From 45794b538eca8ca1ba33f2a4187400d30cf9dea4 Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Tue, 28 Apr 2015 19:44:46 +0200 Subject: [PATCH] more cleanup like deleting very old xemacs stuff. Signed-off-by: Andreas Gerler --- .gitignore | 2 + artbollocks-mode.el | 356 - cl-lib.el | 342 - custom.el | 1 + egg.el | 6208 ------------ lisp/cfengine.el | 2 +- xemacs-packages/etc/bbdb/bbdb-213-310.el | 57 - xemacs-packages/etc/bbdb/bbdb-415-510.el | 87 - .../etc/bbdb/bbdb-areacode-split.pl | 62 - xemacs-packages/etc/bbdb/bbdb-cid.pl | 516 - xemacs-packages/etc/bbdb/bbdb-srv.pl | 45 - xemacs-packages/etc/bbdb/bbdb-to-netscape.el | 213 - xemacs-packages/etc/bbdb/bbdb-unlazy-lock.pl | 19 - xemacs-packages/etc/bbdb/tex/bbdb-cols.tex | 234 - .../etc/bbdb/tex/bbdb-print-brief.tex | 159 - xemacs-packages/etc/bbdb/tex/bbdb-print.tex | 171 - xemacs-packages/etc/ediff/ediff-A-up.xbm | 6 - xemacs-packages/etc/ediff/ediff-A-up.xpm | 24 - xemacs-packages/etc/ediff/ediff-A-xx.xpm | 24 - xemacs-packages/etc/ediff/ediff-B-up.xbm | 6 - xemacs-packages/etc/ediff/ediff-B-up.xpm | 25 - xemacs-packages/etc/ediff/ediff-B-xx.xpm | 25 - xemacs-packages/etc/ediff/ediff-help.xbm | 6 - xemacs-packages/etc/ediff/ediff-help.xpm | 26 - xemacs-packages/etc/ediff/ediff-next.xbm | 6 - xemacs-packages/etc/ediff/ediff-next.xpm | 25 - xemacs-packages/etc/ediff/ediff-prev.xbm | 6 - xemacs-packages/etc/ediff/ediff-prev.xpm | 23 - xemacs-packages/etc/ediff/ediff-quit.xbm | 6 - xemacs-packages/etc/ediff/ediff-quit.xpm | 26 - xemacs-packages/etc/ediff/ediff-refine.xbm | 6 - xemacs-packages/etc/ediff/ediff-refine.xpm | 24 - xemacs-packages/etc/ediff/ediff-save-xx.xbm | 6 - xemacs-packages/etc/ediff/ediff-save-xx.xpm | 25 - xemacs-packages/etc/ediff/ediff-save.xbm | 6 - xemacs-packages/etc/ediff/ediff-save.xpm | 25 - .../etc/ediff/ediff-toggle-split-up.xbm | 6 - .../etc/ediff/ediff-toggle-split-up.xpm | 25 - xemacs-packages/etc/ediff/ediff-update.xbm | 6 - xemacs-packages/etc/ediff/ediff-update.xpm | 25 - xemacs-packages/etc/enriched.doc | 219 - .../etc/python-modes/pydoc_lisp.py | 113 - xemacs-packages/info/bbdb.info | 3626 ------- xemacs-packages/info/ediff.info | 2668 ----- xemacs-packages/info/edit-utils.info | 3987 -------- xemacs-packages/info/os-utils.info | 849 -- xemacs-packages/info/patcher.info | 1887 ---- xemacs-packages/info/pgg.info | 431 - xemacs-packages/info/prog-modes.info | 2718 ------ xemacs-packages/info/re-builder.info | 207 - xemacs-packages/info/smtpmail.info | 414 - xemacs-packages/info/speedbar.info | 1318 --- xemacs-packages/info/tempo.info | 588 -- xemacs-packages/info/tramp.info | 2114 ---- xemacs-packages/info/tramp_ja.info | 2043 ---- xemacs-packages/lisp/bbdb/ChangeLog | 1140 --- xemacs-packages/lisp/bbdb/INSTALL | 166 - xemacs-packages/lisp/bbdb/README | 1 - xemacs-packages/lisp/bbdb/_pkg.el | 5 - xemacs-packages/lisp/bbdb/auto-autoloads.el | 764 -- xemacs-packages/lisp/bbdb/bbdb-com.el | 3612 ------- xemacs-packages/lisp/bbdb/bbdb-ftp.el | 202 - xemacs-packages/lisp/bbdb/bbdb-gnus.el | 814 -- xemacs-packages/lisp/bbdb/bbdb-gui.el | 526 - xemacs-packages/lisp/bbdb/bbdb-hooks.el | 710 -- xemacs-packages/lisp/bbdb/bbdb-merge.el | 261 - xemacs-packages/lisp/bbdb/bbdb-mhe.el | 227 - xemacs-packages/lisp/bbdb/bbdb-migrate.el | 486 - xemacs-packages/lisp/bbdb/bbdb-print.el | 734 -- xemacs-packages/lisp/bbdb/bbdb-reportmail.el | 111 - xemacs-packages/lisp/bbdb/bbdb-rmail.el | 179 - xemacs-packages/lisp/bbdb/bbdb-sc.el | 211 - xemacs-packages/lisp/bbdb/bbdb-snarf.el | 631 -- xemacs-packages/lisp/bbdb/bbdb-srv.el | 288 - xemacs-packages/lisp/bbdb/bbdb-vm.el | 432 - xemacs-packages/lisp/bbdb/bbdb-w3.el | 63 - xemacs-packages/lisp/bbdb/bbdb-whois.el | 263 - xemacs-packages/lisp/bbdb/bbdb-xemacs.el | 113 - xemacs-packages/lisp/bbdb/bbdb.el | 3749 ------- xemacs-packages/lisp/bbdb/custom-load.el | 31 - xemacs-packages/lisp/c-support/ChangeLog | 97 - xemacs-packages/lisp/c-support/_pkg.el | 5 - .../lisp/c-support/auto-autoloads.el | 252 - .../lisp/c-support/c-comment-edit.el | 323 - xemacs-packages/lisp/c-support/c-fill.el | 272 - xemacs-packages/lisp/c-support/c-style.el | 199 - xemacs-packages/lisp/c-support/cmacexp.el | 389 - xemacs-packages/lisp/c-support/ctypes.el | 1737 ---- xemacs-packages/lisp/c-support/custom-load.el | 13 - xemacs-packages/lisp/c-support/hideif.el | 1081 --- xemacs-packages/lisp/c-support/hideshow.el | 933 -- xemacs-packages/lisp/ecrypto/ChangeLog | 243 - xemacs-packages/lisp/ecrypto/_pkg.el | 5 - xemacs-packages/lisp/ecrypto/ascii-armor.el | 138 - .../lisp/ecrypto/auto-autoloads.el | 49 - xemacs-packages/lisp/ecrypto/blowfish.el | 482 - xemacs-packages/lisp/ecrypto/custom-load.el | 14 - xemacs-packages/lisp/ecrypto/des.el | 330 - xemacs-packages/lisp/ecrypto/encrypt.el | 273 - xemacs-packages/lisp/ecrypto/hex-util.el | 75 - xemacs-packages/lisp/ecrypto/md4.el | 230 - xemacs-packages/lisp/ecrypto/md5-dl.el | 55 - xemacs-packages/lisp/ecrypto/md5-el.el | 411 - xemacs-packages/lisp/ecrypto/md5.el | 79 - xemacs-packages/lisp/ecrypto/paranoid.el | 87 - xemacs-packages/lisp/ecrypto/password.el | 192 - xemacs-packages/lisp/ecrypto/rander.el | 137 - xemacs-packages/lisp/ecrypto/rc16.el | 122 - xemacs-packages/lisp/ecrypto/rijndael.el | 843 -- xemacs-packages/lisp/ecrypto/sha1.el | 442 - xemacs-packages/lisp/ediff/ChangeLog | 907 -- xemacs-packages/lisp/ediff/README | 70 - xemacs-packages/lisp/ediff/_pkg.el | 5 - xemacs-packages/lisp/ediff/auto-autoloads.el | 230 - xemacs-packages/lisp/ediff/custom-load.el | 18 - xemacs-packages/lisp/ediff/ediff-diff.el | 1559 --- xemacs-packages/lisp/ediff/ediff-help.el | 332 - xemacs-packages/lisp/ediff/ediff-hook.el | 376 - xemacs-packages/lisp/ediff/ediff-init.el | 1882 ---- xemacs-packages/lisp/ediff/ediff-merg.el | 402 - xemacs-packages/lisp/ediff/ediff-mult.el | 2396 ----- xemacs-packages/lisp/ediff/ediff-ptch.el | 856 -- xemacs-packages/lisp/ediff/ediff-tbar.el | 377 - xemacs-packages/lisp/ediff/ediff-util.el | 4315 --------- xemacs-packages/lisp/ediff/ediff-vers.el | 322 - xemacs-packages/lisp/ediff/ediff-wind.el | 1326 --- xemacs-packages/lisp/ediff/ediff.el | 1546 --- xemacs-packages/lisp/edit-utils/ChangeLog | 1756 ---- xemacs-packages/lisp/edit-utils/_pkg.el | 5 - xemacs-packages/lisp/edit-utils/abbrevlist.el | 55 - .../lisp/edit-utils/after-save-commands.el | 407 - xemacs-packages/lisp/edit-utils/align.el | 1591 --- xemacs-packages/lisp/edit-utils/allout.el | 4773 --------- xemacs-packages/lisp/edit-utils/array.el | 951 -- .../lisp/edit-utils/atomic-extents.el | 110 - .../lisp/edit-utils/auto-autoloads.el | 1563 --- xemacs-packages/lisp/edit-utils/autorevert.el | 375 - xemacs-packages/lisp/edit-utils/avoid.el | 407 - xemacs-packages/lisp/edit-utils/backup-dir.el | 576 -- .../lisp/edit-utils/balloon-help.el | 602 -- .../lisp/edit-utils/big-menubar.el | 215 - .../lisp/edit-utils/blink-cursor.el | 139 - .../lisp/edit-utils/blink-paren.el | 181 - xemacs-packages/lisp/edit-utils/bookmark.el | 2305 ----- xemacs-packages/lisp/edit-utils/compare-w.el | 180 - xemacs-packages/lisp/edit-utils/completion.el | 2727 ------ xemacs-packages/lisp/edit-utils/crm.el | 633 -- .../lisp/edit-utils/custom-load.el | 69 - xemacs-packages/lisp/edit-utils/dabbrev.el | 1060 -- xemacs-packages/lisp/edit-utils/desktop.el | 801 -- .../lisp/edit-utils/detached-minibuf.el | 169 - xemacs-packages/lisp/edit-utils/edit-faces.el | 373 - .../lisp/edit-utils/edit-toolbar.el | 547 -- xemacs-packages/lisp/edit-utils/fast-lock.el | 773 -- xemacs-packages/lisp/edit-utils/file-part.el | 273 - .../lisp/edit-utils/floating-toolbar.el | 385 - xemacs-packages/lisp/edit-utils/flow-ctrl.el | 120 - xemacs-packages/lisp/edit-utils/foldout.el | 581 -- xemacs-packages/lisp/edit-utils/func-menu.el | 2757 ------ xemacs-packages/lisp/edit-utils/highline.el | 882 -- xemacs-packages/lisp/edit-utils/hippie-exp.el | 1129 --- xemacs-packages/lisp/edit-utils/icomplete.el | 361 - xemacs-packages/lisp/edit-utils/id-select.el | 1291 --- xemacs-packages/lisp/edit-utils/info-look.el | 787 -- xemacs-packages/lisp/edit-utils/iswitchb.el | 1357 --- xemacs-packages/lisp/edit-utils/lazy-lock.el | 1076 --- xemacs-packages/lisp/edit-utils/lazy-shot.el | 327 - .../lisp/edit-utils/lispm-fonts.el | 191 - xemacs-packages/lisp/edit-utils/live-icon.el | 328 - xemacs-packages/lisp/edit-utils/makesum.el | 125 - xemacs-packages/lisp/edit-utils/man.el | 761 -- xemacs-packages/lisp/edit-utils/mic-paren.el | 1444 --- .../lisp/edit-utils/mode-motion+.el | 2203 ----- .../lisp/edit-utils/narrow-stack.el | 120 - xemacs-packages/lisp/edit-utils/outl-mouse.el | 684 -- xemacs-packages/lisp/edit-utils/page-ext.el | 793 -- xemacs-packages/lisp/edit-utils/paren.el | 413 - .../lisp/edit-utils/permanent-buffers.el | 228 - xemacs-packages/lisp/edit-utils/popper.el | 1817 ---- .../lisp/edit-utils/power-macros.el | 1932 ---- .../lisp/edit-utils/recent-files.el | 769 -- xemacs-packages/lisp/edit-utils/redo.el | 203 - xemacs-packages/lisp/edit-utils/reportmail.el | 997 -- xemacs-packages/lisp/edit-utils/resume.el | 131 - .../lisp/edit-utils/rsz-minibuf.el | 233 - xemacs-packages/lisp/edit-utils/saveconf.el | 285 - xemacs-packages/lisp/edit-utils/savehist.el | 375 - xemacs-packages/lisp/edit-utils/saveplace.el | 243 - .../lisp/edit-utils/scroll-in-place.el | 1588 --- .../lisp/edit-utils/search-buffers.el | 300 - xemacs-packages/lisp/edit-utils/setnu.el | 449 - xemacs-packages/lisp/edit-utils/shell-font.el | 161 - xemacs-packages/lisp/edit-utils/tempo.el | 759 -- .../lisp/edit-utils/toolbar-utils.el | 484 - xemacs-packages/lisp/edit-utils/tree-menu.el | 199 - xemacs-packages/lisp/edit-utils/uniquify.el | 478 - .../lisp/edit-utils/vertical-mode.el | 76 - .../lisp/edit-utils/where-was-i-db.el | 364 - xemacs-packages/lisp/edit-utils/winring.el | 594 -- xemacs-packages/lisp/mail-lib/ChangeLog | 1378 --- xemacs-packages/lisp/mail-lib/_pkg.el | 5 - .../lisp/mail-lib/auto-autoloads.el | 572 -- xemacs-packages/lisp/mail-lib/base64.el | 278 - .../lisp/mail-lib/browse-url-xemacs.el | 170 - xemacs-packages/lisp/mail-lib/browse-url.el | 1604 --- xemacs-packages/lisp/mail-lib/custom-load.el | 25 - .../lisp/mail-lib/highlight-headers.el | 556 -- xemacs-packages/lisp/mail-lib/mail-abbrevs.el | 649 -- xemacs-packages/lisp/mail-lib/mail-extr.el | 2132 ---- xemacs-packages/lisp/mail-lib/mail-utils.el | 315 - xemacs-packages/lisp/mail-lib/mailheader.el | 195 - xemacs-packages/lisp/mail-lib/netrc.el | 203 - xemacs-packages/lisp/mail-lib/pop3.el | 789 -- xemacs-packages/lisp/mail-lib/reporter.el | 413 - xemacs-packages/lisp/mail-lib/rfc2104.el | 120 - xemacs-packages/lisp/mail-lib/rfc822.el | 329 - xemacs-packages/lisp/mail-lib/rmail-mini.el | 74 - xemacs-packages/lisp/mail-lib/rmailout.el | 263 - xemacs-packages/lisp/mail-lib/sendmail.el | 1849 ---- xemacs-packages/lisp/mail-lib/smtpmail.el | 983 -- xemacs-packages/lisp/mail-lib/starttls.el | 296 - xemacs-packages/lisp/mail-lib/tls.el | 159 - xemacs-packages/lisp/net-utils/ChangeLog | 469 - xemacs-packages/lisp/net-utils/_pkg.el | 5 - .../lisp/net-utils/auto-autoloads.el | 186 - .../lisp/net-utils/browse-cltl2.el | 482 - xemacs-packages/lisp/net-utils/custom-load.el | 31 - xemacs-packages/lisp/net-utils/dig.el | 188 - xemacs-packages/lisp/net-utils/dns-mode.el | 198 - xemacs-packages/lisp/net-utils/dns.el | 374 - xemacs-packages/lisp/net-utils/feedmail.el | 3160 ------ .../lisp/net-utils/google-query.el | 351 - xemacs-packages/lisp/net-utils/metamail.el | 226 - xemacs-packages/lisp/net-utils/mozmail.el | 463 - xemacs-packages/lisp/net-utils/net-utils.el | 674 -- xemacs-packages/lisp/net-utils/rcompile.el | 197 - xemacs-packages/lisp/net-utils/shadowfile.el | 863 -- xemacs-packages/lisp/net-utils/webjump.el | 454 - xemacs-packages/lisp/net-utils/webster-www.el | 71 - xemacs-packages/lisp/net-utils/xemacsbug.el | 353 - xemacs-packages/lisp/net-utils/xml.el | 507 - xemacs-packages/lisp/os-utils/ChangeLog | 317 - xemacs-packages/lisp/os-utils/_pkg.el | 5 - xemacs-packages/lisp/os-utils/arc-mode.el | 1598 --- .../lisp/os-utils/auto-autoloads.el | 400 - xemacs-packages/lisp/os-utils/background.el | 184 - xemacs-packages/lisp/os-utils/crypt.el | 2666 ----- xemacs-packages/lisp/os-utils/custom-load.el | 26 - xemacs-packages/lisp/os-utils/ftelnet.el | 425 - xemacs-packages/lisp/os-utils/inf-lisp.el | 636 -- xemacs-packages/lisp/os-utils/jka-compr.el | 989 -- xemacs-packages/lisp/os-utils/kermit.el | 151 - xemacs-packages/lisp/os-utils/ledit.el | 157 - xemacs-packages/lisp/os-utils/mchat.el | 1353 --- xemacs-packages/lisp/os-utils/rlogin.el | 368 - xemacs-packages/lisp/os-utils/spell.el | 156 - xemacs-packages/lisp/os-utils/ssh.el | 363 - xemacs-packages/lisp/os-utils/tar-mode.el | 1407 --- xemacs-packages/lisp/os-utils/telnet.el | 341 - xemacs-packages/lisp/os-utils/terminal.el | 1280 --- xemacs-packages/lisp/os-utils/uncompress.el | 111 - xemacs-packages/lisp/perl-modes/ChangeLog | 103 - xemacs-packages/lisp/perl-modes/_pkg.el | 5 - .../lisp/perl-modes/auto-autoloads.el | 193 - xemacs-packages/lisp/perl-modes/cperl-mode.el | 8578 ----------------- .../lisp/perl-modes/custom-load.el | 16 - xemacs-packages/lisp/perl-modes/perl-mode.el | 712 -- xemacs-packages/lisp/pgg/ChangeLog | 507 - xemacs-packages/lisp/pgg/README | 4 - xemacs-packages/lisp/pgg/_pkg.el | 5 - xemacs-packages/lisp/pgg/auto-autoloads.el | 74 - xemacs-packages/lisp/pgg/custom-load.el | 14 - xemacs-packages/lisp/pgg/pgg-def.el | 89 - xemacs-packages/lisp/pgg/pgg-gpg.el | 275 - xemacs-packages/lisp/pgg/pgg-parse.el | 515 - xemacs-packages/lisp/pgg/pgg-pgp.el | 245 - xemacs-packages/lisp/pgg/pgg-pgp5.el | 250 - xemacs-packages/lisp/pgg/pgg.el | 371 - xemacs-packages/lisp/prog-modes/ChangeLog | 1560 --- xemacs-packages/lisp/prog-modes/_pkg.el | 5 - xemacs-packages/lisp/prog-modes/asm-mode.el | 265 - .../lisp/prog-modes/auto-autoloads.el | 1407 --- .../lisp/prog-modes/autoconf-mode.el | 87 - xemacs-packages/lisp/prog-modes/awk-mode.el | 181 - xemacs-packages/lisp/prog-modes/cl-indent.el | 513 - .../lisp/prog-modes/custom-load.el | 65 - xemacs-packages/lisp/prog-modes/cvs.el | 2028 ---- xemacs-packages/lisp/prog-modes/diff-mode.el | 1393 --- xemacs-packages/lisp/prog-modes/eiffel.el | 2070 ---- xemacs-packages/lisp/prog-modes/icon.el | 706 -- .../lisp/prog-modes/javascript-mode.el | 389 - xemacs-packages/lisp/prog-modes/ksh-mode.el | 1341 --- xemacs-packages/lisp/prog-modes/lua-mode.el | 1115 --- xemacs-packages/lisp/prog-modes/m4-mode.el | 215 - xemacs-packages/lisp/prog-modes/make-mode.el | 1684 ---- .../lisp/prog-modes/mode-compile.el | 2667 ----- xemacs-packages/lisp/prog-modes/modula2.el | 583 -- xemacs-packages/lisp/prog-modes/old-c-mode.el | 2024 ---- xemacs-packages/lisp/prog-modes/p4.el | 3694 ------- xemacs-packages/lisp/prog-modes/pascal.el | 1597 --- xemacs-packages/lisp/prog-modes/php-mode.el | 852 -- xemacs-packages/lisp/prog-modes/postscript.el | 357 - xemacs-packages/lisp/prog-modes/prolog.el | 336 - xemacs-packages/lisp/prog-modes/rexx-mode.el | 620 -- .../lisp/prog-modes/rpm-spec-mode.el | 1353 --- xemacs-packages/lisp/prog-modes/simula.el | 1330 --- xemacs-packages/lisp/prog-modes/sql.el | 2979 ------ xemacs-packages/lisp/prog-modes/tcl.el | 2020 ---- xemacs-packages/lisp/prog-modes/teco.el | 1947 ---- xemacs-packages/lisp/prog-modes/uil-mode.el | 109 - .../lisp/prog-modes/verilog-mode.el | 8268 ---------------- xemacs-packages/lisp/prog-modes/vrml-mode.el | 787 -- xemacs-packages/lisp/python-modes/ChangeLog | 75 - xemacs-packages/lisp/python-modes/_pkg.el | 5 - .../lisp/python-modes/auto-autoloads.el | 117 - .../lisp/python-modes/custom-load.el | 10 - .../lisp/python-modes/pydoc-el-README | 44 - xemacs-packages/lisp/python-modes/pydoc.el | 644 -- .../lisp/python-modes/python-mode.el | 3817 -------- xemacs-packages/lisp/re-builder/ChangeLog | 100 - xemacs-packages/lisp/re-builder/_pkg.el | 5 - .../lisp/re-builder/auto-autoloads.el | 20 - .../lisp/re-builder/custom-load.el | 10 - xemacs-packages/lisp/re-builder/re-builder.el | 952 -- xemacs-packages/lisp/sh-script/ChangeLog | 127 - xemacs-packages/lisp/sh-script/_pkg.el | 5 - .../lisp/sh-script/auto-autoloads.el | 62 - xemacs-packages/lisp/sh-script/custom-load.el | 15 - xemacs-packages/lisp/sh-script/executable.el | 315 - xemacs-packages/lisp/sh-script/sh-script.el | 3589 ------- xemacs-packages/lisp/speedbar/ChangeLog | 1626 ---- xemacs-packages/lisp/speedbar/_pkg.el | 5 - .../lisp/speedbar/auto-autoloads.el | 74 - xemacs-packages/lisp/speedbar/bigclock.el | 164 - xemacs-packages/lisp/speedbar/custom-load.el | 15 - xemacs-packages/lisp/speedbar/dframe.el | 1026 -- xemacs-packages/lisp/speedbar/rpm.el | 198 - xemacs-packages/lisp/speedbar/sb-ant.el | 108 - .../lisp/speedbar/sb-box-minus.xpm | 22 - xemacs-packages/lisp/speedbar/sb-box-plus.xpm | 22 - xemacs-packages/lisp/speedbar/sb-box.xpm | 22 - xemacs-packages/lisp/speedbar/sb-chk.xpm | 20 - .../lisp/speedbar/sb-dir-minus.xpm | 23 - xemacs-packages/lisp/speedbar/sb-dir-plus.xpm | 23 - xemacs-packages/lisp/speedbar/sb-dir.xpm | 23 - .../lisp/speedbar/sb-doc-minus.xpm | 23 - xemacs-packages/lisp/speedbar/sb-doc-plus.xpm | 23 - xemacs-packages/lisp/speedbar/sb-doc.xpm | 23 - xemacs-packages/lisp/speedbar/sb-gud.el | 243 - xemacs-packages/lisp/speedbar/sb-html.el | 118 - xemacs-packages/lisp/speedbar/sb-image.el | 284 - xemacs-packages/lisp/speedbar/sb-info.el | 251 - xemacs-packages/lisp/speedbar/sb-info.xpm | 22 - xemacs-packages/lisp/speedbar/sb-label.xpm | 22 - xemacs-packages/lisp/speedbar/sb-mail.xpm | 22 - xemacs-packages/lisp/speedbar/sb-obj.xpm | 20 - xemacs-packages/lisp/speedbar/sb-objod.xpm | 21 - xemacs-packages/lisp/speedbar/sb-pg-minus.xpm | 23 - xemacs-packages/lisp/speedbar/sb-pg-plus.xpm | 23 - xemacs-packages/lisp/speedbar/sb-pg.xpm | 23 - xemacs-packages/lisp/speedbar/sb-rmail.el | 158 - xemacs-packages/lisp/speedbar/sb-ro.xpm | 17 - xemacs-packages/lisp/speedbar/sb-tag-gt.xpm | 22 - .../lisp/speedbar/sb-tag-minus.xpm | 22 - xemacs-packages/lisp/speedbar/sb-tag-plus.xpm | 22 - xemacs-packages/lisp/speedbar/sb-tag-type.xpm | 22 - xemacs-packages/lisp/speedbar/sb-tag-v.xpm | 22 - xemacs-packages/lisp/speedbar/sb-tag.xpm | 22 - xemacs-packages/lisp/speedbar/sb-texinfo.el | 219 - xemacs-packages/lisp/speedbar/sb-w3.el | 151 - xemacs-packages/lisp/speedbar/speedbar.el | 3952 -------- xemacs-packages/lisp/template/ChangeLog | 619 -- xemacs-packages/lisp/template/template.el | 2609 ----- xemacs-packages/lisp/texinfo/ChangeLog | 450 - xemacs-packages/lisp/texinfo/_pkg.el | 5 - .../lisp/texinfo/auto-autoloads.el | 186 - xemacs-packages/lisp/texinfo/custom-load.el | 13 - xemacs-packages/lisp/texinfo/detexinfo.el | 275 - xemacs-packages/lisp/texinfo/informat.el | 546 -- xemacs-packages/lisp/texinfo/makeinfo.el | 258 - xemacs-packages/lisp/texinfo/tex-mode.el | 892 -- xemacs-packages/lisp/texinfo/texinfmt.el | 4426 --------- xemacs-packages/lisp/texinfo/texinfo.el | 1062 -- xemacs-packages/lisp/texinfo/texnfo-tex.el | 370 - xemacs-packages/lisp/texinfo/texnfo-upd.el | 2043 ---- xemacs-packages/lisp/text-modes/ChangeLog | 947 -- xemacs-packages/lisp/text-modes/_pkg.el | 5 - xemacs-packages/lisp/text-modes/ansi-color.el | 645 -- .../lisp/text-modes/apache-mode.el | 561 -- .../lisp/text-modes/auto-autoloads.el | 904 -- xemacs-packages/lisp/text-modes/autoinsert.el | 281 - xemacs-packages/lisp/text-modes/crontab.el | 162 - xemacs-packages/lisp/text-modes/css-mode.el | 626 -- .../lisp/text-modes/custom-load.el | 47 - .../lisp/text-modes/desktop-entry-mode.el | 197 - xemacs-packages/lisp/text-modes/filladapt.el | 988 -- xemacs-packages/lisp/text-modes/flyspell.el | 2198 ----- xemacs-packages/lisp/text-modes/folding.el | 5356 ---------- xemacs-packages/lisp/text-modes/hexl.el | 962 -- xemacs-packages/lisp/text-modes/htmlize.el | 1578 --- xemacs-packages/lisp/text-modes/image-mode.el | 201 - xemacs-packages/lisp/text-modes/iso-acc.el | 504 - xemacs-packages/lisp/text-modes/iso-ascii.el | 148 - xemacs-packages/lisp/text-modes/iso-cvt.el | 719 -- xemacs-packages/lisp/text-modes/iso-insert.el | 634 -- xemacs-packages/lisp/text-modes/iso-swed.el | 153 - xemacs-packages/lisp/text-modes/nroff-mode.el | 289 - xemacs-packages/lisp/text-modes/po-compat.el | 263 - xemacs-packages/lisp/text-modes/po-mode.el | 3321 ------- .../lisp/text-modes/rtf-support.el | 744 -- xemacs-packages/lisp/text-modes/scribe.el | 323 - xemacs-packages/lisp/text-modes/swedish.el | 156 - xemacs-packages/lisp/text-modes/tabify.el | 92 - xemacs-packages/lisp/text-modes/tpum.el | 1590 --- xemacs-packages/lisp/text-modes/underline.el | 118 - .../lisp/text-modes/whitespace-mode.el | 606 -- .../lisp/text-modes/whitespace-visual-mode.el | 645 -- xemacs-packages/lisp/text-modes/whitespace.el | 856 -- .../lisp/text-modes/winmgr-mode.el | 173 - xemacs-packages/lisp/text-modes/ws-mode.el | 756 -- xemacs-packages/lisp/text-modes/xpm-mode.el | 464 - xemacs-packages/lisp/text-modes/xrdb-mode.el | 583 -- xemacs-packages/lisp/tramp/ChangeLog | 283 - xemacs-packages/lisp/tramp/ChangeLog.upstream | 798 -- xemacs-packages/lisp/tramp/_pkg.el | 5 - xemacs-packages/lisp/tramp/auto-autoloads.el | 58 - xemacs-packages/lisp/tramp/custom-load.el | 10 - xemacs-packages/lisp/tramp/tramp-efs.el | 237 - xemacs-packages/lisp/tramp/tramp-ftp.el | 141 - xemacs-packages/lisp/tramp/tramp-smb.el | 1056 -- xemacs-packages/lisp/tramp/tramp-util.el | 139 - xemacs-packages/lisp/tramp/tramp-uu.el | 92 - xemacs-packages/lisp/tramp/tramp-vc.el | 538 -- xemacs-packages/lisp/tramp/tramp.el | 7772 --------------- xemacs-packages/lisp/tramp/trampcache.el | 98 - xemacs-packages/lisp/tramp/trampver.el | 42 - xemacs-packages/lisp/xemacs-base/ChangeLog | 1277 --- xemacs-packages/lisp/xemacs-base/_pkg.el | 10 - xemacs-packages/lisp/xemacs-base/add-log.el | 1381 --- xemacs-packages/lisp/xemacs-base/advice.el | 3971 -------- .../lisp/xemacs-base/annotations.el | 451 - xemacs-packages/lisp/xemacs-base/assoc.el | 143 - .../lisp/xemacs-base/auto-autoloads.el | 1827 ---- .../lisp/xemacs-base/case-table.el | 142 - xemacs-packages/lisp/xemacs-base/chistory.el | 179 - .../lisp/xemacs-base/comint-xemacs.el | 53 - xemacs-packages/lisp/xemacs-base/comint.el | 2943 ------ xemacs-packages/lisp/xemacs-base/compile.el | 2368 ----- .../lisp/xemacs-base/custom-load.el | 40 - xemacs-packages/lisp/xemacs-base/debug.el | 827 -- .../lisp/xemacs-base/easy-mmode.el | 605 -- .../lisp/xemacs-base/ebuff-menu.el | 304 - xemacs-packages/lisp/xemacs-base/echistory.el | 158 - xemacs-packages/lisp/xemacs-base/edmacro.el | 745 -- xemacs-packages/lisp/xemacs-base/ehelp.el | 418 - xemacs-packages/lisp/xemacs-base/electric.el | 210 - xemacs-packages/lisp/xemacs-base/enriched.el | 531 - xemacs-packages/lisp/xemacs-base/env.el | 149 - xemacs-packages/lisp/xemacs-base/facemenu.el | 878 -- xemacs-packages/lisp/xemacs-base/ffap.el | 1732 ---- xemacs-packages/lisp/xemacs-base/field.el | 297 - xemacs-packages/lisp/xemacs-base/helper.el | 159 - xemacs-packages/lisp/xemacs-base/imenu.el | 1031 -- .../lisp/xemacs-base/iso-syntax.el | 38 - xemacs-packages/lisp/xemacs-base/macros.el | 242 - xemacs-packages/lisp/xemacs-base/novice.el | 168 - xemacs-packages/lisp/xemacs-base/outline.el | 649 -- xemacs-packages/lisp/xemacs-base/passwd.el | 403 - xemacs-packages/lisp/xemacs-base/pp.el | 193 - .../lisp/xemacs-base/regexp-opt.el | 278 - xemacs-packages/lisp/xemacs-base/regi.el | 259 - xemacs-packages/lisp/xemacs-base/ring.el | 172 - xemacs-packages/lisp/xemacs-base/shell.el | 1198 --- xemacs-packages/lisp/xemacs-base/skeleton.el | 591 -- xemacs-packages/lisp/xemacs-base/sort.el | 624 -- xemacs-packages/lisp/xemacs-base/thing.el | 350 - .../lisp/xemacs-base/time-stamp.el | 541 -- .../lisp/xemacs-base/timer-funcs.el | 291 - xemacs-packages/lisp/xemacs-base/timezone.el | 430 - xemacs-packages/lisp/xemacs-base/tq.el | 124 - .../lisp/xemacs-base/xbm-button.el | 335 - .../lisp/xemacs-base/xpm-button.el | 415 - xemacs-packages/lisp/xemacs-devel/ChangeLog | 821 -- xemacs-packages/lisp/xemacs-devel/_pkg.el | 5 - .../lisp/xemacs-devel/auto-autoloads.el | 582 -- xemacs-packages/lisp/xemacs-devel/bench.el | 540 -- xemacs-packages/lisp/xemacs-devel/checkdoc.el | 2762 ------ .../lisp/xemacs-devel/custom-load.el | 24 - xemacs-packages/lisp/xemacs-devel/docref.el | 287 - xemacs-packages/lisp/xemacs-devel/eldoc.el | 662 -- xemacs-packages/lisp/xemacs-devel/elp.el | 608 -- .../lisp/xemacs-devel/eval-expr.el | 262 - .../lisp/xemacs-devel/find-func.el | 403 - xemacs-packages/lisp/xemacs-devel/find-gc.el | 160 - .../lisp/xemacs-devel/hide-copyleft.el | 161 - xemacs-packages/lisp/xemacs-devel/ielm.el | 493 - .../lisp/xemacs-devel/lisp-file-db.el | 39 - .../lisp/xemacs-devel/patch-keywords.el | 317 - xemacs-packages/lisp/xemacs-devel/patcher.el | 3423 ------- .../lisp/xemacs-devel/pretty-print.el | 577 -- xemacs-packages/lisp/xemacs-devel/profile.el | 416 - .../lisp/xemacs-devel/reposition.el | 202 - xemacs-packages/lisp/xemacs-devel/trace.el | 331 - xemacs-packages/man/bbdb/bbdb.texinfo | 3978 -------- xemacs-packages/man/ediff/ediff.texi | 2530 ----- .../man/edit-utils/edit-utils.texi | 3969 -------- xemacs-packages/man/edit-utils/tempo.texi | 599 -- xemacs-packages/man/mail-lib/smtpmail.texi | 412 - xemacs-packages/man/os-utils/os-utils.texi | 826 -- xemacs-packages/man/pgg/pgg.texi | 399 - .../man/prog-modes/prog-modes.texi | 2625 ----- .../man/re-builder/re-builder.texi | 287 - xemacs-packages/man/speedbar/speedbar.texi | 1296 --- xemacs-packages/man/tramp/tramp.texi | 2405 ----- xemacs-packages/man/tramp/tramp_ja.texi | 2172 ----- xemacs-packages/man/xemacs-devel/patcher.texi | 2000 ---- xemacs-packages/pkginfo/MANIFEST.bbdb | 59 - xemacs-packages/pkginfo/MANIFEST.c-support | 21 - xemacs-packages/pkginfo/MANIFEST.ecrypto | 37 - xemacs-packages/pkginfo/MANIFEST.ediff | 58 - xemacs-packages/pkginfo/MANIFEST.edit-utils | 147 - xemacs-packages/pkginfo/MANIFEST.mail-lib | 47 - xemacs-packages/pkginfo/MANIFEST.net-utils | 37 - xemacs-packages/pkginfo/MANIFEST.os-utils | 41 - xemacs-packages/pkginfo/MANIFEST.perl-modes | 11 - xemacs-packages/pkginfo/MANIFEST.pgg | 22 - xemacs-packages/pkginfo/MANIFEST.prog-modes | 69 - xemacs-packages/pkginfo/MANIFEST.python-modes | 13 - xemacs-packages/pkginfo/MANIFEST.re-builder | 11 - xemacs-packages/pkginfo/MANIFEST.sh-script | 11 - xemacs-packages/pkginfo/MANIFEST.speedbar | 58 - xemacs-packages/pkginfo/MANIFEST.texinfo | 23 - xemacs-packages/pkginfo/MANIFEST.text-modes | 73 - xemacs-packages/pkginfo/MANIFEST.tramp | 30 - xemacs-packages/pkginfo/MANIFEST.xemacs-base | 92 - xemacs-packages/pkginfo/MANIFEST.xemacs-devel | 43 - 536 files changed, 4 insertions(+), 363104 deletions(-) delete mode 100644 artbollocks-mode.el delete mode 100644 cl-lib.el delete mode 100644 egg.el delete mode 100644 xemacs-packages/etc/bbdb/bbdb-213-310.el delete mode 100644 xemacs-packages/etc/bbdb/bbdb-415-510.el delete mode 100755 xemacs-packages/etc/bbdb/bbdb-areacode-split.pl delete mode 100755 xemacs-packages/etc/bbdb/bbdb-cid.pl delete mode 100755 xemacs-packages/etc/bbdb/bbdb-srv.pl delete mode 100644 xemacs-packages/etc/bbdb/bbdb-to-netscape.el delete mode 100755 xemacs-packages/etc/bbdb/bbdb-unlazy-lock.pl delete mode 100644 xemacs-packages/etc/bbdb/tex/bbdb-cols.tex delete mode 100644 xemacs-packages/etc/bbdb/tex/bbdb-print-brief.tex delete mode 100644 xemacs-packages/etc/bbdb/tex/bbdb-print.tex delete mode 100644 xemacs-packages/etc/ediff/ediff-A-up.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-A-up.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-A-xx.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-B-up.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-B-up.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-B-xx.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-help.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-help.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-next.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-next.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-prev.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-prev.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-quit.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-quit.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-refine.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-refine.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-save-xx.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-save-xx.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-save.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-save.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-toggle-split-up.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-toggle-split-up.xpm delete mode 100644 xemacs-packages/etc/ediff/ediff-update.xbm delete mode 100644 xemacs-packages/etc/ediff/ediff-update.xpm delete mode 100644 xemacs-packages/etc/enriched.doc delete mode 100755 xemacs-packages/etc/python-modes/pydoc_lisp.py delete mode 100644 xemacs-packages/info/bbdb.info delete mode 100644 xemacs-packages/info/ediff.info delete mode 100644 xemacs-packages/info/edit-utils.info delete mode 100644 xemacs-packages/info/os-utils.info delete mode 100644 xemacs-packages/info/patcher.info delete mode 100644 xemacs-packages/info/pgg.info delete mode 100644 xemacs-packages/info/prog-modes.info delete mode 100644 xemacs-packages/info/re-builder.info delete mode 100644 xemacs-packages/info/smtpmail.info delete mode 100644 xemacs-packages/info/speedbar.info delete mode 100644 xemacs-packages/info/tempo.info delete mode 100644 xemacs-packages/info/tramp.info delete mode 100644 xemacs-packages/info/tramp_ja.info delete mode 100644 xemacs-packages/lisp/bbdb/ChangeLog delete mode 100644 xemacs-packages/lisp/bbdb/INSTALL delete mode 100644 xemacs-packages/lisp/bbdb/README delete mode 100644 xemacs-packages/lisp/bbdb/_pkg.el delete mode 100644 xemacs-packages/lisp/bbdb/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-com.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-ftp.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-gnus.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-gui.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-hooks.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-merge.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-mhe.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-migrate.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-print.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-reportmail.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-rmail.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-sc.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-snarf.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-srv.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-vm.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-w3.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-whois.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb-xemacs.el delete mode 100644 xemacs-packages/lisp/bbdb/bbdb.el delete mode 100644 xemacs-packages/lisp/bbdb/custom-load.el delete mode 100644 xemacs-packages/lisp/c-support/ChangeLog delete mode 100644 xemacs-packages/lisp/c-support/_pkg.el delete mode 100644 xemacs-packages/lisp/c-support/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/c-support/c-comment-edit.el delete mode 100644 xemacs-packages/lisp/c-support/c-fill.el delete mode 100644 xemacs-packages/lisp/c-support/c-style.el delete mode 100644 xemacs-packages/lisp/c-support/cmacexp.el delete mode 100644 xemacs-packages/lisp/c-support/ctypes.el delete mode 100644 xemacs-packages/lisp/c-support/custom-load.el delete mode 100644 xemacs-packages/lisp/c-support/hideif.el delete mode 100644 xemacs-packages/lisp/c-support/hideshow.el delete mode 100644 xemacs-packages/lisp/ecrypto/ChangeLog delete mode 100644 xemacs-packages/lisp/ecrypto/_pkg.el delete mode 100644 xemacs-packages/lisp/ecrypto/ascii-armor.el delete mode 100644 xemacs-packages/lisp/ecrypto/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/ecrypto/blowfish.el delete mode 100644 xemacs-packages/lisp/ecrypto/custom-load.el delete mode 100644 xemacs-packages/lisp/ecrypto/des.el delete mode 100644 xemacs-packages/lisp/ecrypto/encrypt.el delete mode 100644 xemacs-packages/lisp/ecrypto/hex-util.el delete mode 100644 xemacs-packages/lisp/ecrypto/md4.el delete mode 100644 xemacs-packages/lisp/ecrypto/md5-dl.el delete mode 100644 xemacs-packages/lisp/ecrypto/md5-el.el delete mode 100644 xemacs-packages/lisp/ecrypto/md5.el delete mode 100644 xemacs-packages/lisp/ecrypto/paranoid.el delete mode 100644 xemacs-packages/lisp/ecrypto/password.el delete mode 100644 xemacs-packages/lisp/ecrypto/rander.el delete mode 100644 xemacs-packages/lisp/ecrypto/rc16.el delete mode 100644 xemacs-packages/lisp/ecrypto/rijndael.el delete mode 100644 xemacs-packages/lisp/ecrypto/sha1.el delete mode 100644 xemacs-packages/lisp/ediff/ChangeLog delete mode 100644 xemacs-packages/lisp/ediff/README delete mode 100644 xemacs-packages/lisp/ediff/_pkg.el delete mode 100644 xemacs-packages/lisp/ediff/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/ediff/custom-load.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-diff.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-help.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-hook.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-init.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-merg.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-mult.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-ptch.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-tbar.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-util.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-vers.el delete mode 100644 xemacs-packages/lisp/ediff/ediff-wind.el delete mode 100644 xemacs-packages/lisp/ediff/ediff.el delete mode 100644 xemacs-packages/lisp/edit-utils/ChangeLog delete mode 100644 xemacs-packages/lisp/edit-utils/_pkg.el delete mode 100644 xemacs-packages/lisp/edit-utils/abbrevlist.el delete mode 100644 xemacs-packages/lisp/edit-utils/after-save-commands.el delete mode 100644 xemacs-packages/lisp/edit-utils/align.el delete mode 100644 xemacs-packages/lisp/edit-utils/allout.el delete mode 100644 xemacs-packages/lisp/edit-utils/array.el delete mode 100644 xemacs-packages/lisp/edit-utils/atomic-extents.el delete mode 100644 xemacs-packages/lisp/edit-utils/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/edit-utils/autorevert.el delete mode 100644 xemacs-packages/lisp/edit-utils/avoid.el delete mode 100644 xemacs-packages/lisp/edit-utils/backup-dir.el delete mode 100644 xemacs-packages/lisp/edit-utils/balloon-help.el delete mode 100644 xemacs-packages/lisp/edit-utils/big-menubar.el delete mode 100644 xemacs-packages/lisp/edit-utils/blink-cursor.el delete mode 100644 xemacs-packages/lisp/edit-utils/blink-paren.el delete mode 100644 xemacs-packages/lisp/edit-utils/bookmark.el delete mode 100644 xemacs-packages/lisp/edit-utils/compare-w.el delete mode 100644 xemacs-packages/lisp/edit-utils/completion.el delete mode 100755 xemacs-packages/lisp/edit-utils/crm.el delete mode 100644 xemacs-packages/lisp/edit-utils/custom-load.el delete mode 100644 xemacs-packages/lisp/edit-utils/dabbrev.el delete mode 100644 xemacs-packages/lisp/edit-utils/desktop.el delete mode 100644 xemacs-packages/lisp/edit-utils/detached-minibuf.el delete mode 100644 xemacs-packages/lisp/edit-utils/edit-faces.el delete mode 100644 xemacs-packages/lisp/edit-utils/edit-toolbar.el delete mode 100644 xemacs-packages/lisp/edit-utils/fast-lock.el delete mode 100644 xemacs-packages/lisp/edit-utils/file-part.el delete mode 100644 xemacs-packages/lisp/edit-utils/floating-toolbar.el delete mode 100644 xemacs-packages/lisp/edit-utils/flow-ctrl.el delete mode 100644 xemacs-packages/lisp/edit-utils/foldout.el delete mode 100644 xemacs-packages/lisp/edit-utils/func-menu.el delete mode 100644 xemacs-packages/lisp/edit-utils/highline.el delete mode 100644 xemacs-packages/lisp/edit-utils/hippie-exp.el delete mode 100644 xemacs-packages/lisp/edit-utils/icomplete.el delete mode 100644 xemacs-packages/lisp/edit-utils/id-select.el delete mode 100644 xemacs-packages/lisp/edit-utils/info-look.el delete mode 100644 xemacs-packages/lisp/edit-utils/iswitchb.el delete mode 100644 xemacs-packages/lisp/edit-utils/lazy-lock.el delete mode 100644 xemacs-packages/lisp/edit-utils/lazy-shot.el delete mode 100644 xemacs-packages/lisp/edit-utils/lispm-fonts.el delete mode 100644 xemacs-packages/lisp/edit-utils/live-icon.el delete mode 100644 xemacs-packages/lisp/edit-utils/makesum.el delete mode 100644 xemacs-packages/lisp/edit-utils/man.el delete mode 100644 xemacs-packages/lisp/edit-utils/mic-paren.el delete mode 100644 xemacs-packages/lisp/edit-utils/mode-motion+.el delete mode 100644 xemacs-packages/lisp/edit-utils/narrow-stack.el delete mode 100644 xemacs-packages/lisp/edit-utils/outl-mouse.el delete mode 100644 xemacs-packages/lisp/edit-utils/page-ext.el delete mode 100644 xemacs-packages/lisp/edit-utils/paren.el delete mode 100644 xemacs-packages/lisp/edit-utils/permanent-buffers.el delete mode 100644 xemacs-packages/lisp/edit-utils/popper.el delete mode 100644 xemacs-packages/lisp/edit-utils/power-macros.el delete mode 100644 xemacs-packages/lisp/edit-utils/recent-files.el delete mode 100644 xemacs-packages/lisp/edit-utils/redo.el delete mode 100644 xemacs-packages/lisp/edit-utils/reportmail.el delete mode 100644 xemacs-packages/lisp/edit-utils/resume.el delete mode 100644 xemacs-packages/lisp/edit-utils/rsz-minibuf.el delete mode 100644 xemacs-packages/lisp/edit-utils/saveconf.el delete mode 100644 xemacs-packages/lisp/edit-utils/savehist.el delete mode 100644 xemacs-packages/lisp/edit-utils/saveplace.el delete mode 100644 xemacs-packages/lisp/edit-utils/scroll-in-place.el delete mode 100644 xemacs-packages/lisp/edit-utils/search-buffers.el delete mode 100644 xemacs-packages/lisp/edit-utils/setnu.el delete mode 100644 xemacs-packages/lisp/edit-utils/shell-font.el delete mode 100644 xemacs-packages/lisp/edit-utils/tempo.el delete mode 100644 xemacs-packages/lisp/edit-utils/toolbar-utils.el delete mode 100644 xemacs-packages/lisp/edit-utils/tree-menu.el delete mode 100644 xemacs-packages/lisp/edit-utils/uniquify.el delete mode 100644 xemacs-packages/lisp/edit-utils/vertical-mode.el delete mode 100644 xemacs-packages/lisp/edit-utils/where-was-i-db.el delete mode 100644 xemacs-packages/lisp/edit-utils/winring.el delete mode 100644 xemacs-packages/lisp/mail-lib/ChangeLog delete mode 100644 xemacs-packages/lisp/mail-lib/_pkg.el delete mode 100644 xemacs-packages/lisp/mail-lib/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/mail-lib/base64.el delete mode 100644 xemacs-packages/lisp/mail-lib/browse-url-xemacs.el delete mode 100644 xemacs-packages/lisp/mail-lib/browse-url.el delete mode 100644 xemacs-packages/lisp/mail-lib/custom-load.el delete mode 100644 xemacs-packages/lisp/mail-lib/highlight-headers.el delete mode 100644 xemacs-packages/lisp/mail-lib/mail-abbrevs.el delete mode 100644 xemacs-packages/lisp/mail-lib/mail-extr.el delete mode 100644 xemacs-packages/lisp/mail-lib/mail-utils.el delete mode 100644 xemacs-packages/lisp/mail-lib/mailheader.el delete mode 100644 xemacs-packages/lisp/mail-lib/netrc.el delete mode 100644 xemacs-packages/lisp/mail-lib/pop3.el delete mode 100644 xemacs-packages/lisp/mail-lib/reporter.el delete mode 100644 xemacs-packages/lisp/mail-lib/rfc2104.el delete mode 100644 xemacs-packages/lisp/mail-lib/rfc822.el delete mode 100644 xemacs-packages/lisp/mail-lib/rmail-mini.el delete mode 100644 xemacs-packages/lisp/mail-lib/rmailout.el delete mode 100644 xemacs-packages/lisp/mail-lib/sendmail.el delete mode 100644 xemacs-packages/lisp/mail-lib/smtpmail.el delete mode 100644 xemacs-packages/lisp/mail-lib/starttls.el delete mode 100644 xemacs-packages/lisp/mail-lib/tls.el delete mode 100644 xemacs-packages/lisp/net-utils/ChangeLog delete mode 100644 xemacs-packages/lisp/net-utils/_pkg.el delete mode 100644 xemacs-packages/lisp/net-utils/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/net-utils/browse-cltl2.el delete mode 100644 xemacs-packages/lisp/net-utils/custom-load.el delete mode 100644 xemacs-packages/lisp/net-utils/dig.el delete mode 100644 xemacs-packages/lisp/net-utils/dns-mode.el delete mode 100644 xemacs-packages/lisp/net-utils/dns.el delete mode 100644 xemacs-packages/lisp/net-utils/feedmail.el delete mode 100644 xemacs-packages/lisp/net-utils/google-query.el delete mode 100644 xemacs-packages/lisp/net-utils/metamail.el delete mode 100644 xemacs-packages/lisp/net-utils/mozmail.el delete mode 100644 xemacs-packages/lisp/net-utils/net-utils.el delete mode 100644 xemacs-packages/lisp/net-utils/rcompile.el delete mode 100644 xemacs-packages/lisp/net-utils/shadowfile.el delete mode 100644 xemacs-packages/lisp/net-utils/webjump.el delete mode 100644 xemacs-packages/lisp/net-utils/webster-www.el delete mode 100644 xemacs-packages/lisp/net-utils/xemacsbug.el delete mode 100644 xemacs-packages/lisp/net-utils/xml.el delete mode 100644 xemacs-packages/lisp/os-utils/ChangeLog delete mode 100644 xemacs-packages/lisp/os-utils/_pkg.el delete mode 100644 xemacs-packages/lisp/os-utils/arc-mode.el delete mode 100644 xemacs-packages/lisp/os-utils/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/os-utils/background.el delete mode 100644 xemacs-packages/lisp/os-utils/crypt.el delete mode 100644 xemacs-packages/lisp/os-utils/custom-load.el delete mode 100644 xemacs-packages/lisp/os-utils/ftelnet.el delete mode 100644 xemacs-packages/lisp/os-utils/inf-lisp.el delete mode 100644 xemacs-packages/lisp/os-utils/jka-compr.el delete mode 100644 xemacs-packages/lisp/os-utils/kermit.el delete mode 100644 xemacs-packages/lisp/os-utils/ledit.el delete mode 100644 xemacs-packages/lisp/os-utils/mchat.el delete mode 100644 xemacs-packages/lisp/os-utils/rlogin.el delete mode 100644 xemacs-packages/lisp/os-utils/spell.el delete mode 100644 xemacs-packages/lisp/os-utils/ssh.el delete mode 100644 xemacs-packages/lisp/os-utils/tar-mode.el delete mode 100644 xemacs-packages/lisp/os-utils/telnet.el delete mode 100644 xemacs-packages/lisp/os-utils/terminal.el delete mode 100644 xemacs-packages/lisp/os-utils/uncompress.el delete mode 100644 xemacs-packages/lisp/perl-modes/ChangeLog delete mode 100644 xemacs-packages/lisp/perl-modes/_pkg.el delete mode 100644 xemacs-packages/lisp/perl-modes/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/perl-modes/cperl-mode.el delete mode 100644 xemacs-packages/lisp/perl-modes/custom-load.el delete mode 100644 xemacs-packages/lisp/perl-modes/perl-mode.el delete mode 100644 xemacs-packages/lisp/pgg/ChangeLog delete mode 100644 xemacs-packages/lisp/pgg/README delete mode 100644 xemacs-packages/lisp/pgg/_pkg.el delete mode 100644 xemacs-packages/lisp/pgg/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/pgg/custom-load.el delete mode 100644 xemacs-packages/lisp/pgg/pgg-def.el delete mode 100644 xemacs-packages/lisp/pgg/pgg-gpg.el delete mode 100644 xemacs-packages/lisp/pgg/pgg-parse.el delete mode 100644 xemacs-packages/lisp/pgg/pgg-pgp.el delete mode 100644 xemacs-packages/lisp/pgg/pgg-pgp5.el delete mode 100644 xemacs-packages/lisp/pgg/pgg.el delete mode 100644 xemacs-packages/lisp/prog-modes/ChangeLog delete mode 100644 xemacs-packages/lisp/prog-modes/_pkg.el delete mode 100644 xemacs-packages/lisp/prog-modes/asm-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/prog-modes/autoconf-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/awk-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/cl-indent.el delete mode 100644 xemacs-packages/lisp/prog-modes/custom-load.el delete mode 100644 xemacs-packages/lisp/prog-modes/cvs.el delete mode 100644 xemacs-packages/lisp/prog-modes/diff-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/eiffel.el delete mode 100644 xemacs-packages/lisp/prog-modes/icon.el delete mode 100644 xemacs-packages/lisp/prog-modes/javascript-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/ksh-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/lua-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/m4-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/make-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/mode-compile.el delete mode 100644 xemacs-packages/lisp/prog-modes/modula2.el delete mode 100644 xemacs-packages/lisp/prog-modes/old-c-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/p4.el delete mode 100644 xemacs-packages/lisp/prog-modes/pascal.el delete mode 100644 xemacs-packages/lisp/prog-modes/php-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/postscript.el delete mode 100644 xemacs-packages/lisp/prog-modes/prolog.el delete mode 100644 xemacs-packages/lisp/prog-modes/rexx-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/rpm-spec-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/simula.el delete mode 100644 xemacs-packages/lisp/prog-modes/sql.el delete mode 100644 xemacs-packages/lisp/prog-modes/tcl.el delete mode 100644 xemacs-packages/lisp/prog-modes/teco.el delete mode 100644 xemacs-packages/lisp/prog-modes/uil-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/verilog-mode.el delete mode 100644 xemacs-packages/lisp/prog-modes/vrml-mode.el delete mode 100644 xemacs-packages/lisp/python-modes/ChangeLog delete mode 100644 xemacs-packages/lisp/python-modes/_pkg.el delete mode 100644 xemacs-packages/lisp/python-modes/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/python-modes/custom-load.el delete mode 100644 xemacs-packages/lisp/python-modes/pydoc-el-README delete mode 100644 xemacs-packages/lisp/python-modes/pydoc.el delete mode 100644 xemacs-packages/lisp/python-modes/python-mode.el delete mode 100644 xemacs-packages/lisp/re-builder/ChangeLog delete mode 100644 xemacs-packages/lisp/re-builder/_pkg.el delete mode 100644 xemacs-packages/lisp/re-builder/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/re-builder/custom-load.el delete mode 100644 xemacs-packages/lisp/re-builder/re-builder.el delete mode 100644 xemacs-packages/lisp/sh-script/ChangeLog delete mode 100644 xemacs-packages/lisp/sh-script/_pkg.el delete mode 100644 xemacs-packages/lisp/sh-script/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/sh-script/custom-load.el delete mode 100644 xemacs-packages/lisp/sh-script/executable.el delete mode 100644 xemacs-packages/lisp/sh-script/sh-script.el delete mode 100644 xemacs-packages/lisp/speedbar/ChangeLog delete mode 100644 xemacs-packages/lisp/speedbar/_pkg.el delete mode 100644 xemacs-packages/lisp/speedbar/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/speedbar/bigclock.el delete mode 100644 xemacs-packages/lisp/speedbar/custom-load.el delete mode 100644 xemacs-packages/lisp/speedbar/dframe.el delete mode 100644 xemacs-packages/lisp/speedbar/rpm.el delete mode 100644 xemacs-packages/lisp/speedbar/sb-ant.el delete mode 100644 xemacs-packages/lisp/speedbar/sb-box-minus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-box-plus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-box.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-chk.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-dir-minus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-dir-plus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-dir.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-doc-minus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-doc-plus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-doc.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-gud.el delete mode 100644 xemacs-packages/lisp/speedbar/sb-html.el delete mode 100644 xemacs-packages/lisp/speedbar/sb-image.el delete mode 100644 xemacs-packages/lisp/speedbar/sb-info.el delete mode 100644 xemacs-packages/lisp/speedbar/sb-info.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-label.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-mail.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-obj.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-objod.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-pg-minus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-pg-plus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-pg.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-rmail.el delete mode 100644 xemacs-packages/lisp/speedbar/sb-ro.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-tag-gt.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-tag-minus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-tag-plus.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-tag-type.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-tag-v.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-tag.xpm delete mode 100644 xemacs-packages/lisp/speedbar/sb-texinfo.el delete mode 100644 xemacs-packages/lisp/speedbar/sb-w3.el delete mode 100644 xemacs-packages/lisp/speedbar/speedbar.el delete mode 100644 xemacs-packages/lisp/template/ChangeLog delete mode 100644 xemacs-packages/lisp/template/template.el delete mode 100644 xemacs-packages/lisp/texinfo/ChangeLog delete mode 100644 xemacs-packages/lisp/texinfo/_pkg.el delete mode 100644 xemacs-packages/lisp/texinfo/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/texinfo/custom-load.el delete mode 100644 xemacs-packages/lisp/texinfo/detexinfo.el delete mode 100644 xemacs-packages/lisp/texinfo/informat.el delete mode 100644 xemacs-packages/lisp/texinfo/makeinfo.el delete mode 100644 xemacs-packages/lisp/texinfo/tex-mode.el delete mode 100644 xemacs-packages/lisp/texinfo/texinfmt.el delete mode 100644 xemacs-packages/lisp/texinfo/texinfo.el delete mode 100644 xemacs-packages/lisp/texinfo/texnfo-tex.el delete mode 100644 xemacs-packages/lisp/texinfo/texnfo-upd.el delete mode 100644 xemacs-packages/lisp/text-modes/ChangeLog delete mode 100644 xemacs-packages/lisp/text-modes/_pkg.el delete mode 100644 xemacs-packages/lisp/text-modes/ansi-color.el delete mode 100644 xemacs-packages/lisp/text-modes/apache-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/text-modes/autoinsert.el delete mode 100644 xemacs-packages/lisp/text-modes/crontab.el delete mode 100644 xemacs-packages/lisp/text-modes/css-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/custom-load.el delete mode 100644 xemacs-packages/lisp/text-modes/desktop-entry-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/filladapt.el delete mode 100644 xemacs-packages/lisp/text-modes/flyspell.el delete mode 100644 xemacs-packages/lisp/text-modes/folding.el delete mode 100644 xemacs-packages/lisp/text-modes/hexl.el delete mode 100644 xemacs-packages/lisp/text-modes/htmlize.el delete mode 100644 xemacs-packages/lisp/text-modes/image-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/iso-acc.el delete mode 100644 xemacs-packages/lisp/text-modes/iso-ascii.el delete mode 100644 xemacs-packages/lisp/text-modes/iso-cvt.el delete mode 100644 xemacs-packages/lisp/text-modes/iso-insert.el delete mode 100644 xemacs-packages/lisp/text-modes/iso-swed.el delete mode 100644 xemacs-packages/lisp/text-modes/nroff-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/po-compat.el delete mode 100644 xemacs-packages/lisp/text-modes/po-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/rtf-support.el delete mode 100644 xemacs-packages/lisp/text-modes/scribe.el delete mode 100644 xemacs-packages/lisp/text-modes/swedish.el delete mode 100644 xemacs-packages/lisp/text-modes/tabify.el delete mode 100644 xemacs-packages/lisp/text-modes/tpum.el delete mode 100644 xemacs-packages/lisp/text-modes/underline.el delete mode 100644 xemacs-packages/lisp/text-modes/whitespace-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/whitespace-visual-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/whitespace.el delete mode 100644 xemacs-packages/lisp/text-modes/winmgr-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/ws-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/xpm-mode.el delete mode 100644 xemacs-packages/lisp/text-modes/xrdb-mode.el delete mode 100644 xemacs-packages/lisp/tramp/ChangeLog delete mode 100644 xemacs-packages/lisp/tramp/ChangeLog.upstream delete mode 100644 xemacs-packages/lisp/tramp/_pkg.el delete mode 100644 xemacs-packages/lisp/tramp/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/tramp/custom-load.el delete mode 100644 xemacs-packages/lisp/tramp/tramp-efs.el delete mode 100644 xemacs-packages/lisp/tramp/tramp-ftp.el delete mode 100644 xemacs-packages/lisp/tramp/tramp-smb.el delete mode 100644 xemacs-packages/lisp/tramp/tramp-util.el delete mode 100644 xemacs-packages/lisp/tramp/tramp-uu.el delete mode 100644 xemacs-packages/lisp/tramp/tramp-vc.el delete mode 100644 xemacs-packages/lisp/tramp/tramp.el delete mode 100644 xemacs-packages/lisp/tramp/trampcache.el delete mode 100644 xemacs-packages/lisp/tramp/trampver.el delete mode 100644 xemacs-packages/lisp/xemacs-base/ChangeLog delete mode 100644 xemacs-packages/lisp/xemacs-base/_pkg.el delete mode 100644 xemacs-packages/lisp/xemacs-base/add-log.el delete mode 100644 xemacs-packages/lisp/xemacs-base/advice.el delete mode 100644 xemacs-packages/lisp/xemacs-base/annotations.el delete mode 100644 xemacs-packages/lisp/xemacs-base/assoc.el delete mode 100644 xemacs-packages/lisp/xemacs-base/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/xemacs-base/case-table.el delete mode 100644 xemacs-packages/lisp/xemacs-base/chistory.el delete mode 100644 xemacs-packages/lisp/xemacs-base/comint-xemacs.el delete mode 100644 xemacs-packages/lisp/xemacs-base/comint.el delete mode 100644 xemacs-packages/lisp/xemacs-base/compile.el delete mode 100644 xemacs-packages/lisp/xemacs-base/custom-load.el delete mode 100644 xemacs-packages/lisp/xemacs-base/debug.el delete mode 100644 xemacs-packages/lisp/xemacs-base/easy-mmode.el delete mode 100644 xemacs-packages/lisp/xemacs-base/ebuff-menu.el delete mode 100644 xemacs-packages/lisp/xemacs-base/echistory.el delete mode 100644 xemacs-packages/lisp/xemacs-base/edmacro.el delete mode 100644 xemacs-packages/lisp/xemacs-base/ehelp.el delete mode 100644 xemacs-packages/lisp/xemacs-base/electric.el delete mode 100644 xemacs-packages/lisp/xemacs-base/enriched.el delete mode 100644 xemacs-packages/lisp/xemacs-base/env.el delete mode 100644 xemacs-packages/lisp/xemacs-base/facemenu.el delete mode 100644 xemacs-packages/lisp/xemacs-base/ffap.el delete mode 100644 xemacs-packages/lisp/xemacs-base/field.el delete mode 100644 xemacs-packages/lisp/xemacs-base/helper.el delete mode 100644 xemacs-packages/lisp/xemacs-base/imenu.el delete mode 100644 xemacs-packages/lisp/xemacs-base/iso-syntax.el delete mode 100644 xemacs-packages/lisp/xemacs-base/macros.el delete mode 100644 xemacs-packages/lisp/xemacs-base/novice.el delete mode 100644 xemacs-packages/lisp/xemacs-base/outline.el delete mode 100644 xemacs-packages/lisp/xemacs-base/passwd.el delete mode 100644 xemacs-packages/lisp/xemacs-base/pp.el delete mode 100644 xemacs-packages/lisp/xemacs-base/regexp-opt.el delete mode 100644 xemacs-packages/lisp/xemacs-base/regi.el delete mode 100644 xemacs-packages/lisp/xemacs-base/ring.el delete mode 100644 xemacs-packages/lisp/xemacs-base/shell.el delete mode 100644 xemacs-packages/lisp/xemacs-base/skeleton.el delete mode 100644 xemacs-packages/lisp/xemacs-base/sort.el delete mode 100644 xemacs-packages/lisp/xemacs-base/thing.el delete mode 100644 xemacs-packages/lisp/xemacs-base/time-stamp.el delete mode 100644 xemacs-packages/lisp/xemacs-base/timer-funcs.el delete mode 100644 xemacs-packages/lisp/xemacs-base/timezone.el delete mode 100644 xemacs-packages/lisp/xemacs-base/tq.el delete mode 100644 xemacs-packages/lisp/xemacs-base/xbm-button.el delete mode 100644 xemacs-packages/lisp/xemacs-base/xpm-button.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/ChangeLog delete mode 100644 xemacs-packages/lisp/xemacs-devel/_pkg.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/auto-autoloads.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/bench.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/checkdoc.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/custom-load.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/docref.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/eldoc.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/elp.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/eval-expr.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/find-func.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/find-gc.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/hide-copyleft.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/ielm.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/lisp-file-db.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/patch-keywords.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/patcher.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/pretty-print.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/profile.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/reposition.el delete mode 100644 xemacs-packages/lisp/xemacs-devel/trace.el delete mode 100644 xemacs-packages/man/bbdb/bbdb.texinfo delete mode 100644 xemacs-packages/man/ediff/ediff.texi delete mode 100644 xemacs-packages/man/edit-utils/edit-utils.texi delete mode 100644 xemacs-packages/man/edit-utils/tempo.texi delete mode 100644 xemacs-packages/man/mail-lib/smtpmail.texi delete mode 100644 xemacs-packages/man/os-utils/os-utils.texi delete mode 100644 xemacs-packages/man/pgg/pgg.texi delete mode 100644 xemacs-packages/man/prog-modes/prog-modes.texi delete mode 100644 xemacs-packages/man/re-builder/re-builder.texi delete mode 100644 xemacs-packages/man/speedbar/speedbar.texi delete mode 100644 xemacs-packages/man/tramp/tramp.texi delete mode 100644 xemacs-packages/man/tramp/tramp_ja.texi delete mode 100644 xemacs-packages/man/xemacs-devel/patcher.texi delete mode 100644 xemacs-packages/pkginfo/MANIFEST.bbdb delete mode 100644 xemacs-packages/pkginfo/MANIFEST.c-support delete mode 100644 xemacs-packages/pkginfo/MANIFEST.ecrypto delete mode 100644 xemacs-packages/pkginfo/MANIFEST.ediff delete mode 100644 xemacs-packages/pkginfo/MANIFEST.edit-utils delete mode 100644 xemacs-packages/pkginfo/MANIFEST.mail-lib delete mode 100644 xemacs-packages/pkginfo/MANIFEST.net-utils delete mode 100644 xemacs-packages/pkginfo/MANIFEST.os-utils delete mode 100644 xemacs-packages/pkginfo/MANIFEST.perl-modes delete mode 100644 xemacs-packages/pkginfo/MANIFEST.pgg delete mode 100644 xemacs-packages/pkginfo/MANIFEST.prog-modes delete mode 100644 xemacs-packages/pkginfo/MANIFEST.python-modes delete mode 100644 xemacs-packages/pkginfo/MANIFEST.re-builder delete mode 100644 xemacs-packages/pkginfo/MANIFEST.sh-script delete mode 100644 xemacs-packages/pkginfo/MANIFEST.speedbar delete mode 100644 xemacs-packages/pkginfo/MANIFEST.texinfo delete mode 100644 xemacs-packages/pkginfo/MANIFEST.text-modes delete mode 100644 xemacs-packages/pkginfo/MANIFEST.tramp delete mode 100644 xemacs-packages/pkginfo/MANIFEST.xemacs-base delete mode 100644 xemacs-packages/pkginfo/MANIFEST.xemacs-devel diff --git a/.gitignore b/.gitignore index a72ed3c3..1cbe25a6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ /bba.el +/bookmarks *.elc archive-contents /ac-comphist.dat @@ -8,3 +9,4 @@ archive-contents /mthesaur.txt.cache /org-clock-save.el* /tramp +/url/* diff --git a/artbollocks-mode.el b/artbollocks-mode.el deleted file mode 100644 index 0f0943b7..00000000 --- a/artbollocks-mode.el +++ /dev/null @@ -1,356 +0,0 @@ -;;; artbollocks-mode.el --- A minor mode to guide art writers. -;; -;; Copyright (c) 2011,2012 Rob Myers -;; Minor changes (c) 2012 Sacha Chua -;; -;; Based on fic-mode.el -;; Copyright (C) 2010, Trey Jackson -;; -;; Non-artbollocks words from: http://matt.might.net/articles/ -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU Affero 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 . -;; -;; 2012-06-16: Renamed functions and variables to avoid collisions. -;; Incompatible changes, so please review your configuration. - Sacha -;; Chua -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Extra words thanks to: -;; Brian van den Broek (contextuality, dialetic, problematize) -;; Isabel Brison (alterity, mise en abyme) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Commentary: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Usage -;; -;; To use, save artbollocks-mode.el to a directory in your load-path. -;; -;; (require 'artbollocks-mode) -;; (add-hook 'text-mode-hook 'artbollocks-mode) -;; -;; or -;; -;; M-x artbollocks-mode -;; -;; NOTE: If you manually turn on artbollocks-mode, -;; you you might need to force re-fontification initially: -;; -;; M-x font-lock-fontify-buffer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Customization -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Enable features individually - -(defcustom artbollocks-lexical-illusions t - "Whether to check for lexical illusions" - :type '(boolean) - :group 'artbollocks-mode) - -(defcustom artbollocks-passive-voice t - "Whether to check for passive voice" - :type '(boolean) - :group 'artbollocks-mode) - -(defcustom artbollocks-weasel-words t - "Whether to check for weasel words" - :type '(boolean) - :group 'artbollocks-mode) - -(defcustom artbollocks-jargon t - "Whether to check for artbollocks jargon" - :type '(boolean) - :group 'artbollocks-mode) - -;; Lexical illusion face - -(defcustom artbollocks-lexical-illusions-foreground-color "black" - "Lexical illusions face foreground colour" - :group 'artbollocks-mode) - -(defcustom artbollocks-lexical-illusions-background-color "magenta" - "Lexical illusions face background color" - :group 'artbollocks-mode) - -(defcustom artbollocks-font-lock-lexical-illusions-face 'font-lock-lexical-illusions-face - "The face for lexical illusions in artbollocks mode" - :group 'artbollocks-mode) - -(make-face 'artbollocks-font-lock-lexical-illusions-face) -(modify-face 'artbollocks-font-lock-lexical-illusions-face - artbollocks-lexical-illusions-foreground-color - artbollocks-lexical-illusions-background-color - nil t nil t nil nil) - -;; Passive voice face - -(defcustom artbollocks-passive-voice-foreground-color "Gray" - "Passive voice face foreground colour" - :group 'artbollocks-mode) - -(defcustom artbollocks-passive-voice-background-color "White" - "Passive voice face background color" - :group 'artbollocks-mode) - -(defcustom artbollocks-font-lock-passive-voice-face 'font-lock-passive-voice-face - "The face for passive voice words in artbollocks mode" - :group 'artbollocks-mode) - -(make-face 'artbollocks-font-lock-passive-voice-face) -(modify-face 'artbollocks-font-lock-passive-voice-face - artbollocks-passive-voice-foreground-color - artbollocks-passive-voice-background-color nil t nil t nil nil) - -;; Weasel words face - -(defcustom artbollocks-weasel-words-foreground-color "Brown" - "Weasel words face foreground colour" - :group 'artbollocks-mode) - -(defcustom artbollocks-weasel-words-background-color "White" - "Weasel words face background color" - :group 'artbollocks-mode) - -(defcustom artbollocks-font-lock-weasel-words-face 'artbollocks-font-lock-weasel-words-face - "The face for weasel-words words in artbollocks mode" - :group 'artbollocks-mode) - -(make-face 'artbollocks-font-lock-weasel-words-face) -(modify-face 'artbollocks-font-lock-weasel-words-face - artbollocks-weasel-words-foreground-color - artbollocks-weasel-words-background-color nil t nil t nil nil) - -;; Artbollocks face - -(defcustom artbollocks-foreground-color "Purple" - "Font foreground colour" - :group 'artbollocks-mode) - -(defcustom artbollocks-background-color "White" - "Font background color" - :group 'artbollocks-mode) - -(defcustom artbollocks-font-lock-artbollocks-face 'font-lock-artbollocks-face - "The face for artbollocks words in artbollocks mode" - :group 'artbollocks-mode) - -(make-face 'artbollocks-font-lock-artbollocks-face) -(modify-face 'artbollocks-font-lock-artbollocks-face artbollocks-foreground-color - artbollocks-background-color nil t nil t nil nil) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Lexical illusions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst artbollocks-lexical-illusions-regex "\\b\\(\\w+\\)\\W+\\(\\1\\)\\b") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Passive voice -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst artbollocks-passive-voice-regex "\\b\\(am\\|are\\|were\\|being\\|is\\|been\\|was\\|be\\)\\s-+\\(\\w+ed\\|awoken\\|been\\|born\\|beat\\|become\\|begun\\|bent\\|beset\\|bet\\|bid\\|bidden\\|bound\\|bitten\\|bled\\|blown\\|broken\\|bred\\|brought\\|broadcast\\|built\\|burnt\\|burst\\|bought\\|cast\\|caught\\|chosen\\|clung\\|come\\|cost\\|crept\\|cut\\|dealt\\|dug\\|dived\\|done\\|drawn\\|dreamt\\|driven\\|drunk\\|eaten\\|fallen\\|fed\\|felt\\|fought\\|found\\|fit\\|fled\\|flung\\|flown\\|forbidden\\|forgotten\\|foregone\\|forgiven\\|forsaken\\|frozen\\|gotten\\|given\\|gone\\|ground\\|grown\\|hung\\|heard\\|hidden\\|hit\\|held\\|hurt\\|kept\\|knelt\\|knit\\|known\\|laid\\|led\\|leapt\\|learnt\\|left\\|lent\\|let\\|lain\\|lighted\\|lost\\|made\\|meant\\|met\\|misspelt\\|mistaken\\|mown\\|overcome\\|overdone\\|overtaken\\|overthrown\\|paid\\|pled\\|proven\\|put\\|quit\\|read\\|rid\\|ridden\\|rung\\|risen\\|run\\|sawn\\|said\\|seen\\|sought\\|sold\\|sent\\|set\\|sewn\\|shaken\\|shaven\\|shorn\\|shed\\|shone\\|shod\\|shot\\|shown\\|shrunk\\|shut\\|sung\\|sunk\\|sat\\|slept\\|slain\\|slid\\|slung\\|slit\\|smitten\\|sown\\|spoken\\|sped\\|spent\\|spilt\\|spun\\|spit\\|split\\|spread\\|sprung\\|stood\\|stolen\\|stuck\\|stung\\|stunk\\|stridden\\|struck\\|strung\\|striven\\|sworn\\|swept\\|swollen\\|swum\\|swung\\|taken\\|taught\\|torn\\|told\\|thought\\|thrived\\|thrown\\|thrust\\|trodden\\|understood\\|upheld\\|upset\\|woken\\|worn\\|woven\\|wed\\|wept\\|wound\\|won\\|withheld\\|withstood\\|wrung\\|written\\)\\b") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Weasel words -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst artbollocks-weasel-words-regex "\\b\\(many\\|various\\|very\\|fairly\\|several\\|extremely\\|exceedingly\\|quite\\|remarkably\\|few\\|surprisingly\\|mostly\\|largely\\|huge\\|tiny\\|\\(\\(are\\|is\\) a number\\)\\|excellent\\|interestingly\\|significantly\\|substantially\\|clearly\\|vast\\|relatively\\|completely\\)\\b") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Artbollocks -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst artbollocks-jargon-regex "\\b\\(a priori\\|ad hoc\\|affirmation\\|affirm\\|affirms\\|alterity\\|altermodern\\|aporia\\|aporetic\\|appropriates\\|appropriation\\|archetypal\\|archetypical\\|archetype\\|archetypes\\|autonomous\\|autonomy\\|baudrillardian\\|baudrillarian\\|commodification\\|committed\\|commitment\\|commonalities\\|contemporaneity\\|context\\|contexts\\|contextual\\|contextualise\\|contextualises\\|contextualisation\\|contextialize\\|contextializes\\|contextualization\\|contextuality\\|convention\\|conventional\\|conventions\\|coterminous\\|critique\\|cunning\\|cunningly\\|death of the author\\|debunk\\|debunked\\|debunking\\|debunks\\|deconstruct\\|deconstruction\\|deconstructs\\|deleuzian\\|desire\\|desires\\|dialectic\\|dialectical\\|dialectically\\|discourse\\|discursive\\|disrupt\\|disrupts\\|engage\\|engagement\\|engages\\|episteme\\|epistemic\\|ergo\\|fetish\\|fetishes\\|fetishise\\|fetishised\\|fetishize\\|fetishized\\|gaze\\|gender\\|gendered\\|historicise\\|historicisation\\|historicize\\|historicization\\|hegemonic\\|hegemony\\|identity\\|identity politics\\|intensifies\\|intensify\\|intensifying\\|interrogate\\|interrogates\\|interrogation\\|intertextual\\|intertextuality\\|irony\\|ironic\\|ironical\\|ironically\\|ironisation\\|ironization\\|ironises\\|ironizes\\|jouissance\\|juxtapose\\|juxtaposes\\|juxtaposition\\|lacanian\\|lack\\|loci\\|locus\\|locuses\\|matrix\\|mise en abyme\\|mocking\\|mockingly\\|modalities\\|modality\\|myth\\|mythologies\\|mythology\\|myths\\|narrative\\|narrativisation\\|narrativization\\|narrativity\\|nexus\\|nodal\\|node\\|normative\\|normativity\\|notion\\|notions\\|objective\\|objectivity\\|objectivities\\|objet petit a\\|ontology\\|ontological\\|operate\\|operates\\|otherness\\|othering\\|paradigm\\|paradigmatic\\|paradigms\\|parody\\|parodic\\|parodies\\|physicality\\|plenitude\\|poetics\\|popular notions\\|position\\|post hoc\\|post internet\\|post-internet\\|postmodernism\\|postmodernist\\|postmodernity\\|postmodern\\|practice\\|practise\\|praxis\\|problematic\\|problematics\\|problematise\\|problematize\\|proposition\\|qua\\|reading\\|readings\\|reification\\|relation\\|relational\\|relationality\\|relations\\|representation\\|representations\\|rhizomatic\\|rhizome\\|simulacra\\|simulacral\\|simulation\\|simulationism\\|simulationism\\|situate\\|situated\\|situates\\|stereotype\\|stereotypes\\|strategy\\|strategies\\|subjective\\|subjectivity\\|subjectivities\\|subvert\\|subversion\\|subverts\\|text\\|textual\\|textuality\\|thinker\\|thinkers\\|trajectory\\|transgress\\|transgresses\\|transgression\\|transgressive\\|unfolding\\|undermine\\|undermining\\|undermines\\|work\\|works\\|wry\\|wryly\\|zizekian\\|zižekian\\)\\b") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Highlighting -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun artbollocks-search-for-keyword (regex limit) - "Match REGEX in buffer until LIMIT." - (let (match-data-to-set - found) - (save-match-data - (while (and (null match-data-to-set) - (re-search-forward regex limit t)) - (setq match-data-to-set (match-data)))) - (when match-data-to-set - (set-match-data match-data-to-set) - (goto-char (match-end 0)) - t))) - -(defun artbollocks-lexical-illusions-search-for-keyword (limit) - (artbollocks-search-for-keyword artbollocks-lexical-illusions-regex limit)) - -(defun artbollocks-passive-voice-search-for-keyword (limit) - (artbollocks-search-for-keyword artbollocks-passive-voice-regex limit)) - -(defun artbollocks-weasel-words-search-for-keyword (limit) - (artbollocks-search-for-keyword artbollocks-weasel-words-regex limit)) - -(defun artbollocks-search-for-jargon (limit) - (artbollocks-search-for-keyword artbollocks-jargon-regex limit)) - -(defconst artbollocks-lexicalkwlist - '((artbollocks-lexical-illusions-search-for-keyword - (2 'artbollocks-font-lock-lexical-illusions-face t)))) - -(defconst artbollocks-passivekwlist - '((artbollocks-passive-voice-search-for-keyword - (0 'artbollocks-font-lock-passive-voice-face t)))) - -(defconst artbollocks-weaselkwlist - '((artbollocks-weasel-words-search-for-keyword - (0 'artbollocks-font-lock-weasel-words-face t)))) - -(defconst artbollocks-kwlist - '((artbollocks-search-for-jargon - (0 'artbollocks-font-lock-artbollocks-face t)))) - -(defun artbollocks-add-keywords () - (when artbollocks-lexical-illusions - (font-lock-add-keywords nil artbollocks-lexicalkwlist)) - (when artbollocks-passive-voice - (font-lock-add-keywords nil artbollocks-passivekwlist)) - (when artbollocks-weasel-words - (font-lock-add-keywords nil artbollocks-weaselkwlist)) - (when artbollocks-jargon - (font-lock-add-keywords nil artbollocks-kwlist))) - -(defun artbollocks-remove-keywords () - (font-lock-remove-keywords nil artbollocks-lexicalkwlist) - (font-lock-remove-keywords nil artbollocks-passivekwlist) - (font-lock-remove-keywords nil artbollocks-weaselkwlist) - (font-lock-remove-keywords nil artbollocks-kwlist)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Utility macros -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro interactive-optional-region () - "Flexible variation of (interactive \"r\"). -Bind START and END parameters to either a selected region or the -entire buffer, subject to narrowing." - `(interactive - (if (use-region-p) - (list (region-beginning) (region-end)) - (list (point-min) (point-max))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Text metrics -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun artbollocks-count-letters (&optional start end) - (how-many "\\w" (or start (point-min)) (or end (point-max)))) - -(defun artbollocks-count-syllables (&optional start end) - ;; Naively count vowel runs as syllable markers - (how-many "[aeiouy]+" (or start (point-min)) (or end (point-max)))) - -(defun artbollocks-count-words (&optional start end) - "Count the number of words between START and END." - (interactive-optional-region) - (let* ((s (or start (point-min))) - (e (or end (point-max))) - (result - (if (fboundp 'count-words) - (count-words s e) - (how-many "\\w+" s e)))) - (if (called-interactively-p 'any) - (message "Word count: %s" result)) - result)) - -(defun artbollocks-count-sentences (&optional start end) - "Count the number of words between START and END." - (interactive-optional-region) - (let* ((s (or start (point-min))) - (e (or end (point-max))) - (result - (how-many "\\w[!?.]" s e))) - (if (called-interactively-p 'any) - (message "Sentence count: %s" result)) - result)) - -;; FIXME: Avoid divide by zero where document is empty or small - -(defun artbollocks-automated-readability-index (&optional start end) - (let ((words (float (artbollocks-count-words start end)))) - (- (+ (* 4.71 (/ (artbollocks-count-letters start end) words)) - (* 0.5 (/ words (artbollocks-count-sentences start end)))) - 21.43))) - -(defun artbollocks-flesch-reading-ease (&optional start end) - (let ((words (float (artbollocks-count-words start end)))) - (- 206.834 - (* 1.015 (/ words (artbollocks-count-sentences start end))) - (* 84.6 (/ (artbollocks-count-syllables start end) words))))) - -(defun artbollocks-flesch-kinkaid-grade-level (&optional start end) - (let ((words (float (artbollocks-count-words start end)))) - (- (+ (* 11.8 (/ (artbollocks-count-syllables start end) words)) - (* 0.39 (/ words (artbollocks-count-sentences start end)))) - 15.59))) - -(defalias 'artbollocks-word-count 'artbollocks-count-words) -(defalias 'artbollocks-sentence-count 'artbollocks-count-sentences) - -(defun artbollocks-readability-index (&optional start end) - "Determine the automated readability index between START and END." - (interactive-optional-region) - (message "Readability index: %s" (artbollocks-automated-readability-index start end))) - -(defun artbollocks-reading-ease (&optional start end) - "Determine the Flesch reading ease between START and END." - (interactive-optional-region) - (message "Reading ease: %s" (artbollocks-flesch-reading-ease start end))) - -(defun artbollocks-grade-level (&optional start end) - "Determine the Flesch-Kinkaid grade level between START and END." - (interactive-optional-region) - (message "Grade level: %s" (artbollocks-flesch-kinkaid-grade-level start end))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The mode -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst artbollocks-mode-keymap (make-keymap)) - -(define-key artbollocks-mode-keymap (kbd "C-c [") 'artbollocks-word-count) -(define-key artbollocks-mode-keymap (kbd "C-c ]") 'artbollocks-sentence-count) -(define-key artbollocks-mode-keymap (kbd "C-c \\") 'artbollocks-readability-index) -(define-key artbollocks-mode-keymap (kbd "C-c /") 'artbollocks-reading-ease) -(define-key artbollocks-mode-keymap (kbd "C-c =") 'artbollocks-grade-level) - -;;;###autoload -(define-minor-mode artbollocks-mode "Highlight passive voice, weasel words and artbollocks jargon in text, and provide useful text metrics" - :lighter " AB" - :keymap artbollocks-mode-keymap - :group 'artbollocks-mode - (if artbollocks-mode - (artbollocks-add-keywords) - (artbollocks-remove-keywords))) - -(provide 'artbollocks-mode) - -;; TODO -;; Toggle adding word/sentence count to status bar -;; Pluralization -;; Incorporate diction commands if available (and advise on installation if not) -;; Split general writing back out diff --git a/cl-lib.el b/cl-lib.el deleted file mode 100644 index a1df0a23..00000000 --- a/cl-lib.el +++ /dev/null @@ -1,342 +0,0 @@ -;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8 -*- - -;; Copyright (C) 2012, 2013 Free Software Foundation, Inc. - -;; Author: Stefan Monnier -;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below. -;; Version: 0.3 - -;; 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 is a forward compatibility package, which provides (a subset of) the -;; features of the cl-lib package introduced in Emacs-24.3, for use on -;; previous emacsen. - -;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's -;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to -;; Emacs-24.3, the built-in version of the file will take precedence, otherwise -;; you could get into trouble (although we try to hack our way around the -;; problem in case it happens). - -;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings -;; simply reversed. - -;;; Code: - -(when (functionp 'macroexp--compiler-macro) - ;; `macroexp--compiler-macro' was introduced as part of the big CL - ;; reorganization which moved/reimplemented some of CL into core (mostly the - ;; setf and compiler-macro support), so its presence indicates we're running - ;; in an Emacs that comes with the new cl-lib.el, where this file should - ;; never be loaded! - (message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name) - (when load-file-name - ;; (message "Let's try to patch things up") - (let ((loaddir (file-name-directory load-file-name)) - load-path-dir) - ;; Find the problematic directory from load-path. - (dolist (dir load-path) - (if (equal loaddir (expand-file-name (file-name-as-directory dir))) - (setq load-path-dir dir))) - (when load-path-dir - ;; (message "Let's move the offending dir to the end") - (setq load-path (append (remove load-path-dir load-path) - (list load-path-dir))) - ;; Here we could manually load cl-lib and then return immediately. - ;; But Emacs currently doesn't provide any way for a file to "return - ;; immediately", so instead we make sure the rest of the file does not - ;; throw away any pre-existing definition. - )))) - -(require 'cl) - -;; Some of Emacs-24.3's cl.el definition are not just aliases, because either -;; the feature was dropped from cl-lib.el or because the cl-lib version is -;; not fully compatible. -;; Let's just not include them here, since it is very important that if code -;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el, -;; whereas the reverse is much less important. - -(dolist (var '( - ;; loop-result-var - ;; loop-result - ;; loop-initially - ;; loop-finally - ;; loop-bindings - ;; loop-args - ;; bind-inits - ;; bind-block - ;; lambda-list-keywords - float-negative-epsilon - float-epsilon - least-negative-normalized-float - least-positive-normalized-float - least-negative-float - least-positive-float - most-negative-float - most-positive-float - ;; custom-print-functions - )) - (let ((new (intern (format "cl-%s" var)))) - (unless (boundp new) (defvaralias new var)))) - -(dolist (fun '( - (get* . cl-get) - (random* . cl-random) - (rem* . cl-rem) - (mod* . cl-mod) - (round* . cl-round) - (truncate* . cl-truncate) - (ceiling* . cl-ceiling) - (floor* . cl-floor) - (rassoc* . cl-rassoc) - (assoc* . cl-assoc) - (member* . cl-member) - (delete* . cl-delete) - (remove* . cl-remove) - (defsubst* . cl-defsubst) - (sort* . cl-sort) - (function* . cl-function) - (defmacro* . cl-defmacro) - (defun* . cl-defun) - (mapcar* . cl-mapcar) - - remprop - getf - tailp - list-length - nreconc - revappend - concatenate - subseq - random-state-p - make-random-state - signum - isqrt - lcm - gcd - notevery - notany - every - some - mapcon - mapcan - mapl - maplist - map - equalp - coerce - tree-equal - nsublis - sublis - nsubst-if-not - nsubst-if - nsubst - subst-if-not - subst-if - subsetp - nset-exclusive-or - set-exclusive-or - nset-difference - set-difference - nintersection - intersection - nunion - union - rassoc-if-not - rassoc-if - assoc-if-not - assoc-if - member-if-not - member-if - merge - stable-sort - search - mismatch - count-if-not - count-if - count - position-if-not - position-if - position - find-if-not - find-if - find - nsubstitute-if-not - nsubstitute-if - nsubstitute - substitute-if-not - substitute-if - substitute - delete-duplicates - remove-duplicates - delete-if-not - delete-if - remove-if-not - remove-if - replace - fill - reduce - compiler-macroexpand - define-compiler-macro - assert - check-type - typep - deftype - defstruct - callf2 - callf - letf* - letf - rotatef - shiftf - remf - psetf - (define-setf-method . define-setf-expander) - declare - the - locally - multiple-value-setq - multiple-value-bind - symbol-macrolet - macrolet - progv - psetq - do-all-symbols - do-symbols - dotimes - dolist - do* - do - loop - return-from - return - block - etypecase - typecase - ecase - case - load-time-value - eval-when - destructuring-bind - gentemp - gensym - pairlis - acons - subst - adjoin - copy-list - ldiff - list* - cddddr - cdddar - cddadr - cddaar - cdaddr - cdadar - cdaadr - cdaaar - cadddr - caddar - cadadr - cadaar - caaddr - caadar - caaadr - caaaar - cdddr - cddar - cdadr - cdaar - caddr - cadar - caadr - caaar - tenth - ninth - eighth - seventh - sixth - fifth - fourth - third - endp - rest - second - first - svref - copy-seq - evenp - oddp - minusp - plusp - floatp-safe - declaim - proclaim - nth-value - multiple-value-call - multiple-value-apply - multiple-value-list - values-list - values - pushnew - decf - incf - - dolist - dotimes - )) - (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun))) - (intern (format "cl-%s" fun))))) - (unless (fboundp new) (defalias new fun)))) - -;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping -;; (mostly because it does not turn lambdas that refer to those functions into -;; closures). OTOH it is compatible when using lexical scoping. - -(unless (fboundp 'cl-labels) - (defmacro cl-labels (&rest args) - (unless (and (boundp 'lexical-binding) lexical-binding) - ;; We used to signal an error rather than a message, but in many uses of - ;; cl-labels, the value of lexical-binding doesn't actually matter. - ;; More importantly, the value of `lexical-binding' here is unreliable - ;; (it does not necessarily reflect faithfully whether the output of this - ;; macro will be interpreted as lexically bound code or not). - (message "This `cl-labels' requires `lexical-binding' to be non-nil")) - `(labels ,@args))) - -;;;; ChangeLog: - -;; 2013-05-22 Stefan Monnier -;; -;; * cl-lib.el (cl-labels): Demote error to message and improve it. -;; -;; 2012-11-30 Stefan Monnier -;; -;; * cl-lib.el: Try and patch things up in case we're hiding the real cl-lib. -;; -;; 2012-11-22 Stefan Monnier -;; -;; Add cl-letf and cl-labels. -;; -;; 2012-11-16 Stefan Monnier -;; -;; * packages/cl-lib: New package. -;; - - -(provide 'cl-lib) -;;; cl-lib.el ends here diff --git a/custom.el b/custom.el index 0f66994c..706cd7e1 100644 --- a/custom.el +++ b/custom.el @@ -20,6 +20,7 @@ ;; If you edit it by hand, you could mess it up, so be careful. ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right. + '(default ((t (:inherit nil :stipple nil :background "black" :foreground "green" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :height 1 :width normal :foundry "default" :family "default")))) '(cursor ((t (:foreground "red")))) '(rainbow-delimiters-depth-1-face ((((background dark)) (:foreground "gray90")))) '(rainbow-delimiters-depth-2-face ((((background dark)) (:foreground "#ff82ab")))) diff --git a/egg.el b/egg.el deleted file mode 100644 index c9c227dd..00000000 --- a/egg.el +++ /dev/null @@ -1,6208 +0,0 @@ -;;; egg -- Emacs Got Git -;;; A magit fork - -;; Copyright (C) 2008 Linh Dang -;; Copyright (C) 2008 Marius Vollmer -;; Copyright (C) 2009 Tim Moore -;; Copyright (C) 2010 Alexander Prusov -;; Copyright (C) 2011 byplayer -;; -;; Special Thanks to -;; Antoine Levitt, Bogolisk -;; -;; Egg is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; Egg is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -;; License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary -;;; This is my fork of Marius's excellent magit. his work is at: -;;; http://zagadka.vm.bytemark.co.uk/magit -;;; -;;; This is my fork of bogolisk egg . his work is at -;; http://github.com/bogolisk/egg -;;; - -;; Options -;; If you want to auto-update egg-status on file save, -;; you set follow value on your .emacs. -;; (setq egg-auto-update t) -;; -;; Set to nonnil for egg-status to switch to the status buffer in the same window. -;; (setq egg-switch-to-buffer t) -;; -;; If you want to change prefix of lunch egg, -;; you set follow value on your .emacs. -;; (custom-set-variables -;; '(egg-mode-key-prefix "C-c v")) - -(require 'cl) -(require 'electric) -(require 'ediff) -(require 'ffap) -(require 'diff-mode) - -(defconst egg-version "1.0.1") - -(defgroup egg nil - "Controlling Git from Emacs." - :prefix "egg-" - :group 'tools) - -(defgroup egg-faces nil - "Colourful Faces for Egg." - :group 'egg) - -(defface egg-header - '((t :weight bold :inherit variable-pitch :height 1.1)) - "Face for generic headers. - -Many Egg faces inherit from this one by default." - :group 'egg-faces) - -(defface egg-text-base - '((((class color) (background light)) - :foreground "navy" :inherit variable-pitch) - (((class color) (background dark)) - :foreground "SteelBlue" :inherit variable-pitch) - (t)) - "Face for description text." - :group 'egg-faces) - -(defface egg-text-1 - '((t :inherit egg-text-base)) - "Face for description text." - :group 'egg-faces) - -(defface egg-text-help - '((t :inherit egg-text-base :height 0.8)) - "Face for help text." - :group 'egg-faces) - -(defface egg-help-header-1 - '((t :inherit egg-text-base :weight bold)) - "Face for help text." - :group 'egg-faces) - -(defface egg-help-header-2 - '((((class color) (background light)) - :foreground "Black" :inherit egg-text-1 :height 0.9) - (((class color) (background dark)) - :foreground "LightSteelBlue" :inherit egg-text-1 :height 0.9) - (t :inherit egg-text-1)) - "Face for help text." - :group 'egg-faces) - -(defface egg-text-2 - '((t :inherit egg-text-base :height 1.1)) - "Face for description text." - :group 'egg-faces) - -(defface egg-text-3 - '((t :inherit egg-text-base :height 1.2)) - "Face for description text." - :group 'egg-faces) - -(defface egg-text-4 - '((t :inherit egg-text-base :height 1.4)) - "Face for description text." - :group 'egg-faces) - -(defface egg-electrict-choice - '((((class color) (background light)) - :foreground "Blue" :inherit egg-text-1 :weight bold) - (((class color) (background dark)) - :foreground "Cyan" :inherit egg-text-1 :weight bold) - (t)) - "Face for description text." - :group 'egg-faces) - -(defface egg-section-title - '((((class color) (background light)) - :foreground "DarkGoldenrod" :inherit egg-header :height 1.1) - (((class color) (background dark)) - :foreground "PaleGreen" :inherit egg-header :height 1.1) - (t :weight bold)) - "Face for generic header lines. - -Many Egg faces inherit from this one by default." - :group 'egg-faces) - -(defface egg-branch - '((((class color) (background light)) - :foreground "SkyBlue" :inherit egg-header :height 1.1) - (((class color) (background dark)) - :foreground "Yellow" :inherit egg-header :height 1.1) - (t :weight bold)) - "Face for the current branch." - :group 'egg-faces) - -(defface egg-log-buffer-mark - '((((class color) (background light)) - :foreground "black" :inherit bold) - (((class color) (background dark)) - :foreground "orchid1" :inherit bold) - (t :weight bold)) - "Face to mark commit line in log-buffer." - :group 'egg-faces) - -(defface egg-branch-mono - '((((class color) (background light)) - :foreground "SkyBlue" :inherit bold) - (((class color) (background dark)) - :foreground "Yellow" :inherit bold) - (t :weight bold)) - "Face for a branch." - :group 'egg-faces) - -(defface egg-tag-mono - '((((class color) (background light)) - :foreground "GoldenRod" :inherit bold) - (((class color) (background dark)) - :foreground "SkyBlue" :inherit bold) - (t :weight bold)) - "Face for a tag." - :group 'egg-faces) - -(defface egg-an-tag-mono - '((((class color) (background light)) - :foreground "DarkGoldenRod" :inherit bold) - (((class color) (background dark)) - :foreground "LightGreen" :inherit bold) - (t :weight bold)) - "Face for an annotated branch." - :group 'egg-faces) - -(defface egg-stash-mono - '((((class color) (background light)) - :foreground "DarkGoldenRod" :inherit bold) - (((class color) (background dark)) - :foreground "LightGreen" :inherit bold) - (t :weight bold)) - "Face for a stash identifier." - :group 'egg-faces) - -(defface egg-remote-mono - '((((class color) (background light)) - :foreground "Orchid" :inherit bold) - (((class color) (background dark)) - :foreground "DarkSalmon" :inherit bold) - (t :weight bold)) - "Face for a remote." - :group 'egg-faces) - -(defface egg-term - '((((class color) (background light)) - :foreground "SkyBlue" :inherit bold) - (((class color) (background dark)) - :foreground "Yellow" :inherit bold) - (t :weight bold)) - "Face for an important term." - :group 'egg-faces) - -(defface egg-help-key - '((t :inherit 'egg-term :height 0.9)) - "Hilight Face in help text." - :group 'egg-faces) - -(defface egg-warning - '((((class color) (background light)) - :foreground "Red" :inherit bold) - (((class color) (background dark)) - :foreground "Orange" :inherit bold) - (t :weight bold)) - "Face for a warning." - :group 'egg-faces) - -(defface egg-diff-file-header - '((((class color) (background light)) - :foreground "SlateBlue" :inherit egg-header) - (((class color) (background dark)) - :foreground "LightSlateBlue" :inherit egg-header) - (t :weight bold)) - "Face for diff file headers." - :group 'egg-faces) - -(defface egg-unmerged-diff-file-header - '((((class color) (background light)) - :foreground "Red" :inherit egg-diff-file-header) - (((class color) (background dark)) - :foreground "Orange" :inherit egg-diff-file-header) - (t :weight bold)) - "Face for unmerged diff file headers." - :group 'egg-faces) - -(defface egg-diff-hunk-header - '((((class color) (background light)) - :background "grey85") - (((class color) (background dark)) - :background "grey45")) - "Face for diff hunk headers." - :group 'egg-faces) - -(defface egg-diff-add - '((((class color) (background light)) - :foreground "blue1") - (((class color) (background dark)) - :foreground "ForestGreen")) - "Face for lines in a diff that have been added." - :group 'egg-faces) - -(defface egg-diff-none - '((((class color) (background light)) - :foreground "grey50") - (((class color) (background dark)) - :foreground "grey70")) - "Face for lines in a diff that are unchanged." - :group 'egg-faces) - -(defface egg-diff-del - '((((class color) (background light)) - :foreground "red") - (((class color) (background dark)) - :foreground "OrangeRed")) - "Face for lines in a diff that have been deleted." - :group 'egg-faces) - -(defface egg-diff-conflict - '((((class color) (background light)) - :foreground "Blue") - (((class color) (background dark)) - :foreground "Orange")) - "Face for lines in a diff that have been deleted." - :group 'egg-faces) - -(defface egg-graph - '((((class color) (background light)) - :foreground "grey90") - (((class color) (background dark)) - :foreground "grey30")) - "Face for graph." - :group 'egg-faces) - -(defface egg-blame - '((((class color) (background light)) - :background: "grey85" :foreground "black") - (((class color) (background dark)) - :background "grey15" :foreground "white") - (t :inherit region)) - "Face for blame header." - :group 'egg-faces) - -(defface egg-blame-culprit - '((((class color) (background light)) - :inherit egg-text-2 :background "grey85" :foreground "grey35") - (((class color) (background dark)) - :inherit egg-text-2 :background "grey15" :foreground "grey60") - (t :inherit egg-blame)) - "Face for blame culprit." - :group 'egg-faces) - -(defface egg-blame-subject - '((((class color) (background light)) - :inherit egg-blame-culprit :foreground "black") - (((class color) (background dark)) - :inherit egg-blame-culprit :foreground "white") - (t :inherit egg-blame)) - "Face for blame tag line." - :group 'egg-faces) - -(defface egg-log-HEAD - '((t (:inherit region))) - "Face to highlight HEAD in the log buffer." - :group 'egg-faces) - -(defcustom egg-buffer-hide-sub-blocks-on-start nil - "Initially hide all sub-blocks." - :group 'egg - :type '(set (const :tag "Status Buffer" egg-status-buffer-mode) - (const :tag "Log Buffer" egg-log-buffer-mode) - (const :tag "File Log Buffer" egg-file-log-buffer-mode) - (const :tag "RefLog Buffer" egg-reflog-buffer-mode) - (const :tag "Diff Buffer" egg-diff-buffer-mode) - (const :tag "Commit Buffer" egg-commit-buffer-mode))) - -(defcustom egg-buffer-hide-section-type-on-start nil - "Initially hide sections of the selected type." - :group 'egg - :type '(set (cons :tag "Status Buffer" - (const :tag "Hide Blocks of type" - egg-status-buffer-mode) - (radio (const :tag "Section" :section) - (const :tag "File" :diff) - (const :tag "Hunk" :hunk))) - (cons :tag "Commit Log Buffer" - (const :tag "Hide Blocks of type" - egg-commit-buffer-mode) - (radio (const :tag "Section" :section) - (const :tag "File" :diff) - (const :tag "Hunk" :hunk))) - (cons :tag "Diff Buffer" - (const :tag "Hide Blocks of type" - egg-diff-buffer-mode) - (radio (const :tag "File" :diff) - (const :tag "Hunk" :hunk))))) - -(defcustom egg-buffer-hide-help-on-start nil - "Initially hide keybindings help." - :group 'egg - :type '(set (const :tag "Status Buffer" egg-status-buffer-mode) - (const :tag "Log Buffer" egg-log-buffer-mode) - (const :tag "File Log Buffer" egg-file-log-buffer-mode) - (const :tag "RefLog Buffer" egg-reflog-buffer-mode) - (const :tag "Diff Buffer" egg-diff-buffer-mode) - (const :tag "Commit Buffer" egg-commit-buffer-mode))) - -(defcustom egg-log-HEAD-max-len 1000 - "Maximum number of entries when showing the history of HEAD." - :group 'egg - :type 'integer) - -(defcustom egg-log-all-max-len 10000 - "Maximum number of entries when showing the history of HEAD." - :group 'egg - :type 'integer) - -(defcustom egg-confirm-next-action t - "Always prompt for confirmation while guessing the next logical action ." - :group 'egg - :type 'boolean) - -(defcustom egg-confirm-undo t - "Always prompt for confirmation before removing delta from workdir." - :group 'egg - :type 'boolean) - -(defcustom egg-status-buffer-sections '(repo unstaged staged untracked) - "Sections to be listed in the status buffer and their order." - :group 'egg - :type '(repeat (choice (const :tag "Repository Info" repo) - (const :tag "Unstaged Changes Section" unstaged) - (const :tag "Staged Changes Section" staged) - (const :tag "Untracked/Uignored Files" untracked)))) - - -(defcustom egg-commit-buffer-sections '(staged unstaged untracked) - "Sections to be listed in the status buffer and their order." - :group 'egg - :type '(repeat (choice (const :tag "Unstaged Changes Section" unstaged) - (const :tag "Staged Changes Section" staged) - (const :tag "Untracked/Uignored Files" untracked)))) - - -(defcustom egg-refresh-index-in-backround nil - "Whether to refresh the index in the background when emacs is idle." - :group 'egg - :type 'boolean) - -(defcustom egg-enable-tooltip nil - "Whether to activate useful tooltips, showing the local keymap at the point." - :group 'egg - :type 'boolean) - -(defcustom egg-git-rebase-subdir "rebase-merge" - "Name of the rebase's workdir. -Different versions of git have different names for this subdir." - :group 'egg - :type '(choice (const ".dotest-merge") - (const "rebase-merge") - string)) - -(defcustom egg-show-key-help-in-buffers - '(:log :status :diff :file-log :reflog) - "Display keybinding help in egg special buffers." - :group 'egg - :type '(set (const :tag "Status Buffer" :status) - (const :tag "Log Buffer" :log) - (const :tag "File Log Buffer" :file-log) - (const :tag "RefLog Buffer" :reflog) - (const :tag "Diff Buffer" :diff) - (const :tag "Commit Buffer" :commit))) - -(define-widget 'egg-quit-window-actions-set 'lazy - "Custom Type for quit-window actions." - :offset 4 - :format "%v" - :type '(set :tag "Actions" - (const :tag "Kill Buffer" kill) - (const :tag "Restore Windows" restore-windows))) - -(defcustom egg-quit-window-actions nil - "Actions to perform upon quitting an egg special buffer." - :group 'egg - :type '(set (cons :format "%v" (const :tag "Status Buffer" egg-status-buffer-mode) - egg-quit-window-actions-set) - (cons :format "%v" (const :tag "Log (History) Buffer" egg-log-buffer-mode) - egg-quit-window-actions-set) - (cons :format "%v" (const :tag "Commit Log Buffer" egg-commit-buffer-mode) - egg-quit-window-actions-set) - (cons :format "%v" (const :tag "RefLog Buffer" egg-reflog-buffer-mode) - egg-quit-window-actions-set) - (cons :format "%v" (const :tag "Diff Buffer" egg-diff-buffer-mode) - egg-quit-window-actions-set) - (cons :format "%v" (const :tag "File Log (History) Buffer" egg-file-log-buffer-mode) - egg-quit-window-actions-set))) - -(defcustom egg-git-command "git" - "Name or full-path to the git command. -Set this to the appropriate string in the case where `git' is not the -desirable way to invoke GIT." - :group 'egg - :type 'string) - -(defcustom egg-patch-command "patch" - "Name or full-path to the patch command. -Set this to the appropriate string in the case where `patch' is not the -desirable way to invoke gnu patch command." - :group 'egg - :type 'string) - - -(defcustom egg-dummy-option nil - "Foo bar" - :group 'egg - :type '(set (const :bold) (const :italic))) - -;;;======================================================== -;;; simple routines -;;;======================================================== -(defmacro egg-text (text face) - "Format TEXT with face FACE at compile-time or run-time." - (cond ((stringp text) - (propertize text 'face (if (symbolp face) face - (nth 1 face)))) - ((null text) - `(propertize "" 'face ,face)) - (t `(propertize ,text 'face ,face)))) - -;;(cl-macroexpand '(egg-text blah 'egg-text-3)) - -(defmacro egg-prop (text &rest prop) - "Propertize TEXT with properties list PROP at compile-time or run-time." - (if (stringp text) - (apply 'propertize text - (mapcar (lambda (sym) - (if (consp sym) - (nth 1 sym) - sym)) - prop)) - `(propertize ,text ,@prop))) - -(defalias 'egg-string-at-point 'ffap-string-at-point) -(defalias 'egg-find-file-at-point 'find-file-at-point) - -(defsubst egg-prepend (str prefix &rest other-properties) - "Make STR appear to have prefix PREFIX. -If OTHER-PROPERTIES was non-nil, apply it to STR." - (setq prefix (concat prefix (substring str 0 1))) - (setq str (apply 'propertize str other-properties)) - (put-text-property 0 1 'display prefix str) - str) - -(defsubst egg-commit-contents (rev) - "Retrieve the raw-contents of the commit REV." - (with-temp-buffer - (call-process egg-git-command nil t nil "cat-file" "commit" rev) - (buffer-string))) - -(defsubst egg-commit-message (rev) - "Retrieve the commit message of REV." - (with-temp-buffer - (call-process egg-git-command nil t nil "cat-file" "commit" rev) - (goto-char (point-min)) - (re-search-forward "^\n") - (buffer-substring-no-properties (match-end 0) (point-max)))) - - -(defsubst egg-cmd-to-string-1 (program args) - "Execute PROGRAM and return its output as a string. -ARGS is a list of arguments to pass to PROGRAM." - (with-temp-buffer - (if (= (apply 'call-process program nil t nil args) 0) - (buffer-substring-no-properties - (point-min) (if (> (point-max) (point-min)) - (1- (point-max)) (point-max)))))) - -(defsubst egg-cmd-to-string (program &rest args) - "Execute PROGRAM and return its output as a string. -ARGS is a list of arguments to pass to PROGRAM." - (egg-cmd-to-string-1 program args)) - - -(defsubst egg-git-to-string (&rest args) - "run GIT wih ARGS and return the output as a string." - (egg-cmd-to-string-1 egg-git-command args)) - -(defsubst egg-cmd-ok (program buffer &rest args) - "run PROGRAM with ARGS and insert output into BUFFER at point. -return the t if the exit-code was 0. if BUFFER was t then -current-buffer would be used." - (= (apply 'call-process program nil buffer nil args) 0)) - -(defsubst egg-git-ok (buffer &rest args) - "run GIT with ARGS and insert output into BUFFER at point. -return the t if the exit-code was 0. if BUFFER was t then -current-buffer would be used." - (= (apply 'call-process egg-git-command nil buffer nil args) 0)) - -(defsubst egg-git-region-ok (start end &rest args) - "run GIT with ARGS and insert output into current buffer at point. -return the t if the exit-code was 0. The text between START and END -is used as input to GIT." - (= (apply 'call-process-region start end egg-git-command t t nil args) 0)) - -(defsubst egg-wdir-clean () (egg-git-ok nil "diff" "--quiet")) -(defsubst egg-file-updated (file) - (egg-git-ok nil "diff" "--quiet" "--" file)) -(defsubst egg-file-committed (file) - (egg-git-ok nil "diff" "--quiet" "HEAD" "--" file)) -(defsubst egg-file-index-empty (file) - (egg-git-ok nil "diff" "--quiet" "--cached" "--" file)) -(defsubst egg-index-empty () (egg-git-ok nil "diff" "--cached" "--quiet")) - - -(defsubst egg-git-to-lines (&rest args) - "run GIT with ARGS. -Return the output lines as a list of strings." - (save-match-data - (split-string (or (egg-cmd-to-string-1 egg-git-command args) "") - "[\n]+" t))) - -(defun egg-git-lines-matching (re idx &rest args) - "run GIT with ARGS. -Return the output lines as a list of strings." - (with-temp-buffer - (when (= (apply 'call-process egg-git-command nil t nil args) 0) - (let (lines) - (save-match-data - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq lines (cons (match-string-no-properties idx) lines))) - lines))))) - -(defun egg-git-lines-matching-multi (re indices &rest args) - "run GIT with ARGS. -Return the output lines as a list of strings." - (with-temp-buffer - (when (= (apply 'call-process egg-git-command nil t nil args) 0) - (let (lines matches) - (save-match-data - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq matches nil) - (dolist (idx indices) - (when (match-beginning idx) - (setq matches - (cons (cons idx (match-string-no-properties idx)) - matches)))) - (setq lines (cons matches lines))) - lines))))) - -(defsubst egg-file-git-name (file) - "return the repo-relative name of FILE." - (car (egg-git-to-lines "ls-files" "--full-name" "--" file))) - -(defsubst egg-buf-git-name (&optional buf) - "return the repo-relative name of the file visited by BUF. -if BUF was nil then use current-buffer" - (egg-file-git-name (file-truename (buffer-file-name buf)))) - -(defsubst egg-files-git-name (files) - "return the repo-relative name for each file in the list of files FILES." - (delete-duplicates - (apply 'egg-git-to-lines "ls-files" "--full-name" "--" files) - :test 'string-equal)) - -(defsubst egg-unmerged-files () - "return a list of repo-relative names for each unmerged files." - (save-match-data - (delete-duplicates - (mapcar 'car - (mapcar 'last - (mapcar - 'split-string - (egg-git-to-lines "ls-files" "--full-name" "-u")))) - :test 'string-equal))) - -(defsubst egg-local-branches () - "Get a list of local branches. E.g. (\"master\", \"wip1\")." - (egg-git-to-lines "rev-parse" "--symbolic" "--branches")) - -(defsubst egg-local-refs () - "Get a list of local refs. E.g. (\"master\", \"wip1\")." - (egg-git-to-lines "rev-parse" "--symbolic" "--branches" "--tags")) - -(defun egg-remote-branches (&optional raw) - "Get a list of remote branches. E.g. (\"origin/master\", \"joe/fork1\")." - (let ((lst (egg-git-to-lines "rev-parse" "--symbolic" "--remotes"))) - (if raw lst - (mapcar (lambda (full-name) - (let ((tmp (save-match-data (split-string full-name "/")))) - (cons (cadr tmp) (car tmp)))) - lst)))) - -(defsubst egg-rbranch-to-remote (rbranch) - "Return the remote name in the remote-branch RBRANCH. -E.g: `foo' in `foo/bar'" - (and (stringp rbranch) - (> (length rbranch) 0) - (directory-file-name (file-name-directory rbranch)))) - -(defsubst egg-rbranch-name (rbranch) - "Return the ref name in the remote-branch RBRANCH. -E.g: `bar' in `foo/bar'" - (and (stringp rbranch) - (> (length rbranch) 0) - (file-name-nondirectory rbranch))) - -(defsubst egg-short-ref (full-ref) - "Return the short ref name of the full ref name FULL-REF. -like `my_tag' in `refs/tags/my_tag'." - (and (stringp full-ref) - (> (length full-ref) 0) - (file-name-nondirectory full-ref))) - -(defsubst egg-file-as-string-raw (file-name) - (with-temp-buffer - (insert-file-contents-literally file-name) - (buffer-string))) - -(defsubst egg-file-as-string (file-name) - "return the contents of file FILE-NAME as a string." - (with-temp-buffer - (insert-file-contents-literally file-name) - (buffer-substring-no-properties - (point-min) (if (> (point-max) (point-min)) - (1- (point-max)) (point-max))))) - - -(defun egg-pick-file-contents (file-name regexp &rest indices) - "Pick a string out of the contents of the file FILE-NAME. -This function searches for and return the 1st match of REGEXP on the -contents of the file. If indices was not nil, then return the first -successful submatch in the order in INDICES." - (with-temp-buffer - (insert-file-contents-literally file-name) - (goto-char (point-min)) - (when (re-search-forward regexp nil t) - (if (null indices) - (match-string-no-properties 0) - (dolist (idx indices) - (if (match-beginning idx) - (return (match-string-no-properties idx)))))))) - -(defun egg-pick-file-records (file-name start-re end-re) - "Return a list of strings from the contents of the file FILE-NAME. -START-RE is the regexp to match the beginning of a record. -END-RE is the regexp to match the end of a record." - (with-temp-buffer - (insert-file-contents-literally file-name) - (goto-char (point-min)) - (let ((beg (point-min)) - (end (point-max)) - lst) - (save-match-data - (while (and (> end beg) - (not (eobp)) - (re-search-forward start-re nil t)) - (setq beg (match-beginning 0)) - (when (re-search-forward end-re nil t) - (setq end (match-beginning 0)) - (if (> end beg) - (setq lst (cons (buffer-substring-no-properties - beg (match-beginning 0)) - lst))) - (goto-char end)))) - lst))) - -(defsubst egg-is-in-git () - "is the default-directory in a git repo." - (= (call-process egg-git-command nil nil nil "rev-parse" "--git-dir") 0)) - -(defsubst egg-is-dir-in-git (dir) - "is DIR in a git repo." - (let ((default-directory dir)) (egg-is-in-git))) - -(defsubst egg-name-rev (rev) - "get the symbolic name of REV." - (egg-git-to-string "name-rev" "--always" "--name-only" rev)) - -(defsubst egg-describe-rev (rev) - "get the long symbolic name of REV." - (egg-git-to-string "describe" "--always" "--tags" rev)) - -(defsubst egg-sha1 (rev) - "get the SHA1 of REV." - (egg-git-to-string "rev-parse" (concat rev "~0"))) - -(defun egg-read-git-dir () - "call GIT to read the git directory of default-directory." - (let* ((dotgit-parent (and (buffer-file-name) (locate-dominating-file (buffer-file-name) ".git"))) - (dir (or (and dotgit-parent (concat dotgit-parent "/.git")) - (egg-git-to-string "rev-parse" "--git-dir")))) - (if (stringp dir) - (expand-file-name dir)))) - -(defsubst egg-read-dir-git-dir (dir) - "call GIT to read the git directory of DIR." - (let ((default-directory dir)) (egg-read-git-dir))) - -(defvar egg-git-dir nil) -(defsubst egg-git-dir (&optional error-if-not-git) - "return the (pre-read) git-dir of default-directory" - (if (local-variable-p 'egg-git-dir) - egg-git-dir - (set (make-local-variable 'egg-git-dir) - (or (egg-read-git-dir) - (and error-if-not-git - (or (kill-local-variable 'egg-git-dir) t) - (error "Not in a git repository: %s" default-directory)))) - ;; first time, no status yet. - ;; this directory's specific var will be updated by - ;; egg-set-mode-info - (set (intern (concat "egg-" egg-git-dir "-HEAD")) " Egg") - egg-git-dir)) - -(defsubst egg-buf-git-dir (buffer) - "return the (pre-read) git-dir of BUFFER." - (with-current-buffer buffer - (egg-git-dir))) - -(defun egg-HEAD () - "return HEAD. Either a symbolic ref or a sha1." - (let* ((git-dir (egg-git-dir))) - (if git-dir - (egg-pick-file-contents (concat git-dir "/HEAD") - "^ref: refs/heads/\\(.+\\)\\|^\\([0-9a-f]+\\)" 1 2)))) - -(defun egg-all-refs () - "Get a list of all refs." - (append (egg-git-to-lines "rev-parse" "--symbolic" - "--branches" "--tags" "--remotes") - (delq nil - (mapcar - (lambda (head) - (if (file-exists-p (concat (egg-git-dir) "/" head)) - head)) - '("HEAD" "ORIG_HEAD" "MERGE_HEAD" "FETCH_HEAD"))))) - -(defun egg-ref-type-alist () - "Build an alist of (REF-NAME . :type) cells." - (mapcar (lambda (ref-desc) - (cons (cdr (assq 5 ref-desc)) - (cond ((assq 2 ref-desc) :head) - ((assq 3 ref-desc) :tag) - ((assq 4 ref-desc) :remote)))) - (egg-git-lines-matching-multi - "^.+ \\(refs/\\(?:\\(heads\\)\\|\\(tags\\)\\|\\(remotes\\)\\)/\\(\\([^/\n]+/\\)?[^/\n]+\\)\\)$" - ;; 1: full-name - ;; 2: head - ;; 3: tag - ;; 4: remote - ;; 5: name - ;; 6: remote-host - '(1 2 3 4 5 6) "show-ref"))) - -(defsubst egg-tooltip-func () - (if egg-enable-tooltip 'egg-buffer-help-echo)) - -(defun egg-full-ref-decorated-alist (head-properties - tag-properties - atag-properties - remote-ref-properties - remote-site-properties) - "Build an alist of (ref . :type) cells. -A ref string of a head will be decorated with head-PROPERTIES. A -ref string of a tag will be decorated with TAG-PROPERTIES or -ATAG-PROPERTIES. A ref string of a remote will be formatted with -REMOTE-REF-PROPERTIES and REMOTE-SITE-PROPERTIES." - (let ((refs-desc-list - (egg-git-lines-matching-multi - "^.+ \\(refs/\\(?:\\(heads\\)\\|\\(tags\\)\\|\\(remotes\\)\\)/\\(\\([^/\n]+/\\)?[^/\n{}]+\\)\\)\\(\\^{}\\)?$" - ;; 1: full-name - ;; 2: head - ;; 3: tag - ;; 4: remote - ;; 5: name - ;; 6: remote-host - ;; 7: is annotated tag - '(1 2 3 4 5 6 7) "show-ref" "-d")) - annotated-tags) - ;; remove the annotated tags from the list - (setq refs-desc-list - (delq nil - (mapcar (lambda (desc) - (if (not (assq 7 desc)) - ;; not an annotated tag - desc - (setq annotated-tags - (cons (cdr (assq 1 desc)) - annotated-tags)) - nil)) - refs-desc-list))) - ;; decorate the ref alist - (mapcar (lambda (desc) - (let ((full-name (cdr (assq 1 desc))) - (name (cdr (assq 5 desc))) - (remote (cdr (assq 6 desc)))) - (cond ((assq 2 desc) - ;; head - (cons full-name - (apply 'propertize name - :ref (cons name :head) - head-properties))) - ((assq 3 desc) - ;; tag - (cons full-name - (apply 'propertize name - :ref (cons name :tag) - (if (member full-name annotated-tags) - atag-properties - tag-properties)))) - ((assq 4 desc) - ;; remote - (cons full-name - (concat - (if (stringp remote) - (apply 'propertize remote - :ref (cons name :remote) - remote-site-properties) - ;; svn has no remote name - "") - (apply 'propertize (substring name (length remote)) - :ref (cons name :remote) - remote-ref-properties))))))) - refs-desc-list))) - - - -(defun egg-complete-rev (string &optional ignored all) - "Do revision completion" - (save-match-data - (cond ((string-match "\\`:[0-3]*" string) ;; stages - (funcall (if all 'all-completions 'try-completion) - string '(":0" ":1" ":2" ":3"))) - - ;; rev^, rev~10 etc. - ((string-match "[\\^~][\\^~0-9]*\\'" string) - ;; check with rev-parse - (if (egg-git-ok nil "rev-parse" string) - ;; rev-parse ok - (if all - ;; fixme: how to do a full expansion? - (list string) - ;; match - string))) - - ;; normal rev name - (t (let ((matches - ;; match all types of refs - (egg-git-to-lines "for-each-ref" "--format=%(refname)" - (concat "refs/*/" string "*") - (concat "refs/*/" string "*/*"))) - prefix) - ;; get the short name - ;; with 1.6.x: for-each-ref" "--format=%(refname=short) - (setq matches - (mapcar (lambda (long) - (string-match - "\\`refs/\\(?:heads\\|tags\\|remotes\\)/\\(.+\\)\\'" - long) - (match-string-no-properties 1 long)) - matches)) - ;; do the completion - (setq prefix - (funcall (if all 'all-completions 'try-completion) - string - (nconc (directory-files (egg-git-dir) - nil "HEAD") - matches))) - (cond (all prefix) - ((stringp prefix) prefix) - ((null prefix) nil) - (t string))))))) - -(defsubst egg-get-symbolic-HEAD (&optional file) - ;; get the symbolic name of HEAD - (setq file (or file (concat (egg-git-dir) "/HEAD"))) - (egg-pick-file-contents file - "^ref: refs/heads/\\(.+\\)" - 1)) - -(defsubst egg-get-full-symbolic-HEAD (&optional file) - ;; get the symbolic full name of HEAD - (setq file (or file (concat (egg-git-dir) "/HEAD"))) - (egg-pick-file-contents file - "^ref: \\(refs/heads/.+\\)" - 1)) - -(defsubst egg-get-current-sha1 () - (or (egg-git-to-string "rev-parse" "--verify" "-q" "HEAD") - "0000000000000000000000000000000000000000")) - -(defsubst egg-set-mode-info (state) - "Set the mode-line string for buffers visiting files in the current repo. -The string is built based on the current state STATE." - (set (intern (concat "egg-" egg-git-dir "-HEAD")) - (format " Git:%s" (cond ((plist-get state :rebase-dir) - "(rebasing)") - ((plist-get state :merge-heads) - "(merging)") - ((plist-get state :branch) - (plist-get state :branch)) - (t "(detached)"))))) - -(defsubst egg-get-rebase-merge-state (rebase-dir) - "Build a plist of rebase info of REBASE-DIR. -this is for rebase -m variant." - (list :rebase-dir rebase-dir - :rebase-head - (egg-name-rev (egg-file-as-string (concat rebase-dir "head-name"))) - :rebase-upstream - (egg-describe-rev (egg-file-as-string (concat rebase-dir "onto_name"))) - :rebase-step ;; string-to-number? - (egg-file-as-string (concat rebase-dir "msgnum")) - :rebase-num ;; string-to-number? - (egg-file-as-string (concat rebase-dir "end")))) - -(defsubst egg-get-rebase-interactive-state (rebase-dir) - "Build a plist of rebase info of REBASE-DIR. -this is for rebase -i variant." - (list :rebase-dir rebase-dir - :rebase-head - (egg-name-rev (egg-file-as-string (concat rebase-dir "head-name"))) - :rebase-upstream - (egg-describe-rev (egg-file-as-string (concat rebase-dir "onto"))) - :rebase-num - (length - (egg-pick-file-records (concat rebase-dir "git-rebase-todo.backup") - "^[pes]" "$")) - :rebase-step - (if (file-exists-p (concat rebase-dir "done")) - (length (egg-pick-file-records (concat rebase-dir "done") - "^[pes]" "$")) - 0) - :rebase-cherry - (if (file-exists-p (concat rebase-dir "done")) - (car (egg-pick-file-records - (concat rebase-dir "done") - "^[pes]" "$"))))) - -(defsubst egg-git-rebase-dir (&optional git-dir) - (concat (or git-dir (egg-git-dir)) "/" egg-git-rebase-subdir "/")) - -(defsubst egg-rebase-author-info (rebase-dir) - "Retrieve an alist of commit environment variables of the current -cherry in REBASE-DIR." - (mapcar (lambda (lst) - ;; chop the ' ' - (setcar (cdr lst) (substring (cadr lst) 1 -1)) - lst) - (mapcar (lambda (line) - ;; name-value split - (save-match-data (split-string line "=" t))) - ;; grab the GIT_xxx=yyy - (egg-pick-file-records (concat rebase-dir "author-script") - "^GIT_\\(.+\\)" "$")))) - -(defsubst egg-interactive-rebase-in-progress () - "Is an interactive rebase in progress in the current repo?" - (file-exists-p (concat (egg-git-dir) "/" egg-git-rebase-subdir - "/interactive") )) - -(defvar egg-internal-current-state nil) -(defun egg-get-repo-state (&optional extras) - "Retrieve current repo's state as a plist. -The properties: -:gitdir :head :branch :sha1 :merge-heads :rebase-dir :rebase-head -:rebase-upstream :rebase-step :rebase-num :rebase-cherry - -EXTRAS contains the extra properties to retrieve: :staged :unstaged - -if EXTRAS contains :error-if-not-git then error-out if not a git repo. -" - (let* ((git-dir (egg-git-dir (memq :error-if-not-git extras))) - (head-file (concat git-dir "/HEAD")) - (merge-file (concat git-dir "/MERGE_HEAD")) - (branch (egg-get-symbolic-HEAD head-file)) - (branch-full-name (egg-get-full-symbolic-HEAD head-file)) - (sha1 (egg-get-current-sha1)) - (merge-heads - (mapcar 'egg-name-rev - (if (file-readable-p merge-file) - (egg-pick-file-records merge-file "^" "$")))) - (rebase-dir - (if (file-directory-p (concat git-dir "/" egg-git-rebase-subdir)) - (concat git-dir "/" egg-git-rebase-subdir "/"))) - (is-rebase-interactive - (file-exists-p (concat rebase-dir "interactive"))) - (rebase-state - (when rebase-dir - (if is-rebase-interactive - (egg-get-rebase-interactive-state rebase-dir) - (egg-get-rebase-merge-state rebase-dir)))) - (state (nconc (list :gitdir git-dir - :head branch-full-name - :branch branch - :sha1 sha1 - :merge-heads merge-heads) - rebase-state)) - files) - (dolist (req extras) - (cond ((eq req :unstaged) - (setq files (egg-git-to-lines "diff" "--name-only")) - (setq state (nconc (list :unstaged files) state)) - (when (and files (stringp (car files))) - (setq state (nconc (list :unmerged (egg-unmerged-files)) - state)))) - ((eq req :staged) - (setq state - (nconc (list :staged - (egg-git-to-lines "diff" "--cached" - "--name-only")) - state))))) - ;; update mode-line - (egg-set-mode-info state) - state)) - -(defsubst egg-repo-state (&rest args) - "return the cached repo state or re-read it. -if ARGS contained :force then ignore the cached state." - (or (unless (memq :force args) egg-internal-current-state) - (egg-get-repo-state args))) - -(defsubst egg-repo-clean (&optional state) - "Whether the current repos is clean base on the current repo state. -use STATE as repo state if it was not nil. Otherwise re-read the repo state." - (unless state - (setq state (egg-repo-state :staged :unstaged))) - (and - (null (plist-get state :rebase-num)) - (null (plist-get state :merge-heads)) - (not (if (memq :unstaged state) - (plist-get state :unstaged) - (egg-wdir-clean))) - (not (if (memq :staged state) - (plist-get state :staged) - (egg-index-empty))))) - -(defsubst egg-current-branch (&optional state) - "The current symbolic value of HEAD. i.e. name of a branch. if STATE -was not nil then use it as repo state instead of re-read from disc." - (plist-get (or state (egg-repo-state)) :branch)) - -(defsubst egg-current-sha1 (&optional state) - "The immutable sha1 of HEAD. if STATE was not nil then use it -as repo state instead of re-read from disc." - (plist-get (or state (egg-repo-state)) :sha1)) - -(defsubst egg-head (&optional state) - "a cons cell (branch . sha1) of HEAD. if STATE was not nil then use it -as repo state instead of re-read from disc." - (if (egg-git-dir) - (let ((state (or state (egg-repo-state)))) - (cons (egg-current-sha1 state) - (egg-current-branch state))))) - -(defun egg-pretty-head-string (&optional state) - "Pretty description of HEAD. if STATE was not nil then use it -as repo state instead of re-read from disc." - (let* ((state (or state (egg-repo-state))) - (branch (plist-get state :branch)) - (merge-heads (plist-get state :merge-heads)) - (rebase-head (plist-get state :rebase-head)) - (rebase-upstream (plist-get state :rebase-upstream)) - (sha1 (plist-get state :sha1))) - (cond ((and branch merge-heads) - (concat "Merging to " branch " from: " - (mapconcat 'identity merge-heads ","))) - (merge-heads - (concat "Merging to " (egg-name-rev sha1) " from: " - (mapconcat 'identity merge-heads ","))) - ((and rebase-head rebase-upstream) - (format "Rebasing %s onto %s" rebase-head rebase-upstream)) - (branch branch) - (t (concat "Detached HEAD: " (egg-describe-rev sha1)))))) - -(defsubst egg-pretty-head-name (&optional state) - "Pretty name for HEAD. if STATE was not nil then use it -as repo state instead of re-read from disc." - (let* ((state (or state (egg-repo-state))) - (branch (plist-get state :branch))) - (or branch (egg-describe-rev (plist-get state :sha1))))) - - -(defsubst egg-config-section-raw (type &optional name) - (egg-pick-file-contents (concat (egg-git-dir) "/config") - (concat "^" - (if name - (format "\\[%s \"%s\"\\]" type name) - (format "\\[%s\\]" type)) - "\n" - "\\(\\(?:\t.+\n\\)+\\)") - 1)) - -(defsubst egg-config-section (type &optional name) - (save-match-data - (mapcar - (lambda (line) - (split-string line "[ =]+" t)) - (split-string (or (egg-config-section-raw type name) "") - "[\t\n]+" t)))) - -(defun egg-config-get-all (file type) - (interactive "fFilename: ") - (save-match-data - (mapcar (lambda (rec) - (let ((key (car rec)) - (infos (cdr rec))) - (cons (progn (string-match "\"\\(.+\\)\"" key) - (match-string-no-properties 1 key)) - (mapcar (lambda (attr) - (split-string attr "[ =]+" t)) - infos)))) - (mapcar (lambda (str) - (split-string str "[\t\n]+" t)) - (egg-pick-file-records file - (concat "^\\[" type " \"") - "^\\[\\|\\'"))))) - -(defsubst egg-config-get-all-branches () - (egg-config-get-all (concat (egg-git-dir) "/config") "branch")) - -(defsubst egg-config-get-all-remotes () - (egg-config-get-all (concat (egg-git-dir) "/config") "remote")) - -(defsubst egg-config-get-all-remote-names () - (mapcar 'car (egg-config-get-all-remotes))) - -(defsubst egg-config-get (type attr &optional name) - (and (egg-git-dir) - (cadr (assoc attr (egg-config-section type name))))) - -(defun egg-tracking-target (branch &optional mode) - (let ((remote (egg-config-get "branch" "remote" branch)) - (rbranch (egg-config-get "branch" "merge" branch))) - (when (stringp rbranch) - (setq rbranch (egg-rbranch-name rbranch)) - (cond ((null mode) (concat remote "/" rbranch)) - ((eq :name-only mode) rbranch) - (t (cons rbranch remote)))))) - - -(defsubst egg-read-rev (prompt &optional default) - "Query user for a revision using PROMPT. DEFAULT is the default value." - (completing-read prompt 'egg-complete-rev nil nil default)) - -(defsubst egg-read-remote (prompt &optional default) - "Query user for a remote using PROMPT. DEFAULT is the default value." - (completing-read prompt (egg-config-get-all-remote-names) nil t default)) - -;;;======================================================== -;;; Async Git process -;;;======================================================== - -(defsubst egg-async-process () - (let* ((buffer (get-buffer-create "*egg-process*")) - (proc (get-buffer-process buffer))) - (if (and (processp proc) ;; is a process - (not (eq (process-status proc) 'exit)) ;; not finised - (= (process-exit-status proc) 0)) ;; still running - proc))) - -(defun egg-async-do (exit-code func-args args) - "Run GIT asynchronously with ARGS. -if EXIT code is an exit-code from GIT other than zero but considered -success." - (let ((dir (file-name-directory (egg-git-dir))) - (buf (get-buffer-create "*egg-process*")) - (inhibit-read-only inhibit-read-only) - (accepted-msg (and (integerp exit-code) - (format "exited abnormally with code %d" - exit-code))) - proc) - (setq proc (get-buffer-process buf)) - (when (and (processp proc) ;; is a process - (not (eq (process-status proc) 'exit)) ;; not finised - (= (process-exit-status proc) 0)) ;; still running - (error "EGG: %s is already running!" (process-command proc))) - (with-current-buffer buf - (setq inhibit-read-only t) - (setq default-directory dir) - ;;(erase-buffer) - (widen) - (goto-char (point-max)) - (insert "EGG-GIT-CMD:\n") - (insert (format "%S\n" args)) - (insert "EGG-GIT-OUTPUT:\n") - (setq proc (apply 'start-process "egg-git" buf egg-git-command args)) - (setq mode-line-process " git") - (when (and (consp func-args) (functionp (car func-args))) - (process-put proc :callback-func (car func-args)) - (process-put proc :callback-args (cdr func-args))) - (when (stringp accepted-msg) - (process-put proc :accepted-msg accepted-msg) - (process-put proc :accepted-code exit-code)) - (process-put proc :cmds (cons egg-git-command args)) - (set-process-sentinel proc #'egg-process-sentinel)) - proc)) - -(defsubst egg-async-0 (func-args &rest args) - (egg-async-do nil func-args args)) - -(defsubst egg-async-1 (func-args &rest args) - (egg-async-do 1 func-args args)) - -(defvar egg-async-process nil) -(defvar egg-async-cmds nil) -(defvar egg-async-exit-msg nil) - -(defun egg-process-sentinel (proc msg) - (let ((exit-code (process-get proc :accepted-code)) - (accepted-msg (process-get proc :accepted-msg)) - (callback-func (process-get proc :callback-func)) - (callback-args (process-get proc :callback-args)) - (cmds (process-get proc :cmds))) - (cond ((string= msg "finished\n") - (message "EGG: git finished.")) - ((string= msg "killed\n") - (message "EGG: git was killed.")) - ((and accepted-msg (string-match accepted-msg msg)) - (message "EGG: git exited with code: %d." exit-code)) - ((string-match "exited abnormally" msg) - (message "EGG: git failed.")) - (t (message "EGG: git is weird!"))) - (with-current-buffer (process-buffer proc) - (setq mode-line-process nil) - (widen) - (goto-char (point-max)) - (re-search-backward "^EGG-GIT-CMD:" nil t) - ;; Narrow to the last command - (narrow-to-region (point) (point-max)) - (if (functionp callback-func) - (let ((egg-async-process proc) - (egg-async-cmds cmds) - (egg-async-exit-msg msg)) - (apply callback-func callback-args)))))) - -;;;======================================================== -;;; Blame utils -;;;======================================================== - -(defconst egg-blame-map - (let ((map (make-sparse-keymap "Egg:Blame"))) - (define-key map (kbd "l") 'egg-blame-locate-commit) - (define-key map (kbd "RET") 'egg-blame-locate-commit) - (define-key map (kbd "q") 'egg-file-toggle-blame-mode) - map) - "Keymap for an annotated section.\\{egg-blame-map}") - - -(defun egg-parse-git-blame (target-buf blame-buf &optional ov-attributes) - "Parse blame-info in buffer BLAME-BUF and decorate TARGET-BUF buffer. -OV-ATTRIBUTES are the extra decorations for each blame chunk." - (save-match-data - (let ((blank (egg-text " " 'egg-blame)) - (nl (egg-text "\n" 'egg-blame)) - (commit-hash (make-hash-table :test 'equal :size 577)) - commit commit-info old-line new-line num old-file subject author - info ov beg end blame) - (with-current-buffer blame-buf - (goto-char (point-min)) - ;; search for a ful commit info - (while (re-search-forward "^\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)$" nil t) - (setq commit (match-string-no-properties 1) - old-line (string-to-number - (match-string-no-properties 2)) - new-line (string-to-number - (match-string-no-properties 3)) - num (string-to-number - (match-string-no-properties 4))) - ;; was this commit already seen (and stored in the hash)? - (setq commit-info (gethash commit commit-hash)) - ;; Nope, this is the 1st time, the full commit-info follow. - (unless commit-info - (re-search-forward "^author \\(.+\\)$") - (setq author (match-string-no-properties 1)) - (re-search-forward "^summary \\(.+\\)$") - (setq subject (match-string-no-properties 1)) - (re-search-forward "^filename \\(.+\\)$") - (setq old-file (match-string-no-properties 1)) - (setq commit-info (nconc - (list :sha1 commit :author author - :subject subject :file old-file) - ov-attributes)) - ;; save it in the hash - (puthash commit commit-info commit-hash)) - ;; add the current blame-block into the list INFO. - (setq info (cons (list old-line new-line num commit-info) - info)))) - ;; now do from beginning - (setq info (nreverse info)) - (with-current-buffer target-buf - ;; for every blame chunk - (dolist (chunk info) - (setq commit-info (nth 3 chunk) - old-line (nth 0 chunk) - new-line (nth 1 chunk) - num (nth 2 chunk) - commit (plist-get commit-info :sha1) - author (plist-get commit-info :author) - subject (plist-get commit-info :subject)) - - (goto-line new-line) - (setq beg (line-beginning-position) - end (save-excursion - (forward-line num) - (line-beginning-position))) - ;; mark the blame chunk - (put-text-property beg end :blame chunk) - - ;; make an overlay with blame info as 'before-string - ;; on the current chunk. - (setq ov (make-overlay beg end)) - (overlay-put ov :blame chunk) - (setq blame (concat - (egg-text (substring-no-properties commit 0 8) - 'egg-blame) - blank - (egg-text (format "%-20s" author) - 'egg-blame-culprit) - blank - (egg-text subject 'egg-blame-subject) - blank nl)) - (overlay-put ov 'before-string blame) - (overlay-put ov 'local-map egg-blame-map)))))) - -(defsubst egg-file-buffer-blame-off (buffer) - (save-excursion - (save-restriction - (with-current-buffer buffer - (widen) - (mapc (lambda (ov) - (if (overlay-get ov :blame) - (delete-overlay ov))) - (overlays-in (point-min) (point-max))))))) - -(defun egg-file-buffer-blame-on (buffer &rest ov-attributes) - (egg-file-buffer-blame-off buffer) - (save-excursion - (with-current-buffer buffer - (save-restriction - (with-temp-buffer - (when (egg-git-ok t "blame" "--porcelain" "--" - (file-name-nondirectory - (buffer-file-name buffer))) - (egg-parse-git-blame buffer (current-buffer) - ov-attributes))))))) - -(defun egg-blame-locate-commit (pos &optional all) - (interactive "d\nP") - "Jump to a commit in the branch history from an annotated blame section. - - With prefix argument, the history of all refs is used." - (let ((overlays (overlays-at pos)) - sha1) - (dolist (ov overlays) - (if (overlay-get ov :blame) - (setq sha1 (plist-get (nth 3 (overlay-get ov :blame)) :sha1)))) - (if sha1 - (let (commit-pos) - (egg-log all) - (setq commit-pos (point-min)) - (while (and commit-pos - (not (equal (get-text-property commit-pos :commit) sha1))) - (setq commit-pos (next-single-property-change commit-pos :commit))) - (if commit-pos - (progn - (egg-log-buffer-goto-pos commit-pos) - (recenter))))))) - -;;;======================================================== -;;; Diff/Hunk -;;;======================================================== - -(defun egg-mouse-do-command (event cmd) - (let* ((window (posn-window (event-end event))) - (buffer (and window (window-buffer window))) - (position (posn-point (event-end event)))) - (when (bufferp buffer) - (save-window-excursion - (save-excursion - (select-window window) - (with-current-buffer buffer - (goto-char position) - (call-interactively cmd))))))) - -(defun egg-mouse-hide-show-cmd (event) - (interactive "e") - (egg-mouse-do-command event 'egg-section-cmd-toggle-hide-show)) - -(defconst egg-hide-show-map - (let ((map (make-sparse-keymap "Egg:HideShow"))) - (define-key map (kbd "h") 'egg-section-cmd-toggle-hide-show) - (define-key map (kbd "H") 'egg-section-cmd-toggle-hide-show-children) - (define-key map [mouse-2] 'egg-mouse-hide-show-cmd) - map) - "Keymap for a section than can be hidden/shown.\\{egg-hide-show-map}") - -(defconst egg-section-map - (let ((map (make-sparse-keymap "Egg:Section"))) - (set-keymap-parent map egg-hide-show-map) - (define-key map (kbd "n") 'egg-buffer-cmd-navigate-next) - (define-key map (kbd "p") 'egg-buffer-cmd-navigate-prev) - map) - "Keymap for a section in sequence that can be navigated back and forth. -\\{egg-section-map}") - -(defconst egg-diff-section-map - (let ((map (make-sparse-keymap "Egg:Diff"))) - (set-keymap-parent map egg-section-map) - (define-key map (kbd "RET") 'egg-diff-section-cmd-visit-file-other-window) - (define-key map (kbd "f") 'egg-diff-section-cmd-visit-file) - (define-key map (kbd "=") 'egg-diff-section-cmd-ediff) - map) - "Keymap for a diff section in sequence of deltas. -\\{egg-diff-section-map}") - -(defconst egg-staged-diff-section-map - (let ((map (make-sparse-keymap "Egg:StagedDiff"))) - (set-keymap-parent map egg-diff-section-map) - (define-key map (kbd "=") 'egg-staged-section-cmd-ediff3) - (define-key map (kbd "s") 'egg-diff-section-cmd-unstage) - (define-key map [C-down-mouse-2] 'egg-status-popup-staged-diff-menu) - (define-key map [C-mouse-2] 'egg-status-popup-staged-diff-menu) - - map) - "Keymap for a diff section in sequence of staged deltas. -\\{egg-staged-diff-section-map}") - -(defconst egg-wdir-diff-section-map - (let ((map (make-sparse-keymap "Egg:WdirDiff"))) - (set-keymap-parent map egg-diff-section-map) - (define-key map (kbd "u") 'egg-diff-section-cmd-undo) - map) - "Keymap for a diff section in sequence of deltas between the workdir and -the index. \\{egg-wdir-diff-section-map}") - -(defconst egg-unstaged-diff-section-map - (let ((map (make-sparse-keymap "Egg:UnstagedDiff"))) - (set-keymap-parent map egg-wdir-diff-section-map) - (define-key map (kbd "=") 'egg-unstaged-section-cmd-ediff) - (define-key map (kbd "s") 'egg-diff-section-cmd-stage) - - (define-key map [C-down-mouse-2] 'egg-status-popup-unstaged-diff-menu) - (define-key map [C-mouse-2] 'egg-status-popup-unstaged-diff-menu) - - map) - "Keymap for a diff section in sequence of unstaged deltas. -\\{egg-unstaged-diff-section-map}") - -(defconst egg-unmerged-diff-section-map - (let ((map (make-sparse-keymap "Egg:UnmergedDiff"))) - (set-keymap-parent map egg-unstaged-diff-section-map) - (define-key map (kbd "=") 'egg-unmerged-section-cmd-ediff3) - map) - "Keymap for a diff section in sequence of unmerged deltas. -\\{egg-unmerged-diff-section-map}") - -(defconst egg-hunk-section-map - (let ((map (make-sparse-keymap "Egg:Hunk"))) - (set-keymap-parent map egg-section-map) - (define-key map (kbd "RET") 'egg-hunk-section-cmd-visit-file-other-window) - (define-key map (kbd "=") 'egg-diff-section-cmd-ediff) - (define-key map (kbd "f") 'egg-hunk-section-cmd-visit-file) - map) - "Keymap for a hunk in a diff section. \\{egg-hunk-section-map}") - -(defconst egg-staged-hunk-section-map - (let ((map (make-sparse-keymap "Egg:StagedHunk"))) - (set-keymap-parent map egg-hunk-section-map) - (define-key map (kbd "=") 'egg-staged-section-cmd-ediff3) - (define-key map (kbd "s") 'egg-hunk-section-cmd-unstage) - - (define-key map [C-down-mouse-2] 'egg-status-popup-staged-hunk-menu) - (define-key map [C-mouse-2] 'egg-status-popup-staged-hunk-menu) - - map) - "Keymap for a hunk in a staged diff section. -\\{egg-staged-hunk-section-map}") - -(defconst egg-wdir-hunk-section-map - (let ((map (make-sparse-keymap "Egg:WdirHunk"))) - (set-keymap-parent map egg-hunk-section-map) - (define-key map (kbd "u") 'egg-hunk-section-cmd-undo) - map) - "Keymap for a hunk in a diff section between the workdir and the index. -\\{egg-wdir-hunk-section-map}") - -(defconst egg-unstaged-hunk-section-map - (let ((map (make-sparse-keymap "Egg:UnstagedHunk"))) - (set-keymap-parent map egg-wdir-hunk-section-map) - (define-key map (kbd "=") 'egg-unstaged-section-cmd-ediff) - (define-key map (kbd "s") 'egg-hunk-section-cmd-stage) - - (define-key map [C-down-mouse-2] 'egg-status-popup-unstaged-hunk-menu) - (define-key map [C-mouse-2] 'egg-status-popup-unstaged-hunk-menu) - - map) - "Keymap for a hunk in a unstaged diff section. -\\{egg-unstaged-hunk-section-map}") - -(defconst egg-unmerged-hunk-section-map - (let ((map (make-sparse-keymap "Egg:UnmergedHunk"))) - ;; no hunking staging in unmerged file - (set-keymap-parent map egg-wdir-hunk-section-map) - (define-key map (kbd "=") 'egg-unmerged-section-cmd-ediff3) - map) - "Keymap for a hunk in a unmerged diff section. -\\{egg-unmerged-hunk-section-map}") - -(defun list-tp () - (interactive) - (message "tp: %S" (text-properties-at (point)))) - -(defun list-nav () - (interactive) - (message "nav: %c:%s-%c:%s" - (preceding-char) - (get-text-property (1- (point)) :navigation) - (following-char) - (get-text-property (point) :navigation))) - -(defsubst egg-navigation-at-point () - (get-text-property (point) :navigation)) - -(defsubst egg-invisible-spec-at-point () - (get-text-property (point) 'invisible)) - -(defsubst egg-hunk-at-point () - (get-text-property (point) :hunk)) - -(defsubst egg-diff-at-point () - (get-text-property (point) :diff)) - -(defsubst egg-point-in-section (section-id) - (eq (get-text-property (point) :section) section-id)) - -(defsubst egg-safe-search (re limit &optional no) - (save-excursion - (save-match-data - (and (re-search-forward re limit t) - (match-beginning (or no 0)))))) - -(defsubst egg-safe-search-pickup (re &optional limit no) - (save-excursion - (save-match-data - (and (re-search-forward re limit t) - (match-string-no-properties (or no 0)))))) - -(defsubst egg-decorate-diff-header (beg end line-beg line-end) - (put-text-property line-beg (1+ beg) - 'display - (egg-text - (concat "\n" - (buffer-substring-no-properties beg - (1+ beg))) - 'egg-diff-file-header)) - (put-text-property (1+ beg) end 'face 'egg-diff-file-header) - (put-text-property (1+ beg) end 'help-echo (egg-tooltip-func))) - -(defsubst egg-decorate-cc-diff-header (beg end line-beg line-end) - (put-text-property line-beg (1+ beg) - 'display - (egg-text - (concat "\n" - (buffer-substring-no-properties beg - (1+ beg))) - 'egg-unmerged-diff-file-header)) - (put-text-property (1+ beg) end 'face 'egg-unmerged-diff-file-header) - (put-text-property (1+ beg) end 'help-echo (egg-tooltip-func))) - -(defsubst egg-decorate-diff-index-line (beg end line-beg line-end) - (put-text-property (1- line-beg) beg 'display " -- ") - (put-text-property beg end 'face 'egg-diff-none)) - -(defsubst egg-decorate-hunk-header (beg end line-beg line-end) - (put-text-property beg end 'face 'egg-diff-hunk-header) - (put-text-property end line-end 'face 'egg-diff-none) - (put-text-property beg end 'help-echo (egg-tooltip-func))) - -(defvar egg-internal-buffer-obarray nil) - -(defsubst egg-make-navigation (parent child) - "Make a symbolic and unique navigation id. -return a symbol PARENT-CHILD from an internal obarray." - (unless (vectorp egg-internal-buffer-obarray) - (error "Arrg! egg-internal-buffer-obarray is not an obarray!")) - (intern (format "%s-%s" parent child) egg-internal-buffer-obarray)) - -(defsubst egg-do-compute-navigation (section pos) - "Come up with a symbolic and unique navigation id for -section SECTION at position POS." - (egg-make-navigation (get-text-property pos :navigation) - (if (consp section) - (car section) - section))) - -(defun egg-compute-navigation (ignored-1 section pos ignored-2) - "Come up with a symbolic and unique navigation id for -section SECTION at position POS." - (egg-do-compute-navigation section pos)) - -(defun egg-delimit-section (sect-type section beg end - &optional inv-beg - keymap navigation) - "Mark section for navigation and add local/context keymap. -SECT-TYPE is the type of the section (usually a :symbol). -SECTION is the name of the section (usually a string). BEG and -END are limits of the section. INV-BEG is the position after the -position that would remain visible when the section is hidden. -KEYMAP is the local/context keymap for the section. -NAVIGATION is the navigation id of the section. NAVIGATION can also -a function to call to compute the navigation id of the section." - (let ((nav (cond ((functionp navigation) - (funcall navigation sect-type section beg end)) - ((null navigation) beg) - (t navigation)))) - (put-text-property beg end :sect-type sect-type) - (put-text-property beg end sect-type section) - (put-text-property beg end :navigation nav) - (when (keymapp keymap) - (put-text-property beg end 'keymap keymap)) - (when (integer-or-marker-p inv-beg) - (let ((current-inv (get-text-property inv-beg 'invisible))) - (add-to-list 'current-inv nav t) - (put-text-property inv-beg (1- end) 'invisible current-inv))))) - -(defsubst egg-make-hunk-info (name beg end diff) - "Build a hunk info NAME from BEG to END based on DIFF. -Hunk info contains name and posistions of the hunk. Positions are offsets -from DIFF because it can the whole diff can be pushed around inside -the buffer." - (let ((b (nth 1 diff))) - (list name (- beg b) (- end b)))) - -(defsubst egg-make-diff-info (name beg end head-end) - "Build a diff info NAME from BEG to END. HEAD-END is the end position -of the diff header. - -Diff info contains name and posistions of the diff. The beginning position -is stored as a marker and the others are offset from the beginning posistion - because the whole diff can be pushed around inside the buffer." - (let ((b (make-marker))) - (set-marker b beg) - ;; no insertion indo the diff - (set-marker-insertion-type b t) - ;; all other posistions are offsets from B. - (list name b (- end beg) (- head-end beg)))) - -(defun egg-decorate-diff-sequence (args) - "Decorate a sequence of deltas. ARGS is a plist containing the -positions of the sequence as well as the decorations. - -:begin :end :diff-map :hunk-map :cc-diff-map :cc-hunk-map -:conflict-map :src-prefix :dst-prefix -" - (let* ((beg (plist-get args :begin)) - (end (plist-get args :end)) - (diff-map (plist-get args :diff-map)) - (hunk-map (plist-get args :hunk-map)) - (cc-diff-map (plist-get args :cc-diff-map)) - (cc-hunk-map (plist-get args :cc-hunk-map)) - (conflict-map (plist-get args :conflict-map)) - (a (plist-get args :src-prefix)) - (b (plist-get args :dst-prefix)) - - ;; the sub match id of the regexp below - (diff-no 1) - (cc-diff-no 2) - (hunk-no 3) - (cc-hunk-no 4) - (src-no 5) - (dst-no 6) - (index-no 7) - (conf-beg-no 8) - (conf-div-no 9) - (conf-end-no 10) - (del-no 11) - (add-no 12) - (none-no 13) - - (regexp - (concat "^\\(?:" - "diff --git " a ".+" b "\\(.+\\)\\|" ;1 diff header - "diff --cc \\(.+\\)\\|" ;2 cc-diff header - "\\(@@ .+@@\\).*\\|" ;3 hunk - "\\(@@@ .+@@@\\).*\\|" ;4 cc-hunk - "--- " a "\\(.+\\)\\|" ;5 src - "\\+\\+\\+ " b "\\(.+\\)\\|" ;6 dst - "index \\(.+\\)\\|" ;7 index - "\\+\\+<<<<<<< \\(.+\\):.+\\|" ;8 conflict start - "\\(\\+\\+=======\\)\\|" ;9 conflict div - "\\+\\+>>>>>>> \\(.+\\):.+\\|" ;10 conflict end - "\\(-.*\\)\\|" ;11 del - "\\(\\+.*\\)\\|" ;12 add - "\\( .*\\)" ;13 none - "\\)$")) - - ;; where the hunk end? - (hunk-end-re "^\\(?:diff\\|@@\\)") - ;; where the diff end? - (diff-end-re "^diff ") - - sub-beg sub-end head-end m-b-0 m-e-0 m-b-x m-e-x - last-diff last-cc) - - (save-match-data - (save-excursion - (goto-char beg) - (while (re-search-forward regexp end t) - (setq sub-beg (match-beginning 0) - m-b-0 sub-beg - m-e-0 (match-end 0)) - (cond ((match-beginning del-no) ;; del - (put-text-property m-b-0 m-e-0 'face 'egg-diff-del)) - - ((match-beginning add-no) ;; add - (put-text-property m-b-0 m-e-0 'face 'egg-diff-add)) - - ((match-beginning none-no) ;; unchanged - (put-text-property m-b-0 m-e-0 'face 'egg-diff-none)) - - ((match-beginning dst-no) ;; +++ b/file - (setq m-b-x (match-beginning dst-no) - m-e-x (match-end dst-no)) - (put-text-property m-b-0 m-b-x 'face 'egg-diff-add) - (put-text-property m-b-x m-e-x 'face 'egg-diff-none)) - - ((match-beginning src-no) ;; --- a/file - (setq m-b-x (match-beginning src-no) - m-e-x (match-end src-no)) - (put-text-property m-b-0 m-b-x 'face 'egg-diff-del) - (put-text-property m-b-x m-e-x 'face 'egg-diff-none)) - - ((match-beginning conf-beg-no) ;;++<<<<<<< - (setq m-b-x (match-beginning conf-beg-no) - m-e-x (match-end conf-beg-no)) - (put-text-property m-b-0 m-b-x 'face 'egg-diff-conflict) - (put-text-property m-b-x m-e-x 'face 'egg-branch-mono) - (put-text-property m-e-x m-e-0 'face 'egg-diff-none) - ;; mark the whole conflict section - (setq sub-end (egg-safe-search "^++>>>>>>>.+$" end)) - (put-text-property m-b-0 sub-end 'keymap - conflict-map)) - - ((match-beginning conf-end-no) - (setq m-b-x (match-beginning conf-end-no) - m-e-x (match-end conf-end-no)) - ;; just decorate, no mark. - ;; the section was already mark when the conf-beg-no - ;; matched. - (put-text-property m-b-0 m-b-x 'face 'egg-diff-conflict) - (put-text-property m-b-x m-e-x 'face 'egg-branch-mono) - (put-text-property m-e-x m-e-0 'face 'egg-diff-none)) - - ((match-beginning conf-div-no) ;;++======= - ;; just decorate, no mark. - ;; the section was already mark when the conf-beg-no - ;; matched. - (put-text-property m-b-0 m-e-0 'face 'egg-diff-conflict)) - - ((match-beginning hunk-no) ;; hunk @@ - (setq m-b-x (match-beginning hunk-no) - m-e-x (match-end hunk-no) - ;; find the end of the hunk section - sub-end (or (egg-safe-search hunk-end-re end) - end)) - ;; decorate the header - (egg-decorate-hunk-header m-b-x m-e-x m-b-0 m-e-0) - ;; mark the whole hunk based on the last diff header - (egg-delimit-section - :hunk (egg-make-hunk-info - (match-string-no-properties hunk-no) - sub-beg sub-end last-diff) - sub-beg sub-end m-e-0 hunk-map - 'egg-compute-navigation)) - - ((match-beginning cc-hunk-no) ;; cc-hunk - (setq m-b-x (match-beginning cc-hunk-no) - m-e-x (match-end cc-hunk-no) - ;; find the end of the hunk section - sub-end (or (egg-safe-search hunk-end-re end) - end)) - ;; decorate the header - (egg-decorate-hunk-header m-b-x m-e-x m-b-0 m-e-0) - ;; mark the whole hunk based on the last cc-diff header - (egg-delimit-section - :hunk (egg-make-hunk-info - (match-string-no-properties cc-hunk-no) - sub-beg sub-end last-cc) - sub-beg sub-end m-e-0 cc-hunk-map - 'egg-compute-navigation)) - - ((match-beginning diff-no) ;; diff - (setq m-b-x (match-beginning diff-no) - m-e-x (match-end diff-no) - sub-end (or (egg-safe-search diff-end-re end) end) - ;; find the end of the header - head-end (or (egg-safe-search "^@@" end) end)) - ;; decorate the header - (egg-decorate-diff-header m-b-x m-e-x m-b-0 m-e-0) - ;; mark the whole diff - (egg-delimit-section - :diff (setq last-diff - (egg-make-diff-info - (match-string-no-properties diff-no) - sub-beg sub-end head-end)) - sub-beg sub-end m-e-0 diff-map 'egg-compute-navigation)) - - ((match-beginning cc-diff-no) ;; cc-diff - (setq m-b-x (match-beginning cc-diff-no) - m-e-x (match-end cc-diff-no) - sub-end (or (egg-safe-search diff-end-re end) end) - ;; find the end of the header - head-end (or (egg-safe-search "^@@@" end) end)) - ;; decorate the header - (egg-decorate-cc-diff-header m-b-x m-e-x m-b-0 m-e-0) - ;; mark the whole diff - (egg-delimit-section - :diff (setq last-cc - (egg-make-diff-info - (match-string-no-properties cc-diff-no) - sub-beg sub-end head-end)) - sub-beg sub-end m-e-0 cc-diff-map - 'egg-compute-navigation)) - - ((match-beginning index-no) ;; index - (setq m-b-x (match-beginning index-no) - m-e-x (match-end index-no)) - (egg-decorate-diff-index-line m-b-x m-e-x m-b-0 m-b-0)) - ) ;; cond - ) ;; while - ) ;; save-excursion - ) ;;; save -match-data - - nil)) - -(defun egg-decorate-diff-section (&rest args) - "Decorate a section containing a sequence of diffs. -See `egg-decorate-diff-sequence'." - (let ((beg (plist-get args :begin)) - (end (plist-get args :end)) - (a (or (plist-get args :src-prefix) "a/")) - (b (or (plist-get args :dst-prefix) "b/")) - (a-rev (plist-get args :src-revision)) - (b-rev (plist-get args :dst-revision))) - (when (stringp a-rev) - (put-text-property beg end :src-revision a-rev)) - (when (stringp b-rev) - (put-text-property beg end :dst-revision b-rev)) - (egg-decorate-diff-sequence - (nconc (list :src-prefix a :dst-prefix b) args)))) - -(defun egg-diff-section-cmd-visit-file (file) - "Visit file FILE." - (interactive (list (car (get-text-property (point) :diff)))) - (find-file file)) - -(defun egg-diff-section-cmd-visit-file-other-window (file) - "Visit file FILE in other window." - (interactive (list (car (get-text-property (point) :diff)))) - (find-file-other-window file)) - -(defun egg-unmerged-section-cmd-ediff3 (file) - "Run ediff3 to resolve merge conflicts in FILE." - (interactive (list (car (get-text-property (point) :diff)))) - (find-file file) - (egg-resolve-merge-with-ediff)) - -(defun egg-unstaged-section-cmd-ediff (file) - "Compare FILE and its staged copy using ediff." - (interactive (list (car (get-text-property (point) :diff)))) - (find-file file) - (egg-file-do-ediff ":0" "INDEX")) - -(defun egg-staged-section-cmd-ediff3 (file) - "Compare the staged copy of FILE and the version in HEAD using ediff." - (interactive (list (car (get-text-property (point) :diff)))) - (find-file file) - (egg-file-do-ediff ":0" "INDEX" "HEAD")) - -(defvar egg-diff-buffer-info nil) - -(defun egg-diff-section-cmd-ediff (file pos) - "Ediff src and dest versions of FILE based on the diff at POS." - (interactive (list (car (get-text-property (point) :diff)) - (point))) - (let ((commit (get-text-property pos :commit)) - (diff-info egg-diff-buffer-info) - src src-name dst commit) - (find-file file) - (cond (commit - (setq src (egg-describe-rev (concat commit "^")) - dst (egg-describe-rev commit))) - ((setq src (plist-get diff-info :src-revision)) - (setq src (egg-describe-rev src))) - ((setq src (and diff-info ":0")) - (setq src-name "INDEX"))) - (unless src (error "Ooops!")) - (egg-file-do-ediff src src-name dst nil 'ediff2))) - -(defun egg-hunk-compute-line-no (hunk-header hunk-beg) - "Calaculate the effective line number in the original file based -on the position of point in a hunk. HUNK-HEADER is the header and -HUNK-BEG is the starting position of the current hunk." - (let ((limit (line-end-position)) - (line (string-to-number - (nth 2 (save-match-data - (split-string hunk-header "[ @,\+,-]+" t))))) - (adjust 0)) - (save-excursion - (goto-char hunk-beg) - (forward-line 1) - (end-of-line) - (if (< (point) limit) - (while (re-search-forward "^\\(?:\\+\\| \\).*" limit t) - (setq adjust (1+ adjust))))) - (+ line adjust))) - -(defsubst egg-hunk-info-at (pos) - "Rebuild the hunk info at POS. -Hunk info are relative offsets. This function compute the -physical offsets." - (let* ((diff-info (get-text-property pos :diff)) - (head-beg (nth 1 diff-info)) - (hunk-info (get-text-property pos :hunk)) - (hunk-beg (+ (nth 1 hunk-info) head-beg)) - (hunk-end (+ (nth 2 hunk-info) head-beg))) - (list (car diff-info) (car hunk-info) hunk-beg hunk-end))) - -(defun egg-hunk-section-cmd-visit-file (file hunk-header hunk-beg - &rest ignored) - "Visit FILE and goto the current line of the hunk." - (interactive (egg-hunk-info-at (point))) - (let ((line (egg-hunk-compute-line-no hunk-header hunk-beg))) - (find-file file) - (goto-line line))) - -(defun egg-hunk-section-cmd-visit-file-other-window (file hunk-header hunk-beg - &rest ignored) - "Visit FILE in other-window and goto the current line of the hunk." - (interactive (egg-hunk-info-at (point))) - (let ((line (egg-hunk-compute-line-no hunk-header hunk-beg))) - (find-file-other-window file) - (goto-line line))) - -(defun egg-section-cmd-toggle-hide-show (nav) - "Toggle the hidden state of the current navigation section of type NAV." - (interactive (list (get-text-property (point) :navigation))) - - ;; emacs's bug? caused by tooltip - (if (eq buffer-invisibility-spec t) - (setq buffer-invisibility-spec nil)) - - (if (assoc nav buffer-invisibility-spec) - (remove-from-invisibility-spec (cons nav t)) - (add-to-invisibility-spec (cons nav t))) - (force-window-update (current-buffer))) - -(defun egg-section-cmd-toggle-hide-show-children (pos sect-type) - "Toggle the hidden state of the subsections of the current navigation section at POS." - (interactive (list (previous-single-property-change (1+ (point)) - :navigation) - (get-text-property (point) :sect-type))) - (unless pos - (setq pos (point))) - (let ((end (next-single-property-change pos sect-type nil (point-max))) - child-pos child-nav - currently-hidden) - ;; guess the current state - (setq child-pos (next-single-property-change pos :navigation nil end)) - (when child-pos - (setq child-nav (get-text-property child-pos :navigation)) - (setq currently-hidden (and child-nav - (assoc child-nav - buffer-invisibility-spec)))) - (setq child-pos pos) - ;; toggle every child - (while (< (setq child-pos (next-single-property-change child-pos :navigation nil end)) - end) - (setq child-nav (get-text-property child-pos :navigation)) - (if currently-hidden - (remove-from-invisibility-spec (cons child-nav t)) - (add-to-invisibility-spec (cons child-nav t)))) - (force-window-update (current-buffer)))) - -(defun egg-diff-section-patch-string (&optional pos) - "Build a file patch based on the diff section at POS." - (let* ((diff-info (get-text-property (or pos (point)) :diff)) - (beg (nth 1 diff-info)) - (end (+ (nth 2 diff-info) beg))) - (buffer-substring-no-properties beg end))) - -(defun egg-hunk-section-patch-string (&optional pos reverse) - "Build a single hunk patch based on the delta hunk at POS." - (let* ((diff-info (get-text-property (or pos (point)) :diff)) - (head-beg (nth 1 diff-info)) - (head-end (+ (nth 3 diff-info) head-beg)) - (hunk-info (get-text-property (or pos (point)) :hunk)) - (hunk-beg (+ (nth 1 hunk-info) head-beg)) - (hunk-end (+ (nth 2 hunk-info) head-beg))) - ;; craete diff patch - (if (egg-use-region-p) - (egg-hunk-section-patch-region-string pos diff-info reverse) - (concat (buffer-substring-no-properties head-beg head-end) - (buffer-substring-no-properties hunk-beg hunk-end))))) - -(defun egg-use-region-p () - (if (fboundp 'use-region-p) - (use-region-p) - (and transient-mark-mode mark-active))) - -(defun egg-insert-current-line-buffer (buf) - (egg-insert-string-buffer (egg-current-line-string) buf)) - -(defun egg-current-line-string () - (buffer-substring-no-properties - (line-beginning-position) (line-beginning-position 2))) - -(defun egg-insert-string-buffer (string buf) - (with-current-buffer buf - (insert string))) - -(defun egg-hunk-section-patch-region-string (pos diff-info reverse) - (let* ((head-beg (nth 1 diff-info)) - (head-end (+ (nth 3 diff-info) head-beg)) - (hunk-info (get-text-property (or pos (point)) :hunk)) - (hunk-beg (+ (nth 1 hunk-info) head-beg)) - (hunk-end (+ (nth 2 hunk-info) head-beg)) - (beg (region-beginning)) - (end (region-end)) - (hunk-buf (current-buffer))) - (with-temp-buffer - (let ((buf (current-buffer))) - (with-current-buffer hunk-buf - ;; insert header - (egg-insert-string-buffer - (buffer-substring-no-properties head-beg head-end) buf) - (goto-char hunk-beg) - ;; insert beginning of hunk - (egg-insert-current-line-buffer buf) - (forward-line) - (let ((copy-op (if reverse "+" "-"))) - (while (< (point) hunk-end) - (if (and (<= beg (point)) (< (point) end)) - (egg-insert-current-line-buffer buf) - (cond ((looking-at " ") - (egg-insert-current-line-buffer buf)) - ((looking-at copy-op) - (egg-insert-string-buffer - (concat - " " - (buffer-substring-no-properties - (+ (point) 1) (line-beginning-position 2))) buf)))) - (forward-line)))) - ;; with current buffer `buf' - (diff-fixup-modifs (point-min) (point-max)) - (buffer-string))))) - -;;;======================================================== -;;; Buffer -;;;======================================================== -(defvar egg-buffer-refresh-func nil) -(defvar egg-buffer-async-cmd-refresh-func nil) -(defvar egg-internal-update-index-timer nil) - -(defsubst egg-buffer-async-do (accepted-code &rest args) - "Run git asynchronously and refresh the current buffer on exit. -exit code ACCEPTED-CODE is considered a success." - (egg-async-do accepted-code - (cons (or egg-buffer-async-cmd-refresh-func - egg-buffer-refresh-func) - (list (current-buffer))) - args)) - -(defsubst egg-run-buffers-update-hook (&optional newly-read-state) - "Update all egg special buffers." - (let ((egg-internal-current-state - (or newly-read-state (egg-get-repo-state)))) - (run-hooks 'egg-buffers-refresh-hook))) - -(defun egg-buffer-cmd-refresh () - "Refresh the current egg special buffer." - (interactive) - (when (and (egg-git-dir) - (functionp egg-buffer-refresh-func)) - (funcall egg-buffer-refresh-func (current-buffer)) - (recenter))) - -(defun egg-buffer-cmd-next-block (nav-prop) - "Move to the next block indentified by text property NAV-PROP." - (goto-char (or (next-single-property-change (point) nav-prop) - (point)))) - -(defun egg-buffer-cmd-prev-block (nav-prop) - "Move to the previous block indentified by text property NAV-PROP." - (goto-char (previous-single-property-change (point) nav-prop - nil (point-min)))) - -(defun egg-buffer-cmd-navigate-next () - "Move to the next section." - (interactive) - (egg-buffer-cmd-next-block :navigation)) - -(defun egg-buffer-cmd-navigate-prev () - "Move to the previous section." - (interactive) - (egg-buffer-cmd-prev-block :navigation)) - -(defconst egg-buffer-mode-map - (let ((map (make-sparse-keymap "Egg:Buffer"))) - (define-key map (kbd "q") 'egg-quit-buffer) - (define-key map (kbd "g") 'egg-buffer-cmd-refresh) - (define-key map (kbd "n") 'egg-buffer-cmd-navigate-next) - (define-key map (kbd "p") 'egg-buffer-cmd-navigate-prev) - map) - "Common map for an egg special buffer.\\{egg-buffer-mode-map}" ) - -(defun egg-get-buffer (fmt create) - "Get a special egg buffer. If buffer doesn't exist and CREATE was not nil then -creat the buffer. FMT is used to construct the buffer name. The name is built as: -(format FMT current-dir-name git-dir-full-path)." - (let* ((git-dir (egg-git-dir)) - (dir (file-name-directory git-dir)) - (dir-name (file-name-nondirectory - (directory-file-name dir))) - (buf-name (format fmt dir-name git-dir)) - (default-directory dir) - (buf (get-buffer buf-name))) - (unless (or (bufferp buf) (not create)) - (setq buf (get-buffer-create buf-name))) - buf)) - -(defvar egg-orig-window-config nil) - -(defun egg-quit-buffer (&optional win) - "Leave (and burry) an egg special buffer" - (interactive) - (let ((orig-win-cfg egg-orig-window-config) - (mode major-mode)) - (quit-window (memq 'kill (cdr (assq mode egg-quit-window-actions))) win) - (if (and orig-win-cfg - (window-configuration-p orig-win-cfg) - (memq 'restore-windows (cdr (assq mode egg-quit-window-actions)))) - (set-window-configuration orig-win-cfg)))) - -(defmacro define-egg-buffer (type name-fmt &rest body) - "Define an egg-special-file type." - (let* ((type-name (symbol-name type)) - (get-buffer-sym (intern (concat "egg-get-" type-name "-buffer"))) - (buffer-mode-sym (intern (concat "egg-" type-name "-buffer-mode"))) - (buffer-mode-hook-sym (intern (concat "egg-" type-name "-buffer-mode-hook"))) - (buffer-mode-map-sym (intern (concat "egg-" type-name "-buffer-mode-map"))) - (update-buffer-no-create-sym (intern (concat "egg-update-" type-name "-buffer-no-create")))) - `(progn - (defun ,buffer-mode-sym () - ,@body - (set (make-local-variable 'egg-orig-window-config) - (current-window-configuration)) - ;; (message "buffer %s win-cfg %s" (buffer-name) egg-orig-window-config) - (set (make-local-variable 'egg-internal-buffer-obarray) - (make-vector 67 0))) - - (defun ,get-buffer-sym (&optional create) - (let ((buf (egg-get-buffer ,name-fmt create))) - (when (bufferp buf) - (with-current-buffer buf - (unless (eq major-mode ',buffer-mode-sym) - (,buffer-mode-sym)))) - buf)) - ,(unless (string-match ":" type-name) - `(progn - (defun ,update-buffer-no-create-sym () - (let ((buf (,get-buffer-sym))) - (when (bufferp buf) - (with-current-buffer buf - (when (functionp egg-buffer-refresh-func) - (funcall egg-buffer-refresh-func buf)))))) - (add-hook 'egg-buffers-refresh-hook ',update-buffer-no-create-sym)))))) - - -;; (cl-macroexpand '(define-egg-buffer diff "*diff-%s@egg:%s*")) -;; (cl-macroexpand ' (define-egg-buffer diff (buf) "*diff-%s@egg:%s*" (show-diff buf) )) - - - -;;;======================================================== -;;; Status Buffer -;;;======================================================== -(defconst egg-status-buffer-mode-map - (let ((map (make-sparse-keymap "Egg:StatusBuffer"))) - (set-keymap-parent map egg-buffer-mode-map) - (define-key map (kbd "c") 'egg-commit-log-edit) - (define-key map (kbd "o") 'egg-checkout-ref) - (define-key map (kbd "l") 'egg-log) - (define-key map (kbd "w") 'egg-buffer-stash-wip) - (define-key map (kbd "L") 'egg-reflog) - (define-key map (kbd "S") 'egg-stage-all-files) - (define-key map (kbd "d") 'egg-diff-ref) - map) - "Keymap for the status buffer.\\{egg-status-buffer-mode-map}") - -(defconst egg-status-buffer-rebase-map - (let ((map (make-sparse-keymap "Egg:StatusBufferRebase"))) - (set-keymap-parent map egg-section-map) - (define-key map (kbd "x") 'egg-buffer-rebase-abort) - (define-key map (kbd "u") 'egg-buffer-selective-rebase-skip) - (define-key map (kbd "RET") 'egg-buffer-selective-rebase-continue) - map) - "Context keymap for the repo section of the status buffer when - rebase is in progress.\\{egg-status-buffer-rebase-map}") - -(defun egg-buffer-do-rebase (upstream-or-action - &optional old-base prompt) - "Perform rebase action from an egg special buffer. -See `egg-do-rebase-head'." - (let ((git-dir (egg-git-dir)) - modified-files res) - (if (stringp upstream-or-action) - (unless (egg-repo-clean) - (egg-status) - (error "Repo %s is not clean" git-dir)) - (unless (file-directory-p (concat git-dir "/" egg-git-rebase-subdir)) - (error "No rebase in progress in directory %s" - (file-name-directory git-dir)))) - (setq res (egg-do-rebase-head upstream-or-action old-base prompt)) - (setq modified-files (plist-get res :files)) - (if modified-files - (egg-revert-visited-files modified-files)) - (message "GIT-REBASE> %s" (plist-get res :message)) - (plist-get res :success))) - -(defun egg-buffer-rebase-continue () - "Continue the current rebase session." - (interactive) - (message "continue with current rebase") - (unless (egg-buffer-do-rebase :continue) - (egg-status))) - -(defsubst egg-do-async-rebase-continue (callback closure &optional - action - exit-code) - "Continue the current rebase session asynchronously." - (let ((process-environment process-environment) - (action (or action "--continue")) - (buffer (current-buffer)) - proc) - (setenv "EDITOR" "\nplease commit in egg") - (setq proc (egg-async-1 (list callback closure) "rebase" action)) - (process-put proc :orig-buffer buffer) - proc)) - -(defun egg-buffer-selective-rebase-action (action) - "Perform ACTION to continue the current rebase session. -The mode, sync or async, will depend on the nature of the current -rebase session." - (if (not (egg-interactive-rebase-in-progress)) - (unless (egg-buffer-do-rebase action) - (egg-status)) - (setq action (cdr (assq action '((:skip . "--skip") - (:continue . "--continue") - (:abort . "--abort"))))) - (egg-do-async-rebase-continue - #'egg-handle-rebase-interactive-exit - (egg-pick-file-contents (concat (egg-git-rebase-dir) "head") "^.+$") - action))) - -(defun egg-buffer-selective-rebase-continue () - "Continue the current rebase session. -The mode, sync or async, will depend on the nature of the current -rebase session." - (interactive) - (message "continue with current rebase") - (egg-buffer-selective-rebase-action :continue)) - -(defun egg-buffer-selective-rebase-skip () - "Skip the current commit and continue the current rebase session. -The mode, sync or async, will depend on the nature of the current -rebase session." - (interactive) - (message "skip rebase's current commit") - (egg-buffer-selective-rebase-action :skip)) - -(defun egg-buffer-rebase-skip () - (interactive) - (message "skip rebase's current commit") - (unless (egg-buffer-do-rebase :skip) - (egg-status))) - -(defun egg-buffer-rebase-abort () - (interactive) - (message "abort current rebase") - (egg-buffer-do-rebase :abort) - (egg-status)) - -(defun egg-rebase-in-progress () - (plist-get (egg-repo-state) :rebase-step)) - -(defsubst egg-pretty-help-text (&rest strings) - "Perform key bindings substitutions and highlighting in STRINGS." - (let* ((map (current-local-map)) last-found) - (with-temp-buffer - (use-local-map map) - (save-match-data - ;; key substitutions - (insert (substitute-command-keys - (mapconcat 'identity strings ""))) - (goto-char (point-min)) - ;; key highlighting - (while (re-search-forward "\\(\\<[^\n \t:]+\\|[/+.~*=-]\\):" nil t) - (put-text-property (match-beginning 1) (match-end 1)'face 'egg-help-key) - (if last-found - (put-text-property last-found (1- (match-beginning 0)) - 'face 'egg-text-help)) - (setq last-found (point))) - (if last-found - (put-text-property last-found (line-end-position) 'face 'egg-text-help)) - ;; return the total - (buffer-string))))) - -(defconst egg-status-buffer-common-help-text - (concat - (egg-text "Common Key Bindings:" 'egg-help-header-2) - (egg-pretty-help-text - "\\\n" - "\\[egg-buffer-cmd-navigate-prev]:previous block " - "\\[egg-buffer-cmd-navigate-next]:next block " - "\\[egg-commit-log-edit]:commit staged modifications " - "\\[egg-log]:show repo's history\n" - "\\[egg-stage-all-files]:stage all modifications " - "\\[egg-diff-ref]:diff other repos " - "\\" - "\\[egg-section-cmd-toggle-hide-show]:hide/show block " - "\\[egg-section-cmd-toggle-hide-show-children]:hide sub-blocks \n" - "\\" - "\\[egg-buffer-cmd-refresh]:redisplay " - "\\[egg-quit-buffer]:quit\n"))) - -(defconst egg-status-buffer-rebase-help-text - (concat - (egg-text "Key Bindings for Rebase Operations:" 'egg-help-header-2) - (egg-pretty-help-text - "\\\n" - "\\[egg-buffer-selective-rebase-continue]:resume rebase " - "\\[egg-buffer-selective-rebase-skip]:skip this rebase step " - "\\[egg-buffer-rebase-abort]:abort current rebase session\n"))) - -(defconst egg-status-buffer-diff-help-text - (concat - (egg-text "Extra Key Bindings for the Diff Sections:" - 'egg-help-header-2) - (egg-pretty-help-text - "\\\n" - "\\[egg-diff-section-cmd-visit-file-other-window]:visit file/line " - "\\[egg-diff-section-cmd-stage]:stage/unstage file/hunk/selected area " - "\\[egg-diff-section-cmd-undo]:undo file/hunk's modifications\n"))) - -(defun egg-sb-insert-repo-section () - "Insert the repo section into the status buffer." - (let* ((state (egg-repo-state)) - (sha1 (plist-get state :sha1)) - (beg (point)) - (map egg-section-map) - (rebase-step (plist-get state :rebase-step)) - (rebase-num (plist-get state :rebase-num)) - inv-beg help-beg help-inv-beg rebase-beg) - - (unless (and sha1 state) - (error "Invalid repo state: sha1 = %s, state = %S" - sha1 state)) - - ;; head, sha1 and git-dir - (insert (egg-text (egg-pretty-head-string state) 'egg-branch) "\n" - (egg-text sha1 'font-lock-string-face) "\n" - (egg-text (plist-get state :gitdir) 'font-lock-constant-face) - "\n") - ;; invisibility start at the newline - (setq inv-beg (1- (point))) - (when rebase-step - ;; Rebase info and keybindings - (insert (format "Rebase: commit %s of %s\n" rebase-step rebase-num)) - (setq map egg-status-buffer-rebase-map)) - (when (memq :status egg-show-key-help-in-buffers) - ;; Help - (insert "\n") - (setq help-beg (point)) - (insert (egg-text "Help" 'egg-help-header-1) "\n") - (put-text-property help-beg (point) 'help-echo (egg-tooltip-func)) - (setq help-inv-beg (1- (point))) - (insert egg-status-buffer-common-help-text) - (when (eq egg-status-buffer-rebase-map map) - (insert egg-status-buffer-rebase-help-text)) - (insert egg-status-buffer-diff-help-text)) - ;; Mark the repo section - (egg-delimit-section :section 'repo beg (point) inv-beg map 'repo) - (when help-beg - ;; Mark the help sub-section so it can be hidden - (egg-delimit-section :help 'help help-beg (point) help-inv-beg map - 'egg-compute-navigation)) - (put-text-property beg (or help-beg (point)) - 'help-echo (egg-tooltip-func)))) - -(defun egg-ignore-pattern-from-string-at-point () - (interactive) - (let ((string (egg-string-at-point)) - (file (ffap-file-at-point)) - dir pattern gitignore) - (setq pattern (read-string "ignore pattern: " - (if (string-match "\\.[^.]+\\'" string) - (match-string-no-properties 0 string) - string))) - (when (equal pattern "") - (error "Can't ignore empty string!")) - (setq dir (if (stringp file) - (file-name-directory (expand-file-name file)) - default-directory)) - (setq gitignore - (read-file-name (format "add pattern `%s' to: " pattern) - dir nil nil ".gitignore")) - (save-excursion - (with-current-buffer (find-file-noselect gitignore t t) - (goto-char (point-max)) - (insert pattern "\n") - (save-buffer) - (kill-buffer (current-buffer)))) - (egg-buffer-cmd-refresh))) - -(defun egg-status-buffer-stage-untracked-file () - (interactive) - (let ((file (ffap-file-at-point))) - (when (egg-sync-do-file file egg-git-command nil nil - (list "add" "--" file)) - (message "new file %s added" file)))) - -(defconst egg-untracked-file-map - (let ((map (make-sparse-keymap "Egg:UntrackedFile"))) - (define-key map (kbd "RET") 'egg-find-file-at-point) - (define-key map (kbd "DEL") 'egg-ignore-pattern-from-string-at-point) - (define-key map "s" 'egg-status-buffer-stage-untracked-file) - (define-key map "i" 'egg-status-buffer-stage-untracked-file) - map)) - -(defun egg-sb-insert-untracked-section () - "Insert the untracked files section into the status buffer." - (let ((beg (point)) inv-beg end) - (insert (egg-prepend "Untracked Files:" "\n\n" - 'face 'egg-section-title - 'help-echo (egg-tooltip-func)) - "\n") - (setq inv-beg (1- (point))) - (call-process egg-git-command nil t nil "ls-files" "--others" - "--exclude-standard") - (setq end (point)) - (egg-delimit-section :section 'untracked beg end - inv-beg egg-section-map 'untracked) - (put-text-property inv-beg end 'keymap egg-untracked-file-map) - (put-text-property (1+ inv-beg) end 'help-echo (egg-tooltip-func)))) - -(defun egg-sb-insert-unstaged-section (title &rest extra-diff-options) - "Insert the unstaged changes section into the status buffer." - (let ((beg (point)) inv-beg diff-beg) - (insert (egg-prepend title "\n\n" 'face 'egg-section-title - 'help-echo (egg-tooltip-func)) - "\n") - (setq diff-beg (point)) - (setq inv-beg (1- (point))) - (apply 'call-process egg-git-command nil t nil "diff" "--no-color" - "-M" "-p" "--src-prefix=INDEX:/" "--dst-prefix=WORKDIR:/" - extra-diff-options) - (egg-delimit-section :section 'unstaged beg (point) - inv-beg egg-section-map 'unstaged) - ;; this section might contains merge conflicts, thus cc-diff - (egg-decorate-diff-section :begin diff-beg - :end (point) - :src-prefix "INDEX:/" - :dst-prefix "WORKDIR:/" - :diff-map egg-unstaged-diff-section-map - :hunk-map egg-unstaged-hunk-section-map - :cc-diff-map egg-unmerged-diff-section-map - :cc-hunk-map egg-unmerged-hunk-section-map - :conflict-map egg-unmerged-hunk-section-map - ))) - -(defun egg-sb-insert-staged-section (title &rest extra-diff-options) - "Insert the staged changes section into the status buffer." - (let ((beg (point)) inv-beg diff-beg) - (insert (egg-prepend title "\n\n" - 'face 'egg-section-title - 'help-echo (egg-tooltip-func)) - "\n") - (setq diff-beg (point) - inv-beg (1- diff-beg)) - (apply 'call-process egg-git-command nil t nil "diff" "--no-color" - "--cached" "-M" "-p" "--src-prefix=HEAD:/" "--dst-prefix=INDEX:/" - extra-diff-options) - (egg-delimit-section :section 'staged beg (point) - inv-beg egg-section-map 'staged) - ;; this section never contains merge conflicts, thus no cc-diff - (egg-decorate-diff-section :begin diff-beg - :end (point) - :src-prefix "HEAD:/" - :dst-prefix "INDEX:/" - :diff-map egg-staged-diff-section-map - :hunk-map egg-staged-hunk-section-map))) - -(defun egg-checkout-ref (&optional default) - "Prompt a revision to checkout. Default is DEFAULT." - (interactive (list (car (get-text-property (point) :ref)))) - (egg-do-checkout (completing-read "checkout: " (egg-all-refs) - nil nil (or default "HEAD")))) - -(defsubst egg-buffer-show-all () - (interactive) - (setq buffer-invisibility-spec nil) - (if (interactive-p) - (force-window-update (current-buffer)))) - -(defsubst egg-buffer-hide-all () - "Hide all sections in current special egg buffer." - (interactive) - (let ((pos (point-min)) nav) - (while (setq pos (next-single-property-change (1+ pos) :navigation)) - (setq nav (get-text-property pos :navigation)) - (add-to-invisibility-spec (cons nav t)))) - (if (interactive-p) - (force-window-update (current-buffer)))) - -(defsubst egg-buffer-hide-section-type (sect-type) - "Hide sections of SECT-TYPE in current special egg buffer." - (let ((pos (point-min)) nav) - (while (setq pos (next-single-property-change (1+ pos) sect-type)) - (when (get-text-property pos sect-type) - (setq nav (get-text-property pos :navigation)) - (add-to-invisibility-spec (cons nav t)))))) - -(defsubst egg-buffer-maybe-hide-all () - "If requsted, hide all sections in current special egg buffer. -See `egg-buffer-hide-sub-blocks-on-start'." - (let ((sect-type (cdr (assq major-mode - egg-buffer-hide-section-type-on-start)))) - (cond ((memq major-mode egg-buffer-hide-sub-blocks-on-start) - (egg-buffer-hide-all)) - ((and sect-type (symbolp sect-type)) - (egg-buffer-hide-section-type sect-type))))) - -(defsubst egg-buffer-maybe-hide-help (help-nav &optional top-nav) - "If requested, hide the help section in the current special buffer. -See `egg-buffer-hide-help-on-start'." - (if (memq major-mode egg-buffer-hide-help-on-start) - (add-to-invisibility-spec - (cons (if (symbolp help-nav) help-nav - (egg-make-navigation top-nav help-nav)) - t)))) - -(defun egg-status-buffer-redisplay (buf &optional init) - "(Re)Display the contents of the status buffer in BUF. -If INIT was not nil, then perform 1st-time initializations as well." - (with-current-buffer buf - (let ((inhibit-read-only t) - (orig-pos (point))) - (erase-buffer) - - (dolist (sect egg-status-buffer-sections) - (cond ((eq sect 'repo) (egg-sb-insert-repo-section)) - ((eq sect 'unstaged) (egg-sb-insert-unstaged-section "Unstaged Changes:")) - ((eq sect 'staged) (egg-sb-insert-staged-section "Staged Changes:")) - ((eq sect 'untracked) (egg-sb-insert-untracked-section)))) - (if init (egg-buffer-maybe-hide-all)) - (if init (egg-buffer-maybe-hide-help "help" 'repo)) - (goto-char orig-pos)))) - -(defun egg-internal-background (proc msg) - "Background job sentinel." - (let ((name (process-name proc))) - (cond ((string= msg "finished\n") - (message "EGG BACKGROUND: %s finished." name)) - ((string= msg "killed\n") - (message "EGG BACKGROUND: %s was killed." name)) - ((string-match "exited abnormally" msg) - (message "EGG BACKGROUND: %s failed." name)) - (t (message "EGG BACKGROUND: %s is weird!" name))))) - -(defun egg-internal-background-refresh-index (buffer-name) - (let ((buffer (get-buffer buffer-name)) - proc) - (when (and buffer (buffer-live-p buffer)) - (with-current-buffer buffer - (setq proc (start-process (format "refresh index in %s" - default-directory) - nil - egg-git-command "update-index" - "-q" "--really-refresh" "--unmerged")) - (set-process-sentinel proc #'egg-internal-background))))) - -(defvar egg-internal-status-buffer-names-list nil) -(defvar egg-internal-background-jobs-timer nil) - -(defun egg-status-buffer-background-job () - (when egg-refresh-index-in-backround - (mapcar #'egg-internal-background-refresh-index - egg-internal-status-buffer-names-list))) - -(defsubst egg-internal-background-jobs-restart () - (cancel-function-timers #'egg-status-buffer-background-job) - (setq egg-internal-background-jobs-timer - (run-with-idle-timer egg-background-idle-period t - #'egg-status-buffer-background-job))) - -(defun egg-set-background-idle-period (var val) - (custom-set-default var val) - (egg-internal-background-jobs-restart)) - -(defcustom egg-background-idle-period 30 - "How long emacs has been idle before we trigger background jobs." - :group 'egg - :set 'egg-set-background-idle-period - :type 'integer) - -(egg-internal-background-jobs-restart) - -(define-egg-buffer status "*%s-status@%s*" - "Major mode to display the egg status buffer." - (kill-all-local-variables) - (setq buffer-read-only t) - (setq major-mode 'egg-status-buffer-mode - mode-name "Egg-Status" - mode-line-process "" - truncate-lines t) - (use-local-map egg-status-buffer-mode-map) - (set (make-local-variable 'egg-buffer-refresh-func) - 'egg-status-buffer-redisplay) - (setq buffer-invisibility-spec nil) - (add-to-list 'egg-internal-status-buffer-names-list (buffer-name)) - (run-mode-hooks 'egg-status-buffer-mode-hook)) - - -;;; I'm here -(defun egg-status-make-section-menu (&optional name) - (let ((map (make-sparse-keymap name))) - (define-key map [f-stage] (list 'menu-item "Stage File" - 'egg-diff-section-cmd-stage - :visible '(egg-diff-at-point) - :enable '(egg-point-in-section 'unstaged))) - - (define-key map [f-unstage] (list 'menu-item "Unstage File" - 'egg-diff-section-cmd-unstage - :visible '(egg-diff-at-point) - :enable '(egg-point-in-section 'staged))) - - (define-key map [f-undo] (list 'menu-item "Undo File's Modifications" - 'egg-diff-section-cmd-undo - :visible '(egg-diff-at-point) - :enable '(egg-point-in-section 'unstaged))) - - (define-key map [h-stage] (list 'menu-item "Stage Hunk" - 'egg-hunk-section-cmd-stage - :visible '(egg-hunk-at-point) - :enable '(egg-point-in-section 'unstaged))) - - (define-key map [h-unstage] (list 'menu-item "Unstage Hunk" - 'egg-hunk-section-cmd-unstage - :visible '(egg-hunk-at-point) - :enable '(egg-point-in-section 'staged))) - - (define-key map [h-undo] (list 'menu-item "Undo Hunk" - 'egg-hunk-section-cmd-undo - :visible '(egg-hunk-at-point) - :enable '(egg-point-in-section 'unstaged))) - - (define-key map [sp9] '("--")) - (define-key map [prev] (list 'menu-item "Goto Prev Block" - 'egg-buffer-cmd-navigate-prev - :enable '(egg-navigation-at-point))) - (define-key map [next] (list 'menu-item "Goto Next Block" - 'egg-buffer-cmd-navigate-next - :enable '(egg-navigation-at-point))) - (define-key map [hs] (list 'menu-item "Hide/Show Current Block" - 'egg-section-cmd-toggle-hide-show - :enable '(egg-navigation-at-point))) - (define-key map [hs-sub] (list 'menu-item "Hide/Show SubBlocks" - 'egg-section-cmd-toggle-hide-show-children - :enable '(egg-navigation-at-point))) - (define-key map [sp8] '("--")) - (define-key map [goto-file] (list 'menu-item "Open File" - 'egg-diff-section-cmd-visit-file-other-window - :visble '(and (egg-diff-at-point) (not (egg-hunk-at-point))))) - (define-key map [goto-line] (list 'menu-item "Locate Line" - 'egg-hunk-section-cmd-visit-file-other-window - :visible '(egg-hunk-at-point))) - (define-key map [ediff] (list 'menu-item "Ediff: WorkDir vs INDEX" - 'egg-unstaged-section-cmd-ediff - :visible '(egg-diff-at-point) - :enable '(egg-point-in-section 'unstaged))) - (define-key map [ediff3] (list 'menu-item "Ediff3: WorkDir vs INDEX vs HEAD" - 'egg-staged-section-cmd-ediff3 - :visible '(egg-diff-at-point) - :enable '(egg-point-in-section 'staged))) - map)) - -(defconst egg-status-buffer-unstaged-diff-menu (egg-status-make-section-menu "Unstaged Delta")) -(defconst egg-status-buffer-unstaged-hunk-menu (egg-status-make-section-menu "Unstaged Hunk")) -(defconst egg-status-buffer-staged-diff-menu (egg-status-make-section-menu "Staged Delta")) -(defconst egg-status-buffer-staged-hunk-menu (egg-status-make-section-menu "Staged Hunk")) -(defconst egg-status-buffer-mode-delta-menu (egg-status-make-section-menu)) - -(defun egg-status-popup-delta-menu (event menu) - (let* ((keys (progn - (force-mode-line-update) - (x-popup-menu event menu))) - (cmd (and keys (lookup-key menu (apply 'vector keys))))) - (when (and cmd (commandp cmd)) - (call-interactively cmd)))) - -(defun egg-status-popup-unstaged-diff-menu (event) - (interactive "e") - (egg-status-popup-delta-menu event egg-status-buffer-unstaged-diff-menu)) - -(defun egg-status-popup-staged-diff-menu (event) - (interactive "e") - (egg-status-popup-delta-menu event egg-status-buffer-staged-diff-menu)) - -(defun egg-status-popup-unstaged-hunk-menu (event) - (interactive "e") - (egg-status-popup-delta-menu event egg-status-buffer-unstaged-hunk-menu)) - -(defun egg-status-popup-staged-hunk-menu (event) - (interactive "e") - (egg-status-popup-delta-menu event egg-status-buffer-staged-hunk-menu)) - - -(defconst egg-status-buffer-menu (make-sparse-keymap "Egg (Git)")) - -(define-key egg-status-buffer-mode-map - [menu-bar egg-status-buffer-mode] (cons "Egg (Git)" egg-status-buffer-menu)) - -(let ((menu egg-status-buffer-menu)) - (define-key menu [quit] '(menu-item "Close Status View" egg-quit-buffer)) - (define-key menu [refresh] '(menu-item "Refresh Status View" egg-buffer-cmd-refresh)) - (define-key menu [log] '(menu-item "Show Branch History" egg-log)) - (define-key menu [sp3] '("--")) - (define-key menu [rb-skip] '(menu-item "Skip Rebase Session's Current Commit" - egg-buffer-selective-rebase-skip - :enable (egg-rebase-in-progress))) - (define-key menu [rb-abort] '(menu-item "Abort Rebase Session" - egg-buffer-rebase-abort - :enable (egg-rebase-in-progress))) - (define-key menu [rb-cont] '(menu-item "Resume Rebase Session" - egg-buffer-selective-rebase-continue - :enable (egg-rebase-in-progress))) - (define-key menu [sp2] '("--")) - (define-key menu [delta] (list 'menu-item "Delta" - egg-status-buffer-mode-delta-menu - :enable '(egg-diff-at-point))) - (define-key menu [commit] '(menu-item "Commit Staged Changes" - egg-commit-log-edit)) - (define-key menu [stage] '(menu-item "Stage All Modifications" - egg-stage-all-files)) - (define-key menu [stage-untracked] '(menu-item "Stage All Untracked Files" - egg-stage-untracked-files)) - (define-key menu [sp1] '("--")) - (define-key menu [hide-all] '(menu-item "Hide All" egg-buffer-hide-all)) - (define-key menu [show-all] '(menu-item "Show All" egg-buffer-show-all)) - (define-key menu [hs] '(menu-item "Hide/Show Block" - egg-section-cmd-toggle-hide-show - :enable (egg-navigation-at-point))) - (define-key menu [hs-sub] '(menu-item "Hide/Show SubBlocks" - egg-section-cmd-toggle-hide-show-children - :enable (egg-navigation-at-point))) - (define-key menu [prev] '(menu-item "Goto Previous Block" egg-buffer-cmd-navigate-prev - :enable (egg-navigation-at-point))) - (define-key menu [next] '(menu-item "Goto Next Block" egg-buffer-cmd-navigate-next - :enable (egg-navigation-at-point)))) - -(defvar egg-switch-to-buffer nil "Set to nonnil for egg-status to switch to the status buffer in the same window.") - -(defun egg-status (&optional select caller) - (interactive "P") - (let* ((egg-internal-current-state - (egg-repo-state (if (interactive-p) :error-if-not-git))) - (buf (egg-get-status-buffer 'create))) - (with-current-buffer buf - (egg-status-buffer-redisplay buf 'init)) - (cond ((eq caller :sentinel) (pop-to-buffer buf)) - (select (pop-to-buffer buf t)) - (egg-switch-to-buffer (switch-to-buffer buf)) - ((interactive-p) (display-buffer buf t)) - (t (pop-to-buffer buf t))))) - -;;;======================================================== -;;; action -;;;======================================================== - -(defun egg-revert-visited-files (file-or-files) - (let* ((git-dir (egg-git-dir)) - (default-directory (file-name-directory git-dir)) - (files (if (consp file-or-files) - file-or-files - (list file-or-files)))) - (mapcar (lambda (file) - (let ((buf (get-file-buffer file))) - (when (bufferp buf) - (with-current-buffer buf - (when (equal (egg-git-dir) git-dir) - (revert-buffer t t t)))))) - files))) - -(defun egg-revert-all-visited-files () - (let* ((git-dir (egg-git-dir)) - (default-directory (file-name-directory git-dir)) - bufs files) - (setq files - (delq nil (mapcar (lambda (buf) - (with-current-buffer buf - (when (and (buffer-file-name buf) - (equal (egg-git-dir) git-dir)) - (buffer-file-name buf)))) - (buffer-list)))) - (when (consp files) - (setq files (mapcar 'expand-file-name - (apply 'egg-git-to-lines "ls-files" files))) - (when (consp files) - (egg-revert-visited-files files))))) - -(defun egg-cmd-log-buffer () - (or (get-buffer (concat " *egg-cmd-logs@" (egg-git-dir) "*")) - (let ((git-dir (egg-git-dir)) - (default-directory default-directory) - dir) - (unless git-dir - (error "Can't find git dir in %s" default-directory)) - (setq dir (file-name-nondirectory git-dir)) - (setq default-directory dir) - (get-buffer-create (concat " *egg-cmd-logs@" git-dir "*"))))) - -(defsubst egg-cmd-log (&rest strings) - (with-current-buffer (egg-cmd-log-buffer) - (goto-char (point-max)) - (cons (current-buffer) - (prog1 (point) - (apply 'insert "LOG/" strings))))) - -(defun egg-sync-handle-exit-code (ret accepted-codes logger) - (let (output) - (with-current-buffer (car logger) - (save-excursion - (goto-char (cdr logger)) - (forward-line 1) - (setq output (buffer-substring-no-properties - (point) (point-max))))) - (egg-cmd-log (format "RET:%d\n" ret)) - (if (listp accepted-codes) - (setq accepted-codes (cons 0 accepted-codes)) - (setq accepted-codes (list 0 accepted-codes))) - (if (null (memq ret accepted-codes)) - (with-current-buffer (car logger) - (widen) - (narrow-to-region (cdr logger) (point-max)) - (display-buffer (current-buffer) t) - nil) - (egg-run-buffers-update-hook) - output))) - -(defun egg-sync-do (program stdin accepted-codes args) - (let (logger ret) - (setq logger (egg-cmd-log "RUN:" program " " - (mapconcat 'identity args " ") - (if stdin " (length output) 1)) - (when (numberp line-no) - (when (setq output (save-match-data (split-string output "\n" t))) - (cond ((< line-no 0) - (setq line-no (1+ line-no)) - (setq output (nth line-no (nreverse output)))) - ((> line-no 0) - (setq line-no (1- line-no)) - (setq output (nth line-no output))) - (t (setq output nil))))) - (when (stringp output) - (message "%s> %s" prefix output) - t))) - -(defun egg-hunk-section-cmd-stage (pos) - (interactive (list (point))) - (egg-show-git-output - (egg-hunk-section-patch-cmd pos egg-git-command "apply" "--cached") - -1 "GIT-APPLY")) - -(defun egg-hunk-section-cmd-unstage (pos) - (interactive (list (point))) - (egg-show-git-output - (egg-hunk-section-patch-cmd pos egg-git-command "apply" - "--cached" "--reverse") - -1 "GIT-APPLY")) - -(defun egg-hunk-section-cmd-undo (pos) - (interactive (list (point))) - (unless (or (not egg-confirm-undo) - (y-or-n-p "irreversibly remove the hunk under cursor? ")) - (error "Too chicken to proceed with undo operation!")) - (let ((file (egg-hunk-section-patch-cmd pos egg-patch-command - "-p1" "--quiet" "--reverse"))) - (if (consp file) (setq file (car file))) - (when (stringp file) - (egg-revert-visited-files file)))) - -(defun egg-diff-section-patch-cmd (pos accepted-codes &rest args) - (let ((file (car (get-text-property pos :diff)))) - (unless (stringp file) - (error "No diff with file-name here!")) - (egg-sync-do-file file egg-git-command nil accepted-codes - (append args (list file))))) - -(defun egg-diff-section-cmd-stage (pos) - (interactive (list (point))) - (let ((file (car (get-text-property pos :diff)))) - (egg-diff-section-patch-cmd pos nil - (if (file-exists-p file) - "add" - "rm")))) - -(defun egg-diff-section-cmd-unstage (pos) - (interactive (list (point))) - (egg-show-git-output - (egg-diff-section-patch-cmd pos 1 "reset" "HEAD" "--") - 1 "GIT-RESET")) - -(defun egg-diff-section-cmd-undo-old-no-revsion-check (pos) - (interactive (list (point))) - (let ((file (egg-diff-section-patch-cmd pos nil "checkout" "--"))) - (if (consp file) (setq file (car file))) - (when (stringp file) - (egg-revert-visited-files file)))) - -(defun egg-diff-section-cmd-undo (pos) - (interactive (list (point))) - (unless (or (not egg-confirm-undo) - (y-or-n-p "irreversibly remove the delta under cursor? ")) - (error "Too chicken to proceed with undo operation!")) - - (let ((file (car (or (get-text-property pos :diff) - (error "No diff with file-name here!")))) - (src-rev (get-text-property pos :src-revision)) - args) - (setq args - (if (stringp src-rev) - (list "checkout" src-rev "--" file) - (list "checkout" "--" file))) - (when (setq file (egg-sync-do-file file egg-git-command nil nil args)) - (if (consp file) (setq file (car file))) - (when (stringp file) - (egg-revert-visited-files file))))) - -(defun egg-file-stage-current-file () - (interactive) - (let ((git-dir (egg-git-dir)) - (file (buffer-file-name))) - (when (egg-sync-do-file file egg-git-command nil nil - (list "add" "--" file)) - (message "staged %s modifications" file)))) - -(defun egg-stage-all-files () - (interactive) - (let* ((git-dir (egg-git-dir)) - (default-directory (file-name-directory git-dir))) - (when (egg-sync-0 "add" "-u") - (message "staged all tracked files's modifications")))) - -(defun egg-stage-untracked-files () - (interactive) - (let* ((git-dir (egg-git-dir)) - (default-directory (file-name-directory git-dir))) - (when (egg-sync-0 "add" ".") - (message "staged all untracked files")))) - -(defun egg-do-stash-wip (msg) - (let* ((git-dir (egg-git-dir)) - (default-directory (file-name-directory git-dir))) - (if (egg-repo-clean) - (error "No WIP to stash") - (when (egg-show-git-output - (if (and msg (stringp msg)) - (egg-sync-0 "stash" "save" msg) - (egg-sync-0 "stash" "save")) - 1 "GIT-STASH") - (egg-revert-all-visited-files))))) - -(defun egg-do-checkout (rev) - (let* ((git-dir (egg-git-dir)) - (default-directory (file-name-directory git-dir))) - (if (egg-sync-0 "checkout" rev) - (egg-revert-all-visited-files)))) - -(defun egg-do-tag (&optional rev prompt force) - (let ((all-refs (egg-all-refs)) - (name (read-string (or prompt "new tag name: "))) - (rev (or rev "HEAD"))) - (when (and (not force) (member name all-refs)) - (error "referene %s already existed!" name)) - (if force - (egg-git-ok nil "tag" "-f" name rev) - (egg-git-ok nil "tag" name rev)))) - -(defun egg-do-create-branch (&optional rev checkout prompt force) - (let ((all-refs (egg-all-refs)) - (name (read-string (or prompt "create new branch: "))) - (rev (or rev "HEAD"))) - (when (and (not force) (member name all-refs)) - (error "referene %s already existed!" name)) - (if (null checkout) - (if force - (egg-git-ok nil "branch" "-f" name rev) - (egg-git-ok nil "branch" name rev)) - (if force - (egg-sync-0 "checkout" "-b" "-f" name rev) - (egg-sync-0 "checkout" "-b" name rev))))) - -(defun egg-do-apply-stash (stash) - (let ((state (egg-repo-state)) - output) - - (setq output (egg-sync-0 "stash" "apply" stash)) - (if output - (egg-revert-all-visited-files) - (message "GIT-STASH> failed to apply %s" stash) - (egg-status nil :sentinel)) - output)) - -(defun egg-do-pop-stash () - (let ((state (egg-repo-state)) - output) - (setq output (egg-sync-0 "stash" "pop")) - (if output - (egg-revert-all-visited-files) - (message "GIT-STASH> failed to pop WIP") - (egg-status nil :sentinel)) - output)) - -(defun egg-do-move-head (rev &optional update-wdir update-index) - (when (egg-show-git-output - (cond (update-wdir (egg-sync-0 "reset" "--hard" rev)) - (update-index (egg-sync-0 "reset" rev)) - (t (egg-sync-0 "reset" "--soft" rev))) - -1 "GIT-RESET") - (if update-wdir (egg-revert-all-visited-files)))) - -(defun egg-do-merge-to-head (rev &optional no-commit) - (let ((msg (concat "merging in " rev)) - (commit-flag (if no-commit "--no-commit" "--commit")) - (pre-merge (egg-get-current-sha1)) - merge-cmd-res modified-files res feed-back) - (with-temp-buffer - (setq merge-cmd-res (egg-git-ok (current-buffer) - "merge" "--log" commit-flag "-m" msg rev)) - (goto-char (point-min)) - (setq modified-files - (egg-git-to-lines "diff" "--name-only" pre-merge)) - (setq feed-back - (save-match-data - (car (nreverse (split-string (buffer-string) - "[\n]+" t))))) - (egg-run-buffers-update-hook) - (list :success merge-cmd-res - :files modified-files - :message feed-back)))) - -(defun egg-do-rebase-head (upstream-or-action - &optional old-base prompt) - (let ((pre-merge (egg-get-current-sha1)) - cmd-res modified-files feed-back old-choices) -;;; (with-temp-buffer - (with-current-buffer (get-buffer-create "*egg-debug*") - (erase-buffer) - (when (and (stringp upstream-or-action) ;; start a rebase - (eq old-base t)) ;; ask for old-base - (unless (egg-git-ok (current-buffer) "rev-list" - "--topo-order" "--reverse" - (concat upstream-or-action "..HEAD^")) - (error "Failed to find rev between %s and HEAD^: %s" - upstream-or-action (buffer-string))) - (unless (egg-git-region-ok (point-min) (point-max) - "name-rev" "--stdin") - (error "Failed to translate revisions: %s" (buffer-string))) - (save-match-data - (goto-char (point-min)) - (while (re-search-forward "^.+(\\(.+\\))$" nil t) - (setq old-choices (cons (match-string-no-properties 1) - old-choices)))) - (setq old-base - (completing-read (or prompt "old base: ") old-choices)) - (erase-buffer)) - - (setq cmd-res - (cond ((and (stringp old-base) (stringp upstream-or-action)) - (egg-git-ok (current-buffer) "rebase" "-m" "--onto" - upstream-or-action old-base)) - ((eq upstream-or-action :abort) - (egg-git-ok (current-buffer) "rebase" "--abort")) - ((eq upstream-or-action :skip) - (egg-git-ok (current-buffer) "rebase" "--skip")) - ((eq upstream-or-action :continue) - (egg-git-ok (current-buffer) "rebase" "--continue")) - ((stringp upstream-or-action) - (egg-git-ok (current-buffer) "rebase" "-m" - upstream-or-action)))) - (goto-char (point-min)) - (setq feed-back - (egg-safe-search-pickup - "^\\(?:CONFLICT\\|All done\\|HEAD is now at\\|Fast-forwarded\\|You must edit all merge conflicts\\).+$")) - (setq modified-files - (egg-git-to-lines "diff" "--name-only" pre-merge)) - (egg-run-buffers-update-hook) - (list :success cmd-res - :message feed-back - :files modified-files)))) - -(defun egg-rm-ref (&optional force name prompt default) - (let* ((refs-alist (egg-ref-type-alist)) - (name (or name (completing-read (or prompt "remove ref: ") - refs-alist nil t - default))) - (type (cdr (assoc name refs-alist)))) - (unless (and name type) - (error "Cannot find reference %s!" name)) - (egg-show-git-output - (cond ((eq :tag type) - (egg-sync-0 "tag" "-d" name)) - ((eq :head type) - (egg-sync-0 "branch" (if force "-vD" "-vd") name)) - ((eq :remote type) - (egg-sync-0 "branch" (if force "-vrD" "-vrd") name))) - -1))) - -;;;======================================================== -;;; log message -;;;======================================================== - -(require 'derived) -(require 'ring) - -(defvar egg-log-msg-ring (make-ring 32)) -(defvar egg-log-msg-ring-idx nil) -(defvar egg-log-msg-action nil) -(defvar egg-log-msg-text-beg nil) -(defvar egg-log-msg-text-end nil) -(defvar egg-log-msg-diff-beg nil) -(define-derived-mode egg-log-msg-mode text-mode "Egg-LogMsg" - "Major mode for editing Git log message.\n\n -\{egg-log-msg-mode-map}." - (setq default-directory (file-name-directory (egg-git-dir))) - (make-local-variable 'egg-log-msg-action) - (set (make-local-variable 'egg-log-msg-ring-idx) nil) - (set (make-local-variable 'egg-log-msg-text-beg) nil) - (set (make-local-variable 'egg-log-msg-text-end) nil) - (set (make-local-variable 'egg-log-msg-diff-beg) nil)) - -(define-key egg-log-msg-mode-map (kbd "C-c C-c") 'egg-log-msg-done) -(define-key egg-log-msg-mode-map (kbd "C-c C-k") 'egg-log-msg-cancel) -(define-key egg-log-msg-mode-map (kbd "M-p") 'egg-log-msg-older-text) -(define-key egg-log-msg-mode-map (kbd "M-n") 'egg-log-msg-newer-text) -(define-key egg-log-msg-mode-map (kbd "C-l") 'egg-buffer-cmd-refresh) - -(defun egg-log-msg-commit () - (let (output) - (setq output - (egg-sync-git-region egg-log-msg-text-beg egg-log-msg-text-end - "commit" "-F" "-")) - (when output - (egg-show-git-output output -1 "GIT-COMMIT") - (egg-run-buffers-update-hook)))) - -(defun egg-log-msg-amend-commit () - (let (output) - (setq output - (egg-sync-git-region egg-log-msg-text-beg egg-log-msg-text-end - "commit" "--amend" "-F" "-")) - (when output - (egg-show-git-output output -1 "GIT-COMMIT-AMEND") - (egg-run-buffers-update-hook)))) - -(defun egg-log-msg-done () - (interactive) - (widen) - (goto-char egg-log-msg-text-beg) - (if (save-excursion (re-search-forward "\\sw\\|\\-" - egg-log-msg-text-end t)) - (when (functionp egg-log-msg-action) - (ring-insert egg-log-msg-ring - (buffer-substring-no-properties egg-log-msg-text-beg - egg-log-msg-text-end)) - (funcall egg-log-msg-action) - (let ((inhibit-read-only t) - (win (get-buffer-window (current-buffer)))) - (erase-buffer) - (if (windowp win) (egg-quit-buffer win)))) - (message "Please enter a log message!") - (ding))) - -(defun egg-log-msg-cancel () - (interactive) - (if (> (length (window-list)) 1) - (delete-window) - (kill-buffer))) - -(defun egg-log-msg-hist-cycle (&optional forward) - "Cycle through message log history." - (let ((len (ring-length egg-log-msg-ring))) - (cond ((<= len 0) - ;; no history - (message "No previous log message.") - (ding)) - ;; don't accidentally throw away unsaved text - ((and (null egg-log-msg-ring-idx) - (> egg-log-msg-text-end egg-log-msg-text-beg) - (not (y-or-n-p "throw away current text? ")))) - ;; do it - (t (delete-region egg-log-msg-text-beg egg-log-msg-text-end) - (setq egg-log-msg-ring-idx - (if (null egg-log-msg-ring-idx) - (if forward - ;; 1st-time + fwd = oldest - (ring-minus1 0 len) - ;; 1st-time + bwd = newest - 0) - (if forward - ;; newer - (ring-minus1 egg-log-msg-ring-idx len) - ;; older - (ring-plus1 egg-log-msg-ring-idx len)))) - (goto-char egg-log-msg-text-beg) - (insert (ring-ref egg-log-msg-ring egg-log-msg-ring-idx)))))) - -(defun egg-log-msg-older-text () - "Cycle backward through comment history." - (interactive) - (egg-log-msg-hist-cycle)) - -(defun egg-log-msg-newer-text () - "Cycle forward through comment history." - (interactive) - (egg-log-msg-hist-cycle t)) - -(defun egg-commit-log-buffer-show-diffs (buf &optional init) - (with-current-buffer buf - (let ((inhibit-read-only t) beg) - (goto-char egg-log-msg-diff-beg) - (delete-region (point) (point-max)) - (setq beg (point)) - - (dolist (sect egg-commit-buffer-sections) - (cond ((eq sect 'staged) - (egg-sb-insert-staged-section "Changes to Commit:" "--stat")) - ((eq sect 'unstaged) - (egg-sb-insert-unstaged-section "Deferred Changes:")) - ((eq sect 'untracked) - (egg-sb-insert-untracked-section)))) - - (put-text-property beg (point) 'read-only t) - (put-text-property beg (point) 'front-sticky nil) - (if init (egg-buffer-maybe-hide-all)) - (force-window-update buf)))) - -(define-egg-buffer commit "*%s-commit@%s*" - (egg-log-msg-mode) - (setq major-mode 'egg-commit-buffer-mode - mode-name "Egg-Commit" - mode-line-process "") - (set (make-local-variable 'egg-buffer-refresh-func) - 'egg-commit-log-buffer-show-diffs) - (setq buffer-invisibility-spec nil) - (run-mode-hooks 'egg-commit-buffer-mode-hook)) - -(defun egg-commit-log-edit (title-function - action-function - insert-init-text-function) - (interactive (if current-prefix-arg - (list (concat - (egg-text "Amending " 'egg-text-3) - (egg-text (egg-pretty-head-name) 'egg-branch)) - #'egg-log-msg-amend-commit - (egg-commit-message "HEAD")) - (list (concat - (egg-text "Committing into " 'egg-text-3) - (egg-text (egg-pretty-head-name) 'egg-branch)) - #'egg-log-msg-commit - nil))) - (let* ((git-dir (egg-git-dir)) - (default-directory (file-name-directory git-dir)) - (buf (egg-get-commit-buffer 'create)) - (state (egg-repo-state)) - (head-info (egg-head)) - (head (or (cdr head-info) - (format "Detached HEAD! (%s)" (car head-info)))) - (inhibit-read-only inhibit-read-only)) - (with-current-buffer buf - (setq inhibit-read-only t) - (erase-buffer) - (set (make-local-variable 'egg-log-msg-action) - action-function) - (insert (cond ((functionp title-function) - (funcall title-function state)) - ((stringp title-function) title-function) - (t "Shit happens!")) - "\n" - "Repository: " (egg-text git-dir 'font-lock-constant-face) "\n" - (egg-text "-- Commit Message (type `C-c C-c` when done or `C-c C-k` when cancel) -" - 'font-lock-comment-face)) - (put-text-property (point-min) (point) 'read-only t) - (put-text-property (point-min) (point) 'rear-sticky nil) - (insert "\n") - (set (make-local-variable 'egg-log-msg-text-beg) (point-marker)) - (set-marker-insertion-type egg-log-msg-text-beg nil) - (put-text-property (1- egg-log-msg-text-beg) egg-log-msg-text-beg - :navigation 'commit-log-text) - (insert (egg-prop "\n------------------------ End of Commit Message ------------------------" - 'read-only t 'front-sticky nil - 'face 'font-lock-comment-face)) - (set (make-local-variable 'egg-log-msg-diff-beg) (point-marker)) - (set-marker-insertion-type egg-log-msg-diff-beg nil) - (egg-commit-log-buffer-show-diffs buf 'init) - (goto-char egg-log-msg-text-beg) - (cond ((functionp insert-init-text-function) - (funcall insert-init-text-function)) - ((stringp insert-init-text-function) - (insert insert-init-text-function))) - (set (make-local-variable 'egg-log-msg-text-end) (point-marker)) - (set-marker-insertion-type egg-log-msg-text-end t)) - (pop-to-buffer buf t))) - -;;;======================================================== -;;; diff-mode -;;;======================================================== -(defconst egg-diff-buffer-mode-map - (let ((map (make-sparse-keymap "Egg:DiffBuffer"))) - (set-keymap-parent map egg-buffer-mode-map) - map)) - -(defun egg-diff-buffer-insert-diffs (buffer) - (with-current-buffer buffer - (let ((args (plist-get egg-diff-buffer-info :args)) - (title (plist-get egg-diff-buffer-info :title)) - (prologue (plist-get egg-diff-buffer-info :prologue)) - (src-prefix (plist-get egg-diff-buffer-info :src)) - (dst-prefix (plist-get egg-diff-buffer-info :dst)) - (help (plist-get egg-diff-buffer-info :help)) - (inhibit-read-only t) - pos beg inv-beg help-beg help-end help-inv-beg) - (erase-buffer) - (insert (egg-text title 'egg-section-title) "\n") - (insert prologue "\n") - (setq inv-beg (1- (point))) - (when help - (insert "\n") - (setq help-beg (point)) - (insert (egg-text "Help" 'egg-help-header-1) "\n") - (setq help-inv-beg (1- (point))) - (insert help) - (setq help-end (point))) - (setq pos (point)) - (setq beg (point)) - (apply 'call-process egg-git-command nil t nil "diff" args) - (unless (> (point) beg) - (insert (egg-text "No difference!\n" 'egg-text-4))) - (egg-delimit-section :section 'file (point-min) (point) inv-beg - egg-section-map 'file) - (egg-delimit-section :help 'help help-beg help-end help-inv-beg - egg-section-map 'egg-compute-navigation) - (apply 'egg-decorate-diff-section - :begin (point-min) - :end (point) - :src-prefix src-prefix - :dst-prefix dst-prefix - egg-diff-buffer-info) - (goto-char pos)))) - -(define-egg-buffer diff "*%s-diff@%s*" - "Major mode to display the git diff output." - (kill-all-local-variables) - (setq buffer-read-only t) - (setq major-mode 'egg-diff-buffer-mode - mode-name "Egg-Diff" - mode-line-process "" - truncate-lines t) - (use-local-map egg-diff-buffer-mode-map) - (set (make-local-variable 'egg-buffer-refresh-func) - 'egg-diff-buffer-insert-diffs) - (setq buffer-invisibility-spec nil) - (run-mode-hooks 'egg-diff-buffer-mode-hook)) - -(defconst egg-diff-buffer-common-help-text - (concat - (egg-text "Common Key Bindings:" 'egg-help-header-2) - (egg-pretty-help-text - "\\\n" - "\\[egg-buffer-cmd-navigate-prev]:previous block " - "\\[egg-buffer-cmd-navigate-next]:next block " - "\\[egg-buffer-cmd-refresh]:redisplay " - "\\[egg-quit-buffer]:quit\n"))) - -(defconst egg-diff-buffer-diff-help-heading - (egg-text "Extra Bindings for Diff blocks:" 'egg-help-header-2)) - -(defconst egg-unstaged-diff-help-text - (egg-pretty-help-text - "\\\n" - "\\[egg-diff-section-cmd-stage]:stage file/hunk " - "\\[egg-diff-section-cmd-undo]:undo file/hunk " - "\\[egg-diff-section-cmd-visit-file-other-window]:visit file/line\n")) - -(defconst egg-staged-diff-help-text - (egg-pretty-help-text - "\\\n" - "\\[egg-diff-section-cmd-stage]:unstage file/hunk " - "\\[egg-diff-section-cmd-visit-file-other-window]:visit file/line\n")) - -(defconst egg-plain-diff-help-text - (egg-pretty-help-text - "\\\n" - "\\[egg-diff-section-cmd-visit-file-other-window]:visit file/line\n")) - -(defconst egg-wdir-diff-help-text - (egg-pretty-help-text - "\\\n" - "\\[egg-diff-section-cmd-undo]:undo file/hunk " - "\\[egg-diff-section-cmd-visit-file-other-window]:visit file/line\n")) - -(defun egg-diff-info-add-help (info) - (let ((map (plist-get info :diff-map)) help) - (setq help - (concat egg-diff-buffer-common-help-text - egg-diff-buffer-diff-help-heading - (cond ((eq map egg-unstaged-diff-section-map) - egg-unstaged-diff-help-text) - ((eq map egg-staged-diff-section-map) - egg-staged-diff-help-text) - ((eq map egg-diff-section-map) - egg-plain-diff-help-text) - ((eq map egg-wdir-diff-section-map) - egg-wdir-diff-help-text)))) - (plist-put info :help help))) - -(defun egg-do-diff (diff-info) - (let* ((git-dir (egg-git-dir)) - (dir (file-name-directory git-dir)) - (buf (egg-get-diff-buffer 'create))) - (with-current-buffer buf - (set (make-local-variable 'egg-diff-buffer-info) diff-info) - (egg-diff-buffer-insert-diffs buf)) - buf)) - -(defun egg-build-diff-info (src dst &optional file) - (let* ((git-dir (egg-git-dir)) - (dir (file-name-directory git-dir)) - info tmp) - (setq info - (cond ((and (null src) (null dst)) - (list :args (list "--no-color" "-p" - "--src-prefix=INDEX/" - "--dst-prefix=WORKDIR/") - :title (format "from INDEX to %s" dir) - :prologue "hunks can be removed or added into INDEX." - :src "INDEX/" :dst "WORKDIR/" - :diff-map egg-unstaged-diff-section-map - :hunk-map egg-unstaged-hunk-section-map)) - ((and (equal src "HEAD") (equal dst "INDEX")) - (list :args (list "--no-color" "--cached" "-p" - "--src-prefix=INDEX/" - "--dst-prefix=WORKDIR/") - :title "from HEAD to INDEX" - :prologue "hunks can be removed from INDEX." - :src "HEAD/" :dst "INDEX/" - :diff-map egg-staged-diff-section-map - :hunk-map egg-staged-hunk-section-map)) - ((and (stringp src) (stringp dst)) - (list :args (list "--no-color" "-p" - (concat src ".." dst)) - :title (format "from %s to %s" src dst) - :prologue (format "a: %s\nb: %s" src dst) - :src-revision src - :dst-revision dst - :diff-map egg-diff-section-map - :hunk-map egg-hunk-section-map)) - ((and (stringp src) (null dst)) - (list :args (list "--no-color" "-p" src) - :title (format "from %s to %s" src dir) - :prologue (concat (format "a: %s\nb: %s\n" src dir) - "hunks can be removed???") - :src-revision src - :diff-map egg-wdir-diff-section-map - :hunk-map egg-wdir-hunk-section-map)))) - (if (memq :diff egg-show-key-help-in-buffers) - (egg-diff-info-add-help info)) - (if (stringp file) - (setq file (list file)) - (setq tmp (plist-get info :args)) - (setq tmp (cons "-M" tmp)) - (plist-put info :args tmp)) - (when (consp file) - (setq tmp (plist-get info :prologue)) - (setq tmp (concat (egg-text (mapconcat 'identity file "\n") - 'egg-text-3) - "\n" - (egg-text tmp 'egg-text-1))) - (plist-put info :prologue tmp) - (setq tmp (plist-get info :args)) - (setq tmp (append tmp (cons "--" file))) - (plist-put info :args tmp)) - info)) - -(defun egg-diff-ref (&optional default) - "Prompt a revision to diff other ref." - (interactive (list (car (get-text-property (point) :ref)))) - (let* ((src (completing-read "diff: " (egg-all-refs) - nil nil (or default ""))) - (buf (egg-do-diff (egg-build-diff-info src nil)))) - (pop-to-buffer buf t))) - - -;;;======================================================== -;;; log browsing -;;;======================================================== -(defvar egg-log-buffer-comment-column nil) -(defvar egg-internal-log-buffer-closure nil) - -(defun egg-run-git-log-HEAD (&optional refs-only) - (if refs-only - (egg-git-ok t "log" (format "--max-count=%d" egg-log-HEAD-max-len) - "--graph" "--topo-order" "--simplify-by-decoration" - "--pretty=oneline" "--decorate" "--no-color") - (egg-git-ok t "log" (format "--max-count=%d" egg-log-HEAD-max-len) - "--graph" "--topo-order" - "--pretty=oneline" "--decorate" "--no-color"))) - -(defun egg-run-git-log-all (&optional refs-only) - (if refs-only - (egg-git-ok t "log" (format "--max-count=%d" egg-log-all-max-len) - "--graph" "--topo-order" "--simplify-by-decoration" - "--pretty=oneline" "--decorate" "--all" "--no-color") - (egg-git-ok t "log" (format "--max-count=%d" egg-log-all-max-len) - "--graph" "--topo-order" - "--pretty=oneline" "--decorate" "--all" "--no-color"))) - -(defun egg-run-git-log-pickaxe (string) - (egg-git-ok t "log" "--pretty=oneline" "--decorate" "--no-color" - (concat "-S" string))) - -(defconst egg-log-commit-base-map - (let ((map (make-sparse-keymap "Egg:LogCommitBase"))) - (set-keymap-parent map egg-hide-show-map) - (define-key map (kbd "SPC") 'egg-log-buffer-insert-commit) - (define-key map (kbd "B") 'egg-log-buffer-create-new-branch) - (define-key map (kbd "b") 'egg-log-buffer-start-new-branch) - (define-key map (kbd "o") 'egg-log-buffer-checkout-commit) - (define-key map (kbd "t") 'egg-log-buffer-tag-commit) - (define-key map (kbd "T") 'egg-log-buffer-atag-commit) - (define-key map (kbd "a") 'egg-log-buffer-attach-head) - (define-key map (kbd "m") 'egg-log-buffer-merge) - (define-key map (kbd "r") 'egg-log-buffer-rebase) - (define-key map (kbd "R") 'egg-log-buffer-rebase-interactive) - map)) - -(defconst egg-log-commit-map - (let ((map (make-sparse-keymap "Egg:LogCommit"))) - (set-keymap-parent map egg-log-commit-base-map) - (define-key map (kbd "+") 'egg-log-buffer-mark-pick) - (define-key map (kbd ".") 'egg-log-buffer-mark-squash) - (define-key map (kbd "~") 'egg-log-buffer-mark-edit) - (define-key map (kbd "-") 'egg-log-buffer-unmark) - - (define-key map (kbd "*") 'egg-log-buffer-mark) - (define-key map (kbd "=") 'egg-log-buffer-diff-revs) - - (define-key map [C-down-mouse-2] 'egg-log-popup-commit-line-menu) - (define-key map [C-mouse-2] 'egg-log-popup-commit-line-menu) - - map)) - -(defconst egg-log-ref-map - (let ((map (make-sparse-keymap "Egg:LogRef"))) - (set-keymap-parent map egg-log-commit-map) - (define-key map (kbd "L") 'egg-log-buffer-reflog-ref) - (define-key map (kbd "x") 'egg-log-buffer-rm-ref) - (define-key map (kbd "u") 'egg-log-buffer-push-to-local) - map)) - -(defconst egg-log-local-ref-map - (let ((map (make-sparse-keymap "Egg:LogLocalRef"))) - (set-keymap-parent map egg-log-ref-map) - (define-key map (kbd "U") 'egg-log-buffer-push-to-remote) - (define-key map (kbd "d") 'egg-log-buffer-push-head-to-local) - - (define-key map [C-down-mouse-2] 'egg-log-popup-local-ref-menu) - (define-key map [C-mouse-2] 'egg-log-popup-local-ref-menu) - - map)) - -(defconst egg-log-remote-ref-map - (let ((map (make-sparse-keymap "Egg:LogRemoteRef"))) - (set-keymap-parent map egg-log-ref-map) - (define-key map (kbd "d") 'egg-log-buffer-fetch-remote-ref) - - (define-key map [C-down-mouse-2] 'egg-log-popup-remote-ref-menu) - (define-key map [C-mouse-2] 'egg-log-popup-remote-ref-menu) - - map)) - -(defconst egg-log-remote-site-map - (let ((map (make-sparse-keymap "Egg:LogRef"))) - (set-keymap-parent map egg-log-commit-map) - (define-key map (kbd "d") 'egg-log-buffer-fetch) - (define-key map (kbd "U") 'egg-log-buffer-push) - - (define-key map [C-down-mouse-2] 'egg-log-popup-remote-site-menu) - (define-key map [C-mouse-2] 'egg-log-popup-remote-site-menu) - - map)) - -(defconst egg-log-diff-map - (let ((map (make-sparse-keymap "Egg:LogDiff"))) - (set-keymap-parent map egg-section-map) - (define-key map (kbd "RET") 'egg-log-diff-cmd-visit-file-other-window) - (define-key map (kbd "f") 'egg-log-diff-cmd-visit-file) - (define-key map (kbd "=") 'egg-diff-section-cmd-ediff) - map)) - -(defconst egg-log-hunk-map - (let ((map (make-sparse-keymap "Egg:LogHunk"))) - (set-keymap-parent map egg-section-map) - (define-key map (kbd "RET") 'egg-log-hunk-cmd-visit-file-other-window) - (define-key map (kbd "f") 'egg-log-hunk-cmd-visit-file) - (define-key map (kbd "=") 'egg-diff-section-cmd-ediff) - map)) - -(defconst egg-log-buffer-mode-map - (let ((map (make-sparse-keymap "Egg:LogBuffer"))) - (set-keymap-parent map egg-buffer-mode-map) - (define-key map "n" 'egg-log-buffer-next-ref) - (define-key map "s" 'egg-status) - (define-key map "p" 'egg-log-buffer-prev-ref) - (define-key map "L" 'egg-reflog) - (define-key map "/" 'egg-search-changes) - map)) - - - -(defun egg-decorate-log (&optional line-map head-map tag-map remote-map remote-site-map) - (let ((start (point)) - (head-sha1 (egg-get-current-sha1)) - (ov (make-overlay (point-min) (point-min) nil t)) - (dec-ref-alist - (egg-full-ref-decorated-alist - (list 'face 'egg-branch-mono 'keymap head-map 'help-echo (egg-tooltip-func)) - (list 'face 'egg-tag-mono 'keymap tag-map 'help-echo (egg-tooltip-func)) - (list 'face 'egg-an-tag-mono 'keymap tag-map 'help-echo (egg-tooltip-func)) - (list 'face 'egg-branch-mono 'keymap remote-map 'help-echo (egg-tooltip-func)) - (list 'face 'egg-remote-mono 'keymap remote-site-map 'help-echo (egg-tooltip-func)))) - (ref-string-len 0) - (dashes-len 0) - (min-dashes-len 300) - separator ref-string refs full-refs sha1 - line-props graph-len beg end sha-beg sha-end subject-beg - refs-start refs-end ref-alist - head-line) - (setq ref-alist (mapcar (lambda (pair) - (cons - (substring-no-properties (cdr pair)) - (car pair))) - dec-ref-alist)) - (save-excursion - (while (re-search-forward "\\([0-9a-f]\\{40\\}\\) .+$" nil t) - (setq sha-beg (match-beginning 1) - sha-end (match-end 1) - subject-beg (1+ sha-end) - beg (line-beginning-position) - end (match-end 0) - refs-start nil) - (setq graph-len (if (= beg sha-beg) 0 (- sha-beg beg 1)) - sha1 (buffer-substring-no-properties sha-beg sha-end) - subject-beg (if (/= (char-after subject-beg) ?\() - subject-beg - (setq refs-start (1+ subject-beg)) - (goto-char subject-beg) - (skip-chars-forward "^)") - (setq refs-end (point)) - (+ (point) 2))) - (setq refs (when refs-start - (save-match-data - (mapcar (lambda (lref) - (if (and (>= (length lref) 5) (string-equal (substring lref 0 5) "tag: ")) - (substring lref 5) - (if (and (>= (length lref) 6) (string-equal (substring lref -5) "/HEAD")) - nil - lref))) - (split-string - (buffer-substring-no-properties (+ sha-end 2) - refs-end) - ", +" t))))) - - (setq full-refs (mapcar (lambda (full-ref-name) - (cdr (assoc full-ref-name ref-alist))) - refs)) - - ;; common line decorations - (setq line-props (list :navigation sha1 :commit sha1)) - - (if line-map - (setq line-props (nconc (list 'keymap line-map) - line-props))) - (when refs - (setq line-props (nconc (list :references refs) - line-props))) - - - (setq separator (apply 'propertize " " line-props)) - (setq ref-string - (if full-refs - (propertize - (mapconcat (lambda (full-ref-name) - (cdr (assoc full-ref-name - dec-ref-alist))) - full-refs separator) - :navigation sha1 :commit sha1 - :references refs))) - (setq ref-string-len (if ref-string (length ref-string))) - - ;; entire line - (add-text-properties beg (1+ end) line-props) - - ;; comment - (put-text-property subject-beg end 'face 'egg-text-2) - ;; delete refs list (they're already parsed) - (if refs-start - (delete-region (1- refs-start) (+ refs-end 2))) - - ;; shorten sha - (delete-region (+ sha-beg 8) sha-end) - (put-text-property sha-beg (+ sha-beg 8) - 'face 'font-lock-constant-face) - (put-text-property sha-beg (+ sha-beg 8) - 'help-echo (egg-tooltip-func)) - - (setq dashes-len (- 300 graph-len 1 - (if refs (1+ ref-string-len) 0))) - (setq min-dashes-len (min min-dashes-len dashes-len)) - - (put-text-property sha-beg (1+ sha-beg) - :dash-refs - (apply 'concat - (apply 'propertize - (make-string dashes-len ?-) - (nconc (list 'face 'egg-graph) - line-props)) - separator - (if refs - (list ref-string separator)))) -;;; (when (string= sha1 head-sha1) -;;; (overlay-put ov 'face 'egg-log-HEAD) -;;; (overlay-put ov 'evaporate t) -;;; (move-overlay ov beg (1+ (line-end-position)))) - (when (string= sha1 head-sha1) - (setq head-line (point-marker))) - - (goto-char (line-end-position))) - - (if (= min-dashes-len 300) - (insert (egg-text "nothing found!" 'egg-warning)) - - - ;; compute how many dashes can be deleted while - ;; leaving at least 1 dash - (setq min-dashes-len (1- min-dashes-len)) - - ;; before cut - ;; type a: 300 = graph spc dashes - ;; type b: 300 = graph spc dashes spc ref-string - ;; - ;; after cut - ;; type a: 300 - min-dashes-len = graph spc dashes - ;; type b: 300 - min-dashes-len = graph spc dashes spc ref-string - ;; - ;; a: comment-column = graph spc dashes spc sha1-8 spc - ;; b: comment-column = graph spc dashes spc ref-string spc sha1-8 spc - ;; need to remove the 1st spc if graph-len = 0 - (set (make-local-variable 'egg-log-buffer-comment-column) - (+ (- 300 min-dashes-len (if (> graph-len 0) 0 1)) 1 8 1)) - - (when (and (> min-dashes-len 0)) - (goto-char (1- start)) - (while (setq start (next-single-property-change (point) - :dash-refs)) - (goto-char start) - (insert (substring (get-text-property start :dash-refs) - min-dashes-len)) - (forward-char 2))) - - (when head-line - (goto-char head-line) - (overlay-put ov 'face 'egg-log-HEAD) - (overlay-put ov 'evaporate t) - (move-overlay ov (line-beginning-position) - (1+ (line-end-position)))) - head-line)))) - -(defsubst egg-log-buffer-insert-n-decorate-logs (log-insert-func) - (let ((beg (point))) - (funcall log-insert-func) - (goto-char beg) - (egg-decorate-log egg-log-commit-map - egg-log-local-ref-map - egg-log-local-ref-map - egg-log-remote-ref-map - egg-log-remote-site-map))) - - -(defun egg-log-diff-cmd-visit-file (file sha1) - (interactive (list (car (get-text-property (point) :diff)) - (get-text-property (point) :commit))) - (pop-to-buffer (egg-file-get-other-version file sha1 nil t))) - -(defun egg-log-diff-cmd-visit-file-other-window (file sha1) - (interactive (list (car (get-text-property (point) :diff)) - (get-text-property (point) :commit))) - (pop-to-buffer (egg-file-get-other-version file sha1 nil t) t)) - -(defun egg-log-hunk-cmd-visit-file (sha1 file hunk-header hunk-beg &rest ignored) - (interactive (cons (get-text-property (point) :commit) - (egg-hunk-info-at (point)))) - (let ((line (egg-hunk-compute-line-no hunk-header hunk-beg))) - (pop-to-buffer (egg-file-get-other-version file sha1 nil t)) - (goto-line line))) - -(defun egg-log-hunk-cmd-visit-file-other-window (sha1 file hunk-header hunk-beg &rest ignored) - (interactive (cons (get-text-property (point) :commit) - (egg-hunk-info-at (point)))) - (let ((line (egg-hunk-compute-line-no hunk-header hunk-beg))) - (pop-to-buffer (egg-file-get-other-version file sha1 nil t) t) - (goto-line line))) - -(defun egg-log-buffer-get-rev-at (pos &rest options) - (let* ((commit (get-text-property pos :commit)) - (refs (get-text-property pos :references)) - (first-head (if (stringp refs) refs (car (last refs)))) - (ref-at-point (car (get-text-property pos :ref))) - (head-sha1 (egg-get-current-sha1))) - (if (and (not (memq :no-HEAD options)) (string= head-sha1 commit)) - "HEAD" - (or ref-at-point first-head - (if (memq :symbolic options) - (egg-describe-rev commit) - commit))))) - -(defun egg-log-buffer-do-remove-mark (mark-char) - (let ((pos (point-min)) - (inhibit-read-only t)) - (while (setq pos (next-single-property-change (1+ pos) :mark)) - (when (= (get-text-property pos :mark) mark-char) - (remove-text-properties pos (1+ pos) - (list :mark nil 'display nil)))))) - -(defun egg-log-buffer-find-first-mark (mark-char) - (let ((pos (point-min))) - (while (and (setq pos (next-single-property-change (1+ pos) :mark)) - (/= (get-text-property pos :mark) mark-char))) - pos)) - -(defun egg-log-buffer-do-mark (pos char &optional unmark remove-first) - (let ((commit (get-text-property pos :commit)) - (inhibit-read-only t) - (col (- egg-log-buffer-comment-column 10)) - (step (if unmark -1 (if remove-first 0 1)))) - (when commit - (when remove-first - (egg-log-buffer-do-remove-mark char)) - (move-to-column col) - (funcall (if unmark - #'remove-text-properties - #'add-text-properties) - (point) (1+ (point)) - (list :mark char - 'display - (and char - (egg-text (char-to-string char) - 'egg-log-buffer-mark)))) - (forward-line step) - (while (not (or (get-text-property pos :commit) - (eobp) (bobp))) - (forward-line step)) - (move-to-column col)))) - -(defun egg-log-buffer-mark (pos) - (interactive "d") - (egg-log-buffer-do-mark pos ?* nil t)) - -(defun egg-log-buffer-mark-pick (pos) - (interactive "d") - (egg-log-buffer-do-mark pos ?+)) - -(defun egg-log-buffer-mark-squash (pos) - (interactive "d") - (egg-log-buffer-do-mark pos ?.)) - -(defun egg-log-buffer-mark-edit (pos) - (interactive "d") - (egg-log-buffer-do-mark pos ?~)) - -(defun egg-log-buffer-do-unmark-all () - (interactive) - (let ((pos (point-min)) - (inhibit-read-only t)) - (while (setq pos (next-single-property-change (1+ pos) :mark)) - (remove-text-properties pos (1+ pos) - (list :mark nil 'display nil))))) - -(defun egg-log-buffer-unmark (pos &optional all) - (interactive "d\nP") - (if all - (egg-log-buffer-do-unmark-all) - (egg-log-buffer-do-mark pos nil t))) - -(defun egg-log-buffer-get-marked-alist () - (let ((pos (point-min)) - marker subject alist) - (save-excursion - (while (setq pos (next-single-property-change (1+ pos) :mark)) - (goto-char pos) - (setq marker (point-marker)) - (move-to-column egg-log-buffer-comment-column) - (setq subject (buffer-substring-no-properties - (point) (line-end-position))) - (setq alist (cons (list (get-text-property pos :commit) - (get-text-property pos :mark) - subject marker) - alist)))) - alist)) - - -(defun egg-setup-rebase-interactive (rebase-dir upstream onto repo-state commit-alist) - (let ((process-environment process-environment) - (repo-state (or repo-state (egg-repo-state :staged :unstaged))) - (orig-buffer (current-buffer)) - orig-head-sha1) - (setq orig-head-sha1 (plist-get repo-state :sha1)) - (unless (egg-repo-clean repo-state) (error "Repo not clean")) - (unless onto (setq onto upstream)) - - (with-temp-buffer - (make-directory rebase-dir t) - - (write-region (point-min) (point-min) - (concat rebase-dir "interactive")) - (insert (plist-get repo-state :head) "\n") - (write-region (point-min) (point-max) - (concat rebase-dir "head-name")) - (erase-buffer) - (insert (plist-get repo-state :sha1) "\n") - (write-region (point-min) (point-max) - (concat rebase-dir "head")) - (erase-buffer) - (insert upstream "\n") - (write-region (point-min) (point-max) - (concat rebase-dir "upstream")) - (erase-buffer) - (insert onto "\n") - (write-region (point-min) (point-max) - (concat rebase-dir "onto")) - (erase-buffer) - (insert "# Rebase " upstream ".." orig-head-sha1 " onto " onto "\n") - (dolist (rev-info commit-alist) - (insert (cond ((eq (nth 1 rev-info) ?+) "pick") - ((eq (nth 1 rev-info) ?.) "squash") - ((eq (nth 1 rev-info) ?~) "edit")) - " " (nth 0 rev-info) " " (nth 2 rev-info) "\n")) - (write-region (point-min) (point-max) - (concat rebase-dir "git-rebase-todo")) - (write-region (point-min) (point-max) - (concat rebase-dir "git-rebase-todo.backup"))) - - (setenv "GIT_REFLOG_ACTION" (format "rebase -i (%s)" onto)) - (with-current-buffer (get-buffer-create "*egg-debug*") - (egg-git-ok nil "update-ref" "ORIG_HEAD" orig-head-sha1) - (egg-git-ok nil "checkout" onto) - (egg-do-async-rebase-continue #'egg-handle-rebase-interactive-exit - orig-head-sha1)))) - -(defun egg-handle-rebase-interactive-exit (&optional orig-sha1) - (let ((exit-msg egg-async-exit-msg) - (proc egg-async-process) - state buffer res msg rebase-dir) - (goto-char (point-min)) - (save-match-data - (re-search-forward - (eval-when-compile - (concat "\\<\\(?:" - "\\(please commit in egg.+$\\)" "\\|" - "\\(Successfully rebased and updated.+$\\)" "\\|" - "\\(You can amend the commit now\\)" "\\|" - "\\(Automatic cherry-pick failed\\)" "\\|" - "\\(nothing added to commit\\)" "\\|" - "\\(\\(?:Cannot\\|Could not\\).+\\)" "\\)")) nil t) - (setq msg (match-string-no-properties 0)) - (setq res (cond ((match-beginning 1) :rebase-commit) - ((match-beginning 2) :rebase-done) - ((match-beginning 3) :rebase-edit) - ((match-beginning 4) :rebase-conflict) - ((match-beginning 5) :rebase-empty) - ((match-beginning 6) :rebase-fail)))) - (setq buffer (process-get proc :orig-buffer)) - (with-current-buffer buffer - (egg-run-buffers-update-hook) - (egg-revert-all-visited-files) ;; too heavy ??? - (setq state (egg-repo-state :force)) - (setq rebase-dir (plist-get state :rebase-dir)) - (cond ((eq res :rebase-done) - (message "GIT-REBASE-INTERACTIVE: %s" msg)) - - ((eq res :rebase-commit) - (egg-commit-log-edit - (let* ((cherry (plist-get state :rebase-cherry)) - (cherry-op (save-match-data - (car (split-string cherry))))) - (concat - (egg-text "Rebasing " 'egg-text-3) - (egg-text (plist-get state :rebase-head) 'egg-branch) - ": " - (egg-text (concat "Commit " cherry-op "ed cherry") - 'egg-text-3))) - `(lambda () - (let ((process-environment process-environment)) - (mapcar (lambda (env-lst) - (setenv (car env-lst) (cadr env-lst))) - (egg-rebase-author-info ,rebase-dir)) - (egg-log-msg-commit)) - (with-current-buffer ,buffer - (egg-do-async-rebase-continue - #'egg-handle-rebase-interactive-exit - ,orig-sha1))) - (egg-file-as-string (concat rebase-dir "message")))) - - - ((eq res :rebase-edit) - (egg-commit-log-edit - (concat (egg-text "Rebasing " 'egg-text-3) - (egg-text (plist-get state :rebase-head) - 'egg-branch) ": " - (egg-text "Re-edit cherry's commit log" - 'egg-text-3)) - `(lambda () - (let ((process-environment process-environment)) - (mapcar (lambda (env-lst) - (setenv (car env-lst) (cadr env-lst))) - (egg-rebase-author-info ,rebase-dir)) - (egg-log-msg-amend-commit)) - (with-current-buffer ,buffer - (egg-do-async-rebase-continue - #'egg-handle-rebase-interactive-exit - ,orig-sha1))) - (egg-commit-message "HEAD"))) - - ((eq res :rebase-conflict) - (egg-status nil :sentinel) - (ding) - (message "automatic rebase stopped! please resolve conflict(s)")) - ((eq res :rebase-empty) - (egg-status nil :sentinel) - (ding) - (message "automatic rebase stopped! this commit should be skipped!")) - ((eq res :rebase-fail) - (egg-status nil :sentinel) - (ding) - (message "Automatic rebase failed!")))))) - -(defun egg-log-buffer-merge (pos &optional no-commit) - (interactive "d\nP") - (let ((rev (egg-log-buffer-get-rev-at pos :symbolic :no-HEAD)) - res modified-files buf) - (unless (egg-repo-clean) - (egg-status) - (error "Repo is not clean!")) - (if (null (y-or-n-p (format "merge %s to HEAD? " rev))) - (message "cancel merge from %s to HEAD!" rev) - (setq res (egg-do-merge-to-head rev no-commit)) - (setq modified-files (plist-get res :files)) - (if modified-files - (egg-revert-visited-files modified-files)) - (message "GIT-MERGE> %s" (plist-get res :message)) - (unless (and (plist-get res :success) (null no-commit)) - (egg-status))))) - -(defun egg-log-buffer-rebase (pos &optional move) - (interactive "d\nP") - (let ((rev (egg-log-buffer-get-rev-at pos :symbolic :no-HEAD)) - res modified-files buf) - (if (null (y-or-n-p (format "rebase HEAD to %s? " rev))) - (message "cancel rebase HEAD to %s!" rev) - (unless (egg-buffer-do-rebase - rev (if move t) - (if move - (format "starting point to rebase HEAD onto %s: " - rev))) - (egg-status))))) - -(defun egg-log-buffer-rebase-interactive (pos &optional move) - (interactive "d\nP") - (let* ((state (egg-repo-state :staged :unstaged)) - (rebase-dir (concat (plist-get state :gitdir) "/" - egg-git-rebase-subdir "/")) - (todo-alist (egg-log-buffer-get-marked-alist)) - (commits (mapcar 'car todo-alist)) - (upstream (egg-commit-at pos)) - (all (egg-git-to-lines "rev-list" "--reverse" "--cherry-pick" - (concat upstream "..HEAD")))) - (unless (egg-repo-clean state) - (error "repo %s is not clean" (plist-get state :gitdir))) - (mapc (lambda (commit) - (unless (member commit all) - (error "commit %s is not between HEAD and upstream %s" - commit upstream))) - commits) - - (egg-setup-rebase-interactive rebase-dir upstream nil - state todo-alist) - (egg-status))) - -(defun egg-log-buffer-checkout-commit (pos) - (interactive "d") - (egg-do-checkout - (completing-read "checkout: " (egg-all-refs) nil nil - (egg-log-buffer-get-rev-at pos :symbolic :no-HEAD)))) - -(defun egg-log-buffer-tag-commit (pos &optional force) - (interactive "d\nP") - (let ((rev (egg-log-buffer-get-rev-at pos))) - (when (egg-do-tag rev (format "tag %s with name: " rev) force) - (funcall egg-buffer-refresh-func (current-buffer))))) - -(defun egg-log-buffer-atag-commit (pos &optional force) - (interactive "d\nP") - (let ((commit (get-text-property pos :commit))) - (egg-create-annotated-tag - (read-string (format "create annotated tag on %s with name: " - (egg-describe-rev commit))) - commit))) - -(defun egg-log-buffer-create-new-branch (pos &optional force) - (interactive "d\nP") - (let ((rev (egg-log-buffer-get-rev-at pos))) - (when (egg-do-create-branch - rev nil - (format "create new branch at %s with name: " rev) - force) - (funcall egg-buffer-refresh-func (current-buffer))))) - -(defun egg-log-buffer-start-new-branch (pos &optional force) - (interactive "d\nP") - (let ((rev (egg-log-buffer-get-rev-at pos :symbolic :no-HEAD))) - (when (egg-do-create-branch - rev 'checkout - (format "start new branch from %s with name: " rev) - force)))) - -(defun egg-log-buffer-attach-head (pos &optional strict-level) - (interactive "d\np") - (let* ((rev (egg-log-buffer-get-rev-at pos :symbolic :no-HEAD)) - (commit (egg-commit-at-point)) - (branch (egg-current-branch)) - (update-index (> strict-level 3)) - (update-wdir (> strict-level 15)) - (prompt (format "%s to %s%s? " - (if branch - (concat "move " branch) - "attach HEAD") - (if branch (substring commit 0 8) rev) - (cond (update-wdir " (and update workdir)") - (update-index " (and update index)") - (t ""))))) - (if (y-or-n-p prompt) - (egg-do-move-head (if branch commit rev) - update-wdir update-index)))) - - -(defun egg-log-buffer-rm-ref (pos &optional force) - (interactive "d\nP") - (let ((refs (get-text-property pos :references)) - (ref-at-point (car (get-text-property pos :ref))) - victim) - (unless ref-at-point - (setq ref-at-point (last refs))) - (setq victim (completing-read "remove reference: " refs - nil nil ref-at-point)) - (when (egg-rm-ref force victim) - (funcall egg-buffer-refresh-func (current-buffer))))) - -(defun egg-log-buffer-fetch-remote-ref (pos) - (interactive "d") - (let* ((ref-at-point (get-text-property pos :ref)) - (ref (car ref-at-point)) - (type (cdr ref-at-point)) - name remote) - (unless (eq type :remote) - (error "Nothing to fetch from here!")) - (setq name (file-name-nondirectory ref) - remote (egg-rbranch-to-remote ref)) - (when (and remote name) - (message "GIT> fetching %s from %s..." ref remote) - (egg-buffer-async-do nil "fetch" remote - (format "refs/heads/%s:refs/remotes/%s" - name ref))))) - -(defun egg-log-buffer-fetch (pos) - (interactive "d") - (let* ((ref-at-point (get-text-property pos :ref)) - (ref (car ref-at-point)) - (type (cdr ref-at-point)) - site name def remote) - (unless (eq type :remote) - (error "No site here to fetch from!")) - (setq remote (egg-rbranch-to-remote ref)) - (when remote - (setq name (read-string (format "fetch from %s (default all): " - remote) nil nil "--all")) - (if (equal name "--all") - (progn - (message "GIT> fetching everything from %s..." remote) - (egg-buffer-async-do nil "fetch" remote)) - (message "GIT> fetching %s from %s..." name remote) - (egg-buffer-async-do nil "fetch" remote - (format "refs/heads/%s:refs/remotes/%s/%s" - name remote name)))))) - -(defun egg-log-buffer-push-to-local (pos &optional non-ff) - (interactive "d\nP") - (let* ((src (car (get-text-property pos :ref))) - dst) - (unless src - (error "Nothing to push here!")) - (setq dst (completing-read (format "use %s to update: " src) - (egg-local-refs) nil t)) - (when (egg-show-git-output - (egg-sync-0 "push" "." (if non-ff "-vf" "-v") - (concat src ":" dst)) - -1 "GIT-PUSH") - (funcall egg-buffer-refresh-func (current-buffer))))) - -(defun egg-log-buffer-push-head-to-local (pos &optional non-ff) - (interactive "d\nP") - (let* ((dst (car (get-text-property pos :ref)))) - (unless dst - (error "Nothing here to push to!")) - (if (y-or-n-p (format "update %s with HEAD? " dst)) - (when (egg-show-git-output - (egg-sync-0 "push" "." (if non-ff "-vf" "-v") - (concat "HEAD:" dst)) - -1 "GIT-PUSH") - (funcall egg-buffer-refresh-func (current-buffer)))))) - -(defun egg-log-buffer-push-to-remote (pos &optional non-ff) - (interactive "d\nP") - (let* ((ref-at-point (get-text-property pos :ref)) - (lref (car ref-at-point)) - (type (cdr ref-at-point)) - rref tracking remote spec) - (unless ref-at-point - (error "Nothing to push here!")) - (cond ((eq type :remote) ;; delete a remote head - (setq rref (file-name-nondirectory lref)) - (setq remote (directory-file-name - (file-name-directory lref))) - (setq lref "")) - ((eq type :head) - (setq tracking (egg-tracking-target lref :remote)) - (if (consp tracking) - (setq rref (car tracking) remote (cdr tracking)) - (setq remote (egg-read-remote - (format "push branch %s to remote: " lref))) - (setq rref (read-string - (format "push branch %s to %s as: " lref remote) - lref)))) - ((eq type :tag) - (setq remote (egg-read-remote "push to remote: ")) - (setq rref (read-string - (format "remote tag to push at (on %s): " remote) - lref)) - (setq lref (read-string - (format "local tag to push at %s/%s (empty mean delete the remote tag) : " - remote rref) - rref)))) - (unless (> (length lref) 0) - (unless (y-or-n-p (format "delete %s/%s? " remote rref)) - (message "cancel removal of %s/%s" remote rref) - (setq remote nil rref nil lref nil))) - (when (and remote rref lref) - (setq spec (concat lref ":" rref)) - (message "GIT> pushing %s to %s on %s..." lref rref remote) - (egg-buffer-async-do nil "push" (if non-ff "-vf" "-v") - remote spec)))) - -(defun egg-log-buffer-push (pos) - (interactive "d") - (let* ((ref-at-point (get-text-property pos :ref)) - (ref (car ref-at-point)) - (type (cdr ref-at-point)) - site name def remote) - (unless (eq type :remote) - (error "No site here to push to!")) - (setq remote (egg-rbranch-to-remote ref)) - (when remote - (setq name - (completing-read (format "push to %s (default all heads): " - remote) - (egg-local-refs) nil nil nil nil "--all")) - (message "GIT> pushing %s to %s..." - (if (equal name "--all") "everything" name) remote) - (egg-buffer-async-do nil "push" remote name)))) - -(defun egg-log-buffer-goto-pos (pos) - (goto-char pos) - (goto-char (line-beginning-position)) - (let ((sha1 (get-text-property (point) :commit))) - (when (stringp sha1) - (setq sha1 (substring sha1 0 6)) - (save-match-data - (if (looking-at (concat "^.* \\(" sha1 "\\)")) - (goto-char (match-beginning 1))))))) - -(defun egg-log-buffer-next-ref (pos) - (interactive "d") - (let ((current-ref (get-text-property pos :references)) - (n-pos (next-single-property-change pos :references)) - n-ref) - (when n-pos - (setq n-ref (get-text-property n-pos :references)) - (if n-ref - (egg-log-buffer-goto-pos n-pos) - (if (setq n-pos (next-single-property-change n-pos :references)) - (egg-log-buffer-goto-pos n-pos)))))) - -(defun egg-log-buffer-prev-ref (pos) - (interactive "d") - (let ((current-ref (get-text-property pos :references)) - (p-pos (previous-single-property-change pos :references)) - p-ref) - (when p-pos - (setq p-pos (1- p-pos)) - (setq p-ref (get-text-property p-pos :references)) - (if (and p-ref (not (equal p-ref current-ref))) - (egg-log-buffer-goto-pos p-pos) - (when (setq p-pos (previous-single-property-change p-pos :references)) - (setq p-pos (1- p-pos)) - (egg-log-buffer-goto-pos p-pos)))))) - -(defun egg-log-buffer-do-insert-commit (pos) - (save-excursion - (let ((sha1 (get-text-property pos :commit)) - (ref (get-text-property pos :references)) - (nav (get-text-property pos :navigation)) - (inhibit-read-only t) - (indent-column egg-log-buffer-comment-column) - (indent-spaces (make-string egg-log-buffer-comment-column ? )) - beg end) - (goto-char pos) - (goto-char (1+ (line-end-position))) - (setq beg (point)) - (unless (egg-git-ok t "log" "--max-count=1" "-p" "-M" "--no-color" - (concat - "--pretty=format:" - indent-spaces "%ai%n" - indent-spaces "%an%n%n" - "%b%n" - ) - sha1) - (error "error calling git log %s!" ref)) - (setq end (point)) - (egg-delimit-section :commit sha1 beg end (1- beg) nil nav) - (put-text-property beg end 'keymap egg-section-map) - (egg-decorate-diff-section :begin beg - :end end - :diff-map egg-log-diff-map - :hunk-map egg-log-hunk-map) - (goto-char beg) - (setq end (next-single-property-change beg :diff)) - (put-text-property beg (+ indent-column beg) 'face 'egg-diff-none) - (put-text-property (+ indent-column beg) (line-end-position) - 'face 'egg-text-2) - (forward-line 1) - (put-text-property (point) (+ indent-column (point)) 'face 'egg-diff-none) - (put-text-property (+ indent-column (point)) end 'face 'egg-text-2) - (set-buffer-modified-p nil)))) - -(defun egg-log-buffer-insert-commit (pos) - (interactive "d") - (let* ((next (next-single-property-change pos :diff)) - (sha1 (and next (get-text-property next :commit)))) - (unless (equal (get-text-property pos :commit) sha1) - (egg-log-buffer-do-insert-commit pos)))) - -(defun egg-generic-display-logs (data &optional init) - (buffer-disable-undo) - (and init (setq buffer-invisibility-spec nil)) - (let ((title (plist-get data :title)) - (subtitle (plist-get data :subtitle)) - (git-dir (egg-git-dir)) - (desc (plist-get egg-internal-log-buffer-closure :description)) - (closure (plist-get egg-internal-log-buffer-closure :closure)) - (help (plist-get egg-internal-log-buffer-closure :help)) - (inhibit-read-only t) - inv-beg beg help-beg) - (erase-buffer) - (insert title - (if subtitle (concat "\n" subtitle "\n") "\n") - (egg-text "repo: " 'egg-text-2) - (egg-text (egg-git-dir) 'font-lock-constant-face) - (if desc (concat "\n" desc "\n") "\n") - "\n") - (setq inv-beg (- (point) 2)) - (when (stringp help) - (setq help-beg (point)) - (insert (egg-text "Help" 'egg-help-header-1) "\n") - (put-text-property help-beg (point) 'help-echo (egg-tooltip-func)) - (setq inv-beg (1- (point))) - (insert help "\n")) - (setq beg (point)) - (when help-beg - (egg-delimit-section :section :help help-beg (point) - inv-beg egg-section-map :help)) - (if init (egg-buffer-maybe-hide-help :help)) - (goto-char (or (funcall closure) beg)))) - -(defun egg-log-buffer-redisplay (buffer &optional init) - (with-current-buffer buffer - (let* ((state (egg-repo-state)) - (sha1 (plist-get state :sha1))) - (plist-put egg-internal-log-buffer-closure :title - (egg-text (egg-pretty-head-string state) 'egg-branch)) - (plist-put egg-internal-log-buffer-closure :subtitle - (egg-text sha1 'font-lock-string-face)) - (egg-generic-display-logs egg-internal-log-buffer-closure init)))) - -(defun egg-log-buffer-redisplay-from-command (buffer) - ;; in process buffer - (when (and (processp egg-async-process) - (equal (current-buffer) (process-buffer egg-async-process))) - (or - (save-excursion - (let ((cmd "GIT>") cmd-sexp cmd-string pos done) - (goto-char (point-min)) - (skip-chars-forward "^(") - (setq cmd-sexp (read (current-buffer))) - (when (consp cmd-sexp) - (setq cmd-string (car cmd-sexp) - cmd (cond ((string-equal "fetch" cmd-string) "GIT-FETCH>") - ((string-equal "push" cmd-string) "GIT-PUSH>")))) - (goto-char (point-min)) - (save-match-data - (cond ((re-search-forward "^\\(?:From\\|To\\) \\(.+\\)\n\\(.+\\)$" nil t) - (message "%s %s: %s" cmd - (match-string-no-properties 1) - (match-string-no-properties 2)) - (setq done t)))) - (unless done - (goto-char (point-min)) - (save-match-data - (cond ((re-search-forward "^fatal: \\(.+\\)$" nil t) - (message "%s fatal: %s" cmd - (match-string-no-properties 1)) - (setq done t))))))))) - ;; update log buffer - (egg-log-buffer-redisplay buffer)) - -(define-egg-buffer log "*%s-log@%s*" - "Major mode to display the output of git log.\\ -Each line with a shorten sha1 representing a commit in the repo's history. -\\[egg-log-buffer-next-ref] move the cursor to the next commit with a ref -\\[egg-log-buffer-prev-ref] move the cursor to the previous commit line with a ref. -\\[egg-buffer-cmd-refresh] refresh the display of the log buffer -\\[egg-status] shows the repo's current status. - -\\{egg-log-buffer-mode-map} - -Each line representing a commit has extra keybindings:\\ -\\[egg-log-buffer-insert-commit] fetch and show the commit's details. -\\[egg-section-cmd-toggle-hide-show] hide/show the current commit's details -\\[egg-section-cmd-toggle-hide-show-children] hide all the sub-blocks of the current commit's details. -\\[egg-log-buffer-create-new-branch] create a new branch starting from the current commit. -\\[egg-log-buffer-start-new-branch] start in a new branch from the current commit. -\\[egg-log-buffer-checkout-commit] checkout the current commit. -\\[egg-log-buffer-tag-commit] create a new lightweight tag pointing at the current commit. -\\[egg-log-buffer-attach-head] move HEAD (and maybe the current branch tip) to the -current commit (the underlying git command is `reset --soft'. -C-u \\[egg-log-buffer-attach-head] move HEAD (and maybe the current branch tip) as well as -the index to the current commit (the underlying git command -is `reset --mixed'.) -C-u C-u \\[egg-log-buffer-attach-head] move HEAD (and maybe the current branch tip) and -the index to the current commit, the work dir will also be -updated (the underlying git command is `reset --hard'). -\\[egg-log-buffer-merge] will merge the current commit into HEAD. -C-u \\[egg-log-buffer-merge] will merge the current commit into HEAD but will not -auto-commit if the merge was successful. - -\\{egg-log-commit-map} - -Each ref on the commit line has extra extra keybindings:\\ -\\[egg-log-buffer-rm-ref] delete the ref under the cursor. -\\[egg-log-buffer-push-to-local] update another local ref using the ref under the cursor. - -Each local ref on the commit line has extra extra extra keybindings:\\ -\\[egg-log-buffer-push-to-remote] upload to a remote the ref under the cursor. - for a remote-tracking local branch this would updating the tracking target. - for other local refs this means uploading (or deleting) the local value - of the ref to the remote repository. -\\[egg-log-buffer-push-head-to-local] update the local ref under the cursor with the current HEAD. - -Each remote ref on the commit line has extra extra extra keybindings:\\ -\\[egg-log-buffer-fetch-remote-ref] download the new value of the ref from the remote repo. -." - (kill-all-local-variables) - (setq buffer-read-only t) - (setq major-mode 'egg-log-buffer-mode - mode-name "Egg-Log" - mode-line-process "" - truncate-lines t) - (use-local-map egg-log-buffer-mode-map) - (set (make-local-variable 'egg-buffer-refresh-func) - 'egg-log-buffer-redisplay) - (set (make-local-variable 'egg-buffer-async-cmd-refresh-func) - 'egg-log-buffer-redisplay-from-command) - (set (make-local-variable 'egg-log-buffer-comment-column) 0) - (setq buffer-invisibility-spec nil) - (run-mode-hooks 'egg-log-buffer-mode-hook)) - -(defun egg-commit-at-point () - (get-text-property (point) :commit)) - -(defun egg-ref-at-point () - (get-text-property (point) :ref)) - -(defun egg-head-at-point () - (eq (cdr (get-text-property (point) :ref)) :head)) - -(defun egg-tag-at-point () - (eq (cdr (get-text-property (point) :ref)) :tag)) - -(defun egg-remote-at-point () - (eq (cdr (get-text-property (point) :ref)) :remote)) - -(defun egg-references-at-point () - (get-text-property (point) :references)) - -(defun egg-log-commit-line-menu-attach-head-index (pos) - (interactive "d") - (egg-log-buffer-attach-head pos 4)) - -(defun egg-log-commit-line-menu-attach-head-index-wdir (pos) - (interactive "d") - (egg-log-buffer-attach-head pos 16)) - - -(defun egg-log-make-commit-line-menu (&optional heading) - (let ((map (make-sparse-keymap heading))) - (define-key map [load] (list 'menu-item "(Re)Load Commit Details" - 'egg-log-buffer-insert-commit - :visible '(egg-commit-at-point))) - (define-key map [diff] (list 'menu-item "Compare against HEAD (or BASE)" - 'egg-log-buffer-diff-revs - :visible '(egg-commit-at-point))) - (define-key map [prev] (list 'menu-item "Goto Prev Ref" - 'egg-log-buffer-prev-ref - :visible '(egg-navigation-at-point))) - (define-key map [next] (list 'menu-item "Goto Next Ref" - 'egg-log-buffer-next-ref - :visible '(egg-navigation-at-point))) - (define-key map [hs] (list 'menu-item "Hide/Show Details" - 'egg-section-cmd-toggle-hide-show - :visible '(egg-navigation-at-point))) - (define-key map [hs-sub] (list 'menu-item "Hide/Show Details of Subsections" - 'egg-section-cmd-toggle-hide-show-children - :visible '(egg-navigation-at-point))) - (define-key map [sp9] '("--")) - (define-key map [rpush] (list 'menu-item "Fetch Refs from Remote" - 'egg-log-buffer-fetch - :visible '(egg-remote-at-point))) - (define-key map [rfetch] (list 'menu-item "Push Refs to Remote" - 'egg-log-buffer-push - :visible '(egg-remote-at-point))) - (define-key map [rdown] (list 'menu-item "Fetch Remote Ref" - 'egg-log-buffer-fetch-remote-ref - :visible '(egg-ref-at-point) - :enable '(egg-remote-at-point))) - (define-key map [ldown] (list 'menu-item "Push HEAD To Ref" - 'egg-log-buffer-push-head-to-local - :visible '(egg-ref-at-point) - :enable '(not (egg-remote-at-point)))) - (define-key map [upload] (list 'menu-item "Push Ref to Remote" - 'egg-log-buffer-push-to-remote - :visible '(egg-ref-at-point) - :enable '(not (egg-remote-at-point)))) - (define-key map [update] (list 'menu-item "Push to Another Local Branch" - 'egg-log-buffer-push-to-local - :visible '(egg-ref-at-point))) - (define-key map [sp5] '("--")) - (define-key map [irebase] (list 'menu-item "Rebase HEAD interratively" - 'egg-log-buffer-rebase - :visible '(egg-commit-at-point) - :enable '(egg-log-buffer-get-marked-alist))) - (define-key map [unmark] (list 'menu-item "Unmark for interractive Rebase " - 'egg-log-buffer-unmark - :visible '(egg-commit-at-point))) - (define-key map [edit] (list 'menu-item "Mark for Editing in upcoming interractive Rebase " - 'egg-log-buffer-mark-edit - :visible '(egg-commit-at-point))) - (define-key map [squash] (list 'menu-item "Mark to be Squashed in upcoming interractive Rebase " - 'egg-log-buffer-mark-squash - :visible '(egg-commit-at-point))) - (define-key map [pick] (list 'menu-item "Mark to be Picked in upcoming interractive Rebase " - 'egg-log-buffer-mark-pick - :visible '(egg-commit-at-point))) - (define-key map [base] (list 'menu-item "Mark as Base Commit " - 'egg-log-buffer-mark - :visible '(egg-commit-at-point))) - (define-key map [sp4] '("--")) - (define-key map [rebase] (list 'menu-item "Rebase HEAD" - 'egg-log-buffer-rebase - :visible '(egg-commit-at-point))) - (define-key map [merge] (list 'menu-item "Merge to HEAD" - 'egg-log-buffer-merge - :visible '(egg-commit-at-point))) - (define-key map [sp3] '("--")) - (define-key map [rh-16] (list 'menu-item "Anchor HEAD (update INDEX and Workdir)" - 'egg-log-commit-line-menu-attach-head-index-wdir - :visible '(egg-commit-at-point))) - (define-key map [rh-4] (list 'menu-item "Anchor HEAD (update INDEX)" - 'egg-log-commit-line-menu-attach-head-index - :visible '(egg-commit-at-point))) - (define-key map [rh-0] (list 'menu-item "Anchor HEAD" - 'egg-log-buffer-attach-head - :visible '(egg-commit-at-point))) - (define-key map [sp2] '("--")) - (define-key map [reflog] (list 'menu-item "Show Ref History (Reflog)" - 'egg-log-buffer-reflog-ref - :visible '(egg-ref-at-point))) - (define-key map [rm-ref] (list 'menu-item "Remove Ref " - 'egg-log-buffer-rm-ref - :visible '(egg-ref-at-point))) - (define-key map [cb] (list 'menu-item "Create New Branch" - 'egg-log-buffer-create-new-branch - :visible '(egg-commit-at-point))) - (define-key map [co-dh] (list 'menu-item "Detach HEAD and Checkout" - 'egg-log-buffer-checkout-commit - :visible '(egg-commit-at-point))) - (define-key map [sp1] '("--")) - (define-key map [sb] (list 'menu-item "Start New Branch" - 'egg-log-buffer-start-new-branch - :visible '(egg-commit-at-point))) - (define-key map [co] (list 'menu-item "Checkout Branch" - 'egg-log-buffer-checkout-commit - :visible '(egg-head-at-point))) - (define-key map [tag] (list 'menu-item "Tag (Lightweight)" - 'egg-log-buffer-tag-commit - :visible '(egg-commit-at-point))) - (define-key map [atag] (list 'menu-item "Tag (Annotated)" - 'egg-log-buffer-atag-commit - :visible '(egg-commit-at-point))) - map)) - -(defconst egg-log-buffer-commit-line-menu (egg-log-make-commit-line-menu)) -(defconst egg-log-buffer-local-ref-menu (egg-log-make-commit-line-menu)) -(defconst egg-log-buffer-remote-ref-menu (egg-log-make-commit-line-menu)) -(defconst egg-log-buffer-remote-site-menu (egg-log-make-commit-line-menu)) -(defconst egg-log-buffer-mode-commit-menu (egg-log-make-commit-line-menu)) - -(defun egg-log-commit-line-menu-heading (pos &optional prefix) - (let ((ref (get-text-property pos :ref)) - (references (get-text-property pos :references)) - (commit (get-text-property pos :commit)) - (prefix (or prefix "(Git/Egg)"))) - (cond ((consp ref) - (format "%s %s: %s" prefix - (cond ((eq (cdr ref) :head) "Branch") - ((eq (cdr ref) :remote) "Remote") - ((eq (cdr ref) :tag) "Tag")) - (car ref))) - ((consp references) - (concat "Ref: " prefix (car (last references)))) - ((stringp commit) - (concat prefix " Commit: " - (file-name-nondirectory - (egg-name-rev commit)))) - (t "No Commit Here")))) - -(defun egg-log-commit-mouse-menu-heading (&optional prefix) - (let* ((event last-command-event) - (window (posn-window (event-end event))) - (buffer (and window (window-buffer window))) - (pos (posn-point (event-end event)))) - (egg-log-commit-line-menu-heading pos prefix))) - -(defun egg-log-popup-commit-line-menu-1 (event generic-menu) - (let* ((window (posn-window (event-end event))) - (buffer (and window (window-buffer window))) - (pos (posn-point (event-end event))) - menu keys cmd) - (when (bufferp buffer) - (save-excursion - (with-temp-buffer buffer) - (goto-char pos) - (setq menu - (nconc (list 'keymap - (egg-log-commit-line-menu-heading pos)) - (cdr generic-menu))) - (setq keys (progn - (force-mode-line-update) - (x-popup-menu event menu))) - (setq cmd (and keys (lookup-key menu (apply 'vector keys)))) - (when (and cmd (commandp cmd)) - (call-interactively cmd)))))) - -(defun egg-log-popup-local-ref-menu (event) - (interactive "e") - (egg-log-popup-commit-line-menu-1 event egg-log-buffer-local-ref-menu)) - -(defun egg-log-popup-remote-ref-menu (event) - (interactive "e") - (egg-log-popup-commit-line-menu-1 event egg-log-buffer-remote-ref-menu)) - -(defun egg-log-popup-remote-site-menu (event) - (interactive "e") - (egg-log-popup-commit-line-menu-1 event egg-log-buffer-remote-site-menu)) - -(defun egg-log-popup-commit-line-menu (event) - (interactive "e") - (egg-log-popup-commit-line-menu-1 event egg-log-buffer-commit-line-menu)) - -;; (define-key egg-log-local-ref-map [C-down-mouse-2] 'egg-popup-log-local-ref-menu) -;; (define-key egg-log-local-ref-map [C-mouse-2] 'egg-popup-log-local-ref-menu) - -(defconst egg-log-buffer-menu (make-sparse-keymap "Egg (Git)")) - -(define-key egg-log-buffer-mode-map - [menu-bar egg-log-buffer-mode] (cons "Egg (Git)" egg-log-buffer-menu)) - -(let ((menu egg-log-buffer-menu)) - (define-key menu [quit] '(menu-item "Close History View" egg-quit-buffer)) - (define-key menu [refresh] '(menu-item "Refresh History View" egg-buffer-cmd-refresh)) - (define-key menu [pickaxe] '(menu-item "Search History for Changes" - egg-search-changes)) - (define-key menu [goto] '(menu-item "Locate Line in File" - egg-log-hunk-cmd-visit-file-other-window - :enable (egg-hunk-at-point))) - (define-key menu [sp3] '("--")) - (define-key menu [commit] (list 'menu-item - '(egg-log-commit-mouse-menu-heading "Operations on ") - egg-log-buffer-mode-commit-menu - :visible '(egg-commit-at-point))) - (define-key menu [sp1] '("--")) - (define-key menu [hs] '(menu-item "Hide/Show Details" - egg-section-cmd-toggle-hide-show - :enable (egg-navigation-at-point))) - (define-key menu [hs-sub] '(menu-item "Hide/Show Details of Subsections" - egg-section-cmd-toggle-hide-show-children - :enable (egg-navigation-at-point))) - (define-key menu [prev] '(menu-item "Goto Previous Ref" egg-log-buffer-prev-ref)) - (define-key menu [next] '(menu-item "Goto Next Ref" egg-log-buffer-next-ref))) - -(defconst egg-log-buffer-help-text - (concat - (egg-text "Common Key Bindings:" 'egg-help-header-2) - "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-buffer-next-ref]:next thing " - "\\[egg-log-buffer-prev-ref]:previous thing " - "\\[egg-search-changes]:search history " - "\\[egg-status]:show repo's status " - "\\[egg-buffer-cmd-refresh]:redisplay " - "\\[egg-quit-buffer]:quit\n") - (egg-text "Extra Key Bindings for a Commit line:" 'egg-help-header-2) - "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-buffer-insert-commit]:load details " - "\\[egg-section-cmd-toggle-hide-show]:hide/show details " - "\\[egg-section-cmd-toggle-hide-show-children]:hide sub-blocks " - "\\[egg-log-buffer-checkout-commit]:checkout " - "\\[egg-log-buffer-start-new-branch]:start new branch\n" - "\\[egg-log-buffer-attach-head]:anchor HEAD " - "\\[egg-log-buffer-tag-commit]:new tag " - "\\[egg-log-buffer-atag-commit]:new annotated tag " - "\\[egg-log-buffer-create-new-branch]:create branch " - "\\[egg-log-buffer-diff-revs]:diff vs HEAD (or BASE)\n" - "\\[egg-log-buffer-merge]:merge to HEAD " - "\\[egg-log-buffer-rebase]:rebase HEAD " - "\\[egg-log-buffer-rebase-interactive]:rebase HEAD interactively" - "\n" - ) - (egg-text "Extra Key Bindings to prepare a (interactive) rebase:" 'egg-help-header-2) - "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-buffer-mark]:mark as BASE " - "\\[egg-log-buffer-mark-pick]:mark as picked " - "\\[egg-log-buffer-mark-squash]:mark as squashed " - "\\[egg-log-buffer-mark-edit]:mark as edited " - "\\[egg-log-buffer-unmark]:unmark\n") - (egg-text "Extra Extra Key Bindings for a Ref:" 'egg-help-header-2) - "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-buffer-rm-ref]:delete ref " - "\\[egg-log-buffer-push-to-local]:update another local ref " - "\\[egg-log-buffer-push-to-remote]:upload to remote " - "\\[egg-log-buffer-push-head-to-local]:download\n") - (egg-text "Extra Key Bindings for a Diff Block:" 'egg-help-header-2) - "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-diff-cmd-visit-file-other-window]:visit version/line\n") - (egg-text "References:" 'egg-help-header-2) "\n" - (egg-text "local-branch" 'egg-branch-mono) " " - (egg-text "lightweight-tag" 'egg-tag-mono) " " - (egg-text "annotated-tag" 'egg-an-tag-mono) " " - (egg-text "remote/" 'egg-remote-mono) - (egg-text "branch" 'egg-branch-mono) " " - (egg-text " HEAD " 'egg-log-HEAD) " " - "\n")) - -(defun egg-log-buffer-diff-revs (pos) - "Compare HEAD against the rev at POS." - (interactive "d") - (let* ((rev (egg-log-buffer-get-rev-at pos :symbolic)) - (mark (egg-log-buffer-find-first-mark ?*)) - (base (if mark (egg-log-buffer-get-rev-at mark :symbolic) "HEAD")) - buf) - (unless (and rev (stringp rev)) - (error "No commit here to compare against %s!" base)) - (when (string-equal rev base) - (error "It's pointless to compare %s vs %s!" rev base)) - (setq buf (egg-do-diff (egg-build-diff-info rev base))) - (pop-to-buffer buf t))) - -(defun egg-log (&optional all) - (interactive "P") - (let* ((egg-internal-current-state - (egg-repo-state (if (interactive-p) :error-if-not-git))) - (git-dir (egg-git-dir (interactive-p))) - (default-directory (file-name-directory git-dir)) - (buf (egg-get-log-buffer 'create)) - help) - (with-current-buffer buf - (when (memq :log egg-show-key-help-in-buffers) - (setq help egg-log-buffer-help-text)) - (set - (make-local-variable 'egg-internal-log-buffer-closure) - (if all - (list :description (concat - (egg-text "history scope: " 'egg-text-2) - (egg-text "all refs" 'egg-term)) - :closure (lambda () - (egg-log-buffer-insert-n-decorate-logs - 'egg-run-git-log-all))) - (list :description (concat - (egg-text "history scope: " 'egg-text-2) - (egg-text "HEAD" 'egg-term)) - :closure (lambda () - (egg-log-buffer-insert-n-decorate-logs - 'egg-run-git-log-HEAD))))) - (if help (plist-put egg-internal-log-buffer-closure :help help)) - (egg-log-buffer-redisplay buf 'init)) - (cond - (egg-switch-to-buffer (switch-to-buffer buf)) - (t (pop-to-buffer buf t))))) -;;;======================================================== -;;; file history -;;;======================================================== -(define-egg-buffer file-log "*%s-file-log@%s*" - (kill-all-local-variables) - (setq buffer-read-only t) - (setq major-mode 'egg-file-log-buffer-mode - mode-name "Egg-FileHistory" - mode-line-process "" - truncate-lines t) - (use-local-map egg-log-buffer-mode-map) - (set (make-local-variable 'egg-buffer-refresh-func) - 'egg-log-buffer-simple-redisplay) - (set (make-local-variable 'egg-log-buffer-comment-column) 0) - (setq buffer-invisibility-spec nil) - (run-mode-hooks 'egg-file-log-buffer-mode-hook)) - -(defsubst egg-run-git-file-log-HEAD (file) - (egg-git-ok t "log" (format "--max-count=%d" egg-log-HEAD-max-len) - "--graph" "--topo-order" "--no-color" - "--pretty=oneline" "--decorate" "--" file)) - -(defsubst egg-run-git-file-log-all (file) - (egg-git-ok t "log" (format "--max-count=%d" egg-log-all-max-len) - "--graph" "--topo-order" "--no-color" - "--pretty=oneline" "--decorate" "--all" "--" file)) - -(defconst egg-log-commit-simple-map - (let ((map (make-sparse-keymap "Egg:FileLogCommit"))) - (set-keymap-parent map egg-log-commit-base-map) - (define-key map (kbd "RET") 'egg-log-locate-commit) - (define-key map (kbd "C-c C-c") 'egg-log-locate-commit) - map)) - -(defsubst egg-log-buffer-decorate-logs-simple (log-insert-func arg) - (let ((beg (point))) - (funcall log-insert-func arg) - (unless (= (char-before (point-max)) ?\n) - (goto-char (point-max)) - (insert ?\n)) - (goto-char beg) - (egg-decorate-log egg-log-commit-simple-map - egg-log-commit-simple-map - egg-log-commit-simple-map - egg-log-commit-simple-map))) - -(defun egg-log-buffer-simple-redisplay (buffer &optional init) - (with-current-buffer buffer - (egg-generic-display-logs egg-internal-log-buffer-closure init))) - -(defconst egg-file-log-help-text - (concat - (egg-text "Common Key Bindings:" 'egg-help-header-2) "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-buffer-next-ref]:next thing " - "\\[egg-log-buffer-prev-ref]:previous thing " - "\\[egg-status]:show repo's status " - "\\[egg-buffer-cmd-refresh]:redisplay " - "\\[egg-quit-buffer]:quit\n" ) - (egg-text "Extra Key Bindings for a Commit line:" 'egg-help-header-2) "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-locate-commit]:locate commit in history " - "\\[egg-log-buffer-insert-commit]:load details " - "\\[egg-section-cmd-toggle-hide-show]:hide/show details " - "\\[egg-section-cmd-toggle-hide-show-children]:hide sub-blocks\n" - "\\[egg-log-buffer-attach-head]:anchor HEAD " - "\\[egg-log-buffer-checkout-commit]:checkout " - "\\[egg-log-buffer-start-new-branch]:start new branch " - "\\[egg-log-buffer-create-new-branch]:create branch\n" - "\\[egg-log-buffer-tag-commit]:new tag " - "\\[egg-log-buffer-atag-commit]:new annotated tag\n" - ) - (egg-text "Extra Key Bindings for a Diff Block:" 'egg-help-header-2) "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-diff-cmd-visit-file-other-window]:visit version/line\n") - )) - -(defun egg-file-log (file-name &optional all) - (interactive (list (buffer-file-name) current-prefix-arg)) - (unless (and file-name (file-exists-p file-name)) - (error "File does not exist: %s" file-name)) - (let ((buffer (egg-get-file-log-buffer 'create)) - (title (concat (egg-text "history of " 'egg-text-2) - (egg-text file-name 'egg-term))) - help) - (with-current-buffer buffer - (set - (make-local-variable 'egg-internal-log-buffer-closure) - (if all - (list :title title - :description (concat (egg-text "scope: " 'egg-text-2) - (egg-text "all refs" 'egg-branch-mono)) - :closure `(lambda () - (egg-log-buffer-decorate-logs-simple - #'egg-run-git-file-log-all ,file-name))) - (list :title title - :description (concat (egg-text "scope: " 'egg-text-2) - (egg-text "HEAD" 'egg-branch-mono)) - :closure `(lambda () - (egg-log-buffer-decorate-logs-simple - #'egg-run-git-file-log-HEAD ,file-name))))) - (when (memq :file-log egg-show-key-help-in-buffers) - (setq help egg-file-log-help-text)) - (if help (plist-put egg-internal-log-buffer-closure :help help))) - (egg-log-buffer-simple-redisplay buffer 'init) - (pop-to-buffer buffer t))) - -;;;======================================================== -;;; commit search -;;;======================================================== -(defconst egg-query:commit-commit-map - (let ((map (make-sparse-keymap "Egg:LogQueryCommit"))) - (set-keymap-parent map egg-hide-show-map) - (define-key map (kbd "SPC") 'egg-log-buffer-insert-commit) - (define-key map (kbd "o") 'egg-log-buffer-checkout-commit) - (define-key map (kbd "a") 'egg-log-buffer-attach-head) - (define-key map (kbd "RET") 'egg-log-locate-commit) - (define-key map (kbd "C-c C-c") 'egg-log-locate-commit) - map)) - -(defun egg-log-locate-commit (pos) - (interactive "d") - (let ((sha1 (get-text-property pos :commit)) - (buf (egg-get-log-buffer 'create))) - (with-current-buffer buf - (set (make-local-variable 'egg-internal-log-buffer-closure) - (list :description - (concat (egg-text "history scope: " 'egg-text-2) - (egg-text "HEAD" 'egg-term) - (egg-text " and " 'egg-text-2) - (egg-text sha1 'egg-term)) - :closure - (lambda () - (egg-log-buffer-insert-n-decorate-logs - `(lambda () - (egg-git-ok t "log" "--max-count=10000" "--graph" - "--topo-order" "--pretty=oneline" "--no-color" - "--decorate" "HEAD" sha1)))))) - (egg-log-buffer-redisplay buf) - (setq pos (point-min)) - (while (and pos - (not (equal (get-text-property pos :commit) sha1))) - (setq pos (next-single-property-change pos :commit)))) - (pop-to-buffer buf t) - (egg-log-buffer-goto-pos pos) - (recenter))) - -(defun egg-query:commit-buffer-rerun (buffer &optional init) - (interactive (list (current-buffer))) - (with-current-buffer buffer - (plist-put egg-internal-log-buffer-closure :title - (egg-text "History Search" 'egg-branch)) - (egg-generic-display-logs egg-internal-log-buffer-closure init))) - -(define-egg-buffer query:commit "*%s-query:commit@%s*" - (kill-all-local-variables) - (setq buffer-read-only t) - (setq major-mode 'egg-query:commit-buffer-mode - mode-name "Egg-Query:Commit" - mode-line-process "" - truncate-lines t) - (use-local-map egg-buffer-mode-map) - (set (make-local-variable 'egg-internal-log-buffer-closure) nil) - (set (make-local-variable 'egg-buffer-refresh-func) - 'egg-query:commit-buffer-rerun) - ;; re use log-buffer redrawing - (set (make-local-variable 'egg-log-buffer-comment-column) 0) - (setq buffer-invisibility-spec nil) - (run-mode-hooks 'egg-query:commit-buffer-mode-hook)) - -(defun egg-insert-n-decorate-pickaxed-logs (string) - (let ((beg (point))) - (egg-git-ok t "log" "--pretty=oneline" "--decorate" "--no-color" - (concat "-S" string)) - (goto-char beg) - (egg-decorate-log egg-query:commit-commit-map - egg-query:commit-commit-map - egg-query:commit-commit-map - egg-query:commit-commit-map))) - -(defun egg-search-changes (string) - (interactive "ssearch history for changes containing: ") - (let* ((git-dir (egg-git-dir (interactive-p))) - (default-directory (file-name-directory git-dir)) - (buf (egg-get-query:commit-buffer 'create)) - (desc (concat (egg-text "Commits containing: " 'egg-text-2) - (egg-text string 'egg-term))) - (func `(lambda () - (egg-insert-n-decorate-pickaxed-logs ,string)))) - (with-current-buffer buf - (set (make-local-variable 'egg-internal-log-buffer-closure) - (list :description desc :closure func)) - (egg-query:commit-buffer-rerun buf 'init)) - (pop-to-buffer buf t))) -;;;======================================================== -;;; reflog -;;;======================================================== -(defsubst egg-run-reflog-branch (branch) - (egg-git-ok t "log" "-g" "--pretty=oneline" "--decorate" "--no-color" - (format "--max-count=%d" egg-log-HEAD-max-len) - branch)) - -(define-egg-buffer reflog "*%s-reflog@%s*" - (egg-file-log-buffer-mode) - (setq major-mode 'egg-reflog-buffer-mode - mode-name "Egg-RefLog") - (run-mode-hooks 'egg-reflog-buffer-mode-hook)) - -(defconst egg-reflog-help-text - (concat - (egg-text "Common Key Bindings:" 'egg-help-header-2) "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-buffer-next-ref]:next thing " - "\\[egg-log-buffer-prev-ref]:previous thing " - "\\[egg-status]:show repo's status " - "\\[egg-buffer-cmd-refresh]:redisplay " - "\\[egg-quit-buffer]:quit\n" ) - (egg-text "Extra Key Bindings for a Commit line:" 'egg-help-header-2) "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-locate-commit]:locate commit in history " - "\\[egg-log-buffer-insert-commit]:load details " - "\\[egg-section-cmd-toggle-hide-show]:hide/show details " - "\\[egg-section-cmd-toggle-hide-show-children]:hide sub-blocks\n" - "\\[egg-log-buffer-attach-head]:anchor HEAD " - "\\[egg-log-buffer-checkout-commit]:checkout " - "\\[egg-log-buffer-tag-commit]:new tag " - "\\[egg-log-buffer-atag-commit]:new annotated tag\n" - ) - (egg-text "Extra Key Bindings for a Diff Block:" egg-help-header-2) "\n" - (egg-pretty-help-text - "\\" - "\\[egg-log-diff-cmd-visit-file-other-window]:visit version/line\n") - "\n" - )) - -(defun egg-reflog (branch) - (interactive (list (if current-prefix-arg - (egg-read-rev "show history of ref: " "HEAD") - "HEAD"))) - (unless branch (setq branch "HEAD")) - (let ((egg-internal-current-state (egg-repo-state :error-if-not-git)) - (buffer (egg-get-reflog-buffer 'create)) - (title (concat (egg-text "history of " 'egg-text-2) - (egg-text branch 'egg-branch))) - help) - (with-current-buffer buffer - (set - (make-local-variable 'egg-internal-log-buffer-closure) - (list :title title - :closure `(lambda () - (egg-log-buffer-decorate-logs-simple - #'egg-run-reflog-branch ,branch)))) - (when (memq :reflog egg-show-key-help-in-buffers) - (setq help egg-reflog-help-text)) - (if help (plist-put egg-internal-log-buffer-closure :help help))) - (egg-log-buffer-simple-redisplay buffer 'init) - (pop-to-buffer buffer t))) - -(defun egg-log-buffer-reflog-ref (pos) - (interactive "d") - (egg-reflog (car (get-text-property pos :ref)))) - -;;;======================================================== -;;; stash -;;;======================================================== -(defsubst egg-list-stash (&optional ignored) - (egg-git-ok t "stash" "list" "--pretty=oneline")) - -(define-egg-buffer stash "*%s-stash@%s*" - (egg-file-log-buffer-mode) - (use-local-map egg-stash-buffer-mode-map) - (setq major-mode 'egg-stash-buffer-mode - mode-name "Egg-Stash") - (run-mode-hooks 'egg-stash-buffer-mode-hook)) - -(defun egg-stash-buffer-do-insert-stash (pos) - (save-excursion - (let ((stash (get-text-property pos :stash)) - (nav (get-text-property pos :navigation)) - (inhibit-read-only t) - beg end) - (goto-char pos) - (goto-char (1+ (line-end-position))) - (setq beg (point)) - (unless (egg-git-ok t "stash" "show" "-p" - "--src-prefix=BASE:/" "--dst-prefix=WIP:/" - stash) - (error "error calling git stash show %s!" stash)) - (setq end (point)) - (egg-delimit-section :stash stash beg end (1- beg) nil nav) - (put-text-property beg end 'keymap egg-section-map) - (egg-decorate-diff-section :begin beg - :end end - :src-prefix "BASE:/" - :dst-prefix "WIP:/" - :diff-map egg-log-diff-map - :hunk-map egg-log-hunk-map) - (goto-char beg) - (setq end (next-single-property-change beg :diff)) -;;; (put-text-property beg (+ indent-column beg) 'face 'egg-diff-none) -;;; (put-text-property (+ indent-column beg) (line-end-position) -;;; 'face 'egg-text-2) - (forward-line 1) - (set-buffer-modified-p nil)))) - -(defun egg-stash-buffer-show (pos) - (interactive "d") - (let* ((next (next-single-property-change pos :diff)) - (stash (and next (get-text-property next :stash)))) - (unless (equal (get-text-property pos :stash) stash) - (egg-stash-buffer-do-insert-stash pos)))) - -(defun egg-stash-buffer-pop (&optional no-confirm) - (interactive "P") - (unless (egg-wdir-clean) - (egg-status) - (error "Cannot aplly stash on dirty work-dir")) - (when (or no-confirm - (y-or-n-p "pop and apply last WIP to repo? ")) - (when (egg-do-pop-stash) - (message "GIT-STASH> successfully popped and applied last WIP") - (egg-status)))) - -(defun egg-stash-buffer-apply (pos &optional no-confirm) - (interactive "dP") - (unless (egg-wdir-clean) - (egg-status) - (error "Cannot aplly stash on dirty work-dir")) - (let ((stash (get-text-property pos :stash))) - (when (and stash (stringp stash) - (or no-confirm - (y-or-n-p (format "apply WIP %s to repo? " stash)))) - (when (egg-do-apply-stash stash) - (message "GIT-STASH> successfully applied %s" stash) - (egg-status))))) - -(defun egg-buffer-stash-wip (msg) - (interactive "sshort description of this work-in-progress: ") - (egg-do-stash-wip msg) - (egg-stash)) - -(defconst egg-stash-buffer-mode-map - (let ((map (make-sparse-keymap "Egg:StashBuffer"))) - (set-keymap-parent map egg-buffer-mode-map) - (define-key map "n" 'egg-stash-buffer-next-stash) - (define-key map "s" 'egg-status) - (define-key map "p" 'egg-stash-buffer-prev-stash) - (define-key map (kbd "RET") 'egg-stash-buffer-pop) - (define-key map (kbd "o") 'egg-stash-buffer-pop) - (define-key map "l" 'egg-log) - - map)) - -(defconst egg-stash-map - (let ((map (make-sparse-keymap "Egg:Stash"))) - (set-keymap-parent map egg-hide-show-map) - (define-key map (kbd "SPC") 'egg-stash-buffer-show) - (define-key map (kbd "RET") 'egg-stash-buffer-apply) - (define-key map "a" 'egg-stash-buffer-apply) - (define-key map (kbd "DEL") 'egg-stash-buffer-drop) - (define-key map "x" 'egg-stash-buffer-drop) - (define-key map "X" 'egg-stash-buffer-clear) - map)) - -(defun egg-stash-buffer-next-stash () - "Move to the next stash." - (interactive) - (egg-buffer-cmd-next-block :stash)) - -(defun egg-stash-buffer-prev-stash () - "Move to the previous stash." - (interactive) - (egg-buffer-cmd-prev-block :stash)) - - -(defconst egg-stash-help-text - (concat - (egg-text "Common Key Bindings:" 'egg-help-header-2) "\n" - (egg-pretty-help-text - "\\" - "\\[egg-stash-buffer-next-stash]:next stash " - "\\[egg-stash-buffer-prev-stash]:previous stash " - "\\[egg-status]:show repo's status " - "\\[egg-buffer-cmd-refresh]:redisplay " - "\\[egg-quit-buffer]:quit\n" ) - (egg-text "Extra Key Bindings for a Stash line:" 'egg-help-header-2) "\n" - (egg-pretty-help-text - "\\" - "\\[egg-stash-buffer-apply]:apply\n" - "\\[egg-stash-buffer-show]:load details\n" - "\\[egg-stash-buffer-drop]:delete stash\n" - "\\[egg-stash-buffer-pop]:pop and apply stash\n" - "\\[egg-stash-buffer-clear]:delete all\n" - ) - "\n" - )) - -(defun egg-decorate-stash-list (&optional line-map) - (let ((start (point)) stash-beg stash-end beg end msg-beg msg-end - name msg) - (save-excursion - (while (re-search-forward "^\\(stash@{[0-9]+}\\): +\\(.+\\)$" nil t) - (setq beg (match-beginning 0) - stash-end (match-end 1) - msg-beg (match-beginning 2) - end (match-end 0)) - - (setq name (buffer-substring-no-properties beg stash-end) - msg (buffer-substring-no-properties msg-beg end)) - - ;; entire line - (add-text-properties beg (1+ end) - (list :navigation name - :stash name - 'keymap line-map)) - - ;; comment - (put-text-property beg stash-end 'face 'egg-stash-mono) - (put-text-property msg-beg end 'face 'egg-text-2))))) - -(defsubst egg-stash-buffer-decorate-stash-list () - (let ((beg (point))) - (egg-list-stash) - (unless (= (char-before (point-max)) ?\n) - (goto-char (point-max)) - (insert ?\n)) - (goto-char beg) - (egg-decorate-stash-list egg-stash-map))) - -(defun egg-stash () - (interactive) - (let ((egg-internal-current-state (egg-repo-state :error-if-not-git)) - (buffer (egg-get-stash-buffer 'create)) - title help) - (setq title (concat (egg-text "Stash(es)" 'egg-branch))) - (with-current-buffer buffer - (set - (make-local-variable 'egg-internal-log-buffer-closure) - (list :title title - :closure #'egg-stash-buffer-decorate-stash-list)) - (when (memq :stash egg-show-key-help-in-buffers) - (setq help egg-stash-help-text)) - (if help (plist-put egg-internal-log-buffer-closure :help help))) - (egg-log-buffer-simple-redisplay buffer 'init) - (pop-to-buffer buffer t))) - - -;;;======================================================== -;;; annotated tag -;;;======================================================== -(defvar egg-internal-annotated-tag-name nil) -(defvar egg-internal-annotated-tag-target nil) - -(defun egg-tag-msg-create-tag () - (let (output) - (setq output - (egg-sync-git-region egg-log-msg-text-beg egg-log-msg-text-end - "tag" "-a" "-F" "-" - egg-internal-annotated-tag-name - egg-internal-annotated-tag-target)) - (when output - (egg-show-git-output output -1 "GIT-ANNOTATED-TAG") - (egg-run-buffers-update-hook)))) - -(define-egg-buffer tag:msg "*%s-tag:msg@%s*" - (egg-log-msg-mode) - (setq major-mode 'egg-tag:msg-buffer-mode - mode-name "Egg-Tag:Msg" - mode-line-process "") - (make-local-variable 'egg-internal-annotated-tag-name) - (setq buffer-invisibility-spec nil) - (run-mode-hooks 'egg-tag:msg-mode-hook)) - - -(defun egg-create-annotated-tag (name commit-1) - (let* ((git-dir (egg-git-dir)) - (default-directory (file-name-directory git-dir)) - (buf (egg-get-tag:msg-buffer 'create)) - (commit (egg-git-to-string "rev-parse" "--verify" commit-1)) - (pretty (egg-describe-rev commit)) - (inhibit-read-only inhibit-read-only)) - (or commit (error "Bad commit: %s" commit-1)) - (pop-to-buffer buf t) - (setq inhibit-read-only t) - (erase-buffer) - (set (make-local-variable 'egg-log-msg-action) - 'egg-tag-msg-create-tag) - (set (make-local-variable 'egg-internal-annotated-tag-name) name) - (set (make-local-variable 'egg-internal-annotated-tag-target) commit) - (insert (egg-text "Create Annotated Tag" 'egg-text-2) " " - (egg-text name 'egg-branch) "\n\n" - (egg-text "on commit:" 'egg-text-2) " " - (egg-text commit 'font-lock-string-face) "\n" - (egg-text "aka:" 'egg-text-2) " " - (egg-text pretty 'font-lock-string-face) "\n" - (egg-text "Repository: " 'egg-text-2) - (egg-text git-dir 'font-lock-constant-face) "\n" - (egg-text "----------------- Tag Message (type C-c C-c when done) ---------------" - 'font-lock-comment-face)) - (put-text-property (point-min) (point) 'read-only t) - (put-text-property (point-min) (point) 'rear-sticky nil) - (insert "\n") - (set (make-local-variable 'egg-log-msg-text-beg) (point-marker)) - (set-marker-insertion-type egg-log-msg-text-beg nil) - (set (make-local-variable 'egg-log-msg-text-end) (point-marker)) - (set-marker-insertion-type egg-log-msg-text-end t))) -;;;======================================================== -;;; minor-mode -;;;======================================================== -(defun egg-file-toggle-blame-mode (save) - (interactive "P") - (unless (buffer-file-name) - (error "Current buffer has no associated file!")) - (when (and (buffer-modified-p) - (or save - (y-or-n-p (format "save %s first? " (buffer-file-name))))) - (save-buffer)) - (let (blame-was-on buffer-was-readonly) - (mapc (lambda (ov) - (when (overlay-get ov :blame) - (setq buffer-was-readonly (plist-get (overlay-get ov :blame) - :buffer-read-only)) - (setq blame-was-on t))) - (overlays-at (point))) - (if blame-was-on - (progn (egg-file-buffer-blame-off (current-buffer)) - (set-buffer-modified-p nil) - (setq buffer-read-only buffer-was-readonly)) - (egg-file-buffer-blame-on (current-buffer) - :buffer-read-only buffer-read-only) - (set-buffer-modified-p nil) - (setq buffer-read-only t)))) - -(defun egg-file-diff (&optional ask) - "Diff the current file in another window." - (interactive "P") - (unless (buffer-file-name) - (error "Current buffer has no associated file!")) - (let ((git-file (egg-buf-git-name)) - (src-rev (and ask (egg-read-rev "diff against: " "HEAD"))) - buf) - (setq buf (egg-do-diff (egg-build-diff-info src-rev nil git-file))) - (pop-to-buffer buf t))) - -(defun egg-file-checkout-other-version (&optional no-confirm) - "Checkout HEAD's version of the current file. -if CONFIRM-P was not null, then ask for confirmation if the -current file contains unstaged changes." - (interactive "P") - (unless (buffer-file-name) - (error "Current buffer has no associated file!")) - (let* ((file (buffer-file-name)) - (file-modified (not (egg-file-committed (buffer-file-name)))) - rev) - (when file-modified - (unless (y-or-n-p (format "ignored uncommitted changes in %s? " file)) - (error "File %s contains uncommitted changes!" file))) - (setq rev (egg-read-rev (format "checkout %s version: " file) "HEAD")) - (when (egg-sync-do-file file egg-git-command nil nil - (list "checkout" rev "--" file)) - (revert-buffer t t t)))) - -(defun egg-file-cancel-modifications (&optional no-confirm) - "Checkout INDEX's version of the current file. -if CONFIRM-P was not null, then ask for confirmation if the -current file contains unstaged changes." - (interactive "P") - (unless (buffer-file-name) - (error "Current buffer has no associated file!")) - (let* ((file (buffer-file-name)) - (file-modified (not (egg-file-updated (buffer-file-name)))) - rev) - (when (and file-modified (not no-confirm)) - (unless (y-or-n-p (format "ignored unstaged changes in %s? " file)) - (error "File %s contains unstaged changes!" file))) - (when (egg-sync-do-file file egg-git-command nil nil - (list "checkout" "--" file)) - (revert-buffer t t t)))) - -(defun egg-start-new-branch () - (interactive) - (egg-do-create-branch nil 'checkout "start new branch with name: ")) - -(defun egg-file-get-other-version (file &optional rev prompt same-mode name) - (let* ((mode (assoc-default file auto-mode-alist 'string-match)) - (git-dir (egg-git-dir)) - (lbranch (egg-current-branch)) - (rbranch (and git-dir (or (egg-tracking-target lbranch) - rev ":0"))) - (prompt (or prompt (format "%s's version: " file))) - (rev (or rev (egg-read-rev prompt rbranch))) - (canon-name (egg-file-git-name file)) - (git-name (concat rev ":" canon-name)) - (buf (get-buffer-create (concat "*" (or name git-name) "*")))) - (with-current-buffer buf - (let ((inhibit-read-only t)) - (erase-buffer) - (unless (= (call-process egg-git-command nil buf nil "show" - git-name) - 0) - (error "Failed to get %s's version: %s" file rev)) - (when (and (functionp mode) same-mode) - (funcall mode)) - (set-buffer-modified-p nil) - (setq buffer-read-only t))) - buf)) - -(defun egg-file-version-other-window (&optional ask) - "Show other version of the current file in another window." - (interactive "P") - (unless (buffer-file-name) - (error "Current buffer has no associated file!")) - (let ((buf (egg-file-get-other-version - (buffer-file-name) (if ask nil ":0") - (format "show %s's version:" (buffer-file-name)) - t))) - (unless (bufferp buf) - (error "Oops! can't get %s older version" (buffer-file-name))) - (pop-to-buffer buf t))) - -(defun egg-file-ediff (&optional ask-for-dst) - (interactive "P") - (unless (buffer-file-name) - (error "Current buffer has no associated file!")) - (let* ((file buffer-file-name) - (dst-buf (if ask-for-dst - (egg-file-get-other-version - (buffer-file-name) nil - (format "(ediff) %s's newer version: " file) - t) - (current-buffer))) - (src-buf (egg-file-get-other-version - (buffer-file-name) - nil - (format "(ediff) %s's older version: " file) - t))) - (unless (and (bufferp dst-buf) (bufferp src-buf)) - (error "Ooops!")) - (ediff-buffers dst-buf src-buf))) - -(defun egg-resolve-merge-with-ediff (&optional what) - (interactive "P") - (unless (buffer-file-name) - (error "Current buffer has no associated file!")) - (let* ((file buffer-file-name) - (short-file (file-name-nondirectory file)) - (ours (egg-file-get-other-version file ":2" nil t (concat "our:" short-file))) - (theirs (egg-file-get-other-version file ":3" nil t (concat "their:" short-file)))) - (unless (and (bufferp ours) (bufferp theirs)) - (error "Ooops!")) - (ediff-buffers3 theirs ours (current-buffer)))) - -(defun egg-file-do-ediff (closer-rev closer-rev-name &optional further-rev further-rev-name ediff2) - (unless (buffer-file-name) - (error "Current buffer has no associated file!")) - (let* ((file buffer-file-name) - (short-file (file-name-nondirectory file)) - (closer-name (concat (or closer-rev-name closer-rev) - ":" short-file)) - (this (egg-file-get-other-version file closer-rev nil t closer-name)) - (further-name (and further-rev - (concat (or further-rev-name further-rev) - ":" short-file))) - (that (and further-rev - (egg-file-get-other-version file further-rev nil t further-name)))) - (unless (bufferp this) (error "Ooops!")) - (unless (or (null further-rev) (bufferp that)) (error "Ooops!")) - (if (bufferp that) - (if ediff2 - (ediff-buffers that this) - (ediff-buffers3 that this (current-buffer))) - (ediff-buffers this (current-buffer))))) - -(defconst egg-key-action-alist - '((?m :merge-file "[m]erge current file" "Resolve merge conflict(s) in current file.") - (?f :stage-file "stage current [f]ile" "Stage current file's changes") - (?s :status "show repo's [s]tatus" "Browse the current status of the repo" ) - (?a :stage-all "stage [a]ll files" "Stage all current changes inside this repo.") - (?r :rebase-continue "continue [r]rebase" "Continue with the current rebase session.") - (?d :diff-file "[d]iff current file" "Compare the current file against the staged snapshot.") - (?c :commit "[c]ommit staged changes" "Proceed to commit current staged changes onto HEAD.") - (?y :sync "s[y]nc" "Synchronize branches and repos (push/fetch).") - (?? :more-options "[?] more options" nil) - (?b :new-branch "start new [b]ranch" "Create and switch to a new branch starting from HEAD.") - (?q :quit "[q] quit" nil))) - -(defconst egg-action-function-alist - '((:merge-file . egg-resolve-merge-with-ediff) - (:stage-file . egg-file-stage-current-file) - (:status . egg-status) - (:stage-all . egg-stage-all-files) - (:rebase-continue . egg-buffer-rebase-continue) - (:diff-file . egg-file-diff) - (:commit . egg-commit-log-edit) - (:sync . egg-log) - (:new-branch . egg-start-new-branch) - (:quit . (lambda () (interactive) (message "do nothing now! later.") (ding) nil)))) - -(defconst egg-action-menu-name-alist - '((:merge-file . "Resolve File's Merge Conflicts using Ediff") - (:stage-file . "Stage File's Modifications") - (:status . "View Project Status") - (:stage-all . "Stage All Project's Modifications") - (:rebase-continue . "Continue Rebase Session") - (:diff-file . "Show File's Modifications (Diff)") - (:commit . "Commit Staged Changes") - (:sync . "Show Project History") - (:new-branch . "Start a New Branch"))) - -(defconst egg-electrict-select-action-buffer - (get-buffer-create "*Egg:Select Action*")) - -(defun egg-select-action-run () - (interactive) - (let (action) - (save-excursion - (with-current-buffer egg-electrict-select-action-buffer - (beginning-of-line) - (when (boundp 'egg-electric-in-progress-p) - (setq action (get-text-property (point) :action)) - (if action - (throw 'egg-select-action action) - (ding))))))) - -(defun egg-select-action-quit () - (interactive) - (let (action) - (save-excursion - (with-current-buffer egg-electrict-select-action-buffer - (beginning-of-line) - (when (boundp 'egg-electric-in-progress-p) - (throw 'egg-select-action nil)))))) - -(defconst egg-electric-select-action-map - (let ((map (make-sparse-keymap "Egg:SelectAction"))) - (define-key map "q" 'egg-select-action-quit) - (define-key map (kbd "RET") 'egg-select-action-run) - (define-key map (kbd "SPC") 'egg-select-action-run) - (define-key map (kbd "C-l") 'recenter) - map)) - -(defun egg-electric-select-action (default banner &optional alternatives) - (let ((egg-electric-in-progress-p t) - (old-buffer (current-buffer)) - (buf egg-electrict-select-action-buffer) - (action-alist - (delq nil (mapcar (lambda (entry) - (if (and (cadddr entry) - (or (null alternatives) - (memq (cadr entry) alternatives))) - (cons (cadr entry) - (cadddr entry)))) - egg-key-action-alist))) - action default-entry beg) - (setq default-entry (assq default action-alist)) - (setq action-alist - (cons default-entry (remq default-entry action-alist))) - (unwind-protect - (setq action - (catch 'egg-select-action - (save-window-excursion - (with-current-buffer buf - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (egg-text "Select Action\n" - 'egg-section-title)) - (insert (egg-text banner 'egg-text-1) "\n\n") - (insert (egg-text "select an action:" 'egg-text-1) - "\n\n") - (put-text-property (point-min) (point) - 'intangible t) - (setq beg (point)) - (insert - (mapconcat - (lambda (entry) - (egg-prop (concat "- " (cdr entry)) - :action (car entry) - 'face 'egg-electrict-choice)) - action-alist - "\n") - "\n") - (goto-char beg) - (set-buffer-modified-p nil) - (setq buffer-read-only t)) - (setq major-mode 'egg-select-action) - (setq mode-name "Egg-Select") - (use-local-map egg-electric-select-action-map)) - (Electric-pop-up-window egg-electrict-select-action-buffer) - (goto-char beg) - (Electric-command-loop 'egg-select-action - "select next action> ")))) - (bury-buffer buf)) - (when (and action (symbolp action)) - action))) - -(defsubst egg-guess-next-action (desc) - (cond ((memq :file-has-merged-conflict desc) :merge-file) - ((memq :file-is-modified desc) :stage-file) - ((memq :file-is-unmerged desc) :stage-file) - ((memq :wdir-has-merged-conflict desc) :status) - ((memq :wdir-has-unmerged-files desc) :stage-all) - ((memq :wdir-is-modified desc) :stage-all) - ((memq :rebase-in-progress desc) :rebase-continue) - ((memq :has-staged-changes desc) :commit) - (t :sync))) - -(defun egg-limit-alternative-actions (desc) - (let ((alternatives (mapcar 'car egg-action-function-alist))) - (unless (memq :file-has-merged-conflict desc) - (setq alternatives (delq :merge-file alternatives))) - (unless (memq :file-is-modified desc) - (setq alternatives (delq :diff-file (delq :stage-file alternatives)))) - (when (or (not (memq :wdir-is-modified desc)) - (memq :wdir-has-merged-conflict desc)) - (setq alternatives (delq :stage-all alternatives))) - (when (or (not (memq :rebase-in-progress desc)) - (memq :wdir-is-modified desc)) - (setq alternatives (delq :rebase-continue alternatives))) - (when (or (memq :wdir-is-modified desc) - (memq :rebase-in-progress desc) - (not (memq :has-staged-changes desc))) - (setq alternatives (delq :commit alternatives))) - (when (or (memq :wdir-has-merged-conflict desc) - (memq :rebase-in-progress desc)) - (setq alternatives (delq :new-branch alternatives))) - (when (or (memq :wdir-is-modified desc) - (memq :has-staged-changes desc) - (memq :rebase-in-progress desc)) - (setq alternatives (delq :sync alternatives))) - alternatives)) - - - -(defun egg-describe-state (state) - (let* ((git-dir (plist-get state :gitdir)) - (current-file (buffer-file-name)) - (default-directory (file-name-directory git-dir)) - (file-git-name (and current-file (egg-file-git-name current-file))) - (unstaged-files (plist-get state :unstaged)) - (staged-files (plist-get state :staged)) - (unmerged-files (plist-get state :unmerged)) - desc dummy) - (when unstaged-files - (setq desc (cons :wdir-is-modified desc))) - - (when staged-files - (setq desc (cons :has-staged-changes desc))) - - (when unmerged-files - (setq desc (cons :wdir-has-unmerged-files desc))) - - (when (plist-get state :rebase-step) - (setq desc (cons :rebase-in-progress desc))) - - (when unstaged-files - (with-temp-buffer - (egg-git-ok t "diff") - (setq dummy (buffer-string)) - (save-match-data - (goto-char (point-min)) - (if (search-forward "\n++<<<<<<<" nil t) - (setq desc (cons :wdir-has-merged-conflict desc))))) - - (when (and file-git-name (member file-git-name unstaged-files)) - (setq desc (cons :file-is-modified desc)) - (with-temp-buffer - (egg-git-ok t "diff" file-git-name) - (setq dummy (buffer-string)) - (save-match-data - (goto-char (point-min)) - (if (search-forward "\n++<<<<<<<" nil t) - (setq desc (cons :file-has-merged-conflict desc))))) - (when (member file-git-name unmerged-files) - (setq desc (cons :file-is-unmerged desc))))) - desc)) - -(defsubst egg-build-key-prompt (prefix default alternatives) - (let ((action-desc-alist (mapcar 'cdr egg-key-action-alist))) - (concat prefix " default: " - (nth 1 (assq default action-desc-alist)) - ". alternatives: " - (mapconcat 'identity - (mapcar (lambda (action) - (nth 1 (assq action action-desc-alist))) - (remq default alternatives)) ", ")))) - -(defun egg-prompt-next-action (described-state) - (let ((default (egg-guess-next-action described-state)) - (limited-alternatives (egg-limit-alternative-actions described-state)) - banner key action alternatives) - (setq alternatives (list default :status :more-options)) - (while (null action) - (setq key (read-key-sequence - (egg-build-key-prompt "next action?" - default alternatives))) - (setq key (string-to-char key)) - (setq action - (if (memq key '(?\r ?\n ?\ )) - default - (cadr (assq key egg-key-action-alist)))) - (when (eq action :more-options) - (setq banner - (format "%s %s\n%s %s\nINDEX %s" - (buffer-file-name) - (cond ((memq :file-has-merged-conflict described-state) - "contains conflicting merge-changes") - ((memq :file-is-modified described-state) - "contains unstaged changes") - (t "is not modified")) - (file-name-directory (egg-git-dir)) - (cond ((memq :wdir-has-merged-conflict described-state) - "has files with conflicting merge changes") - ((memq :wdir-is-modified described-state) - "has files with unstaged changes") - (t "is clean")) - (cond ((memq :rebase-in-progress described-state) - "has unfinished rebase session") - ((memq :has-staged-changes described-state) - "contains staged changes ready to commit") - (t "is empty")))) - (setq action (egg-electric-select-action default banner limited-alternatives))) - (when (null action) - (ding))) - action)) - -(defun egg-next-action (&optional ask) - (interactive "P") - (save-some-buffers nil 'egg-is-in-git) - (let* ((state (egg-repo-state :unstaged :staged :error-if-not-git)) - (desc (egg-describe-state state)) - action default) - (setq action (if (or ask egg-confirm-next-action) - (egg-prompt-next-action desc) - (egg-guess-next-action desc))) - - (call-interactively (cdr (assq action egg-action-function-alist))))) - -(defun egg-file-next-action-menu-name () - (let* ((state (egg-repo-state :unstaged :staged :error-if-not-git)) - (desc (egg-describe-state state)) - (action (egg-guess-next-action desc))) - (concat "Next Action: " - (cdr (assq action egg-action-menu-name-alist))))) - -(defun egg-file-next-action-menu-binding (&optional ignored) - (let* ((state (egg-repo-state :unstaged :staged :error-if-not-git)) - (desc (egg-describe-state state)) - (action (egg-guess-next-action desc))) - (cdr (assq action egg-action-function-alist)))) - -(defvar egg-minor-mode nil) -(defvar egg-minor-mode-map (make-sparse-keymap "Egg")) -(defvar egg-file-cmd-map (make-sparse-keymap "Egg:File")) - -(defun egg-mode-key-prefix-set (var val) - (define-key egg-minor-mode-map (read-kbd-macro val) egg-file-cmd-map) - (custom-set-default var val)) - -(defun egg-file-log-pickaxe (string) - (interactive (list (read-string "search history for: " - (egg-string-at-point)))) - (egg-search-changes string)) - -(let ((map egg-file-cmd-map)) - (define-key map (kbd "a") 'egg-file-toggle-blame-mode) - (define-key map (kbd "b") 'egg-start-new-branch) - (define-key map (kbd "d") 'egg-status) - (define-key map (kbd "c") 'egg-commit-log-edit) - (define-key map (kbd "e") 'egg-file-ediff) - (define-key map (kbd "g") 'egg-grep) - (define-key map (kbd "i") 'egg-file-stage-current-file) - (define-key map (kbd "l") 'egg-log) - (define-key map (kbd "L") 'egg-reflog) - (define-key map (kbd "h") 'egg-file-log) - (define-key map (kbd "o") 'egg-file-checkout-other-version) - (define-key map (kbd "s") 'egg-status) - (define-key map (kbd "u") 'egg-file-cancel-modifications) - (define-key map (kbd "v") 'egg-next-action) - (define-key map (kbd "w") 'egg-commit-log-edit) - (define-key map (kbd "/") 'egg-file-log-pickaxe) - (define-key map (kbd "=") 'egg-file-diff) - (define-key map (kbd "~") 'egg-file-version-other-window)) - -(defconst egg-minor-mode-menu (make-sparse-keymap "Egg (Git)")) -(define-key egg-minor-mode-map [menu-bar egg-minor-mode-menu] - (cons "Egg (Git)" egg-minor-mode-menu)) - -(let ((menu egg-minor-mode-menu)) - (define-key menu [reflog] '(menu-item "View RefLog" egg-reflog)) - (define-key menu [log] '(menu-item "View Project History" egg-log)) - (define-key menu [status] '(menu-item "View Project Status" egg-status)) - (define-key menu [blame] '(menu-item "Toggle Blame Mode" egg-file-toggle-blame-mode)) - (define-key menu [sp3] '("--")) - (define-key menu [grep] '(menu-item "Search Project's Other Versions (grep)" egg-grep)) - (define-key menu [pickaxe] '(menu-item "Search File History" egg-file-log-pickaxe)) - (define-key menu [vother] '(menu-item "View File Other Version" egg-file-version-other-window)) - (define-key menu [filelog] '(menu-item "View File History" egg-file-log)) - (define-key menu [sp2] '("--")) - (define-key menu [cother] '(menu-item "Checkout File's Other Version" egg-file-checkout-other-version)) - (define-key menu [ediff] - '(menu-item "EDiff File (vs INDEX)" egg-file-ediff - :enable (not (egg-file-updated (buffer-file-name))))) - (define-key menu [diff] - '(menu-item "Diff File (vs INDEX)" egg-file-diff - :enable (not (egg-file-updated (buffer-file-name))))) - (define-key menu [sp1] '("--")) - (define-key menu [undo] - '(menu-item "Cancel Modifications (revert to INDEX)" egg-file-cancel-modifications - :enable (not (egg-file-updated (buffer-file-name))))) - (define-key menu [commit] - '(menu-item "Commit Staged Changes" egg-commit-log-edit - :enable (not (egg-file-index-empty (buffer-file-name))))) - (define-key menu [stage] - '(menu-item "Stage File's Modifications" egg-file-stage-current-file - :enable (not (egg-file-updated (buffer-file-name))))) - (define-key menu [sp0] '("--")) - (define-key menu [next] - '(menu-item (egg-file-next-action-menu-name) egg-next-action - :keys "\\[egg-next-action]" - :filter egg-file-next-action-menu-binding))) - -(defcustom egg-mode-key-prefix "C-x v" - "Prefix keystrokes for egg minor-mode commands." - :group 'egg - :type 'string - :set 'egg-mode-key-prefix-set) - -(defvar egg-minor-mode-name " Git") - -;;;###autoload -(defun egg-minor-mode (&optional arg) - "Turn-on egg-minor-mode which would enable key bindings for -egg in current buffer.\\ -\\[egg-start-new-branch] start a new branch from the current HEAD. -\\[egg-status] shows the repo's current status -\\[egg-commit-log-edit] start editing the commit message for the current staged changes. -\\[egg-file-stage-current-file] stage new changes of the current file -\\[egg-log] shows repo's history -\\[egg-file-checkout-other-version] checkout another version of the current file -\\[egg-file-cancel-modifications] delete unstaged modifications in the current file -\\[egg-next-action] perform the next logical action -\\[egg-file-diff] compare file with index or other commits -\\[egg-file-version-other-window] show other version of the current file. - -\\{egg-minor-mode-map} -" - (interactive "p") - (setq egg-minor-mode (if (null arg) - (not egg-minor-mode) - (> arg 0))) - (when egg-minor-mode - (if (boundp 'vc-mode) - (set 'vc-mode nil)) - (make-local-variable 'egg-minor-mode-name) - (setq egg-minor-mode-name - (intern (concat "egg-" (egg-git-dir) "-HEAD"))))) - -;;;###autoload -(defun egg-minor-mode-find-file-hook () - (when (egg-is-in-git) - (make-local-variable 'egg-minor-mode) - (egg-minor-mode 1))) - -(when (or - (string-match "\\`git version 1.6." - (shell-command-to-string - (concat egg-git-command " --version"))) - (string-match "\\`git version 1.7." - (shell-command-to-string - (concat egg-git-command " --version")))) - (or (assq 'egg-minor-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(egg-minor-mode egg-minor-mode-name) minor-mode-alist))) - - (setcdr (or (assq 'egg-minor-mode minor-mode-map-alist) - (car (setq minor-mode-map-alist - (cons (list 'egg-minor-mode) - minor-mode-map-alist)))) - egg-minor-mode-map) - - (add-hook 'find-file-hook 'egg-git-dir) - (add-hook 'find-file-hook 'egg-minor-mode-find-file-hook)) - -;;;======================================================== -;;; tool-tip -;;;======================================================== -(defun egg-ref-at (pos &optional object) - (car (get-text-property pos :ref object))) - -(defun egg-ref-or-commit-at (pos &optional object) - (or (car (get-text-property pos :ref object)) - (get-text-property pos :commit object))) - -(defun egg-commit-at (pos &optional object) - (get-text-property pos :commit object)) - -(defun egg-rsite-at (pos &optional object) - (egg-rbranch-to-remote (car (get-text-property pos :ref object)))) - -(defun egg-delta-file-at (pos &optional object) - (car (get-text-property pos :diff object))) - -(defun egg-delta-hunk-at (pos &optional object) - (car (get-text-property pos :hunk object))) - -(defun egg-section-at (pos &optional object) - (let* ((sect-prop (get-text-property pos :sect-type object)) - (sect (and sect-prop (get-text-property pos sect-prop object)))) - (unless sect - (setq sect (egg-commit-at pos object))) - (if (consp sect) - (car sect) - sect))) - -(defun egg-file-name-at (pos &optional buffer) - (when (bufferp buffer) - (save-excursion - (with-current-buffer buffer - (goto-char pos) - (ffap-file-at-point))))) - -(defconst egg-cmd-help-text-fmt-alist - '((egg-log-buffer-push-to-local egg-ref-or-commit-at "update another branch with %s") - (egg-log-buffer-push egg-rsite-at "push branches to remote %s") - (egg-log-buffer-fetch egg-ref-at "(re)-fetch %s") - (egg-log-buffer-rm-ref egg-ref-at "remove %s") - (egg-log-buffer-reflog-ref egg-ref-at "show history (reflog) of %s") - (egg-log-buffer-unmark egg-commit-at "unmark %s for upcoming rebase") - (egg-log-buffer-mark-edit egg-commit-at "mark %s to be edited in upcoming rebase") - (egg-log-buffer-mark-squash egg-commit-at "mark %s to be squashed in upcoming rebase") - (egg-log-buffer-mark-pick egg-commit-at "mark %s to be picked in upcoming rebase") - (egg-log-buffer-mark egg-commit-at "mark %s as BASE") - (egg-log-buffer-rebase egg-commit-at "rebase HEAD to %s") - (egg-log-buffer-attach-head egg-ref-or-commit-at "anchor HEAD at %s") - (egg-log-buffer-atag-commit egg-commit-at "create new annotated-tag at %s") - (egg-log-buffer-tag-commit egg-commit-at "create new tag at %s") - (egg-log-buffer-checkout-commit egg-ref-or-commit-at "checkout %s") - (egg-log-buffer-start-new-branch egg-commit-at "start a new branch at %s") - (egg-log-buffer-create-new-branch egg-commit-at "create a new branch at %s") - (egg-log-buffer-insert-commit egg-commit-at "load %s's details") - (egg-section-cmd-toggle-hide-show-children egg-section-at "hide/show %s's children's details") - (egg-section-cmd-toggle-hide-show egg-section-at "hide/show %s's details") - (egg-log-buffer-merge egg-ref-or-commit-at "merge %s to HEAD") - (egg-buffer-cmd-navigate-next nil "next block") - (egg-buffer-cmd-navigate-prev nil "prev block") - (egg-diff-section-cmd-visit-file-other-window egg-section-at "open %s in other window") - (egg-diff-section-cmd-visit-file egg-section-at "open %s") - (egg-diff-section-cmd-ediff nil "view this delta in ediff") - (egg-staged-section-cmd-ediff3 egg-section-at "view %s changes in ediff3") - (egg-diff-section-cmd-unstage egg-section-at "unstage %s") - (egg-diff-section-cmd-undo egg-section-at "delete theses changes from %s") - (egg-unstaged-section-cmd-ediff egg-section-at "view this delta in ediff") - (egg-diff-section-cmd-stage egg-section-at "stage %s") - (egg-unmerged-section-cmd-ediff3 nil "view this conflict in ediff3") - (egg-find-file-at-point egg-file-name-at "open %s") - (egg-ignore-pattern-from-string-at-point egg-file-name-at "add a pattern matching %s to .gitignore file") - (egg-status-buffer-stage-untracked-file egg-file-name-at "add %s to this repo") - (egg-mouse-hide-show-cmd egg-section-at "hide/show %s's details") - (egg-status-popup-staged-diff-menu egg-section-at "popup menu for %s") - (egg-status-popup-unstaged-diff-menu egg-section-at "popup menu for %s") - (egg-buffer-rebase-abort nil "abort rebase session") - (egg-buffer-selective-rebase-skip nil "skip rebase session's current commit") - (egg-buffer-selective-rebase-continue nil "continue rebase session") - (egg-log-buffer-diff-revs egg-ref-or-commit-at "diff %s vs HEAD") - )) - -(defun egg-buffer-help-echo (window buffer pos) - (if (and (bufferp buffer) (number-or-marker-p pos)) - (let ((keymap (get-text-property pos 'keymap buffer)) - seen-list func-name-alist) - (when (keymapp keymap) - (mapconcat - (lambda (mapping) - (if (consp mapping) - (let* ((key (car mapping)) - (cmd (cdr mapping)) - (howto (assq cmd egg-cmd-help-text-fmt-alist)) - (func (nth 1 howto)) - (fmt (nth 2 howto)) - (key-str (format-kbd-macro (vector key))) - (name (or (cdr (assq func func-name-alist)) - (when (functionp func) - (cdar (setq func-name-alist - (cons (cons func - (funcall func pos buffer)) - func-name-alist))))))) - (when (and (not (memq key seen-list)) (stringp fmt)) - (if (and (stringp name) (= (length name) 40)) - (setq name (substring name 0 8))) - (add-to-list 'seen-list key) - (format "%s - %s\n" key-str (format fmt name)))) - "")) - keymap ""))))) - -;;;======================================================== -;;; auto-update -;;;======================================================== - -(defvar egg-auto-update nil) - -(defun egg-maybe-update-status () - "Pull up the status buffer for the current buffer if there is one." - (let ((bufname (egg-buf-git-name))) - (when (and egg-auto-update bufname) - (egg-status t) - (egg-goto-block-filename bufname)))) - -(add-hook 'after-save-hook 'egg-maybe-update-status) - -(defun egg-goto-block-filename (filename) - (interactive "sFilename: ") - (egg-goto-block-regexp (concat "\\(un\\)?staged-" filename))) - - -(defun egg-goto-block-regexp (nav-regexp) - "Takes `nav-regexp' as regexp and moves cursor there." - (let (nav-point) - (goto-char (point-min)) - (let (prev-point) - (while (not (eql prev-point (point))) - (setq prev-point (point)) - (egg-buffer-cmd-navigate-next) - (let ((prop-name (symbol-name (egg-navigation-at-point)))) - (if (string-match nav-regexp prop-name) - (setq nav-point (point) - prev-point (point)))))) - nav-point)) - -(run-hooks 'egg-load-hook) -(provide 'egg) diff --git a/lisp/cfengine.el b/lisp/cfengine.el index 9ff3ca08..4f78d78c 100644 --- a/lisp/cfengine.el +++ b/lisp/cfengine.el @@ -48,7 +48,7 @@ ;; It's *highly* recommended that you enable the eldoc minor mode: -;; (add-hook 'cfengine3-mode-hook 'eldoc-mode) +(add-hook 'cfengine3-mode-hook 'eldoc-mode) ;; It's *highly* recommended that you use this mode with the latest ;; Emacs, or at least 24.1. diff --git a/xemacs-packages/etc/bbdb/bbdb-213-310.el b/xemacs-packages/etc/bbdb/bbdb-213-310.el deleted file mode 100644 index 5a791a50..00000000 --- a/xemacs-packages/etc/bbdb/bbdb-213-310.el +++ /dev/null @@ -1,57 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; The 213 area code (in LA) has been split into 213 and 310. This code -;;; will map over your Insidious Big Brother Database and convert the area -;;; codes when approriate. It then displays the records which it has changed. -;;; -;;; This is derived from a list posted by Paul Eggert -;;; on 3 Mar 92 18:24:04 GMT. - -(require 'bbdb) - -(defconst bbdb-310-exchanges - '(201 202 203 204 205 206 207 208 209 210 212 214 215 216 217 218 219 220 - 246 247 270 271 273 274 275 276 277 278 279 280 281 282 284 285 286 287 - 288 289 297 301 302 305 306 312 313 314 315 316 317 318 319 320 322 323 - 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 348 350 352 - 354 355 363 364 370 371 372 373 374 375 376 377 378 379 390 391 392 393 - 394 395 396 397 398 399 401 402 403 404 406 407 408 409 410 412 414 416 - 417 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 - 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 - 454 455 456 457 458 459 470 471 472 473 474 475 476 477 478 479 490 491 - 492 493 494 495 496 497 498 499 501 502 510 512 513 514 515 516 517 518 - 519 521 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 - 540 541 542 543 544 545 546 547 548 549 550 551 552 553 556 557 558 559 - 568 570 571 572 573 574 575 576 577 578 590 591 592 593 594 595 596 597 - 598 599 601 602 603 604 605 606 607 608 609 615 616 618 630 631 632 633 - 634 635 637 638 639 640 641 642 643 644 645 646 647 648 649 652 657 659 - 670 671 672 673 674 675 676 677 679 690 691 692 693 694 695 696 697 698 - 699 708 715 719 761 762 763 764 767 768 769 781 782 783 784 785 787 788 - 791 792 793 794 795 796 797 798 799 800 801 802 803 804 806 807 809 812 - 813 814 815 816 819 820 821 822 823 824 825 826 827 828 829 830 831 832 - 833 834 835 836 837 838 839 840 841 842 843 854 855 858 859 860 861 862 - 863 864 865 866 867 868 869 885 886 898 899 902 903 904 905 906 907 908 - 914 915 916 917 918 920 921 922 923 924 925 926 927 928 929 940 941 942 - 943 944 945 946 947 948 949 967 970 973 978 980 981 982 983 984 985 986 - 987 988 989) - "Those exchanges which have moved from the 213 area code to the new 310.") - -(defun bbdb-convert-213-to-310 () - "Convert phone numbers in the BBDB which are in the 213 area code to the -newly-created 310 area code if appropriate." - (let ((records (bbdb-records)) - phones frobbed change-p) - (while records - (setq phones (bbdb-record-phones (car records)) - change-p nil) - (while phones - (if (and (= (bbdb-phone-area (car phones)) 213) - (memq (bbdb-phone-exchange (car phones)) bbdb-310-exchanges)) - (setq change-p (bbdb-phone-set-area (car phones) 310))) - (setq phones (cdr phones))) - (if change-p - (progn - (setq frobbed (cons (car records) frobbed)) - (bbdb-change-record (car records) nil))) - (setq records (cdr records))) - (bbdb-display-records frobbed))) diff --git a/xemacs-packages/etc/bbdb/bbdb-415-510.el b/xemacs-packages/etc/bbdb/bbdb-415-510.el deleted file mode 100644 index 28701511..00000000 --- a/xemacs-packages/etc/bbdb/bbdb-415-510.el +++ /dev/null @@ -1,87 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; The San Francisco Bay Area, which was formerly area code 415, has been -;;; split into two area codes: 415 for the west side of the bay, and 510 -;;; for the east side. This code will map over your Insidious Big Brother -;;; Database and convert the area codes when approriate. It then displays -;;; the records which it has changed. - -(require 'bbdb) - -(defconst bbdb-415-exchanges - '(206 219 221 227 239 241 243 244 252 255 257 258 259 266 267 282 285 289 - 291 292 296 306 307 312 321 322 323 324 325 326 327 328 329 330 331 332 - 333 334 335 336 337 338 340 341 342 343 344 345 346 347 348 349 354 355 - 358 359 361 362 363 364 365 366 367 368 369 371 375 377 378 381 382 383 - 386 387 388 389 391 392 393 394 395 396 397 398 399 403 404 406 421 424 - 431 432 433 434 435 441 442 445 449 453 454 456 457 459 461 464 465 466 - 467 468 469 472 473 474 476 477 478 479 485 488 491 492 493 494 495 496 - 497 499 502 506 507 508 512 513 541 542 543 544 545 546 550 552 553 554 - 556 557 558 561 563 564 565 566 567 570 571 572 573 574 576 578 579 583 - 584 585 586 587 588 589 591 592 593 594 595 597 599 604 610 616 617 621 - 622 626 627 637 641 647 648 661 662 663 664 665 666 668 669 673 677 681 - 688 691 692 694 695 696 697 701 703 705 715 721 723 725 726 728 731 737 - 738 739 742 744 747 749 750 751 752 753 755 756 759 761 764 765 768 771 - 772 773 774 775 776 777 780 781 788 789 804 806 807 813 821 822 824 826 - 851 852 853 854 855 856 857 858 859 861 863 864 868 871 872 873 875 876 - 877 878 879 882 883 885 892 894 896 897 898 903 904 905 912 917 921 922 - 923 924 925 926 927 928 929 931 940 941 948 949 951 952 953 954 955 956 - 957 960 961 962 964 965 966 967 968 969 972 973 974 978 979 981 982 983 - 984 985 986 989 991 992 993 994 995 997 998) - "Those exchanges which are still in the 415 area code.") - -(defconst bbdb-510-exchanges - '(204 208 210 215 222 223 224 226 228 229 231 232 233 234 235 236 237 238 - 245 246 248 251 253 254 256 261 262 263 268 271 272 273 275 276 277 278 - 283 284 287 293 294 295 297 302 308 313 317 339 351 352 356 357 370 372 - 373 374 376 420 422 423 425 426 427 428 429 430 436 437 438 439 443 444 - 446 447 448 451 452 455 458 460 462 463 471 475 481 482 483 484 486 487 - 489 490 498 515 516 521 522 523 524 525 526 527 528 529 530 531 532 533 - 534 535 536 537 538 539 540 547 548 549 551 559 562 568 569 577 581 582 - 596 598 601 602 603 606 609 613 614 618 620 623 624 625 631 632 633 634 - 635 636 638 639 642 643 644 645 646 649 651 652 653 654 655 656 657 658 - 659 667 670 671 672 674 675 676 678 680 682 683 684 685 686 687 689 704 - 706 708 709 713 716 717 718 724 727 729 732 733 734 735 736 741 743 745 - 746 748 754 757 758 762 763 769 778 779 782 783 784 785 786 787 790 791 - 792 793 794 795 796 797 798 799 801 803 810 814 815 819 820 823 825 827 - 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 845 846 - 847 848 849 862 865 866 867 869 874 881 884 886 887 888 889 891 893 895 - 901 910 930 932 933 934 935 937 938 939 942 943 944 945 946 947 975 977 - 987) - "Those exchanges which have moved from the 415 area code to the new 510.") - - -(defsubst bbdb-convert-415-to-510-internal (phone) - (cond ((memq (bbdb-phone-exchange phone) bbdb-510-exchanges) - (if (= (bbdb-phone-area phone) 510) - nil - (bbdb-phone-set-area phone 510))) - ((memq (bbdb-phone-exchange phone) bbdb-415-exchanges) - (if (= (bbdb-phone-area phone) 415) - nil - (bbdb-phone-set-area phone 415))) - (t (error "Exchange %03d is not in the 415 or 510 area codes: %s" - (bbdb-phone-exchange phone) - (bbdb-phone-string phone))))) - - -(defun bbdb-convert-415-to-510 () - "Convert phone numbers in the BBDB which are in the 415 area code to the -newly-created 510 area code if appropriate." - (let ((records (bbdb-records)) - phones frobbed change-p) - (while records - (setq phones (bbdb-record-phones (car records)) - change-p nil) - (while phones - (if (memq (bbdb-phone-area (car phones)) '(415 510)) - (setq change-p - (or (bbdb-convert-415-to-510-internal (car phones)) - change-p))) - (setq phones (cdr phones))) - (if change-p - (progn - (setq frobbed (cons (car records) frobbed)) - (bbdb-change-record (car records) nil))) - (setq records (cdr records))) - (bbdb-display-records frobbed))) diff --git a/xemacs-packages/etc/bbdb/bbdb-areacode-split.pl b/xemacs-packages/etc/bbdb/bbdb-areacode-split.pl deleted file mode 100755 index b77e65fb..00000000 --- a/xemacs-packages/etc/bbdb/bbdb-areacode-split.pl +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/perl -# -# Looks for phone numbers in your .bbdb with a particular area code -# and one of a set of exchanges and changes the area code. The old -# and new area codes are specified on the command line, as is the -# location of a file that contains the exchanges that are being -# changed. (The format of that file is very loose. Every three digit -# sequence will be used.) -# -# Seth Golub -# 15 Aug 1997 - -sub Usage -{ - $0 =~ s@.*/@@; - die "Usage: \n $0 [bbdb]\n"; -} - -$old_area_code = shift || Usage(); -$new_area_code = shift || Usage(); -$exchange_list_file = shift || Usage(); - -$bbdb_file = $ENV{'BBDB'} || shift || $ENV{'HOME'} . '/.bbdb'; -$bbdb_dir = `dirname $bbdb_file`; chomp $bbdb_dir; -$tmp_file = "$bbdb_dir/bbdb.new-$$"; - -open( LIST, "<$exchange_list_file" ) - || die "Failed to open $exchange_list_file\n"; - -while () -{ - while ( /(\d\d\d)/g ) - { - push( @exchanges, $1 ); - } -} - -close( LIST ); - -$exchanges = join( '|', @exchanges ); - -open( BBDB_IN, "<$bbdb_file" ) || die "Failed to open $bbdb_file\n"; -open( BBDB_OUT, ">$tmp_file" ) || die "Failed to open $tmp_file\n"; - -while () -{ - next unless /^\[/; - s/(\[\".*?\") $old_area_code (($exchanges) \d+ \d+\])/$1 $new_area_code $2/og; -} continue { - print BBDB_OUT; -} - -close( BBDB_IN ); -close( BBDB_OUT ); - -unlink( "$bbdb_file.bak" ); -rename( $bbdb_file, "$bbdb_file.bak" ); -rename( $tmp_file, $bbdb_file ); - -print STDERR "Old bbdb moved to $bbdb_file.bak\n"; - -__END__ diff --git a/xemacs-packages/etc/bbdb/bbdb-cid.pl b/xemacs-packages/etc/bbdb/bbdb-cid.pl deleted file mode 100755 index 3bc4cdea..00000000 --- a/xemacs-packages/etc/bbdb/bbdb-cid.pl +++ /dev/null @@ -1,516 +0,0 @@ -#!/usr/local/bin/perl5 -w -# -# Caller-ID-logger, by jwz (19-Jan-97) -# Modified: 24-Apr-97 -# -# Opens the modem and waits for it to print caller-ID data. When it does, -# it logs it to a file, parses it, and pops up a window using "xmessage". -# If the number is present in your .bbdb file, it shows the name (or company) -# associated with it. -# -# Todo: -# My caller ID service (in San Francisco) only ever sends numbers, not names, -# so I've never seen a "name" line come in; I assume that it would send both -# a name and a number, so it would be nice to present both (with error -# checking against BBDB) but the code as currently structured only handles -# one-line-per-call. It should realize that consecutive lines with the same -# timestamp are the same call. -# -# Modems other than ZyXELs have different caller-ID formats, and this doesn't -# deal with those. - -############################################################################## -# -# Some variables you might want to set... - - -# Set this to the device that your modem is attached to. -# -$modem_device = "/dev/ttyd1"; - -# This is your .bbdb file. (Set it to null if you don't want to do BBDB -# lookups at all, but why would you want to go and do a thing like that?) -# -$bbdb_file = "$ENV{HOME}/.bbdb"; - -# A shell command to use to cause emacs to pop up the BBDB buffer -# (bbdb-srv.pl is a good choice, so it defaults to the value of the -# shell environment variable $NS_MSG_DISPLAY_HOOK.) -# -$bbdb_cmd = $ENV{NS_MSG_DISPLAY_HOOK}; - -# If you want the $bbdb_cmd to be run on a different host, set it here. -# -$bbdb_host = "gimp"; - -# If you want each call to be logged to a file as well, name it here. -# -$logfile = "/usr/spool/fax/log/cid-log"; - -# For verbosity... -$debug = 0; - -# How to pop up a dialog box. -# -$xmessage_cmd = "xmessage"; -@xmessage_args = ("-display", ":0", - "-name", "Caller ID", - # roughly centered on my screen; YMMV. - "-geometry", "+400+400", - "-xrm", "*Font: -*-new cent*-bold-r-normal-*-240-*", - "-xrm", "*Foreground: black", - "-xrm", "*Background: lightgreen", - # no buttons on the window: dismiss it by clicking in it. - "-button", "", - "-xrm", "*form.Translations: #override : exit(0)", - "-xrm", "*Command.Font: -*-new cent*-bold-r-normal-*-120-*", - "-xrm", "*Command.horizDistance: 130" - ); - -# Uh, let's turn off the screensaver before popping up the window. -# -$pre_dialog_cmd = "xscreensaver-command -deactivate"; - - -# commands (and their expected responses) used to initialize the modem. -# -@modem_init = ( "AT", "OK", # ping - "ATZ", "OK", # reset - "ATE0", "OK", # don't echo commands - "ATM0", "OK", # turn off speaker - "ATN0", "OK", # turn off ringer - "ATS40.2=1", "OK", # turn on caller ID - ); - - -# for diagnostics: if the modem ever asynchronously prints something that -# doesn't match this, we issue a warning. -# -$expected_responses = "^CALLER NUMBER" . "|" . - "^REASON FOR NO CALLER " . "|" . - "^RING" . "|" . - "^TIME: [-0-9: ]+\$"; - - -############################################################################## -# -# Talking to the serial port... -# -# - -if ( $ debug ) { - use diagnostics; -} - - -sub open_modem { - use IPC::Open2; - - # Close the terminal streams before forking `cu', because otherwise - # it fucks around with the stty settings. - # - open(SAVEIN, "<&STDIN") || die("can't dup stdin"); - open(SAVEOUT, ">&STDOUT") || die("can't dup stdout"); - open(SAVEERR, ">&STDERR") || die("can't dup stderr"); - close(STDIN); - close(STDOUT); - close(STDERR); - - my $cu_pid = open2( \*MODEM_IN, \*MODEM_OUT, - "cu -l$modem_device -s2400 2>&1"); - - # Now that cu has been launched, we can restore them. - # - open(STDIN, "<&SAVEIN") || die("can't restore stdin"); - open(STDOUT, ">&SAVEOUT") || die("can't restore stdout"); - open(STDERR, ">&SAVEERR") || die("can't restore stderr"); - close(SAVEIN); - close(SAVEOUT); - close(SAVEERR); - - # The following doesn't seem to work and I don't know why... - # - # Set up a signal handler to try and kill off the cu process - # when we exit, instead of waiting ~30 seconds for it to notice - # that the pipe is gone... - # -# $SIG{INT} = sub { my $signame = shift; -# if ( $debug) { -# print STDERR "sending $signame to $cu_pid\n"; -# } -# print MODEM_OUT "\r\n~.\r\n"; -# close MODEM_OUT; -# close MODEM_IN; -# kill ($signame, $cu_pid); -# exit (1); -# }; - - $_ = ; - chop; - if ( !m/^Connected/ ) { - print STDERR "$0: cu printed `$_' instead of `Connected'\n"; - } -} - -sub read_line { - $_ = ; - $_ || die("got eof on modem"); - s/[\r\n]+$//; - if ( $_ eq "" ) { - $_ = ; - $_ || die("got eof on modem"); - s/[\r\n]+$//; - } - return $_; -} - -sub command { - my ( $command, $expected_response) = @_; - - if ( $debug ) { - print STDERR "sending: $command\n"; - } - - print MODEM_OUT "$command\r\n"; - my $line = read_line(); - - if ( $line eq $command ) { - if ( $debug ) { - print STDERR " got echo: reading next line too...\n"; - } - $line = read_line(); - } - - if ( $line ne $expected_response ) { - print STDERR " got: $line ; expected: $expected_response\n"; - } elsif ( $debug ) { - print STDERR " got: $line\n"; - } -} - -sub init_modem { - open_modem; - - my $len = $#modem_init + 1; - my $i; - for ($i = 0; $i < $len; $i += 2) { - command($modem_init[$i], $modem_init[$i+1]); - } -} - -sub handle_async_line { - local ( $_ ) = @_; - - if (!m/$expected_responses/) { - print STDERR "modem turd: $_\n"; - - } elsif (m/CALLER/) { - if ( $debug ) { - print STDERR "caller: $_\n"; - } - handle_cid_line($_); - - } elsif ( $debug ) { - if ( $_ eq '' ) { - print STDERR "ignored: blank line\n"; - } else { - print STDERR "ignored: $_\n"; - } - } -} - - -############################################################################## -# -# Parsing BBDB and CID data... -# - -sub find_bbdb_record { - my ( $area, $exchange, $suffix ) = @_; - - if ( ! $bbdb_file ) { - return undef; - } - - # strip off leading 0's, to match the way it's stored in .bbdb. - $area =~ s/^0+(.)/$1/; - $exchange =~ s/^0+(.)/$1/; - $suffix =~ s/^0+(.)/$1/; - - my $bbdb_rec = undef; - my $pat = "\\[\"[^\"]+\" $area $exchange $suffix (nil|[0-9]+)\\]"; - - open(BBDB, "<$bbdb_file") || die("error opening $bbdb_file: $!\n"); - - while () { - if ( m/$pat/ ) { - $bbdb_rec = $_; - last; - } - } - close(BBDB); - return $bbdb_rec; -} - - -# note: global (kludge!) -$pretty_number = 0; - -sub make_message_string { - my ( $number, $date, $fn, $ln, $co, $error ) = @_; - my $msg; - - my $line_prefix = " "; - my $line_suffix = " "; - - # First print the date (reformatted.) - # - $_ = $date; - my ( $dotw, $mon, $day, $hr, $min, $sec, $year ) = - m/^([^ ]+) +([^ ]+) +([^ ]+) +([^:]+):([^:]+):([^:]+) +([^ ]+) *$/; - $year =~ s/^..(..)/$1/; - $day =~ s/^0//; - $hr =~ s/^0//; - if ($hr < 12) { - $ampm = "am"; - } else { - $ampm = "pm"; - if ($hr > 12) { $hr -= 12 }; - } - $date = "$hr:$min$ampm, $day-$mon-$year ($dotw)"; - $msg = $line_prefix . $date . $line_suffix; - - # Next print the caller name, company, or error message. - # - if ( $error ) { - $msg .= "\n" . $line_prefix . $error . $line_suffix; - } elsif ( $co && !$fn && !$ln ) { - $msg .= "\n" . $line_prefix . $co . $line_suffix; - } elsif ( $fn || $ln ) { - $msg .= "\n" . $line_prefix . "$fn $ln" . $line_suffix; - } - - # Next print the phone number (formatted nicely.) - # - if ( $number ) { - my $area = 0; - my $exchange = 0; - my $suffix = 0; - $_ = $number; - ( $area, $exchange, $suffix ) = - m/^([0-9][0-9][0-9])([0-9][0-9][0-9])([0-9][0-9][0-9][0-9]+)/; - - # note: global (kludge!) - $pretty_number = "($area) $exchange-$suffix"; - $msg .= "\n" . $line_prefix . $pretty_number . $line_suffix; - } - - return $msg; -} - -use POSIX; -sub reaper { - $SIG{CHLD} = \&reaper; # loathe sysV - my $signame = shift; - if ( $debug >= 2 ) { - printf STDERR " (got SIG$signame...)\n"; - } - my $child; - while ( ( $child = waitpid(-1,WNOHANG) ), - $child > 0 ) { - if ( $debug >= 2 ) { - printf STDERR " (pid $child exited with $?)\n"; - } - } -} - -sub fork_and_exec { - my @cmd_list = @_; - - $SIG{CHLD} = \&reaper; - - if ( $debug >= 2 ) { - $_ = $cmd_list[0]; - s/ .*//; - print STDERR "forking for " . $_ . " at " . (localtime) . ".\n"; - } - - my $pid; - if ($pid = fork()) { - # parent - } elsif (!defined $pid) { - print STDERR "$0: fork failed: $!\n"; - } else { - # child - - if ( $debug ) { - $_ = $cmd_list[0]; - s/ .*//; - print STDERR "exec'ing " . $_ . " at " . (localtime) . - " in pid $$.\n"; - } - close(STDIN); - close(STDOUT); - close(STDERR); - exec @cmd_list; - } -} - - -sub fork_and_exec_for_bbdb { - my @cmd_list = @_; - my $number = shift @cmd_list; - - $SIG{CHLD} = \&reaper; - - if ( $debug >= 2 ) { - $_ = $cmd_list[0]; - s/ .*//; - print STDERR "forking for " . $_ . " at " . (localtime) . ".\n"; - } - - my $pid; - if ($pid = fork()) { - # parent - } elsif (!defined $pid) { - print STDERR "$0: fork failed: $!\n"; - exit (1); - } else { - # child - - if ( $debug ) { - $_ = $cmd_list[0]; - s/ .*//; - print STDERR "exec'ing " . $_ . " at " . (localtime) . - " in pid $$.\n"; - } - if ( system @cmd_list ) { - my $cmd = "gnudoit -q '(bbdb-srv-add-phone \"$pretty_number\")'"; - if ( $bbdb_host ) { - $cmd =~ s/([()\"])/\\$1/g; - $cmd = "rsh $bbdb_host $cmd"; - } - exec $cmd; - } - exit (0); - } -} - - -sub pop_up_dialog { - my ( $msg, $buttonp, $number ) = @_; - - fork_and_exec $pre_dialog_cmd; - - if ( ! $buttonp ) { - fork_and_exec $xmessage_cmd, @xmessage_args, "\n$msg\n\n"; - } else { - my @args = ( @xmessage_args, "-button", "Add To BBDB" ); - fork_and_exec_for_bbdb $number, $xmessage_cmd, @args, "\n$msg\n\n"; - } -} - -sub pop_up_bbdb_buffer { - my ( $caller ) = @_; - if ( $bbdb_cmd ) { - my $cmd = $bbdb_cmd; - if ( $bbdb_host ) { - $cmd = "rsh $bbdb_host $cmd"; - } - $caller =~ s/\\/\\\\/g; - $caller =~ s/\"/\\\\\"/g; - `echo "Path:\nFrom: \\\"$caller\\\" <>" | $cmd >&- 2>&- &`; - } -} - - -sub handle_cid_line { - my($line) = @_; - - my $date = localtime; - - # Log the call... - # - if ( $logfile ) { - if (open(LOG, ">>$logfile")) { - print LOG "$date\t$line\r\n"; - close LOG; - } else { - print STDERR "error opening $logfile: $!\n"; - } - } - - # Pull the phone number out of the message... - # - my $number = ""; - my $error = ""; - - $_ = $line; - if ( m/^CALLER NUMBER/ ) { - ( $number ) = m/^[^:]+: *(.*) *$/; - } else { - $error = $line; - } - - my $caller = undef; - - my $fn = undef; - my $ln = undef; - my $co = undef; - my $buttonp = 0; - - if ( !$number || $number eq "" ) { - $error =~ tr#A-Z#a-z#; - $error =~ s/^REASON FOR NO CALLER (NUMBER|NAME)/Caller unknown/i; - - } else { - $_ = $number; - - my $area = 0; - my $exchange = 0; - my $suffix = 0; - ( $area, $exchange, $suffix ) = - m/^([0-9][0-9][0-9])([0-9][0-9][0-9])([0-9][0-9][0-9][0-9]+)/; - - my $bbdb_rec = find_bbdb_record($area, $exchange, $suffix); - - if ( $bbdb_rec ) { - my $junk = 0; - $_ = $bbdb_rec; - # This will lose if names or aliases have double-quotes in them. - # No doubt there's some hairier regexp magic that handles that... - ( $fn, $ln ) = m/^[\[]\"([^\"]*)\" *\"([^\"]*)\"/; - ( $junk, $junk, $junk, $co ) = - m/^[[](nil|\"[^\"]*\") *(nil|\"[^\"]*\") (nil|[(][^)]*[)]) \"([^\"]*)\"/; - - if ( $fn || $ln ) { - $caller = "$fn $ln"; - } - } else { - $buttonp = 1; - } - } - - my $msg = make_message_string($number, $date, $fn, $ln, $co, $error); - pop_up_dialog($msg, $buttonp, $pretty_number); - - if ( $caller ) { - pop_up_bbdb_buffer($caller); - } -} - - -############################################################################## -# -# hey ho. let's go. -# -sub main { - init_modem(); - while (1) { - handle_async_line(read_line()); - } - exit (1); -} - -main(); - diff --git a/xemacs-packages/etc/bbdb/bbdb-srv.pl b/xemacs-packages/etc/bbdb/bbdb-srv.pl deleted file mode 100755 index 019adf6f..00000000 --- a/xemacs-packages/etc/bbdb/bbdb-srv.pl +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/local/bin/perl - -# This script reads a block of message headers on stdin, and converts them -# to an emacs-lisp string (quoting all dangerous characters) and then -# uses the `gnudoit' program to cause a running Emacs process to invoke -# the `bbdb-srv' function with that string. -# -# This has the effect of causing the running Emacs to display the BBDB -# record corresponding to these headers. -# -# See the Emacs side of things in bbdb-srv.el for more info. -# -# A trivial application of this is the shell command: -# -# echo 'From: Jamie Zawinski ' | bbdb-srv.perl -# -# which will cause the corresponding record to be displayed. -# A more interesting application of this is: -# -# setenv NS_MSG_DISPLAY_HOOK bbdb-srv.perl -# -# which will hook BBDB up to Mozilla (Unix Netscape Mail and Netscape News -# versions 3.0b2 and later only.) -# -# -- Jamie Zawinski , 25-apr-96 - -# spawn in the background and return to the caller immediately. -if (fork == 0) { exit 0; } - -$str="(bbdb-srv \""; -while(<>) -{ - # quote most shell metacharacters with backslash. - s/([\\"`$#^!])/\\\1/g; - # but quote ' as \047 - s/'/\\047/g; - # and just for kicks, turn newlines into \n -# s/\n/\\n/g; - - $str = $str.$_; -} -$str=$str."\")"; - -exec "gnudoit", "-q", $str; -exit 0; diff --git a/xemacs-packages/etc/bbdb/bbdb-to-netscape.el b/xemacs-packages/etc/bbdb/bbdb-to-netscape.el deleted file mode 100644 index cf7d5a4b..00000000 --- a/xemacs-packages/etc/bbdb/bbdb-to-netscape.el +++ /dev/null @@ -1,213 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is the part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993, 1995 Jamie Zawinski . -;;; Converting a BBDB database to a Netscape Address Book. -;;; last change21-feb-97. - -;;; The Insidious Big Brother Database 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. -;;; -;;; BBDB is distributed in the hope that it will be useful, but WITHOUT ANY -;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more -;;; details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; This file attempts to convert a BBDB database to a Netscape Address Book -;;; file. It doesn't work very well. If you fix it, let me know. -- jwz - -(require 'bbdb) - -(defun bbdb-mozilla-insert-url (string) - (let ((p (point)) - c) - (insert string) - (goto-char (prog1 p (setq p (point)))) - (while (progn - (skip-chars-forward "-a-zA-Z0-9.@/_\r\n" p) - (< (point) p)) - (setq c (following-char)) - (delete-char 1) - (insert (format "%%%02X" c)) - (setq p (+ 2 p))) - (goto-char p))) - -(defun bbdb-mozilla-insert-html (string) - (let ((p (point)) - c) - (insert string) - (goto-char (prog1 p (setq p (point)))) - (while (progn - (skip-chars-forward "^&<>" p) - (< (point) p)) - (setq c (following-char)) - (delete-char 1) - (cond ((= c ?&) (insert "&") (setq p (+ p 4))) - ((= c ?<) (insert "<") (setq p (+ p 3))) - (t (insert ">") (setq p (+ p 3))))) - (goto-char p))) - -(defun bbdb-mozilla-emit-record (record aliases) - (let (addr) - (cond ((setq addr (car (bbdb-record-net record))) - (insert "
")) - (let ((name (or (bbdb-record-name record) - (bbdb-record-company record) - ""))) - (bbdb-mozilla-insert-html name)) - (insert "\n") - (let ((notes nil)) - (cond (notes - ))) - t) - (t nil)))) - -(defun bbdb-to-netscape () - (let* ((target (cons bbdb-define-all-aliases-field - "^[a-z, ]+$")) - (records1 (bbdb-search (bbdb-records) - nil ; name - nil ; company - nil ;"netscape\\.com" ; net - target ; notes - )) - (records records1) - result record aliases match - (lists nil) - (single-aliases nil) - (count 0) - ) - (message "%d" (length records1)) - (while records - (setq record (car records)) - (setq aliases (bbdb-record-getprop record bbdb-define-all-aliases-field)) - (setq aliases (and aliases (bbdb-split aliases ","))) - (while aliases - (if (setq match (assoc (car aliases) result)) - (nconc match (cons record nil)) - (setq result (cons (list (car aliases) record) result))) - (setq aliases (cdr aliases))) - (setq records (cdr records))) - (while result - (let ((alias (downcase (car (car result)))) - (expansion (cdr (car result)))) - (cond - ((cdr expansion) - (setq lists (cons (cons alias expansion) lists))) - (expansion - (setq single-aliases (cons (cons (car expansion) alias) - single-aliases)))) - (setq result (cdr result)))) - -; (setq records (bbdb-records)) - (setq records records1) - (set-buffer (get-buffer-create "*netscape-address-book*")) - (erase-buffer) - (insert "\n" - "\n" - "" (user-full-name) "'s Address book\n" - "

" (user-full-name) "'s Address book

\n" - "\n" - "

\n") - (while records - (setq record (car records)) - (insert "

") - (insert (or (bbdb-record-name record) - net - (bbdb-record-company record) - ""))) - - (insert "\n") - (let ((phones (bbdb-record-phones record)) - (addrs (bbdb-record-addresses record)) - (aka (bbdb-record-aka record)) - phone - ) - - (insert "
") - (setq match nil) - (while phones - (setq phone (car phones)) - (setq match t) - (insert (format " %14s: " (bbdb-phone-location phone))) - (insert (bbdb-phone-string phone) "\n
") - (setq phones (cdr phones))) - (let (addr c s) - (while addrs - (setq addr (car addrs)) - (setq match t) - (insert (format " %14s: " (bbdb-address-location addr))) - (if (= 0 (length (setq s (bbdb-address-street1 addr)))) nil - (indent-to 17) (insert s "\n
")) - (if (= 0 (length (setq s (bbdb-address-street2 addr)))) nil - (indent-to 17) (insert s "\n
")) - (if (= 0 (length (setq s (bbdb-address-street3 addr)))) nil - (indent-to 17) (insert s "\n
")) - (indent-to 17) - (insert (setq c (bbdb-address-city addr))) - (setq s (bbdb-address-state addr)) - (if (and (> (length c) 0) (> (length s) 0)) (insert ", ")) - (insert s " ") - (insert (bbdb-address-zip-string addr) "\n
") - (setq addrs (cdr addrs)))) - (cond (aka - (setq match t) - (insert (format " %14s: %s\n
" "AKA" - (mapconcat (function identity) aka ", "))))) - (let ((notes (bbdb-record-raw-notes record))) - (if (stringp notes) - (setq notes (list (cons 'notes notes)))) - (while notes - (if (memq (car (car notes)) - '(mail-alias password bbdb mail-name face mark-char aka)) - nil - (setq match t) - (insert (format " %14s: " (car (car notes)))) - (let ((p (point))) - (insert (cdr (car notes))) - (save-excursion - (save-restriction - (narrow-to-region p (1- (point))) - (goto-char (1+ p)) - (while (search-forward "\n" nil t) - (forward-char -1) - (insert "
") - (forward-char 1) - (insert (make-string 17 ?\ ))))) - (insert "\n"))) - (setq notes (cdr notes))))) - - (or match (delete-char -4)) - - (setq records (cdr records)) - ) - (insert "

\n") - )) diff --git a/xemacs-packages/etc/bbdb/bbdb-unlazy-lock.pl b/xemacs-packages/etc/bbdb/bbdb-unlazy-lock.pl deleted file mode 100755 index a92dcd00..00000000 --- a/xemacs-packages/etc/bbdb/bbdb-unlazy-lock.pl +++ /dev/null @@ -1,19 +0,0 @@ -#!/usr/local/bin/perl -# -# Author: Christopher Kline -# -# bbdb-unlazy-lock.pl,v 1.1 1997/10/06 00:56:14 simmonmt Exp -# -# bbdb-unlazy-lock.pl,v -# Revision 1.1 1997/10/06 00:56:14 simmonmt -# Initial revision -# -# -# Lazy-lock-mode has (had) a nasty habit of munging .bbdb files if you visited them -# with it on. This script removes the lazy-lock mung -# - -while( ) { - s/#\(("[^"]*")( \d+ \d+ (nil)*(\(lazy-lock t\))*)*\)/$1/gi; - print; -} diff --git a/xemacs-packages/etc/bbdb/tex/bbdb-cols.tex b/xemacs-packages/etc/bbdb/tex/bbdb-cols.tex deleted file mode 100644 index 4102d0f7..00000000 --- a/xemacs-packages/etc/bbdb/tex/bbdb-cols.tex +++ /dev/null @@ -1,234 +0,0 @@ -%%% bbdb-cols.tex - multiple columns per page, multiple pages per sheet. - -%%% Authors: Luigi Semenzato -%%% Boris Goldowsky -%%% Copyright (C) 1993 Boris Goldowsky -%%% Version: 3.92; 5Jan95 - -%%% Commentary: -%%% -%%% Put \input bbdb-cols.tex -%%% at the beginning of your TeX file. -%%% Then \twocol, \threecol, or \fourcol for multi-column output -%%% or \gridformat (4x3 grid of small credit-card-sized pages) -%%% or \quadformat{xsize}{ysize} for four 2-column pages per sheet. -%%% In any case you will need to put \endcol at the end of the -%%% document, before \bye. - -%%% For instructions on using this format file with BBDB, see bbdb-print.el -%%% which should have come bundled with this file. The complete bbdb-print -%%% package is also available via anonymous ftp at: -%%% /cs.rochester.edu:/pub/u/boris/bbdb-print.tar.gz - -%%% This file is part of the bbdb-print extensions to the Insidious -%%% Big Brother Database, which is for use with 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 1, or -%%% (at your option) any later version. -%%% -%%% This program is distributed in the hope that it will be useful, -%%% but WITHOUT ANY WARRANTY; without even the implied warranty of -%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -%%% General Public License for more details. -%%% -%%% You should have received a copy of the GNU General Public License -%%% along with GNU Emacs; see the file COPYING. If not, write to -%%% the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - - -\newdimen\colshsize \colshsize=\hsize -\newdimen\columngutter \columngutter=.2in % space between columns - -\newbox\columnA \newbox\columnB \newbox\columnC - -\newdimen\FULLHSIZE -\newdimen\FULLVSIZE -\newbox\quadrantbox -\newbox\firstquadrant \newbox\secondquadrant -\newbox\thirdquadrant \newbox\fourthquadrant -\newbox\row \newbox\page - -\def\columnbox{\leftline{\pagebody}} - -\def\colsline{\hbox to \colshsize} - -\newcount\NROW \NROW=3 % for grid format. are these really variables -\newcount\NCOL \NCOL=4 % that can be changed? should they be set - % from lisp? I'm not sure. -\newcount\rowindex \newcount\colindex - -\def\onecol % for consistency---or maybe one could use it for switching back. -{ - \output={\shipout\vbox{\makeheadline\colsline{\columnbox}\makefootline} - \advancepageno \ifnum\outputpenalty>-20000 \else\dosupereject\fi} - \def\endcol{} -}% end onecol - -\def\twocol -{ - \advance\hsize by -\columngutter - \divide\hsize 2 - \let\column=A - \output={\if A\column - \global\setbox\columnA=\columnbox \global\let\column=B - \else - \shipout\vbox{\makeheadline - \colsline{\box\columnA\hfil\columnbox} - \makefootline} - \advancepageno \global\let\column=A - \fi - \ifnum\outputpenalty>-20000 \else\dosupereject\fi} - - \def\endcol - { - \vfill\supereject\if A\column \else\null\vfill\eject\fi - } - -} % end twocol - -\def\threecol -{ - \advance\hsize -\columngutter - \advance\hsize -\columngutter - \divide\hsize 3 - \let\column=A - \output={\if A\column - \global\setbox\columnA=\columnbox \global\let\column=B - \else \if B\column - \global\setbox\columnB=\columnbox \global\let\column=C - \else - \shipout\vbox{\makeheadline - \colsline{\box\columnA\hfil\box\columnB - \hfil\columnbox} - \makefootline} - \advancepageno \global\let\column=A - \fi\fi - \ifnum\outputpenalty>-20000 \else\dosupereject\fi} - - \def\endcol - { - \if A\column - \null\vfill\eject\null\vfill\eject - \else\if B\column - \null\vfill\eject - \fi\fi - \vfill\supereject - } - -} % end threecol - -\def\fourcol -{ - \advance\hsize -3\columngutter - \divide\hsize 4 - \let\column=A - \output={\if A\column - \global\setbox\columnA=\columnbox \global\let\column=B - \else \if B\column - \global\setbox\columnB=\columnbox \global\let\column=C - \else \if C\column - \global\setbox\columnC=\columnbox \global\let\column=D - \else - \shipout\vbox - { \makeheadline - \colsline{\box\columnA\hfil\box\columnB\hfil - \box\columnC\hfil\columnbox} - \makefootline} - \advancepageno\global\let\column=A - \fi\fi\fi - \ifnum\outputpenalty>-20000 \else\dosupereject\fi - } - - \def\endcol - { - \vfill\supereject - \if A\column \else\null\vfill\eject\fi - \if B\column \else\null\vfill\eject\fi - \if C\column \else\null\vfill\eject\fi - } - -} % end fourcol - -\def\quadformat#1#2 -{ - \FULLHSIZE=\hsize - \FULLVSIZE=\vsize - - \colshsize=#1 - \vsize=#2 - - \hsize=\colshsize \advance\hsize by -.15in \divide\hsize 2 - - \let\lr=L - \let\quadrant=A - \output={\if L\lr - \global\setbox\columnA=\columnbox \global\let\lr=R - \else - \global\setbox\quadrantbox=\vbox{\colsline - {\box\columnA\hfil\columnbox}} \global\let\lr=L - \quadrantformat - \fi - \ifnum\outputpenalty>-20000 \else\dosupereject\fi} - - \def\quadrantformat - {\if A\quadrant - \global\setbox\firstquadrant=\box\quadrantbox - \global\let\quadrant=B - \else \if B\quadrant - \global\setbox\secondquadrant=\box\quadrantbox - \global\let\quadrant=C - \else \if C\quadrant - \global\setbox\thirdquadrant=\box\quadrantbox - \global\let\quadrant=D - \else - {\shipout - \vbox to \FULLVSIZE - {\FULLLINE{\box\firstquadrant\hfil\box\secondquadrant} - \vfill - \FULLLINE{\box\thirdquadrant\hfil\box\quadrantbox}}} - \global\let\quadrant=A - \advancepageno - \fi\fi\fi} - - \def\FULLLINE{\hbox to \FULLHSIZE} - - \def\endcol{\supereject\if R\lr \null\vfill\eject\fi} -} % end of quadformat - -\def\grid -{ - \def\rowspace{\vbox to 0.2in{}} - \def\colspace{\hbox to 0.2in{}} - - \hsize=1.5in - \vsize=2.9in - - \rowindex=0 \colindex=0 - - \setbox\row=\null \setbox\page=\null - - \output={\global\advance\colindex by 1 - \ifnum\colindex>\NCOL - \global\colindex=1 - \global\setbox\page=\vbox{\box\page\rowspace\box\row} - \global\setbox\row=\null - \global\advance\rowindex by 1 - \ifnum\rowindex=\NROW - \global\rowindex=1 - \shipout\box\page - \global\setbox\page=\null - \advancepageno - \fi - \fi - \global\setbox\row=\hbox{\box\row\colspace\columnbox}} - - \def\columnbox{\leftline{\pagebody}} - - \def\endcol{\vfill\supereject - \ifnum\colindex=1\null\vfill\eject\fi} -} % end of grid. - -%%% bbdb-cols.tex ends here. - diff --git a/xemacs-packages/etc/bbdb/tex/bbdb-print-brief.tex b/xemacs-packages/etc/bbdb/tex/bbdb-print-brief.tex deleted file mode 100644 index f1162708..00000000 --- a/xemacs-packages/etc/bbdb/tex/bbdb-print-brief.tex +++ /dev/null @@ -1,159 +0,0 @@ -%%% bbdb-print-brief.tex - for formatting address lists, one line per entry. - -%%% Authors: Luigi Semenzato -%%% Boris Goldowsky -%%% Copyright (C) 1993 Boris Goldowsky -%%% Version: 3.91; 19Dec94 - -%%% For instructions on using this format file with BBDB, see bbdb-print.el -%%% which should have come bundled with this file; or write to -%%% boris@cs.rochester.edu. - -%%% This file is part of the bbdb-print extensions to the Insidious -%%% Big Brother Database, which is for use with GNU Emacs. -%%% -%%% The Insidious Big Brother Database is free software; you can redistribute -%%% it and/or modify it under the terms of the GNU General Public License as -%%% published by the Free Software Foundation; either version 1, or (at your -%%% option) any later version. -%%% -%%% BBDB 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. - -%%% The address-list file should look something like this: - -%%% \input file % this format file's filename -%%% \setsize{6} % point size of type to use -%%% % or \setpssize{6} to use PostScript fonts. (optional) -%%% \setseparator{3} % which style of separators, 0-7 -%%% -%%% \separator{A} % include a separator here -%%% -%%% \beginrecord % and start a record -%%% \name{A. Name} -%%% \phone{location: (xxx) xxx-xxxx} -%%% \address{1234 Main Street\\ -%%% Anytown, XX 00000\\} -%%% \note{note name}{note text} -%%% \notes{blah blah} -%%% \endrecord -%%% -%%% \endaddresses % done -%%% \bye - -\nopagenumbers -\raggedright -\tolerance=10000 -\hbadness=10000 -\parskip 0pt -\parindent=0pt % was 10pt - -%%% -%%% Fonts -%%% - -\def\setsize#1{ - \font\rm=ecrm#1 - \font\bf=ecbx#1 - \font\it=\ifnum #1=6 ecti7 \else ecti#1 \fi - \font\tt=ectt#1 - \font\bigbf=ecbx#1 scaled \magstep3 - \rm - \baselineskip=#1pt - \ifnum #1>9 \advance\baselineskip by 1pt \fi -} - -\def\setpssize#1{ - \font\rm=ptmr at #1pt - \font\bf=ptmb at #1pt - \font\it=ptmri at #1pt - \font\tt=pcrr at #1pt - {\dimen0=#1pt\global\font\bigbf=ptmb at 1.8\dimen0} - \rm - \baselineskip=#1pt -} - -%%% -%%% Define separator types -%%% - -\def\setseparator#1{ - \ifnum #1=1 - \def\sep##1{\line{\hrulefill}\smallskip\mark{##1}} - \else \ifnum #1=2 - \def\sep##1{\hbox{\vrule\hskip -0.4pt\vbox{\hrule\smallskip - \centerline{\bf{##1}}\smallskip\hrule}\hskip -0.4pt\vrule - \mark{##1}}} - \else \ifnum #1=3 - \def\sep##1{\hbox{\vrule\hskip -0.4pt\vbox{\hrule\smallskip - \centerline{\bigbf{##1}}\smallskip\hrule}\hskip -0.4pt\vrule} - \medskip\mark{##1}} - \else \ifnum #1=4 - \def\sep##1{\smallskip\centerline{\bigbf{##1}}\medskip\mark{##1}} - \else \ifnum #1=5 - \def\sep##1{\hrule\smallskip - \centerline{\bigbf{##1}}\smallskip\hrule\medskip\mark{##1}} - \else \ifnum #1=6 - \def\cute{$\sya\syb\syc\syd$} - \def\revcute{$\syd\syc\syb\sya$} - \let\sya=\heartsuit\let\syb=\spadesuit - \let\syc\diamondsuit\let\syd=\clubsuit - \def\cycle{\let\tmp=\sya\let\sya=\syb - \let\syb=\syc\let\syc=\syd\let\syd=\tmp} - \def\sep##1{\smallskip - \hbox to \hsize{\hfil\cute\hfil\bigbf{##1}\hfil\revcute\hfil} - \cycle\medskip\mark{##1}} - \else \ifnum #1=7 - \def\cute{$\sya\syb\syc\syd$} - \def\revcute{$\syd\syc\syb\sya$} - \let\sya=\heartsuit\let\syb=\spadesuit - \let\syc=\diamondsuit\let\syd=\clubsuit - \def\cycle{\let\tmp=\sya\let\sya=\syb\let\syb=\syc\let\syc=\syd - \let\syd=\tmp} - \def\sep##1{\hbox{\vrule\vbox{\hrule\smallskip - \hbox to \hsize{\hfil\cute\hfil\bigbf{##1}\hfil\revcute\hfil} - \smallskip\hrule}\vrule}\medskip\cycle\mark{##1}} - \else - \def\sep##1{\mark{##1}} - \fi\fi\fi\fi\fi\fi\fi - \def\separator##1{\noalign{\sep##1}} -} % end setseparator - -%%% -%%% Macros for formatting the entries. -%%% - -\def\\{} - -\def\firstline#1#2{% the name and (maybe) the first phone number. - {\bf #1}\hfil&\hfil#2&\hskip0pt} - -\def\name#1{\firstline{#1}{}} % for backwards compatibility - -\def\phone#1{\hfil#1&\hskip0pt} - -\def\address#1{#1\hfil&\hskip0pt} - -\def\comp#1{\hskip0pt} -\def\email#1{\hskip0pt} -\def\note#1#2{\hskip0pt} -\def\notes#1{\hskip0pt} - -\def\beginrecord{\relax} -\def\endrecord{\cr} - -\def\beginaddresses{\halign\bgroup&##\quad\cr} -\def\endaddresses{\egroup} - -\def\today{\number\day\space - \ifcase\month\or Jan\or Feb\or Mar\or Apr \or May\or June\or - Jul\or Aug\or Sept\or Oct\or Nov\or Dec\fi - \space\number\year} - -%%% bbdb-print-brief.tex ends here. diff --git a/xemacs-packages/etc/bbdb/tex/bbdb-print.tex b/xemacs-packages/etc/bbdb/tex/bbdb-print.tex deleted file mode 100644 index 9b60e4b8..00000000 --- a/xemacs-packages/etc/bbdb/tex/bbdb-print.tex +++ /dev/null @@ -1,171 +0,0 @@ -%%% bbdb-print.tex - for formatting address lists. - -%%% Authors: Luigi Semenzato -%%% Boris Goldowsky -%%% Copyright (C) 1993 Boris Goldowsky -%%% Version: 3.92; 5Jan95 - -%%% For instructions on using this format file with BBDB, see bbdb-print.el -%%% which should have come bundled with this file. The complete bbdb-print -%%% package is also available via anonymous ftp at: -%%% /cs.rochester.edu:/pub/u/boris/bbdb-print.tar.gz - -%%% This file is part of the bbdb-print extensions to the Insidious -%%% Big Brother Database, which is for use with 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 1, or -%%% (at your option) any later version. -%%% -%%% This program is distributed in the hope that it will be useful, -%%% but WITHOUT ANY WARRANTY; without even the implied warranty of -%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -%%% General Public License for more details. -%%% -%%% You should have received a copy of the GNU General Public License -%%% along with GNU Emacs; see the file COPYING. If not, write to -%%% the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -%%% The address-list file should look something like this: - -%%% \input file % this format file's filename -%%% \setsize{6} % point size of type to use -%%% % or \setpssize{6} to use PostScript fonts. (optional) -%%% \setseparator{3} % which style of separators, 0-7 -%%% -%%% \separator{A} % include a separator here -%%% -%%% \beginrecord % and start a record -%%% \name{A. Name} -%%% \phone{location: (xxx) xxx-xxxx} -%%% \address{1234 Main Street\\ -%%% Anytown, XX 00000\\} -%%% \note{note name}{note text} -%%% \notes{blah blah} -%%% \endrecord -%%% -%%% \endaddresses % done -%%% \bye - -\raggedright -\tolerance=10000 -\hbadness=10000 -\parskip 0pt -\parindent=0pt -\footline{\hfil} - -%%% -%%% Fonts -%%% - -\def\setsize#1{ - \font\rm=ecrm#1 - \font\bf=ecbx#1 - \font\it=\ifnum #1=6 ecti7 \else ecti#1 \fi - \font\tt=ectt#1 - \font\bigbf=ecbx#1 scaled \magstep3 - \rm - \baselineskip=#1pt - \ifnum #1>9 \advance\baselineskip by 1pt \fi -} - -\def\setpssize#1{ - \font\rm=ptmr at #1pt - \font\bf=ptmb at #1pt - \font\it=ptmri at #1pt - \font\tt=pcrr at #1pt - {\dimen0=#1pt\global\font\bigbf=ptmb at 1.8\dimen0} - \rm - \baselineskip=#1pt -} - -%%% -%%% Define separator types -%%% - -\def\setseparator#1{ - \ifnum #1=1 - \def\separator##1{\hrule\smallskip\mark{##1}} - \else \ifnum #1=2 - \def\separator##1{\hbox{\vrule\hskip -0.4pt\vbox{\hrule\smallskip - \centerline{\bf{##1}}\smallskip\hrule}\hskip -0.4pt\vrule - \mark{##1}}} - \else \ifnum #1=3 - \def\separator##1{\hbox{\vrule\hskip -0.4pt\vbox{\hrule\smallskip - \centerline{\bigbf{##1}}\smallskip\hrule}\hskip -0.4pt\vrule} - \medskip\mark{##1}} - \else \ifnum #1=4 - \def\separator##1{\smallskip\centerline{\bigbf{##1}}\medskip\mark{##1}} - \else \ifnum #1=5 - \def\separator##1{\hrule\smallskip - \centerline{\bigbf{##1}}\smallskip\hrule\medskip\mark{##1}} - \else \ifnum #1=6 - \def\cute{$\sya\syb\syc\syd$} - \def\revcute{$\syd\syc\syb\sya$} - \let\sya=\heartsuit\let\syb=\spadesuit - \let\syc\diamondsuit\let\syd=\clubsuit - \def\cycle{\let\tmp=\sya\let\sya=\syb - \let\syb=\syc\let\syc=\syd\let\syd=\tmp} - \def\separator##1{\smallskip - \hbox to \hsize{\hfil\cute\hfil\bigbf{##1}\hfil\revcute\hfil} - \cycle\medskip\mark{##1}} - \else \ifnum #1=7 - \def\cute{$\sya\syb\syc\syd$} - \def\revcute{$\syd\syc\syb\sya$} - \let\sya=\heartsuit\let\syb=\spadesuit - \let\syc=\diamondsuit\let\syd=\clubsuit - \def\cycle{\let\tmp=\sya\let\sya=\syb\let\syb=\syc\let\syc=\syd - \let\syd=\tmp} - \def\separator##1{\hbox{\vrule\vbox{\hrule\smallskip - \hbox to \hsize{\hfil\cute\hfil\bigbf{##1}\hfil\revcute\hfil} - \smallskip\hrule}\vrule}\medskip\cycle\mark{##1}} - \else - \def\separator##1{\mark{##1}} - \fi\fi\fi\fi\fi\fi\fi -} % end setseparator - -%%% -%%% Macros for formatting the entries. -%%% - -\def\beginaddresses{} - -\def\endaddresses{ - \bigskip\hrule\smallskip - \noindent {\bf Printed \today}\vfill\endcol} - -\def\beginrecord{\bigbreak} - -\def\endrecord{\bigbreak} - -\def\\{\par} - -\def\dots{\leaders\hbox to 0.6em{\hss.\hss}} - -\def\firstline#1#2{% the name and (maybe) the first phone number. - \hyphenpenalty=10000\rightskip=0pt plus 1fil - \noindent{\bf #1}\dotfill\penalty-1\hbox{}\dotfill{#2}\\ -} - -\def\name#1{\firstline{#1}{}} % for backwards compatibility - -\def\comp#1{#1\\} - -\def\phone#1{\hfill#1\\} - -\def\email#1{\smallbreak{\tt#1}\\} - -\def\address#1{\smallbreak#1\smallbreak} - -\def\note#1#2{{\smallbreak\leftskip=2em\parindent=-1em - \noindent\hskip-\leftskip{\it#1: } #2\\ }} - -\def\notes#1{\smallbreak{\it(#1)}\\ } - -\def\today{\number\day\space - \ifcase\month\or Jan\or Feb\or Mar\or Apr \or May\or June\or - Jul\or Aug\or Sept\or Oct\or Nov\or Dec\fi - \space\number\year} - -%%% bbdb-print.tex ends here. diff --git a/xemacs-packages/etc/ediff/ediff-A-up.xbm b/xemacs-packages/etc/ediff/ediff-A-up.xbm deleted file mode 100644 index 338d6a49..00000000 --- a/xemacs-packages/etc/ediff/ediff-A-up.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define ediff-A-up_width 15 -#define ediff-A-up_height 15 -static char ediff-A-up_bits[] = { - 0x00,0x80,0x00,0x80,0x00,0x80,0xc0,0x81,0xe0,0x83,0x60,0x83,0x70,0x87,0x30, - 0x86,0x38,0x8e,0xf8,0x8f,0x18,0x8c,0x18,0x8c,0x00,0x80,0x00,0x80,0x00,0x80 - }; diff --git a/xemacs-packages/etc/ediff/ediff-A-up.xpm b/xemacs-packages/etc/ediff/ediff-A-up.xpm deleted file mode 100644 index e5fde45c..00000000 --- a/xemacs-packages/etc/ediff/ediff-A-up.xpm +++ /dev/null @@ -1,24 +0,0 @@ -/* XPM */ -static char *ediff_A[] = { -/* width height num_colors chars_per_pixel */ -" 15 15 2 1", -/* colors */ -". c blue", -"# c Gray75 s backgroundToolBarColor", -/* pixels */ -"###############", -"###############", -"###############", -"######...######", -"#####.....#####", -"#####..#..#####", -"####...#...####", -"####..###..####", -"###...###...###", -"###.........###", -"###..#####..###", -"###..#####..###", -"###############", -"###############", -"###############", -}; diff --git a/xemacs-packages/etc/ediff/ediff-A-xx.xpm b/xemacs-packages/etc/ediff/ediff-A-xx.xpm deleted file mode 100644 index 50c6cfa1..00000000 --- a/xemacs-packages/etc/ediff/ediff-A-xx.xpm +++ /dev/null @@ -1,24 +0,0 @@ -/* XPM */ -static char *ediff_A[] = { -/* width height num_colors chars_per_pixel */ -" 15 15 2 1", -/* colors */ -". c gray60", -"# c Gray75 s backgroundToolBarColor", -/* pixels */ -"###############", -"###############", -"###############", -"######...######", -"#####.....#####", -"#####..#..#####", -"####...#...####", -"####..###..####", -"###...###...###", -"###.........###", -"###..#####..###", -"###..#####..###", -"###############", -"###############", -"###############", -}; diff --git a/xemacs-packages/etc/ediff/ediff-B-up.xbm b/xemacs-packages/etc/ediff/ediff-B-up.xbm deleted file mode 100644 index bcb82eb3..00000000 --- a/xemacs-packages/etc/ediff/ediff-B-up.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define ediff-B-up_width 15 -#define ediff-B-up_height 15 -static char ediff-B-up_bits[] = { - 0x00,0x80,0x00,0x80,0xf8,0x81,0xf8,0x83,0x38,0x87,0x38,0x86,0xf8,0x83,0xf8, - 0x87,0x38,0x8e,0x38,0x8c,0x38,0x8e,0xf8,0x87,0xf8,0x83,0x00,0x80,0x00,0x80 - }; diff --git a/xemacs-packages/etc/ediff/ediff-B-up.xpm b/xemacs-packages/etc/ediff/ediff-B-up.xpm deleted file mode 100644 index c9c4c5a9..00000000 --- a/xemacs-packages/etc/ediff/ediff-B-up.xpm +++ /dev/null @@ -1,25 +0,0 @@ -/* XPM */ -static char *ediff-B-up[] = { -/* width height num_colors chars_per_pixel */ -" 15 15 2 1", -/* colors */ -". c blue", -"# c Gray75 s backgroundToolBarColor", -/* pixels */ -"###############", -"###############", -"###......######", -"###.......#####", -"###...##...####", -"###...###..####", -"###.......#####", -"###........####", -"###...###...###", -"###...####..###", -"###...###...###", -"###........####", -"###.......#####", -"###############", -"###############", -"###############" -}; diff --git a/xemacs-packages/etc/ediff/ediff-B-xx.xpm b/xemacs-packages/etc/ediff/ediff-B-xx.xpm deleted file mode 100644 index 00338536..00000000 --- a/xemacs-packages/etc/ediff/ediff-B-xx.xpm +++ /dev/null @@ -1,25 +0,0 @@ -/* XPM */ -static char *ediff-B-up[] = { -/* width height num_colors chars_per_pixel */ -" 15 15 2 1", -/* colors */ -". c gray60", -"# c Gray75 s backgroundToolBarColor", -/* pixels */ -"###############", -"###############", -"###......######", -"###.......#####", -"###...##...####", -"###...###..####", -"###.......#####", -"###........####", -"###...###...###", -"###...####..###", -"###...###...###", -"###........####", -"###.......#####", -"###############", -"###############", -"###############" -}; diff --git a/xemacs-packages/etc/ediff/ediff-help.xbm b/xemacs-packages/etc/ediff/ediff-help.xbm deleted file mode 100644 index b2c76efe..00000000 --- a/xemacs-packages/etc/ediff/ediff-help.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define ediff-help_width 15 -#define ediff-help_height 15 -static char ediff-help_bits[] = { - 0x00,0x80,0xf0,0x83,0x0c,0x86,0xe4,0x8c,0x74,0x8d,0xb4,0x8c,0x58,0x86,0x20, - 0x83,0xa0,0x83,0xa0,0x81,0xc0,0x80,0x20,0x83,0x20,0x83,0xc0,0x81,0x00,0x80 - }; diff --git a/xemacs-packages/etc/ediff/ediff-help.xpm b/xemacs-packages/etc/ediff/ediff-help.xpm deleted file mode 100644 index 3964d9a2..00000000 --- a/xemacs-packages/etc/ediff/ediff-help.xpm +++ /dev/null @@ -1,26 +0,0 @@ -/* XPM */ -static char *help[] = { -/* width height num_colors chars_per_pixel */ -" 15 15 3 1", -/* colors */ -". c #000000", -"b c Gray75 s backgroundToolBarColor", -"c c #ffff00", -/* pixels */ -"bbbbbbbbbbbbbbb", -"bbbb......bbbbb", -"bbb.ccccc..bbbb", -"bb.cc...cc..bbb", -"bb.c..bb.c..bbb", -"bb.c..b.cc..bbb", -"bbb..b.cc..bbbb", -"bbbbb.cc..bbbbb", -"bbbbb.c..bbbbbb", -"bbbbb.c..bbbbbb", -"bbbbbb..bbbbbbb", -"bbbbb.cc..bbbbb", -"bbbbb.cc..bbbbb", -"bbbbbb...bbbbbb", -"bbbbbbbbbbbbbbb" -"bbbbbbbbbbbbbbb" -}; diff --git a/xemacs-packages/etc/ediff/ediff-next.xbm b/xemacs-packages/etc/ediff/ediff-next.xbm deleted file mode 100644 index 240c6bfd..00000000 --- a/xemacs-packages/etc/ediff/ediff-next.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define ediff-next_width 15 -#define ediff-next_height 15 -static char ediff-next_bits[] = { - 0x00,0x80,0x80,0x80,0x80,0x83,0x80,0x82,0xfe,0x8c,0x02,0x8a,0xfa,0xb7,0xfa, - 0xbf,0xfa,0x9f,0xfe,0x8f,0xfe,0x87,0x80,0x83,0x80,0x81,0x80,0x80,0x00,0x80 - }; diff --git a/xemacs-packages/etc/ediff/ediff-next.xpm b/xemacs-packages/etc/ediff/ediff-next.xpm deleted file mode 100644 index b8718670..00000000 --- a/xemacs-packages/etc/ediff/ediff-next.xpm +++ /dev/null @@ -1,25 +0,0 @@ -/* XPM */ -static char * file[] = { -/* width height num_colors chars_per_pixel */ -"15 15 5 1", -" c Gray75 s backgroundToolBarColor", -". c black", -"X c white", -"o c black", -"O c black", -" ", -" . ", -" .. ", -" .X. ", -" .......XX. ", -" .XXXXXXXoX. ", -" .XooooooooX. ", -" .Xoooooooooo. ", -" .XooooooooO. ", -" .oOOOOOOoO. ", -" .......OO. ", -" .O. ", -" .. ", -" . ", -" ", -}; diff --git a/xemacs-packages/etc/ediff/ediff-prev.xbm b/xemacs-packages/etc/ediff/ediff-prev.xbm deleted file mode 100644 index 052f9620..00000000 --- a/xemacs-packages/etc/ediff/ediff-prev.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define ediff-prev_width 15 -#define ediff-prev_height 15 -static char ediff-prev_bits[] = { - 0x00,0x80,0x00,0x81,0x80,0x81,0x40,0x81,0x20,0xbf,0x50,0xa0,0xe8,0xaf,0xfc, - 0xaf,0xf8,0xaf,0xf0,0xbf,0xe0,0xbf,0xc0,0x81,0x80,0x81,0x00,0x81,0x00,0x80 - }; diff --git a/xemacs-packages/etc/ediff/ediff-prev.xpm b/xemacs-packages/etc/ediff/ediff-prev.xpm deleted file mode 100644 index c53e6a40..00000000 --- a/xemacs-packages/etc/ediff/ediff-prev.xpm +++ /dev/null @@ -1,23 +0,0 @@ -/* XPM */ -static char * left-arrow_xpm[] = { -/* width height num_colors chars_per_pixel */ -"15 15 3 1", -" c Gray75 s backgroundToolBarColor", -". c black", -"X c white", -" ", -" . ", -" .. ", -" .X. ", -" .XX...... ", -" .X.XXXXXX. ", -" .X.......X. ", -" ..........X. ", -" .........X. ", -" .......... ", -" ......... ", -" ... ", -" .. ", -" . ", -" ", -}; diff --git a/xemacs-packages/etc/ediff/ediff-quit.xbm b/xemacs-packages/etc/ediff/ediff-quit.xbm deleted file mode 100644 index 7c28d957..00000000 --- a/xemacs-packages/etc/ediff/ediff-quit.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define ediff-quit_width 15 -#define ediff-quit_height 15 -static char ediff-quit_bits[] = { - 0x00,0x80,0x06,0xb0,0x1e,0x98,0x3c,0x8c,0x70,0x82,0xe0,0x83,0xc0,0x81,0xe0, - 0x83,0x70,0x86,0x38,0x8c,0x1c,0x88,0x1c,0x90,0x08,0x80,0x00,0x80,0x00,0x80 - }; diff --git a/xemacs-packages/etc/ediff/ediff-quit.xpm b/xemacs-packages/etc/ediff/ediff-quit.xpm deleted file mode 100644 index 37d51236..00000000 --- a/xemacs-packages/etc/ediff/ediff-quit.xpm +++ /dev/null @@ -1,26 +0,0 @@ -/* XPM */ -static char *delete[] = { -/* width height num_colors chars_per_pixel */ -" 15 15 4 1", -/* colors */ -". c #808080", -"# c #800000", -"a c #ffffff", -"b c #c0c0c0", -/* pixels */ -"bbbbbbbbbbbbbbb", -"b##abbbbbbbb##a", -"b####abbbbb##ab", -"bb####abbb##abb", -"bbbb###ab#abbbb", -"bbbbb#####abbbb", -"bbbbbb###abbbbb", -"bbbbb#####abbbb", -"bbbb###ab##abbb", -"bbb###abbb##abb", -"bb###abbbbb#abb", -"bb###abbbbbb#ab", -"bbb#abbbbbbbbbb", -"bbb#abbbbbbbbbb", -"bbbbbbbbbbbbbbb", -}; diff --git a/xemacs-packages/etc/ediff/ediff-refine.xbm b/xemacs-packages/etc/ediff/ediff-refine.xbm deleted file mode 100644 index 059156be..00000000 --- a/xemacs-packages/etc/ediff/ediff-refine.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define ediff-refine_width 15 -#define ediff-refine_height 15 -static char ediff-refine_bits[] = { - 0x00,0x80,0x80,0x80,0x84,0x90,0x8c,0x98,0x98,0x8c,0xf0,0x87,0xe0,0x83,0xe0, - 0x83,0xe0,0x83,0xf0,0x87,0x98,0x8c,0x8c,0x98,0x84,0x90,0x80,0x80,0x00,0x80 - }; diff --git a/xemacs-packages/etc/ediff/ediff-refine.xpm b/xemacs-packages/etc/ediff/ediff-refine.xpm deleted file mode 100644 index c54eaff4..00000000 --- a/xemacs-packages/etc/ediff/ediff-refine.xpm +++ /dev/null @@ -1,24 +0,0 @@ -/* XPM */ -static char *help[] = { -/* width height num_colors chars_per_pixel */ -" 15 15 2 1", -/* colors */ -"# c #000000", -"a c Gray75 s backgroundToolBarColor", -/* pixels */ -"aaaaaaaaaaaaaaa", -"aaaaaaa#aaaaaaa", -"aa#aaaa#aaaa#aa", -"aa##aaa#aaa##aa", -"aaa##aa#aa##aaa", -"aaaa#######aaaa", -"aaaaa#####aaaaa", -"aaaaa#####aaaaa", -"aaaaa#####aaaaa", -"aaaa#######aaaa", -"aaa##aa#aa##aaa", -"aa##aaa#aaa##aa", -"aa#aaaa#aaaa#aa", -"aaaaaaa#aaaaaaa", -"aaaaaaaaaaaaaaa", -}; diff --git a/xemacs-packages/etc/ediff/ediff-save-xx.xbm b/xemacs-packages/etc/ediff/ediff-save-xx.xbm deleted file mode 100644 index b2527699..00000000 --- a/xemacs-packages/etc/ediff/ediff-save-xx.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define disk-xx_width 15 -#define disk-xx_height 15 -static char disk-xx_bits[] = { - 0x00,0x00,0x0a,0x28,0x00,0x00,0x0a,0x28,0x00,0x00,0x0a,0x28,0x00,0x00,0xfa, - 0x2f,0x00,0x00,0x02,0x20,0x00,0x00,0x0a,0x29,0x00,0x00,0xf8,0x3f,0x00,0x00 - }; diff --git a/xemacs-packages/etc/ediff/ediff-save-xx.xpm b/xemacs-packages/etc/ediff/ediff-save-xx.xpm deleted file mode 100644 index fcd14fbb..00000000 --- a/xemacs-packages/etc/ediff/ediff-save-xx.xpm +++ /dev/null @@ -1,25 +0,0 @@ -/* XPM */ -static char * disk[] = { -"15 15 5 1", -"X c Gray75 s backgroundToolBarColor", -"o c Gray60", -"O c Gray60", -"+ c Gray90", -"@ c Gray40", -"XXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXX", -"XoooooooooooooX", -"XoOo+++++++oOoX", -"XoOo+++++++oOoX", -"XoOo+++++++oOoX", -"XoOo+++++++oOoX", -"XoOoooooooooOoX", -"XoOOOOOOOOOOOoX", -"XoOoooooooooOoX", -"XoOo@@@@o++oOoX", -"XoOo@@@@o++oOoX", -"XoOo@@@@o++oOoX", -"XXooooooooooooX", -"XXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXX" -}; diff --git a/xemacs-packages/etc/ediff/ediff-save.xbm b/xemacs-packages/etc/ediff/ediff-save.xbm deleted file mode 100644 index b53fedaa..00000000 --- a/xemacs-packages/etc/ediff/ediff-save.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define disk-up_width 15 -#define disk-up_height 15 -static char disk-up_bits[] = { - 0x00,0x00,0xfe,0x3f,0x0a,0x28,0x0a,0x28,0x0a,0x38,0x0a,0x28,0x0a,0x28,0xfa, - 0x2f,0x02,0x20,0xfa,0x2f,0x0a,0x29,0x0a,0x29,0x0c,0x29,0xf8,0x3f,0x00,0x00 - }; diff --git a/xemacs-packages/etc/ediff/ediff-save.xpm b/xemacs-packages/etc/ediff/ediff-save.xpm deleted file mode 100644 index a9a8e2b4..00000000 --- a/xemacs-packages/etc/ediff/ediff-save.xpm +++ /dev/null @@ -1,25 +0,0 @@ -/* XPM */ -static char * disk[] = { -"15 15 5 1", -"X c Gray75 s backgroundToolBarColor", -"o c black", -"O c Gray60", -"+ c Gray90", -"@ c Gray40", -"XXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXX", -"XoooooooooooooX", -"XoOo+++++++oOoX", -"XoOo+++++++oOoX", -"XoOo+++++++oOoX", -"XoOo+++++++oOoX", -"XoOoooooooooOoX", -"XoOOOOOOOOOOOoX", -"XoOoooooooooOoX", -"XoOo@@@@o++oOoX", -"XoOo@@@@o++oOoX", -"XoOo@@@@o++oOoX", -"XXooooooooooooX", -"XXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXX" -}; diff --git a/xemacs-packages/etc/ediff/ediff-toggle-split-up.xbm b/xemacs-packages/etc/ediff/ediff-toggle-split-up.xbm deleted file mode 100644 index ee1bbeee..00000000 --- a/xemacs-packages/etc/ediff/ediff-toggle-split-up.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define ediff-toggle-split-up_width 15 -#define ediff-toggle-split-up_height 15 -static char ediff-toggle-split-up_bits[] = { - 0x00,0x80,0xfe,0x87,0xfe,0x87,0x00,0x80,0x00,0xb0,0x7e,0xb0,0x1e,0xb0,0x1e, - 0xb0,0x3e,0xb2,0x72,0xb3,0xe2,0xb3,0xc0,0xb3,0xc0,0xb3,0xf0,0xb7,0x00,0x80 - }; diff --git a/xemacs-packages/etc/ediff/ediff-toggle-split-up.xpm b/xemacs-packages/etc/ediff/ediff-toggle-split-up.xpm deleted file mode 100644 index b41fff7c..00000000 --- a/xemacs-packages/etc/ediff/ediff-toggle-split-up.xpm +++ /dev/null @@ -1,25 +0,0 @@ -/* XPM */ -static char *ediff-toggle-split-up[] = { -/* width height num_colors chars_per_pixel */ -" 15 15 3 1", -/* colors */ -"# c #000000", -"a c firebrick", -"f c Gray75 s backgroundToolBarColor", -/* pixels */ -"fffffffffffffff", -"faaaaaaaaaaffff", -"faaaaaaaaaaffff", -"fffffffffffffff", -"ffffffffffffaaf", -"f######fffffaaf", -"f####fffffffaaf", -"f####fffffffaaf", -"f#####fff#ffaaf", -"f#ff###ff#ffaaf", -"f#fff#####ffaaf", -"ffffff####ffaaf", -"ffffff####ffaaf", -"ffff######ffaaf", -"fffffffffffffff", -}; diff --git a/xemacs-packages/etc/ediff/ediff-update.xbm b/xemacs-packages/etc/ediff/ediff-update.xbm deleted file mode 100644 index 6d4598db..00000000 --- a/xemacs-packages/etc/ediff/ediff-update.xbm +++ /dev/null @@ -1,6 +0,0 @@ -#define ediff-update_width 15 -#define ediff-update_height 15 -static char ediff-update_bits[] = { - 0x00,0x80,0x78,0x80,0xcc,0x99,0x04,0x9b,0x04,0x9c,0x04,0x9e,0x0c,0x9f,0x00, - 0x80,0x7c,0x98,0x3c,0x90,0x1c,0x90,0x6c,0x90,0xcc,0x99,0x00,0x8f,0x00,0x80 - }; diff --git a/xemacs-packages/etc/ediff/ediff-update.xpm b/xemacs-packages/etc/ediff/ediff-update.xpm deleted file mode 100644 index adc802c7..00000000 --- a/xemacs-packages/etc/ediff/ediff-update.xpm +++ /dev/null @@ -1,25 +0,0 @@ -/* XPM */ -static char *update[] = { -/* width height num_colors chars_per_pixel */ -" 15 15 3 1", -/* colors */ -". c #000000", -"a c #000080", -"c c Gray75 s backgroundToolBarColor", -/* pixels */ -"ccccccccccccccc", -"ccc.aaacccccccc", -"cc.acccaacccacc", -"ccaccccccacaacc", -"ccacccccccaaacc", -"ccaccccccaaaacc", -"cc.accccaaaaacc", -"ccccccccccccccc", -"ccaaaaacccca.cc", -"ccaaaaccccccacc", -"ccaaacccccccacc", -"ccaacaccccccacc", -"ccacccaaccca.cc", -"ccccccccaaa.ccc", -"ccccccccccccccc", -}; diff --git a/xemacs-packages/etc/enriched.doc b/xemacs-packages/etc/enriched.doc deleted file mode 100644 index 99301679..00000000 --- a/xemacs-packages/etc/enriched.doc +++ /dev/null @@ -1,219 +0,0 @@ -Content-Type: text/enriched -Text-Width: 80 - -bluewhite

enriched.el:
-blueWYSIWYG rich text editing for GNU Emacs -
bluewhiteINTRODUCTION - - -Emacs now has the ability to edit enriched text, which is text -containing faces, colors, indentation, and other properties. This -document is a quick introduction to some of the new features, and -is also an example file in the text/enriched format. - - -bluewhiteINSTALLATION and STARTUP - - -Most of the time, you need not do anything to get these features -to work. If you visit a file that has been written out in -text/enriched format, it will automatically be decoded, Emacs will -enter `enriched-mode' while visiting it, and whenever you save it -it will be saved in the same format it was read in. - -If you wish to create a new file, however, you will need to turn -on enriched-mode yourself: - - -M-x enriched-mode RET -Or, if you get a text/enriched file that Emacs does not -automatically recognize and decode, you can tell Emacs to decode -it (which also turns on enriched-mode automatically): - - -M-x format-decode-buffer RET text/enriched RET -bluewhiteWHAT IS ENCODED - - -Here is the current list of text-properties that are saved; they -are discussed in more detail below. Most of these can be added or -changed with the "Text Properties" menu, available under the -"Edit" item in the menu-bar, or on C-mouse-2 (Control + the middle -mouse button). - -Faces: default, bold, italic, underline, fixed, etc. - -Colors: redDarkSlateGrayanyDarkSlateGrayorangething yellowyourgreen screenblue light bluecanviolet display... -Sizes: things can get larger, smaller, much larger, and much - smaller. - -Newlines: Which ones are real ("hard") newlines, and which can be -changed to fit lines into the margins. - -Margins: can be indented on the left or right. - -Justification (whether lines should be flush with the left margin, -the right margin, fully justified, centered, or left alone). - -Excerpts: "For quoted material." -Read-only regions. - - -bluewhiteFACES and COLORS - - -You can add faces either with the menu or with M-g. The face is -applied to the current region. If you are using -`transient-mark-mode' and the region is not active, then the face -applies to whatever you type next. Any face can have colors, but -faces have no other attributes are put on the color submenus of -the "Text Properties" menu. - - -bluewhiteNEWLINES and PARAGRAPHS - - -Text/enriched format distinguishes between hard and soft newlines. -Hard newlines are used to separate paragraphs, or items in a list, -or anywhere that must be a line break no matter what the margins -are. Soft newlines are the ones inserted in order to fit text -between the margins. The fill and auto-fill functions insert soft -newlines as necessary, but hard newlines are only inserted by -direct request, such as using the return key or the C-o -(open-line) function. - - -bluewhiteINDENTATION - - -The fill functions also understand margins, which can be set -for any region of a document. In addition to the menu items, -which increase or decrease the margins, there are two commands -for setting the margins absolutely: C-c l (set-left-margin) -and C-c r (set-right-margin). -You can change indentation at any point in a paragraph, which -makes it possible to do interesting things like -hanging-indents: this paragraph was indented by selecting the -region from the second word to the end of the paragraph, and -indenting only that part. - -bluewhiteJUSTIFICATION - -Several styles of justification are possible, the simplest being unfilled. -This means that your lines will be left as you write them. -This paragraph is unfilled. - -The most common (for English) style is FlushLeft. This means -lines are aligned at the left margin but left uneven at the -right. - - - FlushRight makes each line flush with the right margin instead. - - -FlushBoth regions, which are sometimes called "fully justified" -are aligned evenly on both edges, so that the text on the page has -a smooth appearance as in a book or newspaper article. -Unfortunately this does not look as nice with a fixed-width font -as it does in a proportionally-spaced printed document; the extra -spaces that are needed on the screen can make it hard to -read. - -
Center - -
Finally, there is center justification. The normal - center-paragraph key, M-S, can be used to turn on center - justification in enriched-mode. - - M-j or the "Text Properties" menu also can be used to change - justification. - - -
Note that justification can only change at hard newlines, because -that is the unit over which filling gets done. - -bluewhiteEXCERPTS - - -This is an example of an excerpt. You can use them for quoted -parts of other people's email messages and the like. It is just a -face, which is the same as the `italic' face by default. -bluewhiteTHE FILE FORMAT - -Enriched-mode docuemnts are saved in an extended version of a -format called text/enriched, which is defined as part of the MIME -standard. This means that your documents are transportable (even -through email) to many other systems. In the future other file -formats may be supported as well. - - -Since Emacs adds some non-standard features to the format (colors - -and read-only regions), not all systems will be able to recreate -all of the features of your document, but they will get as close -as possible. - - -The MIME standard is defined in internet RFC 1521; text/enriched -is defined in RFC 1563. Details on obtaining these documents via -FTP or email may be obtained by sending an email message to -rfc-info@isi.edu with the message body: - -help: ways_to_get_rfcs - - -See also the newsgroup comp.mail.mime. - - -bluewhiteCUSTOMIZATION - - -- The fixed and excerpt faces should be set to your liking. -- User-preference variables: default-justification, -enriched-verbose. - You can add annotations for your own text -properties by making additions to enriched-annotation-alist. -Note that the standard requires you to name your annotation -starting "x-" (as in "x-read-only"). Please send me any such -additions that you think might be of general interest so that -I can include them in the distribution. - - -bluewhiteTO-DO LIST - - -[Feel free to work on these and send me the results!] -- Be smarter about fixing malformed files. - -- Make the indentation work more seamlessly and robustly: - -+ Create an aggressive auto-fill function that will keep the -paragraph properly filled all the time, without slowing -down editing too much. -+ Refill after yank. - -+ Make deleting a newline also delete the indentation -following it. -+ Never let point enter indentation?? - -- Notice and re-fill when window changes widths (optionally). - -- Deal with the `category' text-property in a smart way. - -- Interface w/ GNUS, VM, RMAIL. Maybe Info too? - -- Support more formats: RTF, HTML... - - -bluewhiteFinal Notes: - - -This code and documentation is under development. Comments and -bug reports are welcome. - - -whiteblueBoris Goldowskylight blue light blue<blue -bluewhite April 1995blue -slightly augmented to match XEmacs version byblue -bluewhiteMichael Sperber < - -bluewhite April 1996 diff --git a/xemacs-packages/etc/python-modes/pydoc_lisp.py b/xemacs-packages/etc/python-modes/pydoc_lisp.py deleted file mode 100755 index 0ae5ac02..00000000 --- a/xemacs-packages/etc/python-modes/pydoc_lisp.py +++ /dev/null @@ -1,113 +0,0 @@ -#!/usr/bin/env python -# -*- Mode: Python; tab-width: 4 -*- -# -# SUMMARY: Produces Lisp lists of Python paths, pydoc keywords, modules and help topics. -# USAGE: l = Pydoc_Lisp() -# KEYWORDS: doc, emacs, lisp, pydoc -# -# AUTHOR: Bob Weiner -# ORG: Deepware -# -# ORIG-DATE: 18-Apr-01 at 12:08:46 -# LAST-MOD: 22-Apr-01 at 11:03:03 by Bob Weiner -# -# COPYRIGHT: Copyright (C) 2001 Bob Weiner -# Available for use and distribution under the terms of the Python license 2.0 or greater. -# -# DESCRIPTION: -""" -Produces Lisp lists of Python paths, pydoc keywords, modules and help topics. -See the doc for class Pydoc_Lisp for details. This provides the interface from -pydoc to the Emacs Lisp pydoc commands. -""" -# DESCRIP-END. - -## ------------------------------------------------------------------------ -## Required modules -## ------------------------------------------------------------------------ - -from string import find, join -import pydoc -import sys - -## ------------------------------------------------------------------------ -## Globals -## ------------------------------------------------------------------------ - -global pydoc_lisp_alist - -def pydoc_output_lisp(): - try: - if isinstance(pydoc_lisp_alist, Pydoc_Lisp): - # Reinitialize the lists - pydoc_lisp_alist.__init__() - else: - pydoc_lisp_alist = Pydoc_Lisp() - except NameError: - pydoc_lisp_alist = Pydoc_Lisp() - - -## ------------------------------------------------------------------------ -## Classes -## ------------------------------------------------------------------------ - -# This is defined as a class so that it may be easily added to pydoc.py -# rather than keeping it in this separate module. -class Pydoc_Lisp: - """ - Produces Lisp lists of Python paths, pydoc keywords, modules and help topics. - Results are stored in the class variables: keywords, modules, topics - and alist, the latter being an association list containing each of the former - three values. An instance prints as the value of `alist'. Call self.__init__() - if there is a need to reset the value of the module list. - """ - - ## Class variables - keywords = modules = paths = topics = alist = None - - def __init__(self): - Pydoc_Lisp.keywords = self._dict_to_lisp_list(pydoc.Helper.keywords) - Pydoc_Lisp.modules = self._get_modules_lisp() - Pydoc_Lisp.paths = self._get_paths_lisp() - Pydoc_Lisp.topics = self._dict_to_lisp_list(pydoc.Helper.topics) - Pydoc_Lisp.alist = '(("keywords" . %s)\n ("modules" . %s)\n ("paths" . %s)\n ("topics" . %s))' \ - % (Pydoc_Lisp.keywords, Pydoc_Lisp.modules, \ - Pydoc_Lisp.paths, Pydoc_Lisp.topics) - # Print the alist so the Lisp reader can evaluate it. - print Pydoc_Lisp.alist - - def __str__(self): - return Pydoc_Lisp.alist - - def _dict_to_lisp_list(self, dict): - keys = dict.keys() - keys.sort() - return '(("%s"))\n' % join(keys, '") ("') - - def _get_modules_lisp(self): - "Return a Lisp list of available Python module and package names." - module_dict = {} - - def callback(path, modname, desc, module_dict=module_dict): - if modname and modname[-9:] == '.__init__': - modname = 'Pkg-' + modname[:-9] - if find(modname, '.') < 0: - module_dict[modname] = 1 - - pydoc.ModuleScanner().run(callback) - return self._dict_to_lisp_list(module_dict) - - def _get_paths_lisp(self): - paths = sys.path[:] - try: - paths[paths.index('')] = '.' - except ValueError: - pass - return '(("%s"))\n' % join(paths, '") ("') - -## ------------------------------------------------------------------------ -## Program execution -## ------------------------------------------------------------------------ - -if __name__ == '__main__': - l = Pydoc_Lisp() diff --git a/xemacs-packages/info/bbdb.info b/xemacs-packages/info/bbdb.info deleted file mode 100644 index 3487162c..00000000 --- a/xemacs-packages/info/bbdb.info +++ /dev/null @@ -1,3626 +0,0 @@ -This is bbdb.info, produced by makeinfo version 4.6 from bbdb.texinfo. - -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* BBDB: (bbdb). The Insidious Big Brother Database. -END-INFO-DIR-ENTRY - - This file documents the Insidious Big Brother Database - - This is edition $Revision: 1.9 $ of the BBDB User Manual for BBDB -version 2.34. - - Copyright (c) 1991-1994 Jamie Zawinski - - Copyright (c) 1997-1999 Matt Simmons - - Copyright (c) 2000-present The BBDB Development Team - - -File: bbdb.info, Node: Top, Next: Installation, Up: _ - -BBDB -**** - -BBDB is a rolodex-like database program for GNU Emacs. BBDB stands for -Insidious Big Brother Database, and is not, repeat, _not_ an obscure -reference to the Buck Rogers TV series. - - It provides the following features: - - * Integration with mail and news readers, with little or no - interaction by the user: - - * easy (or automatic) display of the record corresponding to - the sender of the current message; - - * automatic creation of records based on the contents of the - current message; - - * automatic addition of data to arbitrary fields of the record - corresponding to the sender of the current message. - - * Listing all records which match a regular expression; - - * Listing all records which match a regular expression in a - particular field (`company' or `notes,' for example); - -* Menu: - -* Installation:: Installation -* The BBDB:: Overview -* BBDB Mode:: BBDB Mode -* Interfaces:: Interfaces to various readers -* Reader-specific Features:: Features only available to specific readers -* Other Packages:: Using the BBDB with other packages -* Options:: Options -* Utilities:: Utilities -* Internals:: BBDB Internals -* Mailing Lists:: The BBDB mailing lists -* Changes:: New in this version -* The Latest Version:: Where to Get It -* The Future:: Known Bugs, the TODO list and EOL statements -* Thanks:: to the Ministry of Bugs - -* Concept Index:: Concept Index -* Variable Index:: Variable Index - - --- The Detailed Node Listing --- - -Installation - -* General Prerequisites:: General BBDB requirements - -File Installation -* Normal User:: "Normal" Installations -* XEmacs Package:: Installing as an XEmacs package - -Initial Configuration -* Initial Configuration:: How to initially set up the BBDB - -Manual initialization - -* Gnus Prep:: Initializing BBDB support for Gnus -* MH-E Prep:: Initializing BBDB support for MH-E -* RMAIL Prep:: Initializing BBDB support for RMAIL -* Sendmail Prep:: Initializing BBDB support for Sendmail -* VM Prep:: Initializing BBDB support for VM - -Other packages: - -* Message Prep:: Initializing BBDB support for Message mode -* Reportmail Prep:: Initializing BBDB support for Reportmail -* Supercite Prep:: Initializing BBDB support for Supercite -* Web Browser Prep:: Initializing BBDB support for Web Browsers - -The BBDB - -* Database Fields:: Description of database fields -* Basic Searching:: Basic database searching commands -* Advanced Searching:: Advanced database searching commands -* Manual Record Addition:: Adding records by hand - -Interfaces - -* Mail Reading Interfaces:: Mail Reading Interfaces -* News Reading Interfaces:: News Reading Interfaces -* Mail Sending Interfaces:: Mail Sending Interfaces - -Reader-specific Features - -* Gnus Features:: Gnus-specific Features -* VM Features:: VM-specific Features - -Gnus-specific Features - -* Gnus Scoring:: Store score adjustments in the BBDB -* Gnus Summary Buffer:: BBDB information in the Summary buffer -* GNUS Subject List:: BBDB information in the Subject List - -VM-specific features - -* VM Message Summary:: BBDB information in message summary - -Using the BBDB with other packages - -* Using Message Mode:: Using the BBDB with Message Mode -* Using Reportmail:: Using the BBDB with Reportmail -* Using Supercite:: Using the BBDB with Supercite -* Using Web Browsers:: Using the BBDB with Web Browsers - -Options - -* Customization Parameters:: Customization Parameters -* Customization Hooks:: Customization Hooks -* Predefined Hooks:: Predefined Hooks - -Utilities - -* bbdb-ftp:: Storing FTP sites in the BBDB -* bbdb-print:: Print the BBDB -* bbdb-snarf:: Record generation from raw text -* bbdb-srv:: External control of the BBDB - -Changes in this Version - -* Major Changes:: Major changes in this version -* Other Changes:: Not-so-major changes - -The Future - -* Known Bugs:: Known Bugs, and how to submit new ones -* TODO List:: The TODO List -* EOL Statements:: EOL (End Of Life) Statements - -_ - -* Top:: - - -File: bbdb.info, Node: Installation, Next: The BBDB, Prev: Top, Up: Top - -Installation -============ - -This program consists of several groups of files, organized by -directory: - - lisp - the main program code for the BBDB - tex - TeX support files for *Note bbdb-print::, the BBDB - printing utility - texinfo - the documentation files for the BBDB - utils - miscellaneous external utility programs - misc - things that don't fall into the above categories - bits - things that have been written as add-ons for BBDB - but have not yet been merged with the main codebase - -* Menu: - -* General Prerequisites:: General BBDB requirements - -File Installation -* Normal User:: "Normal" Installations -* XEmacs Package:: Installing as an XEmacs package - -Initial Configuration -* Initial Configuration:: How to initially set up the BBDB - - -File: bbdb.info, Node: General Prerequisites, Next: Normal User, Prev: Installation, Up: Installation - -General Prerequisites ---------------------- - -Various parts of the BBDB require extra packages to be available that -are not part of the BBDB distribution. Please note that with one -exception no extra packages (beyond those which ship with both GNU -Emacs and XEmacs) are required for the use of BBDB core -functionality.(1) This one exception applies to XEmacs 20.5 users - -the `xemacs-base' package must be installed for the correct operation -of the core BBDB functionality. The table below lists the requirements -of the various portions of the BBDB. Please note that the absence of -any of the below optional packages will not affect core BBDB -functionality. - -BBDB file Package needed GNU 19.34 GNU 20.2 XEmacs XEmacs - >=20.4 20.5 -`bbdb-ftp' EFS or B B B P - Ange-FTP -`bbdb-gnus' Gnus[1] B B B P -`bbdb-mhe' MH-E B B B P -`bbdb-reportmail' Reportmail B P[2] -`bbdb-sc' Supercite B B P -`bbdb-srv' `gnuserv' and B B - `itimer' -`bbdb-vm' VM[4] B P -`bbdb-w3' `browse-url' B B B P[3] - -NOTES: - 1. The old GNUS mail/newsreader should still work. Please keep in - mind that you have a relatively recent Emacs (GNU 19.34 or later, - XEmacs 19.15 or later), you are probably using Gnus. - - 2. As of this writing, Reportmail is available as part of the - `edit-utils' package. - - 3. As of this writing, `browse-url' is available as part of the - `mail-lib' package. - - 4. The source release of VM is currently required due to the use of - macros from the VM codebase in BBDB's VM integration. - - Please also note that the XEmacs package locations are as of this -writing. As the XEmacs 20.5 package system is still in development, the -locations may change without warning. - - ---------- Footnotes ---------- - - (1) "Core Functionality" is defined as the parts of the BBDB used to -implement basic record creation (`M-x bbdb-create') and searching (`M-x -bbdb'). - - -File: bbdb.info, Node: Normal User, Next: XEmacs Package, Prev: General Prerequisites, Up: Installation - -Normal User Installation ------------------------- - -Configuring the compilation process ------------------------------------ - -First of all, you should run the `configure' script at the toplevel of -the distribution. This script will perform a number of checks on your -system and generate the `Makefile''s accordingly. - - The `configure' script also comes with a number of options that lets -you customize the compilation process. These options are described -below where appropriate. - -Byte Compiling the Lisp files ------------------------------ - -First, you need to byte-compile the appropriate BBDB Lisp files. While -this is in theory an optional step, it is virtually required in -practice due to speed reasons. - - In order to byte-compile the lisp files, an Emacs of some sort must -be used. By default (at `configure' time), `emacs' and `xemacs' will be -tried in that order. If you want to use a special Emacs flavor (or if -you want to use `xemacs' at the first place), you should pass the -`--with-emacs=PROG' option to `configure'. - - In order to successfully compile the BBDB, the build process also -needs to know the location of the various optional packages. If the -directories containing these optional packages are in the default Emacs -search path (the `load-path' variable), no other changes need be made -for the build process to complete successfully. - - If the optional packages are not in the default search path, the -build process will not find them unless explicitly told of their -location(s). To tell the build process where to find Gnus, MH-E, -and/or VM, use the `configure' options `--with-gnus-dir=DIR', -`--with-mhe-dir=DIR', and/or `--with-vm-dir=DIR' variables -respectively. To tell the build process where to find any other -package(s), pass the directories containing the lisp files for the -package(s) to the `configure' option `--with-other-dirs=DIRS'. If -multiple directories are to be added, they should be separated by -spaces or colons, and should not be quoted. For example, to add the -`/p/local/elisp/footnote' and `/p/local/elisp/sc' directories, call the -`configure' script as follows: - - `configure --with-other-dirs=/p/local/elisp/footnote:/p/local/elisp/sc' - - After configuring, run one of the following commands: - - `make bbdb' - Build the core, mailer independent, components - `make gnus' - Core components plus `Gnus' support - `make mhe' - Core components plus `MH-E' support - `make rmail' - Core components plus `RMAIL' support - `make vm' - Build the core components with `VM' support - `make all' - Core components plus support for all mailers - listed above - - You can also combine the above `make' commands. For example, to -build the BBDB with support for `Gnus' and `VM', you can do so by -typing: - - make gnus vm - -Moving the files to their final destination -------------------------------------------- - -Lisp files -.......... - -As stated above, the `lisp' subdirectory contains the Emacs Lisp source -files for the BBDB. Therefore, these files must be in the Emacs -`load-path'. There are several ways of doing this, three of which are -described below: - - * Add the `lisp' directory from the source distribution to the - `load-path'. This will allow you to run the BBDB in-place. This - method is recommended for normal users or BBDB developers, - especially if disk usage is an issue. It is not recommended for - site-wide installations. - - * Link the `lisp' directory into your `site-lisp' directory. This is - for a site-wide installation, but it is subject to the following - caveat. If you link the `lisp' directory into `site-lisp', you - will make life more difficult for yourself down the road, as you - will not be able to make changes to the source directory (new - versions, patches, etc) without having an effect on other users - who now depend on it. This directory will automatically be added - to the `load-path' when Emacs starts. - - * Make a directory whose sole purpose in life is containing the - production copies of the BBDB source and byte-compiled source - files. Either put this directory under `site-lisp' (or put it - somewhere else and link it into `site-lisp'). This directory will - automatically be added to the `load-path' when Emacs starts. This - is the best of the three listed here, as it allows for a degree of - separation between the (possibly changing) source tree and the - production code. - -TeX files -......... - -The `tex' subdirectory contains the TeX support files for bbdb-print, -the BBDB printing utility (*Note bbdb-print::.). The three support -files, `bbdb-cols.tex', `bbdb-print.tex', and `bbdb-print-brief.tex', -must be placed in a directory that is either on the default TeX search -path or is listed in the `TEXINPUTS' environment variable. If neither -of these two options is taken, TeX will not be able to process the file -output by `bbdb-print'. - -texinfo files -............. - -The `bbdb.info' file in this directory contains the documentation for -the BBDB. This file should either be linked or copied to a directory -on the default path for the `info' program or listed in the `INFOPATH' -environment variable. - - -File: bbdb.info, Node: XEmacs Package, Next: Initial Configuration, Prev: Normal User, Up: Installation - -XEmacs Package Installation ---------------------------- - -NOTE: XEmacs packages are currently supported only under XEmacs -versions after and including 20.5. If you are not running such a -version of XEmacs, you should install the BBDB according to the -instructions in *Note Normal User::. - -Configuring / Byte Compiling ----------------------------- - -The configuration and byte-compilation procedures are the same as in the -Normal User installation. See *Note Normal User::. - -Moving the files to their final destination -------------------------------------------- - -Support is provided for the automatic installation of the BBDB in an -XEmacs package directory. The following `configure' options are -available for you: - -`--with-package-dir=DIR' - This option sets the root of the XEmacs package directory. By - default, `/usr/local/lib/xemacs/site-packages' is used. - -`--with-symlinks' - If this option is used, the installation will be done by making - symbolic links to the sources instead of copying the files. - -`--with-linkpath=PATH' - Without this option, the installation process uses the output of - `pwd' to determine the current directory. If something else should - be used, you should provide an alternate name for the BBDB toplevel - directory by using `--with-linkpath'. If, for example, `pwd' - returns `/p/local/elisp/bbdb', but you prefer to use - `/usr/local/elisp/bbdb/...' for the links, usr this: `configure - --with-linkpath=/usr/local/elisp/bbdb'. This option is ignored if - `--with-symlinks' is not used. - - To perform the (un)installation, use the command `make -(un)install-pkg'. This will compile the `lisp/auto-autoloads.el' file -and will install the appropriate files to the appropriate places. The -final installation tree will take the following form: - -`$(PACKAGEDIR)/' - - `lisp/' - - `bbdb/' - BBDB lisp source files. This directory contains a copy - of all `.el' and `.elc' files from the `lisp' source - directory, or is a symbolic link to it. - - `info/' - - `bbdb.info*' - BBDB documentation files. These are either copies of - the info files from the `texinfo' source directory, or - are symbolic links to them. - - `etc/' - - `bbdb/' - - `tex/' - BBDB support files for bbdb-print. This directory - contains a copy of the appropriate files from the - `tex' source directory, or is a symbolic link to it. - - `utils/' - BBDB miscellaneous utilities. This directory - contains a copy of the appropriate files from the - `utils' source directory, or is a symbolic link to - it. - - -File: bbdb.info, Node: Initial Configuration, Prev: XEmacs Package, Up: Installation - -Initial Configuration ---------------------- - -The simplest way to configure the BBDB is to include the following -forms in your Emacs configuration file: - - `(require 'bbdb)' - `(bbdb-initialize)' - - Note: The forms above replace the autoloads needed for previous -versions of the BBDB. - - This will set up the BBDB for basic querying and record manipulation -(the Core Functionality referred to in the Prerequisites section). It -will not enable any of the mailreader-, newsreader- or other -package-specific BBDB features. To enable some or all of these -features, the `(bbdb-initialize)' form can be enable as shown below. -Alternatively, the features can be enabled manually as described in the -following sections. - -Modifying `(bbdb-initialize)' ------------------------------ - -The `bbdb-initialize' function can be used to enable the various -package-specific BBDB functions. This feature activation is -accomplished through the passing of symbols which tell the function -which features to activate. These symbols are outlined below and in the -Emacs documentation for the `bbdb-initialize'(1) - -Initialization symbols for mail and news readers -................................................ - -`gnus' - Initialize support for Gnus(2). If you pass the `gnus' symbol, - you should probably also pass the `message' symbol. - -`mh-e' - Initialize support for the MH-E mail reader. - -`rmail' - Initialize support for the RMAIL mail reader. - -`sendmail' - Initialize support for sendmail (`M-x mail') - -`vm' - Initialize support for the VM mail reader.(3) - -Initialization symbols for other packages -......................................... - -`message' - Initialize support for Message mode (the mail composition program - included with Gnus). - -`reportmail' - Initialize support for the Reportmail mail notification package. - -`sc' - Initialize support for the Supercite message citation package. - Additional initialization is required for Supercite to work with - the BBDB. *Note Supercite Prep::. - -`w3' - Initialize support for Web browsers. - -Initialization example -...................... - -To initialize support for Gnus 5.5, Message mode, Supercite, and Web -browsers, the following forms would be used: - - (require 'bbdb) - (bbdb-initialize 'gnus 'message 'sc 'w3) - -Manual initialization -..................... - -If your initialization needs exceed those provided by -`bbdb-initialize', refer to the following sections for a description of -the procedures necessary for enabling BBDB support for the packages -listed above. The procedures described are the same as those carried -out by the `bbdb-initialize' function when passed the appropriate -symbols. That is, the procedure listed in the RMAIL Prep section below -is the same as than executed by `bbdb-initialize' when the `rmail' -symbol is passed. - -* Menu: - -Mail and News readers: - -* Gnus Prep:: Initializing BBDB support for Gnus -* MH-E Prep:: Initializing BBDB support for MH-E -* RMAIL Prep:: Initializing BBDB support for RMAIL -* Sendmail Prep:: Initializing BBDB support for Sendmail -* VM Prep:: Initializing BBDB support for VM - -Other packages: - -* Message Prep:: Initializing BBDB support for Message mode -* Reportmail Prep:: Initializing BBDB support for Reportmail -* Supercite Prep:: Initializing BBDB support for Supercite -* Web Browser Prep:: Initializing BBDB support for Web Browsers - - ---------- Footnotes ---------- - - (1) This documentation can be accessed by typing `C-h f -bbdb-initialize RET'. - - (2) If you are using GNUS (not Gnus), and if your GNUS version is -3.14 or older, use the `Gnus' (note the capitalization) symbol. - - (3) For the VM initialization to work properly, you must either call -`bbdb-initialize' with the `vm' symbol from within your VM -initialization file (`~/.vm'), or you must call `bbdb-insinuate-vm' -manually from within your VM initialization file. - - -File: bbdb.info, Node: Gnus Prep, Next: MH-E Prep, Prev: Initial Configuration, Up: Initial Configuration - -Initializing BBDB support for Gnus -.................................. - -To take advantage of the Gnus features of the BBDB, add one of the -following forms to your Emacs configuration file: - -For Gnus 3.14 or older: - - `(add-hook 'gnus-Startup-hook 'bbdb-insinuate-gnus)' - -For Gnus 3.15 or newer: - - `(add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)' - - `bbdb-insinuate-gnus' adds bindings for the default keys to Gnus and -configures Gnus to notify the BBDB when new messages are loaded. This -notification is required if the BBDB is to be able to display BBDB -entries for messages displayed in Gnus. - - -File: bbdb.info, Node: MH-E Prep, Next: RMAIL Prep, Prev: Gnus Prep, Up: Initial Configuration - -Initializing BBDB support for MH-E -.................................. - -To take advantage of the MH-E features of the BBDB, add the following -form to your Emacs configuration file: - - (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh) - - `bbdb-insinuate-mh' adds bindings for the default keys to MH-E and -configures MH-E to notify the BBDB when new messages are loaded. This -notification is required if the BBDB is to be able to display BBDB -entries for messages displayed in MH-E. - - -File: bbdb.info, Node: RMAIL Prep, Next: Sendmail Prep, Prev: MH-E Prep, Up: Initial Configuration - -Initializing BBDB support for RMAIL -................................... - -To take advantage of the RMAIL features of the BBDB, add the following -form to your Emacs configuration file: - - (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail) - - `bbdb-insinuate-rmail' adds bindings for the default keys to RMAIL -and configures RMAIL to notify the BBDB when new messages are loaded. -This notification is required if the BBDB is to be able to display BBDB -entries for messages displayed in RMAIL. - - -File: bbdb.info, Node: Sendmail Prep, Next: VM Prep, Prev: RMAIL Prep, Up: Initial Configuration - -Initializing BBDB support for Sendmail -...................................... - -To take advantage of send-mail-mode (the one invoked with `M-x mail') -features of the BBDB, add the following form to your Emacs -configuration file: - - (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) - - `bbdb-insinuate-sendmail' enables auto-completion in send-mail-mode. - - -File: bbdb.info, Node: VM Prep, Next: Message Prep, Prev: Sendmail Prep, Up: Initial Configuration - -Initializing BBDB support for VM -................................ - -To take advantage of the VM features of the BBDB, either add `'vm' to -the parameters of the `(bbdb-initialize)' form, or add the following -form to your `~/.vm' file: - - `(bbdb-insinuate-vm)' - - `bbdb-insinuate-vm' adds bindings for the default keys to VM and -configures VM to notify the BBDB when new messages are loaded. This -notification is required if the BBDB is to be able to display BBDB -entries for messages displayed in VM. - - -File: bbdb.info, Node: Message Prep, Next: Reportmail Prep, Prev: VM Prep, Up: Initial Configuration - -Initializing BBDB support for Message mode -.......................................... - -To allow the BBDB to be used in Message mode, add the following form to -your Emacs initialization file: - - `(bbdb-insinuate-message)' - - `bbdb-insinuate-message' adds a binding for `M-TAB' to Message mode. -This will enable completion of addressees based on BBDB records. See -*Note Using Message Mode:: for more details on the operation of Message -mode BBDB record completion. - - -File: bbdb.info, Node: Reportmail Prep, Next: Supercite Prep, Prev: Message Prep, Up: Initial Configuration - -Initializing BBDB support for Reportmail -........................................ - -To allow the Reportmail package to report information from BBDB records -for new mail, add the following form to your Emacs initialization file: - - `(bbdb-insinuate-reportmail)' - - `bbdb-insinuate-reportmail' adds to the `display-time-get-field' -function to allow access to BBDB records during new mail information -display. See *Note Using Reportmail:: for more details on the -operation of Reportmail with the BBDB. - - -File: bbdb.info, Node: Supercite Prep, Next: Web Browser Prep, Prev: Reportmail Prep, Up: Initial Configuration - -Initializing BBDB support for Supercite -....................................... - -To allow the BBDB to assist in the storage of Supercite citations, add -the following form to your Emacs initialization file: - - `(bbdb-insinuate-sc)' - - `bbdb-insinuate-sc' adds BBDB functions to two Supercite hooks - -`sc-post-hook' and `sc-attribs-postselect-hook'. See *Note Using -Supercite:: for more details on the operation of Supercite citation -management using the BBDB. - - Three other Supercite variables must be set/modified to allow the -BBDB to work with it. These variables are not automatically set as it -would be impossible to reliably set them without interfering with other -user customizations. The modifications are: - -`sc-preferred-attribution-list' - `"sc-consult"' should be added to the list. An example - configuration is: - - (setq sc-preferred-attribution-list - '("sc-lastchoice" "x-attribution" "sc-consult" - "initials" "firstname" "lastname")) - -`sc-attrib-selection-list' - The following form should be added to `sc-attrib-selection-list': - - '(("sc-from-address" - ((".*" . (bbdb/sc-consult-attr - (sc-mail-field "sc-from-address")))))) - -`sc-mail-glom-frame' - The following form should be added to `sc-mail-glom-frame', to - allow the retrieval of the name of a person who is a) in the BBDB - and b) has only included their net address in the message in - question. - - ("^$" (progn (bbdb/sc-default) - (list 'abort '(step . 0)))) - - An example configuration is as follows: - - `(setq sc-mail-glom-frame' - ` '((begin (setq sc-mail-headers-start (point)))' - ` ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t)' - ` ("^\\S +:.*$" (sc-mail-fetch-field) nil t)' - ` ("^$" (progn (bbdb/sc-default)' - ` (list 'abort '(step . 0))))' - ` ("^[ \t]+" (sc-mail-append-field))' - ` (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))' - ` (end (setq sc-mail-headers-end (point)))))' - - - The above is also documented in `bbdb-sc.el'. The -`bbdb/sc-setup-variables' function has been provided as an example for -Supercite variable initialization. Please note that while -`bbdb/sc-setup-variables' makes every attempt to safely configure the -Supercite variables, it will not always work. Specifically, the -variables `sc-attrib-selection-list' and `sc-mail-glom-frame' will not -be overridden if they have already been defined. - - -File: bbdb.info, Node: Web Browser Prep, Prev: Supercite Prep, Up: Initial Configuration - -Initializing BBDB support for Web Browsers -.......................................... - -To allow URLs to be added to BBDB records, add the following form to -your Emacs initialization file: - - `(bbdb-insinuate-w3)' - - `bbdb-insinuate-w3' adds the definition of `:' to the W3 keymap. - - The other `bbdb-w3' functions, specifically the passing of URLs from -BBDB records to Web browsers, do not require initialization within the -BBDB. They do, however, require the configuration of the `browse-url' -package so it knows to which Web browser URLs are to be passed. For -more details on the operation of `bbdb-w3', see *Note Using Web -Browsers::. - - -File: bbdb.info, Node: The BBDB, Next: BBDB Mode, Prev: Installation, Up: Top - -The BBDB -======== - -This section discusses the basics of the BBDB - an overview of the -database's layout, and a discussion of the basic BBDB manipulation -commands. - - The database itself lives in a file which is named by the variable -`bbdb-file'. If this variable is not set, the database is assumed to -be in `~/.bbdb'. - -* Menu: - -* Database Fields:: Description of database fields -* Basic Searching:: Basic database searching commands -* Advanced Searching:: Advanced database searching commands -* Manual Record Addition:: Adding records by hand - - -File: bbdb.info, Node: Database Fields, Next: Basic Searching, Prev: The BBDB, Up: The BBDB - -Database Fields ---------------- - -The database is organized as a set of records, where each record -corresponds to one person or organization. Each record has several -fields, and each field is of one of several types. Below, the built-in -types are listed, followed by a description of how and why some types -can be used more than once in a single record: - -Type Description Notes -`name' The name of this person, or none if Single value, single - the record corresponds to an instance. - organization. -`company'The name of this person's Single value, single - organization, or none. instance. -`AKA' A list of other names for this Multiple values through - person. commas. -`net' A list of this person's network Multiple values through - addresses. commas. -`address'A list of postal (physical) Multiple values through - addresses for this person. multiple occurences. -`phone' A list of telephone numbers for Multiple values through - this person. multiple occurences. -`notes' Random commentary. Multiple values through - multiple occurences. - - The field types listed above can be classified into four categories, -as indicated by the comments in the `Notes' column. - - Field types marked as "Single value, single occurrence" may only -occur once per record. Each occurrence can only have a single value. -For example, there will be only one field of type `name' in a record. -It will be named `name', and will contain a single value (the person's -name). - - The types marked as "Multiple values through commas" are essentially -the same as the single value, single occurrence field types, but with -one crucial difference: they can contain multiple values in the form of -a comma-separated list. So, for example, while a `name' field with a -value of "foo, bar" would be treated as if it contained the single value -"foo, bar", a `net' field with the same data would be thought of as -having two separate values - "foo" and "bar". As in the single -occurrence, single value field types, there will be only one occurrence -of each "Multiple values through commas" field type, and the occurrence -will have the same name as the type. - - The "Multiple values through multiple occurrences" field type is the -most flexible of the four listed here. There can be multiple -occurrences of each type. This type necessarily does not have the name -restriction imposed by the previous two types. For example, there can -be multiple fields of the `address' type, none of which have to be -named `address'. One could be named `home', and the other could be -named `work'. - - Special properties of the `notes' field type: All user-defined -fields that don't fit into the other predefined field types (`name', -`company', `AKA', `net', `address', and `phone') will be created as a -`notes'-type field. In addition, several of the user-defined field -names are "special". That is, the BBDB treats the values of these -"special" fields differently than it does other user-defined fields. -The "special" fields are: - -`attribution' - (Available only when the Supercite-specific BBDB functions have - been enabled) Used for the storage of Supercite attributions. For - initialization details, see *Note Supercite Prep::. For usage - details, see *Note Using Supercite::. The field used can be - changed by changing the value of `bbdb/sc-attribution-field'. - -`aka' - Used to store non-primary names associated with a given record. - -`face' - (XEmacs only) Used for the storage of image data. This data is to - be in the format output by `compface', and commonly found in - `X-Face:' headers in messages. If face support has been compiled - into XEmacs, the image contained in the `face' header will be - displayed when the record is viewed. - -`finger-host' - Address used in place of the listed net address for fingering the - entity indicated by the record. *Note BBDB Mode::. The field used - can be changed by changing the value of `bbdb-finger-host-field'. - -`gnus-score' - Gnus scoring adjustment for this person. For initialization - details, see *Note Gnus Prep::. For usage details, see *Note Gnus - Features::. The field used can be changed by changing the value of - `bbdb/gnus-score-field'. - -`mail-alias' - Value used instead of `name' for completion. *Note Mail Sending - Interfaces::. - -`mail-name' - (Available only when the Reportmail-specific BBDB functions have - been enabled) Used for the storage of non-default names to be - used in the reporting of new mail by Reportmail. For - initialization details, see *Note Reportmail Prep::. For usage - details, see *Note Using Reportmail::. - -`mark-char' - The field containing the character to be used for marking a given - poster in the Gnus Summary Buffer. For usage details, see *Note - Gnus Summary Buffer::. - -`tex-name' - The value of this field is used in place of the `name' field when - printing the database using `bbdb-print'. *Note bbdb-print::. - -`www' - This field contains the URL associated with the BBDB record. - Common uses are with `bbdb-snarf' (*note bbdb-snarf::) and the - BBDB/Web Browser functionality (for initialization details, see - *Note Web Browser Prep::. For usage details, see *Note Using Web - Browsers::). - - -File: bbdb.info, Node: Basic Searching, Next: Advanced Searching, Prev: Database Fields, Up: The BBDB - -Basic searching commands ------------------------- - -You can list the contents of the database with the command `M-x bbdb'. -You will be prompted for a regular expression, and all records which -match that regexp in the name, company, network address, or any notes -fields will be displayed. - - A narrower search may be made by using the commands `bbdb-name', -`bbdb-company,' `bbdb-net,' or `bbdb-notes'. These commands limit -their searches to the name, company, email address, and notes fields, -respectively. If these commands are given a prefix argument, the -listing displayed will be one line per entry; otherwise, the full -database entry will be shown on multiple lines. - - The functions described above are predefined to certain keys in the -`*BBDB*' buffer. *Note BBDB Mode::. for more details. - - The `bbdb-notes' command will prompt for the notes field to search -(`RET' for all). In this way you can limit your searches to the -contents of one particular user-defined notes field. (You can add -user-defined fields with the `bbdb-insert-new-field' command; *Note -BBDB Mode::.) - - -File: bbdb.info, Node: Advanced Searching, Next: Manual Record Addition, Prev: Basic Searching, Up: The BBDB - -Advanced searching commands ---------------------------- - -The following functions can be used to search for records based on -creation and/or modification dates. These functions will match records -that have `timestamp' and/or `creation-date' fields (as appropriate. -*Note Predefined Hooks::. for more information on these fields, which -are created by default. - -`bbdb-timestamp-older' - Display all records modified before a given date. If this - function is called interactively, it will prompt for a date. If - it is being called non-interactively, the date should be provided - as a string in `yyyy-mm-dd' format. - -`bbdb-timestamp-newer' - Display all records modified after a given date. If this function - is called interactively, it will prompt for a date. If it is - being called non-interactively, the date should be provided as a - string in `yyyy-mm-dd' format. - -`bbdb-creation-older' - Display all records created before a given date. If this function - is called interactively, it will prompt for a date. If it is - being called non-interactively, the date should be provided as a - string in `yyyy-mm-dd' format. - -`bbdb-creation-newer' - Display all records created after a given date. If this function - is called interactively, it will prompt for a date. If it is - being called non-interactively, the date should be provided as a - string in `yyyy-mm-dd' format. - -`bbdb-creation-no-change' - Display all records that have not been changed since creation. - - -File: bbdb.info, Node: Manual Record Addition, Prev: Advanced Searching, Up: The BBDB - -Manual record addition ----------------------- - -There are several ways to add new entries to the Insidious Big Brother -Database; the most straightforward is to use `M-x bbdb-create', which -will prompt you for all relevant information. However, the easiest way -is to allow them to be added automatically by one of the mail or -news-reading interfaces (*Note Interfaces::.). - - There is als `bbdb-snarf' (*Note bbdb-snarf::), which will attempt -to create a record from a text block. Note that this depends on -particular formatting and may not do exactly what you want. - - -File: bbdb.info, Node: BBDB Mode, Next: Interfaces, Prev: The BBDB, Up: Top - -BBDB Mode -========= - -Functions bound to keys in BBDB Mode ------------------------------------- - -When the `*BBDB*' buffer is active (either summoned by one of the -commands in the previous section [*Note The BBDB::.] or by your mail or -news program), a variety of commands become available for database -manipulation. Some of the commands listed below take numeric arguments. -These arguments can be generated by entering the number before pressing -the key(s) corresponding to the desired command. The output (if any) of -the listed commands will be displayed in the `*BBDB*' buffer, and can -be navigated through using the usual cursor motion commands. - -`e' - (`bbdb-edit-current-field') Edit the field on the current line. - If the cursor is in the middle of a multi-line field, such as an - address or comments section, then the entire field is edited, not - just the current line. - -`;' - (`bbdb-edit-notes') A shortcut for editing the NOTES field. - -`d, C-k' - (`bbdb-delete-current-field-or-record') Delete the field on the - current line. If the current line is the first line of a record, - the BBDB will, after prompting the user, delete the entire record - from the database. This may also be applied to multiple records - at once by `*'. - -`C-o' - (`bbdb-insert-new-field') Inserts a new field into the current - record. You are prompted (with completion) for the type of field - to insert (phone, address, notes, etc); if the string you type is - not a known field type, you will be asked whether to add a new - field with the entered name of type `notes'. - - If you are inserting a new phone-number field, you can control - whether it is a North American or European phone number by - providing a prefix argument. A prefix arg of `^U' means it's to - be a euronumber, and any other prefix arg means it's to be a a - structured North American number. If no prefix argument is - supplied, the style used is controlled by the variable - `bbdb-north-american-phone-numbers-p'. - -`C-x C-t' - (`bbdb-transpose-fields') This is like the `transpose-lines' - command, but it is for BBDB fields. If the cursor is on a field of - a BBDB record, that field and the previous field will be - transposed. - - With non-zero numeric argument ARG, the previous field is moved - past ARG fields. With argument 0, the field indicated by point is - interchanged with the one indicated by mark. - - Both fields must be in the same record, and must be of the same - basic type (that is, you can use this command to change the order - in which phone-number fields are listed, but you can't use it to - make an address appear before a phone number; the order of field - types is fixed.) - -`n, p' - (`bbdb-next-record', `bbdb-prev-record') Move to the next and - previous displayed record, respectively. - -`t' - (`bbdb-toggle-records-display-layout') Toggles the display layout - of a record. With a numeric argument of 0, the current record - will be made displayed in one line layout; with any other - argument, the current record will be shown in multi-line layout. - - If `*t' is used instead of simply `t', then the state of all - records will be changed instead of just the one at point. In this - case, a numeric argument of 0 means that all records will - unconditionally be made one-line layout; any other numeric - argument means that all of the records will unconditionally be - shown expanded; and no numeric argument means that the records are - made to be in the opposite state of the record under point. - -`T' - (`bbdb-display-record-completely') Show all the fields of the - current record. The display layout `full-multi-line' is used for - this. - -`o' - (`bbdb-omit-record') Removes the current record from the display, - but does not delete it from the database; it merely makes it seem - as if the most recent search had not matched this record. With a - numeric argument, omit the next N records. With a negative - argument, go backwards. - -`m' - (`bbdb-send-mail') Begin composing mail to the person represented - by the current record. The first email address is used. - Normally, the mail-sending package which is used is determined by - which mail-reading package is loaded; that is, if MH-E is loaded, - then `mh-send' will be used; if VM is loaded, then `vm-mail' is - used; if message is loaded, then it is used; otherwise, `mail' is - used. You can override this by setting the variable - `bbdb-send-mail-style' to one of the symbols `vm', `mh', - `message', or `mail'. - - If `*m' is used instead of simply `m', then mail will be sent to - all of the folks listed in the `*BBDB*' buffer instead of just the - person under point. - - This function does not at present use the facility provided by - `compose-mail' and `mail-user-agent'. In a future version of the - BBDB, it will. - -`s, C-x C-s' - (`bbdb-save-db') Saves the BBDB file to disk. - -`r' - (`bbdb-refile-record') Merge the current record into some other - record; that is, delete the record under point after copying all - of the data within it into some other record. this is useful if - you realize that somehow a redundant record has gotten into the - database, and you want to merge it with another. - - If both records have names and/or companies, you are asked which - to use. Phone numbers, addresses, and network addresses are - simply concatenated. The first record is the record under the - point; the second is prompted for. Completion behavior is as - dictated by the variable `bbdb-completion-type'. - -`M-d' - (`bbdb-dial') This command will attempt to dial the phone number - currently at point, or if point is at the start of a record, the - first phone number in the record. An extension, if present, is - disregarded. - - The method of dialling is controlled by `bbdb-modem-dial'. If this - variable is nil, the BBDB will play touchtones corresponding to the - number to be dialled. Otherwise, this variable is treated as a - modem command string to be prepended to the number prior to - feeding it to `bbdb-modem-device'. - - The BBDB plays touchtones using `bbdb-sound-player' to play the - sounds and the elements of `bbdb-sound-files' as the audio to be - played. The first ten elements of `bbdb-sound-files' correspond to - the touchtones for the digits `0' to `9', while the eleventh and - twelfth elements correspond to `#' and `*' respectively. The - default configuration assumes a Solaris[tm] installation with the - demonstration sound files in `/usr/demo/SOUND/sounds'. - - The actual number dialled depends on the following variables: - - `bbdb-dial-local-prefix-alist' - This is a list of (SEXPR REPLACEMENT) pairs. SEXPR is - evaluated to produce a regular expression which is then - applied to the number. If it matches, whatever it matches is - replaced by REPLACEMENT. The match and replace is performed - using each item in the list that matches, in sequence, so - that the output from one item may become input to another. - The default value for this variable is to remove - `(bbdb-default-area-code)' (i.e. the value of that variable, - in parenthesis) from the start of the number to be dialled. - - Note: If this procedure produces a transformed number then no - further modifications (such as prefix additions, below) will - be made to the number before dialling. - - Using a prefix argument to `bbdb-dial' disables the - processing of this variable. The other modifiers, below, are - not affected by this. - - `bbdb-dial-local-prefix' - If the number to be dialled starts with a zero, it is deemed - to be a local number, and `bbdb-dial-local-prefix' is - prepended to it (see note above concerning - `bbdb-dial-local-prefix-alist' processing, however). - - `bbdb-dial-long-distance-prefix' - If the number to be dialled starts with a plus sign (+), it - is deemed to be a long distance number, and - `bbdb-dial-long-distance-prefix' is prepended to it (see note - above concerning `bbdb-dial-local-prefix-alist' processing, - however). - - -`f' - (`bbdb-finger') This command fingers the network address of a - BBDB record. If this command is executed from the `*BBDB*' buffer, - it fingers the network address of the record which is at point; - otherwise, it prompts in the minibuffer (with completion) for a - user to finger. With a numeric prefix argument, it fingers the - Nth network address of the current record; with a prefix argument - of `^U', it fingers all of them. The `*finger*' buffer is filled - asynchronously, meaning that you don't have to wait around for it - to finish; but fingering another user before the first finger has - finished could have unpredictable results. - - If this command is executed from the `*BBDB*' buffer, it may be - prefixed with `*' (as in `*f' instead of simply `f'), meaning to - finger all of the users currently listed instead of just the one - under point. The numeric prefix argument has the same - interpretation. - - You can define a special network address to "finger" by defining a - field `finger-host'. The name of the field to be fingered can be - changed by setting `bbdb-finger-host-field'. - -`q' - (`bbdb-bury-buffer') Hides the `*BBDB*' buffer. Note: This - command does not kill the `*BBDB*' buffer. - -`?' - (`bbdb-help') This displays a one-line help message in the - minibuffer, showing some of the most common bbdb-mode commands. - -`i' - (`bbdb-info') This documentation is displayed. Please note that - either `bbdb' or `bbdb.info' must be installed in one of the info - directories known to Emacs for this command to work. - - `bbdb-info-file' - If this documentation is not installed in the standard Info - directory, then you should set this variable to the name of - the texinfo-formatted version of this file; the `bbdb-info' - command will use this file instead. - -`W' - (`bbdb-www') Displays the Web page listed in the `www' field of - the current record. *Note Using Web Browsers::. - -`P' - (`bbdb-print') Creates a TeX file that contains a pretty-printed - version of BBDB records. If prefixed by `*', only the records - currently displayed will print. *Note bbdb-print::. - -`h' - Moves point to another window via the `other-window' function. - -`c' - (`bbdb-create') Create a new database record from information - supplied by the user. - -`C' - (`bbdb-changed') Display all records that have been changed since - the last time the database was saved. - -`b' - (`bbdb') Begin a new database search. The results of the new - search will be displayed in place of the results of the old search. - -`S a, S c, S o, S n' - (`bbdb-net', `bbdb-company', `bbdb-notes', `bbdb-name') - Begin a new database search. This search will be limited to the - net address, company, notes, or name fields, respectively, of - database records. *Note Basic Searching::. for more details. - -`*' - `bbdb-append-records' will make the next display/search command to - append its results to the BBDB buffer instead of replacing its - content. - - With an prefix arg (C-u) toggle between always append and no - append. With an prefix arg that is a positive number append will - be enabled for that many times. With any other argument append - will be enabled once." - - -Other database manipulation functions -------------------------------------- - -`bbdb-kill-older' - If called interactively (or with a single argument - a date in - `yyyy-mm-dd' format), it will kill all records that were last - modified before the given date as determined by the `timestamp' - field. *Note Predefined Hooks::. If called non-interactively - with a date (in `yyyy-mm-dd' format), a comparison function and an - action function, the comparison function is applied to the - `timestamp' field of all records, and the action function applied - to those for whom the comparison function returns true. If `nil' - is supplied as the comparison function, `string-lessp' is used. - - - -File: bbdb.info, Node: Interfaces, Next: Reader-specific Features, Prev: BBDB Mode, Up: Top - -Interfaces -========== - -The BBDB interfaces itself with several message-handling packages, but -certain parameters control its behavior depending on whether it is -being used from within a mail reader or a news reader. - - In all of these packages, two new keybindings will be added: - -`:' - (`bbdb/package-show-sender') Displays the BBDB entry corresponding - to the author of the current message. If there is none, you will - be asked whether to create one. The function called is - `bbdb/package-show-sender', where `package' is either `gnus', - `mh', `rmail', or `vm', depending on the mail or news program - being used when the command is invoked. - -`;' - (`bbdb/package-annotate-sender') Lets you edit the `notes' field - of the BBDB record corresponding to the sender of the current - message. If there is no record for the current author, you will be - asked whether to create one. The function called is - `bbdb/package-annotate-sender', where `package' is either `gnus', - `mh', `rmail', or `vm', depending on the mail or news program - being used when the command is invoked. - - These keybindings (and several other features) will not be available -unless you call the appropriate "insinuation" function; *Note -Installation::. - - It is possible to configure BBDB so that it automatically creates a -record when it sees a message from a person who is not in the database. -It is also possible to have text automatically added to the notes field -of the corresponding record depending on the contents of the message -headers. *Note Customization Hooks::. - -* Menu: - -* Mail Reading Interfaces:: Mail Reading Interfaces -* News Reading Interfaces:: News Reading Interfaces -* Mail Sending Interfaces:: Mail Sending Interfaces - - -File: bbdb.info, Node: Mail Reading Interfaces, Next: News Reading Interfaces, Prev: Interfaces, Up: Interfaces - -Mail Reading Interfaces ------------------------ - -There are BBDB interfaces for the following mail readers: - - * Gnus, a news- and email- reader written by Lars Magne Ingebrigtsen - (based on GNUS by Mansanobu Umeda). - - * MH-E, the Emacs interface to Mail Handler (MH), from the standard - emacs library, but packaged separately from XEmacs since version - 20.4. - - * RMAIL, from the standard emacs library (packaged separately for - XEmacs users as of 20.4); - - * View Mail, by Kyle Jones, version 5.31 or newer; - - -File: bbdb.info, Node: News Reading Interfaces, Next: Mail Sending Interfaces, Prev: Mail Reading Interfaces, Up: Interfaces - -News Reading Interfaces ------------------------ - -There are BBDB interfaces for the following news readers: - - * GNUS, a newsreader written by Masanobu Umeda. - - * Gnus, the modern news- and email-reading incarnation of GNUS. - Gnus is written by Lars Magne Ingebrigtsen. - - -File: bbdb.info, Node: Mail Sending Interfaces, Prev: News Reading Interfaces, Up: Interfaces - -Mail Sending Interfaces ------------------------ - -When sending mail, the keystroke `M-TAB' is bound to the function -`bbdb-complete-name'. This will take the string that you have typed -(from point back to the preceding colon, comma, or the beginning of the -line) and will complete that against the contents of the database. -What you have typed may be an initial subsequence of a person's full -name or network address; if it completes ambiguously, then what you -have typed will be replaced with the common portion of the matches. -Typing `M-TAB' again will show a list of possible completions. If it -completes unambiguously, then an address will be inserted. The variable -`bbdb-completion-type' controls whether completion is done on real -names, or network addresses, or both. The address inserted is normally -of the form `User Name '; however, if `User Name' has an -address of the form `', only the -`' portion is inserted. This can be overridden by setting -`bbdb-dwim-net-address-allow-redundancy' to `t'. - - This binding is automatically set by the various insinuation -functions documented earlier in this manual. (*Note Initial -Configuration::.) Briefly, the forms for these functions are: - -Gnus - `(add-hook 'gnus-Startup-hook 'bbdb-insinuate-gnus)' for Gnus 3.14 - or older - `(add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)' for Gnus 3.15 - or newer - -MH-E - `(add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)' - -RMAIL - `(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)' - -sendmail - `(add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)' - -VM - `(bbdb-insinuate-vm)' Add to `~/.vm' file - -The above forms should be added to your Emacs initialization file, -except where otherwise noted. - - You can control what "real name" is inserted with the `mail-alias' -field: if a record has a `mail-alias' field, then that is used instead -of their `name' field. - - If the variable `bbdb-completion-display-record' is true (the -default) then when you successfully complete an address with `M-TAB', -the corresponding record will be appended to the `*BBDB*' buffer. The -buffer will not be displayed if it is not already visible, but the -record will be displayed there. - - When sending mail, you can use the command `bbdb-yank-addresses' to -CC the current message to the people currently displayed in the -`*BBDB*' buffer. This is useful if you are in the midst of sending or -replying to a message, and you decide to add some recipients. You can -use one of the `M-x bbdb' commands to display the set of people that -you want to CC the message to, and then execute this command to add -them to the list. - -Mailing Lists and Mail Aliases ------------------------------- - -If you are using Jamie Zawinski's `mail-abbrevs.el' package, which uses -the word-abbrev mechanism for mail aliases, then you can store your -mail aliases in the BBDB instead of duplicating the information -elsewhere. - - If you want a mail alias to be defined for a person, simply add a -`mail-alias' field to their record. You may have multiple aliases for -the same person; simply separate them with commas. - - For convenience there is the function `bbdb-add-or-remove-mail-alias' -bound to `a' which adds an alias to one or multiple records when -prefixed by a `*'. Called with a prefix argument `C-u' it will remove -the given alias. - - If more than one person has the same mail-alias, then that alias -expands to the addresses of all of those people; in this way you can -maintain mailing lists within the BBDB. - - When you want to group aliases as in `.mailrc' you may just retained -the group aliases in your `.mailrc'. - - To actually define the aliases which are stored in the BBDB, call the -function `bbdb-define-all-aliases' from your `mail-setup-hook' (or -`message-setup-hook' if you use Message mode coming with Gnus). This -will search the database, and call `define-mail-alias' to define each -of the resulting aliases. - - -File: bbdb.info, Node: Reader-specific Features, Next: Other Packages, Prev: Interfaces, Up: Top - -Reader-specific Features -======================== - -There are features of the BBDB that are available only for specific -mail- and news-readers. These features are described below. - - The headers which are parsed for email addresses and what records are -displayed can be controlled by the following variables: -`bbdb-get-addresses-from-headers' controls which headers are parsed for -sender addresses when calling the show-sender function of your MUA. -`bbdb-get-addresses-to-headers' controls which headers are parsed for -recipients addresses when calling the show-all-recipients function of -your MUA. When using the pop up feature it will search for the -addresses in `bbdb-get-addresses-headers' and display them. By default -it will list only the first address, but by setting -`bbdb-get-only-first-address-p' to `nil' one will will get records for -all addresses. - - If there is no MUA specific variable for ignoring certain addresses -then those addresses matching `bbdb-user-mail-names' will be ignored. - - BBDB adds the bindings `:' for showing all senders and `;' for -editing the notes of the sender. - -* Menu: - -* Gnus Features:: Gnus-specific Features -* VM Features:: VM-specific Features - - -File: bbdb.info, Node: Gnus Features, Next: VM Features, Prev: Reader-specific Features, Up: Reader-specific Features - -Gnus-specific Features ----------------------- - -The BBDB can be used to provide score information, or to integrate -database information into the Gnus Summary buffer or the GNUS Subject -List. - -* Menu: - -* Gnus Scoring:: Store score adjustments in the BBDB -* Gnus Summary Buffer:: BBDB information in the Summary buffer -* GNUS Subject List:: BBDB information in the Subject List - - -File: bbdb.info, Node: Gnus Scoring, Next: Gnus Summary Buffer, Prev: Gnus Features, Up: Gnus Features - -Scoring -....... - -The BBDB can provide scoring information to Gnus in one of two ways. - - 1. Articles whose authors appear in the BBDB and who have - `gnus-score' fields will have their scores adjusted by the value - contained in that field. - - 2. Articles whose authors appear in the BBDB but who do not have - `gnus-score' fields will have their scores adjusted by - `bbdb/gnus-score-default'. If `bbdb/gnus-score-default' is `nil', - no score adjustment will be made. - - The BBDB by default searches the field contained in -`bbdb/gnus-score-field' for score values. To have the BBDB use a -different field, change the value of this variable. - - To enable BBDB-assisted scoring, add the `bbdb/gnus-score' function -to `gnus-score-find-score-files-function'. Assuming that you want to -preserve the default value of this variable, use a form similar to the -following: - - (setq gnus-score-find-score-files-function - '(gnus-score-find-bnews bbdb/gnus-score)) - - Note: The default value in Gnus 5.5 is `gnus-score-find-bnews'. -Check your configuration before using the above code, as your values may -be different. - - -File: bbdb.info, Node: Gnus Summary Buffer, Next: GNUS Subject List, Prev: Gnus Scoring, Up: Gnus Features - -Gnus Summary Buffer Enhancements -................................ - -Gnus can use the BBDB to do one of two things: - - * Mark authors in the Summary Buffer who have records in the BBDB - with a user-defined mark character. See Marking Posters, below. - - * For authors in the Summary Buffer who also have records in the - BBDB, replace their name as listed in the Summary Buffer with - their name as stored in the BBDB. See Using Names from the BBDB, - below. - -Marking Posters -............... - -Authors with records in the BBDB can be marked either with a -user-defined mark character, or with a default one. The marking is -enabled by the use of a Gnus user format code, as determined by -`bbdb/gnus-summary-in-bbdb-format-letter'. This variable, which -defaults to `b', is used to create a format code which is intended for -use in `gnus-summary-line-format'. The format code is created by -concatenating `%u' with the value of -`bbdb/gnus-summary-in-bbdb-format-letter'. In the default case this -results in the creation of the format code `%ub'. - - Posts are marked as follows: If the record for the poster has the -field indicated in `bbdb-message-marker-field' (the default is -`mark-char'), the value of that field is used as the mark character.(1) -If no such field is present, the value of -`bbdb/gnus-summary-known-poster-mark' will be used instead. If the -author is not in the BBDB, a space will be used as the mark character. - -Using Names from the BBDB -......................... - -The names reported for authors of posts in the Summary buffer can be -altered to conform to the values present in their respective BBDB -records (if any). This rewriting is enabled by the use of a Gnus user -format code, as determined by `bbdb/gnus-summary-user-format-letter'. -This variable, which defaults to `B', is used to create a format code -which is intended for use in `gnus-summary-line-format'. The format -code is created by concatenating `%u' with the value of -`bbdb/gnus-summary-user-format-letter'. In the default case this -results in the creation of the format code `%uB'. This format code is -intended to replace the format code previously used in the Summary -buffer format line to indicate the author and/or net address (usually -`%a', `%n', and/or `$N'). - - The effects of this format code are in two independent parts - the -marking of known posters, and the rewriting of posters names. The -first, the marking of posters, occurs only when -`bbdb/gnus-summary-mark-known-posters' is `t' (the default) and the -posters have entries in the BBDB. When this variable is true, the -marking occurs as described in the previous section, Marking Posters, -above. - - The poster name rewriting is done for all posters - not just for -those with records in the BBDB. That said, rewriting rules for posters -in the BBDB are more flexible than for those not listed. The rewriting -is governed by two variables, as described below. - - `bbdb/gnus-summary-prefer-real-names' can have one of three values - -`t', `bbdb', or `nil'. In general, this variable governs the -preference between net addresses and names. If it is `t', the name (if -any) will be used. If `nil', the net address will be used. The third -value, `bbdb', can be used as a method for distinguishing between -authors with records in the BBDB and those without. If the variable is -set to `bbdb', the name from the BBDB record will be used if the author -has a record in the BBDB. If the author is not in the BBDB, the net -address from the message will be printed. This variable makes little -sense if `bbdb/gnus-summary-prefer-bbdb-data' is `nil', as no names -will be printed in the Summary buffer in this case - only net addresses. - - `bbdb/gnus-summary-prefer-bbdb-data' is used to (dis)allow use of -the BBDB for author data retrieval. If it is `t', data from the BBDB -will be used if available. If it is `nil', data from the BBDB will not -be used. - -In the following examples, assume the following: - - 1. Message: `From: Jamie ' - BBDB: No record - - 2. Message: `From: Matt ' - BBDB: Name: `Matthew', Net: `simmonmt@purdue.edu' - -`bbdb/gnus-summary-prefer-bbdb-data' `t' `t' `nil' -`bbdb/gnus-summary-prefer-real-names' `t' `bbdb' `t' -Printed in Summary buffer for - Case 1 Jamie jwz@netscape.com Jamie - Case 2 Matthew Matthew Matt - - ---------- Footnotes ---------- - - (1) While it is possible to put a multi-character mark in -`bbdb-message-marker-field' and/or in -`bbdb/gnus-summary-known-poster-mark', the resulting summary buffer -will be misaligned as a result. This misalignment will result from fact -that at this time the character used to indicate posts whose authors are -not in the BBDB is always a single character, and cannot be changed. - - -File: bbdb.info, Node: GNUS Subject List, Prev: Gnus Summary Buffer, Up: Gnus Features - -GNUS Summary Buffer Enhancements -................................ - -This section is remarkably terse, as I don't have a copy of GNUS. If -anybody can provide more descriptive information, please let me know. - - (autoload 'bbdb/gnus-lines-and-from "bbdb-gnus") - (setq gnus-optional-headers 'bbdb/gnus-lines-and-from) - -`bbdb/gnus-mark-known-posters' - If `t' (the default), then the GNUS subject list will contain an - indication of those messages posted by people who have entries in - the Insidious Big Brother Database (they will be marked with an - asterisk.) - - You can change the character used to mark records on a - record-by-record basis by adding a `mark-char' property to the - record, whose value is be the string to display (preferably one - character.) - -`bbdb/gnus-header-prefer-real-names' - Default: `nil'. if `t', then the GNUS subject list will display - real names instead of network addresses. - -`bbdb/gnus-header-show-bbdb-names' - Default: `t'. If both this variable and the - `bbdb/gnus-header-prefer-real-names' variable are true, then for - news messages from people who are in your database, the name - displayed will be the primary name from the database, rather than - the one from the `From:' line of the message. This doesn't affect - the names of people who aren't in the database, of course. - -`bbdb/gnus-lines-and-from-length' - Default: 18. The number of characters used to display `From:' - info in GNUS, if you have set `gnus-optional-headers' to - `bbdb/gnus-lines-and-from'. - - -File: bbdb.info, Node: VM Features, Prev: Gnus Features, Up: Reader-specific Features - -VM-specific features --------------------- - -The BBDB can be used to integrate database information into the message -summary. - -* Menu: - -* VM Message Summary:: BBDB information in message summary -* VM what records are displayed:: -* VM automatic setup of vm-set-auto-folder-alist:: -* VM automatic adding of labels:: - - -File: bbdb.info, Node: VM Message Summary, Next: VM what records are displayed, Prev: VM Features, Up: VM Features - -VM Message Summary Enhancements -............................... - -VM users can cause their summary buffer to display the name of the -message sender according to BBDB data, instead of according to the -contents of the current message's headers. In VM 5.40 or later, use -the summary format control `%UB"' instead of `"%F"', and the current -record name will be shown there if available. If no entry is found it -behaves like `"%F"'. See the documentation for `vm-summary-format' for -more details. Warning, this may significantly slow down summary -generation for large folders. - - -File: bbdb.info, Node: VM what records are displayed, Next: VM automatic setup of vm-set-auto-folder-alist, Prev: VM Message Summary, Up: VM Features - -VM configuration of what records the BBDB buffer shows -...................................................... - -Email addresses which match `vm-summary-uninteresting-senders' are -ignored. - - The records in the BBDB buffer are listed in the same order as found. - - -File: bbdb.info, Node: VM automatic setup of vm-set-auto-folder-alist, Next: VM automatic adding of labels, Prev: VM what records are displayed, Up: VM Features - -VM automatic setup of `vm-set-auto-folder-alist' -................................................ - -VM users can setup the `vm-set-auto-folder-alist' automatically by -calling `bbdb/vm-set-auto-folder-alist'. This adds for each BBDB -record containing a `bbdb/vm-set-auto-folder-alist-field' an entry to -`vm-set-auto-folder-alist'. - - The record field can contain a string which is used as folder name or -if it starts with a `'' it is treated as lisp expression returning a -folder name. - - -File: bbdb.info, Node: VM automatic adding of labels, Prev: VM automatic setup of vm-set-auto-folder-alist, Up: VM Features - -VM automatic adding of labels -............................. - -`bbdb/vm-auto-add-label-list' is a List used by -`bbdb/vm-auto-add-label' to automatically label messages. Each element -in the list is either a string or a list of two strings. If a single -string then it is used as both the field value to check for and the -label to apply to the message. If a list of two strings, the first is -the field value to search for and the second is the label to apply. - - `bbdb/vm-auto-add-label-field bbdb-define-all-aliases-field' is the -field used by `bbdb/vm-auto-add-label' to automatically label messages. -Value is either a single symbol or a list of symbols of bbdb fields that -`bbdb/vm-auto-add-label' uses to check for labels to apply to messages. -Defaults to `bbdb-define-all-aliases-field' which is typically -`mail-alias'. - - `bbdb/vm-auto-add-label' automatically adds labels to messages based -on the `bbdb/vm-auto-add-label-field bbdb-define-all-aliases-field' -field. Add this to `bbdb-notice-hook' and if using VM each message -that bbdb notices will be checked. If the sender has a value in the -`bbdb/vm-auto-add-label-field' in their BBDB record that matches a -value in `bbdb/vm-auto-add-label-list' then a VM label will be added to -the message. - - This works great when `bbdb-user-mail-names' is set. As a result -mail that you send to people (and copy yourself on) is labeled as well. - - -File: bbdb.info, Node: Other Packages, Next: Options, Prev: Reader-specific Features, Up: Top - -Using the BBDB with other packages -================================== - -The BBDB adds functionality to several packages. The following sections -detail these augmentations. - -* Menu: - -* Using Message Mode:: Using the BBDB with Message Mode -* Using Reportmail:: Using the BBDB with Reportmail -* Using Supercite:: Using the BBDB with Supercite -* Using Web Browsers:: Using the BBDB with Web Browsers - - -File: bbdb.info, Node: Using Message Mode, Next: Using Reportmail, Prev: Other Packages, Up: Other Packages - -Using the BBDB with Message Mode --------------------------------- - -At this time, the only feature the BBDB adds to Message mode is the -binding to `M-TAB' which allows for BBDB record completion. - - -File: bbdb.info, Node: Using Reportmail, Next: Using Supercite, Prev: Using Message Mode, Up: Other Packages - -Using the BBDB with Reportmail ------------------------------- - -The BBDB can modify the `reportmail.el' package to use information from -BBDB records when identifying the senders or recipients of e-mail -messages. - - In normal operation, Reportmail displays the name and net address -sender and recipient of incoming messages. The BBDB can be configured -to intercept and rewrite this information before it appears in the -Emacs mode-line. It first attempts to rewrite the sender and/or -recipient information by substituting those addresses with information -from the BBDB. Replacement information is first sought from the -`mail-name' field in the respective BBDB records. If no such field is -found, the `name' field is returned. If no BBDB record is found, no -rewriting is performed. - - The BBDB-Reportmail augmentation is accomplished through the -advising of the Reportmail `display-time-get-field' function in order -to do a-posteriori modification of the returned value. The -augmentation uses the `bbdb/reportmail-alternate-full-name' function to -retrieve data from the BBDB for use in rewriting. - - -File: bbdb.info, Node: Using Supercite, Next: Using Web Browsers, Prev: Using Reportmail, Up: Other Packages - -Using the BBDB with Supercite ------------------------------ - -The BBDB can be used with Supercite to store attributions with BBDB -records. Normally, when a non-default attribution is entered for a -given message, the entered attribution is used for that message, and is -then discarded. When the BBDB-Supercite augmentation is enabled, the -non-default attribution will be added to the record (if any) for the -entity being cited. This poor explanation sounds complicated, but it's -not. If a message from `Jamie Zawinski ' is being -replied to, Supercite will, by default, suggest the citation `Jamie'. -If the non-default citation `jwz' is entered, Supercite can save it -with the BBDB record for `Jamie Zawinski' in the `attribution' field. - - The field used can be changed by changing the value of -`bbdb/sc-attribution-field'. - - -File: bbdb.info, Node: Using Web Browsers, Prev: Using Supercite, Up: Other Packages - -Using the BBDB with Web Browsers --------------------------------- - -The BBDB/Web Browser integration is in two parts, one which is -automatically enabled, and one which must be manually enabled (*note -Web Browser Prep::). The first feature added is the ability to display -the URL associated with a given record in a Web Browser. The second is -the ability to add URLs to BBDB records from within W3, the Emacs Web -Browser. - - Pressing `W' in the `*BBDB*' buffer while the cursor is positioned -over a record with a `www' field will cause the first URL in the field -to be loaded in a Web Browser. This functionality uses `browse-url' to -display URLs - see the documentation for `browse-url' for information on -selecting the browser to be used. - - If W3 is used, and if the BBDB/W3 functionality has been enabled as -described in *Note Web Browser Prep::, pressing the `:' key will add -the URL currently being displayed in W3 to a user-specified BBDB record. - - -File: bbdb.info, Node: Options, Next: Utilities, Prev: Other Packages, Up: Top - -Options -======= - -There are many variables which control the behavior of the Insidious Big -Brother Database, and there are many hook-variables which can be used to -modify its behavior in more complex ways. Several pieces of -functionality are included which use the hooks in this way. - -* Menu: - -* Customization Parameters:: Customization Parameters -* Customization Hooks:: Customization Hooks -* Predefined Hooks:: Predefined Hooks - - -File: bbdb.info, Node: Customization Parameters, Next: Customization Hooks, Prev: Options, Up: Options - -Customization Parameters ------------------------- - -`bbdb-file' - The name of the file which contains your personal database. - Default: `~/.bbdb'. - -`bbdb-default-area-code' - The default area code to use when prompting for a new phone number. - Default: 415. This must be a number, not a string. - -`bbdb-north-american-phone-numbers-p' - Whether syntax-checking of phone numbers should be enforced. - Default: `t'. This only works for Bell-system phone numbers. If - this is true, then you can't enter invalid phone numbers, and all - phone numbers are pretty-printed in the same way. European phone - numbers don't have as strict a syntax, however, so this is a - harder problem for them (on which I am punting). - - You can have both styles of phone number in your database by - providing a prefix argument to the `bbdb-insert-new-field' - command. - -`bbdb-check-zip-codes-p' - Whether syntax-checking of zip codes should be enforced. Default: - `t'. If this is true, you can't enter invalid zip codes. A zip - code is valid if it matches one of the regular expressions in the - variable `bbdb-legal-zip-codes'. - -`bbdb-address-formatting-alist' - Controls the display of addresses in the buffer. Each entry in - this list consists of an identifying function and a formatting - function. The identifying function must accept an address and - return `t' if the associated formatting function is to be used. - The formatting function must insert the formatted address in the - current buffer. Identifying functions usually base their decision - on the zip code format or on the country name. The default - entries will format an address using continental style if the zip - code matches `bbdb-continental-zip-regexp'. If the zip code does - not match, addresses are formatted in US style. - -`bbdb-continental-zip-regexp' - Decides whether an address should be formatted using US or European - style. If the zip code of an address matches the regular - expression, the European style is used. This works only if the - expression `(bbdb-address-is-continental . - bbdb-format-address-continental)' is part of - `bbdb-address-formatting-alist'. - -`bbdb-electric-p' - Whether bbdb mode should be "electric" like `electric-buffer-list'. - Default: `t'. What this means is that the BBDB buffer which pops - up when you use it can be disposed of by pressing the space bar, at - which point your window configuration will be restored to what it - was before you invoked the db list. (The `bbdb-mode' commands - still work as well.) - - There are some problems with electric modes; for example, keyboard - macros and incremental search don't work. (This is not a bug in - BBDB, but in `electric.el'.) - -`bbdb-case-fold-search' - Default: the same as `case-fold-search'. `case-fold-search' is - bound to this by `M-x bbdb' and related commands. This variable - lets the case-sensitivity of `^S' and of the bbdb searching - commands be different. - -`bbdb/mail-auto-create-p' - If this is `t' (the default), then VM, MH, and RMAIL will - automatically create new bbdb records for people you receive mail - from. If this variable is a function name or lambda expression, - then it is called with no arguments to decide whether an entry - should be automatically created. You can use this to, for - example, not create records for messages which have reached you - through a particular mailing list, or to only create records - automatically if the mail has a particular subject. See the - variables `bbdb-ignore-most-messages-alist' and - `bbdb-ignore-some-messages-alist' (*Note Predefined Hooks::.) - -`bbdb/news-auto-create-p' - If this is `t' (default: `nil'), then GNUS will automatically - create new BBDB records for people you read messages by. If this - is a function name or lambda expression, then it is called with no - arguments to decide whether an entry should be automatically - created. You can use this to, for example, create or not create - messages which have a particular subject. See the variable - `bbdb-auto-notes-alist' (*Note Predefined Hooks::.). - - If you want to autocreate messages based on the current newsgroup, - it's probably a better idea to set this variable to `t' or `nil' - from your `gnus-select-group-hook' instead. - - To automatically remember users in certain groups, you can do - something like - (setq gnus-select-group-hook - '(lambda () - (setq bbdb/news-auto-create-p - (or (string= "some.news.group" gnus-newsgroup-name) - (string= "other.news.group" gnus-newsgroup-name))))) - - -`bbdb-quiet-about-name-mismatches' - If this is false (the default), then BBDB will prompt you when it - notices a name change, that is, when the "real name" in a message - doesn't correspond to a record already in the database with the - same network address. As in, "John Smith " versus - "John Q. Smith ". If this is true, then you will - not be asked if you want to change it (and it will not be changed.) - If a number then it is the number of seconds to sit-for while - displaying the name mismatch. - -`bbdb-use-alternate-names' - If this is false, then the BBDB will not use the AKA field. - Otherwise (the default) then the mail and news interfaces will ask - you if you want to add an alternate name when a name-change is - noticed, and will ask you whether the new name should be made the - primary one. Note that if `bbdb-quiet-about-name-mismatches' is - true, you will not be asked any questions about alternate names. - -`bbdb-readonly-p' - If this is true (default: `nil'), then nothing will attempt to - change the database implicitly, and you will be prevented from - doing it explicitly. If you have more than one emacs running at - the same time, you might want to arrange for this to be set to `t' - in all but one of them. - -`bbdb-auto-revert-p' - If this variable is true (default: `nil') and the BBDB file is - noticed to have changed on disk, it will be automatically reverted - without prompting you first. Otherwise you will be asked. (But - if the file has changed and you have made changes in memory as - well, you will always be asked.) - -`bbdb-notice-auto-save-file' - If this is true (default: `nil'), then the BBDB will notice when - its auto-save file is newer than the file is was read from, and - will offer to revert. - -`bbdb-use-pop-up' - If true (the default), display a continuously-updating BBDB window - while in VM, MH, RMAIL, or GNUS. Each time a new message is - selected, the record corresponding to that message's sender will - be displayed in another window. The buffer in this other window - will be in bbdb-mode, and all corresponding commands will be - available. - - This buffer will be positioned on the screen by finding the tallest - of the windows present, and splitting it such that the bottom - `bbdb-pop-up-target-lines' lines of the window display the - `*BBDB*' buffer. With the default configurations of VM, MH, - RMAIL, and GNUS, this means that the bbdb-list buffer will be just - below the message-body buffer. - - If this is the symbol `horiz', then the BBDB window will be - stacked horizontally instead of vertically, if there is room to do - that tastefully. - -`bbdb-pop-up-target-lines' - Desired number of lines in a VM/MH/RMAIL/GNUS pop-up BBDB window, - default 5. - -`bbdb-completion-type' - Controls the behavior of the `bbdb-complete-name' command. If - `nil' (the default), completion is done across the set of all - full-names and user-ids in the database; if the symbol `name', - completion is done on real-names only; if the symbol `net', - completion is done on network addresses only; if it is `primary', - then completion is done only across the set of primary network - addresses (the first address in the list of addresses for a given - user). If it is `primary-or-name', completion is done across - primaries and real names. - -`bbdb-expand-mail-aliases' - If non-nil, expand mail aliases in `bbdb-complete-name'. - -`bbdb-complete-name-allow-cycling' - Whether to allow cycling of email addresses when calling - `bbdb-complete-name' on a completed address in a composition - buffer." - -`bbdb-complete-name-full-completion' - Show full expanded completion rather than partial matches. If t - then do it always, if a number then just is the number of - completions for a specific match is below that number. - -`bbdb-user-mail-names' - A regular expression identifying the addresses that belong to you. - If a message from an address matching this is seen, the BBDB - record for the `To:' line will be shown instead of the one for the - `From:' line. If this is `nil', it will default to the value of - `(user-login-name)'. - -`bbdb-always-add-addresses' - If this is `t', then whenever the Insidious Big Brother Database - notices a new email address corresponding to a person who is in the - database, it will add it to the database. If this is `nil' (the - default), then whenever a new network address is noticed for a - person in the database, you will be asked whether to add the - address. If this is the symbol `never' (really if it is not `t' - and not `nil') then new network addresses will never be - automatically added. - -`bbdb-new-nets-always-primary' - If this is `t', then when the Insidious Big Brother Database adds - a new address to a record, it will always add it to the front of - the list of addresses, making it the primary address. If this is - `nil' (the default), then you will be asked. If this is the - symbol `never' (really if it is not `t' and not `nil') then new - network addresses will always be added to the end of the list. - -`bbdb-canonicalize-redundant-nets-p' - If this is non-`nil', redundant network addresses will be ignored. - If a record has an address of the form `foo@baz.com', setting this - to `t' will cause subsequently-noticed addresses like - `foo@bar.baz.com' to be ignored (since we already have a more - general form of that address.) This is similar in function to one - of the possible uses of the variable `bbdb-canonicalize-net-hook' - but is somewhat more automatic. (This can't quite be implemented - in terms of the canonicalize-net-hook because it needs access to - the database to determine whether an address is redundant, and the - canonicalize-net-hook is purely a textual manipulation which is - performed before any database access.) - -`bbdb-message-caching-enabled' - Whether caching of the message->bbdb-record association should be - used for the interfaces which support it (VM, MH, and RMAIL). - This can speed things up a lot. One implication of this variable - being true (the default) is that the `bbdb-notice-hook' will not - be called each time a message is selected, but only the first - time. Likewise, if selecting a message would generate a question - (whether to add an address, change the name, etc) you will only be - asked that question the very first time the message is selected. - -`bbdb-offer-save' - If `t' (the default), then certain actions will cause the BBDB to - ask you whether you wish to save the database. If `nil', then the - offer to save will never be made. If not `t' and not `nil', then - any time it would ask you, it will just save it without asking. - - - -File: bbdb.info, Node: Customization Hooks, Next: Predefined Hooks, Prev: Customization Parameters, Up: Options - -Customization Hooks -------------------- - -All of the hooks variables described below may be set to a symbol or -lambda expression, which will be funcalled; or may be set to a list of -symbols or lambda expressions, each of which will be funcalled in turn. -Almost all hooks in Emacs work this way. But notice that some of the -hooks described below are called with arguments. - -`bbdb-list-hook' - Hook or hooks invoked after the bbdb-list-buffer is filled in. - Invoked with no arguments. - -`bbdb-create-hook' - Hook or hooks invoked each time a new bbdb-record is created. - Invoked with one argument, the new record. This is called - _before_ the record is added to the database. Note that - `bbdb-change-hook' will be called as well. - -`bbdb-change-hook' - Hook or hooks invoked each time a bbdb-record is altered. Invoked - with one argument, the record. This is called _before_ the - database buffer is modified. Note that if a new bbdb record is - created, both this hook and `bbdb-create-hook' will be called. - -`bbdb-mode-hook' - Hook or hooks invoked when the `*BBDB*' buffer is created. - -`bbdb-notice-hook' - Hook or hooks invoked each time a bbdb-record is "noticed," that - is, each time it is displayed by the news or mail interfaces. - Invoked with one argument, the new record. The record need not - have been modified for this to be called - use `bbdb-change-hook' - for that. You can use this to, for example, add something to the - notes field based on the subject of the current message. It is up - to your hook to determine whether it is running in GNUS, VM, MH, - or RMAIL, and to act appropriately. - - Also note that `bbdb-change-hook' will _not_ be called as a result - of any modifications you may make to the record inside this hook. - - Beware that if the variable `bbdb-message-caching-enabled' is true - (a good idea) then when you are using VM, MH, or RMAIL, this hook - will be called only the first time that message is selected. (The - GNUS interface does not use caching.) When debugging the value of - this hook, it is a good idea to set caching-enabled to `nil'. - -`bbdb-after-read-db-hook' - Hook or hooks invoked (with no arguments) just after the Insidious - Big Brother Database is read in. Note that this can be called - more than once if the BBDB is reverted. One possible use for this - is to rename the `.bbdb' buffer; for example - - `(setq bbdb-after-read-db-hook '(lambda () (rename-buffer " - bbdb")))' - - will cause the buffer visiting the `bbdb-file' to be called - `" bbdb"'. The leading space in its name will prevent it from - showing up in the buffer list. - -`bbdb-load-hook' - Hook or hooks invoked (with no arguments) when the Insidious Big - Brother Database code is first loaded. WARNING: Slow functions - should not be put on this hook, as the BBDB code will, if not - loaded before, be loaded during the first use of BBDB-related - Customization functions. Slow functions should be put on - `bbdb-initialize-hook'. - -`bbdb-initialize-hook' - Hook or hooks invoked (with no arguments) when the - `bbdb-initialize' function is called. - -`bbdb-canonicalize-net-hook' - If this is non-`nil', it should be a function of one argument: a - network address string. (Note that, unlike the other - hook-variables described above, this may not be a list of - functions.) Whenever the Insidious Big Brother Database "notices" - a message, the corresponding network address will be passed to - this function first, as a kind of "filter" to do whatever - transformations upon it you like before it is compared against or - added to the database. For example: it is the case that - `CS.CMU.EDU' is a valid return address for all mail originating at - a machine in the `.CS.CMU.EDU' domain. So, if you wanted all such - addresses to be canonically hashed as `user@CS.CMU.EDU', instead - of as `user@somehost.CS.CMU.EDU', you might set this variable to a - function like this: - - (setq bbdb-canonicalize-net-hook - '(lambda (addr) - (cond ((string-match - "\\`\\([^@]+@\\).*\\.\\(CS\\.CMU\\.EDU\\)\\'" - addr) - (concat (substring addr - (match-beginning 1) (match-end 1)) - (substring addr - (match-beginning 2) (match-end 2)))) - (t addr)))) - - You could also use this function to rewrite UUCP-style addresses - into domain-style addresses, or any number of other things. - - This function will be called repeatedly until it returns a value - EQ to the value passed in. So multiple rewrite rules might apply - to a single address. - - There is an example of the use of this variable in the file - `bbdb-hooks.el': the function `sample-bbdb-canonicalize-net-hook'. - - The `bbdb-canonicalize-net-hook' is powerful in that it allows -arbitrary rewriting of addresses, however, in many cases that is -overkill. The function `bbdb-delete-redundant-nets' can be used as a -value of `bbdb-change-hook' to cause network addresses which appear to -be "redundant" to be deleted each time a modification is made to a -record. - - This works as follows: suppose one gets mail from `user@foo.bar.com', -and then later gets mail from `user@bar.com'. At this point, one can -generally delete the `user@foo.bar.com' address, since the -`user@bar.com' address is more general. (See also the variable -`bbdb-canonicalize-redundant-nets-p', which has the effect of ignoring -subsequent addresses from `user@quux.bar.com' if the address -`user@bar.com' is already known.) - - -File: bbdb.info, Node: Predefined Hooks, Prev: Customization Hooks, Up: Options - -Predefined Hooks ----------------- - -If the variable `bbdb-change-hook' is set to the symbol -`bbdb-timestamp-hook' (the default), then every record in the database -will have a field named `timestamp', which will always contain the date -and time at which this record was created or last modified. - - If the variable `bbdb-create-hook' is set to the symbol -`bbdb-creation-date-hook' (the default), then every record in the -database will have a field named `creation-date', which will contain -the date and time at which this record was added to the database. - - If the variable `bbdb/mail-auto-create-p' is set to the symbol -`bbdb-ignore-most-messages-hook', then the variable -`bbdb-ignore-most-messages-alist' will determine which messages should -have records automatically created for them. The format of this alist -is - (( HEADER-NAME . REGEXP ) ... ) - -for example, - (("From" . "@.*\\.maximegalon\\.edu") - ("Subject" . "time travel")) - -will cause BBDB entries to be made only for messages sent by people at -Maximegalon U., or (that's _or_) people posting about time travel. - - There may be only one entry per header in this alist: that is, - - (("From" . "addr1\\|addr2") ... ) - -is legal, but - - (("From" . "addr1") ("From" . "addr2") ... ) - -is not. - - If the variable `bbdb/mail-auto-create-p' is set to the symbol -`bbdb-ignore-some-messages-hook', then the variable -`bbdb-ignore-some-messages-alist' will determine which messages should -have records automatically created for them. This is the exact inverse -of the semantics of the `bbdb-ignore-most-messages-alist': the alist -specifies which messages should _not_ have records automatically -created for them, instead of which should. For example, - - (("From" . "mailer.daemon") - ("To" . "mailing-list-1\\|mailing-list-2") - ("CC" . "mailing-list-1\\|mailing-list-2")) - -will cause BBDB entries to not be made for messages from any mailer -daemon, or messages sent to or CCed to either of two mailing lists. - - The variable `bbdb/news-auto-create-p' may be set to either of the -above-mentioned functions as well, to get this behavior for netnews -messages instead of mail messages. - - If the variable `bbdb-notice-hook' is set to the symbol -`bbdb-auto-notes-hook', then the variable `bbdb-auto-notes-alist' may -be used to automatically add text to the notes fields of the records -corresponding to certain messages. The format of this alist is - - (( HEADER-NAME - (REGEXP . STRING) ... ) - ... ) - -for example, - - (("To" ("-vm@" . "VM mailing list")) - ("Subject" ("sprocket" . "mail about sprockets") - ("you bonehead" . "called me a bonehead"))) - -will cause the text `"VM mailing list"' to be added to the notes field -of the record corresponding to anyone you get mail from via one of the -VM mailing lists. If, that is, `bbdb/mail-auto-create-p' is set such -that the record would have been created, or if the record already -existed. - - The format of elements of this list may also be - - (REGEXP FIELD-NAME STRING) - -or - (REGEXP FIELD-NAME STRING REPLACE-P) - -meaning add the given string to the named field. The field-name may not -be `name', `aka', `address', `phone', or `net' (builtin fields) but -must be either `notes', `company', or the name of a user-defined -note-field. - - ("pattern" . "string to add") - -is equivalent to - - ("pattern" notes "string to add") - -STRING can contain `\&' or `\N' escapes like in the function -`replace-match'. For example, to automatically add the contents of the -organization field of a message to the `company' field of a BBDB -record, you can use this: - - ("Organization" (".*" company "\\&")) - -(Note you need two \ to get a single \ into a lisp string literal.) - - If STRING is an integer N, the Nth matching subexpression is used, -so the above example could be written more efficiently as - - ("Organization" (".*" company 0)) - - If STRING is neither a string or an integer, it should be a function -which is called with the contents of the field, and the result of the -function call is used. - - If the REPLACE-P flag is true, then the string replaces the old -contents instead of being appended to it. - - If multiple clauses match the message, all of the corresponding -strings will be added. - - If the string is being appended (REPLACE-P is false or not provided) -then the new string is appended to the end of the existing field value, -with an intervening newline. So each piece of text automatically added -to this field will go on its own line. - - You can control what the separator is by putting a `field-separator' -property on the symbol naming the field. For example, to make text -automatically added to a field named `newsgroups' be separated by -commas, you could do - - (put 'newsgroups 'field-separator "; ") - - This variable works for news as well. You might want to arrange for -this to have a different value when in mail as when in news. - - There may be only one entry per header in this alist: that is, - - (("Subject" ("\\bfoo\\b" . "Foo!!") - ("bar" . "Bar!"))) - -will work, but - - (("Subject" ("\\bfoo\\b" . "Foo!!")) - ("Subject" ("bar" . "Bar!"))) - -will not. - - Here's a more complicated example: some people include bitmaps of -themselves in their mail messages in an X-Face: header field. You can -capture this field into the `*BBDB*' with the following: - - (setq bbdb-auto-notes-alist - (append bbdb-auto-notes-alist - (list "x-face" - (list (concat "[ \t\n]*\\([^ \t\n]*\\)" - "\\([ \t\n]+\\([^ \t\n]+\\)\\)?" - "\\([ \t\n]+\\([^ \t\n]+\\)\\)?" - "\\([ \t\n]+\\([^ \t\n]+\\)\\)?" - ) - 'face - "\\1\\3\\5\\7")))) - -(The calls to `list' and `concat' are just for readability, it could -easily be a constant.) The tricky bit here is that it strips out the -newlines and whitespace used for header continuation, which are not -actually a part of the face data. So though the mail message may have -the face data on multiple lines, the entry in the `*BBDB*' will be just -one line. - - `bbdb-auto-notes-ignore' is an alist of headers and regexps to -ignore in `bbdb-auto-notes-hook'. Each element looks like - - (HEADER . REGEXP) - -for example, - - ("Organization" . "^Gatewayed from\\|^Source only") - -would exclude the phony `Organization:' headers in GNU mailing-lists -gatewayed to the `gnu.*' newsgroups. Note that this exclusion applies -only to a single field, not to the entire message. For that, use the -variable `bbdb-auto-notes-ignore-all'. - - `bbdb-auto-notes-ignore-all' is an alist of headers and regexps -which cause the entire message to be ignored in `bbdb-auto-notes-hook'. -Each element looks like - - (HEADER . REGEXP) - -for example, - - ("From" . "BLAT\\.COM") - -would exclude any notes recording for message coming from `BLAT.COM'. -Note that this is different from `bbdb-auto-notes-ignore', which -applies only to a particular header field, rather than the entire -message. - - -File: bbdb.info, Node: Utilities, Next: Internals, Prev: Options, Up: Top - -Utilities -========= - -This section describes BBDB functionality that does not fit neatly into -other sections. - -* Menu: - -* bbdb-ftp:: Storing FTP sites in the BBDB -* bbdb-print:: Print the BBDB -* bbdb-snarf:: Record generation from raw text -* bbdb-srv:: External control of the BBDB - - -File: bbdb.info, Node: bbdb-ftp, Next: bbdb-print, Up: Utilities - -`bbdb-ftp' ----------- - -The `bbdb-ftp' utility enables the storage of FTP sites as BBDB -records. The `bbdb-create-ftp-site' function is used to create a BBDB -record for an FTP site. The command will prompt for information needed -to create the record. The FTP site for a given record can be accessed -with the `bbdb-ftp' command. - - -File: bbdb.info, Node: bbdb-print, Next: bbdb-snarf, Prev: bbdb-ftp, Up: Utilities - -`bbdb-print' ------------- - -`bbdb-print' is a utility for pretty-printing entries from the BBDB -using TeX. It is invoked by pressing `P' in the `*BBDB*' buffer - this -will cause all records in the BBDB to be printed as governed by the -variables described below. If `P' is prefixed by a `*', only the -currently-displayed records will be printed. Once invoked, `bbdb-print' -will generate the TeX output in a buffer named `~/bbdb.tex' (controlled -by `bbdb-print-file-name'). The generated output will be shown, and -must be manually saved. - - For each record printed, `bbdb-print' will look for the presence of -the `tex-name' field. If this field is found, its value will be printed -instead of the `name' field for the record in question. This field is -intended to allow the storage of names with accents or other characters -that would be illegal in the address portion of a message. While other -fields have special characters quoted by `bbdb-print' as described -below, the contents of the `tex-name' field (if present) are used -verbatim. - - The following variables govern the printing of records (and of the -printing of the fields therein): - -`bbdb-print-omit-fields' - This variable should be set to a list of the fields that are not - to be printed by `bbdb-print'. It defaults to: - `(omit tex-name aka mail-alias)' - -`bbdb-print-file-name' - The name of the file where generated TeX output is to be stored. - The default is `~/bbdb.tex'. - -`bbdb-print-require' - The fields required for printing a record. This allows, for - example, only records with phone numbers to be printed. The value - of the value of the variable will be evaluated once for each - record, and the record will be printed only if the evaluation - returns a non-nil value. The symbols `name', `company', `net', - `phone', `address', and `notes' will be set to the appropriate - values during evaluation; they will be nil if the field does not - exist or is elided. - - The value of this variable can be any lisp expression, but - typically it will be used for a boolean combination of the field - variables, as in the following simple examples: - - * Print only people whose phone numbers are known: - `(setq bbdb-print-require 'phone)' - - * Print people whose names AND companies are known: - `(setq bbdb-print-require '(and name company))' - - * Print people whose names, and either addresses OR phone - numbers are known: - `(setq bbdb-print-require '(and name (or address phone))).' - The default value is: - `(or address phone)' - -`bbdb-print-alist' - Formatting options for all formats of `bbdb-print'. The value is - an alist of the form - `((OPTION . VALUE) (OPTION . VALUE) ...)' - Separate settings can be - configured using `bbdb-print-brief-alist' and - `bbdb-print-full-alist'. Settings in these variables will - override the ones in `bbdb-print-alist'. - - The possible options and legal settings are: - `columns' - `1', `2', `3', `4', `quad' (4 little 2-column pages per - sheet) or `grid' (12 credit-card-sized pages per sheet). - - `separator' - `0'-`7', the style of heading for each letter. `0'=none, - `1'=line, `2'=boxed letters, `3'=large boxed letters, - `4'=large letters, `5'=letters with lines, `6'=letters with - suits, `7'=boxed letters with suits. - - `omit-area-code' - A regular expression matching area codes to omit. - - `phone-on-first-line' - If `t', the first phone number will be put on the same line - as the name. If `nil', the name will be the only text on the - line. If set to a string, the field of type `phone' whose - name matches the string will be used. The string should be a - valid regular expression. - - `n-phones' - Maximum number of phone numbers to include. - - `n-addresses' - Maximum number of addresses to include. - - `include-files' - List of TeX files to `\input'. If the filenames are not - absolute, the files must be located somewhere in the TeX - input path. - - `ps-fonts' - Postscript fonts (TimesNewRoman and Courier) will be used if - the value is non-`nil'. Standard TeX fonts (ec-fonts) will - be used otherwise. - - `font-size' - The integer point size of the font to be used. - - `hsize' - The horizontal dimension of the pages. The value must be a - string, and must be a valid TeX dimension. Alternatively, - the TeX default will be used if the value is `nil'. - - `vsize' - The vertical dimension of the pages. The value must be a - string, and must be a valid TeX dimension. Alternatively, - the TeX default will be used if the value is `nil'. - - `hoffset' - The TeX output will be offset to the right by the value of - this option. The value must be either a string containing a - valid TeX dimension or `nil' or `0' to use the default TeX - horizontal offset. - - `voffset' - The TeX output will be offset downward by the value of this - option. The value must be either a string containing a valid - TeX dimension or `nil' or `0' to use the default TeX vertical - offset. - - `quad-hsize' - Horizontal size to be used for the individual pages in the - quad format. The value must be a string containing a valid - TeX dimension. - - `quad-vsize' - Vertical size to be used for the individual pages in the quad - format. The value must be a string containing a valid TeX - dimension. - - The default value is - ((omit-area-code . "(AREA-CODE)") - (phone-on-first-line . "^[ \t]*$") - (ps-fonts . nil) - (font-size . 6) - (quad-hsize . "3.15in") - (quad-vsize . "4.5in")) - - Where AREA-CODE is the value of `bbdb-default-area-code' or `000' - if there is no default area code. - -`bbdb-print-brief-alist' - Extra options for the `bbdb-print' brief format. The value(s) of - this variable can either supplement or override the values in - `bbdb-print-alist'. The format and possible values of this - variable are as in `bbdb-print-alist', described above. - - The default value is - ((columns . 1) - (separator . 1) - (n-phones . 2) - (n-addresses . 1) - (include-files "bbdb-print-brief" "bbdb-cols")) - -`bbdb-print-full-alist' - Extra options for the `bbdb-print' non-brief format. The value(s) - of this variable can either supplement or override the values in - `bbdb-print-alist'. The format and possible values of this - variable are as in `bbdb-print-alist', described above. - - The default value is - ((columns . 3) - (separator . 2) - (include-files "bbdb-print" "bbdb-cols")) - -`bbdb-print-prolog' - TeX statements to include at the beginning of the `bbdb-print' - output file. - -`bbdb-print-epilog' - TeX statements to include at the end of the `bbdb-print' output - file. - - - -File: bbdb.info, Node: bbdb-snarf, Next: bbdb-srv, Prev: bbdb-print, Up: Utilities - -`bbdb-snarf' ------------- - -`bbdb-snarf' provides the ability to generate BBDB records from raw -text. If invoked as `bbdb-snarf', it attempts to generate the record -from the information around point (the cursor). If invoked as -`bbdb-snarf-region'(1), the active region is used to generate the -record. - -Restrictions: - - 1. `bbdb-snarf' currently recognizes only US-style phone numbers. - - 2. `bbdb-snarf' works best with things that look like mailing - addresses. - -Example of an address that `bbdb-snarf' will recognize: - - another test person - 1234 Gridley St. - Los Angeles, CA 91342 - 555-1212 - test@person.net - http://www.foo.bar/ - other stuff about this person - - ---------- Footnotes ---------- - - (1) `bbdb-snarf' is actually a wrapper for `bbdb-snarf-region' that -determines the relevant region and passes it on. - - -File: bbdb.info, Node: bbdb-srv, Prev: bbdb-snarf, Up: Utilities - -`bbdb-srv' ----------- - -`bbdb-srv' provides the ability to initiate the display of BBDB records -from outside of Emacs. This allows external programs to cause the BBDB -record for a given person to appear in the running Emacs when, for -example, mail is recieved from that person. One specific application, -described below, is the integration of Netscape and the BBDB, allowing -the display of BBDB records corresponding to Mail and/or News messages -displayed in Netscape. - - `bbdb-srv' is composed of two parts - an external Perl script -(`utils/bbdb-srv.pl'), and an Emacs Lisp file (`lisp/bbdb-srv.el'). -The external portion is used to send commands to the internal portion. - - NOTE: `bbdb-srv' requires `gnuserv' and `itimer', both included with -XEmacs. `gnuserv' must be started with the `gnuserv-start' command -before `bbdb-srv' can be used. - - In it's most basic form, mail or news headers are passed to the Perl -script. The Perl script then causes the BBDB record (if any) -corresponding to the passed headers to be displayed in the running -Emacs. While `bbdb-srv' will operate with just a `From:' field, it -works better when passed both `From:' and `To:' headers. When -`bbdb-srv' notices that the logged-in user is named in the `From:' -header, it will attempt to display the record (if any) for the person -named in the `To:' header. If no `To:' header is passed, it falls back -on the record (if any) for the logged-in user (the person named in the -`From:' header). - - An example manual invocation of `bbdb-srv' is as follows: - - % cat |bbdb-srv.pl - From: Jamie Zawinski - To: Matt Simmons - - - If the invoking user is Jamie Zawinski, the record for Matt Simmons -(if any) will be displayed. If the invoking user is not Jamie -Zawinski, the record for Jamie Zawinski (if any) will be displayed. - - As mentioned above `bbdb-srv' can be used with Netscape Mail and -Netscape News. Please note that it can only be used with the UNIX -versions 3.0b2 and greater of these applications. To allow Netscape to -use `bbdb-srv', set the `NS_MSG_DISPLAY_HOOK' variable to -`bbdb-srv.pl'(1) as follows: - -Bourne Shell (`/bin/sh') and variants: - # NS_MSG_DISPLAY_HOOK bbdb-srv.pl - # export NS_MSG_DISPLAY_HOOK - -C-Shell (`/bin/csh') and variants: - % setenv NS_MSG_DISPLAY_HOOK bbdb-srv.pl - - The following variables can be used to customize the behavior of -`bbdb-srv': - -`bbdb/srv-auto-create-p' - This variable is similar to `bbdb/news-auto-create-p' and - `bbdb/mail-auto-create-p'. That is, when headers are passed in to - `bbdb-srv', a new BBDB record can be created if none exists, - depending on the value of this variable. Possible values are: - `t' - Automatically create new BBDB records if the headers passed - in do not correspond to an already-existing record. - - `nil' - Do not automatically create new BBDB records. - - FUNCTION - FUNCTION is called. If it returns `t', a record will be - created for the person named in the `From:' header. If it - returns `nil', no record will be created. - - A suggested function for use is - `bbdb/srv-auto-create-mail-news-dispatcher'. This function - will attempt to determine the source of the passed headers - - whether they were part of a mail message or of a news - article. The action (if any) dictated by the value of either - `bbdb/mail-auto-create-p' or `bbdb/news-auto-create-p', based - on the determined source of the passed headers. - - -`bbdb/srv/display-delay' - `bbdb-srv' pauses between displaying the records corresponding to - each passed set of headers. This variable controls the length of - time (in seconds) of the delay between the display of different - records. Note when setting this variable that only one set of - headers can be queued at a time. If three sets of headers are - passed to `bbdb-srv' in less than the delay time, only the first - and last will be displayed. - - ---------- Footnotes ---------- - - (1) Use the full path to `bbdb-srv.pl' if it is not in the default -path. - - -File: bbdb.info, Node: Internals, Next: Mailing Lists, Prev: Utilities, Up: Top - -Internals -========= - -This section is currently a dumping ground for things that should -eventually go here, but were found elsewhere in the file. - - INFORMATION IN THIS SECTION IS FOR INFORMATIONAL PURPOSES ONLY. IT -SHOULD NOT BE TAKEN AS DOCUMENTATION OF AN EXTERNAL API. EVERYTHING -LISTED BELOW IS SUBJECT TO CHANGE WITHOUT NOTICE - - The first time you use one of the BBDB commands, this file is read -into an emacs buffer, and remains there. As you make changes to the -database, this buffer is changed as well, ensuring that if it is -auto-saved, it will be saved in its most current state. - -BBDB data file format ---------------------- - -The data file is arranged in a hierarchical fashion. At the top level -are vectors, with one vector per database record. It is very important -that each vector be on its own line, as the BBDB builds and stores -markers based on this layout. The markers are then used to increase -the speed of database modifications (more on this later). The record -vectors contain the individual fields of the record. These fields can -be of any type, but are currently integers, strings, lists of strings, -alists, vectors, or lists of vectors. In the case of fields that -contain one or more vectors, they can be further broken down in terms -of the fields of their component vectors. - - In an effort to provide a more concrete example to illustrate the -above, and to provide a reference for database accessor and modifier -functions, we describe the database format below. This description -starts with the fields of the individual record vectors, and drills -down through the vectors used by some of the fields. - -Record Vectors -.............. - -Name Type Accessor and Modifier Description -First String `bbdb-record-firstname' Entity's first name -name `bbdb-record-set-firstname' -Last name String `bbdb-record-lastname' Entity's last name - `bbdb-record-set-lastname' -AKAs List of `bbdb-record-aka' Alternate names for - Strings `bbdb-record-set-aka' entity -Company String `bbdb-record-company' Company with which - `bbdb-record-set-company' entity is associated -Phones List of `bbdb-record-phones' List of phone number - Vectors `bbdb-record-set-phones' vectors -Addresses List of `bbdb-record-addresses' List of address vectors - Vectors `bbdb-record-set-addresses' -Net List of `bbdb-record-net' List of network -address Strings `bbdb-record-set-net' addresses -Notes String or `bbdb-record-raw-notes' String or Association - Alist `bbdb-record-set-raw-notes'list of note fields - (strings) -Cache Vector `bbdb-record-cache' Record cache. - `bbdb-record-set-cache' Internal version only. - - The phone, address and cache vector fields are described below. -Please note that, as indicated in the table above, the cache is present -only in the internal version of the database - it is not written out as -part of the `.bbdb' file. - - In addition, the accessor and modifier functions for the notes alist -are described. - -Phone Vectors -............. - -To access the fields in the below table, you must first get the list of -phone vectors using the `bbdb-record-phones' function. Note that if -you alter the phones field with the `bbdb-record-set-phones' function, -you are altering the entire phones list for the given record. Use the -modifier functions below for modifications to individual phone vectors. - -Name Type Accessor and Modifier Description -Location String `bbdb-phone-location' Phone number identifier - `bbdb-phone-set-location' -Area Integer `bbdb-phone-area' Area code for phone - `bbdb-phone-set-area' number -Exchange Integer `bbdb-phone-exchange' Exchange (aka prefix) - `bbdb-phone-set-exchange' for phone number -Suffix Integer `bbdb-phone-suffix' Suffix for phone number - `bbdb-phone-set-suffix' -Extension Integer `bbdb-phone-extension' Phone number extension - `bbdb-phone-set-extension' (`0' if none) - -Address Vectors -............... - -To access the fields in the below table, you must first get the list of -address vectors using the `bbdb-record-addresses' function. Note that -if you alter the addresses field with the `bbdb-record-set-addresses' -function, you are altering the entire addresses list for the given -record. Use the modifier functions below for modifications to -individual address vectors. - -Name Type Accessor and Modifier Description -Location String `bbdb-address-location' Address identifier - `bbdb-address-set-location' -Streets List `bbdb-address-streets' List of street address - `bbdb-address-set-streets' lines. `nil' if none. -Street3 String `bbdb-address-street3' Third line of street - `bbdb-address-set-street3' address. "" if none. -City String `bbdb-address-city' City name - `bbdb-address-set-city' -State String `bbdb-address-state' State abbreviation - `bbdb-address-set-state' -Zip Integer `bbdb-address-zip' Zip code - (american) `bbdb-address-set-zip' - List - (non-american) -Country String `bbdb-address-country' Country - `bbdb-address-set-country' - -Cache Vector -............ - -This vector is present only in the internal database representation. It -is not written out to the database file because it contains information -aggregated from the rest of the record that is reconstructed when the -database is read. To write the cache information to the database file -would increase the risk of database inconsistency, and would violate the -principles of normalization. - - To access the cache fields using the functions listed below that -begin with `bbdb-cache-', you must first get the cache vector using the -`bbdb-record-cache' function. The functions that begin with -`bbdb-record-' get the cache vector internally. Note that if you alter -the cache field in the high-level record with the -`bbdb-record-set-cache' function, you are altering the entire cache -vector for the given record. Use the modifier functions below for -modifications to individual cache fields. - -Name Type Accessor and Modifier Description -Name Cache String `bbdb-cache-namecache' Preconcatenated name - `bbdb-cache-set-namecache' of entity -Sort Key String `bbdb-cache-sortkey' Preconcatenated sort - `bbdb-cache-set-sortkey' key for record -Marker Marker `bbdb-cache-marker' Marker in `.bbdb' for - `bbdb-record-marker' start of record - `bbdb-cache-set-marker' - `bbdb-record-set-marker' -Deleted Boolean `bbdb-cache-deleted-p' Set to `t' if record - `bbdb-record-deleted-p' has been deleted, - `bbdb-cache-set-deleted-p' `nil' if not - `bbdb-record-set-deleted-p' - - The functions listed above will return `nil' if their respective -cache fields are not set. The functions listed below will return the -value of their cache fields if set, but will also build (and set) the -correct field values if the fields are unset: - -`bbdb-record-name' - Return the name in the Name Cache field of the cache (if set). If - the name has not been built yet (if the field is `nil'), the name - is built, stored in the Name Cache field, and returned. - -`bbdb-record-sortkey' - Return the name it the Sort Key field of the cache (if set). If - the Sort Key field has not yet been set (if the field is `nil'), - the Sort Key is built, stored in the Sort Key field, and returned. - - -Notes String or Alist -..................... - -If there is only a single note for a given record, the notes field for -that record will be a string. If there is more than one note, the notes -field will be an association list (alist) with elements of the form - - ( NAME . VALUE ) - -where NAME is the symbol for the name of the note, and VALUE is the -value of the note. - -Example BBDB record -................... - - -File: bbdb.info, Node: Mailing Lists, Next: Changes, Prev: Internals, Up: Top - -Mailing Lists -============= - -(If you are looking for a way to create mailing lists with BBDB, you -should be looking at the section on *Note Mail Sending Interfaces::.) - - There are three mailing lists for the BBDB. -`bbdb-info@lists.sourceforge.net' gets moderate traffic, and is -intended for the discussion and distribution of development versions of -the BBDB. Users of development versions of the BBDB should be -subscribed to this list. It is also to this list that bugs should be -reported. *Note Known Bugs::. for instructions on submitting bug -reports. - - The second mailing list `bbdb-announce@lists.sourceforge.net' has -very low volume. Any user of the BBDB should consider subscribing to -this list, as new releases and security issues will be posted here. - - A third mailing list, `bbdb-cvs@lists.sourceforge.net', is intended -for developers to follow the changes made to the BBDB development -version. Developers of the BBDB should consider to subscribe to this -list. - - -File: bbdb.info, Node: Changes, Next: The Latest Version, Prev: Mailing Lists, Up: Top - -Changes in this Version -======================= - -* Menu: - -* Major Changes:: Major changes in this version -* Other Changes:: Not-so-major changes - - -File: bbdb.info, Node: Major Changes, Next: Other Changes, Prev: Changes, Up: Changes - -Major Changes -------------- - -Database File Version Change -............................ - -(the following version-migration text will move in a future version. -It is in this section currently because new users will likely not -experience it) - - There has been a version change in the BBDB database file. The new -version supports non-US zip codes, and an additional "Country" field in -addresses. - - An automatic version-migration mechanism has been implemented that -allows older version `.bbdb' files to either be migrated to the new -version, or used as-is without migrating. When the BBDB detects a -database file with an old version, it will display the features that -have been introduced in the database file from the time of the older -version's implementation. It will offer the choice of migration or use -of the BBDB with the older-version file. - - If migration is chosen, the database file will be automatically -changed to the new format. If migration is declined, the file will -kept in the older format in the `.bbdb' buffer, but will be stored -internally in the new format. When changes need to be made to the -`.bbdb' buffer, changed records will be reverse-migrated from their -internal version to that of the disk file. - - -File: bbdb.info, Node: Other Changes, Prev: Major Changes, Up: Changes - -Other Changes -------------- - -TeX Output -.......... - -By default, ec fonts are used for TeX output instead of cm fonts. With -the `ps-fonts' option set in `bbdb-print-alist', TimesNewRoman and -Courier fonts are used. - - - -File: bbdb.info, Node: The Latest Version, Next: The Future, Prev: Changes, Up: Top - -The Latest Version -================== - -Released versions of the BBDB can be found at the following site: - - * WWW: `http://bbdb.sourceforge.net' - - * FTP: `ftp://ftp.sourceforge.net/pub/bbdb' - -Development versions of the BBDB can be obtained in the following ways: - - * WWW: `http://bbdb.sourceforge.net' - - * Anonymous CVS: See `http://bbdb.sourceforge.net' for instructions. - - Users of development versions of the BBDB should subscribe to the -`bbdb-info' mailing list. *Note Mailing Lists::. - - -File: bbdb.info, Node: The Future, Prev: The Latest Version, Up: Top - -The Future -========== - -The future consists of Bugs and Features. - -* Menu: - -* Known Bugs:: Known Bugs, and how to submit new ones -* TODO List:: The TODO List -* EOL Statements:: EOL (End Of Life) Statements - - -File: bbdb.info, Node: Known Bugs, Next: TODO List, Prev: The Future, Up: The Future - -Known Bugs ----------- - - 1. `M-TAB' conflicts with ispell. Workaround: The binding installed - by the BBDB for address completion/expansion conflicts with that - used by ispell. The suggested workarounds are to rebind the ispell - key (the BBDB binding is not configurable at this time), to - manually invoke ispell via `M-x', or to not use ispell completion - functionality in BBDB-enabled message composition buffers. The - following is an example of such a rebinding, supplied by Kai - Großjohan: - - (defun my-message-mode-keys () - (define-key message-mode-map (kbd "M-TAB") 'bbdb-complete-name)) - (add-hook 'message-mode-hook 'my-message-mode-keys) - - 2. BBDB and abbrev expansion is inconsistent. Workaround: Currently, - `M-TAB' must be used to expand/complete against BBDB names and net - addresses, and `TAB' must be used to expand abbrevs (the values in - the `mail-alias' field). Unification is planned for a future - version. - - 3. The `*BBDB*' buffer does not always come up when the first article - in a Gnus Summary Buffer is selected. Workaround: Pressing `g' - to reload the article. This will cause the `*BBDB*' buffer to be - displayed. - - 4. Expansion will fail when the name to be expanded is a subset of - the name for another record. For example, if you have entries for - `John' and `Johnathan', you will not be able to expand the name - for `John'. Workaround: Use the net address for the subset name - (`John' in this example). - - - It is commonly known that there are no bugs in the BBDB. Bugs found -in defiance of this rule should be submitted using `M-x -bbdb-submit-bug-report'. These bug reports will bbe sent to the -`bbdb-info' mailing list (*note Mailing Lists::) and are available from -public archives. Other big brothers may be reading your bug reports. - - -File: bbdb.info, Node: TODO List, Next: EOL Statements, Prev: Known Bugs, Up: The Future - -TODO List ---------- - -The Near Future -............... - - * Add bbdb/MUA-delete-sender-record - - * Configurable completion. Should allow user to specify "complete on - names first, then nets", etc. - - * More variables for upgrading. Specifically a variable that lets - users specify extra fields for upgrading (an alist `(a . b)' that - says field `a' should be upgraded the same way as field `b'. - - * Change all functions that switch on MUAs to use compose-mail (ex: - `bbdb-send-mail-internal'). - - * Soren Dayton's method for generically extending the BBDB with - special-purpose fields - - * Sorting records on alternate keys. `bbdb-sort-by' from Boris - Goldowsky. - - * Sorting individual types of fields - Sam Steingold's method. - - * Button 3 menus (Mark Moll and Soren Dayton) - - * Conditionalized erasure of properties when text is pasted into the - BBDB. - - * Should notice when there are `Reply-To:' addresses. - - * Should have a command for merging together two divergent copies of - a `.bbdb' file (in case you read mail on one machine and news on - another, for instance.) - - * The `*BBDB*' buffer should be resized to exactly fit what it's - displaying, even when not in "electric" mode. - - * It should be possible to do completion on last names as well as - first names. - - * The BBDB buffer is left at the top of the stack when GNUS is exited - because GNUS runs its exit-hooks too early. This should be fixed. - - * String area codes (German area codes can begin with zeroes) patch - from `Michael Sperber ' - - * Default country variable, similar to `bbdb-default-area-code'. - - * Make format self-describing in comment - - * ISO-8859-x characters in records for printing. - - * Prefix for `W' (`bbdb-www') command to allow selection of - different addresses. - - * Generalized buttons (via extents) for fields. Example: `(a . b)' - means create button that calls `b' for each entry in the `a' field. - - * Remove support for GNUS. Start with lisp Makefile (remove nntp - and gnus loads). - - * More flexible auto-addition. Conditionalizing of addition - (conditions or supplied function). Prompt if multiple records - that meet criteria exist. - - * Different output formats. See Toby Speight's - `' and Bin Mu's - `<199801221605.KAA23663@DerivaTech.Com>'. - - * Generalized area-code-split program that could split, for example, - based on input copied (or straight fetch of page) from the - Bellcore NANP page. - - * Print multivalue (comma-separated) fields with one value per line - - * Easier BBDB extension. See `' - from Soren Dayton. - - * Take birthdays from the BBDB, add them to calendar. From Boris - Goldowsky. - - * Make mail aliases file for other mailers. From Boris Goldowsky. - - * Various patches from Boris Goldowsky in `bbdb-ext'. - - * Various other patches: - - `bbdb-filters-0.2' - - - `bbdb-frame.el' - - - `bbdb-letter-1.0' - - - `bbdb-plz' - - - `bbdb-query' - - - `country' - - - `country-info' - - Note that these files have not been investigated. They may or may - not be incorporated. - - * Ability to remove all properties from copied strings. - - -Not-So-Near Future -.................. - - * Fix Gnus scoring so it rebuilds when gnus-score disappears - - * Multiline note fields - - * Change key to be some kind of unique number - - * There should be better support for non-American addresses and phone - numbers. This might be Near Future if somebody volunteers to send - me patches. - - * Should reimplement "electric" mode to not be so broken. - - * The `*C-o' keystroke should add a field to all displayed records. - Perhaps `*;' should append some text to an arbitrary field of all - displayed records. - - * Multiple `.bbdb' files with precedence relationships. See Wes - Hardaker's - `' - - * Automatically grab information about a person from their sig. See - Graham Clark's `info-bbdb' post - `<6282.199706161624@havra.dcs.ed.ac.uk>' and Adrian Aichner's - `info-bbdb' post `'. - Would like to have `bbdb-snarf' attack the sig then compare the - snarfed data with the header data. - - -Thoughts -........ - - * Are there enough hooks? - - * The interfaces should share more code. - - * The `bbdb-create-internal' function should be more forgiving. - - * More `*' commands in general, including `*d'. - - -File: bbdb.info, Node: EOL Statements, Prev: TODO List, Up: The Future - -End of Life (EOL) Statements ----------------------------- - -The items in the following list describe items for which support will be -removed in coming versions of the BBDB. The items listed are -guaranteed to be supported and present only until the EOL date. They -may be removed without warning at any time thereafter. - - 1. `advertized-bbdb-delete-current-field-or-record' - Support for this function will be removed for version 2.2. It is - recommended that all code depending on this variable be switched - to use `bbdb-delete-current-field-or-record'. The two functions - have the same calling conventions and effects. This EOL statement - was added for version 2.1. - - 2. Support for the GNUS (not Gnus) newsreader - The GNUS-specific parts of the BBDB will be actively removed for - the 2.2 release. No further maintenance and/or bugfixes are - planned for GNUS code at this time. This EOL statement was added - for version 2.1. - - -File: bbdb.info, Node: Thanks, Up: Top - -Thanks -====== - -Thanks to everyone on the info-bbdb mailing list for many useful -suggestions. This hack would be far less insidious without their input! - -Thanks list for versions after 2.00.06. ---------------------------------------- - -Thanks to Alex Schroeder, Ronan Waide, Thomas DeWeese, Robert Fenk, -Didier Verna, Bill Carpenter. - -Thanks list for versions after 1.51 prior to and including 2.00.06. -------------------------------------------------------------------- - -Thanks to Adrian Aichner, Kees de Bruin, David Carlton, Soren Dayton, -Brian Edmonds, Boris Goldowsky, Seth Golub, John Heidemann, Christopher -Kline, Carsten Leonhardt, Hrvoje Niksic, Jens-Ulrik Hoger Petersen, -Colin Rafferty, Matt Simmons, Sam Steingold, Marco Walther, Christoph -Wedler. - -Thanks list for versions prior to and including 1.51. ------------------------------------------------------ - -And special thanks to Sebastian Kremer, Joe Wells, Todd Kaufmann, Andy -Norman, Ivan Vazquez, Stewart Clamen, Roland McGrath, Dave Brennan, -Kimball Collins, Dirk Grunwald, Philippe Queinnec, Boris Putanec, Dave -Disser, Francois Felix Ingrand, Sean Owens, Guido Bosch, Lance Brown, -Tom Emerson, George Hartzell, Luis Miguel Silveira, Kimmo Suominen, -Derek Upham, David Zuhn, Rod Whitby, Richard Mlynarik. - - Last, but not least, thanks to Jamie Zawinski for writing BBDB in the -first place. - - -File: bbdb.info, Node: _, Up: (dir) - -_ -* - - in.sid.i.ous aj \in-'sid-e-*s\ - [L insidiosus, fr. insidiae ambush, fr. insidere to sit in, sit on, - fr. in- + sedere to sit -- more at SIT] - 1 a : awaiting a chance to entrap TREACHEROUS - b : harmful but enticing SEDUCTIVE - 2 a : having a gradual and cumulative effect SUBTLE - b of a disease - : developing so gradually as to be well established before - becoming apparent - in.sid.i.ous.ly av - in.sid.i.ous.ness n - -* Menu: - -* Top:: - - -File: bbdb.info, Node: Concept Index, Next: Variable Index, Up: Top - -Concept Index -************* - -* Menu: - -* %F: VM Message Summary. -* %UB: VM Message Summary. -* *BBDB* buffer: BBDB Mode. -* Adding new fields: BBDB Mode. -* Adding new records: Manual Record Addition. -* Address completion <1>: Mail Sending Interfaces. -* Address completion: Customization Parameters. -* Address display: Customization Parameters. -* AKA: Customization Parameters. -* Alternate names: Customization Parameters. -* Annotating the sender of the current message: Interfaces. -* Auto-save files: Customization Parameters. -* Automatic display of the corresponding record: Customization Parameters. -* Automatically adding text to records: Predefined Hooks. -* Automatically creating records <1>: Customization Parameters. -* Automatically creating records: Predefined Hooks. -* BBDB Mode: BBDB Mode. -* Browsing the Web page for the current record: BBDB Mode. -* Bug Reports: Known Bugs. -* Builtin field types: Database Fields. -* Changing fields: BBDB Mode. -* Changing windows: BBDB Mode. -* Checking zip codes: Customization Parameters. -* Completion: Customization Parameters. -* Continental addresses: Customization Parameters. -* Creating new records <1>: BBDB Mode. -* Creating new records: Manual Record Addition. -* Deleting fields: BBDB Mode. -* Dialling phone numbers: BBDB Mode. -* Display of addresses: Customization Parameters. -* Displaying changed records: BBDB Mode. -* Editing fields: BBDB Mode. -* Electric display: Customization Parameters. -* Elided display: Basic Searching. -* European addresses: Customization Parameters. -* European phone numbers <1>: BBDB Mode. -* European phone numbers: Customization Parameters. -* Finger interface: BBDB Mode. -* Fixing mistakes: BBDB Mode. -* Format of completed address: Mail Sending Interfaces. -* Formatting addresses: Customization Parameters. -* GNUS Subject-buffer: GNUS Subject List. -* Initial Configuration: Initial Configuration. -* Inserting new fields: BBDB Mode. -* Installation: Installation. -* Invalid zip codes: Customization Parameters. -* List of valid zip codes: Customization Parameters. -* Mail address completion <1>: Customization Parameters. -* Mail address completion <2>: Mail Sending Interfaces. -* Mail address completion: Customization Parameters. -* Mail Aliases: Mail Sending Interfaces. -* mail-alias definition: Database Fields. -* mail-alias usage: Mail Sending Interfaces. -* Mailing lists: Mail Sending Interfaces. -* Makefile: Installation. -* mark-char: GNUS Subject List. -* Merging records: BBDB Mode. -* Name completion <1>: Customization Parameters. -* Name completion: Mail Sending Interfaces. -* Normal User Installation: Normal User. -* North American phone numbers <1>: Customization Parameters. -* North American phone numbers: BBDB Mode. -* Not a valid zip code: Customization Parameters. -* One-line display: Basic Searching. -* Phone numbers <1>: Customization Parameters. -* Phone numbers: BBDB Mode. -* Printing records in the database <1>: bbdb-print. -* Printing records in the database <2>: Database Fields. -* Printing records in the database: BBDB Mode. -* Removing fields: BBDB Mode. -* Reordering fields: BBDB Mode. -* Saving your changes: BBDB Mode. -* Searching the database <1>: BBDB Mode. -* Searching the database: Basic Searching. -* Sending mail <1>: Mail Sending Interfaces. -* Sending mail: BBDB Mode. -* Showing the sender of the current message: Interfaces. -* Special Field Names: Database Fields. -* Storing FTP sites in the BBDB: bbdb-ftp. -* Timestamping records: Predefined Hooks. -* Transposing fields: BBDB Mode. -* User-defined fields <1>: Basic Searching. -* User-defined fields: BBDB Mode. -* Valid zip codes: Customization Parameters. -* XEmacs Package Installation: XEmacs Package. -* Zip code checking: Customization Parameters. - - -File: bbdb.info, Node: Variable Index, Prev: Concept Index, Up: Top - -Variable Index -************** - -* Menu: - -* bbdb-address-formatting-alist: Customization Parameters. -* bbdb-after-read-db-hook: Customization Hooks. -* bbdb-always-add-addresses: Customization Parameters. -* bbdb-auto-notes-alist: Predefined Hooks. -* bbdb-auto-notes-ignore: Predefined Hooks. -* bbdb-auto-notes-ignore-all: Predefined Hooks. -* bbdb-auto-revert-p: Customization Parameters. -* bbdb-canonicalize-net-hook: Customization Hooks. -* bbdb-canonicalize-redundant-nets-p: Customization Parameters. -* bbdb-case-fold-search: Customization Parameters. -* bbdb-change-hook: Customization Hooks. -* bbdb-check-zip-codes-p: Customization Parameters. -* bbdb-complete-name-allow-cycling: Customization Parameters. -* bbdb-complete-name-full-completion: Customization Parameters. -* bbdb-completion-display-record: Mail Sending Interfaces. -* bbdb-completion-type: Customization Parameters. -* bbdb-continental-zip-regexp: Customization Parameters. -* bbdb-create-hook: Customization Hooks. -* bbdb-default-area-code: Customization Parameters. -* bbdb-dial-local-prefix: BBDB Mode. -* bbdb-dial-local-prefix-alist: BBDB Mode. -* bbdb-dial-long-distance-prefix: BBDB Mode. -* bbdb-dwim-net-address-allow-redundancy: Mail Sending Interfaces. -* bbdb-electric-p: Customization Parameters. -* bbdb-expand-mail-aliases: Customization Parameters. -* bbdb-file: Customization Parameters. -* bbdb-finger-host-field <1>: Database Fields. -* bbdb-finger-host-field: BBDB Mode. -* bbdb-get-addresses-from-headers: Reader-specific Features. -* bbdb-get-addresses-headers: Reader-specific Features. -* bbdb-get-addresses-to-headers: Reader-specific Features. -* bbdb-get-only-first-address-p: Reader-specific Features. -* bbdb-ignore-most-messages-alist: Predefined Hooks. -* bbdb-ignore-some-messages-alist: Predefined Hooks. -* bbdb-info-file: BBDB Mode. -* bbdb-initialize-hook: Customization Hooks. -* bbdb-legal-zip-codes: Customization Parameters. -* bbdb-list-hook: Customization Hooks. -* bbdb-load-hook: Customization Hooks. -* bbdb-message-caching-enabled: Customization Parameters. -* bbdb-mode-hook: Customization Hooks. -* bbdb-new-nets-always-primary: Customization Parameters. -* bbdb-north-american-phone-numbers-p: Customization Parameters. -* bbdb-notice-auto-save-file: Customization Parameters. -* bbdb-notice-hook <1>: Customization Hooks. -* bbdb-notice-hook: Predefined Hooks. -* bbdb-offer-save: Customization Parameters. -* bbdb-pop-up-target-lines: Customization Parameters. -* bbdb-print-alist: bbdb-print. -* bbdb-print-brief-alist: bbdb-print. -* bbdb-print-epilog: bbdb-print. -* bbdb-print-file-name: bbdb-print. -* bbdb-print-full-alist: bbdb-print. -* bbdb-print-omit-fields: bbdb-print. -* bbdb-print-prolog: bbdb-print. -* bbdb-print-require: bbdb-print. -* bbdb-quiet-about-name-mismatches: Customization Parameters. -* bbdb-readonly-p: Customization Parameters. -* bbdb-send-mail-style: BBDB Mode. -* bbdb-use-alternate-names: Customization Parameters. -* bbdb-use-pop-up: Customization Parameters. -* bbdb-user-mail-names: Customization Parameters. -* bbdb/gnus-header-prefer-real-names: GNUS Subject List. -* bbdb/gnus-header-show-bbdb-names: GNUS Subject List. -* bbdb/gnus-lines-and-from-length: GNUS Subject List. -* bbdb/gnus-mark-known-posters: GNUS Subject List. -* bbdb/gnus-score-default: Gnus Scoring. -* bbdb/gnus-score-field <1>: Gnus Scoring. -* bbdb/gnus-score-field: Database Fields. -* bbdb/mail-auto-create-p <1>: Predefined Hooks. -* bbdb/mail-auto-create-p: Customization Parameters. -* bbdb/news-auto-create-p <1>: Predefined Hooks. -* bbdb/news-auto-create-p: Customization Parameters. -* bbdb/sc-attribution-field: Database Fields. -* bbdb/srv-auto-create-p: bbdb-srv. -* bbdb/srv-display-delay: bbdb-srv. -* bbdb/vm-auto-add-label-field: VM automatic adding of labels. -* bbdb/vm-auto-add-label-list: VM automatic adding of labels. -* bbdb/vm-set-auto-folder-alist-field: VM automatic setup of vm-set-auto-folder-alist. -* gnus-score-find-score-files-function: Gnus Scoring. -* vm-summary-format: VM Message Summary. -* vm-summary-uninteresting-senders: VM what records are displayed. - - - -Tag Table: -Node: Top522 -Node: Installation5043 -Node: General Prerequisites6018 -Ref: General Prerequisites-Footnote-18400 -Node: Normal User8553 -Node: XEmacs Package13936 -Node: Initial Configuration16850 -Ref: Initial Configuration-Footnote-120435 -Ref: Initial Configuration-Footnote-220517 -Ref: Initial Configuration-Footnote-320653 -Node: Gnus Prep20906 -Node: MH-E Prep21623 -Node: RMAIL Prep22212 -Node: Sendmail Prep22812 -Node: VM Prep23277 -Node: Message Prep23888 -Node: Reportmail Prep24464 -Node: Supercite Prep25083 -Node: Web Browser Prep27869 -Node: The BBDB28610 -Node: Database Fields29280 -Node: Basic Searching34972 -Node: Advanced Searching36167 -Node: Manual Record Addition37812 -Node: BBDB Mode38472 -Node: Interfaces51086 -Node: Mail Reading Interfaces52955 -Node: News Reading Interfaces53605 -Node: Mail Sending Interfaces54014 -Node: Reader-specific Features58084 -Node: Gnus Features59429 -Node: Gnus Scoring59987 -Node: Gnus Summary Buffer61239 -Ref: Gnus Summary Buffer-Footnote-165882 -Node: GNUS Subject List66265 -Node: VM Features67935 -Node: VM Message Summary68357 -Node: VM what records are displayed69055 -Node: VM automatic setup of vm-set-auto-folder-alist69474 -Node: VM automatic adding of labels70129 -Node: Other Packages71656 -Node: Using Message Mode72195 -Node: Using Reportmail72506 -Node: Using Supercite73723 -Node: Using Web Browsers74685 -Node: Options75734 -Node: Customization Parameters76253 -Node: Customization Hooks88089 -Node: Predefined Hooks94021 -Node: Utilities101295 -Node: bbdb-ftp101730 -Node: bbdb-print102132 -Node: bbdb-snarf109497 -Ref: bbdb-snarf-Footnote-1110318 -Node: bbdb-srv110439 -Ref: bbdb-srv-Footnote-1114615 -Node: Internals114692 -Node: Mailing Lists123605 -Node: Changes124668 -Node: Major Changes124938 -Node: Other Changes126263 -Node: The Latest Version126556 -Node: The Future127149 -Node: Known Bugs127454 -Node: TODO List129430 -Node: EOL Statements134142 -Node: Thanks135187 -Node: _136590 -Node: Concept Index137181 -Node: Variable Index142436 - -End Tag Table diff --git a/xemacs-packages/info/ediff.info b/xemacs-packages/info/ediff.info deleted file mode 100644 index 4dd5dd6a..00000000 --- a/xemacs-packages/info/ediff.info +++ /dev/null @@ -1,2668 +0,0 @@ -This is ediff.info, produced by makeinfo version 4.7 from ediff.texi. - - This file documents Ediff, a comprehensive visual interface to Unix -diff and patch utilities. - - Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -2003, 2004, 2005, 2006 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.2 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover texts - being "A GNU Manual", and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - "GNU Free Documentation License" in the Emacs manual. - - (a) The FSF's Back-Cover Text is: "You have freedom to copy and - modify this GNU Manual, like GNU software. Copies published by - the Free Software Foundation raise funds for GNU development." - - This document is part of a collection distributed under the GNU - Free Documentation License. If you want to distribute this - document separately from the collection, you can do so by adding a - copy of the license to the document, as described in section 6 of - the license. - -INFO-DIR-SECTION Editors -START-INFO-DIR-ENTRY -* Ediff: (ediff). A visual interface for comparing and merging programs. -END-INFO-DIR-ENTRY - - -File: ediff.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) - -* Menu: - -* Introduction:: About Ediff. -* Major Entry Points:: How to use Ediff. -* Session Commands:: Ediff commands used within a session. -* Registry of Ediff Sessions:: Keeping track of multiple Ediff sessions. -* Session Groups:: Comparing and merging directories. -* Remote and Compressed Files:: You may want to know about this. -* Customization:: How to make Ediff work the way YOU want. -* Credits:: Thanks to those who helped. -* Index:: - - -File: ediff.info, Node: Introduction, Next: Major Entry Points, Prev: Top, Up: Top - -1 Introduction -************** - -Ediff provides a convenient way for simultaneous browsing through the -differences between a pair (or a triple) of files or buffers (which are -called `variants' for our purposes). The files being compared, file-A, -file-B, and file-C (if applicable) are shown in separate windows (side -by side, one above the another, or in separate frames), and the -differences are highlighted as you step through them. You can also -copy difference regions from one buffer to another (and recover old -differences if you change your mind). - - Another powerful feature is the ability to merge a pair of files -into a third buffer. Merging with an ancestor file is also supported. -Furthermore, Ediff is equipped with directory-level capabilities that -allow the user to conveniently launch browsing or merging sessions on -groups of files in two (or three) different directories. - - In addition, Ediff can apply a patch to a file and then let you step -through both files, the patched and the original one, simultaneously, -difference-by-difference. You can even apply a patch right out of a -mail buffer, i.e., patches received by mail don't even have to be -saved. Since Ediff lets you copy differences between variants, you -can, in effect, apply patches selectively (i.e., you can copy a -difference region from `file.orig' to `file', thereby undoing any -particular patch that you don't like). - - Ediff even understands multi-file patches and can apply them -interactively! (Ediff can recognize multi-file patches only if they -are in the context format or GNU unified format. All other patches are -treated as 1-file patches. Ediff is [hopefully] using the same -algorithm as `patch' to determine which files need to be patched.) - - Ediff is aware of version control, which lets you compare files with -their older versions. Ediff also works with remote and compressed -files, automatically ftp'ing them over and uncompressing them. *Note -Remote and Compressed Files::, for details. - - This package builds upon ideas borrowed from Emerge, and several of -Ediff's functions are adaptations from Emerge. Although Ediff subsumes -and greatly extends Emerge, much of the functionality in Ediff is -influenced by Emerge. The architecture and the interface are, of -course, drastically different. - - -File: ediff.info, Node: Major Entry Points, Next: Session Commands, Prev: Introduction, Up: Top - -2 Major Entry Points -******************** - -When Ediff starts up, it displays a small control window, which accepts -the Ediff commands and two or three windows displaying the files to be -compared or merged. The control window can be in its own small frame or -it can be part of a bigger frame that displays other buffers. In any -case, it is important that the control window be active (i.e., be the -one receiving the keystrokes) when you use Ediff. You can switch to -other Emacs buffers at will and even edit the files currently being -compared with Ediff and then switch back to Ediff at any time by -activating the appropriate Emacs windows. - - Ediff can be invoked interactively using the following functions, -which can be run either from the minibuffer or from the menu bar. In -the menu bar, all Ediff's entry points belong to three submenus of the -Tools menu: Compare, Merge, and Apply Patch. - -`ediff-files' -`ediff' - Compare two files. - -`ediff-backup' - Compare a file with its backup. If there are several numerical - backups, use the latest. If the file is itself a backup, then - compare it with its original. - -`ediff-buffers' - Compare two buffers. - -`ediff-files3' -`ediff3' - Compare three files. - -`ediff-buffers3' - Compare three buffers. - -`edirs' -`ediff-directories' - Compare files common to two directories. - -`edirs3' -`ediff-directories3' - Compare files common to three directories. - -`edir-revisions' -`ediff-directory-revisions' - Compare versions of files in a given directory. Ediff selects - only the files that are under version control. - -`edir-merge-revisions' -`ediff-merge-directory-revisions' - Merge versions of files in a given directory. Ediff selects only - the files that are under version control. - -`edir-merge-revisions-with-ancestor' -`ediff-merge-directory-revisions-with-ancestor' - Merge versions of files in a given directory using other versions - as ancestors. Ediff selects only the files that are under version - control. - -`ediff-windows-wordwise' - Compare windows word-by-word. - -`ediff-windows-linewise' - Compare windows line-by-line. - -`ediff-regions-wordwise' - Compare regions word-by-word. The regions can come from the same - buffer and they can even overlap. You will be asked to specify - the buffers that contain the regions, which you want to compare. - For each buffer, you will also be asked to mark the regions to be - compared. Pay attention to the messages that appear in the - minibuffer. - -`ediff-regions-linewise' - Similar to `ediff-windows-linewise', but compares the regions - line-by-line. See `ediff-windows-linewise' for more details. - -`ediff-revision' - Compare versions of the current buffer, if the buffer is visiting - a file under version control. - -`ediff-patch-file' -`epatch' - Patch a file or multiple files, then compare. If the patch - applies to just one file, Ediff will invoke a regular comparison - session. If it is a multi-file patch, then a session group - interface will be used and the user will be able to patch the - files selectively. *Note Session Groups::, for more details. - - Since the patch might be in a buffer or a file, you will be asked - which is the case. To avoid this extra prompt, you can invoke this - command with a prefix argument. With an odd prefix argument, - Ediff assumes the patch is in a file; with an even argument, a - buffer is assumed. - - Note that `ediff-patch-file' will actually use the `patch' utility - to change the original files on disk. This is not that dangerous, - since you will always have the original contents of the file saved - in another file that has the extension `.orig'. Furthermore, if - the file is under version control, then you can always back out to - one of the previous versions (see the section on Version Control in - the Emacs manual). - - `ediff-patch-file' is careful about versions control: if the file - to be patched is checked in, then Ediff will offer to check it - out, because failing to do so may result in the loss of the - changes when the file is checked out the next time. - - If you don't intend to modify the file via the patch and just want - to see what the patch is all about (and decide later), then - `ediff-patch-buffer' might be a better choice. - -`ediff-patch-buffer' -`epatch-buffer' - Patch a buffer, then compare. The buffer being patched and the - file visited by that buffer (if any) is _not_ modified. The - result of the patch appears in some other buffer that has the name - ending with __patched_. - - This function would refuse to apply a multifile patch to a buffer. - Use `ediff-patch-file' for that (and when you want the original - file to be modified by the `patch' utility). - - Since the patch might be in a buffer or a file, you will be asked - which is the case. To avoid this extra prompt, you can invoke this - command with a prefix argument. With an odd prefix argument, - Ediff assumes the patch is in a file; with an even argument, a - buffer is assumed. - -`ediff-merge-files' -`ediff-merge' - Merge two files. - -`ediff-merge-files-with-ancestor' -`ediff-merge-with-ancestor' - Like `ediff-merge', but with a third ancestor file. - -`ediff-merge-buffers' - Merge two buffers. - -`ediff-merge-buffers-with-ancestor' - Same but with ancestor. - -`edirs-merge' -`ediff-merge-directories' - Merge files common to two directories. - -`edirs-merge-with-ancestor' -`ediff-merge-directories-with-ancestor' - Same but using files in a third directory as ancestors. If a - pair of files doesn't have an ancestor in the ancestor-directory, - you will still be able to merge them without the ancestor. - -`ediff-merge-revisions' - Merge two versions of the file visited by the current buffer. - -`ediff-merge-revisions-with-ancestor' - Same but with ancestor. - -`ediff-documentation' - Brings up this manual. - -`ediff-show-registry' -`eregistry' - Brings up Ediff session registry. This feature enables you to - quickly find and restart active Ediff sessions. - -If you want Ediff to be loaded from the very beginning of your Emacs -session, you should put this line in your `~/.emacs' file: - - (require 'ediff) - -Otherwise, Ediff will be loaded automatically when you use one of the -above functions, either directly or through the menus. - - When the above functions are invoked, the user is prompted for all -the necessary information--typically the files or buffers to compare, -merge, or patch. Ediff tries to be smart about these prompts. For -instance, in comparing/merging files, it will offer the visible buffers -as defaults. In prompting for files, if the user enters a directory, -the previously input file name will be appended to that directory. In -addition, if the variable `ediff-use-last-dir' is not `nil', Ediff will -offer previously entered directories as defaults (which will be -maintained separately for each type of file, A, B, or C). - - All the above functions use the POSIX `diff' or `diff3' programs to -find differences between two files. They process the `diff' output and -display it in a convenient form. At present, Ediff understands only -the plain output from diff. Options such as `-c' are not supported, -nor is the format produced by incompatible file comparison programs -such as the VMS version of `diff'. - - The functions `ediff-files', `ediff-buffers', `ediff-files3', -`ediff-buffers3' first display the coarse, line-based difference -regions, as reported by the `diff' program. The total number of -difference regions and the current difference number are always -displayed in the mode line of the control window. - - Since `diff' may report fairly large chunks of text as being -different, even though the difference may be localized to just a few -words or even to the white space or line breaks, Ediff further -_refines_ the regions to indicate which exact words differ. If the -only difference is in the white space and line breaks, Ediff says so. - - On a color display, fine differences are highlighted with color; on a -monochrome display, they are underlined. *Note Highlighting Difference -Regions::, for information on how to customize this. - - The commands `ediff-windows-wordwise', `ediff-windows-linewise', -`ediff-regions-wordwise' and `ediff-regions-linewise' do comparison on -parts of existing Emacs buffers. The commands `ediff-windows-wordwise' -and `ediff-regions-wordwise' are intended for relatively small segments -of buffers (e.g., up to 100 lines, depending on the speed of your -machine), as they perform comparison on the basis of words rather than -lines. (Word-wise comparison of large chunks of text can be slow.) - - To compare large regions, use `ediff-regions-linewise'. This -command displays differences much like `ediff-files' and -`ediff-buffers'. - - The functions `ediff-patch-file' and `ediff-patch-buffer' apply a -patch to a file or a buffer and then run Ediff on the appropriate -files/buffers, displaying the difference regions. - - The entry points `ediff-directories', `ediff-merge-directories', -etc., provide a convenient interface for comparing and merging files in -different directories. The user is presented with Dired-like interface -from which one can run a group of related Ediff sessions. - - For files under version control, `ediff-revision' lets you compare -the file visited by the current buffer to one of its checked-in -versions. You can also compare two checked-in versions of the visited -file. Moreover, the functions `ediff-directory-revisions', -`ediff-merge-directory-revisions', etc., let you run a group of related -Ediff sessions by taking a directory and comparing (or merging) -versions of files in that directory. - - -File: ediff.info, Node: Session Commands, Next: Registry of Ediff Sessions, Prev: Major Entry Points, Up: Top - -3 Session Commands -****************** - -All Ediff commands are displayed in a Quick Help window, unless you type -`?' to shrink the window to just one line. You can redisplay the help -window by typing `?' again. The Quick Help commands are detailed below. - - Many Ediff commands take numeric prefix arguments. For instance, if -you type a number, say 3, and then `j' (`ediff-jump-to-difference'), -Ediff moves to the third difference region. Typing 3 and then `a' -(`ediff-diff-to-diff') copies the 3d difference region from variant A -to variant B. Likewise, 4 followed by `ra' restores the 4th difference -region in buffer A (if it was previously written over via the command -`a'). - - Some commands take negative prefix arguments as well. For instance, -typing `-' and then `j' will make the last difference region current. -Typing `-2' then `j' makes the penultimate difference region current, -etc. - - Without the prefix argument, all commands operate on the currently -selected difference region. You can make any difference region current -using the various commands explained below. - - For some commands, the actual value of the prefix argument is -immaterial. However, if supplied, the prefix argument may modify the -command (see `ga', `gb', and `gc'). - -* Menu: - -* Quick Help Commands:: Frequently used commands. -* Other Session Commands:: Commands that are not bound to keys. - - -File: ediff.info, Node: Quick Help Commands, Next: Other Session Commands, Up: Session Commands - -3.1 Quick Help Commands -======================= - -`?' - Toggles the Ediff Quick Help window ON and OFF. - -`G' - Prepares a mail buffer for sending a praise or a curse to the - Ediff maintainer. - -`E' - Brings up the top node of this manual, where you can find further - information on the various Ediff functions and advanced issues, - such as customization, session groups, etc. - -`v' - Scrolls up buffers A and B (and buffer C where appropriate) in a - coordinated fashion. - -`V' - Scrolls the buffers down. - -`<' - Scrolls the buffers to the left simultaneously. - -`>' - Scrolls buffers to the right. - -`wd' - Saves the output from the diff utility, for further reference. - - With prefix argument, saves the plain output from `diff' (see - `ediff-diff-program' and `ediff-diff-options'). Without the - argument, it saves customized `diff' output (see - `ediff-custom-diff-program' and `ediff-custom-diff-options'), if - it is available. - -`wa' - Saves buffer A, if it was modified. - -`wb' - Saves buffer B, if it was modified. - -`wc' - Saves buffer C, if it was modified (if you are in a session that - compares three files simultaneously). - -`a' - _In comparison sessions:_ Copies the current difference region (or - the region specified as the prefix to this command) from buffer A - to buffer B. Ediff saves the old contents of buffer B's region; - it can be restored via the command `rb', which see. - - _In merge sessions:_ Copies the current difference region (or the - region specified as the prefix to this command) from buffer A to - the merge buffer. The old contents of this region in buffer C can - be restored via the command `r'. - -`b' - Works similarly, but copies the current difference region from - buffer B to buffer A (in _comparison sessions_) or the merge - buffer (in _merge sessions_). - - Ediff saves the old contents of the difference region copied over; - it can be reinstated via the command `ra' in comparison sessions - and `r' in merge sessions. - -`ab' - Copies the current difference region (or the region specified as - the prefix to this command) from buffer A to buffer B. This (and - the next five) command is enabled only in sessions that compare - three files simultaneously. The old region in buffer B is saved - and can be restored via the command `rb'. - -`ac' - Copies the difference region from buffer A to buffer C. The old - region in buffer C is saved and can be restored via the command - `rc'. - -`ba' - Copies the difference region from buffer B to buffer A. The old - region in buffer A is saved and can be restored via the command - `ra'. - -`bc' - Copies the difference region from buffer B to buffer C. The - command `rc' undoes this. - -`ca' - Copies the difference region from buffer C to buffer A. The - command `ra' undoes this. - -`cb' - Copies the difference region from buffer C to buffer B. The - command `rb' undoes this. - -`p' -`DEL' - Makes the previous difference region current. - -`n' -`SPC' - Makes the next difference region current. - -`j' -`-j' -`Nj' - Makes the very first difference region current. - - `-j' makes the last region current. Typing a number, N, and then - `j' makes the difference region N current. Typing -N (a negative - number) then `j' makes current the region Last - N. - -`ga' - Makes current the difference region closest to the position of the - point in buffer A. - - However, with a prefix argument, Ediff would position all variants - around the area indicated by the current point in buffer A: if the - point is inside a difference region, then the variants will be - positioned at this difference region. If the point is not in any - difference region, then it is in an area where all variants agree - with each other. In this case, the variants will be positioned so - that each would display this area (of agreement). - -`gb' - Makes current the difference region closest to the position of the - point in buffer B. - - With a prefix argument, behaves like `ga', but with respect to - buffer B. - -`gc' - _In merge sessions:_ makes current the difference region closest - to the point in the merge buffer. - - _In 3-file comparison sessions:_ makes current the region closest - to the point in buffer C. - - With a prefix argument, behaves like `ga', but with respect to - buffer C. - -`!' - Recomputes the difference regions, bringing them up to date. This - is often needed because it is common to do all sorts of editing - during Ediff sessions, so after a while, the highlighted - difference regions may no longer reflect the actual differences - among the buffers. - -`*' - Forces refinement of the current difference region, which - highlights the exact words of disagreement among the buffers. - With a negative prefix argument, unhighlights the current region. - - Forceful refinement may be needed if Ediff encounters a difference - region that is larger than `ediff-auto-refine-limit'. In this - situation, Ediff doesn't do automatic refinement in order to - improve response time. (Ediff doesn't auto-refine on dumb - terminals as well, but `*' still works there. However, the only - useful piece of information it can tell you is whether or not the - difference regions disagree only in the amount of white space.) - - This command is also useful when the highlighted fine differences - are no longer current, due to user editing. - -`m' - Displays the current Ediff session in a frame as wide as the - physical display. This is useful when comparing files - side-by-side. Typing `m' again restores the original size of the - frame. - -`|' - Toggles the horizontal/vertical split of the Ediff display. - Horizontal split is convenient when it is possible to compare files - side-by-side. If the frame in which files are displayed is too - narrow and lines are cut off, typing `m' may help some. - -`@' - Toggles auto-refinement of difference regions (i.e., automatic - highlighting of the exact words that differ among the variants). - Auto-refinement is turned off on devices where Emacs doesn't - support highlighting. - - On slow machines, it may be advantageous to turn auto-refinement - off. The user can always forcefully refine specific difference - regions by typing `*'. - -`h' - Cycles between full highlighting, the mode where fine differences - are not highlighted (but computed), and the mode where - highlighting is done with ASCII strings. The latter is not really - recommended, unless on a dumb TTY. - -`r' - Restores the old contents of the region in the merge buffer. (If - you copied a difference region from buffer A or B into the merge - buffer using the commands `a' or `b', Ediff saves the old contents - of the region in case you change your mind.) - - This command is enabled in merge sessions only. - -`ra' - Restores the old contents of the current difference region in - buffer A, which was previously saved when the user invoked one of - these commands: `b', `ba', `ca', which see. This command is - enabled in comparison sessions only. - -`rb' - Restores the old contents of the current difference region in - buffer B, which was previously saved when the user invoked one of - these commands: `a', `ab', `cb', which see. This command is - enabled in comparison sessions only. - -`rc' - Restores the old contents of the current difference region in - buffer C, which was previously saved when the user invoked one of - these commands: `ac', `bc', which see. This command is enabled in - 3-file comparison sessions only. - -`##' - Tell Ediff to skip over regions that disagree among themselves - only in the amount of white space and line breaks. - - Even though such regions will be skipped over, you can still jump - to any one of them by typing the region number and then `j'. - Typing `##' again puts Ediff back in the original state. - -`#c' - Toggle case sensitivity in the diff program. All diffs are - recomputed. Case sensitivity is controlled by the variables - `ediff-ignore-case-option', `ediff-ignore-case-option3', and - `ediff-ignore-case', which are explained elsewhere. - -`#h' -`#f' - Ediff works hard to ameliorate the effects of boredom in the - workplace... - - Quite often differences are due to identical replacements (e.g., - the word `foo' is replaced with the word `bar' everywhere). If - the number of regions with such boring differences exceeds your - tolerance threshold, you may be tempted to tell Ediff to skip - these regions altogether (you will still be able to jump to them - via the command `j'). The above commands, `#h' and `#f', may well - save your day! - - `#h' prompts you to specify regular expressions for each variant. - Difference regions where each variant's region matches the - corresponding regular expression will be skipped from then on. - (You can also tell Ediff to skip regions where at least one - variant matches its regular expression.) - - `#f' does dual job: it focuses on regions that match the - corresponding regular expressions. All other regions will be - skipped over. *Note Selective Browsing::, for more. - -`A' - Toggles the read-only property in buffer A. If file A is under - version control and is checked in, it is checked out (with your - permission). - -`B' - Toggles the read-only property in buffer B. If file B is under - version control and is checked in, it is checked out. - -`C' - Toggles the read-only property in buffer C (in 3-file comparison - sessions). If file C is under version control and is checked in, - it is checked out. - -`~' - Swaps the windows where buffers A and B are displayed. If you are - comparing three buffers at once, then this command would rotate - the windows among buffers A, B, and C. - -`i' - Displays all kinds of useful data about the current Ediff session. - -`D' - Runs `ediff-custom-diff-program' on the variants and displays the - buffer containing the output. This is useful when you must send - the output to your Mom. - - With a prefix argument, displays the plain `diff' output. *Note - Patch and Diff Programs::, for details. - -`R' - Displays a list of currently active Ediff sessions--the Ediff - Registry. You can then restart any of these sessions by either - clicking on a session record or by putting the cursor over it and - then typing the return key. - - (Some poor souls leave so many active Ediff sessions around that - they loose track of them completely... The `R' command is - designed to save these people from the recently discovered Ediff - Proficiency Syndrome.) - - Typing `R' brings up Ediff Registry only if it is typed into an - Ediff Control Panel. If you don't have a control panel handy, - type this in the minibuffer: `M-x eregistry'. *Note Registry of - Ediff Sessions::. - -`M' - Shows the session group buffer that invoked the current Ediff - session. *Note Session Groups::, for more information on session - groups. - -`z' - Suspends the current Ediff session. (If you develop a condition - known as Repetitive Ediff Injury--a serious but curable - illness--you must change your current activity. This command - tries hard to hide all Ediff-related buffers.) - - The easiest way to resume a suspended Ediff session is through the - registry of active sessions. *Note Registry of Ediff Sessions::, - for details. - -`q' - Terminates this Ediff session. With a prefix argument - (e.g.,`1q'), asks if you also want to delete the buffers of the - variants. Modified files and the results of merges are never - deleted. - -`%' - Toggles narrowing in Ediff buffers. Ediff buffers may be narrowed - if you are comparing only parts of these buffers via the commands - `ediff-windows-*' and `ediff-regions-*', which see. - -`C-l' - Restores the usual Ediff window setup. This is the quickest way - to resume an Ediff session, but it works only if the control panel - of that session is visible. - -`$$' - While merging with an ancestor file, Ediff is determined to reduce - user's wear and tear by saving him and her much of unproductive, - repetitive typing. If it notices that, say, file A's difference - region is identical to the same difference region in the ancestor - file, then the merge buffer will automatically get the difference - region taken from buffer B. The rationale is that this difference - region in buffer A is as old as that in the ancestor buffer, so - the contents of that region in buffer B represents real change. - - You may want to ignore such `obvious' merges and concentrate on - difference regions where both files `clash' with the ancestor, - since this means that two different people have been changing this - region independently and they had different ideas on how to do - this. - - The above command does this for you by skipping the regions where - only one of the variants clashes with the ancestor but the other - variant agrees with it. Typing `$$' again undoes this setting. - -`$*' - When merging files with large number of differences, it is - sometimes convenient to be able to skip the difference regions for - which you already decided which variant is most appropriate. - Typing `$*' will accomplish precisely this. - - To be more precise, this toggles the check for whether the current - merge is identical to its default setting, as originally decided - by Ediff. For instance, if Ediff is merging according to the - `combined' policy, then the merge region is skipped over if it is - different from the combination of the regions in buffers A and B. - (Warning: swapping buffers A and B will confuse things in this - respect). If the merge region is marked as `prefer-A' then this - region will be skipped if it differs from the current difference - region in buffer A, etc. - -`/' - Displays the ancestor file during merges. - -`&' - In some situations, such as when one of the files agrees with the - ancestor file on a difference region and the other doesn't, Ediff - knows what to do: it copies the current difference region from the - second buffer into the merge buffer. - - In other cases, the right course of action is not that clearcut, - and Ediff would use a default action. The above command changes - the default action. The default action can be `default-A' (choose - the region from buffer A), `default-B' (choose the region from - buffer B), or `combined' (combine the regions from the two - buffers). *Note Merging and diff3::, for further details. - - The command `&' also affects the regions in the merge buffers that - have `default-A', `default-B', or `combined' status, provided they - weren't changed with respect to the original. For instance, if - such a region has the status `default-A' then changing the default - action to `default-B' will also replace this merge-buffer's region - with the corresponding region from buffer B. - -`s' - Causes the merge window shrink to its minimum size, thereby - exposing as much of the variant buffers as possible. Typing `s' - again restores the original size of that window. - - With a positive prefix argument, this command enlarges the merge - window. E.g., `4s' increases the size of the window by about 4 - lines, if possible. With a negative numeric argument, the size of - the merge window shrinks by that many lines, if possible. Thus, - `-s' shrinks the window by about 1 line and `-3s' by about 3 lines. - - This command is intended only for temporary viewing; therefore, - Ediff restores window C to its original size whenever it makes any - other change in the window configuration. However, redisplaying - (`C-l') or jumping to another difference does not affect window - C's size. - - The split between the merge window and the variant windows is - controlled by the variable `ediff-merge-window-share', which see. - -`+' - Combines the difference regions from buffers A and B and copies the - result into the merge buffer. *Note Merging and diff3::, and the - variables `ediff-combine-diffs' and `ediff-combination-pattern'. - -`=' - You may run into situations when a large chunk of text in one file - has been edited and then moved to a different place in another - file. In such a case, these two chunks of text are unlikely to - belong to the same difference region, so the refinement feature of - Ediff will not be able to tell you what exactly differs inside - these chunks. Since eyeballing large pieces of text is contrary - to human nature, Ediff has a special command to help reduce the - risk of developing a cataract. - - In other situations, the currently highlighted region might be big - and you might want to reconcile of them interactively. - - All of this can be done with the above command, `=', which - compares regions within Ediff buffers. Typing `=' creates a child - Ediff session for comparing regions in buffers A, B, or C as - follows. - - First, you will be asked whether you want to compare the fine - differences between the currently highlighted buffers on a - word-by-word basis. If you accept, a child Ediff session will - start using the currently highlighted regions. Ediff will let you - step over the differences word-wise. - - If you reject the offer, you will be asked to select regions of - your choice. - - _If you are comparing 2 files or buffers:_ Ediff will ask you to - select regions in buffers A and B. - - _If you are comparing 3 files or buffers simultaneously:_ Ediff - will ask you to choose buffers and then select regions inside - those buffers. - - _If you are merging files or buffers (with or without ancestor):_ - Ediff will ask you to choose which buffer (A or B) to compare with - the merge buffer and then select regions in those buffers. - - - -File: ediff.info, Node: Other Session Commands, Prev: Quick Help Commands, Up: Session Commands - -3.2 Other Session Commands -========================== - -The following commands can be invoked from within any Ediff session, -although some of them are not bound to a key. - -`eregistry' -`ediff-show-registry' - This command brings up the registry of active Ediff sessions. - Ediff registry is a device that can be used to resume any active - Ediff session (which may have been postponed because the user - switched to some other activity). This command is also useful for - switching between multiple active Ediff sessions that are run at - the same time. The function `eregistry' is an alias for - `ediff-show-registry'. *Note Registry of Ediff Sessions::, for - more information on this registry. - -`ediff-toggle-multiframe' - Changes the display from the multi-frame mode (where the quick - help window is in a separate frame) to the single-frame mode - (where all Ediff buffers share the same frame), and vice versa. - See `ediff-window-setup-function' for details on how to make - either of these modes the default one. - - This function can also be invoked from the Menubar. However, in - some cases, the change will take place only after you execute one - of the Ediff commands, such as going to the next difference or - redisplaying. - -`ediff-toggle-use-toolbar' - Available in XEmacs only. The Ediff toolbar provides quick access - to some of the common Ediff functions. This function toggles the - display of the toolbar. If invoked from the menubar, the function - may take sometimes effect only after you execute an Ediff command, - such as going to the next difference. - -`ediff-use-toolbar-p' - The use of the toolbar can also be specified via the variable - `ediff-use-toolbar-p' (default is `t'). This variable can be set - only in `.emacs' -- do *not* change it interactively. Use the - function `ediff-toggle-use-toolbar' instead. - -`ediff-revert-buffers-then-recompute-diffs' - This command reverts the buffers you are comparing and recomputes - their differences. It is useful when, after making changes, you - decided to make a fresh start, or if at some point you changed the - files being compared but want to discard any changes to comparison - buffers that were done since then. - - This command normally asks for confirmation before reverting files. - With a prefix argument, it reverts files without asking. - -`ediff-profile' - Ediff has an admittedly primitive (but useful) facility for - profiling Ediff's commands. It is meant for Ediff - maintenance--specifically, for making it run faster. The function - `ediff-profile' toggles profiling of ediff commands. - - -File: ediff.info, Node: Registry of Ediff Sessions, Next: Session Groups, Prev: Session Commands, Up: Top - -4 Registry of Ediff Sessions -**************************** - -Ediff maintains a registry of all its invocations that are still -_active_. This feature is very convenient for switching among active -Ediff sessions or for quickly restarting a suspended Ediff session. - - The focal point of this activity is a buffer called _*Ediff -Registry*_. You can display this buffer by typing `R' in any Ediff -Control Buffer or Session Group Buffer (*note Session Groups::), or by -typing `M-x eregistry' into the Minibuffer. The latter would be the -fastest way to bring up the registry buffer if no control or group -buffer is displayed in any of the visible Emacs windows. If you are in -a habit of running multiple long Ediff sessions and often need to -suspend, resume, or switch between them, it may be a good idea to have -the registry buffer permanently displayed in a separate, dedicated -window. - - The registry buffer has several convenient key bindings. For -instance, clicking mouse button 2 or typing `RET' or `v' over any -session record resumes that session. Session records in the registry -buffer provide a fairly complete description of each session, so it is -usually easy to identify the right session to resume. - - Other useful commands are bound to `SPC' (next registry record) and -`DEL' (previous registry record). There are other commands as well, -but you don't need to memorize them, since they are listed at the top of -the registry buffer. - - -File: ediff.info, Node: Session Groups, Next: Remote and Compressed Files, Prev: Registry of Ediff Sessions, Up: Top - -5 Session Groups -**************** - -Several major entries of Ediff perform comparison and merging on -directories. On entering `ediff-directories', `ediff-directories3', -`ediff-merge-directories', `ediff-merge-directories-with-ancestor', -`ediff-directory-revisions', `ediff-merge-directory-revisions', or -`ediff-merge-directory-revisions-with-ancestor', the user is presented -with a Dired-like buffer that lists files common to the directories -involved along with their sizes. (The list of common files can be -further filtered through a regular expression, which the user is -prompted for.) We call this buffer _Session Group Panel_ because all -Ediff sessions associated with the listed files will have this buffer -as a common focal point. - - Clicking button 2 or typing `RET' or `v' over a record describing -files invokes Ediff in the appropriate mode on these files. You can -come back to the session group buffer associated with a particular -invocation of Ediff by typing `M' in Ediff control buffer of that -invocation. - - Many commands are available in the session group buffer; some are -applicable only to certain types of work. The relevant commands are -always listed at the top of each session group buffer, so there is no -need to memorize them. - - In directory comparison or merging, a session group panel displays -only the files common to all directories involved. The differences are -kept in a separate _directory difference buffer_ and are conveniently -displayed by typing `D' to the corresponding session group panel. -Thus, as an added benefit, Ediff can be used to compare the contents of -up to three directories. - - Sometimes it is desirable to copy some files from one directory to -another without exiting Ediff. The _directory difference buffer_, which -is displayed by typing `D' as discussed above, can be used for this -purpose. If a file is, say, in Ediff's Directory A, but is missing in -Ediff's Directory B (Ediff will refuse to override existing files), then -typing `C' or clicking mouse button 2 over that file (which must be -displayed in directory difference buffer) will copy that file from -Directory A to Directory B. - - Session records in session group panels are also marked with `+', for -active sessions, and with `-', for finished sessions. - - Sometimes, it is convenient to exclude certain sessions from a group. -Usually this happens when the user doesn't intend to run Ediff of -certain files in the group, and the corresponding session records just -add clutter to the session group buffer. To help alleviate this -problem, the user can type `h' to mark a session as a candidate for -exclusion and `x' to actually hide the marked sessions. There actions -are reversible: with a prefix argument, `h' unmarks the session under -the cursor, and `x' brings the hidden sessions into the view (`x' -doesn't unmark them, though, so the user has to explicitly unmark the -sessions of interest). - - Group sessions also understand the command `m', which marks sessions -for future operations (other than hiding) on a group of sessions. At -present, the only such group-level operation is the creation of a -multi-file patch. - - For group sessions created to merge files, Ediff can store all merges -automatically in a directory. The user is asked to specify such -directory if the value of `ediff-autostore-merges' is non-`nil'. If -the value is `nil', nothing is done to the merge buffers--it will be -the user's responsibility to save them. If the value is `t', the user -will be asked where to save the merge buffers in all merge jobs, even -those that do not originate from a session group. It the value is -neither `nil' nor `t', the merge buffer is saved _only_ if this merge -session was invoked from a session group. This behavior is implemented -in the function `ediff-maybe-save-and-delete-merge', which is a hook in -`ediff-quit-merge-hook'. The user can supply a different hook, if -necessary. - - The variable `ediff-autostore-merges' is buffer-local, so it can be -set on a per-buffer basis. Therefore, use `setq-default' to change -this variable globally. - - A multi-file patch is a concatenated output of several runs of the -Unix `diff' command (some versions of `diff' let you create a -multi-file patch in just one run). Ediff facilitates creation of -multi-file patches as follows. If you are in a session group buffer -created in response to `ediff-directories' or -`ediff-directory-revisions', you can mark (by typing `m') the desired -Ediff sessions and then type `P' to create a multi-file patch of those -marked sessions. Ediff will then display a buffer containing the patch. -The patch is generated by invoking `diff' on all marked individual -sessions (represented by files) and session groups (represented by -directories). Ediff will also recursively descend into any _unmarked_ -session group and will search for marked sessions there. In this way, -you can create multi-file patches that span file subtrees that grow out -of any given directory. - - In an `ediff-directories' session, it is enough to just mark the -requisite sessions. In `ediff-directory-revisions' revisions, the -marked sessions must also be active, or else Ediff will refuse to -produce a multi-file patch. This is because, in the latter-style -sessions, there are many ways to create diff output, and it is easier -to handle by running Ediff on the inactive sessions. - - Last, but not least, by typing `==', you can quickly find out which -sessions have identical entries, so you won't have to run Ediff on those -sessions. This, however, works only on local, uncompressed files. For -compressed or remote files, this command won't report anything. -Likewise, you can use `=h' to mark sessions with identical entries for -hiding or, with `=m', for further operations. - - The comparison operations `==', `=h', and `=m' can recurse into -subdirectories to see if they have identical contents (so the user will -not need to descend into those subdirectories manually). These commands -ask the user whether or not to do a recursive descent. - - -File: ediff.info, Node: Remote and Compressed Files, Next: Customization, Prev: Session Groups, Up: Top - -6 Remote and Compressed Files -***************************** - -Ediff works with remote, compressed, and encrypted files. Ediff -supports `ange-ftp.el', `jka-compr.el', `uncompress.el' and -`crypt++.el', but it may work with other similar packages as well. -This means that you can compare files residing on another machine, or -you can apply a patch to a file on another machine. Even the patch -itself can be a remote file! - - When patching compressed or remote files, Ediff does not rename the -source file (unlike what the `patch' utility would usually do). -Instead, the source file retains its name and the result of applying -the patch is placed in a temporary file that has the suffix `_patched' -attached. Generally, this applies to files that are handled using -black magic, such as special file handlers (ange-ftp and some -compression and encryption packages also use this method). - - Regular files are treated by the `patch' utility in the usual manner, -i.e., the original is renamed into `source-name.orig' and the result of -the patch is placed into the file source-name (`_orig' is used on -systems like VMS, DOS, etc.) - - -File: ediff.info, Node: Customization, Next: Credits, Prev: Remote and Compressed Files, Up: Top - -7 Customization -*************** - -Ediff has a rather self-explanatory interface, and in most cases you -won't need to change anything. However, should the need arise, there -are extensive facilities for changing the default behavior. - - Most of the customization can be done by setting various variables -in the `.emacs' file. Some customization (mostly window-related -customization and faces) can be done by putting appropriate lines in -`.Xdefaults', `.xrdb', or whatever X resource file is in use. - - With respect to the latter, please note that the X resource for -Ediff customization is `Ediff', _not_ `emacs'. *Note Window and Frame -Configuration::, *Note Highlighting Difference Regions::, for further -details. Please also refer to Emacs manual for the information on how -to set Emacs X resources. - -* Menu: - -* Hooks:: Customization via the hooks. -* Quick Help Customization:: How to customize Ediff's quick help feature. -* Window and Frame Configuration:: Controlling the way Ediff displays things. -* Selective Browsing:: Advanced browsing through difference regions. -* Highlighting Difference Regions:: Controlling highlighting. -* Narrowing:: Comparing regions, windows, etc. -* Refinement of Difference Regions:: How to control the refinement process. -* Patch and Diff Programs:: Changing the utilities that compute differences - and apply patches. -* Merging and diff3:: How to customize Ediff in its Merge Mode. -* Support for Version Control:: Changing the version control package. - You are not likely to do that. -* Customizing the Mode Line:: Changing the look of the mode line in Ediff. -* Miscellaneous:: Other customization. -* Notes on Heavy-duty Customization:: Customization for the gurus. - - -File: ediff.info, Node: Hooks, Next: Quick Help Customization, Prev: Customization, Up: Customization - -7.1 Hooks -========= - -The bulk of customization can be done via the following hooks: - -`ediff-load-hook' - This hook can be used to change defaults after Ediff is loaded. - -`ediff-before-setup-hook' - Hook that is run just before Ediff rearranges windows to its - liking. Can be used to save windows configuration. - -`ediff-keymap-setup-hook' - This hook can be used to alter bindings in Ediff's keymap, - `ediff-mode-map'. These hooks are run right after the default - bindings are set but before `ediff-load-hook'. The regular user - needs not be concerned with this hook--it is provided for - implementors of other Emacs packages built on top of Ediff. - -`ediff-before-setup-windows-hook' -`ediff-after-setup-windows-hook' - These two hooks are called before and after Ediff sets up its - window configuration. These hooks are run each time Ediff - rearranges windows to its liking. This happens whenever it detects - that the user changed the windows setup. - -`ediff-suspend-hook' -`ediff-quit-hook' - These two hooks are run when you suspend or quit Ediff. They can - be used to set desired window configurations, delete files Ediff - didn't want to clean up after exiting, etc. - - By default, `ediff-quit-hook' holds one hook function, - `ediff-cleanup-mess', which cleans after Ediff, as appropriate in - most cases. You probably won't want to change it, but you might - want to add other hook functions. - - Keep in mind that hooks executing before `ediff-cleanup-mess' start - in `ediff-control-buffer;' they should also leave - `ediff-control-buffer' as the current buffer when they finish. - Hooks that are executed after `ediff-cleanup-mess' should expect - the current buffer be either buffer A or buffer B. - `ediff-cleanup-mess' doesn't kill the buffers being compared or - merged (see `ediff-cleanup-hook', below). - -`ediff-cleanup-hook' - This hook is run just before `ediff-quit-hook'. This is a good - place to do various cleanups, such as deleting the variant buffers. - Ediff provides a function, `ediff-janitor', as one such possible - hook, which you can add to `ediff-cleanup-hook' with `add-hooks'. - - This function kills buffers A, B, and, possibly, C, if these - buffers aren't modified. In merge jobs, buffer C is never - deleted. However, the side effect of using this function is that - you may not be able to compare the same buffer in two separate - Ediff sessions: quitting one of them will delete this buffer in - another session as well. - -`ediff-quit-merge-hook' - This hook is called when Ediff quits a merge job. By default, the - value is `ediff-maybe-save-and-delete-merge', which is a function - that attempts to save the merge buffer according to the value of - `ediff-autostore-merges', as described later. - -`ediff-before-setup-control-frame-hook' -`ediff-after-setup-control-frame-hook' - These two hooks run before and after Ediff sets up the control - frame. They can be used to relocate Ediff control frame when - Ediff runs in a multiframe mode (i.e., when the control buffer is - in its own dedicated frame). Be aware that many variables that - drive Ediff are local to Ediff Control Panel - (`ediff-control-buffer'), which requires special care in writing - these hooks. Take a look at `ediff-default-suspend-hook' and - `ediff-default-quit-hook' to see what's involved. - -`ediff-startup-hook' - This hook is run at the end of Ediff startup. - -`ediff-select-hook' - This hook is run after Ediff selects the next difference region. - -`ediff-unselect-hook' - This hook is run after Ediff unselects the current difference - region. - -`ediff-prepare-buffer-hook' - This hook is run for each Ediff buffer (A, B, C) right after the - buffer is arranged. - -`ediff-display-help-hook' - Ediff runs this hook each time after setting up the help message. - It can be used to alter the help message for custom packages that - run on top of Ediff. - -`ediff-mode-hook' - This hook is run just after Ediff mode is set up in the control - buffer. This is done before any Ediff window is created. You can - use it to set local variables that alter the look of the display. - -`ediff-registry-setup-hook' - Hooks run after setting up the registry for all active Ediff - session. *Note Session Groups::, for details. - -`ediff-before-session-group-setup-hook' - Hooks run before setting up a control panel for a group of related - Ediff sessions. Can be used, for example, to save window - configuration to restore later. - -`ediff-after-session-group-setup-hook' - Hooks run after setting up a control panel for a group of related - Ediff sessions. *Note Session Groups::, for details. - -`ediff-quit-session-group-hook' - Hooks run just before exiting a session group. - -`ediff-meta-buffer-keymap-setup-hook' - Hooks run just after setting up the `ediff-meta-buffer-map' -- the - map that controls key bindings in the meta buffer. Since - `ediff-meta-buffer-map' is a local variable, you can set different - bindings for different kinds of meta buffers. - - -File: ediff.info, Node: Quick Help Customization, Next: Window and Frame Configuration, Prev: Hooks, Up: Customization - -7.2 Quick Help Customization -============================ - -Ediff provides quick help using its control panel window. Since this -window takes a fair share of the screen real estate, you can toggle it -off by typing `?'. The control window will then shrink to just one -line and a mode line, displaying a short help message. - - The variable `ediff-use-long-help-message' tells Ediff whether you -use the short message or the long one. By default, it is set to `nil', -meaning that the short message is used. Set this to `t', if you want -Ediff to use the long message by default. This property can always be -changed interactively, by typing `?' into Ediff Control Buffer. - - If you want to change the appearance of the help message on a -per-buffer basis, you must use `ediff-startup-hook' to change the value -of the variable `ediff-help-message', which is local to -`ediff-control-buffer'. - - -File: ediff.info, Node: Window and Frame Configuration, Next: Selective Browsing, Prev: Quick Help Customization, Up: Customization - -7.3 Window and Frame Configuration -================================== - -On a non-windowing display, Ediff sets things up in one frame, splitting -it between a small control window and the windows for buffers A, B, and -C. The split between these windows can be horizontal or vertical, -which can be changed interactively by typing `|' while the cursor is in -the control window. - - On a window display, Ediff sets up a dedicated frame for Ediff -Control Panel and then it chooses windows as follows: If one of the -buffers is invisible, it is displayed in the currently selected frame. -If a buffer is visible, it is displayed in the frame where it is -visible. If, according to the above criteria, the two buffers fall -into the same frame, then so be it--the frame will be shared by the -two. The same algorithm works when you type `C-l' (`ediff-recenter'), -`p' (`ediff-previous-difference'), `n' (`ediff-next-difference'), etc. - - The above behavior also depends on whether the current frame is -splittable, dedicated, etc. Unfortunately, the margin of this book is -too narrow to present the details of this remarkable algorithm. - - The upshot of all this is that you can compare buffers in one frame -or in different frames. The former is done by default, while the -latter can be achieved by arranging buffers A, B (and C, if applicable) -to be seen in different frames. Ediff respects these arrangements, -automatically adapting itself to the multi-frame mode. - - Ediff uses the following variables to set up its control panel -(a.k.a. control buffer, a.k.a. quick help window): - -`ediff-control-frame-parameters' - You can change or augment this variable including the font, color, - etc. The X resource name of Ediff Control Panel frames is - `Ediff'. Under X-windows, you can use this name to set up - preferences in your `~/.Xdefaults', `~/.xrdb', or whatever X - resource file is in use. Usually this is preferable to changing - `ediff-control-frame-parameters' directly. For instance, you can - specify in `~/.Xdefaults' the color of the control frame using the - resource `Ediff*background'. - - In general, any X resource pertaining the control frame can be - reached via the prefix `Ediff*'. - -`ediff-control-frame-position-function' - The preferred way of specifying the position of the control frame - is by setting the variable `ediff-control-frame-position-function' - to an appropriate function. The default value of this variable is - `ediff-make-frame-position'. This function places the control - frame in the vicinity of the North-East corner of the frame - displaying buffer A. - - - The following variables can be used to adjust the location produced -by `ediff-make-frame-position' and for related customization. - -`ediff-narrow-control-frame-leftward-shift' - Specifies the number of characters for shifting the control frame - from the rightmost edge of frame A when the control frame is - displayed as a small window. - -`ediff-wide-control-frame-rightward-shift' - Specifies the rightward shift of the control frame from the left - edge of frame A when the control frame shows the full menu of - options. - -`ediff-control-frame-upward-shift' - Specifies the number of pixels for the upward shift of the control - frame. - -`ediff-prefer-iconified-control-frame' - If this variable is `t', the control frame becomes iconified - automatically when you toggle the quick help message off. This - saves valuable real estate on the screen. Toggling help back will - deiconify the control frame. - - To start Ediff with an iconified Control Panel, you should set this - variable to `t' and `ediff-prefer-long-help-message' to `nil' - (*note Quick Help Customization::). This behavior is useful only - if icons are allowed to accept keybord input (which depend on the - window manager and other factors). - - To make more creative changes in the way Ediff sets up windows, you -can rewrite the function `ediff-setup-windows'. However, we believe -that detaching Ediff Control Panel from the rest and making it into a -separate frame offers an important opportunity by allowing you to -iconify that frame. The icon will usually accept all of the Ediff -commands, but will free up valuable real estate on your screen (this may -depend on your window manager, though). - - The following variable controls how windows are set up: - -`ediff-window-setup-function' - The multiframe setup is done by the - `ediff-setup-windows-multiframe' function, which is the default on - windowing displays. The plain setup, one where all windows are - always in one frame, is done by `ediff-setup-windows-plain', which - is the default on a non-windowing display (or in an xterm window). - In fact, under Emacs, you can switch freely between these two - setups by executing the command `ediff-toggle-multiframe' using - the Minibuffer of the Menubar. - - If you don't like any of these setups, write your own function. - See the documentation for `ediff-window-setup-function' for the - basic guidelines. However, writing window setups is not easy, so - you should first take a close look at `ediff-setup-windows-plain' - and `ediff-setup-windows-multiframe'. - - You can run multiple Ediff sessions at once, by invoking Ediff -several times without exiting previous Ediff sessions. Different -sessions may even operate on the same pair of files. - - Each session has its own Ediff Control Panel and all the regarding a -particular session is local to the associated control panel buffer. You -can switch between sessions by suspending one session and then switching -to another control panel. (Different control panel buffers are -distinguished by a numerical suffix, e.g., `Ediff Control Panel<3>'.) - - -File: ediff.info, Node: Selective Browsing, Next: Highlighting Difference Regions, Prev: Window and Frame Configuration, Up: Customization - -7.4 Selective Browsing -====================== - -Sometimes it is convenient to be able to step through only some -difference regions, those that match certain regular expressions, and -to ignore all others. On other occasions, you may want to ignore -difference regions that match some regular expressions, and to look -only at the rest. - - The commands `#f' and `#h' let you do precisely this. - - Typing `#f' lets you specify regular expressions that match -difference regions you want to focus on. We shall call these regular -expressions REGEXP-A, REGEXP-B and REGEXP-C. Ediff will then start -stepping through only those difference regions where the region in -buffer A matches REGEXP-A and/or the region in buffer B matches -REGEXP-B, etc. Whether `and' or `or' will be used depends on how you -respond to a question. - - When scanning difference regions for the aforesaid regular -expressions, Ediff narrows the buffers to those regions. This means -that you can use the expressions `\`' and `\'' to tie search to the -beginning or end of the difference regions. - - On the other hand, typing `#h' lets you specify (hide) uninteresting -regions. That is, if a difference region in buffer A matches REGEXP-A, -the corresponding region in buffer B matches REGEXP-B and (if -applicable) buffer C's region matches REGEXP-C, then the region will be -ignored by the commands `n'/ (`ediff-next-difference') and -`p'/ (`ediff-previous-difference') commands. - - Typing `#f' and `#h' toggles selective browsing on and off. - - Note that selective browsing affects only `ediff-next-difference' -and `ediff-previous-difference', i.e., the commands `n'/ and -`p'/. `#f' and `#h' do not change the position of the point in -the buffers. And you can still jump directly (using `j') to any -numbered difference. - - Users can supply their own functions to specify how Ediff should do -selective browsing. To change the default Ediff function, add a -function to `ediff-load-hook' which will do the following assignments: - - (setq ediff-hide-regexp-matches-function 'your-hide-function) - (setq ediff-focus-on-regexp-matches-function 'your-focus-function) - - *Useful hint*: To specify a regexp that matches everything, don't -simply type in response to a prompt. Typing tells Ediff to -accept the default value, which may not be what you want. Instead, you -should enter something like <^> or <$>. These match every line. - - You can use the status command, `i', to find out whether selective -browsing is currently in effect. - - The regular expressions you specified are kept in the local variables -`ediff-regexp-focus-A', `ediff-regexp-focus-B', `ediff-regexp-focus-C', -`ediff-regexp-hide-A', `ediff-regexp-hide-B', `ediff-regexp-hide-C'. -Their default value is the empty string (i.e., nothing is hidden or -focused on). To change the default, set these variables in `.emacs' -using `setq-default'. - - In addition to the ability to ignore regions that match regular -expressions, Ediff can be ordered to start skipping over certain -"uninteresting" difference regions. This is controlled by the following -variable: - -`ediff-ignore-similar-regions' - If `t', causes Ediff to skip over "uninteresting" difference - regions, which are the regions where the variants differ only in - the amount of the white space and newlines. This feature can be - toggled on/off interactively, via the command `##'. - - *Please note:* in order for this feature to work, auto-refining of -difference regions must be on, since otherwise Ediff won't know if there -are fine differences between regions. On devices where Emacs can -display faces, auto-refining is a default, but it is not turned on by -default on text-only terminals. In that case, you must explicitly turn -auto-refining on (such as, by typing `@'). - - *Reassurance:* If many such uninteresting regions appear in a row, -Ediff may take a long time to skip over them because it has to compute -fine differences of all intermediate regions. This delay does not -indicate any problem. - - Finally, Ediff can be told to ignore the case of the letters. This -behavior can be toggled with `#c' and it is controlled with three -variables: Toggle case sensitivity in the diff program. All diffs are -recomputed. Case sensitivity is controlled by the variables -`ediff-ignore-case-option', `ediff-ignore-case-option3', and -`ediff-ignore-case'. - - The variable `ediff-ignore-case-option' specifies the option to pass -to the diff program for comparing two files or buffers. For GNU `diff', -this option is `"-i"'. The variable `ediff-ignore-case-option3' -specifies the option to pass to the `diff3' program in order to make it -case-insensitive. GNU `diff3' does not have such an option, so when -merging or comparing three files with this program, ignoring the letter -case is not supported. - - The variable `ediff-ignore-case' controls whether Ediff starts out by -ignoring letter case or not. It can be set in `.emacs' using -`setq-default'. - - -File: ediff.info, Node: Highlighting Difference Regions, Next: Narrowing, Prev: Selective Browsing, Up: Customization - -7.5 Highlighting Difference Regions -=================================== - -The following variables control the way Ediff highlights difference -regions: - -`ediff-before-flag-bol' -`ediff-after-flag-eol' -`ediff-before-flag-mol' -`ediff-after-flag-mol' - These variables hold strings that Ediff uses to mark the beginning - and the end of the differences found in files A, B, and C on - devices where Emacs cannot display faces. Ediff uses different - flags to highlight regions that begin/end at the beginning/end of - a line or in a middle of a line. - -`ediff-current-diff-face-A' -`ediff-current-diff-face-B' -`ediff-current-diff-face-C' - Ediff uses these faces to highlight current differences on devices - where Emacs can display faces. These and subsequently described - faces can be set either in `.emacs' or in `.Xdefaults'. The X - resource for Ediff is `Ediff', _not_ `emacs'. Please refer to - Emacs manual for the information on how to set X resources. - -`ediff-fine-diff-face-A' -`ediff-fine-diff-face-B' -`ediff-fine-diff-face-C' - Ediff uses these faces to show the fine differences between the - current differences regions in buffers A, B, and C, respectively. - -`ediff-even-diff-face-A' -`ediff-even-diff-face-B' -`ediff-even-diff-face-C' -`ediff-odd-diff-face-A' -`ediff-odd-diff-face-B' -`ediff-odd-diff-face-C' - Non-current difference regions are displayed using these - alternating faces. The odd and the even faces are actually - identical on monochrome displays, because without colors options - are limited. So, Ediff uses italics to highlight non-current - differences. - -`ediff-force-faces' - Ediff generally can detect when Emacs is running on a device where - it can use highlighting with faces. However, if it fails to - determine that faces can be used, the user can set this variable - to `t' to make sure that Ediff uses faces to highlight differences. - -`ediff-highlight-all-diffs' - Indicates whether--on a windowind display--Ediff should highlight - differences using inserted strings (as on text-only terminals) or - using colors and highlighting. Normally, Ediff highlights all - differences, but the selected difference is highlighted more - visibly. One can cycle through various modes of highlighting by - typing `h'. By default, Ediff starts in the mode where all - difference regions are highlighted. If you prefer to start in the - mode where unselected differences are not highlighted, you should - set `ediff-highlight-all-diffs' to `nil'. Type `h' to restore - highlighting for all differences. - - Ediff lets you switch between the two modes of highlighting. That - is, you can switch interactively from highlighting using faces to - highlighting using string flags, and back. Of course, switching - has effect only under a windowing system. On a text-only terminal - or in an xterm window, the only available option is highlighting - with strings. - -If you want to change the default settings for `ediff-force-faces' and -`ediff-highlight-all-diffs', you must do it *before* Ediff is loaded. - - You can also change the defaults for the faces used to highlight the -difference regions. There are two ways to do this. The simplest and -the preferred way is to use the customization widget accessible from the -menubar. Ediff's customization group is located under "Tools", which in -turn is under "Programming". The faces that are used to highlight -difference regions are located in the "Highlighting" subgroup of the -Ediff customization group. - - The second, much more arcane, method to change default faces is to -include some Lisp code in `~/.emacs'. For instance, - - (setq ediff-current-diff-face-A - (copy-face 'bold-italic 'ediff-current-diff-face-A)) - -would use the pre-defined fase `bold-italic' to highlight the current -difference region in buffer A (this face is not a good choice, by the -way). - - If you are unhappy with just _some_ of the aspects of the default -faces, you can modify them when Ediff is being loaded using -`ediff-load-hook'. For instance: - - (add-hook 'ediff-load-hook - (lambda () - (set-face-foreground - ediff-current-diff-face-B "blue") - (set-face-background - ediff-current-diff-face-B "red") - (make-face-italic - ediff-current-diff-face-B))) - - *Please note:* to set Ediff's faces, use only `copy-face' or -`set/make-face-...' as shown above. Emacs' low-level face-manipulation -functions should be avoided. - - -File: ediff.info, Node: Narrowing, Next: Refinement of Difference Regions, Prev: Highlighting Difference Regions, Up: Customization - -7.6 Narrowing -============= - -If buffers being compared are narrowed at the time of invocation of -Ediff, `ediff-buffers' will preserve the narrowing range. However, if -`ediff-files' is invoked on the files visited by these buffers, that -would widen the buffers, since this command is defined to compare the -entire files. - - Calling `ediff-regions-linewise' or `ediff-windows-linewise', or the -corresponding `-wordwise' commands, narrows the variants to the -particular regions being compared. The original accessible ranges are -restored when you quit Ediff. During the command, you can toggle this -narrowing on and off with the `%' command. - - These two variables control this narrowing behavior: - -`ediff-start-narrowed' - If `t', Ediff narrows the display to the appropriate range when it - is invoked with an `ediff-regions...' or `ediff-windows...' - command. If `nil', these commands do not automatically narrow, - but you can still toggle narrowing on and off by typing `%'. - -`ediff-quit-widened' - Controls whether on quitting Ediff should restore the accessible - range that existed before the current invocation. - - -File: ediff.info, Node: Refinement of Difference Regions, Next: Patch and Diff Programs, Prev: Narrowing, Up: Customization - -7.7 Refinement of Difference Regions -==================================== - -Ediff has variables to control the way fine differences are -highlighted. This feature gives you control over the process of -refinement. Note that refinement ignores spaces, tabs, and newlines. - -`ediff-auto-refine' - This variable controls whether fine differences within regions are - highlighted automatically ("auto-refining"). The default is yes - (`on'). - - On a slow machine, automatic refinement may be painful. In that - case, you can turn auto-refining on or off interactively by typing - `@'. You can also turn off display of refining that has already - been done. - - When auto-refining is off, fine differences are shown only for - regions for which these differences have been computed and saved - before. If auto-refining and display of refining are both turned - off, fine differences are not shown at all. - - Typing `*' computes and displays fine differences for the current - difference region, regardless of whether auto-refining is turned - on. - -`ediff-auto-refine-limit' - If auto-refining is on, this variable limits the size of the - regions to be auto-refined. This guards against the possible - slowdown that may be caused by extraordinary large difference - regions. - - You can always refine the current region by typing `*'. - -`ediff-forward-word-function' - This variable controls how fine differences are computed. The - value must be a Lisp function that determines how the current - difference region should be split into words. - - Fine differences are computed by first splitting the current - difference region into words and then passing the result to - `ediff-diff-program'. For the default forward word function - (which is `ediff-forward-word'), a word is a string consisting of - letters, `-', or `_'; a string of punctuation symbols; a string of - digits, or a string consisting of symbols that are neither space, - nor a letter. - - This default behavior is controlled by four variables: - `ediff-word-1', ..., `ediff-word-4'. See the on-line - documentation for these variables and for the function - `ediff-forward-word' for an explanation of how to modify these - variables. - - Sometimes, when a region has too many differences between the -variants, highlighting of fine differences is inconvenient, especially -on color displays. If that is the case, type `*' with a negative -prefix argument. This unhighlights fine differences for the current -region. - - To unhighlight fine differences in all difference regions, use the -command `@'. Repeated typing of this key cycles through three -different states: auto-refining, no-auto-refining, and no-highlighting -of fine differences. - - -File: ediff.info, Node: Patch and Diff Programs, Next: Merging and diff3, Prev: Refinement of Difference Regions, Up: Customization - -7.8 Patch and Diff Programs -=========================== - -This section describes variables that specify the programs to be used -for applying patches and for computing the main difference regions (not -the fine difference regions): - -`ediff-diff-program' -`ediff-diff3-program' - These variables specify the programs to use to produce differences - and do patching. - -`ediff-diff-options' -`ediff-diff3-options' - These variables specify the options to pass to the above utilities. - - In `ediff-diff-options', it may be useful to specify options such - as `-w' that ignore certain kinds of changes. However, Ediff does - not let you use the option `-c', as it doesn't recognize this - format yet. - -`ediff-coding-system-for-read' - This variable specifies the coding system to use when reading the - output that the programs `diff3' and `diff' send to Emacs. The - default is `raw-text', and this should work fine in Unix and in - most cases under Windows NT/95/98/2000. There are `diff' programs - for which the default option doesn't work under Windows. In such - cases, `raw-text-dos' might work. If not, you will have to - experiment with other coding systems or use GNU diff. - -`ediff-patch-program' - The program to use to apply patches. Since there are certain - incompatibilities between the different versions of the patch - program, the best way to stay out of trouble is to use a - GNU-compatible version. Otherwise, you may have to tune the - values of the variables `ediff-patch-options', - `ediff-backup-specs', and `ediff-backup-extension' as described - below. - -`ediff-patch-options' - Options to pass to `ediff-patch-program'. - - Note: the `-b' and `-z' options should be specified in - `ediff-backup-specs', not in `ediff-patch-options'. - - It is recommended to pass the `-f' option to the patch program, so - it won't ask questions. However, some implementations don't - accept this option, in which case the default value of this - variable should be changed. - -`ediff-backup-extension' - Backup extension used by the patch program. Must be specified, - even if `ediff-backup-specs' is given. - -`ediff-backup-specs' - Backup directives to pass to the patch program. Ediff requires - that the old version of the file (before applying the patch) is - saved in a file named `the-patch-file.extension'. Usually - `extension' is `.orig', but this can be changed by the user, and - may also be system-dependent. Therefore, Ediff needs to know the - backup extension used by the patch program. - - Some versions of the patch program let the user specify `-b - backup-extension'. Other versions only permit `-b', which - (usually) assumes the extension `.orig'. Yet others force you to - use `-z'. - - Note that both `ediff-backup-extension' and `ediff-backup-specs' - must be properly set. If your patch program takes the option - `-b', but not `-b extension', the variable - `ediff-backup-extension' must still be set so Ediff will know - which extension to use. - -`ediff-custom-diff-program' -`ediff-custom-diff-options' - Because Ediff limits the options you may want to pass to the `diff' - program, it partially makes up for this drawback by letting you - save the output from `diff' in your preferred format, which is - specified via the above two variables. - - The output generated by `ediff-custom-diff-program' (which doesn't - even have to be a standard-style `diff'!) is not used by Ediff. - It is provided exclusively so that you can refer to it later, send - it over email, etc. For instance, after reviewing the - differences, you may want to send context differences to a - colleague. Since Ediff ignores the `-c' option in - `ediff-diff-program', you would have to run `diff -c' separately - just to produce the list of differences. Fortunately, - `ediff-custom-diff-program' and `ediff-custom-diff-options' - eliminate this nuisance by keeping a copy of a difference list in - the desired format in a buffer that can be displayed via the - command `D'. - -`ediff-patch-default-directory' - Specifies the default directory to look for patches. - - -*Warning:* Ediff does not support the output format of VMS `diff'. -Instead, make sure you are using some implementation of POSIX `diff', -such as `gnudiff'. - - -File: ediff.info, Node: Merging and diff3, Next: Support for Version Control, Prev: Patch and Diff Programs, Up: Customization - -7.9 Merging and diff3 -===================== - -Ediff supports three-way comparison via the functions `ediff-files3' and -`ediff-buffers3'. The interface is the same as for two-way comparison. -In three-way comparison and merging, Ediff reports if any two difference -regions are identical. For instance, if the current region in buffer A -is the same as the region in buffer C, then the mode line of buffer A -will display `[=diff(C)]' and the mode line of buffer C will display -`[=diff(A)]'. - - Merging is done according to the following algorithm. - - If a difference region in one of the buffers, say B, differs from -the ancestor file while the region in the other buffer, A, doesn't, -then the merge buffer, C, gets B's region. Similarly when buffer A's -region differs from the ancestor and B's doesn't, A's region is used. - - If both regions in buffers A and B differ from the ancestor file, -Ediff chooses the region according to the value of the variable -`ediff-default-variant'. If its value is `default-A' then A's region -is chosen. If it is `default-B' then B's region is chosen. If it is -`combined' then the region in buffer C will look like this: - - <<<<<<< variant A - the difference region from buffer A - >>>>>>> variant B - the difference region from buffer B - ####### Ancestor - the difference region from the ancestor buffer, if available - ======= end - - The above is the default template for the combined region. The user -can customize this template using the variable -`ediff-combination-pattern'. - - The variable `ediff-combination-pattern' specifies the template that -determines how the combined merged region looks like. The template is -represented as a list of the form `(STRING1 Symbol1 STRING2 Symbol2 -STRING3 Symbol3 STRING4)'. The symbols here must be atoms of the form -`A', `B', or `Ancestor'. They determine the order in which the -corresponding difference regions (from buffers A, B, and the ancestor -buffer) are displayed in the merged region of buffer C. The strings in -the template determine the text that separates the aforesaid regions. -The default template is - - ("<<<<<<< variant A" A ">>>>>>> variant B" B - "####### Ancestor" Ancestor "======= end") - -(this is one long line) and the corresponding combined region is shown -above. The order in which the regions are shown (and the separator -strings) can be changed by changing the above template. It is even -possible to add or delete region specifiers in this template (although -the only possibly useful such modification seems to be the deletion of -the ancestor). - - In addition to the state of the difference, Ediff displays the state -of the merge for each region. If a difference came from buffer A by -default (because both regions A and B were different from the ancestor -and `ediff-default-variant' was set to `default-A') then `[=diff(A) -default-A]' is displayed in the mode line. If the difference in buffer -C came, say, from buffer B because the difference region in that buffer -differs from the ancestor, but the region in buffer A does not (if -merging with an ancestor) then `[=diff(B) prefer-B]' is displayed. The -indicators default-A/B and prefer-A/B are inspired by Emerge and have -the same meaning. - - Another indicator of the state of merge is `combined'. It appears -with any difference region in buffer C that was obtained by combining -the difference regions in buffers A and B as explained above. - - In addition to the state of merge and state of difference -indicators, while merging with an ancestor file or buffer, Ediff -informs the user when the current difference region in the (normally -invisible) ancestor buffer is empty via the _AncestorEmpty_ indicator. -This helps determine if the changes made to the original in variants A -and B represent pure insertion or deletion of text: if the mode line -shows _AncestorEmpty_ and the corresponding region in buffers A or B is -not empty, this means that new text was inserted. If this indicator is -not present and the difference regions in buffers A or B are non-empty, -this means that text was modified. Otherwise, the original text was -deleted. - - Although the ancestor buffer is normally invisible, Ediff maintains -difference regions there and advances the current difference region -accordingly. All highlighting of difference regions is provided in the -ancestor buffer, except for the fine differences. Therefore, if -desired, the user can put the ancestor buffer in a separate frame and -watch it there. However, on a TTY, only one frame can be visible at -any given time, and Ediff doesn't support any single-frame window -configuration where all buffers, including the ancestor buffer, would -be visible. However, the ancestor buffer can be displayed by typing -`/' to the control window. (Type `C-l' to hide it again.) - - Note that the state-of-difference indicators `=diff(A)' and -`=diff(B)' above are not redundant, even in the presence of a -state-of-merge indicator. In fact, the two serve different purposes. - - For instance, if the mode line displays `=diff(B) prefer(B)' and you -copy a difference region from buffer A to buffer C then `=diff(B)' will -change to `diff-A' and the mode line will display `=diff(A) prefer-B'. -This indicates that the difference region in buffer C is identical to -that in buffer A, but originally buffer C's region came from buffer B. -This is useful to know because you can recover the original difference -region in buffer C by typing `r'. - - Ediff never changes the state-of-merge indicator, except in response -to the `!' command (see below), in which case the indicator is lost. -On the other hand, the state-of-difference indicator is changed -automatically by the copying/recovery commands, `a', `b', `r', `+'. - - The `!' command loses the information about origins of the regions -in the merge buffer (default-A, prefer-B, or combined). This is because -recomputing differences in this case means running `diff3' on buffers -A, B, and the merge buffer, not on the ancestor buffer. (It makes no -sense to recompute differences using the ancestor file, since in the -merging mode Ediff assumes that you have not edited buffers A and B, -but that you may have edited buffer C, and these changes are to be -preserved.) Since some difference regions may disappear as a result of -editing buffer C and others may arise, there is generally no simple way -to tell where the various regions in the merge buffer came from. - - In three-way comparison, Ediff tries to disregard regions that -consist entirely of white space. For instance, if, say, the current -region in buffer A consists of the white space only (or if it is -empty), Ediff will not take it into account for the purpose of -computing fine differences. The result is that Ediff can provide a -better visual information regarding the actual fine differences in the -non-white regions in buffers B and C. Moreover, if the regions in -buffers B and C differ in the white space only, then a message to this -effect will be displayed. - - In the merge mode, the share of the split between window C (the -window displaying the merge-buffer) and the windows displaying buffers -A and B is controlled by the variable `ediff-merge-window-share'. Its -default value is 0.5. To make the merge-buffer window smaller, reduce -this amount. - - We don't recommend increasing the size of the merge-window to more -than half the frame (i.e., to increase the value of -`ediff-merge-window-share') to more than 0.5, since it would be hard to -see the contents of buffers A and B. - - You can temporarily shrink the merge window to just one line by -typing `s'. This change is temporary, until Ediff finds a reason to -redraw the screen. Typing `s' again restores the original window size. - - With a positive prefix argument, the `s' command will make the merge -window slightly taller. This change is persistent. With ``-'' or with -a negative prefix argument, the command `s' makes the merge window -slightly shorter. This change also persistent. - - Ediff lets you automatically ignore the regions where only one of the -buffers A and B disagrees with the ancestor. To do this, set the -variable `ediff-show-clashes-only' to non-`nil'. - - You can toggle this feature interactively by typing `$$'. - - Note that this variable affects only the show next/previous -difference commands. You can still jump directly to any difference -region directly using the command `j' (with a prefix argument -specifying the difference number). - - The variable `ediff-autostore-merges' controls what happens to the -merge buffer when Ediff quits. If the value is `nil', nothing is done -to the merge buffer--it will be the user's responsibility to save it. -If the value is `t', the user will be asked where to save the buffer -and whether to delete it afterwards. It the value is neither `nil' nor -`t', the merge buffer is saved _only_ if this merge session was invoked -from a group of related Ediff session, such as those that result from -`ediff-merge-directories', `ediff-merge-directory-revisions', etc. -*Note Session Groups::. This behavior is implemented in the function -`ediff-maybe-save-and-delete-merge', which is a hook in -`ediff-quit-merge-hook'. The user can supply a different hook, if -necessary. - - The variable `ediff-autostore-merges' is buffer-local, so it can be -set in a per-buffer manner. Therefore, use `setq-default' to globally -change this variable. - - When merge buffers are saved automatically as directed by -`ediff-autostore-merges', Ediff attaches a prefix to each file, as -specified by the variable `ediff-merge-filename-prefix'. The default is -`merge_', but this can be changed by the user. - - -File: ediff.info, Node: Support for Version Control, Next: Customizing the Mode Line, Prev: Merging and diff3, Up: Customization - -7.10 Support for Version Control -================================ - -Ediff supports version control and lets you compare versions of files -visited by Emacs buffers via the function `ediff-revision'. This -feature is controlled by the following variables: - -`ediff-version-control-package' - A symbol. The default is `vc'. - - If you are like most Emacs users, Ediff will use VC as the version - control package. This is the standard Emacs interface to RCS, - CVS, and SCCS. - - However, if your needs are better served by other interfaces, you - will have to tell Ediff which version control package you are - using, e.g., - (setq ediff-version-control-package 'rcs) - - Apart from the standard `vc.el', Ediff supports three other - interfaces to version control: `rcs.el', `pcl-cvs.el' (recently - renamed pcvs.el), and `generic-sc.el'. The package `rcs.el' is - written by Sebastian Kremer and is available - as - `ftp.cs.buffalo.edu:pub/Emacs/rcs.tar.Z' - `ftp.uni-koeln.de:/pub/gnu/emacs/rcs.tar.Z' - - Ediff's interface to the above packages allows the user to compare -the versions of the current buffer or to merge them (with or without an -ancestor-version). These operations can also be performed on -directories containing files under version control. - - In case of `pcl-cvs.el', Ediff can also be invoked via the function -`run-ediff-from-cvs-buffer'--see the documentation string for this -function. - - -File: ediff.info, Node: Customizing the Mode Line, Next: Miscellaneous, Prev: Support for Version Control, Up: Customization - -7.11 Customizing the Mode Line -============================== - -When Ediff is running, the mode line of `Ediff Control Panel' buffer -shows the current difference number and the total number of difference -regions in the two files. - - The mode line of the buffers being compared displays the type of the -buffer (`A:', `B:', or `C:') and (usually) the file name. Ediff tries -to be intelligent in choosing the mode line buffer identification. In -particular, it works well with the `uniquify.el' and `mode-line.el' -packages (which improve on the default way in which Emacs displays -buffer identification). If you don't like the way Ediff changes the -mode line, you can use `ediff-prepare-buffer-hook' to modify the mode -line. - - -File: ediff.info, Node: Miscellaneous, Next: Notes on Heavy-duty Customization, Prev: Customizing the Mode Line, Up: Customization - -7.12 Miscellaneous -================== - -Here are a few other variables for customizing Ediff: - -`ediff-split-window-function' - Controls the way you want the window be split between file-A and - file-B (and file-C, if applicable). It defaults to the vertical - split (`split-window-vertically', but you can set it to - `split-window-horizontally', if you so wish. Ediff also lets you - switch from vertical to horizontal split and back interactively. - - Note that if Ediff detects that all the buffers it compares are - displayed in separate frames, it assumes that the user wants them - to be so displayed and stops splitting windows. Instead, it - arranges for each buffer to be displayed in a separate frame. You - can switch to the one-frame mode by hiding one of the buffers - A/B/C. - - You can also swap the windows where buffers are displayed by typing - `~'. - -`ediff-merge-split-window-function' - Controls how windows are split between buffers A and B in the - merge mode. This variable is like `ediff-split-window-function', - but it defaults to `split-window-horizontally' instead of - `split-window-vertically'. - -`ediff-make-wide-display-function' - The value is a function to be called to widen the frame for - displaying the Ediff buffers. See the on-line documentation for - `ediff-make-wide-display-function' for details. It is also - recommended to look into the source of the default function - `ediff-make-wide-display'. - - You can toggle wide/regular display by typing `m'. In the wide - display mode, buffers A, B (and C, when applicable) are displayed - in a single frame that is as wide as the entire workstation - screen. This is useful when files are compared side-by-side. By - default, the display is widened without changing its height. - -`ediff-use-last-dir' - Controls the way Ediff presents the default directory when it - prompts the user for files to compare. If `nil', Ediff uses the - default directory of the current buffer when it prompts the user - for file names. Otherwise, it will use the directories it had - previously used for files A, B, or C, respectively. - -`ediff-no-emacs-help-in-control-buffer' - If `t', makes `C-h' behave like the key, i.e., it will move - you back to the previous difference rather than invoking help. - This is useful when, in an xterm window or a text-only terminal, - the Backspace key is bound to `C-h' and is positioned more - conveniently than the key. - -`ediff-toggle-read-only-function' - This variable's value is a function that Ediff uses to toggle the - read-only property in its buffers. - - The default function that Ediff uses simply toggles the read-only - property, unless the file is under version control. For a - checked-in file under version control, Ediff first tries to check - the file out. - -`ediff-make-buffers-readonly-at-startup nil' - If `t', all variant buffers are made read-only at Ediff startup. - -`ediff-keep-variants' - The default is `t', meaning that the buffers being compared or - merged will be preserved when Ediff quits. Setting this to `nil' - causes Ediff to offer the user a chance to delete these buffers - (if they are not modified). Supplying a prefix argument to the - quit command (`q') temporarily reverses the meaning of this - variable. This is convenient when the user prefers one of the - behaviors most of the time, but occasionally needs the other - behavior. - - However, Ediff temporarily resets this variable to `t' if it is - invoked via one of the "buffer" jobs, such as `ediff-buffers'. - This is because it is all too easy to loose day's work otherwise. - Besides, in a "buffer" job, the variant buffers have already been - loaded prior to starting Ediff, so Ediff just preserves status quo - here. - - Using `ediff-cleanup-hook', one can make Ediff delete the variants - unconditionally (e.g., by making `ediff-janitor' into one of these - hooks). - -`ediff-grab-mouse' - Default is `t'. Normally, Ediff grabs mouse and puts it in its - control frame. This is useful since the user can be sure that - when he needs to type an Ediff command the focus will be in an - appropriate Ediff's frame. However, some users prefer to move the - mouse by themselves. The above variable, if set to `maybe', will - prevent Ediff from grabbing the mouse in many situations, usually - after commands that may take more time than usual. In other - situation, Ediff will continue grabbing the mouse and putting it - where it believes is appropriate. If the value is `nil', then - mouse is entirely user's responsibility. Try different settings - and see which one is for you. - - -File: ediff.info, Node: Notes on Heavy-duty Customization, Prev: Miscellaneous, Up: Customization - -7.13 Notes on Heavy-duty Customization -====================================== - -Some users need to customize Ediff in rather sophisticated ways, which -requires different defaults for different kinds of files (e.g., SGML, -etc.). Ediff supports this kind of customization in several ways. -First, most customization variables are buffer-local. Those that -aren't are usually accessible from within Ediff Control Panel, so one -can make them local to the panel by calling make-local-variable from -within `ediff-startup-hook'. - - Second, the function `ediff-setup' accepts an optional sixth -argument which has the form `((VAR-NAME-1 . VAL-1) (VAR-NAME-2 . VAL-2) -...)'. The function `ediff-setup' sets the variables in the list to -the respective values, locally in the Ediff control buffer. This is an -easy way to throw in custom variables (which usually should be -buffer-local) that can then be tested in various hooks. - - Make sure the variable `ediff-job-name' and `ediff-word-mode' are set -properly in this case, as some things in Ediff depend on this. - - Finally, if you want custom-tailored help messages, you can set the -variables `ediff-brief-help-message-function' and -`ediff-long-help-message-function' to functions that return help -strings. - - When customizing Ediff, some other variables are useful, although -they are not user-definable. They are local to the Ediff control -buffer, so this buffer must be current when you access these variables. -The control buffer is accessible via the variable -`ediff-control-buffer', which is also local to that buffer. It is -usually used for checking if the current buffer is also the control -buffer. - - Other variables of interest are: -`ediff-buffer-A' - The first of the data buffers being compared. - -`ediff-buffer-B' - The second of the data buffers being compared. - -`ediff-buffer-C' - In three-way comparisons, this is the third buffer being compared. - In merging, this is the merge buffer. In two-way comparison, this - variable is `nil'. - -`ediff-window-A' - The window displaying buffer A. If buffer A is not visible, this - variable is `nil' or it may be a dead window. - -`ediff-window-B' - The window displaying buffer B. - -`ediff-window-C' - The window displaying buffer C, if any. - -`ediff-control-frame' - A dedicated frame displaying the control buffer, if it exists. It - is non-`nil' only if Ediff uses the multiframe display, i.e., when - the control buffer is in its own frame. - - -File: ediff.info, Node: Credits, Next: Index, Prev: Customization, Up: Top - -8 Credits -********* - -Ediff was written by Michael Kifer . It was -inspired by emerge.el written by Dale R. Worley . An -idea due to Boris Goldowsky made it possible -to highlight fine differences in Ediff buffers. Alastair Burt - ported Ediff to XEmacs, Eric Freudenthal - made it work with VC, Marc Paquette - wrote the toolbar support package for Ediff, and -Hrvoje Niksic adapted it to the Emacs -customization package. - - Many people provided help with bug reports, feature suggestions, and -advice. Without them, Ediff would not be nearly as useful as it is -today. Here is a hopefully full list of contributors: - - Adrian Aichner (aichner@ecf.teradyne.com), - Drew Adams (drew.adams@oracle.com), - Steve Baur (steve@xemacs.org), - Neal Becker (neal@ctd.comsat.com), - E. Jay Berkenbilt (ejb@ql.org), - Alastair Burt (burt@dfki.uni-kl.de), - Paul Bibilo (peb@delcam.co.uk), - Kevin Broadey (KevinB@bartley.demon.co.uk), - Harald Boegeholz (hwb@machnix.mathematik.uni-stuttgart.de), - Bradley A. Bosch (brad@lachman.com), - Michael D. Carney (carney@ltx-tr.com), - Jin S. Choi (jin@atype.com), - Scott Cummings (cummings@adc.com), - Albert Dvornik (bert@mit.edu), - Eric Eide (eeide@asylum.cs.utah.edu), - Paul Eggert (eggert@twinsun.com), - Urban Engberg (ue@cci.dk), - Kevin Esler (esler@ch.hp.com), - Robert Estes (estes@ece.ucdavis.edu), - Jay Finger (jayf@microsoft.com), - Xavier Fornari (xavier@europe.cma.fr), - Eric Freudenthal (freudent@jan.ultra.nyu.edu), - Job Ganzevoort (Job.Ganzevoort@cwi.nl), - Felix Heinrich Gatzemeier (felix.g@tzemeier.info), - Boris Goldowsky (boris@cs.rochester.edu), - Allan Gottlieb (gottlieb@allan.ultra.nyu.edu), - Aaron Gross (aaron@bfr.co.il), - Thorbjoern Hansen (thorbjoern.hansen@mchp.siemens.de), - Marcus Harnisch (marcus_harnisch@mint-tech.com), - Steven E. Harris (seh@panix.com), - Aaron S. Hawley (Aaron.Hawley@uvm.edu), - Xiaoli Huang (hxl@epic.com), - Andreas Jaeger (aj@suse.de), - Lars Magne Ingebrigtsen (larsi@ifi.uio.no), - Larry Gouge (larry@itginc.com), - Karl Heuer (kwzh@gnu.org), - (irvine@lks.csi.com), - (jaffe@chipmunk.cita.utoronto.ca), - David Karr (dkarr@nmo.gtegsc.com), - Norbert Kiesel (norbert@i3.informatik.rwth-aachen.de), - Leigh L Klotz (klotz@adoc.xerox.com), - Fritz Knabe (Fritz.Knabe@ecrc.de), - Heinz Knutzen (hk@informatik.uni-kiel.d400.de), - Andrew Koenig (ark@research.att.com), - Hannu Koivisto (azure@iki.fi), - Ken Laprade (laprade@dw3f.ess.harris.com), - Will C Lauer (wcl@cadre.com), - Richard Levitte (levitte@e.kth.se), - Mike Long (mike.long@analog.com), - Dave Love (d.love@dl.ac.uk), - Martin Maechler (maechler@stat.math.ethz.ch), - Simon Marshall (simon@gnu.org), - Paul C. Meuse (pmeuse@delcomsys.com), - Richard Mlynarik (mly@adoc.xerox.com), - Stefan Monnier (monnier@cs.yale.edu), - Chris Murphy (murphycm@sun.aston.ac.uk), - Erik Naggum (erik@naggum.no), - Eyvind Ness (Eyvind.Ness@hrp.no), - Ray Nickson (nickson@cs.uq.oz.au), - Dan Nicolaescu (dann@ics.uci.edu), - David Petchey (petchey_david@jpmorgan.com), - Benjamin Pierce (benjamin.pierce@cl.cam.ac.uk), - Francois Pinard (pinard@iro.umontreal.ca), - Tibor Polgar (tlp00@spg.amdahl.com), - David Prince (dave0d@fegs.co.uk), - Paul Raines (raines@slac.stanford.edu), - Stefan Reicher (xsteve@riic.at), - Charles Rich (rich@merl.com), - Bill Richter (richter@math.nwu.edu), - C.S. Roberson (roberson@aur.alcatel.com), - Kevin Rodgers (kevin.rodgers@ihs.com), - Sandy Rutherford (sandy@ibm550.sissa.it), - Heribert Schuetz (schuetz@ecrc.de), - Andy Scott (ascott@pcocd2.intel.com), - Axel Seibert (axel@tumbolia.ppp.informatik.uni-muenchen.de), - Vin Shelton (acs@xemacs.org), - Scott O. Sherman (Scott.Sherman@mci.com), - Richard Stallman (rms@gnu.org), - Richard Stanton (stanton@haas.berkeley.edu), - Sam Steingold (sds@goems.com), - Ake Stenhoff (etxaksf@aom.ericsson.se), - Stig (stig@hackvan.com), - Peter Stout (Peter_Stout@cs.cmu.edu), - Chuck Thompson (cthomp@cs.uiuc.edu), - Ray Tomlinson (tomlinso@bbn.com), - Raymond Toy (toy@rtp.ericsson.se), - Stephen J. Turnbull (stephen@xemacs.org), - Jan Vroonhof (vroonhof@math.ethz.ch), - Colin Walters (walters@cis.ohio-state.edu), - Philippe Waroquiers (philippe.waroquiers@eurocontrol.be), - Klaus Weber (gizmo@zork.north.de), - Ben Wing (ben@xemacs.org), - Tom Wurgler (twurgler@goodyear.com), - Steve Youngs (youngs@xemacs.org), - Ilya Zakharevich (ilya@math.ohio-state.edu), - Eli Zaretskii (eliz@is.elta.co.il) - - -File: ediff.info, Node: Index, Prev: Credits, Up: Top - -Index -***** - -[index] -* Menu: - -* !: Quick Help Commands. (line 146) -* ##: Quick Help Commands. (line 223) -* #c: Quick Help Commands. (line 231) -* #f: Quick Help Commands. (line 238) -* #h: Quick Help Commands. (line 238) -* $$: Quick Help Commands. (line 337) -* $*: Quick Help Commands. (line 357) -* %: Quick Help Commands. (line 327) -* &: Quick Help Commands. (line 376) -* *: Quick Help Commands. (line 153) -* +: Quick Help Commands. (line 416) -* /: Quick Help Commands. (line 373) -* <: Quick Help Commands. (line 26) -* =: Quick Help Commands. (line 421) -* >: Quick Help Commands. (line 29) -* ?: Quick Help Commands. (line 7) -* @: Quick Help Commands. (line 181) -* A: Quick Help Commands. (line 260) -* a: Quick Help Commands. (line 51) -* ab: Quick Help Commands. (line 71) -* ac: Quick Help Commands. (line 78) -* B: Quick Help Commands. (line 265) -* b: Quick Help Commands. (line 62) -* ba: Quick Help Commands. (line 83) -* bc: Quick Help Commands. (line 88) -* C: Quick Help Commands. (line 269) -* C-l: Quick Help Commands. (line 332) -* ca: Quick Help Commands. (line 92) -* cb: Quick Help Commands. (line 96) -* Comparing files and buffers: Introduction. (line 6) -* D: Quick Help Commands. (line 282) -* DEL: Quick Help Commands. (line 101) -* Directory difference buffer: Session Groups. (line 36) -* E: Quick Help Commands. (line 14) -* ediff: Major Entry Points. (line 23) -* ediff-after-flag-eol: Highlighting Difference Regions. - (line 13) -* ediff-after-flag-mol: Highlighting Difference Regions. - (line 13) -* ediff-after-session-group-setup-hook: Hooks. (line 112) -* ediff-after-setup-control-frame-hook: Hooks. (line 69) -* ediff-after-setup-windows-hook: Hooks. (line 24) -* ediff-auto-refine: Refinement of Difference Regions. - (line 11) -* ediff-auto-refine-limit: Refinement of Difference Regions. - (line 30) -* ediff-autostore-merges <1>: Merging and diff3. (line 166) -* ediff-autostore-merges <2>: Hooks. (line 62) -* ediff-autostore-merges: Session Groups. (line 64) -* ediff-backup: Major Entry Points. (line 26) -* ediff-before-flag-bol: Highlighting Difference Regions. - (line 13) -* ediff-before-flag-mol: Highlighting Difference Regions. - (line 13) -* ediff-before-session-group-setup-hook: Hooks. (line 107) -* ediff-before-setup-control-frame-hook: Hooks. (line 69) -* ediff-before-setup-hook: Hooks. (line 12) -* ediff-before-setup-windows-hook: Hooks. (line 24) -* ediff-brief-help-message-function: Notes on Heavy-duty Customization. - (line 27) -* ediff-buffers: Major Entry Points. (line 31) -* ediff-buffers3: Major Entry Points. (line 38) -* ediff-cleanup-hook: Hooks. (line 49) -* ediff-coding-system-for-read: Patch and Diff Programs. - (line 25) -* ediff-combination-pattern: Merging and diff3. (line 39) -* ediff-control-buffer: Quick Help Customization. - (line 6) -* ediff-control-frame-parameters: Window and Frame Configuration. - (line 35) -* ediff-control-frame-position-function: Window and Frame Configuration. - (line 48) -* ediff-control-frame-upward-shift: Window and Frame Configuration. - (line 70) -* ediff-current-diff-face-A: Highlighting Difference Regions. - (line 22) -* ediff-current-diff-face-B: Highlighting Difference Regions. - (line 22) -* ediff-current-diff-face-C: Highlighting Difference Regions. - (line 22) -* ediff-custom-diff-options: Patch and Diff Programs. - (line 78) -* ediff-custom-diff-program: Patch and Diff Programs. - (line 78) -* ediff-default-variant: Merging and diff3. (line 21) -* ediff-diff-options: Patch and Diff Programs. - (line 17) -* ediff-diff-program <1>: Patch and Diff Programs. - (line 12) -* ediff-diff-program: Refinement of Difference Regions. - (line 42) -* ediff-diff3-options: Patch and Diff Programs. - (line 17) -* ediff-diff3-program: Patch and Diff Programs. - (line 12) -* ediff-directories: Major Entry Points. (line 42) -* ediff-directories3: Major Entry Points. (line 46) -* ediff-directory-revisions: Major Entry Points. (line 50) -* ediff-display-help-hook: Hooks. (line 93) -* ediff-documentation: Major Entry Points. (line 165) -* ediff-even-diff-face-A: Highlighting Difference Regions. - (line 40) -* ediff-even-diff-face-B: Highlighting Difference Regions. - (line 40) -* ediff-even-diff-face-C: Highlighting Difference Regions. - (line 40) -* ediff-files: Major Entry Points. (line 23) -* ediff-files3: Major Entry Points. (line 35) -* ediff-fine-diff-face-A: Highlighting Difference Regions. - (line 31) -* ediff-fine-diff-face-B: Highlighting Difference Regions. - (line 31) -* ediff-fine-diff-face-C: Highlighting Difference Regions. - (line 31) -* ediff-force-faces: Highlighting Difference Regions. - (line 47) -* ediff-forward-word: Refinement of Difference Regions. - (line 42) -* ediff-forward-word-function: Refinement of Difference Regions. - (line 38) -* ediff-grab-mouse: Miscellaneous. (line 92) -* ediff-help-message: Quick Help Customization. - (line 6) -* ediff-highlight-all-diffs: Highlighting Difference Regions. - (line 53) -* ediff-ignore-case <1>: Selective Browsing. (line 87) -* ediff-ignore-case: Quick Help Commands. (line 231) -* ediff-ignore-case-option <1>: Selective Browsing. (line 87) -* ediff-ignore-case-option: Quick Help Commands. (line 231) -* ediff-ignore-case-option3 <1>: Selective Browsing. (line 87) -* ediff-ignore-case-option3: Quick Help Commands. (line 231) -* ediff-ignore-similar-regions: Selective Browsing. (line 70) -* ediff-janitor: Hooks. (line 54) -* ediff-job-name: Notes on Heavy-duty Customization. - (line 27) -* ediff-keep-variants: Miscellaneous. (line 71) -* ediff-keymap-setup-hook: Hooks. (line 16) -* ediff-load-hook: Hooks. (line 9) -* ediff-long-help-message-function: Notes on Heavy-duty Customization. - (line 27) -* ediff-make-buffers-readonly-at-startup: Miscellaneous. (line 68) -* ediff-make-frame-position: Window and Frame Configuration. - (line 55) -* ediff-make-wide-display-function: Miscellaneous. (line 32) -* ediff-maybe-save-and-delete-merge <1>: Merging and diff3. (line 166) -* ediff-maybe-save-and-delete-merge: Hooks. (line 62) -* ediff-merge: Major Entry Points. (line 136) -* ediff-merge-buffers: Major Entry Points. (line 143) -* ediff-merge-buffers-with-ancestor: Major Entry Points. (line 146) -* ediff-merge-directories: Major Entry Points. (line 150) -* ediff-merge-directories-with-ancestor: Major Entry Points. (line 154) -* ediff-merge-directory-revisions: Major Entry Points. (line 55) -* ediff-merge-directory-revisions-with-ancestor: Major Entry Points. - (line 60) -* ediff-merge-filename-prefix: Merging and diff3. (line 183) -* ediff-merge-files: Major Entry Points. (line 136) -* ediff-merge-files-with-ancestor: Major Entry Points. (line 140) -* ediff-merge-revisions: Major Entry Points. (line 159) -* ediff-merge-revisions-with-ancestor: Major Entry Points. (line 162) -* ediff-merge-split-window-function: Miscellaneous. (line 26) -* ediff-merge-window-share: Merging and diff3. (line 135) -* ediff-merge-with-ancestor: Major Entry Points. (line 140) -* ediff-meta-buffer-keymap-setup-hook: Hooks. (line 119) -* ediff-meta-buffer-map: Hooks. (line 119) -* ediff-mode-hook: Hooks. (line 98) -* ediff-mode-map: Hooks. (line 16) -* ediff-narrow-control-frame-leftward-shift: Window and Frame Configuration. - (line 60) -* ediff-no-emacs-help-in-control-buffer: Miscellaneous. (line 52) -* ediff-odd-diff-face-A: Highlighting Difference Regions. - (line 40) -* ediff-odd-diff-face-B: Highlighting Difference Regions. - (line 40) -* ediff-odd-diff-face-C: Highlighting Difference Regions. - (line 40) -* ediff-patch-buffer: Major Entry Points. (line 119) -* ediff-patch-default-directory: Patch and Diff Programs. - (line 97) -* ediff-patch-file: Major Entry Points. (line 88) -* ediff-patch-options: Patch and Diff Programs. - (line 17) -* ediff-patch-program: Patch and Diff Programs. - (line 12) -* ediff-prefer-iconified-control-frame: Window and Frame Configuration. - (line 74) -* ediff-prepare-buffer-hook <1>: Customizing the Mode Line. - (line 17) -* ediff-prepare-buffer-hook: Hooks. (line 89) -* ediff-profile: Other Session Commands. - (line 56) -* ediff-quit-hook: Hooks. (line 31) -* ediff-quit-merge-hook <1>: Merging and diff3. (line 166) -* ediff-quit-merge-hook: Hooks. (line 62) -* ediff-quit-session-group-hook: Hooks. (line 116) -* ediff-quit-widened: Narrowing. (line 27) -* ediff-regions-linewise: Major Entry Points. (line 79) -* ediff-regions-wordwise: Major Entry Points. (line 71) -* ediff-registry-setup-hook: Hooks. (line 103) -* ediff-revert-buffers-then-recompute-diffs: Other Session Commands. - (line 46) -* ediff-revision: Major Entry Points. (line 83) -* ediff-save-buffer: Patch and Diff Programs. - (line 78) -* ediff-select-hook: Hooks. (line 82) -* ediff-setup: Notes on Heavy-duty Customization. - (line 27) -* ediff-setup-windows: Window and Frame Configuration. - (line 85) -* ediff-setup-windows-multiframe: Window and Frame Configuration. - (line 103) -* ediff-setup-windows-plain: Window and Frame Configuration. - (line 103) -* ediff-show-clashes-only: Merging and diff3. (line 155) -* ediff-show-registry: Other Session Commands. - (line 11) -* ediff-split-window-function: Miscellaneous. (line 9) -* ediff-start-narrowed: Narrowing. (line 21) -* ediff-startup-hook <1>: Notes on Heavy-duty Customization. - (line 27) -* ediff-startup-hook <2>: Quick Help Customization. - (line 6) -* ediff-startup-hook: Hooks. (line 79) -* ediff-suspend-hook: Hooks. (line 31) -* ediff-toggle-multiframe <1>: Window and Frame Configuration. - (line 103) -* ediff-toggle-multiframe: Other Session Commands. - (line 21) -* ediff-toggle-read-only-function: Miscellaneous. (line 59) -* ediff-toggle-use-toolbar: Other Session Commands. - (line 33) -* ediff-unselect-hook: Hooks. (line 85) -* ediff-use-last-dir <1>: Miscellaneous. (line 45) -* ediff-use-last-dir: Major Entry Points. (line 188) -* ediff-use-long-help-message: Quick Help Customization. - (line 6) -* ediff-use-toolbar-p: Other Session Commands. - (line 40) -* ediff-version-control-package: Support for Version Control. - (line 11) -* ediff-wide-control-frame-rightward-shift: Window and Frame Configuration. - (line 65) -* ediff-window-setup-function: Window and Frame Configuration. - (line 96) -* ediff-windows-linewise: Major Entry Points. (line 68) -* ediff-windows-wordwise: Major Entry Points. (line 65) -* ediff-word-1: Refinement of Difference Regions. - (line 54) -* ediff-word-2: Refinement of Difference Regions. - (line 54) -* ediff-word-3: Refinement of Difference Regions. - (line 54) -* ediff-word-4: Refinement of Difference Regions. - (line 54) -* ediff-word-mode: Notes on Heavy-duty Customization. - (line 27) -* ediff3: Major Entry Points. (line 35) -* edir-merge-revisions: Major Entry Points. (line 55) -* edir-merge-revisions-with-ancestor: Major Entry Points. (line 60) -* edir-revisions: Major Entry Points. (line 50) -* edirs: Major Entry Points. (line 42) -* edirs-merge: Major Entry Points. (line 150) -* edirs-merge-with-ancestor: Major Entry Points. (line 154) -* edirs3: Major Entry Points. (line 46) -* epatch: Major Entry Points. (line 88) -* epatch-buffer: Major Entry Points. (line 119) -* eregistry: Other Session Commands. - (line 11) -* Finding differences: Introduction. (line 6) -* G: Quick Help Commands. (line 10) -* ga: Quick Help Commands. (line 117) -* gb: Quick Help Commands. (line 129) -* gc: Quick Help Commands. (line 136) -* generic-sc.el: Support for Version Control. - (line 29) -* h: Quick Help Commands. (line 191) -* i: Quick Help Commands. (line 279) -* j: Quick Help Commands. (line 110) -* M: Quick Help Commands. (line 306) -* m: Quick Help Commands. (line 169) -* Merging files and buffers: Introduction. (line 6) -* mode-line.el: Customizing the Mode Line. - (line 17) -* Multi-file patches: Session Groups. (line 81) -* n: Quick Help Commands. (line 105) -* p: Quick Help Commands. (line 101) -* Patching files and buffers: Introduction. (line 6) -* pcl-cvs.el: Support for Version Control. - (line 29) -* q: Quick Help Commands. (line 321) -* R: Quick Help Commands. (line 290) -* r: Quick Help Commands. (line 197) -* ra: Quick Help Commands. (line 205) -* rb: Quick Help Commands. (line 211) -* rc: Quick Help Commands. (line 217) -* rcs.el: Support for Version Control. - (line 29) -* s: Quick Help Commands. (line 396) -* SPC: Quick Help Commands. (line 105) -* uniquify.el: Customizing the Mode Line. - (line 17) -* V: Quick Help Commands. (line 23) -* v: Quick Help Commands. (line 19) -* vc.el: Support for Version Control. - (line 29) -* wa: Quick Help Commands. (line 41) -* wb: Quick Help Commands. (line 44) -* wc: Quick Help Commands. (line 47) -* wd: Quick Help Commands. (line 32) -* z: Quick Help Commands. (line 311) -* |: Quick Help Commands. (line 175) -* ~: Quick Help Commands. (line 274) - - - -Tag Table: -Node: Top1411 -Node: Introduction2015 -Node: Major Entry Points4410 -Node: Session Commands14323 -Node: Quick Help Commands15846 -Node: Other Session Commands34301 -Node: Registry of Ediff Sessions37106 -Node: Session Groups38667 -Node: Remote and Compressed Files44837 -Node: Customization46074 -Node: Hooks48032 -Node: Quick Help Customization53336 -Node: Window and Frame Configuration54352 -Node: Selective Browsing60320 -Node: Highlighting Difference Regions65464 -Node: Narrowing70211 -Node: Refinement of Difference Regions71494 -Node: Patch and Diff Programs74434 -Node: Merging and diff379006 -Node: Support for Version Control88814 -Node: Customizing the Mode Line90444 -Node: Miscellaneous91303 -Node: Notes on Heavy-duty Customization96273 -Node: Credits98863 -Node: Index103819 - -End Tag Table diff --git a/xemacs-packages/info/edit-utils.info b/xemacs-packages/info/edit-utils.info deleted file mode 100644 index acb73539..00000000 --- a/xemacs-packages/info/edit-utils.info +++ /dev/null @@ -1,3987 +0,0 @@ -This is edit-utils.info, produced by makeinfo version 4.7 from -edit-utils.texi. - -INFO-DIR-SECTION XEmacs Editor -START-INFO-DIR-ENTRY -* Edit Utilities: (edit-utils). Editing Utilities for XEmacs. -END-INFO-DIR-ENTRY - - This manual is part of XEmacs. - - XEmacs 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. - - XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. - - -File: edit-utils.info, Node: Top, Next: Copying, Prev: (dir), Up: (dir) - -1 The Editing Utilities Package -******************************* - -This Info file contains the manual for the Editing Utilities package. - -The node name for each entry in the menu is the name of the elisp file -containing the code that implements the functionality described. It is -highly recommended that you briefly peruse the elisp source code since -it can provide valuable information on usage and technique. This can -easily be done by typing `C-x 4 l RET' where is -the name of the elisp file to be loaded. - -* Menu: - -* Copying:: Why this manual is GPL, and what that means - -Buffer and Window Management -* compare-w:: Comparing Windows -* detached-minibuf:: Detached Minibuffers -* iswitchb:: Convenient Buffer Switching -* permanent-buffers:: Permanent Buffers -* rsz-minibuf:: Self-Resizing Minibuffer -* search-buffers:: Searching Many Buffers -* uniquify:: Meaningful Unique Names -* winring:: Window Configuration Rings -* autorevert:: Reverting Buffers - -Editing Help -* foldout:: Folding Extensions for Outline-Mode -* func-menu:: Jump to a Function Within a Buffer. -* id-select:: Select Syntax-Driven Regions in a Buffer -* outl-mouse:: Outline-Mode Mouse Commands -* page-ext:: Extended Page Handling Commands -* power-macros:: Power Macros - Keyboard Macros Made Easy -* redo:: Redo/Undo System -* scroll-in-place:: Scrolling In Place -* setnu:: VI-style Line Number Mode -* vertical-mode:: Vertical Mode - Editing of Vertical Text -* align:: Align Text to a Specific Column, By Regexp -* allout:: Extensive Outline Mode -* narrow-stack:: Extending the built-in narrowing functions - -File Management -* backup-dir:: Specify Directories to be Used for Backup Files - -Session Management -* bookmark:: Create annotated bookmarks -* desktop:: Save Partial Status of Emacs When Killed -* recent-files:: Recent File Navigation -* resume:: Resuming a Suspended Emacs Job -* saveconf:: Save Buffer/Window Configuration Between Sessions -* savehist:: Save Minibuffer History -* saveplace:: Automatically Save Place in Files -* where-was-i-db:: Keep Persistent State in Visited Files - -Abbreviations -* completion:: Completion -* dabbrev:: Dynamic Abbreviations -* hippie-exp:: Hippie Expand -* icomplete:: Interactive Minibuffer Completion -* tempo:: Flexible Template Insertion - -Display, Faces, and Highlighting: -* avoid:: Move Mouse Pointer Out of the Way of Editing -* blink-cursor:: Blinking Cursor -* fast-lock:: Speeding Up Font Lock Mode -* lazy-lock:: Lazy Demand-Driven Fontification -* lazy-shot:: Another Lazy Demand-Driven Fontification -* mic-paren:: Advanced Highlighting of Matching Parentheses -* paren:: Highlight (Un)matching Parens and Whole Expressions -* shell-font:: Decorate a Shell Buffer With Fonts -* highline:: Highlight the Current Line in the Buffer - -Low-Level Editing Hacks: -* after-save-commands:: Hooks Invoked After Saving a File -* atomic-extents:: Indivisible Blocks of Text -* array:: Table and Array Editor - -Menu and Toolbar Support: -* floating-toolbar:: Floating Toolbar -* The Toolbar Utilities:: Creating and Managing Toolbars and Buttons. - -Miscellaneous: -* flow-ctrl:: Flow Control -* makesum:: Generate Summary of All Key Binding -* man:: Browse UNIX manual pages - -Undocumented: -* abbrevlist:: Abbreviation List -* file-part:: Treat a Section of a Buffer as a Separate File -* info-look:: Major-Mode-Sensitive Info Index Lookup Facility -* live-icon:: Make Frame Icons Represent Current Frame Contents -* mode-motion+:: Per Mode/Buffer Mouse Tracking With Highlighting -* popper:: Shrink-Wrapped Temporary Windows -* reportmail:: Display Time and Load in Mode Line -* balloon-help:: Balloon Help and Tooltips -* blink-paren:: Blinking Parentheses -* edit-faces:: Face Editor -* lispm-fonts:: lispm-fonts -* big-menubar:: Big Menubar -* tree-menu:: tree-menu.el - -Appendices: -* XEmacs License:: The GNU General Public License - - -File: edit-utils.info, Node: Copying, Next: compare-w, Prev: Top, Up: Top - -2 Copying -********* - -This document may be redistributed, verbatim or in modified form, under -the terms of the GNU General Public License, version 2 or any later -version. The same terms apply to the libraries it documents. A copy -of the General Public License is provided as an Appendix. - - Most XEmacs documentation has its own license, which is an ancestor -of the GNU Free Documentation License ("FDL"), and whose terms are -quite similar to those imposed by GNU on Emacs documentation. Why is -this manual licensed differently (under the GNU General Public License, -or "GPL"), and why does it have to be distributed separately from the -XEmacs User's Guide and the XEmacs Lisp Reference Manual? - - Taking the second question first, XEmacs is "community-owned" -software. That is, unlike GNU Emacs, there is no monopoly copyright -holder. Many of us, including the original Lucid authors, have -contributed our copyrights to the Free Software Foundation (FSF), and of -course much content is derived from GNU Emacs, and therefore is held by -the FSF. Another large chunk is held by Sun Microsystems, and a few -individual authors hold copyright to thousands of lines each. But many -individuals hold copyright to only a few dozen lines. Like the Linux -kernel, copyright ownership is distributed throughout a community. - - However, its license is "copyleft," _i.e._, it _requires_ that you -redistribute it under terms _identical_ to those under which you -received it, unless you have explicit permission of the copyright -holder. Because of the multiple owners, determining the ownership of -any given part of XEmacs is tedious, and perhaps impossible. For -practical purposes, then, the license of any substantial chunk of -existing XEmacs content cannot be changed, except to a later version of -the GPL, for those parts under GPL. (That is due to the _explicit_ -permission to change to a later version of the GPL, present in every -file of XEmacs.) - - Unfortunately, this severe restriction means that the GPL, FDL, and -the XEmacs documentation license ("XDL") are _mutually incompatible_. -That is, content licensed under any of the GPL, FDL, or XDL _may not_ -be mixed with content licensed under either of the other two without -changing the license of some of the content. But this requires -permission of the copyright holder, which is often difficult or -impossible to get. - - For example, you _may not_ take comments or docstrings from XEmacs -code and add them to the Lispref to mend a gap in the latter's coverage. -You _may not_ copy text from the Lispref into docstrings in the code. -And you _may not_ copy text from the GNU Emacs Lisp Reference to the -XEmacs Lisp Reference Manual. (In this case it is at least trivial to -ask permission, although it is rather unclear whether it would be -granted.) - - In fact, parts of this document were derived by copying from XEmacs -code under the GPL, without any further permission from the authors. -Thus, this document must be distributed under the GPL, as a "volume" -separate from the XEmacs documentation under the XDL. Note that the -"mere aggregation" clauses allow us to distribute in the same tarball. -But incorporating it as a node in the Lispref is prohibited, even if -done by inclusion. - - A bit of advocacy: - - If you look carefully at the additional restrictions imposed by the -soi-disant "free" documentation licenses, you discover that they are -simply proprietary restrictions guaranteeing a certain amount of -_unpaid_ political advertising to the Free Software Foundation and GNU -Project (and in the case of the FDL, this is extended to commercial -advertising by authors of original or derived works). Whether this is -"ethically justified" or not is a difficult question. What is certain -is that there is little social benefit to these terms (since the license -documents themselves contain the advocacy and must be included with any -distribution). - - I conclude it makes sense for XEmacs to reduce its restrictions, -where possible, to the "least common denominator," the GNU General -Public License. - - -File: edit-utils.info, Node: compare-w, Next: detached-minibuf, Prev: Copying, Up: Top - -3 Comparing Windows -******************* - -This package provides one entry point, compare-windows. It compares -text starting from point in two adjacent windows, advancing point until -it finds a difference. There are variables to permit ignoring of -whitespace differences, or case differences, or both. - - -File: edit-utils.info, Node: detached-minibuf, Next: iswitchb, Prev: compare-w, Up: Top - -4 Detached Minibuffers -********************** - -This package creates a standalone minibuffer in its own frame. - - To configure this package, type: - - M-x customize-group RET detached-minibuf RET - - -File: edit-utils.info, Node: iswitchb, Next: permanent-buffers, Prev: detached-minibuf, Up: Top - -5 Convenient Buffer Switching -***************************** - -With this package installed, as you type in a substring, the list of -buffers currently matching the substring are displayed as you type. -The list is ordered so that the most recent buffers visited come at the -start of the list. The buffer at the start of the list will be the one -visited when you press return. By typing more of the substring, the -list is narrowed down so that gradually the buffer you want will be at -the top of the list. Alternatively, you can use `C-s' and `C-r' to -rotate buffer names in the list until the one you want is at the top of -the list. Completion is also available so that you can see what is -common to all of the matching buffers as you type. - - For example, let's say we have two buffers called "123456" and -"123", with "123456" the most recent. When I use `iswitchb', I first of -all get presented with the list of all the buffers - - `iswitch {123456,123}' - - If I then press `2': - - `iswitch 2[3]{123456,123}' - - The list in {} are the matching buffers, most recent first (buffers -visible in the current frame are put at the end of the list by -default). At any time I can select the item at the head of the list by -pressing `RET'. I can also bring the put the first element at the end -of the list by pressing `C-s', or put the last element at the head of -the list by pressing `C-r'. The item in [] indicates what can be added -to my input by pressing `TAB'. In this case, I will get `3' added to -my input. So, press `TAB': - - `iswitch 23{123456,123}' - - At this point, I still have two matching buffers. If I want the -first buffer in the list, I simply press `RET'. If I wanted the second -in the list, I could press `C-s' to move it to the top of the list and -then `RET' to select it. - - However, If I type `4', I only have one match left: - - `iswitch 234[123456] [Matched]' - - Since there is only one matching buffer left, it is given in `[]' -and we see the text `[Matched]' afterwards. I can now press `TAB' or -`RET' to go to that buffer. - - If however, I now type `a': - - `iswitch 234a [No match]' - - There are no matching buffers. If I press `RET' or `TAB', I can be -prompted to create a new buffer called "234a". - - Of course, where this function comes in really useful is when you -can specify the buffer using only a few keystrokes. In the above -example, the quickest way to get to the "123456" buffer would be just -to type `4' and then `RET' (assuming there isn't any newer buffer with -"4" in its name). - - To see a full list of all matching buffers in a separate buffer, hit -`?' or press `TAB' when there are no further completions to the -substring. Repeated `TAB' presses will scroll you through this -separate buffer. - - The buffer at the head of the list can be killed by pressing `C-k'. -If the buffer needs saving, you will be queried before the buffer is -killed. - - If you find that the file you are after is not in a buffer, you can -press `C-x C-f' to immediately drop into find-file. - - To see the doc string of iswitchb for full keybindings and features, -type: - - M-x describe-function RET iswitchb - -* Menu: - -* Customization: iswitchb-cust. -* Changing the Display:: -* Regexp Matching:: -* Replacement for read-buffer:: - - -File: edit-utils.info, Node: iswitchb-cust, Next: Changing the Display, Prev: iswitchb, Up: iswitchb - -5.1 Customization -================= - -To configure the package, type: - - M-x customize-group RET iswitchb RET - - To install this package on the default keys used for buffer -switching, type: - - M-x iswitchb-default-keybindings RET - - To modify the default keybindings, use the hook provided. For -example, the following code can be added to your initialization file: - - (add-hook 'iswitchb-define-mode-map-hook 'iswitchb-my-keys) - - (defun iswitchb-my-keys () - "Add my keybindings for iswitchb." - (define-key iswitchb-mode-map " " 'iswitchb-next-match) - ) - - -File: edit-utils.info, Node: Changing the Display, Next: Regexp Matching, Prev: iswitchb-cust, Up: iswitchb - -5.2 Changing the Display -======================== - -If you have many matching buffers, they may not all fit onto one line -of the minibuffer. In this case, you should use -`(resize-minibuffer-mode)' *Note rsz-minibuf::. You can also limit -iswitchb so that it only shows a certain number of lines. To do this, -see the documentation for `iswitchb-minibuffer-setup-hook'. - - By default, the list of current buffers is most recent first, oldest -last, with the exception that the buffers visible in the current frame -are put at the end of the list. A hook exists to allow other functions -to order the list. For example, if you add: - - (add-hook 'iswitchb-make-buflist-hook 'iswitchb-summaries-to-end) - - then all buffers matching "Summary" are moved to the end of the -list. (I find this handy for keeping the INBOX Summary and so on out -of the way.) It also moves buffers matching "output\*$" to the end of -the list (these are created by AUC TeX when compiling.) Other -functions could be made available which alter the list of matching -buffers (either deleting or rearranging elements.) - - If you have font-lock loaded, the first matching buffer is -highlighted. To switch this off, set `(setq iswitchb-use-fonts nil)'. -I don't use font-lock that much, so I've hardcoded the faces. If this -is too harsh, let me know. Colouring of the matching buffer name was -suggested by Carsten Dominik (dominik@strw.leidenuniv.nl) - - -File: edit-utils.info, Node: Regexp Matching, Next: Replacement for read-buffer, Prev: Changing the Display, Up: iswitchb - -5.3 Regexp Matching -=================== - -There is limited provision for regexp matching within `iswitchb', -enabled through `iswitchb-regexp'. This allows you to type `c$' for -example and see all buffer names ending in `c'. This facility is quite -limited though in two respects. First, you can't currently type in -expressions like `[0-9]' directly - you have to type them in when -`iswitchb-regexp' is `nil' and then toggle on the regexp functionality. -Likewise, don't enter an expression containing `\' in regexp mode. If -you try, iswitchb gets confused, so just hit `C-g' and try again. -Secondly, no completion mechanism is currently offered when regexp -searching. - - -File: edit-utils.info, Node: Replacement for read-buffer, Prev: Regexp Matching, Up: iswitchb - -5.4 Replacement for read-buffer -=============================== - -iswitchb-read-buffer has been written to be a drop in replacement for -the normal buffer selection routine `read-buffer'. To use iswitch for -all buffer selections in Emacs, add: `(setq read-buffer-function -'iswitchb-read-buffer)' (This variable should be present in Emacs 20.3+) -XEmacs users can get the same behaviour by doing: `(defalias -'read-buffer 'iswitchb-read-buffer)' since `read-buffer' is defined in -lisp. - - -File: edit-utils.info, Node: permanent-buffers, Next: rsz-minibuf, Prev: iswitchb, Up: Top - -6 Permanent Buffers -******************* - -A permanent buffer is a buffer that you don't want to kill, mainly used -for testing or temporary stuff. The *scratch* buffer is the most famous -example of what could be a permanent buffer. This package allows you to -define several permanent buffers (the scratch buffer can be one of -them) that will never disappear. If you kill them or save their -contents, they will be regenerated. You can also specify a set of lisp -forms to eval in the buffer when it is (re)generated. - - This package is implemented in a minor-mode fashion. You can -customize the default value of `permanent-buffers-mode' or use -`turn-on-permanent-buffers' at startup. Within an XEmacs session, use -`permanent-buffers-mode' or `turn-o[n|ff]-permanent-buffers'. You might -also want to customize `permanent-buffers-alist'. - - To configure this package, type: - - M-x customize-group RET permanent-buffers RET - - -File: edit-utils.info, Node: rsz-minibuf, Next: search-buffers, Prev: permanent-buffers, Up: Top - -7 Self-Resizing Minibuffer -************************** - -This package allows the entire contents (or as much as possible) of the -minibuffer to be visible at once when typing. As the end of a line is -reached, the minibuffer will resize itself. When the user is done -typing, the minibuffer will return to its original size. - - In window systems where it is possible to have a frame in which the -minibuffer is the only window, the frame itself can be resized. - - Note that the minibuffer and echo area are not the same! They -simply happen to occupy roughly the same place on the frame. Messages -put in the echo area will not cause any resizing by this package. - - This package is considered a minor mode but it doesn't put anything -in minor-mode-alist because this mode is specific to the minibuffer, -which has no modeline. - - To invoke this mode, type: - - M-x resize-minibuffer-mode RET - - To configure this package, type: - - M-x customize-group RET resize-minibuffer RET - - -File: edit-utils.info, Node: search-buffers, Next: uniquify, Prev: rsz-minibuf, Up: Top - -8 Searching Many Buffers -************************ - -This package searches all live buffers for REGEXP and presents matching -lines in a separate buffer with hyperlinks to their occurrences. - - After creating countless buffers in an XEmacs session, the user can -execute the following: - - M-x list-matches-in-buffers RET \ RET .* RET - - to find all matches of the single word "problem" in any of them. -The result is presented in a buffer named "*Matches for "\" -in buffers*" with hyperlinks to any occurrence. User may navigate to -the next (`n') or previous (`p') match. - - -File: edit-utils.info, Node: uniquify, Next: winring, Prev: search-buffers, Up: Top - -9 Meaningful Unique Names -************************* - -Emacs' standard method for making buffer names unique adds <2>, <3>, -etc. to the end of (all but one of) the buffers. This file replaces -that behavior, for buffers visiting files and dired buffers, with a -uniquification that adds parts of the file name until the buffer names -are unique. For instance, buffers visiting `/u/mernst/tmp/Makefile' and -`/usr/projects/zaphod/Makefile' would be named `Makefile|tmp' and -`Makefile|zaphod', respectively (instead of `Makefile' and -`Makefile<2>'). Other buffer name styles are also available. - - To configure this package, type: - - M-x customize-group RET uniquify RET - - -File: edit-utils.info, Node: winring, Next: autorevert, Prev: uniquify, Up: Top - -10 Window Configuration Rings -***************************** - -This package provides lightweight support for circular rings of window -configurations. A window configuration is the layout of windows and -associated buffers within a frame. There is always at least one -configuration on the ring, the current configuration. You can create -new configurations and cycle through the layouts in either direction. -You can also delete configurations from the ring (except the last one -of course!). Window configurations are named, and you can jump to and -delete named configurations. - - Window configuration rings are frame specific. That is, each frame -has its own ring which can be cycled through independently of other -frames. - - You are always looking at the current window configuration for each -frame, which consists of the windows in the frame, the buffers in those -windows, and point in the current buffer. As you run commands such as -`C-x 4 b', `C-x 2', and `C-x 0' you are modifying the current window -configuration. When you jump to a new configuration, the layout that -existed before the jump is captured, and the ring is rotated to the -selected configuration. Window configurations are captured with -`current-window-configuration', however winring also saves point for the -current buffer. - - To use, add the following to your initialization file: - - (winring-initialize) - - Note that by default, this binds the winring keymap to the `C-x 7' -prefix, but you can change this by setting the value of -`winring-keymap-prefix', before you call `winring-initialize'. - - The following commands are defined: - -`C-x 7 n' - Create a new window configuration. The new configuration will - contain a single buffer, the one named in the variable - `winring-new-config-buffer-name'. - - With `C-u', winring prompts for the name of the new configuration. - If you don't use `C-u' the function in `winring-name-generator' - will be called to get the new configuration's name. - -`C-x 7 2' - Create a duplicate of the current window configuration. C-u has - the same semantics as with `C-x 7 c'. - -`C-x 7 j' - Jump to a named configuration (prompts for the name). - -`C-x 7 0' - Kill the current window configuration and rotate to the previous - layout on the ring. You cannot delete the last configuration in - the ring. With `C-u', prompts for the name of the configuration - to kill. - -`C-x 7 o' - Go to the next configuration on the ring. - -`C-x 7 p' - Go to the previous configuration on the ring. - - Note that the sequence `C-x 7 o C-x 7 p' is a no-op; it leaves you - in the same configuration you were in before the sequence. - -`C-x 7 r' - Rename the current window configuration. - -`C-x 7 b' - Submit a bug report on winring. - -`C-x 7 v' - Echo the winring version. - - - As mentioned, window configuration names can be displayed in the -modeline. The default value of `winring-show-names' is currently `nil' -by default. Set it to `t' to activate. If you don't like the position -in the modeline where winring names are shown, you can change this by -passing in your own modeline hacker function to `winring-initialize'. - -* Menu: - -* History:: -* Related Packages:: - - -File: edit-utils.info, Node: History, Next: Related Packages, Prev: winring, Up: winring - -10.1 History -============ - -A long long time ago there was a package called `wicos' written by -Heikki Suopanki, which was based on yet another earlier package called -`screens' also written by Suopanki. This in turn was based on the Unix -tty session manager `screen' (unrelated to Emacs) by Oliver Laumann, -Juergen Weigert, and Michael Schroeder. - - Wicos essentially provided fancy handling for window configurations. -I liked the basic ideas, but wicos broke with later versions of Emacs -and XEmacs. I re-implemented just the functionality I wanted, -simplifying things in the process, and porting the code to run with -XEmacs 19 and 20, and Emacs 20 (I don't know if winring works in Emacs -19.34). - - Wicos used the M-o prefix which I've recently changed to C-x 7 as the -default, by suggestion of RMS. Wicos also had some support for multiple -frames, and saving configurations on all visible frames, but it didn't -work too well, and I like frame independent rings better. - - -File: edit-utils.info, Node: Related Packages, Prev: History, Up: winring - -10.2 Related Packages -===================== - -I know of a few other related packages: - - * `escreen' by Noah Friedman. A much more ambitious package that - does Emacs window session management. Very cool, but I wanted - something more lightweight. - - * `wconfig' by Bob Weiner as part of Hyperbole. I think wconfig is - similar in spirit to winring; it seems to have also have named - window configurations, but not frame-specific window rings. - - * `winner' by Ivar Rummelhoff. This package comes with Emacs 20, - and appears to differ from winring by providing undo/redo - semantics to window configuration changes. winner is a minor mode - and does seem to support frame-specific window rings. - - * window-xemacs' by the XEmacs Development Team. It appears that - this package, which is specific to XEmacs (and perhaps just XEmacs - 20) implements stacks of window configurations which are frame - independent. - - - Please feel free to email me if my rendition of history, or my -explanation of the related packages, is inaccurate. - - -File: edit-utils.info, Node: autorevert, Next: backup-dir, Prev: winring, Up: Top - -11 Reverting Buffers -******************** - -Whenever a file that Emacs is editing has been changed by another -program the user normally has to execute the command `revert-buffer' to -load the new content of the file into Emacs. - - This package is defined in autorevert.el and contains two minor -modes: Global Auto-Revert Mode and Auto-Revert Mode. Both modes -automatically revert buffers whenever the corresponding files have been -changed on disk. - - Auto-Revert Mode can be activated for individual buffers. Global -Auto-Revert Mode applies to all file buffers. - - Both modes operate by checking the time stamp of all files at -intervals of `auto-revert-interval'. The default is every five -seconds. The check is aborted whenever the user actually uses Emacs. -You should never even notice that this package is active (except that -your buffers will be reverted, of course). - -* Menu: - -* Auto-Revert Usage:: How to use the package. - - -File: edit-utils.info, Node: Auto-Revert Usage, Prev: autorevert, Up: autorevert - -11.1 Auto-Revert Usage -====================== - -To configure the package, type: - - M-x customize-group RET auto-revert RET - - To activate Auto-Revert for a specific buffer, go to the buffer and -type: - - M-x auto-revert-mode RET - - To activate Global Auto-Revert Mode, type: - - M-x global-auto-revert-mode RET - - To activate Global Auto-Revert Mode every time Emacs is started -customize the option `global-auto-revert-mode' or the following line -could be added to your initialization file: - - (global-auto-revert-mode 1) - - The function `turn-on-auto-revert-mode' could be added to any major -mode hook to activate Auto-Revert Mode for all buffers in that mode. -For example, the following line will activate Auto-Revert Mode in all C -mode buffers: - - (add-hook 'c-mode-hook 'turn-on-auto-revert-mode) - - -File: edit-utils.info, Node: backup-dir, Next: bookmark, Prev: autorevert, Up: Top - -12 Specify Directories to be Used for Backup Files -************************************************** - -Allows backup files to be optionally stored in some directories, based -on the value of the alist, `bkup-backup-directory-info'. This variable -is a list of lists of the form `(FILE-REGEXP BACKUP-DIR OPTIONS ...)'. -If the filename to be backed up matches `FILE-REGEXP', or `FILE-REGEXP' -is `t', then `BACKUP-DIR' is used as the path for its backups. -Directories may begin with "/" to specify an absolute pathname. - - If `BACKUP-DIR' does not exist and `OPTIONS' contains the symbol -`ok-create', then it is created if possible. Otherwise the usual -behavior (backup in the same directory as the file) results. - - If `OPTIONS' contains the symbol `full-path', then the full path of -the file being backed up is prepended to the backup file name, with -each "/" replaced by a "!". This is intended for cases where an -absolute backup path is used. If `OPTIONS' contains `prepend-name' in -addition to `full-path', then the file name is prepended rather than -appended to the path component when forming the backup name. - - If `OPTIONS' contains the symbol `search-upward' and the backup -directory `BACKUP-DIR' is a relative path, then a directory with that -name is searched for starting at the current directory and proceeding -upward (.., ../.., etc) until one is found of that name or the root is -reached, and if one is found it is used as the backup directory. - - Finally, if no `FILE-REGEXP' matches the file name being backed up, -then the usual behavior results. - - These lines from my initialization file load this library and set -the values I like: - - (require 'backup-dir) - (setq bkup-backup-directory-info - '(("/home/greg/.*" "/~/.backups/" ok-create full-path prepend-name) - ("^/[^/:]+:" ".backups/") ; handle EFS files specially: don't - ("^/[^/:]+:" "./") ; search-upward... its very slow - (t ".backups/" - full-path prepend-name search-upward))) - - The package also provides a new function, `find-file-latest-backup' -to find the latest backup file for the current buffer's file. - - This package is based on `files.el' from XEmacs 20.3 and overrides -functions defined there. - - -File: edit-utils.info, Node: bookmark, Next: desktop, Prev: backup-dir, Up: Top - -13 Create annotated bookmarks -***************************** - -This package is for setting "bookmarks" in files. A bookmark -associates a string with a location in a certain file. Thus, you can -navigate your way to that location by providing the string. - - To configure this package, type: - - M-x customize-group RET bookmark RET - - -File: edit-utils.info, Node: desktop, Next: recent-files, Prev: bookmark, Up: Top - -14 Save Partial Status of Emacs When Killed -******************************************* - -Save the Desktop, i.e., - - * some global variables - - * the list of buffers with associated files. For each buffer also - - * the major mode - - * the default directory - - * the point - - * the mark & mark-active - - * buffer-read-only - - * some local variables - - - - To use this, first put these two lines at the bottom of your -initialization file (the later the better): - - (desktop-load-default) - (desktop-read) - - Between these two lines you may wish to add something that updates -the variables `desktop-globals-to-save' and/or -`desktop-locals-to-save'. If for instance you want to save the local -variable `foobar' for every buffer in which it is local, you could add -the line - - (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save)) - - To avoid saving excessive amounts of data you may also wish to add -something like the following - - (add-hook 'kill-emacs-hook - '(lambda () - (desktop-truncate search-ring 3) - (desktop-truncate regexp-search-ring 3))) - - which will make sure that no more than three search items are saved. -You must place this line _after_ the `(desktop-load-default)' line. -See also the variable `desktop-save-hook'. - - Start Emacs in the root directory of your "project". The desktop -saver is inactive by default. You activate it by typing `M-x -desktop-save RET'. When you exit the next time the above data will be -saved. This ensures that all the files you were editing will be -reloaded the next time you start Emacs from the same directory and that -points will be set where you left them. If you save a desktop file in -your home directory it will act as a default desktop when you start -Emacs from a directory that doesn't have its own. I never do this, but -you may want to. - - Some words on minor modes: Most minor modes are controlled by -buffer-local variables, which have a standard save / restore mechanism. -To handle all minor modes, we take the following approach: (1) check -whether the variable name from `minor-mode-alist' is also a function; -and (2) use translation table `desktop-minor-mode-table' in the case -where the two names are not the same. - - By the way: don't use `desktop.el' to customize Emacs - the standard -XEmacs initialization file is used for that. Saving global default -values for buffers is an example of misuse. - - PLEASE NOTE: The kill ring can be saved as specified by the variable -`desktop-globals-to-save' (by default it isn't). This may result in -saving things you did not mean to keep. Use `M-x desktop-clear RET'. - - To configure this package, type: - - M-x customize-group RET desktop RET - - -File: edit-utils.info, Node: recent-files, Next: resume, Prev: desktop, Up: Top - -15 Recent File Navigation -************************* - -To install `recent-files', put the following statements into your -initialization file - - (recent-files-initialize) - - `recent-files' adds the menu "Recent Files" (or whatever name you -choose, (*note Customization: recentf-cust.) to Emacs's menubar. Its -entries are the files (and directories) that have recently been opened -by Emacs. You can open one of these files again by selecting its entry -in the "Recent Files" menu. The list of file entries in this menu is -preserved from one Emacs session to another. You can prevent Emacs from -saving this list by selecting "Don't save recent-files list on exit" -from the menu. If you have disabled saving, you can re-enable it by -selecting "Save recent-files list on exit". - - The menu has permanent and non-permanent entries. Permanent entries -are marked with an asterisk in front of the filename. The non-permanent -entries are hidden in a submenu. - - Each time you open a file in Emacs, it is added as a non-permanent -entry to the menu. The value of `recent-files-number-of-entries' -determines how many non-permanent entries are held in the menu. When -the number of non-permanent entries reaches this value, the least -recently added non-permanent entry is removed from the menu when -another non-permanent entry is added. It is not removed from the list, -though; it may reappear when entries are deleted from the list. The -number of entries saved to disk is the value of the variable -`recent-files-number-of-saved-entries'. - - Permanent entries are not removed from the menu. You can make a file -entry permanent by selecting "Make permanent" (where -is the name of the current buffer) when the current buffer holds this -file. "Make non-permanent" makes the file entry of the current -buffer non-permanent. - - The command "Kill buffer and delete entry" is handy when -you have accidentally opened a file but want to keep neither the buffer -nor the entry. - - You can erase the list of non-permanent entries by selecting "Erase -non-permanent entries" from the menu. - -* Menu: - -* Customization: recentf-cust. - - -File: edit-utils.info, Node: recentf-cust, Prev: recent-files, Up: recent-files - -15.1 Customization -================== - -There are lots of variables to control the behaviour of recent-files. -You do not have to change any of them if you like it as it comes out of -the box. However, you may want to look at these options to make it -behave different. - -`recent-files-number-of-entries' - Controls how many non-permanent entries are shown in the - recent-files list. The default is 15. - -`recent-files-number-of-saved-entries' - Controls how many non-permanent entries are saved to disk when - Emacs exits or recent-files-save-the-list is called. The default - is 50. - -`recent-files-save-file' - The name of the file where the recent-files list is saved between - Emacs session. You probably don't need to change this. The - default is ".recent-files.el" in your home directory. - -`recent-files-dont-include' - A list of regular expressions for files that should not be - included into the recent-files list. This list is empty by - default. For instance, a list to exclude all .newsrc files, all - auto-save-files, and all files in the /tmp directory (but not the - /tmp directory itself) would look like this: - - (setq recent-files-dont-include - '("/\\.newsrc" "~$" "^/tmp/.")) - - The default is empty. - -`recent-files-use-full-names' - If the value of this variable is non-nil, the full pathnames of - the files are shown in the recent-files menu. Otherwise only the - filename part (or the last name component if it is a directory) is - shown in the menu. The default it t, i.e. show full names. - -`recent-files-filename-replacements' - This is a list of pairs of regular expressions and replacement - strings. If a filename matches one of the regular expressions, the - matching part is replaced by the replacement string for display in - the recent-files menu. Example: My home directory is - "/users/mmc/nickel/". I want to replace it with "~/". I also want - to replace the directory "/imports/teleservices/mmc/avc2/", where - I work a lot, with ".../avc2/". The list then looks like - - (setq recent-files-filename-replacements - '(("/users/mmc/nickel/" . "~/") - ("/imports/teleservices/mmc/avc2/" . ".../avc2/"))) - - Only the first match is replaced. So, if you have several entries - in this list that may match a filename simultaneously, put the one - you want to match (usually the most special) in front of the - others. The default is to replace the home directory with "~". - -`recent-files-sort-function' - Contains a function symbol to sort the display of filenames in the - recent-files menu. Supplied are two functions, - `recent-files-dont-sort' and `recent-files-sort-alphabetically'. - The first, which is the default, preserves the order of "most - recent on top". - -`recent-files-permanent-submenu' - If this variable is non-nil, the permanent entries are put into a - separate submenu of the recent-files menu. The default is nil. - -`recent-files-non-permanent-submenu' - If this variable is non-nil, the non-permanent entries are put - into a separate submenu of the recent-files menu. The default is - currently t, but probably should be nil, and we may change it - back. (You can set both `recent-files-permanent-submenu' and - `recent-files-non-permanent-submenu' to t to have both lists in - separate submenus.) - -`recent-files-commands-submenu' - If this variable is non-nil, the commands if recent-files are - placed in a submenu of the recent-files menu. The default is nil. - -`recent-files-commands-submenu-title' - If the commands are placed in a submenu, this string is used as - the title of the submenu. The default is "Commands...". - -`recent-files-actions-on-top' - If this variable is non-nil, the "action" menu entries ("Make - permanent" etc.) are put on top of the menu. Otherwise - they appear below the file entries or submenus. The default is nil. - -`recent-files-permanent-first' - If this variable is t, the permanent entries are put first in the - recent-files menu, i.e. above the non-permanent entries. If the - value is nil, non-permanent entries appear first. If the value is - neither t nor nil, the entries are sorted according to - recent-files-sort-function. The default is 'sort. - -`recent-files-find-file-command' - This variable contains the command to execute when a file entry is - selected from the menu. Usually this will be `find-file', which is - the default. - - - -File: edit-utils.info, Node: resume, Next: saveconf, Prev: recent-files, Up: Top - -16 Resuming a Suspended Emacs Job -********************************* - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: saveconf, Next: savehist, Prev: resume, Up: Top - -17 Save Buffer/Window Configuration Between Sessions -**************************************************** - -This package of functions gives Emacs the ability to remember which -files were being visited, the windows that were on them, and the value -of point in their buffers the last Emacs session in the same directory. -This is an emulation of an old Gosling Emacs feature. - - The relevant commands are `save-context' and `recover-context'. - - Most of the time you'll want an Emacs session's context saved even -if you choose not to recover it later. To avoid having to manually `M-x -save-context' at each emacs exit, put the line: - - (setq auto-save-and-recover-context t) - - in your initialization file or in `default.el' in the lisp directory -of the Emacs distribution. The context will then automatically be -saved when Emacs exits. - - By default only the contexts of visible buffers (buffers with -windows on them) are saved. Setting the variable save-buffer-context -to t causes the contexts of all buffers to be saved. - - To use the package put these lines - - (require 'saveconf) - (if (null (cdr command-line-args)) - (setq inihibit-startup-message (recover-context))) - - at the end of your initialization file or the `default.el' file in -the lisp directory of the Emacs distribution. This causes the context -saved in the current directory to be recovered whenever Emacs is -invoked without any arguments. - - -File: edit-utils.info, Node: savehist, Next: saveplace, Prev: saveconf, Up: Top - -18 Save Minibuffer History -************************** - -Many editors (e.g. Vim) have the feature of saving minibuffer history -to an external file after exit. This package provides the same feature -in Emacs. When Emacs is about the exit, `savehist-save' will dump the -contents of various minibuffer histories (as determined by -`savehist-history-variables') to a save file (`~/.emacs-history' by -default). Although the package was designed for saving the minibuffer -histories, any variables can be saved that way. - - To use savehist, put the following in your initialization file: - - (savehist-load) - - To configure this package, type: - - M-x customize-group RET savehist RET - - -File: edit-utils.info, Node: saveplace, Next: where-was-i-db, Prev: savehist, Up: Top - -19 Automatically Save Place in Files -************************************ - -Automatically save place in files, so that visiting them later (even -during a different Emacs session) automatically moves point to the -saved position, when the file is first found. Uses the value of -buffer-local variable `save-place' to determine whether to save -position or not. - - To use this package, put the following in your initialization file: - - (require 'saveplace) - - To configure this package, type: - - M-x customize-group RET saveplace RET - - -File: edit-utils.info, Node: where-was-i-db, Next: completion, Prev: saveplace, Up: Top - -20 Keep Persistent State in Visited Files -***************************************** - -This library will make XEmacs keep track of where you were last time you -visited a file. It hopes to become a standard and favored XEmacs -feature on setups with Berkeley DB installed. - - It works by installing functions on the `find-file-hooks' and on the -buffer-local `kill-buffer-hook'. When a buffer is killed, if it was -visiting a file, and place saving has been enabled for it, a database -entry is made, saving the location of `point'. When you visit a file, -the database is queried, keyed on `buffer-file-name', and if an entry is -found, point is set to the value retrieved, and place saving is enabled -again for that buffer. - - There is a command, which is initially not bound to a keystroke in -this incarnation; and may never be, since I think completion works well -enough: - - M-x toggle-where-was-i - - which, using auto-completion, can be entered as - - M-x tog TAB w TAB - - that will turn place saving on and off on a per-file, buffer- local -basis. If `where-was-i-db' has been turned off in a buffer and then -you kill it, or exit XEmacs, any record for that file will be purged -from the database, and you'll start at the top of the file next time -you open it, with place saving turned off there. - - Place saving is automatically still `on' when you visit a file you'd -toggled it on for in a previous session or visitation. (That's the -point of it, after all.) - - Toggling place saving on in a buffer visiting a file is all that is -required to cause the `where-was-i-db' feature to be autoloaded, as -`toggle-where-was-i' will call on `install-where-was-i' if the -`wwi-ffh' has not yet been installed. That WILL NOT cause this feature -to be automatically enabled in your next XEmacs invocation, however. -For that, you must customize and save -`wwi-auto-install-on-startup-flag'. There is more information about -this in its docstring. - - This feature can be unloaded with: - - C-u M-x install-where-was-i - - which will call `unload-feature', as well as traverse the -`buffer-list' removing the buffer-local `kill-buffer-hook' installed by -this program. Note that any buffers that got place saving enabled by -having had an entry in the database for them when they were first -visited (thus restoring point to where it was the last time you had -visited the file), will not have an updated entry made, nor the old -entry removed (as would happen if you `toggle-where-was-i' to off in -just that buffer), after you uninstall this feature like that. - - If you toggle it on again in a buffer visiting a file, then kill -that buffer, the point will be saved for it. When you kill the other -buffers that had place saving enabled before you uninstalled the -feature with `C-u M-x install-where-was-i', no `where-was-i-db' -database update will happen for them, since their buffer-local -`kill-buffer-hook' will have been cleaned of the member -`wwi-save-where-i-am', the function that writes the `point' entry to -the database when a buffer is killed. If you then re-visit one of -those files, point will get restored to the location it did the last -time you visited that file with `where-was-i-db' installed. - - To remove a file from the place saving database, simply visit it, -`M-x toggle-where-was-i' to switch `where-was-i-db' off, then kill that -buffer. You can see how this works by looking at the definition of -`wwi-save-where-i-am'. - - After a period of time, the database of saved file positions will -become cluttered with the names of files that no longer exist. You may -vacume out the crumbs using: - - M-x wwi-vacume-where-was-i-db - - which will prompt you for an optional regular expression to match -files you want records removed for. It will traverse the database and -remove entries for file names that either match the regexp, or that are -`(not (file-exists-p file-name))'. The main reason for this command is -the removal of stale entries, for files that no longer exist on the -filesystem. - - Note also that running `wwi-vacume-where-was-i-db' will cause EFS -traffic, if you've saved your place in any remote files. Don't be -surprised if your dialing daemon picks up the phone when you run the -vacume function. You should be able to purge the database of all EFS -entries with a simple regular expression passed to -`wwi-vacume-where-was-i-db'. Of course, you might not want to do that, -for obvious reasons. - - To configure this package, type: - - M-x customize-group RET where-was-i RET - - -File: edit-utils.info, Node: completion, Next: dabbrev, Prev: where-was-i-db, Up: Top - -21 Completion -************* - -To load this package, add the following to your initialization file: - - (require 'completion) - - After you type a few characters, pressing the "complete" key inserts -the rest of the word you are likely to type. - - This watches all the words that you type and remembers them. When -typing a new word, pressing "complete" (`C-return') "completes" the -word by inserting the most recently used word that begins with the same -characters. If you press meta-return repeatedly, it cycles through all -the words it knows about. - - If you like the completion then just continue typing, it is as if -you entered the text by hand. If you want the inserted extra -characters to go away, type `C-w' or delete. More options are -described below. - - The guesses are made in the order of the most recently "used". -Typing in a word and then typing a separator character (such as a -space) "uses" the word. So does moving a cursor over the word. If no -words are found, it uses an extended version of dynamic abbreviation -*Note dabbrev::. - - Completions are automatically saved to a file between sessions. - - Completion enables programmers to enter longer, more descriptive -variable names while typing fewer keystrokes than they normally would. - - To configure this package, type: - - M-x customize-group RET completion RET - - -File: edit-utils.info, Node: dabbrev, Next: hippie-exp, Prev: completion, Up: Top - -22 Dynamic Abbreviations -************************ - -The purpose with this package is to let you write just a few characters -of words you've written earlier to be able to expand them. - - To expand a word, just put the point right after the word and press -`M-/' (`dabbrev-expand') or `M-C-/' (`dabbrev-completion'). - - Check out the customizable variables to learn about all the features -of this package. - - To configure this package, type: - - M-x customize-group RET dabbrev RET - - -File: edit-utils.info, Node: hippie-exp, Next: icomplete, Prev: dabbrev, Up: Top - -23 Hippie Expand -**************** - -`hippie-expand' is a single function for a lot of different kinds of -completions and expansions. Called repeatedly it tries all possible -completions in succession. Which kinds of completions to try, and in -which order, is determined by the contents of -`hippie-expand-try-functions-list'. Much customization of -`hippie-expand' can be made by changing the order of, removing, or -inserting new functions in this list. Given a positive numeric -argument, `hippie-expand' jumps directly ARG functions forward in this -list. Given some other argument (a negative argument or just `C-u') it -undoes the tried completion. - - If the variable `hippie-expand-verbose' is non-nil, `hippie-expand' -outputs in a message which try-function in the list that is used -currently (ie. was used currently and will be tried first the next -time). - - The variable `hippie-expand-max-buffers' determines in how many -buffers, apart from the current, to search for expansions in. It is -used by the try-functions named "-all-buffers". The variable -`hippie-expand-ignore-buffers' is a list of regexps matching buffer -names (as strings) or major modes (as atoms) of buffers that should not -be searched by the try-functions named "-all-buffers". See also the -macro `make-hippie-expand-function' below. - - A short description of the current try-functions in this file: - -`try-complete-file-name' - Very convenient to have in any buffer, and not just in the - minibuffer or (some) shell-mode. It goes through all possible - completions instead of just completing as much as is unique. - -`try-complete-file-name-partially' - To insert in the list just before `try-complete-file-name' for - those who want first to get a file name completed only as many - characters as is unique. - -`try-expand-all-abbrevs' - Can be removed if you don't use abbrevs. Otherwise it looks - through all abbrev-tables, starting with the local followed by the - global. - -`try-expand-line' - Searches the buffer for an entire line that begins exactly as the - current line. Convenient sometimes, for example as a substitute - for (or complement to) the history list in shell-like buffers. At - other times, only confusing. - -`try-expand-line-all-buffers' - Like `try-expand-line' but searches in all buffers (except the - current). (This may be a little slow, don't use it unless you are - really fond of `hippie-expand'.) - -``try-expand-list' - Tries to expand the text back to the nearest open delimiter, to a - whole list from the buffer. Convenient for example when writing - lisp or TeX. - -`try-expand-list-all-buffers' - Like `try-expand-list' but searches in all buffers (except the - current). - -`try-expand-dabbrev' - Works exactly as `dabbrev-expand' (but of course in a way - compatible with the other try-functions). - -`try-expand-dabbrev-all-buffers' - Perhaps the most useful of them, like `dabbrev-expand' but - searches all Emacs buffers (except the current) for matching - words. (No, I don't find this one particularly slow.) - -`try-expand-dabbrev-visible' - Searches the currently visible parts of all windows. Can be put - before `try-expand-dabbrev-all-buffers' to first try the - expansions you can see. - -`try-expand-dabbrev-from-kill' - Searches the kill ring for a suitable completion of the word. - Good to have, just in case the word was not found elsewhere. - -`try-expand-whole-kill' - Tries to complete text with a whole entry from the kill ring. May - be good if you don't know how far up in the kill-ring the required - entry is, and don't want to mess with "Choose Next Paste". - -`try-complete-lisp-symbol' - Like `lisp-complete-symbol', but goes through all possibilities - instead of completing what is unique. Might be tedious (usually a - lot of possible completions) and since its function is much like - `lisp-complete-symbol', which already has a key of its own, you - might want to remove this. - -`try-complete-lisp-symbol-partially' - To insert in the list just before `try-complete-lisp-symbol' for - those who first want to get completion of what is unique in the - name. - - - Not all of the above functions are by default in -`hippie-expand-try-functions-list'. This variable is better set in your -initialization file to make `hippie-expand' behave maximally convenient -according to personal taste. Also, instead of loading the variable -with all kinds of try-functions above, it might be an idea to use -`make-hippie-expand-function' to construct different -`hippie-expand'-like functions, with different try-lists and bound to -different keys. It is also possible to make -`hippie-expand-try-functions-list' a buffer local variable, and let it -depend on the mode (by setting it in the mode-hooks). - - -File: edit-utils.info, Node: icomplete, Next: tempo, Prev: hippie-exp, Up: Top - -24 Interactive Minibuffer Completion -************************************ - -Loading this package implements a more fine-grained minibuffer -completion feedback scheme. Prospective completions are concisely -indicated within the minibuffer itself, with each successive keystroke. - - See `icomplete-completions' docstring for a description of the -icomplete display format. - - See the `icomplete-minibuffer-setup-hook' docstring for a means to -customize icomplete setup for interoperation with other -minibuffer-oriented packages. - - To activate `icomplete mode', load the package and use the -`icomplete-mode' function. You can subsequently deactivate it by -invoking the function `icomplete-mode' with a negative prefix-arg `(C-U --1 ESC-x icomplete-mode'). Also, you can prevent activation of the -mode during package load by first setting the variable `icomplete-mode' -to nil. Icompletion can be enabled any time after the package is -loaded by invoking `icomplete-mode' without a prefix arg. - - To configure this package, type: - - M-x customize-group RET icomplete RET - - -File: edit-utils.info, Node: tempo, Next: avoid, Prev: icomplete, Up: Top - -25 Flexible Template Insertion -****************************** - -This file provides a simple way to define powerful templates, or -macros, if you wish. It is mainly intended for, but not limited to, -other programmers to be used for creating shortcuts for editing certain -kind of documents. It was originally written to be used by a HTML -editing mode written by Nelson Minar , and his -`html-helper-mode.el' is probably the best example of how to use this -program. - - A template is defined as a list of items to be inserted in the -current buffer at point. Some of the items can be simple strings, while -other can control formatting or define special points of interest in -the inserted text. - - If a template defines a "point of interest" that point is inserted -in a buffer-local list of "points of interest" that the user can jump -between with the commands `tempo-backward-mark' and -`tempo-forward-mark'. If the template definer provides a prompt for the -point, and the variable `tempo-interactive' is non-nil, the user will -be prompted for a string to be inserted in the buffer, using the -minibuffer. - - The template can also define one point to be replaced with the -current region if the template command is called with a prefix (or a -non-nil argument). - - More flexible templates can be created by including lisp symbols, -which will be evaluated as variables, or lists, which will be evaluated -as lisp expressions. - - See the documentation for `tempo-define-template' for the different -items that can be used to define a tempo template. - - One of the more powerful features of tempo templates are automatic -completion. With every template can be assigned a special tag that -should be recognized by `tempo-complete-tag' and expanded to the -complete template. By default the tags are added to a global list of -template tags, and are matched against the last word before point. But -if you assign your tags to a specific list, you can also specify -another method for matching text in the buffer against the tags. In the -HTML mode, for instance, the tags are matched against the text between -the last `<' and point. - - When defining a template named `foo', a symbol named -`tempo-template-foo' will be created whose value as a variable will be -the template definition, and its function value will be an interactive -function that inserts the template at the point. - - To configure this package, type: - - M-x customize-group RET tempo RET - - -File: edit-utils.info, Node: avoid, Next: blink-cursor, Prev: tempo, Up: Top - -26 Move Mouse Pointer Out of the Way of Editing -*********************************************** - -For those who are annoyed by the mouse pointer obscuring text, this mode -moves the mouse pointer - either just a little out of the way, or all -the way to the corner of the frame. To use, type `M-x -mouse-avoidance-mode'. To set up permanently, add the following to -your initialization file: - - (if window-system (mouse-avoidance-mode 'animate)) - - The `'animate' can be `'jump' or `'banish' or `'exile' or `'protean' -if you prefer. See the documentation for function -`mouse-avoidance-mode' for details of the different modes. - - For added silliness, make the animatee animate by put something -similar to the following into your initialization file: - - (if window-system - (mouse-avoidance-set-pointer-shape - (eval (nth (random 4) - '(x-pointer-man x-pointer-spider - x-pointer-gobbler x-pointer-gumby))))) - - For completely random pointer shape, replace the `setq' above with -`(setq x-pointer-shape (mouse-avoidance-random-shape))'. - - To configure this package, type: - - M-x customize-group RET avoid RET - - -File: edit-utils.info, Node: blink-cursor, Next: fast-lock, Prev: avoid, Up: Top - -27 Blinking Cursor -****************** - -To activate this package, type: - - M-x blink-cursor-mode RET - - To configure this package, type: - - M-x customize-group RET blink-cursor RET - - -File: edit-utils.info, Node: fast-lock, Next: lazy-lock, Prev: blink-cursor, Up: Top - -28 Speeding Up Font Lock Mode -***************************** - -Lazy Lock mode is a Font Lock support mode. It makes visiting a file -in Font Lock mode faster by restoring its face text properties from -automatically saved associated Font Lock cache files. - - See also the lazy-lock package. (But don't use the two at the same -time!) - - To use this package, add the following to your initialization file: - - (setq font-lock-support-mode 'fast-lock-mode) - - Start up a new Emacs and use font-lock as usual (except that you can -use the so-called "gaudier" fontification regexps on big files without -frustration). - - When you visit a file (which has `font-lock-mode' enabled) that has a -corresponding Font Lock cache file associated with it, the Font Lock -cache will be loaded from that file instead of being generated by Font -Lock code. - - To configure this package, type: - - M-x customize-group RET fast-lock RET - - -File: edit-utils.info, Node: lazy-lock, Next: lazy-shot, Prev: fast-lock, Up: Top - -29 Lazy Demand-Driven Fontification -*********************************** - -The purpose of this library is to make visiting buffers in -`font-lock-mode' faster by making fontification demand-driven and -stealthy. Fontification only occurs when, and where, necessary. - - See also the fast-lock and lazy-shot packages. (But don't use them -at the same time as lazy-lock!) - - To use this package, add the following to your initialization file: - - (setq font-lock-support-mode 'lazy-lock-mode) - - Start up a new XEmacs and use font-lock as usual (except that you -can use the so-called "gaudier" fontification regexps on big files -without frustration). - - In a buffer (which has `font-lock-mode' enabled) which is at least -`lazy-lock-minimum-size' characters long, only the visible portion of -the buffer will be fontified. Motion around the buffer will fontify -those visible portions that were not previous fontified. - - If stealth fontification is enabled, fontification will occur in -invisible parts of the buffer after `lazy-lock-stealth-time' seconds of -idle time. - - To configure this package, type: - - M-x customize-group RET lazy-lock RET - - -File: edit-utils.info, Node: lazy-shot, Next: mic-paren, Prev: lazy-lock, Up: Top - -30 Another Lazy Demand-Driven Fontification -******************************************* - -This is an experimental demand based font-lock implementation. It is -experimental in the sense that it relies on C support from the redisplay -engine, that is experimental. The code in this file is more or less -finished. The C code support experimental because the current design is -rumoured to be ugly. Secondly because XEmacs does actually display the -"un-font-locked" parts of the buffer first, the user notices flashing -as the buffer is repainted with color/fonts. - - To use this package, add the following to your initialization file: - - (add-hook 'font-lock-mode-hook 'turn-on-lazy-shot) - - Do not use in combination with `lazy-lock'. - - M-x customize-group RET lazy-shot RET - - -File: edit-utils.info, Node: mic-paren, Next: paren, Prev: lazy-shot, Up: Top - -31 Advanced Highlighting of Matching Parentheses -************************************************ - -Load this file, activate it and Emacs will display highlighting on -whatever parenthesis (and paired delimiter if you like this) matches -the one before or after point. This is an extension to the paren.el -file distributed with Emacs. The default behaviour is similar to -paren.el but more sophisticated. Normally you can try all default -settings to enjoy mic-paren. - - Or - if you are a LaTeX writer like the current maintainer - try the -following additional setup in your initialization file: - - ;; In LaTeX-mode we want this - (add-hook 'LaTeX-mode-hook - (function (lambda () - (paren-toggle-matching-quoted-paren 1) - (paren-toggle-matching-paired-delimiter 1)))) - - Or - if you are programming in C like languages - try also: - - (add-hook 'c-mode-common-hook - (function (lambda () - (paren-toggle-open-paren-context 1)))) - - `mic-paren.el' is an extension and replacement to the packages -`paren.el' and `stig-paren.el' for Emacs. When mic-paren is active -Emacs normal parenthesis matching is deactivated. Instead parenthesis -matching will be performed as soon as the cursor is positioned at a -parenthesis. The matching parenthesis (or the entire expression between -the parentheses) is highlighted until the cursor is moved away from the -parenthesis. - - Features include: - - * Both forward and backward parenthesis matching (simultaneously if - cursor is between two expressions). - - * Indication of mismatched parentheses. - - * Recognition of "escaped" (also often called "quoted") parentheses. - - * Option to match "escaped" parens too, especially in (La)TeX-mode - (e.g. matches expressions like "\(foo bar\)" properly). - - * Offers two functions as replacement for `forward-sexp' and - `backward-sexp' which handle properly quoted parens (s.a.). These - new functions can automatically be bounded to the original binding - of the standard `forward-sexp' and `backward-sexp' functions. - - * Option to activate matching of paired delimiter (i.e. characters - with syntax '$'). This is useful for writing in LaTeX-mode for - example. - - * Option to select in which situations (always, never, if match, if - mismatch) the entire expression should be highlighted or only the - matching parenthesis. - - * Message describing the match when the matching parenthesis is - off-screen (vertical and/or horizontal). Message contains either - the linenumber or the number of lines between the two matching - parens. Option to select in which cases this message should be - displayed. - - * Optional delayed highlighting (useful on slow systems), - - * Functions to activate/deactivate `mic-paren.el' are provided. - - * Numerous options to control the behaviour and appearance of - `mic-paren.el'. - - - To configure this package, type: - - M-x customize-group RET mic-paren-matching RET - - -File: edit-utils.info, Node: paren, Next: shell-font, Prev: mic-paren, Up: Top - -32 Highlight (Un)matching Parens and Whole Expressions -****************************************************** - -This package highlights matching parens (or whole sexps) for easier -editing of source code, particularly lisp source code. - - The `paren-highlight' hook function runs after each command and -checks to see if the cursor is at a parenthesis. If so, then it -highlights, in one of several ways, the matching parenthesis. - - Priority is given to matching parentheses right before the cursor -because that's what makes sense when you're typing a lot of closed -parentheses. This is especially intuitive if you frequently use -`forward-sexp' (`M-C-f') and `backward-sexp' (`M-C-b') to maneuver -around in source code. - - Different faces are used for matching and mismatching parens so that -it is easier to see mistakes as you type them. Audible feedback is -optional. - - If a (mis)matching paren is offscreen, then a message is sent to the -modeline. - - If `paren-mode' is `sexp', entire S-expressions are highlighted -instead of just matching parens. - - To configure this package, type: - - M-x customize-group RET paren-matching RET - - -File: edit-utils.info, Node: shell-font, Next: highline, Prev: paren, Up: Top - -33 Decorate a Shell Buffer With Fonts -************************************* - -Do this: `(add-hook 'shell-mode-hook 'install-shell-fonts)' and the -prompt in your shell-buffers will appear bold-italic, process output -will appear in normal face, and typein will appear in bold. - - The faces `shell-prompt', `shell-input' and `shell-output' can be -modified as desired, for example, `(copy-face 'italic 'shell-prompt)'. - - -File: edit-utils.info, Node: highline, Next: after-save-commands, Prev: shell-font, Up: Top - -34 Highlight the Current Line in the Buffer -******************************************* - -This package is a minor mode to highlight the current line in buffer. - - The mode supports the following modes of operation: - - * LOCAL highline - - * GLOBAL highline - - * INDIRECT highline - - - Both Local and Global minor modes may be in use at the same time. - - Indirect highline (`highline-view-on', `highline-view-off' and -`highline-view-mode') is useful when you wish to have various "visions" -of the same buffer. Indirect highline uses an indirect buffer to get -the "vision" of the buffer. So, if you kill an indirect buffer, the -base buffer is not affected; if you kill the base buffer, all indirect -buffer related with the base buffer is automagically killed. Also, any -text insertion/deletion in any indirect or base buffer is updated in -all related buffers. - -* Menu: - -* Key Bindings and Example Usage: highline-keys. -* Hooks: highline-hooks. -* Options: highline-options. - - -File: edit-utils.info, Node: highline-keys, Next: highline-hooks, Prev: highline, Up: highline - -34.1 Key Bindings and Example Usage -=================================== - -It might be useful to set up some global key bindings as follows: - - (global-set-key "\C-c\C-a" 'highline-on) - (global-set-key "\C-c\C-b" 'highline-off) - (global-set-key "\C-c\C-l" 'highline-local-mode) - (global-set-key "\C-c\C-d" 'highline-mode-on) - (global-set-key "\C-c\C-e" 'highline-mode-off) - (global-set-key "\C-c\C-g" 'highline-mode) - (global-set-key "\C-c\C-c" 'highline-customize) - (global-set-key "\C-c\C-v\C-n" 'highline-view-on) - (global-set-key "\C-c\C-v\C-f" 'highline-view-off) - (global-set-key "\C-c\C-v\C-t" 'highline-view-mode) - - As an example, try to insert this in your .emacs file: - - (require 'highline) - ;; Turn on local highlighting for Dired (C-x d) - (add-hook 'dired-after-readin-hook 'highline-on) - ;; Turn on local highlighting for list-buffers (C-x C-b) - (defadvice list-buffers (after highlight-line activate) - (save-excursion - (set-buffer "*Buffer List*") - (highline-on))) - - -File: edit-utils.info, Node: highline-hooks, Next: highline-options, Prev: highline-keys, Up: highline - -34.2 Hooks -========== - -highline has the following hook variables: - -`highline-hook' - It is evaluated always when highline is turned on globally. - -`highline-local-hook' - It is evaluated always when highline is turned on locally. - -`highline-view-hook' - It is evaluated always when indirect highline is turned on. - -`highline-load-hook' - It is evaluated after highline package is loaded. - - - -File: edit-utils.info, Node: highline-options, Prev: highline-hooks, Up: highline - -34.3 Options -============ - -This is a brief description of highline options. Please see the options -declarations in the code for more detail. - -`highline-face' - Specify face used to highlight the current line. - -`highline-vertical-face' - Specify face used to highlight other than current line. - -`highline-line' - Specify which part of line should be highlighted. - -`highline-vertical' - Specify how many vertical lines should be highlighted. - -`highline-verbose' - Non-nil means generate messages. - -`highline-ignore-regexp' - Specify regexp for buffers to ignore. - -`highline-priority' - Specify highline overlay priority. - -`highline-selected-window' - Non-nil means highlight current line on current window. - - - To configure this package, type: - - M-x highline-customize RET - - -File: edit-utils.info, Node: after-save-commands, Next: atomic-extents, Prev: highline, Up: Top - -35 Hooks Invoked After Saving a File -************************************ - -Set up a list of file-name matching regular expressions associated with -shell commands or lisp forms to run after saving the file. - - This is good for things like running `newaliases(1)' on -`/etc/aliases', `xrdb(1)' on `~/.Xresources', installing a new -`~/.crontab', as well as for sending signals to daemons whose -configuration files you've just finished editing. - - It is much safer and more powerful than using exec statements in -"Local Variables" sections, and can safely be used by root for system -administration tasks. The shell command can run about anything you can -think of. - - See variable `After-save-alist' for more information. - - -File: edit-utils.info, Node: atomic-extents, Next: array, Prev: after-save-commands, Up: Top - -36 Indivisible Blocks of Text -***************************** - -Point is not allowed to fall inside of an atomic extent. This has the -effect of making all text covered by an atomic extent be treated as a -single object. Normally point will be adjusted to an end of an atomic -extent in the direction of motion. If point appears inside of an -atomic extent (via `goto-char' for example), point will be adjusted to -the side closest to the entry point. - - To make this feature available, add the following to your -initialization file: - - (require 'atomic-extents) - - To make an extent atomic use the command: - - (set-extent-property # 'atomic t) - - -File: edit-utils.info, Node: array, Next: floating-toolbar, Prev: atomic-extents, Up: Top - -37 Table and Array Editor -************************* - -Commands for editing a buffer interpreted as a rectangular array or -matrix of whitespace-separated strings. You specify the array -dimensions and some other parameters at startup time. - - -File: edit-utils.info, Node: floating-toolbar, Next: The Toolbar Utilities, Prev: array, Up: Top - -38 Floating Toolbar -******************* - -The command `floating-toolbar' pops up a small frame containing a -toolbar. The command should be bound to a button-press event. If the -mouse press happens over an extent that has a non-nil -`'floating-toolbar' property, the value of that property is the toolbar -instantiator that will be displayed. Otherwise the toolbar displayed -is taken from the variable `floating-toolbar'. This variable can be -made buffer local to produce buffer local floating toolbars. - - `floating-toolbar-or-popup-mode-menu' works like `floating-toolbar' -except that if no toolbar is found, `popup-mode-menu' is called. - - `floating-toolbar-from-extent-or-popup-mode-menu' works like -`floating-toolbar-or-popup-mode-menu' except only extent local toolbars -are used; the value of floating-toolbar is not used. - - Add the following line to your initialization file: - - (require 'floating-toolbar) - - You will also need to bind a mouse click to `floating-toolbar' or to -`floating-toolbar-or-popup-mode-menu'. - - -File: edit-utils.info, Node: The Toolbar Utilities, Next: foldout, Prev: floating-toolbar, Up: Top - -39 The Toolbar Utilities -************************ - -The toolbar utilities are a set of Emacs commands and Lisp functions for -convenient creation and management of toolbars. Common usages such as -creating and adding toolbar buttons to invoke commands and keyboard -macros are implemented as user commands. Convenience APIs are provided -to create buttons, add them to toolbars, kill them from toolbars, and -finding a particular button, or a button with certain content, in a -toolbar. - - The toolbar utilities are implemented in three files: - -`toolbar-utils.el' - The toolbar utility APIs and user commands. - -`edit-toolbar.el' - The near-WYSIWYG toolbar editor by Peter D. Pezaris. - -`xemacs-toolbar.el' - The XEmacs compatibility API for programs that should also run - under GNU Emacs. - - The author would like to thank Jeff Miller and Peter D. Pezaris for -the original API and the toolbar editor, respectively, and David -Kastrup and Jamie Zawinski for the pedal-gluteal impetus that resulted -in the recent revision of these libraries described in this manual. - -* Menu: - -* Adding Buttons on the Fly:: Quick and convenient. -* The Toolbar Editor:: Power tools for customization. -* APIs for Adding and Killing:: For Lisp programmers. -* APIs for Search:: Button, button, who's got the button? -* Toolbar Portability:: The `xemacs-toolbar.el' library. - - -File: edit-utils.info, Node: Adding Buttons on the Fly, Next: The Toolbar Editor, Prev: The Toolbar Utilities, Up: The Toolbar Utilities - -39.1 Adding Buttons on the Fly -============================== - - -- Group: edit-toolbar - Customize group of tools for interactive editing and - non-interactive management of toolbars. - - -- Variable: toolbar-button-default-position - Default position for adding toolbar buttons on the fly. The value - may be a non-negative integer (0 is leftmost), or one of the - symbols `left', `right', or `extreme-right'. `left' is synonymous - with 0, and `extreme-right' is synonymous with `(length toolbar)'. - `right' specifies placing a new item at the right end of the - flush-left group of buttons. - - Default value: `right'. Customize type: sexp. - - See also `toolbar-add-button', *Note APIs for Adding and Killing::. - - -- Command: toolbar-add-button-on-the-fly description command label - &optional position locale - Add an button at POSITION to the default toolbar of the selected - window. Returns `t'. - - The return value may change. Tell stephen@xemacs.org what value - you think would be (most) useful. - - DESCRIPTION - A string describing the action, and displayed as help. - - COMMAND - An interactive command (ie, a symbol with an interactive - function definition) implementing the action. - - LABEL - A string used to label the button. - - POSITION - Optional. A position (a non-negative integer, or one of the - symbols `left', `right', or `extreme-right'. - - Default: `right'. - - LOCALE - Optional. A specifier locale, defaulting to the current - buffer. If current-buffer-only is not what you want, and you - don't understand specifier locales, use `global'. It's safe - and probably does what you want. - - -- Command: toolbar-add-kbd-macro mac icon is-file - Add a button invoking a keyboard macro to the toolbar. The button - is added at the end of the left group. - - MAC - A keyboard macro name, or the empty string or nil to use a - copy of the last keyboard macro defined. - - ICON - A string specifying the icon to be used. If IS-FILE is - non-`nil', it is interpreted as the name of an image file, and - searched for using `locate-data-file'. Otherwise it is used - verbatim as a label. - - IS-FILE - Determines the treatment of ICON (q.v.). - - Used interactively, prompts for the macro name MAC and an ICON. - IS-FILE is non-`nil' if a prefix argument was used. - - -- Function: toolbar-add-execute-macro-button - Add a button to the global toolbar to execute the last keyboard - macro. - - Unlike `toolbar-add-kbd-macro', this does not copy the macro. The - macro executed will change with redefinitions. - - Due to a simple implementation, this button will not appear in - buffers with local toolbars if invoked after the toolbar is - installed. If you like this button, it's probably best to invoke - this function in your init file. - - -- Function: toolbar-execute-last-kbd-macro - Toolbar thunk which executes the most recently defined keyboard - macro. - - -- Command: restore-initial-toolbar - Restores the default toolbar defined by `initial-toolbar-spec'. - - There is also a cache of killed buttons in `button-palette'. - - -File: edit-utils.info, Node: The Toolbar Editor, Next: APIs for Adding and Killing, Prev: Adding Buttons on the Fly, Up: The Toolbar Utilities - -39.2 The Toolbar Editor -======================= - -To use `edit-toolbar.el', simply type `M-x edit-toolbar RET'. - - For help on the various commands you can type in a -`edit-toolbar' buffer. To save a modified toolbar type `C-x C-s' in an -`edit-toolbar' buffer. If you want to use a saved toolbar in your -future XEmacs sessions, add the following line of code to your init -file: - - (load "~/.xemacs/.toolbar") - - Here is a table of commands and bindings available in -`edit-toolbar-mode'. These commands are also available from the `Edit -Toolbar' menu. - -`q' - `edit-toolbar-quit': Bury the `edit-toolbar' buffer. - -`p' -`DEL' - `edit-toolbar-previous': Select the previous item (line). - -`n' -`SPC' -`RET' - `edit-toolbar-next': Select the next item (line). - -`?' - `describe-mode': Help. - -`f' - `edit-toolbar-set-function': Set the command for the current - button. - -`h' - `edit-toolbar-set-help': Set the help string for the current - button. - -`a' - `edit-toolbar-add-button': Add a new empty button. - -`2' - `edit-toolbar-add-separator-2D-narrow': Add a new narrow 2D - fixed-width spacer. - -`@' - `edit-toolbar-add-separator-2D-wide': Add a new wide 2D - fixed-width spacer. - -`3' - `edit-toolbar-add-separator-3D-narrow': Add a new narrow 3D - fixed-width spacer. - -`#' - `edit-toolbar-add-separator-3D-wide': Add a new wide 3D - fixed-width spacer. - -`R' - `edit-toolbar-add-separator-right-left': Place the filler - separator, which expands to create a flush-left group of buttons - and spacers and a flush-right group. - -`c' - `edit-toolbar-copy': Copy the selected button. - -`d' - `edit-toolbar-down': Reorder the buttons by moving the selected - button down (to the right on a horizontal toolbar). - -`u' - `edit-toolbar-up': Reorder the buttons by moving the selected - button up (to the left on a horizontal toolbar). - -`k' - `edit-toolbar-kill': Kill the selected button. - -`s' -`C-x C-s' - `edit-toolbar-save': Save the current buffer to - `~/.xemacs/.toolbar' in a format that allows it to be reloaded. - -`r' - `edit-toolbar-restore': Restore the original toolbar (ie, before - this editing session started). - - - -File: edit-utils.info, Node: APIs for Adding and Killing, Next: APIs for Search, Prev: The Toolbar Editor, Up: The Toolbar Utilities - -39.3 APIs for Adding and Killing -================================ - - -- Variable: button-palette - List of buttons cut from toolbars. - - Note this is actually a toolbar descriptor. - - -- Function: toolbar-add-item toolbar-spec item &optional position - Add ITEM to TOOLBAR-SPEC at POSITION, and return TOOLBAR-SPEC. - Uses functions that alter list structure. - - ITEM - A toolbar button or spacer specification (eg, from - `toolbar-new-button' or `toolbar-new-spacer'). - - TOOLBAR-SPEC - A toolbar descriptor (eg, from `toolbar-new-toolbar'). - - POSITION - Optional. A non-negative integer, with 0 being the extreme - left and \(length TOOLBAR-SPEC) the extreme right. The - symbols `left', `right', and `extreme-right' are also - accepted. `left' is synonymous with 0. `right' places ITEM - at the right end of the left group of buttons. - `extreme-right' places ITEM at the extreme right of the - toolbar, creating a right group if one does not exist. - - #### This function does not yet support inserting the group - delimiter nil as an explicit item. - - POSITION may be greater than (length TOOLBAR-SPEC), in which case - it is truncated to (length TOOLBAR-SPEC). Note that `(length - TOOLBAR-SPEC)' is not synonymous with `right' or `extreme-right' - (`extreme-right' will create a right group if it doesn't already - exist). - - -- Function: toolbar-new-button icon-spec command help-string - &optional initially-disabled - Return a checked toolbar button specification. - - ICON-SPEC - A list of glyphs (from `make-glyph'), a glyph, or a string to - use as the button's icon. If a string or single glyph, it - will be used for the button-up glyph. If a list, it may - contain 1 to 6 glyphs, which XEmacs will use for button up, - button down, button disabled, button up with caption, button - down with caption, and button disabled with caption, in that - order. Missing or nil glyphs will be defaulted. (#### - Strings as list elements are not supported but could be.) - - COMMAND - The (interactive) command to invoke when the button is - pressed. - - HELP-STRING - A string briefly describing the command, displayed in the - echo area or as balloon help when the pointer enters the - button. - - INITIALLY-DISABLED - Optional. If non-`nil', specifies that the button should - initially be disabled. - - See `default-toolbar' or the Lispref (*note Toolbars: - (lispref)Toolbars.) for more information. - - -- Function: toolbar-new-spacer style &optional size - Returns a checked toolbar spacer "button". - - STYLE - One of the symbols `2d' or `3d', indicating whether the area - is displayed without shadows (giving it a flat appearance), - or with shadows (giving it a raised, 3-D appearance). There - is no default. #### We may set a default style. Tell - stephen@xemacs.org which you use. - - SIZE - Specifies the length, in pixels, of the blank area. If - omitted, it defaults to a device-specific value (8 pixels for - X devices). - - -- Function: make-toolbar-instantiator &optional toolbar-spec domain - Return a checked toolbar instantiator, a list of vectors. - - TOOLBAR-SPEC - May be a list of buttons (ie, a toolbar descriptor, see - `default-toolbar'), a toolbar specifier object, a symbol whose - value is a toolbar specifier object, or `nil'. If `nil', - returns a null list. If a toolbar specifier object or - variable containing one, the specification for DOMAIN is - used. If non-nil, DOMAIN must be a window, a frame, or a - device, otherwise it defaults to the selected window (see - `specifier-instance'). The list thus generated is checked and - returned. - - If TOOLBAR-SPEC is a list, it is copied; it is safe to pass - other packages' toolbar initializers to this function. - However, you probably do not want to change any of the - objects in the returned specification. They are returned as - is, not copied. - - See `default-toolbar' or the Lispref (*note Toolbars: - (lispref)Toolbars.) for more information. - - -- Function: toolbar-kill-item-pos pos &optional toolbar locale - Kill the item at position POS of TOOLBAR in LOCALE. Killed - buttons are prepended to `button-palette'. - - LOCALE defaults to `global'. If there are multiple specs for - LOCALE, take the first one. - - This function currently does not accept symbolic positions a la - `toolbar-add-item'. Use `toolbar-find-item' to locate whole - buttons and spacers, and `toolbar-find-button' to locate buttons by - characteristics. See also `toolbar-find-button-by-icon', - `toolbar-find-button-by-command', and - `toolbar-find-button-by-help-string'. - - -File: edit-utils.info, Node: APIs for Search, Next: Toolbar Portability, Prev: APIs for Adding and Killing, Up: The Toolbar Utilities - -39.4 APIs for Search -==================== - - -- Function: toolbar-find-button item &optional toolbar locale - Return the position of a button containing ITEM in its - specification. - - ITEM - May specify a button, spacer, icon, command, help string, or - nil. If ITEM is nil, find the separator between the group of - buttons to be left justified, and the group to be right - justified. (Distinctions among the various "search key - types" are somewhat heuristic but are probably reliable - enough to use in library code.) - - TOOLBAR - If non-`nil', search it; otherwise search the default toolbar. - - LOCALE - If non-`nil', get TOOLBAR's descriptor in that locale, - otherwise use the `global' locale. - - -- Function: toolbar-find-item item &optional toolbar locale - Return the position of ITEM, a button, spacer, or nil. TOOLBAR - and LOCALE determine the descriptor to be searched. - - If ITEM is nil, find the separator between the group of buttons to - be left justified, and the group to be right justified. If there - are several matching items, the first is returned. If none is - found, return nil. - - -- Function: toolbar-find-button-by-icon icon &optional toolbar locale - Return the position of a button with icon ICON. ICON must be a - list of glyphs or a symbols whose value is a list of glyphs. - TOOLBAR and LOCALE determine the descriptor to be searched. - - If there are several matching buttons, the first is returned. - - -- Function: toolbar-find-button-by-command cmd &optional toolbar - locale - Return the position of a button invoking command CMD. TOOLBAR and - LOCALE determine the descriptor to be searched. - - If there are several matching buttons, the first is returned. - - -- Function: toolbar-find-button-by-help-string str &optional toolbar - locale - Return the position of a button with help-string STR. TOOLBAR and - LOCALE determine the descriptor to be searched. - - If there are several matching buttons, the first is returned. - This function will not find spacers. - - -- Function: toolbar-find-button-by-element object index toolbar - locale &optional thunk - Return the position of a button containing OBJECT in element - INDEX. TOOLBAR and LOCALE determine the descriptor to be searched. - - Optional argument THUNK is a function of one argument which is - used to normalize OBJECT for comparison. - - If there are several matching buttons, the first is returned. - This function will not find spacers. - - -File: edit-utils.info, Node: Toolbar Portability, Prev: APIs for Search, Up: The Toolbar Utilities - -39.5 Toolbar API Portability to GNU Emacs -========================================= - -The `xemacs-toolbar.el' library provides XEmacs toolbar compatibility -functions for GNU Emacs. - - Third-party maintainers may use the same APIs in GNU Emacs as in -XEmacs. Simply provide this library with your own code, and load it -conditionally: - - (if (featurep 'xemacs) - (require 'toolbar-utils) - (require 'toolbar-utils "xemacs-toolbar")) - - XEmacs features that are not present in GNU Emacs will be ignored, -and various arguments with different semantics will be defaulted -appropriately. - - User commands such as `toolbar-add-kbd-macro' and advanced features -such as the toolbar editor and the button cache are not presently -provided. - - -File: edit-utils.info, Node: foldout, Next: func-menu, Prev: The Toolbar Utilities, Up: Top - -40 Folding Extensions for Outline-Mode -************************************** - -This file provides folding editor extensions for `outline-mode' and -`outline-minor-mode' buffers. What's a "folding editor"? Read on... - - Imagine you're in an `outline-mode' buffer and you've hidden all the -text and subheadings under your level-1 headings. You now want to look -at the stuff hidden under one of these headings. Normally you'd do `C-c -C-e' `(show-entry)' to expose the body or `C-c C-i' to expose the child -(level-2) headings. - - With foldout, you do `C-c C-z' (`foldout-zoom-subtree'). This -exposes the body and child subheadings and narrows the buffer so that -only the level-1 heading, the body and the level-2 headings are -visible. If you now want to look under one of the level-2 headings, -position the cursor on it and do `C-c C-z' again. This exposes the -level-2 body and its level-3 child subheadings and narrows the buffer -again. You can keep on zooming in on successive subheadings as much as -you like. A string in the modeline tells you how deep you've gone. - - When zooming in on a heading you might only want to see the child -subheadings. You do this by specifying a numeric argument: `C-u C-c -C-z'. You can specify the number of levels of children too (c.f. -`show-children'): e.g. `M-2 C-c C-z' exposes two levels of child -subheadings. Alternatively, you might only be interested in the body. -You do this by specifying a negative argument: `M-- C-c C-z'. You can -also cause the whole subtree to be expanded, similar to `C-c C-s' -(`show-subtree'), by specifying a zero argument: `M-0 C-c C-z'. - - While you're zoomed in you can still use outline-mode's exposure and -hiding functions. It won't upset foldout at all. Also, since the -buffer is narrowed, "global" editing actions will only affect the stuff -under the zoomed-in heading. This is useful for restricting changes to -a particular chapter or section of your document. - - You unzoom (exit) a fold by doing `C-c C-x' (`foldout-exit-fold'). -This hides all the text and subheadings under the top-level heading and -returns you to the previous view of the buffer. Specifying a numeric -argument exits that many folds. Specifying a zero argument exits *all* -folds. - - You might want to exit a fold *without* hiding the text and -subheadings. You do this by specifying a negative argument. For -example, `M--2 C-c C-x' exits two folds and leaves the text and -subheadings exposed. - - Foldout also provides mouse bindings for entering and exiting folds -and for showing and hiding text. Hold down Meta and Control, then -click a mouse button as follows:- - - * mouse-1 (`foldout-mouse-zoom') zooms in on the heading clicked on: - - - single click - expose body - - - double click - expose subheadings - - - triple click - expose body and subheadings - - - quad click - expose entire subtree - - - * mouse-2 (`foldout-mouse-show') exposes text under the heading - clicked on: - - - single click - expose body - - - double click - expose subheadings - - - triple click - expose body and subheadings - - - quad click - expose entire subtree - - - * mouse-3 (`foldout-mouse-hide-or-exit') hides text under the - heading clicked on or exits the fold: - - - single click - hide subtree - - - double click - exit fold and hide text - - - triple click - exit fold without hiding text - - - quad click - exit all folds and hide text - - - - You can change the modifier keys used by setting -`foldout-mouse-modifiers'. - - To use foldout, put this in your initialization file: - - (require 'foldout) - - If you don't want it loaded until you need it, try this instead: - - (eval-after-load "outline" '(require 'foldout)) - - -File: edit-utils.info, Node: func-menu, Next: id-select, Prev: foldout, Up: Top - -41 Jump to a Function Within a Buffer. -************************************** - -Suppose you have a file with a lot of functions in it. Well, this -package makes it easy to jump to any of those functions. The names of -the functions in the current buffer are automatically put into a -menubar menu, you select one of the function-names and the point is -moved to that very function. The mark is pushed on the mark-ring, so -you can easily go back to where you were. Alternatively, you can use -enter the name of the desired function via the minibuffer which offers -completing read input. In addition, the name of the function before -point is optionally displayed in the modeline. - - The following modes are supported: - - Ada, Assembly, BibTex, C++, C, Dired, Ehdm, ELisp, FORTRAN, Ksh, -Latex, Lelisp, Makefile, Maple, Modula2, Modula3, Outline, Objective-C, -Pascal, Perl, Postscript, Prolog, PVS, Python, SGML, Scheme, Tcl, -Verilog, Manual, Ruby, JavaScript - - To install this package, add the following to your initialization -file: - - (add-hook 'find-file-hooks 'fume-setup-buffer) - (add-hook 'Manual-mode-hook 'turn-on-fume-mode) - - -File: edit-utils.info, Node: id-select, Next: outl-mouse, Prev: func-menu, Up: Top - -42 Select Syntax-Driven Regions in a Buffer -******************************************* - -This is a radically cool, drop in mouse and keyboard-based library for -selecting successively bigger syntactical regions within a buffer. -Simply load this library and you are ready to try it out by -double-clicking on various kinds of characters in different buffer -major modes. You'll quickly get the hang of it. (It also provides a -command to jump between beginning and end tags within HTML and SGML -buffers.) - - A great deal of smarts are built-in so that it does the right thing -almost all of the time; many other attempts at similar behavior such as -`thing.el' fail to deal with many file format complexities. - - Double clicks of the Selection Key (left mouse key) at the same -point will select bigger and bigger regions with each successive use. -The first double click selects a region based upon the character at the -point of the click. For example, with the point over an opening or -closing grouping character, such as { or }, the whole grouping is -selected, e.g. a C function. When on an _ or - within a programming -language variable name, the whole name is selected. The type of -selection is displayed in the minibuffer as feedback. When using a -language based mainly on indenting, like Bourne shell, a double click -on the first alpha character of a line, such as an if statement, -selects the whole statement. - - This whole package is driven by a single function, available in -mouse and keyboard forms, that first marks a region based on the syntax -category of the character following point. Successive invocations mark -larger and larger regions until the whole buffer is marked. See the -documentation for the function, `id-select-syntactical-region', for the -kinds of syntax categories handled. - - Loading this package automatically installs its functionality on -double-clicks (or higher) of the left mouse key. (See the -documentation for the variable, `mouse-track-click-hook', for how this -is done.) A single click of the left button will remove the region and -reset point. - - The function, `id-select-thing', may be bound to a key to provide the -same syntax-driven region selection functionality. `C-c C-m' is a -reasonable site-wide choice since this key is seldom used and it -mnemonically indicates marking something. `C-c s' may be preferred as -a personal binding. - - Use `C-g' to unmark the region when done. Use, -`id-select-thing-with-mouse', if you want to bind this to a mouse key -and thereby use single clicks instead of double clicks. - - Three other commands are also provided: - -`id-select-and-copy-thing' - mark and copy the syntactical unit to the kill ring - -`id-select-and-kill-thing' - kill the syntactical unit at point - -`id-select-goto-matching-tag' - In HTML and SGML modes (actually any listed in the variable, - `id-select-markup-modes'), moves point to the start of the tag - paired with the closest tag that point is within or which it - precedes, so you can quickly jump back and forth between open and - close tags. - - - To autoload this package via mouse usage, add the following line to -one of your initialization files: - - (add-hook 'mouse-track-click-hook 'id-select-double-click-hook) - - To configure this package, type: - - M-x customize-group RET id-select RET - - -File: edit-utils.info, Node: outl-mouse, Next: page-ext, Prev: id-select, Up: Top - -43 Outline-Mode Mouse Commands -****************************** - -Defines `mouse button one' to hide blocks when clicked on -outline-up-arrow and expand blocks when clicked on outline-down-arrow. -Features are activated when `outline-minor-mode' or `outline-mode' are -turned on. There is also a menu for each glyph on `mouse button 3'. - - To use, add the following to your initialization file: - - (require 'outl-mouse) - - If you use func-menu all the time and want outl-mouse on all the -time as well then specify `(setq outline-sync-with-func-menu t)'. -Outlining will then be turned on when func-menu is activated. - - If you want mac-style outlining then set `outline-mac-style' to t. -If you want the outline arrows on the left then set -`outline-glyphs-on-left' to t. If you have xpm then arrows are much -better defined. - - To configure this package, type: - - M-x customize-group RET outl-mouse RET - - -File: edit-utils.info, Node: page-ext, Next: power-macros, Prev: outl-mouse, Up: Top - -44 Extended Page Handling Commands -********************************** - -The page commands are helpful in several different contexts. For -example, programmers often divide source files into sections using the -`page-delimiter'; you can use the `pages-directory' command to list the -sections. - - You may use the page commands to handle an address list or other -small data base. Put each address or entry on its own page. The first -line of text in each page is a `header line' and is listed by the -`pages-directory' or `pages-directory-for-addresses' command. - -* Menu: - -* Key Assignments: page-ext-keys. -* Using the Page Commands: page-ext-using. -* Address List or Small Database: page-ext-addr. - - -File: edit-utils.info, Node: page-ext-keys, Next: page-ext-using, Prev: page-ext, Up: page-ext - -44.1 Key Assignments -==================== - -The current page commands are: - -forward-page C-x ] -backward-page C-x [ -narrow-to-page C-x p -count-lines-page C-x l -mark-page C-x C-p (change this to C-x C-p C-m) -sort-pages not bound -what-page not bound - - The new page handling commands all use `C-x C-p' as a prefix. This -means that the key binding for `mark-page' must be changed. Otherwise, -no other changes are made to the current commands or their bindings. - - The extended page handling commands are: - -next-page C-x C-p C-n -previous-page C-x C-p C-p -search-pages C-x C-p C-s -add-new-page C-x C-p C-a -sort-pages-buffer C-x C-p s -set-page-delimiter C-x C-p C-l -pages-directory C-x C-p C-d -pages-directory-for-addresses C-x C-p d -pages-directory-goto C-c C-c - - -File: edit-utils.info, Node: page-ext-using, Next: page-ext-addr, Prev: page-ext-keys, Up: page-ext - -44.2 Using the Page Commands -============================ - -The page commands are helpful in several different contexts. For -example, programmers often divide source files into sections using the -`page-delimiter'; you can use the `pages-directory' command to list the -sections. - - You may change the buffer local value of the `page-delimiter' with -the `set-page-delimiter' command. This command is bound to `C-x C-p -C-l'. The command prompts you for a new value for the `page-delimiter'. -Called with a prefix-arg, the command resets the value of the -page-delimiter to its original value. - - You may set several user options: - -`pages-directory-buffer-narrowing-p' - Causes the `pages-directory-goto' command to narrow to the - destination page. - -`pages-directory-for-adding-page-narrowing-p' - Causes the `add-new-page' command to narrow to the new entry. - -`pages-directory-for-adding-new-page-before-current-page-p' - Causes the `add-new-page' command to insert a new page before - current page. - - - These variables are all true by default. - - -File: edit-utils.info, Node: page-ext-addr, Prev: page-ext-using, Up: page-ext - -44.3 Address List or Small Database -=================================== - -You may use the page commands to handle an address list or other small -data base. Put each address or entry on its own page. The first line -of text in each page is a `header line' and is listed by the -`pages-directory' or `pages-directory-for-addresses' command. - - Specifically: - - 1. Begin each entry with a `page-delimiter' (which is, by default, - `^L' at the beginning of the line). - - 2. The first line of text in each entry is the `heading line'; it - will appear in the pages-directory-buffer which is constructed - using the `C-x C-p C-d' (`pages-directory') command or the `C-x - C-p d' (`pages-directory-for-addresses') command. - - The heading line may be on the same line as the page-delimiter or - it may follow after. It is the first non-blank line on the page. - Conventionally, the heading line is placed on the line immediately - following the line containing page-delimiter. - - 3. Follow the heading line with the body of the entry. The body - extends up to the next `page-delimiter'. The body may be of any - length. It is conventional to place a blank line after the last - line of the body. - - - For example, a file might look like this: - - FSF - Free Software Foundation - 59 Temple Place - Suite 330 - Boston, MA 02111-1307 USA. - (617) 542-5942 - gnu@prep.ai.mit.edu - - - House Subcommittee on Intellectual Property, - U.S. House of Representatives, - Washington, DC 20515 - - Congressional committee concerned with permitting or preventing - monopolistic restrictions on the use of software technology. - - - George Lakoff - ``Women, Fire, and Dangerous Things: - What Categories Reveal about the Mind'' - 1987, Univ. of Chicago Press - - About philosophy, Whorfian effects, and linguistics. - - - OBI (On line text collection.) - Open Book Initiative - c/o Software Tool & Die - 1330 Beacon St, Brookline, MA 02146 USA - (617) 739-0202 - obi@world.std.com - - In this example, the heading lines are: - - FSF - House Subcommittee on Intellectual Property - George Lakoff - OBI (On line text collection.) - - The `C-x C-p s' (`sort-pages-buffer') command sorts the entries in -the buffer alphabetically. - - You may use any of the page commands, including the `next-page', -`previous-page', `add-new-page', `mark-page', and `search-pages' -commands. - - You may use either the `C-x C-p d' (`pages-directory-for-addresses') -or the `C-x C-p C-d' (`pages-directory') command to construct and -display a directory of all the heading lines. - - In the directory, you may position the cursor over a heading line -and type `C-c C-c' (`pages-directory-goto') to go to the entry to which -it refers in the pages buffer. - - You can type `C-c C-p C-a' (`add-new-page') to add a new entry in -the pages buffer or address file. This is the same command you use to -add a new entry when you are in the pages buffer or address file. - - If you wish, you may create several different directories, one for -each different buffer. - - ``pages-directory-for-addresses' assumes a default addresses file. -You do not need to specify the addresses file but merely type `C-x C-p -d' from any buffer. The command finds the file, constructs a directory -for it, and switches you to the directory. If you call the command -with a prefix arg, `C-u C-x C-p d', it prompts you for a file name. - - You may customize the addresses commands: - -`pages-addresses-file-name' - Determines the name of the addresses file; by default it is - "~/addresses". - -`pages-directory-for-addresses-goto-narrowing-p' - Determines whether `pages-directory-goto' narrows the addresses - buffer to the entry, which it does by default. - -`pages-directory-for-addresses-buffer-keep-windows-p' - Determines whether `pages-directory-for-addresses' deletes other - windows to show as many lines as possible on the screen or works - in the usual Emacs manner and keeps other windows. Default is to - keep other windows. - -`pages-directory-for-adding-addresses-narrowing-p' - Determines whether `pages-directory-for-addresses' narrows the - addresses buffer to a new entry when you are adding that entry. - Default is to narrow to new entry, which means you see a blank - screen before you write the new entry. - - - Call the `pages-directory' command from the buffer for which you -want a directory created; it creates a directory for the buffer and -pops you to the directory. - - The `pages-directory' command has several options: - - 1. Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory' - prompts you for a regular expression and only lists only those - header lines that are part of pages that contain matches to the - regexp. In the example above, `C-u C-x C-p C-d 617 RET' would - match the telephone area code of the first and fourth entries, so - only the header lines of those two entries would appear in the - pages-directory-buffer. - - 2. Called with a numeric argument, the `pages-directory' command - lists the number of lines in each page. This is helpful when you - are printing hardcopy. - - 3. Called with a negative numeric argument, the `pages-directory' - command lists the lengths of pages whose contents match a regexp. - - - To configure this package, type: - - M-x customize-group RET pages RET - - -File: edit-utils.info, Node: power-macros, Next: redo, Prev: page-ext, Up: Top - -45 Power Macros - Keyboard Macros Made Easy -******************************************* - -Keyboard Macros are a very powerful tool, if you know how to use them -the right way! Without this extension it is, however, a bit difficult -in Emacs to define and maintain several macros at a time. This problem -is solved with this package. - - When you have loaded this package Emacs will, upon completion of -macro definition, ask you which key you want to assign this macro to -and ask for a description of the macro. If something is already bound -to this key, Emacs will ask you whether you want to override this -binding. Furthermore, this package also takes care of saving the macro -to your initialization file for later Emacs sessions. - - The description for all the defined macros may be obtained with the -function `pm-manage-macros'. Using this function you can also manage -your power-macros. - - To execute this function, type: - - M-x pm-manage-macros RET - - To configure the package, type: - - M-x customize-group RET power-macros RET - - -File: edit-utils.info, Node: redo, Next: scroll-in-place, Prev: power-macros, Up: Top - -46 Redo/Undo System -******************* - -Emacs' normal undo system allows you to undo an arbitrary number of -buffer changes. These undos are recorded as ordinary buffer changes -themselves. So when you break the chain of undos by issuing some other -command, you can then undo all the undos. The chain of recorded buffer -modifications therefore grows without bound, truncated only at garbage -collection time. - - The redo/undo system is different in two ways: - - 1. The undo/redo command chain is only broken by a buffer - modification. You can move around the buffer or switch buffers - and still come back and do more undos or redos. - - 2. The `redo' command rescinds the most recent undo without - recording the change as a _new_ buffer change. It completely - reverses the effect of the undo, which includes making the chain - of buffer modification records shorter by one, to counteract the - effect of the undo command making the record list longer by one. - - - To use this package, add the following to your initialization file: - - (require 'redo) - - -File: edit-utils.info, Node: scroll-in-place, Next: setnu, Prev: redo, Up: Top - -47 Scrolling In Place -********************* - -This library provides improved vertical scrolling commands for GNU -Emacs. - -* Menu: - -* Features: sip-features. -* Commands and Functions: sip-commands. -* Installation: sip-install. -* Advanced Customization: sip-customize - - -File: edit-utils.info, Node: sip-features, Next: sip-commands, Prev: scroll-in-place, Up: scroll-in-place - -47.1 Features -============= - -The new vertical scrolling commands offer the following features: - - * When a scrolling command is executed, GNU Emacs tries to keep - point as close as possible to its original window position (window - line and column). This is what "scroll in place" means: point - stays "in place" within the window. (There are times when point - must be moved from its original window position in order to - execute the scroll; see below.) - - The variable `scroll-in-place', which is true by default, - determines whether or not the standard GNU Emacs scrolling - commands (`scroll-down', `scroll-up', `scroll-other-window-down', - and `scroll-other-window') use the "in place" features listed - here. When `scroll-in-place' is nil the standard GNU Emacs - scrolling commands essentially just call the original versions of - themselves. (Note that even when `scroll-in-place' is nil the new - versions of `scroll-down' and `scroll-up' have slightly different - behavior when a minibuffer window is the selected window. See - below.) - - It is possible to turn off (or turn on) "in place" scrolling for - certain buffers by making buffer-local bindings of the variable - `scroll-in-place' for those buffers. The variable - `scroll-in-place' is not usually buffer-local, but you can make it - so if you desire. - - * Because the improved scrolling commands keep point at its - original window position, these scrolling commands are - "reversible." The `scroll-up' command undoes the effect of the - immediately previous `scroll-down' command (if any) and vice - versa. In other words, if you scroll up and then immediately - scroll back down, the window configuration is restored to its - exact original state. This allows you to browse through a buffer - more easily, as you can always get back to the original - configuration. - - Note, however, that the improved scrolling commands are guaranteed - to be reversible only if there are no intervening non-scrolling - commands. Also, if you give a prefix argument to a scrolling - command (in order to specify the number of lines to scroll by), - previous scrolling commands may no longer be reversible. More - specifically, if the new prefix argument has a different magnitude - than the previous scrolling distance, then any previous scrolling - commands are not reversible. The new prefix argument takes - precedence. - - You might find it useful to think of the scrolling commands as - forming "chains." A scrolling command either starts or continues - a chain. By issuing a non-scrolling command or by changing the - number of lines to be scrolled, you break the chain. (Note that - simply changing the scrolling direction won't break the chain; - changing the absolute number of lines to be scrolled is what - breaks the chain.) Scrolling commands are guaranteed to be - reversible only within the current chain. Hopefully that's clear - enough. - - * When a scrolling command is given a prefix argument (which - specifies the number of lines to scroll by), then that argument - becomes the default scrolling distance for all immediately - subsequent scrolling commands. This means that you can easily set - the scrolling distance for a chain of scrolling commands. Note - that a new prefix argument or any non- scrolling command breaks - the chain (as described above), and any further scrolling commands - will use the usual defaults (or the prefix argument you specify at - that time, of course). - - However, there are cases in which one doesn't want the current - scrolling command to use the default scrolling distance that was - set by the previous scrolling command. For example, suppose that - you had special commands that scrolled one line up and one line - down. When you invoke one of these commands, the "in place" - scrolling routines set the default scrolling distance to be just - one line. Now suppose that you use one of your special commands - and then immediately invoke `scroll-up' (`C-v'), expecting it to - scroll by a near windowful of text. You would be disappointed -- - because the previous command set the default scrolling distance to - be just one line, `scroll-up' just scrolls by one line. - - To solve this problem, "scroll-in-place" allows you to divide - scrolling commands into separate "groups." Commands in a group - can only form chains with (and therefore, inherit defaults from) - commands in the same group. (Note that no command can be in more - than one group.) If you invoke a scrolling command that is not in - the same group as that of the immediately previous scrolling - command, then the previous chain is broken and you start a new - chain -- with a new set of defaults. - - So to solve the problem described above, you could put your - one-line scrolling commands in their own group. Once that is - done, the standard scrolling commands will not form chains with - your one-line scrolling commands, and therefore will not use the - default scrolling distance set by those commands. Problem solved! - - By default, all "in place" scrolling commands are in a single - group. If you want to partition some commands into separate - groups, you must do that yourself _before_ any "in place" commands - are invoked. For more information about grouping commands, see - the documentation for the variables `scroll-command-groups' and - `scroll-default-command-group'. - - * The improved scrolling commands will avoid displaying empty lines - past the end of the buffer when possible. In other words, just as - you can't see "dead space" before the beginning of the buffer - text, the new scrolling commands try to avoid displaying "dead - space" past the end of the buffer text. This behavior is somewhat - configurable; see the documentation for the variable - `scroll-allow-blank-lines-past-eob'. - - Dead space will be displayed if it is necessary in order to make a - previous scrolling action reversible, however. - - * If the scrolling commands cannot keep point at its initial window - position (because a buffer boundary is on screen and the window - can't be scrolled as far as necessary to keep point at the right - place), point is allowed to temporarily stray from its initial - window position. That is, point moves the correct number of - window lines, even if it means that it has to stray from its - desired window position. This straying is undone when (and if) the - scrolling action is reversed. - - * If a scrolling command tries to move point past a buffer - boundary, point is instead moved to the boundary (the beginning or - the end of the buffer as appropriate) and an appropriate message - is displayed. This motion is reversible, of course. - - However, if point was already at the buffer boundary when the - scrolling command was invoked, the command signals an appropriate - error instead. - - * When a minibuffer window is the selected window, the new versions - of `scroll-up' and `scroll-down' either scroll the window in the - variable `minibuffer-scroll-window' (which is usually the window of - completions) or the `next-window' if there is no - `minibuffer-scroll-window'. This is usually much more useful than - scrolling the minibuffer itself. (Note that this feature is - available even when the variable `scroll-in-place' is nil.) - - * When a scrolling command is scrolling a window other than the - selected window, it will signal an appropriate buffer boundary - error if the window cannot be scrolled (because the appropriate - buffer boundary is already visible). This means that an error is - signalled even in cases that would be allowed (by "straying" point - or by moving it to the buffer boundary) if the window were - selected. - - (If an error were not signalled in these cases, then there would - be many cases in which the last scroll in a particular direction - would appear to do nothing because only the point position would - change -- the displayed text would stay the same! To avoid these - cases the scrolling commands signal boundary errors "prematurely" - when the window to be scrolled is not selected.) - - - -File: edit-utils.info, Node: sip-commands, Next: sip-install, Prev: sip-features, Up: scroll-in-place - -47.2 Command and Functions -========================== - -This library provides the following "in place" versions of GNU Emacs' -standard vertical scrolling commands: - - * scroll-down-in-place - - * scroll-up-in-place - - * scroll-other-window-down-in-place - - * scroll-other-window-in-place - - The variable `scroll-in-place', which is true by default, determines -whether or not the new versions of the standard GNU Emacs scrolling -commands (`scroll-down', `scroll-up', `scroll-other-window-down', and -`scroll-other-window') use the "in place" features listed above. When -`scroll-in-place' is nil the standard GNU Emacs scrolling commands -essentially just call the original versions of themselves. (Note that -even when `scroll-in-place' is nil the new versions of `scroll-down' and -`scroll-up' have slightly different behavior when a minibuffer window is -the selected window. See the feature list above.) - - NOTE that this package redefines the standard GNU Emacs commands -`scroll-down', `scroll-up', `scroll-other-window-down', and -`scroll-other-window' (in order to check the variable -`scroll-in-place', as described above). The command -`scroll-other-window-down' first appeared as a standard command in the -FSF's GNU Emacs 19.26. - - This package also provides the following functions and variables -which are of use to programmers: - - * scroll-window - - * scroll-window-in-place - - * scroll-window-in-place-continue-sequence - - * scroll-default-lines (variable) - - * scroll-command-groups (variable) - - The `scroll-window-in-place' function is the heart of the "in place" -scrolling commands. `scroll-window' is a function that checks the -variable `scroll-in-place' and calls the appropriate scrolling function -(either `scroll-window-in-place' or one of the original versions of -`scroll-down' and `scroll-up'). The function -`scroll-window-in-place-continue-sequence' is provided in order to -preserve running "chains" of scrolling commands as described above. - - The variable `scroll-default-lines' determines the default scrolling -distance when a new chain of "in place" scrolling commands begins. If -this variable is not a number, then the default distance is the height -of the window to be scrolled minus `next-screen-context-lines'. The -variable `scroll-command-groups' contains the explicit groups of "in -place" scrolling commands; for more information read the variable -documentation. - - -File: edit-utils.info, Node: sip-install, Next: sip-customize, Prev: sip-commands, Up: scroll-in-place - -47.3 Installation -================= - -To use this package, you simply need to load it from within your -initialization file: - - (require 'scroll-in-place) - - By default, this package provides for the standard GNU Emacs vertical -scrolling commands (`scroll-down', `scroll-up', -`scroll-other-window-down', and `scroll-other-window') to use the "in -place" features. If you would rather not have this, set the variable -`(setq scroll-in-place nil)'. - - When `scroll-in-place' is nil you will have to bind keys in order to -call the "in place" scrolling commands. For example, you might want to -do the following: - - (global-set-key "\M-v" 'scroll-down-in-place) - (global-set-key "\C-v" 'scroll-up-in-place) - - -File: edit-utils.info, Node: sip-customize, Prev: sip-install, Up: scroll-in-place - -47.4 Advanced Customization -=========================== - -If you want to partition certain "in place" scrolling commands into -separate groups, you should do something like the following: - - ;; Make one group containing the commands `scroll-down-one-line' and - ;; `scroll-up-one-line'. (These are not standard GNU Emacs commands.) - (setq scroll-command-groups - (list '(scroll-down-one-line scroll-up-one-line))) - - You could write the `scroll-down-one-line' command like this: - - (defun scroll-down-one-line (arg) - "Scroll down one line, or number of lines specified by prefix arg." - (interactive "P") - (let ((scroll-default-lines 1)) - (scroll-down-in-place arg))) - - If you want to disable "in place" scrolling for windows that display -a particular buffer (while leaving it available in other windows), you -can make `scroll-in-place' a buffer-local variable for that buffer and -then bind that local copy of `scroll-in-place' to nil. This is the -kind of thing that one generally does in a major mode hook. For -example, you can disable "in place" scrolling of GNUS article windows -with the following code: - - (setq gnus-article-mode-hook - (function (lambda () - (make-local-variable 'scroll-in-place) - (setq scroll-in-place nil)))) - ;; Set the variable `gnus-Article-mode-hook' instead if you are using - ;; an old version of GNUS, say version 3.13 or 3.14. - - The variable `scroll-allow-blank-lines-past-eob' can also be made -local to particular buffers, if you desire. (But why would you want to -do that?) - - -File: edit-utils.info, Node: setnu, Next: vertical-mode, Prev: scroll-in-place, Up: Top - -48 VI-style Line Number Mode -**************************** - -This library activates VI-style line numbering for a buffer. - - `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. - - (add-hook 'text-mode-hook 'turn-on-setnu-mode) - - to automatically turn on line numbering when entering text-mode. - - -File: edit-utils.info, Node: vertical-mode, Next: align, Prev: setnu, Up: Top - -49 Vertical Mode - Editing of Vertical Text -******************************************* - -This minor mode allows you to conveniently edit things that are oriented -vertically (like tables in computer programs): after each action, cursor -moves down. Therefore, to move block of text to the right, you simply -enter vertical mode and then hold `spacebar', waiting for autorepeat to -do the job for you. - - -File: edit-utils.info, Node: align, Next: allout, Prev: vertical-mode, Up: Top - -50 Align Text to a Specific Column, By Regexp -********************************************* - -This mode allows you to align regions in a context-sensitive fashion. -The classic use is to align assignments: - - int a = 1; - short foo = 2; - double blah = 4; - - becomes - - int a = 1; - short foo = 2; - double blah = 4; - -* Menu: - -* Align Usage:: How to use the package. - - -File: edit-utils.info, Node: Align Usage, Prev: align, Up: align - -50.1 Align Usage -================ - -To configure the package, type: - - M-x customize-group RET align RET - - There are several variables which define how certain "categories" of -syntax are to be treated. These variables go by the name -`align-CATEGORY-modes'. For example, "c++" is such a category. There -are several rules which apply to c++, but since several other languages -have a syntax similar to c++ (e.g., c, java, etc), these modes are -treated as belonging to the same category. - - If you want to add a new mode under a certain category, just -customize that list, or add the new mode manually. For example, to -make jde-mode a c++ category mode, use this code in your initialization -file: - - (setq align-c++-modes (cons 'jde-mode align-c++-modes)) - - In some programming modes, it's useful to have the aligner run only -after indentation is performed. To achieve this, customize or set the -variable `align-indent-before-aligning' to t. - - -File: edit-utils.info, Node: allout, Next: narrow-stack, Prev: align, Up: Top - -51 Extensive Outline Mode -************************* - -Allout outline mode provides extensive outline formatting and -manipulation beyond standard emacs outline mode (*note Outline Mode: -(xemacs)Outline Mode.). It provides for structured editing of -outlines, as well as navigation and exposure. It also provides for -syntax-sensitive text like programming languages. (For an example, see -the allout code itself, which is organized in ;; an outline framework.) - - In addition to outline navigation and exposure, allout includes: - - * topic-oriented repositioning, cut, and paste - - * integral outline exposure-layout - - * incremental search with dynamic exposure and reconcealment of - hidden text - - * automatic topic-number maintenance - - * "Hot-spot" operation, for single-keystroke maneuvering and exposure - control. (See the outline-mode docstring.) - - - and many other features. - - To configure the package, type: - - M-x customize-group RET allout RET - - To use the allout package in place of the standard outline package, -add the following bit of code - - (require 'outline "allout") - - to your initialization file. This will ensure that all the functions -provided by the outline package will be loaded from the new allout -package instead. - - The outline menubar additions provide quick reference to many of the -features, and see the docstring of the variable `outline-init' for -instructions on priming your emacs session for automatic activation of -outline-mode. - - See the docstring of the variables `outline-layout' and -`outline-auto-activation' for details on automatic activation of allout -outline-mode as a minor mode. - - By default, allout mode does not fontify the buffer. To get Font -Lock to work put the following into your initialization file (adapted -from the standard outline mode): - - (defvar rf-allout-font-lock-keywords - '(;; - ;; Highlight headings according to the level. - (eval . (list (concat "^\\(" outline-regexp "\\).+") - 0 '(or (cdr (assq (outline-depth) - '((1 . font-lock-function-name-face) - (2 . font-lock-variable-name-face) - (3 . font-lock-keyword-face) - (4 . font-lock-builtin-face) - (5 . font-lock-comment-face) - (6 . font-lock-constant-face) - (7 . font-lock-type-face) - (8 . font-lock-string-face)))) - font-lock-warning-face) - nil t))) - "Additional expressions to highlight in Outline mode.") - - ;; add font-lock to allout mode - (defun rf-allout-font-lock-hook () - (set (make-local-variable 'font-lock-defaults) - '(rf-allout-font-lock-keywords t nil nil outline-back-to-current-heading))) - - (add-hook 'outline-mode-hook 'rf-allout-font-lock-hook) - - -File: edit-utils.info, Node: narrow-stack, Next: flow-ctrl, Prev: allout, Up: Top - -52 Extending the built-in narrowing functions -********************************************* - -Narrowing, as implemented in Emacs has one limitation, namely that it -is not possible to narrow within a narrowing, and then widen again to -the previous narrowing. This package implements an extension to -narrowing, which makes this possible. - - To activate this extension type `M-x narrow-stack-mode' or add -`(narrow-stack-mode)' to your initialization file. - - -File: edit-utils.info, Node: flow-ctrl, Next: makesum, Prev: narrow-stack, Up: Top - -53 Flow Control -*************** - -Terminals that use XON/XOFF flow control can cause problems with GNU -Emacs users. This file contains Emacs Lisp code that makes it easy for -a user to deal with this problem, when using such a terminal. - - To invoke these adjustments, a user need only invoke the function -`enable-flow-control-on' with a list of terminal types specified in the -initialization file. As arguments, give it the names of one or more -terminal types in use by that user which require flow control -adjustments. Here's an example: - - (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") - - Portability note: This uses `(getenv "TERM")', and therefore probably -won't work outside of UNIX-like environments. - - -File: edit-utils.info, Node: makesum, Next: man, Prev: flow-ctrl, Up: Top - -54 Generate Summary of All Key Binding -************************************** - -Displays a nice human-readable summary of all keybindings in a -two-column format. - - To invoke this command, type: - - M-x make-command-summary RET - - -File: edit-utils.info, Node: man, Next: abbrevlist, Prev: makesum, Up: Top - -55 Browse UNIX manual pages -*************************** - -This library defines the command `manual-entry' to browse Unix manual -pages. - - To invoke this command, type: - - M-x manual-entry RET - - For ease of use, autocompletion on `M-x man' will work just fine. - - To configure this package, type: - - M-x customize-group RET man RET - - -File: edit-utils.info, Node: abbrevlist, Next: file-part, Prev: man, Up: Top - -56 Abbreviation List -******************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: file-part, Next: info-look, Prev: abbrevlist, Up: Top - -57 Treat a Section of a Buffer as a Separate File -************************************************* - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: info-look, Next: live-icon, Prev: file-part, Up: Top - -58 Major-Mode-Sensitive Info Index Lookup Facility -************************************************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: live-icon, Next: mode-motion+, Prev: info-look, Up: Top - -59 Make Frame Icons Represent Current Frame Contents -**************************************************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: mode-motion+, Next: popper, Prev: live-icon, Up: Top - -60 Per Mode/Buffer Mouse Tracking With Highlighting -*************************************************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: popper, Next: reportmail, Prev: mode-motion+, Up: Top - -61 Shrink-Wrapped Temporary Windows -*********************************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: reportmail, Next: balloon-help, Prev: popper, Up: Top - -62 Display Time and Load in Mode Line -************************************* - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: balloon-help, Next: blink-paren, Prev: reportmail, Up: Top - -63 Balloon Help and Tooltips -**************************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: blink-paren, Next: edit-faces, Prev: balloon-help, Up: Top - -64 Blinking Parentheses -*********************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: edit-faces, Next: lispm-fonts, Prev: blink-paren, Up: Top - -65 Face Editor -************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: lispm-fonts, Next: big-menubar, Prev: edit-faces, Up: Top - -66 lispm-fonts -************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: big-menubar, Next: tree-menu, Prev: lispm-fonts, Up: Top - -67 Big Menubar -************** - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: tree-menu, Next: XEmacs License, Prev: big-menubar, Up: Top - -68 tree-menu -************ - -This library not documented. Please contribute! - - -File: edit-utils.info, Node: XEmacs License, Prev: tree-menu, Up: Top - -69 XEmacs License -***************** - -GNU GENERAL PUBLIC LICENSE -************************** - - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 675 Mass Ave, Cambridge, MA 02139, USA - - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -Preamble -======== - -The licenses for most software are designed to take away your freedom -to share and change it. By contrast, the GNU General Public License is -intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it in -new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, -and (2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - 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. - - ONE LINE TO GIVE THE PROGRAM'S NAME AND AN IDEA OF WHAT IT DOES. - Copyright (C) 19YY NAME OF AUTHOR - - 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., 675 Mass Ave, Cambridge, MA 02139, USA. - - Also add information on how to contact you by electronic and paper -mail. - - If the program is interactive, make it output a short notice like -this when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) 19YY NAME OF AUTHOR - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details - type `show w'. This is free software, and you are welcome - to redistribute it under certain conditions; type `show c' - for details. - - The hypothetical commands `show w' and `show c' should show the -appropriate parts of the General Public License. Of course, the -commands you use may be called something other than `show w' and `show -c'; they could even be mouse-clicks or menu items--whatever suits your -program. - - You should also get your employer (if you work as a programmer) or -your school, if any, to sign a "copyright disclaimer" for the program, -if necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright - interest in the program `Gnomovision' - (which makes passes at compilers) written - by James Hacker. - - SIGNATURE OF TY COON, 1 April 1989 - Ty Coon, President of Vice - - This General Public License does not permit incorporating your -program into proprietary programs. If your program is a subroutine -library, you may consider it more useful to permit linking proprietary -applications with the library. If this is what you want to do, use the -GNU Library General Public License instead of this License. - - - -Tag Table: -Node: Top927 -Node: Copying5753 -Node: compare-w9903 -Node: detached-minibuf10300 -Node: iswitchb10596 -Node: iswitchb-cust13966 -Node: Changing the Display14675 -Node: Regexp Matching16218 -Node: Replacement for read-buffer17017 -Node: permanent-buffers17600 -Node: rsz-minibuf18623 -Node: search-buffers19715 -Node: uniquify20406 -Node: winring21170 -Node: History24482 -Node: Related Packages25554 -Node: autorevert26712 -Node: Auto-Revert Usage27736 -Node: backup-dir28651 -Node: bookmark31054 -Node: desktop31477 -Node: recent-files34353 -Node: recentf-cust36586 -Node: resume41256 -Node: saveconf41463 -Node: savehist42989 -Node: saveplace43765 -Node: where-was-i-db44400 -Node: completion49021 -Node: dabbrev50464 -Node: hippie-exp51039 -Node: icomplete55976 -Node: tempo57138 -Node: avoid59682 -Node: blink-cursor60969 -Node: fast-lock61249 -Node: lazy-lock62266 -Node: lazy-shot63510 -Node: mic-paren64386 -Node: paren67548 -Node: shell-font68779 -Node: highline69280 -Node: highline-keys70357 -Node: highline-hooks71584 -Node: highline-options72095 -Node: after-save-commands72987 -Node: atomic-extents73811 -Node: array74576 -Node: floating-toolbar74912 -Node: The Toolbar Utilities76052 -Node: Adding Buttons on the Fly77543 -Node: The Toolbar Editor80993 -Node: APIs for Adding and Killing83370 -Node: APIs for Search88574 -Node: Toolbar Portability91336 -Node: foldout92193 -Node: func-menu96049 -Node: id-select97275 -Node: outl-mouse100707 -Node: page-ext101705 -Node: page-ext-keys102493 -Node: page-ext-using103624 -Node: page-ext-addr104792 -Node: power-macros110461 -Node: redo111591 -Node: scroll-in-place112768 -Node: sip-features113119 -Node: sip-commands121725 -Node: sip-install124242 -Node: sip-customize125071 -Node: setnu126816 -Node: vertical-mode127295 -Node: align127778 -Node: Align Usage128270 -Node: allout129299 -Node: narrow-stack132503 -Node: flow-ctrl133047 -Node: makesum133865 -Node: man134179 -Node: abbrevlist134606 -Node: file-part134783 -Node: info-look135024 -Node: live-icon135266 -Node: mode-motion+135515 -Node: popper135759 -Node: reportmail135972 -Node: balloon-help136189 -Node: blink-paren136393 -Node: edit-faces136587 -Node: lispm-fonts136762 -Node: big-menubar136937 -Node: tree-menu137111 -Node: XEmacs License137284 - -End Tag Table diff --git a/xemacs-packages/info/os-utils.info b/xemacs-packages/info/os-utils.info deleted file mode 100644 index 45d3653b..00000000 --- a/xemacs-packages/info/os-utils.info +++ /dev/null @@ -1,849 +0,0 @@ -This is os-utils.info, produced by makeinfo version 4.7 from -os-utils.texi. - -INFO-DIR-SECTION XEmacs Editor -START-INFO-DIR-ENTRY -* OS Utilities: (os-utils). Operating System Utilities for XEmacs. -END-INFO-DIR-ENTRY - - This manual is part of XEmacs. - - XEmacs 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. - - XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. - - -File: os-utils.info, Node: Top, Next: Copying, Prev: (dir), Up: (dir) - -1 The Operating System Utilities Package -**************************************** - -This Info file contains the manual for the Operating System Utilities -package. - -The node name for each entry in the menu is the name of the elisp file -containing the code that implements the functionality described. It is -highly recommended that you briefly peruse the elisp source code since -it can provide valuable information on usage and technique. This can -easily be done by typing `C-x 4 l RET' where is -the name of the elisp file to be loaded. - -* Menu: - -* Copying:: Why this manual is GPL, and what that means - -Archive Management -* tar-mode:: Simple Editing of TAR Files -* arc-mode:: Simple Editing of Archives - -Compression/Decompression -* crypt:: Handling for Compressed and Encrypted Files -* jka-compr:: Reading/Writing/Loading Compressed Files -* uncompress:: Auto-Decompression Hook for Visiting .Z Files - -Communications -* telnet:: Execute a Telnet Session From Within an Emacs Buffer -* ssh:: Remote Login Interface Using SSH -* ftelnet:: Remote Login Interface Using Telnet -* rlogin:: Remote Login Interface Using rlogin -* mchat:: Multicast Chatting -* kermit:: Using Shell Mode With Kermit -* terminal:: Terminal Emulator - -Miscellaneous -* spell:: Spelling Correction -* background:: Fun With Background Jobs -* inf-lisp:: Inferior-Lisp Mode -* ledit:: ledit - -Appendices: -* XEmacs License:: The GNU General Public License - - -File: os-utils.info, Node: Copying, Next: tar-mode, Prev: Top, Up: Top - -2 Copying -********* - -This document may be redistributed, verbatim or in modified form, under -the terms of the GNU General Public License, version 2 or any later -version. The same terms apply to the libraries it documents. A copy -of the General Public License is provided as an Appendix. - - Most XEmacs documentation has its own license, which is an ancestor -of the GNU Free Documentation License ("FDL"), and whose terms are -quite similar to those imposed by GNU on Emacs documentation. Why is -this manual licensed differently (under the GNU General Public License, -or "GPL"), and why does it have to be distributed separately from the -XEmacs User's Guide and the XEmacs Lisp Reference Manual? - - Taking the second question first, XEmacs is "community-owned" -software. That is, unlike GNU Emacs, there is no monopoly copyright -holder. Many of us, including the original Lucid authors, have -contributed our copyrights to the Free Software Foundation (FSF), and of -course much content is derived from GNU Emacs, and therefore is held by -the FSF. Another large chunk is held by Sun Microsystems, and a few -individual authors hold copyright to thousands of lines each. But many -individuals hold copyright to only a few dozen lines. Like the Linux -kernel, copyright ownership is distributed throughout a community. - - However, its license is "copyleft," _i.e._, it _requires_ that you -redistribute it under terms _identical_ to those under which you -received it, unless you have explicit permission of the copyright -holder. Because of the multiple owners, determining the ownership of -any given part of XEmacs is tedious, and perhaps impossible. For -practical purposes, then, the license of any substantial chunk of -existing XEmacs content cannot be changed, except to a later version of -the GPL, for those parts under GPL. (That is due to the _explicit_ -permission to change to a later version of the GPL, present in every -file of XEmacs.) - - Unfortunately, this severe restriction means that the GPL, FDL, and -the XEmacs documentation license ("XDL") are _mutually incompatible_. -That is, content licensed under any of the GPL, FDL, or XDL _may not_ -be mixed with content licensed under either of the other two without -changing the license of some of the content. But this requires -permission of the copyright holder, which is often difficult or -impossible to get. - - For example, you _may not_ take comments or docstrings from XEmacs -code and add them to the Lispref to mend a gap in the latter's coverage. -You _may not_ copy text from the Lispref into docstrings in the code. -And you _may not_ copy text from the GNU Emacs Lisp Reference to the -XEmacs Lisp Reference Manual. (In this case it is at least trivial to -ask permission, although it is rather unclear whether it would be -granted.) - - In fact, parts of this document were derived by copying from XEmacs -code under the GPL, without any further permission from the authors. -Thus, this document must be distributed under the GPL, as a "volume" -separate from the XEmacs documentation under the XDL. Note that the -"mere aggregation" clauses allow us to distribute in the same tarball. -But incorporating it as a node in the Lispref is prohibited, even if -done by inclusion. - - A bit of advocacy: - - If you look carefully at the additional restrictions imposed by the -soi-disant "free" documentation licenses, you discover that they are -simply proprietary restrictions guaranteeing a certain amount of -_unpaid_ political advertising to the Free Software Foundation and GNU -Project (and in the case of the FDL, this is extended to commercial -advertising by authors of original or derived works). Whether this is -"ethically justified" or not is a difficult question. What is certain -is that there is little social benefit to these terms (since the license -documents themselves contain the advocacy and must be included with any -distribution). - - I conclude it makes sense for XEmacs to reduce its restrictions, -where possible, to the "least common denominator," the GNU General -Public License. - - -File: os-utils.info, Node: tar-mode, Next: arc-mode, Prev: Copying, Up: Top - -3 Simple Editing of TAR Files -***************************** - -This package attempts to make dealing with Unix 'tar' archives easier. -When this code is loaded, visiting a file whose name ends in '.tar' -will cause the contents of that archive file to be displayed in a -Dired-like listing. It is then possible to use the customary Dired -keybindings to extract sub-files from that archive, either by reading -them into their own editor buffers, or by copying them directly to -arbitrary files on disk. It is also possible to delete sub-files from -within the tar file and write the modified archive back to disk, or to -edit sub-files within the archive and re-insert the modified files into -the archive. See the documentation string of `tar-mode' for more info. - - To configure this package, type: - - M-x customize-group RET tar RET - - -File: os-utils.info, Node: arc-mode, Next: crypt, Prev: tar-mode, Up: Top - -4 Simple Editing of Archives -**************************** - -This library not documented. Please contribute! - - To configure this package, type: - - M-x customize-group RET archive RET - - -File: os-utils.info, Node: crypt, Next: jka-compr, Prev: arc-mode, Up: Top - -5 Handling for Compressed and Encrypted Files -********************************************* - -The basic purpose of this package of Lisp functions is to recognize -automatically encrypted and encoded (i.e., compressed) files when they -are first visited or written. The BUFFER corresponding to the file is -decoded and/or decrypted before it is presented to the user. The file -itself is unchanged on the disk. When the buffer is subsequently saved -to disk, a hook function re-encodes the buffer before the actual disk -write takes place. - - This package recognizes all sorts of compressed files by a magic -number at the beginning of these files but uses a heuristic to detect -encrypted files. If you are asked for an encryption key for a file -that is in fact not encrypted, just hit RET and the file will be -accepted as is, and the crypt minor mode will not be entered. - - Other types of encoding programs may be added to this package by -using the variable `crypt-encoding-alist' which contains a table of -encoding programs such as `compress', `gzip' (GNU zip), `freeze', and -`compact'. - - This new extended version of crypt now monitors the filename -extensions of buffers that are written out using `write-file' (`C-x -C-w'). If the filename extension matches one of the extensions listed -in `crypt-encoding-alist', then this package will write the file out -using the corresponding encoding (compression) method. This is done -whether or not the buffer originated from a previously encoded -(compressed) file. - - Thus, if the user is editing a file that may or may not have been -encoded originally (e.g., `foobar.Z' or `foobar') and decides to write -it to a different file (e.g., `barfoo' or `barfoo.z' or `barfoo.C'). -This package will examine the filename extension and write the buffer -in plain format or an alternate encoding (compression) format by -searching through the entries in the table of encoding methods -`crypt-encoding-alist'. This change in encoding state is done -automatically if the variable `crypt-auto-write-buffer' is t otherwise -the user is asked. - - To use this package, put the line `(require 'crypt)' in your -initialization file. Do not bother trying to autoload this file; this -package uses `find-file' and `write-file' hooks and thus should be -loaded the first time you visit any sort of file. Any package loaded -after this one that appends something to `write-file-hooks' will not be -executed because this package writes out the file. Other packages that -append to `write-file-hooks' should either be modified to prepend to -that hook or be loaded before this one (preferably the former). - - NOTE: encryption users should set `crypt-encryption-type' to one of -the values in `crypt-encryption-alist'. - - To configure this package, type: - - M-x customize-group RET compression RET - - -File: os-utils.info, Node: jka-compr, Next: uncompress, Prev: crypt, Up: Top - -6 Reading/Writing/Loading Compressed Files -****************************************** - -This package implements low-level support for reading, writing, and -loading compressed files. It hooks into the low-level file I/O -functions (including `write-region' and `insert-file-contents') so that -they automatically compress or uncompress a file if the file appears to -need it (based on the extension of the file name). Packages like -Rmail, VM, GNUS, and Info should be able to work with compressed files -without modification. - - The operation of this package should be transparent to the user -(except for messages appearing when a file is being compressed or -uncompressed). - - The variable, `jka-compr-compression-info-list' can be used to -customize `jka-compr' to work with other compression programs. The -default value of this variable allows `jka-compr' to work with Unix -compress and gzip. - - To activate this package, add the following to your initialization -file: - - (toggle-auto-compression 1 t) ; enable compression/decompression - - To configure this package, type: - - M-x customize-group RET jka-compr RET - - -File: os-utils.info, Node: uncompress, Next: telnet, Prev: jka-compr, Up: Top - -7 Auto-Decompression Hook for Visiting .Z Files -*********************************************** - -This package can be used to arrange for automatic uncompress of -compressed files when they are visited. All that's necessary is to -load it. This can conveniently be done from your initialization file. - - `M-x auto-compression-mode' is a more modern replacement for this -package. - - -File: os-utils.info, Node: telnet, Next: ssh, Prev: uncompress, Up: Top - -8 Execute a Telnet Session From Within an Emacs Buffer -****************************************************** - -This mode is intended to be used for telnet or rsh to a remote host; -`telnet' and `rsh' are the two entry points. Multiple telnet or rsh -sessions are supported. - - Normally, input is sent to the remote telnet/rsh line-by-line, as -you type `RET' or `LFD'. `C-c C-c' sends a `C-c' to the remote -immediately; `C-c C-z' sends `C-z' immediately. `C-c C-q' followed by -any character sends that character immediately. - - All `RET' characters are filtered out of the output coming back from -the remote system. The mode tries to do other useful translations -based on what it sees coming back from the other system before the -password query. It knows about UNIX, ITS, TOPS-20 and Explorer systems. - - You can use the global `telnet-host-properties' to associate a telnet -program and login name with each host you regularly telnet to. - - To configure this package, type: - - M-x customize-group RET telnet RET - - -File: os-utils.info, Node: ssh, Next: ftelnet, Prev: telnet, Up: Top - -9 Remote Login Interface Using SSH -********************************** - -This package provides support for remote logins using `ssh'. The -package is layered on top of shell.el; the code here only accounts for -the variations needed to handle a remote process, e.g. directory -tracking and the sending of some special characters. - - If you wish for ssh mode to prompt you in the minibuffer for -passwords when a password prompt appears, just enter `M-x -send-invisible' and type in your line, or add -`comint-watch-for-password-prompt' to `comint-output-filter-functions'. - - To configure this package, type: - - M-x customize-group RET ssh RET - - -File: os-utils.info, Node: ftelnet, Next: rlogin, Prev: ssh, Up: Top - -10 Remote Login Interface Using Telnet -************************************** - -This package provides support for remote logins using `telnet'. The -package is layered on top of shell.el; the code here only accounts for -the variations needed to handle a remote process, e.g. directory -tracking and the sending of some special characters. - - If you wish for ftelnet mode to prompt you in the minibuffer for -passwords when a password prompt appears, just enter `M-x -send-invisible' and type in your line, or add -`comint-watch-for-password-prompt' to `comint-output-filter-functions'. - - -File: os-utils.info, Node: rlogin, Next: mchat, Prev: ftelnet, Up: Top - -11 Remote Login Interface Using rlogin -************************************** - -This package provides support for remote logins using `rlogin'. The -package is layered on top of shell.el; the code here only accounts for -the variations needed to handle a remote process, e.g. directory -tracking and the sending of some special characters. - - If you wish for rlogin mode to prompt you in the minibuffer for -passwords when a password prompt appears, just enter `M-x -send-invisible' and type in your line, or add -`comint-watch-for-password-prompt' to `comint-output-filter-functions'. - - To configure this package, type: - - M-x customize-group RET rlogin RET - - -File: os-utils.info, Node: mchat, Next: kermit, Prev: rlogin, Up: Top - -12 Multicast Chatting -********************* - -MChat is a package allowing a conversation to take place between a -potentially infinite number of people across the Internet. It uses the -Multicast support that has been added to XEmacs in the early 21.0 days. -At that time a rudimentary version of MChat was written, merely to -illustrate the feature, and almost nobody knew it, apart from the other -developers. This version is much improved and completely backwards -incompatible ;-). - - NOTE: before using this package, you most likely have to customize -the `mchat-nsl-method' first. It specifies a program like `nsl' or -`nslookup' in order to retrieve the IP number of your machine. - - The main entry point to the package is the `mchat' function which -allows you to open a multicast group based on the MChat protocol. There -are a number a variables that can be customized and their doc-string -should be self-explanatory. You might also want to look at the bindings -(`C-h b') in MChat buffers, or at the menubar entries to get an idea of -what you can do. - - WARNING: the current version (but there's also a limitation in the -internals of XEmacs's processes) doesn't let you send messages longer -than 500 octets or so, including the protocol header. I plan to change -this in the future (see the todo list). - - To configure this package, type: - - M-x customize-group RET mchat RET - - -File: os-utils.info, Node: kermit, Next: terminal, Prev: mchat, Up: Top - -13 Using Shell Mode With Kermit -******************************* - -This library not documented. Please contribute! - - -File: os-utils.info, Node: terminal, Next: spell, Prev: kermit, Up: Top - -14 Terminal Emulator -******************** - -This library not documented. Please contribute! - - -File: os-utils.info, Node: spell, Next: background, Prev: terminal, Up: Top - -15 Spelling Correction -********************** - -This mode provides an Emacs interface to the UNIX spell(1) program. -Entry points are `spell-buffer', `spell-word', `spell-region' and -`spell-string'. These facilities are documented in the Emacs user's -manual. - - -File: os-utils.info, Node: background, Next: inf-lisp, Prev: spell, Up: Top - -16 Fun With Background Jobs -*************************** - -This library not documented. Please contribute! - - To configure this package, type: - - M-x customize-group RET background RET - - -File: os-utils.info, Node: inf-lisp, Next: ledit, Prev: background, Up: Top - -17 Inferior-Lisp Mode -********************* - -This library not documented. Please contribute! - - -File: os-utils.info, Node: ledit, Next: XEmacs License, Prev: inf-lisp, Up: Top - -18 ledit -******** - -This library not documented. Please contribute! - - -File: os-utils.info, Node: XEmacs License, Prev: ledit, Up: Top - -19 XEmacs License -***************** - -GNU GENERAL PUBLIC LICENSE -************************** - - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 675 Mass Ave, Cambridge, MA 02139, USA - - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -Preamble -======== - -The licenses for most software are designed to take away your freedom -to share and change it. By contrast, the GNU General Public License is -intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it in -new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, -and (2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - 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. - - ONE LINE TO GIVE THE PROGRAM'S NAME AND AN IDEA OF WHAT IT DOES. - Copyright (C) 19YY NAME OF AUTHOR - - 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., 675 Mass Ave, Cambridge, MA 02139, USA. - - Also add information on how to contact you by electronic and paper -mail. - - If the program is interactive, make it output a short notice like -this when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) 19YY NAME OF AUTHOR - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details - type `show w'. This is free software, and you are welcome - to redistribute it under certain conditions; type `show c' - for details. - - The hypothetical commands `show w' and `show c' should show the -appropriate parts of the General Public License. Of course, the -commands you use may be called something other than `show w' and `show -c'; they could even be mouse-clicks or menu items--whatever suits your -program. - - You should also get your employer (if you work as a programmer) or -your school, if any, to sign a "copyright disclaimer" for the program, -if necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright - interest in the program `Gnomovision' - (which makes passes at compilers) written - by James Hacker. - - SIGNATURE OF TY COON, 1 April 1989 - Ty Coon, President of Vice - - This General Public License does not permit incorporating your -program into proprietary programs. If your program is a subroutine -library, you may consider it more useful to permit linking proprietary -applications with the library. If this is what you want to do, use the -GNU Library General Public License instead of this License. - - - -Tag Table: -Node: Top928 -Node: Copying2796 -Node: tar-mode6943 -Node: arc-mode7861 -Node: crypt8132 -Node: jka-compr11033 -Node: uncompress12245 -Node: telnet12710 -Node: ssh13813 -Node: ftelnet14534 -Node: rlogin15193 -Node: mchat15933 -Node: kermit17394 -Node: terminal17588 -Node: spell17760 -Node: background18102 -Node: inf-lisp18376 -Node: ledit18554 -Node: XEmacs License18710 - -End Tag Table diff --git a/xemacs-packages/info/patcher.info b/xemacs-packages/info/patcher.info deleted file mode 100644 index 65ec78c5..00000000 --- a/xemacs-packages/info/patcher.info +++ /dev/null @@ -1,1887 +0,0 @@ -This is patcher.info, produced by makeinfo version 4.6 from -patcher.texi. - -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* Patcher: (patcher). Automatic archive-based projects maintenance. -END-INFO-DIR-ENTRY - - This file contains the documentation for Patcher version 3.8, an -XEmacs package for automating the maintenance of archive-based projects. - - Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005 Didier Verna. - - 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. - - Permission is granted to copy and distribute modified versions of -this manual under the conditions for verbatim copying, provided also -that the sections entitled "Copying" and "GNU General Public License" -are included exactly as in the original, and provided that the entire -resulting derived work is distributed under the terms of a permission -notice identical to this one. - - Permission is granted to copy and distribute translations of this -manual into another language, under the above conditions for modified -versions, except that this permission notice may be stated in a -translation approved by the Free Software Foundation. - - -File: patcher.info, Node: Top, Next: Copying, Up: (dir) - -Patcher -******* - -Patcher is an XEmacs package designed to automate and ease the -maintenance of archive-based projects. It provides assistance in -building, reporting and committing patches, as well as in handling the -corresponding ChangeLog entries, for example by creating skeletons. - - This info file documents Patcher version 3.8. - -* Menu: - -* Copying:: The GNU General Public License -* Introduction:: What Patcher is all about -* Installation:: How to get and install Patcher -* Quick Start:: For the brave and the impatient -* User Manual:: A step-by-step guide to using Patcher -* Variables Index:: -* Functions Index:: -* Keystrokes Index:: - - Patcher is developed by Didier Verna . - - -File: patcher.info, Node: Copying, Next: Introduction, Prev: Top, Up: Top - -Copying -******* - -Patcher 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 Software Foundation. - - Patcher 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. - - -File: patcher.info, Node: Introduction, Next: Installation, Prev: Copying, Up: Top - -Introduction -************ - -When a project becomes important in size, or when the development is -performed cooperatively by several people across the Internet, it is a -common practice to help maintaining it by using a development control -system. Such tools (CVS, PRCS, to name a few) usually work by -maintaining a centralized project archive (also called a repository) -that keeps track of the history of the changes, lets you develop -different "branches" at the same time and perform operations like -merges between these different project branches. - - In such "archive-based" maintenance models, making the project evolve -usually involves repeatedly the same few steps, some of which can be -tedious: you work on your local copy of the project; once you're -satisfied with your changes, you create a patch by diffing your local -copy against the project's archive; then (or progressively), you -construct the ChangeLog entries. Finally, you propose your changes by -sending a mail to the developers list with your patch and the ChangeLog -entries included, hoping that your proposition will be accepted. If -you're one of the maintainers, you will still probably send the message -to the list, simply announcing the modification, and immediately commit -the patch with an informative log message. - - Patcher is an XEmacs package designed to automate this process. -Patcher can't work on the project for you. However, as soon as you give -it some basic knowledge on the project structure and repository, it can -automatically build a patch by comparing your local copy with the -repository, create ChangeLog entries, prepare a mail announcing the -changes, and even commit the patch for you with a informative log -message. All of this is done in just a few keystrokes. Additionally, -Patcher can perform some sanity checks, like verifying that your local -copy is up-to-date, that you did not forget some ChangeLog entries, that -the commit operation went well and so on. - - If you're brave and impatient, and want to start using the basics of -Patcher as soon as possible, see *Note Quick Start::. It is recommended -to read it anyway, since it gives an overview of how Patcher works. If -you know the basics and want a more detailed guide, see *Note User -Manual::. - - Enjoy using Patcher ! - - -File: patcher.info, Node: Installation, Next: Quick Start, Prev: Introduction, Up: Top - -Installation -************ - -* Menu: - -* Distribution:: How to get Patcher -* Requirements:: What you need to get Patcher running -* Insinuation:: How to plug Patcher into other libraries - - -File: patcher.info, Node: Distribution, Next: Requirements, Up: Installation - -Distribution -============ - -Patcher is available either as a standalone package, or as part of the -standard `xemacs-devel' XEmacs package. - - You can get `xemacs-devel' in three different ways: - * You can install `xemacs-devel' from within XEmacs via the package - user interface (accessible from the `Tools' menu or via `M-x - list-packages'). - - * You can also download the `xemacs-devel--pkg.tar.gz' - tarball from `ftp://ftp.xemacs.org/pub/xemacs/packages/', and - unpack it where you put the other packages. - - * `xemacs-devel' sources are available from the XEmacs CVS - repository. The module name is `xemacs-devel'. See - `http://www.xemacs.org/Develop/cvsaccess.html' for more information - about the XEmacs CVS repository. - - I also provide Patcher as a standalone package. This is mainly for my -personal usage (when developing and debugging new versions) but you -might want to use it if you're not interested in the rest of -`xemacs-devel'. The standalone version of Patcher can be found at -`http://www.lrde.epita.fr/~didier/comp/development/software.php'. You -will also find different inlined versions of this documentation at that -place. For installation instructions, please read the `INSTALL' file. - - -File: patcher.info, Node: Requirements, Next: Insinuation, Prev: Distribution, Up: Installation - -Requirements -============ - -Patcher currently works only with XEmacs 21.4 or later. I'm not sure it -works with earlier versions of XEmacs, but I'm sure it does *not* work -with GNU Emacs (see below). - - Patcher might also have some other requirements, depending on how -you use it: - - * If you let Patcher create ChangeLogs for you (*note ChangeLogs - Handling::), you will need the `add-log' library from the - `xemacs-base' package, version 1.48 or later, installed on your - system. That's actually the may reason for Patcher not being able - to run in GNU Emacs, though I have not tried to port it yet. - - * If you want to send mails from Patcher (*note Mail Methods::), you - will need a mail user agent. Patcher currently supports `sendmail', - `message' and `Gnus' natively and through the `compose-mail' - interface. Other MUA might be partly supported when used with - `compose-mail'. Patcher will probably suffer from non critical - deficiencies in that case however (it will issue warnings). - - -File: patcher.info, Node: Insinuation, Prev: Requirements, Up: Installation - -Insinuation -=========== - -With a proper installation of Patcher (either way), you don't need any -special trickery in your `.emacs' file because all entry points to the -library should be autoloaded. - - However, Patcher has the ability to hook into external libraries, but -won't do so unless requested. Currently, Patcher has hooks for Gnus -only. If you're using Gnus as your MUA, you might want to add the -following line to your `gnusrc' file: - - (patcher-insinuate-gnus) - - This will add some facilities described along the text. - - -File: patcher.info, Node: Quick Start, Next: User Manual, Prev: Installation, Up: Top - -Quick Start -*********** - -In this chapter, we quickly setup the basic Patcher configuration for -hacking on XEmacs. Adapt the example as you wish. Let's make some -assumptions first: - - * You own a computer. - - * You have the `add-log' library from the `xemacs-base' package, - version 1.48 or later, installed on your system. - - * You're using XEmacs from the CVS repository. - - * Your local copy of the repository is located in - `/usr/local/src/XEmacs-21.5'. - - * Your local copy of the repository is up-to-date, but you've done - some hacking in the sources that you'd like to submit. - - * Since you're lazy, you didn't write the ChangeLog entries yet. - -* Menu: - -* Setting up Patcher:: Making Patcher aware of your project -* Calling Patcher:: Preparing a patch and a message -* Filling the ChangeLogs:: Patcher only creates skeletons -* Filling the Message:: You should insert the ChangeLog entries -* Committing the Patch:: Applying your modifications to the archive -* Sending the Message:: Telling people about your modifications - - -File: patcher.info, Node: Setting up Patcher, Next: Calling Patcher, Prev: Quick Start, Up: Quick Start - -Setting up Patcher -================== - -The first thing to do is to make patcher aware of your "XEmacs" -project. Put this in your `.emacs' file: - - (setq patcher-projects - '(("XEmacs" "/usr/local/src/XEmacs-21.5" - :to-address "xemacs-patches@xemacs.org") - )) - - As you can imagine, `patcher-projects' is a user option in which you -store information about the projects you want to manage with Patcher. -It is actually a list of what's called "project descriptors". Here's -the meaning of the only project descriptor we have in the example -above: we have a project named "XEmacs", located in -`/usr/local/src/XEmacs-21.5' and for which emails should be sent to -. - - Note the particular syntax for specifying the mailing address. This -is what's called a "project option". Contrary to the project's name and -directory, which are mandatory and always appear as the first and second -elements of a project descriptor, project options are optional and can -appear in any order. - - -File: patcher.info, Node: Calling Patcher, Next: Filling the ChangeLogs, Prev: Setting up Patcher, Up: Quick Start - -Calling Patcher -=============== - -Now you want to build a patch with your changes, and prepare a message -to submit them. The way Patcher works is currently to setup the message -first, and then to control all subsequent operations from there. In -other words, to create a patch, you actually ask Patcher to prepare a -mail. Type this: - - M-x patcher-mail - - First, you're prompted (with completion) for a project name (the -first element of each project descriptor, remember ?). We currently -only have an "XEmacs" project, so hitting `TAB' will directly fill the -minibuffer in with this only choice. Then, you're prompted for a subject -line that will be used in the mail. Say something sensible. - - Three operations are now executed in turn: - - 1. Patcher prepares a mail buffer. The message will be sent to the - address you specified with the `:to-address' project option, and - the subject line now reads "[PATCH] something sensible". - - 2. Patcher now builds the patch. The command used to do this is `cvs - -q diff -u' (this is also a project option). Upon successful - completion of this command (we assume that's indeed the case), the - patch is inserted into the mail buffer. Some information about the - patch is provided just above it (the command used, the files - affected and so on). - - 3. Finally, Patcher generates ChangeLog skeletons from what it - understands of the patch. This involves visiting the appropriate - ChangeLog files, and creating initial entries. - - -File: patcher.info, Node: Filling the ChangeLogs, Next: Filling the Message, Prev: Calling Patcher, Up: Quick Start - -Filling the ChangeLogs -====================== - -Patcher has just created initial ChangeLog entries for you. You must now -browse through the ChangeLog file(s) and fill the entries as you see -fit. Once you're done, you can very well save the ChangeLog buffers. -However, don't kill them ! Don't even think about it. Patcher still -needs them. Now, please return to the mail buffer. - - -File: patcher.info, Node: Filling the Message, Next: Committing the Patch, Prev: Filling the ChangeLogs, Up: Quick Start - -Filling the message -=================== - -Now that you're satisfied with your ChangeLog entries and you've -returned to the mail buffer, you want to write some explanation text in -the message. I'll let you do that. You also want to insert the ChangeLog -entries corresponding to your patch, since they are usually much more -readable than the patch itself. - - Inserting your ChangeLog entries in the mail buffer is as simple as -typing `C-c C-p i'. This actually calls the function -`patcher-insert-change-logs', which places them just above the patch, -with a short information line (per ChangeLog file) on top. - - -File: patcher.info, Node: Committing the Patch, Next: Sending the Message, Prev: Filling the Message, Up: Quick Start - -Committing the Patch -==================== - -If you have commit access to your project, you should read this. -Otherwise, you may directly see *Note Sending the Message::. - - Committing your changes involves three steps: preparing the commit -command, preparing the commit log message, and actually committing the -changes. Although Patcher can do all of this in one shot, it lets you -control each step by default. - - In order to start the commit process, simply type `C-c C-p c'. This -calls the function `patcher-commit-change'. Congratulations. You've -just been transported to a new buffer, the `*Patcher Log Message*' -buffer. This buffer lets you edit the log message that will accompany -your commit. Note that the message is initialized with the subject line -of your mail. This is also a project option. - - Once you're satisfied with the log message, type `C-c C-c'. This -calls the function `patcher-logmsg-commit', which computes the commit -command to use. The command is displayed in a special buffer, the -`*Patcher Commit Command*' buffer. The default commit command is `cvs -commit', which of course is also a project option. Note that Patcher -stores the log message in a temporary file and uses the `-F' `cvs -commit' option. Finally, note that Patcher has automatically appended -the affected ChangeLog files to the commit command. - - At this point, you have the opportunity to abort the commit -operation. Otherwise, answer positively and the commit will be -executed. If you had not previously saved the ChangeLog files, Patcher -will do it for you just before committing. - - -File: patcher.info, Node: Sending the Message, Prev: Committing the Patch, Up: Quick Start - -Sending the Message -=================== - -Sending the message has actually nothing to do with Patcher. It depends -on the method you use for sending mails, but will usually be done via a -`C-c C-c' command of some sort. On thing to note however: if you've -committed your changes via Patcher, the message has been slightly -modified: the subject line now reads "[COMMIT] something sensible" -instead of "[PATCH] ...", and a short commit notice has been inserted -just at the beginning of the message's body. - - That's it. That was easy. Congratulations on your first shot at -Patcher, anyway ! Of course, Patcher is much more powerful and -customizable than what has been described in this chapter. For a -complete documentation on how to use and customize Patcher, please -refer to *Note User Manual::. - - -File: patcher.info, Node: User Manual, Next: Variables Index, Prev: Quick Start, Up: Top - -User Manual -*********** - -This chapter provides a step-by-step guide to using Patcher. Everything -there is to know about Patcher is here, though the features are -introduced progressively. - - All user options that are going to be presented in this manual can be -found in the `patcher' customization group, or a subgroup of it. - -* Menu: - -* Project Descriptors:: The project specification mechanism -* Mail Preparation:: Customizing Patcher messages -* Patch Generation:: Specifying how a patch is to be constructed -* ChangeLogs Handling:: How Patcher behaves with respect to ChangeLogs -* Project Check In:: Committing your changes from Patcher -* Mail Sending:: Sending the message and cleaning up the place -* More On Commands:: Error handling and other generalities -* More On Subprojects:: Defining permanent subprojects - - -File: patcher.info, Node: Project Descriptors, Next: Mail Preparation, Prev: User Manual, Up: User Manual - -Project Descriptors -=================== - -Projects specifications are stored in `patcher-projects'. This user -option is actually a list of "project descriptors". Each project -descriptor has the following form: `(NAME DIR :OPTION VALUE ...)' - - NAME is a string naming your project, DIR is a string specifying the -directory in which it resides. The remainder of a project descriptor is -a sequence of zero or more option/value pairs, that we call "project -options". All option names start with a colon. The type of a value -depends on the corresponding option. For example, there is a project -option named `:to-address', whose value should be a string giving the -email address to which you want to send Patcher messages. - - When Patcher needs the value for a particular project option, it -looks for it directly in the project descriptor, but also in other -places. This process is described below. - -* Menu: - -* Themes:: Collections of options -* Project inheritance:: Getting options from other projects -* Fallbacks:: Default values for project options -* Retrieval:: The process of getting an option's value -* Inheritance or theme ?:: The proper way to factor out option values - - -File: patcher.info, Node: Themes, Next: Project inheritance, Up: Project Descriptors - -Themes ------- - -If you have several projects sharing the same option set, you might want -to setup a theme. Themes are named collections of project options. - - Themes are stored in the `patcher-themes' user option. This option -is a list of themes. Each theme has the following form: `(NAME :OPTION -VALUE ...)'. - - NAME is the theme's name (a symbol). The remainder of the list is a -sequence of zero or more option/value pairs, just like in project -descriptors. - - In order to use a theme in a given project, a `:themes' project -option is provided. It is a list of theme names (symbols). Use this -option in your project descriptor, and the project will implicitly -inherit all options from the corresponding theme. - - One important note: as `:themes' is a project option, it can appear -in a theme. In other words, themes can inherit from other themes. When -Patcher tries to retrieve an option, the themes tree is traversed in -depth first. - - Because themes can contain themes, a bogus setting might lead to an -infinite loop (a cycle in a theme graph). To prevent this, the -`patcher-max-theme-depth' user option is provided. It represents the -expected maximum theme nesting level, and defaults to 8. - - -File: patcher.info, Node: Project inheritance, Next: Fallbacks, Prev: Themes, Up: Project Descriptors - -Project inheritance -------------------- - -When two projects are very similar, you might want to use the project -inheritance mechanism described below. - - There is a special project option called `:inheritance'. This option -must be a list of project names (strings). The inheritance of a project -defines a list of projects from which to inherit options. - - One important note: inherited projects might have their own -`:inheritance' option set to other projects in turn. In other words, -the project inheritance can be more than one level deep. When Patcher -tries to retrieve an option, the inheritance tree is traversed in depth -first. - - Because inherited projects can inherit from projects, a bogus setting -might lead to an infinite loop (a cycle in a project graph). To prevent -this, the `patcher-max-inheritance-depth' user option is provided. It -represents the expected maximum project inheritance level, and defaults -to 8. - - The `:inheritance' project option is somewhat special in the sense -that it can't appear in a theme. We will encounter other exceptions -later in this manual. - - -File: patcher.info, Node: Fallbacks, Next: Retrieval, Prev: Project inheritance, Up: Project Descriptors - -Fallbacks ---------- - -For each existing project option, Patcher also has a "fallback" user -option with a default value that would be shared among all (or some of) -your projects. The name of the fallback is obtained by replacing the -colon in the project option's name with the prefix `patcher-default-'. -For example, the fallback corresponding to the `:to-address' project -option is named `patcher-default-to-address'. - - The `:inheritance' project option is also special in the sense that -it doesn't have a corresponding fallback. We will encounter other -exceptions later in this manual. - - In the remainder of this manual, we will rarely mention the fallbacks -again. When we introduce a new project option, just remember that it -always has a corresponding fallback (well, not always, as you just -discovered). - - -File: patcher.info, Node: Retrieval, Next: Inheritance or theme ?, Prev: Fallbacks, Up: Project Descriptors - -Retrieval ---------- - -When Patcher needs the value of a particular project option, it looks -for it in the following manner: - - * First, it looks directly in the project descriptor to see if the - option is given. - - * If that fails, it next tries the given themes, if any. This - involves recursively traversing the project's themes tree. Options - successfully retrieved in themes are said to be "themed". - - * If that still fails, it then tries the inherited projects, if any. - This involves recursively traversing the project's inheritance - tree. Options successfully retrieved in inherited projects are - said to be "inherited". Note that in turn, such options could have - been actually themed in the inherited project. - - * If that fails again, it finally falls back to the value given in - the corresponding fallback (if it exists). In such a case, the - option is said to be "fallbacked". - - Note that a value of `nil' for a project option *is an actual -value*. It is not equivalent to an option being unset. As a -consequence, if Patcher finds a project option with a value of `nil' -somewhere, it will use it and stop the search, even if a non nil value -could be retrieved later from a theme, an inherited project or a -fallback. This provides you with a way to annihilate themed, inherited -or fallbacked options. - - -File: patcher.info, Node: Inheritance or theme ?, Prev: Retrieval, Up: Project Descriptors - -Inheritance or theme ? ----------------------- - -At that point, you might be wondering why the themes and inheritance -concepts were both designed, since they actually perform very similar -tasks. Good question. Here is a good answer. - - Projects might share options for different reasons. For example, my -"XEmacs" (source) and "XEmacs Packages" projects share many options -(`To:' address, `From:' address, diff and commit commands and so on) -because they both relate to XEmacs. On the other hand I have personal -but totally unrelated projects that share the same commands because -they are all handled through a local PRCS archive. - - In other words, you should rather use the inheritance mechanism when -projects relate to each other, and the theme mechanism for settings that -are orthogonal the projects they apply to. - - -File: patcher.info, Node: Mail Preparation, Next: Patch Generation, Prev: Project Descriptors, Up: User Manual - -Mail Preparation -================ - -Patcher currently uses the mail buffers as "master" buffers for -controlling all operations: building a patch, creating the ChangeLog -entries, committing... all is done from the mail buffer. Note however -that you don't need to actually send mails to use Patcher (*note Fake -Mail Method::). - - To use Patcher on a certain project, you start by preparing a -(possibly fake) mail. There are several ways to do so: you could start -a brand new message, "adapt" a message already in preparation to -Patcher, or even compose some sort of a Patcher reply to another -message. - - - Function: patcher-mail - Start composing a brand new Patcher message. This function - interactively prompts you for the name of the project and for a - (mail) subject line. - - - Function: patcher-mail-adapt - Assuming that you are already editing a message (with your usual - MUA), this function "adapts" it to Patcher by prompting you for - the name of a project. Note that this function does _not_ prompt - you for a subject. - - If you're using Gnus to read mail and have properly insinuated it -(*note Insinuation::), Patcher offers different Gnus-like ways to answer -mails and adapt them to Patcher. All the functions below are available -from both the Gnus Summary and the Article buffer. - - - Function: patcher-gnus-summary-followup - Compose a followup to the article, and adapt it to Patcher. This - function is bound to `C-c C-p f'. - - - Function: patcher-gnus-summary-followup-with-original - Idem, but also cite the original article. This function is bound to - `C-c C-p F'. - - - Function: patcher-gnus-summary-reply - Like `patcher-gnus-summary-followup', but compose a reply. This - function is bound to `C-c C-p r'. - - - Function: patcher-gnus-summary-reply-with-original - Idem, but also cite the original article. This function is bound to - `C-c C-p R'. - - In any case, Patcher starts working on the project (by first creating -the patch) after the message is prepared. Because of this, we'll start -by reviewing the mail-related customizations you might want to setup. - -* Menu: - -* Mail Methods:: Using a particular mailer -* Message Customization:: Specifying initial contents for messages - - -File: patcher.info, Node: Mail Methods, Next: Message Customization, Prev: Mail Preparation, Up: Mail Preparation - -Mail Methods ------------- - -Since there are different mail packages working in XEmacs, Patcher -supports different methods for preparing messages. You can specify the -method you prefer in the `:mail-method' project option. The value must -be a symbol. - -* Menu: - -* Standard Mail Methods:: Patcher supports standard mail packages -* Fake Mail Method:: Patcher supports not sending mails -* Other Mail Methods:: Patcher supports everything - - -File: patcher.info, Node: Standard Mail Methods, Next: Fake Mail Method, Prev: Mail Methods, Up: Mail Methods - -Standard Mail Methods -..................... - -Patcher currently supports `sendmail', `message' and `Gnus' natively -and through the `compose-mail' interface. Other MUA might be partly -supported when used with `compose-mail'. Patcher will probably suffer -from non critical deficiencies in that case however (it will issue -warnings). - -`compose-mail' - This is the default. It is implemented via the function - `patcher-mail-compose-mail' which calls `compose-mail' to prepare - the message. If you are not familiar with `compose-mail', you - might also want to throw an eye to the user option - `mail-user-agent'. If your project does not specify an address to - send the message to (*note Message Customization::), it is - prompted for. - -`sendmail' - A direct interface to the `mail' function from the `sendmail' - package. It is implemented via the function - `patcher-mail-sendmail'. If your project does not specify an - address to send the message to (*note Message Customization::), it - is prompted for. - -`message' - A direct interface to the `message-mail' function from the - `message' library (it is part of `Gnus'). It is implemented via - the function `patcher-mail-message'. If your project does not - specify an address to send the message to (*note Message - Customization::), it is prompted for. - -`gnus' - A direct interface to the `gnus-post-news' function from the - `Gnus' package (it can also send mails...). It is implemented via - the function `patcher-mail-gnus'. This mail method is interesting - when you maintain a special mail group for messages that you send - with Patcher, most probably because they are sent to some - mailing-list, such as . - - This method uses a Gnus group name and acts as if you had type `C-u - a' on that group in the `*Group*' buffer, hence honoring the group - parameters and posting-styles. If your project does not specify a - Gnus group name (*note Message Customization::), it is prompted - for. - - This last mail method is special in the sense that it requires a -running Gnus session to work. If that's needed, Patcher can start Gnus -for you in several ways, according to the following user options: - -`patcher-mail-run-gnus' - If `nil', Patcher will never start Gnus and abort the operation - instead. If `t', Patcher will always start Gnus when needed. If - `'prompt', Patcher will ask you what (you want) to do. This is the - default behavior. - -`patcher-mail-run-gnus-other-frame' - Used when Patcher has to start Gnus by itself. If `nil', continue - using the current frame. If `t', start Gnus in another frame (this - is the default). If `'follow', start Gnus in another frame, and use - this new frame to prepare the Patcher mail. - - -File: patcher.info, Node: Fake Mail Method, Next: Other Mail Methods, Prev: Standard Mail Methods, Up: Mail Methods - -Fake Mail Method -................ - -At that point, you might be wondering why the mail method is a project -option and not simply a user option, since you probably only use one -mail agent at all. Right. But you might one day work on projects for -which you don't need to send messages at all. This could happen if you -start using Patcher on a project of your own for instance. For that -reason, there is a `fake' mail method available. It is implemented via -the `patcher-mail-fake' function and calls no particular mail user -agent. Once you type `C-c C-c' to virtually send the fake message, it -only performs some cleanup. - - All right. But did we really need this fake method ? I mean, one -could use the usual mail method, and simply not send the message in the -end. Huh, yeah, ok... Actually, it is very probable that in a future -release of Patcher, the mail buffer won't be the master buffer anymore, -and mail sending will be just another optional step in the process. In -that case, the mail method is likely to move away from project option -to standard user option. - - -File: patcher.info, Node: Other Mail Methods, Prev: Fake Mail Method, Up: Mail Methods - -Other Mail Methods -.................. - -If you're not satisfied with the provided mail methods (want a `vm' one -?), you can provide your own, more or less. Here's what to do: set your -`:mail-method' project option to, say, `foo', and write your own -function which must be named `patcher-mail-foo'. - - This function must take two arguments (a project descriptor and a -string containing the subject of the message), and prepare a mail -buffer. If you want to do this, you should see how it's done for the -built-in methods. - - Note that the mail adaptation facility won't be available for your -custom method. For that, I would have to hack the internals of Patcher. - - -File: patcher.info, Node: Message Customization, Prev: Mail Methods, Up: Mail Preparation - -Message Customization ---------------------- - -When preparing a message, Patcher can fill some parts of it for you. -Here's a list of mail-related project options. - -`:user-name' - The name (your name) to use when composing the message. It will - affect the `From:' header. This option is used by all mail methods - but `fake'. If not given, `user-full-name' is used. - -`:user-mail' - The mail (your mail) address to use when composing the message. It - will affect the `From:' header. This option is used by all mail - methods but `fake'. If not given, `user-mail-address' is used. - -`:to-address' - The address to send messages to (a string). This option is used by - all mail methods but `gnus' and `fake'. If not given, it is - prompted for when calling `patcher-mail'. - -`:gnus-group' - The Gnus group name to use for posting messages (a string). This - option is used only by the `gnus' mail method. If not given, it is - prompted for when calling `patcher-mail'. - - Note that if you configured your name and mail in Gnus, for - instance through posting styles, these configurations take - precedence over the corresponding Patcher options. - -`:subject-prefix' - A prefix for the subject line of messages. It can be `nil' or a - string. By default, "[PATCH]" is used. This part of subjects is - never prompted for. A `%n' occurring in this string will be - replaced with the project name. Also, a space is inserted between - the prefix and the remainder of the subject, when appropriate. - -`:subject' - A default value for prompted subjects (a string). A `%n' occurring - in this string will be replaced with the project's name (*note - Subproject Naming::). Please note that this is used *only* to - provide a default value for prompted subjects. Subjects are - *always* prompted for. - -`:mail-prologue' - A prologue to insert just at the top of a message body (a string). - - -File: patcher.info, Node: Patch Generation, Next: ChangeLogs Handling, Prev: Mail Preparation, Up: User Manual - -Patch Generation -================ - -Patcher creates patches by diffing your local copy of the project -against the repository. This is done automatically after preparing a -message, so you shouldn't normally bother to do it manually. That -situation might still happen from time to time, like, if you further -modify the sources, or if the initial operation failed for some reason -(*note More On Commands::). - - The way to (re)generate the patch manually is to call -`patcher-generate-diff' from the mail buffer. This function is bound to -`C-c C-p d' in this buffer. You can both customize the diff command -used to (re)generate the patch, and restrict the diff to a subset of -the project's files. - - When possible, Patcher also tries to check that your project is -up-to-date with respect to the archive, and will inform you otherwise. - -* Menu: - -* Diff Command:: Specifying the command to generate the patch -* After Diff Hook:: Tweaking the diff output -* Diff Line Filter:: Omitting lines from the diff output -* Patch Restriction:: Specifying the files affected by the patch -* Patcher Instances:: You can have several instances of Patcher -* Diff Prologue:: A header is inserted above the patch - - By the way, (re)generating the patch does not necessarily mean that -it is directly inserted into the mail buffer. This also depends on the -ChangeLogs behavior (*note ChangeLogs Handling::). - - -File: patcher.info, Node: Diff Command, Next: After Diff Hook, Prev: Patch Generation, Up: Patch Generation - -Diff Command ------------- - -The diff command used to generate the patch is specified by the -`:diff-command' project option. By default, the command used is `cvs -q -diff -u'. You can also punctually change this command by calling -`patcher-mail' or `patcher-generate-diff' with a prefix argument. -Patcher will then prompt you for a new command and use it exclusively -for this particular patch. - - For detail about the format of this option, see *Note Patch -Restriction::. See also *Note More On Commands::. - - -File: patcher.info, Node: After Diff Hook, Next: Diff Line Filter, Prev: Diff Command, Up: Patch Generation - -After Diff Hook ---------------- - -Sometimes, you might want to tweak a little the diff output before doing -anything with it, for instance, before generating ChangeLog skeletons -(*note ChangeLogs Handling::), or simply inserting it into the mail -buffer. - - In order to do that, you might want to use the `:after-diff-hook' -project option. It should be a list of function names (symbols) that -will be called after each diff output. Each function should take two -optional arguments delimiting a region to process (no arguments means -process the whole buffer) and work in the current buffer. The point is -originally placed at the beginning of the region, and the buffer -excursion is saved for you. - - Note: Patcher provides a special function named -`patcher-prcs-diff-convert' that can be used in this hook in order to -convert PRCS diff output to a traditional one. - - -File: patcher.info, Node: Diff Line Filter, Next: Patch Restriction, Prev: After Diff Hook, Up: Patch Generation - -Diff Line Filter ----------------- - -When generating a global diff, that is, without specifying the files -affected by the patch explicitly (*note Patch Restriction::), some -uninformative lines might be present in the output. A typical example is -files present in your local copy but unknown to the CVS server. Such -files are indicated by a question mark in diff outputs. - - Patcher has a project option named `:diff-line-filter' that lets -filter out such unwanted lines when inserting the diff in the mail -buffer. This must be a regular expression matching a whole line. Caution -however: do not put beginning or end of lines markers in your regexp. -Patcher will do it for you. - - By default, the value is `"\\? .*"', which excludes files unknown to -the CVS server. - - -File: patcher.info, Node: Patch Restriction, Next: Patcher Instances, Prev: Diff Line Filter, Up: Patch Generation - -Patch Restriction ------------------ - -Sometimes, you don't want to generate a global patch, but instead work -on a subset of the project's files. Patcher understands this concept as -working on a "subproject". - - As for working on whole projects, there are several alternatives to -start working on a subproject: - - - Function: patcher-mail-subproject - This function behaves exactly like `patcher-mail', except that it - also prompts you for the files affected by the patch. You can - specify files as well as directories, use wildcards, just as you - would construct a command line diff. - - - Function: patcher-mail-adapt-subproject - Idem, with respect to `patcher-mail-adapt'. - - Finally, all the Gnus-specific reply functions (*note Mail -Preparation::) take an optional prefix argument that make them work on -subprojects. - - Two important things are to be kept in mind when working on -subprojects: - * It is not necessary (it is even forbidden) to specify the ChangeLog - files. Patcher will automatically find them for you. In other - words, only specify source files, not ChangeLog files. - - * Don't mistake the prefix argument of `patcher-mail', - `patcher-mail-subproject' and `patcher-generate-diff' as a way to - specify files. It is not meant for that. It is meant only to - temporarily modify the diff command itself, not the files to which - it applies. - - When working on a subproject, Patcher uses the same diff command as -the one used for the whole project, that is, the value of the -`:diff-command' project option. In the case of a subproject however, -Patcher has to know where to put the files on the command line (even if -it's usually the last part of it). This is done with the special -construct `%f': a `%f' appearing in the diff command will be replaced -with the specified files (and the computed ChangeLog files) for a -subproject, and will simply be removed when working on the whole -project. - - As an example, given that the default diff command used by Patcher is -`cvs -q diff -u', you should know understand that the default value for -`patcher-default-diff-command' is `cvs -q diff -u %f'. Do you ? - - There is another special construct available in this command: a `%n' -will be replaced with the project's name (*note Subproject Naming::). -This is useful in commands with weird options syntax, like PRCS. - - For a more advanced way of handling subprojects, see *Note More On -Subprojects::. - - -File: patcher.info, Node: Patcher Instances, Next: Diff Prologue, Prev: Patch Restriction, Up: Patch Generation - -Patcher Instances ------------------ - -The concept of subprojects brings up the question of having Patcher -working on different patches at the same time. It is possible under some -conditions: - - * You can have as many simultaneous Patcher instances as you want on - different projects (you would not define two projects sharing the - same directory, would you ?). - - * You can have as many simultaneous Patcher instances as you want on - the same project, as long as there is no overlapping between each - subproject. This means that you can't have source files, or even - ChangeLog files in common. - - This last point will be subject to improvements in the future. - - -File: patcher.info, Node: Diff Prologue, Prev: Patcher Instances, Up: Patch Generation - -Diff Prologue -------------- - -Patcher can (and does) insert a special prologue just above a patch in -the message in preparation. This prologue gives information such as the -diff command used, the files affected and so on. - - The function used to generate this prologue can be specified with the -`:diff-prologue-function' project option. A value of `nil' means don't -insert any prologue. By default, the internal function -`patcher-default-diff-prologue' is used. If you want to provide your -own, here how to do it. - - Your function should take one argument indicating the kind of diff (a -symbol), and perform insertion at current point in the current buffer. -The possible values for the argument are: - -`sources' - indicates a source diff only, - -`change-logs' - indicates a ChangeLog diff only, - -`mixed' - indicates a diff on both source and ChangeLog files. - - The following variables are bound (when appropriate) when this -function is executed: - -`name' - the name of the current Patcher project, - -`source-diff' - the command used to create a source diff, - -`change-log-diff' - the command used to create a ChangeLog diff, - -`source-files' - sources files affected by the current patch, - -`change-log-files' - ChangeLog files affected by the current patch. - - In the case of a mixed diff, a `nil' value for `change-log-diff' -indicates that the same command was used for both the source and -ChangeLog files. - - -File: patcher.info, Node: ChangeLogs Handling, Next: Project Check In, Prev: Patch Generation, Up: User Manual - -ChangeLogs Handling -=================== - -ChangeLogs management in Patcher involves two aspects: how ChangeLog -entries are created, and how they appear in the messages. Both aspects -can be customized beyond your craziest dreams. - -* Menu: - -* ChangeLogs Updating:: How Patcher deals with ChangeLogs -* ChangeLogs Appearance:: How ChangeLogs appear in messages -* ChangeLogs Prologue:: A header is inserted above the ChangeLogs - - -File: patcher.info, Node: ChangeLogs Updating, Next: ChangeLogs Appearance, Prev: ChangeLogs Handling, Up: ChangeLogs Handling - -ChangeLogs Action ------------------ - -The way Patcher deals with ChangeLogs is controlled via the -`:change-logs-updating' project option. Its value must be a symbol from -the following: - -`automatic' - This is the default. Each time you (re)generate a diff, Patcher - (re)creates ChangeLog skeletons in the appropriate ChangeLog - files, by analyzing the generated diff. You then have to fill the - entries manually. *Caution*: the diff analysis is not done by - Patcher directly, but by the function `patch-to-change-log' from - the `add-log' library from the `xemacs-base' package. Only - standard diff and cvs diff output are currently supported, both in - unified format only. - -`manual' - Patcher assumes that you create ChangeLog entries manually, as you - write code, so it won't create ChangeLogs skeletons. It is - important to understand that in this situation, ChangeLog entries - *must* have been written *before* you call Patcher. Patcher won't - let you write them in the process. - -`none' - The project doesn't have ChangeLog files. Patcher won't try to - create ChangeLog entries, and won't expect that you have written - some either. - - If you're working in `automatic' updating mode, Patcher has two -other project options that give you some control on the created entries: -`:change-logs-user-name' and `:change-logs-user-mail'. As you might -expect, these are strings defining your name and mail address for -ChangeLog entries'headers. When `nil', Patcher lets the function -`patch-to-change-log' decide what to use (most probably what the user -options `user-full-name' and `user-mail-address' say). - - Here's a last point to mention about the `automatic' updating mode. -In order to build the ChangeLog skeletons, the source files must be -visited. Patcher has a `:kill-source-files-after-diffing' project -option that lets you decide whether you want to kill the source buffers -just after diffing or not. The value can be either `nil' or `t'. By -default, the behavior is to preserve the source files, since you might -need them for reference when filling the ChangeLog entries. - - If you're working in `manual' updating mode, Patcher might still -need to know the affected ChangeLog files (for the commit process) and -your exact ChangeLog entries in each of these files (for insertion in -the message). The ChangeLog files are automatically deduced from the -patch. When that's required, however, you will be presented with each -ChangeLog file in turn, and invited to precise the number of ChangeLog -entries concerning this patch. These entries must of course appear at -the top of the file. - - Finally, note that an updating mode of `none' is the only case where -ChangeLog files are regarded as normal ones if present. As a -consequence, that is a case where it is not forbidden to list them -explicitly as part of a subproject (*note Patch Restriction::), -although I don't see why you would want to do that. - - -File: patcher.info, Node: ChangeLogs Appearance, Next: ChangeLogs Prologue, Prev: ChangeLogs Updating, Up: ChangeLogs Handling - -ChangeLogs Appearance ---------------------- - -When Patcher has to deal with ChangeLog files, you insert ChangeLog -entries in the message buffer by calling the function -`patcher-insert-change-logs'. It is bound to `C-c C-p i' in the mail -buffer. Note that if ChangeLogs are written in advance, you don't have -to do that, as Patcher will do it automatically. You have to call this -function by hand only in `automatic' updating mode (*note ChangeLogs -Updating::). - - In all circumstances however, you can use this function to -*reinsert* the ChangeLog entries into the mail buffer. That might come -in handy if you further modified them after the initial insertion (it's -never too late to fix a typo). - - The appearance of ChangeLog entries in the message is controlled by -the `:change-logs-appearance' project option. Its value must be a -symbol from the following: - -`verbatim' - This is the default. ChangeLog entries appear just as text in the - message, above the patch. Most people prefer this kind of - appearance since it is the most readable. - -`packed' - ChangeLog entries appear as a patch (they are diff'ed against the - archive). This patch is however distinct from the source patch, and - appears above it. - -`patch' - ChangeLog entries appear as a patch (they are diff'ed against the - archive), and this patch is integrated into the source patch. In - other words, the message looks like a global patch integrating - both the sources and the ChangeLogs. - - When the ChangeLogs appearance is either `packed' or `patch', the -diff command used to generate the patch is controlled by the -`:change-logs-diff-command' project option. The value can be the symbol -`diff', meaning that the same diff command is to be used as for the -sources (*note Diff Command::), or it can be a string specifying an -alternate command. - - When diffing ChangeLog files, it is strongly recommended that you -remove contexts from the diff, because otherwise, ChangeLog patches -often fail to apply correctly. - - As in the case of the `:diff-command' project option (*note Patch -Restriction::), a `%f' serves to indicate where to put the ChangeLog -files on the diff command line, and a `%n' is replaced with the -project's name (*note Subproject Naming::). See also *Note More On -Commands::. - - Given these two remarks, you should now understand why the default -value for `patcher-default-change-logs-diff-command' is `cvs -q diff -U -0 %f'. - - -File: patcher.info, Node: ChangeLogs Prologue, Prev: ChangeLogs Appearance, Up: ChangeLogs Handling - -ChangeLogs Prologue -------------------- - -ChangeLog prologues are small pieces of informative text that Patcher -adds above each ChangeLog insertion in the mail buffer. - - When the ChangeLogs appearance is `verbatim', Patcher inserts one -prologue per ChangeLog file. The prologue's contents is controlled by -the `:change-logs-prologue' project option (a string). A `%f' appearing -in this string will be replaced with the ChangeLog filename. The -default value for `patcher-default-change-logs-prologue' is `"%f -addition:"'. - - When the ChangeLogs appearance is `packed', Patcher inserts only one -prologue for the whole ChangeLogs patch. When `patch', there is a -single prologue for both the ChangeLogs and the sources. For -customizing the prologue in both of these cases, see *Note Diff -Prologue::. - - -File: patcher.info, Node: Project Check In, Next: Mail Sending, Prev: ChangeLogs Handling, Up: User Manual - -Project Check In -================ - -If you have the privilege to commit your changes yourself, you might do -so directly from the mail buffer, as the last operation before actually -sending the message. This is done by calling the function -`patcher-commit-change' which is bound to `C-c C-p c' in the mail -buffer. - - Committing directly from Patcher has the advantage that both the -commit command line and the commit log message (*note Log Message -Handling::) are constructed automatically. Of course, you still have an -in-depth control on the commit process. - -* Menu: - -* Commit Command:: Specifying the command to commit the patch -* Log Message Handling:: Building a commit log message -* Commit Operation:: Actually committing your changes - - -File: patcher.info, Node: Commit Command, Next: Log Message Handling, Prev: Project Check In, Up: Project Check In - -Commit Command --------------- - -The command used to to commit a patch is specified by the -`:commit-command' project option (a string). You can also temporarily -change the command in question by calling `patcher-commit-change' with -a prefix argument. As usual, note that this prefix argument is not -meant to modify the affected files on the command line. It's meant only -to punctually modify the commit command itself. The affected files are -computed automatically by Patcher. - - The commit command accepts (and maybe requires) special constructs: - - * A `%n' occurring in the string will be replaced with the project's - name (*note Subproject Naming::). - - * A `%f' occurring in the string will be replaced with the files - affected by the patch (ChangeLogs included, this time), or - discarded if the patch is global. - - * A `%s' occurring in the string will be replaced with the name of a - file containing the commit log message (*note Log Message - Handling::). This file is a temporary file handled by Patcher. - - * A `%S' occurring in the string will be replaced with the commit log - message itself (*note Log Message Handling::). Since the intent - here is to use the message as a command-line argument, it is - quoted against shell expansion. - - Please note that a `%f' is required in your commit commands, unless -you know for sure that you will never ever work on a subproject (*note -Patch Restriction::). But you never know that. Besides, you should -always also provide either a `%s' or a `%S', unless your archival -software does not support log messages. - - Given that, you should now understand why the default value for -`patcher-default-commit-command' is `cvs commit -F %s %f'. - - -File: patcher.info, Node: Log Message Handling, Next: Commit Operation, Prev: Commit Command, Up: Project Check In - -Log Message Handling --------------------- - -Most project management tools understand the concept of a "log -message": a short yet informative message that accompany the commit -operation, which is also stored in the repository. - - Before a commit operation, Patcher always builds an initial log -message, based on certain elements under your control (*note Log -Message Elements::). Afterwards, you can decide on whether you want -some further (manual) edition of log message, or whether you want to -commit immediately. - - The `:edit-log-message' project option lets you specify this -behavior. If `t' (the default), you will be able to manually edit the -log message. If `nil', Patcher will proceed directly to the commit -operation. - - Please note that Patcher stores log messages in temporary files that -will be used later by the commit command. - -* Menu: - -* Log Message Elements:: Elements Patcher can add automatically -* Log Message Editing:: Manually modifying the log message - - -File: patcher.info, Node: Log Message Elements, Next: Log Message Editing, Prev: Log Message Handling, Up: Log Message Handling - -Log Message Elements -.................... - -Patcher has the ability to initialize the log message with different -elements. These elements are specified with the `:log-message-items' -project option. Its value is either `nil', meaning that you don't want -any initialization, or a list of symbols specifying the elements you -desire. The available items are: - -`subject' - The subject of the message. The subject's prefix is automatically - removed. - -`compressed-change-logs' - The "compressed" ChangeLog entries. Only the most important part of - the ChangeLogs is preserved, so the entries appear in a more - compact fashion. - -`change-logs' - The raw ChangeLog entries. - - By default, only the message's subject is used. When using more than -one item, they appear in the order specified above. If anything appears -before the raw ChangeLog entries, a separator string is used. This -string is specified by the `:change-logs-separator' project option. By -default the string looks like "-- ChangeLog entries follow: --". - - -File: patcher.info, Node: Log Message Editing, Prev: Log Message Elements, Up: Log Message Handling - -Log Message Editing -................... - -If so required, Patcher lets you manually edit the log message after -having initialized it. Log message edition happens in a special buffer, -the `*Patcher Log Message*' buffer. - - While editing this buffer, commands to insert the items described in -*Note Log Message Elements:: are at your disposal. These commands -perform insertion at point: - -`patcher-logmsg-insert-subject' - Bound to `C-c C-p s'. Insert the message's subject (sans the - prefix). - -`patcher-logmsg-insert-compressed-change-logs' - Bound to `C-c C-p c'. Insert the compressed ChangeLog entries. - -`patcher-logmsg-insert-change-logs' - Bound to `C-c C-p l'. Insert the raw ChangeLog entries. Use a - prefix argument if you also want the ChangeLogs separator string - to be inserted. - - In addition to these commands, you can also completely reinitialize -the log message according to the specified items, by calling the -function `patcher-logmsg-init-message', bound to `C-c C-p i'. Caution: -this command first erases the buffer. - - Finally, once you're happy with your log message, you proceed to the -commit operation by calling the function `patcher-logmsg-commit', bound -to `C-c C-c'. - - -File: patcher.info, Node: Commit Operation, Prev: Log Message Handling, Up: Project Check In - -Commit Operation ----------------- - -The commit operation occurs after typing `C-c C-p c' from the mail -buffer, if you have not required log message edition, or after typing -`C-c C-c' from the `*Patcher Log Message*' buffer otherwise. - - At that point, Patcher has constructed a proper commit command. You -still have an option to abort the process, though: the -`:confirm-commits' project option lets you specify whether to require -confirmation before committing. If `t' (the default), Patcher will -display the constructed commit command and ask for a confirmation -before proceeding. If `nil', Patcher will commit immediately. - - After the commit operation, Patcher changes some parts of the mail -buffer in the following manner: - - * The subject prefix is changed to that specified by the - `:subject-committed-prefix' project option (a string), unless it is - `nil'. By default, "[COMMIT]" is used. - - * A commit notice is added right at the beginning of the message's - body. This notice is specified by the `:committed-notice' project - option. It can be `nil' or a string. By default, it reads "NOTE: - this patch has been committed.". - - -File: patcher.info, Node: Mail Sending, Next: More On Commands, Prev: Project Check In, Up: User Manual - -Mail Sending -============ - -Sending the message will most probably be done by typing `C-c C-c' in -the mail buffer. This is also the case when you're using the fake mail -method, by the way. - -* Menu: - -* Before Sending:: Patcher does some checkings -* After Sending:: patcher does some cleanup - - -File: patcher.info, Node: Before Sending, Next: After Sending, Prev: Mail Sending, Up: Mail Sending - -Before Sending --------------- - -There are circumstances in which Patcher will perform some checkings on -your message when you send it, just before it is actually sent: - - * ChangeLogs insertion - - In case of manual ChangeLog insertion (*note ChangeLogs - Appearance::), Patcher can check that you have indeed inserted the - ChangeLog entries before sending the message. This behavior is - controlled by the `patcher-mail-check-change-logs-insertion' user - option. A value of `nil' means never check (the message will be - sent as-is). A value of t means check, and abort the sending if - the ChangeLog entries are missing. A value of `ask' (the default) - means ask for your opinion on this terrible matter. - - * Commit Operation - - Patcher has a `:commit-privilege' project option; a boolean - specifying whether you're likely to commit your changes by - yourself. - - In case of commit privilege, Patcher can check that you have indeed - committed your changes before sending the message. This behavior is - controlled by the `patcher-mail-check-commit-action' user option. A - value of `nil' means never check (the message will be sent as-is). - A value of t means check, and abort the sending if the commit - operation has not been performed. A value of `ask' (the default) - means ask for your opinion on this rather unfortunate situation. - - Two notes on these checkings: - - * For uninteresting technical reasons, Patcher does not currently - (and will probably never) offer you an automatic ChangeLogs - insertion or commit operation, at mail sending time, but just - abort the sending process in some circumstances. That's not a big - deal though. - - * For other uninteresting technical reasons, these checkings require - a native knowledge of your mail user agent. Patcher does not - currently support all mail user agents on earth (I'll add them on - demand however). If that's the case, you will be warned and - invited to send me a message. Also, you can send me one on April - 21st: it's my birthday. - - -File: patcher.info, Node: After Sending, Prev: Before Sending, Up: Mail Sending - -After Sending -------------- - -After sending the message, Patcher also performs some cleanup -operations, that you can customize. The cleanup is controlled by the -following project options. Each one is a boolean option which defaults -to `t'. - -`:kill-source-files-after-sending' - Whether to kill source files after sending the message. If `nil', - the source files will remain visited. - -`:kill-change-logs-after-sending' - Whether to kill ChangeLog files after sending the message. If - `nil', the ChangeLog files will remain visited. - - -File: patcher.info, Node: More On Commands, Next: More On Subprojects, Prev: Mail Sending, Up: User Manual - -More On Commands -================ - -This section deals with information that apply to all commands used by -Patcher (diff and commit operations). - -* Menu: - -* Prefixing Commands:: Bypassing a firewall -* Error Handling:: Dealing with errors - - -File: patcher.info, Node: Prefixing Commands, Next: Error Handling, Up: More On Commands - -Prefixing Commands ------------------- - -If you're working on a distant archive and you're behind a firewall, you -might need to prefix all your commands with something like `runsocks'. -Of course, this can be done manually in all your command settings, but -Patcher offers you a simpler way to do it. - - There is a project option named `:pre-command' which can be used for -this kind of thing. It must be a string that will be prepended to all -operations performed by Patcher. - - -File: patcher.info, Node: Error Handling, Prev: Prefixing Commands, Up: More On Commands - -Error Handling --------------- - -From time to time, commands may fail for different reasons. Patcher -tracks the failures in these commands and lets you know when that -happens. The `:failed-command-regexp' project option lets you specify a -regular expression to match with the output of an aborted command. By -default, the value is `"^cvs \\[[^]]* aborted\\]"'. - - -File: patcher.info, Node: More On Subprojects, Prev: More On Commands, Up: User Manual - -More On Subprojects -=================== - -We've already seen how to work punctually on a subproject, that is, on a -subset of a project's files (*note Patch Restriction::). If you happen -to work more than once on the same project subset, it will quickly -become annoying to have to specify explicitly the same files over and -over again. Patcher offers you a way to permanently define subprojects. - -* Menu: - -* Defining Subprojects:: Storing subprojects definitions -* Subproject Naming:: When different projects have the same name -* Command Directory:: For non local revision control systems - - -File: patcher.info, Node: Defining Subprojects, Next: Subproject Naming, Up: More On Subprojects - -Defining Subprojects --------------------- - -The user option `patcher-subprojects' stores a list of "subproject -descriptors". A subproject descriptor is almost the same as a project -descriptor, with a few exceptions: - - * Instead of the project directory field (the second field in a - project descriptor), you rather specify the name of the project - this subproject is based on. - - * In addition to the standard project options we've already seen, two - subproject options are available: - `:subdirectory' - This lets you specify a subdirectory of the original - project's directory in which the whole subproject resides. - - `:files' - This lets you specify a list of files or directories - composing the subproject. Each file specification can contain - wildcards. If a `:subdirectory' subproject option is given, - these files or directories should be relative to this - subdirectory. Otherwise, they should be relative to the - parent project's directory. - - Please note that these subproject options have no corresponding - fallback (that would be meaningless). They can't appear in a theme - either. - - * Subprojects don't have an `:inheritance' mechanism. Instead, they - implicitly inherit from their base project (which in turn can - inherit from other projects). - - Here are some important remarks about subprojects: - - * A subproject with neither a `:subdirectory' nor a `:files' option - is exactly the same as the base project, apart from project - options that you would override. - - * Since permanent subprojects are defined statically, they should be - used with the normal Patcher functions like `patcher-mail'. You - don't need to use the `*-subproject' versions any more. - - * Because of that, projects and subprojects can't have names in - common. If that happens to be the case, Patcher will blindly use a - subproject rather than a project of that name - - * So what happens if you persist in using a `*-subproject' function - on a permanent subproject ? Well, you punctually work on a - subsubproject... - - -File: patcher.info, Node: Subproject Naming, Next: Command Directory, Prev: Defining Subprojects, Up: More On Subprojects - -Subproject Naming ------------------ - -As you already know, Patcher distinguishes projects by their NAME field -in the `patcher-projects' and `patcher-subprojects' user options. This -is problematic, however, if you define different patcher projects for a -single physical project, and the commands require the project's name. -That might for instance be the case with PRCS (decidedly) weird options -syntax. - - To remedy this problem, patcher provides a `:name' project option. -If set, it will actually be used for all `%n' substitutions where the -project's name (in the Patcher sense) would normally be used. - - If you want to use the project's name in the Patcher sense, -regardless of the value of the `:name' option, use `%N' instead of `%n'. - - -File: patcher.info, Node: Command Directory, Prev: Subproject Naming, Up: More On Subprojects - -Command Directory ------------------ - -Some revision control systems, like CVS, work on a per-file basis. Some -others, like PRCS, work only globally. This has an important implication -for subprojects being sudirectories of other projects. Indeed, while -CVS, for instance, can be executed anywhere, PRCS can only be run in the -base project's root directory. - - If you want to define projects for which the revision control system -can be executed in only one directory, Patcher provides you with the -`:command-directory' project option (a string). This directory can be -specified relative to the project's directory (but note that it must go -upwards). - - All commands (diff and commit ones) will be executed from there. -Also, note that the command directory does not change the way you might -specify files. Patcher modifies all needed paths automatically to handle -the command directory properly. - - -File: patcher.info, Node: Variables Index, Next: Functions Index, Prev: User Manual, Up: Top - -Variables Index -*************** - -* Menu: - -* :after-diff-hook: After Diff Hook. -* :change-logs-appearance: ChangeLogs Appearance. -* :change-logs-diff-command: ChangeLogs Appearance. -* :change-logs-prologue: ChangeLogs Prologue. -* :change-logs-separator: Log Message Elements. -* :change-logs-updating: ChangeLogs Updating. -* :change-logs-user-mail: ChangeLogs Updating. -* :change-logs-user-name: ChangeLogs Updating. -* :command-directory: Command Directory. -* :commit-command: Commit Command. -* :commit-privilege: Before Sending. -* :committed-notice: Commit Operation. -* :confirm-commits: Commit Operation. -* :diff-command <1>: ChangeLogs Appearance. -* :diff-command <2>: Diff Command. -* :diff-command: Patch Restriction. -* :diff-line-filter: Diff Line Filter. -* :diff-prologue-function <1>: ChangeLogs Prologue. -* :diff-prologue-function: Diff Prologue. -* :edit-log-message: Log Message Handling. -* :failed-command-regexp: Error Handling. -* :files: Defining Subprojects. -* :gnus-group <1>: Standard Mail Methods. -* :gnus-group: Message Customization. -* :inheritance <1>: Project inheritance. -* :inheritance <2>: Retrieval. -* :inheritance: Defining Subprojects. -* :kill-change-logs-after-sending: After Sending. -* :kill-source-files-after-diffing: ChangeLogs Updating. -* :kill-source-files-after-sending: After Sending. -* :log-message-items: Log Message Elements. -* :mail-method <1>: Other Mail Methods. -* :mail-method: Mail Methods. -* :name: Subproject Naming. -* :pre-command: Prefixing Commands. -* :subdirectory: Defining Subprojects. -* :subject: Message Customization. -* :subject-committed-prefix: Commit Operation. -* :subject-prefix: Message Customization. -* :themes <1>: Retrieval. -* :themes: Themes. -* :to-address <1>: Fallbacks. -* :to-address <2>: Message Customization. -* :to-address <3>: Project Descriptors. -* :to-address: Calling Patcher. -* :user-mail: Message Customization. -* :user-name: Message Customization. -* mail-user-agent: Standard Mail Methods. -* patcher-default-after-diff-hook: After Diff Hook. -* patcher-default-change-logs-appearance: ChangeLogs Appearance. -* patcher-default-change-logs-diff-command: ChangeLogs Appearance. -* patcher-default-change-logs-prologue: ChangeLogs Prologue. -* patcher-default-change-logs-separator: Log Message Elements. -* patcher-default-change-logs-updating: ChangeLogs Updating. -* patcher-default-change-logs-user-mail: ChangeLogs Updating. -* patcher-default-change-logs-user-name: ChangeLogs Updating. -* patcher-default-command-directory: Command Directory. -* patcher-default-commit-command: Commit Command. -* patcher-default-commit-privilege: Before Sending. -* patcher-default-committed-notice: Commit Operation. -* patcher-default-confirm-commits: Commit Operation. -* patcher-default-diff-command <1>: ChangeLogs Appearance. -* patcher-default-diff-command <2>: Patch Restriction. -* patcher-default-diff-command: Diff Command. -* patcher-default-diff-line-filter: Diff Line Filter. -* patcher-default-diff-prologue-function <1>: ChangeLogs Prologue. -* patcher-default-diff-prologue-function: Diff Prologue. -* patcher-default-edit-log-message: Log Message Handling. -* patcher-default-failed-command-regexp: Error Handling. -* patcher-default-gnus-group <1>: Standard Mail Methods. -* patcher-default-gnus-group: Message Customization. -* patcher-default-kill-change-logs-after-sending: After Sending. -* patcher-default-kill-source-files-after-diffing: ChangeLogs Updating. -* patcher-default-kill-source-files-after-sending: After Sending. -* patcher-default-log-message-items: Log Message Elements. -* patcher-default-mail-method <1>: Mail Methods. -* patcher-default-mail-method: Other Mail Methods. -* patcher-default-name: Subproject Naming. -* patcher-default-pre-command: Prefixing Commands. -* patcher-default-subject: Message Customization. -* patcher-default-subject-committed-prefix: Commit Operation. -* patcher-default-subject-prefix: Message Customization. -* patcher-default-themes <1>: Retrieval. -* patcher-default-themes: Themes. -* patcher-default-to-address <1>: Fallbacks. -* patcher-default-to-address <2>: Message Customization. -* patcher-default-to-address <3>: Project Descriptors. -* patcher-default-to-address: Calling Patcher. -* patcher-default-user-mail: Message Customization. -* patcher-default-user-name: Message Customization. -* patcher-mail-check-change-logs-insertion: Before Sending. -* patcher-mail-check-commit-action: Before Sending. -* patcher-mail-run-gnus: Standard Mail Methods. -* patcher-mail-run-gnus-other-frame: Standard Mail Methods. -* patcher-max-inheritance-depth: Project inheritance. -* patcher-max-theme-depth: Themes. -* patcher-projects <1>: Project Descriptors. -* patcher-projects <2>: Subproject Naming. -* patcher-projects: Setting up Patcher. -* patcher-subprojects <1>: Subproject Naming. -* patcher-subprojects: Defining Subprojects. -* patcher-themes <1>: Retrieval. -* patcher-themes: Themes. -* user-full-name: ChangeLogs Updating. -* user-mail-address: ChangeLogs Updating. - - -File: patcher.info, Node: Functions Index, Next: Keystrokes Index, Prev: Variables Index, Up: Top - -Functions Index -*************** - -* Menu: - -* compose-mail: Standard Mail Methods. -* gnus-post-news: Standard Mail Methods. -* mail: Standard Mail Methods. -* message-mail: Standard Mail Methods. -* patch-to-change-log: ChangeLogs Updating. -* patcher-commit-change <1>: Commit Command. -* patcher-commit-change <2>: Committing the Patch. -* patcher-commit-change: Project Check In. -* patcher-default-diff-prologue <1>: Diff Prologue. -* patcher-default-diff-prologue: ChangeLogs Prologue. -* patcher-generate-diff <1>: Patch Generation. -* patcher-generate-diff: Patch Restriction. -* patcher-gnus-summary-followup <1>: Mail Preparation. -* patcher-gnus-summary-followup: Patch Restriction. -* patcher-gnus-summary-followup-with-original <1>: Patch Restriction. -* patcher-gnus-summary-followup-with-original: Mail Preparation. -* patcher-gnus-summary-reply <1>: Mail Preparation. -* patcher-gnus-summary-reply: Patch Restriction. -* patcher-gnus-summary-reply-with-original <1>: Mail Preparation. -* patcher-gnus-summary-reply-with-original: Patch Restriction. -* patcher-insert-change-logs <1>: Filling the Message. -* patcher-insert-change-logs: ChangeLogs Appearance. -* patcher-logmsg-commit <1>: Committing the Patch. -* patcher-logmsg-commit: Log Message Editing. -* patcher-logmsg-init-message: Log Message Editing. -* patcher-logmsg-insert-change-logs: Log Message Editing. -* patcher-logmsg-insert-compressed-change-logs: Log Message Editing. -* patcher-logmsg-insert-subject: Log Message Editing. -* patcher-mail <1>: Calling Patcher. -* patcher-mail <2>: Diff Command. -* patcher-mail <3>: Patch Restriction. -* patcher-mail <4>: Mail Preparation. -* patcher-mail: Defining Subprojects. -* patcher-mail-adapt <1>: Mail Preparation. -* patcher-mail-adapt <2>: Patch Restriction. -* patcher-mail-adapt: Defining Subprojects. -* patcher-mail-adapt-subproject <1>: Patch Restriction. -* patcher-mail-adapt-subproject: Defining Subprojects. -* patcher-mail-compose-mail: Standard Mail Methods. -* patcher-mail-fake: Fake Mail Method. -* patcher-mail-gnus: Standard Mail Methods. -* patcher-mail-message: Standard Mail Methods. -* patcher-mail-sendmail: Standard Mail Methods. -* patcher-mail-subproject <1>: Defining Subprojects. -* patcher-mail-subproject: Patch Restriction. -* patcher-prcs-diff-convert: After Diff Hook. - - -File: patcher.info, Node: Keystrokes Index, Prev: Functions Index, Up: Top - -Keystrokes Index -**************** - -* Menu: - -* C-c C-c <1>: Log Message Editing. -* C-c C-c <2>: Commit Operation. -* C-c C-c: Committing the Patch. -* C-c C-p c <1>: Log Message Editing. -* C-c C-p c <2>: Commit Operation. -* C-c C-p c <3>: Committing the Patch. -* C-c C-p c: Project Check In. -* C-c C-p d: Patch Generation. -* C-c C-p F: Mail Preparation. -* C-c C-p f: Mail Preparation. -* C-c C-p i <1>: Filling the Message. -* C-c C-p i <2>: Log Message Editing. -* C-c C-p i: ChangeLogs Appearance. -* C-c C-p l: Log Message Editing. -* C-c C-p r: Mail Preparation. -* C-c C-p R: Mail Preparation. -* C-c C-p s: Log Message Editing. - - - -Tag Table: -Node: Top1225 -Node: Copying2018 -Node: Introduction2706 -Node: Installation5071 -Node: Distribution5395 -Node: Requirements6728 -Node: Insinuation7862 -Node: Quick Start8479 -Node: Setting up Patcher9637 -Node: Calling Patcher10781 -Node: Filling the ChangeLogs12410 -Node: Filling the Message12911 -Node: Committing the Patch13647 -Node: Sending the Message15352 -Node: User Manual16244 -Node: Project Descriptors17185 -Node: Themes18518 -Node: Project inheritance19810 -Node: Fallbacks21011 -Node: Retrieval21935 -Node: Inheritance or theme ?23405 -Node: Mail Preparation24321 -Node: Mail Methods26698 -Node: Standard Mail Methods27260 -Node: Fake Mail Method30207 -Node: Other Mail Methods31399 -Node: Message Customization32156 -Node: Patch Generation34201 -Node: Diff Command35727 -Node: After Diff Hook36349 -Node: Diff Line Filter37328 -Node: Patch Restriction38214 -Node: Patcher Instances40791 -Node: Diff Prologue41593 -Node: ChangeLogs Handling43117 -Node: ChangeLogs Updating43662 -Node: ChangeLogs Appearance46762 -Node: ChangeLogs Prologue49348 -Node: Project Check In50254 -Node: Commit Command51118 -Node: Log Message Handling52966 -Node: Log Message Elements54066 -Node: Log Message Editing55235 -Node: Commit Operation56556 -Node: Mail Sending57814 -Node: Before Sending58216 -Node: After Sending60425 -Node: More On Commands61056 -Node: Prefixing Commands61414 -Node: Error Handling61983 -Node: More On Subprojects62438 -Node: Defining Subprojects63128 -Node: Subproject Naming65381 -Node: Command Directory66253 -Node: Variables Index67249 -Node: Functions Index73726 -Node: Keystrokes Index76712 - -End Tag Table diff --git a/xemacs-packages/info/pgg.info b/xemacs-packages/info/pgg.info deleted file mode 100644 index 016e36db..00000000 --- a/xemacs-packages/info/pgg.info +++ /dev/null @@ -1,431 +0,0 @@ -This is pgg.info, produced by makeinfo version 4.6 from pgg.texi. - -This file describes the PGG. - - Copyright (C) 2003, 2004 Free Software Foundation, Inc. Copyright -(C) 2001 Daiki Ueno. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.1 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". - -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* PGG: (pgg). Emacs interface to various PGP implementations. -END-INFO-DIR-ENTRY - - -File: pgg.info, Node: Top, Next: Overview, Up: (dir) - -PGG -*** - -This manual describes PGG. PGG is an interface library between Emacs -and various tools for secure communication. PGG also provides a simple -user interface to encrypt, decrypt, sign, and verify MIME messages. - -* Menu: - -* Overview:: What PGG is. -* Prerequisites:: Complicated stuff you may have to do. -* How to use:: Getting started quickly. -* Architecture:: -* Parsing OpenPGP packets:: -* Function Index:: -* Variable Index:: - - -File: pgg.info, Node: Overview, Next: Prerequisites, Prev: Top, Up: Top - -Overview -******** - -PGG is an interface library between Emacs and various tools for secure -communication. Even though Mailcrypt has similar feature, it does not -deal with detached PGP messages, normally used in PGP/MIME -infrastructure. This was the main reason why I wrote the new library. - - PGP/MIME is an application of MIME Object Security Services -(RFC1848). The standard is documented in RFC2015. - - -File: pgg.info, Node: Prerequisites, Next: How to use, Prev: Overview, Up: Top - -Prerequisites -************* - -PGG requires at least one implementation of privacy guard system. This -document assumes that you have already obtained and installed them and -that you are familiar with its basic functions. - - By default, PGG uses GnuPG, but Pretty Good Privacy version 2 or -version 5 are also supported. If you are new to such a system, I -recommend that you should look over the GNU Privacy Handbook (GPH) -which is available at `http://www.gnupg.org/gph/'. - - -File: pgg.info, Node: How to use, Next: Architecture, Prev: Prerequisites, Up: Top - -How to use -********** - -The toplevel interface of this library is quite simple, and only -intended to use with public-key cryptographic operation. - - To use PGG, evaluate following expression at the beginning of your -application program. - - (require 'pgg) - - If you want to check existence of pgg.el at runtime, instead you can -list autoload setting for desired functions as follows. - - (autoload 'pgg-encrypt-region "pgg" - "Encrypt the current region." t) - (autoload 'pgg-decrypt-region "pgg" - "Decrypt the current region." t) - (autoload 'pgg-sign-region "pgg" - "Sign the current region." t) - (autoload 'pgg-verify-region "pgg" - "Verify the current region." t) - (autoload 'pgg-insert-key "pgg" - "Insert the ASCII armored public key." t) - (autoload 'pgg-snarf-keys-region "pgg" - "Import public keys in the current region." t) - -* Menu: - -* User Commands:: -* Selecting an implementation:: -* Caching passphrase:: -* Default user identity:: - - -File: pgg.info, Node: User Commands, Next: Selecting an implementation, Up: How to use - -User Commands -============= - -At this time you can use some cryptographic commands. The behavior of -these commands relies on a fashion of invocation because they are also -intended to be used as library functions. In case you don't have the -signer's public key, for example, the function `pgg-verify-region' -fails immediately, but if the function had been called interactively, it -would ask you to retrieve the signer's public key from the server. - - - Command: pgg-encrypt-region start end recipients &optional sign - Encrypt the current region between START and END for RECIPIENTS. - When the function were called interactively, you would be asked - about the recipients. - - If encryption is successful, it replaces the current region - contents (in the accessible portion) with the resulting data. - - If optional argument SIGN is non-`nil', the function is request to - do a combined sign and encrypt. This currently only work with - GnuPG. - - - Command: pgg-decrypt-region start end - Decrypt the current region between START and END. If decryption - is successful, it replaces the current region contents (in the - accessible portion) with the resulting data. - - - Command: pgg-sign-region start end &optional cleartext - Make the signature from text between START and END. If the - optional third argument CLEARTEXT is non-`nil', or the function is - called interactively, it does not create a detached signature. In - such a case, it replaces the current region contents (in the - accessible portion) with the resulting data. - - - Command: pgg-verify-region start end &optional signature fetch - Verify the current region between START and END. If the optional - third argument SIGNATURE is non-`nil', or the function is called - interactively, it is treated as the detached signature of the - current region. - - If the optional 4th argument FETCH is non-`nil', or the function - is called interactively, we attempt to fetch the signer's public - key from the key server. - - - Command: pgg-insert-key - Retrieve the user's public key and insert it as ASCII-armored - format. - - - Command: pgg-snarf-keys-region start end - Collect public keys in the current region between START and END, - and add them into the user's keyring. - - -File: pgg.info, Node: Selecting an implementation, Next: Caching passphrase, Prev: User Commands, Up: How to use - -Selecting an implementation -=========================== - -Since PGP has a long history and there are a number of PGP -implementations available today, the function which each one has differs -considerably. For example, if you are using GnuPG, you know you can -select cipher algorithm from 3DES, CAST5, BLOWFISH, and so on, but on -the other hand the version 2 of PGP only supports IDEA. - - By default, if the variable `pgg-scheme' is not set, PGG searches the -registered scheme for an implementation of the requested service -associated with the named algorithm. If there are no match, PGG uses -`pgg-default-scheme'. In other words, there are two options to control -which command is used to process the incoming PGP armors. One is for -encrypting and signing, the other is for decrypting and verifying. - - - Variable: pgg-scheme - Force specify the scheme of PGP implementation for decrypting and - verifying. The value can be `gpg', `pgp', and `pgp5'. - - - Variable: pgg-default-scheme - Force specify the scheme of PGP implementation for encrypting and - signing. The value can be `gpg', `pgp', and `pgp5'. - - -File: pgg.info, Node: Caching passphrase, Next: Default user identity, Prev: Selecting an implementation, Up: How to use - -Caching passphrase -================== - -PGG uses a simple passphrase caching mechanism, which is enabled by -default. - - - Variable: pgg-cache-passphrase - If non-`nil', store passphrases. The default value of this - variable is `t'. If you were worry about security issue, however, - you could stop caching with setting it `nil'. - - - Variable: pgg-passphrase-cache-expiry - Elapsed time for expiration in seconds. - - -File: pgg.info, Node: Default user identity, Prev: Caching passphrase, Up: How to use - -Default user identity -===================== - -The PGP implementation is usually able to select the proper key to use -for signing and decryption, but if you have more than one key, you may -need to specify the key id to use. - - - Variable: pgg-default-user-id - User ID of your default identity. It defaults to the value - returned by `(user-login-name)'. You can customize this variable. - - - Variable: pgg-gpg-user-id - User ID of the GnuPG default identity. It defaults to `nil'. - This overrides `pgg-default-user-id'. You can customize this - variable. - - - Variable: pgg-pgp-user-id - User ID of the PGP 2.x/6.x default identity. It defaults to - `nil'. This overrides `pgg-default-user-id'. You can customize - this variable. - - - Variable: pgg-pgp5-user-id - User ID of the PGP 5.x default identity. It defaults to `nil'. - This overrides `pgg-default-user-id'. You can customize this - variable. - - -File: pgg.info, Node: Architecture, Next: Parsing OpenPGP packets, Prev: How to use, Up: Top - -Architecture -************ - -PGG introduces the notion of a "scheme of PGP implementation" (used -interchangeably with "scheme" in this document). This term refers to a -singleton object wrapped with the luna object system. - - Since PGG was designed for accessing and developing PGP -functionality, the architecture had to be designed not just for -interoperability but also for extensiblity. In this chapter we explore -the architecture while finding out how to write the PGG backend. - -* Menu: - -* Initializing:: -* Backend methods:: -* Getting output:: - - -File: pgg.info, Node: Initializing, Next: Backend methods, Up: Architecture - -Initializing -============ - -A scheme must be initialized before it is used. It had better -guarantee to keep only one instance of a scheme. - - The following code is snipped out of `pgg-gpg.el'. Once an instance -of `pgg-gpg' scheme is initialized, it's stored to the variable -`pgg-scheme-gpg-instance' and will be reused from now on. - - (defvar pgg-scheme-gpg-instance nil) - - (defun pgg-make-scheme-gpg () - (or pgg-scheme-gpg-instance - (setq pgg-scheme-gpg-instance - (luna-make-entity 'pgg-scheme-gpg)))) - - The name of the function must follow the -regulation--`pgg-make-scheme-' follows the backend name. - - -File: pgg.info, Node: Backend methods, Next: Getting output, Prev: Initializing, Up: Architecture - -Backend methods -=============== - -In each backend, these methods must be present. The output of these -methods is stored in special buffers (*Note Getting output::), so that -these methods must tell the status of the execution. - - - Method: pgg-scheme-lookup-key scheme string &optional type - Return keys associated with STRING. If the optional third - argument TYPE is non-`nil', it searches from the secret keyrings. - - - Method: pgg-scheme-encrypt-region scheme start end recipients - &optional sign - Encrypt the current region between START and END for RECIPIENTS. - If SIGN is non-`nil', do a combined sign and encrypt. If - encryption is successful, it returns `t', otherwise `nil'. - - - Method: pgg-scheme-decrypt-region scheme start end - Decrypt the current region between START and END. If decryption - is successful, it returns `t', otherwise `nil'. - - - Method: pgg-scheme-sign-region scheme start end &optional cleartext - Make the signature from text between START and END. If the - optional third argument CLEARTEXT is non-`nil', it does not create - a detached signature. If signing is successful, it returns `t', - otherwise `nil'. - - - Method: pgg-scheme-verify-region scheme start end &optional signature - Verify the current region between START and END. If the optional - third argument SIGNATURE is non-`nil', it is treated as the - detached signature of the current region. If the signature is - successfully verified, it returns `t', otherwise `nil'. - - - Method: pgg-scheme-insert-key scheme - Retrieve the user's public key and insert it as ASCII-armored - format. On success, it returns `t', otherwise `nil'. - - - Method: pgg-scheme-snarf-keys-region scheme start end - Collect public keys in the current region between START and END, - and add them into the user's keyring. On success, it returns `t', - otherwise `nil'. - - -File: pgg.info, Node: Getting output, Prev: Backend methods, Up: Architecture - -Getting output -============== - -The output of the backend methods (*Note Backend methods::) is stored in -special buffers, so that these methods must tell the status of the -execution. - - - Variable: pgg-errors-buffer - The standard error output of the execution of the PGP command is - stored here. - - - Variable: pgg-output-buffer - The standard output of the execution of the PGP command is stored - here. - - - Variable: pgg-status-buffer - The rest of status information of the execution of the PGP command - is stored here. - - -File: pgg.info, Node: Parsing OpenPGP packets, Next: Function Index, Prev: Architecture, Up: Top - -Parsing OpenPGP packets -*********************** - -The format of OpenPGP messages is maintained in order to publish all -necessary information needed to develop interoperable applications. -The standard is documented in RFC 2440. - - PGG has its own parser for the OpenPGP packets. - - - Function: pgg-parse-armor string - List the sequence of packets in STRING. - - - Function: pgg-parse-armor-region start end - List the sequence of packets in the current region between START - and END. - - - Variable: pgg-ignore-packet-checksum - If non-`nil', don't check the checksum of the packets. - - -File: pgg.info, Node: Function Index, Next: Variable Index, Prev: Parsing OpenPGP packets, Up: Top - -Function Index -************** - -* Menu: - -* pgg-decrypt-region: User Commands. -* pgg-encrypt-region: User Commands. -* pgg-insert-key: User Commands. -* pgg-parse-armor: Parsing OpenPGP packets. -* pgg-parse-armor-region: Parsing OpenPGP packets. -* pgg-scheme-decrypt-region: Backend methods. -* pgg-scheme-encrypt-region: Backend methods. -* pgg-scheme-insert-key: Backend methods. -* pgg-scheme-lookup-key: Backend methods. -* pgg-scheme-sign-region: Backend methods. -* pgg-scheme-snarf-keys-region: Backend methods. -* pgg-scheme-verify-region: Backend methods. -* pgg-sign-region: User Commands. -* pgg-snarf-keys-region: User Commands. -* pgg-verify-region: User Commands. - - -File: pgg.info, Node: Variable Index, Prev: Function Index, Up: Top - -Variable Index -************** - -* Menu: - -* pgg-cache-passphrase: Caching passphrase. -* pgg-default-scheme: Selecting an implementation. -* pgg-default-user-id: Default user identity. -* pgg-errors-buffer: Getting output. -* pgg-gpg-user-id: Default user identity. -* pgg-ignore-packet-checksum: Parsing OpenPGP packets. -* pgg-output-buffer: Getting output. -* pgg-passphrase-cache-expiry: Caching passphrase. -* pgg-pgp-user-id: Default user identity. -* pgg-pgp5-user-id: Default user identity. -* pgg-scheme: Selecting an implementation. -* pgg-status-buffer: Getting output. - - - -Tag Table: -Node: Top730 -Node: Overview1274 -Node: Prerequisites1760 -Node: How to use2320 -Node: User Commands3408 -Node: Selecting an implementation5817 -Node: Caching passphrase7058 -Node: Default user identity7613 -Node: Architecture8646 -Node: Initializing9295 -Node: Backend methods10022 -Node: Getting output12047 -Node: Parsing OpenPGP packets12673 -Node: Function Index13370 -Node: Variable Index14391 - -End Tag Table diff --git a/xemacs-packages/info/prog-modes.info b/xemacs-packages/info/prog-modes.info deleted file mode 100644 index ba5d93ed..00000000 --- a/xemacs-packages/info/prog-modes.info +++ /dev/null @@ -1,2718 +0,0 @@ -This is prog-modes.info, produced by makeinfo version 4.7 from -prog-modes.texi. - -INFO-DIR-SECTION XEmacs Editor -START-INFO-DIR-ENTRY -* Programming Modes: (prog-modes). Programming Modes for XEmacs. -END-INFO-DIR-ENTRY - - -File: prog-modes.info, Node: Top, Next: Copying, Prev: (dir), Up: (dir) - -1 The Programming Modes Package -******************************* - -This Info file contains the manual for the Programming Modes package. - -The node name for each entry in the menu is the name of the elisp file -containing the code that implements the functionality described. It is -highly recommended that you briefly peruse the elisp source code since -it can provide valuable information on usage and technique. This can -easily be done by typing `C-x 4 l RET' where is -the name of the elisp file to be loaded. - - In many cases, the `customize' command can be used to customize a -package's options. For those packages that support `customize', the -appropriate command is given. Otherwise, peruse the code as described -above to learn how to set the package's options. - - When you have entered a mode, you may get more info on the -capabilities of that mode by pressing `C-h m'. You may also get online -help describing functions provided by the mode by pressing `C-h f -'. - -* Menu: - -* Copying:: - -* asm-mode:: Editing Assembler Code -* autoconf-mode:: Editing Autoconf Input Files -* awk-mode:: Editing AWK Code -* cl-indent:: Enhanced Lisp-Indent Mode -* cvs:: Light CVS Support -* diff-mode:: Viewing and Editing Context Diffs -* eiffel:: Editing Eiffel Code -* icon:: Editing Icon Code -* javascript-mode:: Editing JavaScript Code -* ksh-mode:: Editing Shell Script (sh, ksh, bash) Code -* lua-mode:: Editing Lua Code -* m4-mode:: Editing m4 Code -* make-mode:: Editing Makefiles -* mode-compile:: Compiling Files According to Major-Mode -* modula2:: Editing Modula-2 Code -* old-c-mode:: Editing C Code -* p4:: Integration with Perforce Version Control -* pascal:: Editing Pascal Code -* php-mode:: Editing PHP Code -* postscript:: Editing PostScript Programs -* prolog:: Editing and Running Prolog Code -* rexx-mode:: Editing REXX Code -* rpm-spec-mode:: Editing RPM Spec Files -* simula:: Editing SIMULA 87 Code -* sql:: Specialized Mode for SQL Interpreters -* tcl:: Editing Tcl Code -* teco:: Teco Interpreter -* uil-mode:: Editing Motif UIL Code -* verilog-mode:: Editing Verilog HDL Source -* vrml-mode:: Editing VRML (.wrl) Files - -* XEmacs License:: XEmacs License - - -File: prog-modes.info, Node: Copying, Next: asm-mode, Prev: Top, Up: Top - -2 Copying -********* - -This document may be redistributed, verbatim or in modified form, under -the terms of the GNU General Public License, version 2 or any later -version. The same terms apply to the libraries it documents. A copy -of the General Public License is provided as an Appendix. - - Most XEmacs documentation has its own license, which is an ancestor -of the GNU Free Documentation License ("FDL"), and whose terms are -quite similar to those imposed by GNU on Emacs documentation. Why is -this manual licensed differently (under the GNU General Public License, -or "GPL"), and why does it have to be distributed separately from the -XEmacs User's Guide and the XEmacs Lisp Reference Manual? - - Taking the second question first, XEmacs is "community-owned" -software. That is, unlike GNU Emacs, there is no monopoly copyright -holder. Many of us, including the original Lucid authors, have -contributed our copyrights to the Free Software Foundation (FSF), and of -course much content is derived from GNU Emacs, and therefore is held by -the FSF. Another large chunk is held by Sun Microsystems, and a few -individual authors hold copyright to thousands of lines each. But many -individuals hold copyright to only a few dozen lines. Like the Linux -kernel, copyright ownership is distributed throughout a community. - - However, its license is "copyleft," _i.e._, it _requires_ that you -redistribute it under terms _identical_ to those under which you -received it, unless you have explicit permission of the copyright -holder. Because of the multiple owners, determining the ownership of -any given part of XEmacs is tedious, and perhaps impossible. For -practical purposes, then, the license of any substantial chunk of -existing XEmacs content cannot be changed, except to a later version of -the GPL, for those parts under GPL. (That is due to the _explicit_ -permission to change to a later version of the GPL, present in every -file of XEmacs.) - - Unfortunately, this severe restriction means that the GPL, FDL, and -the XEmacs documentation license ("XDL") are _mutually incompatible_. -That is, content licensed under any of the GPL, FDL, or XDL _may not_ -be mixed with content licensed under either of the other two without -changing the license of some of the content. But this requires -permission of the copyright holder, which is often difficult or -impossible to get. - - For example, you _may not_ take comments or docstrings from XEmacs -code and add them to the Lispref to mend a gap in the latter's coverage. -You _may not_ copy text from the Lispref into docstrings in the code. -And you _may not_ copy text from the GNU Emacs Lisp Reference to the -XEmacs Lisp Reference Manual. (In this case it is at least trivial to -ask permission, although it is rather unclear whether it would be -granted.) - - In fact, parts of this document were derived by copying from XEmacs -code under the GPL, without any further permission from the authors. -Thus, this document must be distributed under the GPL, as a "volume" -separate from the XEmacs documentation under the XDL. Note that the -"mere aggregation" clauses allow us to distribute in the same tarball. -But incorporating it as a node in the Lispref is prohibited, even if -done by inclusion. - - A bit of advocacy: - - If you look carefully at the additional restrictions imposed by the -soi-disant "free" documentation licenses, you discover that they are -simply proprietary restrictions guaranteeing a certain amount of -_unpaid_ political advertising to the Free Software Foundation and GNU -Project (and in the case of the FDL, this is extended to commercial -advertising by authors of original or derived works). Whether this is -"ethically justified" or not is a difficult question. What is certain -is that there is little social benefit to these terms (since the license -documents themselves contain the advocacy and must be included with any -distribution). - - I conclude it makes sense for XEmacs to reduce its restrictions, -where possible, to the "least common denominator," the GNU General -Public License. - - -File: prog-modes.info, Node: asm-mode, Next: autoconf-mode, Prev: Copying, Up: Top - -3 Editing Assembler Code -************************ - -This mode is used for editing Assembler code. The mode is automatically -invoked for buffers visiting any file ending with one of the following -extensions: `.s', `.S', `.asm'. - - The mode is based on text-mode. It defines a private abbrev table -that can be used to save abbrevs for assembler mnemonics. It binds -just five keys: - -`TAB' - Tab to next tab stop - -`:' - Outdent preceding label, tab to tab stop - -`comment char' - Place or move comment. `asm-comment-char' specifies which - character this is; you can use a different character in different - Asm mode buffers. Alternatively, you may set this variable in - `asm-mode-set-comment-hook', which is called near the beginning of - mode initialization. - -`C-j, C-m' - Newline and tab to tab stop - - - Code is automatically indented to the first tab stop level. - - Turning on Asm mode runs the hook `asm-mode-hook' at the end of -initialization. - - To configure this package, type: - - M-x customize-group RET asm RET - - -File: prog-modes.info, Node: autoconf-mode, Next: awk-mode, Prev: asm-mode, Up: Top - -4 Editing Autoconf Input Files -****************************** - -This mode is used for editing autoconf input files. It is automatically -invoked for buffers visiting the following types of files: - - * any file ending with an extension of `.m4' - - * any file named `configure' ending with an extension of either - `.in' or `.ac'. - - - To configure this package please view the source code. This can be -done by typing `C-x 4 l autoconf-mode'. - -* Menu: - -* About Autoconf: about-autoconf. - - -File: prog-modes.info, Node: about-autoconf, Prev: autoconf-mode, Up: autoconf-mode - -4.1 About Autoconf -================== - -Autoconf is an extensible package of m4 macros that produce shell -scripts to automatically configure software source code packages. These -scripts can adapt the packages to many kinds of UNIX-like systems -without manual user intervention. Autoconf creates a configuration -script for a package from a template file that lists the operating -system features that the package can use, in the form of m4 macro calls. - - -File: prog-modes.info, Node: awk-mode, Next: cl-indent, Prev: autoconf-mode, Up: Top - -5 Editing AWK Code -****************** - -This mode is used for editing Awk code. It is automatically invoked for -buffers visiting the following types of files: - - * any file ending with an extension of `.awk'. - - * any file that has an interpretor line (the "shebang" line) - specifying "awk". - - - The mode operates much like C mode except for the syntax of -comments. It uses the same keymap as C mode and has the same variables -for customizing indentation. It has its own abbrev table and its own -syntax table. - - Turning on AWK mode calls the value of the variable `awk-mode-hook' -with no arguments, if that value is non-nil. - - NOTE: This library is obsolete. Support for AWK is now available -directly via the cc-mode package. *Note AWK Mode: (cc-mode)AWK Mode., -for details. - -* Menu: - -* About Awk: about-awk. - - -File: prog-modes.info, Node: about-awk, Prev: awk-mode, Up: awk-mode - -5.1 About Awk -============= - -Awk is a text-processing programming language. It is a useful and -simple tool for manipulating text. - - -File: prog-modes.info, Node: cl-indent, Next: cvs, Prev: awk-mode, Up: Top - -6 Enhanced Lisp-Indent Mode -*************************** - -This package provides an extension to lisp-mode. It supplies a single -entry point, `common-lisp-indent-function', which performs indentation -in the preferred style for Common Lisp code. To enable it add the -following to your `user-init-file': - - (setq lisp-indent-function 'common-lisp-indent-function) - - To configure this package, type: - - M-x customize-group RET lisp-indent RET - - -File: prog-modes.info, Node: cvs, Next: diff-mode, Prev: cl-indent, Up: Top - -7 Light CVS Support -******************* - -This package provides simple CVS support within the editing session. - - The package provides the following features: - - * Displays the CVS revision in the mode line. - - * Compares file changes between CVS revisions using `ediff'. - - * Keystrokes and menu entries to execute `cvs status', `cvs log' and - `cvsann'. - - * Simple interface to `cvs commit' and `cvs update' commands. - - * Status listing per directory. - - * `msb' support (better buffer selection). - - * `dired' support. - - * Softlink tree support. - - * Little module support (status and update). - - - To install this library, add the following to your `user-init-file': - - (require 'cvs) - - To configure this package please view the source code. This can be -done by typing `C-x 4 l cvs'. - - For related packages please see *Note PCL-CVS: (pcl-cvs)Top. and -*Note Version Control: (xemacs)Version Control. - -* Menu: - -* About CVS: about-cvs. - - -File: prog-modes.info, Node: about-cvs, Prev: cvs, Up: cvs - -7.1 About CVS -============= - -CVS is the Concurrent Versions System, an open-source -network-transparent version control system. More information on CVS -can be found at CVS Home (http://www.cvshome.org/). - - -File: prog-modes.info, Node: diff-mode, Next: eiffel, Prev: cvs, Up: Top - -8 Viewing and Editing Context Diffs -*********************************** - -This mode facilitates viewing and editing of context diffs. It is -automatically invoked buffers visiting any file ending with one of the -following extensions: `.diff', `.diffs', `.patch', `.rej'. - - The mode provides support for font-lock, outline, navigation -commands, editing and various conversions as well as jumping. - - The following key mappings are defined: - -`C-c' << Prefix Command >> -`M-A' diff-ediff-patch -`M-C' diff-unified->context -`M-K' diff-file-kill -`M-N' diff-file-next -`M-P' diff-file-prev -`M-R' diff-reverse-direction -`M-U' diff-context->unified -`M-W' widen -`M-k' diff-hunk-kill -`M-n' diff-hunk-next -`M-o' diff-goto-source -`M-p' diff-hunk-prev -`M-r' diff-restrict-view -`M-{' diff-file-prev -`M-}' diff-file-next -`M-delete' scroll-down -`M-return' diff-goto-source -`M-space' scroll-up -`M-C-m' diff-goto-source -`C-c C-a' diff-apply-hunk -`C-c C-c' diff-goto-source -`C-c C-s' diff-split-hunk -`C-c C-t' diff-test-hunk - - To configure this package, type: - - M-x customize-group RET diff-mode RET - - -File: prog-modes.info, Node: eiffel, Next: icon, Prev: diff-mode, Up: Top - -9 Editing Eiffel Code -********************* - -This mode is used for editing Eiffel code. It is automatically invoked -for buffers visiting any file ending in an extension of `.e'. - - The following key mappings are defined: - -`return' reindent-then-newline-and-indent -`C-c' << Prefix Command >> -`C-j' newline-and-indent -`C-x' << Prefix Command >> -`M-'' eif-feature-quote -`M-q' eif-fill-paragraph -`M-C-a' eif-beginning-of-feature -`M-C-e' eif-end-of-feature -`M-C-q' eif-indent-construct -`C-c C-c' eif-compile -`C-c C-o' eif-set-compile-options -`C-c C-r' eif-run -`C-c C-s' eif-short -`C-x n' << Prefix Command >> -`C-x n d' eif-narrow-to-feature - - To configure this package, type: - - M-x customize-group RET eiffel RET - -* Menu: - -* About Eiffel: about-eiffel. - - -File: prog-modes.info, Node: about-eiffel, Prev: eiffel, Up: eiffel - -9.1 About Eiffel -================ - -The Eiffel programming language was created by Bertrand Meyer and -developed by his company, Interactive Software Engineering (ISE) of -Goleta, CA in 1985. More information on Eiffel can be found at the -Eiffel Web Site -(http://www.engin.umd.umich.edu/CIS/course.des/cis400/eiffel/eiffel.html). - - -File: prog-modes.info, Node: icon, Next: javascript-mode, Prev: eiffel, Up: Top - -10 Editing Icon Code -******************** - -This mode is used for editing Icon code. It is automatically invoked -for buffers visiting any file ending in an extension of `.icn'. - - The mode provides the following features: - - * Expression and list commands understand all Icon brackets. - - * Tab indents for Icon code. - - * Paragraphs are separated by blank lines only. - - * Delete converts tabs to spaces as it moves back. - - The following key mappings are defined: - -`{' electric-icon-brace -`}' electric-icon-brace -`delete' backward-delete-char-untabify -`menu-bar' << Prefix command "Icon" >> -`M-backspace' mark-icon-function -`M-C-a' beginning-of-icon-defun -`M-C-e' end-of-icon-defun -`M-C-h' mark-icon-function -`M-C-q' indent-icon-exp - - The variables controlling indentation style are: - -`icon-tab-always-indent' - Non-nil means TAB in Icon mode should always reindent the current - line, regardless of where in the line point is when the TAB - command is used. - -`icon-auto-newline' - Non-nil means automatically newline before and after braces - inserted in Icon code. - -`icon-indent-level' - Indentation of Icon statements within surrounding block. The - surrounding block's indentation is the indentation of the line on - which the open-brace appears. - -`icon-continued-statement-offset' - Extra indentation given to a substatement, such as the then-clause - of an if or body of a while. - -`icon-continued-brace-offset' - Extra indentation given to a brace that starts a substatement. - This is in addition to `icon-continued-statement-offset'. - -`icon-brace-offset' - Extra indentation for line if it starts with an open brace. - -`icon-brace-imaginary-offset' - An open brace following other text is treated as if it were this - far to the right of the start of its line. - - - Turning on Icon mode calls the value of the variable `icon-mode-hook' -with no args, if that value is non-nil. - - To configure this package, type: - - M-x customize-group RET icon RET - -* Menu: - -* About Icon: about-icon. - - -File: prog-modes.info, Node: about-icon, Prev: icon, Up: icon - -10.1 About Icon -=============== - -Icon is a high-level, general-purpose programming language with a large -repertoire of features for processing data structures and character -strings. Icon is an imperative, procedural language with a syntax -reminiscent of C and Pascal, but with semantics at a much higher level. -More information on Icon can be found at The Icon Programming Language -(http://www.cs.arizona.edu/icon/). - - -File: prog-modes.info, Node: javascript-mode, Next: ksh-mode, Prev: icon, Up: Top - -11 Editing JavaScript Code -************************** - -This mode is used for editing JavaScript code. It is automatically -invoked for buffers visiting any file ending in an extension of `.js' or -`.pac'. - - See the documentation for `c++-mode': JavaScript mode is an -extension of it (*note CC Mode: (cc-mode)Top.). Use the hook -`javascript-mode-hook' to execute custom code when entering JavaScript -mode. - - The following key mappings are defined: - -`#' c-electric-pound -`(, )' c-electric-paren -`*' c-electric-star -`,' c-electric-semi&comma -`/' c-electric-slash -`:' c-electric-colon -`;' c-electric-semi&comma -`<' c-electric-lt-gt -`>' c-electric-lt-gt -`{' c-electric-brace -`}' c-electric-brace -`backspace' c-electric-backspace -`delete' c-electric-delete -`return' c-context-line-break -`tab' c-indent-command -`C-c' << Prefix Command >> -`C-i' c-indent-command -`C-m' c-context-line-break -`C-x' << Prefix Command >> -`M-a' c-beginning-of-statement -`M-c' c-comment-edit-at-point -`M-e' c-end-of-statement -`M-j' c-indent-new-comment-line -`M-q' c-fill-paragraph -`M-backspace' backward-kill-word -`M-backward' backward-kill-word -`M-delete' backward-kill-word -`M-linefeed' c-indent-new-comment-line -`M-C-h' backward-kill-word -`M-C-j' c-indent-new-comment-line -`M-C-q' c-indent-exp -`M-C-kp-left' c-beginning-of-statement -`M-C-kp-right' c-end-of-statement -`M-C-left' c-beginning-of-statement -`M-C-right' c-end-of-statement -`C-c .' c-set-style -`C-c C-\' c-backslash-region -`C-c C-a' c-toggle-auto-state -`C-c C-b' c-submit-bug-report -`C-c C-c' comment-region -`C-c C-d' c-toggle-hungry-state -`C-c C-n' c-forward-conditional -`C-c C-o' c-set-offset -`C-c C-p' c-backward-conditional -`C-c C-q' c-indent-defun -`C-c C-s' c-show-syntactic-information -`C-c C-t' c-toggle-auto-hungry-state -`C-c C-u' c-up-conditional -`C-x f' c-fill-paragraph - - To configure this package, type: - - M-x customize-group RET javascript RET - -* Menu: - -* About JavaScript: about-javascript. - - -File: prog-modes.info, Node: about-javascript, Prev: javascript-mode, Up: javascript-mode - -11.1 About JavaScript -===================== - -JavaScript is a compact, object-based scripting language for developing -client and server Internet applications. - - -File: prog-modes.info, Node: ksh-mode, Next: lua-mode, Prev: javascript-mode, Up: Top - -12 Editing Shell Script (sh, ksh, bash) Code -******************************************** - -This mode is used for editing shell scripts written for the Bourne -(sh), Korn (ksh) or Bourne Again (bash) shells. It is NOT -automatically invoked for any particular file extension. To invoke -this mode while editing a file, type `M-x ksh-mode'. - - The following key mappings are defined: - -`linefeed' reindent-then-newline-and-indent -`tab' ksh-indent-line -`C-c' << Prefix Command >> -`C-i' ksh-indent-line -`C-j' reindent-then-newline-and-indent -`M-tab' ksh-complete-symbol -`M-C-i' ksh-complete-symbol -`C-c tab' ksh-completion-init-and-pickup -`C-c C-i' ksh-completion-init-and-pickup - - The variables controlling indentation style are: - -`ksh-indent' - Indentation of ksh statements with respect to containing block. - Default value is 2. - -`ksh-case-indent' - Additional indentation for statements under case items. Default - value is nil which will align the statements one position past the - ")" of the pattern. - -`ksh-case-item-offset' - Additional indentation for case items within a case statement. - Default value is 2. - -`ksh-group-offset' - Additional indentation for keywords "do" and "then". Default - value is -2. - -`ksh-brace-offset' - Additional indentation of "{" under functions or brace groupings. - Default value is 0. - -`ksh-multiline-offset' - Additional indentation of line that is preceded of a line ending - with a `\' to make it continue on next line. - -`ksh-tab-always-indent' - Controls the operation of the `TAB' key. If t (the default), always - reindent the current line. If nil, indent the current line only if - point is at the left margin or in the line's indentation; otherwise - insert a tab. - -`ksh-match-and-tell' - If non-nil echo in the minibuffer the matching compound command - for the "done", "}", "fi", or "esac". Default value is t. - -`ksh-align-to-keyword' - Controls whether nested constructs align from the keyword or the - current indentation. If non-nil, indentation will be relative to - the column the keyword starts. If nil, indentation will be - relative to the current indentation of the line the keyword is on. - The default value is non-nil. - -`ksh-comment-regexp' - Regular expression used to recognize comments. Customize to support - ksh-like languages. Default value is "\s *#". - - - An example of how to set up this mode is as follows: - - (setq ksh-mode-hook - (function (lambda () - (font-lock-mode 1) ;; font-lock the buffer - (setq ksh-indent 8) - (setq ksh-group-offset -8) - (setq ksh-brace-offset -8) - (setq ksh-tab-always-indent t) - (setq ksh-match-and-tell t) - (setq ksh-align-to-keyword t) ;; Turn on keyword alignment - ))) - - To configure this package please view the source code. This can be -done by typing `C-x 4 l ksh-mode'. - - For a related package, see `sh-script'. - - -File: prog-modes.info, Node: lua-mode, Next: m4-mode, Prev: ksh-mode, Up: Top - -13 Editing Lua Code -******************* - -This mode is used for editing Lua code. It is automatically invoked for -buffers visiting any file ending in the extension `.lua'. - - To configure this mode, type: - - M-x customize-group RET lua RET - -* Menu: - -* About Lua: about-lua. - - -File: prog-modes.info, Node: about-lua, Prev: lua-mode, Up: lua-mode - -13.1 About Lua -============== - -Lua is a powerful light-weight programming language designed for -extending applications. Lua is also frequently used as a -general-purpose, stand-alone language. More information on Lua can be -found at The Programming Language Lua (http://www.lua.org/). - - -File: prog-modes.info, Node: m4-mode, Next: make-mode, Prev: lua-mode, Up: Top - -14 Editing m4 Code -****************** - -This mode is used for editing m4 macro definitions. It is NOT -automatically invoked for any particular file extension. To invoke -this mode while editing a file, type `M-x m4-mode'. - - The mode has most of the syntax right (i.e., sexp motion commands -work, but function motion commands don't). It also sets up font-lock -for colorization. - - To configure this package please view the source code. This can be -done by typing `C-x 4 l m4-mode'. - - NOTE: The preferred package for editing m4 code is autoconf mode. -*Note autoconf-mode::., for details. - -* Menu: - -* About m4: about-m4. - - -File: prog-modes.info, Node: about-m4, Prev: m4-mode, Up: m4-mode - -14.1 About m4 -============= - -m4 is a general purpose macro processor that can be used to preprocess -C and assembly language programs, among other things. Besides the -straightforward replacement of one string of text by another, m4 lets -you perform: - - * integer arithmetic - - * file inclusion - - * conditional macro expansion - - * string and substring manipulation - - - -File: prog-modes.info, Node: make-mode, Next: mode-compile, Prev: m4-mode, Up: Top - -15 Editing Makefiles -******************** - -This mode is used for editing Makefiles. It is automatically invoked -for for buffers visiting the following types of files: - - * any file ending with an extension of `.ma?ke?' or `.am' - - * any file named `GNU[Mm]akefile' or `[Mm]akefile' with an extension - of `.in'. - - * any file that has an interpretor line (the "shebang" line) - specifying "make". - - - The mode knows about Makefile syntax and defines `M-n' and `M-p' to -move to next and previous productions. - - The keys `$', `=', `:' and `.' are electric; they try to help you -fill in a macro reference, macro definition, ordinary target name, or -special target name, respectively. Such names are completed using a -list of targets and macro names parsed out of the makefile. This list -is automatically updated, if necessary, whenever you invoke one of these -commands. You can force it to be updated with `C-c C-p'. - - The command `C-c C-f' adds certain filenames in the current -directory as targets. You can filter out filenames by setting the -variable `makefile-ignored-files-in-pickup-regex'. - - The command `C-c C-u' grinds for a bit, then pops up a report buffer -showing which target names are up-to-date with respect to their -prerequisites, which targets are out-of-date, and which have no -prerequisites. - - The command `C-c C-b' pops up a browser window listing all target and -macro names. You can mark or unmark items wit `C-c SPC', and insert all -marked items back in the Makefile with `C-c TAB'. - - The command `C-c TAB' in the makefile buffer inserts a GNU make -builtin. You will be prompted for the builtin's args. - - The following key mappings are defined: - -`C-c' << Prefix Command >> -`M-n' makefile-next-dependency -`M-p' makefile-previous-dependency -`M-tab' makefile-complete -`M-C-i' makefile-complete -`C-c :' makefile-insert-target-ref -`C-c tab' makefile-insert-gmake-function -`C-c C-\' makefile-backslash-region -`C-c C-b' makefile-switch-to-browser -`C-c C-c' comment-region -`C-c C-f' makefile-pickup-filenames-as-targets -`C-c C-i' makefile-insert-gmake-function -`C-c C-p' makefile-pickup-everything -`C-c C-u' makefile-create-up-to-date-overview - - In the browser, use the following keys: - -`I' makefile-browser-insert-selection-and-quit -`i' makefile-browser-insert-selection -`n' makefile-browser-next-line -`p' makefile-browser-previous-line -`q' makefile-browser-quit -`space' makefile-browser-toggle -`C-c' << Prefix Command >> -`C-n' makefile-browser-next-line -`C-p' makefile-browser-previous-line -`C-c return' makefile-browser-insert-continuation -`C-c C-m' makefile-browser-insert-continuation - - Makefile mode can be configured by modifying the following variables: - -`makefile-browser-buffer-name:' - Name of the macro- and target browser buffer. - -`makefile-target-colon:' - The string that gets appended to all target names inserted by - `makefile-insert-target'. ":" or "::" are quite common values. - -`makefile-macro-assign:' - The string that gets appended to all macro names inserted by - `makefile-insert-macro'. The normal value should be " = ", since - this is what standard make expects. However, newer makes such as - dmake allow a larger variety of different macro assignments, so you - might prefer to use " += " or " := " . - -`makefile-tab-after-target-colon:' - If you want a `TAB' (instead of a space) to be appended after the - target colon, then set this to a non-nil value. - -`makefile-browser-leftmost-column:' - Number of blanks to the left of the browser selection mark. - -`makefile-browser-cursor-column:' - Column in which the cursor is positioned when it moves up or down - in the browser. - -`makefile-browser-selected-mark:' - String used to mark selected entries in the browser. - -`makefile-browser-unselected-mark:' - String used to mark unselected entries in the browser. - -`makefile-browser-auto-advance-after-selection-p:' - If this variable is set to a non-nil value the cursor will - automagically advance to the next line after an item has been - selected in the browser. - -`makefile-pickup-everything-picks-up-filenames-p:' - If this variable is set to a non-nil value then - `makefile-pickup-everything' also picks up filenames as targets - (i.e. it calls `makefile-pickup-filenames-as-targets'), otherwise - filenames are omitted. - -`makefile-cleanup-continuations-p:' - If this variable is set to a non-nil value then Makefile mode will - assure that no line in the file ends with a backslash (the - continuation character) followed by any whitespace. This is done - by silently removing the trailing whitespace, leaving the - backslash itself intact. IMPORTANT: Please note that enabling - this option causes Makefile mode to MODIFY A FILE WITHOUT YOUR - CONFIRMATION when "it seems necessary". - -`makefile-browser-hook:' - A function or list of functions to be called just before the - browser is entered. This is executed in the makefile buffer. - -`makefile-special-targets-list:' - List of special targets. You will be offered to complete on one of - those in the minibuffer whenever you enter a `.'. at the - beginning of a line in Makefile mode. - - - To configure this package, type: - - M-x customize-group RET makefile RET - -* Menu: - -* About Make: about-make. - - -File: prog-modes.info, Node: about-make, Prev: make-mode, Up: make-mode - -15.1 About Make -=============== - -A Makefile is used by a `make' utility to automatically determine which -pieces of a large program need to be recompiled, and to issue the -commands to recompile them. *Note Make: (make)Top., for details. - - -File: prog-modes.info, Node: mode-compile, Next: modula2, Prev: make-mode, Up: Top - -16 Compiling Files According to Major-Mode -****************************************** - -The `compile' command is very rudimentary in its creation of its -compilation command, using "make -k" by default. This package provides -an intelligent replacement for the `compile' command. *Note -Compilation: (xemacs)Compilation., for details. - - The `mode-compile' command functions as a layer above `compile'. -Its purpose is mainly to build a smarter compile command for `compile' -to execute. This compile command is built according to number of -parameters: - - * the major-mode - - * presence or absence of a makefile in the current directory - - * the `buffer-file-name' and extension - - * contents of the current buffer (`main' function, "#!/path/shell", - ...) - - * and more ... (see below) - - - Most of these parameters are highly customizable through Emacs Lisp -variables (to be set in your `user-init-file' or through the -Customization menu). Running `mode-compile' after a universal-argument -(`C-u') allows remote compilations; the user is prompted for the host -name to execute the compilation command. The `mode-compile-kill' -function terminates a running compilation session launched by -`mode-compile'. - - By default, `mode-compile' is very verbose and waits a user-specified -number of seconds after displaying each message to give the user time -to read it. The variables `mode-compile-expert-p' and -`mode-compile-reading-time' can be used to change this behaviour. On -Windows-based systems, the variable `mode-compile-other-frame-p' will -create a new frame and launch the compilation command in it. - -* Menu: - -* compile-cust:: Customization -* compile-compilation-mode:: compilation-mode -* compile-makefile-mode:: makefile-mode -* compile-emacs-lisp-mode:: emacs-lisp-mode, lisp-interaction-mode -* compile-dired-mode:: dired-mode -* compile-sh-mode:: sh-mode, csh-mode, zsh-mode -* compile-c?perl-mode:: c?perl-mode -* compile-tcl-mode:: tcl-mode -* compile-c-mode:: c-mode, c++-mode -* compile-ada-mode:: ada-mode -* compile-fortran-mode:: fortran-mode -* compile-java-mode:: java-mode -* compile-python-mode:: python-mode -* compile-message-mode:: message-mode -* compile-catchall:: Miscellaneous Modes - - -File: prog-modes.info, Node: compile-cust, Next: compile-compilation-mode, Prev: mode-compile, Up: mode-compile - -16.1 Customization -================== - -This section explains how the `compile-command' is built according to -the `major-mode' and how to customize it. The major modes currently -supported are: - -ada-mode c++-mode c-mode -c?perl-mode compilation-mode csh-mode -dired-mode emacs-lisp-mode fortran-mode -fundamental-mode indented-text-mode java-mode -lisp-interaction-mode makefile-mode python-mode -sh-mode tcl-mode text-mode -zsh-mode - - For other modes a default behaviour is provided. - - When running `mode-compile' or `mode-compile-kill' the hooks -`mode-compile-(before|after)-(compile|kill)-hook' are executed. The -current buffer can be automatically saved if -`mode-compile-always-save-buffer-p' is set to `t'. All the modified -buffers can be automatically saved if `mode-compile-save-all-p' is set -to `t'. - - To configure this package, type: - - M-x customize-group RET compilation RET - - -File: prog-modes.info, Node: compile-compilation-mode, Next: compile-makefile-mode, Prev: compile-cust, Up: mode-compile - -16.2 compilation-mode -===================== - -Calls `compile' with the last compile command. - - -File: prog-modes.info, Node: compile-makefile-mode, Next: compile-emacs-lisp-mode, Prev: compile-compilation-mode, Up: mode-compile - -16.3 makefile-mode -================== - -The makefile is run with make through `compile' (user is prompted for -the rule to run, see variable `mode-compile-preferred-default-makerule' -to see how a default choice could be selected). - - -File: prog-modes.info, Node: compile-emacs-lisp-mode, Next: compile-dired-mode, Prev: compile-makefile-mode, Up: mode-compile - -16.4 emacs-lisp-mode, lisp-interaction-mode -=========================================== - -If the buffer is a `.el' file we `byte-compile' it to produce a `.elc' -file. Otherwise, just `byte-compile' the buffer (this does not use -`compile' but `byte-compile'). - - -File: prog-modes.info, Node: compile-dired-mode, Next: compile-sh-mode, Prev: compile-emacs-lisp-mode, Up: mode-compile - -16.5 dired-mode -=============== - -Find a `makefile' in the directory and run make with it (like in -`makefile-mode'), else try to `byte-recompile' all `.el' files older -than their associated `.elc' files (unlike `byte-recompile-directory' -this is not recursive), finally if no `.el' files are present ask -compilation command to user by calling `default-compile'. To find a -`makefile' a regexp is provided which name is -`mode-compile-makefile-regexp'. - - -File: prog-modes.info, Node: compile-sh-mode, Next: compile-c?perl-mode, Prev: compile-dired-mode, Up: mode-compile - -16.6 sh-mode, csh-mode, zsh-mode -================================ - -Run "[cz]?sh" with debugging arguments as specified in -`[cz]?sh-dbg-flags' on the currently edited file. - - -File: prog-modes.info, Node: compile-c?perl-mode, Next: compile-tcl-mode, Prev: compile-sh-mode, Up: mode-compile - -16.7 c?perl-mode -================ - -Run file with "perl -w" (can step through errors with compile's -`next-error' command). - - -File: prog-modes.info, Node: compile-tcl-mode, Next: compile-c-mode, Prev: compile-c?perl-mode, Up: mode-compile - -16.8 tcl-mode -============= - -Run file with "wish" (can step through errors with compile's -`next-error' command). - - -File: prog-modes.info, Node: compile-c-mode, Next: compile-ada-mode, Prev: compile-tcl-mode, Up: mode-compile - -16.9 c-mode, c++-mode -===================== - -First it tries to see if there is a `makefile' in the directory. -Makefiles to look for are specified by the variable -`mode-compile-makefile-regexp'. If yes two cases could happen: there is -only one makefile so use it, or there is more than one (sometimes when -you need to write portable soft you could have some makefiles by system: -SunOs.make, HP.make ...), in that case prompt to user for choice (with -smart completion). Once the makefile has been selected it extract the -rules from it and ask to user to choose a rule to make (with smart -completion, see variable `mode-compile-preferred-default-makerule' to -see how a default choice could be selected). - - There are some cases where no makefiles are present (YES I KNOW this -is bad practice but you sometimes have no need to write a Makefile). In -that case the function tries to build the most intelligent compilation -command by using the favourite user C/C++ compiler: value of -environment variable "CC" or "CXX" or first found, in the PATH, of -compilers specified in variable `cc-compilers-list' or -`c++-compilers-list'. Then it looks for the environment variable -"CFLAGS" of "CXXFLAGS" to append to the compiler command, finds the -file to compile: .(c|cc|C|cpp) (see *) -and asks for confirmation. If you really trust mode-compile will build -the correct command and want to bypass confirmation you could set the -variable `mode-compile-never-edit-command-p' to `t'. - - -File: prog-modes.info, Node: compile-ada-mode, Next: compile-fortran-mode, Prev: compile-c-mode, Up: mode-compile - -16.10 ada-mode -============== - -Same as c/c++-mode but run Ada compiler on the Ada file. There are no -companion file and no way to find a main function in Ada. - - -File: prog-modes.info, Node: compile-fortran-mode, Next: compile-java-mode, Prev: compile-ada-mode, Up: mode-compile - -16.11 fortran-mode -================== - -Same as c-mode but run Fortran compiler on .[Ff](or)? files. - - -File: prog-modes.info, Node: compile-java-mode, Next: compile-python-mode, Prev: compile-fortran-mode, Up: mode-compile - -16.12 java-mode -=============== - -Same as c-mode but call "javac" without the -o option on .java files - - -File: prog-modes.info, Node: compile-python-mode, Next: compile-message-mode, Prev: compile-java-mode, Up: mode-compile - -16.13 python-mode -================= - -Run file with "python" (can step through errors with compile's -`next-error' command). - - -File: prog-modes.info, Node: compile-message-mode, Next: compile-catchall, Prev: compile-python-mode, Up: mode-compile - -16.14 message-mode -================== - -Run `message-send'. - - -File: prog-modes.info, Node: compile-catchall, Prev: compile-message-mode, Up: mode-compile - -16.15 Miscellaneous Modes -========================= - -This handles `fundamental-mode', `text-mode', `indented-text-mode' and -any unknown modes. - - Try to guess what the file is by - - * Looking at its name and extension (see variable - `mode-compile-filename-regexp-alist'). - - * Looking at string "#!/path/shell" at first line to extract shell - to run the script with (see variable `mode-compile-shell-alist'). - - * Looking at a makefile in current directory. - - * Calling `compile' with the last compile command which is asked to - be edited by user - - - The `kill-compile' command is then bound dynamically (buffer-local). - - -File: prog-modes.info, Node: modula2, Next: old-c-mode, Prev: mode-compile, Up: Top - -17 Editing Modula-2 Code -************************ - -This mode is used for editing Modula-2 code. It is NOT automatically -invoked for any particular file extension. To invoke this mode while -editing a file, type `M-x modula-2-mode'. - - The mode provides convenient abbrevs for Modula-2 keywords, knows -about the standard layout rules, and supports a native compile command. - - All control constructs of Modula-2 can be reached by typing C-c -followed by the first character of the construct. - - The following key mappings are defined: - -C-c b begin C-c c case -C-c d definition C-c e else -C-c f for C-c h header -C-c i if C-c m module -C-c l loop C-c o or -C-c p procedure Control-c Control-w with -C-c r record C-c s stdio -C-c t type C-c u until -C-c v var C-c w while -C-c x export C-c y import -C-c { begin-comment C-c } end-comment -C-c C-z suspend Emacs C-c C-t toggle -C-c C-c compile M-x m2-next-error - next-error -C-c C-l link - - Following are some important variables: - -`m2-indent' - controls the number of spaces for each indentation. - -`m2-compile-command' - holds the command to compile a Modula-2 program. - -`m2-link-command' - holds the command to link a Modula-2 program. - - To configure this package, type: - - M-x customize-group RET modula2 RET - -* Menu: - -* About Modula-2: about-modula2. - - -File: prog-modes.info, Node: about-modula2, Prev: modula2, Up: modula2 - -17.1 About Modula-2 -=================== - -Modula-2 is a programming language developed by Niklaus Wirth at ETH in -Zurich, Switzerland in the late 70's. Wirth also developed Algol-W, -Pascal, Modula, and Oberon. - - Modula-2 corrects some of the deficiencies of Pascal. It is suitable -for learning programming, for large projects written and maintained in -the fashion of professional software engineers, and for real time -embedded systems. Modula-2 is small, expressive, easy to learn and to -read. - - -File: prog-modes.info, Node: old-c-mode, Next: p4, Prev: modula2, Up: Top - -18 Editing C Code -***************** - -This is a smart editing mode for C code. It knows a lot about C syntax -and tries to position the cursor according to C layout conventions. -You can change the details of the layout style with option variables. - - The mode provides the following features: - - * Expression and list commands understand all C brackets. - - * Tab indents for C code. - - * Comments are delimited with /* ... */. - - * Paragraphs are separated by blank lines only. - - * Delete converts tabs to spaces as it moves back. - - The variables controlling indentation style are: - -`c-tab-always-indent' - Non-nil means TAB in C mode should always reindent the current - line, regardless of where in the line point is when the TAB - command is used. - -`c-auto-newline' - Non-nil means automatically newline before and after braces, and - after colons and semicolons, inserted in C code. - -`c-indent-level' - Indentation of C statements within surrounding block. The - surrounding block's indentation is the indentation of the line on - which the open-brace appears. - -`c-continued-statement-offset' - Extra indentation given to a substatement, such as the then-clause - of an if or body of a while. - -`c-continued-brace-offset' - Extra indentation given to a brace that starts a substatement. - This is in addition to c-continued-statement-offset. - -`c-brace-offset' - Extra indentation for line if it starts with an open brace. - -`c-brace-imaginary-offset' - An open brace following other text is treated as if it were this - far to the right of the start of its line. - -`c-argdecl-indent' - Indentation level of declarations of C function arguments. - -`c-label-offset' - Extra indentation for line that is a label, or case or default. - - - NOTE: This package has been obsoleted by the cc-mode package (*note -CC Mode: (cc-mode)Top.). cc-mode can be quite slow, however, on large -files, even on fast machines. This version works with no problems on -the XEmacs source code and is very very fast. - - To configure this package, type: - - M-x customize-group RET old-c RET - - -File: prog-modes.info, Node: p4, Next: pascal, Prev: old-c-mode, Up: Top - -19 Integration with Perforce Version Control -******************************************** - -This package provides simple integration with Perforce Version Control. - - To use this package, add the following line to your `user-init-file': - - (load-library "p4") - - To configure this package, type: - - M-x customize-group RET p4 RET - -* Menu: - -* About Perforce: about-perforce. - - -File: prog-modes.info, Node: about-perforce, Prev: p4, Up: p4 - -19.1 About Perforce -=================== - -The Perforce SCM System features comprehensive software configuration -management capabilities built around a scalable client/server -architecture. Requiring only TCP/IP, developers can access the Perforce -Server through a variety of Perforce clients (Windows GUI, Web, or -Command-Line). Perforce can be deployed quickly and easily, and requires -minimal administration1, even for large or distributed sites. - - More information on Perforce can be found at -`http://www.perforce.com/'. - - -File: prog-modes.info, Node: pascal, Next: php-mode, Prev: p4, Up: Top - -20 Editing Pascal Code -********************** - -This mode is used for editing Pascal code. It is automatically invoked -for buffers visiting any file ending with an extension of `.pas'. - - The mode provides the following capabilities: - - * TAB indents for Pascal code. - - * Delete converts tabs to spaces as it moves back. - - * `pascal-complete-word' completes the word around current point - with respect \ to position in code - - * `pascal-show-completions' shows all possible completions at this - point. - - Other useful functions are: - -`pascal-mark-defun' - Mark function. - -`pascal-insert-block' - insert begin ... end; - -`pascal-star-comment' - insert (* ... *) - -`pascal-comment-area' - Put marked area in a comment, fixing nested comments. - -`pascal-uncomment-area' - Uncomment an area commented with `pascal-comment-area'. - -`pascal-beg-of-defun' - Move to beginning of current function. - -`pascal-end-of-defun' - Move to end of current function. - -`pascal-goto-defun' - Goto function prompted for in the minibuffer. - -`pascal-outline' - Enter pascal-outline-mode (see also pascal-outline). - - - The variables controlling indentation/edit style are: - -`pascal-indent-level' - Indentation of Pascal statements with respect to containing block. - -`pascal-case-indent' - Indentation for case statements. - -`pascal-auto-newline' - Non-nil means automatically newline after semicolons and the - punctuation mark after an end. - -`pascal-tab-always-indent' - Non-nil means TAB in Pascal mode should always reindent the - current line, regardless of where in the line point is when the - TAB command is used. - -`pascal-auto-endcomments' - Non-nil means a comment { ... } is set after the ends which ends - cases and functions. The name of the function or case will be set - between the braces. - -`pascal-auto-lineup' - List of contexts where auto lineup of :'s or ='s should be done. - - - See also the user variables `pascal-type-keywords', -`pascal-start-keywords' and `pascal-separator-keywords'. - - Turning on Pascal mode calls the value of the variable -`pascal-mode-hook' with no args, if that value is non-nil. - - To configure this package, type: - - M-x customize-group RET pascal RET - - -File: prog-modes.info, Node: php-mode, Next: postscript, Prev: pascal, Up: Top - -21 Editing PHP Code -******************* - -PHP mode is a major mode for editing PHP source code. It is -automatically invoked for buffers visiting the following files of files: - - * any file ending with one of the following extensions: `.phps', - `.php3', `.php4' - - * any file ending with the extension `.phtml' - - * any file ending with the extension `.inc' - - The mode is an extension of cc-mode; thus it inherits all cc-mode's -navigation functionality (*note CC Mode: (cc-mode)Top.). But it colors -according to the PHP grammar and indents according to the PEAR coding -guidelines. It also includes a couple of handy IDE-type features such -as documentation search and a source and class browser. - - For colorization, turn on `global-font-lock' or add the following to -your `user-init-file': - - (add-hook 'php-mode-user-hook 'turn-on-font-lock) - - To use abbrev-mode, add lines like this to your `user-init-file': - - (add-hook 'php-mode-user-hook - '(lambda () (define-abbrev php-mode-abbrev-table "ex" "extends"))) - - To make php-mode compatible with html-mode, see -`http://php-mode.sourceforge.net/'. - - To configure this package, type: - - M-x customize-group RET php RET - -* Menu: - -* About PHP: about-php. - - -File: prog-modes.info, Node: about-php, Prev: php-mode, Up: php-mode - -21.1 About PHP -============== - -PHP is a widely-used general-purpose scripting language that is -especially suited for Web development and can be embedded into HTML. -For more information, see `http://www.php.net/'. - - -File: prog-modes.info, Node: postscript, Next: prolog, Prev: php-mode, Up: Top - -22 Editing PostScript Programs -****************************** - -This mode is used for editing PostScript programs. It is automatically -invoked for buffers visiting any file ending with an extension of `.cps' -or `.ps'. - - `C-c C-c' will send the contents of the buffer to the NeWS server -using psh(1). `C-c |' sends the current region. `C-c !' starts an -interactive psh(1) window which will be used for subsequent `C-c C-c' or -`C-c |' commands. - - In this mode, `TAB' and `M-C-\' attempt to indent code based on the -position of {}, [], and begin/end pairs. The variable -`ps-indent-level' controls the amount of indentation used inside arrays -and begin/end pairs. - - The following key mappings are defined: - -`tab' ps-tab -`C-c' << Prefix Command >> -`C-i' ps-tab -`C-c !' ps-shell -`C-c |' ps-execute-region -`C-c C-c' ps-execute-buffer - - `M-x postscript-mode' calls the value of the variable -`postscript-mode-hook' with no args, if that value is non-nil. - - To configure this package please view the source code. This can be -done by typing `C-x 4 l postscript'. - -* Menu: - -* About PostScript: about-postscript. - - -File: prog-modes.info, Node: about-postscript, Prev: postscript, Up: postscript - -22.1 About PostScript -===================== - -PostScript is a programming language optimized for printing graphics -and text (whether on paper, film, or CRT is immaterial). In the jargon -of the day, it is a page description language. It was introduced by -Adobe in 1985 and first (to my knowledge) appeared in the Apple -LaserWriter. The main purpose of PostScript was to provide a convenient -language in which to describe images in a device independent manner. -This device independence means that the image is described without -reference to any specific device features (e.g. printer resolution) so -that the same description could be used on any PostScript printer (say, -a LaserWriter or a Linotron) without modification. - - -File: prog-modes.info, Node: prolog, Next: rexx-mode, Prev: postscript, Up: Top - -23 Editing and Running Prolog Code -********************************** - -This mode is used for editing Prolog code. It is automatically invoked -for buffers visiting any file ending with an of extension `.prolog'. - - The mode knows about Prolog syntax and comments, and can send -regions to an inferior Prolog interpreter process. - - Blank lines and `%%...' separate paragraphs. `%'s start comments. - - The following key mappings are defined: - -`tab' prolog-indent-line -`C-i' prolog-indent-line -`M-C-x' prolog-consult-region - - Entry to this mode calls the value of `prolog-mode-hook' if that -value is non-nil. - - To configure this package, type: - - M-x customize-group RET prolog RET - - -File: prog-modes.info, Node: rexx-mode, Next: rpm-spec-mode, Prev: prolog, Up: Top - -24 Editing REXX Code -******************** - -This mode is used for editing REXX code. It is automatically invoked -for buffers visiting the following types of files: - - * any file ending with an extension of `.rexx'. - - * any file that has an interpretor line (the "shebang" line) - specifying "rexx". - - The following key mappings are defined: - -`backspace' backward-delete-char-untabify -`return' rexx-indent-and-newline -`tab' rexx-indent-command -`C-c' << Prefix Command >> -`C-i' rexx-indent-command -`C-m' rexx-indent-and-newline -`C-c C-c' rexx-debug -`C-c C-p' rexx-find-matching-do - - The following variables control indentation style: - -`rexx-indent' - The basic indentation for do-blocks. - -`rexx-end-indent' - The relative offset of the \"end\" statement. 0 places it in the - same column as the statements of the block. Setting it to the same - value as rexx-indent places the \"end\" under the do-line. - -`rexx-cont-indent' - The indention for lines following \"then\", \"else\" and \",\" - (continued) lines. - -`rexx-tab-always-indent' - Non-nil means TAB in REXX mode should always reindent the current - line, regardless of where in the line the point is when the TAB - command is used. - - - If you have set `rexx-end-indent' to a nonzero value, you probably -want to remap `RETURN' to `rexx-indent-newline-indent'. It makes sure -that lines indents correctly when you press `RETURN'. - - An extensive abbreviation table consisting of all the keywords of -REXX are supplied. Expanded keywords are converted into upper case -making it easier to distinguish them. To use this feature the buffer -must be in `abbrev-mode'. (See example below.) - - Turning on REXX mode calls the value of the variable `rexx-mode-hook' -with no args, if that value is non-nil. - - For example: - - (setq rexx-mode-hook '(lambda () - (setq rexx-indent 4) - (setq rexx-end-indent 4) - (setq rexx-cont-indent 4) - (local-set-key \"\\C-m\" 'rexx-indent-newline-indent) - (abbrev-mode 1) - )) - - will make the END aligned with the DO/SELECT. It will indent blocks -and IF-statements four steps and make sure that the END jumps into the -correct position when RETURN is pressed. Finally it will use the -abbrev table to convert all REXX keywords into upper case. - - To configure this package, type: - - M-x customize-group RET rexx RET - -* Menu: - -* About REXX: about-rexx. - - -File: prog-modes.info, Node: about-rexx, Prev: rexx-mode, Up: rexx-mode - -24.1 About REXX -=============== - -REXX is a programming language designed by Michael Cowlishaw of IBM UK -Laboratories. Rexx is an acronym which stands for "Restructured -Extended Executor Language". In Mike's own words: "REXX is a -procedural language that allows programs and algorithms to be written -in a clear and structured way." - - -File: prog-modes.info, Node: rpm-spec-mode, Next: simula, Prev: rexx-mode, Up: Top - -25 Editing RPM Spec Files -************************* - -This mode is used for editing spec files for building RPM packages. It -is automatically invoked for buffers visiting any file ending with an -extension of `.spec?' or `.spec.in'. - - The mode much like C mode except for the syntax of comments. It -uses the same keymap as C mode and has the same variables for -customizing indentation. It has its own abbrev table and its own -syntax table. *Note CC Mode: (cc-mode)Top., for details. - - Turning on RPM spec mode calls the value of the variable -`rpm-spec-mode-hook' with no args, if that value is non-nil. - - To configure this package, type: - - M-x customize-group RET rpm-spec RET - -* Menu: - -* About RPM: about-rpm. - - -File: prog-modes.info, Node: about-rpm, Prev: rpm-spec-mode, Up: rpm-spec-mode - -25.1 About RPM -============== - -The RPM Package Manager (RPM) is a powerful command line driven package -management system capable of installing, uninstalling, verifying, -querying, and updating computer software packages. Each software -package consists of an archive of files along with information about -the package like its version, a description, and the like. There is -also a related API ("Application Program Interface"), permitting -advanced developers to bypass 'shelling out' to a command line, and to -manage such transactions from within a native coding language. - - For more information, see `http://www.rpm.org/'. - - -File: prog-modes.info, Node: simula, Next: sql, Prev: rpm-spec-mode, Up: Top - -26 Editing SIMULA 87 Code -************************* - -This mode is used for editing SIMULA code. It is NOT automatically -invoked for any particular file extension. To invoke this mode while -editing a file, type `M-x simula-mode'. - - The mode knows about Simula syntax and standard indentation -commands. It also provides convenient abbrevs for Simula keywords. - - The following key mappings are defined: - -`:' simula-electric-label -`tab' simula-indent-command -`C-c' << Prefix Command >> -`C-i' simula-indent-command -`C-c C-d' simula-forward-down-level -`C-c C-n' simula-next-statement -`C-c C-p' simula-previous-statement -`C-c C-u' simula-backward-up-level - - The following variables controlling indentation style: - -`simula-tab-always-indent' - Non-nil means TAB in SIMULA mode should always reindent the - current line, regardless of where in the line point is when the - TAB command is used. - -`simula-indent-level' - Indentation of SIMULA statements with respect to containing block. - -`simula-substatement-offset' - Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE. - -`simula-continued-statement-offset' - Extra indentation for lines not starting a statement or - substatement, e.g. a nested FOR-loop. If value is a list, each - line in a multiple- line continued statement will have the car of - the list extra indentation with respect to the previous line of - the statement. - -`simula-label-offset -4711' - Offset of SIMULA label lines relative to usual indentation. - -`simula-if-indent '(0 . 0)' - Extra indentation of THEN and ELSE with respect to the starting IF. - Value is a cons cell, the car is extra THEN indentation and the cdr - extra ELSE indentation. IF after ELSE is indented as the starting - IF. - -`simula-inspect-indent '(0 . 0)' - Extra indentation of WHEN and OTHERWISE with respect to the - corresponding INSPECT. Value is a cons cell, the car is extra - WHEN indentation and the cdr extra OTHERWISE indentation. - -`simula-electric-indent nil' - If this variable is non-nil, `simula-indent-line' will check the - previous line to see if it has to be reindented. - -`simula-abbrev-keyword 'upcase' - Determine how SIMULA keywords will be expanded. Value is one of - the symbols `upcase', `downcase', `capitalize', (as in) - `abbrev-table', or nil if they should not be changed. - -`simula-abbrev-stdproc 'abbrev-table' - Determine how standard SIMULA procedure and class names will be - expanded. Value is one of the symbols `upcase', `downcase', - `capitalize', (as in) `abbrev-table', or nil if they should not be - changed. - - - Turning on SIMULA mode calls the value of the variable -`simula-mode-hook' with no arguments, if that value is non-nil. - - Warning: `simula-mode-hook' should not read in an abbrev file without -calling the function `simula-install-standard-abbrevs' afterwards, -preferably not at all. - - To configure this package, type: - - M-x customize-group RET simula RET - -* Menu: - -* About SIMULA: about-simula. - - -File: prog-modes.info, Node: about-simula, Prev: simula, Up: simula - -26.1 About SIMULA -================= - -The SIMULA programming language was designed and built by Ole-Johan -Dahl and Kristen Nygaard at the Norwegian Computing Center (NCC) in -Oslo between 1962 and 1967. It was originally designed and implemented -as a language for discrete event simulation, but was later extended and -reimplemented as a full scale general purpose programming language. - - For more information, see -`http://www.engin.umd.umich.edu/CIS/course.des/cis400/simula/simula.html'. - - -File: prog-modes.info, Node: sql, Next: tcl, Prev: simula, Up: Top - -27 Specialized Mode for SQL Interpreters -**************************************** - -This package provides a `sql-mode' and a `sql-interactive-mode'. The -goals were two simple modes providing syntactic highlighting. The -interactive mode had to provide a command-line history; the other mode -had to provide "send region/buffer to SQL interpreter" functions. -"simple" in this context means easy to use, easy to maintain and little -or no bells and whistles. - - `sql-interactive-mode' is used to interact with a SQL interpreter -process in a SQLi buffer (usually called `*SQL*'). The SQLi buffer is -created by calling a SQL interpreter-specific entry function. Do _not_ -call `sql-interactive-mode' by itself. - - The list of currently supported interpreters and the corresponding -entry function used to create the SQLi buffers is shown with `M-x -sql-help'. - - Since `sql-interactive-mode' is built on top of the general -command-interpreter-in-a-buffer mode (comint mode), it shares a common -base functionality, and a common set of bindings, with all modes -derived from comint mode. This makes these modes easier to use. - - `sql-mode' can be used to keep editing SQL statements. The SQL -statements can be sent to the SQL process in the SQLi buffer. - - For documentation on the functionality provided by comint mode, and -the hooks available for customizing it, see the file `comint.el'. - - Hint for newbies: take a look at `dabbrev-expand', `abbrev-mode', -and `imenu-add-menubar-index'. - - To configure this package, type: - - M-x customize-group RET SQL RET - - -File: prog-modes.info, Node: tcl, Next: teco, Prev: sql, Up: Top - -28 Editing Tcl Code -******************* - -This mode is used to edit Tcl code. The mode is automatically invoked -for buffers visiting the following types of files: - - * any file ending with an extension of `.tcl' or `.exp'. - - * any file that has an interpretor line (the "shebang" line) - specifying "scope", "wish", "tcl", "tclsh", or "expect". - - The mode provides the following capabilities: - - * Expression and list commands understand all Tcl brackets. - - * Tab indents for Tcl code. - - * Paragraphs are separated by blank lines only. - - * Delete converts tabs to spaces as it moves back. - - The variables controlling indentation style are: - -`tcl-indent-level' - Indentation of Tcl statements within surrounding block. - -`tcl-continued-indent-level' - Indentation of continuation line relative to first line of command. - - - The variables controlling user interaction with mode (see variable -documentation for details) are: - -`tcl-tab-always-indent' - Controls action of TAB key. - -`tcl-auto-newline' - Non-nil means automatically newline before and after braces, - brackets, and semicolons inserted in Tcl code. - -`tcl-electric-hash-style' - Controls action of `#' key. - -`tcl-use-hairy-comment-detector' - If t, use more complicated, but slower, comment detector. This - variable is only used in Emacs 19. - -`tcl-use-smart-word-finder' - If not nil, use a smarter, Tcl-specific way to find the current - word when looking up help on a Tcl command. - - - Turning on Tcl mode calls the value of the variable `tcl-mode-hook' -with no args, if that value is non-nil. Read the documentation for -`tcl-mode-hook' to see what kinds of interesting hook functions already -exist. - - The following key mappings are defined: - -`#' tcl-electric-hash -`;' tcl-electric-char -`[' tcl-electric-char -`]' tcl-electric-char -`{' tcl-electric-char -`}' tcl-electric-brace -`delete' backward-delete-char-untabify -`tab' tcl-indent-command -`C-c' << Prefix Command >> -`C-i' tcl-indent-command -`M-;' tcl-indent-for-comment -`M-backspace' tcl-mark-defun -`M-C-a' tcl-beginning-of-defun -`M-C-e' tcl-end-of-defun -`M-C-h' tcl-mark-defun -`M-C-q' indent-tcl-exp -`M-C-x' tcl-eval-defun -`C-c tab' tcl-help-on-word -`C-c C-b' tcl-submit-bug-report -`C-c C-c' comment-region -`C-c C-f' tcl-load-file -`C-c C-i' tcl-help-on-word -`C-c C-s' switch-to-tcl -`C-c C-t' inferior-tcl -`C-c C-v' tcl-eval-defun -`C-c C-x' tcl-eval-region - - To configure this package, type: - - M-x customize-group RET tcl RET - -* Menu: - -* About Tcl: about-tcl. - - -File: prog-modes.info, Node: about-tcl, Prev: tcl, Up: tcl - -28.1 About Tcl -============== - -Tcl (Tool Command Language) is used by over half a million developers -worldwide and has become a critical component in thousands of -corporations. It has a simple and programmable syntax and can be either -used as a standalone application or embedded in application programs. -Best of all, Tcl is open source so it's completely free. - - Tk is a graphical user interface toolkit that makes it possible to -create powerful GUIs incredibly quickly. It proved so popular that it -now ships with all distributions of Tcl. - - For more information, see `http://www.tcl.tk/software/tcltk/'. - - -File: prog-modes.info, Node: teco, Next: uil-mode, Prev: tcl, Up: Top - -29 Teco Interpreter -******************* - -This package implements a Teco Interpreter. - - To configure this package please view the source code. This can be -done by typing `C-x 4 l teco'. - - -File: prog-modes.info, Node: uil-mode, Next: verilog-mode, Prev: teco, Up: Top - -30 Editing Motif UIL Code -************************* - -This mode is used to edit Motif UIL files. It is automatically invoked -for buffers visiting any file ending with an extension of `.uil'. - - This mode is much like C mode except for the syntax of comments. It -uses the same keymap as C mode and has the same variables for -customizing indentation. It has its own abbrev table and its own -syntax table. *Note CC Mode: (cc-mode)Top., for details. - - Turning on uilmode calls the value of the variable `uil-mode-hook' -with no args, if that value is non-nil. - - To configure this package please view the source code. This can be -done by typing `C-x 4 l uil-mode'. - -* Menu: - -* About UIL: about-uil. - - -File: prog-modes.info, Node: about-uil, Prev: uil-mode, Up: uil-mode - -30.1 About UIL -============== - -The Motif user interface language (UIL) is a specification language for -describing the initial state of a Motif application's user interface. - - -File: prog-modes.info, Node: verilog-mode, Next: vrml-mode, Prev: uil-mode, Up: Top - -31 Editing Verilog HDL Source -***************************** - -This mode is used to edit Verilog source files. It is automatically -invoked for buffers visiting any file ending with one of the following -extensions: `.vh?', `.dv', `.vlog', and `.verilog'. - - The mode provides the following features: - - * NEWLINE, TAB indents for Verilog code. - - * Delete converts tabs to spaces as it moves back. - - * Supports highlighting. - - The variables controlling indentation/edit style are: - -`verilog-indent-level' - Indentation of Verilog statements with respect to containing block. - -`verilog-indent-level-module' - Absolute indentation of Module level Verilog statements. Set to 0 - to get initial and always statements lined up on the left side of - your screen. - -`verilog-indent-level-declaration' - Indentation of declarations with respect to containing block. Set - to 0 to get them list right under containing block. - -`verilog-indent-level-behavioral' - Indentation of first begin in a task or function block Set to 0 to - get such code to lined up underneath the task or function keyword - -`verilog-indent-level-directive' - Indentation of `ifdef/`endif blocks - -``verilog-cexp-indent' - Indentation of Verilog statements broken across lines i.e.: - if (a) - begin - -`verilog-case-indent' - Indentation for case statements. - -`verilog-auto-newline' - Non-nil means automatically newline after semicolons and the - punctuation mark after an end. - -`verilog-auto-indent-on-newline' - Non-nil means automatically indent line after newline - -`verilog-tab-always-indent' - Non-nil means TAB in Verilog mode should always reindent the - current line, regardless of where in the line point is when the - TAB command is used. - -`verilog-indent-begin-after-if' - Non-nil means to indent begin statements following a preceding if, - else, while, for and repeat statements, if any. otherwise, the - begin is lined up with the preceding token. If t, you get: - if (a) - begin // amount of indent based on `verilog-cexp-indent' - - otherwise you get: - if (a) - begin - -`verilog-auto-endcomments' - Non-nil means a comment /* ... */ is set after the ends which ends - cases, tasks, functions and modules. The type and name of the - object will be set between the braces. - -`verilog-minimum-comment-distance' - Minimum distance (in lines) between begin and end required before - a comment will be inserted. Setting this variable to zero results - in every end acquiring a comment; the default avoids too many - redundant comments in tight quarters. - -`verilog-auto-lineup' - List of contexts where auto lineup of :'s or ='s should be done. - - - Turning on Verilog mode calls the value of the variable -`verilog-mode-hook' with no args, if that value is non-nil. - - Other useful functions are: - -`verilog-complete-word' - complete word with appropriate possibilities (functions, verilog - keywords...) - -`verilog-comment-region' - Put marked area in a comment, fixing nested comments. - -`verilog-uncomment-region' - Uncomment an area commented with `verilog-comment-region'. - -`verilog-insert-block' - insert begin ... end; - -`verilog-star-comment' - insert /* ... */ - -`verilog-mark-defun' - Mark function. - -`verilog-beg-of-defun' - Move to beginning of current function. - -`verilog-end-of-defun' - Move to end of current function. - -`verilog-label-be' - Label matching begin ... end, fork ... join and case ... endcase - statements - -`verilog-sk-always' - Insert a always @(AS) begin .. end block - -`verilog-sk-begin' - Insert a begin .. end block - -`verilog-sk-case' - Insert a case block, prompting for details - -`verilog-sk-else' - Insert an else begin .. end block - -`verilog-sk-for' - Insert a for (...) begin .. end block, prompting for details - -`verilog-sk-generate' - Insert a generate .. endgenerate block - -`verilog-sk-header' - Insert a nice header block at the top of file - -`verilog-sk-initial' - Insert an initial begin .. end block - -`verilog-sk-fork' - Insert a fork begin .. end .. join block - -`verilog-sk-module' - Insert a module .. (/*AUTOARG*/);.. endmodule block - -`verilog-sk-primitive' - Insert a primitive .. (.. );.. endprimitive block - -`verilog-sk-repeat' - Insert a repeat (..) begin .. end block - -`verilog-sk-specify' - Insert a specify .. endspecify block - -`verilog-sk-task' - Insert a task .. begin .. end endtask block - -`verilog-sk-while' - Insert a while (...) begin .. end block, prompting for details - -`verilog-sk-casex' - Insert a casex (...) item: begin.. end endcase block, prompting - for details - -`verilog-sk-casez' - Insert a casez (...) item: begin.. end endcase block, prompting - for details - -`verilog-sk-if' - Insert an if (..) begin .. end block - -`verilog-sk-else-if' - Insert an else if (..) begin .. end block - -`verilog-sk-comment' - Insert a comment block - -`verilog-sk-assign' - Insert an assign .. = ..; statement - -`verilog-sk-function' - Insert a function .. begin .. end endfunction block - -`verilog-sk-input' - Insert an input declaration, prompting for details - -`verilog-sk-output' - Insert an output declaration, prompting for details - -`verilog-sk-state-machine' - Insert a state machine definition, prompting for details! - -`verilog-sk-inout' - Insert an inout declaration, prompting for details - -`verilog-sk-wire' - Insert a wire declaration, prompting for details - -`verilog-sk-reg' - Insert a register declaration, prompting for details" - - - To configure this package, type: - - M-x customize-group RET verilog-mode RET - -* Menu: - -* About Verilog: about-verilog. - - -File: prog-modes.info, Node: about-verilog, Prev: verilog-mode, Up: verilog-mode - -31.1 About Verilog -================== - -Verilog HDL is a hardware description language used to design and -document electronic systems. Verilog HDL allows designers to design at -various levels of abstraction. It is the most widely used HDL with a -user community of more than 50,000 active designers. - - For more information, see `http://www.verilog.com/'. - - -File: prog-modes.info, Node: vrml-mode, Next: XEmacs License, Prev: verilog-mode, Up: Top - -32 Editing VRML (.wrl) Files -**************************** - -This mode is used for editing VRML files. It is automatically invoked -for buffers visiting any file ending with an extension of `.wrl'. - - The mode has the following features: - - * Expression and list commands understand all VRML brackets. - - * Tab indents for VRML code. - - * Paragraphs are separated by blank lines only. - - * Delete converts tabs to spaces as it moves back. - - - The variables controlling indentation style are: - -`vrml-indent-level' - Indentation of VRML statements within surrounding block. - - - The variables controlling user interaction with mode (see variable -documentation for details) are: - -`vrml-tab-always-indent' - Controls action of TAB key. - -`vrml-auto-newline' - Non-nil means automatically newline before and after braces - inserted in VRML code. - - - Turning on VRML mode calls the value of the variable `vrml-mode-hook' -with no args, if that value is non-nil. Read the documentation for -`vrml-mode-hook' to see what kinds of interesting hook functions already -exist. - - To configure this package, type: - - M-x customize-group RET vrml RET - - -File: prog-modes.info, Node: XEmacs License, Prev: vrml-mode, Up: Top - -33 XEmacs License -***************** - -GNU GENERAL PUBLIC LICENSE -************************** - - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 675 Mass Ave, Cambridge, MA 02139, USA - - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -Preamble -======== - -The licenses for most software are designed to take away your freedom -to share and change it. By contrast, the GNU General Public License is -intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it in -new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, -and (2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - 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. - - ONE LINE TO GIVE THE PROGRAM'S NAME AND AN IDEA OF WHAT IT DOES. - Copyright (C) 19YY NAME OF AUTHOR - - 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., 675 Mass Ave, Cambridge, MA 02139, USA. - - Also add information on how to contact you by electronic and paper -mail. - - If the program is interactive, make it output a short notice like -this when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) 19YY NAME OF AUTHOR - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details - type `show w'. This is free software, and you are welcome - to redistribute it under certain conditions; type `show c' - for details. - - The hypothetical commands `show w' and `show c' should show the -appropriate parts of the General Public License. Of course, the -commands you use may be called something other than `show w' and `show -c'; they could even be mouse-clicks or menu items--whatever suits your -program. - - You should also get your employer (if you work as a programmer) or -your school, if any, to sign a "copyright disclaimer" for the program, -if necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright - interest in the program `Gnomovision' - (which makes passes at compilers) written - by James Hacker. - - SIGNATURE OF TY COON, 1 April 1989 - Ty Coon, President of Vice - - This General Public License does not permit incorporating your -program into proprietary programs. If your program is a subroutine -library, you may consider it more useful to permit linking proprietary -applications with the library. If this is what you want to do, use the -GNU Library General Public License instead of this License. - - - -Tag Table: -Node: Top218 -Node: Copying3067 -Node: asm-mode7216 -Node: autoconf-mode8361 -Node: about-autoconf8943 -Node: awk-mode9484 -Node: about-awk10401 -Node: cl-indent10608 -Node: cvs11143 -Node: about-cvs12189 -Node: diff-mode12459 -Node: eiffel13740 -Node: about-eiffel14624 -Node: icon15027 -Node: about-icon17229 -Node: javascript-mode17715 -Node: about-javascript20137 -Node: ksh-mode20392 -Node: lua-mode23537 -Node: about-lua23903 -Node: m4-mode24265 -Node: about-m424977 -Node: make-mode25420 -Node: about-make31014 -Node: mode-compile31330 -Node: compile-cust33760 -Node: compile-compilation-mode34937 -Node: compile-makefile-mode35158 -Node: compile-emacs-lisp-mode35527 -Node: compile-dired-mode35920 -Node: compile-sh-mode36498 -Node: compile-c?perl-mode36794 -Node: compile-tcl-mode37038 -Node: compile-c-mode37272 -Node: compile-ada-mode38890 -Node: compile-fortran-mode39172 -Node: compile-java-mode39397 -Node: compile-python-mode39627 -Node: compile-message-mode39878 -Node: compile-catchall40064 -Node: modula240802 -Node: about-modula242370 -Node: old-c-mode42943 -Node: p445154 -Node: about-perforce45620 -Node: pascal46213 -Node: php-mode48545 -Node: about-php49874 -Node: postscript50163 -Node: about-postscript51386 -Node: prolog52192 -Node: rexx-mode52979 -Node: about-rexx55670 -Node: rpm-spec-mode56082 -Node: about-rpm56898 -Node: simula57607 -Node: about-simula60762 -Node: sql61326 -Node: tcl62967 -Node: about-tcl65761 -Node: teco66438 -Node: uil-mode66704 -Node: about-uil67492 -Node: verilog-mode67741 -Node: about-verilog73599 -Node: vrml-mode74042 -Node: XEmacs License75297 - -End Tag Table diff --git a/xemacs-packages/info/re-builder.info b/xemacs-packages/info/re-builder.info deleted file mode 100644 index 46817fd3..00000000 --- a/xemacs-packages/info/re-builder.info +++ /dev/null @@ -1,207 +0,0 @@ -This is re-builder.info, produced by makeinfo version 4.6 from -re-builder.texi. - -START-INFO-DIR-ENTRY -* re-builder:: Write regular expressions with visual feedback. -END-INFO-DIR-ENTRY - - This file documents the re-builder XEmacs package, which provides -visual feedback when developing regular expressions. - - This documentation was taken from the source file, `re-builder.el', -which is subject to the following conditions; because of the nature of -the GNU GPL, this file is as a result also subject to those conditions. - - Copyright (C) 1999, 2000, 2001, 2002, 2004 Free Software Foundation, -Inc. - - This file is part of GNU Emacs. - - GNU Emacs is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - - GNU Emacs is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - - You should have received a copy of the GNU General Public License -along with GNU Emacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. - - End of permissions notice. - - -File: re-builder.info, Node: Top, Next: Copying, Prev: (dir), Up: (dir) - -Re-builder on XEmacs -******************** - -When I have to come up with regular expressions that are more complex -than simple string matchers, especially if they contain sub -expressions, I find myself spending quite some time in the `development -cycle'. `re-builder' aims to shorten this time span so I can get on -with the more interesting bits. - - With it you can have immediate visual feedback about how well the -regexp behaves to your expectations on the intended data. - - This is version 1.2 of the re-builder manual, last updated on -Sunday, July 24, 2005. - -* Menu: - -* Copying:: re-builder copying conditions. -* Overview:: re-builder history and general information. - -For general users: -* Usage:: An overview of the operation of re-builder. -* Regex Types:: Types of regular expression handled. -* Questions:: A couple of selected queries. - - -File: re-builder.info, Node: Copying, Next: Overview, Prev: Top, Up: Top - -re-builder Copying Conditions -***************************** - -Copyright (C) 1999, 2000, 2001, 2002, 2004 Free Software Foundation, -Inc. - - re-builder 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. - - re-builder 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 XEmacs; see the file COPYING. If not, write to the Free -Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. - - -File: re-builder.info, Node: Overview, Next: Usage, Prev: Copying, Up: Top - -An Overview of re-builder -************************* - -When I have to come up with regular expressions that are more complex -than simple string matchers, especially if they contain sub expressions, -I find myself spending quite some time in the `development cycle'. -re-builder aims to shorten this time span so I can get on with the more -interesting bits. - - With it you can have immediate visual feedback about how well the -regexp behaves to your expectations on the intended data. - - -File: re-builder.info, Node: Usage, Next: Regex Types, Prev: Overview, Up: Top - -Operation of re-builder -*********************** - -When called up, with `M-x re-builder RET', re-builder attaches itself -to the current buffer which becomes its target buffer, where all the -matching is done. The active window is split so you have a view on the -data while authoring the RE. If the edited expression is valid the -matches in the target buffer are marked automatically with colored -overlays (for non-color displays see below) giving you feedback over the -extents of the matched (sub) expressions. The (non-)validity is shown -only in the modeline without throwing the errors at you. If you want to -know the reason why RE Builder considers it as invalid call -`reb-force-update' (`C-c C-u') which should reveal the error. - - The target buffer can be changed with `reb-change-target-buffer' -(`C-c C-b'). Changing the target buffer automatically removes the -overlays from the old buffer and displays the new one in the target -window. - - re-builder keeps the focus while updating the matches in the target -buffer so corrections are easily incorporated. If you are satisfied -with the result you can paste the RE to the kill-ring with `reb-copy' -(`C-c C-w') (the copied RE and current syntax is displayed in the echo -area), quit re-builder (`C-c C-q') and use it wherever you need it. - - As the automatic updates can take some time on large buffers, they -can be limited by `reb-auto-match-limit' so that they should not have a -negative impact on the editing. Setting it to nil makes even the auto -updates go all the way. Forcing an update overrides this limit allowing -an easy way to see all matches. - - -File: re-builder.info, Node: Regex Types, Next: Questions, Prev: Usage, Up: Top - -Regex Types -*********** - -Currently re-builder understands six different forms of input, namely -`lisp-re', `perl', `read', `rx', `sregex', and `string' syntax. Read -syntax and string syntax are both delimited by `"'s and behave -according to their name. With the `perl' and `string' syntax there's -no need to escape the backslashes and double quotes simplifying the -editing somewhat. The other four allow editing of symbolic regular -expressions supported by the packages of the same name. (`lisp-re' is -a package by me and its support may go away as it is nearly the same as -the `sregex' package in Emacs) - - Note that the `sregex,' `rx' and `lisp-re' syntaxes will only be -available in XEmacs if you've installed them yourself. - - Editing symbolic expressions is done through a major mode derived -from `emacs-lisp-mode' so you'll get all the good stuff like automatic -indentation and font-locking etc. - - When editing a symbolic regular expression, only the first expression -in the RE Builder buffer is considered, which helps limiting the extent -of the expression like the `"'s do for the text modes. For the -`sregex' syntax the function `sregex' is applied to the evaluated -expression read. So you can use quoted arguments with something like -'("findme") or you can construct arguments to your heart's content with -a valid ELisp expression. The compiled string form will be copied by -`reb-copy'. If you want to take a glance at the corresponding string -you can temporarily change the input syntax using `reb-change-syntax' -(`C-c C-i'). The current RE syntax is also displayed in the modeline. - - Changing the input syntax is transparent (for the obvious exception -non-symbolic -> symbolic) so you can change your mind as often as you -like. - - There is also a shortcut function, `reb-toggle-case' (`C-c C-c'), -for toggling the `case-fold-search' variable in the target buffer with -an immediate update. - - -File: re-builder.info, Node: Questions, Prev: Regex Types, Up: Top - -Questions -********* - -Q: But what if my display cannot show colored overlays? - - A: Then the cursor will flash around the matched text making it stand -out. - - Q: But how can I then make out the sub-expressions? - - A: That's where the `sub-expression mode' comes in. In it only the -digit keys are assigned to perform an update that will flash the -corresponding subexp only. - - - -Tag Table: -Node: Top1369 -Node: Copying2388 -Node: Overview3289 -Node: Usage3853 -Node: Regex Types5555 -Node: Questions7559 - -End Tag Table diff --git a/xemacs-packages/info/smtpmail.info b/xemacs-packages/info/smtpmail.info deleted file mode 100644 index a096ac4f..00000000 --- a/xemacs-packages/info/smtpmail.info +++ /dev/null @@ -1,414 +0,0 @@ -This is smtpmail.info, produced by makeinfo version 4.7 from -smtpmail.texi. - - Copyright (C) 2003, 2004 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.1 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover texts - being "A GNU Manual", and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - "GNU Free Documentation License" in the Emacs manual. - - (a) The FSF's Back-Cover Text is: "You have freedom to copy and - modify this GNU Manual, like GNU software. Copies published by - the Free Software Foundation raise funds for GNU development." - - This document is part of a collection distributed under the GNU - Free Documentation License. If you want to distribute this - document separately from the collection, you can do so by adding a - copy of the license to the document, as described in section 6 of - the license. - -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* SMTP: (smtpmail). Emacs library for sending mail via SMTP. -END-INFO-DIR-ENTRY - - -File: smtpmail.info, Node: Top, Next: How Mail Works, Up: (dir) - -Emacs SMTP Library -****************** - -Copyright (C) 2003, 2004 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.1 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover texts - being "A GNU Manual", and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - "GNU Free Documentation License" in the Emacs manual. - - (a) The FSF's Back-Cover Text is: "You have freedom to copy and - modify this GNU Manual, like GNU software. Copies published by - the Free Software Foundation raise funds for GNU development." - - This document is part of a collection distributed under the GNU - Free Documentation License. If you want to distribute this - document separately from the collection, you can do so by adding a - copy of the license to the document, as described in section 6 of - the license. - -* Menu: - -* How Mail Works:: Brief introduction to mail concepts. -* Emacs Speaks SMTP:: How to use the SMTP library in Emacs. -* Authentication:: Authenticating yourself to the server. -* Queued delivery:: Sending mail without an internet connection. -* Server workarounds:: Mail servers with special requirements. -* Debugging:: Tracking down problems. - -Indices - -* Index:: Index over variables and functions. - - -File: smtpmail.info, Node: How Mail Works, Next: Emacs Speaks SMTP, Prev: Top, Up: Top - -1 How Mail Works -**************** - -On the internet, mail is sent from mail host to mail host using the -simple mail transfer protocol (SMTP). To send and receive mail, you -must get it from and send it to a mail host. Every mail host runs a -mail transfer agent (MTA) such as Exim that accepts mails and passes -them on. The communication between a mail host and other clients does -not necessarily involve SMTP, however. Here is short overview of what -is involved. - - The mail program -- also called a mail user agent (MUA) -- usually -sends outgoing mail to a mail host. When your computer is permanently -connected to the internet, it might even be a mail host itself. In -this case, the MUA will pipe mail to the `/usr/lib/sendmail' -application. It will take care of your mail and pass it on to the next -mail host. - - When you are only connected to the internet from time to time, your -internet service provider (ISP) has probably told you which mail host -to use. You must configure your MUA to use that mail host. Since you -are reading this manual, you probably want to configure Emacs to use -SMTP to send mail to that mail host. More on that in the next section. - - Things are different when reading mail. The mail host responsible -for your mail keeps it in a file somewhere. The messages get into the -file by way of a mail delivery agent (MDA) such as procmail. These -delivery agents often allow you to filter and munge your mails before -you get to see it. When your computer is that mail host, this file is -called a spool, and sometimes located in the directory -`/var/spool/mail/'. All your MUA has to do is read mail from the -spool, then. - - When your computer is not always connected to the internet, you must -get the mail from the remote mail host using a protocol such as POP3 or -IMAP. POP3 essentially downloads all your mail from the mail host to -your computer. The mail is stored in some file on your computer, and -again, all your MUA has to do is read mail from the spool. - - When you read mail from various machines, downloading mail from the -mail host to your current machine is not convenient. In that case, you -will probably want to use the IMAP protocol. Your mail is kept on the -mail host, and you can read it while you are connected via IMAP to the -mail host. - - So how does reading mail via the web work, you ask. In that case, -the web interface just allows you to remote-control a MUA on the web -host. Whether the web host is also a mail host, and how all the pieces -interact is completely irrelevant. You usually cannot use Emacs to -read mail via the web, unless you use software that parses the -ever-changing HTML of the web interface. - - -File: smtpmail.info, Node: Emacs Speaks SMTP, Next: Authentication, Prev: How Mail Works, Up: Top - -2 Emacs Speaks SMTP -******************* - -Emacs includes a package for sending your mail to a SMTP server and -have it take care of delivering it to the final destination, rather -than letting the MTA on your local system take care of it. This can be -useful if you don't have a MTA set up on your host, or if your machine -is often disconnected from the internet. - - Sending mail via SMTP requires configuring your mail user agent -(*note Mail Methods: (emacs)Mail Methods.) to use the SMTP library. -How to do this should be described for each mail user agent; for the -default mail user agent the variable `send-mail-function' (*note Mail -Sending: (emacs)Mail Sending.) is used; for the Message and Gnus user -agents the variable `message-send-mail-function' (*note Mail Variables: -(message)Mail Variables.) is used. - - ;; If you use the default mail user agent. - (setq send-mail-function 'smtpmail-send-it) - ;; If you use Message or Gnus. - (setq message-send-mail-function 'smtpmail-send-it) - - Before using SMTP you must find out the hostname of the SMTP server -to use. Your system administrator should provide you with this -information, but often it is the same as the server you receive mail -from. - -`smtpmail-smtp-server' - The variable `smtpmail-smtp-server' controls the hostname of the - server to use. It is a string with an IP address or hostname. It - defaults to the contents of the `SMTPSERVER' environment variable, - or, if empty, the contents of `smtpmail-default-smtp-server'. - -`smtpmail-default-smtp-server' - The variable `smtpmail-default-smtp-server' controls the default - hostname of the server to use. It is a string with an IP address - or hostname. It must be set before the SMTP library is loaded. - It has no effect if set after the SMTP library has been loaded, or - if `smtpmail-smtp-server' is defined. It is usually set by system - administrators in a site wide initialization file. - - The following example illustrates what you could put in `~/.emacs' -to set the SMTP server name. - - ;; Send mail using SMTP via mail.example.org. - (setq smtpmail-smtp-server "mail.example.org") - - SMTP is normally used on the registered "smtp" TCP service port 25. -Some environments use SMTP in "Mail Submission" mode, which uses port -587. Using other ports is not uncommon, either for security by -obscurity purposes, port forwarding, or otherwise. - -`smtpmail-smtp-service' - The variable `smtpmail-smtp-service' controls the port on the - server to contact. It is either a string, in which case it will be - translated into an integer using system calls, or an integer. - - The following example illustrates what you could put in `~/.emacs' -to set the SMTP service port. - - ;; Send mail using SMTP on the mail submission port 587. - (setq smtpmail-smtp-service 587) - - -File: smtpmail.info, Node: Authentication, Next: Queued delivery, Prev: Emacs Speaks SMTP, Up: Top - -3 Authentication -**************** - -Many environments require SMTP clients to authenticate themselves -before they are allowed to route mail via a server. The two following -variables contains the authentication information needed for this. The -first variable, `smtpmail-auth-credentials', instructs the SMTP library -to use a SASL authentication step, currently only the CRAM-MD5 and -LOGIN mechanisms are supported and will be selected in that order if -the server support both. - - The second variable, `smtpmail-starttls-credentials', instructs the -SMTP library to connect to the server using STARTTLS. This means the -protocol exchange may be integrity protected and confidential by using -TLS, and optionally also authentication of the client. This feature -uses the elisp package `starttls.el' (see it for more information on -customization), which in turn require that at least one of the -following external tools are installed: - - 1. The GNUTLS command line tool `gnutls-cli', you can get it from - `http://www.gnu.org/software/gnutls/'. This is the recommended - tool, mainly because it can verify the server certificates. - - 2. The `starttls' external program, you can get it from - `starttls-*.tar.gz' from `ftp://ftp.opaopa.org/pub/elisp/'. - - It is not uncommon to use both these mechanisms, e.g., to use -STARTTLS to achieve integrity and confidentiality and then use SASL for -client authentication. - -`smtpmail-auth-credentials' - The variable `smtpmail-auth-credentials' contains a list of - hostname, port, username and password tuples. When the SMTP - library connects to a host on a certain port, this variable is - searched to find a matching entry for that hostname and port. If - an entry is found, the authentication process is invoked and the - credentials are used. - - The hostname field follows the same format as - `smtpmail-smtp-server' (i.e., a string) and the port field the - same format as `smtpmail-smtp-service' (i.e., a string or an - integer). The username and password fields, which either can be - `nil' to indicate that the user is prompted for the value - interactively, should be strings with the username and password, - respectively, information that is normally provided by system - administrators. - -`smtpmail-starttls-credentials' - The variable `smtpmail-starttls-credentials' contains a list of - tuples with hostname, port, name of file containing client key, and - name of file containing client certificate. The processing is - similar to the previous variable. The client key and certificate - may be `nil' if you do not wish to use client authentication. - - The following example illustrates what you could put in `~/.emacs' -to enable both SASL authentication and STARTTLS. The server name -(`smtpmail-smtp-server') is HOSTNAME, the server port -(`smtpmail-smtp-service') is PORT, and the username and password are -USERNAME and PASSWORD respectively. - - ;; Authenticate using this username and password against my server. - (setq smtpmail-auth-credentials - '(("HOSTNAME" "PORT" "USERNAME" "PASSWORD"))) - - ;; Note that if PORT is an integer, you must not quote it as a - ;; string. Normally PORT should be the integer 25, and the example - ;; become: - (setq smtpmail-auth-credentials - '(("HOSTNAME" 25 "USERNAME" "PASSWORD"))) - - ;; Use STARTTLS without authentication against the server. - (setq smtpmail-starttls-credentials - '(("HOSTNAME" "PORT" nil nil))) - - -File: smtpmail.info, Node: Queued delivery, Next: Server workarounds, Prev: Authentication, Up: Top - -4 Queued delivery -***************** - -If you connect to the internet via a dialup connection, or for some -other reason don't have permanent internet connection, sending mail -will fail when you are not connected. The SMTP library implements -queued delivery, and the following variable control its behaviour. - -`smtpmail-queue-mail' - The variable `smtpmail-queue-mail' controls whether a simple off - line mail sender is active. This variable is a boolean, and - defaults to `nil' (disabled). If this is non-`nil', mail is not - sent immediately but rather queued in the directory - `smtpmail-queue-dir' and can be later sent manually by invoking - `smtpmail-send-queued-mail' (typically when you connect to the - internet). - -`smtpmail-queue-dir' - The variable `smtpmail-queue-dir' specifies the name of the - directory to hold queued messages. It defaults to - `~/Mail/queued-mail/'. - - The function `smtpmail-send-queued-mail' can be used to send any -queued mail when `smtpmail-queue-mail' is enabled. It is typically -invoked interactively with `M-x smtpmail-send-queued-mail RET' when you -are connected to the internet. - - -File: smtpmail.info, Node: Server workarounds, Next: Debugging, Prev: Queued delivery, Up: Top - -5 Server workarounds -******************** - -Some SMTP servers have special requirements. The following variables -implement support for common requirements. - -`smtpmail-local-domain' - The variable `smtpmail-local-domain' controls the hostname sent in - the first `EHLO' or `HELO' command sent to the server. It should - only be set if the `system-name' function returns a name that - isn't accepted by the server. Do not set this variable unless - your server complains. - -`smtpmail-sendto-domain' - The variable `smtpmail-sendto-domain' makes the SMTP library add - `@' and the specified value to recipients specified in the message - when they are sent using the `RCPT TO' command. Some - configurations of sendmail requires this behaviour. Don't bother - to set this unless you have get an error like: - - Sending failed; SMTP protocol error - - when sending mail, and the debug buffer (*note Debugging::)) - contains an error such as: - - RCPT TO: SOMEONE - 501 SOMEONE: recipient address must contain a domain - - - -File: smtpmail.info, Node: Debugging, Next: Index, Prev: Server workarounds, Up: Top - -6 Debugging -*********** - -Sometimes delivery fails, often with the generic error message `Sending -failed; SMTP protocol error'. Enabling one or both of the following -variables and inspecting a trace buffer will often give clues to the -reason for the error. - -`smtpmail-debug-info' - The variable `smtpmail-debug-info' controls whether to print the - SMTP protocol exchange in the minibuffer, and retain the entire - exchange in a buffer `*trace of SMTP session to SERVER*', where - SERVER is the name of the mail server to which you send mail. - -`smtpmail-debug-verb' - The variable `smtpmail-debug-verb' controls whether to send the - `VERB' token to the server. The `VERB' server instructs the - server to be more verbose, and often also to attempt final delivery - while your SMTP session is still running. It is usually only - useful together with `smtpmail-debug-info'. Note that this may - cause mail delivery to take considerable time if the final - destination cannot accept mail. - - - -File: smtpmail.info, Node: Index, Prev: Debugging, Up: Top - -7 Index -******* - -7.1 Concept Index -================= - -[index] -* Menu: - -* CRAM-MD5: Authentication. (line 6) -* Dialup connection: Queued delivery. (line 6) -* IMAP: How Mail Works. (line 36) -* ISP: How Mail Works. (line 21) -* LOGIN: Authentication. (line 6) -* Mail Submission: Emacs Speaks SMTP. (line 50) -* MDA: How Mail Works. (line 27) -* MTA: How Mail Works. (line 6) -* MUA: How Mail Works. (line 14) -* POP3: How Mail Works. (line 36) -* SASL: Authentication. (line 6) -* SMTP: How Mail Works. (line 6) -* STARTTLS: Authentication. (line 6) -* Webmail: How Mail Works. (line 48) - -7.2 Function and Variable Index -=============================== - -[index] -* Menu: - -* smtpmail-auth-credentials: Authentication. (line 34) -* smtpmail-debug-info: Debugging. (line 12) -* smtpmail-debug-verb: Debugging. (line 18) -* smtpmail-default-smtp-server: Emacs Speaks SMTP. (line 37) -* smtpmail-local-domain: Server workarounds. (line 10) -* smtpmail-queue-dir: Queued delivery. (line 21) -* smtpmail-queue-mail: Queued delivery. (line 12) -* smtpmail-send-queued-mail: Queued delivery. (line 25) -* smtpmail-sendto-domain: Server workarounds. (line 17) -* smtpmail-smtp-server: Emacs Speaks SMTP. (line 31) -* smtpmail-smtp-service: Emacs Speaks SMTP. (line 56) -* smtpmail-starttls-credentials: Authentication. (line 51) -* SMTPSERVER: Emacs Speaks SMTP. (line 31) - - - -Tag Table: -Node: Top1239 -Node: How Mail Works2792 -Node: Emacs Speaks SMTP5570 -Node: Authentication8533 -Node: Queued delivery12174 -Node: Server workarounds13439 -Node: Debugging14620 -Node: Index15737 - -End Tag Table diff --git a/xemacs-packages/info/speedbar.info b/xemacs-packages/info/speedbar.info deleted file mode 100644 index 00ddfe89..00000000 --- a/xemacs-packages/info/speedbar.info +++ /dev/null @@ -1,1318 +0,0 @@ -This is speedbar.info, produced by makeinfo version 4.6 from -speedbar.texi. - -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* Speedbar: (speedbar). File/Tag summarizing utility. -END-INFO-DIR-ENTRY - Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.1 or -any later version published by the Free Software Foundation; with the -Invariant Sections being "The GNU Manifesto", "Distribution" and "GNU -GENERAL PUBLIC LICENSE", with the Front-Cover texts being "A GNU -Manual", and with the Back-Cover Texts as in (a) below. A copy of the -license is included in the section entitled "GNU Free Documentation -License" in the Emacs manual. - - (a) The FSF's Back-Cover Text is: "You have freedom to copy and -modify this GNU Manual, like GNU software. Copies published by the Free -Software Foundation raise funds for GNU development." - - This document is part of a collection distributed under the GNU Free -Documentation License. If you want to distribute this document -separately from the collection, you can do so by adding a copy of the -license to the document, as described in section 6 of the license. - - -File: speedbar.info, Node: Top, Up: (dir)Top - - Speedbar is a program for Emacs which can be used to summarize -information related to the current buffer. Its original inspiration is -the `explorer' often used in modern development environments, office -packages, and web browsers. - - Speedbar displays a narrow frame in which a tree view is shown. This -tree view defaults to containing a list of files and directories. Files -can be `expanded' to list tags inside. Directories can be expanded to -list the files within itself. Each file or tag can be jumped to -immediately. - - Speedbar expands upon `explorer' windows by maintaining context with -the user. For example, when using the file view, the current buffer's -file is highlighted. Speedbar also mimics the explorer windows by -providing multiple display modes. These modes come in two flavors. -Major display modes remain consistent across buffers, and minor display -modes appear only when a buffer of the applicable type is shown. This -allows authors of other packages to provide speedbar summaries -customized to the needs of that mode. - - Throughout this manual, activities are defined as `clicking on', or -`expanding' items. Clicking means using using `Mouse-2' on a button. -Expanding refers to clicking on an expansion button to display an -expanded summary of the entry the expansion button is on. *Note Basic -Navigation::. - -* Menu: - -* Introduction:: Basics of speedbar. -* Basic Navigation:: Basics of speedbar common between all modes. -* File Mode:: Summarizing files. -* Buffer Mode:: Summarizing buffers. -* Minor Modes:: Additional minor modes such as Info and RMAIL. -* Customizing:: Changing speedbar behavior. -* Extending:: Extend speedbar for your own project. -* Index:: - - -File: speedbar.info, Node: Introduction, Next: Basic Navigation, Up: Top - -Introduction -************ - -To start using speedbar use the command `M-x speedbar RET' or select it -from the Tools menu in versions of Emacs with speedbar installed by -default. This command will open a new frame to summarize the local -files. On X Window systems or on MS-Windows, speedbar's frame is twenty -characters wide, and will mimic the height of the frame from which it -was started. It positions itself to the left or right of the frame you -started it from. - - To use speedbar effectively, it is important to understand its -relationship with the frame you started it from. This frame is the -"attached frame" which speedbar will use as a reference point. Once -started, speedbar watches the contents of this frame, and attempts to -make its contents relevant to the buffer loaded into the attached -frame. In addition, all requests made in speedbar that require the -display of another buffer will display in the attached frame. - - When used in terminal mode, the new frame appears the same size as -the terminal. Since it is not visible while working in the attached -frame, speedbar will save time by using the "slowbar mode", where no -tracking is done until speedbar is requested to show itself (i.e., the -speedbar's frame becomes the selected frame). - - The function to use when switching between frames using the keyboard -is `speedbar-get-focus'. This function will toggle between frames, and -it's useful to bind it to a key in terminal mode. *Note Customizing::. - - -File: speedbar.info, Node: Basic Navigation, Next: File Mode, Prev: Introduction, Up: Top - -Basic Navigation -**************** - -Speedbar can display different types of data, and has several display -and behavior modes. These modes all have a common behavior, menu -system, and look. If one mode is learned, then the other modes are easy -to use. - -* Menu: - -* Basic Key Bindings:: -* Basic Visuals:: -* Mouse Bindings:: -* Displays Submenu:: - - -File: speedbar.info, Node: Basic Key Bindings, Next: Basic Visuals, Prev: Basic Navigation, Up: Basic Navigation - -Basic Key Bindings -================== - -These key bindings are common across all modes: - -`delete, SPC' - Scroll up and down one page. - -`Q' - Quit speedbar, and kill the frame. - -`q' - Quit speedbar, and hide the frame. This makes it faster to - restore the speedbar frame, than if you press `Q'. - -`g' - Refresh whatever contents are in speedbar. - -`t' - Toggle speedbar to and from slowbar mode. In slowbar mode, frame - tracking is not done. - -`n' -`p' - Move, respectively, to the next or previous item. A summary of - that item will be displayed in the attached frame's minibuffer. - -`M-n' -`M-p' - Move to the next or previous item in a restricted fashion. If a - list is open, the cursor will skip over it. If the cursor is in - an open list, it will not leave it. - -`C-M-n' -`C-M-n' - Move forwards and backwards across extended groups. This lets you - quickly skip over all files, directories, or other common - sub-items at the same current depth. - -`C-x b' - Switch buffers in the attached frame. - - Speedbar can handle multiple modes. Two are provided by default. -These modes are File mode, and Buffers mode. There are accelerators to -switch into these different modes. - -`b' - Switch into Quick Buffers mode (*note Buffer Mode::). After one - use, the previous display mode is restored. - -`f' - Switch into File mode. - -`r' - Switch back to the previous mode. - - Some modes provide groups, lists and tags. *Note Basic Visuals::. -When these are available, some additional common bindings are available. - -`RET' -`e' - Edit/Open the current group or tag. This behavior is dependent on - the mode. In general, files or buffers are opened in the attached - frame, and directories or group nodes are expanded locally. - -`+' -`=' - Expand the current group, displaying sub items. When used with a - prefix argument, any data that may have been cached is flushed. - This is similar to a power click. *Note Mouse Bindings::. - -`-' - Contract the current group, hiding sub items. - - -File: speedbar.info, Node: Basic Visuals, Next: Mouse Bindings, Prev: Basic Key Bindings, Up: Basic Navigation - -Basic Visuals -============= - -Speedbar has visual cues for indicating different types of data. These -cues are used consistently across the different speedbar modes to make -them easier to interpret. - - At a high level, in File mode, there are directory buttons, sub -directory buttons, file buttons, tag buttons, and expansion buttons. -This makes it easy to use the mouse to navigate a directory tree, and -quickly view files, or a summary of those files. - - The most basic visual effect used to distinguish between these button -types is color and mouse highlighting. Anything the mouse highlights -can be clicked on and is called a button (*note Mouse Bindings::). -Anything not highlighted by the mouse will not be clickable. - - Text in speedbar consists of four different types of data. Knowing -how to read these textual elements will make it easier to navigate by -identifying the types of data available. - -Groups -...... - -Groups summarize information in a single line, and provide a high level -view of more complex systems, like a directory tree, or manual chapters. - - Groups appear at different indentation levels, and are prefixed with -a `+' in some sort of `box'. The group name will summarize the -information within it, and the expansion box will display that -information inline. In File mode, directories and files are `groups' -where the `+' is surrounded by brackets like this: - - <+> include - <-> src - [+] foo.c - - In this example, we see both open and closed directories, in -addition to a file. The directories have a box consisting of angle -brackets, and a file uses square brackets. - - In all modes, a group can be `edited' by pressing `RET', meaning a -file will be opened, or a directory explicitly opened in speedbar. A -group can be expanded or contracted using `+' or `-'. *Note Basic Key -Bindings::. - - Sometimes groups may have a `?' in its indicator box. This means -that it is a group type, but there are no contents, or no known way of -extracting contents of that group. - - When a group has been expanded, the indicator button changes from -`+' to `-'. This indicates that the contents are being shown. Click -the `-' button to contract the group, or hide the contents currently -displayed. - -Tags -.... - -Tags are the leaf nodes of the tree system. Tags are generally prefixed -with a simple character, such as `>'. Tags can only be jumped to using -`RET' or `e'. - -Boolean Flags -............. - -Sometimes a group or tag is given a boolean flag. These flags appear as -extra text characters at the end of the line. File mode uses boolean -flags, such as a `*' to indicate that a file has been checked out of a -versioning system. - - For additional flags, see *Note File Mode::, and *Note Version -Control::. - -Unadorned Text -.............. - -Unadorned text generally starts in column 0, without any special symbols -prefixing them. In Buffers mode different buffer groups are prefixed -with a description of what the following buffers are (Files, scratch -buffers, and invisible buffers.) - - Unadorned text will generally be colorless, and not clickable. - -Color Cues -.......... - -Each type of Group, item indicator, and label is given a different -color. The colors chosen are dependent on whether the background color -is light or dark. Of important note is that the `current item', which -may be a buffer or file name, is highlighted red, and underlined. - - Colors can be customized from the group `speedbar-faces'. Some -modes, such as for Info, will use the Info colors instead of default -speedbar colors as an indication of what is currently being displayed. - - The face naming convention mirrors the File display mode. Modes -which do not use files will attempt to use the same colors on analogous -entries. - - -File: speedbar.info, Node: Mouse Bindings, Next: Displays Submenu, Prev: Basic Visuals, Up: Basic Navigation - -Mouse Bindings -============== - -The mouse has become a common information navigation tool. Speedbar -will use the mouse to navigate file systems, buffer lists, and other -data. The different textual cues provide buttons which can be clicked -on (*note Basic Visuals::). Anything that highlights can be clicked on -with the mouse, or affected by the menu. - - The mouse bindings are: - -`Mouse-1' - Move cursor to that location. - -`Mouse-2' -`Double-Mouse-1' - Activate the current button. `Double-Mouse-1' is called a "double - click" on other platforms, and is useful for windows users with two - button mice. - -`S-Mouse-2' -`S-Double-Mouse-1' - This has the same effect as `Mouse-2', except it is called a power - click. This means that if a group with an expansion button `+' is - clicked, any caches are flushed, and subitems re-read. If it is a - name, it will be opened in a new frame. - -`Mouse-3' - Activate the speedbar menu. The item selected affects the line - clicked, not the line where the cursor was. - -`Mouse-1 (mode line)' - Activate the menu. This affects the item the cursor is on before - the click, since the mouse was not clicked on anything. - -`C-Mouse-1' - Buffers sub-menu. The buffer in the attached frame is switched. - - When the mouse moves over buttons in speedbar, details of that item -should be displayed in the minibuffer of the attached frame. Sometimes -this can contain extra information such as file permissions, or tag -location. - - -File: speedbar.info, Node: Displays Submenu, Prev: Mouse Bindings, Up: Basic Navigation - -Displays Submenu -================ - -You can display different data by using different display modes. These -specialized modes make it easier to navigate the relevant pieces of -information, such as files and directories, or buffers. - - In the main menu, found by clicking `Mouse-3', there is a submenu -labeled `Displays'. This submenu lets you easily choose between -different display modes. - - The contents are modes currently loaded into emacs. By default, this -would include Files, Quick Buffers, and Buffers. Other major display -modes such as Info are loaded separately. - - -File: speedbar.info, Node: File Mode, Next: Buffer Mode, Prev: Basic Navigation, Up: Top - -File Mode -********* - -File mode displays a summary of your current directory. You can display -files in the attached frame, or summarize the tags found in files. You -can even see if a file is checked out of a version control system, or -has some associated object file. - - Advanced behavior, like copying and renaming files, is also provided. - -* Menu: - -* Directory Display:: What the display means. -* Hidden Files:: How to display hidden files. -* File Key Bindings:: Performing file operations. - - -File: speedbar.info, Node: Directory Display, Next: Hidden Files, Prev: File Mode, Up: File Mode - -Directory Display -================= - -There are three major sections in the display. The first line or two is -the root directory speedbar is currently viewing. You can jump to one -of the parent directories by clicking on the name of the directory you -wish to jump to. - - Next, directories are listed. A directory starts with the group -indicator button `<+>'. Clicking the directory name makes speedbar -load that directory as the root directory for its display. Clicking the -`<+>' button will list all directories and files beneath. - - Next, files are listed. Files start with the group indicator `[+]' -or `[?]'. You can jump to a file in the attached frame by clicking on -the file name. You can expand a file and look at its tags by clicking -on the `[+]' symbol near the file name. - - A typical session might look like this: - - ~/lisp/ - <+> checkdoc - <+> eieio - <-> speedbar - [+] Makefile - [+] rpm.el # - [+] sb-gud.el # - [+] sb-info.el # - [+] sb-rmail.el # - [+] sb-w3.el - [-] speedbar.el *! - {+} Types - {+} Variables - {+} def (group) - {+} speedbar- - [+] speedbar.texi * - <+> testme - [+] align.el - [+] autoconf.el - - In this example, you can see several directories. The directory -`speedbar' has been opened inline. Inside the directory `speedbar', -the file `speedbar.el' has its tags exposed. These tags are extensive, -and they are summarized into tag groups. - - Files get additional boolean flags associated with them. Valid -flags are: - -`*' - This file has been checked out of a version control system. *Note - Version Control::. - -`#' - This file has an up to date object file associated with it. The - variable `speedbar-obj-alist' defines how speedbar determines this - value. - -`!' - This file has an out of date object file associated with it. - - A Tag group is prefixed with the symbol `{+}'. Clicking this symbol -will show all symbols that have been organized into that group. -Different types of files have unique tagging methods as defined by their -major mode. Tags are generated with either the `imenu' package, or -through the `etags' interface. - - Tag groups are defined in multiple ways which make it easier to find -the tag you are looking for. Imenu keywords explicitly create groups, -and speedbar will automatically create groups if tag lists are too long. - - In our example, Imenu created the groups `Types' and `Variables'. -All remaining top-level symbols are then regrouped based on the -variable `speedbar-tag-hierarchy-method'. The subgroups `def' and -`speedbar-' are groupings where the first few characters of the given -symbols are specified in the group name. Some group names may say -something like `speedbar-t to speedbar-v', indicating that all symbols -which alphabetically fall between those categories are included in that -sub-group. *Note Tag Hierarchy Methods::. - - -File: speedbar.info, Node: Hidden Files, Next: File Key Bindings, Prev: Directory Display, Up: File Mode - -Hidden Files -============ - -On GNU and Unix systems, a hidden file is a file whose name starts with -a period. They are hidden from a regular directory listing because the -user is not generally interested in them. - - In speedbar, a hidden file is a file which isn't very interesting and -might prove distracting to the user. Any uninteresting files are -removed from the File display. There are two levels of uninterest in -speedbar. The first level of uninterest are files which have no -expansion method, or way of extracting tags. You can define which -files are interesting with `speedbar-supported-extension-expressions'. -The second level is any file that matches the same pattern used for -completion in `find-file'. This is derived from the variable -`completion-ignored-extensions'. This filter will override the -supported extensions, so beif you add something to be supported, and it -doesn't appear, check for this. - - You can toggle the display of uninteresting files from the toggle -menu item `Show All Files'. This will display all level one hidden -files. These files will be shown with a `?' indicator. Level 2 hidden -files will still not be shown. - - Object files fall into the category of level 2 hidden files. You can -determine their presence by the `#' and `!' file indicators. *Note -Directory Display::. - - -File: speedbar.info, Node: File Key Bindings, Prev: Hidden Files, Up: File Mode - -File Key Bindings -================= - -File mode has key bindings permitting different file system operations -such as copy or rename. These commands all operate on the "current -file". In this case, the current file is the file at point, or clicked -on when pulling up the menu. - -`U' - Move the entire speedbar display up one directory. - -`I' - Display information in the minibuffer about this line. This is - the same information shown when navigating with `n' and `p', or - moving the mouse over an item. - -`B' - Byte compile the Emacs Lisp file on this line. - -`L' - Load the Emacs Lisp file on this line. If a `.elc' file exists, - optionally load that. - -`C' - Copy the current file to some other location. - -`R' - Rename the current file, possibly moving it to some other location. - -`D' - Delete the current file. - -`O' - Delete the current file's object file. Use the symbols `#' and - `!' to determine if there is an object file available. - - One menu item toggles the display of all available files. By -default, only files which Emacs understands, and knows how to convert -into a tag list, are shown. By showing all files, additional files -such as text files are also displayed, but they are prefixed with the -`[?]' symbol. This means that it is a file, but Emacs doesn't know how -to expand it. - - -File: speedbar.info, Node: Buffer Mode, Next: Minor Modes, Prev: File Mode, Up: Top - -Buffer Mode -*********** - -Buffer mode is very similar to File mode, except that instead of -tracking the current directory and all files available there, the -current list of Emacs buffers is shown. - - These buffers can have their tags expanded in the same way as files, -and uses the same unknown file indicator (*note File Mode::). - - Buffer mode does not have file operation bindings, but the following -buffer specific key bindings are available: - -`k' - Kill this buffer. Do not touch its file. - -`r' - Revert this buffer, reloading from disk. - - In addition to Buffer mode, there is also Quick Buffer mode. In -fact, Quick Buffers is bound to the `b' key. The only difference -between Buffers and Quick Buffers is that after one operation is -performed which affects the attached frame, the display is immediately -reverted to the last displayed mode. - - Thus, if you are in File mode, and you need quick access to a buffer, -press `b', click on the buffer you want, and speedbar will revert back -to File mode. - - -File: speedbar.info, Node: Minor Modes, Next: Customizing, Prev: Buffer Mode, Up: Top - -Minor Display Modes -******************* - -For some buffers, a list of files and tags makes no sense. This could -be because files are not currently in reference (such as web pages), or -that the files you might be interested have special properties (such as -email folders.) - - In these cases, a minor display mode is needed. A minor display mode -will override any major display mode currently being displayed for the -duration of the specialized buffer's use. Minor display modes will -follow the general rules of their major counterparts in terms of key -bindings and visuals, but will have specialized behaviors. - -* Menu: - -* RMAIL:: Managing folders in speedbar -* Info:: Browsing topics in speedbar -* GDB:: Managing the current stack trace in speedbar - - -File: speedbar.info, Node: RMAIL, Next: Info, Prev: Minor Modes, Up: Minor Modes - -RMAIL -===== - -When using RMAIL, speedbar will display two sections. The first is a -layer one reply button. Clicking here will initialize a reply buffer -showing only this email address in the `To:' field. - - The second section lists all RMAIL folders in the same directory as -your main RMAIL folder. The general rule is that RMAIL folders always -appear in all caps, or numbers. It is possible to save mail in folders -with lower case letters, but there is no clean way of detecting such -RMAIL folders without opening them all. - - Each folder can be visited by clicking the name. You can move mail -from the current RMAIL folder into a different folder by clicking the -`' button. The `M' stands for Move. - - In this way you can manage your existing RMAIL folders fairly easily -using the mouse. - - -File: speedbar.info, Node: Info, Next: GDB, Prev: RMAIL, Up: Minor Modes - -Info -==== - -When browsing Info files, all local relevant information is displayed in -the info buffer and a topical high-level view is provided in speedbar. -All top-level info nodes are shown in the speedbar frame, and can be -jumped to by clicking the name. - - You can open these nodes with the `[+]' button to see what sub-topics -are available. Since these sub-topics are not examined until you click -the `[+]' button, sometimes a `[?]' will appear when you click on a -`[+]', indicating that there are no sub-topics. - - -File: speedbar.info, Node: GDB, Prev: Info, Up: Minor Modes - -GDB -=== - -If you are debugging an application with GDB in Emacs, speedbar can show -you the current stack when the current buffer is the `*gdb*' buffer. -Usually, it will just report that there is no stack, but when the -application is stopped, the current stack will be shown. - - You can click on any stack element and gdb will move to that stack -level. You can then check variables local to that level at the GDB -prompt. - - This mode has the unfortunate side-effect of breaking GDB's repeat -feature when you hit `RET' since your previous command is overridden -with a stack fetching command. - - -File: speedbar.info, Node: Customizing, Next: Extending, Prev: Minor Modes, Up: Top - -Customizing -*********** - -Speedbar is highly customizable, with a plethora of control elements. -Since speedbar is so visual and reduces so much information, this is an -important aspect of its behavior. - - In general, there are three custom groups you can use to quickly -modify speedbar's behavior. - -`speedbar' - Basic speedbar behaviors. - -`speedbar-vc' - Customizations regarding version control handling. - -`speedbar-faces' - Customize speedbar's many colors and fonts. - -* Menu: - -* Frames and Faces:: Visible behaviors. -* Tag Hierarchy Methods:: Customizing how tags are displayed. -* Version Control:: Adding new VC detection modes. -* Hooks:: The many hooks you can use. - - -File: speedbar.info, Node: Frames and Faces, Next: Tag Hierarchy Methods, Prev: Customizing, Up: Customizing - -Frames and Faces -================ - -There are several faces speedbar generates to provide a consistent -color scheme across display types. You can customize these faces using -your favorite method. They are: - -speedbar-button-face - Face used on expand/contract buttons. - -speedbar-file-face - Face used on Files. Should also be used on non-directory like - nodes. - -speedbar-directory-face - Face used for directories, or nodes which consist of groups of - other nodes. - -speedbar-tag-face - Face used for tags in a file, or for leaf items. - -speedbar-selected-face - Face used to highlight the selected item. This would be the - current file being edited. - -speedbar-highlight-face - Face used when the mouse passes over a button. - - You can also customize speedbar's initial frame parameters. How -this is accomplished is dependent on your platform being Emacs or -XEmacs. - - In Emacs, change the alist `speedbar-frame-parameters'. This -variable is used to set up initial details. Height is also -automatically added when speedbar is created, though you can override -it. - - In XEmacs, change the plist `speedbar-frame-plist'. This is the -XEmacs way of doing the same thing. - - -File: speedbar.info, Node: Tag Hierarchy Methods, Next: Version Control, Prev: Frames and Faces, Up: Customizing - -Tag Hierarchy Methods -===================== - -When listing tags within a file, it is possible to get an annoyingly -long list of entries. Imenu (which generates the tag list in Emacs) -will group some classes of items automatically. Even here, however, -some tag groups can be quite large. - - To solve this problem, tags can be grouped into logical units -through a hierarchy processor. The specific variable to use is -`speedbar-tag-hierarchy-method'. There are several methods that can be -applied in any order. They are: - -`speedbar-trim-words-tag-hierarchy' - Find a common prefix for all elements of a group, and trim it off. - -`speedbar-prefix-group-tag-hierarchy' - If a group is too large, place sets of tags into bins based on - common prefixes. - -`speedbar-simple-group-tag-hierarchy' - Take all items in the top level list not in a group, and stick - them into a `Tags' group. - -`speedbar-sort-tag-hierarchy' - Sort all items, leaving groups on top. - - You can also add your own functions to reorganize tags as you see -fit. - - Some other control variables are: - -`speedbar-tag-group-name-minimum-length' - Default value: 4. - - The minimum length of a prefix group name before expanding. Thus, - if the `speedbar-tag-hierarchy-method' includes - `speedbar-prefix-group-tag-hierarchy' and one such group's common - characters is less than this number of characters, then the group - name will be changed to the form of: - - worda to wordb - - instead of just - - word - - This way we won't get silly looking listings. - -`speedbar-tag-split-minimum-length' - Default value: 20. - - Minimum length before we stop trying to create sub-lists in tags. - This is used by all tag-hierarchy methods that break large lists - into sub-lists. - -`speedbar-tag-regroup-maximum-length' - Default value: 10. - - Maximum length of submenus that are regrouped. If the regrouping - option is used, then if two or more short subgroups are next to - each other, then they are combined until this number of items is - reached. - - -File: speedbar.info, Node: Version Control, Next: Hooks, Prev: Tag Hierarchy Methods, Up: Customizing - -Version Control -=============== - -When using the file mode in speedbar, information regarding a version -control system adds small details to the display. If a file is in a -version control system, and is "checked out" or "locked" locally, an -asterisk `*' appears at the end of the file name. In addition, the -directory name for Version Control systems are left out of the speedbar -display. - - You can easily add new version control systems into speedbar's -detection scheme. To make a directory "disappear" from the list, use -the variable `speedbar-directory-unshown-regexp'. - - Next, you need to write entries for two hooks. The first is -`speedbar-vc-path-enable-hook' which will enable a VC check in the -current directory for the group of files being checked. Your hook -function should take one parameter (the directory to check) and return -`t' if your VC method is in control here. - - The second function is `speedbar-vc-in-control-hook'. This hook -takes two parameters, the PATH of the file to check, and the FILE name. -Return `t' if you want to have the asterisk placed near this file. - - Lastly, you can change the VC indicator using the variable -`speedbar-vc-indicator', and specify a single character string. - - -File: speedbar.info, Node: Hooks, Prev: Version Control, Up: Customizing - -Hooks -===== - -There are several hooks in speedbar allowing custom behaviors to be -added. Available hooks are: - -`speedbar-visiting-file-hook' - Hooks run when speedbar visits a file in the selected frame. - -`speedbar-visiting-tag-hook' - Hooks run when speedbar visits a tag in the selected frame. - -`speedbar-load-hook' - Hooks run when speedbar is loaded. - -`speedbar-reconfigure-keymaps-hook' - Hooks run when the keymaps are regenerated. Keymaps are - reconfigured whenever modes change. This will let you add custom - key bindings. - -`speedbar-before-popup-hook' - Hooks called before popping up the speedbar frame. New frames are - often popped up when "power clicking" on an item to view it. - -`speedbar-before-delete-hook' - Hooks called before deleting or hiding the speedbar frame. - -`speedbar-mode-hook' - Hooks called after creating a speedbar buffer. - -`speedbar-timer-hook' - Hooks called after running the speedbar timer function. - -`speedbar-scanner-reset-hook' - Hook called whenever generic scanners are reset. Set this to - implement your own scanning or rescan safe functions with state - data. - - -File: speedbar.info, Node: Extending, Next: Index, Prev: Customizing, Up: Top - -Extending -********* - -Speedbar can run different types of Major display modes such as Files -(*note File Mode::), and Buffers (*note Buffer Mode::). It can also -manage different minor display modes for use with buffers handling -specialized data. - - These major and minor display modes are handled through an extension -system which permits specialized keymaps and menu extensions, in -addition to a unique rendering function. You can also specify a wide -range of tagging functions. The default uses `imenu', but new tagging -methods can be easily added. In this chapter, you will learn how to -write your own major or minor display modes, and how to create -specialized tagging functions. - -* Menu: - -* Minor Display Modes:: How to create a minor display mode. -* Major Display Modes:: How to create a major display mode. -* Tagging Extensions:: How to create your own tagging methods. -* Creating a display:: How to insert buttons and hierarchies. - - -File: speedbar.info, Node: Minor Display Modes, Next: Major Display Modes, Prev: Extending, Up: Extending - -Minor Display Modes -=================== - -A "minor display mode" is a mode useful when using a specific type of -buffer. This mode might not be useful for any other kind of data or -mode, or may just be more useful that a files or buffers based mode when -working with a specialized mode. - - Examples that already exist for speedbar include RMAIL, Info, and -gdb. These modes display information specific to the major mode shown -in the attached frame. - - To enable a minor display mode in your favorite Major mode, follow -these steps. The string `NAME' is the name of the major mode being -augmented with speedbar. - - 1. Create the keymap variable `NAME-speedbar-key-map'. - - 2. Create a function, named whatever you like, which assigns values - into your keymap. Use this command to create the keymap before - assigning bindings: - - (setq NAME-speedbar-key-map (speedbar-make-specialized-keymap)) - - This function creates a special keymap for use in speedbar. - - 3. Call your install function, or assign it to a hook like this: - - (if (featurep 'speedbar) - (NAME-install-speedbar-variables) - (add-hook 'speedbar-load-hook 'NAME-install-speedbar-variables)) - - 4. Create an easymenu compatible vector named - `NAME-speedbar-menu-items'. This will be spliced into speedbar's - control menu. - - 5. Create a function called `NAME-speedbar-buttons'. This function - should take one variable, which is the buffer for which it will - create buttons. At this time `(current-buffer)' will point to the - uncleared speedbar buffer. - - When writing `NAME-speedbar-buttons', the first thing you will want -to do is execute a check to see if you need to re-create your display. -If it needs to be cleared, you need to erase the speedbar buffer -yourself, and start drawing buttons. *Note Creating a display::. - - -File: speedbar.info, Node: Major Display Modes, Next: Tagging Extensions, Prev: Minor Display Modes, Up: Extending - -Major Display Modes -=================== - -Creating a "Major Display Mode" for speedbar requires authoring a -keymap, an easy-menu segment, and writing several functions. These -items can be given any name, and are made the same way as in a minor -display mode (*note Minor Display Modes::). Once this is done, these -items need to be registered. - - Because this setup activity may or may not have speedbar available -when it is being loaded, it is necessary to create an install function. -This function should create and initialize the keymap, and add your -expansions into the customization tables. - - When creating the keymap, use the function -`speedbar-make-specialized-keymap' instead of other keymap making -functions. This will provide you with the initial bindings needed. -Some common speedbar functions you might want to bind are: - -`speedbar-edit-line' - Edit the item on the current line. - -`speedbar-expand-line' - Expand the item under the cursor. With a numeric argument - (`C-u'), flush cached data before expanding. - -`speedbar-contract-line' - Contract the item under the cursor. - - These function require that function `speedbar-line-path' be -correctly overloaded to work. - - Next, register your extension like this; - - (speedbar-add-expansion-list '("MyExtension" - MyExtension-speedbar-menu-items - MyExtension-speedbar-key-map - MyExtension-speedbar-buttons)) - - There are no limitations to the names you use. - - The first parameter is the string representing your display mode. -The second parameter is a variable name containing an easymenu -compatible menu definition. This will be stuck in the middle of -speedbar's menu. The third parameter is the variable name containing -the keymap we discussed earlier. The last parameter is a function -which draws buttons for your mode. This function must take two -parameters. The directory currently being displayed, and the depth at -which you should start rendering buttons. The function will then draw -(starting at the current cursor position) any buttons deemed necessary -based on the input parameters. *Note Creating a display::. - - Next, you need to register function overrides. This may look -something like this: - - (speedbar-add-mode-functions-list - '("MYEXTENSION" - (speedbar-item-info . MyExtension-speedbar-item-info) - (speedbar-line-path . MyExtension-speedbar-line-path))) - - The first element in the list is the name of you extension. The -second is an alist of functions to overload. The function to overload -is first, followed by what you want called instead. - - For `speedbar-line-path' your function should take an optional DEPTH -parameter. This is the starting depth for heavily indented lines. If -it is not provided, you can derive it like this: - - (save-match-data - (if (not depth) - (progn - (beginning-of-line) - (looking-at "^\\([0-9]+\\):") - (setq depth (string-to-int (match-string 1))))) - -where the depth is stored as invisible text at the beginning of each -line. - - The path returned should be the full path name of the file associated -with that line. If the cursor is on a tag, then the file containing -that tag should be returned. This is critical for built in file based -functions to work (meaning less code for you to write). If your display -does not deal in files, you do not need to overload this function. - - The function `speedbar-item-info', however, is very likely to need -overloading. This function takes no parameters and must derive a text -summary to display in the minibuffer. - - There are several helper functions you can use if you are going to -use built in tagging. These functions can be `or'ed since each one -returns non-nil if it displays a message. They are: - -`speedbar-item-info-file-helper' - This takes an optional FILENAME parameter. You can derive your own - filename, or it will derive it using a (possibly overloaded) - function `speedbar-line-file'. It shows details about a file. - -`speedbar-item-info-tag-helper' - If the current line is a tag, then display information about that - tag, such as its parent file, and location. - - Your custom function might look like this: - - (defun MyExtension-item-info () - "Display information about the current line." - (or (speedbar-item-info-tag-helper) - (message "Interesting detail."))) - - Once you have done all this, speedbar will show an entry in the -`Displays' menu declaring that your extension is available. - - -File: speedbar.info, Node: Tagging Extensions, Next: Creating a display, Prev: Major Display Modes, Up: Extending - -Tagging Extensions -================== - -It is possible to create new methods for tagging files in speedbar. To -do this, you need two basic functions, one function to fetch the tags -from a buffer, the other to insert them below the filename. - - - Function: my-fetch-dynamic-tags file - Parse FILE for a list of tags. Return the list, or `t' if there - was an error. FILE is not necessarily available as an buffer when - your function is called. Be sure to load it if it is needed with - code like this: - - (save-excursion - (set-buffer (find-file-noselect file)) - ... - ) - - The non-error return value can be anything, as long as it can be -inserted by its paired function: - - - Function: my-insert-tag-list level lst - Insert a list of tags LST started at indentation level LEVEL. - Creates buttons for each tag, and provides any other display - information required. - - It is often useful to use `speedbar-create-tag-hierarchy' on your -token list. See that function's documentation for details on what it -requires. - - Once these two functions are written, modify the variable -`speedbar-dynamic-tags-function-list' to include your parser at the -beginning, like this: - - (add-to-list 'speedbar-dynamic-tags-function-list - '(my-fetch-dynamic-tags . my-insert-tag-list)) - - If your parser is only good for a few types of files, make sure that -it is either a buffer local modification, or that the tag generator -returns `t' for non valid buffers. - - -File: speedbar.info, Node: Creating a display, Prev: Tagging Extensions, Up: Extending - -Creating a display -================== - -Rendering a display in speedbar is completely flexible. When your -button function is called, see *Note Minor Display Modes::, and *Note -Major Display Modes::, you have control to `insert' anything you want. - - The conventions allow almost anything to be inserted, but several -helper functions are provided to make it easy to create the standardized -buttons. - - To understand the built in functions, each `button' in speedbar -consists of four important pieces of data. The text to be displayed, -token data to be associated with the text, a function to call, and some -face to display it in. - - When a function is provided, then that text becomes mouse activated, -meaning the mouse will highlight the text. - - Additionally, for data which can form deep trees, each line is given -a depth which indicates how far down the tree it is. This information -is stored in invisible text at the beginning of each line, and is used -by the navigation commands. - - - Function: speedbar-insert-button text face mouse function &optional - token prevline - This function inserts one button into the current location. TEXT - is the text to insert. FACE is the face in which it will be - displayed. MOUSE is the face to display over the text when the - mouse passes over it. FUNCTION is called whenever the user clicks - on the text. - - The optional argument TOKEN is extra data to associated with the - text. Lastly PREVLINE should be non-nil if you want this line to - appear directly after the last button which was created instead of - on the next line. - - - Function: speedbar-make-tag-line exp-button-type exp-button-char - exp-button-function exp-button-data tag-button - tag-button-function tag-button-data tag-button-face depth - Create a tag line with EXP-BUTTON-TYPE for the small expansion - button. This is the button that expands or contracts a node (if - applicable), and EXP-BUTTON-CHAR the character in it (`+', `-', - `?', etc). EXP-BUTTON-FUNCTION is the function to call if it's - clicked on. Button types are `'bracket', `'angle', `'curly', - `'expandtag', `'statictag', or nil. EXP-BUTTON-DATA is extra data - attached to the text forming the expansion button. - - Next, TAG-BUTTON is the text of the tag. TAG-BUTTON-FUNCTION is - the function to call if clicked on, and TAG-BUTTON-DATA is the - data to attach to the text field (such a tag positioning, etc). - TAG-BUTTON-FACE is a face used for this type of tag. - - Lastly, DEPTH shows the depth of expansion. - - This function assumes that the cursor is in the speedbar window at - the position to insert a new item, and that the new item will end - with a CR. - - - Function: speedbar-insert-generic-list level list expand-fun find-fun - At LEVEL, (the current indentation level desired) insert a generic - multi-level alist LIST. Associations with lists get `{+}' tags - (to expand into more nodes) and those with positions or other data - just get a `>' as the indicator. `{+}' buttons will have the - function EXPAND-FUN and the token is the `cdr' list. The token - name will have the function FIND-FUN and not token. - - Each element of the list can have one of these forms: - - `(NAME . marker-or-number)' - One tag at this level. - - `(NAME (NAME . marker-or-number) (NAME . marker-or-number) ... )' - One group of tags. - - `(NAME marker-or-number (NAME . marker-or-number) ... )' - One Group of tags where the group has a starting position. - - When you use `speedbar-insert-generic-list', there are some - variables you can set buffer-locally to change the behavior. The - most obvious is `speedbar-tag-hierarchy-method'. *Note Tag - Hierarchy Methods::. - - - Variable: speedbar-generic-list-group-expand-button-type - This is the button type used for groups of tags, whether - expanded or added in via a hierarchy method. Two good values - are `'curly' and `'expandtag'. Curly is the default button, - and `'expandtag' is useful if the groups also has a position. - - - Variable: speedbar-generic-list-tag-button-type - This is the button type used for a single tag. Two good - values are `nil' and `'statictag'. `nil' is the default, and - `'statictag' has the same width as `'expandtag'. - - - -File: speedbar.info, Node: Index, Prev: Extending, Up: Top - -Concept Index -************* - -* Menu: - -* buffer mode: Buffer Mode. -* common keys: Basic Key Bindings. -* create major display mode: Major Display Modes. -* create minor display mode: Minor Display Modes. -* creating a display: Creating a display. -* customizing: Customizing. -* directory display: Directory Display. -* displays submenu: Displays Submenu. -* extending: Extending. -* faces: Frames and Faces. -* file flags: Directory Display. -* file key bindings: File Key Bindings. -* file mode: File Mode. -* frame parameters: Frames and Faces. -* gdb: GDB. -* groups: Basic Visuals. -* gud: GDB. -* hidden files: Hidden Files. -* hooks: Hooks. -* Info: Info. -* introduction: Introduction. -* key bindings: Basic Key Bindings. -* minor display modes: Minor Modes. -* mode switching hotkeys: Basic Key Bindings. -* mouse bindings: Mouse Bindings. -* my-fetch-dynamic-tags: Tagging Extensions. -* my-insert-tag-list: Tagging Extensions. -* navigation: Basic Key Bindings. -* power click: Mouse Bindings. -* quitting speedbar: Basic Key Bindings. -* refresh speedbar display: Basic Key Bindings. -* RMAIL: RMAIL. -* scrolling in speedbar: Basic Key Bindings. -* slowbar mode: Basic Key Bindings. -* speedbar-before-delete-hook: Hooks. -* speedbar-before-popup-hook: Hooks. -* speedbar-button-face: Frames and Faces. -* speedbar-contract-line: Major Display Modes. -* speedbar-create-tag-hierarchy: Tagging Extensions. -* speedbar-directory-face: Frames and Faces. -* speedbar-directory-unshown-regexp: Version Control. -* speedbar-dynamic-tags-function-list: Tagging Extensions. -* speedbar-edit-line: Major Display Modes. -* speedbar-expand-line: Major Display Modes. -* speedbar-file-face: Frames and Faces. -* speedbar-frame-parameters, Emacs: Frames and Faces. -* speedbar-frame-plist, XEmacs: Frames and Faces. -* speedbar-get-focus: Introduction. -* speedbar-highlight-face: Frames and Faces. -* speedbar-insert-button: Creating a display. -* speedbar-insert-generic-list: Creating a display. -* speedbar-item-info: Major Display Modes. -* speedbar-item-info-file-helper: Major Display Modes. -* speedbar-item-info-tag-helper: Major Display Modes. -* speedbar-line-path: Major Display Modes. -* speedbar-load-hook: Hooks. -* speedbar-make-specialized-keymap: Major Display Modes. -* speedbar-make-tag-line: Creating a display. -* speedbar-mode-hook: Hooks. -* speedbar-obj-alist: Directory Display. -* speedbar-prefix-group-tag-hierarchy: Tag Hierarchy Methods. -* speedbar-reconfigure-keymaps-hook: Hooks. -* speedbar-scanner-reset-hook: Hooks. -* speedbar-selected-face: Frames and Faces. -* speedbar-simple-group-tag-hierarchy: Tag Hierarchy Methods. -* speedbar-sort-tag-hierarchy: Tag Hierarchy Methods. -* speedbar-tag-face: Frames and Faces. -* speedbar-tag-group-name-minimum-length: Tag Hierarchy Methods. -* speedbar-tag-hierarchy-method: Tag Hierarchy Methods. -* speedbar-tag-regroup-maximum-length: Tag Hierarchy Methods. -* speedbar-tag-split-minimum-length: Tag Hierarchy Methods. -* speedbar-timer-hook: Hooks. -* speedbar-trim-words-tag-hierarchy: Tag Hierarchy Methods. -* speedbar-vc-in-control-hook: Version Control. -* speedbar-vc-indicator: Version Control. -* speedbar-vc-path-enable-hook: Version Control. -* speedbar-visiting-file-hook: Hooks. -* speedbar-visiting-tag-hook: Hooks. -* tag groups: Tag Hierarchy Methods. -* tag hierarchy: Tag Hierarchy Methods. -* tag sorting: Tag Hierarchy Methods. -* tags: Basic Visuals. -* vc extensions: Version Control. -* version control: Version Control. -* visuals: Basic Visuals. - - - -Tag Table: -Node: Top1260 -Node: Introduction3042 -Node: Basic Navigation4602 -Node: Basic Key Bindings5043 -Node: Basic Visuals7225 -Node: Mouse Bindings11092 -Node: Displays Submenu12709 -Node: File Mode13381 -Node: Directory Display13984 -Node: Hidden Files17014 -Node: File Key Bindings18455 -Node: Buffer Mode19881 -Node: Minor Modes20992 -Node: RMAIL21844 -Node: Info22734 -Node: GDB23333 -Node: Customizing23992 -Node: Frames and Faces24799 -Node: Tag Hierarchy Methods26119 -Node: Version Control28331 -Node: Hooks29665 -Node: Extending30897 -Node: Minor Display Modes31939 -Node: Major Display Modes33922 -Node: Tagging Extensions38681 -Node: Creating a display40325 -Node: Index44851 - -End Tag Table diff --git a/xemacs-packages/info/tempo.info b/xemacs-packages/info/tempo.info deleted file mode 100644 index adc5f8f8..00000000 --- a/xemacs-packages/info/tempo.info +++ /dev/null @@ -1,588 +0,0 @@ -This is tempo.info, produced by makeinfo version 4.7 from tempo.texi. - - This is Edition 0.0(prerelease), last updated 8 June 1995, of `the -Tempo manual', for `tempo.el' version 1.2.3. - - Copyright (C) 1995 David Kågedal - - 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. - - Permission is granted to copy and distribute modified versions of -this manual under the conditions for verbatim copying, provided also -that the section entitled "Copying"is included exactly as in the -original, and provided that the entire resulting derived work is -distributed under the terms of a permission notice identical to this -one. - - Permission is granted to copy and distribute translations of this -manual into another language, under the above conditions for modified -versions, except that this permission notice may be stated in a -translation approved by the Free Software Foundation. - - -File: tempo.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir) - -Tempo -***** - -This is Edition 0.0(prerelease), last updated 8 June 1995, of the -manual for `tempo.el' version 1.2.3. - - Tempo is a template writing package for GNU Emacs. - -* Menu: - -* Overview:: An overview of tempo -* Templates:: Templates -* Options:: Controlling tempo behaviour -* The mark list:: The mark list -* The save list:: The save list -* Adding tempo:: Adding tempo support -* Concept index:: Concept index -* Function index:: Function index -* Variable index:: Variable index -* Copying:: The terms of this distribution - - --- The Detailed Node Listing --- - -Overview - -* A short example:: Example -* Basics:: Tempo basics -* Tags overview:: Tag lists and automatic completion - -Templates - -* Syntax:: Template syntax -* Elements:: Template elements -* Defining your own elements:: Defining your own elements - - -File: tempo.info, Node: Overview, Next: Templates, Prev: Top, Up: Top - -1 Overview -********** - -Tempo is a package that provides writers and users of Emacs editing -modes with functions for creating and inserting templates into an Emacs -buffer in a convenient way. The template insertion commands can be bound -to keys or can be automatically expanded from words written in the -buffer. - -* Menu: - -* A short example:: Example -* Basics:: Tempo basics -* Tags overview:: Tag lists and automatic completion - - -File: tempo.info, Node: A short example, Next: Basics, Prev: Overview, Up: Overview - -1.1 A short example -=================== - -A good way to get a general idea of what `tempo' is about is through an -introductory example. The follwoing short example of a `tempo' template -builds a template for inserting a for loop in a C program. - - (tempo-define-template "c-for" - '("for (" - (p "Initialization: ") "," - (p "Increment: ") "," - (p "End condition: ") " {" n> - r n> - "}" > %)) - - This creates a command `tempo-template-c-for' which, when executed, -inserts the following at the point: - - for (-!-,,) { - - } - - The point is placed at the -!-, which is not included in the text. -The command `M-x tempo-forward-mark' will, at this point, move the -point to after the first comma. Successive executions will move the -point to after the second comma, to the second line and to after the -closing brace. In a mode customized for tempo, `tempo-forward-mark' -will of course be bound to some convenient keystroke combination. - - If the variable `tempo-interactive' was set to non-nil, the result -would have been a little different. Instead of inserting nothing inside -the parenthesis, the user would be prompted for the text to be written -in the three positions, with the prompt strings `Initialization:', -`Increment:' and `End condition:', respectively, and the point would be -placed on the second line, properly indented. - - Also, if there was a currently active region (*note Regions: -(emacs)Mark.), and the template command was used with a prefix argument -(such as `C-u M-x tempo-template-c-for') the for loop would be inserted -around the region, so that the contents of the region would be placed -between the the opening and closing braces. - - -File: tempo.info, Node: Basics, Next: Tags overview, Prev: A short example, Up: Overview - -1.2 Tempo basics -================ - -The most inportant function in tempo is `tempo-define-template', which -defines a template, together with a function to insert it. *Note -Syntax::, for a complete description of this function. - - A simple definition has the form - - (tempo-define-template NAME ELEMENTS) - - When this is evaluated, the variable `tempo-template-NAME' is bound -to ELEMENTS, and the function `tempo-template-NAME' is a command that -will insert the template when invoked. - - The ELEMENTS is supplied as a list whose elements have different -meanings. Strings are simply inserted and lisp expressions are evaluated -to strings. There are also some symbols with special meanings, such as: - -`p' -`(p PROMPT [NAME])' - The symbol `p' marks a "hot spot" in a template. When this is - encountered, the current position of the point is saved as a - marker and saved on the `tempo-marks' list. These marks can later - easily be jumped to with the functions `tempo-forward-mark' and - `tempo-backward-mark'. - - If the form `(p PROMPT)' is used, and the variable - `tempo-interactive' is non-`nil', PROMPT is used to prompt the - user for a string in the minibuffer. If `tempo-interactive' is - `nil', it works just like a single `p'. - -`r' -`(r PROMPT)' - This works very much like `p', but when the template was invoked - with a prefix (as with `C-u TEMPLATE-CMD') and a region is active, - the template will be wrapped around the region, so that the text - of the region is placed where the `r' element is. - -`>' - A greater-than sign in a template means that the current line - should be indented according to the current mode. The function - `indent-line' is called, which usually gives the desired result. - not that often it is advisable to insert the `>' after the text to - be put on the line, to help the indention function. - - - There are many more thing you can put in a template, but the above -are some of the more essential. *Note Elements::, for a full -description of the possible template elements. - - -File: tempo.info, Node: Tags overview, Prev: Basics, Up: Overview - -1.3 Tag lists and automatic completion -====================================== - -If you supply a third argument TAG to `tempo-define-template', it can -be used as an abbrevation for the template. If you gave the C for-loop -in the example above a third argument `"for"', you could use the -completion capabilities in tempo. If you write in a buffer (with the -point at -!-): - - for-!- - - and type `M-x tempo-complete-tag', the string `foo' would be -replaced by the for-loop template. For this to be really useful, -`tempo-complete-tag' should be bound to a convenient keystroke. But -there is more power in this command. If you have defined a template with -the tag `procedure' you can hit `M-x tempo-complete-tag' as soon as you -have written a unique prefix of the word. For example - - proc-!- - - could expand to - - procedure -!-(); - begin - - end; - - when you type `M-x tempo-complete-tag' had you defined a Pascal -`procedure' template with the tag `procedure'. If there is no unique -match, `tempo-complete-tag' will complete the tag as much as possible, -and show a buffer with the possible completions. You can then type -another character, which will hopefully make it unique and press `M-x -tempo-complete-tag' again. - - Unfortunaly, there is no good way to use the mouse in the completion -buffer, although it claims to be so. - - -File: tempo.info, Node: Templates, Next: Options, Prev: Overview, Up: Top - -2 Templates -*********** - -This node describes the syntax and semantics of templates defined by -`tempo-define-template'. The first part deals with the syntax of the -function itself, while the second part describes the different template -elements. - -* Menu: - -* Syntax:: Template syntax -* Elements:: Template elements -* Defining your own elements:: Defining your own elements - - -File: tempo.info, Node: Syntax, Next: Elements, Prev: Templates, Up: Templates - -2.1 Template syntax -=================== - -Templates are defined with the function `tempo-define-tempalate'. - - -- Function: tempo-define-template name elements [tag documentation - [taglist]]] - Define a template named `tempo-template-NAME'. - - This function creates a template and binds it to a new variable - named `tempo-template-NAME'. It also creates a new command under - the same name. This command expands the template at the current - point, when invoked. - - The parameter ELEMENTS is a list of template elements. The - possible elements are described in *Note Elements::. - - If a TAG is supplied, it must be a string which is placed in - TAGLIST or `tempo-tags'. This string is used for automatic - completion. When `tempo-complete-tag' is called and TAG is - matched, the template template defined with TAG is inserted. - (*note Tags overview:: for more information on tags and tag lists) - - -File: tempo.info, Node: Elements, Next: Defining your own elements, Prev: Syntax, Up: Templates - -2.2 Template elements -===================== - -These are the predefined elements you can use in a template definition: - -`STRING' - A string in a template is first run through the string - preprocessors in `tempo-insert-string-functions' and the result is - inserted. - -`p' - This denotes an "interesting" position in the template. When the - template is expanded, this position is remembered with a mark on - the tempo-marks list. *Note The mark list::. - -`r' - This works in a similar way to the above `p' element, but if the - template command is given a prefix command, the current region is - placed here. This means that the preceding part of the template is - expanded before the region, and the rest is expanded after. There - can be only one `r' in a template. If `transient-mark-mode' is - active (*note Regions: (emacs)Mark.) the current region is used - and the prefix argument is ignored. - - If the variable `tempo-insert-region' is non-nil, the behaviour of - the `r' element is reversed. - -`(p PROMPT [NAME [NOINSERT]])' -`(P PROMPT [NAME [NOINSERT]])' -`(r PROMPT [NAME [NOINSERT]])' - If the variable `tempo-interactive' is nil, the elements `(p - ...))' and `(P ...)' work exactly like a single `p', and `(r ...)' - works like a single `r'. - - But, if you set `tempo-interactive' to `t' the user is prompted - for a string to insert when the template is expanded. The prompt - is taken from the `prompt' parameter. The element `(P ...)' works - like `(p ...)' with the exception that `tempo-interactive' is - forced to `t', which means that the user will always (almost - always, see below) be prompted. - - If you provide a NAME to any of these, and interactive prompting - is taking place, the resulting string is saved in a local list so - it can be inserted again later with the `(s ...)' element. *Note - The save list::, for more detailed information. - - As a special case, if the save list already contains something - under NAME, it is used directly, and no prompting is done, even - with a `(P ...)' element. - - The third argument, NOINSERT, disables insertion of text. If - `tempo-interactive' it non-`nil', and a NAME has been provided, - normally a string is read through the minibuffer and then inserted - and saved. When NOINSERT is non-`nil', nothing is inserted, and - the text is only saved for later. - - Stylistic conventions (invented by me) dictates that these elements - should be placed as early as possible in template definitions. - -`r>' - This element works like `r', but it also indents the region it is - expanded around. - -`(s NAME)' - This looks up NAME in the save list and inserts what it finds. - Note that if it finds a string, it is not run through the string - preprocessors. - -`&' - An ampersand inserts a newline if there are characters other than - whitespace before the current point on the line. Otherwise it does - nothing. This means that it makes sure that the following text - always starts a new line, possibly with some leading whitespace. - -`%' - A percent sign inserts a newline it there are characters other than - whitespace after the current point on the line. Otherwise it does - nothing. - -`n' - Simply inserts a newline character. - -`>' - This does not insert any text. Instead it indents the line - according to the major mode, by calling - `indent-according-to-mode'. Note that in order to get best - results, you often should place this after the text you want to - place on the line, as this could affect the indentation. - -`n>' - Inserts a newline and indents line. It is the same as a `n' - followed by a `>'. - -`o' - Works like `%', but leaves the point on the first line. Note that - this can cause great confusion if you are not careful. If the `o' - is the first element in a template which is inserted at the - beginning of a line, strange things happen. This is due to odd - behaviour in `open-line'. - -`nil' - A `nil' element is simply igonred. That means that a lisp - expression (see below) that returns nil does not insert anything. - -`(l ELEMENT1 ELEMENT2...)' - This element is most useful as a return value from a lisp - expression (see below). It inserts the elements using the same - rules as all template elements. - -`Anything else' - All unrecognized elements are checked to see if it is a - user-defined elemet. *Note Defining your own elements::. If isn't, - it is assumed to be a lisp expression and is evaluated in a normal - fashion. The result from such an expression is taken as a template - element an is inserted according to the usual rules. If you don't - want to insert anything, make your expression return `nil'. If you - want to insert more than one element, use the `(l ELEMENT1 - ELEMENT2...)' element. - - - -File: tempo.info, Node: Defining your own elements, Prev: Elements, Up: Templates - -2.3 Defining your own elements -============================== - -The variable `tempo-user-elements' contains a list of functions to call -when an unrecognized element is found. - - -- Variable: tempo-user-elements - A list of functions. When `tempo-insert' is called with an element - it doesn't recognize, it checks this list by calling each function - with the element as the single argument. A function in this list - should take a single element as argument and return `nil' for - elements it doesn't recognize. If it does recognize an element, it - should return another element to be inserted, e.g. a string. If - the function wants to return an authorative `nil', it could return - either `""' or `(l)'. - - Do not use any one-charachter tags for your own elements. These are -reserved for future tempo enhancements. - - -File: tempo.info, Node: Options, Next: The mark list, Prev: Templates, Up: Top - -3 Controlling tempo behaviour -***************************** - -There are some options available for the end user of tempo templates. - - -- User Option: tempo-interactive - Controls whether templates should prompt the user for strings to - insert via the minibuffer or let the user edit them in place. This - affects the behaviour of the template elements `(p ...)' and `(r - ...)'. - - -- User Option: tempo-insert-region - Controls the behaviour of the `r', `r>' and `(r ...)' tags. If - this variable is `nil', `r' elements will be treated just like `p' - elements, unless the template command is given a prefix (or a - non-nil argument), in which case the template will be inserted - around the region. *Note Elements::, for further information. If - this variable is non-`nil', the behaviour is reversed. - - In Transient Mark mode, this option is unused. - - -File: tempo.info, Node: The mark list, Next: The save list, Prev: Options, Up: Top - -4 The mark list -*************** - -When a `p' or `r' element is inserted, or when `tempo-interactive' is -nil and a `(p ...)', `(P ...)' or `(r ...)' element is inserted, the -current position in the buffer is remembered for later. A mark is -created and stored in the variable `tepo-marks'. - - There are two functions for moving between these marks. - - -- Function: tempo-forward-mark - Move the point to the first mark on the mark list that is after the - point. If there is no such mark, nothing happens. - - -- Function: tempo-backward-mark - Move the point to the last mark on the mark lit that is before the - point. If there is no such mark, nothing happens. - - This function adds marks to the mark list. - - -- Function: tempo-insert-mark mark - Inserts MARK in the mark list, while keeping the list sorted. If - there already is a mark at the same position, only one mark is - kept. - - -File: tempo.info, Node: The save list, Next: Adding tempo, Prev: The mark list, Up: Top - -5 The save list -*************** - -In a template, different elements can be saved for later with the -function `tempo-save-named' on a data structure called the "save list". -The most obvious way to do this, is to supply a NAME argument to the -`(p ...)' element or one of its likes, but it can also be done -programmatically with an explicit call to `tempo-save-named'. - - Every saved element is saved in the list `tempo-named-insertions'. -After inserting a template, this list is cleared, so things saved in it -does not live between insertions. You should use ordinary variables for -that. - - The following two functions could be used from inside a template. - - -- Function: tempo-save-named name data - Save DATA on the save list under the name NAME. The function - returns nil. - - -- Function: tempo-lookup-named name - Lookup some saved data under the name NAME. Returns the data if - NAME was found, and `nil' otherwise. - - The following functions deal with the save list, but should be -considered internal to tempo. - - -- Function: tempo-insert-named name - Insert the previous insertion saved under a named specified in - NAME. If there is no such name saved, a tempo mark is inserted. - - Note that if the data is a string, it will not be run through the - string processor. - - -- Function: tempo-forget-insertions - Clears the save list. - - -File: tempo.info, Node: Adding tempo, Next: Concept index, Prev: The save list, Up: Top - -6 Adding tempo support -********************** - - -File: tempo.info, Node: Concept index, Next: Function index, Prev: Adding tempo, Up: Top - -7 Concept index -*************** - -[index] -* Menu: - -* Adding elements: Defining your own elements. - (line 6) -* Customization: Options. (line 6) -* Defining elements: Defining your own elements. - (line 6) -* Defining new templates: Syntax. (line 6) -* Elements: Elements. (line 6) -* Template elements: Elements. (line 6) -* Templates: Syntax. (line 6) -* User options: Options. (line 6) -* User-defined elements: Defining your own elements. - (line 6) -* Writing templates: Syntax. (line 6) - - -File: tempo.info, Node: Function index, Next: Variable index, Prev: Concept index, Up: Top - -8 Function index -**************** - -[index] -* Menu: - -* tempo-backward-mark: The mark list. (line 18) -* tempo-define-template: Syntax. (line 10) -* tempo-forget-insertions: The save list. (line 38) -* tempo-forward-mark: The mark list. (line 14) -* tempo-insert-mark: The mark list. (line 24) -* tempo-insert-named: The save list. (line 31) -* tempo-lookup-named: The save list. (line 24) -* tempo-save-named: The save list. (line 20) - - -File: tempo.info, Node: Variable index, Next: Copying, Prev: Function index, Up: Top - -9 Variable index -**************** - -[index] -* Menu: - -* tempo-insert-region: Options. (line 15) -* tempo-interactive: Options. (line 9) -* tempo-named-insertions: The save list. (line 12) -* tempo-user-elements: Defining your own elements. - (line 10) - - -File: tempo.info, Node: Copying, Prev: Variable index, Up: Top - -10 Copying -********** - - - -Tag Table: -Node: Top991 -Node: Overview2119 -Node: A short example2670 -Node: Basics4592 -Node: Tags overview6759 -Node: Templates8172 -Node: Syntax8666 -Node: Elements9695 -Node: Defining your own elements14723 -Node: Options15654 -Node: The mark list16628 -Node: The save list17624 -Node: Adding tempo19088 -Node: Concept index19230 -Node: Function index20318 -Node: Variable index21057 -Node: Copying21567 - -End Tag Table diff --git a/xemacs-packages/info/tramp.info b/xemacs-packages/info/tramp.info deleted file mode 100644 index 0f9bc84e..00000000 --- a/xemacs-packages/info/tramp.info +++ /dev/null @@ -1,2114 +0,0 @@ -This is tramp.info, produced by makeinfo version 4.7 from tramp.texi. - - Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free -Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.2 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover texts - being "A GNU Manual", and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - "GNU Free Documentation License" in the Emacs manual. - - (a) The FSF's Back-Cover Text is: "You have freedom to copy and - modify this GNU Manual, like GNU software. Copies published by - the Free Software Foundation raise funds for GNU development." - - This document is part of a collection distributed under the GNU - Free Documentation License. If you want to distribute this - document separately from the collection, you can do so by adding a - copy of the license to the document, as described in section 6 of - the license. - -INFO-DIR-SECTION XEmacs -START-INFO-DIR-ENTRY -* TRAMP: (tramp). Transparent Remote Access, Multiple Protocol - XEmacs remote file access via rsh and rcp. -END-INFO-DIR-ENTRY - - -File: tramp.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir) - -TRAMP version 2.0.53 User Manual -******************************** - -This file documents TRAMP version 2.0.53, a remote file editing package -for XEmacs. - - TRAMP stands for `Transparent Remote (file) Access, Multiple -Protocol'. This package provides remote file editing, similar to -EFS. - - The difference is that EFS uses FTP to transfer files between the -local and the remote host, whereas TRAMP uses a combination of `rsh' -and `rcp' or other work-alike programs, such as `ssh'/`scp'. - - You can find the latest version of this document on the web at -`http://www.gnu.org/software/tramp/'. - - There is a mailing list for TRAMP, available at -, and archived at the TRAMP Mail Archive -(http://lists.gnu.org/archive/html/tramp-devel/). - - Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free -Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.2 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover texts - being "A GNU Manual", and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - "GNU Free Documentation License" in the Emacs manual. - - (a) The FSF's Back-Cover Text is: "You have freedom to copy and - modify this GNU Manual, like GNU software. Copies published by - the Free Software Foundation raise funds for GNU development." - - This document is part of a collection distributed under the GNU - Free Documentation License. If you want to distribute this - document separately from the collection, you can do so by adding a - copy of the license to the document, as described in section 6 of - the license. - -* Menu: - -* Overview:: What TRAMP can and cannot do. - -For the end user: - -* Obtaining Tramp:: How to obtain TRAMP. -* History:: History of TRAMP. -* Configuration:: Configuring TRAMP for use. -* Usage:: An overview of the operation of TRAMP. -* Bug Reports:: Reporting Bugs and Problems. -* Frequently Asked Questions:: Questions and answers from the mailing list. -* Concept Index:: An item for each concept. - -For the developer: - -* Version Control:: The inner workings of remote version control. -* Files directories and localnames:: How file names, directories and localnames are mangled and managed. -* Issues:: Debatable Issues and What Was Decided. - - --- The Detailed Node Listing --- - -Configuring TRAMP for use - -* Connection types:: Types of connections made to remote machines. -* Inline methods:: Inline methods. -* External transfer methods:: External transfer methods. -* Multi-hop Methods:: Connecting to a remote host using multiple hops. -* Default Method:: Selecting a default method. -* Customizing Methods:: Using Non-Standard Methods. -* Customizing Completion:: Selecting config files for user/host name completion. -* Password caching:: Reusing passwords for several connections. -* Remote Programs:: How TRAMP finds and uses programs on the remote machine. -* Remote shell setup:: Remote shell setup hints. -* Windows setup hints:: Issues with Cygwin ssh. -* Auto-save and Backup:: Auto-save and Backup. - -Using TRAMP - -* Filename Syntax:: TRAMP filename conventions. -* Multi-hop filename syntax:: Multi-hop filename conventions. -* Filename completion:: Filename completion. -* Dired:: Dired. -* Compilation:: Compile remote files. - -The inner workings of remote version control - -* Version Controlled Files:: Determining if a file is under version control. -* Remote Commands:: Executing the version control commands on the remote machine. -* Changed workfiles:: Detecting if the working file has changed. -* Checking out files:: Bringing the workfile out of the repository. -* Miscellaneous Version Control:: Things related to Version Control that don't fit elsewhere. - -Things related to Version Control that don't fit elsewhere - -* Remote File Ownership:: How VC determines who owns a workfile. -* Back-end Versions:: How VC determines what release your RCS is. - -How file names, directories and localnames are mangled and managed - -* Localname deconstruction:: Breaking a localname into its components. - - -File: tramp.info, Node: Overview, Next: Obtaining Tramp, Prev: Top, Up: Top - -1 An overview of TRAMP -********************** - -After the installation of TRAMP into your XEmacs, you will be able to -access files on remote machines as though they were local. Access to -the remote file system for editing files, version control, and `dired' -are transparently enabled. - - Your access to the remote machine can be with the `rsh', `rlogin', -`telnet' programs or with any similar connection method. This -connection must pass ASCII successfully to be usable but need not be -8-bit clean. - - The package provides support for `ssh' connections out of the box, -one of the more common uses of the package. This allows relatively -secure access to machines, especially if `ftp' access is disabled. - - The majority of activity carried out by TRAMP requires only that the -remote login is possible and is carried out at the terminal. In order -to access remote files TRAMP needs to transfer their content to the -local machine temporarily. - - TRAMP can transfer files between the machines in a variety of ways. -The details are easy to select, depending on your needs and the -machines in question. - - The fastest transfer methods (for large files) rely on a remote file -transfer package such as `rcp', `scp' or `rsync'. - - If the remote copy methods are not suitable for you, TRAMP also -supports the use of encoded transfers directly through the shell. This -requires that the `mimencode' or `uuencode' tools are available on the -remote machine. These methods are generally faster for small files. - - Within these limitations, TRAMP is quite powerful. It is worth -noting that, as of the time of writing, it is far from a polished -end-user product. For a while yet you should expect to run into rough -edges and problems with the code now and then. - - It is finished enough that the developers use it for day to day work -but the installation and setup can be a little difficult to master, as -can the terminology. - - TRAMP is still under active development and any problems you -encounter, trivial or major, should be reported to the TRAMP developers. -*Note Bug Reports::. - -Behind the scenes -................. - -This section tries to explain what goes on behind the scenes when you -access a remote file through TRAMP. - - Suppose you type `C-x C-f' and enter part of an TRAMP file name, -then hit `' for completion. Suppose further that this is the -first time that TRAMP is invoked for the host in question. Here's what -happens: - - * TRAMP discovers that it needs a connection to the host. So it - invokes `telnet HOST' or `rsh HOST -l USER' or a similar tool to - connect to the remote host. Communication with this process - happens through an XEmacs buffer, that is, the output from the - remote end goes into a buffer. - - * The remote host may prompt for a login name (for `telnet'). The - login name is given in the file name, so TRAMP sends the login - name and a newline. - - * The remote host may prompt for a password or pass phrase (for - `rsh' or for `telnet' after sending the login name). TRAMP - displays the prompt in the minibuffer, asking you for the password - or pass phrase. - - You enter the password or pass phrase. TRAMP sends it to the - remote host, followed by a newline. - - * TRAMP now waits for the shell prompt or for a message that the - login failed. - - If TRAMP sees neither of them after a certain period of time (a - minute, say), then it issues an error message saying that it - couldn't find the remote shell prompt and shows you what the - remote host has sent. - - If TRAMP sees a `login failed' message, it tells you so, aborts - the login attempt and allows you to try again. - - * Suppose that the login was successful and TRAMP sees the shell - prompt from the remote host. Now TRAMP invokes `/bin/sh' because - Bourne shells and C shells have different command syntaxes.(1) - - After the Bourne shell has come up, TRAMP sends a few commands to - ensure a good working environment. It turns off echoing, it sets - the shell prompt, and a few other things. - - * Now the remote shell is up and it good working order. Remember, - what was supposed to happen is that TRAMP tries to find out what - files exist on the remote host so that it can do filename - completion. - - So, TRAMP basically issues `cd' and `ls' commands and also - sometimes `echo' with globbing. Another command that is often - used is `test' to find out whether a file is writable or a - directory or the like. The output of each command is parsed for - the necessary operation. - - * Suppose you are finished with filename completion, have entered - `C-x C-f', a full file name and hit `'. Now comes the time to - transfer the file contents from the remote host to the local host - so that you can edit them. - - See above for an explanation of how TRAMP transfers the file - contents. - - For inline transfers, TRAMP issues a command like `mimencode -b - /path/to/remote/file', waits until the output has accumulated in - the buffer that's used for communication, then decodes that output - to produce the file contents. - - For out-of-band transfers, TRAMP issues a command like the - following: - rcp user@host:/path/to/remote/file /tmp/tramp.4711 - It then reads the local temporary file `/tmp/tramp.4711' into a - buffer and deletes the temporary file. - - * You now edit the buffer contents, blithely unaware of what has - happened behind the scenes. (Unless you have read this section, - that is.) When you are finished, you type `C-x C-s' to save the - buffer. - - * Again, TRAMP transfers the file contents to the remote host either - inline or out-of-band. This is the reverse of what happens when - reading the file. - - I hope this has provided you with a basic overview of what happens -behind the scenes when you open a file with TRAMP. - - ---------- Footnotes ---------- - - (1) Invoking `/bin/sh' will fail if your login shell doesn't -recognize `exec /bin/sh' as a valid command. Maybe you use the Scheme -shell `scsh'... - - -File: tramp.info, Node: Obtaining Tramp, Next: History, Prev: Overview, Up: Top - -2 Obtaining Tramp. -****************** - -TRAMP is freely available on the Internet and the latest release may be -downloaded from `ftp://ftp.gnu.org/gnu/tramp/'. This release includes -the full documentation and code for TRAMP, suitable for installation. -But GNU Emacs (22 or later) includes TRAMP already, and there is a -TRAMP package for XEmacs, as well. So maybe it is easier to just use -those. But if you want the bleeding edge, read on...... - - For the especially brave, TRAMP is available from CVS. The CVS -version is the latest version of the code and may contain incomplete -features or new issues. Use these versions at your own risk. - - Instructions for obtaining the latest development version of TRAMP -from CVS can be found by going to the Savannah project page at the -following URL and then clicking on the CVS link in the navigation bar -at the top. - -`http://savannah.gnu.org/projects/tramp/' - -Or follow the example session below: - - ] *cd ~/xemacs* - ] *export CVS_RSH="ssh"* - ] *cvs -z3 -d:ext:anoncvs@savannah.gnu.org:/cvsroot/tramp co tramp* - -You should now have a directory `~/xemacs/tramp' containing the latest -version of TRAMP. You can fetch the latest updates from the repository -by issuing the command: - - ] *cd ~/xemacs/tramp* - ] *export CVS_RSH="ssh"* - ] *cvs update -d* - -Once you've got updated files from the CVS repository, you need to run -`autoconf' in order to get an up-to-date `configure' script: - - ] *cd ~/xemacs/tramp* - ] *autoconf* - - -File: tramp.info, Node: History, Next: Configuration, Prev: Obtaining Tramp, Up: Top - -3 History of TRAMP -****************** - -Development was started end of November 1998. The package was called -`rssh.el', back then. It only provided one method to access a file, -using `ssh' to log in to a remote host and using `scp' to transfer the -file contents. After a while, the name was changed to `rcp.el', and -now it's TRAMP. Along the way, many more methods for getting a remote -shell and for transferring the file contents were added. Support for -VC was added. - - The most recent addition of major features were the multi-hop methods -added in April 2000 and the unification of TRAMP and Ange-FTP filenames -in July 2002. - - -File: tramp.info, Node: Configuration, Next: Usage, Prev: History, Up: Top - -4 Configuring TRAMP for use -*************************** - -TRAMP is (normally) fully functional when it is initially installed. -It is initially configured to use the `ssh' program to connect to the -remote host and to use base64 or uu encoding to transfer the files -through that shell connection. So in the easiest case, you just type -`C-x C-f' and then enter the filename `/[USER@MACHINE]/PATH/TO.FILE'. - - On some hosts, there are problems with opening a connection. These -are related to the behavior of the remote shell. See *Note Remote -shell setup::, for details on this. - - If you do not wish to use these commands to connect to the remote -host, you should change the default connection and transfer method that -TRAMP uses. There are several different methods that TRAMP can use to -connect to remote machines and transfer files (*note Connection -types::). - - If you don't know which method is right for you, see *Note Default -Method::. - -* Menu: - -* Connection types:: Types of connections made to remote machines. -* Inline methods:: Inline methods. -* External transfer methods:: External transfer methods. -* Multi-hop Methods:: Connecting to a remote host using multiple hops. -* Default Method:: Selecting a default method. - Here we also try to help those who - don't have the foggiest which method - is right for them. -* Customizing Methods:: Using Non-Standard Methods. -* Customizing Completion:: Selecting config files for user/host name completion. -* Password caching:: Reusing passwords for several connections. -* Remote Programs:: How TRAMP finds and uses programs on the remote machine. -* Remote shell setup:: Remote shell setup hints. -* Windows setup hints:: Issues with Cygwin ssh. -* Auto-save and Backup:: Auto-save and Backup. - - -File: tramp.info, Node: Connection types, Next: Inline methods, Up: Configuration - -4.1 Types of connections made to remote machines. -================================================= - -There are two basic types of transfer methods, each with its own -advantages and limitations. Both types of connection make use of a -remote shell access program such as `rsh', `ssh' or `telnet' to connect -to the remote machine. - - This connection is used to perform many of the operations that TRAMP -requires to make the remote file system transparently accessible from -the local machine. It is only when visiting files that the methods -differ. - - Loading or saving a remote file requires that the content of the file -be transfered between the two machines. The content of the file can be -transfered over the same connection used to log in to the remote -machine or the file can be transfered through another connection using -a remote copy program such as `rcp', `scp' or `rsync'. The former are -called "inline methods", the latter are called "out-of-band methods" or -"external transfer methods" ("external methods" for short). - - The performance of the external transfer methods is generally better -than that of the inline methods, at least for large files. This is -caused by the need to encode and decode the data when transferring -inline. - - The one exception to this rule are the `scp' based transfer methods. -While these methods do see better performance when actually -transferring files, the overhead of the cryptographic negotiation at -startup may drown out the improvement in file transfer times. - - External transfer methods should be configured such a way that they -don't require a password (with `ssh-agent', or such alike). If it -isn't possible, you should consider *Note Password caching::, otherwise -you will be prompted for a password every copy action. - - A variant of the inline methods are the "multi-hop methods". These -methods allow you to connect a remote host using a number `hops', each -of which connects to a different host. This is useful if you are in a -secured network where you need to go through a bastion host to connect -to the outside world. - - -File: tramp.info, Node: Inline methods, Next: External transfer methods, Prev: Connection types, Up: Configuration - -4.2 Inline methods -================== - -The inline methods in TRAMP are quite powerful and can work in -situations where you cannot use an external transfer program to connect. -Inline methods are the only methods that work when connecting to the -remote machine via telnet. (There are also strange inline methods which -allow you to transfer files between _user identities_ rather than -hosts, see below.) - - These methods depend on the existence of a suitable encoding and -decoding command on remote machine. Locally, TRAMP may be able to use -features of XEmacs to decode and encode the files or it may require -access to external commands to perform that task. - - TRAMP checks the availability and usability of commands like -`mimencode' (part of the `metamail' package) or `uuencode' on the -remote host. The first reliable command will be used. The search path -can be customized, see *Note Remote Programs::. - - If both commands aren't available on the remote host, TRAMP -transfers a small piece of Perl code to the remote host, and tries to -apply it for encoding and decoding. - -`rsh' - Connect to the remote host with `rsh'. Due to the unsecure - connection it is recommended for very local host topology only. - - On operating systems which provide the command `remsh' instead of - `rsh', you can use the method `remsh'. This is true for HP-UX or - Cray UNICOS, for example. - -`ssh' - Connect to the remote host with `ssh'. This is identical to the - previous option except that the `ssh' package is used, making the - connection more secure. - - There are also two variants, `ssh1' and `ssh2', that call `ssh -1' - and `ssh -2', respectively. This way, you can explicitly select - whether you want to use the SSH protocol version 1 or 2 to connect - to the remote host. (You can also specify in `~/.ssh/config', the - SSH configuration file, which protocol should be used, and use the - regular `ssh' method.) - - Two other variants, `ssh1_old' and `ssh2_old', use the `ssh1' and - `ssh2' commands explicitly. If you don't know what these are, you - do not need these options. - - All the methods based on `ssh' have an additional kludgy feature: - you can specify a host name which looks like `host#42' (the real - host name, then a hash sign, then a port number). This means to - connect to the given host but to also pass `-p 42' as arguments to - the `ssh' command. - -`telnet' - Connect to the remote host with `telnet'. This is as unsecure as - the `rsh' method. - -`su' - This method does not connect to a remote host at all, rather it - uses the `su' program to allow you to edit files as another user. - -`sudo' - This is similar to the `su' method, but it uses `sudo' rather than - `su' to become a different user. - - Note that `sudo' must be configured to allow you to start a shell - as the user. It would be nice if it was sufficient if `ls' and - `mimencode' were allowed, but that is not easy to implement, so I - haven't got around to it, yet. - -`sshx' - As you would expect, this is similar to `ssh', only a little - different. Whereas `ssh' opens a normal interactive shell on the - remote host, this option uses `ssh -t -t HOST -l USER /bin/sh' to - open a connection. This is useful for users where the normal - login shell is set up to ask them a number of questions when - logging in. This procedure avoids these questions, and just gives - TRAMP a more-or-less `standard' login shell to work with. - - Note that this procedure does not eliminate questions asked by - `ssh' itself. For example, `ssh' might ask "Are you sure you want - to continue connecting?" if the host key of the remote host is not - known. TRAMP does not know how to deal with such a question - (yet), therefore you will need to make sure that you can log in - without such questions. - - This is also useful for Windows users where `ssh', when invoked - from an XEmacs buffer, tells them that it is not allocating a - pseudo tty. When this happens, the login shell is wont to not - print any shell prompt, which confuses TRAMP mightily. For - reasons unknown, some Windows ports for `ssh' require the doubled - `-t' option. - - This supports the `-p' kludge. - -`krlogin' - This method is also similar to `ssh'. It only uses the `krlogin - -x' command to log in to the remote host. - -`plink' - This method is mostly interesting for Windows users using the PuTTY - implementation of SSH. It uses `plink -ssh' to log in to the - remote host. - - Additionally, the method `plink1' is provided, which calls `plink - -1 -ssh' in order to use SSH protocol version 1 explicitely. - - CCC: Do we have to connect to the remote host once from the command - line to accept the SSH key? Maybe this can be made automatic? - - CCC: Does `plink' support the `-p' option? TRAMP will support - that, anyway. - - - -File: tramp.info, Node: External transfer methods, Next: Multi-hop Methods, Prev: Inline methods, Up: Configuration - -4.3 External transfer methods -============================= - -The external transfer methods operate through multiple channels, using -the remote shell connection for many actions while delegating file -transfers to an external transfer utility. - - This saves the overhead of encoding and decoding that multiplexing -the transfer through the one connection has with the inline methods. - - If you want to use an external transfer method you should be able to -execute the transfer utility to copy files to and from the remote -machine without any interaction. - - This means that you will need to use `ssh-agent' if you use the -`scp' program for transfers, or maybe your version of `scp' accepts a -password on the command line.(1) If you use `rsync' via `ssh' then the -same rule must apply to that connection. - - If you cannot get an external method to run without asking for a -password you should consider *Note Password caching::. - -`rcp' -- `rsh' and `rcp' - This method uses the `rsh' and `rcp' commands to connect to the - remote machine and transfer files. This is probably the fastest - connection method available. - - The alternative method `remcp' uses the `remsh' and `rcp' - commands. It should be applied on machines where `remsh' is used - instead of `rsh'. - -`scp' -- `ssh' and `scp' - Using `ssh' to connect to the remote host and `scp' to transfer - files between the machines is the best method for securely - connecting to a remote machine and accessing files. - - The performance of this option is also quite good. It may be - slower than the inline methods when you often open and close small - files however. The cost of the cryptographic handshake at the - start of an `scp' session can begin to absorb the advantage that - the lack of encoding and decoding presents. - - There are also two variants, `scp1' and `scp2', that call `ssh -1' - and `ssh -2', respectively. This way, you can explicitly select - whether you want to use the SSH protocol version 1 or 2 to connect - to the remote host. (You can also specify in `~/.ssh/config', the - SSH configuration file, which protocol should be used, and use the - regular `scp' method.) - - Two other variants, `scp1_old' and `scp2_old', use the `ssh1' and - `ssh2' commands explicitly. If you don't know what these are, you - do not need these options. - - All the `ssh' based methods support the kludgy `-p' feature where - you can specify a port number to connect to in the host name. For - example, the host name `host#42' tells TRAMP to specify `-p 42' in - the argument list for `ssh'. - -`rsync' -- `ssh' and `rsync' - Using the `ssh' command to connect securely to the remote machine - and the `rsync' command to transfer files is almost identical to - the `scp' method. - - While `rsync' performs much better than `scp' when transferring - files that exist on both hosts, this advantage is lost if the file - exists only on one side of the connection. - - The `rsync' based method may be considerably faster than the `rcp' - based methods when writing to the remote system. Reading files to - the local machine is no faster than with a direct copy. - - This method supports the `-p' hack. - -`scpx' -- `ssh' and `scp' - As you would expect, this is similar to `scp', only a little - different. Whereas `scp' opens a normal interactive shell on the - remote host, this option uses `ssh -t -t HOST -l USER /bin/sh' to - open a connection. This is useful for users where the normal - login shell is set up to ask them a number of questions when - logging in. This procedure avoids these questions, and just gives - TRAMP a more-or-less `standard' login shell to work with. - - This is also useful for Windows users where `ssh', when invoked - from an XEmacs buffer, tells them that it is not allocating a - pseudo tty. When this happens, the login shell is wont to not - print any shell prompt, which confuses TRAMP mightily. - - This method supports the `-p' hack. - -`pscp' -- `plink' and `pscp' - This method is similar to `scp', but it uses the `plink' command - to connect to the remote host, and it uses `pscp' for transferring - the files. These programs are part of PuTTY, an SSH - implementation for Windows. - - CCC: Does `plink' support the `-p' hack? - -`fcp' -- `fsh' and `fcp' - This method is similar to `scp', but it uses the `fsh' command to - connect to the remote host, and it uses `fcp' for transferring the - files. `fsh/fcp' are a front-end for `ssh' which allow for - reusing the same `ssh' session for submitting several commands. - This avoids the startup overhead of `scp' (which has to establish - a secure connection whenever it is called). Note, however, that - you can also use one of the inline methods to achieve a similar - effect. - - This method uses the command `fsh HOST -l USER /bin/sh -i' to - establish the connection, it does not work to just say `fsh HOST - -l USER'. - - There is no inline method using `fsh' as the multiplexing provided - by the program is not very useful in our context. TRAMP opens - just one connection to the remote host and then keeps it open, - anyway. - -`ftp' - This is not a native TRAMP method. Instead of, it forwards all - requests to EFS. This works only for unified filenames, see *Note - Issues::. - -`smb' -- `smbclient' - This is another not natural TRAMP method. It uses the `smbclient' - command on different Unices in order to connect to an SMB server. - An SMB server might be a Samba (or CIFS) server on another UNIX - host or, more interesting, a host running MS Windows. So far, it - is tested towards MS Windows NT, MS Windows 2000, and MS Windows - XP. - - The first directory in the localname must be a share name on the - remote host. Remember, that the `$' character in which default - shares usually end, must be written `$$' due to environment - variable substitution in file names. If no share name is given - (i.e. remote directory `/'), all available shares are listed. - - Since authorization is done on share level, you will be prompted - always for a password if you access another share on the same host. - This can be suppressed by *Note Password caching::. - - MS Windows uses for authorization both a user name and a domain - name. Because of this, the TRAMP syntax has been extended: you can - specify a user name which looks like `user%domain' (the real user - name, then a percent sign, then the domain name). So, to connect - to the machine `melancholia' as user `daniel' of the domain - `BIZARRE', and edit `.emacs' in the home directory (share - `daniel$') I would specify the filename - `/[smb/daniel%BIZARRE@melancholia]/daniel$$/.emacs'. - - The domain name as well as the user name are optional. If no user - name is specified at all, the anonymous user (without password - prompting) is assumed. This is different from all other TRAMP - methods, where in such a case the local user name is taken. - - The `smb' method supports the `-p' hack. - - *Please note:* If XEmacs runs locally under MS Windows, this - method isn't available. Instead of, you can use UNC file names - like `//melancholia/daniel$$/.emacs'. The only disadvantage is - that there's no possibility to specify another user name. - - - ---------- Footnotes ---------- - - (1) PuTTY's `pscp' allows you to specify the password on the command -line. - - -File: tramp.info, Node: Multi-hop Methods, Next: Default Method, Prev: External transfer methods, Up: Configuration - -4.4 Connecting to a remote host using multiple hops -=================================================== - -Sometimes, the methods described before are not sufficient. Sometimes, -it is not possible to connect to a remote host using a simple command. -For example, if you are in a secured network, you might have to log in -to a `bastion host' first before you can connect to the outside world. -Of course, the target host may also require a bastion host. The format -of multi-hop filenames is slightly different than the format of normal -TRAMP methods. - - A multi-hop file name specifies a method, a number of hops, and a -localname (path name on the remote system). The method name is always -`multi'. - - Each hop consists of a "hop method" specification, a user name and a -host name. The hop method can be an inline method only. The following -hop methods are (currently) available: - -`telnet' - Uses the well-known `telnet' program to connect to the host. - Whereas user name and host name are supplied in the file name, the - user is queried for the password. - -`rsh' - This uses `rsh' to connect to the host. You do not need to enter - a password unless `rsh' explicitly asks for it. - - The variant `remsh' uses the `remsh' command. It should be - applied on machines where `remsh' is used instead of `rsh'. - -`ssh' - This uses `ssh' to connect to the host. You might have to enter a - password or a pass phrase. - -`su' - This method does not actually contact a different host, but it - allows you to become a different user on the host you're currently - on. This might be useful if you want to edit files as root, but - the remote host does not allow remote root logins. In this case - you can use `telnet', `rsh' or `ssh' to connect to the remote host - as a non-root user, then use an `su' hop to become root. But `su' - need not be the last hop in a sequence, you could also use it - somewhere in the middle, if the need arises. - - Even though you _must_ specify both user and host with an `su' - hop, the host name is ignored and only the user name is used. - -`sudo' - This is similar to the `su' hop, except that it uses `sudo' rather - than `su' to become a different user. - - - Some people might wish to use port forwarding with `ssh' or maybe -they have to use a nonstandard port. This can be accomplished by -putting a stanza in `~/.ssh/config' for the account which specifies a -different port number for a certain host name. But it can also be -accomplished within TRAMP, by adding a multi-hop method. For example: - - (add-to-list - 'tramp-multi-connection-function-alist - '("sshf" tramp-multi-connect-rlogin "ssh %h -l %u -p 4400%n")) - - Now you can use an `sshf' hop which connects to port 4400 instead of -the standard port. - - -File: tramp.info, Node: Default Method, Next: Customizing Methods, Prev: Multi-hop Methods, Up: Configuration - -4.5 Selecting a default method -============================== - -When you select an appropriate transfer method for your typical usage -you should set the variable `tramp-default-method' to reflect that -choice. This variable controls which method will be used when a method -is not specified in the TRAMP file name. For example: - - (setq tramp-default-method "scp") - - You can also specify different methods for certain user/host -combinations, via the variable `tramp-default-method-alist'. For -example, the following two lines specify to use the `ssh' method for -all user names matching `john' and the `rsync' method for all host -names matching `lily'. The third line specifies to use the `su' method -for the user `root' on the machine `localhost'. - - (add-to-list 'tramp-default-method-alist '("" "john" "ssh")) - (add-to-list 'tramp-default-method-alist '("lily" "" "rsync")) - (add-to-list 'tramp-default-method-alist - '("\\`localhost\\'" "\\`root\\'" "su")) - -See the documentation for the variable `tramp-default-method-alist' for -more details. - - External transfer methods are normally preferable to inline transfer -methods, giving better performance. - - *Note Inline methods::. *Note External transfer methods::. *Note -Multi-hop Methods::. - - Another consideration with the selection of transfer methods is the -environment you will use them in and, especially when used over the -Internet, the security implications of your preferred method. - - The `rsh' and `telnet' methods send your password as plain text as -you log in to the remote machine, as well as transferring the files in -such a way that the content can easily be read from other machines. - - If you need to connect to remote systems that are accessible from the -Internet, you should give serious thought to using `ssh' based methods -to connect. These provide a much higher level of security, making it a -non-trivial exercise for someone to obtain your password or read the -content of the files you are editing. - -4.5.1 Which method is the right one for me? -------------------------------------------- - -Given all of the above, you are probably thinking that this is all fine -and good, but it's not helping you to choose a method! Right you are. -As a developer, we don't want to boss our users around but give them -maximum freedom instead. However, the reality is that some users would -like to have some guidance, so here I'll try to give you this guidance -without bossing you around. You tell me whether it works ... - - My suggestion is to use an inline method. For large files, -out-of-band methods might be more efficient, but I guess that most -people will want to edit mostly small files. - - I guess that these days, most people can access a remote machine by -using `ssh'. So I suggest that you use the `ssh' method. So, type -`C-x C-f /[ssh/root@otherhost]/etc/motd ' to edit the `/etc/motd' -file on the other host. - - If you can't use `ssh' to log in to the remote host, then select a -method that uses a program that works. For instance, Windows users -might like the `plink' method which uses the PuTTY implementation of -`ssh'. Or you use Kerberos and thus like `krlogin'. - - For the special case of editing files on the local host as another -user, see the `su' or `sudo' methods. They offer shortened syntax for -the `root' account, like `/[su/]/etc/motd'. - - People who edit large files may want to consider `scp' instead of -`ssh', or `pscp' instead of `plink'. These out-of-band methods are -faster than inline methods for large files. Note, however, that -out-of-band methods suffer from some limitations. Please try first -whether you really get a noticeable speed advantage from using an -out-of-band method! Maybe even for large files, inline methods are -fast enough. - - -File: tramp.info, Node: Customizing Methods, Next: Customizing Completion, Prev: Default Method, Up: Configuration - -4.6 Using Non-Standard Methods -============================== - -There is a variable `tramp-methods' which you can change if the -predefined methods don't seem right. - - For the time being, I'll refer you to the Lisp documentation of that -variable, accessible with `C-h v tramp-methods '. - - -File: tramp.info, Node: Customizing Completion, Next: Password caching, Prev: Customizing Methods, Up: Configuration - -4.7 Selecting config files for user/host name completion -======================================================== - -The variable `tramp-completion-function-alist' is intended to customize -which files are taken into account for user and host name completion -(*note Filename completion::). For every method, it keeps a set of -configuration files, accompanied by a Lisp function able to parse that -file. Entries in `tramp-completion-function-alist' have the form -(METHOD PAIR1 PAIR2 ...). - - Each PAIR is composed of (FUNCTION FILE). FUNCTION is responsible -to extract user names and host names from FILE for completion. There -are two functions which access this variable: - - -- Function: tramp-get-completion-function method - This function returns the list of completion functions for METHOD. - - Example: - (tramp-get-completion-function "rsh") - - => ((tramp-parse-rhosts "/etc/hosts.equiv") - (tramp-parse-rhosts "~/.rhosts")) - - -- Function: tramp-set-completion-function method function-list - This function sets FUNCTION-LIST as list of completion functions - for METHOD. - - Example: - (tramp-set-completion-function "ssh" - '((tramp-parse-sconfig "/etc/ssh_config") - (tramp-parse-sconfig "~/.ssh/config"))) - - => ((tramp-parse-sconfig "/etc/ssh_config") - (tramp-parse-sconfig "~/.ssh/config")) - - The following predefined functions parsing configuration files exist: - -`tramp-parse-rhosts' - This function parses files which are syntactical equivalent to - `~/.rhosts'. It returns both host names and user names, if - specified. - -`tramp-parse-shosts' - This function parses files which are syntactical equivalent to - `~/.ssh/known_hosts'. Since there are no user names specified in - such files, it can return host names only. - -`tramp-parse-sconfig' - This function returns the host nicknames defined by `Host' entries - in `~/.ssh/config' style files. - -`tramp-parse-shostkeys' - SSH2 parsing of directories `/etc/ssh2/hostkeys/*' and - `~/ssh2/hostkeys/*'. Hosts are coded in file names - `hostkey_PORTNUMBER_HOST-NAME.pub'. User names are always `nil'. - -`tramp-parse-sknownhosts' - Another SSH2 style parsing of directories like - `/etc/ssh2/knownhosts/*' and `~/ssh2/knownhosts/*'. This case, - hosts names are coded in file names `HOST-NAME.ALGORITHM.pub'. - User names are always `nil'. - -`tramp-parse-hosts' - A function dedicated to `/etc/hosts' style files. It returns host - names only. - -`tramp-parse-passwd' - A function which parses `/etc/passwd' like files. Obviously, it - can return user names only. - -`tramp-parse-netrc' - Finally, a function which parses `~/.netrc' like files. - - If you want to keep your own data in a file, with your own structure, -you might provide such a function as well. This function must meet the -following conventions: - - -- Function: my-tramp-parse file - FILE must be either a file name on your host, or `nil'. The - function must return a list of (USER HOST), which are taken as - candidates for user and host name completion. - - Example: - (my-tramp-parse "~/.my-tramp-hosts") - - => ((nil "toto") ("daniel" "melancholia")) - - -File: tramp.info, Node: Password caching, Next: Remote Programs, Prev: Customizing Completion, Up: Configuration - -4.8 Reusing passwords for several connections. -============================================== - -Sometimes it is necessary to connect to the same remote host several -times. Reentering passwords again and again would be annoying, when -the choosen method does not support access without password prompt -throught own configuration. - - By default, TRAMP caches the passwords entered by you. They will be -reused next time if a connection needs them for the same user name and -host name, independant of the connection method. - - Passwords are not saved permanently, that means the password caching -is limited to the lifetime of your XEmacs session. You can influence -the lifetime of password caching by customizing the variable -`password-cache-expiry'. The value is the number of seconds how long -passwords are cached. Setting it to `nil' disables the expiration. - - A password is removed from the cache if a connection isn't -established successfully. You can remove a password from the cache -also by executing `M-x tramp-clear-passwd' in a buffer containing a -related remote file or directory. - - If you don't like this feature for security reasons, password caching -can be disabled totally by customizing the variable `password-cache' -(setting it to `nil'). - - Implementation Note: password caching is based on the package -password.el in No Gnus. For the time being, it is activated only when -this package is seen in the `load-path' while loading TRAMP. It will -be activated mandatory once No Gnus has found its way into XEmacs. - - -File: tramp.info, Node: Remote Programs, Next: Remote shell setup, Prev: Password caching, Up: Configuration - -4.9 How TRAMP finds and uses programs on the remote machine. -============================================================ - -TRAMP depends on a number of programs on the remote host in order to -function, including `ls', `test', `find' and `cat'. - - In addition to these required tools, there are various tools that -may be required based on the connection method. See *Note Inline -methods:: and *Note External transfer methods:: for details on these. - - Certain other tools, such as `perl' (or `perl5') and `grep' will be -used if they can be found. When they are available, they are used to -improve the performance and accuracy of remote file access. - - When TRAMP connects to the remote machine, it searches for the -programs that it can use. The variable TRAMP-REMOTE-PATH controls the -directories searched on the remote machine. - - By default, this is set to a reasonable set of defaults for most -machines. It is possible, however, that your local (or remote ;) system -administrator has put the tools you want in some obscure local -directory. - - In this case, you can still use them with TRAMP. You simply need to -add code to your `.emacs' to add the directory to the remote path. -This will then be searched by TRAMP when you connect and the software -found. - - To add a directory to the remote search path, you could use code such -as: - - ;; We load TRAMP to define the variable. - (require 'tramp) - ;; We have `perl' in "/usr/local/perl/bin" - (add-to-list 'tramp-remote-path "/usr/local/perl/bin") - - -File: tramp.info, Node: Remote shell setup, Next: Windows setup hints, Prev: Remote Programs, Up: Configuration - -4.10 Remote shell setup hints -============================= - -As explained in the *Note Overview:: section, TRAMP connects to the -remote host and talks to the shell it finds there. Of course, when you -log in, the shell executes its init files. Suppose your init file -requires you to enter the birth date of your mother; clearly TRAMP does -not know this and hence fails to log you in to that host. - - There are different possible strategies for pursuing this problem. -One strategy is to enable TRAMP to deal with all possible situations. -This is a losing battle, since it is not possible to deal with _all_ -situations. The other strategy is to require you to set up the remote -host such that it behaves like TRAMP expects. This might be -inconvenient because you have to invest a lot of effort into shell -setup before you can begin to use TRAMP. - - The package, therefore, pursues a combined approach. It tries to -figure out some of the more common setups, and only requires you to -avoid really exotic stuff. For example, it looks through a list of -directories to find some programs on the remote host. And also, it -knows that it is not obvious how to check whether a file exists, and -therefore it tries different possibilities. (On some hosts and shells, -the command `test -e' does the trick, on some hosts the shell builtin -doesn't work but the program `/usr/bin/test -e' or `/bin/test -e' -works. And on still other hosts, `ls -d' is the right way to do this.) - - Below you find a discussion of a few things that TRAMP does not deal -with, and that you therefore have to set up correctly. - -SHELL-PROMPT-PATTERN - After logging in to the remote host, TRAMP has to wait for the - remote shell startup to finish before it can send commands to the - remote shell. The strategy here is to wait for the shell prompt. - In order to recognize the shell prompt, the variable - `shell-prompt-pattern' has to be set correctly to recognize the - shell prompt on the remote host. - - Note that TRAMP requires the match for `shell-prompt-pattern' to - be at the end of the buffer. Many people have something like the - following as the value for the variable: `"^[^>$][>$] *"'. Now - suppose your shell prompt is `a c $ '. In this case, TRAMP - recognizes the `>' character as the end of the prompt, but it is - not at the end of the buffer. - -TRAMP-SHELL-PROMPT-PATTERN - This regular expression is used by TRAMP in the same way as - `shell-prompt-pattern', to match prompts from the remote shell. - This second variable exists because the prompt from the remote - shell might be different from the prompt from a local shell -- - after all, the whole point of TRAMP is to log in to remote hosts - as a different user. The default value of - `tramp-shell-prompt-pattern' is the same as the default value of - `shell-prompt-pattern', which is reported to work well in many - circumstances. - -`tset' and other questions - Some people invoke the `tset' program from their shell startup - scripts which asks the user about the terminal type of the shell. - Maybe some shells ask other questions when they are started. TRAMP - does not know how to answer these questions. There are two - approaches for dealing with this problem. One approach is to take - care that the shell does not ask any questions when invoked from - TRAMP. You can do this by checking the `TERM' environment - variable, it will be set to `dumb' when connecting. - - The variable `tramp-terminal-type' can be used to change this value - to `dumb'. - - The other approach is to teach TRAMP about these questions. See - the variables `tramp-actions-before-shell' and - `tramp-multi-actions' (for multi-hop connections). - -Environment variables named like users in `.profile' - If you have a user named frumple and set the variable `FRUMPLE' in - your shell environment, then this might cause trouble. Maybe - rename the variable to `FRUMPLE_DIR' or the like. - - This weird effect was actually reported by a TRAMP user! - -Non-Bourne commands in `.profile' - After logging in to the remote host, TRAMP issues the command - `exec /bin/sh'. (Actually, the command is slightly different.) - When `/bin/sh' is executed, it reads some init files, such as - `~/.shrc' or `~/.profile'. - - Now, some people have a login shell which is not `/bin/sh' but a - Bourne-ish shell such as bash or ksh. Some of these people might - put their shell setup into the files `~/.shrc' or `~/.profile'. - This way, it is possible for non-Bourne constructs to end up in - those files. Then, `exec /bin/sh' might cause the Bourne shell to - barf on those constructs. - - As an example, imagine somebody putting `export FOO=bar' into the - file `~/.profile'. The standard Bourne shell does not understand - this syntax and will emit a syntax error when it reaches this line. - - Another example is the tilde (`~') character, say when adding - `~/bin' to `$PATH'. Many Bourne shells will not expand this - character, and since there is usually no directory whose name - consists of the single character tilde, strange things will happen. - - What can you do about this? - - Well, one possibility is to make sure that everything in `~/.shrc' - and `~/.profile' on all remote hosts is Bourne-compatible. In the - above example, instead of `export FOO=bar', you might use - `FOO=bar; export FOO' instead. - - The other possibility is to put your non-Bourne shell setup into - some other files. For example, bash reads the file - `~/.bash_profile' instead of `~/.profile', if the former exists. - So bash aficionados just rename their `~/.profile' to - `~/.bash_profile' on all remote hosts, and Bob's your uncle. - - The TRAMP developers would like to circumvent this problem, so if - you have an idea about it, please tell us. However, we are afraid - it is not that simple: before saying `exec /bin/sh', TRAMP does - not know which kind of shell it might be talking to. It could be - a Bourne-ish shell like ksh or bash, or it could be a csh - derivative like tcsh, or it could be zsh, or even rc. If the - shell is Bourne-ish already, then it might be prudent to omit the - `exec /bin/sh' step. But how to find out if the shell is - Bourne-ish? - - - -File: tramp.info, Node: Auto-save and Backup, Prev: Windows setup hints, Up: Configuration - -4.11 Auto-save and Backup configuration -======================================= - -Normally, XEmacs writes backup files to the same directory as the -original files, but this behavior can be changed via the variable -`bkup-backup-directory-info'. In connection with TRAMP, this can have -unexpected side effects. Suppose that you specify that all backups -should go to the directory `~/.emacs.d/backups/', and then you edit the -file `/[su/root@localhost]/etc/secretfile'. The effect is that the -backup file will be owned by you and not by root, thus possibly -enabling others to see it even if they were not intended to see it. - - When `bkup-backup-directory-info' is `nil' (the default), such -problems do not occur. - - Therefore, it is usefull to set special values for TRAMP files. For -example, the following statement effectively `turns off' the effect of -`bkup-backup-directory-info' for TRAMP files: - - (require 'backup-dir) - (add-to-list 'bkup-backup-directory-info - (list tramp-file-name-regexp "")) - - Another possibility is to use the TRAMP variable -`tramp-bkup-backup-directory-info'. This variable has the same meaning -like `bkup-backup-directory-info'. If a TRAMP file is backed up, and -DIRECTORY is an absolute local file name, DIRECTORY is prepended with -the TRAMP file name prefix of the file to be backed up. - -Example: - - (require 'backup-dir) - (add-to-list 'bkup-backup-directory-info - (list "." "~/.emacs.d/backups/" 'full-path)) - (setq tramp-bkup-backup-directory-info bkup-backup-directory-info) - -The backup file name of `/[su/root@localhost]/etc/secretfile' would be -`/[su/root@localhost]~/.emacs.d/backups/![su!root@localhost]!etc!secretfile~' - - The same problem can happen with auto-saving files. For this -purpose you can set the variable `auto-save-directory' to a proper -value. - - -File: tramp.info, Node: Windows setup hints, Next: Auto-save and Backup, Prev: Remote shell setup, Up: Configuration - -4.12 Issues with Cygwin ssh -=========================== - -This section needs a lot of work! Please help. - - The recent Cygwin installation of `ssh' works only with a Cygwinized -XEmacs. You can check it by typing `M-x eshell', and starting `ssh -test.machine'. The problem is evident if you see a message like this: - - Pseudo-terminal will not be allocated because stdin is not a terminal. - - Older `ssh' versions of Cygwin are told to cooperate with TRAMP -selecting `sshx' as the connection method. You can find information -about setting up Cygwin in their FAQ at `http://cygwin.com/faq/'. - - If you wish to use the `scpx' connection method, then you might have -the problem that XEmacs calls `scp' with a Windows filename such as -`c:/foo'. The Cygwin version of `scp' does not know about Windows -filenames and interprets this as a remote filename on the host `c'. - - One possible workaround is to write a wrapper script for `scp' which -converts the Windows filename to a Cygwinized filename. - - If you want to use either `ssh' based method on Windows, then you -might encounter problems with `ssh-agent'. Using this program, you can -avoid typing the pass-phrase every time you log in. However, if you -start XEmacs from a desktop shortcut, then the environment variable -`SSH_AUTH_SOCK' is not set and so XEmacs and thus TRAMP and thus `ssh' -and `scp' started from TRAMP cannot communicate with `ssh-agent'. It -works better to start XEmacs from the shell. - - If anyone knows how to start `ssh-agent' under Windows in such a way -that desktop shortcuts can profit, please holler. I don't really know -anything at all about Windows... - - -File: tramp.info, Node: Usage, Next: Bug Reports, Prev: Configuration, Up: Top - -5 Using TRAMP -************* - -Once you have installed TRAMP it will operate fairly transparently. You -will be able to access files on any remote machine that you can log in -to as though they were local. - - Files are specified to TRAMP using a formalized syntax specifying the -details of the system to connect to. This is similar to the syntax used -by the EFS package. - - Something that might happen which surprises you is that XEmacs -remembers all your keystrokes, so if you see a password prompt from -XEmacs, say, and hit `' twice instead of once, then the second -keystroke will be processed by XEmacs after TRAMP has done its thing. -Why, this type-ahead is normal behavior, you say. Right you are, but -be aware that opening a remote file might take quite a while, maybe -half a minute when a connection needs to be opened. Maybe after half a -minute you have already forgotten that you hit that key! - -* Menu: - -* Filename Syntax:: TRAMP filename conventions. -* Multi-hop filename syntax:: Multi-hop filename conventions. -* Filename completion:: Filename completion. -* Dired:: Dired. -* Compilation:: Compile remote files. - - -File: tramp.info, Node: Filename Syntax, Next: Multi-hop filename syntax, Up: Usage - -5.1 TRAMP filename conventions -============================== - -To access the file LOCALNAME on the remote machine MACHINE you would -specify the filename `/[MACHINE]LOCALNAME'. This will connect to -MACHINE and transfer the file using the default method. *Note Default -Method::. - - Some examples of TRAMP filenames are shown below. - -`/[melancholia].emacs' - Edit the file `.emacs' in your home directory on the machine - `melancholia'. - -`/[melancholia.danann.net].emacs' - This edits the same file, using the fully qualified domain name of - the machine. - -`/[melancholia]~/.emacs' - This also edits the same file -- the `~' is expanded to your home - directory on the remote machine, just like it is locally. - -`/[melancholia]~daniel/.emacs' - This edits the file `.emacs' in the home directory of the user - `daniel' on the machine `melancholia'. The `~' construct is - expanded to the home directory of that user on the remote machine. - -`/[melancholia]/etc/squid.conf' - This edits the file `/etc/squid.conf' on the machine `melancholia'. - - - Unless you specify a different name to use, TRAMP will use the -current local user name as the remote user name to log in with. If you -need to log in as a different user, you can specify the user name as -part of the filename. - - To log in to the remote machine as a specific user, you use the -syntax `/[USER@MACHINE]/PATH/TO.FILE'. That means that connecting to -`melancholia' as `daniel' and editing `.emacs' in your home directory -you would specify `/[daniel@melancholia].emacs'. - - It is also possible to specify other file transfer methods (*note -Default Method::) as part of the filename. This is done by replacing -the initial `/[' with `/[/'. (Note the trailing slash!). The -user, machine and file specification remain the same. - - So, to connect to the machine `melancholia' as `daniel', using the -`ssh' method to transfer files, and edit `.emacs' in my home directory -I would specify the filename `/[ssh/daniel@melancholia].emacs'. - - -File: tramp.info, Node: Multi-hop filename syntax, Next: Filename completion, Prev: Filename Syntax, Up: Usage - -5.2 Multi-hop filename conventions -================================== - -The syntax of multi-hop file names is necessarily slightly different -than the syntax of other TRAMP file names. Here's an example multi-hop -file name: - - /[multi/rsh:out@gate/telnet:kai@real.host]/path/to.file - - This is quite a mouthful. So let's go through it step by step. The -file name consists of three parts. The parts are separated by slashes -and square brackets. The first part is `/[multi', the method -specification. The second part is `rsh:out@gate/telnet:kai@real.host' -and specifies the hops. The final part is `/path/to.file' and -specifies the file name on the remote host. - - The first part and the final part should be clear. See *Note -Multi-hop Methods::, for a list of alternatives for the method -specification. - - The second part can be subdivided again into components, so-called -hops. In the above file name, there are two hops, `rsh:out@gate' and -`telnet:kai@real.host'. - - Each hop can _again_ be subdivided into (three) components, the "hop -method", the "user name" and the "host name". The meaning of the -second and third component should be clear, and the hop method says -what program to use to perform that hop. - - The first hop, `rsh:out@gate', says to use `rsh' to log in as user -`out' to the host `gate'. Starting at that host, the second hop, -`telnet:kai@real.host', says to use `telnet' to log in as user `kai' to -host `real.host'. - - *Note Multi-hop Methods::, for a list of possible hop method values. -The variable `tramp-multi-connection-function-alist' contains the list -of possible hop methods and information on how to execute them, should -you want to add your own. - - -File: tramp.info, Node: Filename completion, Next: Dired, Prev: Multi-hop filename syntax, Up: Usage - -5.3 Filename completion -======================= - -Filename completion works with TRAMP for both completing methods, user -names and machine names (except multi hop methods) as well as for files -on remote machines. - - If you, for example, type `C-x C-f /[t ', TRAMP might give you -as result the choice for - - [telnet/ [toto] - - `[telnet/' is a possible completion for the respective method, and -`[toto]' might be a host TRAMP has detected in your `~/.ssh/known_hosts' -file (given you're using default method `ssh'). - - If you go on to type `e ', the minibuffer is completed to -`/[telnet/'. Next `' brings you all machine names TRAMP detects in -your `/etc/hosts' file, let's say - - [telnet/127.0.0.1] [telnet/192.168.0.1] - [telnet/localhost] [telnet/melancholia.danann.net] - [telnet/melancholia] - - Now you can choose the desired machine, and you can continue to -complete file names on that machine. - - As filename completion needs to fetch the listing of files from the -remote machine, this feature is sometimes fairly slow. As TRAMP does -not yet cache the results of directory listing, there is no gain in -performance the second time you complete filenames. - - If the configuration files (*note Customizing Completion::), which -TRAMP uses for analysis of completion, offer user names, those user -names will be taken into account as well. - - -File: tramp.info, Node: Dired, Next: Compilation, Prev: Filename completion, Up: Usage - -5.4 Dired -========= - -TRAMP works transparently with dired, enabling you to use this powerful -file management tool to manage files on any machine you have access to -over the Internet. - - If you need to browse a directory tree, Dired is a better choice, at -present, than filename completion. Dired has its own cache mechanism -and will only fetch the directory listing once. - - -File: tramp.info, Node: Compilation, Prev: Dired, Up: Usage - -5.5 Compile remote files -======================== - -TRAMP provides commands for compilation of files on remote machines. -In order to get them loaded, you need to require `tramp-util.el': - - (require 'tramp-util) - - Afterwards, you can use the commands `tramp-compile' and -`tramp-recompile' instead of `compile' and `recompile', respectively; -*note (xemacs)Compilation::. This does not work for the `ftp' and -`smb' methods. - - The corresponding key bindings and menu entries calling these -commands are redefined automatically for buffers associated with remote -files. - - After finishing the compilation, you can use the usual commands like -`previous-error', `next-error' and `first-error' for navigation in the -`*Compilation*' buffer. - - -File: tramp.info, Node: Bug Reports, Next: Frequently Asked Questions, Prev: Usage, Up: Top - -6 Reporting Bugs and Problems -***************************** - -Bugs and problems with TRAMP are actively worked on by the development -team. Feature requests and suggestions are also more than welcome. - - The TRAMP mailing list is a great place to get information on working -with TRAMP, solving problems and general discussion and advice on topics -relating to the package. - - The mailing list is at . Messages sent to this -address go to all the subscribers. This is _not_ the address to send -subscription requests to. - - Subscribing to the list is performed via the TRAMP Mail Subscription -Page (http://lists.gnu.org/mailman/listinfo/tramp-devel/). - - To report a bug in TRAMP, you should execute `M-x tramp-bug'. This -will automatically generate a buffer with the details of your system and -TRAMP version. - - When submitting a bug report, please try to describe in excruciating -detail the steps required to reproduce the problem, the setup of the -remote machine and any special conditions that exist. You should also -check that your problem is not described already in *Note Frequently -Asked Questions::. - - If you can identify a minimal test case that reproduces the problem, -include that with your bug report. This will make it much easier for the -development team to analyze and correct the problem. - - -File: tramp.info, Node: Frequently Asked Questions, Next: Concept Index, Prev: Bug Reports, Up: Top - -7 Frequently Asked Questions -**************************** - - * Where can I get the latest TRAMP? - - TRAMP is available under the URL below. - - `ftp://ftp.gnu.org/gnu/tramp/' - - There is also a Savannah project page. - - `http://savannah.gnu.org/projects/tramp/' - - * Which systems does it work on? - - The package has been used successfully on GNU Emacs 20, GNU Emacs - 21 and GNU Emacs 22, as well as XEmacs 21. XEmacs 20 is more - problematic, see the notes in `tramp.el'. I don't think anybody - has really tried it on GNU Emacs 19. - - The package was intended to work on Unix, and it really expects a - Unix-like system on the remote end (except the `smb' method), but - some people seemed to have some success getting it to work on MS - Windows NT/2000/XP XEmacs. - - There is some informations on TRAMP on NT at the following URL; - many thanks to Joe Stoy for providing the information: - `ftp://ftp.comlab.ox.ac.uk/tmp/Joe.Stoy/' - - ??? Is the XEmacs info correct? - - ??? Can somebody provide some information for getting it to work - on NT Emacs? I think there was some issue with `ssh'? - - * TRAMP does not connect to the remote host - - When TRAMP does not connect to the remote host, there are two - reasons heading the bug mailing list: - - - Unknown characters in the prompt - - TRAMP needs to recognize the prompt on the remote machine - after execution any command. This is not possible, when the - prompt contains unknown characters like escape sequences for - coloring. This should be avoided on the remote side. *Note - Remote shell setup::. for setting the regular expression - detecting the prompt. - - - TRAMP doesn't transfer strings with more than 500 characters - correctly - - On some few systems, the implementation of - `process-send-string' seems to be broken for longer strings. - This case, you should customize the variable - `tramp-chunksize' to 500. For a description how to determine - whether this is necessary see the documentation of - `tramp-chunksize'. - - * File name completion does not work with TRAMP - - When you log in to the remote machine, do you see the output of - `ls' in color? If so, this may be the cause of your problems. - - `ls' outputs ANSI escape sequences that your terminal emulator - interprets to set the colors. These escape sequences will confuse - TRAMP however. - - In your `.bashrc', `.profile' or equivalent on the remote machine - you probably have an alias configured that adds the option - `--color=yes' or `--color=auto'. - - You should remove that alias and ensure that a new login _does not_ - display the output of `ls' in color. If you still cannot use - filename completion, report a bug to the TRAMP developers. - - * File name completion does not work in large directories - - TRAMP uses globbing for some operations. (Globbing means to use - the shell to expand wildcards such as `*.c'.) This might create - long command lines, especially in directories with many files. - Some shells choke on long command lines, or don't cope well with - the globbing itself. - - If you have a large directory on the remote end, you may wish to - execute a command like `ls -d * ..?* > /dev/null' and see if it - hangs. Note that you must first start the right shell, which - might be `/bin/sh', `ksh' or `bash', depending on which of those - supports tilde expansion. - - * How can I get notified when TRAMP file transfers are complete? - - The following snippet can be put in your `~/.emacs' file. It - makes XEmacs beep after reading from or writing to the remote host. - - (defadvice tramp-handle-write-region - (after tramp-write-beep-advice activate) - " make tramp beep after writing a file." - (interactive) - (beep)) - (defadvice tramp-handle-do-copy-or-rename-file - (after tramp-copy-beep-advice activate) - " make tramp beep after copying a file." - (interactive) - (beep)) - (defadvice tramp-handle-insert-file-contents - (after tramp-copy-beep-advice activate) - " make tramp beep after copying a file." - (interactive) - (beep)) - - * There's this `~/.sh_history' file on the remote host which keeps - growing and growing. What's that? - - Sometimes, TRAMP starts `ksh' on the remote host for tilde - expansion. Maybe `ksh' saves the history by default. TRAMP tries - to turn off saving the history, but maybe you have to help. For - example, you could put this in your `.kshrc': - - if [ -f $HOME/.sh_history ] ; then - /bin/rm $HOME/.sh_history - fi - if [ "${HISTFILE-unset}" != "unset" ] ; then - unset HISTFILE - fi - if [ "${HISTSIZE-unset}" != "unset" ] ; then - unset HISTSIZE - fi - - * How can I disable TRAMP? - - Shame on you, why did you read until now? - - Unloading TRAMP can be achieved by applying `M-x - tramp-unload-tramp'. - - -File: tramp.info, Node: Version Control, Next: Files directories and localnames, Prev: Concept Index, Up: Top - -8 The inner workings of remote version control -********************************************** - -Unlike EFS, TRAMP has full shell access to the remote machine. This -makes it possible to provide version control for files accessed under -TRAMP. - - The actual version control binaries must be installed on the remote -machine, accessible in the directories specified in TRAMP-REMOTE-PATH. - - This transparent integration with the version control systems is one -of the most valuable features provided by TRAMP, but it is far from -perfect. Work is ongoing to improve the transparency of the system. - -* Menu: - -* Version Controlled Files:: Determining if a file is under version control. -* Remote Commands:: Executing the version control commands on the remote machine. -* Changed workfiles:: Detecting if the working file has changed. -* Checking out files:: Bringing the workfile out of the repository. -* Miscellaneous Version Control:: Things related to Version Control that don't fit elsewhere. - - -File: tramp.info, Node: Version Controlled Files, Next: Remote Commands, Up: Version Control - -8.1 Determining if a file is under version control -================================================== - -The VC package uses the existence of on-disk revision control master -files to determine if a given file is under revision control. These file -tests happen on the remote machine through the standard TRAMP -mechanisms. - - -File: tramp.info, Node: Remote Commands, Next: Changed workfiles, Prev: Version Controlled Files, Up: Version Control - -8.2 Executing the version control commands on the remote machine -================================================================ - -There are no hooks provided by VC to allow intercepting of the version -control command execution. The calls occur through the `call-process' -mechanism, a function that is somewhat more efficient than the -`shell-command' function but that does not provide hooks for remote -execution of commands. - - To work around this, the functions `vc-do-command' and -`vc-simple-command' have been advised to intercept requests for -operations on files accessed via TRAMP. - - In the case of a remote file, the `shell-command' interface is used, -with some wrapper code, to provide the same functionality on the remote -machine as would be seen on the local machine. - - -File: tramp.info, Node: Changed workfiles, Next: Checking out files, Prev: Remote Commands, Up: Version Control - -8.3 Detecting if the working file has changed -============================================= - -As there is currently no way to get access to the mtime of a file on a -remote machine in a portable way, the `vc-workfile-unchanged-p' -function is advised to call an TRAMP specific function for remote files. - - The `tramp-vc-workfile-unchanged-p' function uses the functioning VC -diff functionality to determine if any changes have occurred between the -workfile and the version control master. - - This requires that a shell command be executed remotely, a process -that is notably heavier-weight than the mtime comparison used for local -files. Unfortunately, unless a portable solution to the issue is found, -this will remain the cost of remote version control. - - -File: tramp.info, Node: Checking out files, Next: Miscellaneous Version Control, Prev: Changed workfiles, Up: Version Control - -8.4 Bringing the workfile out of the repository -=============================================== - -VC will, by default, check for remote files and refuse to act on them -when checking out files from the repository. To work around this -problem, the function `vc-checkout' knows about TRAMP files and allows -version control to occur. - - -File: tramp.info, Node: Miscellaneous Version Control, Prev: Checking out files, Up: Version Control - -8.5 Things related to Version Control that don't fit elsewhere -============================================================== - -Minor implementation details, &c. - -* Menu: - -* Remote File Ownership:: How VC determines who owns a workfile. -* Back-end Versions:: How VC determines what release your RCS is. - - -File: tramp.info, Node: Remote File Ownership, Next: Back-end Versions, Up: Miscellaneous Version Control - -8.5.1 How VC determines who owns a workfile -------------------------------------------- - -XEmacs provides the `user-full-name' function to return the login name -of the current user as well as mapping from arbitrary user id values -back to login names. The VC code uses this functionality to map from -the uid of the owner of a workfile to the login name in some -circumstances. - - This will not, for obvious reasons, work if the remote system has a -different set of logins. As such, it is necessary to delegate to the -remote machine the job of determining the login name associated with a -uid. - - Unfortunately, with the profusion of distributed management systems -such as `NIS', `NIS+' and `NetInfo', there is no simple, reliable and -portable method for performing this mapping. - - Thankfully, the only place in the VC code that depends on the -mapping of a uid to a login name is the `vc-file-owner' function. This -returns the login of the owner of the file as a string. - - This function has been advised to use the output of `ls' on the -remote machine to determine the login name, delegating the problem of -mapping the uid to the login to the remote system which should know more -about it than I do. - - -File: tramp.info, Node: Back-end Versions, Prev: Remote File Ownership, Up: Miscellaneous Version Control - -8.5.2 How VC determines what release your RCS is ------------------------------------------------- - -VC needs to know what release your revision control binaries you are -running as not all features VC supports are available with older -versions of `rcs(1)', `cvs(1)' or `sccs(1)'. - - The default implementation of VC determines this value the first -time it is needed and then stores the value globally to avoid the -overhead of executing a process and parsing its output each time the -information is needed. - - Unfortunately, life is not quite so easy when remote version control -comes into the picture. Each remote machine may have a different version -of the version control tools and, while this is painful, we need to -ensure that unavailable features are not used remotely. - - To resolve this issue, TRAMP currently takes the sledgehammer -approach of making the release values of the revision control tools -local to each TRAMP buffer, forcing VC to determine these values again -each time a new file is visited. - - This has, quite obviously, some performance implications. Thankfully, -most of the common operations performed by VC do not actually require -that the remote version be known. This makes the problem far less -apparent. - - Eventually these values will be captured by TRAMP on a system by -system basis and the results cached to improve performance. - - -File: tramp.info, Node: Files directories and localnames, Next: Issues, Prev: Version Control, Up: Top - -9 How file names, directories and localnames are mangled and managed. -********************************************************************* - -* Menu: - -* Localname deconstruction:: Breaking a localname into its components. - - -File: tramp.info, Node: Localname deconstruction, Up: Files directories and localnames - -9.1 Breaking a localname into its components. -============================================= - -TRAMP file names are somewhat different, obviously, to ordinary file -names. As such, the lisp functions `file-name-directory' and -`file-name-nondirectory' are overridden within the TRAMP package. - - Their replacements are reasonably simplistic in their approach. They -dissect the filename, call the original handler on the localname and -then rebuild the TRAMP file name with the result. - - This allows the platform specific hacks in the original handlers to -take effect while preserving the TRAMP file name information. - - -File: tramp.info, Node: Issues, Prev: Files directories and localnames, Up: Top - -10 Debatable Issues and What Was Decided -**************************************** - - * The uuencode method does not always work. - - Due to the design of TRAMP, the encoding and decoding programs - need to read from stdin and write to stdout. On some systems, - `uudecode -o -' will read stdin and write the decoded file to - stdout, on other systems `uudecode -p' does the same thing. But - some systems have uudecode implementations which cannot do this at - all--it is not possible to call these uudecode implementations with - suitable parameters so that they write to stdout. - - Of course, this could be circumvented: the `begin foo 644' line - could be rewritten to put in some temporary file name, then - `uudecode' could be called, then the temp file could be printed - and deleted. - - But I have decided that this is too fragile to reliably work, so - on some systems you'll have to do without the uuencode methods. - - * TRAMP does not work on XEmacs 20. - - This is because it requires the macro `with-timeout' which does not - appear to exist in XEmacs 20. I'm somewhat reluctant to add an - emulation macro to TRAMP, but if somebody who uses XEmacs 20 steps - forward and wishes to implement and test it, please contact me or - the mailing list. - - * The TRAMP filename syntax differs between GNU Emacs and XEmacs. - - The GNU Emacs maintainers wish to use a unified filename syntax for - Ange-FTP and TRAMP so that users don't have to learn a new syntax. - It is sufficient to learn some extensions to the old syntax. - - For the XEmacs maintainers, the problems caused from using a - unified filename syntax are greater than the gains. The XEmacs - package system uses EFS for downloading new packages. So, - obviously, EFS has to be installed from the start. If the - filenames were unified, TRAMP would have to be installed from the - start, too. - - *Note:* If you'ld like to use a similar syntax like EFS, you need - the following settings in your init file: - - (setq tramp-unified-filenames t) - (require 'tramp) - - The autoload of the XEmacs TRAMP package must be disabled. This - can be achieved by setting file permissions `000' to the files - `.../xemacs-packages/lisp/tramp/auto-autoloads.el*'. - - In case of unified filenames, all XEmacs download sites are added - to `tramp-default-method-alist' with default method `ftp' *Note - Default Method::. These settings shouldn't be touched for proper - working of the XEmacs package system. - - The syntax for unified filenames is described in the TRAMP manual - for GNU Emacs. - - -File: tramp.info, Node: Concept Index, Next: Version Control, Prev: Frequently Asked Questions, Up: Top - -Concept Index -************* - -[index] -* Menu: - -* .login file: Remote shell setup. (line 6) -* .profile file: Remote shell setup. (line 6) -* auto-save: Auto-save and Backup. - (line 6) -* backup: Auto-save and Backup. - (line 6) -* base-64 encoding: Inline methods. (line 18) -* behind the scenes: Overview. (line 53) -* bug reports: Bug Reports. (line 6) -* choosing the right method: Default Method. (line 51) -* compile: Compilation. (line 6) -* configuration: Configuration. (line 6) -* connection types, overview: Connection types. (line 6) -* create your own methods: Customizing Methods. (line 6) -* customizing completion: Customizing Completion. - (line 6) -* customizing methods: Customizing Methods. (line 6) -* Cygwin and ssh-agent: Windows setup hints. (line 26) -* Cygwin, issues: Windows setup hints. (line 6) -* default configuration: Configuration. (line 6) -* default method: Default Method. (line 6) -* details of operation: Overview. (line 53) -* development history: History. (line 6) -* dired: Dired. (line 6) -* external methods: Connection types. (line 16) -* external transfer methods <1>: External transfer methods. - (line 6) -* external transfer methods: Connection types. (line 16) -* FAQ: Frequently Asked Questions. - (line 6) -* fcp (with fcp method): External transfer methods. - (line 101) -* fcp method: External transfer methods. - (line 101) -* filename completion: Filename completion. (line 6) -* filename examples: Filename Syntax. (line 6) -* filename syntax: Filename Syntax. (line 6) -* filename syntax for multi-hop files: Multi-hop filename syntax. - (line 6) -* frequently asked questions: Frequently Asked Questions. - (line 6) -* fsh (with fcp method): External transfer methods. - (line 101) -* fsh method: External transfer methods. - (line 114) -* ftp method: External transfer methods. - (line 120) -* history: History. (line 6) -* hop method rsh: Multi-hop Methods. (line 28) -* hop method ssh: Multi-hop Methods. (line 35) -* hop method su: Multi-hop Methods. (line 39) -* hop method sudo: Multi-hop Methods. (line 52) -* hop method telnet: Multi-hop Methods. (line 23) -* how it works: Overview. (line 53) -* inline methods <1>: Inline methods. (line 6) -* inline methods: Connection types. (line 16) -* Kerberos (with krlogin method): Inline methods. (line 100) -* km krlogin: Inline methods. (line 100) -* method fcp: External transfer methods. - (line 101) -* method fsh: External transfer methods. - (line 114) -* method ftp: External transfer methods. - (line 120) -* method krlogin: Inline methods. (line 100) -* method multi: Multi-hop Methods. (line 14) -* method plink: Inline methods. (line 104) -* method pscp: External transfer methods. - (line 93) -* method rcp: External transfer methods. - (line 26) -* method rsh: Inline methods. (line 28) -* method rsync: External transfer methods. - (line 62) -* method scp: External transfer methods. - (line 35) -* method scpx: External transfer methods. - (line 77) -* method scpx with Cygwin: Windows setup hints. (line 18) -* method smb: External transfer methods. - (line 125) -* method ssh: Inline methods. (line 36) -* method sshx: Inline methods. (line 75) -* method sshx with Cygwin: Windows setup hints. (line 8) -* method su: Inline methods. (line 62) -* method sudo: Inline methods. (line 66) -* method telnet: Inline methods. (line 58) -* methods, external transfer <1>: External transfer methods. - (line 6) -* methods, external transfer: Connection types. (line 16) -* methods, inline <1>: Inline methods. (line 6) -* methods, inline: Connection types. (line 16) -* methods, multi-hop <1>: Multi-hop Methods. (line 6) -* methods, multi-hop: Connection types. (line 39) -* methods, out-of-band <1>: External transfer methods. - (line 6) -* methods, out-of-band: Connection types. (line 16) -* mimencode: Inline methods. (line 18) -* multi method: Multi-hop Methods. (line 14) -* multi-hop filename syntax: Multi-hop filename syntax. - (line 6) -* multi-hop methods <1>: Multi-hop Methods. (line 6) -* multi-hop methods: Connection types. (line 39) -* obtaining Tramp: Obtaining Tramp. (line 6) -* out-of-band methods <1>: External transfer methods. - (line 6) -* out-of-band methods: Connection types. (line 16) -* overview: Overview. (line 6) -* passwords: Password caching. (line 6) -* plink (with pscp method): External transfer methods. - (line 93) -* plink method: Inline methods. (line 104) -* pscp (with pscp method): External transfer methods. - (line 93) -* pscp method: External transfer methods. - (line 93) -* PuTTY (with pscp method): External transfer methods. - (line 93) -* rcp (with rcp method): External transfer methods. - (line 26) -* rcp method: External transfer methods. - (line 26) -* recompile: Compilation. (line 6) -* remote shell setup: Remote shell setup. (line 6) -* rsh (with rcp method): External transfer methods. - (line 26) -* rsh hop method: Multi-hop Methods. (line 28) -* rsh method: Inline methods. (line 28) -* rsync (with rsync method): External transfer methods. - (line 62) -* rsync method: External transfer methods. - (line 62) -* scp (with scp method): External transfer methods. - (line 35) -* scp (with scpx method): External transfer methods. - (line 77) -* scp method: External transfer methods. - (line 35) -* scpx method: External transfer methods. - (line 77) -* scpx method with Cygwin: Windows setup hints. (line 18) -* selecting config files: Customizing Completion. - (line 6) -* shell init files: Remote shell setup. (line 6) -* smb method: External transfer methods. - (line 125) -* ssh (with rsync method): External transfer methods. - (line 62) -* ssh (with scp method): External transfer methods. - (line 35) -* ssh (with scpx method): External transfer methods. - (line 77) -* ssh hop method: Multi-hop Methods. (line 35) -* ssh method: Inline methods. (line 36) -* ssh-agent: External transfer methods. - (line 17) -* SSH_AUTH_SOCK and XEmacs on Windows: Windows setup hints. (line 26) -* sshx method: Inline methods. (line 75) -* sshx method with Cygwin: Windows setup hints. (line 8) -* su hop method: Multi-hop Methods. (line 39) -* su method: Inline methods. (line 62) -* sudo hop method: Multi-hop Methods. (line 52) -* sudo method: Inline methods. (line 66) -* telnet hop method: Multi-hop Methods. (line 23) -* telnet method: Inline methods. (line 58) -* tset Unix command: Remote shell setup. (line 60) -* type-ahead: Usage. (line 14) -* Unix command tset: Remote shell setup. (line 60) -* using non-standard methods: Customizing Methods. (line 6) -* using TRAMP: Usage. (line 6) -* uuencode: Inline methods. (line 18) -* Version Control: Version Control. (line 6) - - - -Tag Table: -Node: Top1363 -Node: Overview6036 -Ref: Overview-Footnote-112103 -Node: Obtaining Tramp12255 -Node: History13839 -Node: Configuration14565 -Node: Connection types16601 -Node: Inline methods18774 -Node: External transfer methods23878 -Ref: External transfer methods-Footnote-131530 -Node: Multi-hop Methods31609 -Node: Default Method34551 -Node: Customizing Methods38468 -Node: Customizing Completion38883 -Node: Password caching42296 -Node: Remote Programs43953 -Node: Remote shell setup45587 -Node: Auto-save and Backup52120 -Node: Windows setup hints54078 -Node: Usage55847 -Node: Filename Syntax57123 -Node: Multi-hop filename syntax59249 -Node: Filename completion61062 -Node: Dired62558 -Node: Compilation63027 -Node: Bug Reports63834 -Node: Frequently Asked Questions65264 -Node: Version Control70581 -Node: Version Controlled Files71723 -Node: Remote Commands72142 -Node: Changed workfiles73049 -Node: Checking out files73925 -Node: Miscellaneous Version Control74388 -Node: Remote File Ownership74814 -Node: Back-end Versions76129 -Node: Files directories and localnames77604 -Node: Localname deconstruction77939 -Node: Issues78647 -Node: Concept Index81417 - -End Tag Table diff --git a/xemacs-packages/info/tramp_ja.info b/xemacs-packages/info/tramp_ja.info deleted file mode 100644 index e472d369..00000000 --- a/xemacs-packages/info/tramp_ja.info +++ /dev/null @@ -1,2043 +0,0 @@ -This is tramp_ja.info, produced by makeinfo version 4.7 from -tramp_ja.texi. - - Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, -Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.1 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover texts - being "A GNU Manual", and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - "GNU Free Documentation License" in the Emacs manual. - - (a) The FSF's Back-Cover Text is: "You have freedom to copy and - modify this GNU Manual, like GNU software. Copies published by - the Free Software Foundation raise funds for GNU development." - - This document is part of a collection distributed under the GNU - Free Documentation License. If you want to distribute this - document separately from the collection, you can do so by adding a - copy of the license to the document, as described in section 6 of - the license. - -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* TRAMP-ja: (tramp_ja). Transparent Remote Access, Multiple Protocol - Emacs remote file access via rsh and rcp - (Japanese). -END-INFO-DIR-ENTRY - - -File: tramp_ja.info, Node: Top, Next: Overview, Prev: (dir), Up: (dir) - -TRAMP version 2.0.53 ¥æ¡¼¥¶¡¼¥Þ¥Ë¥å¥¢¥ë -*************************************** - -¤³¤Î¥Õ¥¡¥¤¥ë¤Ï TRAMP version 2.0.53 ¤Ë¤Ä¤¤¤ÆÀâÌÀ¤·¤Þ¤¹¡£ TRAMP ¤Ï -XEmacs ¤Ë¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤ÎÊÔ½¸µ¡Ç½¤òÄ󶡤¹¤ë ¥Ñ¥Ã¥±¡¼¥¸¤Ç¤¹¡£ - - TRAMP ¤Ï `Transparent Remote (file) Access, Multiple Protocol' -¤Îά¾Î¤Ç¤¹¡£¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ï EFS ¤Î¤è¤¦¤Ê -¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤ÎÊÔ½¸µ¡Ç½¤òÄ󶡤·¤Þ¤¹¡£ - - °Û¤Ê¤ëÅÀ¤Ï¥Õ¥¡¥¤¥ë¤ÎžÁ÷ÊýË¡¤Ç¤¹¡£EFS ¤Ï¡¢ -¥í¡¼¥«¥ë¥Û¥¹¥È¤È¥ê¥â¡¼¥È¥Û¥¹¥È´Ö¤Î¥Õ¥¡¥¤¥ëžÁ÷¤Ë FTP ¤ò»ÈÍѤ·¤Þ¤¹¡£ -°ìÊý TRAMP ¤Ï¡¢`rsh' ¤È `rcp' ¤¢¤ë¤¤¤Ï¾¤ÎƱ¤¸¤è¤¦ -¤ÊƯ¤­¤ò¤¹¤ë¥×¥í¥°¥é¥à¡¢Î㤨¤Ð `ssh' ¤ä `scp'¤ò»ÈÍѤ· ¤Þ¤¹¡£ - - ¤³¤Î¥É¥­¥å¥á¥ó¥È¤ÎºÇ¿·¥Ð¡¼¥¸¥ç¥ó¤Ï web ¥µ¥¤¥È -`http://www.freesoftware.fsf.org/tramp/' ¤Ë¤¢¤ê¤Þ¤¹¡£ - - TRAMP¤Î¤¿¤á¤Î¥á¡¼¥ê¥ó¥°¥ê¥¹¥È -, -¤¬Â¸ºß¤·¤Þ¤¹¡£¥¢¡¼¥«¥¤¥Ö¤ÏÄ̾ï¤Î Savannah ¥¢¡¼¥«¥¤¥Ö¤ÈƱ¤¸¾ì½ê¤È¡¢ -`http://www.mail-archive.com/emacs-rcp@ls6.cs.uni-dortmund.de/' -¤Ë¤¢¤ê¤Þ¤¹¡£ - - Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, -Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.1 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover texts - being "A GNU Manual", and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - "GNU Free Documentation License" in the Emacs manual. - - (a) The FSF's Back-Cover Text is: "You have freedom to copy and - modify this GNU Manual, like GNU software. Copies published by - the Free Software Foundation raise funds for GNU development." - - This document is part of a collection distributed under the GNU - Free Documentation License. If you want to distribute this - document separately from the collection, you can do so by adding a - copy of the license to the document, as described in section 6 of - the license. - -* Menu: - -* Overview:: TRAMP ¤Ç²Äǽ¤Ê»ö¡¢ÉÔ²Äǽ¤Ê»ö - -¥¨¥ó¥É¥æ¡¼¥¶¡¼¸þ¤±: - -* Obtaining Tramp:: TRAMP ¤ÎÆþ¼êÊýË¡ -* History:: TRAMP ¤ÎÎò»Ë -* Configuration:: TRAMP ¤ÎÀßÄê -* Usage:: TRAMP ¤Î»È¤¤Êý -* Bug Reports:: ¥Ð¥°¤äÌäÂê¤ÎÊó¹ð -* Frequently Asked Questions:: ¤è¤¯¤¢¤ë¼ÁÌä¤È¤½¤ÎÅú -* Concept Index:: ¤½¤ì¤¾¤ì¤Î³µÇ°¤Ë¤Ä¤¤¤Æ¤Î¹àÌÜ - -³«È¯¼Ô¸þ¤±: - -* Version Control:: ¥ê¥â¡¼¥È¥Ð¡¼¥¸¥ç¥ó¥³¥ó¥È¥í¡¼¥ë¤ÎÆâÉôÆ°ºî -* Files directories and localnames:: ¥Õ¥¡¥¤¥ë̾¡¢¥Ç¥£¥ì¥¯¥È¥ê¡¢¥í¡¼¥«¥ë̾¤¬¤É¤Î¤è¤¦¤Ë - ÊÑ´¹¤µ¤ì(mangled)¡¢´ÉÍý¤µ¤ì¤ë¤« -* Issues:: µÄÏÀ¤Î;ÃϤ¬¤¢¤ëÅÀ¤È²¿¤¬·èÄꤵ¤ì¤Æ¤¤¤ë¤« - - --- ¾ÜºÙ¤Ê¥Î¡¼¥É¤Î°ìÍ÷ --- - -TRAMP ¤ÎÀßÄê - -* Connection types:: ¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤ÎÀܳ¤Î¼ïÎà -* Inline methods:: ¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É -* External transfer methods:: ³°ÉôžÁ÷¥á¥½¥Ã¥É -* Multi-hop Methods:: ¥Þ¥ë¥Á¥Û¥Ã¥×¤ò»ÈÍѤ·¤¿¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤ÎÀܳ -* Default Method:: ¥Ç¥Õ¥©¥ë¥È¤Î¥á¥½¥Ã¥É¤ÎÁªÂò -* Customizing Methods:: Èóɸ½à¤Î¥á¥½¥Ã¥É¤ò»È¤¦ -* Customizing Completion:: ¥æ¡¼¥¶¡¿¥Û¥¹¥È̾Êä´°¤Î¤¿¤á¤ÎÀßÄê¥Õ¥¡¥¤¥ë¤ÎÁªÂò -* Remote Programs:: ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç TRAMP ¤¬¥×¥í¥°¥é¥à¤òȯ¸«¡¢»ÈÍѤ¹¤ëÊýË¡ -* Remote shell setup:: ¥ê¥â¡¼¥È¥·¥§¥ëÀßÄê¤Î¥Ò¥ó¥È -* Windows setup hints:: Cygwin ssh ¤Ë¤Þ¤Ä¤ï¤ë»öÊÁ -* Auto-save and Backup:: Auto-save ¤È¥Ð¥Ã¥¯¥¢¥Ã¥× - -TRAMP ¤Î»È¤¤Êý - -* Filename Syntax:: TRAMP ¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê -* Multi-hop filename syntax:: ¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê -* Filename completion:: ¥Õ¥¡¥¤¥ë̾¤ÎÊä´° -* Dired:: Dired - -¥ê¥â¡¼¥È¥Ð¡¼¥¸¥ç¥ó¥³¥ó¥È¥í¡¼¥ë¤ÎÆâÉôÆ°ºî - -* Version Controlled Files:: ¥Õ¥¡¥¤¥ë¤¬¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤µ¤ì¤Æ¤¤¤ë¤«¤É¤¦¤«¤ÎȽÃÇ -* Remote Commands:: ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥³¥Þ¥ó¥É¤Î¼Â¹Ô -* Changed workfiles:: ºî¶È¥Õ¥¡¥¤¥ë¤ÎÊѹ¹¤Îȯ¸« -* Checking out files:: ºî¶È¥Õ¥¡¥¤¥ë¤Î¥ê¥Ý¥¸¥È¥ê¤«¤é¤Î¼èÆÀ -* Miscellaneous Version Control:: ¤½¤Î¾¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Ë´Ø·¸¤¹¤ë»ö - -¤½¤Î¾¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Ë´Ø·¸¤¹¤ë»ö - -* Remote File Ownership:: VC ¤¬¥ï¡¼¥¯¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼¤òÄ´¤Ù¤ëÊýË¡ -* Back-end Versions:: VC ¤¬ RCS ¤Î¥Ð¡¼¥¸¥ç¥ó¤òÄ´¤Ù¤ëÊýË¡ - -¥Õ¥¡¥¤¥ë̾¡¢¥Ç¥£¥ì¥¯¥È¥ê¡¢¥í¡¼¥«¥ë̾¤¬¤É¤Î¤è¤¦¤ËÊÑ´¹¤µ¤ì(mangled)¡¢´ÉÍý¤µ¤ì¤ë¤« - -* Localname deconstruction:: ¥í¡¼¥«¥ë̾¤ÎÍ×ÁǤؤÎʬ²ò - - -File: tramp_ja.info, Node: Overview, Next: Obtaining Tramp, Prev: Top, Up: Top - -1 TRAMP ¤Î³µÍ× -************** - -XEmacs ¤Ë TRAMP ¤ò¥¤¥ó¥¹¥È¡¼¥ë¤¹¤ë¤È¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å -¤Î¥Õ¥¡¥¤¥ë¤Ë¥í¡¼¥«¥ë¥Õ¥¡¥¤¥ë¤ÈƱ¤¸¤è¤¦¤Ê´¶³Ð¤Ç¥¢¥¯¥»¥¹¤Ç¤­¤Þ¤¹¡£ -¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¥·¥¹¥Æ¥à¾å¤Î¥Õ¥¡¥¤¥ë¤ÎÊÔ½¸¡¢¥Ð¡¼¥¸¥ç¥ó¥³¥ó¥È¥í¡¼¥ë¡¢ -`dired' ¤òÆ©²áŪ¤Ë¼Â¹Ô¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - ¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤Î¥¢¥¯¥»¥¹¤Ë¤Ï¡¢`rsh' ¤ä `rlogin'¡¢ `telnet' -¥³¥Þ¥ó¥É¡¢¤¢¤ë¤¤¤Ï¤³¤ì¤é¤ËÎà»÷¤·¤¿ÀܳÊýË¡¤ò»ÈÍÑ -¤·¤Þ¤¹¡£¤³¤ì¤é¤Î¥³¥Þ¥ó¥É¤Ï ASCII ¤òÄ̲ᤵ¤»¤ë¤³¤È¤¬²Äǽ¤Ç¤Ê¤±¤ì¤Ð -¤Ê¤ê¤Þ¤»¤ó¤¬¡¢8-bit ¥¯¥ê¡¼¥ó¤Ç¤¢¤ëɬÍפϤ¢¤ê¤Þ¤»¤ó¡£ - - ¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤ÏÊ̤Υޥ·¥ó¤Ø¤Î `ssh' Àܳ¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£ -¤³¤ì¤Ï¡¢¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Î¤â¤Ã¤È¤â°ìÈÌŪ¤Ê»È¤¤Êý¤Î¤Ò¤È¤Ä¤Ç¤¹¡£ÆÃ¤Ë -`ftp'¥¢¥¯¥»¥¹¤¬µö²Ä¤µ¤ì¤Æ¤¤¤Ê¤¤¾ì¹ç¤Ë¤â¡¢Â¾¤Î¥Þ¥·¥ó¤Ø¤Î -Èæ³ÓŪ¥»¥­¥å¥¢¤Ê¥¢¥¯¥»¥¹¤¬²Äǽ¤È¤Ê¤ê¤Þ¤¹¡£ - - TRAMP ¤Ë¤è¤Ã¤Æ¼Â¹Ô¤µ¤ì¤ë¥¢¥¯¥Æ¥£¥Ó¥Æ¥£¤Î¤Û¤È¤ó¤É¤Ï¡¢¥ê¥â¡¼¥È -¥í¥°¥¤¥ó¤¬²Äǽ¤Ç¡¢Ã¼Ëö¾å¤Ç¼Â¹Ô¤Ç¤­¤ë¤³¤È¤À¤±¤òÍ׵ᤷ¤Þ¤¹¡£¥ê¥â¡¼¥È -¥Õ¥¡¥¤¥ë¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤¿¤á¤Ë¡¢TRAMP ¤Ï¥Õ¥¡¥¤¥ë¤ÎÆâÍƤò°ì»þŪ -¤Ë¥í¡¼¥«¥ë¥Þ¥·¥ó¤ËžÁ÷¤·¤Þ¤¹¡£ - - TRAMP ¤Ï¡¢¤µ¤Þ¤¶¤Þ¤ÊÊýË¡¤Ç¥Þ¥·¥ó´Ö¤Î¥Õ¥¡¥¤¥ëžÁ÷¤ò¤ª¤³¤Ê¤¤¤Þ¤¹¡£ -žÁ÷ÊýË¡¤Ï´Êñ¤ËÁªÂò¤Ç¤­¡¢¤¢¤Ê¤¿¤Î¥Ë¡¼¥º¤È¥Þ¥·¥ó´Ä¶­¤Ë±þ¤¸¤Æ»È¤¤ -¤ï¤±¤ë»ö¤¬¤Ç¤­¤Þ¤¹¡£ - -(Â礭¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ)¤â¤Ã¤È¤â®¤¤Å¾Á÷¥á¥½¥Ã¥É¤Ï¡¢¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤Î -žÁ÷¥Ñ¥Ã¥±¡¼¥¸¡¢¤¿¤È¤¨¤Ð `rcp'¡¢`scp'¡¢`rsync' -¤ò»È¤¦¤â¤Î¤Ç¤¹¡£¤³¤ì¤é¤Î¥á¥½¥Ã¥É¤Ï¡¢¥Õ¥¡¥¤¥ë¤Î¥³¥Ô¡¼¥³¥Þ¥ó¥É¤¬¥ê¥â¡¼¥È -¥Þ¥·¥ó¤Î¥Ñ¥¹¥ï¡¼¥É¤ò¤¿¤º¤Í¤Ê¤¤¾ì¹ç¤Ë¤Î¤ßÍ­¸ú¤Ç¤¹¡£ - - ¤â¤·¡¢¥ê¥â¡¼¥È¥³¥Ô¡¼¥á¥½¥Ã¥É¤¬»È¤¨¤Ê¤¤¾ì¹ç¤Î¤¿¤á¤Ë¡¢TRAMP ¤Ï¡¢ -¥·¥§¥ë¤òľÀÜÍøÍѤ·¤¿Éä¹æ²½Å¾Á÷ÊýË¡¤ò¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤Þ¤¹¡£¤³¤ÎÊýË¡¤ò»È¤¦ -¤¿¤á¤Ë¤Ï¡¢`mimencode' ¤« `uuencode' ¤¬¥ê¥â¡¼¥È¥Þ¥·¥ó -¾å¤Ë¸ºß¤·¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£¤³¤ì¤é¤Ï°ìÈ̤˾®¤µ¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ®¤¤ -ÊýË¡¤Ç¤¹¡£ - - ¾åµ­¤ÎÀ©¸ÂÆâ¤Ç¤¢¤ì¤Ð¡¢TRAMP ¤ÏÈó¾ï¤Ë¥Ñ¥ï¥Õ¥ë¤Ç¤¹¡£¤¿¤À¤·¡¢Ãí°Õ¤·¤Æ -¤ª¤«¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¤Î¤Ï¡¢¸½ºß¤Î TRAMP ¤Ï¡¢¥¨¥ó¥É¥æ¡¼¥¶¡¼¸þ¤±¤ÎÀöÎý -¤µ¤ì¤¿À½ÉʤȤϤۤɱ󤤾õÂ֤Ǥ¢¤ë¤È¤¤¤¦¤³¤È¤Ç¤¹¡£¤â¤¦¤·¤Ð¤é¤¯¤Î´Ö¤Ï¡¢»þ¡¹ -¤Á¤ç¤Ã¤Èº¤¤Ã¤¿»ö¤Ë¤Ê¤Ã¤¿¤ê¡¢¥³¡¼¥É¤ËÌäÂ꤬¤¢¤ë¤«¤â¤·¤ì¤Ê¤¤¤È¤¤¤¦¤³¤È¤ò -ǰƬ¤Ë¤ª¤¤¤Æ¤ª¤¤¤Æ¤¯¤À¤µ¤¤¡£ - -¤¹¤Ç¤Ë³«È¯¼Ô¤¬Æü¡¹¤Îºî¶È¤Ë»È¤¦»ö¤¬¤Ç¤­¤ëÄøÅ٤ˤϰÂÄꤷ¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢ -¥¤¥ó¥¹¥È¡¼¥ë¤ÈÀßÄê¤ò³Ð¤¨¤ë¤Î¤Ï¡¢ÀìÌçÍѸì¤Î¤»¤¤¤Ç¼ã´³Æñ¤·¤¤¤Ç¤·¤ç¤¦¡£ - - TRAMP ¤Ï¡¢¤Þ¤À¥¢¥¯¥Æ¥£¥Ö¤Ë³«È¯¤ò¤·¤Æ¤¤¤ëºÇÃæ¤Ç¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢¤É¤ó¤Ê -º³ºÙ¤ÊÌäÂê¤Ç¤¢¤Ã¤Æ¤â¡¢¤¼¤Ò TRAMP ³«È¯¼Ô¤ËÊó¹ð¤·¤Æ¤¯¤À¤µ¤¤¡£ *Note Bug -Reports::. - -ÉñÂæ¤Î΢¦ -.......... - -¤³¤Î¥»¥¯¥·¥ç¥ó¤Ç¤Ï¡¢TRAMP ¤ò»È¤¤¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤Ë¥¢¥¯¥»¥¹¤·¤¿»þ¤Ë¡¢ -ÉñÂæ¤Î΢¦¤Ç²¿¤¬¤ª¤³¤Ã¤Æ¤¤¤ë¤«¤òÀâÌÀ¤·¤Þ¤¹¡£ - - `C-x C-f' ¤È¥¿¥¤¥×¤·¡¢TRAMP ¤Î¥Õ¥¡¥¤¥ë̾¤Î°ìÉô¤òÆþÎϤ·¤Þ¤¹¡£ -¤½¤ì¤«¤é¡¢¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤Î¤¿¤á¤Ë `' ¤ò²¡¤·¤Þ¤¹¡£¤³¤ì -¤¬¤½¤Î¥Û¥¹¥È¤ËÂФ¹¤ë½é¤á¤Æ¤Î TRAMP ¤Îµ¯Æ°¤Î¾ì¹ç¡¢°Ê²¼¤Î¤è¤¦¤Ê»ö -¤¬¤ª¤³¤ê¤Þ¤¹¡£ - - * TRAMP ¤Ï¡¢Â¾¤Î¥Û¥¹¥È¤Ø¤ÎÀܳ¤¬É¬Íפʻö¤òǧ¼±¤·¤Þ¤¹¡£¤½¤ì¤«¤é - `telnet HOST' ¤« `rsh HOST -l USER' ¤¢¤ë¤¤ - ¤Ï¡¢¤½¤Î¾¤Î¥ê¥â¡¼¥È¥Û¥¹¥È¤ØÀܳ¤¹¤ë¤¿¤á¤Î¥Ä¡¼¥ë¤òµ¯Æ°¤·¤Þ¤¹¡£¤³¤ì¤é¤Î - ¥×¥í¥»¥¹¤È¤Î¥³¥ß¥å¥Ë¥±¡¼¥·¥ç¥ó¤Ï XEmacs ¤Î¥Ð¥Ã¥Õ¥¡¤ò·Ðͳ¤· - ¤Æ¤ª¤³¤Ê¤ï¤ì¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢¥ê¥â¡¼¥È¦¤«¤é¤Î½ÐÎϤϤ³¤Î¥Ð¥Ã¥Õ¥¡¤Ë½ÐÎÏ - ¤µ¤ì¤Þ¤¹¡£ - - * ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ï¡¢¥í¥°¥¤¥ó̾¤Î¥×¥í¥ó¥×¥È¤òɽ¼¨¤·¤Þ¤¹(`telnet' - ¤Î¾ì¹ç)¡£¥í¥°¥¤¥ó̾¤ÏÆþÎϤµ¤ì¤¿¥Õ¥¡¥¤¥ë̾¤Ë´Þ¤Þ¤ì¤Æ¤¤¤ë¤Î¤Ç¡¢TRAMP - ¤Ï¥í¥°¥¤¥ó̾¤È²þ¹Ô¤òÁ÷¿®¤·¤Þ¤¹¡£ - - * ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ï¡¢¥Ñ¥¹¥ï¡¼¥É¤¢¤ë¤¤¤Ï¥Ñ¥¹¥Õ¥ì¡¼¥º¤Î¥×¥í¥ó¥×¥È¤òɽ¼¨ - ¤·¤Þ¤¹(¤³¤ì¤Ï`rsh' ¤Î¾ì¹ç¤Ç¤¹¡£`telnet' ¤Î¾ì¹ç¤Ï¥í¥° - ¥¤¥ó̾¤òÁ÷¿®¤·¤¿¸å¤Ëɽ¼¨¤µ¤ì¤Þ¤¹)¡£TRAMP ¤Ï¥ß¥Ë¥Ð¥Ã¥Õ¥¡¤Ë¥×¥í¥ó - ¥×¥È¤òɽ¼¨¤·¡¢¥Ñ¥¹¥ï¡¼¥É¤Þ¤¿¤Ï¥Ñ¥¹¥Õ¥ì¡¼¥º¤ò¤¿¤º¤Í¤Þ¤¹¡£ - - ¥Ñ¥¹¥ï¡¼¥É¤«¥Ñ¥¹¥Õ¥ì¡¼¥º¤òÆþÎϤ¹¤ë¤È¡¢TRAMP ¤Ï¤½¤ì¤ò¥ê¥â¡¼¥È¥Û¥¹¥È - ¤ËÁ÷¿®¤·¡¢¼¡¤Ë²þ¹Ô¤òÁ÷¿®¤·¤Þ¤¹¡£ - - * TRAMP ¤Ï¡¢¥·¥§¥ë¥×¥í¥ó¥×¥È¤«¥í¥°¥¤¥ó¤Ë¼ºÇÔ¤·¤¿»Ý¤Î¥á¥Ã¥»¡¼¥¸¤òÂÔ¤Á - ¤Þ¤¹¡£ - - ¤â¤·¡¢TRAMP - ¤¬¡¢°ìÄê»þ´Ö(¤¿¤È¤¨¤Ð°ìʬ)ÂԤäƤ⡢¤³¤ì¤é¤Î¥á¥Ã¥»¡¼¥¸¤ò - ȯ¸«¤¹¤ë¤³¤È¤¬¤Ç¤­¤Ê¤«¤Ã¤¿¤é¡¢¥ê¥â¡¼¥È¥·¥§¥ë¤Î¥×¥í¥ó¥×¥È¤òȯ¸«¤Ç¤­¤Ê¤«¤Ã - ¤¿»Ý¤Î¥á¥Ã¥»¡¼¥¸¤ò½ÐÎϤ·¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤«¤éÁ÷¿®¤µ¤ì¤¿¥á¥Ã¥»¡¼¥¸¤òɽ¼¨ - ¤·¤Þ¤¹¡£ - - ¤â¤·¡¢TRAMP ¤¬ `login failed' ¤È¤¤¤¦¥á¥Ã¥»¡¼¥¸¤òȯ¸«¤·¤¿¤é¡¢¤½¤ì¤ò - ɽ¼¨¤·¡¢¥í¥°¥¤¥ó¤òÃæ»ß¤·¤Þ¤¹¡£¤³¤ì¤ÇºÆ¤Ó¥í¥°¥¤¥ó¤ò»î¤ß¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - * ¥í¥°¥¤¥ó¤ËÀ®¸ù¤·¡¢TRAMP - ¤¬¥·¥§¥ë¥×¥í¥ó¥×¥È¤òȯ¸«¤·¤¿¤È¤·¤Þ¤¹¡£¤³¤³¤Ç¡¢ TRAMP ¤Ï `/bin/sh' - ¤òµ¯Æ°¤·¤Þ¤¹¡£¤³¤ì¤Ï¡¢Bourne ¥·¥§¥ë¤È C - ¥·¥§¥ë¤Ç¤Ïʸˡ¤¬°Û¤Ê¤ë¤¿¤á¤Ç¤¹¡£(1) - - Bourne ¥·¥§¥ë¤¬µ¯Æ°¤µ¤ì¤¿¤é¡¢TRAMP - ¤Ï³Î¼Â¤ËÆ°ºî¤¹¤ë´Ä¶­¤ò½àÈ÷¤¹¤ë¤¿¤á - ¤Ë¤¤¤¯¤Ä¤«¤Î¥³¥Þ¥ó¥É¤òÁ÷¿®¤·¤Þ¤¹¡£echo - ¤ò¥ª¥Õ¤Ë¤·¡¢¥·¥§¥ë¥×¥í¥ó¥×¥È¤òÀßÄê - ¤·¤¿¤ê¡¢¤½¤Î¾¤¤¤¯¤Ä¤«¤Î»ö¤ò¤ª¤³¤Ê¤¤¤Þ¤¹¡£ - - * - ¤µ¤Æ¡¢¥ê¥â¡¼¥È¥·¥§¥ë¤¬µ¯Æ°¤µ¤ì¤­¤Á¤ó¤ÈÆ°ºî¤¹¤ë¾õÂ֤ˤʤê¤Þ¤·¤¿¡£¤³¤³¤Ç¡¢ - ²¿¤¬¤ª¤³¤ë¤Ï¤º¤À¤Ã¤¿¤«»×¤¤¤À¤·¤Æ¤¯¤À¤µ¤¤¡£¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤Ë¤É¤Î¤è¤¦¤Ê - ¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤¹¤ë¤«¤ò TRAMP - ¤¬Ä´¤Ù¡¢¥Õ¥¡¥¤¥ë̾¤òÊä´°¤Ç¤­¤ë¤è¤¦¤Ë¤Ê¤ë ¤³¤È¤Ç¤¹¡£ - - TRAMP ¤Ï `cd' ¤È `ls' ¥³¥Þ¥ó¥É¡¢¤½¤·¤Æ»þ¡¹ globbing ¤µ¤ì¤¿ `echo' - ¤ò¼Â¹Ô¤·¤Þ¤¹¡£¤³¤ì°Ê³°¤Ë¡¢¥Õ¥¡¥¤¥ë¤¬½ñ¤­¹þ¤ß²Äǽ - ¤«¤É¤¦¤«¡¢¥Ç¥£¥ì¥¯¥È¥ê¤«¤É¤¦¤«Åù¤òÄ´¤Ù¤ë¤¿¤á¤Ë `test' ¤¬¡¢¤·¤Ð - ¤·¤Ð»ÈÍѤµ¤ì¤Þ¤¹¡£¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤ò¤ª¤³¤Ê¤¦¤¿¤á¤Ë¡¢¤¹¤Ù¤Æ¤Î¥³¥Þ¥ó¥É¤Î½Ð - ÎϤϥѡ¼¥¹¤µ¤ì¤Þ¤¹¡£ - - * ¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤¬´°Î»¤·¡¢`C-xC-f'¤È´°Á´¤Ê¥Õ¥¡¥¤¥ë̾¤òÆþÎϤ·¡¢ - `' ¤ò²¡¤·¤¿¤È¤·¤Þ¤·¤ç¤¦¡£¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤¹¤ë¤¿¤á¤Ë¡¢¥ê¥â¡¼¥È - ¥Û¥¹¥È¤«¤é¥í¡¼¥«¥ë¥Û¥¹¥È¤Ë¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòžÁ÷¤¹¤ë»þ¤¬¤è¤¦¤ä¤¯¤ä¤Ã¤Æ - ¤­¤Þ¤·¤¿¡£ - - TRAMP - ¤¬¤É¤Î¤è¤¦¤Ë¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòžÁ÷¤¹¤ë¤Î¤«¤È¤¤¤¦ÀâÌÀ¤Ï¡¢¾å¤ò¸«¤Æ - ¤¯¤À¤µ¤¤¡£ - - ¥¤¥ó¥é¥¤¥óžÁ÷¤Î¤¿¤á¤Ë¡¢TRAMP ¤Ï `mimencode -b - /path/to/remote/file' - ¤Î¤è¤¦¤Ê¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤·¡¢½ÐÎϤ¬¥³¥ß¥å¥Ë¥±¡¼¥·¥ç¥ó¤Î¤¿¤á¤Î¥Ð¥Ã¥Õ¥¡¤Ë - ÃßÀѤµ¤ì¤ë¤Þ¤ÇÂÔ¤Á¤Þ¤¹¡£¤½¤·¤Æ¡¢¥Õ¥¡¥¤¥ë¤ÎÃæ¿È¤òºîÀ®¤¹¤ë¤¿¤á¤Ë¡¢½ÐÎϤò - Éü¹æ²½¤·¤Þ¤¹¡£ - - out-of-band žÁ÷¤Î¤¿¤á¤Ë¡¢TRAMP ¤Ï°Ê²¼¤Î¤è¤¦¤Ê¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤·¤Þ¤¹: - rcp user@host:/path/to/remote/file /tmp/tramp.4711 - ¤½¤·¤Æ¡¢¥í¡¼¥«¥ë¤Ê°ì»þ¥Õ¥¡¥¤¥ë `/tmp/tramp.4711' ¤ò¥Ð¥Ã¥Õ¥¡¤ËÆÉ¤ß - ¹þ¤ß¡¢°ì»þ¥Õ¥¡¥¤¥ë¤òºï½ü¤·¤Þ¤¹¡£ - - * - º£¡¢¤¢¤Ê¤¿¤Ï¥Ð¥Ã¥Õ¥¡¤ÎÆâÍƤòÊÔ½¸¤·¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢¹¬±¿¤Ë¤âÉñÂæ΢¤Ç²¿¤¬ - ¤ª¤³¤Ã¤Æ¤¤¤ë¤Î¤«¤Ëµ¤¤¬¤Ä¤­¤Þ¤»¤ó(¤³¤Î¥»¥¯¥·¥ç¥ó¤òÆɤà¤Þ¤Ç¤Ï¡¢¤½¤¦¤Ç¤·¤ç¤¦)¡£ - ºî¶È¤¬½ª¤ê¡¢¥Ð¥Ã¥Õ¥¡¤òÊݸ¤¹¤ë¤¿¤á¤Ë `C-x C-s' ¤ò²¡¤·¤Þ¤¹¡£ - - * ºÆ¤Ó¡¢TRAMP ¤Ï¥Õ¥¡¥¤¥ë¤ÎÆâÍƤò¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥¤¥ó¥é¥¤¥ó¤« - out-of-band - ¥á¥½¥Ã¥É¤ÇžÁ÷¤·¤Þ¤¹¡£¤³¤³¤Ç¤Ï¥Õ¥¡¥¤¥ë¤òÆɤ߻þ¤Ë¤ª¤³¤Ã¤Æ¤¤¤ë»ö¤ÈµÕ¤Î¤³¤È - ¤¬¤ª¤³¤Ã¤Æ¤¤¤Þ¤¹¡£ - - - ¤³¤ÎÀâÌÀ¤Ç¡¢TRAMP -¤ò»È¤¤¥Õ¥¡¥¤¥ë¤ò¥ª¡¼¥×¥ó¤·¤¿»þ¤ËÉñÂæ΢¤Ç¤ª¤³¤Ã¤Æ¤¤¤ë -»ö¤ò¤ï¤«¤Ã¤Æ¤â¤é¤¨¤ë¤³¤È¤ò´ê¤Ã¤Æ¤¤¤Þ¤¹¡£ - - ---------- Footnotes ---------- - - (1) ¥í¥°¥¤¥ó¥·¥§¥ë¤¬ `exec /bin/sh' ¤òÀµ¤·¤¤¥³¥Þ¥ó¥É¤È¤·¤Æǧ¼±¤»¤º¤Ë -`/bin/sh' ¤Îµ¯Æ°¤Ë¼ºÇÔ¤¹¤ë¤³¤È¤¬¤¢¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤¿¤Ö¤ó¡¢¤¢¤Ê¤¿¤Ï -Scheme ¥·¥§¥ë `scsh' ¤ò»È¤Ã¤Æ¤¤¤ë¤Î¤Ç¤·¤ç¤¦... - - -File: tramp_ja.info, Node: Obtaining Tramp, Next: History, Prev: Overview, Up: Top - -2 Tramp ¤ÎÆþ¼êÊýË¡ -****************** - -TRAMP ¤Ï¡¢¥¤¥ó¥¿¡¼¥Í¥Ã¥È¾å¤Ç¥Õ¥ê¡¼¤ËÇÛÉÛ¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ºÇ¿·ÈÇ¤Ï -`http://savannah.nongnu.org/download/tramp/' -¤«¤é¥À¥¦¥ó¥í¡¼¥É²Äǽ¤Ç¤¹¡£¤³¤ÎÃæ¤Ë¤Ï¡¢¥¤¥ó¥¹¥È¡¼¥ë¤ËɬÍ×¤Ê TRAMP -¤Î¤¹¤Ù¤Æ¤Î¥É¥­¥å¥á¥ó¥È¤È¥½¡¼¥¹¥³¡¼¥É¤¬´Þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢Emacs -(21.4 ¤«¤½¤ì°Ê¹ß¤Î¤â¤Î) ¤Ï¡¢TRAMP ¤ò´Þ¤ó¤Ç¤ª¤ê¡¢XEmacs ¤Ë¤â TRAMP -¤Î¥Ñ¥Ã¥±¡¼¥¸¤¬¤¢¤ê¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢¤½¤ì¤é¤ò»È¤¦Êý¤¬¤¿¤Ö¤ó´Êñ¤Ç¤·¤ç¤¦¡£ -¤·¤«¤·¡¢¤â¤·ºÇ¿·¤Î³«È¯ÈǤòµá¤á¤ë¤Î¤Ç¤¢¤ì¤Ð¡¢Â³¤­¤òÆɤó¤Ç²¼¤µ¤¤...... - - ËÁ¸±²È¤Î¤¿¤á¤Ë TRAMP ¤Ï CVS ¤«¤é¤âÆþ¼ê²Äǽ¤Ç¤¹¡£CVS ¤«¤éÆþ¼ê¤·¤¿ -¥Ð¡¼¥¸¥ç¥ó¤Ï¥½¡¼¥¹¥³¡¼¥É¤ÎºÇ¿·¥Ð¡¼¥¸¥ç¥ó¤Ç¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢ÉÔ´°Á´¤Ê -µ¡Ç½¤ä¿·¤¿¤ÊÌäÂê¤ò¤«¤«¤¨¤Æ¤¤¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤³¤Î¥Ð¡¼¥¸¥ç¥ó¤Ï¼«Ê¬ -¤ÎÀÕǤ¤Ç»ÈÍѤ·¤Æ¤¯¤À¤µ¤¤¡£ - - TRAMP ¤ÎºÇ¿·¤Î³«È¯¥Ð¡¼¥¸¥ç¥ó¤ò CVS ¤«¤éÆþ¼ê¤¹¤ëÊýË¡¤Ï¡¢°Ê²¼¤Ë¼¨¤¹ -Savannah ¥×¥í¥¸¥§¥¯¥È¥Ú¡¼¥¸¤Ë¹Ô¤Ã¤Æ°ìÈÖ¾å¤Î¥Ê¥Ó¥²¡¼¥·¥ç¥ó¥Ð¡¼¤Ë¤¢¤ë CVS -¤Î¥ê¥ó¥¯¤ò¥¯¥ê¥Ã¥¯¤¹¤ì¤Ð¸«¤ë¤³¤È¤¬½ÐÍè¤Þ¤¹¡£ - -`http://savannah.gnu.org/projects/tramp/' - -¤â¤·¤¯¤Ï¡¢°Ê²¼¤Î¥»¥Ã¥·¥ç¥ó¤ÎÎã¤Ë½¾¤Ã¤Æ²¼¤µ¤¤¡£ - - ] *cd ~/xemacs* - ] *cvs -d:pserver:anoncvs@subversions.gnu.org:/cvsroot/tramp login* - - CVS password: *(just hit RET here)* - ... - - ] *cvs -z3 -d:pserver:anoncvs@subversions.gnu.org:/cvsroot/tramp co tramp* - - ¤³¤ì¤Ç¡¢TRAMP ¤ÎºÇ¿·¥Ð¡¼¥¸¥ç¥ó¤¬´Þ¤Þ¤ì¤ë¥Ç¥£¥ì¥¯¥È¥ê `~/xemacs/tramp' -¤¬ºîÀ®¤µ¤ì¤ë¤Ï¤º¤Ç¤¹¡£°Ê²¼¤Î¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤¹¤ë¤³¤È¤Ë¤è¤ê¡¢ºÇ¿·¤Î¥Ð¡¼¥¸¥ç¥ó -¤Ë¹¹¿·¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹: - - ] *cd ~/xemacs/tramp* - ] *cvs update -d* - -CVS ¥ê¥Ý¥¸¥È¥ê¤«¤é¥Õ¥¡¥¤¥ë¤ò¹¹¿·¤·¤¿¤é¡¢¿·¤·¤¤ `configure' ¥¹¥¯¥ê¥×¥È -¤òÀ¸À®¤¹¤ë¤¿¤á¤Ë `autoconf' ¤ò¼Â¹Ô¤¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹: - - ] *cd ~/xemacs/tramp* - ] *autoconf* - - -File: tramp_ja.info, Node: History, Next: Configuration, Prev: Obtaining Tramp, Up: Top - -3 TRAMP ¤ÎÎò»Ë -************** - -TRAMP ¤Î³«È¯¤Ï 1998 ǯ¤Î 11·î²¼½Ü¤Ë»Ï¤Þ¤ê¤Þ¤·¤¿¡£¤½¤ÎÅö»þ¤Ï¡¢¤³¤Î -¥Ñ¥Ã¥±¡¼¥¸¤Ï `rssh.el' ¤È¸Æ¤Ð¤ì¤Æ¤¤¤Þ¤·¤¿¡£¥Õ¥¡¥¤¥ë¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤¿¤á -¤Î¤¿¤Ã¤¿¤Ò¤È¤Ä¤Î¥á¥½¥Ã¥É¤¬¤¢¤ë¤À¤±¤Ç¡¢`ssh' ¤ò»ÈÍѤ·¥ê¥â¡¼¥È -¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤·¡¢`scp' ¤Ç¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòžÁ÷¤·¤Æ¤¤¤Þ¤·¤¿¡£ -¤·¤Ð¤é¤¯¤·¤Æ¡¢Ì¾Á°¤¬ `rcp.el' ¤ËÊѤï¤ê¡¢º£¤Ï TRAMP ¤È¸Æ¤Ð¤ì¤Æ¤¤¤Þ¤¹¡£ -¤³¤ì¤Ëȼ¤¤¡¢¥ê¥â¡¼¥È¥·¥§¥ë¤òµ¯Æ°¤·¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòžÁ÷¤¹¤ë¿¤¯¤Î¥á¥½¥Ã¥É -¤¬Äɲ䵤ì¤Þ¤·¤¿¡£¤Þ¤¿¡¢VC ¥µ¥Ý¡¼¥È¤âÄɲ䵤ì¤Þ¤·¤¿¡£ - -¤â¤Ã¤È¤âºÇ¶á¤ÎÂ礭¤Êµ¡Ç½Äɲäϡ¢2000ǯ4·î¤Î¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É¤ÎÄɲäȡ¢ -2002ǯ7·î¤Î TRAMP ¤Ë¤ª¤±¤ë¥Õ¥¡¥¤¥ë̾¤È Ange-FTP ¤Ë¤ª¤±¤ë¥Õ¥¡¥¤¥ë̾¤Î -Åý°ì¤Ç¤¹¡£ - - -File: tramp_ja.info, Node: Configuration, Next: Usage, Prev: History, Up: Top - -4 TRAMP ¤ÎÀßÄê -************** - -TRAMP ¤Ï(Ä̾ï)¥¤¥ó¥¹¥È¡¼¥ë¤¹¤ë¤À¤±¤Ç´°Á´¤Ëµ¡Ç½¤·¤Þ¤¹¡£½é´ü¾õÂ֤Ǥϡ¢ -¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤ÎÀܳ¤Ë `ssh' ¥×¥í¥°¥é¥à¤ò»ÈÍѤ·¡¢base64 ¥¨¥ó -¥³¡¼¥Ç¥£¥ó¥°¤â¤·¤¯¤Ï uu ¥¨¥ó¥³¡¼¥Ç¥£¥ó¥°¤ò»ÈÍѤ¹¤ë¤è¤¦¤ËÀßÄꤵ¤ì¤Æ¤¤¤Þ -¤¹¡£ ½¾¤Ã¤ÆºÇ¤â´Êñ¤Ê¾ì¹ç¤Ë¤Ï `C-x C-f' ¤ÈÂǤÁ¹þ¤ó¤Ç¥Õ¥¡¥¤¥ë̾ -`/[USER@MACHINE]/PATH/TO.FILE'. ¤òÆþÎϤ¹¤ë¤À¤±¤Ç¤¹¡£ - -¥Û¥¹¥È¤Ë¤è¤Ã¤Æ¤Ï¡¢Àܳ¤ò³ÎΩ¤¹¤ë¤Î¤ËÌäÂ꤬µ¯¤­¤ë¤³¤È¤¬¤¢¤ê¤Þ¤¹¡£¤³¤ì¤Ï¡¢ -remote shell ¤Î¿¶¤ëÉñ¤¤¤Ë¤è¤ë¤â¤Î¤Ç¤¹¡£¤³¤Î¾ÜºÙ¤Ë¤Ä¤¤¤Æ¤Ï *Note Remote -shell setup::, ¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£ - -¤â¤·¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤È¤ÎÀܳ¤Ë¤³¤ì¤é¤Î¥³¥Þ¥ó¥É¤ò»ÈÍѤ·¤¿¤¯¤Ê¤¤¾ì¹ç¤Ï¡¢ -TRAMP ¤Î¥Ç¥Õ¥©¥ë¥È¤ÎÀܳ¤ÈžÁ÷¥á¥½¥Ã¥É¤òÊѹ¹¤·¤Æ¤¯¤À¤µ¤¤¡£¥ê¥â¡¼¥È -¥Þ¥·¥ó¤ËÀܳ¤·¥Õ¥¡¥¤¥ë¤òžÁ÷¤¹¤ë¤Î¤Ë»È¤¦¤³¤È¤Î¤Ç¤­¤ë TRAMP ¤Î¥á¥½¥Ã¥É -¤¬¤¤¤¯¤Ä¤«¤¢¤ê¤Þ¤¹ (*note Connection types::)¡£ - - ¤É¤Î¥á¥½¥Ã¥É¤¬¤Õ¤µ¤ï¤·¤¤¤«¤ï¤«¤é¤Ê¤¤¤Ê¤é¼¡¤ò¸«¤Æ²¼¤µ¤¤: *Note -Default Method::. - -* Menu: - -* Connection types:: ¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤ÎÀܳ¤Î¼ïÎà -* Inline methods:: ¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É -* External transfer methods:: ³°ÉôžÁ÷¥á¥½¥Ã¥É -* Multi-hop Methods:: ¥Þ¥ë¥Á¥Û¥Ã¥×¤ò»ÈÍѤ·¤¿¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤ÎÀܳ -* Default Method:: ¥Ç¥Õ¥©¥ë¥È¤Î¥á¥½¥Ã¥É¤ÎÁªÂò - ¤³¤³¤Ç¤Ï¤É¤Î¥á¥½¥Ã¥É¤ò»È¤¨¤Ð¤è¤¤¤« - ¤ï¤«¤é¤Ê¤¤¿Í¤Î¤ª¼êÅÁ¤¤¤â¤·¤Þ¤¹¡£ -* Customizing Methods:: Èóɸ½à¤Î¥á¥½¥Ã¥É¤ò»È¤¦ -* Customizing Completion:: ¥æ¡¼¥¶/¥Û¥¹¥È̾Êä´°¤Î¤¿¤á¤ÎÀßÄê¥Õ¥¡¥¤¥ë¤ÎÁªÂò -* Remote Programs:: ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç TRAMP ¤¬¥×¥í¥°¥é¥à¤òȯ¸«¡¢»ÈÍѤ¹¤ëÊýË¡ -* Remote shell setup:: ¥ê¥â¡¼¥È¥·¥§¥ëÀßÄê¤Î¥Ò¥ó¥È -* Windows setup hints:: Cygwin ssh ¤Ë¤Þ¤Ä¤ï¤ë»öÊÁ -* Auto-save and Backup:: Auto-save ¤È¥Ð¥Ã¥¯¥¢¥Ã¥× - - -File: tramp_ja.info, Node: Connection types, Next: Inline methods, Up: Configuration - -4.1 ¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤ÎÀܳ¤Î¼ïÎà -================================ - -žÁ÷¥á¥½¥Ã¥É¤Ë¤ÏÆó¤Ä¤Î´ðËÜŪ¤Ê¥¿¥¤¥×¤¬¤¢¤ê¡¢¤½¤ì¤¾¤ì¤ËĹ½ê¡¢Ã»½ê¤¬ -¤¢¤ê¤Þ¤¹¡£Î¾¼Ô¤È¤â¤Ë¡¢`rsh' ¤ä `ssh'¡¢`telnet' -¤Î¤è¤¦¤Ê¥ê¥â¡¼¥È¥·¥§¥ë¤Ë¥¢¥¯¥»¥¹¤¹¤ë¥×¥í¥°¥é¥à¤ò»ÈÍѤ·¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó -¤ËÀܳ¤·¤Þ¤¹¡£ - - ¤³¤Î¥³¥Í¥¯¥·¥ç¥ó¤Ï¡¢TRAMP ¤¬¥í¡¼¥«¥ë¥Þ¥·¥ó¤«¤é¥ê¥â¡¼¥È¥Þ¥·¥ó¤ØÆ©²áŪ -¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤¿¤á¤Ë¡¢¤µ¤Þ¤¶¤Þ¤Ê¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤ò¤ª¤³¤Ê¤¦¤¿¤á¤Ë»È¤ï¤ì¤Þ¤¹¡£ -¥Õ¥¡¥¤¥ë¤ò¥ª¡¼¥×¥ó¤·¤¿»þ¤Î¥á¥½¥Ã¥É¤¬°Û¤Ê¤ë¤À¤±¤Ç¤¹¡£ - -¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤òÆɤ߹þ¤ó¤À¤ê¡¢Êݸ¤¹¤ë»þ¤Ë¤Ï¡¢Æó¤Ä¤Î¥Þ¥·¥ó´Ö¤Ç¥Õ¥¡¥¤¥ë -¤ÎÆâÍƤòžÁ÷¤¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£¥Õ¥¡¥¤¥ë¤ÎÆâÍƤϡ¢¥Þ¥·¥ó¤Ë¥í¥°¥¤¥ó¤·¤¿¤Î -¤ÈƱ¤¸¥³¥Í¥¯¥·¥ç¥ó¤«¡¢`rcp' ¤ä `scp'¡¢`rsync' -¤Ê¤É¤Î¥ê¥â¡¼¥È¥³¥Ô¡¼¥×¥í¥°¥é¥à¤ò»ÈÍѤ·¤¿Ê̤Υ³¥Í¥¯¥·¥ç¥ó¤ÇžÁ÷¤µ¤ì¤Þ¤¹¡£ -Á°¼Ô¤Ï "¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É"¡¢¸å¼Ô¤Ï "out-of-band ¥á¥½¥Ã¥É" ¤¢¤ë¤¤¤Ï -"³°ÉôžÁ÷¥á¥½¥Ã¥É" (ά¤·¤Æ "³°Éô¥á¥½¥Ã¥É") ¤È¤è¤Ð¤ì¤Þ¤¹¡£ - - ¾¯¤Ê¤¯¤È¤âÂ礭¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ¤Ï¡¢°ìÈ̤˳°ÉôžÁ÷¥á¥½¥Ã¥É¤ÎÀ­Ç½¤Ï -¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤è¤ê¤¹¤°¤ì¤Æ¤¤¤Þ¤¹¡£¤½¤ÎÍýͳ¤Ï¡¢¥¤¥ó¥é¥¤¥óžÁ÷¤Ç¤Ï -¥Ç¡¼¥¿¤ÎÉä¹æ²½¡¢Éü¹æ²½¤ò¤ª¤³¤Ê¤¦É¬Íפ¬¤¢¤ë¤«¤é¤Ç¤¹¡£ - - ¤³¤Î¥ë¡¼¥ë¤ÎÍ£°ì¤ÎÎã³°¤Ï¡¢`scp' ¤ò»ÈÍѤ¹¤ëžÁ÷¥á¥½¥Ã¥É¤Ç¤¹¡£ -¤³¤ì¤é¤Î¥á¥½¥Ã¥É¤Î¼ÂºÝ¤Î¥Õ¥¡¥¤¥ëžÁ÷¤ÎÀ­Ç½¤Ï¹â¤¤¤Î¤Ç¤¹¤¬¡¢Å¾Á÷³«»Ï»þ -¤Î°Å¹æ²½¤Ë¤«¤«¤ï¤ë¥Í¥´¥·¥¨¡¼¥·¥ç¥ó¤Î¥ª¡¼¥Ð¡¼¥Ø¥Ã¥É¤¬¥Õ¥¡¥¤¥ëžÁ÷¤ÎÀ­Ç½ -¤òÄ¢¾Ã¤·¤Ë¤·¤Þ¤¹¡£ - -³°ÉôžÁ÷¥á¥½¥Ã¥É¤ò»È¤¦¤¿¤á¤Ë¤Ï¡¢¥ê¥â¡¼¥È¥³¥Ô¡¼¥³¥Þ¥ó¥É¤¬ÂÐÏÃŪ¤Ç¤Ê¤¤¡¢ -¤Ä¤Þ¤ê¥³¥Þ¥ó¥É¤¬¥Ñ¥¹¥ï¡¼¥É¤Î¤¿¤á¤Ë¥×¥í¥ó¥×¥È¤ò½ÐÎϤ·¤Ê¤¤¤³¤È¤¬É¬ÍפǤ¹¡£ -¤â¤·¡¢¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤʤ·¤Î¥ê¥â¡¼¥È¥³¥Ô¡¼¥³¥Þ¥ó¥É¤ò»È¤¦»ö¤¬¤Ç¤­¤Ê¤¤¤Î¤Ç -¤¢¤ì¤Ð¡¢¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ò»È¤¦É¬Íפ¬¤¢¤ê¤Þ¤¹¡£ - - ¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Î°ì¼ï¤Ë¡¢"¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É" ¤¬¤¢¤ê¤Þ¤¹¡£ -¤³¤Î¥á¥½¥Ã¥É¤ò»È¤¦¤È¡¢¤¤¤¯¤Ä¤«¤Î¥Û¥Ã¥×¤ò»È¤¤¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤ØÀܳ -¤Ç¤­¤Þ¤¹¡£¤³¤ì¤Ï¡¢¤¢¤Ê¤¿¤¬¥»¥­¥å¥¢¤Ê¥Í¥Ã¥È¥ï¡¼¥¯¤ÎÃæ¤Ë¤¤¤Æ¡¢Í׺ɥۥ¹¥È -¤ò·Ðͳ¤·¤Æ³°Éô¤ËÀܳ¤¹¤ë¾ì¹ç¤ËÊØÍø¤Ç¤¹¡£ - - -File: tramp_ja.info, Node: Inline methods, Next: External transfer methods, Prev: Connection types, Up: Configuration - -4.2 ¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É -====================== - -TRAMP ¤Î¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ÏÂçÊѶ¯ÎϤǡ¢³°ÉôžÁ÷¥á¥½¥Ã¥É¤ò»È¤¦»ö¤¬ -¤Ç¤­¤Ê¤¤¾õ¶·¤Ç¤âÆ°ºî¤·¤Þ¤¹¡£¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Ï¡¢telnet ·Ðͳ¤Ç¥ê¥â¡¼¥È -¥Þ¥·¥ó¤ËÀܳ¤·¤Æ¤¤¤ë»þ¤ËÆ°ºî¤¹¤ëÍ£°ì¤Î¥á¥½¥Ã¥É¤Ç¤¹(¥Û¥¹¥È´Ö¤Ç¤Ê¤¯ -_¥æ¡¼¥¶¡¼_ ´Ö¤Î¥Õ¥¡¥¤¥ëžÁ÷¤ò²Äǽ¤Ë¤¹¤ë¡¢¤Á¤ç¤Ã¤ÈÊѤï¤Ã¤¿¥á¥½¥Ã¥É -¤â¤¢¤ê¤Þ¤¹¡£°Ê²¼¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤)¡£ - -¤³¤ì¤é¤Î¥á¥½¥Ã¥É¤ò»È¤¦¤¿¤á¤Ë¤Ï¡¢Éä¹æ²½¡¢Éü¹æ²½¤Î¤¿¤á¤Î¥³¥Þ¥ó¥É¤¬¥ê¥â¡¼¥È -¥Þ¥·¥ó¾å¤Ë¸ºß¤·¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£¥í¡¼¥«¥ë¥Þ¥·¥ó¾å¤Ç¤Ï¡¢TRAMP ¤Ï -¥Õ¥¡¥¤¥ë¤òÉü¹æ²½¡¢Éä¹æ²½¤¹¤ë Emacs ¤Îµ¡Ç½¤ò»È¤¦¤«¡¢³°Éô¥³¥Þ¥ó¥É¤ò»ÈÍÑ -¤·¤Þ¤¹¡£ - - TRAMP ¤Ï¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¤ª¤¤¤Æ `mimencode' (`metamail' -¥Ñ¥Ã¥±¡¼¥¸¤Î°ìÉô) ¤ä `uuencode' ¤È¤¤¤Ã¤¿ -¥³¥Þ¥ó¥É¤Î¸ºß¤È¡¢¤½¤ì¤¬»È¤¨¤ë¤«¤É¤¦¤«¤òÄ´¤Ù¤Þ¤¹¡£ºÇ½é¤Î¿®Íê¤Ç¤­¤ë¥³¥Þ¥ó¥É¤¬ -»È¤ï¤ì¤Þ¤¹¡£¸¡º÷¥Ñ¥¹¤ò¥«¥¹¥¿¥Þ¥¤¥º¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£*Note Remote -Programs:: ¤ò»²¾È¤·¤Æ²¼¤µ¤¤¡£ - - ¤â¤·¤É¤Á¤é¤Î¥³¥Þ¥ó¥É¤â¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë̵¤«¤Ã¤¿¾ì¹ç¡¢ TRAMP ¤Ï¾®¤µ¤Ê -Perl ¤Î¥³¡¼¥É¤ò¥ê¥â¡¼¥È¥Û¥¹¥È¤ËžÁ÷¤·¡¢¤½¤ì¤ò¥¨¥ó¥³¡¼¥É¤ä¥Ç¥³¡¼¥É¤ËÍѤ¤ -¤è¤¦¤È¤·¤Þ¤¹¡£ - -`rsh' - ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë `rsh' ¤ÇÀܳ¤·¤Þ¤¹¡£¥»¥­¥å¥¢¤Ç¤Ê¤¤Àܳ¤Î°Ù¡¢ - ¶Ë¤á¤Æ¥í¡¼¥«¥ë¤Ê¥Û¥¹¥È¥È¥Ý¥í¥¸¡¼°Ê³°¤ËÍѤ¤¤ë¤Ù¤­¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£ - - `rsh' ¤ÎÂå¤ï¤ê¤Ë `remsh' ¥³¥Þ¥ó¥É¤òÄ󶡤¹¤ë¥ª¥Ú¥ì¡¼¥Æ - ¥£¥ó¥°¥·¥¹¥Æ¥à¤Ç¤Ï¥á¥½¥Ã¥É `remsh' ¤ò»È¤¦¤³¤È¤â¤Ç¤­¤Þ¤¹¡£Î㤨¤Ð - HP-UX ¤ä Cray UNICOS ¤Î¾ì¹ç¤¬¤¢¤Æ¤Ï¤Þ¤ê¤Þ¤¹¡£ - -`ssh' - ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë `ssh' ¤ÇÀܳ¤·¤Þ¤¹¡£`ssh' ¥Ñ¥Ã¥±¡¼¥¸ - ¤òÍѤ¤¤ÆÀܳ¤ò¤è¤ê¥»¥­¥å¥¢¤Ë¤·¤Æ¤¤¤ë¤³¤È¤ò½ü¤±¤ÐÀè¤Û¤É¤Î¥ª¥×¥·¥ç¥ó¤ÈƱ - ¤¸¤Ç¤¹¡£ - - `ssh1' ¤È `ssh2' ¤È¤¤¤¦Æó¤Ä¤ÎÊѼ郎¤¢¤ê¡¢¤½¤ì¤¾¤ì¤Ï `ssh -1' ¤È - `ssh -2' ¤ò¸Æ¤Ó½Ð¤·¤Þ¤¹¡£¤³¤Î¤è¤¦¤Ë¤·¤Æ¡¢ SSH ¥×¥í¥È¥³¥ë¥Ð¡¼¥¸¥ç¥ó - 1 ¤È 2 ¤Î¤É¤Á¤é¤òÍѤ¤¤Æ¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ - ¤¹¤ë¤«¤òÌÀ¼¨Åª¤ËÁªÂò¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£(SSH ¤ÎÀßÄê¥Õ¥¡¥¤¥ë - `~/.ssh/config' ¤Ç¤É¤Á¤é¤Î¥×¥í¥È¥³¥ë¤òÍѤ¤¤ë¤«»ØÄꤷ¡¢Ä̾ï¤Î `ssh' - ¥á¥½¥Ã¥É¤òÍѤ¤¤ë ¤³¤È¤â¤Ç¤­¤Þ¤¹¡£) - - ¤Þ¤¿¤½¤Î¤Û¤«¤Ë¡¢ `ssh1_old' ¤È `ssh2_old' ¤È¤¤¤¦Æó¤Ä¤ÎÊѼ郎 - ¸ºß¤·¡¢ÌÀ¼¨Åª¤Ë `ssh1' ¥³¥Þ¥ó¥É¤È `ssh2' ¥³¥Þ¥ó¥É¤ò»È¤¤¤Þ¤¹¡£ - ¤½¤ì¤é¤¬²¿¤«ÃΤé¤Ê¤¤¤Ê¤é¡¢¤³¤ì¤é¤Î¥ª¥×¥·¥ç¥ó¤Ï¤¢¤Ê¤¿¤Ë¤ÏɬÍפ¢¤ê¤Þ¤»¤ó¡£ - - `ssh' ¤Ë´ð¤Å¤¯Á´¤Æ¤Î¥á¥½¥Ã¥É¤Ï¡¢¥¯¥ë¡¼¥¸ÅªÆÃħ¤ò»ý¤Á¤Þ¤¹: - `host#42' - ¤Î¤è¤¦¤Ë¤·¤Æ(¼Â¥Û¥¹¥È̾¤Ë³¤±¤Æ¥Ï¥Ã¥·¥åµ­¹æ¡¢¤½¤·¤Æ¥Ý¡¼¥ÈÈÖ¹æ) - ¥Û¥¹¥È̾¤ò»ØÄꤹ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¤³¤ì¤Î°ÕÌ£¤Ï¡¢»ØÄꤷ¤¿¥Û¥¹¥È¤ËÀܳ¤¹¤ëºÝ¤Ë¡¢ - `ssh' ¥³¥Þ¥ó¥É¤Î°ú¿ô¤È¤·¤Æ `-p 42' ¤òÅϤ¹¤È¤¤¤¦¤³¤È¤Ç¤¹¡£ - -`telnet' - ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë `telnet' ¤ÇÀܳ¤·¤Þ¤¹¡£¤³¤ì¤Ï `rsh' ¥á¥½¥Ã¥É - ¤ÈƱÍͤ˥»¥­¥å¥¢¤Ç¤Ê¤¤ÊýË¡¤Ç¤¹¡£ - -`su' - ¤³¤Î¥á¥½¥Ã¥É¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤·¤Þ¤»¤ó¡£¤½¤Î¤«¤ï¤ê¤Ë `su' - ¥×¥í¥°¥é¥à¤ò»È¤¦¤³¤È¤Ç¾¤Î¥æ¡¼¥¶¤È¤·¤Æ¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤¹¤ë¤³¤È¤ò²Äǽ¤È - ¤·¤Þ¤¹¡£ - -`sudo' - ¤³¤Î¥á¥½¥Ã¥É¤Ï¡¢`su' ¥á¥½¥Ã¥É¤Ë»÷¤Æ¤¤¤Þ¤¹¤¬¡¢°ã¤¦¥æ¡¼¥¶¡¼¤Ë¤Ê¤ë - ¤¿¤á¤Ë `su' ¤Ç¤Ê¤¯ `sudo' ¤ò»ÈÍѤ·¤Þ¤¹¡£ - - ¤½¤Î¥æ¡¼¥¶¡¼¤Ç¥·¥§¥ë¤òµ¯Æ°¤Ç¤­¤ë¤è¤¦¤Ë¡¢`sudo' ¤¬ÀßÄꤵ¤ì¤Æ¤¤¤Ê - ¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¤³¤È¤ËÃí°Õ¤·¤Æ¤¯¤À¤µ¤¤¡£`ls' ¤È `mimedecode' - ¤Îµ¯Æ°¤Îµö²Ä¤À¤±¤Ç½½Ê¬¤Ç¤¢¤ì¤Ð¤è¤¤¤Î¤Ç¤¹¤¬¡¢¤½¤Î¤è¤¦¤Ë¼ÂÁõ¤¹¤ë¤Î¤Ï´Êñ¤Ç¤Ï - ¤Ê¤¯¡¢¤Þ¤À̵Íý¤Ç¤¹¡£ - -`sshx' - ¤ªÊ¬¤«¤ê¤Î¤è¤¦¤Ë¡¢¤³¤ì¤Ï `ssh' ¤È¤Á¤ç¤Ã¤È°ã¤Ã¤¿Îà»÷ʪ¤Ç¤¹¡£ `ssh' - ¤¬¥ê¥â¡¼¥È¥Û¥¹¥È¤ÇÄ̾ï¤ÎÂÐÏÃŪ¥·¥§¥ë¤ò³«¤¯¤Î¤ËÂФ·¡¢ - ¤³¤Î¥ª¥×¥·¥ç¥ó¤Ï `ssh -t -t HOST -l USER /bin/sh' - ¤ò»È¤Ã¤ÆÀܳ¤ò¹Ô¤Ê¤¤¤Þ¤¹¡£¤³¤ÎÊýË¡¤Ï¡¢Ä̾ï¤Î¥í¥°¥¤¥ó¥·¥§¥ë¤¬¡¢¥í¥°¥¤¥ó - ¤ÎºÝ¤Ë¼ÁÌä¤ò¤·¤Æ¤¯¤ë¤è¤¦¤ËÀßÄꤷ¤Æ¤¢¤ë¾ì¹ç¤ËÍ­ÍѤǤ¹¡£¤³¤Î¼ê½ç¤Ë¤è¤ê - ¤½¤ì¤é¤Î¼ÁÌä¤ò²óÈò¤·¤Æ¡¢`ɸ½àŪ¤Ê' ¥í¥°¥¤¥ó¥·¥§¥ë¤ò TRAMP ¤Ë»È¤ï¤» - ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - ¤³¤Î¼ê³¤­¤Ï `ssh' ¼«¿È¤«¤é¤Î¼ÁÌä¤òÇÓ½ü¤·¤Ê¤¤¤³¤È¤ËÃí°Õ¤·¤Æ²¼ - ¤µ¤¤¡£Î㤨¤Ð¥ê¥â¡¼¥È¥Û¥¹¥È¤Î¥Û¥¹¥È¸°¤¬Ì¤ÃΤÎʪ¤Ç¤¢¤ë¾ì¹ç¤Ë¡¢"Are - you sure you want to continue connecting?" ¤È `ssh' ¤¬¿Ö¤¤¤Æ¤¯¤ë - ¤«¤â¤·¤ì¤Þ¤»¤ó¡£TRAMP ¤Ï(º£¤Î¤È¤³¤í)¤½¤Î¤è¤¦¤Ê¼ÁÌä¤ò°·¤¦ÊýË¡¤òÃΤé - ¤Ê¤¤¤Î¤Ç¡¢¤½¤Î¤è¤¦¤Ê¼ÁÌä¤ò¤µ¤ì¤Ê¤¤¤Ç¥í¥°¥¤¥ó¤Ç¤­¤ë¤è¤¦¤Ë¤·¤Æ¤ª¤¯É¬Íפ¬ - ¤¢¤ê¤Þ¤¹¡£ - - ¤³¤Î¼ê½ç¤Ï¡¢ `ssh' ¤ò Emacs ¥Ð¥Ã¥Õ¥¡¤«¤é¸Æ¤Ö¤È pseudo tty ¤ò³ä - ¤êÅö¤Æ¤Æ¤Ê¤¤¤È¸À¤ï¤ì¤Æ¤·¤Þ¤¦ Windows - ¥æ¡¼¥¶¤Ë¤È¤Ã¤Æ¤âÍ­ÍѤǤ¹¡£¤³¤Î»þ¡¢ - ¥í¥°¥¤¥ó¥·¥§¥ë¤Ï¥·¥§¥ë¥×¥í¥ó¥×¥È¤ò°ìÀÚɽ¼¨¤·¤è¤¦¤È¤·¤Ê¤¯¤Æ¡¢¤½¤ì¤Ï - TRAMP ¤òÂçÊѺ®Í𤵤»¤Æ¤·¤Þ¤¤¤Þ¤¹¡£Ì¤ÃΤÎÍýͳ¤Ë¤è¤ê¡¢¤¤¤¯¤Ä¤«¤Î - `ssh' ¤Î Windows ¤Ø¤Î°Ü¿¢ÈÇ(¤¿¤Ö¤ó Cygwin ¤Î¤â¤Î¤â)¤Ï `-t' - ¥ª¥×¥·¥ç¥ó¤òÆó¤Ä½Å¤Í¤Æ»È¤¦¤³¤È¤òÍ׵ᤷ¤Þ¤¹¡£ - - ¤³¤ì¤Ï `-p' ¥¯¥ë¡¼¥¸¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£ - -`krlogin' - ¤³¤Î¥á¥½¥Ã¥É¤â `ssh' ¤Ë»÷¤Æ¤¤¤Þ¤¹¡£¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤¹¤ë¤Î¤Ë - `krlogin -x' ¥³¥Þ¥ó¥É¤ò»È¤¦¤À¤±¤Ç¤¹¡£ - -`plink' - ¤³¤Î¥á¥½¥Ã¥É¤Ï SSH ¤Î PuTTY ¼ÂÁõ¤ò»È¤Ã¤Æ¤¤¤ë Windows ¥æ¡¼¥¶¤Ë¤È¤Ã¤Æ - ¤È¤Æ¤â¶½Ì£¿¼¤¤¤â¤Î¤Ç¤¹¡£¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤¹¤ë¤Î¤Ë `plink - -ssh' ¤ò»È¤¤¤Þ¤¹¡£ - - ¤µ¤é¤Ë¥á¥½¥Ã¥É `plink1' ¤¬Ä󶡤µ¤ì¤Þ¤¹¡£¤½¤ì¤Ï ÌÀ¼¨Åª¤Ë SSH - ¥×¥í¥È¥³¥ë¥Ð¡¼¥¸¥ç¥ó 1 ¤ò»È¤¦¤¿¤á¤Ë `plink -1 -ssh' - ¤ò¸Æ¤Ó½Ð¤·¤Þ¤¹¡£ - - CCC: SSH key - ¤ò¼õÍý¤¹¤ë¤¿¤á¤Ë¥³¥Þ¥ó¥É¥é¥¤¥ó¤«¤é¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø·Ò¤°É¬Í×¤Ï - ¤¢¤ë¤Î¤«? ¤³¤ì¤Ï¼«Æ°²½¤Ç¤­¤Ê¤¤¤«? - - CCC: `plink' ¤Ï `-p' ¥ª¥×¥·¥ç¥ó¤ò¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤ë¤«? ¤¤¤º¤ì¤Ë ¤»¤è - TRAMP ¤Ï¤½¤ì¤ò¥µ¥Ý¡¼¥È¤¹¤ë¡£ - - - -File: tramp_ja.info, Node: External transfer methods, Next: Multi-hop Methods, Prev: Inline methods, Up: Configuration - -4.3 ³°ÉôžÁ÷¥á¥½¥Ã¥É -==================== - -³°ÉôžÁ÷¥á¥½¥Ã¥É¤ÏÊ£¿ô¤Î¥Á¥ã¥Í¥ë¤ò»ÈÍѤ·¤Þ¤¹¡£¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤Î¤¿¤á¤Ë -¥ê¥â¡¼¥È¥·¥§¥ë¤Î¥³¥Í¥¯¥·¥ç¥ó¤ò»È¤¤¡¢¥Õ¥¡¥¤¥ëžÁ÷¤Ë¤Ï¡¢³°Éô¥×¥í¥°¥é¥à -¤ò»È¤¤¤Þ¤¹¡£ - -¤³¤ì¤Ï¡¢¥¤¥ó¥é¥¤¥óžÁ÷»þ¤Î¡¢¤Ò¤È¤Ä¤Î¥³¥Í¥¯¥·¥ç¥ó¤ò»È¤Ã¤¿Â¿½Å²½Å¾Á÷¤Î¤¿¤á -¤ÎÉä¹æ²½¡¢Éü¹æ²½¤Î¥ª¡¼¥Ð¡¼¥Ø¥Ã¥É¤òºï¸º¤·¤Þ¤¹¡£ - -³°ÉôžÁ÷¥á¥½¥Ã¥É¤ò»È¤¤¤¿¤¤¾ì¹ç¤Ï¡¢¥Õ¥¡¥¤¥ë¤ò¥³¥Ô¡¼¤¹¤ë¤¿¤á¤ÎžÁ÷¥æ¡¼¥Æ¥£ -¥ê¥Æ¥£¤¬¡¢¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤʤ·¤Ç¼Â¹Ô¤Ç¤­¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£ - - ¤Ä¤Þ¤ê¡¢`scp' ¤ò»È¤¦¾ì¹ç¤ä¡¢»È¤Ã¤Æ¤¤¤ë `scp' ¤¬¥³¥Þ¥ó¥É -¥é¥¤¥ó¤Ç¥Ñ¥¹¥ï¡¼¥É¤ò¼õ¤±ÉÕ¤±¤ë¥Ð¡¼¥¸¥ç¥ó¤Î¾ì¹ç¤Ë¤Ï¡¢`ssh-agent' -¤ò»È¤¦É¬Íפ¬¤¢¤ë¤È¤¤¤¦¤³¤È¤Ç¤¹¡£(1) `ssh' ·Ðͳ¤Ç `rsync' -¤ò»È¤¦¾ì¹ç¤âƱÍͤǤ¹¡£ - - ¤â¤·¡¢¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤʤ·¤Ç `scp' ¤ò¼Â¹Ô¤¹¤ë¤³¤È¤¬¤Ç¤­¤Ê¤¤¤¬¡¢ -¥³¥Í¥¯¥·¥ç¥ó¤ò¥»¥­¥å¥¢¤Ë¤¹¤ë¤¿¤á¤Ë `ssh' ¤ò»È¤¤¤¿¤¤¾ì¹ç¤Ï¡¢ `ssh' -¥Ù¡¼¥¹¤Î¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£ - -`rcp' -- `rsh' ¤È `rcp' - ¤³¤Î¥á¥½¥Ã¥É¤Ï `rsh' ¤È `rcp' ¤ò»È¤¤¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó - ¤ËÀܳ¡¢¥Õ¥¡¥¤¥ëžÁ÷¤ò¤ª¤³¤Ê¤¤¤Þ¤¹¡£¤ª¤½¤é¤¯ºÇ®¤Î¥á¥½¥Ã¥É¤Ç¤¹¡£ - - ¤â¤¦°ì¤ÄÊ̤Υ᥽¥Ã¥É `remcp' ¤Ç¤Ï `remsh' ¥³¥Þ¥ó¥É¤È `rcp' - ¥³¥Þ¥ó¥É¤ò»È¤¤¤Þ¤¹¡£¤³¤ì¤Ï `rsh' ¤ÎÂå¤ï¤ê¤Ë `remsh' - ¤¬»È¤ï¤ì¤ë¥Þ¥·¥ó¾å¤Ç»È¤ï¤ì¤ë¤Ù¤­¤Ç¤¹¡£ - -`scp' -- `ssh' ¤È `scp' - ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤ÎÀܳ¤Î¤¿¤á¤Î `ssh' ¤ä¡¢¥Þ¥·¥ó´Ö¤Î¥Õ¥¡¥¤¥ëžÁ÷ - ¤Î¤¿¤á¤Î `scp' ¤Ï¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤Î¥»¥­¥å¥¢¤ÊÀܳ¤È¥Õ¥¡¥¤¥ë - ¥¢¥¯¥»¥¹¤Î¤¿¤á¤Ë¤ÏºÇÎɤΥ᥽¥Ã¥É¤Ç¤¹¡£ - - ¤³¤Î¥ª¥×¥·¥ç¥ó¤ÎÀ­Ç½¤âÍ¥¤ì¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢¾®¤µ¤¤¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥×¥ó¡¢ - ¥¯¥í¡¼¥º¤òÉÑÈˤ˷«¤êÊÖ¤¹¾ì¹ç¤Ï¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤è¤êÃÙ¤¯¤Ê¤ê¤Þ¤¹¡£ - `scp'¥»¥Ã¥·¥ç¥ó³«»Ï»þ¤Î°Å¹æ²½¤Î¤¿¤á¤Î¥Ï¥ó¥É¥·¥§¡¼¥¯¤Î¥³¥¹¥È¤Ï¡¢ - Éä¹æ²½¡¢Éü¹æ²½¤ò¤ª¤³¤Ê¤ï¤Ê¤¤ÍøÅÀ¤òÄ¢¾Ã¤·¤Ë¤·¤Þ¤¹¡£ - - `scp1' ¤È `scp2' ¤È¤¤¤¦Æó¤Ä¤ÎÊѼ郎¤¢¤ê¡¢¤½¤ì¤¾¤ì¤Ï `ssh -1' ¤È - `ssh -2' ¤ò¸Æ¤Ó½Ð¤·¤Þ¤¹¡£¤³¤Î¤è¤¦¤Ë¤·¤Æ¡¢ SSH ¥×¥í¥È¥³¥ë¥Ð¡¼¥¸¥ç¥ó - 1 ¤È 2 ¤Î¤É¤Á¤é¤òÍѤ¤¤Æ¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ - ¤¹¤ë¤«¤òÌÀ¼¨Åª¤ËÁªÂò¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£(SSH ¤ÎÀßÄê¥Õ¥¡¥¤¥ë - `~/.ssh/config' ¤Ç¤É¤Á¤é¤Î¥×¥í¥È¥³¥ë¤òÍѤ¤¤ë¤«»ØÄꤷ¡¢Ä̾ï¤Î `scp' - ¥á¥½¥Ã¥É¤òÍѤ¤¤ë ¤³¤È¤â¤Ç¤­¤Þ¤¹¡£) - - ¤Þ¤¿¤½¤Î¤Û¤«¤Ë¡¢ `scp1_old' ¤È `scp2_old' ¤È¤¤¤¦Æó¤Ä¤ÎÊѼ郎 - ¸ºß¤·¡¢ÌÀ¼¨Åª¤Ë `ssh1' ¥³¥Þ¥ó¥É¤È `ssh2' ¥³¥Þ¥ó¥É¤ò»È¤¤¤Þ¤¹¡£ - ¤½¤ì¤é¤¬²¿¤«ÃΤé¤Ê¤¤¤Ê¤é¡¢¤³¤ì¤é¤Î¥ª¥×¥·¥ç¥ó¤Ï¤¢¤Ê¤¿¤Ë¤ÏɬÍפ¢¤ê¤Þ¤»¤ó¡£ - - `ssh' ¤Ë´ð¤Å¤¯Á´¤Æ¤Î¥á¥½¥Ã¥É¤Ï¡¢ `-p' ¤Ë´Ø¤¹¤ë¥¯¥ë¡¼¥¸Åª - ÆÃħ¤ò»ý¤Ã¤Æ¤ª¤ê¡¢¥Û¥¹¥È̾¤ÎÃæ¤Ç¥Ý¡¼¥ÈÈÖ¹æ¤ò»ØÄê¤Ç¤­¤Þ¤¹¡£Î㤨¤Ð¥Û¥¹¥È - ̾¤ò `host#42' ¤È¤¹¤ë¤³¤È¤Ç `ssh' ¥³¥Þ¥ó¥É¤Î°ú¿ô¥ê¥¹¥È¤Ë `-p 42' - ¤ò»ØÄꤹ¤ë¤è¤¦¤Ë TRAMP ¤Ë»Ø¼¨¤Ç¤­¤Þ¤¹¡£ - -`rsync' -- `ssh' ¤È `rsync' - ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥»¥­¥å¥¢¤ËÀܳ¤¹¤ë¤¿¤á¤Ë `ssh' ¥³¥Þ¥ó¥É¤ò¡¢ - ¥Õ¥¡¥¤¥ëžÁ÷¤Î¤¿¤á¤Ë `rsync' ¤ò»È¤¦¤Î¤¬¡¢`scp' ¥á¥½¥Ã¥É¤ÎÆÃħ¤Ç¤¹¡£ - - ξ¦¤Î¥Û¥¹¥È¾å¤Ë¸ºß¤¹¤ë¥Õ¥¡¥¤¥ë¤òžÁ÷¤¹¤ë¾ì¹ç¡¢`rsync' ¤Ï `scp' - ¤è¤ê¹âÀ­Ç½¤Ç¤¹¡£¤³¤ÎÍøÅÀ¤Ï¡¢¥Õ¥¡¥¤¥ë¤¬ÊÒ¦¤Î¥Û¥¹¥È¤Ë - ¤·¤«¤Ê¤¤¾ì¹ç¤Ë¤Ï¼º¤Ê¤ï¤ì¤Þ¤¹¡£ - - ¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤Ø½ñ¤­¹þ¤à¾ì¹ç¡¢`rsync' ¥Ù¡¼¥¹¤Î¥á¥½¥Ã¥É¤Ï `rcp' - ¥Ù¡¼¥¹¤Î¥á¥½¥Ã¥É¤è¤ê¤«¤Ê¤ê®¤¤¤Ç¤·¤ç¤¦¡£¤·¤«¤·¡¢¥í¡¼¥«¥ë - ¥Þ¥·¥ó¤Î¥Õ¥¡¥¤¥ë¤òÆɤ߹þ¤à¾ì¹ç¤Ï¡¢Ä¾ÀÜ¥³¥Ô¡¼¤¹¤ë¤è¤ê®¤¯¤¢¤ê¤Þ¤»¤ó¡£ - - ¤³¤Î¥á¥½¥Ã¥É¤Ï `-p' ¥Ï¥Ã¥¯¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£ - -`scpx' -- `ssh' ¤È `scp' - ÁÛÁüÄ̤ꡢ¤³¤Î¥á¥½¥Ã¥É¤Ï `scp' ¤È¤è¤¯»÷¤Æ¤¤¤Þ¤¹¡£`scp' ¤¬ - ¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤ÇÄ̾ï¤ÎÂÐÏÃŪ¥·¥§¥ë¤òµ¯Æ°¤¹¤ë¤Î¤ËÂФ·¤Æ¡¢¤³¤Î¥ª¥×¥·¥ç¥ó - ¤Ï¥³¥Í¥¯¥·¥ç¥ó¤ò¥ª¡¼¥×¥ó¤¹¤ë¤¿¤á¤Ë `ssh -t -t HOST -l USER /bin/sh' - ¤ò»È¤¤¤Þ¤¹¡£¤³¤Î¥ª¥×¥·¥ç¥ó¤Ï¡¢Ä̾ï¤Î¥í¥°¥¤¥ó¥·¥§¥ë¤¬¥í¥°¥¤¥ó»þ¤Ë¤¤¤¯¤Ä¤« - ¤Î¼ÁÌä¤ò¤ª¤³¤Ê¤¦¤è¤¦¤ËÀßÄꤵ¤ì¤Æ¤¤¤ë¾ì¹ç¤ËÌò¤ËΩ¤Á¤Þ¤¹¡£¤³¤Î¼ê½ç¤Ë¤è¤ê - ¤½¤ì¤é¤Î¼ÁÌä¤ò²óÈò¤·¤Æ¡¢`ɸ½àŪ¤Ê' ¥í¥°¥¤¥ó¥·¥§¥ë¤ò TRAMP ¤Ë»È¤ï¤» - ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - ¤³¤Î¼ê½ç¤Ï Windows ¥æ¡¼¥¶¤Ë¤È¤Ã¤Æ `ssh' ¤ò Emacs ¥Ð¥Ã¥Õ¥¡¤«¤é - ¸Æ¤Ö¤È pseudo tty - ¤ò³ä¤êÅö¤Æ¤Æ¤Ê¤¤¤È¸À¤ï¤ì¤Æ¤·¤Þ¤¦¾ì¹ç¤Ë¤âÍ­ÍѤǤ¹¡£ - ¤³¤Î»þ¥í¥°¥¤¥ó¥·¥§¥ë¤Ï¥·¥§¥ë¥×¥í¥ó¥×¥È¤ò°ìÀÚɽ¼¨¤·¤Ê¤¤¤¿¤á¤Ë TRAMP - ¤ÏÂçÊѺ®Í𤷤Ƥ·¤Þ¤¤¤Þ¤¹¡£¤¿¤Ö¤ó¤³¤ì¤Ï Cygwin ¤Ë°Ü¿¢¤µ¤ì¤¿SSH - ¤Î¾ì¹ç¤Ë Åö¤Æ¤Ï¤Þ¤ê¤Þ¤¹¡£ - - ¤³¤Î¥á¥½¥Ã¥É¤Ï `-p' ¥Ï¥Ã¥¯¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£ - -`pscp' -- `plink' ¤È `pscp' - ¤³¤Î¥á¥½¥Ã¥É¤Ï `scp' ¤Ë»÷¤Æ¤¤¤Þ¤¹¤¬¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤¹¤ë¤Î ¤Ë - `plink' ¥³¥Þ¥ó¥É¤ò»È¤¤¡¢¥Õ¥¡¥¤¥ë¤òžÁ÷¤¹¤ë¤Î¤Ë `pscp' - ¤ò»È¤¤¤Þ¤¹¡£¤³¤ì¤é¤Î¥³¥Þ¥ó¥É¤Ï Windows ÍѤΠSSH ¼ÂÁõ¤Ç¤¢¤ë PuTTY ¤Ë - ´Þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£ - - CCC: `plink' ¤Ï `-p' ¥Ï¥Ã¥¯¤ò¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤ë¤«? - -`fcp' -- `fsh' ¤È `fcp' - ¤³¤Î¥á¥½¥Ã¥É¤Ï `scp' ¤Ë»÷¤Æ¤¤¤Þ¤¹¤¬¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤¹¤ë¤Î ¤Ë - `fsh' ¥³¥Þ¥ó¥É¤ò»È¤¤¡¢¥Õ¥¡¥¤¥ë¤òžÁ÷¤¹¤ë¤Î¤Ë `fcp' ¤ò»È¤¤¤Þ¤¹¡£ - `fsh/fcp' ¤Ï `ssh' ¤Î¥Õ¥í¥ó¥È¥¨¥ó¥É¤Ç¡¢ Ʊ°ì¤Î `ssh' - ¥»¥Ã¥·¥ç¥ó¤òºÆÍøÍѤ·¤Æ¤¤¤¯¤Ä¤«¤Î¥³¥Þ¥ó¥É¤òÁ÷¤ë¤³ - ¤È¤ò²Äǽ¤È¤·¤Þ¤¹¡£¤³¤ì¤Ë¤è¤ê¡¢`scp' ¤Îµ¯Æ°¤Ë¤«¤«¤ë¥ª¡¼¥Ð¡¼¥Ø¥Ã¥É - (¸Æ¤Ð¤ì¤ëÅ٤˥»¥­¥å¥¢¤ÊÀܳ¤ò³ÎΩ¤·¤Ê¤¤¤È¤¤¤±¤Ê¤¤)¤ò²óÈò¤Ç¤­¤Þ¤¹¡£ - °ìÊý¡¢Æ±Íͤθú²Ì¤òÆÀ¤ë¤¿¤á¤Ë¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Î¤É¤ì¤«¤òÍѤ¤¤ë¤³¤È¤â - ¤Ç¤­¤ë¤³¤È¤òÃí°Õ¤·¤Æ¤ª¤­¤Þ¤¹¡£ - - ¤³¤Î¥á¥½¥Ã¥É¤Ï¥³¥Þ¥ó¥É `fsh HOST -l USER /bin/sh -i' - ¤ò»È¤Ã¤ÆÀܳ¤ò³ÎΩ¤·¤Þ¤¹¡£Ã±¤Ë `fsh HOST -l USER' - ¤È¤·¤¿¤À¤±¤Ç¤ÏÆ°¤­¤Þ¤»¤ó¡£ - - `fsh' ¥×¥í¥°¥é¥à¤¬Ä󶡤¹¤ë¿½Å²½¤Ï²æ¡¹¤Îʸ̮¤Ç¤Ï¤½¤ì¤Û¤ÉÍ­ÍÑ¤Ç - ¤Ï¤Ê¤¤¤Î¤Ç¡¢¤½¤ì¤òÍѤ¤¤ë¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Ï¸ºß¤·¤Þ¤»¤ó¡£¤½¤ÎÂå¤ï¤ê - TRAMP - ¤Ïñ¤Ë¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤Î°ì¤Ä¤ÎÀܳ¤ò³«¤­¡¢¤½¤ÎÀܳ¤òÊÝ»ý¤·¤Þ¤¹¡£ - -`smb' -- `smbclient' - ¤³¤ì¤Ï¤Þ¤¿Ê̤ΠTRAMP Æȼ«¤Ç¤Ê¤¤¥á¥½¥Ã¥É¤Ç¤¹¡£`smbclient' - ¥³¥Þ¥ó¥É¤òÊ̤ΠUnices ¾å¤Ç»È¤Ã¤Æ¡¢SMB ¥µ¡¼¥Ð¤Ø¤ÎÀܳ¤ò¹Ô¤Ê¤¤¤Þ¤¹¡£ - SMB ¥µ¡¼¥Ð¤ÏÊ̤ΠUNIX ¥Û¥¹¥È¾å¤Î Samba (¤â¤·¤¯¤Ï CIFS) - ¥µ¡¼¥Ð¤Ç¤¢¤ë¤« ¤â¤·¤ì¤Þ¤»¤ó¤·¡¢¤µ¤é¤Ë¶½Ì£¿¼¤¤¤³¤È¤Ë¡¢MS Windows - ¤¬Æ°¤¤¤Æ¤¤¤ë¥Û¥¹¥È¤Ç ¤¢¤ë¤«¤â¤·¤ì¤Ê¤¤¤Î¤Ç¤¹¡£º£¤Î¤È¤³¤í¡¢MS - Windows NT¡¢MS Windows 2000¡¢ ¤ª¤è¤Ó MS Windows XP - ¤ËÂФ·¤Æ¥Æ¥¹¥È¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ - - ¥í¡¼¥«¥ë̾¤ÎÀèƬ¤Î¥Ç¥£¥ì¥¯¥È¥ê¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¤Ç¤Î¶¦Í­Ì¾¤Ç¤Ê¤±¤ì¤Ð¤Ê¤ê - ¤Þ¤»¤ó¡£Ä̾ï¥Ç¥Õ¥©¥ë¥È¤Î¶¦Í­¤Î½ªÃ¼¤Ïʸ»ú `$' ¤Ç¤¹¤¬¡¢¥Õ¥¡¥¤¥ë̾¤Î - ´Ä¶­ÊÑ¿ô¤Ë¤è¤ëŸ³«¤Î¤¿¤á¡¢¤½¤ì¤ò `$$' ¤È½ñ¤¯É¬Íפ¬¤¢¤ë¤³¤È¤ò²±¤¨¤Æ - ¤ª¤¤¤Æ²¼¤µ¤¤¡£¤â¤·¡¢¶¦Í­Ì¾¤¬Í¿¤¨¤é¤ì¤Ê¤±¤ì¤Ð(¤¹¤Ê¤ï¤Á¥ê¥â¡¼¥È¥Ç¥£¥ì¥¯¥È¥ê - ¤¬ `/' ¤Î¾ì¹ç)¡¢Á´¤Æ¤ÎÍøÍѲÄǽ¤Ê¶¦Í­¤¿¤Á¤¬É½¼¨¤µ¤ì¤Þ¤¹¡£ - - ǧ²Ä¤Ï¶¦Í­¥ì¥Ù¥ë¤Ç¤Ê¤µ¤ì¤Æ¤¤¤ë¤Î¤Ç¡¢Æ±¤¸¥Û¥¹¥È¤Ç¤¢¤Ã¤Æ¤âÊ̤ζ¦Í­¤Ë¥¢¥¯ - ¥»¥¹¤¹¤ë¤Èɬ¤º¥Ñ¥¹¥ï¡¼¥É¤òµá¤á¤é¤ì¤Þ¤¹¡£¥»¥­¥å¥ê¥Æ¥£¾å¤ÎÍýͳ¤«¤é¥Ñ¥¹¥ï - ¡¼¥É¤Ï¥­¥ã¥Ã¥·¥å¤µ¤ì¤Þ¤»¤ó¡£ - - MS Windows - ¤Ïǧ²Ä¤Î¤¿¤á¤Ë¥æ¡¼¥¶Ì¾¤È¥É¥á¥¤¥ó̾¤ÎξÊý¤òÍѤ¤¤Þ¤¹¡£¤³¤Î¤¿ - ¤á¡¢TRAMP ¹½Ê¸¤Ï³ÈÄ¥¤µ¤ì¤Þ¤·¤¿: ¥æ¡¼¥¶Ì¾¤ò»ØÄꤹ¤ëºÝ¤Ë - `user%domain' - (¼Â¥æ¡¼¥¶Ì¾¡¢¥Ñ¡¼¥»¥ó¥Èµ­¹æ¡¢¥É¥á¥¤¥ó̾)¤Î¤è¤¦¤Ë½ñ¤¯¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - ¤·¤¿¤¬¤Ã¤Æ¡¢¥Þ¥·¥ó `melancholia' ¤Ë¥É¥á¥¤¥ó `BIZARRE' ¤Î¥æ¡¼¥¶ - `daniel' ¤È¤·¤ÆÀܳ¤·¤Æ¡¢¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê (¶¦Í­ `daniel$') - ¤Ë¤¢¤ë `.emacs' ¤òÊÔ½¸¤¹¤ë¾ì¹ç¡¢¥Õ¥¡¥¤¥ë̾¤ò - `/[smb/daniel%BIZARRE@melancholia]/daniel$$/.emacs' ¤È»ØÄꤷ¤Þ¤¹¡£ - - ¥É¥á¥¤¥ó̾¤ä¥æ¡¼¥¶Ì¾¤ÏÉÕ¤±¤Ê¤¤¤³¤È¤â¤Ç¤­¤Þ¤¹¡£¤â¤·¥æ¡¼¥¶Ì¾¤¬»ØÄꤵ¤ì¤Ê - ¤±¤ì¤Ðƿ̾¥æ¡¼¥¶(¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤÎɬÍפ¬¤Ê¤¤)¤¬²¾Äꤵ¤ì¤Þ¤¹¡£¤³¤ì¤Ï¾¤Î - Á´¤Æ¤Î TRAMP ¥á¥½¥Ã¥É¤È°Û¤Ê¤ê¤Þ¤¹¡£Â¾¤Î¥á¥½¥Ã¥É¤ÇƱ¤¸¾õ¶·¤Î¾ì¹ç¤Ë¤Ï - ¥í¡¼¥«¥ë¥æ¡¼¥¶Ì¾¤¬»È¤ï¤ì¤Þ¤¹¡£ - - `smb' ¥á¥½¥Ã¥É¤Ï `-p' ¥Ï¥Ã¥¯¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£ - - *Ãí°Õ¤·¤Æ²¼¤µ¤¤:* ¤â¤· Emacs ¤¬¥í¡¼¥«¥ë¤Î MS Windows ¤Î²¼¤ÇÆ°¤¤ - ¤Æ¤¤¤ë¤Ê¤é¤Ð¤³¤Î¥á¥½¥Ã¥É¤ÏÍøÍѤǤ­¤Þ¤»¤ó¡£¤½¤ÎÂå¤ï¤ê¤Ë¡¢ - `//melancholia/daniel$$/.emacs' ¤Î¤è¤¦¤Ê UNC ¥Õ¥¡¥¤¥ë̾¤ò»È¤¦¤³¤È - ¤¬¤Ç¤­¤Þ¤¹¡£Í£°ì¤Î·çÅÀ¤Ï¾¤Î¥æ¡¼¥¶Ì¾¤ò»ØÄꤹ¤ë¤¿¤á¤ÎÊýË¡¤¬Ìµ¤¤¤³¤È¤Ç¤¹¡£ - - - ---------- Footnotes ---------- - - (1) PuTTY's `pscp' ¤Ç¤Ï ¥³¥Þ¥ó¥É¥é¥¤¥ó¤Ç¥Ñ¥¹¥ï¡¼¥É¤ò»ØÄê¤Ç¤­¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Multi-hop Methods, Next: Default Method, Prev: External transfer methods, Up: Configuration - -4.4 Ê£¿ô¤Î¥Û¥Ã¥×¤ò»È¤¤¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤¹¤ë -============================================== - -¤³¤ì¤Þ¤Ç¤ËÀâÌÀ¤·¤¿¥á¥½¥Ã¥É¤Ç¤ÏÉÔ½½Ê¬¤Ê»ö¤¬¤¢¤ê¤Þ¤¹¡£¥·¥ó¥×¥ë¤Ê¥á¥½¥Ã¥É¤ò -»È¤Ã¤Æ¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤Ç¤­¤Ê¤¤¤³¤È¤¬¤¢¤ê¤Þ¤¹¡£¤¿¤È¤¨¤Ð¡¢¥»¥­¥å¥¢¤Ê -¥Í¥Ã¥È¥ï¡¼¥¯¤ÎÃæ¤Ë¤¤¤ë¾ì¹ç¡¢³°Éô¤ËÀܳ¤¹¤ëÁ°¤Ë¤Þ¤ºÍ׺ɥۥ¹¥È¤Ë¥í¥°¥¤¥ó -¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¤Ç¤·¤ç¤¦¡£¤â¤Á¤í¤ó¡¢¥¿¡¼¥²¥Ã¥È¥Û¥¹¥È¤ÏÍ׺ɥۥ¹¥È¤âÍ×µá -¤·¤Þ¤¹¡£¥Þ¥ë¥Á¥Û¥Ã¥×¤Î¥Õ¥¡¥¤¥ë̾¤Î¥Õ¥©¡¼¥Þ¥Ã¥È¤Ï¡¢Ä̾ï¤Î TRAMP ¤Î -¥á¥½¥Ã¥É¤È¤¹¤³¤·°Û¤Ê¤ê¤Þ¤¹¡£ - - ¥Þ¥ë¥Á¥Û¥Ã¥×¤Î¥Õ¥¡¥¤¥ë̾¤Ï¡¢¥á¥½¥Ã¥É̾¡¢¥Û¥Ã¥×¿ô¡¢¥í¡¼¥«¥ë̾(¥ê¥â¡¼¥È -¥·¥¹¥Æ¥à¾å¤Î¥Ñ¥¹Ì¾)¤ò»ØÄꤷ¤Þ¤¹¡£¥á¥½¥Ã¥É̾¤Ï¾ï¤Ë `multi' ¤Ç¤¹¡£ - - ³Æ¥Û¥Ã¥×¤Ï "¥Û¥Ã¥×¥á¥½¥Ã¥É" »ØÄê¡¢¤Ä¤Þ¤ê¥æ¡¼¥¶Ì¾¤È¥Û¥¹¥È̾¤«¤éÀ®¤ê -¤Þ¤¹¡£¥Û¥Ã¥×¥á¥½¥Ã¥É¤Ï¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Î¤ß¤Ë¤Ê¤êÆÀ¤Þ¤¹¡£°Ê²¼¤Î¥Û¥Ã¥× -¥á¥½¥Ã¥É¤¬(º£¤Î¤È¤³¤í)ÍøÍѲÄǽ¤Ç¤¹: - -`telnet' - ¥Û¥¹¥È¤Ø¤ÎÀܳ¤Ë¤è¤¯ÃΤé¤ì¤¿ `telnet' ¥×¥í¥°¥é¥à¤ò»ÈÍѤ·¤Þ¤¹¡£ - ¥æ¡¼¥¶¡¼Ì¾¤È¥Û¥¹¥È̾¤Ï¥Õ¥¡¥¤¥ë̾¤ÎÃæ¤Ë´Þ¤Þ¤ì¡¢¥Ñ¥¹¥ï¡¼¥É¤ò¤¿¤º¤Í¤é¤ì¤Þ¤¹¡£ - -`rsh' - ¥Û¥¹¥È¤Ø¤ÎÀܳ¤Ë `rsh' ¤ò»ÈÍѤ·¤Þ¤¹¡£`rsh' ¤¬¥Ñ¥¹¥ï¡¼¥É - ¤ò¤¿¤º¤Í¤ë»þ°Ê³°¤Ï¡¢¥Ñ¥¹¥ï¡¼¥É¤òÆþÎϤ¹¤ëɬÍפϤ¢¤ê¤Þ¤»¤ó¡£ - - ¤³¤ÎÊѼï `remsh' ¤Ï `remsh' ¥³¥Þ¥ó¥É¤ò»È¤¤¤Þ¤¹¡£¤³¤ì¤Ï `rsh' - ¤ÎÂå¤ï¤ê¤Ë `remsh' ¤¬»È¤ï¤ì¤ë¥Þ¥·¥ó¾å¤Ç»È¤ï¤ì¤ë ¤Ù¤­¤Ç¤¹¡£ - -`ssh' - ¤³¤Î¥á¥½¥Ã¥É¤Ï¥Û¥¹¥È¤Ø¤ÎÀܳ¤Î¤¿¤á¤Ë `ssh' ¤ò»ÈÍѤ·¤Þ¤¹¡£¥Ñ¥¹¥ï¡¼¥É - ¤«¥Ñ¥¹¥Õ¥ì¡¼¥º¤òÆþÎϤ¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£ - -`su' - ¤³¤Î¥á¥½¥Ã¥É¤Ï¾¤Î¥Û¥¹¥È¤Ø¤Þ¤Ã¤¿¤¯¥¢¥¯¥»¥¹¤·¤Þ¤»¤ó¡£¤½¤Î¤«¤ï¤ê¡¢º£¤¤¤ë - ¥Û¥¹¥È¾å¤Ç¾¤Î¥æ¡¼¥¶¡¼¤Ë¤Ê¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¤³¤ì¤Ï¡¢root - ¤È¤·¤Æ¥Õ¥¡¥¤¥ë ¤òÊÔ½¸¤·¤¿¤¤¤¬¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤Ï¥ê¥â¡¼¥È¤«¤é¤Î root - ¤Î¥í¥°¥¤¥ó¤òµö²Ä¤·¤Æ - ¤¤¤Ê¤¤¾ì¹ç¤ËÌò¤ËΩ¤Á¤Þ¤¹¡£¤³¤Î¤è¤¦¤Ê¾ì¹ç¡¢°ìÈ̥桼¥¶¡¼¤Ç¤Î¥ê¥â¡¼¥È¥Û¥¹¥È - ¤Ø¤ÎÀܳ¤Ë `telnet'¡¢`rsh' ¤¢¤ë¤¤¤Ï `ssh' ¤ò»È¤¦ - ¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¤½¤ì¤«¤é¡¢root ¤Ë¤Ê¤ë¤¿¤á¤Ë `su' ¥Û¥Ã¥×¤ò»È¤¤¤Þ¤¹¡£ - `su' ¤Ï°ìÏ¢¤Î¥·¡¼¥¯¥¨¥ó¥¹Ãæ¤ÎºÇ¸å¤Î¥Û¥Ã¥×¤Ç¤¢¤ëɬÍפϤ¢¤ê¤Þ¤»¤ó¡£ - ɬÍפǤ¢¤ì¤Ð¥Û¥Ã¥×Ãæ¤Î¤É¤³¤Ç¤Ç¤â»È¤¦¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - `su' ¥Û¥Ã¥×¤È°ì½ï¤Ë¥æ¡¼¥¶¡¼¤È¥Û¥¹¥ÈξÊý¤ò»ØÄꤷ¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£ - ¤·¤«¤·¤Ê¤¬¤é¡¢¥Û¥¹¥È̾¤Ï̵»ë¤µ¤ì¥æ¡¼¥¶¡¼Ì¾¤À¤±¤¬»ÈÍѤµ¤ì¤Þ¤¹¡£ - -`sudo' - ¤³¤ì¤Ï `su' ¥Û¥Ã¥×¤Ë»÷¤Æ¤¤¤Þ¤¹¡£°ã¤¦¥æ¡¼¥¶¡¼¤Ë¤Ê¤ë¤¿¤á¤Ë `su' - ¤Ç¤Ê¤¯ `sudo' ¤ò»ÈÍѤ¹¤ëÅÀ¤¬°Û¤Ê¤ê¤Þ¤¹¡£ - - - `ssh' ¤òÍѤ¤¤Æ¥Ý¡¼¥È¥Õ¥©¥ï¡¼¥É¤ò¤·¤¿¤¤¾ì¹ç¤ä¡¢É¸½àŪ¤Ç¤Ê¤¤¥Ý¡¼¥È¤ò -»ÈÍѤ·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¾ì¹ç¤¬¤¢¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤½¤Î¤è¤¦¤Ê¾ì¹ç¤Ë¤Ï¡¢ -¥Û¥¹¥È̾¤´¤È¤Ë°Û¤Ê¤ë¥Ý¡¼¥ÈÈÖ¹æ¤ò»ØÄꤷ¤¿µ­½Ò¤ò `~/.ssh/config' ¤Ë -½ñ¤­¹þ¤à¤³¤È¤Ç¼Â¸½¤Ç¤­¤Þ¤¹¡£¤·¤«¤·¤Ê¤¬¤é¡¢¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É¤ò»È¤¨¤Ð -¤½¤ì¤Ï TRAMP ¤ÎÏÈÆâ¤Ç¼Â¸½¤¹¤ë¤³¤È¤â¤Ç¤­¤Þ¤¹¡£Î㤨¤Ð: - - (add-to-list - 'tramp-multi-connection-function-alist - '("sshf" tramp-multi-connect-rlogin "ssh %h -l %u -p 4400%n")) - - ¤È¤¹¤ì¤Ð¡¢ `sshf' ¥Û¥Ã¥×¤òÍѤ¤¤Æ¡¢É¸½àŪ¤Ê¥Ý¡¼¥È¤ÎÊѤï¤ê¤Ë 4400 ÈÖ -¥Ý¡¼¥È¤Ø·Ò¤°¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Default Method, Next: Customizing Methods, Prev: Multi-hop Methods, Up: Configuration - -4.5 ¥Ç¥Õ¥©¥ë¥È¤Î¥á¥½¥Ã¥É¤ÎÁªÂò -============================== - -ÉáÃʤ褯»È¤¦Å¬ÀڤʞÁ÷¥á¥½¥Ã¥É¤òÁªÂò¤¹¤ë¤Ë¤Ï¡¢ÊÑ¿ô -`tramp-default-method' ¤òÀßÄꤷ¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£¤³¤ÎÊÑ¿ô¤Ë¤Ï TRAMP -¥Õ¥¡¥¤¥ë̾¤Ë¥á¥½¥Ã¥É¤¬ -»ØÄꤵ¤ì¤Ê¤«¤Ã¤¿»þ¤Ë»ÈÍѤµ¤ì¤ë¥Ç¥Õ¥©¥ë¥È¤Î¥á¥½¥Ã¥É¤òÀßÄꤷ¤Þ¤¹¡£ Î㤨¤Ð: - - (setq tramp-default-method "scp") - - ÊÑ¿ô `tramp-default-method-alist' ¤ò»È¤Ã¤ÆÆÃÄê¤Î¥æ¡¼¥¶/¥Û¥¹¥È¤Î -ÁȤ߹ç¤ï¤»¤ËÂФ·¤Æ°Û¤Ê¤Ã¤¿¥á¥½¥Ã¥É¤ò»ØÄꤹ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£Î㤨¤Ð -¼¡¤Î2¹Ô¤Ï¡¢¥æ¡¼¥¶Ì¾¤¬ `john' ¤Ë¥Þ¥Ã¥Á¤¹¤ë¾ì¹ç¤Ë¤Ï `ssh' -¥á¥½¥Ã¥É¤òÍѤ¤¡¢¥Û¥¹¥È̾¤¬ `lily' ¤Ë¥Þ¥Ã¥Á¤¹¤ë¾ì¹ç¤Ë¤Ï `rsync' -¥á¥½¥Ã¥É¤òÍѤ¤¤Þ¤¹¡£3¹ÔÌܤϥޥ·¥ó `localhost' ¾å¤Î¥æ¡¼¥¶`root' ¤ËÂФ·¤Æ -`su' ¥á¥½¥Ã¥É¤ò»È¤¦¤è¤¦¤Ë»ØÄꤷ¤Þ¤¹¡£ - - (add-to-list 'tramp-default-method-alist '("" "john" "ssh")) - (add-to-list 'tramp-default-method-alist '("lily" "" "rsync")) - (add-to-list 'tramp-default-method-alist - '("\\`localhost\\'" "\\`root\\'" "su")) - -¤µ¤é¤Ê¤ë¾ÜºÙ¤Ë¤Ä¤¤¤Æ¤ÏÊÑ¿ô `tramp-default-method-alist' ¤Î¥É¥­¥å¥á¥ó¥È -¤ò¸«¤Æ²¼¤µ¤¤¡£ - -°ìÈÌŪ¤Ë¤Ï¡¢¥¤¥ó¥é¥¤¥óžÁ÷¥á¥½¥Ã¥É¤è¤ê¤Ï³°ÉôžÁ÷¥á¥½¥Ã¥É¤òÁª¤Ö¤Ù¤­¤Ç¤¹¡£ -³°ÉôžÁ÷¥á¥½¥Ã¥É¤Ï¥¤¥ó¥é¥¤¥ó¤è¤ê¹âÀ­Ç½¤Ç¤¹¡£¤·¤«¤·¡¢³°ÉôžÁ÷¥á¥½¥Ã¥É¤Ï¡¢ -¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤʤ·¤Ç¥í¥°¥¤¥ó¤Ç¤­¤Ê¤¤¥ê¥â¡¼¥È¥Þ¥·¥ó¤¬¤¿¤¯¤µ¤ó¤¢¤ë¾ì¹ç¤Ï -Ìò¤ËΩ¤Á¤Þ¤»¤ó¡£ - - *Note Inline methods::. *Note External transfer methods::. *Note -Multi-hop Methods::. - - žÁ÷¥á¥½¥Ã¥É¤ÎÁªÂò¤ò¤¹¤ë»þ¤Ë¾¤Ë¹Íθ¤¹¤Ù¤­»ö¤Ï¡¢¤½¤ì¤é¤ò»È¤¦´Ä¶­¤È¡¢ -Æä˥¤¥ó¥¿¡¼¥Í¥Ã¥È¾å¤Ç»È¤¦¾ì¹ç¤¢¤Ê¤¿¤ÎÁªÂò¤·¤¿¥á¥½¥Ã¥É¤Î¥»¥­¥å¥ê¥Æ¥£ -¤È¤Î´Ø·¸¤Ç¤¹¡£ - - `rsh' ¤È `telnet' ¥á¥½¥Ã¥É¤Ï¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë¥í¥°¥¤¥ó -¤¹¤ë»þ¤Ë¡¢¥Ñ¥¹¥ï¡¼¥É¤ò¥×¥ì¥¤¥ó¥Æ¥­¥¹¥È¤ÇÁ÷¿®¤·¤Þ¤¹¡£¥Õ¥¡¥¤¥ëžÁ÷¤âƱ¤¸ -ÊýË¡¤Ç¤ª¤³¤Ê¤¦¤Î¤Ç¡¢Â¾¤â¥Þ¥·¥ó¤«¤é¥Õ¥¡¥¤¥ë¤ÎÆâÍƤò´Êñ¤ËÆɤळ¤È¤¬¤Ç¤­¤Þ¤¹¡£ - -¥¤¥ó¥¿¡¼¥Í¥Ã¥È¤«¤é¥¢¥¯¥»¥¹²Äǽ¤Ê¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤ËÀܳ¤¹¤ëɬÍפ¬¤¢¤ë¾ì¹ç¡¢ -Àܳ¤Ë `ssh' ¥Ù¡¼¥¹¤Î¥á¥½¥Ã¥É¤ò»ÈÍѤ¹¤ë¤³¤È¤ò¿¿·õ¤Ë¹Í¤¨¤ë¤Ù¤­¤Ç¤¹¡£ -¤³¤Î¥á¥½¥Ã¥É¤Ï¡¢¹â¤¤¥ì¥Ù¥ë¤Î¥»¥­¥å¥ê¥Æ¥£¤òÄ󶡤·¡¢Ã¯¤«¤¬¥Ñ¥¹¥ï¡¼¥É¤òÆþ¼ê -¤·¤¿¤ê¡¢ÊÔ½¸¤·¤Æ¤¤¤ë¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòÆɤó¤À¤ê¤¹¤ë¤³¤È¤òº¤Æñ¤Ë¤·¤Þ¤¹¡£ - -4.5.1 »ä¤Ï¤É¤Î¥á¥½¥Ã¥É¤ò»È¤¦¤Ù¤­¤«? ------------------------------------ - -¤³¤³¤Þ¤Ç¤ÎÀâÌÀ¤Ç¡¢¤³¤ì¤ÏÁ´¤¯¤¹¤Ð¤é¤·¤¯¤ÆÎɤ¤¤â¤Î¤À¤¬¡¢¤·¤«¤·¤Ê¤¬¤é¥á¥½¥Ã¥É -¤òÁª¤ÖÊýË¡¤Ë¤Ä¤¤¤Æ¤Ï²¿¤Î½õ¸À¤â¤µ¤ì¤Æ¤Ê¤¤¤è! -¤È»×¤¦¤³¤È¤È»×¤¤¤Þ¤¹¡£³Î¤«¤Ë¡£ -³«È¯¼Ô¤È¤·¤Æ¤Ï¡¢¥æ¡¼¥¶¤òµí¼ª¤í¤¦¤È¤Ï»×¤Ã¤Æ¤Ê¤¯¤Æ¡¢Âå¤ï¤ê¤ËºÇÂç¸Â¤Î¼«Í³ÅÙ¤ò -Í¿¤¨¤è¤¦¤È¹Í¤¨¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¤Ê¤¬¤é¼ÂºÝ¤Ë¤Ï¥æ¡¼¥¶¤ÎÃæ¤Ë¤Ï¼ê°ú¤­¤òµá¤á¤ë -¿Í¤âµï¤ë¤Ç¤·¤ç¤¦¡£¤½¤³¤Ç¤³¤³¤Ç¤Ï¤¢¤Ê¤¿¤ò»ÙÇÛ¤¹¤ë¤³¤È¤Ê¤¯¼ê°ú¤­¤òÍ¿¤¨¤ë¤³¤È -¤ò»î¤ß¤Þ¤¹¡£¤³¤ì¤¬¤¦¤Þ¤¯¹Ô¤Ã¤¿¤«¶µ¤¨¤Æ²¼¤µ¤¤¤Í ... - -»ä¤ÎÄó°Æ¤Ï¡¢¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ò»È¤¦¤³¤È¤Ç¤¹¡£Â礭¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ¤Ï -out-of-band ¥á¥½¥Ã¥É¤ÎÊý¤¬Í­¸ú¤«¤â¤·¤ì¤Þ¤»¤ó¤¬¡¢¤Û¤È¤ó¤É¤Î¿Í¤Ï¾®¤µ¤Ê -¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤·¤¿¤¤¤È»×¤¦¤È¿ä¬¤·¤Þ¤¹¡£ - - º£Æü¤Ç¤Ï¡¢¤Û¤È¤ó¤É¤Î¿Í¤¬¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë `ssh' ¤ò»È¤Ã¤Æ¥¢¥¯¥»¥¹ -¤Ç¤­¤ë¤È¿ä¬¤·¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ `ssh' ¥á¥½¥Ã¥É¤ò»È¤¦¤³¤È¤òÄó°Æ¤·¤Þ¤¹¡£ -¤Ä¤Þ¤ê¡¢Â¾¤Î¥Û¥¹¥È¤Î `/etc/motd' ¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤¹¤ë¤¿¤á¤Ë¤Ï `C-x C-f -/ssh:root@otherhost:/etc/motd ' ¤ÈÆþÎϤ¹¤ì¤Ð¤è¤¤ ¤Ç¤¹¡£ - - ¤â¤·¡¢`ssh' ¤ò»È¤Ã¤Æ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤Ç¤­¤Ê¤¤¤Ê¤é¡¢Æ°ºî¤¹¤ë -¥×¥í¥°¥é¥à¤ò»È¤¦¥á¥½¥Ã¥É¤òÁªÂò¤·¤Þ¤¹¡£Î㤨¤Ð Windows ¥æ¡¼¥¶¤Ï `ssh' ¤Î -PuTTY ¼ÂÁõ¤ò»È¤¦ `plink' ¥á¥½¥Ã¥É¤ò¹¥¤à¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤Þ¤¿¡¢ Kerberos -¤ò»È¤Ã¤Æ¤¤¤ë¤Ê¤é `krlogin' ¤ò¹¥¤à¤Ç¤·¤ç¤¦¡£ - -ÆÃÊ̤ʾì¹ç¤È¤·¤Æ¥í¡¼¥«¥ë¥Û¥¹¥È¤Î¥Õ¥¡¥¤¥ë¤òÊ̤Υ桼¥¶¤È¤·¤ÆÊÔ½¸¤·¤¿¤¤¾ì¹ç -¤Ë¤Ï `su' ¥á¥½¥Ã¥É¤â¤·¤¯¤Ï `sudo' ¥á¥½¥Ã¥É¤ò»²¾È¤·¤Æ²¼¤µ¤¤¡£ - - Â礭¤Ê¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤¹¤ë¿Í¤Ï `ssh' ¤ÎÂå¤ï¤ê¤Ë `scp' ¡¢¤â¤·¤¯¤Ï -`plink' ¤ÎÂå¤ï¤ê¤Ë `pscp' ¤ÎÍøÍѤò¹Í¤¨¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£ ¤³¤ì¤é¤Î -out-of-band ¥á¥½¥Ã¥É¤ÏÂ礭¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ¤Ï¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É -¤è¤ê¤â¹â®¤Ç¤¹¡£¤·¤«¤·¡¢out-of-band ¥á¥½¥Ã¥É¤¿¤Á¤Ï¤¤¤¯¤Ä¤«¤ÎÀ©¸Â -¤ò¼õ¤±¤ë¤«¤â¤·¤ì¤Ê¤¤¤³¤È¤ËÃí°Õ¤·¤Æ²¼¤µ¤¤¡£ºÇ½é¤ËËÜÅö¤Ë¸²Ãø¤Ê®ÅÙŪ¤Ê -Í¥°Ì¤ò out-of-band -¥á¥½¥Ã¥É¤ÇÆÀ¤é¤ì¤ë¤«»î¤·¤Æ²¼¤µ¤¤!¤ª¤½¤é¤¯Â礭¤Ê¥Õ¥¡¥¤¥ë -¤ËÂФ·¤Æ¤â¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤¿¤Á¤Ï½½Ê¬¹â®¤À¤È»×¤¤¤Þ¤¹¡£ - - »ä¤¬¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ÎÍøÍѤòÄó°Æ¤¹¤ëÍýͳ¤Ï¡¢¤½¤ì¤é¤Ï¥ê¥â¡¼¥È¦¤¬ -¥Ñ¥¹¥ï¡¼¥É¤òʹ¤¤¤Æ¤­¤¿¤È¤·¤Æ¤âÆ°ºî¤¹¤ë¤«¤é¤Ç¤¹¡£out-of-band ¥á¥½¥Ã¥É -¤Ï¤½¤Î¤è¤¦¤Ê¾õ¶·¤Ç¤ÏÆ°ºî¤·¤Þ¤»¤ó¡£¤Þ¤¿¡¢¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É¤¿¤Á¤Ï -ËܼÁŪ¤Ë¥¤¥ó¥é¥¤¥ó¤Ç¤¹¡£ - - -File: tramp_ja.info, Node: Customizing Methods, Next: Customizing Completion, Prev: Default Method, Up: Configuration - -4.6 Èóɸ½à¤Î¥á¥½¥Ã¥É¤ò»È¤¦ -========================== - -»öÁ°¤ËÄêµÁ¤µ¤ì¤¿¥á¥½¥Ã¥É¤À¤±¤Ç¤ÏÉÔ½½Ê¬¤Ê¾ì¹ç¤Ë¡¢¤½¤ì¤òÊѹ¹¤¹¤ë¤¿¤á¤Î -`tramp-methods' ¤È¤¤¤¦ÊÑ¿ô¤¬¤¢¤ê¤Þ¤¹¡£ - - Êѹ¹¤¬É¬Íפˤʤä¿»þ¤Î¤¿¤á¤Ë¡¢¤³¤ÎÊÑ¿ô¤Î Lisp -¥É¥­¥å¥á¥ó¥È¤Ë¤Ä¤¤¤Æ½Ò¤Ù¤Æ ¤ª¤­¤Þ¤¹¡£¥É¥­¥å¥á¥ó¥È¤Ï `C-h v -tramp-methods ' ¤Ç»²¾È¤¹¤ë ¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Customizing Completion, Next: Remote Programs, Prev: Customizing Methods, Up: Configuration - -4.7 ¥æ¡¼¥¶/¥Û¥¹¥È̾Êä´°¤Î¤¿¤á¤ÎÀßÄê¥Õ¥¡¥¤¥ë¤ÎÁªÂò -================================================= - -ÊÑ¿ô `tramp-completion-function-alist' ¤Ï¡¢¥æ¡¼¥¶Ì¾¤È¥Û¥¹¥È̾¤Î Êä´° -(*note Filename completion::) ¤ÎºÝ¤Ë¤É¤Î¥Õ¥¡¥¤¥ë¤¿¤Á¤ò¹Íθ¤ËÆþ¤ì -¤ë¤«¤ò¥«¥¹¥¿¥Þ¥¤¥º¤¹¤ë¤¿¤á¤Ë¤¢¤ê¤Þ¤¹¡£¤³¤ÎÊÑ¿ô¤Ï³Æ¡¹¤Î¥á¥½¥Ã¥É¤ËÂФ·¤Æ¡¢ -ÀßÄê¥Õ¥¡¥¤¥ë¤Î½¸¹ç¤È¤½¤Î¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤Ç¤­¤ë Lisp ´Ø¿ô¤È¤ÎÁȤòÊÝ»ý¤· -¤Þ¤¹¡£`tramp-completion-function-alist' ¤Î¥¨¥ó¥È¥ê¤Ï (METHOD PAIR1 -PAIR2 ...) ¤Î·Á¼°¤ò¤È¤ê¤Þ¤¹¡£ - - ¤½¤ì¤¾¤ì¤Î PAIR ¤Ï (FUNCTION FILE) ¤«¤éÀ®¤ê¤Þ¤¹¡£ FUNCTION -¤ÏÊä´°¤ÎºÝ¤Ë FILE ¤«¤é¥æ¡¼¥¶Ì¾¤È¥Û¥¹¥È̾¤ò¼è¤ê½Ð -¤¹¤Î¤Ë»È¤ï¤ì¤Þ¤¹¡£¤³¤ÎÊÑ¿ô¤Ë¥¢¥¯¥»¥¹¤¹¤ëÆó¤Ä¤Î´Ø¿ô¤¬¤¢¤ê¤Þ¤¹: - - -- Function: tramp-get-completion-function method - ¤³¤Î´Ø¿ô¤Ï METHOD ¤ËÂФ¹¤ëÊä´°´Ø¿ô¤Î¥ê¥¹¥È¤òÊÖ¤·¤Þ¤¹¡£ - - Example: - (tramp-get-completion-function "rsh") - - => ((tramp-parse-rhosts "/etc/hosts.equiv") - (tramp-parse-rhosts "~/.rhosts")) - - -- Function: tramp-set-completion-function method function-list - ¤³¤Î´Ø¿ô¤Ï METHOD ¤ËÂФ¹¤ëÊä´°´Ø¿ô¤Î¥ê¥¹¥È¤ò FUNCTION-LIST - ¤ËÀßÄꤷ¤Þ¤¹¡£ - - Example: - (tramp-set-completion-function "ssh" - '((tramp-parse-sconfig "/etc/ssh_config") - (tramp-parse-sconfig "~/.ssh/config"))) - - => ((tramp-parse-sconfig "/etc/ssh_config") - (tramp-parse-sconfig "~/.ssh/config")) - - ÀßÄê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤¹¤ë¤¿¤á¤Î°Ê²¼¤Î´Ø¿ô¤¬¤¢¤é¤«¤¸¤áÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹: - -`tramp-parse-rhosts' - ¤³¤Î´Ø¿ô¤Ï¹½Ê¸Åª¤Ë `~/.rhosts' ¤ÈÅù²Á¤Ê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤·¤Þ¤¹¡£¤â¤· - ½ñ¤«¤ì¤Æ¤¤¤ì¤Ð¥Û¥¹¥È̾¤È¥æ¡¼¥¶Ì¾¤ÎξÊý¤òÊÖ¤·¤Þ¤¹¡£ - -`tramp-parse-shosts' - ¤³¤Î´Ø¿ô¤Ï¹½Ê¸Åª¤Ë `~/.ssh/known_hosts' - ¤ÈÅù²Á¤Ê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤·¤Þ¤¹¡£ - ¤½¤Î¥Õ¥¡¥¤¥ë¤Ë¤Ï¥æ¡¼¥¶Ì¾¤Ï½ñ¤«¤ì¤Æ¤¤¤Ê¤¤¤Î¤Ç¥Û¥¹¥È̾¤Î¤ß¤òÊÖ¤·¤Þ¤¹¡£ - -`tramp-parse-sconfig' - ¤³¤Î´Ø¿ô¤Ï `~/.ssh/config' ·Á¼°¤Î¥Õ¥¡¥¤¥ë¤Î `Host' ¥¨¥ó¥È¥ê¤Ç - ÄêµÁ¤µ¤ì¤¿¥Û¥¹¥È¤Î¤¢¤À¤Ê¤òÊÖ¤·¤Þ¤¹¡£ - -`tramp-parse-hosts' - `/etc/hosts' - ·Á¼°¤Î¥Õ¥¡¥¤¥ë¤Î¤¿¤á¤Î´Ø¿ô¤Ç¤¹¡£¥Û¥¹¥È̾¤Î¤ß¤òÊÖ¤·¤Þ¤¹¡£ - -`tramp-parse-passwd' - `/etc/passwd' - ¤Î¤è¤¦¤Ê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤¹¤ë´Ø¿ô¤Ç¤¹¡£ÅöÁ³¤Ê¤¬¤é¥æ¡¼¥¶ - ̾¤Î¤ß¤òÊÖ¤·¤Þ¤¹¡£ - -`tramp-parse-netrc' - ºÇ¸å¤Ë¡¢¤³¤ì¤Ï `~/.netrc' ¤Î¤è¤¦¤Ê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤¹¤ë´Ø¿ô¤Ç¤¹¡£ - -¤â¤·Æȼ«¤Î¥Ç¡¼¥¿¤òÆȼ«¤Î¹½Â¤¤Ç¥Õ¥¡¥¤¥ë¤ËÊÝ»ý¤·¤¿¤¤¤Ê¤é¡¢¤³¤Î¤è¤¦¤Ê´Ø¿ô -¤òÄ󶡤¹¤ì¤Ð¤è¤¤¤Ç¤¹¡£¤³¤Î´Ø¿ô¤Ï°Ê²¼¤Î´·½¬¤Ë¹çÃפ¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£ - - -- Function: my-tramp-parse file - FILE ¤Ï¤¢¤Ê¤¿¤Î¥Û¥¹¥È¤Ë¤¢¤ë¥Õ¥¡¥¤¥ë̾¤â¤·¤¯¤Ï `nil' ¤Î¤¤¤º¤ì¤« - ¤Ç¤¹¡£¤³¤Î´Ø¿ô¤Ï (USER HOST) ¤Î¥ê¥¹¥È¤òÊÖ¤µ¤Í¤Ð¤Ê¤ê¤Þ¤»¤ó¡£ - ¤½¤ì¤é¤Ï¥æ¡¼¥¶/¥Û¥¹¥È̾Êä´°¤Î¸õÊä¤È¤·¤Æ»È¤ï¤ì¤Þ¤¹¡£ - - Example: - (my-tramp-parse "~/.my-tramp-hosts") - - => ((nil "toto") ("daniel" "melancholia")) - - -File: tramp_ja.info, Node: Remote Programs, Next: Remote shell setup, Prev: Customizing Completion, Up: Configuration - -4.8 ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç TRAMP ¤¬¥×¥í¥°¥é¥à¤òȯ¸«¡¢»ÈÍѤ¹¤ëÊýË¡ -============================================================= - -TRAMP ¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤Î¤¤¤¯¤Ä¤«¤Î¥×¥í¥°¥é¥à¡¢`ls'¡¢ `test'¡¢`find' -¤½¤·¤Æ `cat' ¤Ë°Í¸¤·¤Æ¤¤¤Þ¤¹¡£ - -¤³¤ì¤é¤Î¥Ä¡¼¥ë¤Ë¤¯¤ï¤¨¡¢¥³¥Í¥¯¥·¥ç¥ó¥á¥½¥Ã¥É¤Î¤¿¤á¤Ë¤¤¤¯¤Ä¤«¤Î¥Ä¡¼¥ë¤¬ -ɬÍפǤ¹¡£¾ÜºÙ¤Ï *Note Inline methods:: ¤È *Note External transfer -methods:: ¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£ - - ¤¤¤¯¤Ä¤«¤Î¾¤Î¥Ä¡¼¥ë¡¢`perl' (¤¢¤ë¤¤¤Ï `perl5') ¤È `grep' -¤¬Â¸ºß¤¹¤ì¤Ð¤½¤ì¤é¤â»ÈÍѤµ¤ì¤Þ¤¹¡£¤³¤ì¤Ï¡¢À­Ç½¤È -¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¥¢¥¯¥»¥¹¤ÎÀµ³Î¤µ¤Î¸þ¾å¤Î¤¿¤á¤Ç¤¹¡£ - - TRAMP -¤Ï¥ê¥â¡¼¥È¥Þ¥·¥ó¤ËÀܳ¤·¤¿»þ¤Ë¡¢»ÈÍѲÄǽ¥×¥í¥°¥é¥à¤ò¸¡º÷¤·¤Þ¤¹¡£ ÊÑ¿ô -TRAMP-REMOTE-PATH ¤Ï¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç¸¡º÷¤µ¤ì¤ë¥Ç¥£¥ì¥¯¥È¥ê -¤òÀ©¸æ¤·¤Þ¤¹¡£ - - ¥Ç¥Õ¥©¥ë¥È¤Ç¿¤¯¤Î¥Þ¥·¥ó¤Ë¤È¤Ã¤ÆŬÀڤʥѥ¹¤¬ÀßÄꤵ¤ì¤Æ¤¤¤Þ¤¹¡£¤·¤«¤· -¤Ê¤¬¤é¡¢¥í¡¼¥«¥ë(¤¢¤ë¤¤¤Ï¥ê¥â¡¼¥È)¥·¥¹¥Æ¥à¤Î´ÉÍý¼Ô¤¬¡¢É¬Íפʥġ¼¥ë¤ò -¤Ø¤ó¤Ô¤Ê¥Ç¥£¥ì¥¯¥È¥ê¤Ë¥¤¥ó¥¹¥È¡¼¥ë¤·¤Æ¤¤¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£ - - ¤³¤Î¤è¤¦¤Ê¾ì¹ç¤Ç¤â TRAMP ¤ò»È¤¦»ö¤¬¤Ç¤­¤Þ¤¹¡£Ã±¤Ë¡¢É¬Íפʥǥ£¥ì¥¯¥È¥ê -¤ò¥ê¥â¡¼¥È¥Ñ¥¹¤ËÄɲ乤륳¡¼¥É¤ò `.emacs' ¤Ë½ñ¤¯¤À¤±¤Ç¤¹¡£¤³¤ì¤Ç -Àܳ»þ¤Ë TRAMP ¤Ë¤è¤ê¡¢Äɲä·¤¿¥Ç¥£¥ì¥¯¥È¥ê¤¬¸¡º÷¤µ¤ì¥×¥í¥°¥é¥à¤¬ -ȯ¸«¤µ¤ì¤Þ¤¹¡£ - - ¥ê¥â¡¼¥È¥µ¡¼¥Á¥Ñ¥¹¤Ë¥Ç¥£¥ì¥¯¥È¥ê¤òÄɲ乤뤿¤á¤Ë¤Ï¡¢°Ê²¼¤Î¤è¤¦¤Ê -¥³¡¼¥É¤ò»È¤Ã¤Æ¤¯¤À¤µ¤¤: - - ;; ÊÑ¿ô¤òÄêµÁ¤¹¤ë¤¿¤á¤Ë TRAMP ¤ò¥í¡¼¥É¤¹¤ë - (require 'tramp) - ;; `perl' ¤¬ "/usr/local/perl/bin" ¤Ë¤¢¤ë - (add-to-list 'tramp-remote-path "/usr/local/perl/bin") - - -File: tramp_ja.info, Node: Remote shell setup, Next: Windows setup hints, Prev: Remote Programs, Up: Configuration - -4.9 ¥ê¥â¡¼¥È¥·¥§¥ë¤ÎÀßÄê¤Î¥Ò¥ó¥È -================================ - -*Note Overview:: ¤ÎÀá¤ÇÀâÌÀ¤·¤¿¤è¤¦¤Ë¡¢TRAMP ¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤·¡¢ -¤½¤³¤Ë¤¢¤ë¥·¥§¥ë¤ÈÂÐÏä·¤Þ¤¹¡£¤â¤Á¤í¤ó¥í¥°¥¤¥ó¤¹¤ëºÝ¤Ë¤Ï¥·¥§¥ë¤Ï¤½¤Î -½é´ü²½¥Õ¥¡¥¤¥ë¤ò¼Â¹Ô¤·¤Þ¤¹¡£Î㤨¤Ð¤¢¤Ê¤¿¤Î½é´ü²½¥Õ¥¡¥¤¥ë¤¬¤¢¤Ê¤¿¤Î¤ªÊì -¤µ¤ó¤ÎÃÂÀ¸Æü¤òÆþÎϤµ¤»¤ë¤è¤¦¤Ë¤Ê¤Ã¤Æ¤¤¤¿¤È¤·¤Þ¤·¤ç¤¦; ÅöÁ³ TRAMP -¤Ï¤½¤Î¤³¤È¤òÃΤé¤Ê¤¤¤Î¤Ç¡¢¤½¤Î¥Û¥¹¥È¤Ø¤Î¥í¥°¥¤¥ó¤Ë¼ºÇÔ¤·¤Þ¤¹¡£ - - ¤³¤ÎÌäÂê¤òÄɵ᤹¤ë¤¿¤á¤Ë¡¢¤¤¤¯¤Ä¤«¤ÎÀïά¤¬¹Í¤¨¤é¤ì¤Þ¤¹¡£°ì¤Ä¤Ï¡¢TRAMP -¤¬¤¹¤Ù¤Æ¤Î²Äǽ¤Ê¾õ¶·¤ËÂбþ¤Ç¤­¤ë¤è¤¦¤Ë¤¹¤ë¤³¤È¤Ç¤¹¡£¤³¤ì¤Ï¾ÃÌ×Àï¤Ç¤¹¡£ -²¿¸Î¤Ê¤é _Á´¤Æ¤Î_ ¾õ¶·¤ò°·¤¦¤³¤È¤ÏÉÔ²Äǽ¤À¤«¤é¤Ç¤¹¡£Ê̤μê¤È¤·¤Æ¡¢ -TRAMP ¤Î´üÂÔÄ̤ê¤Ë¿¶¤ëÉñ¤¦¤è¤¦¤Ë¡¢¤¢¤Ê¤¿¤Ë¥ê¥â¡¼¥È¥Û¥¹¥È¤ÎÀßÄê¤ò¤·¤Æ -¤¤¤¿¤À¤¯¤È¤¤¤¦¤³¤È¤â½ÐÍè¤Þ¤¹¡£¤·¤«¤·¤³¤ì¤ÏÉÔÊؤ«¤â¤·¤ì¤Þ¤»¤ó¡£²¿¸Î¤Ê¤é -TRAMP ¤ò»È¤¤»Ï¤á¤ë¤è¤êÀè¤Ë¡¢¥·¥§¥ë¤ÎÀßÄê¤Ë¿¤¯¤ÎÏ«ÎϤò³ä¤¯É¬Íפ¬¤¢¤ë -¤Î¤Ç¤¹¤«¤é¡£ - - ¤½¤Î¤³¤È¤«¤é¡¢¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ç¤Ï¤½¤ì¤é¤òÁȤ߹ç¤ï¤»¤¿ÊýË¡¤ò¤È¤ê¤Þ¤¹¡£ -¤¤¤¯¤Ä¤«¤Î¤¢¤ê¤Õ¤ì¤¿ÀßÄê¤Ë¤Ä¤¤¤Æ¤ÏÍý²ò¤·¤è¤¦¤È¤·¤Æ¤¯¤ì¤Æ¡¢¤¢¤Ê¤¿¤Ë¤Ï -ËÜÅö¤ËÆðۤÊÀßÄê¤À¤±¤òÈò¤±¤ë¤è¤¦¤Ëµá¤á¤Þ¤¹¡£Î㤨¤Ð¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤Ç -¤¢¤ë¥×¥í¥°¥é¥à¤ò¸«¤Ä¤±¤ë¤¿¤á¤Ë¤Ï¡¢¥Ç¥£¥ì¥¯¥È¥ê¤Î°ìÍ÷¤òÄ´¤Ù¤Þ¤¹¡£ -¤½¤·¤Æ¤Þ¤¿¡¢¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤¹¤ë¤«¤ò¤É¤¦¤«Ä´¤Ù¤ëÊýË¡¤È¤¤¤¦¤Î¤âÌÀ¤é¤«¤Ç¤Ï -¤Ê¤¤¤Î¤Ç¡¢¤¤¤¯¤Ä¤«¤Î°Û¤Ê¤ë²ÄǽÀ­¤ò»î¤·¤Æ¤¯¤ì¤Þ¤¹¡£ -(¤¢¤ë¥Û¥¹¥È¤È¥·¥§¥ë¤Ë¤ª¤¤¤Æ¤Ï¡¢`test -e' ¥³¥Þ¥ó¥É¤¬¤½¤ÎÌòÌܤò²Ì¤¿¤¹¡£ -Ê̤Υۥ¹¥È¡¢¥·¥§¥ë¤ËÂФ·¤Æ¤Ï¥·¥§¥ë¤ÎÁȤ߹þ¤ß¥³¥Þ¥ó¥É¤ÏƯ¤«¤Ê¤¤¤¬¡¢ -`/usr/bin/test -e' ¤ä `/bin/test -e' ¤Ê¤é¤¦¤Þ¤¯Æ¯¤¯¡£ -¤½¤·¤Æ¤µ¤é¤ËÊ̤Υۥ¹¥È¤Ç¤Ï `ls -d' ¤¬¤½¤ÎÊýË¡¤È¤·¤ÆƯ¤¯¡£) - - °Ê²¼¤Ç¤Ï¡¢TRAMP -¤¬¼è¤ê°·¤Ã¤Æ¤¯¤ì¤Ê¤¤¡¢¤Ä¤Þ¤ê¤¢¤Ê¤¿¤¬Àµ¤·¤¯ÀßÄꤹ¤ëɬÍ× -¤Î¤¢¤ë¤¤¤¯¤Ä¤«¤Î»öÊÁ¤Ë¤Ä¤¤¤Æ½Ò¤Ù¤Þ¤¹¡£ - -SHELL-PROMPT-PATTERN - ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤·¤¿¸å¡¢TRAMP - ¤¬¥ê¥â¡¼¥È¥·¥§¥ë¤ËÌ¿Îá¤òÁ÷¤ì¤ë - ¤è¤¦¤Ë¤Ê¤ëÁ°¤Ë¡¢¥ê¥â¡¼¥È¥·¥§¥ë¤Î¥»¥Ã¥È¥¢¥Ã¥×¤¬½ªÎ»¤¹¤ë¤Î¤òÂÔ¤ÄɬÍפ¬¤¢¤ê - ¤Þ¤¹¡£¥·¥§¥ë¥×¥í¥ó¥×¥È¤òǧ¼±¤¹¤ë°Ù¤Ë¡¢ÊÑ¿ô `shell-prompt-pattern' - ¤ò¥ê¥â¡¼¥È¥Û¥¹¥È¤Î¥·¥§¥ë¥×¥í¥ó¥×¥È¤òǧ¼±½ÐÍè¤ë¤è¤¦¤ËÀßÄꤷ¤Æ¤ª¤¯É¬Íפ¬ - ¤¢¤ê¤Þ¤¹¡£ - - TRAMP ¤Ï `shell-prompt-pattern' ¤ËÂФ·¤Æ¥Ð¥Ã¥Õ¥¡ËöÈø¤Ç¥Þ¥Ã¥Á¤¹ - ¤ë¤³¤È¤òÍ׵᤹¤ë¤³¤È¤ËÃí°Õ¤·¤Æ²¼¤µ¤¤¡£Â¿¤¯¤Î¿Í¤Ï¤³¤ÎÊÑ¿ô¤ÎÃͤȤ·¤Æ¼¡¤Î - ¤è¤¦¤Ê¤â¤Î¤ò»ØÄꤷ¤Æ¤¤¤Þ¤¹: `"^[^>$][>$] *"'¡£¤³¤³¤Ç¤¢¤Ê¤¿¤Î¥·¥§¥ë - ¥×¥í¥ó¥×¥È¤¬ `a c $ ' - ¤Î¤è¤¦¤Ê¤â¤Î¤À¤Ã¤¿¤È¤·¤Þ¤·¤ç¤¦¡£¤³¤Î¾ì¹ç¡¢ TRAMP ¤Ïʸ»ú`>' - ¤ò¥×¥í¥ó¥×¥È¤Î½ªÃ¼¤Èǧ¼±¤·¤Þ¤¹¤¬¡¢¤½¤ì¤Ï¥Ð¥Ã¥Õ¥¡ - ¤Î½ªÃ¼¤Ë¤Ï¤¢¤ê¤Þ¤»¤ó¡£ - -TRAMP-SHELL-PROMPT-PATTERN - ¤³¤ÎÀµµ¬É½¸½¤Ï `shell-prompt-pattern' ¤ÈƱÍͤ˥ê¥â¡¼¥È¥·¥§¥ë¤Î - ¥×¥í¥ó¥×¥È¤Ë¥Þ¥Ã¥Á¤¹¤ë¤â¤Î¤È¤·¤Æ»È¤ï¤ì¤Þ¤¹¡£¤³¤ÎÆó¤ÄÌܤÎÊÑ¿ô¤Ï¥ê¥â¡¼¥È - ¥·¥§¥ë¤Î¥×¥í¥ó¥×¥È¤¬¥í¡¼¥«¥ë¥·¥§¥ë¤È°Û¤Ê¤ë²ÄǽÀ­¤¬¤¢¤ë¤Î¤Ç¸ºß¤·¤Þ¤¹¡£ - ¤È¤Ë¤«¤¯ TRAMP ¤ÎÍ×ÅÀ¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÊ̤Υ桼¥¶¤È¤·¤Æ¥í¥°¥¤¥ó¤¹¤ë - ¤³¤È¤Ç¤¹¡£`tramp-shell-prompt-pattern' ¤Î¥Ç¥Õ¥©¥ë¥È¤ÎÃÍ¤Ï - `shell-prompt-pattern' ¤Î¥Ç¥Õ¥©¥ë¥ÈÃͤÈƱ°ì¤Î¤â¤Î¤Ç¤¹¤¬¡¢Â¿¤¯¤Î¾õ¶· - ¤Ç¤½¤ì¤Ï¤¦¤Þ¤¯Æ¯¤¯¤ÈÊó¹ð¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ - -`tset' ¤È¤½¤Î¾¤Î¼ÁÌä - ¥·¥§¥ë¤Îµ¯Æ°¥¹¥¯¥ê¥×¥È¤«¤é `tset' ¥×¥í¥°¥é¥à¤ò¸Æ¤Ó½Ð¤·¡¢ - ¥·¥§¥ë¤ÎüËö¤Î¼ïÎà¤ò¿Ò¤Í¤ë¤è¤¦¤Ë¤·¤Æ¤¤¤ë¾ì¹ç¤¬¤¢¤ê¤Þ¤¹¡£¤¿¤Ö¤ó - ¥·¥§¥ë¤Ë¤è¤Ã¤Æ¤Ï¤½¤Î¾¤Î¼ÁÌä¤òµ¯Æ°»þ¤Ë¤·¤Æ¤¯¤ë¾ì¹ç¤â¤¢¤ë¤Ç¤·¤ç¤¦¡£ - TRAMP ¤Ï¤³¤ì¤é¤Î¼ÁÌä¤ËÅú¤¨¤ëÊýË¡¤òÃΤê¤Þ¤»¤ó¡£¤³¤ÎÌäÂê¤ò°·¤¦¤Ë¤Ï - Æó¤Ä¤Î¥¢¥×¥í¡¼¥Á¤¬¤¢¤ê¤Þ¤¹¡£°ì¤Ä¤Î¥¢¥×¥í¡¼¥Á¤Ï¡¢¥·¥§¥ë¤¬ TRAMP ¤«¤é - ¸Æ¤Ó½Ð¤µ¤ì¤¿¤È¤­¤Ë²¿¤Î¼ÁÌä¤â¤·¤Ê¤¤¤è¤¦¤Ë¤·¤Æ¤ª¤¯¤³¤È¤Ç¤¹¡£¤½¤Î¤¿¤á¤Ë¤Ï - ´Ä¶­ÊÑ¿ô `TERM' ¤òÄ´¤Ù¤Æ²¼¤µ¤¤¡£¤½¤ì¤ÏÀܳ»þ¤Ë `dumb' ¤ËÀßÄê - ¤µ¤ì¤Þ¤¹¡£ - - ÊÑ¿ô `tramp-terminal-type' ¤Ë¤è¤ê¤³¤ÎÃͤò `dumb' ¤ËÊѹ¹¤¹¤ë - ¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - Ê̤Υ¢¥×¥í¡¼¥Á¤Ï TRAMP ¤Ë¤³¤ì¤é¤Î¼ÁÌä¤ò¶µ¤¨¤Æ¤ª¤¯¤³¤È¤Ç¤¹¡£ÊÑ¿ô - `tramp-actions-before-shell' ¤ª¤è¤Ó `tramp-multi-actions' - (¥Þ¥ë¥Á¥Û¥Ã¥×Àܳ¤Î¾ì¹ç) ¤ò»²¾È¤·¤Æ²¼¤µ¤¤¡£ - -`.profile' Ãæ¤Î´Ä¶­ÊÑ¿ô¤Ç¡¢¥æ¡¼¥¶¤ÈƱ¤¸Ì¾Á°¤Î¤â¤Î¤¿¤Á - frumple ¤È¤¤¤¦Ì¾Á°¤Î¥æ¡¼¥¶¤¬µï¤¿¤È¤·¤Æ¡¢ÊÑ¿ô `FRUMPLE' ¤ò¥·¥§¥ë´Ä¶­ - ¤ÇÀßÄꤷ¤Æ¤¤¤ë¾ì¹ç¡¢ÉÔ¶ñ¹ç¤¬µ¯¤­¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£ `FRUMPLE_DIR' - ¤È¤«¤½¤Î¤è¤¦¤Ê¤â¤Î¤Ë²þ̾¤¹¤ë¤Î¤¬¤è¤¤¤Ç¤·¤ç¤¦¡£ - - ´ñ̯¤Ê¸ú²Ì¤¬¼ÂºÝ¤Ë TRAMP ¥æ¡¼¥¶¤«¤éÊó¹ð¤µ¤ì¤Æ¤¤¤Þ¤¹! - -`.profile' Ãæ¤Î Non-Bourne ¥³¥Þ¥ó¥É¤¿¤Á - ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤·¤¿¸å¡¢TRAMP ¤Ï¥³¥Þ¥ó¥É `exec /bin/sh' - ¤òȯ¹Ô¤·¤Þ¤¹¡£ (¼ÂºÝ¤Ë¤Ï¥³¥Þ¥ó¥É¤Ï¤Á¤ç¤Ã¤È°Û¤Ê¤ê¤Þ¤¹¤¬¡£) - `/bin/sh' - ¤¬¼Â¹Ô¤µ¤ì¤ë»þ¤Ë¡¢¤¤¤¯¤Ä¤«¤Î½é´ü²½¥Õ¥¡¥¤¥ë¤¬Æɤ߹þ¤Þ¤ì¤Þ¤¹¡£ - Î㤨¤Ð `~/.shrc' ¤ä `~/.profile' ¤Ç¤¹¡£ - - ¤³¤³¤Ç¡¢¥í¥°¥¤¥ó¥·¥§¥ë¤¬ `/bin/sh' ¤Ç¤Ï¤Ê¤¯¡¢ bash ¤ä ksh ¤È¤¤¤Ã¤¿ - Bourne Ū¤Ê¥·¥§¥ë¤Ç¤¢¤Ã¤¿¾ì¹ç¡¢¿Í¤Ë¤è¤Ã¤Æ¤Ï `~/.shrc' ¤ä - `~/.profile'. - ¤Ë¥·¥§¥ë¤ÎÀßÄê¤ò½ñ¤¤¤Æ¤¤¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤½¤Î¾ì¹ç¤Ë¡¢Bourne - ¤Ç¤Ê¤¤¹½À®Êª - ¤¬¤½¤ì¤é¤Î¥Õ¥¡¥¤¥ë¤Ë½ñ¤«¤ì¤Æ¤¤¤ë²ÄǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£¤½¤¦¤¹¤ë¤È¡¢`exec - /bin/sh' ¤Ë¤è¤Ã¤Æ Bourne ¥·¥§¥ë¤Ï¤½¤ì¤é¤òÌᤷ¤Æ¤·¤Þ¤¤¤Þ¤¹¡£ - - Î㤨¤Ð `~/.profile' ¥Õ¥¡¥¤¥ë¤Ë `export FOO=bar' ¤È½ñ¤¤¤Æ¤¢¤Ã¤¿ - ¤È¤¹¤ë¤È¡¢É¸½àŪ¤Ê Bourne - ¥·¥§¥ë¤Ï¤³¤Î¹½Ê¸¤òÍý²ò¤Ç¤­¤Ê¤¤¤Î¤Ç¡¢¤³¤Î¹Ô¤Ë - Åþ㤹¤ë¤È¥·¥ó¥¿¥Ã¥¯¥¹¥¨¥é¡¼¤òÊÖ¤·¤Þ¤¹¡£ - - Ê̤ÎÎã¤È¤·¤Æ¤Ï¥Á¥ë¥À (`~') ʸ»ú¤¬¤¢¤ê¤Þ¤¹¡£Î㤨¤Ð `$PATH' ¤Ë - `~/bin' ¤òÉÕ¤±²Ã¤¨¤ë¾ì¹ç¤Ç¤¹¡£ ¿¤¯¤Î Bourne ¥·¥§¥ë¤Ï¤³¤Îʸ»ú¤òŸ³« - ¤»¤º¡¢ÉáÄ̤Ï̾Á°¤¬¥Á¥ë¥À°ìʸ»ú¤Î¥Ç¥£¥ì¥¯¥È¥ê¤Ï¸ºß¤·¤Ê¤¤¤Î¤Ç¤ª¤«¤·¤Ê¤³¤È - ¤¬µ¯¤³¤ë¤Ç¤·¤ç¤¦¡£ - - ¤³¤ì¤ËÂФ·¤Æ²¿¤ò¤¹¤ì¤Ð¤è¤¤¤Î¤«? - - °ì¤Ä¤ÎÊýË¡¤È¤·¤Æ¤ÏÁ´¤Æ¤Î¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤Î `~/.shrc' ¤È - `~/.profile' ¤ÎÃæ¤ÎÁ´¤Æ¤¬ Bourne-¸ß´¹¤Ç¤¢¤ë¤è¤¦¤Ë¤¹¤ë¤³¤È¤Ç¤¹¡£ - ¾å¤ÎÎã¤Ç¤Ï¡¢`export FOO=bar' ¤ÎÂå¤ï¤ê¤Ë `FOO=bar; export FOO' - ¤È½ñ¤±¤Ð¤è¤¤¤Ç¤·¤ç¤¦¡£ - - Ê̤ÎÊýË¡¤È¤·¤Æ¤Ï¡¢non-Bourne - ¥·¥§¥ë¤ÎÀßÄê¤òÊ̤Υե¡¥¤¥ë¤Ë½ñ¤¯¤³¤È¤Ç¤¹¡£ Î㤨¤Ð¡¢bash ¤Ï¥Õ¥¡¥¤¥ë - `~/.bash_profile' ¤¬¤¢¤ì¤Ð `~/.profile' - ¤ÎÂå¤ï¤ê¤Ë¤½¤ì¤òÆɤ߹þ¤ß¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ bash - ¥Õ¥¡¥ó¤ÏÁ´¤Æ¤Î¥ê¥â¡¼¥È¥Û¥¹¥È ¾å¤Î `~/.profile' ¤ò - `~/.bash_profile' ¤Ë²þ̾¤·¤Æ¤ª¤±¤ÐÂç¾æÉפǤ¹¡£ - - TRAMP - ¤Î³«È¯¼Ô¤Ï¤³¤ÎÌäÂê¤ò²óÈò¤·¤¿¤¤¤È¹Í¤¨¤Æ¤¤¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ¤³¤ì¤Ë - ´Ø¤¹¤ë¥¢¥¤¥Ç¥¢¤¬¤¢¤ì¤Ð¤¼¤Ò¶µ¤¨¤Æ²¼¤µ¤¤¡£¤·¤«¤·¤Ê¤¬¤é¡¢¤³¤ì¤Ï¤½¤¦Ã±½ã¤Ç¤Ï - ¤Ê¤¤¤È¹Í¤¨¤Æ¤¤¤Þ¤¹: `exec /bin/sh' ¤È¸Æ¤ÖÁ°¤Ë¤Ï¡¢TRAMP ¤Ï¤É¤Î - ¼ïÎà¤Î¥·¥§¥ë¤ÈÂÐÏ䷤Ƥ¤¤ë¤Î¤«ÃΤé¤Ê¤¤¤Î¤Ç¤¹¡£¤½¤ì¤Ï ksh ¤ä bash - ¤È¤¤¤Ã¤¿ Bourne Ū¤Ê¥·¥§¥ë¤Ç¤¢¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¤·¡¢csh ¤«¤éÇÉÀ¸¤·¤¿ - tcsh ¤Î¤è¤¦¤Ê ¤â¤Î¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤â¤·¤¯¤Ï zsh ¤ä¡¢¤Ï¤¿¤Þ¤¿ rc - ¤Ç¤¢¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£ ¤â¤·¥·¥§¥ë¤¬¤¹¤Ç¤Ë Bourne - Ū¤Ê¤â¤Î¤Ç¤¢¤ë¤Ê¤é `exec /bin/sh' ¤ÎÃʳ¬¤ò - ¾Êά¤¹¤ë¤Î¤¬·üÌ¿¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤·¤«¤·¡¢¤É¤¦¤ä¤Ã¤Æ¥·¥§¥ë¤¬ Bourne - Ū¤À¤È ÃΤë¤Î¤Ç¤·¤ç¤¦¤«? - - - -File: tramp_ja.info, Node: Auto-save and Backup, Prev: Windows setup hints, Up: Configuration - -4.10 Auto-save ¤È¥Ð¥Ã¥¯¥¢¥Ã¥×¤ÎÀßÄê -=================================== - -auto-save ¤ÎÀâÌÀ¤Ï̤´°À®¤Ç¤¹¡£ - - Ä̾ï Emacs ¤Ï¥ª¥ê¥¸¥Ê¥ë¤Î¥Õ¥¡¥¤¥ë¤ÈƱ¤¸¥Ç¥£¥ì¥¯¥È¥ê¤Ë¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡ -¥¤¥ë¤òÊݸ¤·¤Þ¤¹¤¬¡¢¤³¤ÎµóÆ°¤ÏÊÑ¿ô `backup-directory-alist' ¤òÄÌ -¤·¤ÆÊѹ¹¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£TRAMP ¤òÍѤ¤¤¿Àܳ¤Ë¤ª¤¤¤Æ¤³¤Î¤³¤È¤Ïͽ -´ü¤·¤Ê¤¤ÉûºîÍѤò¤â¤¿¤é¤¹²ÄǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£Î㤨¤ÐÁ´¤Æ¤Î¥Ð¥Ã¥¯¥¢¥Ã¥×¤¬¥Ç -¥£¥ì¥¯¥È¥ê `~/.emacs.d/backups/' ¤Ë¹Ô¤¯¤è¤¦¤Ë¤Ê¤Ã¤Æ¤¤¤¿¤È¤·¤Æ¡¢¥Õ -¥¡¥¤¥ë `/su:root@localhost:/etc/secretfile' ¤òÊÔ½¸¤·¤¿¤È¤·¤Þ¤·¤ç -¤¦¡£¤½¤Î·ë²Ì¤Ï¡¢¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡¥¤¥ë¤Ï root ¤Ç¤Ï¤Ê¤¯¤¢¤Ê¤¿¤Î½êÍ­¤È¤Ê¤ê¡¢ -¤·¤¿¤¬¤Ã¤Æ¤¿¤È¤¨¤½¤Î¤Ä¤â¤ê¤¬¤Ê¤«¤Ã¤¿¤È¤·¤Æ¤â¤½¤ì¤¬Â¾¼Ô¤«¤é¸«¤Æ¤·¤Þ¤¦²Ä -ǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£ - - `backup-directory-alist' ¤¬ nil (¥Ç¥Õ¥©¥ë¥È) ¤Ç¤¢¤ì¤Ð¤½¤Î¤è¤¦¤ÊÌä -Âê¤Ï¤ª¤³¤ê¤Þ¤»¤ó¡£ - - ¤â¤·¤¢¤Ê¤¿¤¬¤½¤ÎÊÑ¿ô¤ò¥«¥¹¥¿¥Þ¥¤¥º¤·¤¿¤¤¤Ê¤é¡¢TRAMP ¤Î¥Õ¥¡¥¤¥ë¤ËÂÐ -¤·¤ÆÆÃÊ̤ÊÀßÄê¤ò¹Ô¤Ê¤¦¤È¤¤¤¦²óÈòË¡¤¬¤¢¤ê¤Þ¤¹¡£Î㤨¤Ð°Ê²¼¤Îµ­½Ò¤Ë¤è¤ê¡¢ -TRAMP ¤Î¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ¸ú²ÌŪ¤Ë `backup-directory-alist' ¤Î¸ú -²Ì¤ò¾Ã¤·¤Þ¤¹: - - (require 'tramp) - (add-to-list 'backup-directory-alist - (cons tramp-file-name-regexp nil)) - - -File: tramp_ja.info, Node: Windows setup hints, Next: Auto-save and Backup, Prev: Remote shell setup, Up: Configuration - -4.11 Cygwin ssh ¤Ë¤Þ¤Ä¤ï¤ë»öÊÁ -============================== - -¤³¤ÎÀá¤Ï¤¿¤¯¤µ¤ó¤Î»Å»ö¤¬É¬ÍפǤ¹! ¤É¤¦¤«¼êÅÁ¤Ã¤Æ²¼¤µ¤¤¡£ - - ¤â¤·¤¢¤Ê¤¿¤¬ Cygwin ¤Ç¥¤¥ó¥¹¥È¡¼¥ë¤·¤¿ ssh -(¥¤¥ó¥¹¥È¡¼¥é¤ÇÌÀ¼¨Åª¤ËÁªÂò ¤¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹) -¤ò»È¤Ã¤Æ¤¤¤ë¤Ê¤é¡¢Àܳ¥á¥½¥Ã¥É¤È¤·¤Æ `sshx' ¤ò -ÁªÂò¤¹¤ë¤À¤±¤Ç¥Þ¥·¥ó¤Î³°¤Ë½Ð¤é¤ì¤ë¤Ï¤º¤Ç¤¹¡£Cygwin ¤Î¥»¥Ã¥È¥¢¥Ã¥×¤Ë -¤Ä¤¤¤Æ¤Î¾ðÊó¤Ï `http://cygwin.com/faq/' ¤Ë¤¢¤ëÈà¤é¤Î FAQ ¤ÇÆÀ¤ë -¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - ¤â¤· `scpx' Àܳ¥á¥½¥Ã¥É¤ò»È¤¤¤¿¤¤¤È»×¤Ã¤¿¤Ê¤é¡¢Emacs ¤¬ `c:/foo' -¤Î¤è¤¦¤Ê Windows ¥Õ¥¡¥¤¥ë̾¤òȼ¤Ê¤Ã¤Æ `scp' ¤ò¸Æ¤Ö»þ¤ËÌäÂ꤬µ¯¤­¤ë -¤«¤â¤·¤ì¤Þ¤»¤ó¡£Cygwin ÈǤΠ`scp' ¤Ï Windows ¥Õ¥¡¥¤¥ë̾¤Ë¤Ä¤¤¤ÆÃΤé -¤Ê¤¤¤Î¤Ç¡¢¤½¤ì¤ò¥Û¥¹¥È `c' ¾å¤Î¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë̾¤È²ò¼á¤·¤Æ¤·¤Þ¤¤¤Þ¤¹¡£ - - °ì¤Ä¤Î²Äǽ¤Ê²óÈòË¡¤È¤·¤Æ¤Ï¡¢Windows ¥Õ¥¡¥¤¥ë̾¤ò Cygwin -¤Î¥Õ¥¡¥¤¥ë̾¤Ë ÊÑ´¹¤¹¤ë¥é¥Ã¥Ñ¡¼¥¹¥¯¥ê¥×¥È¤ò½ñ¤¯¤³¤È¤Ç¤¹¡£ - - Ê̤βóÈòË¡¤È¤·¤Æ¤Ï Emacs ¤ò Cygwin ¾å¤ÇÆ°¤«¤¹¤«¡¢¤â¤·¤¯¤Ï Cygwin ÈǤΠ-Emacs ¤ò»È¤¦¤³¤È¤¬¤¢¤ë¤È»×¤¤¤Þ¤¹¡£ - - ²¿¤é¤«¤Î `ssh' ¤Ë´ð¤Å¤¯¥á¥½¥Ã¥É¤ò Windows ¾å¤Ç»È¤¤¤¿¤¤¾ì¹ç¡¢ -`ssh-agent' ¤Ë´Ø¤¹¤ëÌäÂê¤ËÁø¶ø¤¹¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤³¤Î¥×¥í¥°¥é¥à -¤ò»È¤¦¤È¡¢¥í¥°¥¤¥ó¤ÎºÝ¤ËËè²ó¥Ñ¥¹¥Õ¥ì¡¼¥º¤òÆþÎϤ¹¤ë¤³¤È¤òÈò¤±¤ë¤³¤È¤¬ -¤Ç¤­¤Þ¤¹ (¤Þ¤¿¡¢`scpx' ¥á¥½¥Ã¥É¤Ï `ssh-agent' ¤ò»È¤¦¤³¤È¤ò -Í׵ᤷ¤Þ¤¹¡£¤Ê¤¼¤Ê¤é¤½¤ì¤Ï¥Ñ¥¹¥ï¡¼¥É¤ä¥Ñ¥¹¥Õ¥ì¡¼¥º¤òÆþÎϤµ¤»¤Æ¤¯¤ì¤Ê¤¤ -¤«¤é¤Ç¤¹)¡£¤·¤«¤·¤Ê¤¬¤é¡¢Emacs ¤ò¥Ç¥¹¥¯¥È¥Ã¥×¥·¥ç¡¼¥È¥«¥Ã¥È¤«¤éµ¯Æ°¤·¤¿ -¤Ê¤é¡¢´Ä¶­ÊÑ¿ô `SSH_AUTH_SOCK' ¤ÏÀßÄꤵ¤ì¤Ê¤¤¤Î¤Ç¡¢ Emacs ¤½¤·¤Æ -TRAMP¡¢ ¤½¤·¤Æ TRAMP ¤«¤éµ¯Æ°¤µ¤ì¤ë `ssh' ¤ª¤è¤Ó `scp' ¤Ï `ssh-agent' -¤ÈÄÌ¿®¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤»¤ó¡£Emacs ¤ò¥·¥§¥ë¤«¤éµ¯Æ° -¤¹¤ì¤Ð¤¦¤Þ¤¯Æ°¤­¤Þ¤¹¡£ - - ¤â¤·Ã¯¤« Windows -¾å¤Ç¥Ç¥¹¥¯¥È¥Ã¥×¥·¥ç¡¼¥È¥«¥Ã¥È¤¬²¸·Ã¤ò¼õ¤±¤é¤ì¤ë¤è¤¦¤Ê¡¢ `ssh-agent' -¤Îµ¯Æ°ÊýË¡¤òÃΤäƤ¤¤¿¤é¶«¤ó¤Ç²¼¤µ¤¤¡£»ä¤ÏËÜÅö¤Ë Windows -¤Ë¤Ä¤¤¤Æ¤Ï²¿¤âÃΤé¤Ê¤¤¤Î¤Ç¤¹... - - -File: tramp_ja.info, Node: Usage, Next: Bug Reports, Prev: Configuration, Up: Top - -5 TRAMP ¤Î»È¤¤Êý -**************** - -TRAMP ¤ò¥¤¥ó¥¹¥È¡¼¥ë¤¹¤ë¤È¡¢TRAMP ¤Ï´°Á´¤ËÆ©²áŪ¤ËÆ°ºî¤·¤Þ¤¹¡£ -¥í¥°¥¤¥ó²Äǽ¤Ê¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥Õ¥¡¥¤¥ë¤Ë¡¢¤¢¤¿¤«¤â¥í¡¼¥«¥ë¥Õ¥¡¥¤¥ë -¤Î¤è¤¦¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - TRAMP ¤Ç¤Ï¡¢formalized -¥·¥ó¥¿¥Ã¥¯¥¹¤ò»È¤¤¥Õ¥¡¥¤¥ë¤ò»ØÄꤷ¤Þ¤¹¡£¤³¤ì¤Ï¡¢ EFS -¥Ñ¥Ã¥±¡¼¥¸¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤Ë»÷¤Æ¤¤¤Þ¤¹¡£ - - ¤¢¤Ê¤¿¤ò¶Ã¤«¤»¤ë¤³¤È¤¬µ¯¤³¤êÆÀ¤Þ¤¹¡£ Emacs -¤ÏÁ´¤Æ¤Î¥­¡¼ÆþÎϤò²±¤¨¤Æ¤¤¤Þ¤¹¡£ ¤·¤¿¤¬¤Ã¤Æ Emacs -¤«¤é¤Î¥Ñ¥¹¥ï¡¼¥É¥×¥í¥ó¥×¥È¤òÌܤˤ·¤Æ `' -¤ò°ì²ó¤Ç¤Ê¤¯Æó²óᤤ¤¿¾ì¹ç¡¢Æó²óÌܤΥ­¡¼ÆþÎÏ¤Ï TRAMP ¤¬Æ°ºî¤·¤¿¸å¤Ç -Emacs ¤Ç½èÍý¤µ¤ì¤Þ¤¹¡£²¿¸Î¤³¤ÎÀè¹ÔÆþÎϤ¬Ä̾ï¤ÎµóÆ°¤«¤È»×¤¦¤Ç¤·¤ç¤¦¡£ -¤¢¤Ê¤¿¤ÏÀµ¤·¤¤¡¢¤·¤«¤·¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤ò³«¤¯¤Ë¤Ï¤·¤Ð¤é¤¯¤Î»þ´Ö¤¬¤«¤«¤ê¡¢ -Àܳ¤¬³«¤«¤ì¤ë¤Þ¤Ç¤Ë30É䫤«¤ë¤«¤â¤·¤ì¤Ê¤¤¤È¤¤¤¦¤³¤È¤Ëµ¤ÉÕ¤¤¤Æ²¼¤µ¤¤¡£ -¤ª¤½¤é¤¯30Éøå¤Ë¤Ï¤½¤Î¥­¡¼¤òᤤ¤¿¤³¤È¤ò¤¹¤Ç¤Ë˺¤ì¤Æ¤¤¤ë¤Ç¤·¤ç¤¦! - -* Menu: - -* Filename Syntax:: TRAMP ¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê -* Multi-hop filename syntax:: ¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê -* Filename completion:: ¥Õ¥¡¥¤¥ë̾Êä´° -* Dired:: Dired - - -File: tramp_ja.info, Node: Filename Syntax, Next: Multi-hop filename syntax, Up: Usage - -5.1 TRAMP ¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê -============================ - -¥ê¥â¡¼¥È¥Þ¥·¥ó MACHINE ¾å¤Î¥Õ¥¡¥¤¥ë LOCALNAME ¤Ë¥¢¥¯¥»¥¹¤¹ -¤ë¤¿¤á¤Ë¤Ï¡¢¥Õ¥¡¥¤¥ë̾ `/[MACHINE]LOCALNAME'. -¤ò»ØÄꤷ¤Æ¤¯¤À¤µ¤¤¡£¤³¤ì¤Ç¡¢ MACHINE ¤ËÀܳ¤·¡¢¥Ç¥Õ¥©¥ë¥È¥á¥½¥Ã¥É -¤ò»ÈÍѤ·¤Æ¥Õ¥¡¥¤¥ë¤¬Å¾Á÷¤µ¤ì¤Þ¤¹¡£*Note Default Method::. - - TRAMP ¤Î¥Õ¥¡¥¤¥ë̾¤ÎÎã¤ò°Ê²¼¤Ëµó¤²¤Þ¤¹¡£ - -`/[melancholia].emacs' - ¥Þ¥·¥ó `melancholia' ¾å¤Î¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤Ë¤¢¤ë `.emacs'¤ò - ÊÔ½¸¤·¤Þ¤¹¡£ - -`/[melancholia.danann.net].emacs' - ´°Á´¤Ê¥Û¥¹¥È̾(FQDN)¤ò»È¤¤¡¢¾å¤ÈƱ¤¸¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤·¤Þ¤¹¡£ - -`/[melancholia]~/.emacs' - ¤³¤ì¤â¤Þ¤¿Æ±¤¸¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤·¤Þ¤¹¡£`~' ¤Ï¡¢¥í¡¼¥«¥ë¤Î¾ì¹ç¤È - ƱÍͤˡ¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤ËŸ³«¤µ¤ì¤Þ¤¹¡£ - -`/[melancholia]~daniel/.emacs' - ¥Þ¥·¥ó `melancholia' ¾å¤Î¥æ¡¼¥¶¡¼ `daniel' ¤Î¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê - ¤Ë¤¢¤ë¥Õ¥¡¥¤¥ë `.emacs' ¤òÊÔ½¸¤·¤Þ¤¹¡£`~<¥æ¡¼¥¶¡¼>' ¹½Ê¸¤Ï - ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥æ¡¼¥¶¡¼¤Î¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤ËŸ³«¤µ¤ì¤Þ¤¹¡£ - -`/[melancholia]/etc/squid.conf' - ¥Þ¥·¥ó `melancholia' ¾å¤Î¥Õ¥¡¥¤¥ë `/etc/squid.conf' ¤òÊÔ½¸ ¤·¤Þ¤¹¡£ - - - °ã¤¦Ì¾Á°¤ò»È¤¦¤è¤¦¤Ë»ØÄꤷ¤Ê¤¤¸Â¤ê¡¢TRAMP ¤Ï¸½ºß¤Î¥í¡¼¥«¥ë¤Ê¥æ¡¼¥¶Ì¾ -¤ò¥í¥°¥¤¥ó¤Î¤¿¤á¤Î¥ê¥â¡¼¥È¥æ¡¼¥¶¡¼Ì¾¤È¤·¤Æ»È¤¤¤Þ¤¹¡£¤â¤·¡¢°ã¤¦¥æ¡¼¥¶¡¼¤Ç -¥í¥°¥¤¥ó¤¹¤ëɬÍפ¬¤¢¤ë¾ì¹ç¤Ï¡¢¥Õ¥¡¥¤¥ë̾¤Î°ìÉô¤È¤·¤Æ¥æ¡¼¥¶¡¼Ì¾¤ò»ØÄꤹ¤ë -¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - »ØÄꤷ¤¿¥æ¡¼¥¶¡¼¤Ç¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë¥í¥°¥¤¥ó¤¹¤ëɬÍפ¬¤¢¤ë¾ì¹ç¡¢ -`/[USER@MACHINE]/PATH/TO.FILE' -¤È¤¤¤¦¥·¥ó¥¿¥Ã¥¯¥¹¤ò»ÈÍѤ·¤Æ¤¯¤À¤µ¤¤¡£¤Ä¤Þ¤ê¡¢ `melancholia' ¤Ë¥æ¡¼¥¶¡¼ -`daniel' ¤È¤·¤ÆÀܳ¤·¤Æ¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤Î `.emacs' ¤òÊÔ½¸ -¤¹¤ë¾ì¹ç¡¢`/[daniel@melancholia].emacs' ¤ò»ØÄꤹ¤ì¤Ð¤è¤¤¤Î¤Ç¤¹¡£ - - ¥Õ¥¡¥¤¥ë̾¤Î°ìÉô¤È¤·¤Æ¡¢Â¾¤Î¥Õ¥¡¥¤¥ëžÁ÷¥á¥½¥Ã¥É(*note Default -Method::) ¤ò»ØÄꤹ¤ë¤³¤È¤â¤Ç¤­¤Þ¤¹¡£ ¤½¤¦¤¹¤ë¤Ë¤ÏºÇ½é¤Î `/[' ¤ò -`/[/' ¤ÇÃÖ¤­´¹¤¨¤Þ¤¹¡£(ËöÈø¤Î¥¹¥é¥Ã¥·¥å¤ËÃí°Õ!) -¥æ¡¼¥¶¡¼¡¢¥Þ¥·¥ó¡¢¥Õ¥¡¥¤¥ë¤Î»ØÄê¤Ïº£¤Þ¤Ç¤ÈƱ¤¸¤Ç¤¹¡£ - - ¥Þ¥·¥ó `melancholia' ¤Ë `daniel' ¤È¤·¤ÆÀܳ¤·¡¢¥Õ¥¡¥¤¥ëžÁ÷¤Ë `ssh' -¥á¥½¥Ã¥É¤ò»È¤¤¡¢¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤Î `.emacs' ¤òÊÔ½¸¤¹¤ë -¤¿¤á¤Ë¤Ï¡¢¥Õ¥¡¥¤¥ë̾ `/[ssh/daniel@melancholia].emacs' ¤ò»ØÄꤷ¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Multi-hop filename syntax, Next: Filename completion, Prev: Filename Syntax, Up: Usage - -5.2 ¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê -================================== - -¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤Ï¡¢ÅöÁ³¤Î¤³¤È¤Ê¤¬¤é¡¢Â¾¤Î TRAMP -¤Î¥Õ¥¡¥¤¥ë̾¤È¼ã´³°Û¤Ê¤ê¤Þ¤¹¡£°Ê²¼¤Ë¡¢¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤ÎÎã¤ò -¤¢¤²¤Þ¤¹¡£ºÇ½é¤¬ Emacs ¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤Ç¼¡¤¬ XEmacs ¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤Ë¤è -¤ë¤â¤Î¤Ç¤¹: - - /[multi/rsh:out@gate/telnet:kai@real.host]/path/to.file - - ¤³¤ì¤ÏÈó¾ï¤Ë½ÅÍפʤΤǡ¢¤Ò¤È¤Ä¤Ò¤È¤ÄÀâÌÀ¤·¤Þ¤·¤ç¤¦¡£¥Õ¥¡¥¤¥ë̾¤Ï -3¤Ä¤ÎÉôʬ¤«¤éÀ®¤ê¡¢ ³ÆÉô¤Ï¥¹¥é¥Ã¥·¥å¤È³Ñ³ç¸Ì¤Ç¶èÀÚ¤é¤ì¤Þ¤¹¡£ -ºÇ½é¤Î¥Ñ¡¼¥È `/[multi' ¤Ï¥á¥½¥Ã¥É¤Î»ØÄê¤Ç¤¹¡£ ÆóÈÖÌܤΥѡ¼¥È¤Ï -`rsh:out@gate/telnet:kai@real.host' -¤Ç¥Û¥Ã¥×¤ò»ØÄꤷ¤Þ¤¹¡£ºÇ¸å¤Î¥Ñ¡¼¥È¤Ï `/path/to.file' ¤Ç¡¢¥ê¥â¡¼¥È -¥Û¥¹¥È¾å¤Î¥Õ¥¡¥¤¥ë̾¤ò»ØÄꤷ¤Þ¤¹¡£ - - ºÇ½é¤ÈºÇ¸å¤Î¥Ñ¡¼¥È¤ÏÌÀÇò¤Ç¤·¤ç¤¦¡£*Note Multi-hop Methods::¤Ë»ØÄê²Äǽ -¤Ê¥á¥½¥Ã¥É¤Î°ìÍ÷¤¬¤¢¤ê¤Þ¤¹¡£ - - ÆóÈÖÌܤΥѡ¼¥È¤Ï¡¢ºÆ¤Ó¥³¥ó¥Ý¡¼¥Í¥ó¥È¤Ë¡¢¤Ä¤Þ¤ê¥Û¥Ã¥×¤¿¤Á(hops) ¤Ëʬ³ä -¤µ¤ì¤ë¤³¤È¤¬¤¢¤ê¤Þ¤¹¡£¾åµ­¤Î¥Õ¥¡¥¤¥ë̾¤Ë¤Ï¡¢Æó¤Ä¤Î¥Û¥Ã¥×¤¿¤Á¡¢ -`rsh:out@gate' ¤ª¤è¤Ó `telnet:kai@real.host' ¤¬´Þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£ - - ¤½¤ì¤¾¤ì¤Î¥Û¥Ã¥×¤Ï¡¢_ºÆ¤Ó_(3¤Ä¤Î)¥³¥ó¥Ý¡¼¥Í¥ó¥È¡¢ -"¥Û¥Ã¥×¥á¥½¥Ã¥É"¡¢"¥æ¡¼¥¶¡¼Ì¾"¡¢"¥Û¥¹¥È̾"¤Ëʬ³ä¤µ¤ì¤ë¤³¤È¤¬ -¤¢¤ê¤Þ¤Þ¤¹¡£ÆóÈÖÌÜ¡¢»°ÈÖÌܤΥ³¥ó¥Ý¡¼¥Í¥ó¥È¤Î°ÕÌ£¤ÏÌÀÇò¤Ç¤¹¡£¥Û¥Ã¥×¥á¥½¥Ã¥É¤Ï¡¢ -¤³¤Î¥Û¥Ã¥×¤Ç¤É¤Î¤è¤¦¤Ê¥×¥í¥°¥é¥à¤ò»È¤¦¤«¤ò°ÕÌ£¤·¤Æ¤¤¤Þ¤¹¡£ - - ºÇ½é¤Î¥Û¥Ã¥× `rsh:out@gate' ¤Ï¡¢ ¥Û¥¹¥È `gate' ¤Ë¥æ¡¼¥¶¡¼ `out' -¤È¤·¤Æ¥í¥°¥¤¥ó¤¹¤ë¤¿¤á¤Ë `rsh' ¤ò»È¤¦¤È¤¤¤¦°ÕÌ£¤Ç¤¹¡£ÆóÈÖÌÜ¤Î¥Û¥Ã¥× -`telnet:kai@real.host'`telnet:kai@real.host' ¤Ï¡¢¤³¤Î¥Û¥¹¥È¤«¤é¥Û¥¹¥È -`real.host' ¤Ë¥æ¡¼¥¶¡¼ `kai'¤Ç¥í¥° ¥¤¥ó¤¹¤ë¤¿¤á¤Ë `telnet' -¤ò»È¤¦¤È¤¤¤¦°ÕÌ£¤Ç¤¹¡£ - - *Note Multi-hop Methods::. ¤³¤³¤Ë¥Û¥Ã¥×¥á¥½¥Ã¥É¤Î°ìÍ÷¤¬¤¢¤ê¤Þ¤¹¡£ -ÊÑ¿ô `tramp-multi-connection-function-alist' ¤Ë¤Ï¡¢ÁªÂò²Äǽ¤Ê¥Û¥Ã¥× -¥á¥½¥Ã¥É¤Î¥ê¥¹¥È¤È¤½¤ì¤é¤ò¤É¤Î¤è¤¦¤Ë¼Â¹Ô¤¹¤ë¤«¤È¤¤¤¦¾ðÊ󤬴ޤޤì¤Æ¤¤¤Þ¤¹¡£ -¤¢¤Ê¤¿¤¬ºî¤Ã¤¿¥á¥½¥Ã¥É¤ò¤³¤ÎÊÑ¿ô¤ËÄɲ䷤Ƥ¯¤À¤µ¤¤¡£ - - -File: tramp_ja.info, Node: Filename completion, Next: Dired, Prev: Multi-hop filename syntax, Up: Usage - -5.3 ¥Õ¥¡¥¤¥ë̾Êä´° -================== - -TRAMP ¤Î¥Õ¥¡¥¤¥ë̾Êä´°¤Ï¥ê¥â¡¼¥È¥Þ¥·¥ó¤Î¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤Ë²Ã¤¨¤Æ -¥á¥½¥Ã¥É¡¢¥æ¡¼¥¶Ì¾¤ª¤è¤Ó¥Þ¥·¥ó̾(¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É¤¿¤Á¤Ï½ü¤¯)¤Ë -ÂФ·¤ÆƯ¤­¤Þ¤¹¡£ - - Î㤨¤Ð `C-x C-f /[t' ¤ÈÆþÎϤ¹¤ë¤È TRAMP -¤Ï°Ê²¼¤ÎÁªÂò»è¤òÊÖ¤·¤Þ¤¹¡£ - - [telnet/ [toto] - - `[telnet/' ¤Ï¥á¥½¥Ã¥É¤ÎÊä´°¤Ç¤¢¤ê¡¢ `[toto]' ¤Ï TRAMP ¤¬¥Õ¥¡¥¤¥ë -`~/.ssh/known_hosts' ¤«¤é¸¡½Ð¤·¤¿¥Û¥¹¥È̾ ¤Ç¤¹(¥Ç¥Õ¥©¥ë¥È¥á¥½¥Ã¥É `ssh' -¤ò»È¤Ã¤Æ¤¤¤ë¾ì¹ç)¡£ - - ³¤±¤Æ `e ' ¤È¤¹¤ì¤Ð¡¢¥ß¥Ë¥Ð¥Ã¥Õ¥¡¤Ï `/[telnet/' -¤ÈÊä´°¤µ¤ì¤Þ¤¹¡£¼¡¤Î `' ¤Ç¤Ï TRAMP ¤¬¥Õ¥¡¥¤¥ë `/etc/hosts' -¤«¤é¸¡½Ð¤·¤¿Á´¤Æ¤Î¥Þ¥·¥ó̾¤òµó¤²¤Þ¤¹¡£Î㤨¤Ð¡¢ - - [telnet/127.0.0.1] [telnet/192.168.0.1] - [telnet/localhost] [telnet/melancholia.danann.net] - [telnet/melancholia] - -¤³¤³¤Ç´õ˾¤Î¥Þ¥·¥ó¤òÁªÂò¤¹¤ë¤³¤È¤¬¤Ç¤­¡¢Â³¤±¤Æ¤½¤Î¥Þ¥·¥ó¾å¤Î¥Õ¥¡¥¤¥ë̾ -¤òÊä´°¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - - ¥Õ¥¡¥¤¥ë̾Êä´°¤Ï¥ê¥â¡¼¥È¥Þ¥·¥ó¤«¤é¥Õ¥¡¥¤¥ë¥ê¥¹¥È¤ò¼è¤ê´ó¤»¤ëɬÍפ¬ -¤¢¤ë¤¿¤á¤Ë¡¢¤·¤Ð¤·¤Ð¤È¤Æ¤âÃÙ¤¯¤Ê¤ê¤Þ¤¹¡£º£¤Î½ê TRAMP ¤Ï¥Ç¥£¥ì¥¯¥È¥ê -¥ê¥¹¥È¤ò¥­¥ã¥Ã¥·¥å¤·¤Ê¤¤¤Î¤ÇÆó²óÌܤΥե¡¥¤¥ë̾Êä´°¤Ç¤â¥Ñ¥Õ¥©¡¼¥Þ¥ó¥¹ -¾å¤Î°ã¤¤¤Ï¸½¤ì¤Þ¤»¤ó¡£ - - TRAMP ¤¬Êä´°¤Î²òÀϤËÍѤ¤¤ëÀßÄê¥Õ¥¡¥¤¥ë (*note Customizing -Completion::) ¤¬¥æ¡¼¥¶Ì¾¤òÄ󶡤·¤¿¾ì¹ç¡¢¤½¤ì¤é¤Î¥æ¡¼¥¶Ì¾¤â¹Í褵¤ì¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Dired, Prev: Filename completion, Up: Usage - -5.4 Dired -========= - -TRAMP ¤Ï dired ¾å¤Ç¤âÆ©²áŪ¤ËÆ°ºî¤·¤Þ¤¹¡£¤³¤Î¶¯ÎϤʥե¡¥¤¥ë´ÉÍý -¥Ä¡¼¥ë¤ò»È¤¤¡¢¥¤¥ó¥¿¡¼¥Í¥Ã¥È¤ò·Ðͳ¤·¥¢¥¯¥»¥¹²Äǽ¤Ê¤¹¤Ù¤Æ¤Î¥Þ¥·¥ó¾å¤Î -¥Õ¥¡¥¤¥ë¤ò´ÉÍý¤Ç¤­¤Þ¤¹¡£ - - ¥Ç¥£¥ì¥¯¥È¥ê¥Ä¥ê¡¼¤ò¥Ö¥é¥¦¥º¤·¤¿¤¤¾ì¹ç¤Ï¡¢º£¤Î¤È¤³¤í¥Õ¥¡¥¤¥ë̾¤ÎÊä´° -¤è¤ê dired ¤ò»È¤¦¤Û¤¦¤¬Îɤ¤¤Ç¤·¤ç¤¦¡£dired ¤Ï¼«¿È¤Ç¥­¥ã¥Ã¥·¥å¤Î»ÅÁÈ¤ß -¤ò¤â¤Ã¤Æ¤¤¤ë¤Î¤Ç¡¢¥Õ¥¡¥¤¥ë°ìÍ÷¤ò°ìÅÙ¤·¤«¼èÆÀ¤·¤Þ¤»¤ó¡£ - - -File: tramp_ja.info, Node: Bug Reports, Next: Frequently Asked Questions, Prev: Usage, Up: Top - -6 ¥Ð¥°¤äÌäÂê¤ÎÊó¹ð -****************** - -TRAMP ¤Î¥Ð¥°¤äÌäÂê¤Ï¡¢³«È¯¥Á¡¼¥à¤Ë¤è¤Ã¤Æ¥¢¥¯¥Æ¥£¥Ö¤Ë²ò·è¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ -»ÅÍͤ˴ؤ¹¤ë¥ê¥¯¥¨¥¹¥È¤äÄó°Æ¤â´¿·Þ¤·¤Þ¤¹¡£ - - TRAMP ¥á¡¼¥ê¥ó¥°¥ê¥¹¥È¤Ï¡¢TRAMP ¤Î¾ðÊó¤òÆþ¼ê¤·¤¿¤ê¡¢ÌäÂê¤Î²ò·è¤ä¡¢ -°ìÈÌŪ¤ÊµÄÏÀ¡¢¤½¤·¤Æ¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ë´Ø·¸¤¹¤ëÏÃÂê¤Ø¤Î¥¢¥É¥Ð¥¤¥¹¤ËºÇŬ -¤Î¾ì½ê¤Ç¤¹¡£ - - ¥á¡¼¥ê¥ó¥°¥ê¥¹¥È¤Ï ¤Ç¤¹¡£ -¤³¤Î¥¢¥É¥ì¥¹¤Ë¥á¥Ã¥»¡¼¥¸¤ò¤òÁ÷¤ë¤È¤¹¤Ù¤Æ¤Î¹ÖÆɼԤËÆϤ­¤Þ¤¹¡£ -¤³¤ì¤Ï¹ÖÆɤΥꥯ¥¨¥¹¥È¤òÁ÷¿®¤¹¤ë¤¿¤á¤Î¥¢¥É¥ì¥¹¤Ç¤Ï _¤¢¤ê¤Þ¤»¤ó_¡£ - - ¥á¡¼¥ê¥ó¥°¥ê¥¹¥È¤ò¹ÖÆɤ¹¤ë¤¿¤á¤Î¥Ø¥ë¥×¤òÆþ¼ê¤¹¤ë¤Ë¤Ï¡¢¥µ¥Ö¥¸¥§¥¯¥È¤Ë -`help' ¤È½ñ¤¤¤¿¥á¡¼¥ë¤ò´ÉÍýÍѤΥ¢¥É¥ì¥¹ - ¤ËÁ÷¿®¤·¤Æ¤¯¤À¤µ¤¤¡£ - - TRAMP ¤Î¥Ð¥°Êó¹ð¤ò¤¹¤ë¾ì¹ç¤Ë¤Ï¡¢`M-x tramp-bug' ¤ò¼Â¹Ô¤·¤Æ¤¯¤À¤µ¤¤¡£ -¤³¤ì¤Ï¡¢¤¢¤Ê¤¿¤Î¥·¥¹¥Æ¥à¤Î¾ÜºÙ¤ä TRAMP ¤Î¥Ð¡¼¥¸¥ç¥ó¾ðÊó¤ò´Þ¤à¥Ð¥Ã¥Õ¥¡ -¤ò¼«Æ°Åª¤ËÀ¸À®¤·¤Þ¤¹¡£ - - ¥Ð¥°Êó¹ð¤òÄó½Ð¤¹¤ë»þ¤Ë¤Ï¡¢ÌäÂê¤òºÆ¸½¤¹¤ë¼ê½ç¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¤ÎÀßÄê¡¢ -¤â¤·Â¸ºß¤¹¤ë¤Î¤Ç¤¢¤ì¤ÐÆüì¤Ê¾ò·ï¤ò¡¢¤·¤Ä¤³¤¤¤°¤é¤¤¾ÜºÙ¤Ëµ­½Ò¤·¤Æ¤¯ -¤À¤µ¤¤¡£¤â¤·²Äǽ¤Ê¤é¡¢´Êñ¤ÊºÆ¸½¼ê½ç¤âµ­½Ò¤·¤Æ¤¯¤À¤µ¤¤¡£ - - ¤â¤·¡¢ÌäÂê¤òºÆ¸½¤¹¤ë¤¿¤á¤Î´Êñ¤Ê¥Æ¥¹¥È¥±¡¼¥¹¤¬¤ï¤«¤ì¤Ð¡¢¤½¤ì¤ò¥Ð¥° -Êó¹ð¤Ë´Þ¤á¤Æ¤¯¤À¤µ¤¤¡£¤³¤ì¤Ë¤è¤ê¡¢³«È¯¥Á¡¼¥à¤¬¥Ð¥°¤òÆͤ­»ß¤á¡¢½¤Àµ -¤¹¤ë¤Î¤¬Íưפˤʤê¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Frequently Asked Questions, Next: Concept Index, Prev: Bug Reports, Up: Top - -7 ¤è¤¯¤¢¤ë¼ÁÌä¤È¤½¤ÎÅú -********************** - - * ºÇ¿·¤Î TRAMP ¤Ï¤É¤³¤«¤éÆþ¼ê¤Ç¤­¤Þ¤¹¤«? - - TRAMP ¤Ï°Ê²¼¤Î URL ¤ÇÆþ¼ê²Äǽ¤Ç¤¹ - - `http://savannah.nongnu.org/download/tramp/' - - ¤Þ¤¿ Savannah ¤Î¥×¥í¥¸¥§¥¯¥È¥Ú¡¼¥¸¤â¤¢¤ê¤Þ¤¹¡£ - - `https://savannah.gnu.org/projects/tramp/' - - * ¤É¤Î¤è¤¦¤Ê¥·¥¹¥Æ¥à¾å¤ÇÆ°ºî¤·¤Þ¤¹¤«? - - ¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ï¡¢Emacs 20 ¤È Emacs 21 ¾å¤ÇÆ°ºî¤·¤Þ¤¹¡£XEmacs 20 - ¾å¤Ç¤Ï ÌäÂ꤬¤¢¤ê¤Þ¤¹¡£`tramp.el' - ¤Î¥³¥á¥ó¥È¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£Emacs 19 - ¤Ç»î¤·¤¿¿Í¤¬¤¤¤ë¤Î¤«¤É¤¦¤«¤ÏÃΤê¤Þ¤»¤ó¡£ - - ¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ï Unix - ¾å¤ÇÆ°ºî¤¹¤ë¤è¤¦¤ËÀ߷פµ¤ì¤Æ¤¤¤Þ¤¹¡£¤½¤·¤Æ¥ê¥â¡¼¥È ¦¤â Unix - É÷¤Î¥·¥¹¥Æ¥à¤Ç¤¢¤ë¤³¤È¤ò´üÂÔ¤·¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢NT Emacs ¾å¤Ç - Æ°ºî¤µ¤»¤ë¤³¤È¤ËÀ®¸ù¤·¤¿¿Í¤¬²¿¿Í¤«¤¤¤ë¤è¤¦¤Ç¤¹¡£ - - °Ê²¼¤Î URL ¤Ë¤Ï¡¢Tramp ¤ò NT ¤Ç»È¤¦¤¿¤á¤Î¾ðÊ󤬤¢¤ê¤Þ¤¹; Joe Stoy - ¤Ë¤Ï¾ðÊó¤ÎÄ󶡤ËÂФ·¤Æ¿¼¤¯´¶¼Õ¤·¤Þ¤¹: - `ftp://ftp.comlab.ox.ac.uk/tmp/Joe.Stoy/' - - ¾åµ­¤Ï¤â¤Ã¤Ñ¤é¸Å¤¤¥Ð¡¼¥¸¥ç¥ó¤Î ssh ¤Ø¤Î¥Ñ¥Ã¥Á¤¬¤ª¤¤¤Æ¤¢¤ê¤Þ¤¹; Tom - Roche ¤Î Web page ¤Ë¤âÀâÌÀ¤¬¤¢¤ê¤Þ¤¹: - `http://www4.ncsu.edu/~tlroche/plinkTramp.html' - - ??? XEmacs ¤Î¾ðÊó¤ÏÀµ¤·¤¤¤Î¤Ç¤·¤ç¤¦¤«? - - ??? 狼¡¢NT Emacs - ¾å¤ÇÆ°¤«¤¹¤¿¤á¤Î¾ðÊó¤ò¶µ¤¨¤Æ¤¯¤À¤µ¤¤¡£¤¿¤Ö¤ó¡¢`ssh' - ´Ø·¸¤ÎÌäÂ꤬¤¢¤ë¤Î¤Ç¤Ï¤Ê¤¤¤«¤È»×¤¤¤Þ¤¹¡£ - - * XEmacs ¤Ç EFS ¤¬µ¯Æ°¤µ¤ì¤Æ¤·¤Þ¤¤¤Þ¤¹ - - ¤¹¤Ù¤Æ¤Î¸Å¤¤¥Ð¡¼¥¸¥ç¥ó¤Î TRAMP ¤¬ XEmacs XEmacs - ¤òÀµ¤·¤¯¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤ë¤ï¤±¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£¤Þ¤ººÇ½é¤Ë¡¢ºÇ¿·¤Î - TRAMP ¤¬¥¤¥ó¥¹¥È¡¼¥ë¤µ¤ì¤Æ¤¤¤ë¤«¤É¤¦¤«¤ò³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£ - - ¤â¤·ºÇ¿·¤Î¥Ð¡¼¥¸¥ç¥ó¤Ê¤é¡¢ EFS ¥Ï¥ó¥É¥é¡¼¤¬¼Â¹Ô - ¤µ¤ì¤ë¤¿¤á¤Î¾ò·ï¤òÀµ³Î¤ËÄ´¤Ù¤Æ¤¯¤À¤µ¤¤¡£¤â¤·²Äǽ¤Ê¤é¡¢¥Ö¥ì¡¼¥¯¥Ý¥¤¥ó¥È - ¤ò `efs-ftp-path' ¤ËÀßÄꤷ¤Æ¡¢¥Ð¥°Êó¹ð¤È°ì½ï¤Ë¥¹¥¿¥Ã¥¯¥È¥ì¡¼¥¹¤ò - Á÷¤Ã¤Æ¤¯¤À¤µ¤¤¡£¤³¤ì¤é¤Î¾ðÊ󤬤¢¤ë¤È¡¢³«È¯¼Ô¤¬²¿¤¬´Ö°ã¤Ã¤Æ¤¤¤ë¤Î¤«¤òȯ - ¸«¤¹¤ë¤³¤È¤¬Íưפˤʤê¤Þ¤¹¡£ - - * TRAMP ¤ò»È¤¦¤È¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤¬¤Ç¤­¤Þ¤»¤ó - - ¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë¥í¥°¥¤¥ó¤·¤¿»þ¤Ë¡¢`ls' ¤Î½ÐÎϤ¬¿§ÉÕ¤­¤Ë¤Ê¤Ã¤Æ - ¤¤¤Þ¤»¤ó¤«? ¤â¤·¡¢¤½¤¦¤Ê¤é¡¢¤½¤ì¤¬¸¶°ø¤Ç¤¹¡£ - - `ls' ¤Ï¡¢Ã¼Ëö¥¨¥ß¥å¥ì¡¼¥¿¡¼¤¬¿§¤òÊѹ¹¤¹¤ë¤¿¤á¤Î ANSI - ¥¨¥¹¥±¡¼¥×¥·¡¼¥¯¥¨¥ó¥¹¤ò½ÐÎϤ·¤Þ¤¹¡£¤·¤«¤·¤Ê¤¬¤é¡¢¤³¤Î¥¨¥¹¥±¡¼¥× - ¥·¡¼¥¯¥¨¥ó¥¹¤Ï TRAMP ¤òº®Í𤵤»¤Þ¤¹¡£ - - ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î `.bashrc'¡¢`.profile' ¤¢¤ë¤¤¤ÏƱ¤¸¤è¤¦¤Ê - ÀßÄê¥Õ¥¡¥¤¥ë¤Ë¡¢`--color=yes' ¤Þ¤¿¤Ï `--color=auto' - ¤¬Äɲ䵤줿ÀßÄê¤Î alias ¤¬¤¢¤ë¤Ï¤º¤Ç¤¹¡£ - - ¤³¤Î alias ¤òºï½ü¤·¡¢¿·¤·¤¯¥í¥°¥¤¥ó¤·¤¿»þ¤Î `ls' ¤Î½ÐÎϤ¬ - ¿§ÉÕ¤­¤Çɽ¼¨¤µ¤ì _¤Ê¤¤_ ¤³¤È¤ò³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£¤â¤·¡¢¤³¤ì¤Ç¤â - ¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤¬Àµ¾ï¤ËÆ°ºî¤·¤Ê¤¤¾ì¹ç¤Ï¡¢TRAMP ³«È¯¼Ô¤Ë¥Ð¥°Êó¹ð - ¤ò¤·¤Æ¤¯¤À¤µ¤¤¡£ - - * µðÂç¤Ê¥Ç¥£¥ì¥¯¥È¥ê¤ÎÃæ¤Ç¤Ï¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤¬Æ°ºî¤·¤Þ¤»¤ó - - TRAMP ¤Ï¤¤¤¯¤Ä¤«¤Î¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤Ç globbing ¤ò»ÈÍѤ·¤Þ¤¹¡£(globbing - ¤È¤Ï¡¢`*.c' ¤Î¤è¤¦¤Ê¥ï¥¤¥ë¥É¥«¡¼¥ÉŸ³«¤Î¤¿¤á¤Ë¥·¥§¥ë¤ò»È¤¦¤³¤È¤Ç¤¹) - ¤³¤ì¤Ï¡¢¤¿¤¯¤µ¤ó¤Î¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤¹¤ë¥Ç¥£¥ì¥¯¥È¥ê¤Ç¤ÏŤ¤¥³¥Þ¥ó¥É¥é¥¤¥ó - ¤òºî¤ê¤Þ¤¹¡£¤¤¤¯¤Ä¤«¤Î¥·¥§¥ë¤Ç¤ÏŤ¤¥³¥Þ¥ó¥É¥é¥¤¥ó¤ò¤±¤º¤ê¤È¤Ã¤¿¤ê¡¢ - ¤¢¤ë¤¤¤Ï globbing ¼«¿È¤ò½èÍý¤Ç¤­¤Þ¤»¤ó¡£ - - ¥ê¥â¡¼¥È¥Û¥¹¥È¦¤ËµðÂç¤Ê¥Ç¥£¥ì¥¯¥È¥ê¤¬¤¢¤ë¾ì¹ç¤Ï¡¢ `ls -d * ..?* > - /dev/null' ¤Î¤è¤¦¤Ê¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤·¡¢¥Ï¥ó¥°¤¹¤ë¤« - ¤É¤¦¤«¤ò³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£Ãí°Õ¤¹¤ëɬÍפ¬¤¢¤ë¤Î¤Ï¡¢ºÇ½é¤ËÀµ¤·¤¤¥·¥§¥ë¡¢ - `/bin/sh'¡¢`ksh' ¤¢¤ë¤¤¤Ï `bash'¡¢¤Ä¤Þ¤ê tilde ¤Î - Ÿ³«¤ò¥µ¥Ý¡¼¥È¤¹¤ë¥·¥§¥ë¤«¤é»î¤¹¤Ù¤­¤À¤È¤¤¤¦»ö¤Ç¤¹¡£ - - * TRAMP ¤Ï¤É¤Î¤è¤¦¤Ê¼ïÎà¤Î¥·¥¹¥Æ¥à¤ÇÆ°ºî¤·¤Þ¤¹¤« - - TRAMP ¤Ï¡¢¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤¬ Unix É÷¤Î¥·¥¹¥Æ¥à¤Ç¤¢¤ë»ö¤òÁ°Äó¤Ë¤·¤Æ - ¤¤¤Þ¤¹¡£¤Þ¤¿¡¢¥í¡¼¥«¥ë¥·¥¹¥Æ¥à¤â Unix - É÷¤Î¥·¥¹¥Æ¥à¤Î¤Û¤¦¤¬Ë¾¤Þ¤·¤¤¤Ç - ¤·¤ç¤¦¡£¤·¤«¤·¡¢¤¹¤³¤·½¤Àµ¤¹¤ì¤Ð¡¢TRAMP ¤Ï NT - ¾å¤Ç¤âÆ°ºî¤¹¤ë¤Ï¤º¤Ç¤¹¡£ - - * TRAMP - ¤Î¥Õ¥¡¥¤¥ëžÁ÷¤¬´°Î»¤·¤¿»þ¤ËÄÌÃΤµ¤»¤ë¤Ë¤Ï¤É¤¦¤¹¤ì¤Ð¤¤¤¤¤Ç¤·¤ç¤¦¤«? - - °Ê²¼¤Î¥³¡¼¥É¤ò¡¢`~/.emacs' ¤ËÄɲ䷤Ƥ¯¤À¤µ¤¤¡£¤³¤ì¤Ç¡¢¥ê¥â¡¼¥È - ¥Û¥¹¥È¤ËÂФ¹¤ëÆɤ߽ñ¤­¤Î¸å¤Ë¡¢Emacs ¤¬ beep ²»¤ò¤Ê¤é¤·¤Æ¤¯¤ì¤Þ¤¹¡£ - - (defadvice tramp-handle-write-region - (after tramp-write-beep-advice activate) - " make tramp beep after writing a file." - (interactive) - (beep)) - (defadvice tramp-handle-do-copy-or-rename-file - (after tramp-copy-beep-advice activate) - " make tramp beep after copying a file." - (interactive) - (beep)) - (defadvice tramp-handle-insert-file-contents - (after tramp-copy-beep-advice activate) - " make tramp beep after copying a file." - " make tramp beep after copying a file." - (interactive) - (beep)) - - * ¥ê¥â¡¼¥È¥Û¥¹¥È¤Î `~/.sh_history' ¤È¤¤¤¦¥Õ¥¡¥¤¥ë¤¬ÈîÂ礷³¤±¤Æ¤¤¤Þ - ¤¹¡£¤³¤ì¤Ï²¿¤Ç¤¹¤«? - - TRAMP ¤Ï¥Æ¥£¥ë¥ÀŸ³«¤Î°Ù¤Ë¡¢¤·¤Ð¤·¤Ð¥ê¥â¡¼¥È¥Û¥¹¥È¤Ç `ksh' ¤ò - µ¯Æ°¤·¤Þ¤¹¡£¤¿¤Ö¤ó `ksh' ¤Ï¥Ç¥Õ¥©¥ë¥È¤ÇÍúÎò¤òÊݸ¤·¤Þ¤¹¡£TRAMP - ¤ÏÍúÎò¤ÎÊݸ¤òÄä»ß¤·¤è¤¦¤È»î¤ß¤Þ¤¹¤¬¡¢¤¢¤Ê¤¿¤¬¼ê½õ¤±¤ò¤¹¤ëɬÍפ¬¤¢¤ë - ¤«¤â¤·¤ì¤Þ¤»¤ó¡£Î㤨¤Ð¡¢¤¢¤Ê¤¿¤Î `.kshrc' ¤Ë¤³¤ì¤òÆþ¤ì¤Æ¤¯¤À¤µ¤¤: - - if [ -f $HOME/.sh_history ] ; then - /bin/rm $HOME/.sh_history - fi - if [ "${HISTFILE-unset}" != "unset" ] ; then - unset HISTFILE - fi - if [ "${HISTSIZE-unset}" != "unset" ] ; then - unset HISTSIZE - fi - - * TRAMP ¤¬ 500 ʸ»ú¤ò±Û¤¨¤ëʸ»úÎó¤òÀµ¤·¤¯Å¾Á÷¤·¤Þ¤»¤ó¡£ - - ¤¤¤¯¤Ä¤«¤Îµ©¤Ê¥·¥¹¥Æ¥à¤Ç¤Ï¡¢`process-send-string' ¤Î¼ÂÁõ¤¬ - Ť¤Ê¸»úÎó¤ËÂФ·¤Æ²õ¤ì¤Æ¤¤¤Þ¤¹¡£¤³¤Î¾ì¹ç¡¢ÊÑ¿ô `tramp-chunksize' - ¤ò 500 ¤Ë¥«¥¹¥¿¥Þ¥¤¥º¤·¤Þ¤¹¡£¤³¤ì¤¬É¬Íפ«¤É¤¦¤«¤ò¤É¤¦¤ä¤Ã¤ÆÃΤ뤫¤Ï - `tramp-chunksize' ¤ÎÀâÌÀ¤ò¸«¤Æ²¼¤µ¤¤¡£ - - - -File: tramp_ja.info, Node: Version Control, Next: Files directories and localnames, Prev: Concept Index, Up: Top - -8 ¥ê¥â¡¼¥È¥Ð¡¼¥¸¥ç¥ó¥³¥ó¥È¥í¡¼¥ë¤ÎÆâÉôÆ°ºî -****************************************** - -EFS ¤È°Û¤Ê¤ê¡¢TRAMP ¤Ï¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥·¥§¥ë¤ò¼Â¹Ô -¤·¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢TRAMP ¤ò»È¤¤¥¢¥¯¥»¥¹¤·¤¿¥Õ¥¡¥¤¥ë¤Î¥Ð¡¼¥¸¥ç¥ó -´ÉÍý¤ò¤ª¤³¤Ê¤¦»ö¤¬¤Ç¤­¤Þ¤¹¡£ - -¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤ò¤ª¤³¤Ê¤¦¥Ð¥¤¥Ê¥ê¤¬¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë¥¤¥ó¥¹¥È¡¼¥ë¤µ¤ì¤Æ -¤¤¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£¤½¤·¤Æ¡¢TRAMP-REMOTE-PATH ¤Ç»ØÄꤵ¤ì¤¿ -¥Ç¥£¥ì¥¯¥È¥ê¤ËÃÖ¤«¤ì¤Æ¡¢¥¢¥¯¥»¥¹²Äǽ¤Ç¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£ - - ¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤ÎÆ©²áŪ¤ÊÅý¹ç¤Ï¡¢TRAMP ¤Î¤â¤Ã¤È¤â²ÁÃͤΤ¢¤ë -µ¡Ç½¤Î¤Ò¤È¤Ä¤Ç¤¹¡£¤·¤«¤·¡¢¤Þ¤À´°Á´¤Ë¤Ï¤Û¤É±ó¤¤¾õÂ֤Ǥ¹¡£¥·¥¹¥Æ¥à¤ÎÆ©²á -À­¤ò¸þ¾å¤µ¤»¤ë¤¿¤á¤Îºî¶È¤¬Â³¤±¤é¤ì¤Æ¤¤¤Þ¤¹¡£ - -* Menu: - -* Version Controlled Files:: ¥Õ¥¡¥¤¥ë¤¬¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤µ¤ì¤Æ¤¤¤ë¤«¤É¤¦¤«¤ÎȽÃÇ -* Remote Commands:: ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥³¥Þ¥ó¥É¤Î¼Â¹Ô -* Changed workfiles:: ºî¶È¥Õ¥¡¥¤¥ë¤ÎÊѹ¹¤Îȯ¸« -* Checking out files:: ºî¶È¥Õ¥¡¥¤¥ë¤Î¥ê¥Ý¥¸¥È¥ê¤«¤é¤Î¼èÆÀ -* Miscellaneous Version Control:: ¤½¤Î¾¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Ë´Ø·¸¤¹¤ë»ö - - -File: tramp_ja.info, Node: Version Controlled Files, Next: Remote Commands, Up: Version Control - -8.1 ¥Õ¥¡¥¤¥ë¤¬¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤µ¤ì¤Æ¤¤¤ë¤«¤É¤¦¤«¤ÎȽÃÇ -==================================================== - -VC ¥Ñ¥Ã¥±¡¼¥¸¤Ï¡¢¥Ç¥£¥¹¥¯¾å¤Î¥Þ¥¹¥¿¡¼¥Õ¥¡¥¤¥ë¤Î¸ºß¤ò¤â¤È¤Ë¡¢»ØÄꤵ¤ì¤¿ -¥Õ¥¡¥¤¥ë¤¬¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Î´ÉÍý²¼¤Ë¤¢¤ë¤«¤É¤¦¤«¤òȽÃǤ·¤Þ¤¹¡£ -¤³¤ì¤é¤Î¥Õ¥¡¥¤¥ë¤Î¥Æ¥¹¥È¤Ï¡¢É¸½àŪ¤Ê TRAMP ¤Î»ÅÁȤߤò»È¤¤¥ê¥â¡¼¥È -¥Þ¥·¥ó¾å¤Ç¼Â¹Ô¤µ¤ì¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Remote Commands, Next: Changed workfiles, Prev: Version Controlled Files, Up: Version Control - -8.2 ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥³¥Þ¥ó¥É¤Î¼Â¹Ô -================================================== - -¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Î¥³¥Þ¥ó¥É¤Î¼Â¹Ô¤ò²£¼è¤ê¤¹¤ë¤³¤È¤Î¤Ç¤­¤ë VC ÍѤΠ-hook ¤Ï¸ºß¤·¤Þ¤»¤ó¡£`call-process' ¤Î»ÅÁȤߤò»È¤¤¡¢ -´Ø¿ô¸Æ¤Ó½Ð¤·¤¬È¯À¸¤·¤Þ¤¹¡£´Ø¿ô¤Ï `shell-command' ¤è¤ê¡¢¼ã´³ -¸úΨŪ¤Ç¤¹¤¬¡¢¥ê¥â¡¼¥È¤Ç¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤¹¤ë¤¿¤á¤Î hook -¤ÏÍÑ°Õ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó¡£ - - ¤È¤ê¤¢¤¨¤ºÆ°ºî¤µ¤»¤ë¤¿¤á¤Ë¡¢´Ø¿ô `vc-do-command' ¤È -`vc-simple-command' ¤Ë¡¢TRAMP ¤ò·Ðͳ¤·¥¢¥¯¥»¥¹¤µ¤ì¤¿¥Õ¥¡¥¤¥ë¤Ø¤Î -¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤Î¤¿¤á¤Î¥ê¥¯¥¨¥¹¥È¤ò²£¼è¤¹¤ë¤³¤È¤¬ÄÌÃΤµ¤ì¤Þ¤¹¡£ - - ¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤Î¾ì¹ç¡¢¥í¡¼¥«¥ë¥Þ¥·¥ó¤ÈƱ¤¸µ¡Ç½¤òÄ󶡤¹¤ë¤¿¤á¤Ë¡¢ -`shell-command' ¥¤¥ó¥¿¡¼¥Õ¥§¡¼¥¹¤¬¡¢¤¤¤¯¤Ä¤«¤Î¥é¥Ã¥Ñ¡¼¥³¡¼¥É¤È -¶¦¤Ë»ÈÍѤµ¤ì¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Changed workfiles, Next: Checking out files, Prev: Remote Commands, Up: Version Control - -8.3 ºî¶È¥Õ¥¡¥¤¥ë¤ÎÊѹ¹¤Îȯ¸« -============================ - -º£¤Î¤È¤³¤í¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥Õ¥¡¥¤¥ë¤Î mtime ¤ò¼èÆÀ¤¹¤ë°Ü¿¢À­¤Î¹â¤¤ -ÊýË¡¤Ï¸ºß¤·¤Þ¤»¤ó¡£`vc-workfile-unchanged-p' ´Ø¿ô¤Ë¡¢¥ê¥â¡¼¥È -¥Õ¥¡¥¤¥ë¤Î¤¿¤á¤Ë TRAMP ¤Î´Ø¿ô¤Î¸Æ¤Ó½Ð¤·¤¬ÄÌÃΤµ¤ì¤Þ¤¹¡£ - - `tramp-vc-workfile-unchanged-p' ´Ø¿ô¤Ï¡¢ºî¶È¥Õ¥¡¥¤¥ë¤È¥Ð¡¼¥¸¥ç¥ó -´ÉÍý¥Þ¥¹¥¿¥Õ¥¡¥¤¥ë¤ÎÊѹ¹ÅÀ¤òÄ´¤Ù¤ë¤¿¤á¤Ë VC ¤Î diff µ¡Ç½¤ò»ÈÍѤ·¤Þ¤¹¡£ - - ¤³¤ì¤ò¼Â¸½¤¹¤ë¤¿¤á¤Ë¤Ï¡¢¥ê¥â¡¼¥È¤Ç¤Î¥·¥§¥ë¥³¥Þ¥ó¥É¤¬¼Â¹Ô²Äǽ¤Ç¤Ê¤ì¤Ð -¤Ê¤ê¤Þ¤»¤ó¡£¤³¤Î½èÍý¤Ï¡¢¥í¡¼¥«¥ë¥Õ¥¡¥¤¥ë¤Ç»È¤ï¤ì¤ë mtime ¤Î¼èÆÀ¤è¤ê -½Å¤¤½èÍý¤Ç¤¹¡£»ÄÇ°¤Ê¤¬¤é¡¢°Ü¿¢À­¤Î¹â¤¤²ò·èÊýË¡¤¬¸«¤Ä¤«¤ë¤Þ¤Ç¤Ï¡¢¥ê¥â¡¼¥È -¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤Î¥³¥¹¥È¤Ï¤³¤Î¤Þ¤Þ¤Ç¤·¤ç¤¦¡£ - - -File: tramp_ja.info, Node: Checking out files, Next: Miscellaneous Version Control, Prev: Changed workfiles, Up: Version Control - -8.4 ºî¶È¥Õ¥¡¥¤¥ë¤Î¥ê¥Ý¥¸¥È¥ê¤«¤é¤Î¼èÆÀ -====================================== - -¥Ç¥Õ¥©¥ë¥È¤Ç¤Ï¡¢VC -¤Ï¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤ò¥Á¥§¥Ã¥¯¤·¡¢¥ê¥Ý¥¸¥È¥ê¤«¤é¥Á¥§¥Ã¥¯ -¥¢¥¦¥È¤µ¤ì¤¿¥Õ¥¡¥¤¥ë¤¬¤¢¤ë¾ì¹ç¤Ï¡¢¥Á¥§¥Ã¥¯¥¢¥¦¥È¤ò¤ª¤³¤Ê¤¤¤Þ¤»¤ó¡£¤³¤ÎÌäÂê -¤ò²ò·è¤¹¤ë¤¿¤á¤Ë¡¢´Ø¿ô `vc-checkout' ¤Ï TRAMP ¥Õ¥¡¥¤¥ë¤ò¶èÊ̤·¡¢ -¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤ò¤ª¤³¤Ê¤¦¤³¤È¤ò²Äǽ¤Ë¤·¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Miscellaneous Version Control, Prev: Checking out files, Up: Version Control - -8.5 ¤½¤Î¾¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Ë´Ø·¸¤¹¤ë»ö -============================================ - -¤³¤Þ¤«¤Ê¼ÂÁõ¤Î¾ÜºÙ¡¢¤½¤Î¾¡£ - -* Menu: - -* Remote File Ownership:: VC ¤¬¥ï¡¼¥¯¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼¤òÄ´¤Ù¤ëÊýË¡ -* Back-end Versions:: VC ¤¬ RCS ¤Î¥Ð¡¼¥¸¥ç¥ó¤òÄ´¤Ù¤ëÊýË¡ - - -File: tramp_ja.info, Node: Remote File Ownership, Next: Back-end Versions, Up: Miscellaneous Version Control - -8.5.1 VC ¤¬¥ï¡¼¥¯¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼¤òÄ´¤Ù¤ëÊýË¡ ------------------------------------------------ - -Emacs ¤Ï¡¢Ç¤°Õ¤Î¥æ¡¼¥¶¡¼ ID ¤ÎÃÍ¤È¥í¥°¥¤¥ó̾¤ò¥Þ¥Ã¥Ô¥ó¥°¤¹¤ë¤Î¤ÈƱÍͤˡ¢ -¸½ºß¤Î¥æ¡¼¥¶¡¼¤Î¥í¥°¥¤¥ó̾¤ò¤«¤¨¤¹´Ø¿ô `user-full-name' ¤òÍÑ°Õ¤·¤Æ -¤¤¤Þ¤¹¡£VC ¤Ï¡¢¤¤¤¯¤Ä¤«¤Î¾õ¶·¤Ç¡¢¥ï¡¼¥¯¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼¤Î uid ¤«¤é¥í¥° -¥¤¥ó̾¤Ø¤Î¥Þ¥Ã¥×µ¡Ç½¤ò»ÈÍѤ·¤Þ¤¹¡£ - -¤³¤ì¤Ï¡¢¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤¬°Û¤Ê¤ë¥í¥°¥¤¥ó¥»¥Ã¥È¤ò»ý¤Ä¾ì¹ç¤Ë¤Ï¡¢¤¢¤­¤é¤« -¤ËÀµ¤·¤¯Æ°ºî¤·¤Þ¤»¤ó¡£¤·¤¿¤¬¤Ã¤Æ¡¢uid -¤ËÂбþ¤¹¤ë¥í¥°¥¤¥ó̾¤Î·èÄê¤ò¥ê¥â¡¼¥È -¥Þ¥·¥ó¤Ë¤ª¤³¤Ê¤ï¤»¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£ - - »ÄÇ°¤Ê¤¬¤é¡¢`NIS'¡¢`NIS+'¤½¤·¤Æ `NetInfo' ¤Î¤è¤¦¤Ê¡¢ -ʬ»¶´ÉÍý¥·¥¹¥Æ¥à ¤ò»È¤¦¾ì¹ç¡¢¥·¥ó¥×¥ë¤Ç¡¢¿®ÍêÀ­¤¬¤¢¤ê¡¢°Ü¿¢À­¤Î¹â¤¤ -¥Þ¥Ã¥Ô¥ó¥°¤ÎÊýË¡¤Ï¸ºß¤·¤Þ¤»¤ó¡£ - - ¤¢¤ê¤¬¤¿¤¤»ö¤Ë¡¢uid ¤«¤é¥í¥°¥¤¥ó̾¤Ø¤Î¥Þ¥Ã¥Ô¥ó¥°¤Ë°Í¸¤¹¤ë VC -¤Î¥³¡¼¥É¤Ï¡¢ ´Ø¿ô `vc-file-owner' -¤Ò¤È¤Ä¤À¤±¤Ç¤¹¡£¤³¤Î´Ø¿ô¤Ï¡¢¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼ -¤Î¥í¥°¥¤¥ó̾¤òʸ»úÎó¤È¤·¤ÆÊÖ¤·¤Þ¤¹¡£ - - ¥í¥°¥¤¥ó̾¤ò·èÄꤹ¤ë¤¿¤á¤Ë¡¢¤³¤Î´Ø¿ô¤Ë¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î `ls' -¤Î½ÐÎϤò»ÈÍѤ¹¤ë¤³¤È¤¬ÄÌÃΤµ¤ì¤Þ¤¹¡£uid ¤«¤é¥í¥°¥¤¥ó̾¤Î¥Þ¥Ã¥Ô¥ó¥°¤ò¡¢ -»ä¤è¤ê¤½¤ì¤é¤Ë¤Ä¤¤¤ÆÎɤ¯ÃΤäƤ¤¤ë¤Ï¤º¤Î¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤Ë°Ñ¾ù¤·¤Þ¤¹¡£ - - -File: tramp_ja.info, Node: Back-end Versions, Prev: Remote File Ownership, Up: Miscellaneous Version Control - -8.5.2 VC ¤¬ RCS ¤Î¥Ð¡¼¥¸¥ç¥ó¤òÄ´¤Ù¤ëÊýË¡ ----------------------------------------- - -VC ¤Ï¡¢¤É¤Î¥ê¥ê¡¼¥¹¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Î¥Ð¥¤¥Ê¥ê¤ò»È¤Ã¤Æ¤¤¤ë¤«¤ò -ÃΤëɬÍפ¬¤¢¤ê¤Þ¤¹¡£¤³¤ì¤Ï¡¢VC ¤¬¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤ë¤¹¤Ù¤Æ¤Îµ¡Ç½¤ò¡¢¸Å¤¤ -¥Ð¡¼¥¸¥ç¥ó¤Î`rcs(1)'¡¢`cvs(1)'¡¢`sccs(1)'¤¬Äó¶¡ -¤·¤Æ¤¤¤ë¤ï¤±¤Ç¤Ï̵¤¤¤«¤é¤Ç¤¹¡£ - - VC -¤Î¥Ç¥Õ¥©¥ë¥È¤Î¼ÂÁõ¤Ç¤Ï¡¢ºÇ½é¤ËɬÍפˤʤä¿»þ¤Ë¡¢¤³¤ÎÃͤò·èÄꤷ¤Þ¤¹¡£ -¤³¤ì¤Ï¡¢É¬Íפˤʤä¿»þ¤ËËè²ó¥×¥í¥»¥¹¤ò¼Â¹Ô¤·¡¢¤½¤Î½ÐÎϤò¥Ñ¡¼¥¹¤¹¤ë¤³¤È¤Î -¥ª¡¼¥Ð¡¼¥Ø¥Ã¥É¤ò¤µ¤±¤ë¤¿¤á¤Ç¤¹¡£ - - ¤¤¤«¤·¡¢¥ê¥â¡¼¥È¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Î»ö¤¬´Ø·¸¤·¤Æ¤¯¤ë¤È¡¢¿ÍÀ¸¤Ï -¤½¤ì¤Û¤É´Êñ¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ï¤½¤ì¤¾¤ì¡¢°Û¤Ê¤ë¥Ð¡¼¥¸¥ç¥ó -¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥Ä¡¼¥ë¤ò¤â¤Ã¤Æ¤¤¤Þ¤¹¡£¤³¤ì¤¬º¤Æñ¤Ê´Ö¤Ï¡¢Â¸ºß¤·¤Ê¤¤µ¡Ç½ -¤¬¡¢¥ê¥â¡¼¥È¤Ç»ÈÍѤµ¤ì¤Ê¤¤¤³¤È¤òÊݾڤ¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£ - - ¤³¤ÎÌäÂê¤ò²ò·è¤¹¤ë¤¿¤á¤Ë¡¢¸½ºß¤Î TRAMP ¤Ï¡¢¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥Ä¡¼¥ë¤Î -¥Ð¡¼¥¸¥ç¥óÈÖ¹æ¤ò TRAMP ¥Ð¥Ã¥Õ¥¡Ëè¤Ë¥í¡¼¥«¥ë¤ÊÊÑ¿ô¤Ë¤·¡¢¿·¤·¤¤ -¥Õ¥¡¥¤¥ë¤ò³«¤¯¤¿¤Ó¤ËVC ¤Ë¤³¤ÎÃͤò·èÄꤵ¤»¤ë¤È¤¤¤¦ÎϤº¤¯¤Î¥¢¥×¥í¡¼¥Á -¤òºÎÍѤ·¤Æ¤¤¤Þ¤¹¡£ - - ¤³¤ì¤Ï¤¢¤­¤é¤«¤ËÀ­Ç½¤Ë±Æ¶Á¤·¤Þ¤¹¡£¤¢¤ê¤¬¤¿¤¤¤³¤È¤Ë¡¢VC -¤Ë¤è¤Ã¤Æ¤ª¤³¤Ê¤ï¤ì¤ë -¤Û¤È¤ó¤É¤Î½èÍý¤Ï¡¢¼ÂºÝ¤Ë¤Ï¥ê¥â¡¼¥È¤Î¥Ð¡¼¥¸¥ç¥ó¤òÃΤ뤳¤È¤òɬÍפȤ·¤Þ¤»¤ó¡£ -¤·¤¿¤¬¤Ã¤Æ¡¢¤½¤ì¤Û¤ÉÌäÂê¤Ë¤Ê¤ê¤Þ¤»¤ó¡£ - - ºÇ½ªÅª¤Ë¤Ï¡¢¤³¤ì¤é¤ÎÊÑ¿ô¤Ï TRAMP ¤Ë¤è¤Ã¤Æ¥·¥¹¥Æ¥àËè¤ËÄ´¤Ù¤é¤ì¡¢ -¤½¤Î·ë²Ì¤ÏÀ­Ç½¤ò²þÁ±¤¹¤ë¤¿¤á¤Ë¥­¥ã¥Ã¥·¥å¤µ¤ì¤ë¤è¤¦¤Ë¤Ê¤ë¤Ç¤·¤ç¤¦¡£ - - -File: tramp_ja.info, Node: Files directories and localnames, Next: Issues, Prev: Version Control, Up: Top - -9 ¥Õ¥¡¥¤¥ë̾¡¢¥Ç¥£¥ì¥¯¥È¥ê¡¢¥í¡¼¥«¥ë̾¤¬¤É¤Î¤è¤¦¤ËÊÑ´¹¤µ¤ì(mangled)¡¢´ÉÍý¤µ¤ì¤ë¤« -********************************************************************************* - -* Menu: - -* Localname deconstruction:: ¥í¡¼¥«¥ë̾¤Îʬ²ò - - -File: tramp_ja.info, Node: Localname deconstruction, Up: Files directories and localnames - -9.1 ¥í¡¼¥«¥ë̾¤Îʬ²ò -==================== - -TRAMP ¤Î¥Õ¥¡¥¤¥ë̾¤ÏÉáÄ̤Υե¡¥¤¥ë̾¤È¤ÏÌÀ¤é¤«¤Ë°Û¤Ê¤Ã¤Æ¤¤¤Þ¤¹¡£ -¤·¤¿¤¬¤Ã¤Æ¡¢lisp ¤Î´Ø¿ô `file-name-directory' ¤È -`file-name-nondirectory' ¤Ï¡¢TRAMP ¥Ñ¥Ã¥±¡¼¥¸Æâ¤Ç¾å½ñ¤­¤µ¤ì¤Æ ¤¤¤Þ¤¹¡£ - - ´Ø¿ô¤ÎÃÖ¤­´¹¤¨¤Ï¥·¥ó¥×¥ë¤«¤ÄŬÀÚ¤ÊÊýË¡¤Ç¤¹¡£¥Õ¥¡¥¤¥ë̾¤òʬ²ò¤·¡¢ -¥í¡¼¥«¥ë̾¤ËÂФ·¤Æ¥ª¥ê¥¸¥Ê¥ë¤Î¥Ï¥ó¥É¥é¡¼¤¬¤è¤Ð¤ì¤Þ¤¹¡£¤½¤·¤Æ¡¢ -¤½¤Î·ë²Ì¤ò¤â¤È¤Ë TRAMP ¥Õ¥¡¥¤¥ë̾¤¬ºÆ¹½À®¤µ¤ì¤Þ¤¹¡£ - - ¤³¤ì¤Ë¤è¤ê¡¢TRAMP ¥Õ¥¡¥¤¥ë̾¤Î¾ðÊó¤ò°·¤¦¾ì¹ç¤â¡¢¥×¥é¥Ã¥È¥Û¡¼¥à¸ÇÍ­¤Î -¥ª¥ê¥¸¥Ê¥ë¥Ï¥ó¥É¥é¡¼¤Î¥Ï¥Ã¥¯¤ÏÍ­¸ú¤Ç¤¹¡£ - - -File: tramp_ja.info, Node: Issues, Prev: Files directories and localnames, Up: Top - -10 ¸¡Æ¤²ÝÂê¤È·èÄê»ö¹à -********************* - - * uuencode ¥á¥½¥Ã¥É¤¬¤¤¤Ä¤âÆ°ºî¤¹¤ë¤ï¤±¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó - - TRAMP ¤ÎÀß·×¾å¤ÎÍýͳ¤Ç¡¢Éä¹æ²½¤ÈÉü¹æ²½¤ò¤ª¤³¤Ê¤¦¥×¥í¥°¥é¥à¤Ïɸ½à - ÆþÎϤ«¤éÆɤ߹þ¤ß¡¢É¸½à½ÐÎϤ˽ñ¤­¹þ¤àɬÍפ¬¤¢¤ê¤Þ¤¹¡£¤¤¤¯¤Ä¤«¤Î¥·¥¹¥Æ¥à - ¤Ç¤Ï¡¢`uudecode -o -' ¤Çɸ½àÆþÎϤ«¤éÆɤ߹þ¤ß¡¢Éü¹æ²½¤µ¤ì¤¿¥Õ¥¡¥¤¥ë - ¤òɸ½à½ÐÎϤ˽ñ¤­¹þ¤ß¤Þ¤¹¡£Â¾¤Î¥·¥¹¥Æ¥à¤Ç¤Ï¡¢`uudecode -p' ¤¬Æ±¤¸ - Æ°ºî¤ò¤·¤Þ¤¹¡£¤·¤«¤·¡¢¤¤¤¯¤Ä¤«¤Î¥·¥¹¥Æ¥à¤Î uudecode - ¤Î¼ÂÁõ¤Ç¤Ï¡¢¤³¤ì¤é ¤Î¤³¤È¤¬Á´¤¯¤Ç¤­¤Þ¤»¤ó¡£¤³¤ì¤é¤Î uudecode - ¤Î¼ÂÁõ¤Ë¡¢É¸½à½ÐÎϤ˽ñ¤­¹þ¤à - ¤¿¤á¤ËŬÀڤʥѥé¥á¡¼¥¿¤òÅϤ·¤Æ¸Æ¤Ö¤³¤È¤ÏÉÔ²Äǽ¤Ç¤¹¡£ - - ¤â¤Á¤í¤ó¡¢¤³¤ì¤ò²óÈò¤¹¤ë»ö¤Ï²Äǽ¤Ç¤¹¡£¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë̾¤òÄɲ乤ë - ¤¿¤á¤Ë `begin foo 644' ¹Ô¤ò½ñ¤­¤«¤¨¤ì¤Ð¡¢`uudecode' ¤ò¸Æ¤Ö¤³¤È - ¤¬¤Ç¤­¤Þ¤¹¡£¤½¤·¤Æ¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë¤òɽ¼¨¤·ºï½ü¤·¤Þ¤¹¡£ - - ¤·¤«¤·¡¢¤³¤ÎÊýË¡¤Ï¤¢¤Þ¤ê¤Ë¤â¿®ÍêÀ­¤¬Ä㤤¤¿¤á¡¢¤¤¤¯¤Ä¤«¤Î¥·¥¹¥Æ¥à¤Ç¤Ï - uuencode ¥á¥½¥Ã¥É¤ò»ÈÍѤǤ­¤Ê¤¤¤Þ¤Þ¤Ë¤·¤Æ¤ª¤¯»ö¤Ë¤·¤Þ¤·¤¿¡£ - - * TRAMP ¤Ï XEmacs 20 ¾å¤ÇÆ°¤­¤Þ¤»¤ó - - ¤³¤ì¤Ï¡¢XEmacs 20 ¤Ë¸ºß¤·¤Ê¤¤¥Þ¥¯¥í `with-timeout' ¤ò»È¤Ã¤Æ¤¤¤ë - ¤«¤é¤Ç¤¹¡£»ä¤Ï¡¢¥¨¥ß¥å¥ì¡¼¥·¥ç¥ó¤Î¤¿¤á¤Î¥Þ¥¯¥í¤ò TRAMP ¤ËÄɲ乤ë - ¤³¤È¤Ë¡¢¤¢¤Þ¤ê¾è¤êµ¤¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£¤·¤«¤·¡¢XEmacs 20 - ¥æ¡¼¥¶¡¼¤Î狼¤¬ - ÀѶËŪ¤Ë¼ÂÁõ¤È¥Æ¥¹¥È¤ò¤·¤¿¤¤¤È¹Í¤¨¤Æ¤¤¤ë¤Î¤Ç¤¢¤ì¤Ð¡¢»ä¤«¥á¡¼¥ê¥ó¥°¥ê¥¹¥È - ¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£ - - * TRAMP ¥Õ¥¡¥¤¥ë̾¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤¬ Emacs ¤È XEmacs ¤Ç°ã¤¤¤Þ¤¹¡£ - - Emacs - ¤Î¥á¥ó¥Æ¥Êã¤Ï¡¢¥æ¡¼¥¶¤¬¿·¤·¤¤¥·¥ó¥¿¥Ã¥¯¥¹¤òÊÙ¶¯¤¹¤ëɬÍפ¬¤Ê¤¤¤è - ¤¦¤Ë Ange-FTP ¤È TRAMP ¤ÇÅý°ì¤µ¤ì¤¿¥Õ¥¡¥¤¥ë̾¥·¥ó¥¿¥Ã¥¯¥¹¤ò»È¤¤¤¿¤¤ - ¤È˾¤ó¤Ç¤¤¤Þ¤¹¡£ - - XEmacs - ¤Î¥á¥ó¥Æ¥Ê¤Ë¤È¤Ã¤Æ¤Ï¡¢Åý°ì¤µ¤ì¤¿¥Õ¥¡¥¤¥ë̾¥·¥ó¥¿¥Ã¥¯¥¹¤òÍѤ¤¤ë - ¤³¤È¤Ë¤è¤ëÍø±×¤è¤ê¤â¤½¤Î¤³¤È¤Ë¤è¤ëÌäÂê¤ÎÊý¤¬Â礭¤¤¤Ç¤¹¡£ XEmacs - ¤Î¥Ñ¥Ã¥±¡¼¥¸¥·¥¹¥Æ¥à¤Ï¥Ñ¥Ã¥±¡¼¥¸¤ò¥À¥¦¥ó¥í¡¼¥É¤¹¤ë¤Î¤Ë EFS ¤ò - »È¤¤¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤ÆÌÀ¤é¤«¤Ë EFS - ¤ÏºÇ½é¤«¤é¥¤¥ó¥¹¥È¡¼¥ë¤µ¤ì¤Æ¤¤¤ë¤Ï¤º - ¤Ç¤¹¡£¤â¤·¥Õ¥¡¥¤¥ë̾¤¬Åý°ì¤µ¤ì¤Æ¤¤¤¿¤È¤¹¤ë¤È¡¢TRAMP ¤â¤Þ¤¿ºÇ½é¤«¤é - ¥¤¥ó¥¹¥È¡¼¥ë¤µ¤ì¤Æ¤¤¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£ - - - -File: tramp_ja.info, Node: Concept Index, Next: Version Control, Prev: Frequently Asked Questions, Up: Top - -Concept Index -************* - -[index] -* Menu: - -* .login file: Remote shell setup. (line 6) -* .profile file: Remote shell setup. (line 6) -* auto-save: Auto-save and Backup. - (line 6) -* backup: Auto-save and Backup. - (line 6) -* base-64 encoding: Inline methods. (line 17) -* behind the scenes: Overview. (line 57) -* bug reports: Bug Reports. (line 6) -* choosing the right method: Default Method. (line 52) -* configuration: Configuration. (line 6) -* connection types, overview: Connection types. (line 6) -* create your own methods: Customizing Methods. (line 6) -* customizing completion: Customizing Completion. - (line 6) -* customizing methods: Customizing Methods. (line 6) -* Cygwin (with scpx method): External transfer methods. - (line 74) -* Cygwin (with sshx method): Inline methods. (line 76) -* Cygwin and ssh-agent: Windows setup hints. (line 26) -* Cygwin, issues: Windows setup hints. (line 6) -* default configuration: Configuration. (line 6) -* default method: Default Method. (line 6) -* details of operation: Overview. (line 57) -* development history: History. (line 6) -* dired: Dired. (line 6) -* external methods: Connection types. (line 15) -* external transfer methods <1>: External transfer methods. - (line 6) -* external transfer methods: Connection types. (line 15) -* FAQ: Frequently Asked Questions. - (line 6) -* fcp (with fcp method): External transfer methods. - (line 100) -* fcp method: External transfer methods. - (line 100) -* filename completion: Filename completion. (line 6) -* filename examples: Filename Syntax. (line 6) -* filename syntax: Filename Syntax. (line 6) -* filename syntax for multi-hop files: Multi-hop filename syntax. - (line 6) -* frequently asked questions: Frequently Asked Questions. - (line 6) -* fsh (with fcp method): External transfer methods. - (line 100) -* fsh method: External transfer methods. - (line 113) -* history: History. (line 6) -* hop method rsh: Multi-hop Methods. (line 25) -* hop method ssh: Multi-hop Methods. (line 32) -* hop method su: Multi-hop Methods. (line 36) -* hop method sudo: Multi-hop Methods. (line 50) -* hop method telnet: Multi-hop Methods. (line 21) -* how it works: Overview. (line 57) -* inline methods <1>: Inline methods. (line 6) -* inline methods: Connection types. (line 15) -* Kerberos (with krlogin method): Inline methods. (line 102) -* km krlogin: Inline methods. (line 102) -* method fcp: External transfer methods. - (line 100) -* method fsh: External transfer methods. - (line 113) -* method krlogin: Inline methods. (line 102) -* method multi: Multi-hop Methods. (line 13) -* method plink: Inline methods. (line 106) -* method pscp: External transfer methods. - (line 92) -* method rcp: External transfer methods. - (line 26) -* method rsh: Inline methods. (line 28) -* method rsync: External transfer methods. - (line 60) -* method scp: External transfer methods. - (line 34) -* method scpx: External transfer methods. - (line 74) -* method scpx with Cygwin: Windows setup hints. (line 15) -* method smb: External transfer methods. - (line 119) -* method ssh: Inline methods. (line 36) -* method sshx: Inline methods. (line 76) -* method sshx with Cygwin: Windows setup hints. (line 8) -* method su: Inline methods. (line 62) -* method sudo: Inline methods. (line 67) -* method telnet: Inline methods. (line 58) -* methods, external transfer <1>: External transfer methods. - (line 6) -* methods, external transfer: Connection types. (line 15) -* methods, inline <1>: Inline methods. (line 6) -* methods, inline: Connection types. (line 15) -* methods, multi-hop <1>: Multi-hop Methods. (line 6) -* methods, multi-hop: Connection types. (line 36) -* methods, out-of-band <1>: External transfer methods. - (line 6) -* methods, out-of-band: Connection types. (line 15) -* mimencode: Inline methods. (line 17) -* multi method: Multi-hop Methods. (line 13) -* multi-hop filename syntax: Multi-hop filename syntax. - (line 6) -* multi-hop methods <1>: Multi-hop Methods. (line 6) -* multi-hop methods: Connection types. (line 36) -* obtaining Tramp: Obtaining Tramp. (line 6) -* out-of-band methods <1>: External transfer methods. - (line 6) -* out-of-band methods: Connection types. (line 15) -* overview: Overview. (line 6) -* plink (with pscp method): External transfer methods. - (line 92) -* plink method: Inline methods. (line 106) -* pscp (with pscp method): External transfer methods. - (line 92) -* pscp method: External transfer methods. - (line 92) -* PuTTY (with pscp method): External transfer methods. - (line 92) -* rcp (with rcp method): External transfer methods. - (line 26) -* rcp method: External transfer methods. - (line 26) -* remote shell setup: Remote shell setup. (line 6) -* rsh (with rcp method): External transfer methods. - (line 26) -* rsh hop method: Multi-hop Methods. (line 25) -* rsh method: Inline methods. (line 28) -* rsync (with rsync method): External transfer methods. - (line 60) -* rsync method: External transfer methods. - (line 60) -* scp (with scp method): External transfer methods. - (line 34) -* scp (with scpx method): External transfer methods. - (line 74) -* scp method: External transfer methods. - (line 34) -* scpx method: External transfer methods. - (line 74) -* scpx method with Cygwin: Windows setup hints. (line 15) -* selecting config files: Customizing Completion. - (line 6) -* shell init files: Remote shell setup. (line 6) -* smb method: External transfer methods. - (line 119) -* ssh (with rsync method): External transfer methods. - (line 60) -* ssh (with scp method): External transfer methods. - (line 34) -* ssh (with scpx method): External transfer methods. - (line 74) -* ssh hop method: Multi-hop Methods. (line 32) -* ssh method: Inline methods. (line 36) -* ssh-agent: External transfer methods. - (line 16) -* SSH_AUTH_SOCK and Emacs on Windows: Windows setup hints. (line 26) -* sshx method: Inline methods. (line 76) -* sshx method with Cygwin: Windows setup hints. (line 8) -* su hop method: Multi-hop Methods. (line 36) -* su method: Inline methods. (line 62) -* sudo hop method: Multi-hop Methods. (line 50) -* sudo method: Inline methods. (line 67) -* telnet hop method: Multi-hop Methods. (line 21) -* telnet method: Inline methods. (line 58) -* tset Unix command: Remote shell setup. (line 61) -* type-ahead: Usage. (line 14) -* Unix command tset: Remote shell setup. (line 61) -* using non-standard methods: Customizing Methods. (line 6) -* using TRAMP: Usage. (line 6) -* uuencode: Inline methods. (line 17) -* Version Control: Version Control. (line 6) - - - -Tag Table: -Node: Top1393 -Node: Overview5861 -Ref: Overview-Footnote-112232 -Node: Obtaining Tramp12421 -Node: History14132 -Node: Configuration14871 -Node: Connection types16670 -Node: Inline methods18551 -Node: External transfer methods23623 -Ref: External transfer methods-Footnote-130989 -Node: Multi-hop Methods31060 -Node: Default Method33932 -Node: Customizing Methods38076 -Node: Customizing Completion38523 -Node: Remote Programs41364 -Node: Remote shell setup42899 -Node: Auto-save and Backup49295 -Node: Windows setup hints50495 -Node: Usage52327 -Node: Filename Syntax53444 -Node: Multi-hop filename syntax55546 -Node: Filename completion57460 -Node: Dired58795 -Node: Bug Reports59250 -Node: Frequently Asked Questions60564 -Node: Version Control66066 -Node: Version Controlled Files67174 -Node: Remote Commands67616 -Node: Changed workfiles68446 -Node: Checking out files69214 -Node: Miscellaneous Version Control69689 -Node: Remote File Ownership70071 -Node: Back-end Versions71268 -Node: Files directories and localnames72688 -Node: Localname deconstruction73030 -Node: Issues73652 -Node: Concept Index75719 - -End Tag Table diff --git a/xemacs-packages/lisp/bbdb/ChangeLog b/xemacs-packages/lisp/bbdb/ChangeLog deleted file mode 100644 index f88a5a8e..00000000 --- a/xemacs-packages/lisp/bbdb/ChangeLog +++ /dev/null @@ -1,1140 +0,0 @@ -2005-10-12 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.29 released. - -2005-07-27 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.28 released. - -2005-07-24 Waider - * Sync to SourceForge CVS - -2005-07-24 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.27 released. - -2005-05-10 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.26 released. - -2004-11-08 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.25 released. - -2004-09-29 Steve Youngs - - * Makefile (REQUIRES): Add ecrypto. - -2003-10-31 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.24 released. - -2003-05-18 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.23 released. - -2003-05-14 Vin Shelton - - * Makefile (REQUIRES): Added os-utils to find jka-compr, necessary - to compile mhe. - -2003-05-14 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.22 released. - -2003-05-14 Steve Youngs - - * Makefile (REQUIRES): Add net-utils. - -2003-03-09 Ben Wing - - * Makefile (DOCS_TEXINFO_EXTENSION): New. - Delete explicit compile:: and binkit: rules. - Don't add custom-load.elc to the list of generated elc's. - Use EXPLICIT_DOCS instead of explicitly giving the targets - and dependencies. - Eliminate the recursive building of the files using Makefile - (now deleted) in subdirectory texinfo/. - Use DOCS_TEXINFO_EXTENSION, since the docs are named .texinfo - rather than .texi. - * texi/Makefile: Delete. - -2002-11-29 Ben Wing - - * .cvsignore: Remove files now handled automatically by CVS. - * lisp/.cvsignore: Ditto. - * Makefile: Use `compile' instead of hard-coded `all'. - * texinfo/Makefile: Use `compile' instead of hard-coded `all'. - -2002-10-15 Ville Skyttä - - * Makefile (srckit): Remove. - (.PHONY): Ditto. - -2002-10-14 Ville Skyttä - - * Makefile (MANUAL): Removed (unused). - -2002-10-13 Ville Skyttä - - * Makefile (REQUIRES): Add indirect fsf-compat, eterm, and - sh-script requirements. - (PRELOADS): New, preload vm-version. - -2002-07-15 Adrian Aichner - - * lisp/bbdb-xemacs.el: It's XEmacs, not Xemacs. - -2002-06-27 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.21 released. - -2002-06-12 Steve Youngs - - * lisp/bbdb-vm.el (bbdb/vm-set-auto-folder-alist): Typo fix. - -2002-03-25 Steve Youngs - - * Makefile (VERSION): 1.20 released. - -2002-03-17 Adrian Aichner - - * texinfo/Makefile: include .../XEmacs.rules for generic HTML - rules. - * texinfo/Makefile (HTML_FILES): Moved here from ../Makefile. - * texinfo/Makefile (HTML_DEP): Ditto. - * texinfo/Makefile (all): Converted to double-colon - * texinfo/Makefile (clean): Ditto. - -2002-03-17 Adrian Aichner - - * Makefile: Add html rule to invoke texinfo/Makefile. - -2002-03-12 Adrian Aichner - - * texinfo/bbdb.texinfo: Fix typos found - by my own grep-for-likely-typo.pl. - -2002-02-21 Nix - - * lisp/bbdb-com.el (top-level): Evaluate fsets at runtime, - as well as at compilation time. - -2002-02-13 Steve Youngs - - * Sync to BBDB 2.34. - - * lisp/bbdb-sc.el (bbdb-insinuate-sc): Autoload it. - -2002-01-15 Waider - - * testing/bbdb-test.el: - New file - - * bits/make.bat: - Merged in some changes from the mailing list. Note, this is - still experimental. - - * lisp/bbdb-com.el: - Don't fset things that aren't ours - Last of compiler warning cleanup - Fixed one more completion bug - -2002-01-14 Waider - - * lisp/bbdb-hooks.el: - Conditionalise the rmail load - - * lisp/bbdb-gui.el: - Make X/Emacs compatibility less intrusive - -2002-01-13 Waider - - * lisp/bbdb-hooks.el: - Don't force VM on people, even if it is a great mailer... - -2002-01-10 Waider - - * bbdb-com.el: - Last few fixes (hopefully) to completion - - * lisp/bbdb-snarf.el: - Make bbdb-rfc822-addresses the default address parser - Remove test-harness code to elsewhere (i.e. not in user code!) - - * lisp/bbdb.el: - Changed the workaround for set-keymap-prompt, as it seemed to be - clashing with VM. Ideally, all this Emacs/XEmacs stuff should go - in a separate file, or at least all in one part of bbdb.el. - -2002-01-06 Waider - - * lisp/bbdb-xemacs.el, lisp/bbdb-srv.el, lisp/bbdb-sc.el, - lisp/bbdb-gui.el, lisp/bbdb-ftp.el, lisp/bbdb-com.el, - lisp/bbdb-hooks.el, lisp/bbdb-w3.el, lisp/bbdb.el, - lisp/bbdb-snarf.el: - Compiler cleanup - -2002-01-04 Robert Fenk - - * lisp/bbdb-snarf.el (bbdb-extract-address-component-regexps): - Replaced the call of bbdb-clean-username bt a call to - mail-extract-address-components in order to handle addresses of - the form "Lastname, Firstname" and "Firstname Lastname, Jr" in the - right way. - (bbdb-test/bbdb-extract-address-components): New test function to - check if everything is working as it should. - -2002-01-03 Robert Fenk - - * lisp/bbdb-com.el (bbdb-complete-name): fixed cycling when the - current completion is equal to one of the nets. - Added code for C-u M-TAB which lists all possible nets of current - completed addess. - -2002-01-01 Waider - - * lisp/bbdb-com.el (bbdb-complete-name): - Two fixes based on further testing with completion-type. - -2001-12-27 Waider - - * lisp/bbdb-com.el - (bbdb-completing-read-one-record): - Correctly handle case where no records are selected - (bbdb-complete-name): - Whoops. Small logic error in cycling code - - * lisp/bbdb.el (bbdb-send-mail-style), - lisp/bbdb-com.el (bbdb-send-mail-internal): - Add Mew as an option for bbdb-send-mail-style - -2001-12-27 Jeff Bigler - - * lisp/bbdb-com.el (bbdb-phone-area-regexp): - Allow / and . as separators when parsing a phone number. - -2001-12-26 Waider - - * lisp/bbdb-com.el (bbdb-complete-name): - Mostly rewritten to consolidate the last four years(!) of code - glomming. - - * lisp/bbdb.el (bbdb-search-intertwingle): - New function. More stringent version of bbdb-search-simple, - intended for internal bbdb use only - -2001-12-10 Karl Fogel - - * bbdb.texinfo - (Mail Sending Interfaces): - Use `add-hook' instead of `setq' in the examples, so users won't - clobber existing hooks. - (Known Bugs): - Reference mailing lists, as is done in other places where the - `bbdb-info' list is mentioned. - -2001-11-19 Waider - - * lisp/bbdb.el (bbdb-format-address): - Several people contributed a patch to fix this. Alex Schroeder's - was the most general as it handles both printing and - non-printing situations. - - * lisp/bbdb-print.el - Some more fixes from Alex. - -2001-11-12 Waider - - * lisp/bbdb-snarf.el (bbdb-extract-address-component-regexps): - Allow '+' as part of an email address - - * lisp/bbdb-com.el (bbdb-complete-name-allow-cycling): - Documentation fix - (bbdb-get-help-window): - Removed dead code - - * lisp/bbdb.el - Try to autoload the message-mode and mail-mode keymaps rather than - defining them as nil. - -2001-11-11 Waider - - * lisp/bbdb-vm.el (bbdb/vm-set-auto-folder-alist-field): - Move into mua-specific group - (bbdb/vm-set-auto-folder-alist): - Documentation typo - -2001-11-06 Waider - - * texinfo/bbdb.texinfo (Mail Sending Interfaces): - Mention message-setup-hook in the mail aliases section - (Raymond Scholz) - -2001-10-14 Waider - - * lisp/bbdb-gnus.el - (bbdb/gnus-pop-up-bbdb-buffer): - Move the call to bbdb-display-records back inside the (when...) - I had two bug reports for this (Sudesh Joseph and Michael - Totschnig). - - * lisp/bbdb.el: - Added Nix's patch to make inside-bbdb-notice-hook work as - advertised, also other bbdb-expire support. - (bbdb-search-simple): - Try company name if record name is unset, before falling back to - "". (Martin Schwenke) - - * lisp/bbdb-com.el - (bbdb-complete-name): - Restored the original code to handle making sure primary addresses - get picked first, since the code I'd replaced it with had some - dubious side-effects. - (bbdb-create-internal): - Documentation fix. (Ueli Schläpfer) - -2001-09-20 Robert Fenk - - * lisp/bbdb.el (bbdb-create-hook), (bbdb-notice-hook): - Added a note that hook functions might use the new variables - bbdb-update-address-class and bbdb-update-address-header to obtain - information about the currently processed email address. - - * lisp/bbdb-com.el (bbdb-get-addresses-headers): merged - bbdb-get-addresses-from-headers and bbdb-get-addresses-to-headers - into this variable. - (bbdb-get-addresses): new generic function for extraction of email - addresses from header, which is used by Gnus and VM - (bbdb-update-address-class), (bbdb-update-address-header): new - variable providing additional information to hook functions about - the currently processed email address. - - * lisp/bbdb-gnus.el (bbdb/gnus-update-records): uses - bbdb-get-addresses instead of bbdb/gnus-get-addresses which was - removed. - (bbdb/gnus-show-sender), (bbdb/gnus-show-all-recipients), - (bbdb/gnus-show-records): modified to use new style of - bbdb-get-addresses-headers - - * lisp/bbdb-vm.el (bbdb/vm-get-header-content): VM specific header - extraction function. - (bbdb/vm-update-records): bbdb-get-addresses instead of - bbdb/vm-get-addresses which was removed. - (bbdb/vm-show-all-recipients), - (bbdb/vm-show-sender), (bbdb/vm-show-records): modified to use new - style of bbdb-get-addresses-headers - - * lisp/bbdb-hooks.el (bbdb-auto-notes-alist): Additional element - type to allow actions also on recipients of an message - (bbdb-auto-notes-hook): Fixed to perfom auto-note actions only for - authors of a message. Support for new features of - bbdb-auto-notes-alist. Honor bbdb-silent-running. - -2001-09-18 Waider - - * lisp/bbdb-snarf.el (bbdb-rfc822-addresses): - Cope with rfc822-addresses returning nil as the car. - -2001-09-11 Robert Fenk - - * lisp/bbdb-print.el (bbdb-print-field-shown-p): Added as a - replacement for bbdb-field-shown-p. - (bbdb-print-omit-fields): Added as a replacement for - bbdb-print-elided-display. - - * lisp/bbdb-com.el (bbdb-get-addresses-headers): - bbdb-auto-notes-alist does not know if a address comes form a - author or recipient of a message and therefore might update wrong - records, e.g. the organization of recipients to that of the - author. - Therfore the default is now bbdb-get-addresses-from-headers until - the hook functions are able to tell the type (author/recp) of an - address. - -2001-09-09 Waider - - * lisp/bbdb-gui.el: - Fixed bogus fset (fsetting variable instead of 'variable) - (bbdb-hack-x-face): - use bbdb-find-face, not find-face - - * lisp/bbdb.el - (bbdb-initialize): - Fixed vm entry. vm-load-hook no longer exists! - (bbdb-mode): - Removed references to bbdb-elide-record - -2001-09-05 Robert Fenk - - * lisp/bbdb-com.el (bbdb-complete-name-hooks): Fixed the - documentation. - (bbdb-get-only-first-address-p): fixed the default value, which - should have been t - -2001-09-04 Robert Fenk - - * lisp/bbdb.el (bbdb-annotate-message-sender): calling of - bbdb-create-hook functions moved to the end of function - (bbdb-display-layout-alist): replaced by the nice version - provided by Alex Schroeder - -2001-08-31 Robert Fenk - - * lisp/bbdb-hooks.el (bbdb-auto-notes-alist): applied posted - patch of better customization. - - * lisp/bbdb-srv.el, lisp/bbdb-rmail.el, lisp/bbdb-mhe.el, - lisp/bbdb-vm.el, lisp/bbdb-gnus.el, lisp/bbdb.el, - lisp/bbdb-com.el: replaced occureneces of bbdb-elided-display and - bbdb-pop-up-elided-display. - - * lisp/bbdb-gui.el (build-bbdb-menu): Fix menus to use new display - layout toggeling functions. - - * lisp/bbdb-com.el (bbdb-change-records-state-and-redisplay), - (bbdb-toggle-all-records-display-layout), - (bbdb-toggle-records-display-layout), - (bbdb-display-all-records-completely), - (bbdb-display-record-completely): modified functions for toggeling - the display layout of records. Old functions bbdb-elide-record - and bbdb-unelide-records have been removed. - - * lisp/bbdb.el - (bbdb-display-layout-alist): variable controling options for - display layouts, support for user defines format functions still - missing. - (bbdb-display-layout): variable controling the default display layout - (bbdb-pop-up-display-layout): variable controling the default display - layout for pop-up buffers. - (bbdb-elided-display), (bbdb-pop-up-elided-display): are obsolete - variables now. - (bbdb-elided-display-sanity-setup): function which sets up the - layout variables from the obsolete bbdb-elided-display and - bbdb-pop-up-elided-display variables. Might be removed along with - the variables in the future. - (bbdb-format-record): rewitten to support multiple - layouts according to bbdb-display-layout-alist - (bbdb-format-record-layout-multi-line), - (bbdb-format-record-layout-one-line), - (bbdb-format-record-one-line-*): Function specific to certain - layouts. - -2002-01-13 Steve Youngs - - * package-info.in (provides): Update to include all provides. - -2002-01-07 Adrian Aichner - - * Makefile (HTML_FILES): New. - * Makefile (HTML_DEP): New. - -2001-08-29 Steve Youngs - - * Makefile (MAINTAINER): Change to Ronan Waide - . - -2001-08-26 Steve Youngs - - * lisp/bbdb.el (bbdb-initialize): Autoload it. - -2001-08-13 Jeff Mincy - - * lisp/bbdb-gui.el (bbdb-hack-x-face): Fix call to make-glyph. - -2001-07-01 Steve Youngs - - * Import BBDB 2.32 - -2000-11-07 Martin Buchholz - - * ./texinfo/bbdb.texinfo: Doc fix. - -2000-10-05 Martin Buchholz - - * *: Mega typo fix. - -2000-08-22 Steve Youngs - - * Makefile: Remove target 'clean' because it's covered in XEmacs.rules - -2000-08-16 Andreas Jaeger - - * Makefile (REQUIRES): Require w3 for base64. - -1999-01-24 Matt Simmons - - * lisp/bbdb.el: BBDB 2.00.06 released - -1999-01-24 Colin Rafferty - - * lisp/bbdb-gnus.el: (bbdb/gnus-score-as-text) Handle the fact - that `score' could be either an int or a string. - -1999-01-21 Colin Rafferty - - * lisp/bbdb-com.el (bbdb-info): Made it work with Info-directory-list - -1999-01-21 Sam Steingold - - * lisp/bbdb.el (bbdb-display-records-1): bind - `temp-buffer-setup-hook' and `temp-buffer-show-hook' to nil. - This fixes the problem of `view-mode' conflicting with - `bbdb-mode'. - -1999-01-08 Jean-Yves Perrier - - * lisp/bbdb-comp.el (bbdb-redisplay-records): Don't bug out - with mark. - -1999-01-08 Colin Rafferty - - * lisp/bbdb.el (bbdb-string-trim): Make it remove *all* text - properties from the string instead of just a few select ones. - Inspired by Sam Steingold . - -1999-01-08 Sam Steingold - - * lisp/bbdb.el (bbdb-save-db-timeout): Correct comment. - -1998-12-31 Matt Simmons - - * lisp/bbdb-snarf.el (bbdb-snarf-region): Autoload - -1998-12-31 Colin Rafferty - - * lisp/bbdb-gnus.el (bbdb/gnus-snarf-signature): Created - -1998-12-31 Matt Simmons - - * lisp/bbdb.el: BBDB 2.00.05 released - -1998-12-31 Matt Simmons - - * INSTALL: Added documentation for those without make - * lisp/bbdb-snarf.el: Merge in 1.8.1.x subtree - -1998-12-30 Matt Simmons - - * lisp/bbdb.el: BBDB 2.00.04 released - -1998-12-29 Colin Rafferty - - * lisp/bbdb-com.el (bbdb-current-field): Made it handle the - blank user. - -1998-12-24 Colin Rafferty - - * lisp/bbdb.el (bbdb-version): Made it take an option to output in - current buffer. - -1998-12-10 Colin Rafferty - - * lisp/bbdb.el (bbdb-load-hook): Moved after the provide. - * lisp/bbdb.el (bbdb-display-records-1): Fix bug so that it - doesn't blow out on null records parameter. - -1998-12-07 Colin Rafferty - - * lisp/bbdb-snarf.el (bbdb-snarf-web-prop): Fix it to be a symbol. - * lisp/bbdb-snarf.el (bbdb-merge-internally): Use - bbdb-record-set-raw-notes. - -1998-12-05 Matt Simmons - - * lisp/bbdb.el: BBDB 2.00.03 released - -1998-12-03 Adam C. Finnefrock - - * lisp/bbdb-gnus.el (bbdb/gnus-update-record): Honor - bbdb-user-mail-names. - -1998-11-17 Colin Rafferty - - * lisp/bbdb-gnus.el (bbdb/gnus-show-sender): Use currently - selected summary line rather than what may be in *Article* - buffer. - * lisp/bbdb-gnus.el (bbdb/gnus-edit-notes): ditto - * lisp/bbdb-gnus.el (bbdb/gnus-annotate-sender): ditto - -1998-11-09 Didier Verna - - * lisp/bbdb-xemacs.el (bbdb-fontify-buffer): extent-data is - obsolete (and gone in XEmacs 21.2+). Replace it. - * lisp/bbdb-xemacs.el (bbdb-menu): ditto. - -1998-10-27 Colin Rafferty - - * bbdb-com.el (bbdb-dwim-net-address-allow-redundancy): Created. - * bbdb-com.el (bbdb-dwim-net-address): As inspired by Xavier Francois - Vigouroux, use `bbdb-dwim-net-address-allow-redundancy'. - -1998-10-23 Colin Rafferty - - * lisp/bbdb.el: Changed mail list name from info-bbdb to - bbdb-info. - - * lisp/bbdb-print.el: Changed mail list name from info-bbdb to - bbdb-info. - - * texinfo/bbdb.texinfo: Changed mail list name from info-bbdb to - bbdb-info. - -1998-10-13 Colin Rafferty - - * bbdb-snarf.el (bbdb-snarf-web-prop): Made it a symbol. - -1998-10-13 Colin Rafferty - - * lisp/bbdb-com.el (bbdb-read-new-record): Check for integerp - explicitly with bbdb-default-area-code, instead of relying on - condition-case. - - * lisp/bbdb-print.el (bbdb-print-alist-widget): ditto. - * lisp/bbdb-print.el (bbdb-print-alist): ditto. - -1998-10-12 Adam C. Finnefrock - - * lisp/bbdb-com.el (bbdb-info-file): Made it a choice, since nil didn't - match the type: file. - -1998-10-08 Colin Rafferty - - * lisp/bbdb.el (bbdb-version): BBDB 2.00.02 released - -1998-07-19 SL Baur - - * lisp/bbdb-migrate.el (bbdb-migration-query): Don't pass an - integer to concat. - - * lisp/bbdb.el (bbdb-y-or-n-p): raise-screen -> raise-frame, - screen-visible-p -> frame-visible-p, selected-screen -> - selected-frame. - * lisp/bbdb.el (bbdb-pop-up-bbdb-buffer-horizontally): - screen-width -> frame-width. - - * lisp/bbdb-xemacs.el (bbdb-fontify-buffer): set-extent-attribute - -> set-extent-property, set-extent-data -> set-extent-property. - * lisp/bbdb-xemacs.el (bbdb-hack-x-face): set-extent-data -> - set-extent-property. - - * lisp/bbdb-srv.el (bbdb/srv-handle-headers): Use new name for - set-window-buffer-dedicated. - -Sat Apr 11 00:28:17 1998 Matt Simmons - - * lisp/bbdb.el: BBDB 2.00.01 released - * lisp/bbdb.el (bbdb-mode-map): Added bindings - * lisp/bbdb.el (bbdb-mode-search-map): Created, bound search - functions to it. - * lisp/bbdb.el (bbdb-initialize): Gutted - * lisp/bbdb.el (bbdb-initialize-hook): Created - * lisp/bbdb.el (bbdb-load-hook): Changed documentation - * lisp/bbdb.el (advertized-bbdb-delete-current-field-or-record): - Began to remove support - * lisp/bbdb-com.el (bbdb-changed): Syntax error in comment - * lisp/bbdb-com.el (bbdb-phones): Changed prompt - * lisp/bbdb-com.el (bbdb-net): Changed prompt - * lisp/bbdb-com.el (bbdb-company): Changed prompt - * lisp/bbdb-com.el (bbdb-name): Changed prompt - * lisp/bbdb-com.el (bbdb): Changed prompt - * lisp/bbdb-com.el (advertized-bbdb-delete-current-field-or-record): - Began to remove support - * texinfo/bbdb.texinfo: Added EOL list. - * texinfo/bbdb.texinfo: EOL'd - advertized-bbdb-delete-current-field-or-record. - * texinfo/bbdb.texinfo: EOL'd GNUS support. - * texinfo/bbdb.texinfo: Documented bbdb-initialize-hook - * texinfo/bbdb.texinfo: Documented new bindings - -Fri Mar 13 00:00:00 1998 Colin Rafferty - - * lisp/bbdb.el (bbdb-initialize): Made the autoloads be - conditionally loaded. - * lisp/bbdb-com.el: Added ###autoload cookies. - * lisp/bbdb-ftp.el: Added ###autoload cookies. - * lisp/bbdb-gnus.el: Added ###autoload cookies. - * lisp/bbdb-hooks.el: Added ###autoload cookies. - * lisp/bbdb-mhe.el: Added ###autoload cookies. - * lisp/bbdb-migrate.el: Added ###autoload cookies. - * lisp/bbdb-print.el: Added ###autoload cookies. - * lisp/bbdb-reportmail.el: Added ###autoload cookies. - * lisp/bbdb-rmail.el: Added ###autoload cookies. - * lisp/bbdb-sc.el: Added ###autoload cookies. - * lisp/bbdb-snarf.el: Added ###autoload cookies. - * lisp/bbdb-srv.el: Added ###autoload cookies. - * lisp/bbdb-vm.el: Added ###autoload cookies. - * lisp/bbdb-w3.el: Added ###autoload cookies. - * lisp/bbdb-whois.el: Added ###autoload cookies. - * lisp/bbdb-xemacs.el: Added ###autoload cookies. - * lisp/auto-autoloads.el: Regenerated with new autoloads. - -Tue Mar 31 23:46:05 1998 Matt Simmons - - * lisp/bbdb-migrate.el (bbdb-migrate-change-dates-change-field): - Use %S instead of %s for error messages. - -Tue Mar 17 00:00:00 1998 Colin Rafferty - - * lisp/bbdb-hooks.el (bbdb-timestamp-hook): Made - `format-time-string' take two arguments for XEmacs 19.15. - * lisp/bbdb-hooks.el (bbdb-creation-date-hook): Same. - -Mon Mar 16 20:02:00 1998 Matt Simmons - - * Makefile: Fix for compatibility with other makes - -Sun Mar 15 23:46:00 1998 Matt Simmons - - * lisp/bbdb.el: BBDB 2.00 released - -Fri Mar 13 01:52:00 1998 Matt Simmons - - * lisp/bbdb.el: BBDB 1.91unoff released - -Wed Mar 12 15:37:86 1998 Colin Rafferty - - * lisp/bbdb.el (parse-bbdb-internal): Fixed the error message on - mismatched bbdb-file-format. - -Fri Feb 06 00:00:00 1998 Colin Rafferty - - * bbdb-com.el (bbdb-current-field): Made it correctly count the - number of lines of a specially-formatted note field. - -Mon Mar 09 23:25:00 1998 Matt Simmons - - * lisp/bbdb.el: BBDB 1.90unoff released - * lisp/bbdb.el (defface): Fixed defface standin - * lisp/bbdb.el (bbdb-alist-with-header): Created widget for - bbdb-auto-notes-alist custom fix. - * lisp/bbdb.el (bbdb-create-hook): Default to bbdb-creation-date-hook - * lisp/bbdb.el (bbdb-change-hook): Default to bbdb-timestamp-hook - * lisp/bbdb.el (bbdb-initialize): Added autoload for bbdb-srv - * Makefile: Removed my paths - * Makefile: Added 19.34 comment about Custom - * Makefile: Started test harness for 19.34 and 20.2 - * INSTALL: Added 19.34 comment about Custom - * lisp/Makefile: Fixed 19.34 problem with custom (:link bug) - * lisp/bbdb-hooks.el (bbdb-auto-notes-alist): Fixed customization - * lisp/bbdb-srv.el (bbdb/srv-handle-headers): buffer-disable-undo - doesn't always return the argument - * texinfo/bbdb.texinfo: Finished revisions. - -Mon Mar 09 03:03:21 1998 Carsten Leonhardt - - * lisp/bbdb-xemacs.el (bbdb-fontify-buffer): don't access - scrollbars on XEmacsen without scrollbars - -Mon Mar 02 00:00:00 1998 Colin Rafferty - - * bbdb-com.el (bbdb-refile-notes-generate-alist): Created. - * bbdb-com.el (bbdb-refile-notes-default-merge-function): Created. - * bbdb-com.el (bbdb-refile-notes-remove-duplicates): Created. - * bbdb-com.el (bbdb-refile-notes-string-least): Create. - * bbdb-com.el (bbdb-refile-record): Use `bbdb-refile-notes-generate-alist' - and `bbdb-refile-notes-default-merge-function' for merging notes. - -Wed Feb 25 23:35:00 1998 Matt Simmons - - * lisp/bbdb-print.el (bbdb-print-alist-widget): Protect bbdb-default-area-code - * lisp/bbdb-print.el (bbdb-print-alist): Protect bbdb-default-area-code - * lisp/bbdb-com.el (bbdb-read-new-record): Protect bbdb-default-area-code - * lisp/bbdb-com.el (bbdb-prompt-for-new-field-value): Protect bbdb-default-area-code - * lisp/bbdb-com.el (bbdb-dial): Protect bbdb-default-area-code - -Sat Jan 16 00:00:00 1998 Colin Rafferty - - * lisp/Makefile (extras): fixed typo in bbdb-migrate.elc - -Sun Feb 22 20:58:00 1998 Matt Simmons - - * lisp/bbdb.el: BBDB 1.59unoff released - * lisp/bbdb.el: Created defface stand-in macro - * lisp/bbdb.el (bbdb-initialize): Reword - * lisp/bbdb.el (bbdb-initialize): Add keybinding for bbdb-print - * lisp/bbdb.el (bbdb-initialize): Add autoloads for - bbdb-show-all-recipients (bbdb-com), bbdb-ftp, bbdb-print - * lisp/bbdb.el (bbdb-initialize): Use bbdb-add-hook if none in Emacs - * lisp/bbdb-ftp.el: Changed comment - can use EFS - * lisp/bbdb-gnus.el: Changed GNUS/Gnus stuff around to reflect docs - * lisp/bbdb-gnus.el (bbdb/gnus-summary-author-in-bbdb): Now uses - `bbdb-message-marker-field' as documented - * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Use `add-hook', not - `bbdb-add-hook' - * lisp/bbdb-hooks.el: Use add-hook, not bbdb-add-hook - * lisp/bbdb-mhe.el: Use add-hook, not bbdb-add-hook - * lisp/bbdb-rmail.el: Use add-hook, not bbdb-add-hook - * lisp/bbdb-vm.el: Use add-hook, not bbdb-add-hook - * lisp/bbdb-xemacs.el: Use add-hook, not bbdb-add-hook - * lisp/bbdb-print.el: Moved key binding to bbdb.el - * lisp/bbdb-print.el: Changed default of `bbdb-print-elide' - * lisp/bbdb-print.el (bbdb-print-alist-widget): Fixed problem with - nil `bbdb-default-area-code' - * lisp/bbdb-sc.el: Fixed intro comments - * lisp/bbdb-sc.el: Use add-hook, not bbdb-add-hook - * Makefile: Alphabetized MUA directory variables, added OTHERDIR - variable - * lisp/Makefile: Support for OTHERDIR, rearranged flags to Emacs - so we can use bbdb-split-string (19.34 doesn't have split-string) - * texinfo/bbdb.texinfo: Almost finished doc rewrite - * misc/bbdb_gnus-summary-get-author.fig: Created - -Fri Feb 20 19:31:00 1998 Christopher Kline - - * texinfo/bbdb.texinfo: Documentation for BBDB-Reportmail - -Thu Feb 19 13:41:17 1998 Sam Steingold - - * lisp/bbdb.el (bbdb-version): Return a string if non-interactive - -Mon Jan 5 20:40:03 1998 Matt Simmons - - * lisp/bbdb.el: BBDB 1.58unoff released - * lisp/auto-autoloads.el: Removed all autoloads except `bbdb-initialize' - * lisp/bbdb-com.el: Fixed copyright - * lisp/bbdb-com.el: Removed autoloads - * lisp/bbdb-com.el: Finger group changed - * lisp/bbdb-com.el (bbdb-compare-records): Changed to backquote notation - * lisp/bbdb-ftp.el: Customized - * lisp/bbdb-ftp.el: Added provide of bbdb-ftp - * lisp/bbdb-gnus.el: Removed autoloads - * lisp/bbdb-gnus.el (bbdb/gnus-summary-prefer-real-names): Reformatted doc - * lisp/bbdb-gnus.el (bbdb/gnus-score-as-text): Remove `when' - * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Remove `when' - * lisp/bbdb-hooks.el: Added provide of bbdb-hooks - * lisp/bbdb-hooks.el (bbdb-time-internal-format): Replaces bbdb-time-string - * lisp/bbdb-hooks.el (bbdb-ignore-most-messages-alist): Fixed custom spec - * lisp/bbdb-hooks.el (bbdb-ignore-some-messages-alist): Fixed custom spec - * lisp/bbdb-hooks.el (bbdb-auto-notes-alist): Fixed custom spec - * lisp/bbdb-hooks.el (bbdb-auto-notes-ignore): Fixed custom spec - * lisp/bbdb-hooks.el (bbdb-auto-notes-ignore-all): Fixed custom spec - * lisp/bbdb-migrate.el: Created from migrate code in bbdb.el - * lisp/bbdb-print.el: Customized - * lisp/bbdb-print.el: Removed autoloads - * lisp/bbdb-reportmail.el: Changed setup docs, added RCS ID and Log strings - * lisp/bbdb-sc.el: Fixed jwz's e-mail address - * lisp/bbdb-sc.el: Customized - * lisp/bbdb-sc.el: Removed autoloads - * lisp/bbdb-sc.el: Added provide of bbdb-sc - * lisp/bbdb-snarf.el: Customized - * lisp/bbdb-snarf.el: Removed autoloads - * lisp/bbdb-srv.el: Rearranged copyright - * lisp/bbdb-srv.el: Customized - * lisp/bbdb-w3.el: Removed autoloads - * lisp/bbdb-w3.el: Added provide of bbdb-w3 - * lisp/bbdb-whois.el: Added to copyright - * lisp/bbdb-whois.el: Customized - * lisp/bbdb-xemacs.el: Removed autoloads - * lisp/bbdb.el: Added define-widget definition for users without Custom - * lisp/bbdb.el: Added utilities custom groups - * lisp/bbdb.el: Removed migration code - * lisp/bbdb.el: Commented some code - * lisp/bbdb.el (bbdb-string-trim): Delete still more text properties - * lisp/bbdb.el (bbdb-save-db): Made error message slightly more obvious - * lisp/bbdb.el (bbdb-initialize): Added symbols for selective insinuation - * lisp/bbdb.el (bbdb-initialize): Rearranged and added some autoloads - * Makefile: Added migrate.el - * Makefile: Added deploy target - * texinfo/bbdb.texinfo: Changed `setq' to `add-hook' in setup instructions - * texinfo/bbdb.texinfo: Added to Internals section - -Mon Dec 1 09:00:12 1997 Matt Simmons - - * lisp/bbdb.el: BBDB 1.57Aunoff released - * texinfo/bbdb.texinfo: Documented new startup procedure - * INSTALL: Documented new startup procedure - -Sun Nov 30 23:26:21 1997 Matt Simmons - - * lisp/bbdb.el: BBDB 1.57unoff released - -Sun Nov 30 22:47:04 1997 Sam Steingold - - * lisp/bbdb-hooks.el (bbdb-time-string): Uses format string now - * lisp/bbdb-com.el (bbdb-display-some): Added - * lisp/bbdb-com.el (bbdb-kill-older): Created - * lisp/bbdb-com.el (bbdb-timestamp-older): Created - * lisp/bbdb-com.el (bbdb-timestamp-newer): Created - * lisp/bbdb-com.el (bbdb-creation-older): Created - * lisp/bbdb-com.el (bbdb-creation-newer): Created - -Sun Nov 30 22:44:42 1997 Matt Simmons - - * lisp/auto-autoloads.el: Autoloads for date functions - * lisp/bbdb-com.el (bbdb-complete-clicked-name): Make 19.34 happy - * lisp/bbdb-com.el (bbdb-compare-records): Created - * lisp/bbdb-com.el: Customized variables - * lisp/bbdb-gnus.el: Customized variables - * lisp/bbdb-hooks.el: Customized variables - * lisp/bbdb.el: Customized variables - * lisp/bbdb.el: Added timezone require to support date functions - * lisp/bbdb.el: Added migration functions, changed database version - * lisp/bbdb.el: Added definitions for utility functions that don't - appear in all Emacsen (in the case of string>, in none) - * lisp/bbdb.el (defstruct): Added documentation - * lisp/bbdb.el (bbdb-format-record): Can now define printing - functions for each note field - (bbdb-format-record-fieldname) - * lisp/bbdb.el (bbdb-copy-thing): Created - * lisp/bbdb.el (bbdb-initialize): Created - Use it to initialize - * texinfo/Makefile (clean): Changed since we now distribute *.info* - * texinfo/Makefile (reallyclean): clean + removes *.info* - * texinfo/bbdb.texinfo: Removed `BBDB database' per jwz, added - prereq section, more special fields, some - internals. - * INSTALL: Created - -Thu Oct 30 07:06:15 1997 Hrvoje Niksic - - * lisp/bbdb.el: Custom blob to make defcustom and defgroup - transparent in non-customized Emacsen - -Sun Nov 30 12:03:41 1997 Soren Dayton - - * lisp/bbdb-print.el (bbdb-print-tex-quote): Escape tildes properly - -Tue Nov 10 20:10:53 1997 Jens-Ulrik Holger Petersen - - * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Improve output of - warning messages. - * lisp/bbdb-gnus.el (bbdb/gnus-summary-known-poster-mark): Correct - docstring. - -Sat Nov 8 17:00:21 1997 Matt Simmons - - * lisp/bbdb.el (bbdb-string-trim): Just remove 'face property. - * lisp/bbdb.el: Define `defvaralias' as empty function if it's not - defined. (GNU Emacs doesn't have it) - -Sun Nov 2 01:32:23 1997 Matt Simmons - - * lisp/bbdb.el: BBDB 1.56unoff released - * lisp/bbdb-sc.el: Added - * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Commented back in score - hook addition, can now set up format functions one at a time - (latter based on function from Christoph Wedler) - * lisp/bbdb-gnus.el (bbdb/gnus-score-default-internal): Added to - automagically catch changes to `bbdb/gnus-score-default'. - * lisp/bbdb-gnus.el (bbdb/gnus-annotate-sender): Now takes REPLACE - argument. - * lisp/bbdb-vm.el (bbdb/vm-annotate-sender): Ditto - * lisp/bbdb-mhe.el (bbdb/mh-annotate-sender): Ditto - * lisp/bbdb-rmail.el (bbdb/rmail-annotate-sender): Ditto - * lisp/auto-autoloads.el: Support for bbdb-sc, housekeeping for others. - * Makefile (install-pkg): Bug fix. - * texinfo/bbdb.texinfo: More rewriting, documentation for the - Summary Buffer stuff in bbdb-gnus.el - -Tue Oct 28 16:08:54 1997 Christoph Wedler - - * lisp/bbdb-gnus.el (bbdb/gnus-define-format-functions): New - variable. - * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Use it. Only define user - functions the first time. Use `bbdb-warn' instead `error'. - * lisp/bbdb.el (bbdb-warn): New function. Use it. - -Sun Oct 26 20:47:20 1997 Matt Simmons - - * lisp/auto-autoloads.el: Remove summary buffer autoloads - * lisp/bbdb-gnus.el: Variable aliases for backward compatibility - * lisp/bbdb-gnus.el (bbdb/gnus-summary-user-format-letter): Add - more descriptive documentation. - * lisp/bbdb-gnus.el (bbdb/gnus-summary-in-bbdb-format-letter): Added - * lisp/bbdb-gnus.el (bbdb/gnus-lines-and-from): Variable name change - * lisp/bbdb-gnus.el (bbdb/gnus-summary-author-in-bbdb): Added - * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Commented out score - insinuation, add %ub summary line code creation - * lisp/bbdb.el: Remove summary buffer autoloads - -Sun Oct 26 00:14:36 1997 Matt Simmons - - * lisp/bbdb.el: BBDB 1.55unoff released - * texinfo/bbdb.texinfo: Partial rewrite - * lisp/bbdb.el: new autoloads. Override bbdb-display-completion-list - for XEmacs users. - * lisp/bbdb-w3.el (bbdb-www): Uses browse-url-browser-function - instead of a manual funcall - * lisp/bbdb-snarf.el (bbdb-snarf-region): Toss trailing space too - -Sat Oct 25 23:47:40 1997 Brian Edmonds -Sat Oct 25 23:47:40 1997 Matt Simmons - - * lisp/bbdb-gnus.el: Changed *everything* beginning with - `gnus-bbdb' to `bbdb/gnus' - * lisp/bbdb-gnus.el (bbdb/gnus-summary-get-author): Integrated (along - with associated variables and functions) - * lisp/bbdb-gnus.el (bbdb/gnus-score): Integrated (along with - associated variables and functions) - * lisp/bbdb-gnus.el (bbdb-insinuate-gnus): Activate above new - features - -Sat Oct 25 17:54:26 1997 Marco Walther -Sat Oct 25 17:54:26 1997 Matt Simmons - - * lisp/bbdb-com.el (bbdb-complete-name): Clicking on name in - completion buffer now restores configuration (uses callback below) - * lisp/bbdb-com.el (bbdb-complete-clicked-name): Created. See above - * lisp/bbdb-com.el (bbdb-display-completion-list): Wrapper - * lisp/bbdb-xemacs.el (bbdb-xemacs-display-completion-list): - XEmacs version of bbdb-display-completion-list, allows callbacks - * lisp/auto-autoloads.el: autoload for XEmacs version of - bbdb-display-completion-list - -Mon Oct 20 18:38:28 1997 Colin Rafferty - - * Makefile (install-pkg): Made it install the el before the .elc. - -Mon Oct 20 12:15:15 1997 Christoph Wedler - - * lisp/bbdb-xemacs.el (global-bbdb-menu-commands): Bug fix "Finger - All Records". - * lisp/bbdb-xemacs.el (build-bbdb-finger-menu): Use - `bbdb-record-finger-host'. - * lisp/bbdb-com.el (bbdb-finger): Doc string extension. - * texinfo/bbdb.texinfo (BBDB Mode): Add documentation for - `bbdb-finger'. - -Tue Oct 14 20:06:38 1997 david carlton - - * Makefile (install-pkg): Fix info linking - use texinfo, not info - -Mon Oct 13 16:41:27 1997 Soren Dayton - - * lisp/bbdb-w3.el (bbdb-www): Use browse-url instead of funcalling - contents of browse-url-browser-function. - -Sat Oct 11 19:19:27 1997 Matt Simmons - - * bbdb.el: BBDB 1.54unoff released - * lisp/Makefile: Changed VM, GNUS, and MHE definitions so they can - be blank if the packages are in load-path. Added bbdb-snarf and - bbdb-w3. Made bbdb-srv and bbdb-reportmail skipping messages more - informative. Added check for itimer for bbdb-srv. - * lisp/bbdb-w3.el (bbdb-insinuate-w3): Created from bare add-hook - statement found in David's version. Add this to w3-mode-hook - (yes, that's singular, not plural) - * lisp/bbdb-w3.el (bbdb-www): Modified to use - browse-url-browser-function instead of having two functions, one - for netscape and one for w3. - * lisp/bbdb-snarf.el: Fixed area code pattern to use [2-9] instead - of [0-9] for first digit. - * lisp/auto-autoloads.el: Autoloads for bbdb-snarf, bbdb-www, - changed package dir from `bbdb-1.52' to `bbdb', autoload for - bbdb-insinuate-message. - * lisp/bbdb.el: Added autoloads for bbdb-insinuate-message, - bbdb-www, bbdb-www-grab-homepage, bbdb-insinuate-w3, bbdb-snarf. - * lisp/bbdb.el (bbdb-mode): Documentation for bbdb-www `w' keystroke - * lisp/bbdb.el (bbdb-mode-map): bbdb-www invocation - * lisp/bbdb.el (bbdb-split): Documented. - * lisp/bbdb-gnus.el (bbdb-insinuate-message): Use it. Sets the - M-t binding for message-mode. This isn't in bbdb-insinuate-gnus - because some like to use message-mode before loading gnus. Add - it to `message-setup-hook', _not_ `message-load-hook'. - -Sat Oct 11 19:01:00 1997 David Carlton - - * lisp/bbdb-w3.el: Added to bbdb distribution. I don't know who - the original author is, but David mailed it to me. - -Sat Oct 11 19:00:00 1997 John Heidemann - - * lisp/bbdb-snarf.el: Added to bbdb distribution. Grabs text from - paragraph around point and makes a bbdb record out of it. See - the source for docs until I get around to adding to the texinfo - file. - -Sat Oct 11 18:50:52 1997 Kees de Bruin - - * lisp/bbdb-vm.el (bbdb/vm-alternate-full-name): make VM use the - canonicalized net address instead of the default address. - * lisp/bbdb-com.el (bbdb-sendmail-internal): Still more - message-mode fixes. Default to message-mode if neither mh-e nor - vm are in `features'. If message-mode is to be used and it's not - loaded, autoload it. - -Thu Oct 9 06:37:00 1997 Matt Simmons - * lisp/Makefile: Check for itimer before building bbdb-srv. - Complain nicely when check fails. - -Sun Oct 5 20:16:00 1997 Matt Simmons - * bbdb.el: BBDB 1.53unoff released - -Sun Oct 5 19:53:12 1997 Boris Goldowsky - * tex/bbdb-cols.tex, tex/bbdb-print-brief.tex, tex/bbdb-print.tex, - lisp/bbdb-print.el: New version of bbdb-print - -Sun Oct 5 19:51:21 1997 Jamie Zawinski - * utils/bbdb-cid.pl, utils/bbdb-src.pl, utils/bbdb-to-netscape.el: - New utilities - * lisp/bbdb-com.el (bbdb-parse-phone-number): Changed comment to - reflect new area codes that don't have [012] as their second digit - * lisp/bbdb-srv.el (bbdb/srv-auto-create-mail-news-dispatcher): - Classification of messages as mail or news - * lisp/bbdb-srv.el (bbdb-src-add-phone): Supports caller ID util - * lisp/bbdb-srv.el (bbdb/srv-handle-headers): Make sure *BBDB* is - bottommost buffer - -Sun Oct 5 19:51:20 1997 Seth Golub - * utils/bbdb-areacode-split.pl: New utility - -Sun Oct 5 19:51:19 1997 Matt Simmons - - * A grand reorg: .tex files -> tex subdirectory, - .texinfo files -> texinfo subdirectory, - .el files -> lisp subdirectory, - * Makefile: modified all Makefiles to deal with reorg, - rewrote XEmacs package section - * lisp/bbdb.el (bbdb-frob-mode-line): I like version numbers on modelines - * lisp/bbdb.el (bbdb-version-date): Separate date from version number - * lisp/bbdb.el (bbdb-version): Modified to deal with version - number separate from date - -Mon Sep 29 18:49:47 1997 Matt Simmons - - * Makefile: patch to avoid building bbdb-srv and bbdb-reportmail - if gnuserv and reportmail (respectively) aren't present - * bbdb.el (bbdb-frob-mode-line): Print the version number on the - mode line - -Sun Sep 28 00:50:07 1997 Matt Simmons - - * bbdb.el: BBDB 1.52unoff released - * bbdb.el (bbdb-y-or-n-p): Fix obsolete functions - * bbdb-ftp.el: Added check for efs - * Makefile: renamed it, removed mail-extr and mail-abbrev, did - some reformatting - -Sun Sep 28 00:49:00 1997 Colin Rafferty - - * auto-autoloads.el, Makefile: Use BBDB as an XEmacs package - -Sun Sep 28 00:03:31 1997 Jens-Ulrik Hoger Petersen - - * bbdb-gnus.el (bbdb/gnus-update-record): Changed method for - referencing article buffer. Needed when - gnus-single-article-buffer is nil. - * bbdb-hooks.el (bbdb-header-start): See above. - -Sat Sep 27 23:56:35 1997 Christopher Kline - - * bbdb-reportmail.el: Created - -Sat Sep 27 23:47:01 1997 Soren Dayton - - * bbdb-com.el (bbdb-send-mail-internal): Allow use of message-mail - * bbdb.el (bbdb-send-mail-style): Documentation change. See above. - -Sat Sep 27 23:44:43 1997 Colin Rafferty - - * bbdb.el (bbdb-annotate-message-sender): Use address for name if no name - -Sat Sep 27 23:39:09 1997 Christoph Wedler - - * bbdb-com.el (bbdb-finger-host-field): Added code to check for - finger-host field. Finger is done on finger-host if it - exists, on net address otherwise. - -Sat Sep 27 20:06:05 1997 Matt Simmons - - * bbdb-com.el (bbdb-phone-area-regexp): Fix US area code pattern diff --git a/xemacs-packages/lisp/bbdb/INSTALL b/xemacs-packages/lisp/bbdb/INSTALL deleted file mode 100644 index 9cba0732..00000000 --- a/xemacs-packages/lisp/bbdb/INSTALL +++ /dev/null @@ -1,166 +0,0 @@ -This file has three sets of installation instructions: with `make', -without `make', and uncompiled. Please follow the appropriate set of -instructions. If you plan on running BBDB directly from CVS, please -check the additional instructions below. - -=============================================================================== - -Running BBDB from CVS: - - *** PLEASE NOTE **** - This applies to the master CVS tree at sourceforge, not the XEmacs CVS tree. - *** PLEASE NOTE *** - - This is not recommended, unless you're a BBDB developer. You will - need to either install the GNU autoconf package, or download the - pregenerated copy of configure from the BBDB website. If you choose - the former option, you'll need to run `autoconf' to generate the - configure script. Thereafter, follow the appropriate set of - instructions below. - -=============================================================================== - -To compile and install the BBDB on systems with `make': - - 1) Configure the compilation process: - - First of all, you should run the `configure' script at the toplevel of - the distribution. This script will perform a number of checks on your - system and generate the Makefile's accordingly. - - The `configure' script comes with a number of options that might be of - interest to you: - - `--with-emacs=PROG' lets you select an Emacs program to use. By - default, "emacs" and "xemacs" will be tried in that order. - - `--with-{gnus,mhe,vm}-dir=DIR' let you specify the paths where Gnus, - MH-E and VM can respectively be found, if Emacs can't find them by - itself (like, if they're not in the load-path by default). - - `--with-other-dirs=DIRS' lets you specify additional paths (space or - colon spearated) to find other libraries that might be needed (see - the "Byte Compiling the Lisp files" section of the BBDB manual for - more information). - - NOTE: Gnu Emacs 19.34 users should add the path to Custom 1.9962 - here if they plan to build Gnus support. Gnus support will not build - under Gnu Emacs 19.34 without Custom 1.9962. - - `--with-package-dir=DIR' lets you specify the installation path for - for XEmacs package installation. By default, - "/usr/local/lib/xemacs/site-packages" is used. - - `--with-symlinks' will make the installation process use symbolic links - to the sources instead of copying the files. - - `--with-linkpath=PATH' lets you specify the path to link from, if your - `pwd' command doesn't work properly. - - - 2) Build the BBDB: - - To build the BBDB with support for all of the supported mail - and news programs (gnus, mh-e, rmail, and vm), issue the - command 'make all'. (The BBDB also supports sendmail mode - - support for it is automatically compiled in, regardless of the - build options supplied) To build with support only for gnus, - mh-e, rmail, and/or vm, issue the 'make' command with one or - more of the following arguments: 'gnus', 'mh-e', 'rmail', - and/or 'vm'. To build the BBDB without support for any mail - program (except for sendmail mode), issue the command - 'make bbdb'. - - - 3) Install the BBDB: - - The three most typical installations are outlined below: - - a) In-place. - i) Follow steps 1 and 2 - ii) Add the lisp subdirectory to the Emacs load-path - iii) Add the tex subdirectory to the TeX - search path (can be done by adding the complete path - to the tex subdirectory to the environment variable - TEXINPUTS) - iv) Add the texinfo directory to the Info search path. - b) "Normal". - i) Follow steps 1 and 2. - ii) Copy the .el and .elc files from the lisp - subdirectory to a directory on the Emacs load-path - (or make a new directory, copy the files to it, and - add the new directory to the load-path). - iii) Copy the .tex files from the tex subdirectory to a - directory on the TeX search path (or make a new - directory, copy the files to it, and add the new - directory to the TeX search path. - iv) Copy the .info and .info-* files from the texinfo - subdirectory to a directory on the Info search path - (or make a new directory, copy the files to it, and - add the new directory to the Info search path) - c) XEmacs Package - NOTE: This installation option is only available to users - running XEmacs 20.3 or higher. - i) Follow steps 1 and 2. - ii) Issue the 'make install-pkg' command. - - - -To compile and install the BBDB on systems without `make': - - If at all possible, use make to automatically build the BBDB as - outlined above. While it looks like there are fewer steps in the - non-make instructions below, they're more tedious and involved. - - 1) Compile the .el files using the byte-compile-file function in - Emacs. - - 2) Install the BBDB as outlined in step 3 above. - -=============================================================================== - -To run BBDB uncompiled: - - Again, this is really not recommended, although it will generate a - more meaningful stacktrace if you happen to run into a problem. In - order to run BBDB uncompiled, you'll need to do two things: - - 1) Generate bbdb-autoloads.el - You can do this by typing 'make autoloads' in the main BBDB - directory. Note that this will require you to have previously run - configure to generate Makefiles. - - 2) Add .../bbdb/lisp to your load path - You need to make sure that the lisp subdirectory of the BBDB - source is in your load path so that Emacs can find the BBDB - files. - - Since arbitrary chunks of the BBDB are macros, you'll probably find - the uncompiled version slower than the compiled version. - -=============================================================================== - -*************************************************************************** -* * -* THE BBDB INITIALIZATION PROCEDURE CHANGED IN 1.57unoff. * -* * -* YOU *MUST* ADD * -* * -* (require 'bbdb) * -* (bbdb-initialize) * -* * -* TO YOUR BBDB INITIALIZATION CODE. THIS TAKES THE PLACE OF ALL BBDB * -* AUTOLOADS. IT DOES *NOT* TAKE THE PLACE OF THE INSINUATION CODE. * -* * -* If you do not add this code, you will receive keymap errors * -* (among other things) * -* * -*************************************************************************** - -For information on post-installation BBDB configuration and setup, see -the info file. (M-x bbdb, and press 'i' in the BBDB info window) - -Questions, Comments, Suggestions, and Bug Reports may be directed to -the BBDB mailing list at bbdb-info@lists.sourceforge.net. To -subscribe, send mail to bbdb-info-request@lists.sourceforge.net, with -'subscribe' as the subject. diff --git a/xemacs-packages/lisp/bbdb/README b/xemacs-packages/lisp/bbdb/README deleted file mode 100644 index 95dee723..00000000 --- a/xemacs-packages/lisp/bbdb/README +++ /dev/null @@ -1 +0,0 @@ -Read the INSTALL file. diff --git a/xemacs-packages/lisp/bbdb/_pkg.el b/xemacs-packages/lisp/bbdb/_pkg.el deleted file mode 100644 index f3a7e398..00000000 --- a/xemacs-packages/lisp/bbdb/_pkg.el +++ /dev/null @@ -1,5 +0,0 @@ -;;;###autoload -(package-provide 'bbdb - :version 1.29 - :author-version "2.34" - :type 'regular) diff --git a/xemacs-packages/lisp/bbdb/auto-autoloads.el b/xemacs-packages/lisp/bbdb/auto-autoloads.el deleted file mode 100644 index 7259c97e..00000000 --- a/xemacs-packages/lisp/bbdb/auto-autoloads.el +++ /dev/null @@ -1,764 +0,0 @@ -;;; DO NOT MODIFY THIS FILE -(if (featurep 'bbdb-autoloads) (error "Already loaded")) - -;;;### (autoloads nil "_pkg" "lisp/_pkg.el") - -(package-provide 'bbdb :version 1.29 :author-version "2.34" :type 'regular) - -;;;*** - -;;;### (autoloads (bbdb-update-records bbdb-help bbdb-info bbdb-creation-no-change bbdb-creation-newer bbdb-creation-older bbdb-timestamp-newer bbdb-timestamp-older bbdb-finger bbdb-dial bbdb-add-or-remove-mail-alias bbdb-define-all-aliases bbdb-yank bbdb-complete-name bbdb-read-addresses-with-completion bbdb-completion-predicate bbdb-completion-check-record bbdb-show-all-recipients bbdb-send-mail bbdb-dwim-net-address bbdb-sort-addresses bbdb-sort-phones bbdb-sort-notes bbdb-refile-record bbdb-omit-record bbdb-display-record-with-layout bbdb-display-record-completely bbdb-display-all-records-completely bbdb-toggle-records-display-layout bbdb-toggle-all-records-display-layout bbdb-delete-current-record bbdb-delete-current-field-or-record bbdb-transpose-fields bbdb-record-edit-property bbdb-record-edit-notes bbdb-edit-current-field bbdb-insert-new-field bbdb-append-records bbdb-append-records-p bbdb-apply-next-command-to-all-records bbdb-create bbdb-redisplay-records bbdb-changed bbdb-notes bbdb-net bbdb-company bbdb-name bbdb bbdb-search-invert-set) "bbdb-com" "lisp/bbdb-com.el") - -(autoload 'bbdb-search-invert-set "bbdb-com" "\ -Typing \\\\[bbdb-search-invert-set] inverts the meaning of the next search command. -Sets `bbdb-search-invert' to t. -You will have to call this function again, if you want to -do repeated inverted searches." t nil) - -(autoload 'bbdb "bbdb-com" "\ -Display all entries in the BBDB matching the regexp STRING -in either the name(s), company, network address, or notes." t nil) - -(autoload 'bbdb-name "bbdb-com" "\ -Display all entries in the BBDB matching the regexp STRING in the name -\(or ``alternate'' names)." t nil) - -(autoload 'bbdb-company "bbdb-com" "\ -Display all entries in BBDB matching STRING in the company field." t nil) - -(autoload 'bbdb-net "bbdb-com" "\ -Display all entries in BBDB matching regexp STRING in the network address." t nil) - -(autoload 'bbdb-notes "bbdb-com" "\ -Display all entries in BBDB matching STRING in the named notes field." t nil) - -(autoload 'bbdb-changed "bbdb-com" "\ -Display all entries in the bbdb database which have been changed since -the database was last saved." t nil) - -(autoload 'bbdb-redisplay-records "bbdb-com" "\ -Regrinds the contents of the *BBDB* buffer, without scrolling. -If possible, you should call `bbdb-redisplay-one-record' instead." nil nil) - -(autoload 'bbdb-create "bbdb-com" "\ -Add a new entry to the bbdb database ; prompts for all relevant info -using the echo area, inserts the new record in the db, sorted alphabetically, -and offers to save the db file. DO NOT call this from a program. Call -bbdb-create-internal instead." t nil) - -(autoload 'bbdb-apply-next-command-to-all-records "bbdb-com" "\ -Typing \\\\[bbdb-apply-next-command-to-all-records] in the *BBDB* buffer makes the next command operate on all -of the records currently displayed. (Note that this only works for -certain commands.)" t nil) - -(autoload 'bbdb-append-records-p "bbdb-com" nil nil nil) - -(autoload 'bbdb-append-records "bbdb-com" "\ -Typing \\\\[bbdb-append-records] in the *BBDB* buffer makes the next search/display command to append -new records to those in the *BBDB* buffer. - -With an prefix arg (C-u) toggle between always append and no append. -With an prefix arg that is a positive number append will be enabled for that -many times. -With any other argument append will be enabled once." t nil) - -(autoload 'bbdb-insert-new-field "bbdb-com" "\ -Add a new field to the current record; the field type and contents -are prompted for if not supplied. - -If you are inserting a new phone-number field, you can control whether -it is a north american or european phone number by providing a prefix -argument. A prefix arg of ^U means it's to be a euronumber, and any -other prefix arg means it's to be a a structured north american number. -Otherwise, which style is used is controlled by the variable -`bbdb-north-american-phone-numbers-p'. - -If you are inserting a new net address, you can have BBDB append a -default domain to any net address that does not contain one. Set -`bbdb-default-domain' to a string such as \"mycompany.com\" (or, -depending on your environment, (getenv \"DOMAINNAME\")), and -\"@mycompany.com\" will be appended to an address that is entered as -just a username. A prefix arg of ^U (or a `bbdb-default-domain' -value of \"\", the default) means do not alter the address." t nil) - -(autoload 'bbdb-edit-current-field "bbdb-com" "\ -Edit the contents of the Insidious Big Brother Database field displayed on -the current line (this is only meaningful in the \"*BBDB*\" buffer.) If the -cursor is in the middle of a multi-line field, such as an address or comments -section, then the entire field is edited, not just the current line." t nil) - -(autoload 'bbdb-record-edit-notes "bbdb-com" nil t nil) - -(autoload 'bbdb-record-edit-property "bbdb-com" nil t nil) - -(autoload 'bbdb-transpose-fields "bbdb-com" "\ -This is like the `transpose-lines' command, but it is for BBDB fields. -If the cursor is on a field of a BBDB record, that field and the previous -field will be transposed. - -With argument ARG, takes previous line and moves it past ARG fields. -With argument 0, interchanges field point is in with field mark is in. - -Both fields must be in the same record, and must be of the same basic type -\(that is, you can use this command to change the order in which phone-number -fields are listed, but you can't use it to make an address appear before a -phone number; the order of field types is fixed.)" t nil) - -(autoload 'bbdb-delete-current-field-or-record "bbdb-com" "\ -Delete the line which the cursor is on; actually, delete the field which -that line represents from the database. If the cursor is on the first line -of a database entry (the name/company line) then the entire entry will be -deleted." t nil) - -(autoload 'bbdb-delete-current-record "bbdb-com" "\ -Delete the entire bbdb database entry which the cursor is within. -Pressing \\\\[bbdb-apply-next-command-to-all-records] will -delete all records listed in the BBDB buffer." t nil) - -(autoload 'bbdb-toggle-all-records-display-layout "bbdb-com" "\ -Show all the fields of all visible records. -Like `bbdb-toggle-records-display-layout' but for all visible records." t nil) - -(autoload 'bbdb-toggle-records-display-layout "bbdb-com" "\ -Toggle whether the current record is displayed expanded or elided -\(multi-line or one-line display.) With a numeric argument of 0, the -current record will unconditionally be made elided; with any other argument, -the current record will unconditionally be shown expanded. -\\ -If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-toggle-records-display-layout]\" is used instead of simply \"\\[bbdb-toggle-records-display-layout]\", then the state of all records will -be changed instead of just the one at point. In this case, an argument -of 0 means that all records will unconditionally be made elided; any other -numeric argument means that all of the records will unconditionally be shown -expanded; and no numeric argument means that the records are made to be in -the opposite state of the record under point." t nil) - -(autoload 'bbdb-display-all-records-completely "bbdb-com" "\ -Show all the fields of all currently displayed records. -The display layout `full-multi-line' is used for this." t nil) - -(autoload 'bbdb-display-record-completely "bbdb-com" "\ -Show all the fields of the current record. -The display layout `full-multi-line' is used for this." t nil) - -(autoload 'bbdb-display-record-with-layout "bbdb-com" "\ -Show all the fields of the current record using LAYOUT." t nil) - -(autoload 'bbdb-omit-record "bbdb-com" "\ -Remove the current record from the display without deleting it from the -database. With a prefix argument, omit the next N records. If negative, -omit backwards." t nil) - -(autoload 'bbdb-refile-record "bbdb-com" "\ -Merge the current record into some other record; that is, delete the -record under point after copying all of the data within it into some other -record. this is useful if you realize that somehow a redundant record has -gotten into the database, and you want to merge it with another. - -If both records have names and/or companies, you are asked which to use. -Phone numbers, addresses, and network addresses are simply concatenated. -The first record is the record under the point; the second is prompted for. -Completion behaviour is as dictated by the variable `bbdb-completion-type'." t nil) - -(autoload 'bbdb-sort-notes "bbdb-com" "\ -Sort the notes in the record according to `bbdb-notes-sort-order'. -Can be used in `bbdb-change-hook'." nil nil) - -(autoload 'bbdb-sort-phones "bbdb-com" "\ -Sort the phones in the record according to the location. -Can be used in `bbdb-change-hook'." nil nil) - -(autoload 'bbdb-sort-addresses "bbdb-com" "\ -Sort the addresses in the record according to the location. -Can be used in `bbdb-change-hook'." nil nil) - -(autoload 'bbdb-dwim-net-address "bbdb-com" "\ -Returns a string to use as the email address of the given record. The -given address is the address the mail is destined to; this is formatted like -\"Firstname Lastname \" unless both the first name and last name are -constituents of the address, as in John.Doe@SomeHost, or the address is -already in the form \"Name \" or \"foo (Name)\", in which case the -address is used as-is. If `bbdb-dwim-net-address-allow-redundancy' is non-nil, -the name is always included. If `bbdb-dwim-net-address-allow-redundancy' is -'netonly the name is never included!" nil nil) - -(autoload 'bbdb-send-mail "bbdb-com" "\ -Compose a mail message to the person indicated by the current bbdb record. -The first (most-recently-added) address is used if there are more than one. -\\ -If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-send-mail]\" is used instead of simply \"\\[bbdb-send-mail]\", then mail will be sent to all of the -folks listed in the *BBDB* buffer instead of just the person at point." t nil) - -(autoload 'bbdb-show-all-recipients "bbdb-com" "\ -*Display BBDB records for all recipients of the message in this buffer." t nil) - -(autoload 'bbdb-completion-check-record "bbdb-com" nil nil nil) - -(autoload 'bbdb-completion-predicate "bbdb-com" "\ -For use as the third argument to `completing-read'. -Obey the semantics of `bbdb-completion-type'." nil nil) - -(autoload 'bbdb-read-addresses-with-completion "bbdb-com" "\ -Like `read-string', but allows `bbdb-complete-name' style completion." nil nil) - -(autoload 'bbdb-complete-name "bbdb-com" "\ -Complete the user full-name or net-address before point (up to the -preceeding newline, colon, or comma, or the value of START-POS). If -what has been typed is unique, insert an entry of the form \"User Name -\" (although see documentation for -bbdb-dwim-net-address-allow-redundancy). If it is a valid completion -but not unique, a list of completions is displayed. - -If the completion is done and `bbdb-complete-name-allow-cycling' is -true then cycle through the nets for the matching record. - -When called with a prefix arg then display a list of all nets. - -Completion behaviour can be controlled with `bbdb-completion-type'." t nil) - -(autoload 'bbdb-yank "bbdb-com" "\ -Insert the current contents of the *BBDB* buffer at point." t nil) - -(autoload 'bbdb-define-all-aliases "bbdb-com" "\ -Define mail aliases for some of the records in the database. -Every record which has a `mail-alias' field will have a mail alias -defined for it which is the contents of that field. If there are -multiple comma-separated words in the `mail-alias' field, then all -of those words will be defined as aliases for that person. - -If multiple entries in the database have the same mail alias, then -that alias expands to a comma-separated list of the network addresses -of all of those people." t nil) - -(autoload 'bbdb-add-or-remove-mail-alias "bbdb-com" "\ -Add NEWALIAS in all RECORDS or remove it if DELETE it t. -When called with prefix argument it will remove the alias. -We honor `bbdb-apply-next-command-to-all-records'! -The new alias will only be added if it isn't there yet." t nil) - -(autoload 'bbdb-dial "bbdb-com" "\ -Dial the number at point. -If the point is at the beginning of a record, dial the first -phone number. Does not dial the extension. Does not apply the -transformations from bbdb-dial-local-prefix-alist if a prefix arg -is given." t nil) - -(autoload 'bbdb-finger "bbdb-com" "\ -Finger the network address of a BBDB record. -If this command is executed from the *BBDB* buffer, finger the network -address of the record at point; otherwise, it prompts for a user. -With a numeric prefix argument, finger the Nth network address of the -current record; with a prefix argument of ^U, finger all of them. -The *finger* buffer is filled asynchronously, meaning that you don't -have to wait around for it to finish; but fingering another user before -the first finger has finished could have unpredictable results. -\\ -If this command is executed from the *BBDB* buffer, it may be prefixed -with \"\\[bbdb-apply-next-command-to-all-records]\" (as in \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-finger]\" instead of simply \"\\[bbdb-finger]\"), meaning to finger all of -the users currently listed in the *BBDB* buffer instead of just the one -at point. The numeric prefix argument has the same interpretation. - -You can define a special network address to \"finger\" by defining a -field `finger-host' (default value of `bbdb-finger-host-field')." t nil) - -(autoload 'bbdb-timestamp-older "bbdb-com" "\ -*Display records with timestamp older than DATE. -DATE must be in yyyy-mm-dd format." t nil) - -(autoload 'bbdb-timestamp-newer "bbdb-com" "\ -*Display records with timestamp newer than DATE. -DATE must be in yyyy-mm-dd format." t nil) - -(autoload 'bbdb-creation-older "bbdb-com" "\ -*Display records with creation-date older than DATE. -DATE must be in yyyy-mm-dd format." t nil) - -(autoload 'bbdb-creation-newer "bbdb-com" "\ -*Display records with creation-date newer than DATE. -DATE must be in yyyy-mm-dd format." t nil) - -(autoload 'bbdb-creation-no-change "bbdb-com" "\ -*Display records that have the same timestamp and creation-date." t nil) - -(autoload 'bbdb-info "bbdb-com" nil t nil) - -(autoload 'bbdb-help "bbdb-com" nil t nil) - -(defcustom bbdb-update-records-mode 'annotating "Controls how `bbdb-update-records' processes email addresses.\nSet this to an expression which evaluates either to 'searching or\n'annotating. When set to 'annotating email addresses will be fed to\n`bbdb-annotate-message-sender' in order to update existing records or create\nnew ones. A value of 'searching will search just for existing records having\nthe right net.\n\nThere is a version of this variable for each MUA, which overrides this variable\nwhen set!\n\nThis variable is also used for inter-function communication between the\nfunctions `bbdb-update-records' and `bbdb-prompt-for-create'." :group 'bbdb-mua-specific :type '(choice (const :tag "annotating all messages" annotating) (const :tag "annotating no messages" searching) (sexp :tag "user defined"))) - -(autoload 'bbdb-update-records "bbdb-com" "\ -Returns the records corresponding to the list of addresses ADDRS, -creating or modifying them as necessary. A record will be created if -AUTO-CREATE-P is non-nil or if OFFER-TO-CREATE is true and the user -confirms the creation. - -The variable `bbdb/gnus-update-records-mode' controls what actions -are performed and it might override `bbdb-update-records-mode'. - -When hitting C-g once you will not be asked any more for new people listed -in this message, but it will search only for existing records. When hitting -C-g again it will stop scanning." nil nil) - -(defcustom bbdb-get-addresses-headers '((authors "From" "Resent-From" "Reply-To") (recipients "Resent-To" "Resent-CC" "To" "CC" "BCC")) "*List of headers to search for senders and recipients email addresses.\nThe headers are grouped into two classes, the authors and the senders headers." :group 'bbdb-mua-specific :type 'list) - -(defcustom bbdb-get-only-first-address-p t "*If t `bbdb-update-records' will return only the first one.\nChanging this variable will show its effect only after clearing the\n`bbdb-message-cache' of a folder or closing and visiting it again." :group 'bbdb-mua-specific :type 'boolean) - -;;;*** - -;;;### (autoloads (bbdb-create-ftp-site bbdb-ftp) "bbdb-ftp" "lisp/bbdb-ftp.el") - -(autoload 'bbdb-ftp "bbdb-ftp" "\ -Use ange-ftp to open an ftp-connection to a BBDB record's name. -If this command is executed from the *BBDB* buffer, ftp the site of -the record at point; otherwise, it prompts for an ftp-site." t nil) - -(autoload 'bbdb-create-ftp-site "bbdb-ftp" "\ -Add a new ftp-site entry to the bbdb database. -Prompts for all relevant info using the echo area, -inserts the new record in the db, sorted alphabetically." t nil) - -;;;*** - -;;;### (autoloads (bbdb-insinuate-gnus bbdb/gnus-summary-show-all-recipients bbdb/gnus-score bbdb/gnus-snarf-signature bbdb/gnus-show-all-recipients bbdb/gnus-show-records bbdb/gnus-annotate-sender bbdb/gnus-update-records bbdb/gnus-update-record) "bbdb-gnus" "lisp/bbdb-gnus.el") - -(autoload 'bbdb/gnus-update-record "bbdb-gnus" "\ -Return the record corresponding to the current GNUS message, creating -or modifying it as necessary. A record will be created if -bbdb/news-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and -the user confirms the creation." nil nil) - -(autoload 'bbdb/gnus-update-records "bbdb-gnus" "\ -Return the records corresponding to the current GNUS message, creating -or modifying it as necessary. A record will be created if -bbdb/news-auto-create-p is non-nil or if OFFER-TO-CREATE is true -and the user confirms the creation. - -The variable `bbdb/gnus-update-records-mode' controls what actions -are performed and it might override `bbdb-update-records-mode'. - -When hitting C-g once you will not be asked anymore for new people listed -in this message, but it will search only for existing records. When hitting -C-g again it will stop scanning." nil nil) - -(autoload 'bbdb/gnus-annotate-sender "bbdb-gnus" "\ -Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message. If REPLACE is non-nil, -replace the existing notes entry (if any)." t nil) - -(autoload 'bbdb/gnus-show-records "bbdb-gnus" "\ -Display the contents of the BBDB for all addresses of this message. -This buffer will be in `bbdb-mode', with associated keybindings." t nil) - -(autoload 'bbdb/gnus-show-all-recipients "bbdb-gnus" "\ -Show all recipients of this message. Counterpart to `bbdb/vm-show-sender'." t nil) - -(autoload 'bbdb/gnus-snarf-signature "bbdb-gnus" "\ -Snarf signature from the corresponding *Article* buffer." t nil) - -(autoload 'bbdb/gnus-score "bbdb-gnus" "\ -This returns a score alist for GNUS. A score pair will be made for -every member of the net field in records which also have a gnus-score -field. This allows the BBDB to serve as a supplemental global score -file, with the advantage that it can keep up with multiple and changing -addresses better than the traditionally static global scorefile." nil nil) - -(autoload 'bbdb/gnus-summary-show-all-recipients "bbdb-gnus" "\ -Display BBDB records for all recipients of the message." t nil) - -(autoload 'bbdb-insinuate-gnus "bbdb-gnus" "\ -Call this function to hook BBDB into GNUS." nil nil) - -;;;*** - -;;;### (autoloads (bbdb-menu bbdb-fontify-buffer) "bbdb-gui" "lisp/bbdb-gui.el") - -(autoload 'bbdb-fontify-buffer "bbdb-gui" nil t nil) - -(autoload 'bbdb-menu "bbdb-gui" nil t nil) - -;;;*** - -;;;### (autoloads (bbdb-force-record-create sample-bbdb-canonicalize-net-hook bbdb-auto-notes-hook bbdb-ignore-some-messages-hook bbdb-ignore-selected-messages-hook bbdb-ignore-most-messages-hook bbdb-extract-field-value bbdb-header-start bbdb-creation-date-hook bbdb-timestamp-hook) "bbdb-hooks" "lisp/bbdb-hooks.el") - -(autoload 'bbdb-timestamp-hook "bbdb-hooks" "\ -For use as a `bbdb-change-hook'; maintains a notes-field called `timestamp' -for the given record which contains the time when it was last modified. If -there is such a field there already, it is changed, otherwise it is added." nil nil) - -(autoload 'bbdb-creation-date-hook "bbdb-hooks" "\ -For use as a `bbdb-create-hook'; adds a notes-field called `creation-date' -which is the current time string." nil nil) - -(autoload 'bbdb-header-start "bbdb-hooks" "\ -Returns a marker at the beginning of the header block of the current -message. This will not necessarily be in the current buffer." nil nil) - -(autoload 'bbdb-extract-field-value "bbdb-hooks" "\ -Given the name of a field (like \"Subject\") this returns the value of -that field in the current message, or nil. This works whether you're in -GNUS, Rmail, or VM. This works on multi-line fields, but if more than -one field of the same name is present, only the last is returned. It is -expected that the current buffer has a message in it, and (point) is at the -beginning of the message headers." nil nil) - -(autoload 'bbdb-ignore-most-messages-hook "bbdb-hooks" "\ -For use as the value of bbdb/news-auto-create-p or bbdb/mail-auto-create-p. -This will automatically create BBDB entries for messages which match -the bbdb-ignore-most-messages-alist (which see) and *no* others." nil nil) - -(autoload 'bbdb-ignore-selected-messages-hook "bbdb-hooks" "\ -For use as a bbdb/news-auto-create-hook or bbdb/mail-auto-create-hook. -This will automatically create BBDB entries for messages based on a -combination of bbdb-ignore-some-messages-alist and -bbdb-ignore-most-messages-alist. It first looks at the SOME list. If -that doesn't disqualify a message, then it looks at the MOST list. If -that qualifies the message, the record is auto-created, but a -confirmation is conditionally sought, based on the value of -`bbdb-ignore-selected-messages-confirmation'." nil nil) - -(autoload 'bbdb-ignore-some-messages-hook "bbdb-hooks" "\ -For use as a `bbdb/news-auto-create-hook' or `bbdb/mail-auto-create-hook'. -This will automatically create BBDB entries for messages which do *not* -match the `bbdb-ignore-some-messages-alist' (which see)." nil nil) - -(autoload 'bbdb-auto-notes-hook "bbdb-hooks" "\ -For use as a `bbdb-notice-hook'. This might automatically add some text -to the notes field of the BBDB record corresponding to the current record -based on the header of the current message. See the documentation for -the variables `bbdb-auto-notes-alist' and `bbdb-auto-notes-ignore'." nil nil) - -(autoload 'sample-bbdb-canonicalize-net-hook "bbdb-hooks" nil nil nil) - -(autoload 'bbdb-force-record-create "bbdb-hooks" "\ -Force automatic creation of a BBDB records for the current message. -You might add this to the reply hook of your MUA in order to automatically -get records added for those people you reply to." t nil) - -;;;*** - -;;;### (autoloads (bbdb-merge-file bbdb-merge-record) "bbdb-merge" "lisp/bbdb-merge.el") - -(autoload 'bbdb-merge-record "bbdb-merge" "\ -Generic merge function. - -Merges new-record into your bbdb, using DATE to check who's more -up-to-date and OVERRIDE to decide who gets precedence if two dates -match. DATE can be extracted from a notes if it's an alist with an -element marked timestamp. Set OVERRIDE to 'new to allow the new record -to stomp on existing data, 'old to preserve existing data or nil to -merge both together. If it can't find a record to merge with, it will -create a new record. If MERGE-RECORD is set, it's a record discovered -by other means that should be merged with. - -Returns the Grand Unified Record." nil nil) - -(autoload 'bbdb-merge-file "bbdb-merge" "\ -Merge a bbdb file into the in-core bbdb." t nil) - -;;;*** - -;;;### (autoloads (bbdb-insinuate-mh bbdb/mh-show-sender bbdb/mh-annotate-sender bbdb/mh-update-record) "bbdb-mhe" "lisp/bbdb-mhe.el") - -(autoload 'bbdb/mh-update-record "bbdb-mhe" "\ -Returns the record corresponding to the current MH message, creating or -modifying it as necessary. A record will be created if -bbdb/mail-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and -the user confirms the creation." nil nil) - -(autoload 'bbdb/mh-annotate-sender "bbdb-mhe" "\ -Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message. If REPLACE is non-nil, -replace the existing notes entry (if any)." t nil) - -(autoload 'bbdb/mh-show-sender "bbdb-mhe" "\ -Display the contents of the BBDB for the sender of this message. -This buffer will be in bbdb-mode, with associated keybindings." t nil) - -(autoload 'bbdb-insinuate-mh "bbdb-mhe" "\ -Call this function to hook BBDB into MH-E." nil nil) - -;;;*** - -;;;### (autoloads (bbdb-migrate-update-file-version bbdb-migrate-rewrite-all bbdb-unmigrate-record bbdb-migrate bbdb-migration-query) "bbdb-migrate" "lisp/bbdb-migrate.el") - -(autoload 'bbdb-migration-query "bbdb-migrate" "\ -Ask if the database is to be migrated. -ONDISK is the version number of the database as currently stored on -disk. Returns the version for the saved database." nil nil) - -(autoload 'bbdb-migrate "bbdb-migrate" "\ -Migrate the BBDB from the version on disk (the car of -`bbdb-file-format-migration') to the current version (in -`bbdb-file-format')." nil nil) - -(autoload 'bbdb-unmigrate-record "bbdb-migrate" "\ -Reverse-migrate a single record from the current version (in -`bbdb-file-format') to the version to be saved (the cdr of -`bbdb-file-format-migration')." nil nil) - -(autoload 'bbdb-migrate-rewrite-all "bbdb-migrate" "\ -Rewrite each and every record in the bbdb file; this is necessary if we -are updating an old file format. MESSAGE-P says whether to sound off -for each record converted. If RECORDS is non-nil, its value will be -used as the list of records to update." nil nil) - -(autoload 'bbdb-migrate-update-file-version "bbdb-migrate" "\ -Change the `file-version' string from the OLD version to the NEW -version." nil nil) - -;;;*** - -;;;### (autoloads (bbdb-print) "bbdb-print" "lisp/bbdb-print.el") - -(autoload 'bbdb-print "bbdb-print" "\ -Make a TeX file for printing out the bbdb database.\\ -If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-print]\" is used instead of simply \"\\[bbdb-print]\", then includes only the -people currently in the *BBDB* buffer. With a prefix argument, makes -a brief (one-line-per-entry) printout. - -There are various variables for customizing the content & format of -the printout, notably the variables `bbdb-print-alist' and -`bbdb-print-require'. See the file bbdb-print.el for more information." t nil) - -;;;*** - -;;;### (autoloads (bbdb-insinuate-reportmail) "bbdb-reportmail" "lisp/bbdb-reportmail.el") - -(autoload 'bbdb-insinuate-reportmail "bbdb-reportmail" "\ -Call this function to hook BBDB into reportmail." nil nil) - -;;;*** - -;;;### (autoloads (bbdb-insinuate-rmail bbdb/rmail-show-sender bbdb/rmail-annotate-sender bbdb/rmail-update-record) "bbdb-rmail" "lisp/bbdb-rmail.el") - -(autoload 'bbdb/rmail-update-record "bbdb-rmail" nil nil nil) - -(autoload 'bbdb/rmail-annotate-sender "bbdb-rmail" "\ -Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message. If REPLACE is non-nil, -replace the existing notes entry (if any)." t nil) - -(autoload 'bbdb/rmail-show-sender "bbdb-rmail" "\ -Display the contents of the BBDB for the sender of this message. -This buffer will be in bbdb-mode, with associated keybindings." t nil) - -(autoload 'bbdb-insinuate-rmail "bbdb-rmail" "\ -Call this function to hook BBDB into RMAIL." nil nil) - -;;;*** - -;;;### (autoloads (bbdb-insinuate-sc bbdb/sc-default) "bbdb-sc" "lisp/bbdb-sc.el") - -(autoload 'bbdb/sc-default "bbdb-sc" "\ -If the current \"from\" field in `sc-mail-info' alist -contains only an e-mail address, lookup e-mail address in -BBDB, and prepend a new \"from\" field to `sc-mail-info'." nil nil) - -(autoload 'bbdb-insinuate-sc "bbdb-sc" "\ -Call this function to hook BBDB into Supercite." nil nil) - -;;;*** - -;;;### (autoloads (bbdb-rfc822-addresses bbdb-extract-address-components bbdb-snarf-region bbdb-snarf) "bbdb-snarf" "lisp/bbdb-snarf.el") - -(autoload 'bbdb-snarf "bbdb-snarf" "\ -snarf up a bbdb record WHERE the point is. -We assume things are line-broken and paragraph-bounded. -The name comes first and other fields (address, -phone, email, web pages) are recognized by context. - -Required context: - addresses end with \"City, State ZIP\" or \"City, State\" - phones match bbdb-snarf-phone-regexp - (currently US-style phones) - e-mail addresses have @'s in them - web sites are recognized by http:// or www. - -Address and phone context are currently US-specific; -patches to internationalize these assumptions are welcome. - -\\[bbdb-snarf] is similar to \\[bbdb-whois-sentinel], but less specialized." t nil) - -(autoload 'bbdb-snarf-region "bbdb-snarf" "\ -snarf up a bbdb record in the current region. See `bbdb-snarf' for -more details." t nil) - -(autoload 'bbdb-extract-address-components "bbdb-snarf" "\ -Return a list of address components found in ADSTRING. -If extracting fails one probably has to adjust the variable -`bbdb-extract-address-component-regexps'." nil nil) - -(autoload 'bbdb-rfc822-addresses "bbdb-snarf" "\ -Split ADDRLINE into a list of parsed addresses. - -You can't do this with rfc822.el in any sort of useful way because it discards -the comments. You can't do this with mail-extr.el because the multiple address -parsing in GNU Emacs appears to be broken beyond belief, and the XEmacs -version doesn't support multiple addresses." nil nil) - -;;;*** - -;;;### (autoloads (bbdb-srv-add-phone bbdb/srv-auto-create-mail-news-dispatcher bbdb/srv-handle-headers-with-delay) "bbdb-srv" "lisp/bbdb-srv.el") - -(autoload 'bbdb/srv-handle-headers-with-delay "bbdb-srv" "\ -Just like bbdb/srv-handle-headers, but only updates every few seconds. -This is so that trying to display many records in succession won't queue them -up, but will end up only displaying a record when no displays have been -requested for a couple of seconds." nil nil) - -(defalias 'bbdb-srv 'bbdb/srv-handle-headers-with-delay) - -(autoload 'bbdb/srv-auto-create-mail-news-dispatcher "bbdb-srv" "\ -For use as the value of bbdb/srv-auto-create-p. -This will try to decide if this is a mail message or a news message, and then -run either bbdb/news-auto-create-p or bbdb/mail-auto-create-p as appropriate. -\(The heuristic is that news messages never have a Status or X-Mozilla-Status -header; and that mail messages never have Path headers.)" nil nil) - -(autoload 'bbdb-srv-add-phone "bbdb-srv" nil nil nil) - -;;;*** - -;;;### (autoloads (bbdb-insinuate-vm bbdb/vm-set-auto-folder-alist bbdb/vm-show-sender bbdb/vm-show-all-recipients bbdb/vm-show-records bbdb/vm-annotate-sender bbdb/vm-update-records bbdb/vm-update-record) "bbdb-vm" "lisp/bbdb-vm.el") - -(autoload 'bbdb/vm-update-record "bbdb-vm" nil nil nil) - -(autoload 'bbdb/vm-update-records "bbdb-vm" "\ -Returns the records corresponding to the current VM message, -creating or modifying them as necessary. A record will be created if -bbdb/mail-auto-create-p is non-nil or if OFFER-TO-CREATE is true, and -the user confirms the creation. - -The variable `bbdb/vm-update-records-mode' controls what actions -are performed and it might override `bbdb-update-records-mode'. - -When hitting C-g once you will not be asked anymore for new people listed -in this message, but it will search only for existing records. When hitting -C-g again it will stop scanning." nil nil) - -(autoload 'bbdb/vm-annotate-sender "bbdb-vm" "\ -Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message. If REPLACE is non-nil, -replace the existing notes entry (if any)." t nil) - -(autoload 'bbdb/vm-show-records "bbdb-vm" "\ -Display the contents of the BBDB for the sender of this message. -This buffer will be in bbdb-mode, with associated keybindings." t nil) - -(autoload 'bbdb/vm-show-all-recipients "bbdb-vm" "\ -Show all recipients of this message. Counterpart to `bbdb/vm-show-sender'." t nil) - -(autoload 'bbdb/vm-show-sender "bbdb-vm" "\ -Display the contents of the BBDB for the senders of this message. -With a prefix argument show the recipients instead, -with two prefix arguments show all records. -This buffer will be in `bbdb-mode', with associated keybindings." t nil) - -(defcustom bbdb/vm-set-auto-folder-alist-field 'vm-folder "*The field which `bbdb/vm-set-auto-folder-alist' searches for." :group 'bbdb-mua-specific-vm :type 'symbol) - -(defcustom bbdb/vm-set-auto-folder-alist-headers '("From:" "To:" "CC:") "*The headers used by `bbdb/vm-set-auto-folder-alist'.\nThe order in this list is the order how matching will be performed!" :group 'bbdb-mua-specific-vm :type '(repeat (string :tag "header name"))) - -(autoload 'bbdb/vm-set-auto-folder-alist "bbdb-vm" "\ -Create a `vm-auto-folder-alist' according to the records in the bbdb. -For each record that has a 'vm-folder' attribute, add an -element (email-regexp . folder) to the `vm-auto-folder-alist'. - -The element gets added to the 'element-name' sublist of the -`vm-auto-folder-alist'. - -The car of the element consists of all the email addresses for the -bbdb record concatenated with OR; the cdr is the value of the -vm-folder attribute. - -If the first character of vm-folders value is a quote ' it will be -parsed as lisp expression and is evaluated to return a folder name, -e.g. define you own function `my-folder-name' and set it to - '(my-folder-name)" t nil) - -(autoload 'bbdb-insinuate-vm "bbdb-vm" "\ -Call this function to hook BBDB into VM." nil nil) - -;;;*** - -;;;### (autoloads (bbdb-insinuate-w3 bbdb-www-grab-homepage bbdb-www) "bbdb-w3" "lisp/bbdb-w3.el") - -(autoload 'bbdb-www "bbdb-w3" "\ -Visit URLs stored in the `www' field of the current record. -\\[bbdb-apply-next-command-to-all-records]\\[bbdb-www] means to try all records currently visible. -Non-interactively, do all records if arg is nonnil." t nil) - -(autoload 'bbdb-www-grab-homepage "bbdb-w3" "\ -Grab the current URL and store it in the bbdb database" t nil) - -(autoload 'bbdb-insinuate-w3 "bbdb-w3" "\ -Call this function to hook BBDB into W3." nil nil) - -;;;*** - -;;;### (autoloads (bbdb-whois) "bbdb-whois" "lisp/bbdb-whois.el") - -(autoload 'bbdb-whois "bbdb-whois" nil t nil) - -;;;*** - -;;;### (autoloads (bbdb-load-touchtones bbdb-xemacs-display-completion-list) "bbdb-xemacs" "lisp/bbdb-xemacs.el") - -(autoload 'bbdb-xemacs-display-completion-list "bbdb-xemacs" "\ -Wrapper for `display-completion-list'. -Allows callbacks on XEmacs `display-completion-list' is called with -`:activate-callback CALLBACK' if CALLBACK is non-nil. -`:user-data DATA' is also used if DATA is non-nil. -Neither are used if CALLBACK is nil." nil nil) - -(defcustom bbdb-sounds-directory (expand-file-name "~/.xemacs/etc/sounds") "The directory to load the touchtone sound files from, or nil if none." :group 'bbdb-phone-dialing :type 'directory) - -(defcustom bbdb-sound-volume 50 "Volume for playing sounds." :group 'bbdb-phone-dialing :type 'integer) - -(autoload 'bbdb-load-touchtones "bbdb-xemacs" "\ -Load the touchtone sounds into `sound-alist'. -The directory specified in `bbdb-sounds-directory' is searched for the files -touchtone.*\\.\\(wav\\|au\\) as named in `bbdb-sound-files'. -They are stored in `sound-alist' as touchtone0 to touchtone11." t nil) - -;;;*** - -;;;### (autoloads (bbdb-insinuate-message bbdb-initialize bbdb-submit-bug-report) "bbdb" "lisp/bbdb.el") - -(autoload 'bbdb-submit-bug-report "bbdb" "\ -Submit a bug report, with pertinent information to the BBDB info list." t nil) - -(defcustom bbdb-multiple-buffers nil "When non-nil we create a new buffer of every buffer causing pop-ups.\nYou can also set this to a function returning a buffer name." :group 'bbdb-record-display :type '(choice (const :tag "Disabled" nil) (function :tag "Enabled" bbdb-multiple-buffers-default) (function :tag "User defined function"))) - -(autoload 'bbdb-initialize "bbdb" "\ -*Initialize the BBDB. One or more of the following symbols can be -passed as arguments to initiate the appropriate insinuations. - - Initialization of mail/news readers: - - gnus Initialize BBDB support for the gnus mail/news reader - version 3.15 or newer. If you pass the `gnus' symbol, - you should probably also pass the `message' symbol. - mh-e Initialize BBDB support for the MH-E mail reader. - rmail Initialize BBDB support for the RMAIL mail reader. - sendmail Initialize BBDB support for sendmail (M-x mail). - vm Initialize BBDB support for the VM mail reader. - NOTE: For the VM insinuation to work properly, you must - either call `bbdb-initialize' with the `vm' symbol from - within your VM initialization file (\"~/.vm\") or you - must call `bbdb-insinuate-vm' manually from within your - VM initialization file. - - Initialization of miscellaneous package: - - message Initialize BBDB support for Message mode. - reportmail Initialize BBDB support for the Reportmail mail - notification package. - sc or Initialize BBDB support for the Supercite message - supercite citation package. - w3 Initialize BBDB support for Web browsers." nil nil) - -(autoload 'bbdb-insinuate-message "bbdb" "\ -Call this function to hook BBDB into `message-mode'." nil nil) - -;;;*** - -(provide 'bbdb-autoloads) diff --git a/xemacs-packages/lisp/bbdb/bbdb-com.el b/xemacs-packages/lisp/bbdb/bbdb-com.el deleted file mode 100644 index 0088712c..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-com.el +++ /dev/null @@ -1,3612 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; It contains most of the user-level interactive commands for BBDB. -;;; See bbdb.texinfo. - -;;; The Insidious Big Brother Database 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. -;;; -;;; BBDB 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. - -;; -;; $Id: bbdb-com.el,v 1.9 2005/07/24 15:22:57 waider Exp $ -;; - -(require 'bbdb) -;;(require 'bbdb-snarf) causes recursive compile! -(eval-when-compile - (require 'cl) - (defvar bbdb-extract-address-components-func)) ;; bbdb-snarf - -;; ARGH. fmh, dammit. -(require - (eval-and-compile - (if (locate-library "mailabbrev") - (quote mailabbrev) - (quote mail-abbrevs)))) - -;; compiler placating. -;; not sure BBDB runs on anything old enough to use auto-fill-hook, mind. -(eval-and-compile - (if (boundp 'auto-fill-function) - (fset 'bbdb-auto-fill-function 'auto-fill-function) - (fset 'bbdb-auto-fill-function 'auto-fill-hook)) - - (autoload 'mh-send "mh-e") - (autoload 'vm-session-initialization "vm-startup") - (autoload 'vm-mail-internal "vm-reply") - (autoload 'mew-send "mew") - (autoload 'bbdb-header-start "bbdb-hooks") - (autoload 'bbdb-extract-field-value "bbdb-hooks") - (autoload 'bbdb-fontify-buffer "bbdb-gui") - (autoload 'Info-goto-node "info") - ;; this is very unpleasant, but saves me doing a lot of rewriting - ;; for now. a big cleanup will happen for the next release, maybe. - ;; NB if emacs 21 or older emacsen or even things you bolt on have - ;; any of these functions, bad things will happen. Again, FITNR. - (if (featurep 'xemacs) - (progn - (fset 'bbdb-extent-string 'extent-string) - (fset 'bbdb-display-message 'display-message) - (fset 'bbdb-event-to-character 'event-to-character)) - (fset 'bbdb-extent-string 'ignore) - (fset 'bbdb-display-message 'ignore) - (fset 'bbdb-event-to-character 'ignore))) - -(defvar bbdb-define-all-aliases-needs-rebuilt nil) - -(defcustom bbdb-default-country - '"Emacs";; what do you mean, it's not a country? - "*Default country to use if none is specified." - :group 'bbdb-record-creation - :type 'string) ;; wonder if there's a smart place to get this? TZ, maybe? - -(defmacro bbdb-grovel-elide-arg (arg) - (list 'if arg - (list 'not (list 'eq arg 0)) - 'bbdb-display-layout)) - -(defvar bbdb-search-invert nil - "Bind this variable to t in order to invert the result of `bbdb-search'. - -\(let ((bbdb-search-invert t)) - \(bbdb-search records foo foo))") - -(defun bbdb-search-invert-p () - "Return `bbdb-search-invert' and set it to nil. -To set it on again, use `bbdb-search-invert-set'." - (let ((result bbdb-search-invert)) - (setq bbdb-search-invert nil) - result)) - -;;;###autoload -(defun bbdb-search-invert-set () - "Typing \\\\[bbdb-search-invert-set] inverts the meaning of the next search command. -Sets `bbdb-search-invert' to t. -You will have to call this function again, if you want to -do repeated inverted searches." - (interactive) - (setq bbdb-search-invert t) - (message (substitute-command-keys - "\\\\[bbdb-search-invert-set] - "))) - -(defmacro bbdb-search (records &optional name company net notes phone) - "Search RECORDS for optional arguments NAME, COMPANY, NET, NOTES, PHONE. -This macro only emits code for those things being searched for; -literal nils at compile-time cause no code to be emitted. - -If you want to reverse the search, bind `bbdb-search-invert' to t." - (let (clauses) - ;; I didn't protect these vars from multiple evaluation because that - ;; actually generates *less efficient code* in elisp, because the extra - ;; bindings can't easily be optimized away without lexical scope. fmh. - (or (stringp name) (symbolp name) (error "name must be atomic")) - (or (stringp company) (symbolp company) (error "company must be atomic")) - (or (stringp net) (symbolp net) (error "net must be atomic")) - (or (stringp notes) (symbolp notes) (error "notes must be atomic")) - (or (stringp phone) (symbolp phone) (error "phone must be atomic")) - (if phone - (setq clauses - (cons - (` (let ((rest-of-phones (bbdb-record-phones record)) - (done nil)) - (if rest-of-phones - (while (and rest-of-phones (not done)) - (setq done (string-match (, phone) - ;; way way wasteful... - (bbdb-phone-string - (car rest-of-phones))) - rest-of-phones (cdr rest-of-phones))) - ;; so that "^$" can be used to find entries that - ;; have no phones - (setq done (string-match (, phone) ""))) - done)) - clauses))) - (if notes - (setq clauses - (cons - (` (if (stringp (, notes)) - (string-match (, notes) - (or (bbdb-record-notes record) "")) - (if (eq (car (, notes)) '*) - (let ((fields all-fields) done tmp) - (if (bbdb-record-raw-notes record) - (while (and (not done) fields) - (setq tmp (bbdb-record-getprop - record (car fields)) - done (and tmp (string-match - (cdr (, notes)) - tmp)) - fields (cdr fields))) - ;; so that "^$" can be used to find entries that - ;; have no notes - (setq done (string-match (cdr (, notes)) ""))) - done) - (string-match (cdr (, notes)) - (or (bbdb-record-getprop - record (car (, notes))) ""))))) - clauses))) - (if name - (setq clauses - (append - (` ((string-match (, name) (or (bbdb-record-name record) "")) - (let ((rest-of-aka (bbdb-record-aka record)) - (done nil)) - (while (and rest-of-aka (not done)) - (setq done (string-match (, name) (car rest-of-aka)) - rest-of-aka (cdr rest-of-aka))) - done))) - clauses))) - (if net - (setq clauses - (cons - (` (let ((rest-of-nets (bbdb-record-net record)) - (done nil)) - (if rest-of-nets - (while (and rest-of-nets (not done)) - (setq done (string-match (, net) (car rest-of-nets)) - rest-of-nets (cdr rest-of-nets))) - ;; so that "^$" can be used to find entries that - ;; have no net addresses. - (setq done (string-match (, net) ""))) - done)) - clauses))) - (if company - (setq clauses - (cons - (` (string-match (, company) - (or (bbdb-record-company record) ""))) - clauses))) - - (` (let ((matches '()) - (,@ (if notes - '((all-fields (cons 'notes - (mapcar (lambda (x) (intern (car x))) - (bbdb-propnames))))) - nil)) - (case-fold-search bbdb-case-fold-search) - (records (, records)) - (invert (bbdb-search-invert-p)) - record) - (while records - (setq record (car records)) - (if (or (and invert - (not (or (,@ clauses)))) - (and (not invert) - (or (,@ clauses)))) - (setq matches (cons record matches))) - (setq records (cdr records))) - (nreverse matches))))) - -(defun bbdb-search-prompt (prompt &rest rest) - (if (string-match "%m" prompt) - (setq prompt (replace-match (if bbdb-search-invert - "not matching" - "matching") - nil nil prompt))) - (read-string (apply 'format prompt rest))) - -;;;###autoload -(defun bbdb (string elidep) - "Display all entries in the BBDB matching the regexp STRING -in either the name(s), company, network address, or notes." - (interactive - (list (bbdb-search-prompt "Search records %m regexp: ") - current-prefix-arg)) - (let* ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)) - (notes (cons '* string)) - (records - (bbdb-search (bbdb-records) string string string notes - nil))) - (if records - (bbdb-display-records records) - ;; we could use error here, but it's not really an error. - (message "No records matching '%s'" string)))) - -;;;###autoload -(defun bbdb-name (string elidep) - "Display all entries in the BBDB matching the regexp STRING in the name -\(or ``alternate'' names\)." - (interactive - (list (bbdb-search-prompt "Search records with names %m regexp: ") - current-prefix-arg)) - (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))) - (bbdb-display-records (bbdb-search (bbdb-records) string)))) - -;;;###autoload -(defun bbdb-company (string elidep) - "Display all entries in BBDB matching STRING in the company field." - (interactive - (list (bbdb-search-prompt "Search records with company %m regexp: ") - current-prefix-arg)) - (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))) - (bbdb-display-records (bbdb-search (bbdb-records) nil string)))) - -;;;###autoload -(defun bbdb-net (string elidep) - "Display all entries in BBDB matching regexp STRING in the network address." - (interactive - (list (bbdb-search-prompt "Search records with net address %m regexp: ") - current-prefix-arg)) - (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))) - (bbdb-display-records (bbdb-search (bbdb-records) nil nil string)))) - -;;;###autoload -(defun bbdb-notes (which string elidep) - "Display all entries in BBDB matching STRING in the named notes field." - (interactive - (let (field) - (list (setq field (completing-read "Notes field to search (RET for all): " - (append '(("notes")) (bbdb-propnames)) - nil t)) - (if (featurep 'gmhist) - (read-with-history-in 'bbdb-notes-field "Regular expression: ") - (bbdb-search-prompt "Search records with %s %m regexp: " - (if (string= field "") - "one field" - field))) - current-prefix-arg))) - (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)) - (notes (if (string= which "") - (cons '* string) - (cons (intern which) string)))) - (bbdb-display-records (bbdb-search (bbdb-records) nil nil nil notes)))) - -(defun bbdb-phones (string elidep) - "Display all entries in BBDB matching the regexp STRING in the phones field." - (interactive - (list (bbdb-search-prompt "Search records with phone %m regexp: ") - current-prefix-arg)) - (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep))) - (bbdb-display-records - (bbdb-search (bbdb-records) nil nil nil nil string)))) - -;;;###autoload -(defun bbdb-changed (elidep) - "Display all entries in the bbdb database which have been changed since -the database was last saved." - (interactive "P") - (let ((bbdb-display-layout (bbdb-grovel-elide-arg elidep)) - (changed-records (bbdb-with-db-buffer bbdb-changed-records))) - (if (bbdb-search-invert-p) - (let ((recs (bbdb-records)) - unchanged-records - r) - (while recs - (setq r (car recs) - recs (cdr recs)) - (when (not (member r changed-records)) - (setq changed-records (delete r changed-records) - unchanged-records (cons r unchanged-records)))) - (bbdb-display-records unchanged-records)) - (bbdb-display-records changed-records)))) - -(defun bbdb-display (records) - "Prompts for and displays a single record (this is faster than searching.)" - (interactive (list (bbdb-completing-read-record "Display record of: "))) - (bbdb-display-records records)) - -(defun bbdb-display-some (function) - "Display records according to FUNCTION. FUNCTION is called with one -argument, the record, and should return nil if the record is not to be -displayed. If the record is to be displayed, it (the record) should -be returned." - (bbdb-display-records (delq nil (mapcar function (bbdb-records))))) - -;;; fancy redisplay - -;;;###autoload -(defun bbdb-redisplay-records () - "Regrinds the contents of the *BBDB* buffer, without scrolling. -If possible, you should call `bbdb-redisplay-one-record' instead." - (let ((p (point)) - (m (condition-case nil (mark) (error nil)))) - (goto-char (window-start)) - (let ((p2 (point))) - (bbdb-display-records-1 bbdb-records) - (goto-char p2) - (if m (set-mark m))) - (recenter 0) - (goto-char p) - (save-excursion - (run-hooks 'bbdb-list-hook)))) - -(defun bbdb-redisplay-one-record (record &optional record-cons next-record-cons - delete-p) - "Regrind one record. The *BBDB* buffer must be current when this is called." - (bbdb-debug (if (not (eq (not (not delete-p)) - (not (not (bbdb-record-deleted-p record))))) - (error "splorch."))) - (if (null record-cons) (setq record-cons (assq record bbdb-records))) - (if (null next-record-cons) - (setq next-record-cons (car (cdr (memq record-cons bbdb-records))))) - (if (null record-cons) - (bbdb-display-records (list record) nil t) - (let ((position (point)) - (marker (nth 2 record-cons)) - next-marker - (buffer-read-only nil)) - (bbdb-debug - (if (null record-cons) (error "doubleplus ungood: record unexists!")) - (if (null marker) (error "doubleplus ungood: marker unexists!"))) - (beginning-of-line) - (goto-char marker) - (remove-text-properties marker (or (nth 2 next-record-cons) (point-max)) - '(bbdb-field nil)) - (if delete-p nil - (bbdb-format-record (car record-cons) (car (cdr record-cons)))) - (setq next-marker (or (nth 2 next-record-cons) (point-max))) - (delete-region (point) next-marker) - (if (< position next-marker) - (goto-char position)) - - (if (and bbdb-gui (not delete-p)) - (bbdb-fontify-buffer (list record-cons - ;; the record ends here - (list nil nil next-marker)))) - (save-excursion - (run-hooks 'bbdb-list-hook))))) - -;;; Parsing phone numbers -;;; XXX this needs expansion to handle international prefixes properly -;;; i.e. +353-number without discarding the +353 part. Problem being -;;; that this will necessitate yet another change in the database -;;; format for people who are using north american numbers. - - -(defconst bbdb-phone-area-regexp "(?[ \t]*\\+?1?[ \t]*[-\(]?[ \t]*[-\(]?[ \t]*\\([2-9][0-9][0-9]\\)[ \t]*)?[-./ \t]*") -(defconst bbdb-phone-main-regexp "\\([1-9][0-9][0-9]\\)[ \t]*[-.]?[ \t]*\\([0-9][0-9][0-9][0-9]\\)[ \t]*") - -(defconst bbdb-phone-ext-regexp "x?[ \t]*\\([0-9]+\\)[ \t]*") - -(defconst bbdb-phone-regexp-1 (concat "^[ \t]*" bbdb-phone-area-regexp bbdb-phone-main-regexp bbdb-phone-ext-regexp "$")) -(defconst bbdb-phone-regexp-2 (concat "^[ \t]*" bbdb-phone-area-regexp bbdb-phone-main-regexp "$")) -(defconst bbdb-phone-regexp-3 (concat "^[ \t]*" bbdb-phone-main-regexp bbdb-phone-ext-regexp "$")) -(defconst bbdb-phone-regexp-4 (concat "^[ \t]*" bbdb-phone-main-regexp "$")) -(defconst bbdb-phone-regexp-5 (concat "^[ \t]*" bbdb-phone-ext-regexp "$")) - -(defun bbdb-parse-phone-number (string &optional number-type) - "Parse a phone number from STRING and return a list of integers the form -\(area-code exchange number) or (area-code exchange number extension). -This is both lenient and strict in what it will parse - whitespace may -appear (or not) between any of the groups of digits, parentheses around the -area code are optional, as is a dash between the exchange and number, and -a '1' preceeding the area code; but there must be three digits in the area -code and exchange, and four in the number (if they are present). An error -will be signalled if unparsable. All of these are unambigously parsable: - - ( 415 ) 555 - 1212 x123 -> (415 555 1212 123) - (415)555-1212 123 -> (415 555 1212 123) - (1-415) 555-1212 123 -> (415 555 1212 123) - 1 (415)-555-1212 123 -> (415 555 1212 123) - 555-1212 123 -> (0 555 1212 123) - 555 1212 -> (0 555 1212) - 415 555 1212 -> (415 555 1212) - 1 415 555 1212 -> (415 555 1212) - 5551212 -> (0 555 1212) - 4155551212 -> (415 555 1212) - 4155551212123 -> (415 555 1212 123) - 5551212x123 -> (0 555 1212 123) - 1234 -> (0 0 0 1234) - -Note that \"4151212123\" is ambiguous; it could be interpreted either as -\"(415) 121-2123\" or as \"415-1212 x123\". - -\(And uh, oh yeah, this does little if `bbdb-north-american-phone-numbers-p' -is nil...\)" - - (cond ((if number-type - (eq number-type 'euro) - (not bbdb-north-american-phone-numbers-p)) - (list (bbdb-string-trim string))) - ((string-match bbdb-phone-regexp-1 string) - ;; (415) 555-1212 x123 - (list (bbdb-subint string 1) (bbdb-subint string 2) - (bbdb-subint string 3) (bbdb-subint string 4))) - ((string-match bbdb-phone-regexp-2 string) - ;; (415) 555-1212 - (list (bbdb-subint string 1) (bbdb-subint string 2) - (bbdb-subint string 3))) - ((string-match bbdb-phone-regexp-3 string) - ;; 555-1212 x123 - (list 0 (bbdb-subint string 1) (bbdb-subint string 2) - (bbdb-subint string 3))) - ((string-match bbdb-phone-regexp-4 string) - ;; 555-1212 - (list 0 (bbdb-subint string 1) (bbdb-subint string 2))) - ((string-match bbdb-phone-regexp-5 string) - ;; x123 - (list 0 0 0 (bbdb-subint string 1))) - (t (error "phone number unparsable.")))) - -;;; Parsing other things - -(defcustom bbdb-expand-mail-aliases t - "If non-nil, expand mail aliases in `bbdb-complete-name'." - :group 'bbdb-record-use - :type 'boolean) - -(defcustom bbdb-check-zip-codes-p t - "If non-nil, require legal zip codes when entering an address. -The format of legal zip codes is determined by the variable -`bbdb-legal-zip-codes'." - :group 'bbdb-record-creation - :type 'boolean) - -(defcustom bbdb-legal-zip-codes - '(;; empty string - "^$" - ;; Matches 1 to 6 digits. - "^[ \t\n]*[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[ \t\n]*$" - ;; Matches 5 digits and 3 or 4 digits. - "^[ \t\n]*\\([0-9][0-9][0-9][0-9][0-9]\\)[ \t\n]*-?[ \t\n]*\\([0-9][0-9][0-9][0-9]?\\)[ \t\n]*$" - ;; Match zip codes for Canada, UK, etc. (result is ("LL47" "U4B")). - "^[ \t\n]*\\([A-Za-z0-9]+\\)[ \t\n]+\\([A-Za-z0-9]+\\)[ \t\n]*$" - ;; Match zip codes for continental Europe. Examples "CH-8057" - ;; or "F - 83320" (result is ("CH" "8057") or ("F" "83320")). - ;; Support for "NL-2300RA" added at request from Carsten Dominik - ;; - "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+ ?[A-Z]*\\)[ \t\n]*$" - ;; Match zip codes from Sweden where the five digits are grouped 3+2 - ;; at the request from Mats Lofdahl . - ;; (result is ("SE" (133 36))) - "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+\\)[ \t\n]+\\([0-9]+\\)[ \t\n]*$") - "List of regexps that match legal zip codes. -Whether this is used at all depends on the variable `bbdb-check-zip-codes-p'." - :group 'bbdb-record-creation - :type '(repeat regexp)) - -(defun bbdb-parse-zip-string (string) - "Check whether STRING is a legal zip code. -Do this only if `bbdb-check-zip-codes-p' is non-nil." - (if (and bbdb-check-zip-codes-p - (not (memq t (mapcar (lambda (regexp) - ;; if it matches, (not (not index-of-match)) returns t - (not (not (string-match regexp string)))) - bbdb-legal-zip-codes)))) - (error "not a valid zip code.") - string)) - -(defun bbdb-read-new-record () - "Prompt for and return a completely new BBDB record. -Doesn't insert it in to the database or update the hashtables, but does -ensure that there will not be name collisions." - (bbdb-records) ; make sure database is loaded - (if bbdb-readonly-p - (error "The Insidious Big Brother Database is read-only.")) - (let (firstname lastname) - (bbdb-error-retry - (progn - (if current-prefix-arg - (setq firstname (bbdb-read-string "First Name: ") - lastname (bbdb-read-string "Last Name: ")) - (let ((names (bbdb-divide-name (bbdb-read-string "Name: ")))) - (setq firstname (car names) - lastname (nth 1 names)))) - (if (string= firstname "") (setq firstname nil)) - (if (string= lastname "") (setq lastname nil)) - (if (and bbdb-no-duplicates-p - (bbdb-gethash (bbdb-build-name firstname lastname))) - (error "%s %s is already in the database" - (or firstname "") (or lastname ""))))) - (let ((company (bbdb-read-string "Company: ")) - (net (bbdb-split (bbdb-read-string "Network Address: ") ",")) - (addrs - (let (L L-tail str addr) - (while (not (string= - "" - (setq str - (bbdb-read-string - "Address Description [RET when no more]: " - "" - (mapcar (function (lambda(x) (list x))) - (bbdb-label-completion-list - "addresses")))))) - (setq addr (make-vector bbdb-address-length nil)) - (bbdb-record-edit-address addr str) - (if L - (progn (setcdr L-tail (cons addr nil)) - (setq L-tail (cdr L-tail))) - (setq L (cons addr nil) - L-tail L))) - L)) - (phones - (let (L L-tail str) - (while (not (string= - "" - (setq str - (bbdb-read-string - "Phone Location [RET when no more]: " - "" - (mapcar (function (lambda(x) (list x))) - (bbdb-label-completion-list - "phones")))))) - (let* ((phonelist - (bbdb-error-retry - (bbdb-parse-phone-number - (read-string "Phone: " - (and (integerp bbdb-default-area-code) - (format "(%03d) " - bbdb-default-area-code)))))) - (phone (apply 'vector str - (if (= 3 (length phonelist)) - (nconc phonelist '(0)) - phonelist)))) - (if L - (progn (setcdr L-tail (cons phone nil)) - (setq L-tail (cdr L-tail))) - (setq L (cons phone nil) - L-tail L)))) - L)) - (notes (bbdb-read-string "Additional Comments: "))) - (if (string= company "") (setq company nil)) - (if (string= notes "") (setq notes nil)) - (let ((record - (vector firstname lastname nil company phones addrs net notes - (make-vector bbdb-cache-length nil)))) - record)))) - -;;;###autoload -(defun bbdb-create (record) - "Add a new entry to the bbdb database ; prompts for all relevant info -using the echo area, inserts the new record in the db, sorted alphabetically, -and offers to save the db file. DO NOT call this from a program. Call -bbdb-create-internal instead." - (interactive (list (bbdb-read-new-record))) - (bbdb-invoke-hook 'bbdb-create-hook record) - (bbdb-change-record record t) - (bbdb-display-records (list record))) - - -(defmacro bbdb-check-type (place predicate) - (list 'while (list 'not (list predicate place)) - (nconc (cond ((eq (car-safe place) 'aref) - (list 'aset (nth 1 place) (nth 2 place))) - ((eq (car-safe place) 'car) - (list 'setcar (nth 1 place))) - ((eq (car-safe place) 'cdr) - (list 'setcdr (nth 1 place))) - (t (list 'setq place))) - (list - (list 'signal ''wrong-type-argument - (list 'list (list 'quote predicate) place)))))) - -(defun bbdb-create-internal (name company net addrs phones notes) - "Adds a record to the database; this function does a fair amount of -error-checking on the passed in values, so it's safe to call this from -other programs. - -NAME is a string, the name of the person to add. An error is signalled -if that name is already in use and `bbdb-no-duplicates-p' is t. -COMPANY is a string or nil. -NET is a comma-separated list of email addresses, or a list of strings. -An error is signalled if that name is already in use. -ADDRS is a list of address objects. An address is a vector of the form - [\"location\" (\"line1\" \"line2\" ... ) \"City\" \"State\" \"Zip\" \"Country\"]. -PHONES is a list of phone-number objects. A phone-number is a vector of -the form - [\"location\" areacode prefix suffix extension-or-nil] -or - [\"location\" \"phone-number\"] -NOTES is a string, or an alist associating symbols with strings." - (let (firstname lastname aka) - (while (and (progn - (setq name (and name (bbdb-divide-name name)) - firstname (car name) - lastname (nth 1 name)) - (bbdb-gethash (bbdb-build-name firstname lastname))) - bbdb-no-duplicates-p) - (setq name (signal 'error - (list (format "%s %s is already in the database" - (or firstname "") (or lastname "")))))) - (and company (bbdb-check-type company stringp)) - (if (stringp net) - (setq net (bbdb-split net ","))) - (if bbdb-no-duplicates-p - (let ((rest net)) - (while rest - (while (bbdb-gethash (downcase (car rest))) - (setcar rest - (signal 'error (list (format - "%s is already in the database" - (car rest)))))) - (setq rest (cdr rest))))) - (setq addrs - (mapcar - (lambda (addr) - (while (or (not (vectorp addr)) - (/= (length addr) bbdb-address-length)) - (setq addr (signal 'wrong-type-argument (list 'vectorp addr)))) - (bbdb-check-type (aref addr 0) stringp) ;;; XXX use bbdb-addresses - (bbdb-check-type (aref addr 1) listp) - (bbdb-check-type (aref addr 2) stringp) - (bbdb-check-type (aref addr 3) stringp) - (bbdb-check-type (aref addr 4) stringp) - (bbdb-check-type (aref addr 5) stringp) - addr) - addrs)) - (setq phones - (mapcar - (lambda (phone) - (while (or (not (vectorp phone)) - (and (/= (length phone) 2) - (/= (length phone) bbdb-phone-length))) - (setq phone - (signal 'wrong-type-argument (list 'vectorp phone)))) - (bbdb-check-type (aref phone 0) stringp) - (if (= 2 (length phone)) - (bbdb-check-type (aref phone 1) stringp) - (bbdb-check-type (aref phone 1) integerp) - (bbdb-check-type (aref phone 2) integerp) - (bbdb-check-type (aref phone 3) integerp) - (and (aref phone 4) (bbdb-check-type (aref phone 4) integerp)) - (if (eq 0 (aref phone 4)) (aset phone 4 nil))) - phone) - phones)) - (or (stringp notes) - (setq notes - (mapcar (lambda (note) - (bbdb-check-type note consp) - (bbdb-check-type (car note) symbolp) - (if (consp (cdr note)) - (setq note (cons (car note) (car (cdr note))))) - (bbdb-check-type (cdr note) stringp) - note) - notes))) - (let ((record - (vector firstname lastname aka company phones addrs net notes - (make-vector bbdb-cache-length nil)))) - (bbdb-invoke-hook 'bbdb-create-hook record) - (bbdb-change-record record t) - record))) - - -;;; bbdb-mode stuff - -(defun bbdb-current-record (&optional planning-on-modifying) - "Returns the record which the point is point at. In linear time, man..." - (if (and planning-on-modifying bbdb-readonly-p) - (error "The Insidious Big Brother Database is read-only.")) - (if (not (equal bbdb-buffer-name (buffer-name (current-buffer)))) - (error "this command only works while in the \"%s\" buffer." - bbdb-buffer-name)) - (let ((p (point)) - (rest bbdb-records) - (rec nil)) - (while (and (cdr rest) (not rec)) - (if (> (nth 2 (car (cdr rest))) p) - (setq rec (car (car rest)))) - (setq rest (cdr rest))) - (or rec (car (car rest))))) - - -;; yow, are we object oriented yet? -(defun bbdb-record-get-field-internal (record field) - (cond ((eq field 'name) (bbdb-record-name record)) - ((eq field 'net) (bbdb-record-net record)) - ((eq field 'aka) (bbdb-record-aka record)) - ((eq field 'phone) (bbdb-record-phones record)) - ((eq field 'address) (bbdb-record-addresses record)) - ((eq field 'property) (bbdb-record-raw-notes record)) - (t (error "doubleplus ungood: unknown field type %s" field)))) - -(defun bbdb-record-store-field-internal (record field value) - (cond ((eq field 'name) (error "doesn't work on names")) - ((eq field 'net) (bbdb-record-set-net record value)) - ((eq field 'aka) (bbdb-record-set-aka record value)) - ((eq field 'phone) (bbdb-record-set-phones record value)) - ((eq field 'address) (bbdb-record-set-addresses record value)) - ((eq field 'property) (bbdb-record-set-raw-notes record value)) - (t (error "doubleplus ungood: unknown field type %s" field)))) - -(defun bbdb-record-edit-field-internal (record field &optional which location) - (cond ((eq field 'name) (bbdb-record-edit-name record)) - ((eq field 'company) (bbdb-record-edit-company record)) - ((eq field 'net) (bbdb-record-edit-net record)) - ((eq field 'aka) (bbdb-record-edit-aka record)) - ((eq field 'phone) (bbdb-record-edit-phone which location)) - ((eq field 'address) (bbdb-record-edit-address which location)) - ((eq field 'property) (bbdb-record-edit-property record (car which))) - (t (error "doubleplus ungood: unknown field type %s" field)))) - - -(defun bbdb-current-field (&optional planning-on-modifying) - (or (bbdb-current-record planning-on-modifying) - (error "unperson")) - (delete 'field-name (get-text-property (point) 'bbdb-field))) - -;;;###autoload -(defun bbdb-apply-next-command-to-all-records () - "Typing \\\\[bbdb-apply-next-command-to-all-records] \ -in the *BBDB* buffer makes the next command operate on all -of the records currently displayed. \(Note that this only works for -certain commands.\)" - (interactive) - (message (substitute-command-keys - "\\\\[bbdb-apply-next-command-to-all-records] - ")) - (setq prefix-arg current-prefix-arg - last-command this-command) - nil) - -(defmacro bbdb-do-all-records-p () - "Whether the last command was `bbdb-apply-next-command-to-all-records'." - '(eq last-command 'bbdb-apply-next-command-to-all-records)) - - -(defvar bbdb-append-records nil) - -;;;###autoload -(defun bbdb-append-records-p () - (cond ((eq t bbdb-append-records)) - ((numberp bbdb-append-records) - (setq bbdb-append-records - (1- bbdb-append-records)) - (when (= 0 bbdb-append-records) - (when (not bbdb-silent-running) - (message "No further search results will be appended.") - (sit-for 2)) - (setq bbdb-append-records nil)) - t) - (bbdb-append-records - (setq bbdb-append-records nil) - t) - (t nil))) - -;;;###autoload -(defun bbdb-append-records (arg) - "Typing \\\\[bbdb-append-records] \ -in the *BBDB* buffer makes the next search/display command to append -new records to those in the *BBDB* buffer. - -With an prefix arg (C-u) toggle between always append and no append. -With an prefix arg that is a positive number append will be enabled for that -many times. -With any other argument append will be enabled once." - (interactive "P") - (message (substitute-command-keys - "\\\\[bbdb-append-records] - ")) - (setq bbdb-append-records - (cond ((and arg (listp arg)) - (if (not bbdb-silent-running) - (if (not bbdb-append-records) - (message "Always append records.") - (message "Do not append records."))) - (not bbdb-append-records)) - ((and (numberp arg) (< 1 arg)) - (if (not bbdb-silent-running) - (message "Append records for the next %d times." arg)) - arg) - (t 'once)))) - -;;;###autoload -(defun bbdb-insert-new-field (record name contents) - "Add a new field to the current record; the field type and contents -are prompted for if not supplied. - -If you are inserting a new phone-number field, you can control whether -it is a north american or european phone number by providing a prefix -argument. A prefix arg of ^U means it's to be a euronumber, and any -other prefix arg means it's to be a a structured north american number. -Otherwise, which style is used is controlled by the variable -`bbdb-north-american-phone-numbers-p'. - -If you are inserting a new net address, you can have BBDB append a -default domain to any net address that does not contain one. Set -`bbdb-default-domain' to a string such as \"mycompany.com\" (or, -depending on your environment, (getenv \"DOMAINNAME\")), and -\"@mycompany.com\" will be appended to an address that is entered as -just a username. A prefix arg of ^U (or a `bbdb-default-domain' -value of \"\", the default) means do not alter the address." - (interactive (let ((record (or (bbdb-current-record t) - (error "current record unexists!"))) - (name "") - (completion-ignore-case t)) - (while (string= name "") - (setq name - (downcase - (completing-read "Insert Field: " - (append '(("phone") ("address") - ("net") ("AKA") ("notes")) - (bbdb-propnames)) - nil - nil ; used to be t - nil)))) - (setq name (intern name)) - (list record name (bbdb-prompt-for-new-field-value name)))) - (if (null contents) - (setq contents (bbdb-prompt-for-new-field-value name))) - - (cond ((eq name 'phone) - (bbdb-record-set-phones record - (nconc (bbdb-record-phones record) - (list contents)))) - ((eq name 'address) - (bbdb-record-set-addresses record - (nconc (bbdb-record-addresses record) - (list contents)))) - ((eq name 'net) - (if (bbdb-record-net record) - (error "There already are net addresses!")) - (if (stringp contents) - (setq contents (bbdb-split contents ","))) - ;; first detect any conflicts.... - (if bbdb-no-duplicates-p - (let ((nets contents)) - (while nets - (let ((old (bbdb-gethash (downcase (car nets))))) - (if (and old (not (eq old record))) - (error "net address \"%s\" is used by \"%s\"" - (car nets) - (or (bbdb-record-name old) - (car (bbdb-record-net old)))))) - (setq nets (cdr nets))))) - ;; then store. - (let ((nets contents)) - (while nets - (bbdb-puthash (downcase (car nets)) record) - (setq nets (cdr nets)))) - (bbdb-record-set-net record contents)) - ((eq name 'aka) - (if (bbdb-record-aka record) - (error "there already are alternate names!")) - (if (stringp contents) - (setq contents (bbdb-split contents ";"))) - ;; first detect any conflicts.... - (if bbdb-no-duplicates-p - (let ((aka contents)) - (while aka - (let ((old (bbdb-gethash (downcase (car aka))))) - (if (and old (not (eq old record))) - (error "alternate name \"%s\" is used by \"%s\"" - (car aka) - (or (bbdb-record-name old) - (car (bbdb-record-net old)))))) - (setq aka (cdr aka))))) - ;; then store. - (let ((aka contents)) - (while aka - (bbdb-puthash (downcase (car aka)) record) - (setq aka (cdr aka)))) - (bbdb-record-set-aka record contents)) - ((eq name 'notes) - (if (bbdb-record-notes record) (error "there already are notes!")) - (bbdb-record-set-notes record contents)) - ((assoc (symbol-name name) (bbdb-propnames)) - (if (and (consp (bbdb-record-raw-notes record)) - (assq name (bbdb-record-raw-notes record))) - (error "there is already a \"%s\" note!" name)) - (bbdb-record-putprop record name contents)) - (t (error "doubleplus ungood: unknow how to set slot %s" name))) - (bbdb-change-record record nil) -; (bbdb-offer-save) - (let ((bbdb-display-layout nil)) - (bbdb-redisplay-one-record record))) - -(defun bbdb-prompt-for-new-field-value (name) - (cond ((eq name 'net) - (let - ((n (bbdb-read-string "Net: "))) - (if (string-match "^mailto:" n) - (setq n (substring n (match-end 0)))) - (if (or (eq nil bbdb-default-domain) - current-prefix-arg (string-match "[@%!]" n)) - n - (concat n "@" bbdb-default-domain)))) - ((eq name 'aka) (bbdb-read-string "Alternate Names: ")) - ((eq name 'phone) - (let ((p (make-vector - (if (if current-prefix-arg - (numberp current-prefix-arg) - bbdb-north-american-phone-numbers-p) - bbdb-phone-length - 2) - 0))) - (aset p 0 nil) - (aset p 1 - (if (= bbdb-phone-length (length p)) - (if (integerp bbdb-default-area-code) - bbdb-default-area-code - 0) - nil)) - (bbdb-record-edit-phone p) - p)) - ((eq name 'address) - (let ((a (make-vector bbdb-address-length nil))) - (bbdb-record-edit-address a) - a)) - ((eq name 'notes) (bbdb-read-string "Notes: ")) - ((assoc (symbol-name name) (bbdb-propnames)) - (bbdb-read-string (format "%s: " name))) - (t - (if (bbdb-y-or-n-p - (format "\"%s\" is an unknown field name. Define it? " name)) - (bbdb-set-propnames - (append (bbdb-propnames) (list (list (symbol-name name))))) - (error "unknown field \"%s\"" name)) - (bbdb-read-string (format "%s: " name))))) - -(defun bbdb-add-new-field (name) - "Programmatically add a new field called NAME. Returns the list of propnames." - ;; check that we don't have one already; if we do, return quietly. - (if (assoc (symbol-name name) (append '(("phone") ("address") ("net") - ("AKA") ("notes")) - (bbdb-propnames))) - bbdb-propnames - (bbdb-set-propnames (append (bbdb-propnames) - (list (list (symbol-name name))))))) - -;;;###autoload -(defun bbdb-edit-current-field () - "Edit the contents of the Insidious Big Brother Database field displayed on -the current line (this is only meaningful in the \"*BBDB*\" buffer.) If the -cursor is in the middle of a multi-line field, such as an address or comments -section, then the entire field is edited, not just the current line." - (interactive) - ;; when at the end of the line take care of it - (if (and (eolp) (not (bobp)) (not (bbdb-current-field t))) - (backward-char 1)) - - (let* ((record (bbdb-current-record t)) - (field (bbdb-current-field t)) - need-to-sort) - (or field (error "on an unfield")) - (setq need-to-sort - (apply 'bbdb-record-edit-field-internal record field)) - (bbdb-change-record record need-to-sort) - (bbdb-redisplay-one-record record) - ;; (bbdb-offer-save) - (if (and (eq 'property (car field)) - (or (eq 'mail-alias (caadr field)) - (eq 'net (caadr field)))) - (setq bbdb-define-all-aliases-needs-rebuilt 'edit)) - )) - -(defun bbdb-record-edit-name (bbdb-record) - (let (fn ln co need-to-sort new-name old-name) - (bbdb-error-retry - (progn - (if current-prefix-arg - (setq fn (bbdb-read-string "First Name: " - (bbdb-record-firstname bbdb-record)) - ln (bbdb-read-string "Last Name: " - (bbdb-record-lastname bbdb-record))) - (let ((names (bbdb-divide-name - (bbdb-read-string "Name: " - (bbdb-record-name bbdb-record))))) - (setq fn (car names) - ln (nth 1 names)))) - (setq need-to-sort - (or (not (string= fn - (or (bbdb-record-firstname bbdb-record) ""))) - (not (string= ln - (or (bbdb-record-lastname bbdb-record) ""))))) - (if (string= "" fn) (setq fn nil)) - (if (string= "" ln) (setq ln nil)) - ;; check for collisions - (setq new-name (if (and fn ln) (concat fn " " ln) - (or fn ln)) - old-name (bbdb-record-name bbdb-record)) - (if (and bbdb-no-duplicates-p - new-name - (not (and old-name (string= (downcase new-name) - (downcase old-name)))) - (bbdb-gethash (downcase new-name))) - (error "%s is already in the database!" new-name)))) - (setq co (bbdb-read-string "Company: " - (bbdb-record-company bbdb-record))) - (if (string= "" co) (setq co nil)) - (setq need-to-sort - (or need-to-sort - (not (equal (if co (downcase co) "") - (downcase (or (bbdb-record-company bbdb-record) - "")))))) - ;; - ;; delete the old hash entry - (let ((name (bbdb-record-name bbdb-record)) - (company (bbdb-record-company bbdb-record))) - (if (> (length name) 0) - (bbdb-remhash (downcase name) bbdb-record)) - (if (> (length company) 0) - (bbdb-remhash (downcase company) bbdb-record))) - (bbdb-record-set-namecache bbdb-record nil) - (bbdb-record-set-firstname bbdb-record fn) - (bbdb-record-set-lastname bbdb-record ln) - (bbdb-record-set-company bbdb-record co) - ;; add a new hash entry - (and (or fn ln) - (bbdb-puthash (downcase (bbdb-record-name bbdb-record)) - bbdb-record)) - need-to-sort)) - -(defun bbdb-record-edit-company (bbdb-record) - (let ((co (bbdb-read-string "Company: " (bbdb-record-company bbdb-record))) - need-to-sort) - - (if (string= "" co) (setq co nil)) - (setq need-to-sort - (or need-to-sort - (not (equal (if co (downcase co) "") - (downcase (or (bbdb-record-company bbdb-record) - "")))))) - - ;; delete the old hash entry - (let ((name (bbdb-record-name bbdb-record)) - (company (bbdb-record-company bbdb-record))) - (if (> (length name) 0) - (bbdb-remhash (downcase name) bbdb-record)) - (if (> (length company) 0) - (bbdb-remhash (downcase company) bbdb-record))) - - (bbdb-record-set-company bbdb-record co) - ;; add a new hash entry - (bbdb-puthash (downcase (bbdb-record-name bbdb-record)) - bbdb-record) - - need-to-sort)) - -(defun bbdb-address-edit-default (addr) - "Function to use for address editing. -The sub-fields are queried using the default order and using the -default names. Set `bbdb-address-editing-function' to an alternate -address editing function if you don't like this function. It is -mostly used for US style addresses. - -The sub-fields and the prompts used are: -Street, line n: (nth n street) -City: city -State: state -Zip Code: zip -Country: country" - (let* ((str (let ((l) (s) (n 0)) - (while (not (string= "" (setq s (bbdb-read-string - (format "Street, line %d: " (+ 1 n)) - (nth n (bbdb-address-streets addr)))))) - (setq l (append l (list s))) - (setq n (1+ n))) - l)) - (cty (bbdb-read-string "City: " (bbdb-address-city addr))) - (ste (bbdb-read-string "State: " (bbdb-address-state addr))) - (zip (bbdb-error-retry - (bbdb-parse-zip-string - (bbdb-read-string "Zip Code: " (bbdb-address-zip-string addr))))) - (country (bbdb-read-string "Country: " (or (bbdb-address-country addr) - bbdb-default-country)))) - (bbdb-address-set-streets addr str) - (bbdb-address-set-city addr cty) - (bbdb-address-set-state addr ste) - (bbdb-address-set-zip addr zip) - (if (string= "" (concat cty ste zip country (mapconcat 'identity str ""))) - ;; user didn't enter anything. this causes a display bug. this - ;; is a temporary fix. Ideally, we'd simply discard the entire - ;; address entry, but that's going to require bigger hacking. - (bbdb-address-set-country addr "Emacs") - (bbdb-address-set-country addr country)) - nil)) - -(defun bbdb-address-edit-continental (addr) - "Function to use for address editing. -The sub-fields are queried using the default order and using the -default names. Set `bbdb-address-editing-function' to an alternate -address editing function if you don't like this function. It is -mostly used for US style addresses. - -The sub-fields and the prompts used are: -Street, line n: (nth n street) -City: city -State: state -Zip Code: zip -Country: country" - (let* ((str (let ((l) (s) (n 0)) - (while (not (string= "" (setq s (bbdb-read-string - (format "Street, line %d: " (+ 1 n)) - (nth n (bbdb-address-streets addr)))))) - (setq l (append l (list s))) - (setq n (1+ n))) - l)) - (zip (bbdb-error-retry - (bbdb-parse-zip-string - (bbdb-read-string "Zip Code: " (bbdb-address-zip-string addr))))) - (cty (bbdb-read-string "City: " (bbdb-address-city addr))) - (ste "") - (country (bbdb-read-string "Country: " (or (bbdb-address-country addr) - bbdb-default-country)))) - (bbdb-address-set-streets addr str) - (bbdb-address-set-city addr cty) - (bbdb-address-set-state addr ste) - (bbdb-address-set-zip addr zip) - (if (string= "" (concat cty ste zip country (mapconcat 'identity str ""))) - ;; user didn't enter anything. this causes a display bug. this - ;; is a temporary fix. Ideally, we'd simply discard the entire - ;; address entry, but that's going to require bigger hacking. - (bbdb-address-set-country addr "Emacs") - (bbdb-address-set-country addr country)) - nil)) - -(defcustom bbdb-address-editing-function 'bbdb-address-edit-default - "Function to use for address editing. -The function must accept a BBDB address as parameter and allow the -user to edit it. This variable is called from `bbdb-record-edit-address'. -The default value is the symbol `bbdb-address-edit-default'." - :group 'bbdb-record-creation - :type 'function) - -(defun bbdb-record-edit-address (addr &optional location) - "Edit an address ADDR. -If optional parameter LOCATION is nil, edit the location sub-field -of the address as well. The address itself is edited using the editing -function in `bbdb-address-editing-function'." - (let ((loc - (or location (bbdb-read-string "Location: " - (or (bbdb-address-location addr) - (bbdb-label-completion-default - "addresses")) - (mapcar (function (lambda(x) (list x))) - (bbdb-label-completion-list - "addresses")))))) - (bbdb-address-set-location addr loc)) - (if current-prefix-arg - (bbdb-address-edit-default addr) - (funcall bbdb-address-editing-function addr))) - -(defun bbdb-record-edit-phone (phone-number &optional location) - (let ((newl (or location - (bbdb-read-string "Location: " - (or (bbdb-phone-location phone-number) - (bbdb-label-completion-default - "phones")) - (mapcar (function (lambda(x) (list x))) - (bbdb-label-completion-list - "phones"))))) - (newp (let ((bbdb-north-american-phone-numbers-p - (= (length phone-number) bbdb-phone-length))) - (bbdb-error-retry - (bbdb-parse-phone-number - (read-string "Phone: " (bbdb-phone-string phone-number))))))) - (bbdb-phone-set-location phone-number newl) - (bbdb-phone-set-area phone-number (nth 0 newp)) ; euronumbers too. - (if (= (length phone-number) 2) - nil - (bbdb-phone-set-exchange phone-number (nth 1 newp)) - (bbdb-phone-set-suffix phone-number (nth 2 newp)) - (bbdb-phone-set-extension phone-number (or (nth 3 newp) 0)))) - nil) - -(defun bbdb-record-edit-net (bbdb-record) - (let ((str (bbdb-read-string "Net: " - (mapconcat (function identity) - (bbdb-record-net bbdb-record) - ", ")))) - (let ((oldnets (bbdb-record-net bbdb-record)) - (newnets (bbdb-split str ","))) - ;; first check for any conflicts... - (if bbdb-no-duplicates-p - (let ((rest newnets)) - (while rest - (let ((old (delete bbdb-record (bbdb-gethash (downcase (car rest)))))) - (if old - (error "net address \"%s\" is used by \"%s\"" - (car rest) (mapconcat (lambda (r) (bbdb-record-name r)) - old ", ")))) - (setq rest (cdr rest))))) - ;; then update. - (let ((rest oldnets)) - (while rest - (bbdb-remhash (downcase (car rest)) bbdb-record) - (setq rest (cdr rest)))) - (let ((nets newnets)) - (while nets - (bbdb-puthash (downcase (car nets)) bbdb-record) - (setq nets (cdr nets)))) - (bbdb-record-set-net bbdb-record newnets))) - nil) - -(defun bbdb-record-edit-aka (bbdb-record) - (let ((str (bbdb-read-string "AKA: " - (mapconcat (function identity) - (bbdb-record-aka bbdb-record) - "; ")))) - (let ((oldaka (bbdb-record-aka bbdb-record)) - (newaka (bbdb-split str ";"))) - ;; first check for any conflicts... - (if bbdb-no-duplicates-p - (let ((rest newaka)) - (while rest - (let ((old (bbdb-gethash (downcase (car rest))))) - (if (and old (not (eq old bbdb-record))) - (error "alternate name address \"%s\" is used by \"%s\"" - (car rest) (bbdb-record-name old)))) - (setq rest (cdr rest))))) - ;; then update. - (let ((rest oldaka)) - (while rest - (bbdb-remhash (downcase (car rest)) bbdb-record) - (setq rest (cdr rest)))) - (let ((aka newaka)) - (while aka - (bbdb-puthash (downcase (car aka)) bbdb-record) - (setq aka (cdr aka)))) - (bbdb-record-set-aka bbdb-record newaka))) - nil) - -;;;###autoload -(defun bbdb-record-edit-notes (bbdb-record &optional regrind) - (interactive (list (bbdb-current-record t) t)) - (let ((notes (bbdb-read-string "Notes: " (bbdb-record-notes bbdb-record)))) - (bbdb-record-set-notes bbdb-record (if (string= "" notes) nil notes))) - (if regrind - (save-excursion - (set-buffer bbdb-buffer-name) - (bbdb-redisplay-one-record bbdb-record))) - nil) - -;;;###autoload -(defun bbdb-record-edit-property (bbdb-record &optional prop regrind) - (interactive (list (bbdb-current-record t) nil t)) - (let* ((propnames (bbdb-propnames)) - (propname (if prop (symbol-name prop) - (completing-read - (format "Edit property of %s: " - (bbdb-record-name bbdb-record)) - (cons '("notes") propnames)))) - (propsym (or prop (if (equal "" propname) 'notes (intern propname)))) - (string (bbdb-read-string (format "%s: " propname) - (bbdb-record-getprop bbdb-record propsym)))) - (bbdb-record-putprop bbdb-record propsym - (if (string= "" string) nil string))) - (if regrind - (save-excursion - (set-buffer bbdb-buffer-name) - (bbdb-redisplay-one-record bbdb-record))) - nil) - - -(defsubst bbdb-field-equal (x y) - (if (and (consp x) (consp y)) - (and (eq (car x) (car y)) - (eq (car (cdr x)) (car (cdr y))) - (eq (car (cdr (cdr x))) (car (cdr (cdr y))))) - (eq x y))) - -(defun bbdb-next-field (&optional count planning-on-modifying) - (or count (setq count 1)) - (beginning-of-line) - (let* ((record (bbdb-current-record planning-on-modifying)) - (field (bbdb-current-field planning-on-modifying)) - (next-record record) - (next-field field) - (signum (if (< count 0) -1 1)) - (i 0)) - (if (< count 0) (setq count (- count))) - (if field - (while (and next-field (< i count)) - (while (bbdb-field-equal next-field field) - (forward-line signum) - (setq next-record (bbdb-current-record planning-on-modifying) - next-field (bbdb-current-field planning-on-modifying)) - (or (eq next-record record) - (setq next-field nil))) - (setq i (1+ i)) - (setq field next-field))) - next-field)) - -;;;###autoload -(defun bbdb-transpose-fields (&optional arg) - "This is like the `transpose-lines' command, but it is for BBDB fields. -If the cursor is on a field of a BBDB record, that field and the previous -field will be transposed. - -With argument ARG, takes previous line and moves it past ARG fields. -With argument 0, interchanges field point is in with field mark is in. - -Both fields must be in the same record, and must be of the same basic type -\(that is, you can use this command to change the order in which phone-number -fields are listed, but you can't use it to make an address appear before a -phone number; the order of field types is fixed.\)" - (interactive "p") - (let ((record (bbdb-current-record t)) - moving-field position-after position-before - swap-p type list) - (if (/= arg 0) - (setq moving-field (or (bbdb-next-field -1 t) - (error "no previous field")) - position-after (bbdb-next-field arg t) - position-before (bbdb-next-field (if (< arg 0) -1 1) t)) - ;; if arg is 0, swap fields at point and mark - (setq swap-p t) - (setq position-after (bbdb-current-field)) - (save-excursion - (goto-char (mark)) - (setq moving-field (bbdb-current-field)) - (or (eq record (bbdb-current-record)) (error "not in the same record")))) - (if (< arg 0) - (let ((x position-after)) - (setq position-after position-before - position-before x) - (forward-line 2))) - (setq type (car moving-field)) - (or position-after position-before - (error "that would be out of the record!")) - (or (eq type (car position-after)) - (eq type (car position-before)) - (error "can't transpose fields of different types (%s and %s)" - type (if (eq type (car position-after)) - (car position-before) (car position-after)))) - (or (eq type (car position-after)) (setq position-after nil)) - (or (eq type (car position-before)) (setq position-before nil)) - (setq moving-field (nth 1 moving-field) - position-after (nth 1 position-after) - position-before (nth 1 position-before)) - (cond ((memq type '(name aka net)) - (error "there is only one %s field, so you can't transpose it" - type)) - ((memq type '(phone address property)) - (setq list (bbdb-record-get-field-internal record type))) - (t (error "doubleplus ungood: unknown field %s" type))) - (if swap-p - (let ((rest list)) - (while rest - (cond ((eq (car rest) moving-field) (setcar rest position-after)) - ((eq (car rest) position-after) (setcar rest moving-field))) - (setq rest (cdr rest)))) - (if (eq position-before (car list)) - (setq list (cons moving-field (delq moving-field list))) - (let ((rest list)) - (while (and rest (not (eq position-after (car rest)))) - (setq rest (cdr rest))) - (or rest (error "doubleplus ungood: couldn't reorder list")) - (let ((inhibit-quit t)) - (setq list (delq moving-field list)) - (setcdr rest (cons moving-field (cdr rest))))))) - (bbdb-record-store-field-internal record type list) - (bbdb-change-record record nil) - (bbdb-redisplay-one-record record))) - - -;;;###autoload -(defun bbdb-delete-current-field-or-record (&optional records noprompt) - "Delete the line which the cursor is on; actually, delete the field which -that line represents from the database. If the cursor is on the first line -of a database entry (the name/company line) then the entire entry will be -deleted." - (interactive (list (if (bbdb-do-all-records-p) - (mapcar 'car bbdb-records) - (list (bbdb-current-record))) - current-prefix-arg)) - (let* ((field (bbdb-current-field t)) - (type (car field)) - record - (name (cond ((null field) (error "on an unfield")) - ((eq type 'property) (symbol-name (car (nth 1 field)))) - (t (symbol-name type))))) - (while records - (setq record (car records)) - (if (eq type 'name) - (bbdb-delete-current-record record noprompt) - (if (not (or noprompt - (bbdb-y-or-n-p (format "delete this %s field (of %s)? " - name - (bbdb-record-name record))))) - nil - (cond ((memq type '(phone address)) - (bbdb-record-store-field-internal - record type - (delq (nth 1 field) - (bbdb-record-get-field-internal record type)))) - ((memq type '(net aka)) - (let ((rest (bbdb-record-get-field-internal record type))) - (while rest - (bbdb-remhash (downcase (car rest)) record) - (setq rest (cdr rest)))) - (bbdb-record-store-field-internal record type nil)) - ((eq type 'property) - (bbdb-record-putprop record (car (nth 1 field)) nil)) - (t (error "doubleplus ungood: unknown field type"))) - (bbdb-change-record record nil) - (bbdb-redisplay-one-record record))) - (setq records (cdr records))))) - -;;;###autoload -(defun bbdb-delete-current-record (recs &optional noprompt) - "Delete the entire bbdb database entry which the cursor is within. -Pressing \\\\[bbdb-apply-next-command-to-all-records] will -delete all records listed in the BBDB buffer." - (interactive (list (if (bbdb-do-all-records-p) - (mapcar 'car bbdb-records) - (list (bbdb-current-record t))) - current-prefix-arg)) - (if (not (listp recs)) - (setq recs (list recs))) - (while recs - (let ((r (car recs))) - (setq recs (cdr recs)) - (bbdb-debug (if (bbdb-record-deleted-p r) - (error "deleting deleted record"))) - (if (or noprompt - (bbdb-y-or-n-p (format "delete the entire db entry of %s? " - (or (bbdb-record-name r) - (bbdb-record-company r) - (car (bbdb-record-net r)))))) - (let* ((record-cons (assq r bbdb-records)) - (next-record-cons (car (cdr (memq record-cons - bbdb-records))))) - (bbdb-debug (if (bbdb-record-deleted-p r) - (error "deleting deleted record"))) - (bbdb-record-set-deleted-p r t) - (bbdb-delete-record-internal r) - (if (eq record-cons (car bbdb-records)) - (setq bbdb-records (cdr bbdb-records)) - (let ((rest bbdb-records)) - (while (cdr rest) - (if (eq record-cons (car (cdr rest))) - (progn - (setcdr rest (cdr (cdr rest))) - (setq rest nil))) - (setq rest (cdr rest))))) - (bbdb-redisplay-one-record r record-cons next-record-cons t) - (bbdb-with-db-buffer - (setq bbdb-changed-records (delq r bbdb-changed-records))) - ;; (bbdb-offer-save) - ))))) - -(defun bbdb-change-records-state-and-redisplay (desired-state records) - (let (rec) - (while records - (setq rec (car records)) - (unless (eq desired-state (nth 1 rec)) - (setcar (cdr rec) desired-state) - (bbdb-redisplay-one-record (car rec) rec)) - (setq records (cdr records))))) - -;;;###autoload -(defun bbdb-toggle-all-records-display-layout (arg &optional records) - "Show all the fields of all visible records. -Like `bbdb-toggle-records-display-layout' but for all visible records." - (interactive "P") - (if (null records) - (setq records bbdb-records)) - (let* ((record (bbdb-current-record)) - (cons (assq record bbdb-records)) - (current-state (nth 1 cons)) - (layout-alist - (or (delete nil (mapcar (lambda (l) - (if (and (assoc 'toggle l) - (cdr (assoc 'toggle l))) - l)) - bbdb-display-layout-alist)) - bbdb-display-layout-alist)) - (desired-state (assoc current-state layout-alist))) - (setq desired-state - (cond ((eq arg 0) - 'one-line) - ((null current-state) - 'multi-line) - ((null (cdr (memq desired-state layout-alist))) - (caar layout-alist)) - (t - (caadr (memq desired-state layout-alist))))) - (message "Using %S layout" desired-state) - (bbdb-change-records-state-and-redisplay desired-state records))) - -;;;###autoload -(defun bbdb-toggle-records-display-layout (arg) - "Toggle whether the current record is displayed expanded or elided -\(multi-line or one-line display.\) With a numeric argument of 0, the -current record will unconditionally be made elided; with any other argument, -the current record will unconditionally be shown expanded. -\\ -If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-toggle-records-display-layout]\" is \ -used instead of simply \"\\[bbdb-toggle-records-display-layout]\", then the state of all \ -records will -be changed instead of just the one at point. In this case, an argument -of 0 means that all records will unconditionally be made elided; any other -numeric argument means that all of the records will unconditionally be shown -expanded; and no numeric argument means that the records are made to be in -the opposite state of the record under point." - (interactive "P") - (bbdb-toggle-all-records-display-layout - arg - (if (not (bbdb-do-all-records-p)) - (list (assq (bbdb-current-record) bbdb-records))))) - -;;;###autoload -(defun bbdb-display-all-records-completely - (arg &optional records) - "Show all the fields of all currently displayed records. -The display layout `full-multi-line' is used for this." - (interactive "P") - (if (null records) - (setq records bbdb-records)) - (let* ((record (bbdb-current-record)) - (cons (assq record bbdb-records)) - (current-state (nth 1 cons)) - (desired-state - (cond ((not (eq current-state 'full-multi-line)) - 'full-multi-line) - (t - 'multi-line)))) - (bbdb-change-records-state-and-redisplay desired-state records))) - -;;;###autoload -(defun bbdb-display-record-completely (arg) - "Show all the fields of the current record. -The display layout `full-multi-line' is used for this." - (interactive "P") - (bbdb-display-all-records-completely - arg - (if (not (bbdb-do-all-records-p)) - (list (assq (bbdb-current-record) bbdb-records))))) - -;;;###autoload -(defun bbdb-display-record-with-layout (layout &optional records) - "Show all the fields of the current record using LAYOUT." - (interactive (list (completing-read "Layout: " - (mapcar (lambda (i) - (list (symbol-name (car i)))) - bbdb-display-layout-alist)))) - (when (stringp layout) - (setq layout (intern layout))) - (when (null records) - (setq records bbdb-records)) - (bbdb-change-records-state-and-redisplay layout records)) - -;;;###autoload -(defun bbdb-omit-record (n) - "Remove the current record from the display without deleting it from the -database. With a prefix argument, omit the next N records. If negative, -omit backwards." - (interactive "p") - (while (not (= n 0)) - (if (< n 0) (bbdb-prev-record 1)) - (let* ((record (or (bbdb-current-record) (error "no records"))) - (rest bbdb-records) - cons next prev-tail) - (while rest - (if (eq (car (car rest)) record) - (setq cons (car rest) - next (car (cdr rest)) - rest nil) - (setq prev-tail rest - rest (cdr rest)))) - (or record (error "can't find current record")) - (let ((buffer-read-only nil)) - (delete-region (nth 2 cons) (if next (nth 2 next) (point-max)))) - (if prev-tail - (setcdr prev-tail (cdr (cdr prev-tail))) - (setq bbdb-records (cdr bbdb-records))) - (setq n (if (> n 0) (1- n) (1+ n))))) - (bbdb-frob-mode-line (length bbdb-records))) - -;;; Fixing up bogus entries - -(defcustom bbdb-refile-notes-generate-alist '((creation-date . bbdb-refile-notes-string-least) (timestamp . bbdb-refile-notes-string-most)) - "*An alist defining specific merging function, based on notes field." - :group 'bbdb-noticing-records - :type '(repeat (cons - (symbol :tag "Notes filed") - (hook :tag "Generating function")))) - -(defcustom bbdb-refile-notes-default-merge-function 'bbdb-refile-notes-default-merge-function - "*Default function to use for merging BBDB notes records. - -If the note field has an entry in `bbdb-refile-notes-generate-alist', -that function will be used instead." - :group 'bbdb-noticing-records - :type 'function) - - -(defun bbdb-refile-notes-default-merge-function (string1 string2) - "Returns the concatenation of STRING1 and STRING2" - (concat string1 "\n" string2)) - -(defun bbdb-refile-notes-remove-duplicates (string1 string2) - "Concatenate STRING1 and STRING2, but remove duplicate lines." - (let ((note1 (split-string string1 "\n")) - (note2 (split-string string2 "\n"))) - (while note2 - (if (not (member (car note2) note1)) - (setq note1 (cons (car note2) note1))) - (setq note2 (cdr note2))) - (mapconcat 'identity note1 "\n"))) - -(defun bbdb-refile-notes-string-least (string1 string2) - "Returns the string that is lessp." - (if (string-lessp string1 string2) - string1 - string2)) - -(defun bbdb-refile-notes-string-most (string1 string2) - "Returns the string that is not lessp." - (if (string-lessp string1 string2) - string2 - string1)) - -(defun bbdb-merge-lists! (l1 l2 cmp &optional mod) - "Merge two lists l1 l2 (modifies l1) only adds elements from l2 -if cmp returns false for all elements of l1. If optional mod -is provided it is applied to each element of l1 and l2 prior to cmp" - (if (null l1) - l2 - (let ((end (last l1)) - (src2 l2) - (chk (if mod (mapcar mod l1) (append l1 '())))) - (while src2 - (let ((fail '()) - (src1 chk) - (val (if mod (apply mod (car src2) '()) (car src2)))) - (while src1 - (if (apply cmp (car src1) val '()) - (setq src1 '() - fail 't) - (setq src1 (cdr src1)))) - (if fail '() - (setcdr end (cons (car src2) '())) - (setq end (cdr end))) - (setq src2 (cdr src2)))) - l1))) - -(defun bbdb-merge-records (old-record new-record) - "Merge the contents of old-record into new-record, old-record -remains unchanged. For name and company it queries about which to use -if they differ. All other fields are concatenated. Idealy this would -be better about checking for duplicate entries in other fields, as -well as possibly querying about differing values. - -This function does nothing to ensure the integrity of the rest of the -database, that is somebody elses problem (something like -`bbdb-refile-record')." - (if (or (null new-record) (eq old-record new-record)) - (error "those are the same")) - (let ((new-name (bbdb-record-name new-record)) - (new-co (bbdb-record-company new-record)) - (old-name (bbdb-record-name old-record)) - (old-co (bbdb-record-company old-record)) - (old-nets (bbdb-record-net old-record)) - (old-aka (bbdb-record-aka old-record)) - extra-name) - (let ((name - (cond ((= 0 (length old-name)) - (cons (bbdb-record-firstname new-record) - (bbdb-record-lastname new-record))) - ((= 0 (length new-name)) - (cons (bbdb-record-firstname old-record) - (bbdb-record-lastname old-record))) - ((string-equal (downcase old-name) (downcase new-name)) - (cons (bbdb-record-firstname new-record) - (bbdb-record-lastname new-record))) - (t (prog1 - (if (bbdb-y-or-n-p - (format "Use name \"%s\" instead of \"%s\"? " - old-name new-name)) - (progn - (setq extra-name new-record) - (cons (bbdb-record-firstname old-record) - (bbdb-record-lastname old-record))) - (setq extra-name old-record) - (cons (bbdb-record-firstname new-record) - (bbdb-record-lastname new-record))) - (or (and bbdb-use-alternate-names - (bbdb-y-or-n-p - (format "Keep \"%s\" as an alternate name? " - (bbdb-record-name extra-name)))) - (setq extra-name nil)))))) - (comp (cond ((= 0 (length old-co)) new-co) - ((= 0 (length new-co)) old-co) - ((string-equal old-co new-co) new-co) - (t (if (bbdb-y-or-n-p - (format "Use company \"%s\" instead of \"%s\"? " - old-co new-co)) - old-co new-co))))) - - (if extra-name - (setq old-aka (cons (bbdb-record-name extra-name) old-aka))) - - (bbdb-record-set-phones new-record - (bbdb-merge-lists! - (bbdb-record-phones new-record) - (bbdb-record-phones old-record) - 'equal)) - (bbdb-record-set-addresses new-record - (bbdb-merge-lists! - (bbdb-record-addresses new-record) - (bbdb-record-addresses old-record) - 'equal)) - (bbdb-record-set-company new-record comp) - - (let ((n1 (bbdb-record-raw-notes new-record)) - (n2 (bbdb-record-raw-notes old-record)) - tmp) - (or (equal n1 n2) - (progn - (or (listp n1) (setq n1 (list (cons 'notes n1)))) - (or (listp n2) (setq n2 (list (cons 'notes n2)))) - (while n2 - (if (setq tmp (assq (car (car n2)) n1)) - (setcdr tmp - (funcall - (or (cdr (assq (car (car n2)) - bbdb-refile-notes-generate-alist)) - bbdb-refile-notes-default-merge-function) - (cdr tmp) (cdr (car n2)))) - (setq n1 (nconc n1 (list (car n2))))) - (setq n2 (cdr n2))) - (bbdb-record-set-raw-notes new-record n1)))) - - (bbdb-record-set-firstname new-record (car name)) - (bbdb-record-set-lastname new-record (cdr name)) - (bbdb-record-set-namecache new-record nil) - - (bbdb-record-set-net new-record - (bbdb-merge-lists! - (bbdb-record-net new-record) old-nets - 'string= 'downcase)) - (bbdb-record-set-aka new-record - (bbdb-merge-lists! - (bbdb-record-aka new-record) old-aka - 'string= 'downcase)) - new-record))) - -;;;###autoload -(defun bbdb-refile-record (old-record new-record) - "Merge the current record into some other record; that is, delete the -record under point after copying all of the data within it into some other -record. this is useful if you realize that somehow a redundant record has -gotten into the database, and you want to merge it with another. - -If both records have names and/or companies, you are asked which to use. -Phone numbers, addresses, and network addresses are simply concatenated. -The first record is the record under the point; the second is prompted for. -Completion behaviour is as dictated by the variable `bbdb-completion-type'." - (interactive - (let ((r (bbdb-current-record)) - name) - (setq name (bbdb-record-name r)) - (list r - (if current-prefix-arg - (car (delq r (bbdb-search (bbdb-records) name nil))) - (bbdb-completing-read-one-record - (format "merge record \"%s\" into: " - (or (bbdb-record-name r) (car (bbdb-record-net r)) - "???")) (list r)))))) - - (if (or (null new-record) (eq old-record new-record)) - (error "those are the same")) - (setq new-record (bbdb-merge-records old-record new-record)) - - (bbdb-delete-current-record old-record 'noprompt) - (bbdb-change-record new-record t) ; don't always need-to-sort... - (let ((bbdb-display-layout nil)) - (if (assq new-record bbdb-records) - (bbdb-redisplay-one-record new-record)) - (bbdb-with-db-buffer - (if (not (memq new-record bbdb-changed-records)) - (setq bbdb-changed-records - (cons new-record bbdb-changed-records)))) - (if (null bbdb-records) ; nothing displayed, display something. - (bbdb-display-records (list new-record)))) - (message "records merged.")) - -;; sort the notes -(defcustom bbdb-notes-sort-order - '((notes . 0) (www . 1) (ftp . 2) (gopher . 3) (telnet . 4) (mail-alias . 5) - (mail-folder . 6) (lpr . 7) (creation-date . 1000) (timestamp . 1001)) - "*The order for sorting the notes. -If a note is not in the alist, it is assigned weight 100, so all notes -with weights less then 100 will be in the beginning, and all notes with -weights more than 100 will be in the end." - :group 'bbdb-noticing-records - :type 'list) - -;;;###autoload -(defun bbdb-sort-notes (rec) - "Sort the notes in the record according to `bbdb-notes-sort-order'. -Can be used in `bbdb-change-hook'." - (flet ((kk (nt) (or (cdr (assq (car nt) bbdb-notes-sort-order)) 100))) - (bbdb-record-set-raw-notes - rec (sort (bbdb-record-raw-notes rec) - (lambda (aa bb) (< (kk aa) (kk bb))))))) - -;;;###autoload -(defun bbdb-sort-phones (rec) - "Sort the phones in the record according to the location. -Can be used in `bbdb-change-hook'." - (bbdb-record-set-phones - rec (sort (bbdb-record-phones rec) - (lambda (xx yy) (string< (aref xx 0) (aref yy 0)))))) - -;;;###autoload -(defun bbdb-sort-addresses (rec) - "Sort the addresses in the record according to the location. -Can be used in `bbdb-change-hook'." - (bbdb-record-set-addresses - rec (sort (bbdb-record-addresses rec) - (lambda (xx yy) (string< (aref xx 0) (aref yy 0)))))) - - -;;; Send-Mail interface - -(defcustom bbdb-dwim-net-address-allow-redundancy nil - "*Non-nil means always use full name when sending mail, even if same as net." - :group 'bbdb - :type '(choice (const :tag "Disallow redundancy" nil) - (const :tag "Return only the net" 'netonly) - (const :tag "Allow redundancy" t))) - -;;;###autoload -(defun bbdb-dwim-net-address (record &optional net) - "Returns a string to use as the email address of the given record. The -given address is the address the mail is destined to; this is formatted like -\"Firstname Lastname \" unless both the first name and last name are -constituents of the address, as in John.Doe@SomeHost, or the address is -already in the form \"Name \" or \"foo (Name)\", in which case the -address is used as-is. If `bbdb-dwim-net-address-allow-redundancy' is non-nil, -the name is always included. If `bbdb-dwim-net-address-allow-redundancy' is -'netonly the name is never included!" - (or net (setq net (car (bbdb-record-net record)))) - (or net (error "record unhas network addresses")) - (let* ((override (bbdb-record-getprop record 'mail-name)) - (name (or override (bbdb-record-name record))) - fn ln (i 0)) - (if override - (let ((both (bbdb-divide-name override))) - (setq fn (car both) - ln (car (cdr both))) - (if (equal fn "") (setq fn nil)) - (if (equal ln "") (setq ln nil))) - (setq fn (bbdb-record-firstname record) - ln (bbdb-record-lastname record))) - ;; if the name contains backslashes or double-quotes, backslash them. - (if name - (while (setq i (string-match "[\\\"]" name i)) - (setq name (concat (substring name 0 i) "\\" (substring name i)) - i (+ i 2)))) - (cond ((eq 'netonly bbdb-dwim-net-address-allow-redundancy) - net) - ((or (null name) - (if (not bbdb-dwim-net-address-allow-redundancy) - (cond ((and fn ln) - (or (string-match - (concat "\\`[^!@%]*\\b" (regexp-quote fn) - "\\b[^!%@]+\\b" (regexp-quote ln) "\\b") - net) - (string-match - (concat "\\`[^!@%]*\\b" (regexp-quote ln) - "\\b[^!%@]+\\b" (regexp-quote fn) "\\b") - net))) - ((or fn ln) - (string-match - (concat "\\`[^!@%]*\\b" (regexp-quote (or fn ln)) "\\b") - net)))) - ;; already in "foo " or "bar " format. - (string-match "\\`[ \t]*[^<]+[ \t]*<" net) - (string-match "\\`[ \t]*[^(]+[ \t]*(" net)) - net) - ;; if the name contains control chars or RFC822 specials, it needs - ;; to be enclosed in quotes. Double-quotes and backslashes have - ;; already been escaped. This quotes a few extra characters as - ;; well (!,%, and $) just for common sense. - ((string-match "[][\000-\037\177()<>@,;:.!$%]" name) - (format "\"%s\" <%s>" name net)) - (t - (format "%s <%s>" name net))))) - - -(defun bbdb-send-mail-internal (&optional to subj records) - (let ((type (or bbdb-send-mail-style - ;; In Emacs, `compose-mail' gets whatever you've - ;; customized as your preferred `mail-user-agent'. - (cond ((fboundp 'compose-mail) 'compose-mail) - ((featurep 'mh-e) 'mh) - ((featurep 'vm) 'vm) - ((featurep 'message) 'message) - ((featurep 'mew) 'mew) - ((featurep 'gnus) 'gnus) - (t 'mail))))) - (cond - ((eq type 'mh) - (or (fboundp 'mh-send) (autoload 'mh-send "mh-e")) - (mh-send to "" (or subj ""))) - ((eq type 'vm) - (cond ((not (fboundp 'vm-mail-internal)) - (load-library "vm") ; 5.32 or later - (or (fboundp 'vm-mail-internal) - (load-library "vm-reply")))) ; 5.31 or earlier - (vm-session-initialization) - (vm-mail-internal nil to subj) - (run-hooks 'vm-mail-hook) - (run-hooks 'vm-mail-mode-hook)) - ((eq type 'message) - (or (fboundp 'message-mail) (autoload 'message-mail "message")) - (message-mail to subj)) - ((or (eq type 'mail) (eq type 'rmail)) - (mail nil to subj)) - ((eq type 'mew) - (or (fboundp 'mew-send) (load-library "mew")) - (mew-send to nil subj)) - ((eq type 'compose-mail) - (compose-mail to subj)) - ((eq type 'gnus) - (gnus-msg-mail to subj)) - (t - (error "bbdb-send-mail-style must be vm, mh, message, compose-mail, or rmail"))))) - -;;;###autoload -(defun bbdb-send-mail (bbdb-record &optional subject) - "Compose a mail message to the person indicated by the current bbdb record. -The first (most-recently-added) address is used if there are more than one. -\\ -If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-send-mail]\" is \ -used instead of simply \"\\[bbdb-send-mail]\", then mail will be sent to \ -all of the -folks listed in the *BBDB* buffer instead of just the person at point." - (interactive (list (if (bbdb-do-all-records-p) - (mapcar 'car bbdb-records) - (bbdb-current-record)))) - (if (consp bbdb-record) - (bbdb-send-mail-many bbdb-record subject) - (bbdb-send-mail-1 bbdb-record subject))) - - -(defun bbdb-send-mail-1 (bbdb-record &optional subject) - (if bbdb-inside-electric-display - (bbdb-electric-throw-to-execute - (list 'bbdb-send-mail bbdb-record subject))) - ;; else... - - (cond ((null bbdb-record) (error "record unexists")) - ((null (bbdb-record-net bbdb-record)) - (error "Current record unhas a network addresses.")) - (t (bbdb-send-mail-internal (bbdb-dwim-net-address bbdb-record) - subject (list bbdb-record)) - (if (re-search-backward "^Subject: $" nil t) (end-of-line))))) - - -(defun bbdb-send-mail-many (records &optional subject) - (if bbdb-inside-electric-display - (bbdb-electric-throw-to-execute - (list 'bbdb-send-mail (list 'quote records) subject))) - ;; else... - - (let ((good '()) (bad '()) - (orec records)) - (while records - (if (bbdb-record-net (car records)) - (setq good (cons (car records) good)) - (setq bad (cons (car records) bad))) - (setq records (cdr records))) - (bbdb-send-mail-internal - (mapconcat (lambda (x) (bbdb-dwim-net-address x)) - (nreverse good) ",\n ") - subject orec) - (if (not bad) nil - (goto-char (point-max)) - (let ((p (point)) - (fill-prefix " ") - (fill-column 70)) - (insert "*** Warning: No net addresses for " - (mapconcat (lambda (x) (bbdb-record-name x)) - (nreverse bad) ", ") ".") - (fill-region-as-paragraph p (point)) - (goto-char p)))) - (if (re-search-backward "^Subject: $" nil t) (end-of-line))) - - -(defun bbdb-yank-addresses () - "CC the people displayed in the *BBDB* buffer on this message. -The primary net-address of each of the records currently listed in the -*BBDB* buffer (whether it is visible or not) will be appended to the -CC: field of the current buffer (assuming the current buffer is a mail -composition buffer.)" - (interactive) - (let ((addrs (save-excursion - (set-buffer bbdb-buffer-name) - (delq nil - (mapcar (lambda (x) - (if (bbdb-record-net (car x)) - (bbdb-dwim-net-address (car x)) - nil)) - bbdb-records))))) - (goto-char (point-min)) - ;; If there's a CC field, move to the end of it, inserting a comma if - ;; there are already addresses present. - ;; Otherwise, if there's an empty To: field, move to the end of it. - ;; Otherwise, insert an empty CC: field. - (if (re-search-forward "^CC:[ \t]*" nil t) - (if (eolp) - nil - (end-of-line) - (while (looking-at "\n[ \t]") - (forward-char) (end-of-line)) - (insert ",\n") - (indent-relative)) - (re-search-forward "^To:[ \t]*") - (if (eolp) - nil - (end-of-line) - (while (looking-at "\n[ \t]") - (forward-char) (end-of-line)) - (insert ",\n") - (indent-relative)) - (if (eolp) - nil - (end-of-line) - (while (looking-at "\n[ \t]") - (forward-char) (end-of-line)) - (insert "\nCC:") - (indent-relative))) - ;; Now insert each of the addresses on its own line. - (while addrs - (insert (car addrs)) - (if (cdr addrs) (progn (insert ",\n") (indent-relative))) - (setq addrs (cdr addrs))))) - -;;;###autoload -(defun bbdb-show-all-recipients () - "*Display BBDB records for all recipients of the message in this buffer." - (interactive) - (let ((marker (bbdb-header-start)) - (fields '("from" "sender" "to" "cc" "bcc" - "resent-from" "resent-to" "resent-cc" "resent-bcc")) - addrs) - (message "Searching...") - (save-excursion - (set-buffer (marker-buffer marker)) - (while fields - (goto-char marker) - (setq addrs (append (bbdb-split (or (bbdb-extract-field-value - (car fields)) - "") - ",") - addrs) - fields (cdr fields)))) - (let ((rest addrs) - (records '()) - record) - (while rest - (setq record (bbdb-annotate-message-sender (car rest) t t t)) - (if record (setq records (cons record records))) - (setq rest (cdr rest))) - (message "Sorting...") - (setq records (sort records (lambda (x y) (bbdb-record-lessp x y)))) - (bbdb-display-records records)))) - - -;;; completion - -;;;###autoload -(defun bbdb-completion-check-record (sym rec) - (let ((name (or (bbdb-record-name rec) - (bbdb-record-company rec) - "")) - (nets (bbdb-record-net rec)) - ok) - - (if (null bbdb-completion-type) - (setq ok 't) - - (if (memq bbdb-completion-type - '(name primary-or-name name-or-primary)) - (setq ok (string= sym (downcase name)))) - - ;; #### handle AKA, mail-name or mail-alias here? - (if ok '() - (when (eq bbdb-completion-type 'net) - (while (and nets (not ok)) - (setq ok (string= sym (downcase (car nets))) - nets (cdr nets)))) - (when (and nets (memq bbdb-completion-type - '(primary primary-or-name name-or-primary))) - (setq ok (string= sym (downcase (car nets))))))) - ok)) - - -;;;###autoload -(defun bbdb-completion-predicate (symbol) - "For use as the third argument to `completing-read'. -Obey the semantics of `bbdb-completion-type'." - (cond ((null bbdb-completion-type) - t) - ((not (boundp symbol)) - nil) - (t - (let ((sym (symbol-name symbol)) - (recs (symbol-value symbol)) - ok) - (while (and recs (not ok)) - (setq ok (bbdb-completion-check-record sym (car recs)) - recs (cdr recs))) - ok)))) - -(defun bbdb-completing-read-record (prompt &optional omit-records) - "Prompt for and return a record from the bbdb. -Completion is done according to `bbdb-completion-type'. If the user -just hits return, nil is returned. Otherwise, a valid response is forced." - (let* ((ht (bbdb-hashtable)) - (completion-ignore-case 't) - (string (completing-read prompt ht 'bbdb-completion-predicate t)) - (symbol (and (not (= 0 (length string))) - (intern-soft string ht)))) - (if symbol - (if (and (boundp symbol) (symbol-value symbol)) - (let ((recs (symbol-value symbol)) ret) - (while recs - (if (and (not (memq (car recs) omit-records)) - (bbdb-completion-check-record (symbol-name symbol) - (car recs))) - (setq ret (cons (car recs) ret))) - (setq recs (cdr recs))) - ret) - (error "selecting deleted (unhashed) record \"%s\"!" symbol)) - nil))) - -(defun bbdb-completing-read-one-record (prompt &optional omit-records) - "Prompt for and return a single record from the bbdb; -completion is done according to `bbdb-completion-type'. If the user -just hits return, nil is returned. Otherwise, a valid response is forced. -if omit-records is non-nil it should be a list of records to dis-allow -completion with." - (let ((records (bbdb-remove-memq-duplicates - (bbdb-completing-read-record prompt omit-records)))) - (cond - ((eq (length records) 1) - (car records)) - ((> (length records) 1) - (let ((count (length records)) - prompts result) - (bbdb-display-records records) - (while (> count 0) - (setq prompts (cons (list (number-to-string count) count) prompts) - count (1- count))) - (setq result - (completing-read (format "Which duplicate record (1-%s): " - (length records)) - prompts nil t "1")) - (nth (1- (string-to-number result)) records))) - (t - nil)))) - -(defvar bbdb-read-addresses-with-completion-map - (let ((map (copy-keymap minibuffer-local-completion-map))) - (define-key map " " 'self-insert-command) - (define-key map "\t" 'bbdb-complete-name) - (define-key map "\M-\t" 'bbdb-complete-name) - map)) - -;;;###autoload -(defun bbdb-read-addresses-with-completion (prompt &optional default) - "Like `read-string', but allows `bbdb-complete-name' style completion." - (read-from-minibuffer prompt default - bbdb-read-addresses-with-completion-map)) - - -;; Internal use. Store the window configuration before we pop up the -;; completion buffer. -(defvar bbdb-complete-name-saved-window-config nil) - -;; Restore the saved window configuration -(defun bbdb-complete-name-cleanup () - (if bbdb-complete-name-saved-window-config - (progn - (if (get-buffer-window "*Completions*") - (progn - (set-window-configuration - bbdb-complete-name-saved-window-config) - (bury-buffer "*Completions*")) - ) - (setq bbdb-complete-name-saved-window-config nil)))) - -(defun bbdb-display-completion-list (list &optional callback data) - "Wrapper for `display-completion-list'. -GNU Emacs requires DATA to be in a specific format, viz. (nth 1 data) should -be a marker for the start of the region being completed." - (if (featurep 'xemacs) - (display-completion-list list :activate-callback callback - :user-data data) - (display-completion-list list) - ;; disgusting hack to make GNU Emacs nuke the bit you've typed - ;; when it inserts the completion. - (if data - (save-excursion - (set-buffer standard-output) - (setq completion-base-size - (- (marker-position (nth 1 data)) 1)))))) - -(defun bbdb-complete-clicked-name (event extent user-data) - "Find the record for a name clicked in a completion buffer. -Currently only used by XEmacs." - (let ((buffer (nth 0 user-data)) - (bbdb-complete-name-allow-cycling nil) - (beg (nth 1 user-data)) - (end (nth 2 user-data))) - (bbdb-complete-name-cleanup) - (set-buffer buffer) - (goto-char beg) - (delete-region beg end) - (insert (bbdb-extent-string extent)) - (bbdb-complete-name beg))) - - -(defun bbdb-list-overlap (l1 l2) - (let (ok) - (while (and (not ok) l1) - (if (memq (car l1) l2) (setq ok t l1 '()) - (setq l1 (cdr l1)))) - ok)) - -(defun bbdb-remove-assoc-duplicates (l) - (if (null l) '() - (if (assoc (car (car l)) (cdr l)) - (bbdb-remove-assoc-duplicates (cdr l)) - (cons (car l) (bbdb-remove-assoc-duplicates (cdr l)))))) - -(defcustom bbdb-complete-name-allow-cycling nil - "Whether to allow cycling of email addresses when calling -`bbdb-complete-name' on a completed address in a composition buffer." - :group 'bbdb-mua-specific - :type 'boolean) - -(defcustom bbdb-complete-name-hooks nil - "List of functions called after a sucessful completion." - :group 'bbdb-mua-specific - :type 'boolean) - -(eval-when-compile (defvar auto-fill-hook)) - -;;;###autoload -(defun bbdb-complete-name (&optional start-pos) - "Complete the user full-name or net-address before point (up to the -preceeding newline, colon, or comma, or the value of START-POS). If -what has been typed is unique, insert an entry of the form \"User Name -\" (although see documentation for -bbdb-dwim-net-address-allow-redundancy). If it is a valid completion -but not unique, a list of completions is displayed. - -If the completion is done and `bbdb-complete-name-allow-cycling' is -true then cycle through the nets for the matching record. - -When called with a prefix arg then display a list of all nets. - -Completion behaviour can be controlled with `bbdb-completion-type'." - (interactive) - - (let* ((end (point)) - (beg (or start-pos - (save-excursion - (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") - (goto-char (match-end 0)) - (point)))) - (orig (buffer-substring beg end)) - (typed (downcase orig)) - (pattern (bbdb-string-trim typed)) - (ht (bbdb-hashtable)) - ;; make a list of possible completion strings - ;; (all-the-completions), and a flag to indicate if there's a - ;; single matching record or not (only-one-p) - (only-one-p t) - (all-the-completions nil) - (pred - (lambda (sym) - (when (bbdb-completion-predicate sym) - (if (and only-one-p - all-the-completions - (or - ;; not sure about this. more than one record - ;; attached to the symbol? does that happen? - (> (length (symbol-value sym)) 1) - ;; this is the doozy, though. multiple syms - ;; which all match the same record - (delete t (mapcar (lambda(x) - (equal (symbol-value x) - (symbol-value sym))) - all-the-completions)))) - (setq only-one-p nil)) - (if (not (memq sym all-the-completions)) - (setq all-the-completions (cons sym all-the-completions)))))) - (completion (try-completion pattern ht pred)) - (exact-match (eq completion t))) - - (cond - ;; No matches found OR you're trying completion on an - ;; already-completed record. In the latter case, we might have to - ;; cycle through the nets for that record. - ((or (null completion) - (and bbdb-complete-name-allow-cycling - exact-match ;; which is a net of the record - (member orig - (bbdb-record-net - (car (symbol-value (intern-soft pattern ht))))))) - ;; Clean up the completion buffer, if it exists - (bbdb-complete-name-cleanup) - ;; Check for cycling - (or (catch 'bbdb-cycling-exit - ;; jump straight out if we're not cycling - (or bbdb-complete-name-allow-cycling - (throw 'bbdb-cycling-exit nil)) - - ;; find the record we're working on. - (let* ((addr (funcall bbdb-extract-address-components-func orig)) - (rec - (if (listp addr) - ;; for now, we're ignoring the case where this - ;; returns more than one record. Ideally, the - ;; last expansion would be stored in a - ;; buffer-local variable, perhaps. - (car (bbdb-search-intertwingle (caar addr) - (cadar addr))) - nil))) - (or rec - (throw 'bbdb-cycling-exit nil)) - - (if current-prefix-arg - ;; use completion buffer - (let ((standard-output (get-buffer-create "*Completions*"))) - ;; a previously existing buffer has to be cleaned first - (save-excursion (set-buffer standard-output) - (setq buffer-read-only nil) - (erase-buffer)) - (display-completion-list - (mapcar (lambda (n) (bbdb-dwim-net-address rec n)) - (bbdb-record-net rec))) - (delete-region beg end) - (switch-to-buffer standard-output)) - ;; use next address - (let* ((addrs (bbdb-record-net rec)) - (this-addr (or (cadr (member (car (cdar addr)) addrs)) - (nth 0 addrs)))) - (if (= (length addrs) 1) - ;; no alternatives. don't signal an error. - (throw 'bbdb-cycling-exit t) - ;; replace with new mail address - (delete-region beg end) - (insert (bbdb-dwim-net-address rec this-addr)) - (run-hooks 'bbdb-complete-name-hooks) - (throw 'bbdb-cycling-exit t)))))) - - ;; FALL THROUGH - ;; Check mail aliases - (if (and bbdb-expand-mail-aliases (expand-abbrev)) - () - (when bbdb-complete-name-hooks - (message "completion for \"%s\" unfound." pattern) - (ding)))));; no matches, sorry! - - ;; Match for a single record. If cycling is enabled then we don't - ;; care too much about the exact-match part. - ((and only-one-p (or exact-match bbdb-complete-name-allow-cycling)) - (let* ((sym (if exact-match (intern-soft pattern ht) (car all-the-completions))) - (recs (symbol-value sym)) - the-net match-recs lst primary matched) - - (while recs - (when (bbdb-record-net (car recs)) - - ;; Did we match on name? - (let ((b-r-name (or (bbdb-record-name (car recs)) ""))) - (if (string= pattern - (substring (downcase b-r-name) 0 - (min (length b-r-name) - (length pattern)))) - (setq match-recs (cons (car recs) match-recs) - matched t))) - - ;; Did we match on aka? - (when (not matched) - (setq lst (bbdb-record-aka (car recs))) - (while lst - (if (string= pattern (substring (downcase (car lst)) 0 - (min (length (downcase - (car - lst))) - (length pattern)))) - (setq match-recs (append match-recs (list (car recs))) - matched t - lst '()) - (setq lst (cdr lst))))) - - ;; Name didn't match name so check net matching - (when (not matched) - (setq lst (bbdb-record-net (car recs))) - (setq primary t) ;; primary wins over secondary... - (while lst - (if (string= pattern (substring (downcase (car lst)) - 0 (min (length - (downcase (car - lst))) - (length pattern)))) - (setq the-net (car lst) - lst nil - match-recs - (if primary (cons (car recs) match-recs) - (append match-recs (list (car recs)))))) - (setq lst (cdr lst) - primary nil)))) - - ;; loop to next rec - (setq recs (cdr recs) - matched nil)) - - (unless match-recs - (error "only exact matching record unhas net field")) - - ;; now replace the text with the expansion - (delete-region beg end) - (insert (bbdb-dwim-net-address (car match-recs) the-net)) - - ;; if we're past fill-column, wrap at the previous comma. - (if (and - (bbdb-auto-fill-function) - (>= (current-column) fill-column)) - (let ((p (point)) - bol) - (save-excursion - (beginning-of-line) - (setq bol (point)) - (goto-char p) - (if (search-backward "," bol t) - (progn - (forward-char 1) - (insert "\n ")))))) - - ;; Update the *BBDB* buffer if desired. - (if bbdb-completion-display-record - (let ((bbdb-gag-messages t)) - (bbdb-pop-up-bbdb-buffer) - (bbdb-display-records-1 match-recs t))) - (bbdb-complete-name-cleanup) - - ;; call the exact-completion hook - (run-hooks 'bbdb-complete-name-hooks))) - - ;; Partial match - ;; note, we can't use the trimmed version of the pattern here or - ;; we'll recurse infinitely on e.g. common first names - ((and (stringp completion) (not (string= typed completion))) - (delete-region beg end) - (insert completion) - (setq end (point)) - (let ((last "") - (bbdb-complete-name-allow-cycling nil)) - (while (and (stringp completion) - (not (string= completion last)) - (setq last completion - pattern (downcase orig) - completion (try-completion pattern ht pred))) - (if (stringp completion) - (progn (delete-region beg end) - (insert completion)))) - (bbdb-complete-name beg))) - - ;; Exact match, but more than one record - (t - (or (eq (selected-window) (minibuffer-window)) - (message "Making completion list...")) - - (let (dwim-completions - uniq nets net name akas) - ;; Now collect all the dwim-addresses for each completion, but only - ;; once for each record! Add it if the net is part of the completions - (bbdb-mapc - (lambda (sym) - (bbdb-mapc - (lambda (rec) - (when (not (member rec uniq)) - (setq uniq (cons rec uniq) - nets (bbdb-record-net rec) - name (downcase (or (bbdb-record-name rec) "")) - akas (mapcar 'downcase (bbdb-record-aka rec))) - (while nets - (setq net (car nets)) - (when (cond - ;; primary - ((and (member bbdb-completion-type - '(primary primary-or-name)) - (member (intern-soft (downcase net) ht) - all-the-completions)) - (setq nets nil) - t) - ;; name - ((and name (member bbdb-completion-type - '(nil name primary-or-name)) - (let ((cname (symbol-name sym))) - (or (string= cname name) - (member cname akas)))) - (setq name nil) - t) - ;; net - ((and (member bbdb-completion-type - '(nil net)) - (member (intern-soft (downcase net) ht) - all-the-completions))) - ;; (name-or-)primary - ((and (member bbdb-completion-type - '(name-or-primary)) - (let ((cname (symbol-name sym))) - (or (string= cname name) - (member cname akas)))) - (setq nets nil) - t) - ) - (setq dwim-completions - (cons (bbdb-dwim-net-address rec net) - dwim-completions)) - (if exact-match (setq nets nil))) - (setq nets (cdr nets))))) - (symbol-value sym))) - all-the-completions) - - ;; if, after all that, we've only got one matching record... - (if (and dwim-completions (null (cdr dwim-completions))) - (progn - (delete-region beg end) - (insert (car dwim-completions)) - (message "")) - ;; otherwise, pop up a completions window - (if (not (get-buffer-window "*Completions*")) - (setq bbdb-complete-name-saved-window-config - (current-window-configuration))) - (let ((arg (list (current-buffer) - (set-marker (make-marker) beg) - (set-marker (make-marker) end)))) - (with-output-to-temp-buffer "*Completions*" - (bbdb-display-completion-list - dwim-completions - 'bbdb-complete-clicked-name - arg))) - (or (eq (selected-window) (minibuffer-window)) - (message "Making completion list...done")))))))) - -;;;###autoload -(defun bbdb-yank () - "Insert the current contents of the *BBDB* buffer at point." - (interactive) - (insert (let ((b (current-buffer))) - (set-buffer bbdb-buffer-name) - (prog1 (buffer-string) (set-buffer b))))) - - -;;; interface to mail-abbrevs.el. - -(defcustom bbdb-define-all-aliases-field 'mail-alias - "*The field which `bbdb-define-all-aliases' searches for." - :group 'bbdb - :type 'symbol) - -(defcustom bbdb-define-all-aliases-mode 'first - "*The type of alias which are created. -first: Default is to generate an abbrev which is \"alias\" and expands to the - primary net. -star: Generate an extra alias \"*\" which expands to all nets of an - record. -all: Generate an alias all nets (as for 'star) and an alias for each net - as \"n\" where n is the position of the net in the nets of the - record." - :group 'bbdb - :type '(choice (symbol :tag "Only first" first) - (symbol :tag "* for all nets" star) - (symbol :tag "All aliases" all))) - -;;;###autoload -(defun bbdb-define-all-aliases () - "Define mail aliases for some of the records in the database. -Every record which has a `mail-alias' field will have a mail alias -defined for it which is the contents of that field. If there are -multiple comma-separated words in the `mail-alias' field, then all -of those words will be defined as aliases for that person. - -If multiple entries in the database have the same mail alias, then -that alias expands to a comma-separated list of the network addresses -of all of those people." - (interactive "") - (let* ((target (cons bbdb-define-all-aliases-field ".")) - (use-abbrev-p (fboundp 'define-mail-abbrev)) - (mail-alias-separator-string (if (boundp 'mail-alias-separator-string) - mail-alias-separator-string - ", ")) - (records (bbdb-search (bbdb-records) nil nil nil target)) - result record aliases match) - - (if use-abbrev-p - nil - ;; clear abbrev-table - (setq mail-aliases nil) - ;; arrange rebuilt if necessary, this should be done by - ;; mail-pre-abbrev-expand-hook, but there is none! - (defadvice sendmail-pre-abbrev-expand-hook - (before bbdb-rebuilt-all-aliases activate) - (bbdb-rebuilt-all-aliases))) - - ;; collect an alist of (alias rec1 [rec2 ...]) - (while records - (setq record (car records)) - (if (bbdb-record-net record) - (setq aliases (bbdb-split - (bbdb-record-getprop record - bbdb-define-all-aliases-field) - ",")) - (if (not bbdb-silent-running) - (bbdb-warn "record %S has no network address, but the aliases: %s" - (bbdb-record-name record) - (bbdb-record-getprop record - bbdb-define-all-aliases-field))) - (setq aliases nil)) - - (while aliases - (if (setq match (assoc (car aliases) result)) - (nconc match (cons record nil)) - (setq result (cons (list (car aliases) record) result))) - (setq aliases (cdr aliases))) - (setq records (cdr records))) - - ;; iterate over the results and create the aliases - (while result - (let* ((aliasstem (caar result)) - (rec (cadar result)) - (group-alias-p (cddar result)) - (nets (if (not group-alias-p) (bbdb-record-net rec))) - (expansions - (if group-alias-p - (mapcar (lambda (r) (bbdb-dwim-net-address r)) (cdar result)) - (mapcar (lambda (net) (bbdb-dwim-net-address rec net)) - (if (eq 'all bbdb-define-all-aliases-mode) - nets - (list (car nets)))))) - (count 1) - alias expansion) - - (if group-alias-p - ;; for group aliases we just take all the primary nets and define - ;; just one expansion! - (setq expansions (list (mapconcat 'identity expansions - mail-alias-separator-string))) - ;; this is an alias for a single person so deal with it according to - ;; the bbdb-define-all-aliases-mode - (when (or (not (eq 'first bbdb-define-all-aliases-mode)) - (setq expansions - (cons (mapconcat 'identity - (mapcar (lambda (net) - (bbdb-dwim-net-address - rec net)) - nets) - mail-alias-separator-string) - expansions) - count 0)))) - - ;; create the aliases for each expansion - (while expansions - (cond ((= count 0);; all the nets of a record - (setq alias (concat aliasstem "*"))) - ((= count 1);; expansion as usual - (setq alias aliasstem)) - (t;; alias# for each net of a record - (setq alias (format "%s%s" aliasstem count)))) - (setq count (1+ count)) - (setq expansion (car expansions)) - - (if use-abbrev-p - (define-mail-abbrev alias expansion) - (define-mail-alias alias expansion)) - (setq alias (or (intern-soft (downcase alias) - (if use-abbrev-p - mail-abbrevs mail-aliases)) - (error "couldn't find the alias we just defined!"))) - - (or (eq (symbol-function alias) 'mail-abbrev-expand-hook) - (error "mail-aliases contains unexpected hook %s" - (symbol-function alias))) - ;; The abbrev-hook is called with network addresses instead of bbdb - ;; records to avoid keeping pointers to records, which would lose if - ;; the database was reverted. It uses -search-simple to convert - ;; these to records, which is plenty fast. - (fset alias (list 'lambda '() - (list 'bbdb-mail-abbrev-expand-hook - alias - (list 'quote - (mapcar (lambda (x) - (car (bbdb-record-net x))) - (cdr (car result))))))) - (setq expansions (cdr expansions)))) - (setq result (cdr result))) - - (when (not use-abbrev-p) - (modify-syntax-entry ?* "w" mail-mode-header-syntax-table) - (sendmail-pre-abbrev-expand-hook)))) - -;; We should be cleverer here and instead of rebuilding all aliases we should -;; just do what's necessary, i.e. remove deleted records and add new records -(defun bbdb-rebuilt-all-aliases () - (let ((needs-rebuilt bbdb-define-all-aliases-needs-rebuilt)) - (when needs-rebuilt - (if (not bbdb-silent-running) - (message "Rebuilding aliases due to %s aliases." needs-rebuilt)) - (setq bbdb-define-all-aliases-needs-rebuilt nil) - (bbdb-define-all-aliases)))) - -(defcustom bbdb-mail-abbrev-expand-hook nil - "*Hook or hooks invoked each time an alias is expanded. -The hook is called with two arguments the alias and the list of records." - :group 'bbdb-hooks - :type 'hook) - -(defun bbdb-mail-abbrev-expand-hook (alias records) - (run-hook-with-args 'bbdb-mail-abbrev-expand-hook alias records) - (mail-abbrev-expand-hook) - (when bbdb-completion-display-record - (if bbdb-use-pop-up - (bbdb-pop-up-bbdb-buffer)) - (let ((bbdb-gag-messages t)) - (bbdb-display-records-1 - (mapcar (lambda (x) (bbdb-search-simple nil x)) records) - t)))) - -(defun bbdb-get-mail-aliases () - "Return a list of mail aliases used in the BBDB. -The format is suitable for `completing-read'." - (let* ((target (cons bbdb-define-all-aliases-field ".")) - (records (bbdb-search (bbdb-records) nil nil nil target)) - result aliases) - (while records - (setq aliases (bbdb-split - (bbdb-record-getprop (car records) - bbdb-define-all-aliases-field) - ",")) - (while aliases - (add-to-list 'result (list (car aliases))) - (setq aliases (cdr aliases))) - (setq records (cdr records))) - result)) - -;;;###autoload -(defun bbdb-add-or-remove-mail-alias (&optional records newalias delete) - "Add NEWALIAS in all RECORDS or remove it if DELETE it t. -When called with prefix argument it will remove the alias. -We honor `bbdb-apply-next-command-to-all-records'! -The new alias will only be added if it isn't there yet." - (interactive (list (if (bbdb-do-all-records-p) 'all 'one) - (completing-read - (format "%s mail alias: " (if current-prefix-arg "Remove" "Add")) - (bbdb-get-mail-aliases)) - current-prefix-arg)) - (setq newalias (bbdb-string-trim newalias)) - (setq newalias (if (string= "" newalias) nil newalias)) - (let* ((propsym bbdb-define-all-aliases-field) - (do-all-p (if (equal records 'one) nil t)) - (records (cond ((equal records 'all) (mapcar 'car bbdb-records)) - ((equal records 'one) (list (bbdb-current-record t))) - (t records)))) - (while records - (let* ((record (car records)) - (oldaliases (bbdb-record-getprop record propsym))) - (if oldaliases (setq oldaliases (bbdb-split oldaliases ","))) - (if delete (setq oldaliases (delete newalias oldaliases)) - (add-to-list 'oldaliases newalias)) - (setq oldaliases (bbdb-join oldaliases ", ")) - (bbdb-record-putprop record propsym oldaliases)) - (setq records (cdr records))) - (if do-all-p - (bbdb-redisplay-records) - (bbdb-redisplay-one-record (bbdb-current-record)))) - (setq bbdb-define-all-aliases-needs-rebuilt - (if delete - 'deleted - (if (bbdb-record-net (bbdb-current-record)) - 'new - nil)))) - -;;; Dialing numbers from BBDB -(defcustom bbdb-dial-local-prefix-alist - '(((if (integerp bbdb-default-area-code) - (format "(%03d)" bbdb-default-area-code) - (or bbdb-default-area-code "")) - "")) - "Mapping to remove local prefixes from numbers. -If this is non-nil, it should be an alist of -(PREFIX REPLACEMENT) elements. The first part of a phone number -matching the regexp returned by evaluating PREFIX will be replaced by -the corresponding REPLACEMENT when dialing." - :group 'bbdb-phone-dialing - :type 'sexp) - -(defcustom bbdb-dial-local-prefix nil - "Local prefix digits. -If this is non-nil, it should be a string of digits which your phone -system requires before making local calls (for example, if your phone system -requires you to dial 9 before making outside calls.) In BBDB's -opinion, you're dialing a local number if it starts with a 0 after -processing bbdb-dial-local-prefix-alist." - :group 'bbdb-phone-dialing - :type '(choice (const :tag "No digits required" nil) - (string :tag "Dial this first" "9"))) - -(defcustom bbdb-dial-long-distance-prefix nil - "Long distance prefix digits. -If this is non-nil, it should be a string of digits which your phone -system requires before making a long distance call (one not in your local -area code). For example, in some areas you must dial 1 before an area -code. Note that this is used to replace the + sign in phone numbers -when dialling (international dialing prefix.)" - :group 'bbdb-phone-dialing - :type '(choice (const :tag "No digits required" nil) - (string :tag "Dial this first" "1"))) - -(defcustom bbdb-sound-player nil - "The program to be used to play the sounds for the touch-tone digits." - :group 'bbdb-phone-dialing - :type '(choice (const :tag "No External Player" nil) - (file :tag "Sound Player" "/usr/local/bin/play"))) - -(defcustom bbdb-sound-files - '["/usr/demo/SOUND/sounds/touchtone.0.au" - "/usr/demo/SOUND/sounds/touchtone.1.au" - "/usr/demo/SOUND/sounds/touchtone.2.au" - "/usr/demo/SOUND/sounds/touchtone.3.au" - "/usr/demo/SOUND/sounds/touchtone.4.au" - "/usr/demo/SOUND/sounds/touchtone.5.au" - "/usr/demo/SOUND/sounds/touchtone.6.au" - "/usr/demo/SOUND/sounds/touchtone.7.au" - "/usr/demo/SOUND/sounds/touchtone.8.au" - "/usr/demo/SOUND/sounds/touchtone.9.au" - "/usr/demo/SOUND/sounds/touchtone.pound.au" - "/usr/demo/SOUND/sounds/touchtone.star.au"] - "A vector of ten sound files to be used for dialing. They -correspond to the 0, 1, 2, ... 9 digits, pound and star, respectively." - :group 'bbdb-phone-dialing - :type 'vector) - -(defcustom bbdb-modem-dial nil - "Type of dialing to use. -If this value is nil, the audio device is used for dialing. Otherwise, -this string is fed to the modem before the phone number digits." - :group 'bbdb-phone-dialing - :type '(choice (const :tag "audio" nil) - (string :tag "tone dialing" "ATDT ") - (string :tag "pulse dialing" "ATDP "))) - -(defcustom bbdb-modem-device "/dev/modem" - "The name of the modem device. -This is only used if bbdb-modem-dial is set to something other than nil." - :group 'bbdb-phone-dialing - :type 'string) - -(defcustom bbdb-sound-volume 50 - "The volume to play back dial tones at. The range is 0 to 100. -This is only used if bbdb-modem-dial is set to nil." - :group 'bbdb-phone-dialing - :type 'integer) - -(defun bbdb-play-sound (num &optional volume) - "Play the specified touchtone number NUM at VOLUME. -Uses external program `bbdb-sound-player' if set, otherwise -try to use internal sound if available." - (if (and (not bbdb-sound-player) (featurep 'native-sound)) - ;; This requires the sound files to be loaded via bbdb-xemacs. - (funcall 'play-sound (intern (format "touchtone%d" num)) - bbdb-sound-volume) - (if (and (not (featurep 'xemacs)) - ;; We can't tell a priori if Emacs 21 facility will - ;; actually work. - (condition-case nil - (play-sound (list 'sound - :file (aref bbdb-sound-files - (string-to-int num)) - :volume (or volume bbdb-sound-volume))) - (error nil))) - (if (and bbdb-sound-player - (file-exists-p bbdb-sound-player)) - (call-process bbdb-sound-player nil nil nil - (aref bbdb-sound-files num)) - (error "BBDB has no means of playing sound."))))) - -(eval-and-compile - (if (fboundp 'next-event) - (fset 'bbdb-next-event 'next-event) - (fset 'bbdb-next-event 'read-event))) - -(defun bbdb-dial-number (phone-string) - "Dial the number specified by PHONE-STRING. -The number is dialed either by playing touchtones through the audio -device using bbdb-sound-player, or by sending a dial sequence to -bbdb-modem-device. # and * are dialed as-is, and a space is treated as -a pause in the dial sequence." - (interactive "sDial number: ") - (let ((dialed "")) - (mapcar - (lambda(d) - (if bbdb-modem-dial - (setq dialed - (concat dialed - (cond ((eq ? d) ",") - ((memq d '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?* ?#)) - (format "%c" d)) - (t "")))) - (cond - ((eq ?# d) - (bbdb-play-sound 10)) - ((eq ?* d) - (bbdb-play-sound 11)) - ((eq ? d) - ;; if we use sit-for, the user can interrupt! - (sleep-for 1)) ;; configurable? - ((memq d '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) - (bbdb-play-sound (- (char-int d) (char-int ?0)))) - (t)))) phone-string) - - ;; tell the user that we're dialed, if we're using the modem - (if bbdb-modem-dial - (with-temp-buffer - (insert bbdb-modem-dial dialed ";\r\n") - (write-region (point-min) (point-max) bbdb-modem-device t) - (message "%s dialed. Pick up the phone now and hit any key ..." - phone-string) - (bbdb-next-event) - (erase-buffer) - (insert "ATH\r\n") - (write-region (point-min) (point-max) bbdb-modem-device t))))) - -;;;###autoload -(defun bbdb-dial (phone force-area-code) - "Dial the number at point. -If the point is at the beginning of a record, dial the first -phone number. Does not dial the extension. Does not apply the -transformations from bbdb-dial-local-prefix-alist if a prefix arg -is given." - (interactive (list (bbdb-current-field) - current-prefix-arg)) - (if (eq (car-safe phone) 'name) - (setq phone (car (bbdb-record-phones (bbdb-current-record))))) - (if (eq (car-safe phone) 'phone) - (setq phone (car (cdr phone)))) - (or (vectorp phone) (error "not on a phone field")) - - (let* ((number (bbdb-phone-string phone)) shortnumber) - (when (not force-area-code) - (let ((alist bbdb-dial-local-prefix-alist)) - (while alist - (if (string-match (concat "^" (eval (caar alist))) number) - (setq shortnumber (concat (car (cdar alist)) - (substring number (match-end 0))) - alist nil)) - (setq alist (cdr alist))))) - - ;; cut off the extension - (if (string-match "x[0-9]+$" number) - (setq number (substring number 0 (match-beginning 0)))) - - ;; This is terrifically Americanized... - ;; Leading 0 => local number (?) - (if (and (not shortnumber) bbdb-dial-local-prefix - (string-match "^0" number)) - (setq number (concat bbdb-dial-local-prefix number))) - - ;; Leading + => long distance/international number - (if (and (not shortnumber) bbdb-dial-long-distance-prefix - (string-match "^\+" number)) - (setq number (concat bbdb-dial-long-distance-prefix " " - (substring number 1)))) - - ;; use the short number if it's available - (setq number (or shortnumber number)) - (if (not bbdb-silent-running) - (message "Dialing %s" number)) - (bbdb-dial-number number))) - - -;; not sure what this is doing here... -(defun bbdb-get-record (prompt) - "Get the current record or ask the user. -To be used in `interactive' like this: -(interactive (list (bbdb-get-record \"look up ...\")))" - (if (and (boundp 'bbdb-buffer-name) -(string= bbdb-buffer-name (buffer-name))) -(bbdb-current-record) -(let (re (pr "")) - (while (not re) - (setq re (bbdb-completing-read-record (concat pr prompt))) - (unless re (ding)) (setq pr "Invalid response! ")) re))) - -;;; Finger, based on code by Sam Cramer . -;;; Note that process-death bugs in 18.57 may make this eat up all the cpu... - -(defcustom bbdb-finger-buffer-name "*finger*" - "The buffer into which finger output should be directed." - :group 'bbdb-utilities-finger - :type 'string) - -(defun bbdb-finger-internal (address) - (message "Fingering %s..." address) - (condition-case condition - (let* ((@ (string-match "@" address)) - (stream (open-network-stream - "finger" bbdb-finger-buffer-name - (if @ (substring address (1+ @)) "localhost") - "finger"))) - (set-process-sentinel stream 'bbdb-finger-process-sentinel) - (princ (concat "finger " address "\n")) - (process-send-string - stream (concat;;"/W " ; cs.stanford.edu doesn't like this... - (if @ (substring address 0 @) address) "\n")) - (process-send-eof stream)) - (error - (princ (format "error fingering %s: %s\n" address - (if (stringp condition) condition - (concat "\n" (nth 1 condition) - (if (cdr (cdr condition)) ": ") - (mapconcat '(lambda (x) - (if (stringp x) x - (prin1-to-string x))) - (cdr (cdr condition)) ", "))))) - (bbdb-finger-process-sentinel nil nil)))) ; hackaroonie - -(defvar bbdb-remaining-addrs-to-finger) -(defun bbdb-finger-process-sentinel (process s) - (save-excursion - (set-buffer bbdb-finger-buffer-name) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (delete-char -1)) - (if (and (boundp 'bbdb-remaining-addrs-to-finger) - bbdb-remaining-addrs-to-finger) - (let ((addr (car bbdb-remaining-addrs-to-finger))) - (setq bbdb-remaining-addrs-to-finger - (cdr bbdb-remaining-addrs-to-finger)) - (goto-char (point-max)) - (let ((standard-output (current-buffer))) - (princ "\n\n\^L\n") - (bbdb-finger-internal addr))) - (goto-char (point-max)) - (message "Finger done.")))) - -(defcustom bbdb-finger-host-field 'finger-host - "*The field for special net addresses used by \"\\[bbdb-finger]\"." - :group 'bbdb-utilities-finger - :type 'symbol) - -(defun bbdb-record-finger-host (record) - (let ((finger-host (and bbdb-finger-host-field - (bbdb-record-getprop record bbdb-finger-host-field)))) - (if finger-host - (bbdb-split finger-host ",") - (bbdb-record-net record)))) - -;;;###autoload -(defun bbdb-finger (record &optional which-address) - "Finger the network address of a BBDB record. -If this command is executed from the *BBDB* buffer, finger the network -address of the record at point; otherwise, it prompts for a user. -With a numeric prefix argument, finger the Nth network address of the -current record\; with a prefix argument of ^U, finger all of them. -The *finger* buffer is filled asynchronously, meaning that you don't -have to wait around for it to finish\; but fingering another user before -the first finger has finished could have unpredictable results. -\\ -If this command is executed from the *BBDB* buffer, it may be prefixed -with \"\\[bbdb-apply-next-command-to-all-records]\" \(as in \ -\"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-finger]\" instead of \ -simply \"\\[bbdb-finger]\"\), meaning to finger all of -the users currently listed in the *BBDB* buffer instead of just the one -at point. The numeric prefix argument has the same interpretation. - -You can define a special network address to \"finger\" by defining a -field `finger-host' (default value of `bbdb-finger-host-field')." - (interactive (list (bbdb-get-record "BBDB Finger: ") - current-prefix-arg)) - (if (not (consp record)) (setq record (list record))) - (let ((addrs nil)) - (while record - (cond ((null which-address) - (setq addrs - (nconc addrs - (list (car (bbdb-record-finger-host (car record))))))) - ((stringp which-address) - (setq addrs (nconc addrs (list which-address)))) - ((numberp which-address) - (setq addrs - (nconc addrs - (list (nth which-address - (bbdb-record-finger-host (car record))))))) - (t - (setq addrs - (nconc addrs - (copy-sequence (bbdb-record-finger-host - (car record))))))) - (setq record (cdr record))) - (if (car addrs) - (save-excursion - (with-output-to-temp-buffer bbdb-finger-buffer-name - (set-buffer bbdb-finger-buffer-name) - (make-local-variable 'bbdb-remaining-addrs-to-finger) - (setq bbdb-remaining-addrs-to-finger (cdr addrs)) - (bbdb-finger-internal (car addrs)))) - (error "Nothing to finger!")))) - - -(defun bbdb-remove-duplicate-nets (records) - "*Remove duplicate nets from a record." - (interactive (if (bbdb-do-all-records-p) - (mapcar 'car bbdb-records) - (bbdb-current-record))) - (let (nets cnets) - (while records - (setq nets (bbdb-record-net (car records)) - cnets nil) - (while nets - (add-to-list 'cnets (car nets)) - (setq nets (cdr nets))) - (bbdb-record-set-net (car records) cnets) - (setq records (cdr records))))) - -(defun bbdb-find-duplicates (&optional fields) - "Find all records that have duplicate entries for given FIELDS. -FIELDS should be a list of the symbols `name', `net', and/or `aka'. -Note that overlap between these fields is noted if either is selected, -most common case `aka' and `name'. If FIELDS is not given it -defaults to all of them. - -The results of the search is returned as a list of records." - (setq fields (or fields '(name net aka))) - (let ((records (bbdb-records)) - rec hash ret) - (while records - (setq rec (car records)) - - (when (and (memq 'name fields) - (bbdb-record-name rec) - (setq hash (bbdb-gethash (downcase (bbdb-record-name rec)))) - (> (length hash) 1)) - (setq ret (append hash ret)) - (message "BBDB record `%s' causes duplicates, maybe it is equal to a company name." - (bbdb-record-name rec)) - (sit-for 0)) - - (if (memq 'net fields) - (let ((nets (bbdb-record-net rec))) - (while nets - (setq hash (bbdb-gethash (downcase (car nets)))) - (when (> (length hash) 1) - (setq ret (append hash ret)) - (message "BBDB record `%s' has duplicate net `%s'." - (bbdb-record-name rec) (car nets)) - (sit-for 0)) - (setq nets (cdr nets))))) - - (if (memq 'aka fields) - (let ((aka (bbdb-record-aka rec))) - (while aka - (setq hash (bbdb-gethash (downcase (car aka)))) - (when (> (length hash) 1) - (setq ret (append hash ret)) - (message "BBDB record `%s' has duplicate aka `%s'" - (bbdb-record-name rec) (car aka)) - (sit-for 0)) - (setq aka (cdr aka))))) - - (setq records (cdr records))) - (reverse (bbdb-remove-memq-duplicates ret)))) - -(defun bbdb-show-duplicates (&optional fields) - "*Find all records that have duplicate entries for given FIELDS. -FIELDS should be a list of the symbols `name', `net', and/or `aka'. -Note that overlap between these fields is noted if either is selected -(most common case `aka' and `name'). If FIELDS is not given it -defaults to all of them. - -The results are displayed in the bbdb buffer." - (interactive) - (setq fields (or fields '(name net aka))) - (bbdb-display-records (bbdb-find-duplicates fields))) - -;;; Time-based functions -(defun bbdb-kill-older (date &optional compare function) - "*Apply FUNCTION to all records with timestamps older than DATE. -The comparison is done with COMPARE. If FUNCTION is not specified, the -selected records are deleted. If COMPARE is not specified, -`string-lessp' is used. - -Example: - (bbdb-kill-older \"1997-01-01\") -will delete all records with timestamps older than Jan 1 1997. - -Notes: 1. Records without timestamp fields will be ignored -2. DATE must be in yyyy-mm-dd format." - (interactive "sKill records with timestamp older than (yyyy-mm-dd): \n") - (let ((records (bbdb-records)) timestamp - (fun (or function 'bbdb-delete-record-internal)) - (cmp (or compare 'string-lessp))) - (while records - (if (and (setq timestamp (bbdb-record-getprop (car records) 'timestamp)) - (funcall cmp timestamp date)) - (funcall fun (car records))) - (setq records (cdr records))))) - -(defmacro bbdb-compare-records (cmpval field compare) - "Builds a lambda comparison function that takes one argument, REC. -REC is returned if -(COMPARE VALUE CMPVAL) -is true, where VALUE is the value of the FIELD field of REC." - `(lambda (rec) -(let ((val (bbdb-record-getprop rec ,field))) - (if (and val (,compare val ,cmpval)) - rec nil)))) - -;;;###autoload -(defun bbdb-timestamp-older (date) - "*Display records with timestamp older than DATE. -DATE must be in yyyy-mm-dd format." - (interactive "sOlder than date (yyyy-mm-dd): ") - (bbdb-display-some (bbdb-compare-records date 'timestamp string<))) - -;;;###autoload -(defun bbdb-timestamp-newer (date) - "*Display records with timestamp newer than DATE. -DATE must be in yyyy-mm-dd format." - (interactive "sNewer than date (yyyy-mm-dd): ") - (bbdb-display-some (bbdb-compare-records date 'timestamp string>))) - -;;;###autoload -(defun bbdb-creation-older (date) - "*Display records with creation-date older than DATE. -DATE must be in yyyy-mm-dd format." - (interactive "sOlder than date (yyyy-mm-dd): ") - (bbdb-display-some (bbdb-compare-records date 'creation-date string<))) - -;;;###autoload -(defun bbdb-creation-newer (date) - "*Display records with creation-date newer than DATE. -DATE must be in yyyy-mm-dd format." - (interactive "sNewer than date (yyyy-mm-dd): ") - (bbdb-display-some (bbdb-compare-records date 'creation-date string>))) - -;;;###autoload -(defun bbdb-creation-no-change () - "*Display records that have the same timestamp and creation-date." - (interactive) - (bbdb-display-some - (bbdb-compare-records (bbdb-record-getprop rec 'timestamp) - 'creation-date string=))) - -;;; Help and documentation - -(defcustom bbdb-info-file nil - "*Set this to the location of the bbdb info file, if it's not in the -standard place." - :group 'bbdb - :type '(choice (const :tag "Standard location" nil) - (file :tag "New location"))) - -;;;###autoload -(defun bbdb-info () - (interactive) - (require 'info) - (if bbdb-inside-electric-display - (bbdb-electric-throw-to-execute '(bbdb-info)) - (let ((file (or bbdb-info-file "bbdb"))) - (Info-goto-node (format "(%s)Top" file))))) - -;;;###autoload -(defun bbdb-help () - (interactive) - (message (substitute-command-keys "\\\ -new field: \\[bbdb-insert-new-field]; \ -edit field: \\[bbdb-edit-current-field]; \ -delete field: \\[bbdb-delete-current-field-or-record]; \ -mode help: \\[describe-mode]; \ -info: \\[bbdb-info]"))) - - -(or (fboundp 'member);; v18 lossage - (defun member (item list) - (while (and list (not (equal item (car list)))) (setq list (cdr list))) - list)) - - -;;; If Sebastian Kremer's minibuffer history package is around, use it. -(if (and (fboundp 'gmhist-make-magic) - (string-lessp emacs-version "19")) ; v19 has history built in - (mapcar 'gmhist-make-magic - '(bbdb bbdb-name bbdb-company bbdb-net bbdb-changed))) - -;;;###autoload -(defcustom bbdb-update-records-mode 'annotating - "Controls how `bbdb-update-records' processes email addresses. -Set this to an expression which evaluates either to 'searching or -'annotating. When set to 'annotating email addresses will be fed to -`bbdb-annotate-message-sender' in order to update existing records or create -new ones. A value of 'searching will search just for existing records having -the right net. - -There is a version of this variable for each MUA, which overrides this variable -when set! - -This variable is also used for inter-function communication between the -functions `bbdb-update-records' and `bbdb-prompt-for-create'." - :group 'bbdb-mua-specific - :type '(choice (const :tag "annotating all messages" - annotating) - (const :tag "annotating no messages" - searching) - (sexp :tag "user defined"))) - -(defvar bbdb-offer-to-create nil - "Used for inter-function communication between the functions -`bbdb-update-records' and `bbdb-prompt-for-create'.") -(defvar bbdb-address nil - "Used for inter-function communication between the functions -`bbdb-update-records' and `bbdb-prompt-for-create'.") - -(defvar bbdb-update-address-class nil - "Class of currently processed address as in `bbdb-get-addresses-headers'. -The `bbdb-notice-hook' and `bbdb-create-hook' functions may utilize this to -treat updates in the right way.") - -(defvar bbdb-update-address-header nil - "Header the currently processed address was extracted from. -The `bbdb-notice-hook' and `bbdb-create-hook' functions may utilize this to -treat updates in the right way.") - -;;;###autoload -(defun bbdb-update-records (addrs auto-create-p offer-to-create) - "Returns the records corresponding to the list of addresses ADDRS, -creating or modifying them as necessary. A record will be created if -AUTO-CREATE-P is non-nil or if OFFER-TO-CREATE is true and the user -confirms the creation. - -The variable `bbdb/gnus-update-records-mode' controls what actions -are performed and it might override `bbdb-update-records-mode'. - -When hitting C-g once you will not be asked any more for new people listed -in this message, but it will search only for existing records. When hitting -C-g again it will stop scanning." - (setq auto-create-p (bbdb-invoke-hook-for-value auto-create-p)) - - (let ((bbdb-records (bbdb-records)) - (processed-addresses 0) - (bbdb-offer-to-create (or offer-to-create (eq 'prompt auto-create-p))) - (bbdb-update-records-mode - (if offer-to-create 'annotating - (if (listp bbdb-update-records-mode) - (eval bbdb-update-records-mode) - bbdb-update-records-mode))) - (addrslen (length addrs)) - (bbdb-update-address-class nil) - (bbdb-update-address-header nil) - records hits) - - (while addrs - - (setq bbdb-address (car addrs) - bbdb-update-address-class (car bbdb-address) - bbdb-update-address-header (cadr bbdb-address) - bbdb-address (caddr bbdb-address)) - - (condition-case nil - (progn - (setq hits - (cond ((null (cadr bbdb-address)) - ;; ignore emtpy addrs, e.g. (??? nil) - nil) - ((eq bbdb-update-records-mode 'annotating) - (list;; search might return a list - (bbdb-annotate-message-sender - bbdb-address t - (or offer-to-create;; force create - auto-create-p) - 'bbdb-prompt-for-create))) - ((eq bbdb-update-records-mode 'searching) - ;; search for records having this net - (let ((net (concat "^" - (regexp-quote - (cadr bbdb-address)) - "$")) - ;; there is no case for nets - (bbdb-case-fold-search t)) - (bbdb-search bbdb-records nil nil net)))) - processed-addresses (+ processed-addresses 1)) - - (when (and (not bbdb-silent-running) - (not bbdb-gag-messages) - (not (eq bbdb-offer-to-create 'quit)) - (= 0 (% processed-addresses 5))) - (let ((mess (format "Hit C-g to stop BBDB from %s. %d of %d addresses processed." - bbdb-update-records-mode processed-addresses addrslen))) - (if (featurep 'xemacs) - (bbdb-display-message 'progress mess) - (message mess))) - (sit-for 0))) - - ;; o.k. there was a quit signal so how should we proceed now? - (quit (cond ((eq bbdb-update-records-mode 'annotating) - (setq bbdb-update-records-mode 'searching)) - ((eq bbdb-update-records-mode 'searching) - nil) - ((eq bbdb-update-records-mode 'next) - (setq bbdb-update-records-mode 'annotating)) - (t - (setq bbdb-update-records-mode 'quit))) - nil)) - - (while hits - ;; people should be listed only once so we use add-to-list - (if (car hits) (add-to-list 'records (car hits))) - (setq hits (cdr hits))) - - (setq addrs (cdr addrs))) - - ;; add-to-list adds at the front so we have to reverse the list in order - ;; to reflect the order of the records as they appear in the headers. - (setq records (nreverse records)) - - records)) - -(defun bbdb-get-help-window (message) - "Display MESSAGE in a new window which is the last one in the current frame." - (let ((b (get-buffer-create " *BBDB Help*")) - (w (or (get-buffer-window " *BBDB Help*") - (get-lru-window))) - (lines (let ((l 2) (s 0)) - (while (setq s (string-match "\n" message s)) - (setq s (1+ s) l (1+ l))) - l))) - - (setq w (split-window w)) - (select-window w) - (switch-to-buffer b) - (erase-buffer) - (insert message) - (goto-char (point-min)) - (let ((window-min-height 1)) - (enlarge-window (- lines (window-height w)))) - w)) - -(defun bbdb-kill-help-window (window) - "Kill the buffer corresponding to WINDOW and delete the WINDOW." - (kill-buffer (window-buffer window)) - (delete-window window)) - -;; This is a hack. The function is called by bbdb-annotate-message-sender and -;; uses the above variable in order to manipulate bbdb-update-records. -;; Some cases are handled with signals in order to keep the changes in -;; bbdb-annotate-message-sender as minimal as possible. - -(defun bbdb-prompt-for-create () - "This function is used by `bbdb-update-records' to ask the user how to -proceed the processing of records. - -It is called from `bbdb-annotate-message-sender' (PROMPT-FOR-CREATE arg) and -returns `t' if the record should be created or `nil' otherwise. It honors a -previous answer, e.g. \"!\" add all ..." - (let ((old-offer-to-create bbdb-offer-to-create) - event prompt) - (when bbdb-offer-to-create - (when (not (integerp bbdb-offer-to-create)) - (setq prompt (format "%s is not in the db; add? (y,!,n,s,q,?) " - (or (car bbdb-address) (cadr bbdb-address)))) - (while (not event) - (setq event (read-key-sequence prompt)) - (if (featurep 'xemacs) - (setq event (bbdb-event-to-character (aref event 0))) - (setq event (if (stringp event) (aref event 0))))) - - (setq bbdb-offer-to-create event)) - (message "");; clear the message buffer - - (cond ((eq bbdb-offer-to-create ?y) - (setq bbdb-offer-to-create old-offer-to-create) - t) - ((eq bbdb-offer-to-create ?!) - t) - ((or (eq bbdb-offer-to-create ?n) - (eq bbdb-offer-to-create ? )) - (setq bbdb-update-records-mode 'next - bbdb-offer-to-create old-offer-to-create) - (signal 'quit nil)) - ((eq bbdb-offer-to-create ?q) - (setq bbdb-update-records-mode 'quit) - (signal 'quit nil)) - ((eq bbdb-offer-to-create ?s) - (setq bbdb-update-records-mode 'searching) - (signal 'quit nil)) - (t - (let ((w (bbdb-get-help-window - "Your answer controls how BBDB updates/searches for records. - -Type ? for this help. -Type y to add the current record. -Type ! to add all remaining records. -Type n to skip the current record. (You might also type space) -Type s to switch from annotate to search mode. -Type q to quit updating records. No more search or annotation is done."))) - (setq bbdb-offer-to-create nil) - (condition-case error - (progn (bbdb-prompt-for-create) - (bbdb-kill-help-window w)) - (t - (bbdb-kill-help-window w) - (apply 'signal error))))))))) - -;;;###autoload -(defcustom bbdb-get-addresses-headers - '((authors . ("From" "Resent-From" "Reply-To")) - (recipients . ("Resent-To" "Resent-CC" "To" "CC" "BCC"))) - "*List of headers to search for senders and recipients email addresses. -The headers are grouped into two classes, the authors and the senders headers." - :group 'bbdb-mua-specific - :type 'list) - -;;;###autoload -(defcustom bbdb-get-only-first-address-p - t - "*If t `bbdb-update-records' will return only the first one. -Changing this variable will show its effect only after clearing the -`bbdb-message-cache' of a folder or closing and visiting it again." - :group 'bbdb-mua-specific - :type 'boolean) - -(defun bbdb-get-addresses (only-first-address - uninteresting-senders - get-header-content-function - &rest get-header-content-function-args) - "" - (let ((headers bbdb-get-addresses-headers) - (ignore-senders (or bbdb-user-mail-names uninteresting-senders)) - addrlist adlist fn ad - header-type header-fields header-content) - (while headers - (setq header-type (caar headers) - header-fields (cdar headers)) - (while header-fields - (setq header-content (apply get-header-content-function - (car header-fields) - get-header-content-function-args)) - (when header-content - (setq adlist (funcall bbdb-extract-address-components-func - header-content)) - (while adlist - (setq fn (caar adlist) - ad (car (cdar adlist))) - - ;; ignore uninteresting addresses, this is kinda gross! - (if (or (not (stringp ignore-senders)) - (not (or (and fn (string-match ignore-senders fn)) - (and ad (string-match ignore-senders ad))))) - (add-to-list 'addrlist - (list header-type - (car header-fields) - (car adlist)))) - - (if (and only-first-address addrlist) - (setq adlist nil headers nil) - (setq adlist (cdr adlist))))) - (setq header-fields (cdr header-fields))) - (setq headers (cdr headers))) - (nreverse addrlist))) - -(provide 'bbdb-com) diff --git a/xemacs-packages/lisp/bbdb/bbdb-ftp.el b/xemacs-packages/lisp/bbdb/bbdb-ftp.el deleted file mode 100644 index 9bd66fa4..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-ftp.el +++ /dev/null @@ -1,202 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is an addition to the Insidious Big Brother Database -;;; (aka BBDB), copyright (c) 1991, 1992 Jamie Zawinski -;;; . -;;; -;;; The Insidious Big Brother Database is free software; you can redistribute -;;; it and/or modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 1, or (at your -;;; option) any later version. -;;; -;;; BBDB is distributed in the hope that it will be useful, but WITHOUT ANY -;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more -;;; details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - - -;;; This file was written by Ivan Vazquez - -;;; $Id: bbdb-ftp.el,v 1.8 2005/07/24 15:22:57 waider Exp $ - -;;; This file adds the ability to define ftp-sites in a BBDB, much the same -;;; way one adds a regular person's name to the BBDB. It also defines the -;;; bbdb-ftp command which allows you to ftp a site that is in a bbdb-record. -;;; You must have either EFS or ange-ftp in order to use this code. Ange-ftp -;;; is available at archive.cis.ohio-state.edu in the -;;; /pub/gnu/emacs/elisp-archive/packages directory. EFS ships with XEmacs. - -;;; Note that Ftp Site BBDB entries differ from regular entries by the -;;; fact that the Name Field must have the ftp site preceeded by the -;;; bbdb-ftp-site-name-designator-prefix. This defaults to "Ftp Site:" -;;; BBDB Ftp Site entries also have two new fields added, the -;;; ftp-dir slot, and the ftp-user slot. These are added to the notes -;;; alist part of the bbdb-records, the original bbdb-record structure -;;; remains untouched. - -;;; The following user-level commands are defined for use: -;;; - -;;; bbdb-ftp - Use ange-ftp to open an ftp-connection to a BBDB -;;; record's name. If this command is executed from the -;;; *BBDB* buffer, ftp the site of the record at point; -;;; otherwise, it prompts for an ftp-site. - -;;; bbdb-create-ftp-site - -;;; Add a new ftp-site entry to the bbdb database; prompts -;;; for all relevant info using the echo area, inserts the -;;; new record in the db, sorted alphabetically. - -;;; The package can be installed by compiling and adding the following -;;; two lines to your .emacs. - -;;; (autoload 'bbdb-ftp "bbdb-ftp" "Ftp BBDB Package" t) -;;; (autoload 'bbdb-create-ftp-site "bbdb-ftp" "Ftp BBDB Package" t) - -(require 'bbdb) - -;; There must be a better way -(if (featurep 'efs-cu) - (require 'efs) - (require 'ange-ftp)) - -(defcustom bbdb-default-ftp-user "anonymous" - "*The default login to use when ftp-ing." - :group 'bbdb-utilities-ftp - :type 'string) - -(defcustom bbdb-default-ftp-dir "/" - "*The default directory to open when ftp-ing." - :group 'bbdb-utilities-ftp - :type 'string) - -(defcustom bbdb-ftp-site-name-designator-prefix "Ftp Site: " - "*The prefix that all ftp sites in the bbdb will have in their name field." - :group 'bbdb-utilities-ftp - :type 'string) - -(defmacro defun-bbdb-raw-notes-accessor (slot) - "Expands into an accessor function for slots in the notes alist." - (let ((fn-name (intern (concat "bbdb-record-" (symbol-name slot))))) - (list 'defun fn-name (list 'record) - (list 'cdr - (list 'assoc (list 'quote slot) - (list 'bbdb-record-raw-notes 'record)))))) - -(defun-bbdb-raw-notes-accessor ftp-dir) -(defun-bbdb-raw-notes-accessor ftp-user) - -(defun bbdb-record-ftp-site (record) - "Accessor Function. Returns the ftp-site field of the BBDB record or nil." - (let* ((name (bbdb-record-name record)) - (ftp-pfx-regexp (concat bbdb-ftp-site-name-designator-prefix " *")) - (ftp-site - (and (string-match ftp-pfx-regexp name) - (substring name (match-end 0))))) - ftp-site)) - -(defun remove-leading-whitespace (string) - "Remove any spaces or tabs from only the start of the string." - (let ((space-char-code (string-to-char " ")) - (tab-char-code ?\t) - (index 0)) - (if string - (progn - (while (or (char-equal (elt string index) space-char-code) - (char-equal (elt string index) tab-char-code)) - (setq index (+ index 1))) - (substring string index)) - nil))) - -;;;###autoload -(defun bbdb-ftp (bbdb-record &optional which) - "Use ange-ftp to open an ftp-connection to a BBDB record's name. -If this command is executed from the *BBDB* buffer, ftp the site of -the record at point; otherwise, it prompts for an ftp-site." - (interactive (list (bbdb-get-record "Visit (FTP): ") - (or current-prefix-arg 0))) - (if (bbdb-record-ftp-site bbdb-record) - (bbdb-ftp-internal bbdb-record) - (find-file-other-window - (read-string "fetch: " (bbdb-get-field bbdb-record 'ftp which))))) - -(defun bbdb-ftp-internal (bbdb-record) - (let* ((site (bbdb-record-ftp-site bbdb-record)) - (dir (or (bbdb-record-ftp-dir bbdb-record) bbdb-default-ftp-dir)) - (user (or (bbdb-record-ftp-user bbdb-record) bbdb-default-ftp-user)) - (file-string (concat "/" user "@" site ":" dir ))) - (if bbdb-inside-electric-display - (bbdb-electric-throw-to-execute (list 'bbdb-ftp-internal bbdb-record))) - (if site - (find-file-other-window file-string) - (error "Not an ftp site. Check bbdb-ftp-site-name-designator-prefix")))) - -(defun bbdb-read-new-ftp-site-record () - "Prompt for and return a completely new BBDB record that is -specifically an ftp site entry. Doesn't insert it in to the database -or update the hashtables, but does insure that there will not be name -collisions." - (bbdb-records) ; make sure database is loaded - (if bbdb-readonly-p (error "The Insidious Big Brother Database is read-only.")) - (let (site dir user) - (bbdb-error-retry - (progn - (setq site (bbdb-read-string "Ftp Site: ")) - ;; try and parse it out, in case the user typed in things like - ;; "ftp://user@site/directory/ or /user@site/directory - (if (string-match - "^\\([Ff][Tt][Pp]://\\|/\\)?\\([^@/]@\\)?\\([^/]+\\)\\(/[^/].*\\)?" - site) - (setq user (if (match-beginning 2) - (substring site (match-beginning 2) - (match-end 2))) - dir (if (match-beginning 4) - (substring site (match-beginning 4) - (match-end 4))) - site (substring site (match-beginning 3) - (match-end 3))) - (if (string-match "/" site) - (error "%s doesn't look like a valid site name." site))) - (setq site (concat bbdb-ftp-site-name-designator-prefix site)) - (if (and bbdb-no-duplicates-p - (bbdb-gethash (downcase site))) - (error "%s is already in the database" site)))) - (let* ((dir (or dir (bbdb-read-string "Ftp Directory: " - bbdb-default-ftp-dir))) - (user (or user (bbdb-read-string "Ftp Username: " - bbdb-default-ftp-user))) - (company (bbdb-read-string "Company: ")) - (notes (bbdb-read-string "Additional Comments: ")) - (names (bbdb-divide-name site)) - (firstname (car names)) - (lastname (nth 1 names))) - (if (string= user bbdb-default-ftp-user) (setq user nil)) - (if (string= company "") (setq company nil)) - (if (or (string= dir bbdb-default-ftp-dir) (string= dir "")) - (setq dir nil)) - (if (string= notes "") (setq notes nil)) - - (let ((record - (vector firstname lastname nil company nil nil nil - (append - (if notes (list (cons 'notes notes)) nil) - (if dir (list (cons 'ftp-dir dir)) nil) - (if user (list (cons 'ftp-user user)) nil)) - (make-vector bbdb-cache-length nil)))) - record)))) - -;;;###autoload -(defun bbdb-create-ftp-site (record) - "Add a new ftp-site entry to the bbdb database. -Prompts for all relevant info using the echo area, -inserts the new record in the db, sorted alphabetically." - (interactive (list (bbdb-read-new-ftp-site-record))) - (bbdb-invoke-hook 'bbdb-create-hook record) - (bbdb-change-record record t) - (bbdb-display-records (list record))) - -(provide 'bbdb-ftp) diff --git a/xemacs-packages/lisp/bbdb/bbdb-gnus.el b/xemacs-packages/lisp/bbdb/bbdb-gnus.el deleted file mode 100644 index 193f8e9a..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-gnus.el +++ /dev/null @@ -1,814 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; Interface to GNUS version 3.12 or greater. See bbdb.texinfo. - -;;; The Insidious Big Brother Database is free software; you can redistribute -;;; it and/or modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 1, or (at your -;;; option) any later version. -;;; -;;; BBDB 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. - -;; -;; $Id: bbdb-gnus.el,v 1.8 2005/07/24 15:22:57 waider Exp $ -;; - -(require 'bbdb) -(require 'bbdb-snarf) -(require 'gnus) - -(eval-and-compile - (require 'bbdb-com) - (require 'rfc822)) - -;; Cater for older emacs (19.34) with default Gnus installation. -(eval-and-compile - (condition-case nil - (progn - (require 'gnus-win) - (require 'gnus-sum) - (require 'gnus-art)) - (error nil))) - -;;; Compiler hushing -(eval-when-compile - (defvar gnus-optional-headers)) - -(defun bbdb/gnus-get-message-id () - "Return the message-id of the current message." - (save-excursion - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (let ((case-fold-search t)) - (if (re-search-forward "^Message-ID:\\s-*\\(<.+>\\)" (point-max) t) - (match-string 1))))) - -(defcustom bbdb/gnus-update-records-mode 'annotating -; '(if (gnus-new-flag msg) 'annotating 'searching) - "Controls how `bbdb/gnus-update-records' processes email addresses. -Set this to an expression which evaluates either to 'searching or -'annotating. When set to 'annotating email addresses will be fed to -`bbdb-annotate-message-sender' in order to update existing records or create -new ones. A value of 'searching will search just for existing records having -the right net. - -The default is to annotate only new messages." - :group 'bbdb-mua-specific-gnus - :type '(choice (const :tag "annotating all messages" - annotating) - (const :tag "annotating no messages" - searching) - (const :tag "annotating only new messages" - (if (equal "" - (gnus-summary-article-mark - (gnus-summary-article-number))) - 'annotating 'searching)) - (sexp :tag "user defined"))) - - -;;;###autoload -(defun bbdb/gnus-update-record (&optional offer-to-create) - "Return the record corresponding to the current GNUS message, creating -or modifying it as necessary. A record will be created if -bbdb/news-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and -the user confirms the creation." - (let* ((bbdb-get-only-first-address-p t) - (records (bbdb/gnus-update-records offer-to-create))) - (if records (car records) nil))) - -;;;###autoload -(defun bbdb/gnus-update-records (&optional offer-to-create) - "Return the records corresponding to the current GNUS message, creating -or modifying it as necessary. A record will be created if -bbdb/news-auto-create-p is non-nil or if OFFER-TO-CREATE is true -and the user confirms the creation. - -The variable `bbdb/gnus-update-records-mode' controls what actions -are performed and it might override `bbdb-update-records-mode'. - -When hitting C-g once you will not be asked anymore for new people listed -in this message, but it will search only for existing records. When hitting -C-g again it will stop scanning." - (let ((bbdb-update-records-mode (or bbdb/gnus-update-records-mode - bbdb-update-records-mode)) - (bbdb/gnus-offer-to-create offer-to-create) - ;; here we may distiguish between different type of messages - ;; for those that have no message id we have to find something - ;; else as message key. - (msg-id (bbdb/gnus-get-message-id)) - records cache) - (save-excursion - (set-buffer gnus-article-buffer) - - (if (and msg-id (not bbdb/gnus-offer-to-create)) - (setq cache (bbdb-message-cache-lookup msg-id))) - - (if cache - (setq records (if bbdb-get-only-first-address-p - (list (car cache)) - cache)) - - (let ((bbdb-update-records-mode (or bbdb/gnus-update-records-mode - bbdb-update-records-mode))) - (setq records (bbdb-update-records - (bbdb-get-addresses - bbdb-get-only-first-address-p - (or (if (boundp 'gnus-ignored-from-addresses) - gnus-ignored-from-addresses) - bbdb-user-mail-names) - 'gnus-fetch-field) - bbdb/news-auto-create-p - offer-to-create))) - (if (and bbdb-message-caching-enabled msg-id) - (bbdb-encache-message msg-id records)))) - records)) - -;;;###autoload -(defun bbdb/gnus-annotate-sender (string &optional replace) - "Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message. If REPLACE is non-nil, -replace the existing notes entry (if any)." - (interactive (list (if bbdb-readonly-p - (error "The Insidious Big Brother Database is read-only.") - (read-string "Comments: ")))) - (gnus-summary-select-article) - (bbdb-annotate-notes (bbdb/gnus-update-record t) string 'notes replace)) - -(defun bbdb/gnus-edit-notes (&optional arg) - "Edit the notes field or (with a prefix arg) a user-defined field -of the BBDB record corresponding to the sender of this message." - (interactive "P") - (gnus-summary-select-article) - (let ((record (or (bbdb/gnus-update-record t) (error "unperson")))) - (bbdb-display-records (list record)) - (if arg - (bbdb-record-edit-property record nil t) - (bbdb-record-edit-notes record t)))) - -;;;###autoload -(defun bbdb/gnus-show-records (&optional address-class) - "Display the contents of the BBDB for all addresses of this message. -This buffer will be in `bbdb-mode', with associated keybindings." - (interactive) - (gnus-summary-select-article) - (let ((bbdb-get-addresses-headers - (if address-class - (list (assoc address-class bbdb-get-addresses-headers)) - bbdb-get-addresses-headers)) - (bbdb/gnus-update-records-mode 'annotating) - (bbdb-message-cache nil) - (bbdb-user-mail-names nil) - (gnus-ignored-from-addresses nil) - records) - (setq records (bbdb/gnus-update-records t)) - (if records - (bbdb-display-records records) - (bbdb-undisplay-records)) - records)) - -;;;###autoload -(defun bbdb/gnus-show-all-recipients () - "Show all recipients of this message. Counterpart to `bbdb/vm-show-sender'." - (interactive) - (let ((bbdb-get-only-first-address-p nil)) - (bbdb/gnus-show-records 'recipients))) - -(defun bbdb/gnus-show-sender (&optional show-recipients) - "Display the contents of the BBDB for the senders of this message. -With a prefix argument show the recipients instead, -with two prefix arguments show all records. -This buffer will be in `bbdb-mode', with associated keybindings." - (interactive "p") - (cond ((= 4 show-recipients) - (bbdb/gnus-show-all-recipients)) - ((= 16 show-recipients) - (let ((bbdb-get-only-first-address-p nil)) - (bbdb/gnus-show-records))) - (t - (if (null (bbdb/gnus-show-records 'authors)) - (bbdb/gnus-show-all-recipients))))) - -(defun bbdb/gnus-pop-up-bbdb-buffer (&optional offer-to-create) - "Make the *BBDB* buffer be displayed along with the GNUS windows, -displaying the record corresponding to the sender of the current message." - (let ((bbdb-gag-messages t) - (records (bbdb/gnus-update-records offer-to-create)) - (bbdb-electric-p nil)) - - (when bbdb-use-pop-up - (let ((b (current-buffer))) - ;; display the bbdb buffer iff there is a record for this article. - (if records - (bbdb-pop-up-bbdb-buffer - (lambda (w) - (let ((b (current-buffer))) - (set-buffer (window-buffer w)) - (prog1 (eq major-mode 'gnus-article-mode) - (set-buffer b))))) - (or bbdb-inside-electric-display - (not (get-buffer-window bbdb-buffer-name)) - (let (w) - (delete-other-windows) - (gnus-configure-windows 'article) - (if (setq w (get-buffer-window gnus-summary-buffer)) - (select-window w))))) - (set-buffer b)) - (if records (bbdb-display-records records bbdb-pop-up-display-layout))) - records)) - -;; -;; Announcing BBDB entries in the summary buffer -;; - -(defcustom bbdb/gnus-lines-and-from-length 18 - "*The number of characters used to display From: info in Gnus, if you have -set gnus-optional-headers to 'bbdb/gnus-lines-and-from." - :group 'bbdb-mua-specific-gnus - :type 'integer) - -(defcustom bbdb/gnus-summary-mark-known-posters t - "*If t, mark messages created by people with records in the BBDB. -In GNUS, this marking will take place in the subject list (assuming -`gnus-optional-headers' contains `bbdb/gnus-lines-and-from'). In Gnus, the -marking will take place in the Summary buffer if the format code defined by -`bbdb/gnus-summary-user-format-letter' is used in `gnus-summary-line-format'. -This variable has no effect on the marking controlled by -`bbdb/gnus-summary-in-bbdb-format-letter'." - :group 'bbdb-mua-specific-gnus - :type '(choice (const :tag "Mark known posters" t) - (const :tag "Do not mark known posters" nil))) -(defvaralias 'bbdb/gnus-mark-known-posters - 'bbdb/gnus-summary-mark-known-posters) - -(defcustom bbdb/gnus-summary-known-poster-mark "+" - "This is the default character to prefix author names with if -bbdb/gnus-summary-mark-known-posters is t. If the poster's record has -an entry in the field named by bbdb-message-marker-field, then that will -be used instead." - :group 'bbdb-mua-specific-gnus - :type 'character) - -(defcustom bbdb/gnus-summary-show-bbdb-names t - "*If both this variable and `bbdb/gnus-summary-prefer-real-names' are true, -then for messages from authors who are in your database, the name -displayed will be the primary name in the database, rather than the -one in the From line of the message. This doesn't affect the names of -people who aren't in the database, of course. (`gnus-optional-headers' -must be `bbdb/gnus-lines-and-from' for GNUS users.)" - :group 'bbdb-mua-specific-gnus - :type 'boolean) -(defvaralias 'bbdb/gnus-header-show-bbdb-names - 'bbdb/gnus-summary-show-bbdb-names) - -(defcustom bbdb/gnus-summary-prefer-bbdb-data t - "If t, then for posters who are in our BBDB, replace the information -provided in the From header with data from the BBDB." - :group 'bbdb-mua-specific-gnus - :type 'boolean) - -(defcustom bbdb/gnus-summary-prefer-real-names t - "If t, then display the poster's name from the BBDB if we have one, -otherwise display his/her primary net address if we have one. If it -is set to the symbol bbdb, then real names will be used from the BBDB -if present, otherwise the net address in the post will be used. If -bbdb/gnus-summary-prefer-bbdb-data is nil, then this has no effect. -See `bbdb/gnus-lines-and-from' for GNUS users, or -`bbdb/gnus-summary-user-format-letter' for Gnus users." - :group 'bbdb-mua-specific-gnus - :type '(choice (const :tag "Prefer real names" t) - (const :tag "Prefer network addresses" nil))) -(defvaralias 'bbdb/gnus-header-prefer-real-names - 'bbdb/gnus-summary-prefer-real-names) - -(defcustom bbdb/gnus-summary-user-format-letter "B" - "This is the gnus-user-format-function- that will be used to insert -the information from the BBDB in the summary buffer (using -`bbdb/gnus-summary-get-author'). This format code is meant to replace -codes that insert sender names or addresses (like %A or %n). Unless -you've already got other code using user format B, you might as well -stick with the default. Additionally, if the value of this variable -is nil, no format function will be installed for -`bbdb/gnus-summary-get-author'. See also -`bbdb/gnus-summary-in-bbdb-format-letter', which installs a format -code for `bbdb/gnus-summary-author-in-bbdb'" - :group 'bbdb-mua-specific-gnus - :type 'character) - -(defcustom bbdb/gnus-summary-in-bbdb-format-letter "b" - "This is the gnus-user-format-function- that will be used to insert -`bbdb/gnus-summary-known-poster-mark' (using -`bbdb/gnus-summary-author-in-bbdb') if the poster is in the BBDB, and -\" \" if not. If the value of this variable is nil, no format code -will be installed for `bbdb/gnus-summary-author-in-bbdb'. See also -`bbdb/gnus-summary-user-format-letter', which installs a format code -for `bbdb/gnus-summary-get-author'." - :group 'bbdb-mua-specific-gnus - :type 'character) - -(defcustom bbdb-message-marker-field 'mark-char - "*The field whose value will be used to mark messages by this user in Gnus." - :group 'bbdb-mua-specific-gnus - :type 'symbol) - -(defun bbdb/gnus-summary-get-author (header) - "Given a Gnus message header, returns the appropriate piece of -information to identify the author in a Gnus summary line, depending on -the settings of the various configuration variables. See the -documentation for the following variables for more details: - `bbdb/gnus-summary-mark-known-posters' - `bbdb/gnus-summary-known-poster-mark' - `bbdb/gnus-summary-prefer-bbdb-data' - `bbdb/gnus-summary-prefer-real-names' -This function is meant to be used with the user function defined in - `bbdb/gnus-summary-user-format-letter'" - (let* ((from (mail-header-from header)) - (data (and bbdb/gnus-summary-show-bbdb-names - (condition-case nil - (mail-extract-address-components from) - (error nil)))) - (name (car data)) - (net (car (cdr data))) - (record (and data - (bbdb-search-simple - name - (if (and net bbdb-canonicalize-net-hook) - (bbdb-canonicalize-address net) - net))))) - (if (and record name (member (downcase name) (bbdb-record-net record))) - ;; bogon! - (setq record nil)) - (setq name - (or (and bbdb/gnus-summary-prefer-bbdb-data - (or (and bbdb/gnus-summary-prefer-real-names - (and record (bbdb-record-name record))) - (and record (bbdb-record-net record) - (nth 0 (bbdb-record-net record))))) - (and bbdb/gnus-summary-prefer-real-names - (or (and (equal bbdb/gnus-summary-prefer-real-names 'bbdb) - net) - name)) - net from "**UNKNOWN**")) - (format "%s%s" - (or (and record bbdb/gnus-summary-mark-known-posters - (or (bbdb-record-getprop - record bbdb-message-marker-field) - bbdb/gnus-summary-known-poster-mark)) - " ") - name))) - -;; DEBUG: (bbdb/gnus-summary-author-in-bbdb "From: simmonmt@acm.org") -(defun bbdb/gnus-summary-author-in-bbdb (header) - "Given a Gnus message header, returns a mark if the poster is in the BBDB, \" \" otherwise. The mark itself is the value of the field indicated by `bbdb-message-marker-field' (`mark-char' by default) if the indicated field is in the poster's record, and `bbdb/gnus-summary-known-poster-mark' otherwise." - (let* ((from (mail-header-from header)) - (data (condition-case () - (mail-extract-address-components from) - (error nil))) - (name (car data)) - (net (cadr data)) - record) - (if (and data - (setq record - (bbdb-search-simple - name (if (and net bbdb-canonicalize-net-hook) - (bbdb-canonicalize-address net) - net)))) - (or (bbdb-record-getprop - record bbdb-message-marker-field) - bbdb/gnus-summary-known-poster-mark) " "))) - -;; -;; Gnus-specific snarfing (see also bbdb-snarf.el) -;; - -;;;###autoload -(defun bbdb/gnus-snarf-signature () - "Snarf signature from the corresponding *Article* buffer." - (interactive) - (save-excursion - ;; this is a little bogus, since it will remain set after you've - ;; quit Gnus - (or gnus-article-buffer (error "Not in Gnus!")) - ;; This is wrong for non-ASCII text. Why not use - ;; gnus-article-hide-signature? - (set-buffer gnus-original-article-buffer) - (save-restriction - (or (gnus-article-narrow-to-signature) (error "No signature!")) - (bbdb-snarf-region (point-min) (point-max))))) - -;; -;; Scoring -;; - -(defcustom bbdb/gnus-score-field 'gnus-score - "This variable contains the name of the BBDB field which should be -checked for a score to add to the net addresses in the same record." - :group 'bbdb-mua-specific-gnus-scoring - :type 'symbol) - -(defcustom bbdb/gnus-score-default nil - "If this is set, then every net address in the BBDB that does not have -an associated score field will be assigned this score. A value of nil -implies a default score of zero." - :group 'bbdb-mua-specific-gnus-scoring - :type '(choice (const :tag "Do not assign default score") - (integer :tag "Assign this default score" 0))) - -(defvar bbdb/gnus-score-default-internal nil - "Internal variable for detecting changes to -`bbdb/gnus-score-default'. You should not set this variable directly - -set `bbdb/gnus-score-default' instead.") - -(defvar bbdb/gnus-score-alist nil - "The text version of the scoring structure returned by -bbdb/gnus-score. This is built automatically from the BBDB.") - -(defvar bbdb/gnus-score-rebuild-alist t - "Set to t to rebuild bbdb/gnus-score-alist on the next call to -bbdb/gnus-score. This will be set automatically if you change a BBDB -record which contains a gnus-score field.") - -(defun bbdb/gnus-score-invalidate-alist (rec) - "This function is called through `bbdb-after-change-hook', -and sets `bbdb/gnus-score-rebuild-alist' to t if the changed -record contains a gnus-score field." - (if (bbdb-record-getprop rec bbdb/gnus-score-field) - (setq bbdb/gnus-score-rebuild-alist t))) - -;;;###autoload -(defun bbdb/gnus-score (group) - "This returns a score alist for GNUS. A score pair will be made for -every member of the net field in records which also have a gnus-score -field. This allows the BBDB to serve as a supplemental global score -file, with the advantage that it can keep up with multiple and changing -addresses better than the traditionally static global scorefile." - (list (list - (condition-case nil - (read (bbdb/gnus-score-as-text group)) - (error (setq bbdb/gnus-score-rebuild-alist t) - (message "Problem building BBDB score table.") - (ding) (sit-for 2) - nil))))) - -(defun bbdb/gnus-score-as-text (group) - "Returns a SCORE file format string built from the BBDB." - (cond ((or (cond ((/= (or bbdb/gnus-score-default 0) - (or bbdb/gnus-score-default-internal 0)) - (setq bbdb/gnus-score-default-internal - bbdb/gnus-score-default) - t)) - (not bbdb/gnus-score-alist) - bbdb/gnus-score-rebuild-alist) - (setq bbdb/gnus-score-rebuild-alist nil) - (setq bbdb/gnus-score-alist - (concat "((touched nil) (\"from\"\n" - (mapconcat - (lambda (rec) - (let ((score (or (bbdb-record-getprop rec - bbdb/gnus-score-field) - bbdb/gnus-score-default)) - (net (bbdb-record-net rec))) - (if (not (and score net)) nil - (mapconcat - (lambda (addr) - (format "(\"%s\" %s)\n" addr score)) - net "")))) - (bbdb-records) "") - "))")))) - bbdb/gnus-score-alist) - -;;;###autoload -(defun bbdb/gnus-summary-show-all-recipients (not-elided) - "Display BBDB records for all recipients of the message." - (interactive "P") - (let ((bbdb-display-layout (or (not not-elided) - bbdb-pop-up-display-layout - bbdb-display-layout)) - (bbdb-get-only-first-address-p nil)) - (gnus-summary-select-article) - (bbdb/gnus-show-records 'recipients))) - -;;; from Brian Edmonds' gnus-bbdb.el -;;; -;;; Filing with gnus-folder REQUIRES (ding) 0.50 OR HIGHER -;;; -;;; To use this feature, you need to put this file somewhere in your -;;; load-path and add the following lines of code to your .gnus file: -;;; -;;; (setq nnmail-split-methods 'bbdb/gnus-split-method) -;;; -;;; You should also examine the variables defvar'd below and customize -;;; them to your taste. They're listed roughly in descending likelihood -;;; of your wanting to change them. Once that is done, you need to add -;;; filing information to your BBDB. There are two fields of interest: -;;; -;;; 1. gnus-private. This field contains the name of the group in which -;;; mail to you from any of the addresses associated with this record -;;; will be filed. Also, any self-copies of mail you send any of the -;;; same addresses will be filed here. -;;; 2. gnus-public. This field is used to keep mail from mailing lists -;;; out of the private mailboxes. It should be added to a record for -;;; the list submission address, and is formatted as follows: -;;; "group regexp" -;;; where group is where mail from the list should be filed, and -;;; regexp is a regular expression which is checked against the -;;; envelope sender (from the From_ header) to verify that this is -;;; the copy which came from the list. For example, the entry for -;;; the ding mailing list might be: -;;; "mail.emacs.ding ding-request@ifi.uio.no" -;;; Yes, the second part *is* a regexp, so those dots may match -;;; something other than dots. Sue me. -;;; -;;; Note that you can also specify a gnus-private field for mailing list -;;; addresses, in which case self-copies of mail you send to the list -;;; will be filed there. Also, the field names can be changed below if -;;; the defaults aren't hip enough for you. Lastly, if you specify a -;;; gnus-private field for your *own* BBDB record, then all self-copies -;;; of mail you send will be filed to that group. -;;; -;;; This documentation should probably be expanded and moved to a -;;; separate file, but it's late, and *I* know what I'm trying to -;;; say. :) - -;;; custom bits -(defcustom bbdb/gnus-split-default-group "mail.misc" - "*If the BBDB doesn't indicate any group to spool a message to, it will -be spooled to this group. If bbdb/gnus-split-crosspost-default is not -nil, and if the BBDB did not indicate a specific group for one or more -addresses, messages will be crossposted to this group in addition to any -group(s) which the BBDB indicated." - :group 'bbdb-mua-specific-gnus-splitting - :type 'string) - -(defcustom bbdb/gnus-split-nomatch-function nil - "*This function will be called after searching the BBDB if no place to -file the message could be found. It should return a group name (or list -of group names) -- nnmail-split-fancy as provided with Gnus is an -excellent choice." - :group 'bbdb-mua-specific-gnus-splitting - :type 'function) - -(defcustom bbdb/gnus-split-myaddr-regexp - (concat "^" (user-login-name) "$\\|^" - (user-login-name) "@\\([-a-z0-9]+\\.\\)*" - (or gnus-local-domain (message-make-domain) - (system-name) "") "$") - "*This regular expression should match your address as found in the -From header of your mail. You should make sure gnus-local-domain or -gnus-use-generic-from are set before loading this module, if they differ -from (system-name). If you send mail/news from multiple addresses, then -you'll likely have to set this yourself anyways." - :group 'bbdb-mua-specific-gnus-splitting - :type 'string) - -(defcustom bbdb/gnus-split-crosspost-default nil - "*If this variable is not nil, then if the BBDB could not identify a -group for every mail address, messages will be filed in -bbdb/gnus-split-default-group in addition to any group(s) which the BBDB -identified." - :group 'bbdb-mua-specific-gnus-splitting - :type 'boolean) - -(defcustom bbdb/gnus-split-private-field 'gnus-private - "*This variable is used to determine the field to reference to find the -associated group when saving private mail for a network address known to -the BBDB. The value of the field should be the name of a mail group." - :group 'bbdb-mua-specific-gnus-splitting - :type 'string) - -(defcustom bbdb/gnus-split-public-field 'gnus-public - "*This variable is used to determine the field to reference to find the -associated group when saving non-private mail (received from a mailing -list) for a network address known to the BBDB. The value of the field -should be the name of a mail group, followed by a space, and a regular -expression to match on the envelope sender to verify that this mail came -from the list in question." - :group 'bbdb-mua-specific-gnus-splitting - :type 'string) - -;; The split function works by assigning one of four spooling priorities -;; to each group that is associated with an address in the message. The -;; priorities are assigned as follows: -;; -;; 0. This priority is assigned when crosspost-default is nil to To/Cc -;; addresses which have no private group defined in the BBDB. If the -;; user's own address has no private group defined, then it will -;; always be given this priority. -;; 1. This priority is assigned to To/Cc addresses which have a private -;; group defined in the BBDB. If crosspost-default is not nil, then -;; To/Cc addresses which have no private group will also be assigned -;; this priority. This is also assigned to the user's own address in -;; the From position if a private group is defined for it. -;; 2. This priority is assigned to From addresses which have a private -;; group defined in the BBDB, except for the user's own address as -;; described under priorities 0 and 1. -;; 3. This priority is assigned to To/Cc addresses which have a public -;; group defined in the BBDB, and whose associated regular expression -;; matches the envelope sender (found in the header From_). -;; -;; The split function evaluates the spool priority for each address in -;; the headers of the message, and returns as a list all the groups -;; associated with the addresses which share the highest calculated -;; priority. - -;;;#autoload -(defun bbdb/gnus-split-method nil - "This function expects to be called in a buffer which contains a mail -message to be spooled, and the buffer should be narrowed to the message -headers. It returns a list of groups to which the message should be -spooled, using the addresses in the headers and information from the -BBDB." - (let ((prq (list (cons 0 nil) (cons 1 nil) (cons 2 nil) (cons 3 nil)))) - ;; the From: header is special - (let* ((hdr (or (mail-fetch-field "resent-from") - (mail-fetch-field "from") - (user-login-name))) - (rv (bbdb/gnus-split-to-group hdr t))) - (setcdr (nth (cdr rv) prq) (cons (car rv) nil))) - ;; do the rest of the headers - (let ((hdr (or (concat (or (mail-fetch-field "resent-to" nil t) - (mail-fetch-field "to" nil t)) - ", " - (mail-fetch-field "cc" nil t) - ", " - (mail-fetch-field "apparently-to" nil t)) - ""))) - (setq hdr (rfc822-addresses hdr)) - (while hdr - (let* ((rv (bbdb/gnus-split-to-group (car hdr))) - (pr (nth (cdr rv) prq))) - (or (member (car rv) pr) (setcdr pr (cons (car rv) (cdr pr))))) - (setq hdr (cdr hdr)))) - ;; find the highest non-empty queue - (setq prq (reverse prq)) - (while (and prq (not (cdr (car prq)))) (setq prq (cdr prq))) - ;; and return... - (if (not (or (not (cdr (car prq))) - (and (equal (cdr (car prq)) (list bbdb/gnus-split-default-group)) - (symbolp bbdb/gnus-split-nomatch-function) - (fboundp bbdb/gnus-split-nomatch-function)))) - (cdr (car prq)) - (goto-char (point-min)) - (funcall bbdb/gnus-split-nomatch-function)))) - -(defun bbdb/gnus-split-to-group (addr &optional source) - "This function is called from bbdb/gnus-split-method in order to -determine the group and spooling priority for a single address." - (condition-case tmp - (progn - (setq tmp (mail-extract-address-components addr)) - (let* ((nam (car tmp)) - (net (if (not bbdb-canonicalize-net-hook) (car (cdr tmp)) - (bbdb-canonicalize-address (car (cdr tmp))))) - (rec (bbdb-search-simple nam net)) - pub prv rgx) - (if (not rec) nil - (setq prv (bbdb-record-getprop rec bbdb/gnus-split-private-field) - pub (bbdb-record-getprop rec bbdb/gnus-split-public-field)) - (if (and pub (not source) (string-match "^\\([^ ]+\\) \\(.*\\)$" pub)) - (setq rgx (substring pub (match-beginning 2) (match-end 2)) - pub (substring pub (match-beginning 1) (match-end 1))) - (setq pub nil))) - (cond - ((and rgx pub - (goto-char (point-min)) - (re-search-forward "^From: \\([^ \n]+\\)[ \n]" nil t) - (string-match rgx (buffer-substring (match-beginning 1) - (match-end 1)))) - (cons pub 3)) - (prv - (cons prv - (- 1 (if source -1 0) - (if (string-match bbdb/gnus-split-myaddr-regexp net) 1 0)))) - (t - (cons bbdb/gnus-split-default-group - (if (string-match bbdb/gnus-split-myaddr-regexp net) 0 - (if source 2 (if bbdb/gnus-split-crosspost-default 1 0)))))))) - (error (cons bbdb/gnus-split-default-group 0)))) - -;; -;; Insinuation -;; - -;;;###autoload -(defun bbdb-insinuate-gnus () - "Call this function to hook BBDB into GNUS." - (setq gnus-optional-headers 'bbdb/gnus-lines-and-from) - (add-hook 'gnus-article-prepare-hook 'bbdb/gnus-pop-up-bbdb-buffer) - (add-hook 'gnus-save-newsrc-hook 'bbdb-offer-save) - (define-key gnus-summary-mode-map ":" 'bbdb/gnus-show-sender) - (define-key gnus-summary-mode-map ";" 'bbdb/gnus-edit-notes) - - ;; Set up user field for use in gnus-summary-line-format - (let ((get-author-user-fun (intern - (concat "gnus-user-format-function-" - bbdb/gnus-summary-user-format-letter))) - (in-bbdb-user-fun (intern - (concat "gnus-user-format-function-" - bbdb/gnus-summary-in-bbdb-format-letter)))) - ; The big one - whole name - (cond (bbdb/gnus-summary-user-format-letter - (if (and (fboundp get-author-user-fun) - (not (eq (symbol-function get-author-user-fun) - 'bbdb/gnus-summary-get-author))) - (bbdb-warn - (format "`gnus-user-format-function-%s' already seems to be in use. -Please redefine `bbdb/gnus-summary-user-format-letter' to a different letter." - bbdb/gnus-summary-user-format-letter)) - (fset get-author-user-fun 'bbdb/gnus-summary-get-author)))) - - ; One tick. One tick only, please - (cond (bbdb/gnus-summary-in-bbdb-format-letter - (if (and (fboundp in-bbdb-user-fun) - (not (eq (symbol-function in-bbdb-user-fun) - 'bbdb/gnus-summary-author-in-bbdb))) - (bbdb-warn - (format "`gnus-user-format-function-%s' already seems to be in use. -Redefine `bbdb/gnus-summary-in-bbdb-format-letter' to a different letter." - bbdb/gnus-summary-in-bbdb-format-letter)) - (fset in-bbdb-user-fun 'bbdb/gnus-summary-author-in-bbdb))))) - - ;; Scoring - (add-hook 'bbdb-after-change-hook 'bbdb/gnus-score-invalidate-alist) -; (setq gnus-score-find-score-files-function -; (if (boundp 'gnus-score-find-score-files-function) -; (cond ((functionp gnus-score-find-score-files-function) -; (list gnus-score-find-score-files-function -; 'bbdb/gnus-score)) -; ((listp gnus-score-find-score-files-function) -; (append gnus-score-find-score-files-function -; 'bbdb/gnus-score)) -; (t 'bbdb/gnus-score)) -; 'bbdb/gnus-score)) - ) - -;; Uwe Brauer -(defun bbdb/gnus-nnimap-folder-list-from-bbdb () - "Return a list of \( \"From\" email-regexp imap-folder-name\) tuples -based on the contents of the bbdb. - -The folder-name is the value of the 'imap attribute on the bbdb -record; the email-regexp consists of all the email addresses for the -bbdb record concatenated with with OR. bbdb records without a 'imap -attribute are ignored. -Here is an example of a relevant BBDB entry: - -Uwe Brauer - net: oub@mat.ucm.es - imap: testimap - - -This function uses regexp-opt to generate the email-regexp which -automatically regexp-quotes its arguments. Please note: in oder that -this will work with the nnimap-split-fancy method you have to use -macros, that is your setting will look like: - -\(setq - nnimap-split-rule 'nnimap-split-fancy - nnimap-split-inbox \"INBOX\" - nnimap-split-fancy - `\(| - ,@\(bbdb/gnus-nnimap-folder-list-from-bbdb\) - ... -\)\) -Note that `\( is the backquote NOT the quote '\(. " - - ;(interactive) - (let ( ;; the raw-notes attribute of a bbdb record - notes-attr - ;; the value of the 'imap attribute of a bbdb record - folder-attr - ;; strings to put before and after the folder-attr - (folder-prefix "") - (folder-postfix "") - ;; a regexp matching all the email addresses from a bbdb record - email-regexp - ;; the list of (folder email) tuples to return - new-elmnt-list - ) - ;; loop over the bbdb-records; if a imap attribute exists on - ;; the record, generate a regexp matching all the email addresses - ;; and add a tuple (folder email-regexp) to the new-elmnt-list - (dolist (record (bbdb-records)) - (setq notes-attr (bbdb-record-raw-notes record)) - (when (and (listp notes-attr) - (setq folder-attr (cdr (assq 'imap notes-attr)))) - (setq email-regexp (regexp-opt (mapcar 'downcase - (bbdb-record-net record)))) - (unless (zerop (length email-regexp)) - (setq new-elmnt-list - (cons (list "From" email-regexp (concat folder-prefix - folder-attr folder-postfix)) - new-elmnt-list))))) - new-elmnt-list)) - - -(provide 'bbdb-gnus) diff --git a/xemacs-packages/lisp/bbdb/bbdb-gui.el b/xemacs-packages/lisp/bbdb/bbdb-gui.el deleted file mode 100644 index d084b73e..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-gui.el +++ /dev/null @@ -1,526 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- -;;; This file contains font and menu hacks for BBDB. - -;;; This file is the part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1992, 1993, 1994 Jamie Zawinski . - -;;; The Insidious Big Brother Database 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. -;;; -;;; BBDB is distributed in the hope that it will be useful, but WITHOUT ANY -;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more -;;; details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; This code is kind of kludgey, mostly because it needs to parse the contents -;;; of the *BBDB* buffer, since BBDB doesn't save the buffer-positions of the -;;; various fields when it fills in that buffer (doing that would be slow and -;;; cons a lot, so it doesn't seem to be worth it.) - -(require 'bbdb) -(require 'bbdb-com) - -;; compiler whinage. Some of this is legacy stuff that would probably -;; be better deleted. -(defvar scrollbar-height nil) - -;; MIGRATE XXX -(eval-and-compile - (if (fboundp 'set-specifier) - (defalias 'bbdb-set-specifier 'set-specifier) - (defalias 'bbdb-set-specifier 'ignore)) - (if (fboundp 'make-glyph) - (defalias 'bbdb-make-glyph 'make-glyph) - (defalias 'bbdb-make-glyph 'ignore)) - (if (fboundp 'set-glyph-face) - (defalias 'bbdb-set-glyph-face 'set-glyph-face) - (defalias 'bbdb-set-glyph-face 'ignore)) - (if (fboundp 'highlight-headers-x-face) - (defalias 'bbdb-highlight-headers-x-face 'highlight-headers-x-face) - (defalias 'bbdb-highlight-headers-x-face 'ignore)) - (if (fboundp 'highlight-headers-x-face-to-pixmap) - (defalias 'bbdb-highlight-headers-x-face-to-pixmap - 'highlight-headers-x-face-to-pixmap) - (defalias 'bbdb-highlight-headers-x-face-to-pixmap 'ignore))) - - -(if (featurep 'xemacs) - (progn - (define-key bbdb-mode-map 'button3 'bbdb-menu) - (define-key bbdb-mode-map 'button2 - (lambda (e) - (interactive "e") - (mouse-set-point e) - (bbdb-toggle-records-display-layout nil)))) - (define-key bbdb-mode-map [mouse-3] 'bbdb-menu) - (define-key bbdb-mode-map [mouse-2] - (lambda (e) - (interactive "e") - (mouse-set-point e) - (bbdb-toggle-records-display-layout nil)))) - -(eval-and-compile - (if (fboundp 'find-face) - (defalias 'bbdb-find-face 'find-face) - (if (fboundp 'internal-find-face) ;; GRR. - ;; This should be facep in Emacs 21 - (defalias 'bbdb-find-face 'internal-find-face) - (defalias 'bbdb-find-face 'ignore)))) ; noop - you probably don't HAVE faces. - -(or (bbdb-find-face 'bbdb-name) - (face-differs-from-default-p (make-face 'bbdb-name)) - (set-face-underline-p 'bbdb-name t)) - -(condition-case nil - (or (bbdb-find-face 'bbdb-company) - (face-differs-from-default-p (make-face 'bbdb-company)) - (make-face-italic 'bbdb-company)) ;; this can fail on emacs - (error nil)) - -(or (bbdb-find-face 'bbdb-field-value) - (make-face 'bbdb-field-value)) - -(or (bbdb-find-face 'bbdb-field-name) - (face-differs-from-default-p (make-face 'bbdb-field-name)) - (copy-face 'bold 'bbdb-field-name)) - -;;; Extents vs. Overlays unhappiness -;;; FIXME: see if VM is around, and call its extents code instead; -;;; change bbdb-foo-extents below to vm-foo-extents, etc. -(eval-and-compile - (if (fboundp 'make-extent) - (defalias 'bbdb-make-extent 'make-extent) - (defalias 'bbdb-make-extent 'make-overlay)) - - (if (fboundp 'delete-extent) - (defalias 'bbdb-delete-extent 'delete-extent) - (defalias 'bbdb-delete-extent 'delete-overlay)) - - (if (fboundp 'mapcar-extents) - (defmacro bbdb-list-extents() `(mapcar-extents 'identity)) - (defun bbdb-list-extents() - (let ((o (overlay-lists))) (nconc (car o) (cdr o))))) - - (if (fboundp 'mapcar-extents) - (defmacro bbdb-extents-in (s e) - (list 'mapcar-extents ''identity nil nil s e)) - (defmacro bbdb-extents-in (s e) - (list 'overlays-in s e))) - - (if (fboundp 'set-extent-property) - (defalias 'bbdb-set-extent-property 'set-extent-property) - (defun bbdb-set-extent-property( e p v ) - (if (eq 'highlight p) - (if v - (overlay-put e 'mouse-face 'highlight) - (overlay-put e 'mouse-face nil))) - (overlay-put e p v))) - - (if (fboundp 'extent-property) - (defalias 'bbdb-extent-property 'extent-property) - (defalias 'bbdb-extent-property 'overlay-get)) - - (if (fboundp 'extent-at) - (defalias 'bbdb-extent-at 'extent-at) - (defun bbdb-extent-at (pos buf tag) "NOT FULL XEMACS IMPLEMENTATION" - (let ((o (overlays-at pos)) - minpri retval) - (while (car o) - (let ((x (car o))) - (and (overlayp x) - (overlay-get x tag) - (if (or (null minpri) (> minpri (overlay-get x 'priority))) - (setq retval x - minpri (overlay-get x 'priority)))) - (setq o (cdr o)))) - retval))) - - (if (fboundp 'highlight-extent) - (defalias 'bbdb-highlight-extent 'highlight-extent) - (defalias 'bbdb-highlight-extent 'ignore)) ; XXX noop - - (if (fboundp 'extent-start-position) - (defalias 'bbdb-extent-start-position 'extent-start-position) - (defalias 'bbdb-extent-start-position 'overlay-start)) - - (if (fboundp 'extent-end-position) - (defalias 'bbdb-extent-end-position 'extent-end-position) - (defalias 'bbdb-extent-end-position 'overlay-end)) - - (if (fboundp 'extent-face) - (defalias 'bbdb-extent-face 'extent-face) - (defun bbdb-extent-face (extent) - (overlay-get extent 'face))) - - (if (fboundp 'set-extent-face) - (defalias 'bbdb-set-extent-face 'set-extent-face) - (defun bbdb-set-extent-face (extent face) "set the face for an overlay" - (overlay-put extent 'face face))) - - (if (fboundp 'set-extent-begin-glyph) - (defalias 'bbdb-set-extent-begin-glyph 'set-extent-begin-glyph) - (defalias 'bbdb-set-extent-begin-glyph 'ignore)) ; XXX noop - - (if (fboundp 'set-extent-end-glyph) - (defalias 'bbdb-set-extent-end-glyph 'set-extent-end-glyph) - (defalias 'bbdb-set-extent-end-glyph 'ignore))) ; XXX noop - - -(eval-when-compile (defvar scrollbar-height)) -;;;###autoload -(defun bbdb-fontify-buffer (&optional records) - (interactive) - (save-excursion - (set-buffer bbdb-buffer-name) - (if (featurep 'scrollbar) - (bbdb-set-specifier scrollbar-height (cons (current-buffer) 0))) - - (let ((rest (or records bbdb-records)) - record face - start end s e - multi-line-p - property - extent) - - (while rest - (setq record (car (car rest)) - multi-line-p (string-match "multi-line" - (symbol-name (nth 1 (car rest)))) - face (and multi-line-p (bbdb-record-getprop record 'face)) - start (marker-position (nth 2 (car rest))) - end (1- (or (nth 2 (car (cdr rest))) (point-max)))) - - (if (< start (point-min)) (setq start (point-min))) - (if (> end (point-max)) (setq end (point-max))) - - (mapcar (function (lambda(o) - (if (and o - (eq (bbdb-extent-property o 'data) - 'bbdb)) - (bbdb-delete-extent o)))) - (bbdb-extents-in start end)) - - (setq extent (bbdb-make-extent start end)) - (bbdb-set-extent-property extent 'highlight t) - (bbdb-set-extent-property extent 'data 'bbdb) - ;; note that on GNU Emacs, once you hit the main overlay, you - ;; have to move off the record and back on again before it'll - ;; notice that you're on a more specific overlay. This is - ;; bogus, like most GNU Emacs GUI stuff. - (bbdb-set-extent-property extent 'priority 3) - (if face (bbdb-hack-x-face face extent)) - (goto-char start) - (setq s start) - (setq property (cadr (member 'bbdb-field (text-properties-at s)))) - (while (and s (< s end)) - (setq e (or (next-single-property-change (1+ s) 'bbdb-field) - (point-max))) - (cond ((equal property '(name)) - (setq extent (bbdb-make-extent s e)) - (bbdb-set-extent-property extent 'priority 2) - (bbdb-set-extent-property extent 'data 'bbdb) - (bbdb-set-extent-face extent 'bbdb-name)) - ((equal property '(company)) - (setq extent (bbdb-make-extent s e)) - (bbdb-set-extent-property extent 'priority 2) - (bbdb-set-extent-property extent 'data 'bbdb) - (bbdb-set-extent-face extent 'bbdb-company)) - ((member 'field-name property) - (goto-char s) - (setq extent (bbdb-make-extent s e)) - (bbdb-set-extent-property extent 'priority 2) - (bbdb-set-extent-property extent 'data 'bbdb) - (bbdb-set-extent-face extent 'bbdb-field-name)) - (t - (setq extent (bbdb-make-extent start e)) - (bbdb-set-extent-property extent 'priority 2) - (bbdb-set-extent-property extent 'data 'bbdb) - (bbdb-set-extent-face extent 'bbdb-field-value))) - (setq s e) - (while (and s (null (setq property - (cadr (member 'bbdb-field - (text-properties-at s)))))) - (setq s (next-single-property-change s 'bbdb-field)))) - - (setq rest (cdr rest)) - (if (null (caar rest)) - (setq rest nil)))))) - -;;; share the xface cache data with VM if it's around -(defvar vm-xface-cache (make-vector 29 0)) -(eval-when-compile (defvar highlight-headers-hack-x-face-p)) - -;; In Emacs 21, this could use the x-face support from Gnus. -(defun bbdb-hack-x-face (face extent) - "Process a face property of a record and honour it. -Not done for GNU Emacs just yet, since it doesn't have image support -as of GNU Emacs 20.7" - (if (not (or (and (fboundp 'highlight-headers-hack-x-face-p) - (symbol-value (intern ;; compiler - "highlight-headers-hack-x-face-p"))) ;; ick. - (and (featurep 'xemacs) - (string-match "^21\\." emacs-version)))) ;; XXX - () ;; nothing doing - (setq face (bbdb-split face "\n")) - (while face - (cond - - ;; ripped pretty much verbatim from VM; X Faces for recent XEmacsen. - ((string-match "^21\\." emacs-version) ;; XXX how far back can I go? - (condition-case nil - (let* ((h (concat "X-Face: " (car face))) ;; from vm-display-xface - (g (intern h vm-xface-cache))) - (if (bbdb-find-face 'vm-xface) ;; use the same face as VM - nil - (make-face 'vm-xface) - (set-face-background 'vm-xface "white") - (set-face-foreground 'vm-xface "black")) - (if (boundp g) - (setq g (symbol-value g)) - (set g (bbdb-make-glyph - (list - (vector 'xface ':data h)))) ;; XXX use API - (setq g (symbol-value g)) - (bbdb-set-glyph-face g 'vm-xface)) - (bbdb-set-extent-property extent 'vm-xface t) - (bbdb-set-extent-begin-glyph extent g)) - (error nil))) ;; looks like you don't have xface support, d00d - - ;; requires lemacs 19.10 version of highlight-headers.el - ((fboundp 'highlight-headers-x-face) ; the 19.10 way - (bbdb-highlight-headers-x-face (car face) extent) - (let ((b (bbdb-extent-property extent 'begin-glyph))) - (cond (b ; I'd like this to be an end-glyph instead - (bbdb-set-extent-property extent 'begin-glyph nil) - (bbdb-set-extent-property extent 'end-glyph b))))) - - ((fboundp 'highlight-headers-x-face-to-pixmap) ; the 19.13 way - (save-excursion - (set-buffer (get-buffer-create " *tmp*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert (car face)) - (bbdb-set-extent-begin-glyph extent nil) - (bbdb-set-extent-end-glyph extent - (bbdb-highlight-headers-x-face-to-pixmap - (point-min) (point-max))) - (erase-buffer)))) - - ;; more faces? - (setq face (cdr face)) - (cond (face ; there are more, so clone the extent - (setq extent (bbdb-make-extent - (bbdb-extent-start-position extent) - (bbdb-extent-end-position extent))) - (bbdb-set-extent-property extent 'data 'bbdb)))))) - - -(defcustom bbdb-user-menu-commands nil - "User defined menu entries which should be appended to the BBDB menu. -This should be a list of menu entries. -When set to a fucntion the function gets called with two arguments the -RECORD and the FIELD and it should either return nil or a list of menu -entries." - :group 'bbdb-database - :type 'sexp) - -(defun build-bbdb-finger-menu (record) - (let ((addrs (bbdb-record-finger-host record))) - (if (cdr addrs) - (cons "Finger..." - (nconc - (mapcar (lambda (addr) - (vector addr (list 'bbdb-finger record addr) - t)) - addrs) - (list "----" - (vector "Finger all addresses" - (list 'bbdb-finger record ''(4)) t)))) - (vector (concat "Finger " (car addrs)) - (list 'bbdb-finger record (car addrs)) t)))) - -(defun build-bbdb-sendmail-menu (record) - (let ((addrs (bbdb-record-net record))) - (if (cdr addrs) - (cons "Send Mail..." - (mapcar (lambda (addr) - (vector addr (list 'bbdb-send-mail-internal - (bbdb-dwim-net-address record addr)) - t)) - addrs)) - (vector (concat "Send mail to " (car addrs)) - (list 'bbdb-send-mail-internal - (bbdb-dwim-net-address record (car addrs))) - t)))) - - -(defun build-bbdb-field-menu (record field) - (let ((type (car field))) - (nconc - (list - (concat "Commands for " - (cond ((eq type 'property) - (concat "\"" - (symbol-name (if (consp (car (cdr field))) - (car (car (cdr field))) - (car (cdr field)))) - "\" field:")) - ((eq type 'name) "Name field:") - ((eq type 'company) "Company field:") - ((eq type 'net) "Network Addresses field:") - ((eq type 'aka) "Alternate Names field:") - (t - (concat "\"" (aref (nth 1 field) 0) "\" " - (capitalize (symbol-name type)) " field:")))) - "-----" - ["Edit Field" bbdb-edit-current-field t] - ) - (if (memq type '(name company)) - nil - (list ["Delete Field" bbdb-delete-current-field-or-record t])) - (cond ((eq type 'phone) - (list (vector (concat "Dial " (bbdb-phone-string (car (cdr field)))) - (list 'bbdb-dial (list 'quote field) nil) t))) - ) - ))) - - -(defun build-bbdb-insert-field-menu (record) - (cons "Insert New Field..." - (mapcar - (lambda (field) - (let ((type (if (string= (car field) "AKA") - 'aka - (intern (car field))))) - (vector (car field) - (list 'bbdb-insert-new-field - record - (list 'quote type) - (list 'bbdb-prompt-for-new-field-value - (list 'quote type))) - (not - (or (and (eq type 'net) (bbdb-record-net record)) - (and (eq type 'aka) (bbdb-record-aka record)) - (and (eq type 'notes) (bbdb-record-notes record)) - (and (consp (bbdb-record-raw-notes record)) - (assq type (bbdb-record-raw-notes record)))))))) - (append '(("phone") ("address") ("net") ("AKA") ("notes")) - (bbdb-propnames))))) - - -(defun build-bbdb-menu (record field) - (delete - nil - (append - '("bbdb-menu" "Global BBDB Commands" "-----") - (list - ["Save BBDB" bbdb-save-db t] - ["Toggle All Records Display Layout" - bbdb-toggle-all-records-display-layout t] - ["Finger All Records" (bbdb-finger (mapcar 'car bbdb-records)) t] - ["BBDB Manual" bbdb-info t] - ["BBDB Quit" bbdb-bury-buffer t]) - (if record - (list - "-----" - (concat "Commands for record \"" - (bbdb-record-name record) "\":") - "-----" - (vector "Delete Record" - (list 'bbdb-delete-current-record record) t) - ["Toggle Records Display Layout" bbdb-toggle-records-display-layout t] - (if (and (not (eq 'full-multi-line - (nth 1 (assq record bbdb-records)))) - (bbdb-display-layout-get-option 'multi-line 'omit)) - ["Fully Display Record" bbdb-display-record-completely t]) - ["Omit Record" bbdb-omit-record t] - ["Refile (Merge) Record" bbdb-refile-record t] - )) - (if record - (list (build-bbdb-finger-menu record))) - (if (bbdb-record-net record) - (list (build-bbdb-sendmail-menu record))) - (if record - (list (build-bbdb-insert-field-menu record))) - (if field - (cons "-----" (build-bbdb-field-menu record field))) - (if bbdb-user-menu-commands - (let ((menu (if (functionp bbdb-user-menu-commands) - (funcall bbdb-user-menu-commands record field) - bbdb-user-menu-commands))) - (if menu - (append ["-----"] - ["User Defined Commands"] - ["-----"] - menu))))))) - -(eval-and-compile - (if (fboundp 'popup-menu) - (progn - (fset 'bbdb-popup 'popup-menu) - (fset 'bbdb-desc-to-menu 'identity)) - ;; This is really, REALLY ugly, but it saves me some coding and uses - ;; the correct keymap API instead of carnal knowledge of keymap - ;; structure. - (defun bbdb-desc-to-menu(desc) - (let ((map (make-sparse-keymap (car desc))) - (desc (reverse (cdr desc))) ;; throw away header, reorient list - (txtcount 0) elt elt-name) - (while (setq elt (car desc)) - ;; fake a key binding name - (setq elt-name (intern (format "fake%d" txtcount)) - txtcount (+ 1 txtcount)) - (cond - ;; non-active entries in the menu - ((stringp elt) - (define-key map (vector elt-name) (list elt))) - - ;; active entries in the menu - ((vectorp elt) - (define-key map (vector elt-name) (cons (aref elt 0) (aref elt 1)))) - - ;; submenus - ((listp elt) - (define-key map (vector elt-name) - (cons (car elt) (bbdb-desc-to-menu elt)))) - ) - (setq desc (cdr desc))) - map)) - ;; this does the actual popping up & parsing nonsense - (defun bbdb-popup( desc &optional event ) - (let ((map (bbdb-desc-to-menu desc)) result) - (setq result (x-popup-menu t map)) - (if result - (let ((command (lookup-key map (vconcat result)))) - ;; Clear out echoing, which perhaps shows a prefix arg. - (message "") - (if command - (if (commandp command) - (command-execute command) - (funcall 'eval command))))))))) - -;;;###autoload -(defun bbdb-menu (event) - (interactive "e") - (mouse-set-point event) - (bbdb-popup - (save-window-excursion - (save-excursion - (let ((extent (or (bbdb-extent-at (point) (current-buffer) 'highlight) - (error ""))) - record field) - (or (eq (bbdb-extent-property extent 'data) 'bbdb) - (error "not a bbdb extent")) - (bbdb-highlight-extent extent t) - (setq record (bbdb-current-record) - field (get-text-property (point) 'bbdb-field)) - (build-bbdb-menu record field)))))) - -;; tell everyone else we're here. -(provide 'bbdb-gui) diff --git a/xemacs-packages/lisp/bbdb/bbdb-hooks.el b/xemacs-packages/lisp/bbdb/bbdb-hooks.el deleted file mode 100644 index 23738b0a..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-hooks.el +++ /dev/null @@ -1,710 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; Various additional functionality for the BBDB. See bbdb.texinfo. - -;;; The Insidious Big Brother Database 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. -;;; -;;; BBDB is distributed in the hope that it will be useful, but WITHOUT ANY -;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more -;;; details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; This file lets you do stuff like -;;; -;;; o automatically update a "timestamp" field each time a record is -;;; modified -;;; o automatically add some string to the notes field(s) based on the -;;; contents of header fields of the current message -;;; o only automatically create entries when certain header fields -;;; are matched -;;; o don't automatically create entries when certain header fields -;;; are matched -;;; -;;; Read the docstrings; read the texinfo file. - -;; -;; $Id: bbdb-hooks.el,v 1.6 2005/07/24 15:22:57 waider Exp $ -;; - -(require 'bbdb) -(require 'bbdb-com) - -(eval-when-compile - (condition-case() - (progn - (require 'gnus) - (require 'bbdb-gnus)) - (error nil)) - (condition-case() - (progn - (require 'vm) - (require 'bbdb-vm)) - (error nil)) - (autoload 'mh-show "mh-e") - (condition-case() - (require 'bbdb-rmail) - (error nil))) - -(defvar rmail-buffer) -(defvar mh-show-buffer) - - -(defvar bbdb-time-internal-format "%Y-%m-%d" - "The internal date format.") - -;;;###autoload -(defun bbdb-timestamp-hook (record) - "For use as a `bbdb-change-hook'; maintains a notes-field called `timestamp' -for the given record which contains the time when it was last modified. If -there is such a field there already, it is changed, otherwise it is added." - (bbdb-record-putprop record 'timestamp (format-time-string - bbdb-time-internal-format - (current-time)))) - -;;;###autoload -(defun bbdb-creation-date-hook (record) - "For use as a `bbdb-create-hook'; adds a notes-field called `creation-date' -which is the current time string." - ;; hey buddy, we've known about your antics since the eighties... - (bbdb-record-putprop record 'creation-date (format-time-string - bbdb-time-internal-format - (current-time)))) - - -;;; Determining whether to create a record based on the content of the -;;; current message. - -(eval-when-compile - (defvar vm-mail-buffer) - (defvar vm-message-pointer) - (autoload 'vm-start-of "vm") - (autoload 'bbdb/vm-pop-up-bbdb-buffer "bbdb-vm")) - -;;;###autoload -(defun bbdb-header-start () - "Returns a marker at the beginning of the header block of the current -message. This will not necessarily be in the current buffer." - (cond ((memq major-mode - '(gnus-group-mode gnus-summary-mode gnus-article-mode)) - (set-buffer (or gnus-original-article-buffer - gnus-article-buffer)) - (point-min-marker)) - ((memq major-mode '(vm-presentation-mode vm-mode vm-summary-mode)) - (if vm-mail-buffer (set-buffer vm-mail-buffer)) - (vm-start-of (car vm-message-pointer))) - ((memq major-mode '(rmail-mode rmail-summary-mode)) - (if (and (boundp 'rmail-buffer) rmail-buffer) - (set-buffer rmail-buffer)) - (point-min-marker)) - ;; MH-E clause added by knabe. - ((eq major-mode 'mh-folder-mode) - (mh-show) - (set-buffer mh-show-buffer) - (point-min-marker)) - (t (point-min-marker)) - )) - - -;;;###autoload -(defun bbdb-extract-field-value (field-name) - "Given the name of a field (like \"Subject\") this returns the value of -that field in the current message, or nil. This works whether you're in -GNUS, Rmail, or VM. This works on multi-line fields, but if more than -one field of the same name is present, only the last is returned. It is -expected that the current buffer has a message in it, and (point) is at the -beginning of the message headers." - ;; we can't special-case VM here to use its cache, because the cache has - ;; divided real-names from addresses; the actual From: and Subject: fields - ;; exist only in the message. - (save-excursion - (if (memq major-mode - '(gnus-summary-mode gnus-article-mode gnus-tree-mode)) - (progn - (set-buffer (get-buffer gnus-original-article-buffer)) - (goto-char (point-min)))) - (setq field-name (concat (regexp-quote field-name) "[ \t]*:[ \t]*")) - (let ((case-fold-search t) - done) - (while (not (or done - (looking-at "\n") ; we're at BOL - (eobp))) - (if (looking-at field-name) - (progn - (goto-char (match-end 0)) - (setq done (buffer-substring (point) - (progn (end-of-line) (point)))) - (while (looking-at "\n[ \t]") - (setq done (concat done " " - (buffer-substring (match-end 0) - (progn (end-of-line 2) (point)))))))) - (forward-line 1)) - done))) - -(defcustom bbdb-ignore-most-messages-alist '() - "*An alist describing which messages to automatically create BBDB -records for. This only works if bbdb/news-auto-create-p or -bbdb/mail-auto-create-p (or both) is 'bbdb-ignore-most-messages-hook. -The format of this alist is - (( HEADER-NAME . REGEXP ) ... ) -for example, - ((\"From\" . \"@.*\\.maximegalon\\.edu\") - (\"Subject\" . \"time travel\")) -will cause BBDB entries to be made only for messages sent by people at -Maximegalon U., or (that's *or*) people posting about time travel. - -See also bbdb-ignore-some-messages-alist, which has the opposite effect." - :group 'bbdb-noticing-records - :type '(repeat (cons - (string :tag "Header name") - (regexp :tag "Regex to match on header value")))) - - -(defcustom bbdb-ignore-some-messages-alist '() - "*An alist describing which messages *not* to automatically create -BBDB records for. This only works if bbdb/news-auto-create-p or -bbdb/mail-auto-create-p (or both) is 'bbdb-ignore-some-messages-hook. -The format of this alist is - (( HEADER-NAME . REGEXP ) ... ) -for example, - ((\"From\" . \"mailer-daemon\") - (\"To\" . \"mailing-list-1\\\\|mailing-list-2\") - (\"CC\" . \"mailing-list-1\\\\|mailing-list-2\")) -will cause BBDB entries to not be made for messages from any mailer daemon, -or messages sent to or CCed to either of two mailing lists. - -See also bbdb-ignore-most-messages-alist, which has the opposite effect." - :group 'bbdb-noticing-records - :type '(repeat (cons - (string :tag "Header name") - (regexp :tag "Regex to match on header value")))) - - -;;;###autoload -(defun bbdb-ignore-most-messages-hook (&optional invert-sense) - "For use as the value of bbdb/news-auto-create-p or bbdb/mail-auto-create-p. -This will automatically create BBDB entries for messages which match -the bbdb-ignore-most-messages-alist (which see) and *no* others." - ;; don't need to optimize this to check the cache, because if - ;; bbdb/*-update-record uses the cache, this won't be called. - (let ((rest (if invert-sense - bbdb-ignore-some-messages-alist - bbdb-ignore-most-messages-alist)) - (case-fold-search t) - (done nil) - (b (current-buffer)) - (marker (bbdb-header-start)) - field regexp fieldval) - (set-buffer (marker-buffer marker)) - (save-restriction - (widen) - (while (and rest (not done)) - (goto-char marker) - (setq field (car (car rest)) - regexp (cdr (car rest)) - fieldval (bbdb-extract-field-value field)) - (if (and fieldval (string-match regexp fieldval)) - (setq done t)) - (setq rest (cdr rest)))) - (set-buffer b) - (if invert-sense - (not done) - done))) - -;;; Provided by Bill Carpenter. -(defvar bbdb-ignore-selected-messages-confirmation nil - "*If bbdb-ignore-selected-messages-hook is used as an auto-create-hook, this -variable governs whether you are prompted for creation of BBDB entries.") - -;;;###autoload -(defun bbdb-ignore-selected-messages-hook () - "For use as a bbdb/news-auto-create-hook or bbdb/mail-auto-create-hook. -This will automatically create BBDB entries for messages based on a -combination of bbdb-ignore-some-messages-alist and -bbdb-ignore-most-messages-alist. It first looks at the SOME list. If -that doesn't disqualify a message, then it looks at the MOST list. If -that qualifies the message, the record is auto-created, but a -confirmation is conditionally sought, based on the value of -`bbdb-ignore-selected-messages-confirmation'." - (if (bbdb-ignore-some-messages-hook) - ;; wasn't ruled out - (if (bbdb-ignore-most-messages-hook) - ;; was ruled in - (if bbdb-ignore-selected-messages-confirmation - (let ((case-fold-search t) - (marker (bbdb-header-start)) - record-exists from) - (save-excursion - (set-buffer (marker-buffer marker)) - (save-restriction - (widen) - (goto-char marker) - (setq from (bbdb-extract-field-value "FROM")))) - (setq record-exists (bbdb-annotate-message-sender from)) - (or record-exists - (y-or-n-p (concat "Create BBDB record from " from "? ")))) - ;; no confirmation desired so let it be - t) - nil) - nil)) - -;;;###autoload -(defun bbdb-ignore-some-messages-hook () - "For use as a `bbdb/news-auto-create-hook' or `bbdb/mail-auto-create-hook'. -This will automatically create BBDB entries for messages which do *not* -match the `bbdb-ignore-some-messages-alist' (which see)." - (bbdb-ignore-most-messages-hook t)) - - -;;; Automatically add to the notes field based on the current message. - -(defcustom bbdb-auto-notes-alist nil - "*An alist which lets you have certain pieces of text automatically added -to the BBDB record representing the sender of the current message based on -the subject or other header fields. This only works if `bbdb-notice-hook' -contains `bbdb-auto-notes-hook'. The format of this alist is - - ((HEADER-NAME [ADDRESS-CLASS-LIST] - (REGEXP . STRING) ... ) - ... ) -for example, - ((\"To\" (\"-vm@\" . \"VM mailing list\")) - (\"Subject\" (\"sprocket\" . \"mail about sprockets\") - (\"you bonehead\" . \"called me a bonehead\"))) - -will cause the text \"VM mailing list\" to be added to the notes field of -the record corresponding to anyone you get mail from via one of the VM -mailing lists. If, that is, `bbdb/mail-auto-create-p' is set such that the -record would have been created, or the record already existed. - -A ADDRESS-CLASS-LIST is optional and by default actions will be performed only -for records of authors of a message. However, by giving an list of classes -specified in `bbdb-get-addresses-headers'. Actions will then only be -performed if the currently processed email is of a class listed in -ADDRESS-CLASS-LIST. ADDRESS-CLASS-LIST might also be an alist with elements -of the form (CLASS . HEADER) which allows actions only when the current -address matches one of the elemets. - -The format of elements of this list may also be - (REGEXP FIELD-NAME STRING) -or - (REGEXP FIELD-NAME STRING REPLACE-P) -instead of - (REGEXP . STRING) - -meaning add the given string to the named field. The field-name may not -be name, address, phone, or net (builtin fields) but must be either ``notes,'' -``company,'' or the name of a user-defined note-field. - (\"pattern\" . \"string to add\") -is equivalent to - (\"pattern\" notes \"string to add\") - -STRING can contain \\& or \\N escapes like in function -`replace-match'. For example, to automatically add the contents of the -\"organization\" field of a message to the \"company\" field of a BBDB -record, you can use this: - - (\"Organization\" (\".*\" company \"\\\\&\")) - -\(Note you need two \\ to get a single \\ into a lisp string literal.\) - -If STRING is an integer N, the N'th matching subexpression is used, so -the above example could be written more efficiently as - - (\"Organization\" (\".*\" company 0)) - -If STRING is neither a string or an integer, it should be a function, which -will be called with the contents of the field. The result of that function -call is used as the field value (the returned value must be a string.) - -If REPLACE-P is t, the string replaces the old contents instead of -being appended to it. - -If multiple clauses match the message, all of the corresponding strings -will be added. - -This works for news as well. You might want to arrange for this to have -a different value when in mail as when in news. - -See also variables `bbdb-auto-notes-ignore' and `bbdb-auto-notes-ignore-all'." - :group 'bbdb-noticing-records - :type '(repeat - (bbdb-alist-with-header - (string :tag "Header name") - (repeat (choice - (cons :tag "Address Class" - (repeat (choice - (const authors) - (const recipients)))) - (cons :tag "Value Pair" - (regexp :tag "Regexp to match on header value") - (string :tag "String for notes if regexp matches")) - (list :tag "Replacement list" - (regexp :tag "Regexp to match on header value") - (choice :tag "Record field" - (const notes :tag "Notes") - (const company :tag "Company") - (symbol :tag "Other")) - (choice :tag "Regexp match" - (string :tag "Replacement string") - (integer :tag "Subexpression match") - (function :tag "Callback Function")) - (choice :tag "Replace previous contents" - (const :tag "No" nil) - (const :tag "Yes" t)))))))) - -(defcustom bbdb-auto-notes-ignore nil - "Alist of headers and regexps to ignore in `bbdb-auto-notes-hook'. -Each element looks like - - (HEADER . REGEXP) - -For example, - - (\"Organization\" . \"^Gatewayed from\\\\\|^Source only\") - -would exclude the phony `Organization:' headers in GNU mailing-lists -gatewayed to gnu.* newsgroups. Note that this exclusion applies only -to a single field, not to the entire message. For that, use the variable -`bbdb-auto-notes-ignore-all'." - :group 'bbdb-noticing-records - :type '(repeat (cons - (string :tag "Header name") - (regexp :tag "Regexp to match on header value")))) - -(defcustom bbdb-auto-notes-ignore-all nil - "Alist of headers and regexps which cause the entire message to be ignored -in `bbdb-auto-notes-hook'. Each element looks like - - (HEADER . REGEXP) - -For example, - - (\"From\" . \"BLAT\\\\.COM\") - -would exclude any notes recording for message coming from BLAT.COM. -Note that this is different from `bbdb-auto-notes-ignore', which applies -only to a particular header field, rather than the entire message." - :group 'bbdb-noticing-records - :type '(repeat (cons - (string :tag "Header name") - (regexp :tag "Regexp to match on header value")))) - - -;;;###autoload -(defun bbdb-auto-notes-hook (record) - "For use as a `bbdb-notice-hook'. This might automatically add some text -to the notes field of the BBDB record corresponding to the current record -based on the header of the current message. See the documentation for -the variables `bbdb-auto-notes-alist' and `bbdb-auto-notes-ignore'." - ;; This could stand to be faster... - ;; could optimize this to check the cache, and noop if this record is - ;; cached for any other message, but that's probably not the right thing. - (unless bbdb-readonly-p - (let ((rest bbdb-auto-notes-alist) - (ignore-all bbdb-auto-notes-ignore-all) - (case-fold-search t) - (b (current-buffer)) - (marker (bbdb-header-start)) - ignore - field pairs fieldval ; do all bindings here for speed - regexp string notes-field-name notes - replace-p) - (set-buffer (marker-buffer marker)) - (save-restriction - (widen) - (goto-char marker) - (if (and (setq fieldval (bbdb-extract-field-value "From")) - (string-match (bbdb-user-mail-names) fieldval)) - ;; Don't do anything if this message is from us. Note that we have - ;; to look at the message instead of the record, because the record - ;; will be of the recipient of the message if it is from us. - nil - ;; check the ignore-all pattern - (while (and ignore-all (not ignore)) - (goto-char marker) - (setq field (car (car ignore-all)) - regexp (cdr (car ignore-all)) - fieldval (bbdb-extract-field-value field)) - (if (and fieldval - (string-match regexp fieldval)) - (setq ignore t) - (setq ignore-all (cdr ignore-all)))) - - (unless ignore ; ignore-all matched - (while rest ; while there are still clauses in the auto-notes alist - (goto-char marker) - (setq field (car (car rest)) ; name of header, e.g., "Subject" - pairs (cdr (car rest)) ; (REGEXP . STRING) or - ; (REGEXP FIELD-NAME STRING) or - ; (REGEXP FIELD-NAME STRING REPLACE-P) - fieldval (bbdb-extract-field-value field)) ; e.g., Subject line - (when fieldval - ;; we perform the auto notes stuff only for authors of a message - ;; or if explicitly requested - (if (or (symbolp (caar pairs)) (listp (caar pairs))) - (if (or (memq bbdb-update-address-class (car pairs)) - (and (assoc bbdb-update-address-class (car pairs)) - (string= bbdb-update-address-header - (cdr (assoc bbdb-update-address-class - (car pairs)))))) - (setq pairs (cdr pairs)) - (setq pairs nil)) - (if (not (and (eq 'authors bbdb-update-address-class) - (string-match "From" bbdb-update-address-header))) - (setq pairs nil))) - - ;; now handle the remaining pairs - (while pairs - (setq regexp (car (car pairs)) - string (cdr (car pairs))) - (if (consp string) ; not just the (REGEXP . STRING) format - (setq notes-field-name (car string) - replace-p (nth 2 string) ; perhaps nil - string (nth 1 string)) - ;; else it's simple (REGEXP . STRING) - (setq notes-field-name 'notes - replace-p nil)) - (setq notes (bbdb-record-getprop record notes-field-name)) - (let ((did-match - (and (string-match regexp fieldval) - ;; make sure it is not to be ignored - (let ((re (cdr (assoc field - bbdb-auto-notes-ignore)))) - (if re - (not (string-match re fieldval)) - t))))) - ;; An integer as STRING is an index into match-data: - ;; A function as STRING calls the function on fieldval: - (if did-match - (setq string - (cond ((integerp string) ; backward compat - (substring fieldval - (match-beginning string) - (match-end string))) - ((stringp string) - (bbdb-auto-expand-newtext fieldval string)) - (t - (goto-char marker) - (let ((s (funcall string fieldval))) - (or (stringp s) - (null s) - (error "%s returned %s: not a string" - string s)) - s))))) - ;; need expanded version of STRING here: - (if (and did-match - string ; A function as STRING may return nil - (not (and notes - ;; check that STRING is not already - ;; present in the NOTES field - (string-match - (regexp-quote string) - notes)))) - (if replace-p - ;; replace old contents of field with STRING - (progn - (when (not bbdb-silent-running) - (if (eq notes-field-name 'notes) - (message "Replacing with note \"%s\"" string) - (message "Replacing field \"%s\" with \"%s\"" - notes-field-name string))) - (bbdb-record-putprop record notes-field-name string) - (bbdb-maybe-update-display record)) - ;; add STRING to old contents, don't replace - (when (not bbdb-silent-running) - (if (eq notes-field-name 'notes) - (message "Adding note \"%s\"" string) - (message "Adding \"%s\" to field \"%s\"" - string notes-field-name))) - (bbdb-annotate-notes record string notes-field-name)))) - (setq pairs (cdr pairs)))) - (setq rest (cdr rest)))))) - (set-buffer b)))) - -(defun bbdb-auto-expand-newtext (string newtext) - ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT. - ;; Note that in Emacs 18 match data are clipped to current buffer - ;; size...so the buffer had better not be smaller than STRING (arrrrggggh!!) - (let ((pos 0) - (len (length newtext)) - (expanded-newtext "")) - (while (< pos len) - (setq expanded-newtext - (concat expanded-newtext - (let ((c (aref newtext pos))) - (if (= ?\\ c) - (cond ((= ?\& (setq c (aref newtext - (setq pos (1+ pos))))) - (substring string - (match-beginning 0) - (match-end 0))) - ((and (>= c ?1) - (<= c ?9)) - ;; return empty string if N'th - ;; sub-regexp did not match: - (let ((n (- c ?0))) - (if (match-beginning n) - (substring string - (match-beginning n) - (match-end n)) - ""))) - (t (char-to-string c))) - (char-to-string c))))) - (setq pos (1+ pos))) - expanded-newtext)) - - -;;; I use this as the value of bbdb-canonicalize-net-hook; it is provided -;;; as an example for you to customize. - -(defcustom bbdb-canonical-hosts - (mapconcat 'regexp-quote - '("cs.cmu.edu" "ri.cmu.edu" "edrc.cmu.edu" "andrew.cmu.edu" - "mcom.com" "netscape.com" "cenatls.cena.dgac.fr" - "cenaath.cena.dgac.fr" "irit.fr" "enseeiht.fr" "inria.fr" - "cs.uiuc.edu" "xemacs.org") - "\\|") - "Certain sites have a single mail-host; for example, all mail originating -at hosts whose names end in \".cs.cmu.edu\" can (and probably should) be -addressed to \"user@cs.cmu.edu\" instead. This variable lists other hosts -which behave the same way." - :group 'bbdb - :type '(regexp :tag "Regexp matching sites")) - -(defmacro bbdb-match-substring (string match) - (list 'substring string - (list 'match-beginning match) (list 'match-end match))) - -;;;###autoload -(defun sample-bbdb-canonicalize-net-hook (addr) - (cond - ;; - ;; rewrite mail-drop hosts. - ;; - ((string-match - (concat "\\`\\([^@%!]+@\\).*\\.\\(" bbdb-canonical-hosts "\\)\\'") - addr) - (concat (bbdb-match-substring addr 1) (bbdb-match-substring addr 2))) - ;; - ;; Here at Lucid, our workstation names sometimes get into our email - ;; addresses in the form "jwz%thalidomide@lucid.com" (instead of simply - ;; "jwz@lucid.com"). This removes the workstation name. - ;; - ((string-match "\\`\\([^@%!]+\\)%[^@%!.]+@\\(lucid\\.com\\)\\'" addr) - (concat (bbdb-match-substring addr 1) "@" (bbdb-match-substring addr 2))) - ;; - ;; Another way that our local mailer is misconfigured: sometimes addresses - ;; which should look like "user@some.outside.host" end up looking like - ;; "user%some.outside.host" or even "user%some.outside.host@lucid.com" - ;; instead. This rule rewrites it into the original form. - ;; - ((string-match "\\`\\([^@%]+\\)%\\([^@%!]+\\)\\(@lucid\\.com\\)?\\'" addr) - (concat (bbdb-match-substring addr 1) "@" (bbdb-match-substring addr 2))) - ;; - ;; Sometimes I see addresses like "foobar.com!user@foobar.com". - ;; That's totally redundant, so this rewrites it as "user@foobar.com". - ;; - ((string-match "\\`\\([^@%!]+\\)!\\([^@%!]+[@%]\\1\\)\\'" addr) - (bbdb-match-substring addr 2)) - ;; - ;; Sometimes I see addresses like "foobar.com!user". Turn it around. - ;; - ((string-match "\\`\\([^@%!.]+\\.[^@%!]+\\)!\\([^@%]+\\)\\'" addr) - (concat (bbdb-match-substring addr 2) "@" (bbdb-match-substring addr 1))) - ;; - ;; The mailer at hplb.hpl.hp.com tends to puke all over addresses which - ;; pass through mailing lists which are maintained there: it turns normal - ;; addresses like "user@foo.com" into "user%foo.com@hplb.hpl.hp.com". - ;; This reverses it. (I actually could have combined this rule with - ;; the similar lucid.com rule above, but then the regexp would have been - ;; more than 80 characters long...) - ;; - ((string-match "\\`\\([^@!]+\\)%\\([^@%!]+\\)@hplb\\.hpl\\.hp\\.com\\'" - addr) - (concat (bbdb-match-substring addr 1) "@" (bbdb-match-substring addr 2))) - ;; - ;; Another local mail-configuration botch: sometimes mail shows up - ;; with addresses like "user@workstation", where "workstation" is a - ;; local machine name. That should really be "user" or "user@netscape.com". - ;; (I'm told this one is due to a bug in SunOS 4.1.1 sendmail.) - ;; - ((string-match "\\`\\([^@%!]+\\)[@%][^@%!.]+\\'" addr) - (bbdb-match-substring addr 1)) - ;; - ;; Sometimes I see addrs like "foo%somewhere%uunet.uu.net@somewhere.else". - ;; This is silly, because I know that I can send mail to uunet directly. - ;; - ((string-match ".%uunet\\.uu\\.net@[^@%!]+\\'" addr) - (concat (substring addr 0 (+ (match-beginning 0) 1)) "@UUNET.UU.NET")) - ;; - ;; Otherwise, leave it as it is. Returning a string EQ to the one passed - ;; in tells BBDB that we're done. - ;; - (t addr))) - - -;;; Here's another approach; sometimes one gets mail from foo@bar.baz.com, -;;; and then later gets mail from foo@baz.com. At this point, one would -;;; like to delete the bar.baz.com address, since the baz.com address is -;;; obviously superior. See also var `bbdb-canonicalize-redundant-nets-p'. -;;; -;;; Turn this on with -;;; (add-hook 'bbdb-change-hook 'bbdb-delete-redundant-nets) - -(defun bbdb-delete-redundant-nets (record) - "Deletes redundant network addresses. -For use as a value of `bbdb-change-hook'. See `bbdb-net-redundant-p'." - (let* ((nets (bbdb-record-net record)) - (rest nets) - net new redundant) - (while rest - (setq net (car rest)) - (if (bbdb-net-redundant-p net nets) - (setq redundant (cons net redundant)) - (setq new (cons net new))) - (setq rest (cdr rest))) - (cond (redundant - (message "Deleting redundant nets %s..." - (mapconcat 'identity (nreverse redundant) ", ")) - (setq new (nreverse new)) - (bbdb-record-set-net record new) - t)))) - - - -;;;###autoload -(defun bbdb-force-record-create () - "Force automatic creation of a BBDB records for the current message. -You might add this to the reply hook of your MUA in order to automatically -get records added for those people you reply to." - (interactive) - (let ((bbdb/mail-auto-create-p t) - (bbdb/news-auto-create-p t) - (bbdb-message-caching-enabled nil) - (bbdb/gnus-update-records-mode 'annotating) - (bbdb/rmail-update-records-mode 'annotating) - (bbdb/mhe-update-records-mode 'annotating) - (bbdb/vm-update-records-mode 'annotating)) - (save-excursion - (cond ((member major-mode '(vm-mode vm-virtual-mode vm-summary-mode - vm-presentation-mode)) - (bbdb/vm-pop-up-bbdb-buffer)) - ((member major-mode '(gnus-summary-mode gnus-article-mode - gnus-tree-mode)) - (bbdb/gnus-pop-up-bbdb-buffer)) - ((member major-mode '(rmail-mode rmail-summary-mode)) - (bbdb/rmail-pop-up-bbdb-buffer)) - ((member major-mode '(mhe-mode mhe-summary-mode mh-folder-mode)) - (bbdb/mh-pop-up-bbdb-buffer)) - )))) - -(provide 'bbdb-hooks) diff --git a/xemacs-packages/lisp/bbdb/bbdb-merge.el b/xemacs-packages/lisp/bbdb/bbdb-merge.el deleted file mode 100644 index bfb042bb..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-merge.el +++ /dev/null @@ -1,261 +0,0 @@ -;;; BBDB merge/sync framework -;;; GNU Public License to go here. This file is under GPL, thanks guys. -;;; Copyright (c) 2000 Waider - -(require 'bbdb) -(require 'bbdb-com) - -;;; to do: -;;; smarter phone, notes and address merging. - -;;;###autoload -(defun bbdb-merge-record (new-record &optional merge-record override) - "Generic merge function. - -Merges new-record into your bbdb, using DATE to check who's more -up-to-date and OVERRIDE to decide who gets precedence if two dates -match. DATE can be extracted from a notes if it's an alist with an -element marked timestamp. Set OVERRIDE to 'new to allow the new record -to stomp on existing data, 'old to preserve existing data or nil to -merge both together. If it can't find a record to merge with, it will -create a new record. If MERGE-RECORD is set, it's a record discovered -by other means that should be merged with. - -Returns the Grand Unified Record." - - (let* ((firstname (bbdb-record-firstname new-record)) - (lastname (bbdb-record-lastname new-record)) - (aka (bbdb-record-aka new-record)) - (nets (bbdb-record-net new-record)) - (addrs (bbdb-record-addresses new-record)) - (phones (bbdb-record-phones new-record)) - (company (bbdb-record-company new-record)) - (notes (bbdb-record-raw-notes new-record)) - (name (bbdb-string-trim (concat firstname " " lastname))) - (date (if (listp notes) (cdr (assq 'timestamp notes)) nil)) - olddate) - - ;; for convenience - (if (stringp notes) - (setq notes (list (cons 'notes notes)))) - - ;; See if we have a record that looks right, using an intertwingle - ;; search. Could probably parameterize that. - ;; bbdb-merge-search-function or some such. - (if (null merge-record) - (setq merge-record (bbdb-search-simple name nets))) - - (if merge-record - (progn - ;; if date is unset, set it to the existing record's date. - (setq olddate (bbdb-record-getprop merge-record 'timestamp) - date (or date olddate)) - ;; FIXME if date & olddate are STILL unset, set to today's date. - - ;; if the old record is actually newer, invert the sense of override - (if (string-lessp olddate date) - (setq override (cond ((eq 'old override) 'new) - ((eq 'new override) 'old) - (t nil)))) - - (bbdb-record-set-firstname merge-record - (if (null override) - (bbdb-merge-strings (bbdb-record-firstname merge-record) - firstname " ") - (if (eq 'new override) firstname - (bbdb-record-firstname merge-record)))) - - (bbdb-record-set-lastname merge-record - (if (null override) - (bbdb-merge-strings (bbdb-record-lastname merge-record) - lastname " ") - (if (eq 'new override) lastname - (bbdb-record-lastname merge-record)))) - - (bbdb-record-set-company merge-record - (if (null override) - (bbdb-merge-strings (bbdb-record-company merge-record) - company " ") - (if (eq 'new override) company - (bbdb-record-company merge-record)))) - - (bbdb-record-set-aka - merge-record - (if (null override) - (bbdb-merge-lists! - (bbdb-record-aka merge-record) - (if (listp aka) aka (list aka)) 'string= 'downcase) - (if (eq 'new override) aka - (bbdb-record-aka merge-record)))) - - (bbdb-record-set-net - merge-record - (if (null override) - (bbdb-merge-lists! - (bbdb-record-net merge-record) nets 'string= 'downcase) - (if (eq 'new override) nets - (bbdb-record-net merge-record)))) - - (bbdb-record-set-phones - merge-record - (if (null override) - (bbdb-merge-lists! - (bbdb-record-phones merge-record) phones 'equal) - (if (eq 'new override) phones - (bbdb-record-phones merge-record)))) - - (bbdb-record-set-addresses - merge-record - (if (null override) - (bbdb-merge-lists! - (bbdb-record-addresses merge-record) addrs 'equal) - (if (eq 'new override) addrs - (bbdb-record-addresses merge-record)))) - - ;; lifted from bbdb-com.el - (let ((n1 (bbdb-record-raw-notes merge-record)) - (n2 notes) - tmp - (bbdb-refile-notes-default-merge-function ;; XXX - 'bbdb-merge-strings)) - (or (equal n1 n2) - (progn - (or (listp n1) (setq n1 (list (cons 'notes n1)))) - (or (listp n2) (setq n2 (list (cons 'notes n2)))) - (while n2 - (if (setq tmp (assq (car (car n2)) n1)) - (setcdr tmp - (funcall (or (cdr (assq (car (car n2)) - bbdb-refile-notes-generate-alist)) - bbdb-refile-notes-default-merge-function) - (cdr tmp) (cdr (car n2)))) - (setq n1 (nconc n1 (list (car n2))))) - (setq n2 (cdr n2))) - (bbdb-record-set-raw-notes merge-record n1))))) - - ;; we couldn't find a record, so create one - (setq merge-record - (bbdb-create-internal name company nets addrs phones notes)) - ;; bite me, bbdb-create-internal - (bbdb-record-set-firstname merge-record firstname) - (bbdb-record-set-lastname merge-record lastname)) - - ;; more general bitingness - (if (equal (bbdb-record-firstname merge-record) "") - (bbdb-record-set-firstname merge-record nil)) - (if (equal (bbdb-record-lastname merge-record) "") - (bbdb-record-set-lastname merge-record nil)) - - ;; fix up the in-memory copy. - (bbdb-change-record merge-record t) - (let ((name (bbdb-record-name merge-record)) - (company (bbdb-record-company merge-record))) - (if (> (length name) 0) - (bbdb-remhash (downcase name) merge-record)) - (if (> (length company) 0) - (bbdb-remhash (downcase company) merge-record))) - (bbdb-record-set-namecache merge-record nil) - (if (or (bbdb-record-lastname merge-record) - (bbdb-record-firstname merge-record)) - (bbdb-puthash (downcase (bbdb-record-name merge-record)) merge-record)) - (if (bbdb-record-company merge-record) - (bbdb-puthash (downcase (bbdb-record-company merge-record)) - merge-record)) - (bbdb-with-db-buffer - (if (not (memq merge-record bbdb-changed-records)) - (setq bbdb-changed-records - (cons merge-record bbdb-changed-records)))) - - ;; your record, sir. - merge-record)) - -;; fixme these could be a macros, I guess. -(defun bbdb-instring( s1 s2 ) -;; (and case-fold-search -;; (setq s1 (downcase s1) -;; s2 (downcase s2))) - (catch 'done - (while (>= (length s1) (length s2)) - (if (string= s2 (substring s1 0 (length s2))) - (throw 'done t) - (setq s1 (substring s1 1)))) - (throw 'done nil))) - -(defun bbdb-merge-strings (s1 s2 &optional sep) - "Merge two strings together uniquely. -If s1 doesn't contain s2, return s1+sep+s2." - (cond ((or (null s1) (string-equal s1 "")) s2) - ((or (null s2) (string-equal s2 "")) s1) - (t (if (bbdb-instring s2 s1) s1 - (concat s1 (or sep "") s2))))) - -;;;###autoload -(defun bbdb-merge-file (&optional bbdb-new override match-fun) - "Merge a bbdb file into the in-core bbdb." - (interactive "fMerge bbdb file: ") - (or bbdb-gag-messages - bbdb-silent-running - (message "Merging %s" bbdb-new)) - ;; argh urgle private environment - (let* ((bbdb-live-file bbdb-file) - (bbdb-file bbdb-new) - (bbdb-live-buffer-name bbdb-buffer-name) - (bbdb-buffer-name "*BBDB-merge*") - (bbdb-buffer nil) ;; hack hack - (new-records (bbdb-records)) - (bbdb-buffer nil) ;; hack hack - (bbdb-file bbdb-live-file) - (bbdb-buffer-name bbdb-live-buffer-name) - (bbdb-refile-notes-default-merge-function 'bbdb-merge-strings)) - - ;; merge everything - (mapcar (lambda(rec) - (bbdb-merge-record rec - (and match-fun - (funcall match-fun rec)) - override)) - new-records)) - ;; hack - (setq bbdb-buffer (or (get-file-buffer bbdb-file) nil))) - -(defun bbdb-add-or-update-phone ( record location phone-string ) - "Add or update a phone number in the current record. - -Insert into RECORD phone number for LOCATION consisting of -PHONE-STRING. Will automatically overwrite an existing phone entry for -the same location." - (let* ((phone (make-vector (if bbdb-north-american-phone-numbers-p - bbdb-phone-length - 2) - nil))) - (if (= 2 (length phone)) - (aset phone 1 phone-string) - (let ((newp (bbdb-parse-phone-number phone-string))) - (bbdb-phone-set-area phone (nth 0 newp)) - (bbdb-phone-set-exchange phone (nth 1 newp)) - (bbdb-phone-set-suffix phone (nth 2 newp)) - (bbdb-phone-set-extension phone (or (nth 3 newp) 0)))) - (bbdb-phone-set-location phone location) - - ;; "phone" now contains a suitable record - ;; we need to check if this is already in the phones list - (let ((phones (bbdb-record-phones record)) - phones-list) - (setq phones-list phones) - (while (car phones-list) - (if (string= (bbdb-phone-location (car phones-list)) - location) - (setq phones (delete (car phones-list) phones))) - (setq phones-list (cdr phones-list))) - - - (bbdb-record-set-phones record - (nconc phones (list phone)))) - (bbdb-change-record record nil) - - ;; update display if record is visible - (and (get-buffer-window bbdb-buffer-name) - (bbdb-display-records (list record))) - nil)) - -(provide 'bbdb-merge) diff --git a/xemacs-packages/lisp/bbdb/bbdb-mhe.el b/xemacs-packages/lisp/bbdb/bbdb-mhe.el deleted file mode 100644 index 43226590..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-mhe.el +++ /dev/null @@ -1,227 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991 Todd Kaufmann -;;; Interface to mh-e version 3.7 or later (modeled after bbdb-rmail). -;;; Created 5-Mar-91; -;;; Modified: 28-Jul-94 by Fritz Knabe -;;; Jack Repenning - -;;; The Insidious Big Brother Database is free software; you can redistribute -;;; it and/or modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 1, or (at your -;;; option) any later version. -;;; -;;; BBDB 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. - -;; -;; $Id: bbdb-mhe.el,v 1.5 2005/07/24 15:22:57 waider Exp $ -;; - -(eval-and-compile - (require 'bbdb) - (require 'bbdb-com) - (require 'mail-utils) - ;; We advise several mh-e functions - (require 'mh-e) - (if (fboundp 'mh-version) - (require 'mh-comp)) ; For mh-e 4.x - (require 'advice)) - -(defmacro bbdb/mh-cache-key (message) - "Return a (numeric) key for MESSAGE" - (`(let* ((attrs (file-attributes (, message))) - (status-time (nth 6 attrs)) - (status-time-2 (cdr status-time)) - (inode (nth 10 attrs))) - (logxor (if (integerp inode) ;; if inode is larger than an emacs int, - inode ;; it's returned as a dotted pair - (car inode)) - (car status-time) - ;; We need the following test because XEmacs returns the - ;; status time as a dotted pair, whereas FSF and Epoch - ;; return it as list. - (if (integerp status-time-2) - status-time-2 - (car status-time-2)))))) - -;;;###autoload -(defun bbdb/mh-update-record (&optional offer-to-create) - "Returns the record corresponding to the current MH message, creating or -modifying it as necessary. A record will be created if -bbdb/mail-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and -the user confirms the creation." - (save-excursion - (and mh-show-buffer (set-buffer mh-show-buffer)) - (if bbdb-use-pop-up - (bbdb/mh-pop-up-bbdb-buffer offer-to-create) - (let ((msg (bbdb/mh-cache-key buffer-file-name)) - records record) - (if (eq msg 0) (setq msg nil)) ; 0 could mean trouble; be safe. - (setq records (bbdb-message-cache-lookup msg)) - (if records - (car records) - (let ((from (bbdb/mh-get-field "^From[ \t]*:"))) - (if (or (string= "" from) - (string-match (bbdb-user-mail-names) - (mail-strip-quoted-names from))) - ;; if logged-in user sent this, use recipients. - (progn - (setq from (bbdb/mh-get-field "^To[ \t]*:")) - (if (or (string= "" from) - (string-match (bbdb-user-mail-names) - (mail-strip-quoted-names from))) - (setq from nil)))) - (if from - (setq record - (bbdb-annotate-message-sender - from t - (or (bbdb-invoke-hook-for-value bbdb/mail-auto-create-p) - offer-to-create) - offer-to-create))) - (if (and msg record) (bbdb-encache-message msg (list record))) - ;; return one record - record)))))) - -;;;###autoload -(defun bbdb/mh-annotate-sender (string &optional replace) - "Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message. If REPLACE is non-nil, -replace the existing notes entry (if any)." - (interactive (list (if bbdb-readonly-p - (error "The Insidious Big Brother Database is read-only.") - (read-string "Comments: ")))) - (mh-show) - (let ((b (current-buffer)) - (p (point))) - (set-buffer mh-show-buffer) - (bbdb-annotate-notes (bbdb/mh-update-record t) string 'notes replace) - (set-buffer b) - (goto-char p))) - - -(defun bbdb/mh-edit-notes (&optional arg) - "Edit the notes field or (with a prefix arg) a user-defined field -of the BBDB record corresponding to the sender of this message." - (interactive "P") - (mh-show) - (let ((b (current-buffer)) - (p (point))) - (set-buffer mh-show-buffer) - (let (bbdb-electric-p (record (or (bbdb/mh-update-record t) (error "")))) - (bbdb-display-records (list record)) - (if arg - (bbdb-record-edit-property record nil t) - (bbdb-record-edit-notes record t))) - (set-buffer b) - (goto-char p))) - - -;;;###autoload -(defun bbdb/mh-show-sender () - "Display the contents of the BBDB for the sender of this message. -This buffer will be in bbdb-mode, with associated keybindings." - (interactive) - (mh-show) - (let ((b (current-buffer)) - (p (point))) - (set-buffer mh-show-buffer) - (let ((record (bbdb/mh-update-record t))) - (if record - (bbdb-display-records (list record)) - (error "unperson"))) - (set-buffer b) - (goto-char p))) - - -(defun bbdb/mh-pop-up-bbdb-buffer (&optional offer-to-create) - "Make the *BBDB* buffer be displayed along with the MH window, -displaying the record corresponding to the sender of the current message." - (bbdb-pop-up-bbdb-buffer - (function (lambda (w) - (let ((b (current-buffer))) - (set-buffer (window-buffer w)) - (prog1 (eq major-mode 'mh-folder-mode) - (set-buffer b)))))) - (let ((bbdb-gag-messages t) - (bbdb-use-pop-up nil) - (bbdb-electric-p nil)) - (let ((record (bbdb/mh-update-record offer-to-create))) - (bbdb-display-records (if record (list record) nil) - bbdb-pop-up-display-layout) - record))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; this is a more strict version of mh-get-field which takes an regexp - -(defun bbdb/mh-get-field (field) - ;; Find and return the value of field FIELD (regexp) in the current buffer. - ;; Returns the empty string if the field is not in the message. - (let ((case-fold-search nil)) - (goto-char (point-min)) - (cond ((not (re-search-forward field nil t)) "") - ((looking-at "[\t ]*$") "") - (t (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) - (let ((field (buffer-substring (match-beginning 1) (match-end 1))) - (end-of-match (point))) - (forward-line) - (while (looking-at "[ \t]") (forward-line 1)) - (backward-char 1) - (if (<= (point) end-of-match) - field - (format "%s%s" field - (buffer-substring end-of-match (point))))))))) - -(defadvice mh-process-commands (after mh-bbdb-process act) - (bbdb-offer-save)) - -(defadvice mh-send (before mh-bbdb-send act) - (interactive (list - (bbdb-read-addresses-with-completion "To: ") - (bbdb-read-addresses-with-completion "Cc: ") - (read-string "Subject: ")))) - -(defadvice mh-send-other-window (before mh-bbdb-send-other act) - (interactive (list - (bbdb-read-addresses-with-completion "To: ") - (bbdb-read-addresses-with-completion "Cc: ") - (read-string "Subject: ")))) - -(defadvice mh-forward (before mh-bbdb-forward act) - (interactive (list (bbdb-read-addresses-with-completion "To: ") - (bbdb-read-addresses-with-completion "Cc: ") - (if current-prefix-arg - (mh-read-seq-default "Forward" t) - (mh-get-msg-num t))))) - -(defadvice mh-redistribute (before mh-bbdb-redist act) - (interactive (list - (bbdb-read-addresses-with-completion "Redist-To: ") - (bbdb-read-addresses-with-completion "Redist-Cc: ") - (mh-get-msg-num t)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; mail from bbdb-mode using mh - -;; these redefine the bbdb-send-mail functions to use mh-send. - -;;; Install bbdb into mh-e's show-message function - -;;;###autoload -(defun bbdb-insinuate-mh () - "Call this function to hook BBDB into MH-E." - (define-key mh-folder-mode-map ":" 'bbdb/mh-show-sender) - (define-key mh-folder-mode-map ";" 'bbdb/mh-edit-notes) - (define-key mh-letter-mode-map "\M-;" 'bbdb-complete-name) - (add-hook 'mh-show-hook 'bbdb/mh-update-record) - (define-key mh-letter-mode-map "\e\t" 'bbdb-complete-name)) - -(provide 'bbdb-mhe) diff --git a/xemacs-packages/lisp/bbdb/bbdb-migrate.el b/xemacs-packages/lisp/bbdb/bbdb-migrate.el deleted file mode 100644 index 745c7015..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-migrate.el +++ /dev/null @@ -1,486 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file contains the migration functions for the Insidious Big -;;; Brother Database (aka BBDB), copyright (c) 1991, 1992, 1993, 1994 -;;; Jamie Zawinski . See the file bbdb.texinfo for -;;; documentation. -;;; -;;; The Insidious Big Brother Database 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. -;;; -;;; BBDB 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. -;;; - -;; -;; $Id: bbdb-migrate.el,v 1.8 2005/07/24 15:22:58 waider Exp $ -;; -;; $Log: bbdb-migrate.el,v $ -;; Revision 1.8 2005/07/24 15:22:58 waider -;; sync with Sourceforge CVS -;; -;; Revision 1.20 2004/03/22 15:55:03 waider -;; * Minor docstring fix (Stefan Monnier) -;; * Catch error if attempting to kill only window in frame (Stefan Monnier) -;; -;; Revision 1.19 2002/08/19 22:49:12 waider -;; Jim Blandy's fix for migrating notes. -;; -;; Revision 1.18 2002/05/12 22:17:03 waider -;; Dave Love's big patch. See ChangeLog for full details. -;; -;; Revision 1.17 2001/05/17 17:15:31 fenk -;; (bbdb-unmigrate-zip-codes-to-strings): Fixed the faulty use of let instead of let*. -;; -;; Revision 1.16 2000/11/27 12:59:53 waider -;; Alex's zipcode changes. WARNING: New database format. -;; -;; Revision 1.15 2000/08/05 15:38:04 waider -;; When converting the streets to a list, delete "nil" as well as "". -;; -;; Revision 1.14 2000/07/11 21:28:44 sds -;; (bbdb-migrate-record-lambda): `mapcar', not `mapc' here! -;; -;; Revision 1.13 2000/07/10 17:00:12 sds -;; revert the last patch (`mapc' is more efficient than `mapcar') -;; -;; Revision 1.12 2000/07/09 09:20:11 waider -;; GNUmacs doesn't have "mapc". -;; -;; Revision 1.11 2000/07/05 21:43:35 sds -;; rewrote migration in a modular way -;; -;; Revision 1.10 2000/06/30 19:12:36 sds -;; (bbdb-migrate): re-wrote using `mapcar' instead of `append' -;; this is linear instead of quadratic and avoids much consing -;; -;; Revision 1.9 2000/05/29 22:47:50 waider -;; *** empty log message *** -;; -;; Revision 1.8 2000/04/17 08:30:47 waider -;; omitted bracket on unmigrate for v5->v4 -;; -;; Revision 1.7 2000/04/16 04:00:54 waider -;; * Added 5->4 unmigration -;; -;; Revision 1.6 2000/04/15 14:57:38 waider -;; * Fixed misplaced bracket in street migration code. -;; -;; Revision 1.5 2000/04/12 23:57:16 waider -;; * Added v5 migration. NB no back-migration yet. -;; -;; Revision 1.4 2000/04/05 16:45:07 bbdb-writer -;; * Added Alex's BBDB v4 format migration (country field) -;; -;; Revision 1.3 1998/10/10 18:47:21 simmonmt -;; From slbaur: Don't pass an integer to concat. -;; Format dates with number format - not string - so we get leading -;; zeros. -;; -;; Revision 1.2 1998/04/11 07:19:19 simmonmt -;; Colin Rafferty's patch adding autoload cookies back -;; -;; Revision 1.1 1998/01/06 06:06:06 simmonmt -;; Initial revision -;; -;; - -(require 'bbdb) - -;;; Migrating the BBDB - -;; Features that have changed in the various database revs. Format: -;; ((VERSION . DIFFERENCES) ... ) -(defconst bbdb-migration-features - '((3 . "* Date format for `creation-date' and `timestamp' has changed, - from \"dd mmm yy\" (ex: 25 Sep 97) to \"yyyy-mm-dd\" (ex: 1997-09-25).") - (4 . "* Country field added.") - (5 . "* More flexible street address.") - (6 . "* Zip codes are stored as plain strings."))) - -;;;###autoload -(defun bbdb-migration-query (ondisk) - "Ask if the database is to be migrated. -ONDISK is the version number of the database as currently stored on -disk. Returns the version for the saved database." - (save-excursion - (let ((wc (current-window-configuration)) - (buf (get-buffer-create "*BBDB Migration Info*")) - (newfeatures bbdb-migration-features) - (first t) - win update) - (set-buffer buf) - (erase-buffer) - (goto-char (point-min)) - (insert-string (format "BBDB new data version notice: -============================= - -Your BBDB data is stored in an older format (version %d). At this point, -you have the option of either upgrading or continuing to save your data -in your current format. Please note that if you elect the latter option, -any changes made to your data using features intended for the newer -versions will be lost. For your convenience, a list of file format -changes introduced after version %d is shown below:\n\n" ondisk ondisk)) - (while newfeatures - (if (> (caar newfeatures) ondisk) - (insert-string (concat (if first (setq first nil) "\n\n") - "New features in database version " - (format "%d" (caar newfeatures)) - ":\n\n" (cdar newfeatures)))) - (setq newfeatures (cdr newfeatures))) - (setq win (display-buffer buf)) - (shrink-window-if-larger-than-buffer win) - (setq update - (y-or-n-p (concat "Upgrade BBDB to version " - (format "%d" bbdb-file-format) - "? "))) - (condition-case nil - (delete-window win) - ;; The window might be the only one on its frame. Hopefully, it's - ;; a dedicated window and the kill-buffer below will DTRT. - (error nil)) - (kill-buffer buf) - (set-window-configuration wc) - (if update bbdb-file-format ondisk)))) - -;;;###autoload -(defun bbdb-migrate (records) - "Migrate the BBDB from the version on disk (the car of -`bbdb-file-format-migration') to the current version (in -`bbdb-file-format')." - (bbdb-mapc (bbdb-migrate-versions-lambda (car bbdb-file-format-migration)) - records) - records) - -;;;###autoload -(defun bbdb-unmigrate-record (record) - "Reverse-migrate a single record from the current version (in -`bbdb-file-format') to the version to be saved (the cdr of -`bbdb-file-format-migration')." - (funcall (bbdb-migrate-versions-lambda bbdb-file-format - (car bbdb-file-format-migration)) - record) - record) - -(defconst bbdb-migration-spec - '((2 (bbdb-record-raw-notes bbdb-record-set-raw-notes - bbdb-migrate-change-dates)) - (3 (bbdb-record-addresses bbdb-record-set-addresses - bbdb-migrate-add-country-field)) - (4 (bbdb-record-addresses bbdb-record-set-addresses - bbdb-migrate-streets-to-list)) - (5 (bbdb-record-addresses bbdb-record-set-addresses - bbdb-migrate-zip-codes-to-strings))) - "The alist of (version . migration-spec-list). -See `bbdb-migrate-record-lambda' for details.") - -(defconst bbdb-unmigration-spec - '((2 (bbdb-record-raw-notes bbdb-record-set-raw-notes - bbdb-unmigrate-change-dates)) - (3 (bbdb-record-addresses bbdb-record-set-addresses - bbdb-unmigrate-add-country-field)) - (4 (bbdb-record-addresses bbdb-record-set-addresses - bbdb-unmigrate-streets-to-list)) - (5 (bbdb-record-addresses bbdb-record-set-addresses - bbdb-unmigrate-zip-codes-to-strings))) - "The alist of (version . migration-spec-list). -See `bbdb-migrate-record-lambda' for details.") - -(defun bbdb-migrate-record-lambda (changes) - "Return a function which will migrate a single record. -CHANGES is a `migration-spec-list' containing entries of the form - - (GET SET FUNCTION) - -where GET is the function to be used to retrieve the field to be -modified, and SET is the function to be used to set the field to be -modified. FUNCTION will be applied to the result of GET, and its -results will be saved with SET." - (byte-compile `(lambda (rec) - ,@(mapcar (lambda (ch) - `(,(cadr ch) rec - (,(car (cddr ch)) - (,(car ch) rec)))) - changes) - rec))) - -(defun bbdb-migrate-versions-lambda (v0 &optional v1) - "Return the function to migrate from V0 to V1. -V1 defaults to `bbdb-file-format'." - (setq v1 (or v1 bbdb-file-format)) - (let ((vv v0) spec) - (while (/= vv v1) - (setq spec (append spec (cdr (assoc vv bbdb-migration-spec))) - vv (if (< v0 v1) (1+ vv) (1- vv)))) - (bbdb-migrate-record-lambda spec))) - -(defun bbdb-migrate-zip-codes-to-strings (addrs) - "Make all zip codes plain strings. -This uses the code that used to be in bbdb-address-zip-string." - ;; apply the function to all addresses in the list and return a - ;; modified list of addresses - (mapcar (lambda (addr) - (let ((zip (if (stringp (bbdb-address-zip addr)) - (bbdb-address-zip addr) - ;; if not a string, make it a string... - (if (consp (bbdb-address-zip addr)) - ;; if a cons cell with two strings - (if (and (stringp (car (bbdb-address-zip addr))) - (stringp (car (cdr (bbdb-address-zip addr))))) - ;; if the second string starts with 4 digits - (if (string-match "^[0-9][0-9][0-9][0-9]" - (car (cdr (bbdb-address-zip addr)))) - (concat (car (bbdb-address-zip addr)) - "-" - (car (cdr (bbdb-address-zip addr)))) - ;; if ("abc" "efg") - (concat (car (bbdb-address-zip addr)) - " " - (car (cdr (bbdb-address-zip addr))))) - ;; if ("SE" (123 45)) - (if (and (stringp (nth 0 (bbdb-address-zip addr))) - (consp (nth 1 (bbdb-address-zip addr))) - (integerp (nth 0 (nth 1 (bbdb-address-zip addr)))) - (integerp (nth 1 (nth 1 (bbdb-address-zip addr))))) - (format "%s-%d %d" - (nth 0 (bbdb-address-zip addr)) - (nth 0 (nth 1 (bbdb-address-zip addr))) - (nth 1 (nth 1 (bbdb-address-zip addr)))) - ;; if a cons cell with two numbers - (if (and (integerp (car (bbdb-address-zip addr))) - (integerp (car (cdr (bbdb-address-zip addr))))) - (format "%05d-%04d" (car (bbdb-address-zip addr)) - (car (cdr (bbdb-address-zip addr)))) - ;; else a cons cell with a string an a number (possible error - ;; if a cons cell with a number and a string -- note the - ;; order!) - (format "%s-%d" (car (bbdb-address-zip addr)) - (car (cdr (bbdb-address-zip addr))))))) - ;; if nil or zero - (if (or (eq 0 (bbdb-address-zip addr)) - (null (bbdb-address-zip addr))) - "" - ;; else a number, could be 3 to 5 digits (possible error: assuming - ;; no leading zeroes in zip codes) - (format "%d" (bbdb-address-zip addr))))))) - (bbdb-address-set-zip addr zip)) - addr) - addrs)) - -(defun bbdb-unmigrate-zip-codes-to-strings (addrs) - "Make zip code string into zip code datastructures. -This uses the code that used to be in bbdb-parse-zip-string." - ;; apply the function to all addresses in the list and return a - ;; modified list of addresses - (mapcar (lambda (addr) - (let* ((string (bbdb-address-zip addr)) - (zip (cond ((string-match "^[ \t\n]*$" string) 0) - ;; Matches 1 to 6 digits. - ((string-match "^[ \t\n]*[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[ \t\n]*$" string) - (string-to-int string)) - ;; Matches 5 digits and 3 or 4 digits. - ((string-match "^[ \t\n]*\\([0-9][0-9][0-9][0-9][0-9]\\)[ \t\n]*-?[ \t\n]*\\([0-9][0-9][0-9][0-9]?\\)[ \t\n]*$" string) - (list (bbdb-subint string 1) (bbdb-subint string 2))) - ;; Match zip codes for Canada, UK, etc. (result is ("LL47" "U4B")). - ((string-match - "^[ \t\n]*\\([A-Za-z0-9]+\\)[ \t\n]+\\([A-Za-z0-9]+\\)[ \t\n]*$" - string) - (list (substring string (match-beginning 1) (match-end 1)) - (substring string (match-beginning 2) (match-end 2)))) - ;; Match zip codes for continental Europe. Examples "CH-8057" - ;; or "F - 83320" (result is ("CH" "8057") or ("F" "83320")). - ;; Support for "NL-2300RA" added at request from Carsten Dominik - ;; - ((string-match - "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+ ?[A-Z]*\\)[ \t\n]*$" string) - (list (substring string (match-beginning 1) (match-end 1)) - (substring string (match-beginning 2) (match-end 2)))) - ;; Match zip codes from Sweden where the five digits are grouped 3+2 - ;; at the request from Mats Lofdahl . - ;; (result is ("SE" (133 36))) - ((string-match - "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+\\)[ \t\n]+\\([0-9]+\\)[ \t\n]*$" string) - (list (substring string (match-beginning 1) (match-end 1)) - (list (bbdb-subint string 2) - (bbdb-subint string 3))))))) - (bbdb-address-set-zip addr zip) - addr)) - addrs)) - -(defun bbdb-migrate-change-dates (rec) - "Change date formats. -Formats are changed in timestamp and creation-date fields from -\"dd mmm yy\" to \"yyyy-mm-dd\". Assumes the notes are passed in as an -argument." - (unless (stringp rec) - (bbdb-mapc (lambda (rr) - (when (memq (car rr) '(creation-date timestamp)) - (bbdb-migrate-change-dates-change-field rr))) - rec) - rec)) - -(defun bbdb-migrate-change-dates-change-field (field) - "Migrate the date field (the cdr of FIELD) from \"dd mmm yy\" to -\"yyyy-mm-dd\"." - (let ((date (cdr field)) - parsed) - ;; Verify and extract - this is fairly hideous - (and (equal (setq parsed (timezone-parse-date (concat date " 00:00:00"))) - ["0" "0" "0" "0" nil]) - (equal (setq parsed (timezone-parse-date date)) - ["0" "0" "0" "0" nil]) - (cond ((string-match - "^\\([0-9]\\{4\\}\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)" date) - (setq parsed (vector (string-to-int (match-string 1 date)) - (string-to-int (match-string 2 date)) - (string-to-int (match-string 3 date)))) - ;; This should be fairly loud for GNU Emacs users - (bbdb-warn "BBDB is treating %s field value %s as %s %d %d" - (car field) (cdr field) - (upcase-initials - (downcase (car (rassoc (aref parsed 1) - timezone-months-assoc)))) - (aref parsed 2) (aref parsed 0))) - ((string-match - "^\\([ 0-9]?[0-9]\\)[-/]\\([ 0-9]?[0-9]\\)[-/]\\([0-9]\\{4\\}\\)" date) - (setq parsed (vector (string-to-int (match-string 3 date)) - (string-to-int (match-string 1 date)) - (string-to-int (match-string 2 date)))) - ;; This should be fairly loud for GNU Emacs users - (bbdb-warn "BBDB is treating %s field value %s as %s %d %d" - (car field) (cdr field) - (upcase-initials - (downcase (car (rassoc (aref parsed 1) - timezone-months-assoc)))) - (aref parsed 2) (aref parsed 0))) - (t ["0" "0" "0" "0" nil]))) - - ;; I like numbers - (and (stringp (aref parsed 0)) - (aset parsed 0 (string-to-int (aref parsed 0)))) - (and (stringp (aref parsed 1)) - (aset parsed 1 (string-to-int (aref parsed 1)))) - (and (stringp (aref parsed 2)) - (aset parsed 2 (string-to-int (aref parsed 2)))) - - ;; Sanity check - (cond ((and (< 0 (aref parsed 0)) - (< 0 (aref parsed 1)) (>= 12 (aref parsed 1)) - (< 0 (aref parsed 2)) - (>= (timezone-last-day-of-month (aref parsed 1) - (aref parsed 0)) - (aref parsed 2))) - (setcdr field (format "%04d-%02d-%02d" (aref parsed 0) - (aref parsed 1) (aref parsed 2))) - field) - (t - (error "BBDB cannot parse %s header value %S for upgrade" - field date))))) - -(defun bbdb-unmigrate-change-dates (rec) - "Change date formats. -Formats are changed in timestamp and creation-date fields from -\"yyyy-mm-dd\" to \"dd mmm yy\". Assumes the notes list is passed in -as an argument." - (unless (stringp rec) - (bbdb-mapc (lambda (rr) - (when (memq (car rr) '(creation-date timestamp)) - (bbdb-unmigrate-change-dates-change-field rr))) - rec) - rec)) - -(defun bbdb-unmigrate-change-dates-change-field (field) - "Unmigrate the date field (the cdr of FIELD) from \"yyyy-mm-dd\" to -\"yyyy-mm-dd\"." - (cons (car field) (bbdb-time-convert (cdr field) "%e %b %y"))) - -(defun bbdb-migrate-add-country-field (addrl) - "Add a country field to each address in the address list." - (mapcar (lambda (addr) (vconcat addr [""])) addrl)) - -(defun bbdb-unmigrate-add-country-field (addrl) - "Remove the country field from each address in the address list." - ;; Some version 4 zip codes will be illegal version 3 (as used in - ;; 2.00.06) zip codes. This problem has not been solved. - (mapcar (lambda (addr) - (let* ((len (1- (length addr))) - (new-addr (make-vector len nil)) - (ii 0)) - (while (< ii len) - (aset new-addr ii (aref addr ii)) - (setq ii (1+ ii))))) - addrl)) - -(defun bbdb-migrate-streets-to-list (addrl) - "Convert the streets to a list." - (mapcar (lambda (addr) - (vector (aref addr 0) ; tag - (delete nil (delete "" ; nuke empties - (list (aref addr 1) ; street1 - (aref addr 2) ; street2 - (aref addr 3))));street3 - (aref addr 4) ; city - (aref addr 5) ; state - (aref addr 6) ; zip - (aref addr 7))) ; country - addrl)) - -(defun bbdb-unmigrate-streets-to-list (addrl) - "Convert the street list to the street[1-3] format." - ;; Take all the old addresses, ie. the 5th field, and for each - ;; address, render the third element (a list of streets) as three - ;; vector elements (v4-style address). If there's more than 3 - ;; lines, everything remaining gets crammed into the third, using - ;; commas to separate the bits. If there's less, fill out with nil. - (mapcar (lambda (addr) - (let ((streets (aref addr 1))) - (vector (aref addr 0) ; tag - (or (nth 0 streets) "") - (or (nth 1 streets) "") - (mapconcat 'identity (cddr streets) ", ") - (aref addr 2) ; city - (aref addr 3) ; state - (aref addr 4) ; zip - (aref addr 5)))) ; country - addrl)) - -;;;###autoload -(defun bbdb-migrate-rewrite-all (message-p &optional records) - "Rewrite each and every record in the bbdb file; this is necessary if we -are updating an old file format. MESSAGE-P says whether to sound off -for each record converted. If RECORDS is non-nil, its value will be -used as the list of records to update." - ;; RECORDS is used by the migration mechanism. Since the migration - ;; mechanism is called from within bbdb-records, if we called - ;; bbdb-change-record, we'd recurse and die. We're therefore left - ;; with the slightly more palatable (but still not pretty) calling - ;; of bbdb-overwrite-record-internal. - (or records (setq records (bbdb-records))) - (let ((i 0)) - (while records - (bbdb-overwrite-record-internal (car records) nil) - (if message-p (message "Updating %d: %s %s" (setq i (1+ i)) - (bbdb-record-firstname (car records)) - (bbdb-record-lastname (car records)))) - (setq records (cdr records))))) -(defalias 'bbdb-dry-heaves 'bbdb-migrate-rewrite-all) - -;;;###autoload -(defun bbdb-migrate-update-file-version (old new) - "Change the `file-version' string from the OLD version to the NEW -version." - (goto-char (point-min)) - (if (re-search-forward (format "^;;; file-version: %d$" old) nil t) - (replace-match (format ";;; file-version: %d" new)) - (error (format "Can't find file-version string in %s buffer for v%d migration" - bbdb-file new)))) - -(provide 'bbdb-migrate) diff --git a/xemacs-packages/lisp/bbdb/bbdb-print.el b/xemacs-packages/lisp/bbdb/bbdb-print.el deleted file mode 100644 index ffc6ff95..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-print.el +++ /dev/null @@ -1,734 +0,0 @@ -;;; bbdb-print.el -- for printing BBDB databases using TeX. - -;;; Authors: Boris Goldowsky -;;; Dirk Grunwald -;;; Luigi Semenzato -;;; Copyright (C) 1993 Boris Goldowsky -;;; Version: 3.92; 4Jan95 - -;;; This file is part of the bbdb-print extensions to the Insidious -;;; Big Brother Database, which is for use with GNU Emacs. -;;; -;;; The Insidious Big Brother Database is free software; you can redistribute -;;; it and/or modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 1, or (at your -;;; option) any later version. -;;; -;;; BBDB 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: -;;; -;;; In the *BBDB* buffer, type P to convert the listing to TeX -;;; format. It will prompt you for a filename. Then run TeX on that -;;; file and print it out. -;;; -;;; Bbdb-print understands one new bbdb field: tex-name. If it -;;; exists, this will be used for the printed listing instead of the -;;; name field of that record. This is designed for entering names -;;; with lots of accents that would mess up mailers, or when for any -;;; reason you want the printed version of the name to be different -;;; from the version that appears on outgoing mail and in the *BBDB* -;;; buffer. You may want to add tex-name to a omit list of the variable -;;; bbdb-display-layout-alist so you only see it in the printout. -;;; tex-name is exempted from the usual special-character quoting done by -;;; bbdb-print; it is used verbatim. -;;; -;;; Not all fields or records need be printed. To not print a certain -;;; field, add it to `bbdb-print-omit-fields' (which see). If after eliding -;;; fields a record contains no interesting information, it will not -;;; be printed at all; the variable `bbdb-print-require' determines -;;; what is meant by "interesting" information. You can also restrict -;;; printing to just the records currently in the *BBDB* buffer by -;;; using *P instead of P. -;;; -;;; There are various options for the way the formatting is done; most -;;; are controlled by the variable bbdb-print-alist. See its -;;; documentation for the allowed options. - -;; -;; $Id: bbdb-print.el,v 1.6 2005/07/24 15:22:58 waider Exp $ -;; -;; $Log: bbdb-print.el,v $ -;; Revision 1.6 2005/07/24 15:22:58 waider -;; sync with Sourceforge CVS -;; -;; Revision 1.68 2004/10/13 13:37:06 waider -;; * Correct variable name in comment -;; -;; Revision 1.67 2001/11/19 21:35:08 waider -;; Patch from Alex Schroeder -;; -;; Revision 1.66 2001/09/11 10:55:31 fenk -;; Appliend fixed according to change log -;; -;; Revision 1.65 2000/11/27 12:59:53 waider -;; Alex's zipcode changes. WARNING: New database format. -;; -;; Revision 1.64 2000/07/13 17:07:00 sds -;; minor doc fixes to comply with the standards -;; -;; Revision 1.63 2000/05/29 22:47:50 waider -;; *** empty log message *** -;; -;; Revision 1.62 2000/04/15 17:11:49 kuepper -;; Adopt TeX-output of streets to new file-format v5. -;; -;; Revision 1.61 2000/04/13 17:19:58 kuepper -;; Improved TeX output (fonts, breaks). -;; -;; Revision 1.60 2000/04/13 00:22:23 waider -;; * Address layout patch, including Euro addresses and the streets->list thing -;; -;; Revision 1.59 1998/11/02 07:08:14 simmonmt -;; Change mailing list address -;; -;; Revision 1.58 1998/10/17 19:43:26 simmonmt -;; Patch to convert default area code protection from condition-case to -;; integerp. -;; -;; Revision 1.57 1998/04/11 07:19:32 simmonmt -;; Colin Rafferty's patch adding autoload cookies back -;; -;; Revision 1.56 1998/03/10 07:37:42 simmonmt -;; Protecting bbdb-default-area-code -;; -;; Revision 1.55 1998/02/23 07:12:40 simmonmt -;; Moved key binding to bbdb.el, changed default of bbdb-print-elide, -;; fixed problem with nil bbdb-default-area-code -;; -;; Revision 1.54 1998/01/06 06:08:38 simmonmt -;; Customized variables and removed autoloads -;; -;; Revision 1.53 1997/12/01 05:02:28 simmonmt -;; Soren Dayton's fix to correct tilde printing -;; -;; Revision 1.52 1997/10/06 01:05:28 simmonmt -;; New version of bbdb-print from Boris Goldowsky -;; -;; - -;;; Installation: -;;; -;;; Put this file somewhere on your load-path. Put bbdb-print.tex and -;;; bbdb-cols.tex somewhere on your TEXINPUTS path, or put absolute -;;; pathnames into the variable bbdb-print-format-files (which see). Put -;;; (add-hook 'bbdb-load-hook (function (lambda () (require 'bbdb-print)))) -;;; into your .emacs, or autoload it. -;;; -;;; This program was adapted for BBDB by Boris Goldowsky -;;; and Dirk Grunwald -;;; using a TeX format designed by Luigi -;;; Semenzato . -;;; We are also grateful to numerous people on the bbdb-info -;;; mailing list for suggestions and bug reports. - -;;; Code: - -(require 'bbdb) -(require 'bbdb-com) - -;;; Variables: - -(defcustom bbdb-print-file-name "~/bbdb.tex" - "*Default file name for printouts of BBDB database." - :group 'bbdb-utilities-print - :type 'file) - -(defcustom bbdb-print-omit-fields '(omit tex-name aka mail-alias) - "*List of fields NOT to print in address list. -See also bbdb-print-require." - :group 'bbdb-utilities-print - :type '(repeat (symbol :tag "Field to exclude"))) - -(defcustom bbdb-print-require '(or address phone) - "*What fields are required for printing a record. -This is evaluated for each record, and the record will be printed only -if it returns non-nil. The symbols name, company, net, phone, -address, and notes will be set to appropriate values when this is -evaluated; they will be nil if the field does not exist or is elided. - -The value of this variable can be any lisp expression, but typically -it will be used for a boolean combination of the field variables, as -in the following simple examples: - - Print only people whose phone numbers are known: - (setq bbdb-print-require 'phone) - Print people whose names AND companies are known: - (setq bbdb-print-require '(and name company)) - Print people whose names, and either addresses OR phone numbers are known: - (setq bbdb-print-require '(and name (or address phone)))." - :group 'bbdb-utilities-print - :type '(choice (const :tag "Print all records" t) - (symbol :tag "Print all records with this field" phone) - (sexp :tag "Print only when this evaluates to non-nil" - '(or phone address phone)))) - -(defun bbdb-print-field-shown-p (field) - (not (memq field bbdb-print-omit-fields))) - -(define-widget 'bbdb-print-alist-widget 'repeat - "For use in Customize" - :args `((choice - (cons :tag "Column specification" :value (column . 1) - (const :tag "Column mode" column) - (radio-button-choice (const :tag "One column" 1) - (const :tag "Two columns" 2) - (const :tag "Three columns" 3) - (const :tag "Four columns" 4) - (const :tag "Quad" quad) - (const :tag "Grid" grid))) - (cons :tag "Separator specification" :value (separator . 0) - (const :tag "Separator" separator) - (radio-button-choice (const :tag "None" 0) - (const :tag "Line" 1) - (const :tag "Boxed letters" 2) - (const :tag "Large boxed letters" 3) - (const :tag "Large letters" 4) - (const :tag "Letters with lines" 5) - (const :tag "Letters with suits" 6) - (const :tag "Boxed letters with suits" 7))) - (cons :tag "Omit certain area codes" - :value (omit-area-code . ,(concat "^(" - (if (integerp bbdb-default-area-code) - (int-to-string bbdb-default-area-code) - "000") ") ")) - (const :tag "Omit certain area codes" omit-area-code) - (regexp :tag "Pattern to omit")) - (cons :tag "Phone number location" :value (phone-on-first-line . t) - (const :tag "Phone number location" phone-on-first-line) - (choice (const :tag "First home number on same line as name" t) - (const :tag "Don't put the phone number on the name line" nil) - (regexp :tag "Use phone number whose location matches" "^work$"))) - (cons :tag "Limit included phone numbers" :value (n-phones . 3) - (const :tag "Limit included phone numbers" n-phones) - (integer :tag "Maximum number to include" 3)) - (cons :tag "Limit included addresses" :value (n-addresses . 3) - (const :tag "Limit included addresses" n-addresses) - (integer :tag "Maximum number to include" 3)) - (cons :tag "Include additional TeX input files" :value (include-files . nil) - (const :tag "Additional TeX input files to include" include-files) - (repeat (file :tag "TeX file to include"))) - (cons :tag "Font type selection" :value (ps-fonts . nil) - (const :tag "Select font type" ps-fonts) - (choice (const :tag "Use standard TeX fonts" nil) - (const :tag "Use Postscript fonts" t))) - (cons :tag "Font size selection" :value (font-size . 10) - (const :tag "Select font size" font-size) - (integer :tag "Font size in points" 10)) - (cons :tag "Page height selection" :value (v-size . nil) - (const :tag "Select page height" v-size) - (choice (const :tag "Use TeX default" nil) - (string :tag "Height (must be valid TeX dimension)" "9in"))) - (cons :tag "Page width selection" :value (h-size . nil) - (const :tag "Select page width" h-size) - (choice (const :tag "Use TeX default" nil) - (string :tag "Width (must be valid TeX dimension)" "6in"))) - (cons :tag "Vertical offset (top margin)" :value (voffset . nil) - (const :tag "Select vertical offset (top margin)" voffset) - (choice (const :tag "Use TeX default" nil) - (string :tag "Vertical offset (must be valid TeX dimension)" "1in"))) - (cons :tag "Horizontal offset (left margin)" :value (hoffset . nil) - (const :tag "Select horizontal offset (left margin)" hoffset) - (choice (const :tag "Use TeX default" nil) - (string :tag "Horizontal offset (must be valid TeX dimension)" "1in"))) - (cons :tag "Quad format height" :value (quad-vsize . "") - (const :tag "Select height for quad format pages" quad-vsize) - (string :tag "Height (must be valid TeX dimension)")) - (cons :tag "Quad format width" :value (quad-hsize . "") - (const :tag "Select width for quad format pages" quad-hsize) - (string :tag "Width (must be valid TeX dimension)"))))) - -(defcustom bbdb-print-alist - `((omit-area-code . ,(concat "^(" (if (integerp bbdb-default-area-code) - (int-to-string bbdb-default-area-code) - "000") ") ")) - (phone-on-first-line . "^[ \t]*$") - (ps-fonts . nil) - (font-size . 6) - (quad-hsize . "3.15in") - (quad-vsize . "4.5in")) - "*Formatting options for `bbdb-print', all formats. -This is an alist of the form ((option1 . value1) (option2 . value2) ...) - -You can have separate settings for brief and non-brief printouts; -see the variables `bbdb-print-brief-alist' and `bbdb-print-full-alist'. -Settings there will override the common settings in this variable. - -The possible options and legal values are: - - columns: 1, 2, 3, 4 or 'quad (4 little 2-column pages per sheet) - or 'grid (12 credit-card-sized pages per sheet). - - separator: 0-7, the style of heading for each letter. - 0=none, 1=line, 2=boxed letters, 3=large boxed letters, 4=large letters, - 5=letters with lines, 6=letters with suits, 7=boxed letters with suits. - - omit-area-code: a regular expression matching area codes to omit. - - phone-on-first-line: t means to put first phone number on the same - line with the name, nil means just the name. A string means to - use the first phone number whose \"location\" matches that string, - which should be a valid regular expression. - - n-phones: maximum number of phone numbers to include. - - n-addresses: maximum number of addresses to include. - - include-files: list of TeX files to \\input. If these filenames are not - absolute, the files must be located somewhere that TeX will find them. - - ps-fonts: nonnil means to use them, nil to use standard TeX fonts. - - font-size: in points, any integer (assuming fonts in that size exist!). - - hsize, vsize: horizontal dimension of pages. String value can be any valid - TeX dimension, or nil to use TeX's default. - - hoffset, voffset: shift TeX's output rightward (downward) by this distance - (any TeX dimension). Nil or 0 uses TeX's default positioning. - - quad-hsize, quad-vsize: for the quad format, horizontal and - vertical size of the little pages. These must be strings which - are valid TeX dimensions, eg \"10cm\"." - :group 'bbdb-utilities-print - :type 'bbdb-print-alist-widget) - -(defcustom bbdb-print-full-alist - '((columns . 3) - (separator . 2) - (include-files "bbdb-print" "bbdb-cols")) - "*Extra options for `bbdb-print' non-brief format. -These supplement or override entries in `bbdb-print-alist'; see description -of possible contents there." - :group 'bbdb-utilities-print - :type 'bbdb-print-alist-widget) - -(defcustom bbdb-print-brief-alist - '((columns . 1) - (separator . 1) - (n-phones . 2) - (n-addresses . 1) - (include-files "bbdb-print-brief" "bbdb-cols")) - "*Extra Options for `bbdb-print', brief format. -These supplement or override entries in `bbdb-print-alist'; see description -of possible contents there." - :group 'bbdb-utilities-print - :type 'bbdb-print-alist-widget) - -(defconst bbdb-print-filofax-alist - (append '((font-size . 12) - (columns . 2) - (voffset . "-2cm") - (hoffset . "-2cm") - (vsize . "27cm")) - bbdb-print-full-alist) - "Example setup for making pages for a Filofax binder.") - - -(defcustom bbdb-print-prolog - (concat "%%%% ====== Phone/Address list in -*-TeX-*- Format =====\n" - "%%%% produced by bbdb-print, version 3.0\n\n") - "*TeX statements to include at the beginning of the `bbdb-print' file." - :group 'bbdb-utilities-print - :type '(text :format "%t:\n%v")) - -(defcustom bbdb-print-epilog "\\endaddresses\n\\bye\n" - "*TeX statements to include at the end of the `bbdb-print' file." - :group 'bbdb-utilities-print - :type '(text :format "%t:\n%v")) - -(defcustom bbdb-print-net 'primary - "*Indicates whether only the primary or all email addresses are printed. -Symbol `primary' means print the primary email address only. -Symbol `all' means print all email addresses." - :group 'bbdb-utilities-print - :type '(choice (const primary) - (const all))) - -;;; Functions: - -(defsubst bbdb-print-if-not-blank (string &rest more) - "If STRING is not null, then return it concatenated -with rest of arguments. If it is null, then all arguments are -ignored and the null string is returned." - (if (or (null string) (equal "" string)) - "" - (apply 'concat string more))) - -;;;###autoload -(defun bbdb-print (visible-records to-file brief) - "Make a TeX file for printing out the bbdb database.\\ -If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-print]\" is \ -used instead of simply \"\\[bbdb-print]\", then includes only the -people currently in the *BBDB* buffer. With a prefix argument, makes -a brief \(one-line-per-entry) printout. - -There are various variables for customizing the content & format of -the printout, notably the variables `bbdb-print-alist' and -`bbdb-print-require'. See the file bbdb-print.el for more information." - (interactive (list (bbdb-do-all-records-p) - (read-file-name "Print To File: " - (file-name-directory bbdb-print-file-name) - bbdb-print-file-name - nil - (file-name-nondirectory bbdb-print-file-name)) - current-prefix-arg)) - (setq bbdb-print-file-name (expand-file-name to-file)) - (let* ((alist (append (if brief bbdb-print-brief-alist bbdb-print-full-alist) - bbdb-print-alist)) - (records (if (not visible-records) - (bbdb-records) - (set-buffer bbdb-buffer-name) - (mapcar 'car bbdb-records))) - (psstring (if (cdr (assoc 'ps-fonts alist)) - "ps" "")) - (columns (cdr (assoc 'columns alist))) - (current-letter t) - (pofl (cdr (assoc 'phone-on-first-line alist))) - (n-phones (cdr (assoc 'n-phones alist))) - (n-addresses (cdr (assoc 'n-addresses alist)))) - (find-file bbdb-print-file-name) - (widen) (erase-buffer) - (insert bbdb-print-prolog) - (let ((dimens '(hsize vsize hoffset voffset)) - val) - (while dimens - (setq val (cdr (assoc (car dimens) alist))) - (if val - (insert (format "\\%s=%s\n" (car dimens) val))) - (setq dimens (cdr dimens)))) - (let ((infiles (cdr (assoc 'include-files alist)))) - (while infiles - (insert (format "\\input %s\n" (car infiles))) - (setq infiles (cdr infiles)))) - (insert (format "\n\\set%ssize{%d}\n" - psstring (cdr (assoc 'font-size alist))) - (format "\\setseparator{%d}\n" - (cdr (assoc 'separator alist))) - (cond ((eq 'quad columns) - (format "\\quadformat{%s}{%s}" - (cdr (assoc 'quad-hsize alist)) - (cdr (assoc 'quad-vsize alist)))) - ((eq 'grid columns) "\\grid") - ((= 4 columns) "\\fourcol") - ((= 3 columns) "\\threecol") - ((= 2 columns) "\\twocol") - ((= 1 columns) "\\onecol")) - ;; catcodes are font-encoding specific ! - ;; Add more if you know them - (if (equal psstring "ps") - (concat "\n\n" - ;; Adobe Times and Courier - ) - (concat "\n\n" - ;; ec fonts - "\\catcode`ß=\\active\\chardefß=\"FF")) - "\n\n\\beginaddresses\n") - (while records - (setq current-letter - (bbdb-print-format-record (car records) current-letter - brief pofl n-phones n-addresses)) - (setq records (cdr records))) - (insert bbdb-print-epilog) - (goto-char (point-min)))) - -(defvar bbdb-address-print-formatting-alist - '((bbdb-address-is-continental . bbdb-print-format-address-continental) - (nil . bbdb-print-format-address-default)) - "Alist of address identifying and address formatting functions for printing. -The key is an identifying function which accepts an address. The -associated value is a formatting function which inserts the formatted -address in the current buffer. If the identifying function returns -non-nil, the formatting function is called. The nil key is a default -value will allways calls the associated formatting function. Therefore -you should always have (nil . bbdb-print-format-address-default) as the -last element in the alist. - -The functions must take one argument, the address. - -See also `bbdb-address-formatting-alist'.") - -(defun bbdb-print-format-address-continental (addr) - "Insert formated continental address ADDR in current buffer for printing. -This format is used in western Europe, for example. - -This function is a possible formatting function for -`bbdb-address-print-formatting-alist'. - -The result looks like this: - street - street - ... - zip city, state - country" - (insert - (format - "\\address{%s}\n" - (bbdb-print-tex-quote - (if addr - (concat - (mapconcat (function (lambda(str) - (if (= 0 (length (bbdb-string-trim str))) - () - (concat str"\\\\\n")))) - (bbdb-address-streets addr) - "") - (let ((c (bbdb-address-city addr)) - (s (bbdb-address-state addr)) - (z (bbdb-address-zip addr))) - (if (or (> (length c) 0) - (> (length z) 0) - (> (length s) 0)) - (concat z (if (and (> (length z) 0) - (> (length c) 0)) " " "") - c (if (and (or (> (length z) 0) - (> (length c) 0)) - (> (length s) 0)) ", " "") - s "\\\\\n") "")) - (bbdb-print-if-not-blank (bbdb-address-country addr) "\\\\\n")) - ""))))) - -(defun bbdb-print-format-address-default (addr) - "Insert formated address ADDR in current buffer for printing. -This is the default format; it is used in the US, for example. - -This function is a possible formatting function for -`bbdb-address-print-formatting-alist'. - -The result looks like this: - street - street - ... - city, state zip - country" - (insert - (format - "\\address{%s}\n" - (bbdb-print-tex-quote - (if addr - (concat - (mapconcat (function (lambda(str) - (if (= 0 (length (bbdb-string-trim str))) - () - (concat str "\\\\\n")))) - (bbdb-address-streets addr) - "") - (let ((c (bbdb-address-city addr)) - (s (bbdb-address-state addr)) - (z (bbdb-address-zip addr))) - (if (or (> (length c) 0) - (> (length z) 0) - (> (length s) 0)) - (concat c (if (and (> (length c) 0) - (> (length s) 0)) ", " "") - s (if (and (or (> (length c) 0) - (> (length s) 0)) - (> (length z) 0)) " " "") - z "\\\\\n") "")) - (bbdb-print-if-not-blank (bbdb-address-country addr) "\\\\\n")) - ""))))) - -(defun bbdb-print-format-record (record current-letter - brief pofl n-phones n-addresses) - "Insert the bbdb RECORD in TeX format. -Second arg CURRENT-LETTER is the first letter of the sortkey of the previous -record. If this is non-nil and RECORD begins differently, a section heading is -output. If CURRENT-LETTER is t always produces a heading. -3rd argument BRIEF is for 1-line-per-record printouts. -Args 3-5 PHONE-ON-FIRST-LINE, N-PHONES, and N-ADDRESSES are the respective -values from `bbdb-print-alist'. - -The return value is the new CURRENT-LETTER." - - (bbdb-debug (if (bbdb-record-deleted-p record) - (error "plus ungood: tex formatting deleted record"))) - - (let* ((first-letter - (substring (concat (bbdb-record-sortkey record) "?") 0 1)) - (name (and (bbdb-print-field-shown-p 'name) - (or (bbdb-record-getprop record 'tex-name) - (bbdb-print-tex-quote - (bbdb-record-name record))))) - (company (and (bbdb-print-field-shown-p 'company) - (bbdb-record-company record))) - (net (and (bbdb-print-field-shown-p 'net) - (bbdb-record-net record))) - (phone (and (bbdb-print-field-shown-p 'phone) - (bbdb-record-phones record))) - (address (and (bbdb-print-field-shown-p 'address) - (bbdb-record-addresses record))) - (notes (bbdb-record-raw-notes record))) - - (if (not (eval bbdb-print-require)) - nil ; lacks required fields - - ;; Section header, if neccessary. - - (if (and current-letter - (not (string-equal first-letter current-letter))) - (insert (format "\\goodbreak\n\\separator{%s}\n%%\n" - (bbdb-print-tex-quote (upcase first-letter))))) - - (insert "\\beginrecord\n") - - ;; if there is no name, use company instead - (if (and (not name) company) - (setq name (bbdb-print-tex-quote company) - company nil)) - - (let ((rightside "")) - (cond ((null phone)) - ((eq t pofl) - (setq rightside (bbdb-print-phone-string (car phone)) - phone (cdr phone))) - ((stringp pofl) - (let ((p (bbdb-print-front-if - (function (lambda (ph) - (string-match pofl (aref ph 0)))) - phone))) - (if p - (setq rightside (bbdb-print-phone-string (car p)) - phone (cdr p)))))) - (insert (format "\\firstline{%s}{%s}\n" - name - (bbdb-print-tex-quote rightside)))) - - (if company - (insert (format "\\comp{%s}\n" (bbdb-print-tex-quote company)))) - - ;; Phone numbers - - (if n-phones - (setq phone (bbdb-print-firstn (- n-phones (if pofl 1 0)) - phone brief))) - (while phone - (if (car phone) - (let ((place (aref (car phone) 0)) - (number (bbdb-print-phone-string (car phone)))) - (insert (format "\\phone{%s%s}\n" - (bbdb-print-tex-quote - (bbdb-print-if-not-blank place ": ")) - (bbdb-print-tex-quote number)))) - (insert (format "\\phone{}\n"))) - (setq phone (cdr phone))) - - ;; Email address - ;; Make all dots legal line-breaks. - - (when net - (let ((net-addrs - (cond ((eq bbdb-print-net 'primary) - (list (car net))) - ((eq bbdb-print-net 'all) - net) - (t nil)))) - (insert - (format - "\\email{%s}\n" - (mapconcat - (lambda (net-addr) - (setq net-addr (bbdb-print-tex-quote net-addr)) - (let ((start 0)) - (while (string-match "\\." net-addr start) - (setq net-addr - (concat (substring net-addr 0 (match-beginning 0)) - ".\\-" - (substring net-addr (match-end 0)))) - (setq start (+ 2 (match-end 0))))) - net-addr) - net-addrs ", "))))) - - ;; Addresses. FUTURE: If none left, should use phones instead. - - (if n-addresses - (setq address - (bbdb-print-firstn n-addresses address brief))) - (while address - (bbdb-format-address (car address) 'printing) - (setq address (cdr address))) - - ;; Notes - - (if (stringp notes) - (setq notes (list (cons 'notes notes)))) - (while notes - (let ((thisnote (car notes))) - (if (bbdb-print-field-shown-p (car thisnote)) - (progn - (if (eq 'notes (car thisnote)) - (insert (format "\\notes{%s}\n" (bbdb-print-tex-quote - (cdr thisnote)))) - (insert (format "\\note{%s}{%s}\n" - (bbdb-print-tex-quote (symbol-name - (car thisnote))) - (bbdb-print-tex-quote (cdr thisnote)))))))) - (setq notes (cdr notes))) - - ;; Mark end of the record. - - (insert "\\endrecord\n%\n") - (setq current-letter first-letter))) - - current-letter) - -(defun bbdb-print-phone-string (phone) - "Format PHONE-NUMBER as a string, obeying omit-area-code setting. -Omit-area-code is one of the allowed symbols in `bbdb-print-alist', which see." - (let ((str (bbdb-phone-string phone)) - (omit (cdr (assoc 'omit-area-code bbdb-print-alist)))) - (if (and omit (string-match omit str)) - (substring str (match-end 0)) - str))) - -(defun bbdb-print-front-if (func list) - "Move first elt of LIST satisfying FUNC to front. -The car of the returned list is the first element that returned nonnil; -The cdr is the rest of the list. -But if the FUNC returns nil for every elements of the LIST, returns nil." - (cond ((null list) nil) - ((funcall func (car list)) - list) - ((let ((rest (bbdb-print-front-if func (cdr list)))) - (if rest - (cons (car rest) - (cons (car list) (cdr rest)))))))) - -(defun bbdb-print-firstn (n list force) - "The first N elements of LIST. -If 3rd arg FORCE is nonnil, will extend the list to length N if necessary, by -adding nil's. If N is nil, just returns LIST." - (cond ((null n) list) - ((null list) (if force (make-list n nil) nil)) - ((<= n 0) nil) - (t (cons (car list) (bbdb-print-firstn (1- n) (cdr list) force))))) - -(defun bbdb-print-tex-quote (string) - "Quote any unquoted TeX special characters that appear in STRING. -In other words, # alone will be replaced by \\#, but \\^ will be left for -TeX to process as an accent." - (if string - (save-excursion - (set-buffer (get-buffer-create " bbdb-print-tex-quote")) - (erase-buffer) - (insert string) - (goto-char (point-min)) - (while (not (eobp)) - (cond ((looking-at "[<>=]+") - (replace-match "$\\&$")) - ((and (looking-at "[#$%&_]") - (not (eq ?\\ (char-after (1- (point)))))) - (insert "\\") - (forward-char 1)) - ((and (looking-at "~") - (not (eq ?\\ (char-after (1- (point)))))) - (insert "\\") - (forward-char 1) - (insert "{}")) - ((and (looking-at "[{}]") - (not (eq ?\\ (char-after (1- (point)))))) - (insert "$\\") - (forward-char 1) - (insert "$")) - (t (forward-char 1)))) - (buffer-string)))) - - -(provide 'bbdb-print) - -;;; bbdb-print ends here. - diff --git a/xemacs-packages/lisp/bbdb/bbdb-reportmail.el b/xemacs-packages/lisp/bbdb/bbdb-reportmail.el deleted file mode 100644 index c2173cb3..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-reportmail.el +++ /dev/null @@ -1,111 +0,0 @@ -;; bbdb-reportmail.el --- Hooks the Insidious Big Brother Database -;; into the Reportmail package - -;; Copyright (C) 1997 Christopher Kline - -;; Author: Christopher Kline -;; Maintainer: Christopher Kline -;; Version: 1.01 -;; Created: 25 Jun 1997 -;; Date: 26 Jun 1997 - -;; Bbdb-reportmail 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. - -;; Bbdb-reportmail 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: - -;; Bbdb-reportmail advises the reportmail package function -;; display-time-get-field so that it attempts to replace the reported -;; "from" and "to" fields with the name field (or mail-name, if it -;; exists) of the corresponding BBDB record, if such a correspondence -;; can be made. - -;; To use this, simply add the following lines AFTER you load in your -;; bbdb, set bbdb variables, etc. -;; -;; (bbdb-insinuate-reportmail) -;; -;; (A require used to be necessary - it is no longer needed as long as -;; bbdb-insinuate-reportmail is called) - -;;; History: - -;; v1.01 26 June 1997 -;; Fixed the advice so that if we are the message recipient, do -;; nothing so that display-time-process-new-mail will correctly -;; trap this case. -;; -;; v1.00 26 June 1997 -;; Initial release. - -;; -;; $Id: bbdb-reportmail.el,v 1.6 2005/07/24 15:22:58 waider Exp $ -;; - -;;----------------------------------------------------------------------- - -(require 'bbdb) -(require 'reportmail) -(require 'advice) -(require 'mail-extr) - -(defun bbdb/reportmail-alternate-full-name (address) - (if address - (let ((entry (bbdb-search-simple nil address))) - (if entry - (or (bbdb-record-getprop entry 'mail-name) - (bbdb-record-name entry)))))) - -(defadvice display-time-get-field - (around bbdb/reportmail-hack-display-time-get-field disable activate) - "Advises the `display-time-get-field' function in the reportmail package. -If the field is \"from\" or \"to\", it tries to replace the value of the field -with the name field of the corresponding BBDB entry, if one can be found. - -If no corresponding record can be found, the field value is left unaltered." - (let (gf-field) - ;; Get the original argument to display-time-get-field - (setq gf-field (ad-get-arg 0)) - ;; Call the original display-time-get-field - ad-do-it - (if (or (string= gf-field "To") (string= gf-field "From")) - (setq ad-return-value - (or - ;; If this message is to me, then do nothing so - ;; reportmail can trap this case in - ;; display-time-process-new-mail - (if (display-time-member ad-return-value - display-time-my-addresses) - ad-return-value - nil) - ;; Is the sender/recipient in our BBDB? - (bbdb/reportmail-alternate-full-name - (car (cdr (mail-extract-address-components ad-return-value)))) - ;; Can't find sender/recipient in BBDB; do nothing. - ad-return-value) - )))) - -;;;###autoload -(defun bbdb-insinuate-reportmail () - "Call this function to hook BBDB into reportmail." - (ad-enable-advice 'display-time-get-field 'around - 'bbdb/reportmail-hack-display-time-get-field) - (ad-activate 'display-time-get-field) - (message "Insinuated BBDB into Reportmail.") -) - -(provide 'bbdb-reportmail) - - diff --git a/xemacs-packages/lisp/bbdb/bbdb-rmail.el b/xemacs-packages/lisp/bbdb/bbdb-rmail.el deleted file mode 100644 index 63f0bd84..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-rmail.el +++ /dev/null @@ -1,179 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992 Jamie Zawinski . -;;; Interface to RMAIL. See bbdb.texinfo. - -;;; The Insidious Big Brother Database is free software; you can redistribute -;;; it and/or modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 1, or (at your -;;; option) any later version. -;;; -;;; BBDB 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. - -;; -;; $Id: bbdb-rmail.el,v 1.6 2005/07/24 15:22:58 waider Exp $ -;; - -(eval-when-compile - (require 'bbdb) - (require 'bbdb-com) - (require 'rmail) - ;(require 'rmailsum) ; not provided, dammit! - (if (not (fboundp 'rmail-make-summary-line)) - (load-library "rmailsum")) - ;; just to avoid a warning - (if (not (boundp 'rmail-buffer)) - (defvar rmail-buffer nil))) - -;;;###autoload -(defun bbdb/rmail-update-record (&optional offer-to-create) - (let ((bbdb-get-only-first-address-p) - (records (bbdb/rmail-update-records offer-to-create))) - (if records (car records) nil))) - -(defun bbdb/rmail-update-records (&optional offer-to-create) - "Returns the records corresponding to the current RMAIL message, creating or -modifying it as necessary. A record will be created if -bbdb/mail-auto-create-p is non-nil, or if OFFER-TO-CREATE is true and -the user confirms the creation." - (if bbdb-use-pop-up - (bbdb/rmail-pop-up-bbdb-buffer offer-to-create) - (if (and (boundp 'rmail-buffer) rmail-buffer) - (set-buffer rmail-buffer)) - (if rmail-current-message - (let ((records (bbdb-message-cache-lookup rmail-current-message)) - record) - (or records - (save-excursion - (let ((from (mail-fetch-field "from"))) - (if (or (null from) - (string-match (bbdb-user-mail-names) - (mail-strip-quoted-names from))) - ;; if logged-in user sent this, use recipients. - (setq from (or (mail-fetch-field "to") from))) - (if from - (setq record - (bbdb-annotate-message-sender - from t - (or (bbdb-invoke-hook-for-value - bbdb/mail-auto-create-p) - offer-to-create) - offer-to-create))) - ;; return a list of records - (if record - (bbdb-encache-message - rmail-current-message - (list record)))))))))) - -;;;###autoload -(defun bbdb/rmail-annotate-sender (string &optional replace) - "Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message. If REPLACE is non-nil, -replace the existing notes entry (if any)." - (interactive (list (if bbdb-readonly-p - (error "The Insidious Big Brother Database is read-only.") - (read-string "Comments: ")))) - (if (and (boundp 'rmail-buffer) rmail-buffer) - (set-buffer rmail-buffer)) - (bbdb-annotate-notes (bbdb/rmail-update-record t) string 'notes replace)) - -(defun bbdb/rmail-edit-notes (&optional arg) - "Edit the notes field or (with a prefix arg) a user-defined field -of the BBDB record corresponding to the sender of this message." - (interactive "P") - (let ((record (or (bbdb/rmail-update-record t) (error "")))) - (bbdb-display-records (list record)) - (if arg - (bbdb-record-edit-property record nil t) - (bbdb-record-edit-notes record t)))) - - -;;;###autoload -(defun bbdb/rmail-show-sender () - "Display the contents of the BBDB for the sender of this message. -This buffer will be in bbdb-mode, with associated keybindings." - (interactive) - (if (and (boundp 'rmail-buffer) rmail-buffer) - (set-buffer rmail-buffer)) - (let ((record (bbdb/rmail-update-record t))) - (if record - (bbdb-display-records (list record)) - (error "unperson")))) - - -(defun bbdb/rmail-pop-up-bbdb-buffer (&optional offer-to-create) - "Make the *BBDB* buffer be displayed along with the RMAIL window(s), -displaying the record corresponding to the sender of the current message." - (bbdb-pop-up-bbdb-buffer - (function (lambda (w) - (let ((b (current-buffer))) - (set-buffer (window-buffer w)) - (prog1 (eq major-mode 'rmail-mode) - (set-buffer b)))))) - (let ((bbdb-gag-messages t) - (bbdb-use-pop-up nil) - (bbdb-electric-p nil)) - (let ((records (bbdb/rmail-update-records offer-to-create)) - (b (current-buffer))) - (if records - (bbdb-display-records records bbdb-pop-up-display-layout) - (bbdb-undisplay-records) - (if (get-buffer-window bbdb-buffer-name) - (delete-window (get-buffer-window bbdb-buffer-name)))) - (set-buffer b) - records))) - -(defun bbdb/rmail-only-expunge () - "Actually erase all deleted messages in the file." - (interactive) - (setq bbdb-message-cache nil) - (bbdb-orig-rmail-only-expunge)) - -(defun bbdb/undigestify-rmail-message () - "Break up a digest message into its constituent messages. -Leaves original message, deleted, before the undigestified messages." - (interactive) - (setq bbdb-message-cache nil) - (bbdb-orig-undigestify-rmail-message)) - -;(defun bbdb-orig-rmail-expunge () -; "This becomes the original rmail-expunge function.") -;(defun bbdb-orig-undigestify-rmail-message () -; "This becomes the original rmail-expunge function.") - -;;;###autoload -(defun bbdb-insinuate-rmail () - "Call this function to hook BBDB into RMAIL." - (define-key rmail-mode-map ":" 'bbdb/rmail-show-sender) - (define-key rmail-mode-map ";" 'bbdb/rmail-edit-notes) - (define-key rmail-summary-mode-map ":" 'bbdb/rmail-show-sender) - (define-key rmail-summary-mode-map ";" 'bbdb/rmail-edit-notes) - - (add-hook 'rmail-show-message-hook 'bbdb/rmail-update-records) - - ;; We must patch into rmail-only-expunge to clear the cache, since expunging a - ;; message invalidates the cache (which is based on message numbers). - ;; Same for undigestifying. - (or (fboundp 'bbdb-orig-rmail-only-expunge) - (defalias 'bbdb-orig-rmail-only-expunge (symbol-function 'rmail-only-expunge))) - (defalias 'rmail-only-expunge 'bbdb/rmail-only-expunge) - - (or (fboundp 'undigestify-rmail-message) - (autoload 'undigestify-rmail-message "undigest" nil t)) - (if (eq (car-safe (symbol-function 'undigestify-rmail-message)) 'autoload) - (load (nth 1 (symbol-function 'undigestify-rmail-message)))) - (or (fboundp 'bbdb-orig-undigestify-rmail-message) - (defalias 'bbdb-orig-undigestify-rmail-message - (symbol-function 'undigestify-rmail-message))) - (defalias 'undigestify-rmail-message 'bbdb/undigestify-rmail-message) - ) - -(provide 'bbdb-rmail) diff --git a/xemacs-packages/lisp/bbdb/bbdb-sc.el b/xemacs-packages/lisp/bbdb/bbdb-sc.el deleted file mode 100644 index 4abd4c86..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-sc.el +++ /dev/null @@ -1,211 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is an addition to the Insidious Big Brother Database -;;; (aka BBDB), copyright (c) 1991, 1992 Jamie Zawinski -;;; . -;;; -;;; The Insidious Big Brother Database is free software; you can redistribute -;;; it and/or modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 1, or (at your -;;; option) any later version. -;;; -;;; BBDB is distributed in the hope that it will be useful, but WITHOUT ANY -;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more -;;; details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - - -;;; This file was written by Martin Sjolin -;;; based the original code by Tom Tromey . -;;; -;;; Thanks to Richard Stanton for ideas -;;; for improvements and to Michael D. Carney -;;; for testing and feedback. - -;;; $Id: bbdb-sc.el,v 1.7 2005/07/24 15:22:58 waider Exp $ - -;;; This file adds the ability to define attributions for Supercite in -;;; a BBDB, enables you to retrieve your standard attribution from -;;; BBDB. If the from header in the mail to which you are replying -;;; only contains the e-mail address, the personal name is lookup in -;;; BBDB. You need Supercite to make this code work. The attribution -;;; os is stored under the key `attribution' (unless you've changed -;;; bbdb/sc-attribution-field). - -;;; To use enable this code you will have to the "sc-consult" to your -;;; sc-preferred-attribution-list. This file sets variable if it is not -;;; set and isues an warning message if "sc-consult" is not included. -;;; -;;; (setq sc-preferred-attribution-list -;;; '("sc-lastchoice" "x-attribution" "sc-consult" -;;; "initials" "firstname" "lastname")) -;;; -;;; -;;; We also set the sc-attrib-selection-list below if is not bound, if -;;; you have your own special sc-attrib-selection-list, please add -;;; an expression as below: -;;; -;;; (setq sc-attrib-selection-list -;;; '(("sc-from-address" ((".*" . (bbdb/sc-consult-attr -;;; (sc-mail-field "sc-from-address"))))))) -;;; -;;; And finally we set the sc-mail-glom-frame to enable the -;;; fetching of the name of person when there is only an e-mail -;;; address in the original mail: -;;; -;;; (setq sc-mail-glom-frame -;;; '((begin (setq sc-mail-headers-start (point))) -;;; ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t) -;;; ("^\\S +:.*$" (sc-mail-fetch-field) nil t) -;;; ("^$" (progn (bbdb/sc-default) -;;; (list 'abort '(step . 0)))) -;;; ("^[ \t]+" (sc-mail-append-field)) -;;; (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) -;;; (end (setq sc-mail-headers-end (point))))) -;;; -;;; - -;;; -;;; - -;;; packages -(require 'bbdb) -(require 'supercite) - -;;; User variable(s) -(defcustom bbdb/sc-replace-attr-p t - "t if you like to create a new BBDB entry when -entering a non-default attribution, 'ask if the user -should be asked before creation and NIL if we never create a new entry." - :group 'bbdb-utilities-supercite - :type '(choice (const "Create a new BBDB entry" t) - (const "Confirm new record creation" ask) - (const "Don't create a new entry" nil))) - -(defcustom bbdb/sc-attribution-field 'attribution - "The BBDB field used for Supercite attribution information." - :group 'bbdb-utilities-supercite - :type '(symbol :tag "Field name")) - -;;; Code starts -(defcustom bbdb/sc-last-attribution "" - "Default attribution return by the SuperCite citation engine, -used to compare against citation selected by the user." - :group 'bbdb-utilities-supercite - :type '(string :tag "Default citation" "")) - -(defun bbdb/sc-consult-attr (from) - "Extract citing information from BBDB using sc-consult where -FROM is user e-mail address to look for in BBDB." - ;; if logged in user sent this, use recipients. - (let ((from (if (or (null from) - (string-match (bbdb-user-mail-names) from)) - (car (cdr (mail-extract-address-components - (or (sc-mail-field "to") from)))) - from))) - (if from - (let ((record (bbdb-search-simple nil from))) - (and record - (bbdb-record-getprop record bbdb/sc-attribution-field)))))) - -(defun bbdb/sc-set-attr () - "Add attribute to BBDB." - (let ((from (sc-mail-field "from")) - (address (sc-mail-field "sc-from-address")) - (attr (sc-mail-field "sc-attribution"))) - (if (and from attr bbdb/sc-replace-attr-p - (not (string-equal attr bbdb/sc-last-attribution)) - (not (string-match (bbdb-user-mail-names) address))) - (let* ((bbdb-notice-hook nil) - ;; avoid noticing any headers in the reply message - (record (bbdb-annotate-message-sender - from t - (bbdb-invoke-hook-for-value - bbdb/mail-auto-create-p) t))) - (if record - (let ((old (bbdb-record-getprop record 'attribution))) - ;; ignore if we have an value and same value - (if (and (not (and old (string-equal old attr))) - (or (not (eq bbdb/sc-replace-attr-p 'ask)) - (y-or-n-p (concat "Change attribution " attr)))) - (progn (bbdb-record-putprop record - bbdb/sc-attribution-field attr) - (bbdb-change-record record nil))))))))) - -;;; this is marked as autoload since someone managed to trip up Gnus -;;; with it. I'm not clear this needs fixing, as you should be calling -;;; bbdb-insinuate-sc if you're using supercite/BBDB. However. -;;;###autoload -(defun bbdb/sc-default () - "If the current \"from\" field in `sc-mail-info' alist -contains only an e-mail address, lookup e-mail address in -BBDB, and prepend a new \"from\" field to `sc-mail-info'." - (let* ((from (sc-mail-field "from")) - (pair (and from (mail-extract-address-components from)))) - (if (and pair (not (car pair))) - (let* ((record (bbdb-search-simple nil (car (cdr pair)))) - (name (and record (bbdb-record-name record)))) - (if name - (setq sc-mail-info - (cons (cons "from" - (format "%s (%s)" (car (cdr pair)) name)) - sc-mail-info))))))) - -;;; setup the default setting of the variables -(defun bbdb/sc-setup-variables () - "Set up the various Supercite variables for the BBDB. -`sc-preferred-attribution-list', `sc-attrib-selection-list', and -`sc-mail-glom-frame' are set, but only if they have not previously -been defined. It is strongly suggested that you not call this -function directly, but that you use this function (specifically the -settings contained herein) as an example. In other words, set these -variables yourself, either in your Emacs configuration file or using -Custom." - - ;; check for sc-consult in sc-preferred-attribution-list - (if (boundp 'sc-preferred-attribution-list) - (or (member '"sc-consult" sc-preferred-attribution-list) - (bbdb-warn (concat "\"sc-consult\" not included in " - "sc-preferred-attribution-list. Attributions cannot" - "be gathered from the BBDB without \"sc-consult\"" - "in sc-preferred-attribution-list"))) - (defvar sc-preferred-attribution-list - '("sc-lastchoice" "x-attribution" "sc-consult" - "initials" "firstname" "lastname"))) - - ;; check sc-attrib-selection-list - (defvar sc-attrib-selection-list - '(("sc-from-address" - ((".*" . (bbdb/sc-consult-attr - (sc-mail-field "sc-from-address"))))))) - - ;; set sc-mail-glom-frame - (defvar sc-mail-glom-frame - '((begin (setq sc-mail-headers-start (point))) - ("^x-attribution:[ \t]+.*$" (sc-mail-fetch-field t) nil t) - ("^\\S +:.*$" (sc-mail-fetch-field) nil t) - ("^$" (progn (bbdb/sc-default) - (list 'abort '(step . 0)))) - ("^[ \t]+" (sc-mail-append-field)) - (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) - (end (setq sc-mail-headers-end (point)))))) - -;; insert our hooks - call me from your Emacs initialization file -(defvar attribution) ;; dammit, supercite! -;;;###autoload -(defun bbdb-insinuate-sc () - "Call this function to hook BBDB into Supercite." - - (add-hook 'sc-post-hook 'bbdb/sc-set-attr) - (add-hook 'sc-attribs-postselect-hook - (function (lambda() - (setq bbdb/sc-last-attribution - (if sc-downcase-p - (downcase attribution) attribution)))))) - -(provide 'bbdb-sc) -;;; end of bbdb-sc.el diff --git a/xemacs-packages/lisp/bbdb/bbdb-snarf.el b/xemacs-packages/lisp/bbdb/bbdb-snarf.el deleted file mode 100644 index ce4a4779..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-snarf.el +++ /dev/null @@ -1,631 +0,0 @@ -;;; bbdb-snarf.el -- convert free-form text to BBDB records - -;;; -;;; Copyright (C) 1997 by John Heidemann . -;;; $Id: bbdb-snarf.el,v 1.7 2005/07/24 15:22:58 waider 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 version 1. -;;; -;;; 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. -;;; - -;;; -;;; bbdb-snarf is code to pick addresses, phones, and such out of a -;;; free-form paragraphs. Things are recognized by context (web pages -;;; start with http:// or www., for example). I wrote it because I -;;; despise fill-in-the-blank forms (a la bbdb-create). (if I wanted -;;; modes, I'd use vi :-). -;;; -;;; Eventually I'd like to be able to replace bbdb-mode with a free-form -;;; text mode where bbdb-snarf merges in any changes you make. -;;; I'm not there yet---merging is not good enough currently. -;;; Currently bbdb-snarf is good for pulling postal addresses -;;; from e-mail messages and converting other databases. -;;; - -(require 'bbdb) -(require 'bbdb-com) -(require 'rfc822) -(require 'mail-extr) - -(defconst bbdb-digit "[0-9]") -(defvar bbdb-snarf-phone-regexp - (concat - "\\(([2-9][0-9][0-9])[-. ]?\\|[2-9][0-9][0-9][-. ]\\)?" - "[0-9][0-9][0-9][-. ][0-9][0-9][0-9][0-9]" - "\\( *\\(x\\|ext\\.?\\) *[0-9]+\\)?" - ) - "regexp to match phones.") -(defvar bbdb-snarf-zip-regexp - (concat - "\\<" - bbdb-digit bbdb-digit bbdb-digit bbdb-digit bbdb-digit - "\\(-" bbdb-digit bbdb-digit bbdb-digit bbdb-digit "\\)?" - "\\>$") - "regexp matching zip.") - -(defcustom bbdb-snarf-web-prop 'www - "What property bbdb should use for the web, or nil to not detect web URLs." - :group 'bbdb - :type 'symbol) - -(defun bbdb-snarf-address-lines () - (let ((lines (bbdb-split (buffer-string) "\n"))) - (if (>= bbdb-file-format 5) nil - (while (< (length lines) 3) - (setq lines (append lines (list nil)))) - (if (> (length lines) 3) - (error "bbdb-snarf-address-lines: too many lines in address."))) - (delete-region (point-min) (point-max)) - lines)) - -(defun bbdb-snarf-make-address - (label address-lines city state zip country) - (if (>= bbdb-file-format 4) - (vector label address-lines city state zip country) - (if (>= bbdb-file-format 3) - (vector label address-lines city state zip) - (vector label - (nth 0 address-lines) - (nth 1 address-lines) - (nth 2 address-lines) - city state zip)))) - -(defun bbdb-snarf-prune-empty-lines () - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*\n" (point-max) t) - (replace-match ""))) - -(defun delete-and-return-region (begin end) - (prog1 - (buffer-substring begin end) - (delete-region begin end))) - -(defun bbdb-snarf-extract-label (default consume-p) - "Extract the label before the point, or return DEFAULT if no label. -If CONSUME-P is set, delete the text, if found." - (interactive "sDefault label: ") - (let ((end (point-marker))) - (skip-chars-backward " \t") - (if (not (= (point) (point-min))) - (forward-char -1)) - (if (looking-at ":") - (let* ((label-end (point)) - (label (delete-and-return-region - (progn (skip-chars-backward "^\n,;") (point)) - label-end))) - (delete-region (point) end) - label) - default))) - -(defun bbdb-snarf-parse-phone-number (phone) - "Fix the bogosity that is `bbdb-snarf-parse-phone-number'. -It doesn't always return a normalized phone number. -For (800) 555-1212 it returns a three element list." - (let ((try (bbdb-parse-phone-number phone))) - (if (= 3 (length try)) - (nconc try '(0))) - try)) - -;;;###autoload -(defun bbdb-snarf (where) - "snarf up a bbdb record WHERE the point is. -We assume things are line-broken and paragraph-bounded. -The name comes first and other fields (address, -phone, email, web pages) are recognized by context. - -Required context: - addresses end with \"City, State ZIP\" or \"City, State\" - phones match bbdb-snarf-phone-regexp - (currently US-style phones) - e-mail addresses have @'s in them - web sites are recognized by http:// or www. - -Address and phone context are currently US-specific; -patches to internationalize these assumptions are welcome. - -\\[bbdb-snarf] is similar to \\[bbdb-whois-sentinel], but less specialized." - (interactive "d") - (bbdb-snarf-region - (progn (goto-char where) (forward-paragraph -1) (point)) - (progn (forward-paragraph 1) (point)))) - -;;;###autoload -(defun bbdb-snarf-region (begin end) - "snarf up a bbdb record in the current region. See `bbdb-snarf' for -more details." - (interactive "r") - - (save-excursion - (let - ((buf (get-buffer-create " *BBDB snarf*")) - (text (buffer-substring-no-properties begin end)) - phones nets web city state zip name address-lines - address-vector notes) - (set-buffer buf) - (erase-buffer) - (insert text) - - ;; toss beginning and trailing space - (goto-char (point-min)) - (while (re-search-forward "^[ \t]+" (point-max) t) - (replace-match "")) - (goto-char (point-min)) - (while (re-search-forward "^\\s +$" (point-max) t) - (replace-match "")) - - ;; first, pick out phone numbers - (goto-char (point-min)) - (while (re-search-forward bbdb-snarf-phone-regexp (point-max) t) - (let (phone - (begin (match-beginning 0)) - (end (match-end 0))) - (goto-char begin) - (forward-char -1) - (if (looking-at "[0-9A-Za-z]") - (goto-char end);; not really phone - (setq phone (bbdb-snarf-parse-phone-number - (delete-and-return-region begin end)) - phones (append phones - (list (vconcat - (list (bbdb-snarf-extract-label - (bbdb-label-completion-default - 'phone) t)) - phone))))))) - - ;; next, web pages - (goto-char (point-min)) - (if (and bbdb-snarf-web-prop - (re-search-forward "\\(http://\\|www\.\\)[^ \t\n]+" - (point-max) t)) - (progn - (setq web (match-string 0) - notes (append notes (list (cons bbdb-snarf-web-prop web)))) - (replace-match ""))) - - ;; next e-mail - (goto-char (point-min)) - (while (re-search-forward "[^ \t\n<]+@[^ \t\n>]+" (point-max) t) - (setq nets (append nets (list (match-string 0)))) - (replace-match "")) - - (bbdb-snarf-prune-empty-lines) - - ;; name - (goto-char (point-min)) - ;; This check is horribly english-centric (I think) - (while (/= (char-syntax (char-after (point))) ?w) - (forward-line 1)) - (re-search-forward "\\(\\sw\\|[ -\.,]\\)*\\sw" nil t) - (setq name (match-string 0)) - (delete-region (match-beginning 0) (match-end 0)) - - ;; address - (goto-char (point-min)) - (cond - ;; city, state zip - ((re-search-forward bbdb-snarf-zip-regexp (point-max) t) - (save-excursion - (save-restriction - (let (mk) - (narrow-to-region (point-min) (match-end 0)) - (goto-char (point-max)) - ;; zip - (re-search-backward bbdb-snarf-zip-regexp (point-min) t) - (setq zip (bbdb-parse-zip-string (match-string 0))) - ;; state - (skip-chars-backward " \t") - (setq mk (point)) - (skip-chars-backward "^ \t,") - (setq state (buffer-substring (point) mk)) - ;; city - (skip-chars-backward " \t,") - (setq mk (point)) - (beginning-of-line) - (setq city (buffer-substring (point) mk)) - ;; toss it - (forward-char -1) - (delete-region (point) (point-max)) - ;; address lines - (goto-char (point-min)) - (setq address-lines (bbdb-snarf-address-lines) - address-vector (list (bbdb-snarf-make-address - (bbdb-label-completion-default - 'address) - address-lines - city - state - zip - "";; FIXME: snarf country - ))))))) - ;; try for just city, state - ((re-search-forward "^\\(.*\\), \\([A-Z][A-Za-z]\\)$" - (point-max) t) - (save-excursion - (save-restriction - (setq city (match-string 1) - state (match-string 2)) - (narrow-to-region (point-min) (match-end 0)) - (goto-char (point-min)) - (setq address-lines (bbdb-snarf-address-lines) - address-vector (list (bbdb-snarf-make-address - "address" - address-lines - city - state - 0 - "";; FIXME: snarf country - )))))) - (t - (setq address-lines '(nil nil nil) - address-vector nil))) - - ;; anything else -> notes - (bbdb-snarf-prune-empty-lines) - (if (/= (point-min) (point-max)) - (setq notes (append notes (list (cons 'notes (buffer-string)))))) - - ;; debug - ; (goto-char (point-max)) - ; (insert "\n\n" - ; "name: " name "\n" - ; "city: " city "\n" - ; "state: " state "\n" - ; "zip: " zip "\n") - (bbdb-merge-interactively name - nil - nets - address-vector - phones - notes)))) - - -; (setq bbdb-snarf-test-cases " -; -; another test person -; 1234 Gridley St. -; Los Angeles, CA 91342 -; 555-1212 -; test@person.net -; http://www.foo.bar/ -; other stuff about this person -; -; test person -; 1234 Gridley St. -; St. Los Angeles, CA 91342-1234 -; 555-1212 -; test@person.net -; -; x test person -; 1234 Gridley St. -; Los Angeles, California 91342-1234 -; 555-1212 -; test@person.net -; -; y test person -; 1234 Gridley St. -; Los Angeles, CA -; 555-1212 -; test@person.net -; " -; "some test cases") - - - -(defun bbdb-merge-interactively (name company nets addrs phones notes) - "Interactively add a new record; arguments same as \\[bbdb-create-internal]." - (let* - ((f-l-name (bbdb-divide-name name)) - (firstname (car f-l-name)) - (lastname (nth 1 f-l-name)) - (aka nil) - (new-record - (vector firstname lastname aka company phones addrs - (if (listp nets) nets (list nets)) notes - (make-vector bbdb-cache-length nil))) - (old-record (bbdb-search-simple name nets))) - (if old-record - (progn - (setq new-record (bbdb-merge-internally old-record new-record)) - (bbdb-delete-record-internal old-record))) - ;; create new record - (bbdb-invoke-hook 'bbdb-create-hook new-record) - (bbdb-change-record new-record t) - (bbdb-hash-record new-record) - (bbdb-display-records (list new-record)))) - -(defun bbdb-merge-internally (old-record new-record) - "Merge two records. NEW-RECORDS wins over OLD in cases of ties." - (if (and (null (bbdb-record-firstname new-record)) - (bbdb-record-firstname old-record)) - (bbdb-record-set-firstname new-record (bbdb-record-firstname old-record))) - (if (and (null (bbdb-record-lastname new-record)) - (bbdb-record-lastname old-record)) - (bbdb-record-set-lastname new-record (bbdb-record-lastname old-record))) - (if (and (null (bbdb-record-company new-record)) - (bbdb-record-company old-record)) - (bbdb-record-set-company new-record (bbdb-record-company old-record))) - ;; nets - (let ((old-nets (bbdb-record-net old-record)) - (new-nets (bbdb-record-net new-record))) - (while old-nets - (if (not (member (car old-nets) new-nets)) - (setq new-nets (append new-nets (list (car old-nets))))) - (setq old-nets (cdr old-nets))) - (bbdb-record-set-net new-record new-nets)) - ;; addrs - (let ((old-addresses (bbdb-record-addresses old-record)) - (new-addresses (bbdb-record-addresses new-record))) - (while old-addresses - (if (not (member (car old-addresses) new-addresses)) - (setq new-addresses (append new-addresses (list (car old-addresses))))) - (setq old-addresses (cdr old-addresses))) - (bbdb-record-set-addresses new-record new-addresses)) - ;; phones - (let ((old-phones (bbdb-record-phones old-record)) - (new-phones (bbdb-record-phones new-record))) - (while old-phones - (if (not (member (car old-phones) new-phones)) - (setq new-phones (append new-phones (list (car old-phones))))) - (setq old-phones (cdr old-phones))) - (bbdb-record-set-phones new-record new-phones)) - ;; notes - (let ((old-notes (bbdb-record-raw-notes old-record)) - (new-notes (bbdb-record-raw-notes new-record))) - (while old-notes - (if (not (member (car old-notes) new-notes)) - (setq new-notes (append new-notes (list (car old-notes))))) - (setq old-notes (cdr old-notes))) - (bbdb-record-set-raw-notes new-record new-notes)) - ;; return - new-record) - -;;---------------------------------------------------------------------------- -(eval-and-compile - (if (fboundp 'replace-in-string) - (fset 'bbdb-replace-in-string 'replace-in-string) - (if (fboundp 'replace-regexp-in-string) ; defined in e21 - (fset 'bbdb-replace-regexp-in-string 'replace-regexp-in-string) - ;; actually this is `dired-replace-in-string' slightly modified - ;; We're not defining the whole thing, just enough for our purposes. - (defun bbdb-replace-regexp-in-string (regexp newtext string &optional - fixedcase literal) - ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result. - ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. - (let ((result "") (start 0) mb me) - (while (string-match regexp string start) - (setq mb (match-beginning 0) - me (match-end 0) - result (concat result (substring string start mb) newtext) - start me)) - (concat result (substring string start))))) - (defun bbdb-replace-in-string (string regexp newtext &optional literal) - (bbdb-replace-regexp-in-string regexp newtext string nil literal)))) - -(defcustom bbdb-extract-address-components-func - 'bbdb-rfc822-addresses - "Function called to parse one or more email addresses. -See bbdb-extract-address-components for an example." - :group 'bbdb-noticing-records - :type 'function) - -(defcustom bbdb-extract-address-component-regexps - '( -;; This was part of Dave Love's patch. Alas, it appears to break the -;; very thing it is supposed to handle, viz. unwrapping "Last, First" -;; into "First Last". Thusly, commented out for now. The unwrapping -;; seems to work fine without it? -;; -;; "surname, firstname"
from Outlookers -;; ("\"\\([^\"]*\\)\"\\s-*<\\([^>]+\\)>" -;; (bbdb-clean-username (match-string 1 adstring)) 2) - ;; "name"
- ("\"\\([^\"]*\\)\"\\s-*<\\([^>]+\\)>" - (car (mail-extract-address-components - (concat "\"" (match-string 1 adstring) "\""))) - 2) - ;; name
- ("\\([^<>,\t][^<>,]+[^<>, \t]\\)\\s-*<\\([^>]+\\)>" - 1 2) - ;;
- ("<\\([^>,]+\\)>" nil 1) - ;; address (name) - ("\\(\\b[^<\",()]+\\b\\)\\s-*(\\([^)]+\\))" - (car (mail-extract-address-components - (concat "\"" (match-string 2 adstring) "\""))) - 1) - ;; firstname.lastname@host - ("\\b\\(\\([^@ \t\n.]+\\.[^@ \t\n.]+\\)@[^@ \t\n]+\\)\\b" - (car (mail-extract-address-components - (concat "\"" (match-string 2 adstring) "\""))) - 1) - ;; user@host - ("\\b\\(\\([^@ \t\n]+\\)@[^@ \t\n]+\\)\\b" - nil 1) - ;; localaddress - ("\\b\\([^@ \t\n]+\\)\\b" - nil 1) - ) - "*List of regexps matching headers. -Each list element should have the form (REGEXP FULLNAME ADDRESS), where -REGEXP matches the address while the actual address components should -be a parenthesized expression. - -FULLNAME is a default string for addresses without full name or a -number denoting parenthesized expression. -ADDRESS is a number denoting the parenthesized expression matching the -address. - -If FULLNAME or ADDRESS is a list it will be evaluated to return a -string or nil. If its a function it will be called with the remaining -address-string as argument." - :group 'bbdb-noticing-records - :type 'list) - -(defcustom bbdb-extract-address-component-ignore-regexp - "\\(\\(undisclosed\\|unlisted\\)[^,]*recipients\\)\\|no To-header on input" - "*A regexp matching addresses which should be ignored." - :group 'bbdb-noticing-records - :type 'string) - -(defcustom bbdb-extract-address-component-handler 'message - "*Specifies how `bbdb-extract-address-components' reports errors. - -A value of nil means ignore unparsable stuff and 'warn will report -a warning, 'message will report a message in the minibuffer and all -other value will fire a error. - -When set to a function it will be called with the remaining string in -order to extract the address components and return the rest and the -components as list or to do what ever it wants, e.g. send a complain -to the author ... - -To skip known unparseable stuff you rather should set the variable -`bbdb-extract-address-component-ignore-regexp' instead of disabling -this handler." - :group 'bbdb-noticing-records - :type '(choice (const :tag "Ignore problems." - nil) - (const :tag "Warn about parsing problems." - 'warn) - (const :tag "Show a message about parsing problems." - 'message) - (function :tag "A user defined handler"))) - -;;;###autoload -(defun bbdb-extract-address-components (adstring &optional ignore-errors) - "Return a list of address components found in ADSTRING. -If extracting fails one probably has to adjust the variable -`bbdb-extract-address-component-regexps'." - (let ((case-fold-search t) - (fnadlist nil) - adcom-regexp - nomatch) - - ;; Do some string cleanup and trimming - (setq adstring (bbdb-replace-in-string adstring "[\n\t]" " ")) - (setq adstring (bbdb-replace-in-string adstring " " " ")) - (setq adstring (bbdb-replace-in-string adstring "^ +" "")) - - ;; scan the string - (while (not (string= "" adstring)) - (setq adcom-regexp bbdb-extract-address-component-regexps - nomatch t) - (while adcom-regexp - (let ((regexp (caar adcom-regexp)) - (fn (car (cdar adcom-regexp))) - (ad (cadr (cdar adcom-regexp)))) - (cond ((string-match - (concat "^[^,]*\\(" - bbdb-extract-address-component-ignore-regexp - "\\)[^,]*\\(,\\|$\\)") - adstring) - (setq adstring (substring adstring (match-end 0)) - adcom-regexp nil - nomatch nil)) - ((string-match (concat "^\\s-*" regexp "\\s-*\\(,\\|$\\)") - adstring) - (add-to-list 'fnadlist - (list (let ((n - (cond ((numberp fn) - (match-string fn adstring)) - ((listp fn) - (save-match-data (eval fn))) - ((functionp fn) - (save-match-data - (funcall fn adstring))) - (t fn)))) - (if (string= n "") - nil - n)) - (let ((a - (cond ((numberp ad) - (match-string ad adstring)) - ((listp ad) - (save-match-data (eval ad))) - ((functionp ad) - (save-match-data - (funcall ad adstring))) - (t ad)))) - (if (string= a "") - nil - a)))) -; (save-match-data -; (message "%S Match on %S to\n\t%S" -; regexp adstring fnadlist)) - (setq adstring (substring adstring (match-end 0)) - adcom-regexp nil - nomatch nil))) - (setq adcom-regexp (cdr adcom-regexp)))) - - ;; Now handle problems - (if (and nomatch (not ignore-errors)) - (cond ((equal bbdb-extract-address-component-handler nil)) - ((equal bbdb-extract-address-component-handler 'warn) - (bbdb-warn "Cannot extract an address component at \"%s\". -See `bbdb-extract-address-component-handler' for more information." - adstring)) - ((equal bbdb-extract-address-component-handler 'message) - (message "Cannot extract an address component at \"%s\"." - adstring)) - ((functionp bbdb-extract-address-component-handler) - (let ((result - (funcall bbdb-extract-address-component-handler - adstring))) - (if (and (listp result) (= 3 (length result))) - (progn (add-to-list 'fnadlist (cdr result)) - (setq adstring (car result) - nomatch nil))))) - (t - (error "Cannot extract an address component at \"%30s\"" - adstring)))) - - ;; ignore the bad junk - (if nomatch - (if (string-match "^[^,]*," adstring) - (setq adstring (substring adstring (match-end 0))) - (setq adstring "")))) - - (delete '(nil nil) (nreverse fnadlist)))) - -;;; alternative name parser -;;;###autoload -(defun bbdb-rfc822-addresses ( addrline &optional ignore-errors) - "Split ADDRLINE into a list of parsed addresses. - -You can't do this with rfc822.el in any sort of useful way because it discards -the comments. You can't do this with mail-extr.el because the multiple address -parsing in GNU Emacs appears to be broken beyond belief, and the XEmacs -version doesn't support multiple addresses." - (let (addrs (start 0)) - (setq addrline (concat addrline ",")) ;; kludge, to make parsing easier - ;; Addresses are separated by commas. This is probably the worst - ;; possible way to do this, but it does cut down on the amount of - ;; coding effort I have to duplicate. Basically, we split on - ;; commas, and then try and parse what we've found. Pathologically - ;; bad address lines will break this. - (while (string-match "\\([^,]+\\)," addrline start) - (let* ((thisaddr (substring addrline 0 (match-end 1))) - (comma (match-end 0)) ;; rfc822-addresses trashes match-data - (parsed (rfc822-addresses thisaddr))) - (if (string-match "(" (or (car parsed) "")) ;; rfc822 didn't like it. - (setq start comma) - (setq addrs - (append addrs (list - (mail-extract-address-components - thisaddr))) - ;; throw away what we just parsed - addrline (substring addrline comma) - start 0)))) - addrs)) - -(provide 'bbdb-snarf) diff --git a/xemacs-packages/lisp/bbdb/bbdb-srv.el b/xemacs-packages/lisp/bbdb/bbdb-srv.el deleted file mode 100644 index 416606a5..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-srv.el +++ /dev/null @@ -1,288 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is the part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1995 Jamie Zawinski . -;;; Invoking BBDB from another process, via `gnudoit'. -;;; See the file bbdb.texinfo for documentation. -;;; -;;; The Insidious Big Brother Database 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. -;;; -;;; BBDB 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. - -;; -;; $Id: bbdb-srv.el,v 1.8 2005/07/24 15:22:58 waider Exp $ - -;;; This requires the `gnuserv' and `itimer' packages. -;;; -;;; To use: -;;; -;;; First, do `(gnuserv-start)' to initialize the emacs server process. -;;; If you don't know what this does, see the doc for gnuserv.el. -;;; -;;; Then, an external process may invoke `gnudoit' in the following way: -;;; -;;; gnudoit '(bbdb-server "...all message headers..")' -;;; -;;; The bbdb-srv.perl program is a good choice for this; it takes a header -;;; block on stdin, and converts them to a lisp string, taking care to -;;; "sanitize" them so that hostile data can't take over the executing shell. -;;; -;;; The string should be a validly-formatted-and-quoted lisp string, and -;;; should contain multiple lines, which are the headers of the message for -;;; which a record should be displayed. It should contain at least a "From:" -;;; header, or nothing will be displayed, but it should contain as many headers -;;; as your various BBDB hooks might want access to. -;;; -;;; Records will not be displayed until no record has been requested for -;;; `bbdb/srv-display-delay' seconds (default 2.) This is to prevent rapid -;;; display of records from queueing up and swamping the emacs server process. -;;; -;;; Note that in order for this to build, itimer.el and gnuserv.el must be in -;;; the build-path. The easiest way to achieve this is to set OTHERDIR to point -;;; to the directory/ies they're in. - -;;; A trivial application of this is the shell command: -;;; -;;; echo 'From: Jamie Zawinski ' | bbdb-srv.perl -;;; -;;; which will cause the corresponding record to be displayed. -;;; A more interesting application of this is: -;;; -;;; setenv NS_MSG_DISPLAY_HOOK bbdb-srv.perl -;;; -;;; which will hook BBDB up to Mozilla (Unix Netscape Mail and Netscape News -;;; versions 3.0b2 and later only.) - -(require 'bbdb) -(require 'bbdb-com) -(require 'bbdb-hooks) - - -(eval-when-compile - (require 'mail-utils) ;; for mail-strip-quoted-names - (require 'bbdb-gui) ;; for extents macros - (if (featurep 'xemacs) - () - (fset 'set-keymap-name 'ignore) - (fset 'frame-lowest-window 'ignore))) - -;; newer version of gnuserv requires gnuserv-compat when using FSF emacs -;; but you might be using an older version, and we can't tell until you -;; crash it... -(or (fboundp 'define-obsolete-variable-alias) - (if (locate-library "gnuserv-compat") - (require 'gnuserv-compat))) -(require 'gnuserv) -(require 'itimer) - -(defcustom bbdb/srv-auto-create-p nil - "*Like `bbdb/news-auto-create-p' and `bbdb/mail-auto-create-p', -but for the case where the record is being displayed by some external -process via the `gnudoit' mechanism. - -If this is t, then records will automatically be created; if this is a -function name or lambda, then it is called with no arguments to decide -whether an entry should be automatically created. You can use this to, -for example, create or not create messages which have a particular subject. - -`bbdb/srv-auto-create-mail-news-dispatcher' is a good value for this -- -that function will try to decide if this is a mail message or a news -message, and then run either `bbdb/news-auto-create-p' or -`bbdb/mail-auto-create-p' as appropriate." - :group 'bbdb-utilities-server - :type '(choice (const :tag "Don't automatically create records" nil) - (const :tag "Automatically create records" t) - (sexp :tag "Use function to determine record creation" - bbdb/srv-auto-create-mail-news-dispatcher))) - -(defcustom bbdb/srv-display-delay 2 - "*How long (in seconds) we must be idle before displaying a record." - :group 'bbdb-utilities-server - :type 'integer) - -(defvar bbdb/srv-pending-headers nil) -(defvar bbdb/srv-pending-map - (and (fboundp 'bbdb-set-extent-property) - (condition-case nil - (let ((m (make-sparse-keymap))) - (set-keymap-name m 'bbdb/srv-pending-map) - (define-key m 'button1 'bbdb/srv-pending-add) - m) - (error nil)))) - -(defun bbdb/srv-handle-headers (headers &optional create-p) - "Display (or create) the BBDB entry corresponding to the message headers. -HEADERS should be a string containing an RFC822 header block; at least a -\"From:\" header should be provided, but others will be made available to -the various hooks (like `bbdb-notice-hook' and `bbdb/news-auto-create-p')." - (let ((buf "*bbdb-tmp*") - (record nil) - (bbdb-force-dialog-boxes t) ; affects bbdb-y-or-n-p - from) - (save-excursion - (set-buffer (or (get-buffer buf) - (progn - (setq buf (get-buffer-create buf)) - (set-buffer buf) - (buffer-disable-undo buf) - buf))) - (erase-buffer) - (insert headers "\n\n") - (setq from (mail-fetch-field "from")) - (if (or (null from) - (string-match (bbdb-user-mail-names) - (mail-strip-quoted-names from))) - ;; if logged-in user sent this, use recipients. - (setq from (or (mail-fetch-field "to") from))) - (if from - (setq record - (bbdb-annotate-message-sender from t - (or create-p - (bbdb-invoke-hook-for-value - bbdb/srv-auto-create-p)) - nil)))) - (let ((w (get-buffer-window bbdb-buffer-name))) - (if w - nil - (setq w (selected-window)) - (unwind-protect - (progn - (if (fboundp 'frame-lowest-window) - (select-window (frame-lowest-window))) - (bbdb-pop-up-bbdb-buffer)) - (select-window w)) - (setq w (get-buffer-window bbdb-buffer-name)) - (if (fboundp 'set-window-dedicated-p) - (set-window-dedicated-p w bbdb-buffer-name)))) - (cond (record - (let ((bbdb-gag-messages t) - (bbdb-use-pop-up nil) - (bbdb-electric-p nil) - (b (current-buffer))) - (save-window-excursion ;; needed to get around XEmacs 19.15 bug? - (bbdb-display-records (list record)) bbdb-pop-up-display-layout) - (set-buffer b))) - ((and from (not create-p) bbdb/srv-pending-map) - (setq bbdb/srv-pending-headers headers) - (save-excursion - (set-buffer bbdb-buffer-name) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert "\t\t\t") - (let ((p (point)) - e) - (insert from) - (setq e (bbdb-make-extent p (point))) - (bbdb-set-extent-face e 'bold) - (bbdb-set-extent-property e 'highlight t) - (bbdb-set-extent-property e 'keymap bbdb/srv-pending-map) - ) - (insert "\n\n\t\t\tClick to add to BBDB.") - )))))) - -(defun bbdb/srv-pending-add () - (interactive "@") - (or bbdb/srv-pending-headers (error "lost headers?")) - (bbdb/srv-handle-headers bbdb/srv-pending-headers t)) - - -(defvar bbdb/srv-itimer-arg nil) -(defun bbdb/srv-itimer () - "Used as a timer function by bbdb/srv-handle-headers-with-delay. -This invokes bbdb/srv-handle-headers with bbdb/srv-itimer-arg. -We do it this way instead of by using a lambda to start-itimer so that -we cons less." - (defvar current-itimer) - (if current-itimer (delete-itimer current-itimer)) - (if bbdb/srv-itimer-arg - (bbdb/srv-handle-headers - (prog1 bbdb/srv-itimer-arg - (setq bbdb/srv-itimer-arg nil))))) - -;;;###autoload -(defun bbdb/srv-handle-headers-with-delay (headers) - "Just like bbdb/srv-handle-headers, but only updates every few seconds. -This is so that trying to display many records in succession won't queue them -up, but will end up only displaying a record when no displays have been -requested for a couple of seconds." - (let* ((name "bbdb-srv") - (itimer (get-itimer name))) - (setq bbdb/srv-itimer-arg headers) - (if itimer - ;; It hasn't gone off yet; just change what it's argument will be. - nil - ;; else, start the timer going again. - (start-itimer name 'bbdb/srv-itimer bbdb/srv-display-delay nil)) - nil)) - -;;;###autoload -(defalias 'bbdb-srv 'bbdb/srv-handle-headers-with-delay) - -(autoload 'bbdb-header-start "bbdb-hooks") - -;;;###autoload -(defun bbdb/srv-auto-create-mail-news-dispatcher () - "For use as the value of bbdb/srv-auto-create-p. -This will try to decide if this is a mail message or a news message, and then -run either bbdb/news-auto-create-p or bbdb/mail-auto-create-p as appropriate. -\(The heuristic is that news messages never have a Status or X-Mozilla-Status -header; and that mail messages never have Path headers.)" - (let (mail-p) - (save-excursion - (let ((start (bbdb-header-start))) - (set-buffer (marker-buffer start)) - (setq mail-p - (cond ((progn (goto-char start) - (bbdb-extract-field-value "Status")) - t) - ((progn (goto-char start) - (bbdb-extract-field-value "X-Mozilla-Status")) - t) - ((progn (goto-char start) - (bbdb-extract-field-value "Path")) - nil) - (t t))))) ; can't tell -- guess mail. - (bbdb-invoke-hook-for-value - (if mail-p bbdb/mail-auto-create-p bbdb/news-auto-create-p)))) - - -;; For caller-id stuff -;;;###autoload -(defun bbdb-srv-add-phone (phone-string &optional description record) - (let ((phone (make-vector (if bbdb-north-american-phone-numbers-p - bbdb-phone-length - 2) - nil))) - (setq record (if (stringp record) - (or (bbdb-search-simple record "") - (bbdb-create-internal record nil nil nil nil nil)) - (bbdb-completing-read-record - (format "Add %s to: " phone-string)))) - (if (= 2 (length phone)) - (aset phone 1 phone-string) - (let ((newp (bbdb-parse-phone-number phone-string))) - (bbdb-phone-set-area phone (nth 0 newp)) - (bbdb-phone-set-exchange phone (nth 1 newp)) - (bbdb-phone-set-suffix phone (nth 2 newp)) - (bbdb-phone-set-extension phone (or (nth 3 newp) 0)))) - (bbdb-phone-set-location phone - (or description - (read-string "Phone number description: " - "cid"))) - (bbdb-record-set-phones record - (nconc (bbdb-record-phones record) (list phone))) - (bbdb-change-record record nil) - (bbdb-display-records (list record)) - record)) - -(provide 'bbdb-srv) diff --git a/xemacs-packages/lisp/bbdb/bbdb-vm.el b/xemacs-packages/lisp/bbdb/bbdb-vm.el deleted file mode 100644 index 52fc2fb1..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-vm.el +++ /dev/null @@ -1,432 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- - -;;; This file is the part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; Interface to VM (View Mail) 5.31 or greater. See bbdb.texinfo. - -;;; The Insidious Big Brother Database is free software; you can redistribute -;;; it and/or modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 1, or (at your -;;; option) any later version. -;;; -;;; BBDB 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. - -;; -;; $Id: bbdb-vm.el,v 1.7 2005/07/24 15:22:58 waider Exp $ -;; - -(eval-and-compile - (require 'cl) - (require 'bbdb) - (require 'bbdb-com) - (require 'bbdb-snarf) - (require 'vm-autoload) - (require 'vm) - - (if (not (fboundp 'vm-record-and-change-message-pointer)) - (load-library "vm-motion")) - (if (not (fboundp 'vm-su-from)) - (load-library "vm-summary")) - (or (boundp 'vm-mode-map) - (load-library "vm-vars"))) - -(defun bbdb/vm-get-header-content (header-field msg) - (let ((content (vm-get-header-contents msg (concat header-field ":")))) - (if content - (vm-decode-mime-encoded-words-in-string content)))) - -(defcustom bbdb/vm-update-records-mode - '(if (vm-new-flag msg) 'annotating 'searching) - "Controls how `bbdb/vm-update-records' processes email addresses. -Set this to an expression which evaluates either to 'searching or -'annotating. When set to 'annotating email addresses will be fed to -`bbdb-annotate-message-sender' in order to update existing records or create -new ones. A value of 'searching will search just for existing records having -the right net. - -The default is to annotate only new messages." - :group 'bbdb-mua-specific-vm - :type '(choice (const :tag "annotating all messages" - annotating) - (const :tag "annotating no messages" - searching) - (const :tag "annotating only new messages" - (if (vm-new-flag msg) 'annotating 'searching)) - (sexp :tag "user defined"))) - -;;;###autoload -(defun bbdb/vm-update-record (&optional offer-to-create) - (let* ((bbdb-get-only-first-address-p t) - (records (bbdb/vm-update-records offer-to-create))) - (if records (car records) nil))) - -;;;###autoload -(defun bbdb/vm-update-records (&optional offer-to-create) - "Returns the records corresponding to the current VM message, -creating or modifying them as necessary. A record will be created if -bbdb/mail-auto-create-p is non-nil or if OFFER-TO-CREATE is true, and -the user confirms the creation. - -The variable `bbdb/vm-update-records-mode' controls what actions -are performed and it might override `bbdb-update-records-mode'. - -When hitting C-g once you will not be asked anymore for new people listed -in this message, but it will search only for existing records. When hitting -C-g again it will stop scanning." - (vm-select-folder-buffer) - (vm-check-for-killed-summary) - (vm-error-if-folder-empty) - (let ((msg (car vm-message-pointer)) - (enable-local-variables t) ; ...or vm bind this to nil. - (inhibit-quit nil) ; vm better not bind this to t! - (bbdb/vm-offer-to-create offer-to-create) - cache records) - - ;; ignore cache if we may be creating a record, since the cache - ;; may otherwise tell us that the user didn't want a record for - ;; this person. - (if (not bbdb/vm-offer-to-create) - (setq cache (and msg (bbdb-message-cache-lookup msg)))) - - (if cache - (setq records (if bbdb-get-only-first-address-p - (list (car cache)) - cache)) - - (let ((bbdb-update-records-mode (or bbdb/vm-update-records-mode - bbdb-update-records-mode))) - (setq records (bbdb-update-records - (bbdb-get-addresses bbdb-get-only-first-address-p - vm-summary-uninteresting-senders - 'bbdb/vm-get-header-content - (vm-real-message-of msg)) - bbdb/mail-auto-create-p - offer-to-create)) - - (bbdb-encache-message msg records))) - records)) - -;;;###autoload -(defun bbdb/vm-annotate-sender (string &optional replace) - "Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message. If REPLACE is non-nil, -replace the existing notes entry (if any)." - (interactive - (list (if bbdb-readonly-p - (error "The Insidious Big Brother Database is read-only.") - (read-string "Comments: ")))) - (vm-follow-summary-cursor) - (let ((record (or (bbdb/vm-update-record t) (error "unperson")))) - (bbdb-annotate-notes record string 'notes replace))) - -(defun bbdb/vm-edit-notes (&optional arg) - "Edit the notes field or (with a prefix arg) a user-defined field -of the BBDB record corresponding to the sender of this message." - (interactive "P") - (vm-follow-summary-cursor) - (let ((record (or (bbdb/vm-update-record t) (error "unperson")))) - (bbdb-display-records (list record)) - (if arg - (bbdb-record-edit-property record nil t) - (bbdb-record-edit-notes record t)))) - -;;;###autoload -(defun bbdb/vm-show-records (&optional address-class) - "Display the contents of the BBDB for the sender of this message. -This buffer will be in bbdb-mode, with associated keybindings." - (interactive) - (vm-follow-summary-cursor) - (let ((bbdb-get-addresses-headers - (if address-class - (list (assoc address-class bbdb-get-addresses-headers)) - bbdb-get-addresses-headers)) - (bbdb/vm-update-records-mode 'annotating) - (bbdb-message-cache nil) - ;; should we move this to bbdb/vm-show-sender? - (bbdb-user-mail-names nil) - (vm-summary-uninteresting-senders nil) - records) - (setq records (bbdb/vm-update-records t)) - (if records - (bbdb-display-records records) - (bbdb-undisplay-records)) - records)) - -;;;###autoload -(defun bbdb/vm-show-all-recipients () - "Show all recipients of this message. Counterpart to `bbdb/vm-show-sender'." - (interactive) - (let ((bbdb-get-only-first-address-p nil)) - (bbdb/vm-show-records 'recipients))) - -;;;###autoload -(defun bbdb/vm-show-sender (&optional show-recipients) - "Display the contents of the BBDB for the senders of this message. -With a prefix argument show the recipients instead, -with two prefix arguments show all records. -This buffer will be in `bbdb-mode', with associated keybindings." - (interactive "p") - (cond ((= 4 show-recipients) - (bbdb/vm-show-all-recipients)) - ((= 16 show-recipients) - (let ((bbdb-get-only-first-address-p nil)) - (bbdb/vm-show-records))) - (t - (if (null (bbdb/vm-show-records 'authors)) - (bbdb/vm-show-all-recipients))))) - -(defun bbdb/vm-pop-up-bbdb-buffer (&optional offer-to-create) - "Make the *BBDB* buffer be displayed along with the VM window(s). -Displays the records corresponding to the sender respectively -recipients of the current message. -See `bbdb/vm-get-addresses-headers' and 'bbdb-get-only-first-address-p' for -configuration of what is being displayed." - (save-excursion - (let ((bbdb-gag-messages t) - (bbdb-electric-p nil) - (records (bbdb/vm-update-records offer-to-create)) - (bbdb-buffer-name bbdb-buffer-name)) - - (when (and bbdb-use-pop-up records) - (bbdb-pop-up-bbdb-buffer - (function (lambda (w) - (let ((b (current-buffer))) - (set-buffer (window-buffer w)) - (prog1 (eq major-mode 'vm-mode) - (set-buffer b)))))) - - ;; Always update the records; if there are no records, empty the - ;; BBDB window. This should be generic, not VM-specific. - (bbdb-display-records records bbdb-pop-up-display-layout)) - - (when (not records) - (bbdb-undisplay-records) - (if (get-buffer-window bbdb-buffer-name) - (delete-window (get-buffer-window bbdb-buffer-name))))))) - - -;; By Alastair Burt -;; vm 5.40 and newer support a new summary format, %U, to call -;; a user-provided function. Use "%-17.17UB" instead of "%-17.17F" to -;; have your VM summary buffers display BBDB's idea of the sender's full -;; name instead of the name (or lack thereof) in the message itself. - -(defun vm-summary-function-B (m &optional to-p) - "Given a VM message returns the BBDB name of the sender. -Respects vm-summary-uninteresting-senders." - (if (and vm-summary-uninteresting-senders (not to-p)) - (let ((case-fold-search nil)) - (if (string-match vm-summary-uninteresting-senders (vm-su-from m)) - (concat vm-summary-uninteresting-senders-arrow - (vm-summary-function-B m t)) - (or (bbdb/vm-alternate-full-name (vm-su-from m)) - (vm-su-full-name m)))) - (or (bbdb/vm-alternate-full-name (if to-p (vm-su-to m) (vm-su-from m))) - (vm-decode-mime-encoded-words-in-string - (if to-p (vm-su-to-names m) (vm-su-full-name m)))))) - -(defun bbdb/vm-alternate-full-name (address) - (if address - (let ((entry (bbdb-search-simple - nil - (if (and address bbdb-canonicalize-net-hook) - (bbdb-canonicalize-address address) - address)))) - (if entry - (or (bbdb-record-getprop entry 'mail-name) - (bbdb-record-name entry)))))) - - -;; From: Mark Thomas -;; Subject: auto-folder-alist from bbdb - -;;;###autoload -(defcustom bbdb/vm-set-auto-folder-alist-field 'vm-folder - "*The field which `bbdb/vm-set-auto-folder-alist' searches for." - :group 'bbdb-mua-specific-vm - :type 'symbol) - -;;;###autoload -(defcustom bbdb/vm-set-auto-folder-alist-headers '("From:" "To:" "CC:") - "*The headers used by `bbdb/vm-set-auto-folder-alist'. -The order in this list is the order how matching will be performed!" - :group 'bbdb-mua-specific-vm - :type '(repeat (string :tag "header name"))) - -;;;###autoload -(defun bbdb/vm-set-auto-folder-alist () - "Create a `vm-auto-folder-alist' according to the records in the bbdb. -For each record that has a 'vm-folder' attribute, add an -element (email-regexp . folder) to the `vm-auto-folder-alist'. - -The element gets added to the 'element-name' sublist of the -`vm-auto-folder-alist'. - -The car of the element consists of all the email addresses for the -bbdb record concatenated with OR; the cdr is the value of the -vm-folder attribute. - -If the first character of vm-folders value is a quote ' it will be -parsed as lisp expression and is evaluated to return a folder name, -e.g. define you own function `my-folder-name' and set it to - '(my-folder-name)" - (interactive) - (let* (;; we add the email-address/vm-folder-name pair to this - ;; sublist of the vm-auto-folder-alist variable - (headers (reverse bbdb/vm-set-auto-folder-alist-headers)) - header - ;; grab the folder list from the vm-auto-folder-alist - folder-list - ;; the raw-notes and vm-folder attributes of the current bbdb - ;; record - notes-field folder - ;; a regexp matching all the email addresses from the bbdb - ;; record - email-regexp - ;; - records) - - (setq records - (delete - nil - (mapcar (lambda (r) - (let ((notes (bbdb-record-raw-notes r))) - (if (and notes - (assq bbdb/vm-set-auto-folder-alist-field - notes)) - r - nil))) - (bbdb-records)))) - - (while headers - (setq header (car headers) headers (cdr headers)) - ;; create the folder-list in vm-auto-folder-alist if it doesn't exist - (setq folder-list (assoc header vm-auto-folder-alist)) - (unless folder-list - (setq vm-auto-folder-alist (cons (list header) - vm-auto-folder-alist) - folder-list (assoc header vm-auto-folder-alist))) - (mapcar - (lambda (r) - (setq notes-field (bbdb-record-raw-notes r)) - (when (and (listp notes-field) - (setq folder (cdr (assq bbdb/vm-set-auto-folder-alist-field - notes-field)))) - ;; quote all the email addresses for the record and join them - ;; with OR - (setq email-regexp (regexp-opt (bbdb-record-net r))) - (unless (or (zerop (length email-regexp)) - (assoc email-regexp folder-list)) - ;; be careful: nconc modifies the list in place - (if (equal (elt folder 0) ?\') - (setq folder (read (substring folder 1)))) - (nconc folder-list (list (cons email-regexp folder)))))) - records)))) - - -;;; bbdb/vm-auto-add-label -;;; Howard Melman, contributed Jun 16 2000 -(defcustom bbdb/vm-auto-add-label-list nil - "*List used by `bbdb/vm-auto-add-label' to automatically label messages. -Each element in the list is either a string or a list of two strings. -If a single string then it is used as both the field value to check for -and the label to apply to the message. If a list of two strings, the first -is the field value to search for and the second is the label to apply." - :group 'bbdb-mua-specific-vm - :type 'list) - -(defcustom bbdb/vm-auto-add-label-field bbdb-define-all-aliases-field - "*Fields used by `bbdb/vm-auto-add-label' to automatically label messages. -Value is either a single symbol or a list of symbols of bbdb fields that -`bbdb/vm-auto-add-label' uses to check for labels to apply to messages. -Defaults to `bbdb-define-all-aliases-field' which is typically `mail-alias'." - :group 'bbdb-mua-specific-vm - :type '(choice symbol list)) - -(defun bbdb/vm-auto-add-label (record) - "Automatically add labels to messages based on the mail-alias field. -Add this to `bbdb-notice-hook' and if using VM each message that bbdb -notices will be checked. If the sender has a value in the -bbdb/vm-auto-add-label-field in their BBDB record that -matches a value in `bbdb/vm-auto-add-label-list' then a VM -label will be added to the message. - -This works great when `bbdb-user-mail-names' is set. As a result -mail that you send to people (and copy yourself on) is labeled as well. - -This is how you hook it in. -;; (add-hook 'bbdb-notice-hook 'bbdb/vm-auto-add-label) -" - (let (field aliases sep) - (and (eq major-mode 'vm-mode) - (mapcar #'(lambda(x) - (and - (setq field (bbdb-record-getprop record x)) - (setq sep (or (get x 'field-separator) ",")) - (setq aliases (append aliases (bbdb-split field sep))))) - (cond ((listp bbdb/vm-auto-add-label-field) - bbdb/vm-auto-add-label-field) - ((symbolp bbdb/vm-auto-add-label-field) - (list bbdb/vm-auto-add-label-field)) - (t (error "Bad value for bbdb/vm-auto-add-label-field")) - )) - (vm-add-message-labels - (mapconcat #'(lambda (l) - (cond ((stringp l) - (if (member l aliases) - l)) - ((and (consp l) - (stringp (car l)) - (stringp (cdr l))) - (if (member (car l) aliases) - (cdr l))) - (t - (error "Malformed bbdb/vm-auto-add-label-list") - ))) - bbdb/vm-auto-add-label-list - " ") - 1)))) - - -;;; Automatically add a record for replies. -;;; Contributed by Robert Fenk, 27 Oct 2000. It only took me 8 months to put -;;; it in the source... -;;; -;;; (add-hook 'vm-reply-hook 'bbdb/vm-force-create) to enable it. You could -;;; presumably hook it elsewhere as well. -(defun bbdb/vm-force-create () - "Force automatic adding of a bbdb entry for current message." - (interactive) - (let ((bbdb/mail-auto-create-p t) - (bbdb-message-caching-enabled nil)) - (save-excursion - (vm-select-folder-buffer) - (bbdb/vm-pop-up-bbdb-buffer)))) - - -;;;###autoload -(defun bbdb-insinuate-vm () - "Call this function to hook BBDB into VM." - (cond ((boundp 'vm-select-message-hook) ; VM 5.36+ - (add-hook 'vm-select-message-hook 'bbdb/vm-pop-up-bbdb-buffer)) - ((boundp 'vm-show-message-hook) ; VM 5.32.L+ - (add-hook 'vm-show-message-hook 'bbdb/vm-pop-up-bbdb-buffer)) - (t - (error "vm versions older than 5.36 no longer supported"))) - (define-key vm-mode-map ":" 'bbdb/vm-show-sender) - ;; (define-key vm-mode-map "'" 'bbdb/vm-show-all-recipients) ;; not yet - (define-key vm-mode-map ";" 'bbdb/vm-edit-notes) - (define-key vm-mode-map "/" 'bbdb) - ;; VM used to inherit from mail-mode-map, so bbdb-insinuate-sendmail - ;; did this. Kyle, you loser. - (if (boundp 'vm-mail-mode-map) - (define-key vm-mail-mode-map "\M-\t" 'bbdb-complete-name))) - -(provide 'bbdb-vm) diff --git a/xemacs-packages/lisp/bbdb/bbdb-w3.el b/xemacs-packages/lisp/bbdb/bbdb-w3.el deleted file mode 100644 index a0c2dac1..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-w3.el +++ /dev/null @@ -1,63 +0,0 @@ -;;; This file is part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993 Jamie Zawinski . -;;; WWW-related functions for the BBDB. See bbdb.texinfo. - -;;; The Insidious Big Brother Database 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. -;;; -;;; BBDB 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. - -;; -;; $Id: bbdb-w3.el,v 1.6 2005/07/24 15:22:58 waider Exp $ -;; - -(require 'bbdb-com) -(require 'browse-url) - -(defvar w3-mode-map) -(eval-when-compile - (condition-case() (require 'url) (error (fset 'url-view-url 'ignore)))) - -;;;###autoload -(defun bbdb-www (rec &optional which) - "Visit URLs stored in the `www' field of the current record. -\\[bbdb-apply-next-command-to-all-records]\\[bbdb-www] \ -means to try all records currently visible. -Non-interactively, do all records if arg is nonnil." - (interactive (list (bbdb-get-record "Visit (WWW): ") - (or current-prefix-arg 0))) - (browse-url (read-string "fetch: " (bbdb-get-field rec 'www which)))) - -;;;###autoload -(defun bbdb-www-grab-homepage (record) - "Grab the current URL and store it in the bbdb database" - (interactive (list (bbdb-completing-read-one-record - "Add WWW homepage for: "))) - ;; if there is no database record for this person, create one - (unless record - (setq record (bbdb-read-new-record)) - (bbdb-invoke-hook 'bbdb-create-hook record)) - (if (bbdb-record-getprop record 'www) - (bbdb-record-putprop - record 'www - (concat (bbdb-record-getprop record 'www) "," (url-view-url t))) - (bbdb-record-putprop record 'www (url-view-url t))) - (bbdb-change-record record t) - (bbdb-display-records (list record))) - -;;;###autoload -(defun bbdb-insinuate-w3 () - "Call this function to hook BBDB into W3." - (add-hook 'w3-mode-hook - (lambda () (define-key w3-mode-map ":" 'bbdb-www-grab-homepage)))) - -(provide 'bbdb-w3) diff --git a/xemacs-packages/lisp/bbdb/bbdb-whois.el b/xemacs-packages/lisp/bbdb/bbdb-whois.el deleted file mode 100644 index f0621270..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-whois.el +++ /dev/null @@ -1,263 +0,0 @@ -;;; bbdb-whois.el -- Big Brother gets a little help from Big Brother -;;; This file is part of the Insidious Big Brother Database (aka BBDB). -;;; -;;; Copyright (C) 1992, 1993 Roland McGrath -;;; -;;; 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 roland@gnu.ai.mit.edu) or -;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA -;;; 02139, USA. -;;; -;;; Send bug reports to bbdb@waider.ie - -(require 'bbdb-com) - -(defmacro bbdb-add-to-field (record field text) - (let ((get (intern (concat "bbdb-record-" (symbol-name field)))) - (set (intern (concat "bbdb-record-set-" (symbol-name field))))) - (` (let ((old ((, get) (, record))) - (text (, text))) - (or (member text old) - ((, set) (, record) (nconc old (list text)))))))) - -(defcustom bbdb-whois-server (or (and (boundp 'whois-server) whois-server) - "whois.geektools.com") - "*Server for \\[bbdb-whois] lookups." - :group 'bbdb-utilities - :type 'string) - -(defvar bbdb-whois-name nil - "Used to store the name during a whois call.") -(make-variable-buffer-local 'bbdb-whois-name) -(defvar bbdb-whois-record nil - "Used to store the record during a whois call.") -(make-variable-buffer-local 'bbdb-whois-record) - -;;; main entry point. it'd be nice if we could bbdb-whois an arbitrary -;;; name and make a record from that directly. - -;;;###autoload -(defun bbdb-whois (the-record &optional server) - (interactive (list (bbdb-get-record "BBDB Whois: ") - (and current-prefix-arg - (read-string "Query whois server: " - bbdb-whois-server)))) - (or server (setq server bbdb-whois-server)) - (if (or (bbdb-record-lastname the-record) (bbdb-record-firstname the-record)) - ;; XXX we seem to get called with a vector of nils. - (save-excursion - (set-buffer (generate-new-buffer " *bbdb-whois*")) - (set bbdb-whois-record the-record) - (set bbdb-whois-name - (if (bbdb-record-getprop the-record 'nic) - (concat "!" (bbdb-record-getprop the-record 'nic)) - (concat (bbdb-record-lastname the-record) ", " - (bbdb-record-firstname the-record)))) - (let ((proc (open-network-stream "whois" (current-buffer) server 43))) - (set-process-sentinel proc 'bbdb-whois-sentinel) - (process-send-string proc (concat bbdb-whois-name "\r\n")))))) - -;;; This function parses the results from the server. -(defun bbdb-whois-sentinel (proc status) - (save-excursion - (let (rec) - (set-buffer (process-buffer proc)) - (setq rec bbdb-whois-record) - (goto-char 1) - - ;; check for multiple replies - ;; should maybe present a menu/completion buffer of multiples and do a - ;; refetch. - (if (not (re-search-forward "Record last updated" (point-max) t)) - (if (re-search-forward "No match" (point-max) t) - (message "Can not find a whois record for `%s'" bbdb-whois-name) - (if (re-search-forward "Access Limit Exceeded" (point-max) t) - (message "Per-day access limit to %s exceeded." - bbdb-whois-server) ;; bah! - (message "%s is ambiguous to whois; try a different name" - bbdb-whois-name))) - - ;; clean up & parse buffer, otherwise. - (replace-string "\r\n" "\n") - (goto-char 1) - (if (re-search-forward - (concat (if (string-match "^!" bbdb-whois-name) - (concat "(\\(" - (regexp-quote (substring bbdb-whois-name 1)) - "\\))") - (concat (regexp-quote bbdb-whois-name) - ".*(\\([A-Z0-9]+\\))")) - "\\s *\\(\\S +@\\S +\\)?$") - nil t) - (let ((net (if (match-beginning 2) - (downcase (buffer-substring (match-beginning 2) - (match-end 2))))) - (nic (buffer-substring (match-beginning 1) (match-end 1))) - (lines nil)) - (if net - (bbdb-add-to-field rec net net)) - (bbdb-record-putprop rec 'nic nic) - - ;; Snarf company. - ;; not all nic records have companies, though. - (forward-line 1) - (back-to-indentation) - (let ((company (buffer-substring (point) (progn (end-of-line) - (point)))) - (old (bbdb-record-company rec))) - (cond ((not old) - (bbdb-record-set-company rec company)) - ((string= old company) - nil) - (t - (bbdb-record-putprop rec 'nic-organization company)))) - - ;; Read the address info into LINES. - (while (progn (forward-line 1) - (not (looking-at "^$"))) - (back-to-indentation) - (setq lines (cons (buffer-substring (point) - (progn (end-of-line) - (point))) - lines))) - - ;; Snarf phone number. - ;; phone, fax are presented, it seems, as - ;; +country area prefix number +country area prefix number - ;; we can look for the " +" and split there, I guess. - (if (car lines) - (let ((phones (car lines)) - (n 1) - phone-numbers) - (while (string-match "^\\(.+\\) \\+" phones) - (setq phone-numbers - (append phone-numbers - (list (substring phones 0 (match-end 1)))) - phones (substring phones (+ 1 (match-end 1))))) - (setq phone-numbers (append phone-numbers - (list phones))) - - ;; now add each member of the list to the bbdb record - ;; it'd be nice if we could be smarter about this. - (mapcar (function - (lambda(p) - (if (not (bbdb-find-phone - p (bbdb-record-phones rec))) - (let ((p-n - (vector (format "nic-phone-%d" n) p))) - (bbdb-add-to-field rec phones p-n) - (setq n (+ 1 n)))))) - phone-numbers) - - ;; throw away phones line from what we've snarfed - (setq lines (cdr lines)))) - - ;; Snarf address. - (if (car lines) - (let ((addr (make-vector bbdb-address-length nil)) - (city "") - (state "") - (zip "") - (country "")) - - ;; extract country - (if (string-match "^[A-Z][A-Z]$" (car lines)) - (setq country (car lines) ;; could convert from ISO... - lines (cdr lines))) - - ;; extract city, state, zip - ;; it would be nice if this could all use bbdb-snarf. - ;; or if NICs would hand out something machine - ;; readable, like XML. - ;; - ;; note the zipcode check at the end of the regexp - ;; isn't really a zipcode check, because we don't do - ;; zipcode checks any more. - (if (string-match - "\\([^,]+\\),\\s *\\(\\S +\\)\\s *\\(.+\\)" - (car lines)) - (setq city (substring (car lines) - (match-beginning 1) - (match-end 1)) - state (substring (car lines) - (match-beginning 2) - (match-end 2)) - zip (substring (car lines) - (match-beginning 3) - (match-end 3)) - lines (cdr lines)) - ;; otherwise we just stuff everything into the - ;; streets list and let the user clean it up. This - ;; would be nice to do heuristically, if I knew - ;; enough about variable address formats. - ;; (bbdb-snarf-grok-address (ADDR)) would be neat. - ) - - (bbdb-address-set-location addr "nic-address") - (bbdb-address-set-city addr (or city "")) - (bbdb-address-set-state addr (or state "")) - (bbdb-address-set-zip addr (or zip "")) - (bbdb-address-set-country addr (or country "")) - (setq lines (nreverse lines)) - (bbdb-address-set-streets addr lines) - - ;; should probably overwrite existing nic-address field. - (bbdb-add-to-field rec addresses addr))) - - ;; Snarf any random notes. - (setq lines nil) - (while (progn - (forward-line 1) - (back-to-indentation) - (not (looking-at - "$\\|Record last updated on"))) - (if (looking-at "Alternate mailbox: \\(\\S +\\)$") - (bbdb-add-to-field rec net - (buffer-substring (match-beginning 1) - (match-end 1))) - (setq lines (cons (buffer-substring (point) - (progn (end-of-line) - (point))) - lines)))) - (if lines - (bbdb-record-putprop rec 'nic-notes - (mapconcat 'identity - (nreverse lines) - "\n"))) - - ;; Snarf the last-update date. - (if (re-search-forward "Record last updated on \\(\\S *\\)\\." - nil t) - (bbdb-record-putprop rec 'nic-updated - (buffer-substring (match-beginning 1) - (match-end 1)))) - - (save-excursion - (set-buffer bbdb-buffer-name) - (bbdb-redisplay-one-record rec))) - (message "No whois information for %s" bbdb-whois-name))) - (delete-process proc) - (kill-buffer (current-buffer))))) - -(defun bbdb-find-phone (string record) - "Return the vector entry if STRING is a phone number listed in RECORD." - (let ((phone nil) - (done nil)) - (while (and record (not done)) - (setq phone (car record)) - (if (string= string (bbdb-phone-string phone)) - (setq done phone)) - (setq record (cdr record))) - done)) - -(provide 'bbdb-whois) diff --git a/xemacs-packages/lisp/bbdb/bbdb-xemacs.el b/xemacs-packages/lisp/bbdb/bbdb-xemacs.el deleted file mode 100644 index 456c0af3..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb-xemacs.el +++ /dev/null @@ -1,113 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- -;;; This file contains some XEmacs-specific stuff for BBDB. - -;;; This file is the part of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1992, 1993, 1994 Jamie Zawinski . - -;;; The Insidious Big Brother Database 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. -;;; -;;; BBDB is distributed in the hope that it will be useful, but WITHOUT ANY -;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more -;;; details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to -;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; This code is kind of kludgey, mostly because it needs to parse the contents -;;; of the *BBDB* buffer, since BBDB doesn't save the buffer-positions of the -;;; various fields when it fills in that buffer (doing that would be slow and -;;; cons a lot, so it doesn't seem to be worth it.) - -(or (string-match "XEmacs\\|Lucid" emacs-version) - (error "This file only works in XEmacs.")) - -;; this makes no sense, long-term, but. -(eval-when-compile - (or (featurep 'xemacs) - (fset 'load-sound-file 'ignore))) - -(require 'bbdb) -(require 'bbdb-com) -(require 'bbdb-gui) ;; load in the menu/font stuff - -;; Utility functions that mask others to provide XEmacs-specific functionality -;;;###autoload -(defun bbdb-xemacs-display-completion-list (list &optional callback data) - "Wrapper for `display-completion-list'. -Allows callbacks on XEmacs `display-completion-list' is called with -`:activate-callback CALLBACK' if CALLBACK is non-nil. -`:user-data DATA' is also used if DATA is non-nil. -Neither are used if CALLBACK is nil." - (cond ((and callback data) - (display-completion-list list - :activate-callback callback - :user-data data)) - (callback - (display-completion-list list - :activate-callback callback)) - (t - (display-completion-list list)))) - - -;; For native Xemacs sound support we can use these ... -;;;###autoload -(defcustom bbdb-sounds-directory (expand-file-name "~/.xemacs/etc/sounds") - "The directory to load the touchtone sound files from, or nil if none." - :group 'bbdb-phone-dialing - :type 'directory) - -;;;###autoload -(defcustom bbdb-sound-volume 50 - "Volume for playing sounds." - :group 'bbdb-phone-dialing - :type 'integer) - -;;;###autoload -(defun bbdb-load-touchtones () - "Load the touchtone sounds into `sound-alist'. -The directory specified in `bbdb-sounds-directory' is searched for the files -touchtone.*\\.\\(wav\\|au\\) as named in `bbdb-sound-files'. -They are stored in `sound-alist' as touchtone0 to touchtone11." - (interactive) - (let (files - (nr 0)) - (condition-case nil - (setq files - (directory-files bbdb-sounds-directory t - (if (and system-type - (string-match - "windows" - (format "%s" system-type))) - "touchtone.*\\.wav" - "touchtone.*\\.au"))) - (error - ;; It is not a fatal error if we can't find the touchtones; it - ;; just prevents a particular, possibly little-used feature - ;; from working. - (bbdb-warn "Cannot find any touchtone sounds") - (setq files nil))) - - (if (not files) - (progn - (message "No touchtone files found in `bbdb-sound-directory'!") - (sit-for 2)) - ;; otherwise, load 'em up. - (while files - (load-sound-file (car files) - (intern (concat "touchtone" (format "%d" nr))) - bbdb-sound-volume) - (setq files (cdr files) - nr (1+ nr)))))) - -(if (and bbdb-sounds-directory - (file-directory-p bbdb-sounds-directory) - (boundp 'xemacsp) - (featurep 'native-sound)) - (bbdb-load-touchtones)) - -(provide 'bbdb-xemacs) diff --git a/xemacs-packages/lisp/bbdb/bbdb.el b/xemacs-packages/lisp/bbdb/bbdb.el deleted file mode 100644 index c161140f..00000000 --- a/xemacs-packages/lisp/bbdb/bbdb.el +++ /dev/null @@ -1,3749 +0,0 @@ -;;; -*- Mode:Emacs-Lisp -*- -;;; This file is the core of the Insidious Big Brother Database (aka BBDB), -;;; copyright (c) 1991, 1992, 1993, 1994 Jamie Zawinski . -;;; See the file bbdb.texinfo for documentation. -;;; -;;; The Insidious Big Brother Database 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. -;;; -;;; BBDB 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. -;;; -;;; ------------------------------------------------------------------------ -;;; | There is a mailing list for discussion of BBDB: | -;;; | bbdb-info@lists.sourceforge.net | -;;; | To join, send mail to bbdb-info-request@lists.sourceforge.net | -;;; | (don't forget the "-request" part or you'll look silly in front of | -;;; | lots of people who have the ability to remember it indefinitely...) | -;;; | | -;;; | There is also a second mailing list, to which only bug fixes and | -;;; | new version announcements are sent; to be added to it, send mail to | -;;; | bbdb-announce-request@lists.sourceforge.net. This is a very low | -;;; | volume list, and if you're using BBDB, you really should be on it. | -;;; | | -;;; | When joining these lists or reporting bugs, please mention which | -;;; | version you have. The preferred method of reporting bugs is to use | -;;; | bbdb-submit-bug-report, which will include all useful version | -;;; | information plus state information about how you have BBDB set up. | -;;; ------------------------------------------------------------------------ -;;; -;;; $Id: bbdb.el,v 1.9 2005/07/24 15:22:58 waider Exp $ - -(require 'timezone) -(eval-when-compile (require 'cl)) - -(eval-when-compile ; pacify the compiler. - (autoload 'widget-group-match "wid-edit") - (autoload 'Electric-pop-up-window "electric") - (autoload 'Electric-command-loop "electric") - (autoload 'bbdb-migration-query "bbdb-migrate") - (autoload 'bbdb-migrate "bbdb-migrate") - (autoload 'bbdb-migrate-rewrite-all "bbdb-migrate") - (autoload 'bbdb-migrate-update-file-version "bbdb-migrate") - (autoload 'bbdb-unmigrate-record "bbdb-migrate") - (autoload 'bbdb-redisplay-records "bbdb-com") - (autoload 'bbdb-create-internal "bbdb-com") - (autoload 'bbdb-append-records-p "bbdb-com") - (autoload 'y-or-n-p-with-timeout "timer") - (autoload 'mail-position-on-field "sendmail") - (autoload 'bbdb-fontify-buffer "bbdb-gui") - ;; autoload doesn't work for these - (condition-case nil (require 'message) - (error (message "Warning: message not found. Ensure it is in your `load-path'"))); for message-mode-map - (require 'sendmail); for mail-mode-map - ) - -(defconst bbdb-version "2.35") -(defconst bbdb-version-date "$Date: 2005/07/24 15:22:58 $") - -(defcustom bbdb-gui (if (fboundp 'display-color-p) ; Emacs 21 - (display-color-p) - (not (null window-system))) ; wrong for XEmacs? - "*Non-nil means fontify the *BBDB* buffer." - :group 'bbdb - :type 'boolean) - -;; File format -(defconst bbdb-file-format 6) -(defvar bbdb-file-format-migration nil - "A cons of two elements: the version read, and the version to write. -nil if the database was read in and is to be written in the current -version.") - -(defvar bbdb-no-duplicates-p nil - "Should BBDB allow entries with duplicate names. -This may lead to confusion when doing completion. If non-nil, it will -prompt the users on how to merge records when duplicates are detected.") - -;; Definitions for things that aren't in all Emacsen and that I really -;; would prefer not to live without. -(eval-and-compile - (if (fboundp 'unless) nil - (defmacro unless (bool &rest forms) `(if ,bool nil ,@forms)) - (defmacro when (bool &rest forms) `(if ,bool (progn ,@forms)))) - (unless (fboundp 'save-current-buffer) - (defalias 'save-current-buffer 'save-excursion)) - (if (fboundp 'mapc) - (defalias 'bbdb-mapc 'mapc) - (defalias 'bbdb-mapc 'mapcar)) - ) - -(unless (fboundp 'with-current-buffer) - (defmacro with-current-buffer (buf &rest body) - `(save-current-buffer (set-buffer ,buf) ,@body))) - -(unless (fboundp 'defvaralias) - (defun defvaralias (&rest args))) - -(defmacro string> (a b) (list 'not (list 'or (list 'string= a b) - (list 'string< a b)))) - -(eval-and-compile - (or (fboundp 'set-keymap-prompt) - (fset 'set-keymap-prompt 'ignore))) - -;; this should really be in bbdb-com -;;;###autoload -(defun bbdb-submit-bug-report () - "Submit a bug report, with pertinent information to the BBDB info list." - (interactive) - (require 'reporter) - (delete-other-windows) - (reporter-submit-bug-report - "bbdb-info@lists.sourceforge.net" - (concat "BBDB " bbdb-version) - (append - ;; non user variables - '(emacs-version - bbdb-version-date - bbdb-file-format - bbdb-no-duplicates-p) - ;; user variables - (sort (apropos-internal "^bbdb" - 'user-variable-p) - (lambda (v1 v2) (string-lessp (format "%s" v1) (format "%s" v2)))) - ;; see what the user had loaded - (list 'features) - ) - nil - nil - "Please change the Subject header to a concise bug description.\nIn this report, remember to cover the basics, that is, what you expected to\nhappen and what in fact did happen. Please remove these\ninstructions from your message.") - - ;; insert the backtrace buffer content if present - (let ((backtrace (get-buffer-create "*Backtrace*"))) - (when backtrace - (goto-char (point-max)) - (insert "\n\n") - (insert-buffer-substring backtrace))) - - (goto-char (point-min)) - (mail-position-on-field "Subject")) - -;; Make custom stuff work even without customize -;; Courtesy of Hrvoje Niksic -(eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (unless (and (featurep 'custom) (fboundp 'custom-declare-variable)) - ;; 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)) - (defmacro defface (var value doc &rest args) - `(make-face ,var)) - (defmacro define-widget (&rest args) - nil))) - -(defconst bbdb-have-re-char-classes (string-match "[[:alpha:]]" "x") - "Non-nil if this Emacs supports regexp character classes. -E.g. `[[:alnum:]]'.") - -;; Custom groups - -(defgroup bbdb nil - "The Insidious Big Brother Database." - :group 'news - :group 'mail) - -(put 'bbdb 'custom-loads '("bbdb-hooks" "bbdb-com")) - -(defgroup bbdb-hooks nil - "Hooks run at various times by the BBDB" - :group 'bbdb) - -(defgroup bbdb-record-display nil - "Variables that affect the display of BBDB records" - :group 'bbdb) - -(defgroup bbdb-record-creation nil - "Variables that affect the creation of BBDB records" - :group 'bbdb) - -(defgroup bbdb-noticing-records nil - "Variables that affect the noticing of new authors" - :group 'bbdb-record-creation) -(put 'bbdb-noticing-records 'custom-loads '("bbdb-hooks")) - -(defgroup bbdb-record-use nil - "Variables that affect the use of BBDB records" - :group 'bbdb) - -(defgroup bbdb-database nil - "Variables that affect the database as a whole" - :group 'bbdb) - -(defgroup bbdb-saving nil - "Variables that affect saving of the BBDB" - :group 'bbdb-database) - -(defgroup bbdb-mua-specific nil - "MUA-specific customizations" - :group 'bbdb) - -(defgroup bbdb-mua-specific-gnus nil - "Gnus-specific BBDB customizations" - :group 'bbdb-mua-specific) - -(put 'bbdb-mua-specific-gnus 'custom-loads '("bbdb-gnus")) - -(defgroup bbdb-mua-specific-gnus-scoring nil - "Gnus-specific scoring BBDB customizations" - :group 'bbdb-mua-specific-gnus) - -(put 'bbdb-mua-specific-gnus-scoring 'custom-loads '("bbdb-gnus")) - -(defgroup bbdb-mua-specific-gnus-splitting nil - "Gnus-specific splitting BBDB customizations" - :group 'bbdb-mua-specific-gnus) - -(put 'bbdb-mua-specific-gnus-splitting 'custom-loads '("bbdb-gnus")) - -(defgroup bbdb-mua-specific-vm nil - "VM-specific BBDB customizations" - :group 'bbdb-mua-specific) - -(put 'bbdb-mua-specific-vm 'custom-loads '("bbdb-vm")) - -(defgroup bbdb-phone-dialing nil - "Customizations for phone number dialing" - :group 'bbdb) -(put 'bbdb-phone-dialing 'custom-loads '("bbdb-com")) - -(defgroup bbdb-utilities nil - "Customize BBDB Utilities" - :group 'bbdb) - -(defgroup bbdb-utilities-finger nil - "Customizations for fingering from within the BBDB" - :group 'bbdb-utilities - :prefix "bbdb-finger") -(put 'bbdb-utilities-finger 'custom-loads '("bbdb-com")) - -(defgroup bbdb-utilities-ftp nil - "Customizations for using FTP sites stored in BBDB records." - :group 'bbdb-utilities) -(put 'bbdb-utilities-ftp 'custom-loads '("bbdb-ftp")) - -(defgroup bbdb-utilities-print nil - "Customizations for printing the BBDB." - :group 'bbdb-utilities - :prefix "bbdb-print") -(put 'bbdb-utilities-print 'custom-loads '("bbdb-print")) - -(defgroup bbdb-utilities-supercite nil - "Customizations for using Supercite with the BBDB." - :group 'bbdb-utilities - :prefix "bbdb/sc") -(if (or (featurep 'supercite) - (locate-library "supercite")) - (put 'bbdb-utilities-supercite 'custom-loads '("bbdb-sc"))) - -(defgroup bbdb-utilities-server nil - "Customizations for interfacing with the BBDB from external programs." - :group 'bbdb-utilities - :prefix "bbdb/srv") -(if (and (or (featurep 'gnuserv) (locate-library "gnuserv")) - (or (featurep 'itimer) (locate-library "itimer"))) - (put 'bbdb-utilities-server 'custom-loads '("bbdb-srv"))) - -;; BBDB custom widgets - -(define-widget 'bbdb-alist-with-header 'group - "My group" - :match 'bbdb-alist-with-header-match - :value-to-internal (lambda (widget value) - (if value (list (car value) (cdr value)))) - :value-to-external (lambda (widget value) - (if value (append (list (car value)) (cadr value))))) - -(defun bbdb-alist-with-header-match (widget value) - (widget-group-match widget - (widget-apply widget :value-to-internal value))) - -;; Customizable variables - -(defcustom bbdb-file "~/.bbdb" - "*The name of the Insidious Big Brother Database file." - :group 'bbdb-database - :type 'file) - -;; this should be removed, and the following put in place: -;; a hierarchical structure of bbdb files, some perhaps read-only, -;; perhaps caching in the local bbdb. This way you could have, e.g. a -;; company address book, with each person having access to it, and -;; then a local address book with personal stuff in it. -(defcustom bbdb-file-remote nil - "*The remote file to save the database to. -When this is non-nil, it should be a file name. -When BBDB reads `bbdb-file', it checks this file, - and if it is newer, downloads it. -When BBDB writes `bbdb-file', it also writes this file. - -This feature allows one to keep the database in one place while using -different computers, thus reducing the need for merging different files." - :group 'bbdb-database - :type '(choice (const :tag "none" nil) - (file :tag "remote file name"))) - -(defcustom bbdb-file-remote-save-always t - "*Should the `bbdb-file-remote' file be saved whenever the database is saved? -When nil, you will be asked." - :group 'bbdb-database - :type 'boolean) - -(unless (fboundp 'primep) - (defun primep (num) - (let ((lim (sqrt num)) (nu 2) (prime t)) - (while (and prime (< nu lim)) - (setq prime (/= 0 (mod num nu)) - nu (1+ nu))) - prime))) - -(defcustom bbdb-hashtable-size 1021 - "*The size of the bbdb hashtable. -BBDB hashtable is an obarray, so this must be a prime integer. -Set this to a prime number (much) larger than the size of your database -before loading it. -If you change this variable outside `customize', -you should reload `bbdb-file'." - :group 'bbdb-database - :type 'integer - :set (lambda (symb val) - (unless (primep val) - (error "`%s' must be prime, not %s" symb val)) - (set symb val) - (when (fboundp 'bbdb-records) - (bbdb-records)) - val)) - -(defcustom bbdb-default-area-code nil - "*The default area code to use when prompting for a new phone number. -This variable also affects dialing." - :group 'bbdb-record-creation - :type '(choice (const :tag "none" nil) - (integer :tag "Default Area Code")) - :set (lambda( symb val ) - (if (or (and (stringp val) - (string-match "^[0-9]+$" val)) - (integerp val) - (null val)) - (set symb val) - (error "%s must contain digits only." symb)))) - -(defcustom bbdb-lastname-prefixes - '("von" "Von" "de" "De") - "*List of lastname prefixes recognized in name fields. Used to -enhance dividing name strings into firstname and lastname parts." - :group 'bbdb-record-creation - :type '(repeat string)) - -(defcustom bbdb-default-domain nil - "*The default domain to append when prompting for a new net address. -If the address entered does not contain `[@%!]', `@bbdb-default-domain' -will be appended to it. - -The address will not be altered if bbdb-default-domain remains at its -default value of nil, or if one provides a prefix argument to the -bbdb-insert-new-field command." - :group 'bbdb-record-creation - :type '(choice (const :tag "none" nil) - (string :tag "Domain" :value nil))) - -(defcustom bbdb-north-american-phone-numbers-p t - "*Set this to nil if you want to enter phone numbers that aren't the same -syntax as those in North America (that is, [[1] nnn] nnn nnnn ['x' n*]). -If this is true, then some error checking is done so that you can't enter -incorrect phone numbers, and all phone numbers are pretty-printed the same -way. European phone numbers don't have as strict a syntax, however, so -this is a harder problem for them (on which I am punting). - -You can have both styles of phone number in your database by providing a -prefix argument to the bbdb-insert-new-field command." - :group 'bbdb-record-creation - :type 'boolean) - -(defcustom bbdb-electric-p nil - "*Whether bbdb mode should be `electric' like `electric-buffer-list'." - :group 'bbdb-record-display - :type 'boolean) - -(defcustom bbdb-case-fold-search (default-value 'case-fold-search) - "*This is the value of `case-fold-search' used by `bbdb' and friends. -This variable lets the case-sensitivity of ^S and of the bbdb -commands be different." - :group 'bbdb - :type 'boolean) - -;; these variables both need to be enabled for gnus mailreading to -;; work right. that's probably a bug, or something. -(defcustom bbdb/mail-auto-create-p t - "*If this is t, then VM, MH, and RMAIL will automatically create new bbdb -records for people you receive mail from. If this is a function name -or lambda, then it is called with no arguments to decide whether an -entry should be automatically created. You can use this to, for example, -not create records for messages which have reached you through a -particular mailing list, or to only create records automatically if -the mail has a particular subject." - :group 'bbdb-noticing-records - :type '(choice (const :tag "Automatically create" t) - (const :tag "Prompt before creating" prompt) - (const :tag "Do not automatically create" nil) - (function :tag "Create with function" bbdb-))) - -(defcustom bbdb/news-auto-create-p nil - "*If this is t, then GNUS will automatically create new bbdb -records for people you receive mail from. If this is a function name -or lambda, then it is called with no arguments to decide whether an -entry should be automatically created. You can use this to, for -example, create or not create messages which have a particular -subject. If you want to autocreate messages based on the current -newsgroup, it's probably a better idea to set this variable to t or -nil from your `gnus-select-group-hook' instead." - :group 'bbdb-noticing-records - :type '(choice (const :tag "Automatically create" t) - (const :tag "Prompt before creating" prompt) - (const :tag "Do not automatically create" nil) - (function :tag "Create with function" bbdb-))) - -(defcustom bbdb-quiet-about-name-mismatches nil - "*If this is true, then BBDB will not prompt you when it notices a -name change, that is, when the \"real name\" in a message doesn't correspond -to a record already in the database with the same network address. As in, -\"John Smith \" versus \"John Q. Smith \". -Normally you will be asked if you want to change it. -If set to a number it is the number of seconds to sit for while -displaying the mismatch message." - :group 'bbdb-noticing-records - :type '(choice (const :tag "Prompt for name changes" nil) - (const :tag "Do not prompt for name changes" t) - (integer :tag - "Instead of prompting, warn for this many seconds"))) - -(defcustom bbdb-use-alternate-names t - "*If this is true, then when bbdb notices a name change, it will ask you -if you want both names to map to the same record." - :group 'bbdb-noticing-records - :type '(choice (const :tag "Ask to use alternate names field" t) - (const :tag "Use alternate names field without asking" nil))) - -(defcustom bbdb-readonly-p nil - "*If this is true, then nothing will attempt to change the bbdb database -implicitly, and you will be prevented from doing it explicitly. If you have -more than one emacs running at the same time, you might want to arrange for -this to be set to t in all but one of them." - :group 'bbdb-database - :type '(choice (const :tag "Database is read-only" t) - (const :tag "Database is writable" nil))) - -(defcustom bbdb-continental-zip-regexp "^\\s *[A-Z][A-Z]?\\s *-\\s *[0-9][0-9][0-9]" - "Regexp matching continental zip codes. -Addresses with zip codes matching the regexp will be formated using -`bbdb-format-address-continental'. The regexp should match zip codes -of the form CH-8052, NL-2300RA, and SE-132 54." - :group 'bbdb-record-display - :type 'regexp) - -(defcustom bbdb-auto-revert-p nil - "*If this variable is true and the BBDB file is noticed to have changed on -disk, it will be automatically reverted without prompting you first. Otherwise -you will be asked. (But if the file has changed and you hae made changes in -memory as well, you will always be asked.)" - :group 'bbdb-saving - :type '(choice (const :tag "Revert unchanged database without prompting" t) - (const :tag "Ask before reverting database"))) - -(defcustom bbdb-notice-auto-save-file nil - "*If this is true, then the BBDB will notice when its auto-save file is -newer than the file is was read from, and will offer to revert." - :group 'bbdb-saving - :type '(choice (const :tag "Check auto-save file" t) - (const :tag "Do not check auto-save file" nil))) - -(defcustom bbdb-use-pop-up t - "If true, display a continuously-updating bbdb window while in VM, MH, -RMAIL, or GNUS. If 'horiz, stack the window horizontally if there is room." - :group 'bbdb-record-display - :type '(choice (const :tag "Automatic BBDB window, stacked vertically" t) - (const :tag "Automatic BBDB window, stacked horizontally" 'horiz) - (const :tag "No Automatic BBDB window" nil))) - -(defcustom bbdb-pop-up-target-lines 5 - "*Desired number of lines in a VM/MH/RMAIL/GNUS pop-up bbdb window." - :group 'bbdb-record-display - :type 'integer) - -(defcustom bbdb-completion-type nil - "*Controls the behaviour of `bbdb-complete-name'. If nil, completion is -done across the set of all full-names and user-ids in the bbdb-database; -if the symbol 'name, completion is done on names only; if the symbol 'net, -completion is done on network addresses only; if it is 'primary, then -completion is done only across the set of primary network addresses (the -first address in the list of addresses for a given user). If it is -'primary-or-name, completion is done across primaries and real names." - :group 'bbdb-record-use - :type '(choice (const :tag "Complete across names and net addresses" nil) - (const :tag "Complete across names" name) - (const :tag "Complete across net addresses" net) - (const :tag "Complete across primary net addresses" primary) - (const :tag "Complete across names and primary net addresses" - primary-or-name))) - -(defcustom bbdb-completion-display-record t - "*Whether `bbdb-complete-name' (\\\\[bbdb-complete-name] -in mail-mode) will update the *BBDB* buffer -to display the record whose email address has just been inserted." - :group 'bbdb-record-use - :type '(choice (const :tag "Update the BBDB buffer" t) - (const :tag "Don't update the BBDB buffer" nil))) - -(defcustom bbdb-user-mail-names nil - "*A regular expression identifying the addresses that belong to you. -If a message from an address matching this is seen, the BBDB record for -the To: line will be shown instead of the one for the From: line. If -this is nil, it will default to the value of (user-login-name)." - :group 'bbdb-noticing-records - :type (list 'choice '(const :tag "Use value of (user-login-name)" nil) - (list 'regexp :tag "Pattern matching your addresses" - (or (user-login-name) "address")))) - -(defcustom bbdb-always-add-addresses 'ask - "*If this is true, then when the Insidious Big Brother Database notices -a new email address for a person, it will automatically add it to the list of -addresses. If it is 'ask, you will be asked whether to add it. If it is nil -then new network addresses will never be automatically added nor the user will -be asked. - -When set to a function name the function should return one of these values. - -See also the variable `bbdb-new-nets-always-primary' for control of whether -the addresses go at the front of the list or the back." - :group 'bbdb-noticing-records - :type '(choice (const :tag "Automatically add new addresses" t) - (const :tag "Ask before adding new addresses" ask) - (const :tag "Never add new addresses" nil) - (const bbdb-ignore-some-messages-hook) - (const bbdb-ignore-most-messages-hook))) - -(defcustom bbdb-new-nets-always-primary nil - "*If this is true, then when the Insidious Big Brother Database adds a new -address to a record, it will always add it to the front of the list of -addresses, making it the primary address. If this is nil, you will be asked. -If it is the symbol 'never (really, if it is any non-t, non-nil value) then -new network addresses will always be added at the end of the list." - :group 'bbdb-noticing-records - :type '(choice (const :tag "New address automatically made primary" t) - (const :tag "Ask before making new address primary" nil) - (const :tag "Never make new address primary" never))) - -(defcustom bbdb-send-mail-style nil - "*Specifies which package should be used to send mail. -Should be 'vm, 'mh, 'mail, 'message, or 'gnus (or nil, meaning guess.)" - :group 'bbdb-record-use - :type '(choice (const :tag "Use VM to send mail" vm) - (const :tag "Use MH-E to send mail" mh) - (const :tag "Use send-mail mode to send mail" mail) - (const :tag "Use Message to send mail" message) - (const :tag "Use Mew to send mail" mew) - (const :tag "Use compose-mail to send mail" compose-mail) - (const :tag "Use gnus to send mail" gnus) - (const :tag "Guess which package to use" nil))) - -(defcustom bbdb-offer-save t - "*If t, then certain actions will cause the BBDB to ask you whether -you wish to save the database. If nil, then the offer to save will never -be made. If not t and not nil, then any time it would ask you, it will -just save it without asking." - :group 'bbdb-saving - :type '(choice (const :tag "Offer to save the database" t) - (const :tag "Never offer to save the database" nil) - (const :tag "Save database without asking" savenoprompt))) - -(defcustom bbdb-message-caching-enabled t - "*Whether caching of the message->bbdb-record association should be used -for the interfaces which support it (VM, MH, and RMAIL). This can speed -things up a lot. One implication of this variable being true is that the -`bbdb-notice-hook' will not be called each time a message is selected, but -only the first time. Likewise, if selecting a message would generate a -question (whether to add an address, change the name, etc) you will only -be asked that question the very first time the message is selected." - :group 'bbdb - :type '(choice (const :tag "Enable caching" t) - (const :tag "Disable caching" nil))) - -(defcustom bbdb-silent-running nil - "*If this is true, bbdb will suppress all its informational messages and -queries. Be very very certain you want to set this, because it will suppress -prompting to alter record names, assign names to addresses, etc." - :group 'bbdb - :type '(choice (const :tag "Run silently" t) - (const :tag "Disable silent running" nil))) - -(defcustom bbdb-mode-hook nil - "*Hook or hooks invoked when the *BBDB* buffer is created." - :group 'bbdb-hooks - :type 'hook) - -(defcustom bbdb-list-hook nil - "*Hook or hooks invoked after the `bbdb-list-buffer' is filled in. -Invoked with no arguments." - :group 'bbdb-hooks - :type 'hook) - -(defcustom bbdb-create-hook 'bbdb-creation-date-hook - "*Hook or hooks invoked each time a new BBDB record is created. Invoked -with one argument, the new record. This is called *before* the record is -added to the database. Note that `bbdb-change-hook' will be called as well. - -Hook functions can use the variable `bbdb-update-address-class' to determine -the class of an email address according to `bbdb-get-addresses-headers' and -the variable `bbdb-update-address-header' is set to the header the email -address was extracted from." - :group 'bbdb-hooks - :type 'hook) - -(defcustom bbdb-change-hook 'bbdb-timestamp-hook - "*Hook or hooks invoked each time a BBDB record is altered. Invoked with -one argument, the record. This is called *before* the bbdb-database buffer -is modified. Note that if a new bbdb record is created, both this hook and -`bbdb-create-hook' will be called." - :group 'bbdb-hooks - :type 'hook) - -(defcustom bbdb-after-change-hook nil - "*Hook or hooks invoked each time a BBDB record is altered. Invoked with -one argument, the record. This is called *after* the bbdb-database buffer -is modified, so if you want to modify the record each time it is changed, -you should use the `bbdb-change-hook' instead. Note that if a new bbdb -record is created, both this hook and `bbdb-create-hook' will be called." - :group 'bbdb-hooks - :type 'hook) - -(defcustom bbdb-canonicalize-net-hook nil - "*If this is non-nil, it should be a function of one arg: a network address -string. Whenever the Insidious Big Brother Database \"notices\" a message, -the corresponding network address will be passed to this function first, as -a kind of \"filter\" to do whatever transformations upon it you like before -it is compared against or added to the database. For example: it is the case -that CS.CMU.EDU is a valid return address for all mail originating at a -machine in the .CS.CMU.EDU domain. So, if you wanted all such addresses to -be canonically hashed as user@CS.CMU.EDU, instead of as user@host.CS.CMU.EDU, -you might set this variable to a function like this: - - (setq bbdb-canonicalize-net-hook - '(lambda (addr) - (cond ((string-match \"\\\\`\\\\([^@]+@\\\\).*\\\\.\\\\(CS\\\\.CMU\\\\.EDU\\\\)\\\\'\" - addr) - (concat (substring addr (match-beginning 1) (match-end 1)) - (substring addr (match-beginning 2) (match-end 2)))) - (t addr)))) - -You could also use this function to rewrite UUCP-style addresses into domain- -style addresses, or any number of things. - -This function will be called repeatedly until it returns a value EQ to the -value passed in. So multiple rewrite rules might apply to a single address." - :group 'bbdb-hooks - :type 'function) - -(defcustom bbdb-canonicalize-redundant-nets-p t - "*If this is non-nil, redundant network addresses will be ignored. -If a record has an address of the form foo@baz.com, setting this to t -will cause subsequently-noticed addresses like foo@bar.baz.com to be -ignored (since we already have a more general form of that address.) -This is similar in function to one of the possible uses of the variable -`bbdb-canonicalize-net-hook' but is somewhat more automatic. (This -can't quite be implemented in terms of the canonicalize-net-hook because -it needs access to the database to determine whether an address is -redundant, and the canonicalize-net-hook is purely a textual manipulation -which is performed before any database access.)" - :group 'bbdb-noticing-records - :type '(choice (const :tag "Ignore redundant addresses" t) - (const :tag "Don't ignore redundant addresses" nil))) - -(defcustom bbdb-notice-hook nil - "*Hook or hooks invoked each time a BBDB record is \"noticed\", that is, -each time it is displayed by the news or mail interfaces. Invoked with -one argument, the new record. The record need not have been modified for -this to be called - use `bbdb-change-hook' for that. You can use this to, -for example, add something to the notes field based on the subject of the -current message. It is up to your hook to determine whether it is running -in GNUS, VM, MH, or RMAIL, and to act appropriately. - -Also note that `bbdb-change-hook' will NOT be called as a result of any -modifications you may make to the record inside this hook. - -Hook functions can use the variable `bbdb-update-address-class' to determine -the class of an email address according to `bbdb-get-addresses-headers' and -the variable `bbdb-update-address-header' is set to the header the email -address was extracted from. - -Beware that if the variable `bbdb-message-caching-enabled' is true (a good -idea) then when you are using VM, MH, or RMAIL, this hook will be called only -the first time that message is selected. (The GNUS interface does not use -caching.) When debugging the value of this hook, it is a good idea to set -caching-enabled to nil." - :group 'bbdb-hooks - :type 'hook) - -(defcustom bbdb-after-read-db-hook nil - "*Hook or hooks invoked (with no arguments) just after the Insidious Big -Brother Database is read in. Note that this can be called more than once if -the BBDB is reverted." - :group 'bbdb-hooks - :type 'hook) - -(defcustom bbdb-load-hook nil - "*Hook or hooks invoked when the BBDB code is first loaded. - -WARNING: This hook will be run the first time you traverse the Custom menus - for the BBDB. As a result, nothing slow should be added to - this hook." - :group 'bbdb-hooks - :type 'hook) - -(defcustom bbdb-initialize-hook nil - "*Hook or hooks invoked (with no arguments) when the Insidious Big Brother -Database initialization function `bbdb-initialize' is run." - :group 'bbdb-hooks - :type 'hook) - -(defvar bbdb-mode-map nil - "Keymap for Insidious Big Brother Database listings.") -(defvar bbdb-mode-search-map nil - "Keymap for Insidious Big Brother Database searching") - -;; iso-2022-7bit should be OK (but not optimal for Emacs, at least -- -;; emacs-mule would be better) with both Emacs 21 and XEmacs. Emacs -;; 22 will really need utf-8-emacs. -(defconst bbdb-file-coding-system (if (fboundp 'coding-system-p) - (cond ((coding-system-p 'utf-8-emacs) - 'utf-8-emacs) - ((coding-system-p 'mule-utf-8) - 'mule-utf-8) - (t 'iso-2022-7bit))) - "Coding system used for reading and writing `bbdb-file'. -This should not be changed by users.") - -(defvar bbdb-suppress-changed-records-recording nil - "Whether to record changed records in variable `bbdb-changed-records'. - -If this is false, the BBDB will cease to remember which records are changed -as the change happens. It will still remember that records have been changed, -so the file will still be saved, but the changed records list, and the `!!' -in the *BBDB* buffer modeline that it depends on, will no longer be updated. - -You should bind this variable, not set it; the `!!' is a useful user- -interface feature, and should only be suppressed when changes need to be -automatically made to BBDB records which the user will not care directly -about.") - - -;;; These are the buffer-local variables we use. -;;; They are mentioned here so that the compiler doesn't warn about them -;;; when byte-compile-warn-about-free-variables is on. - -(defvar bbdb-records nil) -(defvar bbdb-changed-records nil) -(defvar bbdb-end-marker nil) -(defvar bbdb-hashtable nil) -(defvar bbdb-propnames nil) -(defvar bbdb-message-cache nil) -(defvar bbdb-showing-changed-ones nil) -(defvar bbdb-modified-p nil) -(defvar bbdb-address-print-formatting-alist) ; "bbdb-print" - -(defvar bbdb-debug t) -(defmacro bbdb-debug (&rest body) - ;; ## comment out the next line to turn off debugging. - ;; ## You really shouldn't do this! But it will speed things up. - (list 'and 'bbdb-debug (list 'let '((debug-on-error t)) (cons 'progn body))) - ) - - -;;; internal kludge to force queries to always happen with the mouse rather -;;; than basing the decision on the last-input-event; bind this, don't set it. -(defvar bbdb-force-dialog-boxes nil) - -(defun bbdb-y-or-n-p (prompt) - (prog1 - (funcall - (cond ((and bbdb-force-dialog-boxes - (fboundp 'yes-or-no-p-dialog-box)) - (when (and (fboundp 'raise-frame) - (not (frame-visible-p (selected-frame)))) - (raise-frame (selected-frame))) - 'yes-or-no-p-dialog-box) - (t 'y-or-n-p)) - prompt) - (message " "))) - -(defun bbdb-yes-or-no-p (prompt) - (prog1 - (funcall (if (and bbdb-force-dialog-boxes - (fboundp 'yes-or-no-p-dialog-box)) - 'yes-or-no-p-dialog-box - 'yes-or-no-p) - prompt) - (message " "))) - -(defun bbdb-invoke-hook (hook arg) - "Like `invoke-hooks', but invokes the given hook with one argument." - (if (and (boundp hook) (setq hook (symbol-value hook))) - (if (and (consp hook) (not (eq (car hook) 'lambda))) - (while hook - (funcall (car hook) arg) - (setq hook (cdr hook))) - (funcall hook arg)))) - -(defun bbdb-invoke-hook-for-value (hook &rest args) - "If HOOK is nil, return nil. If it is t, return t. Otherwise, -return the value of funcalling it with the rest of the arguments." - (cond ((eq hook nil) nil) - ((eq hook t) t) - ((functionp hook) (apply hook args)) - (t hook))) - -(defmacro bbdb-defstruct (conc-name &rest slots) - "Make two functions, one for each slot. The functions are: - CONC-NAME + SLOT and CONC-NAME + `set-' + SLOT -The first one is to be used to read the element named in SLOT, and the -second is used to set it. Also make a constant - CONC-NAME + `length' -that holds the number of slots." - (setq conc-name (symbol-name conc-name)) - (let ((body '()) - (i 0) - (L (length slots))) - (while slots - (setq body - (nconc body - (let ((readname (intern (concat conc-name (symbol-name (car slots))))) - (setname (intern (concat conc-name "set-" (symbol-name (car slots)))))) - (list - (list 'defmacro readname '(vector) - (list 'list ''aref 'vector i)) - (list 'defmacro setname '(vector value) - (list 'list ''aset 'vector i 'value)) - ;(list 'put (list 'quote readname) ''edebug-form-hook ''(form)) - ;(list 'put (list 'quote setname) ''edebug-form-hook ''(form form)) - )))) - (setq slots (cdr slots) i (1+ i))) - (setq body (nconc body (list (list 'defconst - (intern (concat conc-name "length")) - L)))) - (cons 'progn body))) - -;;; When reading this code, beware that "cache" refers to two things. -;;; It refers to the cache slot of bbdb-record structures, which is -;;; used for computed properties of the records; and it also refers -;;; to a message-id --> bbdb-record association list which speeds up -;;; the RMAIL, VM, and MH interfaces. - -;; Build reading and setting functions for firstname, lastname, aka, -;; company, phones, addresses, net, raw-notes, and cache. These are -;; for accessing the high-level forms for the record. -(bbdb-defstruct bbdb-record- - firstname lastname aka company - phones addresses net raw-notes - cache - ) - -;; HACKHACK -(defmacro bbdb-record-set-net (vector value) - "We redefine the set-binding for 'net to detect changes" - (list 'progn - (list 'aset vector 6 value) - (list 'setq 'bbdb-define-all-aliases-needs-rebuilt t))) - -(put 'company 'field-separator "; ") -(put 'notes 'field-separator "\n") - -;; Build reading and setting functions for location, area, exchange, -;; suffix, and extension. These are for accessing the elements of the -;; individual phone number forms. -(bbdb-defstruct bbdb-phone- - location area exchange suffix extension - ) - -;; Build reading and setting functions for location, street, city, -;; state, zip and country. These are for accessing the elements of -;; the individual address forms. -(bbdb-defstruct bbdb-address- - location streets city state zip country - ) - -;; Build reading and setting functions for namecache (the full name of -;; the person referred to by the record), sortkey (the concatenation -;; of the elements used for sorting the record), marker, and -;; deleted-p. These are for accessing the elements of the cache form, -;; and are generally concatenations of data existing in separate parts -;; of the record, stored here prebuilt for speed. -(bbdb-defstruct bbdb-cache- - namecache sortkey marker deleted-p - ) - -;; Build the namecache for a record -(defsubst bbdb-record-name-1 (record) - (bbdb-cache-set-namecache (bbdb-record-cache record) - (let ((fname (bbdb-record-firstname record)) - (lname (bbdb-record-lastname record))) - (if (> (length fname) 0) - (if (> (length lname) 0) - (concat fname " " lname) - fname) - lname)))) - -;; Return the full name from a record. If the name is not available -;; in the namecache, the namecache value is generated (and stored). -(defun bbdb-record-name (record) - (or (bbdb-cache-namecache (bbdb-record-cache record)) - (bbdb-record-name-1 record))) - -;; Return the sortkey for a record, building (and storing) it if -;; necessary. -(defun bbdb-record-sortkey (record) - (or (bbdb-cache-sortkey (bbdb-record-cache record)) - (bbdb-cache-set-sortkey (bbdb-record-cache record) - (downcase - (concat (bbdb-record-lastname record) - (bbdb-record-firstname record) - (bbdb-record-company record)))))) - -(defmacro bbdb-record-marker (record) - (list 'bbdb-cache-marker (list 'bbdb-record-cache record))) - -(defmacro bbdb-record-deleted-p (record) - (list 'bbdb-cache-deleted-p (list 'bbdb-record-cache record))) - -(defmacro bbdb-record-set-deleted-p (record val) - (list 'bbdb-cache-set-deleted-p (list 'bbdb-record-cache record) val)) - -(defmacro bbdb-record-set-namecache (record newval) - (list 'bbdb-cache-set-namecache (list 'bbdb-record-cache record) newval)) - -(defmacro bbdb-record-set-sortkey (record newval) - (list 'bbdb-cache-set-sortkey (list 'bbdb-record-cache record) newval)) - -(defmacro bbdb-record-set-marker (record newval) - (list 'bbdb-cache-set-marker (list 'bbdb-record-cache record) newval)) - - -;; The "notes" and "properties" accessors don't need to be fast. - -(defun bbdb-record-notes (record) - (if (consp (bbdb-record-raw-notes record)) - (cdr (assq 'notes (bbdb-record-raw-notes record))) - (bbdb-record-raw-notes record))) - -;; this works on the 'company field as well. -(defun bbdb-record-getprop (record property) - (if (memq property '(name address addresses phone phones net aka AKA)) - (error "bbdb: cannot access the %s field this way" property)) - (if (eq property 'company) - (bbdb-record-company record) - (if (consp (bbdb-record-raw-notes record)) - (cdr (assq property (bbdb-record-raw-notes record))) - (if (and (eq property 'notes) - (stringp (bbdb-record-raw-notes record))) - (bbdb-record-raw-notes record) - nil)))) - -(defun bbdb-get-field (rec field &optional nn) - "Get the N-th element (or all if nil) of the notes FIELD of the REC. -If the note is absent, returns a zero length string." - (let ((note (or (bbdb-record-getprop rec field) ""))) - (if nn - (nth nn (split-string note " ,;\t\n\f\r\v")) - note))) - -;; this works on the 'company field as well. -(defun bbdb-record-putprop (record property newval) - (if (memq property '(name address addresses phone phones net aka AKA)) - (error "bbdb: cannot annotate the %s field this way" property)) - (if (eq property 'company) - (bbdb-record-set-company record - (bbdb-record-set-company record newval)) - (if (and (eq property 'notes) - (not (consp (bbdb-record-raw-notes record)))) - (bbdb-record-set-raw-notes record newval) - (or (listp (bbdb-record-raw-notes record)) - (bbdb-record-set-raw-notes record - (list (cons 'notes (bbdb-record-raw-notes record))))) - (let ((old (assq property (bbdb-record-raw-notes record)))) - (if old - (if newval - (setcdr old newval) - (bbdb-record-set-raw-notes record - (delq old (bbdb-record-raw-notes record)))) - (and newval - (bbdb-record-set-raw-notes record - (append (bbdb-record-raw-notes record) - (list (cons property newval)))))))) - ;; save some file space: if we ever end up with ((notes . "...")), - ;; replace it with the string. - (if (and (consp (bbdb-record-raw-notes record)) - (null (cdr (bbdb-record-raw-notes record))) - (eq 'notes (car (car (bbdb-record-raw-notes record))))) - (bbdb-record-set-raw-notes record - (cdr (car (bbdb-record-raw-notes record))))) - ) - ;; If we're changing the company, then we need to sort, since the company - ;; is the sortkey for nameless records. This should almost never matter... - (bbdb-change-record record (eq property 'company)) - newval) - -(defun bbdb-record-set-notes (record newval) - (if (consp (bbdb-record-raw-notes record)) - (bbdb-record-putprop record 'notes newval) - (bbdb-record-set-raw-notes record newval) - (bbdb-change-record record nil))) - -(defun bbdb-phone-string (phone) - (if (= 2 (length phone)) ; euronumbers.... - (aref phone 1) - ;; numbers should come in two forms: - ;; ["where" 415 555 1212 99] or ["where" "the number"] - (if (stringp (aref phone 1)) - (error "doubleplus ungood: euronumbers unwork")) - (concat (if (/= 0 (bbdb-phone-area phone)) - (format "(%03d) " (bbdb-phone-area phone)) - "") - (if (/= 0 (bbdb-phone-exchange phone)) - (format "%03d-%04d" - (bbdb-phone-exchange phone) (bbdb-phone-suffix phone)) - "") - (if (and (bbdb-phone-extension phone) - (/= 0 (bbdb-phone-extension phone))) - (format " x%d" (bbdb-phone-extension phone)) - "")))) - -;; Legacy function. Used to convert a zip datastructure string into a -;; formated string. As zip codes are plain strings now, use -;; `bbdb-address-zip' instead. -(defalias 'bbdb-address-zip-string 'bbdb-address-zip) - -(defmacro bbdb-record-lessp (record1 record2) - (list 'string< (list 'bbdb-record-sortkey record1) - (list 'bbdb-record-sortkey record2))) - -(defmacro bbdb-subint (string match-number) - (list 'string-to-int - (list 'substring string - (list 'match-beginning match-number) - (list 'match-end match-number)))) - -(eval-and-compile - (if (fboundp 'display-error) - (fset 'bbdb-display-error 'display-error) - (defun bbdb-display-error(msg stream) - (message "Error: %s" (nth 1 msg))))) - -(defmacro bbdb-error-retry (form) - (list 'catch ''--bbdb-error-retry-- - (list 'while ''t - (list 'condition-case '--c-- - (list 'throw ''--bbdb-error-retry-- form) - '(error - (ding) - (let ((cursor-in-echo-area t)) - (bbdb-display-error --c-- nil) - (sit-for 2))))))) - -;;; Completion on labels and field data - -;;; Realistically speaking, it doesn't make sense to offer minibuffer -;;; completion for some fields - like ones that don't have labels! -;;; -;;; Also, I could probably do this with macros similar to the -;;; def-struct stuff. -(defcustom bbdb-default-label-list - '("Home" "Office" "Mobile" "Other") - "*Default list of labels for Address and Phone fields." - :group 'bbdb-record-creation - :type '(repeat string)) - -(defcustom bbdb-phones-label-list - bbdb-default-label-list - "*List of labels for Phone field. -The default value is `bbdb-default-label-list'." - :group 'bbdb-record-creation - :type '(repeat string)) - -(defcustom bbdb-addresses-label-list - bbdb-default-label-list - "*List of labels for Address field. -The default value is `bbdb-default-label-list'." - :group 'bbdb-record-creation - :type '(repeat string)) - -(defun bbdb-label-completion-list (field) - "Figure out a completion list for the specified FIELD label. -This evaluates the variable bbdb-FIELD-label-list, such -as `bbdb-phones-label-list'." - (if (boundp (intern (format "bbdb-%s-label-list" field))) - (eval (intern (format "bbdb-%s-label-list" field))) - ;; special-case out the ones it doesn't make sense for here? - bbdb-default-label-list)) - -(defun bbdb-label-completion-default (field) - "Figure out a default label from the completion list for FIELD. -This evaluates the variable bbdb-default-FIELD-label, such -as `bbdb-default-phones-label', if it exists, or it takes -the first item from the list of completions for FIELD as -returned by `bbdb-label-completion-list'." - (if (boundp (intern (format "bbdb-default-%s-label" field))) - (eval (intern (format "bbdb-default-%s-label" field))) - (nth 0 (bbdb-label-completion-list field)))) - -;; These are so you can accumulate e.g. mail aliases or company names -;; and have BBDB offer completion on them. -(defun bbdb-data-completion-list (field) - "Figure out a completion list for the specified FIELD value. -This evaluates the variable bbdb-FIELD-data-list, such -as `bbdb-mail-alias-data-list', if it exists, or it uses -`bbdb-default-label-list'." - (if (boundp (intern (format "bbdb-%s-data-list" field))) - (eval (intern (format "bbdb-%s-data-list" field))) - ;; special-case out the ones it doesn't make sense for here? - bbdb-default-label-list)) - -(defun bbdb-data-completion-default (field) - "Figure out a default value from the completion list for FIELD. -This evaluates the variable bbdb-default-FIELD-data, such -as `bbdb-default-mail-alias-data', if it exists, or it takes -the first item from the list of completions for FIELD as -returned by `bbdb-data-completion-list'." - (if (boundp (intern (format "bbdb-default-%s-data" field))) - (eval (intern (format "bbdb-default-%s-data" field))) - (nth 0 (bbdb-label-completion-list field)))) - -;;; -(defvar bbdb-buffer nil) -(defun bbdb-buffer () - (if (and bbdb-buffer (buffer-live-p bbdb-buffer)) - bbdb-buffer - (when (and bbdb-file-remote - (file-newer-than-file-p bbdb-file-remote bbdb-file)) - (let ((coding-system-for-write bbdb-file-coding-system)) - (copy-file bbdb-file-remote bbdb-file t t))) - (setq bbdb-buffer (find-file-noselect bbdb-file 'nowarn)))) - -(defmacro bbdb-with-db-buffer (&rest body) - (cons 'with-current-buffer - (cons '(bbdb-buffer) - (if (and (boundp 'bbdb-debug) bbdb-debug) - ;; if we're debugging, and the .bbdb buffer is visible in - ;; a window, temporarilly switch to that window so that - ;; when we come out, that window has been scrolled to the - ;; record we've just modified. (make w-point = b-point) - (list - (list 'let '((w (and bbdb-debug - (get-buffer-window - (buffer-name - (get-buffer bbdb-file)))))) - (list 'save-excursion - (cons 'save-window-excursion - (cons '(and w (select-window w)) - body))))) - body)))) - -(defsubst bbdb-string-trim (string) - "Lose leading and trailing whitespace. Also remove all properties -from string." - (if (string-match "\\`[ \t\n]+" string) - (setq string (substring string (match-end 0)))) - (if (string-match "[ \t\n]+\\'" string) - (setq string (substring string 0 (match-beginning 0)))) - ;; This is not ideologically blasphemous. It is a bad function to - ;; use on regions of a buffer, but since this is our string, we can - ;; do whatever we want with it. --Colin - (set-text-properties 0 (length string) nil string) - string) - -(defun bbdb-read-string (prompt &optional default completions) - "Reads a string, trimming whitespace and text properties." - (bbdb-string-trim - (if completions - (completing-read prompt completions nil nil (cons default 0)) - (bbdb-string-trim (read-string prompt default))))) - -;;; Address formatting. - -(defcustom bbdb-time-display-format "%d %b %Y" - "The format for the timestamp to be used in the creation-date and -timestamp fields. See the documentation for `format-time-string'." - :group 'bbdb :type 'string) - -(defun bbdb-time-convert (date &optional format) - "Convert a date from the BBDB internal format to the format -determined by FORMAT (or `bbdb-time-display-format' if FORMAT not -present). Returns a string containing the date in the new format." - (let ((parts (bbdb-split date "-"))) - (format-time-string (or format bbdb-time-display-format) - (encode-time 0 0 0 (string-to-int (caddr parts)) - (string-to-int (cadr parts)) - (string-to-int (car parts)))))) - -(defalias 'bbdb-format-record-timestamp 'bbdb-time-convert) -(defalias 'bbdb-format-record-creation-date 'bbdb-time-convert) - -(defconst bbdb-gag-messages nil - "Bind this to t to quiet things down - do not set it!") - -(defconst bbdb-buffer-name "*BBDB*") - -(defcustom bbdb-display-layout-alist - '((one-line (order . (phones mail-alias net notes)) - (name-end . 24) - (toggle . t)) - (multi-line (omit . (creation-date timestamp)) - (toggle . t)) - (pop-up-multi-line) - (full-multi-line)) - "*An alist describing each display layout. -The format of an element is (LAYOUT-NAME OPTION-ALIST). - -By default there are four different layout types used by BBDB, which are -`one-line', `multi-line', `pop-up-multi-line' (used for pop-ups) and -`full-multi-line' (showing all fields of a record). - -OPTION-ALIST specifies the options for the layout. Valid options are: - - ------- Availability -------- - Format one-line multi-line default if unset ------------------------------------------------------------------------------- - (toggle . BOOL) + + nil - (order . FIELD-LIST) + + '(phones ...) - (omit . FIELD-LIST) + + nil - (name-end . INTEGER) + - 40 - (indentation . INTEGER) - + 14 - (primary . BOOL) - + nil - (test . SEXP) + + nil - -- toggle: controls if this layout is included when toggeling the display layout -- order: defines a user specific order for the fields, where `t' is a place - holder for all remaining fields -- omit: is a list of fields which should not be displayed or `t' to exclude all - fields except those listed in the order option -- name-end: sets the column where the name should end in one-line layout. -- indentation: sets the level of indentation for multi-line display. -- primary: controls wether only the primary net is shown or all are shown. -- test: a lisp expression controlling wether the record is to be displayed. - -When you add a new layout FOO, you can write a corresponding layout -function bbdb-format-record-layout-FOO. If you do not write your own -layout function, the multi-line layout will be used." - :group 'bbdb - :type - `(repeat - (cons :tag "Layout Definition" - (choice :tag "Layout type" - (const one-line) - (const multi-line) - (const pop-up-multi-line) - (const full-multi-line) - (symbol)) - (set :tag "Properties" - (cons :tag "Order" - (const :tag "List of fields to order by" order) - (repeat (choice (const phones) - (const addresses) - (const net) - (const AKA) - (const notes) - (symbol :tag "other") - (const :tag "Remaining fields" t)))) - (choice :tag "Omit" - :value (omit . nil) - (cons :tag "List of fields to omit" - (const :tag "Fields not to display" omit) - (repeat (choice (const phones) - (const addresses) - (const net) - (const AKA) - (const notes) - (symbol :tag "other")))) - (const :tag "Exclude all fields except those listed in the order property" t)) - (cons :tag "Indentation" - :value (indentation . 14) - (const :tag "Level of indentation for multi-line layout" - indentation) - (number :tag "Column")) - (cons :tag "End of name field" - :value (name-end . 24) - (const :tag "The column where the name should end in one-line layout" - name-end) - (number :tag "Column")) - (cons :tag "Toggle" - (const :tag "The layout is included when toggling display layout" toggle) - boolean) - (cons :tag "Primary Net Only" - (const :tag "Only the primary net address is included" primary) - boolean) - (cons :tag "Test" - (const :tag "Show only records passing this test" test) - (choice (const :tag "No test" nil) - (cons :tag "List of required fields" - (const :tag "Choose from the attributes in the following set:" and) - (set - (const name) - (const company) - (const net) - (const phones) - (const addresses) - (const notes))) - (sexp :tag "Lisp expression"))))))) - - -(defcustom bbdb-display-layout 'multi-line - "*The default display layout." - :group 'bbdb - :type '(choice (const one-line) - (const multi-line) - (const full-multi-line) - (symbol))) - -(defcustom bbdb-pop-up-display-layout 'pop-up-multi-line - "*The default display layout pop-up BBDB buffers, i.e. mail, news." - :group 'bbdb - :type '(choice (const one-line) - (const multi-line) - (const full-multi-line) - (symbol))) - -(defun bbdb-display-layout-get-option (layout option) - (let ((layout-spec (if (listp layout) - layout - (assoc layout bbdb-display-layout-alist))) - option-value) - (and layout-spec - (setq option-value (assoc option layout-spec)) - (cdr option-value)))) - -(defcustom bbdb-address-formatting-alist - '((bbdb-address-is-continental . bbdb-format-address-continental) - (nil . bbdb-format-address-default)) - "Alist of address identifying and address formatting functions. -The key is an identifying function which accepts an address. The -associated value is a formatting function which inserts the formatted -address in the current buffer. If the identifying function returns -non-nil, the formatting function is called. When nil is used as the -car, then the associated formatting function will always be called. -Therefore you should always have (nil . bbdb-format-address-default) as -the last element in the alist. - -All functions should take two arguments, the address and an indentation. -The indentation argument may be optional. - -This alist is used in `bbdb-format-address'. - -See also `bbdb-address-print-formatting-alist'." - :group 'bbdb-record-display - :type '(repeat (cons function function))) - -(defvar bbdb-address-print-formatting-alist) ; "bbdb-print" - -(defun bbdb-address-is-continental (addr) - "Return non-nil if the address ADDR is a continental address. -This is done by comparing the zip code to `bbdb-continental-zip-regexp'. - -This is a possible identifying function for -`bbdb-address-formatting-alist' and -`bbdb-address-print-formatting-alist'." - (string-match bbdb-continental-zip-regexp (bbdb-address-zip addr))) - -(defun bbdb-format-streets (addr indent) - "Insert street subfields of address ADDR in current buffer. -This may be used by formatting functions listed in -`bbdb-address-formatting-alist'." - (bbdb-mapc (lambda(str) - (indent-to indent) - (insert str "\n")) - (bbdb-address-streets addr))) - -(defun bbdb-format-address-continental (addr &optional indent) - "Insert formated continental address ADDR in current buffer. -This format is used in western Europe, for example. - -This function is a possible formatting function for -`bbdb-address-formatting-alist'. - -The result looks like this: - location: street - street - ... - zip city, state - country" - (setq indent (or indent 14)) - (let (;(fmt (format " %%%ds: " indent)) - (indent (+ 3 indent))) - ;(insert (format fmt (bbdb-address-location addr))) - (bbdb-format-streets addr indent) - (let ((c (bbdb-address-city addr)) - (s (bbdb-address-state addr)) - (z (bbdb-address-zip addr))) - (if (or (> (length c) 0) - (> (length z) 0) - (> (length s) 0)) - (progn - (indent-to indent) - (insert z (if (and (> (length z) 0) - (> (length c) 0)) " " "") - c (if (and (or (> (length z) 0) - (> (length c) 0)) - (> (length s) 0)) ", " "") - s "\n")))) - (let ((str (bbdb-address-country addr))) - (if (= 0 (length str)) nil - (indent-to indent) (insert str "\n"))))) - -(defun bbdb-format-address-default (addr &optional indent) - "Insert formated address ADDR in current buffer. -This is the default format; it is used in the US, for example. - -This function is a possible formatting function for -`bbdb-address-formatting-alist'. - -The result looks like this: - location: street - street - ... - city, state zip - country" - (setq indent (or indent 14)) - (let (;(fmt (format " %%%ds: " indent)) - (indent (+ 3 indent))) -; (insert (format fmt (bbdb-address-location addr))) - (bbdb-format-streets addr indent) - (let ((c (bbdb-address-city addr)) - (s (bbdb-address-state addr)) - (z (bbdb-address-zip addr))) - (if (or (> (length c) 0) - (> (length z) 0) - (> (length s) 0)) - (progn - (indent-to indent) - (insert c (if (and (> (length c) 0) - (> (length s) 0)) ", " "") - s (if (and (or (> (length c) 0) - (> (length s) 0)) - (> (length z) 0)) " " "") - z "\n")))) - (let ((str (bbdb-address-country addr))) - (if (= 0 (length str)) nil - (indent-to indent) (insert str "\n"))))) - -(defun bbdb-format-address (addr &optional printing indent) - "Call appropriate formatting function for address ADDR. - -If optional second argument PRINTING is non-nil, this uses the alist -`bbdb-address-print-formatting-alist' to determine how the address is to -formatted and inserted into the current buffer. This is used by -`bbdb-print-format-record'. - -If second argument PRINTING is nil, this uses the alist -`bbdb-address-formatting-alist' to determine how the address is to -formatted and inserted into the current buffer. This is used by -`bbdb-format-record'." - ;; alist contains functions ((ident1 . format1) (ident2 . format2) ...) - ;; the first identifying-function is (caar alist) - ;; the first formatting-function is (cdar alist) - (let ((alist (if printing bbdb-address-print-formatting-alist - bbdb-address-formatting-alist))) - ;; while there a functions left and the current function does not - ;; identify the address, try the next function. - (while (and (caar alist) - (null (funcall (caar alist) addr))) - (setq alist (cdr alist))) - ;; if we haven't reached the end of functions, we got a hit. - (when alist - (if printing - (funcall (cdar alist) addr) - (funcall (cdar alist) addr indent))))) - -(defun bbdb-format-record-name-company (record) - (let ((name (or (bbdb-record-name record) "???")) - (company (bbdb-record-company record)) - (start (point))) - - (insert name) - (put-text-property start (point) 'bbdb-field '(name)) - - (when company - (insert " - ") - (setq start (point)) - (insert company) - (put-text-property start (point) 'bbdb-field '(company))))) - -(defun bbdb-format-record-one-line-phones (layout record phone) - "Return a formatted phone number for one-line display." - (let ((start (point))) - (insert (format "%s " (aref phone 1))) - (put-text-property start (point) 'bbdb-field - (list 'phone phone (aref phone 0))) - (setq start (point)) - (insert (format "(%s)" (aref phone 0))) - (put-text-property start (point) 'bbdb-field - (list 'phone phone 'field-name)))) - -(defun bbdb-format-record-one-line-net (layout record net) - "Return a formatted list of nets for one-line display." - (let ((start (point))) - (insert net) - (put-text-property start (point) 'bbdb-field (list 'net net)))) - -(defun bbdb-format-record-layout-one-line (layout record field-list) - "Record formatting function for the one-line layout. -See `bbdb-display-layout-alist' for more." - ;; name and company - (bbdb-format-record-name-company record) - (let ((name-end (or (bbdb-display-layout-get-option layout 'name-end) - 40)) - start end) - (save-excursion - (setq end (point)) - (beginning-of-line) - (setq start (point))) - (when (> (- end start -1) name-end) - (put-text-property (+ start name-end -4) end 'invisible t) - (insert "...")) - ;; guarantee one space after name - company - (insert " ") - (indent-to name-end)) - ;; rest of the fields - (let (start field contentfun formatfun values value) - (while field-list - (setq field (car field-list) - contentfun (intern (concat "bbdb-record-" - (symbol-name field)))) - (if (fboundp contentfun) - (setq values (eval (list contentfun record))) - (setq values (bbdb-record-getprop record field))) - (when (and (eq field 'net) - (bbdb-display-layout-get-option layout 'primary)) - (setq values (list (car values)))) - (when values - (if (not (listp values)) (setq values (list values))) - (setq formatfun (intern (format "bbdb-format-record-%s-%s" - layout field))) - (while values - (setq start (point) - value (car values)) - (if (fboundp formatfun) - (funcall formatfun layout record value) - (insert (format "%s" value)) - (cond ((eq field 'addresses) - (put-text-property start (point) 'bbdb-field - (list 'address value))) - ((eq field 'phones) - (put-text-property start (point) 'bbdb-field - (list 'phone value))) - ((memq field '(name net aka)) - (put-text-property start (point) 'bbdb-field - (list field value ))) - (t - (put-text-property start (point) 'bbdb-field - (list 'property (list field value)))))) - (setq values (cdr values)) - (if values (insert ", "))) - (insert "; ")) - (setq field-list (cdr field-list)))) - ;; delete the trailing "; " - (backward-delete-char 2) - (insert "\n")) - -(defun bbdb-format-record-layout-multi-line (layout record field-list) - "Record formatting function for the multi-line layout. -See `bbdb-display-layout-alist' for more." - (bbdb-format-record-name-company record) - (insert "\n") - (let* ((notes (bbdb-record-raw-notes record)) - (indent (or (bbdb-display-layout-get-option layout 'indentation) 14)) - (fmt (format " %%%ds: " indent)) - start field) - (if (stringp notes) - (setq notes (list (cons 'notes notes)))) - (while field-list - (setq field (car field-list) - start (point)) - (cond ((eq field 'phones) - (let ((phones (bbdb-record-phones record)) - loc phone) - (while phones - (setq phone (car phones) - start (point)) - (setq loc (format fmt (bbdb-phone-location phone))) - (insert loc) - (put-text-property start (point) 'bbdb-field - (list 'phone phone 'field-name)) - (setq start (point)) - (insert (bbdb-phone-string phone) "\n") - (put-text-property start (point) 'bbdb-field - (list 'phone phone - (bbdb-phone-location phone))) - (setq phones (cdr phones)))) - (setq start nil)) - ((eq field 'addresses) - (let ((addrs (bbdb-record-addresses record)) - loc addr) - (while addrs - (setq addr (car addrs) - start (point)) - (setq loc (format fmt (bbdb-address-location addr))) - (insert loc) - (put-text-property start (point) 'bbdb-field - (list 'address addr 'field-name)) - (setq start (point)) - (bbdb-format-address addr nil indent) - (put-text-property start (point) 'bbdb-field - (list 'address addr - (bbdb-address-location addr))) - (setq addrs (cdr addrs)))) - (setq start nil)) - ((eq field 'net) - (let ((net (bbdb-record-net record))) - (when net - (insert (format fmt "net")) - (put-text-property start (point) 'bbdb-field - '(net field-name)) - (setq start (point)) - (if (bbdb-display-layout-get-option layout 'primary) - (insert (car net) "\n") - (insert (mapconcat (function identity) net ", ") "\n")) - (put-text-property start (point) 'bbdb-field '(net))))) - ((eq field 'aka) - (let ((aka (bbdb-record-aka record))) - (when aka - (insert (format fmt "AKA")) - (put-text-property start (point) 'bbdb-field - '(aka field-name)) - (insert (mapconcat (function identity) aka ", ") "\n") - (setq start (point)) - (put-text-property start (point) 'bbdb-field '(aka))))) - (t - (let ((note (assoc field notes)) - (indent (length (format fmt ""))) - p notefun) - (when note - (insert (format fmt field)) - (put-text-property start (point) 'bbdb-field - (list 'property note 'field-name)) - (setq start (point)) - (setq p (point) - notefun (intern (format "bbdb-format-record-%s" field))) - (if (fboundp notefun) - (insert (funcall notefun (cdr note))) - (insert (cdr note))) - (save-excursion - (save-restriction - (narrow-to-region p (1- (point))) - (goto-char (1+ p)) - (while (search-forward "\n" nil t) - (insert (make-string indent ?\ ))))) - (insert "\n")) - (put-text-property start (point) 'bbdb-field - (list 'property note))))) - (setq field-list (cdr field-list))))) - -(defalias 'bbdb-format-record-layout-full-multi-line - 'bbdb-format-record-layout-multi-line) - -(defalias 'bbdb-format-record-layout-pop-up-multi-line - 'bbdb-format-record-layout-multi-line) - -(defun bbdb-format-record (record &optional layout) - "Insert a formatted version of RECORD into the current buffer. - -LAYOUT can be a symbol describing a layout in -`bbdb-display-layout-alist'. For compatibility reasons, LAYOUT can -also be nil or t, where t stands for the one-line, and nil for the -multi-line layout." - (bbdb-debug (if (bbdb-record-deleted-p record) - (error "plus ungood: formatting deleted record"))) - (setq layout (cond ((eq nil layout) - 'multi-line) - ((eq t layout) - 'one-line) - ((symbolp layout) - layout) - (t - (error "Unknown layout `%s'" layout)))) - (let* ((layout-spec (assoc layout bbdb-display-layout-alist)) - (test (bbdb-display-layout-get-option layout-spec 'test)) - (omit-list (bbdb-display-layout-get-option layout-spec 'omit)) - (order-list (bbdb-display-layout-get-option layout-spec 'order)) - (all-fields (append '(phones addresses net aka) - (let ((raw-notes (bbdb-record-raw-notes record))) - (if (stringp raw-notes) - '(notes) - (mapcar (lambda (r) (car r)) raw-notes))))) - format-function field-list) - (when (or (not test) - ;; bind some variables for the test - (let ((name (bbdb-record-name record)) - (company (bbdb-record-company record)) - (net (bbdb-record-net record)) - (phones (bbdb-record-phones record)) - (addresses (bbdb-record-addresses record)) - (notes (bbdb-record-raw-notes record))) - ;; this must evaluate to non-nil if the record is to be shown - (eval test))) - (if (functionp omit-list) - (setq omit-list (funcall omit-list record layout))) - (if (functionp order-list) - (setq order-list (funcall order-list record layout))) - ;; first omit unwanted fields - (when (and omit-list (or (not order-list) (memq t order-list))) - (if (not (listp omit-list)) - ;; t => show nothing - (setq all-fields nil) - ;; listp => show all fields except those listed here - (while omit-list - (setq all-fields (delete (car omit-list) all-fields) - omit-list (cdr omit-list))))) - ;; then order them - (if (not order-list) - (setq field-list all-fields) - (if (not (memq t order-list)) - (setq field-list order-list) - (setq order-list (reverse order-list)) - (setq all-fields (delete nil (mapcar (lambda (f) - (if (memq f order-list) - nil - f)) - all-fields))) - (while order-list - (if (eq t (car order-list)) - (setq field-list (append all-fields field-list)) - (setq field-list (cons (car order-list) field-list))) - (setq order-list (cdr order-list))))) - ;; call the actual format function - (setq format-function - (intern (format "bbdb-format-record-layout-%s" layout))) - (if (functionp format-function) - (funcall format-function layout record field-list) - (bbdb-format-record-layout-multi-line layout record field-list))))) - -(defun bbdb-frob-mode-line (n) - (setq - ;; identification - mode-line-buffer-identification - (if (> n 0) - (list 24 (buffer-name) ": " - (list 10 (format "%d/%d" n (length (bbdb-records)))) - '(bbdb-showing-changed-ones " !!" " ")) - (list (buffer-name) ": Insidious Big Brother Database v" bbdb-version " " - mode-line-modified "-")) - ;; modified indicator - mode-line-modified - '(bbdb-readonly-p "--%%%%-" (bbdb-modified-p "--**-" "-----")))) - -(defun bbdb-display-records-1 (records &optional append layout) - (setq append (or append (bbdb-append-records-p))) - - (if (or (null records) - (consp (car records))) - nil - - ;; add layout and a marker to the local list of records - (setq layout (or layout bbdb-display-layout)) - (setq records (mapcar (lambda (x) - (list x layout (make-marker))) - records))) - - (let ((b (current-buffer)) - (temp-buffer-setup-hook nil) - (temp-buffer-show-hook nil) - (first (car (car records)))) - - (if bbdb-multiple-buffers (bbdb-pop-up-bbdb-buffer)) - - (with-output-to-temp-buffer bbdb-buffer-name - (set-buffer bbdb-buffer-name) - - ;; If append is set, clear the buffer, otherwise do clean up. - (unless append (bbdb-undisplay-records)) - - ;; If we're appending these records to the ones already displayed, - ;; then first remove any duplicates, and then sort them. - (if append - (let ((rest records)) - (while rest - (if (assq (car (car rest)) bbdb-records) - (setq records (delq (car rest) records))) - (setq rest (cdr rest))) - (setq records (append bbdb-records records)) - (setq records - (sort records - (lambda (x y) (bbdb-record-lessp (car x) (car y))))))) - (make-local-variable 'mode-line-buffer-identification) - (make-local-variable 'mode-line-modified) - (set (make-local-variable 'bbdb-showing-changed-ones) nil) - (let ((done nil) - (rest records) - (changed (bbdb-changed-records))) - (while (and rest (not done)) - (setq done (memq (car (car rest)) changed) - rest (cdr rest))) - (setq bbdb-showing-changed-ones done)) - (bbdb-frob-mode-line (length records)) - (and (not bbdb-gag-messages) - (not bbdb-silent-running) - (message "Formatting...")) - (bbdb-mode) - ;; this in in the *BBDB* buffer, remember, not the .bbdb buffer. - (set (make-local-variable 'bbdb-records) nil) - (setq bbdb-records records) - (let ((buffer-read-only nil) - prs) - (bbdb-debug (setq prs (bbdb-records))) - (setq truncate-lines t) - (while records - (bbdb-debug (if (not (memq (car (car records)) prs)) - (error "record doubleplus unpresent!"))) - (set-marker (nth 2 (car records)) (point)) - (bbdb-format-record (nth 0 (car records)) - (nth 1 (car records))) - (setq records (cdr records)))) - (and (not bbdb-gag-messages) - (not bbdb-silent-running) - (message "Formatting...done."))) - (set-buffer bbdb-buffer-name) - (if (and append first) - (let ((cons (assq first bbdb-records)) - (window (get-buffer-window (current-buffer)))) - (if window (set-window-start window (nth 2 cons))))) - (bbdbq) - ;; this doesn't really belong here, but it's convenient ... and when - ;; using electric display it would not be called otherwise. - (save-excursion (run-hooks 'bbdb-list-hook)) - (if bbdb-gui (bbdb-fontify-buffer)) - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (set-buffer b))) - -(defun bbdb-undisplay-records () - (let ((bbdb-display-buffer (get-buffer bbdb-buffer-name))) - (if (bufferp bbdb-display-buffer) - (save-excursion - (set-buffer bbdb-display-buffer) - (setq bbdb-showing-changed-ones nil - mode-line-modified nil - bbdb-records nil - buffer-read-only nil) - (erase-buffer) - (setq buffer-read-only t) - (set-buffer-modified-p nil))))) - - ;;; Electric display stuff - -(defconst bbdb-inside-electric-display nil) -;; hack hack: a couple of specials that the electric stuff uses for state. -(defvar bbdb-electric-execute-me) -(defvar bbdb-electric-completed-normally) - -(defun electric-bbdb-display-records (records) - (require 'electric) - (let ((bbdb-electric-execute-me nil)) ; Hack alert! throw-to-execute sets this! - (let ((bbdb-inside-electric-display t) - buffer - bbdb-electric-completed-normally ; Hack alert! throw-to-execute sets this! - ) - (save-excursion - (save-window-excursion - (save-window-excursion (bbdb-display-records-1 records)) - (setq buffer (window-buffer (Electric-pop-up-window bbdb-buffer-name))) - (set-buffer buffer) - (if (not bbdb-gag-messages) - (message "<<< Press Space to bury the Insidious Big Brother Database list >>>")) - (catch 'Done - (while t - (catch 'Blow-off-the-error - (setq bbdb-electric-completed-normally nil) - (unwind-protect - (progn - (catch 'electric-bbdb-list-select - (Electric-command-loop 'electric-bbdb-list-select - "-> " t)) - (setq bbdb-electric-completed-normally t)) - ;; protected - (if bbdb-electric-completed-normally - (throw 'Done t) - (ding) - (message "BBDB-Quit") - (throw 'Blow-off-the-error t) - ))))) - (bury-buffer buffer)))) - (message " ") - (if bbdb-electric-execute-me - (eval bbdb-electric-execute-me))) - nil) - -(defun bbdb-electric-throw-to-execute (form-to-execute) - "Exit the `electric-command-loop' and evaluate the given form." - ;; Hack alert! These variables are bound only within the scope of - ;; bbdb-electric-display-records! - (if (not (boundp 'bbdb-electric-execute-me)) - (error "plusungood: electrical short")) - (setq bbdb-electric-execute-me form-to-execute - bbdb-electric-completed-normally t) - (throw 'electric-bbdb-list-select t)) - - -(defun bbdb-done-command () (interactive) - (throw 'electric-bbdb-list-select t)) - -(defun bbdb-bury-buffer () - (interactive) - (if bbdb-inside-electric-display - (bbdb-done-command) - (bury-buffer))) - -(defun bbdb-display-records (records &optional layout append) - (let ((bbdb-window (get-buffer-window bbdb-buffer-name))) - (if (and bbdb-electric-p - ;; never be electric if the buffer is already on screen. - (not bbdb-window)) - (progn - (define-key bbdb-mode-map " " 'bbdb-done-command) - (electric-bbdb-display-records records)) - (bbdb-display-records-1 records append layout) - ;; don't smash keybinding if they invoked `bbdb-display' - ;; from inside an electric loop. - (unless bbdb-inside-electric-display - (define-key bbdb-mode-map " " 'undefined)) - (if (and (not bbdb-gag-messages) - (not bbdb-window)) - (message - (substitute-command-keys - (if (one-window-p t) - (if pop-up-windows - "Type \\[delete-other-windows] to unshow the bbdb-list window." - "Type \\[switch-to-buffer] RET to unshow the bbdb-list window.") - "Type \\[switch-to-buffer-other-window] RET to restore old contents of the bbdb-list window."))))))) - -(defun bbdbq () - (if (not (zerop (logand (random) 31))) nil - (let ((v '["\104\157\156\47\164\40\163\165\163\160\145\143\164\40\171\157\ -\165\162\40\156\145\151\147\150\142\157\162\72\40\162\145\160\157\162\164\40\ -\150\151\155\41" "\146\156\157\162\144" "\103\157\156\163\165\155\145\40\55\55\ -\40\102\145\40\123\151\154\145\156\164\40\55\55\40\104\151\145" "\114\157\166\ -\145\40\102\151\147\40\102\162\157\164\150\145\162" "\114\145\145\40\110\141\ -\162\166\145\171\40\117\163\167\141\154\144\40\141\143\164\145\144\40\141\154\ -\157\156\145" "\101\114\114\40\131\117\125\122\40\102\101\123\105\40\101\122\ -\105\40\102\105\114\117\116\107\40\124\117\40\125\123" "\127\141\162\40\151\ -\163\40\120\145\141\143\145" "\106\162\145\145\144\157\155\40\151\163\40\123\ -\154\141\166\145\162\171" "\111\147\156\157\162\141\156\143\145\40\151\163\40\ -\123\164\162\145\156\147\164\150" "\120\162\157\154\145\163\40\141\156\144\40\ -\141\156\151\155\141\154\163\40\141\162\145\40\146\162\145\145"])) - (message (aref v (% (logand 255 (random)) (length v)))) - (message " ")))) - -(defmacro bbdb-hashtable () - '(bbdb-with-db-buffer (bbdb-records nil t) bbdb-hashtable)) - -(defun bbdb-changed-records () - (bbdb-with-db-buffer (bbdb-records nil t) bbdb-changed-records)) - -(defmacro bbdb-build-name (f l) - (list 'downcase - (list 'if (list '= (list 'length f) 0) l - (list 'if (list '= (list 'length l) 0) f - (list 'concat f " " l))))) - -(defun bbdb-remove! (e l) - (if (null l) l - (let ((ret l) - (n (cdr l))) - (while n - (if (eq e (car n)) - (setcdr l (cdr n)) ; skip n - (setq l n)) ; keep n - (setq n (cdr n))) - (if (eq e (car ret)) (cdr ret) - ret)))) - -(defun bbdb-remove-memq-duplicates (l) - (let (ret tail) - (setq ret (cons '() '()) - tail ret) - (while l - (if (not (memq (car l) ret)) - (setq tail (setcdr tail (cons (car l) '())))) - (setq l (cdr l))) - (cdr ret))) - -(defmacro bbdb-gethash (name &optional ht) - (list 'symbol-value - (list 'intern-soft name - (or ht '(bbdb-hashtable))))) - -(defmacro bbdb-puthash (name record &optional ht) - (list 'let (list (list 'sym (list 'intern name (or ht '(bbdb-hashtable))))) - (list 'set 'sym (list 'cons record - '(and (boundp sym) (symbol-value sym)))))) - -(defmacro bbdb-remhash (name record &optional ht) - (list 'let (list (list 's (list 'intern-soft name - (or ht '(bbdb-hashtable))))) - (list 'and 's (list 'set 's (list 'bbdb-remove! record - (list 'symbol-value 's)))))) - -(defsubst bbdb-search-intertwingle (name net) - "Find bbdb records matching NAME and NET. - -This is a more stringent version of bbdb-search-simple, which I am -not inclined to modify for fear of damaging other code that currently -relies on it. BBDB internals should be migrated to use this function -to identify which record is referred to by a name/net combination, -since search-simple has been overloaded with other functionality. - -The name comes from -http://www.mozilla.org/blue-sky/misc/199805/intertwingle.html, which -any budding BBDB hacker should be at least vaguely familiar with." - (bbdb-records t) - (if name (setq name (downcase name))) - (if net (setq net (downcase net)) - (setq net "")) - (let ((net-recs (bbdb-gethash (downcase net))) - recs) - (while net-recs - (if (or (and (not name) net) - (string= name (downcase (bbdb-record-name (car net-recs))))) - (add-to-list 'recs (car net-recs))) - (setq net-recs (cdr net-recs))) - recs)) - -(defsubst bbdb-search-simple (name net) - "name is a string; net is a string or list of strings." - (if (eq 0 (length name)) (setq name nil)) - (if (eq 0 (length net)) (setq net nil)) - (bbdb-records t) ; make sure db is parsed; don't check disk (faster) - (let ((name-recs (if name ;; filter out companies from hash - (let ((recs (bbdb-gethash (downcase name))) - answer) - (while recs - (let ((n-rec (car recs))) - (if (string= (downcase name) - (downcase - (or (bbdb-record-name - n-rec) - (bbdb-record-company - n-rec) - ""))) - (setq answer (append recs (list n-rec)))) - (setq recs (cdr recs)))) - answer))) - (net-recs (if (stringp net) (bbdb-gethash (downcase net)) - (let (answer) - (while (and net (null answer)) - (setq answer (bbdb-gethash (downcase (car net))) - net (cdr net))) - answer))) - ret) - (if (not (and name-recs net-recs)) - (or (and name-recs (car name-recs)) - (and net-recs (car net-recs))) - - (while name-recs - (let ((name-rec (car name-recs)) - (nets net-recs)) - (while nets - (if (eq (car nets) name-rec) - (setq nets '() - name-recs '() - ret name-rec) - (setq nets (cdr nets)))) - (if name-recs (setq name-recs (cdr name-recs)) - name-rec))) - ret))) - -(defun bbdb-net-convert (record) - "Given a record whose net field is a comma-separated string, convert it to -a list of strings (the new way of doing things.) Returns the new list." - (bbdb-record-set-net record (bbdb-split (bbdb-record-net record) ","))) - -(defun bbdb-split (string separators) - "Return a list by splitting STRING at SEPARATORS. -The inverse function of `bbdb-join'." - (let (result - (not-separators (concat "^" separators))) - (save-excursion - (set-buffer (get-buffer-create " *split*")) - (erase-buffer) - (insert string) - (goto-char (point-min)) - (while (progn - (skip-chars-forward separators) - (skip-chars-forward " \t\n\r") - (not (eobp))) - (let ((begin (point)) - p) - (skip-chars-forward not-separators) - (setq p (point)) - (skip-chars-backward " \t\n\r") - (setq result (cons (buffer-substring begin (point)) result)) - (goto-char p))) - (erase-buffer)) - (nreverse result))) - -(defun bbdb-join (list separator) - "Join a LIST to a string where the list elements are separated by SEPARATOR. -The inverse function of `bbdb-split'." - (when list - (mapconcat 'identity list separator))) - -(defsubst bbdb-hash-record (record) - "Insert the record in the appropriate hashtables. This must be called -while the .bbdb buffer is selected." - (let ((name (bbdb-record-name-1 record)) ; faster version - (company (bbdb-record-company record)) - (aka (bbdb-record-aka record)) - (net (bbdb-record-net record))) - (if (> (length name) 0) - (bbdb-puthash (downcase name) record bbdb-hashtable)) - (if (> (length company) 0) - (bbdb-puthash (downcase company) record bbdb-hashtable)) - (while aka - (bbdb-puthash (downcase (car aka)) record bbdb-hashtable) - (setq aka (cdr aka))) - (while net - (bbdb-puthash (downcase (car net)) record bbdb-hashtable) - (setq net (cdr net))))) - - -;;; Reading the BBDB - -(defvar inside-bbdb-records nil - "Internal variable. Do not touch.") - -(defvar bbdb-write-file-hooks '(bbdb-write-file-hook-fn) - "*The list of functions added to `local-write-file-hooks' in `bbdb-file'.") - -(defun bbdb-records (&optional dont-check-disk already-in-db-buffer) - "Return a list of all bbdb records; read in and parse the db if necessary. -This also notices if the disk file has changed out from under us, unless -optional arg DONT-CHECK-DISK is non-nil (which is faster, but hazardous.)" - (if inside-bbdb-records - (let ((debug-on-error t)) - (error "catastrophic: bbdb-records recursed"))) - (let ((inside-bbdb-records t) - (buf (if already-in-db-buffer (current-buffer) (bbdb-buffer))) - shut-up) - (with-current-buffer buf - ;; make sure the BBDB in memory is not out of synch with disk. - (cond (dont-check-disk nil) - ((verify-visited-file-modtime buf) nil) - ((and bbdb-auto-revert-p (not (buffer-modified-p buf))) - (message "BBDB has changed on disk, reverting...") - (setq shut-up t) - (revert-buffer t t)) - ;; hassle the user - ((bbdb-yes-or-no-p - (if (buffer-modified-p buf) - "BBDB has changed on disk; flush your changes and revert? " - "BBDB has changed on disk; revert? ")) - (or (file-exists-p bbdb-file) - (error "bbdb: file %s no longer exists!!" bbdb-file)) - (revert-buffer t t)) - ;; this is the case where the .bbdb file has changed; the buffer - ;; has changed as well; and the user has answered "no" to the - ;; "flush your changes and revert" question. The only other - ;; alternative is to save the file right now. If they answer - ;; no to the following question, they will be asked the - ;; preceeding question again and again some large (but finite) - ;; number of times. `bbdb-records' is called a lot, you see... - ((buffer-modified-p buf) - ;; this prompts - (bbdb-save-db t t)) - ;; otherwise, the buffer and file are inconsistent, but we let - ;; them stay that way. - ) - (unless (assq 'bbdb-records (buffer-local-variables)) - (set (make-local-variable 'bbdb-records) nil) - (set (make-local-variable 'bbdb-changed-records) nil) - (set (make-local-variable 'bbdb-end-marker) nil) - (set (make-local-variable 'bbdb-hashtable) nil) - (set (make-local-variable 'bbdb-propnames) nil) - (set (make-local-variable 'revert-buffer-function) - 'bbdb-revert-buffer) - (bbdb-mapc (lambda (ff) (add-hook 'local-write-file-hooks ff)) - bbdb-write-file-hooks) - (setq bbdb-hashtable (make-vector bbdb-hashtable-size 0))) - (setq bbdb-modified-p (buffer-modified-p) - buffer-read-only bbdb-readonly-p) - (or bbdb-records - (cond ((= (point-min) (point-max)) ; special-case empty db - ;; this doesn't need to be insert-before-markers because - ;; there are no db-markers in this buffer. - (insert (format ";; -*-coding: %s;-*-\n;;; file-version: %d\n" - bbdb-file-coding-system bbdb-file-format)) - (bbdb-flush-all-caches) - (setq bbdb-end-marker (point-marker)) - ;;(run-hooks 'bbdb-after-read-db-hook) ; run this? - nil) - (t - (or shut-up bbdb-silent-running (message "Parsing BBDB...")) - (bbdb-flush-all-caches) - (cond ((and bbdb-notice-auto-save-file - (file-newer-than-file-p (make-auto-save-file-name) - buffer-file-name)) - (if (bbdb-yes-or-no-p "BBDB auto-save file is newer; recover it? ") - (progn - (recover-file buffer-file-name) - (bury-buffer (current-buffer)) ; recover-file selects it - (auto-save-mode 1) ; turn autosave back on - (delete-file (make-auto-save-file-name)) - (message "Auto-save mode is ON in BBDB buffer. Suggest you save it soon.") - (sleep-for 2)) - ;; delete auto-save anyway, so we don't keep asking. - (condition-case nil - (delete-file (make-auto-save-file-name)) - (file-error nil))) - ;; tail-recurse and try again - (let ((inside-bbdb-records nil)) - (bbdb-records))) - (t - ;; normal case - (fillarray bbdb-hashtable 0) - (parse-bbdb-internal))))))))) - -(defun bbdb-revert-buffer (arg noconfirm) - ;; The .bbdb file's revert-buffer-function. - ;; Don't even think of calling this. - (kill-all-local-variables) ; clear db and caches. - (if (get-buffer bbdb-buffer-name) ; now contains invalid records; nukem. - (bbdb-undisplay-records)) - (let ((revert-buffer-function nil)) ; don't loop. - (revert-buffer arg noconfirm))) - -(defun parse-bbdb-internal () - (bbdb-debug (message "Parsing BBDB... (reading...)")) - (widen) - (goto-char (point-min)) - ;; go to the point at which the first record begins - (cond ((eq (following-char) ?\[) nil) - ((search-forward "\n[" nil 0) (forward-char -1)) - (t nil)) ;; no records - ;; look backwards for user-defined field names (for completion purposes.) - (save-excursion - (if (re-search-backward "^;+[ \t]*user-fields:[ \t]*\(" nil t) - (progn - (goto-char (1- (match-end 0))) - (setq bbdb-propnames - (mapcar (lambda (x) (list (symbol-name x))) - (read (point-marker))))))) - ;; look backwards for file version, and convert if necessary. - ;; (at least, I'll write this code if I ever change the file format again...) - (let ((v (save-excursion - (if (re-search-backward - "^;+[ \t]*file-version:[ \t]*\\([0-9]+\\)[ \t]*$" nil t) - (car (read-from-string - (buffer-substring - (match-beginning 1) (match-end 1)))))))) - (if (null v) ; current version, but no file-version: line. Bootstrap it. - (let ((modp (buffer-modified-p))) - ;; This should never happen (not any more, anyway...) - (bbdb-debug (error "bbdb corrupted: no file-version line")) - (setq v 2) - (save-excursion - (if (re-search-backward "^;" nil t) - (forward-line 1) - (goto-char 1)) - ;; remember, this goes before the begin-marker of the first - ;; record in the database! - (insert-before-markers - (format ";; -*-coding: %s;-*-\n;;; file-version: %d\n" - bbdb-file-coding-system bbdb-file-format))) - (set-buffer-modified-p modp))) - (cond ((< v bbdb-file-format) - (if bbdb-file-format-migration - ;; Sanity checking. - (if (/= (car bbdb-file-format-migration) v) - (error - (format - "BBDB file format has changed on disk from %d to %d!" - (car bbdb-file-format-migration) v))) - (setq bbdb-file-format-migration - (cons v (bbdb-migration-query v))))) - ((> v bbdb-file-format) - (error "BBDB version %s doesn't understand file format version %s." - bbdb-version v)) - (t (setq bbdb-file-format-migration (cons bbdb-file-format - bbdb-file-format))))) - ;; A trap to catch a bug - ;;(assert (not (null (car bbdb-file-format-migration)))) - - (bbdb-debug - (or (eobp) (looking-at "[\[]") - (error "no following bracket: bbdb corrupted")) - (if (save-excursion - (save-restriction - (widen) - (save-excursion (search-backward "\n[" nil t)))) - (error "bbdb corrupted: records before point"))) - - ;; Migrate only if we need to. Change the .bbdb buffer only if it - ;; is not to be saved in the newest version. - (if (= (car bbdb-file-format-migration) bbdb-file-format) - (parse-bbdb-frobnicate (parse-bbdb-read)) - (let ((newrecs (parse-bbdb-frobnicate (bbdb-migrate (parse-bbdb-read))))) - (cond ((= (cdr bbdb-file-format-migration) bbdb-file-format) - (bbdb-migrate-rewrite-all nil newrecs) - (bbdb-migrate-update-file-version - (car bbdb-file-format-migration) - (cdr bbdb-file-format-migration)))) - newrecs))) - -(defun parse-bbdb-read () - ;; narrow the buffer to skip over the rubbish before the first record. - (narrow-to-region (point) (point-max)) - (let ((records nil)) - ;; insert parens so we can read the db in one fell swoop (down in C). - (let ((buffer-read-only nil) - (modp (buffer-modified-p)) - ;; Make sure those parens get cleaned up. - ;; This code had better stay simple! - (inhibit-quit t)) - (goto-char (point-min)) (insert "(\n") - (goto-char (point-max)) (insert "\n)") - (goto-char (point-min)) - (setq records (read (current-buffer))) - (goto-char (point-min)) (delete-char 2) - (goto-char (point-max)) (delete-char -2) - (set-buffer-modified-p modp)) - records)) - -(defun parse-bbdb-frobnicate (records) - ;; now we have to come up with a marker for each record. Rather than - ;; calling read for each record, we read them at once (already done) and - ;; assume that the markers are at each newline. If this isn't the case, - ;; things can go *very* wrong. - (goto-char (point-min)) - (while (looking-at "[ \t\n\f]*;") - (forward-line 1)) - (widen) - (bbdb-debug (message "Parsing BBDB... (frobnicating...)")) - (setq bbdb-records records) - (let* ((head (cons '() records)) - (rest head) - record) - (while (cdr rest) - (setq record (car (cdr rest))) - ;; yow, are we stack-driven yet?? Damn byte-compiler... - ;; Make a cache. Put it in the record. Put a marker in the cache. - ;; Add record to hash tables. - (bbdb-cache-set-marker - (bbdb-record-set-cache record (make-vector bbdb-cache-length nil)) - (point-marker)) - (forward-line 1) - - ;; frob the label completion lists (and data completion when I, - ;; uh, get around to it, maybe. this stuff should probably be - ;; conditional, in case you're not running a 42GHz Pentium 69 - ;; with chrome tailpipes) - (let ((ps (bbdb-record-phones record)) - (pl (bbdb-label-completion-list "phones")) - (as (bbdb-record-addresses record)) - (al (bbdb-label-completion-list "addresses"))) - (while ps - (let ((l (bbdb-phone-location (car ps)))) - (or (member l pl) - (setq bbdb-phones-label-list - (append (or bbdb-phones-label-list - bbdb-default-label-list) - (list l)) - pl bbdb-phones-label-list))) - (setq ps (cdr ps))) - ;; Yes, I cut and pasted. - (while as - (let ((l (bbdb-address-location (car as)))) - (or (member l al) - (setq bbdb-addresses-label-list - (append (or bbdb-addresses-label-list - bbdb-default-label-list) - (list l)) - al bbdb-addresses-label-list))) - (setq as (cdr as)))) - - (if bbdb-no-duplicates-p - ;; warn the user that there is a duplicate... - (let* ((name (bbdb-record-name record)) - (tmp (and name (bbdb-gethash (downcase name) - bbdb-hashtable)))) - (if tmp (message "Duplicate BBDB record encountered: %s" name)))) - - (bbdb-hash-record record) - (setq rest (cdr rest)) - - (bbdb-debug - (if (and (cdr rest) (not (looking-at "[\[]"))) - (error "bbdb corrupted: junk between records at %s" (point))))) - ;; In case we removed some of the leading entries... - (setq bbdb-records (cdr head))) - ;; all done. - (setq bbdb-end-marker (point-marker)) - (run-hooks 'bbdb-after-read-db-hook) - (bbdb-debug (message "Parsing BBDB... (frobnicating...done)")) - bbdb-records) - -(defmacro bbdb-user-mail-names () - "Returns a regexp matching the address of the logged-in user." - '(or bbdb-user-mail-names - (setq bbdb-user-mail-names - (concat "\\b" (regexp-quote (user-login-name)) "\\b")))) - -(defun bbdb-write-file-hook-fn () - "This is just for `bbdb-write-file-hooks'. Keep it there." - ;; this is premature as the file isn't actually written yet; but it's just - ;; for the benefit of the mode-line of the *BBDB* buffer, and there isn't - ;; an after-write-file-hook, so it'll do. - (save-restriction - (widen) - (goto-char (point-min)) - ;; Fixme: probably this should check any existing cookie for - ;; consistency with bbdb-file-coding-system. - (unless (looking-at ";; *-\\*-coding:") - (insert-before-markers (format ";; -*-coding: %s;-*-\n" - bbdb-file-coding-system)))) - (setq bbdb-modified-p nil - bbdb-changed-records nil) - (let ((buf (get-buffer bbdb-buffer-name))) - (when buf - (with-current-buffer buf - (setq bbdb-showing-changed-ones nil) - (set-buffer-modified-p nil)))) - (when (and bbdb-file-remote - (or bbdb-file-remote-save-always - (y-or-n-p (format "Save the remote BBDB file %s too? " - bbdb-file-remote)))) - ;; write the current buffer, which is `bbdb-file' (since this is called - ;; from its `local-write-file-hooks'), into the `bbdb-file-remote'. - (let ((coding-system-for-write bbdb-file-coding-system)) - (write-region (point-min) (point-max) bbdb-file-remote)))) - -(defun bbdb-delete-record-internal (record) - (if (null (bbdb-record-marker record)) (error "bbdb: marker unpresent")) - (bbdb-with-db-buffer - (if (or bbdb-suppress-changed-records-recording - (memq record bbdb-changed-records)) - nil - (setq bbdb-changed-records (cons record bbdb-changed-records))) - (let ((tail (memq record bbdb-records))) - (if (null tail) (error "bbdb: unfound %s" record)) - (setq bbdb-records (delq record bbdb-records)) - (delete-region (bbdb-record-marker record) - (if (cdr tail) - (bbdb-record-marker (car (cdr tail))) - bbdb-end-marker)) - (let ((name (bbdb-record-name record)) - (company (bbdb-record-company record)) - (aka (bbdb-record-aka record)) - (nets (bbdb-record-net record))) - (if (> (length name) 0) - (bbdb-remhash (downcase name) record bbdb-hashtable)) - (if (> (length company) 0) - (bbdb-remhash (downcase company) record bbdb-hashtable)) - (while nets - (bbdb-remhash (downcase (car nets)) record bbdb-hashtable) - (setq nets (cdr nets))) - (while aka - (bbdb-remhash (downcase (car aka)) record bbdb-hashtable) - (setq aka (cdr aka))) - ) - (bbdb-record-set-sortkey record nil) - (setq bbdb-modified-p t)))) - -(defun bbdb-insert-sorted (record records) - "Inserts the RECORD into the list of RECORDS, in order. -Assumes the list is already sorted. Returns the new head." - (bbdb-debug (if (memq record records) - (error "doubleplus ununique: - %s" record))) - (let* ((rest (cons nil records)) - (top rest)) - (while (and (cdr rest) - (bbdb-record-lessp (nth 1 rest) record)) - (setq rest (cdr rest))) - (setcdr rest (cons record (cdr rest))) - (cdr top))) - -(defun bbdb-insert-record-internal (record unmigrated) - (if (null (bbdb-record-marker record)) - (bbdb-record-set-marker record (make-marker))) - (bbdb-with-db-buffer - (if (or bbdb-suppress-changed-records-recording - (memq record bbdb-changed-records)) - nil - (setq bbdb-changed-records (cons record bbdb-changed-records))) - (let ((print-escape-newlines t)) - (bbdb-record-set-sortkey record nil) ; just in case... - (setq bbdb-records - (bbdb-insert-sorted record bbdb-records)) - (let ((next (car (cdr (memq record bbdb-records))))) - (goto-char (if next - (bbdb-record-marker next) - bbdb-end-marker)) - ;; before printing the record, remove the cache \(we don't want that - ;; written to the file.\) Ater writing, put the cache back and update - ;; the cache's marker. - (let ((cache (bbdb-record-cache record)) - (point (point))) - (bbdb-debug - (if (= point (point-min)) - (error "doubleplus ungood: inserting at point-min (%s)" point)) - (if (and (/= point bbdb-end-marker) - (not (looking-at "[\[]"))) - (error "doubleplus ungood: not inserting before a record (%s)" - point))) - (bbdb-record-set-cache record nil) - (if unmigrated (bbdb-record-set-cache unmigrated nil)) - (insert-before-markers (prin1-to-string (or unmigrated record)) "\n") - (set-marker (bbdb-cache-marker cache) point) - (bbdb-record-set-cache record cache) -;; (if (bbdb-record-name record) -;; (bbdb-puthash (downcase (bbdb-record-name record)) record bbdb-hashtable)) -;; (let ((nets (bbdb-record-net record))) -;; (while nets -;; (bbdb-puthash (downcase (car nets)) record bbdb-hashtable) -;; (setq nets (cdr nets)))) - ;; This is marginally slower because it rebuilds the namecache, - ;; but it makes jbw's life easier. :-\) - (bbdb-hash-record record)) - record)) - (setq bbdb-modified-p t))) - -(defun bbdb-overwrite-record-internal (record unmigrated) - (bbdb-with-db-buffer - (if (or bbdb-suppress-changed-records-recording - (memq record bbdb-changed-records)) - nil - (setq bbdb-changed-records (cons record bbdb-changed-records))) - (let ((print-escape-newlines t) - (tail bbdb-records)) - ;; Look for record after RECORD in the database. Use the - ;; beginning marker of this record (or the marker for the end of - ;; the database if no next record) to determine where to stop - ;; deleting old copy of record - (while (and tail (not (eq record (car tail)))) - (setq tail (cdr tail))) - (if (null tail) (error "bbdb: unfound %s" record)) - (let ((cache (bbdb-record-cache record))) - - (bbdb-debug - (if (<= (bbdb-cache-marker cache) (point-min)) - (error "doubleplus ungood: cache marker is %s" - (bbdb-cache-marker cache))) - (goto-char (bbdb-cache-marker cache)) - (if (and (/= (point) bbdb-end-marker) - (not (looking-at "[\[]"))) - (error "doubleplus ungood: not inserting before a record (%s)" - (point)))) - - (goto-char (bbdb-cache-marker cache)) - (bbdb-record-set-cache record nil) - (if unmigrated (bbdb-record-set-cache unmigrated nil)) - - (insert (prin1-to-string (or unmigrated record)) "\n") - (delete-region (point) - (if (cdr tail) - (bbdb-record-marker (car (cdr tail))) - bbdb-end-marker)) - (bbdb-record-set-cache record cache) - - (bbdb-debug - (if (<= (if (cdr tail) - (bbdb-record-marker (car (cdr tail))) - bbdb-end-marker) - (bbdb-record-marker record)) - (error "doubleplus ungood: overwrite unworks"))) - - (setq bbdb-modified-p t) - record)))) - -(defvar inside-bbdb-change-record nil "hands off") -(defvar inside-bbdb-notice-hook nil - "Internal variable; hands off. -Set to t by the BBDB when inside the `bbdb-notice-hook'. - -Calls to the `bbdb-change-hook' are suppressed when this is non-nil.") - -(defun bbdb-change-record (record need-to-sort) - "Update the database after a change to the given record. Second arg -NEED-TO-SORT is whether the name has changed. You still need to worry -about updating the name hash-table." - (if inside-bbdb-change-record - record - (let ((inside-bbdb-change-record t) - unmigrated) - (or inside-bbdb-notice-hook - (bbdb-invoke-hook 'bbdb-change-hook record)) - (bbdb-debug (if (bbdb-record-deleted-p record) - (error "bbdb: changing deleted record"))) - (if (/= (cdr bbdb-file-format-migration) bbdb-file-format) - (bbdb-unmigrate-record (setq unmigrated (bbdb-copy-thing record)))) - ;; Do the changing - (if (memq record (bbdb-records)) ; checks file synchronization too. - (if (not need-to-sort) ;; If we don't need to sort, overwrite it. - (progn - (bbdb-overwrite-record-internal record unmigrated) - (bbdb-debug - (if (not (memq record (bbdb-records))) - (error "Overwrite in change doesn't work")))) - ;; Since we do need to sort, delete then insert - (bbdb-delete-record-internal record) - (bbdb-debug - (if (memq record (bbdb-records)) - (error "Delete in need-sort change doesn't work"))) - (bbdb-insert-record-internal record unmigrated) - (bbdb-debug - (if (not (memq record (bbdb-records))) - (error "Insert in need-sort change doesn't work")))) - ;; Record isn't in database so add it. - (bbdb-insert-record-internal record unmigrated) - (bbdb-debug (if (not (memq record (bbdb-records))) - (error "Insert in change doesn't work")))) - (setq bbdb-modified-p t) - (bbdb-invoke-hook 'bbdb-after-change-hook record) - record))) - -(defun bbdb-copy-thing (thing) - "Copy a thing. Handles vectors, strings, markers, numbers, conses, -lists, symbols, and nil. Raises an error if it finds something it -doesn't know how to deal with." - (cond ((vectorp thing) - (let ((i 0) - (newvec (make-vector (length thing) nil))) - (while (< i (length thing)) - (aset newvec i (bbdb-copy-thing (aref thing i))) - (setq i (1+ i))) - newvec)) - ((stringp thing) - (copy-sequence thing)) - ((markerp thing) - (copy-marker thing)) - ((numberp thing) - thing) - ((consp thing) - (cons (bbdb-copy-thing (car thing)) - (bbdb-copy-thing (cdr thing)))) - ((listp thing) - (let ((i 0) newlist) - (while (< i (length thing)) - (setq newlist (append newlist (list (bbdb-copy-thing - (nth i thing)))) - i (1+ i))) - newlist)) - ((symbolp thing) - thing) - ((eq nil thing) - nil) - (t - (error "Don't know how to copy %s" (prin1-to-string thing))))) - -(defmacro bbdb-propnames () - '(bbdb-with-db-buffer bbdb-propnames)) - -(defun bbdb-set-propnames (newval) - (bbdb-with-db-buffer - (setq bbdb-propnames newval) - (widen) - (goto-char (point-min)) - (and (not (eq (following-char) ?\[)) - (search-forward "\n[" nil 0)) - (if (re-search-backward "^[ \t]*;+[ \t]*user-fields:[ \t]*\(" nil t) - (progn - (goto-char (1- (match-end 0))) - (delete-region (point) (progn (end-of-line) (point)))) - (and (re-search-backward "^[ \t]*;.*\n" nil t) - (goto-char (match-end 0))) - ;; remember, this goes before the begin-marker of the first - ;; record in the database! - (insert-before-markers ";;; user-fields: \n") - (forward-char -1)) - (prin1 (mapcar (lambda (x) (intern (car x))) - bbdb-propnames) - (current-buffer)) - bbdb-propnames)) - - -;;; BBDB mode - -(defun bbdb-mode () - "Major mode for viewing and editing the Insidious Big Brother Database. -Letters no longer insert themselves. Numbers are prefix arguments. -You can move around using the usual cursor motion commands. -\\ -\\[bbdb-add-or-remove-mail-alias]\t Add new mail alias to visible records or \ -remove it. -\\[bbdb-edit-current-field]\t Edit the field on the current line. -\\[bbdb-record-edit-notes]\t Edit the `notes' field for the current record. -\\[bbdb-delete-current-field-or-record]\t Delete the field on the \ -current line. If the current line is the\n\t first line of a record, then \ -delete the entire record. -\\[bbdb-insert-new-field]\t Insert a new field into the current record. \ -Note that this\n\t will let you add new fields of your own as well. -\\[bbdb-transpose-fields]\t Swap the field on the current line with the \ -previous field. -\\[bbdb-dial]\t Dial the current phone field. -\\[bbdb-next-record], \\[bbdb-prev-record]\t Move to the next or the previous \ -displayed record, respectively. -\\[bbdb-create]\t Create a new record. -\\[bbdb-toggle-records-display-layout]\t Toggle whether the current record is displayed in a \ -one-line\n\t listing, or a full multi-line listing. -\\[bbdb-apply-next-command-to-all-records]\\[bbdb-toggle-records-display-layout]\t Do that \ -for all displayed records. -\\[bbdb-refile-record]\t Merge the contents of the current record with \ -some other, and then\n\t delete the current record. See this command's \ -documentation. -\\[bbdb-omit-record]\t Remove the current record from the display without \ -deleting it from\n\t the database. This is often a useful thing to do \ -before using one\n\t of the `*' commands. -\\[bbdb]\t Search for records in the database (on all fields). -\\[bbdb-net]\t Search for records by net address. -\\[bbdb-company]\t Search for records by company. -\\[bbdb-notes]\t Search for records by note. -\\[bbdb-name]\t Search for records by name. -\\[bbdb-changed]\t Display records that have changed since the database \ -was saved. -\\[bbdb-send-mail]\t Compose mail to the person represented by the \ -current record. -\\[bbdb-apply-next-command-to-all-records]\\[bbdb-send-mail]\t Compose mail \ -to everyone whose record is displayed. -\\[bbdb-finger]\t Finger the net address of the current record. -\\[bbdb-ftp]\t FTP to the curent records's `ftp' field. -\\[bbdb-apply-next-command-to-all-records]\\[bbdb-finger]\t Finger the \ -net address of all displayed records. -\\[bbdb-save-db]\t Save the BBDB file to disk. -\\[bbdb-print]\t Create a TeX file containing a pretty-printed version \ -of all the\n\t records in the database. -\\[bbdb-apply-next-command-to-all-records]\\[bbdb-print]\t Do that for the \ -displayed records only. -\\[other-window]\t Move to another window. -\\[bbdb-info]\t Read the Info documentation for BBDB. -\\[bbdb-help]\t Display a one line command summary in the echo area. -\\[bbdb-www]\t Visit Web sites listed in the `www' field(s) of the current \ -record. -\\[bbdb-whois]\t run whois on the current record. - -For address completion using the names and net addresses in the database: -\t in Sendmail mode, type \\\\[bbdb-complete-name]. -\t in Message mode, type \\\\[bbdb-complete-name]. - -Variables of note: -\t bbdb-always-add-addresses -\t bbdb-auto-revert-p -\t bbdb-canonicalize-redundant-nets-p -\t bbdb-case-fold-search -\t bbdb-completion-type -\t bbdb-default-area-code -\t bbdb-default-domain -\t bbdb-electric-p -\t bbdb-display-layout -\t bbdb-file -\t bbdb-message-caching-enabled -\t bbdb-new-nets-always-primary -\t bbdb-north-american-phone-numbers-p -\t bbdb-notice-auto-save-file -\t bbdb-offer-save -\t bbdb-pop-up-display-layout -\t bbdb-pop-up-target-lines -\t bbdb-quiet-about-name-mismatches -\t bbdb-readonly-p -\t bbdb-use-alternate-names -\t bbdb-use-pop-up -\t bbdb-user-mail-names -\t bbdb/mail-auto-create-p -\t bbdb/news-auto-create-p - -There are numerous hooks. M-x apropos ^bbdb.*hook RET - -The keybindings, more precisely: -\\{bbdb-mode-map}" - (setq major-mode 'bbdb-mode) - (setq mode-name "BBDB") - (use-local-map bbdb-mode-map) - (run-hooks 'bbdb-mode-hook)) - -;;; these should be in bbdb-com.el but they're so simple, why load it all. - -(defun bbdb-next-record (p) - "Move the cursor to the first line of the next BBDB record." - (interactive "p") - (if (< p 0) - (bbdb-prev-record (- p)) - (forward-char) - (while (> p 0) - (or (re-search-forward "^[^ \t\n]" nil t) - (progn (beginning-of-line) - (error "no next record"))) - (setq p (1- p))) - (beginning-of-line))) - -(defun bbdb-prev-record (p) - "Move the cursor to the first line of the previous BBDB record." - (interactive "p") - (if (< p 0) - (bbdb-next-record (- p)) - (while (> p 0) - (or (re-search-backward "^[^ \t\n]" nil t) - (error "no previous record")) - (setq p (1- p))))) - - -(defun bbdb-maybe-update-display (bbdb-record) - (save-excursion - (save-window-excursion - (let ((w (get-buffer-window bbdb-buffer-name)) - (b (current-buffer))) - (if w - (unwind-protect - (progn (set-buffer bbdb-buffer-name) - (save-restriction - (if (assq bbdb-record bbdb-records) - (bbdb-redisplay-records)))) - (set-buffer b))))))) - -(defcustom bbdb-notes-default-separator ", " - "*The default separator inserted by `bbdb-annotate-notes'. -This is used for notes which do not have `field-separator' property set. -E.g., if you want URLs to be separated by newlines, you can put - (put 'www 'field-separator \"\\n\") -into your .emacs." - :group 'bbdb-noticing-records - :type 'string) - -(defun bbdb-annotate-notes (bbdb-record annotation &optional fieldname replace) - "Add an annotation to a record. -Adds (or replaces, when the fourth argument REPLACE is non-nil) -an ANNOTATION to the note FIELDNAME in BBDB-RECORD. -Called by `bbdb-auto-notes-hook'." - (or bbdb-record (error "unperson")) - (setq annotation (bbdb-string-trim annotation)) - (if (memq fieldname '(name address addresses phone phones net aka AKA)) - (error "bbdb: cannot annotate the %s field this way" fieldname)) - (or fieldname (setq fieldname 'notes)) - (or (memq fieldname '(notes company)) - (assoc (symbol-name fieldname) (bbdb-propnames)) - (bbdb-set-propnames (append (bbdb-propnames) - (list (list (symbol-name fieldname)))))) - (let ((notes (bbdb-string-trim - (or (bbdb-record-getprop bbdb-record fieldname) "")))) - (unless (or (string= "" annotation) - (string-match (regexp-quote annotation) notes)) - (bbdb-record-putprop bbdb-record fieldname - (if (or replace (string= notes "")) - annotation - (concat notes - (or (get fieldname 'field-separator) - bbdb-notes-default-separator) - annotation))) - (bbdb-maybe-update-display bbdb-record)))) - -(defun bbdb-offer-save () - "Offer to save the Insidious Big Brother Database if it is modified." - (if bbdb-offer-save - (bbdb-save-db (eq bbdb-offer-save t)))) - -(defcustom bbdb-save-db-timeout nil - "*If non-nil, then when `bbdb-save-db' is asking you whether to save the db, -it will time out to `yes' after this many seconds. This only works if the -function `y-or-n-p-with-timeout' is defined." - :group 'bbdb-save - :type '(choice (const :tag "Don't time out" nil) - (integer :tag "Time out after this many seconds" 5))) - -(defun bbdb-save-db (&optional prompt-first mention-if-not-saved) - "Save the DB if it is modified." - (interactive (list nil t)) - (bbdb-with-db-buffer - (if (and (buffer-modified-p) - (or (null prompt-first) - (if bbdb-readonly-p - (bbdb-y-or-n-p - "Save the BBDB, even though it's supposedly read-only? ") - (if (and bbdb-save-db-timeout - (fboundp 'y-or-n-p-with-timeout)) - (y-or-n-p-with-timeout - "Save the BBDB now? " bbdb-save-db-timeout t) - (bbdb-y-or-n-p "Save the BBDB now? "))))) - (save-buffer) - (if mention-if-not-saved (message "BBDB not saved"))))) - - -;;; mail and news interface - -(defun bbdb-clean-username (string) - "Strips garbage from the user full name string." - ;; This function is called a lot, and should be fast. But I'm loathe to - ;; remove any of the functionality in it. - (if (string-match "[@%!]" string) ; ain't no user name! It's an address! - (bbdb-string-trim string) - (let ((case-fold-search t)) - ;; Take off leading and trailing non-alpha chars \(quotes, parens, - ;; digits, etc) and things which look like phone extensions \(like - ;; "x1234" and "ext. 1234". \) - ;; This doesn't work all the time because some of our friends in - ;; northern europe have brackets in their names... - (if (string-match (if bbdb-have-re-char-classes - "\\`[^[:alpha:]]+" - "\\`[^a-z]+") - string) - (setq string (substring string (match-end 0)))) - (while (string-match - "\\(\\W+\\([Xx]\\|[Ee]xt\\.?\\)\\W*[-0-9]+\\|[^a-z]+\\)\\'" - string) - (setq string (substring string 0 (match-beginning 0)))) - ;; replace tabs, multiple spaces, dots, and underscores with a single - ;; space, but don't replace ". " with " " because that could be an - ;; initial. - (while (string-match "\\(\t\\| +\\|\\(\\.\\)[^ \t_]\\|_+\\)" string) - (setq string (concat (substring string 0 - (or (match-beginning 2) - (match-beginning 1))) - " " - (substring string (or (match-end 2) - (match-end 1)))))) - ;; If the string contains trailing parenthesized comments, nuke 'em. - (if (string-match "[^ \t]\\([ \t]*\\((\\| -\\| #\\)\\)" string) - (progn - (setq string (substring string 0 (match-beginning 1))) - ;; lose rubbish this may have exposed. - (while - (string-match - "\\(\\W+\\([Xx]\\|[Ee]xt\\.?\\)\\W*[-0-9]+\\|[^a-z]+\\)\\'" - string) - (setq string (substring string 0 (match-beginning 0)))))) - string))) - -;;; message-caching, to speed up the the mail interfaces - -(defvar bbdb-buffers-with-message-caches '() - "A list of all the buffers which have stuff on their `bbdb-message-cache' -local variable. When we re-parse the `bbdb-file', we need to flush all of -these caches.") - -(defun notice-buffer-with-cache (buffer) - (or (memq buffer bbdb-buffers-with-message-caches) - (progn - ;; First remove any deleted buffers which may have accumulated. - ;; This happens only when a buffer is added to the list, so it - ;; ought not happen that frequently (each time you read mail, say.) - (let ((rest bbdb-buffers-with-message-caches)) - (while rest - (if (null (buffer-name (car rest))) - (setq bbdb-buffers-with-message-caches - (delq (car rest) bbdb-buffers-with-message-caches))) - (setq rest (cdr rest)))) - ;; now add this buffer. - (setq bbdb-buffers-with-message-caches - (cons buffer bbdb-buffers-with-message-caches))))) - -(defvar bbdb-message-cache nil - "alist of (MESSAGE-KEY BBDB-RECORDS) cached in order to avoid updating -messages each time they are visited. This is used by all MUAs, while the -MESSAGE-KEY is specific to the MUA and the cache is local for each MUA or MUA -folder.") - -(make-variable-buffer-local 'bbdb-message-cache) - -(defun bbdb-message-cache-lookup (message-key) - "Return cached BBDB records for MESSAGE-KEY. -If not present or when the records have been modified return nil." - (bbdb-records) - (if bbdb-message-caching-enabled - (let ((records (assq message-key bbdb-message-cache)) - (invalid nil)) - (when records - (setq records (cdr records)) - (bbdb-mapc (lambda (record) - (if (bbdb-record-deleted-p record) - (setq invalid t))) - records)) - (if invalid nil records)))) - -(defun bbdb-encache-message (message-key bbdb-records) - "Cache the BBDB-RECORDS for a message identified by MESSAGE-KEY and -return them." - (and bbdb-message-caching-enabled - (car bbdb-records) - (add-to-list 'bbdb-message-cache (cons message-key bbdb-records)) - (notice-buffer-with-cache (current-buffer))) - bbdb-records) - -(defun bbdb-decache-message (message-key) - "Remove an element form the cache." - (and bbdb-message-caching-enabled - (delq (assoc message-key bbdb-message-cache) bbdb-message-cache))) - -(defun bbdb-flush-all-caches () - (bbdb-debug - (and bbdb-buffers-with-message-caches - (message "Flushing BBDB caches"))) - (save-excursion - (while bbdb-buffers-with-message-caches - (if (buffer-name (car bbdb-buffers-with-message-caches)) - (progn - (set-buffer (car bbdb-buffers-with-message-caches)) - (setq bbdb-message-cache nil))) - (setq bbdb-buffers-with-message-caches - (cdr bbdb-buffers-with-message-caches))))) - - -(defconst bbdb-name-gubbish - (concat "[-,. \t/\\]+\\(" - "[JjSs]r\\.?" - "\\|V?\\(I\\.?\\)+V?" - (concat "\\|" - (regexp-opt bbdb-lastname-prefixes)) - "\\)\\W*\\'")) - -(defun bbdb-divide-name (string) - "divide the string into a first name and a last name, cleverly." - ;; ## This shouldn't be here. - (if (string-match "\\W+\\([Xx]\\|[Ee]xt\\.?\\)\\W*[-0-9]+\\'" string) - (setq string (substring string 0 (match-beginning 0)))) - (let* ((case-fold-search nil) - (str string) - (gubbish (string-match bbdb-name-gubbish string))) - (if gubbish - (setq gubbish (substring str gubbish) - str (substring string 0 (match-beginning 0)))) - (if (string-match - (concat " +\\(" - ;; start recognize some prefixes to lastnames - (if bbdb-lastname-prefixes - (concat "\\(" - (regexp-opt bbdb-lastname-prefixes t) - "[ ]+\\)?")) - ;; end recognize some prefixes to lastnames - "\\([^ ]+ *- *\\)?[^ ]+\\)\\'") str) - (list (substring str 0 (match-beginning 0)) - (concat - (substring str (match-beginning 1)) - (or gubbish ""))) - (list string "")))) - -(defun bbdb-check-alternate-name (possible-name record) - (let (aka) - (if (setq aka (bbdb-record-aka record)) - (let ((down-name (downcase possible-name)) - match) - (while aka - (if (equal down-name (downcase (car aka))) - (setq match (car aka) - aka nil) - (setq aka (cdr aka)))) - match)))) - - -(defun bbdb-canonicalize-address (net) - ;; call the bbdb-canonicalize-net-hook repeatedly until it returns a - ;; value eq to the value passed in. This implies that it can't - ;; destructively modify the string. - - ;; Hysterical Raisins: This is a function, not a hook. In order to - ;; make this hook a hook, we'll quietly convert a single function - ;; into a hook list. We should really warn the user that we're - ;; doing this, and advise them to update their configuration - ;; accordingly. For the release, maybe. - (if (functionp bbdb-canonicalize-net-hook) - (setq bbdb-canonicalize-net-hook (list bbdb-canonicalize-net-hook))) - - ;; Now, do the hook run. Note, if you mess up, it's possible that - ;; BBDB will get stuck here oscillating between various definitions - ;; of the canonical address. - (while (not (equal net (setq net (run-hook-with-args - 'bbdb-canonicalize-net-hook net))))) - - net) - -;; Mostly written by Rod Whitby. -(defun bbdb-net-redundant-p (net old-nets) - "Returns non-nil if NET represents a sub-domain of one of the OLD-NETS. -The returned value is the address which makes this one redundant. -For example, \"foo@bar.baz.com\" is redundant w.r.t. \"foo@baz.com\", -and \"foo@quux.bar.baz.com\" is redundant w.r.t. \"foo@bar.baz.com\"." - (let ((redundant-addr nil)) - (while (and (not redundant-addr) old-nets) - ;; Calculate a host-regexp for each address in OLD-NETS - (let* ((old (car old-nets)) - (host-index (string-match "@" old)) - (name (and host-index (substring old 0 host-index))) - (host (and host-index (substring old (1+ host-index)))) - ;; host-regexp is "^@.*\.$" - (host-regexp (and name host - (concat "\\`" (regexp-quote name) - "@.*\\." (regexp-quote host) - "\\'")))) - ;; If NET matches host-regexp, then it is redundant - (if (and host-regexp net - (string-match host-regexp net)) - (setq redundant-addr old))) - (setq old-nets (cdr old-nets))) - redundant-addr)) - - -(defun bbdb-annotate-message-sender (from &optional loudly create-p - prompt-to-create-p) - "Fills the record corresponding to the sender with as much info as possible. -A record may be created by this; a record or nil is returned. -If `bbdb-readonly-p' is true, then a record will never be created. -If CREATE-P is true, then a record may be created, otherwise it won't. -If PROMPT-TO-CREATE-P is true, then the user will be asked for confirmation -before the record is created, otherwise it is created without confirmation -\(assuming that CREATE-P is true\). " - (let* ((data (if (consp from) - from ; if from is a cons, it's pre-parsed (hack hack) - (mail-extract-address-components from))) - (name (car data)) - (net (car (cdr data)))) - (if (equal name net) (setq name nil)) - (bbdb-debug - (if (equal name "") (error "mail-extr returned \"\" as name")) - (if (equal net "") (error "mail-extr returned \"\" as net"))) - - (if (and net bbdb-canonicalize-net-hook) - (setq net (bbdb-canonicalize-address net))) - - (let ((change-p nil) - (record (or (bbdb-search-simple nil net) - (bbdb-search-simple name nil))) - (created-p nil) - (fname name) - (lname nil) - old-name - bogon-mode) - (and record (setq old-name (bbdb-record-name record))) - - ;; This is to prevent having losers like "John " match - ;; against existing records like "Someone Else ". - ;; - ;; The solution implemented here is to never create or show records - ;; corresponding to a person who has a real-name which is the same - ;; as the network-address of someone in the db already. This is not - ;; a good solution. - (let (down-name old-net) - (if (and record name - (not (equal (setq down-name (downcase name)) - (and old-name (downcase old-name))))) - (progn - (setq old-net (bbdb-record-net record)) - (while old-net - (if (equal down-name (downcase (car old-net))) - (progn - (setq bogon-mode t - old-net nil) - (message - "Ignoring bogon %s's name \"%s\" to avoid name-clash with \"%s\"" - net name old-name) - (sit-for 2)) - (setq old-net (cdr old-net))))))) - - (if (or record - bbdb-readonly-p - (not create-p) - (not (or name net)) - bogon-mode) - ;; no further action required - nil - ;; otherwise, the db is writable, and we may create a record. - ;; first try to get a reasonable default name if not given - ;; often I get things like .@ ... - (if (or (null name) (and (stringp name) (string= "" name))) - (if (string-match "^[^@]+" net) - (setq name (bbdb-clean-username (match-string 0 net))))) - (setq record (if (or (null prompt-to-create-p) - create-p - (if (functionp prompt-to-create-p) - (bbdb-invoke-hook-for-value - prompt-to-create-p) - (bbdb-y-or-n-p - (format "%s is not in the db. Add? " - (or name net))))) - (make-vector bbdb-record-length nil)) - created-p (not (null record))) - (if record - (bbdb-record-set-cache record (make-vector bbdb-cache-length nil))) - ) - (if (or bogon-mode (null record)) - nil - (bbdb-debug (if (bbdb-record-deleted-p record) - (error "nasty nasty deleted record nasty."))) - (if (and name - (not (equal (and name (downcase name)) - (and old-name (downcase old-name)))) - (or (null bbdb-use-alternate-names) - (not (bbdb-check-alternate-name name record))) - (let ((fullname (bbdb-divide-name name)) - tmp) - (setq fname (car fullname) - lname (nth 1 fullname)) - (not (and (equal (downcase fname) - (and (setq tmp - (bbdb-record-firstname record)) - (downcase tmp))) - (equal (downcase lname) - (and (setq tmp - (bbdb-record-lastname record)) - (downcase tmp))))))) - - ;; have a message-name, not the same as old name. - (cond (bbdb-readonly-p nil);; skip if readonly - - ;; ignore name mismatches? - ;; NB 'quiet' means 'don't ask', not 'don't mention' - ((and bbdb-quiet-about-name-mismatches old-name) - (let ((sit-for-secs - (if (numberp bbdb-quiet-about-name-mismatches) - bbdb-quiet-about-name-mismatches - 2))) - (if (or bbdb-silent-running (= 0 sit-for-secs)) nil - (message "name mismatch: \"%s\" changed to \"%s\"" - (bbdb-record-name record) name) - (sit-for sit-for-secs)))) - ((or created-p - (if bbdb-silent-running t - (if (null old-name) - (bbdb-y-or-n-p - (format "Assign name \"%s\" to address \"%s\"? " - name (car (bbdb-record-net record)))) - (bbdb-y-or-n-p - (format "Change name \"%s\" to \"%s\"? " - old-name name))))) - (setq change-p 'sort) - - ;; Keep old name? - (and old-name bbdb-use-alternate-names - (not (member old-name (bbdb-record-aka record))) - ;; Silent mode: just add it. - (if bbdb-silent-running - (bbdb-record-set-aka record - (cons old-name - (bbdb-record-aka - record))) - ;; prompt user otherwise. - (if (bbdb-y-or-n-p - (format "Keep name \"%s\" as an AKA? " - old-name)) - (bbdb-record-set-aka record - (cons old-name - (bbdb-record-aka - record))) - (bbdb-remhash (downcase old-name) record)))) - - (bbdb-record-set-namecache record nil) - (bbdb-record-set-firstname record fname) - (bbdb-record-set-lastname record lname) - (bbdb-debug (or fname lname - (error "bbdb: should have a name by now"))) - (bbdb-puthash (downcase (bbdb-record-name record)) record)) - - ;; not quiet about mismatches - ((and old-name bbdb-use-alternate-names - ;; dedupe - (not (member old-name (bbdb-record-aka record))) - (if (not bbdb-silent-running) - (bbdb-y-or-n-p - (format "Make \"%s\" an alternate for \"%s\"? " - name old-name)))) - (setq change-p 'sort) - (bbdb-record-set-aka - record (cons name (bbdb-record-aka record))) - (bbdb-puthash (downcase name) record)))) - - ;; It's kind of a kludge that the "redundancy" concept is built in. - ;; Maybe I should just add a new hook here... The problem is that the - ;; canonicalize-net-hook is run before database lookup, and thus can't - ;; refer to the database to determine whether a net is redundant. - (if bbdb-canonicalize-redundant-nets-p - (setq net (or (bbdb-net-redundant-p net (bbdb-record-net record)) - net))) - - (if (and net (not bbdb-readonly-p)) - (if (null (bbdb-record-net record)) - ;; names are always a sure match, so don't bother prompting - ;; here. - (progn (bbdb-record-set-net record (list net)) - (bbdb-puthash (downcase net) record) ; important! - (or change-p (setq change-p t))) - ;; new address; ask before adding. - (if (let ((rest-net (bbdb-record-net record)) - (new (downcase net)) - (match nil)) - (while (and rest-net (null match)) - (setq match (string= new (downcase (car rest-net))) - rest-net (cdr rest-net))) - match) - nil - (if (let ((bbdb-always-add-addresses - bbdb-always-add-addresses)) - (if (functionp bbdb-always-add-addresses) - (setq bbdb-always-add-addresses - (funcall bbdb-always-add-addresses))) - (cond - ;; add it automatically - ((eq bbdb-always-add-addresses t) - t) - ;; do not add it - ((null bbdb-always-add-addresses) - nil) - ;; ask the user if it should be added - (t - (and - (not (equal net "???")) - (let ((the-first-bit - (format "Add address \"%s\" to \"" net)) - ;; this groveling is to prevent the "(y or n)" - ;; from falling off the right edge of the - ;; screen. - (the-next-bit (mapconcat 'identity - (bbdb-record-net - record) - ", ")) - (w (window-width (minibuffer-window)))) - (if (> (+ (length the-first-bit) - (length the-next-bit) 15) w) - (setq the-next-bit - (concat - (substring - the-next-bit - 0 (max 0 (- w (length the-first-bit) - 20))) - "..."))) - (bbdb-display-records (list record)) - (if (bbdb-y-or-n-p (concat the-first-bit - the-next-bit - "\"? ")) - ;; then add the new net - t - ;; else add a new record with the same name - (if (and create-p - (or (null prompt-to-create-p) - (if (functionp prompt-to-create-p) - (bbdb-invoke-hook-for-value - prompt-to-create-p) - (bbdb-y-or-n-p - (format - "Create a new record for %s? " - (bbdb-record-name record)))))) - (setq record - (bbdb-create-internal name nil net - nil nil nil))) - nil)))))) - ;; then modify an existing record - (let ((front-p (cond ((null bbdb-new-nets-always-primary) - (bbdb-y-or-n-p - (format - "Make \"%s\" the primary address? " - net))) - ((eq bbdb-new-nets-always-primary t) - t) - (t nil)))) - (bbdb-record-set-net record - (if front-p - (cons net (bbdb-record-net - record)) - (nconc (bbdb-record-net record) - (list net)))) - (bbdb-puthash (downcase net) record) ; important! - (or change-p (setq change-p t))))))) - - (bbdb-debug - (if (and change-p bbdb-readonly-p) - (error - "doubleplus ungood: how did we change anything in readonly mode?" - ))) - (if (and loudly change-p (not bbdb-silent-running)) - (if (eq change-p 'sort) - (message "noticed \"%s\"" (bbdb-record-name record)) - (if (bbdb-record-name record) - (message "noticed %s's address \"%s\"" - (bbdb-record-name record) net) - (message "noticed naked address \"%s\"" net)))) - - (if created-p - (bbdb-invoke-hook 'bbdb-create-hook record)) - - (if change-p - (bbdb-change-record record (eq change-p 'sort))) - - ;; only invoke bbdb-notice-hook if we actually noticed something - (if record - (let ((inside-bbdb-notice-hook t)) - (bbdb-invoke-hook 'bbdb-notice-hook record))) - - record)))) - - -;;; window configuration hackery -;;;###autoload -(defcustom bbdb-multiple-buffers nil - "When non-nil we create a new buffer of every buffer causing pop-ups. -You can also set this to a function returning a buffer name." - :group 'bbdb-record-display - :type '(choice (const :tag "Disabled" nil) - (function :tag "Enabled" bbdb-multiple-buffers-default) - (function :tag "User defined function"))) - -(defun bbdb-multiple-buffers-default () - "Default function for guessing a better name for new *BBDB* buffers." - (cond ((memq major-mode '(vm-mode vm-summary-mode - vm-presentation-mode - vm-virtual-mode)) - (vm-select-folder-buffer) - (buffer-name)) - ((memq major-mode '(gnus-summary-mode gnus-group-mode)) - (set-buffer gnus-article-buffer) - (buffer-name)) - ((memq major-mode '(mail-mode vm-mail-mode message-mode)) - "message composition"))) - -(defun bbdb-multiple-buffers-set-name (&optional buffer-list new-name) - (setq new-name (or new-name - (concat " *BBDB " (funcall bbdb-multiple-buffers) "*")) - buffer-list (append (list (current-buffer) - (get-buffer-create new-name)) - buffer-list)) - - (save-excursion - (while buffer-list - (set-buffer (car buffer-list)) - (make-local-variable 'bbdb-buffer-name) - (setq bbdb-buffer-name new-name) - (setq buffer-list (cdr buffer-list))))) - -(defun bbdb-pop-up-bbdb-buffer (&optional horiz-predicate) - "Find the largest window on the screen, and split it, displaying the -*BBDB* buffer in the bottom 'bbdb-pop-up-target-lines' lines (unless -the *BBDB* buffer is already visible, in which case do nothing.) - -If 'bbdb-use-pop-up' is the symbol 'horiz, and the first window -matching HORIZ-PREDICATE is sufficiently wide (> 100 columns) then -the window will be split vertically rather than horizontally. - -If `bbdb-multiple-buffers' is set we create a new BBDB buffer when not -already within one. The new buffer-name starts with a space, i.e. it does -not clutter the buffer-list." - - (let ((b (current-buffer)) - new-bbdb-buffer-name) - - ;; create new BBDB buffer if multiple buffers are desired. - (when (and bbdb-multiple-buffers (not (eq major-mode 'bbdb-mode))) - (bbdb-multiple-buffers-set-name (list b))) - (setq new-bbdb-buffer-name bbdb-buffer-name) - - ;; now get the pop-up - (if (get-buffer-window new-bbdb-buffer-name) - nil - (if (and (eq bbdb-use-pop-up 'horiz) - horiz-predicate - (bbdb-pop-up-bbdb-buffer-horizontally horiz-predicate)) - nil - (let* ((first-window (selected-window)) - (tallest-window first-window) - (window first-window)) - ;; find the tallest window... - (while (not (eq (setq window (previous-window window)) first-window)) - (if (> (window-height window) (window-height tallest-window)) - (setq tallest-window window))) - ;; select it and split it... - (select-window tallest-window) - (let ((size (min - (- (window-height tallest-window) - window-min-height 1) - (- (window-height tallest-window) - (max window-min-height - (1+ bbdb-pop-up-target-lines)))))) - (split-window tallest-window - (if (> size 0) size window-min-height))) - (if (memq major-mode - '(gnus-Group-mode gnus-Subject-mode gnus-Article-mode)) - (goto-char (point-min))) ; make gnus happy... - ;; goto the bottom of the two... - (select-window (next-window)) - ;; make it display *BBDB*... - (let ((pop-up-windows nil)) - (switch-to-buffer (get-buffer-create new-bbdb-buffer-name))) - ;; select the original window we were in... - (select-window first-window))) - ;; and make sure the current buffer is correct as well. - (set-buffer b) - nil))) - -(defun bbdb-pop-up-bbdb-buffer-horizontally (predicate) - (if (<= (frame-width) 112) - nil - (let* ((first-window (selected-window)) - (got-it nil) - (window first-window)) - (while (and (not (setq got-it (funcall predicate window))) - (not (eq first-window (setq window (next-window window))))) - ) - (if (or (null got-it) - (<= (window-width window) 112)) - nil - (let ((b (current-buffer))) - (select-window window) - (split-window-horizontally 80) - (select-window (next-window window)) - (let ((pop-up-windows nil)) - (switch-to-buffer (get-buffer-create bbdb-buffer-name))) - (select-window first-window) - (set-buffer b) - t))))) - -(defun bbdb-version (&optional arg) - "Return string describing the version of the BBDB that is running. -When called interactively with a prefix argument, insert string at point." - (interactive "P") - (let ((version-string (format "BBDB version %s (%s)" - bbdb-version bbdb-version-date))) - (cond - (arg - (insert (message version-string))) - ((interactive-p) - (message version-string)) - (t version-string)))) - - ;;; resorting, which really shouldn't be necesary... - -(defun bbdb-record-lessp-fn (record1 record2) ; for use as a funarg - (bbdb-record-lessp record1 record2)) - -(defun bbdb-resort-database () - "*Resort BBDB database as a last resort. -This is not be needed when using BBDB itself. It might be necessary -after having used inferior software to add entries to the BBDB, however." - (interactive) - (let* ((records (copy-sequence (bbdb-records)))) - (bbdb-with-db-buffer - (setq bbdb-records (sort bbdb-records 'bbdb-record-lessp-fn)) - (if (equal records bbdb-records) - nil - (message "DANGER! BBDB was mis-sorted; it's being fixed...") - (goto-char (point-min)) - (cond ((eq (following-char) ?\[) nil) - ((search-forward "\n[" nil 0) (forward-char -1))) - (delete-region (point) bbdb-end-marker) - (let ((print-escape-newlines t) - (standard-output (current-buffer)) - (inhibit-quit t) ; really, don't fuck with this - record cache) - (setq records bbdb-records) - (while records - (setq record (car records) - cache (bbdb-record-cache record)) - (bbdb-record-set-cache record nil) - (prin1 (car records)) - (bbdb-record-set-cache record cache) - (insert ?\n) - (setq records (cdr records)))) - (kill-all-local-variables) - (error "the BBDB was mis-sorted: it has been repaired."))))) - -(defvar bbdb-init-forms - '((gnus ; gnus 3.15 or newer - (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)) - (mh-e ; MH-E - (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)) - (rmail ; RMAIL - (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)) - (sendmail ; the standard mail user agent - (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)) - (vm-old ; the alternative mail reader - (add-hook 'vm-load-hook 'bbdb-insinuate-vm)) - (vm ; newer versions don't have vm-load-hook - (progn (eval-after-load "vm" '(bbdb-insinuate-vm)))) - (message ; the gnus mail user agent - (add-hook 'message-setup-hook 'bbdb-insinuate-message)) - (reportmail ; mail notification - (add-hook 'reportmail-load-hook 'bbdb-insinuate-reportmail)) - (sc ; message citation - (add-hook 'sc-load-hook 'bbdb-insinuate-sc)) - (supercite ; same - (add-hook 'sc-load-hook 'bbdb-insinuate-sc)) - (w3 ; WWW browser - (add-hook 'w3-load-hook 'bbdb-insinuate-w3))) - "The alist which maps features to insinuation forms.") - -;;;###autoload -(defun bbdb-initialize (&rest to-insinuate) -"*Initialize the BBDB. One or more of the following symbols can be -passed as arguments to initiate the appropriate insinuations. - - Initialization of mail/news readers: - - gnus Initialize BBDB support for the gnus mail/news reader - version 3.15 or newer. If you pass the `gnus' symbol, - you should probably also pass the `message' symbol. - mh-e Initialize BBDB support for the MH-E mail reader. - rmail Initialize BBDB support for the RMAIL mail reader. - sendmail Initialize BBDB support for sendmail (M-x mail). - vm Initialize BBDB support for the VM mail reader. - NOTE: For the VM insinuation to work properly, you must - either call `bbdb-initialize' with the `vm' symbol from - within your VM initialization file (\"~/.vm\") or you - must call `bbdb-insinuate-vm' manually from within your - VM initialization file. - - Initialization of miscellaneous package: - - message Initialize BBDB support for Message mode. - reportmail Initialize BBDB support for the Reportmail mail - notification package. - sc or Initialize BBDB support for the Supercite message - supercite citation package. - w3 Initialize BBDB support for Web browsers." - - (defalias 'advertized-bbdb-delete-current-field-or-record - 'bbdb-delete-current-field-or-record) - - (require 'bbdb-autoloads) - - (while to-insinuate - (let* ((feature (car to-insinuate)) - (init (assq feature bbdb-init-forms))) - (setq to-insinuate (cdr to-insinuate)) - (if init - (if (or (featurep feature) (locate-library (symbol-name feature))) - (eval (cadr init)) - (bbdb-warn "cannot locate feature `%s'" feature)) - (bbdb-warn "don't know how to insinuate `%s'" feature)))) - - ;; RMAIL, MHE, and VM interfaces might need these. - (autoload 'mail-strip-quoted-names "mail-utils") - (autoload 'mail-fetch-field "mail-utils") - ;; All of the interfaces need this. - (autoload 'mail-extract-address-components "mail-extr") - - (run-hooks 'bbdb-initialize-hook)) - -;; Initialize keymaps -(unless bbdb-mode-search-map - (define-prefix-command 'bbdb-mode-search-map) - (if (fboundp 'set-keymap-prompt) - (set-keymap-prompt - bbdb-mode-search-map - "(Search [n]ame, [c]ompany, net [a]ddress, n[o]tes)?")) - - (define-key bbdb-mode-search-map [(n)] 'bbdb-name) - (define-key bbdb-mode-search-map [(c)] 'bbdb-company) - (define-key bbdb-mode-search-map [(a)] 'bbdb-net) - (define-key bbdb-mode-search-map [(o)] 'bbdb-notes)) - -(unless bbdb-mode-map - (setq bbdb-mode-map (make-keymap)) - (suppress-keymap bbdb-mode-map) - - (define-key bbdb-mode-map [(S)] 'bbdb-mode-search-map) - - (define-key bbdb-mode-map [(*)] 'bbdb-apply-next-command-to-all-records) - (define-key bbdb-mode-map [(+)] 'bbdb-append-records) - (define-key bbdb-mode-map [(!)] 'bbdb-search-invert-set) - (define-key bbdb-mode-map [(a)] 'bbdb-add-or-remove-mail-alias) - (define-key bbdb-mode-map [(e)] 'bbdb-edit-current-field) - (define-key bbdb-mode-map [(n)] 'bbdb-next-record) - (define-key bbdb-mode-map [(p)] 'bbdb-prev-record) - (define-key bbdb-mode-map [(d)] 'bbdb-delete-current-field-or-record) - (define-key bbdb-mode-map [(control k)] 'bbdb-delete-current-field-or-record) - (define-key bbdb-mode-map [(control o)] 'bbdb-insert-new-field) - (define-key bbdb-mode-map [(s)] 'bbdb-save-db) - (define-key bbdb-mode-map [(control x) (control s)] - 'bbdb-save-db) - (define-key bbdb-mode-map [(r)] 'bbdb-refile-record) - (define-key bbdb-mode-map [(t)] 'bbdb-toggle-records-display-layout) - (define-key bbdb-mode-map [(T)] 'bbdb-display-record-completely) - (define-key bbdb-mode-map [(o)] 'bbdb-omit-record) - (define-key bbdb-mode-map [(?\;)] 'bbdb-record-edit-notes) - (define-key bbdb-mode-map [(m)] 'bbdb-send-mail) - (define-key bbdb-mode-map "\M-d" 'bbdb-dial) - (define-key bbdb-mode-map [(f)] 'bbdb-finger) - (define-key bbdb-mode-map [(F)] 'bbdb-ftp) - (define-key bbdb-mode-map [(i)] 'bbdb-info) - (define-key bbdb-mode-map [(??)] 'bbdb-help) - (define-key bbdb-mode-map [(q)] 'bbdb-bury-buffer) - (define-key bbdb-mode-map [(control x) (control t)] - 'bbdb-transpose-fields) - (define-key bbdb-mode-map [(w)] 'bbdb-www) - (define-key bbdb-mode-map [(W)] 'bbdb-whois) - (define-key bbdb-mode-map [(P)] 'bbdb-print) - (define-key bbdb-mode-map [(h)] 'other-window) - (define-key bbdb-mode-map [(=)] 'delete-other-windows) - (define-key bbdb-mode-map [(c)] 'bbdb-create) - (define-key bbdb-mode-map [(C)] 'bbdb-changed) - (define-key bbdb-mode-map [(b)] 'bbdb) - - (define-key bbdb-mode-map [delete] 'scroll-down) - (define-key bbdb-mode-map " " 'scroll-up) - ) - - -;;; Support for the various Emacsen. This is for features that the -;;; BBDB adds to itself for different Emacsen. For definitions of -;;; functions that aren't present in various Emacsen (for example, -;;; cadr for Emacs 19.34), see below -(when (string-match "XEmacs\\|Lucid" emacs-version) - ;; Above - (fset 'bbdb-warn 'warn) - - ;; bbdb-com.el - (fset 'bbdb-display-completion-list 'bbdb-xemacs-display-completion-list)) - -(defun bbdb-insinuate-sendmail () - "Call this function to hook BBDB into sendmail (that is, M-x mail)." - (define-key mail-mode-map "\M-\t" 'bbdb-complete-name)) - -;;;###autoload -(defun bbdb-insinuate-message () - "Call this function to hook BBDB into `message-mode'." - (define-key message-mode-map "\M-\t" 'bbdb-complete-name)) - -;;; Erm. says here that (require...) can take a noerror flag; why do -;;; we have this function? -(defmacro safe-require (thing) - (list 'condition-case nil (list 'require thing) '(file-error nil))) - -;; Wrappers for things that change for different Emacsen. Note: This -;; is for things that get redefined that don't belong elsewhere. Some -;; functions that get redefined live elsewhere in the source because -;; it makes sense to put them there. - -(defun bbdb-warn (&rest args) - (beep 1) - (apply 'message args)) - - -(provide 'bbdb) ; provide before loading things which might require - -(run-hooks 'bbdb-load-hook) diff --git a/xemacs-packages/lisp/bbdb/custom-load.el b/xemacs-packages/lisp/bbdb/custom-load.el deleted file mode 100644 index 371e760b..00000000 --- a/xemacs-packages/lisp/bbdb/custom-load.el +++ /dev/null @@ -1,31 +0,0 @@ -;;; custom-load.el --- automatically extracted custom dependencies - -;;; Code: - -(autoload 'custom-add-loads "cus-load") - -(custom-add-loads 'bbdb-record-display '("bbdb")) -(custom-add-loads 'bbdb-utilities-ftp '("bbdb-ftp")) -(custom-add-loads 'bbdb-record-use '("bbdb-com" "bbdb")) -(custom-add-loads 'bbdb-mua-specific-gnus '("bbdb-gnus" "bbdb")) -(custom-add-loads 'bbdb-mua-specific-gnus-scoring '("bbdb-gnus")) -(custom-add-loads 'mail '("bbdb")) -(custom-add-loads 'bbdb-record-creation '("bbdb-com" "bbdb")) -(custom-add-loads 'bbdb-saving '("bbdb")) -(custom-add-loads 'bbdb-utilities-server '("bbdb-srv")) -(custom-add-loads 'bbdb-mua-specific-vm '("bbdb-vm")) -(custom-add-loads 'bbdb-utilities-print '("bbdb-print")) -(custom-add-loads 'bbdb-save '("bbdb")) -(custom-add-loads 'bbdb-hooks '("bbdb-com" "bbdb")) -(custom-add-loads 'bbdb-phone-dialing '("bbdb-xemacs" "bbdb-com")) -(custom-add-loads 'bbdb-mua-specific-gnus-splitting '("bbdb-gnus")) -(custom-add-loads 'bbdb-utilities-finger '("bbdb-com")) -(custom-add-loads 'bbdb-utilities '("bbdb-whois" "bbdb")) -(custom-add-loads 'news '("bbdb")) -(custom-add-loads 'bbdb-utilities-supercite '("bbdb-sc")) -(custom-add-loads 'bbdb '("bbdb-com" "bbdb-hooks" "bbdb-snarf" "bbdb")) -(custom-add-loads 'bbdb-database '("bbdb-gui" "bbdb")) -(custom-add-loads 'bbdb-noticing-records '("bbdb-com" "bbdb-hooks" "bbdb-snarf" "bbdb")) -(custom-add-loads 'bbdb-mua-specific '("bbdb-com" "bbdb")) - -;;; custom-load.el ends here diff --git a/xemacs-packages/lisp/c-support/ChangeLog b/xemacs-packages/lisp/c-support/ChangeLog deleted file mode 100644 index 33136b26..00000000 --- a/xemacs-packages/lisp/c-support/ChangeLog +++ /dev/null @@ -1,97 +0,0 @@ -2005-07-27 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.22 released. - -2005-04-19 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.21 released. - -2005-04-15 Adrian Aichner - - * cmacexp.el (c-macro-expansion): Use shell-command-switch. - -2004-02-11 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.20 released. - -2004-02-02 Jerry James - - * hideshow.el: Sync with Emacs 21.3. - -2004-01-05 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.19 released. - -2003-12-02 Nix - - * hideshow.el (hs-grok-mode-type): Don't fail if comment-start or - comment-end are nil. - -2003-10-31 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.18 released. - -2003-09-15 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.17 released. - -2003-03-09 Ben Wing - - * Makefile: - Delete explicit compile:: and binkit: rules. - Don't add custom-load.elc to the list of generated elc's. - -2002-11-29 Ben Wing - - * .cvsignore: Remove files now handled automatically by CVS. - * Makefile: Use `compile' instead of hard-coded `all'. - -2002-10-15 Ville Skyttä - - * Makefile (srckit): Remove. - -2000-10-05 Martin Buchholz - - * *: Mega typo fix. - -1999-09-09 Jeff Miller - - * hideif.el: sync with Emacs 20.4. - -1999-03-02 SL Baur - - * hideif.el (hide-ifdef-mode-map): Autoload. - -1999-02-06 Jan Vroonhof - - * hideif.el (hide-ifdef-mode): Don't quote keymap when passing to - add-minor-mode. - -1998-03-25 SL Baur - - * ctypes.el: new file. - -1998-03-21 SL Baur - - * c-comment-edit.el-1.02 from Kyle Jones - -1998-02-26 SL Baur - - * c-comment-edit.el-1.01 from Kyle Jones. - -1998-01-24 SL Baur - - * Makefile (VERSION): Update to package standard 1.0. - * package-info.in: Ditto. - -1998-01-12 SL Baur - - * Makefile: Update to newer package interface. - -1998-01-03 SL Baur - - * Makefile: Update to newer package interface. - -1997-12-29 SL Baur - - * Makefile: Created. diff --git a/xemacs-packages/lisp/c-support/_pkg.el b/xemacs-packages/lisp/c-support/_pkg.el deleted file mode 100644 index ac0b99ad..00000000 --- a/xemacs-packages/lisp/c-support/_pkg.el +++ /dev/null @@ -1,5 +0,0 @@ -;;;###autoload -(package-provide 'c-support - :version 1.22 - :author-version "No-Upstream-Ver" - :type 'single-file) diff --git a/xemacs-packages/lisp/c-support/auto-autoloads.el b/xemacs-packages/lisp/c-support/auto-autoloads.el deleted file mode 100644 index a847b188..00000000 --- a/xemacs-packages/lisp/c-support/auto-autoloads.el +++ /dev/null @@ -1,252 +0,0 @@ -;;; DO NOT MODIFY THIS FILE -(if (featurep 'c-support-autoloads) (error "Already loaded")) - -;;;### (autoloads nil "_pkg" "c-support/_pkg.el") - -(package-provide 'c-support :version 1.22 :author-version "No-Upstream-Ver" :type 'single-file) - -;;;*** - -;;;### (autoloads (c-comment-edit) "c-comment-edit" "c-support/c-comment-edit.el") - -(autoload 'c-comment-edit "c-comment-edit" "\ -Edit multi-line C comments. -This command allows the easy editing of a multi-line C comment like this: - /* - * ... - * ... - */ -The comment may be indented or flush with the left margin. - -If point is within a comment, that comment is used. Otherwise the -comment to be edited is found by searching forward from point. - -With one \\[universal-argument] searching starts after moving back one - paragraph. -With two \\[universal-argument]'s searching starts at the beginning of the - current or proceeding C function. -With three \\[universal-argument]'s searching starts at the beginning of the - current page. -With four \\[universal-argument]'s searching starts at the beginning of the - current buffer (clipping restrictions apply). - -Once located, the comment is copied into a temporary buffer, the comment -leaders and delimiters are stripped away and the resulting buffer is -selected for editing. The major mode of this buffer is controlled by -the variable `c-comment-edit-mode'.\\ - -Use \\[c-comment-edit-end] when you have finished editing the comment. The -comment will be inserted into the original buffer with the appropriate -delimiters and indention, replacing the old version of the comment. If -you don't want your edited version of the comment to replace the -original, use \\[c-comment-edit-abort]." t nil) - -;;;*** - -;;;### (autoloads (c-macro-expand) "cmacexp" "c-support/cmacexp.el") - -(autoload 'c-macro-expand "cmacexp" "\ -Expand C macros in the region, using the C preprocessor. -Normally display output in temp buffer, but -prefix arg means replace the region with it. - -`c-macro-preprocessor' specifies the preprocessor to use. -Prompt for arguments to the preprocessor (e.g. `-DDEBUG -I ./include') -if the user option `c-macro-prompt-flag' is non-nil. - -Noninteractive args are START, END, SUBST. -For use inside Lisp programs, see also `c-macro-expansion'." t nil) - -;;;*** - -;;;### (autoloads (ctypes-read-file ctypes-auto-parse-mode ctypes-file ctypes-dir ctypes-tags ctypes-all-buffers ctypes-buffer ctypes-define-type-in-mode ctypes-define-type) "ctypes" "c-support/ctypes.el") - -(autoload 'ctypes-define-type "ctypes" "\ -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." t nil) - -(autoload 'ctypes-define-type-in-mode "ctypes" "\ -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.)" t nil) - -(autoload 'ctypes-buffer "ctypes" "\ -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." t nil) - -(autoload 'ctypes-all-buffers "ctypes" "\ -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." t nil) - -(autoload 'ctypes-tags "ctypes" "\ -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." t nil) - -(autoload 'ctypes-dir "ctypes" "\ -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." t nil) - -(autoload 'ctypes-file "ctypes" "\ -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." t nil) - -(autoload 'ctypes-auto-parse-mode "ctypes" "\ -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." t nil) - -(autoload 'ctypes-read-file "ctypes" "\ -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." t nil) - -;;;*** - -;;;### (autoloads (hide-ifdef-mode) "hideif" "c-support/hideif.el") - -(defvar hide-ifdef-mode-map nil "\ -Keymap used with Hide-Ifdef mode.") - -(add-minor-mode 'hide-ifdef-mode " Ifdef" hide-ifdef-mode-map) - -(autoload 'hide-ifdef-mode "hideif" "\ -Toggle Hide-Ifdef mode. This is a minor mode, albeit a large one. -With ARG, turn Hide-Ifdef mode on if arg is positive, off otherwise. -In Hide-Ifdef mode, code within #ifdef constructs that the C preprocessor -would eliminate may be hidden from view. Several variables affect -how the hiding is done: - -hide-ifdef-env - An association list of defined and undefined symbols for the - current buffer. Initially, the global value of `hide-ifdef-env' - is used. - -hide-ifdef-define-alist - An association list of defined symbol lists. - Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env' - and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env' - from one of the lists in `hide-ifdef-define-alist'. - -hide-ifdef-lines - Set to non-nil to not show #if, #ifdef, #ifndef, #else, and - #endif lines when hiding. - -hide-ifdef-initially - Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode - is activated. - -hide-ifdef-read-only - Set to non-nil if you want to make buffers read only while hiding. - After `show-ifdefs', read-only status is restored to previous value. - -\\{hide-ifdef-mode-map}" t nil) - -(defcustom hide-ifdef-initially nil "*Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated." :type 'boolean :group 'hide-ifdef) - -(defcustom hide-ifdef-read-only nil "*Set to non-nil if you want buffer to be read-only while hiding text." :type 'boolean :group 'hide-ifdef) - -(defcustom hide-ifdef-lines nil "*Non-nil means hide the #ifX, #else, and #endif lines." :type 'boolean :group 'hide-ifdef) - -;;;*** - -;;;### (autoloads (hs-minor-mode) "hideshow" "c-support/hideshow.el") - -(defcustom hs-hide-comments-when-hiding-all t "*Hide the comments too when you do an `hs-hide-all'." :type 'boolean :group 'hideshow) - -(defvar hs-special-modes-alist '((c-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) (bibtex-mode ("^@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning)) "\ -*Alist for initializing the hideshow variables for different modes. -Each element has the form - (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). - -If non-nil, hideshow will use these values as regexps to define blocks -and comments, respectively for major mode MODE. - -START, END and COMMENT-START are regular expressions. A block is -defined as text surrounded by START and END. - -As a special case, START may be a list of the form (COMPLEX-START -MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and -MDATA-SELECTOR an integer that specifies which sub-match is the proper -place to adjust point, before calling `hs-forward-sexp-func'. For -example, see the `hs-special-modes-alist' entry for `bibtex-mode'. - -For some major modes, `forward-sexp' does not work properly. In those -cases, FORWARD-SEXP-FUNC specifies another function to use instead. - -See the documentation for `hs-adjust-block-beginning' to see what is the -use of ADJUST-BEG-FUNC. - -If any of the elements is left nil or omitted, hideshow tries to guess -appropriate values. The regexps should not contain leading or trailing -whitespace. Case does not matter.") - -(autoload 'hs-minor-mode "hideshow" "\ -Toggle hideshow minor mode. -With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. -When hideshow minor mode is on, the menu bar is augmented with hideshow -commands and the hideshow commands are enabled. -The value '(hs . t) is added to `buffer-invisibility-spec'. - -The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block', -`hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also -`hs-hide-initial-comment-block' and `hs-mouse-toggle-hiding'. - -Turning hideshow minor mode off reverts the menu bar and the -variables to default values and disables the hideshow commands. - -Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'. - -Key bindings: -\\{hs-minor-mode-map}" t nil) - -;;;*** - -(provide 'c-support-autoloads) diff --git a/xemacs-packages/lisp/c-support/c-comment-edit.el b/xemacs-packages/lisp/c-support/c-comment-edit.el deleted file mode 100644 index ef46af91..00000000 --- a/xemacs-packages/lisp/c-support/c-comment-edit.el +++ /dev/null @@ -1,323 +0,0 @@ -;; c-comment-edit.el --- edit C comments -;; Copyright (C) 1987, 1988, 1989, 1998 Kyle E. Jones - -;; Author: Kyle Jones -;; Maintainer: Kyle Jones -;; Keywords: languages - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; A copy of the GNU General Public License can be obtained from this -;; program's author (send electronic mail to kyle_jones@wonderworks.com) -;; or from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, -;; MA 02139, USA. - -;;; Synched up with: Not in FSF. - -;;; Commentary: - -;; Send bug reports to kyle_jones@wonderworks.com - -;; The command c-comment-edit is the entry point for this library. - -(provide 'c-comment-edit) - -(defvar c-comment-edit-version "1.02" - "Version number for the C Comment Edit package.") - -(defvar c-comment-edit-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\e" 'c-comment-edit-end) - (define-key map "\C-c\C-c" 'c-comment-edit-end) - (define-key map "\C-c\C-]" 'c-comment-edit-abort) - map ) - "Keymap for c-comment-edit buffers") - -(defvar c-comment-leader " *" - "*Leader used when rebuilding edited C comments. The value of this variable -should be a two-character string. Values of \" \", \" *\" and \"**\" produce -the comment styles: - /* /* /* - ... * ... ** ... - ... * ... ** ... - */ */ */ -respectively.") - -(defconst c-comment-leader-regexp "^[ ]*\\(\\*\\*\\|\\*\\)?[ ]?" - "Regexp used to match C comment leaders.") - -(defvar c-comment-edit-mode 'text-mode - "*Major mode used by `c-comment-edit' when editing C comments.") - -(defvar c-comment-edit-hook nil - "*Function to call whenever `c-comment-edit' is used. -The function is called just before the `c-comment-edit' function allows you to -begin editing the comment.") - -(defvar c-comment-edit-buffer-alist nil - "Assoc list of C buffers and their associated comment buffers. -Elements are of the form (C-BUFFER COMMENT-BUFFER COMMENT-START COMMENT-END) -COMMENT-START and COMMENT-END are markers in the C-BUFFER.") - -(defmacro save-point (&rest body) - "Save value of point, evaluates FORMS and restore value of point. -If the saved value of point is no longer valid go to (point-max). -The variable `save-point' is lambda-bound to the value of point for -the duration of this call." - (list 'let '((save-point (point))) - (list 'unwind-protect - (cons 'progn body) - '(goto-char (min (point-max) save-point))))) - -(defmacro marker (pos &optional buffer) - (list 'set-marker '(make-marker) pos buffer)) - -;;;###autoload -(defun c-comment-edit (search-prefix) - "Edit multi-line C comments. -This command allows the easy editing of a multi-line C comment like this: - /* - * ... - * ... - */ -The comment may be indented or flush with the left margin. - -If point is within a comment, that comment is used. Otherwise the -comment to be edited is found by searching forward from point. - -With one \\[universal-argument] searching starts after moving back one - paragraph. -With two \\[universal-argument]'s searching starts at the beginning of the - current or proceeding C function. -With three \\[universal-argument]'s searching starts at the beginning of the - current page. -With four \\[universal-argument]'s searching starts at the beginning of the - current buffer (clipping restrictions apply). - -Once located, the comment is copied into a temporary buffer, the comment -leaders and delimiters are stripped away and the resulting buffer is -selected for editing. The major mode of this buffer is controlled by -the variable `c-comment-edit-mode'.\\ - -Use \\[c-comment-edit-end] when you have finished editing the comment. The -comment will be inserted into the original buffer with the appropriate -delimiters and indention, replacing the old version of the comment. If -you don't want your edited version of the comment to replace the -original, use \\[c-comment-edit-abort]." - (interactive "*P") - (let ((c-buffer (current-buffer)) - marker tem c-comment-fill-column c-comment-buffer - c-comment-start c-comment-end - (inhibit-quit t)) - ;; honor search-prefix - (cond ((equal search-prefix '(4)) - (backward-paragraph)) - ((equal search-prefix '(16)) - (end-of-defun) - (beginning-of-defun) - (backward-paragraph)) - ((equal search-prefix '(64)) - (backward-page)) - ((equal search-prefix '(256)) - (goto-char (point-min)))) - (if (and (null search-prefix) (setq tem (within-c-comment-p))) - (setq c-comment-start (marker (car tem)) - c-comment-end (marker (cdr tem))) - (let (start end) - (condition-case error-data - (save-point - (search-forward "/*") - (setq start (- (point) 2)) - (search-forward "*/") - (setq end (point))) - (search-failed (error "No C comment found."))) - (setq c-comment-start (marker start)) - (setq c-comment-end (marker end)))) - ;; calculate the correct fill-column for the comment - (setq c-comment-fill-column (- fill-column 3 - (save-excursion - (goto-char c-comment-start) - (current-column)))) - ;; create the comment buffer - (setq c-comment-buffer - (generate-new-buffer (concat (buffer-name) " *C Comment Edit*"))) - ;; link into the c-comment-edit-buffer-alist - (setq c-comment-edit-buffer-alist - (cons (list (current-buffer) c-comment-buffer - c-comment-start c-comment-end) - c-comment-edit-buffer-alist)) - ;; copy to the comment to the comment-edit buffer - (copy-to-buffer c-comment-buffer (+ c-comment-start 2) (- c-comment-end 2)) - ;; mark the position of point, relative to the beginning of the - ;; comment, in the comment buffer. (iff point is within a comment.) - (or search-prefix (< (point) c-comment-start) - (setq marker (marker (+ (- (point) c-comment-start 2) 1) - c-comment-buffer))) - ;; select the comment buffer for editing - (switch-to-buffer c-comment-buffer) - ;; remove the comment leaders and delimiters - (goto-char (point-min)) - (while (not (eobp)) - (and (re-search-forward c-comment-leader-regexp nil t) - (replace-match "" nil t)) - (forward-line)) - ;; run appropriate major mode - (funcall (or c-comment-edit-mode 'fundamental-mode)) - ;; override user's default fill-column here since it will lose if - ;; the comment is indented in the C buffer. - (setq fill-column c-comment-fill-column) - ;; delete one leading whitespace char - (goto-char (point-min)) - (if (looking-at "[ \n\t]") - (delete-char 1)) - ;; restore cursor if possible - (goto-char (or marker (point-min))) - (if (fboundp 'set-keymap-parents) - (set-keymap-parents c-comment-edit-map (list (current-local-map)))) - (use-local-map c-comment-edit-map) - (set-buffer-modified-p nil)) - ;; run user hook, if present. - (if c-comment-edit-hook - (funcall c-comment-edit-hook)) - ;; final admonition - (message - (substitute-command-keys - "Type \\[c-comment-edit-end] to end edit, \\[c-comment-edit-abort] to abort with no change."))) - -(defun c-comment-edit-end () - "End c-comment-edit. -C comment is replaced by its edited counterpart in the appropriate C buffer. -Indentation will be the same as the original." - (interactive) - (let ((tuple (find-c-comment-buffer))) - (if (null tuple) - (error "Not a c-comment-edit buffer.")) - (let ((inhibit-quit t) - (c-comment-c-buffer (car tuple)) - (c-comment-buffer (nth 1 tuple)) - (c-comment-start (nth 2 tuple)) - (c-comment-end (nth 3 tuple))) - (cond - ((buffer-modified-p) - ;; rebuild the comment - (goto-char (point-min)) - (insert "/*\n") - (if (string= c-comment-leader " ") - (while (not (eobp)) - (if (not (eolp)) - (insert c-comment-leader " ")) - (forward-line)) - (while (not (eobp)) - (insert c-comment-leader (if (eolp) "" " ")) - (forward-line))) - (if (not (char-equal (preceding-char) ?\n)) - (insert "\n")) - (insert (if (string= c-comment-leader " *") " */" "*/")) - ;; indent if necessary - (let ((indention - (save-excursion - (set-buffer c-comment-c-buffer) - (goto-char c-comment-start) - (current-column)))) - (goto-char (point-min)) - (cond ((not (zerop indention)) - ;; first line is already indented - ;; in the C buffer - (forward-line) - (while (not (eobp)) - (indent-to indention) - (forward-line))))) - ;; replace the old comment with the new - (save-excursion - (set-buffer c-comment-c-buffer) - (save-point - (save-excursion - (delete-region c-comment-start c-comment-end) - (goto-char c-comment-start) - (set-buffer c-comment-buffer) - (append-to-buffer c-comment-c-buffer - (point-min) (point-max)))))) - (t (message "No change."))) - ;; switch to the C buffer - (if (get-buffer-window c-comment-c-buffer) - (select-window (get-buffer-window c-comment-c-buffer)) - (switch-to-buffer c-comment-c-buffer)) - ;; delete the window viewing the comment buffer - (and (get-buffer-window c-comment-buffer) - (delete-window (get-buffer-window c-comment-buffer))) - ;; unlink the tuple from c-comment-edit-buffer-alist - (setq c-comment-edit-buffer-alist - (delq tuple c-comment-edit-buffer-alist)) - ;; let Emacs reclaim various resources - (save-excursion - (set-buffer c-comment-buffer) - (set-buffer-modified-p nil) - (kill-buffer c-comment-buffer)) - (set-marker c-comment-start nil) - (set-marker c-comment-end nil)))) - -(defun c-comment-edit-abort () - "Abort a c-comment-edit with no change." - (interactive) - (let* ((tuple (find-c-comment-buffer)) - (c-comment-c-buffer (car tuple)) - (c-comment-buffer (nth 1 tuple)) - (c-comment-start (nth 2 tuple)) - (c-comment-end (nth 3 tuple))) - (if (null tuple) - (error "Not a c-comment-edit buffer.")) - ;; switch to the C buffer - (if (get-buffer-window c-comment-c-buffer) - (select-window (get-buffer-window c-comment-c-buffer)) - (switch-to-buffer c-comment-c-buffer)) - (let ((inhibit-quit t)) - (save-excursion - (set-buffer c-comment-buffer) - (set-buffer-modified-p nil) - (kill-buffer c-comment-buffer)) - ;; unlink the tuple from c-comment-edit-buffer-alist - (setq c-comment-edit-buffer-alist - (delq tuple c-comment-edit-buffer-alist)) - (set-marker c-comment-start nil) - (set-marker c-comment-end nil) - (message "Aborted with no change.")))) - -;; this loses on /* /* */ but doing it right would be grim. -(defun within-c-comment-p () - (condition-case error-data - (let (start end) - (save-point - (search-backward "/*") - (setq start (point)) - (search-forward "*/") - (setq end (point))) - (if (< (point) end) (cons start end) nil)) - (search-failed nil))) - -(defun find-c-comment-buffer (&optional buffer) - (or buffer (setq buffer (current-buffer))) - (let ((list c-comment-edit-buffer-alist)) - (catch 'return-value - (while list - (if (eq (nth 1 (car list)) buffer) - (throw 'return-value (car list)) - (setq list (cdr list))))))) - -(defun find-c-comment-c-buffer (&optional buffer) - (or buffer (setq buffer (current-buffer))) - (let ((list c-comment-edit-buffer-alist)) - (catch 'return-value - (while list - (if (eq (car (car list)) buffer) - (throw 'return-value (car list)) - (setq list (cdr list))))))) - -;; c-comment.el ends here diff --git a/xemacs-packages/lisp/c-support/c-fill.el b/xemacs-packages/lisp/c-support/c-fill.el deleted file mode 100644 index 48310bfb..00000000 --- a/xemacs-packages/lisp/c-support/c-fill.el +++ /dev/null @@ -1,272 +0,0 @@ -;;; C comment mode - An auto-filled comment mode for gnu c-mode. -;;; -;;; Author: Robert Mecklenburg -;;; Computer Science Dept. -;;; University of Utah -;;; From: mecklen@utah-gr.UUCP (Robert Mecklenburg) -;;; Also hartzell@Boulder.Colorado.EDU -;;; (c) 1986, University of Utah -;;; -;;; Everyone is granted permission to copy, modify and redistribute -;;; this file, provided the people they give it to can. - -;;; Synched up with: Not in FSF. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; I have written a "global comment" minor-mode which performs auto-fill, -;;; fill-paragraph, and auto-indentation functions. This function only -;;; works for comments which occupy an entire line (not comments to the -;;; right of code). The mode has several options set through variables. -;;; If the variable c-comment-starting-blank is non-nil multi-line -;;; comments come out like this: -;;; -;;; /* -;;; * Your favorite -;;; * multi-line comment. -;;; */ -;;; -;;; otherwise they look like this: -;;; -;;; /* Your Favorite -;;; * multi-line comment. -;;; */ -;;; -;;; If the variable c-comment-hanging-indent is non-nil K&R style comments -;;; are indented automatically like this: -;;; -;;; /* my_func - For multi-line comments with hanging indent -;;; * the text is lined up after the dash. -;;; */ -;;; -;;; otherwise the text "the text" (!) is lined up under my_func. If a -;;; comment fits (as typed) on a single line it remains a single line -;;; comment even if c-comment-starting-blank is set. If -;;; c-comment-indenting is non-nil hitting carriage return resets the -;;; indentation for the next line to the current line's indentation -;;; (within the comment) like this: -;;; -;;; /* Typing along merrily.... -;;; * Now I indent with spaces, when I hit return -;;; * the indentation is automatically set to -;;; * ^ here. -;;; */ -;;; -;;; Due to my lack of understanding of keymaps this permanently resets M-q -;;; to my own fill function. I would like to have the comment mode -;;; bindings only in comment mode but I can't seem to get that to work. -;;; If some gnu guru can clue me in, I'd appreciate it. -;;; -(defvar c-comment-starting-blank t - "*Controls whether global comments have an initial blank line.") -(defvar c-comment-indenting t - "*If set global comments are indented to the level of the previous line.") -(defvar c-comment-hanging-indent t - "*If true, comments will be automatically indented to the dash.") -(defvar c-hang-already-done t - "If true we have performed the hanging indent already for this comment.") - - -;;; -;;; c-comment-map - This is a sparse keymap for comment mode which -;;; gets inserted when c-comment is called. -;;; -(defvar c-comment-mode-map () - "Keymap used in C comment mode.") -(if c-comment-mode-map - () - (setq c-comment-mode-map (copy-keymap c-mode-map)) - (define-key c-comment-mode-map "\e\r" 'newline) - (define-key c-comment-mode-map "\eq" 'set-fill-and-fill) - (define-key c-comment-mode-map "\r" 'set-fill-and-return)) - -;;; -;;; c-comment - This is a filled comment mode which can format -;;; indented text, do hanging indents, and symetric -;;; placement of comment delimiters. -;;; -(defun c-comment () - "Edit a C comment with filling and indentation. -This performs hanging indentation, symmetric placement of delimiters, - and Indented-Text mode style indentation. Type 'M-x apropos -c-comment' for information on options." - (interactive) - (let - ;; Save old state. - ((auto-fill-function (if c-comment-indenting - 'do-indented-auto-fill 'do-auto-fill)) -; (comment-start nil) - (comment-multi-line t) - (comment-start-skip "/*\\*+[ ]*") - (paragraph-start-ref paragraph-start) - fill-prefix paragraph-start paragraph-separate opoint) - - ;; Determine if we are inside a comment. - (setq in-comment - (save-excursion - (and (re-search-backward "/\\*\\|\\*/" 0 t) - (string= "/*" (buffer-substring (point) (+ (point) 2)))))) - - ;; Indent the comment and set the fill prefix to comment continuation - ;; string. If we are already in a comment get the indentation on - ;; the current line. - (setq c-hang-already-done nil) - - ;; Set the beginning of the comment and insert the blank line if needed. - (use-local-map c-comment-mode-map) - (if (not in-comment) - (progn (c-indent-line) - (insert "/* ") - (setq fill-prefix (get-current-fill (point))) - (recursive-edit) - - ;; If the comment fits on one line, place the close - ;; comment at the end of the line. Otherwise, newline. - (setq opoint (point)) - (if (and (save-excursion (beginning-of-line) - (search-forward "/*" opoint t)) - (<= (+ (current-column) 3) 79)) - (insert " */") - (insert "\n*/")) - - (c-indent-line)) - (progn (setq fill-prefix (get-current-fill (point))) - (recursive-edit) - (search-forward "*/" (buffer-size) t) - (forward-line 1))) - - ;; If starting blank enabled, insert a newline, etc., but only if - ;; this comment requires multiple lines. - (if c-comment-starting-blank - (save-excursion - (setq opoint (point)) - (forward-line -1) - (if (or (null (search-forward "/*" opoint t)) - (null (search-forward "*/" opoint t))) - (progn - (search-backward "/*") - (re-search-forward comment-start-skip opoint t) - (setq fill-prefix (get-current-fill (point))) - (if (not (looking-at "\n")) - (insert ?\n fill-prefix)))))) -; (indent-new-comment-line)))))) - - ;; Move cursor to indentation. - (c-indent-line) - (use-local-map c-mode-map) - ) - ) - - -;;; -;;; set-fill-and-fill - Get the current fill for this line and fill -;;; the paragraph. -;;; -(defun set-fill-and-fill (arg) - "Get the fill-prefix and fill the current paragraph." - - (interactive "P") - (setq fill-prefix (get-current-fill (point))) - (fill-paragraph arg)) - -;;; -;;; set-fill-and-return - Set the current fill prefix and -;;; indent-new-comment-line. -;;; -(defun set-fill-and-return () - "Set the current fill prefix and move to the next line." - - (interactive) - (if c-comment-indenting - (setq fill-prefix (get-current-fill (point)))) - (insert ?\n fill-prefix)) - -;;; -;;; do-indented-auto-fill - Perform the auto-fill function, but get -;;; the fill-prefix first. -;;; -(defun do-indented-auto-fill () - "Perform auto-fill, but get fill-prefix first." - - (let ((opoint (point))) - (save-excursion - (move-to-column (1+ fill-column)) - (skip-chars-backward "^ \t\n") - (if (bolp) - (re-search-forward "[ \t]" opoint t)) - ;; If there is a space on the line before fill-point, - ;; and nonspaces precede it, break the line there. - (if (save-excursion - (skip-chars-backward " \t") - (not (bolp))) - - ;; If we are wrapping to a new line, figure out the indentation on - ;; the current line first. - (progn - (setq fill-prefix (get-current-fill opoint)) - (insert ?\n fill-prefix))))) -; (indent-new-comment-line))))) - ) - - -;;; -;;; get-current-fill - Get the fill-prefix for the current line. This -;;; assumes that the valid fill prefix is between -;;; (beginning-of-line) and (point). -;;; -(defun get-current-fill (pnt) - "Get the current fill prefix. -A valid fill prefix must be between the beginning of the line and point." - - (let ((opoint pnt) fill last-char) - (save-excursion - (beginning-of-line) - (setq fill - (buffer-substring (point) - (progn - (re-search-forward comment-start-skip opoint t) - (point)))) - - ;; Be sure there is trailing white space. - (setq last-char (substring fill (1- (length fill)) (length fill))) - (if (and (not (string= " " last-char)) - (not (string= " " last-char))) - (setq fill (concat fill " "))) - - (setq fill (replace-letter fill "/" " ")) - - ;; Get the hanging indentation if we haven't already. - (if (and c-comment-hanging-indent (not c-hang-already-done)) - (let ((curr (point)) - (opnt (progn (end-of-line) (point)))) - (beginning-of-line) - (if (search-forward " - " opnt t) - (progn - (setq fill (concat fill (make-string (- (point) curr) 32))) - (setq c-hang-already-done t))))) - - ;; Set the paragraph delimiters. - (setq paragraph-start (concat paragraph-start-ref - "\\|^" - (regexp-quote - (substring fill - 0 (1- (length fill)))) - "$")) - (setq paragraph-separate paragraph-start)) - fill) - ) - - -;;; -;;; replace-letter - Given a string, an old letter and a new letter, -;;; perform the substitution. -;;; -(defun replace-letter (str old-letter new-letter) - (let (new-str c - (sp 0) - (size (length str))) - (while (< sp size) - (setq c (substring str sp (1+ sp))) - (setq new-str (concat new-str (if (string= c old-letter) new-letter c))) - (setq sp (1+ sp))) - new-str)) diff --git a/xemacs-packages/lisp/c-support/c-style.el b/xemacs-packages/lisp/c-support/c-style.el deleted file mode 100644 index 427fce6c..00000000 --- a/xemacs-packages/lisp/c-support/c-style.el +++ /dev/null @@ -1,199 +0,0 @@ -;; c-style.el --- sets c-style control variables. -;; Copyright (C) 1992-1993 Free Software Foundation, Inc. - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. -;; -;; LCD Archive Entry: -;; c-style|Daniel LaLiberte|liberte@cs.uiuc.edu -;; |sets c-style control variables -;; |Thu Feb 27 13:42:57 CST 1992|Version: 2.1|~/as-is/c-src-doc.el.Z -;; -;;; Synched up with: Not in FSF. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; There are several ways to call set-c-style described below. -;;; None of these methods reindent your program - they only affect -;;; new indentation. -;;; -;;; - Just call set-c-style in your c-mode-hook. -;;; Without style argument, default-c-style will be used. -;;; With style argument, this will set the style for every -;;; c-mode buffer the same. -;;; -;;; - Call set-c-style from the Local Variables list. -;;; e.g. "eval:(set-c-style 'C++)" -;;; -;;; - Call set-c-style interactively. It prompts for the style name -;;; with completion using default-c-style. -;;; -;;; For convenience, put one of the following in your .emacs: -;;; (autoload 'set-c-style "c-style" nil t) -;;; or (load "c-style") -;;; ===================================================== - -(defvar default-c-style 'GNU - "*The default value of c-style. Set this in your .emacs.") - -;; The following predefined styles are all I know about. -;; If you learn of another style that has a "big" following, please -;; send me the parameters. - -(defvar c-style-alist - '((GNU - (c-indent-level 2) - (c-continued-statement-offset 2) - (c-brace-offset 0) - (c-argdecl-indent 5) - (c-label-offset -2)) - - (BSD - (c-indent-level 8) - (c-continued-statement-offset 8) - (c-brace-offset -8) - (c-argdecl-indent 8) - (c-label-offset -8)) - - (K&R - (c-indent-level 5) - (c-continued-statement-offset 5) - (c-brace-offset -5) - (c-argdecl-indent 0) - (c-label-offset -5)) - - (BS ; was C++ - (c-indent-level 4) - (c-continued-statement-offset 4) - (c-brace-offset -4) - (c-argdecl-indent 4) - (c-label-offset -4)) - - ;; From Lynn Slater - (LRS - (c-indent-level 4) - (c-continued-statement-offset 4) - (c-brace-offset 0) - (c-argdecl-indent 4) - (c-label-offset -2) - (c-auto-newline nil)) - - (Plauger - (c-indent-level 0) - (c-continued-statement-offset 8) - (c-continued-brace-offset -8) - (c-brace-offset 8) - (c-brace-imaginary-offset 0) - (c-argdecl-indent 0) - (c-label-offset -8) - (c-auto-newline t) - (c-tab-always-indent t)) - - ;; From Jozsef A Toth - ;; Is this really the Whitesmith style? - (Alman - (c-argdecl-indent 0) - (c-brace-imaginary-offset 2) ;;; ???? - (c-brace-offset 0) - (c-continued-statement-offset 2) - (c-indent-level 0) - (c-label-offset -2) - (c-auto-newline t) - (comment-column 40) - (tab-width 2) - (fill-column '79)) - - (Gould - (c-indent-level 4) - (c-continued-statement-offset 4) - (c-brace-offset -4) - (c-argdecl-indent 8) - (c-label-offset -2) - (c-brace-imaginary-offset 0)) - - ;; From Joan Eslinger - (WRS - (c-indent-level 0) - (c-continued-statement-offset 4) - (c-brace-offset 0) - (c-argdecl-indent 4) - (c-label-offset -2) - (c-brace-imaginary-offset 4) - (c-continued-brace-offset -4)) - )) - -(defvar c-style nil - "The buffer local c-mode indentation style.") - -;; Add style name to mode line. Assumes minor-mode-alist is not buffer local. -;; Thanks to Joan Eslinger. - -(defvar c-style-name nil - "The style name for a c-mode indentation style. -This is to be set by set-c-style, and used by the mode line.") - -(or (assq 'c-style-name minor-mode-alist) - (setq minor-mode-alist - (purecopy - (append minor-mode-alist - ;; use undocumented feature - '((c-style-name c-style-name)))))) - -(defun set-c-style (&optional style) - "Set up the c-mode style variables from STYLE if it is given, or -default-c-style otherwise. It makes the c indentation style variables -buffer local." - - (interactive) - - (let ((c-styles (mapcar 'car c-style-alist))) ; for completion - (if (interactive-p) - (setq style - (let ((style-string ; Get style name with completion. - (completing-read - (format "Set c-mode indentation style to (default %s): " - default-c-style) - (vconcat c-styles) - (function (lambda (arg) (memq arg c-styles))) - ))) - (if (string-equal "" style-string) - default-c-style - (intern style-string)) - ))) - - ;; If style is nil, use default-c-style. - (setq style (or style default-c-style)) - - (make-local-variable 'c-style) - (if (memq style c-styles) - (setq c-style style) - (error "Undefined c style: %s" style) - ) - (message "c-style: %s" c-style) - - ;; Set the c-style-name - (make-local-variable 'c-style-name) - (setq c-style-name (format " %s" c-style)) - - ;; Finally, set the indentation style variables making each one local. - (mapcar (function (lambda (c-style-pair) - (make-local-variable (car c-style-pair)) - (set (car c-style-pair) - (car (cdr c-style-pair))))) - (cdr (assq c-style c-style-alist))) - c-style - )) diff --git a/xemacs-packages/lisp/c-support/cmacexp.el b/xemacs-packages/lisp/c-support/cmacexp.el deleted file mode 100644 index c78214c5..00000000 --- a/xemacs-packages/lisp/c-support/cmacexp.el +++ /dev/null @@ -1,389 +0,0 @@ -;;; cmacexp.el --- expand C macros in a region - -;; Copyright (C) 1992, 1994, 1996 Free Software Foundation, Inc. - -;; Author: Francesco Potorti` -;; Version: $Id: cmacexp.el,v 1.2 2005/04/15 20:23:27 adrian Exp $ -;; Adapted-By: ESR -;; Keywords: c - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: FSF 19.34. - -;; USAGE ============================================================= - -;; In C mode C-C C-e is bound to c-macro-expand. The result of the -;; expansion is put in a separate buffer. A user option allows the -;; window displaying the buffer to be optimally sized. -;; -;; When called with a C-u prefix, c-macro-expand replaces the selected -;; region with the expansion. Both the preprocessor name and the -;; initial flag can be set by the user. If c-macro-prompt-flag is set -;; to a non-nil value the user is offered to change the options to the -;; preprocessor each time c-macro-expand is invoked. Preprocessor -;; arguments default to the last ones entered. If c-macro-prompt-flag -;; is nil, one must use M-x set-variable to set a different value for -;; c-macro-cppflags. - -;; A c-macro-expansion function is provided for non-interactive use. - -;; INSTALLATION ====================================================== - -;; Put the following in your ~/.emacs file. - -;; If you want the *Macroexpansion* window to be not higher than -;; necessary: -;;(setq c-macro-shrink-window-flag t) -;; -;; If you use a preprocessor other than /lib/cpp (be careful to set a -;; -C option or equivalent in order to make the preprocessor not to -;; strip the comments): -;;(setq c-macro-preprocessor "gpp -C") -;; -;; If you often use a particular set of flags: -;;(setq c-macro-cppflags "-I /usr/include/local -DDEBUG" -;; -;; If you want the "Preprocessor arguments: " prompt: -;;(setq c-macro-prompt-flag t) - -;; BUG REPORTS ======================================================= - -;; Please report bugs, suggestions, complaints and so on to -;; pot@cnuce.cnr.it (Francesco Potorti`). - -;; IMPROVEMENTS OVER emacs 18.xx cmacexp.el ========================== - -;; - A lot of user and programmer visible changes. See above. -;; - #line directives are inserted, so __LINE__ and __FILE__ are -;; correctly expanded. Works even with START inside a string, a -;; comment or a region #ifdef'd away by cpp. cpp is invoked with -C, -;; making comments visible in the expansion. -;; - All work is done in core memory, no need for temporary files. - -;; ACKNOWLEDGEMENTS ================================================== - -;; A lot of thanks to Don Maszle who did a great work of testing, bug -;; reporting and suggestion of new features. This work has been -;; partially inspired by Don Maszle and Jonathan Segal's. - -;; BUGS ============================================================== - -;; If the start point of the region is inside a macro definition the -;; macro expansion is often inaccurate. - - -(require 'cc-mode) - -(provide 'cmacexp) - -(defgroup c-macro nil - "Expand C macros in a region." - :group 'c) - - -(defcustom c-macro-shrink-window-flag nil - "*Non-nil means shrink the *Macroexpansion* window to fit its contents." - :type 'boolean - :group 'c-macro) - -(defcustom c-macro-prompt-flag nil - "*Non-nil makes `c-macro-expand' prompt for preprocessor arguments." - :type 'boolean - :group 'c-macro) - -(defcustom c-macro-preprocessor - ;; Cannot rely on standard directory on MS-DOS to find CPP. - (cond ((eq system-type 'ms-dos) "cpp -C") - ;; Solaris has it in an unusual place. - ((and (string-match "^[^-]*-[^-]*-\\(solaris\\|sunos5\\)" - system-configuration) - (file-exists-p "/opt/SUNWspro/SC3.0.1/bin/acomp")) - "/opt/SUNWspro/SC3.0.1/bin/acomp -C -E") - (t "/lib/cpp -C")) - "The preprocessor used by the cmacexp package. - -If you change this, be sure to preserve the `-C' (don't strip comments) -option, or to set an equivalent one." - :type 'string - :group 'c-macro) - -(defcustom c-macro-cppflags "" - "*Preprocessor flags used by `c-macro-expand'." - :type 'string - :group 'c-macro) - -(defconst c-macro-buffer-name "*Macroexpansion*") - -;; Autoload for XEmacs -;;;###autoload -(defun c-macro-expand (start end subst) - "Expand C macros in the region, using the C preprocessor. -Normally display output in temp buffer, but -prefix arg means replace the region with it. - -`c-macro-preprocessor' specifies the preprocessor to use. -Prompt for arguments to the preprocessor \(e.g. `-DDEBUG -I ./include') -if the user option `c-macro-prompt-flag' is non-nil. - -Noninteractive args are START, END, SUBST. -For use inside Lisp programs, see also `c-macro-expansion'." - - (interactive "r\nP") - (let ((inbuf (current-buffer)) - (displaybuf (if subst - (get-buffer c-macro-buffer-name) - (get-buffer-create c-macro-buffer-name))) - (expansion "")) - ;; Build the command string. - (if c-macro-prompt-flag - (setq c-macro-cppflags - (read-string "Preprocessor arguments: " - c-macro-cppflags))) - ;; Decide where to display output. - (if (and subst - (and buffer-read-only (not inhibit-read-only)) - (not (eq inbuf displaybuf))) - (progn - (message - "Buffer is read only: displaying expansion in alternate window") - (sit-for 2) - (setq subst nil) - (or displaybuf - (setq displaybuf (get-buffer-create c-macro-buffer-name))))) - ;; Expand the macro and output it. - (setq expansion (c-macro-expansion start end - (concat c-macro-preprocessor " " - c-macro-cppflags) t)) - (if subst - (let ((exchange (= (point) start))) - (delete-region start end) - (insert expansion) - (if exchange - (exchange-point-and-mark))) - (set-buffer displaybuf) - (setq buffer-read-only nil) - (buffer-disable-undo displaybuf) - (erase-buffer) - (insert expansion) - (set-buffer-modified-p nil) - (if (string= "" expansion) - (message "Null expansion") - (c-macro-display-buffer)) - (setq buffer-read-only t) - (setq buffer-auto-save-file-name nil) - (bury-buffer displaybuf)))) - - -;; Display the current buffer in a window which is either just large -;; enough to contain the entire buffer, or half the size of the -;; screen, whichever is smaller. Do not select the new -;; window. -;; -;; Several factors influence window resizing so that the window is -;; sized optimally if it is created anew, and so that it is messed -;; with minimally if it has been created by the user. If the window -;; chosen for display exists already but contains something else, the -;; window is not re-sized. If the window already contains the current -;; buffer, it is never shrunk, but possibly expanded. Finally, if the -;; variable c-macro-shrink-window-flag is nil the window size is *never* -;; changed. -(defun c-macro-display-buffer () - (goto-char (point-min)) - (c-mode) - (let ((oldwinheight (window-height)) - (alreadythere ;the window was already there - (get-buffer-window (current-buffer))) - (popped nil)) ;the window popped changing the layout - (or alreadythere - (progn - (display-buffer (current-buffer) t) - (setq popped (/= oldwinheight (window-height))))) - (if (and c-macro-shrink-window-flag ;user wants fancy shrinking :\) - (or alreadythere popped)) - ;; Enlarge up to half screen, or shrink properly. - (let ((oldwin (selected-window)) - (minheight 0) - (maxheight 0)) - (save-excursion - (select-window (get-buffer-window (current-buffer))) - (setq minheight (if alreadythere - (window-height) - window-min-height)) - ;; XEmacs change - (setq maxheight (/ (screen-height) 2)) - (enlarge-window (- (min maxheight - (max minheight - (+ 2 (vertical-motion (point-max))))) - (window-height))) - (goto-char (point-min)) - (select-window oldwin)))))) - - -(defun c-macro-expansion (start end cppcommand &optional display) - "Run a preprocessor on region and return the output as a string. -Expand the region between START and END in the current buffer using -the shell command CPPCOMMAND (e.g. \"/lib/cpp -C -DDEBUG\"). -Be sure to use a -C (don't strip comments) or equivalent option. -Optional arg DISPLAY non-nil means show messages in the echo area." - -;; Copy the current buffer's contents to a temporary hidden buffer. -;; Delete from END to end of buffer. Insert a preprocessor #line -;; directive at START and after each #endif following START that are -;; not inside a comment or a string. Put all the strings thus -;; inserted (without the "line" substring) in a list named linelist. -;; If START is inside a comment, prepend "*/" and append "/*" to the -;; #line directive. If inside a string, prepend and append "\"". -;; Preprocess the buffer contents, then look for all the lines stored -;; in linelist starting from end of buffer. The last line so found is -;; where START was, so return the substring from point to end of -;; buffer. - (let ((inbuf (current-buffer)) - (outbuf (get-buffer-create " *C Macro Expansion*")) - (filename (if (and buffer-file-name - (string-match (regexp-quote default-directory) - buffer-file-name)) - (substring buffer-file-name (match-end 0)) - (buffer-name))) - (mymsg (format "Invoking %s%s%s on region..." - c-macro-preprocessor - (if (string= "" c-macro-cppflags) "" " ") - c-macro-cppflags)) - (uniquestring "??? !!! ??? start of c-macro expansion ??? !!! ???") - (startlinenum 0) - (linenum 0) - (startstat ()) - (startmarker "") - (exit-status 0) - (tempname (make-temp-name (concat - (or (getenv "TMPDIR") (getenv "TEMP") - (getenv "TMP") "/tmp") - "/")))) - (unwind-protect - (save-excursion - (save-restriction - (widen) - (let ((in-syntax-table (syntax-table))) - (set-buffer outbuf) - (setq buffer-read-only nil) - (erase-buffer) - (set-syntax-table in-syntax-table)) - (insert-buffer-substring inbuf 1 end)) - - ;; We have copied inbuf to outbuf. Point is at end of - ;; outbuf. Inset a newline at the end, so cpp can correctly - ;; parse a token ending at END. - (insert "\n") - - ;; Save sexp status and line number at START. - (setq startstat (parse-partial-sexp 1 start)) - (setq startlinenum (+ (count-lines 1 (point)) - (if (bolp) 1 0))) - - ;; Now we insert the #line directives after all #endif or - ;; #else following START going backward, so the lines we - ;; insert don't change the line numbers. - ;(switch-to-buffer outbuf) (debug) ;debugging instructions - (goto-char (point-max)) - (while (re-search-backward "\n#\\(endif\\|else\\)\\>" start 'move) - (if (equal (nthcdr 3 (parse-partial-sexp start (point) - nil nil startstat)) - '(nil nil nil 0 nil)) ;neither in string nor in - ;comment nor after quote - (progn - (goto-char (match-end 0)) - (setq linenum (+ startlinenum - (count-lines start (point)))) - (insert (format "\n#line %d \"%s\"\n" linenum filename)) - (goto-char (match-beginning 0))))) - - ;; Now we are at START. Insert the first #line directive. - ;; This must work even inside a string or comment, or after a - ;; quote. - (let* ((startinstring (nth 3 startstat)) - (startincomment (nth 4 startstat)) - (startafterquote (nth 5 startstat)) - (startinbcomment (nth 7 startstat))) - (insert (if startafterquote " " "") - (cond (startinstring - (char-to-string startinstring)) - (startincomment "*/") - ("")) - (setq startmarker - (concat "\n" uniquestring - (cond (startinstring - (char-to-string startinstring)) - (startincomment "/*") - (startinbcomment "//")) - (if startafterquote "\\"))) - (format "\n#line %d \"%s\"\n" startlinenum filename))) - - ;; Call the preprocessor. - (if display (message mymsg)) - (setq exit-status - (call-process-region 1 (point-max) - shell-file-name - t (list t tempname) nil - shell-command-switch cppcommand)) - (if display (message (concat mymsg "done"))) - (if (= (buffer-size) 0) - ;; Empty output is normal after a fatal error. - (insert "\nPreprocessor produced no output\n") - ;; Find and delete the mark of the start of the expansion. - ;; Look for `# nn "file.c"' lines and delete them. - (goto-char (point-min)) - (search-forward startmarker) - (delete-region 1 (point))) - (while (re-search-forward (concat "^# [0-9]+ \"" - (regexp-quote filename) - "\"") nil t) - (beginning-of-line) - (let ((beg (point))) - (forward-line 1) - (delete-region beg (point)))) - - ;; If CPP got errors, show them at the beginning. - ;; MS-DOS shells don't return the exit code of their children. - ;; Look at the size of the error message file instead, but - ;; don't punish those MS-DOS users who have a shell that does - ;; return an error code. - (or (and (or (not (boundp 'msdos-shells)) - (not (member (file-name-nondirectory shell-file-name) - msdos-shells))) - (eq exit-status 0)) - (zerop (nth 7 (file-attributes (expand-file-name tempname)))) - (progn - (goto-char (point-min)) - ;; Put the messages inside a comment, so they won't get in - ;; the way of font-lock, highlighting etc. - (insert - (format "/* Preprocessor terminated with status %s\n\n Messages from `%s\':\n\n" - exit-status cppcommand)) - (goto-char (+ (point) - (nth 1 (insert-file-contents tempname)))) - (insert "\n\n*/\n"))) - (delete-file tempname) - - ;; Compute the return value, keeping in account the space - ;; inserted at the end of the buffer. - (buffer-substring 1 (max 1 (- (point-max) 1)))) - - ;; Cleanup. - (kill-buffer outbuf)))) - -;;; cmacexp.el ends here diff --git a/xemacs-packages/lisp/c-support/ctypes.el b/xemacs-packages/lisp/c-support/ctypes.el deleted file mode 100644 index ba300d30..00000000 --- a/xemacs-packages/lisp/c-support/ctypes.el +++ /dev/null @@ -1,1737 +0,0 @@ -;;; ctypes.el --- Enhanced Font lock support for custom defined types. - -;; Copyright (C) 1997 Anders Lindgren. - -;; Author: Anders Lindgren -;; Maintainer: Anders Lindgren -;; Version: 1.2 -;; Created: 16 Mar 1997 -;; Date: 12 Jun 1997 - -;; 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); -;; -;; a) A new function `hello' that takes one argument `bar' that is a -;; pointer to a `foo', or; -;; -;; b) 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.csd.uu.se/~andersl/emacs.shtml - -;; 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 Emacs 19.35 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 determine 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) - ;; This version of the mode descriptor needs font-lock from - ;; Emacs 19.35. - '((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 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 too 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.") - - -;; 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 -variable to, for example, \".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)))) - - -;; TODO: classes need not start at the beginning of a line, do they? -(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\\)\\>" 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 'font-lock-keyword-depth) - (defun font-lock-keyword-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) - "Set a Emacs 19.35 (not yet released) style font-lock regexp." - (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)))))) - - -;; Pre Emacs 19.35 stuff below. - -(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 (font-lock-keyword-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/xemacs-packages/lisp/c-support/custom-load.el b/xemacs-packages/lisp/c-support/custom-load.el deleted file mode 100644 index af968d70..00000000 --- a/xemacs-packages/lisp/c-support/custom-load.el +++ /dev/null @@ -1,13 +0,0 @@ -;;; custom-load.el --- automatically extracted custom dependencies - -;;; Code: - -(autoload 'custom-add-loads "cus-load") - -(custom-add-loads 'hide-ifdef '("hideif")) -(custom-add-loads 'c-macro '("cmacexp")) -(custom-add-loads 'languages '("hideshow")) -(custom-add-loads 'hideshow '("hideshow")) -(custom-add-loads 'c '("cmacexp" "hideif")) - -;;; custom-load.el ends here diff --git a/xemacs-packages/lisp/c-support/hideif.el b/xemacs-packages/lisp/c-support/hideif.el deleted file mode 100644 index 94fb57fb..00000000 --- a/xemacs-packages/lisp/c-support/hideif.el +++ /dev/null @@ -1,1081 +0,0 @@ -;;; hide-ifdef-mode.el --- hides selected code within ifdef. - -;; Copyright (C) 1988, 1994 Free Software Foundation, Inc. - -;; Author: Dan LaLiberte -;; Maintainer: FSF -;; Keywords: c, outlines - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: FSF 20.4. - -;;; Commentary: - -;; To initialize, toggle the hide-ifdef minor mode with -;; -;; M-x hide-ifdef-mode -;; -;; This will set up key bindings and call hide-ifdef-mode-hook if it -;; has a value. To explicitly hide ifdefs using a buffer-local -;; define list (default empty), type -;; -;; M-x hide-ifdefs or C-c @ h -;; -;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't -;; pass through. The support of constant expressions in #if lines is -;; limited to identifiers, parens, and the operators: &&, ||, !, and -;; "defined". Please extend this. -;; -;; The hidden code is marked by ellipses (...). Be -;; cautious when editing near ellipses, since the hidden text is -;; still in the buffer, and you can move the point into it and modify -;; text unawares. If you don't want to see the ellipses, set -;; selective-display-ellipses to nil. But this can be dangerous. -;; You can make your buffer read-only while hide-ifdef-hiding by setting -;; hide-ifdef-read-only to a non-nil value. You can toggle this -;; variable with hide-ifdef-toggle-read-only (C-c @ C-q). -;; -;; You can undo the effect of hide-ifdefs by typing -;; -;; M-x show-ifdefs or C-c @ s -;; -;; Use M-x hide-ifdef-define (C-c @ d) to define a symbol. -;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol. -;; -;; If you define or undefine a symbol while hide-ifdef-mode is in effect, -;; the display will be updated. Only the define list for the current -;; buffer will be affected. You can save changes to the local define -;; list with hide-ifdef-set-define-alist. This adds entries -;; to hide-ifdef-define-alist. -;; -;; If you have defined a hide-ifdef-mode-hook, you can set -;; up a list of symbols that may be used by hide-ifdefs as in the -;; following example: -;; -;; (setq hide-ifdef-mode-hook -;; '(lambda () -;; (if (not hide-ifdef-define-alist) -;; (setq hide-ifdef-define-alist -;; '((list1 ONE TWO) -;; (list2 TWO THREE) -;; ))) -;; (hide-ifdef-use-define-alist 'list2) ; use list2 by default -;; )) -;; -;; You can call hide-ifdef-use-define-alist (C-c @ u) at any time to specify -;; another list to use. -;; -;; To cause ifdefs to be hidden as soon as hide-ifdef-mode is called, -;; set hide-ifdef-initially to non-nil. -;; -;; If you set hide-ifdef-lines to t, hide-ifdefs hides all the #ifdef lines. -;; In the absence of highlighting, that might be a bad idea. If you set -;; hide-ifdef-lines to nil (the default), the surrounding preprocessor -;; lines will be displayed. That can be confusing in its own -;; right. Other variations on display are possible, but not much -;; better. -;; -;; You can explicitly hide or show individual ifdef blocks irrespective -;; of the define list by using hide-ifdef-block and show-ifdef-block. -;; -;; You can move the point between ifdefs with forward-ifdef, backward-ifdef, -;; up-ifdef, down-ifdef, next-ifdef, and previous-ifdef. -;; -;; If you have minor-mode-alist in your mode line (the default) two labels -;; may appear. "Ifdef" will appear when hide-ifdef-mode is active. "Hiding" -;; will appear when text may be hidden ("hide-ifdef-hiding" is non-nil). -;; -;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL. -;; Extensively modified by Daniel LaLiberte (while at Gould). -;; -;; You may freely modify and distribute this, but keep a record -;; of modifications and send comments to: -;; liberte@a.cs.uiuc.edu or ihnp4!uiucdcs!liberte -;; I will continue to upgrade hide-ifdef-mode -;; with your contributions. - -;;; Code: - -(require 'cc-mode) - -(defgroup hide-ifdef nil - "Hide selected code within `ifdef'." - :group 'c) - -(defvar hide-ifdef-mode-submap nil - "Keymap used with Hide-Ifdef mode.") - -;;;###autoload -(defvar hide-ifdef-mode-map nil - "Keymap used with Hide-Ifdef mode.") - -;; XEmacs Change: Use vector notation. -(defconst hide-ifdef-mode-prefix-key [(control c) @] - "Prefix key for all Hide-Ifdef mode commands.") - -;; Set up the submap that goes after the prefix key. -(if hide-ifdef-mode-submap - () ; Don't redefine it. - (setq hide-ifdef-mode-submap (make-sparse-keymap)) - (define-key hide-ifdef-mode-submap "d" 'hide-ifdef-define) - (define-key hide-ifdef-mode-submap "u" 'hide-ifdef-undef) - (define-key hide-ifdef-mode-submap "D" 'hide-ifdef-set-define-alist) - (define-key hide-ifdef-mode-submap "U" 'hide-ifdef-use-define-alist) - - (define-key hide-ifdef-mode-submap "h" 'hide-ifdefs) - (define-key hide-ifdef-mode-submap "s" 'show-ifdefs) - (define-key hide-ifdef-mode-submap "\C-d" 'hide-ifdef-block) - (define-key hide-ifdef-mode-submap "\C-s" 'show-ifdef-block) - - (define-key hide-ifdef-mode-submap "\C-q" 'hide-ifdef-toggle-read-only) -;;(let ((where (where-is-internal 'toggle-read-only '(keymap) t))) -;; XEmacs change - (let ((where (where-is-internal 'toggle-read-only nil t))) - (if where - (define-key hide-ifdef-mode-submap - where - 'hide-ifdef-toggle-outside-read-only))) - ) - -;; Set up the mode's main map, which leads via the prefix key to the submap. -(if hide-ifdef-mode-map - () - (setq hide-ifdef-mode-map (make-sparse-keymap)) - (define-key hide-ifdef-mode-map hide-ifdef-mode-prefix-key - hide-ifdef-mode-submap)) - -(defvar hide-ifdef-mode nil - "Non-nil when hide-ifdef-mode is activated.") - -(defvar hide-ifdef-hiding nil - "Non-nil when text may be hidden.") - -(or (assq 'hide-ifdef-hiding minor-mode-alist) - (setq minor-mode-alist - (cons '(hide-ifdef-hiding " Hiding") - minor-mode-alist))) - -;(or (assq 'hide-ifdef-mode minor-mode-alist) -; (setq minor-mode-alist -; (cons '(hide-ifdef-mode " Ifdef") -; minor-mode-alist))) -;; XEmacs: do it right. -;;;###autoload -(add-minor-mode 'hide-ifdef-mode " Ifdef" hide-ifdef-mode-map) - -;; fix c-mode syntax table so we can recognize whole symbols. -(defvar hide-ifdef-syntax-table - (copy-syntax-table c-mode-syntax-table) - "Syntax table used for tokenizing #if expressions.") - -(modify-syntax-entry ?_ "w" hide-ifdef-syntax-table) -(modify-syntax-entry ?& "." hide-ifdef-syntax-table) -(modify-syntax-entry ?\| "." hide-ifdef-syntax-table) - -(defvar hide-ifdef-env nil - "An alist of defined symbols and their values.") - -(defvar hif-outside-read-only nil - "Internal variable. Saves the value of `buffer-read-only' while hiding.") - -;;;###autoload -(defun hide-ifdef-mode (arg) - "Toggle Hide-Ifdef mode. This is a minor mode, albeit a large one. -With ARG, turn Hide-Ifdef mode on if arg is positive, off otherwise. -In Hide-Ifdef mode, code within #ifdef constructs that the C preprocessor -would eliminate may be hidden from view. Several variables affect -how the hiding is done: - -hide-ifdef-env - An association list of defined and undefined symbols for the - current buffer. Initially, the global value of `hide-ifdef-env' - is used. - -hide-ifdef-define-alist - An association list of defined symbol lists. - Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env' - and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env' - from one of the lists in `hide-ifdef-define-alist'. - -hide-ifdef-lines - Set to non-nil to not show #if, #ifdef, #ifndef, #else, and - #endif lines when hiding. - -hide-ifdef-initially - Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode - is activated. - -hide-ifdef-read-only - Set to non-nil if you want to make buffers read only while hiding. - After `show-ifdefs', read-only status is restored to previous value. - -\\{hide-ifdef-mode-map}" - - (interactive "P") - (make-local-variable 'hide-ifdef-mode) - (setq hide-ifdef-mode - (if (null arg) - (not hide-ifdef-mode) - (> (prefix-numeric-value arg) 0))) - - ;; XEmacs change - (redraw-modeline) - - (if hide-ifdef-mode - (progn - ; inherit global values - (make-local-variable 'hide-ifdef-env) - (setq hide-ifdef-env (default-value 'hide-ifdef-env)) - - (make-local-variable 'hide-ifdef-hiding) - (setq hide-ifdef-hiding (default-value 'hide-ifdef-hiding)) - - (make-local-variable 'hif-outside-read-only) - (setq hif-outside-read-only buffer-read-only) - - (run-hooks 'hide-ifdef-mode-hook) - - (if hide-ifdef-initially - (hide-ifdefs) - (show-ifdefs)) - (message "Enter Hide-Ifdef mode") - ) - ; else end hide-ifdef-mode - (if hide-ifdef-hiding - (show-ifdefs)) - (message "Exit Hide-Ifdef mode") - )) - - -;; from outline.el with docstring fixed. -(defun hif-outline-flag-region (from to flag) - "Hides or shows lines from FROM to TO, according to FLAG. -If FLAG is \\n (newline character) then text is shown, while if FLAG is \\^M -\(control-M) the text is hidden." - (let ((modp (buffer-modified-p))) - (unwind-protect (progn - (subst-char-in-region from to - (if (= flag ?\n) ?\^M ?\n) - flag t) ) - (set-buffer-modified-p modp)) - )) - -(defun hif-show-all () - "Show all of the text in the current buffer." - (interactive) - (hif-outline-flag-region (point-min) (point-max) ?\n)) - -;; By putting this on after-revert-hook, we arrange that it only -;; does anything when revert-buffer avoids turning off the mode. -;; (That can happen in VC.) -(defun hif-before-revert-function () - (and hide-ifdef-mode hide-ifdef-hiding - (hide-ifdefs t))) -(add-hook 'after-revert-hook 'hif-before-revert-function) - -(defun hide-ifdef-region (start end) - "START is the start of a #if or #else form. END is the ending part. -Everything including these lines is made invisible." - (hif-outline-flag-region start end ?\^M) - ) - -(defun hif-show-ifdef-region (start end) - "Everything between START and END is made visible." - (hif-outline-flag-region start end ?\n) - ) - - - -;===%%SF%% evaluation (Start) === - -;; It is not useful to set this to anything but `eval'. -;; In fact, the variable might as well be eliminated. -(defvar hide-ifdef-evaluator 'eval - "The function to use to evaluate a form. -The evaluator is given a canonical form and returns t if text under -that form should be displayed.") - -(defvar hif-undefined-symbol nil - "...is by default considered to be false.") - - -(defun hif-set-var (var value) - "Prepend (var value) pair to hide-ifdef-env." - (setq hide-ifdef-env (cons (cons var value) hide-ifdef-env))) - - -(defun hif-lookup (var) -; (message "hif-lookup %s" var) - (let ((val (assoc var hide-ifdef-env))) - (if val - (cdr val) - hif-undefined-symbol))) - -(defun hif-defined (var) - (hif-lookup var) - ; when #if expressions are fully supported, defined result should be 1 - ; (if (assoc var hide-ifdef-env) - ; 1 - ; nil) -) - - -;===%%SF%% evaluation (End) === - - - -;===%%SF%% parsing (Start) === -;;; The code that understands what ifs and ifdef in files look like. - -(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*") -(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) -(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+")) -(defconst hif-else-regexp (concat hif-cpp-prefix "else")) -(defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) -(defconst hif-ifx-else-endif-regexp - (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp)) - -; Used to store the current token and the whole token list during parsing. -; Only bound dynamically. -(defvar hif-token) -(defvar hif-token-list) - -(defun hif-infix-to-prefix (token-list) - "Convert list of tokens in infix into prefix list" -; (message "hif-infix-to-prefix: %s" token-list) - (if (= 1 (length token-list)) - (` (hif-lookup (quote (, (car token-list))))) - (hif-parse-if-exp token-list)) - ) - -; pattern to match initial identifier, !, &&, ||, (, or ). -; Added ==, + and -: garyo@avs.com 8/9/94 -(defconst hif-token-regexp "^\\(&&\\|||\\|[!=]=\\|!\\|[()+-]\\|[<>]=?\\|\\w+\\)") -(defconst hif-end-of-comment "\\*/") - - -(defun hif-tokenize (expr-string) - "Separate string into a list of tokens" - (let ((token-list nil) - (expr-start 0) - (expr-length (length expr-string)) - (current-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table hide-ifdef-syntax-table) - (while (< expr-start expr-length) -; (message "expr-start = %d" expr-start) (sit-for 1) - (cond - ((string-match "^[ \t]+" expr-string expr-start) - ;; skip whitespace - (setq expr-start (match-end 0)) - ;; stick newline in string so ^ matches on the next string-match - (aset expr-string (1- expr-start) ?\n)) - - ((string-match "^/\\*" expr-string expr-start) - (setq expr-start (match-end 0)) - (aset expr-string (1- expr-start) ?\n) - (or - (string-match hif-end-of-comment - expr-string expr-start) ; eat comment - (string-match "$" expr-string expr-start)) ; multi-line comment - (setq expr-start (match-end 0)) - (aset expr-string (1- expr-start) ?\n)) - - ((string-match "^//" expr-string expr-start) - (string-match "$" expr-string expr-start) - (setq expr-start (match-end 0))) - - ((string-match hif-token-regexp expr-string expr-start) - (let ((token (substring expr-string expr-start (match-end 0)))) - (setq expr-start (match-end 0)) - (aset expr-string (1- expr-start) ?\n) -; (message "token: %s" token) (sit-for 1) - (setq token-list - (cons - (cond - ((string-equal token "||") 'or) - ((string-equal token "&&") 'and) - ((string-equal token "==") 'equal) - ((string-equal token "!=") 'hif-notequal) - ((string-equal token "!") 'not) - ((string-equal token "defined") 'hif-defined) - ((string-equal token "(") 'lparen) - ((string-equal token ")") 'rparen) - ((string-equal token ">") 'hif-greater) - ((string-equal token "<") 'hif-less) - ((string-equal token ">=") 'hif-greater-equal) - ((string-equal token "<=") 'hif-less-equal) - ((string-equal token "+") 'hif-plus) - ((string-equal token "-") 'hif-minus) - (t (intern token))) - token-list)))) - (t (error "Bad #if expression: %s" expr-string))))) - (set-syntax-table current-syntax-table)) - (nreverse token-list))) - -;;;----------------------------------------------------------------- -;;; Translate C preprocessor #if expressions using recursive descent. -;;; This parser is limited to the operators &&, ||, !, and "defined". -;;; Added ==, !=, +, and -. Gary Oberbrunner, garyo@avs.com, 8/9/94 - -(defun hif-parse-if-exp (hif-token-list) - "Parse the TOKEN-LIST. Return translated list in prefix form." - (hif-nexttoken) - (prog1 - (hif-expr) - (if hif-token ; is there still a token? - (error "Error: unexpected token: %s" hif-token)))) - -(defun hif-nexttoken () - "Pop the next token from token-list into the let variable \"hif-token\"." - (setq hif-token (car hif-token-list)) - (setq hif-token-list (cdr hif-token-list)) - hif-token) - -(defun hif-expr () - "Parse an expression as found in #if. - expr : term | expr '||' term." - (let ((result (hif-term))) - (while (eq hif-token 'or) - (hif-nexttoken) - (setq result (list 'or result (hif-term)))) - result)) - -(defun hif-term () - "Parse a term : eq-expr | term '&&' eq-expr." - (let ((result (hif-eq-expr))) - (while (eq hif-token 'and) - (hif-nexttoken) - (setq result (list 'and result (hif-eq-expr)))) - result)) - -(defun hif-eq-expr () - "Parse an eq-expr : math | eq-expr `=='|`!='|`<'|`>'|`>='|`<=' math." - (let ((result (hif-math)) - (eq-token nil)) - (while (memq hif-token '(equal hif-notequal hif-greater hif-less - hif-greater-equal hif-less-equal)) - (setq eq-token hif-token) - (hif-nexttoken) - (setq result (list eq-token result (hif-math)))) - result)) - -(defun hif-math () - "Parse an expression with + or - and simpler things. - math : factor | math '+|-' factor." - (let ((result (hif-factor)) - (math-op nil)) - (while (or (eq hif-token 'hif-plus) (eq hif-token 'hif-minus)) - (setq math-op hif-token) - (hif-nexttoken) - (setq result (list math-op result (hif-factor)))) - result)) - -(defun hif-factor () - "Parse a factor: '!' factor | '(' expr ')' | 'defined(' id ')' | id." - (cond - ((eq hif-token 'not) - (hif-nexttoken) - (list 'not (hif-factor))) - - ((eq hif-token 'lparen) - (hif-nexttoken) - (let ((result (hif-expr))) - (if (not (eq hif-token 'rparen)) - (error "Bad token in parenthesized expression: %s" hif-token) - (hif-nexttoken) - result))) - - ((eq hif-token 'hif-defined) - (hif-nexttoken) - (if (not (eq hif-token 'lparen)) - (error "Error: expected \"(\" after \"defined\"")) - (hif-nexttoken) - (let ((ident hif-token)) - (if (memq hif-token '(or and not hif-defined lparen rparen)) - (error "Error: unexpected token: %s" hif-token)) - (hif-nexttoken) - (if (not (eq hif-token 'rparen)) - (error "Error: expected \")\" after identifier")) - (hif-nexttoken) - (` (hif-defined (quote (, ident)))) - )) - - (t ; identifier - (let ((ident hif-token)) - (if (memq ident '(or and)) - (error "Error: missing identifier")) - (hif-nexttoken) - (` (hif-lookup (quote (, ident)))) - )) - )) - -(defun hif-mathify (val) - "Treat VAL as a number: if it's t or nil, use 1 or 0." - (cond ((eq val t) - 1) - ((null val) - 0) - (t val))) - -(defun hif-plus (a b) - "Like ordinary plus but treat t and nil as 1 and 0." - (+ (hif-mathify a) (hif-mathify b))) -(defun hif-minus (a b) - "Like ordinary minus but treat t and nil as 1 and 0." - (- (hif-mathify a) (hif-mathify b))) -(defun hif-notequal (a b) - "Like (not (equal A B)) but as one symbol." - (not (equal a b))) -(defun hif-greater (a b) - "Simple comparison." - (> (hif-mathify a) (hif-mathify b))) -(defun hif-less (a b) - "Simple comparison." - (< (hif-mathify a) (hif-mathify b))) -(defun hif-greater-equal (a b) - "Simple comparison." - (>= (hif-mathify a) (hif-mathify b))) -(defun hif-less-equal (a b) - "Simple comparison." - (<= (hif-mathify a) (hif-mathify b))) -;;;----------- end of parser ----------------------- - - -(defun hif-canonicalize () - "When at beginning of #ifX, returns a Lisp expression for its condition." - (save-excursion - (let ((negate (looking-at hif-ifndef-regexp))) - (re-search-forward hif-ifx-regexp) - (let* ((expr-string - (buffer-substring (point) - (progn (skip-chars-forward "^\n\r") (point)))) - (expr (hif-infix-to-prefix (hif-tokenize expr-string)))) -; (message "hif-canonicalized: %s" expr) - (if negate - (list 'not expr) - expr))))) - - -(defun hif-find-any-ifX () - "Move to next #if..., or #ifndef, at point or after." -; (message "find ifX at %d" (point)) - (prog1 - (re-search-forward hif-ifx-regexp (point-max) t) - (beginning-of-line))) - - -(defun hif-find-next-relevant () - "Move to next #if..., #else, or #endif, after the current line." -; (message "hif-find-next-relevant at %d" (point)) - (end-of-line) - ; avoid infinite recursion by only going to beginning of line if match found - (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t) - (beginning-of-line))) - -(defun hif-find-previous-relevant () - "Move to previous #if..., #else, or #endif, before the current line." -; (message "hif-find-previous-relevant at %d" (point)) - (beginning-of-line) - ; avoid infinite recursion by only going to beginning of line if match found - (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t) - (beginning-of-line))) - - -(defun hif-looking-at-ifX () ;; Should eventually see #if - (looking-at hif-ifx-regexp)) -(defun hif-looking-at-endif () - (looking-at hif-endif-regexp)) -(defun hif-looking-at-else () - (looking-at hif-else-regexp)) - - - -(defun hif-ifdef-to-endif () - "If positioned at #ifX or #else form, skip to corresponding #endif." -; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1) - (hif-find-next-relevant) - (cond ((hif-looking-at-ifX) - (hif-ifdef-to-endif) ; find endif of nested if - (hif-ifdef-to-endif)) ; find outer endif or else - ((hif-looking-at-else) - (hif-ifdef-to-endif)) ; find endif following else - ((hif-looking-at-endif) - 'done) - (t - (error "Mismatched #ifdef #endif pair")))) - - -(defun hif-endif-to-ifdef () - "If positioned at #endif form, skip backward to corresponding #ifX." -; (message "hif-endif-to-ifdef at %d" (point)) - (let ((start (point))) - (hif-find-previous-relevant) - (if (= start (point)) - (error "Mismatched #ifdef #endif pair"))) - (cond ((hif-looking-at-endif) - (hif-endif-to-ifdef) ; find beginning of nested if - (hif-endif-to-ifdef)) ; find beginning of outer if or else - ((hif-looking-at-else) - (hif-endif-to-ifdef)) - ((hif-looking-at-ifX) - 'done) - (t))) ; never gets here - - -(defun forward-ifdef (&optional arg) - "Move point to beginning of line of the next ifdef-endif. -With argument, do this that many times." - (interactive "p") - (or arg (setq arg 1)) - (if (< arg 0) - (backward-ifdef (- arg))) - (while (< 0 arg) - (setq arg (- arg)) - (let ((start (point))) - (if (not (hif-looking-at-ifX)) - (hif-find-next-relevant)) - (if (hif-looking-at-ifX) - (hif-ifdef-to-endif) - (goto-char start) - (error "No following #ifdef") - )))) - - -(defun backward-ifdef (&optional arg) - "Move point to beginning of the previous ifdef-endif. -With argument, do this that many times." - (interactive "p") - (or arg (setq arg 1)) - (if (< arg 0) - (forward-ifdef (- arg))) - (while (< 0 arg) - (setq arg (1- arg)) - (beginning-of-line) - (let ((start (point))) - (if (not (hif-looking-at-endif)) - (hif-find-previous-relevant)) - (if (hif-looking-at-endif) - (hif-endif-to-ifdef) - (goto-char start) - (error "No previous #ifdef"))))) - - -(defun down-ifdef () - "Move point to beginning of nested ifdef or else-part." - (interactive) - (let ((start (point))) - (hif-find-next-relevant) - (if (or (hif-looking-at-ifX) (hif-looking-at-else)) - () - (goto-char start) - (error "No following #ifdef")))) - - -(defun up-ifdef () - "Move point to beginning of enclosing ifdef or else-part." - (interactive) - (beginning-of-line) - (let ((start (point))) - (if (not (hif-looking-at-endif)) - (hif-find-previous-relevant)) - (if (hif-looking-at-endif) - (hif-endif-to-ifdef)) - (if (= start (point)) - (error "No previous #ifdef")))) - -(defun next-ifdef (&optional arg) - "Move to the beginning of the next #ifX, #else, or #endif. -With argument, do this that many times." - (interactive "p") - (or arg (setq arg 1)) - (if (< arg 0) - (previous-ifdef (- arg))) - (while (< 0 arg) - (setq arg (1- arg)) - (hif-find-next-relevant) - (if (eolp) - (progn - (beginning-of-line) - (error "No following #ifdefs, #elses, or #endifs"))))) - -(defun previous-ifdef (&optional arg) - "Move to the beginning of the previous #ifX, #else, or #endif. -With argument, do this that many times." - (interactive "p") - (or arg (setq arg 1)) - (if (< arg 0) - (next-ifdef (- arg))) - (while (< 0 arg) - (setq arg (1- arg)) - (let ((start (point))) - (hif-find-previous-relevant) - (if (= start (point)) - (error "No previous #ifdefs, #elses, or #endifs") - )))) - - -;===%%SF%% parsing (End) === - - -;===%%SF%% hide-ifdef-hiding (Start) === - - -;;; A range is a structure with four components: -;;; ELSE-P True if there was an else clause for the ifdef. -;;; START The start of the range. (beginning of line) -;;; ELSE The else marker (beginning of line) -;;; Only valid if ELSE-P is true. -;;; END The end of the range. (beginning of line) - -(defun hif-make-range (else-p start end &optional else) - (list else-p start else end)) - -(defun hif-range-else-p (range) (elt range 0)) -(defun hif-range-start (range) (elt range 1)) -(defun hif-range-else (range) (elt range 2)) -(defun hif-range-end (range) (elt range 3)) - - - -;;; Find-Range -;;; The workhorse, it delimits the #if region. Reasonably simple: -;;; Skip until an #else or #endif is found, remembering positions. If -;;; an #else was found, skip some more, looking for the true #endif. - -(defun hif-find-range () - "Returns a Range structure describing the current #if region. -Point is left unchanged." -; (message "hif-find-range at %d" (point)) - (save-excursion - (beginning-of-line) - (let ((start (point)) - (else-p nil) - (else nil) - (end nil)) - ;; Part one. Look for either #endif or #else. - ;; This loop-and-a-half dedicated to E. Dijkstra. - (hif-find-next-relevant) - (while (hif-looking-at-ifX) ; Skip nested ifdef - (hif-ifdef-to-endif) - (hif-find-next-relevant)) - ;; Found either a #else or an #endif. - (cond ((hif-looking-at-else) - (setq else-p t) - (setq else (point))) - (t - (setq end (point)) ; (save-excursion (end-of-line) (point)) - )) - ;; If found #else, look for #endif. - (if else-p - (progn - (hif-find-next-relevant) - (while (hif-looking-at-ifX) ; Skip nested ifdef - (hif-ifdef-to-endif) - (hif-find-next-relevant)) - (if (hif-looking-at-else) - (error "Found two elses in a row? Broken!")) - (setq end (point)) ; (save-excursion (end-of-line) (point)) - )) - (hif-make-range else-p start end else)))) - - -;;; A bit slimy. -;;; NOTE: If there's an #ifdef at the beginning of the file, we can't -;;; hide it. There's no previous newline to replace. If we added -;;; one, we'd throw off all the counts. Feh. - -(defun hif-hide-line (point) - "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." - (if hide-ifdef-lines - (save-excursion - (goto-char point) - (let ((modp (buffer-modified-p))) - (unwind-protect - (progn - (beginning-of-line) - (if (not (= (point) 1)) - (hide-ifdef-region (1- (point)) (point)))) - (set-buffer-modified-p modp)) - )) - )) - - -;;; Hif-Possibly-Hide -;;; There are four cases. The #ifX expression is "taken" if it -;;; the hide-ifdef-evaluator returns T. Presumably, this means the code -;;; inside the #ifdef would be included when the program was -;;; compiled. -;;; -;;; Case 1: #ifX taken, and there's an #else. -;;; The #else part must be hidden. The #if (then) part must be -;;; processed for nested #ifX's. -;;; Case 2: #ifX taken, and there's no #else. -;;; The #if part must be processed for nested #ifX's. -;;; Case 3: #ifX not taken, and there's an #else. -;;; The #if part must be hidden. The #else part must be processed -;;; for nested #ifs. -;;; Case 4: #ifX not taken, and there's no #else. -;;; The #ifX part must be hidden. -;;; -;;; Further processing is done by narrowing to the relevant region -;;; and just recursively calling hide-ifdef-guts. -;;; -;;; When hif-possibly-hide returns, point is at the end of the -;;; possibly-hidden range. - -(defun hif-recurse-on (start end) - "Call `hide-ifdef-guts' after narrowing to end of START line and END line." - (save-excursion - (save-restriction - (goto-char start) - (end-of-line) - (narrow-to-region (point) end) - (hide-ifdef-guts)))) - -(defun hif-possibly-hide () - "Called at #ifX expression, this hides those parts that should be hidden. -It uses the judgment of `hide-ifdef-evaluator'." -; (message "hif-possibly-hide") (sit-for 1) - (let ((test (hif-canonicalize)) - (range (hif-find-range))) -; (message "test = %s" test) (sit-for 1) - - (hif-hide-line (hif-range-end range)) - (if (funcall hide-ifdef-evaluator test) - (cond ((hif-range-else-p range) ; case 1 - (hif-hide-line (hif-range-else range)) - (hide-ifdef-region (hif-range-else range) - (1- (hif-range-end range))) - (hif-recurse-on (hif-range-start range) - (hif-range-else range))) - (t ; case 2 - (hif-recurse-on (hif-range-start range) - (hif-range-end range)))) - (cond ((hif-range-else-p range) ; case 3 - (hif-hide-line (hif-range-else range)) - (hide-ifdef-region (hif-range-start range) - (1- (hif-range-else range))) - (hif-recurse-on (hif-range-else range) - (hif-range-end range))) - (t ; case 4 - (hide-ifdef-region (point) - (1- (hif-range-end range)))) - )) - (hif-hide-line (hif-range-start range)) ; Always hide start. - (goto-char (hif-range-end range)) - (end-of-line) - )) - - - -(defun hide-ifdef-guts () - "Does most of the work of `hide-ifdefs'. -It does not do the work that's pointless to redo on a recursive entry." -; (message "hide-ifdef-guts") - (save-excursion - (goto-char (point-min)) - (while (hif-find-any-ifX) - (hif-possibly-hide)))) - -;===%%SF%% hide-ifdef-hiding (End) === - - -;===%%SF%% exports (Start) === - -;;;###autoload -(defcustom hide-ifdef-initially nil - "*Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated." - :type 'boolean - :group 'hide-ifdef) - -;;;###autoload -(defcustom hide-ifdef-read-only nil - "*Set to non-nil if you want buffer to be read-only while hiding text." - :type 'boolean - :group 'hide-ifdef) - -;;;###autoload -(defcustom hide-ifdef-lines nil - "*Non-nil means hide the #ifX, #else, and #endif lines." - :type 'boolean - :group 'hide-ifdef) - -(defun hide-ifdef-toggle-read-only () - "Toggle hide-ifdef-read-only." - (interactive) - (setq hide-ifdef-read-only (not hide-ifdef-read-only)) - (message "Hide-Read-Only %s" - (if hide-ifdef-read-only "ON" "OFF")) - (if hide-ifdef-hiding - (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) - ;; XEmacs change - (redraw-modeline)) - -(defun hide-ifdef-toggle-outside-read-only () - "Replacement for `toggle-read-only' within Hide-Ifdef mode." - (interactive) - (setq hif-outside-read-only (not hif-outside-read-only)) - (message "Read only %s" - (if hif-outside-read-only "ON" "OFF")) - (setq buffer-read-only - (or (and hide-ifdef-hiding hide-ifdef-read-only) - hif-outside-read-only) - ) - ;; XEmacs change - (redraw-modeline)) - - -(defun hide-ifdef-define (var) - "Define a VAR so that #ifdef VAR would be included." - (interactive "SDefine what? ") - (hif-set-var var 1) - (if hide-ifdef-hiding (hide-ifdefs))) - -(defun hide-ifdef-undef (var) - "Undefine a VAR so that #ifdef VAR would not be included." - (interactive "SUndefine what? ") - (hif-set-var var nil) - (if hide-ifdef-hiding (hide-ifdefs))) - - -(defun hide-ifdefs (&optional nomsg) - "Hide the contents of some #ifdefs. -Assume that defined symbols have been added to `hide-ifdef-env'. -The text hidden is the text that would not be included by the C -preprocessor if it were given the file with those symbols defined. - -Turn off hiding by calling `show-ifdefs'." - - (interactive) - (message "Hiding...") - (setq hif-outside-read-only buffer-read-only) - (if (not hide-ifdef-mode) - (hide-ifdef-mode 1)) ; turn on hide-ifdef-mode - (if hide-ifdef-hiding - (show-ifdefs)) ; Otherwise, deep confusion. - (let ((inhibit-read-only t)) - (setq selective-display t) - (setq hide-ifdef-hiding t) - (hide-ifdef-guts)) - (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)) - (or nomsg - (message "Hiding done"))) - - -(defun show-ifdefs () - "Cancel the effects of `hide-ifdef': show the contents of all #ifdefs." - (interactive) - (setq buffer-read-only hif-outside-read-only) - (setq selective-display nil) ; defaults - (let ((inhibit-read-only t)) - (hif-show-all)) - (setq hide-ifdef-hiding nil)) - - -(defun hif-find-ifdef-block () - "Utility for hide and show `ifdef-block'. -Return as (TOP . BOTTOM) the extent of ifdef block." - (let (max-bottom) - (cons (save-excursion - (beginning-of-line) - (if (not (or (hif-looking-at-else) (hif-looking-at-ifX))) - (up-ifdef)) - (prog1 (point) - (hif-ifdef-to-endif) - (setq max-bottom (1- (point))))) - (save-excursion - (beginning-of-line) - (if (not (hif-looking-at-endif)) - (hif-find-next-relevant)) - (while (hif-looking-at-ifX) - (hif-ifdef-to-endif) - (hif-find-next-relevant)) - (min max-bottom (1- (point))))))) - - -(defun hide-ifdef-block () - "Hide the ifdef block (true or false part) enclosing or before the cursor." - (interactive) - (if (not hide-ifdef-mode) - (hide-ifdef-mode 1)) - (setq selective-display t) - (let ((top-bottom (hif-find-ifdef-block)) - (inhibit-read-only t)) - (hide-ifdef-region (car top-bottom) (cdr top-bottom)) - (if hide-ifdef-lines - (progn - (hif-hide-line (car top-bottom)) - (hif-hide-line (1+ (cdr top-bottom))))) - (setq hide-ifdef-hiding t)) - (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))) - - -(defun show-ifdef-block () - "Show the ifdef block (true or false part) enclosing or before the cursor." - (interactive) - (let ((inhibit-read-only t)) - (if hide-ifdef-lines - (save-excursion - (beginning-of-line) - (hif-show-ifdef-region (1- (point)) (progn (end-of-line) (point)))) - - (let ((top-bottom (hif-find-ifdef-block))) - (hif-show-ifdef-region (1- (car top-bottom)) (cdr top-bottom)))))) - - -;;; definition alist support - -(defvar hide-ifdef-define-alist nil - "A global assoc list of pre-defined symbol lists") - -(defun hif-compress-define-list (env) - "Compress the define list ENV into a list of defined symbols only." - (let ((defs (mapcar '(lambda (arg) - (if (hif-lookup (car arg)) (car arg))) - env)) - (new-defs nil)) - (while defs - (if (car defs) - (setq new-defs (cons (car defs) new-defs))) - (setq defs (cdr defs))) - new-defs)) - -(defun hide-ifdef-set-define-alist (name) - "Set the association for NAME to `hide-ifdef-env'." - (interactive "SSet define list: ") - (setq hide-ifdef-define-alist - (cons (cons name (hif-compress-define-list hide-ifdef-env)) - hide-ifdef-define-alist))) - -(defun hide-ifdef-use-define-alist (name) - "Set `hide-ifdef-env' to the define list specified by NAME." - (interactive "SUse define list: ") - (let ((define-list (assoc name hide-ifdef-define-alist))) - (if define-list - (setq hide-ifdef-env - (mapcar '(lambda (arg) (cons arg t)) - (cdr define-list))) - (error "No define list for %s" name)) - (if hide-ifdef-hiding (hide-ifdefs)))) - -(provide 'hideif) - -;;; hideif.el ends here diff --git a/xemacs-packages/lisp/c-support/hideshow.el b/xemacs-packages/lisp/c-support/hideshow.el deleted file mode 100644 index e3f6745c..00000000 --- a/xemacs-packages/lisp/c-support/hideshow.el +++ /dev/null @@ -1,933 +0,0 @@ -;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks - -;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01 Free Software Foundation - -;; Author: Thien-Thi Nguyen -;; Dan Nicolaescu -;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines -;; Maintainer-Version: 5.31 -;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning -;; -;; XEmacs port by Jerry James -;; This port consists almost entirely of substituting extent manipulations for -;; overlay manipulations. - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; * Commands provided -;; -;; This file provides Hideshow Minor Mode. When active, nine commands -;; are available, implementing block hiding and showing. They (and their -;; keybindings) are: -;; -;; hs-hide-block C-c @ C-h -;; hs-show-block C-c @ C-s -;; hs-hide-all C-c @ C-M-h -;; hs-show-all C-c @ C-M-s -;; hs-hide-level C-c @ C-l -;; hs-toggle-hiding C-c @ C-c -;; hs-mouse-toggle-hiding [(shift mouse-2)] -;; hs-hide-initial-comment-block -;; -;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they -;; are simply text between curly braces, while in Lisp-ish modes parens -;; are used. Multi-line comment blocks can also be hidden. Read-only -;; buffers are not a problem, since hideshow doesn't modify the text. -;; -;; The command `M-x hs-minor-mode' toggles the minor mode or sets it -;; (similar to other minor modes). - -;; * Suggested usage -;; -;; First make sure hideshow.el is in a directory in your `load-path'. -;; You can optionally byte-compile it using `M-x byte-compile-file'. -;; Then, add the following to your ~/.emacs: -;; -;; (load-library "hideshow") -;; (add-hook 'X-mode-hook ; other modes similarly -;; '(lambda () (hs-minor-mode 1))) -;; -;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle -;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is -;; activated or deactivated, `hs-minor-mode-hook' is run w/ `run-hooks'. -;; -;; Additionally, Joseph Eydelnant writes: -;; I enjoy your package hideshow.el Ver. 5.24 2001/02/13 -;; a lot and I've been looking for the following functionality: -;; toggle hide/show all with a single key. -;; Here are a few lines of code that lets me do just that. -;; -;; (defvar my-hs-hide nil "Current state of hideshow for toggling all.") -;; ;;;###autoload -;; (defun my-toggle-hideshow-all () "Toggle hideshow all." -;; (interactive) -;; (setq my-hs-hide (not my-hs-hide)) -;; (if my-hs-hide -;; (hs-hide-all) -;; (hs-show-all))) -;; -;; [Your hideshow hacks here!] - -;; * Customization -;; -;; You can use `M-x customize-variable' on the following variables: -;; -;; - hs-hide-comments-when-hiding-all -- self-explanatory! -;; - hs-hide-all-non-comment-function -- if non-nil, when doing a -;; `hs-hide-all', this function -;; is called w/ no arguments -;; - hs-isearch-open -- what kind of hidden blocks to -;; open when doing isearch -;; -;; Some languages (e.g., Java) are deeply nested, so the normal behavior -;; of `hs-hide-all' (hiding all but top-level blocks) results in very -;; little information shown, which is not very useful. You can use the -;; variable `hs-hide-all-non-comment-function' to implement your idea of -;; what is more useful. For example, the following code shows the next -;; nested level in addition to the top-level: -;; -;; (defun ttn-hs-hide-level-1 () -;; (hs-hide-level 1) -;; (forward-sexp 1)) -;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1) -;; -;; Hideshow works w/ incremental search (isearch) by setting the variable -;; `hs-headline', which is the line of text at the beginning of a hidden -;; block that contains a match for the search. You can have this show up -;; in the mode line by modifying the variable `mode-line-format'. For -;; example, the following code prepends this info to the mode line: -;; -;; (unless (memq 'hs-headline mode-line-format) -;; (setq mode-line-format -;; (append '("-" hs-headline) mode-line-format))) -;; -;; See documentation for `mode-line-format' for more info. -;; -;; Hooks are run after some commands: -;; -;; hs-hide-hook in hs-hide-block, hs-hide-all, hs-hide-level -;; hs-show-hook hs-show-block, hs-show-all -;; -;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling -;; commands when the result of the toggle is to hide or show blocks, -;; respectively. All hooks are run w/ `run-hooks'. See docs for each -;; variable or hook for more info. -;; -;; Normally, hideshow tries to determine appropriate values for block -;; and comment definitions by examining the buffer's major mode. If -;; there are problems, hideshow will not activate and in that case you -;; may wish to override hideshow's heuristics by adding an entry to -;; variable `hs-special-modes-alist'. Packages that use hideshow should -;; do something like: -;; -;; (let ((my-mode-hs-info '(my-mode "{{" "}}" ...))) -;; (if (not (member my-mode-hs-info hs-special-modes-alist)) -;; (setq hs-special-modes-alist -;; (cons my-mode-hs-info hs-special-modes-alist)))) -;; -;; If you have an entry that works particularly well, consider -;; submitting it for inclusion in hideshow.el. See docstring for -;; `hs-special-modes-alist' for more info on the entry format. - -;; * Bugs -;; -;; (1) Hideshow does not work w/ emacs 18 because emacs 18 lacks the -;; function `forward-comment' (among other things). If someone -;; writes this, please send me a copy. -;; -;; (2) Sometimes `hs-headline' can become out of sync. To reset, type -;; `M-x hs-minor-mode' twice (that is, deactivate then re-activate -;; hideshow). -;; -;; (3) Hideshow 5.x is developed and tested on GNU Emacs 20.7. -;; XEmacs compatibility may have bitrotted since 4.29. -;; [Jerry says: XEmacs compatibility is back! Give it a try.] -;; -;; (4) Some buffers can't be `byte-compile-file'd properly. This is because -;; `byte-compile-file' inserts the file to be compiled in a temporary -;; buffer and switches `normal-mode' on. In the case where you have -;; `hs-hide-initial-comment-block' in `hs-minor-mode-hook', the hiding of -;; the initial comment sometimes hides parts of the first statement (seems -;; to be only in `normal-mode'), so there are unbalanced "(" and ")". -;; -;; The workaround is to clear `hs-minor-mode-hook' when byte-compiling: -;; -;; (defadvice byte-compile-file (around -;; byte-compile-file-hideshow-off -;; act) -;; (let ((hs-minor-mode-hook nil)) -;; ad-do-it)) -;; -;; (5) Hideshow interacts badly with Ediff and `vc-diff'. At the moment, the -;; suggested workaround is to turn off hideshow entirely, for example: -;; -;; (defun turn-off-hideshow () (hs-minor-mode -1)) -;; (add-hook 'ediff-prepare-buffer-hook 'turn-off-hideshow) -;; (add-hook 'vc-before-checkin-hook 'turn-off-hideshow) -;; -;; In the case of `vc-diff', here is a less invasive workaround: -;; -;; (add-hook 'vc-before-checkin-hook -;; '(lambda () -;; (goto-char (point-min)) -;; (hs-show-block))) -;; -;; Unfortunately, these workarounds do not restore hideshow state. -;; If someone figures out a better way, please let me know. - -;; * Correspondance -;; -;; Correspondance welcome; please indicate version number. Send bug -;; reports and inquiries to . -;; If the bug appears to be XEmacs-specific, use M-x report-emacs-bug instead. - -;; * Thanks -;; -;; Thanks go to the following people for valuable ideas, code and -;; bug reports. -;; -;; Dean Andrews, Alf-Ivar Holm, Holger Bauer, Christoph Conrad, Dave -;; Love, Dirk Herrmann, Gael Marziou, Jan Djarv, Guillaume Leray, -;; Moody Ahmad, Preston F. Crow, Lars Lindberg, Reto Zimmermann, -;; Keith Sheffield, Chew Meng Kuan, Tony Lam, Pete Ware, François -;; Pinard, Stefan Monnier, Joseph Eydelnant -;; -;; Special thanks go to Dan Nicolaescu, who reimplemented hideshow using -;; overlays (rather than selective display), added isearch magic, folded -;; in custom.el compatibility, generalized comment handling, incorporated -;; mouse support, and maintained the code in general. Version 4.0 is -;; largely due to his efforts. - -;; * History -;; -;; Hideshow was inspired when I learned about selective display. It was -;; reimplemented to use overlays for 4.0 (see above). WRT older history, -;; entries in the masterfile corresponding to versions 1.x and 2.x have -;; been lost. XEmacs support is reliable as of 4.29. State save and -;; restore was added in 3.5 (not widely distributed), and reliable as of -;; 4.30. Otherwise, the code seems stable. Passes checkdoc as of 4.32. -;; Version 5.x uses new algorithms for block selection and traversal, -;; unbundles state save and restore, and includes more isearch support. - -;;; Code: - -(require 'easymenu) - -;;--------------------------------------------------------------------------- -;; user-configurable variables - -(defgroup hideshow nil - "Minor mode for hiding and showing program and comment blocks." - :prefix "hs-" - :group 'languages) - -;;;###autoload -(defcustom hs-hide-comments-when-hiding-all t - "*Hide the comments too when you do an `hs-hide-all'." - :type 'boolean - :group 'hideshow) - -(defcustom hs-minor-mode-hook nil - "*Hook called when hideshow minor mode is activated or deactivated." - :type 'hook - :group 'hideshow - :version "21.1") - -(defcustom hs-isearch-open 'code - "*What kind of hidden blocks to open when doing `isearch'. -One of the following symbols: - - code -- open only code blocks - comment -- open only comment blocks - t -- open both code and comment blocks - nil -- open neither code nor comment blocks - -This has effect iff `search-invisible' is set to `open'." - :type '(choice (const :tag "open only code blocks" code) - (const :tag "open only comment blocks" comment) - (const :tag "open both code and comment blocks" t) - (const :tag "don't open any of them" nil)) - :group 'hideshow) - -;;;###autoload -(defvar hs-special-modes-alist - '((c-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) - (c++-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) - (bibtex-mode ("^@\\S(*\\(\\s(\\)" 1)) - (java-mode "{" "}" "/[*/]" nil hs-c-like-adjust-block-beginning) - ) - "*Alist for initializing the hideshow variables for different modes. -Each element has the form - (MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC). - -If non-nil, hideshow will use these values as regexps to define blocks -and comments, respectively for major mode MODE. - -START, END and COMMENT-START are regular expressions. A block is -defined as text surrounded by START and END. - -As a special case, START may be a list of the form (COMPLEX-START -MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and -MDATA-SELECTOR an integer that specifies which sub-match is the proper -place to adjust point, before calling `hs-forward-sexp-func'. For -example, see the `hs-special-modes-alist' entry for `bibtex-mode'. - -For some major modes, `forward-sexp' does not work properly. In those -cases, FORWARD-SEXP-FUNC specifies another function to use instead. - -See the documentation for `hs-adjust-block-beginning' to see what is the -use of ADJUST-BEG-FUNC. - -If any of the elements is left nil or omitted, hideshow tries to guess -appropriate values. The regexps should not contain leading or trailing -whitespace. Case does not matter.") - -(defvar hs-hide-all-non-comment-function nil - "*Function called if non-nil when doing `hs-hide-all' for non-comments.") - -(defvar hs-hide-hook nil - "*Hook called (with `run-hooks') at the end of commands to hide text. -These commands include the toggling commands (when the result is to hide -a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.") - -(defvar hs-show-hook nil - "*Hook called (with `run-hooks') at the end of commands to show text. -These commands include the toggling commands (when the result is to show -a block), `hs-show-all' and `hs-show-block'..") - -;;--------------------------------------------------------------------------- -;; internal variables - -(defvar hs-minor-mode nil - "Non-nil if using hideshow mode as a minor mode of some other mode. -Use the command `hs-minor-mode' to toggle or set this variable.") - -(defvar hs-minor-mode-map nil - "Keymap for hideshow minor mode.") - -(defvar hs-minor-mode-menu nil - "Menu for hideshow minor mode.") - -(defvar hs-c-start-regexp nil - "Regexp for beginning of comments. -Differs from mode-specific comment regexps in that -surrounding whitespace is stripped.") - -(defvar hs-block-start-regexp nil - "Regexp for beginning of block.") - -(defvar hs-block-start-mdata-select nil - "Element in `hs-block-start-regexp' match data to consider as block start. -The internal function `hs-forward-sexp' moves point to the beginning of this -element (using `match-beginning') before calling `hs-forward-sexp-func'.") - -(defvar hs-block-end-regexp nil - "Regexp for end of block.") - -(defvar hs-forward-sexp-func 'forward-sexp - "Function used to do a `forward-sexp'. -Should change for Algol-ish modes. For single-character block -delimiters -- ie, the syntax table regexp for the character is -either `(' or `)' -- `hs-forward-sexp-func' would just be -`forward-sexp'. For other modes such as simula, a more specialized -function is necessary.") - -(defvar hs-adjust-block-beginning nil - "Function used to tweak the block beginning. -The block is hidden from the position returned by this function, -as opposed to hiding it from the position returned when searching -for `hs-block-start-regexp'. - -For example, in c-like modes, if we wish to also hide the curly braces -(if you think they occupy too much space on the screen), this function -should return the starting point (at the end of line) of the hidden -region. - -It is called with a single argument ARG which is the the position in -buffer after the block beginning. - -It should return the position from where we should start hiding. - -It should not move the point. - -See `hs-c-like-adjust-block-beginning' for an example of using this.") - -(defvar hs-headline nil - "Text of the line where a hidden block begins, set during isearch. -You can display this in the mode line by adding the symbol `hs-headline' -to the variable `mode-line-format'. For example, - - (unless (memq 'hs-headline mode-line-format) - (setq mode-line-format - (append '(\"-\" hs-headline) mode-line-format))) - -Note that `mode-line-format' is buffer-local.") - -;;--------------------------------------------------------------------------- -;; system dependency - -;; XEmacs and emacs-19 compatibility -(if (not (fboundp 'add-to-invisibility-spec)) - (defun add-to-invisibility-spec (arg) - "Add elements to `buffer-invisibility-spec'. -See documentation for `buffer-invisibility-spec' for the kind of elements -that can be added." - (if (eq buffer-invisibility-spec t) - (setq buffer-invisibility-spec (list t))) - (setq buffer-invisibility-spec - (cons arg buffer-invisibility-spec)))) - -(if (not (fboundp 'remove-from-invisibility-spec)) - (defun remove-from-invisibility-spec (arg) - "Remove elements from `buffer-invisibility-spec'." - (if (consp buffer-invisibility-spec) - (setq buffer-invisibility-spec - (delete arg buffer-invisibility-spec))))) - -;; hs-match-data -(defalias 'hs-match-data 'match-data) - -;;--------------------------------------------------------------------------- -;; support functions - -(defun hs-discard-extents (from to) - "Delete hideshow extents in region defined by FROM and TO." - (when (< to from) - (setq from (prog1 to (setq to from)))) - (map-extents #'(lambda (ex ignored) (delete-extent ex)) - (current-buffer) from to nil 'end-closed 'hs)) - -(defun hs-isearch-show (ex) - "Delete extent EX, and set `hs-headline' to nil. - -This function is meant to be used as the `isearch-open-invisible' -property of an extent." - (setq hs-headline nil) - (delete-extent ex)) - -(defun hs-isearch-show-temporary (ex hide-p) - "Hide or show extent EX, and set `hs-headline', all depending on HIDE-P. -If HIDE-P is non-nil, `hs-headline' is set to nil and extent EX is hidden. -Otherwise, `hs-headline' is set to the line of text at the head of EX, and -EX is shown. - -This function is meant to be used as the `isearch-open-invisible-temporary' -property of an extent." - (setq hs-headline - (if hide-p - nil - (or hs-headline - (let ((start (extent-start-position ex))) - (buffer-substring - (save-excursion (goto-char start) - (beginning-of-line) - (skip-chars-forward " \t") - (point)) - start))))) - (force-mode-line-update) - (set-extent-property ex 'invisible (and hide-p 'hs))) - -(defun hs-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 non-nil the text is -hidden. FLAG must be one of the symbols `code' or `comment', depending -on what kind of block is to be hidden." - (when (< to from) - (setq from (prog1 to (setq to from)))) - (save-excursion - ;; first clear it all out - (hs-discard-extents from to) - ;; now create extents if needed - (when flag - (let ((ex (make-extent from to))) - (set-extent-property ex 'invisible 'hs) - (set-extent-property ex 'hs flag) - (when (or (eq hs-isearch-open t) - (eq hs-isearch-open flag) - ;; deprecated backward compatibility -- `block'<=>`code' - (and (eq 'block hs-isearch-open) - (eq 'code flag))) - (set-extent-property ex 'isearch-open-invisible 'hs-isearch-show) - (set-extent-property ex 'isearch-open-invisible-temporary - 'hs-isearch-show-temporary)) - ex)))) - -(defun hs-forward-sexp (match-data arg) - "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG. -Original match data is restored upon return." - (save-match-data - (set-match-data match-data) - (goto-char (match-beginning hs-block-start-mdata-select)) - (funcall hs-forward-sexp-func arg))) - -(defun hs-hide-comment-region (beg end &optional repos-end) - "Hide a region from BEG to END, marking it as a comment. -Optional arg REPOS-END means reposition at end." - (hs-flag-region (progn (goto-char beg) (end-of-line) (point)) - (progn (goto-char end) (end-of-line) (point)) - 'comment) - (goto-char (if repos-end end beg))) - -(defun hs-hide-block-at-point (&optional end comment-reg) - "Hide block iff on block beginning. -Optional arg END means reposition at end. -Optional arg COMMENT-REG is a list of the form (BEGIN END) and -specifies the limits of the comment, or nil if the block is not -a comment. - -The block beginning is adjusted by `hs-adjust-block-beginning' -and then further adjusted to be at the end of the line." - (if comment-reg - (hs-hide-comment-region (car comment-reg) (cadr comment-reg) end) - (if (looking-at hs-block-start-regexp) - (let* ((mdata (hs-match-data t)) - (pure-p (match-end 0)) - (p - ;; `p' is the point at the end of the block beginning, - ;; which may need to be adjusted - (save-excursion - (goto-char (funcall (or hs-adjust-block-beginning - 'identity) - pure-p)) - ;; whatever the adjustment, we move to eol - (end-of-line) - (point))) - (q - ;; `q' is the point at the end of the block - (progn (hs-forward-sexp mdata 1) - (end-of-line) - (point)))) - (if (and (< p (point)) (> (count-lines p q) 1)) - (set-extent-property (hs-flag-region p q 'code) - 'hs-ofs - (- pure-p p))) - (goto-char (if end q (min p pure-p))))))) - -(defun hs-safety-is-job-n () - "Warn if `buffer-invisibility-spec' does not contain symbol `hs'." - (unless (and (listp buffer-invisibility-spec) - (assq 'hs buffer-invisibility-spec)) - (message "Warning: `buffer-invisibility-spec' does not contain hs!!") - (sit-for 2))) - -(defun hs-inside-comment-p () - "Return non-nil if point is inside a comment, otherwise nil. -Actually, return a list containing the buffer position of the start -and the end of the comment. A comment block can be hidden only if on -its starting line there is only whitespace preceding the actual comment -beginning. If we are inside of a comment but this condition is not met, -we return a list having a nil as its car and the end of comment position -as cdr." - (save-excursion - ;; the idea is to look backwards for a comment start regexp, do a - ;; forward comment, and see if we are inside, then extend extend - ;; forward and backward as long as we have comments - (let ((q (point))) - (when (or (looking-at hs-c-start-regexp) - (re-search-backward hs-c-start-regexp (point-min) t)) - (forward-comment (- (buffer-size))) - (skip-chars-forward " \t\n\f") - (let ((p (point)) - (not-hidable nil)) - (beginning-of-line) - (unless (looking-at (concat "[ \t]*" hs-c-start-regexp)) - ;; we are in this situation: (example) - ;; (defun bar () - ;; (foo) - ;; ) ; comment - ;; ^ - ;; the point was here before doing (beginning-of-line) - ;; here we should advance till the next comment which - ;; eventually has only white spaces preceding it on the same - ;; line - (goto-char p) - (forward-comment 1) - (skip-chars-forward " \t\n\f") - (setq p (point)) - (while (and (< (point) q) - (> (point) p) - (not (looking-at hs-c-start-regexp))) - (setq p (point));; use this to avoid an infinite cycle - (forward-comment 1) - (skip-chars-forward " \t\n\f")) - (if (or (not (looking-at hs-c-start-regexp)) - (> (point) q)) - ;; we cannot hide this comment block - (setq not-hidable t))) - ;; goto the end of the comment - (forward-comment (buffer-size)) - (skip-chars-backward " \t\n\f") - (end-of-line) - (if (>= (point) q) - (list (if not-hidable nil p) (point)))))))) - -(defun hs-grok-mode-type () - "Set up hideshow variables for new buffers. -If `hs-special-modes-alist' has information associated with the -current buffer's major mode, use that. -Otherwise, guess start, end and `comment-start' regexps; `forward-sexp' -function; and adjust-block-beginning function." - (if (and (boundp 'comment-start) - (boundp 'comment-end) - comment-start comment-end) - (let* ((lookup (assoc major-mode hs-special-modes-alist)) - (start-elem (or (nth 1 lookup) "\\s("))) - (if (listp start-elem) - ;; handle (START-REGEXP MDATA-SELECT) - (setq hs-block-start-regexp (car start-elem) - hs-block-start-mdata-select (cadr start-elem)) - ;; backwards compatibility: handle simple START-REGEXP - (setq hs-block-start-regexp start-elem - hs-block-start-mdata-select 0)) - (setq hs-block-end-regexp (or (nth 2 lookup) "\\s)") - hs-c-start-regexp (or (nth 3 lookup) - (let ((c-start-regexp - (regexp-quote comment-start))) - (if (string-match " +$" c-start-regexp) - (substring c-start-regexp - 0 (1- (match-end 0))) - c-start-regexp))) - hs-forward-sexp-func (or (nth 4 lookup) 'forward-sexp) - hs-adjust-block-beginning (nth 5 lookup))) - (progn - (setq hs-minor-mode nil) - (error "%s Mode doesn't support Hideshow Minor Mode" mode-name)))) - -(defun hs-find-block-beginning () - "Reposition point at block-start. -Return point, or nil if original point was not in a block." - (let ((done nil) - (here (point))) - ;; look if current line is block start - (if (looking-at hs-block-start-regexp) - (point) - ;; look backward for the start of a block that contains the cursor - (while (and (re-search-backward hs-block-start-regexp nil t) - (not (setq done - (< here (save-excursion - (hs-forward-sexp (hs-match-data t) 1) - (point))))))) - (if done - (point) - (goto-char here) - nil)))) - -(defun hs-hide-level-recursive (arg minp maxp) - "Recursively hide blocks ARG levels below point in region (MINP MAXP)." - (when (hs-find-block-beginning) - (setq minp (1+ (point))) - (funcall hs-forward-sexp-func 1) - (setq maxp (1- (point)))) - (hs-flag-region minp maxp nil) ; eliminate weirdness - (goto-char minp) - (while (progn - (forward-comment (buffer-size)) - (and (< (point) maxp) - (re-search-forward hs-block-start-regexp maxp t))) - (if (> arg 1) - (hs-hide-level-recursive (1- arg) minp maxp) - (goto-char (match-beginning hs-block-start-mdata-select)) - (hs-hide-block-at-point t))) - (hs-safety-is-job-n) - (goto-char maxp)) - -(defmacro hs-life-goes-on (&rest body) - "Evaluate BODY forms iff variable `hs-minor-mode' is non-nil. -In the dynamic context of this macro `case-fold-search' is t." - `(when hs-minor-mode - (let ((case-fold-search t)) - ,@body))) - -(put 'hs-life-goes-on 'edebug-form-spec '(&rest form)) - -(defun hs-already-hidden-p () - "Return non-nil if point is in an already-hidden block, otherwise nil." - (save-excursion - (let ((c-reg (hs-inside-comment-p))) - (if (and c-reg (nth 0 c-reg)) - ;; point is inside a comment, and that comment is hidable - (goto-char (nth 0 c-reg)) - (if (and (not c-reg) - (hs-find-block-beginning) - (looking-at hs-block-start-regexp)) - ;; point is inside a block - (goto-char (match-end 0))))) - (end-of-line) - (extent-at (point) (current-buffer) 'hs nil 'at))) - -(defun hs-c-like-adjust-block-beginning (initial) - "Adjust INITIAL, the buffer position after `hs-block-start-regexp'. -Actually, point is never moved; a new position is returned that is -the end of the C-function header. This adjustment function is meant -to be assigned to `hs-adjust-block-beginning' for C-like modes." - (save-excursion - (goto-char (1- initial)) - (forward-comment (- (buffer-size))) - (point))) - -;;--------------------------------------------------------------------------- -;; commands - -(defun hs-hide-all () - "Hide all top level blocks, displaying only first and last lines. -Move point to the beginning of the line, and run the normal hook -`hs-hide-hook'. See documentation for `run-hooks'. -If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." - (interactive) - (hs-life-goes-on - (message "Hiding all blocks ...") - (save-excursion - (hs-flag-region (point-min) (point-max) nil) ; eliminate weirdness - (goto-char (point-min)) - (let ((count 0) - (re (concat "\\(" - hs-block-start-regexp - "\\)" - (if hs-hide-comments-when-hiding-all - (concat "\\|\\(" - hs-c-start-regexp - "\\)") - "")))) - (while (progn - (unless hs-hide-comments-when-hiding-all - (forward-comment (point-max))) - (re-search-forward re (point-max) t)) - (if (match-beginning 1) - ;; we have found a block beginning - (progn - (goto-char (match-beginning 1)) - (if hs-hide-all-non-comment-function - (funcall hs-hide-all-non-comment-function) - (hs-hide-block-at-point t))) - ;; found a comment, probably - (let ((c-reg (hs-inside-comment-p))) ; blech! - (when (and c-reg (car c-reg)) - (if (> (count-lines (car c-reg) (nth 1 c-reg)) 1) - (hs-hide-block-at-point t c-reg) - (goto-char (nth 1 c-reg)))))) - (message "Hiding ... %d" (setq count (1+ count))))) - (hs-safety-is-job-n)) - (beginning-of-line) - (message "Hiding all blocks ... done") - (run-hooks 'hs-hide-hook))) - -(defun hs-show-all () - "Show everything then run `hs-show-hook'. See `run-hooks'." - (interactive) - (hs-life-goes-on - (message "Showing all blocks ...") - (hs-flag-region (point-min) (point-max) nil) - (message "Showing all blocks ... done") - (run-hooks 'hs-show-hook))) - -(defun hs-hide-block (&optional end) - "Select a block and hide it. With prefix arg, reposition at END. -Upon completion, point is repositioned and the normal hook -`hs-hide-hook' is run. See documentation for `run-hooks'." - (interactive "P") - (hs-life-goes-on - (let ((c-reg (hs-inside-comment-p))) - (cond - ((and c-reg (or (null (nth 0 c-reg)) - (<= (count-lines (car c-reg) (nth 1 c-reg)) 1))) - (message "(not enough comment lines to hide)")) - ((or c-reg - (looking-at hs-block-start-regexp) - (hs-find-block-beginning)) - (hs-hide-block-at-point end c-reg) - (hs-safety-is-job-n) - (run-hooks 'hs-hide-hook)))))) - -(defun hs-show-block (&optional end) - "Select a block and show it. -With prefix arg, reposition at END. Upon completion, point is -repositioned and the normal hook `hs-show-hook' is run. -See documentation for functions `hs-hide-block' and `run-hooks'." - (interactive "P") - (hs-life-goes-on - (or - ;; first see if we have something at the end of the line - (let* ((here (point)) - (buf (current-buffer)) - (ex (extent-at (point-at-eol nil buf) buf 'hs nil 'at))) - (when ex - (goto-char - (cond (end (extent-end-position ex)) - ((eq 'comment (extent-property ex 'hs)) here) - (t (+ (extent-start-position ex) - (extent-property ex 'hs-ofs))))) - (delete-extent ex) - t)) - ;; not immediately obvious, look for a suitable block - (let ((c-reg (hs-inside-comment-p)) - p q) - (cond (c-reg - (when (car c-reg) - (setq p (car c-reg) - q (cadr c-reg)))) - ((and (hs-find-block-beginning) - (looking-at hs-block-start-regexp)) ; fresh match-data, ugh - (setq p (point) - q (progn (hs-forward-sexp (hs-match-data t) 1) (point))))) - (when (and p q) - (hs-flag-region p q nil) - (goto-char (if end q (1+ p))))) - (hs-safety-is-job-n) - (run-hooks 'hs-show-hook)))) - -(defun hs-hide-level (arg) - "Hide all blocks ARG levels below this block. -The hook `hs-hide-hook' is run; see `run-hooks'." - (interactive "p") - (hs-life-goes-on - (save-excursion - (message "Hiding blocks ...") - (hs-hide-level-recursive arg (point-min) (point-max)) - (message "Hiding blocks ... done")) - (hs-safety-is-job-n) - (run-hooks 'hs-hide-hook))) - -(defun hs-toggle-hiding () - "Toggle hiding/showing of a block. -See `hs-hide-block' and `hs-show-block'." - (interactive) - (hs-life-goes-on - (if (hs-already-hidden-p) - (hs-show-block) - (hs-hide-block)))) - -(defun hs-mouse-toggle-hiding (e) - "Toggle hiding/showing of a block. -This command should be bound to a mouse key. -Argument E is a mouse event used by `mouse-set-point'. -See `hs-hide-block' and `hs-show-block'." - (interactive "@e") - (hs-life-goes-on - (mouse-set-point e) - (hs-toggle-hiding))) - -(defun hs-hide-initial-comment-block () - "Hide the first block of comments in a file. -This can be useful if you have huge RCS logs in those comments." - (interactive) - (hs-life-goes-on - (let ((c-reg (save-excursion - (goto-char (point-min)) - (skip-chars-forward " \t\n\f") - (hs-inside-comment-p)))) - (when c-reg - (let ((beg (car c-reg)) (end (cadr c-reg))) - ;; see if we have enough comment lines to hide - (when (> (count-lines beg end) 1) - (hs-hide-comment-region beg end))))))) - -;;;###autoload -(defun hs-minor-mode (&optional arg) - "Toggle hideshow minor mode. -With ARG, turn hideshow minor mode on if ARG is positive, off otherwise. -When hideshow minor mode is on, the menu bar is augmented with hideshow -commands and the hideshow commands are enabled. -The value '(hs . t) is added to `buffer-invisibility-spec'. - -The main commands are: `hs-hide-all', `hs-show-all', `hs-hide-block', -`hs-show-block', `hs-hide-level' and `hs-toggle-hiding'. There is also -`hs-hide-initial-comment-block' and `hs-mouse-toggle-hiding'. - -Turning hideshow minor mode off reverts the menu bar and the -variables to default values and disables the hideshow commands. - -Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'. - -Key bindings: -\\{hs-minor-mode-map}" - - (interactive "P") - (setq hs-headline nil - hs-minor-mode (if (null arg) - (not hs-minor-mode) - (> (prefix-numeric-value arg) 0))) - (if hs-minor-mode - (progn - (hs-grok-mode-type) - (easy-menu-add hs-minor-mode-menu) - (set (make-local-variable 'line-move-ignore-invisible) t) - (add-to-invisibility-spec '(hs . t))) - (easy-menu-remove hs-minor-mode-menu) - (remove-from-invisibility-spec '(hs . t))) - (run-hooks 'hs-minor-mode-hook)) - -;;--------------------------------------------------------------------------- -;; load-time actions - -;; keymaps and menus -(if hs-minor-mode-map - nil - (setq hs-minor-mode-map (make-sparse-keymap)) - (easy-menu-define hs-minor-mode-menu - hs-minor-mode-map - "Menu used when hideshow minor mode is active." - (cons "Hide/Show" - (mapcar - ;; Interpret each table entry as follows: first, populate keymap - ;; with elements 2 and 1; then, for easymenu, use entry directly - ;; unless element 0 is nil, in which case the entry is "omitted". - (lambda (ent) - (define-key hs-minor-mode-map (aref ent 2) (aref ent 1)) - (if (aref ent 0) ent "-----")) - ;; These bindings roughly imitate those used by Outline mode. - ;; menu entry command key - '(["Hide Block" hs-hide-block "\C-c@\C-h"] - ["Show Block" hs-show-block "\C-c@\C-s"] - ["Hide All" hs-hide-all "\C-c@\C-\M-h"] - ["Show All" hs-show-all "\C-c@\C-\M-s"] - ["Hide Level" hs-hide-level "\C-c@\C-l"] - ["Toggle Hiding" hs-toggle-hiding "\C-c@\C-c"] - [nil hs-mouse-toggle-hiding [(shift mouse-2)]] - ))))) - -;; some housekeeping -(or (assq 'hs-minor-mode minor-mode-map-alist) - (setq minor-mode-map-alist - (cons (cons 'hs-minor-mode hs-minor-mode-map) - minor-mode-map-alist))) -(or (assq 'hs-minor-mode minor-mode-alist) - (setq minor-mode-alist (append minor-mode-alist - (list '(hs-minor-mode " hs"))))) - -;; make some variables permanently buffer-local -(let ((vars '(hs-minor-mode - hs-c-start-regexp - hs-block-start-regexp - hs-block-start-mdata-select - hs-block-end-regexp - hs-forward-sexp-func - hs-adjust-block-beginning))) - (while vars - (let ((var (car vars))) - (make-variable-buffer-local var) - (put var 'permanent-local t)) - (setq vars (cdr vars)))) - -;;--------------------------------------------------------------------------- -;; that's it - -(provide 'hideshow) - -;;; hideshow.el ends here diff --git a/xemacs-packages/lisp/ecrypto/ChangeLog b/xemacs-packages/lisp/ecrypto/ChangeLog deleted file mode 100644 index 5bc5fa73..00000000 --- a/xemacs-packages/lisp/ecrypto/ChangeLog +++ /dev/null @@ -1,243 +0,0 @@ -2005-09-26 Norbert Koch - - * Makefile (VERSION): XEmacs package 0.20 released. - -2005-05-30 Reiner Steib - - * encrypt.el (encrypt-xor-process-buffer): Replace `string-to-int' - by `string-to-number'. - -2005-05-17 Katsumi Yamaoka - - * encrypt.el (encrypt): Add :group. - -2005-02-22 Simon Josefsson - - * encrypt.el (encrypt-password-cache-expiry): Remove (use - `password-cache-expiry' instead). Reported by Arne Jørgensen - . - (encrypt): Add password-cache and password-cache-expiry as group - members. - -2004-01-05 Simon Josefsson - - * md4.el (print-int32, print-string-hexa): Remove. Suggested by - Jesper Harder . - -2004-11-30 Norbert Koch - - * Makefile (VERSION): XEmacs package 0.19 released. - -2004-11-29 Simon Josefsson - - * encrypt.el: New file. - - * Makefile (ELCS): Add encrypt.elc. - -2004-09-16 Norbert Koch - - * Makefile (VERSION): XEmacs package 0.18 released. - -2004-09-16 Simon Josefsson - - * hex-util.el: Add arch-tag cookie. - -2004-09-12 Simon Josefsson - - * sha1-dl.el: Removed. - -2004-09-12 Simon Josefsson - - * sha1-el.el, password.el: Gnus CVS sync changes for the the - following ChangeLog entries, until 2004-02-09 below. - -2004-09-01 Simon Josefsson - - * sha1-el.el: Renamed to sha1.el. - -2004-08-04 Teodor Zlatanov - - * password.el: add comments on using password-read-and-add - (password-read-and-add): new function to read and add the - password to the cache at once - -2004-03-05 Jesper Harder - - * sha1-el.el (sha1-maximum-internal-length): Doc fix. - -2004-03-04 Katsumi Yamaoka - - * password.el: Don't autoload run-at-time for Emacs. - - * sha1-el.el: Don't autoload executable-find. - -2004-01-07 Katsumi Yamaoka - - * sha1-el.el (sha1-string-external): Use with-temp-buffer. - -2004-01-07 Katsumi Yamaoka - - * sha1-el.el (sha1-string-external): Make it can return a string - in binary form. - (sha1-region-external): Ditto. - (sha1-string-internal): Ditto. - (sha1-region-internal): Ditto. - (sha1-region): Ditto. - (sha1-string): Ditto. - (sha1): Ditto. - -2004-02-09 Norbert Koch - - * Makefile (VERSION): XEmacs package 0.17 released. - -2004-02-06 Simon Josefsson - - * sha1-el.el: Gnus CVS sync changes for the the following - ChangeLog entries, until 2004-01-07 below, suggested by Steve - Youngs . - -2004-01-07 Katsumi Yamaoka - - * sha1-el.el (sha1-string-external): Use with-temp-buffer. - -2004-01-07 Katsumi Yamaoka - - * sha1-el.el (sha1-string-external): Make it can return a string - in binary form. - (sha1-region-external): Ditto. - (sha1-string-internal): Ditto. - (sha1-region-internal): Ditto. - (sha1-region): Ditto. - (sha1-string): Ditto. - (sha1): Ditto. - -2004-01-17 Norbert Koch - - * Makefile (VERSION): XEmacs package 0.16 released. - -2004-01-16 Simon Josefsson - - * password.el: Add. - - * Makefile (REQUIRES): Add xemacs-base. - (ELCS): Add password.el. - -2003-12-16 Norbert Koch - - * Makefile (VERSION): XEmacs package 0.15 released. - -2003-12-15 Simon Josefsson - - * hex-util.el, sha1-el.el: Gnus CVS sync changes for the following - ChangeLog entries, until 2001-12-29 below. - -2003-12-16 Simon Josefsson - - * sha1-el.el (autoload): Don't use ignore-errors. - (sha1-use-external): Use condition-case. Suggested by Katsumi - Yamaoka . - -2003-12-15 Simon Josefsson - - * sha1-el.el (autoload): Ignore errors for - executable-find. (XEmacs ecrypto does not require sh-script where - executable.el is located.) - (sha1-use-external): Likewise. - - * sha1-el.el (sha1): Add defgroup. - (sha1-maximum-internal-length, sha1-program, sha1-use-external) - (sha1-program): Use 'sha1sum' from GNU CoreUtils instead of OpenSSL. - (sha1): Autoload. - -2002-02-20 Katsumi Yamaoka - - * hex-util.el: Remove trailing whitespaces, replace spc+tab with - tab, replace leading whitespaces with tabs. - -2001-12-29 ShengHuo ZHU - - * sha1-el.el (sha1-use-external): New variable. - (sha1-region): Use it. - (sha1-string): Ditto. - -2003-10-31 Norbert Koch - - * Makefile (VERSION): XEmacs package 0.14 released. - -2003-06-22 Norbert Koch - - * Makefile (VERSION): XEmacs package 0.13 released. - -2003-06-21 Simon Josefsson - - * blowfish.el (blowfish-add, blowfish-f, blowfish-s-box-inits) - (blowfish-p-array-inits): Use #xCAFE instead of ?\xCAFE, suggested - by "Stephen J. Turnbull" and reported by - sigurd@12move.de (Karl Pflästerer). - -2003-03-09 Ben Wing - - * Makefile: - Delete explicit compile:: and binkit: rules. - -2002-11-29 Ben Wing - - * .cvsignore: Remove files now handled automatically by CVS. - * Makefile: Use `compile' instead of hard-coded `all'. - -2002-10-15 Ville Skyttä - - * Makefile (srckit): Remove. - -2002-09-25 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 0.12 released. - -2002-09-17 Ville Skyttä - - * md5-el.el (md5-update): Comment typo fix. - -2002-08-12 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 0.11 released. - -2002-08-07 Ville Skyttä - - * Package moved to official location in xemacs-packages. - -2002-08-02 Simon Josefsson - - * hex-util.el: New file. - - * package-info.in: Fix package name, fix provides. - - * sha1-el.el (sha1): autoload. - - * md5-el.el (md5): autoload. - (md5-program, md5-maximum-internal-length): defcustom. - - * md4.el (md4): autoload. - - * sha1.el, sha1-el.el, sha1-dl.el, md5.el, md5-el.el, md5-dl.el: - Replace with versions from FLIM. Supports emacsen that can load - dynamic libraries, otherwise should be equal. - - * Makefile (PACKAGE): Fix package name. - (ELCS): Add md4.elc md5.elc md5-el.elc md5-dl.elc sha1.elc - sha1-el.elc sha1-dl.elc hex-util.elc. - -2002-08-01 Ville Skyttä - - * .cvsignore: New. - - * Makefile: Fix path to XEmacs.rules. - (CATEGORY): Change to unsupported. - - * package-info.in (distribution): Change to unsupported. - -2002-06-13 Simon Josefsson - - * ecrypto: New package, from Ecrypto2.0.tgz (29436 bytes, MD5 - 01e74632426b429b9468158ad52ef973) from - http://web.mit.edu/thouis/www/ecrypto.html written by Ray Jones - . diff --git a/xemacs-packages/lisp/ecrypto/_pkg.el b/xemacs-packages/lisp/ecrypto/_pkg.el deleted file mode 100644 index 635f477f..00000000 --- a/xemacs-packages/lisp/ecrypto/_pkg.el +++ /dev/null @@ -1,5 +0,0 @@ -;;;###autoload -(package-provide 'ecrypto - :version 0.20 - :author-version "2.0" - :type 'regular) diff --git a/xemacs-packages/lisp/ecrypto/ascii-armor.el b/xemacs-packages/lisp/ecrypto/ascii-armor.el deleted file mode 100644 index 93028589..00000000 --- a/xemacs-packages/lisp/ecrypto/ascii-armor.el +++ /dev/null @@ -1,138 +0,0 @@ -;;; ascii-armor.el -- translate data into and from ascii-armor -;;; (radix64) - -;; Copyright (C) 1998 Ray Jones - -;; Author: Ray Jones, rjones@pobox.com -;; Keywords: base64, ascii-armor, radix64, oink -;; Created: 1998-04-14 - -;; 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.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA. - -;;; Commentary: - -;;; Code: - -(require 'cl) - -(defun ascii-armor-char (val) - (cond ((< val 26) (+ val ?A)) - ((< val 52) (+ (- val 26) ?a)) - ((< val 62) (+ (- val 52) ?0)) - ((= val 62) ?+) - ((= val 63) ?/) - (t (error "no ascii-armor character for %d!" val)))) - -(defun ascii-armor-val (char) - (cond ((and (<= ?A char) (<= char ?Z)) (- char ?A)) - ((and (<= ?a char) (<= char ?z)) (+ (- char ?a) 26)) - ((and (<= ?0 char) (<= char ?9)) (+ (- char ?0) 52)) - ((= char ?+) 62) - ((= char ?/) 63) - (t nil))) - -(defun ascii-armor-length (n) - "calculate the number of characters needed to encode N octets." - - (let* ( - ;; number of bits - (n1 (* n 8)) - ;; ascii armor is 6 bits per symbol... - (n2 (car (ceiling* n1 6))) - ;; but always a multiple of 4 symbols - (n3 (* 4 (car (ceiling* n2 4))))) - n3)) - -(defun ascii-armor-data-length (str) - "calculate the number of octets stored in an ascii-armor string" - - (let ((len (length str))) - (while (and (> len 0) - (eq ?= (aref str (1- len)))) - (decf len)) - (/ (* len 6) 8))) - -;; translate a vector of 16-bit values into an ascii-armor string -(defun vec16-to-ascii-armor (vec) - (let* ((in-len (length vec)) - (out-len (ascii-armor-length (* 2 in-len))) - (out-str (make-string out-len ?=)) - (out-idx 0) - (bits-start 0)) - ;; helper function - (flet ((next-out (val) - (aset out-str out-idx - (ascii-armor-char - (logand ?\x3f val))) - (incf out-idx))) - - (dotimes (in-idx in-len) - (incf bits-start 16) - ;; read out as many bits from the current index as possible - (while (> bits-start 0) - ;; do the next 6 bits straddle a boundary in vec? - - (if (< bits-start 6) - ;; straddle - (let ((hi-val (aref vec in-idx)) - ;; pad with 0s - (lo-val (if (< in-idx (1- in-len)) - (aref vec (1+ in-idx)) - 0))) - (next-out (logior - (ash hi-val (- 6 bits-start)) - (ash lo-val (- 6 bits-start 16))))) - - ;; 6 bits all from the current entry in vec - (next-out (ash (aref vec in-idx) (- 6 bits-start)))) - - (decf bits-start 6)))) - - ;; pad with ?=, if out-str isn't full - (while (< out-idx out-len) - (aset out-str out-idx ?=) - (incf out-idx)) - - out-str)) - -;; translate an ascii-armor string to a 16-bit vector -(defun ascii-armor-to-vec16 (string) - ;; ascii armor is padded, so this doesn't have to be rounded, just - ;; truncated. - (let* ((out-len (/ (ascii-armor-data-length string) 2)) - (out-vec (make-vector out-len 0)) - (buf 0) - (bits-in-buf 0) - (in-idx 0)) - (dotimes (out-idx out-len) - ;; shift bits from the string until there are enough to stick - ;; into the output vector - (while (< bits-in-buf 16) - (let ((val (ascii-armor-val (aref string in-idx)))) - (when val - (setq buf (logior (ash buf 6) - val)) - (incf bits-in-buf 6)) - (incf in-idx))) - - (aset out-vec out-idx (ash buf (- 16 bits-in-buf))) - (decf bits-in-buf 16) - ;; turn off the used bits - (setq buf (logand buf (lognot (ash ?\xffff bits-in-buf))))) - - out-vec)) - -(provide 'ascii-armor) diff --git a/xemacs-packages/lisp/ecrypto/auto-autoloads.el b/xemacs-packages/lisp/ecrypto/auto-autoloads.el deleted file mode 100644 index 91d52e26..00000000 --- a/xemacs-packages/lisp/ecrypto/auto-autoloads.el +++ /dev/null @@ -1,49 +0,0 @@ -;;; DO NOT MODIFY THIS FILE -(if (featurep 'ecrypto-autoloads) (error "Already loaded")) - -;;;### (autoloads nil "_pkg" "ecrypto/_pkg.el") - -(package-provide 'ecrypto :version 0.2 :author-version "2.0" :type 'regular) - -;;;*** - -;;;### (autoloads (encrypt-insert-file-contents encrypt-find-model) "encrypt" "ecrypto/encrypt.el") - -(autoload 'encrypt-find-model "encrypt" "\ -Given a filename, find a encrypt-file-alist entry" nil nil) - -(autoload 'encrypt-insert-file-contents "encrypt" "\ -Decrypt FILE into the current buffer." t nil) - -;;;*** - -;;;### (autoloads (md4) "md4" "ecrypto/md4.el") - -(autoload 'md4 "md4" "\ -Returns the MD4 hash string of 16 bytes long for a string IN of N -bytes long. N is required to handle strings containing character 0." nil nil) - -;;;*** - -;;;### (autoloads (md5) "md5-el" "ecrypto/md5-el.el") - -(autoload 'md5 "md5-el" "\ -Return the MD5 (a secure message digest algorithm) of an object. -OBJECT is either a string or a buffer. -Optional arguments START and END denote buffer positions for computing the -hash of a portion of OBJECT." nil nil) - -;;;*** - -;;;### (autoloads (sha1) "sha1" "ecrypto/sha1.el") - -(autoload 'sha1 "sha1" "\ -Return the SHA1 (Secure Hash Algorithm) of an object. -OBJECT is either a string or a buffer. -Optional arguments BEG and END denote buffer positions for computing the -hash of a portion of OBJECT. -If BINARY is non-nil, return a string in binary form." nil nil) - -;;;*** - -(provide 'ecrypto-autoloads) diff --git a/xemacs-packages/lisp/ecrypto/blowfish.el b/xemacs-packages/lisp/ecrypto/blowfish.el deleted file mode 100644 index 7febd6bc..00000000 --- a/xemacs-packages/lisp/ecrypto/blowfish.el +++ /dev/null @@ -1,482 +0,0 @@ -;;; blowfish.el -- block cipher - -;; Copyright (C) 1998 Ray Jones - -;; Author: Ray Jones, rjones@pobox.com -;; Keywords: Blowfish, Schneier, oink, cipher, cypher, cryptography -;; Created: 1998-04-01 - -;; 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.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA. - -;;; Commentary: - -;; this code is Bruce Schneier's Blowfish encryption algorithm. it is -;; fast, license-free, unpatented, and beleived secure. it takes a -;; key of length 32-448 bits. it works on 64-bit blocks. further -;; information is available in Applied Cryptography by Schneier or at -;; http://www.counterpane.com/blowfish.html - -;; to use, given a key: -;; -;; (let ((subkeys (blowfish-generate-keys key)) ;; returns a pair, the -;; ;; P-array and the S-boxes -;; (data [1 2 3 4])) -;; ;; encipher data in place -;; (blowfish-cipher-block data (car subkeys) (cdr subkeys)) -;; ;; decipher in place -;; (blowfish-cipher-block data (car subkeys) (cdr subkeys) 'decrypt) -;; ;; data should now be back to its starting value -;; (assert (equal data [1 2 3 4]))) - -;; note: the time taken to generate subkeys is quite substantial, but -;; encryption and decryption afterwards is quite fast. - -;; keys are vectors of 16-bit integers, with the vector being a -;; positive, even number of elements long. - - -;;; Code: -(require 'cl) - -;; blowfish is a 64-bit algorithm, which operates on 32-bit pieces. -;; this code stores 32-bit numbers as vectors w/ 2 16-bit elements. - -;; helper functions -(defsubst blowfish-xor (a b result) - (aset result 0 (logxor (aref a 0) (aref b 0))) - (aset result 1 (logxor (aref a 1) (aref b 1))) - (assert (and (< (aref result 0) (ash 1 16)) - (< (aref result 1) (ash 1 16))) nil - "")) - -(defsubst blowfish-add (a b result) - (let* ((low (+ (aref a 1) (aref b 1))) - (high (logand (+ (aref a 0) (aref b 0) (ash low -16)) - #xFFFF))) - (aset result 0 high) - (aset result 1 (logand low #xFFFF))) - (assert (and (< (aref result 0) (ash 1 16)) - (< (aref result 1) (ash 1 16))) nil - "")) - -(defun blowfish-cipher-block (data p-array s-boxes &optional direction) - "encode or decode with the blowfish cipher, in place. -first arg is vector of 4 16-bit words (MSB order). -second arg is P-array to encrypt/decrypt with. -third arg is S-boxes to encrypt/decrypt with. -optional fourth arg is direction \(eq 'decrypt to decrypt\)." - - ;; split the data into two 32 bit pieces (stored as 2 16-bit pieces - ;; each.) - (let ((xl (vector (aref data 0) (aref data 1))) - (xr (vector (aref data 2) (aref data 3))) - (reverse (eq direction 'decrypt))) - ;; 16 rounds - (dotimes (idx 16) - ;; mix in the p-array. note the reverse order for decryption. - (let ((p-val (aref p-array (if reverse (- 17 idx) idx)))) - (blowfish-xor xl p-val xl)) - ;; apply F - (blowfish-f xl s-boxes xr) - ;; swap low and high 32 bits - (rotatef xl xr)) - - ;; undo the last swap - (rotatef xl xr) - ;; mixin last two elements of P-array - ;; (when comparing to section in AC 2nd Ed, note that this is 0 - ;; indexed, and the reverse order for decryption. - (let ((p-val-16 (aref p-array (if reverse 1 16))) - (p-val-17 (aref p-array (if reverse 0 17)))) - (blowfish-xor xl p-val-17 xl) - (blowfish-xor xr p-val-16 xr)) - - ;; put the result back into the input vector - (aset data 0 (aref xl 0)) - (aset data 1 (aref xl 1)) - (aset data 2 (aref xr 0)) - (aset data 3 (aref xr 1)) - - ;; clean up - (fillarray xl 0) - (fillarray xr 0))) - -(defvar *blowfish-f-scratch* [0 0] - "scratch area for the blowfish-f function, to reduce allocation") - -(defun blowfish-f (x s-boxes dest) - "perform the blowfish F-function. takes vector of two-16-bit -numbers and S-boxes to use as args, and the destination to xor the -result into. uses *blowfish-f-scratch* to reduce allocation." - ;; S-boxes are indexed into via 8-bit pieces of X - (let* ((x0 (aref x 0)) - (Sa (aref (aref s-boxes 0) (ash x0 -8))) - (Sb (aref (aref s-boxes 1) (logand x0 #xFF))) - (x1 (aref x 1)) - (Sc (aref (aref s-boxes 2) (ash x1 -8))) - (Sd (aref (aref s-boxes 3) (logand x1 #xFF)))) - - (blowfish-add Sa Sb *blowfish-f-scratch*) - (blowfish-xor Sc *blowfish-f-scratch* *blowfish-f-scratch*) - (blowfish-add Sd *blowfish-f-scratch* *blowfish-f-scratch*) - (blowfish-xor *blowfish-f-scratch* dest dest))) - -;; initialization constants for the P-array and S-boxes - -(defconst blowfish-s-box-inits - [ - [ - [#xd131 #x0ba6] [#x98df #xb5ac] [#x2ffd #x72db] [#xd01a #xdfb7] - [#xb8e1 #xafed] [#x6a26 #x7e96] [#xba7c #x9045] [#xf12c #x7f99] - [#x24a1 #x9947] [#xb391 #x6cf7] [#x0801 #xf2e2] [#x858e #xfc16] - [#x6369 #x20d8] [#x7157 #x4e69] [#xa458 #xfea3] [#xf493 #x3d7e] - [#x0d95 #x748f] [#x728e #xb658] [#x718b #xcd58] [#x8215 #x4aee] - [#x7b54 #xa41d] [#xc25a #x59b5] [#x9c30 #xd539] [#x2af2 #x6013] - [#xc5d1 #xb023] [#x2860 #x85f0] [#xca41 #x7918] [#xb8db #x38ef] - [#x8e79 #xdcb0] [#x603a #x180e] [#x6c9e #x0e8b] [#xb01e #x8a3e] - [#xd715 #x77c1] [#xbd31 #x4b27] [#x78af #x2fda] [#x5560 #x5c60] - [#xe655 #x25f3] [#xaa55 #xab94] [#x5748 #x9862] [#x63e8 #x1440] - [#x55ca #x396a] [#x2aab #x10b6] [#xb4cc #x5c34] [#x1141 #xe8ce] - [#xa154 #x86af] [#x7c72 #xe993] [#xb3ee #x1411] [#x636f #xbc2a] - [#x2ba9 #xc55d] [#x7418 #x31f6] [#xce5c #x3e16] [#x9b87 #x931e] - [#xafd6 #xba33] [#x6c24 #xcf5c] [#x7a32 #x5381] [#x2895 #x8677] - [#x3b8f #x4898] [#x6b4b #xb9af] [#xc4bf #xe81b] [#x6628 #x2193] - [#x61d8 #x09cc] [#xfb21 #xa991] [#x487c #xac60] [#x5dec #x8032] - [#xef84 #x5d5d] [#xe985 #x75b1] [#xdc26 #x2302] [#xeb65 #x1b88] - [#x2389 #x3e81] [#xd396 #xacc5] [#x0f6d #x6ff3] [#x83f4 #x4239] - [#x2e0b #x4482] [#xa484 #x2004] [#x69c8 #xf04a] [#x9e1f #x9b5e] - [#x21c6 #x6842] [#xf6e9 #x6c9a] [#x670c #x9c61] [#xabd3 #x88f0] - [#x6a51 #xa0d2] [#xd854 #x2f68] [#x960f #xa728] [#xab51 #x33a3] - [#x6eef #x0b6c] [#x137a #x3be4] [#xba3b #xf050] [#x7efb #x2a98] - [#xa1f1 #x651d] [#x39af #x0176] [#x66ca #x593e] [#x8243 #x0e88] - [#x8cee #x8619] [#x456f #x9fb4] [#x7d84 #xa5c3] [#x3b8b #x5ebe] - [#xe06f #x75d8] [#x85c1 #x2073] [#x401a #x449f] [#x56c1 #x6aa6] - [#x4ed3 #xaa62] [#x363f #x7706] [#x1bfe #xdf72] [#x429b #x023d] - [#x37d0 #xd724] [#xd00a #x1248] [#xdb0f #xead3] [#x49f1 #xc09b] - [#x0753 #x72c9] [#x8099 #x1b7b] [#x25d4 #x79d8] [#xf6e8 #xdef7] - [#xe3fe #x501a] [#xb679 #x4c3b] [#x976c #xe0bd] [#x04c0 #x06ba] - [#xc1a9 #x4fb6] [#x409f #x60c4] [#x5e5c #x9ec2] [#x196a #x2463] - [#x68fb #x6faf] [#x3e6c #x53b5] [#x1339 #xb2eb] [#x3b52 #xec6f] - [#x6dfc #x511f] [#x9b30 #x952c] [#xcc81 #x4544] [#xaf5e #xbd09] - [#xbee3 #xd004] [#xde33 #x4afd] [#x660f #x2807] [#x192e #x4bb3] - [#xc0cb #xa857] [#x45c8 #x740f] [#xd20b #x5f39] [#xb9d3 #xfbdb] - [#x5579 #xc0bd] [#x1a60 #x320a] [#xd6a1 #x00c6] [#x402c #x7279] - [#x679f #x25fe] [#xfb1f #xa3cc] [#x8ea5 #xe9f8] [#xdb32 #x22f8] - [#x3c75 #x16df] [#xfd61 #x6b15] [#x2f50 #x1ec8] [#xad05 #x52ab] - [#x323d #xb5fa] [#xfd23 #x8760] [#x5331 #x7b48] [#x3e00 #xdf82] - [#x9e5c #x57bb] [#xca6f #x8ca0] [#x1a87 #x562e] [#xdf17 #x69db] - [#xd542 #xa8f6] [#x287e #xffc3] [#xac67 #x32c6] [#x8c4f #x5573] - [#x695b #x27b0] [#xbbca #x58c8] [#xe1ff #xa35d] [#xb8f0 #x11a0] - [#x10fa #x3d98] [#xfd21 #x83b8] [#x4afc #xb56c] [#x2dd1 #xd35b] - [#x9a53 #xe479] [#xb6f8 #x4565] [#xd28e #x49bc] [#x4bfb #x9790] - [#xe1dd #xf2da] [#xa4cb #x7e33] [#x62fb #x1341] [#xcee4 #xc6e8] - [#xef20 #xcada] [#x3677 #x4c01] [#xd07e #x9efe] [#x2bf1 #x1fb4] - [#x95db #xda4d] [#xae90 #x9198] [#xeaad #x8e71] [#x6b93 #xd5a0] - [#xd08e #xd1d0] [#xafc7 #x25e0] [#x8e3c #x5b2f] [#x8e75 #x94b7] - [#x8ff6 #xe2fb] [#xf212 #x2b64] [#x8888 #xb812] [#x900d #xf01c] - [#x4fad #x5ea0] [#x688f #xc31c] [#xd1cf #xf191] [#xb3a8 #xc1ad] - [#x2f2f #x2218] [#xbe0e #x1777] [#xea75 #x2dfe] [#x8b02 #x1fa1] - [#xe5a0 #xcc0f] [#xb56f #x74e8] [#x18ac #xf3d6] [#xce89 #xe299] - [#xb4a8 #x4fe0] [#xfd13 #xe0b7] [#x7cc4 #x3b81] [#xd2ad #xa8d9] - [#x165f #xa266] [#x8095 #x7705] [#x93cc #x7314] [#x211a #x1477] - [#xe6ad #x2065] [#x77b5 #xfa86] [#xc754 #x42f5] [#xfb9d #x35cf] - [#xebcd #xaf0c] [#x7b3e #x89a0] [#xd641 #x1bd3] [#xae1e #x7e49] - [#x0025 #x0e2d] [#x2071 #xb35e] [#x2268 #x00bb] [#x57b8 #xe0af] - [#x2464 #x369b] [#xf009 #xb91e] [#x5563 #x911d] [#x59df #xa6aa] - [#x78c1 #x4389] [#xd95a #x537f] [#x207d #x5ba2] [#x02e5 #xb9c5] - [#x8326 #x0376] [#x6295 #xcfa9] [#x11c8 #x1968] [#x4e73 #x4a41] - [#xb347 #x2dca] [#x7b14 #xa94a] [#x1b51 #x0052] [#x9a53 #x2915] - [#xd60f #x573f] [#xbc9b #xc6e4] [#x2b60 #xa476] [#x81e6 #x7400] - [#x08ba #x6fb5] [#x571b #xe91f] [#xf296 #xec6b] [#x2a0d #xd915] - [#xb663 #x6521] [#xe7b9 #xf9b6] [#xff34 #x052e] [#xc585 #x5664] - [#x53b0 #x2d5d] [#xa99f #x8fa1] [#x08ba #x4799] [#x6e85 #x076a] - ] - [ - [#x4b7a #x70e9] [#xb5b3 #x2944] [#xdb75 #x092e] [#xc419 #x2623] - [#xad6e #xa6b0] [#x49a7 #xdf7d] [#x9cee #x60b8] [#x8fed #xb266] - [#xecaa #x8c71] [#x699a #x17ff] [#x5664 #x526c] [#xc2b1 #x9ee1] - [#x1936 #x02a5] [#x7509 #x4c29] [#xa059 #x1340] [#xe418 #x3a3e] - [#x3f54 #x989a] [#x5b42 #x9d65] [#x6b8f #xe4d6] [#x99f7 #x3fd6] - [#xa1d2 #x9c07] [#xefe8 #x30f5] [#x4d2d #x38e6] [#xf025 #x5dc1] - [#x4cdd #x2086] [#x8470 #xeb26] [#x6382 #xe9c6] [#x021e #xcc5e] - [#x0968 #x6b3f] [#x3eba #xefc9] [#x3c97 #x1814] [#x6b6a #x70a1] - [#x687f #x3584] [#x52a0 #xe286] [#xb79c #x5305] [#xaa50 #x0737] - [#x3e07 #x841c] [#x7fde #xae5c] [#x8e7d #x44ec] [#x5716 #xf2b8] - [#xb03a #xda37] [#xf050 #x0c0d] [#xf01c #x1f04] [#x0200 #xb3ff] - [#xae0c #xf51a] [#x3cb5 #x74b2] [#x2583 #x7a58] [#xdc09 #x21bd] - [#xd191 #x13f9] [#x7ca9 #x2ff6] [#x9432 #x4773] [#x22f5 #x4701] - [#x3ae5 #xe581] [#x37c2 #xdadc] [#xc8b5 #x7634] [#x9af3 #xdda7] - [#xa944 #x6146] [#x0fd0 #x030e] [#xecc8 #xc73e] [#xa475 #x1e41] - [#xe238 #xcd99] [#x3bea #x0e2f] [#x3280 #xbba1] [#x183e #xb331] - [#x4e54 #x8b38] [#x4f6d #xb908] [#x6f42 #x0d03] [#xf60a #x04bf] - [#x2cb8 #x1290] [#x2497 #x7c79] [#x5679 #xb072] [#xbcaf #x89af] - [#xde9a #x771f] [#xd993 #x0810] [#xb38b #xae12] [#xdccf #x3f2e] - [#x5512 #x721f] [#x2e6b #x7124] [#x501a #xdde6] [#x9f84 #xcd87] - [#x7a58 #x4718] [#x7408 #xda17] [#xbc9f #x9abc] [#xe94b #x7d8c] - [#xec7a #xec3a] [#xdb85 #x1dfa] [#x6309 #x4366] [#xc464 #xc3d2] - [#xef1c #x1847] [#x3215 #xd908] [#xdd43 #x3b37] [#x24c2 #xba16] - [#x12a1 #x4d43] [#x2a65 #xc451] [#x5094 #x0002] [#x133a #xe4dd] - [#x71df #xf89e] [#x1031 #x4e55] [#x81ac #x77d6] [#x5f11 #x199b] - [#x0435 #x56f1] [#xd7a3 #xc76b] [#x3c11 #x183b] [#x5924 #xa509] - [#xf28f #xe6ed] [#x97f1 #xfbfa] [#x9eba #xbf2c] [#x1e15 #x3c6e] - [#x86e3 #x4570] [#xeae9 #x6fb1] [#x860e #x5e0a] [#x5a3e #x2ab3] - [#x771f #xe71c] [#x4e3d #x06fa] [#x2965 #xdcb9] [#x99e7 #x1d0f] - [#x803e #x89d6] [#x5266 #xc825] [#x2e4c #xc978] [#x9c10 #xb36a] - [#xc615 #x0eba] [#x94e2 #xea78] [#xa5fc #x3c53] [#x1e0a #x2df4] - [#xf2f7 #x4ea7] [#x361d #x2b3d] [#x1939 #x260f] [#x19c2 #x7960] - [#x5223 #xa708] [#xf713 #x12b6] [#xebad #xfe6e] [#xeac3 #x1f66] - [#xe3bc #x4595] [#xa67b #xc883] [#xb17f #x37d1] [#x018c #xff28] - [#xc332 #xddef] [#xbe6c #x5aa5] [#x6558 #x2185] [#x68ab #x9802] - [#xeece #xa50f] [#xdb2f #x953b] [#x2aef #x7dad] [#x5b6e #x2f84] - [#x1521 #xb628] [#x2907 #x6170] [#xecdd #x4775] [#x619f #x1510] - [#x13cc #xa830] [#xeb61 #xbd96] [#x0334 #xfe1e] [#xaa03 #x63cf] - [#xb573 #x5c90] [#x4c70 #xa239] [#xd59e #x9e0b] [#xcbaa #xde14] - [#xeecc #x86bc] [#x6062 #x2ca7] [#x9cab #x5cab] [#xb2f3 #x846e] - [#x648b #x1eaf] [#x19bd #xf0ca] [#xa023 #x69b9] [#x655a #xbb50] - [#x4068 #x5a32] [#x3c2a #xb4b3] [#x319e #xe9d5] [#xc021 #xb8f7] - [#x9b54 #x0b19] [#x875f #xa099] [#x95f7 #x997e] [#x623d #x7da8] - [#xf837 #x889a] [#x97e3 #x2d77] [#x11ed #x935f] [#x1668 #x1281] - [#x0e35 #x8829] [#xc7e6 #x1fd6] [#x96de #xdfa1] [#x7858 #xba99] - [#x57f5 #x84a5] [#x1b22 #x7263] [#x9b83 #xc3ff] [#x1ac2 #x4696] - [#xcdb3 #x0aeb] [#x532e #x3054] [#x8fd9 #x48e4] [#x6dbc #x3128] - [#x58eb #xf2ef] [#x34c6 #xffea] [#xfe28 #xed61] [#xee7c #x3c73] - [#x5d4a #x14d9] [#xe864 #xb7e3] [#x4210 #x5d14] [#x203e #x13e0] - [#x45ee #xe2b6] [#xa3aa #xabea] [#xdb6c #x4f15] [#xfacb #x4fd0] - [#xc742 #xf442] [#xef6a #xbbb5] [#x654f #x3b1d] [#x41cd #x2105] - [#xd81e #x799e] [#x8685 #x4dc7] [#xe44b #x476a] [#x3d81 #x6250] - [#xcf62 #xa1f2] [#x5b8d #x2646] [#xfc88 #x83a0] [#xc1c7 #xb6a3] - [#x7f15 #x24c3] [#x69cb #x7492] [#x4784 #x8a0b] [#x5692 #xb285] - [#x095b #xbf00] [#xad19 #x489d] [#x1462 #xb174] [#x2382 #x0e00] - [#x5842 #x8d2a] [#x0c55 #xf5ea] [#x1dad #xf43e] [#x233f #x7061] - [#x3372 #xf092] [#x8d93 #x7e41] [#xd65f #xecf1] [#x6c22 #x3bdb] - [#x7cde #x3759] [#xcbee #x7460] [#x4085 #xf2a7] [#xce77 #x326e] - [#xa607 #x8084] [#x19f8 #x509e] [#xe8ef #xd855] [#x61d9 #x9735] - [#xa969 #xa7aa] [#xc50c #x06c2] [#x5a04 #xabfc] [#x800b #xcadc] - [#x9e44 #x7a2e] [#xc345 #x3484] [#xfdd5 #x6705] [#x0e1e #x9ec9] - [#xdb73 #xdbd3] [#x1055 #x88cd] [#x675f #xda79] [#xe367 #x4340] - [#xc5c4 #x3465] [#x713e #x38d8] [#x3d28 #xf89e] [#xf16d #xff20] - [#x153e #x21e7] [#x8fb0 #x3d4a] [#xe6e3 #x9f2b] [#xdb83 #xadf7] - ] - [ - [#xe93d #x5a68] [#x9481 #x40f7] [#xf64c #x261c] [#x9469 #x2934] - [#x4115 #x20f7] [#x7602 #xd4f7] [#xbcf4 #x6b2e] [#xd4a2 #x0068] - [#xd408 #x2471] [#x3320 #xf46a] [#x43b7 #xd4b7] [#x5000 #x61af] - [#x1e39 #xf62e] [#x9724 #x4546] [#x1421 #x4f74] [#xbf8b #x8840] - [#x4d95 #xfc1d] [#x96b5 #x91af] [#x70f4 #xddd3] [#x66a0 #x2f45] - [#xbfbc #x09ec] [#x03bd #x9785] [#x7fac #x6dd0] [#x31cb #x8504] - [#x96eb #x27b3] [#x55fd #x3941] [#xda25 #x47e6] [#xabca #x0a9a] - [#x2850 #x7825] [#x5304 #x29f4] [#x0a2c #x86da] [#xe9b6 #x6dfb] - [#x68dc #x1462] [#xd748 #x6900] [#x680e #xc0a4] [#x27a1 #x8dee] - [#x4f3f #xfea2] [#xe887 #xad8c] [#xb58c #xe006] [#x7af4 #xd6b6] - [#xaace #x1e7c] [#xd337 #x5fec] [#xce78 #xa399] [#x406b #x2a42] - [#x20fe #x9e35] [#xd9f3 #x85b9] [#xee39 #xd7ab] [#x3b12 #x4e8b] - [#x1dc9 #xfaf7] [#x4b6d #x1856] [#x26a3 #x6631] [#xeae3 #x97b2] - [#x3a6e #xfa74] [#xdd5b #x4332] [#x6841 #xe7f7] [#xca78 #x20fb] - [#xfb0a #xf54e] [#xd8fe #xb397] [#x4540 #x56ac] [#xba48 #x9527] - [#x5553 #x3a3a] [#x2083 #x8d87] [#xfe6b #xa9b7] [#xd096 #x954b] - [#x55a8 #x67bc] [#xa115 #x9a58] [#xcca9 #x2963] [#x99e1 #xdb33] - [#xa62a #x4a56] [#x3f31 #x25f9] [#x5ef4 #x7e1c] [#x9029 #x317c] - [#xfdf8 #xe802] [#x0427 #x2f70] [#x80bb #x155c] [#x0528 #x2ce3] - [#x95c1 #x1548] [#xe4c6 #x6d22] [#x48c1 #x133f] [#xc70f #x86dc] - [#x07f9 #xc9ee] [#x4104 #x1f0f] [#x4047 #x79a4] [#x5d88 #x6e17] - [#x325f #x51eb] [#xd59b #xc0d1] [#xf2bc #xc18f] [#x4111 #x3564] - [#x257b #x7834] [#x602a #x9c60] [#xdff8 #xe8a3] [#x1f63 #x6c1b] - [#x0e12 #xb4c2] [#x02e1 #x329e] [#xaf66 #x4fd1] [#xcad1 #x8115] - [#x6b23 #x95e0] [#x333e #x92e1] [#x3b24 #x0b62] [#xeebe #xb922] - [#x85b2 #xa20e] [#xe6ba #x0d99] [#xde72 #x0c8c] [#x2da2 #xf728] - [#xd012 #x7845] [#x95b7 #x94fd] [#x647d #x0862] [#xe7cc #xf5f0] - [#x5449 #xa36f] [#x877d #x48fa] [#xc39d #xfd27] [#xf33e #x8d1e] - [#x0a47 #x6341] [#x992e #xff74] [#x3a6f #x6eab] [#xf4f8 #xfd37] - [#xa812 #xdc60] [#xa1eb #xddf8] [#x991b #xe14c] [#xdb6e #x6b0d] - [#xc67b #x5510] [#x6d67 #x2c37] [#x2765 #xd43b] [#xdcd0 #xe804] - [#xf129 #x0dc7] [#xcc00 #xffa3] [#xb539 #x0f92] [#x690f #xed0b] - [#x667b #x9ffb] [#xcedb #x7d9c] [#xa091 #xcf0b] [#xd915 #x5ea3] - [#xbb13 #x2f88] [#x515b #xad24] [#x7b94 #x79bf] [#x763b #xd6eb] - [#x3739 #x2eb3] [#xcc11 #x5979] [#x8026 #xe297] [#xf42e #x312d] - [#x6842 #xada7] [#xc66a #x2b3b] [#x1275 #x4ccc] [#x782e #xf11c] - [#x6a12 #x4237] [#xb792 #x51e7] [#x06a1 #xbbe6] [#x4bfb #x6350] - [#x1a6b #x1018] [#x11ca #xedfa] [#x3d25 #xbdd8] [#xe2e1 #xc3c9] - [#x4442 #x1659] [#x0a12 #x1386] [#xd90c #xec6e] [#xd5ab #xea2a] - [#x64af #x674e] [#xda86 #xa85f] [#xbebf #xe988] [#x64e4 #xc3fe] - [#x9dbc #x8057] [#xf0f7 #xc086] [#x6078 #x7bf8] [#x6003 #x604d] - [#xd1fd #x8346] [#xf638 #x1fb0] [#x7745 #xae04] [#xd736 #xfccc] - [#x8342 #x6b33] [#xf01e #xab71] [#xb080 #x4187] [#x3c00 #x5e5f] - [#x77a0 #x57be] [#xbde8 #xae24] [#x5546 #x4299] [#xbf58 #x2e61] - [#x4e58 #xf48f] [#xf2dd #xfda2] [#xf474 #xef38] [#x8789 #xbdc2] - [#x5366 #xf9c3] [#xc8b3 #x8e74] [#xb475 #xf255] [#x46fc #xd9b9] - [#x7aeb #x2661] [#x8b1d #xdf84] [#x846a #x0e79] [#x915f #x95e2] - [#x466e #x598e] [#x20b4 #x5770] [#x8cd5 #x5591] [#xc902 #xde4c] - [#xb90b #xace1] [#xbb82 #x05d0] [#x11a8 #x6248] [#x7574 #xa99e] - [#xb77f #x19b6] [#xe0a9 #xdc09] [#x662d #x09a1] [#xc432 #x4633] - [#xe85a #x1f02] [#x09f0 #xbe8c] [#x4a99 #xa025] [#x1d6e #xfe10] - [#x1ab9 #x3d1d] [#x0ba5 #xa4df] [#xa186 #xf20f] [#x2868 #xf169] - [#xdcb7 #xda83] [#x5739 #x06fe] [#xa1e2 #xce9b] [#x4fcd #x7f52] - [#x5011 #x5e01] [#xa706 #x83fa] [#xa002 #xb5c4] [#x0de6 #xd027] - [#x9af8 #x8c27] [#x773f #x8641] [#xc360 #x4c06] [#x61a8 #x06b5] - [#xf017 #x7a28] [#xc0f5 #x86e0] [#x0060 #x58aa] [#x30dc #x7d62] - [#x11e6 #x9ed7] [#x2338 #xea63] [#x53c2 #xdd94] [#xc2c2 #x1634] - [#xbbcb #xee56] [#x90bc #xb6de] [#xebfc #x7da1] [#xce59 #x1d76] - [#x6f05 #xe409] [#x4b7c #x0188] [#x3972 #x0a3d] [#x7c92 #x7c24] - [#x86e3 #x725f] [#x724d #x9db9] [#x1ac1 #x5bb4] [#xd39e #xb8fc] - [#xed54 #x5578] [#x08fc #xa5b5] [#xd83d #x7cd3] [#x4dad #x0fc4] - [#x1e50 #xef5e] [#xb161 #xe6f8] [#xa285 #x14d9] [#x6c51 #x133c] - [#x6fd5 #xc7e7] [#x56e1 #x4ec4] [#x362a #xbfce] [#xddc6 #xc837] - [#xd79a #x3234] [#x9263 #x8212] [#x670e #xfa8e] [#x4060 #x00e0] - ] - [ - [#x3a39 #xce37] [#xd3fa #xf5cf] [#xabc2 #x7737] [#x5ac5 #x2d1b] - [#x5cb0 #x679e] [#x4fa3 #x3742] [#xd382 #x2740] [#x99bc #x9bbe] - [#xd511 #x8e9d] [#xbf0f #x7315] [#xd62d #x1c7e] [#xc700 #xc47b] - [#xb78c #x1b6b] [#x21a1 #x9045] [#xb26e #xb1be] [#x6a36 #x6eb4] - [#x5748 #xab2f] [#xbc94 #x6e79] [#xc6a3 #x76d2] [#x6549 #xc2c8] - [#x530f #xf8ee] [#x468d #xde7d] [#xd573 #x0a1d] [#x4cd0 #x4dc6] - [#x2939 #xbbdb] [#xa9ba #x4650] [#xac95 #x26e8] [#xbe5e #xe304] - [#xa1fa #xd5f0] [#x6a2d #x519a] [#x63ef #x8ce2] [#x9a86 #xee22] - [#xc089 #xc2b8] [#x4324 #x2ef6] [#xa51e #x03aa] [#x9cf2 #xd0a4] - [#x83c0 #x61ba] [#x9be9 #x6a4d] [#x8fe5 #x1550] [#xba64 #x5bd6] - [#x2826 #xa2f9] [#xa73a #x3ae1] [#x4ba9 #x9586] [#xef55 #x62e9] - [#xc72f #xefd3] [#xf752 #xf7da] [#x3f04 #x6f69] [#x77fa #x0a59] - [#x80e4 #xa915] [#x87b0 #x8601] [#x9b09 #xe6ad] [#x3b3e #xe593] - [#xe990 #xfd5a] [#x9e34 #xd797] [#x2cf0 #xb7d9] [#x022b #x8b51] - [#x96d5 #xac3a] [#x017d #xa67d] [#xd1cf #x3ed6] [#x7c7d #x2d28] - [#x1f9f #x25cf] [#xadf2 #xb89b] [#x5ad6 #xb472] [#x5a88 #xf54c] - [#xe029 #xac71] [#xe019 #xa5e6] [#x47b0 #xacfd] [#xed93 #xfa9b] - [#xe8d3 #xc48d] [#x283b #x57cc] [#xf8d5 #x6629] [#x7913 #x2e28] - [#x785f #x0191] [#xed75 #x6055] [#xf796 #x0e44] [#xe3d3 #x5e8c] - [#x1505 #x6dd4] [#x88f4 #x6dba] [#x03a1 #x6125] [#x0564 #xf0bd] - [#xc3eb #x9e15] [#x3c90 #x57a2] [#x9727 #x1aec] [#xa93a #x072a] - [#x1b3f #x6d9b] [#x1e63 #x21f5] [#xf59c #x66fb] [#x26dc #xf319] - [#x7533 #xd928] [#xb155 #xfdf5] [#x0356 #x3482] [#x8aba #x3cbb] - [#x2851 #x7711] [#xc20a #xd9f8] [#xabcc #x5167] [#xccad #x925f] - [#x4de8 #x1751] [#x3830 #xdc8e] [#x379d #x5862] [#x9320 #xf991] - [#xea7a #x90c2] [#xfb3e #x7bce] [#x5121 #xce64] [#x774f #xbe32] - [#xa8b6 #xe37e] [#xc329 #x3d46] [#x48de #x5369] [#x6413 #xe680] - [#xa2ae #x0810] [#xdd6d #xb224] [#x6985 #x2dfd] [#x0907 #x2166] - [#xb39a #x460a] [#x6445 #xc0dd] [#x586c #xdecf] [#x1c20 #xc8ae] - [#x5bbe #xf7dd] [#x1b58 #x8d40] [#xccd2 #x017f] [#x6bb4 #xe3bb] - [#xdda2 #x6a7e] [#x3a59 #xff45] [#x3e35 #x0a44] [#xbcb4 #xcdd5] - [#x72ea #xcea8] [#xfa64 #x84bb] [#x8d66 #x12ae] [#xbf3c #x6f47] - [#xd29b #xe463] [#x542f #x5d9e] [#xaec2 #x771b] [#xf64e #x6370] - [#x740e #x0d8d] [#xe75b #x1357] [#xf872 #x1671] [#xaf53 #x7d5d] - [#x4040 #xcb08] [#x4eb4 #xe2cc] [#x34d2 #x466a] [#x0115 #xaf84] - [#xe1b0 #x0428] [#x9598 #x3a1d] [#x06b8 #x9fb4] [#xce6e #xa048] - [#x6f3f #x3b82] [#x3520 #xab82] [#x011a #x1d4b] [#x2772 #x27f8] - [#x6115 #x60b1] [#xe793 #x3fdc] [#xbb3a #x792b] [#x3445 #x25bd] - [#xa088 #x39e1] [#x51ce #x794b] [#x2f32 #xc9b7] [#xa01f #xbac9] - [#xe01c #xc87e] [#xbcc7 #xd1f6] [#xcf01 #x11c3] [#xa1e8 #xaac7] - [#x1a90 #x8749] [#xd44f #xbd9a] [#xd0da #xdecb] [#xd50a #xda38] - [#x0339 #xc32a] [#xc691 #x3667] [#x8df9 #x317c] [#xe0b1 #x2b4f] - [#xf79e #x59b7] [#x43f5 #xbb3a] [#xf2d5 #x19ff] [#x27d9 #x459c] - [#xbf97 #x222c] [#x15e6 #xfc2a] [#x0f91 #xfc71] [#x9b94 #x1525] - [#xfae5 #x9361] [#xceb6 #x9ceb] [#xc2a8 #x6459] [#x12ba #xa8d1] - [#xb6c1 #x075e] [#xe305 #x6a0c] [#x10d2 #x5065] [#xcb03 #xa442] - [#xe0ec #x6e0e] [#x1698 #xdb3b] [#x4c98 #xa0be] [#x3278 #xe964] - [#x9f1f #x9532] [#xe0d3 #x92df] [#xd3a0 #x342b] [#x8971 #xf21e] - [#x1b0a #x7441] [#x4ba3 #x348c] [#xc5be #x7120] [#xc376 #x32d8] - [#xdf35 #x9f8d] [#x9b99 #x2f2e] [#xe60b #x6f47] [#x0fe3 #xf11d] - [#xe54c #xda54] [#x1eda #xd891] [#xce62 #x79cf] [#xcd3e #x7e6f] - [#x1618 #xb166] [#xfd2c #x1d05] [#x848f #xd2c5] [#xf6fb #x2299] - [#xf523 #xf357] [#xa632 #x7623] [#x93a8 #x3531] [#x56cc #xcd02] - [#xacf0 #x8162] [#x5a75 #xebb5] [#x6e16 #x3697] [#x88d2 #x73cc] - [#xde96 #x6292] [#x81b9 #x49d0] [#x4c50 #x901b] [#x71c6 #x5614] - [#xe6c6 #xc7bd] [#x327a #x140a] [#x45e1 #xd006] [#xc3f2 #x7b9a] - [#xc9aa #x53fd] [#x62a8 #x0f00] [#xbb25 #xbfe2] [#x35bd #xd2f6] - [#x7112 #x6905] [#xb204 #x0222] [#xb6cb #xcf7c] [#xcd76 #x9c2b] - [#x5311 #x3ec0] [#x1640 #xe3d3] [#x38ab #xbd60] [#x2547 #xadf0] - [#xba38 #x209c] [#xf746 #xce76] [#x77af #xa1c5] [#x2075 #x6060] - [#x85cb #xfe4e] [#x8ae8 #x8dd8] [#x7aaa #xf9b0] [#x4cf9 #xaa7e] - [#x1948 #xc25c] [#x02fb #x8a8c] [#x01c3 #x6ae4] [#xd6eb #xe1f9] - [#x90d4 #xf869] [#xa65c #xdea0] [#x3f09 #x252d] [#xc208 #xe69f] - [#xb74e #x6132] [#xce77 #xe25b] [#x578f #xdfe3] [#x3ac3 #x72e6] - ]]) - -(defconst blowfish-p-array-inits - [ - [#x243f #x6a88] [#x85a3 #x08d3] [#x1319 #x8a2e] [#x0370 #x7344] - [#xa409 #x3822] [#x299f #x31d0] [#x082e #xfa98] [#xec4e #x6c89] - [#x4528 #x21e6] [#x38d0 #x1377] [#xbe54 #x66cf] [#x34e9 #x0c6c] - [#xc0ac #x29b7] [#xc97c #x50dd] [#x3f84 #xd5b5] [#xb547 #x0917] - [#x9216 #xd5d9] [#x8979 #xfb1b] - ]) - -(defun blowfish-generate-keys (key) - "given a key vector \(an even number of 16-bit integers\), returns -the p-array and s-boxes for Blowfish encryption using that key, as a -pair: \(P-array . S-boxes\)." - (let ((s-boxes (vector (make-vector 256 nil) - (make-vector 256 nil) - (make-vector 256 nil) - (make-vector 256 nil))) - (p-array (make-vector 18 nil))) - ;; copy the initial values into the s-boxes - (dotimes (s 4) - (let ((s-box (aref s-boxes s)) - (inits (aref blowfish-s-box-inits s))) - (dotimes (idx 256) - (aset s-box idx (copy-seq (aref inits idx)))))) - ;; copy the initial values into the p-array - (dotimes (idx 18) - (aset p-array idx (copy-seq (aref blowfish-p-array-inits idx)))) - - ;; mix the key into the P-array - (let ((keylen (length key))) - (assert (and (>= keylen 2) (evenp keylen)) nil - "Blowfish key must be a positive multiple of 2 elements long.") - - (dotimes (idx 18) - (let* ((keyidx (mod (* 2 idx) keylen)) - (keyval (vector (aref key keyidx) - (aref key (1+ keyidx)))) - (p-entry (aref p-array idx))) - (blowfish-xor p-entry keyval p-entry) - ;; clean up - (fillarray keyval 0)))) - - ;; begin the iterated filling of the P-array and S-boxes - (let ((data (vector 0 0 0 0))) - ;; fill the P-array - (do ((idx 0 (+ idx 2))) - ((= idx 18)) - ;; encipher data w/ the current P-array and S-boxes - (blowfish-cipher-block data p-array s-boxes) - ;; replace the next two P-array elements with the new data - (let ((Pa (aref p-array idx)) - (Pb (aref p-array (1+ idx)))) - (aset Pa 0 (aref data 0)) - (aset Pa 1 (aref data 1)) - (aset Pb 0 (aref data 2)) - (aset Pb 1 (aref data 3)))) - - ;; fill the S-boxes - (dotimes (s 4) - (do ((idx 0 (+ idx 2)) - (s-box (aref s-boxes s))) - ((= idx 256)) - ;; encipher data w/ the current P-array and S-boxes - (blowfish-cipher-block data p-array s-boxes) - ;; replace the next two S-box elements with the new data - (let ((Sa (aref s-box idx)) - (Sb (aref s-box (1+ idx)))) - (aset Sa 0 (aref data 0)) - (aset Sa 1 (aref data 1)) - (aset Sb 0 (aref data 2)) - (aset Sb 1 (aref data 3))))) - - ;; clean up - (fillarray data 0)) - - ;; return the result - (cons p-array s-boxes))) diff --git a/xemacs-packages/lisp/ecrypto/custom-load.el b/xemacs-packages/lisp/ecrypto/custom-load.el deleted file mode 100644 index 0046c57a..00000000 --- a/xemacs-packages/lisp/ecrypto/custom-load.el +++ /dev/null @@ -1,14 +0,0 @@ -;;; custom-load.el --- automatically extracted custom dependencies - -;;; Code: - -(autoload 'custom-add-loads "cus-load") - -(custom-add-loads 'extensions '("sha1")) -(custom-add-loads 'password '("password")) -(custom-add-loads 'rijndael '("rijndael")) -(custom-add-loads 'encrypt '("password" "encrypt")) -(custom-add-loads 'applications '("encrypt")) -(custom-add-loads 'sha1 '("sha1")) - -;;; custom-load.el ends here diff --git a/xemacs-packages/lisp/ecrypto/des.el b/xemacs-packages/lisp/ecrypto/des.el deleted file mode 100644 index 8ce2df47..00000000 --- a/xemacs-packages/lisp/ecrypto/des.el +++ /dev/null @@ -1,330 +0,0 @@ -;;; des.el - Data Encryption Standard block cipher, including 3DES - -;; Copyright (C) 1998 Ray Jones - -;; Author: Ray Jones, rjones@pobox.com -;; Keywords: DES, 3DES, oink, cipher, cypher, cryptography -;; Created: 1998-04-01 - -;; 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.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA. - -;;; Commentary: - -;; this is not optimized at all, yet. it uses vectors of boolean -;; values. changing it to use 16-bit integers instead might be -;; faster, though the permutation functions will be quite a bit more -;; confusing. - -;; this code was written using des-how-to.txt, by Matthew Fischer -;; (mfischer@blue.weeg.uiowa.edu) - -;;; TODO: - -;; add DESX -;; add DES/SK (anyone that knows what DES/SK is, please mail me) -;; add DES with key-dependent S-boxes (a la Biham, see Schneier) - -;;; Code: - -(require 'cl) - -(defun hexstring-to-bitvec (string) - "convert a hexadecimal string into a MSB-first bit vector" - (let* ((strlen (length string)) - (bitlen (* 4 strlen)) - (bvec (make-vector bitlen nil))) - (do ((stridx 0 (1+ stridx)) - (bitidx 0 (+ bitidx 4))) - ((= stridx strlen) bvec) - (let* ((char (aref string stridx)) - (val (if (and (<= ?0 char) - (<= char ?9)) - (- char ?0) - (+ 10 (- (downcase char) ?a))))) - (dotimes (offset 4) - (when (/= 0 (logand val - (ash 1 (- 3 offset)))) - (aset bvec (+ bitidx offset) t))))))) - -(defun bitvec-to-hexstring (bitvec) - "convert an MSB-first bit vector into a hexadecimal string" - (let* ((bitlen (length bitvec)) - (strlen (car (ceiling* bitlen 4))) - (string (make-string strlen ?0))) - (do ((stridx 0 (1+ stridx)) - (bitidx 0 (+ bitidx 4))) - ((= stridx strlen) string) - (let ((val 0)) - (dotimes (offset 4) - (let ((bidx (+ bitidx offset))) - (when (and (< bidx bitlen) - (aref bitvec bidx)) - (incf val (ash 1 (- 3 offset)))))) - (aset string stridx (if (< val 10) - (+ ?0 val) - (+ ?a (- val 10)))))))) - -(defun des-permute (vec permute-vals) - "helper function for permutations in DES code" - (let* ((len (length permute-vals)) - (outvec (make-vector len nil))) - (dotimes (offset len outvec) - (aset outvec offset (aref vec (aref permute-vals offset)))))) - -;; note that these are 0-indexed. most references list these as 1-indexed -(defconst des-PC1-vals [56 48 40 32 24 16 8 0 57 49 41 33 25 17 9 1 58 50 42 34 26 18 10 2 59 51 43 35 62 54 46 38 30 22 14 6 61 53 45 37 29 21 13 5 60 52 44 36 28 20 12 4 27 19 11 3]) - -(defun des-PC1 (key) - "DES permuted choice #1. -takes a 64-bit key and returns a 56-bit permuted key" - (assert (= (length key) 64) nil - "des-PC1: key must be 64 bits long") - (des-permute key des-PC1-vals)) - -;; note that these are 0-indexed. most references list these as 1-indexed -(defconst des-PC2-vals [13 16 10 23 0 4 2 27 14 5 20 9 22 18 11 3 25 7 15 6 26 19 12 1 40 51 30 36 46 54 29 39 50 44 32 47 43 48 38 55 33 52 45 41 49 35 28 31]) - - -(defun des-PC2 (key) - "DES permuted choice #2. -takes a 56-bit key and returns a 48-bit permuted key." - (assert (= (length key) 56) nil - "des-PC2: key must be 56 bits long") - (des-permute key des-PC2-vals)) - - -(defun des-<<< (vec shift) - "circular left shift VEC by SHIFT elements" - (let* ((len (length vec)) - (outvec (make-vector len nil))) - (when (or (>= shift len) - (< shift 0)) - (setq shift (mod shift len))) - (do ((out-idx 0 (1+ out-idx)) - (in-idx shift (1+ in-idx))) - ((= in-idx len)) - (aset outvec out-idx (aref vec in-idx))) - (do ((out-idx (- len shift) (1+ out-idx)) - (in-idx 0 (1+ in-idx))) - ((= in-idx shift) outvec) - (aset outvec out-idx (aref vec in-idx))))) - - -(defconst des-key-shifts [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1]) - -(defun des-compute-subkeys (key) - "computes the 16 48-bit subkeys from a 64-bit key" - (let* ((subkeys (make-vector 16 [])) - (PC1 (des-PC1 key)) - (C (subseq PC1 0 28)) - (D (subseq PC1 28 56))) - ;; clean up - (fillarray PC1 nil) - ;; compute subkeys - (dotimes (count 16) - (let* ((new-C (des-<<< C (aref des-key-shifts count))) - (new-D (des-<<< D (aref des-key-shifts count))) - (CD (vconcat new-C new-D))) - (aset subkeys count (des-PC2 CD)) - ;; clean up - (fillarray C nil) - (fillarray D nil) - ;; replace old with new - (setq C new-C) - (setq D new-D))) - (fillarray C nil) - (fillarray D nil) - subkeys)) - - - -(defconst des-E-vals [31 0 1 2 3 4 3 4 5 6 7 8 7 8 9 10 11 12 11 12 13 14 15 16 15 16 17 18 19 20 19 20 21 22 23 24 23 24 25 26 27 28 27 28 29 30 31 0]) - -(defun des-E (vec) - "perform the Expansion function on a 32-bit vector" - (assert (= (length vec) 32) nil - "des-E: vec must be 32 bits long") - (des-permute vec des-E-vals)) - -(defun des-xor-in-place (vec1 vec2) - "XOR two bit vectors together, storing in the first" - (let ((len (length vec1))) - (assert (= len (length vec2)) nil - "des-xor: vec1 and vec2 must be of same length") - (dotimes (idx len vec1) - (aset vec1 idx (not (eq (aref vec1 idx) - (aref vec2 idx))))))) - -(defun des-integer-to-bitvec (val) - "converts an integer to a 4-bit bit vector (used to construct S-boxes)" - (let ((out (make-vector 4 nil))) - (dotimes (shift 4 out) - (when (= 1 (logand 1 (ash val (- shift 3)))) - (aset out shift t))))) - - -(defconst des-S-boxes-vals - [[[14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7] - [ 0 15 7 4 14 2 13 1 10 6 12 11 9 5 3 8] - [ 4 1 14 8 13 6 2 11 15 12 9 7 3 10 5 0] - [15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13]] - - [[15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10] - [ 3 13 4 7 15 2 8 14 12 0 1 10 6 9 11 5] - [ 0 14 7 11 10 4 13 1 5 8 12 6 9 3 2 15] - [13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9]] - - [[10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8] - [13 7 0 9 3 4 6 10 2 8 5 14 12 11 15 1] - [13 6 4 9 8 15 3 0 11 1 2 12 5 10 14 7] - [ 1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12]] - - [[ 7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15] - [13 8 11 5 6 15 0 3 4 7 2 12 1 10 14 9] - [10 6 9 0 12 11 7 13 15 1 3 14 5 2 8 4] - [ 3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14]] - - [[ 2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9] - [14 11 2 12 4 7 13 1 5 0 15 10 3 9 8 6] - [ 4 2 1 11 10 13 7 8 15 9 12 5 6 3 0 14] - [11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3]] - - [[12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11] - [10 15 4 2 7 12 9 5 6 1 13 14 0 11 3 8] - [ 9 14 15 5 2 8 12 3 7 0 4 10 1 13 11 6] - [ 4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13]] - - [[ 4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1] - [13 0 11 7 4 9 1 10 14 3 5 12 2 15 8 6] - [ 1 4 11 13 12 3 7 14 10 15 6 8 0 5 9 2] - [ 6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12]] - - [[13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7] - [ 1 15 13 8 10 3 7 4 12 5 6 11 0 14 9 2] - [ 7 11 4 1 9 12 14 2 0 6 10 13 15 3 5 8] - [ 2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11]]]) - -(defconst des-S-boxes (map 'vector - #'(lambda (x) - (map 'vector - #'(lambda (y) - (map 'vector - #'des-integer-to-bitvec - y)) - x)) - des-S-boxes-vals)) - -(defun des-S (vec) - "do the S substitution on a 48-bit vector, returning a 32-bit vector" - (let ((temp-vecs (make-vector 8 nil))) - (do ((Sidx 0 (1+ Sidx)) - (bitidx 0 (+ bitidx 6))) - ((= Sidx 8)) - (let ((val1 (+ (if (aref vec (+ bitidx 0)) 2 0) - (if (aref vec (+ bitidx 5)) 1 0))) - (val2 (+ (if (aref vec (+ bitidx 1)) 8 0) - (if (aref vec (+ bitidx 2)) 4 0) - (if (aref vec (+ bitidx 3)) 2 0) - (if (aref vec (+ bitidx 4)) 1 0)))) - (aset temp-vecs Sidx (aref (aref (aref des-S-boxes Sidx) - val1) - val2)))) - (prog1 - (apply #'vconcat (coerce temp-vecs 'list)) - ;; clean up - (fillarray temp-vecs nil)))) - -(defconst des-P-vals [15 6 19 20 28 11 27 16 0 14 22 25 4 17 30 9 1 7 23 13 31 26 2 8 18 12 29 5 21 10 3 24]) - -(defun des-P (vec) - "perform the P permutation on a 32-bit vector" - (assert (= (length vec) 32) nil - "des-P: vec must be 32 bits long") - (des-permute vec des-P-vals)) - -(defun des-f (vec key) - "perform the des f() function on 32-bit VEC and 48-bit KEY" - (let* ((E-vec (des-E vec)) - (S-vec (des-S (des-xor-in-place E-vec key))) - (P-vec (des-P S-vec))) - (prog1 - P-vec - ;; clean up - (fillarray E-vec nil) - (fillarray S-vec nil)))) - -(defconst des-IP-vals [57 49 41 33 25 17 9 1 59 51 43 35 27 19 11 3 61 53 45 37 29 21 13 5 63 55 47 39 31 23 15 7 56 48 40 32 24 16 8 0 58 50 42 34 26 18 10 2 60 52 44 36 28 20 12 4 62 54 46 38 30 22 14 6]) - -(defun des-IP (vec) - "perform the Initial Permutation on a 64-bit data vector" - (assert (= (length vec) 64) nil - "des-IP: vec must be 64 bits long") - (des-permute vec des-IP-vals)) - - -(defconst des-IP-inv-vals [39 7 47 15 55 23 63 31 38 6 46 14 54 22 62 30 37 5 45 13 53 21 61 29 36 4 44 12 52 20 60 28 35 3 43 11 51 19 59 27 34 2 42 10 50 18 58 26 33 1 41 9 49 17 57 25 32 0 40 8 48 16 56 24]) - -(defun des-IP-inv (vec) - "perform the inverse of the Initial Permutation on a 64-bit data vector" - (assert (= (length vec) 64) nil - "des-IP-inv: vec must be 64 bits long") - (des-permute vec des-IP-inv-vals)) - -(defun des-cipher-block (vec subkeys &optional reverse) - "perform the DES cipher on a 64-bit VEC using SUBKEYS. -if optional third arg REVERSE is true, decrypts." - (let* ((IP (des-IP vec)) - (L (subseq IP 0 32)) - (R (subseq IP 32 64))) - ;; clean up - (fillarray IP nil) - - (dotimes (count 16) - (let ((f-R (des-f R (aref subkeys (if reverse (- 15 count) count)))) - (old-R R) - (old-L L)) - (setq L old-R) - (setq R (des-xor-in-place old-L f-R)) - ;; clean up - (fillarray f-R nil))) - - (let ((RL (vconcat R L))) - (prog1 - (des-IP-inv RL) - ;; clean up - (fillarray RL nil) - (fillarray R nil) - (fillarray L nil))))) - -(defun des-triple-des (data subkeys1 subkeys2 subkeys3 &optional reverse) - "perform the triple-DES encryption on DATA with three sets of subkeys. -if optional fifth arg REVERSE is true, decrypts." - (if (not reverse) - (let* ((E1 (des-cipher-block data subkeys1)) - (E2 (des-cipher-block E1 subkeys2 t)) - (E3 (des-cipher-block E2 subkeys3))) - ;; clean up - (fillarray E1 nil) - (fillarray E2 nil) - E3) - - (let* ((D1 (des-cipher-block data subkeys3 t)) - (D2 (des-cipher-block D1 subkeys2)) - (D3 (des-cipher-block D2 subkeys1 t))) - ;; clean up - (fillarray D1 nil) - (fillarray D2 nil) - D3))) diff --git a/xemacs-packages/lisp/ecrypto/encrypt.el b/xemacs-packages/lisp/ecrypto/encrypt.el deleted file mode 100644 index 659c4b90..00000000 --- a/xemacs-packages/lisp/ecrypto/encrypt.el +++ /dev/null @@ -1,273 +0,0 @@ -;;; encrypt.el --- file encryption routines -;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. - -;; Author: Teodor Zlatanov -;; Created: 2003/01/24 -;; Keywords: files - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; This module addresses data encryption. Page breaks are used for -;;; grouping declarations and documentation relating to each -;;; particular aspect. - -;;; Code: - -;; autoload password -(eval-and-compile - (autoload 'password-read "password")) - -(defgroup encrypt '((password-cache custom-variable) - (password-cache-expiry custom-variable)) - "File encryption configuration." - :group 'applications) - -(defcustom encrypt-file-alist nil - "List of file names or regexes matched with encryptions. -Format example: - '((\"beta\" - (gpg \"AES\")) - (\"/home/tzz/alpha\" - (encrypt-xor \"Semi-Secret\")))" - - :type '(repeat - (list :tag "Encryption entry" - (radio :tag "What to encrypt" - (file :tag "Filename") - (regexp :tag "Regular expression match")) - (radio :tag "How to encrypt it" - (list - :tag "GPG Encryption" - (const :tag "GPG Program" gpg) - (radio :tag "Choose a cipher" - (const :tag "3DES Encryption" "3DES") - (const :tag "CAST5 Encryption" "CAST5") - (const :tag "Blowfish Encryption" "BLOWFISH") - (const :tag "AES Encryption" "AES") - (const :tag "AES192 Encryption" "AES192") - (const :tag "AES256 Encryption" "AES256") - (const :tag "Twofish Encryption" "TWOFISH") - (string :tag "Cipher Name"))) - (list - :tag "Built-in simple XOR" - (const :tag "XOR Encryption" encrypt-xor) - (string :tag "XOR Cipher Value (seed value)"))))) - :group 'encrypt) - -;; TODO: now, load gencrypt.el and if successful, modify the -;; custom-type of encrypt-file-alist to add the gencrypt.el options - -;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type) -;; then use plist-put - -(defcustom encrypt-gpg-path (executable-find "gpg") - "Path to the GPG program." - :type '(radio - (file :tag "Location of the GPG executable") - (const :tag "GPG is not installed" nil)) - :group 'encrypt) - -(defvar encrypt-temp-prefix "encrypt" - "Prefix for temporary filenames") - -;;;###autoload -(defun encrypt-find-model (filename) - "Given a filename, find a encrypt-file-alist entry" - (dolist (entry encrypt-file-alist) - (let ((match (nth 0 entry)) - (model (nth 1 entry))) - (when (or (eq match filename) - (string-match match filename)) - (return model))))) - -;;;###autoload -(defun encrypt-insert-file-contents (file &optional model) - "Decrypt FILE into the current buffer." - (interactive "fFile to insert: ") - (let* ((model (or model (encrypt-find-model file))) - (method (nth 0 model)) - (cipher (nth 1 model)) - (password-key (format "encrypt-password-%s-%s %s" - (symbol-name method) cipher file)) - (passphrase - (password-read-and-add - (format "%s password for cipher %s? " - (symbol-name method) cipher) - password-key)) - (buffer-file-coding-system 'binary) - (coding-system-for-read 'binary) - outdata) - - ;; note we only insert-file-contents if the method is known to be valid - (cond - ((eq method 'gpg) - (insert-file-contents file) - (setq outdata (encrypt-gpg-decode-buffer passphrase cipher))) - ((eq method 'encrypt-xor) - (insert-file-contents file) - (setq outdata (encrypt-xor-decode-buffer passphrase cipher)))) - - (if outdata - (progn - (gnus-message 9 "%s was decrypted with %s (cipher %s)" - file (symbol-name method) cipher) - (delete-region (point-min) (point-max)) - (goto-char (point-min)) - (insert outdata)) - ;; the decryption failed, alas - (password-cache-remove password-key) - (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)" - file (symbol-name method) cipher)))) - -(defun encrypt-get-file-contents (file &optional model) - "Decrypt FILE and return the contents." - (interactive "fFile to decrypt: ") - (with-temp-buffer - (encrypt-insert-file-contents file model) - (buffer-string))) - -(defun encrypt-put-file-contents (file data &optional model) - "Encrypt the DATA to FILE, then continue normally." - (with-temp-buffer - (insert data) - (encrypt-write-file-contents file model))) - -(defun encrypt-write-file-contents (file &optional model) - "Encrypt the current buffer to FILE, then continue normally." - (interactive "fFile to write: ") - (let* ((model (or model (encrypt-find-model file))) - (method (nth 0 model)) - (cipher (nth 1 model)) - (password-key (format "encrypt-password-%s-%s %s" - (symbol-name method) cipher file)) - (passphrase - (password-read - (format "%s password for cipher %s? " - (symbol-name method) cipher) - password-key)) - outdata) - - (cond - ((eq method 'gpg) - (setq outdata (encrypt-gpg-encode-buffer passphrase cipher))) - ((eq method 'encrypt-xor) - (setq outdata (encrypt-xor-encode-buffer passphrase cipher)))) - - (if outdata - (progn - (gnus-message 9 "%s was encrypted with %s (cipher %s)" - file (symbol-name method) cipher) - (delete-region (point-min) (point-max)) - (goto-char (point-min)) - (insert outdata) - ;; do not confirm overwrites - (write-file file nil)) - ;; the decryption failed, alas - (password-cache-remove password-key) - (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)" - file (symbol-name method) cipher)))) - -(defun encrypt-xor-encode-buffer (passphrase cipher) - (encrypt-xor-process-buffer passphrase cipher t)) - -(defun encrypt-xor-decode-buffer (passphrase cipher) - (encrypt-xor-process-buffer passphrase cipher nil)) - -(defun encrypt-xor-process-buffer (passphrase - cipher - &optional encode) - "Given PASSPHRASE, xor-encode or decode the contents of the current buffer." - (let* ((bs (buffer-substring-no-properties (point-min) (point-max))) - ;; passphrase-sum is a simple additive checksum of the - ;; passphrase and the cipher - (passphrase-sum - (when (stringp passphrase) - (apply '+ (append cipher passphrase nil)))) - new-list) - - (with-temp-buffer - (if encode - (progn - (dolist (x (append bs nil)) - (setq new-list (cons (logxor x passphrase-sum) new-list))) - - (dolist (x new-list) - (insert (format "%d " x)))) - (progn - (setq new-list (reverse (split-string bs))) - (dolist (x new-list) - (setq x (string-to-number x)) - (insert (format "%c" (logxor x passphrase-sum)))))) - (buffer-substring-no-properties (point-min) (point-max))))) - -(defun encrypt-gpg-encode-buffer (passphrase cipher) - (encrypt-gpg-process-buffer passphrase cipher t)) - -(defun encrypt-gpg-decode-buffer (passphrase cipher) - (encrypt-gpg-process-buffer passphrase cipher nil)) - -(defun encrypt-gpg-process-buffer (passphrase - cipher - &optional encode) - "With PASSPHRASE, use GPG to encode or decode the current buffer." - (let* ((program encrypt-gpg-path) - (input (buffer-substring-no-properties (point-min) (point-max))) - (temp-maker (if (fboundp 'make-temp-file) - 'make-temp-file - 'make-temp-name)) - (temp-file (funcall temp-maker encrypt-temp-prefix)) - (default-enable-multibyte-characters nil) - (args `("--cipher-algo" ,cipher - "--status-fd" "2" - "--logger-fd" "2" - "--passphrase-fd" "0" - "--no-tty")) - exit-status exit-data) - - (when encode - (setq args - (append args - '("--symmetric" - "--armor")))) - - (if program - (with-temp-buffer - (when passphrase - (insert passphrase "\n")) - (insert input) - (setq exit-status - (apply #'call-process-region (point-min) (point-max) program - t `(t ,temp-file) nil args)) - (if (equal exit-status 0) - (setq exit-data - (buffer-substring-no-properties (point-min) (point-max))) - (with-temp-buffer - (when (file-exists-p temp-file) - (insert-file-contents temp-file)) - (gnus-error 5 (format "%s exited abnormally: '%s' [%s]" - program exit-status (buffer-string))))) - (delete-file temp-file)) - (gnus-error 5 "GPG is not installed.")) - exit-data)) - -(provide 'encrypt) -;;; encrypt.el ends here - -;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648 diff --git a/xemacs-packages/lisp/ecrypto/hex-util.el b/xemacs-packages/lisp/ecrypto/hex-util.el deleted file mode 100644 index 1cc67c28..00000000 --- a/xemacs-packages/lisp/ecrypto/hex-util.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; hex-util.el --- Functions to encode/decode hexadecimal string. - -;; Copyright (C) 1999, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. - -;; Author: Shuhei KOBAYASHI -;; Keywords: data - -;; This file is part of FLIM (Faithful Library about Internet Message). - -;; 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: - -;;; Code: - -(eval-when-compile - (defmacro hex-char-to-num (chr) - (` (let ((chr (, chr))) - (cond - ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10)) - ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10)) - ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0)) - (t (error "Invalid hexadecimal digit `%c'" chr)))))) - (defmacro num-to-hex-char (num) - (` (aref "0123456789abcdef" (, num))))) - -(defun decode-hex-string (string) - "Decode hexadecimal STRING to octet string." - (let* ((len (length string)) - (dst (make-string (/ len 2) 0)) - (idx 0)(pos 0)) - (while (< pos len) -;;; logior and lsh are not byte-coded. -;;; (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4) -;;; (hex-char-to-num (aref string (1+ pos))))) - (aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16) - (hex-char-to-num (aref string (1+ pos))))) - (setq idx (1+ idx) - pos (+ 2 pos))) - dst)) - -(defun encode-hex-string (string) - "Encode octet STRING to hexadecimal string." - (let* ((len (length string)) - (dst (make-string (* len 2) 0)) - (idx 0)(pos 0)) - (while (< pos len) -;;; logand and lsh are not byte-coded. -;;; (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15))) - (aset dst idx (num-to-hex-char (/ (aref string pos) 16))) - (setq idx (1+ idx)) -;;; (aset dst idx (num-to-hex-char (logand (aref string pos) 15))) - (aset dst idx (num-to-hex-char (% (aref string pos) 16))) - (setq idx (1+ idx) - pos (1+ pos))) - dst)) - -(provide 'hex-util) - -;;; arch-tag: fe8aaa79-6c86-400e-813f-5a8cc4cb3859 -;;; hex-util.el ends here diff --git a/xemacs-packages/lisp/ecrypto/md4.el b/xemacs-packages/lisp/ecrypto/md4.el deleted file mode 100644 index f2c1dd91..00000000 --- a/xemacs-packages/lisp/ecrypto/md4.el +++ /dev/null @@ -1,230 +0,0 @@ -;;; md4.el --- MD4 Message Digest Algorithm. - -;; Copyright (C) 2004 Free Software Foundation, Inc. -;; Copyright (C) 2001 Taro Kawagishi -;; Author: Taro Kawagishi -;; Keywords: MD4 -;; Version: 1.00 -;; Created: February 2001 - -;; This file is part of FLIM (Faithful Library about Internet Message). - -;; 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: - -;;; -;;; MD4 hash calculation - -(defvar md4-buffer (make-vector 4 '(0 . 0)) - "work buffer of four 32-bit integers") - -;;;###autoload -(defun md4 (in n) - "Returns the MD4 hash string of 16 bytes long for a string IN of N -bytes long. N is required to handle strings containing character 0." - (let (m - (b (cons 0 (* n 8))) - (i 0) - (buf (make-string 128 0)) c4) - ;; initial values - (aset md4-buffer 0 '(26437 . 8961)) ;0x67452301 - (aset md4-buffer 1 '(61389 . 43913)) ;0xefcdab89 - (aset md4-buffer 2 '(39098 . 56574)) ;0x98badcfe - (aset md4-buffer 3 '(4146 . 21622)) ;0x10325476 - - ;; process the string in 64 bits chunks - (while (> n 64) - (setq m (md4-copy64 (substring in 0 64))) - (md4-64 m) - (setq in (substring in 64)) - (setq n (- n 64))) - - ;; process the rest of the string (length is now n <= 64) - (setq i 0) - (while (< i n) - (aset buf i (aref in i)) - (setq i (1+ i))) - (aset buf n 128) ;0x80 - (if (<= n 55) - (progn - (setq c4 (md4-pack-int32 b)) - (aset buf 56 (aref c4 0)) - (aset buf 57 (aref c4 1)) - (aset buf 58 (aref c4 2)) - (aset buf 59 (aref c4 3)) - (setq m (md4-copy64 buf)) - (md4-64 m)) - ;; else - (setq c4 (md4-pack-int32 b)) - (aset buf 120 (aref c4 0)) - (aset buf 121 (aref c4 1)) - (aset buf 122 (aref c4 2)) - (aset buf 123 (aref c4 3)) - (setq m (md4-copy64 buf)) - (md4-64 m) - (setq m (md4-copy64 (substring buf 64))) - (md4-64 m))) - - (concat (md4-pack-int32 (aref md4-buffer 0)) - (md4-pack-int32 (aref md4-buffer 1)) - (md4-pack-int32 (aref md4-buffer 2)) - (md4-pack-int32 (aref md4-buffer 3)))) - -(defsubst md4-F (x y z) (logior (logand x y) (logand (lognot x) z))) -(defsubst md4-G (x y z) (logior (logand x y) (logand x z) (logand y z))) -(defsubst md4-H (x y z) (logxor x y z)) - -(defmacro md4-make-step (name func) - (` - (defun (, name) (a b c d xk s ac) - (let* - ((h1 (+ (car a) ((, func) (car b) (car c) (car d)) (car xk) (car ac))) - (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac))) - (h2 (logand 65535 (+ h1 (lsh l1 -16)))) - (l2 (logand 65535 l1)) - ;; cyclic shift of 32 bits integer - (h3 (logand 65535 (if (> s 15) - (+ (lsh h2 (- s 32)) (lsh l2 (- s 16))) - (+ (lsh h2 s) (lsh l2 (- s 16)))))) - (l3 (logand 65535 (if (> s 15) - (+ (lsh l2 (- s 32)) (lsh h2 (- s 16))) - (+ (lsh l2 s) (lsh h2 (- s 16))))))) - (cons h3 l3))))) - -(md4-make-step md4-round1 md4-F) -(md4-make-step md4-round2 md4-G) -(md4-make-step md4-round3 md4-H) - -(defsubst md4-add (x y) - "Return 32-bit sum of 32-bit integers X and Y." - (let ((h (+ (car x) (car y))) - (l (+ (cdr x) (cdr y)))) - (cons (logand 65535 (+ h (lsh l -16))) (logand 65535 l)))) - -(defsubst md4-and (x y) - (cons (logand (car x) (car y)) (logand (cdr x) (cdr y)))) - -(defun md4-64 (m) - "Calculate md4 of 64 bytes chunk M which is represented as 16 pairs of -32 bits integers. The resulting md4 value is placed in md4-buffer." - (let ((a (aref md4-buffer 0)) - (b (aref md4-buffer 1)) - (c (aref md4-buffer 2)) - (d (aref md4-buffer 3))) - (setq a (md4-round1 a b c d (aref m 0) 3 '(0 . 0)) - d (md4-round1 d a b c (aref m 1) 7 '(0 . 0)) - c (md4-round1 c d a b (aref m 2) 11 '(0 . 0)) - b (md4-round1 b c d a (aref m 3) 19 '(0 . 0)) - a (md4-round1 a b c d (aref m 4) 3 '(0 . 0)) - d (md4-round1 d a b c (aref m 5) 7 '(0 . 0)) - c (md4-round1 c d a b (aref m 6) 11 '(0 . 0)) - b (md4-round1 b c d a (aref m 7) 19 '(0 . 0)) - a (md4-round1 a b c d (aref m 8) 3 '(0 . 0)) - d (md4-round1 d a b c (aref m 9) 7 '(0 . 0)) - c (md4-round1 c d a b (aref m 10) 11 '(0 . 0)) - b (md4-round1 b c d a (aref m 11) 19 '(0 . 0)) - a (md4-round1 a b c d (aref m 12) 3 '(0 . 0)) - d (md4-round1 d a b c (aref m 13) 7 '(0 . 0)) - c (md4-round1 c d a b (aref m 14) 11 '(0 . 0)) - b (md4-round1 b c d a (aref m 15) 19 '(0 . 0)) - - a (md4-round2 a b c d (aref m 0) 3 '(23170 . 31129)) ;0x5A827999 - d (md4-round2 d a b c (aref m 4) 5 '(23170 . 31129)) - c (md4-round2 c d a b (aref m 8) 9 '(23170 . 31129)) - b (md4-round2 b c d a (aref m 12) 13 '(23170 . 31129)) - a (md4-round2 a b c d (aref m 1) 3 '(23170 . 31129)) - d (md4-round2 d a b c (aref m 5) 5 '(23170 . 31129)) - c (md4-round2 c d a b (aref m 9) 9 '(23170 . 31129)) - b (md4-round2 b c d a (aref m 13) 13 '(23170 . 31129)) - a (md4-round2 a b c d (aref m 2) 3 '(23170 . 31129)) - d (md4-round2 d a b c (aref m 6) 5 '(23170 . 31129)) - c (md4-round2 c d a b (aref m 10) 9 '(23170 . 31129)) - b (md4-round2 b c d a (aref m 14) 13 '(23170 . 31129)) - a (md4-round2 a b c d (aref m 3) 3 '(23170 . 31129)) - d (md4-round2 d a b c (aref m 7) 5 '(23170 . 31129)) - c (md4-round2 c d a b (aref m 11) 9 '(23170 . 31129)) - b (md4-round2 b c d a (aref m 15) 13 '(23170 . 31129)) - - a (md4-round3 a b c d (aref m 0) 3 '(28377 . 60321)) ;0x6ED9EBA1 - d (md4-round3 d a b c (aref m 8) 9 '(28377 . 60321)) - c (md4-round3 c d a b (aref m 4) 11 '(28377 . 60321)) - b (md4-round3 b c d a (aref m 12) 15 '(28377 . 60321)) - a (md4-round3 a b c d (aref m 2) 3 '(28377 . 60321)) - d (md4-round3 d a b c (aref m 10) 9 '(28377 . 60321)) - c (md4-round3 c d a b (aref m 6) 11 '(28377 . 60321)) - b (md4-round3 b c d a (aref m 14) 15 '(28377 . 60321)) - a (md4-round3 a b c d (aref m 1) 3 '(28377 . 60321)) - d (md4-round3 d a b c (aref m 9) 9 '(28377 . 60321)) - c (md4-round3 c d a b (aref m 5) 11 '(28377 . 60321)) - b (md4-round3 b c d a (aref m 13) 15 '(28377 . 60321)) - a (md4-round3 a b c d (aref m 3) 3 '(28377 . 60321)) - d (md4-round3 d a b c (aref m 11) 9 '(28377 . 60321)) - c (md4-round3 c d a b (aref m 7) 11 '(28377 . 60321)) - b (md4-round3 b c d a (aref m 15) 15 '(28377 . 60321))) - - (aset md4-buffer 0 (md4-add a (aref md4-buffer 0))) - (aset md4-buffer 1 (md4-add b (aref md4-buffer 1))) - (aset md4-buffer 2 (md4-add c (aref md4-buffer 2))) - (aset md4-buffer 3 (md4-add d (aref md4-buffer 3))) - )) - -(defun md4-copy64 (seq) - "Unpack a 64 bytes string into 16 pairs of 32 bits integers." - (let ((int32s (make-vector 16 0)) (i 0) j) - (while (< i 16) - (setq j (* i 4)) - (aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8)) - (+ (aref seq j) (lsh (aref seq (1+ j)) 8)))) - (setq i (1+ i))) - int32s)) - -;;; -;;; sub functions - -(defun md4-pack-int16 (int16) - "Pack 16 bits integer in 2 bytes string as little endian." - (let ((str (make-string 2 0))) - (aset str 0 (logand int16 255)) - (aset str 1 (lsh int16 -8)) - str)) - -(defun md4-pack-int32 (int32) - "Pack 32 bits integer in a 4 bytes string as little endian. A 32 bits -integer is represented as a pair of two 16 bits integers (cons high low)." - (let ((str (make-string 4 0)) - (h (car int32)) (l (cdr int32))) - (aset str 0 (logand l 255)) - (aset str 1 (lsh l -8)) - (aset str 2 (logand h 255)) - (aset str 3 (lsh h -8)) - str)) - -(defun md4-unpack-int16 (str) - (if (eq 2 (length str)) - (+ (lsh (aref str 1) 8) (aref str 0)) - (error "%s is not 2 bytes long" str))) - -(defun md4-unpack-int32 (str) - (if (eq 4 (length str)) - (cons (+ (lsh (aref str 3) 8) (aref str 2)) - (+ (lsh (aref str 1) 8) (aref str 0))) - (error "%s is not 4 bytes long" str))) - -(provide 'md4) - -;;; arch-tag: 99d706fe-089b-42ea-9507-67ae41091e6e -;;; md4.el ends here diff --git a/xemacs-packages/lisp/ecrypto/md5-dl.el b/xemacs-packages/lisp/ecrypto/md5-dl.el deleted file mode 100644 index bcbf8973..00000000 --- a/xemacs-packages/lisp/ecrypto/md5-dl.el +++ /dev/null @@ -1,55 +0,0 @@ -;;; md5-dl.el --- MD5 Message Digest Algorithm using DL module. - -;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. - -;; Author: Shuhei KOBAYASHI -;; Keywords: MD5, RFC 1321 - -;; This file is part of FLIM (Faithful Library about Internet Message). - -;; 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: - -;;; Code: - -(provide 'md5-dl) ; beware of circular dependency. -(eval-when-compile (require 'md5)) ; md5-dl-module. - -;;; This file is loaded (from "md5.el") only when md5-dl-module is exists. -(defvar md5-dl-handle (dynamic-link md5-dl-module)) - -;;; md5-dl-module provides `md5-string'. -(dynamic-call "emacs_md5_init" md5-dl-handle) - -(defun md5-region (beg end) - (md5-string (buffer-substring-no-properties beg end))) - -;;; Note that v21 `md5' takes two more args: CODING and NOERROR. -(defun md5 (object &optional beg end) - "Return the MD5 (a secure message digest algorithm) of an object. -OBJECT is either a string or a buffer. -Optional arguments BEG and END denote buffer positions for computing the -hash of a portion of OBJECT." - (if (stringp object) - (md5-string object) - (save-excursion - (set-buffer object) - (md5-region (or beg (point-min)) (or end (point-max)))))) - -(provide 'md5-dl) - -;;; md5-dl.el ends here diff --git a/xemacs-packages/lisp/ecrypto/md5-el.el b/xemacs-packages/lisp/ecrypto/md5-el.el deleted file mode 100644 index 4384f6ad..00000000 --- a/xemacs-packages/lisp/ecrypto/md5-el.el +++ /dev/null @@ -1,411 +0,0 @@ -;;; md5.el -- MD5 Message Digest Algorithm -;;; Gareth Rees - -;; LCD Archive Entry: -;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| -;; MD5 cryptographic message digest algorithm| -;; 13-Nov-95|1.0|~/misc/md5.el.Z| - -;;; Details: ------------------------------------------------------------------ - -;; This is a direct translation into Emacs LISP of the reference C -;; implementation of the MD5 Message-Digest Algorithm written by RSA -;; Data Security, Inc. -;; -;; The algorithm takes a message (that is, a string of bytes) and -;; computes a 16-byte checksum or "digest" for the message. This digest -;; is supposed to be cryptographically strong in the sense that if you -;; are given a 16-byte digest D, then there is no easier way to -;; construct a message whose digest is D than to exhaustively search the -;; space of messages. However, the robustness of the algorithm has not -;; been proven, and a similar algorithm (MD4) was shown to be unsound, -;; so treat with caution! -;; -;; The C algorithm uses 32-bit integers; because GNU Emacs -;; implementations provide 28-bit integers (with 24-bit integers on -;; versions prior to 19.29), the code represents a 32-bit integer as the -;; cons of two 16-bit integers. The most significant word is stored in -;; the car and the least significant in the cdr. The algorithm requires -;; at least 17 bits of integer representation in order to represent the -;; carry from a 16-bit addition. - -;;; Usage: -------------------------------------------------------------------- - -;; To compute the MD5 Message Digest for a message M (represented as a -;; string or as a vector of bytes), call -;; -;; (md5-encode M) -;; -;; which returns the message digest as a vector of 16 bytes. If you -;; need to supply the message in pieces M1, M2, ... Mn, then call -;; -;; (md5-init) -;; (md5-update M1) -;; (md5-update M2) -;; ... -;; (md5-update Mn) -;; (md5-final) - -;;; Copyright and licence: ---------------------------------------------------- - -;; Copyright (C) 1995, 1996, 1997 by Gareth Rees -;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm -;; -;; md5.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. -;; -;; md5.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. -;; -;; The original copyright notice is given below, as required by the -;; licence for the original code. This code is distributed under *both* -;; RSA's original licence and the GNU General Public Licence. (There -;; should be no problems, as the former is more liberal than the -;; latter). - -;;; Original copyright notice: ------------------------------------------------ - -;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. -;; -;; License to copy and use this software is granted provided that it is -;; identified as the "RSA Data Security, Inc. MD5 Message- Digest -;; Algorithm" in all material mentioning or referencing this software or -;; this function. -;; -;; License is also granted to make and use derivative works provided -;; that such works are identified as "derived from the RSA Data -;; Security, Inc. MD5 Message-Digest Algorithm" in all material -;; mentioning or referencing the derived work. -;; -;; RSA Data Security, Inc. makes no representations concerning either -;; the merchantability of this software or the suitability of this -;; software for any particular purpose. It is provided "as is" without -;; express or implied warranty of any kind. -;; -;; These notices must be retained in any copies of any part of this -;; documentation and/or software. - -;;; Code: --------------------------------------------------------------------- - -(defcustom md5-program "md5" - "*Program that reads a message on its standard input and writes an -MD5 digest on its output." - :type 'string) - -(defcustom md5-maximum-internal-length 4096 - "*The maximum size of a piece of data that should use the MD5 routines -written in lisp. If a message exceeds this, it will be run through an -external filter for processing. Also see the `md5-program' variable. -This variable has no effect if you call the md5-init|update|final -functions - only used by the `md5' function's simpler interface." - :type 'integer) - -(defvar md5-bits (make-vector 4 0) - "Number of bits handled, modulo 2^64. -Represented as four 16-bit numbers, least significant first.") -(defvar md5-buffer (make-vector 4 '(0 . 0)) - "Scratch buffer (four 32-bit integers).") -(defvar md5-input (make-vector 64 0) - "Input buffer (64 bytes).") - -(defun md5-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun md5-encode (message) - "Encodes MESSAGE using the MD5 message digest algorithm. -MESSAGE must be a string or an array of bytes. -Returns a vector of 16 bytes containing the message digest." - (if (or (null md5-maximum-internal-length) - (<= (length message) md5-maximum-internal-length)) - (progn - (md5-init) - (md5-update message) - (md5-final)) - (save-excursion - (set-buffer (get-buffer-create " *md5-work*")) - (erase-buffer) - (insert message) - (call-process-region (point-min) (point-max) - md5-program - t (current-buffer)) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (let ((data (buffer-substring (point-min) (+ (point-min) 32))) - (vec (make-vector 16 0)) - (ctr 0)) - (while (< ctr 16) - (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) - (md5-unhex (aref data (1+ (* ctr 2)))))) - (setq ctr (1+ ctr))))))) - -(defsubst md5-add (x y) - "Return 32-bit sum of 32-bit integers X and Y." - (let ((m (+ (car x) (car y))) - (l (+ (cdr x) (cdr y)))) - (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) - -;; FF, GG, HH and II are basic MD5 functions, providing transformations -;; for rounds 1, 2, 3 and 4 respectively. Each function follows this -;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x -;; by y bits to the left): -;; -;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b -;; -;; so we use the macro `md5-make-step' to construct each one. The -;; helper functions F, G, H and I operate on 16-bit numbers; the full -;; operation splits its inputs, operates on the halves separately and -;; then puts the results together. - -(defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) -(defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) -(defsubst md5-H (x y z) (logxor x y z)) -(defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) - -(defmacro md5-make-step (name func) - (` - (defun (, name) (a b c d x s ac) - (let* - ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) - (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) - (m2 (logand 65535 (+ m1 (lsh l1 -16)))) - (l2 (logand 65535 l1)) - (m3 (logand 65535 (if (> s 15) - (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) - (+ (lsh m2 s) (lsh l2 (- s 16)))))) - (l3 (logand 65535 (if (> s 15) - (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) - (+ (lsh l2 s) (lsh m2 (- s 16))))))) - (md5-add (cons m3 l3) b))))) - -(md5-make-step md5-FF md5-F) -(md5-make-step md5-GG md5-G) -(md5-make-step md5-HH md5-H) -(md5-make-step md5-II md5-I) - -(defun md5-init () - "Initialise the state of the message-digest routines." - (aset md5-bits 0 0) - (aset md5-bits 1 0) - (aset md5-bits 2 0) - (aset md5-bits 3 0) - (aset md5-buffer 0 '(26437 . 8961)) - (aset md5-buffer 1 '(61389 . 43913)) - (aset md5-buffer 2 '(39098 . 56574)) - (aset md5-buffer 3 '( 4146 . 21622))) - -(defun md5-update (string) - "Update the current MD5 state with STRING (an array of bytes)." - (let ((len (length string)) - (i 0) - (j 0)) - (while (< i len) - ;; Compute number of bytes modulo 64 - (setq j (% (/ (aref md5-bits 0) 8) 64)) - - ;; Store this byte (truncating to 8 bits to be sure) - (aset md5-input j (logand 255 (aref string i))) - - ;; Update number of bits by 8 (modulo 2^64) - (let ((c 8) (k 0)) - (while (and (> c 0) (< k 4)) - (let ((b (aref md5-bits k))) - (aset md5-bits k (logand 65535 (+ b c))) - (setq c (if (> b (- 65535 c)) 1 0) - k (1+ k))))) - - ;; Increment number of bytes processed - (setq i (1+ i)) - - ;; When 64 bytes accumulated, pack them into sixteen 32-bit - ;; integers in the array `in' and then transform them. - (if (= j 63) - (let ((in (make-vector 16 (cons 0 0))) - (k 0) - (kk 0)) - (while (< k 16) - (aset in k (md5-pack md5-input kk)) - (setq k (+ k 1) kk (+ kk 4))) - (md5-transform in)))))) - -(defun md5-pack (array i) - "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." - (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) - (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) - -(defun md5-byte (array n b) - "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." - (let ((e (aref array n))) - (cond ((eq b 0) (logand 255 (cdr e))) - ((eq b 1) (lsh (cdr e) -8)) - ((eq b 2) (logand 255 (car e))) - ((eq b 3) (lsh (car e) -8))))) - -(defun md5-final () - (let ((in (make-vector 16 (cons 0 0))) - (j 0) - (digest (make-vector 16 0)) - (padding)) - - ;; Save the number of bits in the message - (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) - (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) - - ;; Compute number of bytes modulo 64 - (setq j (% (/ (aref md5-bits 0) 8) 64)) - - ;; Pad out computation to 56 bytes modulo 64 - (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) - (aset padding 0 128) - (md5-update padding) - - ;; Append length in bits and transform - (let ((k 0) (kk 0)) - (while (< k 14) - (aset in k (md5-pack md5-input kk)) - (setq k (+ k 1) kk (+ kk 4)))) - (md5-transform in) - - ;; Store the results in the digest - (let ((k 0) (kk 0)) - (while (< k 4) - (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) - (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) - (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) - (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) - (setq k (+ k 1) kk (+ kk 4)))) - - ;; Return digest - digest)) - -;; It says in the RSA source, "Note that if the Mysterious Constants are -;; arranged backwards in little-endian order and decrypted with the DES -;; they produce OCCULT MESSAGES!" Security through obscurity? - -(defun md5-transform (in) - "Basic MD5 step. Transform md5-buffer based on array IN." - (let ((a (aref md5-buffer 0)) - (b (aref md5-buffer 1)) - (c (aref md5-buffer 2)) - (d (aref md5-buffer 3))) - (setq - a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) - d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) - c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) - b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) - a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) - d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) - c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) - b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) - a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) - d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) - c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) - b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) - a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) - d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) - c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) - b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) - a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) - d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) - c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) - b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) - a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) - d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) - c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) - b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) - a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) - d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) - c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) - b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) - a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) - d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) - c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) - b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) - a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) - d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) - c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) - b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) - a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) - d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) - c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) - b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) - a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) - d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) - c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) - b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) - a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) - d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) - c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) - b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) - a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) - d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) - c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) - b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) - a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) - d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) - c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) - b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) - a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) - d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) - c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) - b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) - a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) - d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) - c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) - b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) - - (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) - (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) - (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) - (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Here begins the merger with the XEmacs API and the md5.el from the URL -;;; package. Courtesy wmperry@cs.indiana.edu -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;###autoload -(defun md5 (object &optional start end) - "Return the MD5 (a secure message digest algorithm) of an object. -OBJECT is either a string or a buffer. -Optional arguments START and END denote buffer positions for computing the -hash of a portion of OBJECT." - (let ((buffer nil)) - (unwind-protect - (save-excursion - (setq buffer (generate-new-buffer " *md5-work*")) - (set-buffer buffer) - (cond - ((bufferp object) - (insert-buffer-substring object start end)) - ((stringp object) - (insert (if (or start end) - (substring object start end) - object))) - (t nil)) - (prog1 - (if (or (null md5-maximum-internal-length) - (<= (point-max) md5-maximum-internal-length)) - (mapconcat - (function (lambda (node) (format "%02x" node))) - (md5-encode (buffer-string)) - "") - (call-process-region (point-min) (point-max) - shell-file-name - t buffer nil - shell-command-switch md5-program) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (buffer-substring (point-min) (+ (point-min) 32))) - (kill-buffer buffer))) - (and buffer (buffer-name buffer) (kill-buffer buffer) nil)))) - -(provide 'md5-el) diff --git a/xemacs-packages/lisp/ecrypto/md5.el b/xemacs-packages/lisp/ecrypto/md5.el deleted file mode 100644 index 8c4d7c05..00000000 --- a/xemacs-packages/lisp/ecrypto/md5.el +++ /dev/null @@ -1,79 +0,0 @@ -;;; md5.el --- MD5 Message Digest Algorithm. - -;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. - -;; Author: Shuhei KOBAYASHI -;; Keywords: MD5, RFC 1321 - -;; This file is part of FLIM (Faithful Library about Internet Message). - -;; 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: - -;; Test cases from RFC 1321. -;; -;; (md5 "") -;; => d41d8cd98f00b204e9800998ecf8427e -;; -;; (md5 "a") -;; => 0cc175b9c0f1b6a831c399e269772661 -;; -;; (md5 "abc") -;; => 900150983cd24fb0d6963f7d28e17f72 -;; -;; (md5 "message digest") -;; => f96b697d7cb7938d525a2f31aaf161d0 -;; -;; (md5 "abcdefghijklmnopqrstuvwxyz") -;; => c3fcd3d76192e4007dfb496cca67e13b -;; -;; (md5 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") -;; => d174ab98d277d9f5a5611c2c9f419d9f -;; -;; (md5 "12345678901234567890123456789012345678901234567890123456789012345678901234567890") -;; => 57edf4a22be3c955ac49da2e2107b67a - -;;; Code: - -(defvar md5-dl-module - (cond - ((and (fboundp 'md5) - (subrp (symbol-function 'md5))) - nil) - ((fboundp 'dynamic-link) - ;; Should we take care of `dynamic-link-path'? - (let ((path (expand-file-name "md5.so" exec-directory))) - (if (file-exists-p path) - path - nil))) - (t - nil))) - -(cond - ((and (fboundp 'md5) - (subrp (symbol-function 'md5))) - ;; do nothing. - ) - ((and (stringp md5-dl-module) - (file-exists-p md5-dl-module)) - (require 'md5-dl)) - (t - (require 'md5-el))) - -(provide 'md5) - -;;; md5.el ends here diff --git a/xemacs-packages/lisp/ecrypto/paranoid.el b/xemacs-packages/lisp/ecrypto/paranoid.el deleted file mode 100644 index 4f5b3ae2..00000000 --- a/xemacs-packages/lisp/ecrypto/paranoid.el +++ /dev/null @@ -1,87 +0,0 @@ -;;; paranoid.el -- even more paranoid password prompter - -;; Copyright (C) 1998 Ray Jones - -;; Author: Ray Jones, rjones@pobox.com -;; Keywords: password, comint -;; Created: 1998-05-20 - -;; 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.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA. - -;;; Commentary: - -;; taken from comint.el, so it doesn't have to be loaded in its -;; entirety, and made a little more paranoid. - -;; (defun comint-read-noecho (prompt &optional stars) ...) -(defun prompt-paranoidly (prompt) - - "Read a single line of text from user without echoing, and return -it. Prompt with argument PROMPT, a string. Input ends with RET, LFD, -or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts (if -`inhibit-quit' is set because e.g. this function was called from a -process filter and C-g is pressed, this function returns nil rather -than a string). - -Note that the keystrokes comprising the text can still be recovered -\(temporarily) with \\[view-lossage]. Some people find this worrysome. -Once the caller uses the password, it can erase the password -by doing \(fillarray STRING 0)." - (let ((ans "") - (newans nil) - (c 0) - (echo-keystrokes 0) - (cursor-in-echo-area t) - (message-log-max nil) - (done nil)) - (while (not done) - (message "%s" prompt) - ;; Use this instead of `read-char' to avoid "Non-character input-event". - (setq c (read-char-exclusive)) - (cond ((= c ?\C-g) - ;; This function may get called from a process filter, where - ;; inhibit-quit is set. In later versions of emacs read-char - ;; may clear quit-flag itself and return C-g. That would make - ;; it impossible to quit this loop in a simple way, so - ;; re-enable it here (for backward-compatibility the check for - ;; quit-flag below would still be necessary, so this seems - ;; like the simplest way to do things). - (fillarray ans 0) - (setq quit-flag t - done t)) - ((or (= c ?\r) (= c ?\n) (= c ?\e)) - (setq done t)) - ((= c ?\C-u) - (fillarray ans 0) - (setq ans "")) - ((and (/= c ?\b) (/= c ?\177)) - (setq newans (concat ans (char-to-string c))) - (fillarray ans 0) - (setq ans newans)) - ((> (length ans) 0) - (setq newans (substring ans 0 -1)) - (fillarray ans 0) - (setq ans newans)))) - (if quit-flag - ;; Emulate a true quit, except that we have to return a value. - (prog1 - (setq quit-flag nil) - (message "Quit") - (beep t)) - (message "") - ans))) - -(provide 'paranoid) diff --git a/xemacs-packages/lisp/ecrypto/password.el b/xemacs-packages/lisp/ecrypto/password.el deleted file mode 100644 index d30cf7b5..00000000 --- a/xemacs-packages/lisp/ecrypto/password.el +++ /dev/null @@ -1,192 +0,0 @@ -;;; password.el --- Read passwords from user, possibly using a password cache. - -;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc. - -;; Author: Simon Josefsson -;; Created: 2003-12-21 -;; Keywords: password cache passphrase key - -;; 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: - -;; Greatly influenced by pgg.el written by Daiki Ueno, with timer -;; fixes for XEmacs by Katsumi Yamaoka. In fact, this is mostly just -;; a rip-off. -;; -;; (password-read "Password? " "test") -;; ;; Minibuffer prompt for password. -;; => "foo" -;; -;; (password-cache-add "test" "foo") -;; => nil - -;; Note the previous two can be replaced with: -;; (password-read-and-add "Password? " "test") -;; ;; Minibuffer prompt for password. -;; => "foo" -;; ;; "foo" is now cached with key "test" - - -;; (password-read "Password? " "test") -;; ;; No minibuffer prompt -;; => "foo" -;; -;; (password-read "Password? " "test") -;; ;; No minibuffer prompt -;; => "foo" -;; -;; ;; Wait `password-cache-expiry' seconds. -;; -;; (password-read "Password? " "test") -;; ;; Minibuffer prompt for password is back. -;; => "foo" - -;;; Code: - -(eval-when-compile - (require 'cl)) - -;; XEmacs has a buggy version of run-at-time. This defines a -;; non-buggy version of the same. -(defalias - 'password-run-at-time - (if (condition-case nil - (progn - (unless (or itimer-process itimer-timer) - (itimer-driver-start)) - ;; Check whether there is a bug to which the difference of - ;; the present time and the time when the itimer driver was - ;; woken up is subtracted from the initial itimer value. - (let* ((inhibit-quit t) - (ctime (current-time)) - (itimer-timer-last-wakeup - (prog1 - ctime - (setcar ctime (1- (car ctime))))) - (itimer-list nil) - (itimer (start-itimer "run-at-time" 'ignore 5))) - (sleep-for 0.1) ;; Accept the timeout interrupt. - (prog1 - (> (itimer-value itimer) 0) - (delete-itimer itimer)))) - (error nil)) - (lambda (time repeat function &rest args) - "Function emulating the function of the same name of Emacs. -TIME should be nil meaning now, or a number of seconds from now. -Return an itimer object which can be used in either `delete-itimer' -or `cancel-timer'." - (apply #'start-itimer "run-at-time" - function (if time (max time 1e-9) 1e-9) - repeat nil t args)) - (lambda (time repeat function &rest args) - "Function emulating the function of the same name of Emacs. -It works correctly for TIME even if there is a bug in the XEmacs core. -TIME should be nil meaning now, or a number of seconds from now. -Return an itimer object which can be used in either `delete-itimer' -or `cancel-timer'." - (let ((itimers (list nil))) - (setcar - itimers - (apply #'start-itimer "fixed-run-at-time" - (lambda (itimers repeat function &rest args) - (let ((itimer (car itimers))) - (if repeat - (progn - (set-itimer-function - itimer - (lambda (itimer repeat function &rest args) - (set-itimer-restart itimer repeat) - (set-itimer-function itimer function) - (set-itimer-function-arguments itimer args) - (apply function args))) - (set-itimer-function-arguments - itimer - (append (list itimer repeat function) args))) - (set-itimer-function - itimer - (lambda (itimer function &rest args) - (delete-itimer itimer) - (apply function args))) - (set-itimer-function-arguments - itimer - (append (list itimer function) args))))) - 1e-9 (if time (max time 1e-9) 1e-9) - nil t itimers repeat function args)))))) - -(defcustom password-cache t - "Whether to cache passwords." - :group 'password - :type 'boolean) - -(defcustom password-cache-expiry 16 - "How many seconds passwords are cached, or nil to disable expiring. -Whether passwords are cached at all is controlled by `password-cache'." - :group 'password - :type '(choice (const :tag "Never" nil) - (integer :tag "Seconds"))) - -(defvar password-data (make-vector 7 0)) - -(defun password-read (prompt &optional key) - "Read password, for use with KEY, from user, or from cache if wanted. -KEY indicate the purpose of the password, so the cache can -separate passwords. The cache is not used if KEY is nil. It is -typically a string. -The variable `password-cache' control whether the cache is used." - (or (and password-cache - key - (symbol-value (intern-soft key password-data))) - (read-passwd prompt))) - -(defun password-read-and-add (prompt &optional key) - "Read password, for use with KEY, from user, or from cache if wanted. -Then store the password in the cache. Uses `password-read' and -`password-cache-add'." - (let ((password (password-read prompt key))) - (when (and password key) - (password-cache-add key password)) - password)) - -(defun password-cache-remove (key) - "Remove password indexed by KEY from password cache. -This is typically run be a timer setup from `password-cache-add', -but can be invoked at any time to forcefully remove passwords -from the cache. This may be useful when it has been detected -that a password is invalid, so that `password-read' query the -user again." - (let ((password (symbol-value (intern-soft key password-data)))) - (when password - (fillarray password ?_) - (unintern key password-data)))) - -(defun password-cache-add (key password) - "Add password to cache. -The password is removed by a timer after `password-cache-expiry' -seconds." - (set (intern key password-data) password) - (when password-cache-expiry - (password-run-at-time password-cache-expiry nil - #'password-cache-remove - key)) - nil) - -(provide 'password) - -;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5 -;;; password.el ends here diff --git a/xemacs-packages/lisp/ecrypto/rander.el b/xemacs-packages/lisp/ecrypto/rander.el deleted file mode 100644 index f51523b7..00000000 --- a/xemacs-packages/lisp/ecrypto/rander.el +++ /dev/null @@ -1,137 +0,0 @@ -;;; rander.el -- possibly better random numbers, using rc16 as a RNG - -;; Copyright (C) 1998 Ray Jones - -;; Author: Ray Jones, rjones@pobox.com -;; Keywords: RNG, rc4, rc16, stream cipher -;; Created: 1998-04-14 - -;; 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.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA. - - -(require 'cl) -(require 'rc16) - -(defvar *rander-file* (expand-file-name "~/.emacs.rander")) -(defvar *rander-file-length* 512) - -;;; Initialization of the random state - -;; generate a string with random information in it -(defun rander-noise-string () - (concat - ;; randomness from before - (if (file-readable-p *rander-file*) - (let ((buf nil)) - (unwind-protect - (progn - (setq buf (generate-new-buffer "randerdata")) - (save-excursion - (set-buffer buf) - (insert-file-contents-literally *rander-file*) - (buffer-string))) - (if buf - (let ((kill-buffer-hook nil)) - (kill-buffer buf)))))) - - ;; allocation randomness - (if (boundp 'cons-cells-consed) - (apply 'concat - (mapcar 'int-to-string - (list cons-cells-consed - floats-consed - intervals-consed - misc-objects-consed - string-chars-consed - symbols-consed - vector-cells-consed))) - "") - - ;; time randomness - (apply 'concat (mapcar 'int-to-string (current-time))) - - ;; process randomness - (int-to-string (emacs-pid)))) - - -;;; Mixin keypress randomness, on the fly - -;; don't use this if your (current-time) is not fine grained in the -;; microseconds. or if your computer is particularly slow, and the -;; pre-command-hook stuff slows it down (unlikely). -(defvar *rander-use-keypress* t) -;; this number shouldn't be too high, as a call to (rander16) will -;; have to mixin up to this many values before actually returning -(defvar *rander-keypress-count* 128) -(defvar *rander-keypress-timings* - (and *rander-use-keypress* - (make-vector *rander-keypress-count* 0))) -(defvar *rander-keypress-have* 0) - -(defun rander-store-key-time () - "store keypress timings until we have filled the keypress timings buffer" - (when (< *rander-keypress-have* *rander-keypress-count*) - (aset *rander-keypress-timings* - *rander-keypress-have* - (nth 2 (current-time))) - (incf *rander-keypress-have*))) - -(if *rander-use-keypress* - (add-hook 'pre-command-hook 'rander-store-key-time)) - -;;; main source of randomness, the rc16 generator -(defvar *rander-initialized* nil) -(defvar *rander-rc16-context* nil) - -(defun rander-init () - (setq *rander-rc16-context* (rc16-create-context)) - (rc16-set-key *rander-rc16-context* (rander-noise-string)) - (add-hook 'kill-emacs-hook 'rander-write-file) - (setq *rander-initialized* t)) - -(defun rander16 () - (if (not *rander-initialized*) - (rander-init)) - (when (and *rander-use-keypress* - (not (zerop *rander-keypress-have*))) - ;; mixin all the keypresses we have stored to this point - (dotimes (idx *rander-keypress-have*) - (rc16-mixin *rander-rc16-context* - (aref *rander-keypress-timings* idx))) - ;; reset the buffer - (setq *rander-keypress-have* 0)) - - ;; return a random value - (rc16-short *rander-rc16-context*)) - -(defun rander-write-file () - "write out a seed file for the next time rander is used. called at -the exit of emacs." - (let ((buf nil)) - (unwind-protect - (progn - (setq buf (generate-new-buffer "randerdata")) - (save-excursion - (set-buffer buf) - (dotimes (count *rander-file-length*) - (insert (logand ?\xff (rander16)))) - (let ((backup-inhibited t)) - (write-file *rander-file*)))) - (if buf - (let ((kill-buffer-hook nil)) - (kill-buffer buf)))))) - -(provide 'rander) diff --git a/xemacs-packages/lisp/ecrypto/rc16.el b/xemacs-packages/lisp/ecrypto/rc16.el deleted file mode 100644 index 911a4507..00000000 --- a/xemacs-packages/lisp/ecrypto/rc16.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; rc16.el -- rc16, by proff@iq.org, translated to elisp - -;; Copyright (C) 1998 Ray Jones - -;; Author: Ray Jones, rjones@pobox.com -;; Keywords: RNG, rc4, rc16, stream cipher -;; Created: 1998-04-14 - -;; 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.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA. - - -;; rc16-context functions -(defun rc16-create-context () - (vector 0 0 (make-vector 65536 0))) - -(defsubst rc16-context-x (context) - (aref context 0)) - -(defsubst rc16-context-y (context) - (aref context 1)) - -(defsubst rc16-context-state (context) - (aref context 2)) - -;; sigh. why doesn't elisp have (setf (aref ...))? -(defsubst rc16-context-set-x (context val) - (aset context 0 val)) - -(defsubst rc16-context-set-y (context val) - (aset context 1 val)) - -;; set a key, init the context -(defun rc16-set-key (context key) - (let ((state (rc16-context-state context))) - ;; init context - (rc16-context-set-x context 0) - (rc16-context-set-y context 0) - (let ((counter 0)) - (while (< counter 65536) - (aset state counter counter) - (setq counter (1+ counter)))) - - ;; mix in key - (let ((keyidx 0) - (keylen (length key)) - (stateidx 0) - (counter 0) - temp1 temp2) - (while (< counter 65536) - (setq temp1 (aref state counter)) - (setq stateidx (logand ?\xffff (+ stateidx temp1 (aref key keyidx)))) - (setq temp2 (aref state stateidx)) - (aset state stateidx temp1) - (aset state counter temp2) - (setq keyidx (1+ keyidx)) - (if (= keyidx keylen) (setq keyidx 0)) - (setq counter (1+ counter)))))) - -;; mixin some randomness, a little at a time -;; added by Ray. is this a good thing? -(defun rc16-mixin (context val) - (let* ((state (rc16-context-state context)) - (x (logand ?\xffff (1+ (rc16-context-x context)))) - (sx (aref state x)) - (y (logand ?\xffff - (logxor val - (+ sx (rc16-context-y context))))) - (sy (aref state y))) - (rc16-context-set-x context x) - (rc16-context-set-y context y) - (aset state y sx) - (aset state x sy) - nil)) - -;; return a random value -(defun rc16-short (context) - (let* ((state (rc16-context-state context)) - (x (logand ?\xffff (1+ (rc16-context-x context)))) - (sx (aref state x)) - (y (logand ?\xffff (+ sx (rc16-context-y context)))) - (sy (aref state y))) - (rc16-context-set-x context x) - (rc16-context-set-y context y) - (aset state y sx) - (aset state x sy) - (aref state (logand ?\xffff (+ sx sy))))) - -(defun rc16-encrypt (context data) - (let* ((cipher (make-string (length data) 0)) - (rc16-val (rc16-short context)) - (hi-byte (ash rc16-val -8)) - (lo-byte (logand rc16-val 255)) - (bytes-left 2) - (count 0) - (length (length data))) - (while (< count length) - (aset cipher count (logxor (aref data count) hi-byte)) - (setq bytes-left (1- bytes-left)) - (if (= bytes-left 0) - (progn - (setq bytes-left 2) - (setq rc16-val (rc16-short context)) - (setq hi-byte (ash rc16-val -8)) - (setq lo-byte (logand rc16-val 255))) - (setq hi-byte lo-byte)) - (setq count (1+ count))) - cipher)) - -(provide 'rc16) diff --git a/xemacs-packages/lisp/ecrypto/rijndael.el b/xemacs-packages/lisp/ecrypto/rijndael.el deleted file mode 100644 index 019983a3..00000000 --- a/xemacs-packages/lisp/ecrypto/rijndael.el +++ /dev/null @@ -1,843 +0,0 @@ -;;; rijndael.el --- Rijndael (AES) block cipher implementation -;; Copyright (C) 2001 Simon Josefsson - -;; Author: Simon Josefsson -;; Keywords: rijndael aes block cipher symmetric encryption cryptography - -;; This software is provided as-is, without express or implied -;; warranty. Permission to use, copy, modify, distribute or sell this -;; software, without fee, for any purpose and by any individual or -;; organization, is hereby granted, provided that the above copyright -;; notice and this paragraph appear in all copies. - -;;; Commentary: - -;; This is a implementation of the Rijndael block cipher algorithm in -;; Emacs Lisp. Rijndael has been chosen as the Advanced Encryption -;; Standard (AES) by NIST. -;; -;; This package also have functionality to generate (some of) NIST's -;; Rijndael test vectors. However, they will take a very long time to -;; generate in elisp. You can customize `rijndael-monte-carlo-limit' -;; from the default of 10,000 into something more sensible as, say, 1 -;; to make it faster. It is also possible to customize the loop -;; length defined by `rijndael-monte-carlo-loop' from the default 400. -;; Of course, you need to modify the reference implementation as well -;; if you want to make useful comparisons of the test vectors. -;; -;; Rijndael home page is at: -;; http://www.esat.kuleuven.ac.be/~rijmen/rijndael/ -;; -;; Any updated releases of this file will be located at: -;; http://josefsson.org/aes/ - -;;; Instructions: - -;; Call functions in Emacs Lisp programs, or use this package -;; interactively in the *scratch* buffer in emacs. -;; -;; Here's how you could do a simple encryption interactively (press -;; C-j to evaluate each line): -;; -;; (setq key (rijndael-make-key 128 (rijndael-hexstring-to-bitstring -;; "00000000000000000000000000000000"))) -;; -;; (setq data (rijndael-hexstring-to-bitstring -;; "00000000000000000000000000000000")) -;; -;; (rijndael-bitstring-to-hexstring -;; (rijndael-block-encrypt data key 'ecb 128)) -;; -;; Or more compact as: -;; -;; (rijndael-bitstring-to-hexstring -;; (rijndael-block-encrypt -;; (rijndael-hexstring-to-bitstring "00000000000000000000000000000000") -;; (rijndael-make-key 128 (rijndael-hexstring-to-bitstring -;; "00000000000000000000000000000000")) -;; 'ecb 128)) -;; -;; For reference, correct output is "66e94bd4ef8a2c3b884cfa59ca342b2e". -;; -;; NB! `data' will be destructively modified. - -;;; Todo: - -;; Other modes than ECB. - -;;; Revision history: - -;; 2001-03-31 Posted to gnu.emacs.sources. -;; 2001-04-04 Ported to (X)Emacs 19. -;; 2001-05-10 Supports 160 and 224 key and block sizes. -;; 2001-09-27 Posted to gnu.emacs.sources. - - -;;; Code: - -;; User variables: - -(eval-and-compile - ;; Provide dummy customize functions for emacsen that doesn't have them. - (if (not (and (or (featurep 'custom) (load "custom" t)) - (fboundp 'defcustom) (fboundp 'defgroup))) - (progn - (if (not (fboundp 'defcustom)) - (defmacro defcustom (var value doc &rest args) - (list 'defvar var value doc))) - (if (not (fboundp 'defgroup)) - (defmacro defgroup (&rest args)))))) - -(defgroup rijndael nil - "Rijndael cryptographic functions") - -(defcustom rijndael-monte-carlo-limit 10000 - "How many iterations to do in the Monte-Carlo tests. -NIST uses 10000 (the default), but this will be very slow, so you may -change this to a lower value (like, say, 1). Of course, you must -modify the Rijndael reference implementation to be able to compare the -output." - :group 'rijndael - :type 'integer) - -(defcustom rijndael-monte-carlo-loop 400 - "How many iterations to do in the Monte-Carlo tests. -NIST uses 400 (the default), but this will be very slow, so you may -change this to a lower value (like, say, 1). Of course, you must -modify the Rijndael reference implementation to be able to compare the -output." - :group 'rijndael - :type 'integer) - - -;; Internal constants: - -(defconst rijndael-Logtable - [ 0 0 25 1 50 2 26 198 75 199 27 104 51 238 223 3 - 100 4 224 14 52 141 129 239 76 113 8 200 248 105 28 193 - 125 194 29 181 249 185 39 106 77 228 166 114 154 201 9 120 - 101 47 138 5 33 15 225 36 18 240 130 69 53 147 218 142 - 150 143 219 189 54 208 206 148 19 92 210 241 64 70 131 56 - 102 221 253 48 191 6 139 98 179 37 226 152 34 136 145 16 - 126 110 72 195 163 182 30 66 58 107 40 84 250 133 61 186 - 43 121 10 21 155 159 94 202 78 212 172 229 243 115 167 87 - 175 88 168 80 244 234 214 116 79 174 233 213 231 230 173 232 - 44 215 117 122 235 22 11 245 89 203 95 176 156 169 81 160 - 127 12 246 111 23 196 73 236 216 67 31 45 164 118 123 183 - 204 187 62 90 251 96 177 134 59 82 161 108 170 85 41 157 - 151 178 135 144 97 190 220 252 188 149 207 205 55 63 91 209 - 83 57 132 60 65 162 109 71 20 42 158 93 86 242 211 171 - 68 17 146 217 35 32 46 137 180 124 184 38 119 153 227 165 - 103 74 237 222 197 49 254 24 13 99 140 128 192 247 112 7] - "Multiplication in GF(2^8) lookup table.") - -(defconst rijndael-Alogtable - [ 1 3 5 15 17 51 85 255 26 46 114 150 161 248 19 53 - 95 225 56 72 216 115 149 164 247 2 6 10 30 34 102 170 - 229 52 92 228 55 89 235 38 106 190 217 112 144 171 230 49 - 83 245 4 12 20 60 68 204 79 209 104 184 211 110 178 205 - 76 212 103 169 224 59 77 215 98 166 241 8 24 40 120 136 - 131 158 185 208 107 189 220 127 129 152 179 206 73 219 118 154 - 181 196 87 249 16 48 80 240 11 29 39 105 187 214 97 163 - 254 25 43 125 135 146 173 236 47 113 147 174 233 32 96 160 - 251 22 58 78 210 109 183 194 93 231 50 86 250 21 63 65 - 195 94 226 61 71 201 64 192 91 237 44 116 156 191 218 117 - 159 186 213 100 172 239 42 126 130 157 188 223 122 142 137 128 - 155 182 193 88 232 35 101 175 234 37 111 177 200 67 197 84 - 252 31 33 99 165 244 7 9 27 45 119 153 176 203 70 202 - 69 207 74 222 121 139 134 145 168 227 62 66 198 81 243 14 - 18 54 90 238 41 123 141 140 143 138 133 148 167 242 13 23 - 57 75 221 124 132 151 162 253 28 36 108 180 199 82 246 1] - "Multiplication in GF(2^8) lookup table.") - -(defconst rijndael-S - [ 99 124 119 123 242 107 111 197 48 1 103 43 254 215 171 118 - 202 130 201 125 250 89 71 240 173 212 162 175 156 164 114 192 - 183 253 147 38 54 63 247 204 52 165 229 241 113 216 49 21 - 4 199 35 195 24 150 5 154 7 18 128 226 235 39 178 117 - 9 131 44 26 27 110 90 160 82 59 214 179 41 227 47 132 - 83 209 0 237 32 252 177 91 106 203 190 57 74 76 88 207 - 208 239 170 251 67 77 51 133 69 249 2 127 80 60 159 168 - 81 163 64 143 146 157 56 245 188 182 218 33 16 255 243 210 - 205 12 19 236 95 151 68 23 196 167 126 61 100 93 25 115 - 96 129 79 220 34 42 144 136 70 238 184 20 222 94 11 219 - 224 50 58 10 73 6 36 92 194 211 172 98 145 149 228 121 - 231 200 55 109 141 213 78 169 108 86 244 234 101 122 174 8 - 186 120 37 46 28 166 180 198 232 221 116 31 75 189 139 138 - 112 62 181 102 72 3 246 14 97 53 87 185 134 193 29 158 - 225 248 152 17 105 217 142 148 155 30 135 233 206 85 40 223 - 140 161 137 13 191 230 66 104 65 153 45 15 176 84 187 22] - "Rijndael S-box.") - -(defconst rijndael-Si - [ 82 9 106 213 48 54 165 56 191 64 163 158 129 243 215 251 - 124 227 57 130 155 47 255 135 52 142 67 68 196 222 233 203 - 84 123 148 50 166 194 35 61 238 76 149 11 66 250 195 78 - 8 46 161 102 40 217 36 178 118 91 162 73 109 139 209 37 - 114 248 246 100 134 104 152 22 212 164 92 204 93 101 182 146 - 108 112 72 80 253 237 185 218 94 21 70 87 167 141 157 132 - 144 216 171 0 140 188 211 10 247 228 88 5 184 179 69 6 - 208 44 30 143 202 63 15 2 193 175 189 3 1 19 138 107 - 58 145 17 65 79 103 220 234 151 242 207 206 240 180 230 115 - 150 172 116 34 231 173 53 133 226 249 55 232 28 117 223 110 - 71 241 26 113 29 41 197 137 111 183 98 14 170 24 190 27 - 252 86 62 75 198 210 121 32 154 219 192 254 120 205 90 244 - 31 221 168 51 136 7 199 49 177 18 16 89 39 128 236 95 - 96 81 127 169 25 181 74 13 45 229 122 159 147 201 156 239 - 160 224 59 77 174 42 245 176 200 235 187 60 131 83 153 97 - 23 43 4 126 186 119 214 38 225 105 20 99 85 33 12 125] - "Rijndael inverted S-box.") - -(defconst rijndael-rcon [ ?\x01 ?\x02 ?\x04 ?\x08 ?\x10 ?\x20 ?\x40 ?\x80 - ?\x1b ?\x36 ?\x6c ?\xd8 ?\xab ?\x4d ?\x9a ?\x2f - ?\x5e ?\xbc ?\x63 ?\xc6 ?\x97 ?\x35 ?\x6a ?\xd4 - ?\xb3 ?\x7d ?\xfa ?\xef ?\xc5 ?\x91] - "Rijndael round constants used in key scheduling.") - -(defconst rijndael-shifts [[[0 0] - [1 3] - [2 2] - [3 1]] - - [[0 0] - [1 4] - [2 3] - [3 2]] - - [[0 0] - [1 5] - [2 4] - [3 3]] - - [[0 0] - [1 6] - [2 5] - [4 3]] - - [[0 0] - [1 7] - [3 5] - [4 4]]] - "Rijndael shift offsets. -Element M is used when blocksizes match M=Nb-4. -Element N inside a shift amount for each blocksize corresponds with -the row to shift. -The first element O1 of each row corresponds with encryption offset, -the second element O2 to decryption offset. (O2 inverse of O1 under mod Nb.)") - -(defconst rijndael-maxbc (/ 256 32) - "Rijndael maximum size of data blocks.") - -(defconst rijndael-maxkc (/ 256 32) - "Rijndael maximum size of key blocks.") - -(defconst rijndael-maxrounds 14 - "Rijndael maximum number of rounds.") - -(defconst rijndael-hex-alist - '((?0 . 0) (?a . 10) (?A . 10) - (?1 . 1) (?b . 11) (?B . 11) - (?2 . 2) (?c . 12) (?C . 12) - (?3 . 3) (?d . 13) (?D . 13) - (?4 . 4) (?e . 14) (?E . 14) - (?5 . 5) (?f . 15) (?F . 15) - (?6 . 6) - (?7 . 7) - (?8 . 8) - (?9 . 9)) - "Hex table for use in base conversions.") - - -;; Basic low-level cryptograhic primitives: - -(defsubst rijndael-mul (a b) - "Rijndael MUL primitive. -Multiply two elements of GF(2^m). -needed for MixColumn and InvMixColumn." - (if (and (not (= a 0)) - (not (= b 0))) - (aref rijndael-Alogtable (% (+ (aref rijndael-Logtable a) - (aref rijndael-Logtable b)) - 255)) - 0)) - -(defsubst rijndael-key-addition (a rk bc) - "Rijndael keyAddition primitive. -Exor corresponding text input and round key input bytes." - (let ((i 0) j) - (while (< i 4) - (setq j 0) - (while (< j bc) - (aset (aref a i) j - (logxor (aref (aref a i) j) - (aref (aref rk i) j))) - (setq j (1+ j))) - (setq i (1+ i))))) - -(defsubst rijndael-shift-row (a d bc) - "Rijndael ShiftRow primitive. -Row 0 remains unchanged. -The other three rows are shifted a variable amount." - (let (i j (tmp (make-vector rijndael-maxbc 0))) - (setq i 1) - (while (< i 4) - (setq j 0) - (while (< j bc) - (aset tmp j - (aref (aref a i) - (% (+ j (aref (aref (aref rijndael-shifts - (- bc 4)) - i) - d)) - bc))) - (setq j (1+ j))) - (setq j 0) - (while (< j bc) - (aset (aref a i) j (aref tmp j)) - (setq j (1+ j))) - (setq i (1+ i))))) - -(defsubst rijndael-substitution (a box bc) - "Rijndael substitution primitive. -Replace every byte of the input by the byte at that place -in the nonlinear S-box." - (let ((i 0) j) - (while (< i 4) - (setq j 0) - (while (< j bc) - (aset (aref a i) j (aref box (aref (aref a i) j))) - (setq j (1+ j))) - (setq i (1+ i))))) - -(defsubst rijndael-mix-column (a bc) - "Rijndael MixColumn primitive. -Mix the four bytes of every column in a linear way." - (let ((b (make-vector 4 0)) i j) - ;; init b - (setq i 0) - (while (< i 4) - (aset b i (make-vector rijndael-maxbc 0)) - (setq i (1+ i))) - ;; do it - (setq j 0) - (while (< j bc) - (setq i 0) - (while (< i 4) - (aset (aref b i) - j - (logxor (rijndael-mul 2 (aref (aref a i) j)) - (rijndael-mul 3 (aref (aref a (% (+ i 1) 4)) j)) - (aref (aref a (% (+ i 2) 4)) j) - (aref (aref a (% (+ i 3) 4)) j))) - (setq i (1+ i))) - (setq j (1+ j))) - ;; copy b back into a - (setq i 0) - (while (< i 4) - (setq j 0) - (while (< j bc) - (aset (aref a i) j (aref (aref b i) j)) - (setq j (1+ j))) - (setq i (1+ i))))) - -(defsubst rijndael-inv-mix-column (a bc) - "Rijndael inverted MixColumn primitive. -Mix the four bytes of every column in a linear way. -This is the opposite operation of Mixcolumn." - (let ((b (make-vector 4 0)) i j) - ;; init b - (setq i 0) - (while (< i 4) - (aset b i (make-vector rijndael-maxbc 0)) - (setq i (1+ i))) - ;; do it - (setq j 0) - (while (< j bc) - (setq i 0) - (while (< i 4) - (aset (aref b i) - j - (logxor (rijndael-mul ?\x0E (aref (aref a i) j)) - (rijndael-mul ?\x0B (aref (aref a (% (+ i 1) 4)) j)) - (rijndael-mul ?\x0D (aref (aref a (% (+ i 2) 4)) j)) - (rijndael-mul ?\x09 (aref (aref a (% (+ i 3) 4)) j)))) - (setq i (1+ i))) - (setq j (1+ j))) - ;; copy b back into a - (setq i 0) - (while (< i 4) - (setq j 0) - (while (< j bc) - (aset (aref a i) j (aref (aref b i) j)) - (setq j (1+ j))) - (setq i (1+ i))))) - - -;; Internal functions: - -(defun rijndael-bc (blockBits) - "Determine BC given block size." - (if (or (< blockBits 128) (> blockBits 256)) - (error "Invalid block size %d bits" blockBits) - (/ blockBits 32))) - -(defun rijndael-rounds (keyBits blockBits) - "Determine Rijndael rounds given key and block sizes." - (if (or (< keyBits 128) (> keyBits 256) (< blockBits 128) (> blockBits 256)) - (error "Invalid key/block size combination (key size %d block size %d)" - keyBits blockBits) - (+ (/ (max keyBits blockBits) 32) 6))) - -(defun rijndael-print-key-schedule (key-schedule) - (let (i j k str) - (setq i 0) - (while (< i (1+ rijndael-maxrounds)) - (setq j 0) - (while (< j 4) - (setq k 0) - (while (< k rijndael-maxbc) - (setq str (concat str (format "%3d " - (aref (aref (aref key-schedule i) - j) - k)))) - (setq k (1+ k))) - (setq str (concat str "\n")) - (setq j (1+ j))) - (setq str (concat str "\n")) - (setq i (1+ i))) - (setq str (concat str "\n")))) - -(defun rijndael-key-schedule (k keyBits blockBits) - "Rijndael KeySchedule function (internal). -Calculate the necessary round keys. -The number of calculations depends on keyBits and blockBits." - (let ((rconpointer 0) i j T - (kc (rijndael-bc keyBits)) - (bc (rijndael-bc blockBits)) - (rounds (rijndael-rounds keyBits blockBits)) - (tk (make-vector 4 0)) - (W (make-vector (1+ rijndael-maxrounds) 0)) - (mid 4)) - ;; init tk - (setq i 0) - (while (< i 4) - (aset tk i (make-vector rijndael-maxkc 0)) - (setq i (1+ i))) - ;; init W - (setq i 0) - (while (< i (1+ rijndael-maxrounds)) - (aset W i (make-vector 4 0)) - (setq j 0) - (while (< j 4) - (aset (aref W i) j (make-vector rijndael-maxbc 0)) - (setq j (1+ j))) - (setq i (1+ i))) - ;; start - (setq j 0) - (while (< j kc) - (setq i 0) - (while (< i 4) - (aset (aref tk i) j - (aref (aref k i) j)) - (setq i (1+ i))) - (setq j (1+ j))) - ;; copy values into round key array - (setq j 0 - T 0) - (while (and (< j kc) (< T (* (1+ rounds) bc))) - (setq i 0) - (while (< i 4) - (aset (aref (aref W (/ T bc)) i) (% T bc) - (aref (aref tk i) j)) - (setq i (1+ i))) - (setq j (1+ j)) - (setq T (1+ T))) - ;; while not enough round key material calculated - (while (< T (* (1+ rounds) bc)) - ;; calculate new values - (setq i 0) - (while (< i 4) - (aset (aref tk i) 0 - (logxor (aref (aref tk i) 0) - (aref rijndael-S - (aref (aref tk (% (1+ i) 4)) (1- kc))))) - (setq i (1+ i))) - (aset (aref tk 0) 0 - (logxor (aref (aref tk 0) 0) - (aref rijndael-rcon rconpointer))) - (setq rconpointer (1+ rconpointer)) - (setq j 1) - (if (<= kc 6) - (while (< j kc) - (setq i 0) - (while (< i mid) - (aset (aref tk i) j - (logxor (aref (aref tk i) j) - (aref (aref tk i) (1- j)))) - (setq i (1+ i))) - (setq j (1+ j))) - (while (< j mid) - (setq i 0) - (while (< i 4) - (aset (aref tk i) j - (logxor (aref (aref tk i) j) - (aref (aref tk i) (1- j)))) - (setq i (1+ i))) - (setq j (1+ j))) - (setq i 0) - (while (< i 4) - (aset (aref tk i) mid - (logxor (aref (aref tk i) mid) - (aref rijndael-S (aref (aref tk i) (1- mid))))) - (setq i (1+ i))) - (setq j (1+ mid) i 0) - (while (< j kc) - (setq i 0) - (while (< i mid) - (aset (aref tk i) j - (logxor (aref (aref tk i) j) - (aref (aref tk i) (1- j)))) - (setq i (1+ i))) - (setq j (1+ j)))) - ;; copy values into round key array - (setq j 0) - (while (and (< j kc) (< T (* (1+ rounds) bc))) - (setq i 0) - (while (< i 4) - (aset (aref (aref W (/ T bc)) i) (% T bc) - (aref (aref tk i) j)) - (setq i (1+ i))) - (setq j (1+ j)) - (setq T (1+ T)))) - W)) - -(defun rijndael-encrypt (a keyBits blockBits rk &optional rounds) - "Rijndael block encryption (internal). -Encryption of one block. If optional argument rounds is non-null, -encrypt only a certain number of rounds (for debugging only)." - (let ((r 1) - (bc (rijndael-bc blockBits)) - (ROUNDS (rijndael-rounds keyBits blockBits))) - ;; make number of rounds sane - (if (or (null rounds) (> rounds ROUNDS)) - (setq rounds ROUNDS)) - ;; begin with a key addition - (rijndael-key-addition a (aref rk 0) bc) - ;; ROUNDS-1 ordinary rounds - (while (and (<= r rounds) (< r ROUNDS)) - (rijndael-substitution a rijndael-S bc) - (rijndael-shift-row a 0 bc) - (rijndael-mix-column a bc) - (rijndael-key-addition a (aref rk r) bc) - (setq r (1+ r))) - ;; Last round is special: there is no MixColumn - (if (= rounds ROUNDS) - (progn - (rijndael-substitution a rijndael-S bc) - (rijndael-shift-row a 0 bc) - (rijndael-key-addition a (aref rk rounds) bc))))) - -(defun rijndael-decrypt (a keyBits blockBits rk &optional rounds) - "Rijndael block decryption (internal). -Decryption of one block. If optional argument rounds is non-null, -decrypt only a certain number of rounds (for debugging only)." - (let* ((bc (rijndael-bc blockBits)) - (ROUNDS (rijndael-rounds keyBits blockBits)) - (r (1- ROUNDS))) - ;; make number of rounds sane - (if (or (null rounds) (> rounds ROUNDS)) - (setq rounds 0)) - ;; First the special round: - ;; without InvMixColumn - ;; with extra KeyAddition - (rijndael-key-addition a (aref rk ROUNDS) bc) - (rijndael-substitution a rijndael-Si bc) - (rijndael-shift-row a 1 bc) - (while (> r rounds) - (rijndael-key-addition a (aref rk r) bc) - (rijndael-inv-mix-column a bc) - (rijndael-substitution a rijndael-Si bc) - (rijndael-shift-row a 1 bc) - (setq r (1- r))) - ;; End with the extra key addition - (if (= rounds 0) - (rijndael-key-addition a (aref rk 0) bc)))) - - -;; Rijndael API functions: - -(defun rijndael-make-key (blockbits keymaterial) - "Generate Key Schedule given keying material KEYMATERIAL. -KEYMATERIAL must be of length multiple of 32 bits. -BLOCKBITS is size of blocks in bits (valid values 128, 160, 192, 224 and 256)." - (let ((k (make-vector 4 0)) i - (keybits (* (length keymaterial) 8))) - ;; init k - (setq i 0) - (while (< i 4) - (aset k i (make-vector rijndael-maxkc 0)) - (setq i (1+ i))) - (setq i 0) - (while (< i (/ keybits 8)) - (aset (aref k (% i 4)) (/ i 4) (aref (vconcat keymaterial) i)) - (setq i (1+ i))) - (list keybits keymaterial (rijndael-key-schedule k keybits blockbits)))) - -(defun rijndael-block-encrypt (data key mode blockbits &optional iv) - "Perform Rijndael encryption of DATA with key KEY. -DATA is a vector with data to encrypt (the block). -KEY is a Rijndael Key Schedule (see `rijndael-make-key'). -MODE is a symbol, `ecb', `cbc' or `cfb1', for the encryption mode to use. -BLOCKBITS is size of blocks in bits (valid values 128, 160, 192, 224 and 256). -Optional variable IV is a string containing initialization vectors." - (let ((numBlocks (/ (length data) (/ blockbits 8))) - (blk (make-vector 4 0)) - i j l) - ;; init blk - (setq i 0) - (while (< i 4) - (aset blk i (make-vector rijndael-maxbc 0)) - (setq i (1+ i))) - (cond ((eq mode 'ecb) - (setq i 0) - (while (< i numBlocks) - (setq j 0) - (while (< j (/ blockbits 32)) - (setq l 0) - (while (< l 4) - (aset (aref blk l) j (aref data (+ (* (/ blockbits 8) i) - (* 4 j) - l))) - (setq l (1+ l))) - (setq j (1+ j))) - (rijndael-encrypt blk (nth 0 key) blockbits (nth 2 key)) - (setq j 0) - (while (< j (/ blockbits 32)) - (setq l 0) - (while (< l 4) - (aset data (+ (* (/ blockbits 8) i) - (* 4 j) - l) - (aref (aref blk l) j)) - (setq l (1+ l))) - (setq j (1+ j))) - (setq i (1+ i)))) - (t - (error "Unknown encryption mode: %s" mode))) - data)) - -(defun rijndael-block-decrypt (data key mode blockbits &optional iv) - "Perform Rijndael encryption of DATA with key KEY. -DATA is a vector with data to encrypt (the block). -KEY is a Rijndael Key Schedule (see `rijndael-make-key'). -MODE is a symbol, `ecb', `cbc' or `cfb1', for the decryption mode to use. -BLOCKBITS is size of block in bits (valid values 128, 160, 192, 224 and 256). -Optional variable IV is a string containing initialization vectors." - (let ((numBlocks (/ (length data) (/ blockbits 8))) - (blk (make-vector 4 0)) - i j l) - ;; init blk - (setq i 0) - (while (< i 4) - (aset blk i (make-vector rijndael-maxbc 0)) - (setq i (1+ i))) - (cond ((eq mode 'ecb) - (setq i 0) - (while (< i numBlocks) - (setq j 0) - (while (< j (/ blockbits 32)) - (setq l 0) - (while (< l 4) - (aset (aref blk l) j (aref data (+ (* (/ blockbits 8) i) - (* 4 j) - l))) - (setq l (1+ l))) - (setq j (1+ j))) - (rijndael-decrypt blk (nth 0 key) blockbits (nth 2 key)) - (setq j 0) - (while (< j (/ blockbits 32)) - (setq l 0) - (while (< l 4) - (aset data (+ (* (/ blockbits 8) i) - (* 4 j) - l) - (aref (aref blk l) j)) - (setq l (1+ l))) - (setq j (1+ j))) - (setq i (1+ i)))) - (t - (error "Unknown decryption mode: %s" mode))) - data)) - - -;; Conversion functions: - -(defun rijndael-hex-to-int (str) - (if str - (if (listp str) - (+ (* 16 (rijndael-hex-to-int (cdr str))) - (cdr (assoc (car str) rijndael-hex-alist))) - (rijndael-hex-to-int (reverse (append str nil)))) - 0)) - -(defun rijndael-hexstring-to-bitstring (str) - (let (out) - (while (< 0 (length str)) - (setq out (cons (rijndael-hex-to-int (substring str -2)) out)) - (setq str (substring str 0 -2))) - (concat out))) - -(defun rijndael-vector-to-hexstring (vec) - (mapconcat (lambda (el) - (format "%02x" el)) - vec - "")) - -(defun rijndael-vector-to-bitstring (vec) - (rijndael-hexstring-to-bitstring (rijndael-vector-to-hexstring vec))) - -(defun rijndael-bitstring-to-vector (str) - (let ((out (make-vector (length str) 0)) - (i (1- (length str)))) - (while (< 0 (length str)) - (aset out i (string-to-char (substring str -1))) - (setq i (1- i)) - (setq str (substring str 0 -1))) - out)) - -(defun rijndael-bitstring-to-hexstring (str) - (let ((out "")) - (while (< 0 (length str)) - (setq out (format "%02x%s" (string-to-char (substring str -1)) out)) - (setq str (substring str 0 -1))) - out)) - - -;; NIST test value generator - -(defun rijndael-nist () - "Generate NIST test values. -The output is to be compared with the NIST tabulated values." - (interactive) - (switch-to-buffer (generate-new-buffer "*NIST Rijndael test values")) - (erase-buffer) - (insert "\n\n\nElectronic Codebook (ECB) Mode - ENCRYPTION\n") - ;; ECB encrypt keysize 128 - (rijndael-nist-ecb-mct - "00000000000000000000000000000000" 128 - "00000000000000000000000000000000" 128 'encrypt) - ;; ECB encrypt keysize 160 - (rijndael-nist-ecb-mct - "0000000000000000000000000000000000000000" 160 - "00000000000000000000000000000000" 128 'encrypt) - ;; ECB encrypt keysize 192 - (rijndael-nist-ecb-mct - "000000000000000000000000000000000000000000000000" 192 - "00000000000000000000000000000000" 128 'encrypt) - ;; ECB encrypt keysize 224 - (rijndael-nist-ecb-mct - "00000000000000000000000000000000000000000000000000000000" 224 - "00000000000000000000000000000000" 128 'encrypt) - ;; ECB encrypt keysize 256 - (rijndael-nist-ecb-mct - "0000000000000000000000000000000000000000000000000000000000000000" 256 - "00000000000000000000000000000000" 128 'encrypt) - (insert "\n\n\nElectronic Codebook (ECB) Mode - DECRYPTION\n") - ;; ECB decrypt keysize 128 - (rijndael-nist-ecb-mct - "00000000000000000000000000000000" 128 - "00000000000000000000000000000000" 128 'decrypt) - ;; ECB decrypt keysize 160 - (rijndael-nist-ecb-mct - "0000000000000000000000000000000000000000" 160 - "00000000000000000000000000000000" 128 'decrypt) - ;; ECB decrypt keysize 192 - (rijndael-nist-ecb-mct - "000000000000000000000000000000000000000000000000" 192 - "00000000000000000000000000000000" 128 'decrypt) - ;; ECB decrypt keysize 224 - (rijndael-nist-ecb-mct - "00000000000000000000000000000000000000000000000000000000" 224 - "00000000000000000000000000000000" 128 'decrypt) - ;; ECB decrypt keysize 256 - (rijndael-nist-ecb-mct - "0000000000000000000000000000000000000000000000000000000000000000" 256 - "00000000000000000000000000000000" 128 'decrypt) - (message "NIST Rijndael tables generation...done")) - -(defun rijndael-nist-ecb-mct (initKey keyLength initBlock blockLength dir) - (let ((binKey (rijndael-bitstring-to-vector - (rijndael-hexstring-to-bitstring initKey))) - (outBlock (rijndael-hexstring-to-bitstring initBlock)) - (i 0) j keyInst inBlock) - (insert "\n=========================\n\n") - (insert (format "KEYSIZE=%d\n" keyLength)) - (while (< i rijndael-monte-carlo-loop) - (sit-for 0) - (insert (format "\nI=%d\n" i)) - (insert "KEY=" (rijndael-vector-to-hexstring binKey) "\n") - (setq keyInst (rijndael-make-key blockLength - (rijndael-vector-to-bitstring binKey))) - (insert (if (eq dir 'encrypt) "PT=" "CT=") - (rijndael-bitstring-to-hexstring outBlock) "\n") - (setq j 0) - (while (< j rijndael-monte-carlo-limit) - (if (eq (% j 100) 0) - (message (concat "Rijndael NIST ECB MCT %sion (%db keys, " - "%db blocks) loop %d of %d%s") - dir keyLength blockLength i - rijndael-monte-carlo-loop - (if (> rijndael-monte-carlo-limit 1) - (format " iteration %d of %d" j - rijndael-monte-carlo-limit) - ""))) - (setq inBlock (copy-sequence outBlock)) - (if (eq dir 'encrypt) - (rijndael-block-encrypt outBlock keyInst 'ecb blockLength) - (rijndael-block-decrypt outBlock keyInst 'ecb blockLength)) - (setq j (1+ j))) - (insert (if (eq dir 'encrypt) "CT=" "PT=") - (rijndael-bitstring-to-hexstring outBlock) "\n") - (cond ((eq keyLength 128) - (setq j 0) - (while (< j (/ 128 8)) - (aset binKey j (logxor (aref binKey j) - (aref - (rijndael-bitstring-to-vector outBlock) - j))) - (setq j (1+ j)))) - ((eq keyLength 192) - (setq j 0) - (while (< j (/ 64 8)) - (aset binKey j (logxor (aref binKey j) - (aref - (rijndael-bitstring-to-vector inBlock) - (+ j (/ 64 8))))) - (setq j (1+ j))) - (setq j 0) - (while (< j (/ 128 8)) - (aset binKey (+ j (/ 64 8)) - (logxor (aref binKey (+ j (/ 64 8))) - (aref (rijndael-bitstring-to-vector outBlock) j))) - (setq j (1+ j)))) - ((eq keyLength 256) - (setq j 0) - (while (< j (/ 128 8)) - (aset binKey j (logxor (aref binKey j) - (aref - (rijndael-bitstring-to-vector inBlock) - j))) - (setq j (1+ j))) - (setq j 0) - (while (< j (/ 128 8)) - (aset binKey (+ j (/ 128 8)) - (logxor (aref binKey j) - (aref - (rijndael-bitstring-to-vector outBlock) - j))) - (setq j (1+ j))))) - (setq i (1+ i))))) - -(provide 'rijndael) - -;; rijndael.el ends here diff --git a/xemacs-packages/lisp/ecrypto/sha1.el b/xemacs-packages/lisp/ecrypto/sha1.el deleted file mode 100644 index e6332b5c..00000000 --- a/xemacs-packages/lisp/ecrypto/sha1.el +++ /dev/null @@ -1,442 +0,0 @@ -;;; sha1.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp - -;; Copyright (C) 1999, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. - -;; Author: Shuhei KOBAYASHI -;; Keywords: SHA1, FIPS 180-1 - -;; This file is part of FLIM (Faithful Library about Internet Message). - -;; 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 program is implemented from the definition of SHA-1 in FIPS PUB -;; 180-1 (Federal Information Processing Standards Publication 180-1), -;; "Announcing the Standard for SECURE HASH STANDARD". -;; -;; (EXCEPTION; two optimizations taken from GnuPG/cipher/sha1.c) -;; -;; Test cases from FIPS PUB 180-1. -;; -;; (sha1 "abc") -;; => a9993e364706816aba3e25717850c26c9cd0d89d -;; -;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") -;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1 -;; -;; (sha1 (make-string 1000000 ?a)) -;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f -;; -;; BUGS: -;; * It is assumed that length of input string is less than 2^29 bytes. -;; * It is caller's responsibility to make string (or region) unibyte. -;; -;; TODO: -;; * Rewrite from scratch! -;; This version is much faster than Keiichi Suzuki's another sha1.el, -;; but it is too dirty. - -;;; Code: - -(require 'hex-util) - -;;; -;;; external SHA1 function. -;;; - -(defgroup sha1 nil - "Elisp interface for SHA1 hash computation." - :group 'extensions) - -(defcustom sha1-maximum-internal-length 500 - "*Maximum length of message to use Lisp version of SHA1 function. -If message is longer than this, `sha1-program' is used instead. - -If this variable is set to 0, use external program only. -If this variable is set to nil, use internal function only." - :type 'integer - :group 'sha1) - -(defcustom sha1-program '("sha1sum") - "*Name of program to compute SHA1. -It must be a string \(program name\) or list of strings \(name and its args\)." - :type '(repeat string) - :group 'sha1) - -(defcustom sha1-use-external (condition-case () - (executable-find (car sha1-program)) - (error)) - "*Use external SHA1 program. -If this variable is set to nil, use internal function only." - :type 'boolean - :group 'sha1) - -(defun sha1-string-external (string &optional binary) - (let (prog args digest default-enable-multibyte-characters) - (if (consp sha1-program) - (setq prog (car sha1-program) - args (cdr sha1-program)) - (setq prog sha1-program - args nil)) - (with-temp-buffer - (insert string) - (apply (function call-process-region) - (point-min)(point-max) - prog t t nil args) - ;; SHA1 is 40 bytes long in hexadecimal form. - (setq digest (buffer-substring (point-min)(+ (point-min) 40)))) - (if binary - (decode-hex-string digest) - digest))) - -(defun sha1-region-external (beg end &optional binary) - (sha1-string-external (buffer-substring-no-properties beg end) binary)) - -;;; -;;; internal SHA1 function. -;;; - -(eval-when-compile - ;; optional second arg of string-to-number is new in v20. - (defconst sha1-K0-high 23170) ; (string-to-number "5A82" 16) - (defconst sha1-K0-low 31129) ; (string-to-number "7999" 16) - (defconst sha1-K1-high 28377) ; (string-to-number "6ED9" 16) - (defconst sha1-K1-low 60321) ; (string-to-number "EBA1" 16) - (defconst sha1-K2-high 36635) ; (string-to-number "8F1B" 16) - (defconst sha1-K2-low 48348) ; (string-to-number "BCDC" 16) - (defconst sha1-K3-high 51810) ; (string-to-number "CA62" 16) - (defconst sha1-K3-low 49622) ; (string-to-number "C1D6" 16) - -;;; original definition of sha1-F0. -;;; (defmacro sha1-F0 (B C D) -;;; (` (logior (logand (, B) (, C)) -;;; (logand (lognot (, B)) (, D))))) -;;; a little optimization from GnuPG/cipher/sha1.c. - (defmacro sha1-F0 (B C D) - (` (logxor (, D) (logand (, B) (logxor (, C) (, D)))))) - (defmacro sha1-F1 (B C D) - (` (logxor (, B) (, C) (, D)))) -;;; original definition of sha1-F2. -;;; (defmacro sha1-F2 (B C D) -;;; (` (logior (logand (, B) (, C)) -;;; (logand (, B) (, D)) -;;; (logand (, C) (, D))))) -;;; a little optimization from GnuPG/cipher/sha1.c. - (defmacro sha1-F2 (B C D) - (` (logior (logand (, B) (, C)) - (logand (, D) (logior (, B) (, C)))))) - (defmacro sha1-F3 (B C D) - (` (logxor (, B) (, C) (, D)))) - - (defmacro sha1-S1 (W-high W-low) - (` (let ((W-high (, W-high)) - (W-low (, W-low))) - (setq S1W-high (+ (% (* W-high 2) 65536) - (/ W-low (, (/ 65536 2))))) - (setq S1W-low (+ (/ W-high (, (/ 65536 2))) - (% (* W-low 2) 65536)))))) - (defmacro sha1-S5 (A-high A-low) - (` (progn - (setq S5A-high (+ (% (* (, A-high) 32) 65536) - (/ (, A-low) (, (/ 65536 32))))) - (setq S5A-low (+ (/ (, A-high) (, (/ 65536 32))) - (% (* (, A-low) 32) 65536)))))) - (defmacro sha1-S30 (B-high B-low) - (` (progn - (setq S30B-high (+ (/ (, B-high) 4) - (* (% (, B-low) 4) (, (/ 65536 4))))) - (setq S30B-low (+ (/ (, B-low) 4) - (* (% (, B-high) 4) (, (/ 65536 4)))))))) - - (defmacro sha1-OP (round) - (` (progn - (sha1-S5 sha1-A-high sha1-A-low) - (sha1-S30 sha1-B-high sha1-B-low) - (setq sha1-A-low (+ ((, (intern (format "sha1-F%d" round))) - sha1-B-low sha1-C-low sha1-D-low) - sha1-E-low - (, (symbol-value - (intern (format "sha1-K%d-low" round)))) - (aref block-low idx) - (progn - (setq sha1-E-low sha1-D-low) - (setq sha1-D-low sha1-C-low) - (setq sha1-C-low S30B-low) - (setq sha1-B-low sha1-A-low) - S5A-low))) - (setq carry (/ sha1-A-low 65536)) - (setq sha1-A-low (% sha1-A-low 65536)) - (setq sha1-A-high (% (+ ((, (intern (format "sha1-F%d" round))) - sha1-B-high sha1-C-high sha1-D-high) - sha1-E-high - (, (symbol-value - (intern (format "sha1-K%d-high" round)))) - (aref block-high idx) - (progn - (setq sha1-E-high sha1-D-high) - (setq sha1-D-high sha1-C-high) - (setq sha1-C-high S30B-high) - (setq sha1-B-high sha1-A-high) - S5A-high) - carry) - 65536))))) - - (defmacro sha1-add-to-H (H X) - (` (progn - (setq (, (intern (format "sha1-%s-low" H))) - (+ (, (intern (format "sha1-%s-low" H))) - (, (intern (format "sha1-%s-low" X))))) - (setq carry (/ (, (intern (format "sha1-%s-low" H))) 65536)) - (setq (, (intern (format "sha1-%s-low" H))) - (% (, (intern (format "sha1-%s-low" H))) 65536)) - (setq (, (intern (format "sha1-%s-high" H))) - (% (+ (, (intern (format "sha1-%s-high" H))) - (, (intern (format "sha1-%s-high" X))) - carry) - 65536))))) - ) - -;;; buffers (H0 H1 H2 H3 H4). -(defvar sha1-H0-high) -(defvar sha1-H0-low) -(defvar sha1-H1-high) -(defvar sha1-H1-low) -(defvar sha1-H2-high) -(defvar sha1-H2-low) -(defvar sha1-H3-high) -(defvar sha1-H3-low) -(defvar sha1-H4-high) -(defvar sha1-H4-low) - -(defun sha1-block (block-high block-low) - (let (;; step (c) --- initialize buffers (A B C D E). - (sha1-A-high sha1-H0-high) (sha1-A-low sha1-H0-low) - (sha1-B-high sha1-H1-high) (sha1-B-low sha1-H1-low) - (sha1-C-high sha1-H2-high) (sha1-C-low sha1-H2-low) - (sha1-D-high sha1-H3-high) (sha1-D-low sha1-H3-low) - (sha1-E-high sha1-H4-high) (sha1-E-low sha1-H4-low) - (idx 16)) - ;; step (b). - (let (;; temporary variables used in sha1-S1 macro. - S1W-high S1W-low) - (while (< idx 80) - (sha1-S1 (logxor (aref block-high (- idx 3)) - (aref block-high (- idx 8)) - (aref block-high (- idx 14)) - (aref block-high (- idx 16))) - (logxor (aref block-low (- idx 3)) - (aref block-low (- idx 8)) - (aref block-low (- idx 14)) - (aref block-low (- idx 16)))) - (aset block-high idx S1W-high) - (aset block-low idx S1W-low) - (setq idx (1+ idx)))) - ;; step (d). - (setq idx 0) - (let (;; temporary variables used in sha1-OP macro. - S5A-high S5A-low S30B-high S30B-low carry) - (while (< idx 20) (sha1-OP 0) (setq idx (1+ idx))) - (while (< idx 40) (sha1-OP 1) (setq idx (1+ idx))) - (while (< idx 60) (sha1-OP 2) (setq idx (1+ idx))) - (while (< idx 80) (sha1-OP 3) (setq idx (1+ idx)))) - ;; step (e). - (let (;; temporary variables used in sha1-add-to-H macro. - carry) - (sha1-add-to-H H0 A) - (sha1-add-to-H H1 B) - (sha1-add-to-H H2 C) - (sha1-add-to-H H3 D) - (sha1-add-to-H H4 E)))) - -(defun sha1-binary (string) - "Return the SHA1 of STRING in binary form." - (let (;; prepare buffers for a block. byte-length of block is 64. - ;; input block is split into two vectors. - ;; - ;; input block: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ... - ;; block-high: +-0-+ +-1-+ +-2-+ +-3-+ - ;; block-low: +-0-+ +-1-+ +-2-+ +-3-+ - ;; - ;; length of each vector is 80, and elements of each vector are - ;; 16bit integers. elements 0x10-0x4F of each vector are - ;; assigned later in `sha1-block'. - (block-high (eval-when-compile (make-vector 80 nil))) - (block-low (eval-when-compile (make-vector 80 nil)))) - (unwind-protect - (let* (;; byte-length of input string. - (len (length string)) - (lim (* (/ len 64) 64)) - (rem (% len 4)) - (idx 0)(pos 0)) - ;; initialize buffers (H0 H1 H2 H3 H4). - (setq sha1-H0-high 26437 ; (string-to-number "6745" 16) - sha1-H0-low 8961 ; (string-to-number "2301" 16) - sha1-H1-high 61389 ; (string-to-number "EFCD" 16) - sha1-H1-low 43913 ; (string-to-number "AB89" 16) - sha1-H2-high 39098 ; (string-to-number "98BA" 16) - sha1-H2-low 56574 ; (string-to-number "DCFE" 16) - sha1-H3-high 4146 ; (string-to-number "1032" 16) - sha1-H3-low 21622 ; (string-to-number "5476" 16) - sha1-H4-high 50130 ; (string-to-number "C3D2" 16) - sha1-H4-low 57840) ; (string-to-number "E1F0" 16) - ;; loop for each 64 bytes block. - (while (< pos lim) - ;; step (a). - (setq idx 0) - (while (< idx 16) - (aset block-high idx (+ (* (aref string pos) 256) - (aref string (1+ pos)))) - (setq pos (+ pos 2)) - (aset block-low idx (+ (* (aref string pos) 256) - (aref string (1+ pos)))) - (setq pos (+ pos 2)) - (setq idx (1+ idx))) - (sha1-block block-high block-low)) - ;; last block. - (if (prog1 - (< (- len lim) 56) - (setq lim (- len rem)) - (setq idx 0) - (while (< pos lim) - (aset block-high idx (+ (* (aref string pos) 256) - (aref string (1+ pos)))) - (setq pos (+ pos 2)) - (aset block-low idx (+ (* (aref string pos) 256) - (aref string (1+ pos)))) - (setq pos (+ pos 2)) - (setq idx (1+ idx))) - ;; this is the last (at most) 32bit word. - (cond - ((= rem 3) - (aset block-high idx (+ (* (aref string pos) 256) - (aref string (1+ pos)))) - (setq pos (+ pos 2)) - (aset block-low idx (+ (* (aref string pos) 256) - 128))) - ((= rem 2) - (aset block-high idx (+ (* (aref string pos) 256) - (aref string (1+ pos)))) - (aset block-low idx 32768)) - ((= rem 1) - (aset block-high idx (+ (* (aref string pos) 256) - 128)) - (aset block-low idx 0)) - (t ;; (= rem 0) - (aset block-high idx 32768) - (aset block-low idx 0))) - (setq idx (1+ idx)) - (while (< idx 16) - (aset block-high idx 0) - (aset block-low idx 0) - (setq idx (1+ idx)))) - ;; last block has enough room to write the length of string. - (progn - ;; write bit length of string to last 4 bytes of the block. - (aset block-low 15 (* (% len 8192) 8)) - (setq len (/ len 8192)) - (aset block-high 15 (% len 65536)) - ;; XXX: It is not practical to compute SHA1 of - ;; such a huge message on emacs. - ;; (setq len (/ len 65536)) ; for 64bit emacs. - ;; (aset block-low 14 (% len 65536)) - ;; (aset block-high 14 (/ len 65536)) - (sha1-block block-high block-low)) - ;; need one more block. - (sha1-block block-high block-low) - (fillarray block-high 0) - (fillarray block-low 0) - ;; write bit length of string to last 4 bytes of the block. - (aset block-low 15 (* (% len 8192) 8)) - (setq len (/ len 8192)) - (aset block-high 15 (% len 65536)) - ;; XXX: It is not practical to compute SHA1 of - ;; such a huge message on emacs. - ;; (setq len (/ len 65536)) ; for 64bit emacs. - ;; (aset block-low 14 (% len 65536)) - ;; (aset block-high 14 (/ len 65536)) - (sha1-block block-high block-low)) - ;; make output string (in binary form). - (let ((result (make-string 20 0))) - (aset result 0 (/ sha1-H0-high 256)) - (aset result 1 (% sha1-H0-high 256)) - (aset result 2 (/ sha1-H0-low 256)) - (aset result 3 (% sha1-H0-low 256)) - (aset result 4 (/ sha1-H1-high 256)) - (aset result 5 (% sha1-H1-high 256)) - (aset result 6 (/ sha1-H1-low 256)) - (aset result 7 (% sha1-H1-low 256)) - (aset result 8 (/ sha1-H2-high 256)) - (aset result 9 (% sha1-H2-high 256)) - (aset result 10 (/ sha1-H2-low 256)) - (aset result 11 (% sha1-H2-low 256)) - (aset result 12 (/ sha1-H3-high 256)) - (aset result 13 (% sha1-H3-high 256)) - (aset result 14 (/ sha1-H3-low 256)) - (aset result 15 (% sha1-H3-low 256)) - (aset result 16 (/ sha1-H4-high 256)) - (aset result 17 (% sha1-H4-high 256)) - (aset result 18 (/ sha1-H4-low 256)) - (aset result 19 (% sha1-H4-low 256)) - result)) - ;; do not leave a copy of input string. - (fillarray block-high nil) - (fillarray block-low nil)))) - -(defun sha1-string-internal (string &optional binary) - (if binary - (sha1-binary string) - (encode-hex-string (sha1-binary string)))) - -(defun sha1-region-internal (beg end &optional binary) - (sha1-string-internal (buffer-substring-no-properties beg end) binary)) - -;;; -;;; application interface. -;;; - -(defun sha1-region (beg end &optional binary) - (if (and sha1-use-external - sha1-maximum-internal-length - (> (abs (- end beg)) sha1-maximum-internal-length)) - (sha1-region-external beg end binary) - (sha1-region-internal beg end binary))) - -(defun sha1-string (string &optional binary) - (if (and sha1-use-external - sha1-maximum-internal-length - (> (length string) sha1-maximum-internal-length)) - (sha1-string-external string binary) - (sha1-string-internal string binary))) - -;;;###autoload -(defun sha1 (object &optional beg end binary) - "Return the SHA1 (Secure Hash Algorithm) of an object. -OBJECT is either a string or a buffer. -Optional arguments BEG and END denote buffer positions for computing the -hash of a portion of OBJECT. -If BINARY is non-nil, return a string in binary form." - (if (stringp object) - (sha1-string object binary) - (save-excursion - (set-buffer object) - (sha1-region (or beg (point-min)) (or end (point-max)) binary)))) - -(provide 'sha1) - -;;; arch-tag: c0f9abd0-ffc1-4557-aac6-ece7f2d4c901 -;;; sha1.el ends here diff --git a/xemacs-packages/lisp/ediff/ChangeLog b/xemacs-packages/lisp/ediff/ChangeLog deleted file mode 100644 index 77f6dfdf..00000000 --- a/xemacs-packages/lisp/ediff/ChangeLog +++ /dev/null @@ -1,907 +0,0 @@ -2006-02-22 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.62 released. - -2006-02-21 Michael Kifer - - * ediff-diff.el (ediff-setup-diff-regions, ediff-setup-diff-regions3): - fix the regular expressions. - -2006-02-20 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.61 released. - -2006-02-19 Michael Kifer - - * ediff-diff.el (ediff-ignore-case, ediff-ignore-case-option, - ediff-ignore-case-option3, ediff-actual-diff-options, - ediff-actual-diff3-options): new variables to control case sensitivity. - (ediff-make-diff2-buffer, ediff-setup-fine-diff-regions, - ediff-setup-diff-regions3): made aware of case-sensitivity. - (ediff-toggle-ignore-case): new function. - (ediff-extract-diffs, ediff-extract-diffs3): preserve point in buffers. - - * ediff-help.el (ediff-long-help-message-narrow2, - ediff-long-help-message-compare2, ediff-long-help-message-compare3, - ediff-long-help-message-word-mode): add ignore-case command. - (ediff-help-for-quick-help): add ignore-case command. - - * ediff-merg.el: move provide to the end. - - * ediff-ptch.el: move provide to the end. - - * ediff-wind.el: move provide to the end. - - * ediff-mult.el: move provide to the end. - (ediff-set-meta-overlay): enable follow-link. - - * ediff.el: move provide to the end. - Break recursive load cycle in eval-when-compile. - (ediff-patch-buffer): better heuristics. - - * ediff-util.el: move provide to the end. - Break recursive load cycle in eval-when-compile. - (ediff-setup-keymap): add binding for #c. Replaced some defsubsts with - defuns. - (ediff-submit-report): pass the values of ediff-diff3-program, - ediff-diff3-options. - -2005-12-05 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.60 released. - -2005-11-29 Michael Kifer - - * ediff-wind (ediff-setup-control-frame, ediff-make-wide-display): - preserve user position. - -2005-11-25 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.59 released. - -2005-11-25 Michael Kifer - - * ediff-wind (ediff-make-wide-display): Slight simplification. - - * ediff.el (ediff-date): Changed the date of last update. - -2005-11-16 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.58 released. - -2005-11-15 Michael Kifer - - * ediff-util (ediff-make-temp-file): use proper file-name-handler - operation - -2005-11-07 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.57 released. - -2005-11-04 Michael Kifer - - * ediff-merge.el (ediff-merge-region-is-non-clash): return t, if not - merging. - - * ediff-util.el (ediff-previous-difference): don't skip regions that - have merge clashes. - -2005-10-06 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.56 released. - -2005-10-05 Michael Kifer - - * ediff-merge.el (ediff-merge-region-is-non-clash): new defsubst. - (ediff-merge-region-is-non-clash-to-skip): previouslu called - ediff-merge-region-is-non-clash. - - * ediff-mult.el (ediff-append-custom-diff,ediff-meta-show-patch): use - insert-buffer-substring. - - * ediff-ptch.el (ediff-fixup-patch-map): use better heuristics for - selecting files to patch. Also bug fixes. - - * ediff-util.el (ediff-setup): bug fix. - (ediff-next-difference): Never skip clashes that differ in white space - only. - - * ediff-wind.el (ediff-setup-control-frame,ediff-destroy-control-frame): - check the menubar feature. - -2005-09-21 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.55 released. - -2005-09-20 Michael Kifer - - * ediff-ptch.el (ediff-file-name-sans-prefix): treat nil as an empty - string. - (ediff-fixup-patch-map): better heuristic for intuiting the file names - to patch. - (ediff-prompt-for-patch-file): more intuitive prompt. - - * ediff-util.el: use insert-buffer-substring. - - * ediff-vers.el (cvs-run-ediff-on-file-descriptor): bug fix. - -2005-07-19 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.54 released. - -2005-07-19 Michael Kifer - - * ediff.el (ediff-patch-buffer): changed the docstring. - - * ediff-diff.el: add defvar for longlines-mode. - -2005-07-10 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.53 released. - -2005-07-10 Michael Kifer - - * ediff-diff.el (ediff-extract-diffs,ediff-extract-diffs3): - Make it work with longlines mode - - * ediff-mult.el (ediff-meta-mode-hook): new variable. - - * ediff-ptch.el (ediff-file-name-sans-prefix): quote regexp. - - * ediff-init: got rid of -face in face names. - -2005-06-04 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.52 released. - -2005-06-03 Michael Kifer - - * ediff-diff.el (ediff-same-contents) Eliminate CL-type functions. - Replace string-to-int with string-to-number. - - * ediff-mult.el (ediff-intersect-directories) Make sure that ".." and - "." files are deleted from all file lists before comparison - -2005-02-19 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.51 released. - -2005-02-19 Michael Kifer - - * ediff.el (ediff-set-diff-overlays-in-one-buffer, - ediff-set-fine-overlays-in-one-buffer,ediff-goto-word) make sure - we use the syntax table of the correct buffer. - (ediff-same-file-contents,ediff-same-contents): enhancements thanks to - Felix Gatzemeier. - - * ediff-init.el (ediff-hide-face): checks for definedness of functions. - (ediff-file-remote-p): make synonymous with file-remote-p. - In all deffaces ediff-*-face-*, use min-colors. - - * ediff-mult.el (ediff-meta-mark-equal-files): make use of - ediff-recurse-to-subdirectories. - (ediff-mark-if-equal): check that the arguments are strings, use - ediff-same-contents (after to Felix Gatzemeier). - - * ediff.el (ediff-merge-on-startup): don't set buffer-modified-p to - nil. - -2004-02-20 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.50 released. - -2004-02-19 Michael Kifer - - * ediff-util.el (ediff-toggle-read-only): Remove extra format - string argument. - (ediff-toggle-regexp-match): Likewise. - Suggested by Andreas Schwab - * ediff-ptch.el (ediff-test-patch-utility): - * ediff-diff.el (ediff-test-utility): Don't use = or zerop to - test the return value of call-process, because it can be a string. - By Jesper Harder - -2004-02-19 Michael Kifer - - * ediff-util.el (ediff-compute-custom-diffs-maybe): Avoid creating - temporary file for buffer already visiting one. This change makes - output likely to be directly usable by patch program. - Suggested by Adrian Aichner - -2003-10-31 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.49 released. - -2003-10-13 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.48 released. - -2003-10-12 Michael Kifer - - * ediff-mult.el (ediff-filegroup-action): use - ediff-default-filtering-regexp. - - * ediff-util.el (ediff-recenter): don't call - ediff-restore-highlighting twice. - (ediff-select-difference): set current difference. - (ediff-unselect-and-select-difference): added comment. - - * ediff.el (ediff-directories,ediff-directory-revisions, - ediff-directories3,ediff-merge-directories, - ediff-merge-directories-with-ancestor,ediff-merge-directory-revisions, - ediff-merge-directory-revisions-with-ancestor): use - ediff-default-filtering-regexp. - -2003-05-19 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.47 released. - -2003-05-18 Michael Kifer - - * ediff-mult.el (ediff-default-filtering-regexp): new variable. - - * ediff-util.el (ediff-maybe-save-and-delete-merge): change in a - message. - - * ediff.el (ediff-directories,ediff-directory-revisions, - ediff-directories3,ediff-merge-directories, - ediff-merge-directories-with-ancestor,ediff-merge-directory-revisions, - ediff-merge-directory-revisions-with-ancestor): make use of the new - ediff-default-filtering-regexp variable. - - * all files: eliminated trailing blanks in various lines. - -2003-03-09 Ben Wing - - * Makefile: - Delete explicit compile:: and binkit: rules. - Don't add custom-load.elc to the list of generated elc's. - Use STANDARD_DOCS instead of explicitly giving the targets - and dependencies. - -2003-01-26 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.46 released. - -2003-01-25 Michael Kifer - - * ediff.el (ediff-revision): better defaults. - - * ediff-vers.el (ediff-vc-latest-version): new function. - (ediff-vc-internal): use latest version instead of working version. - -2002-11-29 Ben Wing - - * .cvsignore: Remove files now handled automatically by CVS. - * Makefile: Use `compile' instead of hard-coded `all'. - -2002-12-06 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.45 released. - -2002-11-17 Michael Kifer - - * ediff-diff.el (ediff-setup-diff-regions): change regexp. - - * ediff-mult.el: comments. - - * ediff.el: comments. - -2002-10-29 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.44 released. - -2002-10-27 Michael Kifer - - * ediff-wind.el (ediff-control-frame-parameters): added scrollbar-height. - -2002-10-15 Ville Skyttä - - * Makefile (srckit): Remove. - -2002-10-14 Ville Skyttä - - * Makefile (MANUAL): Removed (unused). - -2002-10-14 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.43 released. - -2002-10-12 Michael Kifer - - * ediff-init.el (ediff-frame-char-height): use frame-selected-window. - - * ediff-util.el (ediff-file-checked-in-p): changed progn with and - - * ediff-wind.el (ediff-skip-unsuitable-frames): distinguish selected - frame from frame of selected window - (ediff-frame-has-dedicated-windows): don't select any frames to avoid - changing selected windows - (ediff-setup-control-frame): make sure auto-rase is properly set for - the control frame - -2002-09-25 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.42 released. - -2002-09-23 Michael Kifer - - * ediff-init.el (ediff-get-next-window): bug fix. - - * ediff-hook.el (ediff-cond-compile-for-xemacs-or-emacs): Put the - definition straight into loaddefs.el as well as executing it here - (by RMS) - -2002-09-18 Michael Kifer - - * ediff-hooks.el: Put back the autoloads (for compatibility with XEmacs). - - * ediff-init.el: Use defalias instead of fset. - - * ediff-util.el: Use defalias instead of fset. - - * ediff-ptch.el (ediff-test-patch-utility): catch errors - - * ediff-wind.el (ediff-window-setup-function): better choices - - * ediff-backup.el (ediff-backup): new function - - * ediff.texi: typo - -2002-07-16 Adrian Aichner - - * .cvsignore: Add generated .info* and .html files. - -2002-04-30 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.41 released. - -2002-04-25 Michael Kifer - - * ediff-hooks.el: Put back the autoloads. - -2002-04-24 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.40 released. - -2002-04-16 Michael Kifer - - * ediff-init.el: better defaults for all faces -- thanks to Eli - Zaretskii. - - * ediff-util.el (ediff-cleanup-mess): delete ctl window on exit - when the window is not in its own frame. - (ediff-clone-buffer-for-region-comparison): more robust window - arrangement while prompting for regions to compare. - (ediff-make-cloned-buffer): use generate-new-buffer-name. - (ediff-inferior-compare-regions): deleted unused vars - ctl-buf and quit-now. - -2002-03-25 Steve Youngs - - * Makefile (VERSION): 1.39 released. - -2002-03-20 Michael Kifer - - * ediff-diff.el (ediff-install-fine-diff-if-necessary): take - the current highlighting style into account. - (ediff-forward-word-function,ediff-whitespace,ediff-word-1, - ediff-word-2,ediff-word-3,ediff-word-4): make them buffer local. - - * ediff-init.el (ediff-patch-job): new macro. - - * ediff-mult.el (ediff-make-new-meta-list-header): new API function. - (ediff-intersect-directories): use ediff-make-new-meta-list-header. - - * ediff-ptch.el (ediff-map-patch-buffer): use - ediff-make-new-meta-list-header. - (ediff-fixup-patch-map): use the meta-list API from ediff-mult.el. - - * ediff-util.el (ediff-toggle-hilit): fix toggling of highliting. - (ediff-select-difference): take highlighting style into account. - (ediff-clone-buffer-for-region-comparison): new function. - (ediff-inferior-compare-regions): added comparison of current diff - regions. - - * ediff.el (ediff-clone-buffer-for-region-comparison, - ediff-clone-buffer-for-window-comparison): moved to ediff-util.el. - -2002-03-05 Michael Kifer - - * ediff-init.el: comments. - - * ediff-hook.el: Got rid of autoloads. Not needed, since the hook - is loaded. - - * ediff-mult.el (ediff-intersect-directories, - ediff-prepare-meta-buffer,ediff-get-directory-files-under-revision): - cleanup. - (ediff-draw-dir-diffs): now supports the "C" command in directory - difference buffer. - (ediff-dir-diff-copy-file): new function that implements copying - of files from one Ediff dir to another - (ediff-bury-dir-diffs-buffer): kills the buffer instead. - (ediff-append-custom-diff): better error msgs. - - * ediff-util.el (ediff-compute-custom-diffs-maybe): buglet fix. - (ediff-inferior-compare-regions): Use - ediff-clone-buffer-for-region-comparison. Better and simpler interface. - - * ediff.el (ediff-directories-internal): Cleanup. - (ediff-clone-buffer-for-region-comparison): Better interface. - -2002-02-09 Michael Kifer - - * ediff-init.el (ediff-has-gutter-support): Steven Turnbull's patch. - - * ediff-wind.el (ediff-setup-control-frame): Use - ediff-has-gutter-support. - -2002-02-09 Michael Kifer - - * ediff-util.el (ediff-dispose-of-variant-according-to-user): - check if buff is alive. - - * ediff.el: typo in comment. - -2002-01-08 Michael Kifer - - * ediff-hook.el: added autoload cookie - -2002-01-07 Michael Kifer - - * ediff-help.el: use ediff-cond-compile-for-xemacs-or-emacs. - - * ediff-hook.el: use ediff-cond-compile-for-xemacs-or-emacs. - - * ediff-init.el (ediff-cond-compile-for-xemacs-or-emacs): new - macro designed to be used in many places where ediff-emacs-p or - ediff-xemacs-p was previously used. Reduces the number of - warnings. - Use ediff-cond-compile-for-xemacs-or-emacs in many places in lieue - of ediff-xemacs-p. - (ediff-make-current-diff-overlay, ediff-highlight-diff-in-one-buffer, - ediff-convert-fine-diffs-to-overlays, ediff-empty-diff-region-p, - ediff-whitespace-diff-region-p, ediff-get-region-contents): - moved to ediff-util.el. - (ediff-event-key): moved here. - - * ediff-merge.el: got rid of unreferenced variables. - - * ediff-mult.el: use ediff-cond-compile-for-xemacs-or-emacs. - - * ediff-util.el: use ediff-cond-compile-for-xemacs-or-emacs. - (ediff-cleanup-mess): improved the way windows are set up after - quitting ediff. - (ediff-janitor): use ediff-dispose-of-variant-according-to-user. - (ediff-dispose-of-variant-according-to-user): new function - designed to be smarter and also understands indirect buffers. - (ediff-highlight-diff-in-one-buffer, - ediff-unhighlight-diff-in-one-buffer, - ediff-unhighlight-diffs-totally-in-one-buffer, - ediff-highlight-diff, ediff-highlight-diff, - ediff-unhighlight-diff, ediff-unhighlight-diffs-totally, - ediff-empty-diff-region-p, ediff-whitespace-diff-region-p, - ediff-get-region-contents, ediff-make-current-diff-overlay): - moved here. - (ediff-format-bindings-of): new function by Hannu Koivisto - . - (ediff-setup): make sure the merge buffer is always widened and - modifiable. - (ediff-write-merge-buffer-and-maybe-kill): refuse to write the - result of a merge into a file visited by another buffer. - (ediff-arrange-autosave-in-merge-jobs): check if the merge file - is visited by another buffer and ask to save/delete that buffer. - (ediff-verify-file-merge-buffer): new function to do the above. - - * ediff-vers.el: load ediff-init.el at compile time. - - * ediff-wind.el: use ediff-cond-compile-for-xemacs-or-emacs. - - * ediff.el (ediff-windows, ediff-regions-wordwise, - ediff-regions-linewise): use indirect buffers to improve - robustness and make it possible to compare regions of the same - buffer (even overlapping regions). - (ediff-clone-buffer-for-region-comparison, - ediff-clone-buffer-for-window-comparison): new functions. - (ediff-files-internal): refuse to compare identical files. - (ediff-regions-internal): get rid of the warning about comparing - regions of the same buffer. - - * ediff-diff.el (ediff-convert-fine-diffs-to-overlays): moved here. - Plus the following fixes courtesy of Dave Love: - Doc fixes. - (ediff-word-1): Use word class and move - to the - front per regexp documentation. - (ediff-wordify): Bind forward-word-function outside loop. - (ediff-copy-to-buffer): Use insert-buffer-substring rather than - consing buffer contents. - (ediff-goto-word): Move syntax table setting outside loop. - -2002-01-07 Adrian Aichner - - * Makefile (HTML_FILES): New. - * Makefile (HTML_DEP): New. - -2001-12-30 Steve Youngs - - * package-info.in (provides): Update to include all provides. - -2001-12-24 Michael Kifer - - * ediff-mult.el (ediff-meta-mark-equal-files): Added optional - action argument. - - * ediff-init.el: Fixed some doc strings. - - * ediff-util.el (ediff-after-quit-hook-internal): New variable. - Got rid of make-local-hook. - - * ediff-wind.el (ediff-setup-control-frame): Got rid of - make-local-hook. - -2001-09-27 Michael Kifer - - * ediff-mult.el (ediff-get-meta-info): Installed Gerd's changes. - Added comments. - -2001-09-09 Michael Kifer - - * ediff-init.el (ediff-highest-priority): bug fix. - - * ediff-mult.el (ediff-get-meta-info): replace and with or. - -2001-07-21 Michael Kifer - - * ediff-util.el - (ediff-file-checked-out-p,ediff-file-checked-in-p): check if - vc-state is available. - (ediff-make-temp-file): use ediff-coding-system-for-write. - - * ediff-init.el (ediff-coding-system-for-read): from ediff-diff.el - (ediff-coding-system-for-write): new variable. - (ediff-highest-priority): fixed the bug having to do with disappearing - overlays. - (ediff-file-remote-p): use file-remote-p, if available. - (ediff-listable-file): new function. - (ediff-file-attributes): use ediff-listable-file. - - * ediff-mult.el (ediff-meta-insert-file-info1): use - ediff-listable-file. - - * ediff-ptch.el (ediff-prompt-for-patch-file): use - ediff-coding-system-for-read. - (ediff-patch-file-internal): use ediff-coding-system-for-write. - - * ediff-diff.el (ediff-coding-system-for-read): moved to ediff-init.el. - (ediff-match-diff3-line,ediff-get-diff3-group): improved pattern. - - * ediff.texi: added clarifications, acknowledgements. - -2001-04-08 Steve Youngs - - * Makefile (REQUIRES): Add prog-modes because diff-mode.el - has moved there. - -2001-03-17 Michael Kifer - - * ediff-util.el: Copyright years. - (ediff-choose-syntax-table): New function. - (ediff-setup): Use ediff-choose-syntax-table. - - * ediff-init.el (ediff-with-syntax-table): New macro, uses - with-syntax-table. - - * ediff.el: Date of last update, copyright years. - - * ediff-wind (ediff-setup-control-frame): Nill->nil. - -2001-02-24 Michael Kifer - - * ediff.texi: Fixed some typos - -2001-02-12 Michael Kifer - - * ediff-diff.el (ediff-make-diff2-buffer): Removed bogus checks - for remote files. - (ediff-coding-system-for-read): replaced the no-conversion default - with raw-text. - - * ediff-init.el: Removed :version from defcustom vars. - - * ediff-util.el (ediff-compute-custom-diffs-maybe): Better - handling of the diff mode - - * ediff.texi: Added ediff-coding-system-for-read. - -2001-01-19 Michael Kifer - - * ediff.el (ediff-patch-file): use better defaults. - - * ediff-vers.el: fix for 8+3 DOS file systems - - * ediff.texi: add credits. - -2001-01-19 Colin Walters - - * ediff-util.el (ediff-compare-custom-diffs-maybe): put diff in - diff mode, if available. - -2001-01-19 Vin Shelton - - * ediff-hook.el (ediff-xemacs-init-menus): fixed add-menu-button - -2001-01-19 Steve Youngs - - * ediff-init.el (subst-char-in-string): Define and use it, unless - it's already defined. - -2001-01-17 Stephen J. Turnbull - - * Makefile: Add edebug to REQUIRES (for def-edebug-spec). - -2000-12-25 Michael Kifer - - * ediff-init.el (ediff-quit-hook,ediff-suspend-hook): changed - initialization; use add-hook. - (ediff-file-remote-p): use file-local-copy. - - * ediff-ptch.el (ediff-prompt-for-patch-buffer): improved defaults. - - * ediff.el (ediff-patch-buffer): bug fix. - (ediff-revision): allow selection of the file at the prompt. - -2000-11-24 Michael Kifer - - * ediff-diff.el: Moved variables around to have it compile under NT. - - * ediff-help.el (ediff-use-long-help-message): made it customizable. - - * ediff-init.el (ediff-abbrev-jobname): use capitalize. - - * ediff-wind.el (ediff-skip-unsuitable-frames): deleted the - redundant skip-small-frames test. - -2000-10-29 Michael Kifer - - * ediff-wind.el (ediff-setup-control-frame): enclose - face-attribute in condition-case to avoid errors in older emacsen. - -2000-10-29 Michael Kifer - - * ediff-init.el (ediff-before-setup-hook): new hook. - Several typos fixed in various docstrings. - * ediff-merg.el (ediff-show-clashes-only): docstring typo fixed. - * ediff-nult.el (ediff-before-session-group-setup-hooks): new - hook. - (ediff-show-meta-buffer): run ediff-before-session-group-setup-hooks. - * ediff-util.el (ediff-setup): run ediff-before-setup-hook. - (ediff-other-buffer): use selected buffers if in Buffer-menu buffer. - (ediff-get-selected-buffers): new function. - * ediff-vers.el (ediff-vc-internal,ediff-rcs-internal, - ediff-vc-merge-internal,ediff-rcs-merge-internal): use - save-window-excursion. - * ediff-wind.el (ediff-skip-unsuitable-frames): more robust - termination check in while loop. - * ediff.el (ediff-get-default-file-name): better defaults when in - dired buffer. - (ediff-files,ediff-merge-files,ediff-files3, - ediff-merge-files-with-ancestor): use ediff-get-default-file-name. - -2000-07-05 Michael Kifer - - * ediff-diff.el (ediff-wordify): use syntax table. - * ediff-init.el (ediff-has-face-support-p): use - ediff-color-display-p. - (ediff-color-display-p): use display-color-p, changed to defun - from defsubst. - Got rid of special cases for NeXT and OS/2. - * ediff-wind.el (ediff-setup-control-frame): set proper modeline - face. - -2000-06-05 Michael Kifer - - * ediff-init.el (ediff-has-face-support-p): make it paint faces on - tty's. - * ediff-diff.el (ediff-exec-process): use --binary for fine - differences whenever apropriate. - -2000-05-25 Michael Kifer - - * ediff-diff.el (ediff-exec-process): delete --binary option from - non-buffer ediff jobs. - -2000-05-24 Michael Kifer - - * ediff-diff.el (ediff-forward-word): take syntactic word class into - account. - (ediff-test-utility,ediff-diff-mandatory-option, - ediff-reset-diff-options): utilities for proper initialization of - ediff-diff-options and ediff-diff3-options on Windows. - - * ediff-init.el (ediff-merge-filename-prefix): new customizable - variable. - - * ediff-mult.el (ediff-filegroup-action): use - ediff-merge-filename-prefix. - -2000-2-28 Michael Kifer - * ediff-wind.el: minor comment changes. - * ediff.el: copyright notice date fix. - -1999-12-15 Gunnar Evermann - - * ediff-help.el (ediff-customize): Add autoload cookie. - -1999-11-24 Michael Kifer - - * ediff*el: replaced old-style backquotes. - - * ediff-merge - (ediff-looks-like-combined-merge,ediff-get-combined-region): - changed to support the new format for ediff-combination-pattern. - - * ediff-diff (ediff-set-fine-overlays-in-one-buffer): - changed to support the new format for ediff-combination-pattern. - - * ediff.texi: Describe the new format for - ediff-combination-pattern. - -1999-11-01 Michael Kifer - - * ediff-diff.el (ediff-cmp-options): new var. - (ediff-same-file-contents): use ediff-cmp-options. - - * ediff-ptch.el (ediff-prompt-for-patch-buffer, - ediff-get-patch-buffer): use current buffer if it appears to be a - patch. - - * ediff-util.el (ediff-file-checked-in-p): don't consider CVS - files checked in. - (ediff-make-temp-file,ediff-make-empty-tmp-file): Make sure you - are writing to a newly created empty file. - - * ediff.texi: minor improvements. - -1999-08-18 Michael Kifer - - * ediff-init.el (ediff-temp-file-prefix): better initialization - - * eviff-vers.el (ediff-vc-merge-internal): small buglet fix - - * ediff.el: comment change - -1999-05-27 SL Baur - - * Makefile: bump version number. - -1999-05-16 Michael Kifer - - * ediff.el, ediff-util.el: Enable ediff-merge-directories-* to be - called with a parameter that specifies the directory where the - merged files are to be saved. - -1999-04-06 Andreas Jaeger - - * ediff.texi: Add comma to satisfy texinfo 3.12f+'s grammar - checker. - -1999-03-03 Michael Kifer - - * ediff-mult.el (ediff-get-directory-files-under-revision): Use - absolute file names. - -1999-03-03 Adrian Aichner - - * ediff-init.el (stipple-pixmap): Locate "stipple" library in - x-bitmap-file-path if bound, else try to locate it in - mswindows-bitmap-file-path, if bound. - -1999-02-16 Michael Kifer - - * ediff-help.el (ediff-customize): new command. - - * ediff-hooks.el: added menu item for customizing ediff. - -1999-02-06 SL Baur - - * ediff-init.el (stipple-pixmap): Move x bitmap dependency to - runtime. - -1999-01-18 Michael Kifer - - * ediff-patch.el: (ediff-patch-buffer-internal): changed message. - -1998-12-09 SL Baur - - * ediff-tbar.el (ediff-toolbar-icon-directory): Don't assume there - is always toolbar support. - -1998-10-8 Michael Kifer - - * ediff-util.el (ediff-cleanup-mess): fixed the case of dead windows. - make sure you are in a good frame before deleting other - windows. - - * ediff-mult.el (ediff-show-session-group-hook): new default. - - * ediff-vers.el (ediff-pcl-cvs-view-revision): - first cd to the file directory. reportedly works - better with remote files. - - * ediff-vers.el (ediff-pcl-cvs-internal, ediff-pcl-cvs-merge-internal): - use file-name-nondirectory when passing files to CVS. - -1998-07-20 Michael Kifer - - * ediff-help.el (ediff-long-help-message-merge): default changed. - - * ediff-util.el (ediff-status-info): updated. - (ediff-toggle-skip-changed-regions): new function. - (ediff-next-difference, ediff-previous-difference): - now skips white space correctly in the merge mode. - (ediff-write-merge-buffer-and-maybe-kill, - ediff-maybe-save-and-delete-merge): changed to give more options to - the user. - (ediff-other-buffer): no longer skips mail buffers. - - * ediff-merg.el (ediff-skip-merge-regions-that-differ-from-default): - new variable. - (ediff-skip-merge-region-if-changed-from-default-p, - ediff-merge-changed-from-default-p): new functions. - - * ediff-wind.el (ediff-control-frame-parameters): - improved, to reduce distraction. - (ediff-skip-unsuitable-frames): make it skip small windows. - - * ediff-diff.el, ediff-init.el: Improved comments. - - * ediff-mult.el (ediff-hide-marked-sessions): - make it redraw the meta buffer. - (ediff-collect-custom-diffs): make the diff buffer read-only, not - modified. - (ediff-mark-for-hiding, ediff-mark-for-operation): renamed to *-at-pos. - (ediff-mark-session-for-hiding, ediff-mark-session-for-operation, - ediff-unmark-all-for-operation, ediff-unmark-all-for-hiding): new - functions. - (ediff-setup-meta-map): changed bindings. - - * ediff.el, ediff-init.el, ediff-ptch.el, ediff-help.el, - ediff-diff.el, ediff-tbar.el, ediff-wind.el, ediff-mult.el: Removed - function quotes around lambdas. - - * ediff.texi: add section about $*. - - -1998-04-27 SL Baur - - * dumped-lisp.el: removed. - -1998-02-25 SL Baur - - * ediff-tbar.el (ediff-toolbar-icon-directory): New variable. - (ediff-toolbar-next-icon): Use it. - (ediff-toolbar-previous-icon): Ditto. - (ediff-toolbar-A-icon): Ditto. - (ediff-toolbar-B-icon): Ditto. - (ediff-toolbar-toggle-split-icon): Ditto. - (ediff-toolbar-save-icon): Ditto. - (ediff-toolbar-quit-icon): Ditto. - (ediff-toolbar-help-icon): Ditto. - (ediff-toolbar-refresh-icon): Ditto. - (ediff-toolbar-refine-icon): Ditto. - - * ediff.texi: Add direntry section for automated installation. - -1998-01-24 SL Baur - - * Makefile (VERSION): Update to package standard 1.0. - * package-info.in: Ditto. - -1998-01-03 SL Baur - - * Makefile: Update to newer package interface. - -1997-12-25 SL Baur - - * Makefile: Created. diff --git a/xemacs-packages/lisp/ediff/README b/xemacs-packages/lisp/ediff/README deleted file mode 100644 index dd5a58fd..00000000 --- a/xemacs-packages/lisp/ediff/README +++ /dev/null @@ -1,70 +0,0 @@ -**** EDIFF -- a comprehensive interface to diff for Emacs and XEmacs - -This directory: - -README -- This file -Makefile -- Automated installation file -ediff.texi -- Manual in Texinfo format -ediff, ediff-? -- The Info files -ediff.dvi -- Manual in DVI format - -ediff.el -- Ediff Emacs Lisp code -ediff-init.el -- Ediff Emacs Lisp code -ediff-help.el -- Ediff Emacs Lisp code -ediff-wind.el -- Ediff Emacs Lisp code -ediff-util.el -- Ediff Emacs Lisp code -ediff-diff.el -- Ediff Emacs Lisp code -ediff-merg.el -- Ediff Emacs Lisp code -ediff-mult.el -- Ediff Emacs Lisp code -ediff-vers.el -- Ediff Emacs Lisp code -ediff-ptch.el -- Ediff Emacs Lisp code -ediff-tbar.el -- Ediff Emacs Lisp code -- for XEmacs only -ediff-hook.el -- Ediff Emacs Lisp code -toolbar/ -- Ediff toolbar icons -- for XEmacs only - - -To install Ediff do: - - uncompress ediff.tar.Z - tar xf ediff.tar - - -Then do the following: - -1. To compile Lisp: - - make (or 'make all') - -2. You can also type - - make install - - to do what "make all" does plus it will copy the files ediff*.elc - into a suitable Lisp directory. - - To make this happen, you will most likely have to change the PREFIX - variable in Makefile and, possibly, one or more of these variables: - - DATADIR, LISPDIR, INFODIR, ETCDIR, and VERSION - - if they don't point to the right directories in your installation. - You also need to have a write permission for all directories - mentioned in LISPDIR, INFODIR, and ETCDIR. - -3. XEmacs users must invoke `make' with the parameter EMACS=xemacs. - Even better: edit Makefile directly. - -4. Under XEmacs, copy the icons in the `toolbar' directory into - the-directory-where-xemacs-installed/etc/toolbar/ - -Normally, all Ediff menus and autoloads are already defined in Emacs, so you -don't need to define anything in your .emacs to run Ediff. -However, if it was announced that this distribution of Ediff contains -new features, you may need to put - -(require 'ediff-hook) - -in your .emacs to take advantage of these new features. This doesn't load -Ediff, but readies Emacs for the things to come. When this version of -Ediff gets installed in the standard Emacs distribution, you can remove -the above require-statement (but leaving it in does no harm). diff --git a/xemacs-packages/lisp/ediff/_pkg.el b/xemacs-packages/lisp/ediff/_pkg.el deleted file mode 100644 index 3c55d88b..00000000 --- a/xemacs-packages/lisp/ediff/_pkg.el +++ /dev/null @@ -1,5 +0,0 @@ -;;;###autoload -(package-provide 'ediff - :version 1.62 - :author-version "2.75" - :type 'regular) diff --git a/xemacs-packages/lisp/ediff/auto-autoloads.el b/xemacs-packages/lisp/ediff/auto-autoloads.el deleted file mode 100644 index 09bc5521..00000000 --- a/xemacs-packages/lisp/ediff/auto-autoloads.el +++ /dev/null @@ -1,230 +0,0 @@ -;;; DO NOT MODIFY THIS FILE -(if (featurep 'ediff-autoloads) (error "Already loaded")) - -;;;### (autoloads nil "_pkg" "ediff/_pkg.el") - -(package-provide 'ediff :version 1.62 :author-version "2.75" :type 'regular) - -;;;*** - -;;;### (autoloads (ediff-customize) "ediff-help" "ediff/ediff-help.el") - -(autoload 'ediff-customize "ediff-help" nil t nil) - -;;;*** - -;;;### (autoloads nil "ediff-hook" "ediff/ediff-hook.el") - -(defvar ediff-window-setup-function) -(defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form) (if (string-match "XEmacs" emacs-version) xemacs-form emacs-form)) - -(ediff-cond-compile-for-xemacs-or-emacs (defun ediff-xemacs-init-menus nil (if (featurep 'menubar) (progn (add-submenu '("Tools") ediff-menu "OO-Browser...") (add-submenu '("Tools") ediff-merge-menu "OO-Browser...") (add-submenu '("Tools") epatch-menu "OO-Browser...") (add-submenu '("Tools") ediff-misc-menu "OO-Browser...") (add-menu-button '("Tools") "-------" "OO-Browser...")))) nil) - -(ediff-cond-compile-for-xemacs-or-emacs (progn (defvar ediff-menu '("Compare" ["Two Files..." ediff-files t] ["Two Buffers..." ediff-buffers t] ["Three Files..." ediff-files3 t] ["Three Buffers..." ediff-buffers3 t] "---" ["Two Directories..." ediff-directories t] ["Three Directories..." ediff-directories3 t] "---" ["File with Revision..." ediff-revision t] ["Directory Revisions..." ediff-directory-revisions t] "---" ["Windows Word-by-word..." ediff-windows-wordwise t] ["Windows Line-by-line..." ediff-windows-linewise t] "---" ["Regions Word-by-word..." ediff-regions-wordwise t] ["Regions Line-by-line..." ediff-regions-linewise t])) (defvar ediff-merge-menu '("Merge" ["Files..." ediff-merge-files t] ["Files with Ancestor..." ediff-merge-files-with-ancestor t] ["Buffers..." ediff-merge-buffers t] ["Buffers with Ancestor..." ediff-merge-buffers-with-ancestor t] "---" ["Directories..." ediff-merge-directories t] ["Directories with Ancestor..." ediff-merge-directories-with-ancestor t] "---" ["Revisions..." ediff-merge-revisions t] ["Revisions with Ancestor..." ediff-merge-revisions-with-ancestor t] ["Directory Revisions..." ediff-merge-directory-revisions t] ["Directory Revisions with Ancestor..." ediff-merge-directory-revisions-with-ancestor t])) (defvar epatch-menu '("Apply Patch" ["To a file..." ediff-patch-file t] ["To a buffer..." ediff-patch-buffer t])) (defvar ediff-misc-menu '("Ediff Miscellanea" ["Ediff Manual" ediff-documentation t] ["Customize Ediff" ediff-customize t] ["List Ediff Sessions" ediff-show-registry t] ["Use separate frame for Ediff control buffer" ediff-toggle-multiframe :style toggle :selected (if (and (featurep 'ediff-util) (boundp 'ediff-window-setup-function)) (eq ediff-window-setup-function 'ediff-setup-windows-multiframe))] ["Use a toolbar with Ediff control buffer" ediff-toggle-use-toolbar :style toggle :selected (if (featurep 'ediff-tbar) (ediff-use-toolbar-p))])) (if (and (featurep 'menubar) (not (featurep 'infodock)) (not (featurep 'ediff-hook))) (ediff-xemacs-init-menus))) (if (featurep 'menu-bar) (progn (defvar menu-bar-ediff-misc-menu (make-sparse-keymap "Ediff Miscellanea")) (fset 'menu-bar-ediff-misc-menu (symbol-value 'menu-bar-ediff-misc-menu)) (defvar menu-bar-epatch-menu (make-sparse-keymap "Apply Patch")) (fset 'menu-bar-epatch-menu (symbol-value 'menu-bar-epatch-menu)) (defvar menu-bar-ediff-merge-menu (make-sparse-keymap "Merge")) (fset 'menu-bar-ediff-merge-menu (symbol-value 'menu-bar-ediff-merge-menu)) (defvar menu-bar-ediff-menu (make-sparse-keymap "Compare")) (fset 'menu-bar-ediff-menu (symbol-value 'menu-bar-ediff-menu)) (define-key menu-bar-ediff-menu [window] '("This Window and Next Window" . compare-windows)) (define-key menu-bar-ediff-menu [ediff-windows-linewise] '("Windows Line-by-line..." . ediff-windows-linewise)) (define-key menu-bar-ediff-menu [ediff-windows-wordwise] '("Windows Word-by-word..." . ediff-windows-wordwise)) (define-key menu-bar-ediff-menu [separator-ediff-windows] '("--")) (define-key menu-bar-ediff-menu [ediff-regions-linewise] '("Regions Line-by-line..." . ediff-regions-linewise)) (define-key menu-bar-ediff-menu [ediff-regions-wordwise] '("Regions Word-by-word..." . ediff-regions-wordwise)) (define-key menu-bar-ediff-menu [separator-ediff-regions] '("--")) (define-key menu-bar-ediff-menu [ediff-dir-revision] '("Directory Revisions..." . ediff-directory-revisions)) (define-key menu-bar-ediff-menu [ediff-revision] '("File with Revision..." . ediff-revision)) (define-key menu-bar-ediff-menu [separator-ediff-directories] '("--")) (define-key menu-bar-ediff-menu [ediff-directories3] '("Three Directories..." . ediff-directories3)) (define-key menu-bar-ediff-menu [ediff-directories] '("Two Directories..." . ediff-directories)) (define-key menu-bar-ediff-menu [separator-ediff-files] '("--")) (define-key menu-bar-ediff-menu [ediff-buffers3] '("Three Buffers..." . ediff-buffers3)) (define-key menu-bar-ediff-menu [ediff-files3] '("Three Files..." . ediff-files3)) (define-key menu-bar-ediff-menu [ediff-buffers] '("Two Buffers..." . ediff-buffers)) (define-key menu-bar-ediff-menu [ediff-files] '("Two Files..." . ediff-files)) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor] '("Directory Revisions with Ancestor..." . ediff-merge-directory-revisions-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions] '("Directory Revisions..." . ediff-merge-directory-revisions)) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions-with-ancestor] '("Revisions with Ancestor..." . ediff-merge-revisions-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions] '("Revisions..." . ediff-merge-revisions)) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge] '("--")) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories-with-ancestor] '("Directories with Ancestor..." . ediff-merge-directories-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories] '("Directories..." . ediff-merge-directories)) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge-dirs] '("--")) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers-with-ancestor] '("Buffers with Ancestor..." . ediff-merge-buffers-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers] '("Buffers..." . ediff-merge-buffers)) (define-key menu-bar-ediff-merge-menu [ediff-merge-files-with-ancestor] '("Files with Ancestor..." . ediff-merge-files-with-ancestor)) (define-key menu-bar-ediff-merge-menu [ediff-merge-files] '("Files..." . ediff-merge-files)) (define-key menu-bar-epatch-menu [ediff-patch-buffer] '("To a Buffer..." . ediff-patch-buffer)) (define-key menu-bar-epatch-menu [ediff-patch-file] '("To a File..." . ediff-patch-file)) (define-key menu-bar-ediff-misc-menu [emultiframe] '("Toggle use of separate control buffer frame" . ediff-toggle-multiframe)) (define-key menu-bar-ediff-misc-menu [eregistry] '("List Ediff Sessions" . ediff-show-registry)) (define-key menu-bar-ediff-misc-menu [ediff-cust] '("Customize Ediff" . ediff-customize)) (define-key menu-bar-ediff-misc-menu [ediff-doc] '("Ediff Manual" . ediff-documentation))))) - -;;;*** - -;;;### (autoloads (ediff-show-registry) "ediff-mult" "ediff/ediff-mult.el") - -(autoload 'ediff-show-registry "ediff-mult" "\ -Display Ediff's registry." t nil) - -(defalias 'eregistry 'ediff-show-registry) - -;;;*** - -;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe) "ediff-util" "ediff/ediff-util.el") - -(autoload 'ediff-toggle-multiframe "ediff-util" "\ -Switch from multiframe display to single-frame display and back. -To change the default, set the variable `ediff-window-setup-function', -which see." t nil) - -(autoload 'ediff-toggle-use-toolbar "ediff-util" "\ -Enable or disable Ediff toolbar. -Works only in versions of Emacs that support toolbars. -To change the default, set the variable `ediff-use-toolbar-p', which see." t nil) - -;;;*** - -;;;### (autoloads (ediff-documentation ediff-version ediff-revision ediff-patch-buffer ediff-patch-file run-ediff-from-cvs-buffer ediff-merge-revisions-with-ancestor ediff-merge-revisions ediff-merge-buffers-with-ancestor ediff-merge-buffers ediff-merge-files-with-ancestor ediff-merge-files ediff-regions-linewise ediff-regions-wordwise ediff-windows-linewise ediff-windows-wordwise ediff-merge-directory-revisions-with-ancestor ediff-merge-directory-revisions ediff-merge-directories-with-ancestor ediff-merge-directories ediff-directories3 ediff-directory-revisions ediff-directories ediff-buffers3 ediff-buffers ediff-backup ediff-files3 ediff-files) "ediff" "ediff/ediff.el") - -(autoload 'ediff-files "ediff" "\ -Run Ediff on a pair of files, FILE-A and FILE-B." t nil) - -(autoload 'ediff-files3 "ediff" "\ -Run Ediff on three files, FILE-A, FILE-B, and FILE-C." t nil) - -(defalias 'ediff3 'ediff-files3) - -(defalias 'ediff 'ediff-files) - -(autoload 'ediff-backup "ediff" "\ -Run Ediff on FILE and its backup file. -Uses the latest backup, if there are several numerical backups. -If this file is a backup, `ediff' it with its original." t nil) - -(autoload 'ediff-buffers "ediff" "\ -Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B." t nil) - -(defalias 'ebuffers 'ediff-buffers) - -(autoload 'ediff-buffers3 "ediff" "\ -Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C." t nil) - -(defalias 'ebuffers3 'ediff-buffers3) - -(autoload 'ediff-directories "ediff" "\ -Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have -the same name in both. The third argument, REGEXP, is nil or a regular -expression; only file names that match the regexp are considered." t nil) - -(defalias 'edirs 'ediff-directories) - -(autoload 'ediff-directory-revisions "ediff" "\ -Run Ediff on a directory, DIR1, comparing its files with their revisions. -The second argument, REGEXP, is a regular expression that filters the file -names. Only the files that are under revision control are taken into account." t nil) - -(defalias 'edir-revisions 'ediff-directory-revisions) - -(autoload 'ediff-directories3 "ediff" "\ -Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that -have the same name in all three. The last argument, REGEXP, is nil or a -regular expression; only file names that match the regexp are considered." t nil) - -(defalias 'edirs3 'ediff-directories3) - -(autoload 'ediff-merge-directories "ediff" "\ -Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have -the same name in both. The third argument, REGEXP, is nil or a regular -expression; only file names that match the regexp are considered." t nil) - -(defalias 'edirs-merge 'ediff-merge-directories) - -(autoload 'ediff-merge-directories-with-ancestor "ediff" "\ -Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors. -Ediff merges files that have identical names in DIR1, DIR2. If a pair of files -in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge -without ancestor. The fourth argument, REGEXP, is nil or a regular expression; -only file names that match the regexp are considered." t nil) - -(autoload 'ediff-merge-directory-revisions "ediff" "\ -Run Ediff on a directory, DIR1, merging its files with their revisions. -The second argument, REGEXP, is a regular expression that filters the file -names. Only the files that are under revision control are taken into account." t nil) - -(defalias 'edir-merge-revisions 'ediff-merge-directory-revisions) - -(autoload 'ediff-merge-directory-revisions-with-ancestor "ediff" "\ -Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors. -The second argument, REGEXP, is a regular expression that filters the file -names. Only the files that are under revision control are taken into account." t nil) - -(defalias 'edir-merge-revisions-with-ancestor 'ediff-merge-directory-revisions-with-ancestor) - -(defalias 'edirs-merge-with-ancestor 'ediff-merge-directories-with-ancestor) - -(autoload 'ediff-windows-wordwise "ediff" "\ -Compare WIND-A and WIND-B, which are selected by clicking, wordwise. -With prefix argument, DUMB-MODE, or on a non-windowing display, works as -follows: -If WIND-A is nil, use selected window. -If WIND-B is nil, use window next to WIND-A." t nil) - -(autoload 'ediff-windows-linewise "ediff" "\ -Compare WIND-A and WIND-B, which are selected by clicking, linewise. -With prefix argument, DUMB-MODE, or on a non-windowing display, works as -follows: -If WIND-A is nil, use selected window. -If WIND-B is nil, use window next to WIND-A." t nil) - -(autoload 'ediff-regions-wordwise "ediff" "\ -Run Ediff on a pair of regions in specified buffers. -Regions (i.e., point and mark) are assumed to be set in advance except -for the second region in the case both regions are from the same buffer. -In such a case the user is asked to interactively establish the second -region. -This function is effective only for relatively small regions, up to 200 -lines. For large regions, use `ediff-regions-linewise'." t nil) - -(autoload 'ediff-regions-linewise "ediff" "\ -Run Ediff on a pair of regions in specified buffers. -Regions (i.e., point and mark) are assumed to be set in advance except -for the second region in the case both regions are from the same buffer. -In such a case the user is asked to interactively establish the second -region. -Each region is enlarged to contain full lines. -This function is effective for large regions, over 100-200 -lines. For small regions, use `ediff-regions-wordwise'." t nil) - -(defalias 'ediff-merge 'ediff-merge-files) - -(autoload 'ediff-merge-files "ediff" "\ -Merge two files without ancestor." t nil) - -(autoload 'ediff-merge-files-with-ancestor "ediff" "\ -Merge two files with ancestor." t nil) - -(defalias 'ediff-merge-with-ancestor 'ediff-merge-files-with-ancestor) - -(autoload 'ediff-merge-buffers "ediff" "\ -Merge buffers without ancestor." t nil) - -(autoload 'ediff-merge-buffers-with-ancestor "ediff" "\ -Merge buffers with ancestor." t nil) - -(autoload 'ediff-merge-revisions "ediff" "\ -Run Ediff by merging two revisions of a file. -The file is the optional FILE argument or the file visited by the current -buffer." t nil) - -(autoload 'ediff-merge-revisions-with-ancestor "ediff" "\ -Run Ediff by merging two revisions of a file with a common ancestor. -The file is the optional FILE argument or the file visited by the current -buffer." t nil) - -(autoload 'run-ediff-from-cvs-buffer "ediff" "\ -Run Ediff-merge on appropriate revisions of the selected file. -First run after `M-x cvs-update'. Then place the cursor on a line describing a -file and then run `run-ediff-from-cvs-buffer'." t nil) - -(autoload 'ediff-patch-file "ediff" "\ -Run Ediff by patching SOURCE-FILENAME. -If optional PATCH-BUF is given, use the patch in that buffer -and don't ask the user. -If prefix argument, then: if even argument, assume that the patch is in a -buffer. If odd -- assume it is in a file." t nil) - -(autoload 'ediff-patch-buffer "ediff" "\ -Run Ediff by patching the buffer specified at prompt. -Without the optional prefix ARG, asks if the patch is in some buffer and -prompts for the buffer or a file, depending on the answer. -With ARG=1, assumes the patch is in a file and prompts for the file. -With ARG=2, assumes the patch is in a buffer and prompts for the buffer. -PATCH-BUF is an optional argument, which specifies the buffer that contains the -patch. If not given, the user is prompted according to the prefix argument." t nil) - -(defalias 'epatch 'ediff-patch-file) - -(defalias 'epatch-buffer 'ediff-patch-buffer) - -(autoload 'ediff-revision "ediff" "\ -Run Ediff by comparing versions of a file. -The file is an optional FILE argument or the file entered at the prompt. -Default: the file visited by the current buffer. -Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'." t nil) - -(defalias 'erevision 'ediff-revision) - -(autoload 'ediff-version "ediff" "\ -Return string describing the version of Ediff. -When called interactively, displays the version." t nil) - -(autoload 'ediff-documentation "ediff" "\ -Display Ediff's manual. -With optional NODE, goes to that node." t nil) - -;;;*** - -(provide 'ediff-autoloads) diff --git a/xemacs-packages/lisp/ediff/custom-load.el b/xemacs-packages/lisp/ediff/custom-load.el deleted file mode 100644 index 45b71e64..00000000 --- a/xemacs-packages/lisp/ediff/custom-load.el +++ /dev/null @@ -1,18 +0,0 @@ -;;; custom-load.el --- automatically extracted custom dependencies - -;;; Code: - -(autoload 'custom-add-loads "cus-load") - -(custom-add-loads 'tools '("ediff")) -(custom-add-loads 'ediff-hook '("ediff-init" "ediff-mult")) -(custom-add-loads 'ediff-diff '("ediff-diff")) -(custom-add-loads 'ediff-window '("ediff-help" "ediff-wind")) -(custom-add-loads 'frames '("ediff-wind")) -(custom-add-loads 'ediff-ptch '("ediff-ptch")) -(custom-add-loads 'ediff-merge '("ediff-init" "ediff-merg")) -(custom-add-loads 'ediff-highlighting '("ediff-init")) -(custom-add-loads 'ediff-mult '("ediff-mult")) -(custom-add-loads 'ediff '("ediff-diff" "ediff-init" "ediff-mult" "ediff-ptch" "ediff-tbar" "ediff-wind" "ediff")) - -;;; custom-load.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-diff.el b/xemacs-packages/lisp/ediff/ediff-diff.el deleted file mode 100644 index 013ed907..00000000 --- a/xemacs-packages/lisp/ediff/ediff-diff.el +++ /dev/null @@ -1,1559 +0,0 @@ -;;; ediff-diff.el --- diff-related utilities - -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - - -;; compiler pacifier -(defvar ediff-default-variant) -(defvar null-device) -(defvar longlines-mode) - -(eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - (or (featurep 'ediff-util) - (load "ediff-util.el" nil nil 'nosuffix)) - )) -;; end pacifier - -(require 'ediff-init) - -(defgroup ediff-diff nil - "Diff related utilities." - :prefix "ediff-" - :group 'ediff) - -;; these two must be here to prevent ediff-test-utility from barking -(defcustom ediff-diff-program "diff" - "*Program to use for generating the differential of the two files." - :type 'string - :group 'ediff-diff) -(defcustom ediff-diff3-program "diff3" - "*Program to be used for three-way comparison. -Must produce output compatible with Unix's diff3 program." - :type 'string - :group 'ediff-diff) - - -;; The following functions must precede all defcustom-defined variables. - -;; The following functions needed for setting diff/diff3 options -;; test if diff supports the --binary option -(defsubst ediff-test-utility (diff-util option &optional files) - (eq 0 (apply 'call-process - (append (list diff-util nil nil nil option) files)))) - -(defun ediff-diff-mandatory-option (diff-util) - (let ((file (if (boundp 'null-device) null-device "/dev/null"))) - (cond ((not (memq system-type '(ms-dos windows-nt windows-95))) - "") - ((and (string= diff-util ediff-diff-program) - (ediff-test-utility - ediff-diff-program "--binary" (list file file))) - "--binary") - ((and (string= diff-util ediff-diff3-program) - (ediff-test-utility - ediff-diff3-program "--binary" (list file file file))) - "--binary") - (t "")))) - -;; make sure that mandatory options are added even if the user changes -;; ediff-diff-options or ediff-diff3-options in the customization widget -(defun ediff-reset-diff-options (symb val) - (let* ((diff-program - (if (eq symb 'ediff-diff-options) - ediff-diff-program - ediff-diff3-program)) - (mandatory-option (ediff-diff-mandatory-option diff-program)) - (spacer (if (string-equal mandatory-option "") "" " "))) - (set symb - (if (string-match mandatory-option val) - val - (concat mandatory-option spacer val))) - )) - - -(defcustom ediff-shell - (cond ((eq system-type 'emx) "cmd") ; OS/2 - ((memq system-type '(ms-dos windows-nt windows-95)) - shell-file-name) ; no standard name on MS-DOS - ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VMS - (t "sh")) ; UNIX - "*The shell used to run diff and patch. -If user's .profile or .cshrc files are set up correctly, any shell -will do. However, some people set $prompt or other things -incorrectly, which leads to undesirable output messages. These may -cause Ediff to fail. In such a case, set `ediff-shell' to a shell that -you are not using or, better, fix your shell's startup file." - :type 'string - :group 'ediff-diff) - -(defcustom ediff-cmp-program "cmp" - "*Utility to use to determine if two files are identical. -It must return code 0, if its arguments are identical files." - :type 'string - :group 'ediff-diff) - -(defcustom ediff-cmp-options nil - "*Options to pass to `ediff-cmp-program'. -If GNU diff is used as `ediff-cmp-program', then the most useful options -are `-I REGEXP', to ignore changes whose lines match the REGEXP." - :type '(repeat string) - :group 'ediff-diff) - -(defcustom ediff-diff-options "" - "*Options to pass to `ediff-diff-program'. -If Unix diff is used as `ediff-diff-program', then a useful option is -`-w', to ignore space, and `-i', to ignore case of letters. -Options `-c' and `-i' are not allowed. Case sensitivity can be toggled -interactively using [ediff-toggle-ignore-case]" - :set 'ediff-reset-diff-options - :type 'string - :group 'ediff-diff) - -(ediff-defvar-local ediff-ignore-case nil - "*If t, skip over difference regions that differ only in letter case. -This variable can be set either in .emacs or toggled interactively. -Use `setq-default' if setting it in .emacs") - -(defcustom ediff-ignore-case-option "-i" - "*Option that causes the diff program to ignore case of letters." - :type 'string - :group 'ediff-diff) - -(defcustom ediff-ignore-case-option3 "" - "*Option that causes the diff3 program to ignore case of letters. -GNU diff3 doesn't have such an option." - :type 'string - :group 'ediff-diff) - -;; the actual options used in comparison -(ediff-defvar-local ediff-actual-diff-options "" "") - -(defcustom ediff-custom-diff-program ediff-diff-program - "*Program to use for generating custom diff output for saving it in a file. -This output is not used by Ediff internally." - :type 'string - :group 'ediff-diff) -(defcustom ediff-custom-diff-options "-c" - "*Options to pass to `ediff-custom-diff-program'." - :type 'string - :group 'ediff-diff) - -;;; Support for diff3 - -(defvar ediff-match-diff3-line "^====\\(.?\\)\C-m?$" - "Pattern to match lines produced by diff3 that describe differences.") -(defcustom ediff-diff3-options "" - "*Options to pass to `ediff-diff3-program'." - :set 'ediff-reset-diff-options - :type 'string - :group 'ediff-diff) - -;; the actual options used in comparison -(ediff-defvar-local ediff-actual-diff3-options "" "") - -(defcustom ediff-diff3-ok-lines-regexp - "^\\([1-3]:\\|====\\| \\|.*Warning *:\\|.*No newline\\|.*missing newline\\|^\C-m$\\)" - "*Regexp that matches normal output lines from `ediff-diff3-program'. -Lines that do not match are assumed to be error messages." - :type 'regexp - :group 'ediff-diff) - -;; keeps the status of the current diff in 3-way jobs. -;; the status can be =diff(A), =diff(B), or =diff(A+B) -(ediff-defvar-local ediff-diff-status "" "") - - -;;; Fine differences - -(ediff-defvar-local ediff-auto-refine (if (ediff-has-face-support-p) 'on 'nix) - "If `on', Ediff auto-highlights fine diffs for the current diff region. -If `off', auto-highlighting is not used. If `nix', no fine diffs are shown -at all, unless the user force-refines the region by hitting `*'. - -This variable can be set either in .emacs or toggled interactively. -Use `setq-default' if setting it in .emacs") - -(ediff-defvar-local ediff-ignore-similar-regions nil - "*If t, skip over difference regions that differ only in the white space and line breaks. -This variable can be set either in .emacs or toggled interactively. -Use `setq-default' if setting it in .emacs") - -(ediff-defvar-local ediff-auto-refine-limit 14000 - "*Auto-refine only the regions of this size \(in bytes\) or less.") - -;;; General - -(defvar ediff-diff-ok-lines-regexp - (concat - "^\\(" - "[0-9,]+[acd][0-9,]+\C-m?$" - "\\|[<>] " - "\\|---" - "\\|.*Warning *:" - "\\|.*No +newline" - "\\|.*missing +newline" - "\\|^\C-m?$" - "\\)") - "Regexp that matches normal output lines from `ediff-diff-program'. -This is mostly lifted from Emerge, except that Ediff also considers -warnings and `Missing newline'-type messages to be normal output. -Lines that do not match are assumed to be error messages.") - -(defvar ediff-match-diff-line - (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)")) - (concat "^" x "\\([acd]\\)" x "\C-m?$")) - "Pattern to match lines produced by diff that describe differences.") - -(ediff-defvar-local ediff-setup-diff-regions-function nil - "value is a function symbol depending on the kind of job is to be done. -For 2-way jobs and for ediff-merge, it should be `ediff-setup-diff-regions'. -For jobs requiring diff3, it should be `ediff-setup-diff-regions3'. - -The function should take three mandatory arguments, file-A, file-B, and -file-C. It may ignore file C for diff2 jobs. It should also take -one optional arguments, diff-number to refine.") - - -;;; Functions - -;; Generate the difference vector and overlays for the two files -;; With optional arg REG-TO-REFINE, refine this region. -;; File-C argument is not used here. It is there just because -;; ediff-setup-diff-regions is called via a funcall to -;; ediff-setup-diff-regions-function, which can also have the value -;; ediff-setup-diff-regions3, which takes 4 arguments. -(defun ediff-setup-diff-regions (file-A file-B file-C) - ;; looking for '-c', '-i', or a 'c', 'i' among clustered non-long options - (if (string-match "^-[ci]\\| -[ci]\\|\\(^\\| \\)-[^- ]+[ci]" - ediff-diff-options) - (error "Options `-c' and `-i' are not allowed in `ediff-diff-options'")) - - ;; create, if it doesn't exist - (or (ediff-buffer-live-p ediff-diff-buffer) - (setq ediff-diff-buffer - (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*")))) - (ediff-make-diff2-buffer ediff-diff-buffer file-A file-B) - (ediff-prepare-error-list ediff-diff-ok-lines-regexp ediff-diff-buffer) - (ediff-convert-diffs-to-overlays - (ediff-extract-diffs - ediff-diff-buffer ediff-word-mode ediff-narrow-bounds))) - -;; Run the diff program on FILE1 and FILE2 and put the output in DIFF-BUFFER -;; Return the size of DIFF-BUFFER -;; The return code isn't used in the program at present. -(defun ediff-make-diff2-buffer (diff-buffer file1 file2) - (let ((file1-size (ediff-file-size file1)) - (file2-size (ediff-file-size file2))) - (cond ((not (numberp file1-size)) - (message "Can't find file: %s" - (ediff-abbreviate-file-name file1)) - (sit-for 2) - ;; 1 is an error exit code - 1) - ((not (numberp file2-size)) - (message "Can't find file: %s" - (ediff-abbreviate-file-name file2)) - (sit-for 2) - ;; 1 is an error exit code - 1) - (t (message "Computing differences between %s and %s ..." - (file-name-nondirectory file1) - (file-name-nondirectory file2)) - ;; this erases the diff buffer automatically - (ediff-exec-process ediff-diff-program - diff-buffer - 'synchronize - ediff-actual-diff-options file1 file2) - (message "") - (ediff-with-current-buffer diff-buffer - (buffer-size)))))) - - - -;; If file-A/B/C is nil, do 2-way comparison with the non-nil buffers -;; This function works for diff3 and diff2 jobs -(defun ediff-setup-fine-diff-regions (file-A file-B file-C reg-num) - (or (ediff-buffer-live-p ediff-fine-diff-buffer) - (setq ediff-fine-diff-buffer - (get-buffer-create - (ediff-unique-buffer-name "*ediff-fine-diff" "*")))) - - (let (diff3-job diff-program diff-options ok-regexp diff-list) - (setq diff3-job ediff-3way-job - diff-program (if diff3-job ediff-diff3-program ediff-diff-program) - diff-options (if diff3-job - ediff-actual-diff3-options - ediff-actual-diff-options) - ok-regexp (if diff3-job - ediff-diff3-ok-lines-regexp - ediff-diff-ok-lines-regexp)) - - (ediff-message-if-verbose "Refining difference region %d ..." (1+ reg-num)) - (ediff-exec-process diff-program ediff-fine-diff-buffer 'synchronize - diff-options - ;; The shuffle below is because we can compare 3-way - ;; or in several 2-way fashions, like fA fC, fA fB, - ;; or fB fC. - (if file-A file-A file-B) - (if file-B file-B file-A) - (if diff3-job - (if file-C file-C file-B)) - ) ; exec process - - (ediff-prepare-error-list ok-regexp ediff-fine-diff-buffer) - (ediff-message-if-verbose - "") - ;; "Refining difference region %d ... done" (1+ reg-num)) - - (setq diff-list - (if diff3-job - (ediff-extract-diffs3 - ediff-fine-diff-buffer '3way-comparison 'word-mode) - (ediff-extract-diffs ediff-fine-diff-buffer 'word-mode))) - ;; fixup diff-list - (if diff3-job - (cond ((not file-A) - (mapcar (lambda (elt) - (aset elt 0 nil) - (aset elt 1 nil)) - (cdr diff-list))) - ((not file-B) - (mapcar (lambda (elt) - (aset elt 2 nil) - (aset elt 3 nil)) - (cdr diff-list))) - ((not file-C) - (mapcar (lambda (elt) - (aset elt 4 nil) - (aset elt 5 nil)) - (cdr diff-list))) - )) - - (ediff-convert-fine-diffs-to-overlays diff-list reg-num) - )) - - -(defun ediff-prepare-error-list (ok-regexp diff-buff) - (or (ediff-buffer-live-p ediff-error-buffer) - (setq ediff-error-buffer - (get-buffer-create (ediff-unique-buffer-name - "*ediff-errors" "*")))) - (ediff-with-current-buffer ediff-error-buffer - (erase-buffer) - (insert (ediff-with-current-buffer diff-buff (buffer-string))) - (goto-char (point-min)) - (delete-matching-lines ok-regexp) - (if (memq system-type '(vax-vms axp-vms)) - (delete-matching-lines "^$"))) - ;; If diff reports errors, show them then quit. - (if (/= 0 (ediff-with-current-buffer ediff-error-buffer (buffer-size))) - (let ((ctl-buf ediff-control-buffer) - (error-buf ediff-error-buffer)) - (ediff-skip-unsuitable-frames) - (switch-to-buffer error-buf) - (ediff-kill-buffer-carefully ctl-buf) - (error "Errors in diff output. Diff output is in %S" diff-buff)))) - -;; BOUNDS specifies visibility bounds to use. -;; WORD-MODE tells whether we are in the word-mode or not. -;; If WORD-MODE, also construct vector of diffs using word numbers. -;; Else, use point values. -;; This function handles diff-2 jobs including the case of -;; merging buffers and files without ancestor. -(defun ediff-extract-diffs (diff-buffer word-mode &optional bounds) - (let ((A-buffer ediff-buffer-A) - (B-buffer ediff-buffer-B) - (C-buffer ediff-buffer-C) - (a-prev 1) ; this is needed to set the first diff line correctly - (a-prev-pt nil) - (b-prev 1) - (b-prev-pt nil) - (c-prev 1) - (c-prev-pt nil) - diff-list shift-A shift-B - ) - - ;; diff list contains word numbers, unless changed later - (setq diff-list (cons (if word-mode 'words 'points) - diff-list)) - ;; we don't use visibility bounds for buffer C when merging - (if bounds - (setq shift-A - (ediff-overlay-start - (ediff-get-value-according-to-buffer-type 'A bounds)) - shift-B - (ediff-overlay-start - (ediff-get-value-according-to-buffer-type 'B bounds)))) - - ;; reset point in buffers A/B/C - (ediff-with-current-buffer A-buffer - (goto-char (if shift-A shift-A (point-min)))) - (ediff-with-current-buffer B-buffer - (goto-char (if shift-B shift-B (point-min)))) - (if (ediff-buffer-live-p C-buffer) - (ediff-with-current-buffer C-buffer - (goto-char (point-min)))) - - (ediff-with-current-buffer diff-buffer - (goto-char (point-min)) - (while (re-search-forward ediff-match-diff-line nil t) - (let* ((a-begin (string-to-number (buffer-substring (match-beginning 1) - (match-end 1)))) - (a-end (let ((b (match-beginning 3)) - (e (match-end 3))) - (if b - (string-to-number (buffer-substring b e)) - a-begin))) - (diff-type (buffer-substring (match-beginning 4) (match-end 4))) - (b-begin (string-to-number (buffer-substring (match-beginning 5) - (match-end 5)))) - (b-end (let ((b (match-beginning 7)) - (e (match-end 7))) - (if b - (string-to-number (buffer-substring b e)) - b-begin))) - a-begin-pt a-end-pt b-begin-pt b-end-pt - c-begin c-end c-begin-pt c-end-pt) - ;; fix the beginning and end numbers, because diff is somewhat - ;; strange about how it numbers lines - (if (string-equal diff-type "a") - (setq b-end (1+ b-end) - a-begin (1+ a-begin) - a-end a-begin) - (if (string-equal diff-type "d") - (setq a-end (1+ a-end) - b-begin (1+ b-begin) - b-end b-begin) - ;; (string-equal diff-type "c") - (setq a-end (1+ a-end) - b-end (1+ b-end)))) - - (if (eq ediff-default-variant 'default-B) - (setq c-begin b-begin - c-end b-end) - (setq c-begin a-begin - c-end a-end)) - - ;; compute main diff vector - (if word-mode - ;; make diff-list contain word numbers - (setq diff-list - (nconc diff-list - (list - (if (ediff-buffer-live-p C-buffer) - (vector (- a-begin a-prev) (- a-end a-begin) - (- b-begin b-prev) (- b-end b-begin) - (- c-begin c-prev) (- c-end c-begin) - nil nil ; dummy ancestor - nil ; state of diff - nil ; state of merge - nil ; state of ancestor - ) - (vector (- a-begin a-prev) (- a-end a-begin) - (- b-begin b-prev) (- b-end b-begin) - nil nil ; dummy buf C - nil nil ; dummy ancestor - nil ; state of diff - nil ; state of merge - nil ; state of ancestor - )) - )) - a-prev a-end - b-prev b-end - c-prev c-end) - ;; else convert lines to points - (ediff-with-current-buffer A-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - ;; we must disable and then restore longlines-mode - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or a-prev-pt shift-A (point-min))) - (forward-line (- a-begin a-prev)) - (setq a-begin-pt (point)) - (forward-line (- a-end a-begin)) - (setq a-end-pt (point) - a-prev a-end - a-prev-pt a-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) - (ediff-with-current-buffer B-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or b-prev-pt shift-B (point-min))) - (forward-line (- b-begin b-prev)) - (setq b-begin-pt (point)) - (forward-line (- b-end b-begin)) - (setq b-end-pt (point) - b-prev b-end - b-prev-pt b-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) - (if (ediff-buffer-live-p C-buffer) - (ediff-with-current-buffer C-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or c-prev-pt (point-min))) - (forward-line (- c-begin c-prev)) - (setq c-begin-pt (point)) - (forward-line (- c-end c-begin)) - (setq c-end-pt (point) - c-prev c-end - c-prev-pt c-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - ))) - (setq diff-list - (nconc - diff-list - (list - (if (ediff-buffer-live-p C-buffer) - (vector - a-begin-pt a-end-pt b-begin-pt b-end-pt - c-begin-pt c-end-pt - nil nil ; dummy ancestor - ;; state of diff - ;; shows which buff is different from the other two - (if (eq ediff-default-variant 'default-B) 'A 'B) - ediff-default-variant ; state of merge - nil ; state of ancestor - ) - (vector a-begin-pt a-end-pt - b-begin-pt b-end-pt - nil nil ; dummy buf C - nil nil ; dummy ancestor - nil nil ; dummy state of diff & merge - nil ; dummy state of ancestor - ))) - ))) - - ))) ; end ediff-with-current-buffer - diff-list - )) - - -(defun ediff-convert-diffs-to-overlays (diff-list) - (ediff-set-diff-overlays-in-one-buffer 'A diff-list) - (ediff-set-diff-overlays-in-one-buffer 'B diff-list) - (if ediff-3way-job - (ediff-set-diff-overlays-in-one-buffer 'C diff-list)) - (if ediff-merge-with-ancestor-job - (ediff-set-diff-overlays-in-one-buffer 'Ancestor diff-list)) - ;; set up vector showing the status of merge regions - (if ediff-merge-job - (setq ediff-state-of-merge - (vconcat - (mapcar (lambda (elt) - (let ((state-of-merge (aref elt 9)) - (state-of-ancestor (aref elt 10))) - (vector - ;; state of merge: prefers/default-A/B or combined - (if state-of-merge (format "%S" state-of-merge)) - ;; whether the ancestor region is empty - state-of-ancestor))) - ;; the first elt designates type of list - (cdr diff-list)) - ))) - (message "Processing difference regions ... done")) - - -(defun ediff-set-diff-overlays-in-one-buffer (buf-type diff-list) - (let* ((current-diff -1) - (buff (ediff-get-buffer buf-type)) - (ctl-buf ediff-control-buffer) - ;; ediff-extract-diffs puts the type of diff-list as the first elt - ;; of this list. The type is either 'points or 'words - (diff-list-type (car diff-list)) - (shift (ediff-overlay-start - (ediff-get-value-according-to-buffer-type - buf-type ediff-narrow-bounds))) - (limit (ediff-overlay-end - (ediff-get-value-according-to-buffer-type - buf-type ediff-narrow-bounds))) - diff-overlay-list list-element total-diffs - begin end pt-saved overlay state-of-diff) - - (setq diff-list (cdr diff-list)) ; discard diff list type - (setq total-diffs (length diff-list)) - - ;; shift, if necessary - (ediff-with-current-buffer buff (setq pt-saved shift)) - - (while diff-list - (setq current-diff (1+ current-diff) - list-element (car diff-list) - begin (aref list-element (cond ((eq buf-type 'A) 0) - ((eq buf-type 'B) 2) - ((eq buf-type 'C) 4) - (t 6))) ; Ancestor - end (aref list-element (cond ((eq buf-type 'A) 1) - ((eq buf-type 'B) 3) - ((eq buf-type 'C) 5) - (t 7))) ; Ancestor - state-of-diff (aref list-element 8) - ) - - (cond ((and (not (eq buf-type state-of-diff)) - (not (eq buf-type 'Ancestor)) - (memq state-of-diff '(A B C))) - (setq state-of-diff - (car (delq buf-type (delq state-of-diff (list 'A 'B 'C))))) - (setq state-of-diff (format "=diff(%S)" state-of-diff)) - ) - (t (setq state-of-diff nil))) - - ;; Put overlays at appropriate places in buffer - ;; convert word numbers to points, if necessary - (if (eq diff-list-type 'words) - (progn - (ediff-with-current-buffer buff (goto-char pt-saved)) - (ediff-with-current-buffer ctl-buf - (setq begin (ediff-goto-word (1+ begin) buff) - end (ediff-goto-word end buff 'end))) - (if (> end limit) (setq end limit)) - (if (> begin end) (setq begin end)) - (setq pt-saved (ediff-with-current-buffer buff (point))))) - (setq overlay (ediff-make-bullet-proof-overlay begin end buff)) - - (ediff-overlay-put overlay 'priority ediff-shadow-overlay-priority) - (ediff-overlay-put overlay 'ediff-diff-num current-diff) - (if (and (ediff-has-face-support-p) - ediff-use-faces ediff-highlight-all-diffs) - (ediff-set-overlay-face - overlay (ediff-background-face buf-type current-diff))) - - (if (= 0 (mod current-diff 10)) - (message "Buffer %S: Processing difference region %d of %d" - buf-type current-diff total-diffs)) - ;; Record all overlays for this difference. - ;; The 2-d elt, nil, is a place holder for the fine diff vector. - ;; The 3-d elt, nil, is a place holder for no-fine-diffs flag. - ;; The 4-th elt says which diff region is different from the other two - ;; (3-way jobs only). - (setq diff-overlay-list - (nconc - diff-overlay-list - (list (vector overlay nil nil state-of-diff))) - diff-list - (cdr diff-list)) - ) ; while - - (set (ediff-get-symbol-from-alist buf-type ediff-difference-vector-alist) - (vconcat diff-overlay-list)) - )) - -;; `n' is the diff region to work on. Default is ediff-current-difference. -;; if `flag' is 'noforce then make fine-diffs only if this region's fine -;; diffs have not been computed before. -;; if `flag' is 'skip then don't compute fine diffs for this region. -(defun ediff-make-fine-diffs (&optional n flag) - (or n (setq n ediff-current-difference)) - - (if (< ediff-number-of-differences 1) - (error ediff-NO-DIFFERENCES)) - - (if ediff-word-mode - (setq flag 'skip - ediff-auto-refine 'nix)) - - (or (< n 0) - (>= n ediff-number-of-differences) - ;; n is within the range - (let ((tmp-buffer (get-buffer-create ediff-tmp-buffer)) - (file-A ediff-temp-file-A) - (file-B ediff-temp-file-B) - (file-C ediff-temp-file-C) - (empty-A (ediff-empty-diff-region-p n 'A)) - (empty-B (ediff-empty-diff-region-p n 'B)) - (empty-C (ediff-empty-diff-region-p n 'C)) - (whitespace-A (ediff-whitespace-diff-region-p n 'A)) - (whitespace-B (ediff-whitespace-diff-region-p n 'B)) - (whitespace-C (ediff-whitespace-diff-region-p n 'C)) - cumulative-fine-diff-length) - - (cond ;; If one of the regions is empty (or 2 in 3way comparison) - ;; then don't refine. - ;; If the region happens to be entirely whitespace or empty then - ;; mark as such. - ((> (length (delq nil (list empty-A empty-B empty-C))) 1) - (if (and (ediff-looks-like-combined-merge n) - ediff-merge-job) - (ediff-set-fine-overlays-in-one-buffer 'C nil n)) - (if ediff-3way-comparison-job - (ediff-message-if-verbose - "Region %d is empty in all buffers but %S" - (1+ n) - (cond ((not empty-A) 'A) - ((not empty-B) 'B) - ((not empty-C) 'C))) - (ediff-message-if-verbose - "Region %d in buffer %S is empty" - (1+ n) - (cond (empty-A 'A) - (empty-B 'B) - (empty-C 'C))) - ) - ;; if all regions happen to be whitespace - (if (and whitespace-A whitespace-B whitespace-C) - ;; mark as space only - (ediff-mark-diff-as-space-only n t) - ;; if some regions are white and others don't, then mark as - ;; non-white-space-only - (ediff-mark-diff-as-space-only n nil))) - - ;; don't compute fine diffs if diff vector exists - ((and (eq flag 'noforce) (ediff-get-fine-diff-vector n 'A)) - (if (ediff-no-fine-diffs-p n) - (message - "Only white-space differences in region %d %s" - (1+ n) - (cond ((eq (ediff-no-fine-diffs-p n) 'A) - "in buffers B & C") - ((eq (ediff-no-fine-diffs-p n) 'B) - "in buffers A & C") - ((eq (ediff-no-fine-diffs-p n) 'C) - "in buffers A & B") - (t ""))))) - ;; don't compute fine diffs for this region - ((eq flag 'skip) - (or (ediff-get-fine-diff-vector n 'A) - (memq ediff-auto-refine '(off nix)) - (ediff-message-if-verbose - "Region %d exceeds the auto-refinement limit. Type `%s' to refine" - (1+ n) - (substitute-command-keys - "\\[ediff-make-or-kill-fine-diffs]") - ))) - (t - ;; recompute fine diffs - (ediff-wordify - (ediff-get-diff-posn 'A 'beg n) - (ediff-get-diff-posn 'A 'end n) - ediff-buffer-A - tmp-buffer - ediff-control-buffer) - (setq file-A - (ediff-make-temp-file tmp-buffer "fineDiffA" file-A)) - - (ediff-wordify - (ediff-get-diff-posn 'B 'beg n) - (ediff-get-diff-posn 'B 'end n) - ediff-buffer-B - tmp-buffer - ediff-control-buffer) - (setq file-B - (ediff-make-temp-file tmp-buffer "fineDiffB" file-B)) - - (if ediff-3way-job - (progn - (ediff-wordify - (ediff-get-diff-posn 'C 'beg n) - (ediff-get-diff-posn 'C 'end n) - ediff-buffer-C - tmp-buffer - ediff-control-buffer) - (setq file-C - (ediff-make-temp-file - tmp-buffer "fineDiffC" file-C)))) - - ;; save temp file names. - (setq ediff-temp-file-A file-A - ediff-temp-file-B file-B - ediff-temp-file-C file-C) - - ;; set the new vector of fine diffs, if none exists - (cond ((and ediff-3way-job whitespace-A) - (ediff-setup-fine-diff-regions nil file-B file-C n)) - ((and ediff-3way-job whitespace-B) - (ediff-setup-fine-diff-regions file-A nil file-C n)) - ((and ediff-3way-job - ;; In merge-jobs, whitespace-C is t, since - ;; ediff-empty-diff-region-p returns t in this case - whitespace-C) - (ediff-setup-fine-diff-regions file-A file-B nil n)) - (t - (ediff-setup-fine-diff-regions file-A file-B file-C n))) - - (setq cumulative-fine-diff-length - (+ (length (ediff-get-fine-diff-vector n 'A)) - (length (ediff-get-fine-diff-vector n 'B)) - ;; in merge jobs, the merge buffer is never refined - (if (and file-C (not ediff-merge-job)) - (length (ediff-get-fine-diff-vector n 'C)) - 0))) - - (cond ((or - ;; all regions are white space - (and whitespace-A whitespace-B whitespace-C) - ;; none is white space and no fine diffs detected - (and (not whitespace-A) - (not whitespace-B) - (not (and ediff-3way-job whitespace-C)) - (eq cumulative-fine-diff-length 0))) - (ediff-mark-diff-as-space-only n t) - (ediff-message-if-verbose - "Only white-space differences in region %d" (1+ n))) - ((eq cumulative-fine-diff-length 0) - (ediff-message-if-verbose - "Only white-space differences in region %d %s" - (1+ n) - (cond (whitespace-A (ediff-mark-diff-as-space-only n 'A) - "in buffers B & C") - (whitespace-B (ediff-mark-diff-as-space-only n 'B) - "in buffers A & C") - (whitespace-C (ediff-mark-diff-as-space-only n 'C) - "in buffers A & B")))) - (t - (ediff-mark-diff-as-space-only n nil))) - ) - ) ; end cond - (ediff-set-fine-diff-properties n) - ))) - -;; Interface to ediff-make-fine-diffs. Checks for auto-refine limit, etc. -(defun ediff-install-fine-diff-if-necessary (n) - (cond ((and (eq ediff-auto-refine 'on) - ediff-use-faces - (not (eq ediff-highlighting-style 'off)) - (not (eq ediff-highlighting-style 'ascii))) - (if (and - (> ediff-auto-refine-limit - (- (ediff-get-diff-posn 'A 'end n) - (ediff-get-diff-posn 'A 'beg n))) - (> ediff-auto-refine-limit - (- (ediff-get-diff-posn 'B 'end n) - (ediff-get-diff-posn 'B 'beg n)))) - (ediff-make-fine-diffs n 'noforce) - (ediff-make-fine-diffs n 'skip))) - - ;; highlight iff fine diffs already exist - ((eq ediff-auto-refine 'off) - (ediff-make-fine-diffs n 'skip)))) - - -;; if fine diff vector is not set for diff N, then do nothing -(defun ediff-set-fine-diff-properties (n &optional default) - (or (not (ediff-has-face-support-p)) - (< n 0) - (>= n ediff-number-of-differences) - ;; when faces are supported, set faces and priorities of fine overlays - (progn - (ediff-set-fine-diff-properties-in-one-buffer 'A n default) - (ediff-set-fine-diff-properties-in-one-buffer 'B n default) - (if ediff-3way-job - (ediff-set-fine-diff-properties-in-one-buffer 'C n default))))) - -(defun ediff-set-fine-diff-properties-in-one-buffer (buf-type - n &optional default) - (let ((fine-diff-vector (ediff-get-fine-diff-vector n buf-type)) - (face (if default - 'default - (face-name - (ediff-get-symbol-from-alist - buf-type ediff-fine-diff-face-alist)))) - (priority (if default - 0 - (1+ (or (ediff-overlay-get - (symbol-value - (ediff-get-symbol-from-alist - buf-type - ediff-current-diff-overlay-alist)) - 'priority) - 0))))) - (mapcar (lambda (overl) - (ediff-set-overlay-face overl face) - (ediff-overlay-put overl 'priority priority)) - fine-diff-vector))) - -;; Set overlays over the regions that denote delimiters -(defun ediff-set-fine-overlays-for-combined-merge (diff-list reg-num) - (let (overlay overlay-list) - (while diff-list - (condition-case nil - (setq overlay - (ediff-make-bullet-proof-overlay - (nth 0 diff-list) (nth 1 diff-list) ediff-buffer-C)) - (error "")) - (setq overlay-list (cons overlay overlay-list)) - (if (> (length diff-list) 1) - (setq diff-list (cdr (cdr diff-list))) - (error "ediff-set-fine-overlays-for-combined-merge: corrupt list of -delimiter regions")) - ) - (setq overlay-list (reverse overlay-list)) - (ediff-set-fine-diff-vector - reg-num 'C (apply 'vector overlay-list)) - )) - - -;; Convert diff list to overlays for a given DIFF-REGION -;; in buffer of type BUF-TYPE -(defun ediff-set-fine-overlays-in-one-buffer (buf-type diff-list region-num) - (let* ((current-diff -1) - (reg-start (ediff-get-diff-posn buf-type 'beg region-num)) - (buff (ediff-get-buffer buf-type)) - (ctl-buf ediff-control-buffer) - combined-merge-diff-list - diff-overlay-list list-element - begin end overlay) - - (ediff-clear-fine-differences-in-one-buffer region-num buf-type) - (setq diff-list (cdr diff-list)) ; discard list type (words or points) - (ediff-with-current-buffer buff (goto-char reg-start)) - - ;; if it is a combined merge then set overlays in buff C specially - (if (and ediff-merge-job (eq buf-type 'C) - (setq combined-merge-diff-list - (ediff-looks-like-combined-merge region-num))) - (ediff-set-fine-overlays-for-combined-merge - combined-merge-diff-list region-num) - ;; regular fine diff - (while diff-list - (setq current-diff (1+ current-diff) - list-element (car diff-list) - begin (aref list-element (cond ((eq buf-type 'A) 0) - ((eq buf-type 'B) 2) - (t 4))) ; buf C - end (aref list-element (cond ((eq buf-type 'A) 1) - ((eq buf-type 'B) 3) - (t 5)))) ; buf C - (if (not (or begin end)) - () ; skip this diff - ;; Put overlays at appropriate places in buffers - ;; convert lines to points, if necessary - (ediff-with-current-buffer ctl-buf - (setq begin (ediff-goto-word (1+ begin) buff) - end (ediff-goto-word end buff 'end))) - (setq overlay (ediff-make-bullet-proof-overlay begin end buff)) - ;; record all overlays for this difference region - (setq diff-overlay-list (nconc diff-overlay-list (list overlay)))) - - (setq diff-list (cdr diff-list)) - ) ; while - ;; convert the list of difference information into a vector - ;; for fast access - (ediff-set-fine-diff-vector - region-num buf-type (vconcat diff-overlay-list)) - ))) - - -(defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num) - (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num) - (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num) - (if ediff-3way-job - (ediff-set-fine-overlays-in-one-buffer 'C diff-list region-num) - )) - - -;; Stolen from emerge.el -(defun ediff-get-diff3-group (file) - ;; This save-excursion allows ediff-get-diff3-group to be called for the - ;; various groups of lines (1, 2, 3) in any order, and for the lines to - ;; appear in any order. The reason this is necessary is that Gnu diff3 - ;; can produce the groups in the order 1, 2, 3 or 1, 3, 2. - (save-excursion - (re-search-forward - (concat "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)\C-m?$")) - (beginning-of-line 2) - ;; treatment depends on whether it is an "a" group or a "c" group - (if (string-equal (buffer-substring (match-beginning 4) (match-end 4)) "c") - ;; it is a "c" group - (if (match-beginning 2) - ;; it has two numbers - (list (string-to-number - (buffer-substring (match-beginning 1) (match-end 1))) - (1+ (string-to-number - (buffer-substring (match-beginning 3) (match-end 3))))) - ;; it has one number - (let ((x (string-to-number - (buffer-substring (match-beginning 1) (match-end 1))))) - (list x (1+ x)))) - ;; it is an "a" group - (let ((x (1+ (string-to-number - (buffer-substring (match-beginning 1) (match-end 1)))))) - (list x x))))) - - -;; If WORD-MODE, construct vector of diffs using word numbers. -;; Else, use point values. -;; WORD-MODE also tells if we are in the word-mode or not. -;; If THREE-WAY-COMP, then it is a 3-way comparison. Else, it is merging -;; with ancestor, in which case buffer-C contents is identical to buffer-A/B, -;; contents (unless buffer-A is narrowed) depending on ediff-default-variant's -;; value. -;; BOUNDS specifies visibility bounds to use. -(defun ediff-extract-diffs3 (diff-buffer word-mode three-way-comp - &optional bounds) - (let ((A-buffer ediff-buffer-A) - (B-buffer ediff-buffer-B) - (C-buffer ediff-buffer-C) - (anc-buffer ediff-ancestor-buffer) - (a-prev 1) ; needed to set the first diff line correctly - (a-prev-pt nil) - (b-prev 1) - (b-prev-pt nil) - (c-prev 1) - (c-prev-pt nil) - (anc-prev 1) - diff-list shift-A shift-B shift-C - ) - - ;; diff list contains word numbers or points, depending on word-mode - (setq diff-list (cons (if word-mode 'words 'points) - diff-list)) - (if bounds - (setq shift-A - (ediff-overlay-start - (ediff-get-value-according-to-buffer-type 'A bounds)) - shift-B - (ediff-overlay-start - (ediff-get-value-according-to-buffer-type 'B bounds)) - shift-C - (if three-way-comp - (ediff-overlay-start - (ediff-get-value-according-to-buffer-type 'C bounds))))) - - ;; reset point in buffers A, B, C - (ediff-with-current-buffer A-buffer - (goto-char (if shift-A shift-A (point-min)))) - (ediff-with-current-buffer B-buffer - (goto-char (if shift-B shift-B (point-min)))) - (if three-way-comp - (ediff-with-current-buffer C-buffer - (goto-char (if shift-C shift-C (point-min))))) - (if (ediff-buffer-live-p anc-buffer) - (ediff-with-current-buffer anc-buffer - (goto-char (point-min)))) - - (ediff-with-current-buffer diff-buffer - (goto-char (point-min)) - (while (re-search-forward ediff-match-diff3-line nil t) - ;; leave point after matched line - (beginning-of-line 2) - (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) - ;; if the files A and B are the same and not 3way-comparison, - ;; ignore the difference - (if (or three-way-comp (not (string-equal agreement "3"))) - (let* ((a-begin (car (ediff-get-diff3-group "1"))) - (a-end (nth 1 (ediff-get-diff3-group "1"))) - (b-begin (car (ediff-get-diff3-group "2"))) - (b-end (nth 1 (ediff-get-diff3-group "2"))) - (c-or-anc-begin (car (ediff-get-diff3-group "3"))) - (c-or-anc-end (nth 1 (ediff-get-diff3-group "3"))) - (state-of-merge - (cond ((string-equal agreement "1") 'prefer-A) - ((string-equal agreement "2") 'prefer-B) - (t ediff-default-variant))) - (state-of-diff-merge - (if (memq state-of-merge '(default-A prefer-A)) 'B 'A)) - (state-of-diff-comparison - (cond ((string-equal agreement "1") 'A) - ((string-equal agreement "2") 'B) - ((string-equal agreement "3") 'C))) - state-of-ancestor - c-begin c-end - a-begin-pt a-end-pt - b-begin-pt b-end-pt - c-begin-pt c-end-pt - anc-begin-pt anc-end-pt) - - (setq state-of-ancestor - (= c-or-anc-begin c-or-anc-end)) - - (cond (three-way-comp - (setq c-begin c-or-anc-begin - c-end c-or-anc-end)) - ((eq ediff-default-variant 'default-B) - (setq c-begin b-begin - c-end b-end)) - (t - (setq c-begin a-begin - c-end a-end))) - - ;; compute main diff vector - (if word-mode - ;; make diff-list contain word numbers - (setq diff-list - (nconc diff-list - (list (vector - (- a-begin a-prev) (- a-end a-begin) - (- b-begin b-prev) (- b-end b-begin) - (- c-begin c-prev) (- c-end c-begin) - nil nil ; dummy ancestor - nil ; state of diff - nil ; state of merge - nil ; state of ancestor - ))) - a-prev a-end - b-prev b-end - c-prev c-end) - ;; else convert lines to points - (ediff-with-current-buffer A-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - ;; we must disable and then restore longlines-mode - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or a-prev-pt shift-A (point-min))) - (forward-line (- a-begin a-prev)) - (setq a-begin-pt (point)) - (forward-line (- a-end a-begin)) - (setq a-end-pt (point) - a-prev a-end - a-prev-pt a-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) - (ediff-with-current-buffer B-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or b-prev-pt shift-B (point-min))) - (forward-line (- b-begin b-prev)) - (setq b-begin-pt (point)) - (forward-line (- b-end b-begin)) - (setq b-end-pt (point) - b-prev b-end - b-prev-pt b-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) - (ediff-with-current-buffer C-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or c-prev-pt shift-C (point-min))) - (forward-line (- c-begin c-prev)) - (setq c-begin-pt (point)) - (forward-line (- c-end c-begin)) - (setq c-end-pt (point) - c-prev c-end - c-prev-pt c-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) - (if (ediff-buffer-live-p anc-buffer) - (ediff-with-current-buffer anc-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (forward-line (- c-or-anc-begin anc-prev)) - (setq anc-begin-pt (point)) - (forward-line (- c-or-anc-end c-or-anc-begin)) - (setq anc-end-pt (point) - anc-prev c-or-anc-end) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - ))) - (setq diff-list - (nconc - diff-list - ;; if comparing with ancestor, then there also is a - ;; state-of-difference marker - (if three-way-comp - (list (vector - a-begin-pt a-end-pt - b-begin-pt b-end-pt - c-begin-pt c-end-pt - nil nil ; ancestor begin/end - state-of-diff-comparison - nil ; state of merge - nil ; state of ancestor - )) - (list (vector a-begin-pt a-end-pt - b-begin-pt b-end-pt - c-begin-pt c-end-pt - anc-begin-pt anc-end-pt - state-of-diff-merge - state-of-merge - state-of-ancestor - ))) - ))) - )) - - ))) ; end ediff-with-current-buffer - diff-list - )) - -;; Generate the difference vector and overlays for three files -;; File-C is either the third file to compare (in case of 3-way comparison) -;; or it is the ancestor file. -(defun ediff-setup-diff-regions3 (file-A file-B file-C) - ;; looking for '-i' or a 'i' among clustered non-long options - (if (string-match "^-i\\| -i\\|\\(^\\| \\)-[^- ]+i" ediff-diff-options) - (error "Option `-i' is not allowed in `ediff-diff3-options'")) - - (or (ediff-buffer-live-p ediff-diff-buffer) - (setq ediff-diff-buffer - (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*")))) - - (message "Computing differences ...") - (ediff-exec-process ediff-diff3-program ediff-diff-buffer 'synchronize - ediff-actual-diff3-options file-A file-B file-C) - - (ediff-prepare-error-list ediff-diff3-ok-lines-regexp ediff-diff-buffer) - ;;(message "Computing differences ... done") - (ediff-convert-diffs-to-overlays - (ediff-extract-diffs3 - ediff-diff-buffer - ediff-word-mode ediff-3way-comparison-job ediff-narrow-bounds) - )) - - -;; Execute PROGRAM asynchronously, unless OS/2, Windows-*, or DOS, or unless -;; SYNCH is non-nil. BUFFER must be a buffer object, and must be alive. The -;; OPTIONS arg is a list of options to pass to PROGRAM. It may be a blank -;; string. All elements in FILES must be strings. We also delete nil from -;; args. -(defun ediff-exec-process (program buffer synch options &rest files) - (let ((data (match-data)) - (coding-system-for-read ediff-coding-system-for-read) - args) - (setq args (append (split-string options) files)) - (setq args (delete "" (delq nil args))) ; delete nil and "" from arguments - ;; the --binary option, if present, should be used only for buffer jobs - ;; or for refining the differences - (or (string-match "buffer" (symbol-name ediff-job-name)) - (eq buffer ediff-fine-diff-buffer) - (setq args (delete "--binary" args))) - (unwind-protect - (let ((directory default-directory) - proc) - (save-excursion - (set-buffer buffer) - (erase-buffer) - (setq default-directory directory) - (if (or (memq system-type '(emx ms-dos windows-nt windows-95)) - synch) - ;; In OS/2 (emx) do it synchronously, since OS/2 doesn't let us - ;; delete files used by other processes. Thus, in ediff-buffers - ;; and similar functions, we can't delete temp files because - ;; they might be used by the asynch process that computes - ;; custom diffs. So, we have to wait till custom diff - ;; subprocess is done. - ;; Similarly for Windows-* - ;; In DOS, must synchronize because DOS doesn't have - ;; asynchronous processes. - (apply 'call-process program nil buffer nil args) - ;; On other systems, do it asynchronously. - (setq proc (get-buffer-process buffer)) - (if proc (kill-process proc)) - (setq proc - (apply 'start-process "Custom Diff" buffer program args)) - (setq mode-line-process '(":%s")) - (set-process-sentinel proc 'ediff-process-sentinel) - (set-process-filter proc 'ediff-process-filter) - ))) - (store-match-data data)))) - -;; This is shell-command-filter from simple.el in Emacs. -;; Copied here because XEmacs doesn't have it. -(defun ediff-process-filter (proc string) - ;; Do save-excursion by hand so that we can leave point numerically unchanged - ;; despite an insertion immediately after it. - (let* ((obuf (current-buffer)) - (buffer (process-buffer proc)) - opoint - (window (get-buffer-window buffer)) - (pos (window-start window))) - (unwind-protect - (progn - (set-buffer buffer) - (or (= (point) (point-max)) - (setq opoint (point))) - (goto-char (point-max)) - (insert-before-markers string)) - ;; insert-before-markers moved this marker: set it back. - (set-window-start window pos) - ;; Finish our save-excursion. - (if opoint - (goto-char opoint)) - (set-buffer obuf)))) - -;; like shell-command-sentinel but doesn't print an exit status message -;; we do this because diff always exits with status 1, if diffs are found -;; so shell-command-sentinel displays a confusing message to the user -(defun ediff-process-sentinel (process signal) - (if (and (memq (process-status process) '(exit signal)) - (buffer-name (process-buffer process))) - (progn - (save-excursion - (set-buffer (process-buffer process)) - (setq mode-line-process nil)) - (delete-process process)))) - - -;;; Word functions used to refine the current diff - -(defvar ediff-forward-word-function 'ediff-forward-word - "*Function to call to move to the next word. -Used for splitting difference regions into individual words.") -(make-variable-buffer-local 'ediff-forward-word-function) - -(defvar ediff-whitespace " \n\t\f" - "*Characters constituting white space. -These characters are ignored when differing regions are split into words.") -(make-variable-buffer-local 'ediff-whitespace) - -(defvar ediff-word-1 - (ediff-cond-compile-for-xemacs-or-emacs "a-zA-Z---_" "-[:word:]_") - "*Characters that constitute words of type 1. -More precisely, [ediff-word-1] is a regexp that matches type 1 words. -See `ediff-forward-word' for more details.") -(make-variable-buffer-local 'ediff-word-1) - -(defvar ediff-word-2 "0-9.," - "*Characters that constitute words of type 2. -More precisely, [ediff-word-2] is a regexp that matches type 2 words. -See `ediff-forward-word' for more details.") -(make-variable-buffer-local 'ediff-word-2) - -(defvar ediff-word-3 "`'?!:;\"{}[]()" - "*Characters that constitute words of type 3. -More precisely, [ediff-word-3] is a regexp that matches type 3 words. -See `ediff-forward-word' for more details.") -(make-variable-buffer-local 'ediff-word-3) - -(defvar ediff-word-4 - (concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace) - "*Characters that constitute words of type 4. -More precisely, [ediff-word-4] is a regexp that matches type 4 words. -See `ediff-forward-word' for more details.") -(make-variable-buffer-local 'ediff-word-4) - -;; Split region along word boundaries. Each word will be on its own line. -;; Output to buffer out-buffer. -(defun ediff-forward-word () - "Move point one word forward. -There are four types of words, each of which consists entirely of -characters in `ediff-word-1', `ediff-word-2', `ediff-word-3', or -`ediff-word-4'. Words are recognized by passing these one after another as -arguments to `skip-chars-forward'." - (or (> (+ (skip-chars-forward ediff-word-1) - (skip-syntax-forward "w")) - 0) - (> (skip-chars-forward ediff-word-2) 0) - (> (skip-chars-forward ediff-word-3) 0) - (> (skip-chars-forward ediff-word-4) 0) - )) - - -(defun ediff-wordify (beg end in-buffer out-buffer &optional control-buf) - (let ((forward-word-function - ;; eval in control buf to let user create local versions for - ;; different invocations - (if control-buf - (ediff-with-current-buffer control-buf - ediff-forward-word-function) - ediff-forward-word-function)) - inbuf-syntax-tbl sv-point diff-string) - (save-excursion - (set-buffer in-buffer) - (setq inbuf-syntax-tbl - (if control-buf - (ediff-with-current-buffer control-buf - ediff-syntax-table) - (syntax-table))) - (setq diff-string (buffer-substring-no-properties beg end)) - - (set-buffer out-buffer) - ;; Make sure that temp buff syntax table is the same as the original buf - ;; syntax tbl, because we use ediff-forward-word in both and - ;; ediff-forward-word depends on the syntax classes of characters. - (set-syntax-table inbuf-syntax-tbl) - (erase-buffer) - (insert diff-string) - (goto-char (point-min)) - (skip-chars-forward ediff-whitespace) - (delete-region (point-min) (point)) - - (while (not (eobp)) - (funcall forward-word-function) - (setq sv-point (point)) - (skip-chars-forward ediff-whitespace) - (delete-region sv-point (point)) - (insert "\n"))))) - -;; copy string specified as BEG END from IN-BUF to OUT-BUF -(defun ediff-copy-to-buffer (beg end in-buffer out-buffer) - (with-current-buffer out-buffer - (erase-buffer) - (insert-buffer-substring in-buffer beg end) - (goto-char (point-min)))) - - -;; goto word #n starting at current position in buffer `buf' -;; For ediff, a word is determined by ediff-forward-word-function -;; If `flag' is non-nil, goto the end of the n-th word. -(defun ediff-goto-word (n buf &optional flag) - ;; remember val ediff-forward-word-function has in ctl buf - (let ((fwd-word-fun ediff-forward-word-function) - (syntax-tbl ediff-syntax-table)) - (ediff-with-current-buffer buf - (skip-chars-forward ediff-whitespace) - (ediff-with-syntax-table syntax-tbl - (while (> n 1) - (funcall fwd-word-fun) - (skip-chars-forward ediff-whitespace) - (setq n (1- n))) - (if (and flag (> n 0)) - (funcall fwd-word-fun))) - (point)))) - -(defun ediff-same-file-contents (f1 f2) - "Return t if files F1 and F2 have identical contents." - (if (and (not (file-directory-p f1)) - (not (file-directory-p f2))) - (let ((res - (apply 'call-process ediff-cmp-program nil nil nil - (append ediff-cmp-options (list f1 f2))))) - (and (numberp res) (eq res 0)))) - ) - - -(defun ediff-same-contents (d1 d2 &optional filter-re) - "Returns t iff D1 and D2 have the same content. -D1 and D2 can either be both directories or both regular files. -Symlinks and the likes are not handled. -If FILTER-RE is non-nil, recursive checking in directories -affects only files whose names match the expression." - ;; Normalize empty filter RE to nil. - (unless (> (length filter-re) 0) (setq filter-re nil)) - ;; Indicate progress - (message "Comparing '%s' and '%s' modulo '%s'" d1 d2 filter-re) - (cond - ;; D1 & D2 directories => recurse - ((and (file-directory-p d1) - (file-directory-p d2)) - (if (null ediff-recurse-to-subdirectories) - (if (y-or-n-p "Compare subdirectories recursively? ") - (setq ediff-recurse-to-subdirectories 'yes) - (setq ediff-recurse-to-subdirectories 'no))) - (if (eq ediff-recurse-to-subdirectories 'yes) - (let* ((all-entries-1 (directory-files d1 t filter-re)) - (all-entries-2 (directory-files d2 t filter-re)) - (entries-1 (ediff-delete-all-matches "^\\.\\.?$" all-entries-1)) - (entries-2 (ediff-delete-all-matches "^\\.\\.?$" all-entries-2)) - ) - - (ediff-same-file-contents-lists entries-1 entries-2 filter-re) - )) - ) ; end of the directories case - ;; D1 & D2 are both files => compare directly - ((and (file-regular-p d1) - (file-regular-p d2)) - (ediff-same-file-contents d1 d2)) - ;; Otherwise => false: unequal contents - ) - ) - -;; If lists have the same length and names of files are pairwise equal -;; (removing the directories) then compare contents pairwise. -;; True if all contents are the same; false otherwise -(defun ediff-same-file-contents-lists (entries-1 entries-2 filter-re) - ;; First, check only the names (works quickly and ensures a - ;; precondition for subsequent code) - (if (and (= (length entries-1) (length entries-2)) - (equal (mapcar 'file-name-nondirectory entries-1) - (mapcar 'file-name-nondirectory entries-2))) - ;; With name equality established, compare the entries - ;; through recursion. - (let ((continue t)) - (while (and entries-1 continue) - (if (ediff-same-contents - (car entries-1) (car entries-2) filter-re) - (setq entries-1 (cdr entries-1) - entries-2 (cdr entries-2)) - (setq continue nil)) - ) - ;; if reached the end then lists are equal - (null entries-1)) - ) - ) - - -;; ARG1 is a regexp, ARG2 is a list of full-filenames -;; Delete all entries that match the regexp -(defun ediff-delete-all-matches (regex file-list-list) - (let (result elt) - (while file-list-list - (setq elt (car file-list-list)) - (or (string-match regex (file-name-nondirectory elt)) - (setq result (cons elt result))) - (setq file-list-list (cdr file-list-list))) - (reverse result))) - -;; Ignore case handling - some ideas from drew.adams@@oracle.com -(defun ediff-toggle-ignore-case () - (interactive) - (ediff-barf-if-not-control-buffer) - (setq ediff-ignore-case (not ediff-ignore-case)) - (cond (ediff-ignore-case - (setq ediff-actual-diff-options - (concat ediff-diff-options " " ediff-ignore-case-option) - ediff-actual-diff3-options - (concat ediff-diff3-options " " ediff-ignore-case-option3)) - (message "Ignoring regions that differ only in case")) - (t - (setq ediff-actual-diff-options ediff-diff-options - ediff-actual-diff3-options ediff-diff3-options) - (message "Ignoring case differences turned OFF"))) - (cond (ediff-merge-job - (message "Ignoring letter case is too dangerous in merge jobs")) - ((and ediff-diff3-job (string= ediff-ignore-case-option3 "")) - (message "Ignoring letter case is not supported by this diff3 program")) - ((and (not ediff-3way-job) (string= ediff-ignore-case-option "")) - (message "Ignoring letter case is not supported by this diff program")) - (t - (sit-for 1) - (ediff-update-diffs))) - ) - - -(provide 'ediff-diff) - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; arch-tag: a86d448e-58d7-4572-a1d9-fdedfa22f648 -;;; ediff-diff.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-help.el b/xemacs-packages/lisp/ediff/ediff-help.el deleted file mode 100644 index d5f505c7..00000000 --- a/xemacs-packages/lisp/ediff/ediff-help.el +++ /dev/null @@ -1,332 +0,0 @@ -;;; ediff-help.el --- Code related to the contents of Ediff help buffers - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - - -;; Compiler pacifier start -(defvar ediff-multiframe) - -(eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - )) -;; end pacifier - -(require 'ediff-init) - -;; Help messages - -(defconst ediff-long-help-message-head - " Move around | Toggle features | Manipulate -=====================|===========================|=============================" - "The head of the full help message.") -(defconst ediff-long-help-message-tail - "=====================|===========================|============================= - R -show registry | = -compare regions | M -show session group - D -diff output | E -browse Ediff manual| G -send bug report - i -status info | ? -help off | z/q -suspend/quit -------------------------------------------------------------------------------- -For help on a specific command: Click Button 2 over it; or - Put the cursor over it and type RET." - "The tail of the full-help message.") - -(defconst ediff-long-help-message-compare3 - " -p,DEL -previous diff | | -vert/horiz split | xy -copy buf X's region to Y -n,SPC -next diff | h -hilighting | rx -restore buf X's old diff - j -jump to diff | @ -auto-refinement | * -refine current region - gx -goto X's point| ## -ignore whitespace | ! -update diff regions - C-l -recenter | #c -ignore case | - v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X - -scroll lt/rt | X -read-only in buf X | wd -save diff output - ~ -rotate buffers| m -wide display | -" - "Help message usually used for 3-way comparison. -Normally, not a user option. See `ediff-help-message' for details.") - -(defconst ediff-long-help-message-compare2 - " -p,DEL -previous diff | | -vert/horiz split |a/b -copy A/B's region to B/A -n,SPC -next diff | h -hilighting | rx -restore buf X's old diff - j -jump to diff | @ -auto-refinement | * -refine current region - gx -goto X's point| ## -ignore whitespace | ! -update diff regions - C-l -recenter | #c -ignore case | - v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X - -scroll lt/rt | X -read-only in buf X | wd -save diff output - ~ -swap variants | m -wide display | -" - "Help message usually used for 2-way comparison. -Normally, not a user option. See `ediff-help-message' for details.") - -(defconst ediff-long-help-message-narrow2 - " -p,DEL -previous diff | | -vert/horiz split |a/b -copy A/B's region to B/A -n,SPC -next diff | h -hilighting | rx -restore buf X's old diff - j -jump to diff | @ -auto-refinement | * -refine current region - gx -goto X's point| ## -ignore whitespace | ! -update diff regions - C-l -recenter | #c -ignore case | % -narrow/widen buffs - v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X - -scroll lt/rt | X -read-only in buf X | wd -save diff output - ~ -swap variants | m -wide display | -" - "Help message when comparing windows or regions line-by-line. -Normally, not a user option. See `ediff-help-message' for details.") - -(defconst ediff-long-help-message-word-mode - " -p,DEL -previous diff | | -vert/horiz split | xy -copy buf X's region to Y -n,SPC -next diff | h -hilighting | rx -restore buf X's old diff - j -jump to diff | | - gx -goto X's point| % -narrow/widen buffs | ! -recompute diffs - C-l -recenter | #c -ignore case | - v/V -scroll up/dn | #f/#h -focus/hide regions | wx -save buf X - -scroll lt/rt | X -read-only in buf X | wd -save diff output - ~ -swap variants | m -wide display | -" - "Help message when comparing windows or regions word-by-word. -Normally, not a user option. See `ediff-help-message' for details.") - -(defconst ediff-long-help-message-merge - " -p,DEL -previous diff | | -vert/horiz split | x -copy buf X's region to C -n,SPC -next diff | h -hilighting | r -restore buf C's old diff - j -jump to diff | @ -auto-refinement | * -refine current region - gx -goto X's point| ## -ignore whitespace | ! -update diff regions - C-l -recenter | #f/#h -focus/hide regions | + -combine diff regions - v/V -scroll up/dn | X -read-only in buf X | wx -save buf X - -scroll lt/rt | m -wide display | wd -save diff output - ~ -swap variants | s -shrink window C | / -show ancestor buff - | $$ -show clashes only | & -merge w/new default - | $* -skip changed regions | -" - "Help message for merge sessions. -Normally, not a user option. See `ediff-help-message' for details.") - -;; The actual long help message. -(ediff-defvar-local ediff-long-help-message "" - "Normally, not a user option. See `ediff-help-message' for details.") - -(defconst ediff-brief-message-string - " Type ? for help" - "Contents of the brief help message.") -;; The actual brief help message -(ediff-defvar-local ediff-brief-help-message "" - "Normally, not a user option. See `ediff-help-message' for details.") - -(ediff-defvar-local ediff-brief-help-message-function nil - "The brief help message that the user can customize. -If the user sets this to a parameter-less function, Ediff will use it to -produce the brief help message. This function must return a string.") -(ediff-defvar-local ediff-long-help-message-function nil - "The long help message that the user can customize. -See `ediff-brief-help-message-function' for more.") - -(defcustom ediff-use-long-help-message nil - "*If t, Ediff displays a long help message. Short help message otherwise." - :type 'boolean - :group 'ediff-window) - -;; The actual help message. -(ediff-defvar-local ediff-help-message "" - "The actual help message. -Normally, the user shouldn't touch this. However, if you want Ediff to -start up with different help messages for different jobs, you can change -the value of this variable and the variables `ediff-help-message-*' in -`ediff-startup-hook'.") - - -;; the keymap that defines clicks over the quick help regions -(defvar ediff-help-region-map (make-sparse-keymap)) - -(define-key - ediff-help-region-map - (if ediff-emacs-p [mouse-2] [button2]) - 'ediff-help-for-quick-help) - -;; runs in the control buffer -(defun ediff-set-help-overlays () - (goto-char (point-min)) - (let (overl beg end cmd) - (while (re-search-forward " *\\([^ \t\n|]+\\||\\) +-[^|\n]+" nil 'noerror) - (setq beg (match-beginning 0) - end (match-end 0) - cmd (buffer-substring (match-beginning 1) (match-end 1))) - (setq overl (ediff-make-overlay beg end)) - (if ediff-emacs-p - (ediff-overlay-put overl 'mouse-face 'highlight) - (ediff-overlay-put overl 'highlight t)) - (ediff-overlay-put overl 'ediff-help-info cmd)))) - - -(defun ediff-help-for-quick-help () - "Explain Ediff commands in more detail." - (interactive) - (ediff-barf-if-not-control-buffer) - (let ((pos (ediff-event-point last-command-event)) - overl cmd) - - (ediff-cond-compile-for-xemacs-or-emacs - ;; xemacs - (setq overl (extent-at pos (current-buffer) 'ediff-help-info) - cmd (ediff-overlay-get overl 'ediff-help-info)) - ;; emacs - (setq cmd (car (mapcar (lambda (elt) - (overlay-get elt 'ediff-help-info)) - (overlays-at pos)))) - ) - - (if (not (stringp cmd)) - (error "Hmm... I don't see an Ediff command around here...")) - - (ediff-documentation "Quick Help Commands") - - (let (case-fold-search) - (cond ((string= cmd "?") (re-search-forward "^`\\?'")) - ((string= cmd "G") (re-search-forward "^`G'")) - ((string= cmd "E") (re-search-forward "^`E'")) - ((string= cmd "wd") (re-search-forward "^`wd'")) - ((string= cmd "wx") (re-search-forward "^`wa'")) - ((string= cmd "a/b") (re-search-forward "^`a'")) - ((string= cmd "x") (re-search-forward "^`a'")) - ((string= cmd "xy") (re-search-forward "^`ab'")) - ((string= cmd "p,DEL") (re-search-forward "^`p'")) - ((string= cmd "n,SPC") (re-search-forward "^`n'")) - ((string= cmd "j") (re-search-forward "^`j'")) - ((string= cmd "gx") (re-search-forward "^`ga'")) - ((string= cmd "!") (re-search-forward "^`!'")) - ((string= cmd "*") (re-search-forward "^`\\*'")) - ((string= cmd "m") (re-search-forward "^`m'")) - ((string= cmd "|") (re-search-forward "^`|'")) - ((string= cmd "@") (re-search-forward "^`@'")) - ((string= cmd "h") (re-search-forward "^`h'")) - ((string= cmd "r") (re-search-forward "^`r'")) - ((string= cmd "rx") (re-search-forward "^`ra'")) - ((string= cmd "##") (re-search-forward "^`##'")) - ((string= cmd "#c") (re-search-forward "^`#c'")) - ((string= cmd "#f/#h") (re-search-forward "^`#f'")) - ((string= cmd "X") (re-search-forward "^`A'")) - ((string= cmd "v/V") (re-search-forward "^`v'")) - ((string= cmd "") (re-search-forward "^`<'")) - ((string= cmd "~") (re-search-forward "^`~'")) - ((string= cmd "i") (re-search-forward "^`i'")) - ((string= cmd "D") (re-search-forward "^`D'")) - ((string= cmd "R") (re-search-forward "^`R'")) - ((string= cmd "M") (re-search-forward "^`M'")) - ((string= cmd "z/q") (re-search-forward "^`z'")) - ((string= cmd "%") (re-search-forward "^`%'")) - ((string= cmd "C-l") (re-search-forward "^`C-l'")) - ((string= cmd "$$") (re-search-forward "^`\\$\\$'")) - ((string= cmd "$*") (re-search-forward "^`\\$\\*'")) - ((string= cmd "/") (re-search-forward "^`/'")) - ((string= cmd "&") (re-search-forward "^`&'")) - ((string= cmd "s") (re-search-forward "^`s'")) - ((string= cmd "+") (re-search-forward "^`\\+'")) - ((string= cmd "=") (re-search-forward "^`='")) - (t (error "Undocumented command! Type `G' in Ediff Control Panel to drop a note to the Ediff maintainer"))) - ) ; let case-fold-search - )) - - -;; assuming we are in control window, calculate length of the first line in -;; help message -(defun ediff-help-message-line-length () - (save-excursion - (goto-char (point-min)) - (if ediff-use-long-help-message - (next-line 1)) - (end-of-line) - (current-column))) - - -(defun ediff-indent-help-message () - (let* ((shift (/ (max 0 (- (window-width (selected-window)) - (ediff-help-message-line-length))) - 2)) - (str (make-string shift ?\ ))) - (save-excursion - (goto-char (point-min)) - (while (< (point) (point-max)) - (insert str) - (beginning-of-line) - (forward-line 1))))) - - -;; compose the help message as a string -(defun ediff-set-help-message () - (setq ediff-long-help-message - (cond ((and ediff-long-help-message-function - (or (symbolp ediff-long-help-message-function) - (consp ediff-long-help-message-function))) - (funcall ediff-long-help-message-function)) - (ediff-word-mode - (concat ediff-long-help-message-head - ediff-long-help-message-word-mode - ediff-long-help-message-tail)) - (ediff-narrow-job - (concat ediff-long-help-message-head - ediff-long-help-message-narrow2 - ediff-long-help-message-tail)) - (ediff-merge-job - (concat ediff-long-help-message-head - ediff-long-help-message-merge - ediff-long-help-message-tail)) - (ediff-diff3-job - (concat ediff-long-help-message-head - ediff-long-help-message-compare3 - ediff-long-help-message-tail)) - (t - (concat ediff-long-help-message-head - ediff-long-help-message-compare2 - ediff-long-help-message-tail)))) - (setq ediff-brief-help-message - (cond ((and ediff-brief-help-message-function - (or (symbolp ediff-brief-help-message-function) - (consp ediff-brief-help-message-function))) - (funcall ediff-brief-help-message-function)) - ((stringp ediff-brief-help-message-function) - ediff-brief-help-message-function) - ((ediff-multiframe-setup-p) ediff-brief-message-string) - (t ; long brief msg, not multiframe --- put in the middle - ediff-brief-message-string) - )) - (setq ediff-help-message (if ediff-use-long-help-message - ediff-long-help-message - ediff-brief-help-message)) - (run-hooks 'ediff-display-help-hook)) - -;;;###autoload -(defun ediff-customize () - (interactive) - (customize-group "ediff")) - - -(provide 'ediff-help) - - -;;; arch-tag: 05659813-7fcf-4274-964f-d2f577431a9d -;;; ediff-help.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-hook.el b/xemacs-packages/lisp/ediff/ediff-hook.el deleted file mode 100644 index fcf261ef..00000000 --- a/xemacs-packages/lisp/ediff/ediff-hook.el +++ /dev/null @@ -1,376 +0,0 @@ -;;; ediff-hook.el --- setup for Ediff's menus and autoloads - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -;;; These must be placed in menu-bar.el in Emacs -;; -;; (define-key menu-bar-tools-menu [ediff-misc] -;; '("Ediff Miscellanea" . menu-bar-ediff-misc-menu)) -;; (define-key menu-bar-tools-menu [epatch] -;; '("Apply Patch" . menu-bar-epatch-menu)) -;; (define-key menu-bar-tools-menu [ediff-merge] -;; '("Merge" . menu-bar-ediff-merge-menu)) -;; (define-key menu-bar-tools-menu [ediff] -;; '("Compare" . menu-bar-ediff-menu)) - -;; Compiler pacifier -(defvar ediff-menu) -(defvar ediff-merge-menu) -(defvar epatch-menu) -(defvar ediff-misc-menu) -;; end pacifier - -;; allow menus to be set up without ediff-wind.el being loaded -;;;###autoload -(defvar ediff-window-setup-function) - -;; This macro is used to avoid compilation warnings. -;; The macro will expand into the form that is appropriate to the -;; compiler at hand (emacs or xemacs). -;; The autoload, below, is useless in Emacs because ediff-hook.el -;; is dumped with emacs, but it is needed in XEmacs -;;;###autoload (defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form) (if (string-match "XEmacs" emacs-version) xemacs-form emacs-form)) - -(defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form) - (if (string-match "XEmacs" emacs-version) - xemacs-form emacs-form)) - -;; This autoload is useless in Emacs because ediff-hook.el is dumped with -;; emacs, but it is needed in XEmacs -;;;###autoload -(ediff-cond-compile-for-xemacs-or-emacs - ;; xemacs form - (defun ediff-xemacs-init-menus () - (if (featurep 'menubar) - (progn - (add-submenu - '("Tools") ediff-menu "OO-Browser...") - (add-submenu - '("Tools") ediff-merge-menu "OO-Browser...") - (add-submenu - '("Tools") epatch-menu "OO-Browser...") - (add-submenu - '("Tools") ediff-misc-menu "OO-Browser...") - (add-menu-button - '("Tools") "-------" "OO-Browser...") - ))) - nil ; emacs form - ) - - -;; This autoload is useless in Emacs because ediff-hook.el is dumped with -;; emacs, but it is needed in XEmacs -;;;###autoload -(ediff-cond-compile-for-xemacs-or-emacs - (progn - (defvar ediff-menu - '("Compare" - ["Two Files..." ediff-files t] - ["Two Buffers..." ediff-buffers t] - ["Three Files..." ediff-files3 t] - ["Three Buffers..." ediff-buffers3 t] - "---" - ["Two Directories..." ediff-directories t] - ["Three Directories..." ediff-directories3 t] - "---" - ["File with Revision..." ediff-revision t] - ["Directory Revisions..." ediff-directory-revisions t] - "---" - ["Windows Word-by-word..." ediff-windows-wordwise t] - ["Windows Line-by-line..." ediff-windows-linewise t] - "---" - ["Regions Word-by-word..." ediff-regions-wordwise t] - ["Regions Line-by-line..." ediff-regions-linewise t] - )) - (defvar ediff-merge-menu - '("Merge" - ["Files..." ediff-merge-files t] - ["Files with Ancestor..." ediff-merge-files-with-ancestor t] - ["Buffers..." ediff-merge-buffers t] - ["Buffers with Ancestor..." - ediff-merge-buffers-with-ancestor t] - "---" - ["Directories..." ediff-merge-directories t] - ["Directories with Ancestor..." - ediff-merge-directories-with-ancestor t] - "---" - ["Revisions..." ediff-merge-revisions t] - ["Revisions with Ancestor..." - ediff-merge-revisions-with-ancestor t] - ["Directory Revisions..." ediff-merge-directory-revisions t] - ["Directory Revisions with Ancestor..." - ediff-merge-directory-revisions-with-ancestor t] - )) - (defvar epatch-menu - '("Apply Patch" - ["To a file..." ediff-patch-file t] - ["To a buffer..." ediff-patch-buffer t] - )) - (defvar ediff-misc-menu - '("Ediff Miscellanea" - ["Ediff Manual" ediff-documentation t] - ["Customize Ediff" ediff-customize t] - ["List Ediff Sessions" ediff-show-registry t] - ["Use separate frame for Ediff control buffer" - ediff-toggle-multiframe - :style toggle - :selected (if (and (featurep 'ediff-util) - (boundp 'ediff-window-setup-function)) - (eq ediff-window-setup-function - 'ediff-setup-windows-multiframe))] - ["Use a toolbar with Ediff control buffer" - ediff-toggle-use-toolbar - :style toggle - :selected (if (featurep 'ediff-tbar) - (ediff-use-toolbar-p))] - )) - - ;; put these menus before Object-Oriented-Browser in Tools menu - (if (and (featurep 'menubar) (not (featurep 'infodock)) - (not (featurep 'ediff-hook))) - (ediff-xemacs-init-menus))) - - ;; Emacs--only if menu-bar is loaded - (if (featurep 'menu-bar) - (progn - ;; initialize menu bar keymaps - (defvar menu-bar-ediff-misc-menu - (make-sparse-keymap "Ediff Miscellanea")) - (fset 'menu-bar-ediff-misc-menu - (symbol-value 'menu-bar-ediff-misc-menu)) - (defvar menu-bar-epatch-menu (make-sparse-keymap "Apply Patch")) - (fset 'menu-bar-epatch-menu (symbol-value 'menu-bar-epatch-menu)) - (defvar menu-bar-ediff-merge-menu (make-sparse-keymap "Merge")) - (fset 'menu-bar-ediff-merge-menu - (symbol-value 'menu-bar-ediff-merge-menu)) - (defvar menu-bar-ediff-menu (make-sparse-keymap "Compare")) - (fset 'menu-bar-ediff-menu (symbol-value 'menu-bar-ediff-menu)) - - ;; define ediff-menu - (define-key menu-bar-ediff-menu [window] - '("This Window and Next Window" . compare-windows)) - (define-key menu-bar-ediff-menu [ediff-windows-linewise] - '("Windows Line-by-line..." . ediff-windows-linewise)) - (define-key menu-bar-ediff-menu [ediff-windows-wordwise] - '("Windows Word-by-word..." . ediff-windows-wordwise)) - (define-key menu-bar-ediff-menu [separator-ediff-windows] '("--")) - (define-key menu-bar-ediff-menu [ediff-regions-linewise] - '("Regions Line-by-line..." . ediff-regions-linewise)) - (define-key menu-bar-ediff-menu [ediff-regions-wordwise] - '("Regions Word-by-word..." . ediff-regions-wordwise)) - (define-key menu-bar-ediff-menu [separator-ediff-regions] '("--")) - (define-key menu-bar-ediff-menu [ediff-dir-revision] - '("Directory Revisions..." . ediff-directory-revisions)) - (define-key menu-bar-ediff-menu [ediff-revision] - '("File with Revision..." . ediff-revision)) - (define-key menu-bar-ediff-menu [separator-ediff-directories] '("--")) - (define-key menu-bar-ediff-menu [ediff-directories3] - '("Three Directories..." . ediff-directories3)) - (define-key menu-bar-ediff-menu [ediff-directories] - '("Two Directories..." . ediff-directories)) - (define-key menu-bar-ediff-menu [separator-ediff-files] '("--")) - (define-key menu-bar-ediff-menu [ediff-buffers3] - '("Three Buffers..." . ediff-buffers3)) - (define-key menu-bar-ediff-menu [ediff-files3] - '("Three Files..." . ediff-files3)) - (define-key menu-bar-ediff-menu [ediff-buffers] - '("Two Buffers..." . ediff-buffers)) - (define-key menu-bar-ediff-menu [ediff-files] - '("Two Files..." . ediff-files)) - - ;; define merge menu - (define-key - menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor] - '("Directory Revisions with Ancestor..." - . ediff-merge-directory-revisions-with-ancestor)) - (define-key - menu-bar-ediff-merge-menu [ediff-merge-dir-revisions] - '("Directory Revisions..." . ediff-merge-directory-revisions)) - (define-key - menu-bar-ediff-merge-menu [ediff-merge-revisions-with-ancestor] - '("Revisions with Ancestor..." - . ediff-merge-revisions-with-ancestor)) - (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions] - '("Revisions..." . ediff-merge-revisions)) - (define-key menu-bar-ediff-merge-menu [separator-ediff-merge] '("--")) - (define-key - menu-bar-ediff-merge-menu [ediff-merge-directories-with-ancestor] - '("Directories with Ancestor..." - . ediff-merge-directories-with-ancestor)) - (define-key menu-bar-ediff-merge-menu [ediff-merge-directories] - '("Directories..." . ediff-merge-directories)) - (define-key - menu-bar-ediff-merge-menu [separator-ediff-merge-dirs] '("--")) - (define-key - menu-bar-ediff-merge-menu [ediff-merge-buffers-with-ancestor] - '("Buffers with Ancestor..." . ediff-merge-buffers-with-ancestor)) - (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers] - '("Buffers..." . ediff-merge-buffers)) - (define-key menu-bar-ediff-merge-menu [ediff-merge-files-with-ancestor] - '("Files with Ancestor..." . ediff-merge-files-with-ancestor)) - (define-key menu-bar-ediff-merge-menu [ediff-merge-files] - '("Files..." . ediff-merge-files)) - - ;; define epatch menu - (define-key menu-bar-epatch-menu [ediff-patch-buffer] - '("To a Buffer..." . ediff-patch-buffer)) - (define-key menu-bar-epatch-menu [ediff-patch-file] - '("To a File..." . ediff-patch-file)) - - ;; define ediff miscellanea - (define-key menu-bar-ediff-misc-menu [emultiframe] - '("Toggle use of separate control buffer frame" - . ediff-toggle-multiframe)) - (define-key menu-bar-ediff-misc-menu [eregistry] - '("List Ediff Sessions" . ediff-show-registry)) - (define-key menu-bar-ediff-misc-menu [ediff-cust] - '("Customize Ediff" . ediff-customize)) - (define-key menu-bar-ediff-misc-menu [ediff-doc] - '("Ediff Manual" . ediff-documentation)) - ) - - ) ; emacs case - ) ; ediff-cond-compile-for-xemacs-or-emacs - -;; arrange for autoloads -(if purify-flag - () ; if dumping, autoloads are set up in loaddefs.el - ;; if the user decides to load this file, set up autoloads - ;; compare files and buffers - (autoload 'ediff "ediff" "Compare two files" t) - (autoload 'ediff-files "ediff" "Compare two files" t) - (autoload 'ediff-buffers "ediff" "Compare two bufers" t) - (autoload 'ebuffers "ediff" "Compare two bufers" t) - (autoload 'ediff3 "ediff" "Compare three files" t) - (autoload 'ediff-files3 "ediff" "Compare three files" t) - (autoload 'ediff-buffers3 "ediff" "Compare three bufers" t) - (autoload 'ebuffers3 "ediff" "Compare three bufers" t) - - (autoload 'erevision "ediff" "Compare versions of a file" t) - (autoload 'ediff-revision "ediff" "Compare versions of a file" t) - - ;; compare regions and windows - (autoload 'ediff-windows-wordwise - "ediff" "Compare two windows word-by-word." t) - (autoload 'ediff-regions-wordwise - "ediff" "Compare two regions word-by-word." t) - (autoload 'ediff-windows-linewise - "ediff" "Compare two windows line-by-line." t) - (autoload 'ediff-regions-linewise - "ediff" "Compare two regions line-by-line." t) - - ;; patch - (autoload 'ediff-patch-file "ediff" "Patch a file." t) - (autoload 'epatch "ediff" "Patch a file." t) - (autoload 'ediff-patch-buffer "ediff" "Patch a buffer.") - (autoload 'epatch-buffer "ediff" "Patch a buffer." t) - - ;; merge - (autoload 'ediff-merge "ediff" "Merge two files." t) - (autoload 'ediff-merge-files "ediff" "Merge two files." t) - (autoload 'ediff-merge-files-with-ancestor - "ediff" "Merge two files using a third file as an ancestor." t) - (autoload 'ediff-merge-buffers "ediff" "Merge two buffers." t) - (autoload 'ediff-merge-buffers-with-ancestor - "ediff" "Merge two buffers using a third buffer as an ancestor." t) - - (autoload 'ediff-merge-revisions "ediff" "Merge two versions of a file." t) - (autoload 'ediff-merge-revisions-with-ancestor - "ediff" "Merge two versions of a file." t) - - ;; compare directories - (autoload 'edirs "ediff" "Compare files in two directories." t) - (autoload 'ediff-directories "ediff" "Compare files in two directories." t) - (autoload 'edirs3 "ediff" "Compare files in three directories." t) - (autoload - 'ediff-directories3 "ediff" "Compare files in three directories." t) - - (autoload 'edir-revisions - "ediff" "Compare two versions of a file." t) - (autoload 'ediff-directory-revisions - "ediff" "Compare two versions of a file." t) - - ;; merge directories - (autoload 'edirs-merge "ediff" "Merge files in two directories." t) - (autoload 'ediff-merge-directories - "ediff" "Merge files in two directories." t) - (autoload 'edirs-merge-with-ancestor - "ediff" - "Merge files in two directories using files in a third dir as ancestors." - t) - (autoload 'ediff-merge-directories-with-ancestor - "ediff" - "Merge files in two directories using files in a third dir as ancestors." - t) - - (autoload 'edir-merge-revisions - "ediff" "Merge versions of files in a directory." t) - (autoload 'ediff-merge-directory-revisions - "ediff" "Merge versions of files in a directory." t) - (autoload 'ediff-merge-directory-revisions-with-ancestor - "ediff" - "Merge versions of files in a directory using other versions as ancestors." - t) - (autoload 'edir-merge-revisions-with-ancestor - "ediff" - "Merge versions of files in a directory using other versions as ancestors." - t) - - ;; misc - (autoload 'ediff-show-registry - "ediff-mult" - "Display the registry of active Ediff sessions." - t) - (autoload 'eregistry - "ediff-mult" - "Display the registry of active Ediff sessions." - t) - (autoload 'ediff-documentation - "ediff" - "Display Ediff's manual." - t) - (autoload 'ediff-version - "ediff" - "Show Ediff's version and last modification date." - t) - (autoload 'ediff-toggle-multiframe - "ediff-util" - "Toggle the use of separate frame for Ediff control buffer." - t) - (autoload 'ediff-toggle-use-toolbar - "ediff-util" - "Toggle the use of Ediff toolbar." - t) - - ) ; if purify-flag - - -(provide 'ediff-hook) - - -;;; arch-tag: 512f8656-8a4b-4789-af5d-5c6144498df3 -;;; ediff-hook.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-init.el b/xemacs-packages/lisp/ediff/ediff-init.el deleted file mode 100644 index 2fc0ceef..00000000 --- a/xemacs-packages/lisp/ediff/ediff-init.el +++ /dev/null @@ -1,1882 +0,0 @@ -;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff - -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -;; Start compiler pacifier -(defvar ediff-metajob-name) -(defvar ediff-meta-buffer) -(defvar pm-color-alist) -(defvar ediff-grab-mouse) -(defvar ediff-mouse-pixel-position) -(defvar ediff-mouse-pixel-threshold) -(defvar ediff-whitespace) -(defvar ediff-multiframe) -(defvar ediff-use-toolbar-p) -(defvar mswindowsx-bitmap-file-path) - -(and noninteractive - (eval-when-compile - (load "ange-ftp" 'noerror))) -;; end pacifier - -;; Is it XEmacs? -(defconst ediff-xemacs-p (featurep 'xemacs)) -;; Is it Emacs? -(defconst ediff-emacs-p (not ediff-xemacs-p)) - -;; This is used to avoid compilation warnings. When emacs/xemacs forms can -;; generate compile time warnings, we use this macro. -;; In this case, the macro will expand into the form that is appropriate to the -;; compiler at hand. -;; Suggested by rms. -(defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form) - (if (featurep 'xemacs) - xemacs-form emacs-form)) - -(defvar ediff-force-faces nil - "If t, Ediff will think that it is running on a display that supports faces. -This is provided as a temporary relief for users of face-capable displays -that Ediff doesn't know about.") - -;; Are we running as a window application or on a TTY? -(defsubst ediff-device-type () - (ediff-cond-compile-for-xemacs-or-emacs - (device-type (selected-device)) ; xemacs form - window-system ; emacs form - )) - -;; in XEmacs: device-type is tty on tty and stream in batch. -(defun ediff-window-display-p () - (and (ediff-device-type) (not (memq (ediff-device-type) '(tty pc stream))))) - -;; test if supports faces -(defun ediff-has-face-support-p () - (cond ((ediff-window-display-p)) - (ediff-force-faces) - ((ediff-color-display-p)) - (ediff-emacs-p (memq (ediff-device-type) '(pc))) - (ediff-xemacs-p (memq (ediff-device-type) '(tty pc))) - )) - -;; toolbar support for emacs hasn't been implemented in ediff -(defun ediff-has-toolbar-support-p () - (ediff-cond-compile-for-xemacs-or-emacs - (and (featurep 'toolbar) (console-on-window-system-p)) ; xemacs form - nil ; emacs form - )) - - -(defun ediff-has-gutter-support-p () - (ediff-cond-compile-for-xemacs-or-emacs - (and (featurep 'gutter) (console-on-window-system-p)) ; xemacs form - nil ; emacs form - )) - - -(defun ediff-use-toolbar-p () - (and (ediff-has-toolbar-support-p) ;Can it do it ? - (boundp 'ediff-use-toolbar-p) - ediff-use-toolbar-p)) ;Does the user want it ? - -;; Defines SYMBOL as an advertised local variable. -;; Performs a defvar, then executes `make-variable-buffer-local' on -;; the variable. Also sets the `permanent-local' property, -;; so that `kill-all-local-variables' (called by major-mode setting -;; commands) won't destroy Ediff control variables. -;; -;; Plagiarised from `emerge-defvar-local' for XEmacs. -(defmacro ediff-defvar-local (var value doc) - `(progn - (defvar ,var ,value ,doc) - (make-variable-buffer-local ',var) - (put ',var 'permanent-local t))) - - - -;; Variables that control each Ediff session---local to the control buffer. - -;; Mode variables -;; The buffer in which the A variant is stored. -(ediff-defvar-local ediff-buffer-A nil "") -;; The buffer in which the B variant is stored. -(ediff-defvar-local ediff-buffer-B nil "") -;; The buffer in which the C variant is stored or where the merge buffer lives. -(ediff-defvar-local ediff-buffer-C nil "") -;; Ancestor buffer -(ediff-defvar-local ediff-ancestor-buffer nil "") -;; The Ediff control buffer -(ediff-defvar-local ediff-control-buffer nil "") - -(ediff-defvar-local ediff-temp-indirect-buffer nil - "If t, the buffer is a temporary indirect buffer. -It needs to be killed when we quit the session.") - - -;; Association between buff-type and ediff-buffer-* -(defconst ediff-buffer-alist - '((?A . ediff-buffer-A) - (?B . ediff-buffer-B) - (?C . ediff-buffer-C))) - -;;; Macros -(defmacro ediff-odd-p (arg) - `(eq (logand ,arg 1) 1)) - -(defmacro ediff-buffer-live-p (buf) - `(and ,buf (get-buffer ,buf) (buffer-name (get-buffer ,buf)))) - -(defmacro ediff-get-buffer (arg) - `(cond ((eq ,arg 'A) ediff-buffer-A) - ((eq ,arg 'B) ediff-buffer-B) - ((eq ,arg 'C) ediff-buffer-C) - ((eq ,arg 'Ancestor) ediff-ancestor-buffer) - )) - -(defmacro ediff-get-value-according-to-buffer-type (buf-type list) - `(cond ((eq ,buf-type 'A) (nth 0 ,list)) - ((eq ,buf-type 'B) (nth 1 ,list)) - ((eq ,buf-type 'C) (nth 2 ,list)) - )) - -(defmacro ediff-char-to-buftype (arg) - `(cond ((memq ,arg '(?a ?A)) 'A) - ((memq ,arg '(?b ?B)) 'B) - ((memq ,arg '(?c ?C)) 'C) - )) - - -;; A-list is supposed to be of the form (A . symb) (B . symb)...) -;; where the first part of any association is a buffer type and the second is -;; an appropriate symbol. Given buffer-type, this function returns the -;; symbol. This is used to avoid using `intern' -(defsubst ediff-get-symbol-from-alist (buf-type alist) - (cdr (assoc buf-type alist))) - -(defconst ediff-difference-vector-alist - '((A . ediff-difference-vector-A) - (B . ediff-difference-vector-B) - (C . ediff-difference-vector-C) - (Ancestor . ediff-difference-vector-Ancestor))) - -(defmacro ediff-get-difference (n buf-type) - `(aref - (symbol-value - (ediff-get-symbol-from-alist - ,buf-type ediff-difference-vector-alist)) - ,n)) - -;; Tell if it has been previously determined that the region has -;; no diffs other than the white space and newlines -;; The argument, N, is the diff region number used by Ediff to index the -;; diff vector. It is 1 less than the number seen by the user. -;; Returns: -;; t if the diffs are whitespace in all buffers -;; 'A (in 3-buf comparison only) if there are only whitespace -;; diffs in bufs B and C -;; 'B (in 3-buf comparison only) if there are only whitespace -;; diffs in bufs A and C -;; 'C (in 3-buf comparison only) if there are only whitespace -;; diffs in bufs A and B -;; -;; A Difference Vector has the form: -;; [diff diff diff ...] -;; where each diff has the form: -;; [overlay fine-diff-vector no-fine-diffs-flag state-of-difference] -;; fine-diff-vector is a vector [fine-diff fine-diff fine-diff ...] -;; no-fine-diffs-flag says if there are fine differences. -;; state-of-difference is A, B, C, or nil, indicating which buffer is -;; different from the other two (used only in 3-way jobs). -(defmacro ediff-no-fine-diffs-p (n) - `(aref (ediff-get-difference ,n 'A) 2)) - -(defmacro ediff-get-diff-overlay-from-diff-record (diff-rec) - `(aref ,diff-rec 0)) - -(defmacro ediff-get-diff-overlay (n buf-type) - `(ediff-get-diff-overlay-from-diff-record - (ediff-get-difference ,n ,buf-type))) - -(defmacro ediff-get-fine-diff-vector-from-diff-record (diff-rec) - `(aref ,diff-rec 1)) - -(defmacro ediff-set-fine-diff-vector (n buf-type fine-vec) - `(aset (ediff-get-difference ,n ,buf-type) 1 ,fine-vec)) - -(defmacro ediff-get-state-of-diff (n buf-type) - `(if (ediff-buffer-live-p ediff-buffer-C) - (aref (ediff-get-difference ,n ,buf-type) 3))) -(defmacro ediff-set-state-of-diff (n buf-type val) - `(aset (ediff-get-difference ,n ,buf-type) 3 ,val)) - -(defmacro ediff-get-state-of-merge (n) - `(if ediff-state-of-merge - (aref (aref ediff-state-of-merge ,n) 0))) -(defmacro ediff-set-state-of-merge (n val) - `(if ediff-state-of-merge - (aset (aref ediff-state-of-merge ,n) 0 ,val))) - -(defmacro ediff-get-state-of-ancestor (n) - `(if ediff-state-of-merge - (aref (aref ediff-state-of-merge ,n) 1))) - -;; if flag is t, puts a mark on diff region saying that -;; the differences are in white space only. If flag is nil, -;; the region is marked as essential (i.e., differences are -;; not just in the white space and newlines.) -(defmacro ediff-mark-diff-as-space-only (n flag) - `(aset (ediff-get-difference ,n 'A) 2 ,flag)) - -(defmacro ediff-get-fine-diff-vector (n buf-type) - `(ediff-get-fine-diff-vector-from-diff-record - (ediff-get-difference ,n ,buf-type))) - -;; Macro to switch to BUFFER, evaluate BODY, returns to original buffer. -;; Doesn't save the point and mark. -;; This is `with-current-buffer' with the added test for live buffers." -(defmacro ediff-with-current-buffer (buffer &rest body) - `(if (ediff-buffer-live-p ,buffer) - (save-current-buffer - (set-buffer ,buffer) - ,@body) - (or (eq this-command 'ediff-quit) - (error ediff-KILLED-VITAL-BUFFER)) - )) - - -(defsubst ediff-multiframe-setup-p () - (and (ediff-window-display-p) ediff-multiframe)) - -(defmacro ediff-narrow-control-frame-p () - `(and (ediff-multiframe-setup-p) - (equal ediff-help-message ediff-brief-message-string))) - -(defmacro ediff-3way-comparison-job () - `(memq - ediff-job-name - '(ediff-files3 ediff-buffers3))) -(ediff-defvar-local ediff-3way-comparison-job nil "") - -(defmacro ediff-merge-job () - `(memq - ediff-job-name - '(ediff-merge-files - ediff-merge-buffers - ediff-merge-files-with-ancestor - ediff-merge-buffers-with-ancestor - ediff-merge-revisions - ediff-merge-revisions-with-ancestor))) -(ediff-defvar-local ediff-merge-job nil "") - -(defmacro ediff-patch-job () - `(eq ediff-job-name 'epatch)) - -(defmacro ediff-merge-with-ancestor-job () - `(memq - ediff-job-name - '(ediff-merge-files-with-ancestor - ediff-merge-buffers-with-ancestor - ediff-merge-revisions-with-ancestor))) -(ediff-defvar-local ediff-merge-with-ancestor-job nil "") - -(defmacro ediff-3way-job () - `(or ediff-3way-comparison-job ediff-merge-job)) -(ediff-defvar-local ediff-3way-job nil "") - -;; A diff3 job is like a 3way job, but ediff-merge doesn't require the use -;; of diff3. -(defmacro ediff-diff3-job () - `(or ediff-3way-comparison-job - ediff-merge-with-ancestor-job)) -(ediff-defvar-local ediff-diff3-job nil "") - -(defmacro ediff-windows-job () - `(memq ediff-job-name '(ediff-windows-wordwise ediff-windows-linewise))) -(ediff-defvar-local ediff-windows-job nil "") - -(defmacro ediff-word-mode-job () - `(memq ediff-job-name '(ediff-windows-wordwise ediff-regions-wordwise))) -(ediff-defvar-local ediff-word-mode-job nil "") - -(defmacro ediff-narrow-job () - `(memq ediff-job-name '(ediff-windows-wordwise - ediff-regions-wordwise - ediff-windows-linewise - ediff-regions-linewise))) -(ediff-defvar-local ediff-narrow-job nil "") - -;; Note: ediff-merge-directory-revisions-with-ancestor is not treated as an -;; ancestor metajob, since it behaves differently. -(defsubst ediff-ancestor-metajob (&optional metajob) - (memq (or metajob ediff-metajob-name) - '(ediff-merge-directories-with-ancestor - ediff-merge-filegroups-with-ancestor))) -(defsubst ediff-revision-metajob (&optional metajob) - (memq (or metajob ediff-metajob-name) - '(ediff-directory-revisions - ediff-merge-directory-revisions - ediff-merge-directory-revisions-with-ancestor))) -(defsubst ediff-patch-metajob (&optional metajob) - (memq (or metajob ediff-metajob-name) - '(ediff-multifile-patch))) -;; metajob involving only one group of files, such as multipatch or directory -;; revision -(defsubst ediff-one-filegroup-metajob (&optional metajob) - (or (ediff-revision-metajob metajob) - (ediff-patch-metajob metajob) - ;; add more here - )) -;; jobs suitable for the operation of collecting diffs into a multifile patch -(defsubst ediff-collect-diffs-metajob (&optional metajob) - (memq (or metajob ediff-metajob-name) - '(ediff-directories - ediff-merge-directories - ediff-merge-directories-with-ancestor - ediff-directory-revisions - ediff-merge-directory-revisions - ediff-merge-directory-revisions-with-ancestor - ;; add more here - ))) -(defsubst ediff-merge-metajob (&optional metajob) - (memq (or metajob ediff-metajob-name) - '(ediff-merge-directories - ediff-merge-directories-with-ancestor - ediff-merge-directory-revisions - ediff-merge-directory-revisions-with-ancestor - ediff-merge-filegroups-with-ancestor - ;; add more here - ))) - -(defsubst ediff-metajob3 (&optional metajob) - (memq (or metajob ediff-metajob-name) - '(ediff-merge-directories-with-ancestor - ediff-merge-filegroups-with-ancestor - ediff-directories3 - ediff-filegroups3))) -(defsubst ediff-comparison-metajob3 (&optional metajob) - (memq (or metajob ediff-metajob-name) - '(ediff-directories3 ediff-filegroups3))) - -;; with no argument, checks if we are in ediff-control-buffer -;; with argument, checks if we are in ediff-meta-buffer -(defun ediff-in-control-buffer-p (&optional meta-buf-p) - (and (boundp 'ediff-control-buffer) - (eq (if meta-buf-p ediff-meta-buffer ediff-control-buffer) - (current-buffer)))) - -(defsubst ediff-barf-if-not-control-buffer (&optional meta-buf-p) - (or (ediff-in-control-buffer-p meta-buf-p) - (error "%S: This command runs in Ediff Control Buffer only!" - this-command))) - -(defgroup ediff-highlighting nil - "Hilighting of difference regions in Ediff." - :prefix "ediff-" - :group 'ediff) - -(defgroup ediff-merge nil - "Merging utilities." - :prefix "ediff-" - :group 'ediff) - -(defgroup ediff-hook nil - "Hooks run by Ediff." - :prefix "ediff-" - :group 'ediff) - -;; Hook variables - -(defcustom ediff-before-setup-hook nil - "*Hooks to run before Ediff begins to set up windows and buffers. -This hook can be used to save the previous window config, which can be restored -on ediff-quit or ediff-suspend." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-before-setup-windows-hook nil - "*Hooks to run before Ediff sets its window configuration. -This hook is run every time when Ediff arranges its windows. -This happens each time Ediff detects that the windows were messed up by the -user." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-after-setup-windows-hook nil - "*Hooks to run after Ediff sets its window configuration. -This can be used to set up control window or icon in a desired place." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-before-setup-control-frame-hook nil - "*Hooks run before setting up the frame to display Ediff Control Panel. -Can be used to change control frame parameters to position it where it -is desirable." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-after-setup-control-frame-hook nil - "*Hooks run after setting up the frame to display Ediff Control Panel. -Can be used to move the frame where it is desired." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-startup-hook nil - "*Hooks to run in the control buffer after Ediff has been set up and is ready for the job." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-select-hook nil - "*Hooks to run after a difference has been selected." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-unselect-hook nil - "*Hooks to run after a difference has been unselected." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-prepare-buffer-hook nil - "*Hooks run after buffers A, B, and C are set up. -For each buffer, the hooks are run with that buffer made current." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-load-hook nil - "*Hook run after Ediff is loaded. Can be used to change defaults." - :type 'hook - :group 'ediff-hook) - -(defcustom ediff-mode-hook nil - "*Hook run just after ediff-mode is set up in the control buffer. -This is done before any windows or frames are created. One can use it to -set local variables that determine how the display looks like." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-keymap-setup-hook nil - "*Hook run just after the default bindings in Ediff keymap are set up." - :type 'hook - :group 'ediff-hook) - -(defcustom ediff-display-help-hook nil - "*Hooks run after preparing the help message." - :type 'hook - :group 'ediff-hook) - -(defcustom ediff-suspend-hook nil - "*Hooks to run in the Ediff control buffer when Ediff is suspended." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-quit-hook nil - "*Hooks to run in the Ediff control buffer after finishing Ediff." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-cleanup-hook nil - "*Hooks to run on exiting Ediff but before killing the control and variant buffers." - :type 'hook - :group 'ediff-hook) - -;; Error messages -(defconst ediff-KILLED-VITAL-BUFFER - "You have killed a vital Ediff buffer---you must leave Ediff now!") -(defconst ediff-NO-DIFFERENCES - "Sorry, comparison of identical variants is not what I am made for...") -(defconst ediff-BAD-DIFF-NUMBER - ;; %S stands for this-command, %d - diff number, %d - max diff - "%S: Bad diff region number, %d. Valid numbers are 1 to %d") -(defconst ediff-BAD-INFO (format " -*** The Info file for Ediff, a part of the standard distribution -*** of %sEmacs, does not seem to be properly installed. -*** -*** Please contact your system administrator. " - (if ediff-xemacs-p "X" ""))) - -;; Selective browsing - -(ediff-defvar-local ediff-skip-diff-region-function 'ediff-show-all-diffs - "Function that determines the next/previous diff region to show. -Should return t for regions to be ignored and nil otherwise. -This function gets a region number as an argument. The region number -is the one used internally by Ediff. It is 1 less than the number seen -by the user.") - -(ediff-defvar-local ediff-hide-regexp-matches-function - 'ediff-hide-regexp-matches - "Function to use in determining which regions to hide. -See the documentation string of `ediff-hide-regexp-matches' for details.") -(ediff-defvar-local ediff-focus-on-regexp-matches-function - 'ediff-focus-on-regexp-matches - "Function to use in determining which regions to focus on. -See the documentation string of `ediff-focus-on-regexp-matches' for details.") - -;; Regexp that determines buf A regions to focus on when skipping to diff -(ediff-defvar-local ediff-regexp-focus-A "" "") -;; Regexp that determines buf B regions to focus on when skipping to diff -(ediff-defvar-local ediff-regexp-focus-B "" "") -;; Regexp that determines buf C regions to focus on when skipping to diff -(ediff-defvar-local ediff-regexp-focus-C "" "") -;; connective that determines whether to focus regions that match both or -;; one of the regexps -(ediff-defvar-local ediff-focus-regexp-connective 'and "") - -;; Regexp that determines buf A regions to ignore when skipping to diff -(ediff-defvar-local ediff-regexp-hide-A "" "") -;; Regexp that determines buf B regions to ignore when skipping to diff -(ediff-defvar-local ediff-regexp-hide-B "" "") -;; Regexp that determines buf C regions to ignore when skipping to diff -(ediff-defvar-local ediff-regexp-hide-C "" "") -;; connective that determines whether to hide regions that match both or -;; one of the regexps -(ediff-defvar-local ediff-hide-regexp-connective 'and "") - - -;;; Copying difference regions between buffers. - -;; A list of killed diffs. -;; A diff is saved here if it is replaced by a diff -;; from another buffer. This alist has the form: -;; \((num (buff-object . diff) (buff-object . diff) (buff-object . diff)) ...), -;; where some buffer-objects may be missing. -(ediff-defvar-local ediff-killed-diffs-alist nil "") - -;; Syntax table to use in ediff-forward-word-function -;; This is chosen by a heuristic. The important thing is for all buffers to -;; have the same syntax table. Which is not too important. -(ediff-defvar-local ediff-syntax-table nil "") - - -;; Highlighting -(defcustom ediff-before-flag-bol (if (featurep 'xemacs) (make-glyph "->>") "->>") - "*Flag placed before a highlighted block of differences, if block starts at beginning of a line." - :type 'string - :tag "Region before-flag at beginning of line" - :group 'ediff) - -(defcustom ediff-after-flag-eol (if (featurep 'xemacs) (make-glyph "<<-") "<<-") - "*Flag placed after a highlighted block of differences, if block ends at end of a line." - :type 'string - :tag "Region after-flag at end of line" - :group 'ediff) - -(defcustom ediff-before-flag-mol (if (featurep 'xemacs) (make-glyph "->>") "->>") - "*Flag placed before a highlighted block of differences, if block starts in mid-line." - :type 'string - :tag "Region before-flag in the middle of line" - :group 'ediff) -(defcustom ediff-after-flag-mol (if (featurep 'xemacs) (make-glyph "<<-") "<<-") - "*Flag placed after a highlighted block of differences, if block ends in mid-line." - :type 'string - :tag "Region after-flag in the middle of line" - :group 'ediff) - - -(ediff-defvar-local ediff-use-faces t "") -(defcustom ediff-use-faces t - "If t, differences are highlighted using faces, if device supports faces. -If nil, differences are highlighted using ASCII flags, ediff-before-flag -and ediff-after-flag. On a non-window system, differences are always -highlighted using ASCII flags." - :type 'boolean - :group 'ediff-highlighting) - -;; this indicates that diff regions are word-size, so fine diffs are -;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise -(ediff-defvar-local ediff-word-mode nil "") -;; Name of the job (ediff-files, ediff-windows, etc.) -(ediff-defvar-local ediff-job-name nil "") - -;; Narrowing and ediff-region/windows support -;; This is a list (overlay-A overlay-B overlay-C) -;; If set, Ediff compares only those parts of buffers A/B/C that lie within -;; the bounds of these overlays. -(ediff-defvar-local ediff-narrow-bounds nil "") - -;; List (overlay-A overlay-B overlay-C), where each overlay spans the -;; entire corresponding buffer. -(ediff-defvar-local ediff-wide-bounds nil "") - -;; Current visibility boundaries in buffers A, B, and C. -;; This is also a list of overlays. When the user toggles narrow/widen, -;; this list changes from ediff-wide-bounds to ediff-narrow-bounds. -;; and back. -(ediff-defvar-local ediff-visible-bounds nil "") - -(ediff-defvar-local ediff-start-narrowed t - "Non-nil means start narrowed, if doing ediff-windows-* or ediff-regions-*") -(ediff-defvar-local ediff-quit-widened t - "*Non-nil means: when finished, Ediff widens buffers A/B. -Actually, Ediff restores the scope of visibility that existed at startup.") - -(defcustom ediff-keep-variants t - "*nil means prompt to remove unmodified buffers A/B/C at session end. -Supplying a prefix argument to the quit command `q' temporarily reverses the -meaning of this variable." - :type 'boolean - :group 'ediff) - -(ediff-defvar-local ediff-highlight-all-diffs t "") -(defcustom ediff-highlight-all-diffs t - "If nil, only the selected differences are highlighted. -Otherwise, all difference regions are highlighted, but the selected region is -shown in brighter colors." - :type 'boolean - :group 'ediff-highlighting) - - -;; The suffix of the control buffer name. -(ediff-defvar-local ediff-control-buffer-suffix nil "") -;; Same as ediff-control-buffer-suffix, but without <,>. -;; It's a number rather than string. -(ediff-defvar-local ediff-control-buffer-number nil "") - - -;; The original values of ediff-protected-variables for buffer A -(ediff-defvar-local ediff-buffer-values-orig-A nil "") -;; The original values of ediff-protected-variables for buffer B -(ediff-defvar-local ediff-buffer-values-orig-B nil "") -;; The original values of ediff-protected-variables for buffer C -(ediff-defvar-local ediff-buffer-values-orig-C nil "") -;; The original values of ediff-protected-variables for buffer Ancestor -(ediff-defvar-local ediff-buffer-values-orig-Ancestor nil "") - -;; association between buff-type and ediff-buffer-values-orig-* -(defconst ediff-buffer-values-orig-alist - '((A . ediff-buffer-values-orig-A) - (B . ediff-buffer-values-orig-B) - (C . ediff-buffer-values-orig-C) - (Ancestor . ediff-buffer-values-orig-Ancestor))) - -;; Buffer-local variables to be saved then restored during Ediff sessions -(defconst ediff-protected-variables '( - ;;buffer-read-only - mode-line-format)) - -;; Vector of differences between the variants. Each difference is -;; represented by a vector of two overlays plus a vector of fine diffs, -;; plus a no-fine-diffs flag. The first overlay spans the -;; difference region in the A buffer and the second overlays the diff in -;; the B buffer. If a difference section is empty, the corresponding -;; overlay's endpoints coincide. -;; -;; The precise form of a Difference Vector for one buffer is: -;; [diff diff diff ...] -;; where each diff has the form: -;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-diff] -;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...] -;; no-fine-diffs-flag says if there are fine differences. -;; state-of-difference is A, B, C, or nil, indicating which buffer is -;; different from the other two (used only in 3-way jobs. -(ediff-defvar-local ediff-difference-vector-A nil "") -(ediff-defvar-local ediff-difference-vector-B nil "") -(ediff-defvar-local ediff-difference-vector-C nil "") -(ediff-defvar-local ediff-difference-vector-Ancestor nil "") -;; A-list of diff vector types associated with buffer types -(defconst ediff-difference-vector-alist - '((A . ediff-difference-vector-A) - (B . ediff-difference-vector-B) - (C . ediff-difference-vector-C) - (Ancestor . ediff-difference-vector-Ancestor))) - -;; [ status status status ...] -;; Each status: [state-of-merge state-of-ancestor] -;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It -;; indicates the way a diff region was created in buffer C. -;; state-of-ancestor says if the corresponding region in ancestor buffer is -;; empty. -(ediff-defvar-local ediff-state-of-merge nil "") - -;; The difference that is currently selected. -(ediff-defvar-local ediff-current-difference -1 "") -;; Number of differences found. -(ediff-defvar-local ediff-number-of-differences nil "") - -;; Buffer containing the output of diff, which is used by Ediff to step -;; through files. -(ediff-defvar-local ediff-diff-buffer nil "") -;; Like ediff-diff-buffer, but contains context diff. It is not used by -;; Ediff, but it is saved in a file, if user requests so. -(ediff-defvar-local ediff-custom-diff-buffer nil "") -;; Buffer used for diff-style fine differences between regions. -(ediff-defvar-local ediff-fine-diff-buffer nil "") -;; Temporary buffer used for computing fine differences. -(defconst ediff-tmp-buffer " *ediff-tmp*" "") -;; Buffer used for messages -(defconst ediff-msg-buffer " *ediff-message*" "") -;; Buffer containing the output of diff when diff returns errors. -(ediff-defvar-local ediff-error-buffer nil "") -;; Buffer to display debug info -(ediff-defvar-local ediff-debug-buffer "*ediff-debug*" "") - -;; List of ediff control panels associated with each buffer A/B/C/Ancestor. -;; Not used any more, but may be needed in the future. -(ediff-defvar-local ediff-this-buffer-ediff-sessions nil "") - -;; to be deleted in due time -;; List of difference overlays disturbed by working with the current diff. -(defvar ediff-disturbed-overlays nil "") - -;; Priority of non-selected overlays. -(defvar ediff-shadow-overlay-priority 100 "") - -(defcustom ediff-version-control-package 'vc - "Version control package used. -Currently, Ediff supports vc.el, rcs.el, pcl-cvs.el, and generic-sc.el. The -standard Emacs interface to RCS, CVS, SCCS, etc., is vc.el. However, some -people find the other two packages more convenient. Set this variable to the -appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire." - :type 'symbol - :group 'ediff) - -(defcustom ediff-coding-system-for-read 'raw-text - "*The coding system for read to use when running the diff program as a subprocess. -In most cases, the default will do. However, under certain circumstances in -Windows NT/98/95 you might need to use something like 'raw-text-dos here. -So, if the output that your diff program sends to Emacs contains extra ^M's, -you might need to experiment here, if the default or 'raw-text-dos doesn't -work." - :type 'symbol - :group 'ediff) - -(defcustom ediff-coding-system-for-write 'no-conversion - "*The coding system for write to use when writing out difference regions -to temp files when Ediff needs to find fine differences." - :type 'symbol - :group 'ediff) - - -(ediff-cond-compile-for-xemacs-or-emacs - (progn ; xemacs - (defalias 'ediff-read-event 'next-command-event) - (defalias 'ediff-overlayp 'extentp) - (defalias 'ediff-make-overlay 'make-extent) - (defalias 'ediff-delete-overlay 'delete-extent)) - (progn ; emacs - (defalias 'ediff-read-event 'read-event) - (defalias 'ediff-overlayp 'overlayp) - (defalias 'ediff-make-overlay 'make-overlay) - (defalias 'ediff-delete-overlay 'delete-overlay)) - ) - -;; Check the current version against the major and minor version numbers -;; using op: cur-vers op major.minor If emacs-major-version or -;; emacs-minor-version are not defined, we assume that the current version -;; is hopelessly outdated. We assume that emacs-major-version and -;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the -;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value -;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be -;; incorrect. However, this gives correct result in our cases, since we are -;; testing for sufficiently high Emacs versions. -(defun ediff-check-version (op major minor &optional type-of-emacs) - (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version)) - (and (cond ((eq type-of-emacs 'xemacs) ediff-xemacs-p) - ((eq type-of-emacs 'emacs) ediff-emacs-p) - (t t)) - (cond ((eq op '=) (and (= emacs-minor-version minor) - (= emacs-major-version major))) - ((memq op '(> >= < <=)) - (and (or (funcall op emacs-major-version major) - (= emacs-major-version major)) - (if (= emacs-major-version major) - (funcall op emacs-minor-version minor) - t))) - (t - (error "%S: Invalid op in ediff-check-version" op)))) - (cond ((memq op '(= > >=)) nil) - ((memq op '(< <=)) t)))) - - -(defun ediff-color-display-p () - (condition-case nil - (ediff-cond-compile-for-xemacs-or-emacs - (eq (device-class (selected-device)) 'color) ; xemacs form - (if (fboundp 'display-color-p) ; emacs form - (display-color-p) - (x-display-color-p)) - ) - (error nil))) - - -;; A var local to each control panel buffer. Indicates highlighting style -;; in effect for this buffer: `face', `ascii', -;; `off' -- turned off \(on a dumb terminal only\). -(ediff-defvar-local ediff-highlighting-style - (if (and (ediff-has-face-support-p) ediff-use-faces) 'face 'ascii) - "") - - -(if (ediff-has-face-support-p) - (ediff-cond-compile-for-xemacs-or-emacs - (progn ; xemacs - (defalias 'ediff-valid-color-p 'valid-color-name-p) - (defalias 'ediff-get-face 'get-face)) - (progn ; emacs - (defalias 'ediff-valid-color-p (if (fboundp 'color-defined-p) - 'color-defined-p - 'x-color-defined-p)) - (defalias 'ediff-get-face 'internal-get-face)) - )) - -(if (ediff-window-display-p) - (ediff-cond-compile-for-xemacs-or-emacs - (progn ; xemacs - (defalias 'ediff-display-pixel-width 'device-pixel-width) - (defalias 'ediff-display-pixel-height 'device-pixel-height)) - (progn ; emacs - (defalias 'ediff-display-pixel-width - (if (fboundp 'display-pixel-width) - 'display-pixel-width - 'x-display-pixel-width)) - (defalias 'ediff-display-pixel-height - (if (fboundp 'display-pixel-height) - 'display-pixel-height - 'x-display-pixel-height))) - )) - -;; A-list of current-diff-overlay symbols associated with buf types -(defconst ediff-current-diff-overlay-alist - '((A . ediff-current-diff-overlay-A) - (B . ediff-current-diff-overlay-B) - (C . ediff-current-diff-overlay-C) - (Ancestor . ediff-current-diff-overlay-Ancestor))) - -;; A-list of current-diff-face-* symbols associated with buf types -(defconst ediff-current-diff-face-alist - '((A . ediff-current-diff-A) - (B . ediff-current-diff-B) - (C . ediff-current-diff-C) - (Ancestor . ediff-current-diff-Ancestor))) - - -(defun ediff-set-overlay-face (extent face) - (ediff-overlay-put extent 'face face) - (ediff-overlay-put extent 'help-echo 'ediff-region-help-echo)) - -(defun ediff-region-help-echo (extent-or-window &optional overlay point) - (unless overlay - (setq overlay extent-or-window)) - (let ((is-current (ediff-overlay-get overlay 'ediff)) - (face (ediff-overlay-get overlay 'face)) - (diff-num (ediff-overlay-get overlay 'ediff-diff-num)) - face-help) - - ;; This happens only for refinement overlays - (if (stringp face) - (setq face (intern face))) - (setq face-help (and face (get face 'ediff-help-echo))) - - (cond ((and is-current diff-num) ; current diff region - (format "Difference region %S -- current" (1+ diff-num))) - (face-help) ; refinement of current diff region - (diff-num ; non-current - (format "Difference region %S -- non-current" (1+ diff-num))) - (t "")) ; none - )) - - -(defun ediff-set-face-pixmap (face pixmap) - "Set face pixmap on a monochrome display." - (if (and (ediff-window-display-p) (not (ediff-color-display-p))) - (condition-case nil - (set-face-background-pixmap face pixmap) - (error - (message "Pixmap not found for %S: %s" (face-name face) pixmap) - (sit-for 1))))) - -(defun ediff-hide-face (face) - (if (and (ediff-has-face-support-p) - (boundp 'add-to-list) - (boundp 'facemenu-unlisted-faces)) - (add-to-list 'facemenu-unlisted-faces face))) - - - -(defface ediff-current-diff-A - (if ediff-emacs-p - '((((class color) (min-colors 16)) - (:foreground "firebrick" :background "pale green")) - (((class color)) - (:foreground "blue3" :background "yellow3")) - (t (:inverse-video t))) - '((((type tty)) (:foreground "blue3" :background "yellow3")) - (((class color)) (:foreground "firebrick" :background "pale green")) - (t (:inverse-video t)))) - "Face for highlighting the selected difference in buffer A." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-current-diff-face-A 'ediff-current-diff-A - "Face for highlighting the selected difference in buffer A. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-current-diff-A' -this variable represents.") -(ediff-hide-face ediff-current-diff-face-A) -;; Until custom.el for XEmacs starts supporting :inverse-video we do this. -;; This means that some user customization may be trashed. -(if (and ediff-xemacs-p - (ediff-has-face-support-p) - (not (ediff-color-display-p))) - (copy-face 'modeline ediff-current-diff-face-A)) - - - -(defface ediff-current-diff-B - (if ediff-emacs-p - '((((class color) (min-colors 16)) - (:foreground "DarkOrchid" :background "Yellow")) - (((class color)) - (:foreground "magenta3" :background "yellow3" - :weight bold)) - (t (:inverse-video t))) - '((((type tty)) (:foreground "magenta3" :background "yellow3" - :weight bold)) - (((class color)) (:foreground "DarkOrchid" :background "Yellow")) - (t (:inverse-video t)))) - "Face for highlighting the selected difference in buffer B." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-current-diff-face-B 'ediff-current-diff-B - "Face for highlighting the selected difference in buffer B. - this variable. Instead, use the customization -widget to customize the actual face `ediff-current-diff-B' -this variable represents.") -(ediff-hide-face ediff-current-diff-face-B) -;; Until custom.el for XEmacs starts supporting :inverse-video we do this. -;; This means that some user customization may be trashed. -(if (and ediff-xemacs-p - (ediff-has-face-support-p) - (not (ediff-color-display-p))) - (copy-face 'modeline ediff-current-diff-face-B)) - - -(defface ediff-current-diff-C - (if ediff-emacs-p - '((((class color) (min-colors 16)) - (:foreground "Navy" :background "Pink")) - (((class color)) - (:foreground "cyan3" :background "yellow3" :weight bold)) - (t (:inverse-video t))) - '((((type tty)) (:foreground "cyan3" :background "yellow3" :weight bold)) - (((class color)) (:foreground "Navy" :background "Pink")) - (t (:inverse-video t)))) - "Face for highlighting the selected difference in buffer C." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-current-diff-face-C 'ediff-current-diff-C - "Face for highlighting the selected difference in buffer C. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-current-diff-C' -this variable represents.") -(ediff-hide-face ediff-current-diff-face-C) -;; Until custom.el for XEmacs starts supporting :inverse-video we do this. -;; This means that some user customization may be trashed. -(if (and ediff-xemacs-p - (ediff-has-face-support-p) - (not (ediff-color-display-p))) - (copy-face 'modeline ediff-current-diff-face-C)) - - -(defface ediff-current-diff-Ancestor - (if ediff-emacs-p - '((((class color) (min-colors 16)) - (:foreground "Black" :background "VioletRed")) - (((class color)) - (:foreground "black" :background "magenta3")) - (t (:inverse-video t))) - '((((type tty)) (:foreground "black" :background "magenta3")) - (((class color)) (:foreground "Black" :background "VioletRed")) - (t (:inverse-video t)))) - "Face for highlighting the selected difference in buffer Ancestor." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-current-diff-face-Ancestor 'ediff-current-diff-Ancestor - "Face for highlighting the selected difference in buffer Ancestor. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-current-diff-Ancestor' -this variable represents.") -(ediff-hide-face ediff-current-diff-face-Ancestor) -;; Until custom.el for XEmacs starts supporting :inverse-video we do this. -;; This means that some user customization may be trashed. -(if (and ediff-xemacs-p - (ediff-has-face-support-p) - (not (ediff-color-display-p))) - (copy-face 'modeline ediff-current-diff-face-Ancestor)) - - -(defface ediff-fine-diff-A - (if ediff-emacs-p - '((((class color) (min-colors 16)) - (:foreground "Navy" :background "sky blue")) - (((class color)) - (:foreground "white" :background "sky blue" :weight bold)) - (t (:underline t :stipple "gray3"))) - '((((type tty)) (:foreground "white" :background "sky blue" :weight bold)) - (((class color)) (:foreground "Navy" :background "sky blue")) - (t (:underline t :stipple "gray3")))) - "Face for highlighting the refinement of the selected diff in buffer A." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-fine-diff-face-A 'ediff-fine-diff-A - "Face for highlighting the fine differences in buffer A. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-fine-diff-A' -this variable represents.") -(ediff-hide-face ediff-fine-diff-face-A) - -(defface ediff-fine-diff-B - (if ediff-emacs-p - '((((class color) (min-colors 16)) - (:foreground "Black" :background "cyan")) - (((class color)) - (:foreground "magenta3" :background "cyan3")) - (t (:underline t :stipple "gray3"))) - '((((type tty)) (:foreground "magenta3" :background "cyan3")) - (((class color)) (:foreground "Black" :background "cyan")) - (t (:underline t :stipple "gray3")))) - "Face for highlighting the refinement of the selected diff in buffer B." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-fine-diff-face-B 'ediff-fine-diff-B - "Face for highlighting the fine differences in buffer B. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-fine-diff-B' -this variable represents.") -(ediff-hide-face ediff-fine-diff-face-B) - -(defface ediff-fine-diff-C - (if ediff-emacs-p - '((((type pc)) - (:foreground "white" :background "Turquoise")) - (((class color) (min-colors 16)) - (:foreground "Black" :background "Turquoise")) - (((class color)) - (:foreground "yellow3" :background "Turquoise" - :weight bold)) - (t (:underline t :stipple "gray3"))) - '((((type tty)) (:foreground "yellow3" :background "Turquoise" - :weight bold)) - (((type pc)) (:foreground "white" :background "Turquoise")) - (((class color)) (:foreground "Black" :background "Turquoise")) - (t (:underline t :stipple "gray3")))) - "Face for highlighting the refinement of the selected diff in buffer C." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-fine-diff-face-C 'ediff-fine-diff-C - "Face for highlighting the fine differences in buffer C. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-fine-diff-C' -this variable represents.") -(ediff-hide-face ediff-fine-diff-face-C) - -(defface ediff-fine-diff-Ancestor - (if ediff-emacs-p - '((((class color) (min-colors 16)) - (:foreground "Black" :background "Green")) - (((class color)) - (:foreground "red3" :background "green")) - (t (:underline t :stipple "gray3"))) - '((((type tty)) (:foreground "red3" :background "green")) - (((class color)) (:foreground "Black" :background "Green")) - (t (:underline t :stipple "gray3")))) - "Face for highlighting the refinement of the selected diff in the ancestor buffer. -At present, this face is not used and no fine differences are computed for the -ancestor buffer." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-fine-diff-face-Ancestor 'ediff-fine-diff-Ancestor - "Face for highlighting the fine differences in buffer Ancestor. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-fine-diff-Ancestor' -this variable represents.") -(ediff-hide-face ediff-fine-diff-face-Ancestor) - -;; Some installs don't have stipple or Stipple. So, try them in turn. -(defvar stipple-pixmap - (cond ((not (ediff-has-face-support-p)) nil) - ((and (boundp 'x-bitmap-file-path) - (locate-library "stipple" t x-bitmap-file-path)) "stipple") - ((and (boundp 'mswindowsx-bitmap-file-path) - (locate-library "stipple" t mswindowsx-bitmap-file-path)) "stipple") - (t "Stipple"))) - -(defface ediff-even-diff-A - (if ediff-emacs-p - `((((type pc)) - (:foreground "green3" :background "light grey")) - (((class color) (min-colors 16)) - (:foreground "Black" :background "light grey")) - (((class color)) - (:foreground "red3" :background "light grey" - :weight bold)) - (t (:italic t :stipple ,stipple-pixmap))) - `((((type tty)) (:foreground "red3" :background "light grey" - :weight bold)) - (((type pc)) (:foreground "green3" :background "light grey")) - (((class color)) (:foreground "Black" :background "light grey")) - (t (:italic t :stipple ,stipple-pixmap)))) - "Face for highlighting even-numbered non-current differences in buffer A." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-even-diff-face-A 'ediff-even-diff-A - "Face for highlighting even-numbered non-current differences in buffer A. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-even-diff-A' -this variable represents.") -(ediff-hide-face ediff-even-diff-face-A) - -(defface ediff-even-diff-B - (if ediff-emacs-p - `((((class color) (min-colors 16)) - (:foreground "White" :background "Grey")) - (((class color)) - (:foreground "blue3" :background "Grey" :weight bold)) - (t (:italic t :stipple ,stipple-pixmap))) - `((((type tty)) (:foreground "blue3" :background "Grey" :weight bold)) - (((class color)) (:foreground "White" :background "Grey")) - (t (:italic t :stipple ,stipple-pixmap)))) - "Face for highlighting even-numbered non-current differences in buffer B." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-even-diff-face-B 'ediff-even-diff-B - "Face for highlighting even-numbered non-current differences in buffer B. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-even-diff-B' -this variable represents.") -(ediff-hide-face ediff-even-diff-face-B) - -(defface ediff-even-diff-C - (if ediff-emacs-p - `((((type pc)) - (:foreground "yellow3" :background "light grey")) - (((class color) (min-colors 16)) - (:foreground "Black" :background "light grey")) - (((class color)) - (:foreground "yellow3" :background "light grey" - :weight bold)) - (t (:italic t :stipple ,stipple-pixmap))) - `((((type tty)) (:foreground "yellow3" :background "light grey" - :weight bold)) - (((type pc)) (:foreground "yellow3" :background "light grey")) - (((class color)) (:foreground "Black" :background "light grey")) - (t (:italic t :stipple ,stipple-pixmap)))) - "Face for highlighting even-numbered non-current differences in buffer C." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-even-diff-face-C 'ediff-even-diff-C - "Face for highlighting even-numbered non-current differences in buffer C. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-even-diff-C' -this variable represents.") -(ediff-hide-face ediff-even-diff-face-C) - -(defface ediff-even-diff-Ancestor - (if ediff-emacs-p - `((((type pc)) - (:foreground "cyan3" :background "light grey")) - (((class color) (min-colors 16)) - (:foreground "White" :background "Grey")) - (((class color)) - (:foreground "cyan3" :background "light grey" - :weight bold)) - (t (:italic t :stipple ,stipple-pixmap))) - `((((type tty)) (:foreground "cyan3" :background "light grey" - :weight bold)) - (((type pc)) (:foreground "cyan3" :background "light grey")) - (((class color)) (:foreground "White" :background "Grey")) - (t (:italic t :stipple ,stipple-pixmap)))) - "Face for highlighting even-numbered non-current differences in the ancestor buffer." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-even-diff-face-Ancestor 'ediff-even-diff-Ancestor - "Face for highlighting even-numbered non-current differences in buffer Ancestor. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-even-diff-Ancestor' -this variable represents.") -(ediff-hide-face ediff-even-diff-face-Ancestor) - -;; Association between buffer types and even-diff-face symbols -(defconst ediff-even-diff-face-alist - '((A . ediff-even-diff-A) - (B . ediff-even-diff-B) - (C . ediff-even-diff-C) - (Ancestor . ediff-even-diff-Ancestor))) - -(defface ediff-odd-diff-A - (if ediff-emacs-p - '((((type pc)) - (:foreground "green3" :background "gray40")) - (((class color) (min-colors 16)) - (:foreground "White" :background "Grey")) - (((class color)) - (:foreground "red3" :background "black" :weight bold)) - (t (:italic t :stipple "gray1"))) - '((((type tty)) (:foreground "red3" :background "black" :weight bold)) - (((type pc)) (:foreground "green3" :background "gray40")) - (((class color)) (:foreground "White" :background "Grey")) - (t (:italic t :stipple "gray1")))) - "Face for highlighting odd-numbered non-current differences in buffer A." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-odd-diff-face-A 'ediff-odd-diff-A - "Face for highlighting odd-numbered non-current differences in buffer A. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-odd-diff-A' -this variable represents.") -(ediff-hide-face ediff-odd-diff-face-A) - - -(defface ediff-odd-diff-B - (if ediff-emacs-p - '((((type pc)) - (:foreground "White" :background "gray40")) - (((class color) (min-colors 16)) - (:foreground "Black" :background "light grey")) - (((class color)) - (:foreground "cyan3" :background "black" :weight bold)) - (t (:italic t :stipple "gray1"))) - '((((type tty)) (:foreground "cyan3" :background "black" :weight bold)) - (((type pc)) (:foreground "White" :background "gray40")) - (((class color)) (:foreground "Black" :background "light grey")) - (t (:italic t :stipple "gray1")))) - "Face for highlighting odd-numbered non-current differences in buffer B." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-odd-diff-face-B 'ediff-odd-diff-B - "Face for highlighting odd-numbered non-current differences in buffer B. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-odd-diff-B' -this variable represents.") -(ediff-hide-face ediff-odd-diff-face-B) - -(defface ediff-odd-diff-C - (if ediff-emacs-p - '((((type pc)) - (:foreground "yellow3" :background "gray40")) - (((class color) (min-colors 16)) - (:foreground "White" :background "Grey")) - (((class color)) - (:foreground "yellow3" :background "black" :weight bold)) - (t (:italic t :stipple "gray1"))) - '((((type tty)) (:foreground "yellow3" :background "black" :weight bold)) - (((type pc)) (:foreground "yellow3" :background "gray40")) - (((class color)) (:foreground "White" :background "Grey")) - (t (:italic t :stipple "gray1")))) - "Face for highlighting odd-numbered non-current differences in buffer C." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-odd-diff-face-C 'ediff-odd-diff-C - "Face for highlighting odd-numbered non-current differences in buffer C. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-odd-diff-C' -this variable represents.") -(ediff-hide-face ediff-odd-diff-face-C) - -(defface ediff-odd-diff-Ancestor - (if ediff-emacs-p - '((((class color) (min-colors 16)) - (:foreground "cyan3" :background "gray40")) - (((class color)) - (:foreground "green3" :background "black" :weight bold)) - (t (:italic t :stipple "gray1"))) - '((((type tty)) (:foreground "green3" :background "black" :weight bold)) - (((class color)) (:foreground "cyan3" :background "gray40")) - (t (:italic t :stipple "gray1")))) - "Face for highlighting odd-numbered non-current differences in the ancestor buffer." - :group 'ediff-highlighting) -;; An internal variable. Ediff takes the face from here. When unhighlighting, -;; this variable is set to nil, then again to the appropriate face. -(defvar ediff-odd-diff-face-Ancestor 'ediff-odd-diff-Ancestor - "Face for highlighting odd-numbered non-current differences in buffer Ancestor. -DO NOT CHANGE this variable. Instead, use the customization -widget to customize the actual face object `ediff-odd-diff-Ancestor' -this variable represents.") -(ediff-hide-face ediff-odd-diff-face-Ancestor) - -;; Association between buffer types and odd-diff-face symbols -(defconst ediff-odd-diff-face-alist - '((A . ediff-odd-diff-A) - (B . ediff-odd-diff-B) - (C . ediff-odd-diff-C) - (Ancestor . ediff-odd-diff-Ancestor))) - -;; A-list of fine-diff face symbols associated with buffer types -(defconst ediff-fine-diff-face-alist - '((A . ediff-fine-diff-A) - (B . ediff-fine-diff-B) - (C . ediff-fine-diff-C) - (Ancestor . ediff-fine-diff-Ancestor))) - -;; Help echo -(put ediff-fine-diff-face-A 'ediff-help-echo - "A `refinement' of the current difference region") -(put ediff-fine-diff-face-B 'ediff-help-echo - "A `refinement' of the current difference region") -(put ediff-fine-diff-face-C 'ediff-help-echo - "A `refinement' of the current difference region") -(put ediff-fine-diff-face-Ancestor 'ediff-help-echo - "A `refinement' of the current difference region") - -(add-hook 'ediff-quit-hook 'ediff-cleanup-mess) -(add-hook 'ediff-suspend-hook 'ediff-default-suspend-function) - - -;;; Overlays - -(ediff-defvar-local ediff-current-diff-overlay-A nil - "Overlay for the current difference region in buffer A.") -(ediff-defvar-local ediff-current-diff-overlay-B nil - "Overlay for the current difference region in buffer B.") -(ediff-defvar-local ediff-current-diff-overlay-C nil - "Overlay for the current difference region in buffer C.") -(ediff-defvar-local ediff-current-diff-overlay-Ancestor nil - "Overlay for the current difference region in the ancestor buffer.") - -;; Compute priority of a current ediff overlay. -(defun ediff-highest-priority (start end buffer) - (let ((pos (max 1 (1- start))) - ovr-list) - (ediff-cond-compile-for-xemacs-or-emacs - (1+ ediff-shadow-overlay-priority) ; xemacs form - ;; emacs form - (ediff-with-current-buffer buffer - (while (< pos (min (point-max) (1+ end))) - (setq ovr-list (append (overlays-at pos) ovr-list)) - (setq pos (next-overlay-change pos))) - (+ 1 ediff-shadow-overlay-priority - (apply 'max - (cons - 1 - (mapcar - (lambda (ovr) - (if (and ovr - ;; exclude ediff overlays from priority - ;; calculation, or else priority will keep - ;; increasing - (null (ediff-overlay-get ovr 'ediff)) - (null (ediff-overlay-get ovr 'ediff-diff-num))) - ;; use the overlay priority or 0 - (or (ediff-overlay-get ovr 'priority) 0) - 0)) - ovr-list) - ) - ))) - ) ; ediff-cond-compile-for-xemacs-or-emacs - )) - - -(defvar ediff-toggle-read-only-function nil - "*Specifies the function to be used to toggle read-only. -If nil, Ediff tries to deduce the function from the binding of C-x C-q. -Normally, this is the `toggle-read-only' function, but, if version -control is used, it could be `vc-toggle-read-only' or `rcs-toggle-read-only'.") - -(defcustom ediff-make-buffers-readonly-at-startup nil - "*Make all variant buffers read-only when Ediff starts up. -This property can be toggled interactively." - :type 'boolean - :group 'ediff) - - -;;; Misc - -;; if nil, this silences some messages -(defconst ediff-verbose-p t) - -(defcustom ediff-autostore-merges 'group-jobs-only - "*Save the results of merge jobs automatically. -nil means don't save automatically. t means always save. Anything else -means save automatically only if the merge job is part of a group of jobs, such -as `ediff-merge-directory' or `ediff-merge-directory-revisions'." - :type '(choice (const nil) (const t) (const group-jobs-only)) - :group 'ediff-merge) -(make-variable-buffer-local 'ediff-autostore-merges) - -;; file where the result of the merge is to be saved. used internally -(ediff-defvar-local ediff-merge-store-file nil "") - -(defcustom ediff-merge-filename-prefix "merge_" - "*Prefix to be attached to saved merge buffers." - :type 'string - :group 'ediff-merge) - -(defcustom ediff-no-emacs-help-in-control-buffer nil - "*Non-nil means C-h should not invoke Emacs help in control buffer. -Instead, C-h would jump to previous difference." - :type 'boolean - :group 'ediff) - -;; This is the same as temporary-file-directory from Emacs 20.3. -;; Copied over here because XEmacs doesn't have this variable. -(defcustom ediff-temp-file-prefix - (file-name-as-directory - (cond ((boundp 'temporary-file-directory) temporary-file-directory) - ((fboundp 'temp-directory) (temp-directory)) - (t "/tmp/"))) -;;; (file-name-as-directory -;;; (cond ((memq system-type '(ms-dos windows-nt)) -;;; (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp")) -;;; ((memq system-type '(vax-vms axp-vms)) -;;; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:")) -;;; (t -;;; (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) - "*Prefix to put on Ediff temporary file names. -Do not start with `~/' or `~USERNAME/'." - :type 'string - :group 'ediff) - -(defcustom ediff-temp-file-mode 384 ; u=rw only - "*Mode for Ediff temporary files." - :type 'integer - :group 'ediff) - -;; Metacharacters that have to be protected from the shell when executing -;; a diff/diff3 command. -(defcustom ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]" - "Regexp that matches characters that must be quoted with `\\' in shell command line. -This default should work without changes." - :type 'string - :group 'ediff) - -;; needed to simulate frame-char-width in XEmacs. -(defvar ediff-H-glyph (if (featurep 'xemacs) (make-glyph "H"))) - - -;; Temporary file used for refining difference regions in buffer A. -(ediff-defvar-local ediff-temp-file-A nil "") -;; Temporary file used for refining difference regions in buffer B. -(ediff-defvar-local ediff-temp-file-B nil "") -;; Temporary file used for refining difference regions in buffer C. -(ediff-defvar-local ediff-temp-file-C nil "") - - -(defun ediff-file-remote-p (file-name) - (file-remote-p file-name)) - -;; File for which we can get attributes, such as size or date -(defun ediff-listable-file (file-name) - (let ((handler (find-file-name-handler file-name 'file-local-copy))) - (or (null handler) (eq handler 'dired-handler-fn)))) - - -(defsubst ediff-frame-unsplittable-p (frame) - (cdr (assq 'unsplittable (frame-parameters frame)))) - -(defsubst ediff-get-next-window (wind prev-wind) - (cond ((window-live-p wind) wind) - (prev-wind (next-window wind)) - (t (selected-window)) - )) - - -(defsubst ediff-kill-buffer-carefully (buf) - "Kill buffer BUF if it exists." - (if (ediff-buffer-live-p buf) - (kill-buffer (get-buffer buf)))) - -(defsubst ediff-background-face (buf-type dif-num) - ;; The value of dif-num is always 1- the one that user sees. - ;; This is why even face is used when dif-num is odd. - (ediff-get-symbol-from-alist - buf-type (if (ediff-odd-p dif-num) - ediff-even-diff-face-alist - ediff-odd-diff-face-alist) - )) - - -;; activate faces on diff regions in buffer -(defun ediff-paint-background-regions-in-one-buffer (buf-type unhighlight) - (let ((diff-vector - (eval (ediff-get-symbol-from-alist - buf-type ediff-difference-vector-alist))) - overl diff-num) - (mapcar (lambda (rec) - (setq overl (ediff-get-diff-overlay-from-diff-record rec) - diff-num (ediff-overlay-get overl 'ediff-diff-num)) - (if (ediff-overlay-buffer overl) - ;; only if overlay is alive - (ediff-set-overlay-face - overl - (if (not unhighlight) - (ediff-background-face buf-type diff-num)))) - ) - diff-vector))) - - -;; activate faces on diff regions in all buffers -(defun ediff-paint-background-regions (&optional unhighlight) - (ediff-paint-background-regions-in-one-buffer - 'A unhighlight) - (ediff-paint-background-regions-in-one-buffer - 'B unhighlight) - (ediff-paint-background-regions-in-one-buffer - 'C unhighlight) - (ediff-paint-background-regions-in-one-buffer - 'Ancestor unhighlight)) - - -;; arg is a record for a given diff in a difference vector -;; this record is itself a vector -(defsubst ediff-clear-fine-diff-vector (diff-record) - (if diff-record - (mapcar 'ediff-delete-overlay - (ediff-get-fine-diff-vector-from-diff-record diff-record)))) - -(defsubst ediff-clear-fine-differences-in-one-buffer (n buf-type) - (ediff-clear-fine-diff-vector (ediff-get-difference n buf-type)) - (ediff-set-fine-diff-vector n buf-type nil)) - -(defsubst ediff-clear-fine-differences (n) - (ediff-clear-fine-differences-in-one-buffer n 'A) - (ediff-clear-fine-differences-in-one-buffer n 'B) - (if ediff-3way-job - (ediff-clear-fine-differences-in-one-buffer n 'C))) - - -(defsubst ediff-mouse-event-p (event) - (ediff-cond-compile-for-xemacs-or-emacs - (button-event-p event) ; xemacs form - (string-match "mouse" (format "%S" (event-basic-type event))) ; emacs form - )) - - -(defsubst ediff-key-press-event-p (event) - (ediff-cond-compile-for-xemacs-or-emacs - (key-press-event-p event) ; xemacs form - (or (char-or-string-p event) (symbolp event)) ; emacs form - )) - -(defun ediff-event-point (event) - (cond ((ediff-mouse-event-p event) - (ediff-cond-compile-for-xemacs-or-emacs - (event-point event) ; xemacs form - (posn-point (event-start event)) ; emacs form - ) - ) - ((ediff-key-press-event-p event) - (point)) - (t (error nil)))) - -(defun ediff-event-buffer (event) - (cond ((ediff-mouse-event-p event) - (ediff-cond-compile-for-xemacs-or-emacs - (event-buffer event) ; xemacs form - (window-buffer (posn-window (event-start event))) ; emacs form - ) - ) - ((ediff-key-press-event-p event) - (current-buffer)) - (t (error nil)))) - -(defun ediff-event-key (event-or-key) - (ediff-cond-compile-for-xemacs-or-emacs - (if (eventp event-or-key) (event-key event-or-key) event-or-key) ; xemacs - event-or-key ; emacs form - )) - - -(defsubst ediff-frame-iconified-p (frame) - (if (and (ediff-window-display-p) (frame-live-p frame)) - (ediff-cond-compile-for-xemacs-or-emacs - (frame-iconified-p frame) ; xemacs form - (eq (frame-visible-p frame) 'icon) ; emacs form - ) - )) - -(defsubst ediff-window-visible-p (wind) - ;; under TTY, window-live-p also means window is visible - (and (window-live-p wind) - (or (not (ediff-window-display-p)) - (frame-visible-p (window-frame wind))))) - - -(defsubst ediff-frame-char-width (frame) - (ediff-cond-compile-for-xemacs-or-emacs - (/ (frame-pixel-width frame) (frame-width frame)) ; xemacs - (frame-char-width frame) ; emacs - )) - -(defun ediff-reset-mouse (&optional frame do-not-grab-mouse) - (or frame (setq frame (selected-frame))) - (if (ediff-window-display-p) - (let ((frame-or-wind frame)) - (if ediff-xemacs-p - (setq frame-or-wind (frame-selected-window frame))) - (or do-not-grab-mouse - ;; don't set mouse if the user said to never do this - (not ediff-grab-mouse) - ;; Don't grab on quit, if the user doesn't want to. - ;; If ediff-grab-mouse = t, then mouse won't be grabbed for - ;; sessions that are not part of a group (this is done in - ;; ediff-recenter). The condition below affects only terminating - ;; sessions in session groups (in which case mouse is warped into - ;; a meta buffer). - (and (eq ediff-grab-mouse 'maybe) - (memq this-command '(ediff-quit ediff-update-diffs))) - (set-mouse-position frame-or-wind 1 0)) - ))) - -(defsubst ediff-spy-after-mouse () - (setq ediff-mouse-pixel-position (mouse-pixel-position))) - -;; It is not easy to find out when the user grabs the mouse, since emacs and -;; xemacs behave differently when mouse is not in any frame. Also, this is -;; sensitive to when the user grabbed mouse. Not used for now. -(defun ediff-user-grabbed-mouse () - (if ediff-mouse-pixel-position - (cond ((not (eq (car ediff-mouse-pixel-position) - (car (mouse-pixel-position))))) - ((and (car (cdr ediff-mouse-pixel-position)) - (car (cdr (mouse-pixel-position))) - (cdr (cdr ediff-mouse-pixel-position)) - (cdr (cdr (mouse-pixel-position)))) - (not (and (< (abs (- (car (cdr ediff-mouse-pixel-position)) - (car (cdr (mouse-pixel-position))))) - ediff-mouse-pixel-threshold) - (< (abs (- (cdr (cdr ediff-mouse-pixel-position)) - (cdr (cdr (mouse-pixel-position))))) - ediff-mouse-pixel-threshold)))) - (t nil)))) - -(defsubst ediff-frame-char-height (frame) - (ediff-cond-compile-for-xemacs-or-emacs - (glyph-height ediff-H-glyph (frame-selected-window frame)) ; xemacs case - (frame-char-height frame) ; emacs case - ) - ) - -;; Some overlay functions - -(defsubst ediff-overlay-start (overl) - (if (ediff-overlayp overl) - (ediff-cond-compile-for-xemacs-or-emacs - (extent-start-position overl) ; xemacs form - (overlay-start overl) ; emacs form - ) - )) - -(defsubst ediff-overlay-end (overl) - (if (ediff-overlayp overl) - (ediff-cond-compile-for-xemacs-or-emacs - (extent-end-position overl) ; xemacs form - (overlay-end overl) ; emacs form - ) - )) - -(defsubst ediff-empty-overlay-p (overl) - (= (ediff-overlay-start overl) (ediff-overlay-end overl))) - -;; like overlay-buffer in Emacs. In XEmacs, returns nil if the extent is -;; dead. Otherwise, works like extent-buffer -(defun ediff-overlay-buffer (overl) - (ediff-cond-compile-for-xemacs-or-emacs - (and (extent-live-p overl) (extent-object overl)) ; xemacs form - (overlay-buffer overl) ; emacs form - )) - -;; like overlay-get in Emacs. In XEmacs, returns nil if the extent is -;; dead. Otherwise, like extent-property -(defun ediff-overlay-get (overl property) - (ediff-cond-compile-for-xemacs-or-emacs - (and (extent-live-p overl) (extent-property overl property)) ; xemacs form - (overlay-get overl property) ; emacs form - )) - - -;; These two functions are here because XEmacs refuses to -;; handle overlays whose buffers were deleted. -(defun ediff-move-overlay (overlay beg end &optional buffer) - "Calls `move-overlay' in Emacs and `set-extent-endpoints' in Lemacs. -Checks if overlay's buffer exists before actually doing the move." - (let ((buf (and overlay (ediff-overlay-buffer overlay)))) - (if (ediff-buffer-live-p buf) - (ediff-cond-compile-for-xemacs-or-emacs - (set-extent-endpoints overlay beg end) ; xemacs form - (move-overlay overlay beg end buffer) ; emacs form - ) - ;; buffer's dead - (if overlay - (ediff-delete-overlay overlay))))) - -(defun ediff-overlay-put (overlay prop value) - "Calls `overlay-put' or `set-extent-property' depending on Emacs version. -Checks if overlay's buffer exists." - (if (ediff-buffer-live-p (ediff-overlay-buffer overlay)) - (ediff-cond-compile-for-xemacs-or-emacs - (set-extent-property overlay prop value) ; xemacs form - (overlay-put overlay prop value) ; emacs form - ) - (ediff-delete-overlay overlay))) - -;; temporarily uses DIR to abbreviate file name -;; if DIR is nil, use default-directory -(defun ediff-abbreviate-file-name (file &optional dir) - (cond ((stringp dir) - (let ((directory-abbrev-alist (list (cons dir "")))) - (abbreviate-file-name file))) - (t - (ediff-cond-compile-for-xemacs-or-emacs - ;; XEmacs requires addl argument - (abbreviate-file-name file t) ; xemacs form - (abbreviate-file-name file)) ; emacs form - ) - )) - -;; Takes a directory and returns the parent directory. -;; does nothing to `/'. If the ARG is a regular file, -;; strip the file AND the last dir. -(defun ediff-strip-last-dir (dir) - (if (not (stringp dir)) (setq dir default-directory)) - (setq dir (expand-file-name dir)) - (or (file-directory-p dir) (setq dir (file-name-directory dir))) - (let* ((pos (1- (length dir))) - (last-char (aref dir pos))) - (if (and (> pos 0) (= last-char ?/)) - (setq dir (substring dir 0 pos))) - (ediff-abbreviate-file-name (file-name-directory dir)))) - -(defun ediff-truncate-string-left (str newlen) - ;; leave space for ... on the left - (let ((len (length str)) - substr) - (if (<= len newlen) - str - (setq newlen (max 0 (- newlen 3))) - (setq substr (substring str (max 0 (- len 1 newlen)))) - (concat "..." substr)))) - -(defsubst ediff-nonempty-string-p (string) - (and (stringp string) (not (string= string "")))) - -(unless (fboundp 'subst-char-in-string) - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "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))) - -(defun ediff-abbrev-jobname (jobname) - (cond ((eq jobname 'ediff-directories) - "Compare two directories") - ((eq jobname 'ediff-files) - "Compare two files") - ((eq jobname 'ediff-buffers) - "Compare two buffers") - ((eq jobname 'ediff-directories3) - "Compare three directories") - ((eq jobname 'ediff-files3) - "Compare three files") - ((eq jobname 'ediff-buffers3) - "Compare three buffers") - ((eq jobname 'ediff-revision) - "Compare file with a version") - ((eq jobname 'ediff-directory-revisions) - "Compare dir files with versions") - ((eq jobname 'ediff-merge-directory-revisions) - "Merge dir files with versions") - ((eq jobname 'ediff-merge-directory-revisions-with-ancestor) - "Merge dir versions via ancestors") - (t - (capitalize - (subst-char-in-string ?- ?\s (substring (symbol-name jobname) 6)))) - )) - - -;; If ediff modified mode line, strip the modification -(defsubst ediff-strip-mode-line-format () - (if (member (car mode-line-format) '(" A: " " B: " " C: " " Ancestor: ")) - (setq mode-line-format (nth 2 mode-line-format)))) - -;; Verify that we have a difference selected. -(defsubst ediff-valid-difference-p (&optional n) - (or n (setq n ediff-current-difference)) - (and (>= n 0) (< n ediff-number-of-differences))) - -(defsubst ediff-show-all-diffs (n) - "Don't skip difference regions." - nil) - -(defsubst Xor (a b) - (or (and a (not b)) (and (not a) b))) - -(defsubst ediff-message-if-verbose (string &rest args) - (if ediff-verbose-p - (apply 'message string args))) - -(defun ediff-file-attributes (filename attr-number) - (if (ediff-listable-file filename) - (nth attr-number (file-attributes filename)) - -1) - ) - -(defsubst ediff-file-size (filename) - (ediff-file-attributes filename 7)) -(defsubst ediff-file-modtime (filename) - (ediff-file-attributes filename 5)) - - -(defun ediff-convert-standard-filename (fname) - (if (fboundp 'convert-standard-filename) - (convert-standard-filename fname) - fname)) - - -(if (fboundp 'with-syntax-table) - (defalias 'ediff-with-syntax-table 'with-syntax-table) - ;; stolen from subr.el in emacs 21 - (defmacro ediff-with-syntax-table (table &rest body) - (let ((old-table (make-symbol "table")) - (old-buffer (make-symbol "buffer"))) - `(let ((,old-table (syntax-table)) - (,old-buffer (current-buffer))) - (unwind-protect - (progn - (set-syntax-table (copy-syntax-table ,table)) - ,@body) - (save-current-buffer - (set-buffer ,old-buffer) - (set-syntax-table ,old-table))))))) - - -(provide 'ediff-init) - - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; arch-tag: fa31d384-1e70-4d4b-82a7-3e96307c46f5 -;;; ediff-init.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-merg.el b/xemacs-packages/lisp/ediff/ediff-merg.el deleted file mode 100644 index 92f462c0..00000000 --- a/xemacs-packages/lisp/ediff/ediff-merg.el +++ /dev/null @@ -1,402 +0,0 @@ -;;; ediff-merg.el --- merging utilities - -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - - -;; compiler pacifier -(defvar ediff-window-A) -(defvar ediff-window-B) -(defvar ediff-window-C) -(defvar ediff-merge-window-share) -(defvar ediff-window-config-saved) - -(eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - (or (featurep 'ediff-util) - (load "ediff-util.el" nil nil 'nosuffix)) - )) -;; end pacifier - -(require 'ediff-init) - -(defcustom ediff-quit-merge-hook 'ediff-maybe-save-and-delete-merge - "*Hooks to run before quitting a merge job. -The most common use is to save and delete the merge buffer." - :type 'hook - :group 'ediff-merge) - - -(defcustom ediff-default-variant 'combined - "*The variant to be used as a default for buffer C in merging. -Valid values are the symbols `default-A', `default-B', and `combined'." - :type '(radio (const default-A) (const default-B) (const combined)) - :group 'ediff-merge) - -(defcustom ediff-combination-pattern - '("<<<<<<< variant A" A ">>>>>>> variant B" B "####### Ancestor" Ancestor "======= end") - "*Pattern to be used for combining difference regions in buffers A and B. -The value must be a list of the form -(STRING1 bufspec1 STRING2 bufspec2 STRING3 bufspec3 STRING4) -where bufspec is the symbol A, B, or Ancestor. For instance, if the value is -'(STRING1 A STRING2 Ancestor STRING3 B STRING4) then the -combined text will look like this: - -STRING1 -diff region from variant A -STRING2 -diff region from the ancestor -STRING3 -diff region from variant B -STRING4 -" - :type '(choice (list string symbol string symbol string) - (list string symbol string symbol string symbol string)) - :group 'ediff-merge) - -(defcustom ediff-show-clashes-only nil - "*If t, show only those diff regions where both buffers disagree with the ancestor. -This means that regions that have status prefer-A or prefer-B will be -skipped over. nil means show all regions." - :type 'boolean - :group 'ediff-merge - ) -(make-variable-buffer-local 'ediff-show-clashes-only) - -(defcustom ediff-skip-merge-regions-that-differ-from-default nil - "*If t, show only the regions that have not been changed by the user. -A region is considered to have been changed if it is different from the current -default (`default-A', `default-B', `combined') and it hasn't been marked as -`prefer-A' or `prefer-B'. -A region is considered to have been changed also when it is marked as -as `prefer-A', but is different from the corresponding difference region in -Buffer A or if it is marked as `prefer-B' and is different from the region in -Buffer B." - :type 'boolean - :group 'ediff-merge - ) -(make-variable-buffer-local 'ediff-skip-merge-regions-that-differ-from-default) - -;; check if there is no clash between the ancestor and one of the variants. -;; if it is not a merge job then return true -(defsubst ediff-merge-region-is-non-clash (n) - (if (ediff-merge-job) - (string-match "prefer" (or (ediff-get-state-of-merge n) "")) - t)) - -;; If ediff-show-clashes-only, check if there is no clash between the ancestor -;; and one of the variants. -(defsubst ediff-merge-region-is-non-clash-to-skip (n) - (and ediff-show-clashes-only - (ediff-merge-region-is-non-clash n))) - -;; If ediff-skip-changed-regions, check if the merge region differs from -;; the current default. If a region is different from the default, it means -;; that the user has made determination as to how to merge for this particular -;; region. -(defsubst ediff-skip-merge-region-if-changed-from-default-p (n) - (and ediff-skip-merge-regions-that-differ-from-default - (ediff-merge-changed-from-default-p n 'prefers-too))) - - -(defun ediff-get-combined-region (n) - (let ((pattern-list ediff-combination-pattern) - (combo-region "") - (err-msg - "ediff-combination-pattern: Invalid format. Please consult the documentation") - region-delim region-spec) - - (if (< (length pattern-list) 5) - (error err-msg)) - - (while (> (length pattern-list) 2) - (setq region-delim (nth 0 pattern-list) - region-spec (nth 1 pattern-list)) - (or (and (stringp region-delim) (memq region-spec '(A B Ancestor))) - (error err-msg)) - - (condition-case nil - (setq combo-region - (concat combo-region - region-delim "\n" - (ediff-get-region-contents - n region-spec ediff-control-buffer))) - (error "")) - (setq pattern-list (cdr (cdr pattern-list))) - ) - - (setq region-delim (nth 0 pattern-list)) - (or (stringp region-delim) - (error err-msg)) - (setq combo-region (concat combo-region region-delim "\n")) - )) - -;;(defsubst ediff-make-combined-diff (regA regB) -;; (concat (nth 0 ediff-combination-pattern) "\n" -;; regA -;; (nth 1 ediff-combination-pattern) "\n" -;; regB -;; (nth 2 ediff-combination-pattern) "\n")) - -(defsubst ediff-set-state-of-all-diffs-in-all-buffers (ctl-buf) - (let ((n 0)) - (while (< n ediff-number-of-differences) - (ediff-set-state-of-diff-in-all-buffers n ctl-buf) - (setq n (1+ n))))) - -(defun ediff-set-state-of-diff-in-all-buffers (n ctl-buf) - (let ((regA (ediff-get-region-contents n 'A ctl-buf)) - (regB (ediff-get-region-contents n 'B ctl-buf)) - (regC (ediff-get-region-contents n 'C ctl-buf))) - (cond ((and (string= regA regB) (string= regA regC)) - (ediff-set-state-of-diff n 'A "=diff(B)") - (ediff-set-state-of-diff n 'B "=diff(C)") - (ediff-set-state-of-diff n 'C "=diff(A)")) - ((string= regA regB) - (ediff-set-state-of-diff n 'A "=diff(B)") - (ediff-set-state-of-diff n 'B "=diff(A)") - (ediff-set-state-of-diff n 'C nil)) - ((string= regA regC) - (ediff-set-state-of-diff n 'A "=diff(C)") - (ediff-set-state-of-diff n 'C "=diff(A)") - (ediff-set-state-of-diff n 'B nil)) - ((string= regB regC) - (ediff-set-state-of-diff n 'C "=diff(B)") - (ediff-set-state-of-diff n 'B "=diff(C)") - (ediff-set-state-of-diff n 'A nil)) - ((string= regC (ediff-get-combined-region n)) - (ediff-set-state-of-diff n 'A nil) - (ediff-set-state-of-diff n 'B nil) - (ediff-set-state-of-diff n 'C "=diff(A+B)")) - (t (ediff-set-state-of-diff n 'A nil) - (ediff-set-state-of-diff n 'B nil) - (ediff-set-state-of-diff n 'C nil))) - )) - -(defun ediff-set-merge-mode () - (normal-mode t) - (remove-hook 'local-write-file-hooks 'ediff-set-merge-mode)) - - -;; Go over all diffs starting with DIFF-NUM and copy regions into buffer C -;; according to the state of the difference. -;; Since ediff-copy-diff refuses to copy identical diff regions, there is -;; no need to optimize ediff-do-merge any further. -;; -;; If re-merging, change state of merge in all diffs starting with -;; DIFF-NUM, except those where the state is prefer-* or where it is -;; `default-*' or `combined' but the buf C region appears to be modified -;; since last set by default. -(defun ediff-do-merge (diff-num &optional remerging) - (if (< diff-num 0) (setq diff-num 0)) - (let ((n diff-num) - ;;(default-state-of-merge (format "%S" ediff-default-variant)) - do-not-copy state-of-merge) - (while (< n ediff-number-of-differences) - (setq do-not-copy nil) ; reset after each cycle - (if (= (mod n 10) 0) - (message "%s buffers A & B into C ... region %d of %d" - (if remerging "Re-merging" "Merging") - n - ediff-number-of-differences)) - - (setq state-of-merge (ediff-get-state-of-merge n)) - - (if remerging - ;;(let ((reg-A (ediff-get-region-contents n 'A ediff-control-buffer)) - ;; (reg-B (ediff-get-region-contents n 'B ediff-control-buffer)) - ;; (reg-C (ediff-get-region-contents n 'C ediff-control-buffer))) - (let () - - ;; if region was edited since it was first set by default - (if (or (ediff-merge-changed-from-default-p n) - ;; was preferred - (string-match "prefer" state-of-merge)) - ;; then ignore - (setq do-not-copy t)) - - ;; change state of merge for this diff, if necessary - (if (and (string-match "\\(default\\|combined\\)" state-of-merge) - (not do-not-copy)) - (ediff-set-state-of-merge - n (format "%S" ediff-default-variant))) - )) - - ;; state-of-merge may have changed via ediff-set-state-of-merge, so - ;; check it once again - (setq state-of-merge (ediff-get-state-of-merge n)) - - (or do-not-copy - (if (string= state-of-merge "combined") - ;; use n+1 because ediff-combine-diffs works via user numbering - ;; of diffs, which is 1+ to what ediff uses internally - (ediff-combine-diffs (1+ n) 'batch) - (ediff-copy-diff - n (if (string-match "-A" state-of-merge) 'A 'B) 'C 'batch))) - (setq n (1+ n))) - (message "Merging buffers A & B into C ... Done") - )) - - -(defun ediff-re-merge () - "Remerge unmodified diff regions using a new default. Start with the current region." - (interactive) - (let* ((default-variant-alist - (list '("default-A") '("default-B") '("combined"))) - (actual-alist - (delete (list (symbol-name ediff-default-variant)) - default-variant-alist))) - (setq ediff-default-variant - (intern - (completing-read - (format "Current merge default is `%S'. New default: " - ediff-default-variant) - actual-alist nil 'must-match))) - (ediff-do-merge ediff-current-difference 'remerge) - (ediff-recenter) - )) - -(defun ediff-shrink-window-C (arg) - "Shrink window C to just one line. -With a prefix argument, returns window C to its normal size. -Used only for merging jobs." - (interactive "P") - (if (not ediff-merge-job) - (error "ediff-shrink-window-C can be used only for merging jobs")) - (cond ((eq arg '-) (setq arg -1)) - ((not (numberp arg)) (setq arg nil))) - (cond ((null arg) - (let ((ediff-merge-window-share - (if (< (window-height ediff-window-C) 3) - ediff-merge-window-share 0))) - (setq ediff-window-config-saved "") ; force redisplay - (ediff-recenter 'no-rehighlight))) - ((and (< arg 0) (> (window-height ediff-window-C) 2)) - (setq ediff-merge-window-share (* ediff-merge-window-share 0.9)) - (setq ediff-window-config-saved "") ; force redisplay - (ediff-recenter 'no-rehighlight)) - ((and (> arg 0) (> (window-height ediff-window-A) 2)) - (setq ediff-merge-window-share (* ediff-merge-window-share 1.1)) - (setq ediff-window-config-saved "") ; force redisplay - (ediff-recenter 'no-rehighlight)))) - - -;; N here is the user's region number. It is 1+ what Ediff uses internally. -(defun ediff-combine-diffs (n &optional batch-invocation) - "Combine Nth diff regions of buffers A and B and place the combination in C. -N is a prefix argument. If nil, combine the current difference regions. -Combining is done according to the specifications in variable -`ediff-combination-pattern'." - (interactive "P") - (setq n (if (numberp n) (1- n) ediff-current-difference)) - - (let (reg-combined) - ;;(setq regA (ediff-get-region-contents n 'A ediff-control-buffer) - ;; regB (ediff-get-region-contents n 'B ediff-control-buffer)) - ;;(setq reg-combined (ediff-make-combined-diff regA regB)) - (setq reg-combined (ediff-get-combined-region n)) - - (ediff-copy-diff n nil 'C batch-invocation reg-combined)) - (or batch-invocation (ediff-jump-to-difference (1+ n)))) - - -;; Checks if the region in buff C looks like a combination of the regions -;; in buffers A and B. Return a list (reg-a-beg reg-a-end reg-b-beg reg-b-end) -;; These refer to where the delimiters for region A, B, Ancestor start and end -;; in buffer C -(defun ediff-looks-like-combined-merge (region-num) - (if ediff-merge-job - (let ((combined (string-match (regexp-quote "(A+B)") - (or (ediff-get-state-of-diff region-num 'C) - ""))) - (mrgreg-beg (ediff-get-diff-posn 'C 'beg region-num)) - (mrgreg-end (ediff-get-diff-posn 'C 'end region-num)) - (pattern-list ediff-combination-pattern) - delim reg-beg reg-end delim-regs-list) - - (if combined - (ediff-with-current-buffer ediff-buffer-C - (while pattern-list - (goto-char mrgreg-beg) - (setq delim (nth 0 pattern-list)) - (search-forward delim mrgreg-end 'noerror) - (setq reg-beg (match-beginning 0)) - (setq reg-end (match-end 0)) - (if (and reg-beg reg-end) - (setq delim-regs-list - ;; in reverse - (cons reg-end (cons reg-beg delim-regs-list)))) - (if (> (length pattern-list) 1) - (setq pattern-list (cdr (cdr pattern-list))) - (setq pattern-list nil)) - ))) - - (reverse delim-regs-list) - ))) - -(eval-when-compile (defvar state-of-merge)) ; dynamic var - -;; Check if the non-preferred merge has been modified since originally set. -;; This affects only the regions that are marked as default-A/B or combined. -;; If PREFERS-TOO is non-nil, then look at the regions marked as prefers-A/B as -;; well. -(defun ediff-merge-changed-from-default-p (diff-num &optional prefers-too) - (let ((reg-A (ediff-get-region-contents diff-num 'A ediff-control-buffer)) - (reg-B (ediff-get-region-contents diff-num 'B ediff-control-buffer)) - (reg-C (ediff-get-region-contents diff-num 'C ediff-control-buffer))) - - (setq state-of-merge (ediff-get-state-of-merge diff-num)) - - ;; if region was edited since it was first set by default - (or (and (string= state-of-merge "default-A") - (not (string= reg-A reg-C))) - (and (string= state-of-merge "default-B") - (not (string= reg-B reg-C))) - (and (string= state-of-merge "combined") - ;;(not (string= (ediff-make-combined-diff reg-A reg-B) reg-C))) - (not (string= (ediff-get-combined-region diff-num) reg-C))) - (and prefers-too - (string= state-of-merge "prefer-A") - (not (string= reg-A reg-C))) - (and prefers-too - (string= state-of-merge "prefer-B") - (not (string= reg-B reg-C))) - ))) - - -(provide 'ediff-merg) - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; arch-tag: 9b798cf9-02ba-487f-a62e-b63aa823dbfb -;;; ediff-merg.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-mult.el b/xemacs-packages/lisp/ediff/ediff-mult.el deleted file mode 100644 index 0bbd3298..00000000 --- a/xemacs-packages/lisp/ediff/ediff-mult.el +++ /dev/null @@ -1,2396 +0,0 @@ -;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Users are encouraged to add functionality to this file. -;; The present file contains all the infrastructure needed for that. -;; -;; Generally, to implement a new multisession capability within Ediff, -;; you need to tell it -;; -;; 1. How to display the session group buffer. -;; This function must indicate which Ediff sessions are active (+) and -;; which are finished (-). -;; See ediff-redraw-directory-group-buffer for an example. -;; In all likelihood, ediff-redraw-directory-group-buffer can be used -;; directly or after a small modification. -;; 2. What action to take when the user clicks button 2 or types v,e, or -;; RET. See ediff-filegroup-action. -;; 3. Provide a list of pairs or triples of file names (or buffers, -;; depending on the particular Ediff operation you want to invoke) -;; in the following format: -;; (HEADER (nil nil (obj1 nil) (obj2 nil) (obj3 nil)) -;; (...) ...) -;; The function ediff-make-new-meta-list-element can be used to create -;; 2nd and subsequent elements of that list (i.e., after the -;; description header). See ediff-make-new-meta-list-element for the -;; explanation of the two nil placeholders in such elements. -;; -;; There is API for extracting the components of the members of the -;; above list. Search for `API for ediff-meta-list' for details. -;; -;; HEADER must be a list of SIX elements (nil or string): -;; (regexp metaobj1 metaobj2 metaobj3 merge-save-buffer -;; comparison-function) -;; The function ediff-redraw-registry-buffer displays the -;; 1st - 4th of these in the registry buffer. -;; For some jobs some of the members of the header might be nil. -;; The meaning of metaobj1, metaobj2, and metaobj3 depend on the job. -;; Typically these are directories where the files to be compared are -;; found. -;; Also, keep in mind that the function ediff-prepare-meta-buffer -;; (which see) prepends the session group buffer to the descriptor, so -;; the descriptor becomes 7-long. -;; Ediff expects that your function (in 2 above) will arrange to -;; replace this prepended nil (via setcar) with the actual ediff -;; control buffer associated with an appropriate Ediff session. -;; This is arranged through internal startup hooks that can be passed -;; to any of Ediff major entries (such as ediff-files, epatch, etc.). -;; See how this is done in ediff-filegroup-action. -;; -;; Session descriptions are of the form -;; (nil nil (obj1 . nil) (obj2 . nil) (obj3 . nil)) -;; which describe the objects relevant to the session. -;; Use ediff-make-new-meta-list-element to create these things. -;; Usually obj1/2/3 are names of files, but they may also be other -;; things for some jobs. For instance, obj3 is nil for jobs that -;; involve only two files. For patch jobs, obj2 and obj3 are markers -;; that specify the patch corresponding to the file -;; (whose name is obj1). -;; The nil's are placeholders, which are used internally by ediff. -;; 4. Write a function that makes a call to ediff-prepare-meta-buffer -;; passing all this info. -;; You may be able to use ediff-directories-internal as a template. -;; 5. If you intend to add several related pieces of functionality, -;; you may want to keep the function in 4 as an internal version -;; and then write several top-level interactive functions that call it -;; with different parameters. -;; See how ediff-directories, ediff-merge-directories, and -;; ediff-merge-directories-with-ancestor all use -;; ediff-directories-internal. -;; -;; A useful addition here could be session groups selected by patterns -;; (which are different in each directory). For instance, one may want to -;; compare files of the form abc{something}.c to files old{something}.d -;; which may be in the same or different directories. Or, one may want to -;; compare all files of the form {something} to files of the form {something}~. -;; -;; Implementing this requires writing a collating function, which should pair -;; up appropriate files. It will also require a generalization of the -;; functions that do the layout of the meta- and differences buffers and of -;; ediff-filegroup-action. - -;;; Code: - - -(defgroup ediff-mult nil - "Multi-file and multi-buffer processing in Ediff." - :prefix "ediff-" - :group 'ediff) - - -;; compiler pacifier -(eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - (or (featurep 'ediff-util) - (load "ediff-util.el" nil nil 'nosuffix)) - )) -;; end pacifier - -(require 'ediff-init) - -;; meta-buffer -(ediff-defvar-local ediff-meta-buffer nil "") -(ediff-defvar-local ediff-parent-meta-buffer nil "") -;; the registry buffer -(defvar ediff-registry-buffer nil) - -(defconst ediff-meta-buffer-message "This is an Ediff Session Group Panel: %s - -Useful commands: - button2, v, or RET over session record: start that Ediff session - M:\tin sessions invoked from here, brings back this group panel - R:\tdisplay the registry of active Ediff sessions - h:\tmark session for hiding (toggle) - x:\thide marked sessions; with prefix arg: unhide - m:\tmark session for a non-hiding operation (toggle) - uh/um:\tunmark all sessions marked for hiding/operation - n,SPC:\tnext session - p,DEL:\tprevious session - E:\tbrowse Ediff on-line manual - T:\ttoggle truncation of long file names - q:\tquit this session group -") - -(ediff-defvar-local ediff-meta-buffer-map nil - "The keymap for the meta buffer.") -(defvar ediff-dir-diffs-buffer-map (make-sparse-keymap) - "The keymap to be installed in the buffer showing differences between -directories.") - -;; Variable specifying the action to take when the use invokes ediff in the -;; meta buffer. This is usually ediff-registry-action or ediff-filegroup-action -(ediff-defvar-local ediff-meta-action-function nil "") -;; Tells ediff-update-meta-buffer how to redraw it -(ediff-defvar-local ediff-meta-redraw-function nil "") -;; Tells ediff-filegroup-action and similar procedures how to invoke Ediff for -;; the sessions in a given session group -(ediff-defvar-local ediff-session-action-function nil "") - -(ediff-defvar-local ediff-metajob-name nil "") - -;; buffer used to collect custom diffs from individual sessions in the group -(ediff-defvar-local ediff-meta-diff-buffer nil "") - -;; t means recurse into subdirs when deciding which files have same contents -(ediff-defvar-local ediff-recurse-to-subdirectories nil "") - -;; history var to use for filtering groups of files -(defvar ediff-filtering-regexp-history nil "") - -(defcustom ediff-default-filtering-regexp nil - "The default regular expression used as a filename filter in multifile comparisons. -Should be a sexp. For instance (car ediff-filtering-regexp-history) or nil." - :type 'sexp - :group 'ediff-mult) - -;; This has the form ((meta-buf regexp dir1 dir2 dir3 merge-auto-store-dir) -;; (ctl-buf session-status (file1 . eq-status) (file2 . eq-status) (file3 -;; . eq-status)) (ctl-buf session-status (file1 . eq-status) (file2 -;; . eq-status)) ...) -;; If ctl-buf is nil, the file-pair hasn't processed yet. If it is -;; killed-buffer object, the file pair has been processed. If it is a live -;; buffer, this means ediff is still working on the pair. -;; Eq-status of a file is t if the file equals some other file in the same -;; group. -(ediff-defvar-local ediff-meta-list nil "") - -(ediff-defvar-local ediff-meta-session-number nil "") - - -;; the difference list between directories in a directory session group -(ediff-defvar-local ediff-dir-difference-list nil "") -(ediff-defvar-local ediff-dir-diffs-buffer nil "") - -;; The registry of Ediff sessions. A list of control buffers. -(defvar ediff-session-registry nil) - -(defcustom ediff-meta-truncate-filenames t - "*If non-nil, truncate long file names in the session group buffers. -This can be toggled with `ediff-toggle-filename-truncation'." - :type 'boolean - :group 'ediff-mult) - -(defcustom ediff-meta-mode-hook nil - "*Hooks run just after setting up meta mode." - :type 'hook - :group 'ediff-mult) - -(defcustom ediff-registry-setup-hook nil - "*Hooks run just after the registry control panel is set up." - :type 'hook - :group 'ediff-mult) - -(defcustom ediff-before-session-group-setup-hooks nil - "*Hooks to run before Ediff arranges the window for group-level operations. -It is used by commands such as `ediff-directories'. -This hook can be used to save the previous window config, which can be restored -on `ediff-quit', `ediff-suspend', or `ediff-quit-session-group-hook'." - :type 'hook - :group 'ediff-hook) -(defcustom ediff-after-session-group-setup-hook nil - "*Hooks run just after a meta-buffer controlling a session group, such as -ediff-directories, is run." - :type 'hook - :group 'ediff-mult) -(defcustom ediff-quit-session-group-hook nil - "*Hooks run just before exiting a session group." - :type 'hook - :group 'ediff-mult) -(defcustom ediff-show-registry-hook nil - "*Hooks run just after the registry buffer is shown." - :type 'hook - :group 'ediff-mult) -(defcustom ediff-show-session-group-hook '(delete-other-windows) - "*Hooks run just after a session group buffer is shown." - :type 'hook - :group 'ediff-mult) -(defcustom ediff-meta-buffer-keymap-setup-hook nil - "*Hooks run just after setting up the `ediff-meta-buffer-map'. -This keymap controls key bindings in the meta buffer and is a local variable. -This means that you can set different bindings for different kinds of meta -buffers." - :type 'hook - :group 'ediff-mult) - -;; Buffer holding the multi-file patch. Local to the meta buffer -(ediff-defvar-local ediff-meta-patchbufer nil "") - -;;; API for ediff-meta-list - -;; A meta-list is either ediff-meta-list, which contains a header and the list -;; of ediff sessions or ediff-dir-difference-list, which is a header followed -;; by the list of differences among the directories (i.e., files that are not -;; in all directories). The header is the same in all meta lists, but the rest -;; is different. -;; Structure of the meta-list: -;; (HEADER SESSION1 SESSION2 ...) -;; HEADER: (GROUP-BUF REGEXP OBJA OBJB OBJC SAVE-DIR COMPARISON-FUNC) -;; OBJA - first directory -;; OBJB - second directory -;; OBJC - third directory -;; SESSION1/2/... are described below -;; group buffer/regexp -(defsubst ediff-get-group-buffer (meta-list) - (nth 0 (car meta-list))) - -(defsubst ediff-get-group-regexp (meta-list) - (nth 1 (car meta-list))) -;; group objects -(defsubst ediff-get-group-objA (meta-list) - (nth 2 (car meta-list))) -(defsubst ediff-get-group-objB (meta-list) - (nth 3 (car meta-list))) -(defsubst ediff-get-group-objC (meta-list) - (nth 4 (car meta-list))) -(defsubst ediff-get-group-merge-autostore-dir (meta-list) - (nth 5 (car meta-list))) -(defsubst ediff-get-group-comparison-func (meta-list) - (nth 6 (car meta-list))) - -;; ELT is a session meta descriptor (what is being preserved as -;; 'ediff-meta-info) -;; The structure is: (SESSION-CTL-BUFFER STATUS OBJA OBJB OBJC) -;; STATUS is ?I (hidden or invalid), ?* (marked for operation), ?H (hidden) -;; nil (nothing) -;; OBJA/B/C is (FILENAME EQSTATUS) -;; EQSTATUS is ?= or nil (?= means that this file is equal to some other -;; file in this session) -;; session buffer -(defsubst ediff-get-session-buffer (elt) - (nth 0 elt)) -(defsubst ediff-get-session-status (elt) - (nth 1 elt)) -(defsubst ediff-set-session-status (session-info new-status) - (setcar (cdr session-info) new-status)) -;; session objects -(defsubst ediff-get-session-objA (elt) - (nth 2 elt)) -(defsubst ediff-get-session-objB (elt) - (nth 3 elt)) -(defsubst ediff-get-session-objC (elt) - (nth 4 elt)) -;; Take the "name" component of the object into acount. ObjA/C/B is of the form -;; (name . equality-indicator) -(defsubst ediff-get-session-objA-name (elt) - (car (nth 2 elt))) -(defsubst ediff-get-session-objB-name (elt) - (car (nth 3 elt))) -(defsubst ediff-get-session-objC-name (elt) - (car (nth 4 elt))) -;; equality indicators -(defsubst ediff-get-file-eqstatus (elt) - (nth 1 elt)) -(defsubst ediff-set-file-eqstatus (elt value) - (setcar (cdr elt) value)) - -;; Create a new element for the meta list out of obj1/2/3, which usually are -;; files -;; -;; The first nil in such an element is later replaced with the session buffer. -;; The second nil is reserved for session status. -;; -;; Also, session objects A/B/C are turned into lists of the form (obj nil). -;; This nil is a placeholder for eq-indicator. It is either nil or =. -;; If it is discovered that this file is = to some other -;; file in the same session, eq-indicator is changed to `='. -;; Curently, the eq-indicator is used only for 2 and 3-file jobs. -(defun ediff-make-new-meta-list-element (obj1 obj2 obj3) - (list nil nil (list obj1 nil) (list obj2 nil) (list obj3 nil))) - -;; Constructs a meta list header. -;; OBJA, OBJB, OBJC are usually directories involved, but can be different for -;; different jobs. For instance, multifile patch has only OBJA, which is the -;; patch buffer. -(defun ediff-make-new-meta-list-header (regexp - objA objB objC - merge-auto-store-dir - comparison-func) - (list regexp objA objB objC merge-auto-store-dir comparison-func)) - -;; The activity marker is either or + (active session, i.e., ediff is currently -;; run in it), or - (finished session, i.e., we've ran ediff in it and then -;; exited). Return nil, if session is neither active nor finished -(defun ediff-get-session-activity-marker (session) - (let ((session-buf (ediff-get-session-buffer session))) - (cond ((null session-buf) nil) ; virgin session - ((ediff-buffer-live-p session-buf) ?+) ;active session - (t ?-)))) - -;; checks if the session is a meta session -(defun ediff-meta-session-p (session-info) - (and (stringp (ediff-get-session-objA-name session-info)) - (file-directory-p (ediff-get-session-objA-name session-info)) - (stringp (ediff-get-session-objB-name session-info)) - (file-directory-p (ediff-get-session-objB-name session-info)) - (if (stringp (ediff-get-session-objC-name session-info)) - (file-directory-p (ediff-get-session-objC-name session-info)) t))) - -;; set up the keymap in the meta buffer -(defun ediff-setup-meta-map () - (setq ediff-meta-buffer-map (make-sparse-keymap)) - (suppress-keymap ediff-meta-buffer-map) - (define-key ediff-meta-buffer-map "q" 'ediff-quit-meta-buffer) - (define-key ediff-meta-buffer-map "T" 'ediff-toggle-filename-truncation) - (define-key ediff-meta-buffer-map "R" 'ediff-show-registry) - (define-key ediff-meta-buffer-map "E" 'ediff-documentation) - (define-key ediff-meta-buffer-map "v" ediff-meta-action-function) - (define-key ediff-meta-buffer-map "\C-m" ediff-meta-action-function) - (define-key ediff-meta-buffer-map " " 'ediff-next-meta-item) - (define-key ediff-meta-buffer-map "n" 'ediff-next-meta-item) - (define-key ediff-meta-buffer-map "\C-?" 'ediff-previous-meta-item) - (define-key ediff-meta-buffer-map "p" 'ediff-previous-meta-item) - (define-key ediff-meta-buffer-map [delete] 'ediff-previous-meta-item) - (define-key ediff-meta-buffer-map [backspace] 'ediff-previous-meta-item) - (or (ediff-one-filegroup-metajob) - (progn - (define-key ediff-meta-buffer-map "=" nil) - (define-key ediff-meta-buffer-map "==" 'ediff-meta-mark-equal-files) - (define-key ediff-meta-buffer-map "=m" 'ediff-meta-mark-equal-files) - (define-key ediff-meta-buffer-map "=h" 'ediff-meta-mark-equal-files))) - (if ediff-no-emacs-help-in-control-buffer - (define-key ediff-meta-buffer-map "\C-h" 'ediff-previous-meta-item)) - (if ediff-emacs-p - (define-key ediff-meta-buffer-map [mouse-2] ediff-meta-action-function) - (define-key ediff-meta-buffer-map [button2] ediff-meta-action-function)) - - (use-local-map ediff-meta-buffer-map) - ;; modify ediff-meta-buffer-map here - (run-hooks 'ediff-meta-buffer-keymap-setup-hook)) - - -(defun ediff-meta-mode () - "This mode controls all operations on Ediff session groups. -It is entered through one of the following commands: - `ediff-directories' - `edirs' - `ediff-directories3' - `edirs3' - `ediff-merge-directories' - `edirs-merge' - `ediff-merge-directories-with-ancestor' - `edirs-merge-with-ancestor' - `ediff-directory-revisions' - `edir-revisions' - `ediff-merge-directory-revisions' - `edir-merge-revisions' - `ediff-merge-directory-revisions-with-ancestor' - `edir-merge-revisions-with-ancestor' - -Commands: -\\{ediff-meta-buffer-map}" - (kill-all-local-variables) - (setq major-mode 'ediff-meta-mode) - (setq mode-name "MetaEdiff") - ;; don't use run-mode-hooks here! - (run-hooks 'ediff-meta-mode-hook)) - - -;; the keymap for the buffer showing directory differences -(suppress-keymap ediff-dir-diffs-buffer-map) -(define-key ediff-dir-diffs-buffer-map "q" 'ediff-bury-dir-diffs-buffer) -(define-key ediff-dir-diffs-buffer-map " " 'next-line) -(define-key ediff-dir-diffs-buffer-map "n" 'next-line) -(define-key ediff-dir-diffs-buffer-map "\C-?" 'previous-line) -(define-key ediff-dir-diffs-buffer-map "p" 'previous-line) -(define-key ediff-dir-diffs-buffer-map "C" 'ediff-dir-diff-copy-file) -(if ediff-emacs-p - (define-key ediff-dir-diffs-buffer-map [mouse-2] 'ediff-dir-diff-copy-file) - (define-key ediff-dir-diffs-buffer-map [button2] 'ediff-dir-diff-copy-file)) -(define-key ediff-dir-diffs-buffer-map [delete] 'previous-line) -(define-key ediff-dir-diffs-buffer-map [backspace] 'previous-line) - -(defun ediff-next-meta-item (count) - "Move to the next item in Ediff registry or session group buffer. -Moves in circular fashion. With numeric prefix arg, skip this many items." - (interactive "p") - (or count (setq count 1)) - (let (overl) - (while (< 0 count) - (setq count (1- count)) - (ediff-next-meta-item1) - (setq overl (ediff-get-meta-overlay-at-pos (point))) - ;; skip invisible ones - (while (and overl (ediff-overlay-get overl 'invisible)) - (ediff-next-meta-item1) - (setq overl (ediff-get-meta-overlay-at-pos (point))))))) - -;; Move to the next meta item -(defun ediff-next-meta-item1 () - (let (pos) - (setq pos (ediff-next-meta-overlay-start (point))) - (if pos (goto-char pos)) - (if (eq ediff-metajob-name 'ediff-registry) - (if (and (ediff-get-meta-info (current-buffer) pos 'noerror) - (search-forward "*Ediff" nil t)) - (skip-chars-backward "a-zA-Z*")) - (if (> (skip-chars-forward "-+?H* \t0-9") 0) - (backward-char 1))))) - - -(defun ediff-previous-meta-item (count) - "Move to the previous item in Ediff registry or session group buffer. -Moves in circular fashion. With numeric prefix arg, skip this many items." - (interactive "p") - (or count (setq count 1)) - (let (overl) - (while (< 0 count) - (setq count (1- count)) - (ediff-previous-meta-item1) - (setq overl (ediff-get-meta-overlay-at-pos (point))) - ;; skip invisible ones - (while (and overl (ediff-overlay-get overl 'invisible)) - (ediff-previous-meta-item1) - (setq overl (ediff-get-meta-overlay-at-pos (point))))))) - -(defun ediff-previous-meta-item1 () - (let (pos) - (setq pos (ediff-previous-meta-overlay-start (point))) -;;; ;; skip deleted -;;; (while (ediff-get-session-status -;;; (ediff-get-meta-info (current-buffer) pos 'noerror)) -;;; (setq pos (ediff-previous-meta-overlay-start pos))) - - (if pos (goto-char pos)) - (if (eq ediff-metajob-name 'ediff-registry) - (if (and (ediff-get-meta-info (current-buffer) pos 'noerror) - (search-forward "*Ediff" nil t)) - (skip-chars-backward "a-zA-Z*")) - (if (> (skip-chars-forward "-+?H* \t0-9") 0) - (backward-char 1))) - )) - -(defsubst ediff-add-slash-if-directory (dir file) - (if (file-directory-p (concat dir file)) - (file-name-as-directory file) - file)) - -(defun ediff-toggle-filename-truncation () - "Toggle truncation of long file names in session group buffers. -Set `ediff-meta-truncate-filenames' variable if you want to change the default -behavior." - (interactive) - (setq ediff-meta-truncate-filenames (not ediff-meta-truncate-filenames)) - (ediff-update-meta-buffer (current-buffer) 'must-redraw)) - - -;; These are used to encode membership of files in directory1/2/3 -;; Membership code of a file is a product of codes for the directories where -;; this file is in -(defvar ediff-membership-code1 2) -(defvar ediff-membership-code2 3) -(defvar ediff-membership-code3 5) -(defvar ediff-product-of-memcodes (* ediff-membership-code1 - ediff-membership-code2 - ediff-membership-code3)) - -;; DIR1, DIR2, DIR3 are directories. DIR3 can be nil. -;; OUTPUT-DIR is a directory for auto-storing the results of merge jobs. -;; Can be nil. -;; REGEXP is nil or a filter regexp; only file names that match the regexp -;; are considered. -;; If a file is a directory in dir1 but not dir2 (or vice versa), it is not -;; included in the intersection. However, a regular file that is a dir in dir3 -;; is included, since dir3 files are supposed to be ancestors for merging. -;; If COMPARISON-FUNC is given, use it. Otherwise, use string= -;; -;; Returns a list of the form: -;; (COMMON-PART DIFF-LIST) -;; COMMON-PART is car and DIFF-LIST is cdr. -;; -;; COMMON-PART is of the form: -;; (META-HEADER (f1 f2 f3) (f1 f2 f3) ...) -;; f3 can be nil if intersecting only 2 directories. -;; Each triple (f1 f2 f3) represents the files to be compared in the -;; corresponding ediff subsession. -;; -;; DIFF-LIST is of the form: -;; (META-HEADER (file . num) (file . num)...) -;; where num encodes the set of dirs where the file is found: -;; 2 - only dir1; 3 - only dir2; 5 - only dir3; 6 - dir1&2; 10 - dir1&3; etc. -;; META-HEADER: -;; Contains the meta info about this ediff operation -;; (regexp dir1 dir2 dir3 merge-auto-store-dir comparison-func) -;; Later the meta-buffer is prepended to this list. -;; -;; Some operations might use a different meta header. For instance, -;; ediff-multifile-patch doesn't have dir2 and dir3, and regexp, -;; comparison-func don't apply. -;; -(defun ediff-intersect-directories (jobname - regexp dir1 dir2 - &optional - dir3 merge-autostore-dir comparison-func) - (setq comparison-func (or comparison-func 'string=)) - (let (lis1 lis2 lis3 common auxdir1 auxdir2 auxdir3 common-part difflist) - - (setq auxdir1 (file-name-as-directory dir1) - lis1 (directory-files auxdir1 nil regexp) - lis1 (delete "." lis1) - lis1 (delete ".." lis1) - lis1 (mapcar - (lambda (elt) - (ediff-add-slash-if-directory auxdir1 elt)) - lis1) - auxdir2 (file-name-as-directory dir2) - lis2 (directory-files auxdir2 nil regexp) - lis2 (delete "." lis2) - lis2 (delete ".." lis2) - lis2 (mapcar - (lambda (elt) - (ediff-add-slash-if-directory auxdir2 elt)) - lis2)) - - (if (stringp dir3) - (setq auxdir3 (file-name-as-directory dir3) - lis3 (directory-files auxdir3 nil regexp) - lis3 (delete "." lis3) - lis3 (delete ".." lis3) - lis3 (mapcar - (lambda (elt) - (ediff-add-slash-if-directory auxdir3 elt)) - lis3))) - - (if (ediff-nonempty-string-p merge-autostore-dir) - (setq merge-autostore-dir - (file-name-as-directory merge-autostore-dir))) - (setq common (ediff-intersection lis1 lis2 comparison-func)) - - ;; In merge with ancestor jobs, we don't intersect with lis3. - ;; If there is no ancestor, we'll offer to merge without the ancestor. - ;; So, we intersect with lis3 only when we are doing 3-way file comparison - (if (and lis3 (ediff-comparison-metajob3 jobname)) - (setq common (ediff-intersection common lis3 comparison-func))) - - ;; copying is needed because sort sorts via side effects - (setq common (sort (ediff-copy-list common) 'string-lessp)) - - ;; compute difference list - (setq difflist (ediff-set-difference - (ediff-union (ediff-union lis1 lis2 comparison-func) - lis3 - comparison-func) - common - comparison-func) - difflist (delete "." difflist) - ;; copying is needed because sort sorts via side effects - difflist (sort (ediff-copy-list (delete ".." difflist)) - 'string-lessp)) - - (setq difflist (mapcar (lambda (elt) (cons elt 1)) difflist)) - - ;; check for files belonging to lis1/2/3 - ;; Each elt is of the norm (file . number) - ;; Number encodes the directories to which file belongs. - ;; It is a product of a subset of ediff-membership-code1=2, - ;; ediff-membership-code2=3, and ediff-membership-code3=5. - ;; If file belongs to dir 1 only, the membership code is 2. - ;; If it is in dir1 and dir3, then the membership code is 2*5=10; - ;; if it is in dir1 and dir2, then the membership code is 2*3=6, etc. - (mapcar (lambda (elt) - (if (member (car elt) lis1) - (setcdr elt (* (cdr elt) ediff-membership-code1))) - (if (member (car elt) lis2) - (setcdr elt (* (cdr elt) ediff-membership-code2))) - (if (member (car elt) lis3) - (setcdr elt (* (cdr elt) ediff-membership-code3))) - ) - difflist) - (setq difflist (cons - ;; diff metalist header - (ediff-make-new-meta-list-header regexp - auxdir1 auxdir2 auxdir3 - merge-autostore-dir - comparison-func) - difflist)) - - (setq common-part - (cons - ;; metalist header - (ediff-make-new-meta-list-header regexp - auxdir1 auxdir2 auxdir3 - merge-autostore-dir - comparison-func) - (mapcar - (lambda (elt) - (ediff-make-new-meta-list-element - (concat auxdir1 elt) - (concat auxdir2 elt) - (if lis3 - (progn - ;; The following is done because: In merging with - ;; ancestor, we don't intersect with lis3. So, it is - ;; possible that elt is a file in auxdir1/2 but a - ;; directory in auxdir3 Or elt may not exist in auxdir3 at - ;; all. In the first case, we add a slash at the end. In - ;; the second case, we insert nil. - (setq elt (ediff-add-slash-if-directory auxdir3 elt)) - (if (file-exists-p (concat auxdir3 elt)) - (concat auxdir3 elt)))))) - common))) - ;; return result - (cons common-part difflist) - )) - -;; find directory files that are under revision. Include subdirectories, since -;; we may visit them recursively. DIR1 is the directory to inspect. -;; MERGE-AUTOSTORE-DIR is the directory where to auto-store the results of -;; merges. Can be nil. -(defun ediff-get-directory-files-under-revision (jobname - regexp dir1 - &optional merge-autostore-dir) - (let (lis1 elt common auxdir1) - (setq auxdir1 (file-name-as-directory dir1) - lis1 (directory-files auxdir1 nil regexp)) - - (if (ediff-nonempty-string-p merge-autostore-dir) - (setq merge-autostore-dir - (file-name-as-directory merge-autostore-dir))) - - (while lis1 - (setq elt (car lis1) - lis1 (cdr lis1)) - ;; take files under revision control - (cond ((file-directory-p (concat auxdir1 elt)) - (setq common - (cons (ediff-add-slash-if-directory auxdir1 elt) common))) - ((and (featurep 'vc-hooks) (vc-backend (concat auxdir1 elt))) - (setq common (cons elt common))) - ;; The following two are needed only if vc-hooks isn't loaded. - ;; They won't recognize CVS files. - ((file-exists-p (concat auxdir1 elt ",v")) - (setq common (cons elt common))) - ((file-exists-p (concat auxdir1 "RCS/" elt ",v")) - (setq common (cons elt common))) - ) ; cond - ) ; while - - (setq common (delete "./" common) - common (delete "../" common) - common (delete "RCS" common) - common (delete "CVS" common) - ) - - ;; copying is needed because sort sorts via side effects - (setq common (sort (ediff-copy-list common) 'string-lessp)) - - ;; return result - (cons - ;; header -- has 6 elements. Meta buffer is prepended later by - ;; ediff-prepare-meta-buffer - (ediff-make-new-meta-list-header regexp - auxdir1 nil nil - merge-autostore-dir nil) - (mapcar (lambda (elt) (ediff-make-new-meta-list-element - (concat auxdir1 elt) nil nil)) - common)) - )) - - -;; If file groups selected by patterns will ever be implemented, this -;; comparison function might become useful. -;;;; uses external variables PAT1 PAT2 to compare str1/2 -;;;; patterns must be of the form ???*???? where ??? are strings of chars -;;;; containing no *. -;;(defun ediff-pattern= (str1 str2) -;; (let (pos11 pos12 pos21 pos22 len1 len2) -;; (setq pos11 0 -;; len (length epat1) -;; pos12 len) -;; (while (and (< pos11 len) (not (= (aref epat1 pos11) ?*))) -;; (setq pos11 (1+ pos11))) -;; (while (and (> pos12 0) (not (= (aref epat1 (1- pos12)) ?*))) -;; (setq pos12 (1- pos12))) -;; -;; (setq pos21 0 -;; len (length epat2) -;; pos22 len) -;; (while (and (< pos21 len) (not (= (aref epat2 pos21) ?*))) -;; (setq pos21 (1+ pos21))) -;; (while (and (> pos22 0) (not (= (aref epat2 (1- pos22)) ?*))) -;; (setq pos22 (1- pos22))) -;; -;; (if (and (> (length str1) pos12) (>= pos12 pos11) (> pos11 -1) -;; (> (length str2) pos22) (>= pos22 pos21) (> pos21 -1)) -;; (string= (substring str1 pos11 pos12) -;; (substring str2 pos21 pos22))) -;; )) - - -;; Prepare meta-buffer in accordance with the argument-function and -;; redraw-function. Must return the created meta-buffer. -(defun ediff-prepare-meta-buffer (action-func meta-list - meta-buffer-name redraw-function - jobname &optional startup-hooks) - (let* ((meta-buffer-name - (ediff-unique-buffer-name meta-buffer-name "*")) - (meta-buffer (get-buffer-create meta-buffer-name))) - (ediff-with-current-buffer meta-buffer - - ;; comes first - (ediff-meta-mode) - - (setq ediff-meta-action-function action-func - ediff-meta-redraw-function redraw-function - ediff-metajob-name jobname - ediff-meta-buffer meta-buffer) - - ;; comes after ediff-meta-action-function is set - (ediff-setup-meta-map) - - (if (eq ediff-metajob-name 'ediff-registry) - (progn - (setq ediff-registry-buffer meta-buffer - ediff-meta-list meta-list) - ;; this func is used only from registry buffer, not from other - ;; meta-buffs. - (define-key - ediff-meta-buffer-map "M" 'ediff-show-meta-buff-from-registry)) - ;; Initialize the meta list -- we don't do this for registry. - (setq ediff-meta-list - ;; add meta-buffer to the list header - (cons (cons meta-buffer (car meta-list)) - (cdr meta-list)))) - - (or (eq meta-buffer ediff-registry-buffer) - (setq ediff-session-registry - (cons meta-buffer ediff-session-registry))) - - ;; redraw-function uses ediff-meta-list - (funcall redraw-function ediff-meta-list) - - ;; set read-only/non-modified - (setq buffer-read-only t) - (set-buffer-modified-p nil) - - (run-hooks 'startup-hooks) - - ;; Arrange to show directory contents differences - ;; Must be after run startup-hooks, since ediff-dir-difference-list is - ;; set inside these hooks - (if (eq action-func 'ediff-filegroup-action) - (progn - ;; put meta buffer in (car ediff-dir-difference-list) - (setq ediff-dir-difference-list - (cons (cons meta-buffer (car ediff-dir-difference-list)) - (cdr ediff-dir-difference-list))) - - (or (ediff-one-filegroup-metajob jobname) - (ediff-draw-dir-diffs ediff-dir-difference-list)) - (define-key - ediff-meta-buffer-map "h" 'ediff-mark-for-hiding-at-pos) - (define-key ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions) - (define-key - ediff-meta-buffer-map "m" 'ediff-mark-for-operation-at-pos) - (define-key ediff-meta-buffer-map "u" nil) - (define-key - ediff-meta-buffer-map "um" 'ediff-unmark-all-for-operation) - (define-key - ediff-meta-buffer-map "uh" 'ediff-unmark-all-for-hiding) - (cond ((ediff-collect-diffs-metajob jobname) - (define-key - ediff-meta-buffer-map "P" 'ediff-collect-custom-diffs)) - ((ediff-patch-metajob jobname) - (define-key - ediff-meta-buffer-map "P" 'ediff-meta-show-patch))) - (define-key ediff-meta-buffer-map "^" 'ediff-up-meta-hierarchy) - (define-key ediff-meta-buffer-map "D" 'ediff-show-dir-diffs))) - - (if (eq ediff-metajob-name 'ediff-registry) - (run-hooks 'ediff-registry-setup-hook) - (run-hooks 'ediff-after-session-group-setup-hook)) - ) ; eval in meta-buffer - meta-buffer)) - -;; Insert the activity marker for session SESSION in the meta buffer at point -;; The activity marker is either SPC (untouched session), or + (active session, -;; i.e., ediff is currently run in it), or - (finished session, i.e., we've ran -;; ediff in it and then exited) -(defun ediff-insert-session-activity-marker-in-meta-buffer (session) - (insert - (cond ((ediff-get-session-activity-marker session)) - ;; virgin session - (t " ")))) - -;; Insert session status at point. Status is either ?H (marked for hiding), or -;; ?I (hidden or invalid), or ?* (meaning marked for an operation; currently, -;; such op can only be checking for equality)), or SPC (meaning neither marked -;; nor invalid) -(defun ediff-insert-session-status-in-meta-buffer (session) - (insert - (cond ((ediff-get-session-status session)) ; session has status: ?H, ?I, ?* - ;; normal session, no marks or hidings - (t " ")))) - -;; If NEW-MARKER is non-nil, use it to substitute the current activity marker -;; in the meta buffer. If nil, use SPC -(defun ediff-replace-session-activity-marker-in-meta-buffer (point new-marker) - (let* ((overl (ediff-get-meta-overlay-at-pos point)) - (session-info (ediff-overlay-get overl 'ediff-meta-info)) - (activity-marker (ediff-get-session-activity-marker session-info)) - buffer-read-only) - (or new-marker activity-marker (setq new-marker ?\s)) - (goto-char (ediff-overlay-start overl)) - (if (eq (char-after (point)) new-marker) - () ; if marker shown in buffer is the same as new-marker, do nothing - (insert new-marker) - (delete-char 1) - (set-buffer-modified-p nil)))) - -;; If NEW-STATUS is non-nil, use it to substitute the current status marker in -;; the meta buffer. If nil, use SPC -(defun ediff-replace-session-status-in-meta-buffer (point new-status) - (let* ((overl (ediff-get-meta-overlay-at-pos point)) - (session-info (ediff-overlay-get overl 'ediff-meta-info)) - (status (ediff-get-session-status session-info)) - buffer-read-only) - (setq new-status (or new-status status ?\s)) - (goto-char (ediff-overlay-start overl)) - (forward-char 1) ; status is the second char in session record - (if (eq (char-after (point)) new-status) - () ; if marker shown in buffer is the same as new-marker, do nothing - (insert new-status) - (delete-char 1) - (set-buffer-modified-p nil)))) - -;; insert all file info in meta buffer for a given session -(defun ediff-insert-session-info-in-meta-buffer (session-info sessionNum) - (let ((f1 (ediff-get-session-objA session-info)) - (f2 (ediff-get-session-objB session-info)) - (f3 (ediff-get-session-objC session-info)) - (pt (point)) - (hidden (eq (ediff-get-session-status session-info) ?I))) - ;; insert activity marker, i.e., SPC, - or + - (ediff-insert-session-activity-marker-in-meta-buffer session-info) - ;; insert session status, i.e., *, H - (ediff-insert-session-status-in-meta-buffer session-info) - (insert " Session " (int-to-string sessionNum) ":\n") - (ediff-meta-insert-file-info1 f1) - (ediff-meta-insert-file-info1 f2) - (ediff-meta-insert-file-info1 f3) - (ediff-set-meta-overlay pt (point) session-info sessionNum hidden))) - - -;; this is a setup function for ediff-directories -;; must return meta-buffer -(defun ediff-redraw-directory-group-buffer (meta-list) - ;; extract directories - (let ((meta-buf (ediff-get-group-buffer meta-list)) - (empty t) - (sessionNum 0) - regexp elt merge-autostore-dir - point tmp-list buffer-read-only) - (ediff-with-current-buffer meta-buf - (setq point (point)) - (erase-buffer) - ;; delete phony overlays that used to represent sessions before the buff - ;; was redrawn - (ediff-cond-compile-for-xemacs-or-emacs - (map-extents 'delete-extent) ; xemacs - (mapcar 'delete-overlay (overlays-in 1 1)) ; emacs - ) - - (insert (format ediff-meta-buffer-message - (ediff-abbrev-jobname ediff-metajob-name))) - - (setq regexp (ediff-get-group-regexp meta-list) - merge-autostore-dir - (ediff-get-group-merge-autostore-dir meta-list)) - - (cond ((ediff-collect-diffs-metajob) - (insert - " P:\tcollect custom diffs of all marked sessions\n")) - ((ediff-patch-metajob) - (insert - " P:\tshow patch appropriately for the context (session or group)\n"))) - (insert - " ^:\tshow parent session group\n") - (or (ediff-one-filegroup-metajob) - (insert - " D:\tshow differences among directories\n" - " ==:\tfor each session, show which files are identical\n" - " =h:\tlike ==, but also marks those sessions for hiding\n" - " =m:\tlike ==, but also marks those sessions for operation\n\n")) - - (insert "\n") - (if (and (stringp regexp) (> (length regexp) 0)) - (insert - (format "*** Filter-through regular expression: %s\n" regexp))) - (ediff-insert-dirs-in-meta-buffer meta-list) - (if (and ediff-autostore-merges (ediff-merge-metajob) - (ediff-nonempty-string-p merge-autostore-dir)) - (insert (format - "\nMerge results are automatically stored in:\n\t%s\n" - merge-autostore-dir))) - (insert "\n - Size Last modified Name - ---------------------------------------------- - -") - - ;; discard info on directories and regexp - (setq meta-list (cdr meta-list) - tmp-list meta-list) - (while (and tmp-list empty) - (if (and (car tmp-list) - (not (eq (ediff-get-session-status (car tmp-list)) ?I))) - (setq empty nil)) - (setq tmp-list (cdr tmp-list))) - - (if empty - (insert - " ****** ****** This session group has no members\n")) - - ;; now organize file names like this: - ;; use-mark sizeA dateA sizeB dateB filename - ;; make sure directories are displayed with a trailing slash. - (while meta-list - (setq elt (car meta-list) - meta-list (cdr meta-list) - sessionNum (1+ sessionNum)) - (if (eq (ediff-get-session-status elt) ?I) - () - (ediff-insert-session-info-in-meta-buffer elt sessionNum))) - (set-buffer-modified-p nil) - (goto-char point) - meta-buf))) - -(defun ediff-update-markers-in-dir-meta-buffer (meta-list) - (let ((meta-buf (ediff-get-group-buffer meta-list)) - session-info point overl buffer-read-only) - (ediff-with-current-buffer meta-buf - (setq point (point)) - (goto-char (point-min)) - (ediff-next-meta-item1) - (while (not (bobp)) - (setq session-info (ediff-get-meta-info meta-buf (point) 'no-error) - overl (ediff-get-meta-overlay-at-pos (point))) - (if session-info - (progn - (cond ((eq (ediff-get-session-status session-info) ?I) - ;; Do hiding - (if overl (ediff-overlay-put overl 'invisible t))) - ((and (eq (ediff-get-session-status session-info) ?H) - overl (ediff-overlay-get overl 'invisible)) - ;; Do unhiding - (ediff-overlay-put overl 'invisible nil)) - (t (ediff-replace-session-activity-marker-in-meta-buffer - (point) - (ediff-get-session-activity-marker session-info)) - (ediff-replace-session-status-in-meta-buffer - (point) - (ediff-get-session-status session-info)))))) - (ediff-next-meta-item1) ; advance to the next item - ) ; end while - (set-buffer-modified-p nil) - (goto-char point)) - meta-buf)) - -(defun ediff-update-session-marker-in-dir-meta-buffer (session-num) - (let (buffer-meta-overlays session-info overl buffer-read-only) - (setq overl - (ediff-cond-compile-for-xemacs-or-emacs - (map-extents ; xemacs - (lambda (ext maparg) - (if (and - (ediff-overlay-get ext 'ediff-meta-info) - (eq (ediff-overlay-get ext 'ediff-meta-session-number) - session-num)) - ext))) - ;; Emacs doesn't have map-extents, so try harder - ;; Splice overlay lists to get all buffer overlays - (progn - (setq buffer-meta-overlays (overlay-lists) - buffer-meta-overlays (append (car buffer-meta-overlays) - (cdr buffer-meta-overlays))) - (car - (delq nil - (mapcar - (lambda (overl) - (if (and - (ediff-overlay-get overl 'ediff-meta-info) - (eq (ediff-overlay-get - overl 'ediff-meta-session-number) - session-num)) - overl)) - buffer-meta-overlays)))) - )) - (or overl - (error - "Bug in ediff-update-session-marker-in-dir-meta-buffer: no overlay with given number %S" - session-num)) - (setq session-info (ediff-overlay-get overl 'ediff-meta-info)) - (goto-char (ediff-overlay-start overl)) - (ediff-replace-session-activity-marker-in-meta-buffer - (point) - (ediff-get-session-activity-marker session-info)) - (ediff-replace-session-status-in-meta-buffer - (point) - (ediff-get-session-status session-info))) - (ediff-next-meta-item1)) - - - -;; Check if this is a problematic session. -;; Return nil if not. Otherwise, return symbol representing the problem -;; At present, problematic sessions occur only in -with-ancestor comparisons -;; when the ancestor is a directory rather than a file, or when there is no -;; suitable ancestor file in the ancestor directory -(defun ediff-problematic-session-p (session) - (let ((f1 (ediff-get-session-objA-name session)) - (f2 (ediff-get-session-objB-name session)) - (f3 (ediff-get-session-objC-name session))) - (cond ((and (stringp f1) (not (file-directory-p f1)) - (stringp f2) (not (file-directory-p f2)) - ;; either invalid file name or a directory - (or (not (stringp f3)) (file-directory-p f3)) - (ediff-ancestor-metajob)) - ;; more may be added later - 'ancestor-is-dir) - (t nil)))) - -(defun ediff-meta-insert-file-info1 (fileinfo) - (let ((fname (car fileinfo)) - (feq (ediff-get-file-eqstatus fileinfo)) - (max-filename-width (if ediff-meta-truncate-filenames - (- (window-width) 41) - 500)) - file-modtime file-size) - (cond ((not (stringp fname)) (setq file-size -2)) ; file doesn't exits - ((ediff-listable-file fname) - (if (file-exists-p fname) - ;; set real size and modtime - (setq file-size (ediff-file-size fname) - file-modtime (ediff-file-modtime fname)) - (setq file-size -2))) ; file doesn't exist - ( t (setq file-size -1))) ; remote file - (if (stringp fname) - (insert - (format - "%s %s %-20s %s\n" - (if feq "=" " ") ; equality indicator - (format "%10s" (cond ((= file-size -1) "--") - ((< file-size -1) "--") - (t file-size))) - (cond ((= file-size -1) "*remote file*") - ((< file-size -1) "*file doesn't exist*") - (t (ediff-format-date (decode-time file-modtime)))) - - ;; dir names in meta lists have training slashes, so we just - ;; abbreviate the file name, if file exists - (if (and (not (stringp fname)) (< file-size -1)) - "-------" ; file doesn't exist - (ediff-truncate-string-left - (ediff-abbreviate-file-name fname) - max-filename-width))))))) - -(defconst ediff-months '((1 . "Jan") (2 . "Feb") (3 . "Mar") (4 . "Apr") - (5 . "May") (6 . "Jun") (7 . "Jul") (8 . "Aug") - (9 . "Sep") (10 . "Oct") (11 . "Nov") (12 . "Dec")) - "Months' associative array.") - -;; returns 2char string -(defsubst ediff-fill-leading-zero (num) - (if (< num 10) - (format "0%d" num) - (number-to-string num))) - -;; TIME is like the output of decode-time -(defun ediff-format-date (time) - (format "%s %2d %4d %s:%s:%s" - (cdr (assoc (nth 4 time) ediff-months)) ; month - (nth 3 time) ; day - (nth 5 time) ; year - (ediff-fill-leading-zero (nth 2 time)) ; hour - (ediff-fill-leading-zero (nth 1 time)) ; min - (ediff-fill-leading-zero (nth 0 time)) ; sec - )) - -;; Draw the directories -(defun ediff-insert-dirs-in-meta-buffer (meta-list) - (let* ((dir1 (ediff-abbreviate-file-name (ediff-get-group-objA meta-list))) - (dir2 (ediff-get-group-objB meta-list)) - (dir2 (if (stringp dir2) (ediff-abbreviate-file-name dir2))) - (dir3 (ediff-get-group-objC meta-list)) - (dir3 (if (stringp dir3) (ediff-abbreviate-file-name dir3)))) - (insert "*** Directory A: " dir1 "\n") - (if dir2 (insert "*** Directory B: " dir2 "\n")) - (if dir3 (insert "*** Directory C: " dir3 "\n")) - (insert "\n"))) - -(defun ediff-draw-dir-diffs (diff-list &optional buf-name) - (if (null diff-list) (error "Lost difference info on these directories")) - (setq buf-name - (or buf-name - (ediff-unique-buffer-name "*Ediff File Group Differences" "*"))) - (let* ((regexp (ediff-get-group-regexp diff-list)) - (dir1 (ediff-abbreviate-file-name (ediff-get-group-objA diff-list))) - (dir2 (ediff-abbreviate-file-name (ediff-get-group-objB diff-list))) - (dir3 (ediff-get-group-objC diff-list)) - (dir3 (if (stringp dir3) (ediff-abbreviate-file-name dir3))) - (meta-buf (ediff-get-group-buffer diff-list)) - (underline (make-string 26 ?-)) - file membership-code saved-point - buffer-read-only) - ;; skip the directory part - (setq diff-list (cdr diff-list)) - (setq ediff-dir-diffs-buffer (get-buffer-create buf-name)) - (ediff-with-current-buffer ediff-dir-diffs-buffer - (setq saved-point (point)) - (use-local-map ediff-dir-diffs-buffer-map) - (erase-buffer) - (setq ediff-meta-buffer meta-buf) - (insert "\t\t*** Directory Differences ***\n") - (insert " -Useful commands: - C,button2: over file name -- copy this file to directory that doesn't have it - q: hide this buffer - n,SPC: next line - p,DEL: previous line\n\n") - - (insert (format "\n*** Directory A: %s\n" dir1)) - (if dir2 (insert (format "*** Directory B: %s\n" dir2))) - (if dir3 (insert (format "*** Directory C: %s\n" dir3))) - (if (and (stringp regexp) (> (length regexp) 0)) - (insert - (format "*** Filter-through regular expression: %s\n" regexp))) - (insert "\n") - (insert (format "\n%-27s%-26s" "Directory A" "Directory B")) - (if dir3 - (insert (format " %-25s\n" "Directory C")) - (insert "\n")) - (insert (format "%s%s" underline underline)) - (if (stringp dir3) - (insert (format "%s\n\n" underline)) - (insert "\n\n")) - - (if (null diff-list) - (insert "\n\t*** No differences ***\n")) - - (while diff-list - (setq file (car (car diff-list)) - membership-code (cdr (car diff-list)) - diff-list (cdr diff-list)) - (if (= (mod membership-code ediff-membership-code1) 0) ; dir1 - (let ((beg (point))) - (insert (format "%-27s" - (ediff-truncate-string-left - (ediff-abbreviate-file-name - (if (file-directory-p (concat dir1 file)) - (file-name-as-directory file) - file)) - 24))) - ;; format of meta info in the dir-diff-buffer: - ;; (filename-tail filename-full otherdir1 otherdir2 otherdir3) - (ediff-set-meta-overlay - beg (point) - (list meta-buf file (concat dir1 file) dir1 dir2 dir3))) - (insert (format "%-27s" "---"))) - (if (= (mod membership-code ediff-membership-code2) 0) ; dir2 - (let ((beg (point))) - (insert (format "%-26s" - (ediff-truncate-string-left - (ediff-abbreviate-file-name - (if (file-directory-p (concat dir2 file)) - (file-name-as-directory file) - file)) - 24))) - (ediff-set-meta-overlay - beg (point) - (list meta-buf file (concat dir2 file) dir1 dir2 dir3))) - (insert (format "%-26s" "---"))) - (if (stringp dir3) - (if (= (mod membership-code ediff-membership-code3) 0) ; dir3 - (let ((beg (point))) - (insert (format " %-25s" - (ediff-truncate-string-left - (ediff-abbreviate-file-name - (if (file-directory-p (concat dir3 file)) - (file-name-as-directory file) - file)) - 24))) - (ediff-set-meta-overlay - beg (point) - (list meta-buf file (concat dir3 file) dir1 dir2 dir3))) - (insert (format " %-25s" "---")))) - (insert "\n")) - (setq buffer-read-only t) - (set-buffer-modified-p nil) - (goto-char saved-point)) ; end eval in diff buffer - )) - -(defun ediff-bury-dir-diffs-buffer () - "Bury the directory difference buffer. Display the meta buffer instead." - (interactive) - ;; ediff-meta-buffer is set in ediff-draw-dir-diffs so the directory - ;; difference buffer remembers the meta buffer - (let ((buf ediff-meta-buffer) - wind) - (ediff-kill-buffer-carefully ediff-dir-diffs-buffer) - (if (setq wind (ediff-get-visible-buffer-window buf)) - (select-window wind) - (set-window-buffer (selected-window) buf)))) - -;; executes in dir session group buffer -;; show buffer differences -(defun ediff-show-dir-diffs () - "Display differences among the directories involved in session group." - (interactive) - (if (ediff-one-filegroup-metajob) - (error "This command is inapplicable in the present context")) - (or (ediff-buffer-live-p ediff-dir-diffs-buffer) - (ediff-draw-dir-diffs ediff-dir-difference-list)) - (let ((buf ediff-dir-diffs-buffer)) - (other-window 1) - (set-window-buffer (selected-window) buf) - (goto-char (point-min)))) - -;; Format of meta info in dir-diff-buffer: -;; (filename-tail filename-full otherdir1 otherdir2) -(defun ediff-dir-diff-copy-file () - "Copy file described at point to directories where this file is missing." - (interactive) - (let* ((pos (ediff-event-point last-command-event)) - (info (ediff-get-meta-info (current-buffer) pos 'noerror)) - (meta-buf (car info)) - (file-tail (nth 1 info)) - (file-abs (nth 2 info)) - (otherdir1 (nth 3 info)) - (otherfile1 (if otherdir1 (concat otherdir1 file-tail))) - (otherdir2 (nth 4 info)) - (otherfile2 (if otherdir2 (concat otherdir2 file-tail))) - (otherdir3 (nth 5 info)) - (otherfile3 (if otherdir3 (concat otherdir3 file-tail))) - meta-list dir-diff-list - ) - (if (null info) - (error "No file suitable for copying described at this location")) - (ediff-with-current-buffer meta-buf - (setq meta-list ediff-meta-list - dir-diff-list ediff-dir-difference-list)) - - ;; copy file to directories where it doesn't exist, update - ;; ediff-dir-difference-list and redisplay - (mapcar - (lambda (otherfile-struct) - (let ((otherfile (car otherfile-struct)) - (file-mem-code (cdr otherfile-struct))) - (if otherfile - (or (file-exists-p otherfile) - (if (y-or-n-p - (format "Copy %s to %s? " file-abs otherfile)) - (let* ((file-diff-record (assoc file-tail dir-diff-list)) - (new-mem-code - (* (cdr file-diff-record) file-mem-code))) - (copy-file file-abs otherfile) - (setcdr file-diff-record new-mem-code) - (ediff-draw-dir-diffs dir-diff-list (buffer-name)) - (sit-for 0) - ;; if file is in all three dirs or in two dirs and only - ;; two dirs are involved, delete this file's record - (if (or (= new-mem-code ediff-product-of-memcodes) - (and (> new-mem-code ediff-membership-code3) - (null otherfile3))) - (delq file-diff-record dir-diff-list)) - )))) - )) - ;; 2,3,5 are numbers used to encode membership of a file in - ;; dir1/2/3. See ediff-intersect-directories. - (list (cons otherfile1 2) (cons otherfile2 3) (cons otherfile3 5))) - - (if (and (file-exists-p otherfile1) - (file-exists-p otherfile2) - (or (not otherfile3) (file-exists-p otherfile3))) - ;; update ediff-meta-list by direct modification - (nconc meta-list - (list (ediff-make-new-meta-list-element - otherfile1 otherfile2 otherfile3))) - ) - (ediff-update-meta-buffer meta-buf 'must-redraw) - )) - -(defun ediff-up-meta-hierarchy () - "Go to the parent session group buffer." - (interactive) - (if (ediff-buffer-live-p ediff-parent-meta-buffer) - (ediff-show-meta-buffer - ediff-parent-meta-buffer ediff-meta-session-number) - (error "This session group has no parent"))) - - -;; argument is ignored -(defun ediff-redraw-registry-buffer (&optional ignore) - (ediff-with-current-buffer ediff-registry-buffer - (let ((point (point)) - elt bufAname bufBname bufCname cur-diff total-diffs pt - job-name meta-list registry-list buffer-read-only) - (erase-buffer) - ;; delete phony overlays that used to represent sessions before the buff - ;; was redrawn - (ediff-cond-compile-for-xemacs-or-emacs - (map-extents 'delete-extent) ; xemacs - (mapcar 'delete-overlay (overlays-in 1 1)) ; emacs - ) - - (insert "This is a registry of all active Ediff sessions. - -Useful commands: - button2, `v', RET over a session record: switch to that session - M over a session record: display the associated session group - R in any Ediff session: display session registry - n,SPC: next session - p,DEL: previous session - E: browse Ediff on-line manual - q: bury registry - - -\t\tActive Ediff Sessions: -\t\t---------------------- - -") - ;; purge registry list from dead buffers - (mapcar (lambda (elt) - (if (not (ediff-buffer-live-p elt)) - (setq ediff-session-registry - (delq elt ediff-session-registry)))) - ediff-session-registry) - - (if (null ediff-session-registry) - (insert " ******* No active Ediff sessions *******\n")) - - (setq registry-list ediff-session-registry) - (while registry-list - (setq elt (car registry-list) - registry-list (cdr registry-list)) - - (if (ediff-buffer-live-p elt) - (if (ediff-with-current-buffer elt - (setq job-name ediff-metajob-name - meta-list ediff-meta-list) - (and ediff-metajob-name - (not (eq ediff-metajob-name 'ediff-registry)))) - (progn - (setq pt (point)) - (insert (format " *group*\t%s: %s\n" - (buffer-name elt) - (ediff-abbrev-jobname job-name))) - (insert (format "\t\t %s %s %s\n" - (ediff-abbreviate-file-name - (ediff-get-group-objA meta-list)) - (ediff-abbreviate-file-name - (if (stringp - (ediff-get-group-objB meta-list)) - (ediff-get-group-objB meta-list) - "")) - (ediff-abbreviate-file-name - (if (stringp - (ediff-get-group-objC meta-list)) - (ediff-get-group-objC meta-list) - "")))) - (ediff-set-meta-overlay pt (point) elt)) - (progn - (ediff-with-current-buffer elt - (setq bufAname (if (ediff-buffer-live-p ediff-buffer-A) - (buffer-name ediff-buffer-A) - "!!!killed buffer!!!") - bufBname (if (ediff-buffer-live-p ediff-buffer-B) - (buffer-name ediff-buffer-B) - "!!!killed buffer!!!") - bufCname (cond ((not (ediff-3way-job)) - "") - ((ediff-buffer-live-p ediff-buffer-C) - (buffer-name ediff-buffer-C)) - (t "!!!killed buffer!!!"))) - (setq total-diffs (format "%-4d" ediff-number-of-differences) - cur-diff - (cond ((= ediff-current-difference -1) " _") - ((= ediff-current-difference - ediff-number-of-differences) - " $") - (t (format - "%4d" (1+ ediff-current-difference)))) - job-name ediff-job-name)) - ;; back in the meta buf - (setq pt (point)) - (insert cur-diff "/" total-diffs "\t" - (buffer-name elt) - (format ": %s" (ediff-abbrev-jobname job-name))) - (insert - "\n\t\t " bufAname " " bufBname " " bufCname "\n") - (ediff-set-meta-overlay pt (point) elt)))) - ) ; while - (set-buffer-modified-p nil) - (goto-char point) - ))) - -;; Sets overlay around a meta record with 'ediff-meta-info property PROP -;; If optional SESSION-NUMBER, make it a property of the overlay, -;; ediff-meta-session-number -;; PROP is either the ctl or meta buffer (used when we work with the registry) -;; or a session meta descriptor of the form -;; (SESSION-CTL-BUFFER STATUS OBJA OBJB OBJC) -(defun ediff-set-meta-overlay (b e prop &optional session-number hidden) - (let (overl) - (setq overl (ediff-make-overlay b e)) - (if ediff-emacs-p - (ediff-overlay-put overl 'mouse-face 'highlight) - (ediff-overlay-put overl 'highlight t)) - (ediff-overlay-put overl 'ediff-meta-info prop) - (ediff-overlay-put overl 'invisible hidden) - (ediff-overlay-put overl 'follow-link t) - (if (numberp session-number) - (ediff-overlay-put overl 'ediff-meta-session-number session-number)))) - -(defun ediff-mark-for-hiding-at-pos (unmark) - "Mark session for hiding. With prefix arg, unmark." - (interactive "P") - (let* ((pos (ediff-event-point last-command-event)) - (meta-buf (ediff-event-buffer last-command-event)) - ;; ediff-get-meta-info gives error if meta-buf or pos are invalid - (info (ediff-get-meta-info meta-buf pos)) - (session-number (ediff-get-session-number-at-pos pos))) - (ediff-mark-session-for-hiding info unmark) - (ediff-next-meta-item 1) - (save-excursion - (ediff-update-meta-buffer meta-buf nil session-number)) - )) - -;; Returns whether session was marked or unmarked -(defun ediff-mark-session-for-hiding (info unmark) - (let ((session-buf (ediff-get-session-buffer info)) - ignore) - (cond ((eq unmark 'mark) (setq unmark nil)) - ((eq (ediff-get-session-status info) ?H) (setq unmark t)) - (unmark ; says unmark, but the marker is different from H - (setq ignore t))) - (cond (ignore) - (unmark (ediff-set-session-status info nil)) -;;; (if (ediff-buffer-live-p session-buf) -;;; (error "Can't hide active session, %s" (buffer-name session-buf))) - (t (ediff-set-session-status info ?H)))) - unmark) - - -(defun ediff-mark-for-operation-at-pos (unmark) - "Mark session for a group operation. With prefix arg, unmark." - (interactive "P") - (let* ((pos (ediff-event-point last-command-event)) - (meta-buf (ediff-event-buffer last-command-event)) - ;; ediff-get-meta-info gives error if meta-buf or pos are invalid - (info (ediff-get-meta-info meta-buf pos)) - (session-number (ediff-get-session-number-at-pos pos))) - (ediff-mark-session-for-operation info unmark) - (ediff-next-meta-item 1) - (save-excursion - (ediff-update-meta-buffer meta-buf nil session-number)) - )) - - -;; returns whether session was unmarked. -;; remember: this is a toggle op -(defun ediff-mark-session-for-operation (info unmark) - (let (ignore) - (cond ((eq unmark 'mark) (setq unmark nil)) - ((eq (ediff-get-session-status info) ?*) (setq unmark t)) - (unmark ; says unmark, but the marker is different from * - (setq ignore t))) - (cond (ignore) - (unmark (ediff-set-session-status info nil)) - (t (ediff-set-session-status info ?*)))) - unmark) - - -(defun ediff-hide-marked-sessions (unhide) - "Hide marked sessions. With prefix arg, unhide." - (interactive "P") - (let ((grp-buf (ediff-get-group-buffer ediff-meta-list)) - (meta-list (cdr ediff-meta-list)) - (from (if unhide ?I ?H)) - (to (if unhide ?H ?I)) - (numMarked 0) - active-sessions-exist session-buf elt) - (while meta-list - (setq elt (car meta-list) - meta-list (cdr meta-list) - session-buf (ediff-get-session-buffer elt)) - - (if (eq (ediff-get-session-status elt) from) - (progn - (setq numMarked (1+ numMarked)) - (if (and (eq to ?I) (buffer-live-p session-buf)) - ;; shouldn't hide active sessions - (setq active-sessions-exist t) - (ediff-set-session-status elt to))))) - (if (> numMarked 0) - (ediff-update-meta-buffer grp-buf 'must-redraw) - (beep) - (if unhide - (message "Nothing to reveal...") - (message "Nothing to hide..."))) - (if active-sessions-exist - (message "Note: Ediff didn't hide active sessions!")) - )) - -;; Apply OPERATION to marked sessions. Operation expects one argument of type -;; meta-list member (not the first one), i.e., a regular session description. -;; Returns number of marked sessions on which operation was performed -(defun ediff-operate-on-marked-sessions (operation) - (let ((grp-buf (ediff-get-group-buffer ediff-meta-list)) - (meta-list (cdr ediff-meta-list)) - (marksym ?*) - (numMarked 0) - (sessionNum 0) - (diff-buffer ediff-meta-diff-buffer) - session-buf elt) - (while meta-list - (setq elt (car meta-list) - meta-list (cdr meta-list) - sessionNum (1+ sessionNum)) - (cond ((eq (ediff-get-session-status elt) marksym) - (save-excursion - (setq numMarked (1+ numMarked)) - (funcall operation elt sessionNum))) - ;; The following goes into a session represented by a subdirectory - ;; and applies operation to marked sessions there - ((and (ediff-meta-session-p elt) - (ediff-buffer-live-p - (setq session-buf (ediff-get-session-buffer elt)))) - (setq numMarked - (+ numMarked - (ediff-with-current-buffer session-buf - ;; pass meta-diff along - (setq ediff-meta-diff-buffer diff-buffer) - ;; collect diffs in child group - (ediff-operate-on-marked-sessions operation))))))) - (ediff-update-meta-buffer grp-buf 'must-redraw) ; just in case - numMarked - )) - -(defun ediff-append-custom-diff (session sessionNum) - (or (ediff-collect-diffs-metajob) - (error "Can't compute multifile patch in this context")) - (let ((session-buf (ediff-get-session-buffer session)) - (meta-diff-buff ediff-meta-diff-buffer) - (metajob ediff-metajob-name) - tmp-buf custom-diff-buf) - (if (ediff-buffer-live-p session-buf) - (ediff-with-current-buffer session-buf - (if (eq ediff-control-buffer session-buf) ; individual session - (progn - (ediff-compute-custom-diffs-maybe) - (setq custom-diff-buf ediff-custom-diff-buffer))))) - - (or (ediff-buffer-live-p meta-diff-buff) - (error "Ediff: something wrong--killed multiple diff's buffer")) - - (cond ((ediff-buffer-live-p custom-diff-buf) - ;; for live session buffers we do them first because the user may - ;; have changed them with respect to the underlying files - (save-excursion - (set-buffer meta-diff-buff) - (goto-char (point-max)) - (insert-buffer-substring custom-diff-buf) - (insert "\n"))) - ;; if ediff session is not live, run diff directly on the files - ((memq metajob '(ediff-directories - ediff-merge-directories - ediff-merge-directories-with-ancestor)) - ;; get diffs by calling shell command on ediff-custom-diff-program - (save-excursion - (set-buffer (setq tmp-buf (get-buffer-create ediff-tmp-buffer))) - (erase-buffer) - (shell-command - (format "%s %s %s %s" - ediff-custom-diff-program ediff-custom-diff-options - (ediff-get-session-objA-name session) - (ediff-get-session-objB-name session)) - t)) - (save-excursion - (set-buffer meta-diff-buff) - (goto-char (point-max)) - (insert-buffer-substring tmp-buf) - (insert "\n"))) - (t - (ediff-kill-buffer-carefully meta-diff-buff) - (error "Session %d compares versions of file. Such session must be active to enable multifile patch collection" sessionNum ))) - )) - -(defun ediff-collect-custom-diffs () - "Collect custom diffs of marked sessions in buffer `*Ediff Multifile Diffs*'. -This operation is defined only for `ediff-directories' and -`ediff-directory-revisions', since its intent is to produce -multifile patches. For `ediff-directory-revisions', we insist that -all marked sessions must be active." - (interactive) - (or (ediff-buffer-live-p ediff-meta-diff-buffer) - (setq ediff-meta-diff-buffer - (get-buffer-create - (ediff-unique-buffer-name "*Ediff Multifile Diffs" "*")))) - (ediff-with-current-buffer ediff-meta-diff-buffer - (setq buffer-read-only nil) - (erase-buffer)) - (if (> (ediff-operate-on-marked-sessions 'ediff-append-custom-diff) 0) - ;; did something - (progn - (display-buffer ediff-meta-diff-buffer 'not-this-window) - (ediff-with-current-buffer ediff-meta-diff-buffer - (set-buffer-modified-p nil) - (setq buffer-read-only t))) - (beep) - (message "No marked sessions found"))) - -(defun ediff-meta-show-patch () - "Show the multi-file patch associated with this group session." - (interactive) - (let* ((pos (ediff-event-point last-command-event)) - (meta-buf (ediff-event-buffer last-command-event)) - (info (ediff-get-meta-info meta-buf pos 'noerror)) - (patchbuffer ediff-meta-patchbufer)) - (if (ediff-buffer-live-p patchbuffer) - (ediff-with-current-buffer patchbuffer - (save-restriction - (if (not info) - (widen) - (narrow-to-region - (ediff-get-session-objB-name info) - (ediff-get-session-objC-name info))) - (set-buffer (get-buffer-create ediff-tmp-buffer)) - (erase-buffer) - (insert-buffer-substring patchbuffer) - (goto-char (point-min)) - (display-buffer ediff-tmp-buffer 'not-this-window) - )) - (error "The patch buffer wasn't found")))) - - -;; This function executes in meta buffer. It knows where event happened. -(defun ediff-filegroup-action () - "Execute appropriate action for a selected session." - (interactive) - (let* ((pos (ediff-event-point last-command-event)) - (meta-buf (ediff-event-buffer last-command-event)) - ;; ediff-get-meta-info gives error if meta-buf or pos are invalid - (info (ediff-get-meta-info meta-buf pos)) - (session-buf (ediff-get-session-buffer info)) - (session-number (ediff-get-session-number-at-pos pos meta-buf)) - (default-regexp (eval ediff-default-filtering-regexp)) - merge-autostore-dir file1 file2 file3 regexp) - - (setq file1 (ediff-get-session-objA-name info) - file2 (ediff-get-session-objB-name info) - file3 (ediff-get-session-objC-name info)) - - ;; make sure we don't start on hidden sessions - ;; ?H means marked for hiding. ?I means invalid (hidden). - (if (memq (ediff-get-session-status info) '(?I)) - (progn - (beep) - (if (y-or-n-p "This session is marked as hidden, unmark? ") - (progn - (ediff-set-session-status info nil) - (ediff-update-meta-buffer meta-buf nil session-number)) - (error "Aborted")))) - - (ediff-with-current-buffer meta-buf - (setq merge-autostore-dir - (ediff-get-group-merge-autostore-dir ediff-meta-list)) - (goto-char pos) ; if the user clicked on session--move point there - ;; First handle sessions involving directories (which are themselves - ;; session groups) - ;; After that handle individual sessions - (cond ((ediff-meta-session-p info) - ;; do ediff/ediff-merge on subdirectories - (if (ediff-buffer-live-p session-buf) - (ediff-show-meta-buffer session-buf) - (setq regexp - (read-string - (if (stringp default-regexp) - (format - "Filter through regular expression (default %s): " - default-regexp) - "Filter through regular expression: ") - nil - 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp))) - (ediff-directories-internal - file1 file2 file3 regexp - ediff-session-action-function - ediff-metajob-name - ;; make it update (car info) after startup - `(list (lambda () - ;; child session group should know its parent - (setq ediff-parent-meta-buffer - (quote ,ediff-meta-buffer) - ediff-meta-session-number - ,session-number) - ;; and parent will know its child - (setcar (quote ,info) ediff-meta-buffer)))))) - - ;; Do ediff-revision on a subdirectory - ((and (ediff-one-filegroup-metajob) - (ediff-revision-metajob) - (file-directory-p file1)) - (if (ediff-buffer-live-p session-buf) - (ediff-show-meta-buffer session-buf) - (setq regexp (read-string "Filter through regular expression: " - nil 'ediff-filtering-regexp-history)) - (ediff-directory-revisions-internal - file1 regexp - ediff-session-action-function ediff-metajob-name - ;; make it update (car info) after startup - `(list (lambda () - ;; child session group should know its parent and - ;; its number - (setq ediff-parent-meta-buffer - (quote ,ediff-meta-buffer) - ediff-meta-session-number - ,session-number) - ;; and parent will know its child - (setcar (quote ,info) ediff-meta-buffer)))))) - - ;; From here on---only individual session handlers - - ;; handle an individual session with a live control buffer - ((ediff-buffer-live-p session-buf) - (ediff-with-current-buffer session-buf - (setq ediff-mouse-pixel-position (mouse-pixel-position)) - (ediff-recenter 'no-rehighlight))) - - ((ediff-problematic-session-p info) - (beep) - (if (y-or-n-p - "This session has no ancestor. Merge without the ancestor? ") - (ediff-merge-files - file1 file2 - ;; provide startup hooks - `(list (lambda () - (add-hook - 'ediff-after-quit-hook-internal - (lambda () - (if (ediff-buffer-live-p ,(current-buffer)) - (ediff-show-meta-buffer - ,(current-buffer) ,session-number))) - nil 'local) - (setq ediff-meta-buffer ,(current-buffer) - ediff-meta-session-number - ,session-number) - (setq ediff-merge-store-file - ,(if (ediff-nonempty-string-p - merge-autostore-dir) - (concat - merge-autostore-dir - ediff-merge-filename-prefix - (file-name-nondirectory file1)) - )) - ;; make ediff-startup pass - ;; ediff-control-buffer back to the meta - ;; level; see below - (setcar - (quote ,info) ediff-control-buffer)))) - (error "Aborted"))) - ((ediff-one-filegroup-metajob) ; needs 1 file arg - (funcall ediff-session-action-function - file1 - ;; provide startup hooks - `(list (lambda () - (add-hook - 'ediff-after-quit-hook-internal - (lambda () - (if (ediff-buffer-live-p - ,(current-buffer)) - (ediff-show-meta-buffer - ,(current-buffer) - ,session-number))) - nil 'local) - (setq ediff-meta-buffer ,(current-buffer) - ediff-meta-session-number - ,session-number) - (setq ediff-merge-store-file - ,(if (ediff-nonempty-string-p - merge-autostore-dir) - (concat - merge-autostore-dir - ediff-merge-filename-prefix - (file-name-nondirectory file1))) ) - ;; make ediff-startup pass - ;; ediff-control-buffer back to the meta - ;; level; see below - (setcar - (quote ,info) ediff-control-buffer))))) - ((not (ediff-metajob3)) ; need 2 file args - (funcall ediff-session-action-function - file1 file2 - ;; provide startup hooks - `(list (lambda () - (add-hook - 'ediff-after-quit-hook-internal - (lambda () - (if (ediff-buffer-live-p - ,(current-buffer)) - (ediff-show-meta-buffer - ,(current-buffer) - ,session-number))) - nil 'local) - (setq ediff-meta-buffer ,(current-buffer) - ediff-meta-session-number - ,session-number) - (setq ediff-merge-store-file - ,(if (ediff-nonempty-string-p - merge-autostore-dir) - (concat - merge-autostore-dir - ediff-merge-filename-prefix - (file-name-nondirectory file1))) ) - ;; make ediff-startup pass - ;; ediff-control-buffer back to the meta - ;; level; see below - (setcar - (quote ,info) ediff-control-buffer))))) - ((ediff-metajob3) ; need 3 file args - (funcall ediff-session-action-function - file1 file2 file3 - ;; arrange startup hooks - `(list (lambda () - (add-hook - 'ediff-after-quit-hook-internal - (lambda () - (if (ediff-buffer-live-p - ,(current-buffer)) - (ediff-show-meta-buffer - ,(current-buffer) - ,session-number))) - nil 'local) - (setq ediff-merge-store-file - ,(if (ediff-nonempty-string-p - merge-autostore-dir) - (concat - merge-autostore-dir - ediff-merge-filename-prefix - (file-name-nondirectory file1))) ) - (setq ediff-meta-buffer , (current-buffer) - ediff-meta-session-number - ,session-number) - ;; this arranges that ediff-startup will pass - ;; the value of ediff-control-buffer back to - ;; the meta level, to the record in the meta - ;; list containing the information about the - ;; session associated with that - ;; ediff-control-buffer - (setcar - (quote ,info) ediff-control-buffer))))) - ) ; cond - ) ; eval in meta-buf - )) - -(defun ediff-registry-action () - "Switch to a selected session." - (interactive) - (let* ((pos (ediff-event-point last-command-event)) - (buf (ediff-event-buffer last-command-event)) - (ctl-buf (ediff-get-meta-info buf pos))) - - (if (ediff-buffer-live-p ctl-buf) - ;; check if this is ediff-control-buffer or ediff-meta-buffer - (if (ediff-with-current-buffer ctl-buf - (eq (key-binding "q") 'ediff-quit-meta-buffer)) - ;; it's a meta-buffer -- last action should just display it - (ediff-show-meta-buffer ctl-buf t) - ;; it's a session buffer -- invoke go back to session - (ediff-with-current-buffer ctl-buf - (setq ediff-mouse-pixel-position (mouse-pixel-position)) - (ediff-recenter 'no-rehighlight))) - (beep) - (message "You've selected a stale session --- try again") - (ediff-update-registry)) - (ediff-with-current-buffer buf - (goto-char pos)) - )) - - -;; If session number is t, means don't update meta buffer -(defun ediff-show-meta-buffer (&optional meta-buf session-number) - "Show the session group buffer." - (interactive) - (run-hooks 'ediff-before-directory-setup-hooks) - (let (wind frame silent) - (if meta-buf (setq silent t)) - - (setq meta-buf (or meta-buf ediff-meta-buffer)) - (cond ((not (bufferp meta-buf)) - (error "This Ediff session is not part of a session group")) - ((not (ediff-buffer-live-p meta-buf)) - (error - "Can't find this session's group panel -- session itself is ok"))) - - (cond ((numberp session-number) - (ediff-update-meta-buffer meta-buf nil session-number)) - ;; if session-number is t, don't update - (session-number) - (t (ediff-cleanup-meta-buffer meta-buf))) - - (ediff-with-current-buffer meta-buf - (save-excursion - (cond ((setq wind (ediff-get-visible-buffer-window meta-buf)) - (or silent - (message - "Already showing the group panel for this session")) - (set-window-buffer wind meta-buf) - (select-window wind)) - ((window-live-p (setq wind ediff-window-C)) ;in merge--merge buf - (set-window-buffer ediff-window-C meta-buf) - (select-window wind)) - ((window-live-p (setq wind ediff-window-A)) - (set-window-buffer ediff-window-A meta-buf) - (select-window wind)) - ((window-live-p (setq wind ediff-window-B)) - (set-window-buffer ediff-window-B meta-buf) - (select-window wind)) - ((and - (setq wind - (ediff-get-visible-buffer-window ediff-registry-buffer)) - (ediff-window-display-p)) - (select-window wind) - (other-window 1) - (set-window-buffer (selected-window) meta-buf)) - (t (ediff-skip-unsuitable-frames 'ok-unsplittable) - (set-window-buffer (selected-window) meta-buf))) - )) - (if (and (ediff-window-display-p) - (window-live-p - (setq wind (ediff-get-visible-buffer-window meta-buf)))) - (progn - (setq frame (window-frame wind)) - (raise-frame frame) - (ediff-reset-mouse frame))) - (sit-for 0) ; sometimes needed to synch the display and ensure that the - ; point ends up after the just completed session - (run-hooks 'ediff-show-session-group-hook) - )) - -(defun ediff-show-current-session-meta-buffer () - (interactive) - (ediff-show-meta-buffer nil ediff-meta-session-number)) - -(defun ediff-show-meta-buff-from-registry () - "Display the session group buffer for a selected session group." - (interactive) - (let* ((pos (ediff-event-point last-command-event)) - (meta-buf (ediff-event-buffer last-command-event)) - (info (ediff-get-meta-info meta-buf pos)) - (meta-or-session-buf info)) - (ediff-with-current-buffer meta-or-session-buf - (ediff-show-meta-buffer nil t)))) - -;;;###autoload -(defun ediff-show-registry () - "Display Ediff's registry." - (interactive) - (ediff-update-registry) - (if (not (ediff-buffer-live-p ediff-registry-buffer)) - (error "No active Ediff sessions or corrupted session registry")) - (let (wind frame) - ;; for some reason, point moves in ediff-registry-buffer, so we preserve it - ;; explicitly - (ediff-with-current-buffer ediff-registry-buffer - (save-excursion - (cond ((setq wind - (ediff-get-visible-buffer-window ediff-registry-buffer)) - (message "Already showing the registry") - (set-window-buffer wind ediff-registry-buffer) - (select-window wind)) - ((window-live-p ediff-window-C) - (set-window-buffer ediff-window-C ediff-registry-buffer) - (select-window ediff-window-C)) - ((window-live-p ediff-window-A) - (set-window-buffer ediff-window-A ediff-registry-buffer) - (select-window ediff-window-A)) - ((window-live-p ediff-window-B) - (set-window-buffer ediff-window-B ediff-registry-buffer) - (select-window ediff-window-B)) - ((and (setq wind - (ediff-get-visible-buffer-window ediff-meta-buffer)) - (ediff-window-display-p)) - (select-window wind) - (other-window 1) - (set-window-buffer (selected-window) ediff-registry-buffer)) - (t (ediff-skip-unsuitable-frames 'ok-unsplittable) - (set-window-buffer (selected-window) ediff-registry-buffer))) - )) - (if (ediff-window-display-p) - (progn - (setq frame - (window-frame - (ediff-get-visible-buffer-window ediff-registry-buffer))) - (raise-frame frame) - (ediff-reset-mouse frame))) - (run-hooks 'ediff-show-registry-hook) - )) - -;;;###autoload -(defalias 'eregistry 'ediff-show-registry) - -;; If meta-buf doesn't exist, it is created. In that case, id doesn't have a -;; parent meta-buf -;; Check if META-BUF exists before calling this function -;; Optional MUST-REDRAW, if non-nil, would force redrawal of the whole meta -;; buffer. Otherwise, it will just go over the buffer and update activity marks -;; and session status. -;; SESSION-NUMBER, if specified, says which session caused the update. -(defun ediff-update-meta-buffer (meta-buf &optional must-redraw session-number) - (if (ediff-buffer-live-p meta-buf) - (ediff-with-current-buffer meta-buf - (let (overl) - (cond (must-redraw ; completely redraw the meta buffer - (funcall ediff-meta-redraw-function ediff-meta-list)) - ((numberp session-number) ; redraw only for the given session - (ediff-update-session-marker-in-dir-meta-buffer - session-number)) - (t ; update what changed only, but scan the entire meta buffer - (ediff-update-markers-in-dir-meta-buffer ediff-meta-list))) - (setq overl (ediff-get-meta-overlay-at-pos (point))) - ;; skip the invisible sessions - (while (and overl (ediff-overlay-get overl 'invisible)) - (ediff-next-meta-item1) - (setq overl (ediff-get-meta-overlay-at-pos (point)))) - )))) - -(defun ediff-update-registry () - (ediff-with-current-buffer (current-buffer) - (if (ediff-buffer-live-p ediff-registry-buffer) - (ediff-redraw-registry-buffer) - (ediff-prepare-meta-buffer - 'ediff-registry-action - ediff-session-registry - "*Ediff Registry" - 'ediff-redraw-registry-buffer - 'ediff-registry)) - )) - -;; If meta-buf exists, it is redrawn along with parent. -;; Otherwise, nothing happens. -(defun ediff-cleanup-meta-buffer (meta-buffer) - (if (ediff-buffer-live-p meta-buffer) - (ediff-with-current-buffer meta-buffer - (ediff-update-meta-buffer meta-buffer) - (if (ediff-buffer-live-p ediff-parent-meta-buffer) - (ediff-update-meta-buffer - ediff-parent-meta-buffer nil ediff-meta-session-number))))) - -;; t if no session is in progress -(defun ediff-safe-to-quit (meta-buffer) - (if (ediff-buffer-live-p meta-buffer) - (let ((lis ediff-meta-list) - (cont t) - buffer-read-only) - ;;(ediff-update-meta-buffer meta-buffer) - (ediff-with-current-buffer meta-buffer - (setq lis (cdr lis)) ; discard the description part of meta-list - (while (and cont lis) - (if (ediff-buffer-live-p - (ediff-get-group-buffer lis)) ; in progress - (setq cont nil)) - (setq lis (cdr lis))) - cont)))) - -(defun ediff-quit-meta-buffer () - "If the group has no active session, delete the meta buffer. -If no session is in progress, ask to confirm before deleting meta buffer. -Otherwise, bury the meta buffer. -If this is a session registry buffer then just bury it." - (interactive) - (let* ((buf (current-buffer)) - (dir-diffs-buffer ediff-dir-diffs-buffer) - (meta-diff-buffer ediff-meta-diff-buffer) - (session-number ediff-meta-session-number) - (parent-buf ediff-parent-meta-buffer) - (dont-show-registry (eq buf ediff-registry-buffer))) - (if dont-show-registry - (bury-buffer) - ;;(ediff-cleanup-meta-buffer buf) - (cond ((and (ediff-safe-to-quit buf) - (y-or-n-p "Quit this session group? ")) - (run-hooks 'ediff-quit-session-group-hook) - (message "") - (ediff-dispose-of-meta-buffer buf)) - ((ediff-safe-to-quit buf) - (bury-buffer)) - (t - (error - "This session group has active sessions---cannot exit"))) - (ediff-update-meta-buffer parent-buf nil session-number) - (ediff-kill-buffer-carefully dir-diffs-buffer) - (ediff-kill-buffer-carefully meta-diff-buffer) - (if (ediff-buffer-live-p parent-buf) - (progn - (setq dont-show-registry t) - (ediff-show-meta-buffer parent-buf session-number))) - ) - (or dont-show-registry - (ediff-show-registry)))) - -(defun ediff-dispose-of-meta-buffer (buf) - (setq ediff-session-registry (delq buf ediff-session-registry)) - (ediff-with-current-buffer buf - (if (ediff-buffer-live-p ediff-dir-diffs-buffer) - (kill-buffer ediff-dir-diffs-buffer))) - (kill-buffer buf)) - - -;; Obtain information on a meta record where the user clicked or typed -;; BUF is the buffer where this happened and POINT is the position -;; If optional NOERROR arg is given, don't report error and return nil if no -;; meta info is found on line. -(defun ediff-get-meta-info (buf point &optional noerror) - (let (result olist tmp) - (if (and point (ediff-buffer-live-p buf)) - (ediff-with-current-buffer buf - (ediff-cond-compile-for-xemacs-or-emacs - (setq result ; xemacs - (if (setq tmp (extent-at point buf 'ediff-meta-info)) - (ediff-overlay-get tmp 'ediff-meta-info))) - (progn ; emacs - (setq olist (overlays-at point)) - (setq olist - (mapcar (lambda (elt) - (unless (overlay-get elt 'invisible) - (overlay-get elt 'ediff-meta-info))) - olist)) - (while (and olist (null (car olist))) - (setq olist (cdr olist))) - (setq result (car olist))) - ) - )) - (if result - result - (if noerror - nil - (ediff-update-registry) - (error "No session info in this line"))))) - - -(defun ediff-get-meta-overlay-at-pos (point) - (ediff-cond-compile-for-xemacs-or-emacs - (extent-at point (current-buffer) 'ediff-meta-info) ; xemacs - ;; emacs - (let* ((overl-list (overlays-at point)) - (overl (car overl-list))) - (while (and overl (null (overlay-get overl 'ediff-meta-info))) - (setq overl-list (cdr overl-list) - overl (car overl-list))) - overl) - ) - ) - -(defsubst ediff-get-session-number-at-pos (point &optional meta-buffer) - (setq meta-buffer (if (ediff-buffer-live-p meta-buffer) - meta-buffer - (current-buffer))) - (ediff-with-current-buffer meta-buffer - (ediff-overlay-get - (ediff-get-meta-overlay-at-pos point) 'ediff-meta-session-number))) - - -;; Return location of the next meta overlay after point -(defun ediff-next-meta-overlay-start (point) - (if (eobp) - (goto-char (point-min)) - (let ((overl (ediff-get-meta-overlay-at-pos point))) - (ediff-cond-compile-for-xemacs-or-emacs - (progn ; xemacs - (if overl - (setq overl (next-extent overl)) - (setq overl (next-extent (current-buffer)))) - (if overl - (extent-start-position overl) - (point-max))) - ;; emacs - (if overl - ;; note: end of current overlay is the beginning of the next one - (overlay-end overl) - (next-overlay-change point)) - ) - ) - )) - - -(defun ediff-previous-meta-overlay-start (point) - (if (bobp) - (goto-char (point-max)) - (let ((overl (ediff-get-meta-overlay-at-pos point))) - (ediff-cond-compile-for-xemacs-or-emacs - (progn - (if overl - (setq overl (previous-extent overl)) - (setq overl (previous-extent (current-buffer)))) - (if overl - (extent-start-position overl) - (point-min))) - (progn - (if overl (setq point (overlay-start overl))) - ;; to get to the beginning of prev overlay - (if (not (bobp)) - ;; trick to overcome an emacs bug--doesn't always find previous - ;; overlay change correctly - (setq point (1- point))) - (setq point (previous-overlay-change point)) - ;; If we are not over an overlay after subtracting 1, it means we are - ;; in the description area preceding session records. In this case, - ;; goto the top of the registry buffer. - (or (car (overlays-at point)) - (setq point (point-min))) - point) - ) - ))) - -;; this is the action invoked when the user selects a patch from the meta -;; buffer. -(defun ediff-patch-file-form-meta (file &optional startup-hooks) - (let* ((pos (ediff-event-point last-command-event)) - (meta-buf (ediff-event-buffer last-command-event)) - ;; ediff-get-meta-info gives error if meta-buf or pos are invalid - (info (ediff-get-meta-info meta-buf pos)) - (meta-patchbuf ediff-meta-patchbufer) - session-buf beg-marker end-marker) - - (if (or (file-directory-p file) (string-match "/dev/null" file)) - (error "`%s' is not an ordinary file" (file-name-as-directory file))) - (setq session-buf (ediff-get-session-buffer info) - beg-marker (ediff-get-session-objB-name info) - end-marker (ediff-get-session-objC-name info)) - - (or (ediff-buffer-live-p session-buf) ; either an active patch session - (null session-buf) ; or it is a virgin session - (error - "Patch has already been applied to this file -- can't repeat!")) - - (ediff-with-current-buffer meta-patchbuf - (save-restriction - (widen) - (narrow-to-region beg-marker end-marker) - (ediff-patch-file-internal meta-patchbuf file startup-hooks))))) - - -(defun ediff-unmark-all-for-operation () - "Unmark all sessions marked for operation." - (interactive) - (let ((list (cdr ediff-meta-list)) - elt) - (while (setq elt (car list)) - (ediff-mark-session-for-operation elt 'unmark) - (setq list (cdr list)))) - (ediff-update-meta-buffer (current-buffer) 'must-redraw)) - -(defun ediff-unmark-all-for-hiding () - "Unmark all sessions marked for hiding." - (interactive) - (let ((list (cdr ediff-meta-list)) - elt) - (while (setq elt (car list)) - (ediff-mark-session-for-hiding elt 'unmark) - (setq list (cdr list)))) - (ediff-update-meta-buffer (current-buffer) 'must-redraw)) - - -;; ACTION is ?h, ?m, ?=: to mark for hiding, mark for operation, or simply -;; indicate which are equal files -(defun ediff-meta-mark-equal-files (&optional action) - "Run through the session list and mark identical files. -This is used only for sessions that involve 2 or 3 files at the same time. -ACTION is an optional argument that can be ?h, ?m, ?=, to mark for hiding, mark -for operation, or simply indicate which are equal files. If it is nil, then -`last-command-char' is used to decide which action to take." - (interactive) - (if (null action) - (setq action last-command-char)) - (let ((list (cdr ediff-meta-list)) - marked1 marked2 marked3 - fileinfo1 fileinfo2 fileinfo3 elt) - (message "Comparing files ...") - (while (setq elt (car list)) - (setq fileinfo1 (ediff-get-session-objA elt) - fileinfo2 (ediff-get-session-objB elt) - fileinfo3 (ediff-get-session-objC elt)) - (ediff-set-file-eqstatus fileinfo1 nil) - (ediff-set-file-eqstatus fileinfo2 nil) - (ediff-set-file-eqstatus fileinfo3 nil) - - (setq marked1 t - marked2 t - marked3 t) - (or (ediff-mark-if-equal fileinfo1 fileinfo2) - (setq marked1 nil)) - (if (ediff-metajob3) - (progn - (or (ediff-mark-if-equal fileinfo1 fileinfo3) - (setq marked2 nil)) - (or (ediff-mark-if-equal fileinfo2 fileinfo3) - (setq marked3 nil)))) - (if (and marked1 marked2 marked3) - (cond ((eq action ?h) - (ediff-mark-session-for-hiding elt 'mark)) - ((eq action ?m) - (ediff-mark-session-for-operation elt 'mark)) - )) - (setq list (cdr list))) - (message "Comparing files ... Done")) - (setq ediff-recurse-to-subdirectories nil) - (ediff-update-meta-buffer (current-buffer) 'must-redraw)) - -;; mark files 1 and 2 as equal, if they are. -;; returns t, if something was marked -(defun ediff-mark-if-equal (fileinfo1 fileinfo2) - (let ((f1 (car fileinfo1)) - (f2 (car fileinfo2))) - (if (and (stringp f1) (stringp f2) (ediff-same-contents f1 f2)) - (progn - (ediff-set-file-eqstatus fileinfo1 t) - (ediff-set-file-eqstatus fileinfo2 t) - )) - )) - - -(provide 'ediff-mult) - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; arch-tag: c8a76898-f96f-4d9c-be9d-129134017188 -;;; ediff-mult.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-ptch.el b/xemacs-packages/lisp/ediff/ediff-ptch.el deleted file mode 100644 index b911c33f..00000000 --- a/xemacs-packages/lisp/ediff/ediff-ptch.el +++ /dev/null @@ -1,856 +0,0 @@ -;;; ediff-ptch.el --- Ediff's patch support - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - - -(defgroup ediff-ptch nil - "Ediff patch support." - :tag "Patch" - :prefix "ediff-" - :group 'ediff) - -;; compiler pacifier -(defvar ediff-window-A) -(defvar ediff-window-B) -(defvar ediff-window-C) -(defvar ediff-use-last-dir) -(defvar ediff-shell) - -(eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - (or (featurep 'ediff-mult) - (load "ediff-mult.el" nil nil 'nosuffix)) - (or (featurep 'ediff) - (load "ediff.el" nil nil 'nosuffix)) - )) -;; end pacifier - -(require 'ediff-init) - -(defcustom ediff-patch-program "patch" - "*Name of the program that applies patches. -It is recommended to use GNU-compatible versions." - :type 'string - :group 'ediff-ptch) -(defcustom ediff-patch-options "-f" - "*Options to pass to ediff-patch-program. - -Note: the `-b' option should be specified in `ediff-backup-specs'. - -It is recommended to pass the `-f' option to the patch program, so it won't ask -questions. However, some implementations don't accept this option, in which -case the default value for this variable should be changed." - :type 'string - :group 'ediff-ptch) - -(defvar ediff-last-dir-patch nil - "Last directory used by an Ediff command for file to patch.") - -;; the default backup extension -(defconst ediff-default-backup-extension - (if (memq system-type '(vax-vms axp-vms emx ms-dos)) - "_orig" ".orig")) - - -(defcustom ediff-backup-extension ediff-default-backup-extension - "Backup extension used by the patch program. -See also `ediff-backup-specs'." - :type 'string - :group 'ediff-ptch) - -(defun ediff-test-patch-utility () - (condition-case nil - (cond ((eq 0 (call-process ediff-patch-program nil nil nil "-z." "-b")) - ;; GNU `patch' v. >= 2.2 - 'gnu) - ((eq 0 (call-process ediff-patch-program nil nil nil "-b")) - 'posix) - (t 'traditional)) - (file-error nil))) - -(defcustom ediff-backup-specs - (let ((type (ediff-test-patch-utility))) - (cond ((eq type 'gnu) - ;; GNU `patch' v. >= 2.2 - (format "-z%s -b" ediff-backup-extension)) - ((eq type 'posix) - ;; POSIX `patch' -- ediff-backup-extension must be ".orig" - (setq ediff-backup-extension ediff-default-backup-extension) - "-b") - (t - ;; traditional `patch' - (format "-b %s" ediff-backup-extension)))) - "*Backup directives to pass to the patch program. -Ediff requires that the old version of the file \(before applying the patch\) -be saved in a file named `the-patch-file.extension'. Usually `extension' is -`.orig', but this can be changed by the user and may depend on the system. -Therefore, Ediff needs to know the backup extension used by the patch program. - -Some versions of the patch program let you specify `-b backup-extension'. -Other versions only permit `-b', which assumes the extension `.orig' -\(in which case ediff-backup-extension MUST be also `.orig'\). The latest -versions of GNU patch require `-b -z backup-extension'. - -Note that both `ediff-backup-extension' and `ediff-backup-specs' -must be set properly. If your patch program takes the option `-b', -but not `-b extension', the variable `ediff-backup-extension' must -still be set so Ediff will know which extension to use. - -Ediff tries to guess the appropriate value for this variables. It is believed -to be working for `traditional' patch, all versions of GNU patch, and for POSIX -patch. So, don't change these variables, unless the default doesn't work." - :type 'string - :group 'ediff-ptch) - - -(defcustom ediff-patch-default-directory nil - "*Default directory to look for patches." - :type '(choice (const nil) string) - :group 'ediff-ptch) - -(defcustom ediff-context-diff-label-regexp - (concat "\\(" ; context diff 2-liner - "^\\*\\*\\* \\([^ \t]+\\)[^*]+[\t ]*\n--- \\([^ \t]+\\)" - "\\|" ; GNU unified format diff 2-liner - "^--- \\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ \\([^ \t]+\\)" - "\\)") - "*Regexp matching filename 2-liners at the start of each context diff. -You probably don't want to change that, unless you are using an obscure patch -program." - :type 'regexp - :group 'ediff-ptch) - -;; The buffer of the patch file. Local to control buffer. -(ediff-defvar-local ediff-patchbufer nil "") - -;; The buffer where patch displays its diagnostics. -(ediff-defvar-local ediff-patch-diagnostics nil "") - -;; Map of patch buffer. Has the form: -;; ((filename1 marker1 marker2) (filename2 marker1 marker2) ...) -;; where filenames are files to which patch would have applied the patch; -;; marker1 delimits the beginning of the corresponding patch and marker2 does -;; it for the end. -(ediff-defvar-local ediff-patch-map nil "") - -;; strip prefix from filename -;; returns /dev/null, if can't strip prefix -(defsubst ediff-file-name-sans-prefix (filename prefix) - (if prefix - (save-match-data - (if (string-match (concat "^" (if (stringp prefix) - (regexp-quote prefix) - "")) - filename) - (substring filename (match-end 0)) - (concat "/null/" filename))) - filename) - ) - - - -;; no longer used -;; return the number of matches of regexp in buf starting from the beginning -(defun ediff-count-matches (regexp buf) - (ediff-with-current-buffer buf - (let ((count 0) opoint) - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) - (progn (setq opoint (point)) - (re-search-forward regexp nil t))) - (if (= opoint (point)) - (forward-char 1) - (setq count (1+ count))))) - count))) - -;; Scan BUF (which is supposed to contain a patch) and make a list of the form -;; ((nil nil filename-spec1 marker1 marker2) -;; (nil nil filename-spec2 marker1 marker2) ...) -;; where filename-spec[12] are files to which the `patch' program would -;; have applied the patch. -;; nin, nil are placeholders. See ediff-make-new-meta-list-element in -;; ediff-meta.el for the explanations. -;; In the beginning we don't know exactly which files need to be patched. -;; We usually come up with two candidates and ediff-file-name-sans-prefix -;; resolves this later. -;; -;; The marker `marker1' delimits the beginning of the corresponding patch and -;; `marker2' does it for the end. -;; The result of ediff-map-patch-buffer is a list, which is then assigned -;; to ediff-patch-map. -;; The function returns the number of elements in the list ediff-patch-map -(defun ediff-map-patch-buffer (buf) - (ediff-with-current-buffer buf - (let ((count 0) - (mark1 (move-marker (make-marker) (point-min))) - (mark1-end (point-min)) - (possible-file-names '("/dev/null" . "/dev/null")) - mark2-end mark2 filenames - beg1 beg2 end1 end2 - patch-map opoint) - (save-excursion - (goto-char (point-min)) - (setq opoint (point)) - (while (and (not (eobp)) - (re-search-forward ediff-context-diff-label-regexp nil t)) - (if (= opoint (point)) - (forward-char 1) ; ensure progress towards the end - (setq mark2 (move-marker (make-marker) (match-beginning 0)) - mark2-end (match-end 0) - beg1 (or (match-beginning 2) (match-beginning 4)) - end1 (or (match-end 2) (match-end 4)) - beg2 (or (match-beginning 3) (match-beginning 5)) - end2 (or (match-end 3) (match-end 5))) - ;; possible-file-names is holding the new file names until we - ;; insert the old file name in the patch map - ;; It is a pair - ;; (filename-from-1st-header-line . fn from 2nd line) - (setq possible-file-names - (cons (if (and beg1 end1) - (buffer-substring beg1 end1) - "/dev/null") - (if (and beg2 end2) - (buffer-substring beg2 end2) - "/dev/null"))) - ;; check for any `Index:' or `Prereq:' lines, but don't use them - (if (re-search-backward "^Index:" mark1-end 'noerror) - (move-marker mark2 (match-beginning 0))) - (if (re-search-backward "^Prereq:" mark1-end 'noerror) - (move-marker mark2 (match-beginning 0))) - - (goto-char mark2-end) - - (if filenames - (setq patch-map - (cons (ediff-make-new-meta-list-element - filenames mark1 mark2) - patch-map))) - (setq mark1 mark2 - mark1-end mark2-end - filenames possible-file-names)) - (setq opoint (point) - count (1+ count)))) - (setq mark2 (point-max-marker) - patch-map (cons (ediff-make-new-meta-list-element - possible-file-names mark1 mark2) - patch-map)) - (setq ediff-patch-map (nreverse patch-map)) - count))) - -;; Fix up the file names in the list using the argument FILENAME -;; Algorithm: find the files' directories in the patch and, if a directory is -;; absolute, cut it out from the corresponding file name in the patch. -;; Relative directories are not cut out. -;; Prepend the directory of FILENAME to each resulting file (which came -;; originally from the patch). -;; In addition, the first file in the patch document is replaced by FILENAME. -;; Each file is actually a pair of files found in the context diff header -;; In the end, for each pair, we ask the user which file to patch. -;; Note: Ediff doesn't recognize multi-file patches that are separated -;; with the `Index:' line. It treats them as a single-file patch. -;; -;; Executes inside the patch buffer -(defun ediff-fixup-patch-map (filename) - (setq filename (expand-file-name filename)) - (let ((actual-dir (if (file-directory-p filename) - ;; directory part of filename - (file-name-as-directory filename) - (file-name-directory filename))) - ;; In case 2 files are possible patch targets, the user will be offered - ;; to choose file1 or file2. In a multifile patch, if the user chooses - ;; 1 or 2, this choice is preserved to decide future alternatives. - chosen-alternative - ) - - ;; chop off base-dirs - (mapcar (lambda (session-info) - (let* ((proposed-file-names - ;; Filename-spec is objA; it is represented as - ;; (file1 . file2). Get it using ediff-get-session-objA. - (ediff-get-session-objA-name session-info)) - ;; base-dir1 is the dir part of the 1st file in the patch - (base-dir1 - (or (file-name-directory (car proposed-file-names)) - "")) - ;; directory part of the 2nd file in the patch - (base-dir2 - (or (file-name-directory (cdr proposed-file-names)) - "")) - ) - ;; If both base-dir1 and base-dir2 are relative and exist, - ;; assume that - ;; these dirs lead to the actual files starting at the present - ;; directory. So, we don't strip these relative dirs from the - ;; file names. This is a heuristic intended to improve guessing - (unless (or (file-name-absolute-p base-dir1) - (file-name-absolute-p base-dir2) - (not (file-exists-p base-dir1)) - (not (file-exists-p base-dir2))) - (setq base-dir1 "" - base-dir2 "")) - (or (string= (car proposed-file-names) "/dev/null") - (setcar proposed-file-names - (ediff-file-name-sans-prefix - (car proposed-file-names) base-dir1))) - (or (string= - (cdr proposed-file-names) "/dev/null") - (setcdr proposed-file-names - (ediff-file-name-sans-prefix - (cdr proposed-file-names) base-dir2))) - )) - ediff-patch-map) - - ;; take the given file name into account - (or (file-directory-p filename) - (string= "/dev/null" filename) - (setcar (ediff-get-session-objA (car ediff-patch-map)) - (cons (file-name-nondirectory filename) - (file-name-nondirectory filename)))) - - ;; prepend actual-dir - (mapcar (lambda (session-info) - (let ((proposed-file-names - (ediff-get-session-objA-name session-info))) - (if (and (string-match "^/null/" (car proposed-file-names)) - (string-match "^/null/" (cdr proposed-file-names))) - ;; couldn't intuit the file name to patch, so - ;; something is amiss - (progn - (with-output-to-temp-buffer ediff-msg-buffer - (ediff-with-current-buffer standard-output - (fundamental-mode)) - (princ - (format " -The patch file contains a context diff for - %s - %s -However, Ediff cannot infer the name of the actual file -to be patched on your system. If you know the correct file name, -please enter it now. - -If you don't know and still would like to apply patches to -other files, enter /dev/null -" - (substring (car proposed-file-names) 6) - (substring (cdr proposed-file-names) 6)))) - (let ((directory t) - user-file) - (while directory - (setq user-file - (read-file-name - "Please enter file name: " - actual-dir actual-dir t)) - (if (not (file-directory-p user-file)) - (setq directory nil) - (setq directory t) - (beep) - (message "%s is a directory" user-file) - (sit-for 2))) - (setcar (ediff-get-session-objA session-info) - (cons user-file user-file)))) - (setcar proposed-file-names - (expand-file-name - (concat actual-dir (car proposed-file-names)))) - (setcdr proposed-file-names - (expand-file-name - (concat actual-dir (cdr proposed-file-names))))) - )) - ediff-patch-map) - ;; Check for the existing files in each pair and discard the nonexisting - ;; ones. If both exist, ask the user. - (mapcar (lambda (session-info) - (let* ((file1 (car (ediff-get-session-objA-name session-info))) - (file2 (cdr (ediff-get-session-objA-name session-info))) - (session-file-object - (ediff-get-session-objA session-info)) - (f1-exists (file-exists-p file1)) - (f2-exists (file-exists-p file2))) - (cond - ((and - ;; The patch program prefers the shortest file as the patch - ;; target. However, this is a questionable heuristic. In an - ;; interactive program, like ediff, we can offer the user a - ;; choice. - ;; (< (length file2) (length file1)) - (not f1-exists) - f2-exists) - ;; replace file-pair with the winning file2 - (setcar session-file-object file2)) - ((and - ;; (< (length file1) (length file2)) - (not f2-exists) - f1-exists) - ;; replace file-pair with the winning file1 - (setcar session-file-object file1)) - ((and f1-exists f2-exists - (string= file1 file2)) - (setcar session-file-object file1)) - ((and f1-exists f2-exists (eq chosen-alternative 1)) - (setcar session-file-object file1)) - ((and f1-exists f2-exists (eq chosen-alternative 2)) - (setcar session-file-object file2)) - ((and f1-exists f2-exists) - (with-output-to-temp-buffer ediff-msg-buffer - (ediff-with-current-buffer standard-output - (fundamental-mode)) - (princ (format " -Ediff has inferred that - %s - %s -are two possible targets for applying the patch. -Both files seem to be plausible alternatives. - -Please advice: - Type `y' to use %s as the target; - Type `n' to use %s as the target. -" - file1 file2 file1 file2))) - (setcar session-file-object - (if (y-or-n-p (format "Use %s ? " file1)) - (progn - (setq chosen-alternative 1) - file1) - (setq chosen-alternative 2) - file2)) - ) - (f2-exists (setcar session-file-object file2)) - (f1-exists (setcar session-file-object file1)) - (t - (with-output-to-temp-buffer ediff-msg-buffer - (ediff-with-current-buffer standard-output - (fundamental-mode)) - (princ "\nEdiff has inferred that") - (if (string= file1 file2) - (princ (format " - %s -is assumed to be the target for this patch. However, this file does not exist." - file1)) - (princ (format " - %s - %s -are two possible targets for this patch. However, these files do not exist." - file1 file2))) - (princ " -\nPlease enter an alternative patch target ...\n")) - (let ((directory t) - target) - (while directory - (setq target (read-file-name - "Please enter a patch target: " - actual-dir actual-dir t)) - (if (not (file-directory-p target)) - (setq directory nil) - (beep) - (message "%s is a directory" target) - (sit-for 2))) - (setcar session-file-object target)))))) - ediff-patch-map) - )) - -(defun ediff-show-patch-diagnostics () - (interactive) - (cond ((window-live-p ediff-window-A) - (set-window-buffer ediff-window-A ediff-patch-diagnostics)) - ((window-live-p ediff-window-B) - (set-window-buffer ediff-window-B ediff-patch-diagnostics)) - (t (display-buffer ediff-patch-diagnostics 'not-this-window)))) - -;; prompt for file, get the buffer -(defun ediff-prompt-for-patch-file () - (let ((dir (cond (ediff-use-last-dir ediff-last-dir-patch) - (ediff-patch-default-directory) ; try patch default dir - (t default-directory))) - (coding-system-for-read ediff-coding-system-for-read) - patch-file-name) - (setq patch-file-name - (read-file-name - (format "Patch is in file%s: " - (cond ((and buffer-file-name - (equal (expand-file-name dir) - (file-name-directory buffer-file-name))) - (concat - " (default " - (file-name-nondirectory buffer-file-name) - ")")) - (t ""))) - dir buffer-file-name 'must-match)) - (if (file-directory-p patch-file-name) - (error "Patch file cannot be a directory: %s" patch-file-name) - (find-file-noselect patch-file-name)) - )) - - -;; Try current buffer, then the other window's buffer. Else, give up. -(defun ediff-prompt-for-patch-buffer () - (get-buffer - (read-buffer - "Buffer that holds the patch: " - (cond ((save-excursion - (goto-char (point-min)) - (re-search-forward ediff-context-diff-label-regexp nil t)) - (current-buffer)) - ((save-window-excursion - (other-window 1) - (save-excursion - (goto-char (point-min)) - (and (re-search-forward ediff-context-diff-label-regexp nil t) - (current-buffer))))) - ((save-window-excursion - (other-window -1) - (save-excursion - (goto-char (point-min)) - (and (re-search-forward ediff-context-diff-label-regexp nil t) - (current-buffer))))) - (t (ediff-other-buffer (current-buffer)))) - 'must-match))) - - -(defun ediff-get-patch-buffer (&optional arg patch-buf) - "Obtain patch buffer. If patch is already in a buffer---use it. -Else, read patch file into a new buffer. If patch buffer is passed as an -optional argument, then use it." - (let ((last-nonmenu-event t) ; Emacs: don't use dialog box - last-command-event) ; XEmacs: don't use dialog box - - (cond ((ediff-buffer-live-p patch-buf)) - ;; even prefix arg: patch in buffer - ((and (integerp arg) (eq 0 (mod arg 2))) - (setq patch-buf (ediff-prompt-for-patch-buffer))) - ;; odd prefix arg: get patch from a file - ((and (integerp arg) (eq 1 (mod arg 2))) - (setq patch-buf (ediff-prompt-for-patch-file))) - (t (setq patch-buf - (if (y-or-n-p "Is the patch already in a buffer? ") - (ediff-prompt-for-patch-buffer) - (ediff-prompt-for-patch-file))))) - - (ediff-with-current-buffer patch-buf - (goto-char (point-min)) - (or (ediff-get-visible-buffer-window patch-buf) - (progn - (pop-to-buffer patch-buf 'other-window) - (select-window (previous-window))))) - (ediff-map-patch-buffer patch-buf) - patch-buf)) - -;; Dispatch the right patch file function: regular or meta-level, -;; depending on how many patches are in the patch file. -;; At present, there is no support for meta-level patches. -;; Should return either the ctl buffer or the meta-buffer -(defun ediff-dispatch-file-patching-job (patch-buf filename - &optional startup-hooks) - (ediff-with-current-buffer patch-buf - ;; relativize names in the patch with respect to source-file - (ediff-fixup-patch-map filename) - (if (< (length ediff-patch-map) 2) - (ediff-patch-file-internal - patch-buf - (if (and ediff-patch-map - (not (string-match - "^/dev/null" - ;; this is the file to patch - (ediff-get-session-objA-name (car ediff-patch-map)))) - (> (length - (ediff-get-session-objA-name (car ediff-patch-map))) - 1)) - (ediff-get-session-objA-name (car ediff-patch-map)) - filename) - startup-hooks) - (ediff-multi-patch-internal patch-buf startup-hooks)) - )) - - -;; When patching a buffer, never change the orig file. Instead, create a new -;; buffer, ***_patched, even if the buff visits a file. -;; Users who want to actually patch the buffer should use -;; ediff-patch-file, not ediff-patch-buffer. -(defun ediff-patch-buffer-internal (patch-buf - buf-to-patch-name - &optional startup-hooks) - (let* ((buf-to-patch (get-buffer buf-to-patch-name)) - (visited-file (if buf-to-patch (buffer-file-name buf-to-patch))) - (buf-mod-status (buffer-modified-p buf-to-patch)) - (multifile-patch-p (> (length (ediff-with-current-buffer patch-buf - ediff-patch-map)) 1)) - default-dir file-name ctl-buf) - (if multifile-patch-p - (error - "To apply multi-file patches, please use `ediff-patch-file'")) - - ;; create a temp file to patch - (ediff-with-current-buffer buf-to-patch - (setq default-dir default-directory) - (setq file-name (ediff-make-temp-file buf-to-patch)) - ;; temporarily switch visited file name, if any - (set-visited-file-name file-name) - ;; don't create auto-save file, if buff was visiting a file - (or visited-file - (setq buffer-auto-save-file-name nil)) - ;; don't confuse the user with a new bufname - (rename-buffer buf-to-patch-name) - (set-buffer-modified-p nil) - (set-visited-file-modtime) ; sync buffer and temp file - (setq default-directory default-dir) - ) - - ;; dispatch a patch function - (setq ctl-buf (ediff-dispatch-file-patching-job - patch-buf file-name startup-hooks)) - - (ediff-with-current-buffer ctl-buf - (delete-file (buffer-file-name ediff-buffer-A)) - (delete-file (buffer-file-name ediff-buffer-B)) - (ediff-with-current-buffer ediff-buffer-A - (if default-dir (setq default-directory default-dir)) - (set-visited-file-name visited-file) ; visited-file might be nil - (rename-buffer buf-to-patch-name) - (set-buffer-modified-p buf-mod-status)) - (ediff-with-current-buffer ediff-buffer-B - (setq buffer-auto-save-file-name nil) ; don't create auto-save file - (if default-dir (setq default-directory default-dir)) - (set-visited-file-name nil) - (rename-buffer (ediff-unique-buffer-name - (concat buf-to-patch-name "_patched") "")) - (set-buffer-modified-p t))) - )) - - -;; Traditional patch has weird return codes. -;; GNU and Posix return 1 if some hanks failed and 2 in case of trouble. -;; 0 is a good code in all cases. -;; We'll do the concervative thing. -(defun ediff-patch-return-code-ok (code) - (eq code 0)) -;;; (if (eq (ediff-test-patch-utility) 'traditional) -;;; (eq code 0) -;;; (not (eq code 2)))) - -(defun ediff-patch-file-internal (patch-buf source-filename - &optional startup-hooks) - (setq source-filename (expand-file-name source-filename)) - - (let* ((shell-file-name ediff-shell) - (patch-diagnostics (get-buffer-create "*ediff patch diagnostics*")) - ;; ediff-find-file may use a temp file to do the patch - ;; so, we save source-filename and true-source-filename as a var - ;; that initially is source-filename but may be changed to a temp - ;; file for the purpose of patching. - (true-source-filename source-filename) - (target-filename source-filename) - ;; this ensures that the patch process gets patch buffer in the - ;; encoding that Emacs thinks is right for that type of text - (coding-system-for-write - (if (boundp 'buffer-file-coding-system) buffer-file-coding-system)) - target-buf buf-to-patch file-name-magic-p - patch-return-code ctl-buf backup-style aux-wind) - - (if (string-match "V" ediff-patch-options) - (error - "Ediff doesn't take the -V option in `ediff-patch-options'--sorry")) - - ;; Make a temp file, if source-filename has a magic file handler (or if - ;; it is handled via auto-mode-alist and similar magic). - ;; Check if there is a buffer visiting source-filename and if they are in - ;; sync; arrange for the deletion of temp file. - (ediff-find-file 'true-source-filename 'buf-to-patch - 'ediff-last-dir-patch 'startup-hooks) - - ;; Check if source file name has triggered black magic, such as file name - ;; handlers or auto mode alist, and make a note of it. - ;; true-source-filename should be either the original name or a - ;; temporary file where we put the after-product of the file handler. - (setq file-name-magic-p (not (equal (file-truename true-source-filename) - (file-truename source-filename)))) - - ;; Checkout orig file, if necessary, so that the patched file - ;; could be checked back in. - (ediff-maybe-checkout buf-to-patch) - - (ediff-with-current-buffer patch-diagnostics - (insert-buffer-substring patch-buf) - (message "Applying patch ... ") - ;; fix environment for gnu patch, so it won't make numbered extensions - (setq backup-style (getenv "VERSION_CONTROL")) - (setenv "VERSION_CONTROL" nil) - (setq patch-return-code - (call-process-region - (point-min) (point-max) - shell-file-name - t ; delete region (which contains the patch - t ; insert output (patch diagnostics) in current buffer - nil ; don't redisplay - shell-command-switch ; usually -c - (format "%s %s %s %s" - ediff-patch-program - ediff-patch-options - ediff-backup-specs - (expand-file-name true-source-filename)) - )) - - ;; restore environment for gnu patch - (setenv "VERSION_CONTROL" backup-style)) - - (message "Applying patch ... done") - (message "") - - (switch-to-buffer patch-diagnostics) - (sit-for 0) ; synchronize - let the user see diagnostics - - (or (and (ediff-patch-return-code-ok patch-return-code) - (file-exists-p - (concat true-source-filename ediff-backup-extension))) - (progn - (with-output-to-temp-buffer ediff-msg-buffer - (ediff-with-current-buffer standard-output - (fundamental-mode)) - (princ (format - "Patch program has failed due to a bad patch file, -it couldn't apply all hunks, OR -it couldn't create the backup for the file being patched. - -The former could be caused by a corrupt patch file or because the %S -program doesn't understand the format of the patch file in use. - -The second problem might be due to an incompatibility among these settings: - ediff-patch-program = %S ediff-patch-options = %S - ediff-backup-extension = %S ediff-backup-specs = %S - -See Ediff on-line manual for more details on these variables. -In particular, check the documentation for `ediff-backup-specs'. - -In any of the above cases, Ediff doesn't compare files automatically. -However, if the patch was applied partially and the backup file was created, -you can still examine the changes via M-x ediff-files" - ediff-patch-program - ediff-patch-program - ediff-patch-options - ediff-backup-extension - ediff-backup-specs - ))) - (beep 1) - (if (setq aux-wind (get-buffer-window ediff-msg-buffer)) - (progn - (select-window aux-wind) - (goto-char (point-max)))) - (switch-to-buffer-other-window patch-diagnostics) - (error "Patch appears to have failed"))) - - ;; If black magic is involved, apply patch to a temp copy of the - ;; file. Otherwise, apply patch to the orig copy. If patch is applied - ;; to temp copy, we name the result old-name_patched for local files - ;; and temp-copy_patched for remote files. The orig file name isn't - ;; changed, and the temp copy of the original is later deleted. - ;; Without magic, the original file is renamed (usually into - ;; old-name_orig) and the result of patching will have the same name as - ;; the original. - (if (not file-name-magic-p) - (ediff-with-current-buffer buf-to-patch - (set-visited-file-name - (concat source-filename ediff-backup-extension)) - (set-buffer-modified-p nil)) - - ;; Black magic in effect. - ;; If orig file was remote, put the patched file in the temp directory. - ;; If orig file is local, put the patched file in the directory of - ;; the orig file. - (setq target-filename - (concat - (if (ediff-file-remote-p (file-truename source-filename)) - true-source-filename - source-filename) - "_patched")) - - (rename-file true-source-filename target-filename t) - - ;; arrange that the temp copy of orig will be deleted - (rename-file (concat true-source-filename ediff-backup-extension) - true-source-filename t)) - - ;; make orig buffer read-only - (setq startup-hooks - (cons 'ediff-set-read-only-in-buf-A startup-hooks)) - - ;; set up a buf for the patched file - (setq target-buf (find-file-noselect target-filename)) - - (setq ctl-buf - (ediff-buffers-internal - buf-to-patch target-buf nil - startup-hooks 'epatch)) - (ediff-with-current-buffer ctl-buf - (setq ediff-patchbufer patch-buf - ediff-patch-diagnostics patch-diagnostics)) - - (bury-buffer patch-diagnostics) - (message "Type `P', if you need to see patch diagnostics") - ctl-buf)) - -(defun ediff-multi-patch-internal (patch-buf &optional startup-hooks) - (let (meta-buf) - (setq startup-hooks - ;; this sets various vars in the meta buffer inside - ;; ediff-prepare-meta-buffer - (cons `(lambda () - ;; tell what to do if the user clicks on a session record - (setq ediff-session-action-function - 'ediff-patch-file-form-meta - ediff-meta-patchbufer patch-buf) ) - startup-hooks)) - (setq meta-buf (ediff-prepare-meta-buffer - 'ediff-filegroup-action - (ediff-with-current-buffer patch-buf - (cons (ediff-make-new-meta-list-header - nil ; regexp - (format "%S" patch-buf) ; obj A - nil nil ; objects B,C - nil ; merge-auto-store-dir - nil ; comparison-func - ) - ediff-patch-map)) - "*Ediff Session Group Panel" - 'ediff-redraw-directory-group-buffer - 'ediff-multifile-patch - startup-hooks)) - (ediff-show-meta-buffer meta-buf) - )) - - - -(provide 'ediff-ptch) - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; arch-tag: 2fe2161e-e116-469b-90fa-5cbb44c1bd1b -;;; ediff-ptch.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-tbar.el b/xemacs-packages/lisp/ediff/ediff-tbar.el deleted file mode 100644 index 07f0f004..00000000 --- a/xemacs-packages/lisp/ediff/ediff-tbar.el +++ /dev/null @@ -1,377 +0,0 @@ -;;; ediff-tbar.el --- A toolbar for Ediff control buffer - -;; Copyright (C) 1996, 97, 2002, 2003, 2004, 2005, -;; 2006 Free Software Foundation, Inc. - -;; Author: Marc Paquette - -;; 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. - -;;; Code: - - -;; compiler pacifier -(eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - (or (featurep 'ediff-util) - (load "ediff-util.el" nil nil 'nosuffix)) - )) -(defvar toolbar-icon-directory) -;; end pacifier - -(require 'ediff-init) - -(defvar ediff-toolbar-icon-directory - (if (and ediff-xemacs-p (featurep 'toolbar)) - (let ((dir (locate-data-directory "ediff"))) - (if (stringp dir) - dir - toolbar-icon-directory)) - "Where the Ediff toolbar icons are.")) - -(defvar ediff-use-toolbar-p nil - "If t, Ediff will use a toolbar for the control frame. -This has an effect only if your emacs supports Toolbars. -Currently, XEmacs does, but not Emacs. -Do not change the value of this variable interactively. -This should be done only via the menu bar or by executing -`ediff-toggle-use-toolbar'.") - -(defcustom ediff-use-toolbar-p nil - "*If t, Ediff will use a toolbar for the control frame. -This has an effect only if your emacs supports Toolbars. -Currently, XEmacs does, but Emacs doesn't. -This variable can be changed only via the menu bar or -through the Emacs customization widget." - :type 'boolean - :set (lambda (widget value) - (or (eq value ediff-use-toolbar-p) - (ediff-toggle-use-toolbar))) - :group 'ediff) - -(defvar ediff-toolbar-height 21 - "The height of the Ediff toolbar. -The value must match the actual size of the toolbar icons.") - -(defvar ediff-toolbar-width 200.0 - "The width of the Ediff toolbar. -The value must match the actual width of the toolbar. -Here's an example: - There are 10 buttons, each 15 pixels large, and the shadows occupy 2 - pixels each side, and the last button is right-justified (so we reserve - about 30 pixels for fill space) = 200 pixels.") - - -;; Here the toolbar width is not the same width talked about in XEmacs -;; lispref info documentation : it is the minimal width needed by -;; ediff's toolbar to display all buttons, for an horizontal toolbar. -;; Ideally, we would query the toolbar for the width of each button -;; and add them, but I didn't find query functions in the doc on -;; toolbars. Therefore, I use a static number of pixels that should -;; be adjusted if the toolbar gets more or loses some buttons. --marcpa -(defun ediff-compute-toolbar-width () - (if (not (ediff-use-toolbar-p)) - 0 - (ceiling (/ ediff-toolbar-width (font-instance-width (face-font-instance 'default)))))) - -(defvar ediff-toolbar-next-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - (if (featurep 'xpm) "ediff-next.xpm" "ediff-next.xbm") - ediff-toolbar-icon-directory))) - "Next difference icon in toolbar.") - -(defvar ediff-toolbar-previous-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - (if (featurep 'xpm) "ediff-prev.xpm" "ediff-prev.xbm") - ediff-toolbar-icon-directory))) - "Previous difference icon in toolbar.") - -(defvar ediff-toolbar-A-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - ;; UP - (if (featurep 'xpm) "ediff-A-up.xpm" "ediff-A-up.xbm") - ediff-toolbar-icon-directory) - (expand-file-name - ;; DOWN - (if (featurep 'xpm) "ediff-A-up.xpm" "ediff-A-up.xbm") - ediff-toolbar-icon-directory) - (expand-file-name - ;; DISABLED - (if (featurep 'xpm) "ediff-A-xx.xpm" "ediff-A-up.xbm") - ediff-toolbar-icon-directory) - )) - "Select diff A icon in toolbar.") - -(defvar ediff-toolbar-B-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - ;; UP - (if (featurep 'xpm) "ediff-B-up.xpm" "ediff-B-up.xbm") - ediff-toolbar-icon-directory) - (expand-file-name - ;; DOWN - (if (featurep 'xpm) "ediff-B-up.xpm" "ediff-B-up.xbm") - ediff-toolbar-icon-directory) - (expand-file-name - ;; DISABLED - (if (featurep 'xpm) "ediff-B-xx.xpm" "ediff-B-up.xbm") - ediff-toolbar-icon-directory) - )) - "Select diff B icon in toolbar.") - -(defvar ediff-toolbar-toggle-split-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - ;; UP - (if (featurep 'xpm) - "ediff-toggle-split-up.xpm" "ediff-toggle-split-up.xbm") - ediff-toolbar-icon-directory) - )) - "Toggle split mode between side-to-side and one-on-top-of-another.") - -(defvar ediff-toolbar-save-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - ;; UP - (if (featurep 'xpm) "ediff-save.xpm" "ediff-save.xbm") - ediff-toolbar-icon-directory) - (expand-file-name - ;; DOWN - (if (featurep 'xpm) "ediff-save.xpm" "ediff-save.xbm") - ediff-toolbar-icon-directory) - (expand-file-name - ;; DISABLED - (if (featurep 'xpm) "ediff-save-xx.xpm" "ediff-save-xx.xbm") - ediff-toolbar-icon-directory) - )) - "Save merge buffer.") - -(defvar ediff-toolbar-quit-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - (if (featurep 'xpm) "ediff-quit.xpm" "ediff-quit.xbm") - ediff-toolbar-icon-directory))) - "Exit Ediff session.") - -(defvar ediff-toolbar-help-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - (if (featurep 'xpm) "ediff-help.xpm" "ediff-help.xbm") - ediff-toolbar-icon-directory))) - "Show Ediff help.") - -(defvar ediff-toolbar-refresh-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - (if (featurep 'xpm) "ediff-update.xpm" "ediff-update.xbm") - ediff-toolbar-icon-directory))) - "Refresh Ediff display (aka recenter).") - -(defvar ediff-toolbar-refine-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name - ;; UP - (if (featurep 'xpm) "ediff-refine.xpm" "ediff-refine.xbm") - ediff-toolbar-icon-directory) - )) - "Refine current difference region by computing fine diffs.") - -(defun ediff-toolbar-previous-difference () - (interactive) - (let ((ediff-grab-mouse nil)) - (ediff-previous-difference 1))) - -(defun ediff-toolbar-next-difference () - (interactive) - (let ((ediff-grab-mouse nil)) - (ediff-next-difference 1))) - -(defun ediff-toolbar-select/copy-A () - (interactive) - (let ((ediff-grab-mouse nil)) - (cond ((or (ediff-merge-job) - (ediff-merge-with-ancestor-job)) - (ediff-copy-A-to-C nil)) - (t - (ediff-copy-A-to-B nil))))) - -(defun ediff-toolbar-select/copy-B () - (interactive) - (let ((ediff-grab-mouse nil)) - (cond ((or (ediff-merge-job) - (ediff-merge-with-ancestor-job)) - (ediff-copy-B-to-C nil)) - (t - (ediff-copy-B-to-A nil))))) - -(defun ediff-toolbar-toggle-split () - (interactive) - (let ((ediff-grab-mouse nil)) - (ediff-toggle-split))) - - -(defun ediff-toolbar-save () - (interactive) - (ediff-barf-if-not-control-buffer) - (if (ediff-merge-job) - (ediff-maybe-save-and-delete-merge 'save-and-continue) - ;; 2-way or 3-way compare: save modified buffers - (mapcar (lambda (type) - (let ((ebuf (ediff-get-buffer type))) - (and (ediff-buffer-live-p ebuf) - (ediff-with-current-buffer ebuf - (and (buffer-modified-p) - (save-buffer)))))) - '(A B C)))) - - -(defun ediff-toolbar-quit () - (interactive) - (let ((ediff-grab-mouse nil)) - (ediff-quit nil))) - -(defun ediff-toolbar-help () - (interactive) - (ediff-toggle-help)) - -(defun ediff-toolbar-refresh () - "Recenter" - (interactive) - (let ((ediff-grab-mouse nil)) - (ediff-recenter))) - -(defun ediff-toolbar-refine () - "Refine current difference region by computing fine diffs." - (interactive) - (let ((ediff-grab-mouse nil)) - (ediff-make-or-kill-fine-diffs 'make-them))) - -(defun ediff-toolbar-refine-needed-p () - (and (> ediff-current-difference 0) - (> ediff-auto-refine-limit - (- (ediff-get-diff-posn 'A 'end ediff-current-difference) - (ediff-get-diff-posn 'A 'beg ediff-current-difference))))) - -(defvar ediff-toolbar - (if (featurep 'toolbar) - '([ediff-toolbar-refine-icon - ediff-toolbar-refine - t - "Refine current difference region by computing fine diffs."] - [ediff-toolbar-previous-icon - ediff-toolbar-previous-difference - t - "Go to the previous difference."] - [ediff-toolbar-next-icon - ediff-toolbar-next-difference - t - "Advance to the next difference."] - [ediff-toolbar-A-icon - ediff-toolbar-select/copy-A - (not (ediff-3way-comparison-job)) - "Select/Copy difference A."] - [ediff-toolbar-B-icon - ediff-toolbar-select/copy-B - (not (ediff-3way-comparison-job)) - "Select/Copy difference B."] - [ediff-toolbar-save-icon - ediff-toolbar-save - t - "Save buffers modified in this session."] - [ediff-toolbar-refresh-icon - ediff-toolbar-refresh - t - "Refresh Ediff display (aka recenter)."] - [ediff-toolbar-toggle-split-icon - ediff-toolbar-toggle-split - t - "Toggle split mode between side-to-side and one-on-top-of-another."] - [ediff-toolbar-help-icon - ediff-toolbar-help - t - "Toggle short/long help."] - nil - [ediff-toolbar-quit-icon - ediff-toolbar-quit - t - "Quit this ediff session."] - ))) - -(defvar ediff-toolbar-3way - (if (featurep 'toolbar) - '([ediff-toolbar-refine-icon - ediff-toolbar-refine - t - "Refine current difference region by computing fine diffs."] - [ediff-toolbar-previous-icon - ediff-toolbar-previous-difference - t - "Go to the previous difference."] - [ediff-toolbar-next-icon - ediff-toolbar-next-difference - t - "Advance to the next difference."] - [ediff-toolbar-save-icon - ediff-toolbar-save - t - "Save buffers modified in this session."] - [ediff-toolbar-refresh-icon - ediff-toolbar-refresh - t - "Refresh Ediff display (aka recenter)."] - [ediff-toolbar-toggle-split-icon - ediff-toolbar-toggle-split - t - "Toggle split mode between side-to-side and one-on-top-of-another."] - [ediff-toolbar-help-icon - ediff-toolbar-help - t - "Toggle short/long help."] - nil - [ediff-toolbar-quit-icon - ediff-toolbar-quit - t - "Quit this ediff session."] - ))) - - -(provide 'ediff-tbar) - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; ediff-tbar.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-util.el b/xemacs-packages/lisp/ediff/ediff-util.el deleted file mode 100644 index dff3c6be..00000000 --- a/xemacs-packages/lisp/ediff/ediff-util.el +++ /dev/null @@ -1,4315 +0,0 @@ -;;; ediff-util.el --- the core commands and utilities of ediff - -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - - -;; Compiler pacifier -(defvar ediff-patch-diagnostics) -(defvar ediff-patchbufer) -(defvar ediff-use-toolbar-p) -(defvar ediff-toolbar-height) -(defvar ediff-toolbar) -(defvar ediff-toolbar-3way) -(defvar bottom-toolbar) -(defvar bottom-toolbar-visible-p) -(defvar bottom-toolbar-height) -(defvar mark-active) -(defvar ediff-emacs-p) - -(defvar ediff-after-quit-hook-internal nil) - -(and noninteractive - (eval-when-compile - (load "reporter" 'noerror))) - -(eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (provide 'ediff-util) ; to break recursive load cycle - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - (or (featurep 'ediff-help) - (load "ediff-help.el" nil nil 'nosuffix)) - (or (featurep 'ediff-mult) - (load "ediff-mult.el" nil nil 'nosuffix)) - (or (featurep 'ediff-wind) - (load "ediff-wind.el" nil nil 'nosuffix)) - (or (featurep 'ediff-diff) - (load "ediff-diff.el" nil nil 'nosuffix)) - (or (featurep 'ediff-merg) - (load "ediff-merg.el" nil nil 'nosuffix)) - (or (featurep 'ediff) - (load "ediff.el" nil nil 'nosuffix)) - (or (featurep 'ediff-tbar) - ediff-emacs-p - (load "ediff-tbar.el" 'noerror nil 'nosuffix)) - )) -;; end pacifier - - -(require 'ediff-init) -(require 'ediff-help) -(require 'ediff-mult) -(require 'ediff-wind) -(require 'ediff-diff) -(require 'ediff-merg) - -(if ediff-xemacs-p - (require 'ediff-tbar)) - - -;;; Functions - -(defun ediff-mode () - "Ediff mode controls all operations in a single Ediff session. -This mode is entered through one of the following commands: - `ediff' - `ediff-files' - `ediff-buffers' - `ebuffers' - `ediff3' - `ediff-files3' - `ediff-buffers3' - `ebuffers3' - `ediff-merge' - `ediff-merge-files' - `ediff-merge-files-with-ancestor' - `ediff-merge-buffers' - `ediff-merge-buffers-with-ancestor' - `ediff-merge-revisions' - `ediff-merge-revisions-with-ancestor' - `ediff-windows-wordwise' - `ediff-windows-linewise' - `ediff-regions-wordwise' - `ediff-regions-linewise' - `epatch' - `ediff-patch-file' - `ediff-patch-buffer' - `epatch-buffer' - `erevision' - `ediff-revision' - -Commands: -\\{ediff-mode-map}" - (kill-all-local-variables) - (setq major-mode 'ediff-mode) - (setq mode-name "Ediff") - ;; We use run-hooks instead of run-mode-hooks for two reasons. - ;; The ediff control buffer is read-only and it is not supposed to be - ;; modified by minor modes and such. So, run-mode-hooks doesn't do anything - ;; useful here on top of what run-hooks does. - ;; Second, changing run-hooks to run-mode-hooks would require an - ;; if-statement, since XEmacs doesn't have this. - (run-hooks 'ediff-mode-hook)) - - - -;;; Build keymaps - -(ediff-defvar-local ediff-mode-map nil - "Local keymap used in Ediff mode. -This is local to each Ediff Control Panel, so they may vary from invocation -to invocation.") - -;; Set up the keymap in the control buffer -(defun ediff-set-keys () - "Set up Ediff keymap, if necessary." - (if (null ediff-mode-map) - (ediff-setup-keymap)) - (use-local-map ediff-mode-map)) - -;; Reload Ediff keymap. For debugging only. -(defun ediff-reload-keymap () - (interactive) - (setq ediff-mode-map nil) - (ediff-set-keys)) - - -(defun ediff-setup-keymap () - "Set up the keymap used in the control buffer of Ediff." - (setq ediff-mode-map (make-sparse-keymap)) - (suppress-keymap ediff-mode-map) - - (define-key ediff-mode-map - (if ediff-emacs-p [mouse-2] [button2]) 'ediff-help-for-quick-help) - (define-key ediff-mode-map "\C-m" 'ediff-help-for-quick-help) - - (define-key ediff-mode-map "p" 'ediff-previous-difference) - (define-key ediff-mode-map "\C-?" 'ediff-previous-difference) - (define-key ediff-mode-map [delete] 'ediff-previous-difference) - (define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer - 'ediff-previous-difference nil)) - ;; must come after C-h, or else C-h wipes out backspace's binding in XEmacs - (define-key ediff-mode-map [backspace] 'ediff-previous-difference) - (define-key ediff-mode-map "n" 'ediff-next-difference) - (define-key ediff-mode-map " " 'ediff-next-difference) - (define-key ediff-mode-map "j" 'ediff-jump-to-difference) - (define-key ediff-mode-map "g" nil) - (define-key ediff-mode-map "ga" 'ediff-jump-to-difference-at-point) - (define-key ediff-mode-map "gb" 'ediff-jump-to-difference-at-point) - (define-key ediff-mode-map "q" 'ediff-quit) - (define-key ediff-mode-map "D" 'ediff-show-diff-output) - (define-key ediff-mode-map "z" 'ediff-suspend) - (define-key ediff-mode-map "\C-l" 'ediff-recenter) - (define-key ediff-mode-map "|" 'ediff-toggle-split) - (define-key ediff-mode-map "h" 'ediff-toggle-hilit) - (or ediff-word-mode - (define-key ediff-mode-map "@" 'ediff-toggle-autorefine)) - (if ediff-narrow-job - (define-key ediff-mode-map "%" 'ediff-toggle-narrow-region)) - (define-key ediff-mode-map "~" 'ediff-swap-buffers) - (define-key ediff-mode-map "v" 'ediff-scroll-vertically) - (define-key ediff-mode-map "\C-v" 'ediff-scroll-vertically) - (define-key ediff-mode-map "^" 'ediff-scroll-vertically) - (define-key ediff-mode-map "\M-v" 'ediff-scroll-vertically) - (define-key ediff-mode-map "V" 'ediff-scroll-vertically) - (define-key ediff-mode-map "<" 'ediff-scroll-horizontally) - (define-key ediff-mode-map ">" 'ediff-scroll-horizontally) - (define-key ediff-mode-map "i" 'ediff-status-info) - (define-key ediff-mode-map "E" 'ediff-documentation) - (define-key ediff-mode-map "?" 'ediff-toggle-help) - (define-key ediff-mode-map "!" 'ediff-update-diffs) - (define-key ediff-mode-map "M" 'ediff-show-current-session-meta-buffer) - (define-key ediff-mode-map "R" 'ediff-show-registry) - (or ediff-word-mode - (define-key ediff-mode-map "*" 'ediff-make-or-kill-fine-diffs)) - (define-key ediff-mode-map "a" nil) - (define-key ediff-mode-map "b" nil) - (define-key ediff-mode-map "r" nil) - (cond (ediff-merge-job - ;; Will barf if no ancestor - (define-key ediff-mode-map "/" 'ediff-show-ancestor) - ;; In merging, we allow only A->C and B->C copying. - (define-key ediff-mode-map "a" 'ediff-copy-A-to-C) - (define-key ediff-mode-map "b" 'ediff-copy-B-to-C) - (define-key ediff-mode-map "r" 'ediff-restore-diff-in-merge-buffer) - (define-key ediff-mode-map "s" 'ediff-shrink-window-C) - (define-key ediff-mode-map "+" 'ediff-combine-diffs) - (define-key ediff-mode-map "$" nil) - (define-key ediff-mode-map "$$" 'ediff-toggle-show-clashes-only) - (define-key ediff-mode-map "$*" 'ediff-toggle-skip-changed-regions) - (define-key ediff-mode-map "&" 'ediff-re-merge)) - (ediff-3way-comparison-job - (define-key ediff-mode-map "ab" 'ediff-copy-A-to-B) - (define-key ediff-mode-map "ba" 'ediff-copy-B-to-A) - (define-key ediff-mode-map "ac" 'ediff-copy-A-to-C) - (define-key ediff-mode-map "bc" 'ediff-copy-B-to-C) - (define-key ediff-mode-map "c" nil) - (define-key ediff-mode-map "ca" 'ediff-copy-C-to-A) - (define-key ediff-mode-map "cb" 'ediff-copy-C-to-B) - (define-key ediff-mode-map "ra" 'ediff-restore-diff) - (define-key ediff-mode-map "rb" 'ediff-restore-diff) - (define-key ediff-mode-map "rc" 'ediff-restore-diff) - (define-key ediff-mode-map "C" 'ediff-toggle-read-only)) - (t ; 2-way comparison - (define-key ediff-mode-map "a" 'ediff-copy-A-to-B) - (define-key ediff-mode-map "b" 'ediff-copy-B-to-A) - (define-key ediff-mode-map "ra" 'ediff-restore-diff) - (define-key ediff-mode-map "rb" 'ediff-restore-diff)) - ) ; cond - (define-key ediff-mode-map "G" 'ediff-submit-report) - (define-key ediff-mode-map "#" nil) - (define-key ediff-mode-map "#h" 'ediff-toggle-regexp-match) - (define-key ediff-mode-map "#f" 'ediff-toggle-regexp-match) - (define-key ediff-mode-map "#c" 'ediff-toggle-ignore-case) - (or ediff-word-mode - (define-key ediff-mode-map "##" 'ediff-toggle-skip-similar)) - (define-key ediff-mode-map "o" nil) - (define-key ediff-mode-map "A" 'ediff-toggle-read-only) - (define-key ediff-mode-map "B" 'ediff-toggle-read-only) - (define-key ediff-mode-map "w" nil) - (define-key ediff-mode-map "wa" 'ediff-save-buffer) - (define-key ediff-mode-map "wb" 'ediff-save-buffer) - (define-key ediff-mode-map "wd" 'ediff-save-buffer) - (define-key ediff-mode-map "=" 'ediff-inferior-compare-regions) - (if (and (fboundp 'ediff-show-patch-diagnostics) (ediff-patch-job)) - (define-key ediff-mode-map "P" 'ediff-show-patch-diagnostics)) - (if ediff-3way-job - (progn - (define-key ediff-mode-map "wc" 'ediff-save-buffer) - (define-key ediff-mode-map "gc" 'ediff-jump-to-difference-at-point) - )) - - (define-key ediff-mode-map "m" 'ediff-toggle-wide-display) - - ;; Allow ediff-mode-map to be referenced indirectly - (fset 'ediff-mode-map ediff-mode-map) - (run-hooks 'ediff-keymap-setup-hook)) - - -;;; Setup functions - -;; Common startup entry for all Ediff functions It now returns control buffer -;; so other functions can do post-processing SETUP-PARAMETERS is a list of the -;; form ((param .val) (param . val)...) This serves a similar purpose to -;; STARTUP-HOOKS, but these parameters are set in the new control buffer right -;; after this buf is created and before any windows are set and such. -(defun ediff-setup (buffer-A file-A buffer-B file-B buffer-C file-C - startup-hooks setup-parameters - &optional merge-buffer-file) - (run-hooks 'ediff-before-setup-hook) - ;; ediff-convert-standard-filename puts file names in the form appropriate - ;; for the OS at hand. - (setq file-A (ediff-convert-standard-filename (expand-file-name file-A))) - (setq file-B (ediff-convert-standard-filename (expand-file-name file-B))) - (if (stringp file-C) - (setq file-C - (ediff-convert-standard-filename (expand-file-name file-C)))) - (if (stringp merge-buffer-file) - (progn - (setq merge-buffer-file - (ediff-convert-standard-filename - (expand-file-name merge-buffer-file))) - ;; check the directory exists - (or (file-exists-p (file-name-directory merge-buffer-file)) - (error "Directory %s given as place to save the merge doesn't exist" - (abbreviate-file-name - (file-name-directory merge-buffer-file)))) - (if (and (file-exists-p merge-buffer-file) - (file-directory-p merge-buffer-file)) - (error "The merge buffer file %s must not be a directory" - (abbreviate-file-name merge-buffer-file))) - )) - (let* ((control-buffer-name - (ediff-unique-buffer-name "*Ediff Control Panel" "*")) - (control-buffer (ediff-with-current-buffer buffer-A - (get-buffer-create control-buffer-name)))) - (ediff-with-current-buffer control-buffer - (ediff-mode) - - (make-local-variable 'ediff-use-long-help-message) - (make-local-variable 'ediff-prefer-iconified-control-frame) - (make-local-variable 'ediff-split-window-function) - (make-local-variable 'ediff-default-variant) - (make-local-variable 'ediff-merge-window-share) - (make-local-variable 'ediff-window-setup-function) - (make-local-variable 'ediff-keep-variants) - - (ediff-cond-compile-for-xemacs-or-emacs - (make-local-hook 'ediff-after-quit-hook-internal) ; xemacs form - nil ; emacs form - ) - - ;; unwrap set up parameters passed as argument - (while setup-parameters - (set (car (car setup-parameters)) (cdr (car setup-parameters))) - (setq setup-parameters (cdr setup-parameters))) - - ;; set variables classifying the current ediff job - ;; must come AFTER setup-parameters - (setq ediff-3way-comparison-job (ediff-3way-comparison-job) - ediff-merge-job (ediff-merge-job) - ediff-merge-with-ancestor-job (ediff-merge-with-ancestor-job) - ediff-3way-job (ediff-3way-job) - ediff-diff3-job (ediff-diff3-job) - ediff-narrow-job (ediff-narrow-job) - ediff-windows-job (ediff-windows-job) - ediff-word-mode-job (ediff-word-mode-job)) - - ;; Don't delete variants in case of ediff-buffer-* jobs without asking. - ;; This is because one may loose work---dangerous. - (if (string-match "buffer" (symbol-name ediff-job-name)) - (setq ediff-keep-variants t)) - - (ediff-cond-compile-for-xemacs-or-emacs - (make-local-hook 'pre-command-hook) ; xemacs form - nil ; emacs form - ) - - (if (ediff-window-display-p) - (add-hook 'pre-command-hook 'ediff-spy-after-mouse nil 'local)) - (setq ediff-mouse-pixel-position (mouse-pixel-position)) - - ;; adjust for merge jobs - (if ediff-merge-job - (let ((buf - ;; If default variant is `combined', the right stuff is - ;; inserted by ediff-do-merge - ;; Note: at some point, we tried to put ancestor buffer here - ;; (which is currently buffer C. This didn't work right - ;; because the merge buffer will contain lossage: diff regions - ;; in the ancestor, which correspond to revisions that agree - ;; in both buf A and B. - (cond ((eq ediff-default-variant 'default-B) - buffer-B) - (t buffer-A)))) - - (setq ediff-split-window-function - ediff-merge-split-window-function) - - ;; remember the ancestor buffer, if any - (setq ediff-ancestor-buffer buffer-C) - - (setq buffer-C - (get-buffer-create - (ediff-unique-buffer-name "*ediff-merge" "*"))) - (save-excursion - (set-buffer buffer-C) - (insert-buffer-substring buf) - (goto-char (point-min)) - (funcall (ediff-with-current-buffer buf major-mode)) - (widen) ; merge buffer is always widened - (add-hook 'local-write-file-hooks 'ediff-set-merge-mode nil t) - ))) - (setq buffer-read-only nil - ediff-buffer-A buffer-A - ediff-buffer-B buffer-B - ediff-buffer-C buffer-C - ediff-control-buffer control-buffer) - - (ediff-choose-syntax-table) - - (setq ediff-control-buffer-suffix - (if (string-match "<[0-9]*>" control-buffer-name) - (substring control-buffer-name - (match-beginning 0) (match-end 0)) - "") - ediff-control-buffer-number - (max - 0 - (1- - (string-to-number - (substring - ediff-control-buffer-suffix - (or - (string-match "[0-9]+" ediff-control-buffer-suffix) - 0)))))) - - (setq ediff-error-buffer - (get-buffer-create (ediff-unique-buffer-name "*ediff-errors" "*"))) - - (ediff-with-current-buffer buffer-A (ediff-strip-mode-line-format)) - (ediff-with-current-buffer buffer-B (ediff-strip-mode-line-format)) - (if ediff-3way-job - (ediff-with-current-buffer buffer-C (ediff-strip-mode-line-format))) - (if (ediff-buffer-live-p ediff-ancestor-buffer) - (ediff-with-current-buffer ediff-ancestor-buffer - (ediff-strip-mode-line-format))) - - (ediff-save-protected-variables) ; save variables to be restored on exit - - ;; ediff-setup-diff-regions-function must be set after setup - ;; parameters are processed. - (setq ediff-setup-diff-regions-function - (if ediff-diff3-job - 'ediff-setup-diff-regions3 - 'ediff-setup-diff-regions)) - - (setq ediff-wide-bounds - (list (ediff-make-bullet-proof-overlay - '(point-min) '(point-max) ediff-buffer-A) - (ediff-make-bullet-proof-overlay - '(point-min) '(point-max) ediff-buffer-B) - (ediff-make-bullet-proof-overlay - '(point-min) '(point-max) ediff-buffer-C))) - - ;; This has effect only on ediff-windows/regions - ;; In all other cases, ediff-visible-region sets visibility bounds to - ;; ediff-wide-bounds, and ediff-narrow-bounds are ignored. - (if ediff-start-narrowed - (setq ediff-visible-bounds ediff-narrow-bounds) - (setq ediff-visible-bounds ediff-wide-bounds)) - - (ediff-set-keys) ; comes after parameter setup - - ;; set up ediff-narrow-bounds, if not set - (or ediff-narrow-bounds - (setq ediff-narrow-bounds ediff-wide-bounds)) - - ;; All these must be inside ediff-with-current-buffer control-buffer, - ;; since these vars are local to control-buffer - ;; These won't run if there are errors in diff - (ediff-with-current-buffer ediff-buffer-A - (ediff-nuke-selective-display) - (run-hooks 'ediff-prepare-buffer-hook) - (if (ediff-with-current-buffer control-buffer ediff-merge-job) - (setq buffer-read-only t)) - ;; add control-buffer to the list of sessions--no longer used, but may - ;; be used again in the future - (or (memq control-buffer ediff-this-buffer-ediff-sessions) - (setq ediff-this-buffer-ediff-sessions - (cons control-buffer ediff-this-buffer-ediff-sessions))) - (if ediff-make-buffers-readonly-at-startup - (setq buffer-read-only t)) - ) - - (ediff-with-current-buffer ediff-buffer-B - (ediff-nuke-selective-display) - (run-hooks 'ediff-prepare-buffer-hook) - (if (ediff-with-current-buffer control-buffer ediff-merge-job) - (setq buffer-read-only t)) - ;; add control-buffer to the list of sessions - (or (memq control-buffer ediff-this-buffer-ediff-sessions) - (setq ediff-this-buffer-ediff-sessions - (cons control-buffer ediff-this-buffer-ediff-sessions))) - (if ediff-make-buffers-readonly-at-startup - (setq buffer-read-only t)) - ) - - (if ediff-3way-job - (ediff-with-current-buffer ediff-buffer-C - (ediff-nuke-selective-display) - ;; the merge bufer should never be narrowed - ;; (it can happen if it is on rmail-mode or similar) - (if (ediff-with-current-buffer control-buffer ediff-merge-job) - (widen)) - (run-hooks 'ediff-prepare-buffer-hook) - ;; add control-buffer to the list of sessions - (or (memq control-buffer ediff-this-buffer-ediff-sessions) - (setq ediff-this-buffer-ediff-sessions - (cons control-buffer - ediff-this-buffer-ediff-sessions))) - (if ediff-make-buffers-readonly-at-startup - (setq buffer-read-only t) - (setq buffer-read-only nil)) - )) - - (if (ediff-buffer-live-p ediff-ancestor-buffer) - (ediff-with-current-buffer ediff-ancestor-buffer - (ediff-nuke-selective-display) - (setq buffer-read-only t) - (run-hooks 'ediff-prepare-buffer-hook) - (or (memq control-buffer ediff-this-buffer-ediff-sessions) - (setq ediff-this-buffer-ediff-sessions - (cons control-buffer - ediff-this-buffer-ediff-sessions))) - )) - - ;; the following must be after setting up ediff-narrow-bounds AND after - ;; nuking selective display - (funcall ediff-setup-diff-regions-function file-A file-B file-C) - (setq ediff-number-of-differences (length ediff-difference-vector-A)) - (setq ediff-current-difference -1) - - (ediff-make-current-diff-overlay 'A) - (ediff-make-current-diff-overlay 'B) - (if ediff-3way-job - (ediff-make-current-diff-overlay 'C)) - (if ediff-merge-with-ancestor-job - (ediff-make-current-diff-overlay 'Ancestor)) - - (ediff-setup-windows buffer-A buffer-B buffer-C control-buffer) - - (let ((shift-A (ediff-overlay-start - (ediff-get-value-according-to-buffer-type - 'A ediff-narrow-bounds))) - (shift-B (ediff-overlay-start - (ediff-get-value-according-to-buffer-type - 'B ediff-narrow-bounds))) - (shift-C (ediff-overlay-start - (ediff-get-value-according-to-buffer-type - 'C ediff-narrow-bounds)))) - ;; position point in buf A - (save-excursion - (select-window ediff-window-A) - (goto-char shift-A)) - ;; position point in buf B - (save-excursion - (select-window ediff-window-B) - (goto-char shift-B)) - (if ediff-3way-job - (save-excursion - (select-window ediff-window-C) - (goto-char shift-C))) - ) - - (select-window ediff-control-window) - (ediff-visible-region) - - (run-hooks 'startup-hooks) - (ediff-arrange-autosave-in-merge-jobs merge-buffer-file) - - (ediff-refresh-mode-lines) - (setq buffer-read-only t) - (setq ediff-session-registry - (cons control-buffer ediff-session-registry)) - (ediff-update-registry) - (if (ediff-buffer-live-p ediff-meta-buffer) - (ediff-update-meta-buffer - ediff-meta-buffer nil ediff-meta-session-number)) - (run-hooks 'ediff-startup-hook) - ) ; eval in control-buffer - control-buffer)) - - -;; This function assumes that we are in the window where control buffer is -;; to reside. -(defun ediff-setup-control-buffer (ctl-buf) - "Set up window for control buffer." - (if (window-dedicated-p (selected-window)) - (set-buffer ctl-buf) ; we are in control frame but just in case - (switch-to-buffer ctl-buf)) - (let ((window-min-height 2)) - (erase-buffer) - (ediff-set-help-message) - (insert ediff-help-message) - (shrink-window-if-larger-than-buffer) - (or (ediff-multiframe-setup-p) - (ediff-indent-help-message)) - (ediff-set-help-overlays) - - (set-buffer-modified-p nil) - (ediff-refresh-mode-lines) - (setq ediff-control-window (selected-window)) - (setq ediff-window-config-saved - (format "%S%S%S%S%S%S%S" - ediff-control-window - ediff-window-A - ediff-window-B - ediff-window-C - ediff-split-window-function - (ediff-multiframe-setup-p) - ediff-wide-display-p)) - - ;; In multiframe, toolbar is set in ediff-setup-control-frame - (if (not (ediff-multiframe-setup-p)) - (ediff-make-bottom-toolbar)) ; this checks if toolbar is requested - (goto-char (point-min)) - (skip-chars-forward ediff-whitespace))) - -;; This executes in control buffer and sets auto-save, visited file name, etc, -;; in the merge buffer -(defun ediff-arrange-autosave-in-merge-jobs (merge-buffer-file) - (if (not ediff-merge-job) - () - (if (stringp merge-buffer-file) - (setq ediff-autostore-merges t - ediff-merge-store-file merge-buffer-file)) - (if (stringp ediff-merge-store-file) - (progn - ;; save before leaving ctl buffer - (ediff-verify-file-merge-buffer ediff-merge-store-file) - (setq merge-buffer-file ediff-merge-store-file) - (ediff-with-current-buffer ediff-buffer-C - (set-visited-file-name merge-buffer-file)))) - (ediff-with-current-buffer ediff-buffer-C - (setq buffer-offer-save t) ; ask before killing buffer - ;; make sure the contents is auto-saved - (auto-save-mode 1)) - )) - - -;;; Commands for working with Ediff - -(defun ediff-update-diffs () - "Recompute difference regions in buffers A, B, and C. -Buffers are not synchronized with their respective files, so changes done -to these buffers are not saved at this point---the user can do this later, -if necessary." - (interactive) - (ediff-barf-if-not-control-buffer) - (if (and (ediff-buffer-live-p ediff-ancestor-buffer) - (not - (y-or-n-p - "Ancestor buffer will not be used. Recompute diffs anyway? "))) - (error "Recomputation of differences canceled")) - - (let ((point-A (ediff-with-current-buffer ediff-buffer-A (point))) - ;;(point-B (ediff-with-current-buffer ediff-buffer-B (point))) - (tmp-buffer (get-buffer-create ediff-tmp-buffer)) - (buf-A-file-name (buffer-file-name ediff-buffer-A)) - (buf-B-file-name (buffer-file-name ediff-buffer-B)) - ;; (null ediff-buffer-C) is no problem, as we later check if - ;; ediff-buffer-C is alive - (buf-C-file-name (buffer-file-name ediff-buffer-C)) - (overl-A (ediff-get-value-according-to-buffer-type - 'A ediff-narrow-bounds)) - (overl-B (ediff-get-value-according-to-buffer-type - 'B ediff-narrow-bounds)) - (overl-C (ediff-get-value-according-to-buffer-type - 'C ediff-narrow-bounds)) - beg-A end-A beg-B end-B beg-C end-C - file-A file-B file-C) - - (if (stringp buf-A-file-name) - (setq buf-A-file-name (file-name-nondirectory buf-A-file-name))) - (if (stringp buf-B-file-name) - (setq buf-B-file-name (file-name-nondirectory buf-B-file-name))) - (if (stringp buf-C-file-name) - (setq buf-C-file-name (file-name-nondirectory buf-C-file-name))) - - (ediff-unselect-and-select-difference -1) - - (setq beg-A (ediff-overlay-start overl-A) - beg-B (ediff-overlay-start overl-B) - beg-C (ediff-overlay-start overl-C) - end-A (ediff-overlay-end overl-A) - end-B (ediff-overlay-end overl-B) - end-C (ediff-overlay-end overl-C)) - - (if ediff-word-mode - (progn - (ediff-wordify beg-A end-A ediff-buffer-A tmp-buffer) - (setq file-A (ediff-make-temp-file tmp-buffer "regA")) - (ediff-wordify beg-B end-B ediff-buffer-B tmp-buffer) - (setq file-B (ediff-make-temp-file tmp-buffer "regB")) - (if ediff-3way-job - (progn - (ediff-wordify beg-C end-C ediff-buffer-C tmp-buffer) - (setq file-C (ediff-make-temp-file tmp-buffer "regC")))) - ) - ;; not word-mode - (setq file-A (ediff-make-temp-file ediff-buffer-A buf-A-file-name)) - (setq file-B (ediff-make-temp-file ediff-buffer-B buf-B-file-name)) - (if ediff-3way-job - (setq file-C (ediff-make-temp-file ediff-buffer-C buf-C-file-name))) - ) - - (ediff-clear-diff-vector 'ediff-difference-vector-A 'fine-diffs-also) - (ediff-clear-diff-vector 'ediff-difference-vector-B 'fine-diffs-also) - (ediff-clear-diff-vector 'ediff-difference-vector-C 'fine-diffs-also) - (ediff-clear-diff-vector - 'ediff-difference-vector-Ancestor 'fine-diffs-also) - ;; let them garbage collect. we can't use the ancestor after recomputing - ;; the diffs. - (setq ediff-difference-vector-Ancestor nil - ediff-ancestor-buffer nil - ediff-state-of-merge nil) - - (setq ediff-killed-diffs-alist nil) ; invalidate saved killed diff regions - - ;; In case of merge job, fool it into thinking that it is just doing - ;; comparison - (let ((ediff-setup-diff-regions-function ediff-setup-diff-regions-function) - (ediff-3way-comparison-job ediff-3way-comparison-job) - (ediff-merge-job ediff-merge-job) - (ediff-merge-with-ancestor-job ediff-merge-with-ancestor-job) - (ediff-job-name ediff-job-name)) - (if ediff-merge-job - (setq ediff-setup-diff-regions-function 'ediff-setup-diff-regions3 - ediff-3way-comparison-job t - ediff-merge-job nil - ediff-merge-with-ancestor-job nil - ediff-job-name 'ediff-files3)) - (funcall ediff-setup-diff-regions-function file-A file-B file-C)) - - (setq ediff-number-of-differences (length ediff-difference-vector-A)) - (delete-file file-A) - (delete-file file-B) - (if file-C - (delete-file file-C)) - - (if ediff-3way-job - (ediff-set-state-of-all-diffs-in-all-buffers ediff-control-buffer)) - - (ediff-jump-to-difference (ediff-diff-at-point 'A point-A)) - (message "") - )) - -;; Not bound to any key---to dangerous. A user can do it if necessary. -(defun ediff-revert-buffers-then-recompute-diffs (noconfirm) - "Revert buffers A, B and C. Then rerun Ediff on file A and file B." - (interactive "P") - (ediff-barf-if-not-control-buffer) - (let ((bufA ediff-buffer-A) - (bufB ediff-buffer-B) - (bufC ediff-buffer-C) - (ctl-buf ediff-control-buffer) - (keep-variants ediff-keep-variants) - (ancestor-buf ediff-ancestor-buffer) - (ancestor-job ediff-merge-with-ancestor-job) - (merge ediff-merge-job) - (comparison ediff-3way-comparison-job)) - (ediff-with-current-buffer bufA - (revert-buffer t noconfirm)) - (ediff-with-current-buffer bufB - (revert-buffer t noconfirm)) - ;; this should only be executed in a 3way comparison, not in merge - (if comparison - (ediff-with-current-buffer bufC - (revert-buffer t noconfirm))) - (if merge - (progn - (set-buffer ctl-buf) - ;; the argument says whether to reverse the meaning of - ;; ediff-keep-variants, i.e., ediff-really-quit runs here with - ;; variants kept. - (ediff-really-quit (not keep-variants)) - (kill-buffer bufC) - (if ancestor-job - (ediff-merge-buffers-with-ancestor bufA bufB ancestor-buf) - (ediff-merge-buffers bufA bufB))) - (ediff-update-diffs)))) - - -;; optional NO-REHIGHLIGHT says to not rehighlight buffers -(defun ediff-recenter (&optional no-rehighlight) - "Bring the highlighted region of all buffers being compared into view. -Reestablish the default three-window display." - (interactive) - (ediff-barf-if-not-control-buffer) - (let (buffer-read-only) - (if (and (ediff-buffer-live-p ediff-buffer-A) - (ediff-buffer-live-p ediff-buffer-B) - (or (not ediff-3way-job) - (ediff-buffer-live-p ediff-buffer-C))) - (ediff-setup-windows - ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-control-buffer) - (or (eq this-command 'ediff-quit) - (message ediff-KILLED-VITAL-BUFFER - (beep 1))) - )) - - ;; set visibility range appropriate to this invocation of Ediff. - (ediff-visible-region) - ;; raise - (if (and (ediff-window-display-p) - (symbolp this-command) - (symbolp last-command) - ;; Either one of the display-changing commands - (or (memq this-command - '(ediff-recenter - ediff-dir-action ediff-registry-action - ediff-patch-action - ediff-toggle-wide-display ediff-toggle-multiframe)) - ;; Or one of the movement cmds and prev cmd was an Ediff cmd - ;; This avoids raising frames unnecessarily. - (and (memq this-command - '(ediff-next-difference - ediff-previous-difference - ediff-jump-to-difference - ediff-jump-to-difference-at-point)) - (not (string-match "^ediff-" (symbol-name last-command))) - ))) - (progn - (if (window-live-p ediff-window-A) - (raise-frame (window-frame ediff-window-A))) - (if (window-live-p ediff-window-B) - (raise-frame (window-frame ediff-window-B))) - (if (window-live-p ediff-window-C) - (raise-frame (window-frame ediff-window-C))))) - (if (and (ediff-window-display-p) - (frame-live-p ediff-control-frame) - (not ediff-use-long-help-message) - (not (ediff-frame-iconified-p ediff-control-frame))) - (raise-frame ediff-control-frame)) - - ;; Redisplay whatever buffers are showing, if there is a selected difference - (let ((control-frame ediff-control-frame) - (control-buf ediff-control-buffer)) - (if (and (ediff-buffer-live-p ediff-buffer-A) - (ediff-buffer-live-p ediff-buffer-B) - (or (not ediff-3way-job) - (ediff-buffer-live-p ediff-buffer-C))) - (progn - (or no-rehighlight - (ediff-select-difference ediff-current-difference)) - - (ediff-recenter-one-window 'A) - (ediff-recenter-one-window 'B) - (if ediff-3way-job - (ediff-recenter-one-window 'C)) - - (ediff-with-current-buffer control-buf - (ediff-recenter-ancestor) ; check if ancestor is alive - - (if (and (ediff-multiframe-setup-p) - (not ediff-use-long-help-message) - (not (ediff-frame-iconified-p ediff-control-frame))) - ;; never grab mouse on quit in this place - (ediff-reset-mouse - control-frame - (eq this-command 'ediff-quit)))) - )) - - (or no-rehighlight - (ediff-restore-highlighting)) - (ediff-with-current-buffer control-buf (ediff-refresh-mode-lines)) - )) - -;; this function returns to the window it was called from -;; (which was the control window) -(defun ediff-recenter-one-window (buf-type) - (if (ediff-valid-difference-p) - ;; context must be saved before switching to windows A/B/C - (let* ((ctl-wind (selected-window)) - (shift (ediff-overlay-start - (ediff-get-value-according-to-buffer-type - buf-type ediff-narrow-bounds))) - (job-name ediff-job-name) - (control-buf ediff-control-buffer) - (window-name (ediff-get-symbol-from-alist - buf-type ediff-window-alist)) - (window (if (window-live-p (symbol-value window-name)) - (symbol-value window-name)))) - - (if (and window ediff-windows-job) - (set-window-start window shift)) - (if window - (progn - (select-window window) - (ediff-deactivate-mark) - (ediff-position-region - (ediff-get-diff-posn buf-type 'beg nil control-buf) - (ediff-get-diff-posn buf-type 'end nil control-buf) - (ediff-get-diff-posn buf-type 'beg nil control-buf) - job-name - ))) - (select-window ctl-wind) - ))) - -(defun ediff-recenter-ancestor () - ;; do half-hearted job by recentering the ancestor buffer, if it is alive and - ;; visible. - (if (and (ediff-buffer-live-p ediff-ancestor-buffer) - (ediff-valid-difference-p)) - (let ((window (ediff-get-visible-buffer-window ediff-ancestor-buffer)) - (ctl-wind (selected-window)) - (job-name ediff-job-name) - (ctl-buf ediff-control-buffer)) - (ediff-with-current-buffer ediff-ancestor-buffer - (goto-char (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf)) - (if window - (progn - (select-window window) - (ediff-position-region - (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf) - (ediff-get-diff-posn 'Ancestor 'end nil ctl-buf) - (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf) - job-name)))) - (select-window ctl-wind) - ))) - - -;; This will have to be refined for 3way jobs -(defun ediff-toggle-split () - "Toggle vertical/horizontal window split. -Does nothing if file-A and file-B are in different frames." - (interactive) - (ediff-barf-if-not-control-buffer) - (let* ((wind-A (if (window-live-p ediff-window-A) ediff-window-A)) - (wind-B (if (window-live-p ediff-window-B) ediff-window-B)) - (wind-C (if (window-live-p ediff-window-C) ediff-window-C)) - (frame-A (if wind-A (window-frame wind-A))) - (frame-B (if wind-B (window-frame wind-B))) - (frame-C (if wind-C (window-frame wind-C)))) - (if (or (eq frame-A frame-B) - (not (frame-live-p frame-A)) - (not (frame-live-p frame-B)) - (if ediff-3way-comparison-job - (or (not (frame-live-p frame-C)) - (eq frame-A frame-C) (eq frame-B frame-C)))) - (setq ediff-split-window-function - (if (eq ediff-split-window-function 'split-window-vertically) - 'split-window-horizontally - 'split-window-vertically)) - (message "Buffers being compared are in different frames")) - (ediff-recenter 'no-rehighlight))) - -(defun ediff-toggle-hilit () - "Switch between highlighting using ASCII flags and highlighting using faces. -On a dumb terminal, switches between ASCII highlighting and no highlighting." - (interactive) - (ediff-barf-if-not-control-buffer) - - (ediff-unselect-and-select-difference - ediff-current-difference 'unselect-only) - ;; cycle through highlighting - (cond ((and ediff-use-faces - (ediff-has-face-support-p) - ediff-highlight-all-diffs) - (message "Unhighlighting unselected difference regions") - (setq ediff-highlight-all-diffs nil - ediff-highlighting-style 'face)) - ((or (and ediff-use-faces (ediff-has-face-support-p) - (eq ediff-highlighting-style 'face)) ; has face support - (and (not (ediff-has-face-support-p)) ; no face support - (eq ediff-highlighting-style 'off))) - (message "Highlighting with ASCII flags") - (setq ediff-highlighting-style 'ascii - ediff-highlight-all-diffs nil - ediff-use-faces nil)) - ((eq ediff-highlighting-style 'ascii) - (message "ASCII highlighting flags removed") - (setq ediff-highlighting-style 'off - ediff-highlight-all-diffs nil)) - ((ediff-has-face-support-p) ; catch-all for cases with face support - (message "Re-highlighting all difference regions") - (setq ediff-use-faces t - ediff-highlighting-style 'face - ediff-highlight-all-diffs t))) - - (if (and ediff-use-faces ediff-highlight-all-diffs) - (ediff-paint-background-regions) - (ediff-paint-background-regions 'unhighlight)) - - (ediff-unselect-and-select-difference - ediff-current-difference 'select-only)) - - -(defun ediff-toggle-autorefine () - "Toggle auto-refine mode." - (interactive) - (ediff-barf-if-not-control-buffer) - (if ediff-word-mode - (error "No fine differences in this mode")) - (cond ((eq ediff-auto-refine 'nix) - (setq ediff-auto-refine 'on) - (ediff-make-fine-diffs ediff-current-difference 'noforce) - (message "Auto-refining is ON")) - ((eq ediff-auto-refine 'on) - (message "Auto-refining is OFF") - (setq ediff-auto-refine 'off)) - (t ;; nix 'em - (ediff-set-fine-diff-properties ediff-current-difference 'default) - (message "Refinements are HIDDEN") - (setq ediff-auto-refine 'nix)) - )) - -(defun ediff-show-ancestor () - "Show the ancestor buffer in a suitable window." - (interactive) - (ediff-recenter) - (or (ediff-buffer-live-p ediff-ancestor-buffer) - (if ediff-merge-with-ancestor-job - (error "Lost connection to ancestor buffer...sorry") - (error "Not merging with ancestor"))) - (let (wind) - (cond ((setq wind (ediff-get-visible-buffer-window ediff-ancestor-buffer)) - (raise-frame (window-frame wind))) - (t (set-window-buffer ediff-window-C ediff-ancestor-buffer))))) - -(defun ediff-make-or-kill-fine-diffs (arg) - "Compute fine diffs. With negative prefix arg, kill fine diffs. -In both cases, operates on the current difference region." - (interactive "P") - (ediff-barf-if-not-control-buffer) - (cond ((eq arg '-) - (ediff-clear-fine-differences ediff-current-difference)) - ((and (numberp arg) (< arg 0)) - (ediff-clear-fine-differences ediff-current-difference)) - (t (ediff-make-fine-diffs)))) - - -(defun ediff-toggle-help () - "Toggle short/long help message." - (interactive) - (ediff-barf-if-not-control-buffer) - (let (buffer-read-only) - (erase-buffer) - (setq ediff-use-long-help-message (not ediff-use-long-help-message)) - (ediff-set-help-message)) - ;; remember the icon status of the control frame when the user requested - ;; full control message - (if (and ediff-use-long-help-message (ediff-multiframe-setup-p)) - (setq ediff-prefer-iconified-control-frame - (ediff-frame-iconified-p ediff-control-frame))) - - (setq ediff-window-config-saved "") ; force redisplay - (ediff-recenter 'no-rehighlight)) - - -;; If BUF, this is the buffer to toggle, not current buffer. -(defun ediff-toggle-read-only (&optional buf) - "Toggle read-only in current buffer. -If buffer is under version control and locked, check it out first. -If optional argument BUF is specified, toggle read-only in that buffer instead -of the current buffer." - (interactive) - (ediff-barf-if-not-control-buffer) - (let ((ctl-buf (if (null buf) (current-buffer))) - (buf-type (ediff-char-to-buftype last-command-char))) - (or buf (ediff-recenter)) - (or buf - (setq buf (ediff-get-buffer buf-type))) - - (ediff-with-current-buffer buf ; eval in buf A/B/C - (let* ((file (buffer-file-name buf)) - (file-writable (and file - (file-exists-p file) - (file-writable-p file))) - (toggle-ro-cmd (cond (ediff-toggle-read-only-function) - ((ediff-file-checked-out-p file) - 'toggle-read-only) - (file-writable 'toggle-read-only) - (t (key-binding "\C-x\C-q"))))) - ;; If the file is checked in, make sure we don't make buffer modifiable - ;; without warning the user. The user can fool our checks by making the - ;; buffer non-RO without checking the file out. We regard this as a - ;; user problem. - (if (and (ediff-file-checked-in-p file) - ;; If ctl-buf is null, this means we called this - ;; non-interactively, in which case don't ask questions - ctl-buf) - (cond ((not buffer-read-only) - (setq toggle-ro-cmd 'toggle-read-only)) - ((and (or (beep 1) t) ; always beep - (y-or-n-p - (format - "File %s is under version control. Check it out? " - (ediff-abbreviate-file-name file)))) - ;; if we checked the file out, we should also change the - ;; original state of buffer-read-only to nil. If we don't - ;; do this, the mode line will show %%, since the file was - ;; RO before ediff started, so the user will think the file - ;; is checked in. - (ediff-with-current-buffer ctl-buf - (ediff-change-saved-variable - 'buffer-read-only nil buf-type))) - (t - (setq toggle-ro-cmd 'toggle-read-only) - (beep 1) (beep 1) - (message - "Boy, this is risky! Don't modify this file...") - (sit-for 3)))) ; let the user see the warning - (if (and toggle-ro-cmd - (string-match "toggle-read-only" (symbol-name toggle-ro-cmd))) - (save-excursion - (save-window-excursion - (select-window (ediff-get-visible-buffer-window buf)) - (command-execute toggle-ro-cmd))) - (error "Don't know how to toggle read-only in buffer %S" buf)) - - ;; Check if we made the current buffer updatable, but its file is RO. - ;; Signal a warning in this case. - (if (and file (not buffer-read-only) - (eq this-command 'ediff-toggle-read-only) - (file-exists-p file) - (not (file-writable-p file))) - (progn - (beep 1) - (message "Warning: file %s is read-only" - (ediff-abbreviate-file-name file)))) - )))) - -;; checkout if visited file is checked in -(defun ediff-maybe-checkout (buf) - (let ((file (expand-file-name (buffer-file-name buf))) - (checkout-function (key-binding "\C-x\C-q"))) - (if (and (ediff-file-checked-in-p file) - (or (beep 1) t) - (y-or-n-p - (format - "File %s is under version control. Check it out? " - (ediff-abbreviate-file-name file)))) - (ediff-with-current-buffer buf - (command-execute checkout-function))))) - - -;; This is a simple-minded check for whether a file is under version control. -;; If file,v exists but file doesn't, this file is considered to be not checked -;; in and not checked out for the purpose of patching (since patch won't be -;; able to read such a file anyway). -;; FILE is a string representing file name -;;(defun ediff-file-under-version-control (file) -;; (let* ((filedir (file-name-directory file)) -;; (file-nondir (file-name-nondirectory file)) -;; (trial (concat file-nondir ",v")) -;; (full-trial (concat filedir trial)) -;; (full-rcs-trial (concat filedir "RCS/" trial))) -;; (and (stringp file) -;; (file-exists-p file) -;; (or -;; (and -;; (file-exists-p full-trial) -;; ;; in FAT FS, `file,v' and `file' may turn out to be the same! -;; ;; don't be fooled by this! -;; (not (equal (file-attributes file) -;; (file-attributes full-trial)))) -;; ;; check if a version is in RCS/ directory -;; (file-exists-p full-rcs-trial))) -;; )) - - -(defun ediff-file-checked-out-p (file) - (or (not (featurep 'vc-hooks)) - (and (vc-backend file) - (if (fboundp 'vc-state) - (or (memq (vc-state file) '(edited needs-merge)) - (stringp (vc-state file))) - ;; XEmacs has no vc-state - (vc-locking-user file)) - ))) - -(defun ediff-file-checked-in-p (file) - (and (featurep 'vc-hooks) - ;; CVS files are considered not checked in - (not (memq (vc-backend file) '(nil CVS))) - (if (fboundp 'vc-state) - (and - (not (memq (vc-state file) '(edited needs-merge))) - (not (stringp (vc-state file)))) - ;; XEmacs has no vc-state - (not (vc-locking-user file))) - )) - -(defun ediff-file-compressed-p (file) - (condition-case nil - (require 'jka-compr) - (error)) - (if (featurep 'jka-compr) - (string-match (jka-compr-build-file-regexp) file))) - - -(defun ediff-swap-buffers () - "Rotate the display of buffers A, B, and C." - (interactive) - (ediff-barf-if-not-control-buffer) - (if (and (window-live-p ediff-window-A) (window-live-p ediff-window-B)) - (let ((buf ediff-buffer-A) - (values ediff-buffer-values-orig-A) - (diff-vec ediff-difference-vector-A) - (hide-regexp ediff-regexp-hide-A) - (focus-regexp ediff-regexp-focus-A) - (wide-visibility-p (eq ediff-visible-bounds ediff-wide-bounds)) - (overlay (if (ediff-has-face-support-p) - ediff-current-diff-overlay-A))) - (if ediff-3way-comparison-job - (progn - (set-window-buffer ediff-window-A ediff-buffer-C) - (set-window-buffer ediff-window-B ediff-buffer-A) - (set-window-buffer ediff-window-C ediff-buffer-B) - ) - (set-window-buffer ediff-window-A ediff-buffer-B) - (set-window-buffer ediff-window-B ediff-buffer-A)) - ;; swap diff buffers - (if ediff-3way-comparison-job - (setq ediff-buffer-A ediff-buffer-C - ediff-buffer-C ediff-buffer-B - ediff-buffer-B buf) - (setq ediff-buffer-A ediff-buffer-B - ediff-buffer-B buf)) - - ;; swap saved buffer characteristics - (if ediff-3way-comparison-job - (setq ediff-buffer-values-orig-A ediff-buffer-values-orig-C - ediff-buffer-values-orig-C ediff-buffer-values-orig-B - ediff-buffer-values-orig-B values) - (setq ediff-buffer-values-orig-A ediff-buffer-values-orig-B - ediff-buffer-values-orig-B values)) - - ;; swap diff vectors - (if ediff-3way-comparison-job - (setq ediff-difference-vector-A ediff-difference-vector-C - ediff-difference-vector-C ediff-difference-vector-B - ediff-difference-vector-B diff-vec) - (setq ediff-difference-vector-A ediff-difference-vector-B - ediff-difference-vector-B diff-vec)) - - ;; swap hide/focus regexp - (if ediff-3way-comparison-job - (setq ediff-regexp-hide-A ediff-regexp-hide-C - ediff-regexp-hide-C ediff-regexp-hide-B - ediff-regexp-hide-B hide-regexp - ediff-regexp-focus-A ediff-regexp-focus-C - ediff-regexp-focus-C ediff-regexp-focus-B - ediff-regexp-focus-B focus-regexp) - (setq ediff-regexp-hide-A ediff-regexp-hide-B - ediff-regexp-hide-B hide-regexp - ediff-regexp-focus-A ediff-regexp-focus-B - ediff-regexp-focus-B focus-regexp)) - - ;; The following is needed for XEmacs, since there one can't move - ;; overlay to another buffer. In Emacs, this swap is redundant. - (if (ediff-has-face-support-p) - (if ediff-3way-comparison-job - (setq ediff-current-diff-overlay-A ediff-current-diff-overlay-C - ediff-current-diff-overlay-C ediff-current-diff-overlay-B - ediff-current-diff-overlay-B overlay) - (setq ediff-current-diff-overlay-A ediff-current-diff-overlay-B - ediff-current-diff-overlay-B overlay))) - - ;; swap wide bounds - (setq ediff-wide-bounds - (cond (ediff-3way-comparison-job - (list (nth 2 ediff-wide-bounds) - (nth 0 ediff-wide-bounds) - (nth 1 ediff-wide-bounds))) - (ediff-3way-job - (list (nth 1 ediff-wide-bounds) - (nth 0 ediff-wide-bounds) - (nth 2 ediff-wide-bounds))) - (t - (list (nth 1 ediff-wide-bounds) - (nth 0 ediff-wide-bounds))))) - ;; swap narrow bounds - (setq ediff-narrow-bounds - (cond (ediff-3way-comparison-job - (list (nth 2 ediff-narrow-bounds) - (nth 0 ediff-narrow-bounds) - (nth 1 ediff-narrow-bounds))) - (ediff-3way-job - (list (nth 1 ediff-narrow-bounds) - (nth 0 ediff-narrow-bounds) - (nth 2 ediff-narrow-bounds))) - (t - (list (nth 1 ediff-narrow-bounds) - (nth 0 ediff-narrow-bounds))))) - (if wide-visibility-p - (setq ediff-visible-bounds ediff-wide-bounds) - (setq ediff-visible-bounds ediff-narrow-bounds)) - )) - (if ediff-3way-job - (ediff-set-state-of-all-diffs-in-all-buffers ediff-control-buffer)) - (ediff-recenter 'no-rehighlight) - ) - - -(defun ediff-toggle-wide-display () - "Toggle wide/regular display. -This is especially useful when comparing buffers side-by-side." - (interactive) - (ediff-barf-if-not-control-buffer) - (or (ediff-window-display-p) - (error "%sEmacs is not running as a window application" - (if ediff-emacs-p "" "X"))) - (ediff-recenter 'no-rehighlight) ; make sure buffs are displayed in windows - (let ((ctl-buf ediff-control-buffer)) - (setq ediff-wide-display-p (not ediff-wide-display-p)) - (if (not ediff-wide-display-p) - (ediff-with-current-buffer ctl-buf - (modify-frame-parameters - ediff-wide-display-frame ediff-wide-display-orig-parameters) - ;;(sit-for (if ediff-xemacs-p 0.4 0)) - ;; restore control buf, since ctl window may have been deleted - ;; during resizing - (set-buffer ctl-buf) - (setq ediff-wide-display-orig-parameters nil - ediff-window-B nil) ; force update of window config - (ediff-recenter 'no-rehighlight)) - (funcall ediff-make-wide-display-function) - ;;(sit-for (if ediff-xemacs-p 0.4 0)) - (ediff-with-current-buffer ctl-buf - (setq ediff-window-B nil) ; force update of window config - (ediff-recenter 'no-rehighlight))))) - -;;;###autoload -(defun ediff-toggle-multiframe () - "Switch from multiframe display to single-frame display and back. -To change the default, set the variable `ediff-window-setup-function', -which see." - (interactive) - (let (window-setup-func) - (or (ediff-window-display-p) - (error "%sEmacs is not running as a window application" - (if ediff-emacs-p "" "X"))) - - (cond ((eq ediff-window-setup-function 'ediff-setup-windows-multiframe) - (setq window-setup-func 'ediff-setup-windows-plain)) - ((eq ediff-window-setup-function 'ediff-setup-windows-plain) - (if (ediff-in-control-buffer-p) - (ediff-kill-bottom-toolbar)) - (setq window-setup-func 'ediff-setup-windows-multiframe))) - - ;; change default - (setq-default ediff-window-setup-function window-setup-func) - ;; change in all active ediff sessions - (mapcar (lambda(buf) (ediff-with-current-buffer buf - (setq ediff-window-setup-function window-setup-func - ediff-window-B nil))) - ediff-session-registry) - (if (ediff-in-control-buffer-p) - (ediff-recenter 'no-rehighlight)))) - - -;;;###autoload -(defun ediff-toggle-use-toolbar () - "Enable or disable Ediff toolbar. -Works only in versions of Emacs that support toolbars. -To change the default, set the variable `ediff-use-toolbar-p', which see." - (interactive) - (if (featurep 'ediff-tbar) - (progn - (or (ediff-window-display-p) - (error "%sEmacs is not running as a window application" - (if ediff-emacs-p "" "X"))) - (if (ediff-use-toolbar-p) - (ediff-kill-bottom-toolbar)) - ;; do this only after killing the toolbar - (setq ediff-use-toolbar-p (not ediff-use-toolbar-p)) - - (mapcar (lambda(buf) - (ediff-with-current-buffer buf - ;; force redisplay - (setq ediff-window-config-saved "") - )) - ediff-session-registry) - (if (ediff-in-control-buffer-p) - (ediff-recenter 'no-rehighlight))))) - - -;; if was using toolbar, kill it -(defun ediff-kill-bottom-toolbar () - ;; Using ctl-buffer or ediff-control-window for LOCALE does not - ;; work properly in XEmacs 19.14: we have to use - ;;(selected-frame). - ;; The problem with this is that any previous bottom-toolbar - ;; will not re-appear after our cleanup here. Is there a way - ;; to do "push" and "pop" toolbars ? --marcpa - (if (ediff-use-toolbar-p) - (ediff-cond-compile-for-xemacs-or-emacs - (progn ; xemacs - (set-specifier bottom-toolbar (list (selected-frame) nil)) - (set-specifier bottom-toolbar-visible-p (list (selected-frame) nil))) - nil ; emacs - ) - )) - -;; If wants to use toolbar, make it. -;; If not, zero the toolbar for XEmacs. -;; Do nothing for Emacs. -(defun ediff-make-bottom-toolbar (&optional frame) - (if (ediff-window-display-p) - (progn - (setq frame (or frame (selected-frame))) - (cond ((ediff-use-toolbar-p) ; this checks for XEmacs - (ediff-cond-compile-for-xemacs-or-emacs - (progn ; xemacs - (set-specifier - bottom-toolbar - (list frame (if (ediff-3way-comparison-job) - ediff-toolbar-3way ediff-toolbar))) - (set-specifier bottom-toolbar-visible-p (list frame t)) - (set-specifier bottom-toolbar-height - (list frame ediff-toolbar-height))) - nil ; emacs - ) - ) - ((ediff-has-toolbar-support-p) - (ediff-cond-compile-for-xemacs-or-emacs - (set-specifier bottom-toolbar-height (list frame 0)) ; xemacs - nil ; emacs - ) - ) - )) - )) - -;; Merging - -(defun ediff-toggle-show-clashes-only () - "Toggle the mode that shows only the merge regions where both variants differ from the ancestor." - (interactive) - (ediff-barf-if-not-control-buffer) - (if (not ediff-merge-with-ancestor-job) - (error "This command makes sense only when merging with an ancestor")) - (setq ediff-show-clashes-only (not ediff-show-clashes-only)) - (if ediff-show-clashes-only - (message "Focus on regions where both buffers differ from the ancestor") - (message "Canceling focus on regions where changes clash"))) - -(defun ediff-toggle-skip-changed-regions () - "Toggle the mode that skips the merge regions that differ from the default." - (interactive) - (ediff-barf-if-not-control-buffer) - (setq ediff-skip-merge-regions-that-differ-from-default - (not ediff-skip-merge-regions-that-differ-from-default)) - (if ediff-skip-merge-regions-that-differ-from-default - (message "Skipping regions that differ from default setting") - (message "Showing regions that differ from default setting"))) - - - -;; Widening/narrowing - -(defun ediff-toggle-narrow-region () - "Toggle narrowing in buffers A, B, and C. -Used in ediff-windows/regions only." - (interactive) - (if (eq ediff-buffer-A ediff-buffer-B) - (error ediff-NO-DIFFERENCES)) - (if (eq ediff-visible-bounds ediff-wide-bounds) - (setq ediff-visible-bounds ediff-narrow-bounds) - (setq ediff-visible-bounds ediff-wide-bounds)) - (ediff-recenter 'no-rehighlight)) - -;; Narrow bufs A/B/C to ediff-visible-bounds. If this is currently set to -;; ediff-wide-bounds, then this actually widens. -;; This function does nothing if job-name is not -;; ediff-regions-wordwise/linewise or ediff-windows-wordwise/linewise. -;; Does nothing if buffer-A = buffer-B since we can't narrow -;; to two different regions in one buffer. -(defun ediff-visible-region () - (if (or (eq ediff-buffer-A ediff-buffer-B) - (eq ediff-buffer-A ediff-buffer-C) - (eq ediff-buffer-C ediff-buffer-B)) - () - ;; If ediff-*-regions/windows, ediff-visible-bounds is already set - ;; Otherwise, always use full range. - (if (not ediff-narrow-job) - (setq ediff-visible-bounds ediff-wide-bounds)) - (let ((overl-A (ediff-get-value-according-to-buffer-type - 'A ediff-visible-bounds)) - (overl-B (ediff-get-value-according-to-buffer-type - 'B ediff-visible-bounds)) - (overl-C (ediff-get-value-according-to-buffer-type - 'C ediff-visible-bounds)) - ) - (ediff-with-current-buffer ediff-buffer-A - (if (ediff-overlay-buffer overl-A) - (narrow-to-region - (ediff-overlay-start overl-A) (ediff-overlay-end overl-A)))) - (ediff-with-current-buffer ediff-buffer-B - (if (ediff-overlay-buffer overl-B) - (narrow-to-region - (ediff-overlay-start overl-B) (ediff-overlay-end overl-B)))) - - (if (and ediff-3way-job (ediff-overlay-buffer overl-C)) - (ediff-with-current-buffer ediff-buffer-C - (narrow-to-region - (ediff-overlay-start overl-C) (ediff-overlay-end overl-C)))) - ))) - - -;; Window scrolling operations - -;; Performs some operation on the two file windows (if they are showing). -;; Traps all errors on the operation in windows A/B/C. -;; Usually, errors come from scrolling off the -;; beginning or end of the buffer, and this gives error messages. -(defun ediff-operate-on-windows (operation arg) - - ;; make sure windows aren't dead - (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B))) - (ediff-recenter 'no-rehighlight)) - (if (not (and (ediff-buffer-live-p ediff-buffer-A) - (ediff-buffer-live-p ediff-buffer-B) - (or (not ediff-3way-job) ediff-buffer-C) - )) - (error ediff-KILLED-VITAL-BUFFER)) - - (let* ((wind (selected-window)) - (wind-A ediff-window-A) - (wind-B ediff-window-B) - (wind-C ediff-window-C) - (coefA (ediff-get-region-size-coefficient 'A operation)) - (coefB (ediff-get-region-size-coefficient 'B operation)) - (three-way ediff-3way-job) - (coefC (if three-way - (ediff-get-region-size-coefficient 'C operation)))) - - (select-window wind-A) - (condition-case nil - (funcall operation (round (* coefA arg))) - (error)) - (select-window wind-B) - (condition-case nil - (funcall operation (round (* coefB arg))) - (error)) - (if three-way - (progn - (select-window wind-C) - (condition-case nil - (funcall operation (round (* coefC arg))) - (error)))) - (select-window wind))) - -(defun ediff-scroll-vertically (&optional arg) - "Vertically scroll buffers A, B \(and C if appropriate\). -With optional argument ARG, scroll ARG lines; otherwise scroll by nearly -the one half of the height of window-A." - (interactive "P") - (ediff-barf-if-not-control-buffer) - - ;; make sure windows aren't dead - (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B))) - (ediff-recenter 'no-rehighlight)) - (if (not (and (ediff-buffer-live-p ediff-buffer-A) - (ediff-buffer-live-p ediff-buffer-B) - (or (not ediff-3way-job) - (ediff-buffer-live-p ediff-buffer-C)) - )) - (error ediff-KILLED-VITAL-BUFFER)) - - (ediff-operate-on-windows - (if (memq last-command-char '(?v ?\C-v)) - 'scroll-up - 'scroll-down) - ;; calculate argument to scroll-up/down - ;; if there is an explicit argument - (if (and arg (not (equal arg '-))) - ;; use it - (prefix-numeric-value arg) - ;; if not, see if we can determine a default amount (the window height) - (let (default-amount) - (setq default-amount - (- (/ (min (window-height ediff-window-A) - (window-height ediff-window-B) - (if ediff-3way-job - (window-height ediff-window-C) - 500)) ; some large number - 2) - 1 next-screen-context-lines)) - ;; window found - (if arg - ;; C-u as argument means half of default amount - (/ default-amount 2) - ;; no argument means default amount - default-amount))))) - - -(defun ediff-scroll-horizontally (&optional arg) - "Horizontally scroll buffers A, B \(and C if appropriate\). -If an argument is given, that is how many columns are scrolled, else nearly -the width of the A/B/C windows." - (interactive "P") - (ediff-barf-if-not-control-buffer) - - ;; make sure windows aren't dead - (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B))) - (ediff-recenter 'no-rehighlight)) - (if (not (and (ediff-buffer-live-p ediff-buffer-A) - (ediff-buffer-live-p ediff-buffer-B) - (or (not ediff-3way-job) - (ediff-buffer-live-p ediff-buffer-C)) - )) - (error ediff-KILLED-VITAL-BUFFER)) - - (ediff-operate-on-windows - ;; Arrange for scroll-left and scroll-right being called - ;; interactively so that they set the window's min_hscroll. - ;; Otherwise, automatic hscrolling will undo the effect of - ;; hscrolling. - (if (= last-command-char ?<) - (lambda (arg) - (let ((prefix-arg arg)) - (call-interactively 'scroll-left))) - (lambda (arg) - (let ((prefix-arg arg)) - (call-interactively 'scroll-right)))) - ;; calculate argument to scroll-left/right - ;; if there is an explicit argument - (if (and arg (not (equal arg '-))) - ;; use it - (prefix-numeric-value arg) - ;; if not, see if we can determine a default amount - ;; (half the window width) - (if (null ediff-control-window) - ;; no control window, use nil - nil - (let ((default-amount - (- (/ (min (window-width ediff-window-A) - (window-width ediff-window-B) - (if ediff-3way-comparison-job - (window-width ediff-window-C) - 500) ; some large number - ) - 2) - 3))) - ;; window found - (if arg - ;; C-u as argument means half of default amount - (/ default-amount 2) - ;; no argument means default amount - default-amount)))))) - - -;;BEG, END show the region to be positioned. -;;JOB-NAME holds ediff-job-name. The ediff-windows job positions regions -;;differently. -(defun ediff-position-region (beg end pos job-name) - (if (> end (point-max)) - (setq end (point-max))) - (if ediff-windows-job - (if (pos-visible-in-window-p end) - () ; do nothing, wind is already positioned - ;; at this point, windows are positioned at the beginning of the - ;; file regions (not diff-regions) being compared. - (save-excursion - (move-to-window-line (- (window-height) 2)) - (let ((amount (+ 2 (count-lines (point) end)))) - (scroll-up amount)))) - (set-window-start (selected-window) beg) - (if (pos-visible-in-window-p end) - ;; Determine the number of lines that the region occupies - (let ((lines 0) - (prev-point 0)) - (while ( and (> end (progn - (move-to-window-line lines) - (point))) - ;; `end' may be beyond the window bottom, so check - ;; that we are making progress - (< prev-point (point))) - (setq prev-point (point)) - (setq lines (1+ lines))) - ;; And position the beginning on the right line - (goto-char beg) - (recenter (/ (1+ (max (- (1- (window-height (selected-window))) - lines) - 1) - ) - 2)))) - (goto-char pos) - )) - -;; get number of lines from window start to region end -(defun ediff-get-lines-to-region-end (buf-type &optional n ctl-buf) - (or n (setq n ediff-current-difference)) - (or ctl-buf (setq ctl-buf ediff-control-buffer)) - (ediff-with-current-buffer ctl-buf - (let* ((buf (ediff-get-buffer buf-type)) - (wind (eval (ediff-get-symbol-from-alist - buf-type ediff-window-alist))) - (beg (window-start wind)) - (end (ediff-get-diff-posn buf-type 'end)) - lines) - (ediff-with-current-buffer buf - (if (< beg end) - (setq lines (count-lines beg end)) - (setq lines 0)) - lines - )))) - -;; Calculate the number of lines from window end to the start of diff region -(defun ediff-get-lines-to-region-start (buf-type &optional diff-num ctl-buf) - (or diff-num (setq diff-num ediff-current-difference)) - (or ctl-buf (setq ctl-buf ediff-control-buffer)) - (ediff-with-current-buffer ctl-buf - (let* ((buf (ediff-get-buffer buf-type)) - (wind (eval (ediff-get-symbol-from-alist - buf-type ediff-window-alist))) - (end (or (window-end wind) (window-end wind t))) - (beg (ediff-get-diff-posn buf-type 'beg diff-num))) - (ediff-with-current-buffer buf - (if (< beg end) - (count-lines (max beg (point-min)) (min end (point-max))) 0)) - ))) - - -;; region size coefficient is a coefficient by which to adjust scrolling -;; up/down of the window displaying buffer of type BUFTYPE. -;; The purpose of this coefficient is to make the windows scroll in sync, so -;; that it won't happen that one diff region is scrolled off while the other is -;; still seen. -;; -;; If the difference region is invalid, the coefficient is 1 -(defun ediff-get-region-size-coefficient (buf-type op &optional n ctl-buf) - (ediff-with-current-buffer (or ctl-buf ediff-control-buffer) - (if (ediff-valid-difference-p n) - (let* ((func (cond ((eq op 'scroll-down) - 'ediff-get-lines-to-region-start) - ((eq op 'scroll-up) - 'ediff-get-lines-to-region-end) - (t '(lambda (a b c) 0)))) - (max-lines (max (funcall func 'A n ctl-buf) - (funcall func 'B n ctl-buf) - (if (ediff-buffer-live-p ediff-buffer-C) - (funcall func 'C n ctl-buf) - 0)))) - ;; this covers the horizontal coefficient as well: - ;; if max-lines = 0 then coef = 1 - (if (> max-lines 0) - (/ (+ (funcall func buf-type n ctl-buf) 0.0) - (+ max-lines 0.0)) - 1)) - 1))) - - -(defun ediff-next-difference (&optional arg) - "Advance to the next difference. -With a prefix argument, go forward that many differences." - (interactive "p") - (ediff-barf-if-not-control-buffer) - (if (< ediff-current-difference ediff-number-of-differences) - (let ((n (min ediff-number-of-differences - (+ ediff-current-difference (or arg 1)))) - non-clash-skip skip-changed regexp-skip) - - (ediff-visible-region) - (or (>= n ediff-number-of-differences) - (setq regexp-skip (funcall ediff-skip-diff-region-function n)) - ;; this won't exec if regexp-skip is t - (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n) - skip-changed - (ediff-skip-merge-region-if-changed-from-default-p n)) - (ediff-install-fine-diff-if-necessary n)) - ;; Skip loop - (while (and (< n ediff-number-of-differences) - (or - ;; regexp skip - regexp-skip - ;; skip clashes, if necessary - non-clash-skip - ;; skip processed regions - skip-changed - ;; skip difference regions that differ in white space - (and ediff-ignore-similar-regions - (ediff-merge-region-is-non-clash n) - (or (eq (ediff-no-fine-diffs-p n) t) - (and (ediff-merge-job) - (eq (ediff-no-fine-diffs-p n) 'C))) - ))) - (setq n (1+ n)) - (if (= 0 (mod n 20)) - (message "Skipped over region %d and counting ..." n)) - (or (>= n ediff-number-of-differences) - (setq regexp-skip (funcall ediff-skip-diff-region-function n)) - ;; this won't exec if regexp-skip is t - (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n) - skip-changed - (ediff-skip-merge-region-if-changed-from-default-p n)) - (ediff-install-fine-diff-if-necessary n)) - ) - (message "") - (ediff-unselect-and-select-difference n) - ) ; let - (ediff-visible-region) - (error "At end of the difference list"))) - -(defun ediff-previous-difference (&optional arg) - "Go to the previous difference. -With a prefix argument, go back that many differences." - (interactive "p") - (ediff-barf-if-not-control-buffer) - (if (> ediff-current-difference -1) - (let ((n (max -1 (- ediff-current-difference (or arg 1)))) - non-clash-skip skip-changed regexp-skip) - - (ediff-visible-region) - (or (< n 0) - (setq regexp-skip (funcall ediff-skip-diff-region-function n)) - ;; this won't exec if regexp-skip is t - (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n) - skip-changed - (ediff-skip-merge-region-if-changed-from-default-p n)) - (ediff-install-fine-diff-if-necessary n)) - (while (and (> n -1) - (or - ;; regexp skip - regexp-skip - ;; skip clashes, if necessary - non-clash-skip - ;; skipp changed regions - skip-changed - ;; skip difference regions that differ in white space - (and ediff-ignore-similar-regions - (ediff-merge-region-is-non-clash n) - (or (eq (ediff-no-fine-diffs-p n) t) - (and (ediff-merge-job) - (eq (ediff-no-fine-diffs-p n) 'C))) - ))) - (if (= 0 (mod (1+ n) 20)) - (message "Skipped over region %d and counting ..." (1+ n))) - (setq n (1- n)) - (or (< n 0) - (setq regexp-skip (funcall ediff-skip-diff-region-function n)) - ;; this won't exec if regexp-skip is t - (setq non-clash-skip (ediff-merge-region-is-non-clash-to-skip n) - skip-changed - (ediff-skip-merge-region-if-changed-from-default-p n)) - (ediff-install-fine-diff-if-necessary n)) - ) - (message "") - (ediff-unselect-and-select-difference n) - ) ; let - (ediff-visible-region) - (error "At beginning of the difference list"))) - -;; The diff number is as perceived by the user (i.e., 1+ the internal -;; representation) -(defun ediff-jump-to-difference (difference-number) - "Go to the difference specified as a prefix argument. -If the prefix is negative, count differences from the end." - (interactive "p") - (ediff-barf-if-not-control-buffer) - (setq difference-number - (cond ((< difference-number 0) - (+ ediff-number-of-differences difference-number)) - ((> difference-number 0) (1- difference-number)) - (t -1))) - ;; -1 is allowed by ediff-unselect-and-select-difference --- it is the - ;; position before the first one. - (if (and (>= difference-number -1) - (<= difference-number ediff-number-of-differences)) - (ediff-unselect-and-select-difference difference-number) - (error ediff-BAD-DIFF-NUMBER - this-command (1+ difference-number) ediff-number-of-differences))) - -(defun ediff-jump-to-difference-at-point (arg) - "Go to difference closest to the point in buffer A, B, or C. -The buffer depends on last command character \(a, b, or c\) that invoked this -command. For instance, if the command was `ga' then the point value in buffer -A is used. -With a prefix argument, synchronize all files around the current point position -in the specified buffer." - (interactive "P") - (ediff-barf-if-not-control-buffer) - (let* ((buf-type (ediff-char-to-buftype last-command-char)) - (buffer (ediff-get-buffer buf-type)) - (pt (ediff-with-current-buffer buffer (point))) - (diff-no (ediff-diff-at-point buf-type nil (if arg 'after))) - (past-last-diff (< ediff-number-of-differences diff-no)) - (beg (if past-last-diff - (ediff-with-current-buffer buffer (point-max)) - (ediff-get-diff-posn buf-type 'beg (1- diff-no)))) - ctl-wind wind-A wind-B wind-C - shift) - (if past-last-diff - (ediff-jump-to-difference -1) - (ediff-jump-to-difference diff-no)) - (setq ctl-wind (selected-window) - wind-A ediff-window-A - wind-B ediff-window-B - wind-C ediff-window-C) - (if arg - (progn - (ediff-with-current-buffer buffer - (setq shift (- beg pt))) - (select-window wind-A) - (if past-last-diff (goto-char (point-max))) - (condition-case nil - (backward-char shift) ; noerror, if beginning of buffer - (error)) - (recenter) - (select-window wind-B) - (if past-last-diff (goto-char (point-max))) - (condition-case nil - (backward-char shift) ; noerror, if beginning of buffer - (error)) - (recenter) - (if (window-live-p wind-C) - (progn - (select-window wind-C) - (if past-last-diff (goto-char (point-max))) - (condition-case nil - (backward-char shift) ; noerror, if beginning of buffer - (error)) - (recenter) - )) - (select-window ctl-wind) - )) - )) - - -;; find region most related to the current point position (or POS, if given) -;; returns diff number as seen by the user (i.e., 1+ the internal -;; representation) -;; The optional argument WHICH-DIFF can be `after' or `before'. If `after', -;; find the diff after the point. If `before', find the diff before the -;; point. If the point is inside a diff, return that diff. -(defun ediff-diff-at-point (buf-type &optional pos which-diff) - (let ((buffer (ediff-get-buffer buf-type)) - (ctl-buffer ediff-control-buffer) - (max-dif-num (1- ediff-number-of-differences)) - (diff-no -1) - (prev-beg 0) - (prev-end 0) - (beg 0) - (end 0)) - - (ediff-with-current-buffer buffer - (setq pos (or pos (point))) - (while (and (or (< pos prev-beg) (> pos beg)) - (< diff-no max-dif-num)) - (setq diff-no (1+ diff-no)) - (setq prev-beg beg - prev-end end) - (setq beg (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer) - end (ediff-get-diff-posn buf-type 'end diff-no ctl-buffer)) - ) - - ;; boost diff-no by 1, if past the last diff region - (if (and (memq which-diff '(after before)) - (> pos beg) (= diff-no max-dif-num)) - (setq diff-no (1+ diff-no))) - - (cond ((eq which-diff 'after) (1+ diff-no)) - ((eq which-diff 'before) diff-no) - ((< (abs (count-lines pos (max 1 prev-end))) - (abs (count-lines pos (max 1 beg)))) - diff-no) ; choose prev difference - (t - (1+ diff-no))) ; choose next difference - ))) - - -;;; Copying diffs. - -(defun ediff-diff-to-diff (arg &optional keys) - "Copy buffer-X'th difference region to buffer Y \(X,Y are A, B, or C\). -If numerical prefix argument, copy the difference specified in the arg. -Otherwise, copy the difference given by `ediff-current-difference'. -This command assumes it is bound to a 2-character key sequence, `ab', `ba', -`ac', etc., which is used to determine the types of buffers to be used for -copying difference regions. The first character in the sequence specifies -the source buffer and the second specifies the target. - -If the second optional argument, a 2-character string, is given, use it to -determine the source and the target buffers instead of the command keys." - (interactive "P") - (ediff-barf-if-not-control-buffer) - (or keys (setq keys (this-command-keys))) - (if (eq arg '-) (setq arg -1)) ; translate neg arg to -1 - (if (numberp arg) (ediff-jump-to-difference arg)) - - (let* ((key1 (aref keys 0)) - (key2 (aref keys 1)) - (char1 (ediff-event-key key1)) - (char2 (ediff-event-key key2)) - ediff-verbose-p) - (ediff-copy-diff ediff-current-difference - (ediff-char-to-buftype char1) - (ediff-char-to-buftype char2)) - ;; recenter with rehighlighting, but no messages - (ediff-recenter))) - -(defun ediff-copy-A-to-B (arg) - "Copy ARGth difference region from buffer A to B. -ARG is a prefix argument. If nil, copy the current difference region." - (interactive "P") - (ediff-diff-to-diff arg "ab")) - -(defun ediff-copy-B-to-A (arg) - "Copy ARGth difference region from buffer B to A. -ARG is a prefix argument. If nil, copy the current difference region." - (interactive "P") - (ediff-diff-to-diff arg "ba")) - -(defun ediff-copy-A-to-C (arg) - "Copy ARGth difference region from buffer A to buffer C. -ARG is a prefix argument. If nil, copy the current difference region." - (interactive "P") - (ediff-diff-to-diff arg "ac")) - -(defun ediff-copy-B-to-C (arg) - "Copy ARGth difference region from buffer B to buffer C. -ARG is a prefix argument. If nil, copy the current difference region." - (interactive "P") - (ediff-diff-to-diff arg "bc")) - -(defun ediff-copy-C-to-B (arg) - "Copy ARGth difference region from buffer C to B. -ARG is a prefix argument. If nil, copy the current difference region." - (interactive "P") - (ediff-diff-to-diff arg "cb")) - -(defun ediff-copy-C-to-A (arg) - "Copy ARGth difference region from buffer C to A. -ARG is a prefix argument. If nil, copy the current difference region." - (interactive "P") - (ediff-diff-to-diff arg "ca")) - - - -;; Copy diff N from FROM-BUF-TYPE \(given as A, B or C\) to TO-BUF-TYPE. -;; If optional DO-NOT-SAVE is non-nil, do not save the old value of the -;; target diff. This is used in merging, when constructing the merged -;; version. -(defun ediff-copy-diff (n from-buf-type to-buf-type - &optional batch-invocation reg-to-copy) - (let* ((to-buf (ediff-get-buffer to-buf-type)) - ;;(from-buf (if (not reg-to-copy) (ediff-get-buffer from-buf-type))) - (ctrl-buf ediff-control-buffer) - (saved-p t) - (three-way ediff-3way-job) - messg - ediff-verbose-p - reg-to-delete reg-to-delete-beg reg-to-delete-end) - - (setq reg-to-delete-beg - (ediff-get-diff-posn to-buf-type 'beg n ctrl-buf)) - (setq reg-to-delete-end - (ediff-get-diff-posn to-buf-type 'end n ctrl-buf)) - - (if reg-to-copy - (setq from-buf-type nil) - (setq reg-to-copy (ediff-get-region-contents n from-buf-type ctrl-buf))) - - (setq reg-to-delete (ediff-get-region-contents - n to-buf-type ctrl-buf - reg-to-delete-beg reg-to-delete-end)) - - (if (string= reg-to-delete reg-to-copy) - (setq saved-p nil) ; don't copy identical buffers - ;; seems ok to copy - (if (or batch-invocation (ediff-test-save-region n to-buf-type)) - (condition-case conds - (progn - (ediff-with-current-buffer to-buf - ;; to prevent flags from interfering if buffer is writable - (let ((inhibit-read-only (null buffer-read-only))) - - (goto-char reg-to-delete-end) - (insert reg-to-copy) - - (if (> reg-to-delete-end reg-to-delete-beg) - (kill-region reg-to-delete-beg reg-to-delete-end)) - )) - (or batch-invocation - (setq - messg - (ediff-save-diff-region n to-buf-type reg-to-delete)))) - (error (message "ediff-copy-diff: %s %s" - (car conds) - (mapconcat 'prin1-to-string (cdr conds) " ")) - (beep 1) - (sit-for 2) ; let the user see the error msg - (setq saved-p nil) - ))) - ) - - ;; adjust state of difference in case 3-way and diff was copied ok - (if (and saved-p three-way) - (ediff-set-state-of-diff-in-all-buffers n ctrl-buf)) - - (if batch-invocation - (ediff-clear-fine-differences n) - ;; If diff3 job, we should recompute fine diffs so we clear them - ;; before reinserting flags (and thus before ediff-recenter). - (if (and saved-p three-way) - (ediff-clear-fine-differences n)) - - (ediff-refresh-mode-lines) - - ;; For diff2 jobs, don't recompute fine diffs, since we know there - ;; aren't any. So we clear diffs after ediff-recenter. - (if (and saved-p (not three-way)) - (ediff-clear-fine-differences n)) - ;; Make sure that the message about saving and how to restore is seen - ;; by the user - (message "%s" messg)) - )) - -;; Save Nth diff of buffer BUF-TYPE \(A, B, or C\). -;; That is to say, the Nth diff on the `ediff-killed-diffs-alist'. REG -;; is the region to save. It is redundant here, but is passed anyway, for -;; convenience. -(defun ediff-save-diff-region (n buf-type reg) - (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist)) - (buf (ediff-get-buffer buf-type)) - (this-buf-n-th-diff-saved (assoc buf (cdr n-th-diff-saved)))) - - (if this-buf-n-th-diff-saved - ;; either nothing saved for n-th diff and buffer or we OK'ed - ;; overriding - (setcdr this-buf-n-th-diff-saved reg) - (if n-th-diff-saved ;; n-th diff saved, but for another buffer - (nconc n-th-diff-saved (list (cons buf reg))) - (setq ediff-killed-diffs-alist ;; create record for n-th diff - (cons (list n (cons buf reg)) - ediff-killed-diffs-alist)))) - (message "Saving old diff region #%d of buffer %S. To recover, type `r%s'" - (1+ n) buf-type - (if ediff-merge-job - "" (downcase (symbol-name buf-type)))) - )) - -;; Test if saving Nth difference region of buffer BUF-TYPE is possible. -(defun ediff-test-save-region (n buf-type) - (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist)) - (buf (ediff-get-buffer buf-type)) - (this-buf-n-th-diff-saved (assoc buf (cdr n-th-diff-saved)))) - - (if this-buf-n-th-diff-saved - (if (yes-or-no-p - (format - "You've previously copied diff region %d to buffer %S. Confirm? " - (1+ n) buf-type)) - t - (error "Quit")) - t))) - -(defun ediff-pop-diff (n buf-type) - "Pop last killed Nth diff region from buffer BUF-TYPE." - (let* ((n-th-record (assoc n ediff-killed-diffs-alist)) - (buf (ediff-get-buffer buf-type)) - (saved-rec (assoc buf (cdr n-th-record))) - (three-way ediff-3way-job) - (ctl-buf ediff-control-buffer) - ediff-verbose-p - saved-diff reg-beg reg-end recovered) - - (if (cdr saved-rec) - (setq saved-diff (cdr saved-rec)) - (if (> ediff-number-of-differences 0) - (error "Nothing saved for diff %d in buffer %S" (1+ n) buf-type) - (error ediff-NO-DIFFERENCES))) - - (setq reg-beg (ediff-get-diff-posn buf-type 'beg n ediff-control-buffer)) - (setq reg-end (ediff-get-diff-posn buf-type 'end n ediff-control-buffer)) - - (condition-case conds - (ediff-with-current-buffer buf - (let ((inhibit-read-only (null buffer-read-only))) - - (goto-char reg-end) - (insert saved-diff) - - (if (> reg-end reg-beg) - (kill-region reg-beg reg-end)) - - (setq recovered t) - )) - (error (message "ediff-pop-diff: %s %s" - (car conds) - (mapconcat 'prin1-to-string (cdr conds) " ")) - (beep 1))) - - ;; Clearing fine diffs is necessary for - ;; ediff-unselect-and-select-difference to properly recompute them. We - ;; can't rely on ediff-copy-diff to clear this vector, as the user might - ;; have modified diff regions after copying and, thus, may have recomputed - ;; fine diffs. - (if recovered - (ediff-clear-fine-differences n)) - - ;; adjust state of difference - (if (and three-way recovered) - (ediff-set-state-of-diff-in-all-buffers n ctl-buf)) - - (ediff-refresh-mode-lines) - - (if recovered - (progn - (setq n-th-record (delq saved-rec n-th-record)) - (message "Diff region %d in buffer %S restored" (1+ n) buf-type) - )) - )) - -(defun ediff-restore-diff (arg &optional key) - "Restore ARGth diff from `ediff-killed-diffs-alist'. -ARG is a prefix argument. If ARG is nil, restore the current-difference. -If the second optional argument, a character, is given, use it to -determine the target buffer instead of last-command-char" - (interactive "P") - (ediff-barf-if-not-control-buffer) - (if (numberp arg) - (ediff-jump-to-difference arg)) - (ediff-pop-diff ediff-current-difference - (ediff-char-to-buftype (or key last-command-char))) - ;; recenter with rehighlighting, but no messages - (let (ediff-verbose-p) - (ediff-recenter))) - -(defun ediff-restore-diff-in-merge-buffer (arg) - "Restore ARGth diff in the merge buffer. -ARG is a prefix argument. If nil, restore the current diff." - (interactive "P") - (ediff-restore-diff arg ?c)) - - -(defun ediff-toggle-regexp-match () - "Toggle between focusing and hiding of difference regions that match -a regular expression typed in by the user." - (interactive) - (ediff-barf-if-not-control-buffer) - (let ((regexp-A "") - (regexp-B "") - (regexp-C "") - msg-connective alt-msg-connective alt-connective) - (cond - ((or (and (eq ediff-skip-diff-region-function - ediff-focus-on-regexp-matches-function) - (eq last-command-char ?f)) - (and (eq ediff-skip-diff-region-function - ediff-hide-regexp-matches-function) - (eq last-command-char ?h))) - (message "Selective browsing by regexp turned off") - (setq ediff-skip-diff-region-function 'ediff-show-all-diffs)) - ((eq last-command-char ?h) - (setq ediff-skip-diff-region-function ediff-hide-regexp-matches-function - regexp-A - (read-string - (format - "Ignore A-regions matching this regexp (default %s): " - ediff-regexp-hide-A)) - regexp-B - (read-string - (format - "Ignore B-regions matching this regexp (default %s): " - ediff-regexp-hide-B))) - (if ediff-3way-comparison-job - (setq regexp-C - (read-string - (format - "Ignore C-regions matching this regexp (default %s): " - ediff-regexp-hide-C)))) - (if (eq ediff-hide-regexp-connective 'and) - (setq msg-connective "BOTH" - alt-msg-connective "ONE OF" - alt-connective 'or) - (setq msg-connective "ONE OF" - alt-msg-connective "BOTH" - alt-connective 'and)) - (if (y-or-n-p - (format - "Ignore regions that match %s regexps, OK? " - msg-connective)) - (message "Will ignore regions that match %s regexps" msg-connective) - (setq ediff-hide-regexp-connective alt-connective) - (message "Will ignore regions that match %s regexps" - alt-msg-connective)) - - (or (string= regexp-A "") (setq ediff-regexp-hide-A regexp-A)) - (or (string= regexp-B "") (setq ediff-regexp-hide-B regexp-B)) - (or (string= regexp-C "") (setq ediff-regexp-hide-C regexp-C))) - - ((eq last-command-char ?f) - (setq ediff-skip-diff-region-function - ediff-focus-on-regexp-matches-function - regexp-A - (read-string - (format - "Focus on A-regions matching this regexp (default %s): " - ediff-regexp-focus-A)) - regexp-B - (read-string - (format - "Focus on B-regions matching this regexp (default %s): " - ediff-regexp-focus-B))) - (if ediff-3way-comparison-job - (setq regexp-C - (read-string - (format - "Focus on C-regions matching this regexp (default %s): " - ediff-regexp-focus-C)))) - (if (eq ediff-focus-regexp-connective 'and) - (setq msg-connective "BOTH" - alt-msg-connective "ONE OF" - alt-connective 'or) - (setq msg-connective "ONE OF" - alt-msg-connective "BOTH" - alt-connective 'and)) - (if (y-or-n-p - (format - "Focus on regions that match %s regexps, OK? " - msg-connective)) - (message "Will focus on regions that match %s regexps" - msg-connective) - (setq ediff-focus-regexp-connective alt-connective) - (message "Will focus on regions that match %s regexps" - alt-msg-connective)) - - (or (string= regexp-A "") (setq ediff-regexp-focus-A regexp-A)) - (or (string= regexp-B "") (setq ediff-regexp-focus-B regexp-B)) - (or (string= regexp-C "") (setq ediff-regexp-focus-C regexp-C)))))) - -(defun ediff-toggle-skip-similar () - (interactive) - (ediff-barf-if-not-control-buffer) - (if (not (eq ediff-auto-refine 'on)) - (error - "Can't skip over whitespace regions: first turn auto-refining on")) - (setq ediff-ignore-similar-regions (not ediff-ignore-similar-regions)) - (if ediff-ignore-similar-regions - (message - "Skipping regions that differ only in white space & line breaks") - (message "Skipping over white-space differences turned off"))) - -(defun ediff-focus-on-regexp-matches (n) - "Focus on diffs that match regexp `ediff-regexp-focus-A/B'. -Regions to be ignored according to this function are those where -buf A region doesn't match `ediff-regexp-focus-A' and buf B region -doesn't match `ediff-regexp-focus-B'. -This function returns nil if the region number N (specified as -an argument) is not to be ignored and t if region N is to be ignored. - -N is a region number used by Ediff internally. It is 1 less -the number seen by the user." - (if (ediff-valid-difference-p n) - (let* ((ctl-buf ediff-control-buffer) - (regex-A ediff-regexp-focus-A) - (regex-B ediff-regexp-focus-B) - (regex-C ediff-regexp-focus-C) - (reg-A-match (ediff-with-current-buffer ediff-buffer-A - (save-restriction - (narrow-to-region - (ediff-get-diff-posn 'A 'beg n ctl-buf) - (ediff-get-diff-posn 'A 'end n ctl-buf)) - (goto-char (point-min)) - (re-search-forward regex-A nil t)))) - (reg-B-match (ediff-with-current-buffer ediff-buffer-B - (save-restriction - (narrow-to-region - (ediff-get-diff-posn 'B 'beg n ctl-buf) - (ediff-get-diff-posn 'B 'end n ctl-buf)) - (re-search-forward regex-B nil t)))) - (reg-C-match (if ediff-3way-comparison-job - (ediff-with-current-buffer ediff-buffer-C - (save-restriction - (narrow-to-region - (ediff-get-diff-posn 'C 'beg n ctl-buf) - (ediff-get-diff-posn 'C 'end n ctl-buf)) - (re-search-forward regex-C nil t)))))) - (not (eval (if ediff-3way-comparison-job - (list ediff-focus-regexp-connective - reg-A-match reg-B-match reg-C-match) - (list ediff-focus-regexp-connective - reg-A-match reg-B-match)))) - ))) - -(defun ediff-hide-regexp-matches (n) - "Hide diffs that match regexp `ediff-regexp-hide-A/B/C'. -Regions to be ignored are those where buf A region matches -`ediff-regexp-hide-A' and buf B region matches `ediff-regexp-hide-B'. -This function returns nil if the region number N (specified as -an argument) is not to be ignored and t if region N is to be ignored. - -N is a region number used by Ediff internally. It is 1 less -the number seen by the user." - (if (ediff-valid-difference-p n) - (let* ((ctl-buf ediff-control-buffer) - (regex-A ediff-regexp-hide-A) - (regex-B ediff-regexp-hide-B) - (regex-C ediff-regexp-hide-C) - (reg-A-match (ediff-with-current-buffer ediff-buffer-A - (save-restriction - (narrow-to-region - (ediff-get-diff-posn 'A 'beg n ctl-buf) - (ediff-get-diff-posn 'A 'end n ctl-buf)) - (goto-char (point-min)) - (re-search-forward regex-A nil t)))) - (reg-B-match (ediff-with-current-buffer ediff-buffer-B - (save-restriction - (narrow-to-region - (ediff-get-diff-posn 'B 'beg n ctl-buf) - (ediff-get-diff-posn 'B 'end n ctl-buf)) - (goto-char (point-min)) - (re-search-forward regex-B nil t)))) - (reg-C-match (if ediff-3way-comparison-job - (ediff-with-current-buffer ediff-buffer-C - (save-restriction - (narrow-to-region - (ediff-get-diff-posn 'C 'beg n ctl-buf) - (ediff-get-diff-posn 'C 'end n ctl-buf)) - (goto-char (point-min)) - (re-search-forward regex-C nil t)))))) - (eval (if ediff-3way-comparison-job - (list ediff-hide-regexp-connective - reg-A-match reg-B-match reg-C-match) - (list ediff-hide-regexp-connective reg-A-match reg-B-match))) - ))) - - - -;;; Quitting, suspending, etc. - -(defun ediff-quit (reverse-default-keep-variants) - "Finish an Ediff session and exit Ediff. -Unselects the selected difference, if any, restores the read-only and modified -flags of the compared file buffers, kills Ediff buffers for this session -\(but not buffers A, B, C\). - -If `ediff-keep-variants' is nil, the user will be asked whether the buffers -containing the variants should be removed \(if they haven't been modified\). -If it is t, they will be preserved unconditionally. A prefix argument, -temporarily reverses the meaning of this variable." - (interactive "P") - (ediff-barf-if-not-control-buffer) - (let ((ctl-buf (current-buffer))) - (if (y-or-n-p (format "Quit this Ediff session%s? " - (if (ediff-buffer-live-p ediff-meta-buffer) - " & show containing session group" ""))) - (progn - (message "") - (set-buffer ctl-buf) - (ediff-really-quit reverse-default-keep-variants)) - (message "")))) - - -;; Perform the quit operations. -(defun ediff-really-quit (reverse-default-keep-variants) - (ediff-unhighlight-diffs-totally) - (ediff-clear-diff-vector 'ediff-difference-vector-A 'fine-diffs-also) - (ediff-clear-diff-vector 'ediff-difference-vector-B 'fine-diffs-also) - (ediff-clear-diff-vector 'ediff-difference-vector-C 'fine-diffs-also) - (ediff-clear-diff-vector 'ediff-difference-vector-Ancestor 'fine-diffs-also) - - (ediff-delete-temp-files) - - ;; Restore the visibility range. This affects only ediff-*-regions/windows. - ;; Since for other job names ediff-visible-region sets - ;; ediff-visible-bounds to ediff-wide-bounds, the settings below are - ;; ignored for such jobs. - (if ediff-quit-widened - (setq ediff-visible-bounds ediff-wide-bounds) - (setq ediff-visible-bounds ediff-narrow-bounds)) - - ;; Apply selective display to narrow or widen - (ediff-visible-region) - (mapcar (lambda (overl) - (if (ediff-overlayp overl) - (ediff-delete-overlay overl))) - ediff-wide-bounds) - (mapcar (lambda (overl) - (if (ediff-overlayp overl) - (ediff-delete-overlay overl))) - ediff-narrow-bounds) - - ;; restore buffer mode line id's in buffer-A/B/C - (let ((control-buffer ediff-control-buffer) - (meta-buffer ediff-meta-buffer) - (after-quit-hook-internal ediff-after-quit-hook-internal) - (session-number ediff-meta-session-number) - ;; suitable working frame - (warp-frame (if (and (ediff-window-display-p) (eq ediff-grab-mouse t)) - (cond ((window-live-p ediff-window-A) - (window-frame ediff-window-A)) - ((window-live-p ediff-window-B) - (window-frame ediff-window-B)) - (t (next-frame)))))) - (condition-case nil - (ediff-with-current-buffer ediff-buffer-A - (setq ediff-this-buffer-ediff-sessions - (delq control-buffer ediff-this-buffer-ediff-sessions)) - (kill-local-variable 'mode-line-buffer-identification) - (kill-local-variable 'mode-line-format) - ) - (error)) - - (condition-case nil - (ediff-with-current-buffer ediff-buffer-B - (setq ediff-this-buffer-ediff-sessions - (delq control-buffer ediff-this-buffer-ediff-sessions)) - (kill-local-variable 'mode-line-buffer-identification) - (kill-local-variable 'mode-line-format) - ) - (error)) - - (condition-case nil - (ediff-with-current-buffer ediff-buffer-C - (setq ediff-this-buffer-ediff-sessions - (delq control-buffer ediff-this-buffer-ediff-sessions)) - (kill-local-variable 'mode-line-buffer-identification) - (kill-local-variable 'mode-line-format) - ) - (error)) - - (condition-case nil - (ediff-with-current-buffer ediff-ancestor-buffer - (setq ediff-this-buffer-ediff-sessions - (delq control-buffer ediff-this-buffer-ediff-sessions)) - (kill-local-variable 'mode-line-buffer-identification) - (kill-local-variable 'mode-line-format) - ) - (error)) - - (setq ediff-session-registry - (delq ediff-control-buffer ediff-session-registry)) - (ediff-update-registry) - ;; restore state of buffers to what it was before ediff - (ediff-restore-protected-variables) - - ;; If the user interrupts (canceling saving the merge buffer), continue - ;; normally. - (condition-case nil - (if (ediff-merge-job) - (run-hooks 'ediff-quit-merge-hook)) - (quit)) - - (run-hooks 'ediff-cleanup-hook) - - (ediff-janitor - 'ask - ;; reverse-default-keep-variants is t if the user quits with a prefix arg - (if reverse-default-keep-variants - (not ediff-keep-variants) - ediff-keep-variants)) - - ;; one hook here is ediff-cleanup-mess, which kills the control buffer and - ;; other auxiliary buffers. we made it into a hook to let the users do their - ;; own cleanup, if needed. - (run-hooks 'ediff-quit-hook) - (ediff-update-meta-buffer meta-buffer nil session-number) - - ;; warp mouse into a working window - (setq warp-frame ; if mouse is over a reasonable frame, use it - (cond ((ediff-good-frame-under-mouse)) - (t warp-frame))) - (if (and (ediff-window-display-p) (frame-live-p warp-frame) ediff-grab-mouse) - (set-mouse-position (if ediff-emacs-p - warp-frame - (frame-selected-window warp-frame)) - 2 1)) - - (run-hooks 'after-quit-hook-internal) - )) - -;; Returns frame under mouse, if this frame is not a minibuffer -;; frame. Otherwise: nil -(defun ediff-good-frame-under-mouse () - (let ((frame-or-win (car (mouse-position))) - (buf-name "") - frame obj-ok) - (setq obj-ok - (if ediff-emacs-p - (frame-live-p frame-or-win) - (window-live-p frame-or-win))) - (if obj-ok - (setq frame (if ediff-emacs-p frame-or-win (window-frame frame-or-win)) - buf-name - (buffer-name (window-buffer (frame-selected-window frame))))) - (if (string-match "Minibuf" buf-name) - nil - frame))) - - -(defun ediff-delete-temp-files () - (if (and (stringp ediff-temp-file-A) (file-exists-p ediff-temp-file-A)) - (delete-file ediff-temp-file-A)) - (if (and (stringp ediff-temp-file-B) (file-exists-p ediff-temp-file-B)) - (delete-file ediff-temp-file-B)) - (if (and (stringp ediff-temp-file-C) (file-exists-p ediff-temp-file-C)) - (delete-file ediff-temp-file-C))) - - -;; Kill control buffer, other auxiliary Ediff buffers. -;; Leave one of the frames split between buffers A/B/C -(defun ediff-cleanup-mess () - (let* ((buff-A ediff-buffer-A) - (buff-B ediff-buffer-B) - (buff-C ediff-buffer-C) - (ctl-buf ediff-control-buffer) - (ctl-wind (ediff-get-visible-buffer-window ctl-buf)) - (ctl-frame ediff-control-frame) - (three-way-job ediff-3way-job) - (main-frame (cond ((window-live-p ediff-window-A) - (window-frame ediff-window-A)) - ((window-live-p ediff-window-B) - (window-frame ediff-window-B))))) - - (ediff-kill-buffer-carefully ediff-diff-buffer) - (ediff-kill-buffer-carefully ediff-custom-diff-buffer) - (ediff-kill-buffer-carefully ediff-fine-diff-buffer) - (ediff-kill-buffer-carefully ediff-tmp-buffer) - (ediff-kill-buffer-carefully ediff-error-buffer) - (ediff-kill-buffer-carefully ediff-msg-buffer) - (ediff-kill-buffer-carefully ediff-debug-buffer) - (if (boundp 'ediff-patch-diagnostics) - (ediff-kill-buffer-carefully ediff-patch-diagnostics)) - - ;; delete control frame or window - (cond ((and (ediff-window-display-p) (frame-live-p ctl-frame)) - (delete-frame ctl-frame)) - ((window-live-p ctl-wind) - (delete-window ctl-wind))) - - ;; Hide bottom toolbar. --marcpa - (if (not (ediff-multiframe-setup-p)) - (ediff-kill-bottom-toolbar)) - - (ediff-kill-buffer-carefully ctl-buf) - - (if (frame-live-p main-frame) - (select-frame main-frame)) - - ;; display only if not visible - (condition-case nil - (or (ediff-get-visible-buffer-window buff-B) - (switch-to-buffer buff-B)) - (error)) - (condition-case nil - (or (ediff-get-visible-buffer-window buff-A) - (progn - (if (and (ediff-get-visible-buffer-window buff-B) - (ediff-buffer-live-p buff-A)) - (funcall ediff-split-window-function)) - (switch-to-buffer buff-A))) - (error)) - (if three-way-job - (condition-case nil - (or (ediff-get-visible-buffer-window buff-C) - (progn - (if (and (or (ediff-get-visible-buffer-window buff-A) - (ediff-get-visible-buffer-window buff-B)) - (ediff-buffer-live-p buff-C)) - (funcall ediff-split-window-function)) - (switch-to-buffer buff-C))) - (error))) - (balance-windows) - (message "") - )) - -(defun ediff-janitor (ask keep-variants) - "Kill buffers A, B, and, possibly, C, if these buffers aren't modified. -In merge jobs, buffer C is not deleted here, but rather according to -ediff-quit-merge-hook. -A side effect of cleaning up may be that you should be careful when comparing -the same buffer in two separate Ediff sessions: quitting one of them might -delete this buffer in another session as well." - (ediff-dispose-of-variant-according-to-user - ediff-buffer-A 'A ask keep-variants) - (ediff-dispose-of-variant-according-to-user - ediff-buffer-B 'B ask keep-variants) - (if ediff-merge-job ; don't del buf C if merging--del ancestor buf instead - (ediff-dispose-of-variant-according-to-user - ediff-ancestor-buffer 'Ancestor ask keep-variants) - (ediff-dispose-of-variant-according-to-user - ediff-buffer-C 'C ask keep-variants) - )) - -;; Kill the variant buffer, according to user directives (ask, kill -;; unconditionaly, keep) -;; BUFF is the buffer, BUFF-TYPE is either 'A, or 'B, 'C, 'Ancestor -(defun ediff-dispose-of-variant-according-to-user (buff bufftype ask keep-variants) - ;; if this is indirect buffer, kill it and substitute with direct buf - (if (and (ediff-buffer-live-p buff) - (ediff-with-current-buffer buff ediff-temp-indirect-buffer)) - (let ((wind (ediff-get-visible-buffer-window buff)) - (base (buffer-base-buffer buff)) - (modified-p (buffer-modified-p buff))) - (if (and (window-live-p wind) (ediff-buffer-live-p base)) - (set-window-buffer wind base)) - ;; Kill indirect buffer even if it is modified, because the base buffer - ;; is still there. Note that if the base buffer is dead then so will be - ;; the indirect buffer - (ediff-with-current-buffer buff - (set-buffer-modified-p nil)) - (ediff-kill-buffer-carefully buff) - (ediff-with-current-buffer base - (set-buffer-modified-p modified-p))) - ;; otherwise, ask or use the value of keep-variants - (or (not (ediff-buffer-live-p buff)) - keep-variants - (buffer-modified-p buff) - (and ask - (not (y-or-n-p (format "Kill buffer %S [%s]? " - bufftype (buffer-name buff))))) - (ediff-kill-buffer-carefully buff)) - )) - -(defun ediff-maybe-save-and-delete-merge (&optional save-and-continue) - "Default hook to run on quitting a merge job. -This can also be used to save merge buffer in the middle of an Ediff session. - -If the optional SAVE-AND-CONTINUE argument is non-nil, save merge buffer and -continue. Otherwise: -If `ediff-autostore-merges' is nil, this does nothing. -If it is t, it saves the merge buffer in the file `ediff-merge-store-file' -or asks the user, if the latter is nil. It then asks the user whether to -delete the merge buffer. -If `ediff-autostore-merges' is neither nil nor t, the merge buffer is saved -only if this merge job is part of a group, i.e., was invoked from within -`ediff-merge-directories', `ediff-merge-directory-revisions', and such." - (let ((merge-store-file ediff-merge-store-file) - (ediff-autostore-merges ; fake ediff-autostore-merges, if necessary - (if save-and-continue t ediff-autostore-merges))) - (if ediff-autostore-merges - (cond ((stringp merge-store-file) - ;; store, ask to delete - (ediff-write-merge-buffer-and-maybe-kill - ediff-buffer-C merge-store-file 'show-file save-and-continue)) - ((eq ediff-autostore-merges t) - ;; ask for file name - (setq merge-store-file - (read-file-name "Save the result of the merge in file: ")) - (ediff-write-merge-buffer-and-maybe-kill - ediff-buffer-C merge-store-file nil save-and-continue)) - ((and (ediff-buffer-live-p ediff-meta-buffer) - (ediff-with-current-buffer ediff-meta-buffer - (ediff-merge-metajob))) - ;; The parent metajob passed nil as the autostore file. - nil))) - )) - -;; write merge buffer. If the optional argument save-and-continue is non-nil, -;; then don't kill the merge buffer -(defun ediff-write-merge-buffer-and-maybe-kill (buf file - &optional - show-file save-and-continue) - (if (not (eq (find-buffer-visiting file) buf)) - (let ((warn-message - (format "Another buffer is visiting file %s. Too dangerous to save the merge buffer" - file))) - (beep) - (message "%s" warn-message) - (with-output-to-temp-buffer ediff-msg-buffer - (princ "\n\n") - (princ warn-message) - (princ "\n\n") - ) - (sit-for 2)) - (ediff-with-current-buffer buf - (if (or (not (file-exists-p file)) - (y-or-n-p (format "File %s exists, overwrite? " file))) - (progn - ;;(write-region (point-min) (point-max) file) - (ediff-with-current-buffer buf - (set-visited-file-name file) - (save-buffer)) - (if show-file - (progn - (message "Merge buffer saved in: %s" file) - (set-buffer-modified-p nil) - (sit-for 3))) - (if (and - (not save-and-continue) - (y-or-n-p "Merge buffer saved. Now kill the buffer? ")) - (ediff-kill-buffer-carefully buf))))) - )) - -;; The default way of suspending Ediff. -;; Buries Ediff buffers, kills all windows. -(defun ediff-default-suspend-function () - (let* ((buf-A ediff-buffer-A) - (buf-B ediff-buffer-B) - (buf-C ediff-buffer-C) - (buf-A-wind (ediff-get-visible-buffer-window buf-A)) - (buf-B-wind (ediff-get-visible-buffer-window buf-B)) - (buf-C-wind (ediff-get-visible-buffer-window buf-C)) - (buf-patch (if (boundp 'ediff-patchbufer) ediff-patchbufer nil)) - (buf-patch-diag (if (boundp 'ediff-patch-diagnostics) - ediff-patch-diagnostics nil)) - (buf-err ediff-error-buffer) - (buf-diff ediff-diff-buffer) - (buf-custom-diff ediff-custom-diff-buffer) - (buf-fine-diff ediff-fine-diff-buffer)) - - ;; hide the control panel - (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) - (iconify-frame ediff-control-frame) - (bury-buffer)) - (if buf-err (bury-buffer buf-err)) - (if buf-diff (bury-buffer buf-diff)) - (if buf-custom-diff (bury-buffer buf-custom-diff)) - (if buf-fine-diff (bury-buffer buf-fine-diff)) - (if buf-patch (bury-buffer buf-patch)) - (if buf-patch-diag (bury-buffer buf-patch-diag)) - (if (window-live-p buf-A-wind) - (progn - (select-window buf-A-wind) - (delete-other-windows) - (bury-buffer)) - (if (ediff-buffer-live-p buf-A) - (progn - (set-buffer buf-A) - (bury-buffer)))) - (if (window-live-p buf-B-wind) - (progn - (select-window buf-B-wind) - (delete-other-windows) - (bury-buffer)) - (if (ediff-buffer-live-p buf-B) - (progn - (set-buffer buf-B) - (bury-buffer)))) - (if (window-live-p buf-C-wind) - (progn - (select-window buf-C-wind) - (delete-other-windows) - (bury-buffer)) - (if (ediff-buffer-live-p buf-C) - (progn - (set-buffer buf-C) - (bury-buffer)))) - )) - - -(defun ediff-suspend () - "Suspend Ediff. -To resume, switch to the appropriate `Ediff Control Panel' -buffer and then type \\[ediff-recenter]. Ediff will automatically set -up an appropriate window config." - (interactive) - (ediff-barf-if-not-control-buffer) - (run-hooks 'ediff-suspend-hook) - (message - "To resume, type M-x eregistry and select the desired Ediff session")) - - -(defun ediff-status-info () - "Show the names of the buffers or files being operated on by Ediff. -Hit \\[ediff-recenter] to reset the windows afterward." - (interactive) - (ediff-barf-if-not-control-buffer) - (save-excursion - (ediff-skip-unsuitable-frames)) - (with-output-to-temp-buffer ediff-msg-buffer - (ediff-with-current-buffer standard-output - (fundamental-mode)) - (raise-frame (selected-frame)) - (princ (ediff-version)) - (princ "\n\n") - (ediff-with-current-buffer ediff-buffer-A - (if buffer-file-name - (princ - (format "File A = %S\n" buffer-file-name)) - (princ - (format "Buffer A = %S\n" (buffer-name))))) - (ediff-with-current-buffer ediff-buffer-B - (if buffer-file-name - (princ - (format "File B = %S\n" buffer-file-name)) - (princ - (format "Buffer B = %S\n" (buffer-name))))) - (if ediff-3way-job - (ediff-with-current-buffer ediff-buffer-C - (if buffer-file-name - (princ - (format "File C = %S\n" buffer-file-name)) - (princ - (format "Buffer C = %S\n" (buffer-name)))))) - (princ (format "Customized diff output %s\n" - (if (ediff-buffer-live-p ediff-custom-diff-buffer) - (concat "\tin buffer " - (buffer-name ediff-custom-diff-buffer)) - " is not available"))) - (princ (format "Plain diff output %s\n" - (if (ediff-buffer-live-p ediff-diff-buffer) - (concat "\tin buffer " - (buffer-name ediff-diff-buffer)) - " is not available"))) - - (let* ((A-line (ediff-with-current-buffer ediff-buffer-A - (1+ (count-lines (point-min) (point))))) - (B-line (ediff-with-current-buffer ediff-buffer-B - (1+ (count-lines (point-min) (point))))) - C-line) - (princ (format "\Buffer A's point is on line %d\n" A-line)) - (princ (format "Buffer B's point is on line %d\n" B-line)) - (if ediff-3way-job - (progn - (setq C-line (ediff-with-current-buffer ediff-buffer-C - (1+ (count-lines (point-min) (point))))) - (princ (format "Buffer C's point is on line %d\n" C-line))))) - - (princ (format "\nCurrent difference number = %S\n" - (cond ((< ediff-current-difference 0) 'start) - ((>= ediff-current-difference - ediff-number-of-differences) 'end) - (t (1+ ediff-current-difference))))) - - (princ - (format "\n%s regions that differ in white space & line breaks only" - (if ediff-ignore-similar-regions - "Ignoring" "Showing"))) - (if (and ediff-merge-job ediff-show-clashes-only) - (princ - "\nFocusing on regions where both buffers differ from the ancestor")) - (if (and ediff-skip-merge-regions-that-differ-from-default ediff-merge-job) - (princ - "\nSkipping merge regions that differ from default setting")) - - (cond ((eq ediff-skip-diff-region-function 'ediff-show-all-diffs) - (princ "\nSelective browsing by regexp is off\n")) - ((eq ediff-skip-diff-region-function - ediff-hide-regexp-matches-function) - (princ - "\nIgnoring regions that match") - (princ - (format - "\n\t regexp `%s' in buffer A %S\n\t regexp `%s' in buffer B\n" - ediff-regexp-hide-A ediff-hide-regexp-connective - ediff-regexp-hide-B))) - ((eq ediff-skip-diff-region-function - ediff-focus-on-regexp-matches-function) - (princ - "\nFocusing on regions that match") - (princ - (format - "\n\t regexp `%s' in buffer A %S\n\t regexp `%s' in buffer B\n" - ediff-regexp-focus-A ediff-focus-regexp-connective - ediff-regexp-focus-B))) - (t (princ "\nSelective browsing via a user-defined method.\n"))) - - (princ - (format "\nBugs/suggestions: type `%s' while in Ediff Control Panel." - (substitute-command-keys "\\[ediff-submit-report]"))) - ) ; with output - (if (frame-live-p ediff-control-frame) - (ediff-reset-mouse ediff-control-frame)) - (if (window-live-p ediff-control-window) - (select-window ediff-control-window))) - - - - -;;; Support routines - -;; Select a difference by placing the ASCII flags around the appropriate -;; group of lines in the A, B buffers -;; This may have to be modified for buffer C, when it will be supported. -(defun ediff-select-difference (n) - (if (and (ediff-buffer-live-p ediff-buffer-A) - (ediff-buffer-live-p ediff-buffer-B) - (ediff-valid-difference-p n)) - (progn - (cond - ((and (ediff-has-face-support-p) ediff-use-faces) - (ediff-highlight-diff n)) - ((eq ediff-highlighting-style 'ascii) - (ediff-place-flags-in-buffer - 'A ediff-buffer-A ediff-control-buffer n) - (ediff-place-flags-in-buffer - 'B ediff-buffer-B ediff-control-buffer n) - (if ediff-3way-job - (ediff-place-flags-in-buffer - 'C ediff-buffer-C ediff-control-buffer n)) - (if (ediff-buffer-live-p ediff-ancestor-buffer) - (ediff-place-flags-in-buffer - 'Ancestor ediff-ancestor-buffer - ediff-control-buffer n)) - )) - - (ediff-install-fine-diff-if-necessary n) - ;; set current difference here so the hook will be able to refer to it - (setq ediff-current-difference n) - (run-hooks 'ediff-select-hook)))) - - -;; Unselect a difference by removing the ASCII flags in the buffers. -;; This may have to be modified for buffer C, when it will be supported. -(defun ediff-unselect-difference (n) - (if (ediff-valid-difference-p n) - (progn - (cond ((and (ediff-has-face-support-p) ediff-use-faces) - (ediff-unhighlight-diff)) - ((eq ediff-highlighting-style 'ascii) - (ediff-remove-flags-from-buffer - ediff-buffer-A - (ediff-get-diff-overlay n 'A)) - (ediff-remove-flags-from-buffer - ediff-buffer-B - (ediff-get-diff-overlay n 'B)) - (if ediff-3way-job - (ediff-remove-flags-from-buffer - ediff-buffer-C - (ediff-get-diff-overlay n 'C))) - (if (ediff-buffer-live-p ediff-ancestor-buffer) - (ediff-remove-flags-from-buffer - ediff-ancestor-buffer - (ediff-get-diff-overlay n 'Ancestor))) - )) - - ;; unhighlight fine diffs - (ediff-set-fine-diff-properties ediff-current-difference 'default) - (run-hooks 'ediff-unselect-hook)))) - - -;; Unselects prev diff and selects a new one, if FLAG has value other than -;; 'select-only or 'unselect-only. If FLAG is 'select-only, the -;; next difference is selected, but the current selection is not -;; unselected. If FLAG is 'unselect-only then the current selection is -;; unselected, but the next one is not selected. If NO-RECENTER is non-nil, -;; don't recenter buffers after selecting/unselecting. -(defun ediff-unselect-and-select-difference (n &optional flag no-recenter) - (let ((ediff-current-difference n)) - (or no-recenter - (ediff-recenter 'no-rehighlight))) - - (let ((control-buf ediff-control-buffer)) - (unwind-protect - (progn - (or (eq flag 'select-only) - (ediff-unselect-difference ediff-current-difference)) - - (or (eq flag 'unselect-only) - (ediff-select-difference n)) - ;; need to set current diff here even though it is also set in - ;; ediff-select-difference because ediff-select-difference might not - ;; be called if unselect-only is specified - (setq ediff-current-difference n) - ) ; end protected section - - (ediff-with-current-buffer control-buf (ediff-refresh-mode-lines))) - )) - - - -(defun ediff-highlight-diff-in-one-buffer (n buf-type) - (if (ediff-buffer-live-p (ediff-get-buffer buf-type)) - (let* ((buff (ediff-get-buffer buf-type)) - (last (ediff-with-current-buffer buff (point-max))) - (begin (ediff-get-diff-posn buf-type 'beg n)) - (end (ediff-get-diff-posn buf-type 'end n)) - (xtra (if (equal begin end) 1 0)) - (end-hilit (min last (+ end xtra))) - (current-diff-overlay - (symbol-value - (ediff-get-symbol-from-alist - buf-type ediff-current-diff-overlay-alist)))) - - (if ediff-xemacs-p - (ediff-move-overlay current-diff-overlay begin end-hilit) - (ediff-move-overlay current-diff-overlay begin end-hilit buff)) - (ediff-overlay-put current-diff-overlay 'priority - (ediff-highest-priority begin end-hilit buff)) - (ediff-overlay-put current-diff-overlay 'ediff-diff-num n) - - ;; unhighlight the background overlay for diff n so it won't - ;; interfere with the current diff overlay - (ediff-set-overlay-face (ediff-get-diff-overlay n buf-type) nil) - ))) - - -(defun ediff-unhighlight-diff-in-one-buffer (buf-type) - (if (ediff-buffer-live-p (ediff-get-buffer buf-type)) - (let ((current-diff-overlay - (symbol-value - (ediff-get-symbol-from-alist - buf-type ediff-current-diff-overlay-alist))) - (overlay - (ediff-get-diff-overlay ediff-current-difference buf-type)) - ) - - (ediff-move-overlay current-diff-overlay 1 1) - - ;; rehighlight the overlay in the background of the - ;; current difference region - (ediff-set-overlay-face - overlay - (if (and (ediff-has-face-support-p) - ediff-use-faces ediff-highlight-all-diffs) - (ediff-background-face buf-type ediff-current-difference))) - ))) - -(defun ediff-unhighlight-diffs-totally-in-one-buffer (buf-type) - (ediff-unselect-and-select-difference -1) - (if (and (ediff-has-face-support-p) ediff-use-faces) - (let* ((inhibit-quit t) - (current-diff-overlay-var - (ediff-get-symbol-from-alist - buf-type ediff-current-diff-overlay-alist)) - (current-diff-overlay (symbol-value current-diff-overlay-var))) - (ediff-paint-background-regions 'unhighlight) - (if (ediff-overlayp current-diff-overlay) - (ediff-delete-overlay current-diff-overlay)) - (set current-diff-overlay-var nil) - ))) - - -(defun ediff-highlight-diff (n) - "Put face on diff N. Invoked for X displays only." - (ediff-highlight-diff-in-one-buffer n 'A) - (ediff-highlight-diff-in-one-buffer n 'B) - (ediff-highlight-diff-in-one-buffer n 'C) - (ediff-highlight-diff-in-one-buffer n 'Ancestor) - ) - - -(defun ediff-unhighlight-diff () - "Remove overlays from buffers A, B, and C." - (ediff-unhighlight-diff-in-one-buffer 'A) - (ediff-unhighlight-diff-in-one-buffer 'B) - (ediff-unhighlight-diff-in-one-buffer 'C) - (ediff-unhighlight-diff-in-one-buffer 'Ancestor) - ) - -;; delete highlighting overlays, restore faces to their original form -(defun ediff-unhighlight-diffs-totally () - (ediff-unhighlight-diffs-totally-in-one-buffer 'A) - (ediff-unhighlight-diffs-totally-in-one-buffer 'B) - (ediff-unhighlight-diffs-totally-in-one-buffer 'C) - (ediff-unhighlight-diffs-totally-in-one-buffer 'Ancestor) - ) - - -;; This is adapted from a similar function in `emerge.el'. -;; PROMPT should not have a trailing ': ', so that it can be modified -;; according to context. -;; If DEFAULT-FILE is set, it should be used as the default value. -;; If DEFAULT-DIR is non-nil, use it as the default directory. -;; Otherwise, use the value of Emacs' variable `default-directory.' -(defun ediff-read-file-name (prompt default-dir default-file &optional no-dirs) - ;; hack default-dir if it is not set - (setq default-dir - (file-name-as-directory - (ediff-abbreviate-file-name - (expand-file-name (or default-dir - (and default-file - (file-name-directory default-file)) - default-directory))))) - - ;; strip the directory from default-file - (if default-file - (setq default-file (file-name-nondirectory default-file))) - (if (string= default-file "") - (setq default-file nil)) - - (let (f) - (setq f (expand-file-name - (read-file-name - (format "%s%s " - prompt - (cond (default-file - (concat " (default " default-file "):")) - (t (concat " (default " default-dir "):")))) - default-dir - (or default-file default-dir) - t ; must match, no-confirm - (if default-file (file-name-directory default-file)) - ) - default-dir - )) - ;; If user entered a directory name, expand the default file in that - ;; directory. This allows the user to enter a directory name for the - ;; B-file and diff against the default-file in that directory instead - ;; of a DIRED listing! - (if (and (file-directory-p f) default-file) - (setq f (expand-file-name - (file-name-nondirectory default-file) f))) - (if (and no-dirs (file-directory-p f)) - (error "File %s is a directory" f)) - f)) - -;; If PREFIX is given, then it is used as a prefix for the temp file -;; name. Otherwise, `ediff' is used. If FILE is given, use this -;; file and don't create a new one. -;; In MS-DOS, make sure the prefix isn't too long, or else -;; `make-temp-name' isn't guaranteed to return a unique filename. -;; Also, save buffer from START to END in the file. -;; START defaults to (point-min), END to (point-max) -(defun ediff-make-temp-file (buff &optional prefix given-file start end) - (let* ((p (ediff-convert-standard-filename (or prefix "ediff"))) - (short-p p) - (coding-system-for-write ediff-coding-system-for-write) - f short-f) - (if (and (fboundp 'msdos-long-file-names) - (not (msdos-long-file-names)) - (> (length p) 2)) - (setq short-p (substring p 0 2))) - - (setq f (concat ediff-temp-file-prefix p) - short-f (concat ediff-temp-file-prefix short-p) - f (cond (given-file) - ((find-file-name-handler f 'insert-file-contents) - ;; to thwart file handlers in write-region, e.g., if file - ;; name ends with .Z or .gz - ;; This is needed so that patches produced by ediff will - ;; have more meaningful names - (ediff-make-empty-tmp-file short-f)) - (prefix - ;; Prefix is most often the same as the file name for the - ;; variant. Here we are trying to use the original file - ;; name but in the temp directory. - (ediff-make-empty-tmp-file f 'keep-name)) - (t - ;; If don't care about name, add some random stuff - ;; to proposed file name. - (ediff-make-empty-tmp-file short-f)))) - - ;; create the file - (ediff-with-current-buffer buff - (write-region (if start start (point-min)) - (if end end (point-max)) - f - nil ; don't append---erase - 'no-message) - (set-file-modes f ediff-temp-file-mode) - (expand-file-name f)))) - -;; Create a temporary file. -;; The returned file name (created by appending some random characters at the -;; end of PROPOSED-NAME is guaranteed to point to a newly created empty file. -;; This is a replacement for make-temp-name, which eliminates a security hole. -;; If KEEP-PROPOSED-NAME isn't nil, try to keep PROPOSED-NAME, unless such file -;; already exists. -;; It is a modified version of make-temp-file in emacs 20.5 -(defun ediff-make-empty-tmp-file (proposed-name &optional keep-proposed-name) - (let ((file proposed-name)) - (while (condition-case () - (progn - (if (or (file-exists-p file) (not keep-proposed-name)) - (setq file (make-temp-name proposed-name))) - ;; the with-temp-buffer thing is a workaround for an XEmacs - ;; bug: write-region complains that we are trying to visit a - ;; file in an indirect buffer, failing to notice that the - ;; VISIT flag is unset and that we are actually writing from a - ;; string and not from any buffer. - (with-temp-buffer - (write-region "" nil file nil 'silent nil 'excl)) - nil) - (file-already-exists t)) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file)) - - -;; Quote metacharacters (using \) when executing diff in Unix, but not in -;; EMX OS/2 -;;(defun ediff-protect-metachars (str) -;; (or (memq system-type '(emx vax-vms axp-vms)) -;; (let ((limit 0)) -;; (while (string-match ediff-metachars str limit) -;; (setq str (concat (substring str 0 (match-beginning 0)) -;; "\\" -;; (substring str (match-beginning 0)))) -;; (setq limit (1+ (match-end 0)))))) -;; str) - -;; Make sure the current buffer (for a file) has the same contents as the -;; file on disk, and attempt to remedy the situation if not. -;; Signal an error if we can't make them the same, or the user doesn't want -;; to do what is necessary to make them the same. -;; Also, Ediff always offers to revert obsolete buffers, whether they -;; are modified or not. -(defun ediff-verify-file-buffer (&optional file-magic) - ;; First check if the file has been modified since the buffer visited it. - (if (verify-visited-file-modtime (current-buffer)) - (if (buffer-modified-p) - ;; If buffer is not obsolete and is modified, offer to save - (if (yes-or-no-p - (format "Buffer %s has been modified. Save it in file %s? " - (buffer-name) - buffer-file-name)) - (condition-case nil - (save-buffer) - (error - (beep) - (message "Couldn't save %s" buffer-file-name))) - (error "Buffer is out of sync for file %s" buffer-file-name)) - ;; If buffer is not obsolete and is not modified, do nothing - nil) - ;; If buffer is obsolete, offer to revert - (if (yes-or-no-p - (format "File %s was modified since visited by buffer %s. REVERT file %s? " - buffer-file-name - (buffer-name) - buffer-file-name)) - (progn - (if file-magic - (erase-buffer)) - (revert-buffer t t)) - (error "Buffer out of sync for file %s" buffer-file-name)))) - -;; if there is another buffer visiting the file of the merge buffer, offer to -;; save and delete the buffer; else bark -(defun ediff-verify-file-merge-buffer (file) - (let ((buff (if (stringp file) (find-buffer-visiting file))) - warn-message) - (or (null buff) - (progn - (setq warn-message - (format "Buffer %s is visiting %s. Save and kill the buffer? " - (buffer-name buff) file)) - (with-output-to-temp-buffer ediff-msg-buffer - (princ "\n\n") - (princ warn-message) - (princ "\n\n")) - (if (y-or-n-p - (message "%s" warn-message)) - (with-current-buffer buff - (save-buffer) - (kill-buffer (current-buffer))) - (error "Too dangerous to merge versions of a file visited by another buffer")))) - )) - - - -(defun ediff-filename-magic-p (file) - (or (ediff-file-compressed-p file) - (ediff-file-remote-p file))) - - -(defun ediff-save-buffer (arg) - "Safe way of saving buffers A, B, C, and the diff output. -`wa' saves buffer A, `wb' saves buffer B, `wc' saves buffer C, -and `wd' saves the diff output. - -With prefix argument, `wd' saves plain diff output. -Without an argument, it saves customized diff argument, if available -\(and plain output, if customized output was not generated\)." - (interactive "P") - (ediff-barf-if-not-control-buffer) - (ediff-compute-custom-diffs-maybe) - (ediff-with-current-buffer - (cond ((memq last-command-char '(?a ?b ?c)) - (ediff-get-buffer - (ediff-char-to-buftype last-command-char))) - ((eq last-command-char ?d) - (message "Saving diff output ...") - (sit-for 1) ; let the user see the message - (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer)) - ediff-diff-buffer) - ((ediff-buffer-live-p ediff-custom-diff-buffer) - ediff-custom-diff-buffer) - ((ediff-buffer-live-p ediff-diff-buffer) - ediff-diff-buffer) - (t (error "Output from `diff' not found")))) - ) - (save-buffer))) - - -;; idea suggested by Hannu Koivisto -(defun ediff-clone-buffer-for-region-comparison (buff region-name) - (let ((cloned-buff (ediff-make-cloned-buffer buff region-name)) - (pop-up-windows t) - wind - other-wind - msg-buf) - (ediff-with-current-buffer cloned-buff - (setq ediff-temp-indirect-buffer t)) - (pop-to-buffer cloned-buff) - (setq wind (ediff-get-visible-buffer-window cloned-buff)) - (select-window wind) - (delete-other-windows) - (split-window-vertically) - (ediff-select-lowest-window) - (setq other-wind (selected-window)) - (with-temp-buffer - (erase-buffer) - (insert - (format "\n ******* Mark a region in buffer %s *******\n" - (buffer-name cloned-buff))) - (insert - (ediff-with-current-buffer buff - (format "\n\t When done, type %s Use %s to abort\n " - (ediff-format-bindings-of 'exit-recursive-edit) - (ediff-format-bindings-of 'abort-recursive-edit)))) - (goto-char (point-min)) - (setq msg-buf (current-buffer)) - (set-window-buffer other-wind msg-buf) - (shrink-window-if-larger-than-buffer) - (if (window-live-p wind) - (select-window wind)) - (condition-case nil - (recursive-edit) - (quit - (ediff-kill-buffer-carefully cloned-buff))) - ) - cloned-buff)) - - -(defun ediff-clone-buffer-for-window-comparison (buff wind region-name) - (let ((cloned-buff (ediff-make-cloned-buffer buff region-name))) - (ediff-with-current-buffer cloned-buff - (setq ediff-temp-indirect-buffer t)) - (set-window-buffer wind cloned-buff) - cloned-buff)) - -(defun ediff-clone-buffer-for-current-diff-comparison (buff buf-type reg-name) - (let ((cloned-buff (ediff-make-cloned-buffer buff reg-name)) - (reg-start (ediff-get-diff-posn buf-type 'beg)) - (reg-end (ediff-get-diff-posn buf-type 'end))) - (ediff-with-current-buffer cloned-buff - ;; set region to be the current diff region - (goto-char reg-start) - (set-mark reg-end) - (setq ediff-temp-indirect-buffer t)) - cloned-buff)) - - - -(defun ediff-make-cloned-buffer (buff region-name) - (ediff-make-indirect-buffer - buff (generate-new-buffer-name - (concat (if (stringp buff) buff (buffer-name buff)) region-name)) - )) - - -(defun ediff-make-indirect-buffer (base-buf indirect-buf-name) - (ediff-cond-compile-for-xemacs-or-emacs - (make-indirect-buffer base-buf indirect-buf-name) ; xemacs - (make-indirect-buffer base-buf indirect-buf-name 'clone) ; emacs - )) - - -;; This function operates only from an ediff control buffer -(defun ediff-compute-custom-diffs-maybe () - (let ((buf-A-file-name (buffer-file-name ediff-buffer-A)) - (buf-B-file-name (buffer-file-name ediff-buffer-B)) - file-A file-B) - (unless (and buf-A-file-name (file-exists-p buf-A-file-name)) - (setq file-A - (ediff-make-temp-file ediff-buffer-A))) - (unless (and buf-B-file-name (file-exists-p buf-B-file-name)) - (setq file-B - (ediff-make-temp-file ediff-buffer-B))) - (or (ediff-buffer-live-p ediff-custom-diff-buffer) - (setq ediff-custom-diff-buffer - (get-buffer-create - (ediff-unique-buffer-name "*ediff-custom-diff" "*")))) - (ediff-with-current-buffer ediff-custom-diff-buffer - (setq buffer-read-only nil) - (erase-buffer)) - (ediff-exec-process - ediff-custom-diff-program ediff-custom-diff-buffer 'synchronize - ediff-custom-diff-options - ;; repetition of buf-A-file-name is needed so it'll return a file - (or (and buf-A-file-name (file-exists-p buf-A-file-name) buf-A-file-name) - file-A) - (or (and buf-B-file-name (file-exists-p buf-B-file-name) buf-B-file-name) - file-B)) - ;; put the diff file in diff-mode, if it is available - (if (fboundp 'diff-mode) - (with-current-buffer ediff-custom-diff-buffer - (diff-mode))) - (and file-A (file-exists-p file-A) (delete-file file-A)) - (and file-B (file-exists-p file-B) (delete-file file-B)) - )) - -(defun ediff-show-diff-output (arg) - (interactive "P") - (ediff-barf-if-not-control-buffer) - (ediff-compute-custom-diffs-maybe) - (save-excursion - (ediff-skip-unsuitable-frames ' ok-unsplittable)) - (let ((buf (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer)) - ediff-diff-buffer) - ((ediff-buffer-live-p ediff-custom-diff-buffer) - ediff-custom-diff-buffer) - ((ediff-buffer-live-p ediff-diff-buffer) - ediff-diff-buffer) - (t - (beep) - (message "Output from `diff' not found") - nil)))) - (if buf - (progn - (ediff-with-current-buffer buf - (goto-char (point-min))) - (switch-to-buffer buf) - (raise-frame (selected-frame))))) - (if (frame-live-p ediff-control-frame) - (ediff-reset-mouse ediff-control-frame)) - (if (window-live-p ediff-control-window) - (select-window ediff-control-window))) - - -(defun ediff-inferior-compare-regions () - "Compare regions in an active Ediff session. -Like ediff-regions-linewise but is called from under an active Ediff session on -the files that belong to that session. - -After quitting the session invoked via this function, type C-l to the parent -Ediff Control Panel to restore highlighting." - (interactive) - (let ((answer "") - (possibilities (list ?A ?B ?C)) - (zmacs-regions t) - use-current-diff-p - begA begB endA endB bufA bufB) - - (if (ediff-valid-difference-p ediff-current-difference) - (progn - (ediff-set-fine-diff-properties ediff-current-difference 'default) - (ediff-unhighlight-diff))) - (ediff-paint-background-regions 'unhighlight) - - (cond ((ediff-merge-job) - (setq bufB ediff-buffer-C) - ;; ask which buffer to compare to the merge buffer - (while (cond ((eq answer ?A) - (setq bufA ediff-buffer-A - possibilities '(?B)) - nil) - ((eq answer ?B) - (setq bufA ediff-buffer-B - possibilities '(?A)) - nil) - ((equal answer "")) - (t (beep 1) - (message "Valid values are A or B") - (sit-for 2) - t)) - (let ((cursor-in-echo-area t)) - (message - "Which buffer to compare to the merge buffer (A or B)? ") - (setq answer (capitalize (read-char-exclusive)))))) - - ((ediff-3way-comparison-job) - ;; ask which two buffers to compare - (while (cond ((memq answer possibilities) - (setq possibilities (delq answer possibilities)) - (setq bufA - (eval - (ediff-get-symbol-from-alist - answer ediff-buffer-alist))) - nil) - ((equal answer "")) - (t (beep 1) - (message - "Valid values are %s" - (mapconcat 'char-to-string possibilities " or ")) - (sit-for 2) - t)) - (let ((cursor-in-echo-area t)) - (message "Enter the 1st buffer you want to compare (%s): " - (mapconcat 'char-to-string possibilities " or ")) - (setq answer (capitalize (read-char-exclusive))))) - (setq answer "") ; silence error msg - (while (cond ((memq answer possibilities) - (setq possibilities (delq answer possibilities)) - (setq bufB - (eval - (ediff-get-symbol-from-alist - answer ediff-buffer-alist))) - nil) - ((equal answer "")) - (t (beep 1) - (message - "Valid values are %s" - (mapconcat 'char-to-string possibilities " or ")) - (sit-for 2) - t)) - (let ((cursor-in-echo-area t)) - (message "Enter the 2nd buffer you want to compare (%s): " - (mapconcat 'char-to-string possibilities "/")) - (setq answer (capitalize (read-char-exclusive)))))) - (t ; 2way comparison - (setq bufA ediff-buffer-A - bufB ediff-buffer-B - possibilities nil))) - - (if (and (ediff-valid-difference-p ediff-current-difference) - (y-or-n-p "Compare currently highlighted difference regions? ")) - (setq use-current-diff-p t)) - - (setq bufA (if use-current-diff-p - (ediff-clone-buffer-for-current-diff-comparison - bufA 'A "-Region.A-") - (ediff-clone-buffer-for-region-comparison bufA "-Region.A-"))) - (ediff-with-current-buffer bufA - (setq begA (region-beginning) - endA (region-end)) - (goto-char begA) - (beginning-of-line) - (setq begA (point)) - (goto-char endA) - (end-of-line) - (or (eobp) (forward-char)) ; include the newline char - (setq endA (point))) - - (setq bufB (if use-current-diff-p - (ediff-clone-buffer-for-current-diff-comparison - bufB 'B "-Region.B-") - (ediff-clone-buffer-for-region-comparison bufB "-Region.B-"))) - (ediff-with-current-buffer bufB - (setq begB (region-beginning) - endB (region-end)) - (goto-char begB) - (beginning-of-line) - (setq begB (point)) - (goto-char endB) - (end-of-line) - (or (eobp) (forward-char)) ; include the newline char - (setq endB (point))) - - - (ediff-regions-internal - bufA begA endA bufB begB endB - nil ; setup-hook - (if use-current-diff-p ; job name - 'ediff-regions-wordwise - 'ediff-regions-linewise) - (if use-current-diff-p ; word mode, if diffing current diff - t nil) - ;; setup param to pass to ediff-setup - (list (cons 'ediff-split-window-function ediff-split-window-function))) - )) - - - -(defun ediff-remove-flags-from-buffer (buffer overlay) - (ediff-with-current-buffer buffer - (let ((inhibit-read-only t)) - (if ediff-xemacs-p - (ediff-overlay-put overlay 'begin-glyph nil) - (ediff-overlay-put overlay 'before-string nil)) - - (if ediff-xemacs-p - (ediff-overlay-put overlay 'end-glyph nil) - (ediff-overlay-put overlay 'after-string nil)) - ))) - - - -(defun ediff-place-flags-in-buffer (buf-type buffer ctl-buffer diff) - (ediff-with-current-buffer buffer - (ediff-place-flags-in-buffer1 buf-type ctl-buffer diff))) - - -(defun ediff-place-flags-in-buffer1 (buf-type ctl-buffer diff-no) - (let* ((curr-overl (ediff-with-current-buffer ctl-buffer - (ediff-get-diff-overlay diff-no buf-type))) - (before (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer)) - after beg-of-line flag) - - ;; insert flag before the difference - (goto-char before) - (setq beg-of-line (bolp)) - - (setq flag (ediff-with-current-buffer ctl-buffer - (if (eq ediff-highlighting-style 'ascii) - (if beg-of-line - ediff-before-flag-bol ediff-before-flag-mol)))) - - ;; insert the flag itself - (if ediff-xemacs-p - (ediff-overlay-put curr-overl 'begin-glyph flag) - (ediff-overlay-put curr-overl 'before-string flag)) - - ;; insert the flag after the difference - ;; `after' must be set here, after the before-flag was inserted - (setq after (ediff-get-diff-posn buf-type 'end diff-no ctl-buffer)) - (goto-char after) - (setq beg-of-line (bolp)) - - (setq flag (ediff-with-current-buffer ctl-buffer - (if (eq ediff-highlighting-style 'ascii) - (if beg-of-line - ediff-after-flag-eol ediff-after-flag-mol)))) - - ;; insert the flag itself - (if ediff-xemacs-p - (ediff-overlay-put curr-overl 'end-glyph flag) - (ediff-overlay-put curr-overl 'after-string flag)) - )) - - -;;; Some diff region tests - -;; t if diff region is empty. -;; In case of buffer C, t also if it is not a 3way -;; comparison job (merging jobs return t as well). -(defun ediff-empty-diff-region-p (n buf-type) - (if (eq buf-type 'C) - (or (not ediff-3way-comparison-job) - (= (ediff-get-diff-posn 'C 'beg n) - (ediff-get-diff-posn 'C 'end n))) - (= (ediff-get-diff-posn buf-type 'beg n) - (ediff-get-diff-posn buf-type 'end n)))) - -;; Test if diff region is white space only. -;; If 2-way job and buf-type = C, then returns t. -(defun ediff-whitespace-diff-region-p (n buf-type) - (or (and (eq buf-type 'C) (not ediff-3way-job)) - (ediff-empty-diff-region-p n buf-type) - (let ((beg (ediff-get-diff-posn buf-type 'beg n)) - (end (ediff-get-diff-posn buf-type 'end n))) - (ediff-with-current-buffer (ediff-get-buffer buf-type) - (save-excursion - (goto-char beg) - (skip-chars-forward ediff-whitespace) - (>= (point) end)))))) - - -(defun ediff-get-region-contents (n buf-type ctrl-buf &optional start end) - (ediff-with-current-buffer - (ediff-with-current-buffer ctrl-buf (ediff-get-buffer buf-type)) - (buffer-substring - (or start (ediff-get-diff-posn buf-type 'beg n ctrl-buf)) - (or end (ediff-get-diff-posn buf-type 'end n ctrl-buf))))) - -;; Returns positions of difference sectors in the BUF-TYPE buffer. -;; BUF-TYPE should be a symbol -- `A', `B', or `C'. -;; POS is either `beg' or `end'--it specifies whether you want the position at -;; the beginning of a difference or at the end. -;; -;; The optional argument N says which difference (default: -;; `ediff-current-difference'). N is the internal difference number (1- what -;; the user sees). The optional argument CONTROL-BUF says -;; which control buffer is in effect in case it is not the current -;; buffer. -(defun ediff-get-diff-posn (buf-type pos &optional n control-buf) - (let (diff-overlay) - (or control-buf - (setq control-buf (current-buffer))) - - (ediff-with-current-buffer control-buf - (or n (setq n ediff-current-difference)) - (if (or (< n 0) (>= n ediff-number-of-differences)) - (if (> ediff-number-of-differences 0) - (error ediff-BAD-DIFF-NUMBER - this-command (1+ n) ediff-number-of-differences) - (error ediff-NO-DIFFERENCES))) - (setq diff-overlay (ediff-get-diff-overlay n buf-type))) - (if (not (ediff-buffer-live-p (ediff-overlay-buffer diff-overlay))) - (error ediff-KILLED-VITAL-BUFFER)) - (if (eq pos 'beg) - (ediff-overlay-start diff-overlay) - (ediff-overlay-end diff-overlay)) - )) - - -;; Restore highlighting to what it should be according to ediff-use-faces, -;; ediff-highlighting-style, and ediff-highlight-all-diffs variables. -(defun ediff-restore-highlighting (&optional ctl-buf) - (ediff-with-current-buffer (or ctl-buf (current-buffer)) - (if (and (ediff-has-face-support-p) - ediff-use-faces - ediff-highlight-all-diffs) - (ediff-paint-background-regions)) - (ediff-select-difference ediff-current-difference))) - - - -;; null out difference overlays so they won't slow down future -;; editing operations -;; VEC is either a difference vector or a fine-diff vector -(defun ediff-clear-diff-vector (vec-var &optional fine-diffs-also) - (if (vectorp (symbol-value vec-var)) - (mapcar (lambda (elt) - (ediff-delete-overlay - (ediff-get-diff-overlay-from-diff-record elt)) - (if fine-diffs-also - (ediff-clear-fine-diff-vector elt)) - ) - (symbol-value vec-var))) - ;; allow them to be garbage collected - (set vec-var nil)) - - - -;;; Misc - -;; In Emacs, this just makes overlay. In the future, when Emacs will start -;; supporting sticky overlays, this function will make a sticky overlay. -;; BEG and END are expressions telling where overlay starts. -;; If they are numbers or buffers, then all is well. Otherwise, they must -;; be expressions to be evaluated in buffer BUF in order to get the overlay -;; bounds. -;; If BUFF is not a live buffer, then return nil; otherwise, return the -;; newly created overlay. -(defun ediff-make-bullet-proof-overlay (beg end buff) - (if (ediff-buffer-live-p buff) - (let (overl) - (ediff-with-current-buffer buff - (or (number-or-marker-p beg) - (setq beg (eval beg))) - (or (number-or-marker-p end) - (setq end (eval end))) - (setq overl - (ediff-cond-compile-for-xemacs-or-emacs - (make-extent beg end buff) ; xemacs - ;; advance front and rear of the overlay - (make-overlay beg end buff nil 'rear-advance) ; emacs - )) - - ;; never detach - (ediff-overlay-put - overl (if ediff-emacs-p 'evaporate 'detachable) nil) - ;; make overlay open-ended - ;; In emacs, it is made open ended at creation time - (if ediff-xemacs-p - (progn - (ediff-overlay-put overl 'start-open nil) - (ediff-overlay-put overl 'end-open nil))) - (ediff-overlay-put overl 'ediff-diff-num 0) - overl)))) - - -(defun ediff-make-current-diff-overlay (type) - (if (ediff-has-face-support-p) - (let ((overlay (ediff-get-symbol-from-alist - type ediff-current-diff-overlay-alist)) - (buffer (ediff-get-buffer type)) - (face (face-name - (ediff-get-symbol-from-alist - type ediff-current-diff-face-alist)))) - (set overlay - (ediff-make-bullet-proof-overlay (point-max) (point-max) buffer)) - (ediff-set-overlay-face (symbol-value overlay) face) - (ediff-overlay-put (symbol-value overlay) 'ediff ediff-control-buffer)) - )) - - -;; Like other-buffer, but prefers visible buffers and ignores temporary or -;; other insignificant buffers (those beginning with "^[ *]"). -;; Gets one arg--buffer name or a list of buffer names (it won't return -;; these buffers). -;; EXCL-BUFF-LIST is an exclusion list. -(defun ediff-other-buffer (excl-buff-lst) - (or (listp excl-buff-lst) (setq excl-buff-lst (list excl-buff-lst))) - (let* ((all-buffers (nconc (ediff-get-selected-buffers) (buffer-list))) - ;; we compute this the second time because we need to do memq on it - ;; later, and nconc above will break it. Either this or use slow - ;; append instead of nconc - (selected-buffers (ediff-get-selected-buffers)) - (prefered-buffer (car all-buffers)) - visible-dired-buffers - (excl-buff-name-list - (mapcar - (lambda (b) (cond ((stringp b) b) - ((bufferp b) (buffer-name b)))) - excl-buff-lst)) - ;; if at least one buffer on the exclusion list is dired, then force - ;; all others to be dired. This is because this means that the user - ;; has already chosen a dired buffer before - (use-dired-major-mode - (cond ((null (ediff-buffer-live-p (car excl-buff-lst))) 'unknown) - ((eq (ediff-with-current-buffer (car excl-buff-lst) major-mode) - 'dired-mode) - 'yes) - (t 'no))) - ;; significant-buffers must be visible and not belong - ;; to the exclusion list `buff-list' - ;; We also exclude temporary buffers, but keep mail and gnus buffers - ;; Furthermore, we exclude dired buffers, unless they are the only - ;; ones visible (and there are at least two of them). - ;; Also, any visible window not on the exclusion list that is first in - ;; the buffer list is chosen regardless. (This is because the user - ;; clicked on it or did something to distinguish it). - (significant-buffers - (mapcar - (lambda (x) - (cond ((member (buffer-name x) excl-buff-name-list) nil) - ((memq x selected-buffers) x) - ((not (ediff-get-visible-buffer-window x)) nil) - ((eq x prefered-buffer) x) - ;; if prev selected buffer is dired, look only at - ;; dired. - ((eq use-dired-major-mode 'yes) - (if (eq (ediff-with-current-buffer x major-mode) - 'dired-mode) - x nil)) - ((eq (ediff-with-current-buffer x major-mode) - 'dired-mode) - (if (null use-dired-major-mode) - ;; don't know if we must enforce dired. - ;; Remember this buffer in case - ;; dired buffs are the only ones visible. - (setq visible-dired-buffers - (cons x visible-dired-buffers))) - ;; skip, if dired is not forced - nil) - ((memq (ediff-with-current-buffer x major-mode) - '(rmail-mode - vm-mode - gnus-article-mode - mh-show-mode)) - x) - ((string-match "^[ *]" (buffer-name x)) nil) - ((string= "*scratch*" (buffer-name x)) nil) - (t x))) - all-buffers)) - (clean-significant-buffers (delq nil significant-buffers)) - less-significant-buffers) - - (if (and (null clean-significant-buffers) - (> (length visible-dired-buffers) 0)) - (setq clean-significant-buffers visible-dired-buffers)) - - (cond (clean-significant-buffers (car clean-significant-buffers)) - ;; try also buffers that are not displayed in windows - ((setq less-significant-buffers - (delq nil - (mapcar - (lambda (x) - (cond ((member (buffer-name x) excl-buff-name-list) - nil) - ((eq use-dired-major-mode 'yes) - (if (eq (ediff-with-current-buffer - x major-mode) - 'dired-mode) - x nil)) - ((eq (ediff-with-current-buffer x major-mode) - 'dired-mode) - nil) - ((string-match "^[ *]" (buffer-name x)) nil) - ((string= "*scratch*" (buffer-name x)) nil) - (t x))) - all-buffers))) - (car less-significant-buffers)) - (t "*scratch*")) - )) - - -;; If current buffer is a Buffer-menu buffer, then take the selected buffers -;; and append the buffer at the cursor to the end. -;; This list would be the preferred list. -(defun ediff-get-selected-buffers () - (if (eq major-mode 'Buffer-menu-mode) - (let ((lis (condition-case nil - (list (Buffer-menu-buffer t)) - (error)) - )) - (save-excursion - (goto-char (point-max)) - (while (search-backward "\n>" nil t) - (forward-char 1) - (setq lis (cons (Buffer-menu-buffer t) lis))) - lis)) - )) - -;; Construct a unique buffer name. -;; The first one tried is prefixsuffix, then prefix<2>suffix, -;; prefix<3>suffix, etc. -(defun ediff-unique-buffer-name (prefix suffix) - (if (null (get-buffer (concat prefix suffix))) - (concat prefix suffix) - (let ((n 2)) - (while (get-buffer (format "%s<%d>%s" prefix n suffix)) - (setq n (1+ n))) - (format "%s<%d>%s" prefix n suffix)))) - - -(defun ediff-submit-report () - "Submit bug report on Ediff." - (interactive) - (ediff-barf-if-not-control-buffer) - (let ((reporter-prompt-for-summary-p t) - (ctl-buf ediff-control-buffer) - (ediff-device-type (ediff-device-type)) - varlist salutation buffer-name) - (setq varlist '(ediff-diff-program ediff-diff-options - ediff-diff3-program ediff-diff3-options - ediff-patch-program ediff-patch-options - ediff-shell - ediff-use-faces - ediff-auto-refine ediff-highlighting-style - ediff-buffer-A ediff-buffer-B ediff-control-buffer - ediff-forward-word-function - ediff-control-frame - ediff-control-frame-parameters - ediff-control-frame-position-function - ediff-prefer-iconified-control-frame - ediff-window-setup-function - ediff-split-window-function - ediff-job-name - ediff-word-mode - buffer-name - ediff-device-type - )) - (setq salutation " -Congratulations! You may have unearthed a bug in Ediff! - -Please make a concise and accurate summary of what happened -and mail it to the address above. ------------------------------------------------------------ -") - - (ediff-skip-unsuitable-frames) - (ediff-reset-mouse) - - (switch-to-buffer ediff-msg-buffer) - (erase-buffer) - (delete-other-windows) - (insert " -Please read this first: ----------------------- - -Some ``bugs'' may actually be no bugs at all. For instance, if you are -reporting that certain difference regions are not matched as you think they -should, this is most likely due to the way Unix diff program decides what -constitutes a difference region. Ediff is an Emacs interface to diff, and -it has nothing to do with those decisions---it only takes the output from -diff and presents it in a way that is better suited for human browsing and -manipulation. - -If Emacs happens to dump core, this is NOT an Ediff problem---it is -an Emacs bug. Report this to Emacs maintainers. - -Another popular topic for reports is compilation messages. Because Ediff -interfaces to several other packages and runs under Emacs and XEmacs, -byte-compilation may produce output like this: - - While compiling toplevel forms in file ediff.el: - ** reference to free variable pm-color-alist - ........................ - While compiling the end of the data: - ** The following functions are not known to be defined: - ediff-valid-color-p, ediff-set-face, - ........................ - -These are NOT errors, but inevitable warnings, which ought to be ignored. - -Please do not report those and similar things. However, comments and -suggestions are always welcome. - -Mail anyway? (y or n) ") - - (if (y-or-n-p "Mail anyway? ") - (progn - (if (ediff-buffer-live-p ctl-buf) - (set-buffer ctl-buf)) - (setq buffer-name (buffer-name)) - (require 'reporter) - (reporter-submit-bug-report "kifer@cs.stonybrook.edu" - (ediff-version) - varlist - nil - 'delete-other-windows - salutation)) - (bury-buffer) - (beep 1)(message "Bug report aborted") - (if (ediff-buffer-live-p ctl-buf) - (ediff-with-current-buffer ctl-buf - (ediff-recenter 'no-rehighlight)))) - )) - - -;; Find an appropriate syntax table for everyone to use -;; If buffer B is not fundamental or text mode, use its syntax table -;; Otherwise, use buffer B's. -;; The syntax mode is used in ediff-forward-word-function -;; The important thing is that every buffer should use the same syntax table -;; during the refinement operation -(defun ediff-choose-syntax-table () - (setq ediff-syntax-table - (ediff-with-current-buffer ediff-buffer-A - (if (not (memq major-mode - '(fundamental-mode text-mode indented-text-mode))) - (syntax-table)))) - (if (not ediff-syntax-table) - (setq ediff-syntax-table - (ediff-with-current-buffer ediff-buffer-B - (syntax-table)))) - ) - - -(defun ediff-deactivate-mark () - (ediff-cond-compile-for-xemacs-or-emacs - (zmacs-deactivate-region) ; xemacs - (deactivate-mark) ; emacs - )) -(defun ediff-activate-mark () - (ediff-cond-compile-for-xemacs-or-emacs - (zmacs-activate-region) ; xemacs - (setq mark-active t) ; emacs - )) - -(cond ((fboundp 'nuke-selective-display) - ;; XEmacs has nuke-selective-display - (defalias 'ediff-nuke-selective-display 'nuke-selective-display)) - (t - (defun ediff-nuke-selective-display () - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let ((mod-p (buffer-modified-p)) - buffer-read-only end) - (and (eq t selective-display) - (while (search-forward "\^M" nil t) - (end-of-line) - (setq end (point)) - (beginning-of-line) - (while (search-forward "\^M" end t) - (delete-char -1) - (insert "\^J")))) - (set-buffer-modified-p mod-p) - (setq selective-display nil))))) - )) - - -;; The next two are modified versions from emerge.el. -;; VARS must be a list of symbols -;; ediff-save-variables returns an association list: ((var . val) ...) -(defsubst ediff-save-variables (vars) - (mapcar (lambda (v) (cons v (symbol-value v))) - vars)) -;; VARS is a list of variable symbols. -(defun ediff-restore-variables (vars assoc-list) - (while vars - (set (car vars) (cdr (assoc (car vars) assoc-list))) - (setq vars (cdr vars)))) - -(defun ediff-change-saved-variable (var value buf-type) - (let* ((assoc-list - (symbol-value (ediff-get-symbol-from-alist - buf-type - ediff-buffer-values-orig-alist))) - (assoc-elt (assoc var assoc-list))) - (if assoc-elt - (setcdr assoc-elt value)))) - - -;; must execute in control buf -(defun ediff-save-protected-variables () - (setq ediff-buffer-values-orig-A - (ediff-with-current-buffer ediff-buffer-A - (ediff-save-variables ediff-protected-variables))) - (setq ediff-buffer-values-orig-B - (ediff-with-current-buffer ediff-buffer-B - (ediff-save-variables ediff-protected-variables))) - (if ediff-3way-comparison-job - (setq ediff-buffer-values-orig-C - (ediff-with-current-buffer ediff-buffer-C - (ediff-save-variables ediff-protected-variables)))) - (if (ediff-buffer-live-p ediff-ancestor-buffer) - (setq ediff-buffer-values-orig-Ancestor - (ediff-with-current-buffer ediff-ancestor-buffer - (ediff-save-variables ediff-protected-variables))))) - -;; must execute in control buf -(defun ediff-restore-protected-variables () - (let ((values-A ediff-buffer-values-orig-A) - (values-B ediff-buffer-values-orig-B) - (values-C ediff-buffer-values-orig-C) - (values-Ancestor ediff-buffer-values-orig-Ancestor)) - (ediff-with-current-buffer ediff-buffer-A - (ediff-restore-variables ediff-protected-variables values-A)) - (ediff-with-current-buffer ediff-buffer-B - (ediff-restore-variables ediff-protected-variables values-B)) - (if ediff-3way-comparison-job - (ediff-with-current-buffer ediff-buffer-C - (ediff-restore-variables ediff-protected-variables values-C))) - (if (ediff-buffer-live-p ediff-ancestor-buffer) - (ediff-with-current-buffer ediff-ancestor-buffer - (ediff-restore-variables ediff-protected-variables values-Ancestor))) - )) - -;; save BUFFER in FILE. used in hooks. -(defun ediff-save-buffer-in-file (buffer file) - (ediff-with-current-buffer buffer - (write-file file))) - - -;;; Debug - -(ediff-defvar-local ediff-command-begin-time '(0 0 0) "") - -;; calculate time used by command -(defun ediff-calc-command-time () - (let ((end (current-time)) - micro sec) - (setq micro - (if (>= (nth 2 end) (nth 2 ediff-command-begin-time)) - (- (nth 2 end) (nth 2 ediff-command-begin-time)) - (+ (nth 2 end) (- 1000000 (nth 2 ediff-command-begin-time))))) - (setq sec (- (nth 1 end) (nth 1 ediff-command-begin-time))) - (or (equal ediff-command-begin-time '(0 0 0)) - (message "Elapsed time: %d second(s) + %d microsecond(s)" sec micro)))) - -(defsubst ediff-save-time () - (setq ediff-command-begin-time (current-time))) - -(defun ediff-profile () - "Toggle profiling Ediff commands." - (interactive) - (ediff-barf-if-not-control-buffer) - - (ediff-cond-compile-for-xemacs-or-emacs - (make-local-hook 'post-command-hook) ; xemacs form - nil ; emacs form - ) - - (let ((pre-hook 'pre-command-hook) - (post-hook 'post-command-hook)) - (if (not (equal ediff-command-begin-time '(0 0 0))) - (progn (remove-hook pre-hook 'ediff-save-time) - (remove-hook post-hook 'ediff-calc-command-time) - (setq ediff-command-begin-time '(0 0 0)) - (message "Ediff profiling disabled")) - (add-hook pre-hook 'ediff-save-time t 'local) - (add-hook post-hook 'ediff-calc-command-time nil 'local) - (message "Ediff profiling enabled")))) - -(defun ediff-print-diff-vector (diff-vector-var) - (princ (format "\n*** %S ***\n" diff-vector-var)) - (mapcar (lambda (overl-vec) - (princ - (format - "Diff %d: \tOverlay: %S -\t\tFine diffs: %s -\t\tNo-fine-diff-flag: %S -\t\tState-of-diff:\t %S -\t\tState-of-merge:\t %S -" - (1+ (ediff-overlay-get (aref overl-vec 0) 'ediff-diff-num)) - (aref overl-vec 0) - ;; fine-diff-vector - (if (= (length (aref overl-vec 1)) 0) - "none\n" - (mapconcat 'prin1-to-string - (aref overl-vec 1) "\n\t\t\t ")) - (aref overl-vec 2) ; no fine diff flag - (aref overl-vec 3) ; state-of-diff - (aref overl-vec 4) ; state-of-merge - ))) - (eval diff-vector-var))) - - - -(defun ediff-debug-info () - (interactive) - (ediff-barf-if-not-control-buffer) - (with-output-to-temp-buffer ediff-debug-buffer - (ediff-with-current-buffer standard-output - (fundamental-mode)) - (princ (format "\nCtl buffer: %S\n" ediff-control-buffer)) - (ediff-print-diff-vector (intern "ediff-difference-vector-A")) - (ediff-print-diff-vector (intern "ediff-difference-vector-B")) - (ediff-print-diff-vector (intern "ediff-difference-vector-C")) - (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor")) - )) - - -;;; General utilities - -;; this uses comparison-func to decide who is a member -(defun ediff-member (elt lis comparison-func) - (while (and lis (not (funcall comparison-func (car lis) elt))) - (setq lis (cdr lis))) - lis) - -;; Make a readable representation of the invocation sequence for FUNC-DEF. -;; It would either be a key or M-x something. -(defun ediff-format-bindings-of (func-def) - (let ((desc (car (where-is-internal func-def - overriding-local-map - nil nil)))) - (if desc - (key-description desc) - (format "M-x %s" func-def)))) - -;; this uses comparison-func to decide who is a member, and this determines how -;; intersection looks like -(defun ediff-intersection (lis1 lis2 comparison-func) - (let ((result (list 'a))) - (while lis1 - (if (ediff-member (car lis1) lis2 comparison-func) - (nconc result (list (car lis1)))) - (setq lis1 (cdr lis1))) - (cdr result))) - - -;; eliminates duplicates using comparison-func -(defun ediff-union (lis1 lis2 comparison-func) - (let ((result (list 'a))) - (while lis1 - (or (ediff-member (car lis1) (cdr result) comparison-func) - (nconc result (list (car lis1)))) - (setq lis1 (cdr lis1))) - (while lis2 - (or (ediff-member (car lis2) (cdr result) comparison-func) - (nconc result (list (car lis2)))) - (setq lis2 (cdr lis2))) - (cdr result))) - -;; eliminates duplicates using comparison-func -(defun ediff-set-difference (lis1 lis2 comparison-func) - (let ((result (list 'a))) - (while lis1 - (or (ediff-member (car lis1) (cdr result) comparison-func) - (ediff-member (car lis1) lis2 comparison-func) - (nconc result (list (car lis1)))) - (setq lis1 (cdr lis1))) - (cdr result))) - -(if (fboundp 'copy-sequence) - (defalias 'ediff-copy-list 'copy-sequence) - (defun ediff-copy-list (list) - (if (consp list) - ;;;(let ((res nil)) - ;;; (while (consp list) (push (pop list) res)) - ;;; (prog1 (nreverse res) (setcdr res list))) - (let (res elt) - (while (consp list) - (setq elt (car list) - res (cons elt res) - list (cdr list))) - (nreverse res)) - (car list)))) - - -;; don't report error if version control package wasn't found -;;(ediff-load-version-control 'silent) - -(run-hooks 'ediff-load-hook) - -(provide 'ediff-util) - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; arch-tag: f51099b6-ef4b-470f-88a1-3a0e0b03a879 -;;; ediff-util.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-vers.el b/xemacs-packages/lisp/ediff/ediff-vers.el deleted file mode 100644 index 3e8b1c37..00000000 --- a/xemacs-packages/lisp/ediff/ediff-vers.el +++ /dev/null @@ -1,322 +0,0 @@ -;;; ediff-vers.el --- version control interface to Ediff - -;; Copyright (C) 1995, 1996, 1997, 2002, 2003, 2004, -;; 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - -;; Compiler pacifier -(defvar rcs-default-co-switches) -(defvar sc-mode) -(defvar cvs-shell) -(defvar cvs-program) -(defvar cvs-cookie-handle) -(defvar ediff-temp-file-prefix) - -(and noninteractive - (eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (load "pcl-cvs" 'noerror) - (load "rcs" 'noerror) - ;; On 8+3 MS-DOS filesystems, generic-x.el is loaded - ;; instead of (the missing) generic-sc.el. Since the - ;; version of Emacs which supports MS-DOS doesn't have - ;; generic-sc, we simply avoid loading it. - (or (and (fboundp 'msdos-long-file-names) - (not (msdos-long-file-names))) - (load "generic-sc" 'noerror)) - ;; (load "vc" 'noerror) ; this sometimes causes compiler error - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - ))) -;; end pacifier - -;; VC.el support - -(defun ediff-vc-latest-version (file) - "Return the version level of the latest version of FILE in repository." - (if (fboundp 'vc-latest-version) - (vc-latest-version file) - (or (vc-file-getprop file 'vc-latest-version) - (cond ((vc-backend file) - (vc-call state file) - (vc-file-getprop file 'vc-latest-version)) - (t (error "File %s is not under version control" file)))) - )) - - -(defun ediff-vc-internal (rev1 rev2 &optional startup-hooks) - ;; Run Ediff on versions of the current buffer. - ;; If REV1 is "", use the latest version of the current buffer's file. - ;; If REV2 is "" then compare current buffer with REV1. - ;; If the current buffer is named `F', the version is named `F.~REV~'. - ;; If `F.~REV~' already exists, it is used instead of being re-created. - (let (file1 file2 rev1buf rev2buf) - (if (string= rev1 "") - (setq rev1 (ediff-vc-latest-version (buffer-file-name)))) - (save-window-excursion - (save-excursion - (vc-version-other-window rev1) - (setq rev1buf (current-buffer) - file1 (buffer-file-name))) - (save-excursion - (or (string= rev2 "") ; use current buffer - (vc-version-other-window rev2)) - (setq rev2buf (current-buffer) - file2 (buffer-file-name))) - (setq startup-hooks - (cons `(lambda () - (delete-file ,file1) - (or ,(string= rev2 "") (delete-file ,file2))) - startup-hooks))) - (ediff-buffers - rev1buf rev2buf - startup-hooks - 'ediff-revision))) - -;; RCS.el support -(defun rcs-ediff-view-revision (&optional rev) -;; View previous RCS revision of current file. -;; With prefix argument, prompts for a revision name. - (interactive (list (if current-prefix-arg - (read-string "Revision: ")))) - (let* ((filename (buffer-file-name (current-buffer))) - (switches (append '("-p") - (if rev (list (concat "-r" rev)) nil))) - (buff (concat (file-name-nondirectory filename) ".~" rev "~"))) - (message "Working ...") - (setq filename (expand-file-name filename)) - (with-output-to-temp-buffer buff - (ediff-with-current-buffer standard-output - (fundamental-mode)) - (let ((output-buffer (ediff-rcs-get-output-buffer filename buff))) - (delete-windows-on output-buffer) - (save-excursion - (set-buffer output-buffer) - (apply 'call-process "co" nil t nil - ;; -q: quiet (no diagnostics) - (append switches rcs-default-co-switches - (list "-q" filename))))) - (message "") - buff))) - -(defun ediff-rcs-get-output-buffer (file name) - ;; Get a buffer for RCS output for FILE, make it writable and clean it up. - ;; Optional NAME is name to use instead of `*RCS-output*'. - ;; This is a modified version from rcs.el v1.1. I use it here to make - ;; Ediff immune to changes in rcs.el - (let* ((default-major-mode 'fundamental-mode) ; no frills! - (buf (get-buffer-create name))) - (save-excursion - (set-buffer buf) - (setq buffer-read-only nil - default-directory (file-name-directory (expand-file-name file))) - (erase-buffer)) - buf)) - -(defun ediff-rcs-internal (rev1 rev2 &optional startup-hooks) -;; Run Ediff on versions of the current buffer. -;; If REV2 is "" then use current buffer. - (let (rev2buf rev1buf) - (save-window-excursion - (setq rev2buf (if (string= rev2 "") - (current-buffer) - (rcs-ediff-view-revision rev2)) - rev1buf (rcs-ediff-view-revision rev1))) - - ;; rcs.el doesn't create temp version files, so we don't have to delete - ;; anything in startup hooks to ediff-buffers - (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision) - )) - - -;; GENERIC-SC.el support - -(defun generic-sc-get-latest-rev () - (cond ((eq sc-mode 'CCASE) - (eval "main/LATEST")) - (t (eval "")))) - -(defun ediff-generic-sc-internal (rev1 rev2 &optional startup-hooks) -;; Run Ediff on versions of the current buffer. -;; If REV2 is "" then compare current buffer with REV1. -;; If the current buffer is named `F', the version is named `F.~REV~'. -;; If `F.~REV~' already exists, it is used instead of being re-created. - (let (rev1buf rev2buf) - (save-excursion - (if (or (not rev1) (string= rev1 "")) - (setq rev1 (generic-sc-get-latest-rev))) - (sc-visit-previous-revision rev1) - (setq rev1buf (current-buffer))) - (save-excursion - (or (string= rev2 "") ; use current buffer - (sc-visit-previous-revision rev2)) - (setq rev2buf (current-buffer))) - (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision))) - - -;;; Merge with Version Control - -(defun ediff-vc-merge-internal (rev1 rev2 ancestor-rev - &optional startup-hooks merge-buffer-file) -;; If ANCESTOR-REV non-nil, merge with ancestor - (let (buf1 buf2 ancestor-buf) - (save-window-excursion - (save-excursion - (vc-version-other-window rev1) - (setq buf1 (current-buffer))) - (save-excursion - (or (string= rev2 "") - (vc-version-other-window rev2)) - (setq buf2 (current-buffer))) - (if ancestor-rev - (save-excursion - (if (string= ancestor-rev "") - (setq ancestor-rev (vc-workfile-version buffer-file-name))) - (vc-version-other-window ancestor-rev) - (setq ancestor-buf (current-buffer)))) - (setq startup-hooks - (cons - `(lambda () - (delete-file ,(buffer-file-name buf1)) - (or ,(string= rev2 "") - (delete-file ,(buffer-file-name buf2))) - (or ,(string= ancestor-rev "") - ,(not ancestor-rev) - (delete-file ,(buffer-file-name ancestor-buf))) - ) - startup-hooks))) - (if ancestor-rev - (ediff-merge-buffers-with-ancestor - buf1 buf2 ancestor-buf - startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file) - (ediff-merge-buffers - buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file)) - )) - -(defun ediff-rcs-merge-internal (rev1 rev2 ancestor-rev - &optional - startup-hooks merge-buffer-file) - ;; If ANCESTOR-REV non-nil, merge with ancestor - (let (buf1 buf2 ancestor-buf) - (save-window-excursion - (setq buf1 (rcs-ediff-view-revision rev1) - buf2 (if (string= rev2 "") - (current-buffer) - (rcs-ediff-view-revision rev2)) - ancestor-buf (if ancestor-rev - (if (string= ancestor-rev "") - (current-buffer) - (rcs-ediff-view-revision ancestor-rev))))) - ;; rcs.el doesn't create temp version files, so we don't have to delete - ;; anything in startup hooks to ediff-buffers - (if ancestor-rev - (ediff-merge-buffers-with-ancestor - buf1 buf2 ancestor-buf - startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file) - (ediff-merge-buffers - buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file)))) - -(defun ediff-generic-sc-merge-internal (rev1 rev2 ancestor-rev - &optional - startup-hooks merge-buffer-file) - ;; If ANCESTOR-REV non-nil, merge with ancestor - (let (buf1 buf2 ancestor-buf) - (save-excursion - (if (string= rev1 "") - (setq rev1 (generic-sc-get-latest-rev))) - (sc-visit-previous-revision rev1) - (setq buf1 (current-buffer))) - (save-excursion - (or (string= rev2 "") - (sc-visit-previous-revision rev2)) - (setq buf2 (current-buffer))) - (if ancestor-rev - (save-excursion - (or (string= ancestor-rev "") - (sc-visit-previous-revision ancestor-rev)) - (setq ancestor-buf (current-buffer)))) - (if ancestor-rev - (ediff-merge-buffers-with-ancestor - buf1 buf2 ancestor-buf - startup-hooks 'ediff-merge-revisions-with-ancestor merge-buffer-file) - (ediff-merge-buffers - buf1 buf2 startup-hooks 'ediff-merge-revisions merge-buffer-file)))) - - -;; PCL-CVS.el support - -;; MK: Check. This function doesn't seem to be used any more by pcvs or pcl-cvs -(defun cvs-run-ediff-on-file-descriptor (tin) -;; This is a replacement for cvs-emerge-mode -;; Runs after cvs-update. -;; Ediff-merge appropriate revisions of the selected file. - (let* ((fileinfo (tin-cookie cvs-cookie-handle tin)) - (type (cvs-fileinfo->type fileinfo)) - (tmp-file - (cvs-retrieve-revision-to-tmpfile fileinfo)) - (default-directory - (file-name-as-directory (cvs-fileinfo->dir fileinfo))) - ancestor-file) - - (or (memq type '(MERGED CONFLICT MODIFIED)) - (error - "Can only merge `Modified', `Merged' or `Conflict' files")) - - (cond ((memq type '(MERGED CONFLICT)) - (setq ancestor-file - (cvs-retrieve-revision-to-tmpfile - fileinfo - ;; revision - (cvs-fileinfo->base-revision fileinfo))) - (ediff-merge-buffers-with-ancestor - (find-file-noselect tmp-file) - (find-file-noselect (cvs-fileinfo->backup-file fileinfo)) - (find-file-noselect ancestor-file) - nil ; startup-hooks - 'ediff-merge-revisions-with-ancestor)) - ((eq type 'MODIFIED) - (ediff-buffers - (find-file-noselect tmp-file) - (if (featurep 'xemacs) - ;; XEmacs doesn't seem to have cvs-fileinfo->full-name - (find-file-noselect (cvs-fileinfo->full-path fileinfo)) - (find-file-noselect (cvs-fileinfo->full-name fileinfo))) - nil ; startup-hooks - 'ediff-revisions))) - (if (stringp tmp-file) (delete-file tmp-file)) - (if (stringp ancestor-file) (delete-file ancestor-file)))) - - -(provide 'ediff-vers) - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; arch-tag: bbb34f0c-2a90-426a-a77a-c75f479ebbbf -;;; ediff-vers.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff-wind.el b/xemacs-packages/lisp/ediff/ediff-wind.el deleted file mode 100644 index 28369f9f..00000000 --- a/xemacs-packages/lisp/ediff/ediff-wind.el +++ /dev/null @@ -1,1326 +0,0 @@ -;;; ediff-wind.el --- window manipulation utilities - -;; Copyright (C) 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; Code: - - -;; Compiler pacifier -(defvar icon-title-format) -(defvar top-toolbar-height) -(defvar bottom-toolbar-height) -(defvar left-toolbar-height) -(defvar right-toolbar-height) -(defvar left-toolbar-width) -(defvar right-toolbar-width) -(defvar default-menubar) -(defvar top-gutter) -(defvar frame-icon-title-format) -(defvar ediff-diff-status) -(defvar ediff-emacs-p) - -(eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - (or (featurep 'ediff-util) - (load "ediff-util.el" nil nil 'nosuffix)) - (or (featurep 'ediff-help) - (load "ediff-help.el" nil nil 'nosuffix)) - (or (featurep 'ediff-tbar) - ediff-emacs-p - (load "ediff-tbar.el" 'noerror nil 'nosuffix)) - )) -;; end pacifier - -(require 'ediff-init) - -;; be careful with ediff-tbar -(if ediff-xemacs-p - (condition-case nil - (require 'ediff-tbar) - (error - (defun ediff-compute-toolbar-width () 0))) - (defun ediff-compute-toolbar-width () 0)) - -(defgroup ediff-window nil - "Ediff window manipulation." - :prefix "ediff-" - :group 'ediff - :group 'frames) - - -(defcustom ediff-window-setup-function (if (ediff-window-display-p) - 'ediff-setup-windows-multiframe - 'ediff-setup-windows-plain) - "*Function called to set up windows. -Ediff provides a choice of two functions: `ediff-setup-windows-plain', for -doing everything in one frame, and `ediff-setup-windows-multiframe', -which sets the control panel in a separate frame. Also, if the latter -function detects that one of the buffers A/B is seen in some other frame, -it will try to keep that buffer in that frame. - -If you don't like the two functions provided---write your own one. -The basic guidelines: - 1. It should leave the control buffer current and the control window - selected. - 2. It should set `ediff-window-A', `ediff-window-B', `ediff-window-C', - and `ediff-control-window' to contain window objects that display - the corresponding buffers. - 3. It should accept the following arguments: - buffer-A, buffer-B, buffer-C, control-buffer - Buffer C may not be used in jobs that compare only two buffers. -If you plan to do something fancy, take a close look at how the two -provided functions are written." - :type '(choice (const :tag "Multi Frame" ediff-setup-windows-multiframe) - (const :tag "Single Frame" ediff-setup-windows-plain) - (function :tag "Other function")) - :group 'ediff-window) - -;; indicates if we are in a multiframe setup -(ediff-defvar-local ediff-multiframe nil "") - -;; Share of the frame occupied by the merge window (buffer C) -(ediff-defvar-local ediff-merge-window-share 0.45 "") - -;; The control window. -(ediff-defvar-local ediff-control-window nil "") -;; Official window for buffer A -(ediff-defvar-local ediff-window-A nil "") -;; Official window for buffer B -(ediff-defvar-local ediff-window-B nil "") -;; Official window for buffer C -(ediff-defvar-local ediff-window-C nil "") -;; Ediff's window configuration. -;; Used to minimize the need to rearrange windows. -(ediff-defvar-local ediff-window-config-saved "" "") - -;; Association between buff-type and ediff-window-* -(defconst ediff-window-alist - '((A . ediff-window-A) - (?A . ediff-window-A) - (B . ediff-window-B) - (?B . ediff-window-B) - (C . ediff-window-C) - (?C . ediff-window-C))) - - -(defcustom ediff-split-window-function 'split-window-vertically - "*The function used to split the main window between buffer-A and buffer-B. -You can set it to a horizontal split instead of the default vertical split -by setting this variable to `split-window-horizontally'. -You can also have your own function to do fancy splits. -This variable has no effect when buffer-A/B are shown in different frames. -In this case, Ediff will use those frames to display these buffers." - :type 'function - :group 'ediff-window) - -(defcustom ediff-merge-split-window-function 'split-window-horizontally - "*The function used to split the main window between buffer-A and buffer-B. -You can set it to a vertical split instead of the default horizontal split -by setting this variable to `split-window-vertically'. -You can also have your own function to do fancy splits. -This variable has no effect when buffer-A/B/C are shown in different frames. -In this case, Ediff will use those frames to display these buffers." - :type 'function - :group 'ediff-window) - -(defconst ediff-control-frame-parameters - (list - '(name . "Ediff") - ;;'(unsplittable . t) - '(minibuffer . nil) - '(user-position . t) ; Emacs only - '(vertical-scroll-bars . nil) ; Emacs only - '(scrollbar-width . 0) ; XEmacs only - '(scrollbar-height . 0) ; XEmacs only - '(menu-bar-lines . 0) ; Emacs only - '(tool-bar-lines . 0) ; Emacs 21+ only - ;; don't lower but auto-raise - '(auto-lower . nil) - '(auto-raise . t) - '(visibility . nil) - ;; make initial frame small to avoid distraction - '(width . 1) '(height . 1) - ;; this blocks queries from window manager as to where to put - ;; ediff's control frame. we put the frame outside the display, - ;; so the initial frame won't jump all over the screen - (cons 'top (if (fboundp 'ediff-display-pixel-height) - (1+ (ediff-display-pixel-height)) - 3000)) - (cons 'left (if (fboundp 'ediff-display-pixel-width) - (1+ (ediff-display-pixel-width)) - 3000)) - ) - "Frame parameters for displaying Ediff Control Panel. -Used internally---not a user option.") - -;; position of the mouse; used to decide whether to warp the mouse into ctl -;; frame -(ediff-defvar-local ediff-mouse-pixel-position nil "") - -;; not used for now -(defvar ediff-mouse-pixel-threshold 30 - "If the user moves mouse more than this many pixels, Ediff won't warp mouse into control window.") - -(defcustom ediff-grab-mouse t - "*If t, Ediff will always grab the mouse and put it in the control frame. -If 'maybe, Ediff will do it sometimes, but not after operations that require -relatively long time. If nil, the mouse will be entirely user's -responsibility." - :type 'boolean - :group 'ediff-window) - -(defcustom ediff-control-frame-position-function 'ediff-make-frame-position - "Function to call to determine the desired location for the control panel. -Expects three parameters: the control buffer, the desired width and height -of the control frame. It returns an association list -of the form \(\(top . \) \(left . \)\)" - :type 'function - :group 'ediff-window) - -(defcustom ediff-control-frame-upward-shift 42 - "*The upward shift of control frame from the top of buffer A's frame. -Measured in pixels. -This is used by the default control frame positioning function, -`ediff-make-frame-position'. This variable is provided for easy -customization of the default control frame positioning." - :type 'integer - :group 'ediff-window) - -(defcustom ediff-narrow-control-frame-leftward-shift (if ediff-xemacs-p 7 3) - "*The leftward shift of control frame from the right edge of buf A's frame. -Measured in characters. -This is used by the default control frame positioning function, -`ediff-make-frame-position' to adjust the position of the control frame -when it shows the short menu. This variable is provided for easy -customization of the default." - :type 'integer - :group 'ediff-window) - -(defcustom ediff-wide-control-frame-rightward-shift 7 - "*The rightward shift of control frame from the left edge of buf A's frame. -Measured in characters. -This is used by the default control frame positioning function, -`ediff-make-frame-position' to adjust the position of the control frame -when it shows the full menu. This variable is provided for easy -customization of the default." - :type 'integer - :group 'ediff-window) - - -;; Wide frame display - -;; t means Ediff is using wide display -(ediff-defvar-local ediff-wide-display-p nil "") -;; keeps frame config for toggling wide display -(ediff-defvar-local ediff-wide-display-orig-parameters nil - "Frame parameters to be restored when the user wants to toggle the wide -display off.") -(ediff-defvar-local ediff-wide-display-frame nil - "Frame to be used for wide display.") -(ediff-defvar-local ediff-make-wide-display-function 'ediff-make-wide-display - "The value is a function that is called to create a wide display. -The function is called without arguments. It should resize the frame in -which buffers A, B, and C are to be displayed, and it should save the old -frame parameters in `ediff-wide-display-orig-parameters'. -The variable `ediff-wide-display-frame' should be set to contain -the frame used for the wide display.") - -;; Frame used for the control panel in a windowing system. -(ediff-defvar-local ediff-control-frame nil "") - -(defcustom ediff-prefer-iconified-control-frame nil - "*If t, keep control panel iconified when help message is off. -This has effect only on a windowing system. -If t, hitting `?' to toggle control panel off iconifies it. - -This is only useful in Emacs and only for certain kinds of window managers, -such as TWM and its derivatives, since the window manager must permit -keyboard input to go into icons. XEmacs completely ignores keyboard input -into icons, regardless of the window manager." - :type 'boolean - :group 'ediff-window) - -;;; Functions - -(defun ediff-get-window-by-clicking (wind prev-wind wind-number) - (let (event) - (message - "Select windows by clicking. Please click on Window %d " wind-number) - (while (not (ediff-mouse-event-p (setq event (ediff-read-event)))) - (if (sit-for 1) ; if sequence of events, wait till the final word - (beep 1)) - (message "Please click on Window %d " wind-number)) - (ediff-read-event) ; discard event - (setq wind (ediff-cond-compile-for-xemacs-or-emacs - (event-window event) ; xemacs - (posn-window (event-start event)) ; emacs - ) - ) - )) - - -;; Select the lowest window on the frame. -(defun ediff-select-lowest-window () - (ediff-cond-compile-for-xemacs-or-emacs - (select-window (frame-lowest-window)) ; xemacs - ;; emacs - (let* ((lowest-window (selected-window)) - (bottom-edge (car (cdr (cdr (cdr (window-edges)))))) - (last-window (save-excursion - (other-window -1) (selected-window))) - (window-search t)) - (while window-search - (let* ((this-window (next-window)) - (next-bottom-edge - (car (cdr (cdr (cdr (window-edges this-window))))))) - (if (< bottom-edge next-bottom-edge) - (progn - (setq bottom-edge next-bottom-edge) - (setq lowest-window this-window))) - - (select-window this-window) - (if (eq last-window this-window) - (progn - (select-window lowest-window) - (setq window-search nil)))))) - )) - - -;;; Common window setup routines - -;; Set up the window configuration. If POS is given, set the points to -;; the beginnings of the buffers. -;; When 3way comparison is added, this will have to choose the appropriate -;; setup function based on ediff-job-name -(defun ediff-setup-windows (buffer-A buffer-B buffer-C control-buffer) - ;; Make sure we are not in the minibuffer window when we try to delete - ;; all other windows. - (run-hooks 'ediff-before-setup-windows-hook) - (if (eq (selected-window) (minibuffer-window)) - (other-window 1)) - - ;; in case user did a no-no on a tty - (or (ediff-window-display-p) - (setq ediff-window-setup-function 'ediff-setup-windows-plain)) - - (or (ediff-keep-window-config control-buffer) - (funcall - (ediff-with-current-buffer control-buffer ediff-window-setup-function) - buffer-A buffer-B buffer-C control-buffer)) - (run-hooks 'ediff-after-setup-windows-hook)) - -;; Just set up 3 windows. -;; Usually used without windowing systems -;; With windowing, we want to use dedicated frames. -(defun ediff-setup-windows-plain (buffer-A buffer-B buffer-C control-buffer) - (ediff-with-current-buffer control-buffer - (setq ediff-multiframe nil)) - (if ediff-merge-job - (ediff-setup-windows-plain-merge - buffer-A buffer-B buffer-C control-buffer) - (ediff-setup-windows-plain-compare - buffer-A buffer-B buffer-C control-buffer))) - -(defun ediff-setup-windows-plain-merge (buf-A buf-B buf-C control-buffer) - ;; skip dedicated and unsplittable frames - (ediff-destroy-control-frame control-buffer) - (let ((window-min-height 1) - split-window-function - merge-window-share merge-window-lines - wind-A wind-B wind-C) - (ediff-with-current-buffer control-buffer - (setq merge-window-share ediff-merge-window-share - ;; this lets us have local versions of ediff-split-window-function - split-window-function ediff-split-window-function)) - (delete-other-windows) - (split-window-vertically) - (ediff-select-lowest-window) - (ediff-setup-control-buffer control-buffer) - - ;; go to the upper window and split it betw A, B, and possibly C - (other-window 1) - (setq merge-window-lines - (max 2 (round (* (window-height) merge-window-share)))) - (switch-to-buffer buf-A) - (setq wind-A (selected-window)) - - ;; XEmacs used to have a lot of trouble with display - ;; It did't set things right unless we tell it to sit still - ;; 19.12 seems ok. - ;;(if ediff-xemacs-p (sit-for 0)) - - (split-window-vertically (max 2 (- (window-height) merge-window-lines))) - (if (eq (selected-window) wind-A) - (other-window 1)) - (setq wind-C (selected-window)) - (switch-to-buffer buf-C) - - (select-window wind-A) - (funcall split-window-function) - - (if (eq (selected-window) wind-A) - (other-window 1)) - (switch-to-buffer buf-B) - (setq wind-B (selected-window)) - - (ediff-with-current-buffer control-buffer - (setq ediff-window-A wind-A - ediff-window-B wind-B - ediff-window-C wind-C)) - - (ediff-select-lowest-window) - (ediff-setup-control-buffer control-buffer) - )) - - -;; This function handles all comparison jobs, including 3way jobs -(defun ediff-setup-windows-plain-compare (buf-A buf-B buf-C control-buffer) - ;; skip dedicated and unsplittable frames - (ediff-destroy-control-frame control-buffer) - (let ((window-min-height 1) - split-window-function wind-width-or-height - three-way-comparison - wind-A-start wind-B-start wind-A wind-B wind-C) - (ediff-with-current-buffer control-buffer - (setq wind-A-start (ediff-overlay-start - (ediff-get-value-according-to-buffer-type - 'A ediff-narrow-bounds)) - wind-B-start (ediff-overlay-start - (ediff-get-value-according-to-buffer-type - 'B ediff-narrow-bounds)) - ;; this lets us have local versions of ediff-split-window-function - split-window-function ediff-split-window-function - three-way-comparison ediff-3way-comparison-job)) - (delete-other-windows) - (split-window-vertically) - (ediff-select-lowest-window) - (ediff-setup-control-buffer control-buffer) - - ;; go to the upper window and split it betw A, B, and possibly C - (other-window 1) - (switch-to-buffer buf-A) - (setq wind-A (selected-window)) - (if three-way-comparison - (setq wind-width-or-height - (/ (if (eq split-window-function 'split-window-vertically) - (window-height wind-A) - (window-width wind-A)) - 3))) - - ;; XEmacs used to have a lot of trouble with display - ;; It did't set things right unless we told it to sit still - ;; 19.12 seems ok. - ;;(if ediff-xemacs-p (sit-for 0)) - - (funcall split-window-function wind-width-or-height) - - (if (eq (selected-window) wind-A) - (other-window 1)) - (switch-to-buffer buf-B) - (setq wind-B (selected-window)) - - (if three-way-comparison - (progn - (funcall split-window-function) ; equally - (if (eq (selected-window) wind-B) - (other-window 1)) - (switch-to-buffer buf-C) - (setq wind-C (selected-window)))) - - (ediff-with-current-buffer control-buffer - (setq ediff-window-A wind-A - ediff-window-B wind-B - ediff-window-C wind-C)) - - ;; It is unlikely that we will want to implement 3way window comparison. - ;; So, only buffers A and B are used here. - (if ediff-windows-job - (progn - (set-window-start wind-A wind-A-start) - (set-window-start wind-B wind-B-start))) - - (ediff-select-lowest-window) - (ediff-setup-control-buffer control-buffer) - )) - - -;; dispatch an appropriate window setup function -(defun ediff-setup-windows-multiframe (buf-A buf-B buf-C control-buf) - (ediff-with-current-buffer control-buf - (setq ediff-multiframe t)) - (if ediff-merge-job - (ediff-setup-windows-multiframe-merge buf-A buf-B buf-C control-buf) - (ediff-setup-windows-multiframe-compare buf-A buf-B buf-C control-buf))) - -(defun ediff-setup-windows-multiframe-merge (buf-A buf-B buf-C control-buf) -;;; Algorithm: -;;; 1. Never use frames that have dedicated windows in them---it is bad to -;;; destroy dedicated windows. -;;; 2. If A and B are in the same frame but C's frame is different--- use one -;;; frame for A and B and use a separate frame for C. -;;; 3. If C's frame is non-existent, then: if the first suitable -;;; non-dedicated frame is different from A&B's, then use it for C. -;;; Otherwise, put A,B, and C in one frame. -;;; 4. If buffers A, B, C are is separate frames, use them to display these -;;; buffers. - - ;; Skip dedicated or iconified frames. - ;; Unsplittable frames are taken care of later. - (ediff-skip-unsuitable-frames 'ok-unsplittable) - - (let* ((window-min-height 1) - (wind-A (ediff-get-visible-buffer-window buf-A)) - (wind-B (ediff-get-visible-buffer-window buf-B)) - (wind-C (ediff-get-visible-buffer-window buf-C)) - (frame-A (if wind-A (window-frame wind-A))) - (frame-B (if wind-B (window-frame wind-B))) - (frame-C (if wind-C (window-frame wind-C))) - ;; on wide display, do things in one frame - (force-one-frame - (ediff-with-current-buffer control-buf ediff-wide-display-p)) - ;; this lets us have local versions of ediff-split-window-function - (split-window-function - (ediff-with-current-buffer control-buf ediff-split-window-function)) - (orig-wind (selected-window)) - (orig-frame (selected-frame)) - (use-same-frame (or force-one-frame - ;; A and C must be in one frame - (eq frame-A (or frame-C orig-frame)) - ;; B and C must be in one frame - (eq frame-B (or frame-C orig-frame)) - ;; A or B is not visible - (not (frame-live-p frame-A)) - (not (frame-live-p frame-B)) - ;; A or B is not suitable for display - (not (ediff-window-ok-for-display wind-A)) - (not (ediff-window-ok-for-display wind-B)) - ;; A and B in the same frame, and no good frame - ;; for C - (and (eq frame-A frame-B) - (not (frame-live-p frame-C))) - )) - ;; use-same-frame-for-AB implies wind A and B are ok for display - (use-same-frame-for-AB (and (not use-same-frame) - (eq frame-A frame-B))) - (merge-window-share (ediff-with-current-buffer control-buf - ediff-merge-window-share)) - merge-window-lines - designated-minibuffer-frame - done-A done-B done-C) - - ;; buf-A on its own - (if (and (window-live-p wind-A) - (null use-same-frame) ; implies wind-A is suitable - (null use-same-frame-for-AB)) - (progn ; bug A on its own - ;; buffer buf-A is seen in live wind-A - (select-window wind-A) - (delete-other-windows) - (setq wind-A (selected-window)) - (setq done-A t))) - - ;; buf-B on its own - (if (and (window-live-p wind-B) - (null use-same-frame) ; implies wind-B is suitable - (null use-same-frame-for-AB)) - (progn ; buf B on its own - ;; buffer buf-B is seen in live wind-B - (select-window wind-B) - (delete-other-windows) - (setq wind-B (selected-window)) - (setq done-B t))) - - ;; buf-C on its own - (if (and (window-live-p wind-C) - (ediff-window-ok-for-display wind-C) - (null use-same-frame)) ; buf C on its own - (progn - ;; buffer buf-C is seen in live wind-C - (select-window wind-C) - (delete-other-windows) - (setq wind-C (selected-window)) - (setq done-C t))) - - (if (and use-same-frame-for-AB ; implies wind A and B are suitable - (window-live-p wind-A)) - (progn - ;; wind-A must already be displaying buf-A - (select-window wind-A) - (delete-other-windows) - (setq wind-A (selected-window)) - - (funcall split-window-function) - (if (eq (selected-window) wind-A) - (other-window 1)) - (switch-to-buffer buf-B) - (setq wind-B (selected-window)) - - (setq done-A t - done-B t))) - - (if use-same-frame - (let ((window-min-height 1)) - (if (and (eq frame-A frame-B) - (eq frame-B frame-C) - (frame-live-p frame-A)) - (select-frame frame-A) - ;; avoid dedicated and non-splittable windows - (ediff-skip-unsuitable-frames)) - (delete-other-windows) - (setq merge-window-lines - (max 2 (round (* (window-height) merge-window-share)))) - (switch-to-buffer buf-A) - (setq wind-A (selected-window)) - - (split-window-vertically - (max 2 (- (window-height) merge-window-lines))) - (if (eq (selected-window) wind-A) - (other-window 1)) - (setq wind-C (selected-window)) - (switch-to-buffer buf-C) - - (select-window wind-A) - - (funcall split-window-function) - (if (eq (selected-window) wind-A) - (other-window 1)) - (switch-to-buffer buf-B) - (setq wind-B (selected-window)) - - (setq done-A t - done-B t - done-C t) - )) - - (or done-A ; Buf A to be set in its own frame, - ;;; or it was set before because use-same-frame = 1 - (progn - ;; Buf-A was not set up yet as it wasn't visible, - ;; and use-same-frame = nil, use-same-frame-for-AB = nil - (select-window orig-wind) - (delete-other-windows) - (switch-to-buffer buf-A) - (setq wind-A (selected-window)) - )) - (or done-B ; Buf B to be set in its own frame, - ;;; or it was set before because use-same-frame = 1 - (progn - ;; Buf-B was not set up yet as it wasn't visible - ;; and use-same-frame = nil, use-same-frame-for-AB = nil - (select-window orig-wind) - (delete-other-windows) - (switch-to-buffer buf-B) - (setq wind-B (selected-window)) - )) - - (or done-C ; Buf C to be set in its own frame, - ;;; or it was set before because use-same-frame = 1 - (progn - ;; Buf-C was not set up yet as it wasn't visible - ;; and use-same-frame = nil - (select-window orig-wind) - (delete-other-windows) - (switch-to-buffer buf-C) - (setq wind-C (selected-window)) - )) - - (ediff-with-current-buffer control-buf - (setq ediff-window-A wind-A - ediff-window-B wind-B - ediff-window-C wind-C) - (setq frame-A (window-frame ediff-window-A) - designated-minibuffer-frame - (window-frame (minibuffer-window frame-A)))) - - (ediff-setup-control-frame control-buf designated-minibuffer-frame) - )) - - -;; Window setup for all comparison jobs, including 3way comparisons -(defun ediff-setup-windows-multiframe-compare (buf-A buf-B buf-C control-buf) -;;; Algorithm: -;;; If a buffer is seen in a frame, use that frame for that buffer. -;;; If it is not seen, use the current frame. -;;; If both buffers are not seen, they share the current frame. If one -;;; of the buffers is not seen, it is placed in the current frame (where -;;; ediff started). If that frame is displaying the other buffer, it is -;;; shared between the two buffers. -;;; However, if we decide to put both buffers in one frame -;;; and the selected frame isn't splittable, we create a new frame and -;;; put both buffers there, event if one of this buffers is visible in -;;; another frame. - - ;; Skip dedicated or iconified frames. - ;; Unsplittable frames are taken care of later. - (ediff-skip-unsuitable-frames 'ok-unsplittable) - - (let* ((window-min-height 1) - (wind-A (ediff-get-visible-buffer-window buf-A)) - (wind-B (ediff-get-visible-buffer-window buf-B)) - (wind-C (ediff-get-visible-buffer-window buf-C)) - (frame-A (if wind-A (window-frame wind-A))) - (frame-B (if wind-B (window-frame wind-B))) - (frame-C (if wind-C (window-frame wind-C))) - (ctl-frame-exists-p (ediff-with-current-buffer control-buf - (frame-live-p ediff-control-frame))) - ;; on wide display, do things in one frame - (force-one-frame - (ediff-with-current-buffer control-buf ediff-wide-display-p)) - ;; this lets us have local versions of ediff-split-window-function - (split-window-function - (ediff-with-current-buffer control-buf ediff-split-window-function)) - (three-way-comparison - (ediff-with-current-buffer control-buf ediff-3way-comparison-job)) - (orig-wind (selected-window)) - (use-same-frame (or force-one-frame - (eq frame-A frame-B) - (not (ediff-window-ok-for-display wind-A)) - (not (ediff-window-ok-for-display wind-B)) - (if three-way-comparison - (or (eq frame-A frame-C) - (eq frame-B frame-C) - (not (ediff-window-ok-for-display wind-C)) - (not (frame-live-p frame-A)) - (not (frame-live-p frame-B)) - (not (frame-live-p frame-C)))) - (and (not (frame-live-p frame-B)) - (or ctl-frame-exists-p - (eq frame-A (selected-frame)))) - (and (not (frame-live-p frame-A)) - (or ctl-frame-exists-p - (eq frame-B (selected-frame)))))) - wind-A-start wind-B-start - designated-minibuffer-frame - done-A done-B done-C) - - (ediff-with-current-buffer control-buf - (setq wind-A-start (ediff-overlay-start - (ediff-get-value-according-to-buffer-type - 'A ediff-narrow-bounds)) - wind-B-start (ediff-overlay-start - (ediff-get-value-according-to-buffer-type - 'B ediff-narrow-bounds)))) - - (if (and (window-live-p wind-A) (null use-same-frame)) ; buf-A on its own - (progn - ;; buffer buf-A is seen in live wind-A - (select-window wind-A) ; must be displaying buf-A - (delete-other-windows) - (setq wind-A (selected-window)) - (setq done-A t))) - - (if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own - (progn - ;; buffer buf-B is seen in live wind-B - (select-window wind-B) ; must be displaying buf-B - (delete-other-windows) - (setq wind-B (selected-window)) - (setq done-B t))) - - (if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own - (progn - ;; buffer buf-C is seen in live wind-C - (select-window wind-C) ; must be displaying buf-C - (delete-other-windows) - (setq wind-C (selected-window)) - (setq done-C t))) - - (if use-same-frame - (let (wind-width-or-height) ; this affects 3way setups only - (if (and (eq frame-A frame-B) (frame-live-p frame-A)) - (select-frame frame-A) - ;; avoid dedicated and non-splittable windows - (ediff-skip-unsuitable-frames)) - (delete-other-windows) - (switch-to-buffer buf-A) - (setq wind-A (selected-window)) - - (if three-way-comparison - (setq wind-width-or-height - (/ - (if (eq split-window-function 'split-window-vertically) - (window-height wind-A) - (window-width wind-A)) - 3))) - - (funcall split-window-function wind-width-or-height) - (if (eq (selected-window) wind-A) - (other-window 1)) - (switch-to-buffer buf-B) - (setq wind-B (selected-window)) - - (if three-way-comparison - (progn - (funcall split-window-function) ; equally - (if (memq (selected-window) (list wind-A wind-B)) - (other-window 1)) - (switch-to-buffer buf-C) - (setq wind-C (selected-window)))) - (setq done-A t - done-B t - done-C t) - )) - - (or done-A ; Buf A to be set in its own frame - ;;; or it was set before because use-same-frame = 1 - (progn - ;; Buf-A was not set up yet as it wasn't visible, - ;; and use-same-frame = nil - (select-window orig-wind) - (delete-other-windows) - (switch-to-buffer buf-A) - (setq wind-A (selected-window)) - )) - (or done-B ; Buf B to be set in its own frame - ;;; or it was set before because use-same-frame = 1 - (progn - ;; Buf-B was not set up yet as it wasn't visible, - ;; and use-same-frame = nil - (select-window orig-wind) - (delete-other-windows) - (switch-to-buffer buf-B) - (setq wind-B (selected-window)) - )) - - (if three-way-comparison - (or done-C ; Buf C to be set in its own frame - ;;; or it was set before because use-same-frame = 1 - (progn - ;; Buf-C was not set up yet as it wasn't visible, - ;; and use-same-frame = nil - (select-window orig-wind) - (delete-other-windows) - (switch-to-buffer buf-C) - (setq wind-C (selected-window)) - ))) - - (ediff-with-current-buffer control-buf - (setq ediff-window-A wind-A - ediff-window-B wind-B - ediff-window-C wind-C) - - (setq frame-A (window-frame ediff-window-A) - designated-minibuffer-frame - (window-frame (minibuffer-window frame-A)))) - - ;; It is unlikely that we'll implement a version of ediff-windows that - ;; would compare 3 windows at once. So, we don't use buffer C here. - (if ediff-windows-job - (progn - (set-window-start wind-A wind-A-start) - (set-window-start wind-B wind-B-start))) - - (ediff-setup-control-frame control-buf designated-minibuffer-frame) - )) - -;; skip unsplittable frames and frames that have dedicated windows. -;; create a new splittable frame if none is found -(defun ediff-skip-unsuitable-frames (&optional ok-unsplittable) - (if (ediff-window-display-p) - (let ((wind-frame (window-frame (selected-window))) - seen-windows) - (while (and (not (memq (selected-window) seen-windows)) - (or - (ediff-frame-has-dedicated-windows wind-frame) - (ediff-frame-iconified-p wind-frame) - ;; skip small windows - (< (frame-height wind-frame) - (* 3 window-min-height)) - (if ok-unsplittable - nil - (ediff-frame-unsplittable-p wind-frame)))) - ;; remember history - (setq seen-windows (cons (selected-window) seen-windows)) - ;; try new window - (other-window 1 t) - (setq wind-frame (window-frame (selected-window))) - ) - (if (memq (selected-window) seen-windows) - ;; fed up, no appropriate frames - (setq wind-frame (make-frame '((unsplittable))))) - - (select-frame wind-frame) - ))) - -(defun ediff-frame-has-dedicated-windows (frame) - (let (ans) - (walk-windows - (lambda (wind) (if (window-dedicated-p wind) - (setq ans t))) - 'ignore-minibuffer - frame) - ans)) - -;; window is ok, if it is only one window on the frame, not counting the -;; minibuffer, or none of the frame's windows is dedicated. -;; The idea is that it is bad to destroy dedicated windows while creating an -;; ediff window setup -(defun ediff-window-ok-for-display (wind) - (and - (window-live-p wind) - (or - ;; only one window - (eq wind (next-window wind 'ignore-minibuffer (window-frame wind))) - ;; none is dedicated - (not (ediff-frame-has-dedicated-windows (window-frame wind))) - ))) - -;; Prepare or refresh control frame -(defun ediff-setup-control-frame (ctl-buffer designated-minibuffer-frame) - (let ((window-min-height 1) - ctl-frame-iconified-p dont-iconify-ctl-frame deiconify-ctl-frame - ctl-frame old-ctl-frame lines - ;; user-grabbed-mouse - fheight fwidth adjusted-parameters) - - (ediff-with-current-buffer ctl-buffer - (ediff-cond-compile-for-xemacs-or-emacs - (when (featurep 'menubar) (set-buffer-menubar nil)) ; xemacs - nil ; emacs - ) - ;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse)) - (run-hooks 'ediff-before-setup-control-frame-hook)) - - (setq old-ctl-frame (ediff-with-current-buffer ctl-buffer ediff-control-frame)) - (ediff-with-current-buffer ctl-buffer - (setq ctl-frame (if (frame-live-p old-ctl-frame) - old-ctl-frame - (make-frame ediff-control-frame-parameters)) - ediff-control-frame ctl-frame) - ;; protect against undefined face-attribute - (condition-case nil - (ediff-cond-compile-for-xemacs-or-emacs - nil ; xemacs - (when (face-attribute 'mode-line :box) - (set-face-attribute 'mode-line ctl-frame :box nil)) - ) - (error)) - ) - - (setq ctl-frame-iconified-p (ediff-frame-iconified-p ctl-frame)) - (select-frame ctl-frame) - (if (window-dedicated-p (selected-window)) - () - (delete-other-windows) - (switch-to-buffer ctl-buffer)) - - ;; must be before ediff-setup-control-buffer - ;; just a precaution--we should be in ctl-buffer already - (ediff-with-current-buffer ctl-buffer - (make-local-variable 'frame-title-format) - (make-local-variable 'frame-icon-title-format) ; XEmacs - (make-local-variable 'icon-title-format)) ; Emacs - - (ediff-setup-control-buffer ctl-buffer) - (setq dont-iconify-ctl-frame - (not (string= ediff-help-message ediff-brief-help-message))) - (setq deiconify-ctl-frame - (and (eq this-command 'ediff-toggle-help) - dont-iconify-ctl-frame)) - - ;; 1 more line for the modeline - (setq lines (1+ (count-lines (point-min) (point-max))) - fheight lines - fwidth (max (+ (ediff-help-message-line-length) 2) - (ediff-compute-toolbar-width)) - adjusted-parameters - (list - ;; possibly change surrogate minibuffer - (cons 'minibuffer - (minibuffer-window - designated-minibuffer-frame)) - (cons 'width fwidth) - (cons 'height fheight) - (cons 'user-position t) - )) - - ;; adjust autoraise - (setq adjusted-parameters - (cons (if ediff-use-long-help-message - '(auto-raise . nil) - '(auto-raise . t)) - adjusted-parameters)) - - ;; In XEmacs, buffer menubar needs to be killed before frame parameters - ;; are changed. - (if (ediff-has-toolbar-support-p) - (ediff-cond-compile-for-xemacs-or-emacs - (progn ; xemacs - (if (ediff-has-gutter-support-p) - (set-specifier top-gutter (list ctl-frame nil))) - (sit-for 0) - (set-specifier top-toolbar-height (list ctl-frame 0)) - ;;(set-specifier bottom-toolbar-height (list ctl-frame 0)) - (set-specifier left-toolbar-width (list ctl-frame 0)) - (set-specifier right-toolbar-width (list ctl-frame 0)) - ) - nil ; emacs - ) - ) - - ;; Under OS/2 (emx) we have to call modify frame parameters twice, in order - ;; to make sure that at least once we do it for non-iconified frame. If - ;; appears that in the OS/2 port of Emacs, one can't modify frame - ;; parameters of iconified frames. As a precaution, we do likewise for - ;; windows-nt. - (if (memq system-type '(emx windows-nt windows-95)) - (modify-frame-parameters ctl-frame adjusted-parameters)) - - ;; make or zap toolbar (if not requested) - (ediff-make-bottom-toolbar ctl-frame) - - (goto-char (point-min)) - - (modify-frame-parameters ctl-frame adjusted-parameters) - (make-frame-visible ctl-frame) - - ;; This works around a bug in 19.25 and earlier. There, if frame gets - ;; iconified, the current buffer changes to that of the frame that - ;; becomes exposed as a result of this iconification. - ;; So, we make sure the current buffer doesn't change. - (select-frame ctl-frame) - (ediff-refresh-control-frame) - - (cond ((and ediff-prefer-iconified-control-frame - (not ctl-frame-iconified-p) (not dont-iconify-ctl-frame)) - (iconify-frame ctl-frame)) - ((or deiconify-ctl-frame (not ctl-frame-iconified-p)) - (raise-frame ctl-frame))) - - (set-window-dedicated-p (selected-window) t) - - ;; Now move the frame. We must do it separately due to an obscure bug in - ;; XEmacs - (modify-frame-parameters - ctl-frame - (funcall ediff-control-frame-position-function ctl-buffer fwidth fheight)) - - ;; synchronize so the cursor will move to control frame - ;; per RMS suggestion - (if (ediff-window-display-p) - (let ((count 7)) - (sit-for .1) - (while (and (not (frame-visible-p ctl-frame)) (> count 0)) - (setq count (1- count)) - (sit-for .3)))) - - (or (ediff-frame-iconified-p ctl-frame) - ;; don't warp the mouse, unless ediff-grab-mouse = t - (ediff-reset-mouse ctl-frame - (or (eq this-command 'ediff-quit) - (not (eq ediff-grab-mouse t))))) - - (if ediff-xemacs-p - (ediff-with-current-buffer ctl-buffer - (ediff-cond-compile-for-xemacs-or-emacs - (make-local-hook 'select-frame-hook) ; xemacs - nil ; emacs - ) - (add-hook - 'select-frame-hook 'ediff-xemacs-select-frame-hook nil 'local) - )) - - (ediff-with-current-buffer ctl-buffer - (run-hooks 'ediff-after-setup-control-frame-hook)) - )) - - -(defun ediff-destroy-control-frame (ctl-buffer) - (ediff-with-current-buffer ctl-buffer - (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) - (let ((ctl-frame ediff-control-frame)) - (ediff-cond-compile-for-xemacs-or-emacs - (when (featurep 'menubar) - (set-buffer-menubar default-menubar)) ; xemacs - nil ; emacs - ) - (setq ediff-control-frame nil) - (delete-frame ctl-frame) - ))) - (ediff-skip-unsuitable-frames) - ;;(ediff-reset-mouse nil) - ) - - -;; finds a good place to clip control frame -(defun ediff-make-frame-position (ctl-buffer ctl-frame-width ctl-frame-height) - (ediff-with-current-buffer ctl-buffer - (let* ((frame-A (window-frame ediff-window-A)) - (frame-A-parameters (frame-parameters frame-A)) - (frame-A-top (eval (cdr (assoc 'top frame-A-parameters)))) - (frame-A-left (eval (cdr (assoc 'left frame-A-parameters)))) - (frame-A-width (frame-width frame-A)) - (ctl-frame ediff-control-frame) - horizontal-adjustment upward-adjustment - ctl-frame-top ctl-frame-left) - - ;; Multiple control frames are clipped based on the value of - ;; ediff-control-buffer-number. This is done in order not to obscure - ;; other active control panels. - (setq horizontal-adjustment (* 2 ediff-control-buffer-number) - upward-adjustment (* -14 ediff-control-buffer-number)) - - (setq ctl-frame-top - (- frame-A-top upward-adjustment ediff-control-frame-upward-shift) - ctl-frame-left - (+ frame-A-left - (if ediff-use-long-help-message - (* (ediff-frame-char-width ctl-frame) - (+ ediff-wide-control-frame-rightward-shift - horizontal-adjustment)) - (- (* frame-A-width (ediff-frame-char-width frame-A)) - (* (ediff-frame-char-width ctl-frame) - (+ ctl-frame-width - ediff-narrow-control-frame-leftward-shift - horizontal-adjustment)))))) - (setq ctl-frame-top - (min ctl-frame-top - (- (ediff-display-pixel-height) - (* 2 ctl-frame-height - (ediff-frame-char-height ctl-frame)))) - ctl-frame-left - (min ctl-frame-left - (- (ediff-display-pixel-width) - (* ctl-frame-width (ediff-frame-char-width ctl-frame))))) - ;; keep ctl frame within the visible bounds - (setq ctl-frame-top (max ctl-frame-top 1) - ctl-frame-left (max ctl-frame-left 1)) - - (list (cons 'top ctl-frame-top) - (cons 'left ctl-frame-left)) - ))) - -(defun ediff-xemacs-select-frame-hook () - (if (and (equal (selected-frame) ediff-control-frame) - (not ediff-use-long-help-message)) - (raise-frame ediff-control-frame))) - -(defun ediff-make-wide-display () - "Construct an alist of parameters for the wide display. -Saves the old frame parameters in `ediff-wide-display-orig-parameters'. -The frame to be resized is kept in `ediff-wide-display-frame'. -This function modifies only the left margin and the width of the display. -It assumes that it is called from within the control buffer." - (if (not (fboundp 'ediff-display-pixel-width)) - (error "Can't determine display width")) - (let* ((frame-A (window-frame ediff-window-A)) - (frame-A-params (frame-parameters frame-A)) - (cw (ediff-frame-char-width frame-A)) - (wd (- (/ (ediff-display-pixel-width) cw) 5))) - (setq ediff-wide-display-orig-parameters - (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params))))) - (cons 'width (cdr (assoc 'width frame-A-params)))) - ediff-wide-display-frame frame-A) - (modify-frame-parameters - frame-A `((left . ,cw) (width . ,wd) (user-position t))))) - - -;; Revise the mode line to display which difference we have selected -;; Also resets modelines of buffers A/B, since they may be clobbered by -;; anothe invocations of Ediff. -(defun ediff-refresh-mode-lines () - (let (buf-A-state-diff buf-B-state-diff buf-C-state-diff buf-C-state-merge) - - (if (ediff-valid-difference-p) - (setq - buf-C-state-diff (ediff-get-state-of-diff ediff-current-difference 'C) - buf-C-state-merge (ediff-get-state-of-merge ediff-current-difference) - buf-A-state-diff (ediff-get-state-of-diff ediff-current-difference 'A) - buf-B-state-diff (ediff-get-state-of-diff ediff-current-difference 'B) - buf-A-state-diff (if buf-A-state-diff - (format "[%s] " buf-A-state-diff) - "") - buf-B-state-diff (if buf-B-state-diff - (format "[%s] " buf-B-state-diff) - "") - buf-C-state-diff (if (and (ediff-buffer-live-p ediff-buffer-C) - (or buf-C-state-diff buf-C-state-merge)) - (format "[%s%s%s] " - (or buf-C-state-diff "") - (if buf-C-state-merge - (concat " " buf-C-state-merge) - "") - (if (ediff-get-state-of-ancestor - ediff-current-difference) - " AncestorEmpty" - "") - ) - "")) - (setq buf-A-state-diff "" - buf-B-state-diff "" - buf-C-state-diff "")) - - ;; control buffer format - (setq mode-line-format - (if (ediff-narrow-control-frame-p) - (list " " mode-line-buffer-identification) - (list "-- " mode-line-buffer-identification " Quick Help"))) - ;; control buffer id - (setq mode-line-buffer-identification - (if (ediff-narrow-control-frame-p) - (ediff-make-narrow-control-buffer-id 'skip-name) - (ediff-make-wide-control-buffer-id))) - ;; Force mode-line redisplay - (force-mode-line-update) - - (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) - (ediff-refresh-control-frame)) - - (ediff-with-current-buffer ediff-buffer-A - (setq ediff-diff-status buf-A-state-diff) - (ediff-strip-mode-line-format) - (setq mode-line-format - (list " A: " 'ediff-diff-status mode-line-format)) - (force-mode-line-update)) - (ediff-with-current-buffer ediff-buffer-B - (setq ediff-diff-status buf-B-state-diff) - (ediff-strip-mode-line-format) - (setq mode-line-format - (list " B: " 'ediff-diff-status mode-line-format)) - (force-mode-line-update)) - (if ediff-3way-job - (ediff-with-current-buffer ediff-buffer-C - (setq ediff-diff-status buf-C-state-diff) - (ediff-strip-mode-line-format) - (setq mode-line-format - (list " C: " 'ediff-diff-status mode-line-format)) - (force-mode-line-update))) - (if (ediff-buffer-live-p ediff-ancestor-buffer) - (ediff-with-current-buffer ediff-ancestor-buffer - (ediff-strip-mode-line-format) - ;; we keep the second dummy string in the mode line format of the - ;; ancestor, since for other buffers Ediff prepends 2 strings and - ;; ediff-strip-mode-line-format expects that. - (setq mode-line-format - (list " Ancestor: " - (cond ((not (stringp buf-C-state-merge)) - "") - ((string-match "prefer-A" buf-C-state-merge) - "[=diff(B)] ") - ((string-match "prefer-B" buf-C-state-merge) - "[=diff(A)] ") - (t "")) - mode-line-format)))) - )) - - -(defun ediff-refresh-control-frame () - (if ediff-emacs-p - ;; set frame/icon titles for Emacs - (modify-frame-parameters - ediff-control-frame - (list (cons 'title (ediff-make-base-title)) - (cons 'icon-name (ediff-make-narrow-control-buffer-id)) - )) - ;; set frame/icon titles for XEmacs - (setq frame-title-format (ediff-make-base-title) - frame-icon-title-format (ediff-make-narrow-control-buffer-id)) - ;; force an update of the frame title - (modify-frame-parameters ediff-control-frame '(())))) - - -(defun ediff-make-narrow-control-buffer-id (&optional skip-name) - (concat - (if skip-name - " " - (ediff-make-base-title)) - (cond ((< ediff-current-difference 0) - (format " _/%d" ediff-number-of-differences)) - ((>= ediff-current-difference ediff-number-of-differences) - (format " $/%d" ediff-number-of-differences)) - (t - (format " %d/%d" - (1+ ediff-current-difference) - ediff-number-of-differences))))) - -(defun ediff-make-base-title () - (concat - (cdr (assoc 'name ediff-control-frame-parameters)) - ediff-control-buffer-suffix)) - -(defun ediff-make-wide-control-buffer-id () - (cond ((< ediff-current-difference 0) - (list (format "%%b At start of %d diffs" - ediff-number-of-differences))) - ((>= ediff-current-difference ediff-number-of-differences) - (list (format "%%b At end of %d diffs" - ediff-number-of-differences))) - (t - (list (format "%%b diff %d of %d" - (1+ ediff-current-difference) - ediff-number-of-differences))))) - - - -;; If buff is not live, return nil -(defun ediff-get-visible-buffer-window (buff) - (if (ediff-buffer-live-p buff) - (if ediff-xemacs-p - (get-buffer-window buff t) - (get-buffer-window buff 'visible)))) - - -;;; Functions to decide when to redraw windows - -(defun ediff-keep-window-config (control-buf) - (and (eq control-buf (current-buffer)) - (/= (buffer-size) 0) - (ediff-with-current-buffer control-buf - (let ((ctl-wind ediff-control-window) - (A-wind ediff-window-A) - (B-wind ediff-window-B) - (C-wind ediff-window-C)) - - (and - (ediff-window-visible-p A-wind) - (ediff-window-visible-p B-wind) - ;; if buffer C is defined then take it into account - (or (not ediff-3way-job) - (ediff-window-visible-p C-wind)) - (eq (window-buffer A-wind) ediff-buffer-A) - (eq (window-buffer B-wind) ediff-buffer-B) - (or (not ediff-3way-job) - (eq (window-buffer C-wind) ediff-buffer-C)) - (string= ediff-window-config-saved - (format "%S%S%S%S%S%S%S" - ctl-wind A-wind B-wind C-wind - ediff-split-window-function - (ediff-multiframe-setup-p) - ediff-wide-display-p))))))) - - -(provide 'ediff-wind) - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; arch-tag: 73d9a5d7-eed7-4d9c-8b4b-21d5d78eb597 -;;; ediff-wind.el ends here diff --git a/xemacs-packages/lisp/ediff/ediff.el b/xemacs-packages/lisp/ediff/ediff.el deleted file mode 100644 index bb6cfc6b..00000000 --- a/xemacs-packages/lisp/ediff/ediff.el +++ /dev/null @@ -1,1546 +0,0 @@ -;;; ediff.el --- a comprehensive visual interface to diff & patch - -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc. - -;; Author: Michael Kifer -;; Created: February 2, 1994 -;; Keywords: comparing, merging, patching, tools, unix - -(defconst ediff-version "2.81" "The current version of Ediff") -(defconst ediff-date "February 18, 2006" "Date of last update") - - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Never read that diff output again! -;; Apply patch interactively! -;; Merge with ease! - -;; This package provides a convenient way of simultaneous browsing through -;; the differences between a pair (or a triple) of files or buffers. The -;; files being compared, file-A, file-B, and file-C (if applicable) are -;; shown in separate windows (side by side, one above the another, or in -;; separate frames), and the differences are highlighted as you step -;; through them. You can also copy difference regions from one buffer to -;; another (and recover old differences if you change your mind). - -;; Ediff also supports merging operations on files and buffers, including -;; merging using ancestor versions. Both comparison and merging operations can -;; be performed on directories, i.e., by pairwise comparison of files in those -;; directories. - -;; In addition, Ediff can apply a patch to a file and then let you step -;; though both files, the patched and the original one, simultaneously, -;; difference-by-difference. You can even apply a patch right out of a -;; mail buffer, i.e., patches received by mail don't even have to be saved. -;; Since Ediff lets you copy differences between buffers, you can, in -;; effect, apply patches selectively (i.e., you can copy a difference -;; region from file_orig to file, thereby undoing any particular patch that -;; you don't like). - -;; Ediff is aware of version control, which lets the user compare -;; files with their older versions. Ediff can also work with remote and -;; compressed files. Details are given below. - -;; Finally, Ediff supports directory-level comparison, merging and patching. -;; See the on-line manual for details. - -;; This package builds upon the ideas borrowed from emerge.el and several -;; Ediff's functions are adaptations from emerge.el. Much of the functionality -;; Ediff provides is also influenced by emerge.el. - -;; The present version of Ediff supersedes Emerge. It provides a superior user -;; interface and has numerous major features not found in Emerge. In -;; particular, it can do patching, and 2-way and 3-way file comparison, -;; merging, and directory operations. - - - -;;; Bugs: - -;; 1. The undo command doesn't restore deleted regions well. That is, if -;; you delete all characters in a difference region and then invoke -;; `undo', the reinstated text will most likely be inserted outside of -;; what Ediff thinks is the current difference region. (This problem -;; doesn't seem to exist with XEmacs.) -;; -;; If at any point you feel that difference regions are no longer correct, -;; you can hit '!' to recompute the differences. - -;; 2. On a monochrome display, the repertoire of faces with which to -;; highlight fine differences is limited. By default, Ediff is using -;; underlining. However, if the region is already underlined by some other -;; overlays, there is no simple way to temporarily remove that residual -;; underlining. This problem occurs when a buffer is highlighted with -;; hilit19.el or font-lock.el packages. If this residual highlighting gets -;; in the way, you can do the following. Both font-lock.el and hilit19.el -;; provide commands for unhighlighting buffers. You can either place these -;; commands in `ediff-prepare-buffer-hook' (which will unhighlight every -;; buffer used by Ediff) or you can execute them interactively, at any time -;; and on any buffer. - - -;;; Acknowledgements: - -;; Ediff was inspired by Dale R. Worley's emerge.el. -;; Ediff would not have been possible without the help and encouragement of -;; its many users. See Ediff on-line Info for the full list of those who -;; helped. Improved defaults in Ediff file-name reading commands. - -;;; Code: - - -;; Compiler pacifier -(defvar cvs-cookie-handle) -(defvar ediff-last-dir-patch) -(defvar ediff-patch-default-directory) - -(and noninteractive - (eval-when-compile - (load-library "dired") - (load-library "info") - (load "pcl-cvs" 'noerror))) -(eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (provide 'ediff) ; to break recursive load cycle - (or (featurep 'ediff-init) - (load "ediff-init.el" nil nil 'nosuffix)) - (or (featurep 'ediff-mult) - (load "ediff-mult.el" nil nil 'nosuffix)) - (or (featurep 'ediff-ptch) - (load "ediff-ptch.el" nil nil 'nosuffix)) - (or (featurep 'ediff-vers) - (load "ediff-vers.el" nil nil 'nosuffix)) - )) -;; end pacifier - -(require 'ediff-init) -(require 'ediff-mult) ; required because of the registry stuff - -(defgroup ediff nil - "A comprehensive visual interface to diff & patch." - :tag "Ediff" - :group 'tools) - - -(defcustom ediff-use-last-dir nil - "*If t, Ediff will use previous directory as default when reading file name." - :type 'boolean - :group 'ediff) - -;; Last directory used by an Ediff command for file-A. -(defvar ediff-last-dir-A nil) -;; Last directory used by an Ediff command for file-B. -(defvar ediff-last-dir-B nil) -;; Last directory used by an Ediff command for file-C. -(defvar ediff-last-dir-C nil) -;; Last directory used by an Ediff command for the ancestor file. -(defvar ediff-last-dir-ancestor nil) -;; Last directory used by an Ediff command as the output directory for merge. -(defvar ediff-last-merge-autostore-dir nil) - - -;; Used as a startup hook to set `_orig' patch file read-only. -(defun ediff-set-read-only-in-buf-A () - (ediff-with-current-buffer ediff-buffer-A - (toggle-read-only 1))) - -;; Return a plausible default for ediff's first file: -;; In dired, return the file number FILENO (or 0) in the list -;; (all-selected-files, filename under the cursor), where directories are -;; ignored. Otherwise, return DEFAULT file name, if non-nil. Else, -;; if the buffer is visiting a file, return that file name. -(defun ediff-get-default-file-name (&optional default fileno) - (cond ((eq major-mode 'dired-mode) - (let ((current (dired-get-filename nil 'no-error)) - (marked (condition-case nil - (dired-get-marked-files 'no-dir) - (error nil))) - aux-list choices result) - (or (integerp fileno) (setq fileno 0)) - (if (stringp default) - (setq aux-list (cons default aux-list))) - (if (and (stringp current) (not (file-directory-p current))) - (setq aux-list (cons current aux-list))) - (setq choices (nconc marked aux-list)) - (setq result (elt choices fileno)) - (or result - default))) - ((stringp default) default) - ((buffer-file-name (current-buffer)) - (file-name-nondirectory (buffer-file-name (current-buffer)))) - )) - -;;; Compare files/buffers - -;;;###autoload -(defun ediff-files (file-A file-B &optional startup-hooks) - "Run Ediff on a pair of files, FILE-A and FILE-B." - (interactive - (let ((dir-A (if ediff-use-last-dir - ediff-last-dir-A - default-directory)) - dir-B f) - (list (setq f (ediff-read-file-name - "File A to compare" - dir-A - (ediff-get-default-file-name) - 'no-dirs)) - (ediff-read-file-name "File B to compare" - (setq dir-B - (if ediff-use-last-dir - ediff-last-dir-B - (file-name-directory f))) - (progn - (setq file-name-history - (cons (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory f) - dir-B)) - file-name-history)) - (ediff-get-default-file-name f 1))) - ))) - (ediff-files-internal file-A - (if (file-directory-p file-B) - (expand-file-name - (file-name-nondirectory file-A) file-B) - file-B) - nil ; file-C - startup-hooks - 'ediff-files)) - -;;;###autoload -(defun ediff-files3 (file-A file-B file-C &optional startup-hooks) - "Run Ediff on three files, FILE-A, FILE-B, and FILE-C." - (interactive - (let ((dir-A (if ediff-use-last-dir - ediff-last-dir-A - default-directory)) - dir-B dir-C f ff) - (list (setq f (ediff-read-file-name - "File A to compare" - dir-A - (ediff-get-default-file-name) - 'no-dirs)) - (setq ff (ediff-read-file-name "File B to compare" - (setq dir-B - (if ediff-use-last-dir - ediff-last-dir-B - (file-name-directory f))) - (progn - (setq file-name-history - (cons - (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory f) - dir-B)) - file-name-history)) - (ediff-get-default-file-name f 1)))) - (ediff-read-file-name "File C to compare" - (setq dir-C (if ediff-use-last-dir - ediff-last-dir-C - (file-name-directory ff))) - (progn - (setq file-name-history - (cons (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory ff) - dir-C)) - file-name-history)) - (ediff-get-default-file-name ff 2))) - ))) - (ediff-files-internal file-A - (if (file-directory-p file-B) - (expand-file-name - (file-name-nondirectory file-A) file-B) - file-B) - (if (file-directory-p file-C) - (expand-file-name - (file-name-nondirectory file-A) file-C) - file-C) - startup-hooks - 'ediff-files3)) - -;;;###autoload -(defalias 'ediff3 'ediff-files3) - - -;; Visit FILE and arrange its buffer to Ediff's liking. -;; FILE is actually a variable symbol that must contain a true file name. -;; BUFFER-NAME is a variable symbol, which will get the buffer object into -;; which FILE is read. -;; LAST-DIR is the directory variable symbol where FILE's -;; directory name should be returned. HOOKS-VAR is a variable symbol that will -;; be assigned the hook to be executed after `ediff-startup' is finished. -;; `ediff-find-file' arranges that the temp files it might create will be -;; deleted. -(defun ediff-find-file (file-var buffer-name &optional last-dir hooks-var) - (let* ((file (symbol-value file-var)) - (file-magic (ediff-filename-magic-p file)) - (temp-file-name-prefix (file-name-nondirectory file))) - (cond ((not (file-readable-p file)) - (error "File `%s' does not exist or is not readable" file)) - ((file-directory-p file) - (error "File `%s' is a directory" file))) - - ;; some of the commands, below, require full file name - (setq file (expand-file-name file)) - - ;; Record the directory of the file - (if last-dir - (set last-dir (expand-file-name (file-name-directory file)))) - - ;; Setup the buffer - (set buffer-name (find-file-noselect file)) - - (ediff-with-current-buffer (symbol-value buffer-name) - (widen) ; Make sure the entire file is seen - (cond (file-magic ; file has a handler, such as jka-compr-handler or - ;;; ange-ftp-hook-function--arrange for temp file - (ediff-verify-file-buffer 'magic) - (setq file - (ediff-make-temp-file - (current-buffer) temp-file-name-prefix)) - (set hooks-var (cons `(lambda () (delete-file ,file)) - (symbol-value hooks-var)))) - ;; file processed via auto-mode-alist, a la uncompress.el - ((not (equal (file-truename file) - (file-truename (buffer-file-name)))) - (setq file - (ediff-make-temp-file - (current-buffer) temp-file-name-prefix)) - (set hooks-var (cons `(lambda () (delete-file ,file)) - (symbol-value hooks-var)))) - (t ;; plain file---just check that the file matches the buffer - (ediff-verify-file-buffer)))) - (set file-var file))) - -;; MERGE-BUFFER-FILE is the file to be associated with the merge buffer -(defun ediff-files-internal (file-A file-B file-C startup-hooks job-name - &optional merge-buffer-file) - (let (buf-A buf-B buf-C) - (if (string= file-A file-B) - (error "Files A and B are the same")) - (if (stringp file-C) - (or (and (string= file-A file-C) (error "Files A and C are the same")) - (and (string= file-B file-C) (error "Files B and C are the same")))) - (message "Reading file %s ... " file-A) - ;;(sit-for 0) - (ediff-find-file 'file-A 'buf-A 'ediff-last-dir-A 'startup-hooks) - (message "Reading file %s ... " file-B) - ;;(sit-for 0) - (ediff-find-file 'file-B 'buf-B 'ediff-last-dir-B 'startup-hooks) - (if (stringp file-C) - (progn - (message "Reading file %s ... " file-C) - ;;(sit-for 0) - (ediff-find-file - 'file-C 'buf-C - (if (eq job-name 'ediff-merge-files-with-ancestor) - 'ediff-last-dir-ancestor 'ediff-last-dir-C) - 'startup-hooks))) - (ediff-setup buf-A file-A - buf-B file-B - buf-C file-C - startup-hooks - (list (cons 'ediff-job-name job-name)) - merge-buffer-file))) - - -;;;###autoload -(defalias 'ediff 'ediff-files) - -;;;###autoload -(defun ediff-backup (file) - "Run Ediff on FILE and its backup file. -Uses the latest backup, if there are several numerical backups. -If this file is a backup, `ediff' it with its original." - (interactive (list (read-file-name "Ediff (file with backup): "))) - ;; The code is taken from `diff-backup'. - (require 'diff) - (let (bak ori) - (if (backup-file-name-p file) - (setq bak file - ori (file-name-sans-versions file)) - (setq bak (or (diff-latest-backup-file file) - (error "No backup found for %s" file)) - ori file)) - (ediff-files bak ori))) - -;;;###autoload -(defun ediff-buffers (buffer-A buffer-B &optional startup-hooks job-name) - "Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B." - (interactive - (let (bf) - (list (setq bf (read-buffer "Buffer A to compare: " - (ediff-other-buffer "") t)) - (read-buffer "Buffer B to compare: " - (progn - ;; realign buffers so that two visible bufs will be - ;; at the top - (save-window-excursion (other-window 1)) - (ediff-other-buffer bf)) - t)))) - (or job-name (setq job-name 'ediff-buffers)) - (ediff-buffers-internal buffer-A buffer-B nil startup-hooks job-name)) - -;;;###autoload -(defalias 'ebuffers 'ediff-buffers) - - -;;;###autoload -(defun ediff-buffers3 (buffer-A buffer-B buffer-C - &optional startup-hooks job-name) - "Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C." - (interactive - (let (bf bff) - (list (setq bf (read-buffer "Buffer A to compare: " - (ediff-other-buffer "") t)) - (setq bff (read-buffer "Buffer B to compare: " - (progn - ;; realign buffers so that two visible - ;; bufs will be at the top - (save-window-excursion (other-window 1)) - (ediff-other-buffer bf)) - t)) - (read-buffer "Buffer C to compare: " - (progn - ;; realign buffers so that three visible - ;; bufs will be at the top - (save-window-excursion (other-window 1)) - (ediff-other-buffer (list bf bff))) - t) - ))) - (or job-name (setq job-name 'ediff-buffers3)) - (ediff-buffers-internal buffer-A buffer-B buffer-C startup-hooks job-name)) - -;;;###autoload -(defalias 'ebuffers3 'ediff-buffers3) - - - -;; MERGE-BUFFER-FILE is the file to be associated with the merge buffer -(defun ediff-buffers-internal (buf-A buf-B buf-C startup-hooks job-name - &optional merge-buffer-file) - (let* ((buf-A-file-name (buffer-file-name (get-buffer buf-A))) - (buf-B-file-name (buffer-file-name (get-buffer buf-B))) - (buf-C-is-alive (ediff-buffer-live-p buf-C)) - (buf-C-file-name (if buf-C-is-alive - (buffer-file-name (get-buffer buf-B)))) - file-A file-B file-C) - (if (not (ediff-buffer-live-p buf-A)) - (error "Buffer %S doesn't exist" buf-A)) - (if (not (ediff-buffer-live-p buf-B)) - (error "Buffer %S doesn't exist" buf-B)) - (let ((ediff-job-name job-name)) - (if (and ediff-3way-comparison-job - (not buf-C-is-alive)) - (error "Buffer %S doesn't exist" buf-C))) - (if (stringp buf-A-file-name) - (setq buf-A-file-name (file-name-nondirectory buf-A-file-name))) - (if (stringp buf-B-file-name) - (setq buf-B-file-name (file-name-nondirectory buf-B-file-name))) - (if (stringp buf-C-file-name) - (setq buf-C-file-name (file-name-nondirectory buf-C-file-name))) - - (setq file-A (ediff-make-temp-file buf-A buf-A-file-name) - file-B (ediff-make-temp-file buf-B buf-B-file-name)) - (if buf-C-is-alive - (setq file-C (ediff-make-temp-file buf-C buf-C-file-name))) - - (ediff-setup (get-buffer buf-A) file-A - (get-buffer buf-B) file-B - (if buf-C-is-alive (get-buffer buf-C)) - file-C - (cons `(lambda () - (delete-file ,file-A) - (delete-file ,file-B) - (if (stringp ,file-C) (delete-file ,file-C))) - startup-hooks) - (list (cons 'ediff-job-name job-name)) - merge-buffer-file))) - - -;;; Directory and file group operations - -;; Get appropriate default name for directory: -;; If ediff-use-last-dir, use ediff-last-dir-A. -;; In dired mode, use the directory that is under the point (if any); -;; otherwise, use default-directory -(defun ediff-get-default-directory-name () - (cond (ediff-use-last-dir ediff-last-dir-A) - ((eq major-mode 'dired-mode) - (let ((f (dired-get-filename nil 'noerror))) - (if (and (stringp f) (file-directory-p f)) - f - default-directory))) - (t default-directory))) - - -;;;###autoload -(defun ediff-directories (dir1 dir2 regexp) - "Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have -the same name in both. The third argument, REGEXP, is nil or a regular -expression; only file names that match the regexp are considered." - (interactive - (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) - f) - (list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil)) - (ediff-read-file-name "Directory B to compare:" - (if ediff-use-last-dir - ediff-last-dir-B - (ediff-strip-last-dir f)) - nil) - (read-string - (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " - default-regexp) - "Filter through regular expression: ") - nil - 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) - ))) - (ediff-directories-internal - dir1 dir2 nil regexp 'ediff-files 'ediff-directories - )) - -;;;###autoload -(defalias 'edirs 'ediff-directories) - - -;;;###autoload -(defun ediff-directory-revisions (dir1 regexp) - "Run Ediff on a directory, DIR1, comparing its files with their revisions. -The second argument, REGEXP, is a regular expression that filters the file -names. Only the files that are under revision control are taken into account." - (interactive - (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) - ) - (list (ediff-read-file-name - "Directory to compare with revision:" dir-A nil) - (read-string - (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " - default-regexp) - "Filter through regular expression: ") - nil - 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) - ))) - (ediff-directory-revisions-internal - dir1 regexp 'ediff-revision 'ediff-directory-revisions - )) - -;;;###autoload -(defalias 'edir-revisions 'ediff-directory-revisions) - - -;;;###autoload -(defun ediff-directories3 (dir1 dir2 dir3 regexp) - "Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that -have the same name in all three. The last argument, REGEXP, is nil or a -regular expression; only file names that match the regexp are considered." - - (interactive - (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) - f) - (list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil)) - (setq f (ediff-read-file-name "Directory B to compare:" - (if ediff-use-last-dir - ediff-last-dir-B - (ediff-strip-last-dir f)) - nil)) - (ediff-read-file-name "Directory C to compare:" - (if ediff-use-last-dir - ediff-last-dir-C - (ediff-strip-last-dir f)) - nil) - (read-string - (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " - default-regexp) - "Filter through regular expression: ") - nil - 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) - ))) - (ediff-directories-internal - dir1 dir2 dir3 regexp 'ediff-files3 'ediff-directories3 - )) - -;;;###autoload -(defalias 'edirs3 'ediff-directories3) - -;;;###autoload -(defun ediff-merge-directories (dir1 dir2 regexp &optional merge-autostore-dir) - "Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have -the same name in both. The third argument, REGEXP, is nil or a regular -expression; only file names that match the regexp are considered." - (interactive - (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) - f) - (list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil)) - (ediff-read-file-name "Directory B to merge:" - (if ediff-use-last-dir - ediff-last-dir-B - (ediff-strip-last-dir f)) - nil) - (read-string - (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " - default-regexp) - "Filter through regular expression: ") - nil - 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) - ))) - (ediff-directories-internal - dir1 dir2 nil regexp 'ediff-merge-files 'ediff-merge-directories - nil merge-autostore-dir - )) - -;;;###autoload -(defalias 'edirs-merge 'ediff-merge-directories) - -;;;###autoload -(defun ediff-merge-directories-with-ancestor (dir1 dir2 ancestor-dir regexp - &optional - merge-autostore-dir) - "Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors. -Ediff merges files that have identical names in DIR1, DIR2. If a pair of files -in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge -without ancestor. The fourth argument, REGEXP, is nil or a regular expression; -only file names that match the regexp are considered." - (interactive - (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) - f) - (list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil)) - (setq f (ediff-read-file-name "Directory B to merge:" - (if ediff-use-last-dir - ediff-last-dir-B - (ediff-strip-last-dir f)) - nil)) - (ediff-read-file-name "Ancestor directory:" - (if ediff-use-last-dir - ediff-last-dir-C - (ediff-strip-last-dir f)) - nil) - (read-string - (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " - default-regexp) - "Filter through regular expression: ") - nil - 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) - ))) - (ediff-directories-internal - dir1 dir2 ancestor-dir regexp - 'ediff-merge-files-with-ancestor 'ediff-merge-directories-with-ancestor - nil merge-autostore-dir - )) - -;;;###autoload -(defun ediff-merge-directory-revisions (dir1 regexp - &optional merge-autostore-dir) - "Run Ediff on a directory, DIR1, merging its files with their revisions. -The second argument, REGEXP, is a regular expression that filters the file -names. Only the files that are under revision control are taken into account." - (interactive - (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) - ) - (list (ediff-read-file-name - "Directory to merge with revisions:" dir-A nil) - (read-string - (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " - default-regexp) - "Filter through regular expression: ") - nil - 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) - ))) - (ediff-directory-revisions-internal - dir1 regexp 'ediff-merge-revisions 'ediff-merge-directory-revisions - nil merge-autostore-dir - )) - -;;;###autoload -(defalias 'edir-merge-revisions 'ediff-merge-directory-revisions) - -;;;###autoload -(defun ediff-merge-directory-revisions-with-ancestor (dir1 regexp - &optional - merge-autostore-dir) - "Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors. -The second argument, REGEXP, is a regular expression that filters the file -names. Only the files that are under revision control are taken into account." - (interactive - (let ((dir-A (ediff-get-default-directory-name)) - (default-regexp (eval ediff-default-filtering-regexp)) - ) - (list (ediff-read-file-name - "Directory to merge with revisions and ancestors:" dir-A nil) - (read-string - (if (stringp default-regexp) - (format "Filter through regular expression (default %s): " - default-regexp) - "Filter through regular expression: ") - nil - 'ediff-filtering-regexp-history - (eval ediff-default-filtering-regexp)) - ))) - (ediff-directory-revisions-internal - dir1 regexp 'ediff-merge-revisions-with-ancestor - 'ediff-merge-directory-revisions-with-ancestor - nil merge-autostore-dir - )) - -;;;###autoload -(defalias - 'edir-merge-revisions-with-ancestor - 'ediff-merge-directory-revisions-with-ancestor) - -;;;###autoload -(defalias 'edirs-merge-with-ancestor 'ediff-merge-directories-with-ancestor) - -;; Run ediff-action (ediff-files, ediff-merge, ediff-merge-with-ancestors) -;; on a pair of directories (three directories, in case of ancestor). -;; The third argument, REGEXP, is nil or a regular expression; -;; only file names that match the regexp are considered. -;; JOBNAME is the symbol indicating the meta-job to be performed. -;; MERGE-AUTOSTORE-DIR is the directory in which to store merged files. -(defun ediff-directories-internal (dir1 dir2 dir3 regexp action jobname - &optional startup-hooks - merge-autostore-dir) - ;; ediff-read-file-name is set to attach a previously entered file name if - ;; the currently entered file is a directory. This code takes care of that. - (setq dir1 (if (file-directory-p dir1) dir1 (file-name-directory dir1)) - dir2 (if (file-directory-p dir2) dir2 (file-name-directory dir2))) - - (if (stringp dir3) - (setq dir3 (if (file-directory-p dir3) dir3 (file-name-directory dir3)))) - - (cond ((string= dir1 dir2) - (error "Directories A and B are the same: %s" dir1)) - ((and (eq jobname 'ediff-directories3) - (string= dir1 dir3)) - (error "Directories A and C are the same: %s" dir1)) - ((and (eq jobname 'ediff-directories3) - (string= dir2 dir3)) - (error "Directories B and C are the same: %s" dir1))) - - (if merge-autostore-dir - (or (stringp merge-autostore-dir) - (error "%s: Directory for storing merged files must be a string" - jobname))) - (let (;; dir-diff-struct is of the form (common-list diff-list) - ;; It is a structure where ediff-intersect-directories returns - ;; commonalities and differences among directories - dir-diff-struct - meta-buf) - (if (and ediff-autostore-merges - (ediff-merge-metajob jobname) - (not merge-autostore-dir)) - (setq merge-autostore-dir - (read-file-name "Save merged files in directory: " - (if ediff-use-last-dir - ediff-last-merge-autostore-dir - (ediff-strip-last-dir dir1)) - nil - 'must-match))) - ;; verify we are not merging into an orig directory - (if merge-autostore-dir - (cond ((and (stringp dir1) (string= merge-autostore-dir dir1)) - (or (y-or-n-p - "Directory for saving merged files = Directory A. Sure? ") - (error "Directory merge aborted"))) - ((and (stringp dir2) (string= merge-autostore-dir dir2)) - (or (y-or-n-p - "Directory for saving merged files = Directory B. Sure? ") - (error "Directory merge aborted"))) - ((and (stringp dir3) (string= merge-autostore-dir dir3)) - (or (y-or-n-p - "Directory for saving merged files = Ancestor Directory. Sure? ") - (error "Directory merge aborted"))))) - - (setq dir-diff-struct (ediff-intersect-directories - jobname - regexp dir1 dir2 dir3 merge-autostore-dir)) - (setq startup-hooks - ;; this sets various vars in the meta buffer inside - ;; ediff-prepare-meta-buffer - (cons `(lambda () - ;; tell what to do if the user clicks on a session record - (setq ediff-session-action-function (quote ,action)) - ;; set ediff-dir-difference-list - (setq ediff-dir-difference-list - (cdr (quote ,dir-diff-struct)))) - startup-hooks)) - (setq meta-buf (ediff-prepare-meta-buffer - 'ediff-filegroup-action - (car dir-diff-struct) - "*Ediff Session Group Panel" - 'ediff-redraw-directory-group-buffer - jobname - startup-hooks)) - (ediff-show-meta-buffer meta-buf) - )) - -;; MERGE-AUTOSTORE-DIR can be given to tell ediff where to store the merged -;; files -(defun ediff-directory-revisions-internal (dir1 regexp action jobname - &optional startup-hooks - merge-autostore-dir) - (setq dir1 (if (file-directory-p dir1) dir1 (file-name-directory dir1))) - - (if merge-autostore-dir - (or (stringp merge-autostore-dir) - (error "%S: Directory for storing merged files must be a string" - jobname))) - (let (file-list meta-buf) - (if (and ediff-autostore-merges - (ediff-merge-metajob jobname) - (not merge-autostore-dir)) - (setq merge-autostore-dir - (read-file-name "Save merged files in directory: " - (if ediff-use-last-dir - ediff-last-merge-autostore-dir - (ediff-strip-last-dir dir1)) - nil - 'must-match))) - ;; verify merge-autostore-dir != dir1 - (if (and merge-autostore-dir - (stringp dir1) - (string= merge-autostore-dir dir1)) - (or (y-or-n-p - "Directory for saving merged file = directory A. Sure? ") - (error "Merge of directory revisions aborted"))) - - (setq file-list - (ediff-get-directory-files-under-revision - jobname regexp dir1 merge-autostore-dir)) - (setq startup-hooks - ;; this sets various vars in the meta buffer inside - ;; ediff-prepare-meta-buffer - (cons `(lambda () - ;; tell what to do if the user clicks on a session record - (setq ediff-session-action-function (quote ,action))) - startup-hooks)) - (setq meta-buf (ediff-prepare-meta-buffer - 'ediff-filegroup-action - file-list - "*Ediff Session Group Panel" - 'ediff-redraw-directory-group-buffer - jobname - startup-hooks)) - (ediff-show-meta-buffer meta-buf) - )) - - -;;; Compare regions and windows - -;;;###autoload -(defun ediff-windows-wordwise (dumb-mode &optional wind-A wind-B startup-hooks) - "Compare WIND-A and WIND-B, which are selected by clicking, wordwise. -With prefix argument, DUMB-MODE, or on a non-windowing display, works as -follows: -If WIND-A is nil, use selected window. -If WIND-B is nil, use window next to WIND-A." - (interactive "P") - (ediff-windows dumb-mode wind-A wind-B - startup-hooks 'ediff-windows-wordwise 'word-mode)) - -;;;###autoload -(defun ediff-windows-linewise (dumb-mode &optional wind-A wind-B startup-hooks) - "Compare WIND-A and WIND-B, which are selected by clicking, linewise. -With prefix argument, DUMB-MODE, or on a non-windowing display, works as -follows: -If WIND-A is nil, use selected window. -If WIND-B is nil, use window next to WIND-A." - (interactive "P") - (ediff-windows dumb-mode wind-A wind-B - startup-hooks 'ediff-windows-linewise nil)) - -;; Compare WIND-A and WIND-B, which are selected by clicking. -;; With prefix argument, DUMB-MODE, or on a non-windowing display, -;; works as follows: -;; If WIND-A is nil, use selected window. -;; If WIND-B is nil, use window next to WIND-A. -(defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode) - (if (or dumb-mode (not (ediff-window-display-p))) - (setq wind-A (ediff-get-next-window wind-A nil) - wind-B (ediff-get-next-window wind-B wind-A)) - (setq wind-A (ediff-get-window-by-clicking wind-A nil 1) - wind-B (ediff-get-window-by-clicking wind-B wind-A 2))) - - (let ((buffer-A (window-buffer wind-A)) - (buffer-B (window-buffer wind-B)) - beg-A end-A beg-B end-B) - - (save-excursion - (save-window-excursion - (sit-for 0) ; sync before using window-start/end -- a precaution - (select-window wind-A) - (setq beg-A (window-start) - end-A (window-end)) - (select-window wind-B) - (setq beg-B (window-start) - end-B (window-end)))) - (setq buffer-A - (ediff-clone-buffer-for-window-comparison - buffer-A wind-A "-Window.A-") - buffer-B - (ediff-clone-buffer-for-window-comparison - buffer-B wind-B "-Window.B-")) - (ediff-regions-internal - buffer-A beg-A end-A buffer-B beg-B end-B - startup-hooks job-name word-mode nil))) - - -;;;###autoload -(defun ediff-regions-wordwise (buffer-A buffer-B &optional startup-hooks) - "Run Ediff on a pair of regions in specified buffers. -Regions \(i.e., point and mark\) are assumed to be set in advance except -for the second region in the case both regions are from the same buffer. -In such a case the user is asked to interactively establish the second -region. -This function is effective only for relatively small regions, up to 200 -lines. For large regions, use `ediff-regions-linewise'." - (interactive - (let (bf) - (list (setq bf (read-buffer "Region's A buffer: " - (ediff-other-buffer "") t)) - (read-buffer "Region's B buffer: " - (progn - ;; realign buffers so that two visible bufs will be - ;; at the top - (save-window-excursion (other-window 1)) - (ediff-other-buffer bf)) - t)))) - (if (not (ediff-buffer-live-p buffer-A)) - (error "Buffer %S doesn't exist" buffer-A)) - (if (not (ediff-buffer-live-p buffer-B)) - (error "Buffer %S doesn't exist" buffer-B)) - - - (let ((buffer-A - (ediff-clone-buffer-for-region-comparison buffer-A "-Region.A-")) - (buffer-B - (ediff-clone-buffer-for-region-comparison buffer-B "-Region.B-")) - reg-A-beg reg-A-end reg-B-beg reg-B-end) - (save-excursion - (set-buffer buffer-A) - (setq reg-A-beg (region-beginning) - reg-A-end (region-end)) - (set-buffer buffer-B) - (setq reg-B-beg (region-beginning) - reg-B-end (region-end))) - - (ediff-regions-internal - (get-buffer buffer-A) reg-A-beg reg-A-end - (get-buffer buffer-B) reg-B-beg reg-B-end - startup-hooks 'ediff-regions-wordwise 'word-mode nil))) - -;;;###autoload -(defun ediff-regions-linewise (buffer-A buffer-B &optional startup-hooks) - "Run Ediff on a pair of regions in specified buffers. -Regions \(i.e., point and mark\) are assumed to be set in advance except -for the second region in the case both regions are from the same buffer. -In such a case the user is asked to interactively establish the second -region. -Each region is enlarged to contain full lines. -This function is effective for large regions, over 100-200 -lines. For small regions, use `ediff-regions-wordwise'." - (interactive - (let (bf) - (list (setq bf (read-buffer "Region A's buffer: " - (ediff-other-buffer "") t)) - (read-buffer "Region B's buffer: " - (progn - ;; realign buffers so that two visible bufs will be - ;; at the top - (save-window-excursion (other-window 1)) - (ediff-other-buffer bf)) - t)))) - (if (not (ediff-buffer-live-p buffer-A)) - (error "Buffer %S doesn't exist" buffer-A)) - (if (not (ediff-buffer-live-p buffer-B)) - (error "Buffer %S doesn't exist" buffer-B)) - - (let ((buffer-A - (ediff-clone-buffer-for-region-comparison buffer-A "-Region.A-")) - (buffer-B - (ediff-clone-buffer-for-region-comparison buffer-B "-Region.B-")) - reg-A-beg reg-A-end reg-B-beg reg-B-end) - (save-excursion - (set-buffer buffer-A) - (setq reg-A-beg (region-beginning) - reg-A-end (region-end)) - ;; enlarge the region to hold full lines - (goto-char reg-A-beg) - (beginning-of-line) - (setq reg-A-beg (point)) - (goto-char reg-A-end) - (end-of-line) - (or (eobp) (forward-char)) ; include the newline char - (setq reg-A-end (point)) - - (set-buffer buffer-B) - (setq reg-B-beg (region-beginning) - reg-B-end (region-end)) - ;; enlarge the region to hold full lines - (goto-char reg-B-beg) - (beginning-of-line) - (setq reg-B-beg (point)) - (goto-char reg-B-end) - (end-of-line) - (or (eobp) (forward-char)) ; include the newline char - (setq reg-B-end (point)) - ) ; save excursion - - (ediff-regions-internal - (get-buffer buffer-A) reg-A-beg reg-A-end - (get-buffer buffer-B) reg-B-beg reg-B-end - startup-hooks 'ediff-regions-linewise nil nil))) ; no word mode - -;; compare region beg-A to end-A of buffer-A -;; to regions beg-B -- end-B in buffer-B. -(defun ediff-regions-internal (buffer-A beg-A end-A buffer-B beg-B end-B - startup-hooks job-name word-mode - setup-parameters) - (let ((tmp-buffer (get-buffer-create ediff-tmp-buffer)) - overl-A overl-B - file-A file-B) - - ;; in case beg/end-A/B aren't markers--make them into markers - (ediff-with-current-buffer buffer-A - (setq beg-A (move-marker (make-marker) beg-A) - end-A (move-marker (make-marker) end-A))) - (ediff-with-current-buffer buffer-B - (setq beg-B (move-marker (make-marker) beg-B) - end-B (move-marker (make-marker) end-B))) - - ;; make file-A - (if word-mode - (ediff-wordify beg-A end-A buffer-A tmp-buffer) - (ediff-copy-to-buffer beg-A end-A buffer-A tmp-buffer)) - (setq file-A (ediff-make-temp-file tmp-buffer "regA")) - - ;; make file-B - (if word-mode - (ediff-wordify beg-B end-B buffer-B tmp-buffer) - (ediff-copy-to-buffer beg-B end-B buffer-B tmp-buffer)) - (setq file-B (ediff-make-temp-file tmp-buffer "regB")) - - (setq overl-A (ediff-make-bullet-proof-overlay beg-A end-A buffer-A)) - (setq overl-B (ediff-make-bullet-proof-overlay beg-B end-B buffer-B)) - (ediff-setup buffer-A file-A - buffer-B file-B - nil nil ; buffer & file C - (cons `(lambda () - (delete-file ,file-A) - (delete-file ,file-B)) - startup-hooks) - (append - (list (cons 'ediff-word-mode word-mode) - (cons 'ediff-narrow-bounds (list overl-A overl-B)) - (cons 'ediff-job-name job-name)) - setup-parameters)) - )) - - -;;; Merge files and buffers - -;;;###autoload -(defalias 'ediff-merge 'ediff-merge-files) - -(defsubst ediff-merge-on-startup () - (ediff-do-merge 0) - ;; Can't remember why this is here, but it may cause the automatically merged - ;; buffer to be lost. So, keep the buffer modified. - ;;(ediff-with-current-buffer ediff-buffer-C - ;; (set-buffer-modified-p nil)) - ) - -;;;###autoload -(defun ediff-merge-files (file-A file-B - ;; MERGE-BUFFER-FILE is the file to be - ;; associated with the merge buffer - &optional startup-hooks merge-buffer-file) - "Merge two files without ancestor." - (interactive - (let ((dir-A (if ediff-use-last-dir - ediff-last-dir-A - default-directory)) - dir-B f) - (list (setq f (ediff-read-file-name - "File A to merge" - dir-A - (ediff-get-default-file-name) - 'no-dirs)) - (ediff-read-file-name "File B to merge" - (setq dir-B - (if ediff-use-last-dir - ediff-last-dir-B - (file-name-directory f))) - (progn - (setq file-name-history - (cons (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory f) - dir-B)) - file-name-history)) - (ediff-get-default-file-name f 1))) - ))) - (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) - (ediff-files-internal file-A - (if (file-directory-p file-B) - (expand-file-name - (file-name-nondirectory file-A) file-B) - file-B) - nil ; file-C - startup-hooks - 'ediff-merge-files - merge-buffer-file)) - -;;;###autoload -(defun ediff-merge-files-with-ancestor (file-A file-B file-ancestor - &optional - startup-hooks - ;; MERGE-BUFFER-FILE is the file - ;; to be associated with the - ;; merge buffer - merge-buffer-file) - "Merge two files with ancestor." - (interactive - (let ((dir-A (if ediff-use-last-dir - ediff-last-dir-A - default-directory)) - dir-B dir-ancestor f ff) - (list (setq f (ediff-read-file-name - "File A to merge" - dir-A - (ediff-get-default-file-name) - 'no-dirs)) - (setq ff (ediff-read-file-name "File B to merge" - (setq dir-B - (if ediff-use-last-dir - ediff-last-dir-B - (file-name-directory f))) - (progn - (setq file-name-history - (cons - (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory f) - dir-B)) - file-name-history)) - (ediff-get-default-file-name f 1)))) - (ediff-read-file-name "Ancestor file" - (setq dir-ancestor - (if ediff-use-last-dir - ediff-last-dir-ancestor - (file-name-directory ff))) - (progn - (setq file-name-history - (cons (ediff-abbreviate-file-name - (expand-file-name - (file-name-nondirectory ff) - dir-ancestor)) - file-name-history)) - (ediff-get-default-file-name ff 2))) - ))) - (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) - (ediff-files-internal file-A - (if (file-directory-p file-B) - (expand-file-name - (file-name-nondirectory file-A) file-B) - file-B) - file-ancestor - startup-hooks - 'ediff-merge-files-with-ancestor - merge-buffer-file)) - -;;;###autoload -(defalias 'ediff-merge-with-ancestor 'ediff-merge-files-with-ancestor) - -;;;###autoload -(defun ediff-merge-buffers (buffer-A buffer-B - &optional - ;; MERGE-BUFFER-FILE is the file to be - ;; associated with the merge buffer - startup-hooks job-name merge-buffer-file) - "Merge buffers without ancestor." - (interactive - (let (bf) - (list (setq bf (read-buffer "Buffer A to merge: " - (ediff-other-buffer "") t)) - (read-buffer "Buffer B to merge: " - (progn - ;; realign buffers so that two visible bufs will be - ;; at the top - (save-window-excursion (other-window 1)) - (ediff-other-buffer bf)) - t)))) - - (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) - (or job-name (setq job-name 'ediff-merge-buffers)) - (ediff-buffers-internal - buffer-A buffer-B nil startup-hooks job-name merge-buffer-file)) - -;;;###autoload -(defun ediff-merge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor - &optional - startup-hooks - job-name - ;; MERGE-BUFFER-FILE is the - ;; file to be associated - ;; with the merge buffer - merge-buffer-file) - "Merge buffers with ancestor." - (interactive - (let (bf bff) - (list (setq bf (read-buffer "Buffer A to merge: " - (ediff-other-buffer "") t)) - (setq bff (read-buffer "Buffer B to merge: " - (progn - ;; realign buffers so that two visible - ;; bufs will be at the top - (save-window-excursion (other-window 1)) - (ediff-other-buffer bf)) - t)) - (read-buffer "Ancestor buffer: " - (progn - ;; realign buffers so that three visible - ;; bufs will be at the top - (save-window-excursion (other-window 1)) - (ediff-other-buffer (list bf bff))) - t) - ))) - - (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks)) - (or job-name (setq job-name 'ediff-merge-buffers-with-ancestor)) - (ediff-buffers-internal - buffer-A buffer-B buffer-ancestor startup-hooks job-name merge-buffer-file)) - - -;;;###autoload -(defun ediff-merge-revisions (&optional file startup-hooks merge-buffer-file) - ;; MERGE-BUFFER-FILE is the file to be associated with the merge buffer - "Run Ediff by merging two revisions of a file. -The file is the optional FILE argument or the file visited by the current -buffer." - (interactive) - (if (stringp file) (find-file file)) - (let (rev1 rev2) - (setq rev1 - (read-string - (format - "Version 1 to merge (default %s's working version): " - (if (stringp file) - (file-name-nondirectory file) "current buffer"))) - rev2 - (read-string - (format - "Version 2 to merge (default %s): " - (if (stringp file) - (file-name-nondirectory file) "current buffer")))) - (ediff-load-version-control) - ;; ancestor-revision=nil - (funcall - (intern (format "ediff-%S-merge-internal" ediff-version-control-package)) - rev1 rev2 nil startup-hooks merge-buffer-file))) - - -;;;###autoload -(defun ediff-merge-revisions-with-ancestor (&optional - file startup-hooks - ;; MERGE-BUFFER-FILE is the file to - ;; be associated with the merge - ;; buffer - merge-buffer-file) - "Run Ediff by merging two revisions of a file with a common ancestor. -The file is the optional FILE argument or the file visited by the current -buffer." - (interactive) - (if (stringp file) (find-file file)) - (let (rev1 rev2 ancestor-rev) - (setq rev1 - (read-string - (format - "Version 1 to merge (default %s's working version): " - (if (stringp file) - (file-name-nondirectory file) "current buffer"))) - rev2 - (read-string - (format - "Version 2 to merge (default %s): " - (if (stringp file) - (file-name-nondirectory file) "current buffer"))) - ancestor-rev - (read-string - (format - "Ancestor version (default %s's base revision): " - (if (stringp file) - (file-name-nondirectory file) "current buffer")))) - (ediff-load-version-control) - (funcall - (intern (format "ediff-%S-merge-internal" ediff-version-control-package)) - rev1 rev2 ancestor-rev startup-hooks merge-buffer-file))) - -;; MK: Check. This function doesn't seem to be used any more by pcvs or pcl-cvs -;;;###autoload -(defun run-ediff-from-cvs-buffer (pos) - "Run Ediff-merge on appropriate revisions of the selected file. -First run after `M-x cvs-update'. Then place the cursor on a line describing a -file and then run `run-ediff-from-cvs-buffer'." - (interactive "d") - (ediff-load-version-control) - (let ((tin (tin-locate cvs-cookie-handle pos))) - (if tin - (cvs-run-ediff-on-file-descriptor tin) - (error "There is no file to merge")))) - - -;;; Apply patch - -;;;###autoload -(defun ediff-patch-file (&optional arg patch-buf) - "Run Ediff by patching SOURCE-FILENAME. -If optional PATCH-BUF is given, use the patch in that buffer -and don't ask the user. -If prefix argument, then: if even argument, assume that the patch is in a -buffer. If odd -- assume it is in a file." - (interactive "P") - (let (source-dir source-file) - (require 'ediff-ptch) - (setq patch-buf - (ediff-get-patch-buffer - (if arg (prefix-numeric-value arg)) patch-buf)) - (setq source-dir (cond (ediff-use-last-dir ediff-last-dir-patch) - ((and (not ediff-patch-default-directory) - (buffer-file-name patch-buf)) - (file-name-directory - (expand-file-name - (buffer-file-name patch-buf)))) - (t default-directory))) - (setq source-file - (read-file-name - "File to patch (directory, if multifile patch): " - ;; use an explicit initial file - source-dir nil nil (ediff-get-default-file-name))) - (ediff-dispatch-file-patching-job patch-buf source-file))) - -;;;###autoload -(defun ediff-patch-buffer (&optional arg patch-buf) - "Run Ediff by patching the buffer specified at prompt. -Without the optional prefix ARG, asks if the patch is in some buffer and -prompts for the buffer or a file, depending on the answer. -With ARG=1, assumes the patch is in a file and prompts for the file. -With ARG=2, assumes the patch is in a buffer and prompts for the buffer. -PATCH-BUF is an optional argument, which specifies the buffer that contains the -patch. If not given, the user is prompted according to the prefix argument." - (interactive "P") - (require 'ediff-ptch) - (setq patch-buf - (ediff-get-patch-buffer - (if arg (prefix-numeric-value arg)) patch-buf)) - (ediff-patch-buffer-internal - patch-buf - (read-buffer - "Which buffer to patch? " - (ediff-other-buffer patch-buf)))) - - -;;;###autoload -(defalias 'epatch 'ediff-patch-file) -;;;###autoload -(defalias 'epatch-buffer 'ediff-patch-buffer) - - - - -;;; Versions Control functions - -;;;###autoload -(defun ediff-revision (&optional file startup-hooks) - "Run Ediff by comparing versions of a file. -The file is an optional FILE argument or the file entered at the prompt. -Default: the file visited by the current buffer. -Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'." - ;; if buffer is non-nil, use that buffer instead of the current buffer - (interactive "P") - (if (not (stringp file)) - (setq file - (ediff-read-file-name "Compare revisions for file" - (if ediff-use-last-dir - ediff-last-dir-A - default-directory) - (ediff-get-default-file-name) - 'no-dirs))) - (find-file file) - (if (and (buffer-modified-p) - (y-or-n-p (message "Buffer %s is modified. Save buffer? " - (buffer-name)))) - (save-buffer (current-buffer))) - (let (rev1 rev2) - (setq rev1 - (read-string - (format "Revision 1 to compare (default %s's latest revision): " - (file-name-nondirectory file))) - rev2 - (read-string - (format "Revision 2 to compare (default %s's current state): " - (file-name-nondirectory file)))) - (ediff-load-version-control) - (funcall - (intern (format "ediff-%S-internal" ediff-version-control-package)) - rev1 rev2 startup-hooks) - )) - - -;;;###autoload -(defalias 'erevision 'ediff-revision) - - -;; Test if version control package is loaded and load if not -;; Is SILENT is non-nil, don't report error if package is not found. -(defun ediff-load-version-control (&optional silent) - (require 'ediff-vers) - (or (featurep ediff-version-control-package) - (if (locate-library (symbol-name ediff-version-control-package)) - (progn - (message "") ; kill the message from `locate-library' - (require ediff-version-control-package)) - (or silent - (error "Version control package %S.el not found. Use vc.el instead" - ediff-version-control-package))))) - - -;;;###autoload -(defun ediff-version () - "Return string describing the version of Ediff. -When called interactively, displays the version." - (interactive) - (if (interactive-p) - (message (ediff-version)) - (format "Ediff %s of %s" ediff-version ediff-date))) - - -;;;###autoload -(defun ediff-documentation (&optional node) - "Display Ediff's manual. -With optional NODE, goes to that node." - (interactive) - (let ((ctl-window ediff-control-window) - (ctl-buf ediff-control-buffer)) - - (ediff-skip-unsuitable-frames) - (condition-case nil - (progn - (pop-to-buffer (get-buffer-create "*info*")) - (info (if ediff-xemacs-p "ediff.info" "ediff")) - (if node - (Info-goto-node node) - (message "Type `i' to search for a specific topic")) - (raise-frame (selected-frame))) - (error (beep 1) - (with-output-to-temp-buffer ediff-msg-buffer - (ediff-with-current-buffer standard-output - (fundamental-mode)) - (princ ediff-BAD-INFO)) - (if (window-live-p ctl-window) - (progn - (select-window ctl-window) - (set-window-buffer ctl-window ctl-buf))))))) - - -(dolist (mess '("^Errors in diff output. Diff output is in " - "^Hmm... I don't see an Ediff command around here...$" - "^Undocumented command! Type `G' in Ediff Control Panel to drop a note to the Ediff maintainer$" - ": This command runs in Ediff Control Buffer only!$" - ": Invalid op in ediff-check-version$" - "^ediff-shrink-window-C can be used only for merging jobs$" - "^Lost difference info on these directories$" - "^This command is inapplicable in the present context$" - "^This session group has no parent$" - "^Can't hide active session, $" - "^Ediff: something wrong--no multiple diffs buffer$" - "^Can't make context diff for Session $" - "^The patch buffer wasn't found$" - "^Aborted$" - "^This Ediff session is not part of a session group$" - "^No active Ediff sessions or corrupted session registry$" - "^No session info in this line$" - "^`.*' is not an ordinary file$" - "^Patch appears to have failed$" - "^Recomputation of differences cancelled$" - "^No fine differences in this mode$" - "^Lost connection to ancestor buffer...sorry$" - "^Not merging with ancestor$" - "^Don't know how to toggle read-only in buffer " - "Emacs is not running as a window application$" - "^This command makes sense only when merging with an ancestor$" - "^At end of the difference list$" - "^At beginning of the difference list$" - "^Nothing saved for diff .* in buffer " - "^Buffer is out of sync for file " - "^Buffer out of sync for file " - "^Output from `diff' not found$" - "^You forgot to specify a region in buffer " - "^All right. Make up your mind and come back...$" - "^Current buffer is not visiting any file$" - "^Failed to retrieve revision: $" - "^Can't determine display width.$" - "^File `.*' does not exist or is not readable$" - "^File `.*' is a directory$" - "^Buffer .* doesn't exist$" - "^Directories . and . are the same: " - "^Directory merge aborted$" - "^Merge of directory revisions aborted$" - "^Buffer .* doesn't exist$" - "^There is no file to merge$" - "^Version control package .*.el not found. Use vc.el instead$")) - (add-to-list 'debug-ignored-errors mess)) - - -(require 'ediff-util) - -(run-hooks 'ediff-load-hook) - -(provide 'ediff) - - -;;; Local Variables: -;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) -;;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1) -;;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body)) -;;; End: - -;;; arch-tag: 97c71396-db02-4f41-8b48-6a51c3348fcc -;;; ediff.el ends here diff --git a/xemacs-packages/lisp/edit-utils/ChangeLog b/xemacs-packages/lisp/edit-utils/ChangeLog deleted file mode 100644 index f1d9460d..00000000 --- a/xemacs-packages/lisp/edit-utils/ChangeLog +++ /dev/null @@ -1,1756 +0,0 @@ -2006-03-07 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.34 released. - -2006-03-07 Nelson Ferreira - - * fast-lock.el (fast-lock-after-fontify-buffer): Check existence - of fast-lock cache file before trying to access it. - -2006-02-22 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.33 released. - -2006-02-21 Adrian Aichner - - * dabbrev.el (dabbrev--extent-clicked-on): Supply required fourth - argument to `dabbrev--substitute-expansion'. - -2005-12-05 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.32 released. - -2005-11-28 Zajcev Evgeny - - * power-macros.el: Use (featurep 'xemacs) instead of (boundp - 'xemacs-logo). - -2005-11-25 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.31 released. - -2005-11-21 Adrian Aichner - - * Makefile (ELCS): Add crm.elc. - -2005-11-21 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.30 released. - -2005-11-20 Adrian Aichner - - * crm.el: New file. This corresponds to revision 1.5 of GNU Emacs - CVS, plus update of FSF address, as provided in Message-ID: - by Reiner Steib. - -2005-11-14 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.29 released. - - * savehist.el: Sync with upstream version 23. - - * Makefile (VERSION): XEmacs package 2.28 released. - -2005-11-02 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.27 released. - - * savehist.el: Sync with upstream version 22. - -2005-10-16 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.26 released. - -2005-05-02 David A. Panariti - - * saveconf.el (recover-context): - Fixed bug when attempting to restore a file that no longer - exists. In this case, the restore loop deletes the buffer but - does not read the following file offset. This puts the restore - loop out of alignment with the data in the restore file, which - causes the loop to terminate possibly leaving some context - unprocessed. - -2005-08-31 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.25 released. - -2005-08-25 Zajcev Evgeny - - * paren.el (paren-mode): [add] New mode 'sexp-around added. - * paren.el (paren-highlight): [add] Support for 'sexp-around mode - * paren.el (paren-set-mode): Ditto. - -2005-05-14 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.24 released. - -2005-04-27 Stephen J. Turnbull - - * balloon-help.el (balloon-help-gutter-possible): - (balloon-help-make-help-frame): - Whack gutters, too. - (balloon-help-make-junk-frame): - (balloon-help-make-help-frame): - Use override-redirect to suppress WM decorations. - (balloon-help-make-help-frame): Convert alist to plist. - -2005-05-07 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.23 released. - -2005-05-05 Aidan Kehoe - - * lazy-lock.el (lazy-lock-mode): lazy-lock-mode should _not_ have - a non-nil global default; it should only be t in those buffers for - which fontification is active. - -2005-02-10 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.22 released. - -2005-02-09 Aidan Kehoe - - * man.el: Bind manual-entry to C-h C-m by default. - -2005-02-03 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.21 released. - -2005-01-31 Ben Wing - - * lazy-shot.el (lazy-shot-install-extent): - Use plain set-extent-property as - set-extent-initial-redisplay-function is going away. - -2005-01-31 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.20 released. - -2005-01-29 Ville Skyttä - - * edit-utils.texi: Spelling fixes, add document title. - -2004-12-22 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.19 released. - -2004-12-22 Peter Thiemann - - * func-menu.el (fume-function-name-regexp-javascript): Enhance the - regexp, don't register functions in comment sections. - -2004-11-09 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.18 released. - -2004-11-08 Ben Wing - - * dabbrev.el (dabbrev-case-replace): - We don't really need to set this to nil by default; the setting - of dabbrev-case-fold-search is enough. - -2004-11-08 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.17 released. - -2004-11-07 Ben Wing - - * dabbrev.el: - * dabbrev.el (dabbrev--eliminate-newlines): New. - * dabbrev.el (dabbrev-upcase-means-case-search): - * dabbrev.el (dabbrev-case-distinction): New. - * dabbrev.el (dabbrev-case-replace): - * dabbrev.el (dabbrev-check-all-buffers): - * dabbrev.el (dabbrev-ignored-buffer-names): - * dabbrev.el (dabbrev-ignored-buffer-regexps): New. - * dabbrev.el (dabbrev-select-buffers-function): - * dabbrev.el (dabbrev-filter-elements): - * dabbrev.el (dabbrev-completion): - * dabbrev.el (dabbrev-expand): - * dabbrev.el (dabbrev--goto-start-of-abbrev): - * dabbrev.el (dabbrev--select-buffers): - * dabbrev.el (dabbrev--try-find): - * dabbrev.el (dabbrev--find-all-expansions): - * dabbrev.el (dabbrev--scanning-message): - * dabbrev.el (dabbrev--ignore-buffer-p): New. - * dabbrev.el (dabbrev--find-expansion): - * dabbrev.el (dabbrev--substitute-expansion): - * dabbrev.el (dabbrev--make-friend-buffer-list): New. - * dabbrev.el (dabbrev--search): - Synch to 21.3. - - * lazy-lock.el (lazy-lock-install-timers): - Use delete-itimer not cancel-timer. - - * recent-files.el: - * recent-files.el (recent-files-non-permanent-submenu): - Default recent-files-non-permanent-submenu to nil, as it should - be. - -2004-10-01 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.16 released. - -2004-09-29 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.15 released. - -2004-09-23 Zajcev Evgeny - - * func-menu.el (fume-mode): [fix] typo. - -2004-06-18 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.14 released. - -2004-03-31 Stephen J. Turnbull - - * completion.el (symbol-under-point): - (symbol-before-point): - (symbol-under-or-before-point): - (symbol-before-point-for-complete): - (next-cdabbrev): - (add-completions-from-c-buffer): - Don't let syntax-table properties override completion's table. - -2004-06-17 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.13 released. - -2004-06-16 Tom Howland - - * desktop.el (desktop-create-buffer): Don't try to - use expand-file-name on nil. - -2003-09-25 Stephen J. Turnbull - - * desktop.el (desktop-partially-loaded-p): New variable. - (desktop-save): Check it before overwriting. - (desktop-read): Set, then clear it, in case error is thrown. - -2004-04-25 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.12 released. - -2004-04-25 Jeff Mincy - - * man.el (manual-entry): Document '-k' option. Accept fewer - characters of output in apropos-mode. - (Manual-nuke-nroff-bs): Handle rman correctly. - -2004-04-24 Adrian Aichner - - * align.el: Sync align.el with current GNU Emacs CVS to fix bug in - align-region. - * align.el (align-rules-list): Typo fix. - * align.el (align-exclude-rules-list): Ditto. - * align.el (align-region): Bug fix. - -2004-01-05 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.11 released. - - * winring.el: Sync with upstream version 3.11. - -2003-10-31 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.10 released. - -2003-10-20 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.09 released. - -2003-10-20 Jake Colman - - * Makefile (ELCS): new library highline.el - * edit-utils.texi: - * edit-utils.texi (Top): - * edit-utils.texi (paren): - * edit-utils.texi (shell-font): - * edit-utils.texi (highline): - * edit-utils.texi (highline-keys): - * edit-utils.texi (highline-hooks): - * edit-utils.texi (highline-options): - * package-info.in: - -2003-10-17 Andrew W. Nosenko - - * func-menu.el: Add autoconf mode support. - (fume-function-name-regexp-autoconf): New variable. - (fume-function-name-regexp-alist): Use it. - -2003-10-16 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.08 released. - -2003-10-15 Jake Colman - - * Makefile (ELCS): new library narrow-stack.el - * edit-utils.texi (Top): - * edit-utils.texi (Align Usage): - * edit-utils.texi (allout): - * edit-utils.texi (narrow-stack): documentation for new library - -2003-08-28 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.07 released. - -2003-08-28 Jake Colman - - * edit-utils.texi: Replaced references to '.emacs file' with the - more generic 'initialization file'. - -2003-08-27 Jake Colman - - * edit-utils.texi: Reorganized and rearranged the menu - -2003-08-27 Jake Colman - - * edit-utils.texi: New section "Undocumented" containing only the - undocumented libraries. Used the .el filename as the node name - since that will make it easier to determine which file provides - which functionality. Provided documentation for a few more - undocumented nodes. - -2003-08-26 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.06 released. - -2003-08-20 René Kyllingstad - - * func-menu.el (fume-python-fully-qualified-names): New. - * func-menu.el (fume-find-next-python-function-name): - use fume-python-fully-qualified-names - -2003-08-14 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.05 released. - -2003-08-14 Jake Colman - - * edit-utils.texi (Top): Completed the documentation of most of - the menu items. - * edit-utils.texi (Navigating the Window Ring): - * edit-utils.texi (Where Was I): - * edit-utils.texi (Abbreviation List): - * edit-utils.texi (id-select): - * edit-utils.texi (makesum): - * edit-utils.texi (man): - * edit-utils.texi (outl-mouse): - * edit-utils.texi (page-ext): - * edit-utils.texi (page-ext-keys): - * edit-utils.texi (page-ext-using): - * edit-utils.texi (page-ext-addr): - * edit-utils.texi (Specifically): New. - * edit-utils.texi (Redo): - * edit-utils.texi (Scrolling In Place): - * edit-utils.texi (sip-features): - * edit-utils.texi (sip-commands): - * edit-utils.texi (sip-install): - * edit-utils.texi (sip-customize): - * edit-utils.texi (Line Numbering): - * edit-utils.texi (Vertical Mode): - * edit-utils.texi (Getting the Mouse Out of the Way): - * edit-utils.texi (Blinking Cursor): - * edit-utils.texi (Speeding Up Fontlock): - * edit-utils.texi (Lazy Fontlocking): - * edit-utils.texi (Another Lazy Fontlocker): - * edit-utils.texi (mic-paren): - * edit-utils.texi (paren): - * edit-utils.texi (shell-font): - * edit-utils.texi (Hooks Invoked After Saving): - * edit-utils.texi (Indivisible Blocks of Text): - * edit-utils.texi (Table and Array Editor): - * edit-utils.texi (Big Menubar): - * edit-utils.texi (Floating Toolbar): - -2003-08-13 Stephen J. Turnbull - - * edit-utils.texi: Add Jake's copyright notice, change license. - (Copying): New node, explains the doclicense problem. - (XEmacs License): Change name from `Copying'. - (Top): - (Comparing Windows): - (The Toolbar Utilities): - Fixup references to `Copying' and `XEmacs License'. - - (Completion): Shut up makeinfo. - -2003-08-11 Jake Colman - - * edit-utils.texi (Top): Documentation for the following sections: - 'File Management', 'Session Management' and 'Abbreviations'. - * edit-utils.texi (Detached Minibuffers): - * edit-utils.texi (Convenient Buffer Switching): - * edit-utils.texi (iswitchb-cust): - * edit-utils.texi (iswitchb-my-keys): Removed. - * edit-utils.texi (Changing the Display): - * edit-utils.texi (Permanent Buffers): - * edit-utils.texi (Self-Resizing Minibuffer): - * edit-utils.texi (Searching Many Buffers): - * edit-utils.texi (Meaningful Unique Names): - * edit-utils.texi (Navigating the Window Ring): - * edit-utils.texi (Auto-Revert Usage): - * edit-utils.texi (Backup Directory): - * edit-utils.texi (Bookmark): - * edit-utils.texi (Desktop): - * edit-utils.texi (Recent File Navigation): - * edit-utils.texi (recentf-cust): - * edit-utils.texi (Example): New. - * edit-utils.texi (Save Configuration): - * edit-utils.texi (Save History): - * edit-utils.texi (Save Places): - * edit-utils.texi (Where Was I): - * edit-utils.texi (Completion): - * edit-utils.texi (Dynamic Abbreviations): - * edit-utils.texi (Hippie Expand): - * edit-utils.texi (Interactive Completion): - * edit-utils.texi (Template Insertion): - * edit-utils.texi (Power Macros): - * edit-utils.texi (Align): - * edit-utils.texi (Align Usage): - * edit-utils.texi (Allout): - * edit-utils.texi (The Toolbar Editor): - * edit-utils.texi (Toolbar Portability): - -2003-08-08 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.04 released. - -2003-08-07 Jake Colman - - * edit-utils.texi (Top): Documentation for the 'Buffer and Window - Management' packages. - * edit-utils.texi (Comparing Windows): - * edit-utils.texi (Detached Minibuffers): - * edit-utils.texi (Convenient Buffer Switching): - * edit-utils.texi (Customization): - * edit-utils.texi (iswitchb-my-keys): New. - * edit-utils.texi (Changing the Display): - * edit-utils.texi (Regexp Matching): - * edit-utils.texi (Replacement for read-buffer): - * edit-utils.texi (Permanent Buffers): - * edit-utils.texi (Self-Resizing Minibuffer): - * edit-utils.texi (Searching Many Buffers): - * edit-utils.texi (Meaningful Unique Names): - * edit-utils.texi (Navigating the Window Ring): - * edit-utils.texi (History): - * edit-utils.texi (Related Packages): - * edit-utils.texi (Reverting Buffers): - * edit-utils.texi (Auto-Revert Usage): - * edit-utils.texi (Power Macros): - * edit-utils.texi (Align Usage): - * edit-utils.texi (Allout): - -2003-08-06 Jake Colman - - * Makefile (ELCS): New package allout - * edit-utils.texi (Top): documentation for allout - * edit-utils.texi (Vertical Mode): - * edit-utils.texi (Align): - * edit-utils.texi (Align Usage): - * edit-utils.texi (Allout): - * package-info.in: New package allout - -2003-08-06 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.03 released. - -2003-08-06 Jake Colman - - * edit-utils.texi (Top): Added documentation for align, - autorevert, and power-macros. - * edit-utils.texi (Meaningful Unique Names): - * edit-utils.texi (Navigating the Window Ring): - * edit-utils.texi (Reverting Buffers): - * edit-utils.texi (Auto-Revert Usage): - * edit-utils.texi (Power Macros): - * edit-utils.texi (Line Numbering): - * edit-utils.texi (Vertical Mode): - * edit-utils.texi (Align): - * edit-utils.texi (Align Usage): - -2003-08-01 Jake Colman - - * Makefile (ELCS): Added two libraries: autorevert and align - * package-info.in: update provides - * autorevert.el: new - * align.el: new - - -2003-06-20 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.02 released. - -2003-06-16 Nickolay Pakoulin - - * recent-files.el (recent-files-visit-file): New function. - A command to find a file from `recent-files-list' - -2003-06-01 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.01 released. - -2003-05-31 Adrian Aichner - - * func-menu.el (fume-function-name-regexp-lisp): Make regexp more - correct. - -2003-03-21 Ben Wing - - * .cvsignore: Add entries for tempo*.html, edit-utils*.html. - -2003-03-09 Ben Wing - - * Makefile: - Delete explicit compile:: and binkit: rules. - Don't add custom-load.elc to the list of generated elc's. - Use EXPLICIT_DOCS instead of explicitly giving the targets - and dependencies. - -2003-03-02 Norbert Koch - - * Makefile (VERSION): XEmacs package 2.00 released. - - * Makefile (VERSION): XEmacs package 1.99 released. - -2003-02-17 Ben Wing - - * lazy-lock.el: - * lazy-lock.el (lazy-lock-cache-start): Removed. - * lazy-lock.el (lazy-lock-cache-end): Removed. - * lazy-lock.el (lazy-lock-window-start-cache): New. - * lazy-lock.el (lazy-lock-window-end-cache): New. - * lazy-lock.el (lazy-lock-window-buffer-cache): New. - * lazy-lock.el (lazy-lock-window-buffer-modiff-cache): New. - * lazy-lock.el (lazy-lock-frame-modiff-cache): New. - * lazy-lock.el (lazy-lock-text-props-changed-cache): New. - * lazy-lock.el (lazy-lock-mode): New. - * lazy-lock.el (lazy-lock-buffers): New. - * lazy-lock.el (lazy-lock-timers): New. - * lazy-lock.el (lazy-lock-first-unfontify-pos): New. - * lazy-lock.el (lazy-lock-minimum-size): - * lazy-lock.el (lazy-lock-walk-windows): Removed. - * lazy-lock.el (lazy-lock-defer-on-the-fly): New. - * lazy-lock.el (NOTE): New. - * lazy-lock.el (lazy-lock-defer-contextually): New. - * lazy-lock.el (lazy-lock-defer-time): New. - * lazy-lock.el (lazy-lock-stealth-time): - * lazy-lock.el (lazy-lock-stealth-nice): - * lazy-lock.el (lazy-lock-stealth-verbose): - * lazy-lock.el (lazy-lock-ignore-commands): Removed. - * lazy-lock.el (lazy-lock-mode-line-string): - * lazy-lock.el (lazy-lock-hide-invisible): Removed. - * lazy-lock.el (lazy-lock-invisible-foreground): Removed. - * lazy-lock.el (turn-on-lazy-lock): - * lazy-lock.el (lazy-lock-value-in-major-mode): New. - * lazy-lock.el (lazy-lock-install): New. - * lazy-lock.el (lazy-lock-fixup-hooks): Removed. - * lazy-lock.el (lazy-lock-install-hooks): New. - * lazy-lock.el (lazy-lock-install-timers): New. - * lazy-lock.el (lazy-lock-unstall): New. - * lazy-lock.el (lazy-lock-pre-idle-fontify-windows): - * lazy-lock.el (lazy-lock-maybe-fontify-frame): - * lazy-lock.el (lazy-lock-fontify-region): Removed. - * lazy-lock.el (lazy-lock-after-fontify-buffer): Removed. - * lazy-lock.el (lazy-lock-after-change-function): Removed. - * lazy-lock.el (lazy-lock-after-change): New. - * lazy-lock.el (lazy-lock-timeout-id): Removed. - * lazy-lock.el (lazy-lock-post-command-fontify-stealthily): Removed. - * lazy-lock.el (lazy-lock-post-setup-emacs-fontify-windows): Removed. - * lazy-lock.el (lazy-lock-post-setup-ediff-control-frame): Removed. - * lazy-lock.el (lazy-lock-fontify-after-defer): New. - * lazy-lock.el (lazy-lock-fontify-after-idle): New. - * lazy-lock.el (lazy-lock-after-unfontify-buffer): New. - * lazy-lock.el (lazy-lock-maybe-fontify-window): Removed. - * lazy-lock.el (lazy-lock-fontify-stealthily): Removed. - * lazy-lock.el (lazy-lock-fontify-walk-stealthily): Removed. - * lazy-lock.el (lazy-lock-unfontified-p): - * lazy-lock.el (lazy-lock-percent-fontified): - * lazy-lock.el (font-lock-after-fontify-buffer-hook): - * lazy-lock.el (font-lock-after-unfontify-buffer-hook): - * lazy-lock.el (lazy-lock-fontify-chunk): New. - * lazy-lock.el (lazy-lock-vertical-motion-value): New. - * lazy-lock.el (lazy-lock-colour-invisible): Removed. - - Major overhaul. This version should be faster than the old one, - and in addition has the major new feature of "deferred correct - fontification", as described below. Sync up most stuff to the - latest lazy-lock in FSF 21.2. Integrate some stuff from jit-lock, - because our model is closer to jit-lock's than to FSF/lazy-lock's. - Speed it up in various ways, e.g. by removing the hack that binds - font-lock-beginning-of-syntax-function to nil, thereby insuring - horrible behavior at the end of a file. Use GUARANTEE argument to - window-end to ensure we get an accurate idea of what's on the - screen, and therefore we know with confidence whether the screen - is going to be scrolled by redisplay, and can much better optimize - our checks to see whether we need to do anything. The biggest - user-level difference has to do with lazy-lock-defer-contextually, - which, if non-nil, implements a system whereby after a change - lazy-lock will update everything from the change point to the - bottom of the screen (and further, once you display the areas - farther down), after an idle-delay of (currently) 0.25 seconds. - Insert a comment-begin (/*) in C, for example, and you'll see - *all* the text afterwards, down to the bottom of the screen, - become colored like a comment unless a comment-end intervenes. - -2003-01-13 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.98 released. - -2003-01-06 Ville Skyttä - - * tempo.el: Doc updates, sync with GNU Emacs. - (tempo-insert-template): Check for `mark-active' and - `deactivate-mark' before using them. - * tempo.texi: New. - * Makefile: Handle tempo.texi. - -2003-01-03 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.97 released. - -2002-12-17 Jerry James - - * Makefile (REQUIRES): Add xemacs-devel so that profile autoloads. - -2002-12-06 Ville Skyttä - - * func-menu.el (fume-perl-fully-qualified-names): New. - (fume-find-next-perl-function-name): Fix names for fully - qualified functions, optionally return the fully qualified name. - Original patch by Remco Wouts . - -2002-12-04 Stephen J. Turnbull - - * toolbar-utils.el (toolbar-update-toolbar): New function. - -2002-12-03 Stephen J. Turnbull - - * toolbar-utils.el (toolbar-find-button): - (toolbar-find-item): - (toolbar-find-button-by-icon): - (toolbar-find-button-by-command): - (toolbar-find-button-by-help-string): - (toolbar-find-button-by-element): - (toolbar-add-kbd-macro): - (toolbar-execute-last-kbd-macro): - New functions. - (button-palette): New variable. - (toolbar-add-button): Rename to toolbar-add-item. - (toolbar-add-item): Renamed from toolbar-add-button. - (toolbar-kill-item-pos): Improve specifier handling. Use - button-palette. - -2002-11-23 Stephen J. Turnbull - - * toolbar-utils.el: Cosmetic changes for jwz. - -2002-11-22 Stephen J. Turnbull - - * toolbar-utils.el: More accurate keywords. - (edit-toolbar): New Customize group. - (toolbar-button-default-position): New user variable. - (toolbar-new-button): New function. - (toolbar-new-spacer): New function. - (make-toolbar-instantiator): New function. - (toolbar-add-button): New function. - (toolbar-add-button-on-the-fly): New function. - -2002-11-29 Ben Wing - - * .cvsignore: Remove files now handled automatically by CVS. - * Makefile: Use `compile' instead of hard-coded `all'. - -2002-12-06 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.96 released. - -2002-12-04 Stephen J. Turnbull - - * toolbar-utils.el (toolbar-update-toolbar): New function. - -2002-12-03 Stephen J. Turnbull - - * toolbar-utils.el (toolbar-find-button): - (toolbar-find-item): - (toolbar-find-button-by-icon): - (toolbar-find-button-by-command): - (toolbar-find-button-by-help-string): - (toolbar-find-button-by-element): - (toolbar-add-kbd-macro): - (toolbar-execute-last-kbd-macro): - New functions. - (button-palette): New variable. - (toolbar-add-button): Rename to toolbar-add-item. - (toolbar-add-item): Renamed from toolbar-add-button. - (toolbar-kill-item-pos): Improve specifier handling. Use - button-palette. - -2002-11-23 Stephen J. Turnbull - - * toolbar-utils.el: Cosmetic changes for jwz. - -2002-11-22 Stephen J. Turnbull - - * toolbar-utils.el: More accurate keywords. - (edit-toolbar): New Customize group. - (toolbar-button-default-position): New user variable. - (toolbar-new-button): New function. - (toolbar-new-spacer): New function. - (make-toolbar-instantiator): New function. - (toolbar-add-button): New function. - (toolbar-add-button-on-the-fly): New function. - -2002-12-04 Stephen J. Turnbull - - * Makefile (TEXI_FILES, INFO_FILES): Define them. - (all): Depend on INFO_FILES. - - * edit-utils.texi: New file. - -2002-11-26 Katsumi Yamaoka - - * lazy-shot.el (lazy-shot-install-timer): Use kill-buffer-hook to - delete an itimer when a buffer is killed. - -2002-11-05 Robert Fenk - - * desktop.el (desktop-relative-file-names): If non-nil we store - relative file names in the desktop-file. - (desktop-save): Modified to honor `desktop-relative-file-names'. - (desktop-create-buffer): Use the current `desktop-dirname' as the - directory for the expansion of relative file names. - -2002-11-01 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.95 released. - -2002-10-28 Vladimir Alexiev - - * after-save-commands.el (After-save--set-help-flyover): - Allow the predicate to be a lisp form instead of a regexp string. - (After-save--entry-lookup): ditto. - (After-save--after-save-hook): - Allow the command to be a lisp form instead of a shell command. - Process environment only if it's a shell command. - (After-save-alist): - Fix the defcustom to allow choices for predicate and command. - Document the variable better and give examples of elisp predicate - and command. - (my-after-save-action): (after "ends here") - Some commented-out code, has nicer output capabilities but is not - merged yet. - -2002-10-29 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.94 released. - -2002-10-20 Ville Skyttä - - * func-menu.el: Update my mail address. - -2002-10-15 Simon Josefsson - - * saveplace.el: Sync.el with Emacs 21.2. - -2001-10-22 Gerd Moellmann - - * saveplace.el (save-place): Require `saveplace'. - -2001-07-15 Pavel Janík - - * saveplace.el: Some fixes to follow coding conventions in - files maintained by FSF. - -2001-06-28 Karl Fogel - - * saveplace.el: Update maintainer email address. - -2001-04-19 Karl Fogel - - * saveplace.el (save-place-alist-to-file): Removed no-effect code - that inserted file content only to delete it immediately. - Probably a cut-and-paste bug. Thanks to Juanma Barranquero - for the patch. - -1997-09-24 Francis Litterio - - * saveplace.el (save-place-to-alist): Optimize out the degenerate - case when point is 1. - -1997-09-19 Richard Stallman - - * saveplace.el (save-place-version-control): Make nil the default. - -1997-01-28 Richard Stallman - - * saveplace.el (load-save-place-alist-from-file): - Delete spurious t's. - -2002-10-15 Ville Skyttä - - * Makefile (srckit): Remove. - -2002-09-06 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.93 released. - -2002-09-03 René Kyllingstad - - * desktop.el (desktop-enable-save-on-exit): New variable. - Partial sync with GNU Emacs 21.2. Small tweaks to the - submitted patch by . - -2002-08-13 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.92 released. - -2002-08-08 Adrian Aichner - - * mic-paren.el: Sync with - http://www.emacswiki.org/elisp/mic-paren.el version 3.7 plus typo - fixes of my own. - -2002-08-12 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.91 released. - -2002-08-02 Rendhalver [Peter Brown] - - * Makefile (VERSION): XEmacs package 1.90 released. - -2002-07-31 Ville Skyttä - - * func-menu.el: Add JavaScript support, checkdoc'ify. - (fume-function-name-regexp-javascript): New. - (fume-function-name-regexp-alist): Use -regexp-javascript. - (fume-find-next-javascript-function-name): New. - (fume-find-function-name-method-alist): Use -javascript-function-name. - -2002-07-24 Ville Skyttä - - * setnu.el: Sync with author version 1.06. - -2002-06-27 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.89 released. - -2002-06-04 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.88 released. - -2002-06-02 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.87 released. - -2002-05-31 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.86 released. - -2002-05-23 Jeff Mincy - - * completion.el (save-completions-to-file): Kill the - " *completion-save-buffer*" buffer. - (load-completions-from-file): Ditto. - -2002-05-14 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.85 released. - -2002-05-10 Ben Wing - - * recent-files.el: - * recent-files.el (recent-files-menu-omit-chars-list): New. - * recent-files.el (recent-files-version): - * recent-files.el (recent-files-maybe-generate-accelerator-spec): New. - * recent-files.el (recent-files-update-menu): - Add accelerator specs to recent-files menus, if possible. - - * scroll-in-place.el (scroll-command-groups): - * scroll-in-place.el (scroll-down): - * scroll-in-place.el (scroll-up): - Changes to track changes in a new workspace of mine (not yet - committed), where all scrollbar stuff is moved to Lisp. - -2002-04-30 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.84 released. - -2002-04-28 Steve Youngs - - * big-menubar.el: Rewrite so it's useful for XEmacs versions - 21.1.x to 21.5.x. - -2002-04-24 Steve Youngs - - * Makefile (VERSION): XEmacs package 1.83 released. - -2002-04-08 John Paul Wallington - - * avoid.el (mouse-avoidance-mode-line-string): add autoload cookie. - -2002-03-25 Steve Youngs - - * Makefile (VERSION): 1.82 released. - -2002-03-24 Nix - - * setnu.el (setnu-mode): Added autoload cookie. - - * vertical-mode.el: Added autoload cookie. - -2002-03-08 Mike Sperber - - * func-menu.el (fume-function-name-regexp-scheme): Recognize other - define-like forms (such as define-syntax). - -2002-03-04 Vin Shelton - - * Makefile (REQUIRES): Added dired and mail-lib - -2002-03-03 Nix - - * desktop.el: Synch with FSF Emacs 21.1. - -2002-02-24 Steve Youngs - - * package-info.in (provides): Remove ibuffer. - -2002-02-15 Steve Youngs - - * Makefile (ELCS): Removed ibuffer.elc, moved it to it's own - package. - -2002-01-29 John Paul Wallington - - * ibuffer.el (ibuffer-name-map): use [buttonx], not [(mouse-x)]. - (ibuffer-mode-name-map): ditto. - (ibuffer-occur-mode-map): ditto. - (ibuffer-fontification-level): return font-lock-auto-fontify when - font-lock-mode is bound. - -2002-01-18 Casper Kvan Clausen - - * lazy-lock.el (lazy-lock-percent-fontified): Fix bug when - traversing empty buffers. - -2002-01-16 John Paul Wallington - - * man.el (Manual-switches): fix custom type, add group. - * avoid.el (mouse-avoidance-mode-line-string): new customizable - variable. - * balloon-help.el (balloon-help-mode-line-string): ditto. - * lazy-lock.el (lazy-lock-mode-line-string): ditto. - -2002-01-08 Didier Verna - - * func-menu.el (fume-function-marks): New. - * func-menu.el (fume-rescan-buffer): Use it. - * func-menu.el (fume-update-menubar-entry): Call `function-menu' - instead of `fume-add-menubar-entry'. - * func-menu.el (function-menu): Add menu entries for - `fume-goto-next-function' and `fume-goto-previous-function'. - * func-menu.el (fume-mouse-function-goto): fix bug when clicking - outside text. - * func-menu.el (fume-goto-next-function): New. - * func-menu.el (fume-goto-previous-function): New. - * func-menu.el (fume-mode-line-string): New. - * func-menu.el (fume-mode-hook): New. - * func-menu.el (fume-mode-map): New. - * func-menu.el (fume-mode): New. - * func-menu.el (turn-on-fume-mode): New. - * func-menu.el (turn-off-fume-mode): New. - * func-menu.el (fume-setup-buffer): New. - * func-menu.el (fume-do-setup-buffer): New. - -2001-12-29 Steve Youngs - - * package-info.in: (provides) Update to include all provides. - -2001-12-26 Nix - - * uniquify.el (uniquify-ignore-buffers-query-functions): New hook, - called to determine buffers not to uniquify. - (uniquify-rationalize-file-buffer-names): Use it... - (uniquify-ignore-buffers-re): ... reimplement in terms of it. - New function. - (uniquify-ignore-buffers-mode-re): New variable and function. - Co-authored with Volker Franz . - -2001-12-13 Steve Youngs - - * Makefile (REQUIRES): Add fsf-compat for info-look's require - 'overlay. - -2001-12-05 Christoph Wedler - - * info-look.el: Sync with Emacs-21.1. The only differences are... - (overlay): Require. - (info-lookup): Use code from old XEmacs version instead Emacs - specific multi-frame coding... - (...emacs-lisp-mode): XEmacs' info files are named - xemacs/lispref instead emacs/elisp. - -2001-12-03 Ted Phelps - - * blink-cursor.el: Don't use last-input-time if it's not - available. - -2001-11-27 Robert Fenk - - * man.el (Manual-use-rosetta-man): New. - -2001-09-29 Jeff Mincy - - * recent-files.el (recent-files-entry-to-menu-entry): Don't - prepend "*" if in a submenu. - -2001-08-23 Adrian Aichner - - * uniquify.el: Fix the documented bug that prevented uniquify from - working in native Windows XEmacs. Patch is courtesy of Paul - Krause. - * uniquify.el (uniquify-directory-matching-regexp): New. - * uniquify.el (uniquify-get-proposed-name): Use - uniquify-directory-matching-regexp. - * uniquify.el (uniquify-reverse-components): Use - directory-sep-char. - -2001-08-16 Steve Youngs - - * setnu.el: Moved here from JDE package. - - * Makefile (ELCS): Add setnu.elc - -2001-08-14 Stefan Kamphausen - - * func-menu.el (fume-find-next-ruby-function-name): Improved. - -2001-08-06 Stefan Kamphausen - - * func-menu.el: added ruby support - -2001-07-19 Daiki Ueno - - * iswitchb.el (iswitchb-complete): Set this-command to - 'iswitchb-completion-help when putting the following excusion into - iswitchb-completion-help. - -2001-07-14 Steve Youngs - - * ibuffer.el: Replaced with newer version that was in - xemacs-devel. - -2001-07-10 Vin Shelton - - * search-buffers.el: Remove trailing ^Ms. - -2001-07-01 Steve Youngs - - * search-buffers.el: New file. - - * ibuffer.el: New file. - - * Makefile (ELCS): Add ibuffer.elc, search-buffers.elc. - -2001-05-20 Ben Wing - - * scroll-in-place.el (scroll-command-groups): - Put scroll-up-one and scroll-down-one in their own group so they - don't interact badly with pageup/down. - -2001-05-11 Ben Wing - - * func-menu.el: typo fix. - * recent-files.el: autoload the init function. - -2001-04-20 Karl M. Hegbloom - - * id-select.el (id-select-thing-with-mouse): Use `own-selection' in - newest XEmacs. - -2001-04-21 Ben Wing - - * func-menu.el: - * func-menu.el (fume-add-menubar-entry): - * func-menu.el (fume-do-add-menubar-entry): New. - * func-menu.el (fume-update-menubar-entry): When invoked from - find-file-hooks, delay creation of menubar entry until XEmacs - becomes idle. This way, func-menu will not intrude when files are - loaded temporarily (e.g. as part of patch-to-change-log). - -2001-04-06 Glynn Clements - - * man.el (manual-entry): limit search to current line when trying - to find a default. - -2001-04-05 Andrew W. Nosenko - - * func-menu.el (fume-function-name-regexp-make): Use `\s_' symbol - class instead of hardcoded `_' and `/' characters. - -2001-02-24 Ben Wing - - * dabbrev.el: - * dabbrev.el (dabbrev): - * dabbrev.el (dabbrev-abbrev-skip-leading-regexp): - * dabbrev.el (dabbrev-case-fold-search): - * dabbrev.el (dabbrev-upcase-means-case-search): - * dabbrev.el (dabbrev-case-replace): - * dabbrev.el (dabbrev-check-all-buffers): - * dabbrev.el (dabbrev-ignored-buffer-names): New. - * dabbrev.el (dabbrev-check-other-buffers): - * dabbrev.el (dabbrev-completion): - * dabbrev.el (dabbrev-expand): - * dabbrev.el (dabbrev--abbrev-at-point): - * dabbrev.el (dabbrev--find-expansion): - * dabbrev.el (dabbrev--substitute-expansion): - * dabbrev.el (dabbrev--search): - Synch with FSF 20.7. - -2001-02-16 Martin Buchholz - - * lazy-lock.el (lazy-lock-pre-idle-fontify-windows): - Avoid infinite loop if selected frame is not visible. - * lazy-lock.el (lazy-lock-maybe-fontify-window): - Can't use with-selected-window - not in 21.1. - -2001-02-15 Martin Buchholz - - Fix bug: - xemacs -q -no-site-file ~/.emacs -f font-lock-mode \ - -f turn-on-lazy-lock -f split-window-vertically -f make-frame - Then select upper window, move mouse to single-window frame, move - mouse back to split-window frame. Selected window will be lower one. - * lazy-lock.el: - (lazy-lock-pre-idle-fontify-windows): - The idiom (with-selected-window x ...) only works if x is in the - same frame as the selected window - else the frame-selected window - of x's frame is not restored. - (lazy-lock-maybe-fontify-frame): New. - -2001-02-15 Martin Buchholz - - * lazy-lock.el: Byte-compiler warning cleanup. - -2001-01-13 Vin Shelton - - * detached-minibuf.el: Create a separator correctly for 21.2. - -2000-11-16 Martin Buchholz - - * func-menu.el (fume-bomb-proof): - Revert previous change, now that the byte compiler in 21.2 is fixed. - -2000-11-16 Steve Youngs - - * redo.el: Sync with author version 1.02. - -2000-11-15 Steve Youngs - - * func-menu.el (fume-bomb-proof): Wrap it in a eval-and-compile. - -2000-11-13 Martin Buchholz - - * man.el: Fix man page presentation portability bugs. - (Manual-nuke-nroff-bs-footers): - - Some systems (AIX, Tru64) don't have 66-line paginated man output. - - Avoid deleting actual information every 66th line of the man page - by doing conservative detection of paginated output. - - Better heuristic for inserting newlines at former page breaks. - - Support both Solaris-style and groff-style pagination. - (Manual-nuke-nroff-bs): - - Make sure section headings are in man-heading face even if the - source boldifies them to avoid random choice of man-bold or man-heading. - - Section headings may be followed by one optional newline. - - Don't do special handling for one-page man pages. - - Special-case the sequence _\b_ so that \fBfoo_bar\fP is - displayed using one extent, not three. - - speed up by almost a factor of two. - - Guess that the sequence c\b\bc is always overstriking. - (Manual-bold-twocolumn-compatibility-regexp): Delete. - (Manual-mouseify-xrefs): - Pass apropos-mode as an arg instead of using it dynamically. - -2000-11-02 Nick V. Pakoulin - - * icomplete.el: Fixed header. - -2000-10-18 Andrew W. Nosenko - - * man.el (Manual-mode-syntax-table): syntax table for Manual mode - is added. - (manual-entry): uses syntax table of current buffer when search - defaults but allow wresize(3x) and similar as special case. - (manual-entry): if current position is first character of - identifier then use this identifier as default. - -2000-10-19 Steve Youngs - - * power-macros.el: New file. - - * Makefile (ELCS): Add power-macros.elc. - -2000-10-08 Gunnar Evermann - - * func-menu.el (fume-about): Add missing fume-version. - -2000-10-08 Carsten Dominik - - * func-menu.el: Upgrade support for IDL to IDLwave - -2000-10-05 Martin Buchholz - - * *: Mega typo fix. - -2000-10-04 Andrew W. Nosenko - - * man.el (manual-entry): using of syntax-table instead of hard-coded - characters for detecting topic when called interactivelly. - -2000-09-23 Steve Youngs - - * Makefile (ELCS): Added vertical-mode.el. - -2000-08-04 Didier Verna - - * func-menu.el: some reformatting of comments and copyright notice. - (fume-version): increase. - (fume-about): just give the version number. - (fume-function-name-regexp-manual): new variable (man pages support). - (fume-function-name-regexp-alist): Manual-mode addition. - (fume-find-next-manual-section): new function (man pages support). - (fume-find-function-name-method-alist): use it. - - -2000-03-10 Felix Gatzemeier - - * man.el: Smoothed sectioning and retrieval. In determining the - default in the prompt, pick up sections in parentheses, too. When - interpreting a manpage request, accept the '5 passwd' shorthand - for 'passwd(5)'. - -1999-08-30 Mike Sperber - - * edit-toolbar.el (edit-toolbar-file-name): Use - `user-init-directory' correctly. - - * where-was-i-db.el: Zap the `in-user-init-directory' crapola. - (wwi-with-open-database): Expand the database filename. - -2000-07-07 Ben Wing - - * lazy-lock.el (lazy-lock-pre-idle-fontify-windows): - window-minibuffer-p requires an arg in 21.1. - (lazy-lock-post-command-fontify-stealthily): same. - -2000-05-21 Ben Wing - - * lazy-lock.el: - * lazy-lock.el (lazy-lock-submit-bug-report): Removed. - * lazy-lock.el (lazy-lock-mode): - * lazy-lock.el (lazy-lock-walk-windows): - * lazy-lock.el (lazy-lock-cache-continue): Removed. - * lazy-lock.el (lazy-lock): New. - * lazy-lock.el (lazy-lock-stealth-verbose): - * lazy-lock.el (lazy-lock-ignore-commands): - * lazy-lock.el (lazy-lock-hide-invisible): - * lazy-lock.el (lazy-lock-continuity-time): Removed. - * lazy-lock.el (lazy-lock-invisible-foreground): - * lazy-lock.el (lazy-lock-stealth-load): New. - * lazy-lock.el (lazy-lock-put-text-property): - * lazy-lock.el ('lazy-lock-put-text-property): New. - * lazy-lock.el (lazy-lock-fontify-region): - * lazy-lock.el (lazy-lock-after-fontify-buffer): - * lazy-lock.el (lazy-lock-sit-for): Removed. - * lazy-lock.el (lazy-lock-pre-idle-fontify-windows): - * lazy-lock.el (lazy-lock-pre-idle-frame-modified-tick): Removed. - * lazy-lock.el (lazy-lock-pre-idle-selected-frame): Removed. - * lazy-lock.el (lazy-lock-maybe-fontify-window): New. - * lazy-lock.el (lazy-lock-timeout-id): New. - * lazy-lock.el (lazy-lock-fontify-window): - * lazy-lock.el (lazy-lock-post-resize-fontify-windows): Removed. - * lazy-lock.el (lazy-lock-fontify-stealthily): - * lazy-lock.el (lazy-lock-fontify-walk-windows): Removed. - * lazy-lock.el (lazy-lock-fontify-walk-stealthily): - * lazy-lock.el (lazy-lock-colour-invisible): - - Removed all support for FSF Emacs and for old (19.x) versions - of XEmacs, added customize support, extended the - frame-modified-tick code to work over all frames, and cleaned - up the pre-idle-hook code to be even more careful about - avoiding consing and not changing any global state - (e.g. select-window) unless necessary. Also, general code - cleanups, e.g. removing outdated comments. - -2000-05-16 Andreas Jaeger - - * func-menu.el (fume-function-name-regexp-fortran90): Improved. - Patch by Michael L. Hall . - -2000-04-13 Mike Woolley - - * desktop.el (desktop-internal-v2s): Handle character correctly. - -2000-04-03 Yoshiki Hayashi - - * edit-utils/foldout.el: (foldout-hide-flag): New constant. - (foldout-show-flag): Ditto. - (foldout-mouse-track-click-hook): New function. - (foldout-mouse-goto-heading): Use event-point. - (foldout-mouse-zoom): New argument click-count. - (foldout-mouse-show): Ditto. - (Top level): Use XEmacs style key bindings. - -2000-04-06 Yoshiki Hayashi - - * man.el (Manual-bold-twocolumn-compatibility-regexp): New - variable. - (Manual-nuke-nroff-bs): Search - Manual-bold-twocolumn-compatibility-regexp followed by two ^H. - -2000-04-02 IKEYAMA Tomonori - - * fast-lock.el (fast-lock-cache-name): Treat Windows path - separator. - -2000-02-23 Andreas Jaeger - - * mic-paren.el: Version 2.3 from Klaus Berndl. - -2000-01-19 Adrian Aichner - - * bookmark.el (bookmark-completing-read): Use new argument default - of `completing-read'. Drop last argument if we get signaled - `wrong-number-of-arguments'. Document the change. Re-indent - function. - -2000-01-18 Andreas Jaeger - - * bookmark.el (bookmark-completing-read): Fix patch from - 1999-12-21 for XEmacs 21.1.x. Patch by Adrian Aichner - . - -2000-01-17 Yoshiki Hayashi - - * bookmark.el (bookmark-menu-popup-paned-menu): Use - get-popup-menu-response. - -2000-01-14 Yoshiki Hayashi - - * makesum.el (make-command-summary): Use with-displaying-help-buffer. - provide makesum. - -1999-12-21 Yoshiki Hayashi - - * bookmark.el (bookmark-completing-read): Use DEFAULT - argument of completing-read. - -1999-11-19 Karl M. Hegbloom - - * where-was-i-db.el: Use expand-file-name in user-init-directory - -1999-11-03 Robert Fenk - - * reportmail.el (display-time-init): `getenv "HOME"' replaced by - `user-home-directory', because usually HOME is not defined on WinNT. - -1999-07-23 Jerry James - - * avoid.el (mouse-avoidance-exile-hook): Check - emacs-major-version too. - * avoid.el (mouse-avoidance-fancy-hook): Ditto. - -1999-01-29 Christoph Wedler - - * uniquify.el: Sync with Emacs-20.3. - (uniquify-ignore-buffers-re): New user option. Useful to avoid - having uniquify rename gnus/message draft buffers. - (uniquify-rationalize-file-buffer-names): Use it. - -1999-07-07 Greg Klanderman - - * backup-dir.el: update to version 2.9 - -1999-06-18 Bob Weiner - - * completion.el (complete): Added autoload cookie. - -1999-07-02 Didier Verna - - * balloon-help.el (balloon-help-minor-mode): new function. - (balloon-help-minor-mode): new variable. - (balloon-help-motion-hook): handle it. - (balloon-help-mode): update doc string + autoload cookie. - (balloon-help-mode): (variable) defcustom' it + autoload cookie. - (balloon-help-version): increment version number. - -1999-05-11 SL Baur - - * recent-files.el (recent-files-add-file): `recent-files-get-file-name' - can return nil - From Tudor Hulubei - -1999-03-17 Didier Verna - - * permanent-buffers.el: version 1.2. ChangeLog in the file. - -1999-03-08 Charles G. Waldman - - * where-was-i-db.el: spelling fixes in documentation - -1999-02-18 Karl M. Hegbloom - - * after-save-commands.el: Many changes. - install a global after - save hook, maybe re-install after `write-file', allow setting of - an after save command for a file currently being visited, upgrade - the example value of After-save-alist, improved docstring, etc... - -1998-12-30 Martin Buchholz - - * winring.el: New file. Version 3.5. - Imported from http://www.python.org/emacs/winring/winring.el - -1998-12-02 SL Baur - - * floating-toolbar.el: Remove explicit (require 'x) so the file - can be bytecompiled prior to release. - -1998-10-16 Hrvoje Niksic - - * man.el (Manual-switches): New option. - (manual-entry): Use it. - -1998-09-29 Jonathan Marten - - * paren.el: General tidy up. Removed paren-message-suppress, look - at whether there is a current message instead. Implemented - backwards context message for programming languages for which it - is appropriate (so giving better messages for C and similar), - added custom variable `paren-backwards-message'. Cleaned up some - doc strings. - -1998-09-30 SL Baur - - * man.el (nuke-nroff-bs): autoload and change to defalias. - (Manual-nuke-nroff-bs): autoload. - -1998-09-29 SL Baur - - * makesum.el (make-command-summary): program test was reversed. - -1998-09-25 Greg Klanderman - - * popper.el: update to version XEmacs 1.5. - -1998-09-18 SL Baur - - * lazy-lock.el (lazy-lock-running-xemacs-p): Test for "XEmacs" in - version string. - -1998-08-25 Karl M. Hegbloom - - * after-save-commands.el: Major cleanups and docstring edits. - -1998-07-20 Karl M. Hegbloom - - * after-save-commands.el (After-save--entry-lookup): use - `regexp-quote' so that files with `c++' in them don't trigger an - "invalid preceding regexp" error. - -1998-07-20 SL Baur - - * func-menu.el: v2.57 from David Hughes - -1998-07-14 SL Baur - - * Makefile: add missing dependency for outl-mouse.elc. - - * outl-mouse.el: Global search and replace - set-pixmap-contributes-to-line-height to set-glyph-contrib-p. - -1998-07-13 SL Baur - - * mode-motion+.el (mode-motion-clear-last-extent): Use modern name - for obsolete popup-menu-up-p. - -1998-07-12 SL Baur - - * scroll-in-place.el (scroll-determine-goal-column): screen-width - -> frame-width. - - * bookmark.el (bookmark-write-file): Kill usage of `baud-rate'. - (bookmark-load): Ditto. - -1998-06-13 Karl M. Hegbloom - - * after-save-commands.el: Shorten the custom group to improve look - of menus. - -1998-06-10 Greg Klanderman - - * backup-dir.el: update to v2.7. - -1998-05-30 Kirill M. Katsnelson - - * recent-files.el (recent-files-filename-replacements): Use - regexp-quote to get regexp from a filename. - -1998-05-29 Greg Klanderman - - * popper.el: upgrage from XEmacs v1.3 to v1.4. - -1998-06-01 SL Baur - - * popper.el: Synch with v1.3. - -1998-05-12 Jan Vroonhof - - * lazy-shot.el (lazy-shot-after-change-function): Removed debug - message. - -1998-05-11 SL Baur - - * edit-faces.el (edit-faces-mode): Use easymenu. - -1998-03-15 Greg Klanderman - - * mic-paren.el (paren-dont-activate-on-load): default to t. - -1998-04-27 SL Baur - - * id-select.el: (id-select-string-p): Fix beginning of string bug. - From Bob Weiner - -1998-04-22 SL Baur - - * shell-font.el: synch David Hughes updates. - -1998-04-22 Didier Verna - - * blink-cursor.el (blink-cursor-mode): defcustom and autoload it - for options menu handling. - - * lazy-shot.el (lazy-shot-mode): ditto. - - * fast-lock.el (fast-lock-mode): ditto. - -1998-04-21 SL Baur - - * id-select.el: Synch with latest version. - -1998-03-31 Stephen Eglen - - * iswitchb.el (iswitchb-read-buffer): New function to act as - drop-in replacement for read-buffer. - (iswitchb-existing-buffer-p): New function. - (iswitchb-exit-minibuffer): New function. - (iswitchb-complete): Use iswitchb-common-match-string rather than - recomputing the value. - (iswitchb-make-buflist): Takes the default buffer as an argument. - (iswitchb-completion-help): Multiple TAB presses scroll the - completion window. - (iswitchb-minibuffer-setup-hook): Customized. - (iswitchb-entryfn-p): Simplified. - (iswitchb-default): New variable. - (iswitchb-method): No longer a user variable. - (iswitchb-entry): Function deleted. - (iswitchb-ignore-buffername-p): store-match-data renamed to - set-match-data. - Many doc fixes. - -1998-04-06 Jan Vroonhof - - * lazy-shot.el (lazy-shot-lock-extent): Be liberal in what you - expect. Check for detached extents. - -1998-03-23 Greg Klanderman - - * backup-dir.el: Update to v2.6: quote the eval-after-load form - -1998-03-30 SL Baur - - * makesum.el (make-command-summary): Fix to work with new help - buffer naming. - -1998-03-25 SL Baur - - * timer.el removed. - -1998-03-21 SL Baur - - * ballon-help.el-1.07 from Kyle Jones - -1998-03-19 SL Baur - - * timer.el (timer-activate-when-idle): avoid call to - set-itimer-uses-arguments. - From someone. #### FIXME. - -1998-03-11 SL Baur - - * paren.el (paren-max-blinks): Allow setting to nil for indefinite - blinking. - From Jeremiah W. James - -1998-03-02 Greg Klanderman - - * man.el (manual-entry): Return the buffer into which the man page - was formatted if successful. - -1998-03-05 SL Baur - - * func-menu.el: synched with v2.54. - -1998-03-04 SL Baur - - * desktop.el (desktop-save): Back out avoidance of write-region patch. - Suggested by Greg Klanderman - -1998-02-21 Greg Klanderman - - * desktop.el (desktop-remove): Use expand-file-name to expand a - filename wrt a directory, not concat. - (desktop-save): ditto. - -1998-02-24 SL Baur - - * backup-dir.el: Updated to 2.5. - - * popper.el added. - From Greg Klanderman - (popper-install): New function with all initialization stuffs. - -1998-02-02 Christoph Wedler - - * icomplete.el: Is now usable with rsz-minibuf.el. - (icomplete-prospects-length): New user option. - (icomplete-completions): Use it. Make much faster. Sort - remaining prospects. - -1998-02-16 Jens-Ulrik Holger Petersen - - * uniquify.el: Emacs syncing. Updates header comments a little. - (uniquify-buffer-name-style): Sync tag. - (uniquify-min-dir-content): Sync docstring. - (uniquify-file-name-nondirectory): Sync new function. - (uniquify-fix-item-base): was `uniquify-fix-list-base'. - (uniquify-fix-item-filename): was `uniquify-fix-list-filename'. - (uniquify-fix-item-buffer): was `uniquify-fix-list-buffer'. - (uniquify-fix-item-unrationalized-buffer): was macro - `uniquify-cadddr' and `uniquify-unrationalized-buffer'. - (uniquify-fix-item-filename-lessp): was - `uniquify-fix-list-filename-lessp'. - (uniquify-rationalize-file-buffer-names): Sync. - (uniquify-buffer-file-name): Sync. - (uniquify-filename-lessp): use `uniquify-file-name-nondirectory'. - (uniquify-get-proposed-name): Sync. - (uniquify-rename-buffer): Sync. - -1998-02-16 Christoph Wedler - - * man.el (manual-entry): Do not use option "-s" with - option "-k". - -1998-02-11 SL Baur - - * reportmail.el: Synch to InfoDock 3.6.2. - -1998-02-04 SL Baur - - * mic-paren.el (mic-paren-highlight): Deebolify -- replace /= with - (not (eq ...)). - -1998-01-23 Hrvoje Niksic - - * man.el (manual-entry): Would bug out on foo(x). - -1998-01-31 Christoph Wedler - - * icomplete.el (icomplete-completions): Make faster. - Would bug out with name="XY" and canditates=(("XY") ("XY")). - Previous bug fix from 1998-01-12 has a serious performance bug. - -1998-01-31 SL Baur - - * icomplete.el: Reverse Wedler patch of 1998-01-12. - - * balloon-help.el: Document X resource name for decoration. - From Georg Nikodym - -1998-01-25 SL Baur - - * Makefile (VERSION): Update to package standard 1.0. - * package-info.in: Ditto. - -1998-01-12 Christoph Wedler - - * icomplete.el (icomplete): - (icomplete-completions): Would bug out with name="XY" and - canditates=(("XY") ("XY")). - -1998-01-12 SL Baur - - * Makefile: Update to newer package specs. - resume.el, timer.el, after-save-commands.el, shell-font.el, - lispm-fonts.el added. - -1997-12-09 Colin Rafferty - - * lazy-shot.el: Made it handle large insertions in the file more - gracefully, by using `after-change-functions'. - (lazy-shot-after-change-function): Created. - (lazy-shot-install-extents): Made it take `start' and `end' - instead of using entire buffer. - (lazy-shot-install): Made it install our after-change-function and - remove font-lock's. - (lazy-shot-unstall): Made it remove our after-change-function and - install font-lock's back. - -1997-12-10 Christoph Wedler - - * func-menu.el (fume-goto-function): `regexp-quote' - function name MATCH-FN. - -1998-01-09 SL Baur - - * id-select.el: Synched up with InfoDock 3.6.2. - -1998-01-05 SL Baur - - * Makefile: add permanent-buffers.el. - -1998-01-03 SL Baur - - * Makefile (ELCS): Add where-was-i-db.el. - Update to new package interface. - -1998-01-01 SL Baur - - * desktop.el (desktop-remove): Correction in overwrite logic to not - lose on MS Windows. - Jeff Sparkes - - * Makefile: Added info-look.el. - -1997-12-30 SL Baur - - * mic-paren.el (mic-paren-command-hook): Spelling fix. - (mic-paren-command-idle-hook): Spelling fix. - (mic-paren-highlight): Deebolify -- replace /= with (not (eq ...)) - - * backup-dir.el ("diff"): Defer symbol munging in diff.el until if - and when "diff" is loaded. - Suggested by: Karl M. Hegbloom - - * Makefile (ELCS): backup-dir.el, saveconf.el, saveplace.el added. - -1997-12-28 SL Baur - - * loadhist.el: Removed from package (and put back in core). - -1997-12-24 SL Baur - - * Makefile: Created. diff --git a/xemacs-packages/lisp/edit-utils/_pkg.el b/xemacs-packages/lisp/edit-utils/_pkg.el deleted file mode 100644 index 73bdb620..00000000 --- a/xemacs-packages/lisp/edit-utils/_pkg.el +++ /dev/null @@ -1,5 +0,0 @@ -;;;###autoload -(package-provide 'edit-utils - :version 2.34 - :author-version "No-Upstream-Ver" - :type 'single-file) diff --git a/xemacs-packages/lisp/edit-utils/abbrevlist.el b/xemacs-packages/lisp/edit-utils/abbrevlist.el deleted file mode 100644 index 3397bb5d..00000000 --- a/xemacs-packages/lisp/edit-utils/abbrevlist.el +++ /dev/null @@ -1,55 +0,0 @@ -;;; abbrevlist.el --- list one abbrev table alphabetically ordered. - -;; Copyright (C) 1986, 1992 Free Software Foundation, Inc. -;; Suggested by a previous version by Gildea. - -;; Maintainer: FSF -;; Keywords: abbrev - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: FSF 19.34. - -;;; Code: - -(defun list-one-abbrev-table (abbrev-table output-buffer) - "Display alphabetical listing of ABBREV-TABLE in buffer OUTPUT-BUFFER." - (with-output-to-temp-buffer output-buffer - (save-excursion - (let ((abbrev-list nil) (first-column 0)) - (set-buffer standard-output) - (mapatoms - (function (lambda (abbrev) - (setq abbrev-list (cons abbrev abbrev-list)))) - abbrev-table) - (setq abbrev-list (sort abbrev-list 'string-lessp)) - (while abbrev-list - (if (> (+ first-column 40) (frame-width)) - (progn - (insert "\n") - (setq first-column 0))) - (indent-to first-column) - (insert (symbol-name (car abbrev-list))) - (indent-to (+ first-column 8)) - (insert (symbol-value (car abbrev-list))) - (setq first-column (+ first-column 40)) - (setq abbrev-list (cdr abbrev-list))))))) - -(provide 'abbrevlist) - -;;; abbrevlist.el ends here diff --git a/xemacs-packages/lisp/edit-utils/after-save-commands.el b/xemacs-packages/lisp/edit-utils/after-save-commands.el deleted file mode 100644 index 4800eb47..00000000 --- a/xemacs-packages/lisp/edit-utils/after-save-commands.el +++ /dev/null @@ -1,407 +0,0 @@ -;;; after-save-commands.el --- Run a shell command or lisp form after saving a file - -;; Copyright (C) 1997,98,99 by Karl M. Hegbloom - -;; $Id: after-save-commands.el,v 1.8 2002/10/29 20:58:06 scop Exp $ -;; Author: Karl M. Hegbloom -;; Keywords: processes,unix - -;; 25-Oct-2002 vladimir@worklogic.com: -;; - the predicate can also be a lisp form instead of a regexp string -;; - the command can also be a lisp form instead of a shell command -;; - documented After-save-alist better - -;; This file is part of XEmacs. - -;;; This might be rolled into `files.el' at some point in the near -;;; future, pending bug fixes, functionality/feature froze, and the -;;; approval of the XEmacs development team (and perhaps RMS... who -;;; will need to find someone to port it some for GNU Emacs if he -;;; would like to.) - - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Commentary: - -;;; Set up a list of file-name matching regular expressions associated -;;; with shell commands or lisp forms to run after saving the file. - -;;; This is good for things like running `newaliases(1)' on -;;; "/etc/aliases", `xrdb(1)' on "~/.Xresources", installing a new -;;; "~/.crontab", as well as for sending signals to daemons whos -;;; configuration files you've just finished editing. -;;; -;;; It is much safer and more powerful than using exec statements in -;;; "Local Variables" sections, and can safely be used by root for -;;; system administration tasks. The shell command can run about -;;; anything you can think of. -;;; -;;; Who knows? Maybe Homekey Symsun will use this feature, and it -;;; will allow per to quickly run a daemon HUP after reconfiguration -;;; of the nuclear plant control file, thus saving an entire duchy -;;; from immanent destruction! -;;; -;;; See variable `After-save-alist' for more information. - -;;; Devel Notes: -;;; -;;; I would like to perhaps... pull out the ~/ and ~name/ expansion -;;; from `expand-file-name', and make a `tilde-expand' -;;; function... and also a `expand-environment-in-string' that -;;; doesn't try to do any tilde expanditsomes. The regexp ought to -;;; be split (by my code in this file?) on \\|, etc., and in the -;;; relevant locations, expansion should be done, so that the regexp -;;; can contain ~'s, and have it do what I mean there, like to match -;;; files in a user's home directory... ? maybe. - -;;; Code: -;;;----------------------------------------------------- -(require 'env) -(require 'advice) - -(defmacro After-save--with-modeline-process-extent-ext (&rest body) - `(and modeline-process - (consp modeline-process) - (let ((ext (car modeline-process))) - (and (extentp ext) - ,@body)))) - -(defun After-save--set-help-flyover (str) - (After-save--with-modeline-process-extent-ext - (let ((state (After-save--ascmd-property))) - (unless (stringp str) (setq str (format "%s" str))) - (cond - ((eq :on state) - (setq str (concat "Run: " str))) - ((eq :off state) - (setq str (concat "DON'T run: " str))))) - (set-extent-property ext 'help-echo str))) - -(defun After-save--get-help-flyover () - (After-save--with-modeline-process-extent-ext - (let ((str (extent-property ext 'help-echo))) - (string-match "^[^:]+:\\(.*\\)\\'" str) - (match-string 1 str)))) - -(defun After-save--ascmd-property () - "Return the 'ascmd property of our extent in `modeline-process' if it -exists." - (After-save--with-modeline-process-extent-ext - (extent-property ext 'ascmd))) - - -(defun After-save--entry-lookup (buf-fn) - "Lookup BUF-FN in `After-save-alist', and return that record." - (if buf-fn - (catch 'return - (mapc #'(lambda (elt) - (if (cond ((stringp (car elt)) - (string-match (car elt) buf-fn)) - ((eval (car elt)))) - (throw 'return elt))) - After-save-alist) - (throw 'return nil)))) - -;; Q: Is `modeline-process' ok? Or is there a more standard place for -;; this? At some point I'll be able to answer my own question, but -;; now have lots else I ought to be doing. (like reading for -;; instance.) Please advise. Yeah or Nay? - -;;;###autoload -(defun After-save--find-file-hook () - "Look up the name of this file in `After-save-alist', and if it has -an entry, turn on the modeline button and indicator." - (let ((file->cmd-entry (After-save--entry-lookup (buffer-file-name)))) - ;;; (declarelike (special file->cmd-entry)) ; need dynamic scope, - ;;; this time. Put up with one byte compiler warning. - (if file->cmd-entry - (After-save--install-ascmd)))) - -;; `autoload' these just in case then get stuck on the hook before the -;; setting of `After-save-alist' brings this program in with its -;; :require. I think that could happen if the `find-file-hooks' gets -;; saved in `options.el' after this has been installed on it. That -;; variable might come before the `defcustom'ed variables at the top -;; of this program. Of course, once this feature is rolled into -;; "files.el", there's no need for it to be in the hooks anymore; -;; it'll be more inline... right? - -;;;###autoload -(defun After-save--after-save-hook () - "An `after-save-hook' to run a shell-command. -This gets hung on the `after-save-hook'. -See: `After-save-alist'." - (let ((file->cmd-entry (After-save--entry-lookup (buffer-file-name)))) - (if (and file->cmd-entry - (eq :on (After-save--ascmd-property))) - (let ((confirm-exec-flag (third file->cmd-entry)) - (command (fourth file->cmd-entry))) - (cond ((and confirm-exec-flag - (not (y-or-n-p (format "Run: %s ? " command)))) - ;; user declined: do nothing - ) - ((not (stringp command)) ;; command is lisp sexp - (message "%s ->%s" command (eval command))) - (t ;; shell command - ;; The `copy-sequence' is important, since `setenv' mutates - ;; `process-environment' in place. (uses `setcar'...) We want - ;; a copy of `process-environment' to get bound here, so the - ;; more global one, outside of this `let*' block, doesn't get - ;; its elements modified like that. - (let ((process-environment (copy-sequence process-environment)) - (environ-alist (second file->cmd-entry))) - ;; Here, the bound `process-environment' is modified, not - ;; the more global one. The current dynamic value of it - ;; will get passed to the command's shell. - (setenv "f" (buffer-file-name)) - (setenv "d" (default-directory)) - (if environ-alist - (mapc #'(lambda (env-pair) - (setenv (car env-pair) - (if (cdr env-pair) - ;; expand $vars - ;; does not expand tilde's... - ;; there is no `expand-environ-in-string' - ;; or `tilde-expand' AFAIK - (substitute-in-file-name (cdr env-pair)) - nil))) - environ-alist)) - (shell-command command)))))))) - -;; I'd just use `minor-mode-alist', but I want the fly-over to show -;; the after save command rather than "button2 will...". -(defun After-save--install-ascmd () - "Install a modeline indicator." - (let ((ext (make-extent nil nil)) - (km (make-sparse-keymap))) - (set-extent-property ext 'ascmd :on) - (set-extent-face ext 'modeline-mousable-minor-mode) - ;;; ref to free var file->cmd-entry : rely on dynamic scope. - (define-key km [(button2)] #'(lambda () - (interactive) - (After-save--toggle-ascmd))) - (set-extent-keymap ext km) - (setq modeline-process (cons ext " AScmd")) - (After-save--set-help-flyover (fourth file->cmd-entry)) - (redraw-modeline))) - - -(copy-face 'modeline-mousable-minor-mode 'After-save--strikethu-face) -;;; Wish: (set-face-strikethru-p 'After-save--strikethu-face t :strikethru-spaces nil) -(set-face-strikethru-p 'After-save--strikethu-face t) - -(defun After-save--toggle-ascmd () - "Turn AScmd off if on, on if off, but not on if not installed in this -buffer yet." - (interactive) - (let* ((ext (and modeline-process - (consp modeline-process) - (car modeline-process))) - (state (After-save--ascmd-property))) - (and (extentp ext) - (cond - ((eq state :off) - (set-extent-property ext 'ascmd :on) - (set-extent-face ext 'modeline-mousable-minor-mode)) - ((eq state :on) - (set-extent-property ext 'ascmd :off) - (set-extent-face ext 'After-save--strikethu-face)))) - (After-save--set-help-flyover (After-save--get-help-flyover)) - (redraw-modeline))) - -;; Will of course be unnecessary once this is part of "files.el" -;; someday when it grows up and is ready to join the core of -;; xemacs/lisp/*.el society as a full fledged member. -(defadvice write-file (before After-save activate) - (if (After-save--ascmd-property) - (setq modeline-process nil))) - - ;; At least in XEmacs-21.0 Pyrenean63, `write-file' calls - ;; `set-visited-file-name' which uses `kill-local-variable' to clear - ;; both `write-file-hooks' and `after-save-hook', amoung others... - -(defadvice write-file (after After-save activate) - (After-save--find-file-hook)) - -;; I shouldn't have to use `after-init-hook' like this... Or should -;; I? I think maybe I ought to be able to use just a straight out -;; `add-hook' here. But when `find-file-hooks' has been customized, -;; it's value can get set to an arbitrary list after this `add-hook' -;; is run, thus wiping it out. So I have to install it on the -;; `after-init-hook' like this. It might be nice if the hook type -;; would be initialized by custom with an add-hook... Then again, -;; maybe sticking an add-hook onto the `after-init-hook' like this is -;; really just the standard way of getting a function onto the list? -;; Perhaps by makeing `custom-set-variables' set the hook to an -;; absolute value, we make it possible to know for certain what it's -;; startup time value will be... minus additions by packages like -;; this one. YTMAWBK OTOH, perhaps `custom-set-variables' ought to -;; use `add-hook', so that whenif things like this are installed -;; earlier than when the options.el file is run, they won't get wiped -;; out. -(add-hook 'after-init-hook - #'(lambda () - (add-hook 'find-file-hooks 'After-save--find-file-hook) - (add-hook 'after-save-hook 'After-save--after-save-hook))) - -;; And once for when we load this, in case that's sometime after the -;; `after-init-hook' has already been run, like the first time a new -;; user customizes `After-save-alist'. `add-hook' will ensure it's -;; only in there once. -(add-hook 'find-file-hooks 'After-save--find-file-hook) -(add-hook 'after-save-hook 'After-save--after-save-hook) - -;;; "... or should I just put ;;;###autoload cookies in front of those -;;; add-hook's?" No, again, I'm afraid that somebody might customize -;;; the hooks and they'll overwrite what the `autoload' brings in. And -;;; besides, there's a :require statement in the `defcustom' for -;;; `After-save-alist', which is easily accessed from the [ Options | -;;; Customize | Emacs | Files ] menu. - -(defcustom After-save-alist - '(("/etc/X11/Xresources/\\|/\\.Xresources" nil t "xrdb $f") - ("/\\.crontab\\'" nil t "crontab $f") - ("/etc/inetd.conf" nil t "echo /etc/init.d/netbase reload") - ("\\.mailrc" nil t (build-mail-aliases)) - ((eq major-mode 'sh-mode) nil t "chmod a+x $f") - ("# __JUST_FOR_EXAMPLE__ #" - (("Set_ME" . "to some value") - ("UN_Set_ME")) - nil "echo 'rm -rf / && Bwahahahha!'")) - "*List associating file regexp or condition to shell command or lisp form. -Each element is of the form - (PREDICATE ((VAR1 . VAL1) (VAR2 . VAL2) (VAR3)...) PROMPT-P COMMAND) -where - PREDICATE is a string regexp to match against the file name, - or a lisp form to evaluate. - (VAR . VAL) are environment variable assignments. - Omit VAL to unset VAR. - PROMPT-P whether to ask for confirmation each time the file is saved - and prior to running the command. - COMMAND Shell command (string) to run or lisp form to eval, - after the file is saved. - -While you are visiting a file that has an `after-save-command' associated with -it, the modeline will display \"AScmd\" in the minor mode list, and moving the -mouse over that indicator will cause the buffer's associated shell command to -be displayed in the minibuffer. Clicking button 2 there will toggle whether -the command will be run or not. - -This facility can be very handy for doing things like: -- running `newaliases(1)' after you've edited the `sendmail(8)' daemon's - \"/etc/aliases\" file, -- running `xrdb\(1)' after you've hand-tweaked your \".Xresource\" settings -- installing a \".crontab\" -- sending a signal to a system daemon whose configuration file you've edited. -- running (build-mail-aliases) after you've edited .mailrc - -You may create or change these settings while you are visiting a file, since -it works by installing a function in the global `after-save-hook', and a -lookup in `After-save-alist' for your command spec happens then. You may also -change the settings for a file that's already got an after-save entry, prior -to saving it. - -The command you specify will be run in a subshell, out of the -`after-save-hook', using the lisp function `shell-command'. You can cause it -to background by suffixing the command with the usual \"&\". It will inherit -the `process-environment' of your XEmacs session, along with the specified -environment modifications, as well as the following automatically defined -variables: - - $f -- The full path and filename of the file, `buffer-file-name' - $d -- The directory, with a trailing \"/\" where the file was saved. - -The `Var=\"Value\" pair' environment variables will be defined in the context -the shell command will be run in. You may reference previously defined -environment variables within the `Value' fields, since they are expanded -sequentially, from top to bottom, using `substitute-in-file-name', just before -the command is run. $f and $d are set first, and so may be used for expansion -within your environment specifications, as well as in the commandline. - -Note that no shell processing will be done until the commandline is fed to -your shell. That is, globbing or brace expansions and things don't happen -until the command is run. - -If you use `write-file' (`C-x C-w') to write the visited buffer to a different -filename, the `after-save-command' will not be run, and the after save command -property will be removed from the buffer, unless the new file name matches one -of your `After-save-alist' specifications." - - :require 'after-save-commands - :set #'(lambda (var val) - (set-default var val) - (mapc #'(lambda (b) - (with-current-buffer b - (if (After-save--ascmd-property) - (setq modeline-process nil)) - (After-save--find-file-hook))) - (buffer-list)) - (redraw-modeline t)) - :type '(repeat - (list :tag - "------------------------------------------------------------" - :indent 2 - (choice (regexp :tag "File name regexp" "") - (sexp :tag "ELisp form (predicate)" "")) - (repeat :tag "Environment" - :indent 1 - (cons :tag "Var=\"Value\" pair" - (string :tag "Variable" "") - (choice (string :tag "Value" "") - (const :tag "unset" nil)))) - (boolean :tag "Confirm before execution? " t) - (choice (string :tag "Shell Command line (use $f and $d)" "") - (sexp :tag "ELisp form to evaluate " "")))) - :group 'files) - -(provide 'after-save-commands) -;;; after-save-commands.el ends here - - -;; vladimir@worklogic.com: this below has some nicer output capabilities, -;; consider merging into the code above. - -'(defun my-after-save-action (predicate action) - (if (cond ((and (stringp predicate) - (eq ?$ (aref predicate (1- (length predicate))))) - (string-match predicate buffer-file-name)) - ((stringp predicate) - (string= buffer-file-name (expand-file-name predicate))) - (t (eval predicate))) - (let (async descr result time) - (if (setq async (eq (car action) :async)) - (setq action (cdr action))) - (when (stringp (car action)) - (setq descr (concat "`" (mapconcat 'identity - (append action (list (file-name-nondirectory buffer-file-name))) - " ") "'")) - (setq action (append action (list buffer-file-name)))) - (cond - (async - (apply 'start-process descr - (setq buf (concat "*output " descr "*")) - action) - (message "%s started, see buffer %s." descr buf)) - (descr - (setq time (second (current-time))) - (message "%s started, please wait..." descr) - (setq result (apply 'call-process - (car action) nil nil nil (cdr action))) - (message "%s returned %s." descr result) - (if (< 3 (- (second (current-time)) time)) - (ding))) - (t (message "%s returned %s." action (eval action))))))) diff --git a/xemacs-packages/lisp/edit-utils/align.el b/xemacs-packages/lisp/edit-utils/align.el deleted file mode 100644 index 99d8fcdb..00000000 --- a/xemacs-packages/lisp/edit-utils/align.el +++ /dev/null @@ -1,1591 +0,0 @@ -;;; align.el --- align text to a specific column, by regexp - -;; Copyright (C) 1999, 2000, 2002 Free Sofware Foundation - -;; Author: John Wiegley -;; Keywords: convenience languages lisp - -;; 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: - -;; This mode allows you to align regions in a context-sensitive fashion. -;; The classic use is to align assignments: -;; -;; int a = 1; -;; short foo = 2; -;; double blah = 4; -;; -;; becomes -;; -;; int a = 1; -;; short foo = 2; -;; double blah = 4; - -;;; Usage: - -;; There are several variables which define how certain "categories" -;; of syntax are to be treated. These variables go by the name -;; `align-CATEGORY-modes'. For example, "c++" is such a category. -;; There are several rules which apply to c++, but since several other -;; languages have a syntax similar to c++ (e.g., c, java, etc), these -;; modes are treated as belonging to the same category. -;; -;; If you want to add a new mode under a certain category, just -;; customize that list, or add the new mode manually. For example, to -;; make jde-mode a c++ category mode, use this code in your .emacs -;; file: -;; -;; (setq align-c++-modes (cons 'jde-mode align-c++-modes)) - -;; In some programming modes, it's useful to have the aligner run only -;; after indentation is performed. To achieve this, customize or set -;; the variable `align-indent-before-aligning' to t. - -;;; Module Authors: - -;; In order to incorporate align's functionality into your own -;; modules, there are only a few steps you have to follow. - -;; 1. Require or load in the align.el library. -;; -;; 2. Define your alignment and exclusion rules lists, either -;; customizable or not. -;; -;; 3. In your mode function, set the variables -;; `align-mode-rules-list' and `align-mode-exclude-rules-list' -;; to your own rules lists. - -;; If there is any need to add your mode name to one of the -;; align-?-modes variables (for example, `align-dq-string-modes'), use -;; `add-to-list', or some similar function which checks first to see -;; if the value is already there. Since the user may customize that -;; mode list, and then write your mode name into their .emacs file, -;; causing the symbol already to be present the next time they load -;; your package. - -;; Example: -;; -;; (require 'align) -;; -;; (defcustom my-align-rules-list -;; '((my-rule -;; (regexp . "Sample"))) -;; :type align-rules-list-type -;; :group 'my-package) -;; -;; (put 'my-align-rules-list 'risky-local-variable t) -;; -;; (add-to-list 'align-dq-string-modes 'my-package-mode) -;; (add-to-list 'align-open-comment-modes 'my-package-mode) -;; -;; (defun my-mode () -;; ... -;; (setq align-mode-rules-list my-align-rules-list)) -;; -;; Note that if you need to install your own exclusion rules, then you -;; will also need to reproduce any double-quoted string, or open -;; comment exclusion rules that are defined in the standard -;; `align-exclude-rules-list'. At the moment there is no convenient -;; way to mix both mode-local and global rules lists. - -;;; History: - -;; Version 1.0 was created in the earlier part of 1996, using a very -;; simple algorithm that understand only basic regular expressions. -;; Parts of the code were broken up and included in vhdl-mode.el -;; around this time. After several comments from users, and a need to -;; find a more robust, performant algorithm, 2.0 was born in late -;; 1998. Many different approaches were taken (mostly due to the -;; complexity of TeX tables), but finally a scheme was discovered -;; which worked fairly well for most common usage cases. Development -;; beyond version 2.8 is not planned, except for problems that users -;; might encounter. - -;;; Code: - -(defgroup align nil - "Align text to a specific column, by regexp." - :group 'fill) - -;;; User Variables: - -(defcustom align-load-hook nil - "*Hook that gets run after the aligner has been loaded." - :type 'hook - :group 'align) - -(defcustom align-indent-before-aligning nil - "*If non-nil, indent the marked region before aligning it." - :type 'boolean - :group 'align) - -(defcustom align-default-spacing 1 - "*An integer that represents the default amount of padding to use. -If `align-to-tab-stop' is non-nil, this will represent the number of -tab stops to use for alignment, rather than the number of spaces. -Each alignment rule can optionally override both this variable. See -`align-mode-alist'." - :type 'integer - :group 'align) - -(defcustom align-to-tab-stop 'indent-tabs-mode - "*If non-nil, alignments will always fall on a tab boundary. -It may also be a symbol, whose value will be taken." - :type '(choice (const nil) symbol) - :group 'align) - -(defcustom align-region-heuristic 500 - "*If non-nil, used as a heuristic by `align-current'. -Since each alignment rule can possibly have its own set of alignment -sections (whenever `align-region-separate' is non-nil, and not a -string), this heuristic is used to determine how far before and after -point we should search in looking for a region separator. Larger -values can mean slower perform in large files, although smaller values -may cause unexpected behavior at times." - :type 'integer - :group 'align) - -(defcustom align-highlight-change-face 'highlight - "*The face to highlight with if changes are necessary." - :type 'face - :group 'align) - -(defcustom align-highlight-nochange-face 'secondary-selection - "*The face to highlight with if no changes are necessary." - :type 'face - :group 'align) - -(defcustom align-large-region 10000 - "*If an integer, defines what constitutes a \"large\" region. -If nil,then no messages will ever be printed to the minibuffer." - :type 'integer - :group 'align) - -(defcustom align-c++-modes '(c++-mode c-mode java-mode) - "*A list of modes whose syntax resembles C/C++." - :type '(repeat symbol) - :group 'align) - -(defcustom align-perl-modes '(perl-mode cperl-mode) - "*A list of modes where perl syntax is to be seen." - :type '(repeat symbol) - :group 'align) - -(defcustom align-lisp-modes - '(emacs-lisp-mode lisp-interaction-mode lisp-mode scheme-mode) - "*A list of modes whose syntax resembles Lisp." - :type '(repeat symbol) - :group 'align) - -(defcustom align-tex-modes - '(tex-mode plain-tex-mode latex-mode slitex-mode) - "*A list of modes whose syntax resembles TeX (and family)." - :type '(repeat symbol) - :group 'align) - -(defcustom align-text-modes '(text-mode outline-mode) - "*A list of modes whose content is plain text." - :type '(repeat symbol) - :group 'align) - -(defcustom align-dq-string-modes - (append align-lisp-modes align-c++-modes align-perl-modes - '(python-mode)) - "*A list of modes where double quoted strings should be excluded." - :type '(repeat symbol) - :group 'align) - -(defcustom align-sq-string-modes - (append align-perl-modes '(python-mode)) - "*A list of modes where single quoted strings should be excluded." - :type '(repeat symbol) - :group 'align) - -(defcustom align-open-comment-modes - (append align-lisp-modes align-c++-modes align-perl-modes - '(python-mode makefile-mode)) - "*A list of modes with a single-line comment syntax. -These are comments as in Lisp, which have a beginning but, end with -the line (i.e., `comment-end' is an empty string)." - :type '(repeat symbol) - :group 'align) - -(defcustom align-region-separate "^\\s-*[{}]?\\s-*$" - "*Select the method by which alignment sections will be separated. -If this is a symbol, that symbol's value will be used. - -For the sake of clarification, consider the following example, which -will be referred to in the descriptions below. - - int alpha = 1; /* one */ - double beta = 2.0; - long gamma; /* ten */ - - unsigned int delta = 1; /* one */ - long double epsilon = 3.0; - long long omega; /* ten */ - -The possible settings for `align-region-separate' are: - - `entire' The entire region being aligned will be considered as a - single alignment section. Assuming that comments were not - being aligned to a particular column, the example would - become: - - int alpha = 1; /* one */ - double beta = 2.0; - long gamma; /* ten */ - - unsigned int delta = 1; /* one */ - long double epsilon; - long long chi = 10; /* ten */ - - `group' Each contiguous set of lines where a specific alignment - occurs is considered a section for that alignment rule. - Note that each rule will may have any entirely different - set of section divisions than another. - - int alpha = 1; /* one */ - double beta = 2.0; - long gamma; /* ten */ - - unsigned int delta = 1; /* one */ - long double epsilon; - long long chi = 10; /* ten */ - - `largest' When contiguous rule sets overlap, the largest section - described will be taken as the alignment section for each - rule touched by that section. - - int alpha = 1; /* one */ - double beta = 2.0; - long gamma; /* ten */ - - unsigned int delta = 1; /* one */ - long double epsilon; - long long chi = 10; /* ten */ - - NOTE: This option is not supported yet, due to algorithmic - issues which haven't been satisfactorily resolved. There - are ways to do it, but they're both ugly and resource - consumptive. - - regexp A regular expression string which defines the section - divider. If the mode you're in has a consistent divider - between sections, the behavior will be very similar to - `largest', and faster. But if the mode does not use clear - separators (for example, if you collapse your braces onto - the preceding statement in C or perl), `largest' is - probably the better alternative. - - function A function that will be passed the beginning and ending - locations of the region in which to look for the section - separator. At the very beginning of the attempt to align, - both of these parameters will be nil, in which case the - function should return non-nil if it wants each rule to - define its own section, or nil if it wants the largest - section found to be used as the common section for all rules - that occur there. - - list A list of markers within the buffer that represent where - the section dividers lie. Be certain to use markers! For - when the aligning begins, the ensuing contract/expanding of - whitespace will throw off any non-marker positions. - - This method is intended for use in Lisp programs, and not - by the user." - :type '(choice - (const :tag "Entire region is one section" entire) - (const :tag "Align by contiguous groups" group) -; (const largest) - (regexp :tag "Regexp defines section boundaries") - (function :tag "Function defines section boundaries")) - :group 'align) - -(put 'align-region-separate 'risky-local-variable t) - -(defvar align-rules-list-type - '(repeat - (cons - :tag "Alignment rule" - (symbol :tag "Title") - (cons :tag "Required attributes" - (cons :tag "Regexp" - (const :tag "(Regular expression to match)" regexp) - (choice :value "\\(\\s-+\\)" regexp function)) - (repeat - :tag "Optional attributes" - (choice - (cons :tag "Repeat" - (const :tag "(Repeat this rule throughout line)" - repeat) - (boolean :value t)) - (cons :tag "Paren group" - (const :tag "(Parenthesis group to use)" group) - (choice :value 2 - integer (repeat integer))) - (cons :tag "Modes" - (const :tag "(Modes where this rule applies)" modes) - (sexp :value (text-mode))) - (cons :tag "Case-fold" - (const :tag "(Should case be ignored for this rule)" - case-fold) - (boolean :value t)) - (cons :tag "To Tab Stop" - (const :tag "(Should rule align to tab stops)" - tab-stop) - (boolean :value nil)) - (cons :tag "Valid" - (const :tag "(Return non-nil if rule is valid)" - valid) - (function :value t)) - (cons :tag "Run If" - (const :tag "(Return non-nil if rule should run)" - run-if) - (function :value t)) - (cons :tag "Column" - (const :tag "(Column to fix alignment at)" column) - (choice :value comment-column - integer symbol)) - (cons :tag "Spacing" - (const :tag "(Amount of spacing to use)" spacing) - (integer :value 1)) - (cons :tag "Justify" - (const :tag "(Should text be right justified)" - justify) - (boolean :value t)) - ;; make sure this stays up-to-date with any changes - ;; in `align-region-separate' - (cons :tag "Separate" - (const :tag "(Separation to use for this rule)" - separate) - (choice :value "^\\s-*$" - (const entire) - (const group) -; (const largest) - regexp function))))))) - "The `type' form for any `align-rules-list' variable.") - -(unless (functionp 'c-guess-basic-syntax) - (autoload 'c-guess-basic-syntax "cc-engine")) - -(defcustom align-rules-list - `((lisp-second-arg - (regexp . "\\(^\\s-+[^( \t\n]\\|(\\(\\S-+\\)\\s-+\\)\\S-+\\(\\s-+\\)") - (group . 3) - (modes . align-lisp-modes) - (run-if . ,(function (lambda () current-prefix-arg)))) - - (lisp-alist-dot - (regexp . "\\(\\s-*\\)\\.\\(\\s-*\\)") - (group . (1 2)) - (modes . align-lisp-modes)) - - (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)))) - (modes . align-open-comment-modes)) - - (c-macro-definition - (regexp . "^\\s-*#\\s-*define\\s-+\\S-+\\(\\s-+\\)") - (modes . align-c++-modes)) - - (c-variable-declaration - (regexp . ,(concat "[*&0-9A-Za-z_]>?[&*]*\\(\\s-+[*&]*\\)" - "[A-Za-z_][0-9A-Za-z:_]*\\s-*\\(\\()\\|" - "=[^=\n].*\\|(.*)\\|\\(\\[.*\\]\\)*\\)?" - "\\s-*[;,]\\|)\\s-*$\\)")) - (group . 1) - (modes . align-c++-modes) - (justify . t) - (valid - . ,(function - (lambda () - (not (or (save-excursion - (goto-char (match-beginning 1)) - (backward-word 1) - (looking-at - "\\(goto\\|return\\|new\\|delete\\|throw\\)")) - (if (and (boundp 'font-lock-mode) font-lock-mode) - (eq (get-text-property (point) 'face) - 'font-lock-comment-face) - (eq (caar (c-guess-basic-syntax)) 'c)))))))) - - (c-assignment - (regexp . ,(concat "[^-=!^&*+<>/| \t\n]\\(\\s-*[-=!^&*+<>/|]*\\)" - "=\\(\\s-*\\)\\([^= \t\n]\\|$\\)")) - (group . (1 2)) - (modes . align-c++-modes) - (justify . t) - (tab-stop . nil)) - - (perl-assignment - (regexp . ,(concat "[^=!^&*-+<>/| \t\n]\\(\\s-*\\)=[~>]?" - "\\(\\s-*\\)\\([^>= \t\n]\\|$\\)")) - (group . (1 2)) - (modes . align-perl-modes) - (tab-stop . nil)) - - (python-assignment - (regexp . ,(concat "[^=!<> \t\n]\\(\\s-*\\)=" - "\\(\\s-*\\)\\([^>= \t\n]\\|$\\)")) - (group . (1 2)) - (modes . '(python-mode)) - (tab-stop . nil)) - - (make-assignment - (regexp . "^\\s-*\\w+\\(\\s-*\\):?=\\(\\s-*\\)\\([^\t\n \\\\]\\|$\\)") - (group . (1 2)) - (modes . '(makefile-mode)) - (tab-stop . nil)) - - (c-comma-delimiter - (regexp . ",\\(\\s-*\\)[^/ \t\n]") - (repeat . t) - (modes . align-c++-modes) - (run-if . ,(function (lambda () current-prefix-arg)))) -; (valid -; . ,(function -; (lambda () -; (memq (caar (c-guess-basic-syntax)) -; '(brace-list-intro -; brace-list-entry -; brace-entry-open)))))) - - ;; With a prefix argument, comma delimiter will be aligned. Since - ;; perl-mode doesn't give us enough syntactic information (and we - ;; don't do our own parsing yet), this rule is too destructive to - ;; run normally. - (basic-comma-delimiter - (regexp . ",\\(\\s-*\\)[^# \t\n]") - (repeat . t) - (modes . (append align-perl-modes '(python-mode))) - (run-if . ,(function (lambda () current-prefix-arg)))) - - (c++-comment - (regexp . "\\(\\s-*\\)\\(//.*\\|/\\*.*\\*/\\s-*\\)$") - (modes . align-c++-modes) - (column . comment-column) - (valid . ,(function - (lambda () - (save-excursion - (goto-char (match-beginning 1)) - (not (bolp))))))) - - (c-chain-logic - (regexp . "\\(\\s-*\\)\\(&&\\|||\\|\\\\|\\\\)") - (modes . align-c++-modes) - (valid . ,(function - (lambda () - (save-excursion - (goto-char (match-end 2)) - (looking-at "\\s-*\\(/[*/]\\|$\\)")))))) - - (perl-chain-logic - (regexp . "\\(\\s-*\\)\\(&&\\|||\\|\\\\|\\\\)") - (modes . align-perl-modes) - (valid . ,(function - (lambda () - (save-excursion - (goto-char (match-end 2)) - (looking-at "\\s-*\\(#\\|$\\)")))))) - - (python-chain-logic - (regexp . "\\(\\s-*\\)\\(\\\\|\\\\)") - (modes . '(python-mode)) - (valid . ,(function - (lambda () - (save-excursion - (goto-char (match-end 2)) - (looking-at "\\s-*\\(#\\|$\\|\\\\\\)")))))) - - (c-macro-line-continuation - (regexp . "\\(\\s-*\\)\\\\$") - (modes . align-c++-modes) - (column . c-backslash-column)) -; (valid -; . ,(function -; (lambda () -; (memq (caar (c-guess-basic-syntax)) -; '(cpp-macro cpp-macro-cont)))))) - - (basic-line-continuation - (regexp . "\\(\\s-*\\)\\\\$") - (modes . '(python-mode makefile-mode))) - - (tex-record-separator - (regexp . ,(function - (lambda (end reverse) - (align-match-tex-pattern "&" end reverse)))) - (group . (1 2)) - (modes . align-tex-modes) - (repeat . t)) - - (tex-tabbing-separator - (regexp . ,(function - (lambda (end reverse) - (align-match-tex-pattern "\\\\[=>]" end reverse)))) - (group . (1 2)) - (modes . align-tex-modes) - (repeat . t) - (run-if . ,(function - (lambda () - (eq major-mode 'latex-mode))))) - - (tex-record-break - (regexp . "\\(\\s-*\\)\\\\\\\\") - (modes . align-tex-modes)) - - ;; With a numeric prefix argument, or C-u, space delimited text - ;; tables will be aligned. - (text-column - (regexp . "\\(^\\|\\S-\\)\\(\\s-+\\)\\(\\S-\\|$\\)") - (group . 2) - (modes . align-text-modes) - (repeat . t) - (run-if . ,(function - (lambda () - (and current-prefix-arg - (not (eq '- current-prefix-arg))))))) - - ;; With a negative prefix argument, lists of dollar figures will - ;; be aligned. - (text-dollar-figure - (regexp . "\\$?\\(\\s-+[0-9]+\\)\\.") - (modes . align-text-modes) - (justify . t) - (run-if . ,(function - (lambda () - (eq '- current-prefix-arg)))))) - "*A list describing all of the available alignment rules. -The format is: - - ((TITLE - (ATTRIBUTE . VALUE) ...) - ...) - -The following attributes are meaningful: - -`regexp' This required attribute must be either a string describing - a regular expression, or a function (described below). - For every line within the section that this regular - expression matches, the given rule will be applied to that - line. The exclusion rules denote which part(s) of the - line should not be modified; the alignment rules cause the - identified whitespace group to be contracted/expanded such - that the \"alignment character\" (the character - immediately following the identified parenthesis group), - occurs in the same column for every line within the - alignment section (see `align-region-separate' for a - description of how the region is broken up into alignment - sections). - - The `regexp' attribute describes how the text should be - treated. Within this regexp, there must be at least one - group of characters (typically whitespace) identified by - the special opening and closing parens used in regexp - expressions (`\\\\(' and `\\\\)') (see the Emacs manual on - the syntax of regular expressions for more info). - - If `regexp' is a function, it will be called as a - replacement for `re-search-forward'. This means that it - should return nil if nothing is found to match the rule, - or it should set the match data appropriately, move point - to the end of the match, and return the value of point. - -`group' For exclusion rules, the group identifies the range of - characters that should be ignored. For alignment rules, - these are the characters that will be deleted/expanded for - the purposes of alignment. The \"alignment character\" is - always the first character immediately following this - parenthesis group. This attribute may also be a list of - integer, in which case multiple alignment characters will - be aligned, with the list of integer identifying the - whitespace groups which precede them. The default for - this attribute is 1. - -`modes' The `modes' attribute, if set, should name a list of - major modes -- or evaluate to such a value -- in which the - rule is valid. If not set, the rule will apply to all - modes. - -`case-fold' If `regexp' is an ordinary regular expression string - containing alphabetic character, sometimes you may want - the search to proceed case-insensitively (for languages - that ignore case, such as pascal for example). In that - case, set `case-fold' to a non-nil value, and the regular - expression search will ignore case. If `regexp' is set to - a function, that function must handle the job of ignoring - case by itself. - -`tab-stop' If the `tab-stop' attribute is set, and non-nil, the - alignment character will always fall on a tab stop - (whether it uses tabs to get there or not depends on the - value of `indent-tabs-mode'). If the `tab-stop' attribute - is set to nil, tab stops will never be used. Otherwise, - the value of `align-to-tab-stop' determines whether or not - to align to a tab stop. The `tab-stop' attribute may also - be a list of t or nil values, corresponding to the number - of parenthesis groups specified by the `group' attribute. - -`repeat' If the `repeat' attribute is present, and non-nil, the - rule will be applied to the line continuously until no - further matches are found. - -`valid' If the `valid' attribute is set, it will be used to - determine whether the rule should be invoked. This form - is evaluated after the regular expression match has been - performed, so that it is possible to use the results of - that match to determine whether the alignment should be - performed. The buffer should not be modified during the - evaluation of this form. - -`run-if' Like `valid', the `run-if' attribute tests whether the - rule should be run at all -- even before any searches are - done to determine if the rule applies to the alignment - region. This can save time, since `run-if' will only be - run once for each rule. If it returns nil, the rule will - not be attempted. - -`column' For alignment rules, if the `column' attribute is set -- - which must be an integer, or a symbol whose value is an - integer -- it will be used as the column in which to align - the alignment character. If the text on a particular line - happens to overrun that column, a single space character, - or tab stop (see `align-to-tab-stop') will be added - between the last text character and the alignment - character. - -`spacing' Alignment rules may also override the amount of spacing - that would normally be used by providing a `spacing' - attribute. This must be an integer, or a list of integers - corresponding to the number of parenthesis groups matched - by the `group' attribute. If a list of value is used, and - any of those values is nil, `align-default-spacing' will - be used for that subgroup. See `align-default-spacing' - for more details on spacing, tab stops, and how to - indicate how much spacing should be used. If TAB-STOP is - present, it will override the value of `align-to-tab-stop' - for that rule. - -`justify' It is possible with `regexp' and `group' to identify a - character group that contains more than just whitespace - characters. By default, any non-whitespace characters in - that group will also be deleted while aligning the - alignment character. However, if the `justify' attribute - is set to a non-nil value, only the initial whitespace - characters within that group will be deleted. This has - the effect of right-justifying the characters that remain, - and can be used for outdenting or just plain old right- - justification. - -`separate' Each rule can define its own section separator, which - describes how to identify the separation of \"sections\" - within the region to be aligned. Setting the `separate' - attribute overrides the value of `align-region-separate' - (see the documentation of that variable for possible - values), and any separation argument passed to `align'." - :type align-rules-list-type - :group 'align) - -(put 'align-rules-list 'risky-local-variable t) - -(defvar align-exclude-rules-list-type - '(repeat - (cons - :tag "Exclusion rule" - (symbol :tag "Title") - (cons :tag "Required attributes" - (cons :tag "Regexp" - (const :tag "(Regular expression to match)" regexp) - (choice :value "\\(\\s-+\\)" regexp function)) - (repeat - :tag "Optional attributes" - (choice - (cons :tag "Repeat" - (const :tag "(Repeat this rule throughout line)" - repeat) - (boolean :value t)) - (cons :tag "Paren group" - (const :tag "(Parenthesis group to use)" group) - (choice :value 2 - integer (repeat integer))) - (cons :tag "Modes" - (const :tag "(Modes where this rule applies)" modes) - (sexp :value (text-mode))) - (cons :tag "Case-fold" - (const :tag "(Should case be ignored for this rule)" - case-fold) - (boolean :value t))))))) - "The `type' form for any `align-exclude-rules-list' variable.") - -(defcustom align-exclude-rules-list - `((exc-dq-string - (regexp . "\"\\([^\"\n]+\\)\"") - (repeat . t) - (modes . align-dq-string-modes)) - - (exc-sq-string - (regexp . "'\\([^'\n]+\\)'") - (repeat . t) - (modes . align-sq-string-modes)) - - (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)))) - (modes . align-open-comment-modes)) - - (exc-c-comment - (regexp . "/\\*\\(.+\\)\\*/") - (repeat . t) - (modes . align-c++-modes)) - - (exc-c-func-params - (regexp . "(\\([^)\n]+\\))") - (repeat . t) - (modes . align-c++-modes)) - - (exc-c-macro - (regexp . "^\\s-*#\\s-*\\(if\\w*\\|endif\\)\\(.*\\)$") - (group . 2) - (modes . align-c++-modes))) - "*A list describing text that should be excluded from alignment. -See the documentation for `align-rules-list' for more info." - :type align-exclude-rules-list-type - :group 'align) - -(put 'align-exclude-rules-list 'risky-local-variable t) - -;;; Internal Variables: - -(defvar align-mode-rules-list nil - "Alignment rules specific to the current major mode. -See the variable `align-rules-list' for more details.") - -(make-variable-buffer-local 'align-mode-rules-list) - -(defvar align-mode-exclude-rules-list nil - "Alignment exclusion rules specific to the current major mode. -See the variable `align-exclude-rules-list' for more details.") - -(make-variable-buffer-local 'align-mode-exclude-rules-list) - -(defvar align-highlight-overlays nil - "The current overlays highlighting the text matched by a rule.") - -;; Sample extension rule set, for vhdl-mode. This should properly be -;; in vhdl-mode.el itself. - -(defcustom align-vhdl-rules-list - `((vhdl-declaration - (regexp . "\\(signal\\|variable\\|constant\\)\\(\\s-+\\)\\S-") - (group . 2)) - - (vhdl-case - (regexp . "\\(others\\|[^ \t\n=<]\\)\\(\\s-*\\)=>\\(\\s-*\\)\\S-") - (group . (2 3)) - (valid - . ,(function - (lambda () - (not (string= (downcase (match-string 1)) - "others")))))) - - (vhdl-colon - (regexp . "[^ \t\n:]\\(\\s-*\\):\\(\\s-*\\)[^=\n]") - (group . (1 2))) - - (direction - (regexp . ":\\s-*\\(in\\|out\\|inout\\|buffer\\)\\(\\s-*\\)") - (group . 2)) - - (sig-assign - (regexp . "[^ \t\n=<]\\(\\s-*\\)<=\\(\\s-*\\)\\S-") - (group . (1 2))) - - (var-assign - (regexp . "[^ \t\n:]\\(\\s-*\\):=")) - - (use-entity - (regexp . "\\(\\s-+\\)use\\s-+entity"))) - "*Alignment rules for `vhdl-mode'. See `align-rules-list' for more info." - :type align-rules-list-type - :group 'align) - -(put 'align-vhdl-rules-list 'risky-local-variable t) - -(defun align-set-vhdl-rules () - "Setup the `align-mode-rules-list' variable for `vhdl-mode'." - (setq align-mode-rules-list align-vhdl-rules-list)) - -(add-hook 'vhdl-mode-hook 'align-set-vhdl-rules) - -(add-to-list 'align-dq-string-modes 'vhdl-mode) -(add-to-list 'align-open-comment-modes 'vhdl-mode) - -;;; User Functions: - -;;;###autoload -(defun align (beg end &optional separate rules exclude-rules) - "Attempt to align a region based on a set of alignment rules. -BEG and END mark the region. If BEG and END are specifically set to -nil (this can only be done programmatically), the beginning and end of -the current alignment section will be calculated based on the location -of point, and the value of `align-region-separate' (or possibly each -rule's `separate' attribute). - -If SEPARATE is non-nil, it overrides the value of -`align-region-separate' for all rules, except those that have their -`separate' attribute set. - -RULES and EXCLUDE-RULES, if either is non-nil, will replace the -default rule lists defined in `align-rules-list' and -`align-exclude-rules-list'. See `align-rules-list' for more details -on the format of these lists." - (interactive "r") - (let ((separator - (or separate - (if (and (symbolp align-region-separate) - (boundp align-region-separate)) - (symbol-value align-region-separate) - align-region-separate) - 'entire))) - (if (not (or ;(eq separator 'largest) - (and (functionp separator) - (not (funcall separator nil nil))))) - (align-region beg end separator - (or rules align-mode-rules-list align-rules-list) - (or exclude-rules align-mode-exclude-rules-list - align-exclude-rules-list)) - (let ((sec-first end) - (sec-last beg)) - (align-region beg end - (or exclude-rules - align-mode-exclude-rules-list - align-exclude-rules-list) nil - separator - (function - (lambda (b e mode) - (when (and mode (listp mode)) - (setq sec-first (min sec-first b) - sec-last (max sec-last e)))))) - (if (< sec-first sec-last) - (align-region sec-first sec-last 'entire - (or rules align-mode-rules-list align-rules-list) - (or exclude-rules align-mode-exclude-rules-list - align-exclude-rules-list))))))) - -;;;###autoload -(defun align-regexp (beg end regexp &optional group spacing repeat) - "Align the current region using an ad-hoc rule read from the minibuffer. -BEG and END mark the limits of the region. This function will prompt -for the REGEXP to align with. If no prefix arg was specified, you -only need to supply the characters to be lined up and any preceding -whitespace is replaced. If a prefix arg was specified, the full -regexp with parenthesized whitespace should be supplied; it will also -prompt for which parenthesis GROUP within REGEXP to modify, the amount -of SPACING to use, and whether or not to REPEAT the rule throughout -the line. See `align-rules-list' for more information about these -options. - -For example, let's say you had a list of phone numbers, and wanted to -align them so that the opening parentheses would line up: - - Fred (123) 456-7890 - Alice (123) 456-7890 - Mary-Anne (123) 456-7890 - Joe (123) 456-7890 - -There is no predefined rule to handle this, but you could easily do it -using a REGEXP like \"(\". All you would have to do is to mark the -region, call `align-regexp' and type in that regular expression." - (interactive - (append - (list (min (point) (mark)) - (max (point) (mark))) - (if current-prefix-arg - (list (read-string "Complex align using regexp: " - "\\(\\s-*\\)") - (string-to-int - (read-string - "Parenthesis group to modify (justify if negative): " "1")) - (string-to-int - (read-string "Amount of spacing (or column if negative): " - (number-to-string align-default-spacing))) - (y-or-n-p "Repeat throughout line? ")) - (list (concat "\\(\\s-*\\)" - (read-string "Align regexp: ")) - 1 align-default-spacing nil)))) - (let ((rule - (list (list nil (cons 'regexp regexp) - (cons 'group (abs group)) - (if (< group 0) - (cons 'justify t) - (cons 'bogus nil)) - (if (>= spacing 0) - (cons 'spacing spacing) - (cons 'column (abs spacing))) - (cons 'repeat repeat))))) - (align-region beg end 'entire rule nil nil))) - -;;;###autoload -(defun align-entire (beg end &optional rules exclude-rules) - "Align the selected region as if it were one alignment section. -BEG and END mark the extent of the region. If RULES or EXCLUDE-RULES -is set to a list of rules (see `align-rules-list'), it can be used to -override the default alignment rules that would have been used to -align that section." - (interactive "r") - (align beg end 'entire rules exclude-rules)) - -;;;###autoload -(defun align-current (&optional rules exclude-rules) - "Call `align' on the current alignment section. -This function assumes you want to align only the current section, and -so saves you from having to specify the region. If RULES or -EXCLUDE-RULES is set to a list of rules (see `align-rules-list'), it -can be used to override the default alignment rules that would have -been used to align that section." - (interactive) - (align nil nil nil rules exclude-rules)) - -;;;###autoload -(defun align-highlight-rule (beg end title &optional rules exclude-rules) - "Highlight the whitespace which a given rule would have modified. -BEG and END mark the extent of the region. TITLE identifies the rule -that should be highlighted. If RULES or EXCLUDE-RULES is set to a -list of rules (see `align-rules-list'), it can be used to override the -default alignment rules that would have been used to identify the text -to be colored." - (interactive - (list (min (mark) (point)) - (max (mark) (point)) - (completing-read - "Title of rule to highlight: " - (mapcar - (function - (lambda (rule) - (list (symbol-name (car rule))))) - (append (or align-mode-rules-list align-rules-list) - (or align-mode-exclude-rules-list - align-exclude-rules-list))) nil t))) - (let ((ex-rule (assq (intern title) - (or align-mode-exclude-rules-list - align-exclude-rules-list))) - face) - (align-unhighlight-rule) - (align-region - beg end 'entire - (or rules (if ex-rule - (or exclude-rules align-mode-exclude-rules-list - align-exclude-rules-list) - (or align-mode-rules-list align-rules-list))) - (unless ex-rule (or exclude-rules align-mode-exclude-rules-list - align-exclude-rules-list)) - (function - (lambda (b e mode) - (if (and mode (listp mode)) - (if (equal (symbol-name (car mode)) title) - (setq face (cons align-highlight-change-face - align-highlight-nochange-face)) - (setq face nil)) - (when face - (let ((overlay (make-overlay b e))) - (setq align-highlight-overlays - (cons overlay align-highlight-overlays)) - (overlay-put overlay 'face - (if mode - (car face) - (cdr face))))))))))) - -;;;###autoload -(defun align-unhighlight-rule () - "Remove any highlighting that was added by `align-highlight-rule'." - (interactive) - (while align-highlight-overlays - (delete-overlay (car align-highlight-overlays)) - (setq align-highlight-overlays - (cdr align-highlight-overlays)))) - -;;;###autoload -(defun align-newline-and-indent () - "A replacement function for `newline-and-indent', aligning as it goes." - (interactive) - (let ((separate (or (if (and (symbolp align-region-separate) - (boundp align-region-separate)) - (symbol-value align-region-separate) - align-region-separate) - 'entire)) - (end (point))) - (call-interactively 'newline-and-indent) - (save-excursion - (forward-line -1) - (while (not (or (bobp) - (align-new-section-p (point) end separate))) - (forward-line -1)) - (align (point) end)))) - -;;; Internal Functions: - -(defun align-match-tex-pattern (regexp end &optional reverse) - "Match REGEXP in TeX mode, counting backslashes appropriately. -END denotes the end of the region to be searched, while REVERSE, if -non-nil, indicates that the search should proceed backward from the -current position." - (let (result) - (while - (and (setq result - (funcall - (if reverse 're-search-backward - 're-search-forward) - (concat "\\(\\s-*\\)" regexp - "\\(\\s-*\\)") end t)) - (let ((pos (match-end 1)) - (count 0)) - (while (and (> pos (point-min)) - (eq (char-before pos) ?\\)) - (setq count (1+ count) pos (1- pos))) - (eq (mod count 2) 1)) - (goto-char (match-beginning 2)))) - result)) - -(defun align-new-section-p (beg end separator) - "Is there a section divider between BEG and END? -SEPARATOR specifies how to look for the section divider. See the -documentation for `align-region-separate' for more details." - (cond ((or (not separator) - (eq separator 'entire)) - nil) - ((eq separator 'group) - (let ((amount 2)) - (save-excursion - (goto-char end) - (if (bolp) - (setq amount 1))) - (> (count-lines beg end) amount))) - ((stringp separator) - (save-excursion - (goto-char beg) - (re-search-forward separator end t))) - ((functionp separator) - (funcall separator beg end)) - ((listp separator) - (let ((seps separator) yes) - (while seps - (if (and (>= (car seps) beg) - (<= (car seps) end)) - (setq yes t seps nil) - (setq seps (cdr seps)))) - yes)))) - -(defun align-adjust-col-for-rule (column rule spacing tab-stop) - "Adjust COLUMN according to the given RULE. -SPACING specifies how much spacing to use. -TAB-STOP specifies whether SPACING refers to tab-stop boundaries." - (unless spacing - (setq spacing align-default-spacing)) - (if (<= spacing 0) - column - (if (not tab-stop) - (+ column spacing) - (let ((stops tab-stop-list)) - (while stops - (if (and (> (car stops) column) - (= (setq spacing (1- spacing)) 0)) - (setq column (car stops) - stops nil) - (setq stops (cdr stops))))) - column))) - -(defsubst align-column (pos) - "Given a position in the buffer, state what column it's in. -POS is the position whose column will be taken. Note that this -function will change the location of point." - (goto-char pos) - (current-column)) - -(defsubst align-regions (regions props rule func) - "Align the regions specified in REGIONS, a list of cons cells. -PROPS describes formatting features specific to the given regions. -RULE specifies exactly how to perform the alignments. -If FUNC is specified, it will be called with each region that would -have been aligned, rather than modifying the text." - (while regions - (save-excursion - (align-areas (car regions) (car props) rule func)) - (setq regions (cdr regions) - props (cdr props)))) - -(defun align-areas (areas props rule func) - "Given a list of AREAS and formatting PROPS, align according to RULE. -AREAS should be a list of cons cells containing beginning and ending -markers. This function sweeps through all of the beginning markers, -finds out which one starts in the furthermost column, and then deletes -and inserts text such that all of the ending markers occur in the same -column. - -If FUNC is non-nil, it will be called for each text region that would -have been aligned. No changes will be made to the buffer." - (let* ((column (cdr (assq 'column rule))) - (fixed (if (symbolp column) - (symbol-value column) - column)) - (justify (cdr (assq 'justify rule))) - (col (or fixed 0)) - (width 0) - ecol change look) - - ;; Determine the alignment column. - (let ((a areas)) - (while a - (unless fixed - (setq col (max col (align-column (caar a))))) - (unless change - (goto-char (cdar a)) - (if ecol - (if (/= ecol (current-column)) - (setq change t)) - (setq ecol (current-column)))) - (when justify - (goto-char (caar a)) - (if (and (re-search-forward "\\s-*" (cdar a) t) - (/= (point) (cdar a))) - (let ((bcol (current-column))) - (setcdr (car a) (cons (point-marker) (cdar a))) - (goto-char (cdr (cdar a))) - (setq width (max width (- (current-column) bcol)))))) - (setq a (cdr a)))) - - (unless fixed - (setq col (+ (align-adjust-col-for-rule - col rule (car props) (cdr props)) width))) - - ;; Make all ending positions to occur in the goal column. Since - ;; the whitespace to be modified was already deleted by - ;; `align-region', all we have to do here is indent. - - (unless change - (setq change (and ecol (/= col ecol)))) - - (when (or func change) - (while areas - (let ((area (car areas)) - (gocol col) cur) - (when area - (if func - (funcall func (car area) (cdr area) change) - (if (not (and justify - (consp (cdr area)))) - (goto-char (cdr area)) - (goto-char (cddr area)) - (let ((ecol (current-column))) - (goto-char (cadr area)) - (setq gocol (- col (- ecol (current-column)))))) - (setq cur (current-column)) - (cond ((< gocol 0) t) ; don't do anything - ((= cur gocol) t) ; don't need to - ((< cur gocol) ; just add space - (indent-to gocol)) - (t - ;; This code works around an oddity in the - ;; FORCE argument of `move-to-column', which - ;; tends to screw up markers if there is any - ;; tabbing. - (let ((endcol (align-column - (if (and justify - (consp (cdr area))) - (cadr area) - (cdr area)))) - (abuts (<= gocol - (align-column (car area))))) - (if abuts - (goto-char (car area)) - (move-to-column gocol t)) - (let ((here (point))) - (move-to-column endcol t) - (delete-region here (point)) - (if abuts - (indent-to (align-adjust-col-for-rule - (current-column) rule - (car props) (cdr props))))))))))) - (setq areas (cdr areas)))))) - -(defun align-region (beg end separate rules exclude-rules - &optional func) - "Align a region based on a given set of alignment rules. -BEG and END specify the region to be aligned. Either may be nil, in -which case the range will stop at the nearest section division (see -`align-region-separate', and `align-region-heuristic' for more -information'). - -The region will be divided into separate alignment sections based on -the value of SEPARATE. - -RULES and EXCLUDE-RULES are a pair of lists describing how to align -the region, and which text areas within it should be excluded from -alignment. See the `align-rules-list' for more information on the -required format of these two lists. - -If FUNC is specified, no text will be modified. What `align-region' -will do with the rules is to search for the alignment areas, as it -regularly would, taking account for exclusions, and then call FUNC, -first with the beginning and ending of the region to be aligned -according to that rule (this can be different for each rule, if BEG -and END were nil), and then with the beginning and ending of each -text region that the rule would have applied to. - -The signature of FUNC should thus be: - - (defun my-align-function (beg end mode) - \"If MODE is a rule (a list), return t if BEG to END are to be searched. -Otherwise BEG to END will be a region of text that matches the rule's -definition, and MODE will be non-nil if any changes are necessary.\" - (unless (and mode (listp mode)) - (message \"Would have aligned from %d to %d...\" beg end))) - -This feature (of passing a FUNC) is used internally to locate the -position of exclusion areas, but could also be used for any other -purpose where you might want to know where the regions that the -aligner would have dealt with are." - (let ((end-mark (and end (copy-marker end t))) - (real-beg beg) - (real-end end) - (report (and (not func) align-large-region beg end - (>= (- end beg) align-large-region))) - (rule-index 1) - (rule-count (length rules))) - (if (and align-indent-before-aligning real-beg end-mark) - (indent-region real-beg end-mark nil)) - (while rules - (let* ((rule (car rules)) - (run-if (assq 'run-if rule)) - (modes (assq 'modes rule))) - ;; unless the `run-if' form tells us not to, look for the - ;; rule.. - (unless (or (and modes (not (memq major-mode - (eval (cdr modes))))) - (and run-if (not (funcall (cdr run-if))))) - (let* ((current-case-fold case-fold-search) - (case-fold (assq 'case-fold rule)) - (regexp (cdr (assq 'regexp rule))) - (regfunc (and (functionp regexp) regexp)) - (rulesep (assq 'separate rule)) - (thissep (if rulesep (cdr rulesep) separate)) - same (eol 0) - group group-c - spacing spacing-c - tab-stop tab-stop-c - repeat repeat-c - valid valid-c - pos-list first - regions index - last-point b e - save-match-data - exclude-p - align-props) - (save-excursion - ;; if beg and end were not given, figure out what the - ;; current alignment region should be. Depending on the - ;; value of `align-region-separate' it's possible for - ;; each rule to have its own definition of what that - ;; current alignment section is. - (if real-beg - (goto-char beg) - (if (or (not thissep) (eq thissep 'entire)) - (error "Cannot determine alignment region for '%s'" - (symbol-name (cdr (assq 'title rule))))) - (beginning-of-line) - (while (and (not (eobp)) - (looking-at "^\\s-*$")) - (forward-line)) - (let* ((here (point)) - (start here)) - (while (and here - (let ((terminus - (and align-region-heuristic - (- (point) - align-region-heuristic)))) - (if regfunc - (funcall regfunc terminus t) - (re-search-backward regexp - terminus t)))) - (if (align-new-section-p (point) here thissep) - (setq beg here - here nil) - (setq here (point)))) - (if (not here) - (goto-char beg)) - (beginning-of-line) - (setq beg (point)) - (goto-char start) - (setq here (point)) - (while (and here - (let ((terminus - (and align-region-heuristic - (+ (point) - align-region-heuristic)))) - (if regfunc - (funcall regfunc terminus nil) - (re-search-forward regexp terminus t)))) - (if (align-new-section-p here (point) thissep) - (setq end here - here nil) - (setq here (point)))) - (if (not here) - (goto-char end)) - (forward-line) - (setq end (point) - end-mark (copy-marker end t)) - (goto-char beg))) - - ;; If we have a region to align, and `func' is set and - ;; reports back that the region is ok, then align it. - (when (or (not func) - (funcall func beg end rule)) - (unwind-protect - (let (exclude-areas) - ;; determine first of all where the exclusions - ;; lie in this region - (when exclude-rules - ;; guard against a problem with recursion and - ;; dynamic binding vs. lexical binding, since - ;; the call to `align-region' below will - ;; re-enter this function, and rebind - ;; `exclude-areas' - (set (setq exclude-areas - (make-symbol "align-exclude-areas")) - nil) - (align-region - beg end 'entire - exclude-rules nil - `(lambda (b e mode) - (or (and mode (listp mode)) - (set (quote ,exclude-areas) - (cons (cons b e) - ,exclude-areas))))) - (setq exclude-areas - (sort (symbol-value exclude-areas) - (function - (lambda (l r) - (>= (car l) (car r))))))) - - ;; set `case-fold-search' according to the - ;; (optional) `case-fold' property - (and case-fold - (setq case-fold-search (cdr case-fold))) - - ;; while we can find the rule in the alignment - ;; region.. - (while (and (< (point) end-mark) - (if regfunc - (funcall regfunc end-mark nil) - (re-search-forward regexp - end-mark t))) - - ;; give the user some indication of where we - ;; are, if it's a very large region being - ;; aligned - (if report - (let ((symbol (car rule))) - (if (and symbol (symbolp symbol)) - (message - "Aligning `%s' (rule %d of %d) %d%%..." - (symbol-name symbol) rule-index rule-count - (/ (* (- (point) real-beg) 100) - (- end-mark real-beg))) - (message - "Aligning %d%%..." - (/ (* (- (point) real-beg) 100) - (- end-mark real-beg)))))) - - ;; if the search ended us on the beginning of - ;; the next line, move back to the end of the - ;; previous line. - (if (bolp) - (forward-char -1)) - - ;; lookup the `group' attribute the first time - ;; that we need it - (unless group-c - (setq group (or (cdr (assq 'group rule)) 1)) - (if (listp group) - (setq first (car group)) - (setq first group group (list group))) - (setq group-c t)) - - (unless spacing-c - (setq spacing (cdr (assq 'spacing rule)) - spacing-c t)) - - (unless tab-stop-c - (setq tab-stop - (let ((rule-ts (assq 'tab-stop rule))) - (if rule-ts - (cdr rule-ts) - (if (symbolp align-to-tab-stop) - (symbol-value align-to-tab-stop) - align-to-tab-stop))) - tab-stop-c t)) - - ;; test whether we have found a match on the same - ;; line as a previous match - (if (> (point) eol) - (setq same nil - eol (save-excursion - (end-of-line) - (point-marker)))) - - ;; lookup the `repeat' attribute the first time - (or repeat-c - (setq repeat (cdr (assq 'repeat rule)) - repeat-c t)) - - ;; lookup the `valid' attribute the first time - (or valid-c - (setq valid (assq 'valid rule) - valid-c t)) - - ;; remember the beginning position of this rule - ;; match, and save the match-data, since either - ;; the `valid' form, or the code that searches for - ;; section separation, might alter it - (setq b (match-beginning first) - save-match-data (match-data)) - - ;; unless the `valid' attribute is set, and tells - ;; us that the rule is not valid at this point in - ;; the code.. - (unless (and valid (not (funcall (cdr valid)))) - - ;; look to see if this match begins a new - ;; section. If so, we should align what we've - ;; collected so far, and then begin collecting - ;; anew for the next alignment section - (if (and last-point - (align-new-section-p last-point b - thissep)) - (progn - (align-regions regions align-props - rule func) - (setq last-point (copy-marker b t) - regions nil - align-props nil)) - (setq last-point (copy-marker b t))) - - ;; restore the match data - (set-match-data save-match-data) - - ;; check whether the region to be aligned - ;; straddles an exclusion area - (let ((excls exclude-areas)) - (setq exclude-p nil) - (while excls - (if (and (< (match-beginning (car group)) - (cdar excls)) - (> (match-end (car (last group))) - (caar excls))) - (setq exclude-p t - excls nil) - (setq excls (cdr excls))))) - - ;; go through the list of parenthesis groups - ;; matching whitespace text to be - ;; contracted/expanded (or possibly - ;; justified, if the `justify' attribute was - ;; set) - (unless exclude-p - (let ((g group)) - (while g - - ;; we have to use markers, since - ;; `align-areas' may modify the buffer - (setq b (copy-marker - (match-beginning (car g)) t) - e (copy-marker (match-end (car g)) t)) - - ;; record this text region for alignment - (setq index (if same (1+ index) 0)) - (let ((region (cons b e)) - (props (cons - (if (listp spacing) - (car spacing) - spacing) - (if (listp tab-stop) - (car tab-stop) - tab-stop)))) - (if (nth index regions) - (setcar (nthcdr index regions) - (cons region - (nth index regions))) - (if regions - (progn - (nconc regions - (list (list region))) - (nconc align-props (list props))) - (setq regions - (list (list region))) - (setq align-props (list props))))) - - ;; if any further rule matches are - ;; found before `eol', then they are - ;; on the same line as this one; this - ;; can only happen if the `repeat' - ;; attribute is non-nil - (if (listp spacing) - (setq spacing (cdr spacing))) - (if (listp tab-stop) - (setq tab-stop (cdr tab-stop))) - (setq same t g (cdr g)))) - - ;; if `repeat' has not been set, move to - ;; the next line; don't bother searching - ;; anymore on this one - (if (and (not repeat) (not (bolp))) - (forward-line))))) - - ;; when they are no more matches for this rule, - ;; align whatever was left over - (if regions - (align-regions regions align-props rule func))) - - (setq case-fold-search current-case-fold))))))) - (setq rules (cdr rules) - rule-index (1+ rule-index))) - - (if report - (message "Aligning...done")))) - -;; Provide: - -(provide 'align) - -(run-hooks 'align-load-hook) - -;;; arch-tag: ef79cccf-1db8-4888-a8a1-d7ce2d1532f7 -;;; align.el ends here diff --git a/xemacs-packages/lisp/edit-utils/allout.el b/xemacs-packages/lisp/edit-utils/allout.el deleted file mode 100644 index 8f53c9c8..00000000 --- a/xemacs-packages/lisp/edit-utils/allout.el +++ /dev/null @@ -1,4773 +0,0 @@ -;;; allout.el --- extensive outline mode for use alone and with other modes - -;; Copyright (C) 1992, 1993, 1994, 2001 Free Software Foundation, Inc. - -;; Author: Ken Manheimer -;; Maintainer: Ken Manheimer -;; Created: Dec 1991 - first release to usenet -;; Version: $Id: allout.el,v 1.1 2003/08/07 14:16:11 j_colman Exp $|| -;; Keywords: outline mode wp languages - -;; 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: - -;; Allout outline mode provides extensive outline formatting and -;; and manipulation beyond standard emacs outline mode. It provides -;; for structured editing of outlines, as well as navigation and -;; exposure. It also provides for syntax-sensitive text like -;; programming languages. (For an example, see the allout code -;; itself, which is organized in ;; an outline framework.) -;; -;; In addition to outline navigation and exposure, allout includes: -;; -;; - topic-oriented repositioning, cut, and paste -;; - integral outline exposure-layout -;; - incremental search with dynamic exposure and reconcealment of hidden text -;; - automatic topic-number maintenance -;; - "Hot-spot" operation, for single-keystroke maneuvering and -;; exposure control. (See the outline-mode docstring.) -;; -;; and many other features. -;; -;; The outline menubar additions provide quick reference to many of -;; the features, and see the docstring of the variable `outline-init' -;; for instructions on priming your emacs session for automatic -;; activation of outline-mode. -;; -;; See the docstring of the variables `outline-layout' and -;; `outline-auto-activation' for details on automatic activation of -;; allout outline-mode as a minor mode. (It has changed since allout -;; 3.x, for those of you that depend on the old method.) -;; -;; Note - the lines beginning with `;;;_' are outline topic headers. -;; Just `ESC-x eval-current-buffer' to give it a whirl. - -;; Ken Manheimer klm@zope.com - -;;; Code: - -;;;_* Provide -(provide 'outline) -(provide 'allout) - -;;;_* USER CUSTOMIZATION VARIABLES: -(defgroup allout nil - "Extensive outline mode for use alone and with other modes." - :prefix "outline-" - :group 'outlines) - -;;;_ + Layout, Mode, and Topic Header Configuration - -;;;_ = outline-auto-activation -(defcustom outline-auto-activation nil - "*Regulates auto-activation modality of allout outlines - see `outline-init'. - -Setq-default by `outline-init' to regulate whether or not allout -outline mode is automatically activated when the buffer-specific -variable `outline-layout' is non-nil, and whether or not the layout -dictated by `outline-layout' should be imposed on mode activation. - -With value `t', auto-mode-activation and auto-layout are enabled. -\(This also depends on `outline-find-file-hooks' being installed in -`find-file-hooks', which is also done by `outline-init'.) - -With value `ask', auto-mode-activation is enabled, and endorsement for -performing auto-layout is asked of the user each time. - -With value `activate', only auto-mode-activation is enabled, -auto-layout is not. - -With value `nil', neither auto-mode-activation nor auto-layout are -enabled. - -See the docstring for `outline-init' for the proper interface to -this variable." - :type '(choice (const :tag "On" t) - (const :tag "Ask about layout" "ask") - (const :tag "Mode only" "activate") - (const :tag "Off" nil)) - :group 'allout) -;;;_ = outline-layout -(defvar outline-layout nil - "*Layout specification and provisional mode trigger for allout outlines. - -Buffer-specific. - -A list value specifies a default layout for the current buffer, to be -applied upon activation of allout outline-mode. Any non-nil value will -automatically trigger allout outline-mode, provided `outline-init' -has been called to enable it. - -See the docstring for `outline-init' for details on setting up for -auto-mode-activation, and for `outline-expose-topic' for the format of -the layout specification. - -You can associate a particular outline layout with a file by setting -this var via the file's local variables. For example, the following -lines at the bottom of an Emacs Lisp file: - -;;;Local variables: -;;;outline-layout: \(0 : -1 -1 0) -;;;End: - -will, modulo the above-mentioned conditions, cause the mode to be -activated when the file is visited, followed by the equivalent of -`\(outline-expose-topic 0 : -1 -1 0)'. \(This is the layout used for -the allout.el, itself.) - -Also, allout's mode-specific provisions will make topic prefixes default -to the comment-start string, if any, of the language of the file. This -is modulo the setting of `outline-use-mode-specific-leader', which see.") -(make-variable-buffer-local 'outline-layout) -;;;_ = outline-show-bodies -(defcustom outline-show-bodies nil - "*If non-nil, show entire body when exposing a topic, rather than -just the header." - :type 'boolean - :group 'allout) -(make-variable-buffer-local 'outline-show-bodies) - -;;;_ = outline-header-prefix -(defcustom outline-header-prefix "." - "*Leading string which helps distinguish topic headers. - -Outline topic header lines are identified by a leading topic -header prefix, which mostly have the value of this var at their front. -\(Level 1 topics are exceptions. They consist of only a single -character, which is typically set to the outline-primary-bullet. Many -outlines start at level 2 to avoid this discrepancy." - :type 'string - :group 'allout) -(make-variable-buffer-local 'outline-header-prefix) -;;;_ = outline-primary-bullet -(defcustom outline-primary-bullet "*" - "Bullet used for top-level outline topics. - -Outline topic header lines are identified by a leading topic header -prefix, which is concluded by bullets that includes the value of this -var and the respective outline-*-bullets-string vars. - -The value of an asterisk (`*') provides for backwards compatibility -with the original emacs outline mode. See outline-plain-bullets-string -and outline-distinctive-bullets-string for the range of available -bullets." - :type 'string - :group 'allout) -(make-variable-buffer-local 'outline-primary-bullet) -;;;_ = outline-plain-bullets-string -(defcustom outline-plain-bullets-string ".:,;" - "*The bullets normally used in outline topic prefixes. - -See `outline-distinctive-bullets-string' for the other kind of -bullets. - -DO NOT include the close-square-bracket, `]', as a bullet. - -Outline mode has to be reactivated in order for changes to the value -of this var to take effect." - :type 'string - :group 'allout) -(make-variable-buffer-local 'outline-plain-bullets-string) -;;;_ = outline-distinctive-bullets-string -(defcustom outline-distinctive-bullets-string "*+-=>([{}&!?#%\"X@$~_\\" - "*Persistent outline header bullets used to distinguish special topics. - -These bullets are used to distinguish topics from the run-of-the-mill -ones. They are not used in the standard topic headers created by -the topic-opening, shifting, and rebulleting \(eg, on topic shift, -topic paste, blanket rebulleting) routines, but are offered among the -choices for rebulleting. They are not altered by the above automatic -rebulleting, so they can be used to characterize topics, eg: - - `?' question topics - `\(' parenthetic comment \(with a matching close paren inside) - `[' meta-note \(with a matching close ] inside) - `\"' a quote - `=' value settings - `~' \"more or less\" - -... just for example. (`#' typically has a special meaning to the -software, according to the value of `outline-numbered-bullet'.) - -See `outline-plain-bullets-string' for the selection of -alternating bullets. - -You must run `set-outline-regexp' in order for outline mode to -reconcile to changes of this value. - -DO NOT include the close-square-bracket, `]', on either of the bullet -strings." - :type 'string - :group 'allout) -(make-variable-buffer-local 'outline-distinctive-bullets-string) - -;;;_ = outline-use-mode-specific-leader -(defcustom outline-use-mode-specific-leader t - "*When non-nil, use mode-specific topic-header prefixes. - -Allout outline mode will use the mode-specific `outline-mode-leaders' -and/or comment-start string, if any, to lead the topic prefix string, -so topic headers look like comments in the programming language. - -String values are used as they stand. - -Value `t' means to first check for assoc value in `outline-mode-leaders' -alist, then use comment-start string, if any, then use default \(`.'). -\(See note about use of comment-start strings, below.) - -Set to the symbol for either of `outline-mode-leaders' or -`comment-start' to use only one of them, respectively. - -Value `nil' means to always use the default \(`.'). - -comment-start strings that do not end in spaces are tripled, and an -`_' underscore is tacked on the end, to distinguish them from regular -comment strings. comment-start strings that do end in spaces are not -tripled, but an underscore is substituted for the space. [This -presumes that the space is for appearance, not comment syntax. You -can use `outline-mode-leaders' to override this behavior, when -incorrect.]" - :type '(choice (const t) (const nil) string - (const outline-mode-leaders) - (const comment-start)) - :group 'allout) -;;;_ = outline-mode-leaders -(defvar outline-mode-leaders '() - "Specific outline-prefix leading strings per major modes. - -Entries will be used instead or in lieu of mode-specific -comment-start strings. See also `outline-use-mode-specific-leader'. - -If you're constructing a string that will comment-out outline -structuring so it can be included in program code, append an extra -character, like an \"_\" underscore, to distinguish the lead string -from regular comments that start at bol.") - -;;;_ = outline-old-style-prefixes -(defcustom outline-old-style-prefixes nil - "*When non-nil, use only old-and-crusty outline-mode `*' topic prefixes. - -Non-nil restricts the topic creation and modification -functions to asterix-padded prefixes, so they look exactly -like the original emacs-outline style prefixes. - -Whatever the setting of this variable, both old and new style prefixes -are always respected by the topic maneuvering functions." - :type 'boolean - :group 'allout) -(make-variable-buffer-local 'outline-old-style-prefixes) -;;;_ = outline-stylish-prefixes - alternating bullets -(defcustom outline-stylish-prefixes t - "*Do fancy stuff with topic prefix bullets according to level, etc. - -Non-nil enables topic creation, modification, and repositioning -functions to vary the topic bullet char (the char that marks the topic -depth) just preceding the start of the topic text) according to level. -Otherwise, only asterisks (`*') and distinctive bullets are used. - -This is how an outline can look (but sans indentation) with stylish -prefixes: - - * Top level - .* A topic - . + One level 3 subtopic - . . One level 4 subtopic - . . A second 4 subtopic - . + Another level 3 subtopic - . #1 A numbered level 4 subtopic - . #2 Another - . ! Another level 4 subtopic with a different distinctive bullet - . #4 And another numbered level 4 subtopic - -This would be an outline with stylish prefixes inhibited (but the -numbered and other distinctive bullets retained): - - * Top level - .* A topic - . * One level 3 subtopic - . * One level 4 subtopic - . * A second 4 subtopic - . * Another level 3 subtopic - . #1 A numbered level 4 subtopic - . #2 Another - . ! Another level 4 subtopic with a different distinctive bullet - . #4 And another numbered level 4 subtopic - -Stylish and constant prefixes (as well as old-style prefixes) are -always respected by the topic maneuvering functions, regardless of -this variable setting. - -The setting of this var is not relevant when outline-old-style-prefixes -is non-nil." - :type 'boolean - :group 'allout) -(make-variable-buffer-local 'outline-stylish-prefixes) - -;;;_ = outline-numbered-bullet -(defcustom outline-numbered-bullet "#" - "*String designating bullet of topics that have auto-numbering; nil for none. - -Topics having this bullet have automatic maintenance of a sibling -sequence-number tacked on, just after the bullet. Conventionally set -to \"#\", you can set it to a bullet of your choice. A nil value -disables numbering maintenance." - :type '(choice (const nil) string) - :group 'allout) -(make-variable-buffer-local 'outline-numbered-bullet) -;;;_ = outline-file-xref-bullet -(defcustom outline-file-xref-bullet "@" - "*Bullet signifying file cross-references, for `outline-resolve-xref'. - -Set this var to the bullet you want to use for file cross-references." - :type '(choice (const nil) string) - :group 'allout) - -;;;_ = outline-presentation-padding -(defcustom outline-presentation-padding 2 - "*Presentation-format white-space padding factor, for greater indent." - :type 'integer - :group 'allout) - -(make-variable-buffer-local 'outline-presentation-padding) - -;;;_ = outline-abbreviate-flattened-numbering -(defcustom outline-abbreviate-flattened-numbering nil - "*If non-nil, `outline-flatten-exposed-to-buffer' abbreviates topic -numbers to minimal amount with some context. Otherwise, entire -numbers are always used." - :type 'boolean - :group 'allout) - -;;;_ + LaTeX formatting -;;;_ - outline-number-pages -(defcustom outline-number-pages nil - "*Non-nil turns on page numbering for LaTeX formatting of an outline." - :type 'boolean - :group 'allout) -;;;_ - outline-label-style -(defcustom outline-label-style "\\large\\bf" - "*Font and size of labels for LaTeX formatting of an outline." - :type 'string - :group 'allout) -;;;_ - outline-head-line-style -(defcustom outline-head-line-style "\\large\\sl " - "*Font and size of entries for LaTeX formatting of an outline." - :type 'string - :group 'allout) -;;;_ - outline-body-line-style -(defcustom outline-body-line-style " " - "*Font and size of entries for LaTeX formatting of an outline." - :type 'string - :group 'allout) -;;;_ - outline-title-style -(defcustom outline-title-style "\\Large\\bf" - "*Font and size of titles for LaTeX formatting of an outline." - :type 'string - :group 'allout) -;;;_ - outline-title -(defcustom outline-title '(or buffer-file-name (current-buffer-name)) - "*Expression to be evaluated to determine the title for LaTeX -formatted copy." - :type 'sexp - :group 'allout) -;;;_ - outline-line-skip -(defcustom outline-line-skip ".05cm" - "*Space between lines for LaTeX formatting of an outline." - :type 'string - :group 'allout) -;;;_ - outline-indent -(defcustom outline-indent ".3cm" - "*LaTeX formatted depth-indent spacing." - :type 'string - :group 'allout) - -;;;_ + Miscellaneous customization - -;;;_ = outline-command-prefix -(defcustom outline-command-prefix "\C-c" - "*Key sequence to be used as prefix for outline mode command key bindings." - :type 'string - :group 'allout) - -;;;_ = outline-keybindings-list -;;; You have to reactivate outline-mode - `(outline-mode t)' - to -;;; institute changes to this var. -(defvar outline-keybindings-list () - "*List of outline-mode key / function bindings, for outline-mode-map. - -String or vector key will be prefaced with outline-command-prefix, -unless optional third, non-nil element is present.") -(setq outline-keybindings-list - '( - ; Motion commands: - ("\C-n" outline-next-visible-heading) - ("\C-p" outline-previous-visible-heading) - ("\C-u" outline-up-current-level) - ("\C-f" outline-forward-current-level) - ("\C-b" outline-backward-current-level) - ("\C-a" outline-beginning-of-current-entry) - ("\C-e" outline-end-of-current-entry) - ; Exposure commands: - ("\C-i" outline-show-children) - ("\C-s" outline-show-current-subtree) - ("\C-h" outline-hide-current-subtree) - ("\C-o" outline-show-current-entry) - ("!" outline-show-all) - ; Alteration commands: - (" " outline-open-sibtopic) - ("." outline-open-subtopic) - ("," outline-open-supertopic) - ("'" outline-shift-in) - (">" outline-shift-in) - ("<" outline-shift-out) - ("\C-m" outline-rebullet-topic) - ("*" outline-rebullet-current-heading) - ("#" outline-number-siblings) - ("\C-k" outline-kill-line t) - ("\C-y" outline-yank t) - ("\M-y" outline-yank-pop t) - ("\C-k" outline-kill-topic) - ; Miscellaneous commands: - ;([?\C-\ ] outline-mark-topic) - ("@" outline-resolve-xref) - ("=c" outline-copy-exposed-to-buffer) - ("=i" outline-indented-exposed-to-buffer) - ("=t" outline-latexify-exposed) - ("=p" outline-flatten-exposed-to-buffer))) - -;;;_ = outline-isearch-dynamic-expose -(defcustom outline-isearch-dynamic-expose t - "*Non-nil enable dynamic exposure of hidden incremental-search -targets as they're encountered." - :type 'boolean - :group 'allout) -(make-variable-buffer-local 'outline-isearch-dynamic-expose) - -;;;_ = outline-use-hanging-indents -(defcustom outline-use-hanging-indents t - "*If non-nil, topic body text auto-indent defaults to indent of the header. -Ie, it is indented to be just past the header prefix. This is -relevant mostly for use with indented-text-mode, or other situations -where auto-fill occurs. - -\[This feature no longer depends in any way on the `filladapt.el' -lisp-archive package.\]" - :type 'boolean - :group 'allout) -(make-variable-buffer-local 'outline-use-hanging-indents) - -;;;_ = outline-reindent-bodies -(defcustom outline-reindent-bodies (if outline-use-hanging-indents - 'text) - "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts. - -When active, topic body lines that are indented even with or beyond -their topic header are reindented to correspond with depth shifts of -the header. - -A value of `t' enables reindent in non-programming-code buffers, ie -those that do not have the variable `comment-start' set. A value of -`force' enables reindent whether or not `comment-start' is set." - :type '(choice (const nil) (const t) (const text) (const force)) - :group 'allout) - -(make-variable-buffer-local 'outline-reindent-bodies) - -;;;_ = outline-inhibit-protection -(defcustom outline-inhibit-protection nil - "*Non-nil disables warnings and confirmation-checks for concealed-text edits. - -Outline mode uses emacs change-triggered functions to detect unruly -changes to concealed regions. Set this var non-nil to disable the -protection, potentially increasing text-entry responsiveness a bit. - -This var takes effect at outline-mode activation, so you may have to -deactivate and then reactivate the mode if you want to toggle the -behavior." - :type 'boolean - :group 'allout) - -;;;_* CODE - no user customizations below. - -;;;_ #1 Internal Outline Formatting and Configuration -;;;_ : Version -;;;_ = outline-version -(defvar outline-version - (let ((rcs-rev "$Revision: 1.1 $")) - (condition-case err - (save-match-data - (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) - (substring rcs-rev (match-beginning 1) (match-end 1))) - ('error rcs-rev))) - "Revision number of currently loaded outline package. \(allout.el)") -;;;_ > outline-version -(defun outline-version (&optional here) - "Return string describing the loaded outline version." - (interactive "P") - (let ((msg (concat "Allout Outline Mode v " outline-version))) - (if here (insert-string msg)) - (message "%s" msg) - msg)) -;;;_ : Topic header format -;;;_ = outline-regexp -(defvar outline-regexp "" - "*Regular expression to match the beginning of a heading line. - -Any line whose beginning matches this regexp is considered a -heading. This var is set according to the user configuration vars -by set-outline-regexp.") -(make-variable-buffer-local 'outline-regexp) -;;;_ = outline-bullets-string -(defvar outline-bullets-string "" - "A string dictating the valid set of outline topic bullets. - -This var should *not* be set by the user - it is set by `set-outline-regexp', -and is produced from the elements of `outline-plain-bullets-string' -and `outline-distinctive-bullets-string'.") -(make-variable-buffer-local 'outline-bullets-string) -;;;_ = outline-bullets-string-len -(defvar outline-bullets-string-len 0 - "Length of current buffers' outline-plain-bullets-string.") -(make-variable-buffer-local 'outline-bullets-string-len) -;;;_ = outline-line-boundary-regexp -(defvar outline-line-boundary-regexp () - "Outline-regexp with outline-style beginning-of-line anchor. - -\(Ie, C-j, *or* C-m, for prefixes of hidden topics). This is properly -set when outline-regexp is produced by `set-outline-regexp', so -that (match-beginning 2) and (match-end 2) delimit the prefix.") -(make-variable-buffer-local 'outline-line-boundary-regexp) -;;;_ = outline-bob-regexp -(defvar outline-bob-regexp () - "Like outline-line-boundary-regexp, for headers at beginning of buffer. -\(match-beginning 2) and \(match-end 2) delimit the prefix.") -(make-variable-buffer-local 'outline-bob-regexp) -;;;_ = outline-header-subtraction -(defvar outline-header-subtraction (1- (length outline-header-prefix)) - "Outline-header prefix length to subtract when computing topic depth.") -(make-variable-buffer-local 'outline-header-subtraction) -;;;_ = outline-plain-bullets-string-len -(defvar outline-plain-bullets-string-len (length outline-plain-bullets-string) - "Length of outline-plain-bullets-string, updated by set-outline-regexp.") -(make-variable-buffer-local 'outline-plain-bullets-string-len) - - -;;;_ X outline-reset-header-lead (header-lead) -(defun outline-reset-header-lead (header-lead) - "*Reset the leading string used to identify topic headers." - (interactive "sNew lead string: ") - (setq outline-header-prefix header-lead) - (setq outline-header-subtraction (1- (length outline-header-prefix))) - (set-outline-regexp)) -;;;_ X outline-lead-with-comment-string (header-lead) -(defun outline-lead-with-comment-string (&optional header-lead) - "*Set the topic-header leading string to specified string. - -Useful when for encapsulating outline structure in programming -language comments. Returns the leading string." - - (interactive "P") - (if (not (stringp header-lead)) - (setq header-lead (read-string - "String prefix for topic headers: "))) - (setq outline-reindent-bodies nil) - (outline-reset-header-lead header-lead) - header-lead) -;;;_ > outline-infer-header-lead () -(defun outline-infer-header-lead () - "Determine appropriate `outline-header-prefix'. - -Works according to settings of: - - `comment-start' - `outline-header-prefix' (default) - `outline-use-mode-specific-leader' -and `outline-mode-leaders'. - -Apply this via \(re)activation of `outline-mode', rather than -invoking it directly." - (let* ((use-leader (and (boundp 'outline-use-mode-specific-leader) - (if (or (stringp outline-use-mode-specific-leader) - (memq outline-use-mode-specific-leader - '(outline-mode-leaders - comment-start - t))) - outline-use-mode-specific-leader - ;; Oops - garbled value, equate with effect of 't: - t))) - (leader - (cond - ((not use-leader) nil) - ;; Use the explicitly designated leader: - ((stringp use-leader) use-leader) - (t (or (and (memq use-leader '(t outline-mode-leaders)) - ;; Get it from outline mode leaders? - (cdr (assq major-mode outline-mode-leaders))) - ;; ... didn't get from outline-mode-leaders... - (and (memq use-leader '(t comment-start)) - comment-start - ;; Use comment-start, maybe tripled, and with - ;; underscore: - (concat - (if (string= " " - (substring comment-start - (1- (length comment-start)))) - ;; Use comment-start, sans trailing space: - (substring comment-start 0 -1) - (concat comment-start comment-start comment-start)) - ;; ... and append underscore, whichever: - "_"))))))) - (if (not leader) - nil - (if (string= leader outline-header-prefix) - nil ; no change, nothing to do. - (setq outline-header-prefix leader) - outline-header-prefix)))) -;;;_ > outline-infer-body-reindent () -(defun outline-infer-body-reindent () - "Determine proper setting for `outline-reindent-bodies'. - -Depends on default setting of `outline-reindent-bodies' \(which see) -and presence of setting for `comment-start', to tell whether the -file is programming code." - (if (and outline-reindent-bodies - comment-start - (not (eq 'force outline-reindent-bodies))) - (setq outline-reindent-bodies nil))) -;;;_ > set-outline-regexp () -(defun set-outline-regexp () - "Generate proper topic-header regexp form for outline functions. - -Works with respect to `outline-plain-bullets-string' and -`outline-distinctive-bullets-string'." - - (interactive) - ;; Derive outline-bullets-string from user configured components: - (setq outline-bullets-string "") - (let ((strings (list 'outline-plain-bullets-string - 'outline-distinctive-bullets-string - 'outline-primary-bullet)) - cur-string - cur-len - cur-char - cur-char-string - index - new-string) - (while strings - (setq new-string "") (setq index 0) - (setq cur-len (length (setq cur-string (symbol-value (car strings))))) - (while (< index cur-len) - (setq cur-char (aref cur-string index)) - (setq outline-bullets-string - (concat outline-bullets-string - (cond - ; Single dash would denote a - ; sequence, repeated denotes - ; a dash: - ((eq cur-char ?-) "--") - ; literal close-square-bracket - ; doesn't work right in the - ; expr, exclude it: - ((eq cur-char ?\]) "") - (t (regexp-quote (char-to-string cur-char)))))) - (setq index (1+ index))) - (setq strings (cdr strings))) - ) - ;; Derive next for repeated use in outline-pending-bullet: - (setq outline-plain-bullets-string-len (length outline-plain-bullets-string)) - (setq outline-header-subtraction (1- (length outline-header-prefix))) - ;; Produce the new outline-regexp: - (setq outline-regexp (concat "\\(\\" - outline-header-prefix - "[ \t]*[" - outline-bullets-string - "]\\)\\|\\" - outline-primary-bullet - "+\\|\^l")) - (setq outline-line-boundary-regexp - (concat "\\([\n\r]\\)\\(" outline-regexp "\\)")) - (setq outline-bob-regexp - (concat "\\(\\`\\)\\(" outline-regexp "\\)")) - ) -;;;_ : Key bindings -;;;_ = outline-mode-map -(defvar outline-mode-map nil "Keybindings for (allout) outline minor mode.") -;;;_ > produce-outline-mode-map (keymap-alist &optional base-map) -(defun produce-outline-mode-map (keymap-list &optional base-map) - "Produce keymap for use as outline-mode-map, from keymap-list. - -Built on top of optional BASE-MAP, or empty sparse map if none specified. -See doc string for outline-keybindings-list for format of binding list." - (let ((map (or base-map (make-sparse-keymap))) - (pref (list outline-command-prefix))) - (mapcar (function - (lambda (cell) - (let ((add-pref (null (cdr (cdr cell)))) - (key-suff (list (car cell)))) - (apply 'define-key - (list map - (apply 'concat (if add-pref - (append pref key-suff) - key-suff)) - (car (cdr cell))))))) - keymap-list) - map)) -;;;_ = outline-prior-bindings - being deprecated. -(defvar outline-prior-bindings nil - "Variable for use in V18, with outline-added-bindings, for -resurrecting, on mode deactivation, bindings that existed before -activation. Being deprecated.") -;;;_ = outline-added-bindings - being deprecated -(defvar outline-added-bindings nil - "Variable for use in V18, with outline-prior-bindings, for -resurrecting, on mode deactivation, bindings that existed before -activation. Being deprecated.") -;;;_ : Menu bar -(defun produce-outline-mode-menubar-entries () - (require 'easymenu) - (easy-menu-define outline-mode-exposure-menu - outline-mode-map - "Allout outline exposure menu." - '("Exposure" - ["Show Entry" outline-show-current-entry t] - ["Show Children" outline-show-children t] - ["Show Subtree" outline-show-current-subtree t] - ["Hide Subtree" outline-hide-current-subtree t] - ["Hide Leaves" outline-hide-current-leaves t] - "----" - ["Show All" outline-show-all t])) - (easy-menu-define outline-mode-editing-menu - outline-mode-map - "Allout outline editing menu." - '("Headings" - ["Open Sibling" outline-open-sibtopic t] - ["Open Subtopic" outline-open-subtopic t] - ["Open Supertopic" outline-open-supertopic t] - "----" - ["Shift Topic In" outline-shift-in t] - ["Shift Topic Out" outline-shift-out t] - ["Rebullet Topic" outline-rebullet-topic t] - ["Rebullet Heading" outline-rebullet-current-heading t] - ["Number Siblings" outline-number-siblings t])) - (easy-menu-define outline-mode-navigation-menu - outline-mode-map - "Allout outline navigation menu." - '("Navigation" - ["Next Visible Heading" outline-next-visible-heading t] - ["Previous Visible Heading" - outline-previous-visible-heading t] - "----" - ["Up Level" outline-up-current-level t] - ["Forward Current Level" outline-forward-current-level t] - ["Backward Current Level" - outline-backward-current-level t] - "----" - ["Beginning of Entry" - outline-beginning-of-current-entry t] - ["End of Entry" outline-end-of-current-entry t] - ["End of Subtree" outline-end-of-current-subtree t])) - (easy-menu-define outline-mode-misc-menu - outline-mode-map - "Allout outlines miscellaneous bindings." - '("Misc" - ["Version" outline-version t] - "----" - ["Duplicate Exposed" outline-copy-exposed-to-buffer t] - ["Duplicate Exposed, numbered" - outline-flatten-exposed-to-buffer t] - ["Duplicate Exposed, indented" - outline-indented-exposed-to-buffer t] - "----" - ["Set Header Lead" outline-reset-header-lead t] - ["Set New Exposure" outline-expose-topic t]))) -;;;_ : Mode-Specific Variable Maintenance Utilities -;;;_ = outline-mode-prior-settings -(defvar outline-mode-prior-settings nil - "Internal outline mode use; settings to be resumed on mode deactivation.") -(make-variable-buffer-local 'outline-mode-prior-settings) -;;;_ > outline-resumptions (name &optional value) -(defun outline-resumptions (name &optional value) - - "Registers or resumes settings over outline-mode activation/deactivation. - -First arg is NAME of variable affected. Optional second arg is list -containing outline-mode-specific VALUE to be imposed on named -variable, and to be registered. (It's a list so you can specify -registrations of null values.) If no value is specified, the -registered value is returned (encapsulated in the list, so the caller -can distinguish nil vs no value), and the registration is popped -from the list." - - (let ((on-list (assq name outline-mode-prior-settings)) - prior-capsule ; By `capsule' i mean a list - ; containing a value, so we can - ; distinguish nil from no value. - ) - - (if value - - ;; Registering: - (progn - (if on-list - nil ; Already preserved prior value - don't mess with it. - ;; Register the old value, or nil if previously unbound: - (setq outline-mode-prior-settings - (cons (list name - (if (boundp name) (list (symbol-value name)))) - outline-mode-prior-settings))) - ; And impose the new value, locally: - (progn (make-local-variable name) - (set name (car value)))) - - ;; Relinquishing: - (if (not on-list) - - ;; Oops, not registered - leave it be: - nil - - ;; Some registration: - ; reestablish it: - (setq prior-capsule (car (cdr on-list))) - (if prior-capsule - (set name (car prior-capsule)) ; Some prior value - reestablish it. - (makunbound name)) ; Previously unbound - demolish var. - ; Remove registration: - (let (rebuild) - (while outline-mode-prior-settings - (if (not (eq (car outline-mode-prior-settings) - on-list)) - (setq rebuild - (cons (car outline-mode-prior-settings) - rebuild))) - (setq outline-mode-prior-settings - (cdr outline-mode-prior-settings))) - (setq outline-mode-prior-settings rebuild))))) - ) -;;;_ : Mode-specific incidentals -;;;_ = outline-during-write-cue nil -(defvar outline-during-write-cue nil - "Used to inhibit outline change-protection during file write. - -See also `outline-post-command-business', `outline-write-file-hook', -`outline-before-change-protect', and `outline-post-command-business' -functions.") -;;;_ = outline-pre-was-isearching nil -(defvar outline-pre-was-isearching nil - "Cue for isearch-dynamic-exposure mechanism, implemented in -outline-pre- and -post-command-hooks.") -(make-variable-buffer-local 'outline-pre-was-isearching) -;;;_ = outline-isearch-prior-pos nil -(defvar outline-isearch-prior-pos nil - "Cue for isearch-dynamic-exposure tracking, used by outline-isearch-expose.") -(make-variable-buffer-local 'outline-isearch-prior-pos) -;;;_ = outline-isearch-did-quit -(defvar outline-isearch-did-quit nil - "Distinguishes isearch conclusion and cancellation. - -Maintained by outline-isearch-abort \(which is wrapped around the real -isearch-abort), and monitored by outline-isearch-expose for action.") -(make-variable-buffer-local 'outline-isearch-did-quit) -;;;_ = outline-override-protect nil -(defvar outline-override-protect nil - "Used in outline-mode for regulate of concealed-text protection mechanism. - -Allout outline mode regulates alteration of concealed text to protect -against inadvertent, unnoticed changes. This is for use by specific, -native outline functions to temporarily override that protection. -It's automatically reset to nil after every buffer modification.") -(make-variable-buffer-local 'outline-override-protect) -;;;_ > outline-unprotected (expr) -(defmacro outline-unprotected (expr) - "Evaluate EXPRESSION with `outline-override-protect' let-bound `t'." - `(let ((outline-override-protect t)) - ,expr)) -;;;_ = outline-undo-aggregation -(defvar outline-undo-aggregation 30 - "Amount of successive self-insert actions to bunch together per undo. - -This is purely a kludge variable, regulating the compensation for a bug in -the way that before-change-functions and undo interact.") -(make-variable-buffer-local 'outline-undo-aggregation) -;;;_ = file-var-bug hack -(defvar outline-v18/19-file-var-hack nil - "Horrible hack used to prevent invalid multiple triggering of outline -mode from prop-line file-var activation. Used by outline-mode function -to track repeats.") -;;;_ > outline-write-file-hook () -(defun outline-write-file-hook () - "In outline mode, run as a local-write-file-hooks activity. - -Currently just sets `outline-during-write-cue', so outline-change-protection -knows to keep inactive during file write." - (setq outline-during-write-cue t) - nil) - -;;;_ #2 Mode activation -;;;_ = outline-mode -(defvar outline-mode () "Allout outline mode minor-mode flag.") -(make-variable-buffer-local 'outline-mode) -;;;_ > outline-mode-p () -(defmacro outline-mode-p () - "Return t if outline-mode is active in current buffer." - 'outline-mode) -;;;_ = outline-explicitly-deactivated -(defvar outline-explicitly-deactivated nil - "Outline-mode was last deliberately deactivated. -So outline-post-command-business should not reactivate it...") -(make-variable-buffer-local 'outline-explicitly-deactivated) -;;;_ > outline-init (&optional mode) -(defun outline-init (&optional mode) - "Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'. - -MODE is one of the following symbols: - - - nil \(or no argument) deactivate auto-activation/layout; - - `activate', enable auto-activation only; - - `ask', enable auto-activation, and enable auto-layout but with - confirmation for layout operation solicited from user each time; - - `report', just report and return the current auto-activation state; - - anything else \(eg, t) for auto-activation and auto-layout, without - any confirmation check. - -Use this function to setup your emacs session for automatic activation -of allout outline mode, contingent to the buffer-specific setting of -the `outline-layout' variable. (See `outline-layout' and -`outline-expose-topic' docstrings for more details on auto layout). - -`outline-init' works by setting up (or removing) the outline-mode -find-file-hook, and giving `outline-auto-activation' a suitable -setting. - -To prime your emacs session for full auto-outline operation, include -the following two lines in your emacs init file: - -\(require 'allout) -\(outline-init t)" - - (interactive) - (if (interactive-p) - (progn - (setq mode - (completing-read - (concat "Select outline auto setup mode " - "(empty for report, ? for options) ") - '(("nil")("full")("activate")("deactivate") - ("ask") ("report") ("")) - nil - t)) - (if (string= mode "") - (setq mode 'report) - (setq mode (intern-soft mode))))) - (let - ;; convenience aliases, for consistent ref to respective vars: - ((hook 'outline-find-file-hook) - (curr-mode 'outline-auto-activation)) - - (cond ((not mode) - (setq find-file-hooks (delq hook find-file-hooks)) - (if (interactive-p) - (message "Allout outline mode auto-activation inhibited."))) - ((eq mode 'report) - (if (not (memq hook find-file-hooks)) - (outline-init nil) - ;; Just punt and use the reports from each of the modes: - (outline-init (symbol-value curr-mode)))) - (t (add-hook 'find-file-hooks hook) - (set curr-mode ; `set', not `setq'! - (cond ((eq mode 'activate) - (message - "Outline mode auto-activation enabled.") - 'activate) - ((eq mode 'report) - ;; Return the current mode setting: - (outline-init mode)) - ((eq mode 'ask) - (message - (concat "Outline mode auto-activation and " - "-layout \(upon confirmation) enabled.")) - 'ask) - ((message - "Outline mode auto-activation and -layout enabled.") - 'full))))))) - -;;;_ > outline-setup-menubar () -(defun outline-setup-menubar () - "Populate the current buffer's menubar with allout outline-mode stuff." - (let ((menus (list outline-mode-exposure-menu - outline-mode-editing-menu - outline-mode-navigation-menu - outline-mode-misc-menu)) - cur) - (while menus - (setq cur (car menus) - menus (cdr menus)) - (easy-menu-add cur)))) -;;;_ > outline-mode (&optional toggle) -;;;_ : Defun: -(defun outline-mode (&optional toggle) -;;;_ . Doc string: - "Toggle minor mode for controlling exposure and editing of text outlines. - -Optional arg forces mode to re-initialize iff arg is positive num or -symbol. Allout outline mode always runs as a minor mode. - -Allout outline mode provides extensive outline-oriented formatting and -manipulation. It enables structural editing of outlines, as well as -navigation and exposure. It also is specifically aimed at -accommodating syntax-sensitive text like programming languages. \(For -an example, see the allout code itself, which is organized as an allout -outline.) - -In addition to outline navigation and exposure, allout includes: - - - topic-oriented repositioning, cut, and paste - - integral outline exposure-layout - - incremental search with dynamic exposure and reconcealment of hidden text - - automatic topic-number maintenance - - \"Hot-spot\" operation, for single-keystroke maneuvering and - exposure control. \(See the outline-mode docstring.) - -and many other features. - -Below is a description of the bindings, and then explanation of -special outline-mode features and terminology. See also the outline -menubar additions for quick reference to many of the features, and see -the docstring of the variable `outline-init' for instructions on -priming your emacs session for automatic activation of outline-mode. - - -The bindings are dictated by the `outline-keybindings-list' and -`outline-command-prefix' variables. - - Navigation: Exposure Control: - ---------- ---------------- -C-c C-n outline-next-visible-heading | C-c C-h outline-hide-current-subtree -C-c C-p outline-previous-visible-heading | C-c C-i outline-show-children -C-c C-u outline-up-current-level | C-c C-s outline-show-current-subtree -C-c C-f outline-forward-current-level | C-c C-o outline-show-current-entry -C-c C-b outline-backward-current-level | ^U C-c C-s outline-show-all -C-c C-e outline-end-of-current-entry | outline-hide-current-leaves -C-c C-a outline-beginning-of-current-entry, alternately, goes to hot-spot - - Topic Header Production: - ----------------------- -C-c outline-open-sibtopic Create a new sibling after current topic. -C-c . outline-open-subtopic ... an offspring of current topic. -C-c , outline-open-supertopic ... a sibling of the current topic's parent. - - Topic Level and Prefix Adjustment: - --------------------------------- -C-c > outline-shift-in Shift current topic and all offspring deeper. -C-c < outline-shift-out ... less deep. -C-c outline-rebullet-topic Reconcile bullets of topic and its offspring - - distinctive bullets are not changed, others - alternated according to nesting depth. -C-c b outline-rebullet-current-heading Prompt for alternate bullet for - current topic. -C-c # outline-number-siblings Number bullets of topic and siblings - the - offspring are not affected. With repeat - count, revoke numbering. - - Topic-oriented Killing and Yanking: - ---------------------------------- -C-c C-k outline-kill-topic Kill current topic, including offspring. -C-k outline-kill-line Like kill-line, but reconciles numbering, etc. -C-y outline-yank Yank, adjusting depth of yanked topic to - depth of heading if yanking into bare topic - heading (ie, prefix sans text). -M-y outline-yank-pop Is to outline-yank as yank-pop is to yank - - Misc commands: - ------------- -M-x outlineify-sticky Activate outline mode for current buffer, - and establish a default file-var setting - for `outline-layout'. -C-c C-SPC outline-mark-topic -C-c = c outline-copy-exposed-to-buffer - Duplicate outline, sans concealed text, to - buffer with name derived from derived from - that of current buffer - \"*XXX exposed*\". -C-c = p outline-flatten-exposed-to-buffer - Like above 'copy-exposed', but convert topic - prefixes to section.subsection... numeric - format. -ESC ESC (outline-init t) Setup emacs session for outline mode - auto-activation. - - HOT-SPOT Operation - -Hot-spot operation provides a means for easy, single-keystroke outline -navigation and exposure control. - -\\ -When the text cursor is positioned directly on the bullet character of -a topic, regular characters (a to z) invoke the commands of the -corresponding outline-mode keymap control chars. For example, \"f\" -would invoke the command typically bound to \"C-c C-f\" -\(\\[outline-forward-current-level] `outline-forward-current-level'). - -Thus, by positioning the cursor on a topic bullet, you can execute -the outline navigation and manipulation commands with a single -keystroke. Non-literal chars never get this special translation, so -you can use them to get away from the hot-spot, and back to normal -operation. - -Note that the command `outline-beginning-of-current-entry' \(\\[outline-beginning-of-current-entry]\) -will move to the hot-spot when the cursor is already located at the -beginning of the current entry, so you can simply hit \\[outline-beginning-of-current-entry] -twice in a row to get to the hot-spot. - - Terminology - -Topic hierarchy constituents - TOPICS and SUBTOPICS: - -TOPIC: A basic, coherent component of an emacs outline. It can - contain other topics, and it can be subsumed by other topics, -CURRENT topic: - The visible topic most immediately containing the cursor. -DEPTH: The degree of nesting of a topic; it increases with - containment. Also called the: -LEVEL: The same as DEPTH. - -ANCESTORS: - The topics that contain a topic. -PARENT: A topic's immediate ancestor. It has a depth one less than - the topic. -OFFSPRING: - The topics contained by a topic; -SUBTOPIC: - An immediate offspring of a topic; -CHILDREN: - The immediate offspring of a topic. -SIBLINGS: - Topics having the same parent and depth. - -Topic text constituents: - -HEADER: The first line of a topic, include the topic PREFIX and header - text. -PREFIX: The leading text of a topic which which distinguishes it from - normal text. It has a strict form, which consists of a - prefix-lead string, padding, and a bullet. The bullet may be - followed by a number, indicating the ordinal number of the - topic among its siblings, a space, and then the header text. - - The relative length of the PREFIX determines the nesting depth - of the topic. -PREFIX-LEAD: - The string at the beginning of a topic prefix, normally a `.'. - It can be customized by changing the setting of - `outline-header-prefix' and then reinitializing outline-mode. - - By setting the prefix-lead to the comment-string of a - programming language, you can embed outline-structuring in - program code without interfering with the language processing - of that code. See `outline-use-mode-specific-leader' - docstring for more detail. -PREFIX-PADDING: - Spaces or asterisks which separate the prefix-lead and the - bullet, according to the depth of the topic. -BULLET: A character at the end of the topic prefix, it must be one of - the characters listed on `outline-plain-bullets-string' or - `outline-distinctive-bullets-string'. (See the documentation - for these variables for more details.) The default choice of - bullet when generating varies in a cycle with the depth of the - topic. -ENTRY: The text contained in a topic before any offspring. -BODY: Same as ENTRY. - - -EXPOSURE: - The state of a topic which determines the on-screen visibility - of its offspring and contained text. -CONCEALED: - Topics and entry text whose display is inhibited. Contiguous - units of concealed text is represented by `...' ellipses. - (Ref the `selective-display' var.) - - Concealed topics are effectively collapsed within an ancestor. -CLOSED: A topic whose immediate offspring and body-text is concealed. -OPEN: A topic that is not closed, though its offspring or body may be." -;;;_ . Code - (interactive "P") - - (let* ((active (and (not (equal major-mode 'outline)) - (outline-mode-p))) - ; Massage universal-arg `toggle' val: - (toggle (and toggle - (or (and (listp toggle)(car toggle)) - toggle))) - ; Activation specifically demanded? - (explicit-activation (or - ;; - (and toggle - (or (symbolp toggle) - (and (natnump toggle) - (not (zerop toggle))))))) - ;; outline-mode already called once during this complex command? - (same-complex-command (eq outline-v18/19-file-var-hack - (car command-history))) - do-layout - ) - - ; See comments below re v19.18,.19 bug. - (setq outline-v18/19-file-var-hack (car command-history)) - - (cond - - ;; Provision for v19.18, 19.19 bug - - ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated - ;; modes twice when file is visited. We have to avoid toggling mode - ;; off on second invocation, so we detect it as best we can, and - ;; skip everything. - ((and same-complex-command ; Still in same complex command - ; as last time outline-mode invoked. - active ; Already activated. - (not explicit-activation) ; Prop-line file-vars don't have args. - (string-match "^19.1[89]" ; Bug only known to be in v19.18 and - emacs-version)); 19.19. - t) - - ;; Deactivation: - ((and (not explicit-activation) - (or active toggle)) - ; Activation not explicitly - ; requested, and either in - ; active state or *de*activation - ; specifically requested: - (setq outline-explicitly-deactivated t) - (if (string-match "^18\." emacs-version) - ; Revoke those keys that remain - ; as we set them: - (let ((curr-loc (current-local-map))) - (mapcar (function - (lambda (cell) - (if (eq (lookup-key curr-loc (car cell)) - (car (cdr cell))) - (define-key curr-loc (car cell) - (assq (car cell) outline-prior-bindings))))) - outline-added-bindings) - (outline-resumptions 'outline-added-bindings) - (outline-resumptions 'outline-prior-bindings))) - - (if outline-old-style-prefixes - (progn - (outline-resumptions 'outline-primary-bullet) - (outline-resumptions 'outline-old-style-prefixes))) - (outline-resumptions 'selective-display) - (if (and (boundp 'before-change-functions) before-change-functions) - (outline-resumptions 'before-change-functions)) - (setq local-write-file-hooks - (delq 'outline-write-file-hook - local-write-file-hooks)) - (outline-resumptions 'paragraph-start) - (outline-resumptions 'paragraph-separate) - (outline-resumptions (if (string-match "^18" emacs-version) - 'auto-fill-hook - 'auto-fill-function)) - (outline-resumptions 'outline-former-auto-filler) - (setq outline-mode nil)) - - ;; Activation: - ((not active) - (setq outline-explicitly-deactivated nil) - (if outline-old-style-prefixes - (progn ; Inhibit all the fancy formatting: - (outline-resumptions 'outline-primary-bullet '("*")) - (outline-resumptions 'outline-old-style-prefixes '(())))) - - (outline-infer-header-lead) - (outline-infer-body-reindent) - - (set-outline-regexp) - - ; Produce map from current version - ; of outline-keybindings-list: - (if (boundp 'minor-mode-map-alist) - - (progn ; V19, and maybe lucid and - ; epoch, minor-mode key bindings: - (setq outline-mode-map - (produce-outline-mode-map outline-keybindings-list)) - (produce-outline-mode-menubar-entries) - (fset 'outline-mode-map outline-mode-map) - ; Include on minor-mode-map-alist, - ; if not already there: - (if (not (member '(outline-mode . outline-mode-map) - minor-mode-map-alist)) - (setq minor-mode-map-alist - (cons '(outline-mode . outline-mode-map) - minor-mode-map-alist)))) - - ; V18 minor-mode key bindings: - ; Stash record of added bindings - ; for later revocation: - (outline-resumptions 'outline-added-bindings - (list outline-keybindings-list)) - (outline-resumptions 'outline-prior-bindings - (list (current-local-map))) - ; and add them: - (use-local-map (produce-outline-mode-map outline-keybindings-list - (current-local-map))) - ) - - ; selective-display is the - ; emacs conditional exposure - ; mechanism: - (outline-resumptions 'selective-display '(t)) - (if outline-inhibit-protection - t - (outline-resumptions 'before-change-functions - '(outline-before-change-protect))) - (add-hook 'pre-command-hook 'outline-pre-command-business) - (add-hook 'post-command-hook 'outline-post-command-business) - ; Temporarily set by any outline - ; functions that can be trusted to - ; deal properly with concealed text. - (add-hook 'local-write-file-hooks 'outline-write-file-hook) - ; Custom auto-fill func, to support - ; respect for topic headline, - ; hanging-indents, etc: - (let* ((fill-func-var (if (string-match "^18" emacs-version) - 'auto-fill-hook - 'auto-fill-function)) - (fill-func (symbol-value fill-func-var))) - ;; Register prevailing fill func for use by outline-auto-fill: - (outline-resumptions 'outline-former-auto-filler (list fill-func)) - ;; Register outline-auto-fill to be used if filling is active: - (outline-resumptions fill-func-var '(outline-auto-fill))) - ;; Paragraphs are broken by topic headlines. - (make-local-variable 'paragraph-start) - (outline-resumptions 'paragraph-start - (list (concat paragraph-start "\\|^\\(" - outline-regexp "\\)"))) - (make-local-variable 'paragraph-separate) - (outline-resumptions 'paragraph-separate - (list (concat paragraph-separate "\\|^\\(" - outline-regexp "\\)"))) - - (or (assq 'outline-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(outline-mode " Outl") minor-mode-alist))) - - (outline-setup-menubar) - - (if outline-layout - (setq do-layout t)) - - (if (and outline-isearch-dynamic-expose - (not (fboundp 'outline-real-isearch-abort))) - (outline-enwrap-isearch)) - - (run-hooks 'outline-mode-hook) - (setq outline-mode t)) - - ;; Reactivation: - ((setq do-layout t) - (outline-infer-body-reindent)) - ) ; cond - - (if (and do-layout - outline-auto-activation - (listp outline-layout) - (and (not (eq outline-auto-activation 'activate)) - (if (eq outline-auto-activation 'ask) - (if (y-or-n-p (format "Expose %s with layout '%s'? " - (buffer-name) - outline-layout)) - t - (message "Skipped %s layout." (buffer-name)) - nil) - t))) - (save-excursion - (message "Adjusting '%s' exposure..." (buffer-name)) - (goto-char 0) - (outline-this-or-next-heading) - (condition-case err - (progn - (apply 'outline-expose-topic (list outline-layout)) - (message "Adjusting '%s' exposure... done." (buffer-name))) - ;; Problem applying exposure - notify user, but don't - ;; interrupt, eg, file visit: - (error (message "%s" (car (cdr err))) - (sit-for 1))))) - outline-mode - ) ; let* - ) ; defun -;;;_ > outline-minor-mode -;;; XXX released verion doesn't do this? -(defalias 'outline-minor-mode 'outline-mode) - -;;;_ #3 Internal Position State-Tracking - "outline-recent-*" funcs -;;; All the basic outline functions that directly do string matches to -;;; evaluate heading prefix location set the variables -;;; `outline-recent-prefix-beginning' and `outline-recent-prefix-end' -;;; when successful. Functions starting with `outline-recent-' all -;;; use this state, providing the means to avoid redundant searches -;;; for just-established data. This optimization can provide -;;; significant speed improvement, but it must be employed carefully. -;;;_ = outline-recent-prefix-beginning -(defvar outline-recent-prefix-beginning 0 - "Buffer point of the start of the last topic prefix encountered.") -(make-variable-buffer-local 'outline-recent-prefix-beginning) -;;;_ = outline-recent-prefix-end -(defvar outline-recent-prefix-end 0 - "Buffer point of the end of the last topic prefix encountered.") -(make-variable-buffer-local 'outline-recent-prefix-end) -;;;_ = outline-recent-end-of-subtree -(defvar outline-recent-end-of-subtree 0 - "Buffer point last returned by outline-end-of-current-subtree.") -(make-variable-buffer-local 'outline-recent-end-of-subtree) -;;;_ > outline-prefix-data (beg end) -(defmacro outline-prefix-data (beg end) - "Register outline-prefix state data - BEGINNING and END of prefix. - -For reference by `outline-recent' funcs. Returns BEGINNING." - `(setq outline-recent-prefix-end ,end - outline-recent-prefix-beginning ,beg)) -;;;_ > outline-recent-depth () -(defmacro outline-recent-depth () - "Return depth of last heading encountered by an outline maneuvering function. - -All outline functions which directly do string matches to assess -headings set the variables outline-recent-prefix-beginning and -outline-recent-prefix-end if successful. This function uses those settings -to return the current depth." - - '(max 1 (- outline-recent-prefix-end - outline-recent-prefix-beginning - outline-header-subtraction))) -;;;_ > outline-recent-prefix () -(defmacro outline-recent-prefix () - "Like outline-recent-depth, but returns text of last encountered prefix. - -All outline functions which directly do string matches to assess -headings set the variables outline-recent-prefix-beginning and -outline-recent-prefix-end if successful. This function uses those settings -to return the current depth." - '(buffer-substring outline-recent-prefix-beginning - outline-recent-prefix-end)) -;;;_ > outline-recent-bullet () -(defmacro outline-recent-bullet () - "Like outline-recent-prefix, but returns bullet of last encountered prefix. - -All outline functions which directly do string matches to assess -headings set the variables outline-recent-prefix-beginning and -outline-recent-prefix-end if successful. This function uses those settings -to return the current depth of the most recently matched topic." - '(buffer-substring (1- outline-recent-prefix-end) - outline-recent-prefix-end)) - -;;;_ #4 Navigation - -;;;_ - Position Assessment -;;;_ : Location Predicates -;;;_ > outline-on-current-heading-p () -(defun outline-on-current-heading-p () - "Return non-nil if point is on current visible topics' header line. - -Actually, returns prefix beginning point." - (save-excursion - (beginning-of-line) - (and (looking-at outline-regexp) - (outline-prefix-data (match-beginning 0) (match-end 0))))) -;;;_ > outline-on-heading-p () -(defalias 'outline-on-heading-p 'outline-on-current-heading-p) -;;;_ > outline-e-o-prefix-p () -(defun outline-e-o-prefix-p () - "True if point is located where current topic prefix ends, heading begins." - (and (save-excursion (beginning-of-line) - (looking-at outline-regexp)) - (= (point)(save-excursion (outline-end-of-prefix)(point))))) -;;;_ > outline-hidden-p () -(defmacro outline-hidden-p () - "True if point is in hidden text." - '(save-excursion - (and (re-search-backward "[\n\r]" () t) - (= ?\r (following-char))))) -;;;_ > outline-visible-p () -(defmacro outline-visible-p () - "True if point is not in hidden text." - (interactive) - '(not (outline-hidden-p))) -;;;_ : Location attributes -;;;_ > outline-depth () -(defsubst outline-depth () - "Like outline-current-depth, but respects hidden as well as visible topics." - (save-excursion - (if (outline-goto-prefix) - (outline-recent-depth) - (progn - ;; Oops, no prefix, zero prefix data: - (outline-prefix-data (point)(point)) - ;; ... and return 0: - 0)))) -;;;_ > outline-current-depth () -(defmacro outline-current-depth () - "Return nesting depth of visible topic most immediately containing point." - '(save-excursion - (if (outline-back-to-current-heading) - (max 1 - (- outline-recent-prefix-end - outline-recent-prefix-beginning - outline-header-subtraction)) - 0))) -;;;_ > outline-get-current-prefix () -(defun outline-get-current-prefix () - "Topic prefix of the current topic." - (save-excursion - (if (outline-goto-prefix) - (outline-recent-prefix)))) -;;;_ > outline-get-bullet () -(defun outline-get-bullet () - "Return bullet of containing topic (visible or not)." - (save-excursion - (and (outline-goto-prefix) - (outline-recent-bullet)))) -;;;_ > outline-current-bullet () -(defun outline-current-bullet () - "Return bullet of current (visible) topic heading, or none if none found." - (condition-case err - (save-excursion - (outline-back-to-current-heading) - (buffer-substring (- outline-recent-prefix-end 1) - outline-recent-prefix-end)) - ;; Quick and dirty provision, ostensibly for missing bullet: - ('args-out-of-range nil)) - ) -;;;_ > outline-get-prefix-bullet (prefix) -(defun outline-get-prefix-bullet (prefix) - "Return the bullet of the header prefix string PREFIX." - ;; Doesn't make sense if we're old-style prefixes, but this just - ;; oughtn't be called then, so forget about it... - (if (string-match outline-regexp prefix) - (substring prefix (1- (match-end 0)) (match-end 0)))) -;;;_ > outline-sibling-index (&optional depth) -(defun outline-sibling-index (&optional depth) - "Item number of this prospective topic among its siblings. - -If optional arg depth is greater than current depth, then we're -opening a new level, and return 0. - -If less than this depth, ascend to that depth and count..." - - (save-excursion - (cond ((and depth (<= depth 0) 0)) - ((or (not depth) (= depth (outline-depth))) - (let ((index 1)) - (while (outline-previous-sibling (outline-recent-depth) nil) - (setq index (1+ index))) - index)) - ((< depth (outline-recent-depth)) - (outline-ascend-to-depth depth) - (outline-sibling-index)) - (0)))) -;;;_ > outline-topic-flat-index () -(defun outline-topic-flat-index () - "Return a list indicating point's numeric section.subsect.subsubsect... -Outermost is first." - (let* ((depth (outline-depth)) - (next-index (outline-sibling-index depth)) - (rev-sibls nil)) - (while (> next-index 0) - (setq rev-sibls (cons next-index rev-sibls)) - (setq depth (1- depth)) - (setq next-index (outline-sibling-index depth))) - rev-sibls) - ) - -;;;_ - Navigation macros -;;;_ > outline-next-heading () -(defsubst outline-next-heading () - "Move to the heading for the topic \(possibly invisible) before this one. - -Returns the location of the heading, or nil if none found." - - (if (and (bobp) (not (eobp))) - (forward-char 1)) - - (if (re-search-forward outline-line-boundary-regexp nil 0) - (outline-prefix-data ; Got valid location state - set vars: - (goto-char (or (match-beginning 2) - outline-recent-prefix-beginning)) - (or (match-end 2) outline-recent-prefix-end)))) -;;;_ : outline-this-or-next-heading -(defun outline-this-or-next-heading () - "Position cursor on current or next heading." - ;; A throwaway non-macro that is defined after outline-next-heading - ;; and usable by outline-mode. - (if (not (outline-goto-prefix)) (outline-next-heading))) -;;;_ > outline-previous-heading () -(defmacro outline-previous-heading () - "Move to the prior \(possibly invisible) heading line. - -Return the location of the beginning of the heading, or nil if not found." - - '(if (bobp) - nil - (outline-goto-prefix) - (if - ;; searches are unbounded and return nil if failed: - (or (re-search-backward outline-line-boundary-regexp nil 0) - (looking-at outline-bob-regexp)) - (progn ; Got valid location state - set vars: - (outline-prefix-data - (goto-char (or (match-beginning 2) - outline-recent-prefix-beginning)) - (or (match-end 2) outline-recent-prefix-end)))))) - -;;;_ - Subtree Charting -;;;_ " These routines either produce or assess charts, which are -;;; nested lists of the locations of topics within a subtree. -;;; -;;; Use of charts enables efficient navigation of subtrees, by -;;; requiring only a single regexp-search based traversal, to scope -;;; out the subtopic locations. The chart then serves as the basis -;;; for assessment or adjustment of the subtree, without redundant -;;; traversal of the structure. - -;;;_ > outline-chart-subtree (&optional levels orig-depth prev-depth) -(defun outline-chart-subtree (&optional levels orig-depth prev-depth) - "Produce a location \"chart\" of subtopics of the containing topic. - -Optional argument LEVELS specifies the depth \(relative to start -depth) for the chart. Subsequent optional args are not for public -use. - -Charts are used to capture outline structure, so that outline-altering -routines need assess the structure only once, and then use the chart -for their elaborate manipulations. - -Topics are entered in the chart so the last one is at the car. -The entry for each topic consists of an integer indicating the point -at the beginning of the topic. Charts for offspring consists of a -list containing, recursively, the charts for the respective subtopics. -The chart for a topics' offspring precedes the entry for the topic -itself. - -The other function parameters are for internal recursion, and should -not be specified by external callers. ORIG-DEPTH is depth of topic at -starting point, and PREV-DEPTH is depth of prior topic." - - (let ((original (not orig-depth)) ; `orig-depth' set only in recursion. - chart curr-depth) - - (if original ; Just starting? - ; Register initial settings and - ; position to first offspring: - (progn (setq orig-depth (outline-depth)) - (or prev-depth (setq prev-depth (1+ orig-depth))) - (outline-next-heading))) - - ;; Loop over the current levels' siblings. Besides being more - ;; efficient than tail-recursing over a level, it avoids exceeding - ;; the typically quite constrained emacs max-lisp-eval-depth. - ;; - ;; Probably would speed things up to implement loop-based stack - ;; operation rather than recursing for lower levels. Bah. - - (while (and (not (eobp)) - ; Still within original topic? - (< orig-depth (setq curr-depth (outline-recent-depth))) - (cond ((= prev-depth curr-depth) - ;; Register this one and move on: - (setq chart (cons (point) chart)) - (if (and levels (<= levels 1)) - ;; At depth limit - skip sublevels: - (or (outline-next-sibling curr-depth) - ;; or no more siblings - proceed to - ;; next heading at lesser depth: - (while (and (<= curr-depth - (outline-recent-depth)) - (outline-next-heading)))) - (outline-next-heading))) - - ((and (< prev-depth curr-depth) - (or (not levels) - (> levels 0))) - ;; Recurse on deeper level of curr topic: - (setq chart - (cons (outline-chart-subtree (and levels - (1- levels)) - orig-depth - curr-depth) - chart)) - ;; ... then continue with this one. - ) - - ;; ... else nil if we've ascended back to prev-depth. - - ))) - - (if original ; We're at the last sibling on - ; the original level. Position - ; to the end of it: - (progn (and (not (eobp)) (forward-char -1)) - (and (memq (preceding-char) '(?\n ?\r)) - (memq (aref (buffer-substring (max 1 (- (point) 3)) - (point)) - 1) - '(?\n ?\r)) - (forward-char -1)) - (setq outline-recent-end-of-subtree (point)))) - - chart ; (nreverse chart) not necessary, - ; and maybe not preferable. - )) -;;;_ > outline-chart-siblings (&optional start end) -(defun outline-chart-siblings (&optional start end) - "Produce a list of locations of this and succeeding sibling topics. -Effectively a top-level chart of siblings. See `outline-chart-subtree' -for an explanation of charts." - (save-excursion - (if (outline-goto-prefix) - (let ((chart (list (point)))) - (while (outline-next-sibling) - (setq chart (cons (point) chart))) - (if chart (setq chart (nreverse chart))))))) -;;;_ > outline-chart-to-reveal (chart depth) -(defun outline-chart-to-reveal (chart depth) - - "Return a flat list of hidden points in subtree CHART, up to DEPTH. - -Note that point can be left at any of the points on chart, or at the -start point." - - (let (result here) - (while (and (or (eq depth t) (> depth 0)) - chart) - (setq here (car chart)) - (if (listp here) - (let ((further (outline-chart-to-reveal here (or (eq depth t) - (1- depth))))) - ;; We're on the start of a subtree - recurse with it, if there's - ;; more depth to go: - (if further (setq result (append further result))) - (setq chart (cdr chart))) - (goto-char here) - (if (= (preceding-char) ?\r) - (setq result (cons here result))) - (setq chart (cdr chart)))) - result)) -;;;_ X outline-chart-spec (chart spec &optional exposing) -(defun outline-chart-spec (chart spec &optional exposing) - "Not yet \(if ever) implemented. - -Produce exposure directives given topic/subtree CHART and an exposure SPEC. - -Exposure spec indicates the locations to be exposed and the prescribed -exposure status. Optional arg EXPOSING is an integer, with 0 -indicating pending concealment, anything higher indicating depth to -which subtopic headers should be exposed, and negative numbers -indicating (negative of) the depth to which subtopic headers and -bodies should be exposed. - -The produced list can have two types of entries. Bare numbers -indicate points in the buffer where topic headers that should be -exposed reside. - - - bare negative numbers indicates that the topic starting at the - point which is the negative of the number should be opened, - including their entries. - - bare positive values indicate that this topic header should be - opened. - - Lists signify the beginning and end points of regions that should - be flagged, and the flag to employ. (For concealment: `\(\?r\)', and - exposure:" - (while spec - (cond ((listp spec) - ) - ) - (setq spec (cdr spec))) - ) - -;;;_ - Within Topic -;;;_ > outline-goto-prefix () -(defun outline-goto-prefix () - "Put point at beginning of immediately containing outline topic. - -Goes to most immediate subsequent topic if none immediately containing. - -Not sensitive to topic visibility. - -Returns the point at the beginning of the prefix, or nil if none." - - (let (done) - (while (and (not done) - (re-search-backward "[\n\r]" nil 1)) - (forward-char 1) - (if (looking-at outline-regexp) - (setq done (outline-prefix-data (match-beginning 0) - (match-end 0))) - (forward-char -1))) - (if (bobp) - (cond ((looking-at outline-regexp) - (outline-prefix-data (match-beginning 0)(match-end 0))) - ((outline-next-heading)) - (done)) - done))) -;;;_ > outline-end-of-prefix () -(defun outline-end-of-prefix (&optional ignore-decorations) - "Position cursor at beginning of header text. - -If optional IGNORE-DECORATIONS is non-nil, put just after bullet, -otherwise skip white space between bullet and ensuing text." - - (if (not (outline-goto-prefix)) - nil - (let ((match-data (match-data))) - (goto-char (match-end 0)) - (if ignore-decorations - t - (while (looking-at "[0-9]") (forward-char 1)) - (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))) - (store-match-data match-data)) - ;; Reestablish where we are: - (outline-current-depth))) -;;;_ > outline-current-bullet-pos () -(defun outline-current-bullet-pos () - "Return position of current \(visible) topic's bullet." - - (if (not (outline-current-depth)) - nil - (1- (match-end 0)))) -;;;_ > outline-back-to-current-heading () -(defun outline-back-to-current-heading () - "Move to heading line of current topic, or beginning if already on the line." - - (beginning-of-line) - (prog1 (or (outline-on-current-heading-p) - (and (re-search-backward (concat "^\\(" outline-regexp "\\)") - nil - 'move) - (outline-prefix-data (match-beginning 1)(match-end 1)))) - (if (interactive-p) (outline-end-of-prefix)))) -;;;_ > outline-back-to-heading () -(defalias 'outline-back-to-heading 'outline-back-to-current-heading) -;;;_ > outline-pre-next-preface () -(defun outline-pre-next-preface () - "Skip forward to just before the next heading line. - -Returns that character position." - - (if (re-search-forward outline-line-boundary-regexp nil 'move) - (prog1 (goto-char (match-beginning 0)) - (outline-prefix-data (match-beginning 2)(match-end 2))))) -;;;_ > outline-end-of-current-subtree () -(defun outline-end-of-current-subtree () - "Put point at the end of the last leaf in the currently visible topic." - (interactive) - (outline-back-to-current-heading) - (let ((level (outline-recent-depth))) - (outline-next-heading) - (while (and (not (eobp)) - (> (outline-recent-depth) level)) - (outline-next-heading)) - (and (not (eobp)) (forward-char -1)) - (and (memq (preceding-char) '(?\n ?\r)) - (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1) - '(?\n ?\r)) - (forward-char -1)) - (setq outline-recent-end-of-subtree (point)))) -;;;_ > outline-beginning-of-current-entry () -(defun outline-beginning-of-current-entry () - "When not already there, position point at beginning of current topic's body. - -If already there, move cursor to bullet for hot-spot operation. -\(See outline-mode doc string for details on hot-spot operation.)" - (interactive) - (let ((start-point (point))) - (outline-end-of-prefix) - (if (and (interactive-p) - (= (point) start-point)) - (goto-char (outline-current-bullet-pos))))) -;;;_ > outline-end-of-current-entry () -(defun outline-end-of-current-entry () - "Position the point at the end of the current topics' entry." - (interactive) - (outline-show-entry) - (prog1 (outline-pre-next-preface) - (if (and (not (bobp))(looking-at "^$")) - (forward-char -1)))) -;;;_ > outline-end-of-current-heading () -(defun outline-end-of-current-heading () - (interactive) - (outline-beginning-of-current-entry) - (forward-line -1) - (end-of-line)) -(defalias 'outline-end-of-heading 'outline-end-of-current-heading) - -;;;_ - Depth-wise -;;;_ > outline-ascend-to-depth (depth) -(defun outline-ascend-to-depth (depth) - "Ascend to depth DEPTH, returning depth if successful, nil if not." - (if (and (> depth 0)(<= depth (outline-depth))) - (let ((last-good (point))) - (while (and (< depth (outline-depth)) - (setq last-good (point)) - (outline-beginning-of-level) - (outline-previous-heading))) - (if (= (outline-recent-depth) depth) - (progn (goto-char outline-recent-prefix-beginning) - depth) - (goto-char last-good) - nil)) - (if (interactive-p) (outline-end-of-prefix)))) -;;;_ > outline-ascend () -(defun outline-ascend () - "Ascend one level, returning t if successful, nil if not." - (prog1 - (if (outline-beginning-of-level) - (outline-previous-heading)) - (if (interactive-p) (outline-end-of-prefix)))) -;;;_ > outline-descend-to-depth (depth) -(defun outline-descend-to-depth (depth) - "Descend to depth DEPTH within current topic. - -Returning depth if successful, nil if not." - (let ((start-point (point)) - (start-depth (outline-depth))) - (while - (and (> (outline-depth) 0) - (not (= depth (outline-recent-depth))) ; ... not there yet - (outline-next-heading) ; ... go further - (< start-depth (outline-recent-depth)))) ; ... still in topic - (if (and (> (outline-depth) 0) - (= (outline-recent-depth) depth)) - depth - (goto-char start-point) - nil)) - ) -;;;_ > outline-up-current-level (arg &optional dont-complain) -(defun outline-up-current-level (arg &optional dont-complain) - "Move out ARG levels from current visible topic. - -Positions on heading line of containing topic. Error if unable to -ascend that far, or nil if unable to ascend but optional arg -DONT-COMPLAIN is non-nil." - (interactive "p") - (outline-back-to-current-heading) - (let ((present-level (outline-recent-depth)) - (last-good (point)) - failed - return) - ;; Loop for iterating arg: - (while (and (> (outline-recent-depth) 1) - (> arg 0) - (not (bobp)) - (not failed)) - (setq last-good (point)) - ;; Loop for going back over current or greater depth: - (while (and (not (< (outline-recent-depth) present-level)) - (or (outline-previous-visible-heading 1) - (not (setq failed present-level))))) - (setq present-level (outline-current-depth)) - (setq arg (- arg 1))) - (if (or failed - (> arg 0)) - (progn (goto-char last-good) - (if (interactive-p) (outline-end-of-prefix)) - (if (not dont-complain) - (error "Can't ascend past outermost level") - (if (interactive-p) (outline-end-of-prefix)) - nil)) - (if (interactive-p) (outline-end-of-prefix)) - outline-recent-prefix-beginning))) - -;;;_ - Linear -;;;_ > outline-next-sibling (&optional depth backward) -(defun outline-next-sibling (&optional depth backward) - "Like outline-forward-current-level, but respects invisible topics. - -Traverse at optional DEPTH, or current depth if none specified. - -Go backward if optional arg BACKWARD is non-nil. - -Return depth if successful, nil otherwise." - - (if (and backward (bobp)) - nil - (let ((start-depth (or depth (outline-depth))) - (start-point (point)) - last-depth) - (while (and (not (if backward (bobp) (eobp))) - (if backward (outline-previous-heading) - (outline-next-heading)) - (> (setq last-depth (outline-recent-depth)) start-depth))) - (if (and (not (eobp)) - (and (> (or last-depth (outline-depth)) 0) - (= (outline-recent-depth) start-depth))) - outline-recent-prefix-beginning - (goto-char start-point) - (if depth (outline-depth) start-depth) - nil)))) -;;;_ > outline-previous-sibling (&optional depth backward) -(defun outline-previous-sibling (&optional depth backward) - "Like outline-forward-current-level,but backwards & respect invisible topics. - -Optional DEPTH specifies depth to traverse, default current depth. - -Optional BACKWARD reverses direction. - -Return depth if successful, nil otherwise." - (outline-next-sibling depth (not backward)) - ) -;;;_ > outline-snug-back () -(defun outline-snug-back () - "Position cursor at end of previous topic - -Presumes point is at the start of a topic prefix." - (if (or (bobp) (eobp)) - nil - (forward-char -1)) - (if (or (bobp) (not (memq (preceding-char) '(?\n ?\r)))) - nil - (forward-char -1) - (if (or (bobp) (not (memq (preceding-char) '(?\n ?\r)))) - (forward-char -1))) - (point)) -;;;_ > outline-beginning-of-level () -(defun outline-beginning-of-level () - "Go back to the first sibling at this level, visible or not." - (outline-end-of-level 'backward)) -;;;_ > outline-end-of-level (&optional backward) -(defun outline-end-of-level (&optional backward) - "Go to the last sibling at this level, visible or not." - - (let ((depth (outline-depth))) - (while (outline-previous-sibling depth nil)) - (prog1 (outline-recent-depth) - (if (interactive-p) (outline-end-of-prefix))))) -;;;_ > outline-next-visible-heading (arg) -(defun outline-next-visible-heading (arg) - "Move to the next ARG'th visible heading line, backward if arg is negative. - -Move as far as possible in indicated direction \(beginning or end of -buffer) if headings are exhausted." - - (interactive "p") - (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) - (step (if backward -1 1)) - (start-point (point)) - prev got) - - (while (> arg 0) ; limit condition - (while (and (not (if backward (bobp)(eobp))) ; boundary condition - ;; Move, skipping over all those concealed lines: - (< -1 (forward-line step)) - (not (setq got (looking-at outline-regexp))))) - ;; Register this got, it may be the last: - (if got (setq prev got)) - (setq arg (1- arg))) - (cond (got ; Last move was to a prefix: - (outline-prefix-data (match-beginning 0) (match-end 0)) - (outline-end-of-prefix)) - (prev ; Last move wasn't, but prev was: - (outline-prefix-data (match-beginning 0) (match-end 0))) - ((not backward) (end-of-line) nil)))) -;;;_ > outline-previous-visible-heading (arg) -(defun outline-previous-visible-heading (arg) - "Move to the previous heading line. - -With argument, repeats or can move forward if negative. -A heading line is one that starts with a `*' (or that outline-regexp -matches)." - (interactive "p") - (outline-next-visible-heading (- arg))) -;;;_ > outline-forward-current-level (arg) -(defun outline-forward-current-level (arg) - "Position point at the next heading of the same level. - -Takes optional repeat-count, goes backward if count is negative. - -Returns resulting position, else nil if none found." - (interactive "p") - (let ((start-depth (outline-current-depth)) - (start-point (point)) - (start-arg arg) - (backward (> 0 arg)) - last-depth - (last-good (point)) - at-boundary) - (if (= 0 start-depth) - (error "No siblings, not in a topic...")) - (if backward (setq arg (* -1 arg))) - (while (not (or (zerop arg) - at-boundary)) - (while (and (not (if backward (bobp) (eobp))) - (if backward (outline-previous-visible-heading 1) - (outline-next-visible-heading 1)) - (> (setq last-depth (outline-recent-depth)) start-depth))) - (if (and last-depth (= last-depth start-depth) - (not (if backward (bobp) (eobp)))) - (setq last-good (point) - arg (1- arg)) - (setq at-boundary t))) - (if (and (not (eobp)) - (= arg 0) - (and (> (or last-depth (outline-depth)) 0) - (= (outline-recent-depth) start-depth))) - outline-recent-prefix-beginning - (goto-char last-good) - (if (not (interactive-p)) - nil - (outline-end-of-prefix) - (error "Hit %s level %d topic, traversed %d of %d requested" - (if backward "first" "last") - (outline-recent-depth) - (- (abs start-arg) arg) - (abs start-arg)))))) -;;;_ > outline-backward-current-level (arg) -(defun outline-backward-current-level (arg) - "Inverse of `outline-forward-current-level'." - (interactive "p") - (if (interactive-p) - (let ((current-prefix-arg (* -1 arg))) - (call-interactively 'outline-forward-current-level)) - (outline-forward-current-level (* -1 arg)))) - -;;;_ #5 Alteration - -;;;_ - Fundamental -;;;_ > outline-before-change-protect (beg end) -(defun outline-before-change-protect (beg end) - "Outline before-change hook, regulates changes to concealed text. - -Reveal concealed text that would be changed by current command, and -offer user choice to commit or forego the change. Unchanged text is -reconcealed. User has option to have changed text reconcealed. - -Undo commands are specially treated - the user is not prompted for -choice, the undoes are always committed (based on presumption that the -things being undone were already subject to this regulation routine), -and undoes always leave the changed stuff exposed. - -Changes to concealed regions are ignored while file is being written. -\(This is for the sake of functions that do change the file during -writes, like crypt and zip modes.) - -Locally bound in outline buffers to `before-change-functions', which -in emacs 19 is run before any change to the buffer. - -Any functions which set [`this-command' to `undo', or which set] -`outline-override-protect' non-nil (as does, eg, outline-flag-chars) -are exempt from this restriction." - (if (and (outline-mode-p) - ; outline-override-protect - ; set by functions that know what - ; they're doing, eg outline internals: - (not outline-override-protect) - (not outline-during-write-cue) - (save-match-data ; Preserve operation position state. - ; Both beginning and end chars must - ; be exposed: - (save-excursion (if (memq this-command '(newline open-line)) - ;; Compensate for stupid emacs {new, - ;; open-}line display optimization: - (setq beg (1+ beg) - end (1+ end))) - (goto-char beg) - (or (outline-hidden-p) - (and (not (= beg end)) - (goto-char end) - (outline-hidden-p)))))) - (save-match-data - (if (equal this-command 'undo) - ;; Allow undo without inhibition. - ;; - Undoing new and open-line hits stupid emacs redisplay - ;; optimization (em 19 cmds.c, ~ line 200). - ;; - Presumably, undoing what was properly protected when - ;; done. - ;; - Undo may be users' only recourse in protection faults. - ;; So, expose what getting changed: - (progn (message "Undo! - exposing concealed target...") - (if (outline-hidden-p) - (outline-show-children)) - (message "Undo!")) - (let (response - (rehide-completely (save-excursion (outline-goto-prefix) - (outline-hidden-p))) - rehide-place) - - (save-excursion - (if (condition-case err - ;; Condition case to catch keyboard quits during reads. - (progn - ; Give them a peek where - (save-excursion - (if (eolp) (setq rehide-place - (outline-goto-prefix))) - (outline-show-entry)) - ; Present the message, but... - ; leave the cursor at the location - ; until they respond: - ; Then interpret the response: - (while - (progn - (message (concat "Change inside concealed" - " region - do it? " - "(n or 'y'/'r'eclose)")) - (setq response (read-char)) - (not - (cond ((memq response '(?r ?R)) - (setq response 'reclose)) - ((memq response '(?y ?Y ? )) - (setq response t)) - ((memq response '(?n ?N 127)) - (setq response nil) - t) - ((eq response ??) - (message - "`r' means `yes, then reclose'") - nil) - (t (message "Please answer y, n, or r") - (sit-for 1) - nil))))) - response) - ('quit nil)) - ; Continue: - (if (eq response 'reclose) - (save-excursion - (if rehide-place (goto-char rehide-place)) - (if rehide-completely - (outline-hide-current-entry-completely) - (outline-hide-current-entry))) - (if (outline-ascend-to-depth (1- (outline-recent-depth))) - (outline-show-children) - (outline-show-to-offshoot))) - ; Prevent: - (if rehide-completely - (save-excursion - (if rehide-place (goto-char rehide-place)) - (outline-hide-current-entry-completely)) - (outline-hide-current-entry)) - (error (concat - "Change within concealed region prevented."))))))) - ) ; if - ) ; defun -;;;_ = outline-post-goto-bullet -(defvar outline-post-goto-bullet nil - "Outline internal var, for `outline-pre-command-business' hot-spot operation. - -When set, tells post-processing to reposition on topic bullet, and -then unset it. Set by outline-pre-command-business when implementing -hot-spot operation, where literal characters typed over a topic bullet -are mapped to the command of the corresponding control-key on the -outline-mode-map.") -(make-variable-buffer-local 'outline-post-goto-bullet) -;;;_ > outline-post-command-business () -(defun outline-post-command-business () - "Outline post-command-hook function. - -- Null outline-override-protect, so it's not left open. - -- Implement (and clear) outline-post-goto-bullet, for hot-spot - outline commands. - -- Massages buffer-undo-list so successive, standard character self-inserts are - aggregated. This kludge compensates for lack of undo bunching when - before-change-functions is used." - - ; Apply any external change func: - (if (not (outline-mode-p)) ; In outline-mode. - nil - (setq outline-override-protect nil) - (if outline-isearch-dynamic-expose - (outline-isearch-rectification)) - (if outline-during-write-cue - ;; Was used by outline-before-change-protect, done with it now: - (setq outline-during-write-cue nil)) - ;; Undo bunching business: - (if (and (listp buffer-undo-list) ; Undo history being kept. - (equal this-command 'self-insert-command) - (equal last-command 'self-insert-command)) - (let* ((prev-stuff (cdr buffer-undo-list)) - (before-prev-stuff (cdr (cdr prev-stuff))) - cur-cell cur-from cur-to - prev-cell prev-from prev-to) - (if (and before-prev-stuff ; Goes back far enough to bother, - (not (car prev-stuff)) ; and break before current, - (not (car before-prev-stuff)) ; !and break before prev! - (setq prev-cell (car (cdr prev-stuff))) ; contents now, - (setq cur-cell (car buffer-undo-list)) ; contents prev. - - ;; cur contents denote a single char insertion: - (numberp (setq cur-from (car cur-cell))) - (numberp (setq cur-to (cdr cur-cell))) - (= 1 (- cur-to cur-from)) - - ;; prev contents denote fewer than aggregate-limit - ;; insertions: - (numberp (setq prev-from (car prev-cell))) - (numberp (setq prev-to (cdr prev-cell))) - ; Below threshold: - (> outline-undo-aggregation (- prev-to prev-from))) - (setq buffer-undo-list - (cons (cons prev-from cur-to) - (cdr (cdr (cdr buffer-undo-list)))))))) - ;; Implement -post-goto-bullet, if set: (must be after undo business) - (if (and outline-post-goto-bullet - (outline-current-bullet-pos)) - (progn (goto-char (outline-current-bullet-pos)) - (setq outline-post-goto-bullet nil))) - )) -;;;_ > outline-pre-command-business () -(defun outline-pre-command-business () - "Outline pre-command-hook function for outline buffers. -Implements special behavior when cursor is on bullet character. - -When the cursor is on the bullet character, self-insert characters are -reinterpreted as the corresponding control-character in the -outline-mode map. The outline-mode post-command-hook insures that the -cursor which has moved as a result of such reinterpretation is -positioned on the bullet character of the destination topic. - -The upshot is that you can get easy, single (ie, unmodified) key -outline maneuvering operations by positioning the cursor on the bullet -char. When in this mode you can use regular cursor-positioning -command/keystrokes to relocate the cursor off of a bullet character to -return to regular interpretation of self-insert characters." - - (if (not (outline-mode-p)) - ;; Shouldn't be invoked if not in allout outline-mode, but just in case: - nil - ;; Register isearch status: - (if (and (boundp 'isearch-mode) isearch-mode) - (setq outline-pre-was-isearching t) - (setq outline-pre-was-isearching nil)) - ;; Hot-spot navigation provisions: - (if (and (eq this-command 'self-insert-command) - (eq (point)(outline-current-bullet-pos))) - (let* ((this-key-num (cond - ((numberp last-command-char) - last-command-char) - ;; XXX Only xemacs has characterp. - ((and (fboundp 'characterp) - (characterp last-command-char)) - (char-to-int last-command-char)) - (t 0))) - mapped-binding) - (if (zerop this-key-num) - nil - ; Map upper-register literals - ; to lower register: - (if (<= 96 this-key-num) - (setq this-key-num (- this-key-num 32))) - ; Check if we have a literal: - (if (and (<= 64 this-key-num) - (>= 96 this-key-num)) - (setq mapped-binding - (lookup-key 'outline-mode-map - (concat outline-command-prefix - (char-to-string (- this-key-num - 64)))))) - (if mapped-binding - (setq outline-post-goto-bullet t - this-command mapped-binding))))))) -;;;_ > outline-find-file-hook () -(defun outline-find-file-hook () - "Activate outline-mode when `outline-auto-activation' & `outline-layout' are non-nil. - -See `outline-init' for setup instructions." - (if (and outline-auto-activation - (not (outline-mode-p)) - outline-layout) - (outline-mode t))) -;;;_ > outline-isearch-rectification -(defun outline-isearch-rectification () - "Rectify outline exposure before, during, or after isearch. - -Called as part of outline-post-command-business." - - (let ((isearching (and (boundp 'isearch-mode) isearch-mode))) - (cond ((and isearching (not outline-pre-was-isearching)) - (outline-isearch-expose 'start)) - ((and isearching outline-pre-was-isearching) - (outline-isearch-expose 'continue)) - ((and (not isearching) outline-pre-was-isearching) - (outline-isearch-expose 'final)) - ;; Not and wasn't isearching: - (t (setq outline-isearch-prior-pos nil) - (setq outline-isearch-did-quit nil))))) -;;;_ = outline-isearch-was-font-lock -(defvar outline-isearch-was-font-lock - (and (boundp 'font-lock-mode) font-lock-mode)) - -;;;_ > outline-flag-region (from to flag) -(defmacro outline-flag-region (from to flag) - "Hide or show lines from FROM to TO, via emacs selective-display FLAG char. -Ie, text following flag C-m \(carriage-return) is hidden until the -next C-j (newline) char. - -Returns the endpoint of the region." - `(let ((buffer-read-only nil) - (outline-override-protect t)) - (subst-char-in-region ,from ,to - (if (= ,flag ?\n) ?\r ?\n) - ,flag t))) - -;;;_ > outline-isearch-expose (mode) -(defun outline-isearch-expose (mode) - "Mode is either 'clear, 'start, 'continue, or 'final." - ;; outline-isearch-prior-pos encodes exposure status of prior pos: - ;; (pos was-vis header-pos end-pos) - ;; pos - point of concern - ;; was-vis - t, else 'topic if entire topic was exposed, 'entry otherwise - ;; Do reclosure or prior pos, as necessary: - (if (eq mode 'start) - (setq outline-isearch-was-font-lock (and (boundp 'font-lock-mode) - font-lock-mode) - font-lock-mode nil) - (if (eq mode 'final) - (setq font-lock-mode outline-isearch-was-font-lock)) - (if (and outline-isearch-prior-pos - (listp outline-isearch-prior-pos)) - ;; Conceal prior peek: - (outline-flag-region (car (cdr outline-isearch-prior-pos)) - (car (cdr (cdr outline-isearch-prior-pos))) - ?\r))) - (if (outline-visible-p) - (setq outline-isearch-prior-pos nil) - (if (not (eq mode 'final)) - (setq outline-isearch-prior-pos (cons (point) (outline-show-entry))) - (if outline-isearch-did-quit - nil - (setq outline-isearch-prior-pos nil) - (outline-show-children)))) - (setq outline-isearch-did-quit nil)) -;;;_ > outline-enwrap-isearch () -(defun outline-enwrap-isearch () - "Impose outline-mode isearch-abort wrapper for dynamic exposure in isearch. - -The function checks to ensure that the rebinding is done only once." - - (add-hook 'isearch-mode-end-hook 'outline-isearch-rectification) - (if (fboundp 'outline-real-isearch-abort) - ;; - nil - ; Ensure load of isearch-mode: - (if (or (and (fboundp 'isearch-mode) - (fboundp 'isearch-abort)) - (condition-case error - (load-library "isearch-mode") - ('file-error (message - "Skipping isearch-mode provisions - %s '%s'" - (car (cdr error)) - (car (cdr (cdr error)))) - (sit-for 1) - ;; Inhibit subsequent tries and return nil: - (setq outline-isearch-dynamic-expose nil)))) - ;; Isearch-mode loaded, encapsulate specific entry points for - ;; outline dynamic-exposure business: - (progn - ;; stash crucial isearch-mode funcs under known, private - ;; names, then register wrapper functions under the old - ;; names, in their stead: - (fset 'outline-real-isearch-abort (symbol-function 'isearch-abort)) - (fset 'isearch-abort 'outline-isearch-abort))))) -;;;_ > outline-isearch-abort () -(defun outline-isearch-abort () - "Wrapper for outline-real-isearch-abort \(which see), to register -actual quits." - (interactive) - (setq outline-isearch-did-quit nil) - (condition-case what - (outline-real-isearch-abort) - ('quit (setq outline-isearch-did-quit t) - (signal 'quit nil)))) - -;;; Prevent unnecessary font-lock while isearching! -(defvar isearch-was-font-locking nil) -(defun isearch-inhibit-font-lock () - "Inhibit font-lock while isearching - for use on isearch-mode-hook." - (if (and (outline-mode-p) (boundp 'font-lock-mode) font-lock-mode) - (setq isearch-was-font-locking t - font-lock-mode nil))) -(add-hook 'isearch-mode-hook 'isearch-inhibit-font-lock) -(defun isearch-reenable-font-lock () - "Reenable font-lock after isearching - for use on isearch-mode-end-hook." - (if (and (boundp 'font-lock-mode) font-lock-mode) - (if (and (outline-mode-p) isearch-was-font-locking) - (setq isearch-was-font-locking nil - font-lock-mode t)))) -(add-hook 'isearch-mode-end-hook 'isearch-reenable-font-lock) - -;;;_ - Topic Format Assessment -;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) -(defun outline-solicit-alternate-bullet (depth &optional current-bullet) - - "Prompt for and return a bullet char as an alternative to the current one. - -Offer one suitable for current depth DEPTH as default." - - (let* ((default-bullet (or (and (stringp current-bullet) current-bullet) - (outline-bullet-for-depth depth))) - (sans-escapes (regexp-sans-escapes outline-bullets-string)) - choice) - (save-excursion - (goto-char (outline-current-bullet-pos)) - (setq choice (solicit-char-in-string - (format "Select bullet: %s ('%s' default): " - sans-escapes - default-bullet) - sans-escapes - t))) - (message "") - (if (string= choice "") default-bullet choice)) - ) -;;;_ > outline-distinctive-bullet (bullet) -(defun outline-distinctive-bullet (bullet) - "True if bullet is one of those on outline-distinctive-bullets-string." - (string-match (regexp-quote bullet) outline-distinctive-bullets-string)) -;;;_ > outline-numbered-type-prefix (&optional prefix) -(defun outline-numbered-type-prefix (&optional prefix) - "True if current header prefix bullet is numbered bullet." - (and outline-numbered-bullet - (string= outline-numbered-bullet - (if prefix - (outline-get-prefix-bullet prefix) - (outline-get-bullet))))) -;;;_ > outline-bullet-for-depth (&optional depth) -(defun outline-bullet-for-depth (&optional depth) - "Return outline topic bullet suited to optional DEPTH, or current depth." - ;; Find bullet in plain-bullets-string modulo DEPTH. - (if outline-stylish-prefixes - (char-to-string (aref outline-plain-bullets-string - (% (max 0 (- depth 2)) - outline-plain-bullets-string-len))) - outline-primary-bullet) - ) - -;;;_ - Topic Production -;;;_ > outline-make-topic-prefix (&optional prior-bullet -(defun outline-make-topic-prefix (&optional prior-bullet - new - depth - solicit - number-control - index) - ;; Depth null means use current depth, non-null means we're either - ;; opening a new topic after current topic, lower or higher, or we're - ;; changing level of current topic. - ;; Solicit dominates specified bullet-char. -;;;_ . Doc string: - "Generate a topic prefix suitable for optional arg DEPTH, or current depth. - -All the arguments are optional. - -PRIOR-BULLET indicates the bullet of the prefix being changed, or -nil if none. This bullet may be preserved (other options -notwithstanding) if it is on the outline-distinctive-bullets-string, -for instance. - -Second arg NEW indicates that a new topic is being opened after the -topic at point, if non-nil. Default bullet for new topics, eg, may -be set (contingent to other args) to numbered bullets if previous -sibling is one. The implication otherwise is that the current topic -is being adjusted - shifted or rebulleted - and we don't consider -bullet or previous sibling. - -Third arg DEPTH forces the topic prefix to that depth, regardless of -the current topics' depth. - -If SOLICIT is non-nil, then the choice of bullet is solicited from -user. If it's a character, then that character is offered as the -default, otherwise the one suited to the context \(according to -distinction or depth) is offered. \(This overrides other options, -including, eg, a distinctive PRIOR-BULLET.) If non-nil, then the -context-specific bullet is used. - -Fifth arg, NUMBER-CONTROL, matters only if `outline-numbered-bullet' -is non-nil *and* soliciting was not explicitly invoked. Then -NUMBER-CONTROL non-nil forces prefix to either numbered or -denumbered format, depending on the value of the sixth arg, INDEX. - -\(Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...) - -If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then -the prefix of the topic is forced to be numbered. Non-nil -NUMBER-CONTROL and nil INDEX forces non-numbered format on the -bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means -that the index for the numbered prefix will be derived, by counting -siblings back to start of level. If INDEX is a number, then that -number is used as the index for the numbered prefix (allowing, eg, -sequential renumbering to not require this function counting back the -index for each successive sibling)." -;;;_ . Code: - ;; The options are ordered in likely frequence of use, most common - ;; highest, least lowest. Ie, more likely to be doing prefix - ;; adjustments than soliciting, and yet more than numbering. - ;; Current prefix is least dominant, but most likely to be commonly - ;; specified... - - (let* (body - numbering - denumbering - (depth (or depth (outline-depth))) - (header-lead outline-header-prefix) - (bullet-char - - ;; Getting value for bullet char is practically the whole job: - - (cond - ; Simplest situation - level 1: - ((<= depth 1) (setq header-lead "") outline-primary-bullet) - ; Simple, too: all asterisks: - (outline-old-style-prefixes - ;; Cheat - make body the whole thing, null out header-lead and - ;; bullet-char: - (setq body (make-string depth - (string-to-char outline-primary-bullet))) - (setq header-lead "") - "") - - ;; (Neither level 1 nor old-style, so we're space padding. - ;; Sneak it in the condition of the next case, whatever it is.) - - ;; Solicitation overrides numbering and other cases: - ((progn (setq body (make-string (- depth 2) ?\ )) - ;; The actual condition: - solicit) - (let* ((got (outline-solicit-alternate-bullet depth solicit))) - ;; Gotta check whether we're numbering and got a numbered bullet: - (setq numbering (and outline-numbered-bullet - (not (and number-control (not index))) - (string= got outline-numbered-bullet))) - ;; Now return what we got, regardless: - got)) - - ;; Numbering invoked through args: - ((and outline-numbered-bullet number-control) - (if (setq numbering (not (setq denumbering (not index)))) - outline-numbered-bullet - (if (and prior-bullet - (not (string= outline-numbered-bullet - prior-bullet))) - prior-bullet - (outline-bullet-for-depth depth)))) - - ;;; Neither soliciting nor controlled numbering ;;; - ;;; (may be controlled denumbering, tho) ;;; - - ;; Check wrt previous sibling: - ((and new ; only check for new prefixes - (<= depth (outline-depth)) - outline-numbered-bullet ; ... & numbering enabled - (not denumbering) - (let ((sibling-bullet - (save-excursion - ;; Locate correct sibling: - (or (>= depth (outline-depth)) - (outline-ascend-to-depth depth)) - (outline-get-bullet)))) - (if (and sibling-bullet - (string= outline-numbered-bullet sibling-bullet)) - (setq numbering sibling-bullet))))) - - ;; Distinctive prior bullet? - ((and prior-bullet - (outline-distinctive-bullet prior-bullet) - ;; Either non-numbered: - (or (not (and outline-numbered-bullet - (string= prior-bullet outline-numbered-bullet))) - ;; or numbered, and not denumbering: - (setq numbering (not denumbering))) - ;; Here 'tis: - prior-bullet)) - - ;; Else, standard bullet per depth: - ((outline-bullet-for-depth depth))))) - - (concat header-lead - body - bullet-char - (if numbering - (format "%d" (cond ((and index (numberp index)) index) - (new (1+ (outline-sibling-index depth))) - ((outline-sibling-index)))))) - ) - ) -;;;_ > outline-open-topic (relative-depth &optional before use_sib_bullet) -(defun outline-open-topic (relative-depth &optional before use_sib_bullet) - "Open a new topic at depth DEPTH. - -New topic is situated after current one, unless optional flag BEFORE -is non-nil, or unless current line is complete empty (not even -whitespace), in which case open is done on current line. - -If USE_SIB_BULLET is true, use the bullet of the prior sibling. - -Nuances: - -- Creation of new topics is with respect to the visible topic - containing the cursor, regardless of intervening concealed ones. - -- New headers are generally created after/before the body of a - topic. However, they are created right at cursor location if the - cursor is on a blank line, even if that breaks the current topic - body. This is intentional, to provide a simple means for - deliberately dividing topic bodies. - -- Double spacing of topic lists is preserved. Also, the first - level two topic is created double-spaced (and so would be - subsequent siblings, if that's left intact). Otherwise, - single-spacing is used. - -- Creation of sibling or nested topics is with respect to the topic - you're starting from, even when creating backwards. This way you - can easily create a sibling in front of the current topic without - having to go to its preceding sibling, and then open forward - from there." - - (let* ((depth (+ (outline-current-depth) relative-depth)) - (opening-on-blank (if (looking-at "^\$") - (not (setq before nil)))) - opening-numbered ; Will get while computing ref-topic, below - ref-depth ; Will get while computing ref-topic, below - ref-bullet ; Will get while computing ref-topic, next - (ref-topic (save-excursion - (cond ((< relative-depth 0) - (outline-ascend-to-depth depth)) - ((>= relative-depth 1) nil) - (t (outline-back-to-current-heading))) - (setq ref-depth (outline-recent-depth)) - (setq ref-bullet - (if (> outline-recent-prefix-end 1) - (outline-recent-bullet) - "")) - (setq opening-numbered - (save-excursion - (and outline-numbered-bullet - (or (<= relative-depth 0) - (outline-descend-to-depth depth)) - (if (outline-numbered-type-prefix) - outline-numbered-bullet)))) - (point))) - dbl-space - doing-beginning) - - (if (not opening-on-blank) - ; Positioning and vertical - ; padding - only if not - ; opening-on-blank: - (progn - (goto-char ref-topic) - (setq dbl-space ; Determine double space action: - (or (and (<= relative-depth 0) ; not descending; - (save-excursion - ;; at b-o-b or preceded by a blank line? - (or (> 0 (forward-line -1)) - (looking-at "^\\s-*$") - (bobp))) - (save-excursion - ;; succeeded by a blank line? - (outline-end-of-current-subtree) - (bolp))) - (and (= ref-depth 1) - (or before - (= depth 1) - (save-excursion - ;; Don't already have following - ;; vertical padding: - (not (outline-pre-next-preface))))))) - - ; Position to prior heading, - ; if inserting backwards, and - ; not going outwards: - (if (and before (>= relative-depth 0)) - (progn (outline-back-to-current-heading) - (setq doing-beginning (bobp)) - (if (not (bobp)) - (outline-previous-heading))) - (if (and before (bobp)) - (outline-unprotected (open-line 1)))) - - (if (<= relative-depth 0) - ;; Not going inwards, don't snug up: - (if doing-beginning - (outline-unprotected (open-line (if dbl-space 2 1))) - (if before - (progn (end-of-line) - (outline-pre-next-preface) - (while (= ?\r (following-char)) - (forward-char 1)) - (if (not (looking-at "^$")) - (outline-unprotected (open-line 1)))) - (outline-end-of-current-subtree))) - ;; Going inwards - double-space if first offspring is, - ;; otherwise snug up. - (end-of-line) ; So we skip any concealed progeny. - (outline-pre-next-preface) - (if (bolp) - ;; Blank lines between current header body and next - ;; header - get to last substantive (non-white-space) - ;; line in body: - (re-search-backward "[^ \t\n]" nil t)) - (if (save-excursion - (outline-next-heading) - (if (> (outline-recent-depth) ref-depth) - ;; This is an offspring. - (progn (forward-line -1) - (looking-at "^\\s-*$")))) - (progn (forward-line 1) - (outline-unprotected (open-line 1)))) - (end-of-line)) - ;;(if doing-beginning (goto-char doing-beginning)) - (if (not (bobp)) - (progn (if (and (not (> depth ref-depth)) - (not before)) - (outline-unprotected (open-line 1)) - (if (> depth ref-depth) - (outline-unprotected (newline 1)) - (if dbl-space - (outline-unprotected (open-line 1)) - (if (not before) - (outline-unprotected (newline 1)))))) - (if dbl-space - (outline-unprotected (newline 1))) - (if (and (not (eobp)) - (not (bolp))) - (forward-char 1)))) - )) - (insert-string (concat (outline-make-topic-prefix opening-numbered - t - depth) - " ")) - - ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1)))) - - - (outline-rebullet-heading (and use_sib_bullet ref-bullet);;; solicit - depth ;;; depth - nil ;;; number-control - nil ;;; index - t) (end-of-line) - ) - ) -;;;_ . open-topic contingencies -;;;_ ; base topic - one from which open was issued -;;;_ , beginning char -;;;_ , amount of space before will be used, unless opening in place -;;;_ , end char will be used, unless opening before (and it still may) -;;;_ ; absolute depth of new topic -;;;_ ! insert in place - overrides most stuff -;;;_ ; relative depth of new re base -;;;_ ; before or after base topic -;;;_ ; spacing around topic, if any, prior to new topic and at same depth -;;;_ ; buffer boundaries - special provisions for beginning and end ob -;;;_ ; level 1 topics have special provisions also - double space. -;;;_ ; location of new topic -;;;_ > outline-open-subtopic (arg) -(defun outline-open-subtopic (arg) - "Open new topic header at deeper level than the current one. - -Negative universal arg means to open deeper, but place the new topic -prior to the current one." - (interactive "p") - (outline-open-topic 1 (> 0 arg))) -;;;_ > outline-open-sibtopic (arg) -(defun outline-open-sibtopic (arg) - "Open new topic header at same level as the current one. - -Positive universal arg means to use the bullet of the prior sibling. - -Negative universal arg means to place the new topic prior to the current -one." - (interactive "p") - (outline-open-topic 0 (> 0 arg) (< 1 arg))) -;;;_ > outline-open-supertopic (arg) -(defun outline-open-supertopic (arg) - "Open new topic header at shallower level than the current one. - -Negative universal arg means to open shallower, but place the new -topic prior to the current one." - - (interactive "p") - (outline-open-topic -1 (> 0 arg))) - -;;;_ - Outline Alteration -;;;_ : Topic Modification -;;;_ = outline-former-auto-filler -(defvar outline-former-auto-filler nil - "Name of modal fill function being wrapped by outline-auto-fill.") -;;;_ > outline-auto-fill () -(defun outline-auto-fill () - "Outline-mode autofill function. - -Maintains outline hanging topic indentation if -`outline-use-hanging-indents' is set." - (let ((fill-prefix (if outline-use-hanging-indents - ;; Check for topic header indentation: - (save-excursion - (beginning-of-line) - (if (looking-at outline-regexp) - ;; ... construct indentation to account for - ;; length of topic prefix: - (make-string (progn (outline-end-of-prefix) - (current-column)) - ?\ )))))) - (if (or outline-former-auto-filler outline-use-hanging-indents) - (do-auto-fill)))) -;;;_ > outline-reindent-body (old-depth new-depth &optional number) -(defun outline-reindent-body (old-depth new-depth &optional number) - "Reindent body lines which were indented at old-depth to new-depth. - -Optional arg NUMBER indicates numbering is being added, and it must -be accommodated. - -Note that refill of indented paragraphs is not done." - - (save-excursion - (outline-end-of-prefix) - (let* ((new-margin (current-column)) - excess old-indent-begin old-indent-end - curr-ind - ;; We want the column where the header-prefix text started - ;; *before* the prefix was changed, so we infer it relative - ;; to the new margin and the shift in depth: - (old-margin (+ old-depth (- new-margin new-depth)))) - - ;; Process lines up to (but excluding) next topic header: - (outline-unprotected - (save-match-data - (while - (and (re-search-forward "[\n\r]\\(\\s-*\\)" - nil - t) - ;; Register the indent data, before we reset the - ;; match data with a subsequent `looking-at': - (setq old-indent-begin (match-beginning 1) - old-indent-end (match-end 1)) - (not (looking-at outline-regexp))) - (if (> 0 (setq excess (- (current-column) - old-margin))) - ;; Text starts left of old margin - don't adjust: - nil - ;; Text was hanging at or right of old left margin - - ;; reindent it, preserving its existing indentation - ;; beyond the old margin: - (delete-region old-indent-begin old-indent-end) - (indent-to (+ new-margin excess))))))))) -;;;_ > outline-rebullet-current-heading (arg) -(defun outline-rebullet-current-heading (arg) - "Solicit new bullet for current visible heading." - (interactive "p") - (let ((initial-col (current-column)) - (on-bullet (eq (point)(outline-current-bullet-pos))) - (backwards (if (< arg 0) - (setq arg (* arg -1))))) - (while (> arg 0) - (save-excursion (outline-back-to-current-heading) - (outline-end-of-prefix) - (outline-rebullet-heading t ;;; solicit - nil ;;; depth - nil ;;; number-control - nil ;;; index - t)) ;;; do-successors - (setq arg (1- arg)) - (if (<= arg 0) - nil - (setq initial-col nil) ; Override positioning back to init col - (if (not backwards) - (outline-next-visible-heading 1) - (outline-goto-prefix) - (outline-next-visible-heading -1)))) - (message "Done.") - (cond (on-bullet (goto-char (outline-current-bullet-pos))) - (initial-col (move-to-column initial-col))))) -;;;_ > outline-rebullet-heading (&optional solicit ...) -(defun outline-rebullet-heading (&optional solicit - new-depth - number-control - index - do-successors) - - "Adjust bullet of current topic prefix. - -All args are optional. - -If SOLICIT is non-nil, then the choice of bullet is solicited from -user. If it's a character, then that character is offered as the -default, otherwise the one suited to the context \(according to -distinction or depth) is offered. If non-nil, then the -context-specific bullet is just used. - -Second arg DEPTH forces the topic prefix to that depth, regardless -of the topic's current depth. - -Third arg NUMBER-CONTROL can force the prefix to or away from -numbered form. It has effect only if `outline-numbered-bullet' is -non-nil and soliciting was not explicitly invoked (via first arg). -Its effect, numbering or denumbering, then depends on the setting -of the forth arg, INDEX. - -If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the -prefix of the topic is forced to be non-numbered. Null index and -non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and -non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil -INDEX is a number, then that number is used for the numbered -prefix. Non-nil and non-number means that the index for the -numbered prefix will be derived by outline-make-topic-prefix. - -Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding -siblings. - -Cf vars `outline-stylish-prefixes', `outline-old-style-prefixes', -and `outline-numbered-bullet', which all affect the behavior of -this function." - - (let* ((current-depth (outline-depth)) - (new-depth (or new-depth current-depth)) - (mb outline-recent-prefix-beginning) - (me outline-recent-prefix-end) - (current-bullet (buffer-substring (- me 1) me)) - (new-prefix (outline-make-topic-prefix current-bullet - nil - new-depth - solicit - number-control - index))) - - ;; Is new one is identical to old? - (if (and (= current-depth new-depth) - (string= current-bullet - (substring new-prefix (1- (length new-prefix))))) - ;; Nothing to do: - t - - ;; New prefix probably different from old: - ; get rid of old one: - (outline-unprotected (delete-region mb me)) - (goto-char mb) - ; Dispense with number if - ; numbered-bullet prefix: - (if (and outline-numbered-bullet - (string= outline-numbered-bullet current-bullet) - (looking-at "[0-9]+")) - (outline-unprotected - (delete-region (match-beginning 0)(match-end 0)))) - - ; Put in new prefix: - (outline-unprotected (insert-string new-prefix)) - - ;; Reindent the body if elected and margin changed: - (if (and outline-reindent-bodies - (not (= new-depth current-depth))) - (outline-reindent-body current-depth new-depth)) - - ;; Recursively rectify successive siblings of orig topic if - ;; caller elected for it: - (if do-successors - (save-excursion - (while (outline-next-sibling new-depth nil) - (setq index - (cond ((numberp index) (1+ index)) - ((not number-control) (outline-sibling-index)))) - (if (outline-numbered-type-prefix) - (outline-rebullet-heading nil ;;; solicit - new-depth ;;; new-depth - number-control;;; number-control - index ;;; index - nil))))) ;;;(dont!)do-successors - ) ; (if (and (= current-depth new-depth)...)) - ) ; let* ((current-depth (outline-depth))...) - ) ; defun -;;;_ > outline-rebullet-topic (arg) -(defun outline-rebullet-topic (arg) - "Like outline-rebullet-topic-grunt, but start from topic visible at point. - -Descends into invisible as well as visible topics, however. - -With repeat count, shift topic depth by that amount." - (interactive "P") - (let ((start-col (current-column)) - (was-eol (eolp))) - (save-excursion - ;; Normalize arg: - (cond ((null arg) (setq arg 0)) - ((listp arg) (setq arg (car arg)))) - ;; Fill the user in, in case we're shifting a big topic: - (if (not (zerop arg)) (message "Shifting...")) - (outline-back-to-current-heading) - (if (<= (+ (outline-recent-depth) arg) 0) - (error "Attempt to shift topic below level 1")) - (outline-rebullet-topic-grunt arg) - (if (not (zerop arg)) (message "Shifting... done."))) - (move-to-column (max 0 (+ start-col arg))))) -;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...) -(defun outline-rebullet-topic-grunt (&optional relative-depth - starting-depth - starting-point - index - do-successors) - - "Rebullet the topic at point, visible or invisible, and all -contained subtopics. See outline-rebullet-heading for rebulleting -behavior. - -All arguments are optional. - -First arg RELATIVE-DEPTH means to shift the depth of the entire -topic that amount. - -The rest of the args are for internal recursive use by the function -itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." - - (let* ((relative-depth (or relative-depth 0)) - (new-depth (outline-depth)) - (starting-depth (or starting-depth new-depth)) - (on-starting-call (null starting-point)) - (index (or index - ;; Leave index null on starting call, so rebullet-heading - ;; calculates it at what might be new depth: - (and (or (zerop relative-depth) - (not on-starting-call)) - (outline-sibling-index)))) - (moving-outwards (< 0 relative-depth)) - (starting-point (or starting-point (point)))) - - ;; Sanity check for excessive promotion done only on starting call: - (and on-starting-call - moving-outwards - (> 0 (+ starting-depth relative-depth)) - (error "Attempt to shift topic out beyond level 1")) ;;; ====> - - (cond ((= starting-depth new-depth) - ;; We're at depth to work on this one: - (outline-rebullet-heading nil ;;; solicit - (+ starting-depth ;;; starting-depth - relative-depth) - nil ;;; number - index ;;; index - ;; Every contained topic will get hit, - ;; and we have to get to outside ones - ;; deliberately: - nil) ;;; do-successors - ;; ... and work on subsequent ones which are at greater depth: - (setq index 0) - (outline-next-heading) - (while (and (not (eobp)) - (< starting-depth (outline-recent-depth))) - (setq index (1+ index)) - (outline-rebullet-topic-grunt relative-depth ;;; relative-depth - (1+ starting-depth);;;starting-depth - starting-point ;;; starting-point - index))) ;;; index - - ((< starting-depth new-depth) - ;; Rare case - subtopic more than one level deeper than parent. - ;; Treat this one at an even deeper level: - (outline-rebullet-topic-grunt relative-depth ;;; relative-depth - new-depth ;;; starting-depth - starting-point ;;; starting-point - index))) ;;; index - - (if on-starting-call - (progn - ;; Rectify numbering of former siblings of the adjusted topic, - ;; if topic has changed depth - (if (or do-successors - (and (not (zerop relative-depth)) - (or (= (outline-recent-depth) starting-depth) - (= (outline-recent-depth) (+ starting-depth - relative-depth))))) - (outline-rebullet-heading nil nil nil nil t)) - ;; Now rectify numbering of new siblings of the adjusted topic, - ;; if depth has been changed: - (progn (goto-char starting-point) - (if (not (zerop relative-depth)) - (outline-rebullet-heading nil nil nil nil t))))) - ) - ) -;;;_ > outline-renumber-to-depth (&optional depth) -(defun outline-renumber-to-depth (&optional depth) - "Renumber siblings at current depth. - -Affects superior topics if optional arg DEPTH is less than current depth. - -Returns final depth." - - ;; Proceed by level, processing subsequent siblings on each, - ;; ascending until we get shallower than the start depth: - - (let ((ascender (outline-depth)) - was-eobp) - (while (and (not (eobp)) - (outline-depth) - (>= (outline-recent-depth) depth) - (>= ascender depth)) - ; Skip over all topics at - ; lesser depths, which can not - ; have been disturbed: - (while (and (not (setq was-eobp (eobp))) - (> (outline-recent-depth) ascender)) - (outline-next-heading)) - ; Prime ascender for ascension: - (setq ascender (1- (outline-recent-depth))) - (if (>= (outline-recent-depth) depth) - (outline-rebullet-heading nil ;;; solicit - nil ;;; depth - nil ;;; number-control - nil ;;; index - t)) ;;; do-successors - (if was-eobp (goto-char (point-max))))) - (outline-recent-depth)) -;;;_ > outline-number-siblings (&optional denumber) -(defun outline-number-siblings (&optional denumber) - "Assign numbered topic prefix to this topic and its siblings. - -With universal argument, denumber - assign default bullet to this -topic and its siblings. - -With repeated universal argument (`^U^U'), solicit bullet for each -rebulleting each topic at this level." - - (interactive "P") - - (save-excursion - (outline-back-to-current-heading) - (outline-beginning-of-level) - (let ((depth (outline-recent-depth)) - (index (if (not denumber) 1)) - (use-bullet (equal '(16) denumber)) - (more t)) - (while more - (outline-rebullet-heading use-bullet ;;; solicit - depth ;;; depth - t ;;; number-control - index ;;; index - nil) ;;; do-successors - (if index (setq index (1+ index))) - (setq more (outline-next-sibling depth nil)))))) -;;;_ > outline-shift-in (arg) -(defun outline-shift-in (arg) - "Increase depth of current heading and any topics collapsed within it." - (interactive "p") - (outline-rebullet-topic arg)) -;;;_ > outline-shift-out (arg) -(defun outline-shift-out (arg) - "Decrease depth of current heading and any topics collapsed within it." - (interactive "p") - (outline-rebullet-topic (* arg -1))) -;;;_ : Surgery (kill-ring) functions with special provisions for outlines: -;;;_ > outline-kill-line (&optional arg) -(defun outline-kill-line (&optional arg) - "Kill line, adjusting subsequent lines suitably for outline mode." - - (interactive "*P") - (if (not (and (outline-mode-p) ; active outline mode, - outline-numbered-bullet ; numbers may need adjustment, - (bolp) ; may be clipping topic head, - (looking-at outline-regexp))) ; are clipping topic head. - ;; Above conditions do not obtain - just do a regular kill: - (kill-line arg) - ;; Ah, have to watch out for adjustments: - (let* ((depth (outline-depth))) - ; Do the kill: - (kill-line arg) - ; Provide some feedback: - (sit-for 0) - (save-excursion - ; Start with the topic - ; following killed line: - (if (not (looking-at outline-regexp)) - (outline-next-heading)) - (outline-renumber-to-depth depth))))) -;;;_ > outline-kill-topic () -(defun outline-kill-topic () - "Kill topic together with subtopics. - -Leaves primary topic's trailing vertical whitespace, if any." - - ;; Some finagling is done to make complex topic kills appear faster - ;; than they actually are. A redisplay is performed immediately - ;; after the region is disposed of, though the renumbering process - ;; has yet to be performed. This means that there may appear to be - ;; a lag *after* the kill has been performed. - - (interactive) - (let* ((beg (prog1 (outline-back-to-current-heading)(beginning-of-line))) - (depth (outline-recent-depth))) - (outline-end-of-current-subtree) - (if (not (eobp)) - (if (or (not (looking-at "^$")) - ;; A blank line - cut it with this topic *unless* this - ;; is the last topic at this level, in which case - ;; we'll leave the blank line as part of the - ;; containing topic: - (save-excursion - (and (outline-next-heading) - (>= (outline-recent-depth) depth)))) - (forward-char 1))) - - (kill-region beg (point)) - (sit-for 0) - (save-excursion - (outline-renumber-to-depth depth)))) -;;;_ > outline-yank-processing () -(defun outline-yank-processing (&optional arg) - - "Incidental outline-specific business to be done just after text yanks. - -Does depth adjustment of yanked topics, when: - -1 the stuff being yanked starts with a valid outline header prefix, and -2 it is being yanked at the end of a line which consists of only a valid - topic prefix. - -Also, adjusts numbering of subsequent siblings when appropriate. - -Depth adjustment alters the depth of all the topics being yanked -the amount it takes to make the first topic have the depth of the -header into which it's being yanked. - -The point is left in front of yanked, adjusted topics, rather than -at the end (and vice-versa with the mark). Non-adjusted yanks, -however, are left exactly like normal, non-outline-specific yanks." - - (interactive "*P") - ; Get to beginning, leaving - ; region around subject: - (if (< (my-mark-marker t) (point)) - (exchange-point-and-mark)) - (let* ((subj-beg (point)) - (subj-end (my-mark-marker t)) - ;; 'resituate' if yanking an entire topic into topic header: - (resituate (and (outline-e-o-prefix-p) - (looking-at (concat "\\(" outline-regexp "\\)")) - (outline-prefix-data (match-beginning 1) - (match-end 1)))) - ;; `rectify-numbering' if resituating (where several topics may - ;; be resituating) or yanking a topic into a topic slot (bol): - (rectify-numbering (or resituate - (and (bolp) (looking-at outline-regexp))))) - (if resituate - ; The yanked stuff is a topic: - (let* ((prefix-len (- (match-end 1) subj-beg)) - (subj-depth (outline-recent-depth)) - (prefix-bullet (outline-recent-bullet)) - (adjust-to-depth - ;; Nil if adjustment unnecessary, otherwise depth to which - ;; adjustment should be made: - (save-excursion - (and (goto-char subj-end) - (eolp) - (goto-char subj-beg) - (and (looking-at outline-regexp) - (progn - (beginning-of-line) - (not (= (point) subj-beg))) - (looking-at outline-regexp) - (outline-prefix-data (match-beginning 0) - (match-end 0))) - (outline-recent-depth)))) - done - (more t)) - (setq rectify-numbering outline-numbered-bullet) - (if adjust-to-depth - ; Do the adjustment: - (progn - (message "... yanking") (sit-for 0) - (save-restriction - (narrow-to-region subj-beg subj-end) - ; Trim off excessive blank - ; line at end, if any: - (goto-char (point-max)) - (if (looking-at "^$") - (outline-unprotected (delete-char -1))) - ; Work backwards, with each - ; shallowest level, - ; successively excluding the - ; last processed topic from - ; the narrow region: - (while more - (outline-back-to-current-heading) - ; go as high as we can in each bunch: - (while (outline-ascend-to-depth (1- (outline-depth)))) - (save-excursion - (outline-rebullet-topic-grunt (- adjust-to-depth - subj-depth)) - (outline-depth)) - (if (setq more (not (bobp))) - (progn (widen) - (forward-char -1) - (narrow-to-region subj-beg (point)))))) - (message "") - ;; Preserve new bullet if it's a distinctive one, otherwise - ;; use old one: - (if (string-match (regexp-quote prefix-bullet) - outline-distinctive-bullets-string) - ; Delete from bullet of old to - ; before bullet of new: - (progn - (beginning-of-line) - (delete-region (point) subj-beg) - (set-marker (my-mark-marker t) subj-end) - (goto-char subj-beg) - (outline-end-of-prefix)) - ; Delete base subj prefix, - ; leaving old one: - (delete-region (point) (+ (point) - prefix-len - (- adjust-to-depth subj-depth))) - ; and delete residual subj - ; prefix digits and space: - (while (looking-at "[0-9]") (delete-char 1)) - (if (looking-at " ") (delete-char 1)))) - (exchange-point-and-mark)))) - (if rectify-numbering - (progn - (save-excursion - ; Give some preliminary feedback: - (message "... reconciling numbers") (sit-for 0) - ; ... and renumber, in case necessary: - (goto-char subj-beg) - (if (outline-goto-prefix) - (outline-rebullet-heading nil ;;; solicit - (outline-depth) ;;; depth - nil ;;; number-control - nil ;;; index - t)) - (message "")))) - (if (not resituate) - (exchange-point-and-mark)))) -;;;_ > outline-yank (&optional arg) -(defun outline-yank (&optional arg) - "Outline-mode yank, with depth and numbering adjustment of yanked topics. - -Non-topic yanks work no differently than normal yanks. - -If a topic is being yanked into a bare topic prefix, the depth of the -yanked topic is adjusted to the depth of the topic prefix. - - 1 we're yanking in an outline-mode buffer - 2 the stuff being yanked starts with a valid outline header prefix, and - 3 it is being yanked at the end of a line which consists of only a valid - topic prefix. - -If these conditions hold then the depth of the yanked topics are all -adjusted the amount it takes to make the first one at the depth of the -header into which it's being yanked. - -The point is left in front of yanked, adjusted topics, rather than -at the end (and vice-versa with the mark). Non-adjusted yanks, -however, (ones that don't qualify for adjustment) are handled -exactly like normal yanks. - -Numbering of yanked topics, and the successive siblings at the depth -into which they're being yanked, is adjusted. - -Outline-yank-pop works with outline-yank just like normal yank-pop -works with normal yank in non-outline buffers." - - (interactive "*P") - (setq this-command 'yank) - (yank arg) - (if (outline-mode-p) - (outline-yank-processing))) -;;;_ > outline-yank-pop (&optional arg) -(defun outline-yank-pop (&optional arg) - "Yank-pop like outline-yank when popping to bare outline prefixes. - -Adapts level of popped topics to level of fresh prefix. - -Note - prefix changes to distinctive bullets will stick, if followed -by pops to non-distinctive yanks. Bug..." - - (interactive "*p") - (setq this-command 'yank) - (yank-pop arg) - (if (outline-mode-p) - (outline-yank-processing))) - -;;;_ - Specialty bullet functions -;;;_ : File Cross references -;;;_ > outline-resolve-xref () -(defun outline-resolve-xref () - "Pop to file associated with current heading, if it has an xref bullet. - -\(Works according to setting of `outline-file-xref-bullet')." - (interactive) - (if (not outline-file-xref-bullet) - (error - "outline cross references disabled - no `outline-file-xref-bullet'") - (if (not (string= (outline-current-bullet) outline-file-xref-bullet)) - (error "current heading lacks cross-reference bullet `%s'" - outline-file-xref-bullet) - (let (file-name) - (save-excursion - (let* ((text-start outline-recent-prefix-end) - (heading-end (progn (end-of-line) (point)))) - (goto-char text-start) - (setq file-name - (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t) - (buffer-substring (match-beginning 1) (match-end 1)))))) - (setq file-name - (if (not (= (aref file-name 0) ?:)) - (expand-file-name file-name) - ; A registry-files ref, strip the `:' - ; and try to follow it: - (let ((reg-ref (reference-registered-file - (substring file-name 1) nil t))) - (if reg-ref (car (cdr reg-ref)))))) - (if (or (file-exists-p file-name) - (if (file-writable-p file-name) - (y-or-n-p (format "%s not there, create one? " - file-name)) - (error "%s not found and can't be created" file-name))) - (condition-case failure - (find-file-other-window file-name) - ('error failure)) - (error "%s not found" file-name)) - ) - ) - ) - ) - -;;;_ #6 Exposure Control - -;;;_ - Fundamental -;;;_ > outline-flag-current-subtree (flag) -(defun outline-flag-current-subtree (flag) - "Hide or show subtree of currently-visible topic. - -See `outline-flag-region' for more details." - - (save-excursion - (outline-back-to-current-heading) - (outline-flag-region (point) - (progn (outline-end-of-current-subtree) (1- (point))) - flag))) - -;;;_ - Topic-specific -;;;_ > outline-show-entry () -(defun outline-show-entry () - "Like `outline-show-current-entry', reveals entries nested in hidden topics. - -This is a way to give restricted peek at a concealed locality without the -expense of exposing its context, but can leave the outline with aberrant -exposure. outline-hide-current-entry-completely or outline-show-offshoot -should be used after the peek to rectify the exposure." - - (interactive) - (save-excursion - (let ((at (point)) - beg end) - (outline-goto-prefix) - (setq beg (if (= (preceding-char) ?\r) (1- (point)) (point))) - (re-search-forward "[\n\r]" nil t) - (setq end (1- (if (< at (point)) - ;; We're on topic head line - show only it: - (point) - ;; or we're in body - include it: - (max beg (or (outline-pre-next-preface) (point)))))) - (outline-flag-region beg end ?\n) - (list beg end)))) -;;;_ > outline-show-children (&optional level strict) -(defun outline-show-children (&optional level strict) - - "If point is visible, show all direct subheadings of this heading. - -Otherwise, do outline-show-to-offshoot, and then show subheadings. - -Optional LEVEL specifies how many levels below the current level -should be shown, or all levels if t. Default is 1. - -Optional STRICT means don't resort to -show-to-offshoot, no matter -what. This is basically so -show-to-offshoot, which is called by -this function, can employ the pure offspring-revealing capabilities of -it. - -Returns point at end of subtree that was opened, if any. (May get a -point of non-opened subtree?)" - - (interactive "p") - (let (max-pos) - (if (and (not strict) - (outline-hidden-p)) - - (progn (outline-show-to-offshoot) ; Point's concealed, open to - ; expose it. - ;; Then recurse, but with "strict" set so we don't - ;; infinite regress: - (setq max-pos (outline-show-children level t))) - - (save-excursion - (save-restriction - (let* ((start-pt (point)) - (chart (outline-chart-subtree (or level 1))) - (to-reveal (outline-chart-to-reveal chart (or level 1)))) - (goto-char start-pt) - (if (and strict (= (preceding-char) ?\r)) - ;; Concealed root would already have been taken care of, - ;; unless strict was set. - (progn - (outline-flag-region (point) (outline-snug-back) ?\n) - (if outline-show-bodies - (progn (goto-char (car to-reveal)) - (outline-show-current-entry))))) - (while to-reveal - (goto-char (car to-reveal)) - (outline-flag-region (point) (outline-snug-back) ?\n) - (if outline-show-bodies - (progn (goto-char (car to-reveal)) - (outline-show-current-entry))) - (setq to-reveal (cdr to-reveal))))))))) -;;;_ > outline-hide-point-reconcile () -(defun outline-hide-reconcile () - "Like `outline-hide-current-entry'; hides completely if within hidden region. - -Specifically intended for aberrant exposure states, like entries that were -exposed by outline-show-entry but are within otherwise concealed regions." - (interactive) - (save-excursion - (outline-goto-prefix) - (outline-flag-region (if (not (bobp)) (1- (point)) (point)) - (progn (outline-pre-next-preface) - (if (= ?\r (following-char)) - (point) - (1- (point)))) - ?\r))) -;;;_ > outline-show-to-offshoot () -(defun outline-show-to-offshoot () - "Like outline-show-entry, but reveals all concealed ancestors, as well. - -As with outline-hide-current-entry-completely, useful for rectifying -aberrant exposure states produced by outline-show-entry." - - (interactive) - (save-excursion - (let ((orig-pt (point)) - (orig-pref (outline-goto-prefix)) - (last-at (point)) - bag-it) - (while (or bag-it (= (preceding-char) ?\r)) - (beginning-of-line) - (if (= last-at (setq last-at (point))) - ;; Oops, we're not making any progress! Show the current - ;; topic completely, and bag this try. - (progn (beginning-of-line) - (outline-show-current-subtree) - (goto-char orig-pt) - (setq bag-it t) - (beep) - (message "%s: %s" - "outline-show-to-offshoot: " - "Aberrant nesting encountered."))) - (outline-show-children) - (goto-char orig-pref)) - (goto-char orig-pt))) - (if (outline-hidden-p) - (outline-show-entry))) -;;;_ > outline-hide-current-entry () -(defun outline-hide-current-entry () - "Hide the body directly following this heading." - (interactive) - (outline-back-to-current-heading) - (save-excursion - (outline-flag-region (point) - (progn (outline-end-of-current-entry) (point)) - ?\r))) -;;;_ > outline-show-current-entry (&optional arg) -(defun outline-show-current-entry (&optional arg) - - "Show body following current heading, or hide the entry if repeat count." - - (interactive "P") - (if arg - (outline-hide-current-entry) - (save-excursion - (outline-flag-region (point) - (progn (outline-end-of-current-entry) (point)) - ?\n)))) -;;;_ > outline-hide-current-entry-completely () -; ... outline-hide-current-entry-completely also for isearch dynamic exposure: -(defun outline-hide-current-entry-completely () - "Like outline-hide-current-entry, but conceal topic completely. - -Specifically intended for aberrant exposure states, like entries that were -exposed by outline-show-entry but are within otherwise concealed regions." - (interactive) - (save-excursion - (outline-goto-prefix) - (outline-flag-region (if (not (bobp)) (1- (point)) (point)) - (progn (outline-pre-next-preface) - (if (= ?\r (following-char)) - (point) - (1- (point)))) - ?\r))) -;;;_ > outline-show-current-subtree (&optional arg) -(defun outline-show-current-subtree (&optional arg) - "Show everything within the current topic. With a repeat-count, -expose this topic and its siblings." - (interactive "P") - (save-excursion - (if (<= (outline-current-depth) 0) - ;; Outside any topics - try to get to the first: - (if (not (outline-next-heading)) - (error "No topics") - ;; got to first, outermost topic - set to expose it and siblings: - (message "Above outermost topic - exposing all.") - (outline-flag-region (point-min)(point-max) ?\n)) - (if (not arg) - (outline-flag-current-subtree ?\n) - (outline-beginning-of-level) - (outline-expose-topic '(* :)))))) -;;;_ > outline-hide-current-subtree (&optional just-close) -(defun outline-hide-current-subtree (&optional just-close) - "Close the current topic, or containing topic if this one is already closed. - -If this topic is closed and it's a top level topic, close this topic -and its siblings. - -If optional arg JUST-CLOSE is non-nil, do not treat the parent or -siblings, even if the target topic is already closed." - - (interactive) - (let ((from (point)) - (orig-eol (progn (end-of-line) - (if (not (outline-goto-prefix)) - (error "No topics found") - (end-of-line)(point))))) - (outline-flag-current-subtree ?\r) - (goto-char from) - (if (and (= orig-eol (progn (goto-char orig-eol) - (end-of-line) - (point))) - (not just-close) - ;; Structure didn't change - try hiding current level: - (goto-char from) - (if (outline-up-current-level 1 t) - t - (goto-char 0) - (let ((msg - "Top-level topic already closed - closing siblings...")) - (message msg) - (outline-expose-topic '(0 :)) - (message (concat msg " Done."))) - nil) - (/= (outline-recent-depth) 0)) - (outline-hide-current-subtree)) - (goto-char from))) -;;;_ > outline-show-current-branches () -(defun outline-show-current-branches () - "Show all subheadings of this heading, but not their bodies." - (interactive) - (beginning-of-line) - (outline-show-children t)) -;;;_ > outline-hide-current-leaves () -(defun outline-hide-current-leaves () - "Hide the bodies of the current topic and all its offspring." - (interactive) - (outline-back-to-current-heading) - (outline-hide-region-body (point) (progn (outline-end-of-current-subtree) - (point)))) - -;;;_ - Region and beyond -;;;_ > outline-show-all () -(defun outline-show-all () - "Show all of the text in the buffer." - (interactive) - (message "Exposing entire buffer...") - (outline-flag-region (point-min) (point-max) ?\n) - (message "Exposing entire buffer... Done.")) -;;;_ > outline-hide-bodies () -(defun outline-hide-bodies () - "Hide all of buffer except headings." - (interactive) - (outline-hide-region-body (point-min) (point-max))) -;;;_ > outline-hide-region-body (start end) -(defun outline-hide-region-body (start end) - "Hide all body lines in the region, but not headings." - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (not (eobp)) - (outline-flag-region (point) - (progn (outline-pre-next-preface) (point)) ?\r) - (if (not (eobp)) - (forward-char - (if (looking-at "[\n\r][\n\r]") - 2 1))))))) - -;;;_ > outline-expose-topic (spec) -(defun outline-expose-topic (spec) - "Apply exposure specs to successive outline topic items. - -Use the more convenient frontend, `outline-new-exposure', if you don't -need evaluation of the arguments, or even better, the `outline-layout' -variable-keyed mode-activation/auto-exposure feature of allout outline -mode. See the respective documentation strings for more details. - -Cursor is left at start position. - -SPEC is either a number or a list. - -Successive specs on a list are applied to successive sibling topics. - -A simple spec \(either a number, one of a few symbols, or the null -list) dictates the exposure for the corresponding topic. - -Non-null lists recursively designate exposure specs for respective -subtopics of the current topic. - -The `:' repeat spec is used to specify exposure for any number of -successive siblings, up to the trailing ones for which there are -explicit specs following the `:'. - -Simple (numeric and null-list) specs are interpreted as follows: - - Numbers indicate the relative depth to open the corresponding topic. - - negative numbers force the topic to be closed before opening to the - absolute value of the number, so all siblings are open only to - that level. - - positive numbers open to the relative depth indicated by the - number, but do not force already opened subtopics to be closed. - - 0 means to close topic - hide all offspring. - : - `repeat' - apply prior element to all siblings at current level, *up to* - those siblings that would be covered by specs following the `:' - on the list. Ie, apply to all topics at level but the last - ones. \(Only first of multiple colons at same level is - respected - subsequent ones are discarded.) - * - completely opens the topic, including bodies. - + - shows all the sub headers, but not the bodies - - - exposes the body of the corresponding topic. - -Examples: -\(outline-expose-topic '(-1 : 0)) - Close this and all following topics at current level, exposing - only their immediate children, but close down the last topic - at this current level completely. -\(outline-expose-topic '(-1 () : 1 0)) - Close current topic so only the immediate subtopics are shown; - show the children in the second to last topic, and completely - close the last one. -\(outline-expose-topic '(-2 : -1 *)) - Expose children and grandchildren of all topics at current - level except the last two; expose children of the second to - last and completely open the last one." - - (interactive "xExposure spec: ") - (if (not (listp spec)) - nil - (let ((depth (outline-depth)) - (max-pos 0) - prev-elem curr-elem - stay done - snug-back - ) - (while spec - (setq prev-elem curr-elem - curr-elem (car spec) - spec (cdr spec)) - (cond ; Do current element: - ((null curr-elem) nil) - ((symbolp curr-elem) - (cond ((eq curr-elem '*) (outline-show-current-subtree) - (if (> outline-recent-end-of-subtree max-pos) - (setq max-pos outline-recent-end-of-subtree))) - ((eq curr-elem '+) (outline-show-current-branches) - (if (> outline-recent-end-of-subtree max-pos) - (setq max-pos outline-recent-end-of-subtree))) - ((eq curr-elem '-) (outline-show-current-entry)) - ((eq curr-elem ':) - (setq stay t) - ;; Expand the `repeat' spec to an explicit version, - ;; w.r.t. remaining siblings: - (let ((residue ; = # of sibs not covered by remaining spec - ;; Dang - could be nice to make use of the chart, sigh: - (- (length (outline-chart-siblings)) - (length spec)))) - (if (< 0 residue) - ;; Some residue - cover it with prev-elem: - (setq spec (append (make-list residue prev-elem) - spec))))))) - ((numberp curr-elem) - (if (and (>= 0 curr-elem) (outline-visible-p)) - (save-excursion (outline-hide-current-subtree t) - (if (> 0 curr-elem) - nil - (if (> outline-recent-end-of-subtree max-pos) - (setq max-pos - outline-recent-end-of-subtree))))) - (if (> (abs curr-elem) 0) - (progn (outline-show-children (abs curr-elem)) - (if (> outline-recent-end-of-subtree max-pos) - (setq max-pos outline-recent-end-of-subtree))))) - ((listp curr-elem) - (if (outline-descend-to-depth (1+ depth)) - (let ((got (outline-expose-topic curr-elem))) - (if (and got (> got max-pos)) (setq max-pos got)))))) - (cond (stay (setq stay nil)) - ((listp (car spec)) nil) - ((> max-pos (point)) - ;; Capitalize on max-pos state to get us nearer next sibling: - (progn (goto-char (min (point-max) max-pos)) - (outline-next-heading))) - ((outline-next-sibling depth)))) - max-pos))) -;;;_ > outline-old-expose-topic (spec &rest followers) -(defun outline-old-expose-topic (spec &rest followers) - - "Deprecated. Use outline-expose-topic \(with different schema -format) instead. - -Dictate wholesale exposure scheme for current topic, according to SPEC. - -SPEC is either a number or a list. Optional successive args -dictate exposure for subsequent siblings of current topic. - -A simple spec (either a number, a special symbol, or the null list) -dictates the overall exposure for a topic. Non null lists are -composite specs whose first element dictates the overall exposure for -a topic, with the subsequent elements in the list interpreted as specs -that dictate the exposure for the successive offspring of the topic. - -Simple (numeric and null-list) specs are interpreted as follows: - - - Numbers indicate the relative depth to open the corresponding topic: - - negative numbers force the topic to be close before opening to the - absolute value of the number. - - positive numbers just open to the relative depth indicated by the number. - - 0 just closes - - `*' completely opens the topic, including bodies. - - `+' shows all the sub headers, but not the bodies - - `-' exposes the body and immediate offspring of the corresponding topic. - -If the spec is a list, the first element must be a number, which -dictates the exposure depth of the topic as a whole. Subsequent -elements of the list are nested SPECs, dictating the specific exposure -for the corresponding offspring of the topic. - -Optional FOLLOWER arguments dictate exposure for succeeding siblings." - - (interactive "xExposure spec: ") - (let ((depth (outline-current-depth)) - done - max-pos) - (cond ((null spec) nil) - ((symbolp spec) - (if (eq spec '*) (outline-show-current-subtree)) - (if (eq spec '+) (outline-show-current-branches)) - (if (eq spec '-) (outline-show-current-entry))) - ((numberp spec) - (if (>= 0 spec) - (save-excursion (outline-hide-current-subtree t) - (end-of-line) - (if (or (not max-pos) - (> (point) max-pos)) - (setq max-pos (point))) - (if (> 0 spec) - (setq spec (* -1 spec))))) - (if (> spec 0) - (outline-show-children spec))) - ((listp spec) - ;(let ((got (outline-old-expose-topic (car spec)))) - ; (if (and got (or (not max-pos) (> got max-pos))) - ; (setq max-pos got))) - (let ((new-depth (+ (outline-current-depth) 1)) - got) - (setq max-pos (outline-old-expose-topic (car spec))) - (setq spec (cdr spec)) - (if (and spec - (outline-descend-to-depth new-depth) - (not (outline-hidden-p))) - (progn (setq got (apply 'outline-old-expose-topic spec)) - (if (and got (or (not max-pos) (> got max-pos))) - (setq max-pos got))))))) - (while (and followers - (progn (if (and max-pos (< (point) max-pos)) - (progn (goto-char max-pos) - (setq max-pos nil))) - (end-of-line) - (outline-next-sibling depth))) - (outline-old-expose-topic (car followers)) - (setq followers (cdr followers))) - max-pos)) -;;;_ > outline-new-exposure '() -(defmacro outline-new-exposure (&rest spec) - "Literal frontend for `outline-expose-topic', doesn't evaluate arguments. -Some arguments that would need to be quoted in outline-expose-topic -need not be quoted in outline-new-exposure. - -Cursor is left at start position. - -Use this instead of obsolete `outline-exposure'. - -Examples: -\(outline-exposure (-1 () () () 1) 0) - Close current topic at current level so only the immediate - subtopics are shown, except also show the children of the - third subtopic; and close the next topic at the current level. -\(outline-exposure : -1 0) - Close all topics at current level to expose only their - immediate children, except for the last topic at the current - level, in which even its immediate children are hidden. -\(outline-exposure -2 : -1 *) - Expose children and grandchildren of first topic at current - level, and expose children of subsequent topics at current - level *except* for the last, which should be opened completely." - (list 'save-excursion - '(if (not (or (outline-goto-prefix) - (outline-next-heading))) - (error "outline-new-exposure: Can't find any outline topics")) - (list 'outline-expose-topic (list 'quote spec)))) -;;;_ > outline-exposure '() -(defmacro outline-exposure (&rest spec) - "Being deprecated - use more recent `outline-new-exposure' instead. - -Literal frontend for `outline-old-expose-topic', doesn't evaluate arguments -and retains start position." - (list 'save-excursion - '(if (not (or (outline-goto-prefix) - (outline-next-heading))) - (error "Can't find any outline topics")) - (cons 'outline-old-expose-topic - (mapcar (function (lambda (x) (list 'quote x))) spec)))) - -;;;_ #7 Systematic outline presentation - copying, printing, flattening - -;;;_ - Mapping and processing of topics -;;;_ ( See also Subtree Charting, in Navigation code.) -;;;_ > outline-stringify-flat-index (flat-index) -(defun outline-stringify-flat-index (flat-index &optional context) - "Convert list representing section/subsection/... to document string. - -Optional arg CONTEXT indicates interior levels to include." - (let ((delim ".") - result - numstr - (context-depth (or (and context 2) 1))) - ;; Take care of the explicit context: - (while (> context-depth 0) - (setq numstr (int-to-string (car flat-index)) - flat-index (cdr flat-index) - result (if flat-index - (cons delim (cons numstr result)) - (cons numstr result)) - context-depth (if flat-index (1- context-depth) 0))) - (setq delim " ") - ;; Take care of the indentation: - (if flat-index - (progn - (while flat-index - (setq result - (cons delim - (cons (make-string - (1+ (truncate (if (zerop (car flat-index)) - 1 - (log10 (car flat-index))))) - ? ) - result))) - (setq flat-index (cdr flat-index))) - ;; Dispose of single extra delim: - (setq result (cdr result)))) - (apply 'concat result))) -;;;_ > outline-stringify-flat-index-plain (flat-index) -(defun outline-stringify-flat-index-plain (flat-index) - "Convert list representing section/subsection/... to document string." - (let ((delim ".") - result) - (while flat-index - (setq result (cons (int-to-string (car flat-index)) - (if result - (cons delim result)))) - (setq flat-index (cdr flat-index))) - (apply 'concat result))) -;;;_ > outline-stringify-flat-index-indented (flat-index) -(defun outline-stringify-flat-index-indented (flat-index) - "Convert list representing section/subsection/... to document string." - (let ((delim ".") - result - numstr) - ;; Take care of the explicit context: - (setq numstr (int-to-string (car flat-index)) - flat-index (cdr flat-index) - result (if flat-index - (cons delim (cons numstr result)) - (cons numstr result))) - (setq delim " ") - ;; Take care of the indentation: - (if flat-index - (progn - (while flat-index - (setq result - (cons delim - (cons (make-string - (1+ (truncate (if (zerop (car flat-index)) - 1 - (log10 (car flat-index))))) - ? ) - result))) - (setq flat-index (cdr flat-index))) - ;; Dispose of single extra delim: - (setq result (cdr result)))) - (apply 'concat result))) -;;;_ > outline-listify-exposed (&optional start end format) -(defun outline-listify-exposed (&optional start end format) - - "Produce a list representing exposed topics in current region. - -This list can then be used by `outline-process-exposed' to manipulate -the subject region. - -Optional START and END indicate bounds of region. - -optional arg, FORMAT, designates an alternate presentation form for -the prefix: - - list - Present prefix as numeric section.subsection..., starting with - section indicated by the list, innermost nesting first. - `indent' \(symbol) - Convert header prefixes to all white space, - except for distinctive bullets. - -The elements of the list produced are lists that represents a topic -header and body. The elements of that list are: - - - a number representing the depth of the topic, - - a string representing the header-prefix, including trailing whitespace and - bullet. - - a string representing the bullet character, - - and a series of strings, each containing one line of the exposed - portion of the topic entry." - - (interactive "r") - (save-excursion - (let* - ;; state vars: - (strings prefix pad result depth new-depth out gone-out bullet beg - next done) - - (goto-char start) - (beginning-of-line) - ;; Goto initial topic, and register preceeding stuff, if any: - (if (> (outline-goto-prefix) start) - ;; First topic follows beginning point - register preliminary stuff: - (setq result (list (list 0 "" nil - (buffer-substring start (1- (point))))))) - (while (and (not done) - (not (eobp)) ; Loop until we've covered the region. - (not (> (point) end))) - (setq depth (outline-recent-depth) ; Current topics depth, - bullet (outline-recent-bullet) ; ... bullet, - prefix (outline-recent-prefix) - beg (progn (outline-end-of-prefix t) (point))) ; and beginning. - (setq done ; The boundary for the current topic: - (not (outline-next-visible-heading 1))) - (setq new-depth (outline-recent-depth)) - (setq gone-out out - out (< new-depth depth)) - (beginning-of-line) - (setq next (point)) - (goto-char beg) - (setq strings nil) - (while (> next (point)) ; Get all the exposed text in - (setq strings - (cons (buffer-substring - beg - ;To hidden text or end of line: - (progn - (search-forward "\r" - (save-excursion (end-of-line) - (point)) - 1) - (if (= (preceding-char) ?\r) - (1- (point)) - (point)))) - strings)) - (if (< (point) next) ; Resume from after hid text, if any. - (forward-line 1)) - (setq beg (point))) - ;; Accumulate list for this topic: - (setq strings (nreverse strings)) - (setq result - (cons - (if format - (let ((special (if (string-match - (regexp-quote bullet) - outline-distinctive-bullets-string) - bullet))) - (cond ((listp format) - (list depth - (if outline-abbreviate-flattened-numbering - (outline-stringify-flat-index format - gone-out) - (outline-stringify-flat-index-plain - format)) - strings - special)) - ((eq format 'indent) - (if special - (list depth - (concat (make-string (1+ depth) ? ) - (substring prefix -1)) - strings) - (list depth - (make-string depth ? ) - strings))) - (t (error "outline-listify-exposed: %s %s" - "invalid format" format)))) - (list depth prefix strings)) - result)) - ;; Reasses format, if any: - (if (and format (listp format)) - (cond ((= new-depth depth) - (setq format (cons (1+ (car format)) - (cdr format)))) - ((> new-depth depth) ; descending - assume by 1: - (setq format (cons 1 format))) - (t - ; Pop the residue: - (while (< new-depth depth) - (setq format (cdr format)) - (setq depth (1- depth))) - ; And increment the current one: - (setq format - (cons (1+ (or (car format) - -1)) - (cdr format))))))) - ;; Put the list with first at front, to last at back: - (nreverse result)))) -;;;_ > outline-process-exposed (&optional func from to frombuf -;;; tobuf format) -(defun outline-process-exposed (&optional func from to frombuf tobuf - format &optional start-num) - "Map function on exposed parts of current topic; results to another buffer. - -All args are options; default values itemized below. - -Apply FUNCTION to exposed portions FROM position TO position in buffer -FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an -alternate presentation form: - - `flat' - Present prefix as numeric section.subsection..., starting with - section indicated by the start-num, innermost nesting first. - X`flat-indented' - Prefix is like `flat' for first topic at each - X level, but subsequent topics have only leaf topic - X number, padded with blanks to line up with first. - `indent' \(symbol) - Convert header prefixes to all white space, - except for distinctive bullets. - -Defaults: - FUNCTION: `outline-insert-listified' - FROM: region start, if region active, else start of buffer - TO: region end, if region active, else end of buffer - FROMBUF: current buffer - TOBUF: buffer name derived: \"*current-buffer-name exposed*\" - FORMAT: nil" - - ; Resolve arguments, - ; defaulting if necessary: - (if (not func) (setq func 'outline-insert-listified)) - (if (not (and from to)) - (if (my-region-active-p) - (setq from (region-beginning) to (region-end)) - (setq from (point-min) to (point-max)))) - (if frombuf - (if (not (bufferp frombuf)) - ;; Specified but not a buffer - get it: - (let ((got (get-buffer frombuf))) - (if (not got) - (error (concat "outline-process-exposed: source buffer " - frombuf - " not found.")) - (setq frombuf got)))) - ;; not specified - default it: - (setq frombuf (current-buffer))) - (if tobuf - (if (not (bufferp tobuf)) - (setq tobuf (get-buffer-create tobuf))) - ;; not specified - default it: - (setq tobuf (concat "*" (buffer-name frombuf) " exposed*"))) - (if (listp format) - (nreverse format)) - - (let* ((listified - (progn (set-buffer frombuf) - (outline-listify-exposed from to format)))) - (set-buffer tobuf) - (mapcar func listified) - (pop-to-buffer tobuf))) - -;;;_ - Copy exposed -;;;_ > outline-insert-listified (listified) -(defun outline-insert-listified (listified) - "Insert contents of listified outline portion in current buffer. - -Listified is a list representing each topic header and body: - - \`(depth prefix text)' - -or \`(depth prefix text bullet-plus)' - -If `bullet-plus' is specified, it is inserted just after the entire prefix." - (setq listified (cdr listified)) - (let ((prefix (prog1 - (car listified) - (setq listified (cdr listified)))) - (text (prog1 - (car listified) - (setq listified (cdr listified)))) - (bullet-plus (car listified))) - (insert-string prefix) - (if bullet-plus (insert-string (concat " " bullet-plus))) - (while text - (insert-string (car text)) - (if (setq text (cdr text)) - (insert-string "\n"))) - (insert-string "\n"))) -;;;_ > outline-copy-exposed-to-buffer (&optional arg tobuf format) -(defun outline-copy-exposed-to-buffer (&optional arg tobuf format) - "Duplicate exposed portions of current outline to another buffer. - -Other buffer has current buffers name with \" exposed\" appended to it. - -With repeat count, copy the exposed parts of only the current topic. - -Optional second arg TOBUF is target buffer name. - -Optional third arg FORMAT, if non-nil, symbolically designates an -alternate presentation format for the outline: - - `flat' - Convert topic header prefixes to numeric - section.subsection... identifiers. - `indent' - Convert header prefixes to all white space, except for - distinctive bullets. - `indent-flat' - The best of both - only the first of each level has - the full path, the rest have only the section number - of the leaf, preceded by the right amount of indentation." - - (interactive "P") - (if (not tobuf) - (setq tobuf (get-buffer-create (concat "*" (buffer-name) " exposed*")))) - (let* ((start-pt (point)) - (beg (if arg (outline-back-to-current-heading) (point-min))) - (end (if arg (outline-end-of-current-subtree) (point-max))) - (buf (current-buffer)) - (start-list ())) - (if (eq format 'flat) - (setq format (if arg (save-excursion - (goto-char beg) - (outline-topic-flat-index)) - '(1)))) - (save-excursion (set-buffer tobuf)(erase-buffer)) - (outline-process-exposed 'outline-insert-listified - beg - end - (current-buffer) - tobuf - format start-list) - (goto-char (point-min)) - (pop-to-buffer buf) - (goto-char start-pt))) -;;;_ > outline-flatten-exposed-to-buffer (&optional arg tobuf) -(defun outline-flatten-exposed-to-buffer (&optional arg tobuf) - "Present numeric outline of outline's exposed portions in another buffer. - -The resulting outline is not compatable with outline mode - use -`outline-copy-exposed-to-buffer' if you want that. - -Use `outline-indented-exposed-to-buffer' for indented presentation. - -With repeat count, copy the exposed portions of only current topic. - -Other buffer has current buffers name with \" exposed\" appended to -it, unless optional second arg TOBUF is specified, in which case it is -used verbatim." - (interactive "P") - (outline-copy-exposed-to-buffer arg tobuf 'flat)) -;;;_ > outline-indented-exposed-to-buffer (&optional arg tobuf) -(defun outline-indented-exposed-to-buffer (&optional arg tobuf) - "Present indented outline of outline's exposed portions in another buffer. - -The resulting outline is not compatable with outline mode - use -`outline-copy-exposed-to-buffer' if you want that. - -Use `outline-flatten-exposed-to-buffer' for numeric sectional presentation. - -With repeat count, copy the exposed portions of only current topic. - -Other buffer has current buffers name with \" exposed\" appended to -it, unless optional second arg TOBUF is specified, in which case it is -used verbatim." - (interactive "P") - (outline-copy-exposed-to-buffer arg tobuf 'indent)) - -;;;_ - LaTeX formatting -;;;_ > outline-latex-verb-quote (str &optional flow) -(defun outline-latex-verb-quote (str &optional flow) - "Return copy of STRING for literal reproduction across latex processing. -Expresses the original characters \(including carriage returns) of the -string across latex processing." - (mapconcat (function - (lambda (char) - (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) - (concat "\\char" (number-to-string char) "{}")) - ((= char ?\n) "\\\\") - (t (char-to-string char))))) - str - "")) -;;;_ > outline-latex-verbatim-quote-curr-line () -(defun outline-latex-verbatim-quote-curr-line () - "Express line for exact \(literal) representation across latex processing. - -Adjust line contents so it is unaltered \(from the original line) -across latex processing, within the context of a `verbatim' -environment. Leaves point at the end of the line." - (beginning-of-line) - (let ((beg (point)) - (end (progn (end-of-line)(point)))) - (goto-char beg) - (while (re-search-forward "\\\\" - ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" - end ; bounded by end-of-line - 1) ; no matches, move to end & return nil - (goto-char (match-beginning 0)) - (insert-string "\\") - (setq end (1+ end)) - (goto-char (1+ (match-end 0)))))) -;;;_ > outline-insert-latex-header (buf) -(defun outline-insert-latex-header (buf) - "Insert initial latex commands at point in BUFFER." - ;; Much of this is being derived from the stuff in appendix of E in - ;; the TeXBook, pg 421. - (set-buffer buf) - (let ((doc-style (format "\n\\documentstyle{%s}\n" - "report")) - (page-numbering (if outline-number-pages - "\\pagestyle{empty}\n" - "")) - (linesdef (concat "\\def\\beginlines{" - "\\par\\begingroup\\nobreak\\medskip" - "\\parindent=0pt\n" - " \\kern1pt\\nobreak \\obeylines \\obeyspaces " - "\\everypar{\\strut}}\n" - "\\def\\endlines{" - "\\kern1pt\\endgroup\\medbreak\\noindent}\n")) - (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n" - outline-title-style)) - (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n" - outline-label-style)) - (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n" - outline-head-line-style)) - (bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n" - outline-body-line-style)) - (setlength (format "%s%s%s%s" - "\\newlength{\\stepsize}\n" - "\\setlength{\\stepsize}{" - outline-indent - "}\n")) - (oneheadline (format "%s%s%s%s%s%s%s" - "\\newcommand{\\OneHeadLine}[3]{%\n" - "\\noindent%\n" - "\\hspace*{#2\\stepsize}%\n" - "\\labelcmd{#1}\\hspace*{.2cm}" - "\\headlinecmd{#3}\\\\[" - outline-line-skip - "]\n}\n")) - (onebodyline (format "%s%s%s%s%s%s" - "\\newcommand{\\OneBodyLine}[2]{%\n" - "\\noindent%\n" - "\\hspace*{#1\\stepsize}%\n" - "\\bodylinecmd{#2}\\\\[" - outline-line-skip - "]\n}\n")) - (begindoc "\\begin{document}\n\\begin{center}\n") - (title (format "%s%s%s%s" - "\\titlecmd{" - (outline-latex-verb-quote (if outline-title - (condition-case err - (eval outline-title) - ('error "")) - "Unnamed Outline")) - "}\n" - "\\end{center}\n\n")) - (hsize "\\hsize = 7.5 true in\n") - (hoffset "\\hoffset = -1.5 true in\n") - (vspace "\\vspace{.1cm}\n\n")) - (insert (concat doc-style - page-numbering - titlecmd - labelcmd - headlinecmd - bodylinecmd - setlength - oneheadline - onebodyline - begindoc - title - hsize - hoffset - vspace) - ))) -;;;_ > outline-insert-latex-trailer (buf) -(defun outline-insert-latex-trailer (buf) - "Insert concluding latex commands at point in BUFFER." - (set-buffer buf) - (insert "\n\\end{document}\n")) -;;;_ > outline-latexify-one-item (depth prefix bullet text) -(defun outline-latexify-one-item (depth prefix bullet text) - "Insert LaTeX commands for formatting one outline item. - -Args are the topics numeric DEPTH, the header PREFIX lead string, the -BULLET string, and a list of TEXT strings for the body." - (let* ((head-line (if text (car text))) - (body-lines (cdr text)) - (curr-line) - body-content bop) - ; Do the head line: - (insert-string (concat "\\OneHeadLine{\\verb\1 " - (outline-latex-verb-quote bullet) - "\1}{" - depth - "}{\\verb\1 " - (if head-line - (outline-latex-verb-quote head-line) - "") - "\1}\n")) - (if (not body-lines) - nil - ;;(insert-string "\\beginlines\n") - (insert-string "\\begin{verbatim}\n") - (while body-lines - (setq curr-line (car body-lines)) - (if (and (not body-content) - (not (string-match "^\\s-*$" curr-line))) - (setq body-content t)) - ; Mangle any occurrences of - ; "\end{verbatim}" in text, - ; it's special: - (if (and body-content - (setq bop (string-match "\\end{verbatim}" curr-line))) - (setq curr-line (concat (substring curr-line 0 bop) - ">" - (substring curr-line bop)))) - ;;(insert-string "|" (car body-lines) "|") - (insert-string curr-line) - (outline-latex-verbatim-quote-curr-line) - (insert-string "\n") - (setq body-lines (cdr body-lines))) - (if body-content - (setq body-content nil) - (forward-char -1) - (insert-string "\\ ") - (forward-char 1)) - ;;(insert-string "\\endlines\n") - (insert-string "\\end{verbatim}\n") - ))) -;;;_ > outline-latexify-exposed (arg &optional tobuf) -(defun outline-latexify-exposed (arg &optional tobuf) - "Format current topics exposed portions to TOBUF for latex processing. -TOBUF defaults to a buffer named the same as the current buffer, but -with \"*\" prepended and \" latex-formed*\" appended. - -With repeat count, copy the exposed portions of entire buffer." - - (interactive "P") - (if (not tobuf) - (setq tobuf - (get-buffer-create (concat "*" (buffer-name) " latexified*")))) - (let* ((start-pt (point)) - (beg (if arg (point-min) (outline-back-to-current-heading))) - (end (if arg (point-max) (outline-end-of-current-subtree))) - (buf (current-buffer))) - (set-buffer tobuf) - (erase-buffer) - (outline-insert-latex-header tobuf) - (goto-char (point-max)) - (outline-process-exposed 'outline-latexify-one-item - beg - end - buf - tobuf) - (goto-char (point-max)) - (outline-insert-latex-trailer tobuf) - (goto-char (point-min)) - (pop-to-buffer buf) - (goto-char start-pt))) - -;;;_ #8 miscellaneous -;;;_ > outline-mark-topic () -(defun outline-mark-topic () - "Put the region around topic currently containing point." - (interactive) - (beginning-of-line) - (outline-goto-prefix) - (push-mark (point)) - (outline-end-of-current-subtree) - (exchange-point-and-mark)) -;;;_ > outlineify-sticky () -;; outlinify-sticky is correct spelling; provide this alias for sticklers: -(defalias 'outlinify-sticky 'outlineify-sticky) -(defun outlineify-sticky (&optional arg) - "Activate outline mode and establish file var so it is started subsequently. - -See doc-string for `outline-layout' and `outline-init' for details on -setup for auto-startup." - - (interactive "P") - - (outline-mode t) - - (save-excursion - (goto-char (point-min)) - (if (looking-at outline-regexp) - t - (outline-open-topic 2) - (insert-string (concat "Dummy outline topic header - see" - "`outline-mode' docstring: `^Hm'.")) - (forward-line 1) - (goto-char (point-max)) - (open-line 1) - (outline-open-topic 0) - (insert-string "Local emacs vars.\n") - (outline-open-topic 1) - (insert-string "(`outline-layout' is for allout.el outline-mode)\n") - (outline-open-topic 0) - (insert-string "Local variables:\n") - (outline-open-topic 0) - (insert-string (format "outline-layout: %s\n" - (or outline-layout - '(-1 : 0)))) - (outline-open-topic 0) - (insert-string "End:\n")))) -;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) -(defun solicit-char-in-string (prompt string &optional do-defaulting) - "Solicit (with first arg PROMPT) choice of a character from string STRING. - -Optional arg DO-DEFAULTING indicates to accept empty input (CR)." - - (let ((new-prompt prompt) - got) - - (while (not got) - (message "%s" new-prompt) - - ;; We do our own reading here, so we can circumvent, eg, special - ;; treatment for `?' character. (Oughta use minibuffer keymap instead.) - (setq got - (char-to-string (let ((cursor-in-echo-area nil)) (read-char)))) - - (setq got - (cond ((string-match (regexp-quote got) string) got) - ((and do-defaulting (string= got "\r")) - ;; Return empty string to default: - "") - ((string= got "\C-g") (signal 'quit nil)) - (t - (setq new-prompt (concat prompt - got - " ...pick from: " - string - "")) - nil)))) - ;; got something out of loop - return it: - got) - ) -;;;_ > regexp-sans-escapes (string) -(defun regexp-sans-escapes (regexp &optional successive-backslashes) - "Return a copy of REGEXP with all character escapes stripped out. - -Representations of actual backslashes - '\\\\\\\\' - are left as a -single backslash. - -Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." - - (if (string= regexp "") - "" - ;; Set successive-backslashes to number if current char is - ;; backslash, or else to nil: - (setq successive-backslashes - (if (= (aref regexp 0) ?\\) - (if successive-backslashes (1+ successive-backslashes) 1) - nil)) - (if (or (not successive-backslashes) (= 2 successive-backslashes)) - ;; Include first char: - (concat (substring regexp 0 1) - (regexp-sans-escapes (substring regexp 1))) - ;; Exclude first char, but maintain count: - (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) -;;;_ > my-region-active-p () -(defmacro my-region-active-p () - (if (fboundp 'region-active-p) - '(region-active-p) - 'mark-active)) -;;;_ - add-hook definition for divergent emacsen -;;;_ > add-hook (hook function &optional append) -(if (not (fboundp 'add-hook)) - (defun add-hook (hook function &optional append) - "Add to the value of HOOK the function FUNCTION unless already present. -\(It becomes the first hook on the list unless optional APPEND is non-nil, in -which case it becomes the last). HOOK should be a symbol, and FUNCTION may be -any valid function. HOOK's value should be a list of functions, not a single -function. If HOOK is void, it is first set to nil." - (or (boundp hook) (set hook nil)) - (or (if (consp function) - ;; Clever way to tell whether a given lambda-expression - ;; is equal to anything in the hook. - (let ((tail (assoc (cdr function) (symbol-value hook)))) - (equal function tail)) - (memq function (symbol-value hook))) - (set hook - (if append - (nconc (symbol-value hook) (list function)) - (cons function (symbol-value hook))))))) -;;;_ : my-mark-marker to accomodate divergent emacsen: -(defun my-mark-marker (&optional force buffer) - "Accomodate the different signature for mark-marker across emacsen. - -GNU XEmacs takes two optional args, while mainline GNU Emacs does not, -so pass them along when appropriate." - (if (string-match " XEmacs " emacs-version) - (mark-marker force buffer) - (mark-marker))) - -;;;_ #9 Under development -;;;_ > outline-bullet-isearch (&optional bullet) -(defun outline-bullet-isearch (&optional bullet) - "Isearch \(regexp) for topic with bullet BULLET." - (interactive) - (if (not bullet) - (setq bullet (solicit-char-in-string - "ISearch for topic with bullet: " - (regexp-sans-escapes outline-bullets-string)))) - - (let ((isearch-regexp t) - (isearch-string (concat "^" - outline-header-prefix - "[ \t]*" - bullet))) - (isearch-repeat 'forward) - (isearch-mode t))) -;;;_ ? Re hooking up with isearch - use isearch-op-fun rather than -;;; wrapping the isearch functions. - -;;;_* Local emacs vars. -;;; The following `outline-layout' local variable setting: -;;; - closes all topics from the first topic to just before the third-to-last, -;;; - shows the children of the third to last (config vars) -;;; - and the second to last (code section), -;;; - and closes the last topic (this local-variables section). -;;;Local variables: -;;;outline-layout: (0 : -1 -1 0) -;;;End: - -;;; allout.el ends here diff --git a/xemacs-packages/lisp/edit-utils/array.el b/xemacs-packages/lisp/edit-utils/array.el deleted file mode 100644 index 55c831aa..00000000 --- a/xemacs-packages/lisp/edit-utils/array.el +++ /dev/null @@ -1,951 +0,0 @@ -;;; array.el --- array editing commands for XEmacs - -;; Copyright (C) 1987 Free Software Foundation, Inc. - -;; Author David M. Brown -;; Maintainer: FSF -;; Keywords: extensions - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: FSF 19.34. - -;;; Commentary: - -;; Commands for editing a buffer interpreted as a rectangular array -;; or matrix of whitespace-separated strings. You specify the array -;; dimensions and some other parameters at startup time. - -;; Written by dmb%morgoth@harvard.harvard.edu (address is old) -;; (David M. Brown at Goldberg-Zoino & Associates, Inc.) -;; Thanks to cph@kleph.ai.mit.edu for assistance - -;; To do: -;; Smooth initialization process by grokking local variables list -;; at end of buffer or parsing buffer using whitespace as delimiters. -;; Make 'array-copy-column-right faster. - - -;;; Code: - -;;; Internal information functions. - -(defun array-cursor-in-array-range () - "Returns t if the cursor is in a valid array cell. -Its ok to be on a row number line." - (let ((columns-last-line (% max-column columns-per-line))) - ;; Requires buffer-line and buffer-column to be current. - (not (or - ;; The cursor is too far to the right. - (>= buffer-column line-length) - ;; The cursor is below the last row. - (>= buffer-line (* lines-per-row max-row)) - ;; The cursor is on the last line of the row, the line is smaller - ;; than the others, and the cursor is after the last array column - ;; on the line. - (and (zerop (% (1+ buffer-line) lines-per-row)) - (not (zerop columns-last-line)) - (>= buffer-column (* columns-last-line field-width))))))) - -(defun array-current-row () - "Return the array row of the field in which the cursor is located." - ;; Requires buffer-line and buffer-column to be current. - (and (array-cursor-in-array-range) - (1+ (floor buffer-line lines-per-row)))) - -(defun array-current-column () - "Return the array column of the field in which the cursor is located." - ;; Requires buffer-line and buffer-column to be current. - (and (array-cursor-in-array-range) - ;; It's not okay to be on a row number line. - (not (and rows-numbered - (zerop (% buffer-line lines-per-row)))) - (+ - ;; Array columns due to line differences. - (* columns-per-line - (if rows-numbered - (1- (% buffer-line lines-per-row)) - (% buffer-line lines-per-row))) - ;; Array columns on the current line. - (1+ (floor buffer-column field-width))))) - -(defun array-update-array-position (&optional a-row a-column) - "Set `array-row' and `array-column' to their current values or -to the optional arguments A-ROW and A-COLUMN." - ;; Requires that buffer-line and buffer-column be current. - (setq array-row (or a-row (array-current-row)) - array-column (or a-column (array-current-column)))) - -(defun array-update-buffer-position () - "Set buffer-line and buffer-column to their current values." - (setq buffer-line (current-line) - buffer-column (current-column))) - - - -;;; Information commands. - -(defun array-what-position () - "Display the row and column in which the cursor is positioned." - (interactive) - (let ((buffer-line (current-line)) - (buffer-column (current-column))) - (message "Array row: %s Array column: %s" - (prin1-to-string (array-current-row)) - (prin1-to-string (array-current-column))))) - -(defun array-display-local-variables () - "Display the current state of the local variables in the minibuffer." - (interactive) - (let ((buf (buffer-name (current-buffer)))) - (with-output-to-temp-buffer "*Local Variables*" - (buffer-disable-undo standard-output) - (terpri) - (princ (format " Buffer: %s\n\n" buf)) - (princ (format " max-row: %s\n" - (prin1-to-string max-row))) - (princ (format " max-column: %s\n" - (prin1-to-string max-column))) - (princ (format " columns-per-line: %s\n" - (prin1-to-string columns-per-line))) - (princ (format " field-width: %s\n" - (prin1-to-string field-width))) - (princ (format " rows-numbered: %s\n" - (prin1-to-string rows-numbered))) - (princ (format " lines-per-row: %s\n" - (prin1-to-string lines-per-row))) - (princ (format " line-length: %s\n" - (prin1-to-string line-length)))))) - - - -;;; Internal movement functions. - -(defun array-beginning-of-field (&optional go-there) - "Return the column of the beginning of the current field. -Optional argument GO-THERE, if non-nil, means go there too." - ;; Requires that buffer-column be current. - (let ((goal-column (- buffer-column (% buffer-column field-width)))) - (if go-there - (move-to-column-untabify goal-column) - goal-column))) - -(defun array-end-of-field (&optional go-there) - "Return the column of the end of the current array field. -If optional argument GO-THERE is non-nil, go there too." - ;; Requires that buffer-column be current. - (let ((goal-column (+ (- buffer-column (% buffer-column field-width)) - field-width))) - (if go-there - (move-to-column-untabify goal-column) - goal-column))) - -(defun array-move-to-cell (a-row a-column) - "Move to array row A-ROW and array column A-COLUMN. -Leave point at the beginning of the field and return the new buffer column." - (let ((goal-line (+ (* lines-per-row (1- a-row)) - (if rows-numbered 1 0) - (floor (1- a-column) columns-per-line))) - (goal-column (* field-width (% (1- a-column) columns-per-line)))) - (goto-char (point-min)) - (forward-line goal-line) - (move-to-column-untabify goal-column))) - -(defun array-move-to-row (a-row) - "Move to array row A-ROW preserving the current array column. -Leave point at the beginning of the field and return the new array row." - ;; Requires that buffer-line and buffer-column be current. - (let ((goal-line (+ (* lines-per-row (1- a-row)) - (% buffer-line lines-per-row))) - (goal-column (- buffer-column (% buffer-column field-width)))) - (forward-line (- goal-line buffer-line)) - (move-to-column-untabify goal-column) - a-row)) - -(defun array-move-to-column (a-column) - "Move to array column A-COLUMN preserving the current array row. -Leave point at the beginning of the field and return the new array column." - ;; Requires that buffer-line and buffer-column be current. - (let ((goal-line (+ (- buffer-line (% buffer-line lines-per-row)) - (if rows-numbered 1 0) - (floor (1- a-column) columns-per-line))) - (goal-column (* field-width (% (1- a-column) columns-per-line)))) - (forward-line (- goal-line buffer-line)) - (move-to-column-untabify goal-column) - a-column)) - -(defun array-move-one-row (sign) - "Move one array row in direction SIGN (1 or -1). -Leave point at the beginning of the field and return the new array row. -If requested to move beyond the array bounds, signal an error." - ;; Requires that buffer-line and buffer-column be current. - (let ((goal-column (array-beginning-of-field)) - (array-row (or (array-current-row) - (error "Cursor is not in a valid array cell.")))) - (cond ((and (= array-row max-row) (= sign 1)) - (error "End of array.")) - ((and (= array-row 1) (= sign -1)) - (error "Beginning of array.")) - (t - (progn - (forward-line (* sign lines-per-row)) - (move-to-column-untabify goal-column) - (+ array-row sign)))))) - -(defun array-move-one-column (sign) - "Move one array column in direction SIGN (1 or -1). -Leave point at the beginning of the field and return the new array column. -If requested to move beyond the array bounds, signal an error." - ;; Requires that buffer-line and buffer-column be current. - (let ((array-column (or (array-current-column) - (error "Cursor is not in a valid array cell.")))) - (cond ((and (= array-column max-column) (= sign 1)) - (error "End of array.")) - ((and (= array-column 1) (= sign -1)) - (error "Beginning of array.")) - (t - (cond - ;; Going backward from first column on the line. - ((and (= sign -1) (= 1 (% array-column columns-per-line))) - (forward-line -1) - (move-to-column-untabify - (* field-width (1- columns-per-line)))) - ;; Going forward from last column on the line. - ((and (= sign 1) (zerop (% array-column columns-per-line))) - (forward-line 1)) - ;; Somewhere in the middle of the line. - (t - (move-to-column-untabify (+ (array-beginning-of-field) - (* field-width sign))))) - (+ array-column sign))))) - -(defun array-normalize-cursor () - "Move the cursor to the first non-whitespace character in the field and, -if necessary, scroll horizontally to keep the cursor in view." - ;; Assumes point is at the beginning of the field. - (let ((buffer-column (current-column))) - (skip-chars-forward " \t" - (1- (save-excursion (array-end-of-field t) (point)))) - (array-maybe-scroll-horizontally))) - -(defun array-maybe-scroll-horizontally () - "If necessary, scroll horizontally to keep the cursor in view." - ;; This is only called from array-normalize-cursor so - ;; buffer-column will always be current. - (let ((w-hscroll (window-hscroll)) - (w-width (window-width))) - (cond - ((and (>= buffer-column w-hscroll) - (<= buffer-column (+ w-hscroll w-width))) - ;; It's already visible. Do nothing. - nil) - ((> buffer-column (+ w-hscroll w-width)) - ;; It's to the right. Scroll left. - (scroll-left (- (- buffer-column w-hscroll) - (/ w-width 2)))) - (t - ;; It's to the left. Scroll right. - (scroll-right (+ (- w-hscroll buffer-column) - (/ w-width 2))))))) - - - -;;; Movement commands. - -(defun array-next-row (&optional arg) - "Move down one array row, staying in the current array column. -If optional ARG is given, move down ARG array rows." - (interactive "p") - (let ((buffer-line (current-line)) - (buffer-column (current-column))) - (if (= (abs arg) 1) - (array-move-one-row arg) - (array-move-to-row - (limit-index (+ (or (array-current-row) - (error "Cursor is not in an array cell.")) - arg) - max-row)))) - (array-normalize-cursor)) - -(defun array-previous-row (&optional arg) - "Move up one array row, staying in the current array column. -If optional ARG is given, move up ARG array rows." - (interactive "p") - (array-next-row (- arg))) - -(defun array-forward-column (&optional arg) - "Move forward one field, staying in the current array row. -If optional ARG is given, move forward ARG array columns. -If necessary, keep the cursor in the window by scrolling right or left." - (interactive "p") - (let ((buffer-line (current-line)) - (buffer-column (current-column))) - (if (= (abs arg) 1) - (array-move-one-column arg) - (array-move-to-column - (limit-index (+ (or (array-current-column) - (error "Cursor is not in an array cell.")) - arg) - max-column)))) - (array-normalize-cursor)) - -(defun array-backward-column (&optional arg) - "Move backward one field, staying in the current array row. -If optional ARG is given, move backward ARG array columns. -If necessary, keep the cursor in the window by scrolling right or left." - (interactive "p") - (array-forward-column (- arg))) - -(defun array-goto-cell (a-row a-column) - "Go to array row A-ROW and array column A-COLUMN." - (interactive "nArray row: \nnArray column: ") - (array-move-to-cell - (limit-index a-row max-row) - (limit-index a-column max-column)) - (array-normalize-cursor)) - - - -;;; Internal copying functions. - -(defun array-field-string () - "Return the field string at the current cursor location." - ;; Requires that buffer-column be current. - (buffer-substring - (save-excursion (array-beginning-of-field t) (point)) - (save-excursion (array-end-of-field t) (point)))) - -(defun array-copy-once-vertically (sign) - "Copy the current field into one array row in direction SIGN (1 or -1). -Leave point at the beginning of the field and return the new array row. -If requested to move beyond the array bounds, signal an error." - ;; Requires that buffer-line, buffer-column, and copy-string be current. - (let ((a-row (array-move-one-row sign))) - (let ((inhibit-quit t)) - (delete-region (point) (save-excursion (array-end-of-field t) (point))) - (insert copy-string)) - (move-to-column buffer-column) - a-row)) - -(defun array-copy-once-horizontally (sign) - "Copy the current field into one array column in direction SIGN (1 or -1). -Leave point at the beginning of the field and return the new array column. -If requested to move beyond the array bounds, signal an error." - ;; Requires that buffer-line, buffer-column, and copy-string be current. - (let ((a-column (array-move-one-column sign))) - (array-update-buffer-position) - (let ((inhibit-quit t)) - (delete-region (point) (save-excursion (array-end-of-field t) (point))) - (insert copy-string)) - (move-to-column buffer-column) - a-column)) - -(defun array-copy-to-row (a-row) - "Copy the current field vertically into every cell up to and including A-ROW. -Leave point at the beginning of the field." - ;; Requires that buffer-line, buffer-column, array-row, and - ;; copy-string be current. - (let* ((num (- a-row array-row)) - (count (abs num)) - (sign (if (zerop count) () (/ num count)))) - (while (> count 0) - (array-move-one-row sign) - (array-update-buffer-position) - (let ((inhibit-quit t)) - (delete-region (point) (save-excursion (array-end-of-field t) (point))) - (insert copy-string)) - (move-to-column buffer-column) - (setq count (1- count))))) - -(defun array-copy-to-column (a-column) - "Copy the current field horizontally into every cell up to and including -A-COLUMN. Leave point at the beginning of the field." - ;; Requires that buffer-line, buffer-column, array-column, and - ;; copy-string be current. - (let* ((num (- a-column array-column)) - (count (abs num)) - (sign (if (zerop count) () (/ num count)))) - (while (> count 0) - (array-move-one-column sign) - (array-update-buffer-position) - (let ((inhibit-quit t)) - (delete-region (point) (save-excursion (array-end-of-field t) (point))) - (insert copy-string)) - (move-to-column buffer-column) - (setq count (1- count))))) - -(defun array-copy-to-cell (a-row a-column) - "Copy the current field into the cell at A-ROW, A-COLUMN. -Leave point at the beginning of the field." - ;; Requires that copy-string be current. - (array-move-to-cell a-row a-column) - (array-update-buffer-position) - (delete-region (point) (save-excursion (array-end-of-field t) (point))) - (insert copy-string) - (move-to-column buffer-column)) - - - -;;; Commands for copying. - -(defun array-copy-down (&optional arg) - "Copy the current field one array row down. -If optional ARG is given, copy down through ARG array rows." - (interactive "p") - (let* ((buffer-line (current-line)) - (buffer-column (current-column)) - (array-row (or (array-current-row) - (error "Cursor is not in a valid array cell."))) - (copy-string (array-field-string))) - (if (= (abs arg) 1) - (array-copy-once-vertically arg) - (array-copy-to-row - (limit-index (+ array-row arg) max-row)))) - (array-normalize-cursor)) - -(defun array-copy-up (&optional arg) - "Copy the current field one array row up. -If optional ARG is given, copy up through ARG array rows." - (interactive "p") - (array-copy-down (- arg))) - -(defun array-copy-forward (&optional arg) - "Copy the current field one array column to the right. -If optional ARG is given, copy through ARG array columns to the right." - (interactive "p") - (let* ((buffer-line (current-line)) - (buffer-column (current-column)) - (array-column (or (array-current-column) - (error "Cursor is not in a valid array cell."))) - (copy-string (array-field-string))) - (if (= (abs arg) 1) - (array-copy-once-horizontally arg) - (array-copy-to-column - (limit-index (+ array-column arg) max-column)))) - (array-normalize-cursor)) - -(defun array-copy-backward (&optional arg) - "Copy the current field one array column to the left. -If optional ARG is given, copy through ARG array columns to the left." - (interactive "p") - (array-copy-forward (- arg))) - -(defun array-copy-column-forward (&optional arg) - "Copy the entire current column in to the column to the right. -If optional ARG is given, copy through ARG array columns to the right." - (interactive "p") - (array-update-buffer-position) - (array-update-array-position) - (if (not array-column) - (error "Cursor is not in a valid array cell.")) - (message "Working...") - (let ((this-row 0)) - (while (< this-row max-row) - (setq this-row (1+ this-row)) - (array-move-to-cell this-row array-column) - (array-update-buffer-position) - (let ((copy-string (array-field-string))) - (if (= (abs arg) 1) - (array-copy-once-horizontally arg) - (array-copy-to-column - (limit-index (+ array-column arg) max-column)))))) - (message "Working...done") - (array-move-to-row array-row) - (array-normalize-cursor)) - -(defun array-copy-column-backward (&optional arg) - "Copy the entire current column one column to the left. -If optional ARG is given, copy through ARG columns to the left." - (interactive "p") - (array-copy-column-forward (- arg))) - -(defun array-copy-row-down (&optional arg) - "Copy the entire current row one row down. -If optional ARG is given, copy through ARG rows down." - (interactive "p") - (array-update-buffer-position) - (array-update-array-position) - (if (not array-row) - (error "Cursor is not in a valid array cell.")) - (cond - ((and (= array-row 1) (= arg -1)) - (error "Beginning of array.")) - ((and (= array-row max-row) (= arg 1)) - (error "End of array.")) - (t - (let* ((copy-string - (buffer-substring - (save-excursion (array-move-to-cell array-row 1) - (point)) - (save-excursion (array-move-to-cell array-row max-column) - (forward-line 1) - (point)))) - (this-row array-row) - (goal-row (limit-index (+ this-row arg) max-row)) - (num (- goal-row this-row)) - (count (abs num)) - (sign (if (not (zerop count)) (/ num count)))) - (while (> count 0) - (setq this-row (+ this-row sign)) - (array-move-to-cell this-row 1) - (let ((inhibit-quit t)) - (delete-region (point) - (save-excursion - (array-move-to-cell this-row max-column) - (forward-line 1) - (point))) - (insert copy-string)) - (setq count (1- count))) - (array-move-to-cell goal-row (or array-column 1))))) - (array-normalize-cursor)) - -(defun array-copy-row-up (&optional arg) - "Copy the entire current array row into the row above. -If optional ARG is given, copy through ARG rows up." - (interactive "p") - (array-copy-row-down (- arg))) - -(defun array-fill-rectangle () - "Copy the field at mark into every cell between mark and point." - (interactive) - ;; Bind arguments. - (array-update-buffer-position) - (let ((p-row (or (array-current-row) - (error "Cursor is not in a valid array cell."))) - (p-column (or (array-current-column) - (error "Cursor is not in a valid array cell."))) - (m-row - (save-excursion - (exchange-point-and-mark) - (array-update-buffer-position) - (or (array-current-row) - (error "Mark is not in a valid array cell.")))) - (m-column - (save-excursion - (exchange-point-and-mark) - (array-update-buffer-position) - (or (array-current-column) - (error "Mark is not in a valid array cell."))))) - (message "Working...") - (let ((top-row (min m-row p-row)) - (bottom-row (max m-row p-row)) - (left-column (min m-column p-column)) - (right-column (max m-column p-column))) - ;; Do the first row. - (let ((copy-string - (save-excursion - (array-move-to-cell m-row m-column) - (array-update-buffer-position) - (array-field-string)))) - (array-copy-to-cell top-row left-column) - (array-update-array-position top-row left-column) - (array-update-buffer-position) - (array-copy-to-column right-column)) - ;; Do the rest of the rows. - (array-move-to-cell top-row left-column) - (let ((copy-string - (buffer-substring - (point) - (save-excursion - (array-move-to-cell top-row right-column) - (setq buffer-column (current-column)) - (array-end-of-field t) - (point)))) - (this-row top-row)) - (while (/= this-row bottom-row) - (setq this-row (1+ this-row)) - (array-move-to-cell this-row left-column) - (let ((inhibit-quit t)) - (delete-region - (point) - (save-excursion - (array-move-to-cell this-row right-column) - (setq buffer-column (current-column)) - (array-end-of-field t) - (point))) - (insert copy-string))))) - (message "Working...done") - (array-goto-cell p-row p-column))) - - - -;;; Reconfiguration of the array. - -(defun array-make-template () - "Create the template of an array." - (interactive) - ;; If there is a conflict between field-width and init-string, resolve it. - (let ((check t) - (len)) - (while check - (setq init-field (read-input "Initial field value: ")) - (setq len (length init-field)) - (if (/= len field-width) - (if (y-or-n-p (format "Change field width to %d? " len)) - (progn (setq field-width len) - (setq check nil))) - (setq check nil)))) - (goto-char (point-min)) - (message "Working...") - (let ((this-row 1)) - ;; Loop through the rows. - (while (<= this-row max-row) - (if rows-numbered - (insert (format "%d:\n" this-row))) - (let ((this-column 1)) - ;; Loop through the columns. - (while (<= this-column max-column) - (insert init-field) - (if (and (zerop (% this-column columns-per-line)) - (/= this-column max-column)) - (newline)) - (setq this-column (1+ this-column)))) - (setq this-row (1+ this-row)) - (newline))) - (message "Working...done") - (array-goto-cell 1 1)) - -(defun array-reconfigure-rows (new-columns-per-line new-rows-numbered) - "Reconfigure the state of `rows-numbered' and `columns-per-line'. -NEW-COLUMNS-PER-LINE is the desired value of `columns-per-line' and -NEW-ROWS-NUMBERED (a character, either ?y or ?n) is the desired value -of rows-numbered." - (interactive "nColumns per line: \ncRows numbered? (y or n) ") - ;; Check on new-columns-per-line - (let ((check t)) - (while check - (if (and (>= new-columns-per-line 1) - (<= new-columns-per-line max-column)) - (setq check nil) - (setq new-columns-per-line - (string-to-int - (read-input - (format "Columns per line (1 - %d): " max-column))))))) - ;; Check on new-rows-numbered. It has to be done this way - ;; because interactive does not have y-or-n-p. - (cond - ((eq new-rows-numbered ?y) - (setq new-rows-numbered t)) - ((eq new-rows-numbered ?n) - (setq new-rows-numbered nil)) - (t - (setq new-rows-numbered (y-or-n-p "Rows numbered? ")))) - (message "Working...") - (array-update-buffer-position) - (let* ((main-buffer (buffer-name (current-buffer))) - (temp-buffer (make-temp-name "Array")) - (temp-max-row max-row) - (temp-max-column max-column) - (old-rows-numbered rows-numbered) - (old-columns-per-line columns-per-line) - (old-lines-per-row lines-per-row) - (old-field-width field-width) - (old-line-length line-length) - (this-row 1)) - (array-update-array-position) - ;; Do the cutting in a temporary buffer. - (copy-to-buffer temp-buffer (point-min) (point-max)) - (set-buffer temp-buffer) - (goto-char (point-min)) - (while (<= this-row temp-max-row) - ;; Deal with row number. - (cond - ((or (and old-rows-numbered new-rows-numbered) - (and (not old-rows-numbered) (not new-rows-numbered))) - ;; Nothing is changed. - ()) - ((and old-rows-numbered (not new-rows-numbered)) - ;; Delete the row number. - (kill-line 1)) - (t - ;; Add the row number. - (insert-string (format "%d:\n" this-row)))) - ;; Deal with the array columns in this row. - (cond - ((= old-columns-per-line new-columns-per-line) - ;; Nothing is changed. Go to the next row. - (forward-line (- old-lines-per-row (if old-rows-numbered 1 0)))) - (t - ;; First expand the row. Then cut it up into new pieces. - (let ((newlines-to-be-removed - (floor (1- temp-max-column) old-columns-per-line)) - (newlines-removed 0) - (newlines-to-be-added - (floor (1- temp-max-column) new-columns-per-line)) - (newlines-added 0)) - (while (< newlines-removed newlines-to-be-removed) - (move-to-column-untabify - (* (1+ newlines-removed) old-line-length)) - (kill-line 1) - (setq newlines-removed (1+ newlines-removed))) - (beginning-of-line) - (while (< newlines-added newlines-to-be-added) - (move-to-column-untabify (* old-field-width new-columns-per-line)) - (newline) - (setq newlines-added (1+ newlines-added))) - (forward-line 1)))) - (setq this-row (1+ this-row))) - (let ((inhibit-quit t)) - (set-buffer main-buffer) - (erase-buffer) - (insert-buffer temp-buffer) - ;; Update local variables. - (setq columns-per-line new-columns-per-line) - (setq rows-numbered new-rows-numbered) - (setq line-length (* old-field-width new-columns-per-line)) - (setq lines-per-row - (+ (floor (1- temp-max-column) new-columns-per-line) - (if new-rows-numbered 2 1))) - (array-goto-cell (or array-row 1) (or array-column 1))) - (kill-buffer temp-buffer)) - (message "Working...done")) - -(defun array-expand-rows () - "Expand the rows so each fits on one line and remove row numbers." - (interactive) - (array-reconfigure-rows max-column ?n)) - - - -;;; Utilities. - -(defun limit-index (index limit) - (cond ((< index 1) 1) - ((> index limit) limit) - (t index))) - -(defun xor (pred1 pred2) - "Returns the logical exclusive or of predicates PRED1 and PRED2." - (and (or pred1 pred2) - (not (and pred1 pred2)))) - -(defun current-line () - "Return the current buffer line at point. The first line is 0." - (save-excursion - (beginning-of-line) - (count-lines (point-min) (point)))) - -(defun move-to-column-untabify (column) - "Move to COLUMN on the current line, untabifying if necessary. -Return COLUMN." - (or (and (= column (move-to-column column)) - column) - ;; There is a tab in the way. - (if respect-tabs - (error "There is a TAB character in the way.") - (progn - (untabify-backward) - (move-to-column column))))) - -(defun untabify-backward () - "Untabify the preceding tab." - (save-excursion - (let ((start (point))) - (backward-char 1) - (untabify (point) start)))) - - - -;;; Array mode. - -(defvar array-mode-map nil - "Keymap used in array mode.") - -(if array-mode-map - () - (setq array-mode-map (make-keymap)) - ;; Bind keys. - (define-key array-mode-map "\M-ad" 'array-display-local-variables) - (define-key array-mode-map "\M-am" 'array-make-template) - (define-key array-mode-map "\M-ae" 'array-expand-rows) - (define-key array-mode-map "\M-ar" 'array-reconfigure-rows) - (define-key array-mode-map "\M-a=" 'array-what-position) - (define-key array-mode-map "\M-ag" 'array-goto-cell) - (define-key array-mode-map "\M-af" 'array-fill-rectangle) - (define-key array-mode-map "\C-n" 'array-next-row) - (define-key array-mode-map "\C-p" 'array-previous-row) - (define-key array-mode-map "\C-f" 'array-forward-column) - (define-key array-mode-map "\C-b" 'array-backward-column) - (define-key array-mode-map "\M-n" 'array-copy-down) - (define-key array-mode-map "\M-p" 'array-copy-up) - (define-key array-mode-map "\M-f" 'array-copy-forward) - (define-key array-mode-map "\M-b" 'array-copy-backward) - (define-key array-mode-map "\M-\C-n" 'array-copy-row-down) - (define-key array-mode-map "\M-\C-p" 'array-copy-row-up) - (define-key array-mode-map "\M-\C-f" 'array-copy-column-forward) - (define-key array-mode-map "\M-\C-b" 'array-copy-column-backward)) - -(put 'array-mode 'mode-class 'special) - -(defun array-mode () - "Major mode for editing arrays. - - Array mode is a specialized mode for editing arrays. An array is -considered to be a two-dimensional set of strings. The strings are -NOT recognized as integers or real numbers. - - The array MUST reside at the top of the buffer. - - TABs are not respected, and may be converted into spaces at any time. -Setting the variable 'respect-tabs to non-nil will prevent TAB conversion, -but will cause many functions to give errors if they encounter one. - - Upon entering array mode, you will be prompted for the values of -several variables. Others will be calculated based on the values you -supply. These variables are all local to the buffer. Other buffers -in array mode may have different values assigned to the variables. -The variables are: - -Variables you assign: - max-row: The number of rows in the array. - max-column: The number of columns in the array. - columns-per-line: The number of columns in the array per line of buffer. - field-width: The width of each field, in characters. - rows-numbered: A logical variable describing whether to ignore - row numbers in the buffer. - -Variables which are calculated: - line-length: The number of characters in a buffer line. - lines-per-row: The number of buffer lines used to display each row. - - The following commands are available (an asterisk indicates it may -take a numeric prefix argument): - - * \\\\[array-forward-column] Move forward one column. - * \\[array-backward-column] Move backward one column. - * \\[array-next-row] Move down one row. - * \\[array-previous-row] Move up one row. - - * \\[array-copy-forward] Copy the current field into the column to the right. - * \\[array-copy-backward] Copy the current field into the column to the left. - * \\[array-copy-down] Copy the current field into the row below. - * \\[array-copy-up] Copy the current field into the row above. - - * \\[array-copy-column-forward] Copy the current column into the column to the right. - * \\[array-copy-column-backward] Copy the current column into the column to the left. - * \\[array-copy-row-down] Copy the current row into the row below. - * \\[array-copy-row-up] Copy the current row into the row above. - - \\[array-fill-rectangle] Copy the field at mark into every cell with row and column - between that of point and mark. - - \\[array-what-position] Display the current array row and column. - \\[array-goto-cell] Go to a particular array cell. - - \\[array-make-template] Make a template for a new array. - \\[array-reconfigure-rows] Reconfigure the array. - \\[array-expand-rows] Expand the array (remove row numbers and - newlines inside rows) - - \\[array-display-local-variables] Display the current values of local variables. - -Entering array mode calls the function `array-mode-hook'." - - (interactive) - ;; Number of rows in the array. - (make-local-variable 'max-row) - ;; Number of columns in the array. - (make-local-variable 'max-column) - ;; Number of array columns per line. - (make-local-variable 'columns-per-line) - ;; Width of a field in the array. - (make-local-variable 'field-width) - ;; Are rows numbered in the buffer? - (make-local-variable 'rows-numbered) - ;; Length of a line in the array. - (make-local-variable 'line-length) - ;; Number of lines per array row. - (make-local-variable 'lines-per-row) - ;; Current line number of point in the buffer. - (make-local-variable 'buffer-line) - ;; Current column number of point in the buffer. - (make-local-variable 'buffer-column) - ;; Current array row location of point. - (make-local-variable 'array-row) - ;; Current array column location of point. - (make-local-variable 'array-column) - ;; Current field string being copied. - (make-local-variable 'copy-string) - ;; Should TAB conversion be prevented? - (make-local-variable 'respect-tabs) - (setq respect-tabs nil) - (array-init-local-variables) - (setq major-mode 'array-mode) - (setq mode-name "Array") - (force-mode-line-update) - (make-variable-buffer-local 'truncate-lines) - (setq truncate-lines t) - (setq overwrite-mode 'overwrite-mode-textual) - (use-local-map array-mode-map) - (run-hooks 'array-mode-hook)) - - - -;;; Initialization functions. These are not interactive. - -(defun array-init-local-variables () - "Initialize the variables associated with the -array in this buffer." - (array-init-max-row) - (array-init-max-column) - (array-init-columns-per-line) - (array-init-field-width) - (array-init-rows-numbered) - (array-init-line-length) - (array-init-lines-per-row) - (message "")) - -(defun array-init-max-row (&optional arg) - "Initialize the value of max-row." - (setq max-row - (or arg (string-to-int (read-input "Number of array rows: "))))) - -(defun array-init-max-column (&optional arg) - "Initialize the value of max-column." - (setq max-column - (or arg (string-to-int (read-input "Number of array columns: "))))) - -(defun array-init-columns-per-line (&optional arg) - "Initialize the value of columns-per-line." - (setq columns-per-line - (or arg (string-to-int (read-input "Array columns per line: "))))) - -(defun array-init-field-width (&optional arg) - "Initialize the value of field-width." - (setq field-width - (or arg (string-to-int (read-input "Field width: "))))) - -(defun array-init-rows-numbered (&optional arg) - "Initialize the value of rows-numbered." - (setq rows-numbered - (or arg (y-or-n-p "Rows numbered? ")))) - -(defun array-init-line-length (&optional arg) - "Initialize the value of line-length." - (setq line-length - (or arg - (* field-width columns-per-line)))) - -(defun array-init-lines-per-row (&optional arg) - "Initialize the value of lines-per-row." - (setq lines-per-row - (or arg - (+ (floor (1- max-column) columns-per-line) - (if rows-numbered 2 1))))) - -;;; array.el ends here diff --git a/xemacs-packages/lisp/edit-utils/atomic-extents.el b/xemacs-packages/lisp/edit-utils/atomic-extents.el deleted file mode 100644 index 573d9502..00000000 --- a/xemacs-packages/lisp/edit-utils/atomic-extents.el +++ /dev/null @@ -1,110 +0,0 @@ -;;; atomic-extents.el --- treat regions of text as a single object - -;; Copyright (C) 1993 Free Software Foundation, Inc. -;; Created: 21-Dec-93, Chuck Thompson -;; Keywords: extensions -;; Changed: 08-Aug-94, Heiko Muenkel - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Point is not allowed to fall inside of an atomic extent. This has -;;; the effect of making all text covered by an atomic extent be -;;; treated as a single object. Normally point will be adjusted to an -;;; end of an atomic extent in the direction of motion. If point -;;; appears inside of an atomic extent (via goto-char for example), -;;; point will be adjusted to the side closest to the entry point. - -;;; Synched up with: Not in FSF. - -;;; To make an extent atomic use the command: -;;; (set-extent-property # 'atomic t) - -;;; Known bug: the atomic property is not detected when sweeping -;;; regions with the mouse until after the mouse button is released. -;;; The release point will then be treated as if it had been reached -;;; using 'goto-char. - -;;; atomic-extent-goto-char-p is defined in editfns.c - -(provide 'atomic-extents) - -(defvar atomic-extent-old-point nil - "The value of point when pre-command-hook is called. -Used to determine the direction of motion.") - -(defun atomic-extent-pre-hook () - (setq atomic-extent-old-point (point)) - (setq atomic-extent-goto-char-p nil)) - -(defun atomic-extent-post-hook () - (let ((extent (extent-at (point) nil 'atomic))) - (if extent - (let ((begin (extent-start-position extent)) - (end (extent-end-position extent)) - (pos (point)) - (region-set (and (point) (mark)))) - (if (eq this-command - 'x-set-point-and-insert-selection) - (delete-region (region-beginning) (region-end))) - (if (/= pos begin) - (if atomic-extent-goto-char-p - (progn - (if (> (- pos begin) (- end pos)) - (goto-char end) - (goto-char begin))) - (if (> pos atomic-extent-old-point) - (goto-char end) - (goto-char begin)))) - (if (and region-set (/= pos begin)) - (progn - (run-hooks 'zmacs-update-region-hook) - (x-store-cutbuffer (buffer-substring (region-beginning) - (region-end))) - ))))) - (if (mark) - (progn - (exchange-point-and-mark t) - (let ((extent (extent-at (point) nil 'atomic))) - (if extent - (let ((begin (extent-start-position extent)) - (end (extent-end-position extent)) - (pos (point)) - (region-set (and (point) (mark)))) - (if (/= pos begin) - (if atomic-extent-goto-char-p - (progn - (if (> (- pos begin) (- end pos)) - (goto-char end) - (goto-char begin))) - (if (> pos atomic-extent-old-point) - (goto-char end) - (goto-char begin)))) - (if (and region-set (/= pos begin)) - (progn - (run-hooks 'zmacs-update-region-hook) - (x-store-cutbuffer (buffer-substring (region-beginning) - (region-end))) - (message "%d, %d" (region-beginning) (region-end)) - ))))) - (exchange-point-and-mark t))) - ) - -(add-hook 'pre-command-hook 'atomic-extent-pre-hook) -(add-hook 'post-command-hook 'atomic-extent-post-hook) - -;;; atomic-extents.el ends here diff --git a/xemacs-packages/lisp/edit-utils/auto-autoloads.el b/xemacs-packages/lisp/edit-utils/auto-autoloads.el deleted file mode 100644 index 5b3c37d2..00000000 --- a/xemacs-packages/lisp/edit-utils/auto-autoloads.el +++ /dev/null @@ -1,1563 +0,0 @@ -;;; DO NOT MODIFY THIS FILE -(if (featurep 'edit-utils-autoloads) (error "Already loaded")) - -;;;### (autoloads nil "_pkg" "edit-utils/_pkg.el") - -(package-provide 'edit-utils :version 2.34 :author-version "No-Upstream-Ver" :type 'single-file) - -;;;*** - -;;;### (autoloads (After-save--after-save-hook After-save--find-file-hook) "after-save-commands" "edit-utils/after-save-commands.el") - -(autoload 'After-save--find-file-hook "after-save-commands" "\ -Look up the name of this file in `After-save-alist', and if it has -an entry, turn on the modeline button and indicator." nil nil) - -(autoload 'After-save--after-save-hook "after-save-commands" "\ -An `after-save-hook' to run a shell-command. -This gets hung on the `after-save-hook'. -See: `After-save-alist'." nil nil) - -;;;*** - -;;;### (autoloads (align-newline-and-indent align-unhighlight-rule align-highlight-rule align-current align-entire align-regexp align) "align" "edit-utils/align.el") - -(autoload 'align "align" "\ -Attempt to align a region based on a set of alignment rules. -BEG and END mark the region. If BEG and END are specifically set to -nil (this can only be done programmatically), the beginning and end of -the current alignment section will be calculated based on the location -of point, and the value of `align-region-separate' (or possibly each -rule's `separate' attribute). - -If SEPARATE is non-nil, it overrides the value of -`align-region-separate' for all rules, except those that have their -`separate' attribute set. - -RULES and EXCLUDE-RULES, if either is non-nil, will replace the -default rule lists defined in `align-rules-list' and -`align-exclude-rules-list'. See `align-rules-list' for more details -on the format of these lists." t nil) - -(autoload 'align-regexp "align" "\ -Align the current region using an ad-hoc rule read from the minibuffer. -BEG and END mark the limits of the region. This function will prompt -for the REGEXP to align with. If no prefix arg was specified, you -only need to supply the characters to be lined up and any preceding -whitespace is replaced. If a prefix arg was specified, the full -regexp with parenthesized whitespace should be supplied; it will also -prompt for which parenthesis GROUP within REGEXP to modify, the amount -of SPACING to use, and whether or not to REPEAT the rule throughout -the line. See `align-rules-list' for more information about these -options. - -For example, let's say you had a list of phone numbers, and wanted to -align them so that the opening parentheses would line up: - - Fred (123) 456-7890 - Alice (123) 456-7890 - Mary-Anne (123) 456-7890 - Joe (123) 456-7890 - -There is no predefined rule to handle this, but you could easily do it -using a REGEXP like \"(\". All you would have to do is to mark the -region, call `align-regexp' and type in that regular expression." t nil) - -(autoload 'align-entire "align" "\ -Align the selected region as if it were one alignment section. -BEG and END mark the extent of the region. If RULES or EXCLUDE-RULES -is set to a list of rules (see `align-rules-list'), it can be used to -override the default alignment rules that would have been used to -align that section." t nil) - -(autoload 'align-current "align" "\ -Call `align' on the current alignment section. -This function assumes you want to align only the current section, and -so saves you from having to specify the region. If RULES or -EXCLUDE-RULES is set to a list of rules (see `align-rules-list'), it -can be used to override the default alignment rules that would have -been used to align that section." t nil) - -(autoload 'align-highlight-rule "align" "\ -Highlight the whitespace which a given rule would have modified. -BEG and END mark the extent of the region. TITLE identifies the rule -that should be highlighted. If RULES or EXCLUDE-RULES is set to a -list of rules (see `align-rules-list'), it can be used to override the -default alignment rules that would have been used to identify the text -to be colored." t nil) - -(autoload 'align-unhighlight-rule "align" "\ -Remove any highlighting that was added by `align-highlight-rule'." t nil) - -(autoload 'align-newline-and-indent "align" "\ -A replacement function for `newline-and-indent', aligning as it goes." t nil) - -;;;*** - -;;;### (autoloads (global-auto-revert-mode turn-on-auto-revert-mode auto-revert-mode) "autorevert" "edit-utils/autorevert.el") - -(defvar auto-revert-mode nil "\ -*Non-nil when Auto-Revert Mode is active. - -Never set this variable directly, use the command `auto-revert-mode' -instead.") - -(defcustom global-auto-revert-mode nil "When on, buffers are automatically reverted when files on disk change.\n\nSet this variable using \\[customize] only. Otherwise, use the\ncommand `global-auto-revert-mode'." :group 'auto-revert :initialize 'custom-initialize-default :set '(lambda (symbol value) (global-auto-revert-mode (or value 0))) :type 'boolean :require 'autorevert) - -(autoload 'auto-revert-mode "autorevert" "\ -Toggle reverting buffer when file on disk changes. - -With arg, turn Auto Revert mode on if and only if arg is positive. -This is a minor mode that affects only the current buffer. -Use `global-auto-revert-mode' to automatically revert all buffers." t nil) - -(autoload 'turn-on-auto-revert-mode "autorevert" "\ -Turn on Auto-Revert Mode. - -This function is designed to be added to hooks, for example: - (add-hook 'c-mode-hook 'turn-on-auto-revert-mode)" nil nil) - -(autoload 'global-auto-revert-mode "autorevert" "\ -Revert any buffer when file on disk change. - -With arg, turn Auto Revert mode on globally if and only if arg is positive. -This is a minor mode that affects all buffers. -Use `auto-revert-mode' to revert a particular buffer." t nil) - -;;;*** - -;;;### (autoloads (mouse-avoidance-mode) "avoid" "edit-utils/avoid.el") - -(defcustom mouse-avoidance-mode nil "Value is t or a symbol if the mouse pointer should avoid the cursor.\nSee function `mouse-avoidance-mode' for possible values. Normally, you\nshouldn't modify this variable by hand, but use the function instead. However,\nthe default value can be customized from the options menu." :type '(radio (const :tag "No mouse avoidance" nil) (const :tag "Move the mouse on keypress" banish) (const :tag "Move the mouse if the cursor gets too close" exile) (const :tag "Displace the mouse if the cursor gets too close" jump) (const :tag "Animate the mouse" animate) (const :tag "Animate + change shape" proteus)) :set (lambda (symbol value) (mouse-avoidance-mode (or value 'none))) :initialize 'custom-initialize-default :require 'avoid :group 'avoid) - -(defcustom mouse-avoidance-mode-line-string " Avoid" "*String to display in the modeline when `mouse-avoidance-mode' is active.\nSet this to nil if you don't want a modeline indicator." :type '(choice string (const :tag "none" nil)) :group 'avoid) - -(autoload 'mouse-avoidance-mode "avoid" "\ -Set cursor avoidance mode to MODE. -MODE should be one of the symbols `banish', `exile', `jump', `animate', -`cat-and-mouse', `proteus', or `none'. - -If MODE is nil, toggle mouse avoidance between `none` and `banish' -modes. Positive numbers and symbols other than the above are treated -as equivalent to `banish'; negative numbers and `-' are equivalent to `none'. - -Effects of the different modes: - * banish: Move the mouse to the upper-right corner on any keypress. - * exile: Move the mouse to the corner only if the cursor gets too close, - and allow it to return once the cursor is out of the way. - * jump: If the cursor gets too close to the mouse, displace the mouse - a random distance & direction. - * animate: As `jump', but shows steps along the way for illusion of motion. - * cat-and-mouse: Same as `animate'. - * proteus: As `animate', but changes the shape of the mouse pointer too. - -Whenever the mouse is moved, the frame is also raised. - -\(see `mouse-avoidance-threshold' for definition of \"too close\", -and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for -definition of \"random distance\".)" t nil) - -(add-minor-mode 'mouse-avoidance-mode 'mouse-avoidance-mode-line-string) - -;;;*** - -;;;### (autoloads (balloon-help-minor-mode balloon-help-mode) "balloon-help" "edit-utils/balloon-help.el") - -(defcustom balloon-help-mode nil "*Non-nil means Balloon help mode is enabled." :type 'boolean :set (lambda (symbol value) (balloon-help-mode (or value 0))) :initialize 'custom-initialize-default :require 'balloon-help :group 'balloon-help) - -(autoload 'balloon-help-mode "balloon-help" "\ -Toggle Balloon Help mode. -With arg, turn Balloon Help mode on iff arg is positive. - -With Balloon Help enabled, a small frame is displayed whenever -the mouse rests on an object that has a help property of some -kind. The text of that help property is displayed in the frame. - -If you want Balloon Help mode enabled in some buffers only, use -`balloon-help-minor-mode' instead. - -For extents, the 'balloon-help' property is checked. - -For toolbar buttons, the help-string slot of the toolbar button -is checked. - -If the value is a string, it is used as the help message. - -If the property's value is a symbol, it is assumed to be the name -of a function and it will be called with one argument, the object -under the mouse, and the return value of that function will be -used as the help message." t nil) - -(autoload 'balloon-help-minor-mode "balloon-help" "\ -Toggle Balloon Help minor mode. -With arg, turn Balloon Help minor mode on iff arg is positive. - -This minor mode is useful if you want `balloon-help-mode' globally disabled, -except in some buffers. - -Please refer to the function `balloon-help-mode' for more details" t nil) - -;;;*** - -;;;### (autoloads (blink-cursor-mode) "blink-cursor" "edit-utils/blink-cursor.el") - -(defcustom blink-cursor-mode nil "Non nil means `blink-cursor-mode' is on. Normally, you shouldn't modify\nthis variable by hand, but use the function `blink-cursor-mode'\ninstead. However, the default value can be customized from the options menu." :type 'boolean :set (lambda (var val) (blink-cursor-mode (or val 0))) :initialize 'custom-initialize-default :require 'blink-cursor :group 'blink-cursor) - -(autoload 'blink-cursor-mode "blink-cursor" "\ -Enable or disable a blinking cursor. -If TIMEOUT is nil, toggle on or off. -If TIMEOUT is t, enable with the previous timeout value. -If TIMEOUT is 0, disable. -If TIMEOUT is greater than 0, then the cursor will blink once -each TIMEOUT secs (can be a float)." t nil) - -;;;*** - -;;;### (autoloads (bookmark-menu-delete bookmark-menu-rename bookmark-menu-locate bookmark-menu-jump bookmark-menu-insert bookmark-bmenu-list bookmark-load bookmark-save bookmark-write bookmark-delete bookmark-insert bookmark-rename bookmark-insert-location bookmark-relocate bookmark-jump bookmark-set bookmark-all-names) "bookmark" "edit-utils/bookmark.el") - -(if (symbolp (key-binding "r")) nil (progn (define-key ctl-x-map "rb" 'bookmark-jump) (define-key ctl-x-map "rm" 'bookmark-set) (define-key ctl-x-map "rl" 'bookmark-bmenu-list))) - -(defvar bookmark-map nil "\ -Keymap containing bindings to bookmark functions. -It is not bound to any key by default: to bind it -so that you have a bookmark prefix, just use `global-set-key' and bind a -key of your choice to `bookmark-map'. All interactive bookmark -functions have a binding in this keymap.") - -(define-prefix-command 'bookmark-map) - -(define-key bookmark-map "x" 'bookmark-set) - -(define-key bookmark-map "m" 'bookmark-set) - -(define-key bookmark-map "j" 'bookmark-jump) - -(define-key bookmark-map "g" 'bookmark-jump) - -(define-key bookmark-map "i" 'bookmark-insert) - -(define-key bookmark-map "e" 'edit-bookmarks) - -(define-key bookmark-map "f" 'bookmark-insert-location) - -(define-key bookmark-map "r" 'bookmark-rename) - -(define-key bookmark-map "d" 'bookmark-delete) - -(define-key bookmark-map "l" 'bookmark-load) - -(define-key bookmark-map "w" 'bookmark-write) - -(define-key bookmark-map "s" 'bookmark-save) - -(add-hook 'kill-emacs-hook (function (lambda nil (and (featurep 'bookmark) bookmark-alist (bookmark-time-to-save-p t) (bookmark-save))))) - -(autoload 'bookmark-all-names "bookmark" "\ -Return a list of all current bookmark names." nil nil) - -(autoload 'bookmark-set "bookmark" "\ -Set a bookmark named NAME inside a file. -If name is nil, then the user will be prompted. -With prefix arg, will not overwrite a bookmark that has the same name -as NAME if such a bookmark already exists, but instead will \"push\" -the new bookmark onto the bookmark alist. Thus the most recently set -bookmark with name NAME would be the one in effect at any given time, -but the others are still there, should you decide to delete the most -recent one. - -To yank words from the text of the buffer and use them as part of the -bookmark name, type C-w while setting a bookmark. Successive C-w's -yank successive words. - -Typing C-u inserts the name of the last bookmark used in the buffer -\(as an aid in using a single bookmark name to track your progress -through a large file). If no bookmark was used, then C-u inserts the -name of the file being visited. - -Use \\[bookmark-delete] to remove bookmarks (you give it a name, -and it removes only the first instance of a bookmark with that name from -the list of bookmarks.)" t nil) - -(autoload 'bookmark-jump "bookmark" "\ -Jump to bookmark BOOKMARK (a point in some file). -You may have a problem using this function if the value of variable -`bookmark-alist' is nil. If that happens, you need to load in some -bookmarks. See help on function `bookmark-load' for more about -this. - -If the file pointed to by BOOKMARK no longer exists, you will be asked -if you wish to give the bookmark a new location, and bookmark-jump -will then jump to the new location, as well as recording it in place -of the old one in the permanent bookmark record." t nil) - -(autoload 'bookmark-relocate "bookmark" "\ -Relocate BOOKMARK to another file (reading file name with minibuffer). -This makes an already existing bookmark point to that file, instead of -the one it used to point at. Useful when a file has been renamed -after a bookmark was set in it." t nil) - -(autoload 'bookmark-insert-location "bookmark" "\ -Insert the name of the file associated with BOOKMARK. -Optional second arg NO-HISTORY means don't record this in the -minibuffer history list `bookmark-history'." t nil) - -(defalias 'bookmark-locate 'bookmark-insert-location) - -(autoload 'bookmark-rename "bookmark" "\ -Change the name of OLD bookmark to NEW name. -If called from keyboard, prompt for OLD and NEW. If called from -menubar, select OLD from a menu and prompt for NEW. - -If called from Lisp, prompt for NEW if only OLD was passed as an -argument. If called with two strings, then no prompting is done. You -must pass at least OLD when calling from Lisp. - -While you are entering the new name, consecutive C-w's insert -consecutive words from the text of the buffer into the new bookmark -name." t nil) - -(autoload 'bookmark-insert "bookmark" "\ -Insert the text of the file pointed to by bookmark BOOKMARK. -You may have a problem using this function if the value of variable -`bookmark-alist' is nil. If that happens, you need to load in some -bookmarks. See help on function `bookmark-load' for more about -this." t nil) - -(autoload 'bookmark-delete "bookmark" "\ -Delete BOOKMARK from the bookmark list. -Removes only the first instance of a bookmark with that name. If -there are one or more other bookmarks with the same name, they will -not be deleted. Defaults to the \"current\" bookmark (that is, the -one most recently used in this file, if any). -Optional second arg BATCH means don't update the bookmark list buffer, -probably because we were called from there." t nil) - -(autoload 'bookmark-write "bookmark" "\ -Write bookmarks to a file (reading the file name with the minibuffer). -Don't use this in Lisp programs; use `bookmark-save' instead." t nil) - -(autoload 'bookmark-save "bookmark" "\ -Save currently defined bookmarks. -Saves by default in the file defined by the variable -`bookmark-default-file'. With a prefix arg, save it in file FILE -\(second argument). - -If you are calling this from Lisp, the two arguments are PREFIX-ARG -and FILE, and if you just want it to write to the default file, then -pass no arguments. Or pass in nil and FILE, and it will save in FILE -instead. If you pass in one argument, and it is non-nil, then the -user will be interactively queried for a file to save in. - -When you want to load in the bookmarks from a file, use -`bookmark-load', \\[bookmark-load]. That function will prompt you -for a file, defaulting to the file defined by variable -`bookmark-default-file'." t nil) - -(autoload 'bookmark-load "bookmark" "\ -Load bookmarks from FILE (which must be in bookmark format). -Appends loaded bookmarks to the front of the list of bookmarks. If -optional second argument REVERT is non-nil, existing bookmarks are -destroyed. Optional third arg NO-MSG means don't display any messages -while loading. - -If you load a file that doesn't contain a proper bookmark alist, you -will corrupt Emacs's bookmark list. Generally, you should only load -in files that were created with the bookmark functions in the first -place. Your own personal bookmark file, `~/.emacs.bmk', is -maintained automatically by Emacs; you shouldn't need to load it -explicitly." t nil) - -(autoload 'bookmark-bmenu-list "bookmark" "\ -Display a list of existing bookmarks. -The list is displayed in a buffer named `*Bookmark List*'. -The leftmost column displays a D if the bookmark is flagged for -deletion, or > if it is flagged for displaying." t nil) - -(defalias 'list-bookmarks 'bookmark-bmenu-list) - -(defalias 'edit-bookmarks 'bookmark-bmenu-list) - -(autoload 'bookmark-menu-insert "bookmark" "\ -Insert the text of the file pointed to by bookmark BOOKMARK. -You may have a problem using this function if the value of variable -`bookmark-alist' is nil. If that happens, you need to load in some -bookmarks. See help on function `bookmark-load' for more about -this. - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp (the one without the -\"-menu-\" in its name)." t nil) - -(autoload 'bookmark-menu-jump "bookmark" "\ -Jump to bookmark BOOKMARK (a point in some file). -You may have a problem using this function if the value of variable -`bookmark-alist' is nil. If that happens, you need to load in some -bookmarks. See help on function `bookmark-load' for more about -this. - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp (the one without the -\"-menu-\" in its name)." t nil) - -(autoload 'bookmark-menu-locate "bookmark" "\ -Insert the name of the file associated with BOOKMARK. -\(This is not the same as the contents of that file). - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp (the one without the -\"-menu-\" in its name)." t nil) - -(autoload 'bookmark-menu-rename "bookmark" "\ -Change the name of OLD-BOOKMARK to NEWNAME. -If called from keyboard, prompts for OLD-BOOKMARK and NEWNAME. -If called from menubar, OLD-BOOKMARK is selected from a menu, and -prompts for NEWNAME. -If called from Lisp, prompts for NEWNAME if only OLD-BOOKMARK was -passed as an argument. If called with two strings, then no prompting -is done. You must pass at least OLD-BOOKMARK when calling from Lisp. - -While you are entering the new name, consecutive C-w's insert -consecutive words from the text of the buffer into the new bookmark -name. - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp (the one without the -\"-menu-\" in its name)." t nil) - -(autoload 'bookmark-menu-delete "bookmark" "\ -Delete the bookmark named NAME from the bookmark list. -Removes only the first instance of a bookmark with that name. If -there are one or more other bookmarks with the same name, they will -not be deleted. Defaults to the \"current\" bookmark (that is, the -one most recently used in this file, if any). - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp (the one without the -\"-menu-\" in its name)." t nil) - -(defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions")) - -(defalias 'menu-bar-bookmark-map (symbol-value 'menu-bar-bookmark-map)) - -(define-key menu-bar-bookmark-map [load] '("Load a Bookmark File..." . bookmark-load)) - -(define-key menu-bar-bookmark-map [write] '("Save Bookmarks As..." . bookmark-write)) - -(define-key menu-bar-bookmark-map [save] '("Save Bookmarks" . bookmark-save)) - -(define-key menu-bar-bookmark-map [edit] '("Edit Bookmark List" . bookmark-bmenu-list)) - -(define-key menu-bar-bookmark-map [delete] '("Delete Bookmark" . bookmark-menu-delete)) - -(define-key menu-bar-bookmark-map [rename] '("Rename Bookmark" . bookmark-menu-rename)) - -(define-key menu-bar-bookmark-map [locate] '("Insert Location" . bookmark-menu-locate)) - -(define-key menu-bar-bookmark-map [insert] '("Insert Contents" . bookmark-menu-insert)) - -(define-key menu-bar-bookmark-map [set] '("Set Bookmark" . bookmark-set)) - -(define-key menu-bar-bookmark-map [jump] '("Jump to Bookmark" . bookmark-menu-jump)) - -;;;*** - -;;;### (autoloads (compare-windows) "compare-w" "edit-utils/compare-w.el") - -(autoload 'compare-windows "compare-w" "\ -Compare text in current window with text in next window. -Compares the text starting at point in each window, -moving over text in each one as far as they match. - -This command pushes the mark in each window -at the prior location of point in that window. -If both windows display the same buffer, -the mark is pushed twice in that buffer: -first in the other window, then in the selected window. - -A prefix arg means ignore changes in whitespace. -The variable `compare-windows-whitespace' controls how whitespace is skipped. -If `compare-ignore-case' is non-nil, changes in case are also ignored." t nil) - -;;;*** - -;;;### (autoloads (complete) "completion" "edit-utils/completion.el") - -(autoload 'complete "completion" "\ -Fill out a completion of the word before point. -Point is left at end. Consecutive calls rotate through all possibilities. -Prefix args :: - control-u :: leave the point at the beginning of the completion rather - than at the end. - a number :: rotate through the possible completions by that amount - `-' :: same as -1 (insert previous completion) - {See the comments at the top of `completion.el' for more info.}" t nil) - -;;;*** - -;;;### (autoloads (completing-read-multiple) "crm" "edit-utils/crm.el") - -(autoload 'completing-read-multiple "crm" "\ -Read multiple strings in the minibuffer, with completion. -By using this functionality, a user may specify multiple strings at a -single prompt, optionally using completion. - -Multiple strings are specified by separating each of the strings with -a prespecified separator character. For example, if the separator -character is a comma, the strings 'alice', 'bob', and 'eve' would be -specified as 'alice,bob,eve'. - -The default value for the separator character is the value of -`crm-default-separator' (comma). The separator character may be -changed by modifying the value of `crm-separator'. - -Contiguous strings of non-separator-characters are referred to as -'elements'. In the aforementioned example, the elements are: 'alice', -'bob', and 'eve'. - -Completion is available on a per-element basis. For example, if the -contents of the minibuffer are 'alice,bob,eve' and point is between -'l' and 'i', pressing TAB operates on the element 'alice'. - -The return value of this function is a list of the read strings. - -See the documentation for `completing-read' for details on the arguments: -PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and -INHERIT-INPUT-METHOD." nil nil) - -;;;*** - -;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "edit-utils/dabbrev.el") - -(define-key global-map [(meta /)] 'dabbrev-expand) - -(define-key global-map [(meta control /)] 'dabbrev-completion) - -(autoload 'dabbrev-completion "dabbrev" "\ -Completion on current word. -Like \\[dabbrev-expand] but finds all expansions in the current buffer -and presents suggestions for completion. - -With a prefix argument, it searches all buffers accepted by the -function pointed out by `dabbrev-friend-buffer-function' to find the -completions. - -If the prefix argument is 16 (which comes from C-u C-u), -then it searches *all* buffers. - -With no prefix argument, it reuses an old completion list -if there is a suitable one already." t nil) - -(autoload 'dabbrev-expand "dabbrev" "\ -Expand previous word \"dynamically\". - -Expands to the most recent, preceding word for which this is a prefix. -If no suitable preceding word is found, words following point are -considered. If still no suitable word is found, then look in the -buffers accepted by the function pointed out by variable -`dabbrev-friend-buffer-function'. - -A positive prefix argument, N, says to take the Nth backward *distinct* -possibility. A negative argument says search forward. - -If the cursor has not moved from the end of the previous expansion and -no argument is given, replace the previously-made expansion -with the next possible expansion not yet tried. - -The variable `dabbrev-backward-only' may be used to limit the -direction of search to backward if set non-nil. - -See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." t nil) - -;;;*** - -;;;### (autoloads (desktop-load-default desktop-read) "desktop" "edit-utils/desktop.el") - -(autoload 'desktop-read "desktop" "\ -Read the Desktop file and the files it specifies. -This is a no-op when Emacs is running in batch mode." t nil) - -(autoload 'desktop-load-default "desktop" "\ -Load the `default' start-up library manually. -Also inhibit further loading of it. Call this from your `.emacs' file -to provide correct modes for autoloaded files." nil nil) - -;;;*** - -;;;### (autoloads (edit-faces) "edit-faces" "edit-utils/edit-faces.el") - -(autoload 'edit-faces "edit-faces" "\ -Alter face characteristics by editing a list of defined faces. -Pops up a buffer containing a list of defined faces. - -WARNING: the changes you may perform with this function are no longer -saved. The prefered way to modify faces is now to use `customize-face'. If you -want to specify particular X font names for faces, please do so in your -.XDefaults file. - -Editing commands: - -\\{edit-faces-mode-map}" t nil) - -;;;*** - -;;;### (autoloads (edit-toolbar) "edit-toolbar" "edit-utils/edit-toolbar.el") - -(autoload 'edit-toolbar "edit-toolbar" "\ -Alter toolbar characteristics by editing a buffer representing the specified toolbar. -Pops up a buffer containing a list of the toolbar matching TOOLBAR_NAME." t nil) - -;;;*** - -;;;### (autoloads (turn-on-fast-lock fast-lock-mode) "fast-lock" "edit-utils/fast-lock.el") - -(defcustom fast-lock-mode nil "Non nil means `fast-lock-mode' is on" :group 'fast-lock :require 'fast-lock :type 'boolean :initialize 'custom-initialize-default :set '(lambda (var val) (if val (progn (fast-lock-mode 1) (add-hook 'font-lock-mode-hook 'turn-on-fast-lock)) (fast-lock-mode -1) (remove-hook 'font-lock-mode-hook 'turn-on-fast-lock)) (setq-default fast-lock-mode val))) - -(autoload 'fast-lock-mode "fast-lock" "\ -Toggle Fast Lock mode. -With arg, turn Fast Lock mode on if and only if arg is positive and the buffer -is associated with a file. Enable it automatically in your `~/.emacs' by: - - (setq font-lock-support-mode 'fast-lock-mode) - -If Fast Lock mode is enabled, and the current buffer does not contain any text -properties, any associated Font Lock cache is used if its timestamp matches the -buffer's file, and its `font-lock-keywords' match those that you are using. - -Font Lock caches may be saved: -- When you save the file's buffer. -- When you kill an unmodified file's buffer. -- When you exit Emacs, for all unmodified or saved buffers. -Depending on the value of `fast-lock-save-events'. -See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'. - -Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad. - -Various methods of control are provided for the Font Lock cache. In general, -see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'. -For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events', -`fast-lock-save-others' and `fast-lock-save-faces'." t nil) - -(autoload 'turn-on-fast-lock "fast-lock" "\ -Unconditionally turn on Fast Lock mode." nil nil) - -(when (fboundp 'add-minor-mode) (defvar fast-lock-mode nil) (add-minor-mode 'fast-lock-mode nil)) - -;;;*** - -;;;### (autoloads (make-file-part) "file-part" "edit-utils/file-part.el") - -(autoload 'make-file-part "file-part" "\ -Make a file part on buffer BUFFER out of the region. Call it NAME. -This command creates a new buffer containing the contents of the -region and marks the buffer as referring to the specified buffer, -called the `master buffer'. When the file-part buffer is saved, -its changes are integrated back into the master buffer. When the -master buffer is deleted, all file parts are deleted with it. - -When called from a function, expects four arguments, START, END, -NAME, and BUFFER, all of which are optional and default to the -beginning of BUFFER, the end of BUFFER, a name generated from -BUFFER's name, and the current buffer, respectively." t nil) - -;;;*** - -;;;### (autoloads (floating-toolbar-from-extent-or-popup-mode-menu floating-toolbar-or-popup-mode-menu floating-toolbar) "floating-toolbar" "edit-utils/floating-toolbar.el") - -(autoload 'floating-toolbar "floating-toolbar" "\ -Popup a toolbar near the current mouse position. -The toolbar instantiator used is taken from the 'floating-toolbar -property of any extent under the mouse. If no such non-nil -property exists for any extent under the mouse, then the value of the -variable `floating-toolbar' is checked. If its value is nil, then -no toolbar will be displayed. - -This command should be bound to a button press event. - -When called from a program, first arg EVENT should be the button -press event. Optional second arg EXTENT-LOCAL-ONLY specifies -that only extent local toolbars should be used; this means the -`floating-toolbar' variable will not be consulted." t nil) - -(autoload 'floating-toolbar-or-popup-mode-menu "floating-toolbar" "\ -Like floating-toolbar, but if no toolbar is displayed -run popup-mode-menu." t nil) - -(autoload 'floating-toolbar-from-extent-or-popup-mode-menu "floating-toolbar" "\ -Like floating-toolbar-or-popup-mode-menu, but search only for an -extent local toolbar." t nil) - -;;;*** - -;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl" "edit-utils/flow-ctrl.el") - -(autoload 'enable-flow-control "flow-ctrl" "\ -Toggle flow control handling. -When handling is enabled, user can type C-s as C-\\, and C-q as C-^. -With arg, enable flow control mode if arg is positive, otherwise disable." t nil) - -(autoload 'enable-flow-control-on "flow-ctrl" "\ -Enable flow control if using one of a specified set of terminal types. -Use `(enable-flow-control-on \"vt100\" \"h19\")' to enable flow control -on VT-100 and H19 terminals. When flow control is enabled, -you must type C-\\ to get the effect of a C-s, and type C-^ -to get the effect of a C-q. - -This function has no effect unless the current device is a tty. - -The tty terminal type is determined from the TERM environment variable. -Trailing hyphens and everything following is stripped, so a TERM -value of \"vt100-nam\" is treated the same as \"vt100\"." nil nil) - -;;;*** - -;;;### (autoloads (fume-setup-buffer turn-on-fume-mode fume-mode function-menu) "func-menu" "edit-utils/func-menu.el") - -(autoload 'function-menu "func-menu" "\ -Pop up a menu of buffer local functions and related commands. -Each function menu entry jumps to its named function. Prior to a jump, a -mark is set so that {C-u \\[set-mark-command]} will move point back to the -old location. - -With optional prefix argument USE-MENUBAR, add the menu to the current -menubar. With optional second argument RETURN-ONLY, return the menu -of functions but do not display it. - -With optional third argument MENU-ITEM-FUNCTION, use this as the function -called by each menu item (default = 'fume-goto-function). This function -must take two arguments, function menu item name (a string) and the position -\(an integer) within the buffer to leave point when displaying this menu item." t nil) - -(autoload 'fume-mode "func-menu" "\ -Toggle the func menu minor mode on/off. -With a prefix numeric value or ARG > 0, turn it on. -The variable `fume-mode-line-string' defines what you will see in the -modeline when the mode is on. - -Note: if you had been using - -\\{fume-mode-map}" t nil) - -(autoload 'turn-on-fume-mode "func-menu" "\ -Unconditionaly turn the func menu minor mode on." t nil) - -(autoload 'fume-setup-buffer "func-menu" "\ -Setup the current buffer for func-menu. -This actually means prepare for turning `fume-mode' on. - -If you've been using func-menu the old way (before `fume-mode' was -written), please note that `mouse-function-menu' is bound to M-Button3 -\(not Shift-Button3) in this mode. Nothing prevents you from keeping your -old binding though. - -This function is meant to be added to `find-file-hooks'. -If FORCE is non-nil, actually do the operation now; otherwise, -delay until the next time the event loop is processed (this is -so that Lisp routines that temporarily load a file, process it, -and then kill it will not be slowed down by `function-menu' processing)." t nil) - -;;;*** - -;;;### (autoloads (highline-view-off highline-view-on highline-view-mode highline-off highline-on highline-local-mode highline-mode-off highline-mode-on highline-mode highline-customize) "highline" "edit-utils/highline.el") - -(autoload 'highline-customize "highline" "\ -Customize highline group." t nil) - -(autoload 'highline-mode "highline" "\ -Toggle global minor mode to highlight line about point (HL on modeline). - -With ARG, turn highline mode on if ARG is positive, off otherwise. -Only useful with a windowing system." t nil) - -(autoload 'highline-mode-on "highline" "\ -Turn on global minor mode to highlight line about point (HL on modeline)." t nil) - -(autoload 'highline-mode-off "highline" "\ -Turn off global minor mode to highlight line about point (HL on modeline)." t nil) - -(autoload 'highline-local-mode "highline" "\ -Toggle local minor mode to highlight the line about point (hl on modeline). - -With ARG, turn highline mode on if ARG is positive, off otherwise. -Only useful with a windowing system." t nil) - -(autoload 'highline-on "highline" "\ -Turn on local highlighting of the current line in buffer (hl on modeline)." t nil) - -(autoload 'highline-off "highline" "\ -Turn off local highlighting of the current line in buffer (hl on modeline)." t nil) - -(autoload 'highline-view-mode "highline" "\ -Toggle indirect mode to highlight current line in buffer (Ihl on modeline). - -With ARG, turn highline mode on if ARG is positive, off otherwise. -Only useful with a windowing system. - -Indirect highline (`highline-view-on', `highline-view-off' and -`highline-view-mode') is useful when you wish to have various \"visions\" of -the same buffer. - -Indirect highline uses an indirect buffer to get the \"vision\" of the buffer. -So, if you kill an indirect buffer, the base buffer is not affected; if you -kill the base buffer, all indirect buffer related with the base buffer is -automagicaly killed. Also, any text insertion/deletion in any indirect or base -buffer is updated in all related buffers. - -See also `highline-selected-window'." t nil) - -(autoload 'highline-view-on "highline" "\ -Turn on indirect highlightining current line in buffer (Ihl on modeline). - -Indirect highline (`highline-view-on', `highline-view-off' and -`highline-view-mode') is useful when you wish to have various \"visions\" of -the same buffer. - -Indirect highline uses an indirect buffer to get the \"vision\" of the buffer. -So, if you kill an indirect buffer, the base buffer is not affected; if you -kill the base buffer, all indirect buffer related with the base buffer is -automagicaly killed. Also, any text insertion/deletion in any indirect or base -buffer is updated in all related buffers. - -See also `highline-selected-window'." t nil) - -(autoload 'highline-view-off "highline" "\ -Turn off indirect highlightining current line in buffer (Ihl on modeline). - -Indirect highline (`highline-view-on', `highline-view-off' and -`highline-view-mode') is useful when you wish to have various \"visions\" of -the same buffer. - -Indirect highline uses an indirect buffer to get the \"vision\" of the buffer. -So, if you kill an indirect buffer, the base buffer is not affected; if you -kill the base buffer, all indirect buffer related with the base buffer is -automagicaly killed. Also, any text insertion/deletion in any indirect or base -buffer is updated in all related buffers. - -See also `highline-selected-window'." t nil) - -;;;*** - -;;;### (autoloads (make-hippie-expand-function hippie-expand) "hippie-exp" "edit-utils/hippie-exp.el") - -(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\ -The list of expansion functions tried in order by `hippie-expand'. -To change the behavior of `hippie-expand', remove, change the order of, -or insert functions in this list.") - -(defvar hippie-expand-verbose t "\ -*Non-nil makes `hippie-expand' output which function it is trying.") - -(defvar hippie-expand-max-buffers nil "\ -*The maximum number of buffers (apart from the current) searched. -If nil, all buffers are searched.") - -(defvar hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode) "\ -*A list specifying which buffers not to search (if not current). -Can contain both regexps matching buffer names (as strings) and major modes -\(as atoms)") - -(autoload 'hippie-expand "hippie-exp" "\ -Try to expand text before point, using multiple methods. -The expansion functions in `hippie-expand-try-functions-list' are -tried in order, until a possible expansion is found. Repeated -application of `hippie-expand' inserts successively possible -expansions. -With a positive numeric argument, jumps directly to the ARG next -function in this list. With a negative argument or just \\[universal-argument], -undoes the expansion." t nil) - -(autoload 'make-hippie-expand-function "hippie-exp" "\ -Construct a function similar to `hippie-expand'. -Make it use the expansion functions in TRY-LIST. An optional second -argument VERBOSE non-nil makes the function verbose." nil 'macro) - -;;;*** - -;;;### (autoloads (icomplete-minibuffer-setup icomplete-mode) "icomplete" "edit-utils/icomplete.el") - -(autoload 'icomplete-mode "icomplete" "\ -Activate incremental minibuffer completion for this emacs session. -Deactivates with negative universal argument." t nil) - -(autoload 'icomplete-minibuffer-setup "icomplete" "\ -Run in minibuffer on activation to establish incremental completion. -Usually run by inclusion in `minibuffer-setup-hook'." nil nil) - -;;;*** - -;;;### (autoloads (id-select-double-click-hook id-select-and-kill-thing id-select-and-copy-thing id-select-goto-matching-tag id-select-thing-with-mouse id-select-thing id-select-install) "id-select" "edit-utils/id-select.el") - -(autoload 'id-select-install "id-select" "\ -Install the id-select mode as the default mode of operation." t nil) - -(autoload 'id-select-thing "id-select" "\ -Mark the region selected by the syntax of the thing at point. -If invoked repeatedly, selects bigger and bigger things. -If `id-select-display-type' is non-nil, the type of selection is displayed in -the minibuffer." t nil) - -(autoload 'id-select-thing-with-mouse "id-select" "\ -Select a region based on the syntax of the character from a mouse click. -If the click occurs at the same point as the last click, select -the next larger syntactic structure. If `id-select-display-type' is non-nil, -the type of selection is displayed in the minibuffer." t nil) - -(autoload 'id-select-goto-matching-tag "id-select" "\ -If in a major mode listed in `id-select-markup-modes,' moves point to the start of the tag paired with the closest tag that point is within or precedes. -Returns t if point is moved, else nil. -Signals an error if no tag is found following point or if the closing tag -does not have a `>' terminator character." t nil) - -(autoload 'id-select-and-copy-thing "id-select" "\ -Copy the region surrounding the syntactical unit at point." t nil) - -(autoload 'id-select-and-kill-thing "id-select" "\ -Kill the region surrounding the syntactical unit at point." t nil) - -(autoload 'id-select-double-click-hook "id-select" "\ -Select a region based on the syntax of the character wherever the mouse is double-clicked. -If the double-click occurs at the same point as the last double-click, select -the next larger syntactic structure. If `id-select-display-type' is non-nil, -the type of selection is displayed in the minibuffer." nil nil) - -;;;*** - -;;;### (autoloads (info-complete-file info-complete-symbol info-lookup-file info-lookup-symbol info-lookup-reset) "info-look" "edit-utils/info-look.el") - -(autoload 'info-lookup-reset "info-look" "\ -Throw away all cached data. -This command is useful if the user wants to start at the beginning without -quitting Emacs, for example, after some Info documents were updated on the -system." t nil) - -(autoload 'info-lookup-symbol "info-look" "\ -Display the definition of SYMBOL, as found in the relevant manual. -When this command is called interactively, it reads SYMBOL from the minibuffer. -In the minibuffer, use M-n to yank the default argument value -into the minibuffer so you can edit it. -The default symbol is the one found at point. - -With prefix arg a query for the symbol help mode is offered." t nil) - -(autoload 'info-lookup-file "info-look" "\ -Display the documentation of a file. -When this command is called interactively, it reads FILE from the minibuffer. -In the minibuffer, use M-n to yank the default file name -into the minibuffer so you can edit it. -The default file name is the one found at point. - -With prefix arg a query for the file help mode is offered." t nil) - -(autoload 'info-complete-symbol "info-look" "\ -Perform completion on symbol preceding point." t nil) - -(autoload 'info-complete-file "info-look" "\ -Perform completion on file preceding point." t nil) - -;;;*** - -;;;### (autoloads (iswitchb-buffer-other-frame iswitchb-display-buffer iswitchb-buffer-other-window iswitchb-buffer iswitchb-default-keybindings) "iswitchb" "edit-utils/iswitchb.el") - -(autoload 'iswitchb-default-keybindings "iswitchb" "\ -Set up default keybindings for `iswitchb-buffer'. -Call this function to override the normal bindings." t nil) - -(autoload 'iswitchb-buffer "iswitchb" "\ -Switch to another buffer. - -The buffer name is selected interactively by typing a substring. The -buffer is displayed according to `iswitchb-default-method' -- the -default is to show it in the same window, unless it is already visible -in another frame. -For details of keybindings, do `\\[describe-function] iswitchb'." t nil) - -(autoload 'iswitchb-buffer-other-window "iswitchb" "\ -Switch to another buffer and show it in another window. -The buffer name is selected interactively by typing a substring. -For details of keybindings, do `\\[describe-function] iswitchb'." t nil) - -(autoload 'iswitchb-display-buffer "iswitchb" "\ -Display a buffer in another window but don't select it. -The buffer name is selected interactively by typing a substring. -For details of keybindings, do `\\[describe-function] iswitchb'." t nil) - -(autoload 'iswitchb-buffer-other-frame "iswitchb" "\ -Switch to another buffer and show it in another frame. -The buffer name is selected interactively by typing a substring. -For details of keybindings, do `\\[describe-function] iswitchb'." t nil) - -;;;*** - -;;;### (autoloads (turn-on-lazy-lock lazy-lock-mode) "lazy-lock" "edit-utils/lazy-lock.el") - -(defcustom lazy-lock-mode nil "Non nil means `lazy-lock-mode' is on." :group 'lazy-lock :require 'lazy-lock :type 'boolean :initialize 'custom-initialize-default :set '(lambda (var val) (if val (progn (lazy-lock-mode 1) (add-hook 'font-lock-mode-hook 'turn-on-lazy-lock)) (lazy-lock-mode -1) (remove-hook 'font-lock-mode-hook 'turn-on-lazy-lock)))) - -(autoload 'lazy-lock-mode "lazy-lock" "\ -Toggle Lazy Lock mode. -With arg, turn Lazy Lock mode on if and only if arg is positive. Enable it -automatically in your `~/.emacs' by: - - (setq font-lock-support-mode 'lazy-lock-mode) - -When Lazy Lock mode is enabled, fontification can be lazy in a number of ways: - -- Demand-driven buffer fontification if `lazy-lock-minimum-size' is non-nil. - This means initial fontification does not occur if the buffer is greater than - `lazy-lock-minimum-size' characters in length. Instead, fontification occurs - when necessary, such as when scrolling through the buffer would otherwise - reveal unfontified areas. This is useful if buffer fontification is too slow - for large buffers. - -- Deferred on-the-fly fontification if `lazy-lock-defer-on-the-fly' is non-nil. - This means on-the-fly fontification does not occur as you type. Instead, - fontification is deferred until after `lazy-lock-defer-time' seconds of Emacs - idle time, while Emacs remains idle. This is useful if fontification is too - slow to keep up with your typing. - -- Deferred context fontification if `lazy-lock-defer-contextually' is non-nil. - This means fontification updates the buffer corresponding to true syntactic - context, after `lazy-lock-defer-time' seconds of Emacs idle time, while Emacs - remains idle. Otherwise, fontification occurs on modified lines only, and - subsequent lines can remain fontified corresponding to previous syntactic - contexts. This is useful where strings or comments span lines. - -- Stealthy buffer fontification if `lazy-lock-stealth-time' is non-nil. - This means remaining unfontified areas of buffers are fontified if Emacs has - been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle. - This is useful if any buffer has any deferred fontification. - -Basic Font Lock mode on-the-fly fontification behaviour fontifies modified -lines only. Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode -on-the-fly fontification may fontify differently, albeit correctly. In any -event, to refontify some lines you can use \\[font-lock-fontify-block]. - -Stealth fontification only occurs while the system remains unloaded. -If the system load rises above `lazy-lock-stealth-load' percent, stealth -fontification is suspended. Stealth fontification intensity is controlled via -the variable `lazy-lock-stealth-nice' and `lazy-lock-stealth-lines', and -verbosity is controlled via the variable `lazy-lock-stealth-verbose'." t nil) - -(autoload 'turn-on-lazy-lock "lazy-lock" "\ -Unconditionally turn on Lazy Lock mode." nil nil) - -(add-minor-mode 'lazy-lock-mode 'lazy-lock-mode-line-string) - -;;;*** - -;;;### (autoloads (turn-on-lazy-shot lazy-shot-mode) "lazy-shot" "edit-utils/lazy-shot.el") - -(defcustom lazy-shot-mode nil "Non nil means `lazy-shot-mode' is on." :group 'lazy-shot :require 'lazy-shot :type 'boolean :initialize 'custom-initialize-default :set '(lambda (var val) (if val (progn (lazy-shot-mode 1) (add-hook 'font-lock-mode-hook 'turn-on-lazy-shot)) (lazy-shot-mode -1) (remove-hook 'font-lock-mode-hook 'turn-on-lazy-shot)) (setq-default lazy-shot-mode val))) - -(autoload 'lazy-shot-mode "lazy-shot" "\ -Toggle Lazy Lock mode. -With arg, turn Lazy Lock mode on if and only if ARG is positive." t nil) - -(autoload 'turn-on-lazy-shot "lazy-shot" "\ -Unconditionally turn on Lazy Lock mode." nil nil) - -;;;*** - -;;;### (autoloads (make-command-summary) "makesum" "edit-utils/makesum.el") - -(autoload 'make-command-summary "makesum" "\ -Make a summary of current key bindings in the buffer *Summary*. -Previous contents of that buffer are killed first." t nil) - -;;;*** - -;;;### (autoloads (Manual-nuke-nroff-bs manual-entry) "man" "edit-utils/man.el") - -(autoload 'manual-entry "man" "\ -Display the Unix manual entry (or entries) for TOPIC. -If TOPIC starts with -k, then a system apropos search is performed -using man -k for TOPIC." t nil) - -(define-key help-map " " 'manual-entry) - -(autoload 'Manual-nuke-nroff-bs "man" nil t nil) - -(defalias 'nuke-nroff-bs 'Manual-nuke-nroff-bs) - -;;;*** - -;;;### (autoloads (paren-backward-sexp paren-forward-sexp paren-toggle-open-paren-context paren-toggle-matching-quoted-paren paren-toggle-matching-paired-delimiter paren-deactivate paren-activate) "mic-paren" "edit-utils/mic-paren.el") - -(autoload 'paren-activate "mic-paren" "\ -Activates mic-paren parenthesis highlighting. -paren-activate deactivates the paren.el and stig-paren.el packages if they are -active ! -The following options are available via the customize-feature: - `paren-priority' - `paren-overlay-priority' - `paren-sexp-mode' - `paren-highlight-at-point' - `paren-highlight-offscreen' - `paren-display-message' - `paren-message-linefeed-display' - `paren-message-no-match' - `paren-message-show-linenumber' - `paren-message-truncate-lines' - `paren-ding-unmatched' - `paren-delay' - `paren-dont-touch-blink' - `paren-match-face' - `paren-mismatch-face' - `paren-no-match-face' - `paren-bind-modified-sexp-functions' -The following options are settable via toggling functions (look at the -documentation of these options for the names of these functions): - `paren-match-quoted-paren' - `paren-match-paired-delimiter' - `paren-open-paren-context-backward'" t nil) - -(autoload 'paren-deactivate "mic-paren" "\ -Deactivates mic-paren parenthesis highlighting" t nil) - -(autoload 'paren-toggle-matching-paired-delimiter "mic-paren" "\ -Toggle matching paired delimiter, force on with positive arg. Use this in -mode-hooks to activate or deactivate paired delimiter matching. If optional -second argument NO-MESSAGE is not nil then no message is displayed about the -current activation state of the paired-delimiter-matching feature." t nil) - -(autoload 'paren-toggle-matching-quoted-paren "mic-paren" "\ -Toggle matching quoted parens, force on with positive arg. Use this in -mode-hooks to activate or deactivate quoted paren matching. If optional second -argument NO-MESSAGE is not nil then no message is displayed about the current -activation state of the quoted-paren-matching feature." t nil) - -(autoload 'paren-toggle-open-paren-context "mic-paren" "\ -Toggle the determining of the context to display of the matching -open-paren, force backward context with positive arg. Use this in mode-hooks. -For a description of the meaning look at `paren-open-paren-context-backward'." t nil) - -(autoload 'paren-forward-sexp "mic-paren" "\ -Acts like forward-sexp but can also handle quoted parens. Look at -`paren-match-quoted-paren' for a detailed comment." t nil) - -(autoload 'paren-backward-sexp "mic-paren" "\ -Acts like backward-sexp but can also matching quoted parens. Look at -`paren-match-quoted-paren' for a detailed comment" t nil) - -;;;*** - -;;;### (autoloads (narrow-stack-mode) "narrow-stack" "edit-utils/narrow-stack.el") - -(autoload 'narrow-stack-mode "narrow-stack" "\ -narrow-stack-mode implements a stack of narrows. Thus with -narrow-stack-mode you may narrow within narrowing, and widen to the -previous narrowing - -For more information on narrowing, see narrow-to-region" t nil) - -;;;*** - -;;;### (autoloads (outl-mouse-minor-mode outl-mouse-mode) "outl-mouse" "edit-utils/outl-mouse.el") - -(autoload 'outl-mouse-mode "outl-mouse" "\ -Calls outline-mode, with outl-mouse extensions" t nil) - -(autoload 'outl-mouse-minor-mode "outl-mouse" "\ -Toggles outline-minor-mode, with outl-mouse extensions" t nil) - -;;;*** - -;;;### (autoloads (blink-paren paren-set-mode) "paren" "edit-utils/paren.el") - -(defcustom paren-mode nil "*Sets the style of parenthesis highlighting.\nValid values are nil, `blink-paren', `paren', and `sexp'.\n nil no parenthesis highlighting.\n blink-paren causes the matching paren to blink.\n paren causes the matching paren to be highlighted but not to blink.\n sexp whole expression enclosed by the local paren at its mate.\n sexp-surround whole surrounding expression, even if point is not at paren.\n nested (not yet implemented) use variable shading to see the\n nesting of an expression. Also groks regular expressions\n and shell quoting.\n\nThis variable is global by default, but you can make it buffer-local and\nhighlight parentheses differently in different major modes." :type '(radio (const :tag "None (default)" nil) (const :tag "Blinking Paren" blink-paren) (const :tag "Highlighted Paren" paren) (const :tag "Highlighted Expression" sexp) (const :tag "Highlighted Surrounding Expression" sexp-surround)) :set (lambda (symbol value) (paren-set-mode value)) :initialize 'custom-initialize-default :require 'paren :group 'paren-matching) - -(autoload 'paren-set-mode "paren" "\ -Cycles through possible values for `paren-mode', force off with negative arg. -When called from lisp, a symbolic value for `paren-mode' can be passed directly. -See also `paren-mode' and `paren-highlight'." t nil) - -(make-obsolete 'blink-paren 'paren-set-mode) - -(autoload 'blink-paren "paren" "\ -Obsolete. Use `paren-set-mode' instead." t nil) - -;;;*** - -;;;### (autoloads (turn-on-permanent-buffers permanent-buffers-mode) "permanent-buffers" "edit-utils/permanent-buffers.el") - -(defcustom permanent-buffers-mode nil "Indicates whether the `permanent-buffers' behavior is active. You can\ncustomize this variable to change the default value. To change the value\nduring an XEmacs session, please use the function instead." :type 'boolean :set (lambda (sym val) (permanent-buffers-mode (if val 1 -1))) :initialize 'custom-initialize-default :require 'permanent-buffers :group 'permanent-buffers) - -(autoload 'permanent-buffers-mode "permanent-buffers" "\ -Toggle on/off the permanent buffers behavior. With a prefix > 0 turn it on. -A permanent buffer is a special buffer, not attached to any file, that can't -be killed or saved-as. If you kill it or save it as a file, it will be -regenerated fresh and empty. See also the variable `permanent-buffers-alist'." t nil) - -(autoload 'turn-on-permanent-buffers "permanent-buffers" "\ -Unconditionally turn on the `permanent-buffers' behavior." t nil) - -;;;*** - -;;;### (autoloads (popper-install) "popper" "edit-utils/popper.el") - -(autoload 'popper-install "popper" "\ -Install popper into Emacs." t nil) - -;;;*** - -;;;### (autoloads (recent-files-visit-file recent-files-initialize) "recent-files" "edit-utils/recent-files.el") - -(autoload 'recent-files-initialize "recent-files" "\ -Initialize the recent-files menu." t nil) - -(autoload 'recent-files-visit-file "recent-files" "\ -Visit a recent file. -Visit a file FILENAME that was visited recently. Optional second argument -specifies the coding system to use when decoding the file. Interactively, -with a prefix argument, you will be prompted for the coding system." t nil) - -;;;*** - -;;;### (autoloads (resume-suspend-hook) "resume" "edit-utils/resume.el") - -(autoload 'resume-suspend-hook "resume" "\ -Clear out the file used for transmitting args when Emacs resumes." nil nil) - -;;;*** - -;;;### (autoloads (resize-minibuffer-mode) "rsz-minibuf" "edit-utils/rsz-minibuf.el") - -(autoload 'resize-minibuffer-mode "rsz-minibuf" "\ -Enable or disable resize-minibuffer mode. -A negative prefix argument disables this mode. A positive argument or -argument of 0 enables it. - -When this minor mode is enabled, the minibuffer is dynamically resized to -contain the entire region of text put in it as you type. - -The variable `resize-minibuffer-mode' is set to t or nil depending on -whether this mode is active or not. - -The maximum height to which the minibuffer can grow is controlled by the -variable `resize-minibuffer-window-max-height'. - -The variable `resize-minibuffer-window-exactly' determines whether the -minibuffer window should ever be shrunk to make it no larger than needed to -display its contents. - -When using a window system, it is possible for a minibuffer to be the sole -window in a frame. Since that window is already its maximum size, the only -way to make more text visible at once is to increase the size of the frame. -The variable `resize-minibuffer-frame' controls whether this should be -done. The variables `resize-minibuffer-frame-max-height' and -`resize-minibuffer-frame-exactly' are analogous to their window -counterparts." t nil) - -;;;*** - -;;;### (autoloads (savehist-mode) "savehist" "edit-utils/savehist.el") - -(defcustom savehist-mode nil "Mode for automatic saving of minibuffer history.\nSet this by calling the `savehist-mode' function or using the customize\ninterface." :type 'boolean :set (lambda (symbol value) (savehist-mode (or value 0))) :initialize 'custom-initialize-default :require 'savehist :group 'savehist) - -(autoload 'savehist-mode "savehist" "\ -Toggle savehist-mode. -Positive ARG turns on `savehist-mode'. When on, savehist-mode causes -minibuffer history to be saved periodically and when exiting Emacs. -When turned on for the first time in an Emacs session, it causes the -previous minibuffer history to be loaded from `savehist-file'. - -This mode should normally be turned on from your Emacs init file. -Calling it at any other time replaces your current minibuffer histories, -which is probably undesirable." t nil) - -;;;*** - -;;;### (autoloads (list-matches-in-buffers) "search-buffers" "edit-utils/search-buffers.el") - -(autoload 'list-matches-in-buffers "search-buffers" "\ -List lines matching REGEXP in any matching buffer. -All buffers chosen via `buffer-regexp-list' are searched. Results are -displayed in a buffer named *Matches for \"REGEXP\" in buffers* -including hyperlinks to visit any match in any buffer." t nil) - -;;;*** - -;;;### (autoloads (setnu-mode) "setnu" "edit-utils/setnu.el") - -(autoload 'setnu-mode "setnu" "\ -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." t nil) - -;;;*** - -;;;### (autoloads (install-shell-fonts) "shell-font" "edit-utils/shell-font.el") - -(autoload 'install-shell-fonts "shell-font" "\ -Decorate the current interaction buffer with fonts. -This uses the faces called `shell-prompt', `shell-input' and `shell-output'; -you can alter the graphical attributes of those with the normal -face-manipulation functions." nil nil) - -;;;*** - -;;;### (autoloads (toolbar-find-item toolbar-find-button toolbar-kill-item-pos make-toolbar-instantiator toolbar-new-spacer toolbar-new-button toolbar-add-item toolbar-update-toolbar toolbar-add-execute-macro-button toolbar-add-kbd-macro toolbar-add-button-on-the-fly restore-initial-toolbar) "toolbar-utils" "edit-utils/toolbar-utils.el") - -(autoload 'restore-initial-toolbar "toolbar-utils" "\ -Restores the default toolbar defined by initial-toolbar-spec. - -There is also a cache of killed buttons in `button-palette'." t nil) - -(autoload 'toolbar-add-button-on-the-fly "toolbar-utils" "\ -Add an button at POSITION to the default toolbar of the selected window. -Returns t. - -#### The return value may change. Tell stephen@xemacs.org what value -you think would be (most) useful. - -DESCRIPTION is a string describing the action, and displayed as help. -COMMAND is an interactive command (ie, a symbol with an interactive function -definition) implementing the action. -LABEL is a string used to label the button. -POSITION is an optional position (a non-negative integer, or one of the -symbols 'left, 'right, or 'extreme-right, see `toolbar-add-item'). -LOCALE is an optional locale, defaulting to the current buffer. If current- -buffer-only is not what you want, and you don't understand specifier locales, -use 'global. It's safe and probably does what you want. - -#### No error checking, use at your own risk." t nil) - -(autoload 'toolbar-add-kbd-macro "toolbar-utils" "\ -Add a button invoking a keyboard macro to the toolbar of the current buffer. -The button is added at the end of the left group. - -MAC is a keyboard macro name, or the empty string or nil to use a copy of -the last keyboard macro defined. -ICON is a string specifying the icon to be used. If IS-FILE is non-nil, -it is interpreted as the name of an image file, and searched for using -`locate-data-file'. Otherwise it is used verbatim as a label. - -Interactively, prompts for the macro name MAC and an ICON. IS-FILE is -non-nil if a prefix argument was used. - -Warning: the interpretation of the prefix argument is likely to change." t nil) - -(autoload 'toolbar-add-execute-macro-button "toolbar-utils" "\ -Add a button to the global toolbar to execute the last keyboard macro. - -Unlike `toolbar-add-kbd-macro', this does not copy the macro. The macro -executed will change with redefinitions. - -Due to a simple implementation, this button will not appear in buffers with -local toolbars if invoked after the toolbar is installed. If you like this -button, it's probably best to invoke this function in your init file." t nil) - -(autoload 'toolbar-update-toolbar "toolbar-utils" "\ -Use ITEM to update TOOLBAR at POSITION in LOCALE. - -ITEM is a toolbar button or spacer specification (eg, from -`toolbar-new-button' or `toolbar-new-spacer'). -Optional TOOLBAR is a toolbar specifier object. It defaults to the value -of `default-toolbar'. -Optional POSITION is a non-negative integer or a symbol (for valid values, -see `toolbar-add-item'). The default is 'right. -Optional LOCALE is a specifier locale. The default is 'global. (This -default is not yet set in stone; it's best not to depend on it.) - -This is a convenience function for helper applications or minor modes that -would like to add a small number of buttons to an existing toolbar. For -constructing toolbars from scratch, use list and vector primitives, or -`toolbar-add-item'." nil nil) - -(autoload 'toolbar-add-item "toolbar-utils" "\ -Add ITEM to TOOLBAR-SPEC at POSITION, and return TOOLBAR-SPEC. -Uses functions that alter list structure. - -TOOLBAR-SPEC is a toolbar descriptor (eg, from `toolbar-new-toolbar'). -ITEM is a toolbar button or spacer specification (eg, from -`toolbar-new-button' or `toolbar-new-spacer'). -Optional POSITION is a non-negative integer, with 0 being the extreme left and -\(length TOOLBAR-SPEC) the extreme right. The symbols 'left, 'right, and -'extreme-right are also accepted. 'left is synonymous with 0. 'right places -ITEM at the right end of the left group of buttons. 'extreme-right places -ITEM at the extreme right of the toolbar, creating a right group if one -does not exist. - -#### This function does not yet support inserting the group delimiter nil -as an explicit item. - -POSITION may be greater than (length TOOLBAR-SPEC), in which case it is -truncated to (length TOOLBAR-SPEC). Note that (length TOOLBAR-SPEC) is not -synonymous with either 'right or 'extreme-right." nil nil) - -(autoload 'toolbar-new-button "toolbar-utils" "\ -Return a checked toolbar button specification. - -ICON-SPEC should be a list of glyphs (from `make-glyph'), a glyph, or a -string to use as the button's icon. If a string or single glyph, it will -be used for the button-up glyph. If a list, it may contain 1 to 6 glyphs, -which XEmacs will use for button up, button down, button disabled, button -up with caption, button down with caption, and button disabled with caption, -in that order. Missing or nil glyphs will be defaulted. (#### Strings as -list elements are not supported but could be.) -COMMAND is the (interactive) command to invoke when the button is pressed. -HELP-STRING is a string briefly describing the command, displayed in the -echo area or as balloon help when the pointer enters the button. -Optional argument INITIALLY-DISABLED, if non-nil, specifies that the button -should initially be disabled. - -See `default-toolbar' or the Lispref (node toolbars) for more information." nil nil) - -(autoload 'toolbar-new-spacer "toolbar-utils" "\ -Returns a checked toolbar spacer \"button\". - -STYLE is one of the symbols '2d or '3d, indicating whether the area is -displayed without shadows (giving it a flat appearance), or with shadows -\(giving it a raised, 3-d appearance). There is no default. -#### We may set a default style. Tell stephen@xemacs.org which you use. -SIZE specifies the length, in pixels, of the blank area. If omitted, -it defaults to a device-specific value (8 pixels for X devices)." nil nil) - -(autoload 'make-toolbar-instantiator "toolbar-utils" "\ -Return a checked toolbar instantiator, a list of vectors. - -TOOLBAR-SPEC may be a list of buttons (ie, a toolbar descriptor, see -`default-toolbar'), a toolbar specifier object, or a symbol whose value is -a toolbar specifier object. If a toolbar specifier object or variable -containing one, the specification for DOMAIN is used. If non-nil, DOMAIN -must be a window, a frame, or a device, otherwise it defaults to the selected -window (see `specifier-instance'). The list thus generated is checked and -returned. - -If TOOLBAR-SPEC is a list, it is copied; it is safe to pass other packages' -toolbar initializers to this function. However, you probably do not want -to change any of the objects in the returned specification. They are -returned as is, not copied. - -See `default-toolbar' or the Lispref (node toolbars) for more information." nil nil) - -(autoload 'toolbar-kill-item-pos "toolbar-utils" "\ -Kill the item at position POS of TOOLBAR in LOCALE. -Killed buttons are prepended to `button-palette'. - -LOCALE defaults to 'global. If there are multiple specs for LOCALE, take -the first one. - -This function currently does not accept symbolic positions a la -`toolbar-add-item'. Use `toolbar-find-item' to locate whole buttons and -spacers, and `toolbar-find-button' to locate buttons by characteristics. -See also `toolbar-find-button-by-icon', `toolbar-find-button-by-command', -and `toolbar-find-button-by-help-string'." nil nil) - -(autoload 'toolbar-find-button "toolbar-utils" "\ -Return the position of a button containing ITEM in its specification. - -ITEM may specify a button, spacer, icon, command, help string, or nil. -If ITEM is nil, find the separator between the group of buttons to be left -justified, and the group to be right justified. (Distinctions among the -various \"search key types\" are somewhat heuristic but are probably -reliable enough to use in library code.) - -If TOOLBAR is non-nil, search it; otherwise search the default toolbar. -If LOCALE is non-nil, get TOOLBAR's descriptor in that locale, otherwise -use the global locale." nil nil) - -(autoload 'toolbar-find-item "toolbar-utils" "\ -Return the position of ITEM, a button, spacer, or nil. -TOOLBAR and LOCALE determine the descriptor to be searched. - -If ITEM is nil, find the separator between the group of buttons to be left -justified, and the group to be right justified. -If there are several matching items, the first is returned. If none is -found, return nil." nil nil) - -;;;*** - -;;;### (autoloads (vertical-mode) "vertical-mode" "edit-utils/vertical-mode.el") - -(autoload 'vertical-mode "vertical-mode" "\ -This function toggles vertical mode on and off." t nil) - -;;;*** - -;;;### (autoloads (install-where-was-i toggle-where-was-i) "where-was-i-db" "edit-utils/where-was-i-db.el") - -(autoload 'toggle-where-was-i "where-was-i-db" "\ -Toggle whether to save your place in this file between sessions. - -Toggling place saving on in a file's buffer will cause -`where-was-i-db' to install its hooks, via `install-where-was-i'. You -do not need to explicitly run an install function -- just toggle it on -for a file for which you want the cursor position to be saved. In -order for this feature to be automatically installed at startup, you -must customize `wwi-auto-install-on-startup-flag'. - -Place saving is enabled ONLY for files in which you've explicitly -toggled it on for. This prevents application programs, such as Gnus, -W3, VM, or your own programs from making extraneous `where-was-i-db' -database entries for their machine-generated files. - -If this mode is enabled, point is recorded for you when you kill the -buffer or exit XEmacs. Visiting a file again that has had a database -entry made in this fashion will cause `point' to be restored to the -saved position, even in a later XEmacs editing session. - -If called with a prefix arg, the mode is enabled if and only if the -argument is positive. This is for use by program code. In that case, -you may also like to bind the value of `where-was-i-db'. You should -not globally `setq' it; but bind it with a `let' around the code for -which you wish point saved in a separate-from-the-main database. - -There is more information in the comment header of this program. It -may be worth reading. If you haven't installed the `.el' codes for -reference, on at least one machine in your system, you deserve to -lose. -" t nil) - -(autoload 'install-where-was-i "where-was-i-db" "\ -Unconditionally activate `where-was-i-db' by installing some hook -functions. An optional prefix arg <= 0 will uninstall the feature. - -See the function documentation to `toggle-where-was-i' for more -information about the `where-was-i-db' feature, and consult the code -itself for more information about unloading the feature." t nil) - -(defconst toggle-where-was-i nil "\ -This is set when `where-was-i-db' place saving is enabled for this -buffer's file. This must be set by `M-x toggle-where-was-i', since it -performs additional actions beyond just toggling this permanent -buffer-local flag variable.") - -;;;*** - -;;;### (autoloads (winring-rename-configuration winring-delete-configuration winring-jump-to-configuration winring-prev-configuration winring-next-configuration winring-duplicate-configuration winring-new-configuration) "winring" "edit-utils/winring.el") - -(autoload 'winring-new-configuration "winring" "\ -Save the current window configuration and create an empty new one. -The buffer shown in the new empty configuration is defined by -`winring-new-config-buffer-name'. - -With \\[universal-argument] prompt for the new configuration's name. -Otherwise, the function in `winring-name-generator' will be called to -get the new configuration's name." t nil) - -(autoload 'winring-duplicate-configuration "winring" "\ -Push the current window configuration on the ring, and duplicate it. - -With \\[universal-argument] prompt for the new configuration's name. -Otherwise, the function in `winring-name-generator' will be called to -get the new configuration's name." t nil) - -(autoload 'winring-next-configuration "winring" "\ -Switch to the next window configuration for this frame." t nil) - -(autoload 'winring-prev-configuration "winring" "\ -Switch to the previous window configuration for this frame." t nil) - -(autoload 'winring-jump-to-configuration "winring" "\ -Go to the named window configuration." t nil) - -(autoload 'winring-delete-configuration "winring" "\ -Delete the current configuration and switch to the next one. -With \\[universal-argument] prompt for named configuration to delete." t nil) - -(autoload 'winring-rename-configuration "winring" "\ -Rename the current configuration to NAME." t nil) - -;;;*** - -(provide 'edit-utils-autoloads) diff --git a/xemacs-packages/lisp/edit-utils/autorevert.el b/xemacs-packages/lisp/edit-utils/autorevert.el deleted file mode 100644 index 5f1a2685..00000000 --- a/xemacs-packages/lisp/edit-utils/autorevert.el +++ /dev/null @@ -1,375 +0,0 @@ -;;; autorevert.el --- revert buffers when files on disk change - -;; Copyright (C) 1997, 1998, 1999, 2001 Free Software Foundation, Inc. - -;; Author: Anders Lindgren -;; Keywords: convenience -;; Created: 1997-06-01 -;; Date: 1999-11-30 - -;; 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: - -;; Introduction: -;; -;; Whenever a file that Emacs is editing has been changed by another -;; program the user normally has to execute the command `revert-buffer' -;; to load the new content of the file into Emacs. -;; -;; This package contains two minor modes: Global Auto-Revert Mode and -;; Auto-Revert Mode. Both modes automatically revert buffers -;; whenever the corresponding files have been changed on disk. -;; -;; Auto-Revert Mode can be activated for individual buffers. -;; Global Auto-Revert Mode applies to all file buffers. -;; -;; Both modes operate by checking the time stamp of all files at -;; intervals of `auto-revert-interval'. The default is every five -;; seconds. The check is aborted whenever the user actually uses -;; Emacs. You should never even notice that this package is active -;; (except that your buffers will be reverted, of course). - -;; Usage: -;; -;; Go to the appropriate buffer and press: -;; M-x auto-revert-mode RET -;; -;; To activate Global Auto-Revert Mode, press: -;; M-x global-auto-revert-mode RET -;; -;; To activate Global Auto-Revert Mode every time Emacs is started -;; customise the option `global-auto-revert-mode' or the following -;; line could be added to your ~/.emacs: -;; (global-auto-revert-mode 1) -;; -;; The function `turn-on-auto-revert-mode' could be added to any major -;; mode hook to activate Auto-Revert Mode for all buffers in that -;; mode. For example, the following line will activate Auto-Revert -;; Mode in all C mode buffers: -;; -;; (add-hook 'c-mode-hook 'turn-on-auto-revert-mode) - -;;; Code: - -;; Dependencies: - -(require 'timer) -(eval-when-compile (require 'cl)) - - -;; Custom Group: -;; -;; The two modes will be placed next to Auto Save Mode under the -;; Files group under Emacs. - -(defgroup auto-revert nil - "Revert individual buffers when files on disk change. - -Auto-Revert Mode can be activated for individual buffer. -Global Auto-Revert Mode applies to all buffers." - :group 'files) - - -;; Variables: - -;; Autoload for the benefit of `make-mode-line-mouse-sensitive'. -;;;###autoload -(defvar auto-revert-mode nil - "*Non-nil when Auto-Revert Mode is active. - -Never set this variable directly, use the command `auto-revert-mode' -instead.") - -;;;###autoload -(defcustom global-auto-revert-mode nil - "When on, buffers are automatically reverted when files on disk change. - -Set this variable using \\[customize] only. Otherwise, use the -command `global-auto-revert-mode'." - :group 'auto-revert - :initialize 'custom-initialize-default - :set '(lambda (symbol value) - (global-auto-revert-mode (or value 0))) - :type 'boolean - :require 'autorevert) - -(defcustom auto-revert-interval 5 - "Time, in seconds, between Auto-Revert Mode file checks." - :group 'auto-revert - :type 'integer) - -(defcustom auto-revert-stop-on-user-input t - "When non-nil Auto-Revert Mode stops checking files on user input." - :group 'auto-revert - :type 'boolean) - -(defcustom auto-revert-verbose t - "When nil, Auto-Revert Mode will not generate any messages. - -Currently, messages are generated when the mode is activated or -deactivated, and whenever a file is reverted." - :group 'auto-revert - :type 'boolean) - -(defcustom auto-revert-mode-text " ARev" - "String to display in the mode line when Auto-Revert Mode is active. - -\(When the string is not empty, make sure that it has a leading space.)" - :tag "Auto Revert Mode Text" ; To separate it from `global-...' - :group 'auto-revert - :type 'string) - -(defcustom auto-revert-mode-hook nil - "Functions to run when Auto-Revert Mode is activated." - :tag "Auto Revert Mode Hook" ; To separate it from `global-...' - :group 'auto-revert - :type 'hook) - -(defcustom global-auto-revert-mode-text "" - "String to display when Global Auto-Revert Mode is active. - -The default is nothing since when this mode is active this text doesn't -vary over time, or between buffers. Hence mode line text -would only waste precious space." - :group 'auto-revert - :type 'string) - -(defcustom global-auto-revert-mode-hook nil - "Hook called when Global Auto-Revert Mode is activated." - :group 'auto-revert - :type 'hook) - -(defcustom global-auto-revert-non-file-buffers nil - "*When nil only file buffers are reverted by Global Auto-Revert Mode. - -When non-nil, both file buffers and buffers with a custom -`revert-buffer-function' are reverted by Global Auto-Revert Mode." - :group 'auto-revert - :type 'boolean) - -(defcustom global-auto-revert-ignore-modes '(Info-mode) - "List of major modes Global Auto-Revert Mode should not check." - :group 'auto-revert - :type '(repeat sexp)) - -(defcustom auto-revert-load-hook nil - "Functions to run when Auto-Revert Mode is first loaded." - :tag "Load Hook" - :group 'auto-revert - :type 'hook) - -(defvar global-auto-revert-ignore-buffer nil - "*When non-nil, Global Auto-Revert Mode will not revert this buffer. - -This variable becomes buffer local when set in any fashion.") -(make-variable-buffer-local 'global-auto-revert-ignore-buffer) - - -;; Internal variables: - -(defvar auto-revert-buffer-list '() - "List of buffers in Auto-Revert Mode. - -Note that only Auto-Revert Mode, never Global Auto-Revert Mode, adds -buffers to this list. - -The timer function `auto-revert-buffers' is responsible for purging -the list of old buffers.") - -(defvar auto-revert-timer nil - "Timer used by Auto-Revert Mode.") - -(defvar auto-revert-remaining-buffers '() - "Buffers not checked when user input stopped execution.") - - -;; Functions: - -;;;###autoload -(defun auto-revert-mode (&optional arg) - "Toggle reverting buffer when file on disk changes. - -With arg, turn Auto Revert mode on if and only if arg is positive. -This is a minor mode that affects only the current buffer. -Use `global-auto-revert-mode' to automatically revert all buffers." - (interactive "P") - (make-local-variable 'auto-revert-mode) - (put 'auto-revert-mode 'permanent-local t) - (setq auto-revert-mode - (if (null arg) - (not auto-revert-mode) - (> (prefix-numeric-value arg) 0))) - (if (and auto-revert-verbose - (interactive-p)) - (message "Auto-Revert Mode is now %s." - (if auto-revert-mode "on" "off"))) - (if auto-revert-mode - (if (not (memq (current-buffer) auto-revert-buffer-list)) - (push (current-buffer) auto-revert-buffer-list)) - (setq auto-revert-buffer-list - (delq (current-buffer) auto-revert-buffer-list))) - (auto-revert-set-timer) - (when auto-revert-mode - (auto-revert-buffers) - (run-hooks 'auto-revert-mode-hook)) - auto-revert-mode) - - -;;;###autoload -(defun turn-on-auto-revert-mode () - "Turn on Auto-Revert Mode. - -This function is designed to be added to hooks, for example: - (add-hook 'c-mode-hook 'turn-on-auto-revert-mode)" - (auto-revert-mode 1)) - - -;;;###autoload -(defun global-auto-revert-mode (&optional arg) - "Revert any buffer when file on disk change. - -With arg, turn Auto Revert mode on globally if and only if arg is positive. -This is a minor mode that affects all buffers. -Use `auto-revert-mode' to revert a particular buffer." - (interactive "P") - (setq global-auto-revert-mode - (if (null arg) - (not global-auto-revert-mode) - (> (prefix-numeric-value arg) 0))) - (if (and auto-revert-verbose - (interactive-p)) - (message "Global Auto-Revert Mode is now %s." - (if global-auto-revert-mode "on" "off"))) - (auto-revert-set-timer) - (when global-auto-revert-mode - (auto-revert-buffers) - (run-hooks 'global-auto-revert-mode-hook))) - - -(defun auto-revert-set-timer () - "Restart or cancel the timer." - (if (timerp auto-revert-timer) - (cancel-timer auto-revert-timer)) - (if (or global-auto-revert-mode auto-revert-buffer-list) - (setq auto-revert-timer (run-with-timer auto-revert-interval - auto-revert-interval - 'auto-revert-buffers)) - (setq auto-revert-timer nil))) - - -(defun auto-revert-buffers () - "Revert buffers as specified by Auto-Revert and Global Auto-Revert Mode. - -Should `global-auto-revert-mode' be active all file buffers are checked. - -Should `auto-revert-mode' be active in some buffers, those buffers -are checked. - -Non-file buffers that have a custom `revert-buffer-function' are -reverted either when Auto-Revert Mode is active in that buffer, or -when the variable `global-auto-revert-non-file-buffers' is non-nil -and Global Auto-Revert Mode is active. - -This function stops whenever there is user input. The buffers not -checked are stored in the variable `auto-revert-remaining-buffers'. - -To avoid starvation, the buffers in `auto-revert-remaining-buffers' -are checked first the next time this function is called. - -This function is also responsible for removing buffers no longer in -Auto-Revert mode from `auto-revert-buffer-list', and for canceling -the timer when no buffers need to be checked." - (let ((bufs (if global-auto-revert-mode - (buffer-list) - auto-revert-buffer-list)) - (remaining '()) - (new '())) - ;; Partition `bufs' into two halves depending on whether or not - ;; the buffers are in `auto-revert-remaining-buffers'. The two - ;; halves are then re-joined with the "remaining" buffers at the - ;; head of the list. - (dolist (buf auto-revert-remaining-buffers) - (if (memq buf bufs) - (push buf remaining))) - (dolist (buf bufs) - (if (not (memq buf remaining)) - (push buf new))) - (setq bufs (nreverse (nconc new remaining))) - (while (and bufs - (not (and auto-revert-stop-on-user-input - (input-pending-p)))) - (let ((buf (car bufs))) - (if (buffer-name buf) ; Buffer still alive? - (save-excursion - (set-buffer buf) - ;; Test if someone has turned off Auto-Revert Mode in a - ;; non-standard way, for example by changing major mode. - (if (and (not auto-revert-mode) - (memq buf auto-revert-buffer-list)) - (setq auto-revert-buffer-list - (delq buf auto-revert-buffer-list))) - (when (and - (or auto-revert-mode - (and - global-auto-revert-mode - (not global-auto-revert-ignore-buffer) - (not (memq major-mode - global-auto-revert-ignore-modes)))) - (not (buffer-modified-p)) - (if (buffer-file-name) - (and (file-readable-p (buffer-file-name)) - (not (verify-visited-file-modtime buf))) - (and revert-buffer-function - (or (and global-auto-revert-mode - global-auto-revert-non-file-buffers) - auto-revert-mode)))) - (if auto-revert-verbose - (message "Reverting buffer `%s'." buf)) - (revert-buffer t t t))) - ;; Remove dead buffer from `auto-revert-buffer-list'. - (setq auto-revert-buffer-list - (delq buf auto-revert-buffer-list)))) - (setq bufs (cdr bufs))) - (setq auto-revert-remaining-buffers bufs) - ;; Check if we should cancel the timer. - (when (and (not global-auto-revert-mode) - (null auto-revert-buffer-list)) - (cancel-timer auto-revert-timer) - (setq auto-revert-timer nil)))) - - -;; The end: - -(unless (assq 'auto-revert-mode minor-mode-alist) - (push '(auto-revert-mode auto-revert-mode-text) - minor-mode-alist)) -(unless (assq 'global-auto-revert-mode minor-mode-alist) - (push '(global-auto-revert-mode global-auto-revert-mode-text) - minor-mode-alist)) - -(provide 'autorevert) - -(run-hooks 'auto-revert-load-hook) - -;; This makes it possible to set Global Auto-Revert Mode from -;; Customize. -(if global-auto-revert-mode - (global-auto-revert-mode 1)) - -;;; autorevert.el ends here diff --git a/xemacs-packages/lisp/edit-utils/avoid.el b/xemacs-packages/lisp/edit-utils/avoid.el deleted file mode 100644 index a6795826..00000000 --- a/xemacs-packages/lisp/edit-utils/avoid.el +++ /dev/null @@ -1,407 +0,0 @@ -;;; avoid.el --- make mouse pointer stay out of the way of editing - -;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. - -;; Author: Boris Goldowsky -;; Keywords: mouse -;; Version: 1.10 - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: FSF 19.34. - -;;; Commentary: - -;; For those who are annoyed by the mouse pointer obscuring text, -;; this mode moves the mouse pointer - either just a little out of -;; the way, or all the way to the corner of the frame. -;; To use, load or evaluate this file and type M-x mouse-avoidance-mode . -;; To set up permanently, put this file on your .emacs: -;; -;; (if window-system (mouse-avoidance-mode 'animate)) -;; -;; The 'animate can be 'jump or 'banish or 'exile or 'protean if you prefer. -;; See the documentation for function `mouse-avoidance-mode' for -;; details of the different modes. -;; -;; For added silliness, make the animatee animate... -;; put something similar to the following into your .emacs: -;; -;; (if window-system -;; (mouse-avoidance-set-pointer-shape -;; (eval (nth (random 4) -;; '(x-pointer-man x-pointer-spider -;; x-pointer-gobbler x-pointer-gumby))))) -;; -;; For completely random pointer shape, replace the setq above with: -;; (setq x-pointer-shape (mouse-avoidance-random-shape)) -;; -;; Bugs / Warnings / To-Do: -;; -;; - Using this code does slow emacs down. "banish" mode shouldn't -;; be too bad, and on my workstation even "animate" is reasonable. -;; -;; - It ought find out where any overlapping frames are and avoid them, -;; rather than always raising the frame. - -;; Credits: -;; This code was helped by all those who contributed suggestions, -;; fixes, and additions -;; Joe Harrington (and his advisor), for the original inspiration. -;; Ken Manheimer, for dreaming up the Protean mode. -;; Richard Stallman, for the awful cat-and-mouse pun, among other things. -;; Mike Williams, Denis Howe, Bill Benedetto, Chris Moore, Don Morris, -;; Simon Marshall, and M.S. Ashton, for their feedback. - -;;; Code: - -(provide 'avoid) - -(defgroup avoid nil - "Make mouse pointer stay out of the way of editing." - :prefix "mouse-avoidance-" - :group 'mouse) - - -;;;###autoload -(defcustom mouse-avoidance-mode nil - "Value is t or a symbol if the mouse pointer should avoid the cursor. -See function `mouse-avoidance-mode' for possible values. Normally, you -shouldn't modify this variable by hand, but use the function instead. However, -the default value can be customized from the options menu." - :type '(radio - (const :tag "No mouse avoidance" nil) - (const :tag "Move the mouse on keypress" banish) - (const :tag "Move the mouse if the cursor gets too close" exile) - (const :tag "Displace the mouse if the cursor gets too close" jump) - (const :tag "Animate the mouse" animate) - (const :tag "Animate + change shape" proteus)) - :set (lambda (symbol value) - (mouse-avoidance-mode (or value 'none))) - :initialize 'custom-initialize-default - :require 'avoid - :group 'avoid) - -(defcustom mouse-avoidance-nudge-dist 15 - "*Average distance that mouse will be moved when approached by cursor. -Only applies in mouse-avoidance-mode `jump' and its derivatives. -For best results make this larger than `mouse-avoidance-threshold'." - :type 'integer - :group 'avoid) - -(defcustom mouse-avoidance-nudge-var 10 - "*Variability of `mouse-avoidance-nudge-dist' (which see)." - :type 'integer - :group 'avoid) - -(defcustom mouse-avoidance-animation-delay .01 - "Delay between animation steps, in seconds." - :type 'number - :group 'avoid) - -(defcustom mouse-avoidance-threshold 5 - "*Mouse-pointer's flight distance. -If the cursor gets closer than this, the mouse pointer will move away. -Only applies in mouse-avoidance-modes `animate' and `jump'." - :type 'integer - :group 'avoid) - -;;;###autoload -(defcustom mouse-avoidance-mode-line-string " Avoid" - "*String to display in the modeline when `mouse-avoidance-mode' is active. -Set this to nil if you don't want a modeline indicator." - :type '(choice string - (const :tag "none" nil)) - :group 'avoid) - -;; Internal variables -(defvar mouse-avoidance-state nil) -(defvar mouse-avoidance-pointer-shapes nil) -(defvar mouse-avoidance-n-pointer-shapes 0) -(defvar mouse-avoidance-old-pointer-shape nil) - -;;; Functions: - -(defsubst mouse-avoidance-set-pointer-shape (shape) - "Set the shape of the mouse pointer to SHAPE." - (setq x-pointer-shape shape) - (set-mouse-color nil)) - -;; XEmacs change -- this is so ugly. [FSF version is totally different -sb] -(defun mouse-avoidance-point-position () - "Returns (WINDOW X . Y) of current point - analogous to mouse-position" - (let* ((beg (window-start)) - (pos (point)) - (col (current-column)) - (row)) - (setq row (count-lines beg pos)) - (cons (selected-window) (cons col row)))) - -;(defun mouse-avoidance-point-position-test () -; (interactive) -; (message "point=%s mouse=%s" -; (cdr (mouse-avoidance-point-position)) -; (cdr (mouse-position)))) - -(defun mouse-avoidance-set-mouse-position (pos) - ;; Carefully set mouse position to given position (X . Y) - ;; Ideally, should check if X,Y is in the current frame, and if not, - ;; leave the mouse where it was. However, this is currently - ;; difficult to do, so we just raise the frame to avoid frame switches. - ;; Returns t if it moved the mouse. - (let ((f (selected-frame))) - (raise-frame f) - ;; XEmacs: FSF version of set-mouse-position requires FRAME parameter - (set-mouse-position (frame-selected-window f) (car pos) (cdr pos)) - t)) - -(defun mouse-avoidance-too-close-p (mouse) - ;; Return t if mouse pointer and point cursor are too close. - ;; Acceptable distance is defined by mouse-avoidance-threshold. - (let ((point (mouse-avoidance-point-position))) - (and (eq (car mouse) (car point)) - (car (cdr mouse)) - (< (abs (- (car (cdr mouse)) (car (cdr point)))) - mouse-avoidance-threshold) - (< (abs (- (cdr (cdr mouse)) (cdr (cdr point)))) - mouse-avoidance-threshold)))) - -(defun mouse-avoidance-banish-destination () - "The position to which mouse-avoidance-mode `banish' moves the mouse. -You can redefine this if you want the mouse banished to a different corner." - (cons (1- (frame-width)) - 0)) - -(defun mouse-avoidance-banish-mouse () - ;; Put the mouse pointer in the upper-right corner of the current frame. - (mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination))) - -(defsubst mouse-avoidance-delta (cur delta dist var min max) - ;; Decide how far to move in either dimension. - ;; Args are the CURRENT location, the desired DELTA for - ;; warp-conservation, the DISTANCE we like to move, the VARIABILITY - ;; in distance allowed, and the MIN and MAX possible window positions. - ;; Returns something as close to DELTA as possible within the constraints. - (let ((L1 (max (- min cur) (+ (- dist) (- var)))) - (R1 (+ (- dist) var )) - (L2 (+ dist (- var))) - (R2 (min (- max cur) (+ dist var)))) - (if (< R1 (- min cur)) (setq L1 nil R1 nil)) - (if (> L2 (- max cur)) (setq L2 nil R2 nil)) - (cond ((and L1 (< delta L1)) L1) - ((and R1 (< delta R1)) delta) - ((and R1 (< delta 0)) R1) - ((and L2 (< delta L2)) L2) - ((and R2 (< delta R2)) delta) - (R2) - ((or R1 L2)) - (t 0)))) - -(defun mouse-avoidance-nudge-mouse () - ;; Push the mouse a little way away, possibly animating the move - ;; For these modes, state keeps track of the total offset that we've - ;; accumulated, and tries to keep it close to zero. - (let* ((cur (mouse-position)) - (cur-frame (car cur)) - (cur-pos (cdr cur)) - (deltax (mouse-avoidance-delta - (car cur-pos) (- (random mouse-avoidance-nudge-var) - (car mouse-avoidance-state)) - mouse-avoidance-nudge-dist mouse-avoidance-nudge-var - 0 (frame-width))) - (deltay (mouse-avoidance-delta - (cdr cur-pos) (- (random mouse-avoidance-nudge-var) - (cdr mouse-avoidance-state)) - mouse-avoidance-nudge-dist mouse-avoidance-nudge-var - 0 (frame-height)))) - (setq mouse-avoidance-state - (cons (+ (car mouse-avoidance-state) deltax) - (+ (cdr mouse-avoidance-state) deltay))) - (if (or (eq mouse-avoidance-mode 'animate) - (eq mouse-avoidance-mode 'proteus)) - (let ((i 0.0) - ;; XEmacs change - (color (cdr (assoc 'mouse-color (frame-parameters))))) - (while (<= i 1) - (mouse-avoidance-set-mouse-position - (cons (+ (car cur-pos) (round (* i deltax))) - (+ (cdr cur-pos) (round (* i deltay))))) - (setq i (+ i (max .1 (/ 1.0 mouse-avoidance-nudge-dist)))) - (if (eq mouse-avoidance-mode 'proteus) - ;; XEmacs change - (progn - (setq x-pointer-shape (mouse-avoidance-random-shape)) - (set-mouse-color color))) - (sit-for mouse-avoidance-animation-delay))) - (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax) - (+ (cdr (cdr cur)) deltay)))))) - -(defun mouse-avoidance-random-shape () - "Return a random cursor shape. -This assumes that any variable whose name begins with x-pointer- and -has an integer value is a valid cursor shape. You might want to -redefine this function to suit your own tastes." - (if (null mouse-avoidance-pointer-shapes) - (progn - (setq mouse-avoidance-pointer-shapes - (mapcar '(lambda (x) (symbol-value (intern x))) - (all-completions "x-pointer-" obarray - '(lambda (x) - (and (boundp x) - (integerp (symbol-value x))))))) - (setq mouse-avoidance-n-pointer-shapes - (length mouse-avoidance-pointer-shapes)))) - (nth (random mouse-avoidance-n-pointer-shapes) - mouse-avoidance-pointer-shapes)) - -(defun mouse-avoidance-banish-hook () - (if (and (not executing-kbd-macro) ; don't check inside macro - (mouse-avoidance-kbd-command (this-command-keys))) - (mouse-avoidance-banish-mouse))) - -(defun mouse-avoidance-exile-hook () - ;; For exile mode, the state is nil when the mouse is in its normal - ;; position, and set to the old mouse-position when the mouse is in exile. - (if (and (not executing-kbd-macro) - (mouse-avoidance-kbd-command (this-command-keys))) - (let ((mp (mouse-position))) - (cond ((and (not mouse-avoidance-state) - (mouse-avoidance-too-close-p mp)) - (setq mouse-avoidance-state mp) - (mouse-avoidance-banish-mouse)) - ((and mouse-avoidance-state - (not (mouse-avoidance-too-close-p mouse-avoidance-state))) - ;; XEmacs change - (if (and (eq (car mp) (if (and (< emacs-major-version 20) - (< emacs-minor-version 12)) - (selected-frame) - (selected-window))) - (equal (cdr mp) (mouse-avoidance-banish-destination))) - (mouse-avoidance-set-mouse-position - ;; move back only if user has not moved mouse - (cdr mouse-avoidance-state))) - ;; but clear state anyway, to be ready for another move - (setq mouse-avoidance-state nil)))))) - -(defun mouse-avoidance-fancy-hook () - ;; Used for the "fancy" modes, ie jump et al. - (if (and (not executing-kbd-macro) ; don't check inside macro - (mouse-avoidance-kbd-command (this-command-keys)) - (mouse-avoidance-too-close-p (mouse-position))) - (let ((old-pos (mouse-position))) - (mouse-avoidance-nudge-mouse) - ;; XEmacs change - (if (not (eq (if (and (< emacs-major-version 20) - (< emacs-minor-version 12)) - (selected-frame) - (selected-window)) (car old-pos))) ; move went awry - (set-mouse-position (car old-pos) ; sigh.. - (car (cdr old-pos)) - (cdr (cdr old-pos))))))) - -(defun mouse-avoidance-kbd-command (key) - "Return t if the KEYSEQENCE is composed of keyboard events only. -Return nil if there are any lists in the key sequence." - (cond ((null key) nil) ; Null event seems to be - ; returned occasionally. - ((not (vectorp key)) t) ; Strings are keyboard events. - ((catch 'done - (let ((i 0) - (l (length key))) - (while (< i l) - ;; XEmacs change: (Emacs version was: (listp (aref key i))) - (if (not (key-press-event-p (aref key i))) - (throw 'done nil)) - (setq i (1+ i)))) - t)))) - -;;;###autoload -(defun mouse-avoidance-mode (&optional mode) - "Set cursor avoidance mode to MODE. -MODE should be one of the symbols `banish', `exile', `jump', `animate', -`cat-and-mouse', `proteus', or `none'. - -If MODE is nil, toggle mouse avoidance between `none` and `banish' -modes. Positive numbers and symbols other than the above are treated -as equivalent to `banish'; negative numbers and `-' are equivalent to `none'. - -Effects of the different modes: - * banish: Move the mouse to the upper-right corner on any keypress. - * exile: Move the mouse to the corner only if the cursor gets too close, - and allow it to return once the cursor is out of the way. - * jump: If the cursor gets too close to the mouse, displace the mouse - a random distance & direction. - * animate: As `jump', but shows steps along the way for illusion of motion. - * cat-and-mouse: Same as `animate'. - * proteus: As `animate', but changes the shape of the mouse pointer too. - -Whenever the mouse is moved, the frame is also raised. - -\(see `mouse-avoidance-threshold' for definition of \"too close\", -and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for -definition of \"random distance\".)" - (interactive - (list (intern (completing-read - "Select cursor avoidance technique (SPACE for list): " - '(("banish") ("exile") ("jump") ("animate") - ("cat-and-mouse") ("proteus") ("none")) - nil t)))) - (if (eq mode 'cat-and-mouse) - (setq mode 'animate)) - ;; XEmacs change - We don't have post-command-idle-hook - (remove-hook 'post-command-hook 'mouse-avoidance-banish-hook) - (remove-hook 'post-command-hook 'mouse-avoidance-exile-hook) - (remove-hook 'post-command-hook 'mouse-avoidance-fancy-hook) - ;; Restore pointer shape if necessary - (if (eq mouse-avoidance-mode 'proteus) - (mouse-avoidance-set-pointer-shape mouse-avoidance-old-pointer-shape)) - - ;; Do additional setup depending on version of mode requested - (cond ((eq mode 'none) - (setq mouse-avoidance-mode nil)) - ((or (eq mode 'jump) - (eq mode 'animate) - (eq mode 'proteus)) - ;; XEmacs: we don't have post-command-idle-hook - (add-hook 'post-command-hook 'mouse-avoidance-fancy-hook) - (setq mouse-avoidance-mode mode - mouse-avoidance-state (cons 0 0) - mouse-avoidance-old-pointer-shape x-pointer-shape)) - ((eq mode 'exile) - ;; XEmacs: FSF uses post-command-idle-hook - (add-hook 'post-command-hook 'mouse-avoidance-exile-hook) - (setq mouse-avoidance-mode mode - mouse-avoidance-state nil)) - ((or (eq mode 'banish) - (eq mode t) - (and (null mode) (null mouse-avoidance-mode)) - (and mode (> (prefix-numeric-value mode) 0))) - ;; XEmacs: FSF uses post-command-idle-hook - (add-hook 'post-command-hook 'mouse-avoidance-banish-hook) - (setq mouse-avoidance-mode 'banish)) - (t (setq mouse-avoidance-mode nil))) - (force-mode-line-update)) - -;(or (assq 'mouse-avoidance-mode minor-mode-alist) -; (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid") -; minor-mode-alist))) -;;XEmacs: do it right. -;;;###autoload -(add-minor-mode 'mouse-avoidance-mode 'mouse-avoidance-mode-line-string) - -;;; avoid.el ends here diff --git a/xemacs-packages/lisp/edit-utils/backup-dir.el b/xemacs-packages/lisp/edit-utils/backup-dir.el deleted file mode 100644 index 8f894eb5..00000000 --- a/xemacs-packages/lisp/edit-utils/backup-dir.el +++ /dev/null @@ -1,576 +0,0 @@ -;;; backup-dir.el --- allow backup files to live in some other directory(s). - -;;; Author: Greg Klanderman -;;; Version: 2.9 -;;; Date: January 8, 1999 -;;; Created: Spring 1992 -;;; Keywords: backup file - -;;; Copyright (C) 1992-98 Greg Klanderman -;;; -;;; 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 the -;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;; Boston, MA 02111-1307, USA. -;;; -;;; Send bug reports, feedback, etc. to greg.klanderman@alum.mit.edu, -;;; greg@alphatech.com, or gregk@ai.mit.edu. - -;;; Commentary: -;;; -;;; Allows backup files to be optionally stored in some directories, based on -;;; the value of the alist, `bkup-backup-directory-info'. This variable is a -;;; list of lists of the form (FILE-REGEXP BACKUP-DIR OPTIONS ...). If the -;;; filename to be backed up matches FILE-REGEXP, or FILE-REGEXP is t, then -;;; BACKUP-DIR is used as the path for its backups. Directories may begin -;;; with "/" to specify an absolute pathname. -;;; -;;; If BACKUP-DIR does not exist and OPTIONS contains the symbol `ok-create', -;;; then it is created if possible. Otherwise the usual behavior (backup in -;;; the same directory as the file) results. -;;; -;;; If OPTIONS contains the symbol `full-path', then the full path of the file -;;; being backed up is prepended to the backup file name, with each "/" -;;; replaced by a "!". This is intended for cases where an absolute backup -;;; path is used. If OPTIONS contains `prepend-name' in addition to -;;; `full-path', then the file name is prepended rather than appended to the -;;; path component when forming the backup name. -;;; -;;; If OPTIONS contains the symbol `search-upward' and the backup directory -;;; BACKUP-DIR is a relative path, then a directory with that name is searched -;;; for starting at the current directory and proceeding upward (.., ../.., -;;; etc) until one is found of that name or the root is reached, and if one is -;;; found it is used as the backup directory. -;;; -;;; Finally, if no FILE-REGEXP matches the file name being backed up, then the -;;; usual behavior results. -;;; -;;; These lines from my .emacs load this file and set the values I like: -;;; -;;; (require 'backup-dir) -;;; (setq bkup-backup-directory-info -;;; '(("/home/greg/.*" "/~/.backups/" ok-create full-path prepend-name) -;;; ("^/[^/:]+:" ".backups/") ; handle EFS files specially: don't -;;; ("^/[^/:]+:" "./") ; search-upward... its very slow -;;; (t ".backups/" -;;; full-path prepend-name search-upward))) -;;; -;;; -;;; The package also provides a new function, `find-file-latest-backup' to -;;; find the latest backup file for the current buffer's file. -;;; -;;; This package is based on `files.el' from XEmacs 20.3 and overrides -;;; functions defined there. The overridden functions are clearly -;;; marked below and the originals precede the new definitions in -;;; commented form. -;;; -;;; The package is known to work in the latest XEmacs betas. It has -;;; not been extensively tested on GNU Emacs past 18.58, though I have -;;; reports of it working through 20.2. It does not work under ms-dos. - -;;; Change Log: -;;; -;;; January 8, 1999 Version 2.9 -;;; * Fix bkup-search-upward-for-backup-dir, -;;; bkup-replace-slashes-with-exclamations, and -;;; bkup-backup-directory-and-basename for NT. -;;; -;;; November 13, 1998 Version 2.8 -;;; * Reformat to fit within 80 columns. -;;; * Reformat ChangeLog section. -;;; -;;; June 10, 1998 Version 2.7 -;;; * Add optional N argument to file-newest-backup and -;;; find-file-latest-backup. -;;; -;;; March 23, 1998 Version 2.6 -;;; * Have to quote the eval-after-load form. -;;; -;;; February 22, 1998 Version 2.5 -;;; * Fix infinite loop in bkup-search-upward-for-backup-dir due to a -;;; change in expand-file-name. Fix to not rely on expand-file-name. -;;; -;;; February 22, 1998 Version 2.4 -;;; * Add a new option: prepend-name, suggested by Dave Bakhash. -;;; -;;; February 2, 1998 Version 2.3 -;;; * Nuke byte-compiler-options. -;;; * Use eval-when-compile defvars to avoid compiler warnings. -;;; * Remove unused binding of non-num-bk-name from find-backup-file-name. -;;; -;;; October 27, 1997 Version 2.2 -;;; * Update to adhere to lisp-mnt.el standards. -;;; * Don't require diff; instead use eval-after-load to patch -;;; diff-latest-backup-file (patch from Steve Baur). -;;; -;;; October 27, 1997 Version 2.1 -;;; * Updated to support GNU Emacs 20.2. The function -;;; `backup-extract-version' now uses the free variable -;;; `backup-extract-version-start' rather than `bv-length'. -;;; Note, we continue to support older GNU Emacs and XEmacs -;;; by binding both names. -;;; -;;; October 22, 1997 -;;; * Customization by Karl M. Hegbloom -;;; -;;; December 28, 1996 Version 2.0 -;;; * Updated for XEmacs 19.15b4, much of code reorganized & cleaned up -;;; -;;; December 27, 1996 Version 1.6 -;;; * Explicit loading of dired replaced to use dired-load-hook -;;; (suggested by Thomas Feuster, feuster@tp4.physik.uni-giessen.de) -;;; -;;; December 2, 1996 Version 1.5 -;;; * Took out obsolete byte compiler options -;;; -;;; September 24, 1996 Version 1.4 -;;; * Various bugfixes. -;;; * Change to OPTIONS alist list (ok-create, full-path..) from -;;; separate fields for each option variable. -;;; * Added search-upward option. -;;; * Added new function `find-file-latest-backup' to find a file's -;;; latest backup. -;;; -;;; January 26, 1996 Version 1.3 -;;; * Name change to backup-dir.el -;;; -;;; March 22, 1995 Version 1.2 -;;; * Added new definitions for functions `file-newest-backup', -;;; `latest-backup-file', and `diff-latest-backup-file' so various other -;;; emacs functions will find the right backup files. -;;; -;;; April 23, 1993 Version 1.1 -;;; * Reworked to allow different behavior for different files based on the -;;; alist `bkup-backup-directory-info'. -;;; -;;; Fall 1992 Version 1.0 -;;; * Name change -;;; * Added ability to make directories absolute. -;;; * Added the full path stuff to make backup name unique for -;;; absolute directories. -;;; -;;; Spring 1992 Version 0.0 -;;; * The original. - - -;;; Code: - -(eval-when-compile - ;; avoid compiler warnings: these are dynamically bound by - ;; find-backup-file-name and used by backup extract-versions. - (defvar backup-extract-version-start) ; GNU Emacs 20.2 - (defvar bv-length) ; XEmacs, older GNU Emacs - - ;; this is defined for msdos only - (unless (fboundp 'msdos-long-file-names) - (defun msdos-long-file-names () nil))) - - -;;; New variables affecting backup file behavior -;;; This is the only user-customizable variable for this package. -;;; -(defcustom bkup-backup-directory-info nil - "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...)) -If the filename to be backed up matches FILE-REGEXP, or FILE-REGEXP is t, -then BACKUP-DIR is used as the path for its backups. - -Directories may begin with \"/\" to specify an absolute pathname. - -If BACKUP-DIR does not exist and OPTIONS contains the symbol `ok-create', -then it is created if possible. Otherwise the usual behavior (backup in the -same directory as the file) results. - -If OPTIONS contains the symbol `full-path', then the full path of the file -being backed up is prepended to the backup file name, with each \"/\" -replaced by a \"!\". This is intended for cases where an absolute backup -path is used. If OPTIONS contains `prepend-name' in addition to `full-path', -then the file name is prepended rather than appended to the path component -when forming the backup name. - -If OPTIONS contains the symbol `search-upward' and the backup directory -BACKUP-DIR is a relative path, then a directory with that name is searched -for starting at the current directory and proceeding upward (.., ../.., etc) -until one is found of that name, or the root is reached, and if one is found -it is used as the backup directory. - -Finally, if no FILE-REGEXP matches the file name being backed up, then the -usual behavior results. - -Once you save this variable with `M-x customize-variable', -`backup-dir' will be loaded for you each time you start XEmacs." - :type '(repeat - (list (regexp :tag "File regexp") - (string :tag "Backup Dir") - (set :inline t - (const ok-create) - (const full-path) - (const prepend-name) - (const search-upward)))) - :require 'backup-dir - :group 'backup) - - -;;; New functions -;;; -(defun bkup-search-upward-for-backup-dir (base bd-name) - "Search upward for a directory named BD-NAME, starting in the -directory BASE and continuing with its parent directories until -one is found or the root is reached." - (let ((prev nil) (curr base) (gotit nil) (tryit nil)) - (while (and (not gotit) - (not (equal curr prev)) - (not (equal prev "/"))) - (setq tryit (expand-file-name bd-name curr)) - (if (and (file-directory-p tryit) - (file-exists-p tryit)) - (setq gotit tryit) - (setq prev curr - curr (file-name-directory (directory-file-name curr))))) - (if (and gotit - (eq (aref gotit (1- (length gotit))) ?/)) - (setq gotit (substring gotit 0 (1- (length gotit))))) - gotit)) - -(defun bkup-replace-slashes-with-exclamations (s) - "Replaces slashes in the string S with exclamations. -A new string is produced and returned." - (let ((ns (copy-sequence s)) - (i (1- (length s))) - (mswin (eq system-type 'windows-nt)) - (c nil)) - (while (>= i 0) - (setq c (aref ns i)) - (if (or (= c ?/) - (and mswin - (or (= c ?:) (= c ?\\)))) - (aset ns i ?!)) - (setq i (1- i))) - ns)) - -(defun bkup-try-making-directory (dir) - "Try making directory DIR, return non-nil if successful" - (condition-case () - (progn (make-directory dir t) - t) - (t - nil))) - -(defun bkup-backup-basename (file options) - "Gives the base part of the backup name for FILE, according to OPTIONS." - (if (memq 'full-path options) - (if (memq 'prepend-name options) - (concat (file-name-nondirectory file) - "!!" - (bkup-replace-slashes-with-exclamations - (file-name-directory file))) - (bkup-replace-slashes-with-exclamations file)) - (file-name-nondirectory file))) - -(defun bkup-backup-directory-and-basename (file) - "Return the cons of the backup directory name -and backup file name base for FILE." - (let ((file (expand-file-name file))) - (let ((dir (file-name-directory file)) - (alist bkup-backup-directory-info) - (bk-dir nil) - (bk-base nil)) - (if (listp alist) - (while (and (not bk-dir) alist) - (if (or (eq (car (car alist)) t) - (eq (string-match (car (car alist)) file) 0)) - (let* ((bd (car (cdr (car alist)))) - (bd-rel-p (not (file-name-absolute-p bd))) - (bd-expn (expand-file-name bd dir)) - (bd-noslash (directory-file-name bd-expn)) - (options (cdr (cdr (car alist)))) - (ok-create (and (memq 'ok-create options) t)) - (search-upward (and (memq 'search-upward options) t))) - (if bd-expn - (cond ((or (file-directory-p bd-expn) - (and ok-create - (not (file-exists-p bd-expn)) - (bkup-try-making-directory bd-noslash))) - (setq bk-dir (file-name-as-directory bd-noslash) - bk-base (bkup-backup-basename file - options))) - ((and bd-rel-p search-upward) - (let ((bd-up (bkup-search-upward-for-backup-dir - dir bd))) - (if bd-up - (setq bk-dir (file-name-as-directory bd-up) - bk-base (bkup-backup-basename - file options))))))))) - (setq alist (cdr alist)))) - (if (and bk-dir bk-base) - (cons bk-dir bk-base) - (cons dir (bkup-backup-basename file nil)))))) - - -;;; This next one is based on the following from `files.el' -;;; but accepts a second optional argument - -;;(defun make-backup-file-name (file) -;; "Create the non-numeric backup file name for FILE. -;;This is a separate function so you can redefine it for customization." -;; (if (and (eq system-type 'ms-dos) -;; (not (msdos-long-file-names))) -;; (let ((fn (file-name-nondirectory file))) -;; (concat (file-name-directory file) -;; (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn) -;; (substring fn 0 (match-end 1))) -;; ".bak")) -;; (concat file "~"))) - -(defun bkup-make-backup-file-name (file &optional dir-n-base) - "Create the non-numeric backup file name for FILE. -Optionally accept a list containing the backup directory and -backup basename. NB: we don't really handle ms-dos." - (if (and (eq system-type 'ms-dos) - (not (and (fboundp 'msdos-long-file-names) - (msdos-long-file-names)))) - (let ((fn (file-name-nondirectory file))) - (concat (file-name-directory file) - (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn) - (substring fn 0 (match-end 1))) - ".bak")) - (let ((d-n-b (or dir-n-base - (bkup-backup-directory-and-basename file)))) - (concat (car d-n-b) (cdr d-n-b) "~")))) - -(defun bkup-existing-backup-files (fn) - "Return list of existing backup files for file" - (let* ((efn (expand-file-name fn)) - (dir-n-base (bkup-backup-directory-and-basename efn)) - (non-num-bk-name (bkup-make-backup-file-name efn dir-n-base)) - (non-num-bk (file-exists-p non-num-bk-name)) - (backup-dir (car dir-n-base)) - (base-versions (concat (cdr dir-n-base) ".~")) - (possibilities (file-name-all-completions base-versions backup-dir)) - (poss (mapcar #'(lambda (name) (concat backup-dir name)) - possibilities))) - (mapcar #'expand-file-name - (if non-num-bk (cons non-num-bk-name poss) poss)))) - -(defun find-file-latest-backup (file &optional n) - "Find the latest backup file for FILE, or the Nth most recent -if optional second argument N is specified. Interactively, N -is specified with the prefix argument." - (interactive - (list - (read-file-name - (format "Find %slatest backup of file (default %s): " - (let* ((arg (prefix-numeric-value - current-prefix-arg)) - (mod (% arg 10))) - (if (and (integerp arg) (> arg 1)) - (format "%d%s " - arg - (cond ((= 1 mod) "st") - ((= 2 mod) "nd") - ((= 3 mod) "rd") - (t "th"))) - "")) - (file-name-nondirectory (buffer-file-name))) - nil (buffer-file-name) t) - (prefix-numeric-value current-prefix-arg))) - (let ((backup (file-newest-backup file n))) - (if backup - (find-file backup) - (message "no %s found for `%s'" - (if (> n 1) "such backup" "backups") file)))) - - -;;; Functions changed from `files.el' and elsewhere -- originals -;;; precede new versions - -;;(defun make-backup-file-name (file) -;; "Create the non-numeric backup file name for FILE. -;;This is a separate function so you can redefine it for customization." -;; (if (and (eq system-type 'ms-dos) -;; (not (msdos-long-file-names))) -;; (let ((fn (file-name-nondirectory file))) -;; (concat (file-name-directory file) -;; (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn) -;; (substring fn 0 (match-end 1))) -;; ".bak")) -;; (concat file "~"))) - -(defun make-backup-file-name (file) - "Create the non-numeric backup file name for FILE. -This is a separate function so you can redefine it for customization. -*** Changed by \"backup-dir.el\"" - (bkup-make-backup-file-name file)) - - -;;(defun find-backup-file-name (fn) -;; "Find a file name for a backup file, and suggestions for deletions. -;;Value is a list whose car is the name for the backup file -;; and whose cdr is a list of old versions to consider deleting now. -;;If the value is nil, don't make a backup." -;; (let ((handler (find-file-name-handler fn 'find-backup-file-name))) -;; ;; Run a handler for this function so that ange-ftp can refuse to do it. -;; (if handler -;; (funcall handler 'find-backup-file-name fn) -;; (if (eq version-control 'never) -;; (list (make-backup-file-name fn)) -;; (let* ((base-versions (concat (file-name-nondirectory fn) ".~")) -;; ;; used by backup-extract-version: -;; (bv-length (length base-versions)) -;; possibilities -;; (versions nil) -;; (high-water-mark 0) -;; (deserve-versions-p nil) -;; (number-to-delete 0)) -;; (condition-case () -;; (setq possibilities (file-name-all-completions -;; base-versions -;; (file-name-directory fn)) -;; versions (sort (mapcar -;; #'backup-extract-version -;; possibilities) -;; '<) -;; high-water-mark (apply #'max 0 versions) -;; deserve-versions-p (or version-control -;; (> high-water-mark 0)) -;; number-to-delete (- (length versions) -;; kept-old-versions kept-new-versions -1)) -;; (file-error -;; (setq possibilities nil))) -;; (if (not deserve-versions-p) -;; (list (make-backup-file-name fn)) -;; (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~") -;; (if (and (> number-to-delete 0) -;; ;; Delete nothing if there is overflow -;; ;; in the number of versions to keep. -;; (>= (+ kept-new-versions kept-old-versions -1) 0)) -;; (mapcar #'(lambda (n) -;; (concat fn ".~" (int-to-string n) "~")) -;; (let ((v (nthcdr kept-old-versions versions))) -;; (rplacd (nthcdr (1- number-to-delete) v) ()) -;; v)))))))))) - -(defun find-backup-file-name (fn) - "Find a file name for a backup file, and suggestions for deletions. -Value is a list whose car is the name for the backup file - and whose cdr is a list of old versions to consider deleting now. -If the value is nil, don't make a backup. -*** Changed by \"backup-dir.el\"" - (let ((handler (find-file-name-handler fn 'find-backup-file-name))) - ;; Run a handler for this function so that ange-ftp can refuse to do it. - (if handler - (funcall handler 'find-backup-file-name fn) - (if (eq version-control 'never) - (list (make-backup-file-name fn)) - (let* ((dir-n-base (bkup-backup-directory-and-basename fn)) ;add - (bk-dir (car dir-n-base)) ;add - (bk-base (cdr dir-n-base)) ;add - (base-versions (concat bk-base ".~")) ;mod - ;; used by backup-extract-version: - (bv-length (length base-versions)) ;; older GNU and XEmacs - (backup-extract-version-start - (length base-versions)) ;; new GNU Emacs (20.2) - possibilities - (versions nil) - (high-water-mark 0) - (deserve-versions-p nil) - (number-to-delete 0)) - (condition-case () - (setq possibilities (file-name-all-completions - base-versions - bk-dir) ;mod - versions (sort (mapcar - #'backup-extract-version - possibilities) - '<) - high-water-mark (apply #'max 0 versions) - deserve-versions-p (or version-control - (> high-water-mark 0)) - number-to-delete (- (length versions) - kept-old-versions - kept-new-versions -1)) - (file-error - (setq possibilities nil))) - (if (not deserve-versions-p) - (list (bkup-make-backup-file-name fn dir-n-base)) ;mod - (cons (concat bk-dir base-versions - (int-to-string (1+ high-water-mark)) "~") ;mod - (if (and (> number-to-delete 0) - ;; Delete nothing if there is overflow - ;; in the number of versions to keep. - (>= (+ kept-new-versions kept-old-versions -1) 0)) - (mapcar #'(lambda (n) - (concat bk-dir base-versions - (int-to-string n) "~")) ;mod - (let ((v (nthcdr kept-old-versions versions))) - (rplacd (nthcdr (1- number-to-delete) v) ()) - v)))))))))) - - -;;(defun file-newest-backup (filename) -;; "Return most recent backup file for FILENAME or nil if no backups exist." -;; (let* ((filename (expand-file-name filename)) -;; (file (file-name-nondirectory filename)) -;; (dir (file-name-directory filename)) -;; (comp (file-name-all-completions file dir)) -;; newest tem) -;; (while comp -;; (setq tem (car comp) -;; comp (cdr comp)) -;; (cond ((and (backup-file-name-p tem) -;; (string= (file-name-sans-versions tem) file)) -;; (setq tem (concat dir tem)) -;; (if (or (null newest) -;; (file-newer-than-file-p tem newest)) -;; (setq newest tem))))) -;; newest)) - -(defun file-newest-backup (filename &optional n) - "Return most recent backup file for FILENAME or nil if no backups exist. -Optional second argument N specifies the Nth newest backup, rather than the -most recent. -*** Changed by \"backup-dir.el\"" - (nth (if (integerp n) (max 0 (1- n)) 0) - (sort (bkup-existing-backup-files filename) - 'file-newer-than-file-p))) - - -;;; patch `latest-backup-file' from "dired" -;;; -;;; we use `dired-load-hook' to avoid loading dired now. This speeds things -;;; up considerably according to Thomas Feuster, -;;; feuster@tp4.physik.uni-giessen.de -;;; -;;; one really wonders why there are 3 functions to do the same thing... -;;; -(defun bkup-patch-latest-backup-file () - (fset 'latest-backup-file (symbol-function 'file-newest-backup)) - (remove-hook 'dired-load-hook 'bkup-patch-latest-backup-file)) - -(if (featurep 'dired) - ;; if loaded, patch it now - (fset 'latest-backup-file (symbol-function 'file-newest-backup)) - ;; otherwise do it later - (add-hook 'dired-load-hook 'bkup-patch-latest-backup-file)) - - -;;; patch `diff-latest-backup-file' from "diff" -;;; -(eval-after-load "diff" - '(fset 'diff-latest-backup-file - (symbol-function 'file-newest-backup))) - - -;;; finally, add to list of features -;;; -(provide 'backup-dir) - -;;; backup-dir.el ends here diff --git a/xemacs-packages/lisp/edit-utils/balloon-help.el b/xemacs-packages/lisp/edit-utils/balloon-help.el deleted file mode 100644 index 1fa53b49..00000000 --- a/xemacs-packages/lisp/edit-utils/balloon-help.el +++ /dev/null @@ -1,602 +0,0 @@ -;;; Balloon help for XEmacs (requires 19.15 or later) -;;; Copyright (C) 1995, 1997 Kyle E. Jones -;;; -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 1, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; 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 - -;; Balloon help pops up a small frame to display help text -;; relating to objects that the mouse cursor passes over. -;; -;; Installation: -;; -;; Byte-compile the file balloon-help.el (with M-x byte-compile-file) -;; and put the .elc file in a directory in your load-path. Add the -;; following line to your .emacs: -;; -;; (require 'balloon-help) -;; (balloon-help-mode 1) -;; -;; The balloon-help frame is a transient window that is not -;; normally decorated by window managers, so the following -;; window manager directives may not be needed. But if they -;; are: -;; -;; For ol[v]wm use this in .Xdefaults: -;; olvwm.NoDecor: balloon-help -;; or -;; olwm.MinimalDecor: balloon-help -;; -;; For fvvm version 1 use this in your .fvwmrc: -;; NoTitle balloon-help -;; or -;; Style "balloon-help" NoTitle, NoHandles, BorderWidth 0 -;; -;; For twm use this in your .twmrc: -;; NoTitle { "balloon-help" } -;; - -(provide 'balloon-help) - -(require 'custom) - -(defgroup balloon-help nil - "Balloon-help support in XEmacs" - :group 'frames) - -(defvar balloon-help-version "1.08" - "Version string for Balloon Help.") - -;;;###autoload -(defcustom balloon-help-mode nil - "*Non-nil means Balloon help mode is enabled." - :type 'boolean - :set (lambda (symbol value) (balloon-help-mode (or value 0))) - :initialize 'custom-initialize-default - :require 'balloon-help - :group 'balloon-help) - -(defvar balloon-help-minor-mode nil - "*Non-nil means Balloon help minor mode is enabled.") -(make-variable-buffer-local 'balloon-help-minor-mode) - -(defcustom balloon-help-timeout 1500 - "*Display help after this many milliseconds of mouse inactivity." - :type 'integer - :group 'balloon-help) - -(defcustom balloon-help-foreground "black" - "*The foreground color for displaying balloon help text." - :type 'string - :group 'balloon-help) - -(defcustom balloon-help-background "gray80" - "*The background color for the balloon help frame." - :type 'string - :group 'balloon-help) - -(defcustom balloon-help-background-pixmap "" - "*The background pixmap for the balloon help frame." - :type 'string - :group 'balloon-help) - -(defcustom balloon-help-font "variable" - "*The font for displaying balloon help text." - :type 'string - :group 'balloon-help) - -(defcustom balloon-help-border-color "black" - "*The color for displaying balloon help frame's border." - :type 'string - :group 'balloon-help) - -(defcustom balloon-help-border-width 1 - "*The width of the balloon help frame's border." - :type 'integer - :group 'balloon-help) - -(defcustom balloon-help-use-sound nil - "*Non-nil value means play a sound to herald the appearance -and disappearance of the help frame. - -`balloon-help-appears' will be played when the frame appears. -`balloon-help-disappears' will be played when the frame disappears. - -See the documentation for the function load-sound-file to see how -define sounds." - :type 'boolean - :group 'balloon-help) - -(defcustom balloon-help-frame-name "balloon-help" - "*The frame name to use for the frame to display the balloon help." - :type 'string - :group 'balloon-help) - -(defcustom balloon-help-aggressively-follow-mouse nil - "*Non-nil means the balloon should move with the mouse even if the mouse -is over the same object as the last mouse motion event." - :type 'boolean - :group 'balloon-help) - -(defcustom balloon-help-mode-line-string " Bal" - "*String to display in the modeline when `balloon-help-minor-mode' is active. -Set this to nil if you don't want a modeline indicator." - :type '(choice string - (const :tag "none" nil)) - :group 'balloon-help) - -;;; -;;; End of user variables. -;;; - -(defvar mouse-motion-hook mouse-motion-handler - "Hooks to be run whenever the user moves the mouse. -Each hook is called with one argument, the mouse motion event. -This hooks variable does not exist unless the \"balloon-help\" library -has been loaded.") - -(defun mouse-motion-hook (event) - "Run the hooks attached to mouse-motion-hook." - (run-hook-with-args 'mouse-motion-hook event)) - -(setq mouse-motion-handler 'mouse-motion-hook) - -(defvar balloon-help-frame nil - "Balloon help is displayed in this frame.") - -(defvar balloon-help-junk-frame nil - "Junk parent frame of balloon-help-frame.") - -(defvar balloon-help-help-object nil - "Object that the mouse is over that has a help property, nil otherwise.") - -(defvar balloon-help-help-object-x nil - "Last horizontal mouse position over balloon-help-help-object.") - -(defvar balloon-help-help-object-y nil - "Last vertical mouse position over balloon-help-help-object.") - -(defvar balloon-help-buffer (get-buffer-create " *balloon-help*") - "Buffer used to display balloon help.") - -(defvar balloon-help-timeout-id nil - "Timeout id for the balloon help timeout.") - -(defvar balloon-help-menubar-possible (featurep 'menubar)) -(defvar balloon-help-toolbar-possible (featurep 'toolbar)) -(defvar balloon-help-scrollbar-possible (featurep 'scrollbar)) -(defvar balloon-help-gutter-possible (featurep 'gutter)) - -(defvar balloon-help-display-pending nil - "Non-nil value means the help frame will be visible as soon -as the X server gets around to displaying it. Nil means it -will be invisible as soon as the X server decides to hide it.") - -;;;###autoload -(defun balloon-help-mode (&optional arg) - "Toggle Balloon Help mode. -With arg, turn Balloon Help mode on iff arg is positive. - -With Balloon Help enabled, a small frame is displayed whenever -the mouse rests on an object that has a help property of some -kind. The text of that help property is displayed in the frame. - -If you want Balloon Help mode enabled in some buffers only, use -`balloon-help-minor-mode' instead. - -For extents, the 'balloon-help' property is checked. - -For toolbar buttons, the help-string slot of the toolbar button -is checked. - -If the value is a string, it is used as the help message. - -If the property's value is a symbol, it is assumed to be the name -of a function and it will be called with one argument, the object -under the mouse, and the return value of that function will be -used as the help message." - (interactive "P") - (setq balloon-help-mode (or (and arg (> (prefix-numeric-value arg) 0)) - (and (null arg) (null balloon-help-mode)))) - (if (null balloon-help-mode) - (balloon-help-undisplay-help))) - -;;;###autoload -(defun balloon-help-minor-mode (&optional arg) - "Toggle Balloon Help minor mode. -With arg, turn Balloon Help minor mode on iff arg is positive. - -This minor mode is useful if you want `balloon-help-mode' globally disabled, -except in some buffers. - -Please refer to the function `balloon-help-mode' for more details" - (interactive "P") - (setq balloon-help-minor-mode - (or (and arg (> (prefix-numeric-value arg) 0)) - (and (null arg) (null balloon-help-minor-mode)))) - (if (and (null balloon-help-minor-mode) (null balloon-help-mode)) - (balloon-help-undisplay-help))) -(add-minor-mode 'balloon-help-minor-mode 'balloon-help-mode-line-string) - -(defun balloon-help-displayed () - (and (frame-live-p balloon-help-frame) - (frame-visible-p balloon-help-frame) - (eq (frame-device balloon-help-frame) (selected-device)))) - -(defun balloon-help (&optional event) - "Display Balloon Help for the object under EVENT. -If EVENT is nil, then point in the selected window is used instead. -See the documentation for balloon-help-mode to find out what this means. -This command must be bound to a mouse event." - (interactive "e") - (unless (device-on-window-system-p) - (error "Cannot display balloon help on %s device" (device-type))) - (let ((balloon-help-mode t)) - (balloon-help-motion-hook event)) - (when balloon-help-timeout-id - (disable-timeout balloon-help-timeout-id) - (setq balloon-help-timeout-id nil)) - (balloon-help-display-help)) - -(defun balloon-help-motion-hook (event) - (cond - ((and (null balloon-help-mode) (null balloon-help-minor-mode)) t) - (t - (let* ((buffer (if event (event-buffer event) (current-buffer))) - (frame (if event (event-frame event) (selected-frame))) - (point (if event (event-point event) (point))) - (modeline-point (if event (event-modeline-position event))) - (modeline-extent (and modeline-point - (map-extents - (function (lambda (e ignored) e)) - (symbol-value-in-buffer - 'generated-modeline-string - buffer) - modeline-point modeline-point - nil nil - 'balloon-help))) - (glyph-extent (and event (event-glyph-extent event))) - (glyph-extent (if (and glyph-extent - (extent-property glyph-extent - 'balloon-help)) - glyph-extent)) - (extent (and point - (extent-at point buffer 'balloon-help))) - (button (and event (event-toolbar-button event))) - (button (if (and button (toolbar-button-help-string button)) - button - nil)) - (object (or modeline-extent glyph-extent extent button)) - (id balloon-help-timeout-id)) - (if (null object) - (if (and balloon-help-frame - (not (eq frame balloon-help-frame))) - (progn - (setq balloon-help-help-object nil) - (when id - (disable-timeout id) - (setq balloon-help-timeout-id nil)) - (if (balloon-help-displayed) - (balloon-help-undisplay-help)))) - (let* ((params (frame-parameters frame)) - (top (cdr (assq 'top params))) - (left (cdr (assq 'left params))) - (xtop-toolbar-height - (if (and balloon-help-toolbar-possible - (specifier-instance top-toolbar-visible-p frame) - (specifier-instance top-toolbar frame)) - (+ (specifier-instance top-toolbar-height frame) - (if (and (boundp 'top-toolbar-border-width) - (specifierp top-toolbar-border-width)) - (specifier-instance top-toolbar-border-width frame) - 0)) - 0)) - (xleft-toolbar-width - (if (and balloon-help-toolbar-possible - (specifier-instance left-toolbar-visible-p frame) - (specifier-instance left-toolbar frame)) - (+ (specifier-instance left-toolbar-width frame) - (if (and (boundp 'left-toolbar-border-width) - (specifierp left-toolbar-border-width)) - (specifier-instance left-toolbar-border-width frame) - 0)) - 0)) - (menubar-height - (if (and balloon-help-menubar-possible buffer - (specifier-instance menubar-visible-p frame) - (save-excursion (set-buffer buffer) current-menubar)) - 22 - 0))) - (setq balloon-help-help-object-x - (if event - (+ left xleft-toolbar-width - (event-x-pixel event)) - (/ (* (device-pixel-width) 2) 5)) - balloon-help-help-object-y - (if event - (+ top xtop-toolbar-height menubar-height - (event-y-pixel event)) - (/ (* (device-pixel-height) 2) 5)))) - (cond ((eq frame balloon-help-frame) t) - ((eq object balloon-help-help-object) - (if (and (balloon-help-displayed) - balloon-help-aggressively-follow-mouse) - (balloon-help-move-help-frame))) - ((balloon-help-displayed) - (setq balloon-help-help-object object) - (balloon-help-display-help)) - (t - (setq balloon-help-help-object object) - (if id - (disable-timeout id)) - (setq balloon-help-timeout-id - (add-timeout (/ balloon-help-timeout 1000.0) - (function balloon-help-display-help) - nil))))))))) - -(defun balloon-help-display-help (&rest ignored) - (setq balloon-help-timeout-id nil) - (if (and balloon-help-help-object (device-on-window-system-p)) - (let* ((object balloon-help-help-object) - (help (or (and (extent-live-p object) - (extent-property object 'balloon-help)) - (and (toolbar-button-p object) - (toolbar-button-help-string object)) - (and (stringp object) object)))) - ;; if help is non-null and is not a string, run it as - ;; function to produuce the help string. - (if (or (null help) (not (symbolp help))) - nil - (condition-case data - (setq help (funcall help object)) - (error - (setq help (format "help function signaled: %S" data))))) - (if (stringp help) - (save-excursion - (if (or (not (frame-live-p balloon-help-frame)) - (not (eq (selected-device) - (frame-device balloon-help-frame)))) - (setq balloon-help-frame (balloon-help-make-help-frame))) - (set-buffer balloon-help-buffer) - (erase-buffer) - (insert help) - (if (not (bolp)) - (insert ?\n)) -;;; ;; help strings longer than 2 lines have the last -;;; ;; line stolen by the minibuffer, so make sure the -;;; ;; last line is blank. Make the top line blank for -;;; ;; some symmetry. -;;; (if (< 2 (count-lines (point-min) (point-max))) -;;; (progn -;;; (insert ?\n) -;;; ;; add a second blank line at the end to -;;; ;; prevent the modeline bar from clipping the -;;; ;; descenders of the last line of text. -;;; (insert ?\n) -;;; (goto-char (point-min)) -;;; (insert ?\n))) - ;; indent everything by a space for readability - (indent-rigidly (point-min) (point-max) 1) - (balloon-help-set-frame-properties) - (balloon-help-resize-help-frame) - (balloon-help-move-help-frame) - (balloon-help-expose-help-frame)))))) - -(defun balloon-help-undisplay-help () - (balloon-help-hide-help-frame)) - -(defun balloon-help-hide-help-frame () - (if (balloon-help-displayed) - (progn - (make-frame-invisible balloon-help-frame) - (if (and balloon-help-use-sound balloon-help-display-pending) - (play-sound 'balloon-help-disappears)) - (setq balloon-help-display-pending nil)))) - -(defun balloon-help-expose-help-frame () - (if (not (balloon-help-displayed)) - (progn - (make-frame-visible balloon-help-frame) - (if (and balloon-help-use-sound (null balloon-help-display-pending)) - (play-sound 'balloon-help-appears)) - (setq balloon-help-display-pending t)))) - -(defun balloon-help-set-frame-properties () - (let ((frame balloon-help-frame)) - ;; don't set the font unconditionally because it makes the - ;; frame size flap visibly while XEmacs figures out the new - ;; frame size. - (if (not (equal (face-font 'default frame) balloon-help-font)) - (set-face-font 'default balloon-help-font frame)) - (set-face-foreground 'default balloon-help-foreground frame) - (set-face-background 'default balloon-help-background frame) - (set-face-background 'modeline balloon-help-background frame) - (set-face-background-pixmap 'default balloon-help-background-pixmap frame) - (set-frame-property frame 'border-color balloon-help-border-color) - (set-frame-property frame 'border-width balloon-help-border-width))) - -;;;(defun balloon-help-resize-help-frame () -;;; (save-excursion -;;; (set-buffer balloon-help-buffer) -;;; (let ((longest 0) -;;; (lines 0) -;;; (done nil) -;;; (window-min-height 1) -;;; (window-min-width 1)) -;;; (goto-char (point-min)) -;;; (while (not done) -;;; (end-of-line) -;;; (setq longest (max longest (current-column)) -;;; done (not (= 0 (forward-line)))) -;;; (and (not done) (setq lines (1+ lines)))) -;;; (set-frame-size balloon-help-frame (+ 1 longest) lines)))) - -(defun balloon-help-resize-help-frame () - (save-excursion - (set-buffer balloon-help-buffer) - (let* ((longest 0) - (lines 0) - (done nil) - (inst (vector 'string ':data nil)) - (window (frame-selected-window balloon-help-frame)) - (font-width (font-width (face-font 'default) balloon-help-frame)) - start width - (window-min-height 1) - (window-min-width 1)) - (goto-char (point-min)) - (while (not done) - (setq start (point)) - (end-of-line) - (aset inst 2 (buffer-substring start (point))) - (setq longest (max longest (glyph-width (make-glyph inst) window)) - done (not (= 0 (forward-line)))) - (and (not done) (setq lines (1+ lines)))) - (setq width (/ longest font-width) - width (if (> longest (* width font-width)) (1+ width) width)) - (set-frame-size balloon-help-frame (+ 0 width) lines)))) - -(defun balloon-help-compute-help-frame-y-location () - (let* ((device-bottom (device-pixel-height - (frame-device balloon-help-frame))) - (y-pos (max 0 (+ 48 balloon-help-help-object-y))) - (height (frame-pixel-height balloon-help-frame)) - (bottom (+ y-pos height))) - (if (>= bottom device-bottom) - (setq y-pos (max 0 (- y-pos (- bottom device-bottom))))) - y-pos )) - -(defun balloon-help-compute-help-frame-x-location () - (let* ((device-right (device-pixel-width (frame-device balloon-help-frame))) - (x-pos (max 0 (+ 32 balloon-help-help-object-x))) - (width (frame-pixel-width balloon-help-frame)) - (right (+ x-pos width))) - (if (>= right device-right) - (setq x-pos (max 0 (- x-pos (- right device-right))))) - x-pos )) - -(defun balloon-help-move-help-frame () - (let ((x (balloon-help-compute-help-frame-x-location)) - (y (balloon-help-compute-help-frame-y-location))) - (set-frame-position balloon-help-frame x y))) - -(defun balloon-help-make-junk-frame () - (let ((window-min-height 1) - (window-min-width 1)) - (when (framep balloon-help-junk-frame) - (delete-frame balloon-help-junk-frame) - (setq balloon-help-junk-frame nil)) - (prog1 - (setq balloon-help-junk-frame - (make-frame '(minibuffer t - initially-unmapped t - override-redirect t ; get rid of WM decorations - width 1 - height 1))) - (set-window-buffer (frame-selected-window balloon-help-junk-frame) - balloon-help-buffer)))) - -(defun balloon-help-make-help-frame () - (when (framep balloon-help-frame) - (delete-frame balloon-help-frame) - (setq balloon-help-frame nil)) - (save-excursion - (set-buffer balloon-help-buffer) - (setq truncate-lines t) - (when balloon-help-menubar-possible - (set-buffer-menubar nil)) - (let* ((x (balloon-help-compute-help-frame-x-location)) - (y (balloon-help-compute-help-frame-y-location)) - (window-min-height 1) - (window-min-width 1) - (junk-frame (balloon-help-make-junk-frame)) - (frame (make-frame `(initially-unmapped t - internal-border-width 0 - ;; try to suppress frame decorations - override-redirect t - name ,balloon-help-frame-name - border-width ,balloon-help-border-width - border-color ,balloon-help-border-color - top ,y - left ,x - popup ,junk-frame - minibuffer ,(minibuffer-window junk-frame) - width 3 - height 1)))) - (set-face-font 'default balloon-help-font frame) - (set-face-foreground 'default balloon-help-foreground frame) - (set-face-background 'default balloon-help-background frame) - (set-face-background-pixmap 'default balloon-help-background-pixmap - frame) - (set-window-buffer (frame-selected-window frame) balloon-help-buffer) - (when balloon-help-toolbar-possible - (set-specifier top-toolbar-height (cons frame 0)) - (set-specifier left-toolbar-width (cons frame 0)) - (set-specifier right-toolbar-width (cons frame 0)) - (set-specifier bottom-toolbar-height (cons frame 0)) - (set-specifier top-toolbar-visible-p (cons frame nil)) - (set-specifier left-toolbar-visible-p (cons frame nil)) - (set-specifier right-toolbar-visible-p (cons frame nil)) - (set-specifier bottom-toolbar-visible-p (cons frame nil)) - (set-specifier top-toolbar (cons frame nil)) - (set-specifier left-toolbar (cons frame nil)) - (set-specifier right-toolbar (cons frame nil)) - (set-specifier bottom-toolbar (cons frame nil))) - (when balloon-help-gutter-possible - (set-specifier top-gutter-height (cons frame 0)) - (set-specifier left-gutter-width (cons frame 0)) - (set-specifier right-gutter-width (cons frame 0)) - (set-specifier bottom-gutter-height (cons frame 0)) - (set-specifier top-gutter-visible-p (cons frame nil)) - (set-specifier left-gutter-visible-p (cons frame nil)) - (set-specifier right-gutter-visible-p (cons frame nil)) - (set-specifier bottom-gutter-visible-p (cons frame nil)) - (set-specifier top-gutter (cons frame nil)) - (set-specifier left-gutter (cons frame nil)) - (set-specifier right-gutter (cons frame nil)) - (set-specifier bottom-gutter (cons frame nil))) - (when balloon-help-scrollbar-possible - (set-specifier scrollbar-width (cons frame 0)) - (set-specifier scrollbar-height (cons frame 0))) - (set-specifier text-cursor-visible-p (cons frame nil)) - (set-specifier has-modeline-p (cons frame nil)) - (set-specifier modeline-shadow-thickness (cons frame 0)) - (set-specifier (glyph-image truncation-glyph) [nothing] frame '(x)) - (set-face-background 'modeline balloon-help-background frame) - frame ))) - -(defun balloon-help-pre-command-hook () - (unless (eq this-command 'balloon-help) - (balloon-help-go-away))) - -(defun balloon-help-go-away (&rest ignored) - (setq balloon-help-help-object nil) - (if (balloon-help-displayed) - (balloon-help-undisplay-help))) - -(defun balloon-help-mouse-leave-frame-hook (&rest ignored) - (let* ((mouse (mouse-position)) - (window (car mouse))) - (if (or (null window) (not (eq (window-frame window) balloon-help-frame))) - (balloon-help-go-away)))) - -;; loses with ClickToFocus under fvwm -;;(fset 'balloon-help-deselect-frame-hook 'balloon-help-go-away) -;;(add-hook 'deselect-frame-hook 'balloon-help-deselect-frame-hook) - -(add-hook 'mouse-motion-hook 'balloon-help-motion-hook) - -(add-hook 'pre-command-hook 'balloon-help-pre-command-hook) -(add-hook 'mouse-leave-frame-hook 'balloon-help-mouse-leave-frame-hook) diff --git a/xemacs-packages/lisp/edit-utils/big-menubar.el b/xemacs-packages/lisp/edit-utils/big-menubar.el deleted file mode 100644 index 0f7eeba1..00000000 --- a/xemacs-packages/lisp/edit-utils/big-menubar.el +++ /dev/null @@ -1,215 +0,0 @@ -;; big-menubar.el --- an alternate menubar - -;; Copyright (C) 1994,2002 Free Software Foundation, Inc. - -;; Author: Dror Caspi -;; Modified by: jwz and allender and haydens@ll.mit.edu -;; Rewritten by: mrb in the differential programming style -;; Rewritten by: Steve Youngs to cater for XEmacsen -;; from 21.1 to 21.5 on 2002-04-28 -;; Keywords: mouse menubar - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not in FSF. - -;;; Code: - -;; Extra menu items for XEmacsen <= 21.1 -(if (and (<= emacs-major-version 21) - (<= emacs-minor-version 1)) - (let* ((current-menubar (default-value 'current-menubar)) - (edit-menu (car (find-menu-item current-menubar '("Edit"))))) - ;; Remove some menu items that this file obsoletes. - (delete-menu-item '("Edit" "Start Macro Recording")) - (delete-menu-item '("Edit" "End Macro Recording")) - (delete-menu-item '("Edit" "Execute Last Macro")) - (delete-menu-item '("Edit" "Search...")) - (delete-menu-item '("Edit" "Search Backward...")) - (delete-menu-item '("Edit" "Search (Regexp)...")) - (delete-menu-item '("Edit" "Search Backward (Regexp)...")) - (nconc - edit-menu - '(("Macro" - ["Start Macro Recording" start-kbd-macro (not defining-kbd-macro)] - ["End Macro Recording" end-kbd-macro defining-kbd-macro] - ["Name Last Macro..." name-last-kbd-macro last-kbd-macro] - ["Insert Macro in Buffer..." insert-kbd-macro t] - ["Execute Last Macro" call-last-kbd-macro last-kbd-macro]) - "---" - ("Register" - ["Copy to Register..." copy-to-register (mark)] - ["Paste Register..." insert-register t] - "---" - ["Save Point to Register" point-to-register t] - ["Jump to Register" register-to-point t]) - ("Rectangles" - ["Kill Rectangle" kill-rectangle t] - ["Yank Rectangle" yank-rectangle t] - ["Rectangle to Register" copy-rectangle-to-register t] - ["Rectangle from Register" insert-register t] - ["Clear Rectangle" clear-rectangle t] - ["Open Rectangle" open-rectangle t] - ["Rectangle Mousing" - (setq mouse-track-rectangle-p (not mouse-track-rectangle-p)) - :style toggle :selected mouse-track-rectangle-p]) - "---" - ("Sort" - ["Lines" sort-lines (mark)] - ["Paragraphs" sort-paragraphs (mark)] - ["Pages" sort-pages (mark)] - ["Columns" sort-columns (mark)] - ["Regexp..." sort-regexp-fields (mark)]) - ("Center" - ["Line" center-line t] - ["Paragraph" center-paragraph t] - ["Region" center-region (mark)]) - ("Indent" - ["As Previous Line" indent-relative t] - ["To Column..." indent-to-column t] - "---" - ["Region" indent-region (mark)] - ["Balanced Expression" indent-sexp t] - ["C Expression" indent-c-exp t]) - "---" - ("Narrow" - ["To Region" narrow-to-region (mark)] - ["To Page" narrow-to-page t] - "---" - ["Cancel" widen - (not (and (= (point-min) 1) (= (point-max) (1+ (buffer-size)))))]))) - ;; Replace Compile button with Compile menu - (add-submenu - '("Tools") - '("Compile" - ["Compile..." compile t] - ["Kill Compilation" kill-compilation t] - "---" - ["Next Error" next-error t] - ["Previous Error" previous-error t] - ["Goto Error" compile-goto-error t]) - "Compile...") - (delete-menu-item '("Tools" "Compile...")) - ;; Replace Spell-Check button with Spell Check menu - (add-submenu - '("Apps") - '("Spell Check" - ["Word" ispell-word t] - ["Complete Word" ispell-complete-word t] - ["Region" ispell-region t] - ["Whole Buffer" ispell-buffer t]) - "Spell-Check Buffer") - (delete-menu-item '("Apps" "Spell-Check Buffer")))) - -;; Extra menu items independent of XEmacs version. -;; -;; Search and Replace -(add-submenu - '("Edit") - '("Search" - ["Forward..." isearch-forward t] - ["Backward..." isearch-backward t] - "---" - ["Regexp Forward..." isearch-forward-regexp t] - ["Regexp Backward..." isearch-backward-regexp t] - "---" - ["Words Forward..." word-search-forward t] - ["Words Backward..." word-search-backward t])) -(add-submenu - '("Edit") - '("Replace" - ["Query..." query-replace t] - ["Regexp Query..." query-replace-regexp t] - "---" - ["All..." replace-string t] - ["Regexp All..." replace-regexp t])) - ;; Marking commands. -(add-submenu - '("Edit") - '("Mark" - ["Here" set-mark-command t] - ["Word" mark-word t] - ["Sentence" mark-end-of-sentence t] - ["Paragraph" mark-paragraph t] - ["Page" mark-page t] - ["Balanced Expression" mark-sexp t] - ["Lisp Function" mark-defun t] - ["C Function" mark-c-function t] - ["Whole Buffer" mark-whole-buffer t])) - ;; Transpose. -(add-submenu - '("Edit") - '("Transpose" - ["Characters" transpose-chars t] - ["Words" transpose-words t] - ["Lines" transpose-lines t] - ["Sentences" transpose-sentences t] - ["Paragraphs" transpose-paragraphs t] - ["Balanced Expressions" transpose-sexps t])) -;; Remove Replace menu -(delete-menu-item '("Edit" "Replace...")) -(delete-menu-item '("Edit" "Replace (Regexp)...")) -;; Add Hex Edit button -(nconc - (car (find-menu-item current-menubar '("Tools"))) - '("---" - ["Hex Edit File..." hexl-find-file t])) -;; Motion menu. -(add-submenu - nil - '("Motion" - ["Goto Mark" exchange-point-and-mark (mark t)] - ["Goto Line..." goto-line t] - "---" - ["End of Balanced Parentheses ( )" forward-list t] - ["Beginning of Balanced Parentheses ( )" backward-list t] - ["Next Opening Parenthesis (" down-list t] - ["Previous Opening Parenthesis (" backward-up-list t] - ["Next Closing Parenthesis )" up-list t] - "---" - ["End of Balanced Expression" forward-sexp t] - ["Beginning of Balanced Expression" backward-sexp t] - "---" - ["End of Function" end-of-defun t] - ["Beginning of Function" beginning-of-defun t] - "---" - ["Next Page" forward-page t] - ["Previous Page" backward-page t] - "---" - ["End of Buffer" end-of-buffer t] - ["Beginning of Buffer" beginning-of-buffer t] - "---" - ["Save Current Position..." point-to-register t] - ["Goto Saved Position..." register-to-point t] - "---" - ["Set Marker..." set-user-marker t] - ["Goto Marker..." goto-user-marker t] - ["List Markers" list-markers t] - "---" - ["Set Goal Column" set-goal-column t] - ["Cancel Goal Column" (set-goal-column t) goal-column])) - -;; Add scrollbar-like buttons to the menubar -(add-menu-button nil ["Top" beginning-of-buffer t]) -(add-menu-button nil ["<<" scroll-down t]) -(add-menu-button nil [" | " recenter t]) -(add-menu-button nil [">>" scroll-up t]) -(add-menu-button nil ["Bot" end-of-buffer t]) - - -(provide 'big-menubar) diff --git a/xemacs-packages/lisp/edit-utils/blink-cursor.el b/xemacs-packages/lisp/edit-utils/blink-cursor.el deleted file mode 100644 index b3bfd2c2..00000000 --- a/xemacs-packages/lisp/edit-utils/blink-cursor.el +++ /dev/null @@ -1,139 +0,0 @@ -;;; blink-cursor.el --- Blink the cursor on or off - -;; Copyright (C) 1996 Ben Wing. - -;; Keywords: display - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not in FSF. - -;;; Commentary: - -;;; Code: - -(defvar blink-cursor-last-selected-window nil) -(defvar blink-cursor-lost-focus nil) - -(defun blink-cursor-callback (foo) - (let ((inhibit-quit t) - (window (selected-window))) - ;; Blinking cursor just doesn't cut it on TTY-s. Rather give it up. - (if (or (eq (console-type) 'tty) - blink-cursor-lost-focus) - nil - (or blink-cursor-last-selected-window - (setq blink-cursor-last-selected-window window)) - (if (eq window blink-cursor-last-selected-window) - - (if (specifier-instance text-cursor-visible-p window) - (if (let ((current-time (current-time))) - (or (not last-input-time) - (> (car current-time) (car last-input-time)) - (> (cadr current-time) (cdr last-input-time)))) - ;; turn cursor off only if more than a second since - ;; last input - (set-specifier text-cursor-visible-p nil window)) - (set-specifier text-cursor-visible-p t window)) - - (remove-specifier text-cursor-visible-p - blink-cursor-last-selected-window) - (setq blink-cursor-last-selected-window window) - (set-specifier text-cursor-visible-p nil window))))) - -; Turn on cursor after every command -(defun blink-cursor-post-command-hook () - (let ((inhibit-quit t) - (window (selected-window))) - (if blink-cursor-lost-focus - nil - (set-specifier text-cursor-visible-p t window)))) - -(defun blink-cursor-reenable-cursor () - (if blink-cursor-last-selected-window - (progn - (remove-specifier text-cursor-visible-p - blink-cursor-last-selected-window) - (setq blink-cursor-last-selected-window nil)))) - -(defun blink-cursor-deselect-frame-hook () - (blink-cursor-reenable-cursor) - (setq blink-cursor-lost-focus t)) - -(defun blink-cursor-select-frame-hook () - (setq blink-cursor-lost-focus nil)) - -(add-hook 'deselect-frame-hook 'blink-cursor-deselect-frame-hook) -(add-hook 'select-frame-hook 'blink-cursor-select-frame-hook) -(add-hook 'post-command-hook 'blink-cursor-post-command-hook) - -(defvar blink-cursor-timeout 1.0) -(defvar blink-cursor-timeout-id nil) - -;; so that the options menu can save it - dverna apr. 98 -(defgroup blink-cursor nil - "Blinking cursor mode") - -;;;###autoload -(defcustom blink-cursor-mode nil - "Non nil means `blink-cursor-mode' is on. Normally, you shouldn't modify -this variable by hand, but use the function `blink-cursor-mode' -instead. However, the default value can be customized from the options menu." - :type 'boolean - :set (lambda (var val) - (blink-cursor-mode (or val 0))) - :initialize 'custom-initialize-default - :require 'blink-cursor - :group 'blink-cursor) - -;;;###autoload -(defun blink-cursor-mode (&optional timeout) - "Enable or disable a blinking cursor. -If TIMEOUT is nil, toggle on or off. -If TIMEOUT is t, enable with the previous timeout value. -If TIMEOUT is 0, disable. -If TIMEOUT is greater than 0, then the cursor will blink once -each TIMEOUT secs (can be a float)." - (interactive) - (cond ((not timeout) - (setq timeout blink-cursor-timeout) - (setq blink-cursor-mode (not blink-cursor-mode))) - ((eq timeout t) - (setq timeout blink-cursor-timeout) - (setq blink-cursor-mode t)) - ((<= timeout 0) - (setq blink-cursor-mode nil)) - (t - (setq blink-cursor-timeout timeout) - (setq blink-cursor-mode t))) - (if blink-cursor-timeout-id - (progn - (disable-timeout blink-cursor-timeout-id) - (blink-cursor-reenable-cursor) - (setq blink-cursor-timeout-id nil))) - (if blink-cursor-mode - (setq blink-cursor-timeout-id - (add-timeout (/ (float timeout) 2) 'blink-cursor-callback nil - (/ (float timeout) 2)))) - ; initialize last-input-time - (if (not last-input-time) - (setq last-input-time (cons 0 0)))) - -(provide 'blink-cursor) - -;;; blink-cursor.el ends here diff --git a/xemacs-packages/lisp/edit-utils/blink-paren.el b/xemacs-packages/lisp/edit-utils/blink-paren.el deleted file mode 100644 index d9cf5639..00000000 --- a/xemacs-packages/lisp/edit-utils/blink-paren.el +++ /dev/null @@ -1,181 +0,0 @@ -;;; blink-paren.el --- blink the matching paren, just like Zmacs -;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - -;; Author: devin@lucid.com. -;; Keywords: faces - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not in FSF. - -(defvar blink-paren-timeout 0.2 - "*If the cursor is on a parenthesis, the matching parenthesis will blink. -This variable controls how long each phase of the blink lasts in seconds. -This should be a fractional part of a second (a float.)") - -(defvar highlight-paren-expression nil - "*If true, highlight the whole expression of the paren under the cursor -instead of blinking (or highlighting) the matching paren. This will highlight -the expression using the `highlight-expression' face.") - -;;; The blinking paren alternates between the faces blink-paren-on and -;;; blink-paren-off. The default is for -on to look just like default -;;; text, and -off to be invisible. You can change this so that, for -;;; example, the blinking paren fluctuates between bold and italic... -;;; -;;; You can make the matching paren merely be highlighted (and not blink) -;;; by setting the blink-paren-on and blink-paren-off faces to have the same -;;; attributes; if you do this, then emacs will not consume as much CPU. -;;; -;;; If highlight-paren-expression is true, then the whole sexp between the -;;; parens will be displayed in the `highlight-expression' face instead. - -(make-face 'blink-paren-on) -(make-face 'blink-paren-off) -(make-face 'highlight-expression) - -;; extent used to change the face of the matching paren -(defvar blink-paren-extent nil) - -;; timeout to blink the face -(defvar blink-paren-timeout-id nil) - -;; find if we should look forward or backward to find the matching paren -(defun blink-paren-sexp-dir () - (cond ((and (< (point) (point-max)) - (eq (char-syntax (char-after (point))) ?\()) - 1) - ((and (> (point) (point-min)) - (eq (char-syntax (char-after (- (point) 1))) ?\))) - -1) - (t ()))) - -;; make an extent on the matching paren if any. return it. -(defun blink-paren-make-extent () - (let ((dir (blink-paren-sexp-dir))) - (and dir - (condition-case () - (let* ((parse-sexp-ignore-comments t) - (other-pos (let ((pmin (point-min)) - (pmax (point-max)) - (point (point))) - (unwind-protect - (progn - (narrow-to-region - (max pmin (- point blink-matching-paren-distance)) - (min pmax (+ point blink-matching-paren-distance))) - (forward-sexp dir) (point)) - (narrow-to-region pmin pmax) - (goto-char point)))) - (extent (if (= dir 1) - (make-extent (if highlight-paren-expression - (point) - (- other-pos 1)) - other-pos) - (make-extent other-pos - (if highlight-paren-expression - (point) - (+ other-pos 1)))))) - (set-extent-face extent (if highlight-paren-expression - 'highlight-expression - 'blink-paren-on)) - extent) - (error nil))))) - -;; callback for the timeout -;; swap the face of the extent on the matching paren -(defun blink-paren-timeout (arg) - ;; The extent could have been deleted for some reason and not point to a - ;; buffer anymore. So catch any error to remove the timeout. - (condition-case () - (set-extent-face blink-paren-extent - (if (eq (extent-face blink-paren-extent) - 'blink-paren-on) - 'blink-paren-off - 'blink-paren-on)) - (error (blink-paren-pre-command)))) - -;; called after each command is executed in the post-command-hook -;; add the extent and the time-out if we are on a paren. -(defun blink-paren-post-command () - (blink-paren-pre-command) - (if (and (setq blink-paren-extent (blink-paren-make-extent)) - (not highlight-paren-expression) - (not (and (face-equal 'blink-paren-on 'blink-paren-off) - (progn - (set-extent-face blink-paren-extent 'blink-paren-on) - t))) - (or (floatp blink-paren-timeout) - (integerp blink-paren-timeout))) - (setq blink-paren-timeout-id - (add-timeout blink-paren-timeout 'blink-paren-timeout () - blink-paren-timeout)))) - -;; called before a new command is executed in the pre-command-hook -;; cleanup by removing the extent and the time-out -(defun blink-paren-pre-command () - (condition-case c ; don't ever signal an error in pre-command-hook! - (let ((inhibit-quit t)) - (if blink-paren-timeout-id - (disable-timeout (prog1 blink-paren-timeout-id - (setq blink-paren-timeout-id nil)))) - (if blink-paren-extent - (delete-extent (prog1 blink-paren-extent - (setq blink-paren-extent nil))))) - (error - (message "blink paren error! %s" c)))) - - -(defun blink-paren (&optional arg) - "Toggles paren blinking on and off. -With a positive argument, turns it on. -With a non-positive argument, turns it off." - (interactive "P") - (let* ((was-on (not (not (memq 'blink-paren-pre-command pre-command-hook)))) - (on-p (if (null arg) - (not was-on) - (> (prefix-numeric-value arg) 0)))) - (cond (on-p - - ;; in case blink paren was dumped, this needs to be setup - (or (face-differs-from-default-p 'blink-paren-off) - (progn - (set-face-background 'blink-paren-off (face-background 'default)) - (set-face-foreground 'blink-paren-off (face-background 'default)))) - - (or (face-differs-from-default-p 'highlight-expression) - (set-face-underline-p 'highlight-expression t)) - - (add-hook 'pre-command-hook 'blink-paren-pre-command) - (add-hook 'post-command-hook 'blink-paren-post-command) - (setq blink-matching-paren nil)) - (t - (remove-hook 'pre-command-hook 'blink-paren-pre-command) - (remove-hook 'post-command-hook 'blink-paren-post-command) - (and blink-paren-extent (detach-extent blink-paren-extent)) - (setq blink-matching-paren t))) - on-p)) - -(defun blink-paren-init () - "obsolete - use `blink-paren' instead." - (interactive) - (blink-paren 1)) - -(provide 'blink-paren) - -(blink-paren 1) diff --git a/xemacs-packages/lisp/edit-utils/bookmark.el b/xemacs-packages/lisp/edit-utils/bookmark.el deleted file mode 100644 index 49e2971b..00000000 --- a/xemacs-packages/lisp/edit-utils/bookmark.el +++ /dev/null @@ -1,2305 +0,0 @@ -;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later. - -;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation - -;; Author: Karl Fogel -;; Maintainer: Karl Fogel -;; Created: July, 1993 -;; Author's Update Number: see variable `bookmark-version'. -;; Keywords: bookmarks, placeholders, annotations - -;; 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: - -;; This package is for setting "bookmarks" in files. A bookmark -;; associates a string with a location in a certain file. Thus, you -;; can navigate your way to that location by providing the string. -;; See the "User Variables" section for customizations. - -;; Thanks to David Bremner for thinking of and -;; then implementing the bookmark-current-bookmark idea. He even -;; sent *patches*, bless his soul... - -;; Thanks to Gregory M. Saunders for -;; fixing and improving bookmark-time-to-save-p. - -;; Thanks go to Andrew V. Klein for the code that -;; sorts the alist before presenting it to the user (in bookmark-bmenu-list -;; and the menu-bar). - -;; And much thanks to David Hughes for many small -;; suggestions and the code to implement them (like -;; bookmark-bmenu-check-position, and some of the Lucid compatibility -;; stuff). - -;; Kudos (whatever they are) go to Jim Blandy -;; for his eminently sensible suggestion to separate bookmark-jump -;; into bookmark-jump and bookmark-jump-noselect, which made many -;; other things cleaner as well. - -;; Thanks to Roland McGrath for encouragement and help with defining -;; autoloads on the menu-bar. - -;; Jonathan Stigelman gave patches for default -;; values in bookmark-jump and bookmark-set. Everybody please keep -;; all the keystrokes they save thereby and send them to him at the -;; end of each year :-) (No, seriously, thanks Jonathan!) - -;; Buckets of gratitude to John Grabowski for -;; thinking up the annotations feature and implementing it so well. - -;; Based on info-bookmark.el, by Karl Fogel and Ken Olstad -;; . - -;; Thanks to Mikio Nakajima for many bugs -;; reported and fixed. - -;; Thank you, Michael Kifer, for contributing the XEmacs support. - -;; Enough with the credits already, get on to the good stuff: - -;; FAVORITE CHINESE RESTAURANT: -;; Boy, that's a tough one. Probably Hong Min, or maybe Emperor's -;; Choice (both in Chicago's Chinatown). Well, both. How about you? - -;;;; Code: - -(require 'pp) - -(defconst bookmark-version "2.6.4" - "Version number of bookmark.el. This is not related to the version -of Emacs bookmark comes with; it is used solely by bookmark's -maintainers to avoid version confusion.") - -;;; Misc comments: -;; -;; If variable bookmark-use-annotations is non-nil, an annotation is -;; queried for when setting a bookmark. -;; -;; The bookmark list is sorted lexically by default, but you can turn -;; this off by setting bookmark-sort-flag to nil. If it is nil, then -;; the list will be presented in the order it is recorded -;; (chronologically), which is actually fairly useful as well. - -;;; User Variables - -(defgroup bookmarks nil - "Set bookmarks, maybe annotate them, jump to them later." - :prefix "bookmark-" - :group 'editing) - - -(defcustom bookmark-use-annotations nil - "*If non-nil, saving a bookmark will query for an annotation in a -buffer." - :type 'boolean - :group 'bookmarks) - - -(defcustom bookmark-save-flag t - "*Controls when Emacs saves bookmarks to a file. ---> Nil means never save bookmarks, except when `bookmark-save' is - explicitly called \(\\[bookmark-save]\). ---> t means save bookmarks when Emacs is killed. ---> Otherwise, it should be a number that is the frequency with which - the bookmark list is saved \(i.e.: the number of times which - Emacs' bookmark list may be modified before it is automatically - saved.\). If it is a number, Emacs will also automatically save - bookmarks when it is killed. - -Therefore, the way to get it to save every time you make or delete a -bookmark is to set this variable to 1 \(or 0, which produces the same -behavior.\) - -To specify the file in which to save them, modify the variable -bookmark-default-file, which is `~/.emacs.bmk' by default." - :type '(choice (const :tag "Never" nil) - (const :tag "On Exit" t) - (number :tag "Frequency" 1)) - :group 'bookmarks) - - -(defconst bookmark-old-default-file "~/.emacs-bkmrks" - "*The .emacs.bmk file used to be called this.") - - -;; defvarred to avoid a compilation warning: -(defvar bookmark-file nil - "Old name for `bookmark-default-file'.") - -(defvar bookmark-default-file - (if bookmark-file - ;; In case user set `bookmark-file' in her .emacs: - bookmark-file - (convert-standard-filename "~/.emacs.bmk")) - "*File in which to save bookmarks by default.") - - -(defcustom bookmark-version-control 'nospecial - "*Whether or not to make numbered backups of the bookmark file. -It can have four values: t, nil, `never', and `nospecial'. -The first three have the same meaning that they do for the -variable `version-control', and the final value `nospecial' means just -use the value of `version-control'." - :type '(choice (const t) (const nil) (const never) (const nospecial)) - :group 'bookmarks) - - -(defcustom bookmark-completion-ignore-case t - "*Non-nil means bookmark functions ignore case in completion." - :type 'boolean - :group 'bookmarks) - - -(defcustom bookmark-sort-flag t - "*Non-nil means that bookmarks will be displayed sorted by bookmark -name. Otherwise they will be displayed in LIFO order (that is, most -recently set ones come first, oldest ones come last)." - :type 'boolean - :group 'bookmarks) - - -(defcustom bookmark-automatically-show-annotations t - "*Nil means don't show annotations when jumping to a bookmark." - :type 'boolean - :group 'bookmarks) - - -(defcustom bookmark-bmenu-file-column 30 - "*Column at which to display filenames in a buffer listing bookmarks. -You can toggle whether files are shown with \\\\[bookmark-bmenu-toggle-filenames]." - :type 'integer - :group 'bookmarks) - - -(defcustom bookmark-bmenu-toggle-filenames t - "*Non-nil means show filenames when listing bookmarks. -This may result in truncated bookmark names. To disable this, put the -following in your .emacs: - -\(setq bookmark-bmenu-toggle-filenames nil\)" - :type 'boolean - :group 'bookmarks) - - -(defcustom bookmark-menu-length 70 - "*Maximum length of a bookmark name displayed on a popup menu." - :type 'integer - :group 'bookmarks) - - -;;; No user-serviceable parts beyond this point. - -;; Is it XEmacs? -(defconst bookmark-xemacsp - (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)) - - -;; Added for lucid emacs compatibility, db -(or (fboundp 'defalias) (fset 'defalias 'fset)) - -;; suggested for lucid compatibility by david hughes: -(or (fboundp 'frame-height) (defalias 'frame-height 'screen-height)) - -;; This variable is probably obsolete now... -;; It is. -sb -;(or (boundp 'baud-rate) -; ;; some random value higher than 9600 -; (setq baud-rate 19200)) - -;; XEmacs apparently call this `buffer-substring-without-properties', -;; sigh. -(or (fboundp 'buffer-substring-no-properties) - (if (fboundp 'buffer-substring-without-properties) - (fset 'buffer-substring-no-properties - 'buffer-substring-without-properties) - (fset 'buffer-substring-no-properties 'buffer-substring))) - - -;;; Keymap stuff: -;; some people have C-x r set to rmail or whatever. We don't want to -;; assume that C-x r is a prefix map just because it's distributed -;; that way... -;; These are the distribution keybindings suggested by RMS, everything -;; else will be done with M-x or the menubar: -;;;###autoload -(if (symbolp (key-binding "\C-xr")) - nil - (progn (define-key ctl-x-map "rb" 'bookmark-jump) - (define-key ctl-x-map "rm" 'bookmark-set) - (define-key ctl-x-map "rl" 'bookmark-bmenu-list))) - -;; define the map, so it can be bound by those who desire to do so: - -;;;###autoload -(defvar bookmark-map nil - "Keymap containing bindings to bookmark functions. -It is not bound to any key by default: to bind it -so that you have a bookmark prefix, just use `global-set-key' and bind a -key of your choice to `bookmark-map'. All interactive bookmark -functions have a binding in this keymap.") - -;;;###autoload -(define-prefix-command 'bookmark-map) - -;; Read the help on all of these functions for details... -;;;###autoload -(define-key bookmark-map "x" 'bookmark-set) -;;;###autoload -(define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark" -;;;###autoload -(define-key bookmark-map "j" 'bookmark-jump) -;;;###autoload -(define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go" -;;;###autoload -(define-key bookmark-map "i" 'bookmark-insert) -;;;###autoload -(define-key bookmark-map "e" 'edit-bookmarks) -;;;###autoload -(define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find" -;;;###autoload -(define-key bookmark-map "r" 'bookmark-rename) -;;;###autoload -(define-key bookmark-map "d" 'bookmark-delete) -;;;###autoload -(define-key bookmark-map "l" 'bookmark-load) -;;;###autoload -(define-key bookmark-map "w" 'bookmark-write) -;;;###autoload -(define-key bookmark-map "s" 'bookmark-save) - - -;;; The annotation maps. -(defvar bookmark-read-annotation-mode-map (copy-keymap text-mode-map) - "Keymap for composing an annotation for a bookmark.") - -(define-key bookmark-read-annotation-mode-map "\C-c\C-c" - 'bookmark-send-annotation) - - - -;;; Core variables and data structures: -(defvar bookmark-alist () - "Association list of bookmarks and their records. -You probably don't want to change the value of this alist yourself; -instead, let the various bookmark functions do it for you. - -The format of the alist is - - \(BOOKMARK1 BOOKMARK2 ...\) - -where each BOOKMARK is of the form - -\(NAME - \(filename . FILE\) - \(front-context-string . FRONT-STR\) - \(rear-context-string . REAR-STR\) - \(position . POS\) - \(info-node . POS\) - \(annotation . ANNOTATION\)\) - -So the cdr of each bookmark is an alist too. -`info-node' is optional, by the way.") - - -(defvar bookmarks-already-loaded nil) - - -;; just add the hook to make sure that people don't lose bookmarks -;; when they kill Emacs, unless they don't want to save them. -;;;###autoload -(add-hook 'kill-emacs-hook - (function - (lambda () (and (featurep 'bookmark) - bookmark-alist - (bookmark-time-to-save-p t) - (bookmark-save))))) - -;; more stuff added by db. - -(defvar bookmark-current-bookmark nil - "Name of bookmark most recently used in the current file. -It is buffer local, used to make moving a bookmark forward -through a file easier.") - -(make-variable-buffer-local 'bookmark-current-bookmark) - - -(defvar bookmark-alist-modification-count 0 - "Number of modifications to bookmark list since it was last saved.") - - -(defvar bookmark-search-size 16 - "Length of the context strings recorded on either side of a bookmark.") - - -(defvar bookmark-current-point 0) -(defvar bookmark-yank-point 0) -(defvar bookmark-current-buffer nil) - - - -;; Helper functions. - -;; Only functions on this page and the next one (file formats) need to -;; know anything about the format of bookmark-alist entries. -;; Everyone else should go through them. - -(defun bookmark-name-from-full-record (full-record) - "Return name of FULL-RECORD \(an alist element instead of a string\)." - (car full-record)) - -;;;###autoload -(defun bookmark-all-names () - "Return a list of all current bookmark names." - (bookmark-maybe-load-default-file) - (mapcar - (lambda (full-record) - (bookmark-name-from-full-record full-record)) - bookmark-alist)) - - -(defun bookmark-get-bookmark (bookmark) - "Return the full entry for BOOKMARK in bookmark-alist." - (assoc bookmark bookmark-alist)) - - -(defun bookmark-get-bookmark-record (bookmark) - "Return the guts of the entry for BOOKMARK in bookmark-alist. -That is, all information but the name." - (car (cdr (bookmark-get-bookmark bookmark)))) - - -(defun bookmark-set-name (bookmark newname) - "Set BOOKMARK's name to NEWNAME." - (setcar (bookmark-get-bookmark bookmark) newname)) - - -(defun bookmark-get-annotation (bookmark) - "Return the annotation of BOOKMARK, or nil if none." - (cdr (assq 'annotation (bookmark-get-bookmark-record bookmark)))) - - -(defun bookmark-set-annotation (bookmark ann) - "Set the annotation of BOOKMARK to ANN." - (let ((cell (assq 'annotation (bookmark-get-bookmark-record bookmark)))) - (if cell - (setcdr cell ann) - (nconc (bookmark-get-bookmark-record bookmark) - (list (cons 'annotation ann)))))) - - -(defun bookmark-get-filename (bookmark) - "Return the full filename of BOOKMARK." - (cdr (assq 'filename (bookmark-get-bookmark-record bookmark)))) - - -(defun bookmark-set-filename (bookmark filename) - "Set the full filename of BOOKMARK to FILENAME." - (let ((cell (assq 'filename (bookmark-get-bookmark-record bookmark)))) - (if cell - (setcdr cell filename) - (nconc (bookmark-get-bookmark-record bookmark) - (list (cons 'filename filename)))))) - - -(defun bookmark-get-position (bookmark) - "Return the position \(i.e.: point\) of BOOKMARK." - (cdr (assq 'position (bookmark-get-bookmark-record bookmark)))) - - -(defun bookmark-set-position (bookmark position) - "Set the position \(i.e.: point\) of BOOKMARK to POSITION." - (let ((cell (assq 'position (bookmark-get-bookmark-record bookmark)))) - (if cell - (setcdr cell position) - (nconc (bookmark-get-bookmark-record bookmark) - (list (cons 'position position)))))) - - -(defun bookmark-get-front-context-string (bookmark) - "Return the front-context-string of BOOKMARK." - (cdr (assq 'front-context-string (bookmark-get-bookmark-record bookmark)))) - - -(defun bookmark-set-front-context-string (bookmark string) - "Set the front-context-string of BOOKMARK to STRING." - (let ((cell (assq 'front-context-string - (bookmark-get-bookmark-record bookmark)))) - (if cell - (setcdr cell string) - (nconc (bookmark-get-bookmark-record bookmark) - (list (cons 'front-context-string string)))))) - - -(defun bookmark-get-rear-context-string (bookmark) - "Return the rear-context-string of BOOKMARK." - (cdr (assq 'rear-context-string (bookmark-get-bookmark-record bookmark)))) - - -(defun bookmark-set-rear-context-string (bookmark string) - "Set the rear-context-string of BOOKMARK to STRING." - (let ((cell (assq 'rear-context-string - (bookmark-get-bookmark-record bookmark)))) - (if cell - (setcdr cell string) - (nconc (bookmark-get-bookmark-record bookmark) - (list (cons 'rear-context-string string)))))) - - -(defun bookmark-get-info-node (bookmark) - "Get the info node associated with BOOKMARK." - (cdr (assq 'info-node (bookmark-get-bookmark-record bookmark)))) - - -(defun bookmark-set-info-node (bookmark node) - "Set the Info node of BOOKMARK to NODE." - (let ((cell (assq 'info-node - (bookmark-get-bookmark-record bookmark)))) - (if cell - (setcdr cell node) - (nconc (bookmark-get-bookmark-record bookmark) - (list (cons 'info-node node))))) - - (message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark))) - (sit-for 4) - ) - - -(defvar bookmark-history nil - "The history list for bookmark functions.") - - -(defun bookmark-completing-read (prompt &optional default) - "Prompting with PROMPT, read a bookmark name in completion. -PROMPT will get a \": \" stuck on the end no matter what, so you -probably don't want to include one yourself. -Optional second arg DEFAULT is a string to return if the user enters -the empty string." - (bookmark-maybe-load-default-file) ; paranoia - (let* ((completion-ignore-case bookmark-completion-ignore-case) - (default default) - (prompt (if default - (concat prompt (format " (%s): " default)) - (concat prompt ": "))) - (str - (condition-case nil - ;; XEmacs 21.2 adds the default argument. - (completing-read prompt - bookmark-alist - nil - 0 - nil - 'bookmark-history - default) - (wrong-number-of-arguments - (completing-read prompt - bookmark-alist - nil - 0 - nil - 'bookmark-history))))) - ;; Take care of the lack of the default argument in XEmacs 21.1. - (if (string-equal "" str) - (list default) - (list str)))) - - -(defmacro bookmark-maybe-historicize-string (string) - "Put STRING into the bookmark prompt history, if caller non-interactive. -We need this because sometimes bookmark functions are invoked from -menus, so `completing-read' never gets a chance to set `bookmark-history'." - (` (or - (interactive-p) - (setq bookmark-history (cons (, string) bookmark-history))))) - - -(defun bookmark-make (name &optional annotation overwrite info-node) - "Make a bookmark named NAME. -Optional second arg ANNOTATION gives it an annotation. -Optional third arg OVERWRITE means replace any existing bookmarks with -this name. -Optional fourth arg INFO-NODE means this bookmark is at info node -INFO-NODE, so record this fact in the bookmark's entry." - (bookmark-maybe-load-default-file) - (let ((stripped-name (copy-sequence name))) - (or bookmark-xemacsp - ;; XEmacs's `set-text-properties' doesn't work on - ;; free-standing strings, apparently. - (set-text-properties 0 (length stripped-name) nil stripped-name)) - (if (and (bookmark-get-bookmark stripped-name) (not overwrite)) - ;; already existing bookmark under that name and - ;; no prefix arg means just overwrite old bookmark - (setcdr (bookmark-get-bookmark stripped-name) - (list (bookmark-make-cell annotation info-node))) - - ;; otherwise just cons it onto the front (either the bookmark - ;; doesn't exist already, or there is no prefix arg. In either - ;; case, we want the new bookmark consed onto the alist...) - - (setq bookmark-alist - (cons - (list stripped-name - (bookmark-make-cell annotation info-node)) - bookmark-alist))) - - ;; Added by db - (setq bookmark-current-bookmark stripped-name) - (setq bookmark-alist-modification-count - (1+ bookmark-alist-modification-count)) - (if (bookmark-time-to-save-p) - (bookmark-save)))) - - -(defun bookmark-make-cell (annotation &optional info-node) - "Return the record part of a new bookmark, given ANNOTATION. -Must be at the correct position in the buffer in which the bookmark is -being set. This might change someday. -Optional second arg INFO-NODE means this bookmark is at info node -INFO-NODE, so record this fact in the bookmark's entry." - (let ((the-record - (` ((filename . (, (bookmark-buffer-file-name))) - (front-context-string - . (, (if (>= (- (point-max) (point)) bookmark-search-size) - (buffer-substring-no-properties - (point) - (+ (point) bookmark-search-size)) - nil))) - (rear-context-string - . (, (if (>= (- (point) (point-min)) bookmark-search-size) - (buffer-substring-no-properties - (point) - (- (point) bookmark-search-size)) - nil))) - (position . (, (point))) - )))) - - ;; Now fill in the optional parts: - (if annotation - (nconc the-record (list (cons 'annotation annotation)))) - (if info-node - (nconc the-record (list (cons 'info-node info-node)))) - - ;; Finally, return the completed record. - the-record)) - - - -;;; File format stuff - -;; The OLD format of the bookmark-alist was: -;; -;; ((bookmark-name (filename -;; string-in-front -;; string-behind -;; point)) -;; ...) -;; -;; The NEW format of the bookmark-alist is: -;; -;; ((bookmark-name ((filename . FILENAME) -;; (front-context-string . string-in-front) -;; (rear-context-string . string-behind) -;; (position . POINT) -;; (annotation . annotation) -;; (whatever . VALUE) -;; ... -;; )) -;; ...) -;; -;; -;; I switched to using an internal as well as external alist because I -;; felt that would be a more flexible framework in which to add -;; features. It means that the order in which values appear doesn't -;; matter, and it means that arbitrary values can be added without -;; risk of interfering with existing ones. -;; -;; BOOKMARK-NAME is the string the user gives the bookmark and -;; accesses it by from then on. -;; -;; FILENAME is the location of the file in which the bookmark is set. -;; -;; STRING-IN-FRONT is a string of `bookmark-search-size' chars of -;; context in front of the point at which the bookmark is set. -;; -;; STRING-BEHIND is the same thing, but after the point. -;; -;; The context strings exist so that modifications to a file don't -;; necessarily cause a bookmark's position to be invalidated. -;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in -;; case the file has changed since the bookmark was set. It will -;; attempt to place the user before the changes, if there were any. -;; ANNOTATION is the annotation for the bookmark; it may not exist -;; (for backward compatibility), be nil (no annotation), or be a -;; string. - - -(defconst bookmark-file-format-version 1 - "The current version of the format used by bookmark files. -You should never need to change this.") - - -(defconst bookmark-end-of-version-stamp-marker - "-*- End Of Bookmark File Format Version Stamp -*-\n" - "This string marks the end of the version stamp in a bookmark file.") - - -(defun bookmark-alist-from-buffer () - "Return a bookmark-alist (in any format) from the current buffer. -The buffer must of course contain bookmark format information. -Does not care from where in the buffer it is called, and does not -affect point." - (save-excursion - (goto-char (point-min)) - (if (search-forward bookmark-end-of-version-stamp-marker nil t) - (read (current-buffer)) - ;; Else we're dealing with format version 0 - (if (search-forward "(" nil t) - (progn - (forward-char -1) - (read (current-buffer))) - ;; Else no hope of getting information here. - (error "Not bookmark format"))))) - - -(defun bookmark-upgrade-version-0-alist (old-list) - "Upgrade a version 0 alist OLD-LIST to the current version." - (mapcar - (lambda (bookmark) - (let* ((name (car bookmark)) - (record (car (cdr bookmark))) - (filename (nth 0 record)) - (front-str (nth 1 record)) - (rear-str (nth 2 record)) - (position (nth 3 record)) - (ann (nth 4 record))) - (list - name - (` ((filename . (, filename)) - (front-context-string . (, (or front-str ""))) - (rear-context-string . (, (or rear-str ""))) - (position . (, position)) - (annotation . (, ann))))))) - old-list)) - - -(defun bookmark-upgrade-file-format-from-0 () - "Upgrade a bookmark file of format 0 (the original format) to format 1. -This expects to be called from point-min in a bookmark file." - (message "Upgrading bookmark format from 0 to %d..." - bookmark-file-format-version) - (let* ((old-list (bookmark-alist-from-buffer)) - (new-list (bookmark-upgrade-version-0-alist old-list))) - (delete-region (point-min) (point-max)) - (bookmark-insert-file-format-version-stamp) - (pp new-list (current-buffer)) - (save-buffer)) - (goto-char (point-min)) - (message "Upgrading bookmark format from 0 to %d...done" - bookmark-file-format-version) - ) - - -(defun bookmark-grok-file-format-version () - "Return an integer which is the file-format version of this bookmark file. -This expects to be called from point-min in a bookmark file." - (if (looking-at "^;;;;") - (save-excursion - (save-match-data - (re-search-forward "[0-9]") - (forward-char -1) - (read (current-buffer)))) - ;; Else this is format version 0, the original one, which didn't - ;; even have version stamps. - 0)) - - -(defun bookmark-maybe-upgrade-file-format () - "Check the file-format version of this bookmark file. -If the version is not up-to-date, upgrade it automatically. -This expects to be called from point-min in a bookmark file." - (let ((version (bookmark-grok-file-format-version))) - (cond - ((= version bookmark-file-format-version) - ) ; home free -- version is current - ((= version 0) - (bookmark-upgrade-file-format-from-0)) - (t - (error "Bookmark file format version strangeness"))))) - - -(defun bookmark-insert-file-format-version-stamp () - "Insert text indicating current version of bookmark file format." - (insert - (format ";;;; Emacs Bookmark Format Version %d ;;;;\n" - bookmark-file-format-version)) - (insert ";;; This format is meant to be slightly human-readable;\n" - ";;; nevertheless, you probably don't want to edit it.\n" - ";;; " - bookmark-end-of-version-stamp-marker)) - - -;;; end file-format stuff - - -;;; Core code: - -;;;###autoload -(defun bookmark-set (&optional name parg) - "Set a bookmark named NAME inside a file. -If name is nil, then the user will be prompted. -With prefix arg, will not overwrite a bookmark that has the same name -as NAME if such a bookmark already exists, but instead will \"push\" -the new bookmark onto the bookmark alist. Thus the most recently set -bookmark with name NAME would be the one in effect at any given time, -but the others are still there, should you decide to delete the most -recent one. - -To yank words from the text of the buffer and use them as part of the -bookmark name, type C-w while setting a bookmark. Successive C-w's -yank successive words. - -Typing C-u inserts the name of the last bookmark used in the buffer -\(as an aid in using a single bookmark name to track your progress -through a large file\). If no bookmark was used, then C-u inserts the -name of the file being visited. - -Use \\[bookmark-delete] to remove bookmarks \(you give it a name, -and it removes only the first instance of a bookmark with that name from -the list of bookmarks.\)" - (interactive (list nil current-prefix-arg)) - (or - (bookmark-buffer-file-name) - (error "Buffer not visiting a file or directory")) - - (bookmark-maybe-load-default-file) - - (setq bookmark-current-point (point)) - (setq bookmark-yank-point (point)) - (setq bookmark-current-buffer (current-buffer)) - - (let* ((default (or bookmark-current-bookmark - (bookmark-buffer-name))) - (str - (or name - (read-from-minibuffer - (format "Set bookmark (%s): " default) - nil - (let ((now-map (copy-keymap minibuffer-local-map))) - (progn (define-key now-map "\C-w" - 'bookmark-yank-word) - (define-key now-map "\C-u" - 'bookmark-insert-current-bookmark)) - now-map)))) - (annotation nil)) - (and (string-equal str "") (setq str default)) - ;; Ask for an annotation buffer for this bookmark - (if bookmark-use-annotations - (bookmark-read-annotation parg str) - (progn - (bookmark-make str annotation parg (bookmark-info-current-node)) - (setq bookmark-current-bookmark str) - (bookmark-bmenu-surreptitiously-rebuild-list) - (goto-char bookmark-current-point))))) - - -(defun bookmark-info-current-node () - "If in Info-mode, return current node name (a string), else nil." - (if (eq major-mode 'Info-mode) - Info-current-node)) - - -(defun bookmark-kill-line (&optional newline-too) - "Kill from point to end of line. -If optional arg NEWLINE-TOO is non-nil, delete the newline too. -Does not affect the kill-ring." - (let ((eol (save-excursion (end-of-line) (point)))) - (delete-region (point) eol) - (if (and newline-too (looking-at "\n")) - (delete-char 1)))) - - -;; Defvars to avoid compilation warnings: -(defvar bookmark-annotation-paragraph nil) -(defvar bookmark-annotation-name nil) -(defvar bookmark-annotation-buffer nil) -(defvar bookmark-annotation-file nil) -(defvar bookmark-annotation-point nil) - - -(defun bookmark-send-annotation () - "Use buffer contents as the annotation for a bookmark. -Exclude lines that begin with `#'. -Store the annotation text in the bookmark list with -the bookmark (and file, and point) specified in buffer local variables." - (interactive) - (if (not (eq major-mode 'bookmark-read-annotation-mode)) - (error "Not in bookmark-read-annotation-mode")) - (goto-char (point-min)) - (while (< (point) (point-max)) - (if (looking-at "^#") - (bookmark-kill-line t) - (forward-line 1))) - (let ((annotation (buffer-substring (point-min) (point-max))) - (parg bookmark-annotation-paragraph) - (bookmark bookmark-annotation-name) - (pt bookmark-annotation-point) - (buf bookmark-annotation-buffer)) - ;; for bookmark-make-cell to work, we need to be - ;; in the relevant buffer, at the relevant point. - ;; Actually, bookmark-make-cell should probably be re-written, - ;; to avoid this need. Should I handle the error if a buffer is - ;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer? - (save-excursion - (pop-to-buffer buf) - (goto-char pt) - (bookmark-make bookmark annotation parg (bookmark-info-current-node)) - (setq bookmark-current-bookmark bookmark)) - (bookmark-bmenu-surreptitiously-rebuild-list) - (goto-char bookmark-current-point)) - (kill-buffer (current-buffer))) - - -(defun bookmark-default-annotation-text (bookmark) - (concat "# Type the annotation for bookmark '" bookmark "' here.\n" - "# All lines which start with a '#' will be deleted.\n" - "# Type C-c C-c when done.\n#\n" - "# Author: " (user-full-name) " <" (user-login-name) "@" - (system-name) ">\n" - "# Date: " (current-time-string) "\n")) - - -(defvar bookmark-read-annotation-text-func 'bookmark-default-annotation-text - "Function to return default text to use for a bookmark annotation. -It takes the name of the bookmark, as a string, as an arg.") - -(defun bookmark-read-annotation-mode (buf point parg bookmark) - "Mode for composing annotations for a bookmark. -Wants BUF POINT PARG and BOOKMARK. -When you have finished composing, type \\[bookmark-send-annotation] to send -the annotation. - -\\{bookmark-read-annotation-mode-map} -" - (interactive) - (kill-all-local-variables) - (make-local-variable 'bookmark-annotation-paragraph) - (make-local-variable 'bookmark-annotation-name) - (make-local-variable 'bookmark-annotation-buffer) - (make-local-variable 'bookmark-annotation-file) - (make-local-variable 'bookmark-annotation-point) - (setq bookmark-annotation-paragraph parg) - (setq bookmark-annotation-name bookmark) - (setq bookmark-annotation-buffer buf) - (setq bookmark-annotation-file (buffer-file-name buf)) - (setq bookmark-annotation-point point) - (use-local-map bookmark-read-annotation-mode-map) - (setq major-mode 'bookmark-read-annotation-mode) - (insert (funcall bookmark-read-annotation-text-func bookmark)) - (run-hooks 'text-mode-hook)) - - -(defun bookmark-read-annotation (parg bookmark) - "Pop up a buffer for entering a bookmark annotation. -Text surrounding the bookmark is PARG; the bookmark name is BOOKMARK." - (let ((buf (current-buffer)) - (point (point))) - (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*")) - (bookmark-read-annotation-mode buf point parg bookmark))) - - -(defvar bookmark-edit-annotation-mode-map (copy-keymap text-mode-map) - "Keymap for editing an annotation of a bookmark.") - - -(define-key bookmark-edit-annotation-mode-map "\C-c\C-c" - 'bookmark-send-edited-annotation) - - -(defun bookmark-edit-annotation-mode (bookmark) - "Mode for editing the annotation of bookmark BOOKMARK. -When you have finished composing, type \\[bookmark-send-annotation]. - -\\{bookmark-edit-annotation-mode-map} -" - (interactive) - (kill-all-local-variables) - (make-local-variable 'bookmark-annotation-name) - (setq bookmark-annotation-name bookmark) - (use-local-map bookmark-edit-annotation-mode-map) - (setq major-mode 'bookmark-edit-annotation-mode) - (insert (funcall bookmark-read-annotation-text-func bookmark)) - (let ((annotation (bookmark-get-annotation bookmark))) - (if (and (not (eq annotation nil)) - (not (string-equal annotation ""))) - (insert annotation))) - (run-hooks 'text-mode-hook)) - - -(defun bookmark-send-edited-annotation () - "Use buffer contents (minus beginning with `#' as annotation for a bookmark." - (interactive) - (if (not (eq major-mode 'bookmark-edit-annotation-mode)) - (error "Not in bookmark-edit-annotation-mode")) - (goto-char (point-min)) - (while (< (point) (point-max)) - (if (looking-at "^#") - (bookmark-kill-line t) - (forward-line 1))) - (let ((annotation (buffer-substring (point-min) (point-max))) - (bookmark bookmark-annotation-name)) - (bookmark-set-annotation bookmark annotation) - (bookmark-bmenu-surreptitiously-rebuild-list) - (goto-char bookmark-current-point)) - (kill-buffer (current-buffer))) - - -(defun bookmark-edit-annotation (bookmark) - "Pop up a buffer for editing bookmark BOOKMARK's annotation." - (let ((buf (current-buffer)) - (point (point))) - (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*")) - (bookmark-edit-annotation-mode bookmark))) - - -(defun bookmark-insert-current-bookmark () - "Insert this buffer's value of bookmark-current-bookmark. -Default to file name if it's nil." - (interactive) - (let ((str - (save-excursion - (set-buffer bookmark-current-buffer) - bookmark-current-bookmark))) - (if str (insert str) (bookmark-insert-buffer-name)))) - - -(defun bookmark-insert-buffer-name () - "Insert the current file name into the bookmark name being set. -The directory part of the file name is not used." - (interactive) - (let ((str - (save-excursion - (set-buffer bookmark-current-buffer) - (bookmark-buffer-name)))) - (insert str))) - - -(defun bookmark-buffer-name () - "Return the name of the current buffer's file, non-directory. -In Info, return the current node." - (cond - ;; Are we in Info? - ((string-equal mode-name "Info") Info-current-node) - ;; Or are we a file? - (buffer-file-name (file-name-nondirectory buffer-file-name)) - ;; Or are we a directory? - ((and (boundp 'dired-directory) dired-directory) - (let* ((dirname (if (stringp dired-directory) - dired-directory - (car dired-directory))) - (idx (1- (length dirname)))) - ;; Strip the trailing slash. - (if (= ?/ (aref dirname idx)) - (file-name-nondirectory (substring dirname 0 idx)) - ;; Else return the current-buffer - (buffer-name (current-buffer))))) - ;; If all else fails, use the buffer's name. - (t - (buffer-name (current-buffer))))) - - -(defun bookmark-yank-word () - (interactive) - ;; get the next word from the buffer and append it to the name of - ;; the bookmark currently being set. - (let ((string (save-excursion - (set-buffer bookmark-current-buffer) - (goto-char bookmark-yank-point) - (buffer-substring-no-properties - (point) - (save-excursion - (forward-word 1) - (setq bookmark-yank-point (point))))))) - (insert string))) - - -(defun bookmark-buffer-file-name () - "Return the current buffer's file in a way useful for bookmarks. -For example, if this is a Info buffer, return the Info file's name." - (if (eq major-mode 'Info-mode) - Info-current-file - (or - buffer-file-name - (if (and (boundp 'dired-directory) dired-directory) - (if (stringp dired-directory) - dired-directory - (car dired-directory)))))) - - -(defun bookmark-maybe-load-default-file () - (and (not bookmarks-already-loaded) - (null bookmark-alist) - (prog2 - (and - ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs - ;; to be renamed. - (file-exists-p (expand-file-name bookmark-old-default-file)) - (not (file-exists-p (expand-file-name bookmark-default-file))) - (rename-file (expand-file-name bookmark-old-default-file) - (expand-file-name bookmark-default-file))) - ;; return t so the `and' will continue... - t) - - (file-readable-p (expand-file-name bookmark-default-file)) - (progn - (bookmark-load bookmark-default-file t t) - (setq bookmarks-already-loaded t)))) - - -(defun bookmark-maybe-sort-alist () - ;;Return the bookmark-alist for display. If the bookmark-sort-flag - ;;is non-nil, then return a sorted copy of the alist. - (if bookmark-sort-flag - (setq bookmark-alist - (sort (copy-alist bookmark-alist) - (function - (lambda (x y) (string-lessp (car x) (car y)))))))) - - -;;;###autoload -(defun bookmark-jump (bookmark) - "Jump to bookmark BOOKMARK (a point in some file). -You may have a problem using this function if the value of variable -`bookmark-alist' is nil. If that happens, you need to load in some -bookmarks. See help on function `bookmark-load' for more about -this. - -If the file pointed to by BOOKMARK no longer exists, you will be asked -if you wish to give the bookmark a new location, and bookmark-jump -will then jump to the new location, as well as recording it in place -of the old one in the permanent bookmark record." - (interactive - (bookmark-completing-read "Jump to bookmark" bookmark-current-bookmark)) - (bookmark-maybe-historicize-string bookmark) - (let ((cell (bookmark-jump-noselect bookmark))) - (and cell - (switch-to-buffer (car cell)) - (goto-char (cdr cell)) - (if bookmark-automatically-show-annotations - ;; if there is an annotation for this bookmark, - ;; show it in a buffer. - (bookmark-show-annotation bookmark))))) - - -(defun bookmark-jump-noselect (str) - ;; a leetle helper for bookmark-jump :-) - ;; returns (BUFFER . POINT) - (bookmark-maybe-load-default-file) - (let* ((file (expand-file-name (bookmark-get-filename str))) - (forward-str (bookmark-get-front-context-string str)) - (behind-str (bookmark-get-rear-context-string str)) - (place (bookmark-get-position str)) - (info-node (bookmark-get-info-node str)) - (orig-file file) - ) - (if (or - (file-exists-p file) - ;; else try some common compression extensions - ;; and Emacs better handle it right! - ;; Sigh: I think it may *not* be handled at the moment. What - ;; to do about this? - (setq file - (or - (let ((altname (concat file ".Z"))) - (and (file-exists-p altname) - altname)) - (let ((altname (concat file ".gz"))) - (and (file-exists-p altname) - altname)) - (let ((altname (concat file ".z"))) - (and (file-exists-p altname) - altname))))) - (save-excursion - (if info-node - ;; Info nodes must be visited with care. - (progn - (require 'info) - (Info-find-node file info-node)) - ;; Else no Info. Can do an ordinary find-file: - (set-buffer (find-file-noselect file)) - (goto-char place)) - - ;; Go searching forward first. Then, if forward-str exists and - ;; was found in the file, we can search backward for behind-str. - ;; Rationale is that if text was inserted between the two in the - ;; file, it's better to be put before it so you can read it, - ;; rather than after and remain perhaps unaware of the changes. - (if forward-str - (if (search-forward forward-str (point-max) t) - (goto-char (match-beginning 0)))) - (if behind-str - (if (search-backward behind-str (point-min) t) - (goto-char (match-end 0)))) - ;; added by db - (setq bookmark-current-bookmark str) - (cons (current-buffer) (point))) - (progn - (ding) - (if (y-or-n-p (concat (file-name-nondirectory orig-file) - " nonexistent. Relocate \"" - str - "\"? ")) - (progn - (bookmark-relocate str) - ;; gasp! It's a recursive function call in Emacs Lisp! - (bookmark-jump-noselect str)) - (message - "Bookmark not relocated; consider removing it \(%s\)." str) - nil))))) - - -;;;###autoload -(defun bookmark-relocate (bookmark) - "Relocate BOOKMARK to another file (reading file name with minibuffer). -This makes an already existing bookmark point to that file, instead of -the one it used to point at. Useful when a file has been renamed -after a bookmark was set in it." - (interactive (bookmark-completing-read "Bookmark to relocate")) - (bookmark-maybe-historicize-string bookmark) - (bookmark-maybe-load-default-file) - (let* ((bmrk-filename (bookmark-get-filename bookmark)) - (newloc (expand-file-name - (read-file-name - (format "Relocate %s to: " bookmark) - (file-name-directory bmrk-filename))))) - (bookmark-set-filename bookmark newloc))) - - -;;;###autoload -(defun bookmark-insert-location (bookmark &optional no-history) - "Insert the name of the file associated with BOOKMARK. -Optional second arg NO-HISTORY means don't record this in the -minibuffer history list `bookmark-history'." - (interactive (bookmark-completing-read "Insert bookmark location")) - (or no-history (bookmark-maybe-historicize-string bookmark)) - (let ((start (point))) - (prog1 - (insert (bookmark-location bookmark)) ; *Return this line* - (if window-system - (put-text-property start - (save-excursion (re-search-backward - "[^ \t]") - (1+ (point))) - 'mouse-face 'highlight))))) - -;;;###autoload -(defalias 'bookmark-locate 'bookmark-insert-location) - -(defun bookmark-location (bookmark) - "Return the name of the file associated with BOOKMARK." - (bookmark-maybe-load-default-file) - (bookmark-get-filename bookmark)) - - -;;;###autoload -(defun bookmark-rename (old &optional new) - "Change the name of OLD bookmark to NEW name. -If called from keyboard, prompt for OLD and NEW. If called from -menubar, select OLD from a menu and prompt for NEW. - -If called from Lisp, prompt for NEW if only OLD was passed as an -argument. If called with two strings, then no prompting is done. You -must pass at least OLD when calling from Lisp. - -While you are entering the new name, consecutive C-w's insert -consecutive words from the text of the buffer into the new bookmark -name." - (interactive (bookmark-completing-read "Old bookmark name")) - (bookmark-maybe-historicize-string old) - (bookmark-maybe-load-default-file) - (progn - (setq bookmark-current-point (point)) - (setq bookmark-yank-point (point)) - (setq bookmark-current-buffer (current-buffer)) - (let ((newname - (or new ; use second arg, if non-nil - (read-from-minibuffer - "New name: " - nil - (let ((now-map (copy-keymap minibuffer-local-map))) - (define-key now-map "\C-w" 'bookmark-yank-word) - now-map) - nil - 'bookmark-history)))) - (progn - (bookmark-set-name old newname) - (setq bookmark-current-bookmark newname) - (bookmark-bmenu-surreptitiously-rebuild-list) - (setq bookmark-alist-modification-count - (1+ bookmark-alist-modification-count)) - (if (bookmark-time-to-save-p) - (bookmark-save)))))) - - -;;;###autoload -(defun bookmark-insert (bookmark) - "Insert the text of the file pointed to by bookmark BOOKMARK. -You may have a problem using this function if the value of variable -`bookmark-alist' is nil. If that happens, you need to load in some -bookmarks. See help on function `bookmark-load' for more about -this." - (interactive (bookmark-completing-read "Insert bookmark contents")) - (bookmark-maybe-historicize-string bookmark) - (bookmark-maybe-load-default-file) - (let ((orig-point (point)) - (str-to-insert - (save-excursion - (set-buffer (car (bookmark-jump-noselect bookmark))) - (buffer-substring (point-min) (point-max))))) - (insert str-to-insert) - (push-mark) - (goto-char orig-point))) - - -;;;###autoload -(defun bookmark-delete (bookmark &optional batch) - "Delete BOOKMARK from the bookmark list. -Removes only the first instance of a bookmark with that name. If -there are one or more other bookmarks with the same name, they will -not be deleted. Defaults to the \"current\" bookmark \(that is, the -one most recently used in this file, if any\). -Optional second arg BATCH means don't update the bookmark list buffer, -probably because we were called from there." - (interactive - (bookmark-completing-read "Delete bookmark" bookmark-current-bookmark)) - (bookmark-maybe-historicize-string bookmark) - (bookmark-maybe-load-default-file) - (let ((will-go (bookmark-get-bookmark bookmark))) - (setq bookmark-alist (delq will-go bookmark-alist)) - ;; Added by db, nil bookmark-current-bookmark if the last - ;; occurrence has been deleted - (or (bookmark-get-bookmark bookmark-current-bookmark) - (setq bookmark-current-bookmark nil))) - ;; Don't rebuild the list - (if batch - nil - (bookmark-bmenu-surreptitiously-rebuild-list) - (setq bookmark-alist-modification-count - (1+ bookmark-alist-modification-count)) - (if (bookmark-time-to-save-p) - (bookmark-save)))) - - -(defun bookmark-time-to-save-p (&optional last-time) - ;; By Gregory M. Saunders - ;; finds out whether it's time to save bookmarks to a file, by - ;; examining the value of variable bookmark-save-flag, and maybe - ;; bookmark-alist-modification-count. Returns t if they should be - ;; saved, nil otherwise. if last-time is non-nil, then this is - ;; being called when emacs is killed. - (cond (last-time - (and (> bookmark-alist-modification-count 0) - bookmark-save-flag)) - ((numberp bookmark-save-flag) - (>= bookmark-alist-modification-count bookmark-save-flag)) - (t - nil))) - - -;;;###autoload -(defun bookmark-write () - "Write bookmarks to a file (reading the file name with the minibuffer). -Don't use this in Lisp programs; use `bookmark-save' instead." - (interactive) - (bookmark-maybe-load-default-file) - (bookmark-save t)) - - -;;;###autoload -(defun bookmark-save (&optional parg file) - "Save currently defined bookmarks. -Saves by default in the file defined by the variable -`bookmark-default-file'. With a prefix arg, save it in file FILE -\(second argument\). - -If you are calling this from Lisp, the two arguments are PREFIX-ARG -and FILE, and if you just want it to write to the default file, then -pass no arguments. Or pass in nil and FILE, and it will save in FILE -instead. If you pass in one argument, and it is non-nil, then the -user will be interactively queried for a file to save in. - -When you want to load in the bookmarks from a file, use -\`bookmark-load\', \\[bookmark-load]. That function will prompt you -for a file, defaulting to the file defined by variable -`bookmark-default-file'." - (interactive "P") - (bookmark-maybe-load-default-file) - (cond - ((and (null parg) (null file)) - ;;whether interactive or not, write to default file - (bookmark-write-file bookmark-default-file)) - ((and (null parg) file) - ;;whether interactive or not, write to given file - (bookmark-write-file file)) - ((and parg (not file)) - ;;have been called interactively w/ prefix arg - (let ((file (read-file-name "File to save bookmarks in: "))) - (bookmark-write-file file))) - (t ; someone called us with prefix-arg *and* a file, so just write to file - (bookmark-write-file file))) - ;; signal that we have synced the bookmark file by setting this to - ;; 0. If there was an error at any point before, it will not get - ;; set, which is what we want. - (setq bookmark-alist-modification-count 0)) - - - -(defun bookmark-write-file (file) - (save-excursion - (save-window-excursion - (message "Saving bookmarks to file %s..." file) - (set-buffer (let ((enable-local-variables nil)) - (find-file-noselect file))) - (goto-char (point-min)) - (delete-region (point-min) (point-max)) - (bookmark-insert-file-format-version-stamp) - (pp bookmark-alist (current-buffer)) - (let ((version-control - (cond - ((null bookmark-version-control) nil) - ((eq 'never bookmark-version-control) 'never) - ((eq 'nospecial bookmark-version-control) version-control) - (t - t)))) - (write-file file) - (kill-buffer (current-buffer)) - (message "Saving bookmarks to file %s...done" file) - )))) - - -;;;###autoload -(defun bookmark-load (file &optional revert no-msg) - "Load bookmarks from FILE (which must be in bookmark format). -Appends loaded bookmarks to the front of the list of bookmarks. If -optional second argument REVERT is non-nil, existing bookmarks are -destroyed. Optional third arg NO-MSG means don't display any messages -while loading. - -If you load a file that doesn't contain a proper bookmark alist, you -will corrupt Emacs's bookmark list. Generally, you should only load -in files that were created with the bookmark functions in the first -place. Your own personal bookmark file, `~/.emacs.bmk', is -maintained automatically by Emacs; you shouldn't need to load it -explicitly." - (interactive - (list (read-file-name - (format "Load bookmarks from: (%s) " - bookmark-default-file) - ;;Default might not be used often, - ;;but there's no better default, and - ;;I guess it's better than none at all. - "~/" bookmark-default-file 'confirm))) - (setq file (expand-file-name file)) - (if (file-readable-p file) - (save-excursion - (save-window-excursion - (if (null no-msg) - (message "Loading bookmarks from %s..." file)) - (set-buffer (let ((enable-local-variables nil)) - (find-file-noselect file))) - (goto-char (point-min)) - (bookmark-maybe-upgrade-file-format) - (let ((blist (bookmark-alist-from-buffer))) - (if (listp blist) - (progn - (if (not revert) - (setq bookmark-alist-modification-count - (1+ bookmark-alist-modification-count)) - (setq bookmark-alist-modification-count 0)) - (setq bookmark-alist - (append blist (if (not revert) bookmark-alist))) - (bookmark-bmenu-surreptitiously-rebuild-list)) - (error "Invalid bookmark list in %s" file))) - (kill-buffer (current-buffer))) - (if (null no-msg) - (message "Loading bookmarks from %s...done" file))) - (error "Cannot read bookmark file %s" file))) - - - -;;; Code supporting the dired-like bookmark menu. Prefix is -;;; "bookmark-bmenu" for "buffer-menu": - - -(defvar bookmark-bmenu-bookmark-column nil) - - -(defvar bookmark-bmenu-hidden-bookmarks ()) - - -(defvar bookmark-bmenu-mode-map nil) - - -(if bookmark-bmenu-mode-map - nil - (setq bookmark-bmenu-mode-map (make-keymap)) - (suppress-keymap bookmark-bmenu-mode-map t) - (define-key bookmark-bmenu-mode-map "q" 'bookmark-bmenu-quit) - (define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select) - (define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate) - (define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window) - (define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window) - (define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window) - (define-key bookmark-bmenu-mode-map "\C-c\C-c" 'bookmark-bmenu-this-window) - (define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window) - (define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window) - (define-key bookmark-bmenu-mode-map "\C-o" - 'bookmark-bmenu-switch-other-window) - (define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save) - (define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete) - (define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards) - (define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions) - (define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete) - (define-key bookmark-bmenu-mode-map " " 'next-line) - (define-key bookmark-bmenu-mode-map "n" 'next-line) - (define-key bookmark-bmenu-mode-map "p" 'previous-line) - (define-key bookmark-bmenu-mode-map 'backspace 'bookmark-bmenu-backup-unmark) - (define-key bookmark-bmenu-mode-map 'delete 'bookmark-bmenu-backup-unmark) - (define-key bookmark-bmenu-mode-map "?" 'describe-mode) - (define-key bookmark-bmenu-mode-map "u" 'bookmark-bmenu-unmark) - (define-key bookmark-bmenu-mode-map "m" 'bookmark-bmenu-mark) - (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load) - (define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename) - (define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames) - (define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation) - (define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations) - (define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation) - (define-key bookmark-bmenu-mode-map [mouse-2] - 'bookmark-bmenu-other-window-with-mouse)) - - - -;; Bookmark Buffer Menu mode is suitable only for specially formatted -;; data. -(put 'bookmark-bmenu-mode 'mode-class 'special) - - -;; todo: need to display whether or not bookmark exists as a buffer in -;; flag column. - -;; Format: -;; FLAGS BOOKMARK [ LOCATION ] - - -(defun bookmark-bmenu-surreptitiously-rebuild-list () - "Rebuild the Bookmark List if it exists. -Don't affect the buffer ring order." - (if (get-buffer "*Bookmark List*") - (save-excursion - (save-window-excursion - (bookmark-bmenu-list))))) - - -;;;###autoload -(defun bookmark-bmenu-list () - "Display a list of existing bookmarks. -The list is displayed in a buffer named `*Bookmark List*'. -The leftmost column displays a D if the bookmark is flagged for -deletion, or > if it is flagged for displaying." - (interactive) - (bookmark-maybe-load-default-file) - (if (interactive-p) - (switch-to-buffer (get-buffer-create "*Bookmark List*")) - (set-buffer (get-buffer-create "*Bookmark List*"))) - (let ((buffer-read-only nil)) - (delete-region (point-max) (point-min)) - (goto-char (point-min)) ;sure are playing it safe... - (insert "% Bookmark\n- --------\n") - (bookmark-maybe-sort-alist) - (mapcar - (lambda (full-record) - ;; if a bookmark has an annotation, prepend a "*" - ;; in the list of bookmarks. - (let ((annotation (bookmark-get-annotation - (bookmark-name-from-full-record full-record)))) - (if (and (not (eq annotation nil)) - (not (string-equal annotation ""))) - (insert " *") - (insert " ")) - (let ((start (point))) - (insert (bookmark-name-from-full-record full-record)) - (if window-system - (put-text-property start - (save-excursion (re-search-backward - "[^ \t]") - (1+ (point))) - 'mouse-face 'highlight)) - (insert "\n") - ))) - bookmark-alist)) - (goto-char (point-min)) - (forward-line 2) - (bookmark-bmenu-mode) - (if bookmark-bmenu-toggle-filenames - (bookmark-bmenu-toggle-filenames t))) - -;;;###autoload -(defalias 'list-bookmarks 'bookmark-bmenu-list) -;;;###autoload -(defalias 'edit-bookmarks 'bookmark-bmenu-list) - - - -(defun bookmark-bmenu-mode () - "Major mode for editing a list of bookmarks. -Each line describes one of the bookmarks in Emacs. -Letters do not insert themselves; instead, they are commands. -Bookmark names preceded by a \"*\" have annotations. -\\ -\\[bookmark-bmenu-mark] -- mark bookmark to be displayed. -\\[bookmark-bmenu-select] -- select bookmark of line point is on. - Also show bookmarks marked using m in other windows. -\\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names). -\\[bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark. -\\[bookmark-bmenu-1-window] -- select this bookmark in full-frame window. -\\[bookmark-bmenu-2-window] -- select this bookmark in one window, - together with bookmark selected before this one in another window. -\\[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer. -\\[bookmark-bmenu-other-window] -- select this bookmark in another window, - so the bookmark menu bookmark remains visible in its window. -\\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark. -\\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\). -\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down. -\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up. -\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'. -\\[bookmark-bmenu-save] -- save the current bookmark list in the default file. - With a prefix arg, prompts for a file to save in. -\\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.) -\\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line. - With prefix argument, also move up one line. -\\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks. -\\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark - in another buffer. -\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. -\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark." - (kill-all-local-variables) - (use-local-map bookmark-bmenu-mode-map) - (setq truncate-lines t) - (setq buffer-read-only t) - (setq major-mode 'bookmark-bmenu-mode) - (setq mode-name "Bookmark Menu") - (run-hooks 'bookmark-bmenu-mode-hook)) - - -(defun bookmark-bmenu-toggle-filenames (&optional show) - "Toggle whether filenames are shown in the bookmark list. -Optional argument SHOW means show them unconditionally." - (interactive) - (cond - (show - (setq bookmark-bmenu-toggle-filenames nil) - (bookmark-bmenu-show-filenames) - (setq bookmark-bmenu-toggle-filenames t)) - (bookmark-bmenu-toggle-filenames - (bookmark-bmenu-hide-filenames) - (setq bookmark-bmenu-toggle-filenames nil)) - (t - (bookmark-bmenu-show-filenames) - (setq bookmark-bmenu-toggle-filenames t)))) - - -(defun bookmark-bmenu-show-filenames (&optional force) - (if (and (not force) bookmark-bmenu-toggle-filenames) - nil ;already shown, so do nothing - (save-excursion - (save-window-excursion - (goto-char (point-min)) - (forward-line 2) - (setq bookmark-bmenu-hidden-bookmarks ()) - (let ((buffer-read-only nil)) - (while (< (point) (point-max)) - (let ((bmrk (bookmark-bmenu-bookmark))) - (setq bookmark-bmenu-hidden-bookmarks - (cons bmrk bookmark-bmenu-hidden-bookmarks)) - (let ((start (save-excursion (end-of-line) (point)))) - (move-to-column bookmark-bmenu-file-column t) - ;; Strip off `mouse-face' from the white spaces region. - (if window-system - (remove-text-properties start (point) - '(mouse-face)))) - (delete-region (point) (progn (end-of-line) (point))) - (insert " ") - ;; Pass the NO-HISTORY arg: - (bookmark-insert-location bmrk t) - (forward-line 1)))))))) - - -(defun bookmark-bmenu-hide-filenames (&optional force) - (if (and (not force) bookmark-bmenu-toggle-filenames) - ;; nothing to hide if above is nil - (save-excursion - (save-window-excursion - (goto-char (point-min)) - (forward-line 2) - (setq bookmark-bmenu-hidden-bookmarks - (nreverse bookmark-bmenu-hidden-bookmarks)) - (save-excursion - (goto-char (point-min)) - (search-forward "Bookmark") - (backward-word 1) - (setq bookmark-bmenu-bookmark-column (current-column))) - (save-excursion - (let ((buffer-read-only nil)) - (while bookmark-bmenu-hidden-bookmarks - (move-to-column bookmark-bmenu-bookmark-column t) - (bookmark-kill-line) - (let ((start (point))) - (insert (car bookmark-bmenu-hidden-bookmarks)) - (if window-system - (put-text-property start - (save-excursion (re-search-backward - "[^ \t]") - (1+ (point))) - 'mouse-face 'highlight))) - (setq bookmark-bmenu-hidden-bookmarks - (cdr bookmark-bmenu-hidden-bookmarks)) - (forward-line 1)))))))) - - -;; if you look at this next function from far away, it resembles a -;; gun. But only with this comment above... -(defun bookmark-bmenu-check-position () - ;; Returns t if on a line with a bookmark. - ;; Otherwise, repositions and returns t. - ;; written by David Hughes - ;; Mucho thanks, David! -karl - (cond ((< (count-lines (point-min) (point)) 2) - (goto-char (point-min)) - (forward-line 2) - t) - ((and (bolp) (eobp)) - (beginning-of-line 0) - t) - (t - t))) - - -(defun bookmark-bmenu-bookmark () - ;; return a string which is bookmark of this line. - (if (bookmark-bmenu-check-position) - (save-excursion - (save-window-excursion - (goto-char (point-min)) - (search-forward "Bookmark") - (backward-word 1) - (setq bookmark-bmenu-bookmark-column (current-column))))) - (if bookmark-bmenu-toggle-filenames - (bookmark-bmenu-hide-filenames)) - (save-excursion - (save-window-excursion - (beginning-of-line) - (forward-char bookmark-bmenu-bookmark-column) - (prog1 - (buffer-substring-no-properties (point) - (progn - (end-of-line) - (point))) - ;; well, this is certainly crystal-clear: - (if bookmark-bmenu-toggle-filenames - (bookmark-bmenu-toggle-filenames t)))))) - - -(defun bookmark-show-annotation (bookmark) - "Display the annotation for bookmark named BOOKMARK in a buffer, -if an annotation exists." - (let ((annotation (bookmark-get-annotation bookmark))) - (if (and (not (eq annotation nil)) - (not (string-equal annotation ""))) - (progn - (save-excursion - (let ((old-buf (current-buffer))) - (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t) - (delete-region (point-min) (point-max)) - ; (insert (concat "Annotation for bookmark '" bookmark "':\n\n")) - (insert annotation) - (goto-char (point-min)) - (pop-to-buffer old-buf))))))) - - -(defun bookmark-show-all-annotations () - "Display the annotations for all bookmarks in a buffer." - (let ((old-buf (current-buffer))) - (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t) - (delete-region (point-min) (point-max)) - (mapcar - (lambda (full-record) - (let* ((name (bookmark-name-from-full-record full-record)) - (ann (bookmark-get-annotation name))) - (insert (concat name ":\n")) - (if (and (not (eq ann nil)) (not (string-equal ann ""))) - ;; insert the annotation, indented by 4 spaces. - (progn - (save-excursion (insert ann)) - (while (< (point) (point-max)) - (beginning-of-line) ; paranoia - (insert " ") - (forward-line) - (end-of-line)))))) - bookmark-alist) - (goto-char (point-min)) - (pop-to-buffer old-buf))) - - -(defun bookmark-bmenu-mark () - "Mark bookmark on this line to be displayed by \\\\[bookmark-bmenu-select]." - (interactive) - (beginning-of-line) - (if (bookmark-bmenu-check-position) - (let ((buffer-read-only nil)) - (delete-char 1) - (insert ?>) - (forward-line 1)))) - - -(defun bookmark-bmenu-select () - "Select this line's bookmark; also display bookmarks marked with `>'. -You can mark bookmarks with the \\\\[bookmark-bmenu-mark] command." - (interactive) - (if (bookmark-bmenu-check-position) - (let ((bmrk (bookmark-bmenu-bookmark)) - (menu (current-buffer)) - (others ()) - tem) - (goto-char (point-min)) - (while (re-search-forward "^>" nil t) - (setq tem (bookmark-bmenu-bookmark)) - (let ((buffer-read-only nil)) - (delete-char -1) - (insert ?\ )) - (or (string-equal tem bmrk) - (member tem others) - (setq others (cons tem others)))) - (setq others (nreverse others) - tem (/ (1- (frame-height)) (1+ (length others)))) - (delete-other-windows) - (bookmark-jump bmrk) - (bury-buffer menu) - (if others - (while others - (split-window nil tem) - (other-window 1) - (bookmark-jump (car others)) - (setq others (cdr others))) - (other-window 1))))) - - -(defun bookmark-bmenu-save (parg) - "Save the current list into a bookmark file. -With a prefix arg, prompts for a file to save them in." - (interactive "P") - (save-excursion - (save-window-excursion - (bookmark-save parg)))) - - -(defun bookmark-bmenu-load () - "Load the bookmark file and rebuild the bookmark menu-buffer." - (interactive) - (if (bookmark-bmenu-check-position) - (save-excursion - (save-window-excursion - ;; This will call `bookmark-bmenu-list' - (call-interactively 'bookmark-load))))) - - -(defun bookmark-bmenu-1-window () - "Select this line's bookmark, alone, in full frame." - (interactive) - (if (bookmark-bmenu-check-position) - (progn - (bookmark-jump (bookmark-bmenu-bookmark)) - (bury-buffer (other-buffer)) - (delete-other-windows)))) - - -(defun bookmark-bmenu-2-window () - "Select this line's bookmark, with previous buffer in second window." - (interactive) - (if (bookmark-bmenu-check-position) - (let ((bmrk (bookmark-bmenu-bookmark)) - (menu (current-buffer)) - (pop-up-windows t)) - (delete-other-windows) - (switch-to-buffer (other-buffer)) - (let* ((pair (bookmark-jump-noselect bmrk)) - (buff (car pair)) - (pos (cdr pair))) - (pop-to-buffer buff) - (goto-char pos)) - (bury-buffer menu)))) - - -(defun bookmark-bmenu-this-window () - "Select this line's bookmark in this window." - (interactive) - (if (bookmark-bmenu-check-position) - (bookmark-jump (bookmark-bmenu-bookmark)))) - - -(defun bookmark-bmenu-other-window () - "Select this line's bookmark in other window, leaving bookmark menu visible." - (interactive) - (let ((bookmark (bookmark-bmenu-bookmark))) - (if (bookmark-bmenu-check-position) - (let* ((pair (bookmark-jump-noselect bookmark)) - (buff (car pair)) - (pos (cdr pair))) - (switch-to-buffer-other-window buff) - (goto-char pos) - (set-window-point (get-buffer-window buff) pos) - (bookmark-show-annotation bookmark))))) - - -(defun bookmark-bmenu-switch-other-window () - "Make the other window select this line's bookmark. -The current window remains selected." - (interactive) - (let ((bookmark (bookmark-bmenu-bookmark))) - (if (bookmark-bmenu-check-position) - (let* ((pair (bookmark-jump-noselect bookmark)) - (buff (car pair)) - (pos (cdr pair))) - (display-buffer buff) - (let ((o-buffer (current-buffer))) - ;; save-excursion won't do - (set-buffer buff) - (goto-char pos) - (set-window-point (get-buffer-window buff) pos) - (set-buffer o-buffer)) - (bookmark-show-annotation bookmark))))) - -(defun bookmark-bmenu-other-window-with-mouse (event) - "Select bookmark at the mouse pointer in other window, leaving bookmark menu visible." - (interactive "e") - (save-excursion - (set-buffer (if (fboundp 'event-buffer) ; XEmacs - (event-buffer event) - (window-buffer (posn-window (event-end event))))) - (save-excursion - (goto-char (if (fboundp 'event-closest-point) - (event-closest-point event) - (posn-point (event-end event)))) - (bookmark-bmenu-other-window)))) - - -(defun bookmark-bmenu-show-annotation () - "Show the annotation for the current bookmark in another window." - (interactive) - (let ((bookmark (bookmark-bmenu-bookmark))) - (if (bookmark-bmenu-check-position) - (bookmark-show-annotation bookmark)))) - - -(defun bookmark-bmenu-show-all-annotations () - "Show the annotation for all bookmarks in another window." - (interactive) - (bookmark-show-all-annotations)) - - -(defun bookmark-bmenu-edit-annotation () - "Edit the annotation for the current bookmark in another window." - (interactive) - (let ((bookmark (bookmark-bmenu-bookmark))) - (if (bookmark-bmenu-check-position) - (bookmark-edit-annotation bookmark)))) - - -(defun bookmark-bmenu-quit () - "Quit the bookmark menu." - (interactive) - (let ((buffer (current-buffer))) - (switch-to-buffer (other-buffer)) - (bury-buffer buffer))) - - -(defun bookmark-bmenu-unmark (&optional backup) - "Cancel all requested operations on bookmark on this line and move down. -Optional BACKUP means move up." - (interactive "P") - (beginning-of-line) - (if (bookmark-bmenu-check-position) - (progn - (let ((buffer-read-only nil)) - (delete-char 1) - ;; any flags to reset according to circumstances? How about a - ;; flag indicating whether this bookmark is being visited? - ;; well, we don't have this now, so maybe later. - (insert " ")) - (forward-line (if backup -1 1))))) - - -(defun bookmark-bmenu-backup-unmark () - "Move up and cancel all requested operations on bookmark on line above." - (interactive) - (forward-line -1) - (if (bookmark-bmenu-check-position) - (progn - (bookmark-bmenu-unmark) - (forward-line -1)))) - - -(defun bookmark-bmenu-delete () - "Mark bookmark on this line to be deleted. -To carry out the deletions that you've marked, use \\\\[bookmark-bmenu-execute-deletions]." - (interactive) - (beginning-of-line) - (if (bookmark-bmenu-check-position) - (let ((buffer-read-only nil)) - (delete-char 1) - (insert ?D) - (forward-line 1)))) - - -(defun bookmark-bmenu-delete-backwards () - "Mark bookmark on this line to be deleted, then move up one line. -To carry out the deletions that you've marked, use \\\\[bookmark-bmenu-execute-deletions]." - (interactive) - (bookmark-bmenu-delete) - (forward-line -2) - (if (bookmark-bmenu-check-position) - (forward-line 1))) - - -(defun bookmark-bmenu-execute-deletions () - "Delete bookmarks marked with \\\\[Buffer-menu-delete] commands." - (interactive) - (message "Deleting bookmarks...") - (let ((hide-em bookmark-bmenu-toggle-filenames) - (o-point (point)) - (o-str (save-excursion - (beginning-of-line) - (if (looking-at "^D") - nil - (buffer-substring - (point) - (progn (end-of-line) (point)))))) - (o-col (current-column))) - (if hide-em (bookmark-bmenu-hide-filenames)) - (setq bookmark-bmenu-toggle-filenames nil) - (goto-char (point-min)) - (forward-line 1) - (while (re-search-forward "^D" (point-max) t) - (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg - (bookmark-bmenu-list) - (setq bookmark-bmenu-toggle-filenames hide-em) - (if bookmark-bmenu-toggle-filenames - (bookmark-bmenu-toggle-filenames t)) - (if o-str - (progn - (goto-char (point-min)) - (search-forward o-str) - (beginning-of-line) - (forward-char o-col)) - (goto-char o-point)) - (beginning-of-line) - (setq bookmark-alist-modification-count - (1+ bookmark-alist-modification-count)) - (if (bookmark-time-to-save-p) - (bookmark-save)) - (message "Deleting bookmarks...done") - )) - - -(defun bookmark-bmenu-rename () - "Rename bookmark on current line. Prompts for a new name." - (interactive) - (if (bookmark-bmenu-check-position) - (let ((bmrk (bookmark-bmenu-bookmark)) - (thispoint (point))) - (bookmark-rename bmrk) - (bookmark-bmenu-list) - (goto-char thispoint)))) - - -(defun bookmark-bmenu-locate () - "Display location of this bookmark. Displays in the minibuffer." - (interactive) - (if (bookmark-bmenu-check-position) - (let ((bmrk (bookmark-bmenu-bookmark))) - (message (bookmark-location bmrk))))) - - - -;;; Menu bar stuff. Prefix is "bookmark-menu". - -(defun bookmark-menu-build-paned-menu (name entries) - "Build a multi-paned menu named NAME from the strings in ENTRIES. -That is, ENTRIES is a list of strings which appear as the choices -in the menu. The number of panes depends on the number of entries. -The visible entries are truncated to `bookmark-menu-length', but the -strings returned are not." - (let* ((f-height (/ (frame-height) 2)) - (pane-list - (let (temp-pane-list - (iter 0)) - (while entries - (let (lst - (count 0)) - (while (and (< count f-height) entries) - (let ((str (car entries))) - (setq lst (cons - (cons - (if (> (length str) bookmark-menu-length) - (substring str 0 bookmark-menu-length) - str) - str) - lst)) - (setq entries (cdr entries)) - (setq count (1+ count)))) - (setq iter (1+ iter)) - (setq - temp-pane-list - (cons - (cons - (format "-*- %s (%d) -*-" name iter) - (nreverse lst)) - temp-pane-list)))) - (nreverse temp-pane-list)))) - - ;; Return the menu: - (cons (concat "-*- " name " -*-") pane-list))) - - -(defun bookmark-build-xemacs-menu (name entries function) - "Build a menu named NAME from the strings in ENTRIES. -That is, ENTRIES is a list of strings that appear as the choices -in the menu. -The visible entries are truncated to `bookmark-menu-length', but the -strings returned are not." - (let* (lst - (pane-list - (progn - (while entries - (let ((str (car entries))) - (setq lst (cons - (vector - (if (> (length str) bookmark-menu-length) - (substring str 0 bookmark-menu-length) - str) - (list function str) - t) - lst)) - (setq entries (cdr entries)))) - (nreverse lst)))) - - ;; Return the menu: - (append (if popup-menu-titles (list (concat "-*- " name " -*-"))) - pane-list))) - - -(defun bookmark-menu-popup-paned-menu (event name entries) - "Pop up multi-paned menu at EVENT, return string chosen from ENTRIES. -That is, ENTRIES is a list of strings which appear as the choices -in the menu. -The number of panes depends on the number of entries." - (interactive "e") - (if (not (featurep 'xemacs)) - (x-popup-menu event (bookmark-menu-build-paned-menu name entries)) - ;; Kludge. Emulate x-popup-menu - (eval - (event-object - (get-popup-menu-response - (cons name - (mapcar - (lambda (x) - (vector x (list 'identity x))) - entries))))))) - - -(defun bookmark-menu-popup-paned-bookmark-menu (event name) - "Pop up menu of bookmarks, return chosen bookmark. -Pop up at EVENT, menu's name is NAME. -The number of panes depends on the number of bookmarks." - (bookmark-menu-popup-paned-menu event name (bookmark-all-names))) - - -(defun bookmark-popup-menu-and-apply-function (func-sym menu-label event) - ;; help function for making menus that need to apply a bookmark - ;; function to a string. - (let* ((choice (bookmark-menu-popup-paned-bookmark-menu - event menu-label))) - (if choice (apply func-sym (list choice))))) - - -;;;###autoload -(defun bookmark-menu-insert (event) - "Insert the text of the file pointed to by bookmark BOOKMARK. -You may have a problem using this function if the value of variable -`bookmark-alist' is nil. If that happens, you need to load in some -bookmarks. See help on function `bookmark-load' for more about -this. - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp \(the one without the -\"-menu-\" in its name\)." - (interactive "e") - (bookmark-popup-menu-and-apply-function - 'bookmark-insert "Insert Bookmark Contents" event)) - - -;;;###autoload -(defun bookmark-menu-jump (event) - "Jump to bookmark BOOKMARK (a point in some file). -You may have a problem using this function if the value of variable -`bookmark-alist' is nil. If that happens, you need to load in some -bookmarks. See help on function `bookmark-load' for more about -this. - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp \(the one without the -\"-menu-\" in its name\)." - (interactive "e") - (bookmark-popup-menu-and-apply-function - 'bookmark-jump "Jump to Bookmark" event)) - - -;;;###autoload -(defun bookmark-menu-locate (event) - "Insert the name of the file associated with BOOKMARK. -\(This is not the same as the contents of that file\). - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp \(the one without the -\"-menu-\" in its name\)." - (interactive "e") - (bookmark-popup-menu-and-apply-function - 'bookmark-insert-location "Insert Bookmark Location" event)) - - -;;;###autoload -(defun bookmark-menu-rename (event) - "Change the name of OLD-BOOKMARK to NEWNAME. -If called from keyboard, prompts for OLD-BOOKMARK and NEWNAME. -If called from menubar, OLD-BOOKMARK is selected from a menu, and -prompts for NEWNAME. -If called from Lisp, prompts for NEWNAME if only OLD-BOOKMARK was -passed as an argument. If called with two strings, then no prompting -is done. You must pass at least OLD-BOOKMARK when calling from Lisp. - -While you are entering the new name, consecutive C-w's insert -consecutive words from the text of the buffer into the new bookmark -name. - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp \(the one without the -\"-menu-\" in its name\)." - (interactive "e") - (bookmark-popup-menu-and-apply-function - 'bookmark-rename "Rename Bookmark" event)) - - -;;;###autoload -(defun bookmark-menu-delete (event) - "Delete the bookmark named NAME from the bookmark list. -Removes only the first instance of a bookmark with that name. If -there are one or more other bookmarks with the same name, they will -not be deleted. Defaults to the \"current\" bookmark \(that is, the -one most recently used in this file, if any\). - -Warning: this function only takes an EVENT as argument. Use the -corresponding bookmark function from Lisp \(the one without the -\"-menu-\" in its name\)." - (interactive "e") - (bookmark-popup-menu-and-apply-function - 'bookmark-delete "Delete Bookmark" event)) - - -;; Thanks to Roland McGrath for fixing menubar.el so that the -;; following works, and for explaining what to do to make it work. - -;; We MUST autoload EACH form used to set up this variable's value, so -;; that the whole job is done in loaddefs.el. - -;; Emacs menubar stuff. - -;;;###autoload -(defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions")) - -;;;###autoload -(defalias 'menu-bar-bookmark-map (symbol-value 'menu-bar-bookmark-map)) - -;; make bookmarks appear toward the right side of the menu. -(if (boundp 'menu-bar-final-items) - (if menu-bar-final-items - (setq menu-bar-final-items - (cons 'bookmark menu-bar-final-items))) - (setq menu-bar-final-items '(bookmark))) - -;;;###autoload -(define-key menu-bar-bookmark-map [load] - '("Load a Bookmark File..." . bookmark-load)) - -;;;###autoload -(define-key menu-bar-bookmark-map [write] - '("Save Bookmarks As..." . bookmark-write)) - -;;;###autoload -(define-key menu-bar-bookmark-map [save] - '("Save Bookmarks" . bookmark-save)) - -;;;###autoload -(define-key menu-bar-bookmark-map [edit] - '("Edit Bookmark List" . bookmark-bmenu-list)) - -;;;###autoload -(define-key menu-bar-bookmark-map [delete] - '("Delete Bookmark" . bookmark-menu-delete)) - -;;;###autoload -(define-key menu-bar-bookmark-map [rename] - '("Rename Bookmark" . bookmark-menu-rename)) - -;;;###autoload -(define-key menu-bar-bookmark-map [locate] - '("Insert Location" . bookmark-menu-locate)) - -;;;###autoload -(define-key menu-bar-bookmark-map [insert] - '("Insert Contents" . bookmark-menu-insert)) - -;;;###autoload -(define-key menu-bar-bookmark-map [set] - '("Set Bookmark" . bookmark-set)) - -;;;###autoload -(define-key menu-bar-bookmark-map [jump] - '("Jump to Bookmark" . bookmark-menu-jump)) - -;;;; end bookmark menu stuff ;;;; - - -;;; Load Hook -(defvar bookmark-load-hook nil - "Hook to run at the end of loading bookmark.") - -(run-hooks 'bookmark-load-hook) - -(provide 'bookmark) - -;;; bookmark.el ends here diff --git a/xemacs-packages/lisp/edit-utils/compare-w.el b/xemacs-packages/lisp/edit-utils/compare-w.el deleted file mode 100644 index 64f80faf..00000000 --- a/xemacs-packages/lisp/edit-utils/compare-w.el +++ /dev/null @@ -1,180 +0,0 @@ -;;; compare-w.el --- compare text between windows for Emacs. - -;; Copyright (C) 1986, 1989, 1993 Free Software Foundation, Inc. - -;; Maintainer: FSF - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: FSF 19.34. - -;;; Whatever was here before didn't look any more correct than the -;;; FSF version, so I've junked it and replaced it with the FSF version. -;;; If you really don't like this, dig out the previous version from -;;; 19.13. --ben - -;;; Commentary: - -;; This package provides one entry point, compare-windows. It compares -;; text starting from point in two adjacent windows, advancing point -;; until it finds a difference. Option variables permit you to ignore -;; whitespace differences, or case differences, or both. - -;;; Code: - -(defvar compare-windows-whitespace "[ \t\n]+" - "*Regexp that defines whitespace sequences for \\[compare-windows]. -Changes in whitespace are optionally ignored. - -The value of `compare-windows-whitespace' may instead be a function; this -function is called in each buffer, with point at the current scanning point. -The function's job is to categorize any whitespace around (including before) -point; it should also advance past any whitespace. - -The function is passed one argument, the point where `compare-windows' -was originally called; it should not consider any text before that point. -If the function returns the same value for both buffers, then the -whitespace is considered to match, and is skipped.") - -(defvar compare-ignore-case nil - "*Non-nil means \\[compare-windows] ignores case differences.") - -;;;###autoload -(defun compare-windows (ignore-whitespace) - "Compare text in current window with text in next window. -Compares the text starting at point in each window, -moving over text in each one as far as they match. - -This command pushes the mark in each window -at the prior location of point in that window. -If both windows display the same buffer, -the mark is pushed twice in that buffer: -first in the other window, then in the selected window. - -A prefix arg means ignore changes in whitespace. -The variable `compare-windows-whitespace' controls how whitespace is skipped. -If `compare-ignore-case' is non-nil, changes in case are also ignored." - (interactive "P") - (let* (p1 p2 maxp1 maxp2 b1 b2 w2 - success size - (opoint1 (point)) - opoint2 - (skip-whitespace (if ignore-whitespace - compare-windows-whitespace))) - (setq p1 (point) b1 (current-buffer)) - (setq w2 (next-window (selected-window))) - (if (eq w2 (selected-window)) - (error "No other window")) - (setq p2 (window-point w2) - b2 (window-buffer w2)) - (setq opoint2 p2) - (setq maxp1 (point-max)) - (save-excursion - (set-buffer b2) - (push-mark p2 t) - (setq maxp2 (point-max))) - (push-mark) - - (setq success t) - (while success - (setq success nil) - ;; if interrupted, show how far we've gotten - (goto-char p1) - (set-window-point w2 p2) - - ;; If both buffers have whitespace next to point, - ;; optionally skip over it. - - (and skip-whitespace - (save-excursion - (let (p1a p2a w1 w2 result1 result2) - (setq result1 - (if (stringp skip-whitespace) - (compare-windows-skip-whitespace opoint1) - (funcall skip-whitespace opoint1))) - (setq p1a (point)) - (set-buffer b2) - (goto-char p2) - (setq result2 - (if (stringp skip-whitespace) - (compare-windows-skip-whitespace opoint2) - (funcall skip-whitespace opoint2))) - (setq p2a (point)) - (if (or (stringp skip-whitespace) - (and result1 result2 (eq result1 result2))) - (setq p1 p1a - p2 p2a))))) - - ;; Try advancing comparing 1000 chars at a time. - ;; When that fails, go 500 chars at a time, and so on. - (let ((size 1000) - success-1 - (case-fold-search compare-ignore-case)) - (while (> size 0) - (setq success-1 t) - ;; Try comparing SIZE chars at a time, repeatedly, till that fails. - (while success-1 - (setq size (min size (- maxp1 p1) (- maxp2 p2))) - (setq success-1 - (and (> size 0) - (= 0 (compare-buffer-substrings b2 p2 (+ size p2) - b1 p1 (+ size p1))))) - (if success-1 - (setq p1 (+ p1 size) p2 (+ p2 size) - success t))) - ;; If SIZE chars don't match, try fewer. - (setq size (/ size 2))))) - - (goto-char p1) - (set-window-point w2 p2) - (if (= (point) opoint1) - (ding)))) - -;; Move forward over whatever might be called whitespace. -;; compare-windows-whitespace is a regexp that matches whitespace. -;; Match it at various starting points before the original point -;; and find the latest point at which a match ends. -;; Don't try starting points before START, though. -;; Value is non-nil if whitespace is found. - -;; If there is whitespace before point, but none after, -;; then return t, but don't advance point. -(defun compare-windows-skip-whitespace (start) - (let ((end (point)) - (beg (point)) - (opoint (point))) - (while (or (and (looking-at compare-windows-whitespace) - (<= end (match-end 0)) - ;; This match goes past END, so advance END. - (progn (setq end (match-end 0)) - (> (point) start))) - (and (/= (point) start) - ;; Consider at least the char before point, - ;; unless it is also before START. - (= (point) opoint))) - ;; keep going back until whitespace - ;; doesn't extend to or past end - (forward-char -1)) - (setq beg (point)) - (goto-char end) - (or (/= beg opoint) - (/= end opoint)))) - -(provide 'compare-w) - -;;; compare-w.el ends here diff --git a/xemacs-packages/lisp/edit-utils/completion.el b/xemacs-packages/lisp/edit-utils/completion.el deleted file mode 100644 index 2fea10b1..00000000 --- a/xemacs-packages/lisp/edit-utils/completion.el +++ /dev/null @@ -1,2727 +0,0 @@ -;;; completion.el --- dynamic word-completion code - -;; Copyright (C) 1990, 1993, 1995 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: abbrev -;; Author: Jim Salem of Thinking Machines Inc. -;; (ideas suggested by Brewster Kahle) - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: FSF 19.34. - -;;; Commentary: - -;; What to put in .emacs -;;----------------------- -;; (load "completion") -;; (initialize-completions) - -;;--------------------------------------------------------------------------- -;; Documentation [Slightly out of date] -;;--------------------------------------------------------------------------- -;; (also check the documentation string of the functions) -;; -;; Introduction -;;--------------- -;; -;; After you type a few characters, pressing the "complete" key inserts -;; the rest of the word you are likely to type. -;; -;; This watches all the words that you type and remembers them. When -;; typing a new word, pressing "complete" (meta-return) "completes" the -;; word by inserting the most recently used word that begins with the -;; same characters. If you press meta-return repeatedly, it cycles -;; through all the words it knows about. -;; -;; If you like the completion then just continue typing, it is as if you -;; entered the text by hand. If you want the inserted extra characters -;; to go away, type control-w or delete. More options are described below. -;; -;; The guesses are made in the order of the most recently "used". Typing -;; in a word and then typing a separator character (such as a space) "uses" -;; the word. So does moving a cursor over the word. If no words are found, -;; it uses an extended version of the dabbrev style completion. -;; -;; You automatically save the completions you use to a file between -;; sessions. -;; -;; Completion enables programmers to enter longer, more descriptive -;; variable names while typing fewer keystrokes than they normally would. -;; -;; -;; Full documentation -;;--------------------- -;; -;; A "word" is any string containing characters with either word or symbol -;; syntax. [E.G. Any alphanumeric string with hyphens, underscores, etc.] -;; Unless you change the constants, you must type at least three characters -;; for the word to be recognized. Only words longer than 6 characters are -;; saved. -;; -;; When you load this file, completion will be on. I suggest you use the -;; compiled version (because it is noticeably faster). -;; -;; M-X completion-mode toggles whether or not new words are added to the -;; database by changing the value of enable-completion. -;; -;; SAVING/LOADING COMPLETIONS -;; Completions are automatically saved from one session to another -;; (unless save-completions-flag or enable-completion is nil). -;; Loading this file (or calling initialize-completions) causes EMACS -;; to load a completions database for a saved completions file -;; (default: ~/.completions). When you exit, EMACS saves a copy of the -;; completions that you -;; often use. When you next start, EMACS loads in the saved completion file. -;; -;; The number of completions saved depends loosely on -;; *saved-completions-decay-factor*. Completions that have never been -;; inserted via "complete" are not saved. You are encouraged to experiment -;; with different functions (see compute-completion-min-num-uses). -;; -;; Some completions are permanent and are always saved out. These -;; completions have their num-uses slot set to T. Use -;; add-permanent-completion to do this -;; -;; Completions are saved only if enable-completion is T. The number of old -;; versions kept of the saved completions file is controlled by -;; completions-file-versions-kept. -;; -;; COMPLETE KEY OPTIONS -;; The complete function takes a numeric arguments. -;; control-u :: leave the point at the beginning of the completion rather -;; than the middle. -;; a number :: rotate through the possible completions by that amount -;; `-' :: same as -1 (insert previous completion) -;; -;; HOW THE DATABASE IS MAINTAINED -;; -;; -;; UPDATING THE DATABASE MANUALLY -;; m-x kill-completion -;; kills the completion at point. -;; m-x add-completion -;; m-x add-permanent-completion -;; -;; UPDATING THE DATABASE FROM A SOURCE CODE FILE -;; m-x add-completions-from-buffer -;; Parses all the definition names from a C or LISP mode buffer and -;; adds them to the completion database. -;; -;; m-x add-completions-from-lisp-file -;; Parses all the definition names from a C or Lisp mode file and -;; adds them to the completion database. -;; -;; UPDATING THE DATABASE FROM A TAGS TABLE -;; m-x add-completions-from-tags-table -;; Adds completions from the current tags-table-buffer. -;; -;; HOW A COMPLETION IS FOUND -;; -;; -;; STRING CASING -;; Completion is string case independent if case-fold-search has its -;; normal default of T. Also when the completion is inserted the case of the -;; entry is coerced appropriately. -;; [E.G. APP --> APPROPRIATELY app --> appropriately -;; App --> Appropriately] -;; -;; INITIALIZATION -;; The form `(initialize-completions)' initializes the completion system by -;; trying to load in the user's completions. After the first cal, further -;; calls have no effect so one should be careful not to put the form in a -;; site's standard site-init file. -;; -;;--------------------------------------------------------------------------- -;; -;; - -;;--------------------------------------------------------------------------- -;; Functions you might like to call -;;--------------------------------------------------------------------------- -;; -;; add-completion string &optional num-uses -;; Adds a new string to the database -;; -;; add-permanent-completion string -;; Adds a new string to the database with num-uses = T -;; - -;; kill-completion string -;; Kills the completion from the database. -;; -;; clear-all-completions -;; Clears the database -;; -;; list-all-completions -;; Returns a list of all completions. -;; -;; -;; next-completion string &optional index -;; Returns a completion entry that starts with string. -;; -;; find-exact-completion string -;; Returns a completion entry that exactly matches string. -;; -;; complete -;; Inserts a completion at point -;; -;; initialize-completions -;; Loads the completions file and sets up so that exiting emacs will -;; save them. -;; -;; save-completions-to-file &optional filename -;; load-completions-from-file &optional filename -;; -;;----------------------------------------------- -;; Other functions -;;----------------------------------------------- -;; -;; get-completion-list string -;; -;; These things are for manipulating the structure -;; make-completion string num-uses -;; completion-num-uses completion -;; completion-string completion -;; set-completion-num-uses completion num-uses -;; set-completion-string completion string -;; -;; - -;;----------------------------------------------- -;; To Do :: (anybody ?) -;;----------------------------------------------- -;; -;; Implement Lookup and keyboard interface in C -;; Add package prefix smarts (for Common Lisp) -;; Add autoprompting of possible completions after every keystroke (fast -;; terminals only !) -;; Add doc. to texinfo -;; -;; -;;----------------------------------------------- -;;; Change Log: -;;----------------------------------------------- -;; Sometime in '84 Brewster implemented a somewhat buggy version for -;; Symbolics LISPMs. -;; Jan. '85 Jim became enamored of the idea and implemented a faster, -;; more robust version. -;; With input from many users at TMC, (rose, craig, and gls come to mind), -;; the current style of interface was developed. -;; 9/87, Jim and Brewster took terminals home. Yuck. After -;; complaining for awhile Brewster implemented a subset of the current -;; LISPM version for GNU Emacs. -;; 8/88 After complaining for a while (and with sufficient -;; promised rewards), Jim reimplemented a version of GNU completion -;; superior to that of the LISPM version. -;; -;;----------------------------------------------- -;; Acknowledgements -;;----------------------------------------------- -;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com), -;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu, -;; -;;----------------------------------------------- -;; Change Log -;;----------------------------------------------- -;; From version 9 to 10 -;; - Allowance for non-integral *completion-version* nos. -;; - Fix cmpl-apply-as-top-level for keyboard macros -;; - Fix broken completion merging (in save-completions-to-file) -;; - More misc. fixes for version 19.0 of emacs -;; -;; From Version 8 to 9 -;; - Ported to version 19.0 of emacs (backcompatible with version 18) -;; - Added add-completions-from-tags-table (with thanks to eero@media-lab) -;; -;; From Version 7 to 8 -;; - Misc. changes to comments -;; - new completion key bindings: c-x o, M->, M-<, c-a, c-e -;; - cdabbrev now checks all the visible window buffers and the "other buffer" -;; - `%' is now a symbol character rather than a separator (except in C mode) -;; -;; From Version 6 to 7 -;; - Fixed bug with saving out .completion file the first time -;; -;; From Version 5 to 6 -;; - removed statistics recording -;; - reworked advise to handle autoloads -;; - Fixed fortran mode support -;; - Added new cursor motion triggers -;; -;; From Version 4 to 5 -;; - doesn't bother saving if nothing has changed -;; - auto-save if haven't used for a 1/2 hour -;; - save period extended to two weeks -;; - minor fix to capitalization code -;; - added *completion-auto-save-period* to variables recorded. -;; - added reenter protection to cmpl-record-statistics-filter -;; - added backup protection to save-completions-to-file (prevents -;; problems with disk full errors) - -;;; Code: - -;;--------------------------------------------------------------------------- -;; User changeable parameters -;;--------------------------------------------------------------------------- - -(defgroup completion nil - "Dynamic word-completion code." - :group 'matching) - - -(defcustom enable-completion t - "*Non-nil means enable recording and saving of completions. -If nil, no new words added to the database or saved to the init file." - :type 'boolean - :group 'completion) - -(defcustom save-completions-flag t - "*Non-nil means save most-used completions when exiting Emacs. -See also `saved-completions-retention-time'." - :type 'boolean - :group 'completion) - -(defcustom save-completions-file-name (convert-standard-filename "~/.completions") - "*The filename to save completions to." - :type 'file - :group 'completion) - -(defcustom save-completions-retention-time 336 - "*Discard a completion if unused for this many hours. -\(1 day = 24, 1 week = 168). If this is 0, non-permanent completions -will not be saved unless these are used. Default is two weeks." - :type 'integer - :group 'completion) - -(defcustom completion-on-separator-character nil - "*Non-nil means separator characters mark previous word as used. -This means the word will be saved as a completion." - :type 'boolean - :group 'completion) - -(defcustom completions-file-versions-kept kept-new-versions - "*Number of versions to keep for the saved completions file." - :type 'integer - :group 'completion) - -(defcustom completion-prompt-speed-threshold 4800 - "*Minimum output speed at which to display next potential completion." - :type 'integer - :group 'completion) - -(defcustom completion-cdabbrev-prompt-flag nil - "*If non-nil, the next completion prompt does a cdabbrev search. -This can be time consuming." - :type 'boolean - :group 'completion) - -(defcustom completion-search-distance 15000 - "*How far to search in the buffer when looking for completions. -In number of characters. If nil, search the whole buffer." - :type 'integer - :group 'completion) - -(defcustom completions-merging-modes '(lisp c) - "*List of modes {`c' or `lisp'} for automatic completions merging. -Definitions from visited files which have these modes -are automatically added to the completion database." - :type '(set (const lisp) (const c)) - :group 'completion) - -;;(defvar *record-cmpl-statistics-p* nil -;; "*If non-nil, record completion statistics.") - -;;(defvar *completion-auto-save-period* 1800 -;; "*The period in seconds to wait for emacs to be idle before autosaving -;;the completions. Default is a 1/2 hour.") - -(defconst completion-min-length nil ;; defined below in eval-when - "*The minimum length of a stored completion. -DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") - -(defconst completion-max-length nil ;; defined below in eval-when - "*The maximum length of a stored completion. -DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") - -(defconst completion-prefix-min-length nil ;; defined below in eval-when - "The minimum length of a completion search string. -DON'T CHANGE WITHOUT RECOMPILING ! This is used by macros.") - -(defmacro eval-when-compile-load-eval (&rest body) - ;; eval everything before expanding - (mapcar 'eval body) - (cons 'progn body)) - -(eval-when-compile - (defvar completion-gensym-counter 0) - (defun completion-gensym (&optional arg) - "Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((prefix (if (stringp arg) arg "G")) - (num (if (integerp arg) arg - (prog1 completion-gensym-counter - (setq completion-gensym-counter (1+ completion-gensym-counter)))))) - (make-symbol (format "%s%d" prefix num))))) - -(defmacro completion-dolist (spec &rest body) - "(completion-dolist (VAR LIST [RESULT]) BODY...): loop over a list. -Evaluate BODY with VAR bound to each `car' from LIST, in turn. -Then evaluate RESULT to get return value, default nil." - (let ((temp (completion-gensym "--dolist-temp--"))) - (append (list 'let (list (list temp (nth 1 spec)) (car spec)) - (append (list 'while temp - (list 'setq (car spec) (list 'car temp))) - body (list (list 'setq temp - (list 'cdr temp))))) - (if (cdr (cdr spec)) - (cons (list 'setq (car spec) nil) (cdr (cdr spec))) - '(nil))))) - -(defun completion-eval-when () - (eval-when-compile-load-eval - ;; These vars. are defined at both compile and load time. - (setq completion-min-length 6) - (setq completion-max-length 200) - (setq completion-prefix-min-length 3))) - -(completion-eval-when) - -;;--------------------------------------------------------------------------- -;; Internal Variables -;;--------------------------------------------------------------------------- - -(defvar cmpl-initialized-p nil - "Set to t when the completion system is initialized. -Indicates that the old completion file has been read in.") - -(defvar cmpl-completions-accepted-p nil - "Set to t as soon as the first completion has been accepted. -Used to decide whether to save completions.") - -(defvar cmpl-preceding-syntax) - -(defvar completion-string) - -;;--------------------------------------------------------------------------- -;; Low level tools -;;--------------------------------------------------------------------------- - -;;----------------------------------------------- -;; Misc. -;;----------------------------------------------- - -(defun minibuffer-window-selected-p () - "True iff the current window is the minibuffer." - (window-minibuffer-p (selected-window))) - -;; This used to be `(eval form)'. Eval FORM at run time now. -(defmacro cmpl-read-time-eval (form) - form) - -;;----------------------------------------------- -;; String case coercion -;;----------------------------------------------- - -(defun cmpl-string-case-type (string) - "Returns :capitalized, :up, :down, :mixed, or :neither." - (let ((case-fold-search nil)) - (cond ((string-match "[a-z]" string) - (cond ((string-match "[A-Z]" string) - (cond ((and (> (length string) 1) - (null (string-match "[A-Z]" string 1))) - ':capitalized) - (t - ':mixed))) - (t ':down))) - (t - (cond ((string-match "[A-Z]" string) - ':up) - (t ':neither)))) - )) - -;; Tests - -;; (cmpl-string-case-type "123ABCDEF456") --> :up -;; (cmpl-string-case-type "123abcdef456") --> :down -;; (cmpl-string-case-type "123aBcDeF456") --> :mixed -;; (cmpl-string-case-type "123456") --> :neither -;; (cmpl-string-case-type "Abcde123") --> :capitalized - -(defun cmpl-coerce-string-case (string case-type) - (cond ((eq case-type ':down) (downcase string)) - ((eq case-type ':up) (upcase string)) - ((eq case-type ':capitalized) - (setq string (downcase string)) - (aset string 0 (logand ?\337 (aref string 0))) - string) - (t string) - )) - -(defun cmpl-merge-string-cases (string-to-coerce given-string) - (let ((string-case-type (cmpl-string-case-type string-to-coerce)) - ) - (cond ((memq string-case-type '(:down :up :capitalized)) - ;; Found string is in a standard case. Coerce to a type based on - ;; the given string - (cmpl-coerce-string-case string-to-coerce - (cmpl-string-case-type given-string)) - ) - (t - ;; If the found string is in some unusual case, just insert it - ;; as is - string-to-coerce) - ))) - -;;; Tests - -;;; (cmpl-merge-string-cases "AbCdEf456" "abc") --> AbCdEf456 -;;; (cmpl-merge-string-cases "abcdef456" "ABC") --> ABCDEF456 -;;; (cmpl-merge-string-cases "ABCDEF456" "Abc") --> Abcdef456 -;;; (cmpl-merge-string-cases "ABCDEF456" "abc") --> abcdef456 - - -(defun cmpl-hours-since-origin () - (let ((time (current-time))) - (truncate - (+ (* (/ (car time) 3600.0) (lsh 1 16)) - (/ (nth 2 time) 3600.0))))) - -;;;--------------------------------------------------------------------------- -;;; "Symbol" parsing functions -;;;--------------------------------------------------------------------------- -;;; The functions symbol-before-point, symbol-under-point, etc. quickly return -;;; an appropriate symbol string. The strategy is to temporarily change -;;; the syntax table to enable fast symbol searching. There are three classes -;;; of syntax in these "symbol" syntax tables :: -;;; -;;; syntax (?_) - "symbol" chars (e.g. alphanumerics) -;;; syntax (?w) - symbol chars to ignore at end of words (e.g. period). -;;; syntax (? ) - everything else -;;; -;;; Thus by judicious use of scan-sexps and forward-word, we can get -;;; the word we want relatively fast and without consing. -;;; -;;; Why do we need a separate category for "symbol chars to ignore at ends" ? -;;; For example, in LISP we want starting :'s trimmed -;;; so keyword argument specifiers also define the keyword completion. And, -;;; for example, in C we want `.' appearing in a structure ref. to -;;; be kept intact in order to store the whole structure ref.; however, if -;;; it appears at the end of a symbol it should be discarded because it is -;;; probably used as a period. - -;;; Here is the default completion syntax :: -;;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > % -;;; Symbol chars to ignore at ends :: _ : . - -;;; Separator chars. :: ! ^ & ( ) = ` | { } [ ] ; " ' # -;;; , ? - -;;; Mode specific differences and notes :: -;;; LISP diffs -> -;;; Symbol chars :: ! & ? = ^ -;;; -;;; C diffs -> -;;; Separator chars :: + * / : % -;;; A note on the hyphen (`-'). Perhaps the hyphen should also be a separator -;;; char., however, we wanted to have completion symbols include pointer -;;; references. For example, "foo->bar" is a symbol as far as completion is -;;; concerned. -;;; -;;; FORTRAN diffs -> -;;; Separator chars :: + - * / : -;;; -;;; Pathname diffs -> -;;; Symbol chars :: . -;;; Of course there is no pathname "mode" and in fact we have not implemented -;;; this table. However, if there was such a mode, this is what it would look -;;; like. - -;;;----------------------------------------------- -;;; Table definitions -;;;----------------------------------------------- - -(defun cmpl-make-standard-completion-syntax-table () - (let ((table (make-syntax-table)) ;; default syntax is whitespace - i) - ;; alpha chars - (setq i 0) - (while (< i 26) - (modify-syntax-entry (+ ?a i) "_" table) - (modify-syntax-entry (+ ?A i) "_" table) - (setq i (1+ i))) - ;; digit chars. - (setq i 0) - (while (< i 10) - (modify-syntax-entry (+ ?0 i) "_" table) - (setq i (1+ i))) - ;; Other ones - (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%)) - (symbol-chars-ignore '(?_ ?- ?: ?.)) - ) - (completion-dolist (char symbol-chars) - (modify-syntax-entry char "_" table)) - (completion-dolist (char symbol-chars-ignore) - (modify-syntax-entry char "w" table) - ) - ) - table)) - -(defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table)) - -(defun cmpl-make-lisp-completion-syntax-table () - (let ((table (copy-syntax-table cmpl-standard-syntax-table)) - (symbol-chars '(?! ?& ?? ?= ?^)) - ) - (completion-dolist (char symbol-chars) - (modify-syntax-entry char "_" table)) - table)) - -(defun cmpl-make-c-completion-syntax-table () - (let ((table (copy-syntax-table cmpl-standard-syntax-table)) - (separator-chars '(?+ ?* ?/ ?: ?%)) - ) - (completion-dolist (char separator-chars) - (modify-syntax-entry char " " table)) - table)) - -(defun cmpl-make-fortran-completion-syntax-table () - (let ((table (copy-syntax-table cmpl-standard-syntax-table)) - (separator-chars '(?+ ?- ?* ?/ ?:)) - ) - (completion-dolist (char separator-chars) - (modify-syntax-entry char " " table)) - table)) - -(defconst cmpl-lisp-syntax-table (cmpl-make-lisp-completion-syntax-table)) -(defconst cmpl-c-syntax-table (cmpl-make-c-completion-syntax-table)) -(defconst cmpl-fortran-syntax-table (cmpl-make-fortran-completion-syntax-table)) - -(defvar cmpl-syntax-table cmpl-standard-syntax-table - "This variable holds the current completion syntax table.") -(make-variable-buffer-local 'cmpl-syntax-table) - -;;----------------------------------------------- -;; Installing the appropriate mode tables -;;----------------------------------------------- - -(add-hook 'lisp-mode-hook - '(lambda () - (setq cmpl-syntax-table cmpl-lisp-syntax-table))) - -(add-hook 'c-mode-hook - '(lambda () - (setq cmpl-syntax-table cmpl-c-syntax-table))) - -(add-hook 'fortran-mode-hook - '(lambda () - (setq cmpl-syntax-table cmpl-fortran-syntax-table) - (completion-setup-fortran-mode))) - -;;----------------------------------------------- -;; Symbol functions -;;----------------------------------------------- -(defvar cmpl-symbol-start nil - "Holds first character of symbol, after any completion symbol function.") -(defvar cmpl-symbol-end nil - "Holds last character of symbol, after any completion symbol function.") -;; These are temp. vars. we use to avoid using let. -;; Why ? Small speed improvement. -;; sjt sez: `let' overhead no longer matters in a command. -(defvar cmpl-saved-syntax nil) -(defvar cmpl-saved-point nil) - -(defun symbol-under-point () - "Returns the symbol that the point is currently on. -But only if it is longer than `completion-min-length'." - (setq cmpl-saved-syntax (syntax-table)) - (unwind-protect - ;; Don't let local syntax tables override completion's. - (let ((lookup-syntax-properties nil)) - (set-syntax-table cmpl-syntax-table) - (cond - ;; Cursor is on following-char and after preceding-char - ((memq (char-syntax (following-char)) '(?w ?_)) - (setq cmpl-saved-point (point) - cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1) - cmpl-symbol-end (scan-sexps cmpl-saved-point 1)) - ;; Remove chars to ignore at the start. - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - (goto-char cmpl-saved-point) - )) - ;; Remove chars to ignore at the end. - (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) - (goto-char cmpl-symbol-end) - (forward-word -1) - (setq cmpl-symbol-end (point)) - (goto-char cmpl-saved-point) - )) - ;; Return completion if the length is reasonable. - (if (and (<= (cmpl-read-time-eval completion-min-length) - (- cmpl-symbol-end cmpl-symbol-start)) - (<= (- cmpl-symbol-end cmpl-symbol-start) - (cmpl-read-time-eval completion-max-length))) - (buffer-substring cmpl-symbol-start cmpl-symbol-end))))) - (set-syntax-table cmpl-saved-syntax))) - -;; tests for symbol-under-point -;; `^' indicates cursor pos. where value is returned -;; simple-word-test -;; ^^^^^^^^^^^^^^^^ --> simple-word-test -;; _harder_word_test_ -;; ^^^^^^^^^^^^^^^^^^ --> harder_word_test -;; .___.______. -;; --> nil -;; /foo/bar/quux.hello -;; ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello -;; - -(defun symbol-before-point () - "Returns a string of the symbol immediately before point. -Returns nil if there isn't one longer than `completion-min-length'." - ;; This is called when a word separator is typed so it must be FAST ! - (setq cmpl-saved-syntax (syntax-table)) - (unwind-protect - ;; Don't let local syntax tables override completion's. - (let ((lookup-syntax-properties nil)) - (set-syntax-table cmpl-syntax-table) - ;; Cursor is on following-char and after preceding-char - (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_) - ;; Number of chars to ignore at end. - (setq cmpl-symbol-end (point) - cmpl-symbol-start (scan-sexps cmpl-symbol-end -1) - ) - ;; Remove chars to ignore at the start. - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - (goto-char cmpl-symbol-end) - )) - ;; Return value if long enough. - (if (>= cmpl-symbol-end - (+ cmpl-symbol-start - (cmpl-read-time-eval completion-min-length))) - (buffer-substring cmpl-symbol-start cmpl-symbol-end)) - ) - ((= cmpl-preceding-syntax ?w) - ;; chars to ignore at end - (setq cmpl-saved-point (point) - cmpl-symbol-start (scan-sexps cmpl-saved-point -1)) - ;; take off chars. from end - (forward-word -1) - (setq cmpl-symbol-end (point)) - ;; remove chars to ignore at the start - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - )) - ;; Restore state. - (goto-char cmpl-saved-point) - ;; Return completion if the length is reasonable - (if (and (<= (cmpl-read-time-eval completion-min-length) - (- cmpl-symbol-end cmpl-symbol-start)) - (<= (- cmpl-symbol-end cmpl-symbol-start) - (cmpl-read-time-eval completion-max-length))) - (buffer-substring cmpl-symbol-start cmpl-symbol-end))))) - (set-syntax-table cmpl-saved-syntax))) - -;; tests for symbol-before-point -;; `^' indicates cursor pos. where value is returned -;; simple-word-test -;; ^ --> nil -;; ^ --> nil -;; ^ --> simple-w -;; ^ --> simple-word-test -;; _harder_word_test_ -;; ^ --> harder_word_test -;; ^ --> harder_word_test -;; ^ --> harder -;; .___.... -;; --> nil - -(defun symbol-under-or-before-point () - ;; This could be made slightly faster but it is better to avoid - ;; copying all the code. - ;; However, it is only used by the completion string prompter. - ;; If it comes into common use, it could be rewritten. - (cond ((memq (progn - (setq cmpl-saved-syntax (syntax-table)) - (unwind-protect - (let ((lookup-syntax-properties nil)) - (set-syntax-table cmpl-syntax-table) - (char-syntax (following-char))) - (set-syntax-table cmpl-saved-syntax))) - '(?w ?_)) - (symbol-under-point)) - (t - (symbol-before-point)))) - -(defun symbol-before-point-for-complete () - ;; "Returns a string of the symbol immediately before point - ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the - ;; end chars." - ;; Cursor is on following-char and after preceding-char - (setq cmpl-saved-syntax (syntax-table)) - (unwind-protect - (let ((lookup-syntax-properties nil)) - (set-syntax-table cmpl-syntax-table) - (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char))) - '(?_ ?w)) - (setq cmpl-symbol-end (point) - cmpl-symbol-start (scan-sexps cmpl-symbol-end -1) - ) - ;; Remove chars to ignore at the start. - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - (goto-char cmpl-symbol-end) - )) - ;; Return completion if the length is reasonable. - (if (and (<= (cmpl-read-time-eval - completion-prefix-min-length) - (- cmpl-symbol-end cmpl-symbol-start)) - (<= (- cmpl-symbol-end cmpl-symbol-start) - (cmpl-read-time-eval completion-max-length))) - (buffer-substring cmpl-symbol-start cmpl-symbol-end))))) - ;; Restore syntax table. - (set-syntax-table cmpl-saved-syntax))) - -;; tests for symbol-before-point-for-complete -;; `^' indicates cursor pos. where value is returned -;; simple-word-test -;; ^ --> nil -;; ^ --> nil -;; ^ --> simple-w -;; ^ --> simple-word-test -;; _harder_word_test_ -;; ^ --> harder_word_test -;; ^ --> harder_word_test_ -;; ^ --> harder_ -;; .___.... -;; --> nil - - - -;;--------------------------------------------------------------------------- -;; Statistics Recording -;;--------------------------------------------------------------------------- - -;; Note that the guts of this has been turned off. The guts -;; are in completion-stats.el. - -;;----------------------------------------------- -;; Conditionalizing code on *record-cmpl-statistics-p* -;;----------------------------------------------- -;; All statistics code outside this block should use this -(defmacro cmpl-statistics-block (&rest body)) -;; "Only executes body if we are recording statistics." -;; (list 'cond -;; (list* '*record-cmpl-statistics-p* body) -;; )) - -;;----------------------------------------------- -;; Completion Sources -;;----------------------------------------------- - -;; ID numbers -(defconst cmpl-source-unknown 0) -(defconst cmpl-source-init-file 1) -(defconst cmpl-source-file-parsing 2) -(defconst cmpl-source-separator 3) -(defconst cmpl-source-cursor-moves 4) -(defconst cmpl-source-interactive 5) -(defconst cmpl-source-cdabbrev 6) -(defconst num-cmpl-sources 7) -(defvar current-completion-source cmpl-source-unknown) - - - -;;--------------------------------------------------------------------------- -;; Completion Method #2: dabbrev-expand style -;;--------------------------------------------------------------------------- -;; -;; This method is used if there are no useful stored completions. It is -;; based on dabbrev-expand with these differences : -;; 1) Faster (we don't use regexps) -;; 2) case coercion handled correctly -;; This is called cdabbrev to differentiate it. -;; We simply search backwards through the file looking for words which -;; start with the same letters we are trying to complete. -;; - -(defvar cdabbrev-completions-tried nil) -;; "A list of all the cdabbrev completions since the last reset.") - -(defvar cdabbrev-current-point 0) -;; "The current point position the cdabbrev search is at.") - -(defvar cdabbrev-current-window nil) -;; "The current window we are looking for cdabbrevs in. T if looking in -;; (other-buffer), NIL if no more cdabbrevs.") - -(defvar cdabbrev-wrapped-p nil) -;; "T if the cdabbrev search has wrapped around the file.") - -(defvar cdabbrev-abbrev-string "") -(defvar cdabbrev-start-point 0) -(defvar cdabbrev-stop-point) - -;; Test strings for cdabbrev -;; cdat-upcase ;;same namestring -;; CDAT-UPCASE ;;ok -;; cdat2 ;;too short -;; cdat-1-2-3-4 ;;ok -;; a-cdat-1 ;;doesn't start correctly -;; cdat-simple ;;ok - - -(defun reset-cdabbrev (abbrev-string &optional initial-completions-tried) - "Resets the cdabbrev search to search for abbrev-string. -INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore -during the search." - (setq cdabbrev-abbrev-string abbrev-string - cdabbrev-completions-tried - (cons (downcase abbrev-string) initial-completions-tried) - ) - (reset-cdabbrev-window t) - ) - -(defun set-cdabbrev-buffer () - ;; cdabbrev-current-window must not be NIL - (set-buffer (if (eq cdabbrev-current-window t) - (other-buffer) - (window-buffer cdabbrev-current-window))) - ) - - -(defun reset-cdabbrev-window (&optional initializep) - "Resets the cdabbrev search to search for abbrev-string." - ;; Set the window - (cond (initializep - (setq cdabbrev-current-window (selected-window)) - ) - ((eq cdabbrev-current-window t) - ;; Everything has failed - (setq cdabbrev-current-window nil)) - (cdabbrev-current-window - (setq cdabbrev-current-window (next-window cdabbrev-current-window)) - (if (eq cdabbrev-current-window (selected-window)) - ;; No more windows, try other buffer. - (setq cdabbrev-current-window t))) - ) - (if cdabbrev-current-window - (save-excursion - (set-cdabbrev-buffer) - (setq cdabbrev-current-point (point) - cdabbrev-start-point cdabbrev-current-point - cdabbrev-stop-point - (if completion-search-distance - (max (point-min) - (- cdabbrev-start-point completion-search-distance)) - (point-min)) - cdabbrev-wrapped-p nil) - ))) - -(defun next-cdabbrev () - "Return the next possible cdabbrev expansion or nil if there isn't one. -`reset-cdabbrev' must've been called already. -This is sensitive to `case-fold-search'." - ;; note that case-fold-search affects the behavior of this function - ;; Bug: won't pick up an expansion that starts at the top of buffer - (if cdabbrev-current-window - (let (saved-point - saved-syntax - (expansion nil) - downcase-expansion tried-list syntax saved-point-2) - (save-excursion - (unwind-protect - (let ((lookup-syntax-properties nil)) - ;; Switch to current completion buffer - (set-cdabbrev-buffer) - ;; Save current buffer state - (setq saved-point (point) - saved-syntax (syntax-table)) - ;; Restore completion state - (set-syntax-table cmpl-syntax-table) - (goto-char cdabbrev-current-point) - ;; Loop looking for completions - (while - ;; This code returns t if it should loop again - (cond - (;; search for the string - (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t) - ;; return nil if the completion is valid - (not - (and - ;; does it start with a separator char ? - (or (= (setq syntax (char-syntax (preceding-char))) ? ) - (and (= syntax ?w) - ;; symbol char to ignore at end. Are we at end ? - (progn - (setq saved-point-2 (point)) - (forward-word -1) - (prog1 - (= (char-syntax (preceding-char)) ? ) - (goto-char saved-point-2) - )))) - ;; is the symbol long enough ? - (setq expansion (symbol-under-point)) - ;; have we not tried this one before - (progn - ;; See if we've already used it - (setq tried-list cdabbrev-completions-tried - downcase-expansion (downcase expansion)) - (while (and tried-list - (not (string-equal downcase-expansion - (car tried-list)))) - ;; Already tried, don't choose this one - (setq tried-list (cdr tried-list)) - ) - ;; at this point tried-list will be nil if this - ;; expansion has not yet been tried - (if tried-list - (setq expansion nil) - t) - )))) - ;; search failed - (cdabbrev-wrapped-p - ;; If already wrapped, then we've failed completely - nil) - (t - ;; need to wrap - (goto-char (setq cdabbrev-current-point - (if completion-search-distance - (min (point-max) (+ cdabbrev-start-point completion-search-distance)) - (point-max)))) - - (setq cdabbrev-wrapped-p t)) - )) - ;; end of while loop - (cond (expansion - ;; successful - (setq cdabbrev-completions-tried - (cons downcase-expansion cdabbrev-completions-tried) - cdabbrev-current-point (point)))) - ) - (set-syntax-table saved-syntax) - (goto-char saved-point) - )) - ;; If no expansion, go to next window - (cond (expansion) - (t (reset-cdabbrev-window) - (next-cdabbrev)))))) - -;; The following must be eval'd in the minibuffer :: -;; (reset-cdabbrev "cdat") -;; (next-cdabbrev) --> "cdat-simple" -;; (next-cdabbrev) --> "cdat-1-2-3-4" -;; (next-cdabbrev) --> "CDAT-UPCASE" -;; (next-cdabbrev) --> "cdat-wrapping" -;; (next-cdabbrev) --> "cdat_start_sym" -;; (next-cdabbrev) --> nil -;; (next-cdabbrev) --> nil -;; (next-cdabbrev) --> nil - -;; _cdat_start_sym -;; cdat-wrapping - - -;;--------------------------------------------------------------------------- -;; Completion Database -;;--------------------------------------------------------------------------- - -;; We use two storage modes for the two search types :: -;; 1) Prefix {cmpl-prefix-obarray} for looking up possible completions -;; Used by search-completion-next -;; the value of the symbol is nil or a cons of head and tail pointers -;; 2) Interning {cmpl-obarray} to see if it's in the database -;; Used by find-exact-completion, completion-in-database-p -;; The value of the symbol is the completion entry - -;; bad things may happen if this length is changed due to the way -;; GNU implements obarrays -(defconst cmpl-obarray-length 511) - -(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0) - "An obarray used to store the downcased completion prefixes. -Each symbol is bound to a list of completion entries.") - -(defvar cmpl-obarray (make-vector cmpl-obarray-length 0) - "An obarray used to store the downcased completions. -Each symbol is bound to a single completion entry.") - -;;----------------------------------------------- -;; Completion Entry Structure Definition -;;----------------------------------------------- - -;; A completion entry is a LIST of string, prefix-symbol num-uses, and -;; last-use-time (the time the completion was last used) -;; last-use-time is T if the string should be kept permanently -;; num-uses is incremented every time the completion is used. - -;; We chose lists because (car foo) is faster than (aref foo 0) and the -;; creation time is about the same. - -;; READER MACROS - -(defmacro completion-string (completion-entry) - (list 'car completion-entry)) - -(defmacro completion-num-uses (completion-entry) - ;; "The number of times it has used. Used to decide whether to save - ;; it." - (list 'car (list 'cdr completion-entry))) - -(defmacro completion-last-use-time (completion-entry) - ;; "The time it was last used. In hours since origin. Used to decide - ;; whether to save it. T if one should always save it." - (list 'nth 2 completion-entry)) - -(defmacro completion-source (completion-entry) - (list 'nth 3 completion-entry)) - -;; WRITER MACROS -(defmacro set-completion-string (completion-entry string) - (list 'setcar completion-entry string)) - -(defmacro set-completion-num-uses (completion-entry num-uses) - (list 'setcar (list 'cdr completion-entry) num-uses)) - -(defmacro set-completion-last-use-time (completion-entry last-use-time) - (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time)) - -;; CONSTRUCTOR -(defun make-completion (string) - "Returns a list of a completion entry." - (list (list string 0 nil current-completion-source))) - -;; Obsolete -;;(defmacro cmpl-prefix-entry-symbol (completion-entry) -;; (list 'car (list 'cdr completion-entry))) - - - -;;----------------------------------------------- -;; Prefix symbol entry definition -;;----------------------------------------------- -;; A cons of (head . tail) - -;; READER Macros - -(defmacro cmpl-prefix-entry-head (prefix-entry) - (list 'car prefix-entry)) - -(defmacro cmpl-prefix-entry-tail (prefix-entry) - (list 'cdr prefix-entry)) - -;; WRITER Macros - -(defmacro set-cmpl-prefix-entry-head (prefix-entry new-head) - (list 'setcar prefix-entry new-head)) - -(defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail) - (list 'setcdr prefix-entry new-tail)) - -;; Constructor - -(defun make-cmpl-prefix-entry (completion-entry-list) - "Makes a new prefix entry containing only completion-entry." - (cons completion-entry-list completion-entry-list)) - -;;----------------------------------------------- -;; Completion Database - Utilities -;;----------------------------------------------- - -(defun clear-all-completions () - "Initializes the completion storage. All existing completions are lost." - (interactive) - (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)) - (setq cmpl-obarray (make-vector cmpl-obarray-length 0)) - (cmpl-statistics-block - (record-clear-all-completions)) - ) - -(defvar completions-list-return-value) - -(defun list-all-completions () - "Returns a list of all the known completion entries." - (let ((completions-list-return-value nil)) - (mapatoms 'list-all-completions-1 cmpl-prefix-obarray) - completions-list-return-value)) - -(defun list-all-completions-1 (prefix-symbol) - (if (boundp prefix-symbol) - (setq completions-list-return-value - (append (cmpl-prefix-entry-head (symbol-value prefix-symbol)) - completions-list-return-value)))) - -(defun list-all-completions-by-hash-bucket () - "Return list of lists of known completion entries, organized by hash bucket." - (let ((completions-list-return-value nil)) - (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray) - completions-list-return-value)) - -(defun list-all-completions-by-hash-bucket-1 (prefix-symbol) - (if (boundp prefix-symbol) - (setq completions-list-return-value - (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol)) - completions-list-return-value)))) - - -;;----------------------------------------------- -;; Updating the database -;;----------------------------------------------- -;; -;; These are the internal functions used to update the datebase -;; -;; -(defvar completion-to-accept nil) - ;;"Set to a string that is pending its acceptance." - ;; this checked by the top level reading functions - -(defvar cmpl-db-downcase-string nil) - ;; "Setup by find-exact-completion, etc. The given string, downcased." -(defvar cmpl-db-symbol nil) - ;; "The interned symbol corresponding to cmpl-db-downcase-string. - ;; Set up by cmpl-db-symbol." -(defvar cmpl-db-prefix-symbol nil) - ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string." -(defvar cmpl-db-entry nil) -(defvar cmpl-db-debug-p nil - "Set to T if you want to debug the database.") - -;; READS -(defun find-exact-completion (string) - "Returns the completion entry for string or nil. -Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'." - (and (boundp (setq cmpl-db-symbol - (intern (setq cmpl-db-downcase-string (downcase string)) - cmpl-obarray))) - (symbol-value cmpl-db-symbol) - )) - -(defun find-cmpl-prefix-entry (prefix-string) - "Returns the prefix entry for string. -Sets `cmpl-db-prefix-symbol'. -Prefix-string must be exactly `completion-prefix-min-length' long -and downcased. Sets up `cmpl-db-prefix-symbol'." - (and (boundp (setq cmpl-db-prefix-symbol - (intern prefix-string cmpl-prefix-obarray))) - (symbol-value cmpl-db-prefix-symbol))) - -(defvar inside-locate-completion-entry nil) -;; used to trap lossage in silent error correction - -(defun locate-completion-entry (completion-entry prefix-entry) - "Locates the completion entry. -Returns a pointer to the element before the completion entry or nil if -the completion entry is at the head. -Must be called after `find-exact-completion'." - (let ((prefix-list (cmpl-prefix-entry-head prefix-entry)) - next-prefix-list - ) - (cond - ((not (eq (car prefix-list) completion-entry)) - ;; not already at head - (while (and prefix-list - (not (eq completion-entry - (car (setq next-prefix-list (cdr prefix-list))) - ))) - (setq prefix-list next-prefix-list)) - (cond (;; found - prefix-list) - ;; Didn't find it. Database is messed up. - (cmpl-db-debug-p - ;; not found, error if debug mode - (error "Completion entry exists but not on prefix list - %s" - completion-string)) - (inside-locate-completion-entry - ;; recursive error: really scrod - (locate-completion-db-error)) - (t - ;; Patch out - (set cmpl-db-symbol nil) - ;; Retry - (locate-completion-entry-retry completion-entry) - )))))) - -(defun locate-completion-entry-retry (old-entry) - (let ((inside-locate-completion-entry t)) - (add-completion (completion-string old-entry) - (completion-num-uses old-entry) - (completion-last-use-time old-entry)) - (let* ((cmpl-entry (find-exact-completion (completion-string old-entry))) - (pref-entry - (if cmpl-entry - (find-cmpl-prefix-entry - (substring cmpl-db-downcase-string - 0 completion-prefix-min-length)))) - ) - (if (and cmpl-entry pref-entry) - ;; try again - (locate-completion-entry cmpl-entry pref-entry) - ;; still losing - (locate-completion-db-error)) - ))) - -(defun locate-completion-db-error () - ;; recursive error: really scrod - (error "Completion database corrupted. Try M-x clear-all-completions. Send bug report.") - ) - -;; WRITES -(defun add-completion-to-tail-if-new (string) - "If STRING is not in the database add it to appropriate prefix list. -STRING is added to the end of the appropriate prefix list with -num-uses = 0. The database is unchanged if it is there. STRING must be -longer than `completion-prefix-min-length'. -This must be very fast. -Returns the completion entry." - (or (find-exact-completion string) - ;; not there - (let (;; create an entry - (entry (make-completion string)) - ;; setup the prefix - (prefix-entry (find-cmpl-prefix-entry - (substring cmpl-db-downcase-string 0 - (cmpl-read-time-eval - completion-prefix-min-length)))) - ) - ;; The next two forms should happen as a unit (atomically) but - ;; no fatal errors should result if that is not the case. - (cond (prefix-entry - ;; These two should be atomic, but nothing fatal will happen - ;; if they're not. - (setcdr (cmpl-prefix-entry-tail prefix-entry) entry) - (set-cmpl-prefix-entry-tail prefix-entry entry)) - (t - (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)) - )) - ;; statistics - (cmpl-statistics-block - (note-added-completion)) - ;; set symbol - (set cmpl-db-symbol (car entry)) - ))) - -(defun add-completion-to-head (completion-string) - "If COMPLETION-STRING is not in the database, add it to prefix list. -We add COMPLETION-STRING to the head of the appropriate prefix list, -or it to the head of the list. -COMPLETION-STRING must be longer than `completion-prefix-min-length'. -Updates the saved string with the supplied string. -This must be very fast. -Returns the completion entry." - ;; Handle pending acceptance - (if completion-to-accept (accept-completion)) - ;; test if already in database - (if (setq cmpl-db-entry (find-exact-completion completion-string)) - ;; found - (let* ((prefix-entry (find-cmpl-prefix-entry - (substring cmpl-db-downcase-string 0 - (cmpl-read-time-eval - completion-prefix-min-length)))) - (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) - (cmpl-ptr (cdr splice-ptr)) - ) - ;; update entry - (set-completion-string cmpl-db-entry completion-string) - ;; move to head (if necessary) - (cond (splice-ptr - ;; These should all execute atomically but it is not fatal if - ;; they don't. - ;; splice it out - (or (setcdr splice-ptr (cdr cmpl-ptr)) - ;; fix up tail if necessary - (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) - ;; splice in at head - (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry)) - (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr) - )) - cmpl-db-entry) - ;; not there - (let (;; create an entry - (entry (make-completion completion-string)) - ;; setup the prefix - (prefix-entry (find-cmpl-prefix-entry - (substring cmpl-db-downcase-string 0 - (cmpl-read-time-eval - completion-prefix-min-length)))) - ) - (cond (prefix-entry - ;; Splice in at head - (setcdr entry (cmpl-prefix-entry-head prefix-entry)) - (set-cmpl-prefix-entry-head prefix-entry entry)) - (t - ;; Start new prefix entry - (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry)) - )) - ;; statistics - (cmpl-statistics-block - (note-added-completion)) - ;; Add it to the symbol - (set cmpl-db-symbol (car entry)) - ))) - -(defun delete-completion (completion-string) - "Deletes the completion from the database. -String must be longer than `completion-prefix-min-length'." - ;; Handle pending acceptance - (if completion-to-accept (accept-completion)) - (if (setq cmpl-db-entry (find-exact-completion completion-string)) - ;; found - (let* ((prefix-entry (find-cmpl-prefix-entry - (substring cmpl-db-downcase-string 0 - (cmpl-read-time-eval - completion-prefix-min-length)))) - (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)) - ) - ;; delete symbol reference - (set cmpl-db-symbol nil) - ;; remove from prefix list - (cond (splice-ptr - ;; not at head - (or (setcdr splice-ptr (cdr (cdr splice-ptr))) - ;; fix up tail if necessary - (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)) - ) - (t - ;; at head - (or (set-cmpl-prefix-entry-head - prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry))) - ;; List is now empty - (set cmpl-db-prefix-symbol nil)) - )) - (cmpl-statistics-block - (note-completion-deleted)) - ) - (error "Unknown completion `%s'" completion-string) - )) - -;; Tests -- -;; - Add and Find - -;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) -;; (find-exact-completion "banana") --> ("banana" 0 nil 0) -;; (find-exact-completion "bana") --> nil -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (add-completion-to-head "banish") --> ("banish" 0 nil 0) -;; (find-exact-completion "banish") --> ("banish" 0 nil 0) -;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (add-completion-to-head "banana") --> ("banana" 0 nil 0) -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) -;; -;; - Deleting - -;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) -;; (delete-completion "banner") -;; (find-exact-completion "banner") --> nil -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) -;; (add-completion-to-head "banner") --> ("banner" 0 nil 0) -;; (delete-completion "banana") -;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banish" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banish" ...)) -;; (delete-completion "banner") -;; (delete-completion "banish") -;; (find-cmpl-prefix-entry "ban") --> nil -;; (delete-completion "banner") --> error -;; -;; - Tail - -;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0) -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) --> (("banana" ...)) -;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0) -;; (car (find-cmpl-prefix-entry "ban")) -->(("banana" ...) ("banish" ...)) -;; (cdr (find-cmpl-prefix-entry "ban")) -->(("banish" ...)) -;; - - -;;--------------------------------------------------------------------------- -;; Database Update :: Interface level routines -;;--------------------------------------------------------------------------- -;; -;; These lie on top of the database ref. functions but below the standard -;; user interface level - - -(defun interactive-completion-string-reader (prompt) - (let* ((default (symbol-under-or-before-point)) - (new-prompt - (if default - (format "%s: (default: %s) " prompt default) - (format "%s: " prompt)) - ) - (read (completing-read new-prompt cmpl-obarray)) - ) - (if (zerop (length read)) (setq read (or default ""))) - (list read) - )) - -(defun check-completion-length (string) - (if (< (length string) completion-min-length) - (error "The string `%s' is too short to be saved as a completion" - string) - (list string))) - -(defun add-completion (string &optional num-uses last-use-time) - "Add STRING to completion list, or move it to head of list. -The completion is altered appropriately if num-uses and/or last-use-time is -specified." - (interactive (interactive-completion-string-reader "Completion to add")) - (check-completion-length string) - (let* ((current-completion-source (if (interactive-p) - cmpl-source-interactive - current-completion-source)) - (entry (add-completion-to-head string))) - - (if num-uses (set-completion-num-uses entry num-uses)) - (if last-use-time - (set-completion-last-use-time entry last-use-time)) - )) - -(defun add-permanent-completion (string) - "Add STRING if it isn't already listed, and mark it permanent." - (interactive - (interactive-completion-string-reader "Completion to add permanently")) - (let ((current-completion-source (if (interactive-p) - cmpl-source-interactive - current-completion-source)) - ) - (add-completion string nil t) - )) - -(defun kill-completion (string) - (interactive (interactive-completion-string-reader "Completion to kill")) - (check-completion-length string) - (delete-completion string) - ) - -(defun accept-completion () - "Accepts the pending completion in `completion-to-accept'. -This bumps num-uses. Called by `add-completion-to-head' and -`completion-search-reset'." - (let ((string completion-to-accept) - ;; if this is added afresh here, then it must be a cdabbrev - (current-completion-source cmpl-source-cdabbrev) - entry - ) - (setq completion-to-accept nil) - (setq entry (add-completion-to-head string)) - (set-completion-num-uses entry (1+ (completion-num-uses entry))) - (setq cmpl-completions-accepted-p t) - )) - -(defun use-completion-under-point () - "Add the completion symbol underneath the point into the completion buffer." - (let ((string (and enable-completion (symbol-under-point))) - (current-completion-source cmpl-source-cursor-moves)) - (if string (add-completion-to-head string)))) - -(defun use-completion-before-point () - "Add the completion symbol before point into the completion buffer." - (let ((string (and enable-completion (symbol-before-point))) - (current-completion-source cmpl-source-cursor-moves)) - (if string (add-completion-to-head string)))) - -(defun use-completion-under-or-before-point () - "Add the completion symbol before point into the completion buffer." - (let ((string (and enable-completion (symbol-under-or-before-point))) - (current-completion-source cmpl-source-cursor-moves)) - (if string (add-completion-to-head string)))) - -(defun use-completion-before-separator () - "Add the completion symbol before point into the completion buffer. -Completions added this way will automatically be saved if -`completion-on-separator-character' is non-nil." - (let ((string (and enable-completion (symbol-before-point))) - (current-completion-source cmpl-source-separator) - entry) - (cmpl-statistics-block - (note-separator-character string) - ) - (cond (string - (setq entry (add-completion-to-head string)) - (if (and completion-on-separator-character - (zerop (completion-num-uses entry))) - (progn - (set-completion-num-uses entry 1) - (setq cmpl-completions-accepted-p t))))) - )) - -;; Tests -- -;; - Add and Find - -;; (add-completion "banana" 5 10) -;; (find-exact-completion "banana") --> ("banana" 5 10 0) -;; (add-completion "banana" 6) -;; (find-exact-completion "banana") --> ("banana" 6 10 0) -;; (add-completion "banish") -;; (car (find-cmpl-prefix-entry "ban")) --> (("banish" ...) ("banana" ...)) -;; -;; - Accepting - -;; (setq completion-to-accept "banana") -;; (accept-completion) -;; (find-exact-completion "banana") --> ("banana" 7 10) -;; (car (find-cmpl-prefix-entry "ban")) --> (("banana" ...) ("banish" ...)) -;; (setq completion-to-accept "banish") -;; (add-completion "banner") -;; (car (find-cmpl-prefix-entry "ban")) -;; --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...)) -;; -;; - Deleting - -;; (kill-completion "banish") -;; (car (find-cmpl-prefix-entry "ban")) --> (("banner" ...) ("banana" ...)) - - -;;--------------------------------------------------------------------------- -;; Searching the database -;;--------------------------------------------------------------------------- -;; Functions outside this block must call completion-search-reset followed -;; by calls to completion-search-next or completion-search-peek -;; - -;; Status variables -;; Commented out to improve loading speed -(defvar cmpl-test-string "") -;; "The current string used by completion-search-next." -(defvar cmpl-test-regexp "") -;; "The current regexp used by completion-search-next. -;; (derived from cmpl-test-string)" -(defvar cmpl-last-index 0) -;; "The last index that completion-search-next was called with." -(defvar cmpl-cdabbrev-reset-p nil) -;; "Set to t when cdabbrevs have been reset." -(defvar cmpl-next-possibilities nil) -;; "A pointer to the element BEFORE the next set of possible completions. -;; cadr of this is the cmpl-next-possibility" -(defvar cmpl-starting-possibilities nil) -;; "The initial list of starting possibilities." -(defvar cmpl-next-possibility nil) -;; "The cached next possibility." -(defvar cmpl-tried-list nil) -;; "A downcased list of all the completions we have tried." - - -(defun completion-search-reset (string) - "Set up the for completion searching for STRING. -STRING must be longer than `completion-prefix-min-length'." - (if completion-to-accept (accept-completion)) - (setq cmpl-starting-possibilities - (cmpl-prefix-entry-head - (find-cmpl-prefix-entry - (downcase (substring string 0 completion-prefix-min-length)))) - cmpl-test-string string - cmpl-test-regexp (concat (regexp-quote string) ".")) - (completion-search-reset-1) - ) - -(defun completion-search-reset-1 () - (setq cmpl-next-possibilities cmpl-starting-possibilities - cmpl-next-possibility nil - cmpl-cdabbrev-reset-p nil - cmpl-last-index -1 - cmpl-tried-list nil - )) - -(defun completion-search-next (index) - "Return the next completion entry. -If INDEX is out of sequence, reset and start from the top. -If there are no more entries, try cdabbrev and returns only a string." - (cond - ((= index (setq cmpl-last-index (1+ cmpl-last-index))) - (completion-search-peek t)) - ((< index 0) - (completion-search-reset-1) - (setq cmpl-last-index index) - ;; reverse the possibilities list - (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities)) - ;; do a "normal" search - (while (and (completion-search-peek nil) - (< (setq index (1+ index)) 0)) - (setq cmpl-next-possibility nil) - ) - (cond ((not cmpl-next-possibilities)) - ;; If no more possibilities, leave it that way - ((= -1 cmpl-last-index) - ;; next completion is at index 0. reset next-possibility list - ;; to start at beginning - (setq cmpl-next-possibilities cmpl-starting-possibilities)) - (t - ;; otherwise point to one before current - (setq cmpl-next-possibilities - (nthcdr (- (length cmpl-starting-possibilities) - (length cmpl-next-possibilities)) - cmpl-starting-possibilities)) - ))) - (t - ;; non-negative index, reset and search - ;;(prin1 'reset) - (completion-search-reset-1) - (setq cmpl-last-index index) - (while (and (completion-search-peek t) - (not (< (setq index (1- index)) 0))) - (setq cmpl-next-possibility nil) - )) - ) - (prog1 - cmpl-next-possibility - (setq cmpl-next-possibility nil) - )) - - -(defun completion-search-peek (use-cdabbrev) - "Returns the next completion entry without actually moving the pointers. -Calling this again or calling `completion-search-next' results in the same -string being returned. Depends on `case-fold-search'. -If there are no more entries, try cdabbrev and then return only a string." - (cond - ;; return the cached value if we have it - (cmpl-next-possibility) - ((and cmpl-next-possibilities - ;; still a few possibilities left - (progn - (while - (and (not (eq 0 (string-match cmpl-test-regexp - (completion-string (car cmpl-next-possibilities))))) - (setq cmpl-next-possibilities (cdr cmpl-next-possibilities)) - )) - cmpl-next-possibilities - )) - ;; successful match - (setq cmpl-next-possibility (car cmpl-next-possibilities) - cmpl-tried-list (cons (downcase (completion-string cmpl-next-possibility)) - cmpl-tried-list) - cmpl-next-possibilities (cdr cmpl-next-possibilities) - ) - cmpl-next-possibility) - (use-cdabbrev - ;; unsuccessful, use cdabbrev - (cond ((not cmpl-cdabbrev-reset-p) - (reset-cdabbrev cmpl-test-string cmpl-tried-list) - (setq cmpl-cdabbrev-reset-p t) - )) - (setq cmpl-next-possibility (next-cdabbrev)) - ) - ;; Completely unsuccessful, return nil - )) - -;; Tests -- -;; - Add and Find - -;; (add-completion "banana") -;; (completion-search-reset "ban") -;; (completion-search-next 0) --> "banana" -;; -;; - Discrimination - -;; (add-completion "cumberland") -;; (add-completion "cumberbund") -;; cumbering -;; (completion-search-reset "cumb") -;; (completion-search-peek t) --> "cumberbund" -;; (completion-search-next 0) --> "cumberbund" -;; (completion-search-peek t) --> "cumberland" -;; (completion-search-next 1) --> "cumberland" -;; (completion-search-peek nil) --> nil -;; (completion-search-next 2) --> "cumbering" {cdabbrev} -;; (completion-search-next 3) --> nil or "cumming"{depends on context} -;; (completion-search-next 1) --> "cumberland" -;; (completion-search-peek t) --> "cumbering" {cdabbrev} -;; -;; - Accepting - -;; (completion-search-next 1) --> "cumberland" -;; (setq completion-to-accept "cumberland") -;; (completion-search-reset "foo") -;; (completion-search-reset "cum") -;; (completion-search-next 0) --> "cumberland" -;; -;; - Deleting - -;; (kill-completion "cumberland") -;; cummings -;; (completion-search-reset "cum") -;; (completion-search-next 0) --> "cumberbund" -;; (completion-search-next 1) --> "cummings" -;; -;; - Ignoring Capitalization - -;; (completion-search-reset "CuMb") -;; (completion-search-next 0) --> "cumberbund" - - - -;;----------------------------------------------- -;; COMPLETE -;;----------------------------------------------- - -(defun completion-mode () - "Toggles whether or not to add new words to the completion database." - (interactive) - (setq enable-completion (not enable-completion)) - (message "Completion mode is now %s." (if enable-completion "ON" "OFF")) - ) - -(defvar cmpl-current-index 0) -(defvar cmpl-original-string nil) -(defvar cmpl-last-insert-location -1) -(defvar cmpl-leave-point-at-start nil) - -;;;###autoload -(defun complete (&optional arg) - "Fill out a completion of the word before point. -Point is left at end. Consecutive calls rotate through all possibilities. -Prefix args :: - control-u :: leave the point at the beginning of the completion rather - than at the end. - a number :: rotate through the possible completions by that amount - `-' :: same as -1 (insert previous completion) - {See the comments at the top of `completion.el' for more info.}" - (interactive "*p") - ;; Set up variables - (cond ((eq last-command this-command) - ;; Undo last one - (delete-region cmpl-last-insert-location (point)) - ;; get next completion - (setq cmpl-current-index (+ cmpl-current-index (or arg 1))) - ) - (t - (if (not cmpl-initialized-p) - (initialize-completions)) ;; make sure everything's loaded - (cond ((consp current-prefix-arg) ;; control-u - (setq arg 0) - (setq cmpl-leave-point-at-start t) - ) - (t - (setq cmpl-leave-point-at-start nil) - )) - ;; get string - (setq cmpl-original-string (symbol-before-point-for-complete)) - (cond ((not cmpl-original-string) - (setq this-command 'failed-complete) - (error "To complete, point must be after a symbol at least %d character long" - completion-prefix-min-length))) - ;; get index - (setq cmpl-current-index (if current-prefix-arg arg 0)) - ;; statistics - (cmpl-statistics-block - (note-complete-entered-afresh cmpl-original-string)) - ;; reset database - (completion-search-reset cmpl-original-string) - ;; erase what we've got - (delete-region cmpl-symbol-start cmpl-symbol-end) - )) - - ;; point is at the point to insert the new symbol - ;; Get the next completion - (let* ((print-status-p - ;; XEmacs change - (and (>= (device-baud-rate) completion-prompt-speed-threshold) - (not (minibuffer-window-selected-p)))) - (insert-point (point)) - (entry (completion-search-next cmpl-current-index)) - string - ) - ;; entry is either a completion entry or a string (if cdabbrev) - - ;; If found, insert - (cond (entry - ;; Setup for proper case - (setq string (if (stringp entry) - entry (completion-string entry))) - (setq string (cmpl-merge-string-cases - string cmpl-original-string)) - ;; insert - (insert string) - ;; accept it - (setq completion-to-accept string) - ;; fixup and cache point - (cond (cmpl-leave-point-at-start - (setq cmpl-last-insert-location (point)) - (goto-char insert-point)) - (t;; point at end, - (setq cmpl-last-insert-location insert-point)) - ) - ;; statistics - (cmpl-statistics-block - (note-complete-inserted entry cmpl-current-index)) - ;; Done ! cmpl-stat-complete-successful - ;;display the next completion - (cond - ((and print-status-p - ;; This updates the display and only prints if there - ;; is no typeahead - (sit-for 0) - (setq entry - (completion-search-peek - completion-cdabbrev-prompt-flag))) - (setq string (if (stringp entry) - entry (completion-string entry))) - (setq string (cmpl-merge-string-cases - string cmpl-original-string)) - (message "Next completion: %s" string) - )) - ) - (t;; none found, insert old - (insert cmpl-original-string) - ;; Don't accept completions - (setq completion-to-accept nil) - ;; print message - ;; This used to call cmpl19-sit-for, an undefined function. - ;; I hope that sit-for does the right thing; I don't know -- rms. - (if (and print-status-p (sit-for 0)) - (message "No %scompletions." - (if (eq this-command last-command) "more " ""))) - ;; statistics - (cmpl-statistics-block - (record-complete-failed cmpl-current-index)) - ;; Pretend that we were never here - (setq this-command 'failed-complete) - )))) - -;;----------------------------------------------- -;; "Complete" Key Keybindings -;;----------------------------------------------- - -;; XEmacs change -;;(global-set-key "\M-\r" 'complete) -;;(global-set-key [?\C-\r] 'complete) -;;(define-key function-key-map [C-return] [?\C-\r]) -;; Hyperbole binds this key globally and does much more with it, -;; so use the other binding instead. -- Bob Weiner, Altrasoft, 08/15/97 -;; (global-set-key '(meta return) 'complete) -(global-set-key '(control return) 'complete) -;; XEmacs: #### still need to take care of function-key-map - -;; Tests - -;; (add-completion "cumberland") -;; (add-completion "cumberbund") -;; cum -;; Cumber -;; cumbering -;; cumb - - -;;--------------------------------------------------------------------------- -;; Parsing definitions from files into the database -;;--------------------------------------------------------------------------- - -;;----------------------------------------------- -;; Top Level functions :: -;;----------------------------------------------- - -;; User interface -(defun add-completions-from-file (file) - "Parse possible completions from a file and add them to data base." - (interactive "fFile: ") - (setq file (expand-file-name file)) - (let* ((buffer (get-file-buffer file)) - (buffer-already-there-p buffer) - ) - (if (not buffer-already-there-p) - (let ((completions-merging-modes nil)) - (setq buffer (find-file-noselect file)))) - (unwind-protect - (save-excursion - (set-buffer buffer) - (add-completions-from-buffer) - ) - (if (not buffer-already-there-p) - (kill-buffer buffer))))) - -(defun add-completions-from-buffer () - (interactive) - (let ((current-completion-source cmpl-source-file-parsing) - (start-num - (cmpl-statistics-block - (aref completion-add-count-vector cmpl-source-file-parsing))) - mode - ) - (cond ((memq major-mode '(emacs-lisp-mode lisp-mode)) - (add-completions-from-lisp-buffer) - (setq mode 'lisp) - ) - ((memq major-mode '(c-mode)) - (add-completions-from-c-buffer) - (setq mode 'c) - ) - (t - (error "Cannot parse completions in %s buffers" - major-mode) - )) - (cmpl-statistics-block - (record-cmpl-parse-file - mode (point-max) - (- (aref completion-add-count-vector cmpl-source-file-parsing) - start-num))) - )) - -;; Find file hook -(defun cmpl-find-file-hook () - (cond (enable-completion - (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode)) - (memq 'lisp completions-merging-modes) - ) - (add-completions-from-buffer)) - ((and (memq major-mode '(c-mode)) - (memq 'c completions-merging-modes) - ) - (add-completions-from-buffer) - ))) - )) - -(add-hook 'find-file-hooks 'cmpl-find-file-hook) - -;;----------------------------------------------- -;; Tags Table Completions -;;----------------------------------------------- - -(defun add-completions-from-tags-table () - ;; Inspired by eero@media-lab.media.mit.edu - "Add completions from the current tags table." - (interactive) - (visit-tags-table-buffer) ;this will prompt if no tags-table - (save-excursion - (goto-char (point-min)) - (let (string) - (condition-case e - (while t - (search-forward "\177") - (backward-char 3) - (and (setq string (symbol-under-point)) - (add-completion-to-tail-if-new string)) - (forward-char 3) - ) - (search-failed) - )))) - - -;;----------------------------------------------- -;; Lisp File completion parsing -;;----------------------------------------------- -;; This merely looks for phrases beginning with (def.... or -;; (package:def ... and takes the next word. -;; -;; We tried using forward-lines and explicit searches but the regexp technique -;; was faster. (About 100K characters per second) -;; -(defconst *lisp-def-regexp* - "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*" - "A regexp that searches for lisp definition form." - ) - -;; Tests - -;; (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8 -;; (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9 -;; (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10 -;; (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9 - -;; Parses all the definition names from a Lisp mode buffer and adds them to -;; the completion database. -(defun add-completions-from-lisp-buffer () - ;; Benchmarks - ;; Sun-3/280 - 1500 to 3000 lines of lisp code per second - (let (string) - (save-excursion - (goto-char (point-min)) - (condition-case e - (while t - (re-search-forward *lisp-def-regexp*) - (and (setq string (symbol-under-point)) - (add-completion-to-tail-if-new string)) - ) - (search-failed) - )))) - - -;;;----------------------------------------------- -;;; C file completion parsing -;;;----------------------------------------------- -;;; C : -;;; Looks for #define or [] [] {,} -;;; or structure, array or pointer defs. -;;; It gets most of the definition names. -;;; -;;; As you might suspect by now, we use some symbol table hackery -;;; -;;; Symbol separator chars (have whitespace syntax) --> , ; * = ( -;;; Opening char --> [ { -;;; Closing char --> ] } -;;; opening and closing must be skipped over -;;; Whitespace chars (have symbol syntax) -;;; Everything else has word syntax - -(defun cmpl-make-c-def-completion-syntax-table () - (let ((table (make-syntax-table)) - (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) - ;; unfortunately the ?( causes the parens to appear unbalanced - (separator-chars '(?, ?* ?= ?\( ?\; - )) - i) - ;; default syntax is whitespace - (setq i 0) - (while (< i 256) - (modify-syntax-entry i "w" table) - (setq i (1+ i))) - (completion-dolist (char whitespace-chars) - (modify-syntax-entry char "_" table)) - (completion-dolist (char separator-chars) - (modify-syntax-entry char " " table)) - (modify-syntax-entry ?\[ "(]" table) - (modify-syntax-entry ?\{ "(}" table) - (modify-syntax-entry ?\] ")[" table) - (modify-syntax-entry ?\} "){" table) - table)) - -(defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table)) - -;; Regexps -(defconst *c-def-regexp* - ;; This stops on lines with possible definitions - "\n[_a-zA-Z#]" - ;; This stops after the symbol to add. - ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)" - ;; This stops before the symbol to add. {Test cases in parens. below} - ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)" - ;; this simple version picks up too much extraneous stuff - ;; "\n\\(\\w\\|\\s_\\|#\\)\\B" - "A regexp that searches for a definition form." - ) -; -;(defconst *c-cont-regexp* -; "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)" -; "This regexp should be used in a looking-at to parse for lists of variables.") -; -;(defconst *c-struct-regexp* -; "\\(*\\|\\s \\)*\\b" -; "This regexp should be used to test whether a symbol follows a structure definition.") - -;(defun test-c-def-regexp (regexp string) -; (and (eq 0 (string-match regexp string)) (match-end 0)) -; ) - -;; Tests - -;; (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9) -;; (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6) -;; (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5) -;; (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil -;; (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4 -;; (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5 -;; (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10 -;; (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil -;; (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9 -;; (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14 -;; (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil - -;; Parses all the definition names from a C mode buffer and adds them to the -;; completion database. -(defun add-completions-from-c-buffer () - ;; Benchmark -- - ;; Sun 3/280-- 1250 lines/sec. - - (let (string next-point char - (saved-syntax (syntax-table)) - ;; This prevents us from using the information provided by the - ;; local syntax tables, but this function would have to be - ;; completely rewritten for that anyway. - (lookup-syntax-properties nil) - ) - (save-excursion - (goto-char (point-min)) - (catch 'finish-add-completions - (unwind-protect - (while t - ;; we loop here only when scan-sexps fails - ;; (i.e. unbalance exps.) - (set-syntax-table cmpl-c-def-syntax-table) - (condition-case e - (while t - (re-search-forward *c-def-regexp*) - (cond - ((= (preceding-char) ?#) - ;; preprocessor macro, see if it's one we handle - (setq string (buffer-substring (point) (+ (point) 6))) - (cond ((or (string-equal string "define") - (string-equal string "ifdef ") - ) - ;; skip forward over definition symbol - ;; and add it to database - (and (forward-word 2) - (setq string (symbol-before-point)) - ;;(push string foo) - (add-completion-to-tail-if-new string) - )))) - (t - ;; C definition - (setq next-point (point)) - (while (and - next-point - ;; scan to next separator char. - (setq next-point (scan-sexps next-point 1)) - ) - ;; position the point on the word we want to add - (goto-char next-point) - (while (= (setq char (following-char)) ?*) - ;; handle pointer ref - ;; move to next separator char. - (goto-char - (setq next-point (scan-sexps (point) 1))) - ) - (forward-word -1) - ;; add to database - (if (setq string (symbol-under-point)) - ;; (push string foo) - (add-completion-to-tail-if-new string) - ;; Local TMC hack (useful for parsing paris.h) - (if (and (looking-at "_AP") ;; "ansi prototype" - (progn - (forward-word -1) - (setq string - (symbol-under-point)) - )) - (add-completion-to-tail-if-new string) - ) - ) - ;; go to next - (goto-char next-point) - ;; (push (format "%c" (following-char)) foo) - (if (= (char-syntax char) ?\() - ;; if on an opening delimiter, go to end - (while (= (char-syntax char) ?\() - (setq next-point (scan-sexps next-point 1) - char (char-after next-point)) - ) - (or (= char ?,) - ;; Current char is an end char. - (setq next-point nil) - )) - )))) - (search-failed ;;done - (throw 'finish-add-completions t) - ) - (error - ;; Check for failure in scan-sexps - (if (or (string-equal (nth 1 e) - "Containing expression ends prematurely") - (string-equal (nth 1 e) "Unbalanced parentheses")) - ;; unbalanced paren., keep going - ;;(ding) - (forward-line 1) - (message "Error parsing C buffer for completions--please send bug report") - (throw 'finish-add-completions t) - )) - )) - (set-syntax-table saved-syntax) - ))))) - - -;;--------------------------------------------------------------------------- -;; Init files -;;--------------------------------------------------------------------------- - -;; The version of save-completions-to-file called at kill-emacs time. -(defun kill-emacs-save-completions () - (if (and save-completions-flag enable-completion cmpl-initialized-p) - (cond - ((not cmpl-completions-accepted-p) - (message "Completions database has not changed - not writing.")) - (t - (save-completions-to-file))))) - -;; There is no point bothering to change this again -;; unless the package changes so much that it matters -;; for people that have saved completions. -(defconst completion-version "11") - -(defconst saved-cmpl-file-header - ";;; Completion Initialization file. -;; Version = %s -;; Format is ( . ) -;; is the completion -;; is the time the completion was last used -;; If it is t, the completion will never be pruned from the file. -;; Otherwise it is in hours since origin. -\n") - -(defun completion-backup-filename (filename) - (concat filename ".BAK")) - -(defun save-completions-to-file (&optional filename) - "Save completions in init file FILENAME. -If file name is not specified, use `save-completions-file-name'." - (interactive) - (setq filename (expand-file-name (or filename save-completions-file-name))) - (if (file-writable-p filename) - (progn - (if (not cmpl-initialized-p) - (initialize-completions));; make sure everything's loaded - (message "Saving completions to file %s" filename) - - (let* ((delete-old-versions t) - (kept-old-versions 0) - (kept-new-versions completions-file-versions-kept) - last-use-time - (current-time (cmpl-hours-since-origin)) - (total-in-db 0) - (total-perm 0) - (total-saved 0) - (backup-filename (completion-backup-filename filename)) - ) - - (save-excursion - (get-buffer-create " *completion-save-buffer*") - (set-buffer " *completion-save-buffer*") - (setq buffer-file-name filename) - - (if (not (verify-visited-file-modtime (current-buffer))) - (progn - ;; file has changed on disk. Bring us up-to-date - (message "Completion file has changed. Merging. . .") - (load-completions-from-file filename t) - (message "Merging finished. Saving completions to file %s" filename))) - - ;; prepare the buffer to be modified - (clear-visited-file-modtime) - (erase-buffer) - ;; (/ 1 0) - (insert (format saved-cmpl-file-header completion-version)) - (completion-dolist (completion (list-all-completions)) - (setq total-in-db (1+ total-in-db)) - (setq last-use-time (completion-last-use-time completion)) - ;; Update num uses and maybe write completion to a file - (cond ((or;; Write to file if - ;; permanent - (and (eq last-use-time t) - (setq total-perm (1+ total-perm))) - ;; or if - (if (> (completion-num-uses completion) 0) - ;; it's been used - (setq last-use-time current-time) - ;; or it was saved before and - (and last-use-time - ;; save-completions-retention-time is nil - (or (not save-completions-retention-time) - ;; or time since last use is < ...retention-time* - (< (- current-time last-use-time) - save-completions-retention-time)) - ))) - ;; write to file - (setq total-saved (1+ total-saved)) - (insert (prin1-to-string (cons (completion-string completion) - last-use-time)) "\n") - ))) - - ;; write the buffer - (condition-case e - (let ((file-exists-p (file-exists-p filename))) - (if file-exists-p - (progn - ;; If file exists . . . - ;; Save a backup(so GNU doesn't screw us when we're out of disk) - ;; (GNU leaves a 0 length file if it gets a disk full error!) - - ;; If backup doesn't exit, Rename current to backup - ;; {If backup exists the primary file is probably messed up} - (or (file-exists-p backup-filename) - (rename-file filename backup-filename)) - ;; Copy the backup back to the current name - ;; (so versioning works) - (copy-file backup-filename filename t))) - ;; Save it - (save-buffer) - (if file-exists-p - ;; If successful, remove backup - (delete-file backup-filename))) - (error - (set-buffer-modified-p nil) - (message "Couldn't save completion file `%s'" filename) - )) - ;; Reset accepted-p flag - (setq cmpl-completions-accepted-p nil) - (kill-buffer " *completion-save-buffer*")) - (cmpl-statistics-block - (record-save-completions total-in-db total-perm total-saved)) - )))) - -;;(defun autosave-completions () -;; (if (and save-completions-flag enable-completion cmpl-initialized-p -;; *completion-auto-save-period* -;; (> cmpl-emacs-idle-time *completion-auto-save-period*) -;; cmpl-completions-accepted-p) -;; (save-completions-to-file))) - -;;(add-hook 'cmpl-emacs-idle-time-hooks 'autosave-completions) - -(defun load-completions-from-file (&optional filename no-message-p) - "Loads a completion init file FILENAME. -If file is not specified, then use `save-completions-file-name'." - (interactive) - (setq filename (expand-file-name (or filename save-completions-file-name))) - (let* ((backup-filename (completion-backup-filename filename)) - (backup-readable-p (file-readable-p backup-filename)) - ) - (if backup-readable-p (setq filename backup-filename)) - (if (file-readable-p filename) - (progn - (if (not no-message-p) - (message "Loading completions from %sfile %s . . ." - (if backup-readable-p "backup " "") filename)) - (save-excursion - (get-buffer-create " *completion-save-buffer*") - (set-buffer " *completion-save-buffer*") - (setq buffer-file-name filename) - ;; prepare the buffer to be modified - (clear-visited-file-modtime) - (erase-buffer) - - (let ((insert-okay-p nil) - (buffer (current-buffer)) - (current-time (cmpl-hours-since-origin)) - string num-uses entry last-use-time - cmpl-entry cmpl-last-use-time - (current-completion-source cmpl-source-init-file) - (start-num - (cmpl-statistics-block - (aref completion-add-count-vector cmpl-source-file-parsing))) - (total-in-file 0) (total-perm 0) - ) - ;; insert the file into a buffer - (condition-case e - (progn (insert-file-contents filename t) - (setq insert-okay-p t)) - - (file-error - (message "File error trying to load completion file %s." - filename))) - ;; parse it - (if insert-okay-p - (progn - (goto-char (point-min)) - - (condition-case e - (while t - (setq entry (read buffer)) - (setq total-in-file (1+ total-in-file)) - (cond - ((and (consp entry) - (stringp (setq string (car entry))) - (cond - ((eq (setq last-use-time (cdr entry)) 'T) - ;; handle case sensitivity - (setq total-perm (1+ total-perm)) - (setq last-use-time t)) - ((eq last-use-time t) - (setq total-perm (1+ total-perm))) - ((integerp last-use-time)) - )) - ;; Valid entry - ;; add it in - (setq cmpl-last-use-time - (completion-last-use-time - (setq cmpl-entry - (add-completion-to-tail-if-new string)) - )) - (if (or (eq last-use-time t) - (and (> last-use-time 1000);;backcompatibility - (not (eq cmpl-last-use-time t)) - (or (not cmpl-last-use-time) - ;; more recent - (> last-use-time cmpl-last-use-time)) - )) - ;; update last-use-time - (set-completion-last-use-time cmpl-entry last-use-time) - )) - (t - ;; Bad format - (message "Error: invalid saved completion - %s" - (prin1-to-string entry)) - ;; try to get back in sync - (search-forward "\n(") - ))) - (search-failed - (message "End of file while reading completions.") - ) - (end-of-file - (if (= (point) (point-max)) - (if (not no-message-p) - (message "Loading completions from file %s . . . Done." - filename)) - (message "End of file while reading completions.") - )) - ))) - - (cmpl-statistics-block - (record-load-completions - total-in-file total-perm - (- (aref completion-add-count-vector cmpl-source-init-file) - start-num))) - - ) - (kill-buffer " *completion-save-buffer*")))))) - -(defun initialize-completions () - "Load the default completions file. -Also sets up so that exiting emacs will automatically save the file." - (interactive) - (cond ((not cmpl-initialized-p) - (load-completions-from-file) - )) - (setq cmpl-initialized-p t) - ) - - -;;----------------------------------------------- -;; Kill EMACS patch -;;----------------------------------------------- - -(add-hook 'kill-emacs-hook - '(lambda () - (kill-emacs-save-completions) - (cmpl-statistics-block - (record-cmpl-kill-emacs)))) - -;;----------------------------------------------- -;; Kill region patch -;;----------------------------------------------- - -;; Modified for InfoDock and XEmacs by Bob Weiner, Altrasoft, 08/15/97. -(defun completion-kill-region (&optional beg end) - "Kill between point and mark. -The text is deleted but saved in the kill ring. -The command \\[yank] can retrieve it from there. -/(If you want to kill and then yank immediately, use \\[copy-region-as-kill].) - -This is the primitive for programs to kill text (as opposed to deleting it). -Supply two arguments, character numbers indicating the stretch of text - to be killed. -Any command that calls this function is a \"kill command\". -If the previous command was also a kill command, -the text killed this time appends to the text killed last time -to make one entry in the kill ring. -Patched to remove the most recent completion." - (interactive - (if buffer-read-only (barf-if-buffer-read-only) - (if (region-exists-p) - (list (region-beginning) (region-end))))) - (cond ((eq last-command 'complete) - (delete-region (point) cmpl-last-insert-location) - (insert cmpl-original-string) - (setq completion-to-accept nil) - (cmpl-statistics-block - (record-complete-failed))) - (t - (setq this-command 'kill-region) - (kill-region beg end)))) - -(global-set-key "\C-w" 'completion-kill-region) - -;;----------------------------------------------- -;; Patches to self-insert-command. -;;----------------------------------------------- - -;; Need 2 versions: generic separator chars. and space (to get auto fill -;; to work) - -;; All common separators (eg. space "(" ")" """) characters go through a -;; function to add new words to the list of words to complete from: -;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg). -;; If the character before this was an alpha-numeric then this adds the -;; symbol before point to the completion list (using ADD-COMPLETION). - -(defun completion-separator-self-insert-command (arg) - (interactive "p") - (use-completion-before-separator) - (self-insert-command arg) - ) - -(defun completion-separator-self-insert-autofilling (arg) - (interactive "p") - (use-completion-before-separator) - (self-insert-command arg) - (and auto-fill-function - (funcall auto-fill-function)) - ) - -;;----------------------------------------------- -;; Wrapping Macro -;;----------------------------------------------- - -;; Note that because of the way byte compiling works, none of -;; the functions defined with this macro get byte compiled. - -(defmacro def-completion-wrapper (function-name type &optional new-name) - "Add a call to update the completion database before function execution. -TYPE is the type of the wrapper to be added. Can be :before or :under." - (cond ((eq type ':separator) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-before-separator)) - ((eq type ':before) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-before-point)) - ((eq type ':backward-under) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-backward-under)) - ((eq type ':backward) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-backward)) - ((eq type ':under) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-under-point)) - ((eq type ':under-or-before) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-under-or-before-point)) - ((eq type ':minibuffer-separator) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-minibuffer-separator)))) - -(defun use-completion-minibuffer-separator () - (let ((cmpl-syntax-table cmpl-standard-syntax-table)) - (use-completion-before-separator))) - -(defun use-completion-backward-under () - (use-completion-under-point) - (if (eq last-command 'complete) - ;; probably a failed completion if you have to back up - (cmpl-statistics-block (record-complete-failed)))) - -(defun use-completion-backward () - (if (eq last-command 'complete) - ;; probably a failed completion if you have to back up - (cmpl-statistics-block (record-complete-failed)))) - -(defun completion-before-command () - (funcall (or (and (symbolp this-command) - (get this-command 'completion-function)) - 'use-completion-under-or-before-point))) -(add-hook 'pre-command-hook 'completion-before-command) - - -;;--------------------------------------------------------------------------- -;; Patches to standard keymaps insert completions -;;--------------------------------------------------------------------------- - -;;----------------------------------------------- -;; Separators -;;----------------------------------------------- -;; We've used the completion syntax table given as a guide. -;; -;; Global separator chars. -;; We left out because there are too many special cases for it. Also, -;; in normal coding it's rarely typed after a word. -(global-set-key " " 'completion-separator-self-insert-autofilling) -(global-set-key "!" 'completion-separator-self-insert-command) -(global-set-key "%" 'completion-separator-self-insert-command) -(global-set-key "^" 'completion-separator-self-insert-command) -(global-set-key "&" 'completion-separator-self-insert-command) -(global-set-key "(" 'completion-separator-self-insert-command) -(global-set-key ")" 'completion-separator-self-insert-command) -(global-set-key "=" 'completion-separator-self-insert-command) -(global-set-key "`" 'completion-separator-self-insert-command) -(global-set-key "|" 'completion-separator-self-insert-command) -(global-set-key "{" 'completion-separator-self-insert-command) -(global-set-key "}" 'completion-separator-self-insert-command) -(global-set-key "[" 'completion-separator-self-insert-command) -(global-set-key "]" 'completion-separator-self-insert-command) -(global-set-key ";" 'completion-separator-self-insert-command) -(global-set-key "\"" 'completion-separator-self-insert-command) -(global-set-key "'" 'completion-separator-self-insert-command) -(global-set-key "#" 'completion-separator-self-insert-command) -(global-set-key "," 'completion-separator-self-insert-command) -(global-set-key "?" 'completion-separator-self-insert-command) - -;; We include period and colon even though they are symbol chars because : -;; - in text we want to pick up the last word in a sentence. -;; - in C pointer refs. we want to pick up the first symbol -;; - it won't make a difference for lisp mode (package names are short) -(global-set-key "." 'completion-separator-self-insert-command) -(global-set-key ":" 'completion-separator-self-insert-command) - -;; Lisp Mode diffs -(define-key lisp-mode-map "!" 'self-insert-command) -(define-key lisp-mode-map "&" 'self-insert-command) -(define-key lisp-mode-map "%" 'self-insert-command) -(define-key lisp-mode-map "?" 'self-insert-command) -(define-key lisp-mode-map "=" 'self-insert-command) -(define-key lisp-mode-map "^" 'self-insert-command) - -;; Avoid warnings. -(defvar c-mode-map) -(defvar fortran-mode-map) - -;; C mode diffs. -(defun completion-c-mode-hook () - (def-completion-wrapper electric-c-semi :separator) - (define-key c-mode-map "+" 'completion-separator-self-insert-command) - (define-key c-mode-map "*" 'completion-separator-self-insert-command) - (define-key c-mode-map "/" 'completion-separator-self-insert-command)) -;; Do this either now or whenever C mode is loaded. -(if (featurep 'cc-mode) - (completion-c-mode-hook) - (add-hook 'c-mode-hook 'completion-c-mode-hook)) - -;; FORTRAN mode diffs. (these are defined when fortran is called) -(defun completion-setup-fortran-mode () - (define-key fortran-mode-map "+" 'completion-separator-self-insert-command) - (define-key fortran-mode-map "-" 'completion-separator-self-insert-command) - (define-key fortran-mode-map "*" 'completion-separator-self-insert-command) - (define-key fortran-mode-map "/" 'completion-separator-self-insert-command) - ) - -;;----------------------------------------------- -;; End of line chars. -;;----------------------------------------------- -(def-completion-wrapper newline :separator) -(def-completion-wrapper newline-and-indent :separator) -(def-completion-wrapper comint-send-input :separator) -(def-completion-wrapper exit-minibuffer :minibuffer-separator) -(def-completion-wrapper eval-print-last-sexp :separator) -(def-completion-wrapper eval-last-sexp :separator) -;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer) - -;;----------------------------------------------- -;; Cursor movement -;;----------------------------------------------- - -(def-completion-wrapper next-line :under-or-before) -(def-completion-wrapper previous-line :under-or-before) -(def-completion-wrapper beginning-of-buffer :under-or-before) -(def-completion-wrapper end-of-buffer :under-or-before) -(def-completion-wrapper beginning-of-line :under-or-before) -(def-completion-wrapper end-of-line :under-or-before) -(def-completion-wrapper forward-char :under-or-before) -(def-completion-wrapper forward-word :under-or-before) -(def-completion-wrapper forward-sexp :under-or-before) -(def-completion-wrapper backward-char :backward-under) -(def-completion-wrapper backward-word :backward-under) -(def-completion-wrapper backward-sexp :backward-under) - -(def-completion-wrapper delete-backward-char :backward) -(def-completion-wrapper delete-backward-char-untabify :backward) - -;; Tests -- -;; foobarbiz -;; foobar -;; fooquux -;; fooper - -(cmpl-statistics-block - (record-completion-file-loaded)) - -(provide 'completion) - -;;; completion.el ends here diff --git a/xemacs-packages/lisp/edit-utils/crm.el b/xemacs-packages/lisp/edit-utils/crm.el deleted file mode 100755 index 2e156571..00000000 --- a/xemacs-packages/lisp/edit-utils/crm.el +++ /dev/null @@ -1,633 +0,0 @@ -;;; crm.el --- read multiple strings with completion - -;; Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000 -;; Free Software Foundation, Inc. - -;; Author: Sen Nagata -;; Keywords: completion, minibuffer, multiple elements - -;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This code defines a function, `completing-read-multiple', which -;; provides the ability to read multiple strings in the minibuffer, -;; with completion. - -;; By using this functionality, a user may specify multiple strings at -;; a single prompt, optionally using completion. - -;; Multiple strings are specified by separating each of the strings -;; with a prespecified separator character. For example, if the -;; separator character is a comma, the strings 'alice', 'bob', and -;; 'eve' would be specified as 'alice,bob,eve'. - -;; The default value for the separator character is the value of -;; `crm-default-separator' (comma). The separator character may be -;; changed by modifying the value of `crm-separator'. - -;; Contiguous strings of non-separator-characters are referred to as -;; 'elements'. In the aforementioned example, the elements are: -;; 'alice', 'bob', and 'eve'. - -;; Completion is available on a per-element basis. For example, if -;; the contents of the minibuffer are 'alice,bob,eve' and point is -;; between 'l' and 'i', pressing TAB operates on the element 'alice'. - -;; For the moment, I have decided to not bind any special behavior to -;; the separator key. In the future, the separator key might be used -;; to provide completion in certain circumstances. One of the reasons -;; why this functionality is not yet provided is that it is unclear to -;; the author what the precise circumstances are, under which -;; separator-invoked completion should be provided. - -;; Design note: `completing-read-multiple' is modeled after -;; `completing-read'. They should be similar -- it was intentional. - -;; Some of this code started out as translation from C code in -;; src/minibuf.c to Emacs Lisp code. - -;; Thanks to Richard Stallman for all of his help (many of the good -;; ideas in here are from him), Gerd Moellmann for his attention, -;; Stefan Monnier for responding with a code sample and comments very -;; early on, and Kai Grossjohann & Soren Dayton for valuable feedback. - -;;; Questions and Thoughts: - -;; -the author has gone through a number of test-and-fix cycles w/ -;; this code, so it should be usable. please let me know if you find -;; any problems. - -;; -should `completing-read-multiple' allow a trailing separator in -;; a return value when REQUIRE-MATCH is t? if not, should beep when a user -;; tries to exit the minibuffer via RET? - -;; -TODO: possibly make return values from `crm-do-completion' into constants - -;; -TODO: find out whether there is an appropriate way to distinguish between -;; functions intended for internal use and those that aren't. - -;; -tip: use M-f and M-b for ease of navigation among elements. - -;;; History: -;; -;; 2000-04-10: -;; -;; first revamped version - -;;; Code: -(defconst crm-default-separator "," - "Default separator for `completing-read-multiple'.") - -(defvar crm-separator crm-default-separator - "Separator used for separating strings in `completing-read-multiple'. -It should be a single character string that doesn't appear in the list of -completion candidates. Modify this value to make `completing-read-multiple' -use a separator other than `crm-default-separator'.") - -;; actual filling in of these maps occurs below via `crm-init-keymaps' -(defvar crm-local-completion-map nil - "Local keymap for minibuffer multiple input with completion. -Analog of `minibuffer-local-completion-map'.") - -(defvar crm-local-must-match-map nil - "Local keymap for minibuffer multiple input with exact match completion. -Analog of `minibuffer-local-must-match-map' for crm.") - -(defvar crm-completion-table nil - "An alist whose elements' cars are strings, or an obarray. -This is a table used for completion by `completing-read-multiple' and its -supporting functions.") - -;; this is supposed to be analogous to last_exact_completion in src/minibuf.c -(defvar crm-last-exact-completion nil - "Completion string if last attempt reported \"Complete, but not unique\".") - -(defvar crm-left-of-element nil - "String to the left of the current element.") - -(defvar crm-current-element nil - "The current element.") - -(defvar crm-right-of-element nil - "String to the right of the current element.") - -(defvar crm-beginning-of-element nil - "Buffer position representing the beginning of the current element.") - -(defvar crm-end-of-element nil - "Buffer position representing the end of the current element.") - -;; emulates temp_echo_area_glyphs from src/minibuf.c -(defun crm-temp-echo-area-glyphs (message-string) - "Temporarily display MESSAGE-STRING in echo area. -After user-input or 2 seconds, erase the displayed string." - (save-excursion - (goto-char (point-max)) - (insert message-string) - (sit-for 2) - (backward-char (length message-string)) - (delete-char (length message-string)))) - -;; this function evolved from a posting by Stefan Monnier -(defun crm-collection-fn (string predicate flag) - "Function used by `completing-read-multiple' to compute completion values. -The value of STRING is the string to be completed. - -The value of PREDICATE is a function to filter possible matches, or -nil if none. - -The value of FLAG is used to specify the type of completion operation. -A value of nil specifies `try-completion'. A value of t specifies -`all-completions'. A value of lambda specifes a test for an exact match. - -For more information on STRING, PREDICATE, and FLAG, see the Elisp -Reference sections on 'Programmed Completion' and 'Basic Completion -Functions'." - (let ((lead "")) - (when (string-match (concat ".*" crm-separator) string) - (setq lead (substring string 0 (match-end 0))) - (setq string (substring string (match-end 0)))) - (if (eq flag 'lambda) - ;; return t for exact match, nil otherwise - (let ((result (try-completion string crm-completion-table predicate))) - (if (stringp result) - nil - (if result - t - nil)))) - (if flag - ;; called via (all-completions string 'crm-completion-fn predicate)? - (all-completions string crm-completion-table predicate) - ;; called via (try-completion string 'crm-completion-fn predicate)? - (let ((result (try-completion string crm-completion-table predicate))) - (if (stringp result) - (concat lead result) - result))))) - -(defun crm-find-current-element () - "Parse the minibuffer to find the current element. -If no element can be found, return nil. - -If an element is found, bind: - - -the variable `crm-current-element' to the current element, - - -the variables `crm-left-of-element' and `crm-right-of-element' to - the strings to the left and right of the current element, - respectively, and - - -the variables `crm-beginning-of-element' and `crm-end-of-element' to - the buffer positions of the beginning and end of the current element - respectively, - -and return t." - (let* ((minibuffer-string (buffer-string)) - (end-index (or (string-match "," minibuffer-string (1- (point))) - (1- (point-max)))) - (target-string (substring minibuffer-string 0 end-index)) - (index (or (string-match - (concat crm-separator "\\([^" crm-separator "]*\\)$") - target-string) - (string-match - (concat "^\\([^" crm-separator "]*\\)$") - target-string)))) - (if (not (numberp index)) - ;; no candidate found - nil - (progn - ;; - (setq crm-beginning-of-element (match-beginning 1)) - (setq crm-end-of-element end-index) - ;; string to the left of the current element - (setq crm-left-of-element (substring target-string 0 (match-beginning 1))) - ;; the current element - (setq crm-current-element (match-string 1 target-string)) - ;; string to the right of the current element - (setq crm-right-of-element (substring minibuffer-string end-index)) - t)))) - -(defun crm-test-completion (candidate) - "Return t if CANDIDATE is an exact match for a valid completion." - (let ((completions - ;; TODO: verify whether the arguments are appropriate - (all-completions - candidate crm-completion-table minibuffer-completion-predicate))) - (if (member candidate completions) - t - nil))) - -(defun crm-minibuffer-completion-help () - "Display a list of possible completions of the current minibuffer element." - (interactive) - (message "Making completion list...") - (if (not (crm-find-current-element)) - nil - (let ((completions (all-completions crm-current-element - minibuffer-completion-table - minibuffer-completion-predicate))) - (message nil) - (if (null completions) - (crm-temp-echo-area-glyphs " [No completions]") - (with-output-to-temp-buffer "*Completions*" - (display-completion-list (sort completions 'string-lessp)))))) - nil) - -(defun crm-do-completion () - "This is the internal completion engine. -This function updates the text in the minibuffer -to complete the current string, and returns a number between 0 and 6. -The meanings of the return values are: - - 0 - the string has no possible completion - 1 - the string is already a valid and unique match - 2 - not used - 3 - the string is already a valid match (but longer matches exist too) - 4 - the string was completed to a valid match - 5 - some completion has been done, but the result is not a match - 6 - no completion was done, and the string is not an exact match" - - (if (not (crm-find-current-element)) - nil - (let (last completion completedp) - (setq completion - (try-completion crm-current-element - minibuffer-completion-table - minibuffer-completion-predicate)) - (setq last crm-last-exact-completion) - (setq crm-last-exact-completion nil) - - (catch 'crm-exit - - (if (null completion) ; no possible completion - (progn - (crm-temp-echo-area-glyphs " [No match]") - (throw 'crm-exit 0))) - - (if (eq completion t) ; was already an exact and unique completion - (throw 'crm-exit 1)) - - (setq completedp - (null (string-equal completion crm-current-element))) - - (if completedp - (progn - (erase-buffer) - (insert crm-left-of-element completion) - ;; (if crm-complete-up-to-point - ;; (insert crm-separator)) - (insert crm-right-of-element) - (backward-char (length crm-right-of-element)) - ;; TODO: is this correct? - (setq crm-current-element completion))) - - (if (null (crm-test-completion crm-current-element)) - (progn - (if completedp ; some completion happened - (throw 'crm-exit 5) - (if completion-auto-help - (crm-minibuffer-completion-help) - (crm-temp-echo-area-glyphs " [Next char not unique]"))) - (throw 'crm-exit 6)) - (if completedp - (throw 'crm-exit 4))) - - (setq crm-last-exact-completion completion) - (if (not (null last)) - (progn - (if (not (null (equal crm-current-element last))) - (crm-minibuffer-completion-help)))) - - ;; returning -- was already an exact completion - (throw 'crm-exit 3))))) - -(defun crm-minibuffer-complete () - "Complete the current element. -If no characters can be completed, display a list of possible completions. - -Return t if the current element is now a valid match; otherwise return nil." - (interactive) - ;; take care of scrolling if necessary -- completely cribbed from minibuf.c - (if (not (eq last-command this-command)) - ;; ok? - (setq minibuffer-scroll-window nil)) - (let ((window minibuffer-scroll-window)) - (if (and (not (null window)) - ;; ok? - (not (null (window-buffer window)))) - (let (tem) - (set-buffer (window-buffer window)) - ;; ok? - (setq tem (pos-visible-in-window-p (point-max) window)) - (if (not (null tem)) - ;; ok? - (set-window-start window (point-min) nil) - (scroll-other-window nil)) - ;; reaching here means exiting the function w/ return value of nil - nil) - - (let* ( - ;(crm-end-of-element nil) - (result (crm-do-completion))) - (cond - ((eq 0 result) - nil) - ((eq 1 result) - ;; adapted from Emacs 21 - (if (not (eq (point) crm-end-of-element)) - (goto-char (+ 1 crm-end-of-element))) - (crm-temp-echo-area-glyphs " [Sole completion]") - t) - ((eq 3 result) - ;; adapted from Emacs 21 - (if (not (eq (point) crm-end-of-element)) - (goto-char (+ 1 crm-end-of-element))) - (crm-temp-echo-area-glyphs " [Complete, but not unique]") - t)))))) - -;; i love traffic lights...but only when they're green -(defun crm-find-longest-completable-substring (string) - "Determine the longest completable (left-anchored) substring of STRING. -The description \"left-anchored\" means the positions of the characters -in the substring must be the same as those of the corresponding characters -in STRING. Anchoring is what `^' does in a regular expression. - -The table and predicate used for completion are -`minibuffer-completion-table' and `minibuffer-completion-predicate', -respectively. - -A non-nil return value means that there is some substring which is -completable. A return value of t means that STRING itself is -completable. If a string value is returned it is the longest -completable proper substring of STRING. If nil is returned, STRING -does not have any non-empty completable substrings. - -Remember: \"left-anchored\" substring" - (let* ((length-of-string (length string)) - (index length-of-string) - (done (if (> length-of-string 0) - nil - t)) - (first t) ; ugh, special handling for first time through... - goal-string - result) - ;; loop through left-anchored substrings in order of descending length, - ;; find the first substring that is completable - (while (not done) - (setq result (try-completion (substring string 0 index) - minibuffer-completion-table - minibuffer-completion-predicate)) - (if result - ;; found completable substring - (progn - (setq done t) - (if (and (eq result t) first) - ;; exactly matching string first time through - (setq goal-string t) - ;; fully-completed proper substring - (setq goal-string (substring string 0 index))))) - (setq index (1- index)) - (if first - (setq first nil)) - (if (<= index 0) - (setq done t))) - ;; possible values include: t, nil, some string - goal-string)) - -;; TODO: decide whether trailing separator is allowed. current -;; implementation appears to allow it -(defun crm-strings-completed-p (separated-string) - "Verify that strings in SEPARATED-STRING are completed strings. -A return value of t means that all strings were verified. A number is -returned if verification was unsuccessful. This number represents the -position in SEPARATED-STRING up to where completion was successful." - (let ((strings (split-string separated-string crm-separator)) - ;; buffers start at 1, not 0 - (current-position 1) - current-string - result - done) - (while (and strings (not done)) - (setq current-string (car strings) - result (try-completion current-string - minibuffer-completion-table - minibuffer-completion-predicate)) - (if (eq result t) - (setq strings (cdr strings) - current-position (+ current-position - (length current-string) - ;; automatically adding 1 for separator - ;; character - 1)) - ;; still one more case of a match - (if (stringp result) - (let ((string-list - (all-completions result - minibuffer-completion-table - minibuffer-completion-predicate))) - (if (member result string-list) - ;; ho ho, code duplication... - (setq strings (cdr strings) - current-position (+ current-position - (length current-string) - 1)) - (progn - (setq done t) - ;; current-string is a partially-completed string - (setq current-position (+ current-position - (length current-string)))))) - ;; current-string cannot be completed - (let ((completable-substring - (crm-find-longest-completable-substring current-string))) - (setq done t) - (setq current-position (+ current-position - (length completable-substring))))))) - ;; return our result - (if (null strings) - t - current-position))) - -;; try to complete candidate, then check all separated strings. move -;; point to problem position if checking fails for some string. if -;; checking succeeds for all strings, exit. -(defun crm-minibuffer-complete-and-exit () - "If all of the minibuffer elements are valid completions then exit. -All elements in the minibuffer must match. If there is a mismatch, move point -to the location of mismatch and do not exit. - -This function is modeled after `minibuffer_complete_and_exit' in src/minibuf.c" - (interactive) - - (if (not (crm-find-current-element)) - nil - (let (result) - - (setq result - (catch 'crm-exit - - (if (eq (point-min) (point-max)) - (throw 'crm-exit t)) - - ;; TODO: this test is suspect? - (if (not (null (crm-test-completion crm-current-element))) - (throw 'crm-exit "check")) - - ;; TODO: determine how to detect errors - (let ((result (crm-do-completion))) - - (cond - ((or (eq 1 result) - (eq 3 result)) - (throw 'crm-exit "check")) - ((eq 4 result) - (if (not (null minibuffer-completion-confirm)) - (progn - (crm-temp-echo-area-glyphs " [Confirm]") - nil) - (throw 'crm-exit "check"))) - (nil))))) - - (if (null result) - nil - (if (equal result "check") - (let ((check-strings - (crm-strings-completed-p (buffer-string)))) - ;; check all of minibuffer - (if (eq check-strings t) - (throw 'exit nil) - (if (numberp check-strings) - (progn - (goto-char check-strings) - (crm-temp-echo-area-glyphs " [An element did not match]")) - (message "Unexpected error")))) - (if (eq result t) - (throw 'exit nil) - (message "Unexpected error"))))))) - -(defun crm-init-keymaps () - "Initialize the keymaps used by `completing-read-multiple'. -Two keymaps are used depending on the value of the REQUIRE-MATCH -argument of the function `completing-read-multiple'. - -If REQUIRE-MATCH is nil, the keymap `crm-local-completion-map' is used. -This keymap inherits from the keymap named `minibuffer-local-completion-map'. -The only difference is that TAB is bound to `crm-minibuffer-complete' in -the inheriting keymap. - -If REQUIRE-MATCH is non-nil, the keymap `crm-local-must-match-map' is used. -This keymap inherits from the keymap named `minibuffer-local-must-match-map'. -The inheriting keymap binds RET to `crm-minibuffer-complete-and-exit' -and TAB to `crm-minibuffer-complete'." - (unless crm-local-completion-map - (setq crm-local-completion-map (make-sparse-keymap)) - (set-keymap-parent crm-local-completion-map - minibuffer-local-completion-map) - ;; key definitions - (define-key crm-local-completion-map - (kbd "TAB") - (function crm-minibuffer-complete))) - - (unless crm-local-must-match-map - (setq crm-local-must-match-map (make-sparse-keymap)) - (set-keymap-parent crm-local-must-match-map - minibuffer-local-must-match-map) - ;; key definitions - (define-key crm-local-must-match-map - (kbd "RET") - (function crm-minibuffer-complete-and-exit)) - (define-key crm-local-must-match-map - (kbd "TAB") - (function crm-minibuffer-complete)))) - -(crm-init-keymaps) - -;; superemulates behavior of completing_read in src/minibuf.c -;;;###autoload -(defun completing-read-multiple - (prompt table &optional predicate require-match initial-input - hist def inherit-input-method) - "Read multiple strings in the minibuffer, with completion. -By using this functionality, a user may specify multiple strings at a -single prompt, optionally using completion. - -Multiple strings are specified by separating each of the strings with -a prespecified separator character. For example, if the separator -character is a comma, the strings 'alice', 'bob', and 'eve' would be -specified as 'alice,bob,eve'. - -The default value for the separator character is the value of -`crm-default-separator' (comma). The separator character may be -changed by modifying the value of `crm-separator'. - -Contiguous strings of non-separator-characters are referred to as -'elements'. In the aforementioned example, the elements are: 'alice', -'bob', and 'eve'. - -Completion is available on a per-element basis. For example, if the -contents of the minibuffer are 'alice,bob,eve' and point is between -'l' and 'i', pressing TAB operates on the element 'alice'. - -The return value of this function is a list of the read strings. - -See the documentation for `completing-read' for details on the arguments: -PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and -INHERIT-INPUT-METHOD." - (let ((minibuffer-completion-table (function crm-collection-fn)) - (minibuffer-completion-predicate predicate) - ;; see completing_read in src/minibuf.c - (minibuffer-completion-confirm - (unless (eq require-match t) require-match)) - (crm-completion-table table) - crm-last-exact-completion - crm-current-element - crm-left-of-element - crm-right-of-element - crm-beginning-of-element - crm-end-of-element - (map (if require-match - crm-local-must-match-map - crm-local-completion-map))) - (split-string (read-from-minibuffer - prompt initial-input map - nil hist def inherit-input-method) - crm-separator))) - -;; testing and debugging -;; (defun crm-init-test-environ () -;; "Set up some variables for testing." -;; (interactive) -;; (setq my-prompt "Prompt: ") -;; (setq my-table -;; '(("hi") ("there") ("man") ("may") ("mouth") ("ma") -;; ("a") ("ab") ("abc") ("abd") ("abf") ("zab") ("acb") -;; ("da") ("dab") ("dabc") ("dabd") ("dabf") ("dzab") ("dacb") -;; ("fda") ("fdab") ("fdabc") ("fdabd") ("fdabf") ("fdzab") ("fdacb") -;; ("gda") ("gdab") ("gdabc") ("gdabd") ("gdabf") ("gdzab") ("gdacb") -;; )) -;; (setq my-separator ",")) - -;(completing-read-multiple my-prompt my-table) -;(completing-read-multiple my-prompt my-table nil t) -;(completing-read-multiple my-prompt my-table nil "match") -;(completing-read my-prompt my-table nil t) -;(completing-read my-prompt my-table nil "match") - -(provide 'crm) - -;;; arch-tag: db1911d9-86c6-4a42-b32a-4910701b15a6 -;;; crm.el ends here diff --git a/xemacs-packages/lisp/edit-utils/custom-load.el b/xemacs-packages/lisp/edit-utils/custom-load.el deleted file mode 100644 index 567535a1..00000000 --- a/xemacs-packages/lisp/edit-utils/custom-load.el +++ /dev/null @@ -1,69 +0,0 @@ -;;; custom-load.el --- automatically extracted custom dependencies - -;;; Code: - -(autoload 'custom-add-loads "cus-load") - -(custom-add-loads 'permanent-buffers '("permanent-buffers")) -(custom-add-loads 'extensions '("iswitchb" "page-ext" "tempo")) -(custom-add-loads 'auto-revert '("autorevert")) -(custom-add-loads 'recent-files-menu '("recent-files")) -(custom-add-loads 'mouse '("avoid" "id-select" "outl-mouse")) -(custom-add-loads 'convenience '("dabbrev" "power-macros")) -(custom-add-loads 'menu '("recent-files")) -(custom-add-loads 'minibuffer '("detached-minibuf" "icomplete" "savehist")) -(custom-add-loads 'environment '("popper")) -(custom-add-loads 'allout '("allout")) -(custom-add-loads 'man '("man")) -(custom-add-loads 'completion '("completion")) -(custom-add-loads 'tools '("func-menu" "lazy-shot")) -(custom-add-loads 'uniquify '("uniquify")) -(custom-add-loads 'recent-files '("recent-files")) -(custom-add-loads 'dabbrev '("dabbrev")) -(custom-add-loads 'save-place '("saveplace")) -(custom-add-loads 'lisp '("func-menu")) -(custom-add-loads 'applications '("uniquify")) -(custom-add-loads 'outlines '("allout" "outl-mouse")) -(custom-add-loads 'paren-matching '("paren" "mic-paren")) -(custom-add-loads 'avoid '("avoid")) -(custom-add-loads 'help '("info-look" "man")) -(custom-add-loads 'mic-paren-matching '("mic-paren" "paren")) -(custom-add-loads 'winring '("winring")) -(custom-add-loads 'data '("saveplace")) -(custom-add-loads 'backup '("backup-dir")) -(custom-add-loads 'id-select '("id-select")) -(custom-add-loads 'outl-mouse '("outl-mouse")) -(custom-add-loads 'lazy-lock '("lazy-lock")) -(custom-add-loads 'frames '("balloon-help" "desktop" "detached-minibuf" "highline" "rsz-minibuf" "winring")) -(custom-add-loads 'edit-toolbar '("toolbar-utils")) -(custom-add-loads 'bookmarks '("bookmark")) -(custom-add-loads 'desktop '("desktop")) -(custom-add-loads 'abbrev '("dabbrev")) -(custom-add-loads 'lazy-shot '("lazy-shot")) -(custom-add-loads 'icomplete '("icomplete")) -(custom-add-loads 'iswitchb '("iswitchb")) -(custom-add-loads 'fume '("func-menu")) -(custom-add-loads 'blink-cursor '("blink-cursor")) -(custom-add-loads 'power-macros '("power-macros")) -(custom-add-loads 'files '("after-save-commands" "autorevert" "recent-files" "where-was-i-db")) -(custom-add-loads 'fast-lock '("fast-lock")) -(custom-add-loads 'font-lock '("lazy-lock")) -(custom-add-loads 'where-was-i '("where-was-i-db")) -(custom-add-loads 'popper '("popper")) -(custom-add-loads 'tempo '("tempo")) -(custom-add-loads 'highline '("highline")) -(custom-add-loads 'detached-minibuf '("detached-minibuf")) -(custom-add-loads 'resize-minibuffer '("rsz-minibuf")) -(custom-add-loads 'info-lookup '("info-look")) -(custom-add-loads 'languages '("info-look")) -(custom-add-loads 'fill '("align")) -(custom-add-loads 'balloon-help '("balloon-help")) -(custom-add-loads 'faces '("fast-lock" "highline" "lazy-shot" "mic-paren")) -(custom-add-loads 'pages '("page-ext")) -(custom-add-loads 'savehist '("savehist")) -(custom-add-loads 'align '("align")) -(custom-add-loads 'editing '("bookmark" "highline" "permanent-buffers")) -(custom-add-loads 'matching '("paren" "completion" "id-select")) -(custom-add-loads 'c '("func-menu")) - -;;; custom-load.el ends here diff --git a/xemacs-packages/lisp/edit-utils/dabbrev.el b/xemacs-packages/lisp/edit-utils/dabbrev.el deleted file mode 100644 index db38b67a..00000000 --- a/xemacs-packages/lisp/edit-utils/dabbrev.el +++ /dev/null @@ -1,1060 +0,0 @@ -;;; dabbrev.el --- dynamic abbreviation package - -;; Copyright (C) 1985, 86, 92, 94, 96, 1997, 2000, 2001 -;; Free Software Foundation, Inc. - -;; Author: Don Morrison -;; Maintainer: Lars Lindberg -;; Created: 16 Mars 1992 -;; Lindberg's last update version: 5.7 -;; Keywords: abbrev expand completion convenience - -;; This file is part of XEmacs. - -;; XEmacs 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. -;; -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, MA -;; 02111-1307, USA. - -;;; Synched up with: FSF 21.3. - -;;; Commentary: - -;; The purpose with this package is to let you write just a few -;; characters of words you've written earlier to be able to expand -;; them. -;; -;; To expand a word, just put the point right after the word and press -;; M-/ (dabbrev-expand) or M-C-/ (dabbrev-completion). -;; -;; Check out the customizable variables below to learn about all the -;; features of this package. - -;;; Hints and tips for major modes writers: - -;; Recommended values C/Lisp etc text -;; dabbrev-case-fold-search nil t -;; dabbrev-case-replace nil t -;; -;; Set the variables you want special for your mode like this: -;; (set (make-local-variable 'dabbrev-case-replace) nil) -;; Then you don't interfere with other modes. -;; -;; If your mode handles buffers that refers to other buffers -;; (i.e. compilation-mode, gud-mode), then try to set -;; `dabbrev-select-buffers-function' or `dabbrev-friend-buffer-function' -;; to a function that point out those buffers. - -;; Same goes for major-modes that are connected to other modes. There -;; are for instance a number of mail-modes. One for reading, one for -;; creating a new mail etc. Maybe those should be connected. - -;; Example for GNUS (when we write a reply, we want dabbrev to look in -;; the article for expansion): -;; (set (make-local-variable 'dabbrev-friend-buffer-function) -;; (lambda (buffer) -;; (save-excursion -;; (set-buffer buffer) -;; (memq major-mode '(news-reply-mode gnus-article-mode))))) - - -;; Known bugs and limitations. -;; - Possible to do several levels of `dabbrev-completion' in the -;; minibuffer. -;; - dabbrev-completion doesn't handle resetting the globals variables -;; right. It resets them after finding the abbrev. - -;; Future enhancements -;; - Check the tags-files? Like tags-complete? -;; - Add the possibility of searching both forward and backward to -;; the nearest expansion. -;; - Check the kill-ring when everything else fails. (Maybe something -;; for hippie-expand?). [Bng] - -;;; These people gave suggestions: -;; [hymie] Hyman Rosen -;; [burgett] Steve Burgett -;; [jules] Julian Gosnell -;; [kifer] Michael Kifer -;; [ake] Ake Stenhoff -;; [alon] Alon Albert -;; [tromey] Tom Tromey -;; [Rolf] Rolf Schreiber -;; [Petri] Petri Raitio -;; [ejb] Jay Berkenbilt -;; [hawley] Bob Hawley -;; ... and to all the people who have participated in the beta tests. - -;;; Code: - -;;---------------------------------------------------------------- -;; Customization variables -;;---------------------------------------------------------------- - -(defgroup dabbrev nil - "Dynamic Abbreviations" - :tag "Dynamic Abbreviations" - :group 'abbrev - :group 'convenience) - -(defcustom dabbrev-backward-only nil - "*If non-nil, `dabbrev-expand' only looks backwards." - :type 'boolean - :group 'dabbrev) - -(defcustom dabbrev-limit nil - "*Limits region searched by `dabbrev-expand' to this many chars away." - :type '(choice (const :tag "off" nil) - integer) - :group 'dabbrev) - -(defcustom dabbrev-abbrev-skip-leading-regexp nil - "*Regexp for skipping leading characters of an abbreviation. - -Example: Set this to \"\\\\$\" for programming languages -in which variable names may appear with or without a leading `$'. -\(For example, in Makefiles.\) - -Set this to nil if no characters should be skipped." - :type '(choice regexp - (const :tag "off" nil)) - :group 'dabbrev) - -(defcustom dabbrev--eliminate-newlines t - "*Non-nil means dabbrev should not insert newlines. -Instead it converts them to spaces." - :type 'boolean - :group 'dabbrev) - -;; XEmacs change: The old defaults are just too obnoxious. Rarely -;; do you actually want the case-folding behavior here, even though -;; it's useful to have case-fold-search set to t most of the time. -(defcustom dabbrev-case-fold-search nil ;;'case-fold-search - "*Control whether dabbrev searches should ignore case. -A value of nil means case is significant. -A value of `case-fold-search' means case is significant - if `case-fold-search' is nil. -Any other non-nil version means case is not significant." - :type '(choice (const :tag "off" nil) - (const :tag "like search" case-fold-search) - (other :tag "on" t)) - :group 'dabbrev) - -(defcustom dabbrev-upcase-means-case-search nil - "*The significance of an uppercase character in an abbreviation. -nil means case fold search when searching for possible expansions; -non-nil means case sensitive search. - -This variable has an effect only when the value of -`dabbrev-case-fold-search' says to ignore case." - :type 'boolean - :group 'dabbrev) - -(defcustom dabbrev-case-distinction 'case-replace - "*Whether dabbrev treats expansions as the same if they differ in case. - -A value of nil means treat them as different. -A value of `case-replace' means distinguish them if `case-replace' is nil. -Any other non-nil value means to treat them as the same. - -This variable has an effect only when the value of -`dabbrev-case-fold-search' specifies to ignore case." - :type '(choice (const :tag "off" nil) - (const :tag "based on `case-replace'" case-replace) - (other :tag "on" t)) - :group 'dabbrev - :version "21.4") - -(defcustom dabbrev-case-replace 'case-replace - "*Whether dabbrev applies the abbreviations's case pattern to the expansion. - -A value of nil means preserve the expansion's case pattern. -A value of `case-replace' means preserve it if `case-replace' is nil. -Any other non-nil value means modify the expansion -by applying the abbreviation's case pattern to it. - -This variable has an effect only when the value of -`dabbrev-case-fold-search' specifies to ignore case." - :type '(choice (const :tag "off" nil) - (const :tag "based on `case-replace'" case-replace) - (other :tag "on" t)) - :group 'dabbrev) - -(defcustom dabbrev-abbrev-char-regexp nil - "*Regexp to recognize a character in an abbreviation or expansion. -This regexp will be surrounded with \\\\( ... \\\\) when actually used. - -Set this variable to \"\\\\sw\" if you want ordinary words or -\"\\\\sw\\\\|\\\\s_\" if you want symbols (including characters whose -syntax is \"symbol\" as well as those whose syntax is \"word\". - -The value nil has a special meaning: the abbreviation is from point to -previous word-start, but the search is for symbols. - -For instance, if you are programming in Lisp, `yes-or-no-p' is a symbol, -while `yes', `or', `no' and `p' are considered words. If this -variable is nil, then expanding `yes-or-no-' looks for a symbol -starting with or containing `no-'. If you set this variable to -\"\\\\sw\\\\|\\\\s_\", that expansion looks for a symbol starting with -`yes-or-no-'. Finally, if you set this variable to \"\\\\sw\", then -expanding `yes-or-no-' signals an error because `-' is not part of a word; -but expanding `yes-or-no' looks for a word starting with `no'. - -The recommended value is \"\\\\sw\\\\|\\\\s_\"." - :type '(choice (const nil) - regexp) - :group 'dabbrev) - -(defcustom dabbrev-check-all-buffers t - "*Non-nil means dabbrev package should search *all* buffers. - -Dabbrev always searches the current buffer first. Then, if -`dabbrev-check-other-buffers' says so, it searches the buffers -designated by `dabbrev-select-buffers-function'. - -Then, if `dabbrev-check-all-buffers' is non-nil, dabbrev searches -all the other buffers, except those named in `dabbrev-ignored-buffer-names', -or matched by `dabbrev-ignored-regexps'." - :type 'boolean - :group 'dabbrev) - -(defcustom dabbrev-ignored-buffer-names '("*Messages*" "*Buffer List*") - "*List of buffer names that dabbrev should not check. -See also `dabbrev-ignored-buffer-regexps'." - :type '(repeat (string :tag "Buffer name")) - :group 'dabbrev - :version "20.3") - -(defcustom dabbrev-ignored-buffer-regexps nil - "*List of regexps matching names of buffers that dabbrev should not check. -See also `dabbrev-ignored-buffer-names'." - :type '(repeat regexp) - :group 'dabbrev - :version "21.1") - -(defcustom dabbrev-check-other-buffers t - "*Should \\[dabbrev-expand] look in other buffers?\ - -nil: Don't look in other buffers. -t: Also look for expansions in the buffers pointed out by - `dabbrev-select-buffers-function'. -Anything else: When we can't find any more expansions in -the current buffer, then ask the user whether to look in other -buffers too. - -The default value is t." - :type '(choice (const :tag "off" nil) - (const :tag "on" t) - (other :tag "ask" other)) - :group 'dabbrev) - -;; I guess setting this to a function that selects all C- or C++- -;; mode buffers would be a good choice for a debugging buffer, -;; when debugging C- or C++-code. -(defvar dabbrev-select-buffers-function 'dabbrev--select-buffers - "A function that selects buffers that should be searched by dabbrev. -The function should take no arguments and return a list of buffers to -search for expansions. See the source of `dabbrev--select-buffers' -for an example. - -A mode setting this variable should make it buffer local.") - -(defcustom dabbrev-friend-buffer-function 'dabbrev--same-major-mode-p - "*A function to decide whether dabbrev should search OTHER-BUFFER. -The function should take one argument, OTHER-BUFFER, and return -non-nil if that buffer should be searched. Have a look at -`dabbrev--same-major-mode-p' for an example. - -The value of `dabbrev-friend-buffer-function' has an effect only if -the value of `dabbrev-select-buffers-function' uses it. The function -`dabbrev--select-buffers' is one function you can use here. - -A mode setting this variable should make it buffer local." - :type 'function - :group 'dabbrev) - -(defcustom dabbrev-search-these-buffers-only nil - "If non-nil, a list of buffers which dabbrev should search. -If this variable is non-nil, dabbrev will only look in these buffers. -It will not even look in the current buffer if it is not a member of -this list.") - -;;---------------------------------------------------------------- -;; Internal variables -;;---------------------------------------------------------------- - -;; Last obarray of completions in `dabbrev-completion' -(defvar dabbrev--last-obarray nil) - -;; Table of expansions seen so far -(defvar dabbrev--last-table nil) - -;; Last string we tried to expand. -(defvar dabbrev--last-abbreviation nil) - -;; Location last abbreviation began -(defvar dabbrev--last-abbrev-location nil) - -;; Direction of last dabbrevs search -(defvar dabbrev--last-direction 0) - -;; Last expansion of an abbreviation. -(defvar dabbrev--last-expansion nil) - -;; Location the last expansion was found. -(defvar dabbrev--last-expansion-location nil) - -;; The list of remaining buffers with the same mode as current buffer. -(defvar dabbrev--friend-buffer-list nil) - -;; The buffer we looked in last, not counting the current buffer. -(defvar dabbrev--last-buffer nil) - -;; The buffer we found the expansion last time. -(defvar dabbrev--last-buffer-found nil) - -;; The buffer we last did a completion in. -(defvar dabbrev--last-completion-buffer nil) - -;; If non-nil, a function to use when copying successive words. -;; It should be `upcase' or `downcase'. -(defvar dabbrev--last-case-pattern nil) - -;; Same as dabbrev-check-other-buffers, but is set for every expand. -(defvar dabbrev--check-other-buffers dabbrev-check-other-buffers) - -;; The regexp for recognizing a character in an abbreviation. -(defvar dabbrev--abbrev-char-regexp nil) - -;;---------------------------------------------------------------- -;; Macros -;;---------------------------------------------------------------- - -;;; Get the buffer that mini-buffer was activated from -(defsubst dabbrev--minibuffer-origin () - (car (cdr (buffer-list)))) - -;; Make a list of some of the elements of LIST. -;; Check each element of LIST, storing it temporarily in the -;; variable ELEMENT, and include it in the result -;; if CONDITION evaluates non-nil. -(defmacro dabbrev-filter-elements (element list condition) - `(let (dabbrev-result dabbrev-tail ,element) - (setq dabbrev-tail ,list) - (while dabbrev-tail - (setq ,element (car dabbrev-tail)) - (if ,condition - (setq dabbrev-result (cons ,element dabbrev-result))) - (setq dabbrev-tail (cdr dabbrev-tail))) - (nreverse dabbrev-result))) - -;; XEmacs:: -(defun dabbrev--extent-clicked-on (event extent user-data) - (let ((buffer (first user-data)) - (point (second user-data)) - (init (third user-data)) - (wconfig (fourth user-data))) - (set-window-configuration wconfig) - (set-buffer buffer) - (goto-char point) - (dabbrev--substitute-expansion nil init (extent-string extent) nil))) - -;;---------------------------------------------------------------- -;; Exported functions -;;---------------------------------------------------------------- - -;; XEmacs changes: -;;;###autoload -(define-key global-map [(meta /)] 'dabbrev-expand) -;;;??? Do we want this? -;;;###autoload -(define-key global-map [(meta control /)] 'dabbrev-completion) - -;;;###autoload -(defun dabbrev-completion (&optional arg) - "Completion on current word. -Like \\[dabbrev-expand] but finds all expansions in the current buffer -and presents suggestions for completion. - -With a prefix argument, it searches all buffers accepted by the -function pointed out by `dabbrev-friend-buffer-function' to find the -completions. - -If the prefix argument is 16 (which comes from C-u C-u), -then it searches *all* buffers. - -With no prefix argument, it reuses an old completion list -if there is a suitable one already." - - (interactive "*P") - (dabbrev--reset-global-variables) - (let* ((dabbrev-check-other-buffers (and arg t)) - (dabbrev-check-all-buffers - (and arg (= (prefix-numeric-value arg) 16))) - (abbrev (dabbrev--abbrev-at-point)) - (ignore-case-p (and (if (eq dabbrev-case-fold-search 'case-fold-search) - case-fold-search - dabbrev-case-fold-search) - (or (not dabbrev-upcase-means-case-search) - (string= abbrev (downcase abbrev))))) - (my-obarray dabbrev--last-obarray) - init) - (save-excursion - (if (and (null arg) - my-obarray - (or (eq dabbrev--last-completion-buffer (current-buffer)) - (and (window-minibuffer-p (selected-window)) - (eq dabbrev--last-completion-buffer - (dabbrev--minibuffer-origin)))) - dabbrev--last-abbreviation - (>= (length abbrev) (length dabbrev--last-abbreviation)) - (string= dabbrev--last-abbreviation - (substring abbrev 0 - (length dabbrev--last-abbreviation))) - (setq init (try-completion abbrev my-obarray))) - ;; We can reuse the existing completion list. - nil - ;;-------------------------------- - ;; New abbreviation to expand. - ;;-------------------------------- - (setq dabbrev--last-abbreviation abbrev) - ;; Find all expansion - (let ((completion-list - (dabbrev--find-all-expansions abbrev ignore-case-p)) - (completion-ignore-case ignore-case-p)) - ;; Make an obarray with all expansions - (setq my-obarray (make-vector (length completion-list) 0)) - (or (> (length my-obarray) 0) - (error "No dynamic expansion for \"%s\" found%s" - abbrev - (if dabbrev--check-other-buffers "" " in this-buffer"))) - (cond - ((or (not ignore-case-p) - (not dabbrev-case-replace)) - (mapc (function (lambda (string) - (intern string my-obarray))) - completion-list)) - ((string= abbrev (upcase abbrev)) - (mapc (function (lambda (string) - (intern (upcase string) my-obarray))) - completion-list)) - ((string= (substring abbrev 0 1) - (upcase (substring abbrev 0 1))) - (mapc (function (lambda (string) - (intern (capitalize string) my-obarray))) - completion-list)) - (t - (mapc (function (lambda (string) - (intern (downcase string) my-obarray))) - completion-list))) - (setq dabbrev--last-obarray my-obarray) - (setq dabbrev--last-completion-buffer (current-buffer)) - ;; Find the longest common string. - (setq init (try-completion abbrev my-obarray))))) - ;;-------------------------------- - ;; Let the user choose between the expansions - ;;-------------------------------- - (or (stringp init) - (setq init abbrev)) - (cond - ;; * Replace string fragment with matched common substring completion. - ((and (not (string-equal init "")) - (not (string-equal (downcase init) (downcase abbrev)))) - (if (> (length (all-completions init my-obarray)) 1) - (message "Repeat `%s' to see all completions" - (key-description (this-command-keys))) - (message "The only possible completion")) - (dabbrev--substitute-expansion nil abbrev init nil)) - (t - ;; * String is a common substring completion already. Make list. - (message "Making completion list...") - ;; XEmacs change: - ;; construct the arg before calling `with-output-to-temp-buffer' - ;; because that changes the window config - (let ((arg (list (current-buffer) - (set-marker (make-marker) (point)) - init - (current-window-configuration)))) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list (all-completions init my-obarray) - :activate-callback - 'dabbrev--extent-clicked-on - :user-data arg))) - (message "Making completion list...done"))) - (and (window-minibuffer-p (selected-window)) - (message nil)))) - -;;;###autoload -(defun dabbrev-expand (arg) - "Expand previous word \"dynamically\". - -Expands to the most recent, preceding word for which this is a prefix. -If no suitable preceding word is found, words following point are -considered. If still no suitable word is found, then look in the -buffers accepted by the function pointed out by variable -`dabbrev-friend-buffer-function'. - -A positive prefix argument, N, says to take the Nth backward *distinct* -possibility. A negative argument says search forward. - -If the cursor has not moved from the end of the previous expansion and -no argument is given, replace the previously-made expansion -with the next possible expansion not yet tried. - -The variable `dabbrev-backward-only' may be used to limit the -direction of search to backward if set non-nil. - -See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." - (interactive "*P") - (let (abbrev record-case-pattern - expansion old direction (orig-point (point))) - ;; abbrev -- the abbrev to expand - ;; expansion -- the expansion found (eventually) or nil until then - ;; old -- the text currently in the buffer - ;; (the abbrev, or the previously-made expansion) - (save-excursion - (if (and (null arg) - (markerp dabbrev--last-abbrev-location) - (marker-position dabbrev--last-abbrev-location) - (or (eq last-command this-command) - (and (window-minibuffer-p (selected-window)) - (= dabbrev--last-abbrev-location - (point))))) - ;; Find a different expansion for the same abbrev as last time. - (progn - (setq abbrev dabbrev--last-abbreviation) - (setq old dabbrev--last-expansion) - (setq direction dabbrev--last-direction)) - ;; If the user inserts a space after expanding - ;; and then asks to expand again, always fetch the next word. - (if (and (eq (preceding-char) ?\ ) - (markerp dabbrev--last-abbrev-location) - (marker-position dabbrev--last-abbrev-location) - (= (point) (1+ dabbrev--last-abbrev-location))) - (progn - ;; The "abbrev" to expand is just the space. - (setq abbrev " ") - (save-excursion - (if dabbrev--last-buffer - (set-buffer dabbrev--last-buffer)) - ;; Find the end of the last "expansion" word. - (if (or (eq dabbrev--last-direction 1) - (and (eq dabbrev--last-direction 0) - (< dabbrev--last-expansion-location (point)))) - (setq dabbrev--last-expansion-location - (+ dabbrev--last-expansion-location - (length dabbrev--last-expansion)))) - (goto-char dabbrev--last-expansion-location) - ;; Take the following word, with intermediate separators, - ;; as our expansion this time. - (re-search-forward - (concat "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)")) - (setq expansion (buffer-substring-no-properties - dabbrev--last-expansion-location (point))) - - ;; Record the end of this expansion, in case we repeat this. - (setq dabbrev--last-expansion-location (point))) - ;; Indicate that dabbrev--last-expansion-location is - ;; at the end of the expansion. - (setq dabbrev--last-direction -1)) - - ;; We have a different abbrev to expand. - (dabbrev--reset-global-variables) - (setq direction (if (null arg) - (if dabbrev-backward-only 1 0) - (prefix-numeric-value arg))) - (setq abbrev (dabbrev--abbrev-at-point)) - (setq record-case-pattern t) - (setq old nil))) - - ;;-------------------------------- - ;; Find the expansion - ;;-------------------------------- - (or expansion - (setq expansion - (dabbrev--find-expansion abbrev direction - (and (if (eq dabbrev-case-fold-search 'case-fold-search) - case-fold-search - dabbrev-case-fold-search) - (or (not dabbrev-upcase-means-case-search) - (string= abbrev (downcase abbrev)))))))) - (cond - ((not expansion) - (dabbrev--reset-global-variables) - (if old - (save-excursion - (setq buffer-undo-list (cons orig-point buffer-undo-list)) - ;; Put back the original abbrev with its original case pattern. - (search-backward old) - (insert abbrev) - (delete-region (point) (+ (point) (length old))))) - (error "No%s dynamic expansion for `%s' found" - (if old " further" "") abbrev)) - (t - (if (not (or (eq dabbrev--last-buffer dabbrev--last-buffer-found) - (minibuffer-window-active-p (selected-window)))) - (progn - (message "Expansion found in '%s'" - (buffer-name dabbrev--last-buffer)) - (setq dabbrev--last-buffer-found dabbrev--last-buffer)) - (message nil)) - (if (and (or (eq (current-buffer) dabbrev--last-buffer) - (null dabbrev--last-buffer)) - (numberp dabbrev--last-expansion-location) - (and (> dabbrev--last-expansion-location (point)))) - (setq dabbrev--last-expansion-location - (copy-marker dabbrev--last-expansion-location))) - ;; Success: stick it in and return. - (setq buffer-undo-list (cons orig-point buffer-undo-list)) - (dabbrev--substitute-expansion old abbrev expansion - record-case-pattern) - - ;; Save state for re-expand. - (setq dabbrev--last-expansion expansion) - (setq dabbrev--last-abbreviation abbrev) - (setq dabbrev--last-abbrev-location (point-marker)))))) - -;;---------------------------------------------------------------- -;; Local functions -;;---------------------------------------------------------------- - -;;; Checks if OTHER-BUFFER has the same major mode as current buffer. -(defun dabbrev--same-major-mode-p (other-buffer) - (eq major-mode - (save-excursion - (set-buffer other-buffer) - major-mode))) - -;;; Back over all abbrev type characters and then moves forward over -;;; all skip characters. -(defun dabbrev--goto-start-of-abbrev () - ;; Move backwards over abbrev chars - (save-match-data - (if (not (bobp)) - (progn - (forward-char -1) - (while (and (looking-at dabbrev--abbrev-char-regexp) - (not (bobp)) - (not (= (point) (field-beginning (point) nil - (1- (point)))))) - (forward-char -1)) - (or (looking-at dabbrev--abbrev-char-regexp) - (forward-char 1)))) - (and dabbrev-abbrev-skip-leading-regexp - (while (looking-at dabbrev-abbrev-skip-leading-regexp) - (forward-char 1))))) - -;;; Extract the symbol at point to serve as abbreviation. -(defun dabbrev--abbrev-at-point () - ;; Check for error - (if (bobp) - (error "No possible abbreviation preceding point")) - ;; Return abbrev at point - (save-excursion - ;; Record the end of the abbreviation. - (setq dabbrev--last-abbrev-location (point)) - ;; If we aren't right after an abbreviation, - ;; move point back to just after one. - ;; This is so the user can get successive words - ;; by typing the punctuation followed by M-/. - (save-match-data - (if (save-excursion - (forward-char -1) - (not (looking-at (concat "\\(" - (or dabbrev-abbrev-char-regexp - "\\sw\\|\\s_") - "\\)+")))) - (if (re-search-backward (or dabbrev-abbrev-char-regexp - "\\sw\\|\\s_") - nil t) - (forward-char 1) - (error "No possible abbreviation preceding point")))) - ;; Now find the beginning of that one. - (dabbrev--goto-start-of-abbrev) - (buffer-substring-no-properties - dabbrev--last-abbrev-location (point)))) - -;;; Initializes all global variables -(defun dabbrev--reset-global-variables () - ;; dabbrev--last-obarray and dabbrev--last-completion-buffer - ;; must not be reset here. - (setq dabbrev--last-table nil - dabbrev--last-abbreviation nil - dabbrev--last-abbrev-location nil - dabbrev--last-direction nil - dabbrev--last-expansion nil - dabbrev--last-expansion-location nil - dabbrev--friend-buffer-list nil - dabbrev--last-buffer nil - dabbrev--last-buffer-found nil - dabbrev--abbrev-char-regexp (or dabbrev-abbrev-char-regexp - "\\sw\\|\\s_") - dabbrev--check-other-buffers dabbrev-check-other-buffers)) - -(defun dabbrev--select-buffers () - "Return a list of other buffers to search for a possible abbrev. -The current buffer is not included in the list. - -This function makes a list of all the buffers returned by `buffer-list', -then discards buffers whose names match `dabbrev-ignored-buffer-names' -or `dabbrev-ignored-buffer-regexps'. It also discards buffers for which -`dabbrev-friend-buffer-function', if it is bound, returns nil when called -with the buffer as argument. -It returns the list of the buffers that are not discarded." - (dabbrev-filter-elements - buffer (buffer-list) - (and (not (eq (current-buffer) buffer)) - (not (dabbrev--ignore-buffer-p buffer)) - (boundp 'dabbrev-friend-buffer-function) - (funcall dabbrev-friend-buffer-function buffer)))) - -(defun dabbrev--try-find (abbrev reverse n ignore-case) - "Search for ABBREV, backwards if REVERSE, N times. -If IGNORE-CASE is non-nil, ignore case while searching. -Return the expansion found, and save the location of the start -of the expansion in `dabbrev--last-expansion-location'." - (save-excursion - (save-restriction - (widen) - (let ((expansion nil)) - (and dabbrev--last-expansion-location - (goto-char dabbrev--last-expansion-location)) - (let ((case-fold-search ignore-case) - (count n)) - (while (and (> count 0) - (setq expansion (dabbrev--search abbrev - reverse - (and ignore-case - (if (eq dabbrev-case-distinction 'case-replace) - case-replace - dabbrev-case-distinction)) - ))) - (setq count (1- count)))) - (and expansion - (setq dabbrev--last-expansion-location (point))) - expansion)))) - -(defun dabbrev--find-all-expansions (abbrev ignore-case) - "Return a list of all possible expansions of ABBREV. -If IGNORE-CASE is non-nil, accept matches which differ in case." - (let ((all-expansions nil) - expansion) - (save-excursion - (goto-char (point-min)) - (while (setq expansion (dabbrev--find-expansion abbrev -1 ignore-case)) - (setq all-expansions (cons expansion all-expansions)))) - all-expansions)) - -(defun dabbrev--scanning-message () - (unless (window-minibuffer-p (selected-window)) - (message "Scanning `%s'" (buffer-name (current-buffer))))) - -(defun dabbrev--ignore-buffer-p (buffer) - "Return non-nil if BUFFER should be ignored by dabbrev." - (let ((bn (buffer-name buffer))) - (or (member bn dabbrev-ignored-buffer-names) - (let ((tail dabbrev-ignored-buffer-regexps) - (match nil)) - (while (and tail (not match)) - (setq match (string-match (car tail) bn) - tail (cdr tail))) - match)))) - -(defun dabbrev--find-expansion (abbrev direction ignore-case) - "Find one occurrence of ABBREV, and return the expansion. -DIRECTION > 0 means look that many times backwards. -DIRECTION < 0 means look that many times forward. -DIRECTION = 0 means try both backward and forward. -IGNORE-CASE non-nil means ignore case when searching. -This sets `dabbrev--last-direction' to 1 or -1 according -to the direction in which the occurrence was actually found. -It sets `dabbrev--last-expansion-location' to the location -of the start of the occurrence." - (save-excursion - ;; If we were scanning something other than the current buffer, - ;; continue scanning there. - (when dabbrev--last-buffer - (set-buffer dabbrev--last-buffer) - (dabbrev--scanning-message)) - (or - ;; ------------------------------------------ - ;; Look backward in current buffer. - ;; ------------------------------------------ - (and (not dabbrev-search-these-buffers-only) - (>= direction 0) - (setq dabbrev--last-direction (min 1 direction)) - (dabbrev--try-find abbrev t - (max 1 direction) - ignore-case)) - ;; ------------------------------------------ - ;; Look forward in current buffer - ;; or whatever buffer we were last scanning. - ;; ------------------------------------------ - (and (or (not dabbrev-search-these-buffers-only) - dabbrev--last-buffer) - (<= direction 0) - (setq dabbrev--last-direction -1) - (dabbrev--try-find abbrev nil - (max 1 (- direction)) - ignore-case)) - ;; ------------------------------------------ - ;; Look in other buffers. - ;; Always start at (point-min) and look forward. - ;; ------------------------------------------ - (progn - (setq dabbrev--last-direction -1) - (unless dabbrev--last-buffer - ;; If we have just now begun to search other buffers, - ;; determine which other buffers we should check. - ;; Put that list in dabbrev--friend-buffer-list. - (or dabbrev--friend-buffer-list - (setq dabbrev--friend-buffer-list - (dabbrev--make-friend-buffer-list)))) - ;; Walk through the buffers till we find a match. - (let (expansion) - (while (and (not expansion) dabbrev--friend-buffer-list) - (setq dabbrev--last-buffer - (car dabbrev--friend-buffer-list)) - (setq dabbrev--friend-buffer-list - (cdr dabbrev--friend-buffer-list)) - (set-buffer dabbrev--last-buffer) - (dabbrev--scanning-message) - (setq dabbrev--last-expansion-location (point-min)) - (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case))) - expansion))))) - -;; Compute the list of buffers to scan. -;; If dabbrev-search-these-buffers-only, then the current buffer -;; is included in this list if it should be searched. -;; Otherwise, the current buffer is searched first specially., -;; and it is not included in this list. -(defun dabbrev--make-friend-buffer-list () - (let ((list (mapcar (function get-buffer) - dabbrev-search-these-buffers-only))) - (when (and (null dabbrev-search-these-buffers-only) - dabbrev--check-other-buffers - (or (eq dabbrev--check-other-buffers t) - (setq dabbrev--check-other-buffers - (y-or-n-p "Scan other buffers also? ")))) - (setq list (funcall dabbrev-select-buffers-function)) - ;; If dabbrev-check-all-buffers, tack on all the other - ;; buffers at the end of the list, except those which are - ;; specifically to be ignored. - (if dabbrev-check-all-buffers - (setq list - (append list - (dabbrev-filter-elements - buffer (buffer-list) - (and (not (memq buffer list)) - (not (dabbrev--ignore-buffer-p buffer))))))) - ;; Remove the current buffer. - (setq list (delq (current-buffer) list))) - ;; Move buffers in the list that are visible on the screen - ;; to the front of the list, but don't add anything to the list. - (if list - (walk-windows (lambda (w) - (unless (eq w (selected-window)) - (if (memq (window-buffer w) list) - (setq list - (cons (window-buffer w) - (delq (window-buffer w) - list)))))))) - ;; In a minibuffer, search the buffer it was activated from, - ;; first after the minibuffer itself. Unless we aren't supposed - ;; to search the current buffer either. - (if (and (window-minibuffer-p (selected-window)) - (not dabbrev-search-these-buffers-only)) - (setq list - (cons (dabbrev--minibuffer-origin) - (delq (dabbrev--minibuffer-origin) list)))) - list)) - -(defun dabbrev--safe-replace-match (string &optional fixedcase literal) - (if (eq major-mode 'picture-mode) - (picture-replace-match string fixedcase literal) - (replace-match string fixedcase literal))) - -;;;---------------------------------------------------------------- -(defun dabbrev--substitute-expansion (old abbrev expansion record-case-pattern) - "Replace OLD with EXPANSION in the buffer. -OLD is text currently in the buffer, perhaps the abbreviation -or perhaps another expansion that was tried previously. -ABBREV is the abbreviation we are expanding. -It is \" \" if we are copying subsequent words. -EXPANSION is the expansion substring to be used this time. -RECORD-CASE-PATTERN, if non-nil, means set `dabbrev--last-case-pattern' -to record whether we upcased the expansion, downcased it, or did neither." - ;;(undo-boundary) - (let ((use-case-replace (and (if (eq dabbrev-case-fold-search 'case-fold-search) - case-fold-search - dabbrev-case-fold-search) - (or (not dabbrev-upcase-means-case-search) - (string= abbrev (downcase abbrev))) - (if (eq dabbrev-case-replace 'case-replace) - case-replace - dabbrev-case-replace)))) - - ;; If we upcased or downcased the original expansion, - ;; do likewise for the subsequent words when we copy them. - ;; Don't do any of the usual case processing, though. - (when (equal abbrev " ") - (if dabbrev--last-case-pattern - (setq expansion - (funcall dabbrev--last-case-pattern expansion))) - (setq use-case-replace nil)) - - ;; If the expansion has mixed case - ;; and it is not simply a capitalized word, - ;; or if the abbrev has mixed case, - ;; and if the given abbrev's case pattern - ;; matches the start of the expansion, - ;; copy the expansion's case - ;; instead of downcasing all the rest. - ;; Treat a one-capital-letter abbrev as "not all upper case", - ;; so as to force preservation of the expansion's pattern - ;; if the expansion starts with a capital letter. - (let ((expansion-rest (substring expansion 1))) - (if (and (not (and (or (string= expansion-rest (downcase expansion-rest)) - (string= expansion-rest (upcase expansion-rest))) - (or (string= abbrev (downcase abbrev)) - (and (string= abbrev (upcase abbrev)) - (> (length abbrev) 1))))) - (string= abbrev - (substring expansion 0 (length abbrev)))) - (setq use-case-replace nil))) - - ;; If the abbrev and the expansion are both all-lower-case - ;; then don't do any conversion. The conversion would be a no-op - ;; for this replacement, but it would carry forward to subsequent words. - ;; The goal of this is to preven that carrying forward. - (if (and (string= expansion (downcase expansion)) - (string= abbrev (downcase abbrev))) - (setq use-case-replace nil)) - - (if use-case-replace - (setq expansion (downcase expansion))) - - ;; In case we insert subsequent words, - ;; record if we upcased or downcased the first word, - ;; in order to do likewise for subsequent words. - (and record-case-pattern - (setq dabbrev--last-case-pattern - (and use-case-replace - (cond ((equal abbrev (upcase abbrev)) 'upcase) - ((equal abbrev (downcase abbrev)) 'downcase))))) - - ;; Convert whitespace to single spaces. - (if dabbrev--eliminate-newlines - ;; Start searching at end of ABBREV so that any whitespace - ;; carried over from the existing text is not changed. - (let ((pos (length abbrev))) - (while (string-match "[\n \t]+" expansion pos) - (setq pos (1+ (match-beginning 0))) - (setq expansion (replace-match " " nil nil expansion))))) - - (if old - (save-excursion - (search-backward old)) - ;;(set-match-data (list (point-marker) (point-marker))) - (search-backward abbrev) - (search-forward abbrev)) - - ;; Make case of replacement conform to case of abbreviation - ;; provided (1) that kind of thing is enabled in this buffer - ;; and (2) the replacement itself is all lower case. - (dabbrev--safe-replace-match expansion - (not use-case-replace) - t))) - - -;;;---------------------------------------------------------------- -;;; Search function used by dabbrevs library. - - -(defun dabbrev--search (abbrev reverse ignore-case) - "Search for something that could be used to expand ABBREV. - -Second arg, REVERSE, is t for reverse search, nil for forward. -The variable `dabbrev-limit' controls the maximum search region size. -Third argument IGNORE-CASE non-nil means treat case as insignificant while -looking for a match and when comparing with previous matches. Also if -that's non-nil and the match is found at the beginning of a sentence -and is in lower case except for the initial then it is converted to -all lower case for return. - -Table of expansions already seen is examined in buffer -`dabbrev--last-table' so that only distinct possibilities are found -by dabbrev-re-expand. - -Returns the expansion found, or nil if not found. -Leaves point at the location of the start of the expansion." - (save-match-data - (let ((pattern1 (concat (regexp-quote abbrev) - "\\(" dabbrev--abbrev-char-regexp "\\)")) - (pattern2 (concat (regexp-quote abbrev) - "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)")) - ;; This makes it possible to find matches in minibuffer prompts - ;; even when they are "inviolable". - (inhibit-point-motion-hooks t) - found-string result) - ;; Limited search. - (save-restriction - (and dabbrev-limit - (narrow-to-region dabbrev--last-expansion-location - (+ (point) - (if reverse (- dabbrev-limit) dabbrev-limit)))) - ;;-------------------------------- - ;; Look for a distinct expansion, using dabbrev--last-table. - ;;-------------------------------- - (while (and (not found-string) - (if reverse - (re-search-backward pattern1 nil t) - (re-search-forward pattern1 nil t))) - (goto-char (match-beginning 0)) - ;; In case we matched in the middle of a word, - ;; back up to start of word and verify we still match. - (dabbrev--goto-start-of-abbrev) - - (if (not (looking-at pattern1)) - nil - ;; We have a truly valid match. Find the end. - (re-search-forward pattern2) - (setq found-string (buffer-substring-no-properties - (match-beginning 0) (match-end 0))) - (setq result found-string) - (and ignore-case (setq found-string (downcase found-string))) - ;; Ignore this match if it's already in the table. - (if (dabbrev-filter-elements - table-string dabbrev--last-table - (string= found-string table-string)) - (setq found-string nil))) - ;; Prepare to continue searching. - (if reverse - (goto-char (match-beginning 0)) - (goto-char (match-end 0)))) - ;; If we found something, use it. - (when found-string - ;; Put it into `dabbrev--last-table' - ;; and return it (either downcased, or as is). - (setq dabbrev--last-table - (cons found-string dabbrev--last-table)) - result))))) - -(dolist (mess '("^No dynamic expansion for .* found$" - "^No further dynamic expansion for .* found$" - "^No possible abbreviation preceding point$")) - (add-to-list 'debug-ignored-errors mess)) - -(provide 'dabbrev) - -;; dabbrev.el ends here diff --git a/xemacs-packages/lisp/edit-utils/desktop.el b/xemacs-packages/lisp/edit-utils/desktop.el deleted file mode 100644 index 108ac103..00000000 --- a/xemacs-packages/lisp/edit-utils/desktop.el +++ /dev/null @@ -1,801 +0,0 @@ -;;; desktop.el --- save partial status of Emacs when killed - -;; Copyright (C) 1993, 1994, 1995, 1997, 2000, 2001 -;; Free Software Foundation, Inc. - -;; Author: Morten Welinder -;; Keywords: convenience -;; Favourite-brand-of-beer: None, I hate beer. - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: GNU Emacs 20.1, partially with 21.2. - -;;; Commentary: - -;; Save the Desktop, i.e., -;; - some global variables -;; - the list of buffers with associated files. For each buffer also -;; - the major mode -;; - the default directory -;; - the point -;; - the mark & mark-active -;; - buffer-read-only -;; - some local variables - -;; To use this, first put these two lines in the bottom of your .emacs -;; file (the later the better): -;; -;; (desktop-load-default) -;; (desktop-read) -;; -;; Between these two lines you may wish to add something that updates the -;; variables `desktop-globals-to-save' and/or `desktop-locals-to-save'. If -;; for instance you want to save the local variable `foobar' for every buffer -;; in which it is local, you could add the line -;; -;; (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save)) -;; -;; To avoid saving excessive amounts of data you may also wish to add -;; something like the following -;; -;; (add-hook 'kill-emacs-hook -;; '(lambda () -;; (desktop-truncate search-ring 3) -;; (desktop-truncate regexp-search-ring 3))) -;; -;; which will make sure that no more than three search items are saved. You -;; must place this line *after* the `(desktop-load-default)' line. See also -;; the variable `desktop-save-hook'. - -;; Start Emacs in the root directory of your "project". The desktop saver -;; is inactive by default. You activate it by M-x desktop-save RET. When -;; you exit the next time the above data will be saved. This ensures that -;; all the files you were editing will be reloaded the next time you start -;; Emacs from the same directory and that points will be set where you -;; left them. If you save a desktop file in your home directory it will -;; act as a default desktop when you start Emacs from a directory that -;; doesn't have its own. I never do this, but you may want to. - -;; Some words on minor modes: Most minor modes are controlled by -;; buffer-local variables, which have a standard save / restore -;; mechanism. To handle all minor modes, we take the following -;; approach: (1) check whether the variable name from -;; `minor-mode-alist' is also a function; and (2) use translation -;; table `desktop-minor-mode-table' in the case where the two names -;; are not the same. - -;; By the way: don't use desktop.el to customize Emacs -- the file .emacs -;; in your home directory is used for that. Saving global default values -;; for buffers is an example of misuse. - -;; PLEASE NOTE: The kill ring can be saved as specified by the variable -;; `desktop-globals-to-save' (by default it isn't). This may result in saving -;; things you did not mean to keep. Use M-x desktop-clear RET. - -;; Thanks to hetrick@phys.uva.nl (Jim Hetrick) for useful ideas. -;; avk@rtsg.mot.com (Andrew V. Klein) for a dired tip. -;; chris@tecc.co.uk (Chris Boucher) for a mark tip. -;; f89-kam@nada.kth.se (Klas Mellbourn) for a mh-e tip. -;; kifer@sbkifer.cs.sunysb.edu (M. Kifer) for a bug hunt. -;; treese@lcs.mit.edu (Win Treese) for ange-ftp tips. -;; pot@cnuce.cnr.it (Francesco Potorti`) for misc. tips. -;; --------------------------------------------------------------------------- -;; TODO: -;; -;; Save window configuration. -;; Recognize more minor modes. -;; Save mark rings. -;; Start-up with buffer-menu??? - -;;; Code: - -;; Make the compilation more silent -(eval-when-compile - ;; We use functions from these modules - ;; We can't (require 'mh-e) since that wants to load something. - (mapcar 'require '(info dired reporter))) -;; ---------------------------------------------------------------------------- -;; USER OPTIONS -- settings you might want to play with. -;; ---------------------------------------------------------------------------- - -(defgroup desktop nil - "Save partial state of Emacs when you exit." - :group 'frames) - -(defcustom desktop-enable nil - "*Non-nil enables Desktop to load the saved state of Emacs on startup." - :group 'desktop - :type 'boolean - :require 'desktop - :initialize 'custom-initialize-default - :version "20.3") - -(defcustom desktop-enable-save-on-exit t - "*Non-nil enables Desktop to save the state of Emacs when you exit. -Set to nil to disable saving on exit while keeping loading on startup." - :group 'desktop - :type 'boolean - :require 'desktop - :initialize 'custom-initialize-default) - -(defcustom desktop-basefilename - ;; GNU Emacs has only (convert-standard-filename ".emacs.desktop") here, - ;; but we keep this stuff around for backwards compatibility. - (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt)) - "emacs.dsk" ; Ms-Dos does not support multiple dots in file name - (convert-standard-filename ".emacs.desktop")) - "File for Emacs desktop, not including the directory name." - :type 'file - :group 'desktop) - -(defcustom desktop-missing-file-warning nil - "*If non-nil then desktop warns when a file no longer exists. -Otherwise it simply ignores that file." - :type 'boolean - :group 'desktop) - -(defcustom desktop-globals-to-save - (list 'desktop-missing-file-warning - ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer - ;; 'kill-ring - 'tags-file-name - 'tags-table-list - 'search-ring - 'regexp-search-ring - 'register-alist - ;; 'desktop-globals-to-save ; Itself! - ) - "List of global variables to save when killing Emacs. -An element may be variable name (a symbol) -or a cons cell of the form (VAR . MAX-SIZE), -which means to truncate VAR's value to at most MAX-SIZE elements -\(if the value is a list) before saving the value." - :type '(repeat (choice (symbol :tag "Variable") - (cons (symbol :tag "Variable") - (integer :tag "Size")))) - :group 'desktop) - -(defcustom desktop-locals-to-save - (list 'desktop-locals-to-save ; Itself! Think it over. - 'truncate-lines - 'case-fold-search - 'case-replace - 'fill-column - 'overwrite-mode - 'change-log-default-name - 'line-number-mode - ) - "List of local variables to save for each buffer. -The variables are saved only when they really are local." - :type '(repeat (choice (symbol :tag "Variable") - (cons (symbol :tag "Variable") - (integer :tag "Size")))) - :group 'desktop) -(make-variable-buffer-local 'desktop-locals-to-save) - -;; We skip .log files because they are normally temporary. -;; (ftp) files because they require passwords and whatnot. -;; TAGS files to save time (tags-file-name is saved instead). -(defcustom desktop-buffers-not-to-save - "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$" - "Regexp identifying buffers that are to be excluded from saving." - :type 'regexp - :group 'desktop) - -;; Skip efs files -(defcustom desktop-files-not-to-save - "^/[^/:]*:" - "Regexp identifying files whose buffers are to be excluded from saving." - :type 'regexp - :group 'desktop) - -(defcustom desktop-buffer-modes-to-save - '(Info-mode rmail-mode) - "If a buffer is of one of these major modes, save the buffer name. -It is up to the functions in `desktop-buffer-handlers' to decide -whether the buffer should be recreated or not, and how." - :type '(repeat symbol) - :group 'desktop) - -(defcustom desktop-modes-not-to-save nil - "List of major modes whose buffers should not be saved." - :type '(repeat symbol) - :group 'desktop) - -(defcustom desktop-buffer-major-mode nil - "When desktop creates a buffer, this holds the desired Major mode." - :type 'symbol - :group 'desktop) - -(defcustom desktop-buffer-file-name nil - "When desktop creates a buffer, this holds the file name to visit." - :type '(choice file (const nil)) - :group 'desktop) - -(defcustom desktop-buffer-name nil - "When desktop creates a buffer, this holds the desired buffer name." - :type '(choice string (const nil)) - :group 'desktop) - -(defvar desktop-buffer-misc nil - "When desktop creates a buffer, this holds a list of misc info. -It is used by the `desktop-buffer-handlers' functions.") - -(defcustom desktop-buffer-misc-functions - '(desktop-buffer-info-misc-data - desktop-buffer-dired-misc-data) - "*Functions used to determine auxiliary information for a buffer. -These functions are called in order, with no arguments. If a function -returns non-nil, its value is saved along with the desktop buffer for -which it was called; no further functions will be called. - -Later, when desktop.el restores the buffers it has saved, each of the -`desktop-buffer-handlers' functions will have access to a buffer local -variable, named `desktop-buffer-misc', whose value is what the -\"misc\" function returned previously." - :type '(repeat function) - :group 'desktop) - -(defcustom desktop-buffer-handlers - '(desktop-buffer-dired - desktop-buffer-rmail - desktop-buffer-mh - desktop-buffer-info - desktop-buffer-file) - "*List of functions to call in order to create a buffer. -The functions are called without explicit parameters but can use the -variables `desktop-buffer-major-mode', `desktop-buffer-file-name', -`desktop-buffer-name'. -If one function returns non-nil, no further functions are called. -If the function returns t then the buffer is considered created." - :type '(repeat function) - :group 'desktop) - -(put 'desktop-buffer-handlers 'risky-local-variable t) - -(defvar desktop-create-buffer-form "(desktop-create-buffer 205" - "Opening of form for creation of new buffers.") - -(defcustom desktop-save-hook nil - "Hook run before desktop saves the state of Emacs. -This is useful for truncating history lists, for example." - :type 'hook - :group 'desktop) - -(defcustom desktop-minor-mode-table - '((auto-fill-function auto-fill-mode) - (vc-mode nil)) - "Table mapping minor mode variables to minor mode functions. -Each entry has the form (NAME RESTORE-FUNCTION). -NAME is the name of the buffer-local variable indicating that the minor -mode is active. RESTORE-FUNCTION is the function to activate the minor mode. -called. RESTORE-FUNCTION nil means don't try to restore the minor mode. -Only minor modes for which the name of the buffer-local variable -and the name of the minor mode function are different have to added to -this table." - :type 'sexp - :group 'desktop) - -;; ---------------------------------------------------------------------------- -(defvar desktop-dirname nil - "The directory in which the current desktop file resides.") - -(defconst desktop-header -";; -------------------------------------------------------------------------- -;; Desktop File for Emacs -;; -------------------------------------------------------------------------- -" "*Header to place in Desktop file.") - -(defvar desktop-delay-hook nil - "Hooks run after all buffers are loaded; intended for internal use.") - -;; ---------------------------------------------------------------------------- -(defun desktop-truncate (l n) - "Truncate LIST to at most N elements destructively." - (let ((here (nthcdr (1- n) l))) - (if (consp here) - (setcdr here nil)))) -;; ---------------------------------------------------------------------------- -(defcustom desktop-clear-preserve-buffers - '("*scratch*" "*Warnings*") - "*Buffer names that `desktop-clear' should not delete." - :type '(repeat string) - :group 'desktop) - -(defun desktop-clear () - "Empty the Desktop. -This kills all buffers except for internal ones -and those listed in `desktop-clear-preserve-buffers'." - (interactive) - (setq kill-ring nil - kill-ring-yank-pointer nil - search-ring nil - search-ring-yank-pointer nil - regexp-search-ring nil - regexp-search-ring-yank-pointer nil) - (let ((buffers (buffer-list))) - (while buffers - (or (member (buffer-name (car buffers)) desktop-clear-preserve-buffers) - (null (buffer-name (car buffers))) - ;; Don't kill buffers made for internal purposes. - (and (not (equal (buffer-name (car buffers)) "")) - (eq (aref (buffer-name (car buffers)) 0) ?\ )) - (kill-buffer (car buffers))) - (setq buffers (cdr buffers)))) - (delete-other-windows)) -;; ---------------------------------------------------------------------------- -(add-hook 'kill-emacs-hook 'desktop-kill) - -(defun desktop-kill () - (if (and desktop-dirname desktop-enable-save-on-exit) - (condition-case err - (desktop-save desktop-dirname) - (file-error - (if (yes-or-no-p "Error while saving the desktop. Quit anyway? ") - nil - (signal (car err) (cdr err))))))) -;; ---------------------------------------------------------------------------- -(defun desktop-list* (&rest args) - (if (null (cdr args)) - (car args) - (setq args (nreverse args)) - (let ((value (cons (nth 1 args) (car args)))) - (setq args (cdr (cdr args))) - (while args - (setq value (cons (car args) value)) - (setq args (cdr args))) - value))) - -(defun desktop-internal-v2s (val) - "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. -TXT is a string that when read and evaluated yields value. -QUOTE may be `may' (value may be quoted), -`must' (values must be quoted), or nil (value may not be quoted)." - (cond - ((or (numberp val) (characterp val) (null val) (eq t val)) - (cons 'may (prin1-to-string val))) - ((stringp val) - (let ((copy (copy-sequence val))) - (set-text-properties 0 (length copy) nil copy) - ;; Get rid of text properties because we cannot read them - (cons 'may (prin1-to-string copy)))) - ((symbolp val) - (cons 'must (prin1-to-string val))) - ((vectorp val) - (let* ((special nil) - (pass1 (mapcar - (lambda (el) - (let ((res (desktop-internal-v2s el))) - (if (null (car res)) - (setq special t)) - res)) - val))) - (if special - (cons nil (concat "(vector " - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - pass1 - " ") - ")")) - (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) - ((consp val) - (let ((p val) - newlist - use-list* - anynil) - (while (consp p) - (let ((q.txt (desktop-internal-v2s (car p)))) - (or anynil (setq anynil (null (car q.txt)))) - (setq newlist (cons q.txt newlist))) - (setq p (cdr p))) - (if p - (let ((last (desktop-internal-v2s p)) - (el (car newlist))) - (or anynil (setq anynil (null (car last)))) - (or anynil - (setq newlist (cons '(must . ".") newlist))) - (setq use-list* t) - (setq newlist (cons last newlist)))) - (setq newlist (nreverse newlist)) - (if anynil - (cons nil - (concat (if use-list* "(desktop-list* " "(list ") - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - newlist - " ") - ")")) - (cons 'must - (concat "(" (mapconcat 'cdr newlist " ") ")"))))) - ((subrp val) - (cons nil (concat "(symbol-function '" - (substring (prin1-to-string val) 7 -1) - ")"))) - ((markerp val) - (let ((pos (prin1-to-string (marker-position val))) - (buf (prin1-to-string (buffer-name (marker-buffer val))))) - (cons nil (concat "(let ((mk (make-marker)))" - " (add-hook 'desktop-delay-hook" - " (list 'lambda '() (list 'set-marker mk " - pos " (get-buffer " buf ")))) mk)")))) - (t ; save as text - (cons 'may "\"Unprintable entity\"")))) - -(defun desktop-value-to-string (val) - "Convert VALUE to a string that when read evaluates to the same value. -Not all types of values are supported." - (let* ((print-escape-newlines t) - (float-output-format nil) - (quote.txt (desktop-internal-v2s val)) - (quote (car quote.txt)) - (txt (cdr quote.txt))) - (if (eq quote 'must) - (concat "'" txt) - txt))) -;; ---------------------------------------------------------------------------- -(defun desktop-outvar (varspec) - "Output a setq statement for variable VAR to the desktop file. -The argument VARSPEC may be the variable name VAR (a symbol), -or a cons cell of the form (VAR . MAX-SIZE), -which means to truncate VAR's value to at most MAX-SIZE elements -\(if the value is a list) before saving the value." - (let (var size) - (if (consp varspec) - (setq var (car varspec) size (cdr varspec)) - (setq var varspec)) - (if (boundp var) - (progn - (if (and (integerp size) - (> size 0) - (listp (eval var))) - (desktop-truncate (eval var) size)) - (insert "(setq " - (symbol-name var) - " " - (desktop-value-to-string (symbol-value var)) - ")\n"))))) -;; ---------------------------------------------------------------------------- -(defun desktop-save-buffer-p (filename bufname mode &rest dummy) - "Return t if the desktop should record a particular buffer for next startup. -FILENAME is the visited file name, BUFNAME is the buffer name, and -MODE is the major mode." - (let ((case-fold-search nil)) - (and (not (string-match desktop-buffers-not-to-save bufname)) - (not (memq mode desktop-modes-not-to-save)) - (or (and filename - (not (string-match desktop-files-not-to-save filename))) - (and (eq mode 'dired-mode) - (save-excursion - (set-buffer (get-buffer bufname)) - (not (string-match desktop-files-not-to-save - default-directory)))) - (and (null filename) - (memq mode desktop-buffer-modes-to-save)))))) -;; ---------------------------------------------------------------------------- -(defcustom desktop-relative-file-names nil - "*Non-nil means file names in the desktop file are relative to -`desktop-dirname'." - :type 'boolean - :group 'desktop) - -(defvar desktop-partially-loaded-p nil - "For Desktop's internal use. - -If non-nil, Desktop was interrupted while loading, and the desktop was -probably only partially loaded. Checked by `desktop-save' to avoid -overwriting a complete desktop file with a partial list.") - -(defun desktop-save (dirname) - "Save the Desktop file. Parameter DIRNAME specifies where to save desktop." - (interactive "DDirectory to save desktop file in: ") - (when (and desktop-partially-loaded-p - (not (y-or-n-p - "Desktop only partially loaded. Write file anyway? "))) - (error 'invalid-state "partially-loaded desktop -- not saving" - (expand-file-name desktop-basefilename dirname))) - (run-hooks 'desktop-save-hook) - (save-excursion - (let ((filename (expand-file-name desktop-basefilename dirname)) - (info (nreverse - (mapcar - (function - (lambda (b) - (set-buffer b) - (list - (let ((bn (buffer-file-name))) - (if bn - (if desktop-relative-file-names - (file-relative-name bn dirname) - bn))) - (buffer-name) - major-mode - ;; minor modes - (let (ret) - (mapcar - #'(lambda (mim) - (and (boundp mim) - (symbol-value mim) - (setq ret - (cons (let ((special (assq mim desktop-minor-mode-table))) - (if special - (cadr special) - mim)) - ret)))) - (mapcar #'car minor-mode-alist)) - ret) - (point) - (list (mark t) ;; mark-active - (not (null (mark)))) ; XEmacs - buffer-read-only - (run-hook-with-args-until-success - 'desktop-buffer-misc-functions) - (let ((locals desktop-locals-to-save) - (loclist (buffer-local-variables)) - (ll)) - (while locals - (let ((here (assq (car locals) loclist))) - (if here - (setq ll (cons here ll)) - (if (member (car locals) loclist) - (setq ll (cons (car locals) ll))))) - (setq locals (cdr locals))) - ll) - ))) - (buffer-list)))) - (buf (get-buffer-create "*desktop*"))) - (set-buffer buf) - (erase-buffer) - - (insert desktop-header - ";; Created " (current-time-string) "\n" - ";; Emacs version " emacs-version "\n\n" - ";; Global section:\n") - (mapcar (function desktop-outvar) desktop-globals-to-save) - (if (memq 'kill-ring desktop-globals-to-save) - (insert "(setq kill-ring-yank-pointer (nthcdr " - (int-to-string - (- (length kill-ring) (length kill-ring-yank-pointer))) - " kill-ring))\n")) - - (insert "\n;; Buffer section:\n") - (mapcar - (function (lambda (l) - (if (apply 'desktop-save-buffer-p l) - (progn - (insert desktop-create-buffer-form) - (mapcar - (function (lambda (e) - (insert "\n " - (desktop-value-to-string e)))) - l) - (insert ")\n\n"))))) - info) - (setq default-directory dirname) - (if (file-exists-p filename) (delete-file filename)) - (write-region (point-min) (point-max) filename nil 'nomessage))) - (setq desktop-dirname dirname)) -;; ---------------------------------------------------------------------------- -(defun desktop-remove () - "Delete the Desktop file and inactivate the desktop system." - (interactive) - (if desktop-dirname - (let ((filename (expand-file-name desktop-basefilename desktop-dirname))) - (setq desktop-dirname nil) - (if (file-exists-p filename) - (delete-file filename))))) -;; ---------------------------------------------------------------------------- -;;;###autoload -(defun desktop-read () - "Read the Desktop file and the files it specifies. -This is a no-op when Emacs is running in batch mode." - (interactive) - (if noninteractive - nil - (let ((dirs '("./" "~/"))) - (while (and dirs - (not (file-exists-p (expand-file-name - desktop-basefilename - (car dirs))))) - (setq dirs (cdr dirs))) - (setq desktop-dirname (and dirs (expand-file-name (car dirs)))) - (if desktop-dirname - (let ((desktop-last-buffer nil)) - (setq desktop-partially-loaded-p t) - ;; `load-with-code-conversion' calls `eval-buffer' which - ;; contains a `save-excursion', so we end up with the same - ;; buffer before and after the load. This is a problem - ;; when the desktop is read initially when Emacs starts up - ;; because, if we still are in *scratch* after running - ;; `after-init-hook', the splash screen will be displayed. - (load (expand-file-name desktop-basefilename desktop-dirname) - t t t) - (when desktop-last-buffer - (switch-to-buffer desktop-last-buffer)) - (run-hooks 'desktop-delay-hook) - (setq desktop-delay-hook nil) - (setq desktop-partially-loaded-p nil) - (message "Desktop loaded.")) - (desktop-clear))))) -;; ---------------------------------------------------------------------------- -;;;###autoload -(defun desktop-load-default () - "Load the `default' start-up library manually. -Also inhibit further loading of it. Call this from your `.emacs' file -to provide correct modes for autoloaded files." - (if (not inhibit-default-init) ; safety check - (progn - (load "default" t t) - (setq inhibit-default-init t)))) -;; ---------------------------------------------------------------------------- -;; Note: the following functions use the dynamic variable binding in Lisp. -;; -(defun desktop-buffer-info-misc-data () - (if (eq major-mode 'Info-mode) - (list Info-current-file - Info-current-node))) - -(defun desktop-buffer-dired-misc-data () - (if (eq major-mode 'dired-mode) - (cons - (expand-file-name dired-directory) - (cdr - (nreverse - (mapcar - (function car) - dired-subdir-alist)))))) - -(defun desktop-buffer-info () "Load an info file." - (if (eq 'Info-mode desktop-buffer-major-mode) - (progn - (let ((first (nth 0 desktop-buffer-misc)) - (second (nth 1 desktop-buffer-misc))) - (when (and first second) - (require 'info) - (Info-find-node first second) - (current-buffer)))))) -;; ---------------------------------------------------------------------------- -(defun desktop-buffer-rmail () "Load an RMAIL file." - (if (eq 'rmail-mode desktop-buffer-major-mode) - (condition-case error - (progn (rmail-input desktop-buffer-file-name) - (if (eq major-mode 'rmail-mode) - (current-buffer) - rmail-buffer)) - (file-locked - (kill-buffer (current-buffer)) - 'ignored)))) -;; ---------------------------------------------------------------------------- -(defun desktop-buffer-mh () "Load a folder in the mh system." - (if (eq 'mh-folder-mode desktop-buffer-major-mode) - (progn - (require 'mh-e) - (mh-find-path) - (mh-visit-folder desktop-buffer-name) - (current-buffer)))) -;; ---------------------------------------------------------------------------- -(defun desktop-buffer-dired () "Load a directory using dired." - (if (eq 'dired-mode desktop-buffer-major-mode) - (if (file-directory-p (file-name-directory (car desktop-buffer-misc))) - (progn - (dired (car desktop-buffer-misc)) - (mapcar 'dired-maybe-insert-subdir (cdr desktop-buffer-misc)) - (current-buffer)) - (message "Directory %s no longer exists." (car desktop-buffer-misc)) - (sit-for 1) - 'ignored))) -;; ---------------------------------------------------------------------------- -(defun desktop-buffer-file () "Load a file." - (if desktop-buffer-file-name - (if (or (file-exists-p desktop-buffer-file-name) - (and desktop-missing-file-warning - (y-or-n-p (format - "File \"%s\" no longer exists. Re-create? " - desktop-buffer-file-name)))) - (let ((buf (find-file-noselect desktop-buffer-file-name))) - (condition-case nil - (switch-to-buffer buf) - (error (pop-to-buffer buf))) - buf) - 'ignored))) -;; ---------------------------------------------------------------------------- -;; Create a buffer, load its file, set is mode, ...; called from Desktop file -;; only. - -(defvar desktop-last-buffer nil - "Last buffer read. Dynamically bound in `desktop-read'.") - -(defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name - desktop-buffer-major-mode - mim pt mk ro desktop-buffer-misc - &optional locals) - - (if (and desktop-buffer-file-name - (not (file-name-absolute-p desktop-buffer-file-name))) - (setq desktop-buffer-file-name - (expand-file-name desktop-buffer-file-name desktop-dirname))) - - (let ((hlist desktop-buffer-handlers) - (result) - (handler)) - (while (and (not result) hlist) - (setq handler (car hlist)) - (setq result (funcall handler)) - (setq hlist (cdr hlist))) - (when (bufferp result) - (setq desktop-last-buffer result) - (set-buffer result) - (if (not (equal (buffer-name) desktop-buffer-name)) - (rename-buffer desktop-buffer-name)) - ;; minor modes - (cond ((equal '(t) mim) (auto-fill-mode 1)) ; backwards compatible - ((equal '(nil) mim) (auto-fill-mode 0)) - (t (mapcar #'(lambda (minor-mode) - (when (functionp minor-mode) - (funcall minor-mode 1))) - mim))) - (goto-char pt) - (if (consp mk) - (progn - (set-mark (car mk)) - (if (car (cdr mk)) (zmacs-activate-region))) - (set-mark mk)) - ;; Never override file system if the file really is read-only marked. - (if ro (setq buffer-read-only ro)) - (while locals - (let ((this (car locals))) - (if (consp this) - ;; an entry of this form `(symbol . value)' - (progn - (make-local-variable (car this)) - (set (car this) (cdr this))) - ;; an entry of the form `symbol' - (make-local-variable this) - (makunbound this))) - (setq locals (cdr locals)))))) - -;; Backward compatibility -- update parameters to 205 standards. -(defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name - desktop-buffer-major-mode - mim pt mk ro tl fc cfs cr desktop-buffer-misc) - (desktop-create-buffer 205 desktop-buffer-file-name desktop-buffer-name - desktop-buffer-major-mode (cdr mim) pt mk ro - desktop-buffer-misc - (list (cons 'truncate-lines tl) - (cons 'fill-column fc) - (cons 'case-fold-search cfs) - (cons 'case-replace cr) - (cons 'overwrite-mode (car mim))))) -;; ---------------------------------------------------------------------------- - -;; If the user set desktop-enable to t with Custom, -;; do the rest of what it takes to use desktop, -;; but do it after finishing loading the init file. -(add-hook 'after-init-hook - '(lambda () - (when desktop-enable - (desktop-load-default) - (desktop-read)))) - -(provide 'desktop) - -;;; desktop.el ends here diff --git a/xemacs-packages/lisp/edit-utils/detached-minibuf.el b/xemacs-packages/lisp/edit-utils/detached-minibuf.el deleted file mode 100644 index 4e9249d1..00000000 --- a/xemacs-packages/lisp/edit-utils/detached-minibuf.el +++ /dev/null @@ -1,169 +0,0 @@ -;;; detached-minibuf.el -- Support a detached minibuffer for XEmacs. - -;; Copyright (C) 2001 Vin Shelton - -;; Author: Vin Shelton -;; Keywords: extensions - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; if not, write to the Free Software Foundation, -;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -;;; Synched up with: not in FSF. - -;;; Commentary: - -;; WARNING. DANGER. This file reportedly crashes 19.14, use it only with a -;; recent XEmacs. - -;; Version: 1.1 - -;;; Code: - -;; -;; Variable definitions - -(defgroup detached-minibuf nil - "Support a detached minibuffer in XEmacs" - :group 'minibuffer - :prefix "minibuf-frame-" - :group 'frames) - - -(defcustom add-minibuf-options t - "*If nil, prevent minibuffer options from being added to the Options menu.\ -This must be set before detached-minibuf is loaded." - :type 'boolean - :group 'detached-minibuf) -(defcustom minibuf-frame-height 1 - "*The height in lines of the minibuffer frame created by make-detached-minibuf" - :type 'integer - :group 'detached-minibuf) -(defcustom minibuf-frame-width (frame-width (selected-frame)) - "*The width in chars of the minibuffer frame created by make-detached-minibuf" - :type 'integer - :group 'detached-minibuf) -(defcustom minibuf-frame-pos-y -2 - "*The y position of the minibuffer frame as created by make-detached-minibuf" - :type 'integer - :group 'detached-minibuf) -(defcustom minibuf-frame-pos-x -2 - "*The x position of the minibuffer frame as created by make-detached-minibuf" - :type 'integer - :group 'detached-minibuf) - -;; -;; Add minibuffer options to the Options menu -(if add-minibuf-options - (progn - (defun toggle-minibuf () - (interactive) - (if (equal (frame-property (selected-frame) 'minibuffer) t) - - ;; This frame already has a minibuffer, so remove the minibuffer. - ;; Unfortunately, we must delete and redraw the frame - (let ((fp (frame-properties (selected-frame))) - (buf (current-buffer)) - (orig (selected-frame))) - - ;; Create and select the new frame; - ;; we have to do this before we delete the old frame. - (setq fp (plist-remprop fp 'window-id) - fp (plist-remprop fp 'minibuffer)) - (select-frame - (make-frame (plist-put fp 'minibuffer nil))) - (switch-to-buffer buf) - - (set-frame-properties - orig (list 'minibuffer default-minibuffer-frame)) - (delete-frame orig t)) - - ;; This frame does not have a minibuffer, so add one - (set-frame-property (selected-frame) 'minibuffer t))) - - ;; The menu structure is different before XEmacs 21.2. - ;; Under 21.1 and previous, add menu items to - ;; Options/Frame Appearance. Under 21.2+, add the - ;; menu items to Options/Display. - (let ((entry-name (if (fboundp 'purecopy-menubar) - '("Options" "Frame Appearance") - '("Options" "Display")))) - (add-menu-button entry-name - "------" - nil) - (add-menu-button entry-name - ["Toggle minibuffer" - (toggle-minibuf) - :style toggle - :active (not (equal (selected-frame) - default-minibuffer-frame)) - :selected (equal - (frame-property (selected-frame) 'minibuffer) - t)] - nil) - (add-menu-button entry-name - ["Default minibuffer here" - (setq default-minibuffer-frame (selected-frame)) - :style toggle - :active (let ((mbf (frame-property - (selected-frame) 'minibuffer))) - (or (equal mbf (selected-frame)) - (equal mbf t))) - :selected (equal (selected-frame) - default-minibuffer-frame)] - nil) - (add-menu-button entry-name - ["Make a detached minibuffer" - (make-detached-minibuf) - :style nil] - nil)))) - -;; -;; Create a minibuffer-only frame. -;; -;; This function creates a frame named "minibuffer". -;; You will likely want this frame not to have a titlebar. -;; In order to do this for gwm, uncomment the following line -;; and add it to your .profile.gwm: -;; (set-window Emacs.minibuffer no-frame) -;; -(defun make-detached-minibuf () - "Create a standalone minibuffer" - (interactive) - (if (console-on-window-system-p) - (progn - (setq initial-frame-plist - (list 'minibuffer nil - 'width (frame-width (selected-frame)) - 'height (frame-height (selected-frame)))) - (setq default-minibuffer-frame - (make-frame - (list 'minibuffer 'only - 'width minibuf-frame-width - 'height minibuf-frame-height - 'menubar-visible-p nil - 'default-toolbar-visible-p nil - 'name "minibuffer" - 'top minibuf-frame-pos-y - 'left minibuf-frame-pos-x - 'has-modeline-p nil))) - - ;; Bogus! But it avoids annoying screen flash at startup - (if (not command-line-args-left) - (frame-notice-user-settings))))) - -(provide 'detached-minibuf) - -;;; detached-minibuf.el ends here diff --git a/xemacs-packages/lisp/edit-utils/edit-faces.el b/xemacs-packages/lisp/edit-utils/edit-faces.el deleted file mode 100644 index 018013ae..00000000 --- a/xemacs-packages/lisp/edit-utils/edit-faces.el +++ /dev/null @@ -1,373 +0,0 @@ -;;; edit-faces.el -- interactive face editing mode - -;; Copyright (C) 1998 Free Software Foundation, Inc. -;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp. -;; Copyright (C) 1996 Ben Wing. - -;; Author: Stig . -;; Maintainer: XEmacs Development Team -;; Keywords: faces - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Synched up with: Not in FSF. - -;;; Commentary: - -;; This is the file that won't die. Even though we have otherwise completely -;; converted to custom, there is still apparently a need to view a lot of -;; faces in one buffer. - -;;; ChangeLog: - -;; May 11, 1998: use easymenu. -sb -;; Significantly fixed up: Ben Wing . - -;;; Code: - -(defvar edit-faces-menu - '("Edit-Faces" - ["Copy other face..." ef-copy-other-face t] - ["Copy this face..." ef-copy-this-face t] - ["Make smaller" ef-smaller t] - ["Make larger" ef-larger t] - ["Toggle bold" ef-bold t] - ["Toggle italic" ef-italic t] - ["Toggle underline" ef-underline t] - ["Query true font" ef-truefont t] - ["Set font" ef-font t] - ["Set foreground" ef-foreground t] - ["Set background" ef-background t] - ["Set doc string" ef-doc-string t] - ["Quit" ef-quit t] - )) - -(or (find-face 'underline) - (progn (make-face 'underline) - (set-face-underline-p 'underline t))) - -(define-derived-mode edit-faces-mode list-mode - "Edit-Faces" - "Major mode for `edit-faces' buffers. - -Editing commands: - -\\{edit-faces-mode-map}" - (setq truncate-lines t) - ;; auto-show-mode is too confusing in this mode - (setq auto-show-mode nil) - (setq mode-popup-menu edit-faces-menu) - (when (and (featurep 'menubar) - current-menubar) - (easy-menu-add edit-faces-menu))) - -(let ((map edit-faces-mode-map)) - (define-key map "<" 'ef-smaller) - (define-key map ">" 'ef-larger) - (define-key map "c" 'ef-copy-other-face) - (define-key map "C" 'ef-copy-this-face) - (define-key map "s" 'ef-smaller) - (define-key map "l" 'ef-larger) - (define-key map "b" 'ef-bold) - (define-key map "i" 'ef-italic) - (define-key map "e" 'ef-font) - (define-key map "f" 'ef-font) - (define-key map "u" 'ef-underline) - (define-key map "t" 'ef-truefont) - (define-key map "F" 'ef-foreground) - (define-key map "B" 'ef-background) - (define-key map "D" 'ef-doc-string) - (define-key map "d" 'ef-delete) - (define-key map "n" 'ef-next) - (define-key map "p" 'ef-prev) - (define-key map " " 'ef-next) - (define-key map "\C-?" 'ef-prev) - (define-key map "g" 'edit-faces) ; refresh display - (define-key map "q" 'ef-quit) - (define-key map "\C-c\C-c" 'bury-buffer)) - -;;;###autoload -(defun edit-faces () - "Alter face characteristics by editing a list of defined faces. -Pops up a buffer containing a list of defined faces. - -WARNING: the changes you may perform with this function are no longer -saved. The prefered way to modify faces is now to use `customize-face'. If you -want to specify particular X font names for faces, please do so in your -.XDefaults file. - -Editing commands: - -\\{edit-faces-mode-map}" - (interactive) - (pop-to-buffer (get-buffer-create "*Edit Faces*")) - (reset-buffer (current-buffer)) - - ;; face-list returns faces in a random order so we sort - ;; alphabetically by the name in order to insert some logic into - ;; the ordering. - (let ((flist (sort (face-list) - (function - (lambda (x y) - (string-lessp (symbol-name x) (symbol-name y)))))) - face) - (ef-update-face-description t) ; insert header line - (while (setq face (car flist)) - (ef-update-face-description face) - (setq flist (cdr flist)) - )) - (edit-faces-mode) -) - -(defun ef-foreground-callback (event extent user-data) - (ef-foreground (ef-face-arg (extent-start-position extent) - (extent-object extent)))) - -(defun ef-background-callback (event extent user-data) - (ef-background (ef-face-arg (extent-start-position extent) - (extent-object extent)))) - -(defun ef-font-callback (event extent user-data) - (ef-font (ef-face-arg (extent-start-position extent) - (extent-object extent)))) - -(defun ef-doc-string-callback (event extent user-data) - (ef-doc-string (ef-face-arg (extent-start-position extent) - (extent-object extent)))) - -(defun ef-update-face-description (face &optional replace) - "Given a face, inserts a description of that face into the current buffer. -Inserts a descriptive header if passed `t'." - (let ((face-name-fmt "%-25s") - (foreground-fmt "%-15s") - (background-fmt "%-15s") - (font-fmt "%s") - (buffer-read-only nil) - fg bg font) - (if (eq face t) - (insert-face (format (concat face-name-fmt " " foreground-fmt " " - background-fmt " " font-fmt "\n") - "Face" "Foreground" "Background" "Font Spec") - 'underline) - (or replace (setq replace face)) - (goto-char (point-min)) - (if (re-search-forward (concat "^" (symbol-name replace) " ") nil 0) - (progn - (beginning-of-line) - (delete-region (point) (progn (forward-line 2) (point))) - )) - (setq fg (face-foreground-instance face) - bg (face-background-instance face) - font (face-font-instance face)) - (let ((st (point)) - (fn #'(lambda (str callback) - (let ((st1 (point))) - (insert str) - (add-list-mode-item st1 (point) nil callback))))) - (funcall fn (format face-name-fmt (symbol-name face)) nil) - (insert " ") - (funcall fn (format foreground-fmt (color-instance-name fg)) - 'ef-foreground-callback) - (insert " ") - (funcall fn (format background-fmt (color-instance-name bg)) - 'ef-background-callback) - (insert " ") - (funcall fn (format font-fmt (font-instance-name font)) - 'ef-font-callback) - (insert "\n (") - (funcall fn (or (face-doc-string face) "") - 'ef-doc-string-callback) - (insert ")") - (add-nonduplicable-text-properties st (point) - `(face ,face eface ,face - start-open t)) - (insert "\n") - ) - (and replace (forward-line -1)) - )) - ) - -(defun ef-face-arg (&optional pos buffer) - (if (and (not pos) (not buffer)) - (and current-mouse-event - (mouse-event-p current-mouse-event) - (mouse-set-point current-mouse-event))) - (or buffer (setq buffer (current-buffer))) - (or pos (setq pos (point buffer))) - (let ((face (or (get-char-property pos 'eface buffer) - (and (> pos (point-min buffer)) - (get-char-property (1- pos) 'eface buffer))))) - (or face (error "There is no face to edit on this line.")) - face)) - -(defun ef-delete (arg) - "Delete the face on the current line from the *Edit Faces* buffer. -The face is not altered. The buffer can be regenerated again with -M-x edit-faces." - (interactive "p") - (and current-mouse-event (mouse-event-p current-mouse-event) - (mouse-set-point current-mouse-event)) - (let ( ;; is this worth the bother? (fwd (> arg 0)) - (count (abs arg)) - (buffer-read-only nil) - ex) - (while (not (zerop (prog1 count (setq count (1- count))))) - (setq ex (text-property-bounds (point) 'eface nil 'at)) - (or ex (error "There is no face to delete on this line.")) - (delete-region (car ex) (cdr ex)) - (delete-blank-lines)))) - -(defun ef-next (arg) - "Move forward ARG entries in the face table." - (interactive "p") - (let ((bounds (next-text-property-bounds arg (point) 'eface))) - (if bounds (goto-char (car bounds)) - (goto-char (if (> arg 0) (point-max) (point-min)))))) - -(defun ef-prev (arg) - "Move forward ARG entries in the face table." - (interactive "p") - (ef-next (- arg))) - -(defun ef-smaller (face) - (interactive (list (ef-face-arg))) - (make-face-smaller face) - (ef-update-face-description face)) - -(defun ef-larger (face) - (interactive (list (ef-face-arg))) - (make-face-larger face) - (ef-update-face-description face)) - -(defun ef-face-font-indirect (face) - (let ((font (face-font-instance face))) - (or font (face-font-instance 'default)))) - -(defun ef-face-bold-p (face) - (let ((font (ef-face-font-indirect face))) - (not (not (string-match "-bold-" (font-instance-name font)))))) - -(defun ef-face-italic-p (face) - (let ((font (ef-face-font-indirect face))) - (not (not (string-match "-[io]-" (font-instance-name font)))))) - -(defun ef-bold (face) - (interactive (list (ef-face-arg))) - (if (ef-face-bold-p face) - (make-face-unbold face) - (make-face-bold face)) - (ef-update-face-description face)) - -(defun ef-italic (face) - (interactive (list (ef-face-arg))) - (if (ef-face-italic-p face) - (make-face-unitalic face) - (make-face-italic face)) - (ef-update-face-description face)) - -(defun ef-underline (face) - (interactive (list (ef-face-arg))) - (set-face-underline-p face (not (face-underline-p face))) - (ef-update-face-description face)) - -(defun ef-truefont (face) - (interactive (list (ef-face-arg))) - (let ((font (face-font-instance face)) - (name (symbol-name face))) - (if font - (message "True font for `%s': %s" name (font-instance-truename font)) - (message "The face `%s' does not have its own font." name)))) - -(defun ef-foreground (face) - (interactive - (list (ef-face-arg))) - (set-face-foreground - face - (read-color (format "Foreground color for `%s': " (symbol-name face)) - nil - (color-instance-name (face-foreground-instance face)))) - (ef-update-face-description face)) - -(defun ef-background (face) - (interactive - (list (ef-face-arg))) - (set-face-background - face - (read-color (format "Background color for `%s': " (symbol-name face)) - nil - (color-instance-name (face-background-instance face)))) - (ef-update-face-description face)) - -(defun ef-doc-string (face) - (interactive - (list (ef-face-arg))) - (set-face-doc-string - face - (read-string (format "Doc string for `%s': " (symbol-name face)) - (face-doc-string face))) - (ef-update-face-description face)) - -(defun ef-copy-other-face (src dst) - (interactive - (let* ((f (ef-face-arg)) - (name (symbol-name f))) - (list (read-face (format "Make `%s' a copy of what face?: " name) t) f))) - (copy-face src dst) - (ef-update-face-description dst dst)) - -(defun ef-copy-this-face (src dst) - (interactive - (let* ((f (ef-face-arg)) - (name (symbol-name f))) - (list f (read-face (format "Copy `%s' onto what face?: " name))))) - (copy-face src dst) - (ef-update-face-description dst dst)) - -(defun ef-font (face) - (interactive - (list (ef-face-arg))) - (let* ((ofont (face-font-instance face)) - (font (read-string (format "Font for `%s': " (symbol-name face)) - (font-instance-name (face-font-instance face)))) - others) - ;; you might think that this could be moved into the loop below, but I - ;; think that it's important to see the new font before asking if the - ;; change should be global. - (set-face-font face (if (and (string= font "") - (not (eq face 'default))) - nil font)) - (ef-update-face-description face) - (setq others (delq nil (mapcar (lambda (f) - (and (equal (face-font-instance f) ofont) - f)) - (face-list)))) - (if (and others - (y-or-n-p "Make the same font change for other faces? ")) - (while others - (setq face (car others) - others (cdr others)) - (set-face-font face font) - (ef-update-face-description face))) - )) - -(defun ef-quit () - (interactive) - (or (one-window-p t 0) - (delete-window)) - (kill-buffer "*Edit Faces*")) - -;;; edit-faces.el ends here diff --git a/xemacs-packages/lisp/edit-utils/edit-toolbar.el b/xemacs-packages/lisp/edit-utils/edit-toolbar.el deleted file mode 100644 index 2e3223e5..00000000 --- a/xemacs-packages/lisp/edit-utils/edit-toolbar.el +++ /dev/null @@ -1,547 +0,0 @@ -;;; edit-toolbar.el --- Interactive toolbar editing mode for XEmacs - -;; Copyright (C) 1996 Peter D. Pezaris - -;; Author: Peter D. Pezaris -;; Keywords: tools - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: Not in FSF - -;;; Commentary: - -;; To use edit-toolbar.el, simply type M-x edit-toolbar RET - -;; For help on the various commands you can type ? in a edit-toolbar -;; buffer. To save a modified toolbar type C-x C-s in an edit-toolbar -;; buffer. If you want to use a saved toolbar in your future XEmacs -;; sessions, add the following line of code to your .emacs file: - -;; (load "~/.xemacs/.toolbar") - -;; Acknowledgements: - -;; Many thanks to Stig and Ben Wing -;; for writing edit-faces.el, on which much of this code is based. - -;; To do: - -;; o The function edit-toolbar-quit should do something other than just -;; bury the buffer. -;; o Dynamically add new items to edit-toolbar-button-alist as new buttons -;; are added. -;; o Allow more than one toolbar to be saved in the ~/.xemacs/.toolbar file. -;; o Allow buttons to be copied from any toolbar. -;; o Allow multiple toolbars to be edited simultaneously. - -;;; Change Log: - -;; Modified by Mike Scheidler 25 Jul 1997 -;; - Enabled editing of any toolbar (not just `default-toolbar'). -;; - Added context sensitivity to `edit-toolbar-menu'. -;; - Added support for `nil' toolbar item (left/right divider). -;; - Enabled editing of empty toolbars. -;; Modified by Jeff Miller 17 Aug 1997 -;; - Modfied how added toolbar buttons are created and saved. - -;;; Code: - -(defvar edit-toolbar-version "1.03" - "Version of Edit Toolbar.") - -(defvar edit-toolbar-temp-toolbar-name nil - "Value of toolbar being edited.") - -(defvar edit-toolbar-temp-toolbar nil - "Working copy of toolbar being edited.") - -(defvar edit-toolbar-fallback-toolbar nil - "Toolbar definition to use when reverting.") - -(defvar edit-toolbar-file-name - (cond - ((boundp 'emacs-user-extension-dir) - (concat (file-name-as-directory (concat "~" emacs-user-extension-dir)) - ".toolbar")) - ;; if `load-user-init-file-p' exists, `user-init-directory' is absolute - ((boundp 'load-user-init-file-p) - (paths-construct-path (list user-init-directory ".toolbar"))) - (t - (paths-construct-path "~" ".toolbar"))) - "File name to save toolbars to. Defaults to \"~/.xemacs/.toolbar\"") - -(defvar edit-toolbar-button-prefix "edit-toolbar-button" - "Prefix to use when naming new buttons created by edit-toolbar. -The new buttons will be stored in the file named by edit-toolbar-file-name") - -(defvar edit-toolbar-added-buttons-alist nil - "Buttons added by edit-toolbar. -A list of cons cells. The car is the variable which stores the glyph data. -The cdr is a list of filenames to be passed as arguments to -toolbar-make-button-list when the toolbar file is read at startup.") - -(defvar edit-toolbar-menu - '("Edit Toolbar" - ["Move This Item Up" edit-toolbar-up (>= (edit-toolbar-current-index) 0)] - ["Move This Item Down" edit-toolbar-down (>= (edit-toolbar-current-index) 0)] - ["Set Function" edit-toolbar-set-function (edit-toolbar-button-p)] - ["Set Help String" edit-toolbar-set-help (edit-toolbar-button-p)] - ["Copy This Button" edit-toolbar-copy (edit-toolbar-button-p)] - ["Remove This Item" edit-toolbar-kill (>= (edit-toolbar-current-index) 0)] - "----" - ["Add Button..." edit-toolbar-add-button t] - ("Add Separator" - ["2D (narrow)" edit-toolbar-add-separator-2D-narrow t] - ["3D (narrow)" edit-toolbar-add-separator-3D-narrow t] - ["2D (wide)" edit-toolbar-add-separator-2D-wide t] - ["3D (wide)" edit-toolbar-add-separator-3D-wide t] - ["Right/left divider" edit-toolbar-add-separator-right-left t] - ) - "----" - ["Restore Default Toolbar " edit-toolbar-restore (buffer-modified-p)] - ["Save This Toolbar" edit-toolbar-save (buffer-modified-p)] - "----" - ["Help" describe-mode t] - "----" - ["Quit" edit-toolbar-quit t] - ) - ) - -(defvar edit-toolbar-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'edit-toolbar-quit) - (define-key map "n" 'edit-toolbar-next) - (define-key map "p" 'edit-toolbar-previous) - (define-key map " " 'edit-toolbar-next) - (define-key map "?" 'describe-mode) - (define-key map "f" 'edit-toolbar-set-function) - (define-key map "h" 'edit-toolbar-set-help) - (define-key map "a" 'edit-toolbar-add-button) - (define-key map "2" 'edit-toolbar-add-separator-2D-narrow) - (define-key map "@" 'edit-toolbar-add-separator-2D-wide) - (define-key map "3" 'edit-toolbar-add-separator-3D-narrow) - (define-key map "#" 'edit-toolbar-add-separator-3D-wide) - (define-key map "R" 'edit-toolbar-add-separator-right-left) - (define-key map "c" 'edit-toolbar-copy) - (define-key map "d" 'edit-toolbar-down) - (define-key map "u" 'edit-toolbar-up) - (define-key map "k" 'edit-toolbar-kill) - (define-key map "s" 'edit-toolbar-save) - (define-key map "\C-x\C-s" 'edit-toolbar-save) - (define-key map "r" 'edit-toolbar-restore) - (define-key map 'return 'edit-toolbar-next) - (define-key map 'delete 'edit-toolbar-previous) - map - )) - -(defun edit-toolbar-create-toolbar-alist () - (setq edit-toolbar-toolbar-alist nil) - (mapatoms - (lambda (sym) - (if (and (boundp sym) - (toolbar-specifier-p (symbol-value sym)) - (not (string-match "^edit-toolbar" (symbol-name sym)))) - (setq edit-toolbar-toolbar-alist - (cons (cons (symbol-name sym) sym) - edit-toolbar-toolbar-alist)))))) - -;;;###autoload -(defun edit-toolbar (&optional toolbar) - "Alter toolbar characteristics by editing a buffer representing the specified toolbar. -Pops up a buffer containing a list of the toolbar matching TOOLBAR_NAME." - (interactive) - (edit-toolbar-create-toolbar-alist) - (if (eq toolbar nil) - (setq toolbar (intern-soft - (completing-read - "Toolbar: " edit-toolbar-toolbar-alist)))) - (if (not (toolbar-specifier-p (symbol-value toolbar))) - (error (format "Toolbar named %s not found" (prin1 toolbar)))) - (pop-to-buffer (get-buffer-create "*Edit Toolbar*")) - (setq edit-toolbar-temp-toolbar (symbol-value toolbar)) - (setq edit-toolbar-temp-toolbar-name (symbol-name toolbar)) - (setq edit-toolbar-fallback-toolbar - (specifier-instance (symbol-value toolbar))) - (edit-toolbar-create-button-alist) - (edit-toolbar-list) - (set-buffer-modified-p nil) - (edit-toolbar-mode) - (set-face-foreground 'default "black" (current-buffer)) - (set-face-background 'default "grey75" (current-buffer)) - (set-face-background-pixmap 'default "nil" (current-buffer)) - (set-face-foreground 'list-mode-item-selected "yellow" (current-buffer)) - (set-face-background 'list-mode-item-selected "black" (current-buffer))) - -(define-derived-mode edit-toolbar-mode list-mode "Edit-Toolbar" - "Major mode for 'edit-toolbar' buffers. - -Editing commands: - -\\{edit-toolbar-map}" - (setq mode-popup-menu edit-toolbar-menu) - (if (and (featurep 'menubar)) - current-menubar - (progn - (set (make-local-variable 'current-menubar) - (copy-sequence current-menubar)) - (add-submenu nil edit-toolbar-menu))) - (use-local-map edit-toolbar-map) - (setq buffer-read-only nil) - (message "Edit Toolbar Version %s. Type \"?\" for help." edit-toolbar-version)) - -(defun edit-toolbar-list () - (erase-buffer) - (edit-toolbar-insert-item 'header) - (mapcar (function (lambda (item) - (edit-toolbar-insert-item item))) - (specifier-instance edit-toolbar-temp-toolbar)) - (goto-char (point-min))) - -(defun edit-toolbar-button-p () - "Returns t if the currently selected edit-toolbar item is a button." - (let ((item (edit-toolbar-current-item))) - (not (or (eq item nil) - (eq (aref item 0) :style) - (eq (aref item 0) :size))))) - -(defun edit-toolbar-current-index () - "Returns the offset of the currently selected edit-toolbar item." - (- (count-lines (point-min) (point)) 2)) - -(defun edit-toolbar-current-item () - "Returns the value of the currently selected edit-toolbar item." - (let ((toolbar (specifier-instance edit-toolbar-temp-toolbar))) - (nth (edit-toolbar-current-index) toolbar))) - -(defun edit-toolbar-quit () - "Quit an Edit Toolbar session. This simply buries the buffer." - (interactive) - ;;FIXME - (bury-buffer)) - -(defun edit-toolbar-next () - "Move to the next line in the Edit Toolbar buffer." - (interactive) - (next-line 1)) - -(defun edit-toolbar-previous () - "Move to the previous line in the Edit Toolbar buffer." - (interactive) - (next-line -1)) - -(defun edit-toolbar-set-function (func) - "Set the function for the selected toolbar button." - (interactive "aNew Function: ") - (let ((index (edit-toolbar-current-index))) - (if (not (edit-toolbar-button-p)) - (error "Not a button") - (setf (aref (edit-toolbar-current-item) 1) func) - (edit-toolbar-list) - (forward-line (+ index 2))))) - -(defun edit-toolbar-set-help (help) - "Set the help string for the selected toolbar button." - (interactive "sNew Help String: ") - (let ((index (edit-toolbar-current-index))) - (if (not (edit-toolbar-button-p)) - (error "Not a button") - (setf (aref (edit-toolbar-current-item) 3) help) - (edit-toolbar-list) - (forward-line (+ index 2))))) - -(defun edit-toolbar-copy () - "Make a copy of the selected toolbar button." - (interactive) - (let ((index (edit-toolbar-current-index))) - (if (not (edit-toolbar-button-p)) - (error "Not a button") - (setcdr (nthcdr index (specifier-instance edit-toolbar-temp-toolbar)) - (cons (edit-toolbar-current-item) - (nthcdr (1+ index) - (specifier-instance edit-toolbar-temp-toolbar)))) - (edit-toolbar-list) - (forward-line (+ index 3))))) - -(defun edit-toolbar-down () - "Move the current toolbar button down (right) one position." - (interactive) - (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar)) - (index (- (count-lines (point-min) (point)) 2)) - (item (nth index toolbar))) - (if (eq (1+ index) (length toolbar)) - (error "Already at the bottom of the toolbar.")) - (if (eq index 0) - (setq toolbar (cdr toolbar)) - (setcdr (nthcdr (1- index) toolbar) - (nthcdr (1+ index) toolbar))) - (setcdr (nthcdr index toolbar) - (cons item (nthcdr (1+ index) toolbar))) - (set-specifier - (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar) - (edit-toolbar-list) - (forward-line (+ index 3)))) - -(defun edit-toolbar-up () - "Move the current toolbar button up (left) one position." - (interactive) - (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar)) - (index (- (count-lines (point-min) (point)) 2)) - (item (nth index toolbar))) - (if (<= index 0) - (error "Already at the top of the toolbar.")) - (setcdr (nthcdr (1- index) toolbar) - (nthcdr (1+ index) toolbar)) - (if (eq index 1) - (setq toolbar (cons item toolbar)) - (setcdr (nthcdr (- index 2) toolbar) - (cons item (nthcdr (- index 1) toolbar)))) - (set-specifier - (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar) - (edit-toolbar-list) - (forward-line (+ index 1)))) - -(defun edit-toolbar-kill () - "Remove the current toolbar button." - (interactive) - (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar)) - (index (- (count-lines (point-min) (point)) 2)) - (etk-scratch-list) - (button (elt (nth index toolbar) 0 ))) - - (mapcar - (lambda (cons) - (if (not (memq button cons)) - (setq etk-scratch-list (append etk-scratch-list cons))) - ) - edit-toolbar-added-buttons-alist) - (setq edit-toolbar-added-buttons-alist etk-scratch-list) - (if (eq index 0) - (setq toolbar (cdr toolbar)) - (setcdr (nthcdr (1- index) toolbar) - (nthcdr (1+ index) toolbar))) - (set-specifier - (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar) - (edit-toolbar-list) - (forward-line (+ index 2)))) - -(defun edit-toolbar-insert-item (item) - (let ((line-format "%-30s %s\n") - icon function help) - (if (eq item 'header) - (progn - (setq function "Function" - help "Help String") - (insert-face "Icon\t" 'bold) - (insert-face (format line-format function help) 'bold)) - (cond ((eq item nil) - (setq icon nil - function "-------------- Right/Left Divider --------------" - help "")) - ((or (eq (aref item 0) :style) - (eq (aref item 0) :size)) - (setq icon nil - function "----------------------------------------" - help "")) - (t - (setq icon (if (listp (aref item 0)) - (car (aref item 0)) - (car (symbol-value (aref item 0)))) - function (aref item 1) - help (aref item 3)))) - (let ((st (point)) - (fn #'(lambda (str callback data) - (let ((st1 (point))) - (insert str) - (add-list-mode-item st1 (point) nil callback data))))) - (insert "\t") - (funcall fn (format line-format function help) nil item) - (set-extent-begin-glyph (make-extent st (point)) icon))))) - -(defun edit-toolbar-create-button-alist () - (let ((button-alist nil) - (buttons (specifier-instance edit-toolbar-temp-toolbar))) - (while buttons - (setq button-alist - (if (arrayp (car buttons)) - (cons (cons (symbol-name (aref (car buttons) 1)) (car buttons)) - button-alist) - (cons (car buttons) button-alist))) - (setq buttons (cdr buttons))) - button-alist)) - -(defvar edit-toolbar-button-alist nil - "List of buttons in the toolbar currently being edited.") - -(defvar edit-toolbar-toolbar-alist nil - "List of existing toolbars (used for completing read).") - -(defun edit-toolbar-add-item (item) - "Add a toolbar item ITEM at the current location." - (let* ((toolbar (specifier-instance edit-toolbar-temp-toolbar)) - (index (- (count-lines (point-min) (point)) 2))) - (if (<= index 0) - (setq toolbar (cons item toolbar)) - (setcdr (nthcdr (- index 1) toolbar) - (cons item (nthcdr index toolbar)))) - (set-specifier - (symbol-value (intern-soft edit-toolbar-temp-toolbar-name)) toolbar) - (edit-toolbar-list) - (forward-line (+ index 2)))) - -;(defun edit-toolbar-check-for-save () -; (if (not (buffer-modified-p)) -; () -; (if (yes-or-no-p-maybe-dialog-box " - -(defun edit-toolbar-restore () - "Restore the default toolbar." - (interactive) -; (edit-toolbar-check-for-save) - (set-specifier edit-toolbar-temp-toolbar - edit-toolbar-fallback-toolbar) - (edit-toolbar-list) - (set-buffer-modified-p nil)) - -(defun edit-toolbar-add-separator-2D-narrow () - "Add a narrow 2D separator at the current position." - (interactive) - (edit-toolbar-add-item [:style 2D])) - -(defun edit-toolbar-add-separator-3D-narrow () - "Add a narrow 3D separator at the current position." - (interactive) - (edit-toolbar-add-item [:style 3D])) - -(defun edit-toolbar-add-separator-2D-wide () - "Add a wide 2D separator at the current position." - (interactive) - (edit-toolbar-add-item [:style 2D :size 30])) - -(defun edit-toolbar-add-separator-3D-wide () - "Add a wide 3D separator at the current position." - (interactive) - (edit-toolbar-add-item [:style 3D :size 30])) - -(defun edit-toolbar-add-separator-right-left () - "Add a right/left separator at the current position." - (interactive) - (if (memq nil (specifier-instance edit-toolbar-temp-toolbar)) - (error "Can't have more than one left/right divider in a toolbar.") - (edit-toolbar-add-item nil))) - -(defun edit-toolbar-add-button () - "Add a new toolbar item at the current position. -Completion is available to the known toolbar buttons." - (interactive) - (let ((button (completing-read - "New Toolbar Button (RET to create a new button): " - edit-toolbar-button-alist nil t))) - (if (string-equal button "") - (let ((prompts '("UP glyph for button: " - "DOWN glyph (RET for no glyph): " - "DISABLED glyph (RET for no glyph): " - "UP CAPTIONED glyph (RET for no glyph): " - "DOWN CAPTIONED glyph (RET for no glyph): " - "DISABLED CAPTIONED glyph (RET for no glyph): ")) - (glyphs-list nil) - (count 0)) - (let ((glyph-file (read-file-name (car prompts) nil ""))) - (if (string-equal glyph-file "") - (error "You must specify at least the UP glyph.") - (setq glyphs-list (list glyph-file)) - (setq prompts (cdr prompts)))) - (while prompts - (let ((glyph-file (read-file-name (car prompts) nil ""))) - (if (not (string-equal glyph-file "")) - (setq glyphs-list - (append glyphs-list (list glyph-file))))) - (setq prompts (cdr prompts))) - (setq added-button (gentemp edit-toolbar-button-prefix )) - (setf (symbol-value added-button) - (toolbar-make-button-list glyphs-list)) - (setq edit-toolbar-added-buttons-alist - (append edit-toolbar-added-buttons-alist - (list (cons added-button glyphs-list)))) - (let ((func (read-string "Function to call: ")) - (help (read-string "Help String: "))) - (setq new-button (vector added-button (intern func) t help)))) - (let ((match (assoc button edit-toolbar-button-alist))) - (if match - (setq new-button (cdr match)) - (error "Can't find button %s" button)))) - (edit-toolbar-add-item new-button))) - -(defun edit-toolbar-prompt-for-initialization () - (popup-dialog-box - '("Edit Toolbar has created the file ~/.xemacs/.toolbar - -In order for your changes to take effect the next time -you start XEmacs, you need to add the following line -to the end of your .emacs file: - - (load \"~/.xemacs/.toolbar\") - -Alternatively, I can do this for you now." - ["Yes, please\nadd the line\nof code for me." edit-toolbar-add-initialization t] - nil - ["No thanks,\nI'll take care\nof it myself." ignore t]))) - -(defun edit-toolbar-add-initialization () - "Add a line to the end of the user's init file for edit-toolbar use." - (interactive) - (set-buffer (find-file-noselect user-init-file)) - (goto-char (point-max)) - (insert " -(if (and (featurep 'toolbar) - (fboundp 'console-on-window-system-p) - (console-on-window-system-p) - (file-exists-p \"" edit-toolbar-file-name "\")) - (load-file (expand-file-name \"" edit-toolbar-file-name "\"))) -") - (save-buffer)) - -(defun edit-toolbar-save () - "Save the current toolbar in the file specified by edit-toolbar-file-name." - (interactive) - (save-excursion - (let* ((exists (file-exists-p edit-toolbar-file-name)) - (buf (find-file-noselect edit-toolbar-file-name)) - (standard-output buf)) - (set-buffer buf) - (erase-buffer) - (insert "(setq edit-toolbar-added-buttons-alist '") - (prin1 edit-toolbar-added-buttons-alist) - (insert ")\n") - (insert "(mapcar - (lambda (cons) - (setf (symbol-value (car cons)) (toolbar-make-button-list (cdr cons))) - ) - edit-toolbar-added-buttons-alist)\n") - (insert (concat "(set-specifier " edit-toolbar-temp-toolbar-name) " '") - (prin1 (specifier-instance edit-toolbar-temp-toolbar)) - (insert ")") - (save-buffer) - (kill-buffer (current-buffer)) - (or exists (edit-toolbar-prompt-for-initialization)))) - (set-buffer-modified-p nil)) - -(provide 'edit-toolbar) - -;;; edit-toolbar.el ends here diff --git a/xemacs-packages/lisp/edit-utils/fast-lock.el b/xemacs-packages/lisp/edit-utils/fast-lock.el deleted file mode 100644 index cd7554d9..00000000 --- a/xemacs-packages/lisp/edit-utils/fast-lock.el +++ /dev/null @@ -1,773 +0,0 @@ -;;; fast-lock.el --- Automagic text properties caching for fast Font Lock mode. - -;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. - -;; Author: Simon Marshall -;; Keywords: faces files -;; Version: 3.11.01 - -;;; 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: - -;; Lazy Lock mode is a Font Lock support mode. -;; It makes visiting a file in Font Lock mode faster by restoring its face text -;; properties from automatically saved associated Font Lock cache files. -;; -;; See caveats and feedback below. -;; See also the lazy-lock package. (But don't use the two at the same time!) - -;; Installation: -;; -;; Put in your ~/.emacs: -;; -;; (setq font-lock-support-mode 'fast-lock-mode) -;; -;; Start up a new Emacs and use font-lock as usual (except that you can use the -;; so-called "gaudier" fontification regexps on big files without frustration). -;; -;; When you visit a file (which has `font-lock-mode' enabled) that has a -;; corresponding Font Lock cache file associated with it, the Font Lock cache -;; will be loaded from that file instead of being generated by Font Lock code. - -;; Caveats: -;; -;; A cache will be saved when visiting a compressed file using crypt++, but not -;; be read. This is a "feature"/"consequence"/"bug" of crypt++. -;; -;; Version control packages are likely to stamp all over file modification -;; times. Therefore the act of checking out may invalidate a cache. - -;; History: -;; -;; 0.02--1.00: -;; - Changed name from turbo-prop to fast-lock. Automagic for font-lock only -;; - Made `fast-lock-mode' a minor mode, like G. Dinesh Dutt's fss-mode -;; 1.00--1.01: -;; - Turn on `fast-lock-mode' only if `buffer-file-name' or `interactive-p' -;; - Made `fast-lock-file-name' use `buffer-name' if `buffer-file-name' is nil -;; - Moved save-all conditions to `fast-lock-save-cache' -;; - Added `fast-lock-save-text-properties' to `kill-buffer-hook' -;; 1.01--2.00: complete rewrite---not worth the space to document -;; - Changed structure of text properties cache and threw out file mod checks -;; 2.00--2.01: -;; - Made `condition-case' forms understand `quit'. -;; - Made `fast-lock' require `font-lock' -;; - Made `fast-lock-cache-name' chase links (from Ben Liblit) -;; 2.01--3.00: -;; - Changed structure of cache to include `font-lock-keywords' (from rms) -;; - Changed `fast-lock-cache-mechanisms' to `fast-lock-cache-directories' -;; - Removed `fast-lock-read-others' -;; - Made `fast-lock-read-cache' ignore cache owner -;; - Made `fast-lock-save-cache-external' create cache directory -;; - Made `fast-lock-save-cache-external' save `font-lock-keywords' -;; - Made `fast-lock-cache-data' check `font-lock-keywords' -;; 3.00--3.01: incorporated port of 2.00 to Lucid, made by Barry Warsaw -;; - Package now provides itself -;; - Lucid: Use `font-lock-any-extents-p' for `font-lock-any-properties-p' -;; - Lucid: Use `list-faces' for `face-list' -;; - Lucid: Added `set-text-properties' -;; - Lucid: Made `turn-on-fast-lock' pass 1 not t to `fast-lock-mode' -;; - Removed test for `fast-lock-mode' from `fast-lock-read-cache' -;; - Lucid: Added Lucid-specific `fast-lock-get-face-properties' -;; 3.01--3.02: now works with Lucid Emacs, thanks to Barry Warsaw -;; - Made `fast-lock-cache-name' map ":" to ";" for OS/2 (from Serganova Vera) -;; - Made `fast-lock-cache-name' use abbreviated file name (from Barry Warsaw) -;; - Lucid: Separated handlers for `error' and `quit' for `condition-case' -;; 3.02--3.03: -;; - Changed `fast-lock-save-cache-external' to `fast-lock-save-cache-data' -;; - Lucid: Added Lucid-specific `fast-lock-set-face-properties' -;; 3.03--3.04: -;; - Corrected `subrp' test of Lucid code -;; - Replaced `font-lock-any-properties-p' with `text-property-not-all' -;; - Lucid: Made `fast-lock-set-face-properties' put `text-prop' on extents -;; - Made `fast-lock-cache-directories' a regexp alist (from Colin Rafferty) -;; - Made `fast-lock-cache-directory' to return a usable cache file directory -;; 3.04--3.05: -;; - Lucid: Fix for XEmacs 19.11 `text-property-not-all' -;; - Replaced `subrp' test of Lucid code with `emacs-version' `string-match' -;; - Made `byte-compile-warnings' omit `unresolved' on compilation -;; - Made `fast-lock-save-cache-data' use a buffer (from Rick Sladkey) -;; - Reverted to old `fast-lock-get-face-properties' (from Rick Sladkey) -;; 3.05--3.06: incorporated hack of 3.03, made by Jonathan Stigelman (Stig) -;; - Reverted to 3.04 version of `fast-lock-get-face-properties' -;; - XEmacs: Removed `list-faces' `defalias' -;; - Made `fast-lock-mode' and `turn-on-fast-lock' succeed `autoload' cookies -;; - Added `fast-lock-submit-bug-report' -;; - Renamed `fast-lock-save-size' to `fast-lock-minimum-size' -;; - Made `fast-lock-save-cache' output a message if no save ever attempted -;; - Made `fast-lock-save-cache-data' output a message if save attempted -;; - Made `fast-lock-cache-data' output a message if load attempted -;; - Made `fast-lock-save-cache-data' do `condition-case' not `unwind-protect' -;; - Made `fast-lock-save-cache' and `fast-lock-read-cache' return nothing -;; - Made `fast-lock-save-cache' check `buffer-modified-p' (Stig) -;; - Added `fast-lock-save-events' -;; - Added `fast-lock-after-save-hook' to `after-save-hook' (Stig) -;; - Added `fast-lock-kill-buffer-hook' to `kill-buffer-hook' -;; - Changed `fast-lock-save-caches' to `fast-lock-kill-emacs-hook' -;; - Added `fast-lock-kill-emacs-hook' to `kill-emacs-hook' -;; - Made `fast-lock-save-cache' check `verify-visited-file-modtime' (Stig) -;; - Made `visited-file-modtime' be the basis of the timestamp (Stig) -;; - Made `fast-lock-save-cache-1' and `fast-lock-cache-data' use/reformat it -;; - Added `fast-lock-cache-filename' to keep track of the cache file name -;; - Added `fast-lock-after-fontify-buffer' -;; - Added `fast-lock-save-faces' list of faces to save (idea from Stig/Tibor) -;; - Made `fast-lock-get-face-properties' functions use it -;; - XEmacs: Made `fast-lock-set-face-properties' do extents the Font Lock way -;; - XEmacs: Removed fix for `text-property-not-all' (19.11 support dropped) -;; - Made `fast-lock-mode' ensure `font-lock-mode' is on -;; - Made `fast-lock-save-cache' do `cdr-safe' not `cdr' (from Dave Foster) -;; - Made `fast-lock-save-cache' do `set-buffer' first (from Dave Foster) -;; - Made `fast-lock-save-cache' loop until saved or quit (from Georg Nikodym) -;; - Made `fast-lock-cache-data' check `buffer-modified-p' -;; - Made `fast-lock-cache-data' do `font-lock-compile-keywords' if necessary -;; - XEmacs: Made `font-lock-compile-keywords' `defalias' -;; 3.06--3.07: -;; - XEmacs: Add `fast-lock-after-fontify-buffer' to the Font Lock hook -;; - Made `fast-lock-cache-name' explain the use of `directory-abbrev-alist' -;; - Made `fast-lock-mode' use `buffer-file-truename' not `buffer-file-name' -;; 3.07--3.08: -;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename' -;; 3.08--3.09: -;; - Made `fast-lock-save-cache' cope if `fast-lock-minimum-size' is an a list -;; - Made `fast-lock-mode' respect the value of `font-lock-inhibit-thing-lock' -;; - Added `fast-lock-after-unfontify-buffer' -;; 3.09--3.10: -;; - Rewrite for Common Lisp macros -;; - Made fast-lock.el barf on a crap 8+3 pseudo-OS (Eli Zaretskii help) -;; - XEmacs: Made `add-minor-mode' succeed `autoload' cookie -;; - XEmacs: Made `fast-lock-save-faces' default to `font-lock-face-list' -;; - Made `fast-lock-save-cache' use `font-lock-value-in-major-mode' -;; - Wrap with `save-buffer-state' (Ray Van Tassle report) -;; - Made `fast-lock-mode' wrap `font-lock-support-mode' -;; 3.10--3.11: -;; - Made `fast-lock-get-face-properties' cope with face lists -;; - Added `fast-lock-verbose' -;; - XEmacs: Add `font-lock-value-in-major-mode' if necessary -;; - Removed `fast-lock-submit-bug-report' and bade farewell -;; 3.10--3.11: - -;;; Code: - -(require 'font-lock) - -;; Make sure fast-lock.el is supported. -(if (and (eq system-type 'ms-dos) (not (msdos-long-file-names))) - (error "`fast-lock' was written for long file name systems")) - -(eval-when-compile - ;; - ;; We don't do this at the top-level as we only use non-autoloaded macros. - (require 'cl) - ;; - ;; I prefer lazy code---and lazy mode. - (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t) - ;; But, we make sure that the code is as zippy as can be. - (setq byte-optimize t) - ;; - ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (varlist &rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state." - (` (let* ((,@ (append varlist - '((modified (buffer-modified-p)) - (inhibit-read-only t) (buffer-undo-list t) - before-change-functions after-change-functions - deactivate-mark buffer-file-name buffer-file-truename)))) - (,@ body) - (when (and (not modified) (buffer-modified-p)) - (set-buffer-modified-p nil))))) - (put 'save-buffer-state 'lisp-indent-function 1) - ;; - ;; We use this to verify that a face should be saved. - (defmacro fast-lock-save-facep (face) - "Return non-nil if FACE is one of `fast-lock-save-faces'." - (` (or (null fast-lock-save-faces) - (if (symbolp (, face)) - (memq (, face) fast-lock-save-faces) - (let ((faces (, face))) - (while (unless (memq (car faces) fast-lock-save-faces) - (setq faces (cdr faces)))) - faces)))))) - -;(defun fast-lock-submit-bug-report () -; "Submit via mail a bug report on fast-lock.el." -; (interactive) -; (let ((reporter-prompt-for-summary-p t)) -; (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.11.01" -; '(fast-lock-cache-directories fast-lock-minimum-size -; fast-lock-save-others fast-lock-save-events fast-lock-save-faces -; fast-lock-verbose) -; nil nil -; (concat "Hi Si., -; -;I want to report a bug. I've read the `Bugs' section of `Info' on Emacs, so I -;know how to make a clear and unambiguous report. To reproduce the bug: -; -;Start a fresh editor via `" invocation-name " -no-init-file -no-site-file'. -;In the `*scratch*' buffer, evaluate:")))) - -(defgroup fast-lock nil - "Automagic text properties caching for fast Font Lock mode" - :group 'faces) - -;;;###autoload -(defcustom fast-lock-mode nil ;; customized for the options menu - "Non nil means `fast-lock-mode' is on" - :group 'fast-lock - :require 'fast-lock ;; which in turn requires font-lock. - :type 'boolean - :initialize 'custom-initialize-default - :set '(lambda (var val) - (if val - (progn - (fast-lock-mode 1) - (add-hook 'font-lock-mode-hook 'turn-on-fast-lock)) - (fast-lock-mode -1) - (remove-hook 'font-lock-mode-hook 'turn-on-fast-lock)) - (setq-default fast-lock-mode val)) - ) - -(defvar fast-lock-cache-timestamp nil) ; For saving/reading. -(defvar fast-lock-cache-filename nil) ; For deleting. - -;; User Variables: - -(defcustom fast-lock-cache-directories '("." "~/.emacs-flc") -; - `internal', keep each file's Font Lock cache file in the same file. -; - `external', keep each file's Font Lock cache file in the same directory. - "*Directories in which Font Lock cache files are saved and read. -Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where -DIR is a directory name (relative or absolute) and REGEXP is a regexp. - -An attempt will be made to save or read Font Lock cache files using these items -until one succeeds (i.e., until a readable or writable one is found). If an -item contains REGEXP, DIR is used only if the buffer file name matches REGEXP. -For example: - - (let ((home (expand-file-name (abbreviate-file-name (file-truename \"~/\"))))) - (list (cons (concat \"^\" (regexp-quote home)) \".\") \"~/.emacs-flc\")) - => - ((\"^/your/true/home/directory/\" . \".\") \"~/.emacs-flc\") - -would cause a file's current directory to be used if the file is under your -home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'." - :type '(repeat (choice (cons regexp directory) directory)) - :group 'fast-lock) - -(defcustom fast-lock-minimum-size (* 25 1024) - "*Minimum size of a buffer for cached fontification. -Only buffers more than this can have associated Font Lock cache files saved. -If nil, means cache files are never created. -If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), -where MAJOR-MODE is a symbol or t (meaning the default). For example: - ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576)) -means that the minimum size is 25K for buffers in C or C++ modes, one megabyte -for buffers in Rmail mode, and size is irrelevant otherwise." - :type '(choice (integer :tag "Size") (repeat (cons (symbol :tag "Major Mode") - (integer :tag "Size")))) - :group 'fast-lock) - -(defcustom fast-lock-save-events '(kill-buffer kill-emacs) - "*Events under which caches will be saved. -Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. -If concurrent editing sessions use the same associated cache file for a file's -buffer, then you should add `save-buffer' to this list." - :type '(set (const kill-buffer) (const save-buffer) (const kill-emacs)) - :group 'fast-lock) - -(defcustom fast-lock-save-others t - "*If non-nil, save Font Lock cache files irrespective of file owner. -If nil, means only buffer files known to be owned by you can have associated -Font Lock cache files saved. Ownership may be unknown for networked files." - :type 'boolean - :group 'fast-lock) - -(defvar fast-lock-save-faces - (when (save-match-data (string-match "XEmacs" (emacs-version))) - ;; XEmacs uses extents for everything, so we have to pick the right ones. - font-lock-face-list) - "Faces that will be saved in a Font Lock cache file. -If nil, means information for all faces will be saved.") - -(defcustom fast-lock-verbose font-lock-verbose - "*If non-nil, means show status messages for cache processing. -If a number, only buffers greater than this size have processing messages." - :type '(choice integer boolean) - :group 'fast-lock) - -;; User Functions: - -;;;###autoload -(defun fast-lock-mode (&optional arg) - "Toggle Fast Lock mode. -With arg, turn Fast Lock mode on if and only if arg is positive and the buffer -is associated with a file. Enable it automatically in your `~/.emacs' by: - - (setq font-lock-support-mode 'fast-lock-mode) - -If Fast Lock mode is enabled, and the current buffer does not contain any text -properties, any associated Font Lock cache is used if its timestamp matches the -buffer's file, and its `font-lock-keywords' match those that you are using. - -Font Lock caches may be saved: -- When you save the file's buffer. -- When you kill an unmodified file's buffer. -- When you exit Emacs, for all unmodified or saved buffers. -Depending on the value of `fast-lock-save-events'. -See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'. - -Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad. - -Various methods of control are provided for the Font Lock cache. In general, -see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'. -For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events', -`fast-lock-save-others' and `fast-lock-save-faces'." - (interactive "P") - ;; Only turn on if we are visiting a file. We could use `buffer-file-name', - ;; but many packages temporarily wrap that to nil when doing their own thing. - (set (make-local-variable 'fast-lock-mode) - (and buffer-file-truename - (not (memq 'fast-lock-mode font-lock-inhibit-thing-lock)) - (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode)))) - (if (and fast-lock-mode (not font-lock-mode)) - ;; Turned on `fast-lock-mode' rather than `font-lock-mode'. - (let ((font-lock-support-mode 'fast-lock-mode)) - (font-lock-mode t)) - ;; Let's get down to business. - (set (make-local-variable 'fast-lock-cache-timestamp) nil) - (set (make-local-variable 'fast-lock-cache-filename) nil) - (when (and fast-lock-mode (not font-lock-fontified)) - (fast-lock-read-cache)))) - -(defun fast-lock-read-cache () - "Read the Font Lock cache for the current buffer. - -The following criteria must be met for a Font Lock cache file to be read: -- Fast Lock mode must be turned on in the buffer. -- The buffer must not be modified. -- The buffer's `font-lock-keywords' must match the cache's. -- The buffer file's timestamp must match the cache's. -- Criteria imposed by `fast-lock-cache-directories'. - -See `fast-lock-mode'." - (interactive) - (let ((directories fast-lock-cache-directories) - (modified (buffer-modified-p)) (inhibit-read-only t) - (fontified font-lock-fontified)) - (set (make-local-variable 'font-lock-fontified) nil) - ;; Keep trying directories until fontification is turned off. - (while (and directories (not font-lock-fontified)) - (let ((directory (fast-lock-cache-directory (car directories) nil))) - (condition-case nil - (when directory - (setq fast-lock-cache-filename (fast-lock-cache-name directory)) - (when (file-readable-p fast-lock-cache-filename) - (load fast-lock-cache-filename t t t))) - (error nil) (quit nil)) - (setq directories (cdr directories)))) - ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if - ;; we don't use a cache. (Note that `fast-lock-cache-data' sets the value - ;; of `fast-lock-cache-timestamp'.) - (set-buffer-modified-p modified) - (unless font-lock-fontified - (setq fast-lock-cache-filename nil font-lock-fontified fontified)))) - -(defun fast-lock-save-cache (&optional buffer) - "Save the Font Lock cache of BUFFER or the current buffer. - -The following criteria must be met for a Font Lock cache file to be saved: -- Fast Lock mode must be turned on in the buffer. -- The event must be one of `fast-lock-save-events'. -- The buffer must be at least `fast-lock-minimum-size' bytes long. -- The buffer file must be owned by you, or `fast-lock-save-others' must be t. -- The buffer must contain at least one `face' text property. -- The buffer must not be modified. -- The buffer file's timestamp must be the same as the file's on disk. -- The on disk file's timestamp must be different than the buffer's cache. -- Criteria imposed by `fast-lock-cache-directories'. - -See `fast-lock-mode'." - (interactive) - (save-excursion - (when buffer - (set-buffer buffer)) - (let ((min-size (font-lock-value-in-major-mode fast-lock-minimum-size)) - (file-timestamp (visited-file-modtime)) (saved nil)) - (when (and fast-lock-mode - ;; - ;; "Only save if the buffer matches the file, the file has - ;; changed, and it was changed by the current emacs session." - ;; - ;; Only save if the buffer is not modified, - ;; (i.e., so we don't save for something not on disk) - (not (buffer-modified-p)) - ;; and the file's timestamp is the same as the buffer's, - ;; (i.e., someone else hasn't written the file in the meantime) - (verify-visited-file-modtime (current-buffer)) - ;; and the file's timestamp is different from the cache's. - ;; (i.e., a save has occurred since the cache was read) - (not (equal fast-lock-cache-timestamp file-timestamp)) - ;; - ;; Only save if user's restrictions are satisfied. - (and min-size (>= (buffer-size) min-size)) - (or fast-lock-save-others - (eq (user-uid) (nth 2 (file-attributes buffer-file-name)))) - ;; - ;; Only save if there are `face' properties to save. - (text-property-not-all (point-min) (point-max) 'face nil)) - ;; - ;; Try each directory until we manage to save or the user quits. - (let ((directories fast-lock-cache-directories)) - (while (and directories (memq saved '(nil error))) - (let* ((dir (fast-lock-cache-directory (car directories) t)) - (file (and dir (fast-lock-cache-name dir)))) - (when (and file (file-writable-p file)) - (setq saved (fast-lock-save-cache-1 file file-timestamp))) - (setq directories (cdr directories))))))))) - -;;;###autoload -(defun turn-on-fast-lock () - "Unconditionally turn on Fast Lock mode." - (fast-lock-mode t)) - -;;; API Functions: - -(defun fast-lock-after-fontify-buffer () - ;; Delete the Font Lock cache file used to restore fontification, if any. - (when (and fast-lock-cache-filename (file-exists-p fast-lock-cache-filename)) - (if (file-writable-p fast-lock-cache-filename) - (delete-file fast-lock-cache-filename) - (message "File %s font lock cache cannot be deleted" (buffer-name)))) - ;; Flag so that a cache will be saved later even if the file is never saved. - (setq fast-lock-cache-timestamp nil)) - -(defalias 'fast-lock-after-unfontify-buffer - 'ignore) - -;; Miscellaneous Functions: - -(defun fast-lock-save-cache-after-save-file () - ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'. - (when (memq 'save-buffer fast-lock-save-events) - (fast-lock-save-cache))) - -(defun fast-lock-save-cache-before-kill-buffer () - ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'. - (when (memq 'kill-buffer fast-lock-save-events) - (fast-lock-save-cache))) - -(defun fast-lock-save-caches-before-kill-emacs () - ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'. - (when (memq 'kill-emacs fast-lock-save-events) - (mapcar 'fast-lock-save-cache (buffer-list)))) - -(defun fast-lock-cache-directory (directory create) - "Return usable directory based on DIRECTORY. -Returns nil if the directory does not exist, or, if CREATE non-nil, cannot be -created. DIRECTORY may be a string or a cons pair of the form (REGEXP . DIR). -See `fast-lock-cache-directories'." - (let ((dir - (cond ((not buffer-file-name) - ;; Should never be nil, but `crypt++' screws it up. - nil) - ((stringp directory) - ;; Just a directory. - directory) - (t - ;; A directory iff the file name matches the regexp. - (let ((bufile (expand-file-name buffer-file-truename)) - (case-fold-search nil)) - (when (save-match-data (string-match (car directory) bufile)) - (cdr directory))))))) - (cond ((not dir) - nil) - ((file-accessible-directory-p dir) - dir) - (create - (condition-case nil - (progn (make-directory dir t) dir) - (error nil)))))) - -;; If you are wondering why we only hash if the directory is not ".", rather -;; than if `file-name-absolute-p', it is because if we just appended ".flc" for -;; relative cache directories (that are not ".") then it is possible that more -;; than one file would have the same cache name in that directory, if the luser -;; made a link from one relative cache directory to another. (Phew!) -(defun fast-lock-cache-name (directory) - "Return full cache path name using caching DIRECTORY. -If DIRECTORY is `.', the path is the buffer file name appended with `.flc'. -Otherwise, the path name is constructed from DIRECTORY and the buffer's true -abbreviated file name, with all `/' characters in the name replaced with `#' -characters, and appended with `.flc'. - -If the same file has different cache path names when edited on different -machines, e.g., on one machine the cache file name has the prefix `#home', -perhaps due to automount, try putting in your `~/.emacs' something like: - - (setq directory-abbrev-alist (cons '(\"^/home/\" . \"/\") directory-abbrev-alist)) - -Emacs automagically removes the common `/tmp_mnt' automount prefix by default. - -See `fast-lock-cache-directory'." - (if (string-equal directory ".") - (concat buffer-file-name ".flc") - (let* ((bufile (expand-file-name buffer-file-truename)) - (chars-alist - (cond - ((eq system-type 'emx) - '((?/ . (?#)) (?# . (?# ?#)) (?: . (?\;)) (?\; . (?\; ?\;)))) - ((eq system-type 'windows-nt) - '((?\\ . (?#)) (?# . (?# ?#)) (?: . (?\;)) (?\; . (?\; ?\;)))) - (t - '((?/ . (?#)) (?# . (?# ?#)))))) - (mapchars - (function (lambda (c) (or (cdr (assq c chars-alist)) (list c)))))) - (concat - (file-name-as-directory (expand-file-name directory)) - (mapconcat 'char-to-string (apply 'append (mapcar mapchars bufile)) "") - ".flc")))) - -;; Font Lock Cache Processing Functions: - -(defun fast-lock-save-cache-1 (file timestamp) - ;; Save the FILE with the TIMESTAMP as: - ;; (fast-lock-cache-data Version=2 TIMESTAMP font-lock-keywords PROPERTIES). - ;; Returns non-nil if a save was attempted to a writable cache file. - (let ((tpbuf (generate-new-buffer " *fast-lock*")) - (verbose (if (numberp fast-lock-verbose) - (> (buffer-size) fast-lock-verbose) - fast-lock-verbose)) - (saved t)) - (if verbose (message "Saving %s font lock cache..." (buffer-name))) - (condition-case nil - (save-excursion - (print (list 'fast-lock-cache-data 2 - (list 'quote timestamp) - (list 'quote font-lock-keywords) - (list 'quote (fast-lock-get-face-properties))) - tpbuf) - (set-buffer tpbuf) - (write-region (point-min) (point-max) file nil 'quietly) - (setq fast-lock-cache-timestamp timestamp - fast-lock-cache-filename file)) - (error (setq saved 'error)) (quit (setq saved 'quit))) - (kill-buffer tpbuf) - (if verbose (message "Saving %s font lock cache...%s" (buffer-name) - (cond ((eq saved 'error) "failed") - ((eq saved 'quit) "aborted") - (t "done")))) - ;; We return non-nil regardless of whether a failure occurred. - saved)) - -(defun fast-lock-cache-data (version timestamp keywords properties - &rest ignored) - ;; Change from (HIGH LOW) for back compatibility. Remove for version 3! - (when (consp (cdr-safe timestamp)) - (setcdr timestamp (nth 1 timestamp))) - ;; Compile KEYWORDS and `font-lock-keywords' in case one is and one isn't. - (let ((current font-lock-keywords)) - (setq keywords (font-lock-compile-keywords keywords) - font-lock-keywords (font-lock-compile-keywords current))) - ;; Use the Font Lock cache PROPERTIES if we're using cache VERSION format 2, - ;; the current buffer's file timestamp matches the TIMESTAMP, and the current - ;; buffer's font-lock-keywords are the same as KEYWORDS. - (let ((buf-timestamp (visited-file-modtime)) - (verbose (if (numberp fast-lock-verbose) - (> (buffer-size) fast-lock-verbose) - fast-lock-verbose)) - (loaded t)) - (if (or (/= version 2) - (buffer-modified-p) - (not (equal timestamp buf-timestamp)) - (not (equal keywords font-lock-keywords))) - (setq loaded nil) - (if verbose (message "Loading %s font lock cache..." (buffer-name))) - (condition-case nil - (fast-lock-set-face-properties properties) - (error (setq loaded 'error)) (quit (setq loaded 'quit))) - (if verbose (message "Loading %s font lock cache...%s" (buffer-name) - (cond ((eq loaded 'error) "failed") - ((eq loaded 'quit) "aborted") - (t "done"))))) - (setq font-lock-fontified (eq loaded t) - fast-lock-cache-timestamp (and (eq loaded t) timestamp)))) - -;; Text Properties Processing Functions: - -;; This is fast, but fails if adjacent characters have different `face' text -;; properties. Maybe that's why I dropped it in the first place? -;(defun fast-lock-get-face-properties () -; "Return a list of all `face' text properties in the current buffer. -;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) -;where VALUE is a `face' property value and STARTx and ENDx are positions." -; (save-restriction -; (widen) -; (let ((start (text-property-not-all (point-min) (point-max) 'face nil)) -; (limit (point-max)) end properties value cell) -; (while start -; (setq end (next-single-property-change start 'face nil limit) -; value (get-text-property start 'face)) -; ;; Make, or add to existing, list of regions with same `face'. -; (if (setq cell (assq value properties)) -; (setcdr cell (cons start (cons end (cdr cell)))) -; (setq properties (cons (list value start end) properties))) -; (setq start (next-single-property-change end 'face))) -; properties))) - -;; This is slow, but copes if adjacent characters have different `face' text -;; properties, but fails if they are lists. -;(defun fast-lock-get-face-properties () -; "Return a list of all `face' text properties in the current buffer. -;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) -;where VALUE is a `face' property value and STARTx and ENDx are positions. -;Only those `face' VALUEs in `fast-lock-save-faces' are returned." -; (save-restriction -; (widen) -; (let ((faces (or fast-lock-save-faces (face-list))) (limit (point-max)) -; properties regions face start end) -; (while faces -; (setq face (car faces) faces (cdr faces) regions () end (point-min)) -; ;; Make a list of start/end regions with `face' property face. -; (while (setq start (text-property-any end limit 'face face)) -; (setq end (or (text-property-not-all start limit 'face face) limit) -; regions (cons start (cons end regions)))) -; ;; Add `face' face's regions, if any, to properties. -; (when regions -; (push (cons face regions) properties))) -; properties))) - -(defun fast-lock-get-face-properties () - "Return a list of all `face' text properties in the current buffer. -Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) -where VALUE is a `face' property value and STARTx and ENDx are positions." - (save-restriction - (widen) - (let ((start (text-property-not-all (point-min) (point-max) 'face nil)) - end properties value cell) - (while start - (setq end (next-single-property-change start 'face nil (point-max)) - value (get-text-property start 'face)) - ;; Make, or add to existing, list of regions with same `face'. - (cond ((setq cell (assoc value properties)) - (setcdr cell (cons start (cons end (cdr cell))))) - ((fast-lock-save-facep value) - (push (list value start end) properties))) - (setq start (text-property-not-all end (point-max) 'face nil))) - properties))) - -(defun fast-lock-set-face-properties (properties) - "Set all `face' text properties to PROPERTIES in the current buffer. -Any existing `face' text properties are removed first. -See `fast-lock-get-face-properties' for the format of PROPERTIES." - (save-buffer-state (plist regions) - (save-restriction - (widen) - (font-lock-unfontify-region (point-min) (point-max)) - (while properties - (setq plist (list 'face (car (car properties))) - regions (cdr (car properties)) - properties (cdr properties)) - ;; Set the `face' property for each start/end region. - (while regions - (set-text-properties (nth 0 regions) (nth 1 regions) plist) - (setq regions (nthcdr 2 regions))))))) - -;; Functions for XEmacs: - -(when (save-match-data (string-match "XEmacs" (emacs-version))) - ;; - ;; It would be better to use XEmacs' `map-extents' over extents with a - ;; `font-lock' property, but `face' properties are on different extents. - (defun fast-lock-get-face-properties () - "Return a list of all `face' text properties in the current buffer. -Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) -where VALUE is a `face' property value and STARTx and ENDx are positions. -Only those `face' VALUEs in `fast-lock-save-faces' are returned." - (save-restriction - (widen) - (let ((properties ()) cell) - (map-extents - (function (lambda (extent ignore) - (let ((value (extent-face extent))) - ;; We're only interested if it's one of `fast-lock-save-faces'. - (when (and value (fast-lock-save-facep value)) - (let ((start (extent-start-position extent)) - (end (extent-end-position extent))) - ;; Make or add to existing list of regions with the same - ;; `face' property value. - (if (setq cell (assoc value properties)) - (setcdr cell (cons start (cons end (cdr cell)))) - (push (list value start end) properties)))) - ;; Return nil to keep `map-extents' going. - nil)))) - properties))) - ;; - ;; Make extents just like XEmacs' font-lock.el does. - (defun fast-lock-set-face-properties (properties) - "Set all `face' text properties to PROPERTIES in the current buffer. -Any existing `face' text properties are removed first. -See `fast-lock-get-face-properties' for the format of PROPERTIES." - (save-restriction - (widen) - (font-lock-unfontify-region (point-min) (point-max)) - (while properties - (let ((face (car (car properties))) - (regions (cdr (car properties)))) - ;; Set the `face' property, etc., for each start/end region. - (while regions - (font-lock-set-face (nth 0 regions) (nth 1 regions) face) - (setq regions (nthcdr 2 regions))) - (setq properties (cdr properties)))))) - ;; - ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook. - (add-hook 'font-lock-after-fontify-buffer-hook - 'fast-lock-after-fontify-buffer)) - -(unless (boundp 'font-lock-inhibit-thing-lock) - (defvar font-lock-inhibit-thing-lock nil - "List of Font Lock mode related modes that should not be turned on.")) - -(unless (fboundp 'font-lock-value-in-major-mode) - (defun font-lock-value-in-major-mode (alist) - ;; Return value in ALIST for `major-mode'. - (if (consp alist) - (cdr (or (assq major-mode alist) (assq t alist))) - alist))) - -(unless (fboundp 'font-lock-compile-keywords) - (defalias 'font-lock-compile-keywords 'identity)) - -;; Install ourselves: - -(add-hook 'after-save-hook 'fast-lock-save-cache-after-save-file) -(add-hook 'kill-buffer-hook 'fast-lock-save-cache-before-kill-buffer) -(add-hook 'kill-emacs-hook 'fast-lock-save-caches-before-kill-emacs) - -;;;###autoload -(when (fboundp 'add-minor-mode) - (defvar fast-lock-mode nil) - (add-minor-mode 'fast-lock-mode nil)) -;;;###dont-autoload -(unless (assq 'fast-lock-mode minor-mode-alist) - (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil))))) - -;; Provide ourselves: - -(provide 'fast-lock) - -;;; fast-lock.el ends here diff --git a/xemacs-packages/lisp/edit-utils/file-part.el b/xemacs-packages/lisp/edit-utils/file-part.el deleted file mode 100644 index ac0bd2e1..00000000 --- a/xemacs-packages/lisp/edit-utils/file-part.el +++ /dev/null @@ -1,273 +0,0 @@ -;;; file-part.el --- treat a section of a buffer as a separate file - -;; Keywords: extensions, tools - -;; Copyright (C) 1992-1993 Sun Microsystems. - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not in FSF. - -;; Written by Ben Wing. - -(provide 'file-part) - -(define-error 'file-part-error "File part error" 'file-error) - -(defvar file-part-extent-alist nil - "Alist of file parts in the current buffer. -Each element of the alist maps an extent describing the file part -to the buffer containing the file part. DON'T MODIFY THIS.") -(make-variable-buffer-local 'file-part-extent-alist) -(setq-default file-part-extent-alist nil) - -(defvar file-part-master-extent nil - "Extent this file part refers to in the master buffer. -NIL if this buffer is not a file part. The master buffer itself -can be found by calling `extent-buffer' on this extent. -DON'T MODIFY THIS.") -(make-variable-buffer-local 'file-part-master-extent) -(setq-default file-part-master-extent nil) - -(or (assq 'file-part-master-extent minor-mode-alist) - (setq minor-mode-alist - (cons minor-mode-alist - '((file-part-master-extent " File-part"))))) - -; apply a function to each element of a list and return true if -; any of the functions returns true. -(defun file-part-maptrue (fn list) - (cond ((null list) nil) - ((funcall fn (car list))) - (t (file-part-maptrue fn (cdr list))))) - -; return a buffer to operate on. If NIL is specified, this is the -; current buffer. If a string is specified, this is the buffer with -; that name. -(defun file-part-buffer-from-arg (arg) - (get-buffer (or arg (current-buffer)))) - -;;;###autoload -(defun make-file-part (&optional start end name buffer) - "Make a file part on buffer BUFFER out of the region. Call it NAME. -This command creates a new buffer containing the contents of the -region and marks the buffer as referring to the specified buffer, -called the `master buffer'. When the file-part buffer is saved, -its changes are integrated back into the master buffer. When the -master buffer is deleted, all file parts are deleted with it. - -When called from a function, expects four arguments, START, END, -NAME, and BUFFER, all of which are optional and default to the -beginning of BUFFER, the end of BUFFER, a name generated from -BUFFER's name, and the current buffer, respectively." - (interactive "r\nsName of file part: ") - (setq buffer (file-part-buffer-from-arg buffer)) - (if (null start) (setq start (point-min))) - (if (null end) (setq end (point-max))) - (if (null name) (setq name (concat (buffer-name buffer) "-part"))) - (if (> start end) nil - (set-buffer buffer) - (make-local-variable 'write-contents-hooks) - (make-local-variable 'kill-buffer-hook) - (make-local-variable 'revert-buffer-function) - (add-hook 'write-contents-hooks 'write-master-buffer-hook) - (add-hook 'kill-buffer-hook 'kill-master-buffer-hook) - (setq revert-buffer-function 'revert-master-buffer-function) - (if (file-part-maptrue (function (lambda (x) - (let ((b (extent-start-position (car x))) - (e (extent-end-position (car x)))) - (and - (numberp b) - (numberp e) - (not (or (and (<= b start) (<= e start)) - (and (>= b end) (>= e end)))))))) - file-part-extent-alist) - (signal 'file-part-error (list "Overlapping file parts not allowed" - buffer)) - (let ((x (make-extent start end)) - (filebuf (generate-new-buffer name))) - (set-extent-property x 'read-only t) - (setq file-part-extent-alist - (cons (cons x filebuf) file-part-extent-alist)) - (switch-to-buffer filebuf) - (setq buffer-file-name (concat "File part on " (buffer-name buffer))) - (make-local-variable 'write-file-hooks) - (make-local-variable 'kill-buffer-hook) - (make-local-variable 'revert-buffer-function) - (make-local-variable 'first-change-hook) - (add-hook 'write-file-hooks 'write-file-part-hook) - (add-hook 'kill-buffer-hook 'kill-file-part-hook) - (setq revert-buffer-function 'revert-file-part-function) - (setq file-part-master-extent x) - (insert-buffer-substring buffer start end) - ; do this after inserting the text so the master buffer isn't marked as - ; modified. - (add-hook 'first-change-hook 'file-part-first-change-hook) - (set-buffer-modified-p nil) - filebuf)))) - -(defun kill-file-part-hook () - "Hook to be called when a file-part buffer is killed. -Removes the file part from the master buffer's list of file parts." - (let ((x file-part-master-extent) - (buf (current-buffer))) - (if x (save-excursion - (set-buffer (extent-buffer x)) - (setq file-part-extent-alist - (delete (cons x buf) file-part-extent-alist)) - (delete-extent x))))) - -(defun kill-all-file-parts (&optional bufname no-ask) - "Kill all file parts on buffer BUFNAME. -The argument may be a buffer or the name of a buffer. -If one or more of the file parts needs saving, prompts for -confirmation unless optional second argument NO-ASK is non-nil. -BUFFER defaults to the current buffer if not specified." - (interactive "b") - (setq bufname (file-part-buffer-from-arg bufname)) - (save-excursion - (set-buffer bufname) - (and (or no-ask - (not (file-parts-modified-p bufname)) - (y-or-n-p "Buffer has modified file parts; kill anyway? ")) - (mapcar (function (lambda (x) - (set-buffer (cdr x)) - (set-buffer-modified-p nil) - (kill-buffer (cdr x)))) - file-part-extent-alist)))) - -(defun kill-master-buffer-hook () - "Hook to be called when a master buffer is killed. -Kills the associated file parts." - (kill-all-file-parts (current-buffer) t)) - -(defun file-part-check-attached (x) - (cond ((null x) nil) - ((extent-property x 'detached) - (kill-file-part-hook) - (setq buffer-file-name nil) - (setq file-part-master-extent nil) - (message "File part has become detached.") - nil) - (t))) - -(defun write-file-part-hook () - "Hook to be called when a file part is saved. -Saves the file part into the master buffer." - (let ((x file-part-master-extent) - (buf (current-buffer)) - (len (- (point-max) (point-min))) - (retval (not (null file-part-master-extent)))) - (and (file-part-check-attached x) - (let ((b (extent-start-position x)) - (e (extent-end-position x))) - (save-excursion - (set-buffer (extent-buffer x)) - (set-extent-property x 'read-only nil) - (goto-char b) - (insert-buffer-substring buf) - (delete-region (+ len b) (+ len e)) - (set-extent-property x 'read-only t) - (set-buffer buf) - (set-buffer-modified-p nil) - (message "Wrote file part %s on %s" - (buffer-name buf) - (buffer-name (extent-buffer x))) - t))) - retval)) - -(defun write-master-buffer-hook () - "Hook to be called when a master buffer is saved. -If there are modified file parts on the buffer, optionally -saves the file parts back into the buffer." - (save-some-file-part-buffers) - nil) - -(defun save-some-file-part-buffers (&optional arg buffer) - "Save some modified file-part buffers on BUFFER. Asks user about each one. -Optional argument (the prefix) non-nil means save all with no questions. -BUFFER defaults to the current buffer if not specified." - (interactive "p") - (setq buffer (file-part-buffer-from-arg buffer)) - (let ((alist file-part-extent-alist) - (name (buffer-name buffer))) - (while alist - (let ((buf (cdr (car alist)))) - (and (buffer-modified-p buf) - (or arg - (y-or-n-p (format "Save file part %s on %s? " - (buffer-name buf) (buffer-name buffer)))) - (condition-case () - (save-excursion - (set-buffer buf) - (save-buffer)) - (error nil)))) - (setq alist (cdr alist))))) - -(defun file-parts-modified-p (&optional buffer) - "Return true if BUFFER has any modified file parts on it. -BUFFER defaults to the current buffer if not specified." - (save-excursion - (and buffer (set-buffer buffer)) - (file-part-maptrue (function (lambda (x) (buffer-modified-p (cdr x)))) - file-part-extent-alist))) - -(defun revert-file-part-function (&optional check-auto noconfirm) - "Hook to be called when a file part is reverted. -Reverts the file part from the master buffer." - (let ((x file-part-master-extent)) - (and (file-part-check-attached x) - (let ((master (extent-buffer x))) - (and - (or noconfirm - (yes-or-no-p - (format - "Revert file part from master buffer %s? " - (buffer-name master)))) - (progn - (erase-buffer) - (let ((mod (buffer-modified-p master))) - (insert-buffer-substring master - (extent-start-position x) - (extent-end-position x)) - (set-buffer-modified-p nil) - (save-excursion - (set-buffer master) - (set-buffer-modified-p mod))))))))) - -(defun revert-master-buffer-function (&optional check-auto noconfirm) - "Hook to be called when a master-buffer is reverted. -Makes sure the user is aware that the file parts will become detached, -then proceeds as normal." - (or noconfirm - (null file-part-extent-alist) - (progn - (message "Warning: file parts will become detached.") - (sleep-for 2))) - (let ((revert-buffer-function nil)) - (revert-buffer (not check-auto) noconfirm))) - -(defun file-part-first-change-hook () - "Hook to be called when a file part is first modified. -Marks the master buffer as modified." - (let ((x file-part-master-extent)) - (and (file-part-check-attached x) - (save-excursion - (set-buffer (extent-buffer x)) - (set-buffer-modified-p t))))) - diff --git a/xemacs-packages/lisp/edit-utils/floating-toolbar.el b/xemacs-packages/lisp/edit-utils/floating-toolbar.el deleted file mode 100644 index 28e01476..00000000 --- a/xemacs-packages/lisp/edit-utils/floating-toolbar.el +++ /dev/null @@ -1,385 +0,0 @@ -;;; floating-toolbar.el -- popup toolbar support for XEmacs. -;; Copyright (C) 1997 Kyle E. Jones - -;; Author: Kyle Jones -;; Keywords: lisp - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. - -;; XEmacs 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Popup toolbar for XEmacs (probably require XEmacs 19.14 or later) -;; Send bug reports to kyle_jones@wonderworks.com - -;; The command `floating-toolbar' pops up a small frame -;; containing a toolbar. The command should be bound to a -;; button-press event. If the mouse press happens over an -;; extent that has a non-nil 'floating-toolbar property, the -;; value of that property is the toolbar instantiator that will -;; be displayed. Otherwise the toolbar displayed is taken from -;; the variable `floating-toolbar'. This variable can be made -;; buffer local to produce buffer local floating toolbars. -;; -;; `floating-toolbar-or-popup-mode-menu' works like `floating-toolbar' -;; except that if no toolbar is found, `popup-mode-menu' is called. -;; -;; `floating-toolbar-from-extent-or-popup-mode-menu' works like -;; `floating-toolbar-or-popup-mode-menu' except only extent local -;; toolbars are used; the value of floating-toolbar is not used. -;; -;; Installation: -;; -;; Byte-compile the file floating-toolbar.el (with M-x byte-compile-file) -;; and put the .elc file in a directory in your load-path. Add the -;; following line to your .emacs: -;; -;; (require 'floating-toolbar) -;; -;; You will also need to bind a mouse click to `floating-toolbar' or to -;; `floating-toolbar-or-popup-mode-menu'. -;; -;; For 19.12 users: -;; If you are using fvwm, [tv]twm or ol[v]wm, you can also add -;; the following lines to various configuration file to use -;; minimal decorations on the toolbar frame. -;; -;; In .emacs: -;; (setq floating-toolbar-frame-name "floating-toolbar") -;; -;; For ol[v]wm use this in .Xdefaults: -;; olvwm.NoDecor: floating-toolbar -;; or -;; olwm.MinimalDecor: floating-toolbar -;; -;; For fvvm use this in your .fvwmrc: -;; NoTitle floating-toolbar -;; or -;; Style "floating-toolbar" NoTitle, NoHandles, BorderWidth 0 -;; -;; For twm use this in your .twmrc: -;; NoTitle { "floating-toolbar" } -;; -;; Under 19.13 and later versions the floating-toolbar frame uses a -;; transient window that is not normally decorated by window -;; managers. So the window manager directives should not be -;; needed for XEmacs 19.13 and beyond. - -;;; Code: - -(provide 'floating-toolbar) - -;; (require 'toolbar) - -(defvar floating-toolbar-version "1.02" - "Version string for the floating-toolbar package.") - -(defvar floating-toolbar-use-sound nil - "*Non-nil value means play a sound to herald the appearance -and disappearance of the floating toolbar. - -`floating-toolbar-appears' will be played when the toolbar appears. -`floating-toolbar-disappears' will be played when the toolbar disappears. - -See the documentation for the function `load-sound-file' to see how -define sounds.") - -(defvar floating-toolbar nil - "*Toolbar instantiator used if mouse event is not over an extent -with a non-nil 'floating-toolbar property. This variable can be -made local to a buffer to have buffer local floating toolbars.") - -(defvar floating-toolbar-help-font nil - "*Non-nil value should be a font to be used to display toolbar help -messages. The floating toolbar frame will have a minibuffer window -so that it can display any help text that is attached to the toolbar -buttons.") - -(defvar floating-toolbar-frame-name nil - "*The frame name for the frame used to display the floating toolbar.") - -;;; -;;; End of user variables. -;;; - -(defvar floating-toolbar-frame nil - "The floating toolbar is displayed in this frame.") - -(defvar floating-toolbar-display-pending nil - "Non-nil value means the toolbar frame will be visible as soon -as the X server gets around to displaying it. Nil means it -will be invisible as soon as the X server decides to hide it.") - -(defun floating-toolbar-displayed () - (and (frame-live-p floating-toolbar-frame) - (frame-visible-p floating-toolbar-frame))) - -;;;###autoload -(defun floating-toolbar (event &optional extent-local-only) - "Popup a toolbar near the current mouse position. -The toolbar instantiator used is taken from the 'floating-toolbar -property of any extent under the mouse. If no such non-nil -property exists for any extent under the mouse, then the value of the -variable `floating-toolbar' is checked. If its value is nil, then -no toolbar will be displayed. - -This command should be bound to a button press event. - -When called from a program, first arg EVENT should be the button -press event. Optional second arg EXTENT-LOCAL-ONLY specifies -that only extent local toolbars should be used; this means the -`floating-toolbar' variable will not be consulted." - (interactive "_e") - (unless (featurep 'toolbar) - (error "Floating toolbar requires built in toolbar support.")) - (if (not (mouse-event-p event)) - nil - (let* ((buffer (event-buffer event)) - (window (event-window event)) - (frame (event-frame event)) - (point (and buffer (event-point event))) - (glyph-extent (event-glyph-extent event)) - (glyph-extent (if (and glyph-extent - (extent-property glyph-extent - 'floating-toolbar)) - glyph-extent)) - (extent (or glyph-extent - (and point - (extent-at point buffer 'floating-toolbar)))) - (toolbar (or (and extent (get extent 'floating-toolbar)) - (and (not extent-local-only) - (symbol-value-in-buffer 'floating-toolbar - buffer nil)))) - (x nil) - (y nil) - (echo-keystrokes 0) - (awaiting-release t) - (done nil)) - (if (not (consp toolbar)) - nil - ;; event-[xy]-pixel are relative to the top left corner - ;; of the frame. The presence of top and left toolbar - ;; and the menubar can move this position down and - ;; leftward, but XEmacs doesn't compensate for this in - ;; the values returned. So we do it here, as best we - ;; can. - (let* ((params (frame-parameters frame)) - (top (cdr (assq 'top params))) - (left (cdr (assq 'left params))) - (xtop-toolbar-height - (if (specifier-instance top-toolbar) - (specifier-instance top-toolbar-height) - 0)) - (xleft-toolbar-width - (if (specifier-instance left-toolbar) - (specifier-instance left-toolbar-width) - 0)) - ;; better than nothing - (menubar-height (if (and (featurep 'menubar) - current-menubar) 22 0))) - (setq x (+ left xleft-toolbar-width (event-x-pixel event)) - y (+ top xtop-toolbar-height menubar-height - (event-y-pixel event)))) - ;; for toolbar spec buffer local variable values - (and buffer (set-buffer buffer)) - (floating-toolbar-display-toolbar toolbar x y) - (while (not done) - (setq event (next-command-event)) - (cond ((and awaiting-release (button-release-event-p event)) - (setq awaiting-release nil)) - ((and (button-release-event-p event) - (event-over-toolbar-p event) - (eq floating-toolbar-frame (event-frame event))) - (floating-toolbar-undisplay-toolbar) - (and window (select-frame (window-frame window))) - (and window (select-window window)) - (dispatch-event event) - (setq done t)) - ((and (button-press-event-p event) - (event-over-toolbar-p event) - (eq floating-toolbar-frame (event-frame event))) - (setq awaiting-release nil) - (dispatch-event event)) - (t - ;; push back the event if it was in another frame. - ;; eat it if it was in the toolbar frame. - (if (and (event-frame event) - (not (eq floating-toolbar-frame - (event-frame event)))) - (setq unread-command-events - (cons event unread-command-events))) - (floating-toolbar-undisplay-toolbar) - (setq done t)))) - t )))) - -;;;###autoload -(defun floating-toolbar-or-popup-mode-menu (event) - "Like floating-toolbar, but if no toolbar is displayed -run popup-mode-menu." - (interactive "_e") - (or (floating-toolbar event) (popup-mode-menu))) - -;;;###autoload -(defun floating-toolbar-from-extent-or-popup-mode-menu (event) - "Like floating-toolbar-or-popup-mode-menu, but search only for an -extent local toolbar." - (interactive "_e") - (or (floating-toolbar event t) (popup-mode-menu))) - -(defun floating-toolbar-display-toolbar (toolbar x y) - (if (not (frame-live-p floating-toolbar-frame)) - (setq floating-toolbar-frame (floating-toolbar-make-toolbar-frame x y))) - (set-specifier top-toolbar - (cons (window-buffer - (frame-selected-window floating-toolbar-frame)) - toolbar)) - (floating-toolbar-resize-toolbar-frame toolbar) - ;; fiddle with the x value to try to center the toolbar relative to - ;; the mouse position. - (setq x (max 0 (- x (/ (frame-pixel-width floating-toolbar-frame) 2)))) - (floating-toolbar-set-toolbar-frame-position x y) - (floating-toolbar-expose-toolbar-frame)) - -(defun floating-toolbar-undisplay-toolbar () - (floating-toolbar-hide-toolbar-frame)) - -(defun floating-toolbar-hide-toolbar-frame () - (if (floating-toolbar-displayed) - (progn - (make-frame-invisible floating-toolbar-frame) - (if (and floating-toolbar-use-sound floating-toolbar-display-pending) - (play-sound 'floating-toolbar-disappears)) - (setq floating-toolbar-display-pending nil)))) - -(defun floating-toolbar-expose-toolbar-frame () - (if (not (floating-toolbar-displayed)) - (progn - (make-frame-visible floating-toolbar-frame) - (if (and floating-toolbar-use-sound - (null floating-toolbar-display-pending)) - (play-sound 'floating-toolbar-appears)) - (setq floating-toolbar-display-pending t)))) - -(defun floating-toolbar-resize-toolbar-frame (toolbar) - (let ((width 0) - (height nil) - (bevel (* 2 (or (cdr (assq 'toolbar-shadow-thickness (frame-parameters))) - 0))) - (captioned (specifier-instance toolbar-buttons-captioned-p)) - button glyph glyph-list) - (while toolbar - (setq button (car toolbar)) - (cond ((null button) - (setq width (+ width 8))) - ((eq (elt button 0) ':size) - (setq width (+ width (elt button 1)))) - ((and (eq (elt button 0) ':style) - (= (length button) 4) - (eq (elt button 2) ':size)) - (setq width (+ width bevel (elt button 3)))) - (t - (setq glyph-list (elt button 0)) - (if (symbolp glyph-list) - (setq glyph-list (symbol-value glyph-list))) - (if (and captioned (> (length glyph-list) 3)) - (setq glyph (or (nth 3 glyph-list) - (nth 4 glyph-list) - (nth 5 glyph-list))) - (setq glyph (car glyph-list))) - (setq width (+ width bevel (glyph-width glyph))) - (or height (setq height (+ bevel (glyph-height glyph)))))) - (setq toolbar (cdr toolbar))) - (set-specifier top-toolbar-height height floating-toolbar-frame) - (set-frame-width floating-toolbar-frame - (1+ (/ width (font-width (face-font 'default) - floating-toolbar-frame)))))) - -(defun floating-toolbar-set-toolbar-frame-position (x y) - (set-frame-position floating-toolbar-frame x y)) - -(defun floating-toolbar-make-junk-frame () - (let ((window-min-height 1) - (window-min-width 1)) - (save-excursion - (set-buffer (generate-new-buffer "*junk-frame-buffer*")) - (prog1 - (make-frame '(minibuffer t initially-unmapped t width 1 height 1)) - (rename-buffer " *junk-frame-buffer*" t))))) - -(defun floating-toolbar-make-toolbar-frame (x y) - (save-excursion - (let ((window-min-height 1) - (window-min-width 1) - (bg-color (or (x-get-resource "backgroundToolBarColor" - "BackgroundToolBarColor" - 'string - 'global - (selected-device) - t) - "grey75")) - (buffer (get-buffer-create " *floating-toolbar-buffer*")) - (frame nil)) - (set-buffer buffer) - (set-buffer-menubar nil) - (if floating-toolbar-help-font - (progn (set-buffer (window-buffer (minibuffer-window))) - (set-buffer-menubar nil))) - (setq frame (make-frame (list - '(initially-unmapped . t) - ;; try to evade frame decorations - (cons 'name (or floating-toolbar-frame-name - "xclock")) - '(border-width . 2) - (cons 'border-color bg-color) - (cons 'top y) - (cons 'left x) - (cons 'popup - (floating-toolbar-make-junk-frame)) - (if floating-toolbar-help-font - '(minibuffer . only) - '(minibuffer . nil)) - '(width . 3) - '(height . 1)))) - (set-specifier text-cursor-visible-p (cons frame nil)) - (if floating-toolbar-help-font - (set-face-font 'default floating-toolbar-help-font frame) - (set-face-font 'default "nil2" frame)) - (set-face-background 'default bg-color frame) - (set-face-background 'modeline bg-color frame) - (set-specifier modeline-shadow-thickness (cons frame 1)) - (set-specifier has-modeline-p (cons frame nil)) - (set-face-background-pixmap 'default "" frame) - (set-window-buffer (frame-selected-window frame) buffer) - (set-specifier top-toolbar-height (cons frame 0)) - (set-specifier left-toolbar-width (cons frame 0)) - (set-specifier right-toolbar-width (cons frame 0)) - (set-specifier bottom-toolbar-height (cons frame 0)) - (set-specifier top-toolbar (cons frame nil)) - (set-specifier left-toolbar (cons frame nil)) - (set-specifier right-toolbar (cons frame nil)) - (set-specifier bottom-toolbar (cons frame nil)) - (set-specifier scrollbar-width (cons frame 0)) - (set-specifier scrollbar-height (cons frame 0)) - frame ))) - -;; first popup should be faster if we go ahead and make the frame now. -(or (not (featurep 'toolbar)) - floating-toolbar-frame - (not (eq (device-type) 'x)) - (setq floating-toolbar-frame (floating-toolbar-make-toolbar-frame 0 0))) - -;;; floating-toolbar.el ends here diff --git a/xemacs-packages/lisp/edit-utils/flow-ctrl.el b/xemacs-packages/lisp/edit-utils/flow-ctrl.el deleted file mode 100644 index 787c3c88..00000000 --- a/xemacs-packages/lisp/edit-utils/flow-ctrl.el +++ /dev/null @@ -1,120 +0,0 @@ -;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control - -;;; Copyright (C) 1990, 1991, 1994 Free Software Foundation, Inc. - -;; Author Kevin Gallagher -;; Maintainer: FSF -;; Adapted-By: ESR -;; Keywords: hardware - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: FSF 19.34. - -;;; Commentary: - -;; Terminals that use XON/XOFF flow control can cause problems with -;; GNU Emacs users. This file contains Emacs Lisp code that makes it -;; easy for a user to deal with this problem, when using such a -;; terminal. -;; -;; To invoke these adjustments, a user need only invoke the function -;; enable-flow-control-on with a list of terminal types in his/her own -;; .emacs file. As arguments, give it the names of one or more terminal -;; types in use by that user which require flow control adjustments. -;; Here's an example: -;; -;; (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") - -;; Portability note: This uses (getenv "TERM"), and therefore probably -;; won't work outside of UNIX-like environments. - -;;; Code: - -(defvar flow-control-c-s-replacement ?\034 - "Character that replaces C-s, when flow control handling is enabled.") -(defvar flow-control-c-q-replacement ?\036 - "Character that replaces C-q, when flow control handling is enabled.") - -;(put 'keyboard-translate-table 'char-table-extra-slots 0) - -;;;###autoload -(defun enable-flow-control (&optional argument) - "Toggle flow control handling. -When handling is enabled, user can type C-s as C-\\, and C-q as C-^. -With arg, enable flow control mode if arg is positive, otherwise disable." - (interactive "P") - (if (if argument - ;; Argument means enable if arg is positive. - (<= (prefix-numeric-value argument) 0) - ;; No arg means toggle. - (nth 1 (current-input-mode))) - (progn - ;; Turn flow control off, and stop exchanging chars. - (set-input-mode t nil (nth 2 (current-input-mode))) - ;; XEmacs - (keyboard-translate flow-control-c-s-replacement nil) - (keyboard-translate ?\^s nil) - (keyboard-translate flow-control-c-q-replacement nil) - (keyboard-translate ?\^q nil)) - ;; Turn flow control on. - ;; Tell emacs to pass C-s and C-q to OS. - (set-input-mode nil t (nth 2 (current-input-mode))) - ;; Initialize translate table, saving previous mappings, if any. - ;; Swap C-s and C-\ - ;; XEmacs - (keyboard-translate flow-control-c-s-replacement ?\^s) - (keyboard-translate ?\^s flow-control-c-s-replacement) - ;; Swap C-q and C-^ - (keyboard-translate flow-control-c-q-replacement ?\^q) - (keyboard-translate ?\^q flow-control-c-q-replacement) - (message (concat - "XON/XOFF adjustment for " - (getenv "TERM") - ": use C-\\ for C-s and use C-^ for C-q.")) - (sleep-for 2))) ; Give user a chance to see message. - -;;;###autoload -(defun enable-flow-control-on (&rest losing-terminal-types) - "Enable flow control if using one of a specified set of terminal types. -Use `(enable-flow-control-on \"vt100\" \"h19\")' to enable flow control -on VT-100 and H19 terminals. When flow control is enabled, -you must type C-\\ to get the effect of a C-s, and type C-^ -to get the effect of a C-q. - -This function has no effect unless the current device is a tty. - -The tty terminal type is determined from the TERM environment variable. -Trailing hyphens and everything following is stripped, so a TERM -value of \"vt100-nam\" is treated the same as \"vt100\"." - (let ((term (getenv "TERM")) - hyphend) - ;; Look for TERM in LOSING-TERMINAL-TYPES. - ;; If we don't find it literally, try stripping off words - ;; from the end, one by one. - (while (and term (not (member term losing-terminal-types))) - ;; Strip off last hyphen and what follows, then try again. - (if (setq hyphend (string-match "[-_][^-_]+$" term)) - (setq term (substring term 0 hyphend)) - (setq term nil))) - (if term - (enable-flow-control)))) - -(provide 'flow-ctrl) - -;;; flow-ctrl.el ends here diff --git a/xemacs-packages/lisp/edit-utils/foldout.el b/xemacs-packages/lisp/edit-utils/foldout.el deleted file mode 100644 index 0f0e8fa1..00000000 --- a/xemacs-packages/lisp/edit-utils/foldout.el +++ /dev/null @@ -1,581 +0,0 @@ -;;; foldout.el --- Folding extensions for outline-mode and outline-minor-mode. - -;; Copyright (C) 1994 Free Software Foundation, Inc. - -;; Author: Kevin Broadey -;; Created: 27 Jan 1994 -;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12 -;; Keywords: folding, outlines - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: FSF 20.6. - -;;; Commentary: - -;; This file provides folding editor extensions for outline-mode and -;; outline-minor-mode buffers. What's a "folding editor"? Read on... -;; -;; Imagine you're in an outline-mode buffer and you've hidden all the text and -;; subheadings under your level-1 headings. You now want to look at the stuff -;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry) -;; to expose the body or C-c C-i to expose the child (level-2) headings. -;; -;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body -;; and child subheadings and narrows the buffer so that only the level-1 -;; heading, the body and the level-2 headings are visible. If you now want to -;; look under one of the level-2 headings, position the cursor on it and do C-c -;; C-z again. This exposes the level-2 body and its level-3 child subheadings -;; and narrows the buffer again. You can keep on zooming in on successive -;; subheadings as much as you like. A string in the modeline tells you how -;; deep you've gone. -;; -;; When zooming in on a heading you might only want to see the child -;; subheadings. You do this by specifying a numeric argument: C-u C-c C-z. -;; You can specify the number of levels of children too (c.f. show-children): -;; e.g. M-2 C-c C-z exposes two levels of child subheadings. Alternatively, -;; you might only be interested in the body. You do this by specifying a -;; negative argument: M-- C-c C-z. You can also cause the whole subtree to be -;; expanded, similar to C-c C-s (show-subtree), by specifying a zero argument: -;; M-0 C-c C-z. -;; -;; While you're zoomed in you can still use outline-mode's exposure and hiding -;; functions. It won't upset foldout at all. Also, since the buffer is -;; narrowed, "global" editing actions will only affect the stuff under the -;; zoomed-in heading. This is useful for restricting changes to a particular -;; chapter or section of your document. -;; -;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides -;; all the text and subheadings under the top-level heading and returns you to -;; the previous view of the buffer. Specifying a numeric argument exits that -;; many folds. Specifying a zero argument exits *all* folds. -;; -;; You might want to exit a fold *without* hiding the text and subheadings. -;; You do this by specifying a negative argument. For example, M--2 C-c C-x -;; exits two folds and leaves the text and subheadings exposed. -;; -;; Foldout also provides mouse bindings for entering and exiting folds and for -;; showing and hiding text. Hold down Meta and Control, then click a mouse -;; button as follows:- -;; -;; mouse-1 (foldout-mouse-zoom) zooms in on the heading clicked on:- -;; -;; single click expose body -;; double click expose subheadings -;; triple click expose body and subheadings -;; quad click expose entire subtree -;; -;; mouse-2 (foldout-mouse-show) exposes text under the heading clicked on:- -;; -;; single click expose body -;; double click expose subheadings -;; triple click expose body and subheadings -;; quad click expose entire subtree -;; -;; mouse-3 (foldout-mouse-hide-or-exit) hides text under the heading clicked -;; on or exits the fold:- -;; -;; single click hide subtree -;; double click exit fold and hide text -;; triple click exit fold without hiding text -;; quad click exit all folds and hide text -;; -;; You can change the modifier keys used by setting `foldout-mouse-modifiers'. - -;;; Installation: - -;; To use foldout, put this in your .emacs:- -;; -;; (require 'foldout) -;; -;; If you don't want it loaded until you need it, try this instead:- -;; -;; (eval-after-load "outline" '(require 'foldout)) - -;;; Advertisements: - -;; Get out-xtra.el by Per Abrahamsen for more -;; outline-mode goodies. In particular, `outline-hide-sublevels' makes -;; setup a lot easier. -;; -;; folding.el by Jamie Lokier supports folding by -;; recognising special marker text in you file. -;; -;; c-outline.el (by me) provides outline-mode support to recognise `C' -;; statements as outline headings, so with foldout you can have a folding `C' -;; code editor without having to put in start- and end-of-fold markers. This -;; is a real winner! - -;;; ChangeLog: - -;; 1.10 21-Mar-94 -;; foldout.el is now part of the GNU Emacs distribution!! -;; Put in changes made by RMS to version 1.8 to keep the diffs to a minimum. -;; bugfix: numeric arg to foldout-exit-fold wasn't working - looks like I don't -;; know how to use the Common LISP `loop' macro after all, so use `while' -;; instead. - -;; 1.9 15-Mar-94 -;; Didn't test that very well, did I? The change to foldout-zoom-subtree -;; affected foldout-mouse-zoom: if the heading under the `level n' one clicked -;; on was at `level n+2' then it didn't get exposed. Sorry about that! - -;; 1.8 15-Mar-94 -;; Changed meaning of prefix arg to foldout-zoom-subtree. arg > 0 now means -;; "expose that many children" instead of just "expose children" so it is more -;; like `show-children' (C-c C-i). Arg of C-u on its own only shows one level -;; of children, though, so you can still zoom by doing C-u C-c C-z. -;; -;; I can't think of a good meaning for the value of a negative prefix. Any -;; suggestions? -;; -;; Added advertisement for my c-outline.el package. Now you can have a folding -;; editor for c-mode without any effort! - -;; 1.7 7-Mar-94 -;; I got fed up trying to work out how many blank lines there were outside the -;; narrowed region when inside a fold. Now *all* newlines before the following -;; heading are *in* the narrowed region. Thus, if the cursor is at point-max, -;; the number of blank lines above it is the number you'll get above the next -;; heading. -;; -;; Since all newlines are now inside the narrowed region, when exiting a fold -;; add a newline at the end of the region if there isn't one so that the -;; following heading doesn't accidentally get joined to the body text. -;; -;; Bugfix: `foldout-mouse-modifiers' should be `defvar', not `defconst'. -;; -;; Use "cond" instead of "case" so that lemacs-19.9 users can use the mouse. -;; -;; Improve "Commentary" entry on using the mouse. -;; -;; Add "Installation" keyword. - -;; 1.6 3-Mar-94 -;; Add mouse support functions foldout-mouse-zoom, foldout-mouse-show, -;; foldout-mouse-hide-or-exit. - -;; 1.5 11-Feb-94 -;; Rename `foldout-enter-subtree' to `foldout-zoom-subtree' and change -;; keystroke from C-g to C-z. This is more mnemonic and leaves C-g alone, as -;; users expect this to cancel the current key sequence. -;; -;; Added better commentary at the request of RMS. Added stuff to comply with -;; the lisp-mnt.el conventions. Added instructions on how best to load the -;; package. - -;; 1.4 2-Feb-94 -;; Bugfix: end-of-fold marking was wrong:- -;; -;; End of narrowed region should be one character on from -;; (outline-end-of-subtree) so it includes the end-of-line at the end of the -;; last line of the subtree. -;; -;; End-of-fold marker should be outside the narrowed region so text inserted -;; at the end of the region goes before the marker. Need to make a special -;; case for end-of-buffer because it is impossible to set a marker that will -;; follow eob. Bummer. - -;; 1.3 28-Jan-94 -;; Changed `foldout-zoom-subtree'. A zero arg now makes it expose the entire -;; subtree on entering the fold. As before, < 0 shows only the body and > 0 -;; shows only the subheadings. - -;; 1.2 28-Jan-94 -;; Fixed a dumb bug - didn't make `foldout-modeline-string' buffer-local :-( -;; -;; Changed `foldout-exit-fold' to use prefix arg to say how many folds to exit. -;; Negative arg means exit but don't hide text. Zero arg means exit all folds. -;; -;; Added `foldout-inhibit-key-bindings' to inhibit key bindings. - -;; 1.1 27-Jan-94 -;; Released to the net. Inspired by a question in gnu.emacs.help from -;; Jason D Lohn . - -;;; Code: - -(require 'outline) - -;; something has gone very wrong if outline-minor-mode isn't bound now. -(if (not (boundp 'outline-minor-mode)) - (error "Can't find outline-minor-mode")) - -(defconst foldout-fold-list nil - "List of start and end markers for the folds currently entered. -An end marker of NIL means the fold ends after (point-max).") -(make-variable-buffer-local 'foldout-fold-list) - -(defconst foldout-modeline-string nil - "Modeline string announcing that we are in an outline fold.") -(make-variable-buffer-local 'foldout-modeline-string) - -;; put our minor mode string immediately following outline-minor-mode's -(or (assq 'foldout-modeline-string minor-mode-alist) - (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist) - minor-mode-alist)) - (foldout-entry '((foldout-modeline-string foldout-modeline-string)))) - - ;; something's wrong with outline if we can't find it - (if (null outl-entry) - (error "Can't find outline-minor-mode in minor-mode-alist")) - - ;; slip our fold announcement into the list - (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) - )) - -;; outline-flag-region has different `flag' values in outline.el and -;; noutline.el for hiding and showing text. - -(defconst foldout-hide-flag - (if (featurep 'noutline) t ?\^M)) - -(defconst foldout-show-flag - (if (featurep 'noutline) nil ?\n)) - - -(defun foldout-zoom-subtree (&optional exposure) - "Open the subtree under the current heading and narrow to it. - -Normally the body and the immediate subheadings are exposed, but -optional arg EXPOSURE \(interactively with prefix arg\) changes this:- - - EXPOSURE > 0 exposes n levels of subheadings (c.f. show-children) - EXPOSURE < 0 exposes only the body - EXPOSURE = 0 exposes the entire subtree" - (interactive "P") - (save-excursion - (widen) - (outline-back-to-heading) - (let* ((exposure-value (prefix-numeric-value exposure)) - (start (point)) - (start-marker (point-marker)) - (end (progn (outline-end-of-subtree) - (skip-chars-forward "\n\^M") - (point))) - ;; I need a marker that will follow the end of the region even when - ;; text is inserted right at the end. Text gets inserted *after* - ;; markers, so I need it at end+1. Unfortunately I can't set a - ;; marker at (point-max)+1, so I use NIL to mean the region ends at - ;; (point-max). - (end-marker (if (eobp) nil (set-marker (make-marker) (1+ end)))) - ) - - ;; narrow to this subtree - (narrow-to-region start end) - - ;; show the body and/or subheadings for this heading - (goto-char start) - (cond - ((null exposure) - (show-entry) - (show-children)) - ((< exposure-value 0) - (show-entry)) - ((consp exposure) - (show-children)) - ((> exposure-value 0) - (show-children exposure-value)) - (t - (show-subtree)) - ) - - ;; save the location of the fold we are entering - (setq foldout-fold-list (cons (cons start-marker end-marker) - foldout-fold-list)) - - ;; update the modeline - (foldout-update-modeline) - ))) - - -(defun foldout-exit-fold (&optional num-folds) - "Return to the ARG'th enclosing fold view. With ARG = 0 exit all folds. - -Normally causes exited folds to be hidden, but with ARG < 0, -ARG folds are -exited and text is left visible." - (interactive "p") - (let (start-marker end-marker (hide-fold t)) - - ;; check there are some folds to leave - (if (null foldout-fold-list) - (error "Not in a fold!")) - - (cond - ;; catch a request to leave all folds - ((zerop num-folds) - (setq num-folds (length foldout-fold-list))) - - ;; have we been told not to hide the fold? - ((< num-folds 0) - (setq hide-fold nil - num-folds (- num-folds))) - ) - - ;; limit the number of folds if we've been told to exit too many - (setq num-folds (min num-folds (length foldout-fold-list))) - - ;; exit the folds - (widen) - (while (not (zerop num-folds)) - ;; get the fold at the top of the stack - (setq start-marker (car (car foldout-fold-list)) - end-marker (cdr (car foldout-fold-list)) - foldout-fold-list (cdr foldout-fold-list) - num-folds (1- num-folds)) - - ;; Make sure there is a newline at the end of this fold, - ;; otherwise the following heading will get joined to the body - ;; text. - (if end-marker - (progn - (goto-char end-marker) - (forward-char -1) - (or (memq (preceding-char) '(?\n ?\^M)) - (insert ?\n)))) - - ;; If this is the last fold to exit, hide the text unless we've - ;; been told not to. Note that at the moment point is at the - ;; beginning of the following heading if there is one. - - ;; Also, make sure that the newline before the following heading - ;; is \n otherwise it will be hidden. If there is a newline - ;; before this one, make it visible too so we do the same as - ;; outline.el and leave a blank line before the heading. - (if (zerop num-folds) - (let ((beginning-of-heading (point)) - (end-of-subtree (if end-marker - (progn - (forward-char -1) - (if (memq (preceding-char) - '(?\n ?\^M)) - (forward-char -1)) - (point)) - (point-max)))) - ;; hide the subtree - (if hide-fold - (outline-flag-region start-marker end-of-subtree - foldout-hide-flag)) - - ;; make sure the next heading is exposed - (if end-marker - (outline-flag-region end-of-subtree beginning-of-heading - foldout-show-flag)) - )) - - ;; zap the markers so they don't slow down editing - (set-marker start-marker nil) - (if end-marker (set-marker end-marker nil)) - ) - - ;; narrow to the enclosing fold if there is one - (if foldout-fold-list - (progn - (setq start-marker (car (car foldout-fold-list)) - end-marker (cdr (car foldout-fold-list))) - (narrow-to-region start-marker - (if end-marker - (1- (marker-position end-marker)) - (point-max))) - )) - (recenter) - - ;; update the modeline - (foldout-update-modeline) - )) - - -(defun foldout-update-modeline () - "Set the modeline string to indicate our fold depth." - (let ((depth (length foldout-fold-list))) - (setq foldout-modeline-string - (cond - ;; if we're not in a fold, keep quiet - ((zerop depth) - nil) - ;; in outline-minor-mode we're after "Outl:xx" in the modeline - (outline-minor-mode - (format ":%d" depth)) - ;; otherwise just announce the depth (I guess we're in outline-mode) - ((= depth 1) - " Inside 1 fold") - (t - (format " Inside %d folds" depth)) - )))) - - -;; XEmacs change. -(defun foldout-mouse-zoom (event click-count) - "Zoom in on the heading clicked on. - -How much is exposed by the zoom depends on the number of mouse clicks:- - - 1 expose body - 2 expose subheadings - 3 expose body and subheadings - 4 expose entire subtree" - (interactive "@e\np") - - ;; swallow intervening mouse events so we only get the final click-count. -;; (setq event (foldout-mouse-swallow-events event)) - - ;; go to the heading clicked on - (foldout-mouse-goto-heading event) - - ;; zoom away - (foldout-zoom-subtree - (cond - ((= click-count 1) -1) ; body only - ((= click-count 2) '(1)) ; subheadings only - ((= click-count 3) nil) ; body and subheadings - (t 0)))) ; entire subtree - -(defun foldout-mouse-show (event click-count) - "Show what is hidden under the heading clicked on. - -What gets exposed depends on the number of mouse clicks:- - - 1 expose body - 2 expose subheadings - 3 expose body and subheadings - 4 expose entire subtree" - (interactive "@e\np") - - ;; swallow intervening mouse events so we only get the final click-count. -;; (setq event (foldout-mouse-swallow-events event)) - - ;; expose the text - (foldout-mouse-goto-heading event) - (cond - ((= click-count 1) (show-entry)) - ((= click-count 2) (show-children)) - ((= click-count 3) (show-entry) (show-children)) - (t (show-subtree)))) - -(defun foldout-mouse-hide-or-exit (event click-count) - "Hide the subtree under the heading clicked on, or exit a fold. - -What happens depends on the number of mouse clicks:- - - 1 hide subtree - 2 exit fold and hide text - 3 exit fold without hiding text - 4 exit all folds and hide text" - (interactive "@e\np") - - ;; swallow intervening mouse events so we only get the final click-count. -;; (setq event (foldout-mouse-swallow-events event)) - - ;; hide or exit - (if (= click-count 1) - (progn - (foldout-mouse-goto-heading event) - (hide-subtree)) - (foldout-exit-fold - (cond - ((= click-count 2) 1) ; exit and hide - ((= click-count 3) -1) ; exit don't hide - (t 0))))) ; exit all - - -;; XEmacs change. -;;(defun foldout-mouse-swallow-events (event) -;; "Swallow intervening mouse events so we only get the final click-count. -;;Signal an error if the final event isn't the same type as the first one." -;; (let ((initial-event-type (event-basic-type event))) -;; (while (null (sit-for 0 double-click-time 'nodisplay)) -;; (setq event (read-event))) -;; (or (eq initial-event-type (event-basic-type event)) -;; (error ""))) -;; event) - -(defun foldout-mouse-goto-heading (event) - "Go to the heading where the mouse event started. Signal an error -if the event didn't occur on a heading." - ;; XEmacs change. - (goto-char (event-point event)) - (or (outline-on-heading-p) - ;; outline.el sometimes treats beginning-of-buffer as a heading - ;; even though outline-on-heading returns nil. - (save-excursion (beginning-of-line) (bobp)) - (error "Not a heading line"))) - - -;;; Keymaps: - -(defvar foldout-inhibit-key-bindings nil - "Set non-NIL before loading foldout to inhibit key bindings.") - -(defvar foldout-mouse-modifiers '(meta control) - "List of modifier keys to apply to foldout's mouse events. - -The default (meta control) makes foldout bind its functions to -(meta control button{1,2,3}). - -Valid modifiers are shift, control, meta, alt, hyper and super.") - -;; XEmacs change. -(defun foldout-mouse-track-click-hook (event click-count) - (if (and (memq click-count '(1 2 3 4)) - (eq (event-modifier-bits - (make-event 'button-release - `(button 1 modifiers ,foldout-mouse-modifiers))) - (event-modifier-bits event))) - (let ((button (event-button event))) - (cond ((eq button 1) - (funcall 'foldout-mouse-zoom event click-count)) - ((eq button 2) - (funcall 'foldout-mouse-show event click-count)) - ((eq button 3) - (funcall 'foldout-mouse-hide-or-exit event click-count)))))) - -(if foldout-inhibit-key-bindings - () - (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) - (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold) - (define-key outline-minor-mode-map - (concat outline-minor-mode-prefix "\C-z") 'foldout-zoom-subtree) - (define-key outline-minor-mode-map - (concat outline-minor-mode-prefix "\C-x") 'foldout-exit-fold) - - (add-hook 'outline-mode-hook - (lambda () - (add-hook 'mouse-track-click-hook - 'foldout-mouse-track-click-hook))) - (add-hook 'outline-minor-mode-hook - (lambda () - (add-hook 'mouse-track-click-hook - 'foldout-mouse-track-click-hook))) - ;; XEmacs change - (let ((mouse-1 (vector (append foldout-mouse-modifiers '(button1)))) - (mouse-2 (vector (append foldout-mouse-modifiers '(button2)))) - (mouse-3 (vector (append foldout-mouse-modifiers '(button3))))) - - (define-key outline-mode-map mouse-1 'mouse-track) - (define-key outline-mode-map mouse-2 'mouse-track) - (define-key outline-mode-map mouse-3 'mouse-track) - - (define-key outline-minor-mode-map mouse-1 'mouse-track) - (define-key outline-minor-mode-map mouse-2 'mouse-track) - (define-key outline-minor-mode-map mouse-3 'mouse-track) - )) - -(provide 'foldout) - -;;; foldout.el ends here - diff --git a/xemacs-packages/lisp/edit-utils/func-menu.el b/xemacs-packages/lisp/edit-utils/func-menu.el deleted file mode 100644 index 34a2d1cb..00000000 --- a/xemacs-packages/lisp/edit-utils/func-menu.el +++ /dev/null @@ -1,2757 +0,0 @@ -;;; func-menu.el --- Jump to a function within a buffer. - -;; Author: David Hughes -;; Maintainer: The XEmacs Development Team -;; Version: 2.66 -;; Keywords: tools, c, lisp - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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. - -;;; Synched up with: Not in FSF. - -;;; Commentary: - -;; Installation: -;; ============= -;; (add-hook 'find-file-hooks 'fume-setup-buffer) -;; (add-hook 'Manual-mode-hook 'turn-on-fume-mode) -;; -;; #### NOTE: if you've been using func-menu the old way (before fume-mode was -;; written), please note that `mouse-function-menu' is bound to M-Button3 -;; (not Shift-Button3) in this mode. Nothing prevents you from keeping your -;; old binding though. -;; -;; -;; Description: -;; ============ -;; Suppose you have a file with a lot of functions in it. Well, this package -;; makes it easy to jump to any of those functions. The names of the -;; functions in the current buffer are automatically put into a menubar menu, -;; you select one of the function-names and the point is moved to that very -;; function. The mark is pushed on the mark-ring, so you can easily go back -;; to where you were. Alternatively, you can use enter the name of the -;; desired function via the minibuffer which offers completing read input. In -;; addition, the name of the function before point is optionally displayed in -;; the modeline. -;; -;; Support for non X Window versions of Emacs: -;; =========================================== -;; This package can also be used for non X versions of Emacs. In this case, -;; only modeline display and completing read input from the minibuffer are -;; possible. -;; -;; Modes supported: -;; ================ -;; Ada, Assembly, BibTex, C++, C, Dired, Ehdm, ELisp, FORTRAN, Ksh, Latex, -;; Lelisp, Makefile, Maple, Modula2, Modula3, Outline, Objective-C, Pascal, -;; Perl, Postscript, Prolog, PVS, Python, SGML, Scheme, Tcl, Verilog, -;; Manual, Ruby, JavaScript -;; -;; Acknowledgements: -;; ================= -;; -;; Manual mode support -;; fume-goto-\(next|previous\)-function functions -;; func-menu minor mode -;; Didier Verna -;; -;; Protect integer concatenation with int-to-string -;; Anthony Rossini -;; -;; Patch for jde-mode -;; Tony Lam -;; -;; Patches to FORTRAN support -;; Bruce Ravel -;; -;; Idea for fume-goto-function-hook -;; Mark Gates -;; -;; Patch for backward compatibility with backquote -;; Bill Dubuque -;; -;; Objective-C support -;; Guillaume Laurent -;; -;; Fix to fume-function-name-regexp-c -;; Jonathan Edwards -;; -;; Speedup for fume-cc-inside-comment -;; Peter Pezaris -;; -;; Made menu placement more flexible and rewrote doc strings -;; Bob Weiner -;; -;; Fortran90 regexp -;; John Turner -;; -;; Patch to error trap in fume-rescan-buffer -;; Andy Piper -;; -;; Java support -;; Bob Weiner -;; Heddy Boubaker -;; -;; Patch for fume-rescan-buffer{-trigger} -;; Christoph Wedler -;; -;; Patch for fume-tickle-f-to-b -;; Michael Sperber -;; -;; Cleanup suggestions -;; Jonathan Stigelman -;; -;; Idea for jumping directly with a mouse click -;; Marc Paquette -;; -;; Prolog mode additions based on functions for Postscript mode -;; Laszlo Teleki -;; -;; Idea for displaying function name in modeline -;; Paul Filipski -;; -;; Fame mode support -;; Cooper Vertz -;; -;; Made fume-match-find-next-function-name iterative, not recursive, to avoid -;; blowing out the emacs stack on big files with lots of prototypes. -;; Joe Marshall -;; -;; Verilog support -;; Matt Sale -;; -;; Minibuffer interface & Pascal support -;; Espen Skoglund -;; -;; Python support -;; Shuichi Koga -;; -;; JavaScript support -;; Ville Skyttä -;; -;; Maple support -;; Luc Tancredi -;; -;; Combined Tcl and C++ function finder -;; Andy Piper -;; -;; Perl Support -;; Alex Rezinsky -;; Michael Lamoureux -;; -;; Ruby Support -;; Stefan Kamphausen -;; Albert Davidson Chou -;; Claus Brunzema -;; -;; Suggested mouse interface -;; Raymond L. Toy -;; -;; Dired support -;; Improved modula support -;; Numerous code cleanups -;; Norbert Kiesel -;; -;; Makefile support -;; Suggested multi-choice sublisting -;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com> -;; -;; Suggestions for menubar entry -;; Andy Piper -;; -;; Ada support -;; Scott Evans -;; Mike Konerman -;; Michael Polo -;; -;; Scheme, BibTeX, Ehdm & PVS support -;; C. Michael Holloway -;; -;; Modula support -;; Geoffrey Wyant -;; -;; SGML support; submenu indexing -;; Thomas Plass -;; -;; Extensions to fume-function-name-regexp-lisp -;; Vladimir Alexiev -;; Kari Heinola -;; Milo A. Chan -;; Jack Repenning -;; Cedric Beust -;; Joachim Krumnow -;; -;; ksh support -;; Philippe Bondono -;; -;; FORTRAN support -;; Paul Emsley -;; Raymond L. Toy -;; Richard Cognot -;; Greg Sjaardema -;; -;; Latex support -;; Wolfgang Mettbach -;; Paolo Frasconi -;; C. Michael Holloway -;; Philippe Queinnec -;; -;; Assembly support -;; Bob Weiner -;; -;; Removal of cl dependencies -;; Russell Ritchie -;; -;; C++ mode enhancemencements for func-menu -;; Andy Piper -;; Kevin R. Powell -;; Mats Lidell -;; Mike Battaglia -;; Oliver Schittko -;; Tom Murray -;; Russell Ritchie -;; -;; Tcl mode additions for func-menu -;; Andy Piper -;; Jean-Michel Augusto -;; Dr P.G. Sjoerdsma -;; -;; Postscript mode additions for func-menu -;; Leigh Klotz -;; -;; Suggestions for popup menu positioning -;; Marc Gemis -;; -;; Original FSF package -;; Ake Stenhoff - -;;; Code: - -(defmacro fume-bomb-proof (&rest forms) - (` (condition-case () (progn (,@ forms)) (t nil)))) - -(eval-when-compile - (byte-compiler-options - (optimize t) - (warnings (- free-vars unresolved))) - ;; For older XEmacs, Win-Emacs - (cond ((not (fume-bomb-proof (require 'custom))) - (defmacro defgroup (sym def description &rest args) - (` (defvar (, sym) (, def) (, description)))) - (defmacro defcustom (sym def description &rest args) - (` (defvar (, sym) (, def) (, description))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;; Environment Initialisation ;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst fume-version "2.66") - -(defconst fume-developer - "The XEmacs Development Team ") - -(defun fume-about () - (interactive) - (sit-for 0) - (display-message - 'no-log - (format "Func-Menu version %s" fume-version))) - -(defconst fume-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) - -(defmacro fume-defvar-local (var value &optional doc) - "Defines VAR as an advertised variable. -Performs a defvar, then executes `make-variable-buffer-local' on -the variable. Also sets the `permanent-local' property, so that -`kill-all-local-variables' (called by major-mode setting commands) -won't destroy func-menu control variables." - (` (progn - (if (, doc) - (defvar (, var) (, value) (, doc)) - (defvar (, var) (, value))) - (make-variable-buffer-local '(, var)) - (put '(, var) 'permanent-local t)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;; Backward compatibility hacks for older versions of XEmacs ;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(or (fboundp 'display-message) - (defun display-message (msgtype msg) (message msg))) - -(or (fboundp 'defalias) - ;; poor man's defalias - (defun defalias (sym newdef) - "Set SYMBOL's function definition to NEWVAL, and return NEWVAL. -Associates the function with the current load file, if any." - (fset sym (symbol-function newdef)))) - -(or (fboundp 'selected-frame) - (defalias 'selected-frame 'selected-screen)) - -(if (fboundp 'locate-window-from-coordinates) - ;; Older versions of XEmacs need a more robust version of 'event-window' - (defun fume-event-window (event) - (or (event-window event) - (locate-window-from-coordinates - (selected-frame) (list (event-x event) (event-y event))) - (locate-window-from-coordinates - (selected-frame) (list (event-x event) (1- (event-y event)))))) - ;; In post 19.11 versions of XEmacs 'event-window' now works acceptably - (defalias 'fume-event-window 'event-window)) - -(or (fboundp 'shrink-window-if-larger-than-buffer) - ;; Win-Emacs doesn't have this - (defun shrink-window-if-larger-than-buffer (&optional window reqd-height) - "Shrink WINDOW to the smallest no of lines needed to display its buffer, -or to optional REQUIRED-HEIGHT if and only if that is larger. Does nothing if -the buffer contains more lines than the present window height." - (interactive) - (let* ((OriginalWindow (selected-window)) - (TargetWindow (select-window (or window OriginalWindow)))) - (or (one-window-p t) - (and reqd-height (>= reqd-height (window-height))) - (< (window-height) (1+ (count-lines (point-min) (point-max)))) - (let ((calc-reqd-height - (if truncate-lines - (1+ (count-lines (point-min) (point-max))) - (save-excursion - (let ((count 0) - linew - (windw (window-width))) - (goto-char (point-min)) - (while (not (eobp)) - (setq linew (1+ (progn (end-of-line) - (current-column))) - count (+ count - (/ linew windw) - (min (% linew windw) 1))) - (beginning-of-line 2)) - count))))) - (setq reqd-height (1+ (max calc-reqd-height - (1- window-min-height) - (or reqd-height 0)))) - (if (> (window-height) reqd-height) - (let* (wc spare bonus share wins shrunkwins) - (walk-windows - '(lambda (w) - (select-window w) - (if (or (eq w TargetWindow) - (> (1+ (count-lines (point-min) (point-max))) - (1- (window-height w)))) - (setq wins (cons w wins)) - (if (= (1+ (count-lines (point-min) (point-max))) - (1- (window-height w))) - (setq shrunkwins (cons w shrunkwins))))) - 'nomini) - (setq wc (1- (length wins)) - spare (- (window-height TargetWindow) reqd-height) - share (if (> wc 0) (/ spare wc)) - bonus (if (> wc 0) (% spare wc)) - shrunkwins (if (zerop wc) nil shrunkwins) - wins (mapcar (function - (lambda (w) - (cons w (list - (if (eq w TargetWindow) - reqd-height - (+ (window-height w) - share - (if (zerop bonus) - 0 - (setq bonus - (1- bonus)) - 1))) - (window-start w))))) - wins)) - (let (ok (trys 2)) - (while (and (not ok) (> trys 0)) - (setq trys (1- trys)) - (mapcar - (function - (lambda (info) - (select-window (car info)) - (enlarge-window - (- (car (cdr info)) (window-height))))) - wins) - (setq ok t) - (mapcar - (function - (lambda (info) - (setq ok - (and ok - (<= (abs (- (car (cdr info)) - (window-height - (car info)))) - 1))))) - wins))) - (mapcar - (function - (lambda (info) - (select-window (car info)) - (if (eq (car info) TargetWindow) - (shrink-window - (- (window-height TargetWindow) reqd-height))) - (set-window-start (car info) (car (cdr (cdr info)))))) - wins) - (mapcar - (function - (lambda (w) - (select-window w) - (if (< (1+ (count-lines (point-min) (point-max))) - (1- (window-height w))) - (shrink-window-if-larger-than-buffer)))) - shrunkwins))))) - (select-window OriginalWindow)))) - -(defconst fume-modeline-buffer-identification - (if (boundp 'modeline-buffer-identification) - 'modeline-buffer-identification - 'mode-line-buffer-identification)) - -(defconst fume-use-local-post-command-hook - (boundp 'local-post-command-hook)) - -(cond ((fboundp 'add-submenu) - (defconst fume-add-submenu 'add-submenu) - (defun fume-munge-menu-args (menu-name submenu before) - (list fume-menu-path (cons menu-name submenu) before))) - (t - (defconst fume-add-submenu 'add-menu) - (defun fume-munge-menu-args (menu-name submenu before) - (list fume-menu-path menu-name submenu before)))) - -(defun fume-add-submenu (menu-name submenu before) - (apply fume-add-submenu (fume-munge-menu-args menu-name submenu before))) - -(defconst fume-not-tty - (or (and (fboundp 'device-type) (not (eq 'tty (device-type)))) - (and (symbol-value 'window-system) t))) ; obsolete test - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;; Customizable Variables ;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup fume nil - "Jump to a function within a buffer." - :tag "Func Menu" - :group 'tools - :group 'c - :group 'lisp) - -(defcustom fume-auto-position-popup t - "*Setting of t (default) means popup the Function menu at the mouse cursor, -nil means at a window corner." - :type 'boolean - :group 'fume) - -(fume-defvar-local fume-display-in-modeline-p t - "*Setting of t (default) means display the function name in the modeline, -nil disables. -Non-nil, non-t setting replaces the normal `modeline-buffer-identification' -which is useful when the modeline display is already full. - -This is a buffer-local variable.") - -(defvar fume-buffer-name "*Function List*" - "Name of buffer used to list functions when `fume-list-functions' is called.") - -(defcustom fume-menubar-menu-name "Functions" - "*Name of the menubar menu which displays current buffer function definitions." - :type 'string - :group 'fume) - -;; Bob Weiner -(defvar fume-menu-path nil - "Path to the menubar menu under which the function menu should be installed. -Nil (default) means install it on the menubar itself. Otherwise, this should -be a list of strings, each of which names a successively deeper menu under -which the new menu should be located.") - -(defcustom fume-menubar-menu-location "Buffers" - "*Name of menu before which function menu should appear (default=\"Buffers\"). -Nil means display it after the last non-right-justified menubar item." - :type '(choice (const :tag "Last" nil) (string :format "%v")) - :group 'fume) - -(defcustom fume-max-items 24 - "*Maximum number of elements in a function menu or submenu (default = 24)." - :type 'integer - :group 'fume) - -(defcustom fume-fn-window-position 3 - "*Number of lines from top of window at which to show a function (default = 3) -If nil, display function start from the centre of the window." - :type '(choice (const :tag "Center" nil) integer) - :group 'fume) - -(defcustom fume-index-method 3 - "*Set this to the method number you want used. - -Methods currently supported: -0 = if you want submenu names to be numbered -1 = if you want submenu range indicated by first character -2 = if you want submenu range indicated by first 12 characters -3 = if you want submenu range indicated by as many characters as needed" - :type '(radio (const :tag "Numbered" 0) - (const :tag "Indicated by first character" 1) - (const :tag "Indicated by first 12 characters" 2) - (const :tag "Indicated by as many characters as needed" 3)) - :group 'fume) - -(defcustom fume-scanning-message "Scanning buffer... (%3d%%)" - "*Message string format displayed during manual buffer function scans. -Nil means inhibit such messages." - :type '(choice (const :tag "None" nil) string) - :group 'fume) - -(defcustom fume-rescanning-message nil - "*Message string format displayed during automatic buffer function scans. -For example, \"Re-Scanning buffer...\". Nil (default) means inhibit such -messages." - :type '(choice (const :tag "None" nil) string) - :group 'fume) - -(defvar fume-rescan-trigger-counter-buffer-size 10000 - "Used to tune the frequency of automatic function scans of the buffer -(default = 10000). -The function `fume-rescan-buffer-trigger' executes only when the value of the -variable `fume-rescan-trigger-counter' reaches zero, whereupon it gets reset -to the maximum of a) buffer-size/`fume-rescan-trigger-counter-buffer-size' - or b) `fume-rescan-trigger-counter-min'.") - -(defvar fume-rescan-trigger-counter-min 50 - "Used to tune the frequency of automatic function scans of the buffer -(default = 50). -The function `fume-rescan-buffer-trigger' executes only when the value of the -variable `fume-rescan-trigger-counter' reaches zero, whereupon it gets reset -to the maximum of a) buffer-size/`fume-rescan-trigger-counter-buffer-size' - or b) `fume-rescan-trigger-counter-min'.") - -(fume-defvar-local - fume-sort-function 'fume-sort-by-name - "*The function used to sort the function menu entries -(default = fume-sort-by-name). -Nil means display in order of occurrence in the buffer; this is faster since -no sorting is done. - -The function should take two arguments and return t if the first -element should appear before the second. The arguments are cons cells: -\(NAME . POSITION). See `fume-sort-by-name' for an example.") - -(fume-defvar-local - fume-rescan-buffer-hook nil - "*Buffer local hook to call at the end of each buffer rescan.") - -;; This hook is provided for outl-mouse and must not be made buffer local as -;; this appears to break outl-mouse for some reason. -;; -(defvar fume-found-function-hook nil - "*Hook to call after every function match.") - -;; Idea for jumping directly with a mouse click -;; Marc Paquette -;; -(defvar fume-no-prompt-on-valid-default nil - "*Non-nil means `fume-prompt-function-goto' should jump to default function -definition without prompting. -Default value is nil.") - -;; Idea from Mark Gates -;; -(defvar fume-goto-function-hook nil - "*Function of with one argument (position) -called if `fume-fn-window-position' is nil or invalid. Default is nil.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;; Buffer local variables ;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(fume-defvar-local - fume-auto-rescan-buffer-p t - "Buffer local variable which if t (default) enables automatic buffer rescanning - -Usage: -By default, `fume-auto-rescan-buffer-p' is set to t. If a particular -major-mode slows down too much as a result of automatic rescanning -by func-menu, add something like the following: - - (defun remove-func-menu-auto-rescan () - (setq fume-auto-rescan-buffer-p nil)) - - (add-hook 'foo-mode-hook 'remove-func-menu-auto-rescan)") - -(fume-defvar-local - fume-funclist nil - "The latest list of function names in the buffer.") - -(fume-defvar-local - fume-function-marks - "The latest list of function positions in the buffer.") - -(fume-defvar-local - fume-function-name-regexp nil - "Regexp which matches names within function definitions. -These names are displayed in the function menu.") - -(fume-defvar-local - fume-find-next-function-name-method nil - "The function to use to find the next function name in the buffer.") - -(fume-defvar-local - fume-modeline-funclist nil - "The latest list of function names in the buffer. -If point is within a function definition, a name from this list may be -displayed in the modeline.") - -(fume-defvar-local - fume-funclist-dirty-p nil - "Flags whether the buffer is in need of a fresh scan.") - -(fume-defvar-local - fume-rescan-inhibit-p nil - "Internal variable only. DO NOT TOUCH.") - -(fume-defvar-local - fume-rescan-trigger-counter 0 - "Used in large buffers to optimise automatic function rescanning frequency.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;; Mode specific regexp's and hooks ;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Every fume-function-name-regexp- should uniquely identify a -;; function for that language. - -;; Lisp -;; -;; David Hughes -;; Vladimir Alexiev -(defvar fume-function-name-regexp-lisp - (concat - "^[ \t]*" ; Allow whitespace |(or (fboundp 'foo) - ; for the construct | (defun foo () - "(\\(def\\(?:un\\*?\\|subst\\*?" ; APA: Make regexp more correct. - "\\|macro\\*?\\|advice\\|group\\|type\\|struct" - "\\|class\\|ine-condition\\)\\)" ; excluding defvar, defconst, but not defgroup - "\\s-+" ; At least one whitespace - "'?[#:?%@!*/A-Za-z0-9_+<>-]+" ; Allow (defalias 'foo 'bar) - "\\s-*" ; Whitespace - "\\(nil\\|(\\)" ; nil or (arg list - ) - "Expression to get Lisp function names.") - -;; C -;; -;; Danny Bar-Dov -;; Bob Weiner added #define macro support. -(defvar fume-function-name-regexp-c - (concat - "^\\([a-zA-Z0-9_]+\\|#define\\)\\s-?"; type specs; there can be no - "\\([a-zA-Z0-9_*]+\\s-+\\)?" ; more than 3 tokens, right? - "\\([a-zA-Z0-9_*]+\\s-+\\)?" - "\\([*&]+\\s-*\\)?" ; pointer - "\\([a-zA-Z0-9_*]+\\)[ \t\n]*(" ; name - ) - "Expression to get C function names.") - -;; C++ -;; -;; Andy Piper -;; Kevin R. Powell -;; Mats Lidell -;; Mike Battaglia -;; Oliver Schittko -;; Tom Murray -;; Bob Weiner added #define macro support. -;; Didier Verna avoid matches on macro def last line -(defvar fume-function-name-regexp-c++ - (cons - (concat - "\\(\\`\\|[^\\]\n\\)" ; avoid matching on last line of macro definition - "\\(#define\\s-+\\|" - "\\(template\\s-+<[^>]+>\\s-+\\)?" ; template formals - "\\([a-zA-Z0-9_*&<,>:]+\\s-+\\)?" ; type specs; there can be no - "\\([a-zA-Z0-9_*&<,>\"]+\\s-+\\)?" ; more than 3 tokens, right? - "\\([a-zA-Z0-9_*&<,>]+\\s-+\\)?\\)" - "\\(\\([a-zA-Z0-9_&~:<,>*]\\|\\(\\s +::\\s +\\)\\)+\\)" - "\\(o?perator\\s *.[^(]*\\)?\\(\\s-\\|\n\\)*(" ; name - ) 7) - "Expression to get C++ function names.") - -;; Objective-C -;; Guillaume Laurent -(defvar fume-function-name-regexp-objc - (concat - "\\(" - "^[a-zA-Z0-9]+\\s-?" ; type specs; there can be no - "\\([a-zA-Z0-9_*]+\\s-+\\)?" ; more than 3 tokens, right? - "\\([a-zA-Z0-9_*]+\\s-+\\)?" - "\\([*&]+\\s-*\\)?" ; pointer - "\\([a-zA-Z0-9_*]+\\)[ \t\n]*(" ; name - "\\)" - "\\|" - "\\(^[-+]\\s-*\\(([a-zA-Z0-9_* \t]+)\\)?\\(\\s-*\\)[a-zA-Z0-9_]+\\)" - ) - "Expression to get Objective-C function names.") - -;; FORTRAN -;; -;; Paul Emsley -;; Raymond L. Toy -;; Richard Cognot -;; Greg Sjaardema -;; Bruce Ravel -(defvar fume-function-name-regexp-fortran - (concat - ;; >= six spaces - "^ \\s-*" - ;; type specs - "[a-zA-Z0-9* ]*\\s-*" - ;; continuation lines - "\\(\n [^ 0]\\s-*\\)*" - ;; function or subroutine - "\\(entry\\|ENTRY\\|function\\|FUNCTION\\|subroutine\\|SUBROUTINE\\|block\\s-*data\\|BLOCK\\s-*DATA\\)\\s-*" - ;; continuation lines - "\\(\n [^ 0]\\s-*\\)*" - ) - "Expression to get Fortran 77 function and subroutine names.") - -;; John Turner -(defvar fume-function-name-regexp-fortran90 - (concat - ;; Start of big "Or" clause. - "\\(" - ;; Modules -- must start at beginning of line -- this eliminates - ;; "module procedure" statements, which are indented. - "^[Mm][Oo][Dd][Uu][Ll][Ee]\\s-*" - ;; Or. - "\\|" - ;; Derived type definitions. This makes use of my convention to - ;; never leave a space between "type" and "(" when I actually use - ;; a derived type. - "^\\s-*[Tt][Yy][Pp][Ee][^(]\\s-*" - ;; Or. - "\\|" - ;; White space at beginning. - "^\\s-*" - ;; Type specs -- not used, because it would also include "end - ;; function" lines and I don't use type specs before function - ;; statements anyway. Uncomment this line if you want that behavior. - ;; "[a-zA-Z0-9*]*" - ;; - ;; Entry, function, subroutine, program. - "\\(" - "[Ee][Nn][Tt][Rr][Yy]\\|" - "[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\|" - "[Ss][Uu][Bb][Rr][Oo][Uu][Tt][Ii][Nn][Ee]\\|" - "[Pp][Rr][Oo][Gg][Rr][Aa][Mm]" - "\\)\\s-*" - ;; End of big "Or" clause. - "\\)" - ) - "Expression to get Fortran 90 module, type, function, and subroutine names.") - -;; Modula -(defvar fume-function-name-regexp-modula - "^\\s-*PROCEDURE\\s-+[A-Za-z0-9_-]+" - "Expression to get Modula function names.") - -;; Maple -;; -;; Luc Tancredi -(defvar fume-function-name-regexp-maple - "^[ \t]*[a-zA-Z0-9_]+[ \t]*:=[ \t]*proc[ \t]*(" - "Expression to get Maple function/procedure names.") - -;; Tcl -;; -;; Andy Piper -;; Jean-Michel Augusto -;; Dr P.G. Sjoerdsma -(defvar fume-function-name-regexp-tcl - (cons "^\\s *proc\\s +\\(\\S-+\\)\\s *{" 1) - "Expression to get Tcl function names.") - -;; Java -;; -;; Heddy Boubaker -(defvar fume-function-name-regexp-java - "\\s-+\\([A-Za-z_][A-Za-z0-9_]+\\)[\n \t\r]*\\((\\)" - "Expression to get Java method names.") - -;; Perl -;; -;; Alex Rezinsky -;; Michael Lamoureux -;; Remco Wouts -;; Ville Skyttä -(defvar fume-function-name-regexp-perl - (concat - "^\\(package\\|sub\\)[ \t]+" ;; Package or sub? - "\\(\\([A-Za-z0-9_:]+\\)::\\)?" ;; Package prefix, like in "sub Foo::bar" - "\\([A-Za-z0-9_]+\\)" ;; Function name. - ) - "Expression to get Perl function names.") - -(defcustom fume-perl-fully-qualified-names t - "*If non-nil, use fully qualified names for Perl functions." - :type 'boolean - :group 'fume) - -;; Ruby -;; Stefan Kamphausen -;; Albert Davidson Chou -;; Claus Brunzema -(defvar fume-function-name-regexp-ruby - "^\\s-*\\(class\\|def\\)+\\s-*\\([^(\n ]+\\)") - -;; Python support -;; Shuichi Koga -;; -(defvar fume-function-name-regexp-python - "^\\s-*\\(class\\|def\\)+\\s-*\\([A-Za-z0-9_]+\\)\\s-*[(:]" - "Expression to get Python class and function names.") - -(defcustom fume-python-fully-qualified-names t - "*If non-nil, include class name for python functions." -:type 'boolean -:group 'fume) - -;; JavaScript -;; -(defvar fume-function-name-regexp-javascript - (concat - "^\\(" - "\\|" - "\\([^/]\\|/[^/\\*]\\|/\\*\\([^\\*]\\|\\*[^/]\\)*\\*/\\)[ \t;{]" - "\\)" - "function[ \t]+" - "\\([a-zA-Z_\\$][a-zA-Z0-9_\\$]*\\)" - ;; "[ \t\n]*(" - ) - "Expression to get JavaScript function names.") - -;; Postscript -;; -;; Leigh L. Klotz -(defvar fume-function-name-regexp-postscript - "^/[^][ \t{}<>]*" - "Expression to get PostScript function names.") - -;; Prolog -;; -;; Laszlo Teleki -(defvar fume-function-name-regexp-prolog - "^[a-z][a-zA-Z0-9_]+" - "Expression to get Prolog fact and clause names.") - -;; Ehdm -;; -;; C. Michael Holloway -(defvar fume-function-name-regexp-ehdm - (concat - "[A-Za-z0-9_]*:[ ]*" - "\\([Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\|" - "[Ll][Ee][Mm][Mm][Aa]\\|" - "[Aa][Xx][Ii][Oo][Mm]\\|" - "[Pp][Rr][Oo][Vv][Ee]\\|" - "[Tt][Hh][Ee][Oo][Rr][Ee][Mm]" - "\\)" - ) - "*Expression to get Ehdm function, theorems, axioms, lemmas, and proofs.") - -;; PVS -;; -;; C. Michael Holloway -(defvar fume-function-name-regexp-pvs - (concat - "\\([A-Za-z0-9_]*:[ ]*" - "\\([Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\|" - "[Ll][Ee][Mm][Mm][Aa]\\|" - "[Aa][Xx][Ii][Oo][Mm]\\|" - "[Tt][Hh][Ee][Oo][Rr][Ee][Mm]\\|" - "[Ff][Or][Rr][Mm][Uu][La][Aa]" - "\\|" - "\\[.*\\]" - "\\)\\)\\|" - "[A-Za-z0-9_]*(.*)[ ]*:" - ) - "*Expression to get PVS functions, theorems, axioms, and lemmas.") - -;; Tex, LaTex -;; -;; Philippe Queinnec -;; Paolo Frasconi -(fume-defvar-local fume-tex-chapter 0) -(fume-defvar-local fume-tex-section 0) -(fume-defvar-local fume-tex-subsection 0) -(fume-defvar-local fume-tex-subsubsection 0) - -(defun fume-tex-rescan-buffer-hook () - (setq fume-tex-chapter 0 - fume-tex-section 0 - fume-tex-subsection 0 - fume-tex-subsubsection 0)) - -(defun fume-tweak-tex-mode () - (setq fume-sort-function nil) - (add-hook 'fume-rescan-buffer-hook 'fume-tex-rescan-buffer-hook)) - -(add-hook 'tex-mode-hook 'fume-tweak-tex-mode) -;; C. Michael Holloway -(add-hook 'TeX-mode-hook 'fume-tweak-tex-mode) -;; Wolfgang Mettbach -(add-hook 'latex-mode-hook 'fume-tweak-tex-mode) -(add-hook 'LaTeX-mode-hook 'fume-tweak-tex-mode) - -;; Philippe Queinnec -(defvar fume-section-name-regexp-latex - (concat - "^\\s-*\\\\\\(" - "\\(sub\\)*section\\|chapter\\)" - "\\*?\\(\\[[^]]*\\]\\)?{\\([^}]*\\)}" - ) - "Expression to get LaTeX section names.") - -;; ksh -;; -;; Philippe Bondono -(defvar fume-function-name-regexp-ksh - (concat - "\\(^\\s-*function\\s-+[A-Za-z_][A-Za-z_0-9]*\\)" - "\\|" - "\\(^\\s-*[A-Za-z_][A-Za-z_0-9]*\\s-*()\\)") - "Expression to get ksh function names.") - -;; Scheme -;; -;; C. Michael Holloway -(defvar fume-function-name-regexp-scheme - "^(define[-a-z]* [ ]*" - "Expression to get Scheme function names.") - -;; BibTeX -;; -;; C. Michael Holloway -(defvar fume-function-name-regexp-bibtex - ;; "^@[A-Za-z]*[({]\\([A-Za-z0-9:;&-]*\\)," - ;; Christoph Wedler - ;; According to the LaTeX Companion, this should be - "^@[A-Za-z]*[({]\\([A-Za-z][^ \t\n\"#%'(),={}]*\\)," - "Expression to get BibTeX citation headers.") - -;; SGML -;; -;; Thomas Plass -(defvar fume-function-name-regexp-sgml - " -;; Michael Polo -(defvar fume-function-name-regexp-ada - (cons "^[ \t]*\\([pP][rR][oO][cC][eE][dD][uU][rR][eE]\\|[fF][uU][nN][cC][tT][iI][oO][nN]\\|[tT][aA][sS][kK][ \t\n]*[bB][oO][dD][yY]\\)[ \n\t]+\\([a-zA-Z0-9_]+\\|\"[^\"]\"\\)" 2) - "Expression to find declaration of Ada function.") - -;; ignore prototypes, `renames', `is new' to eliminate clutter -;; -;; Scott Evans -(defvar fume-function-name-regexp-ada-ignore - "[ \n\t]*\\(([^()]+)[ \n\t]*\\)?\\(return[ \t\n]+[^ \t\n;]+[ \n\t]*\\)?\\(;\\|is[ \n\t]+new[ \n\t]\\|renames\\)" - "Ignore if Ada function name matches this string.") - -;; Makefiles -;; -;; David Hughes -;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com> -(defvar fume-function-name-regexp-make - "^\\(\\(\\$\\s(\\)?\\(\\w\\|\\s_\\|\\.\\)+\\(:sh\\)?\\(\\s)\\)?\\)\\s *\\(::?\\|\\+?=\\)" - "Expression to get Makefile target names. - -Add the following line to your .emacs if you want Makefile support. -Note, this can be very slow for large or non-trivial Makefiles. - -(add-hook 'makefile-mode-hook 'fume-add-menubar-entry)") - -;; Directory Listings -;; -;; Norbert Kiesel -;; regexp stolen from font-lock-mode -(defvar fume-function-name-regexp-dired - "^. +d.*\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\) +[0-9]+ +[0-9:]+ \\(.*\\)$" - "Expression to get directory names.") - -;; Pascal -;; -;; Espen Skoglund -(defvar fume-function-name-regexp-pascal - "^\\(function\\|procedure\\)[ \t]+\\([_a-zA-Z][_a-zA-Z0-9]*\\)" - "Expression to get function/procedure names in Pascal.") - -;; Fame -;; -;; Cooper Vertz -(defvar fume-function-name-regexp-fame - "^\\(function\\|procedure\\)[ \t]+\\([#\\$%_a-zA-Z][#\\$%_a-zA-Z0-9]*\\)" - "Expression to get function/procedure names in fame.") - -;; Verilog -;; -;; Matt Sale -(defvar fume-function-name-regexp-verilog - "^\\(task\\|function\\|module\\|primitive\\)[ \t]+\\([A-Za-z0-9_+-]*\\)[ \t]*(?" - "Expression to get Verilog module names.") - -;; IDL (Interactive Data Language) -;; -;; Lubos Pochman -;; Carsten Dominik -(defvar fume-function-name-regexp-idlwave - (cons "^\\s *\\([pP][rR][oO]\\|[fF][uU][nN][cC][tT][iI][oO][nN]\\)\\s +\\([A-Za-z][A-Za-z0-9_$]*\\(::[A-Za-z][A-Za-z0-9_$]*\\)?\\)" 2) - "Expression to get IDL function, procedure and method names.") - -;; Assembly -(defvar fume-function-name-regexp-asm - "^\\([a-zA-Z_.$][a-zA-Z0-9_.$]*\\)[ \t]*:" - "Expression to get assembly label names.") - -;; Manual pages -;; -;; Didier Verna -(defvar fume-function-name-regexp-manual "^[A-Z][A-Z ]+$" - "*Expression to get Manual page sections.") - -;; Autoconf 2.5x -;; -;; Andrew W. Nosenko -(defvar fume-function-name-regexp-autoconf "^\\(?:AC_DEFUN\\|m4_define\\)(\\[?\\([A-Za-z0-9_()]+\\)" - "*Expression to get Autoconf macro definitions.") - - -;; This is where the mode specific regexp's are hooked in -;; -(defvar fume-function-name-regexp-alist - '(;; Lisp - (emacs-lisp-mode . fume-function-name-regexp-lisp) - (common-lisp-mode . fume-function-name-regexp-lisp) - (fi:common-lisp-mode . fume-function-name-regexp-lisp) - (fi:emacs-lisp-mode . fume-function-name-regexp-lisp) - (fi:franz-lisp-mode . fume-function-name-regexp-lisp) - (fi:inferior-common-lisp-mode . fume-function-name-regexp-lisp) - (fi:inferior-franz-lisp-mode . fume-function-name-regexp-lisp) - (fi:lisp-listener-mode . fume-function-name-regexp-lisp) - (lisp-mode . fume-function-name-regexp-lisp) - (lisp-interaction-mode . fume-function-name-regexp-lisp) - - ;; C - (c-mode . fume-function-name-regexp-c) - (elec-c-mode . fume-function-name-regexp-c) - - ;; C++ - (c++-mode . fume-function-name-regexp-c++) - (c++-c-mode . fume-function-name-regexp-c++) - - ;; Objective-C - (objc-mode . fume-function-name-regexp-objc) - - ;; Fortran - (fortran-mode . fume-function-name-regexp-fortran) - (f90-mode . fume-function-name-regexp-fortran90) - - ;; Modula - (modula-2-mode . fume-function-name-regexp-modula) - (modula-3-mode . fume-function-name-regexp-modula) - - ;; Maple - (maple-mode . fume-function-name-regexp-maple) - - ;; Perl - (perl-mode . fume-function-name-regexp-perl) - - ;; Ruby - (ruby-mode . fume-function-name-regexp-ruby) - - ;; Java - (java-mode . fume-function-name-regexp-java) - (jde-mode . fume-function-name-regexp-java) - - ;; Python - (alice-mode . fume-function-name-regexp-python) - (python-mode . fume-function-name-regexp-python) - - ;; JavaScript - (javascript-mode . fume-function-name-regexp-javascript) - - ;; Postscript - (postscript-mode . fume-function-name-regexp-postscript) - - ;; Prolog - (prolog-mode . fume-function-name-regexp-prolog) - - ;; Tcl - (tcl-mode . fume-function-name-regexp-tcl) - - ;; ksh - (ksh-mode . fume-function-name-regexp-ksh) - - ;; LaTeX - (latex-mode . fume-section-name-regexp-latex) - (LaTeX-mode . fume-section-name-regexp-latex) - - ;; Scheme - (scheme-mode . fume-function-name-regexp-scheme) - - ;; BibTeX - (bibtex-mode . fume-function-name-regexp-bibtex) - - ;; Ehdm & PVS - (ehdm-mode . fume-function-name-regexp-ehdm) - (pvs-mode . fume-function-name-regexp-pvs) - - ;; SGML - (sgml-mode . fume-function-name-regexp-sgml) - - ;; Ada - (ada-mode . fume-function-name-regexp-ada) - - ;; Makefiles - (makefile-mode . fume-function-name-regexp-make) - - ;; Dired - (dired-mode . fume-function-name-regexp-dired) - - ;; Pascal - (pascal-mode . fume-function-name-regexp-pascal) - - ;; Fame - (fame-mode . fume-function-name-regexp-fame) - - ;; Verilog - (verilog-mode . fume-function-name-regexp-verilog) - - ;; IDL (Interactive Data Language) - (idlwave-mode . fume-function-name-regexp-idlwave) - - ;; Assembly - (asm-mode . fume-function-name-regexp-asm) - - ;; Manual - (Manual-mode . fume-function-name-regexp-manual) - - ;; Autoconf - (autoconf-mode . fume-function-name-regexp-autoconf) - ) - - "The connection between a mode and the regexp that matches function names.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;; Mode specific finding functions ;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Default routine : Note, most modes will need a specialised routine -;; -(defun fume-find-next-function-name (buffer) - "Search for the next function in BUFFER." - (set-buffer buffer) - ;; Search for the function - (if (re-search-forward fume-function-name-regexp nil t) - (let ((char (progn - (if (string-match - "[({[]" - (char-to-string (char-after (1- (point))))) - (backward-char) - (forward-word -1)) - (save-excursion - (goto-char (scan-sexps (point) 1)) - (skip-chars-forward "[ \t\n]") - (following-char))))) - ;; Skip this function name if it is a prototype declaration. - (if (and (eq char ?\;) (not (eq major-mode 'emacs-lisp-mode))) - (fume-find-next-function-name buffer) - ;; Get the function name and position - (let (beg) - (forward-sexp -1) - (setq beg (point)) - (forward-sexp) - (cons (buffer-substring beg (point)) beg)))))) - -;; General purpose sexp find function -;; -(defun fume-find-next-sexp (buffer) - "Search for the next sexp type function in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (save-excursion (forward-sexp -1) (point)))) - (cons (buffer-substring beg (point)) beg)))) - -;; Specialised routine to get the next Ehdm entity in the buffer. -;; C. Michael Holloway -;; -(defun fume-find-next-ehdm-entity (buffer) - "Search for the next Ehdm entity in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (cons (buffer-substring beg end) beg)))) - -;; Specialised routine to get the next PVS entity in the buffer. -;; C. Michael Holloway -;; -(defun fume-find-next-pvs-entity (buffer) - "Search for the next PVS entity in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (goto-char (1- end)) - (if (looking-at ":") - (setq end (1- end))) - (cons (buffer-substring beg end) beg)))) - -;; Specialised routine to get the next C function name in the buffer. -;; Modified 16/12/96: Jerome Bertorelle -;; -(defun fume-find-next-c-function-name (buffer) - "Search for the next C function in BUFFER." - (set-buffer buffer) - ;; Search for the function - (if (re-search-forward fume-function-name-regexp nil t) - (let ((char (progn - (backward-up-list 1) - (save-excursion - (goto-char (scan-sexps (point) 1)) - (skip-chars-forward "[ \t\n]") - (following-char))))) - ;; Skip this function name if it is a prototype declaration. - (if (eq char ?\;) - (fume-find-next-c-function-name buffer) - (let (beg - name) - ;; Get the function name and position - (forward-sexp -1) - (setq beg (point)) - (forward-sexp) - (setq name (buffer-substring beg (point))) - ;; ghastly crock for DEFUN declarations - (cond ((string-match "^DEFUN\\s-*" name) - (forward-word 1) - (forward-word -1) - (setq beg (point)) - (cond ((re-search-forward "\"," nil t) - (re-search-backward "\"," nil t) - (setq name - (format "%s %s" - name - (buffer-substring beg (point)))))))) - ;; kludge to avoid `void' etc in menu - (if (string-match - "\\`\\(void\\|if\\|else if\\|else\\|switch\\|for\\|while\\)\\'" - name) - (fume-find-next-c-function-name buffer) - (cons name beg))))))) - -;; Peter Pezaris -;; -(defun fume-cc-inside-comment () - (memq (buffer-syntactic-context) '(comment block-comment))) - -;; -;; -;; -;; -;; -(defun fume-match-find-next-function-name (buffer) - "General next function name in BUFFER finder using match. -The regexp is assumed to be a two item list the car of which is the regexp -to use, and the cdr of which is the match position of the function name." - (set-buffer buffer) - (let ((r (car fume-function-name-regexp)) - (p (cdr fume-function-name-regexp))) - (catch 'found - (while (re-search-forward r nil t) - (catch 'skip - ;; Reject comments - (if (fume-cc-inside-comment) (throw 'skip t)) - ;; Reject typedef's - (save-excursion - (re-search-backward r nil t) - (if (string= "typedef" (fume-what-looking-at)) (throw 'skip t)) - (re-search-forward r nil t)) - (backward-up-list 1) - ;; Reject class member inits - (let ((c (save-excursion (back-to-indentation) (char-after (point))))) - (if (or (char-equal c ?\,) (char-equal c ?\:)) (throw 'skip t))) - ;; Reject prototypes - (save-excursion - (goto-char (scan-sexps (point) 1)) - (skip-chars-forward "[ \t()]*") - (if (char-equal (following-char) ?\;) (throw 'skip t))) - (throw - 'found - (cons (buffer-substring (setq p (match-beginning p)) (point)) p)))) - nil))) - -;; Objective-C -;; Guillaume Laurent -(defun fume-find-next-objc-function-or-method-name (buffer) - "Search for the next Objective-C function or method in BUFFER." - (set-buffer buffer) - ;; Search for the function - (if (re-search-forward fume-function-name-regexp nil t) - (if (string-match "^[-+]\\s-*" (match-string 0)) ; this is a method decl. - (let (beg name) - (backward-sexp) - (setq beg (point)) - (forward-sexp) - (if (char-equal (following-char) ?\:) (forward-char)) - (setq name (buffer-substring beg (point))) - (cons name beg)) - (let ((char (progn ; else this is a regular C func - (backward-up-list 1) - (save-excursion - (goto-char (scan-sexps (point) 1)) - (skip-chars-forward "[ \t\n]") - (following-char))))) - ;; Skip this function name if it is a prototype declaration. - (if (eq char ?\;) - (fume-find-next-function-name buffer) - (let (beg - name) - ;; Get the function name and position - (forward-sexp -1) - (setq beg (point)) - (forward-sexp) - (setq name (buffer-substring beg (point))) - ;; kludge to avoid `void' in menu - (if (string-match "^void\\s-*" name) - (fume-find-next-function-name buffer) - (cons name beg)))))))) - -;; Specialised routine to find the next Perl function -;; -;; This gets package names wrong in some cases, eg: -;; -;; package Foo; -;; { -;; package Bar; -;; sub baz {} -;; } -;; sub quux {} # This is Foo::quux, not Bar::quux ! -;; -(defun fume-find-next-perl-function-name (buffer) - "Search for the next Perl function in BUFFER. -See also `fume-perl-fully-qualified-names'." - (set-buffer buffer) - (when (not (boundp 'fume-perl-current-package)) - (make-variable-buffer-local 'fume-perl-current-package) - (setq fume-perl-current-package nil)) - (if (re-search-forward fume-function-name-regexp nil t) - (save-excursion - (let ((retpnt (match-beginning 1)) - (type (match-string 1)) - (pkg-with-colons (match-string 2)) - (pkg (match-string 3)) - (name (match-string 4))) - (cond ((string= type "package") - (setq name (concat (or pkg-with-colons "") name)) - (setq fume-perl-current-package name)) - ((string= type "sub") - (when fume-perl-fully-qualified-names - (setq name - (format "%s::%s" - (or pkg fume-perl-current-package "main") - name))) - (cons name retpnt))))) - ;; Reset current package when no more functions found. - (setq fume-perl-current-package nil))) - -;; Specialised routine to find the next Ruby function -;; -(defun fume-find-next-ruby-function-name (buffer) - "Search for the next Ruby function in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (save-excursion - (let* ((retpnt (match-beginning 2)) - (retname (buffer-substring retpnt (match-end 2)))) - (goto-char (match-beginning 0)) - (cond ((looking-at "^\\s-*def") - (re-search-backward - "\n?\\s-*class\\s-*\\([A-Z][A-Za-z0-9_]*\\)\\s-*" nil t) - (let* ((classname (buffer-substring - (match-beginning 1) (match-end 1)))) - (if (not (string-match (concat "^" classname "\\.") retname)) - (setq retname (concat classname "." retname)))))) - (cons retname retpnt))))) - -;; Specialised routine to find the next Java function -;; Bob Weiner -;; Heddy Boubaker -;; -(defun fume-find-next-java-function-name (buffer) - "Search for the next Java function in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 1)) - (end (match-end 1))) - (goto-char (match-beginning 2)) - (forward-sexp) - (if (and (looking-at "[^;(]*{") - (not (fume-cc-inside-comment))) - ;; This is a method definition and we're not in a comment - (let ((str (buffer-substring beg end))) - ;; Bob Weiner added exact match - ;; delimiters so function names that happen to contain - ;; any of these terms are not eliminated. The old version - ;; would ignore "notify()" since it contained "if". - (or - (string-match - "\\`\\(if\\|else if\\|else\\|switch\\|catch\\|for\\|while\\|synchronized\\)\\'" - str) - ;; These constructs look like method definitions but are not - (cons str beg))) - (fume-find-next-java-function-name buffer))))) - -;; Specialised routine to find the next Python function -;; Shuichi Koga -;; -(defun fume-find-next-python-function-name (buffer) - "Search for the next Python function in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (save-excursion - (let* ((retpnt (match-beginning 2)) - (retname (buffer-substring retpnt (match-end 2)))) - (when fume-python-fully-qualified-names - (goto-char (match-beginning 0)) - (cond ((looking-at "\\s-+def") - (re-search-backward - "^class\\s-*\\([A-Za-z0-9_]+\\)\\s-*[(:]" nil t) - (setq retname - (concat - (buffer-substring (match-beginning 1) (match-end 1)) - "." - retname))))) - (cons retname retpnt))))) - -;; Specialised routine to find the next JavaScript function -;; -(defun fume-find-next-javascript-function-name (buffer) - "Search for the next JavaScript function in BUFFER." - (fume-find-next-sexp buffer)) - -;; Specialised routine to find the next Modula function or subroutine. -;; -(defun fume-find-next-modula-function-name (buffer) - "Search for the next Modula function in BUFFER." - (fume-find-next-sexp buffer)) - -;; Specialised routine to find the next directory. -;; Norbert Kiesel -;; -(defun fume-find-next-directory-name (buffer) - "Search for the next directory in dired BUFFER." - (set-buffer buffer) - ;; Search for the function - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 2)) - (end (match-end 2))) - (cons (buffer-substring beg end) beg)))) - -;; Specialised routine to find the next Fortran function or subroutine -;; -(defun fume-find-next-fortran-function-name (buffer) - "Search for the next Fortran function in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((pos (point)) - ;; name may have "_" but must start with a letter - (name-regexp "\\s-+[a-zA-Z]+[_a-zA-Z0-9* ]*") - (eol (save-excursion (end-of-line 1) (point)))) - (skip-chars-backward " \t") - (if (re-search-forward name-regexp eol t) - ;; name is ok; so return it - (cons (buffer-substring pos (point)) pos) - ;; rubbish found; skip to next function - (fume-find-next-fortran-function-name buffer))))) - -;; Specialised routine to get the next postscript function name in the buffer -;; Leigh L. Klotz -;; -(defun fume-find-next-postscript-function-name (buffer) - "Search for the next PostScript function in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (progn (beginning-of-line 1) (point)))) - (forward-sexp) - ;; keep including sexps as long as they - ;; start with / or [. - (if (looking-at "\\s-+\\(/\\|\\[\\)") - (forward-sexp)) - (cons (buffer-substring beg (point)) beg)))) - -;; Specialised routine to get the next prolog fact/clause name in the buffer -;; Laszlo Teleki -;; -(defun fume-find-next-prolog-function-name (buffer) - "Search for the next Prolog fact or clause in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (progn (beginning-of-line 1) (point)))) - (forward-sexp) - (cons (buffer-substring beg (point)) beg)))) - -;; Specialized routine to get the next Maple function name in the buffer -;; Luc Tancredi -;; -(defun fume-find-next-maple-function-name (buffer) - "Search for the next Maple function in BUFFER." - (set-buffer buffer) - ;; Search for the function - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (progn (backward-up-list 1) (forward-sexp -2) (point)))) - (forward-sexp) - (cons (buffer-substring beg (point)) beg)))) - -;; Specialised routine to get the next latex section name in the buffer -;; Philippe Queinnec -;; Paolo Frasconi -;; Anthony Rossini -;; -(defun fume-find-next-latex-section-name (buffer) - "Search for the next LaTeX section in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let* ((secname (buffer-substring (match-beginning 1) (match-end 1))) - (beg (match-beginning 4)) - (name (buffer-substring beg (match-end 4)))) - (cond ((string= secname "chapter") - (setq fume-tex-chapter (1+ fume-tex-chapter) - fume-tex-section 0 - fume-tex-subsection 0 - fume-tex-subsubsection 0 - name (concat (int-to-string fume-tex-chapter) - " " (upcase name)))) - ((string= secname "section") - (setq fume-tex-section (1+ fume-tex-section) - name (concat - (if (> fume-tex-chapter 0) - (concat (int-to-string fume-tex-chapter) ".") "") - (int-to-string fume-tex-section) " " name) - fume-tex-subsection 0 - fume-tex-subsubsection 0)) - ((string= secname "subsection") - (setq fume-tex-subsection (1+ fume-tex-subsection) - name (concat - (if (> fume-tex-chapter 0) - (concat (int-to-string fume-tex-chapter) ".") "") - (int-to-string fume-tex-section) "." - (int-to-string fume-tex-subsection) " " name) - fume-tex-subsubsection 0)) - ((string= secname "subsubsection") - (setq fume-tex-subsubsection (1+ fume-tex-subsubsection) - name (concat - (if (> fume-tex-chapter 0) - (concat (int-to-string fume-tex-chapter) ".") "") - (int-to-string fume-tex-section) "." - (int-to-string fume-tex-subsection) "." - (int-to-string fume-tex-subsubsection) " " name))) - ((string= secname "subsubsection") - (setq name (concat " " name)))) - (cons name beg)))) - -;; Specialised routine to get the next ksh function in the buffer -;; Philippe Bondono -;; -(defun fume-find-next-ksh-function-name (buffer) - "Search for the ksh type function in BUFFER." - (set-buffer buffer) - ;; Search for the function - (if (re-search-forward fume-function-name-regexp nil t) - (let (name - (beg (match-beginning 0))) - (cond ((re-search-backward "\\(^\\|\\s-\\)function\\s-" beg t) - (re-search-forward - "\\(function\\s-+\\)\\([A-Za-z_][A-Za-z_0-9]*\\)" nil t) - (setq beg (match-beginning 2) - name (buffer-substring beg (match-end 2)))) - (t - (re-search-backward - "\\(^\\|\\s-\\)\\([A-Za-z_][A-Za-z_0-9]*\\)" beg t) - (setq beg (match-beginning 2) - name (buffer-substring beg (match-end 2))))) - (if (null name) - (fume-find-next-ksh-function-name buffer) - (end-of-line) - (cons name beg))))) - -;; Specialised routine to get the next Scheme function in the buffer -;; C. Michael Holloway -;; -(defun fume-find-next-scheme-function (buffer) - "Search for the next Scheme function in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (progn (if (looking-at "(") (forward-char 1)) (point))) - (end (save-excursion (forward-sexp) (point)))) - (cons (buffer-substring beg end) beg)))) - -;; Specialised routine to get the next BibTeX citation in the buffer -;; C. Michael Holloway -;; -(defun fume-find-next-bibtex-citation (buffer) - "Search for the next BibTeX citation in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 1)) - (end (match-end 1))) - (cons (buffer-substring beg end) beg)))) - -;; Specialised routine to get the next SGML declaration in the buffer -;; Thomas Plass -;; -(defun fume-find-next-sgml-element-name (buffer) - "Search for the next SGML declaration in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((type (buffer-substring (match-beginning 1) (match-end 1))) - (beg (match-beginning 2)) - (name (buffer-substring (match-beginning 2) (match-end 2)))) - (if (string= (downcase type) "element") - (setq name (format "%-17s%3s" name "EL")) - (setq name (format "%-17s%3s" name "ENT"))) - (cons name beg)))) - -;; Specialised routine to get the next ada function in the buffer -;; Michael Polo -;; -(defun fume-find-next-ada-function-name (buffer) - "Search for the next Ada function in BUFFER." - (set-buffer buffer) - (if (re-search-forward (car fume-function-name-regexp-ada) nil t) - (let ((beg (match-beginning (cdr fume-function-name-regexp-ada))) - (end (match-end (cdr fume-function-name-regexp-ada)))) - - (if (looking-at fume-function-name-regexp-ada-ignore) - (fume-find-next-ada-function-name buffer) - (cons (buffer-substring beg end) beg))))) - -;; Makefiles -;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com> -;; -(defun fume-find-next-function-name-make (buffer) - "Search for the next make item in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 1)) - (end (match-end 1))) - (cons (buffer-substring beg end) beg)))) - -;; Find next pascal function in the buffer -;; Espen Skoglund -;; -(defun fume-find-next-pascal-function-name (buffer) - "Search for the next Pascal procedure in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 2)) - (end (match-end 2))) - (cons (buffer-substring beg end) beg)))) - -;; Verilog support -;; Matt Sale -;; -(defun fume-find-next-verilog-function-name (buffer) - "Search for the next Verilog module in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 2)) - (end (match-end 2))) - (cons (buffer-substring beg end) beg)))) - -;; Specialised routine to get the next IDL function in the buffer -;; -;; Lubos Pochman -;; Carsten Dominik -(defun fume-find-next-idlwave-function-name (buffer) - "Search for the next IDL function in BUFFER." - (set-buffer buffer) - (if (re-search-forward (car fume-function-name-regexp-idlwave) nil t) - (let ((beg (match-beginning (cdr fume-function-name-regexp-idlwave))) - (end (match-end (cdr fume-function-name-regexp-idlwave)))) - (cons (buffer-substring beg end) beg)))) - -;; Assembly -;; Bob Weiner -;; -(defun fume-find-next-asm-function-name (buffer) - "Search for the next assembler function in BUFFER." - (set-buffer buffer) - ;; Search for the function - (if (re-search-forward fume-function-name-regexp nil t) - (cons (buffer-substring (match-beginning 1) (match-end 1)) - (match-beginning 1)))) - -;; Specialised routine to get the next manual section name in the buffer -;; Didier Verna -;; -(defun fume-find-next-manual-section (buffer) - "Search for the next manual section name in BUFFER." - (set-buffer buffer) - (if (re-search-forward fume-function-name-regexp nil t) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (cons (buffer-substring beg end) beg)))) - -;; This is where you can hook in other languages which may need a different -;; method to scan for function names. Otherwise, the default defun used is -;; fume-find-next-function-name which is suitable for sexp-based languages -;; such as C, C++ and elisp. -;; -(defconst fume-find-function-name-method-alist - '((ada-mode . fume-find-next-ada-function-name) - (alice-mode . fume-find-next-python-function-name) - (asm-mode . fume-find-next-asm-function-name) - (bibtex-mode . fume-find-next-bibtex-citation) - (c++-mode . fume-match-find-next-function-name) - (c++-c-mode . fume-match-find-next-function-name) - (c-mode . fume-find-next-c-function-name) - (objc-mode . fume-find-next-objc-function-or-method-name) - (dired-mode . fume-find-next-directory-name) - (ehdm-mode . fume-find-next-ehdm-entity) - (fame-mode . fume-find-next-pascal-function-name) - (fortran-mode . fume-find-next-fortran-function-name) - (f90-mode . fume-find-next-fortran-function-name) - (ksh-mode . fume-find-next-ksh-function-name) - (latex-mode . fume-find-next-latex-section-name) - (LaTeX-mode . fume-find-next-latex-section-name) - (makefile-mode . fume-find-next-function-name-make) - (maple-mode . fume-find-next-maple-function-name) - (modula-2-mode . fume-find-next-modula-function-name) - (modula-3-mode . fume-find-next-modula-function-name) - (pascal-mode . fume-find-next-pascal-function-name) - (perl-mode . fume-find-next-perl-function-name) - (ruby-mode . fume-find-next-ruby-function-name) - (java-mode . fume-find-next-java-function-name) - (jde-mode . fume-find-next-java-function-name) - (postscript-mode . fume-find-next-postscript-function-name) - (prolog-mode . fume-find-next-prolog-function-name) - (pvs-mode . fume-find-next-pvs-entity) - (python-mode . fume-find-next-python-function-name) - (javascript-mode . fume-find-next-javascript-function-name) - (scheme-mode . fume-find-next-scheme-function) - (sgml-mode . fume-find-next-sgml-element-name) - (tcl-mode . fume-match-find-next-function-name) - (verilog-mode . fume-find-next-verilog-function-name) - (idlwave-mode . fume-find-next-idlwave-function-name) - (Manual-mode . fume-find-next-manual-section) - ) - - "The connection between a mode and the defun that finds function names. -If no connection is in this alist for a given mode, a default method is used") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;; General utility functions ;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; modeline refresh routine -;; -(or (fboundp 'redraw-modeline) - (defun redraw-modeline () (set-buffer-modified-p (buffer-modified-p)))) - -;; Smart mouse positioning -;; -(if (fboundp 'window-edges) ; old method - (defun fume-set-mouse-position () - (set-mouse-position - (selected-frame) - (nth 0 (window-edges)) (nth 1 (window-edges)))) - (defun fume-set-mouse-position () ; new method - (set-mouse-position - (selected-window) - (nth 0 (window-pixel-edges)) - (nth 1 (window-pixel-edges))))) - -;; Sets `fume-function-name-regexp' to something appropriate for the current -;; mode for this buffer. -;; -(defun fume-set-defaults () - "Return nil if unsuccessful in setting up buffer-local defaults. -Otherwise returns fume-function-name-regexp" - (setq fume-function-name-regexp - (symbol-value - (cdr-safe (assoc major-mode fume-function-name-regexp-alist)))) - (if fume-function-name-regexp - (setq fume-find-next-function-name-method - (or (cdr-safe (assoc major-mode - fume-find-function-name-method-alist)) - 'fume-find-next-function-name))) - fume-function-name-regexp) - -(defun fume-add-menubar-entry (&optional force) - (interactive) - (if force - (save-window-excursion (function-menu t)) - (enqueue-eval-event 'fume-do-add-menubar-entry (current-buffer)))) - -(defun fume-do-add-menubar-entry (buffer) - (and (buffer-live-p buffer) - (save-excursion - (save-window-excursion - (set-buffer buffer) - (function-menu t))))) - -(defun fume-remove-menubar-entry () - (interactive) - (cond ((and fume-running-xemacs current-menubar) - (delete-menu-item (list fume-menubar-menu-name)) - ;; force update of the menubar - (redraw-modeline)))) - -(defun fume-update-menubar-entry () - "Return t if menubar was updated, nil otherwise." - (and fume-running-xemacs - fume-not-tty - (assoc fume-menubar-menu-name current-menubar) - (save-window-excursion (function-menu t)) - t)) - -(defun fume-replace-str (s r b e) (concat (substring s 0 b) r (substring s e))) - -(defun fume-substitute (s old new &optional all) - (let (case-fold-search b (l (length new))) - (while (and (string-match old s b) - (setq b (+ (match-beginning 0) l) - s (fume-replace-str s new (- b l) (match-end 0))) - all)) - s)) - -(defun fume-trim-string (s &optional c) - (setq c (or c " \t") s (fume-substitute s (format "^[%s]*" c) "")) - (fume-substitute s (format "[%s]*$" c) "")) - -(defvar fume-syntax-table nil) - -(defun fume-what-looking-at (&optional check-primary-selection-p) - (or (and check-primary-selection-p - primary-selection-extent - (fume-bomb-proof - (prog1 (buffer-substring (region-beginning) (region-end)) - (and zmacs-regions (zmacs-deactivate-region) (sit-for 0))))) - (let (name - (orig-syntax-table (syntax-table))) - (if fume-syntax-table - () - (setq fume-syntax-table (make-syntax-table)) - (modify-syntax-entry ?: "w" fume-syntax-table)) - (unwind-protect - (progn - (set-syntax-table fume-syntax-table) - (save-excursion - (while (looking-at "\\sw\\|\\s_") (forward-char 1)) - (if (re-search-backward "\\sw\\|\\s_" nil t) - (let ((beg (progn (forward-char 1) (point)))) - (forward-sexp -1) - (while (looking-at "\\s'") (forward-char 1)) - (setq name (buffer-substring beg (point))))))) - (set-syntax-table orig-syntax-table) - name)))) - -(defun fume-function-before-point () - "Find function name that point is in. -The trick is to start from the end." - (if (or fume-modeline-funclist (fume-rescan-buffer) fume-modeline-funclist) - (let ((p (point))) - (save-excursion - (catch 'found - (mapcar (function - (lambda (x) - (goto-char (cdr x)) - (beginning-of-line 1) - (if (>= p (point)) (throw 'found (car x))))) - fume-modeline-funclist) nil))))) - -;; Routines to add a buffer local post command hook -;; -(defun fume-post-command-hook-p (hook) - (memq hook (if fume-use-local-post-command-hook - local-post-command-hook - post-command-hook))) - -(defun fume-add-post-command-hook (hook &optional append) - (or (fume-post-command-hook-p hook) - (cond (fume-use-local-post-command-hook - (add-hook 'local-post-command-hook hook append)) - ((fboundp 'make-local-hook) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook hook append t)) - (t - ;; NOT make-variable-buffer-local - (make-local-variable 'post-command-hook) - (add-hook 'post-command-hook hook append))))) - -(defun fume-remove-post-command-hook (hook) - (and (fume-post-command-hook-p hook) - (cond (fume-use-local-post-command-hook - (remove-hook 'local-post-command-hook hook)) - ((fboundp 'make-local-hook) - (remove-hook 'post-command-hook hook t)) - (t - (remove-hook 'post-command-hook hook))))) - -;; Routine to install the modeline feature -;; -(defun fume-maybe-install-modeline-feature () - (cond ((and fume-display-in-modeline-p (fume-set-defaults)) - (or fume-modeline-funclist - (fume-post-command-hook-p 'fume-tickle-modeline) - (fume-rescan-buffer)) - (fume-add-post-command-hook 'fume-tickle-modeline) - (fume-remove-post-command-hook 'fume-maybe-install-modeline-feature) - (fume-tickle-modeline-1) - (fume-tickle-modeline) - t ; return success flag - ))) - -(defun fume-toggle-modeline-display () - "Toggle whether func-menu displays function names in the modeline." - (interactive) - (setq fume-display-in-modeline-p (not fume-display-in-modeline-p)) - (if (interactive-p) (fume-tickle-modeline))) - -(defun fume-tickle-modeline () - "Routine to display function before point in the modeline." - (let ((fname (and fume-display-in-modeline-p (fume-function-before-point)))) - (set fume-modeline-buffer-identification - (if (not (and fume-display-in-modeline-p fname)) - fume-modeline-buffer-identification-0 - (setq fname (replace-in-string fname "%" "%%") - fname (format "'%s'" (fume-trim-string fname))) - (if (eq fume-display-in-modeline-p t) - (list fume-modeline-buffer-identification-1 " " fname) - fname)))) - (cond ((not fume-display-in-modeline-p) - (fume-remove-post-command-hook 'fume-tickle-modeline) - (fume-add-post-command-hook 'fume-maybe-install-modeline-feature))) - ;; force update of the modeline - (redraw-modeline)) - -(fume-defvar-local fume-modeline-buffer-identification-0 nil - "Storage for original modeline-buffer-identification") - -(fume-defvar-local fume-modeline-buffer-identification-1 nil - "Storage for munged modeline-buffer-identification") - -(defun fume-tickle-f-to-b (str) - "Change modeline format of \"XEmacs: %f\" to \"XEmacs: %b\" in order to make -extra room for the function name which is going to be appended to the -`modeline-buffer-identification' component of `modeline-format'." - (cond ((consp str) - (if (extentp (car str)) - (cons (car str) (fume-tickle-f-to-b (cdr str))) - (mapcar (function fume-tickle-f-to-b) str))) - ((not (stringp str)) str) - ((string-match "%[0-9]*f" str) - (let ((newstr (copy-sequence str))) - (aset newstr (1- (match-end 0)) (string-to-char "b")) - newstr)) - (t str))) - -(defun fume-tickle-modeline-1 () - (or fume-modeline-buffer-identification-0 - (setq fume-modeline-buffer-identification-0 - (symbol-value fume-modeline-buffer-identification))) - (setq fume-modeline-buffer-identification-1 - (fume-tickle-f-to-b fume-modeline-buffer-identification-0))) - -(defun fume-toggle-auto-rescanning () - "Toggle automatic rescanning of the buffer." - (interactive) - (message "Func-Menu buffer auto-rescanning turned %s" - (if (setq fume-auto-rescan-buffer-p (not fume-auto-rescan-buffer-p)) - "ON" "OFF")) - (sit-for 0)) - -(if (fboundp 'copy-tree) ; not built-in in all emacsen - (defalias 'fume-shallow-copy-list 'copy-tree) - (defun fume-shallow-copy-list (list) - "Create a shallow separate copy of a list." - (mapcar (function (lambda (i) (cons (car i) (cdr i)))) list))) - -(defun fume-sort-by-name (item1 item2) - "Sort function to sort items depending on their function name. -An item looks like (NAME . POSITION)." - (or (string-lessp (car item1) (car item2)) - (string-equal (car item1) (car item2)))) - -(defun fume-sort-by-position (item1 item2) - "Sort function to sort items depending on their position." - (<= (cdr item1) (cdr item2))) - -(defun fume-relative-position () - "Calculate relative position in buffer." - (let ((pos (point)) - (total (buffer-size))) - (if (> total 50000) - ;; Avoid overflow from multiplying by 100! - (/ (1- pos) (max (/ total 100) 1)) - (/ (* 100 (1- pos)) - (max total 1))))) - -;; Example (fume-split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8)) -;; -(defun fume-split (list n) - "Split LIST into sublists of max length N." - (let ((i 0) - result - sublist - (remain list)) - (while remain - (if (= n (setq sublist (cons (car remain) sublist) - remain (cdr remain) - i (1+ i))) - ;; We have finished a sublist - (setq result (cons (nreverse sublist) result) - sublist nil - i 0))) - ;; There might be a sublist (if the length of LIST mod n is != 0) - ;; that has to be added to the result list. - (if sublist - (setq result (cons (nreverse sublist) result))) - (nreverse result))) - -;; Routines to create indexes for submenus -;; - -;; Method 0 -;; -(defun fume-index-sublist-method-0 (sublist count) - (concat "Function sublist #" count)) - -;; Method 1 -;; Thomas Plass -;; -(defun fume-index-sublist-method-1 (sublist &rest count) - (interactive) - (let ((s (substring (car (car sublist)) 0 1)) - (e (substring (car (nth (1- (length sublist)) sublist)) 0 1))) - (format "Function sublist (%s%s)" - s (if (string-equal s e) "<>" (format "<>-%s<>" e))))) - -;; Method 2 -;; Paul Filipski & Anthony Girardin <{filipski,girardin}@blackhawk.com> -;; -(defun fume-index-sublist-method-2 (sublist &rest count) - (let ((s (substring (car (car sublist)) - 0 - (min (length (car (car sublist))) 12))) - (e (substring (car (nth (1- (length sublist)) sublist)) - 0 - (min (length (car (nth (1- (length sublist)) sublist))) - 12)))) - (format "%s%s" s (if (string-equal s e) "<>" (format "<> ... %s<>" e))))) - -;; Method 3 -;; -(defun fume-index-sublist-method-3-1 (sublist ix limit) - (let ((s1 (substring (car (car sublist)) 0 (min limit ix))) - (s2 (substring - (car (nth (1- (length sublist)) sublist)) - 0 (min (length (car (nth (1- (length sublist)) sublist))) ix)))) - (cons s1 s2))) - -(defun fume-index-sublist-method-3 (sublist &rest count) - (let* ((cmplength 12) - (limit (length (car (car sublist)))) - (result (fume-index-sublist-method-3-1 sublist cmplength limit)) - (str1 (car result)) - (str2 (cdr result))) - (while (and (string-equal str1 str2) (< cmplength limit)) - (setq cmplength (1+ cmplength) - result (fume-index-sublist-method-3-1 sublist cmplength limit) - str1 (car result) - str2 (cdr result))) - (cond ((not (string-equal str1 str2)) - (format "%s<> ... %s<>" str1 str2)) - ((< cmplength limit) - (format "%s<>" str1)) - (t - (format "%s ..." str1))))) - -;; Buffer rescanning -;; -(defun fume-rescan-buffer-trigger () - "Automatically spots when a buffer rescan becomes necessary." - (if fume-auto-rescan-buffer-p - (if (> fume-rescan-trigger-counter 0) - (setq fume-rescan-trigger-counter (1- fume-rescan-trigger-counter)) - (setq fume-rescan-trigger-counter - (max fume-rescan-trigger-counter-min - (/ (buffer-size) fume-rescan-trigger-counter-buffer-size))) - (if (or fume-funclist-dirty-p - (save-excursion - (let (find fnam) - (fume-bomb-proof - (and fume-function-name-regexp - (setq fnam (fume-function-before-point)) - (setq find (symbol-value - 'fume-find-next-function-name-method)) - (progn (end-of-line 1) - (re-search-backward - fume-function-name-regexp nil t)) - (if (eq find 'fume-find-next-latex-section-name) - (let ((lnam - (car (fume-find-next-latex-section-name - (current-buffer))))) - (fume-tex-rescan-buffer-hook) - (not (string-equal - (substring fnam - (string-match " " fnam)) - (substring lnam - (string-match " " lnam))))) - (not (string-equal - fnam - (car (funcall find (current-buffer))))))))))) - (let ((fume-scanning-message nil)) - (fume-rescan-buffer)))))) - -(defun fume-install-rescan-buffer-trigger () - (cond ((not (fume-post-command-hook-p 'fume-rescan-buffer-trigger)) - (fume-add-post-command-hook 'fume-rescan-buffer-trigger 'append) - ;; Make narrow-to-region tickle func-menu - (or (fboundp 'fume-narrow-to-region) - (fset 'fume-narrow-to-region - (symbol-function 'narrow-to-region))) - (defun narrow-to-region (b e) - "Restrict editing in this buffer to the current region. -The rest of the text becomes temporarily invisible and untouchable -but is not deleted; if you save the buffer in a file, the invisible -text is included in the file. C-x n w makes all visible again. -See also `save-restriction'. - -When calling from a program, pass two arguments; positions (integers -or markers) bounding the text that should remain visible" - (interactive "r") - (fume-narrow-to-region b e) - (if fume-funclist (setq fume-funclist-dirty-p t))) - ;; Make widen tickle func-menu - (or (fboundp 'fume-widen) - (fset 'fume-widen (symbol-function 'widen))) - (defun widen () - "Remove restrictions (narrowing) from current buffer. -This allows the buffer's full text to be seen and edited." - (interactive) - (fume-widen) - (if fume-funclist - (setq fume-funclist-dirty-p t - fume-rescan-trigger-counter 0)))))) - -(defun fume-rescan-buffer (&optional popmenu) - "Rescans the buffer for function names. -If optional arg POPMENU is non-nil, brings up the `function-menu'." - (interactive) - (let ((fnam) - (flst '()) - (buffer-to-scan (current-buffer)) - (find (symbol-value 'fume-find-next-function-name-method))) - (save-excursion - (goto-char (point-min)) - (cond (fume-scanning-message - (display-message 'progress (format fume-scanning-message 0))) - (fume-rescanning-message - (display-message 'progress fume-rescanning-message))) - (while (setq fnam - (condition-case () - (funcall find buffer-to-scan) - (error - ;; test for more possible fns after this error trap - (if (consp fume-function-name-regexp) - (save-excursion - (re-search-forward - (car fume-function-name-regexp) nil t)) - (and fume-function-name-regexp - (save-excursion - (re-search-forward - fume-function-name-regexp nil t))))))) - (cond ((listp fnam) - (setcar fnam (fume-trim-string (car fnam))) ; trim trailing crud - (setq flst (cons fnam flst)) - (if fume-found-function-hook - (save-excursion (run-hooks 'fume-found-function-hook))))) - (if fume-scanning-message - (display-message - 'progress - (format fume-scanning-message (fume-relative-position))))) - (cond (fume-scanning-message - (display-message - 'progress (format "%s done" (format fume-scanning-message 100)))) - (fume-rescanning-message - (display-message - 'progress (format "%s done" fume-rescanning-message)))) - ;; make a copy of flst sorted by position in buffer - (setq fume-modeline-funclist - (nreverse - (sort (fume-shallow-copy-list flst) 'fume-sort-by-position))) - ;; make a copy of the function positions - (setq fume-function-marks (mapcar 'cdr fume-modeline-funclist)) - (if fume-sort-function - (setq fume-funclist (sort flst fume-sort-function)) - (setq fume-funclist (nreverse flst))) - (if fume-rescan-buffer-hook - (run-hooks 'fume-rescan-buffer-hook)))) - (if popmenu - (function-menu) - (let ((fume-rescan-inhibit-p t)) - (fume-update-menubar-entry))) - ;; Reset dirty flag - (setq fume-funclist-dirty-p nil)) - -(defun fume-scan-buffer () - (or fume-funclist (progn (fume-set-defaults) (fume-rescan-buffer)))) - -;; Routine to position cursor -;; -(defun fume-goto-function (fn pos) - "Position cursor at function FN at location POS." - (let ((orig-pos (point)) - (case-fold-search nil) - (match-fn (cond ((string-match "DEFUN " fn) ; Emacs DEFUN declaration - (substring fn (match-end 0))) - ((string-match "^[ \t]*" fn) ; strip leading spaces - (substring fn (match-end 0))) - (t - fn)))) - - (save-excursion - (goto-char pos) - (or (fume-bomb-proof (looking-at (regexp-quote match-fn))) - (let ((fume-scanning-message nil)) - (fume-rescan-buffer) - (setq pos (cdr-safe (assoc fn fume-funclist)))))) - - (if pos - (progn - (goto-char pos) - ;; possibly set mark - (or (= orig-pos (point)) - (push-mark orig-pos (null fume-scanning-message))) - (cond ((numberp fume-fn-window-position) - (set-window-start - (selected-window) - (save-excursion - (beginning-of-line - (- 1 (min (- (window-height) 2) fume-fn-window-position))) - (point)))) - ((fboundp fume-goto-function-hook) - (funcall fume-goto-function-hook pos)) - (t - (recenter)))) - (ding) - (message "%s not found" fn) - (function-menu)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;; The main entry points for this package ;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Interface to function-menu for mouse bindings only -;; -(defun mouse-function-menu (event) - "Wrapper for mouse button bindings for function-menu." - (interactive "e") - (let ((currwin (selected-window))) - (condition-case () - (progn - (select-window (fume-event-window event)) - (let ((fume-auto-position-popup nil)) - (call-interactively 'function-menu))) - (error (select-window currwin))))) - -;; Interface for Key bindings -;; -;;;###autoload -(defun function-menu (&optional use-menubar return-only menu-item-function) - "Pop up a menu of buffer local functions and related commands. -Each function menu entry jumps to its named function. Prior to a jump, a -mark is set so that {C-u \\[set-mark-command]} will move point back to the -old location. - -With optional prefix argument USE-MENUBAR, add the menu to the current -menubar. With optional second argument RETURN-ONLY, return the menu -of functions but do not display it. - -With optional third argument MENU-ITEM-FUNCTION, use this as the function -called by each menu item (default = 'fume-goto-function). This function -must take two arguments, function menu item name (a string) and the position -\(an integer) within the buffer to leave point when displaying this menu item." - (interactive "P") - - (setq use-menubar - (and use-menubar fume-running-xemacs fume-not-tty current-menubar t)) - - (catch 'no-functions - (or (fume-set-defaults) - (if (not (interactive-p)) - (throw 'no-functions t) - (error "func-menu does not support the mode \"%s\"" mode-name))) - - ;; Create a list for this buffer only if there isn't any. - (or fume-funclist - (if fume-rescan-inhibit-p - (fume-remove-menubar-entry) - (fume-rescan-buffer))) - (or fume-funclist - (if (not (interactive-p)) - (throw 'no-functions t) - (error "No functions found in this buffer"))) - - ;; Rescan buffer trigger - (fume-install-rescan-buffer-trigger) - - ;; Function name in modeline - (fume-maybe-install-modeline-feature) - - (or menu-item-function (setq menu-item-function 'fume-goto-function)) - ;; The rest of this routine works only for (Lucid) XEmacs - (cond (fume-running-xemacs - ;; Create the menu - (let* ((count 0) - (index-method - (intern-soft (format "fume-index-sublist-method-%d" - fume-index-method))) - function-menu - (function-menu-items - (mapcar - (function - (lambda (sublist) - (setq count (1+ count)) - (cons - (format "%s" (funcall index-method sublist count)) - (mapcar - (function - (lambda (menu) - (vector - (fume-trim-string (format "%s" (car menu)) "&") - (list menu-item-function (car menu) (cdr menu)) - t))) - sublist)))) - (fume-split fume-funclist fume-max-items)))) - - (or (> count 1) - (setq function-menu-items (cdr (car function-menu-items)))) - - (if return-only - nil - (setq function-menu - (` ((,@ function-menu-items) - "----" - ["Display full list of functions" - fume-list-functions t] - ;; Bill Dubuque - ;; This doesn't work with the old backquote.el - ;;[(, (concat "Rescan buffer : " (buffer-name))) - ;; (fume-rescan-buffer (, (null use-menubar))) t] - (, (vector - (concat "Rescan buffer : " (buffer-name)) - (list 'fume-rescan-buffer (null use-menubar)) - t)) - "----" - ["Go to next function" - fume-goto-next-function t] - ["Go to previous function" - fume-goto-previous-function t] - "----" - ["Toggle modeline display" - fume-toggle-modeline-display t] - ["Toggle buffer auto rescanning" - fume-toggle-auto-rescanning t] - ["About Func-Menu" fume-about t]))) - - (cond (use-menubar - (fume-remove-menubar-entry) - (set-buffer-menubar (copy-sequence current-menubar)) - (fume-add-submenu - fume-menubar-menu-name - (` ((,@ function-menu) - "----" - ["Remove Function Menu from menubar" - fume-remove-menubar-entry t])) - fume-menubar-menu-location)) - - ((and fume-not-tty ; trap tty segmentation faults... - (not (popup-up-p))) - (or (fume-update-menubar-entry) - (setq function-menu - (cons - ["Put Function Menu into menubar" - (function-menu t) t] - (cons "----" function-menu)))) - - (if fume-auto-position-popup - (fume-set-mouse-position)) - - (popup-menu - (cons fume-menubar-menu-name function-menu))))) - - ;; Return basic function menu for display by another function - function-menu-items))))) - -(defun fume-mouse-function-goto (event) - "Goto function clicked on or prompt with completion in the minibuffer." - (interactive "@e") - (let ((orig-pos (point)) - (event-point (event-point event))) - (if (not event-point) - (message "Please click on some text.") - (goto-char event-point) - (let ((fume-no-prompt-on-valid-default t)) - (fume-prompt-function-goto)) - (or (= orig-pos (point)) - (push-mark orig-pos (null fume-scanning-message)))) - )) - -(defun fume-goto-next-function () - "Goto next function in current buffer." - (interactive) - (let ((where (point)) - ;; note that `fume-function-marks' is in reverse order - (marks (reverse fume-function-marks))) - (while (and marks (<= (car marks) where)) - (pop marks)) - (and marks (goto-char (car marks))) - )) - -(defun fume-goto-previous-function () - "Goto previous function in current buffer." - (interactive) - (let ((where (point)) - ;; note that `fume-function-marks' is already in reverse order - (marks fume-function-marks)) - (while (and marks (>= (car marks) where)) - (pop marks)) - (and marks (goto-char (car marks))) - )) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;; Keyboard access to func-menu for tty users ;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Internal variables only -;; -(defvar fume-list-srcbuffer nil) -(defvar fume-list-reused-win-p nil) -(defvar fume-list-trampled-buffer nil) - -;; Espen Skoglund -;; David Hughes -;; -(defun fume-prompt-function-goto (&optional other-window-p prompt) - "Goto a function prompted for with completion in the minibuffer. -With optional prefix argument OTHER-WINDOW-P, jump to the function in a -different window. PROMPT (useful for wrapper functions) must be a format -string with two `%s' elements." - (interactive "P") - (let* ((default-name (fume-what-looking-at t)) - (OrigBuffer (current-buffer)) - (flistMode (eq major-mode 'fume-list-mode)) - (no-prompt (or flistMode fume-no-prompt-on-valid-default)) - (TargetBuffer (if flistMode fume-list-srcbuffer OrigBuffer))) - (switch-to-buffer TargetBuffer) - (fume-scan-buffer) ;; Create funclist and set defaults if required - (let* (;; verify default-name is a valid function name - (default-exists-p (assoc default-name fume-funclist)) - ;; Prompt for function name in minibuffer, unless there is a valid - ;; function name at point & fume-no-prompt-on-valid-default set to t - (function-name - (if (and default-exists-p no-prompt) - "" - (let ((this-command last-command)) ; preserve last-command - (completing-read - (format (or prompt "Goto function%s%s: ") - (if other-window-p " other window" "") - (if default-exists-p - (concat " (" default-name ")") - "")) - fume-funclist nil t)))) - ;; Use default function name if just RET was pressed - (function-name (if (and default-exists-p (string= "" function-name)) - default-name - function-name))) - (switch-to-buffer OrigBuffer) - ;; Goto function or just return if function name is empty string - (cond ((not (string= "" function-name)) - (if other-window-p - (cond ((prog1 (one-window-p) - (if (not (windowp other-window-p)) - (switch-to-buffer-other-window TargetBuffer) - (select-window other-window-p) - (switch-to-buffer TargetBuffer))) - (other-window 1) - (shrink-window-if-larger-than-buffer) - (other-window 1))) - (switch-to-buffer TargetBuffer)) - (fume-goto-function - function-name (cdr (assoc function-name fume-funclist)))))))) - -(defun fume-prompt-function-goto-one-window () - (interactive) - (delete-other-windows) - (fume-prompt-function-goto)) - -(defun fume-prompt-function-goto-other-window () - (interactive) - (fume-prompt-function-goto t)) - -(defun fume-list-functions-show-fn-other-window (&optional window) - (interactive) - (beginning-of-line) - (select-window - (prog1 (selected-window) (fume-prompt-function-goto (or window t))))) - -(defun fume-list-functions-show-prev-fn-other-window (&optional window) - (interactive) - (forward-line -1) - (fume-list-functions-show-fn-other-window window)) - -(defun fume-list-functions-show-next-fn-other-window (&optional window) - (interactive) - (forward-line 1) - (beginning-of-line) - (fume-list-functions-show-fn-other-window window)) - -(defun fume-list-functions-help () - (interactive) - (fume-about) - (sit-for 1) - (display-message - 'prompt - (format "SPC=%s, p=%s, n=%s, o=%s, G=%s, RET=%s, q=%s" - "this" - "previous" - "next" - "other win" - "one win" - "this win" - "quit"))) - -(defun fume-list-functions-quit () - (interactive) - (if (eq major-mode 'fume-list-mode) - (kill-buffer (current-buffer))) - (if fume-list-reused-win-p - (fume-bomb-proof (switch-to-buffer fume-list-trampled-buffer)) - (or (one-window-p) - (delete-window (selected-window)))) - (if (not (eq (current-buffer) fume-list-srcbuffer)) - (condition-case () - (select-window (get-buffer-window fume-list-srcbuffer)) - (error (fume-bomb-proof (switch-to-buffer fume-list-srcbuffer)))))) - -(defun fume-list-mouse-select (event) - (interactive "e") - (let (ws cb cp (wc (current-window-configuration))) - (mouse-set-point event) - (fume-prompt-function-goto-other-window) - (setq ws (save-excursion - (beginning-of-line (- 1 fume-fn-window-position)) (point)) - cb (current-buffer) - cp (point)) - (set-window-configuration wc) - (switch-to-buffer cb) - (set-window-start (selected-window) ws) - (goto-char cp))) - -(defvar fume-list-mode-map nil) -(or fume-list-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "q" 'fume-list-functions-quit) - (define-key map "h" 'fume-list-functions-help) - (define-key map "?" 'fume-list-functions-help) - (define-key map "g" 'fume-prompt-function-goto) - (define-key map "\C-m" 'fume-prompt-function-goto) - (define-key map "G" 'fume-prompt-function-goto-one-window) - (define-key map "o" 'fume-prompt-function-goto-other-window) - (define-key map " " 'fume-list-functions-show-fn-other-window) - (define-key map "p" 'fume-list-functions-show-prev-fn-other-window) - (define-key map "n" 'fume-list-functions-show-next-fn-other-window) - (if fume-not-tty - (define-key map [(button2)] 'fume-list-mouse-select)) - (setq fume-list-mode-map map))) - -(defvar fume-list-mode-hook nil "*Hook to run after fume-list-mode entered.") - -(defun fume-list-functions (&optional this-window) - "Creates a temporary buffer listing functions found in the current buffer." - (interactive "P") - (fume-scan-buffer) ;; Create funclist and set defaults if required - (let ((func-near-point (fume-function-before-point))) - (if func-near-point - (setq func-near-point (fume-substitute func-near-point "\\[" "\\[" t) - func-near-point (fume-substitute func-near-point "\\]" "\\]" t) - func-near-point (format "^%s$" func-near-point))) - (or fume-function-name-regexp - (fume-maybe-install-modeline-feature) - (error "Func-Menu is not operative in this buffer")) - (save-excursion - (let ((srcbuffer (current-buffer))) - (set-buffer (get-buffer-create fume-buffer-name)) - (let (buffer-read-only) (erase-buffer)) - (fume-list-mode) - (setq fume-list-srcbuffer srcbuffer - fume-list-reused-win-p (not (one-window-p))))) - (or fume-funclist (fume-rescan-buffer)) - (if fume-funclist - (mapcar - (function - (lambda (p) - (save-excursion - (set-buffer fume-buffer-name) - (let (buffer-read-only) - (goto-char (point-max)) - (insert (concat (if (< (point-min) (point)) "\n") (car p))) - (set-buffer-modified-p nil) - (goto-char (point-min)))))) - fume-funclist)) - (cond ((interactive-p) - (if current-prefix-arg - (switch-to-buffer fume-buffer-name) - (setq fume-list-trampled-buffer (window-buffer (next-window))) - (switch-to-buffer-other-window fume-buffer-name) - (or fume-list-reused-win-p - (shrink-window-if-larger-than-buffer))) - (cond (func-near-point - (re-search-forward func-near-point nil t) - (beginning-of-line))) - (fume-list-functions-help))))) - -(defun fume-list-mode () - "Major mode for jumping from a list of buffer functions to a function -definition. - -\\{fume-list-mode-map}" - (use-local-map fume-list-mode-map) - (setq buffer-read-only t - mode-name "Func-Menu" - major-mode 'fume-list-mode) - (if fume-not-tty - (setq mode-motion-hook 'mode-motion-highlight-symbol)) - (run-hooks 'fume-list-mode-hook)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;; func-menu minor mode ;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defcustom fume-mode-line-string " Func" - "*String to use in the modeline when func-menu minor mode is active." - :group 'fume - :type 'string) - -(defcustom fume-mode-hook nil - "*Hooks to run after setting up func-menu minor mode." - :group 'fume - :type 'hook) - -(defvar fume-mode-map - (let ((map (make-sparse-keymap 'fume-minor-mode-map))) - (define-key map [(control c) (control f) f] 'function-menu) - (define-key map [(control c) (control f) l] 'fume-list-functions) - (define-key map [(control c) (control f) r] 'fume-rescan-buffer) - (define-key map [(control c) (control f) R] 'fume-toggle-auto-rescanning) - (define-key map [(control c) (control f) p] 'fume-goto-previous-function) - (define-key map [(control c) (control f) n] 'fume-goto-next-function) - (define-key map [(control c) (control f) g] 'fume-prompt-function-goto) - (define-key map [(control c) (control f) D] 'fume-toggle-modeline-display) - (define-key map [(control c) (control f) h] 'fume-about) - (define-key map [(control c) (control f) ??] 'fume-about) - (define-key map '(meta button3) 'mouse-function-menu) - (define-key map '(meta button1) 'fume-mouse-function-goto) - map) - ;; fume minor mode keymap. - ) - -(make-variable-buffer-local - (defvar fume-mode nil)) - -;;;###autoload -(defun fume-mode (arg) - "Toggle the func menu minor mode on/off. -With a prefix numeric value or ARG > 0, turn it on. -The variable `fume-mode-line-string' defines what you will see in the -modeline when the mode is on. - -Note: if you had been using - -\\{fume-mode-map}" - (interactive "P") - (let ((turn-it-on (if (null arg) (not fume-mode) - (> (prefix-numeric-value arg) 0)))) - (cond ((and turn-it-on (not fume-mode)) ;; turn it on - (function-menu t) - (setq fume-mode t) - (run-hooks 'fume-mode-hook)) - ((and (not turn-it-on) fume-mode) ;; turn it off - (fume-remove-menubar-entry) - (setq fume-mode nil))) - (redraw-modeline))) - -(add-minor-mode 'fume-mode fume-mode-line-string fume-mode-map) - -;;;###autoload -(defun turn-on-fume-mode () - "Unconditionaly turn the func menu minor mode on." - (interactive) - (fume-mode 1)) - -(defun turn-off-fume-mode () - "Unconditionaly turn the func menu minor mode off." - (interactive) - (fume-mode 0)) - -;;;###autoload -(defun fume-setup-buffer (&optional force) - "Setup the current buffer for func-menu. -This actually means prepare for turning `fume-mode' on. - -If you've been using func-menu the old way (before `fume-mode' was -written), please note that `mouse-function-menu' is bound to M-Button3 -(not Shift-Button3) in this mode. Nothing prevents you from keeping your -old binding though. - -This function is meant to be added to `find-file-hooks'. -If FORCE is non-nil, actually do the operation now; otherwise, -delay until the next time the event loop is processed (this is -so that Lisp routines that temporarily load a file, process it, -and then kill it will not be slowed down by `function-menu' processing)." - (interactive) - (if force - (turn-on-fume-mode) - (enqueue-eval-event 'fume-do-setup-buffer (current-buffer)))) - -(defun fume-do-setup-buffer (buffer) - (and (buffer-live-p buffer) - (save-excursion - (save-window-excursion - (set-buffer buffer) - (turn-on-fume-mode))))) - -(provide 'func-menu) - -;;; func-menu.el ends here diff --git a/xemacs-packages/lisp/edit-utils/highline.el b/xemacs-packages/lisp/edit-utils/highline.el deleted file mode 100644 index eaaec172..00000000 --- a/xemacs-packages/lisp/edit-utils/highline.el +++ /dev/null @@ -1,882 +0,0 @@ -;; Copyright (C) 2000, 2001, 2002 Vinicius Jose Latorre - -;; Author: Vinicius Jose Latorre -;; Maintainer: Vinicius Jose Latorre -;; Keywords: faces, frames, editing -;; Time-stamp: <2002/12/17 14:01:52 vinicius> -;; Version: 4.2 -;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ - -;; 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: - -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Introduction -;; ------------ -;; -;; This package is a minor mode to highlight the current line in buffer. -;; -;; highline was inspired on: -;; -;; linemenu.el Bill Brodie -;; Hook function to highlight current line in buffer. -;; -;; hl-line.el Dave Love -;; Highlight the current line. -;; -;; highlight-current-line.el Christoph Conrad -;; Highlight line where the cursor is. -;; -;; To use highline, insert in your ~/.emacs: -;; -;; (require 'highline) -;; -;; For good performance, be sure to byte-compile highline.el, e.g. -;; -;; M-x byte-compile-file -;; -;; This will generate highline.elc, which will be loaded instead of -;; highline.el. -;; -;; highline was tested with GNU Emacs 20.4.1. -;; -;; -;; Using highline -;; -------------- -;; -;; * LOCAL highline (see NOTE 1 below): -;; + To activate highline locally, type: -;; M-x highline-on RET -;; Or: -;; C-u 1 M-x highline-local-mode RET -;; -;; + To deactivate highline locally, type: -;; M-x highline-off RET -;; Or: -;; C-u 0 M-x highline-local-mode RET -;; -;; + To toggle highline locally, type: -;; M-x highline-local-mode RET -;; -;; * GLOBAL highline (see NOTE 1 below): -;; + To activate highline globally, type: -;; M-x highline-mode-on RET -;; Or: -;; C-u 1 M-x highline-mode RET -;; -;; + To deactivate highline globally, type: -;; M-x highline-mode-off RET -;; Or: -;; C-u 0 M-x highline-mode RET -;; -;; + To toggle highline globally, type: -;; M-x highline-mode RET -;; -;; * INDIRECT highline (see NOTE 2 below): -;; + To activate indirect highline, type: -;; M-x highline-view-on RET -;; Or: -;; C-u 1 M-x highline-view-mode RET -;; -;; + To deactivate indirect highline, type: -;; M-x highline-view-off RET -;; Or: -;; C-u 0 M-x highline-view-mode RET -;; -;; + To toggle indirect highline, type: -;; M-x highline-view-mode RET -;; -;; * To customize highline, type: -;; M-x highline-customize RET -;; -;; You can also bind `highline-local-mode', `highline-mode', `highline-on', -;; `highline-off', `highline-mode-on', `highline-mode-off', -;; `highline-customize', `highline-view-on', `highline-view-off' and -;; `highline-view-mode' to some key, like: -;; -;; (global-set-key "\C-c\C-a" 'highline-on) -;; (global-set-key "\C-c\C-b" 'highline-off) -;; (global-set-key "\C-c\C-l" 'highline-local-mode) -;; (global-set-key "\C-c\C-d" 'highline-mode-on) -;; (global-set-key "\C-c\C-e" 'highline-mode-off) -;; (global-set-key "\C-c\C-g" 'highline-mode) -;; (global-set-key "\C-c\C-c" 'highline-customize) -;; (global-set-key "\C-c\C-v\C-n" 'highline-view-on) -;; (global-set-key "\C-c\C-v\C-f" 'highline-view-off) -;; (global-set-key "\C-c\C-v\C-t" 'highline-view-mode) -;; -;; NOTE 1: There is no problem if you mix local and global minor mode usage. -;; -;; NOTE 2: Indirect highline (`highline-view-on', `highline-view-off' and -;; `highline-view-mode') is useful when you wish to have various -;; "visions" of the same buffer. -;; Indirect highline uses an indirect buffer to get the "vision" of the -;; buffer. So, if you kill an indirect buffer, the base buffer is not -;; affected; if you kill the base buffer, all indirect buffer related -;; with the base buffer is automagicaly killed. Also, any text -;; insertion/deletion in any indirect or base buffer is updated in all -;; related buffers. -;; -;; -;; Example -;; ------- -;; -;; As an example, try to insert this in your .emacs file: -;; -;; (require 'highline) -;; ;; Turn on local highlighting for Dired (C-x d) -;; (add-hook 'dired-after-readin-hook 'highline-on) -;; ;; Turn on local highlighting for list-buffers (C-x C-b) -;; (defadvice list-buffers (after highlight-line activate) -;; (save-excursion -;; (set-buffer "*Buffer List*") -;; (highline-on))) -;; -;; -;; Hooks -;; ----- -;; -;; highline has the following hook variables: -;; -;; `highline-hook' -;; It is evaluated always when highline is turned on globally. -;; -;; `highline-local-hook' -;; It is evaluated always when highline is turned on locally. -;; -;; `highline-view-hook' -;; It is evaluated always when indirect highline is turned on. -;; -;; `highline-load-hook' -;; It is evaluated after highline package is loaded. -;; -;; -;; Options -;; ------- -;; -;; Below it's shown a brief description of highline options, please, see the -;; options declaration in the code for a long documentation. -;; -;; `highline-face' Specify face used to highlight the -;; current line. -;; -;; `highline-vertical-face' Specify face used to highlight other -;; than current line. -;; -;; `highline-line' Specify which part of line should be -;; highlighted. -;; -;; `highline-vertical' Specify how many vertical lines should -;; be highlighted. -;; -;; `highline-verbose' Non-nil means generate messages. -;; -;; `highline-ignore-regexp' Specify regexp for buffers to ignore. -;; -;; `highline-priority' Specify highline overlay priority. -;; -;; `highline-selected-window' Non-nil means highlight current line on -;; current window. -;; -;; To set the above options you may: -;; -;; a) insert the code in your ~/.emacs, like: -;; -;; (setq highline-face 'highlight) -;; -;; 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 highline-face RET highlight 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 *Editing* group, -;; expand *Highline* group -;; and then customize highline 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 highline-face 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 highline-customize RET -;; -;; and then customize highline options. -;; Through this way, you may choose if the settings are kept or not when -;; you leave out the current Emacs session. -;; -;; -;; Acknowledgements -;; ---------------- -;; -;; Thanks to Sandip Chitale for byte-compilation -;; tests. -;; -;; Thanks to Stephan Engelke for XEmacs tests. -;; -;; Thanks to Roman Belenov for `pre-command-hook' -;; suggestion. -;; -;; Thanks to Trey Jackson for `highline-line' -;; enhancements. -;; -;; Thanks to Fredrik Sundstroem for permanent-local -;; overlay property indication. -;; -;; Thanks to: -;; Bill Brodie linemenu.el -;; Dave Love hl-line.el -;; Christoph Conrad highlight-current-line.el -;; And to all people who contributed with them. -;; -;; -;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Code: - - -(eval-and-compile - (cond - ;; XEmacs - ((let (case-fold-search) - (string-match "XEmacs\\|Lucid\\|Epoch" emacs-version)) - ;; XEmacs needs overlay emulation package - (or (require 'overlay) - (error "`highline' requires `overlay' package.")) - (defun highline-alive-overlay (overlay-list) - "Enforce that the car of OVERLAY-LIST isn't a deleted overlay." - (when overlay-list - (or (overlay-buffer (car overlay-list)) - (setcar overlay-list (make-overlay 1 1))) - overlay-list)) - (defun highline-move-overlay (overlay start end) - "Move overlay even if the overlay is deleted." - (and (overlay-buffer overlay) - (move-overlay overlay start end))) - ) - ;; GNU Emacs - (t - (defalias 'highline-alive-overlay 'identity) - (defalias 'highline-move-overlay 'move-overlay) - ))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; User Variables: - - -;;; Interface to the command system - -(defgroup highline nil - "Highlight the current line" - :link '(emacs-library-link :tag "Source Lisp File" "highline.el") - :group 'faces - :group 'frames - :group 'editing) - - -(defcustom highline-face 'highline-face - "*Specify face used to highlight the current line." - :type 'face - :group 'highline) - - -(defface highline-face '((t (:background "paleturquoise"))) - "Face used to highlight current line.") - - -(defcustom highline-vertical-face 'highline-vertical-face - "*Specify face used to highlight other than current line. - -See also `highline-vertical'." - :type 'face - :group 'highline) - - -(defface highline-vertical-face '((t (:background "lightcyan"))) - "Face used to highlight other than current line.") - - -(defcustom highline-line nil - "*Specify which part of line should be highlighted. - -Valid values are: - - t mark up to end of line. - - nil mark up to window border. On XEmacs, it behaves as t. - NOTE: Let me know, if you find a way to mark up to - window border on XEmacs. - - INTEGER mark up from beginning of line to column INTEGER or to - end of line if INTEGER exceeds line length. If INTEGER - is negative, the region marked starts from end of line - instead of beginning of line. - - (LOWER . UPPER) mark up the region from column LOWER to column UPPER or - to end of line if UPPER exceeds line length. Nothing - happens if LOWER exceeds line length. - It must: 0 <= LOWER < UPPER. - - (beyond . INTEGER) mark up the region from column INTEGER to end of line. - Nothing happens if INTEGER exceeds line length. - It must: INTEGER > 0. - - (point . INTEGER) mark up the region from column - (- (current-column) INTEGER) to column - (+ (current-column) INTEGER). It never goes beyond - beginning or end of line. - It must: INTEGER > 0. - -Any other value is treated as t." - :type '(choice :menu-tag "Mark Up To" - :tag "Mark Up To" - (const :tag "End Of Line" t) - (const :tag "Window Border" nil) - (integer :tag "Column") - (cons :tag "Point" :value (point . 0) - (const :tag "Point" point) - (integer :tag "To")) - (cons :tag "Beyond" :value (beyond . 0) - (const :tag "Beyond" beyond) - (integer :tag "From")) - (cons :tag "Range" :value (0 . 0) - (integer :tag "From") - (integer :tag "To"))) - :group 'highline) - - -(defcustom highline-vertical nil - "*Specify how many vertical lines should be highlighted. - -Valid values are: - - nil Highlight only current line. - - t Highlight all current window. - - (ABOVE . BELOW) Highlight the vertical range from line - (current-line-number - ABOVE) to line - (current-line-number + BELOW). ABOVE and BELOW should - be integers. There are the following cases: - - 1. ABOVE <= 0 and BELOW <= 0 - This is the same as nil, that is, only current - line is highlighted. It's recommended to set - `highline-vertical' to nil instead of (0 . 0), - it'll have a better performance. - - 2. ABOVE <= 0 and BELOW > 0 - Only current line and lines below will be - highlighted. - - 3. ABOVE > 0 and BELOW <= 0 - Only current line and lines above will be - highlighted. - - 4. ABOVE > 0 and BELOW > 0 - Current line, lines above and lines below will - be highlighted. - -Any other value is treated as t." - :type '(choice :menu-tag "" - :tag "" - (const :tag "Only Current Line" nil) - (const :tag "All Current Window" t) - (cons :tag "Vertical Range" :value (1 . 1) - (integer :tag "Above") - (integer :tag "Below"))) - :group 'highline) - - -(defcustom highline-verbose t - "*Non-nil means generate messages." - :type 'boolean - :group 'highline) - - -(defcustom highline-ignore-regexp - (concat "Faces\\|Colors\\|Minibuf\\|\\*tip\\*" - ;; for example: - ;; "\\|RMAIL.*summary\\|\\*Group\\|\\*Summary" - ) - "*Specify regexp for buffers to ignore. - -Set to nil or \"\", to accept any buffer. - -Used by `highline-highlight-current-line'." - :type 'regexp - :group 'highline) - - -(defcustom highline-priority 0 - "*Specify highline overlay priority. - -Higher integer means higher priority, so highline overlay will have precedence -over overlays with lower priority. *Don't* use negative number." - :type 'integer - :group 'highline) - - -(defcustom highline-selected-window nil - "*Non-nil means highlight current line on current window. - -This is useful when you have a buffer in two or more windows and wish to -highlight only on current window." - :type 'boolean - :group 'highline) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;; GNU Emacs -(or (fboundp 'line-beginning-position) - (defun line-beginning-position (&optional n) - (save-excursion - (and n (/= n 1) (forward-line (1- n))) - (beginning-of-line) - (point)))) - - -;; GNU Emacs -(or (fboundp 'line-end-position) - (defun line-end-position (&optional n) - (save-excursion - (and n (/= n 1) (forward-line (1- n))) - (end-of-line) - (point)))) - -;; GNU Emacs -(defvar highlight-nonselected-window nil) -(make-variable-buffer-local 'highlight-nonselected-window) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Macros - - -(defmacro highline-message (&rest body) - `(and highline-verbose (interactive-p) - (message ,@body))) - - -(defmacro highline-minor-mode (arg mode on off message) - `(progn - (if (if arg - (> (prefix-numeric-value arg) 0) - (not ,mode)) - (,on) - (,off)) - (highline-message ,message (if ,mode "on" "off")))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Customization - - -;;;###autoload -(defun highline-customize () - "Customize highline group." - (interactive) - (customize-group 'highline)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; User commands - - -(defvar highline-mode nil - "Non-nil means highline global minor mode is enabled (HL on modeline).") - - -(defvar highline-local-mode nil - "Non-nil means highline local minor mode is enabled (hl on modeline).") -(make-variable-buffer-local 'highline-local-mode) - - -(defvar highline-view-mode nil - "Non-nil means highline view minor mode is enabled (Ihl on modeline).") -(make-variable-buffer-local 'highline-view-mode) - - -(defvar highline-overlays nil - "Overlay list to highlight line(s)") -(make-variable-buffer-local 'highline-overlays) - -(put 'highline-overlays 'permanent-local t) - - -;;;###autoload -(defun highline-mode (&optional arg) - "Toggle global minor mode to highlight line about point (HL on modeline). - -With ARG, turn highline mode on if ARG is positive, off otherwise. -Only useful with a windowing system." - (interactive "P") - (highline-minor-mode arg highline-mode - highline-mode-on highline-mode-off - "Highline global mode is %s")) - - -;;;###autoload -(defun highline-mode-on () - "Turn on global minor mode to highlight line about point (HL on modeline)." - (interactive) - (save-excursion - (let ((buffers (buffer-list)) - (temp (get-buffer-create (make-temp-name " *Temp")))) - ;; be sure to access global `pre-command-hook' and `post-command-hook' - (set-buffer temp) - (setq highline-mode t) - (add-hook 'mouse-leave-buffer-hook 'highline-unhighlight-current-line) - (add-hook 'pre-command-hook 'highline-unhighlight-current-line) - (add-hook 'post-command-hook 'highline-highlight-current-line) - (add-hook 'window-scroll-functions 'highline-highlight-current-line) - (while buffers ; adjust all local mode - (set-buffer (car buffers)) - (unless highline-local-mode - (add-hook 'pre-command-hook 'highline-unhighlight-current-line nil t) - (add-hook 'post-command-hook 'highline-highlight-current-line nil t) - (add-hook 'window-scroll-functions - 'highline-highlight-current-line nil t) - (highline-highlight-current-line)) - (setq buffers (cdr buffers))) - (highline-highlight-current-line) - (kill-buffer temp))) - (run-hooks 'highline-hook) - (highline-message "Highline global mode is on")) - - -;;;###autoload -(defun highline-mode-off () - "Turn off global minor mode to highlight line about point (HL on modeline)." - (interactive) - (save-excursion - (let ((buffers (buffer-list)) - (temp (get-buffer-create (make-temp-name " *Temp")))) - ;; be sure to access global `pre-command-hook' and `post-command-hook' - (set-buffer temp) - (setq highline-mode nil) - (remove-hook 'mouse-leave-buffer-hook 'highline-unhighlight-current-line) - (remove-hook 'pre-command-hook 'highline-unhighlight-current-line) - (remove-hook 'post-command-hook 'highline-highlight-current-line) - (remove-hook 'window-scroll-functions 'highline-highlight-current-line) - (while buffers ; adjust all local mode - (set-buffer (car buffers)) - (unless highline-local-mode - (remove-hook 'pre-command-hook 'highline-unhighlight-current-line t) - (remove-hook 'post-command-hook 'highline-highlight-current-line t) - (remove-hook 'window-scroll-functions - 'highline-highlight-current-line t) - (highline-unhighlight-current-line)) - (setq buffers (cdr buffers))) - (kill-buffer temp))) - (highline-message "Highline global mode is off")) - - -;;;###autoload -(defun highline-local-mode (&optional arg) - "Toggle local minor mode to highlight the line about point (hl on modeline). - -With ARG, turn highline mode on if ARG is positive, off otherwise. -Only useful with a windowing system." - (interactive "P") - (highline-minor-mode arg highline-local-mode - highline-on highline-off - "Highline local mode is %s")) - - -;;;###autoload -(defun highline-on () - "Turn on local highlighting of the current line in buffer (hl on modeline)." - (interactive) - (setq highline-local-mode t) - (highline-local-on) - (run-hooks 'highline-local-hook) - (highline-message "Highline local mode is on")) - - -;;;###autoload -(defun highline-off () - "Turn off local highlighting of the current line in buffer (hl on modeline)." - (interactive) - (setq highline-local-mode nil) - (highline-local-off) - (highline-message "Highline local mode is off")) - - -;;;###autoload -(defun highline-view-mode (&optional arg) - "Toggle indirect mode to highlight current line in buffer (Ihl on modeline). - -With ARG, turn highline mode on if ARG is positive, off otherwise. -Only useful with a windowing system. - -Indirect highline (`highline-view-on', `highline-view-off' and -`highline-view-mode') is useful when you wish to have various \"visions\" of -the same buffer. - -Indirect highline uses an indirect buffer to get the \"vision\" of the buffer. -So, if you kill an indirect buffer, the base buffer is not affected; if you -kill the base buffer, all indirect buffer related with the base buffer is -automagicaly killed. Also, any text insertion/deletion in any indirect or base -buffer is updated in all related buffers. - -See also `highline-selected-window'." - (interactive "P") - (highline-minor-mode arg highline-view-mode - highline-view-on highline-view-off - "Highline view mode is %s")) - - -;;;###autoload -(defun highline-view-on () - "Turn on indirect highlightining current line in buffer (Ihl on modeline). - -Indirect highline (`highline-view-on', `highline-view-off' and -`highline-view-mode') is useful when you wish to have various \"visions\" of -the same buffer. - -Indirect highline uses an indirect buffer to get the \"vision\" of the buffer. -So, if you kill an indirect buffer, the base buffer is not affected; if you -kill the base buffer, all indirect buffer related with the base buffer is -automagicaly killed. Also, any text insertion/deletion in any indirect or base -buffer is updated in all related buffers. - -See also `highline-selected-window'." - (interactive) - (let* ((local-buffer-read-only buffer-read-only) - (buffer (current-buffer)) - (name (generate-new-buffer-name - (concat "{" - (buffer-name (or (buffer-base-buffer buffer) buffer)) - " View}")))) - (switch-to-buffer (make-indirect-buffer buffer name)) - (setq buffer-read-only local-buffer-read-only)) - (setq highline-view-mode t) - (highline-local-on) - (run-hooks 'highline-view-hook) - (highline-message "Highline view mode is on")) - - -;;;###autoload -(defun highline-view-off () - "Turn off indirect highlightining current line in buffer (Ihl on modeline). - -Indirect highline (`highline-view-on', `highline-view-off' and -`highline-view-mode') is useful when you wish to have various \"visions\" of -the same buffer. - -Indirect highline uses an indirect buffer to get the \"vision\" of the buffer. -So, if you kill an indirect buffer, the base buffer is not affected; if you -kill the base buffer, all indirect buffer related with the base buffer is -automagicaly killed. Also, any text insertion/deletion in any indirect or base -buffer is updated in all related buffers. - -See also `highline-selected-window'." - (interactive) - (when highline-view-mode - (setq highline-view-mode nil) - (highline-local-off) - (let* ((buffer (current-buffer)) - (base (buffer-base-buffer buffer))) - (when base - (kill-buffer buffer) - (switch-to-buffer base))) - (highline-message "Highline view mode is off"))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Internal functions - - -(defun highline-local-on () - (add-hook 'mouse-leave-buffer-hook 'highline-unhighlight-current-line) - (add-hook (make-local-variable 'pre-command-hook) - 'highline-unhighlight-current-line nil t) - (add-hook (make-local-variable 'post-command-hook) - 'highline-highlight-current-line nil t) - (add-hook (make-local-variable 'window-scroll-functions) - 'highline-highlight-current-line nil t) - (highline-highlight-current-line)) - - -(defun highline-local-off () - (remove-hook 'mouse-leave-buffer-hook 'highline-unhighlight-current-line) - (remove-hook 'pre-command-hook 'highline-unhighlight-current-line t) - (remove-hook 'post-command-hook 'highline-highlight-current-line t) - (remove-hook 'window-scroll-functions 'highline-highlight-current-line t) - (highline-unhighlight-current-line)) - - -(defsubst highline-column-position (column) - (save-excursion - (move-to-column (max 0 column)) - (point))) - - -(defun highline-unhighlight-current-line (&rest ignore) - "Unhighlight current line." - (let ((overs highline-overlays)) - (while (and overs - (overlay-end (car overs)) - (> (overlay-end (car overs)) 1)) - (highline-move-overlay (car overs) 1 1) - (setq overs (cdr overs))))) - - -(defun highline-highlight-current-line (&rest ignore) - "Highlight current line." - (unless (and highline-ignore-regexp - (not (equal "" highline-ignore-regexp)) - (string-match highline-ignore-regexp (buffer-name))) - (setq highlight-nonselected-window (not highline-selected-window)) - (save-excursion - (let* ((column (current-column)) - (overs highline-overlays) - (lines (highline-vertical)) - (current-line (cdr lines))) - (setq lines (car lines)) - (while (let ((ov (car (or (highline-alive-overlay overs) - (setq highline-overlays - (cons (make-overlay 1 1) ; hide it - highline-overlays))))) - pointp rangep beyondp) - (setq overs (cdr overs)) - ;; set current overlay properties - (overlay-put ov 'hilit t) - (overlay-put ov 'face (if (= lines current-line) - highline-face - highline-vertical-face)) - (overlay-put ov 'priority highline-priority) - (and highline-selected-window - (overlay-put ov 'window (selected-window))) - ;; move highlight to the current line - (and (consp highline-line) - (integerp (cdr highline-line)) - (> (cdr highline-line) 0) - (or (setq beyondp (eq (car highline-line) 'beyond)) - (setq pointp (eq (car highline-line) 'point)) - (setq rangep (and (integerp (car highline-line)) - (>= (car highline-line) 0) - (< (car highline-line) - (cdr highline-line)))))) - (move-overlay - ;; overlay - ov - ;; start point - (cond (rangep ; (LOWER . UPPER) - (highline-column-position (car highline-line))) - (beyondp ; (beyond . INTEGER) - (highline-column-position (cdr highline-line))) - (pointp ; (point . INTEGER) - (highline-column-position - (- column (cdr highline-line)))) - ((integerp highline-line) ; INTEGER - (if (>= highline-line 0) - (line-beginning-position) - (line-end-position))) - ((line-beginning-position))) ; t or nil - ;; end point - (cond (rangep ; (LOWER . UPPER) - (highline-column-position (cdr highline-line))) - (pointp ; (point . INTEGER) - (highline-column-position - (+ column (cdr highline-line)))) - ((integerp highline-line) ; INTEGER - (highline-column-position - (if (>= highline-line 0) - highline-line - (save-excursion - (end-of-line) - (+ column highline-line))))) - (highline-line ; t or (beyond . INTEGER) - (line-end-position)) - ((min (point-max) ; nil - (1+ (line-end-position)))))) - ;; while condition - (> (setq lines (1- lines)) 0)) - ;; while body - (forward-line 1)) - ;; unhighlight remainding overlays, if any - (while (and overs (> (overlay-end (car overs)) 1)) - (highline-move-overlay (car overs) 1 1) - (setq overs (cdr overs))))))) - - -(defun highline-vertical () - (cond - ;; nil - only current line - ((null highline-vertical) - '(1 . 1)) - ;; (ABOVE . BELOW) - vertical range - ((and (consp highline-vertical) - (let ((above (car highline-vertical)) - (below (cdr highline-vertical))) - (and (integerp above) - (integerp below) - (let ((below (1+ (max below 0)))) - (cons (if (<= above 0) - below - (forward-line (- above)) - (+ above below)) - below)))))) - ;; t - all current window - (t - (let ((height (window-height)) - (start (window-start))) - (prog1 - (cons (1- height) - (- height - (count-lines start (point)) - (if (zerop (current-column)) 1 0))) - (goto-char start)))) - )) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(add-to-list 'minor-mode-alist '(highline-mode " HL")) -(add-to-list 'minor-mode-alist '(highline-local-mode " hl")) -(add-to-list 'minor-mode-alist '(highline-view-mode " Ihl")) - - -(provide 'highline) - - -(run-hooks 'highline-load-hook) - - -;;; highline.el ends here diff --git a/xemacs-packages/lisp/edit-utils/hippie-exp.el b/xemacs-packages/lisp/edit-utils/hippie-exp.el deleted file mode 100644 index c7d088ae..00000000 --- a/xemacs-packages/lisp/edit-utils/hippie-exp.el +++ /dev/null @@ -1,1129 +0,0 @@ -;;; hippie-exp.el --- expand text trying various ways to find its expansion. - -;; Copyright (C) 1992 Free Software Foundation, Inc. - -;; Author: Anders Holst -;; Last change: 6 August 1995 -;; Version: 1.4 -;; Keywords: abbrev - -;; 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. - -;;; Synched up with: Emacs/Mule zeta - -;;; Commentary: - -;; `hippie-expand' is a single function for a lot of different kinds -;; of completions and expansions. Called repeatedly it tries all -;; possible completions in succession. -;; Which kinds of completions to try, and in which order, is -;; determined by the contents of `hippie-expand-try-functions-list'. -;; Much customization of `hippie-expand' can be made by changing the -;; order of, removing, or inserting new functions in this list. -;; Given a positive numeric argument, `hippie-expand' jumps directly -;; ARG functions forward in this list. Given some other argument -;; (a negative argument or just Ctrl-U) it undoes the tried -;; completion. -;; -;; If the variable `hippie-expand-verbose' is non-nil, `hippie-expand' -;; outputs in a message which try-function in the list that is used -;; currently (ie. was used currently and will be tried first the next -;; time). -;; The variable `hippie-expand-max-buffers' determines in how many -;; buffers, apart from the current, to search for expansions in. It -;; is used by the try-functions named "-all-buffers". -;; The variable `hippie-expand-ignore-buffers' is a list of regexps -;; matching buffer names (as strings) or major modes (as atoms) of -;; buffers that should not be searched by the try-functions named -;; "-all-buffers". -;; See also the macro `make-hippie-expand-function' below. -;; -;; A short description of the current try-functions in this file: -;; `try-complete-file-name' : very convenient to have in any buffer, -;; and not just in the minibuffer or (some) shell-mode. It goes -;; through all possible completions instead of just completing as -;; much as is unique. -;; `try-complete-file-name-partially' : To insert in the list just -;; before `try-complete-file-name' for those who want first to get -;; a file name completed only as many characters as is unique. -;; `try-expand-all-abbrevs' : can be removed if you don't use abbrevs. -;; Otherwise it looks through all abbrev-tables, starting with -;; the local followed by the global. -;; `try-expand-line' : Searches the buffer for an entire line that -;; begins exactly as the current line. Convenient sometimes, for -;; example as a substitute for (or complement to) the history -;; list in shell-like buffers. At other times, only confusing. -;; `try-expand-line-all-buffers' : Like `try-expand-line' but searches -;; in all buffers (except the current). (This may be a little -;; slow, don't use it unless you are really fond of `hippie-expand'.) -;; `try-expand-list' : Tries to expand the text back to the nearest -;; open delimiter, to a whole list from the buffer. Convenient for -;; example when writing lisp or TeX. -;; `try-expand-list-all-buffers' : Like `try-expand-list' but searches -;; in all buffers (except the current). -;; `try-expand-dabbrev' : works exactly as dabbrev-expand (but of -;; course in a way compatible with the other try-functions). -;; `try-expand-dabbrev-all-buffers' : perhaps the most useful of them, -;; like `dabbrev-expand' but searches all Emacs buffers (except the -;; current) for matching words. (No, I don't find this one -;; particularly slow.) -;; `try-expand-dabbrev-visible': Searches the currently visible parts of -;; all windows. Can be put before `try-expand-dabbrev-all-buffers' to -;; first try the expansions you can see. -;; `try-expand-dabbrev-from-kill': Searches the kill ring for a suitable -;; completion of the word. Good to have, just in case the word was not -;; found elsewhere. -;; `try-expand-whole-kill' : Tries to complete text with a whole entry -;; from the kill ring. May be good if you don't know how far up in -;; the kill-ring the required entry is, and don't want to mess with -;; "Choose Next Paste". -;; `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes -;; through all possibilities instead of completing what is unique. -;; Might be tedious (usually a lot of possible completions) and -;; since its function is much like `lisp-complete-symbol', which -;; already has a key of its own, you might want to remove this. -;; `try-complete-lisp-symbol-partially' : To insert in the list just -;; before `try-complete-lisp-symbol' for those who first want to get -;; completion of what is unique in the name. -;; -;; Not all of the above functions are by default in -;; `hippie-expand-try-functions-list'. This variable is better set -;; in ".emacs" to make `hippie-expand' behave maximally convenient -;; according to personal taste. Also, instead of loading the -;; variable with all kinds of try-functions above, it might be an -;; idea to use `make-hippie-expand-function' to construct different -;; `hippie-expand'-like functions, with different try-lists and bound -;; to different keys. It is also possible to make -;; `hippie-expand-try-functions-list' a buffer local variable, and -;; let it depend on the mode (by setting it in the mode-hooks). -;; -;; To write new try-functions, consider the following: -;; Each try-function takes one argument OLD which is nil the first -;; time the function is called and true in succeeding calls for the -;; same string to complete. The first time the function has to -;; extract the string before point to complete, and substitute the -;; first completion alternative for it. On following calls it has to -;; substitute the next possible completion for the last tried string. -;; The try-function is to return t as long as it finds new -;; possible completions. When there are no more alternatives it has -;; to restore the text before point to its original contents, and -;; return nil (don't beep or message or anything). -;; The try-function can (should) use the following functions: -;; `he-init-string' : Initializes the text to substitute to the -;; contents of the region BEGIN to END. Also sets the variable -;; `he-search-string' to the text to expand. -;; `he-substitute-string' : substitutes STR into the region -;; initialized with `he-init-string'. (An optional second argument -;; TRANS-CASE non-nil, means transfer of case from the abbreviation -;; to the expansion is ok if that is enabled in the buffer.) -;; `he-reset-string' : Resets the initialized region to its original -;; contents. -;; There is also a variable: `he-tried-table' which is meant to contain -;; all tried expansions so far. The try-function can check this -;; variable to see whether an expansion has already been tried -;; (hint: `he-string-member'). -;; -;; Known bugs -;; -;; It may happen that some completion suggestion occurs twice, in -;; spite of the use of `he-tried-table' to prevent that. This is -;; because different try-functions may try to complete different -;; lengths of text, and thus put different amounts of the -;; text in `he-tried-table'. Anyway this seems to occur seldom enough -;; not to be too disturbing. Also it should NOT be possible for the -;; opposite situation to occur, that `hippie-expand' misses some -;; suggestion because it thinks it has already tried it. -;; -;; Acknowledgement -;; -;; I want to thank Mikael Djurfeldt in discussions with whom the idea -;; of this function took form. -;; I am also grateful to all those who have given me suggestions on -;; how to improve it, and all those who helped to find and remove bugs. -;; - -;;; Code: - -(defvar he-num -1) - -(defvar he-string-beg (make-marker)) - -(defvar he-string-end (make-marker)) - -(defvar he-search-string ()) - -(defvar he-expand-list ()) - -(defvar he-tried-table ()) - -(defvar he-search-loc (make-marker)) - -(defvar he-search-loc2 ()) - -(defvar he-search-bw ()) - -(defvar he-search-bufs ()) - -(defvar he-searched-n-bufs ()) - -(defvar he-search-window ()) - -;;;###autoload -(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially - try-complete-file-name - try-expand-all-abbrevs - try-expand-list - try-expand-line - try-expand-dabbrev - try-expand-dabbrev-all-buffers - try-expand-dabbrev-from-kill - try-complete-lisp-symbol-partially - try-complete-lisp-symbol) - "The list of expansion functions tried in order by `hippie-expand'. -To change the behavior of `hippie-expand', remove, change the order of, -or insert functions in this list.") - -;;;###autoload -(defvar hippie-expand-verbose t - "*Non-nil makes `hippie-expand' output which function it is trying.") - -;;;###autoload -(defvar hippie-expand-max-buffers () - "*The maximum number of buffers (apart from the current) searched. -If nil, all buffers are searched.") - -;;;###autoload -(defvar hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode) - "*A list specifying which buffers not to search (if not current). -Can contain both regexps matching buffer names (as strings) and major modes -\(as atoms)") - -;;;###autoload -(defun hippie-expand (arg) - "Try to expand text before point, using multiple methods. -The expansion functions in `hippie-expand-try-functions-list' are -tried in order, until a possible expansion is found. Repeated -application of `hippie-expand' inserts successively possible -expansions. -With a positive numeric argument, jumps directly to the ARG next -function in this list. With a negative argument or just \\[universal-argument], -undoes the expansion." - (interactive "P") - (if (or (not arg) - (and (integerp arg) (> arg 0))) - (let ((first (or (= he-num -1) - (not (equal this-command last-command))))) - (if first - (progn - (setq he-num -1) - (setq he-tried-table nil))) - (if arg - (if (not first) (he-reset-string)) - (setq arg 0)) - (let ((i (max (+ he-num arg) 0))) - (while (not (or (>= i (length hippie-expand-try-functions-list)) - (apply (nth i hippie-expand-try-functions-list) - (list (= he-num i))))) - (setq i (1+ i))) - (setq he-num i)) - (if (>= he-num (length hippie-expand-try-functions-list)) - (progn - (setq he-num -1) - (if first - (message "No expansion found") - (message "No further expansions found")) - (ding)) - (if (and hippie-expand-verbose - (not (window-minibuffer-p (selected-window)))) - (message "Using %s" - (prin1-to-string (nth he-num - hippie-expand-try-functions-list)))))) - (if (and (>= he-num 0) - (eq (marker-buffer he-string-beg) (current-buffer))) - (progn - (setq he-num -1) - (he-reset-string) - (if (and hippie-expand-verbose - (not (window-minibuffer-p (selected-window)))) - (message "Undoing expansions")))))) - -;; Initializes the region to expand (to between BEG and END). -(defun he-init-string (beg end) - (set-marker he-string-beg beg) - (set-marker he-string-end end) - (setq he-search-string (buffer-substring beg end))) - -;; Resets the expanded region to its original contents. -(defun he-reset-string () - (let ((newpos (point-marker))) - (goto-char he-string-beg) - (insert he-search-string) - (delete-region (point) he-string-end) - (goto-char newpos))) - -;; Substitutes an expansion STR into the correct region (the region -;; initialized with `he-init-string'). -;; An optional argument TRANS-CASE means that it is ok to transfer case -;; from the abbreviation to the expansion if that is possible, and is -;; enabled in the buffer. -(defun he-substitute-string (str &optional trans-case) - (let ((trans-case (and trans-case - case-replace - case-fold-search)) - (newpos (point-marker)) - (subst ())) - (goto-char he-string-beg) - (setq subst (if trans-case (he-transfer-case he-search-string str) str)) - (setq he-tried-table (cons subst he-tried-table)) - (insert subst) - (delete-region (point) he-string-end) - (goto-char newpos))) - -(defun he-capitalize-first (str) - (save-match-data - (if (string-match "\\Sw*\\(\\sw\\).*" str) - (let ((res (downcase str)) - (no (match-beginning 1))) - (aset res no (upcase (aref str no))) - res) - str))) - -(defun he-ordinary-case-p (str) - (or (string= str (downcase str)) - (string= str (upcase str)) - (string= str (capitalize str)) - (string= str (he-capitalize-first str)))) - -(defun he-transfer-case (from-str to-str) - (cond ((string= from-str (substring to-str 0 (min (length from-str) - (length to-str)))) - to-str) - ((not (he-ordinary-case-p to-str)) - to-str) - ((string= from-str (downcase from-str)) - (downcase to-str)) - ((string= from-str (upcase from-str)) - (upcase to-str)) - ((string= from-str (he-capitalize-first from-str)) - (he-capitalize-first to-str)) - ((string= from-str (capitalize from-str)) - (capitalize to-str)) - (t - to-str))) - - -;; Check if STR is a member of LST. -;; Transform to the final case if optional TRANS-CASE is non-NIL. -(defun he-string-member (str lst &optional trans-case) - (if str - (member (if (and trans-case - case-replace - case-fold-search) - (he-transfer-case he-search-string str) - str) - lst))) - -;; Check if STR matches any regexp in LST. -;; Ignore possible non-strings in LST. -(defun he-regexp-member (str lst) - (while (and lst - (or (not (stringp (car lst))) - (not (string-match (car lst) str)))) - (setq lst (cdr lst))) - lst) - -;; For the real hippie-expand enthusiast: A macro that makes it -;; possible to use many functions like hippie-expand, but with -;; different try-functions-lists. -;; Usage is for example: -;; (fset 'my-complete-file (make-hippie-expand-function -;; '(try-complete-file-name-partially -;; try-complete-file-name))) -;; (fset 'my-complete-line (make-hippie-expand-function -;; '(try-expand-line -;; try-expand-line-all-buffers))) -;; -;;;###autoload -(defmacro make-hippie-expand-function (try-list &optional verbose) - "Construct a function similar to `hippie-expand'. -Make it use the expansion functions in TRY-LIST. An optional second -argument VERBOSE non-nil makes the function verbose." - (` (function (lambda (arg) - (, (concat - "Try to expand text before point, using the following functions: \n" - (mapconcat 'prin1-to-string (eval try-list) ", "))) - (interactive "P") - (let ((hippie-expand-try-functions-list (, try-list)) - (hippie-expand-verbose (, verbose))) - (hippie-expand arg)))))) - - -;;; Here follows the try-functions and their requisites: - - -(defun try-complete-file-name (old) - "Try to complete text as a file name. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (if (not old) - (progn - (he-init-string (he-file-name-beg) (point)) - (let ((name-part (he-file-name-nondirectory he-search-string)) - (dir-part (expand-file-name (or (he-file-name-directory - he-search-string) "")))) - (if (not (he-string-member name-part he-tried-table)) - (setq he-tried-table (cons name-part he-tried-table))) - (if (and (not (equal he-search-string "")) - (he-file-directory-p dir-part)) - (setq he-expand-list (sort (file-name-all-completions - name-part - dir-part) - 'string-lessp)) - (setq he-expand-list ()))))) - - (while (and he-expand-list - (he-string-member (car he-expand-list) he-tried-table)) - (setq he-expand-list (cdr he-expand-list))) - (if (null he-expand-list) - (progn - (if old (he-reset-string)) - ()) - (let ((filename (he-concat-directory-file-name - (he-file-name-directory he-search-string) - (car he-expand-list)))) - (he-substitute-string filename) - (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table))) - (setq he-expand-list (cdr he-expand-list)) - t))) - -(defun try-complete-file-name-partially (old) - "Try to complete text as a file name, as many characters as unique. -The argument OLD has to be nil the first call of this function. It -returns t if a unique, possibly partial, completion is found, nil -otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-file-name-beg) (point)) - (let ((name-part (he-file-name-nondirectory he-search-string)) - (dir-part (expand-file-name (or (he-file-name-directory - he-search-string) "")))) - (if (and (not (equal he-search-string "")) - (he-file-directory-p dir-part)) - (setq expansion (file-name-completion name-part - dir-part))) - (if (or (eq expansion t) - (string= expansion name-part) - (he-string-member expansion he-tried-table)) - (setq expansion ()))))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (let ((filename (he-concat-directory-file-name - (he-file-name-directory he-search-string) - expansion))) - (he-substitute-string filename) - (setq he-tried-table (cons expansion (cdr he-tried-table))) - t)))) - -(defvar he-file-name-chars - (cond ((memq system-type '(vax-vms axp-vms)) - "-a-zA-Z0-9_/.,~^#$+=:\\[\\]") - ((memq system-type '(ms-dos windows-nt)) - "-a-zA-Z0-9_/.,~^#$+=:\\\\") - (t ;; More strange file formats ? - "-a-zA-Z0-9_/.,~^#$+=")) - "Characters that are considered part of the file name to expand.") - -(defun he-file-name-beg () - (save-excursion - (skip-chars-backward he-file-name-chars) - (point))) - -;; Thanks go to Richard Levitte who helped to make these -;; work under VMS, and to David Hughes who -;; helped to make it work on PC. -(defun he-file-name-nondirectory (file) - "Fix to make `file-name-nondirectory' work for hippie-expand under VMS." - (if (memq system-type '(axp-vms vax-vms)) - (let ((n (file-name-nondirectory file))) - (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n) - (concat "[." (substring n (match-beginning 2) (match-end 2))) - n)) - (file-name-nondirectory file))) - -(defun he-file-name-directory (file) - "Fix to make `file-name-directory' work for hippie-expand under VMS." - (if (memq system-type '(axp-vms vax-vms)) - (let ((n (file-name-nondirectory file)) - (d (file-name-directory file))) - (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n) - (concat d (substring n (match-beginning 1) (match-end 1)) "]") - d)) - (file-name-directory file))) - -(defun he-file-directory-p (file) - "Fix to make `file-directory-p' work for hippie-expand under VMS." - (if (memq system-type '(vax-vms axp-vms)) - (or (file-directory-p file) - (file-directory-p (concat file "[000000]"))) - (file-directory-p file))) - -(defun he-concat-directory-file-name (dir-part name-part) - "Try to slam together two parts of a file specification, system dependently." - (cond ((null dir-part) name-part) - ((memq system-type '(axp-vms vax-vms)) - (if (and (string= (substring dir-part -1) "]") - (string= (substring name-part 0 2) "[.")) - (concat (substring dir-part 0 -1) (substring name-part 1)) - (concat dir-part name-part))) - ((memq system-type '(ms-dos mswindows)) - (if (and (string-match "\\\\" dir-part) - (not (string-match "/" dir-part)) - (= (aref name-part (1- (length name-part))) ?/)) - (aset name-part (1- (length name-part)) ?\\)) - (concat dir-part name-part)) - (t - (concat dir-part name-part)))) - -(defun try-complete-lisp-symbol (old) - "Try to complete word as an Emacs Lisp symbol. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (if (not old) - (progn - (he-init-string (he-lisp-symbol-beg) (point)) - (if (not (he-string-member he-search-string he-tried-table)) - (setq he-tried-table (cons he-search-string he-tried-table))) - (setq he-expand-list - (and (not (equal he-search-string "")) - (sort (all-completions he-search-string obarray - (function (lambda (sym) - (or (boundp sym) - (fboundp sym) - (symbol-plist sym))))) - 'string-lessp))))) - (while (and he-expand-list - (he-string-member (car he-expand-list) he-tried-table)) - (setq he-expand-list (cdr he-expand-list))) - (if (null he-expand-list) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string (car he-expand-list)) - (setq he-expand-list (cdr he-expand-list)) - t))) - -(defun try-complete-lisp-symbol-partially (old) - "Try to complete as an Emacs Lisp symbol, as many characters as unique. -The argument OLD has to be nil the first call of this function. It -returns t if a unique, possibly partial, completion is found, nil -otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-lisp-symbol-beg) (point)) - (if (not (string= he-search-string "")) - (setq expansion - (try-completion he-search-string obarray - (function (lambda (sym) - (or (boundp sym) - (fboundp sym) - (symbol-plist sym))))))) - (if (or (eq expansion t) - (string= expansion he-search-string) - (he-string-member expansion he-tried-table)) - (setq expansion ())))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion) - t)))) - -(defun he-lisp-symbol-beg () - (let ((skips "-a-zA-Z0-9_.")) - (save-excursion - (skip-chars-backward skips) - (point)))) - -(defun try-expand-line (old) - "Try to complete the current line to an entire line in the buffer. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ()) - (strip-prompt (and (get-buffer-process (current-buffer)) - comint-prompt-regexp))) - (if (not old) - (progn - (he-init-string (he-line-beg strip-prompt) (point)) - (set-marker he-search-loc he-string-beg) - (setq he-search-bw t))) - - (if (not (equal he-search-string "")) - (save-excursion - ;; Try looking backward unless inhibited. - (if he-search-bw - (progn - (goto-char he-search-loc) - (setq expansion (he-line-search he-search-string - strip-prompt t)) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (set-marker he-search-loc he-string-end) - (setq he-search-bw ()))))) - - (if (not expansion) ; Then look forward. - (progn - (goto-char he-search-loc) - (setq expansion (he-line-search he-search-string - strip-prompt nil)) - (set-marker he-search-loc (point)))))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun try-expand-line-all-buffers (old) - "Try to complete the current line, searching all other buffers. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ()) - (strip-prompt (and (get-buffer-process (current-buffer)) - comint-prompt-regexp)) - (buf (current-buffer)) - (orig-case-fold-search case-fold-search)) - (if (not old) - (progn - (he-init-string (he-line-beg strip-prompt) (point)) - (setq he-search-bufs (buffer-list)) - (setq he-searched-n-bufs 0) - (set-marker he-search-loc 1 (car he-search-bufs)))) - - (if (not (equal he-search-string "")) - (while (and he-search-bufs - (not expansion) - (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (not (memq major-mode hippie-expand-ignore-buffers)) - (not (he-regexp-member (buffer-name) - hippie-expand-ignore-buffers))) - (save-excursion - (goto-char he-search-loc) - (setq strip-prompt (and (get-buffer-process (current-buffer)) - comint-prompt-regexp)) - (setq expansion (let ((case-fold-search orig-case-fold-search)) - (he-line-search he-search-string - strip-prompt nil))) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (setq he-search-bufs (cdr he-search-bufs)) - (setq he-searched-n-bufs (1+ he-searched-n-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - (setq he-search-bufs (cdr he-search-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - - (set-buffer buf) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun he-line-search (str strip-prompt reverse) - (let ((result ())) - (while (and (not result) - (if reverse - (re-search-backward - (he-line-search-regexp str strip-prompt) - nil t) - (re-search-forward - (he-line-search-regexp str strip-prompt) - nil t))) - (setq result (buffer-substring (match-beginning 2) (match-end 2))) - (if (he-string-member result he-tried-table t) - (setq result nil))) ; if already in table, ignore - result)) - -(defun he-line-beg (strip-prompt) - (save-excursion - (if (re-search-backward (he-line-search-regexp "" strip-prompt) - (save-excursion (beginning-of-line) - (point)) t) - (match-beginning 2) - (point)))) - -(defun he-line-search-regexp (pat strip-prompt) - (if strip-prompt - (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\(" - (regexp-quote pat) - "[^\n]*[^ \t\n]\\)") - (concat "^\\(\\s-*\\)\\(" - (regexp-quote pat) - "[^\n]*[^ \t\n]\\)"))) - -(defun try-expand-list (old) - "Try to complete the current beginning of a list. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-list-beg) (point)) - (set-marker he-search-loc he-string-beg) - (setq he-search-bw t))) - - (if (not (equal he-search-string "")) - (save-excursion - ;; Try looking backward unless inhibited. - (if he-search-bw - (progn - (goto-char he-search-loc) - (setq expansion (he-list-search he-search-string t)) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (set-marker he-search-loc he-string-end) - (setq he-search-bw ()))))) - - (if (not expansion) ; Then look forward. - (progn - (goto-char he-search-loc) - (setq expansion (he-list-search he-search-string nil)) - (set-marker he-search-loc (point)))))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun try-expand-list-all-buffers (old) - "Try to complete the current list, searching all other buffers. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ()) - (buf (current-buffer)) - (orig-case-fold-search case-fold-search)) - (if (not old) - (progn - (he-init-string (he-list-beg) (point)) - (setq he-search-bufs (buffer-list)) - (setq he-searched-n-bufs 0) - (set-marker he-search-loc 1 (car he-search-bufs)))) - - (if (not (equal he-search-string "")) - (while (and he-search-bufs - (not expansion) - (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (not (memq major-mode hippie-expand-ignore-buffers)) - (not (he-regexp-member (buffer-name) - hippie-expand-ignore-buffers))) - (save-excursion - (goto-char he-search-loc) - (setq expansion (let ((case-fold-search orig-case-fold-search)) - (he-list-search he-search-string nil))) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (setq he-search-bufs (cdr he-search-bufs)) - (setq he-searched-n-bufs (1+ he-searched-n-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - (setq he-search-bufs (cdr he-search-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - - (set-buffer buf) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun he-list-search (str reverse) - (let ((result ()) - beg pos err) - (while (and (not result) - (if reverse - (search-backward str nil t) - (search-forward str nil t))) - (setq pos (point)) - (setq beg (match-beginning 0)) - (goto-char beg) - (setq err ()) - (condition-case () - (forward-list 1) - (error (setq err t))) - (if (and reverse - (> (point) he-string-beg)) - (setq err t)) - (if (not err) - (progn - (setq result (buffer-substring beg (point))) - (if (he-string-member result he-tried-table t) - (setq result nil)))) ; if already in table, ignore - (goto-char pos)) - result)) - -(defun he-list-beg () - (save-excursion - (condition-case () - (backward-up-list 1) - (error ())) - (point))) - -(defun try-expand-all-abbrevs (old) - "Try to expand word before point according to all abbrev tables. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible expansions of the same -string). It returns t if a new expansion is found, nil otherwise." - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (setq he-expand-list - (and (not (equal he-search-string "")) - (mapcar (function (lambda (sym) - (if (and (boundp sym) (vectorp (eval sym))) - (abbrev-expansion (downcase he-search-string) - (eval sym))))) - (append '(local-abbrev-table - global-abbrev-table) - abbrev-table-name-list)))))) - (while (and he-expand-list - (or (not (car he-expand-list)) - (he-string-member (car he-expand-list) he-tried-table t))) - (setq he-expand-list (cdr he-expand-list))) - (if (null he-expand-list) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string (car he-expand-list) t) - (setq he-expand-list (cdr he-expand-list)) - t))) - -(defun try-expand-dabbrev (old) - "Try to expand word \"dynamically\", searching the current buffer. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible expansions of the same -string). It returns t if a new expansion is found, nil otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (set-marker he-search-loc he-string-beg) - (setq he-search-bw t))) - - (if (not (equal he-search-string "")) - (save-excursion - ;; Try looking backward unless inhibited. - (if he-search-bw - (progn - (goto-char he-search-loc) - (setq expansion (he-dabbrev-search he-search-string t)) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (set-marker he-search-loc he-string-end) - (setq he-search-bw ()))))) - - (if (not expansion) ; Then look forward. - (progn - (goto-char he-search-loc) - (setq expansion (he-dabbrev-search he-search-string nil)) - (set-marker he-search-loc (point)))))) - - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun try-expand-dabbrev-all-buffers (old) - "Tries to expand word \"dynamically\", searching all other buffers. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible expansions of the same -string). It returns t if a new expansion is found, nil otherwise." - (let ((expansion ()) - (buf (current-buffer)) - (orig-case-fold-search case-fold-search)) - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (setq he-search-bufs (buffer-list)) - (setq he-searched-n-bufs 0) - (set-marker he-search-loc 1 (car he-search-bufs)))) - - (if (not (equal he-search-string "")) - (while (and he-search-bufs - (not expansion) - (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (not (memq major-mode hippie-expand-ignore-buffers)) - (not (he-regexp-member (buffer-name) - hippie-expand-ignore-buffers))) - (save-excursion - (goto-char he-search-loc) - (setq expansion (let ((case-fold-search orig-case-fold-search)) - (he-dabbrev-search he-search-string nil))) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (setq he-search-bufs (cdr he-search-bufs)) - (setq he-searched-n-bufs (1+ he-searched-n-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - (setq he-search-bufs (cdr he-search-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - - (set-buffer buf) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -;; Thanks go to Jeff Dairiki who -;; suggested this one. -(defun try-expand-dabbrev-visible (old) - "Try to expand word \"dynamically\", searching visible window parts. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible expansions of the same -string). It returns t if a new expansion is found, nil otherwise." - (let ((expansion ()) - (buf (current-buffer)) - (flag (if (frame-visible-p (window-frame (selected-window))) - 'visible t))) - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (setq he-search-window (selected-window)) - (set-marker he-search-loc - (window-start he-search-window) - (window-buffer he-search-window)))) - - (while (and (not (equal he-search-string "")) - (marker-position he-search-loc) - (not expansion)) - (save-excursion - (set-buffer (marker-buffer he-search-loc)) - (goto-char he-search-loc) - (setq expansion (he-dabbrev-search he-search-string () - (window-end he-search-window))) - (if (and expansion - (eq (marker-buffer he-string-beg) (current-buffer)) - (eq (marker-position he-string-beg) (match-beginning 0))) - (setq expansion (he-dabbrev-search he-search-string () - (window-end he-search-window)))) - (set-marker he-search-loc (point) (current-buffer))) - (if (not expansion) - (progn - (setq he-search-window (next-window he-search-window nil flag)) - (if (eq he-search-window (selected-window)) - (set-marker he-search-loc nil) - (set-marker he-search-loc (window-start he-search-window) - (window-buffer he-search-window)))))) - - (set-buffer buf) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun he-dabbrev-search (pattern &optional reverse limit) - (let ((result ()) - (regpat (if (eq (char-syntax (aref pattern 0)) ?_) - (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+") - (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")))) - (while (and (not result) - (if reverse - (re-search-backward regpat limit t) - (re-search-forward regpat limit t))) - (setq result (buffer-substring (match-beginning 0) (match-end 0))) - (if (or (and (> (match-beginning 0) (point-min)) - (memq (char-syntax (char-after (1- (match-beginning 0)))) - '(?_ ?w))) - (he-string-member result he-tried-table t)) - (setq result nil))) ; ignore if bad prefix or already in table - result)) - -(defvar he-dabbrev-skip-space () - "Non-NIL means tolerate trailing spaces in the abbreviation to expand.") - -(defun he-dabbrev-beg () - (let ((op (point))) - (save-excursion - (if he-dabbrev-skip-space - (skip-syntax-backward ". ")) - (if (= (skip-syntax-backward "w_") 0) - op - (point))))) - -(defun try-expand-dabbrev-from-kill (old) - "Try to expand word \"dynamically\", searching the kill ring. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (setq he-expand-list - (if (not (equal he-search-string "")) - kill-ring)) - (setq he-search-loc2 0))) - (if (not (equal he-search-string "")) - (setq expansion (he-dabbrev-kill-search he-search-string))) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) - -(defun he-dabbrev-kill-search (pattern) - (let ((result ()) - (regpat (if (eq (char-syntax (aref pattern 0)) ?_) - (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+") - (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))) - (killstr (car he-expand-list))) - (while (and (not result) - he-expand-list) - (while (and (not result) - (string-match regpat killstr he-search-loc2)) - (setq result (substring killstr (match-beginning 0) (match-end 0))) - (setq he-search-loc2 (1+ (match-beginning 0))) - (if (or (and (> (match-beginning 0) 0) - (memq (char-syntax (aref killstr (1- (match-beginning 0)))) - '(?_ ?w))) - (he-string-member result he-tried-table t)) - (setq result nil))) ; ignore if bad prefix or already in table - (if (and (not result) - he-expand-list) - (progn - (setq he-expand-list (cdr he-expand-list)) - (setq killstr (car he-expand-list)) - (setq he-search-loc2 0)))) - result)) - -(defun try-expand-whole-kill (old) - "Try to complete text with something from the kill ring. -The argument OLD has to be nil the first call of this function, and t -for subsequent calls (for further possible completions of the same -string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ())) - (if (not old) - (progn - (he-init-string (he-kill-beg) (point)) - (if (not (he-string-member he-search-string he-tried-table)) - (setq he-tried-table (cons he-search-string he-tried-table))) - (setq he-expand-list - (if (not (equal he-search-string "")) - kill-ring)) - (setq he-search-loc2 ()))) - (if (not (equal he-search-string "")) - (setq expansion (he-whole-kill-search he-search-string))) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion) - t)))) - -(defun he-whole-kill-search (str) - (let ((case-fold-search ()) - (result ()) - (str (regexp-quote str)) - (killstr (car he-expand-list)) - (pos -1)) - (while (and (not result) - he-expand-list) - (if (not he-search-loc2) - (while (setq pos (string-match str killstr (1+ pos))) - (setq he-search-loc2 (cons pos he-search-loc2)))) - (while (and (not result) - he-search-loc2) - (setq pos (car he-search-loc2)) - (setq he-search-loc2 (cdr he-search-loc2)) - (save-excursion - (goto-char he-string-beg) - (if (and (>= (- (point) pos) (point-min)) ; avoid some string GC - (eq (char-after (- (point) pos)) (aref killstr 0)) - (search-backward (substring killstr 0 pos) - (- (point) pos) t)) - (setq result (substring killstr pos)))) - (if (and result - (he-string-member result he-tried-table)) - (setq result nil))) ; ignore if already in table - (if (and (not result) - he-expand-list) - (progn - (setq he-expand-list (cdr he-expand-list)) - (setq killstr (car he-expand-list)) - (setq pos -1)))) - result)) - -(defun he-kill-beg () - (let ((op (point))) - (save-excursion - (skip-syntax-backward "^w_") - (if (= (skip-syntax-backward "w_") 0) - op - (point))))) - - -(provide 'hippie-exp) - -;;; hippie-exp.el ends here diff --git a/xemacs-packages/lisp/edit-utils/icomplete.el b/xemacs-packages/lisp/edit-utils/icomplete.el deleted file mode 100644 index 6cb80720..00000000 --- a/xemacs-packages/lisp/edit-utils/icomplete.el +++ /dev/null @@ -1,361 +0,0 @@ -;;; icomplete.el --- minibuffer completion incremental feedback - -;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - -;; Author: Ken Manheimer -;; Maintainer: Ken Manheimer -;; Version: $Id: icomplete.el,v 1.4 2000/11/02 13:49:00 nick Exp $ -;; Created: Mar 1993 klm@nist.gov - first release to usenet -;; Keywords: help, abbrev - -;; 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. - -;; This file is also part of GNU XEmacs. -;; Hacked for GNU XEmacs: David Hughes 7th September 1995. -;; Icomplete keybindings display originally by Steve Bauer, with -;; some integration and refinement by Ken Manheimer. - -;;; Commentary: - -;; Loading this package implements a more fine-grained minibuffer -;; completion feedback scheme. Prospective completions are concisely -;; indicated within the minibuffer itself, with each successive -;; keystroke. - -;; See 'icomplete-completions' docstring for a description of the -;; icomplete display format. - -;; See the `icomplete-minibuffer-setup-hook' docstring for a means to -;; customize icomplete setup for interoperation with other -;; minibuffer-oriented packages. - -;; To activate icomplete mode, load the package and use the -;; `icomplete-mode' function. You can subsequently deactivate it by -;; invoking the function icomplete-mode with a negative prefix-arg -;; (C-U -1 ESC-x icomplete-mode). Also, you can prevent activation of -;; the mode during package load by first setting the variable -;; `icomplete-mode' to nil. Icompletion can be enabled any time after -;; the package is loaded by invoking icomplete-mode without a prefix -;; arg. - -;; Thanks to everyone for their suggestions for refinements of this -;; package. I particularly have to credit Michael Cook, who -;; implemented an incremental completion style in his 'iswitch' -;; functions that served as a model for icomplete. Some other -;; contributors: Noah Freidman (restructuring as minor mode), Colin -;; Rafferty (lemacs reconciliation), Lars Lindberg, RMS, and others. - -;; klm. - -;;; Code: - -;;;_* Provide -(provide 'icomplete) - -(defgroup icomplete nil - "Minibuffer completion incremental feedback." - :group 'minibuffer) - - -(defcustom icomplete-mode nil - "*Non-nil activates incremental minibuffer completion." - :type 'boolean - :set (lambda (symbol value) - (icomplete-mode (if value 1 -1))) - :initialize 'custom-initialize-default - :require 'icomplete - :group 'icomplete) - -;;;_* User Customization variables -(defcustom icomplete-prospects-length 80 - "*Length of string displaying the prospects." - :type 'integer - :group 'icomplete) -(defcustom icomplete-compute-delay .3 - "*Completions-computation stall, used only with large-number -completions - see `icomplete-delay-completions-threshold'." - :type 'number - :group 'icomplete) -(defcustom icomplete-delay-completions-threshold 400 - "*Pending-completions number over which to apply icomplete-compute-delay." - :type 'integer - :group 'icomplete) -(defcustom icomplete-max-delay-chars 3 - "*Maximum number of initial chars to apply icomplete compute delay." - :type 'integer - :group 'icomplete) - -;;;_* Initialization -;;;_ = icomplete-minibuffer-setup-hook -(defcustom icomplete-minibuffer-setup-hook nil - "*Icomplete-specific customization of minibuffer setup. - -This hook is run during minibuffer setup iff icomplete will be active. -It is intended for use in customizing icomplete for interoperation -with other packages. For instance: - - \(add-hook 'icomplete-minibuffer-setup-hook - \(function - \(lambda () - \(make-local-variable 'resize-minibuffer-window-max-height) - \(setq resize-minibuffer-window-max-height 3)))) - -will constrain rsz-mini to a maximum minibuffer height of 3 lines when -icompletion is occurring." - :type 'hook - :group 'icomplete) - -;;;_ + Internal Variables -;;;_ = icomplete-mode -;(defvar icomplete-mode t -; "*Nil inhibits activated incremental minibuffer completion.") -;;;_ = icomplete-eoinput 1 -(defvar icomplete-eoinput 1 - "Point where minibuffer input ends and completion info begins.") -(make-variable-buffer-local 'icomplete-eoinput) -;;;_ = icomplete-pre-command-hook -(defvar icomplete-pre-command-hook nil - "Incremental-minibuffer-completion pre-command-hook. - -Is run in minibuffer before user input when `icomplete-mode' is non-nil. -Use `icomplete-mode' function to set it up properly for incremental -minibuffer completion.") -(add-hook 'icomplete-pre-command-hook 'icomplete-tidy) -;;;_ = icomplete-post-command-hook -(defvar icomplete-post-command-hook nil - "Incremental-minibuffer-completion post-command-hook. - -Is run in minibuffer after user input when `icomplete-mode' is non-nil. -Use `icomplete-mode' function to set it up properly for incremental -minibuffer completion.") -(add-hook 'icomplete-post-command-hook 'icomplete-exhibit) - -(defvar icomplete-show-key-bindings t - "When non-nil, show key bindings as well as completion for sole matches.") - -(defun icomplete-get-keys (func-name) - "Return strings naming keys bound to `func-name', or nil if none. -Examines the prior, not current, buffer, presuming that current buffer -is minibuffer." - (if (commandp func-name) - (save-excursion - (let* ((sym (intern func-name)) - (buf (other-buffer)) - (map (save-excursion (set-buffer buf) (current-local-map))) - (keys (where-is-internal sym map))) - (if keys - (concat "<" - (mapconcat 'key-description - (sort keys - #'(lambda (x y) - (< (length x) (length y)))) - ", ") - ">")))))) - -;;;_ > icomplete-mode (&optional prefix) -;;;###autoload -(defun icomplete-mode (&optional prefix) - "Activate incremental minibuffer completion for this emacs session. -Deactivates with negative universal argument." - (interactive "p") - (or prefix (setq prefix 0)) - (cond ((>= prefix 0) - (setq icomplete-mode t) - ;; The following is not really necessary after first time - - ;; no great loss. - (add-hook 'minibuffer-setup-hook 'icomplete-minibuffer-setup)) - (t (setq icomplete-mode nil)))) - -;;;_ > icomplete-simple-completing-p () -(defun icomplete-simple-completing-p () - "Non-nil if current window is minibuffer that's doing simple completion. - -Conditions are: - the selected window is a minibuffer, - and not in the middle of macro execution, - and minibuffer-completion-table is not a symbol (which would - indicate some non-standard, non-simple completion mechanism, - like file-name and other custom-func completions)." - - (and (window-minibuffer-p (selected-window)) - (not executing-kbd-macro) - (not (symbolp minibuffer-completion-table)))) - -;;;_ > icomplete-minibuffer-setup () -;;;###autoload -(defun icomplete-minibuffer-setup () - "Run in minibuffer on activation to establish incremental completion. -Usually run by inclusion in `minibuffer-setup-hook'." - (cond ((and icomplete-mode (icomplete-simple-completing-p)) - (make-local-hook 'pre-command-hook) - (add-hook 'pre-command-hook - (function (lambda () - (run-hooks 'icomplete-pre-command-hook))) - nil t) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook - (function (lambda () - (run-hooks 'icomplete-post-command-hook))) - nil t) - (run-hooks 'icomplete-minibuffer-setup-hook)))) - -;;;_* Completion - -;;;_ > icomplete-tidy () -(defun icomplete-tidy () - "Remove completions display \(if any) prior to new user input. -Should be run in on the minibuffer `pre-command-hook'. See `icomplete-mode' -and `minibuffer-setup-hook'." - (if (icomplete-simple-completing-p) - (if (and (boundp 'icomplete-eoinput) - icomplete-eoinput) - - (if (> icomplete-eoinput (point-max)) - ;; Oops, got rug pulled out from under us - reinit: - (setq icomplete-eoinput (point-max)) - (let ((buffer-undo-list buffer-undo-list )) ; prevent entry - (delete-region icomplete-eoinput (point-max)))) - - ;; Reestablish the local variable 'cause minibuffer-setup is weird: - (make-local-variable 'icomplete-eoinput) - (setq icomplete-eoinput 1)))) - -;;;_ > icomplete-exhibit () -(defun icomplete-exhibit () - "Insert icomplete completions display. -Should be run via minibuffer `post-command-hook'. See `icomplete-mode' -and `minibuffer-setup-hook'." - (if (icomplete-simple-completing-p) - (let ((contents (buffer-substring (point-min)(point-max))) - (buffer-undo-list t)) - (save-excursion - (goto-char (point-max)) - ; Register the end of input, so we - ; know where the extra stuff - ; (match-status info) begins: - (if (not (boundp 'icomplete-eoinput)) - ;; In case it got wiped out by major mode business: - (make-local-variable 'icomplete-eoinput)) - (setq icomplete-eoinput (point)) - ; Insert the match-status information: - (if (and (> (point-max) 1) - (or - ;; Don't bother with delay after certain number of chars: - (> (point-max) icomplete-max-delay-chars) - ;; Don't delay if alternatives number is small enough: - (if minibuffer-completion-table - (cond ((numberp minibuffer-completion-table) - (< minibuffer-completion-table - icomplete-delay-completions-threshold)) - ((sequencep minibuffer-completion-table) - (< (length minibuffer-completion-table) - icomplete-delay-completions-threshold)) - )) - ;; Delay - give some grace time for next keystroke, before - ;; embarking on computing completions: - (sit-for icomplete-compute-delay))) - (insert-string - (icomplete-completions contents - minibuffer-completion-table - minibuffer-completion-predicate - (not - minibuffer-completion-confirm)))))))) - -;;;_ > icomplete-completions (name candidates predicate require-match) -(defun icomplete-completions (name candidates predicate require-match) - "Identify prospective candidates for minibuffer completion. - -The display is updated with each minibuffer keystroke during -minibuffer completion. - -Prospective completion suffixes (if any) are displayed, bracketed by -one of \(), \[], or \{} pairs. The choice of brackets is as follows: - - \(...) - a single prospect is identified and matching is enforced, - \[...] - a single prospect is identified but matching is optional, or - \{...} - multiple prospects, separated by commas, are indicated, and - further input is required to distinguish a single one. - -The displays for unambiguous matches have ` [Matched]' appended -\(whether complete or not), or ` \[No matches]', if no eligible -matches exist. \(Keybindings for uniquely matched commands are -exhibited within the square braces.)" - - ;; 'all-completions' doesn't like empty - ;; minibuffer-completion-table's (ie: (nil)) - (if (and (listp candidates) (null (car candidates))) - (setq candidates nil)) - - (let ((comps (all-completions name candidates predicate)) - ; "-determined" - only one candidate - (open-bracket-determined (if require-match "(" "[")) - (close-bracket-determined (if require-match ")" "]"))) - ;; `concat'/`mapconcat' is the slow part. With the introduction of - ;; `icomplete-prospects-length', there is no need for `catch'/`throw'. - (if (null comps) (format " %sNo matches%s" - open-bracket-determined - close-bracket-determined) - (let* ((most-try (try-completion name (mapcar (function list) comps))) - (most (if (stringp most-try) most-try (car comps))) - (most-len (length most)) - (determ (and (> most-len (length name)) - (concat open-bracket-determined - (substring most (length name)) - close-bracket-determined))) - (open-bracket-prospects "{") - (close-bracket-prospects "}") - ;"-prospects" - more than one candidate - (prospects-len 0) - prospects most-is-exact comp) - (if (eq most-try t) - (setq prospects nil) - (while (and comps (< prospects-len icomplete-prospects-length)) - (setq comp (substring (car comps) most-len) - comps (cdr comps)) - (cond ((string-equal comp "") (setq most-is-exact t)) - ((member comp prospects)) - (t (setq prospects (cons comp prospects) - prospects-len (+ (length comp) 1 prospects-len)))))) - (if prospects - (concat determ - open-bracket-prospects - (and most-is-exact ",") - (mapconcat 'identity - (sort prospects (function string-lessp)) - ",") - (and comps ",...") - close-bracket-prospects) - (concat determ - " [Matched" - (let ((keys (and icomplete-show-key-bindings - (commandp (intern-soft most)) - (icomplete-get-keys most)))) - (if keys - (concat "; " keys) - "")) - "]")))))) - -(if (string-match "XEmacs\\|Lucid" emacs-version) - (add-hook 'icomplete-minibuffer-setup-hook 'icomplete-exhibit)) - -;;;_* Local emacs vars. -;;;Local variables: -;;;outline-layout: (-2 :) -;;;End: - -;;; icomplete.el ends here diff --git a/xemacs-packages/lisp/edit-utils/id-select.el b/xemacs-packages/lisp/edit-utils/id-select.el deleted file mode 100644 index f17d684b..00000000 --- a/xemacs-packages/lisp/edit-utils/id-select.el +++ /dev/null @@ -1,1291 +0,0 @@ -;;; id-select.el --- Select larger and larger syntax-driven regions in a buffer - -;; Copyright (C) 1996, 1997 InfoDock Associates - -;; Author: Bob Weiner -;; Maintainer: Altrasoft -;; Keywords: matching, mouse - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: InfoDock 4.0.0. - -;;; Commentary: - -;; This is a radically cool, drop in mouse and keyboard-based library for -;; selecting successively bigger syntactical regions within a buffer. -;; Simply load this library and you are ready to try it out by -;; double-clicking on various kinds of characters in different buffer major -;; modes. You'll quickly get the hang of it. (It also provides a command -;; to jump between beginning and end tags within HTML and SGML buffers.) - -;; A great deal of smarts are built-in so that it does the right thing -;; almost all of the time; many other attempts at similar behavior such as -;; thing.el fail to deal with many file format complexities. - -;; Double clicks of the Selection Key (left mouse key) at the same point -;; will select bigger and bigger regions with each successive use. The -;; first double click selects a region based upon the character at the -;; point of the click. For example, with the point over an opening or -;; closing grouping character, such as { or }, the whole grouping is -;; selected, e.g. a C function. When on an _ or - within a programming -;; language variable name, the whole name is selected. The type of -;; selection is displayed in the minibuffer as feedback. When using a -;; language based mainly on indenting, like Bourne shell, a double click on -;; the first alpha character of a line, such as an if statement, selects -;; the whole statement. - -;; --------------- - -;; This whole package is driven by a single function, available in mouse -;; and keyboard forms, that first marks a region based on the syntax -;; category of the character following point. Successive invocations mark -;; larger and larger regions until the whole buffer is marked. See the -;; documentation for the function, id-select-syntactical-region, for the -;; kinds of syntax categories handled. - -;; Loading this package automatically installs its functionalty on -;; double-clicks (or higher) of the left mouse key. (See the documentation -;; for the variable, mouse-track-click-hook, for how this is done.) A -;; single click of the left button will remove the region and reset point. - -;; The function, id-select-thing, may be bound to a key to provide the same -;; syntax-driven region selection functionality. {C-c C-m} is a -;; reasonable site-wide choice since this key is seldom used and it -;; mnemonically indicates marking something. {C-c s} may be preferred as a -;; personal binding. - -;; Use {C-g} to unmark the region when done. Use, -;; id-select-thing-with-mouse, if you want to bind this to a mouse key and -;; thereby use single clicks instead of double clicks. - -;; Three other commands are also provided: -;; id-select-and-copy-thing - mark and copy the syntactical unit to the -;; kill ring -;; id-select-and-kill-thing - kill the syntactical unit at point -;; id-select-goto-matching-tag - In HTML and SGML modes (actually any -;; listed in the variable, `id-select-markup-modes'), moves point to the -;; start of the tag paired with the closest tag that point is within or -;; which it precedes, so you can quickly jump back and forth between -;; open and close tags. - -;; --------------- -;; SETUP: - -;; To autoload this package under XEmacs or InfoDock via mouse usage, add -;; the following line to one of your initialization files. (Don't do this -;; for GNU Emacs.) - -;; (add-hook 'mouse-track-click-hook 'id-select-double-click-hook) - -;; For any version of Emacs you should add the following autoload entries -;; at your site: - -;; (autoload 'id-select-and-kill-thing -;; "id-select" "Kill syntactical region selection" t) -;; (autoload 'id-select-and-copy-thing -;; "id-select" "Select and copy syntactical region" t) -;; (autoload 'id-select-double-click-hook -;; "id-select" "Double mouse click syntactical region selection" nil) -;; (autoload 'id-select-thing -;; "id-select" "Keyboard-driven syntactical region selection" t) -;; (autoload 'id-select-thing-with-mouse -;; "id-select" "Single mouse click syntactical region selection" t) - -;; If you want to be able to select C++ and Java methods and classes by -;; double-clicking on the first character of a definition or on its opening -;; or closing brace, you will need the java-mode-hook and c++-mode-hook -;; settings from InfoDock (all because Sun programmers can't put their -;; opening braces in the first column): - -;; If you want tags, comments, sentences and text blocks to be selectable -;; in HTML mode and you don't have InfoDock, you need to add the following -;; to your personal initializations: (You would do something similar for -;; SGML mode.) - -;; ;; Make tag begin and end delimiters act like grouping characters, -;; ;; for easy syntactical selection of tags. -;; (add-hook 'html-mode-hook -;; (function -;; (lambda () -;; (modify-syntax-entry ?\< "\(\>" html-mode-syntax-table) -;; (modify-syntax-entry ?\> "\)\<" html-mode-syntax-table) -;; (modify-syntax-entry ?\" "\"" html-mode-syntax-table) -;; (modify-syntax-entry ?= "." html-mode-syntax-table) -;; (make-local-variable 'comment-start) -;; (make-local-variable 'comment-end) -;; (setq comment-start "") -;; (make-local-variable 'sentence-end) -;; (setq sentence-end "\\([^ \t\n\r>]<\\|>\\(<[^\>]*>\\)*\\|[.?!][]\"')}]*\\($\\| $\\|\t\\| \\)\\)[ \t\n]*") - -;; (define-key html-mode-map "\C-c." 'id-select-goto-matching-tag) -;; ))) - -;; If you are incredibly academic and you use the Miranda programming -;; language with a literate programming style (where code is preceded by a -;; > character in the first column, you'll want to change the line in -;; mira.el that reads: -;; (modify-syntax-entry ?\> ".") -;; to: -;; (modify-syntax-entry ?\> " ") - -;; in order to make this package recognize the indented expressions of the -;; language. If you don't use the literate style, no changes should be -;; necessary. - -;;; Change Log: - -;;; Code: -;;; ************************************************************************ -;;; Public variables -;;; ************************************************************************ - -(defgroup id-select nil - "Select larger and larger syntax-driven regions in a buffer" - :group 'matching - :group 'mouse) - - -(defcustom id-select-brace-modes - '(c++-mode c-mode java-mode objc-mode perl-mode tcl-mode) - "*List of language major modes which define things with brace delimiters." - :type '(repeat (symbol :tag "Mode" symbol)) - :group 'id-select) - -(defcustom id-select-markup-modes - '(html-mode sgml-mode) - "*List of markup language modes that use SGML-style pairs." - :type '(repeat (symbol :tag "Mode")) - :group 'id-select) - -(defcustom id-select-text-modes - '(fundamental-mode kotl-mode indented-text-mode Info-mode outline-mode text-mode) - "*List of textual modes where paragraphs may be outdented or indented." - :type '(repeat (symbol :tag "Mode")) - :group 'id-select) - -(defcustom id-select-indent-modes - (append '(altmath-mode asm-mode csh-mode eiffel-mode ksh-mode math-mode - miranda-mode python-mode pascal-mode sather-mode) - id-select-text-modes) - "*List of language major modes which use mostly indentation to define syntactic structure." - :type '(repeat (symbol :tag "Mode")) - :group 'id-select) - -(defvar id-select-indent-non-end-regexp-alist - '((altmath-mode "[^ \t\n]\\|[ \t\n]*\n\\s-") - (csh-mode "\\(\\|then\\|elsif\\|else\\)[ \t]*$") - (eiffel-mode "\\(\\|then\\|else if\\|else\\)[ \t]*$") - (ksh-mode "\\(\\|then\\|elif\\|else\\)[ \t]*$") - (math-mode "[^ \t\n]\\|[ \t\n]*\n\\s-") - (miranda-mode "[ \t>]*$") - (pascal-mode "\\(\\|then\\|else\\)[ \t]*$") - (python-mode "[ \t]*$") - (sather-mode "\\(\\|then\\|else if\\|else\\)[ \t]*$") - ;; - (fundamental-mode "[^ \t\n*]") - (kotl-mode "[^ \t\n*]") - (indented-text-mode "[^ \t\n*]") - (Info-mode "[^ \t\n]") - (outline-mode "[^*]") - (text-mode "[^ \t\n*]") - ) - "List of (major-mode . non-terminator-line-regexp) elements used to avoid early dropoff when marking indented code.") - -(defvar id-select-indent-end-regexp-alist - '((altmath-mode "[ \t\n]*\n\\S-") - (csh-mode "end\\|while") - (eiffel-mode "end") - (ksh-mode "\\(fi\\|esac\\|until\\|done\\)[ \t\n]") - (math-mode "[ \t\n]*\n\\S-") - (pascal-mode "end") - (sather-mode "end") - ;; - (fundamental-mode "[ \t]*$") - (indented-text-mode "[ \t]*$") - (Info-mode "[ \t]*$") - (text-mode "[ \t]*$") - ) - "List of (major-mode . terminator-line-regexp) elements used to include a final line when marking indented code.") - -(defcustom id-select-char-p t - "*If t, return single character boundaries when all else fails." - :type 'boolean - :group 'id-select) - -(defcustom id-select-display-type t - "*If t, display the thing selected with each mouse click." - :type 'boolean - :group 'id-select) - -(defcustom id-select-whitespace t - "*If t, groups of whitespace are considered as things." - :type 'boolean - :group 'id-select) - -;;; ************************************************************************ -;;; Public functions -;;; ************************************************************************ - -;; -;; Commands -;; - -;;;###autoload -(defun id-select-install () - "Install the id-select mode as the default mode of operation." - (interactive) - (if (string-match "XEmacs" emacs-version) - (add-hook 'mouse-track-click-hook 'id-select-double-click-hook) - (if (string-match "^19\\." emacs-version) - (progn (transient-mark-mode 1) - (global-set-key [mouse-1] 'mouse-set-point) - (global-set-key [double-mouse-1] 'id-select-thing-with-mouse) - (global-set-key [triple-mouse-1] 'id-select-thing-with-mouse))))) - -;;;###autoload -(defun id-select-thing () - "Mark the region selected by the syntax of the thing at point. -If invoked repeatedly, selects bigger and bigger things. -If `id-select-display-type' is non-nil, the type of selection is displayed in -the minibuffer." - (interactive - (cond ((and (fboundp 'region-active-p) (region-active-p)) - nil) - ((and (boundp 'transient-mark-mode) transient-mark-mode mark-active) - nil) - (t - ;; Reset selection based on the syntax of character at point. - (id-select-reset) - nil))) - (let ((region (id-select-boundaries (point)))) - (if region - (progn (goto-char (car region)) - (set-mark (cdr region)) - (if (fboundp 'activate-region) (activate-region)) - (if (and (boundp 'transient-mark-mode) - transient-mark-mode) - (setq mark-active t)) - (and (interactive-p) id-select-display-type - (message "%s" id-select-previous)) - (run-hooks 'id-select-thing-hook) - t)))) - -;;;###autoload -(defun id-select-thing-with-mouse (event) - "Select a region based on the syntax of the character from a mouse click. -If the click occurs at the same point as the last click, select -the next larger syntactic structure. If `id-select-display-type' is non-nil, -the type of selection is displayed in the minibuffer." - (interactive "@e") - (cond ((and (eq id-select-prior-point (point)) - (eq id-select-prior-buffer (current-buffer))) - ;; Prior click was at the same point as before, so enlarge - ;; selection to the next bigger item. - (if (and (id-select-bigger-thing) id-select-display-type) - (progn - ;; Conditionally, save selected region for pasting. - (cond - ;; XEmacs >= 21.2-b?? - ((fboundp 'own-selection) - (own-selection (buffer-substring (point) (mark)))) - ;; XEmacs - ((fboundp 'x-store-cutbuffer) - (x-store-cutbuffer (buffer-substring (point) (mark)))) - ;; Emacs 19 - ((and (boundp 'interprogram-cut-function) - interprogram-cut-function) - (x-set-selection 'PRIMARY (buffer-substring (point) (mark))))) - (message "%s" id-select-previous))) - t) - (t (setq this-command 'mouse-start-selection) - (id-select-reset) - (id-select-thing-with-mouse event)))) - -;;;###autoload -(defun id-select-goto-matching-tag () - "If in a major mode listed in `id-select-markup-modes,' moves point to the start of the tag paired with the closest tag that point is within or precedes. -Returns t if point is moved, else nil. -Signals an error if no tag is found following point or if the closing tag -does not have a `>' terminator character." - (interactive) - (if (not (memq major-mode id-select-markup-modes)) - nil - (let ((result) - ;; Assume case of tag names is irrelevant. - (case-fold-search t) - (opoint (point)) - (tag) - end-point - start-regexp - end-regexp) - - ;; Leave point at the start of the tag that point is within or that - ;; follows point. - (cond - ;; Point is at the start of a tag. - ((looking-at "<[^<> \t\n\r]")) - ;; Point was within a tag. - ((and (re-search-backward "[<>]" nil t) - (looking-at "<[^<> \t\n\r]"))) - ;; Move to following tag. - ((and (re-search-forward "<" nil t) - (progn (backward-char 1) - (looking-at "<[^<> \t\n\r]")))) - ;; No tag follows point. - (t (error "(id-select-goto-matching-tag): No tag found after point."))) - - (if (catch 'done - (cond - ;; Beginning of a tag pair - ((looking-at "<[^/][^<> \t\n\r]*") - (setq tag (buffer-substring (match-beginning 0) (match-end 0)) - start-regexp (regexp-quote tag) - end-regexp (concat "= count 0) - (re-search-forward regexp nil t)) - (setq match-point (match-beginning 0)) - (if (/= (char-after (1+ (match-beginning 0))) ?/) - ;; Start tag - (setq count (1+ count)) - ;; End tag - (setq end-point (point)) - (if (or (not (re-search-forward "[<>]" nil t)) - (= (preceding-char) ?<)) - ;; No terminator character `>' for end tag - (progn (setq result end-point) - (throw 'done nil))) - (setq count (1- count)) - (if (= count 0) - (progn - (goto-char match-point) - (setq result t) - (throw 'done result))))))) - ;; - ;; End of a tag pair - ((or (looking-at " \t\n\r]+") - (and (skip-chars-backward "<") - (looking-at " \t\n\r]+"))) - (goto-char (match-end 0)) - (setq tag (buffer-substring (match-beginning 0) (match-end 0)) - end-regexp (regexp-quote tag) - start-regexp (concat "<" (substring end-regexp 2))) - (setq end-point (point)) - (if (or (not (re-search-forward "[<>]" nil t)) - (= (preceding-char) ?<)) - ;; No terminator character `>' for end tag - (progn (setq result end-point) - (throw 'done nil))) - ;; Skip over nested tags. - (let ((count 0) - (regexp (concat start-regexp "\\|" end-regexp))) - (while (and (>= count 0) - (re-search-backward regexp nil t)) - (if (= (char-after (1+ (point))) ?/) - ;; End tag - (setq count (1+ count)) - ;; Start tag - (setq count (1- count)) - (if (= count 0) - (progn - (setq result t) - (throw 'done t))))))))) - nil - ;; Didn't find matching tag. - (goto-char opoint)) - - (cond ((integerp result) - (goto-char result) - (error "(id-select-goto-matching-tag): Add a terminator character for this end ")) - ((null tag) - (error "(id-select-goto-matching-tag): No following point")) - ((null result) - (if (interactive-p) - (progn - (beep) - (message "(id-select-goto-matching-tag): No matching tag for %s>" - tag) - result))) - (t result))))) - -;;;###autoload -(defun id-select-and-copy-thing () - "Copy the region surrounding the syntactical unit at point." - (interactive) - (let ((bounds (id-select-boundaries (point)))) - (if bounds (copy-region-as-kill (car bounds) (cdr bounds))))) - -;;;###autoload -(defun id-select-and-kill-thing () - "Kill the region surrounding the syntactical unit at point." - (interactive "*") - (let ((bounds (id-select-boundaries (point)))) - (if bounds (kill-region (car bounds) (cdr bounds))))) - - -;; -;; Functions -;; - -(defun id-select-boundaries (pos) - "Return the (start . end) of a syntactically defined region based upon the last region selected or on position POS. -The character at POS is selected if no other thing is matched." - (interactive) - (setq zmacs-region-stays t) - (setcar id-select-old-region (car id-select-region)) - (setcdr id-select-old-region (cdr id-select-region)) - (let ((prior-type id-select-previous)) - (cond - ((eq id-select-previous 'char) - (id-select-syntactical-region pos)) - ((and (car id-select-old-region) - (memq id-select-previous - '(sexp sexp-start sexp-end sexp-up)) - (id-select-sexp-up pos) - (id-select-region-bigger-p id-select-old-region id-select-region)) - id-select-region) - ;; - ;; In the general case, we can't know ahead of time what the next - ;; biggest type of thing to select is, so we test them all and choose - ;; the best fit. This means that dynamically, the order of type - ;; selection will change based on the buffer context. - (t (let ((min-region (1+ (- (point-max) (point-min)))) - (result) - region region-size) - (mapcar - (function - (lambda (sym-func) - (setq region - (if (car (cdr sym-func)) - (funcall (car (cdr sym-func)) pos))) - (if (and region (car region) - (id-select-region-bigger-p - id-select-old-region region) - (setq region-size - (- (cdr region) (car region))) - (< region-size min-region)) - (setq min-region region-size - result - (list - ;; The actual selection type is - ;; sometimes different than the one we - ;; originally tried, so recompute it here. - (car (assq id-select-previous - id-select-bigger-alist)) - (car region) (cdr region)))))) - id-select-bigger-alist) - (if result - ;; Returns id-select-region - (progn (setq id-select-previous (car result)) - (id-select-set-region (nth 1 result) (nth 2 result))) - ;; - ;; Restore prior selection type since we failed to find a - ;; new one. - (setq id-select-previous prior-type) - (beep) - (message - "(id-select-boundaries): `%s' is the largest selectable region" - id-select-previous) - nil)))))) - -;;;###autoload -(defun id-select-double-click-hook (event click-count) - "Select a region based on the syntax of the character wherever the mouse is double-clicked. -If the double-click occurs at the same point as the last double-click, select -the next larger syntactic structure. If `id-select-display-type' is non-nil, -the type of selection is displayed in the minibuffer." - (cond ((/= click-count 2) - ;; Return nil so any other hooks are performed. - nil) - (t (id-select-thing-with-mouse event)))) - -(defun id-select-syntactical-region (pos) - "Return the (start . end) of a syntactically defined region based upon the buffer position POS. -Uses `id-select-syntax-alist' and the current buffer's syntax table to -determine syntax groups. - -Typically: - Open or close grouping character syntax marks an s-expression. - Double quotes mark strings. - The end of a line marks the line, including its trailing newline. - Word syntax marks the current word. - Symbol syntax (such as _) marks a symbol. - Whitespace marks a span of whitespace. - Comment start or end syntax marks the comment. - Punctuation syntax marks the words on both sides of the punctuation. - The fallback default is to mark the character at POS. - -If an error occurs during syntax scanning, it returns nil." - (interactive "d") - (setq id-select-previous 'char) - (if (save-excursion (goto-char pos) (eolp)) - (id-select-line pos) - (let* ((syntax (char-syntax (if (eobp) (preceding-char) (char-after pos)))) - (pair (assq syntax id-select-syntax-alist))) - (cond ((and pair - (or id-select-whitespace - (not (eq (car (cdr pair)) 'thing-whitespace)))) - (funcall (car (cdr pair)) pos)) - (id-select-char-p - (setq id-select-previous 'char) - (id-select-set-region pos (1+ pos))) - (t - nil))))) - -;;; ************************************************************************ -;;; Private functions -;;; ************************************************************************ - -(defun id-select-at-blank-line-or-comment () - "Return non-nil if on a blank line or a comment start or end line. -Assumes point is before any non-whitespace character on the line." - (let ((comment-end-p (and (stringp comment-end) - (not (string-equal comment-end ""))))) - (if (looking-at - (concat "\\s-*$\\|\\s-*\\(//\\|/\\*\\|.*\\*/" - (if comment-start - (concat - "\\|" (regexp-quote comment-start))) - (if comment-end-p - (concat - "\\|.*" (regexp-quote comment-end))) - "\\)")) - (or (not (and comment-start comment-end-p)) - ;; Ignore start and end of comments that - ;; follow non-commented text. - (not (looking-at - (format ".*\\S-.*%s.*%s" - (regexp-quote comment-start) - (regexp-quote comment-end)))))))) - -(defun id-select-back-to-indentation () - "Move point to the first non-whitespace character on this line and return point. -This respects the current syntax table definition of whitespace, whereas -`back-to-indentation' does not. This is relevant in literate programming and -mail and news reply modes." - (goto-char (min (progn (end-of-line) (point)) - (progn (beginning-of-line) - (skip-syntax-forward " ") - (point))))) - -(defun id-select-bigger-thing () - "Select a bigger object where point is." - (prog1 - (id-select-thing) - (setq this-command 'select-thing))) - -(defun id-select-region-bigger-p (old-region new-region) - "Return t if OLD-REGION is smaller than NEW-REGION and NEW-REGION partially overlaps OLD-REGION, or if OLD-REGION is uninitialized." - (if (null (car old-region)) - t - (and (> (abs (- (cdr new-region) (car new-region))) - (abs (- (cdr old-region) (car old-region)))) - ;; Ensure the two regions intersect. - (or (and (<= (min (cdr new-region) (car new-region)) - (min (cdr old-region) (car old-region))) - (> (max (cdr new-region) (car new-region)) - (min (cdr old-region) (car old-region)))) - (and (> (min (cdr new-region) (car new-region)) - (min (cdr old-region) (car old-region))) - (<= (min (cdr new-region) (car new-region)) - (max (cdr old-region) (car old-region)))))))) - -(defun id-select-reset () - ;; Reset syntactic selection. - (setq id-select-prior-point (point) - id-select-prior-buffer (current-buffer) - id-select-previous 'char) - (id-select-set-region nil nil)) - -(defun id-select-set-region (beginning end) - "Set the cons cell held by the variable `id-select-region' to (BEGINNING . END). -Return the updated cons cell." - (setcar id-select-region beginning) - (setcdr id-select-region end) - (if (and (null beginning) (null end)) - (progn (setcar id-select-old-region nil) - (setcdr id-select-old-region nil))) - (if (and (not (eq id-select-previous 'buffer)) - (integerp beginning) (integerp end) - (= beginning (point-min)) (= end (point-max))) - ;; If we selected the whole buffer, make sure that 'thing' type is 'buffer'. - nil - id-select-region)) - -(defun id-select-string-p (&optional start-delim end-delim) - "Returns (start . end) of string whose first line point is within or immediately before. -Positions include delimiters. String is delimited by double quotes unless -optional START-DELIM and END-DELIM (strings) are given. -Returns nil if not within a string." - (let ((opoint (point)) - (count 0) - bol start delim-regexp start-regexp end-regexp) - (or start-delim (setq start-delim "\"")) - (or end-delim (setq end-delim "\"")) - ;; Special case for the empty string. - (if (looking-at (concat (regexp-quote start-delim) - (regexp-quote end-delim))) - (id-select-set-region (point) (match-end 0)) - (setq start-regexp (concat "\\(^\\|[^\\]\\)\\(" - (regexp-quote start-delim) "\\)") - end-regexp (concat "[^\\]\\(" (regexp-quote end-delim) "\\)") - delim-regexp (concat start-regexp "\\|" end-regexp)) - (save-excursion - (beginning-of-line) - (setq bol (point)) - (while (re-search-forward delim-regexp opoint t) - (setq count (1+ count)) - ;; This is so we don't miss the closing delimiter of an empty - ;; string. - (if (and (= (point) (1+ bol)) - (looking-at (regexp-quote end-delim))) - (setq count (1+ count)) - (if (bobp) nil (backward-char 1)))) - (goto-char opoint) - (if (and (zerop count) (not (looking-at start-regexp))) - ;; Not within or at the beginning of a string. - nil - ;; If found an even # of starting and ending delimiters before - ;; opoint, then opoint is at the start of a string, where we want it. - (if (zerop (mod count 2)) - (if (bobp) nil (backward-char 1)) - (re-search-backward start-regexp nil t)) - ;; Point is now before the start of the string. - (if (re-search-forward start-regexp nil t) - (progn - (setq start (match-beginning 2)) - (if (re-search-forward end-regexp nil t) - (id-select-set-region start (point)))))))))) - -;;; -;;; Code selections -;;; - -(defun id-select-brace-def-or-declaration (pos) - "If POS is at the first character, opening brace or closing brace of a brace delimited language definition, return (start . end) region, else nil. -The major mode for each supported brace language must be included in the -list, id-select-brace-modes." - (interactive) - (if (not (and (featurep 'cc-mode) (memq major-mode id-select-brace-modes))) - nil - (save-excursion - (goto-char pos) - (let ((at-def-brace - (or (looking-at "^{") (looking-at "^}") - ;; Handle stupid old C-style and new Java - ;; style of putting braces at the end of - ;; lines. - (and (= (following-char) ?{) - (stringp defun-prompt-regexp) - (save-excursion - (beginning-of-line) - (looking-at defun-prompt-regexp))) - (and (= (following-char) ?}) - (stringp defun-prompt-regexp) - (condition-case () - (progn - ;; Leave point at opening brace. - (goto-char - (scan-sexps (1+ (point)) -1)) - ;; Test if these are defun braces. - (save-excursion - (beginning-of-line) - (looking-at defun-prompt-regexp))) - (error nil))))) - eod) - (if (or at-def-brace - ;; At the start of a definition: - ;; Must be at the first non-whitespace character in the line. - (and (= (point) (save-excursion (id-select-back-to-indentation))) - ;; Must be on an alpha or symbol-constituent character. - ;; Also allow ~ for C++ destructors. - (looking-at "[a-zA-z~]\\|\\s_") - ;; Previous line, if any, must be blank or a comment - ;; start or end or we must be looking at - ;; `defun-prompt-regexp' when at the beginning of the line. - (or (and (stringp defun-prompt-regexp) - (save-excursion - (beginning-of-line) - (looking-at defun-prompt-regexp))) - (save-excursion - (if (/= (forward-line -1) 0) - t - (id-select-at-blank-line-or-comment)))))) - (progn - (setq id-select-previous 'brace-def-or-declaration) - ;; Handle declarations and definitions embedded within classes. - (if (and (eq (following-char) ?{) - (/= (point) (save-excursion - (id-select-back-to-indentation)))) - (setq at-def-brace nil)) - ;; - (if at-def-brace nil (beginning-of-line)) - (if (and (not at-def-brace) - (stringp defun-prompt-regexp) - (or (looking-at defun-prompt-regexp) - ;; For Java classes mainly - (looking-at "[a-zA-Z_$. \t]+\\s-*\{"))) - ;; Mark the declaration or definition - (id-select-set-region - (point) - (progn (goto-char (match-end 0)) - (if (eq (preceding-char) ?{) - (backward-char 1)) - (if (eq (following-char) ?{) - (forward-list 1) - (search-forward ";" nil t)) - (skip-chars-forward " \t") - (skip-chars-forward "\n") - (if (looking-at "^\\s-*$") - (forward-line 1)) - (point))) - ;; Mark function definitions only - (setq eod (save-excursion - (condition-case () - (progn - (if (and (eq major-mode 'java-mode) - (fboundp 'id-java-end-of-defun)) - (id-java-end-of-defun) - (end-of-defun)) - (if (looking-at "^\\s-*$") - (forward-line 1)) - (point)) - (error (point-max))))) - (if (= (following-char) ?}) - ;; Leave point at opening brace. - (goto-char (scan-sexps (1+ (point)) -1))) - (if (= (following-char) ?{) - (progn - (while (and (zerop (forward-line -1)) - (not (id-select-at-blank-line-or-comment)))) - (if (id-select-at-blank-line-or-comment) - (forward-line 1)))) - ;; Mark the whole definition - (setq id-select-previous 'brace-def-or-declaration) - (id-select-set-region (point) eod)))))))) - -(defun id-select-indent-def (pos) - "If POS is at the first alpha character on a line, return (start . end) region, - -The major mode for each supported indented language must be included in the -list, id-select-indent-modes." - (interactive) - (if (not (memq major-mode id-select-indent-modes)) - nil - (save-excursion - (goto-char pos) - (if (and - ;; Use this function only if point is on the first non-blank - ;; character of a block, whatever a block is for the current - ;; mode. - (cond ((eq major-mode 'kotl-mode) - (and (looking-at "[1-9*]") (not (kview:valid-position-p)))) - ((or (eq major-mode 'outline-mode) selective-display) - (save-excursion (beginning-of-line) - (looking-at outline-regexp))) - ;; After indent in any other mode, must be on an alpha - ;; or symbol-constituent character. - (t (looking-at "[a-zA-z]\\|\\s_"))) - ;; Must be at the first non-whitespace character in the line. - (= (point) (save-excursion (id-select-back-to-indentation)))) - (let* ((start-col (current-column)) - (opoint (if (eq major-mode 'kotl-mode) - (progn (kotl-mode:to-valid-position) (point)) - (beginning-of-line) (point)))) - (while - (and (zerop (forward-line 1)) - (bolp) - (or (progn (id-select-back-to-indentation) - (> (current-column) start-col)) - ;; If in a text mode, allow outdenting, otherwise - ;; only include special lines here indented to the - ;; same point as the original line. - (and (or (memq major-mode id-select-text-modes) - (= (current-column) start-col)) - (looking-at - (or (car (cdr - (assq - major-mode - id-select-indent-non-end-regexp-alist))) - "\\'")))))) - (if (and (looking-at - (or (car (cdr (assq major-mode - id-select-indent-end-regexp-alist))) - "\\'")) - (or (memq major-mode id-select-text-modes) - (= (current-column) start-col))) - (forward-line 1)) - (beginning-of-line) - ;; Mark the whole definition - (setq id-select-previous 'indent-def) - (id-select-set-region opoint (point))))))) - -(defun id-select-symbol (pos) - "Return (start . end) of a symbol at POS." - (or (id-select-markup-pair pos) - ;; Test for indented def here since might be on an '*' representing - ;; an outline entry, in which case we mark entries as indented blocks. - (id-select-indent-def pos) - (save-excursion - (if (memq (char-syntax (if (eobp) (preceding-char) (char-after pos))) - '(?w ?_)) - (progn (setq id-select-previous 'symbol) - (condition-case () - (let ((end (scan-sexps pos 1))) - (id-select-set-region - (min pos (scan-sexps end -1)) end)) - (error nil))))))) - -(defun id-select-sexp-start (pos) - "Return (start . end) of sexp starting at POS." - (or (id-select-markup-pair pos) - (id-select-brace-def-or-declaration pos) - (save-excursion - (setq id-select-previous 'sexp-start) - (condition-case () - (id-select-set-region pos (scan-sexps pos 1)) - (error nil))))) - -(defun id-select-sexp-end (pos) - "Return (start . end) of sexp ending at POS." - (or (id-select-brace-def-or-declaration pos) - (save-excursion - (setq id-select-previous 'sexp-end) - (condition-case () - (id-select-set-region (scan-sexps (1+ pos) -1) (1+ pos)) - (error nil))))) - -(defun id-select-sexp (pos) - "Return (start . end) of the sexp that POS is within." - (setq id-select-previous 'sexp) - (save-excursion - (goto-char pos) - (condition-case () - (id-select-set-region (progn (backward-up-list 1) (point)) - (progn (forward-list 1) (point))) - (error nil)))) - -(defun id-select-sexp-up (pos) - "Return (start . end) of the sexp enclosing the selected area or nil." - (setq id-select-previous 'sexp-up) - ;; Keep going up and backward in sexps. This means that id-select-sexp-up - ;; can only be called after id-select-sexp or after itself. - (setq pos (or (car id-select-region) pos)) - (save-excursion - (goto-char pos) - (condition-case () - (id-select-set-region (progn (backward-up-list 1) (point)) - (progn (forward-list 1) (point))) - (error nil)))) - -(defun id-select-preprocessor-def (pos) - "Return (start . end) of a preprocessor #definition starting at POS, if any. -The major mode for each language that uses # preprocessor notation must be -included in the list, id-select-brace-modes." - ;; Only applies in brace modes (strictly, this should apply in a subset - ;; of brace modes, but doing it this way permits for configurability. In - ;; other modes, one doesn't have to use the function on a # symbol. - (if (not (memq major-mode id-select-brace-modes)) - nil - (setq id-select-previous 'preprocessor-def) - (save-excursion - (goto-char pos) - (if (and (= (following-char) ?#) - ;; Must be at the first non-whitespace character in the line. - (= (point) (save-excursion (id-select-back-to-indentation)))) - (progn - ;; Skip past continuation lines that end with a backslash. - (while (and (looking-at ".*\\\\\\s-*$") - (zerop (forward-line 1)))) - (forward-line 1) - ;; Include one trailing blank line, if any. - (if (looking-at "^[ \t\n\r]*$") (forward-line 1)) - (id-select-set-region pos (point))))))) - -;; Allow punctuation marks not followed by white-space to include -;; the previous and subsequent sexpression. Useful in contexts such as -;; 'foo.bar'. -(defun id-select-punctuation (pos) - "Return (start . end) region including sexpressions before and after POS, when at a punctuation character." - (or (id-select-comment pos) - (id-select-preprocessor-def pos) - (id-select-brace-def-or-declaration pos) ;; Might be on a C++ ;; destructor ~. - (save-excursion - (setq id-select-previous 'punctuation) - (goto-char (min (1+ pos) (point-max))) - (if (string-match "[ \t\n\r]" (char-to-string - (if (eobp) (preceding-char) - (char-after (point))))) - (id-select-set-region pos (1+ pos)) - (goto-char pos) - (condition-case () - (id-select-set-region - (save-excursion (backward-sexp) (point)) - (progn (forward-sexp) (point))) - (error nil)))))) - -(defun id-select-comment (pos) - "Return rest of line from POS to newline." - (setq id-select-previous 'comment) - (save-excursion - (goto-char pos) - (let ((start-regexp (if (stringp comment-start) - (regexp-quote comment-start))) - (end-regexp (if (stringp comment-end) - (regexp-quote comment-end))) - bolp) - (cond - ;; Beginning of a comment - ((and (stringp comment-start) - (or (looking-at start-regexp) - (and (skip-chars-backward comment-start) - (looking-at start-regexp)))) - (skip-chars-backward " \t") - (setq bolp (bolp) - pos (point)) - (if (equal comment-end "") - (progn (end-of-line) - (id-select-set-region pos (point))) - (if (stringp comment-end) - ;; Skip over nested comments. - (let ((count 0) - (regexp (concat start-regexp "\\|" end-regexp))) - (catch 'done - (while (re-search-forward regexp nil t) - (if (string-equal - (buffer-substring (match-beginning 0) (match-end 0)) - comment-start) - (setq count (1+ count)) - ;; End comment - (setq count (1- count)) - (if (= count 0) - (progn - (if (looking-at "[ \t]*[\n\r]") - ;; Don't include final newline unless the - ;; comment is first thing on its line. - (goto-char (if bolp (match-end 0) - (1- (match-end 0))))) - (throw 'done (id-select-set-region - pos (point)))))))))))) - ;; End of a comment - ((and (stringp comment-end) - (not (string-equal comment-end "")) - (or (looking-at end-regexp) - (and (skip-chars-backward comment-end) - (looking-at end-regexp)))) - (goto-char (match-end 0)) - (if (looking-at "[ \t]*[\n\r]") - (goto-char (match-end 0))) - (setq pos (point)) - (skip-chars-forward " \t") - ;; Skip over nested comments. - (let ((count 0) - (regexp (concat start-regexp "\\|" end-regexp))) - (catch 'done - (while (re-search-backward regexp nil t) - (if (string-equal - (buffer-substring (match-beginning 0) (match-end 0)) - comment-end) - (setq count (1+ count)) - ;; Begin comment - (setq count (1- count)) - (if (= count 0) - (progn - (skip-chars-backward " \t") - ;; Don't include final newline unless the comment is - ;; first thing on its line. - (if (bolp) nil (setq pos (1- pos))) - (throw 'done (id-select-set-region - (point) pos))))))))))))) - -;;; -;;; Textual selections -;;; - -(defun id-select-word (pos) - "Return (start . end) of word at POS." - (or (id-select-brace-def-or-declaration pos) - (id-select-indent-def pos) - (progn (setq id-select-previous 'word) - (save-excursion - (goto-char pos) - (forward-word 1) - (let ((end (point))) - (forward-word -1) - (id-select-set-region (point) end)))))) - -(defun id-select-string (pos) - "Returns (start . end) of string at POS or nil. Pos include delimiters. -Delimiters may be single, double or open and close quotes." - (setq id-select-previous 'string) - (save-excursion - (goto-char pos) - (if (and (memq major-mode id-select-markup-modes) - (/= (following-char) ?\") - (save-excursion - (and (re-search-backward "[<>]" nil t) - (= (following-char) ?>)))) - (progn (setq id-select-previous 'text) - (search-backward ">" nil t) - (id-select-set-region - (1+ (point)) - (progn (if (search-forward "<" nil 'end) - (1- (point)) - (point))))) - (or (id-select-string-p) (id-select-string-p "'" "'") - (id-select-string-p "`" "'"))))) - -(defun id-select-sentence (pos) - "Return (start . end) of the sentence at POS." - (setq id-select-previous 'sentence) - (save-excursion - (goto-char pos) - (condition-case () - (id-select-set-region (progn (backward-sentence) (point)) - (progn (forward-sentence) (point))) - (error nil)))) - -(defun id-select-whitespace (pos) - "Return (start . end) of all but one char of whitespace POS, unless -there is only one character of whitespace or this is leading whitespace on -the line. Then return all of it." - (setq id-select-previous 'whitespace) - (save-excursion - (goto-char pos) - (if (= (following-char) ?\^L) - (id-select-page pos) - (let ((end (progn (skip-chars-forward " \t") (point))) - (start (progn (skip-chars-backward " \t") (point)))) - (if (looking-at "[ \t]") - (if (or (bolp) (= (1+ start) end)) - (id-select-set-region start end) - (id-select-set-region (1+ start) end))))))) - -(defun id-select-markup-pair (pos) - "Return (start . end) of region between the opening and closing of an HTML or SGML tag pair, one of which is at POS. -The major mode for each language that uses such tags must be included in the -list, id-select-markup-modes." - (if (not (memq major-mode id-select-markup-modes)) - nil - (setq id-select-previous 'markup-pair) - (let ((pos-with-space) - ;; Assume case of tag names is irrelevant. - (case-fold-search t) - (result) - start-regexp - end-regexp - bolp - opoint) - (save-excursion - (catch 'done - (goto-char pos) - (cond - ;; Beginning of a tag pair - ((looking-at "<[^/][^<> \t\n\r]*") - (setq start-regexp (regexp-quote (buffer-substring - (match-beginning 0) (match-end 0))) - end-regexp (concat "= count 0) - (re-search-forward regexp nil t)) - (if (/= (char-after (1+ (match-beginning 0))) ?/) - ;; Start tag - (setq count (1+ count)) - ;; Move past end tag terminator - (setq opoint (point)) - (if (or (not (re-search-forward "[<>]" nil t)) - (= (preceding-char) ?<)) - (progn (setq result opoint) - (throw 'done nil))) - (setq count (1- count)) - (if (= count 0) - (progn - (if (looking-at "[ \t]*[\n\r]") - ;; Don't include final newline unless the - ;; start tag was the first thing on its line. - (if bolp - (progn (goto-char (match-end 0)) - ;; Include leading space since the - ;; start and end tags begin and end - ;; lines. - (setq pos pos-with-space)) - (goto-char (1- (match-end 0))))) - (setq result (id-select-set-region pos (point))) - (throw 'done nil))))))) - ;; - ;; End of a tag pair - ((or (looking-at " \t\n\r]+") - (and (skip-chars-backward "<") - (looking-at " \t\n\r]+"))) - (goto-char (match-end 0)) - (setq end-regexp (regexp-quote (buffer-substring - (match-beginning 0) (match-end 0))) - start-regexp (concat "<" (substring end-regexp 2))) - (setq opoint (point)) - (if (or (not (re-search-forward "[<>]" nil t)) - (= (preceding-char) ?<)) - (progn (setq result opoint) - (throw 'done nil))) - (setq pos (point)) - (if (looking-at "[ \t]*[\n\r]") - (setq pos-with-space (match-end 0))) - ;; Skip over nested tags. - (let ((count 0) - (regexp (concat start-regexp "\\|" end-regexp))) - (while (and (>= count 0) - (re-search-backward regexp nil t)) - (if (= (char-after (1+ (point))) ?/) - ;; End tag - (setq count (1+ count)) - ;; Start tag - (setq count (1- count)) - (if (= count 0) - (progn - (if pos-with-space - ;; Newline found after original end tag. - (progn - (skip-chars-backward " \t") - (if (bolp) - ;; Don't include final newline unless the - ;; start tag is the first thing on its line. - (setq pos pos-with-space) - (setq pos (1- pos-with-space)) - ;; Don't include non-leading space. - (skip-chars-forward " \t")))) - (setq result (id-select-set-region (point) pos)) - (throw 'done nil)))))))))) - (if (integerp result) - (progn (goto-char result) - (error "(id-select-markup-pair): Add a terminator character for this end tag")) - result)))) - -;;; -;;; Document selections -;;; - -(defun id-select-line (pos) - "Return (start . end) of the whole line POS is in, with newline unless at end of buffer." - (setq id-select-previous 'line) - (save-excursion - (goto-char pos) - (let* ((start (progn (beginning-of-line 1) (point))) - (end (progn (forward-line 1) (point)))) - (id-select-set-region start end)))) - -(defun id-select-paragraph (pos) - "Return (start . end) of the paragraph at POS." - (setq id-select-previous 'paragraph) - (save-excursion - (goto-char pos) - (if (looking-at paragraph-start) (forward-paragraph)) - (id-select-set-region (progn (backward-paragraph) (point)) - (progn (forward-paragraph) (point))))) - -(defun id-select-page (pos) - "Return (start . end) of the page preceding POS." - (setq id-select-previous 'page) - (save-excursion - (goto-char pos) - (id-select-set-region (progn (backward-page) (point)) - (progn (forward-page) (point))))) - -(defun id-select-buffer (pos) - "Return (start . end) of the buffer at POS." - (setq id-select-previous 'buffer) - (id-select-set-region (point-min) (point-max))) - -;;; ************************************************************************ -;;; Private variables -;;; ************************************************************************ - -(defvar id-select-bigger-alist - '((char nil) - (whitespace id-select-whitespace) - (word id-select-word) - (symbol id-select-symbol) - (punctuation nil) - (string id-select-string) - (text nil) - (comment id-select-comment) - (markup-pair nil) - (preprocessor-def nil) - (sexp id-select-sexp) - (sexp-start nil) - (sexp-end nil) - (sexp-up id-select-sexp-up) - (line id-select-line) - (sentence id-select-sentence) - (brace-def-or-declaration id-select-brace-def-or-declaration) - (indent-def id-select-indent-def) - (paragraph id-select-paragraph) - (page id-select-page) - (buffer id-select-buffer) - ) - "List of (REGION-TYPE-SYMBOL REGION-SELECTION-FUNCTION) pairs. -Used to go from one thing to a bigger thing. See id-select-bigger-thing. -Nil value for REGION-SELECTION-FUNCTION means that region type is skipped -over when trying to grow the region and is only used when a selection is made -with point on a character that triggers that type of selection. Ordering of -entries is largely irrelevant to any code that uses this list.") - - -(defvar id-select-prior-buffer nil) -(defvar id-select-prior-point nil) - -(defvar id-select-previous 'char - "Most recent type of selection. Must be set by all id-select functions.") - -(defvar id-select-region (cons 'nil 'nil) - "Cons cell that contains a region ( . ). -The function `id-select-set-region' updates and returns it.") - -(defvar id-select-old-region (cons 'nil 'nil) - "Cons cell that contains a region ( . ).") - -(defcustom id-select-syntax-alist - '((?w id-select-word) - (?_ id-select-symbol) - (?\" id-select-string) - (?\( id-select-sexp-start) - (?\$ id-select-sexp-start) - (?' id-select-sexp-start) - (?\) id-select-sexp-end) - (? id-select-whitespace) - (?< id-select-comment) - (?. id-select-punctuation)) - "*List of pairs of the form (SYNTAX-CHAR FUNCTION) used by the function `id-select-syntactical-region'. -Each FUNCTION takes a single position argument and returns a region -(start . end) delineating the boundaries of the thing at that position. -Ordering of entries is largely irrelevant to any code that uses this list." - :type '(repeat (list (sexp :tag "Syntax-Char" function))) - :group 'id-select) - - -(provide 'id-select) - -;;; id-select.el ends here diff --git a/xemacs-packages/lisp/edit-utils/info-look.el b/xemacs-packages/lisp/edit-utils/info-look.el deleted file mode 100644 index 3298e196..00000000 --- a/xemacs-packages/lisp/edit-utils/info-look.el +++ /dev/null @@ -1,787 +0,0 @@ -;;; info-look.el --- major-mode-sensitive Info index lookup facility. -;; An older version of this was known as libc.el. - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999 Free Software Foundation, Inc. - -;; Author: Ralph Schleicher -;; Keywords: help languages - -;; 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: - -;; Really cool code to lookup info indexes. -;; Try especially info-lookup-symbol (aka C-h TAB). - -;;; Code: - -(require 'info) -(require 'overlay) - -(defgroup info-lookup nil - "Major mode sensitive help agent." - :group 'help :group 'languages) - -(defvar info-lookup-mode nil - "Symbol of the current buffer's help mode. -Help is provided according to the buffer's major mode if value is nil. -Automatically becomes buffer local when set in any fashion.") -(make-variable-buffer-local 'info-lookup-mode) - -(defcustom info-lookup-other-window-flag t - "Non-nil means pop up the Info buffer in another window." - :group 'info-lookup :type 'boolean) - -(defcustom info-lookup-highlight-face 'highlight - "Face for highlighting looked up help items. -Setting this variable to nil disables highlighting." - :group 'info-lookup :type 'face) - -(defvar info-lookup-highlight-overlay nil - "Overlay object used for highlighting.") - -(defcustom info-lookup-file-name-alist - '(("\\`configure\\.in\\'" . autoconf-mode) ;already covered by auto-mode-alist - ("\\`ac\\(local\\|site\\|include\\)\\.m4\\'" . autoconf-mode)) - "Alist of file names handled specially. -List elements are cons cells of the form - - (REGEXP . MODE) - -If a file name matches REGEXP, then use help mode MODE instead of the -buffer's major mode." - :group 'info-lookup :type '(repeat (cons (string :tag "Regexp") - (symbol :tag "Mode")))) - -(defvar info-lookup-history nil - "History of previous input lines.") - -(defvar info-lookup-alist nil - "Alist of known help topics. -Cons cells are of the form - - (HELP-TOPIC . HELP-DATA) - -HELP-TOPIC is the symbol of a help topic. -HELP-DATA is a HELP-TOPIC's public data set. - Value is an alist with elements of the form - - (HELP-MODE REGEXP IGNORE-CASE DOC-SPEC PARSE-RULE OTHER-MODES) - -HELP-MODE is a mode's symbol. -REGEXP is a regular expression matching those help items whose - documentation can be looked up via DOC-SPEC. -IGNORE-CASE is non-nil if help items are case insensitive. -DOC-SPEC is a list of documentation specifications of the form - - (INFO-NODE TRANS-FUNC PREFIX SUFFIX) - -INFO-NODE is the name (including file name part) of an Info index. -TRANS-FUNC is a function translating index entries into help items; - nil means add only those index entries matching REGEXP, a string - means prepend string to the first word of all index entries. -PREFIX and SUFFIX are parts of a regular expression. If one of - them is non-nil then search the help item's Info node for the - first occurrence of the regular expression `PREFIX ITEM SUFFIX'. - ITEM will be highlighted with `info-lookup-highlight-face' if this - variable is not nil. -PARSE-RULE is either the symbol name of a function or a regular - expression for guessing the default help item at point. Fuzzy - regular expressions like \"[_a-zA-Z0-9]+\" do a better job if - there are no clear delimiters; do not try to write too complex - expressions. PARSE-RULE defaults to REGEXP. -OTHER-MODES is a list of cross references to other help modes.") - -(defsubst info-lookup->topic-value (topic) - (cdr (assoc topic info-lookup-alist))) - -(defsubst info-lookup->mode-value (topic mode) - (assoc mode (info-lookup->topic-value topic))) - -(defsubst info-lookup->regexp (topic mode) - (nth 1 (info-lookup->mode-value topic mode))) - -(defsubst info-lookup->ignore-case (topic mode) - (nth 2 (info-lookup->mode-value topic mode))) - -(defsubst info-lookup->doc-spec (topic mode) - (nth 3 (info-lookup->mode-value topic mode))) - -(defsubst info-lookup->parse-rule (topic mode) - (nth 4 (info-lookup->mode-value topic mode))) - -(defsubst info-lookup->other-modes (topic mode) - (nth 5 (info-lookup->mode-value topic mode))) - -(defun info-lookup-add-help (&rest arg) - "Add or update a help specification. -Function arguments are one or more options of the form - - KEYWORD ARGUMENT - -KEYWORD is either `:topic', `:mode', `:regexp', `:ignore-case', - `:doc-spec', `:parse-rule', or `:other-modes'. -ARGUMENT has a value as explained in the documentation of the - variable `info-lookup-alist'. - -If no topic or mode option has been specified, then the help topic defaults -to `symbol', and the help mode defaults to the current major mode." - (apply 'info-lookup-add-help* nil arg)) - -(defun info-lookup-maybe-add-help (&rest arg) - "Add a help specification iff none is defined. -See the documentation of the function `info-lookup-add-help' -for more details." - (apply 'info-lookup-add-help* t arg)) - -(defun info-lookup-add-help* (maybe &rest arg) - (let (topic mode regexp ignore-case doc-spec - parse-rule other-modes keyword value) - (setq topic 'symbol - mode major-mode - regexp "\\w+") - (while arg - (setq keyword (car arg)) - (or (symbolp keyword) - (error "Junk in argument list \"%S\"" arg)) - (setq arg (cdr arg)) - (and (null arg) - (error "Keyword \"%S\" is missing an argument" keyword)) - (setq value (car arg) - arg (cdr arg)) - (cond ((eq keyword :topic) - (setq topic value)) - ((eq keyword :mode) - (setq mode value)) - ((eq keyword :regexp) - (setq regexp value)) - ((eq keyword :ignore-case) - (setq ignore-case value)) - ((eq keyword :doc-spec) - (setq doc-spec value)) - ((eq keyword :parse-rule) - (setq parse-rule value)) - ((eq keyword :other-modes) - (setq other-modes value)) - (t - (error "Unknown keyword \"%S\"" keyword)))) - (or (and maybe (info-lookup->mode-value topic mode)) - (let* ((data (list regexp ignore-case doc-spec parse-rule other-modes)) - (topic-cell (or (assoc topic info-lookup-alist) - (car (setq info-lookup-alist - (cons (cons topic nil) - info-lookup-alist))))) - (mode-cell (assoc mode topic-cell))) - (if (null mode-cell) - (setcdr topic-cell (cons (cons mode data) (cdr topic-cell))) - (setcdr mode-cell data)))) - nil)) - -(defvar info-lookup-cache nil - "Cache storing data maintained automatically by the program. -Value is an alist with cons cell of the form - - (HELP-TOPIC . ((HELP-MODE INITIALIZED COMPLETIONS REFER-MODES) ...)) - -HELP-TOPIC is the symbol of a help topic. -HELP-MODE is a mode's symbol. -INITIALIZED is nil if HELP-MODE is uninitialized, t if - HELP-MODE is initialized, and `0' means HELP-MODE is - initialized but void. -COMPLETIONS is an alist of documented help items. -REFER-MODES is a list of other help modes to use.") - -(defsubst info-lookup->cache (topic) - (or (assoc topic info-lookup-cache) - (car (setq info-lookup-cache - (cons (cons topic nil) - info-lookup-cache))))) - -(defun info-lookup->topic-cache (topic) - (cdr (info-lookup->cache topic))) - -(defun info-lookup->mode-cache (topic mode) - (assoc mode (info-lookup->topic-cache topic))) - -(defun info-lookup->initialized (topic mode) - (nth 1 (info-lookup->mode-cache topic mode))) - -(defun info-lookup->completions (topic mode) - (or (info-lookup->initialized topic mode) - (info-lookup-setup-mode topic mode)) - (nth 2 (info-lookup->mode-cache topic mode))) - -(defun info-lookup->refer-modes (topic mode) - (or (info-lookup->initialized topic mode) - (info-lookup-setup-mode topic mode)) - (nth 3 (info-lookup->mode-cache topic mode))) - -(defun info-lookup->all-modes (topic mode) - (cons mode (info-lookup->refer-modes topic mode))) - -(defun info-lookup-quick-all-modes (topic mode) - (cons mode (info-lookup->other-modes topic mode))) - -;;;###autoload -(defun info-lookup-reset () - "Throw away all cached data. -This command is useful if the user wants to start at the beginning without -quitting Emacs, for example, after some Info documents were updated on the -system." - (interactive) - (setq info-lookup-cache nil)) - -;;;###autoload -(defun info-lookup-symbol (symbol &optional mode) - "Display the definition of SYMBOL, as found in the relevant manual. -When this command is called interactively, it reads SYMBOL from the minibuffer. -In the minibuffer, use M-n to yank the default argument value -into the minibuffer so you can edit it. -The default symbol is the one found at point. - -With prefix arg a query for the symbol help mode is offered." - (interactive - (info-lookup-interactive-arguments 'symbol current-prefix-arg)) - (info-lookup 'symbol symbol mode)) - -;;;###autoload -(defun info-lookup-file (file &optional mode) - "Display the documentation of a file. -When this command is called interactively, it reads FILE from the minibuffer. -In the minibuffer, use M-n to yank the default file name -into the minibuffer so you can edit it. -The default file name is the one found at point. - -With prefix arg a query for the file help mode is offered." - (interactive - (info-lookup-interactive-arguments 'file current-prefix-arg)) - (info-lookup 'file file mode)) - -(defun info-lookup-interactive-arguments (topic &optional query) - "Read and return argument value (and help mode) for help topic TOPIC. -If optional argument QUERY is non-nil, query for the help mode." - (let* ((mode (cond (query - (info-lookup-change-mode topic)) - ((info-lookup->mode-value topic (info-lookup-select-mode)) - info-lookup-mode) - ((info-lookup-change-mode topic)))) - (completions (info-lookup->completions topic mode)) - (default (info-lookup-guess-default topic mode)) - (completion-ignore-case (info-lookup->ignore-case topic mode)) - (enable-recursive-minibuffers t) - (value (completing-read - (if default - (format "Describe %s (default %s): " topic default) - (format "Describe %s: " topic)) - completions nil nil nil 'info-lookup-history default))) - (list (if (equal value "") default value) mode))) - -(defun info-lookup-select-mode () - (when (and (not info-lookup-mode) (buffer-file-name)) - (let ((file-name (file-name-nondirectory (buffer-file-name))) - (file-name-alist info-lookup-file-name-alist)) - (while (and (not info-lookup-mode) file-name-alist) - (when (string-match (caar file-name-alist) file-name) - (setq info-lookup-mode (cdar file-name-alist))) - (setq file-name-alist (cdr file-name-alist))))) - (or info-lookup-mode (setq info-lookup-mode major-mode))) - -(defun info-lookup-change-mode (topic) - (let* ((completions (mapcar (lambda (arg) - (cons (symbol-name (car arg)) (car arg))) - (info-lookup->topic-value topic))) - (mode (completing-read - (format "Use %s help mode: " topic) - completions nil t nil 'info-lookup-history))) - (or (setq mode (cdr (assoc mode completions))) - (error "No %s help available" topic)) - (or (info-lookup->mode-value topic mode) - (error "No %s help available for `%s'" topic mode)) - (setq info-lookup-mode mode))) - -(defun info-lookup (topic item mode) - "Display the documentation of a help item." - (or mode (setq mode (info-lookup-select-mode))) - (or (info-lookup->mode-value topic mode) - (error "No %s help available for `%s'" topic mode)) - (let ((entry (or (assoc (if (info-lookup->ignore-case topic mode) - (downcase item) item) - (info-lookup->completions topic mode)) - (error "Not documented as a %s: %s" topic (or item "")))) - (modes (info-lookup->all-modes topic mode)) - (window (selected-window)) - found doc-spec node prefix suffix doc-found) - (if (or (not info-lookup-other-window-flag) - (eq (current-buffer) (get-buffer "*info*"))) - (info) - (progn - (save-window-excursion (info)) - (switch-to-buffer-other-window "*info*"))) - ;; Previous line is from old XEmacs version, the commented multi-frame - ;; coding below includes Emacs specific functions... -;;; ;; Determine whether or not the Info buffer is visible in -;;; ;; another frame on the same display. If it is, simply raise -;;; ;; that frame. Otherwise, display it in another window. -;;; (let* ((window (get-buffer-window "*info*" t)) -;;; (info-frame (and window (window-frame window)))) -;;; (if (and info-frame -;;; (display-multi-frame-p) -;;; (memq info-frame (frames-on-display-list))) -;;; (select-frame info-frame) -;;; (switch-to-buffer-other-window "*info*"))))) - (while (and (not found) modes) - (setq doc-spec (info-lookup->doc-spec topic (car modes))) - (while (and (not found) doc-spec) - (setq node (nth 0 (car doc-spec)) - prefix (nth 2 (car doc-spec)) - suffix (nth 3 (car doc-spec))) - (when (condition-case error-data - (progn - (Info-goto-node node) - (setq doc-found t)) - (error - (message "Cannot access Info node %s" node) - (sit-for 1) - nil)) - (condition-case nil - (progn - (Info-menu (or (cdr entry) item)) - (setq found t) - (if (or prefix suffix) - (let ((case-fold-search - (info-lookup->ignore-case topic (car modes))) - (buffer-read-only nil)) - (goto-char (point-min)) - (re-search-forward - (concat prefix (regexp-quote item) suffix)) - (goto-char (match-beginning 0)) - (and window-system ; Emacs: (display-color-p) - info-lookup-highlight-face - ;; Search again for ITEM so that the first - ;; occurence of ITEM will be highlighted. - (re-search-forward (regexp-quote item)) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (if (overlayp info-lookup-highlight-overlay) - (move-overlay info-lookup-highlight-overlay - start end (current-buffer)) - (setq info-lookup-highlight-overlay - (make-overlay start end)))) - (overlay-put info-lookup-highlight-overlay - 'face info-lookup-highlight-face))))) - (error nil))) - (setq doc-spec (cdr doc-spec))) - (setq modes (cdr modes))) - (or doc-found - (error "Info documentation for lookup was not found")) - ;; Don't leave the Info buffer if the help item couldn't be looked up. - (if (and info-lookup-other-window-flag found) - (select-window window)))) - -(defun info-lookup-setup-mode (topic mode) - "Initialize the internal data structure." - (or (info-lookup->initialized topic mode) - (let (cell data (initialized 0) completions refer-modes) - (if (not (info-lookup->mode-value topic mode)) - (message "No %s help available for `%s'" topic mode) - ;; Recursively setup cross references. - ;; But refer only to non-void modes. - (mapcar (lambda (arg) - (or (info-lookup->initialized topic arg) - (info-lookup-setup-mode topic arg)) - (and (eq (info-lookup->initialized topic arg) t) - (setq refer-modes (cons arg refer-modes)))) - (info-lookup->other-modes topic mode)) - (setq refer-modes (nreverse refer-modes)) - ;; Build the full completion alist. - (setq completions - (nconc (condition-case nil - (info-lookup-make-completions topic mode) - (error nil)) - (apply 'append - (mapcar (lambda (arg) - (info-lookup->completions topic arg)) - refer-modes)))) - (setq initialized t)) - ;; Update `info-lookup-cache'. - (setq cell (info-lookup->mode-cache topic mode) - data (list initialized completions refer-modes)) - (if (not cell) - (setcdr (info-lookup->cache topic) - (cons (cons mode data) (info-lookup->topic-cache topic))) - (setcdr cell data)) - initialized))) - -(defun info-lookup-make-completions (topic mode) - "Create a unique alist from all index entries." - (let ((doc-spec (info-lookup->doc-spec topic mode)) - (regexp (concat "^\\(" (info-lookup->regexp topic mode) - "\\)\\([ \t].*\\)?$")) - node trans entry item prefix result doc-found - (buffer (get-buffer-create " temp-info-look"))) - (with-current-buffer buffer - (Info-mode)) - (while doc-spec - (setq node (nth 0 (car doc-spec)) - trans (cond ((eq (nth 1 (car doc-spec)) nil) - (lambda (arg) - (if (string-match regexp arg) - (match-string 1 arg)))) - ((stringp (nth 1 (car doc-spec))) - (setq prefix (nth 1 (car doc-spec))) - (lambda (arg) - (if (string-match "^\\([^: \t\n]+\\)" arg) - (concat prefix (match-string 1 arg))))) - (t (nth 1 (car doc-spec))))) - (with-current-buffer buffer - (message "Processing Info node `%s'..." node) - (when (condition-case error-data - (progn - (Info-goto-node node) - (setq doc-found t)) - (error - (message "Cannot access Info node `%s'" node) - (sit-for 1) - nil)) - (condition-case nil - (progn - (goto-char (point-min)) - (and (search-forward "\n* Menu:" nil t) - (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t) - (setq entry (match-string 1) - item (funcall trans entry)) - ;; `trans' can return nil if the regexp doesn't match. - (when (and item - ;; Sometimes there's more than one Menu: - (not (string= entry "Menu"))) - (and (info-lookup->ignore-case topic mode) - (setq item (downcase item))) - (and (string-equal entry item) - (setq entry nil)) - (and (or (assoc item result) - (setq result (cons (cons item entry) - result)))))))) - (error nil)))) - (message "Processing Info node `%s'...done" node) - (setq doc-spec (cdr doc-spec))) - (or doc-found - (error "Info documentation for lookup was not found")) - result)) - -(defun info-lookup-guess-default (topic mode) - "Return a guess for a symbol to look up, based on text around point. -Try all related modes applicable to TOPIC and MODE. -Return nil if there is nothing appropriate in the buffer near point." - (let ((modes (info-lookup->all-modes topic mode)) - guess) - (while (and (not guess) modes) - (setq guess (info-lookup-guess-default* topic (car modes)) - modes (cdr modes))) - ;; Collapse whitespace characters. - (when guess - (let ((pos 0)) - (while (string-match "[ \t\n]+" guess pos) - (setq pos (1+ (match-beginning 0))) - (setq guess (replace-match " " t t guess))))) - guess)) - -(defun info-lookup-guess-default* (topic mode) - (let ((case-fold-search (info-lookup->ignore-case topic mode)) - (rule (or (info-lookup->parse-rule topic mode) - (info-lookup->regexp topic mode))) - (start (point)) end regexp subexp result) - (save-excursion - (if (symbolp rule) - (setq result (funcall rule)) - (if (consp rule) - (setq regexp (car rule) - subexp (cdr rule)) - (setq regexp rule - subexp 0)) - ;; If at start of symbol, don't go back to end of previous one. - (if (save-match-data - (looking-at "[ \t\n]")) - (skip-chars-backward " \t\n")) - (setq end (point)) - (while (and (re-search-backward regexp nil t) - (looking-at regexp) - (>= (match-end 0) end)) - (setq result (match-string subexp))) - (if (not result) - (progn - (goto-char start) - (skip-chars-forward " \t\n") - (and (looking-at regexp) - (setq result (match-string subexp))))))) - result)) - -(defun info-lookup-guess-c-symbol () - "Get the C symbol at point." - (condition-case nil - (progn - (skip-syntax-backward "w_") - (let ((start (point)) prefix name) - ;; Test for a leading `struct', `union', or `enum' keyword - ;; but ignore names like `foo_struct'. - (setq prefix (and (< (skip-chars-backward " \t\n") 0) - (< (skip-chars-backward "_a-zA-Z0-9") 0) - (looking-at "\\(struct\\|union\\|enum\\)\\s ") - (concat (match-string 1) " "))) - (goto-char start) - (and (looking-at "[_a-zA-Z][_a-zA-Z0-9]*") - (setq name (match-string 0))) - ;; Caveat! Look forward if point is at `struct' etc. - (and (not prefix) - (or (string-equal name "struct") - (string-equal name "union") - (string-equal name "enum")) - (looking-at "[a-z]+\\s +\\([_a-zA-Z][_a-zA-Z0-9]*\\)") - (setq prefix (concat name " ") - name (match-string 1))) - (and (or prefix name) - (concat prefix name)))) - (error nil))) - -;;;###autoload -(defun info-complete-symbol (&optional mode) - "Perform completion on symbol preceding point." - (interactive) - (info-complete 'symbol - (or mode - (if (info-lookup->mode-value - 'symbol (info-lookup-select-mode)) - info-lookup-mode - (info-lookup-change-mode 'symbol))))) - -;;;###autoload -(defun info-complete-file (&optional mode) - "Perform completion on file preceding point." - (interactive) - (info-complete 'file - (or mode - (if (info-lookup->mode-value - 'file (info-lookup-select-mode)) - info-lookup-mode - (info-lookup-change-mode 'file))))) - -(defun info-complete (topic mode) - "Try to complete a help item." - (barf-if-buffer-read-only) - (or mode (setq mode (info-lookup-select-mode))) - (or (info-lookup->mode-value topic mode) - (error "No %s completion available for `%s'" topic mode)) - (let ((modes (info-lookup-quick-all-modes topic mode)) - (start (point)) - try) - (while (and (not try) modes) - (setq mode (car modes) - modes (cdr modes) - try (info-lookup-guess-default* topic mode)) - (goto-char start)) - (and (not try) - (error "Found no %S to complete" topic)) - (let ((completions (info-lookup->completions topic mode)) - (completion-ignore-case (info-lookup->ignore-case topic mode)) - completion) - (setq completion (try-completion try completions)) - (cond ((not completion) - (ding) - (message "No match")) - ((stringp completion) - (or (assoc completion completions) - (setq completion (completing-read - (format "Complete %S: " topic) - completions nil t completion - info-lookup-history))) - ;; Find the original symbol and zap it. - (end-of-line) - (while (and (search-backward try nil t) - (< start (point)))) - (replace-match "") - (insert completion)) - (t - (message "%s is complete" - (capitalize (prin1-to-string topic)))))))) - - -;;; Initialize some common modes. - -(info-lookup-maybe-add-help - :mode 'c-mode :topic 'symbol - :regexp "\\(struct \\|union \\|enum \\)?[_a-zA-Z][_a-zA-Z0-9]*" - :doc-spec '(("(libc)Function Index" nil - "^[ \t]+- \\(Function\\|Macro\\): .*\\<" "\\>") - ("(libc)Variable Index" nil - "^[ \t]+- \\(Variable\\|Macro\\): .*\\<" "\\>") - ("(libc)Type Index" nil - "^[ \t]+- Data Type: \\<" "\\>") - ("(termcap)Var Index" nil - "^[ \t]*`" "'")) - :parse-rule 'info-lookup-guess-c-symbol) - -(info-lookup-maybe-add-help - :mode 'c-mode :topic 'file - :regexp "[_a-zA-Z0-9./+-]+" - :doc-spec '(("(libc)File Index"))) - -(info-lookup-maybe-add-help - :mode 'bison-mode - :regexp "[:;|]\\|%\\([%{}]\\|[_a-z]+\\)\\|YY[_A-Z]+\\|yy[_a-z]+" - :doc-spec '(("(bison)Index" nil - "`" "'")) - :parse-rule "[:;|]\\|%\\([%{}]\\|[_a-zA-Z][_a-zA-Z0-9]*\\)" - :other-modes '(c-mode)) - -(info-lookup-maybe-add-help - :mode 'makefile-mode - :regexp "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z][_a-zA-Z0-9-]*" - :doc-spec '(("(make)Name Index" nil - "^[ \t]*`" "'")) - :parse-rule "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z0-9-]+") - -(info-lookup-maybe-add-help - :mode 'texinfo-mode - :regexp "@\\([a-zA-Z]+\\|[^a-zA-Z]\\)" - :doc-spec '(("(texinfo)Command and Variable Index" - ;; Ignore Emacs commands and prepend a `@'. - (lambda (item) - (if (string-match "^\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\( .*\\)?$" item) - (concat "@" (match-string 1 item)))) - "`" "'"))) - -(info-lookup-maybe-add-help - :mode 'm4-mode - :regexp "[_a-zA-Z][_a-zA-Z0-9]*" - :doc-spec '(("(m4)Macro index")) - :parse-rule "[_a-zA-Z0-9]+") - -(info-lookup-maybe-add-help - :mode 'autoconf-mode - :regexp "A[CM]_[_A-Z0-9]+" - :doc-spec '(("(autoconf)Macro Index" "AC_" - "^[ \t]+- \\(Macro\\|Variable\\): .*\\<" "\\>") - ("(automake)Index" nil - "^[ \t]*`" "'")) - ;; Autoconf symbols are M4 macros. Thus use M4's parser. - :parse-rule 'ignore - :other-modes '(m4-mode)) - -(info-lookup-maybe-add-help - :mode 'awk-mode - :regexp "[_a-zA-Z]+" - :doc-spec '(("(gawk)Index" - (lambda (item) - (let ((case-fold-search nil)) - (cond - ;; `BEGIN' and `END'. - ((string-match "^\\([A-Z]+\\) special pattern\\b" item) - (match-string 1 item)) - ;; `if', `while', `do', ... - ((string-match "^\\([a-z]+\\) statement\\b" item) - (if (not (string-equal (match-string 1 item) "control")) - (match-string 1 item))) - ;; `NR', `NF', ... - ((string-match "^[A-Z]+$" item) - item) - ;; Built-in functions (matches to many entries). - ((string-match "^[a-z]+$" item) - item)))) - "`" "\\([ \t]*([^)]*)\\)?'"))) - -(info-lookup-maybe-add-help - :mode 'perl-mode - :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*" - :doc-spec '(("(perl5)Function Index" - (lambda (item) - (if (string-match "^\\([a-zA-Z0-9]+\\)" item) - (match-string 1 item))) - "^" "\\b") - ("(perl5)Variable Index" - (lambda (item) - ;; Work around bad formatted array variables. - (let ((sym (cond ((or (string-match "^\\$\\(.\\|@@\\)$" item) - (string-match "^\\$\\^[A-Z]$" item)) - item) - ((string-match - "^\\([$%@]\\|@@\\)?[_a-zA-Z0-9]+" item) - (match-string 0 item)) - (t "")))) - (if (string-match "@@" sym) - (setq sym (concat (substring sym 0 (match-beginning 0)) - (substring sym (1- (match-end 0)))))) - (if (string-equal sym "") nil sym))) - "^" "\\b")) - :parse-rule "[$@%]?\\([_a-zA-Z0-9]+\\|[^a-zA-Z]\\)") - -(info-lookup-maybe-add-help - :mode 'cperl-mode - :regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*" - :other-modes '(perl-mode)) - -(info-lookup-maybe-add-help - :mode 'latex-mode - :regexp "\\\\\\([a-zA-Z]+\\|[^a-zA-Z]\\)" - :doc-spec '(("(latex)Command Index" nil - "`" "\\({[^}]*}\\)?'"))) - -(info-lookup-maybe-add-help - :mode 'emacs-lisp-mode - :regexp "[^][()'\" \t\n]+" - :doc-spec '(("(xemacs)Command Index") - ("(xemacs)Variable Index") - ("(lispref)Index"))) - -(info-lookup-maybe-add-help - :mode 'lisp-interaction-mode - :regexp "[^][()'\" \t\n]+" - :parse-rule 'ignore - :other-modes '(emacs-lisp-mode)) - -(info-lookup-maybe-add-help - :mode 'lisp-mode - :regexp "[^()'\" \t\n]+" - :parse-rule 'ignore - :other-modes '(emacs-lisp-mode)) - -(info-lookup-maybe-add-help - :mode 'scheme-mode - :regexp "[^()'\" \t\n]+" - :ignore-case t - ;; Aubrey Jaffer's rendition from - :doc-spec '(("(r5rs)Index" nil - "^[ \t]+- [^:]+:[ \t]*" "\\b"))) - -(info-lookup-maybe-add-help - :mode 'octave-mode - :regexp "[_a-zA-Z0-9]+" - :doc-spec '(("(octave)Function Index" nil - "^ - [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil) - ("(octave)Variable Index" nil "^ - [^:]+:[ ]+" nil) - ;; Catch lines of the form "xyz statement" - ("(octave)Concept Index" - (lambda (item) - (cond - ((string-match "^\\([A-Z]+\\) statement\\b" item) - (match-string 1 item)) - (t nil))) - nil; "^ - [^:]+:[ ]+" don't think this prefix is useful here. - nil))) - -(provide 'info-look) - -;;; info-look.el ends here diff --git a/xemacs-packages/lisp/edit-utils/iswitchb.el b/xemacs-packages/lisp/edit-utils/iswitchb.el deleted file mode 100644 index 1d71bcb6..00000000 --- a/xemacs-packages/lisp/edit-utils/iswitchb.el +++ /dev/null @@ -1,1357 +0,0 @@ -;;; iswitchb.el --- switch between buffers using substrings - -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. - -;; Author: Stephen Eglen -;; Maintainer: Stephen Eglen -;; Keywords: extensions -;; location: http://www.cns.ed.ac.uk/people/stephen/emacs/ -;; RCS: $Id: iswitchb.el,v 1.3 2001/07/20 14:09:12 youngs Exp $ - -;; 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: - -;; Installation: -;; To get the functions in this package bound to keys, do -;; (iswitchb-default-keybindings) - -;; As you type in a substring, the list of buffers currently matching -;; the substring are displayed as you type. The list is ordered so -;; that the most recent buffers visited come at the start of the list. -;; The buffer at the start of the list will be the one visited when -;; you press return. By typing more of the substring, the list is -;; narrowed down so that gradually the buffer you want will be at the -;; top of the list. Alternatively, you can use C-s an C-r to rotate -;; buffer names in the list until the one you want is at the top of -;; the list. Completion is also available so that you can see what is -;; common to all of the matching buffers as you type. - -;; This code is similar to a couple of other packages. Michael R Cook -;; wrote a similar buffer switching package, but -;; does exact matching rather than substring matching on buffer names. -;; I also modified a couple of functions from icomplete.el to provide -;; the completion feedback in the minibuffer. - -;;; Example - -;;If I have two buffers called "123456" and "123", with "123456" the -;;most recent, when I use iswitchb, I first of all get presented with -;;the list of all the buffers -;; -;; iswitch {123456,123} -;; -;; If I then press 2: -;; iswitch 2[3]{123456,123} -;; -;; The list in {} are the matching buffers, most recent first (buffers -;; visible in the current frame are put at the end of the list by -;; default). At any time I can select the item at the head of the -;; list by pressing RET. I can also bring the put the first element -;; at the end of the list by pressing C-s, or put the last element at -;; the head of the list by pressing C-r. The item in [] indicates -;; what can be added to my input by pressing TAB. In this case, I -;; will get "3" added to my input. So, press TAB: -;; iswitch 23{123456,123} -;; -;; At this point, I still have two matching buffers. -;; If I want the first buffer in the list, I simply press RET. If I -;; wanted the second in the list, I could press C-s to move it to the -;; top of the list and then RET to select it. -;; -;;However, If I type 4, I only have one match left: -;; iswitch 234[123456] [Matched] -;; -;;Since there is only one matching buffer left, it is given in [] and we -;;see the text [Matched] afterwards. I can now press TAB or RET to go -;;to that buffer. -;; -;; If however, I now type "a": -;; iswitch 234a [No match] -;; There are no matching buffers. If I press RET or TAB, I can be -;; prompted to create a new buffer called "234a". -;; -;; Of course, where this function comes in really useful is when you -;; can specify the buffer using only a few keystrokes. In the above -;; example, the quickest way to get to the "123456" buffer would be -;; just to type 4 and then RET (assuming there isn't any newer buffer -;; with 4 in its name). - -;; To see a full list of all matching buffers in a separate buffer, -;; hit ? or press TAB when there are no further completions to the -;; substring. Repeated TAB presses will scroll you through this -;; separate buffer. - -;; The buffer at the head of the list can be killed by pressing C-k. -;; If the buffer needs saving, you will be queried before the buffer -;; is killed. - -;; If you find that the file you are after is not in a buffer, you can -;; press C-x C-f to immediately drop into find-file. - -;; -;; See the doc string of iswitchb for full keybindings and features. -;; (describe-function 'iswitchb) - -;;; Customisation - -;; See the User Variables section below for easy ways to change the -;; functionality of the program. These are accessible using the -;; custom package. -;; To modify the keybindings, use the hook provided. For example: -;;(add-hook 'iswitchb-define-mode-map-hook -;; 'iswitchb-my-keys) -;; -;;(defun iswitchb-my-keys () -;; "Add my keybindings for iswitchb." -;; (define-key iswitchb-mode-map " " 'iswitchb-next-match) -;; ) -;; -;; Seeing all the matching buffers -;; -;; If you have many matching buffers, they may not all fit onto one -;; line of the minibuffer. In this case, you should use rsz-mini -;; (resize-minibuffer-mode). You can also limit iswitchb so that it -;; only shows a certain number of lines -- see the documentation for -;; `iswitchb-minibuffer-setup-hook'. - - -;; Changing the list of buffers - -;; By default, the list of current buffers is most recent first, -;; oldest last, with the exception that the buffers visible in the -;; current frame are put at the end of the list. A hook exists to -;; allow other functions to order the list. For example, if you add: -;; -;; (add-hook 'iswitchb-make-buflist-hook 'iswitchb-summaries-to-end) -;; -;; then all buffers matching "Summary" are moved to the end of the -;; list. (I find this handy for keeping the INBOX Summary and so on -;; out of the way.) It also moves buffers matching "output\*$" to the -;; end of the list (these are created by AUC TeX when compiling.) -;; Other functions could be made available which alter the list of -;; matching buffers (either deleting or rearranging elements.) - -;; Font-Lock - -;; If you have font-lock loaded, the first matching buffer is -;; highlighted. To switch this off, set (setq iswitchb-use-fonts nil) -;; I don't use font-lock that much, so I've hardcoded the faces. If -;; this is too harsh, let me know. Colouring of the matching buffer -;; name was suggested by Carsten Dominik (dominik@strw.leidenuniv.nl) - - -;; Replacement for read-buffer - -;; iswitchb-read-buffer has been written to be a drop in replacement -;; for the normal buffer selection routine `read-buffer'. To use -;; iswitch for all buffer selections in Emacs, add: -;; (setq read-buffer-function 'iswitchb-read-buffer) -;; (This variable should be present in Emacs 20.3+) -;; XEmacs users can get the same behaviour by doing: -;; (defalias 'read-buffer 'iswitchb-read-buffer) -;; since `read-buffer' is defined in lisp. - -;; Regexp matching - -;; There is limited provision for regexp matching within iswitchb, -;; enabled through `iswitchb-regexp'. This allows you to type `c$' -;; for example and see all buffer names ending in `c'. This facility -;; is quite limited though in two respects. First, you can't -;; currently type in expressions like `[0-9]' directly -- you have to -;; type them in when iswitchb-regexp is nil and then toggle on the -;; regexp functionality. Likewise, don't enter an expression -;; containing `\' in regexp mode. If you try, iswitchb gets confused, -;; so just hit C-g and try again. Secondly, no completion mechanism -;; is currently offered when regexp searching. - -;;; TODO - -;;; Acknowledgements - -;; Thanks to Jari Aalto for help with the -;; first version of this package, iswitch-buffer. Thanks also to many -;; others for testing earlier versions. - -;;; Code: - - -;; CL needed for cadr and last -(require 'cl) - -;; Set up the custom library. -;; taken from http://www.dina.kvl.dk/~abraham/custom/ -(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)))))) - -;;; User Variables -;; -;; These are some things you might want to change. - -(defgroup iswitchb nil - "Switch between buffers using substrings." - :group 'extensions - ;; These links are to be added in later versions of custom and - ;; so are currently commented out. - :link '(emacs-commentary-link :tag "Commentary" "iswitchb.el") - :link '(emacs-library-link :tag "Lisp File" "iswitchb.el") -) - - -(defcustom iswitchb-case case-fold-search - "*Non-nil if searching of buffer names should ignore case." - :type 'boolean - :group 'iswitchb) - -(defcustom iswitchb-buffer-ignore - '("^ ") - "*List of regexps or functions matching buffer names to ignore. -For example, traditional behavior is not to list buffers whose names begin -with a space, for which the regexp is `^ '. See the source file for -example functions that filter buffernames." - :type '(repeat regexp) - :group 'iswitchb) - - -;;; Examples for setting the value of iswitchb-buffer-ignore -;(defun iswitchb-ignore-c-mode (name) -; "Ignore all c mode buffers -- example function for iswitchb." -; (save-excursion -; (set-buffer name) -; (string-match "^C$" mode-name))) - -;(setq iswitchb-buffer-ignore '("^ " iswitchb-ignore-c-mode)) -;(setq iswitchb-buffer-ignore '("^ " "\\.c$" "\\.h$")) - -(defcustom iswitchb-default-method 'always-frame - "*How to switch to new buffer when using `iswitchb-buffer'. -Possible values: -`samewindow' Show new buffer in same window -`otherwindow' Show new buffer in another window (same frame) -`display' Display buffer in another window without switching to it -`otherframe' Show new buffer in another frame -`maybe-frame' If a buffer is visible in another frame, prompt to ask if you - you want to see the buffer in the same window of the current - frame or in the other frame. -`always-frame' If a buffer is visible in another frame, raise that - frame. Otherwise, visit the buffer in the same window." - :type '(choice (const samewindow) - (const otherwindow) - (const display) - (const otherframe) - (const maybe-frame) - (const always-frame)) - :group 'iswitchb) - - -(defcustom iswitchb-regexp nil - "*Non-nil means that `iswitchb' will do regexp matching. -Value can be toggled within `iswitchb' using `iswitchb-toggle-regexp'." - :type 'boolean - :group 'iswitchb) - - -(defcustom iswitchb-newbuffer t - "*Non-nil means create new buffer if no buffer matches substring. -See also `iswitchb-prompt-newbuffer'." - :type 'boolean - :group 'iswitchb) - - -(defcustom iswitchb-prompt-newbuffer t - "*Non-nil means prompt user to confirm before creating new buffer. -See also `iswitchb-newbuffer'." - :type 'boolean - :group 'iswitchb) - - -(defcustom iswitchb-define-mode-map-hook nil - "*Hook to define keys in `iswitchb-mode-map' for extra keybindings." - :type 'hook - :group 'iswitchb) - - - -(defcustom iswitchb-use-fonts t - "*Non-nil means use font-lock fonts for showing first match." - :type 'boolean - :group 'iswitchb) - - -(defcustom iswitchb-make-buflist-hook nil - "*Hook to run when list of matching buffers is created." - :type 'hook - :group 'iswitchb) - -(defvar iswitchb-all-frames 'visible - "*Argument to pass to `walk-windows' when finding visible buffers. -See documentation of `walk-windows' for useful values.") - -(defcustom iswitchb-minibuffer-setup-hook nil - "*Iswitchb-specific customization of minibuffer setup. - -This hook is run during minibuffer setup iff `iswitchb' will be active. -It is intended for use in customizing iswitchb for interoperation -with other packages. For instance: - - \(add-hook 'iswitchb-minibuffer-setup-hook - \(function - \(lambda () - \(make-local-variable 'resize-minibuffer-window-max-height) - \(setq resize-minibuffer-window-max-height 3)))) - -will constrain rsz-mini to a maximum minibuffer height of 3 lines when -iswitchb is running. Copied from `icomplete-minibuffer-setup-hook'." - :type 'hook - :group 'iswitchb) - -;; Do we need the variable iswitchb-use-mycompletion? - - -;;; Internal Variables - -(defvar iswitchb-method nil - "Stores the method for viewing the selected buffer. -Its value is one of `samewindow', `otherwindow', `display', `otherframe', -`maybe-frame' or `always-frame'. See `iswitchb-default-method' for -details of values.") - -(defvar iswitchb-eoinput 1 - "Point where minibuffer input ends and completion info begins. -Copied from `icomplete-eoinput'.") -(make-variable-buffer-local 'iswitchb-eoinput) - - -(defvar iswitchb-buflist nil - "Stores the current list of buffers that will be searched through. -The list is ordered, so that the most recent buffers come first, -although by default, the buffers visible in the current frame are put -at the end of the list. Created by `iswitchb-make-buflist'.") - -;; todo -- is this necessary? - -(defvar iswitchb-use-mycompletion nil - "Non-nil means use `iswitchb-buffer' completion feedback. -Should only be set to t by iswitchb functions, so that it doesn't -interfere with other minibuffer usage.") - -(defvar iswitchb-change-word-sub nil - "Private variable used by `iswitchb-word-matching-substring'.") - -(defvar iswitchb-common-match-string nil - "Stores the string that is common to all matching buffers.") - -(defvar iswitchb-rescan nil - "Non-nil means we need to regenerate the list of matching buffers.") - -(defvar iswitchb-text nil - "Stores the users string as it is typed in.") - -(defvar iswitchb-matches nil - "List of buffers currently matching `iswitchb-text'.") - -(defvar iswitchb-mode-map nil - "Keymap for `iswitchb-buffer'.") - -(defvar iswitchb-history nil - "History of buffers selected using `iswitchb-buffer'.") - -(defvar iswitchb-exit nil - "Flag to monitor how `iswitchb-buffer' exits. -If equal to `takeprompt', we use the prompt as the buffer name to be -selected.") - -(defvar iswitchb-buffer-ignore-orig nil - "Stores original value of `iswitchb-buffer-ignore'.") - -(defvar iswitchb-xemacs (string-match "XEmacs" (emacs-version)) - "Non-nil if we are running XEmacs. Otherwise, assume we are running Emacs.") - -(defvar iswitchb-default nil - "Default buffer for iswitchb.") - -;;; FUNCTIONS - - -;;; ISWITCHB KEYMAP -(defun iswitchb-define-mode-map () - "Set up the keymap for `iswitchb-buffer'." - (interactive) - (let (map) - ;; generated every time so that it can inherit new functions. - ;;(or iswitchb-mode-map - - (setq map (copy-keymap minibuffer-local-map)) - (define-key map "?" 'iswitchb-completion-help) - (define-key map "\C-s" 'iswitchb-next-match) - (define-key map "\C-r" 'iswitchb-prev-match) - (define-key map "\t" 'iswitchb-complete) - (define-key map "\C-j" 'iswitchb-select-buffer-text) - (define-key map "\C-t" 'iswitchb-toggle-regexp) - (define-key map "\C-x\C-f" 'iswitchb-find-file) - ;;(define-key map "\C-a" 'iswitchb-toggle-ignore) - (define-key map "\C-c" 'iswitchb-toggle-case) - (define-key map "\C-k" 'iswitchb-kill-buffer) - (define-key map "\C-m" 'iswitchb-exit-minibuffer) - (setq iswitchb-mode-map map) - (run-hooks 'iswitchb-define-mode-map-hook) - )) - - - -;;; MAIN FUNCTION -(defun iswitchb () - "Switch to buffer matching a substring. -As you type in a string, all of the buffers matching the string are -displayed. When you have found the buffer you want, it can then be -selected. As you type, most keys have their normal keybindings, -except for the following: -\\ - -RET Select the buffer at the front of the list of matches. If the -list is empty, possibly prompt to create new buffer. - -\\[iswitchb-select-buffer-text] Select the current prompt as the buffer. -If no buffer is found, prompt for a new one. - -\\[iswitchb-next-match] Put the first element at the end of the list. -\\[iswitchb-prev-match] Put the last element at the start of the list. -\\[iswitchb-complete] Complete a common suffix to the current string that -matches all buffers. If there is only one match, select that buffer. -If there is no common suffix, show a list of all matching buffers -in a separate window. -\\[iswitchb-toggle-regexp] Toggle regexp searching. -\\[iswitchb-toggle-case] Toggle case-sensitive searching of buffer names. -\\[iswitchb-completion-help] Show list of matching buffers in separate window. -\\[iswitchb-find-file] Exit iswitchb and drop into find-file. -\\[iswitchb-kill-buffer] Kill buffer at head of buffer list." - ;;\\[iswitchb-toggle-ignore] Toggle ignoring certain buffers (see \ - ;;`iswitchb-buffer-ignore') - - (let - (prompt buf) - - (setq prompt (format "iswitch ")) - - (setq buf (iswitchb-read-buffer prompt)) - - - ;;(message "chosen text %s" iswitchb-final-text) - ;; Choose the buffer name: either the text typed in, or the head - ;; of the list of matches - - (cond ( (eq iswitchb-exit 'findfile) - (call-interactively 'find-file)) - - (t - ;; View the buffer - ;;(message "go to buf %s" buf) - ;; Check buf is non-nil. - (if buf - (if (get-buffer buf) - ;; buffer exists, so view it and then exit - (iswitchb-visit-buffer buf) - ;; else buffer doesn't exist - (iswitchb-possible-new-buffer buf))) - )) - - )) - - - -(defun iswitchb-read-buffer (prompt &optional default require-match) - "Replacement for the built-in `read-buffer'. -Return the name of a buffer selected. -PROMPT is the prompt to give to the user. DEFAULT if given is the default -buffer to be selected, which will go to the front of the list. -If REQUIRE-MATCH is non-nil, an existing-buffer must be selected." - (let - ( - buf-sel - iswitchb-final-text - (icomplete-mode nil) ;; prevent icomplete starting up - ;; can only use fonts if they have been bound. - (iswitchb-use-fonts (and iswitchb-use-fonts - (boundp 'font-lock-comment-face) - (boundp 'font-lock-function-name-face)))) - - (iswitchb-define-mode-map) - (setq iswitchb-exit nil) - (setq iswitchb-rescan t) - (setq iswitchb-text "") - (setq iswitchb-default - (if (bufferp default) - (buffer-name default) - default)) - (iswitchb-make-buflist iswitchb-default) - (iswitchb-set-matches) - (let - ((minibuffer-local-completion-map iswitchb-mode-map) - (iswitchb-prepost-hooks t) - (iswitchb-require-match require-match) - ) - ;; prompt the user for the buffer name - (setq iswitchb-final-text (completing-read - prompt ;the prompt - '(("dummy".1)) ;table - nil ;predicate - nil ;require-match [handled elsewhere] - nil ;initial-contents - 'iswitchb-history))) - ;; Handling the require-match must be done in a better way. - (if (and require-match (not (iswitchb-existing-buffer-p))) - (error "must specify valid buffer")) - - (if (or - (eq iswitchb-exit 'takeprompt) - (null iswitchb-matches)) - (setq buf-sel iswitchb-final-text) - ;; else take head of list - (setq buf-sel (car iswitchb-matches))) - - ;; Or possibly choose the default buffer - (if (equal iswitchb-final-text "") - (setq buf-sel - (car iswitchb-matches))) - - buf-sel)) - - -(defun iswitchb-existing-buffer-p () - "Return non-nil if there is a matching buffer." - (not (null iswitchb-matches))) - -;;; COMPLETION CODE - -(defun iswitchb-set-common-completion () - "Find common completion of `iswitchb-text' in `iswitchb-matches'. -The result is stored in `iswitchb-common-match-string'." - - (let* (val) - (setq iswitchb-common-match-string nil) - (if (and iswitchb-matches - (not iswitchb-regexp) ;; testing - (stringp iswitchb-text) - (> (length iswitchb-text) 0)) - (if (setq val (iswitchb-find-common-substring - iswitchb-matches iswitchb-text)) - (setq iswitchb-common-match-string val))) - val - )) - - -(defun iswitchb-complete () - "Try and complete the current pattern amongst the buffer names." - (interactive) - (let (res) - (cond ((not iswitchb-matches) - (setq this-command 'iswitchb-completion-help) - (iswitchb-completion-help) - ) - - ((= 1 (length iswitchb-matches)) - ;; only one choice, so select it. - (exit-minibuffer)) - - (t - ;; else there could be some completions - (setq res iswitchb-common-match-string) - (if (and (not (memq res '(t nil))) - (not (equal res iswitchb-text))) - ;; found something to complete, so put it in the minibuffer. - (progn - (setq iswitchb-rescan nil) - (delete-region (point-min) (point)) - (insert res)) - ;; else nothing to complete - (setq this-command 'iswitchb-completion-help) - (iswitchb-completion-help) - ) - ) - ))) - - - -;;; TOGGLE FUNCTIONS - -(defun iswitchb-toggle-case () - "Toggle the value of `iswitchb-case'." - (interactive) - (setq iswitchb-case (not iswitchb-case)) - ;; ask for list to be regenerated. - (setq iswitchb-rescan t) - ) - -(defun iswitchb-toggle-regexp () - "Toggle the value of `iswitchb-regexp'." - (interactive) - (setq iswitchb-regexp (not iswitchb-regexp)) - ;; ask for list to be regenerated. - (setq iswitchb-rescan t) - ) - - -(defun iswitchb-toggle-ignore () - "Toggle ignoring buffers specified with `iswitchb-buffer-ignore'." - (interactive) - (if iswitchb-buffer-ignore - (progn - (setq iswitchb-buffer-ignore-orig iswitchb-buffer-ignore) - (setq iswitchb-buffer-ignore nil) - ) - ;; else - (setq iswitchb-buffer-ignore iswitchb-buffer-ignore-orig) - ) - (iswitchb-make-buflist iswitchb-default) - ;; ask for list to be regenerated. - (setq iswitchb-rescan t) - ) - -(defun iswitchb-exit-minibuffer () - "Exit minibuffer, but make sure we have a match if one is needed." - (interactive) - (if (or (not iswitchb-require-match) - (iswitchb-existing-buffer-p)) - (throw 'exit nil) - )) - -(defun iswitchb-select-buffer-text () - "Select the buffer named by the prompt. -If no buffer exactly matching the prompt exists, maybe create a new one." - (interactive) - (setq iswitchb-exit 'takeprompt) - (exit-minibuffer)) - - - -(defun iswitchb-find-file () - "Drop into find-file from buffer switching." - (interactive) - (setq iswitchb-exit 'findfile) - (exit-minibuffer)) - -(defun iswitchb-next-match () - "Put first element of `iswitchb-matches' at the end of the list." - (interactive) - (let ((next (cadr iswitchb-matches))) - (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist next)) - (setq iswitchb-rescan t) - )) - -(defun iswitchb-prev-match () - "Put last element of `iswitchb-matches' at the front of the list." - (interactive) - (let ((prev (car (last iswitchb-matches)))) - (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist prev)) - (setq iswitchb-rescan t) - )) - - - - -(defun iswitchb-chop (list elem) - "Remove all elements before ELEM and put them at the end of LIST." - (let ((ret nil) - (next nil) - (sofar nil)) - (while (not ret) - (setq next (car list)) - (if (equal next elem) - (setq ret (append list (nreverse sofar))) - ;; else - (progn - (setq list (cdr list)) - (setq sofar (cons next sofar))))) - ret)) - - - - -;;; CREATE LIST OF ALL CURRENT BUFFERS - - -(defun iswitchb-make-buflist (default) - "Set `iswitchb-buflist' to the current list of buffers. -Currently visible buffers are put at the end of the list. -The hook `iswitchb-make-buflist-hook' is run after the list has been -created to allow the user to further modify the order of the buffer names -in this list. If DEFAULT is non-nil, and corresponds to an existing buffer, -it is put to the start of the list." - (setq iswitchb-buflist - (let* ((iswitchb-current-buffers (iswitchb-get-buffers-in-frames)) - (buflist - (delq nil - (mapcar - (lambda (x) - (let ((b-name (buffer-name x))) - (if (not - (or - (iswitchb-ignore-buffername-p b-name) - (memq b-name iswitchb-current-buffers))) - b-name))) - (buffer-list))))) - (nconc buflist iswitchb-current-buffers) - (run-hooks 'iswitchb-make-buflist-hook) - ;; Should this be after the hooks, or should the hooks be the - ;; final thing to be run? - (if default - (progn - (setq buflist (delete default buflist)) - (setq buflist (cons default buflist)) - )) - buflist))) - -(defun iswitchb-to-end (lst) - "Move the elements from LST to the end of BUFLIST." - (mapcar - (lambda (elem) - (setq buflist (delq elem buflist))) - lst) - (nconc buflist lst)) - - - -(defun iswitchb-get-buffers-in-frames (&optional current) - "Return the list of buffers that are visible in the current frame. -If optional argument `current' is given, restrict searching to the -current frame, rather than all frames, regardless of value of -`iswitchb-all-frames'." - (let ((iswitchb-bufs-in-frame nil)) - (walk-windows 'iswitchb-get-bufname nil - (if current - nil - iswitchb-all-frames)) - iswitchb-bufs-in-frame)) - - -(defun iswitchb-get-bufname (win) - "Used by `iswitchb-get-buffers-in-frames' to walk through all windows." - (let ((buf (buffer-name (window-buffer win)))) - (if (not (member buf iswitchb-bufs-in-frame)) - ;; Only add buf if it is not already in list. - ;; This prevents same buf in two different windows being - ;; put into the list twice. - (setq iswitchb-bufs-in-frame - (cons buf iswitchb-bufs-in-frame))))) - - -;;; FIND MATCHING BUFFERS - - -(defun iswitchb-set-matches () - "Set `iswitchb-matches' to the list of buffers matching prompt." - (if iswitchb-rescan - (setq iswitchb-matches - (let* ((buflist iswitchb-buflist) - ) - (iswitchb-get-matched-buffers iswitchb-text iswitchb-regexp - buflist))))) - -(defun iswitchb-get-matched-buffers (regexp - &optional string-format buffer-list) - "Return buffers matching REGEXP. -If STRING-FORMAT is nil, consider REGEXP as just a string. -BUFFER-LIST can be list of buffers or list of strings." - (let* ((case-fold-search iswitchb-case) - ;; need reverse since we are building up list backwards - (list (reverse buffer-list)) - (do-string (stringp (car list))) - name - ret - ) - (mapcar - (lambda (x) - - (if do-string - (setq name x) ;We already have the name - (setq name (buffer-name x))) - - (cond - ((and (or (and string-format (string-match regexp name)) - (and (null string-format) - (string-match (regexp-quote regexp) name))) - - (not (iswitchb-ignore-buffername-p name)) - ) - (setq ret (cons name ret)) - ))) - list) - ret - )) - - - - -(defun iswitchb-ignore-buffername-p (bufname) - "Return t if the buffer BUFNAME should be ignored." - (let ((data (match-data)) - (re-list iswitchb-buffer-ignore) - ignorep - nextstr - ) - (while re-list - (setq nextstr (car re-list)) - (cond - ((stringp nextstr) - (if (string-match nextstr bufname) - (progn - (setq ignorep t) - (setq re-list nil)))) - ((fboundp nextstr) - (if (funcall nextstr bufname) - (progn - (setq ignorep t) - (setq re-list nil)) - )) - ) - (setq re-list (cdr re-list))) - (set-match-data data) - - ;; return the result - ignorep) - ) - -(defun iswitchb-word-matching-substring (word) - "Return part of WORD before 1st match to `iswitchb-change-word-sub'. -If `iswitchb-change-word-sub' cannot be found in WORD, return nil." - (let ((case-fold-search iswitchb-case)) - (let ((m (string-match iswitchb-change-word-sub word))) - (if m - (substring word m) - ;; else no match - nil)))) - -(defun iswitchb-find-common-substring (lis subs) - "Return common string following SUBS in each element of LIS." - (let (res - alist - iswitchb-change-word-sub - ) - (setq iswitchb-change-word-sub - (if iswitchb-regexp - subs - (regexp-quote subs))) - (setq res (mapcar 'iswitchb-word-matching-substring lis)) - (setq res (delq nil res)) ;; remove any nil elements (shouldn't happen) - (setq alist (mapcar 'iswitchb-makealist res)) ;; could use an OBARRAY - - ;; try-completion returns t if there is an exact match. - (let ((completion-ignore-case iswitchb-case)) - - (try-completion subs alist) - ))) - - -(defun iswitchb-makealist (res) - "Return dotted pair (RES . 1)." - (cons res 1)) - -;; from Wayne Mesard -(defun iswitchb-rotate-list (lis) - "Destructively removes the last element from LIS. -Return the modified list with the last element prepended to it." - (if (<= (length lis) 1) - lis - (let ((las lis) - (prev lis)) - (while (consp (cdr las)) - (setq prev las - las (cdr las))) - (setcdr prev nil) - (cons (car las) lis)) - )) - - -(defun iswitchb-completion-help () - "Show possible completions in a *Buffer Completions* buffer." - ;; we could allow this buffer to be used to select match, but I think - ;; choose-completion-string will need redefining, so it just inserts - ;; choice with out any previous input. - (interactive) - (setq iswitchb-rescan nil) - (let ((completion-setup-hook nil) ;disable fancy highlight/selection. - (buf (current-buffer)) - (temp-buf "*Buffer Completions*") - (win) - (again (eq last-command this-command))) - - (if again - ;; scroll buffer - (progn - (set-buffer temp-buf) - (setq win (get-buffer-window temp-buf)) - (if (pos-visible-in-window-p (point-max) win) - (set-window-start win (point-min)) - (scroll-other-window)) - (set-buffer buf) - ) - - - (with-output-to-temp-buffer temp-buf - (if iswitchb-xemacs - - ;; XEmacs extents are put on by default, doesn't seem to be - ;; any way of switching them off. - (display-completion-list (if iswitchb-matches - iswitchb-matches - iswitchb-buflist) - :help-string "iswitchb " - :activate-callback - '(lambda (x y z) - (message "doesn't work yet, sorry!"))) - ;; else running Emacs - (display-completion-list (if iswitchb-matches - iswitchb-matches - iswitchb-buflist)) - ))))) - - - -;;; KILL CURRENT BUFFER - -(defun iswitchb-kill-buffer () - "Kill the buffer at the head of `iswitchb-matches'." - (interactive) - (let ( (enable-recursive-minibuffers t) - buf) - - (setq buf (car iswitchb-matches)) - ;; check to see if buf is non-nil. - (if buf - (progn - (kill-buffer buf) - - ;; Check if buffer exists. XEmacs gnuserv.el makes alias - ;; for kill-buffer which does not return t if buffer is - ;; killed, so we can't rely on kill-buffer return value. - (if (get-buffer buf) - ;; buffer couldn't be killed. - (setq iswitchb-rescan t) - ;; else buffer was killed so remove name from list. - (setq iswitchb-buflist (delq buf iswitchb-buflist))))))) - - -;;; VISIT CHOSEN BUFFER -(defun iswitchb-visit-buffer (buffer) - "Visit buffer named BUFFER according to `iswitchb-method'." - (let* (win newframe) - (cond - ((eq iswitchb-method 'samewindow) - (switch-to-buffer buffer)) - - ((memq iswitchb-method '(always-frame maybe-frame)) - (cond - ((and (setq win (iswitchb-window-buffer-p buffer)) - (or (eq iswitchb-method 'always-frame) - (y-or-n-p "Jump to frame? "))) - (setq newframe (window-frame win)) - (raise-frame newframe) - (select-frame newframe) - (select-window win) - (if (not iswitchb-xemacs) - ;; reposition mouse to make frame active. not needed in XEmacs - ;; This line came from the other-frame defun in Emacs. - (set-mouse-position (selected-frame) (1- (frame-width)) 0)) - ) - (t - ;; No buffer in other frames... - (switch-to-buffer buffer) - ))) - - - - ((eq iswitchb-method 'otherwindow) - (switch-to-buffer-other-window buffer)) - - ((eq iswitchb-method 'display) - (display-buffer buffer)) - - ((eq iswitchb-method 'otherframe) - (progn - (switch-to-buffer-other-frame buffer) - (if (not iswitchb-xemacs) - (set-mouse-position (selected-frame) (1- (frame-width)) 0)) - ) - ) ))) - -(defun iswitchb-possible-new-buffer (buf) - "Possibly create and visit a new buffer called BUF." - - (let ((newbufcreated)) - (if (and iswitchb-newbuffer - (or - (not iswitchb-prompt-newbuffer) - - (and iswitchb-prompt-newbuffer - (y-or-n-p - (format - "No buffer matching `%s', create one? " - buf))))) - ;; then create a new buffer - (progn - (setq newbufcreated (get-buffer-create buf)) - (if (fboundp 'set-buffer-major-mode) - (set-buffer-major-mode newbufcreated)) - (iswitchb-visit-buffer newbufcreated)) - ;; else wont create new buffer - (message (format "no buffer matching `%s'" buf)) - ))) - -(defun iswitchb-window-buffer-p (buffer) - "Return window pointer if BUFFER is visible in another frame. -If BUFFER is visible in the current frame, return nil." - (interactive) - (let ((blist (iswitchb-get-buffers-in-frames 'current))) - ;;If the buffer is visible in current frame, return nil - (if (memq buffer blist) - nil - ;; maybe in other frame or icon - (get-buffer-window buffer 0) ; better than 'visible - ))) - -;;;###autoload -(defun iswitchb-default-keybindings () - "Set up default keybindings for `iswitchb-buffer'. -Call this function to override the normal bindings." - (interactive) - (global-set-key (read-kbd-macro "C-x b") 'iswitchb-buffer) - (global-set-key (read-kbd-macro "C-x 4 b") 'iswitchb-buffer-other-window) - (global-set-key (read-kbd-macro "C-x 4 C-o") 'iswitchb-display-buffer) - (global-set-key (read-kbd-macro "C-x 5 b") 'iswitchb-buffer-other-frame)) - - -;;;###autoload -(defun iswitchb-buffer () - "Switch to another buffer. - -The buffer name is selected interactively by typing a substring. The -buffer is displayed according to `iswitchb-default-method' -- the -default is to show it in the same window, unless it is already visible -in another frame. -For details of keybindings, do `\\[describe-function] iswitchb'." - (interactive) - (setq iswitchb-method iswitchb-default-method) - (iswitchb)) - - -;;;###autoload -(defun iswitchb-buffer-other-window () - "Switch to another buffer and show it in another window. -The buffer name is selected interactively by typing a substring. -For details of keybindings, do `\\[describe-function] iswitchb'." - (interactive) - (setq iswitchb-method 'otherwindow) - (iswitchb)) - - - -;;;###autoload -(defun iswitchb-display-buffer () - "Display a buffer in another window but don't select it. -The buffer name is selected interactively by typing a substring. -For details of keybindings, do `\\[describe-function] iswitchb'." - (interactive) - (setq iswitchb-method 'display) - (iswitchb)) - - - -;;;###autoload -(defun iswitchb-buffer-other-frame () - "Switch to another buffer and show it in another frame. -The buffer name is selected interactively by typing a substring. -For details of keybindings, do `\\[describe-function] iswitchb'." - (interactive) - (setq iswitchb-method 'otherframe) - (iswitchb)) - -;;; XEmacs hack for showing default buffer - -;; The first time we enter the minibuffer, Emacs puts up the default -;; buffer to switch to, but XEmacs doesn't -- presumably there is a -;; subtle difference in the two versions of post-command-hook. The -;; default is shown for both whenever we delete all of our text -;; though, indicating its just a problem the first time we enter the -;; function. To solve this, we use another entry hook for emacs to -;; show the default the first time we enter the minibuffer. - -(defun iswitchb-init-XEmacs-trick () - "Display default buffer when first entering minibuffer. -This is a hack for XEmacs, and should really be handled by `iswitchb-exhibit'." - (if (iswitchb-entryfn-p) - (progn - (iswitchb-exhibit) - (goto-char (point-min))))) - - -;; add this hook for XEmacs only. -(if iswitchb-xemacs - (add-hook 'iswitchb-minibuffer-setup-hook - 'iswitchb-init-XEmacs-trick)) - - -;;; XEmacs / backspace key -;; For some reason, if the backspace key is pressed in XEmacs, the -;; line gets confused, so I've added a simple key definition to make -;; backspace act like the normal delete key. - -(defun iswitchb-xemacs-backspacekey () - "Bind backspace to `backward-delete-char'." - (define-key iswitchb-mode-map '[backspace] 'backward-delete-char) - (define-key iswitchb-mode-map '[(meta backspace)] 'backward-kill-word) - ) - - -(if iswitchb-xemacs - (add-hook 'iswitchb-define-mode-map-hook - 'iswitchb-xemacs-backspacekey)) - - - -;;; ICOMPLETE TYPE CODE - -(defun iswitchb-exhibit () - "Find matching buffers and display a list in the minibuffer. -Copied from `icomplete-exhibit' with two changes: -1. It prints a default buffer name when there is no text yet entered. -2. It calls my completion routine rather than the standard completion." - - (if iswitchb-use-mycompletion - (let ((contents (buffer-substring (point-min)(point-max))) - (buffer-undo-list t)) - (save-excursion - (goto-char (point-max)) - ; Register the end of input, so we - ; know where the extra stuff - ; (match-status info) begins: - (if (not (boundp 'iswitchb-eoinput)) - ;; In case it got wiped out by major mode business: - (make-local-variable 'iswitchb-eoinput)) - (setq iswitchb-eoinput (point)) - ;; Update the list of matches - (setq iswitchb-text contents) - (iswitchb-set-matches) - (setq iswitchb-rescan t) - (iswitchb-set-common-completion) - - ;; Insert the match-status information: - (insert-string - (iswitchb-completions - contents - minibuffer-completion-table - minibuffer-completion-predicate - (not minibuffer-completion-confirm))) - )))) - - - -(defun iswitchb-completions - (name candidates predicate require-match) - "Return the string that is displayed after the user's text. -Modified from `icomplete-completions'." - - (let ((comps iswitchb-matches) - ; "-determined" - only one candidate - (open-bracket-determined (if require-match "(" "[")) - (close-bracket-determined (if require-match ")" "]")) - ;"-prospects" - more than one candidate - (open-bracket-prospects "{") - (close-bracket-prospects "}") - first - ) - - (if (and iswitchb-use-fonts comps) - (progn - (setq first (car comps)) - (setq first (format "%s" first)) - (put-text-property 0 (length first) 'face - (if (= (length comps) 1) - 'font-lock-comment-face - 'font-lock-function-name-face) - first) - (setq comps (cons first (cdr comps))) - )) - - (cond ((null comps) (format " %sNo match%s" - open-bracket-determined - close-bracket-determined)) - - ((null (cdr comps)) ;one match - (concat (if (and (> (length (car comps)) - (length name))) - (concat open-bracket-determined - ;; when there is one match, show the - ;; matching buffer name in full - (car comps) - close-bracket-determined) - "") - (if (not iswitchb-use-fonts) " [Matched]") - )) - (t ;multiple matches - (let* ( - ;;(most (try-completion name candidates predicate)) - (most nil) - (most-len (length most)) - most-is-exact - first - (alternatives - (apply - (function concat) - (cdr (apply - (function nconc) - (mapcar '(lambda (com) - (if (= (length com) most-len) - ;; Most is one exact match, - ;; note that and leave out - ;; for later indication: - (progn - (setq most-is-exact t) - ()) - (list "," - (substring com - most-len)))) - comps)))))) - - (concat - - ;; put in common completion item -- what you get by - ;; pressing tab - (if (> (length iswitchb-common-match-string) (length name)) - (concat open-bracket-determined - (substring iswitchb-common-match-string - (length name)) - close-bracket-determined) - ) - ;; end of partial matches... - - ;; think this bit can be ignored. - (and (> most-len (length name)) - (concat open-bracket-determined - (substring most (length name)) - close-bracket-determined)) - - ;; list all alternatives - open-bracket-prospects - (if most-is-exact - (concat "," alternatives) - alternatives) - close-bracket-prospects))) - ))) - -(defun iswitchb-minibuffer-setup () - "Set up minibuffer for `iswitchb-buffer'. -Copied from `icomplete-minibuffer-setup-hook'." - (if (iswitchb-entryfn-p) - (progn - - (make-local-variable 'iswitchb-use-mycompletion) - (setq iswitchb-use-mycompletion t) - (make-local-hook 'pre-command-hook) - (add-hook 'pre-command-hook - 'iswitchb-pre-command - nil t) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook - 'iswitchb-post-command - nil t) - - (run-hooks 'iswitchb-minibuffer-setup-hook) - ) - )) - - -(defun iswitchb-pre-command () - "Run before command in `iswitchb-buffer'." - (iswitchb-tidy)) - - -(defun iswitchb-post-command () - "Run after command in `iswitchb-buffer'." - (iswitchb-exhibit) - ) - - - -(defun iswitchb-tidy () - "Remove completions display, if any, prior to new user input. -Copied from `icomplete-tidy'." - - (if (and (boundp 'iswitchb-eoinput) - iswitchb-eoinput) - - (if (> iswitchb-eoinput (point-max)) - ;; Oops, got rug pulled out from under us - reinit: - (setq iswitchb-eoinput (point-max)) - (let ((buffer-undo-list buffer-undo-list )) ; prevent entry - (delete-region iswitchb-eoinput (point-max)))) - - ;; Reestablish the local variable 'cause minibuffer-setup is weird: - (make-local-variable 'iswitchb-eoinput) - (setq iswitchb-eoinput 1))) - - -(defun iswitchb-entryfn-p () - "Return non-nil if `this-command' shows we are using `iswitchb-buffer'." - (or (boundp 'iswitchb-prepost-hooks) - ;; I think the of this may be redundant, since the prepost hooks - ;; will always be set in the iswitchb defuns. - ;;(and (symbolp this-command) ; ignore lambda functions - ;;(memq this-command - ;; '(iswitchb-buffer - ;; iswitchb-buffer-other-frame - ;; iswitchb-display-buffer - ;; iswitchb-buffer-other-window)))) - )) - - - - - -(defun iswitchb-summaries-to-end () - "Move the summaries to the end of the list. -This is an example function which can be hooked on to -`iswitchb-make-buflist-hook'. Any buffer matching the regexps -`Summary' or `output\*$'are put to the end of the list." - (let ((summaries (delq nil (mapcar - (lambda (x) - (if (or - (string-match "Summary" x) - (string-match "output\\*$" x)) - x)) - buflist) - ))) - - (iswitchb-to-end summaries))) - - - -;;; HOOKS -(add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup) - -(provide 'iswitchb) - -;;; iswitchb.el ends here diff --git a/xemacs-packages/lisp/edit-utils/lazy-lock.el b/xemacs-packages/lisp/edit-utils/lazy-lock.el deleted file mode 100644 index 7016785d..00000000 --- a/xemacs-packages/lisp/edit-utils/lazy-lock.el +++ /dev/null @@ -1,1076 +0,0 @@ -;;; lazy-lock.el --- Lazy demand-driven fontification for fast Font Lock mode. - -;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. -;; Copyright (C) 2000, 2003 Ben Wing. - -;; Author: Ben Wing -;; Original Author: Simon Marshall -;; Maintainer: XEmacs Development Team -;; Keywords: faces files - -;;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: FSF 21.2. Heavily, heavily modified. - -;;; Commentary: - -;; This version of Lazy Lock has been rewritten for XEmacs by Ben Wing. -;; The FSF version (2.11, as of FSF 21.2) supports GNU Emacs only, and -;; relies on C support that is extremely kludgy (three different hooks: -;; `window-scroll-functions', `window-size-change-functions', and -;; `redisplay-end-trigger-functions', and an additional need to hook onto -;; `before-change-functions') and not supported by XEmacs. This version -;; uses `pre-idle-hook' instead. - -;; Simon Marshall has a long diatribe about `pre-idle-hook', noting the -;; fact that it will be called before nearly every redisplay and therefore -;; assuming (wrongly) that this will make a lazy-lock implemented that way -;; extremely slow, as well as complaining about the need to fontify twice -;; as much as necessary, since we don't know the area that will be -;; displayed. However, (a) under XEmacs, we have an argument `GUARANTEE' -;; to `window-end' that computes the proper value as of the next redisplay, -;; so we don't run into the need to fontify more than necessary (in fact -;; lazy-lock version 2 still has this problem), and (b) given proper -;; optimization checks in the pre-idle-hook, the speed of running the hook -;; does not turn out to be a major factor at all. (It's easy to profile -;; this given the built-in profiling support in XEmacs.) We DO have a -;; problem under some circumstances with scrolling -- in particular, -;; scrolling using the arrow keys, but not the page-up/page-down keys. -;; This is because point moves outside the displayed area, and redisplay -;; will then change the displayed area. In such a case we do indeed need -;; to kludgily fontify an area twice the size of the window (and that's -;; only a guess). However, this is at least mitigated by the fact that we -;; can check to determine whether this will happen and only need to take -;; evasive action in those circumstances. - -;; Gerd Marshall in FSF 21 finally went and implemented more-or-less -;; non-kludgy C support for fontification. This involves a hook -;; `fontification-functions', which is triggered by the absence of the -;; `fontified' property on text that redisplay is displaying. This way, -;; redisplay tells us exactly what needs to be fontified, and there is no -;; need for guessing by trapping all sorts of hooks. The one thing that -;; seems somewhat kludgy about this interface is that it passes only a -;; single position, not a range, and asks that the function arbitarily -;; fontify a chunk of 400-600 characters, after which it will check again. -;; However, I trust Gerd's sense of design so I assume there was a reason -;; for this. Perhaps at some point we will implement this support in -;; XEmacs. - -;; Finally, for reasons that are not at all clear to me, someone went ahead -;; and created another lazy fontification package for XEmacs (lazy-shot). -;; That package relies on the extent property `initial-redisplay-function', -;; which would not be so bad except that the implementation of this -;; function is broken in that the function is called through an eval event, -;; which is executed *after* redisplay. Thus, horrible redisplay flashing. -;; To fix this, let the function be called at pre-idle-hook time, or just -;; scrap this stuff entirely and implement `fontification-functions'. - -;; (NB Steve claimed that lazy-lock is too slow or something. However, -;; I used to use it regularly on a Pentium 90 with no problems.) -;; -;; Note: This version is extensively modified from FSF lazy-lock v2.11. -;; Everything related to window-scroll-functions and redisplay end triggers -;; has been removed, as well as the variable `lazy-lock-defer-on-scrolling' -;; and the following functions: -;; -;; -- `lazy-lock-fontify-after-scroll' -;; -- `lazy-lock-defer-after-scroll' -;; -- `lazy-lock-fontify-after-resize' -;; -- `lazy-lock-arrange-before-change' -;; -- `lazy-lock-fontify-after-trigger' -;; -- `lazy-lock-fontify-line-after-change' -;; -- `lazy-lock-fontify-rest-after-change' -;; -- `lazy-lock-defer-line-after-change' -;; -- `lazy-lock-defer-rest-after-change' -;; -- `lazy-lock-fontify-after-visage' -;; -- `lazy-lock-fontify-conservatively' -;; -;; The `*-after-change' functions have been combined into a single -;; after-change function, based on jit-lock (our model, based on -;; pre-idle-hook, is much closer to jit-lock's than FSF's lazy-lock, in -;; that both we and jit-lock have redisplay support of some sort that -;; guarantees that visible regions will get fontified, without the need for -;; numerous hooks and the collusion of other packages). The rest of the -;; functions are simply unnecessary. Some code from lazy-lock v1 is -;; carried over, in particular the code to walk the frames and windows -;; (since pre-idle-hook is called just once and we're not told which -;; windows need updating). - -;; The prime operation of this package can be see in the functions -;; `lazy-lock-fontify-window' and `lazy-lock-after-change'. -;; `lazy-lock-pre-fontify-windows' is also interesting, but mainly just -;; walks through frames and windows, finds windows to fontify and passes -;; them to `lazy-lock-fontify-window'. - -;; "Deferring" in this context is different from the deferring that -;; font-lock itself does. - -;; Font-lock defers fontification of changes made to a buffer until right -;; before display of that buffer. This has lots of advantages -- most -;; noteworthy, it in one fell swoop eliminates almost all the problems with -;; excess fontification. Temporary buffers will never be displayed, so -;; they never will have any fontification done on them. Multiple changes -;; to a buffer can be batched up -- this is important because there is a -;; lot of overhead to doing even a one-character fontification. When a -;; function makes a character-at-a-time change, font-lock used to go crazy, -;; but not any more. - -;; Lazy-lock (and jit-lock, etc.) deferral (perhaps we should call it -;; "support-mode deferral" refers to deferring fontification not until the -;; next redisplay, but some time later (1/4 of a second, 3 seconds, 30 -;; seconds. etc). This usually happens in the context of the after-change -;; function, where the actual region changed (perhaps enlarged a bit) is -;; fontified and the following text is marked (in some sense) as -;; unfontified and will get fontified later, for example on an idle-timer -;; set to go off 1/4 of a second after idle. That way, there will be no -;; interference in typing that would happen when you try to immediately -;; fontify the whole rest of the window every single change. - -;; --ben - -;; Purpose: -;; -;; To make visiting buffers in `font-lock-mode' faster by making fontification -;; be demand-driven and stealthy. -;; Fontification only occurs when, and where, necessary. -;; -;; See caveats and feedback below. See also the fast-lock and lazy-shot -;; packages. (But don't use them at the same time as lazy-lock!) - -;; Installation: -;; -;; As of 21.5, put in your ~/.emacs: -;; -;; (setq font-lock-support-mode 'lazy-lock-mode) -;; -;; For 21.4, do this: -;; -;; (add-hook 'font-lock-mode-hook 'turn-on-lazy-lock) -;; -;; Start up a new XEmacs and use font-lock as usual (except that you can -;; use the so-called "gaudier" fontification regexps on big files without -;; frustration). -;; -;; In a buffer (which has `font-lock-mode' enabled) which is at least -;; `lazy-lock-minimum-size' characters long, only the visible portion of the -;; buffer will be fontified. Motion around the buffer will fontify those -;; visible portions that were not previous fontified. -;; -;; If stealth fontification is enabled, fontification will occur in invisible -;; parts of the buffer after `lazy-lock-stealth-time' seconds of idle time. -;; Caveats: -;; -;; Lazy Lock mode does not work efficiently with Outline mode. This is because -;; when in Outline mode, although text may be hidden (not visible in the -;; window), the text is visible to Emacs Lisp code (not surprisingly) and Lazy -;; Lock fontifies it mercilessly. Hopefully this will be fixed one day. - -;; Feedback: -;; -;; Feedback is welcome. -;; To submit a bug report (or make comments) please send to ben@xemacs.org. - -(require 'font-lock) - -(eval-when-compile - ;; Well, shouldn't Lazy Lock be as lazy as possible? - ;(setq byte-compile-dynamic t byte-compile-dynamic-docstrings t) - ;; - ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (varlist &rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state. -Under FSF, it appears that setting text properties respects the read-only-ness -of a buffer and marks the buffer as modified, as well as maybe even calling -before-change and after-change hooks! We don't do any of these things under -XEmacs, at least currently, so this whole macro is basically just a `let'." - (` (let* ((,@ (append varlist - '(;(modified (buffer-modified-p)) (buffer-undo-list t) - ;(inhibit-read-only t) - ;;; FSF (inhibit-point-motion-hooks t) - ;before-change-functions after-change-functions - ;;; FSF deactivate-mark - ;buffer-file-name buffer-file-truename - )))) - (,@ body) - ;(when (and (not modified) (buffer-modified-p)) - ; (set-buffer-modified-p nil)) - ))) - (put 'save-buffer-state 'lisp-indent-function 1) - ;; - ;; We use this for clarity and speed. Naughty but nice. - (defmacro do-while (test &rest body) - "(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil. -The order of execution is thus BODY, TEST, BODY, TEST and so on -until TEST returns nil." - (` (while (progn (,@ body) (, test))))) - (put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function)) - ;; - ;; We use this for compatibility with a future Emacs. - (or (fboundp 'with-temp-message) - (defmacro with-temp-message (message &rest body) - (let ((current-message (make-symbol "current-message")) - (temp-message (make-symbol "with-temp-message"))) - `(let ((,temp-message ,message) - (,current-message)) - (unwind-protect - (progn - (when ,temp-message - (setq ,current-message (current-message)) - (message "%s" ,temp-message)) - ,@body) - (and ,temp-message ,current-message - (message "%s" ,current-message)))))))) - -(defvar lazy-lock-window-start-cache (make-hash-table :weakness 'key)) -(defvar lazy-lock-window-end-cache (make-hash-table :weakness 'key)) -(defvar lazy-lock-window-buffer-cache (make-hash-table :weakness 'key)) -(defvar lazy-lock-window-buffer-modiff-cache (make-hash-table :weakness 'key)) -(defvar lazy-lock-frame-modiff-cache (make-hash-table :weakness 'key)) -(defvar lazy-lock-text-props-changed-cache (make-hash-table :weakness 'key) - "Table of if non-nil, `lazy-lock' text prop changed and we need to wake up.") - -(defvar lazy-lock-mode nil) ; Whether we are turned on. -(defvar lazy-lock-buffers nil) ; For deferral. -(defvar lazy-lock-timers (cons nil nil)) ; For deferral and stealth. - -(defvar lazy-lock-first-unfontify-pos nil - "Consider text after this position as contextually unfontified. -If nil, contextual fontification is disabled.") -(make-variable-buffer-local 'lazy-lock-first-unfontify-pos) - -(defgroup lazy-lock nil - "Lazy-lock customizations" - :group 'font-lock - :prefix "lazy-lock-") - -;;;###autoload -(defcustom lazy-lock-mode nil - "Non nil means `lazy-lock-mode' is on." - :group 'lazy-lock - :require 'lazy-lock ;; which in turn requires font-lock. - :type 'boolean - :initialize 'custom-initialize-default - :set '(lambda (var val) - (if val - (progn - (lazy-lock-mode 1) - (add-hook 'font-lock-mode-hook 'turn-on-lazy-lock)) - (lazy-lock-mode -1) - (remove-hook 'font-lock-mode-hook 'turn-on-lazy-lock))) - ) - - -;; User Variables: - -(defcustom lazy-lock-minimum-size 25600 - "*Minimum size of a buffer for demand-driven fontification. -On-demand fontification occurs if the buffer size is greater than this value. -If nil, means demand-driven fontification is never performed. -If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), -where MAJOR-MODE is a symbol or t (meaning the default). For example: - ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576)) -means that the minimum size is 25K for buffers in C or C++ modes, one megabyte -for buffers in Rmail mode, and size is irrelevant otherwise. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "none" nil) - (integer :tag "size") - (repeat :menu-tag "mode specific" :tag "mode specific" - :value ((t . nil)) - (cons :tag "Instance" - (radio :tag "Mode" - (const :tag "all" t) - (symbol :tag "name")) - (radio :tag "Size" - (const :tag "none" nil) - (integer :tag "size"))))) - :group 'lazy-lock) - -;; We don't currently support this in our version of lazy-lock. -;; It's tricky to implement given the way our redisplay support works, and -;; it's not clear it's useful. (jit-lock likewise deletes it entirely) -(defcustom lazy-lock-defer-on-the-fly nil - "*If non-nil, means fontification after a change should be deferred. -If nil, means on-the-fly fontification is performed. This means when changes -occur in the buffer, those areas are immediately fontified. -If a list, it should be a list of `major-mode' symbol names for which deferred -fontification should occur. The sense of the list is negated if it begins with -`not'. For example: - (c-mode c++-mode) -means that on-the-fly fontification is deferred for buffers in C and C++ modes -only, and deferral does not occur otherwise. - -NOTE: Not currently implemented in this version of lazy-lock. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "never" nil) - (const :tag "always" t) - (set :menu-tag "mode specific" :tag "modes" - :value (not) - (const :tag "Except" not) - (repeat :inline t (symbol :tag "mode")))) - :group 'lazy-lock) - -(defcustom lazy-lock-defer-contextually 'syntax-driven - "*If non-nil, means deferred fontification should be syntactically true. -If nil, means deferred fontification occurs only on those lines modified. This -means where modification on a line causes syntactic change on subsequent lines, -those subsequent lines are not refontified to reflect their new context. -If t, means deferred fontification occurs on those lines modified and all -subsequent lines. This means those subsequent lines are refontified to reflect -their new syntactic context, either immediately or when scrolling into them. -If any other value, e.g., `syntax-driven', means deferred syntactically true -fontification occurs only if syntactic fontification is performed using the -buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "never" nil) - (const :tag "always" t) - (other :tag "syntax-driven" syntax-driven)) - :group 'lazy-lock) - -(defcustom lazy-lock-defer-time - (if (featurep 'lisp-float-type) (/ (float 1) (float 4)) 1) - "*Time in seconds to delay before beginning deferred fontification. -Deferred fontification occurs if there is no input within this time. -If nil, means fontification is never deferred, regardless of the values of the -variables `lazy-lock-defer-on-the-fly' and `lazy-lock-defer-contextually'. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "never" nil) - (number :tag "seconds")) - :group 'lazy-lock) - -;; not by default because it's not stealthy enough -- it can cause -;; annoying and unpredictable delays when it's running and you try to -;; do something. -(defcustom lazy-lock-stealth-time nil ;30 - "*Time in seconds to delay before beginning stealth fontification. -Stealth fontification occurs if there is no input within this time. -If nil, means stealth fontification is never performed. - -The value of this variable is used when Lazy Lock mode is turned on." - :type '(choice (const :tag "never" nil) - (number :tag "seconds")) - :group 'lazy-lock) - -(defcustom lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250) - "*Maximum size of a chunk of stealth fontification. -Each iteration of stealth fontification can fontify this number of lines. -To speed up input response during stealth fontification, at the cost of stealth -taking longer to fontify, you could reduce the value of this variable." - :type '(integer :tag "lines") - :group 'lazy-lock) - -(defcustom lazy-lock-stealth-load - (if (condition-case nil (load-average) (error)) 200) - "*Load in percentage above which stealth fontification is suspended. -Stealth fontification pauses when the system short-term load average (as -returned by the function `load-average' if supported) goes above this level, -thus reducing the demand that stealth fontification makes on the system. -If nil, means stealth fontification is never suspended. -To reduce machine load during stealth fontification, at the cost of stealth -taking longer to fontify, you could reduce the value of this variable. -See also `lazy-lock-stealth-nice'." - :type (if (condition-case nil (load-average) (error)) - '(choice (const :tag "never" nil) - (integer :tag "load")) - '(const :format "%t: unsupported\n" nil)) - :group 'lazy-lock) - -(defcustom lazy-lock-stealth-nice - (if (featurep 'lisp-float-type) (/ (float 1) (float 8)) 1) - "*Time in seconds to pause between chunks of stealth fontification. -Each iteration of stealth fontification is separated by this amount of time, -thus reducing the demand that stealth fontification makes on the system. -If nil, means stealth fontification is never paused. -To reduce machine load during stealth fontification, at the cost of stealth -taking longer to fontify, you could increase the value of this variable. -See also `lazy-lock-stealth-load'." - :type '(choice (const :tag "never" nil) - (number :tag "seconds")) - :group 'lazy-lock) - -(defcustom lazy-lock-stealth-verbose - (if (featurep 'lisp-float-type) - (and (not lazy-lock-defer-contextually) (not (null font-lock-verbose)))) - "*If non-nil, means stealth fontification should show status messages." - :type 'boolean - :group 'lazy-lock) - -(defcustom lazy-lock-walk-windows 'all-frames - "*If non-nil, fontify windows other than the selected window. -If `all-frames', fontify windows even on other frames. -A non-nil value slows down redisplay." - :type 'boolean - :group 'lazy-lock) - -(defcustom lazy-lock-mode-line-string nil ; " Lazy" - "*String to display in the modeline when `lazy-lock-mode' is active. -Set this to nil if you don't want a modeline indicator." - :type '(choice string - (const :tag "none" nil)) - :group 'lazy-lock) - -; (defvar lazy-lock-rounding-size 500 -; "Round end points of fontified chunks to the nearest multiple of this value. -; Fontifying any amount of text involves some overhead; by increasing the -; size, we minimize this, and by rounding to particular points we help to -; minimize constant refontification in some circumstances when the displayed -; area moves little by little. Setting this too big can cause unnecessary -; delays.") - - -;; User Functions: - -;;;###autoload -(defun lazy-lock-mode (&optional arg) - "Toggle Lazy Lock mode. -With arg, turn Lazy Lock mode on if and only if arg is positive. Enable it -automatically in your `~/.emacs' by: - - (setq font-lock-support-mode 'lazy-lock-mode) - -When Lazy Lock mode is enabled, fontification can be lazy in a number of ways: - -- Demand-driven buffer fontification if `lazy-lock-minimum-size' is non-nil. - This means initial fontification does not occur if the buffer is greater than - `lazy-lock-minimum-size' characters in length. Instead, fontification occurs - when necessary, such as when scrolling through the buffer would otherwise - reveal unfontified areas. This is useful if buffer fontification is too slow - for large buffers. - -- Deferred on-the-fly fontification if `lazy-lock-defer-on-the-fly' is non-nil. - This means on-the-fly fontification does not occur as you type. Instead, - fontification is deferred until after `lazy-lock-defer-time' seconds of Emacs - idle time, while Emacs remains idle. This is useful if fontification is too - slow to keep up with your typing. - -- Deferred context fontification if `lazy-lock-defer-contextually' is non-nil. - This means fontification updates the buffer corresponding to true syntactic - context, after `lazy-lock-defer-time' seconds of Emacs idle time, while Emacs - remains idle. Otherwise, fontification occurs on modified lines only, and - subsequent lines can remain fontified corresponding to previous syntactic - contexts. This is useful where strings or comments span lines. - -- Stealthy buffer fontification if `lazy-lock-stealth-time' is non-nil. - This means remaining unfontified areas of buffers are fontified if Emacs has - been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle. - This is useful if any buffer has any deferred fontification. - -Basic Font Lock mode on-the-fly fontification behaviour fontifies modified -lines only. Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode -on-the-fly fontification may fontify differently, albeit correctly. In any -event, to refontify some lines you can use \\[font-lock-fontify-block]. - -Stealth fontification only occurs while the system remains unloaded. -If the system load rises above `lazy-lock-stealth-load' percent, stealth -fontification is suspended. Stealth fontification intensity is controlled via -the variable `lazy-lock-stealth-nice' and `lazy-lock-stealth-lines', and -verbosity is controlled via the variable `lazy-lock-stealth-verbose'." - (interactive "P") - (let* ((was-on lazy-lock-mode) - (now-on (unless (memq 'lazy-lock-mode font-lock-inhibit-thing-lock) - (if arg (> (prefix-numeric-value arg) 0) (not was-on))))) - (cond ((and now-on (not font-lock-mode)) - ;; Turned on `lazy-lock-mode' rather than `font-lock-mode'. - (let ((font-lock-support-mode 'lazy-lock-mode)) - (font-lock-mode t))) - (now-on - ;; Turn ourselves on. - (set (make-local-variable 'lazy-lock-mode) t) - (lazy-lock-install)) - (was-on - ;; Turn ourselves off. - (set (make-local-variable 'lazy-lock-mode) nil) - (lazy-lock-unstall))))) - -;;;###autoload -(defun turn-on-lazy-lock () - "Unconditionally turn on Lazy Lock mode." - (lazy-lock-mode t)) - -;; Copied from font-lock-value-in-major-mode (not available for 21.4 users) -(defun lazy-lock-value-in-major-mode (alist) - "Return value in ALIST for `major-mode', or ALIST if it is not an alist. -Structure is ((MAJOR-MODE . VALUE) ...) where MAJOR-MODE may be t." - (if (consp alist) - (cdr (or (assq major-mode alist) (assq t alist))) - alist)) - -(defun lazy-lock-install () - (let ((min-size (lazy-lock-value-in-major-mode lazy-lock-minimum-size)) - (defer-change (and lazy-lock-defer-time lazy-lock-defer-on-the-fly)) - (defer-context (and lazy-lock-defer-time lazy-lock-defer-contextually - (or (eq lazy-lock-defer-contextually t) - (null font-lock-keywords-only))))) - ;; - ;; Tell Font Lock whether Lazy Lock will do fontification. - (make-local-variable 'font-lock-fontified) - (setq font-lock-fontified (and min-size (>= (buffer-size) min-size))) - ;; - ;; Add the text properties and fontify. - (if (not font-lock-fontified) - (lazy-lock-after-fontify-buffer) - ;; FSF 21.2 here explicitly fontifies the visible window. Not - ;; necessary in XEmacs. You could say this is yet another hokey - ;; hook-in required to get things working. - ) - - ;; Initialize deferred contextual fontification if requested. - (when defer-context - (setq lazy-lock-first-unfontify-pos - (or lazy-lock-first-unfontify-pos (point-max)))) - - ;; - ;; Add the fontification hooks. - (lazy-lock-install-hooks - font-lock-fontified - (cond ((eq (car-safe defer-change) 'not) - (not (memq major-mode (cdr defer-change)))) - ((listp defer-change) - (memq major-mode defer-change)) - (t - defer-change)) - defer-context) - ;; - ;; Add the fontification timers. - (lazy-lock-install-timers - (if (or defer-change defer-context) lazy-lock-defer-time) - lazy-lock-stealth-time))) - -;; XEmacs DEFER-SCROLL argument deleted and all related code. -(defun lazy-lock-install-hooks (fontifying defer-change defer-context) - ;; Make sure our hooks are correct. - (remove-hook 'pre-idle-hook 'lazy-lock-pre-idle-fontify-windows) - ;; Make sure our hooks are at the end. Font-lock in XEmacs installs its - ;; own pre-idle-hook to implement deferral (#### something that should - ;; really be merged with this file; or more likely, lazy-lock in its - ;; entirety should be merged into font-lock). We *DO NOT* make - ;; pre-idle-hook be local. It needs to be able to update the unfontified - ;; regions of *all* frames. If you turn off lazy lock in your particular - ;; buffer and set a local value to nil, none of the other windows will - ;; get fontified! - (add-hook 'pre-idle-hook 'lazy-lock-pre-idle-fontify-windows t) - ;; - ;; Replace Font Lock mode hook. - (make-local-hook 'after-change-functions) - (remove-hook 'after-change-functions 'font-lock-after-change-function t) - (add-hook 'after-change-functions 'lazy-lock-after-change nil t) - - ;; FSF 21.2: Lots and lots of hooks here. Hooks for `outline', hooks for - ;; `hideshow', hooks for redisplay-end-triggers, window-size-changed, and - ;; window-scroll, before-change-functions needed to set up the end - ;; triggers, multiple different versions of the after-change hook. All - ;; GONE! VANQUISHED! DEAD! DESTROYED! Thank God. We have one - ;; after-change hook and the rest are unnecessary in our model. - ) - -(defun lazy-lock-install-timers (dtime stime) - ;; Schedule or re-schedule the deferral and stealth timers. - ;; The layout of `lazy-lock-timers' is: - ;; ((DEFER-TIME . DEFER-TIMER) (STEALTH-TIME . STEALTH-TIMER) - ;; If an idle timeout has changed, cancel the existing idle timer (if there - ;; is one) and schedule a new one (if the new idle timeout is non-nil). - (unless (eq dtime (car (car lazy-lock-timers))) - (let ((defer (car lazy-lock-timers))) - (when (cdr defer) - (delete-itimer (cdr defer))) - (setcar lazy-lock-timers (cons dtime (and dtime - (run-with-idle-timer dtime t 'lazy-lock-fontify-after-defer)))))) - (unless (eq stime (car (cdr lazy-lock-timers))) - (let ((stealth (cdr lazy-lock-timers))) - (when (cdr stealth) - (delete-itimer (cdr stealth))) - (setcdr lazy-lock-timers (cons stime (and stime - (run-with-idle-timer stime t 'lazy-lock-fontify-after-idle))))))) - -(defun lazy-lock-unstall () - ;; - ;; If Font Lock mode is still enabled, make sure that the buffer is - ;; fontified, and reinstall its hook. We must do this first. - (when font-lock-mode - (when (lazy-lock-unfontified-p) - (let ((verbose (if (numberp font-lock-verbose) - (> (buffer-size) font-lock-verbose) - font-lock-verbose))) - (with-temp-message - (when verbose - (format "Fontifying %s..." (buffer-name))) - ;; Make sure we fontify etc. in the whole buffer. - (save-restriction - (widen) - (lazy-lock-fontify-region (point-min) (point-max)))))) - (add-hook 'after-change-functions 'font-lock-after-change-function nil t)) - ;; - ;; Remove the text properties. - (lazy-lock-after-unfontify-buffer) - ;; - ;; Remove the fontification hooks. - (remove-hook 'after-change-functions 'lazy-lock-after-change t) - ) - -;; use put-nonduplicable-text-property to avoid unfriendly behavior -;; when doing undo, etc. We really don't want syntax-highlighting text -;; properties copied into strings or tracked by undo. -;; -;; Old comment: -;; [[ #### If start-open and end-open really behaved like they are supposed to, -;; we wouldn't really need this. I kind of fixed them up, but there's still -;; a bug -- inserting text into the middle of a region of -;; (start-open t end-open t) text should cause it not to inherit, but it -;; does. ]] -;; -;; They do behave correctly now. #### What should we be doing? --ben - -(defalias 'lazy-lock-put-text-property 'put-nonduplicable-text-property) - - -;; Hook functions. - -;; 1. Text that needs to be fontified is done through `pre-idle-hook', -;; which runs directly before redisplay happens. It is a single hook, -;; so the hook must look through all the windows/frames/etc to see what -;; needs to be done. This is not that elegant of a solution, but it -;; works and avoids the horrible hacked-up multi-hooks in FSF's -;; lazy-lock. Gerd's jit-lock does it right, and #### we should -;; implement the same support. - -;; lazy-lock optimization: -;; -;; pre-idle-hook is called an awful lot -- pretty much every time the -;; mouse moves or a timeout expires, for example. On Linux (sometimes), -;; IRIX 5.x, and Solaris 2.something, it happens every 1/4 of a second -;; due to the 1/4-second timers installed to compensate for various -;; operating system deficiencies in the handling of SIGIO and SIGCHLD. -;; (Those timers cause a cycle of the event loop. They don't necessarily -;; have to, but rewriting to avoid this is fairly tricky and requires -;; having significant amounts of code called from signal handlers, which -;; (despite that fact that FSF Emacs reads its X input during a signal -;; handler ?!), is almost always a bad idea -- it's extremely easy to -;; introduce race conditions, which are very hard to track down. -;; -;; So to improve things, I added `frame-modified-tick'. This is an -;; internal counter that gets ticked any time that any internal -;; redisplay variable gets ticked. If `frame-modified-tick' is -;; the same as the last time we checked, it means that redisplay will -;; do absolutely nothing when encountering this frame, and thus we -;; can skip out immediately. This happens when the 1/4-second timer -;; fires while we're idle, or if we just move the mouse. (Moving -;; around in a buffer changes `frame-modified-tick' because the -;; internal redisplay variable "point_changed" gets ticked. We could -;; easily improve things further by adding more tick counters, mirroring -;; more closely the internal redisplay counters -- e.g. if we had -;; another counter that didn't get ticked when point moved, we could -;; tell if anything was going to happen by seeing if point is within -;; window-start and window-end, since we know that redisplay will -;; only do a window-scroll if it's not. (If window-start or window-end -;; or window-buffer or anything else changed, windows_changed or -;; some other variable will get ticked.)) -;; -;; Also, it's wise to try and avoid things that cons. Avoiding -;; `save-window-excursion', as we do, is definitely a major win because -;; that's a heavy-duty consing function. In fact, we do no consing at all -;; until the frame-modified tick goes off, and even then the only potential -;; consing we do is save-excursion; but in fact, that is consless too. - -(defun lazy-lock-pre-idle-fontify-windows () -; (debug-print (gethash (selected-frame) lazy-lock-frame-modiff-cache)) -; (debug-print (frame-modified-tick (selected-frame))) - (unless nil ;(memq this-command lazy-lock-ignore-commands) - ;; Do the visible parts of the buffer(s), i.e., the window(s). - ;(dp "pre-idle-called") - (if (or (not lazy-lock-walk-windows) - (and (eq lazy-lock-walk-windows t) (one-window-p t))) - (or (window-minibuffer-p (selected-window)) - (lazy-lock-fontify-window (selected-window))) - (if (eq lazy-lock-walk-windows t) - (lazy-lock-maybe-fontify-frame (selected-frame)) - ;; Visit all visible non-minibuffer-only frames on the selected device. - ;; This is harder than it looks, since the `next-frame' - ;; interface is error-prone - finding the starting frame is hard. - (catch 'lazy-lock-frame-loop-done - (let* ((starting-frame (selected-frame)) - (frame starting-frame)) - (when (or (not (frame-visible-p frame)) - (frame-minibuffer-only-p frame)) - ;; starting-frame not suitable. - (setq starting-frame (next-frame starting-frame 'visible-nomini)) - (when (eq starting-frame frame) - ;; No suitable frames. - (throw 'lazy-lock-frame-loop-done t)) - (setq frame starting-frame)) - (while t - (lazy-lock-maybe-fontify-frame frame) - (setq frame (next-frame frame 'visible-nomini)) - (when (eq frame starting-frame) - (throw 'lazy-lock-frame-loop-done t))))))))) - -(defun lazy-lock-maybe-fontify-frame (frame) - ;; Fontify the given frame if we need to. We first check the - ;; appropriate frame-modified-tick to avoid changing global state. - ;(dp "fontify-frame %s" frame) - (let ((tick (frame-modified-tick frame))) - ;(dp tick) - (unless (eq tick (gethash frame lazy-lock-frame-modiff-cache)) - (puthash frame tick lazy-lock-frame-modiff-cache) - ;; We have to select the frame due to a bug in walk-windows in XEmacs - ;; 21.4. - (with-selected-frame frame - (walk-windows #'lazy-lock-fontify-window 'no-minibuf frame))))) - -;; 2. Modified text must be marked as unfontified so it can be identified and -;; fontified later when Emacs is idle. Deferral occurs by adding one of -;; `lazy-lock-fontify-*-after-change' (for on-the-fly fontification) or -;; `lazy-lock-defer-*-after-change' (for deferred fontification) to the -;; hook `after-change-functions'. - -;; Modeled after jit-lock-after-change (21.2). -(defun lazy-lock-after-change (beg end old-len) - "Mark the rest of the buffer as not fontified after a change. -Installed on `after-change-functions'. -BEG and END are the start and end of the changed text. OLD-LEN -is the pre-change length. -This function ensures that lines following the change will be refontified -in case the syntax of those lines has changed. Refontification -will take place when text is fontified stealthily." - (when lazy-lock-mode - (save-excursion - (save-buffer-state nil - ;; It's important that the `fontified' property be set from the - ;; beginning of the line, else font-lock will properly change the - ;; text's face, but the display will have been done already and will - ;; be inconsistent with the buffer's content. - (goto-char beg) - (setq beg (point-at-bol)) - - ;; If we're in text that matches a multi-line font-lock pattern, - ;; make sure the whole text will be redisplayed. - (when (get-text-property beg 'font-lock-multiline) - (setq beg (or (previous-single-property-change - beg 'font-lock-multiline) - (point-min)))) - - ;; Make sure we change at least one char (in case of deletions). - (setq end (min (max end (1+ beg)) (point-max))) - ;; Request refontification of changed region right away. - ;;(when (not lazy-lock-defer-on-the-fly) #### Doesn't work. - ;;We have to arrange a way for the inserted chunk to definitely be - ;;fontified in the defer function. There may be a whole bunch of - ;;chunks inserted before the defer function is run. We'd probably - ;;need text properties with a different name from `lazy-lock' to - ;;note all such regions, and maybe keep a minimum and maximum, and - ;;it would make the logic all clogged up. --ben - (if (= beg end) - (font-lock-after-change-function beg end old-len) - (lazy-lock-put-text-property beg end 'lazy-lock nil))) - (unless (memq (current-buffer) lazy-lock-buffers) - (push (current-buffer) lazy-lock-buffers)) - ;; Mark the change for deferred contextual refontification. - (when lazy-lock-first-unfontify-pos - (setq lazy-lock-first-unfontify-pos - (min lazy-lock-first-unfontify-pos beg))) - ))) - -;; 3. Deferred fontification and stealth fontification are done from these two -;; functions. They are set up as Idle Timers. - -(defun lazy-lock-fontify-after-defer () - ;; Called from `timer-idle-list'. - ;; Fontify all windows where deferral has occurred for its buffer. - ;(beep) - ;(dp "fontify-after-defer") - (save-excursion - (while (and lazy-lock-buffers (not (input-pending-p))) - (let ((buffer (car lazy-lock-buffers)) windows) - ;; Paranoia: check that the buffer is still live and Lazy Lock mode on. - (when (buffer-live-p buffer) - (set-buffer buffer) - (when lazy-lock-mode - ;; Perform deferred unfontification, if any. - (when lazy-lock-first-unfontify-pos - (save-restriction - (widen) - (when (and (>= lazy-lock-first-unfontify-pos (point-min)) - (< lazy-lock-first-unfontify-pos (point-max))) - (save-buffer-state nil - (lazy-lock-put-text-property lazy-lock-first-unfontify-pos - (point-max) 'lazy-lock nil)) - (setq lazy-lock-first-unfontify-pos (point-max)) - ))) - - (setq windows (get-buffer-window-list buffer 'nomini t)) - (while windows - (puthash (car windows) t lazy-lock-text-props-changed-cache) - ;; #### The following isn't necessary. Does it speed up the - ;; response time? Or slow down the overall performance? - (lazy-lock-fontify-window (car windows)) - (setq windows (cdr windows))))) - (setq lazy-lock-buffers (cdr lazy-lock-buffers)))))) - -(defun lazy-lock-fontify-after-idle () - ;; Called from `timer-idle-list'. - ;; Fontify all buffers that need it, stealthily while idle. - (unless (or executing-kbd-macro (window-minibuffer-p (selected-window))) - ;; Loop over all buffers, fontify stealthily for each if necessary. - (let ((buffers (buffer-list)) (continue t) - message ;; FSF 21.2 message-log-max minibuffer-auto-raise - ) - (save-excursion - (do-while (and buffers continue) - (set-buffer (car buffers)) - (if (not (and lazy-lock-mode (lazy-lock-unfontified-p))) - (setq continue (not (input-pending-p))) - ;; Fontify regions in this buffer while there is no input. - (with-temp-message - (when lazy-lock-stealth-verbose - "Fontifying stealthily...") - (do-while (and (lazy-lock-unfontified-p) continue) - (if (and lazy-lock-stealth-load - (> (car (load-average)) lazy-lock-stealth-load)) - ;; Wait a while before continuing with the loop. - (progn - (when message - (message "Fontifying stealthily...suspended") - (setq message nil)) - (setq continue (sit-for (or lazy-lock-stealth-time 30)))) - ;; Fontify a chunk. - (when lazy-lock-stealth-verbose - (if message - (message "Fontifying stealthily... %2d%% of %s" - (lazy-lock-percent-fontified) (buffer-name)) - (message "Fontifying stealthily...") - (setq message t))) - ;; Current buffer may have changed during `sit-for'. - (set-buffer (car buffers)) - (lazy-lock-fontify-chunk) - (setq continue (sit-for (or lazy-lock-stealth-nice 0))))))) - (setq buffers (cdr buffers))))))) - -;; 4. Special circumstances. - -(defun lazy-lock-after-fontify-buffer () - ;; Called from `font-lock-after-fontify-buffer'. - ;; Mark the current buffer as fontified. - ;; FSF: [[This is a conspiracy hack between lazy-lock.el and font-lock.el.]] - (save-buffer-state nil - (lazy-lock-put-text-property (point-min) (point-max) - 'lazy-lock t))) - -(defun lazy-lock-after-unfontify-buffer () - ;; Called from `font-lock-after-unfontify-buffer'. - ;; Mark the current buffer as unfontified. - ;; FSF: [[This is a conspiracy hack between lazy-lock.el and font-lock.el.]] - (save-buffer-state nil - (remove-text-properties (point-min) (point-max) '(lazy-lock nil)))) - - - -;; Functions for fontification: - -;; If packages want to ensure that some region of the buffer is fontified, they -;; should use this function. For an example, see ps-print.el. - -(defun lazy-lock-fontify-region (beg end) - ;; Fontify between BEG and END, where necessary, in the current buffer. - (save-restriction - (widen) - (when (setq beg (text-property-any beg end 'lazy-lock nil)) - (save-excursion - (save-match-data - (save-buffer-state - ;; Ensure syntactic fontification is always correct. - ;; Do NOT bind font-lock-beginning-of-syntax-function because - ;; that leads to catastrophic behavior when scrolling backwards - ;; from the end of a large buffer -- parse-partial-sexp will start - ;; at (point-min) each time! - (;; FSF 21.2 font-lock-beginning-of-syntax-function - next) - ;; Find successive unfontified regions between BEG and END. - (condition-case data - ;; FSF has just BEG as the condition. We have a bug in - ;; text-property-any in 21.4 when BEG > END so we need the - ;; extra check. - (do-while (and beg (< beg end)) - (setq next (or (text-property-any beg end 'lazy-lock t) end)) - ;; Make sure the region end points are at beginning of - ;; line. - (goto-char beg) - (unless (bolp) - (beginning-of-line) - (setq beg (point))) - (goto-char next) - (unless (bolp) - (forward-line) - (setq next (point))) - ;; Fontify the region, then flag it as fontified. - (font-lock-fontify-region beg next) - (lazy-lock-put-text-property beg next 'lazy-lock t) - (setq beg (text-property-any next end 'lazy-lock - nil))) - ((error quit) (message "Fontifying region...%s" data)) - ))))))) - -(defun lazy-lock-fontify-chunk () - ;; Fontify the nearest chunk, for stealth, in the current buffer. - (let (;(inhibit-point-motion-hooks t) - ) - (save-excursion - (save-restriction - (widen) - ;; Move to end of line in case the character at point is not fontified. - (end-of-line) - ;; Find where the previous (next) unfontified regions end (begin). - (let ((prev (previous-single-property-change (point) 'lazy-lock)) - (next (text-property-any (point) (point-max) 'lazy-lock nil))) - ;; Fontify from the nearest unfontified position. - (if (or (null prev) (and next (< (- next (point)) (- (point) prev)))) - ;; The next, or neither, region is the nearest not fontified. - (lazy-lock-fontify-region - (progn (goto-char (or next (point-min))) - (beginning-of-line) - (point)) - (progn (goto-char (or next (point-min))) - (forward-line lazy-lock-stealth-lines) - (point))) - ;; The previous region is the nearest not fontified. - (lazy-lock-fontify-region - (progn (goto-char prev) - (forward-line (- lazy-lock-stealth-lines)) - (point)) - (progn (goto-char prev) - (forward-line) - (point))))))))) - -(defun lazy-lock-vertical-motion-value (window pos lines) - "Move LINES lines down from POS in the WINDOW's buffer and return pos." - (let ((buffer (window-buffer window))) - (if (eq window (selected-window)) - (with-current-buffer buffer - (save-excursion - (goto-char pos) - (vertical-motion lines window) - (point)))) - ;; In this case, vertical-motion sets window's point, not window's - ;; buffer's point. - (let ((winp (window-point window))) - (unwind-protect - (progn - (set-window-point window pos) - (vertical-motion lines window) - (window-point window)) - (set-window-point window winp))))) - -(defun lazy-lock-fontify-window (window) - ;; Fontify the given window if we need to. We first check the - ;; buffer-local value of lazy-lock-mode to make sure we should do - ;; the more accurate (but semi-expensive) checks below. - ;(dp "fontifying %s" window) - (let ((buffer (window-buffer window)) - we-are-screwed - (check-text-props (gethash window lazy-lock-text-props-changed-cache))) - (when (symbol-value-in-buffer 'lazy-lock-mode buffer) - (with-current-buffer buffer - (let ((ws (window-start window)) - ;; use the GUARANTEE option on window-end to be accurate. this - ;; also avoids the need to fontify an over-large area to avoid - ;; leaving unfontified areas visible. Unfortunately, it seems - ;; that by just using the return value from window-end, the - ;; clipped line at the bottom of the window doesn't get - ;; fontified. So we have to go down from there. It turns out - ;; that an arg of 2 is the minimum that will work -- and 0 - ;; actually goes up a line! #### Another bug in vertical-motion? - (we ;(window-end window t)) - (lazy-lock-vertical-motion-value window - (window-end window t) 2)) - (point (point buffer)) - (modiff (buffer-modified-tick buffer))) - (cond ((or (< point ws) (> point we)) - (setq we-are-screwed t check-text-props t)) - ((or check-text-props - (not - (and - (eq buffer - (gethash window lazy-lock-window-buffer-cache)) - (eq modiff - (gethash window - lazy-lock-window-buffer-modiff-cache)) - (eq ws (gethash window lazy-lock-window-start-cache)) - (eq we (gethash window lazy-lock-window-end-cache))))) - (setq check-text-props t))) - (when we-are-screwed - (setq ws - (lazy-lock-vertical-motion-value window (window-point window) - (- (window-height window)))) - (setq we - (lazy-lock-vertical-motion-value window (window-point window) - (window-height window))) - ;; #### Not currently implemented. Perhaps not necessary. -; (setq ws (* lazy-lock-rounding-size -; (/ ws lazy-lock-rounding-size)) -; we (* lazy-lock-rounding-size -; (/ (+ we (1- lazy-lock-rounding-size)) -; lazy-lock-rounding-size))) -; (setq ws (max (point-min buffer) ws) -; we (min (point-max buffer) we))) - ) - (when check-text-props - (puthash window buffer lazy-lock-window-buffer-cache) - (puthash window modiff lazy-lock-window-buffer-modiff-cache) - (puthash window ws lazy-lock-window-start-cache) - (puthash window we lazy-lock-window-end-cache) - (lazy-lock-fontify-region ws we) - )))))) - -(defun lazy-lock-unfontified-p () - ;; Return non-nil if there is anywhere still to be fontified. - (save-restriction - (widen) - (text-property-any (point-min) (point-max) 'lazy-lock nil))) - -(defun lazy-lock-percent-fontified () - ;; Return the percentage (of characters) of the buffer that are fontified. - (save-restriction - (widen) - (let ((beg (point-min)) (size 0) next) - ;; Find where the next fontified region begins. - (while (setq beg (text-property-any beg (point-max) 'lazy-lock t)) - (setq next (or (text-property-any beg (point-max) 'lazy-lock nil) - (point-max))) - (incf size (- next beg)) - (setq beg next)) - ;; Float because using integer multiplication will frequently overflow. - (truncate (* (/ (float size) (point-max)) 100))))) - -;; Install ourselves: - -(add-hook 'font-lock-after-fontify-buffer-hook - 'lazy-lock-after-fontify-buffer) - -(add-hook 'font-lock-after-unfontify-buffer-hook - 'lazy-lock-after-unfontify-buffer) - -;; XEmacs change: do it the right way. This works with modeline mousing. -;;;###autoload -(add-minor-mode 'lazy-lock-mode 'lazy-lock-mode-line-string) - -;; Provide ourselves: - -(provide 'lazy-lock) - -;;; lazy-lock.el ends here diff --git a/xemacs-packages/lisp/edit-utils/lazy-shot.el b/xemacs-packages/lisp/edit-utils/lazy-shot.el deleted file mode 100644 index b89dcd5a..00000000 --- a/xemacs-packages/lisp/edit-utils/lazy-shot.el +++ /dev/null @@ -1,327 +0,0 @@ -;;; lazy-shot.el --- Lazy font locking for XEmacs - -;; Copyright (C) 1997 Jan Vroonhof - -;; Author: Jan Vroonhof -;; Keywords: languages, faces - -;; This file is part of XEmacs - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not in FSF (mostly equivalent to lazy-lock 2.09 -;;; in FSF 20.2). - -;;; Commentary: - -;;; This is an experimental demand based font-lock implemenation. It -;;; is almost equal in functionality and interface to lazy-lock 2.09 -;;; Does somebody really need defer-locking? -;;; -;;; To use: put -;;; (add-hook 'font-lock-mode-hook 'turn-on-lazy-shot) -;;; in .emacs (.xemacs/init.el). Do not use in combination with -;;; lazy-lock. - -;;; It is exprimental in the sense that it relies on C support from -;;; the redisplay engine, that is experimental. The code in this file -;;; is more or less finished. The C code support experimental because -;;; the current design is rumoured to be ugly. Secondly because -;;; XEmacs does actually display the "un-font-locked" parts of the -;;; buffer first, the user notices flashing as the buffer is repainted -;;; with color/fonts. - -;;; Code: - -(require 'font-lock) -(require 'itimer) - -(defgroup lazy-shot nil - "Lazy-shot customizations" - :group 'tools - :group 'faces - :prefix "lazy-shot-") - -;;;###autoload -(defcustom lazy-shot-mode nil ;; customized for the options menu. - dverna - "Non nil means `lazy-shot-mode' is on." - :group 'lazy-shot - :require 'lazy-shot ;; which in turn requires font-lock. - :type 'boolean - :initialize 'custom-initialize-default - :set '(lambda (var val) - (if val - (progn - (lazy-shot-mode 1) - (add-hook 'font-lock-mode-hook 'turn-on-lazy-shot)) - (lazy-shot-mode -1) - (remove-hook 'font-lock-mode-hook 'turn-on-lazy-shot)) - (setq-default lazy-shot-mode val)) - ) - -(defvar lazy-shot-stealth-timer nil) - -(defcustom lazy-shot-minimum-size 0 - "*Minimum size of a buffer for demand-driven fontification. -On-demand fontification occurs if the buffer size is greater than this value. -If nil, means demand-driven fontification is never performed." - :type '(choice (const :tag "Off" nil) - (integer :tag "Size")) - :group 'lazy-shot) - - -(defcustom lazy-shot-step-size 1024 ; Please test diffent sizes - "Minimum size of each fontification shot." - :type 'integer - :group 'lazy-shot) - -(defcustom lazy-shot-stealth-time 30 - "*Time in seconds to delay before beginning stealth fontification. -Stealth fontification occurs if there is no input within this time. -If nil, means stealth fontification is never performed. - -The value of this variable is used when Lazy Shot mode is turned on." - :type '(choice (const :tag "Off" nil) - (number :tag "Time")) - :group 'lazy-shot) - -(defcustom lazy-shot-stealth-lines (if font-lock-maximum-decoration 100 250) - "*Maximum size of a chunk of stealth fontification. -Each iteration of stealth fontification can fontify this number of lines. -To speed up input response during stealth fontification, at the cost of stealth -taking longer to fontify, you could reduce the value of this variable." - :type 'integer - :group 'lazy-shot) - -(defcustom lazy-shot-stealth-nice - (/ (float 1) (float 8)) - "*Time in seconds to pause between chunks of stealth fontification. -Each iteration of stealth fontification is separated by this amount of time. -To reduce machine load during stealth fontification, at the cost of stealth -taking longer to fontify, you could increase the value of this variable." - :type 'number - :group 'lazy-shot) - -(defcustom lazy-shot-verbose (not (null font-lock-verbose)) - "*If non-nil, means demand fontification should show status messages." - :type 'boolean - :group 'lazy-shot) - -(defcustom lazy-shot-stealth-verbose (not (null lazy-shot-verbose)) - "*If non-nil, means stealth fontification should show status messages." - :type 'boolean - :group 'lazy-shot) - - - -;;;###autoload -(defun lazy-shot-mode (&optional arg) - "Toggle Lazy Lock mode. -With arg, turn Lazy Lock mode on if and only if ARG is positive." - (interactive "P") - (let ((was-on lazy-shot-mode)) - (set (make-local-variable 'lazy-shot-mode) - (and (if arg (> (prefix-numeric-value arg) 0) (not lazy-shot-mode)))) - (cond ((and lazy-shot-mode (not font-lock-mode)) - ;; Turned on `lazy-shot-mode' rather than `font-lock-mode'. - (let ((font-lock-support-mode 'lazy-shot-mode)) - (font-lock-mode t))) - (lazy-shot-mode - ;; Turn ourselves on. - (lazy-shot-install)) - (was-on - ;; Turn ourselves off. - (lazy-shot-unstall))))) - -(custom-add-option 'font-lock-mode-hook 'turn-on-lazy-shot) - -;;;###autoload -(defun turn-on-lazy-shot () - "Unconditionally turn on Lazy Lock mode." - (lazy-shot-mode t)) - - ;; Can we do something intelligent here? - ;; I would want to set-extent-end-position start on extents that - ;; only partially overlap! -(defun lazy-shot-clean-up-extents (start end) - "Make sure there are no lazy-shot-extents between START and END. -This improves efficiency and C-g behavior." - ;; Be carefull this function is typically called with inhibit-quit! - (map-extents (lambda (e b) (delete-extent e)) - nil start end nil 'start-and-end-in-region 'initial-redisplay-function - 'lazy-shot-redisplay-function)) - -(defun lazy-shot-redisplay-function (extent) - "Lazy lock the EXTENT when it has become visible." - (lazy-shot-lock-extent extent nil)) - - -(defun lazy-shot-lock-extent (extent stealth) - "Font-lock the EXTENT. Called from redisplay-trigger functions and -stealth locking functions." - (when (and (extent-live-p extent) (null (extent-detached-p extent))) - (let ((start (extent-start-position extent)) - (end (extent-end-position extent)) - (buffer (extent-object extent))) - (delete-extent extent) - (lazy-shot-fontify-internal buffer start end - (or lazy-shot-verbose - (and stealth - lazy-shot-stealth-verbose)) - (if stealth "stealthy " ""))))) - -(defun lazy-shot-fontify-internal (buffer start end verbose message) - (save-excursion - ;; Should inhibit quit here - (set-buffer buffer) ;; with-current-buffer is silly here - ;; This magic should really go into font-lock-fonity-region - (goto-char start) - (setq start (point-at-bol)) - (goto-char end) - (setq end (point-at-bol 2)) - (lazy-shot-clean-up-extents start end) - ;; and a allow quit here - (if verbose - (display-message 'progress - (format "Lazy-shot fontifying %sfrom %s to %s in %s" - message start end buffer))) - (save-match-data - (font-lock-fontify-region start end)))) - -;; Note this is suboptimal but works for now. It is not called that often. -(defun lazy-shot-fontify-region (start end &optional buffer) - (lazy-shot-fontify-internal (or buffer (current-buffer)) - start end lazy-shot-verbose - "on request ")) - -(defun lazy-shot-stealth-lock (buffer) - "Find an extent to lazy lock in BUFFER." - (if (buffer-live-p buffer) - (with-current-buffer buffer - (let ((extent t)) - (while (and extent (sit-for lazy-shot-stealth-nice)) - (setq extent - (or ;; First after point - (map-extents (lambda (e n) e) nil (point) nil nil nil - 'initial-redisplay-function - 'lazy-shot-redisplay-function) - ;; Then before it - (map-extents (lambda (e n) e) nil nil (point) nil nil - 'initial-redisplay-function - 'lazy-shot-redisplay-function))) - (if extent - (lazy-shot-lock-extent extent t) - (delete-itimer current-itimer) - (setq lazy-shot-stealth-timer nil))))) - (delete-itimer current-itimer))) - -(defun lazy-shot-install-extent (spos epos &optional buffer) - "Make an extent that will lazy-shot if it is displayed." - (let ((extent (make-extent spos epos buffer))) - (when extent - (set-extent-property extent 'initial-redisplay-function - 'lazy-shot-redisplay-function)) - extent)) - - -(defun lazy-shot-install-extents (start end fontifying) - ;; - ;; Add hook if lazy-shot.el is deferring or is fontifying on scrolling. - (when fontifying - (save-excursion - (goto-char start) - (while (not (>= (point) end)) - (setq start (point)) - (goto-char (min end (+ start lazy-shot-step-size))) - (forward-line 1) - (lazy-shot-install-extent start (point)))))) - - -(defun lazy-shot-after-change-function (start end old-len) - (and lazy-shot-mode - ;; If it is too small an insert to notice, let font-lock take - ;; care of it. - (if (< (- end start) lazy-shot-step-size) - (font-lock-after-change-function start end old-len) - ;; If there is an extent of ours, get rid of it first, and - ;; expand the region that we should be extentifying. - (let ((extent (map-extents '(lambda (e b) e) - nil start end nil nil - 'initial-redisplay-function - 'lazy-shot-redisplay-function))) - (when extent - (setq start (min start (extent-start-position extent)) - end (max end (extent-end-position extent))) - (delete-extent extent))) - ;; Extentify the region. - (lazy-shot-install-extents start end font-lock-fontified)))) - - -(defun lazy-shot-install-timer (fontifying) - (when (and lazy-shot-stealth-time fontifying) - (make-variable-buffer-local 'lazy-shot-stealth-timer) - (prog1 - (setq lazy-shot-stealth-timer - (start-itimer (format "lazy shot for %s" (current-buffer)) - 'lazy-shot-stealth-lock lazy-shot-stealth-time - lazy-shot-stealth-time - t t (current-buffer))) - (make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'lazy-shot-unstall-after-fontify nil t)))) - - -(defun lazy-shot-install () - (make-local-variable 'font-lock-fontified) - (setq font-lock-fontified (and lazy-shot-minimum-size - (>= (buffer-size) lazy-shot-minimum-size))) - (lazy-shot-install-extents (point-min) (point-max) font-lock-fontified) - (lazy-shot-install-timer font-lock-fontified) - (add-hook 'font-lock-after-fontify-buffer-hook - 'lazy-shot-unstall-after-fontify) - ;; [Comment stolen from lazy-lock.el.] - ;; Fascistically remove font-lock's after-change-function and install - ;; our own. We know better than font-lock what to do. Otherwise, - ;; revert-buffer, insert-file, etc. cause full refontification of the - ;; entire changed area. - (remove-hook 'after-change-functions 'font-lock-after-change-function t) - (make-local-hook 'after-change-functions) - (add-hook 'after-change-functions 'lazy-shot-after-change-function nil t)) - -;; Kludge needed untill lazy-lock-fontify-region is more intelligent -(defun lazy-shot-unstall-after-fontify () - (lazy-shot-unstall 1)) - -(defun lazy-shot-unstall (&optional no-fontify) - ;; Stop the timer - (when (and (boundp 'lazy-shot-stealth-timer) lazy-shot-stealth-timer) - (delete-itimer lazy-shot-stealth-timer) - (setq lazy-shot-stealth-timer nil)) - ;; Remove the extents. - (map-extents - (lambda (e arg) (delete-extent e) nil) - nil nil nil nil nil 'initial-redisplay-function 'lazy-shot-redisplay-function) - (when (and font-lock-mode (not no-fontify)) - (save-restriction - (widen) - (lazy-shot-fontify-region (point-min) (point-max)))) - (remove-hook 'after-change-functions 'lazy-shot-after-change-function t) - (if font-lock-mode - (add-hook 'after-change-functions 'font-lock-after-change-function - nil t))) - -(provide 'lazy-shot) - -;;; lazy-shot.el ends here diff --git a/xemacs-packages/lisp/edit-utils/lispm-fonts.el b/xemacs-packages/lisp/edit-utils/lispm-fonts.el deleted file mode 100644 index acd54054..00000000 --- a/xemacs-packages/lisp/edit-utils/lispm-fonts.el +++ /dev/null @@ -1,191 +0,0 @@ -;;; lispm-fonts.el --- quick hack to parse LISPM-style font-shift codes - -;; Keywords: faces - -;; Copyright (C) 1992-1993 Free Software Foundation, Inc. - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not in FSF. - -;; This only copes with MIT/LMI/TI style font shifts, not Symbolics. -;; It doesn't do diagram lines (ha ha). It doesn't do output. That -;; has to wait until it is possible to attach faces to characters -;; instead of just intervals, since this code is really talking about -;; attributes of the text instead of attributes of regions of the -;; buffer. We could do it by mapping over the extents and hacking -;; the overlaps by hand, but that would be hard. - -(make-face 'variable) -(or (face-differs-from-default-p 'variable) - (set-face-font 'variable - "-*-helvetica-medium-r-*-*-*-120-*-*-*-*-*-*")) - -(make-face 'variable-bold) -(or (face-differs-from-default-p 'variable-bold) - (progn - ;; This is no good because helvetica-12-bold is a LOT larger than - ;; helvetica-12-medium. Someone really blew it there. - ;; (copy-face 'variable 'variable-bold) - ;; (make-face-bold 'variable-bold) - (set-face-font 'variable-bold - "-*-helvetica-bold-r-*-*-*-100-*-*-*-*-*-*"))) - -(make-face 'variable-italic) -(or (face-differs-from-default-p 'variable-italic) - (progn - (copy-face 'variable-bold 'variable-italic) ; see above - (make-face-unbold 'variable-italic) - (make-face-italic 'variable-italic))) - -(make-face 'variable-bold-italic) -(or (face-differs-from-default-p 'variable-bold-italic) - (progn - (copy-face 'variable-bold 'variable-bold-italic) - (make-face-italic 'variable-bold-italic))) - -(defconst lispm-font-to-face - '(("tvfont" . default) - ("cptfont" . default) - ("cptfontb" . bold) - ("cptfonti" . italic) - ("cptfontbi" . bold-italic) - ("base-font" . default) - ("bigfnt" . bold) - ("cmb8" . variable-bold) - ("higher-medfnb" . bold) - ("higher-tr8" . default) - ("medfnb" . bold) - ("medfnt" . normal) - ("medfntb" . bold) - ("wider-font" . bold) - ("wider-medfnt" . bold) - ("mets" . variable-large) - ("metsb" . variable-large-bold) - ("metsbi" . variable-large-bold-italic) - ("metsi" . variable-large-italic) - ("cmr5" . variable) - ("cmr10" . variable) - ("cmr18" . variable) - ("cmold" . variable) - ("cmdunh" . variable) - ("hl10" . variable) - ("hl10b" . variable-bold) - ("hl12" . variable) - ("hl12b" . variable-bold) - ("hl12bi" . variable-bold-italic) - ("hl12i" . variable-italic) - ("hl6" . variable) - ("hl7" . variable) - ("tr10" . variable) - ("tr10b" . variable-bold) - ("tr10bi" . variable-bold-italic) - ("tr10i" . variable-italic) - ("tr12" . variable) - ("tr12b" . variable-bold) - ("tr12bi" . variable-bold-italic) - ("tr12i" . variable-italic) - ("tr18" . variable-large) - ("tr18b" . variable-large-bold) - ("tr8" . variable) - ("tr8b" . variable-bold) - ("tr8i" . variable-italic) - ("5x5" . small) - ("tiny" . small) - ("43vxms" . variable-large) - ("courier" . bold) - ("adobe-courier10" . default) - ("adobe-courier14" . bold) - ("adobe-courier10b" . bold) - ("adobe-courier14b" . bold) - ("adobe-hl12" . variable) - ("adobe-hl14" . variable) - ("adobe-hl14b" . variable-bold) - ) - "Alist of LISPM font names to Emacs face names.") - - -(defun lispm-font-to-face (lispm-font) - (if (symbolp lispm-font) - (setq lispm-font (symbol-name lispm-font))) - (let ((case-fold-search t) - face) - (setq lispm-font (downcase lispm-font)) - (if (string-match "^fonts:+" lispm-font) - (setq lispm-font (substring lispm-font (match-end 0)))) - (if (setq face (cdr (assoc lispm-font lispm-font-to-face))) - (if (find-face face) - face - (message "warning: unknown face %s" face) - 'default) - (message "warning: unknown Lispm font %s" (upcase lispm-font)) - 'default))) - -(defvar fonts) ; the -*- line of the file will set this. - -(defun lispm-fontify-hack-local-variables () - ;; Sometimes code has font-shifts in the -*- line, which means that the - ;; local variables will have been read incorrectly by the emacs-lisp reader. - ;; In particular, the `fonts' variable might be corrupted. So if there - ;; are font-shifts in the prop line, re-parse it. - (if (or (not (boundp 'fonts)) - (null 'fonts) - (let ((case-fold-search t)) - (and (looking-at "[ \t]*;.*-\\*-.*fonts[ \t]*:.*-\\*-") - (looking-at ".*\^F")))) - (save-excursion - (save-restriction - (end-of-line) - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (while (re-search-forward "\^F[0-9a-zA-Z*]" nil t) - (delete-region (match-beginning 0) (match-end 0))) - (let ((enable-local-variables 'query)) - (hack-local-variables)))))) - -(defun lispm-fontify-buffer () - (save-excursion - (goto-char (point-min)) - (if (fboundp 'font-lock-mode) (font-lock-mode 0)) - (lispm-fontify-hack-local-variables) - (let ((font-stack nil) - (p (point)) - c) - (while (search-forward "\^F" nil t) - (delete-char -1) - (setq c (following-char)) - (delete-char 1) - (cond ((= c ?\^F) - (insert "\^F")) - ((= c ?*) - (if (and font-stack (/= p (point))) - (set-extent-face (make-extent p (point)) (car font-stack))) - (setq p (point)) - (setq font-stack (cdr font-stack))) - ((or (< c ?0) (> c ?Z)) ; error... - nil) - ((>= (setq c (- c ?0)) (length fonts)) ; error... - nil) - (t - (if (and font-stack (/= p (point))) - (set-extent-face (make-extent p (point)) (car font-stack))) - (setq font-stack (cons (lispm-font-to-face (nth c fonts)) - font-stack)) - (setq p (point))))) - (if (and font-stack (/= p (point))) - (set-extent-face (make-extent p (point)) (car font-stack)))))) diff --git a/xemacs-packages/lisp/edit-utils/live-icon.el b/xemacs-packages/lisp/edit-utils/live-icon.el deleted file mode 100644 index 389209a2..00000000 --- a/xemacs-packages/lisp/edit-utils/live-icon.el +++ /dev/null @@ -1,328 +0,0 @@ -;; live-icon.el --- make frame icons represent the current frame contents - -;; Copyright (C) 1995 Rich Williams -;; Copyright (C) 1995 Jamie Zawinski - -;; Authors: Rich Williams -;; Jamie Zawinski - -;; Minor cleanups and conversion from obsolete functions by -;; Karl M. Hegbloom - -;; Version 1.3 - - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not in FSF. - -;; Generates little pixmaps representing the contents of your frames. - -(defun live-icon-alloc-colour (cmv colour) - "Allocate a colour and a char from the magic vector" - (let ((bob (assoc colour (aref cmv 0))) - (jim (aref cmv 2))) - (if bob - (cdr bob) - (aset cmv 0 (cons (cons colour jim) (aref cmv 0))) - (aset cmv 1 (1+ (aref cmv 1))) - (aset cmv 2 (1+ jim)) - jim))) - -(defun live-icon-from-frame (&optional frame) - "Calculates the live-icon XPM of FRAME." - (if (not frame) - (setq frame (selected-frame))) - (save-excursion - (select-frame frame) - (let* ((w (frame-width)) - (h (frame-height)) - (pix (make-vector h nil)) - (ny 0) - (cmv (vector nil 0 ?A)) - (d (live-icon-alloc-colour - cmv (color-name (face-background 'default)))) - (m (live-icon-alloc-colour - cmv (color-name (face-background 'modeline)))) - (x (live-icon-alloc-colour - cmv (color-name (face-foreground 'default)))) - y) - (let ((loop 0)) - (while (< loop h) - (aset pix loop (make-string w d)) - (setq loop (1+ loop)))) - (mapcar #'(lambda (win) - (save-excursion - (save-window-excursion - (select-window win) - (save-restriction - (setq y ny - ny (+ ny (1- (window-height)))) - (aset pix (- ny 2) (make-string w m)) - (widen) - (if (> (window-end) (window-start)) - (narrow-to-region (window-start) - (1- (window-end)))) - (goto-char (point-min)) - (while (and (not (eobp)) - (< y (1- ny))) - (while (and (not (eolp)) - (< (current-column) w)) - (if (> (char-after (point)) 32) - (let* ((ex (extent-at (point) (current-buffer) 'face)) - (f (if ex (let ((f (extent-face ex))) - (if (not (consp f)) - f - (car f))))) - (z (if f (color-name (face-foreground f)))) - (c (if z (live-icon-alloc-colour cmv z) x))) - (aset (aref pix y) (current-column) c))) - (forward-char 1)) - (setq y (1+ y)) - (forward-line 1)))))) - (sort (if (fboundp 'window-list) - (window-list) - (let* ((w (frame-root-window)) - (ws nil)) - (while (not (memq (setq w (next-window w)) ws)) - (setq ws (cons w ws))) - ws)) - #'(lambda (won woo) - (< (nth 1 (window-pixel-edges won)) - (nth 1 (window-pixel-edges woo)))))) - (concat "/* XPM */\nstatic char icon[] = {\n" - (format "\"%d %d %d 1\",\n" w (* h 2) (aref cmv 1)) - (mapconcat #'(lambda (colour-entry) - (format "\"%c c %s\"" - (cdr colour-entry) - (car colour-entry))) - (aref cmv 0) - ",\n") - ",\n" - (mapconcat #'(lambda (scan-line) - (concat "\"" scan-line "\"," "\n" - "\"" (make-string w d) "\"," - )) - pix - ",\n") - "};\n")))) - -(defun live-icon-one-frame (&optional frame) - "Gives FRAME (defaulting to (selected-frame)) a live icon." - (interactive) - (unless frame - (setq frame (selected-frame))) - (unless (frame-property frame 'balloon-help) - (set-glyph-image frame-icon-glyph (live-icon-from-frame frame) frame))) - -;;(defun live-icon-all-frames () -;; "Gives all your frames live-icons." -;; (interactive) -;; (mapcar #'(lambda (fr) -;; (set-glyph-image frame-icon-glyph -;; (live-icon-from-frame fr) -;; fr)) -;; (frame-list))) - -(add-hook 'unmap-frame-hook 'live-icon-one-frame) -;;(start-itimer "live-icon" 'live-icon-all-frames 120 120) - -(provide 'live-icon) -;;; live-icon.el ends here - - - -;;;; Spare parts and leftovers department: - -;; #### This thing is somewhat of a mess and could stand some clean-up. - -;;(defun live-icon-colour-name-from-face (face &optional bg-p) -;; "Do backward compatible things to faces and colours" -;; (if (and (boundp 'emacs-major-version) -;; (or (> emacs-major-version 19) -;; (and (= emacs-major-version 19) -;; (>= emacs-minor-version 12)))) -;; (let* ((face (if (consp face) (car face) face)) -;; (colour (if bg-p -;; (face-background face) -;; (face-foreground face)))) -;; (if (consp colour) -;; (setq colour (cdr (car colour)))) -;; (if (color-instance-p colour) -;; (setq colour (color-instance-name colour))) -;; (if (specifierp colour) -;; (setq colour (color-name colour))) -;; (if colour -;; (let ((hack (format "%s" colour))) -;; (if (string-match "(?\\([^)]*\\))?" hack) -;; (substring hack (match-beginning 1) (match-end 1)) -;; hack)))) -;; (let ((p (if bg-p (face-background face) (face-foreground face)))) -;; (and (pixelp p) -;; ;; ** The following functions are not known to be defined: pixelp -;; (pixel-name p))))) -;;;; ** pixel-name is an obsolete function; use color-name instead. - -;;(defun live-icon-start-ppm-stuff (&optional frame) -;; "Start a live icon conversion going" -;; (interactive) -;; (if (not frame) -;; (setq frame (selected-frame))) -;; (let ((buf (get-buffer-create " *live-icon*"))) -;; (message "live-icon...(backgrounding)") -;; (save-excursion -;; (set-buffer buf) -;; (erase-buffer)) -;; (set-process-sentinel -;; (start-process-shell-command "live-icon" -;; buf -;; "xwd" -;; "-id" (format "%s" (x-window-id frame)) "|" -;; "xwdtopnm" "|" -;; "pnmscale" "-xysize" "64" "64" "|" -;; "ppmquant" "256" "|" -;; "ppmtoxpm") -;; #'(lambda (p s) -;; (message "live-icon...(munching)") -;; (save-excursion -;; (set-buffer " *live-icon*") -;; (goto-char (point-min)) -;; (search-forward "/* XPM */") -;; (set-glyph-image frame-icon-glyph -;; (buffer-substring (match-beginning 0) (point-max)) -;; frame)) -;; (message "live-icon...... done")))) -;; nil) - -;;(defun live-icon-goto-position (x y) -;; (let (window edges) -;; (catch 'done -;; (walk-windows -;; #'(lambda (w) -;; (setq edges (window-edges w)) -;; (if (and (>= x (nth 0 edges)) -;; (<= x (nth 2 edges)) -;; (>= y (nth 1 edges)) -;; (<= y (nth 3 edges))) -;; (throw 'done (setq window w)))) -;; nil t)) -;; (if (not window) -;; nil -;; (select-window window) -;; (move-to-window-line (- y (nth 1 edges))) -;; (move-to-column (- x (nth 0 edges))) -;; ))) - -;;(defun live-icon-make-image (width height) -;; (let* ((text-aspect 1.5) -;; (xscale (/ (/ (* (frame-width) 1.0) width) text-aspect)) -;; (yscale (/ (* (frame-height) 1.0) height)) -;; (x 0) -;; (y 0) -;; (cmv (vector nil 0 ?A)) -;; (default-fg (live-icon-alloc-colour -;; cmv (color-name (face-foreground 'default)))) -;; (default-bg (live-icon-alloc-colour -;; cmv (color-name (face-background 'default)))) -;; (modeline-bg (live-icon-alloc-colour -;; cmv (color-name (face-background 'modeline)))) -;; (lines (make-vector height nil))) -;; ;; -;; ;; Put in the text. -;; ;; -;; (save-excursion -;; (save-window-excursion -;; (while (< y height) -;; (aset lines y (make-string width default-bg)) -;; (setq x 0) -;; (while (< x width) -;; (let ((sx (floor (* x xscale))) -;; (sy (floor (* y yscale)))) -;; (live-icon-goto-position sx sy) -;; (let* ((extent (extent-at (point) (current-buffer) 'face)) -;; (face (if extent (extent-face extent))) -;; (name (if face (live-icon-colour-name-from-face -;; face (<= (char-after (point)) 32)))) -;; (color (if name -;; (live-icon-alloc-colour cmv name) -;; (if (<= (or (char-after (point)) 0) 32) -;; default-bg default-fg)))) -;; (aset (aref lines y) x color))) -;; (setq x (1+ x))) -;; (setq y (1+ y))))) -;; ;; -;; ;; Now put in the modelines. -;; ;; -;; (let (sx sy) -;; (walk-windows -;; #'(lambda (w) -;; (let ((edges (window-edges w))) -;; (setq x (nth 0 edges) -;; y (nth 3 edges) -;; sx (floor (/ x xscale)) -;; sy (floor (/ y yscale))) -;; (while (and (< x (1- (nth 2 edges))) -;; (< sx (length (aref lines 0)))) -;; (aset (aref lines sy) sx modeline-bg) -;; (if (> sy 0) -;; (aset (aref lines (1- sy)) sx modeline-bg)) -;; (setq x (1+ x) -;; sx (floor (/ x xscale)))) -;; (if (>= sx (length (aref lines 0))) -;; (setq sx (1- sx))) -;; (while (>= y (nth 1 edges)) -;; (aset (aref lines sy) sx modeline-bg) -;; (setq y (1- y) -;; sy (floor (/ y yscale)))))) -;; nil nil)) -;; ;; -;; ;; Now put in the top and left edges -;; ;; -;; (setq x 0) -;; (while (< x width) -;; (aset (aref lines 0) x modeline-bg) -;; (setq x (1+ x))) -;; (setq y 0) -;; (while (< y height) -;; (aset (aref lines y) 0 modeline-bg) -;; (setq y (1+ y))) -;; ;; -;; ;; Now make the XPM -;; ;; -;; (concat "/* XPM */\nstatic char icon[] = {\n" -;; (format "\"%d %d %d 1\",\n" -;; width -;;;; (* height 2) -;; height -;; (aref cmv 1)) -;; (mapconcat #'(lambda (colour-entry) -;; (format "\"%c c %s\"" -;; (cdr colour-entry) -;; (car colour-entry))) -;; (aref cmv 0) -;; ",\n") -;; ",\n" -;; (mapconcat #'(lambda (scan-line) -;; (concat "\"" scan-line "\"," "\n" -;;;; "\"" scan-line "\"" -;;;; "\"" (make-string width default-bg) -;;;; "\"," -;; )) -;; lines -;; ",\n") -;; "};\n"))) diff --git a/xemacs-packages/lisp/edit-utils/makesum.el b/xemacs-packages/lisp/edit-utils/makesum.el deleted file mode 100644 index d5f2dfe3..00000000 --- a/xemacs-packages/lisp/edit-utils/makesum.el +++ /dev/null @@ -1,125 +0,0 @@ -;;; makesum.el --- generate key binding summary for Emacs - -;; Copyright (C) 1985 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: help - -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: FSF 20.5. - -;;; Commentary: - -;; Displays a nice human-readable summary of all keybindings in a -;; two-column format. - -;;; Code: - -;;;###autoload -(defun make-command-summary () - "Make a summary of current key bindings in the buffer *Summary*. -Previous contents of that buffer are killed first." - (interactive) - (let (help-buffer) - (message "Making command summary...") - ;; This puts a description of bindings in a buffer called *Help*. - (save-window-excursion - (setq help-buffer (describe-bindings))) - (with-displaying-help-buffer - (lambda () - (save-excursion - (let ((cur-mode mode-name)) - (set-buffer standard-output) - (erase-buffer) - (insert-buffer-substring help-buffer) - (goto-char (point-min)) - (delete-region (point) (progn (forward-line 1) (point))) - (while (search-forward " " nil t) - (replace-match " ")) - (goto-char (point-min)) - (while (search-forward "-@ " nil t) - (replace-match "-SP")) - (goto-char (point-min)) - (while (search-forward " .. ~ " nil t) - (replace-match "SP .. ~")) - (goto-char (point-min)) - (while (search-forward "C-?" nil t) - (replace-match "DEL")) - (goto-char (point-min)) - (while (search-forward "C-i" nil t) - (replace-match "TAB")) - (goto-char (point-min)) - (if (re-search-forward "^Local Bindings:" nil t) - (progn - (forward-char -1) - (insert " for " cur-mode " Mode") - (while (search-forward "??\n" nil t) - (delete-region (point) - (progn - (forward-line -1) - (point)))))) - (goto-char (point-min)) - (insert - (cond ((featurep 'infodock) "InfoDock") - ((featurep 'xemacs) "XEmacs") - (t "Emacs"))) - (insert " command summary, " (substring (current-time-string) 0 10) - ".\n") - ;; Delete "key binding" and underlining of dashes. - (delete-region (point) (progn (forward-line 2) (point))) - (forward-line 1) ;Skip blank line - (while (not (eobp)) - (let ((beg (point))) - (or (re-search-forward "^$" nil t) - (goto-char (point-max))) - (double-column beg (point)) - (forward-line 1))) - (goto-char (point-min)))) - (message "Making command summary...done")) - "Command Summary"))) - -(defun double-column (start end) - (interactive "r") - (let (half line lines nlines - (from-end (- (point-max) end))) - (setq nlines (count-lines start end)) - (if (<= nlines 1) - nil - (setq half (/ (1+ nlines) 2)) - (goto-char start) - (save-excursion - (forward-line half) - (while (< half nlines) - (setq half (1+ half)) - (setq line (buffer-substring (point) (save-excursion (end-of-line) (point)))) - (setq lines (cons line lines)) - (delete-region (point) (progn (forward-line 1) (point))))) - (setq lines (nreverse lines)) - (while lines - (end-of-line) - ;; XEmacs change - (indent-to 41 1) - (insert (car lines)) - (forward-line 1) - (setq lines (cdr lines)))) - (goto-char (- (point-max) from-end)))) - -(provide 'makesum) - -;;; makesum.el ends here diff --git a/xemacs-packages/lisp/edit-utils/man.el b/xemacs-packages/lisp/edit-utils/man.el deleted file mode 100644 index 29eb012f..00000000 --- a/xemacs-packages/lisp/edit-utils/man.el +++ /dev/null @@ -1,761 +0,0 @@ -;;; man.el --- browse UNIX manual pages -;; Keywords: help - -;; Copyright (C) 1985, 1993, 1994, 1996, 1997 Free Software Foundation, Inc. -;; -;; This file is part of XEmacs. - -;; XEmacs 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. - -;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;; This file defines "manual-entry", and the remaining definitions all -;; begin with "Manual-". This makes the autocompletion on "M-x man" work. -;; -;; Eviscerated 26-Jun-96 by Jamie Zawinski . -;; All that stuff about looking at $MANPATH and building up lists of -;; directories was bullshit. Now we just invoke "man" and format the -;; output, end of story. -;; -;; [ older changelog entries removed, since they're all about code that -;; I've deleted. ] - -(defgroup man nil - "Browse Unix manual pages" - :group 'help) - -(defcustom Manual-program "man" "\ -*Name of the program to invoke in order to format the source man pages." - :type 'string - :group 'man) - -(defcustom Manual-buffer-view-mode t "\ -*Whether manual buffers should be placed in view-mode. -nil means leave the buffer in fundamental-mode in another window. -t means use `view-buffer' to display the man page in the current window. -Any other value means use `view-buffer-other-window'." - :type '(radio (const :tag "Fundamental-mode other window" nil) - (const :tag "View-mode current window" t) - (sexp :format "%t\n" :tag "View-mode other window" other)) - :group 'man) - -(defcustom Manual-switches nil - "List of switches to the man program." - :type '(choice (list (string :tag "switches")) - (const :tag "none" nil)) - :group 'man) - -(defcustom Manual-mode-hook nil - "Function or functions run on entry to Manual-mode." - :type 'hook - :group 'man) - -(defvar Manual-page-history nil "\ -A list of names of previously visited man page buffers.") - -(defvar Manual-page-minibuffer-history nil "\ -Minibuffer completion history for `manual-entry'.") - -;; New variables. - -(defcustom Manual-snip-subchapter - (not (string-match "solaris" system-configuration)) - "*Should man look in chapter 3 for ctime(3c)? -This is relevant for Solaris and, perhaps, other systems which have -`man -s 3' not find things in chapter 3c, or other such sub-chapters" - :type 'boolean - :group 'man) - -;;Here is information on RosettaMan, from Neal.Becker@comsat.com (Neal Becker): - -;;RosettaMan is a filter for UNIX manual pages. It takes as input man -;;pages formatted for a variety of UNIX flavors (not [tn]roff source) -;;and produces as output a variety of file formats. Currently -;;RosettaMan accepts man pages as formatted by the following flavors of -;;UNIX: Hewlett-Packard HP-UX, AT&T System V, SunOS, Sun Solaris, OSF/1, -;;DEC Ultrix, SGI IRIX, Linux, SCO; and produces output for the following -;;formats: printable ASCII only (stripping page headers and footers), -;;section and subsection headers only, TkMan, [tn]roff, Ensemble, RTF, -;;SGML (soon--I finally found a DTD), HTML, MIME, LaTeX, LaTeX 2e, Perl 5's pod. - -;;RosettaMan improves on other man page filters in several ways: (1) its -;;analysis recognizes the structural pieces of man pages, enabling high -;;quality output, (2) its modular structure permits easy augmentation of -;;output formats, (3) it accepts man pages formatted with the varient -;;macros of many different flavors of UNIX, and (4) it doesn't require -;;modification or cooperation with any other program. - -;;RosettaMan is a rewrite of TkMan's man page filter, called bs2tk. (If -;;you haven't heard about TkMan, a hypertext man page browser, you -;;should grab it via anonymous ftp from ftp.cs.berkeley.edu: -;;/ucb/people/phelps/tkman.tar.Z.) Whereas bs2tk generated output only for -;;TkMan, RosettaMan generalizes the process so that the analysis can be -;;leveraged to new output formats. A single analysis engine recognizes -;;section heads, subsection heads, body text, lists, references to other -;;man pages, boldface, italics, bold italics, special characters (like -;;bullets), tables (to a degree) and strips out page headers and -;;footers. The engine sends signals to the selected output functions so -;;that an enhancement in the engine improves the quality of output of -;;all of them. Output format functions are easy to add, and thus far -;;average about about 75 lines of C code each. - - - -;;*** NOTES ON CURRENT VERSION *** - -;;Help! I'm looking for people to help with the following projects. -;;\(1) Better RTF output format. The current one works, but could be -;;made better. (2) Roff macros that produce text that is easily -;;parsable. RosettaMan handles a great variety, but some things, like -;;H-P's tables, are intractable. If you write an output format or -;;otherwise improve RosettaMan, please send in your code so that I may -;;share the wealth in future releases. - -;;This version can try to identify tables (turn this on with the -T -;;switch) by looking for lines with a large amount of interword spacing, -;;reasoning that this is space between columns of a table. This -;;heuristic doesn't always work and sometimes misidentifies ordinary -;;text as tables. In general I think it is impossible to perfectly -;;identify tables from nroff formatted text. However, I do think the -;;heuristics can be tuned, so if you have a collection of manual pages -;;with unrecognized tables, send me the lot, in formatted form (i.e., -;;after formatting with nroff -man), and uuencode them to preserve the -;;control characters. Better, if you can think of heuristics that -;;distinguish tables from ordinary text, I'd like to hear them. - -;;Notes for HTML consumers: This filter does real (heuristic) -;;parsing--no 
!  Man page references are turned into hypertext links.
-
-(defcustom Manual-use-rosetta-man (locate-file "rman" exec-path)
-  "If non-nil, use RosettaMan (rman) to filter man pages.
-This makes man-page cleanup virtually instantaneous, instead of
-potentially taking a long time."
-  :type '(choice (symbol :tag "Do not use Rosettaman" nil)
-                 (file   :tag "RosettaMan Programm"))
-  :group 'man)
-
-(defface man-italic '((t (:italic t)))
-  "Manual italics face"
-  :group 'man)
-
-(defface man-bold '((t (:bold t)))
-  "Manual bold face"
-  :group 'man)
-
-(defface man-heading '((t (:bold t)))
-  "Manual headings face"
-  :group 'man)
-
-(defface man-xref '((t (:underline t)))
-  "Manual xrefs face"
-  :group 'man)
-
-
-(defvar Manual-mode-map
-  (let ((m (make-sparse-keymap)))
-    (set-keymap-name m 'Manual-mode-map)
-    (define-key m "l" 'Manual-last-page)
-    (define-key m 'button2 'Manual-follow-xref)
-    (define-key m 'button3 'Manual-popup-menu)
-    m))
-
-(defvar Manual-mode-syntax-table nil
-  "Syntax table used in Manual-mode buffers")
-(if Manual-mode-syntax-table
-    ()
-  (setq Manual-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?: "_" Manual-mode-syntax-table)
-  (modify-syntax-entry ?+ "." Manual-mode-syntax-table)
-  (modify-syntax-entry ?- "." Manual-mode-syntax-table)
-  (modify-syntax-entry ?/ "." Manual-mode-syntax-table)
-  (modify-syntax-entry ?* "." Manual-mode-syntax-table)
-  )
-
-;;;###autoload
-(defun manual-entry (topic &optional arg silent)
-  "Display the Unix manual entry (or entries) for TOPIC.
-If TOPIC starts with -k, then a system apropos search is performed
-using man -k for TOPIC."
-  (interactive
-   (list (let* ((default (save-excursion
-			   (buffer-substring
-			    (progn
-                              (if (not (eobp))
-                                  (forward-char))
-                              (if (re-search-backward "\\sw\\|\\s_" nil t)
-                                  (forward-char))
-                              (re-search-backward
-                               "\\(\\sw\\|\\s_\\)([0-9]+[A-Za-z]*\\="
-			       (point-at-bol) t)
-                              (skip-syntax-backward "w_")
-                              (point))
-			    (progn
-                              (skip-syntax-forward "w_")
-                              (re-search-forward "\\=([0-9]+[A-Za-z]*)" nil t)
-                              (point) ))))
-		(thing (read-string
-			(if (equal default "") "Manual entry: "
-			  (concat "Manual entry: (default " default ") "))
-			nil 'Manual-page-minibuffer-history)))
-	   (if (equal thing "") default thing))
-	 (prefix-numeric-value current-prefix-arg)))
-  (let (buffer)
-    (or arg (setq arg 1))
-    ;; Allow leading chapter numbers
-    (if (string-match "\\([1-9n][a-zA-Z0-9]*\\) \\(.*\\)" topic)
-	(setq topic (replace-match "\\2(\\1)" t nil topic))
-      )
-    (let (section apropos-mode)
-      (let ((case-fold-search nil))
-	(if (and (null section)
-		 (string-match
-		  "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'"
-		  topic))
-	    (setq section (match-string 2 topic)
-		  topic (match-string 1 topic))
-	  (if (string-match "\\`[ \t]*-k[ \t]+\\([^ \t]+\\)\\'" topic)
-	      (setq section "-k"
-		    topic (substring topic (match-beginning 1))))))
-
-      (when Manual-snip-subchapter
-	;; jwz: turn section "3x11" and "3n" into "3".
-	(if (and section (string-match "\\`\\([0-9]+\\)[^0-9]" section))
-	    (setq section (match-string 1 section))))
-
-      (if (or (equal section "-k") (member "-k" Manual-switches))
-	  (setq apropos-mode t))
-
-      (let ((bufname (concat "Man"
-			     (when apropos-mode " apropos")
-			     ": " topic
-			     (when section (concat "(" section ")"))))
-	    (temp-buffer-show-function
-	     (cond ((eq 't Manual-buffer-view-mode)
-		    'view-buffer)
-		   ((eq 'nil Manual-buffer-view-mode)
-		    temp-buffer-show-function)
-		   (t
-		    'view-buffer-other-window))))
-
-	(cond ((get-buffer bufname)
-	       ;; reselect an old man page buffer if it exists already.
-	       (save-excursion
-		 (set-buffer (get-buffer bufname))
-		 (Manual-mode)
-		 (setq buffer (current-buffer)))
-	       (if temp-buffer-show-function
-		   (funcall temp-buffer-show-function (get-buffer bufname))
-		 (display-buffer bufname)))
-	      (t
-	       (with-output-to-temp-buffer bufname
-		 (buffer-disable-undo standard-output)
-		 (save-excursion
-		   (set-buffer standard-output)
-		   (setq buffer-read-only nil)
-		   (erase-buffer)
-
-		   (let ((args (append Manual-switches (list topic)))
-			 args-string)
-		     (if section
-			 (setq args
-			       (if (and (eq system-type 'usg-unix-v)
-					(null apropos-mode))
-				   (cons "-s" (cons section args))
-				 (cons section args))))
-		     (setq args-string
-			   (mapconcat 'identity
-				      (cons Manual-program args) " "))
-		     (if (string-match "\\`\\([^ \t/]*/\\)+" args-string)
-			 (setq args-string
-			       (substring args-string (match-end 0))))
-
-		     (message "%s (running...)" args-string)
-		     (apply 'call-process Manual-program nil '(t nil) nil args)
-
-		     (if (< (buffer-size) (if apropos-mode 20 200))
-			 (progn
-			   (kill-buffer (current-buffer))
-			   (error "%s not found" args-string)))
-
-		     (message "%s (cleaning...)" args-string)
-		     (Manual-nuke-nroff-bs apropos-mode)
-		     (message "%s (done.)" args-string))
-		   (set-buffer-modified-p nil)
-		   (Manual-mode)
-		   (setq buffer (current-buffer))))))
-	(let ((page (if section
-			(concat topic "(" section ")")
-		      topic)))
-	  (setq Manual-page-history
-		(cons (buffer-name)
-		      (delete (buffer-name) Manual-page-history))
-		Manual-page-minibuffer-history
-		(cons page (delete page Manual-page-minibuffer-history))))))
-
-    (message nil)
-  buffer))
-
-;;;###autoload
-(define-key help-map "\C-m" 'manual-entry)
-
-(defun Manual-mode ()
-  (kill-all-local-variables)
-  (setq buffer-read-only t)
-  (use-local-map Manual-mode-map)
-  (set-syntax-table Manual-mode-syntax-table)
-  (setq major-mode 'Manual-mode
-	mode-name "Manual")
-  ;; man pages with long lines are buggy!
-  ;; This looks slightly better if they only
-  ;; overran by a couple of chars.
-  (setq truncate-lines t)
-  ;; turn off horizontal scrollbars in this buffer
-  (when (featurep 'scrollbar)
-    (set-specifier scrollbar-height (cons (current-buffer) 0)))
-  (make-local-hook 'kill-buffer-hook)
-  (add-hook 'kill-buffer-hook #'(lambda ()
-				  (setq Manual-page-history
-					(delete (buffer-name)
-						Manual-page-history)))
-	    nil t)
-  (run-hooks 'Manual-mode-hook))
-
-(defun Manual-last-page ()
-  (interactive)
-  (if Manual-page-history
-      (let ((page (pop Manual-page-history)))
-	(if page
-	    (progn
-	      (get-buffer page)
-	      (cons Manual-page-history page)
-	      (switch-to-buffer page))))
-    (error "No manual page buffers found. Use `M-x manual-entry'")))
-
-
-(defmacro Manual-delete-char (n)
-  ;; in v19, delete-char is compiled as a function call, but delete-region
-  ;; is byte-coded, so it's much faster.  (We were spending 40% of our time
-  ;; in delete-char alone.)
-  `(delete-region (point) (+ (point) ,n)))
-
-;; Hint: BS stands for more things than "back space"
-;;;###autoload
-(defun Manual-nuke-nroff-bs (&optional apropos-mode)
-  (interactive "*")
-  (if (and Manual-use-rosetta-man (not apropos-mode))
-      (call-process-region (point-min) (point-max)
-                           Manual-use-rosetta-man t t nil)
-    ;;
-    ;; turn underlining into italics
-    ;;
-    (goto-char (point-min))
-    (while (search-forward "_\b" nil t)
-      ;; searching for underscore-backspace and then comparing the
-      ;; following chars until the sequence ends turns out to be much
-      ;; faster than searching for a regexp which matches the whole
-      ;; sequence.
-      (let ((s (match-beginning 0)))
-	(goto-char s)
-	(while (and (eq (char-after) ?_)
-		    (eq (char-after (1+ (point))) ?\b))
-	  (Manual-delete-char 2)
-	  (forward-char 1))
-	;; The sequence _\b_ is ambiguous - it could be either
-	;; underlining or overstriking.  We resolve the ambiguity as
-	;; follows: if we appear to be creating a one-character extent
-	;; containing only an underscore, we guess that this is
-	;; actually a case of overstriking.  Even if we guess wrong,
-	;; e.g. if the man page contained \fI_\fP, we'll merely end up
-	;; using the wrong face (man-bold instead of man-italic).
-	(if (and (= (1+ s) (point))
-		 (eq (char-before) ?_))
-	    (progn (backward-char) (insert ?_ ?\b)) ; undo
-	  (set-extent-face (make-extent s (point)) 'man-italic))))
-    ;;
-    ;; turn overstriking into bold
-    ;;
-    (goto-char (point-min))
-    (while (search-forward "\b" nil t)
-      (when (eq (char-after) (char-after (- (point) 2)))
-	(backward-char 2)
-	(let ((start (point)))
-	  (while (and (eq (char-after (1+ (point))) ?\b)
-		      (eq (char-after) (char-after (+ (point) 2))))
-	    (let ((c (char-after)))
-	      (forward-char)
-	      ;; Some systems (SGI) overstrike multiple times, eg, "M\bM\bM\bM".
-	      (while (and (eq (char-after ) ?\b)
-			  (eq (char-after (1+ (point))) c))
-		(delete-region (point) (+ 2 (point))))))
-	  (set-extent-face (make-extent start (point)) 'man-bold))))
-
-    ;; Kludge to deal with Japanese nroff formatted man pages.
-    ;; Usually width of Japanese characters is the same as two ASCII
-    ;; characters on a tty.  Therefore, nroff uses two \b.
-    ;; We guess that the sequence c\b\bc is an attempt at overstriking.
-    (goto-char (point-min))
-    (while (search-forward "\b\b" nil t)
-      (backward-char 3)
-      (while (and (eq (char-after (point)) (char-after (+ 3 (point))))
-		  (eq (char-after (+ 1 (point))) ?\b)
-		  (eq (char-after (+ 2 (point))) ?\b))
-	(delete-region (point) (+ (point) 3)))
-      (set-extent-face (make-extent (1- (point)) (point)) 'man-bold))
-
-    ;;
-    ;; hack bullets: o^H+ --> +
-    (goto-char (point-min))
-    (while (search-forward "\b" nil t)
-      (Manual-delete-char -2))
-
-    (Manual-nuke-nroff-bs-footers)
-    ) ;; not Manual-use-rosetta-man
-  ;;
-  ;; turn subsection header lines into bold
-  ;;
-  (goto-char (point-min))
-  (if apropos-mode
-      (while (re-search-forward "[a-zA-Z0-9] ([0-9]" nil t)
-	(forward-char -2)
-	(delete-backward-char 1))
-
-    ;;    (while (re-search-forward "^[^ \t\n]" nil t)
-    ;;      (set-extent-face (make-extent (match-beginning 0)
-    ;;                                   (progn (end-of-line) (point)))
-    ;;                      'man-heading))
-
-    ;; boldface the first line
-    (if (looking-at "[^ \t\n].*$")
-	(set-extent-face (make-extent (match-beginning 0) (match-end 0))
-			 'man-bold))
-
-    ;; boldface subsequent title lines
-    ;; Regexp to match section headers changed to match a non-indented
-    ;; line preceded by a blank line and followed by an indented line.
-    ;; This seems to work ok for manual pages but gives better results
-    ;; with other nroff'd files
-    ;;
-    ;; Most systems have indented text the next line after a section
-    ;; header, but some (Tru64) have an extra newline in between.
-    (while (re-search-forward "\n\n\\([^ \t\n].*\\)\n\n?[ \t]+[^ \t\n]" nil t)
-      (goto-char (match-end 1))
-      ;; section headings are often highlighted by the man page
-      ;; author, but other parts of the man page are highlighted the
-      ;; same way, so make our lisp-deduced section header
-      ;; highlighting higher priority.  This also avoids having
-      ;; section headers being _random_ly highlighted alternately by
-      ;; either man-heading or man-bold, which sure looks like a bug.
-      ;; And for user interface issues, if it looks like a bug, it
-      ;; _is_ a bug.
-      (set-extent-properties (make-extent (match-beginning 1) (match-end 1))
-		       '(face man-heading priority 1))
-      (forward-line 1))
-    )
-
-  (if Manual-use-rosetta-man
-      nil
-    ;; Zap ESC7,  ESC8, and ESC9
-    ;; This is for Sun man pages like "man 1 csh"
-    (goto-char (point-min))
-    (while (re-search-forward "\e[789]" nil t)
-      (replace-match "")))
-
-  (Manual-mouseify-xrefs apropos-mode)
-  )
-
-;;;###autoload
-(defalias 'nuke-nroff-bs 'Manual-nuke-nroff-bs) ; use old name
-
-
-(defun Manual-nuke-nroff-bs-footers ()
-  "For info see comments in packages/man.el"
-  ;; Autodetect and nuke headers and footers in nroff output.
-
-  (goto-char (point-min))
-
-  ;; first lose the status output
-  (let ((case-fold-search t))
-    (if (and (not (looking-at "[^\n]*warning"))
-	     (looking-at "Reformatting.*\n"))
-	(delete-region (match-beginning 0) (match-end 0))))
-
-  ;; kludge around a groff bug where it won't keep quiet about some
-  ;; warnings even with -Wall or -Ww.
-  (cond ((looking-at "grotty:")
-	 (while (looking-at "grotty:")
-	   (delete-region (point) (progn (forward-line 1) (point))))
-	 (if (looking-at " *done\n")
-	     (delete-region (point) (match-end 0)))))
-
-  ;; Some implementations of man use nroff to produce "paginated"
-  ;; output with a page size of 66 lines, of which several are devoted
-  ;; to the header and footer.  Each header and footer consists of 3
-  ;; newlines, one informational line, and either 3 additional
-  ;; newlines in the case of Solaris nroff, or 2 additional newlines
-  ;; in the case of groff.
-  ;;
-  ;; Of course, pagination is an incredibly stupid idea for online
-  ;; information presentation instead of printing to real paper, and
-  ;; so some system vendors have chosen to improve on traditional
-  ;; behavior by providing non-paginated output. We conservatively
-  ;; autodetect whether the output is in fact paginated.  Misdetection
-  ;; is still possible, but highly unlikely.  For starters, the output
-  ;; from man must accidentally be a multiple of 66 lines.
-  ;;
-  ;; Note that if nroff spits out error messages, pages will be more
-  ;; than 66 lines high, and we'll misdetect page starts.  That's ok
-  ;; because standard nroff doesn't do any diagnostics, and the
-  ;; "gnroff" wrapper for groff turns off error messages for
-  ;; compatibility.  (At least, it's supposed to.)
-  (block nuke-headers-and-footers
-    (let* ((page-starts '())
-	   (solaris-pagination		; 66 - 2 * (3 + 1 + 3) = 52
-	    "\\(\n\n\n[^\n]+\n\n\n\n\\)\\([^\n]*\n\\)\\{52\\}\\(\n\n\n[^\n]+\n\n\n\n\\)")
-	   (groff-pagination		; 66 - 2 * (3 + 1 + 2) = 54
-	    "\\(\n\n\n[^\n]+\n\n\n\\)\\([^\n]*\n\\)\\{54\\}\\(\n\n\n[^\n]+\n\n\n\\)")
-	   (pagination solaris-pagination))
-      ;; First pass.
-      ;; Collect the page start markers in reverse order.
-      ;; It's easiest to delete backwards starting from the end of the buffer.
-      ;; `page-starts' conveniently ends up in the desired reversed order.
-      ;; Verify that each header and footer looks like "\n\n\n[^\n]+\n\n\n\n?".
-      (while (not (eobp))
-	(when (not (looking-at pagination))
-	  (setq pagination groff-pagination)
-	  (when (not (looking-at pagination))
-	    (return-from nuke-headers-and-footers)))
-	(push (point-marker) page-starts)
-	(goto-char (match-end 0)))
-
-      ;; Second pass.
-      ;; Delete all the headers and footers, except for the first and last one,
-      ;; since they do actually contain some useful information.
-      (dolist (page-start page-starts)
-	(goto-char page-start)
-	(looking-at pagination)		; guaranteed to match, by first pass.
-
-	;; Delete footers, except merely trim whitespace from the last one.
-	(if (= (match-end 0) (point-max))
-	    (progn
-	      ;; last footer
-	      ;; Leave exactly two newlines before last footer.
-	      (goto-char (match-beginning 3))
-	      (skip-chars-backward "\n")
-	      (forward-char 2)
-	      (delete-region (point) (save-excursion
-				       (skip-chars-forward "\n")
-				       (point))))
-	  (progn
-	    ;; footer with adjoining header
-	    (goto-char (match-beginning 3))
-	    (delete-region (point) (match-end 3)) ; nuke footer
-	    ;; Note: next page's header is already nuked, because
-	    ;; we're processing the buffer backwards.
-	    (save-match-data
-	      (skip-chars-backward "\n")
-	      (cond
-	       ;; Compress multiple newlines where page breaks used to be.
-	       ;; These happen if the man page has a "keep" that
-	       ;; cannot spill over a page break, like a table.
-	       ;; We simply compress multiple newlines to one.
-	       ((looking-at "\n\n\n+")
-		(delete-region (+ 2 (match-beginning 0)) (match-end 0)))
-	       ;; There is no way to tell whether the page separator
-	       ;; we've removed is a logical paragraph separator, so we
-	       ;; guess with a simple heuristic that gets the newlines
-	       ;; correct most of the time.  Section headers and option
-	       ;; descriptions get a newline separator added.
-	       ((looking-at "\n\\([^ \t\n]\\|[ \t]+-\\)")
-		(insert ?\n))))))
-
-	;; Delete headers, except merely trim whitespace from the first one.
-	(if (= page-start (point-min))
-	    ;; Leave exactly two newlines between first header and body.
-	    (delete-region (match-end 1)
-			   (save-excursion (goto-char (match-end 1))
-					   (skip-chars-backward "\n")
-					   (+ 2 (point))))
-	  ;; Completely nuke non-initial headers
-	  (delete-region (match-beginning 1) (match-end 1)))
-
-	(set-marker page-start nil))))	; block nuke-headers-and-footers
-
-  ;; Delete newlines at beginning and end of buffer, whether or not
-  ;; man is feeding us 66-line paginated output.
-  ;; Tru64 is particularly generous with trailing newlines.
-  ;;
-  ;; Leave exactly one newline at end of buffer.
-  (goto-char (point-max))
-  (skip-chars-backward "\n")
-  (if (eobp)
-      (insert ?\n)
-    (delete-region (1+ (point)) (point-max)))
-  ;; Leave exactly zero newlines at beginning of buffer.
-  (delete-region (point-min)
-		 (save-excursion (goto-char (point-min))
-				 (skip-chars-forward "\n")
-				 (point)))
-  )
-
-(defun Manual-mouseify-xrefs (&optional apropos-mode)
-  (goto-char (point-min))
-  ;; skip the top line of manual pages, but not apropos listings.
-  (unless apropos-mode (forward-line 1))
-  (let ((case-fold-search nil)
-	s e name splitp extent)
-    ;; possibly it would be faster to rewrite this expression to search for
-    ;; a less common sequence first (like "([0-9]") and then back up to see
-    ;; if it's really a match.  This function is 15% of the total time, 13%
-    ;; of which is this call to re-search-forward.
-    (while (re-search-forward "[a-zA-Z_][-a-zA-Z0-9_.:]*([0-9][a-zA-Z0-9]*)"
-			      nil t)
-      (setq s (match-beginning 0)
-	    e (match-end 0)
-	    name (buffer-substring s e)
-	    splitp nil)
-
-      (goto-char s)
-      ;; if this is a hyphenated xref, we're on the second line, 1st char now.
-      (when (progn
-	      (beginning-of-line)
-	      (and (looking-at (concat "^[ \t]+" (regexp-quote name)))
-		   (progn
-		     (backward-char 1)
-		     (or (equal (char-before) ?-)
-			 (equal (char-before) ?\255)))
-		   (setq s (progn
-			     (skip-chars-backward "-\255_a-zA-Z0-9")
-			     (point))
-			 name (buffer-substring s e))))
-	(setq splitp t)
-	;; delete the spaces and dash from `name'
-	(let (i)
-	  (while (setq i (string-match "[-\255 \n\t]+" name i))
-	    (setq name (concat (substring name 0 i)
-			       (substring name (match-end 0)))
-		  i (1+ i)))))
-
-      ;; if there are upper case letters in the section, downcase them.
-      (if (string-match "(.*[A-Z]+.*)$" name)
-	  (setq name (concat (substring name 0 (match-beginning 0))
-			     (downcase (substring name (match-beginning 0))))))
-
-      ;; if the xref was hyphenated, don't highlight the indention spaces.
-      (if splitp
-	  (progn
-	    (setq extent (make-extent s (progn (goto-char s) (end-of-line) (point))))
-	    (set-extent-property extent 'man (list 'Manual-follow-xref name))
-	    (set-extent-property extent 'highlight t)
-	    (set-extent-face extent 'man-xref)
-	    (goto-char e)
-	    (skip-chars-backward "-_a-zA-Z0-9()")
-	    (setq extent (make-extent (point) e)))
-	(setq extent (make-extent s e)))
-      (set-extent-property extent 'man (list 'Manual-follow-xref name))
-      (set-extent-property extent 'highlight t)
-      (set-extent-face extent 'man-xref)
-      (goto-char e))))
-
-(defun Manual-follow-xref (&optional name-or-event)
-  "Invoke `manual-entry' on the cross-reference under the mouse.
-When invoked noninteractively, the arg may be an xref string to parse instead."
-  (interactive "e")
-  (if (eventp name-or-event)
-      (let* ((p (event-point name-or-event))
-	     (extent (and p (extent-at p
-			     (event-buffer name-or-event)
-			     'highlight)))
-	     (data (and extent (extent-property extent 'man))))
-	(if (eq (car-safe data) 'Manual-follow-xref)
-	    (eval data)
-	  (error "no manual cross-reference there.")))
-    (or (manual-entry name-or-event)
-	;; If that didn't work, maybe it's in a different section than the
-	;; man page writer expected.  For example, man pages tend assume
-	;; that all user programs are in section 1, but X tends to generate
-	;; makefiles that put things in section "n" instead...
-	(and (string-match "[ \t]*([^)]+)\\'" name-or-event)
-	     (progn
-	       (message "No entries found for %s; checking other sections..."
-			name-or-event)
-	       (manual-entry
-		(substring name-or-event 0 (match-beginning 0))
-		nil t))))))
-
-(defun Manual-popup-menu (&optional event)
-  "Pops up a menu of cross-references in this manual page.
-If there is a cross-reference under the mouse button which invoked this
-command, it will be the first item on the menu.  Otherwise, they are
-on the menu in the order in which they appear in the buffer."
-  (interactive "e")
-  (let ((buffer (current-buffer))
-	(sep "---")
-	xref items)
-    (cond (event
-	   (setq buffer (event-buffer event))
-	   (let* ((p (event-point event))
-		  (extent (and p (extent-at p buffer 'highlight)))
-		  (data (and extent (extent-property extent 'man))))
-	     (if (eq (car-safe data) 'Manual-follow-xref)
-		 (setq xref (nth 1 data))))))
-    (if xref (setq items (list sep xref)))
-    (map-extents #'(lambda (extent ignore)
-		     (let ((data (extent-property extent 'man)))
-		       (if (and (eq (car-safe data) 'Manual-follow-xref)
-				(not (member (nth 1 data) items)))
-			   (setq items (cons (nth 1 data) items)))
-		    nil))
-		 buffer)
-    (if (eq sep (car items)) (setq items (cdr items)))
-    (let ((popup-menu-titles t))
-      (and (null items) (setq popup-menu-titles nil))
-      (popup-menu
-       (cons "Manual Entry"
-	     (mapcar #'(lambda (item)
-			 (if (eq item sep)
-			     item
-                           (vector item
-                                   (list 'Manual-follow-xref item) t)))
-		     (nreverse items)))))))
-
-(defun pager-cleanup-hook ()
-  "cleanup man page if called via $PAGER"
-  (let ((buf-name (or buffer-file-name (buffer-name))))
-	(if (or (string-match "^/tmp/man[0-9]+" buf-name)
-		(string-match ".*/man/\\(man\\|cat\\)[1-9a-z]/" buf-name))
-	    (let (buffer manpage)
-	      (require 'man)
-	      (goto-char (point-min))
-	      (setq buffer-read-only nil)
-	      (Manual-nuke-nroff-bs)
-	      (goto-char (point-min))
-	      (if (re-search-forward "[^ \t]")
-		  (goto-char (- (point) 1)))
-	      (if (looking-at "\\([a-zA-Z0-9]+\\)[ \t]*(")
-		  (setq manpage (buffer-substring (match-beginning 1)
-						  (match-end 1)))
-		(setq manpage "???"))
-	      (setq buffer
-		    (rename-buffer (generate-new-buffer-name
-				    (concat "Man: " manpage)))
-		    buffer-file-name nil)
-	      (goto-char (point-min))
-	      (insert (format "%s\n" buf-name))
-	      (goto-char (point-min))
-	      (buffer-disable-undo buffer)
-	      (set-buffer-modified-p nil)
-	      (Manual-mode)
-	      ))))
-
-(add-hook 'server-visit-hook 'pager-cleanup-hook)
-(provide 'man)
diff --git a/xemacs-packages/lisp/edit-utils/mic-paren.el b/xemacs-packages/lisp/edit-utils/mic-paren.el
deleted file mode 100644
index 1d817f33..00000000
--- a/xemacs-packages/lisp/edit-utils/mic-paren.el
+++ /dev/null
@@ -1,1444 +0,0 @@
-;;; mic-paren.el --- advanced highlighting of matching parentheses.
-
-;; Version: 3.7 - 2001-12-21
-;; Author: Mikael Sjödin (mic@docs.uu.se)
-;;         Klaus Berndl  
-;; Keywords: languages, faces, parenthesis, matching
-;;
-;; Additional info:
-;; Copyright (C) 1997 Mikael Sjödin (mic@docs.uu.se)
-;; Maintenance and development (since v2.1): Klaus Berndl 
-;; Original author: Mikael Sjödin  --  mic@docs.uu.se
-;; Additional code by: Vinicius Jose Latorre 
-;;                     Steven L Baur 
-;;                     Klaus Berndl  
-;;
-;; mic-paren.el is free software
-;; 
-;; 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
-
-;; ----------------------------------------------------------------------
-;; Short Description:
-;;
-;; Load this file, activate it and Emacs will display highlighting on
-;; whatever parenthesis (and paired delimiter if you like this) matches
-;; the one before or after point. This is an extension to the paren.el
-;; file distributed with Emacs. The default behaviour is similar to
-;; paren.el but more sophisticated. Normally you can try all default
-;; settings to enjoy mic-paren.
-;;
-;; Or - if you are a LaTeX writer like the current maintainer - try the
-;; following additional setup in your .emacs:
-;;
-;; ;; In LaTeX-mode we want this
-;; (add-hook 'LaTeX-mode-hook
-;;           (function (lambda ()
-;;                       (paren-toggle-matching-quoted-paren 1)
-;;                       (paren-toggle-matching-paired-delimiter 1))))
-;;
-;; Or - if you are programming in C like languages - try also:
-;; (add-hook 'c-mode-common-hook
-;;           (function (lambda ()
-;;                        (paren-toggle-open-paren-context 1))))
-;; ----------------------------------------------------------------------
-
-;; ----------------------------------------------------------------------
-;; Installation:
-;;
-;; o Place this file in a directory in your 'load-path and byte-compile
-;;   it. You can surely ignore the warnings.
-;; o Put the following in your .emacs file:
-;;   (GNU Emacs supports mic-paren only within a window-system but XEmacs
-;;   supports mic-paren also without X)
-;;   (when (or (string-match "XEmacs\\|Lucid" emacs-version) window-system)
-;;      (require 'mic-paren) ; loading
-;;      (paren-activate)     ; activating
-;;      ;;; set here any of the customizable variables of mic-paren:
-;;      ;;; ...
-;;   )
-;; o Restart your Emacs. mic-paren is now installed and activated!
-;; o To list the possible customizations enter `C-h f paren-activate' or
-;;   go to the customization group `mic-paren-matching'.
-
-;; ----------------------------------------------------------------------
-;; Long Description:
-;;
-;; mic-paren.el is an extension and replacement to the packages paren.el
-;; and stig-paren.el for Emacs. When mic-paren is active Emacs normal
-;; parenthesis matching is deactivated. Instead parenthesis matching will
-;; be performed as soon as the cursor is positioned at a parenthesis. The
-;; matching parenthesis (or the entire expression between the
-;; parentheses) is highlighted until the cursor is moved away from the
-;; parenthesis. Features include:
-;; o Both forward and backward parenthesis matching (simultaneously if
-;;   cursor is between two expressions).
-;; o Indication of mismatched parentheses.
-;; o Recognition of "escaped" (also often called "quoted") parentheses.
-;; o Option to match "escaped" parens too, especially in (La)TeX-mode
-;;   (e.g. matches expressions like "\(foo bar\)" properly).
-;; o Offers two functions as replacement for forward-sexp and
-;;   backward-sexp which handle properly quoted parens (s.a.). These new
-;;   functions can automatically be bounded to the original binding of
-;;   the standard forward-sexp and backward-sexp functions.
-;; o Option to activate matching of paired delimiter (i.e. characters with
-;;   syntax '$'). This is useful for writing in LaTeX-mode for example.
-;; o Option to select in which situations (always, never, if match, if
-;;   mismatch) the entire expression should be highlighted or only the
-;;   matching parenthesis.
-;; o Message describing the match when the matching parenthesis is off-screen
-;;   (vertical and/or horizontal). Message contains either the linenumber or
-;;   the number of lines between the two matching parens. Option to select in
-;;   which cases this message should be displayed.
-;; o Optional delayed highlighting (useful on slow systems),
-;; o Functions to activate/deactivate mic-paren.el are provided.
-;; o Numerous options to control the behaviour and appearance of
-;;   mic-paren.el.
-;;
-;; mic-paren.el was originally developed and tested under Emacs 19.28 -
-;; 20.3. It should work on earlier and forthcoming Emacs versions. XEmacs
-;; compatibility has been provided by Steven L Baur .
-;; Jan Dubois (jaduboi@ibm.net) provided help to get mic-paren to work in
-;; OS/2. Mic-paren versions >= v2.1 are only tested with recent Emacsen
-;; (FSF Emacs >= 20.3.1 and XEmacs >= 21.1) but should also work with
-;; earlier versions of (X)Emacs.
-;;
-;; This file can be obtained from "The EmacsWiki" and here from the
-;; packages-site: http://www.emacswiki.org/elisp/index.html
-
-;; ----------------------------------------------------------------------
-;; Available customizable options:
-;; - `paren-priority'
-;; - `paren-overlay-priority'
-;; - `paren-sexp-mode'
-;; - `paren-highlight-at-point'
-;; - `paren-highlight-offscreen'
-;; - `paren-display-message'
-;; - `paren-message-linefeed-display'
-;; - `paren-message-no-match'
-;; - `paren-message-show-linenumber'
-;; - `paren-message-truncate-lines'
-;; - `paren-ding-unmatched'
-;; - `paren-delay'
-;; - `paren-dont-touch-blink'
-;; - `paren-match-face'
-;; - `paren-mismatch-face'
-;; - `paren-no-match-paren'
-;; - `paren-bind-modified-sexp-functions'
-;; Available customizable faces:
-;; - `paren-face-match'
-;; - `paren-face-mismatch'
-;; - `paren-face-no-match'
-;; Available commands:
-;; - `paren-activate'
-;; - `paren-deactivate'
-;; - `paren-toggle-matching-paired-delimiter'
-;; - `paren-toggle-matching-quoted-paren'
-;; - `paren-toggle-open-paren-context'
-;; - `paren-forward-sexp'
-;; - `paren-backward-sexp'
-;; ----------------------------------------------------------------------
-
-;; IMPORTANT NOTES (important for people who have customized mic-paren
-;;                  from within elisp):
-;; - In version >= 3.3 the prefix "mic-" has been removed from the
-;;   command-names 'mic-paren-forward-sexp' and 'mic-paren-backward-sexp'.
-;;   Now all user-functions and -options begin with the prefix "paren-"
-;;   because this package should be a replacement of the other
-;;   paren-packages like paren.el and stig-paren.el!
-;; - In version >= 3.2 the prefix "mic-" has been removed from the
-;;   command-names 'mic-paren-toggle-matching-quoted-paren' and
-;;   'mic-paren-toggle-matching-paired-delimiter'.
-;; - In versions >= 3.1 mic-paren is NOT auto. activated after loading.
-;; - In versions >= 3.0 the variable 'paren-face' has been renamed to
-;;   `paren-match-face'.
-
-;; ----------------------------------------------------------------------
-;; Versions:
-;; v3.7    + Removed the message "You should be in LaTeX-mode!".
-;;         + Fixed a bug in `paren-toggle-matching-quoted-paren'.
-;;
-;; v3.6    + Fixed a very small bug in `mic-paren-horizontal-pos-visible-p'.
-;;         + The informational messages like "Matches ... [+28]" which are
-;;           displayed if the matching paren is offscreen, do not longer
-;;           wasting the log.
-;;
-;; v3.5    + No mic-paren-messages are displayed if we are in isearch-mode.
-;;         + Matching quoted parens is switched on if entering a minibuffer.
-;;           This is useful for easier inserting regexps, e.g. with
-;;           `query-replace-regexp'. Now \(...\) will be highlighted in the
-;;           minibuffer.
-;;         + New option `paren-message-show-linenumber': You can determine the
-;;           computation of the offscreen-message-linenumber: Either the
-;;           number of lines between the two matching parens or the absolute
-;;           linenumber (Thank you for the idea and a first implementation to
-;;           Eliyahu Barzilay ).
-;;         + New option `paren-message-truncate-lines': If mic-paren messages
-;;           should be truncated ot not (has only an effect in GNU Emacs 21).
-;;           (Thank you for the idea and a first implementation to Eliyahu
-;;           Barzilay ).
-;;
-;; v3.4    + Corrected some bugs in the backward-compatibility for older
-;;           Emacsen. Thanks to Tetsuo Tsukamoto .
-;;
-;; v3.3    + Now the priority of the paren-overlays can be customized
-;;           (option `paren-overlay-priority'). For a description of the
-;;           priority of an overlay see in the emacs-lisp-manual the node
-;;           "Overlays". This option is mainly useful for experienced
-;;           users which use many packages using overlays to perform their
-;;           tasks.
-;;         + Now you can determine what line-context will be displayed if
-;;           the matching open paren is offscreen. In functional
-;;           programming languages like lisp it is useful to display the
-;;           following line in the echo-area if the opening matching paren
-;;           has no preceding text in the same line.
-;;           But in procedural languages like C++ or Java it is convenient
-;;           to display the first previous non empty line in this case
-;;           instead of the following line. Look at the new variable
-;;           `paren-open-paren-context-backward' and the related toggling
-;;           function `paren-toggle-open-paren-context' for a detailed
-;;           description of this new feature.
-;;         + In addition to the previous described new feature you can
-;;           specify how a linefeed in the message (e.g. if the matching
-;;           paren is offscreen) is displayed. This is mainly because the
-;;           standard echo-area display of a linefeed (^J) is bad to read.
-;;           Look at the option `paren-message-linefeed-display'.
-;;         + Solved a little bug in the compatibility-code for Emacsen
-;;           not supporting current customize-feature.
-;;         + Removed the prefix "mic-" from the commands
-;;           'mic-paren-forward-sexp' and 'mic-paren-backward-sexp'. For
-;;           an explanation look at comments for version v3.2.
-;;
-;; v3.2    + The prefix "mic-" has been removed from the commands
-;;           'mic-paren-toggle-matching-quoted-paren' and
-;;           'mic-paren-toggle-matching-paired-delimiter'. This is because
-;;           of consistency. Now all user-variables, -faces and -commands
-;;           begin with the prefix "paren-" and all internal functions and
-;;           variables begin with the prefix "mic-paren-".
-;;         + Now you can exactly specify in which situations the whole
-;;           sexp should be highlighted (option `paren-sexp-mode'):
-;;           Always, never, if match or if mismatch. Tested with Gnus
-;;           Emacs >= 20.3.1 and XEmacs >= 21.1.
-;;
-;; v3.1    + From this version on mic-paren is not auto. loaded. To
-;;           activate it you must call `paren-activate' (either in your
-;;           .emacs or manually with M-x). Therefore the variable
-;;           `paren-dont-activate-on-load' is obsolet and has been
-;;           removed.
-;;         + Now mic-paren works also in older Emacsen without the
-;;           custom-feature. If the actual custom-library is provided
-;;           mic-paren use them and is full customizable otherwise normal
-;;           defvars are used for the options.
-;;         + Fix of a bug displaying a message if the matching paren is
-;;           horizontal out of view.
-;;         + All new features are now tested with XEmacs >= 21.1.6
-;;
-;; v3.0    + Checking if matching paren is horizontally offscreen (in case
-;;           of horizontal scrolling). In that case the message is
-;;           displayed in the echo-area (anlogue to vertical offscreen).
-;;           In case of horizontal offscreen closing parenthesis the
-;;           displayed message is probably wider than the frame/window. So
-;;           you can only read the whole message if you are using a
-;;           package like mscroll.el (scrolling long messages) in GNU
-;;           Emacs.
-;;         + Now full customizable, means all user-options and -faces now
-;;           can be set with the custom-feature of Emacs. On the other
-;;           side this means this version of mic-paren only works with an
-;;           Emacs which provides the custom-package!
-;;         + In case of the matching paren is offscreen now the displayed
-;;           message contains the linenumber of the matching paren too.
-;;         This version is only tested with Gnu Emacs >= 20.4 and not with
-;;         any XEmacs!
-;;         Implemented by Klaus Berndl 
-;;
-;; v2.3    No additional feature but replacing 'char-bytes and
-;;         'char-before with 'mic-char-bytes and 'mic-char-before to
-;;         prevent the global-namespace. Now the new features of v2.1
-;;         and v2.2 are also tested with XEmacs!
-;;
-;; v2.2    Adding the new feature for matching paired delimiter. Not
-;;         tested with XEmacs. Implemented by Klaus Berndl 
-;;
-;; v2.1    Adding the new feature for matching escaped parens too. Not
-;;         tested with XEmacs. Implemented by Klaus Berndl 
-;;
-;; v2.0    Support for MULE and Emacs 20 multibyte characters added. Inspired
-;;         by the suggestion and code of Saito Takaaki
-;;         
-;;
-;; v1.9    Avoids multiple messages/dings when point has not moved.  Thus,
-;;	    mic-paren no longer overwrites messages in minibuffer.  Inspired by
-;;	    the suggestion and code of Barzilay Eliyahu .
-;;
-;; v1.3.1  Some spelling corrected (from Vinicius Jose Latorre
-;;	     and Steven L Baur )
-;;
-;; v1.3    Added code from Vinicius Jose Latorre  to
-;;	    highlight unmatched parentheses (useful in minibuffer)
-;;
-;; v1.2.1  Fixed stuff to work with OS/2 emx-emacs
-;;           - checks if x-display-colour-p is bound before calling it
-;;           - changed how X/Lucid Emacs is detected
-;;         Added automatic load of the timer-feature (+ variable to disable
-;;         the loading)
-
-;; TODO:
-;;
-
-;;; Code
-
-(defvar mic-paren-version "3.7"
-  "Version string for mic-paren.")
-
-;;; ======================================================================
-;; Compatibility stuff 
-;; BLOB to make custom stuff work even without customize
-(eval-and-compile
-  (condition-case ()
-      (require 'custom)
-    (error nil))
-  (unless (fboundp 'defgroup)
-    (defmacro defgroup (&rest rest) nil))
-  (unless (fboundp 'defcustom)
-    (defmacro defcustom (sym val str &rest rest)
-      (` (defvar (, sym) (, val) (, str)))))
-  (unless (fboundp 'defface)
-    (defmacro defface (sym val str &rest rest)
-      (` (defvar (, sym) (make-face '(, sym)) (, str))))))
-
-  
-;;; ======================================================================
-;;; here begin the user options
-
-(defgroup mic-paren-matching nil
-  "Showing advanced (un)matching of parens and expressions."
-  :prefix "paren-"
-  :group 'paren-matching)
-
-(defcustom paren-priority 'both
-  "*Defines the behaviour of mic-paren when point is between a
-closing and an opening parenthesis. This means what should be done in a
-situation like this: \(a b)\(c d)
-                           ^
-                         point
-- 'close means highlight the parenthesis matching the close-parenthesis
-  before the point \(highlight opening paren before 'a').
-- 'open means highlight the parenthesis matching the open-parenthesis after
-  the point \(highlight closing paren after 'd').
-- 'both means highlight both parenthesis matching the parenthesis beside
-  the point \(highlight opening before 'a' and closing after 'd')."
-  :type '(choice (const :tag "Match close" close)
-                 (const :tag "Match open" open)
-                 (const :tag "Match both" both))
-  :group 'mic-paren-matching)
-
-(defcustom paren-overlay-priority 999
- "*Specify paren overlay priority \(Integer >= 0\). For a description of the
-priority of an overlay see in the emacs-lisp manual the node Overlays.
-Normally you don't want to change the default-value!"
- :set (function
-       (lambda (symbol value)
-        (set symbol (if (< value 0) (* -1 value) value))))
- :initialize 'custom-initialize-default
- :type 'integer
- :group 'mic-paren-matching)
-
-(defcustom paren-sexp-mode nil
-  "*Defines in which situations the whole sexp should be highlighted.
-This means the whole s-expression between the matching parenthesis is
-highlighted instead of only the matching/mismatching parenthesis.
-
-- t: Always highlight the whole s-expression.
-- nil: Never highlight the whole s-expression.
-- 'match: Highlight the whole s-expression only if the parens match.
-- 'mismatch: Highlight the whole s-expression only if the parens don't match."
-  :type '(choice (const :tag "Never sexp-mode" nil)
-                 (const :tag "Always sexp-mode" t)
-                 (const :tag "If match" match)
-                 (const :tag "If mismatch" mismatch))
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-highlight-at-point t
-  "*If non-nil and point is after a close parenthesis, both the close
-and open parenthesis is highlighted. If nil, only the open parenthesis is
-highlighted."
-  :type '(choice (const :tag "Highlight both" t)
-                 (const :tag "Highlight open" nil))
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-highlight-offscreen nil
-  "*If non-nil mic-paren will highlight text which is not visible in the
-current buffer.
-
-This is useful if you regularly display the current buffer in multiple
-windows or frames. For instance if you use follow-mode \(by
-andersl@csd.uu.se), however it may slow down your Emacs.
-
-\(This variable is ignored \(treated as non-nil) if you set paren-sexp-mode to
-non-nil.)"
-  :type 'boolean
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-display-message 'only
-  "*Display message if matching parenthesis is off-screen.
-Possible settings are:
-- 'always: message is always displayed regardless if offscreen or not
-- 'only:   message is only displayed when matching is offscreen
-- 'never:  never a message is displayed."
-  :type '(choice (const :tag "Display always" always)
-                 (const :tag "Display if offscreen" only)
-                 (const :tag "No Message display" never))
-  :group 'mic-paren-matching)
-
-(defcustom paren-message-linefeed-display " RET "
-  "*How a linefeed in the matching paren context message is displayed.
-There are three predefined values:
-- Displays linefeeds with \" RET \" in the message.
-- Displays linefeeds with a SPACE in the message.
-- Displays linefeeds in the standard-form, means with \"^J\".
-But you can also specify any user-defined string for it.
-
-For further explanations about message displaying look at
-`paren-display-message'."
-  :type '(choice (const :tag "Display with \"RET\"" :value " RET ")
-                 (const :tag "Display with a SPACE" :value " ")
-                 (const :tag "Standard" :value "^J")
-                 (string :tag "User defined"))
-  :group 'mic-paren-matching)
-
-(defcustom paren-message-show-linenumber 'sexp
-  "*Determine the computation of the offscreen-message-linenumber.
-If the matching paren is offscreen, then maybe a message with the context of
-the matching paren and it´s linenumber is displayed \(depends on the setting
-in `paren-display-message'). Here the computation of the linenumber can be
-determined:
-- 'sexp: Display the number of lines between the matching parens. Then the
-         number of lines is displayed as negativ number if the matching paren
-         is somewhere above. Otherwise the number has a positive sign.
-- 'absolute: Display the absolute linenumber of the machting paren computed
-             from the beginning of the buffer."
-  :type '(choice (const :tag "Count accros sexp" sexp)
-                 (const :tag "Absolute number" absolute))
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-message-no-match t
-  "*Display message if no matching parenthesis is found."
-  :type '(choice (const :tag "Display message" t)
-                 (const :tag "No message" nil))
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-message-truncate-lines t
-  "*Non nil means truncate lines for all messages mic-paren can display.
-This option has only an effect with GNU Emacs 21.x!"
-  :type 'boolean
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-ding-unmatched nil
-  "*Non nil means make noise if the cursor is at an unmatched
-parenthesis or no matching parenthesis is found.
-Even if nil, typing an unmatched parenthesis produces a ding."
-  :type 'boolean
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-delay nil
-  "*This variable controls when highlighting is done.
-The variable has different meaning in different versions of Emacs.
-
-In Emacs 19.29 and below:
-  This variable is ignored.
-
-In Emacs 19.30:
-  A value of nil will make highlighting happen immediately \(this may slow
-  down your Emacs if running on a slow system). Any non-nil value will
-  delay highlighting for the time specified by post-command-idle-delay.
-
-In Emacs 19.31 and above:
-  A value of nil will make highlighting happen immediately \(this may slow
-  down your Emacs if running on a slow system). If not nil, the value
-  should be a number \(possible a floating point number if your Emacs
-  support floating point numbers). The number is the delay in seconds
-  before mic-paren performs highlighting.
-
-If you change this variable when mic-paren is active you have to
-re-activate \(with M-x paren-activate) mic-paren for the change to take
-effect."
-  :type '(choice (number :tag "Delay time")
-                 (const :tag "No delay" nil))
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-dont-touch-blink nil
-  "*Non-nil means not to change the value of blink-matching-paren
-when mic-paren is activated of deactivated.
-If nil mic-paren turns of blinking when activated and turns on blinking when
-deactivated."
-  :type 'boolean
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-dont-load-timer (not (string-match "XEmacs\\|Lucid"
-                                                    emacs-version))
-  "*If non-nil mic-paren will not try to load the timer-feature when
-loaded.
-
-\(I have no idea why Emacs user ever want to set this to non-nil but I hate
-packages which loads/activates stuff I don't want to use so I provide this
-way to prevent the loading if someone doesn't want timers to be loaded.)"
-  :type 'boolean
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-bind-modified-sexp-functions t
-  "*Automatic binding of the new sexp-functions to the old bindings.
-If non nil mic-paren checks at load-time the keybindings for the functions
-`forward-sexp' and `backward-sexp' and binds the modified sexp-functions
-`paren-forward-sexp' and `paren-backward-sexp' to exactly these
-bindings if and only if matching quoted/escaped parens is turned on by
-`paren-toggle-matching-quoted-paren'. These new binding is done only
-for the buffer local-key-map, therefore if you activate the quoted matching
-only in some modes from within a hook only in these buffers the new binding
-is active and 'in all other not.
-If you deactivate the quoted matching feature by
-`paren-toggle-matching-quoted-paren' then `forward-sexp' and
-`backward-sexp' will be bound again to their original key-bindings!"
-  :type 'boolean
-  :group 'mic-paren-matching)
-
-;;; ------------------------------
-;;; Faces
-;;; ------------------------------
-
-(defface paren-face-match
-  '((((class color)) (:background "turquoise"))
-    (t (:background "gray")))
-  "Mic-paren mode face used for a matching paren."
-  :group 'faces
-  :group 'mic-paren-matching)
-
-(defface paren-face-mismatch
-  '((((class color)) (:foreground "white" :background "purple"))
-    (t (:reverse-video t)))
-  "Mic-paren mode face used for a mismatching paren."
-  :group 'faces
-  :group 'mic-paren-matching)
-
-(defface paren-face-no-match
-  '((((class color)) (:foreground "black" :background "yellow"))
-    (t (:reverse-video t)))
-  "Mic-paren mode face used for an unmatched paren."
-  :group 'faces
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-match-face 'paren-face-match
-  "*Face to use for showing the matching parenthesis."
-  :type 'face
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-mismatch-face 'paren-face-mismatch
-  "*Face to use when highlighting a mismatched parenthesis."
-  :type 'face
-  :group 'mic-paren-matching)
-
-
-(defcustom paren-no-match-face 'paren-face-no-match
-  "*Face to use when highlighting an unmatched parenthesis."
-  :type 'face
-  :group 'mic-paren-matching)
-
-
-;;; End of User Options:
-;;; ======================================================================
-
-;;; Below there are only variables and options which either should be not
-;;; set directly but with toggle-functions or pure internal variables
-
-(defvar paren-match-quoted-paren nil
-  "*Non-nil causes to match properly quoted \(or escaped\) parens \(e.g. in
-TeX-files, e.g. \"\\\(x-3y + z = 7\\\)\"\). FSF-Emacs can not match quoted
-parens, so we must temporally deactivate the quoting until emacs has done
-its sexp-parsing. Therefore emacs itself does not \(can not!\) take into
-consideration if either both matched parens are quoted or none. But
-nevertheless we do this! Only symmetric balanced parens are matched: means
-either both matching parens must we quoted or none, otherwise they we will
-be highlighted as mismatched.
-This package offers also two slightly modified versions of forward-sexp
-\(resp. backward-sexp\):
-`paren-forward-sexp'\(`paren-backward-sexp'\). This versions can also
-jump to escaped/quoted parens.
-If this variable is not nil and `paren-bind-modified-sexp-functions' is set
-to non nil then `paren-toggle-matching-quoted-paren' will also toggle
-the original binding of `forward-sexp' \(resp. backward-sexp\) between the
-original functions and the modified equivalents.
-
-Do NOT set this variable directly but use
-`paren-toggle-matching-quoted-paren' to activate/deactivate/toggle this
-feature!. The best method is to do this in a mode hook, e.g.:
-\(add-hook \'LaTeX-mode-hook
-          \(function \(lambda \(\)
-                      \(paren-toggle-matching-quoted-paren 1\)\)\)\)")
-
-(make-variable-buffer-local 'paren-match-quoted-paren)
-
-(defvar paren-match-paired-delimiter nil
-"*If not nil then characters with syntax '$' \(means paired delimiter\)
-will be matched if possible (e.g. in LaTeX \"$...$\" is equal with
-\"\\(...\\)\"\) . Unlike to parens quoted/escaped paired delimiter will
-never match.
-
-Do NOT set this variable directly but use
-`paren-toggle-matching-paired-delimiter' to activate/deactivate/toggle
-this feature!. The best method is to do this in a mode hook, e.g.:
-\(add-hook \'LaTeX-mode-hook
-          \(function \(lambda \(\)
-                      \(paren-toggle-matching-paired-delimiter 1\)\)\)\)")
-
-(make-variable-buffer-local 'paren-match-paired-delimiter)
-
-(defvar paren-open-paren-context-backward nil
-"*Determines which context of the matching open paren will be displayed
-if the matching open paren is offscreen or `paren-display-message' is
-'always \(look at the documentation of `paren-display-message'\) and the
-matching open paren has no previous text in the same line.
-Meaning of the setting:
-- nil: Contents of the **next** not empty and not whitespace-line will be
-  displayed. This value is useful for example in functional programming
-  languages like \(emacs\)lisp.
-- not nil: Contents of the first **previous** not empty and not only
-  whitespace-line will be displayed. This value is useful for example in
-  procedural programming languages like C, C++, Java etc.
-
-Lets take a look at a short example:
-In languages like C++ we often have situations like
-  if \(i > VALUE\)
-  \{
-      // some code
-  \}
-With a value non nil the displayed opening-brace context would be
-\"if \(i > VALUE\)^J\{\" but with nil it would be \"\{^J // some code\"
-which would be in C++ lesser useful as the non nil version.
-\(The ^J stands for a newline in the buffer\).
-
-Do NOT set this variable directly but use `paren-toggle-open-paren-context'
-to change the value of this option!. The best method is to do this in a
-mode hook, e.g.:
-\(add-hook \'c-common-mode-hook
-           \(function \(lambda \(\)
-                         \(paren-toggle-open-paren-context 1\)\)\)\)")
-
-(make-variable-buffer-local 'paren-open-paren-context-backward)
-
-(defconst mic-paren-original-keybinding-of-sexp-functions
-  (list (car (where-is-internal 'forward-sexp))
-        (car (where-is-internal 'backward-sexp))))
-
-
-;;; Compatibility.
-;;; Try to make mic-paren work in different Emacs flavours.
-
-;; XEmacs compatibility (mainly by Steven L Baur )
-(eval-and-compile
-  (if (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)
-      (progn
-        (fset 'mic-make-overlay 'make-extent)
-        (fset 'mic-delete-overlay 'delete-extent)
-        (fset 'mic-overlay-put 'set-extent-property)
-        (defun mic-cancel-timer (timer) (delete-itimer timer))
-        (fset 'mic-run-with-idle-timer 'start-itimer)
-        )
-    (fset 'mic-make-overlay 'make-overlay)
-    (fset 'mic-delete-overlay 'delete-overlay)
-    (fset 'mic-overlay-put 'overlay-put)
-    (fset 'mic-cancel-timer 'cancel-timer)
-    (fset 'mic-run-with-idle-timer 'run-with-idle-timer)
-    ))
-
-;; MULE and Emacs 20 multibyte char compatibility.
-;; Implemented by defining dummys for functions which do not exist in vanilla
-;; Emacs.
-
-(if (fboundp 'char-bytes)
-    (fset 'mic-char-bytes 'char-bytes)
-  (defun mic-char-bytes (ch)
-    "Returns 1 for all input CH.
-Function defined by mic-paren to be compatible with multibyte Emacses."
-    1))
-
-(if (fboundp 'char-before)
-    (fset 'mic-char-before 'char-before)
-  (defun mic-char-before (pos)
-    "Return character in current buffer preceding position POS.
-POS is an integer or a buffer pointer.
-If POS is out of range, the value is nil.
-Function defined by mic-paren to be compatible with multibyte Emacses."
-    (char-after (1- pos))))
-
-(defun mic-paren-nolog-message (&rest args)
-  "Works exactly like `message' but does not log the message"
-  (let ((msg (cond ((or (null args)
-                        (null (car args)))
-                    nil)
-                   ((null (cdr args))
-                    (car args))
-                   (t
-                    (apply 'format args)))))
-    ;; Now message is either nil or the formated string.
-    (if (fboundp 'display-message)
-        ;; XEmacs way of preventing log messages.
-        (if msg
-            (display-message 'no-log msg)
-          (clear-message 'no-log))
-      ;; Emacs way of preventing log messages.
-      (let ((message-log-max nil))
-        (if msg
-            (message "%s" msg)
-          (message nil))))
-    msg))
-
-
-;;; ======================================================================
-;;; User Functions:
-
-;;;###autoload
-(defun paren-activate ()
-  "Activates mic-paren parenthesis highlighting.
-paren-activate deactivates the paren.el and stig-paren.el packages if they are
-active !
-The following options are available via the customize-feature:
-  `paren-priority'
-  `paren-overlay-priority'
-  `paren-sexp-mode'
-  `paren-highlight-at-point'
-  `paren-highlight-offscreen'
-  `paren-display-message'
-  `paren-message-linefeed-display'
-  `paren-message-no-match'
-  `paren-message-show-linenumber'
-  `paren-message-truncate-lines'
-  `paren-ding-unmatched'
-  `paren-delay'
-  `paren-dont-touch-blink'
-  `paren-match-face'
-  `paren-mismatch-face'
-  `paren-no-match-face'
-  `paren-bind-modified-sexp-functions'
-The following options are settable via toggling functions \(look at the
-documentation of these options for the names of these functions\):
-  `paren-match-quoted-paren'
-  `paren-match-paired-delimiter'
-  `paren-open-paren-context-backward'"
-  (interactive)
-  ;; Deactivate mic-paren.el (To remove redundant hooks)
-  (paren-deactivate)
-  ;; Deactivate paren.el if loaded
-  (if (boundp 'post-command-idle-hook)
-      (remove-hook 'post-command-idle-hook 'show-paren-command-hook))
-  (remove-hook 'post-command-hook 'show-paren-command-hook)
-  (and (boundp 'show-paren-overlay)
-       show-paren-overlay
-       (mic-delete-overlay show-paren-overlay))
-  (and (boundp 'show-paren-overlay-1)
-       show-paren-overlay-1
-       (mic-delete-overlay show-paren-overlay-1))
-  ;; Deactivate stig-paren.el if loaded
-  (if (boundp 'post-command-idle-hook)
-      (remove-hook 'post-command-idle-hook 'stig-paren-command-hook))
-  (remove-hook 'post-command-hook 'stig-paren-command-hook)
-  (remove-hook 'post-command-hook 'stig-paren-safe-command-hook)
-  (remove-hook 'pre-command-hook 'stig-paren-delete-overlay)
-  ;; Deactivate Emacs standard parenthesis blinking
-  (or paren-dont-touch-blink
-      (setq blink-matching-paren nil))
-
-  (cond(
-        ;; If timers are available use them
-        ;; (Emacs 19.31 and above)
-        (featurep 'timer)
-        (if (numberp paren-delay)
-            (setq mic-paren-idle-timer
-                  (mic-run-with-idle-timer paren-delay t
-                                           'mic-paren-command-idle-hook))
-          (add-hook 'post-command-hook 'mic-paren-command-hook)))
-       ;; If the idle hook exists assume it is functioning and use it
-       ;; (Emacs 19.30)
-       ((and (boundp 'post-command-idle-hook)
-             (boundp 'post-command-idle-delay))
-        (if paren-delay
-            (add-hook 'post-command-idle-hook 'mic-paren-command-idle-hook)
-          (add-hook 'post-command-hook 'mic-paren-command-hook)))
-       ;; Check if we (at least) have a post-comand-hook, and use it
-       ;; (Emacs 19.29 and below)
-       ((boundp 'post-command-hook)
-        (add-hook 'post-command-hook 'mic-paren-command-hook))
-       ;; Not possible to install mic-paren hooks
-       (t (error "Cannot activate mic-paren in this Emacs version")))
-  ;; we want matching quoted parens is the minibuffer so easier inserting
-  ;; paren-expressions i a rexexp.
-  (add-hook 'minibuffer-setup-hook
-            'mic-paren-minibuffer-setup-hook)
-  (add-hook 'minibuffer-exit-hook
-            'mic-paren-minibuffer-exit-hook))
-
-
-
-;;;###autoload
-(defun paren-deactivate ()
-  "Deactivates mic-paren parenthesis highlighting"
-  (interactive)
-  ;; Deactivate (don't bother to check where/if mic-paren is acivte, just
-  ;; delete all possible hooks and timers)
-  (if (boundp 'post-command-idle-hook)
-      (remove-hook 'post-command-idle-hook 'mic-paren-command-idle-hook))
-  (if mic-paren-idle-timer
-      (mic-cancel-timer mic-paren-idle-timer))
-  (remove-hook 'post-command-hook 'mic-paren-command-hook)
-  (remove-hook 'minibuffer-setup-hook
-               'mic-paren-minibuffer-setup-hook)
-  (remove-hook 'minibuffer-exit-hook
-               'mic-paren-minibuffer-exit-hook)
-  ;; Remove any old highlighs
-  (mic-delete-overlay mic-paren-backw-overlay)
-  (mic-delete-overlay mic-paren-point-overlay)
-  (mic-delete-overlay mic-paren-forw-overlay)
-
-  ;; Reactivate Emacs standard parenthesis blinking
-  (or paren-dont-touch-blink
-      (setq blink-matching-paren t))
-  )
-
-;;;###autoload
-(defun paren-toggle-matching-paired-delimiter (arg &optional no-message)
-"Toggle matching paired delimiter, force on with positive arg. Use this in
-mode-hooks to activate or deactivate paired delimiter matching. If optional
-second argument NO-MESSAGE is not nil then no message is displayed about the
-current activation state of the paired-delimiter-matching feature."
-  (interactive "P")
-  (setq paren-match-paired-delimiter (if (numberp arg)
-                                         (> arg 0)
-                                       (not paren-match-paired-delimiter)))
-  (if (not no-message)
-      (message "Matching paired delimiter is %s"
-               (if paren-match-paired-delimiter
-                   "ON."
-                 "OFF."))))
-
-
-;;;###autoload
-(defun paren-toggle-matching-quoted-paren (arg &optional no-message)
-  "Toggle matching quoted parens, force on with positive arg. Use this in
-mode-hooks to activate or deactivate quoted paren matching. If optional second
-argument NO-MESSAGE is not nil then no message is displayed about the current
-activation state of the quoted-paren-matching feature."
-  (interactive "P")
-  (setq paren-match-quoted-paren (if (numberp arg)
-                                         (> arg 0)
-                                       (not paren-match-quoted-paren)))
-  ;; if matching quoted parens is active now bind the original binding of
-  ;; forward-sexp and backward-sexp to the modified
-  ;; versions paren-forward-sexp (resp. paren-backward-sexp)
-  ;; if not bind it back to the original forward-sexp (resp. backward-sexp).
-  (let ((key-forward-sexp (car
-                           mic-paren-original-keybinding-of-sexp-functions))
-        (key-backward-sexp (car
-                            (cdr
-                             mic-paren-original-keybinding-of-sexp-functions))))
-    (if (and paren-bind-modified-sexp-functions
-             key-backward-sexp
-             key-forward-sexp)
-        (if paren-match-quoted-paren
-            (progn
-              (local-set-key key-forward-sexp
-                             (quote paren-forward-sexp))
-              (local-set-key key-backward-sexp
-                             (quote paren-backward-sexp)))
-          (local-set-key key-forward-sexp (quote forward-sexp))
-          (local-set-key key-backward-sexp (quote backward-sexp)))))
-  (if (not no-message)
-      (message "Matching quoted parens is %s"
-               (if paren-match-quoted-paren
-                   "ON."
-                 "OFF."))))
-
-;;;###autoload
-(defun paren-toggle-open-paren-context (arg)
-  "Toggle the determining of the context to display of the matching
-open-paren, force backward context with positive arg. Use this in mode-hooks.
-For a description of the meaning look at `paren-open-paren-context-backward'."
-  (interactive "P")
-  (setq paren-open-paren-context-backward
-        (if (numberp arg)
-            (> arg 0)
-          (not paren-open-paren-context-backward))))
-
-;;;###autoload
-(defun paren-forward-sexp (&optional arg)
-  "Acts like forward-sexp but can also handle quoted parens. Look at
-`paren-match-quoted-paren' for a detailed comment."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (let* ((uncharquote-diff (if (< arg 0) 2 1))
-         (match-check-diff (if (< arg 0) 1 2))
-         (charquote (mic-paren-uncharquote (- (point) uncharquote-diff)))
-         match-pos mismatch)
-    ;; we must encapsulate this in condition-case so we regain control
-    ;; after error and we can undo our unquoting if any done before!
-    (condition-case ()
-        (setq match-pos (scan-sexps (point) arg))
-      (error nil))
-    (mic-paren-recharquote charquote)
-    (if (not match-pos)
-        (buffer-end arg)
-      (setq mismatch (if charquote
-                         (not (mic-paren-is-following-char-quoted
-                               (- match-pos match-check-diff)))
-                       (mic-paren-is-following-char-quoted
-                        (- match-pos match-check-diff))))
-      (if (not mismatch)
-          (goto-char match-pos)
-        (forward-sexp arg)
-        ))))
-
-;;;###autoload
-(defun paren-backward-sexp (&optional arg)
-  "Acts like backward-sexp but can also matching quoted parens. Look at
-`paren-match-quoted-paren' for a detailed comment"
-  (interactive "p")
-  (or arg (setq arg 1))
-  (paren-forward-sexp (- arg)))
-
-
-;;; ======================================================================
-;;; Pure Internal variables:
-
-(defvar mic-paren-backw-overlay (mic-make-overlay (point-min) (point-min))
-  "Overlay for the open-paren which matches the close-paren before
-point. When in sexp-mode this is the overlay for the expression before point.")
-
-(defvar mic-paren-point-overlay (mic-make-overlay (point-min) (point-min))
-  "Overlay for the close-paren before point.
-\(Not used when is sexp-mode.)")
-
-(defvar mic-paren-forw-overlay (mic-make-overlay (point-min) (point-min))
-  "Overlay for the close-paren which matches the open-paren after
-point. When in sexp-mode this is the overlay for the expression after point.")
-
-(defvar mic-paren-idle-timer nil
-  "Idle-timer. Used only in Emacs 19.31 and above \(and if paren-delay is
-nil)")
-
-(defvar mic-paren-previous-location [nil nil nil]
-  "Records where point was the last time mic-paren performed some action.
-Format is [POINT BUFFER WINDOW]")
-
-
-;;; ======================================================================
-;;; Internal function:
-
-
-
-(defun mic-paren-command-hook ()
-  (or executing-kbd-macro
-      (input-pending-p)                 ;[This might cause trouble since the
-                                        ; function is unreliable]
-      (condition-case paren-error
-          (mic-paren-highlight)
-        (error
-         (if (not (window-minibuffer-p (selected-window)))
-             (message "mic-paren catched error (please report): %s"
-                      paren-error))))))
-
-(defun mic-paren-command-idle-hook ()
-  (condition-case paren-error
-      (mic-paren-highlight)
-    (error
-     (if (not (window-minibuffer-p (selected-window)))
-         (message "mic-paren catched error (please report): %s"
-                  paren-error)))))
-
-;; helper macro to set a FACE and the value of `paren-overlay-priority'
-;; to an OVERLAY.
-(defmacro mic-paren-overlay-set (overlay face)
-  (` (progn
-       (mic-overlay-put (, overlay)
-                        'face (, face))
-       (mic-overlay-put (, overlay)
-                        'priority paren-overlay-priority))))
-
-(defun mic-paren-minibuffer-setup-hook ()
-  (paren-toggle-matching-quoted-paren 1 t))
-
-(defun mic-paren-minibuffer-exit-hook ()
-  (paren-toggle-matching-quoted-paren -1 t))
-
-
-(defun mic-paren-highlight ()
-  "The main-function of mic-paren. Does all highlighting, dinging, messages,
-cleaning-up."
-  ;; Remove any old highlighting
-  (mic-delete-overlay mic-paren-forw-overlay)
-  (mic-delete-overlay mic-paren-point-overlay)
-  (mic-delete-overlay mic-paren-backw-overlay)
-
-  ;; Handle backward highlighting (when after a close-paren or a paired
-  ;; delimiter):
-  ;; If (positioned after a close-paren, and
-  ;;    not before an open-paren when priority=open, and
-  ;;    (paren-match-quoted-paren is t or the close-paren is not escaped))
-  ;;    or
-  ;;    (positioned after a paired delimiter, and
-  ;;    not before a paired-delimiter when priority=open, and
-  ;;    the paired-delimiter is not escaped))
-  ;; then
-  ;;      perform highlighting
-  (if (or (and (eq (char-syntax (preceding-char)) ?\))
-               (not (and (eq (char-syntax (following-char)) ?\()
-                         (eq paren-priority 'open)))
-               (or paren-match-quoted-paren
-                   (not (mic-paren-is-following-char-quoted (- (point)
-                                                               2)))))
-          (and paren-match-paired-delimiter
-               (eq (char-syntax (preceding-char)) ?\$)
-               (not (and (eq (char-syntax (following-char)) ?\$)
-                         (eq paren-priority 'open)))
-               (not (mic-paren-is-following-char-quoted (- (point) 2)))))
-      (let (open matched-paren charquote)
-        ;; if we want to match quoted parens we must change the syntax of
-        ;; the escape or quote-char temporarily. This will be undone later.
-        (setq charquote (mic-paren-uncharquote (- (point) 2)))
-        ;; Find the position for the open-paren
-        (save-excursion
-          (save-restriction
-            (if blink-matching-paren-distance
-                (narrow-to-region
-                 (max (point-min)
-                      (- (point) blink-matching-paren-distance))
-                 (point-max)))
-            (condition-case ()
-                (setq open (scan-sexps (point) -1))
-              (error nil))))
-
-        ;; we must call matching-paren because scan-sexps don't care about
-        ;; the kind of paren (e.g. matches '( and '}). matching-paren only
-        ;; returns the character displaying the matching paren in buffer's
-        ;; syntax-table (regardless of the buffer's current contents!).
-        ;; Below we compare the results of scan-sexps and matching-paren
-        ;; and if different we display a mismatch.
-        (setq matched-paren (matching-paren (preceding-char)))
-        ;; matching-paren can only handle characters with syntax ) or (
-        (if (eq (char-syntax (preceding-char)) ?\$)
-            (setq matched-paren (preceding-char)))
-
-        ;; if we have changed the syntax of the escape or quote-char we
-        ;; must undo this and we can do this first now.
-        (mic-paren-recharquote charquote)
-
-        ;; If match found
-        ;;    highlight expression and/or print messages
-        ;; else
-        ;;    highlight unmatched paren
-        ;;    print no-match message
-        (if open
-            (let ((mismatch (or (not matched-paren)
-                                (/= matched-paren (char-after open))
-                                (if charquote
-                                    (not (mic-paren-is-following-char-quoted
-                                          (1- open)))
-                                  (mic-paren-is-following-char-quoted
-                                   (1- open)))))
-                  ;; check if match-pos is visible
-                  (visible (and (pos-visible-in-window-p open)
-                                (mic-paren-horizontal-pos-visible-p open))))
-              ;; If highlight is appropriate
-              ;;    highlight
-              ;; else
-              ;;    remove any old highlight
-              (if (or visible paren-highlight-offscreen paren-sexp-mode)
-                  ;; If sexp-mode
-                  ;;    highlight sexp
-                  ;; else
-                  ;;    highlight the two parens
-                  (if (mic-paren-sexp-mode-p mismatch)
-                      (progn
-                        (setq mic-paren-backw-overlay
-                              (mic-make-overlay open (point)))
-                        (if mismatch
-                            (mic-paren-overlay-set mic-paren-backw-overlay
-                                                   paren-mismatch-face)
-                          (mic-paren-overlay-set mic-paren-backw-overlay
-                                                 paren-match-face)))
-                    (setq mic-paren-backw-overlay
-                          (mic-make-overlay
-                           open
-                           (+ open
-                              (mic-char-bytes (char-after open)))))
-                    (and paren-highlight-at-point
-                         (setq mic-paren-point-overlay
-                               (mic-make-overlay
-                                (- (point)
-                                   (mic-char-bytes (preceding-char)))
-                                (point))))
-                    (if mismatch
-                        (progn
-                          (mic-paren-overlay-set mic-paren-backw-overlay
-                                                 paren-mismatch-face)
-                          (and paren-highlight-at-point
-                               (mic-paren-overlay-set mic-paren-point-overlay
-                                                      paren-mismatch-face)))
-                      (mic-paren-overlay-set mic-paren-backw-overlay
-                                             paren-match-face)
-                      (and paren-highlight-at-point
-                           (mic-paren-overlay-set mic-paren-point-overlay
-                                                  paren-match-face)))))
-              ;; Print messages if match is offscreen
-              (and (not (eq paren-display-message 'never))
-                   (or (not visible) (eq paren-display-message 'always))
-                   (not (window-minibuffer-p (selected-window)))
-                   (not isearch-mode)
-                   (mic-paren-is-new-location)
-                   (let ((message-truncate-lines paren-message-truncate-lines))
-                     (mic-paren-nolog-message "%s %s"
-                                              (if mismatch "MISMATCH:" "Matches")
-                                              (mic-paren-get-matching-open-text open))))
-              ;; Ding if mismatch
-              (and mismatch
-                   paren-ding-unmatched
-                   (mic-paren-is-new-location)
-                   (ding)))
-          (setq mic-paren-backw-overlay
-                (mic-make-overlay (point)
-                                  (- (point)
-                                     (mic-char-bytes (preceding-char)))))
-          (mic-paren-overlay-set mic-paren-backw-overlay
-                                 paren-no-match-face)
-          (and paren-message-no-match
-               (not (window-minibuffer-p (selected-window)))
-               (not isearch-mode)
-               (mic-paren-is-new-location)
-               (mic-paren-nolog-message "No opening parenthesis found"))
-          (and paren-message-no-match
-               paren-ding-unmatched
-               (mic-paren-is-new-location)
-               (ding)))))
-
-  ;; Handle forward highlighting (when before an open-paren or a paired
-  ;; delimiter):
-  ;; If (positioned before an open-paren, and
-  ;;    not after a close-paren when priority=close, and
-  ;;    (paren-match-quoted-paren is t or the open-paren is not escaped))
-  ;;    or
-  ;;    (positioned before a paired delimiter, and
-  ;;    not after a paired-delimiter when priority=close, and
-  ;;    the paired-delimiter is not escaped))
-  ;; then
-  ;;      perform highlighting
-  (if (or (and (eq (char-syntax (following-char)) ?\()
-               (not (and (eq (char-syntax (preceding-char)) ?\))
-                         (eq paren-priority 'close)))
-               (or paren-match-quoted-paren
-                   (not (mic-paren-is-following-char-quoted (1-
-                                                             (point))))))
-          (and paren-match-paired-delimiter
-               (eq (char-syntax (following-char)) ?\$)
-               (not (and (eq (char-syntax (preceding-char)) ?\$)
-                         (eq paren-priority 'close)))
-               (not (mic-paren-is-following-char-quoted (1- (point))))))
-      (let (close matched-paren charquote)
-        ;; if we want to match quoted parens we must change the syntax of
-        ;; the escape or quote-char temporarily. This will be undone later.
-        (setq charquote (mic-paren-uncharquote (1- (point))))
-        ;; Find the position for the close-paren
-        (save-excursion
-          (save-restriction
-            (if blink-matching-paren-distance
-                (narrow-to-region
-                 (point-min)
-                 (min (point-max)
-                      (+ (point) blink-matching-paren-distance))))
-            (condition-case ()
-                (setq close (scan-sexps (point) 1))
-              (error nil))))
-
-        ;; for an explanation look above.
-        (setq matched-paren (matching-paren (following-char)))
-        (if (eq (char-syntax (following-char)) ?\$)
-            (setq matched-paren (following-char)))
-
-        ;; if we have changed the syntax of the escape or quote-char we
-        ;; must undo this and we can do this first now.
-        (mic-paren-recharquote charquote)
-
-        ;; If match found
-        ;;    highlight expression and/or print messages
-        ;; else
-        ;;    highlight unmatched paren
-        ;;    print no-match message
-        (if close
-            (let ((mismatch (or (not matched-paren)
-                                (/= matched-paren (mic-char-before close))
-                                (if charquote
-                                    (not (mic-paren-is-following-char-quoted
-                                          (- close 2)))
-                                  (mic-paren-is-following-char-quoted
-                                   (- close 2)))))
-                  ;; check if match-pos is visible
-                  (visible (and (pos-visible-in-window-p close)
-                                (mic-paren-horizontal-pos-visible-p close))))
-              ;; If highlight is appropriate
-              ;;    highlight
-              ;; else
-              ;;    remove any old highlight
-              (if (or visible paren-highlight-offscreen paren-sexp-mode)
-                  ;; If sexp-mode
-                  ;;    highlight sexp
-                  ;; else
-                  ;;    highlight the two parens
-                  (if (mic-paren-sexp-mode-p mismatch)
-                      (progn
-                        (setq mic-paren-forw-overlay
-                              (mic-make-overlay (point) close))
-                        (if mismatch
-                            (mic-paren-overlay-set mic-paren-forw-overlay
-                                                   paren-mismatch-face)
-                          (mic-paren-overlay-set mic-paren-forw-overlay
-                                                 paren-match-face)))
-                    (setq mic-paren-forw-overlay
-                          (mic-make-overlay
-                           (- close
-                              (mic-char-bytes (mic-char-before close)))
-                           close))
-                    (if mismatch
-                        (mic-paren-overlay-set mic-paren-forw-overlay
-                                               paren-mismatch-face)
-                      (mic-paren-overlay-set mic-paren-forw-overlay
-                                             paren-match-face))))
-
-              ;; Print messages if match is offscreen
-              (and (not (eq paren-display-message 'never))
-                   (or (not visible) (eq paren-display-message 'always))
-                   (not (window-minibuffer-p (selected-window)))
-                   (not isearch-mode)
-                   (mic-paren-is-new-location)
-                   (let ((message-truncate-lines paren-message-truncate-lines))
-                     (mic-paren-nolog-message "%s %s"
-                                              (if mismatch "MISMATCH:" "Matches")
-                                              (mic-paren-get-matching-close-text close))))
-              ;; Ding if mismatch
-              (and mismatch
-                   (mic-paren-is-new-location)
-                   paren-ding-unmatched
-                   (ding)))
-          (setq mic-paren-forw-overlay
-                (mic-make-overlay (point)
-                                  (+ (point)
-                                     (mic-char-bytes (following-char)))))
-          (mic-paren-overlay-set mic-paren-forw-overlay
-                                 paren-no-match-face)
-          (and paren-message-no-match
-               (not (window-minibuffer-p (selected-window)))
-               (not isearch-mode)
-               (mic-paren-is-new-location)
-               (mic-paren-nolog-message "No closing parenthesis found"))
-          (and paren-message-no-match
-               paren-ding-unmatched
-               (mic-paren-is-new-location)
-               (ding)))))
-
-  ;; Store the points position in mic-paren-previous-location
-  ;; Later used by mic-paren-is-new-location
-  (or (window-minibuffer-p (selected-window))
-      (progn
-        (aset mic-paren-previous-location 0 (point))
-        (aset mic-paren-previous-location 1 (current-buffer))
-        (aset mic-paren-previous-location 2 (selected-window))))
-  )
-
-;;; --------------------------------------------------
-
-(defun mic-paren-sexp-mode-p (mismatch)
-  "Check if we must highlight the whole sexp and return t if we must"
-  (cond ((eq paren-sexp-mode nil) nil)
-        ((eq paren-sexp-mode t) t)
-        ((eq paren-sexp-mode 'match) (not mismatch))
-        ((eq paren-sexp-mode 'mismatch) mismatch)))
-  
-;;; --------------------------------------------------
-
-(defun mic-paren-horizontal-pos-visible-p (match-pos)
-  "Returns non nil if the MATCH-POS is horizontal visible otherwise nil \(in
-case of horizontal scrolling)."
-  (let ((window (selected-window)))
-    (save-excursion
-      (goto-char match-pos)
-      (and (>= (- (current-column) (window-hscroll window)) 0)
-           (< (- (current-column) (window-hscroll window))
-              (window-width window))))))
-
-;; (defun mic-paren-horizontal-pos-visible-p (match-pos)
-;;   "Returns non nil if the MATCH-POS is horizontal visible otherwise nil \(in
-;; case of horizontal scrolling)."
-;;   (let ((match-column
-;;          (save-excursion
-;;            (goto-char match-pos)
-;;            (current-column))))
-;;     (if (> (window-hscroll) 0)
-;;         (and (>= match-column (window-hscroll))
-;;              (< match-column (+ (window-hscroll) (window-width))))
-;;       (< match-column (window-width)))))
-
-(defun mic-paren-get-matching-open-text (open)
-  "Returns a string with the context around OPEN-paren."
-  ;; If there's stuff on this line preceding the paren, then display text from
-  ;; beginning of line to paren.
-  ;;
-  ;; If, however, the paren is at the beginning of a line (means only
-  ;; whitespace before the paren), then skip whitespace forward and display
-  ;; text from paren to end of the next line containing non-space text. But
-  ;; if `paren-open-paren-context-backward' is non nil then skip
-  ;; whitespaces backward and display text from beginning of previous line
-  ;; to paren.
-  (let* ((loc (if (eq paren-message-show-linenumber 'sexp)
-                  (point) (point-min)))
-         (str (save-excursion
-                (goto-char open)
-                (if (save-excursion
-                      (skip-chars-backward " \t")
-                      (not (bolp)))
-                    (progn
-                      (beginning-of-line)
-                      (format "%s... [%s%d-]"
-                              (buffer-substring (point) (1+ open))
-                              (if (eq paren-message-show-linenumber 'sexp)
-                                  "-" "")
-                              (count-lines loc open)))
-                  (let (paren-context-string)
-                    (if (not paren-open-paren-context-backward)
-                        (progn
-                          (forward-char 1)
-                          (skip-chars-forward "\n \t")
-                          (end-of-line)
-                          (setq paren-context-string (buffer-substring open (point))))
-                      (skip-chars-backward "\n \t")
-                      (beginning-of-line)
-                      (setq paren-context-string (buffer-substring (point) (1+ open))))
-                    (format "%s [%s%d]"
-                            paren-context-string
-                            (if (eq paren-message-show-linenumber 'sexp)
-                                "-" "")
-                            (count-lines loc open)))))))
-    (while (string-match "[\n]" str)
-      (setq str (replace-match paren-message-linefeed-display nil t str)))
-    str))
-    
-
-
-(defun mic-paren-get-matching-close-text (close)
-  "Returns a string with the context around CLOSE-paren."
-  ;; The whole line up until the close-paren with "..." appended if there are
-  ;; more text after the close-paren
-  (let* ((loc (if (eq paren-message-show-linenumber 'sexp)
-                  (point) (point-min)))
-         (str (save-excursion
-                (goto-char close)
-                (forward-char -1)
-                (skip-chars-backward "\n \t")
-                (beginning-of-line)
-                (format "%s%s [%s%d]"
-                        (buffer-substring (point) close)
-                        (progn
-                          (goto-char close)
-                          (if (looking-at "[ \t]*$")
-                              ""
-                            "..."))
-                        (if (eq paren-message-show-linenumber 'sexp)
-                            "+" "")                       
-                        (count-lines loc close)))))
-    (while (string-match "[\n]" str)
-      (setq str (replace-match paren-message-linefeed-display nil t str)))
-    str))
-
-
-
-(defun mic-paren-is-new-location ()
-  "Returns t if the points location is not the same as stored in
-`mic-paren-previous-location', nil otherwise.
-
-The variable `mic-paren-previous-location' is set by
-`mic-paren-highlight'."
-  (not (and (eq (point) (aref mic-paren-previous-location 0))
-            (eq (current-buffer) (aref mic-paren-previous-location 1))
-            (eq (selected-window) (aref mic-paren-previous-location 2)))))
-
-
-(defun mic-paren-is-following-char-quoted (pnt)
-  "returns true if character at point PNT escapes or quotes the following
-char."
-  (let ((n 0))
-    (while (and (>= pnt (point-min))
-                (or (eq (char-syntax (char-after pnt)) ?\\)
-                    (eq (char-syntax (char-after pnt)) ?/)))
-      (setq n (1+ n))
-      (setq pnt (1- pnt)))
-    (if (eq 0 (% n 2)) nil t)))
-
-(defun mic-paren-uncharquote (pnt)
-  "if the syntax of character  at point PNT is escape or quote and if the
-character is not escaped or quoted itself then its syntax will be modified
-to punctuation and multiple values \( \"\") will be returned;
-otherwise nil."
-  (let (c cs)
-    (if (< pnt (point-min))
-        nil
-      (setq c (char-after pnt))
-      (setq cs (char-syntax c))
-      (if (not (and paren-match-quoted-paren
-                    (mic-paren-is-following-char-quoted pnt)))
-          nil
-        (modify-syntax-entry c ".")
-        (list c (char-to-string cs))))))
-
-(defun mic-paren-recharquote (charquote)
-  "CHARQUOTE is a 2-element-list: car is a character  and its cadr
-is a syntaxstring . The syntax of character  will be set to syntax
-. If CHARQUOTE is nil nothing will be done."
-  (if charquote
-      (modify-syntax-entry (car charquote) (car (cdr charquote)))))
-
-
-;;; ======================================================================
-;;; Initialisation when loading:
-
-;;; Try to load the timer feature if its not already loaded
-(or paren-dont-load-timer
-    (featurep 'timer)
-    (condition-case ()
-        (require 'timer)
-      (error nil)))
-
-(provide 'mic-paren)
-(provide 'paren)
-
-;;; mic-paren.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/mode-motion+.el b/xemacs-packages/lisp/edit-utils/mode-motion+.el
deleted file mode 100644
index ddb05b54..00000000
--- a/xemacs-packages/lisp/edit-utils/mode-motion+.el
+++ /dev/null
@@ -1,2203 +0,0 @@
-;;   -*- Syntax: Emacs-Lisp; Mode: emacs-lisp -*-
-;;
-;; Per mode and per buffer mouse tracking with highlighting
-;;
-;; Copyright (C) 1992, 1993 by Guido Bosch 
-
-;; This file is written in GNU Emacs Lisp, It is a part of XEmacs.
-
-;; The software contained in 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.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-;;
-;;; Synched up with: Not in FSF.
-
-;; Please send bugs and comments to Russell.Ritchie@gssec.bt.co.uk or
-;;                                  tlp00@spg.amdahl.com.
-;;
-;; 
-;; This program is still under development.  Neither the author nor any
-;; of the maintainers accepts responsibility to anyone for the consequences of
-;; using it or for whether it serves any particular purpose or works
-;; at all.
-
-; Change History
-; Revision 3.16 Fri Jun 28 13:01:12 1996 ritchier@msc.ie
-; Stop multiple highlighting lossage with 19.14 release.
-
-; Revision 3.15 Thu Feb 15 14:26:34 GMT 1996 Russell.Ritchie@gssec.bt.co.uk
-; lisp-interaction-popup-menu => lisp-interaction-mode-popup-menu,
-; emacs-lisp-popup-menu => emacs-lisp-mode-popup-menu.
-
-; Revision 3.14 Tue Nov 14 11:14:38 GMT 1995 Russell.Ritchie@gssec.bt.co.uk
-; Made nil the default value for mode-motion-focus-on-window.  Too many people
-; hate it when the cursor warps into Dired and GNUS buffers because some
-; window managers auto-raise the window with keyboard focus with predictably
-; nauseous results.
-
-; Revision 3.13 Thu Sep 14 10:30:04 1995 Russell.Ritchie@gssec.bt.co.uk
-; Fix the `spontaneous scrolling' problem (at last).  It's funny how
-; easy things are once you actually understand the issues involved.
-; As ever, what we sought was the right question...
-
-; Revision 3.12 Wed Jul 12 11:30:43 1995 Russell.Ritchie@gssec.bt.co.uk
-; Track `don't highlight non-file lines in dired buffers' functionality (in a
-; pretty tasteless manner if I say so myself :-)).
-
-; Revision 3.11 Fri Jul  7 16:26:56 1995 Russell.Ritchie@gssec.bt.co.uk
-; Minor extent detaching bug fix.
-
-; Revision 3.10 Thu Jun 15 11:36:56 1995 Russell.Ritchie@gssec.bt.co.uk
-; Quiet, faster, non-interactive initialistion, mild list-motion-handlers
-; chrome and minor formatting clean-ups.
-
-; Revision 3.9 Thu Jun 15 11:36:56 1995 Russell.Ritchie@gssec.bt.co.uk
-; Fixed the `mouse-motion whilst reading filename in minibuffer auto-ftp' bug.
-
-; Revision 3.8 Thus Mar 23 1995 tlp00@spg.amdahl.com
-; added in menu controls from paquette@atomas.crim.ca
-; re-added minibuffer support (from 3.5)
-;
-; Revision 3.7 Tue Feb 21 11:06:38 1995 Russell.Ritchie@gssec.bt.co.uk
-; Extended mode-motion+-religion and made the defaulting frame-buffer aware.
-; Reworked and added new mode-motion-handlers.
-; Doc string clean up.
-; Fixed unintentional frame/screen reversion.
-
-; Revision 3.6 Mon Feb 20 11:46:32 1995 Russell.Ritchie@gssec.bt.co.uk
-; Made mouse tracking use mode-motion-hook for better integration with
-; the default mouse-motion system (help-echo and friends now work).
-
-; Revision 3.5 1995/02/16 13:40:00 tlp00@spg.amdahl.com
-; fixed sporatic scroll bug
-; added M-button2 binding for mode-motion-copy
-;
-; Revision 3.4 1995/02/14 14:30:15 Russell.Ritchie@gssec.bt.co.uk
-; Small code cleanups: let* -> let, duplicate defvars.
-; Chromed list-motion-handlers a little.
-; Added variable mode-motion+-religion for easy choice twixt underline & bold.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;tlp00 changes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-; tlp00@spg.amdahl.com 2/11/93
-; modified mode-motion-track-pointer to move cursor cross windows
-;          renamed mode-motion-delete to mode-motion-kill to follow kill
-;            convention
-;          mode-motion-highlight-with-handler to put cursor at beginning of line 
-;            follow operations.
-;          mode-motion-copy/delete and mode-motion-kill to position cursor at 
-;            delete point start.  Also set this-command to avoid appends
-; set mode-motion-extent priority to 1, so it will override font-lock
-; changed default handlers for buffer-mode, c-mode, dired-mode, added occur 
-;   and compilation mode.
-; fixed bug in minibuffer-selection-boundaries where C-g was leaving the wrong
-;   syntax table.
-; added support for pending-delete.
-; adds the copy/delete motion-extent to the clipboard even if kill-hooks is nil.
-;
-; Revision 3.3 1995/02/13 tlp00@spg.amdahl.com
-; merged Russell.Ritchie@gssec.bt.co.uk versions with molli/bosch versions
-; renamed versioning 3.0+ for molli/bosch versions.  
-;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Russell Ritchie changes;;;;;;;;;;;;;;;;;;;;;;;;
-; !Log: mode-motion+.el,v !
-; Revision 2.14.R  1994/09/09  10:19:18  rieke@darmstadt.gmd.de
-; Merged in my changes to support motion-gray. This needs a file
-; named "gray1.xbm" in your data-directory (etc) like the following.
-; -------------------------------snip--------------------------
-; #define bg2_width 16
-; #define bg2_height 16
-; static char bg2_bits[] = {
-;   0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00,
-;   0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00,
-;   0x55, 0x55, 0x00, 0x00, 0x55, 0x55, 0x00, 0x00};
-; -------------------------------snip--------------------------
-; This one looks good on SUN 19'' screens with 10x20 font, 
-; black foreground and khaki background. 
-; To use the gray-handlers instead of the underline-handlers
-; include the following into your .emacs:
-; (set-mode-motion-handler 'emacs-lisp-mode 'gray-thing)
-; (set-mode-motion-handler 'lisp-interaction-mode 'gray-thing)
-; (set-mode-motion-handler 'c++-mode 'gray-c)
-; (set-mode-motion-handler 'c-mode 'gray-c)
-; (set-mode-motion-handler 'tcl-mode 'gray-tcl)
-; (set-mode-motion-handler 'dired-mode 'gray-line@)
-; (set-mode-motion-handler 'gnus-group-mode 'gray-vline@)
-; (set-mode-motion-handler 'gnus-summary-mode 'gray-vline@)
-; (set-mode-motion-handler 'texinfo-mode 'gray-Texinfo)
-; (setq default-motion-handler (find-motion-handler 'gray-thing))
-;
-;
-; Revision 2.13.R  1994/08/08  19:47:34  Russell.Ritchie@gssec.bt.co.uk
-; Made default handler be underline-thing, as most bold fonts seem to
-; be greater in height than their corresponding normal versions,
-; causing irritating screen flicker.
-;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Molli/bosch changes;;;;;;;;;;;;;;;;;;;;;;;;
-;
-; Revision 3.2  1994/09/28  15:14:29  molli
-; add   "(set-mode-motion-handler 'latex-mode   'raise-LaTeX)".    Barry
-; Waraw's C/C++ mode is now changed to cc-mode ...
-;
-; Revision 3.1  1994/09/28  15:10:36  molli
-; Initial revision
-;
-; Revision 2.15  1993/11/18  08:13:28  bosch
-; Constant `mode-motion+-version' added.
-; Minor bug fix in `tcl-forward-sexp1'.
-;
-; Revision 2.14  1993/10/29  20:04:59  bosch
-; Minibuffer name matching improved.  Made `tcl-boundaries' smarter by
-; use of new function `tcl-forward-sexp1'. `tcl-commands' list updated
-; -- should be complete now.  A message is printed if the syntax scanner
-; matched or failed for known tcl/tk commands.  Separated `tcl-commands'
-; from `tk-commands' -- `tk-commands' not yet complete.  New motion
-; handler `raise-LaTeX' added, for tex-mode.
-;
-; Revision 2.13  1993/10/08  09:43:00  bosch
-; New user option `mode-motion-setup-cut-and-paste-bindings'.  Function
-; `mode-motion-copy/delete' now takes into account the primary and the
-; motion selection.
-;
-; Revision 2.12  1993/10/08  09:08:46  bosch
-; Avoid highlighting empty lines, even if
-; `mode-motion-highlight-lines-when-behind' is non-nil.
-
-; Revision 2.12  1994/07/07  18:33:38  Russell.Ritchie@gssec.bt.co.uk
-; Made list-motion-handlers and mode-motion-set-handler work in lemacs-19.10.
-; 
-; Revision 2.11  1993/09/20  08:29:15  bosch
-; Code reorganized: variables declared before used.
-; Compatibility hack patched again.
-;
-; Revision 2.10  1993/09/17  18:50:33  bosch
-; Bug in the compatibility hack fixed. Call to `make-cursor' replaced by
-; `x-pointer-cache'. Compatibility hack for Lemacs 19.8 removed.  Tcl
-; motion handler improved (needs still some work).
-;
-; Revision 2.9  1993/09/15  17:52:53  bosch
-; Compatibility patch for Lucid Emacs 19.8. tcl motion handler added.
-;
-; Revision 2.8  1993/08/27  15:17:07  bosch
-; Select window conflict between motion handlers and process filters
-; resolved by using `enqueue-eval-event' for selecting a different
-; window (functions `mode-motion-track-pointer' and
-; `mode-motion-highlight-with-handler' modified). This fixes the nasty
-; bug that made GNUS hanging during NNTP activity while the mouse was
-; moved.
-;
-; Revision 2.7  1993/08/27  12:50:10  bosch
-; TeX and LaTeX motion handler generalized.  Motion handler
-; `highlight-Texinfo' added.
-;
-; Revision 2.6  1993/06/24  11:58:52  bosch
-; Mode motion+ support for pcl-cvs added. #undef syntax for C added.
-;
-; Revision 2.5  1993/06/09  12:04:31  bosch
-; Delivery motion handlers for `c++-c-mode', `gnus-group-mode', and
-; `gnus-summary-mode' added. Mode motion commands bound to copy/cut/past
-; keys for Sun keyboards (f16, f18, f20). Comment added.
-;
-; Revision 2.4  1993/02/15  12:59:47  bosch
-; Modifications sent by Tibor Polgar integrated:
-; Optional parameter added to `mode-motion-copy/delete'.  User option
-; `mode-motion-focus-on-window' added. It controls window selection for
-; the motion handlers. Minor changes of the delivery motion handlers.
-;
-; Revision 2.3  1993/02/04  18:10:09  bosch
-; User option `mode-motion-minibuffer-completion' added. It controls
-; the minibuffer completion highlighting.
-;
-; Revision 2.2  1993/01/27  13:08:12  bosch
-; Improved clearing of `sticky' mode-motion-extents when leaving screen
-; or buffer.  Function `mode-motion-clear-extent' added.
-; Highlight line mouse cursor is behind.
-; `mode-motion-highlight-with-handler' now takes an event as argument.
-; Cut and paste functions renamed and rewritten. Now they are called:
-; `mode-motion-move', `mode-motion-delete', `mode-motion-copy',
-; `mode-motion-copy-as-kill'.  Bug fixes in the C scanner stuff.
-; Motion handler `underline-c' added.
-;
-; Revision 2.1  1993/01/19  18:29:58  bosch
-; Scanner and motion handler for C syntax added.
-; Function `set-default-motion-handler' added.
-; Minor improvements on the `list-motion-handlers' interface done.
-; Minor bug fixes.
-;
-; Revision 2.0 1993/01/14   19:17:29  bosch
-; Lot of things rewritten and reorganized. This version fits in only
-; one file (beside the required package thing.el).
-;
-; New basic features are:
-;  - buffer, mode and default motion handlers
-;  - easy composition of own motion handlers
-;  - listing of motion handlers in tabular form
-;  - menu interface for changing motion handlers
-;  - only two  elisp files: mode-motion+.el, thing.el
-; 
-
-(require 'thing)
-(require 'mode-motion)
-(defconst mode-motion+-version "3.16")
-
-;;; This file defines a set of mouse motion handlers that do some
-;;; highlighting of the text when the mouse moves over.
-;;; An exhaustive list of the motion handlers defined in this file may be
-;;; obtained with M-x list-motion-handlers.
-;;; User Options and their Custommisation
-;;;
-;;; Mode-motion+ provides four user options, defined beyond. See their
-;;; documentation string to know what they are good for. If you want
-;;; to modify their default values, just setq them in your ~/.emacs.
-
-(defvar mode-motion+-religion nil ; Initialised in mode-motion-init.
-  "*Default highlight religion: one of bold, gray, highlight, invert or underline.
-
-Unless you setq this otherwise, it defaults to underline when
-(x-display-color-p) is non-nil and invert otherwise.
-Setting it to 'highlight should cause mode-motion+ extents to be
-indistinguishable from any other type of highlighted extent which may or may
-not be advisable, depending on your point of view.")
-
-(defvar mode-motion-highlight-lines-when-behind t
-  "*If non-nil highlight the whole line if the mouse is past the end.")
-
-(defvar mode-motion-focus-on-window nil
-  "*Controls whether moving the mouse into another window selects this window.
-The following values are possible:
- 
-nil	  - Window selection isn't influenced at all by mode motion.
-
-t	  - Window selection always follows the mouse cursor. Copying motion
-            active regions doesn't work any longer between different buffers.
-	    
-any other - window selection follows the mouse cursor if the motion handler
-	    of the buffer under the mouse has the follow-point property set.
-	    Useful for selecting line mode buffers just by moving the mouse
-	    inside in order to execute commands there (VM summary,
-	    GNUS Group and Subject, DIRED, Buffer menu etc.)")
-
-(defvar mode-motion-setup-cut-and-paste-bindings t
-  "*If non-nil, bind commands to the Copy, Paste and Cut keys.")
-
-;;  Options sub-menu for mode-motion+
-(defvar mode-motion+-options-menu 
-  '("Motion Highlighting"
-    "For Current Buffer"
-    "---"
-    ["None"
-     (progn
-       (set-buffer-motion-handler (current-buffer) 'no-thing)
-       (mode-motion-clear-extent))
-     :style radio
-     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
-		   'no)
-     :active (mode-motion+-active-p)]
-    ["Bold"
-     (progn
-       (modify-buffer-motion-handler (current-buffer) 'bold))
-     :style radio
-     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
-		   'bold)
-     :active (mode-motion+-active-p)]
-    ["Underline"
-     (progn
-       (modify-buffer-motion-handler (current-buffer) 'underline))
-     :style radio
-     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
-		   'underline)
-     :active (mode-motion+-active-p)]
-    ["Gray"
-     (progn
-       (modify-buffer-motion-handler (current-buffer) 'gray))
-     :style radio
-     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
-		   'gray)
-     :active (mode-motion+-active-p)]
-    ["Highlight"
-     (progn
-       (modify-buffer-motion-handler (current-buffer) 'highlight))
-     :style radio
-     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
-		   'highlight)
-     :active (mode-motion+-active-p)]
-    ["Invert"
-     (progn
-       (modify-buffer-motion-handler (current-buffer) 'invert))
-     :style radio
-     :selected (eq (mode-motion+-buffer-handler-religion (current-buffer))
-		   'invert)
-     :active (mode-motion+-active-p)]
-    "---"
-    "For Current Mode"
-    "---"
-    ["None"
-     (progn
-       (set-mode-motion-handler major-mode 'no-thing)
-       (mode-motion-clear-extent))
-     :style radio
-     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'no)
-     :active (mode-motion+-active-p)]
-    ["Bold"
-     (progn
-       (modify-mode-motion-handler major-mode 'bold))
-     :style radio
-     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'bold)
-     :active (mode-motion+-active-p)]
-    ["Underline"
-     (progn
-       (modify-mode-motion-handler major-mode 'underline))
-     :style radio
-     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'underline)
-     :active (mode-motion+-active-p)]
-    ["Gray"
-     (progn
-       (modify-mode-motion-handler major-mode 'gray))
-     :style radio
-     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'gray)
-     :active (mode-motion+-active-p)]
-    ["Highlight"
-     (progn
-       (modify-mode-motion-handler major-mode 'highlight))
-     :style radio
-     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'highlight)
-     :active (mode-motion+-active-p)]
-    ["Invert"
-     (progn
-       (modify-mode-motion-handler major-mode 'invert))
-     :style radio
-     :selected (eq (mode-motion+-mode-handler-religion major-mode) 'invert)
-     :active (mode-motion+-active-p)]
-    "---"
-    "For All"
-    "---"
-    ["None"
-     (progn
-       (setq mode-motion+-religion 'no)
-       (mode-motion-init-handlers-according-to-religion 'force)
-       (mode-motion-clear-extent))
-     :style radio
-     :selected (eq mode-motion+-religion 'no)
-     :active (mode-motion+-active-p)]
-    ["Bold"
-     (progn
-       (setq mode-motion+-religion 'bold)
-       (mode-motion-init-handlers-according-to-religion 'force))
-     :style radio
-     :selected (eq mode-motion+-religion 'bold)
-     :active (mode-motion+-active-p)]
-    ["Underline"
-     (progn
-       (setq mode-motion+-religion 'underline)
-       (mode-motion-init-handlers-according-to-religion 'force))
-     :style radio
-     :selected (eq mode-motion+-religion 'underline)
-     :active (mode-motion+-active-p)]
-    ["Gray"
-     (progn
-       (setq mode-motion+-religion 'gray)
-       (mode-motion-init-handlers-according-to-religion 'force))
-     :style radio
-     :selected (eq mode-motion+-religion 'gray)
-     :active (mode-motion+-active-p)]
-    ["Highlight"
-     (progn
-       (setq mode-motion+-religion 'highlight)
-       (mode-motion-init-handlers-according-to-religion 'force))
-     :style radio
-     :selected (eq mode-motion+-religion 'highlight)
-     :active (mode-motion+-active-p)]
-    ["Invert"
-     (progn
-       (setq mode-motion+-religion 'invert)
-       (mode-motion-init-handlers-according-to-religion 'force))
-     :style radio
-     :selected (eq mode-motion+-religion 'invert)
-     :active (mode-motion+-active-p)]
-    "---"
-    ["Minibuffer highlighting" (setq mode-motion-use-minibuffer-motion-handler
-				     (not mode-motion-use-minibuffer-motion-handler))
-     :style toggle :selected mode-motion-use-minibuffer-motion-handler]
-     
-    ["Customize..."
-     (list-motion-handlers)
-     t
-     ;;     nil
-     ]
-     ["Revert Customization"
-     (call-interactively 'mode-motion+-motion-hook-revert)
-     (and (boundp 'mode-motion+-previous-hook) mode-motion+-previous-hook)
-     ])
-  "Menu for changing mode-motion+ religion and other things.")
-
-(defun mode-motion+-active-p ()
-  (cond ((symbolp mode-motion-hook)
-	 (eq mode-motion-hook 'mode-motion+-highlight))
-	((listp mode-motion-hook)
-	 (memq 'mode-motion+-highlight mode-motion-hook))
-	(t nil)))
-     
-(defun mode-motion+-buffer-handler-religion (buffer)
-  (let* ((current-handler-name (symbol-name (motion-handler-name
-					     (get-current-motion-handler))))
-	 (religion-name (substring current-handler-name
-				   0
-				   (string-match "-" current-handler-name))))
-    (intern-soft religion-name)))
-
-(defun mode-motion+-mode-handler-religion (buffer)
-  (let* ((mode-handler (or (get major-mode 'mode-motion-handler)
-			   default-motion-handler))
-	 (current-handler (symbol-name (motion-handler-name mode-handler)))
-	 (religion (substring current-handler
-			      0
-			      (string-match "-" current-handler))))
-    (intern-soft religion)))
-
-(defun modify-buffer-motion-handler (buffer religion)
-  (let* ((current-handler (symbol-name (motion-handler-name
-					     (get-current-motion-handler))))
-	 (suffix (substring current-handler
-			    (string-match "-" current-handler))))
-    (set-buffer-motion-handler buffer
-			       (intern-soft (concat (symbol-name religion)
-						    suffix)))))
-
-(defun modify-mode-motion-handler (mode religion)
-  (let* ((mode-handler (or (get major-mode 'mode-motion-handler)
-			   default-motion-handler))
-	 (current-handler (symbol-name (motion-handler-name mode-handler)))
-	 (suffix (substring current-handler
-			    (string-match "-" current-handler))))
-    (set-mode-motion-handler mode (intern-soft (concat (symbol-name
-							religion)
-						       suffix)))))
-
-;;;; This does not work.  I would like to be able to modify in-place
-;;;; the non-selectable items, but I don't know how.
-;;;; --paquette, Wed Mar  8 23:32:32 1995 (Marc Paquette) 
-;;; Sensitize the mode motion+ options submenu, a la
-;;; sensitize-file-and-edit-menus-hook.
-(defun mode-motion+-sensitize-options-menu-hook ()
-  "Hook function that will adjust title items in the mode-motion+ submenu in Options"
-  (let* ((mm+-menu (cdr (car (find-menu-item
-			      current-menubar
-			      '("Options" "Motion Highlighting")))))
-	 (buffer-item (find-menu-item mm+-menu '("For Current Buffer")))
-	 (mode-item (find-menu-item mm+-menu '("For Current Mode"))))
-    (setcar buffer-item (format "For Buffer `%s'" (buffer-name nil)))
-    (setcar mode-item (format "For Mode `%s'" major-mode))
-    nil))
-
-;;(add-hook 'activate-menubar-hook 'mode-motion+-sensitize-options-menu-hook)
-  
-
-;;  Motion Handler Format:
-;;      
-;; A motion handler is vector with the following format 
-;; [ 		       	- a symbol
-;;   - a function or name of function 
-;;				  that returns ( . ) 
-;;				  or nil.
-;;  		- as it says ...
-;;  		- non-nil means that the motion extent
-;;				  will be highlighted using the function 
-;;				  `highlight-extent'
-;;  		- non-nil means that point will follow the
-;;				  mouse motion. 
-;; ]
-
-;; accessor functions
-(defsubst motion-handler-name (handler) (aref handler 0))
-(defsubst motion-handler-boundary-function (handler) (aref handler 1))
-(defsubst motion-handler-face (handler) (aref handler 2))
-(defsubst motion-handler-highlight (handler) (aref handler 3))
-(defsubst motion-handler-follow-point (handler) (aref handler 4))
-
-;; modifier functions
-(defsubst set-motion-handler-boundary-function (handler x) (aset handler 1 x))
-(defsubst set-motion-handler-face (handler x) (aset handler 2 x))
-(defsubst set-motion-handler-highlight (handler x) (aset handler 3 x))
-(defsubst set-motion-handler-follow-point (handler x) (aset handler 4 x))
-
-;; Internal global variables 
-(defvar motion-handler-alist ()
-  "Alist with entries of the form \( . \).")
-
-;; Minibuffer motion handler
-(defvar mode-motion-use-minibuffer-motion-handler t
-  "*Enable mousable highlighting when the minibuffer is active. When false only extents with the
-highlight property are selectable (*Completion*)")
-
-(defvar mode-motion-extent nil)
-(make-variable-buffer-local 'mode-motion-extent)
-(defvar buffer-motion-handler nil)
-(make-variable-buffer-local 'buffer-motion-handler)
-(defvar mode-motion-last-extent nil "The last used mode motion extent.")
-(defvar default-motion-handler nil)	; Initialised in mode-motion-init.
-
-;; Creation of motion handlers
-
-(defun find-motion-handler (name)
-  (or (symbolp name)
-      (setq name (intern-soft name)))
-  (cdr (assq name motion-handler-alist)))
-
-;; internal motion handler creator
-(defsubst make-motion-handler-internal 
-  (name boundary-function face highlight follow-cursor)
-  (vector name boundary-function (get-face face) highlight follow-cursor))
-
-(defun make-motion-handler 
-  (name boundary-function &optional face highlight follow-cursor)
-  "Create a motion handler named NAME (a symbol or string) using REGION-FUNCTION.
-
-REGION-FUNCTION is the function that computes the region to be highlighted. 
-Optional arguments are: 
-
-FACE: A face or face name to be used to highlight the region computed
-      by REGION-FUNCTION.  'default is the default.
-      
-HIGHLIGHT: Flag that indicates whether the highlight attribute of the
-      mode-motion-extent should be set or not. If FACE is the default face, 
-      HIGHLIGHT defaults to t, otherwise to nil.
-
-FOLLOW-CURSOR: Flag that indicates whether the cursor should follow
-      the mouse motion. Default is nil."
-
-  ;; required arguments
-  (or name (error "motion handler name required."))
-  (or (symbolp name) 
-      (stringp name)
-      (error "motion handler name must be a string or symbol: %s" name))
-  (or boundary-function 
-      (error "motion handler region function required."))
-  (or (fboundp boundary-function)
-      (error "not a function: %s." boundary-function))
-  ;; defaults
-  (or face (setq face 'default))
-  
-  ;; store the mode motion handler on the 'mode-motion-handler property of
-  ;; its name symbol
-  (let ((old-handler (cdr (assq name motion-handler-alist)))
-	new-handler)
-    (if old-handler
-	(progn 
-	  (set-motion-handler-boundary-function old-handler boundary-function)
-	  (set-motion-handler-face old-handler (get-face face))
-	  (set-motion-handler-highlight old-handler highlight)
-	  (set-motion-handler-follow-point old-handler follow-cursor))
-      (setq motion-handler-alist 
-	    (cons (cons name 
-			(setq new-handler (make-motion-handler-internal
-					   name
-					   boundary-function
-					   (get-face face)
-					   highlight
-					   follow-cursor)))
-		  motion-handler-alist)))
-    (or old-handler new-handler)))
-
-(defvar list-motion-handlers-buffer-to-customize nil
-  "Name of buffer from where list-motion-handlers was called.")
-(make-variable-buffer-local 'list-motion-handlers-buffer-to-customize)
-(defvar list-motion-handlers-buffer-mode nil
-  "Name of mode of buffer from where list-motion-handlers was called.")
-(make-variable-buffer-local 'list-motion-handlers-buffer-mode)
-;; Listing available motion handlers in tabular form. 
-      
-(defvar basic-motion-handlers (list 'mode-motion-highlight-line
-				    'mode-motion-highlight-word
-				    'mode-motion-highlight-symbol
-				    'mode-motion-highlight-sexp)
-  "The basic motion handlers provided by the underlying XEmacs.")
-
-(defun list-motion-handlers ()
-  "Display a list of available motion handlers.
-The listing is in tabular form and contains the following columns:
-NAME: the motion handlers name,
-BOUNDARY FUNCTION: the name of the function used to compute the text  
-   highlighted by the motion handler,
-FACE: the face used to highlight the text.
-
-Additionally, the following flags are used at the beginning of each line:
-`*' Marks the motion handler current to the buffer this functions was called 
-    from.
-`H' Force highlighting of the selected text.
-`F' Make point follow the mouse cursor as it moves."
-  (interactive)
-  (let ((current-handler (get-current-motion-handler))
-	(buffer (current-buffer))
-	(buffer-mode major-mode)
-	(bmmh (if (symbolp mode-motion-hook)
-		  (car (memq mode-motion-hook basic-motion-handlers))
-		(if (and (listp mode-motion-hook) 
-			 (equal 1 (length mode-motion-hook)))
-		    (car (memq (car mode-motion-hook)
-			       basic-motion-handlers))))))
-    (save-excursion
-      (with-output-to-temp-buffer "*Mouse Motion Handlers*"
-	(let ((truncate-lines t))
-	  (set-buffer "*Mouse Motion Handlers*")
-	  (setq list-motion-handlers-buffer-to-customize buffer)
-	  (setq list-motion-handlers-buffer-mode buffer-mode)
-	  (let ((pos1 5)
-		(pos2 25)
-		(pos3 50)
-		(handlers 
-		 (sort 
-		  (mapcar 'cdr motion-handler-alist)
-		  '(lambda (x y)
-		     (string<
-		      (symbol-name (motion-handler-boundary-function x))
-		      (symbol-name (motion-handler-boundary-function y)))))))
-	    (if bmmh
-		(let ((i 1)
-		      (fw (frame-width)))
-		  (while (< i fw)
-		    (princ "*")
-		    (setq i (1+ i)))
-		  (princ "\nNote: this buffer is not using mode-motion+.\n\n")
-		  (princ "It's using the `")
-		  (princ bmmh)
-		  (princ "' motion handler which claims it's:\n")
-		  (insert (documentation bmmh))
-		  (princ "\nSetting this motion handler will be irrevocable from this interface\n(but only for duration of this XEmacs session).\n")
-		  (setq i 1)
-		  (while (< i fw)
-		    (princ "*")
-		    (setq i (1+ i)))
-		  (terpri)))
-	    (princ "     NAME                BOUNDARY FUNCTION        FACE\n")
-	    (princ "     ----                -----------------        ----\n")
-	    (mapcar 
-	     #'(lambda (handler)
-		 (let ((line-start (point)))
-		   (princ (if (and (not bmmh) (eq handler current-handler))
-			      "*" " "))
-		   (princ (if (eq handler default-motion-handler) "D" " "))
-		   (princ (if (motion-handler-highlight handler) "H" " "))
-		   (princ (if (motion-handler-follow-point handler) "F" " "))
-		   (indent-to-column pos1 1)
-		   (princ (motion-handler-name handler))
-		   (indent-to-column pos2 1)
-		   (princ (motion-handler-boundary-function handler))
-		   (indent-to-column pos3)
-		   (let ((face-start (point)))
-		     (princ (face-name (motion-handler-face handler)))
-		     (let ((line-extent (make-extent line-start face-start))
-			   (face-extent (make-extent face-start (point))))
-		     (set-extent-face face-extent
-				      (motion-handler-face handler))
-		     (set-extent-property
-		      face-extent
-		      'mode-motion-handler (motion-handler-name handler))
-		     (set-extent-property
-		      line-extent
-		      'mode-motion-handler (motion-handler-name handler))
-		     (set-extent-property line-extent 'highlight t)))
-		 (terpri)))
-	     handlers)
-	    (princ (format "
-Flags:	`D' the default motion handler
-       	`H' handler with highlighting
-	`F' handler with `following' property
-	`*' the motion handler of buffer \"%s\""
-			   list-motion-handlers-buffer-to-customize))))
-	(local-set-key 'button3 'mode-motion-set-handler)
-	(setq buffer-read-only t)))))
-
-(defun mode-motion-set-handler (event)
-  (interactive "@e")
-  (let* ((handler (or (extent-property
-		       (extent-at (event-point event) (current-buffer)
-				  'mode-motion-handler)
-		       'mode-motion-handler)
-		      (error "Click on highlighted line to select a handler")))
-	 (menu (list
-		(format "Make `%s' the Motion Handler of :" handler)
-		(vector (format "Buffer %s"
-				list-motion-handlers-buffer-to-customize)
-			(` (set-buffer-motion-handler
-			    '(, list-motion-handlers-buffer-to-customize)
-			    '(, handler))) t)
-		(vector "Another Buffer..."
-			(` (motion-handler-list-set-buffer-handler
-			    '(, handler))) t)
-		"---"
-		(vector (format "Mode %s"
-				list-motion-handlers-buffer-mode)
-			(` (progn
-			     (set-mode-motion-handler
-			      '(, list-motion-handlers-buffer-mode)
-			      '(, handler))
-			     (save-excursion
-			       (mapcar
-				(function
-				 (lambda (buf)
-				   (set-buffer buf)
-				   (and (eq
-					 '(, list-motion-handlers-buffer-mode)
-					 major-mode)
-					(mode-motion+-hook-install buf t))))
-				       (buffer-list))))) t)
-		(vector "Another Mode..."
-			(` (motion-handler-list-set-mode-handler
-			    '(, handler))) t)
-		"---"
-		(vector "Default Motion Handler"
-			(` (set-default-motion-handler '(, handler))) t))))
-    (popup-menu menu)))
-
-(defun motion-handler-list-set-buffer-handler (handler)
-  (let ((buffer (read-buffer-name 
-		 (format "Make `%s' the motion handler of buffer: " handler)
-		 (buffer-name list-motion-handlers-buffer-to-customize))))
-    (set-buffer-motion-handler buffer handler)
-    (save-excursion
-      (set-buffer buffer)
-      (and (not (cond ((listp mode-motion-hook)
-		       (memq 'mode-motion+-highlight mode-motion-hook))
-		      ((symbolp mode-motion-hook)
-		       (eq 'mode-motion+-highlight mode-motion-hook))
-		      (t t)))
-	   (y-or-n-p (format "Augment the default mode motion hook for `%s'? "
-			     (buffer-name nil)))
-	   (mode-motion+-hook-install buffer t)))))
-
-(defvar mode-motion+-previous-hook nil
-  "Value of previous `mode-motion-hook' in current buffer.")
-(make-variable-buffer-local 'mode-motion+-previous-hook)
-
-(defun motion-handler-list-set-mode-handler (handler)
-  (let ((mode (intern (completing-read
-	    (format "Make `%s' the motion handler of mode: " handler)
-	    obarray
-	    'fboundp
-	    t	
-	    (symbol-name list-motion-handlers-buffer-mode)))))
-    (set-mode-motion-handler mode handler)
-  (save-excursion
-    (mapcar (function
-	     (lambda (buf)
-	       (set-buffer buf)
-	       (and (eq mode major-mode)
-		    (mode-motion+-hook-install buf t))))
-	    (buffer-list)))))
-
-(defun mode-motion+-hook-install (&optional buffer remove-highlight-line-p)
-  "Add `mode-motion+-highlight' to the BUFFER `mode-motion-hook'.
-If the optional second arg REMOVE-HIGHLIGHT-LINE-P is t, remove
-`mode-motion-highlight-line' from `mode-motion-hook'.
-See `mode-motion+-hook-uninstall' for reverting this operation."
-  (interactive "bInstall mode-motion+ hook for buffer :
-XRemove highlight-line from hook ? :")
-  ;; Check for the mode-motion-hook value to make sure it's under
-  ;; the control of mode-motion+.
-  ;; The reasonning here is that if the user went trough the hassles
-  ;; of list-motion-handlers (or if he's calling this directly from
-  ;; his .emacs) , he is prepared to give up on the current
-  ;; mode-motion-hook.
-  ;; However, we keep the previous hook value in a buffer-local
-  ;; variable: it will be then possible to revert to the old motion
-  ;; handling behavior with `mode-motion+-hook-uninstall'.
-  ;; --paquette, Mon Feb 27 08:54:30 1995 (Marc Paquette)
-  (setq buffer (or buffer (current-buffer)))
-  ;; force the uninstall of mode-motion-highlight since if its second
-  ;; you'll never see ours.
-  (setq remove-highlight-line-p t)
-  (save-excursion
-    (set-buffer buffer)
-    (if (boundp 'mode-motion-hook)
-	(progn
-	  (setq mode-motion+-previous-hook
-		(cond ((sequencep mode-motion-hook)
-		       (copy-sequence mode-motion-hook))
-		      (t mode-motion-hook)))
-	  ;; Make sure that the mode-motion+-highlight is not saved in
-	  ;; the variable, otherwise, we could not revert back to the
-	  ;; "factory settings" after having played with different
-	  ;; handlers
-	  ;; --paquette, Mon Feb 27 08:54:21 1995 (Marc Paquette)
-	  (remove-hook 'mode-motion+-previous-hook 'mode-motion+-highlight)))
-    (add-hook 'mode-motion-hook 'mode-motion+-highlight)
-    (and remove-highlight-line-p
-	 ;; Remove the standard mode-motion-highlight hook because we
-	 ;; provide an alternative to this.  I don't use setq here because
-	 ;; something else could be hooked to mode-motion-hook.
-	 ;; --paquette, Mon Feb 27 08:53:51 1995 (Marc Paquette)
-	 (remove-hook 'mode-motion-hook 'mode-motion-highlight-line))
-    (and mode-motion-extent
-	 (delete-extent mode-motion-extent)
-	 (setq mode-motion-extent nil))
-    ;; Try to make this installed for any buffer of this mode
-    (let ((this-mode-hook (intern-soft (concat (symbol-name major-mode)
-					       "-hook"))))
-      (and (boundp this-mode-hook)
-	   (if remove-highlight-line-p
-	       (add-hook this-mode-hook
-			 #'(lambda () (mode-motion+-hook-install nil t))
-			 'append)
-	     (add-hook this-mode-hook 'mode-motion+-hook-install 'append)))))
-  mode-motion-hook)
-
-(defun mode-motion+-hook-uninstall (buffer)
-  "Restore the value of `mode-motion-hook' in BUFFER to what it was at the time `mode-motion+-hook-install' was called.
-See also `mode-motion+-hook-install'."
-  (interactive "bRestore `mode-motion-hook' of buffer :")
-  ;; Check for the mode-motion-hook value to make sure it's under
-  ;; the control of mode-motion+.
-  ;; The reasonning here is that if the user went trough the hassles
-  ;; of list-motion-handlers (or if he's calling this directly from
-  ;; his .emacs) , he is prepared to give up on the current
-  ;; mode-motion-hook.
-  ;; However, we keep the previous hook value in a buffer-local
-  ;; variable: it will be then possible to revert to the old motion
-  ;; handling behavior with `mode-motion+-hook-uninstall'.
-  ;; --paquette, Mon Feb 27 08:54:30 1995 (Marc Paquette)
-  (save-excursion
-    (set-buffer buffer)
-    (and mode-motion-extent
-	 (delete-extent mode-motion-extent)
-	 (setq mode-motion-extent nil))
-    (if (boundp 'mode-motion+-previous-hook)
-	(progn
-	  (setq mode-motion-hook mode-motion+-previous-hook)
-	  (setq mode-motion+-previous-hook nil)
-	  (let ((this-mode-hook (intern-soft (concat (symbol-name major-mode)
-						     "-hook"))))
-	    (and (boundp this-mode-hook)
-		 (remove-hook this-mode-hook 'mode-motion+-hook-install))))
-      (error "No previous value for mode-motion-hook")))
-  mode-motion-hook)
-
-(defun mode-motion+-motion-hook-revert (&optional buffer-only-p buffer mode)
-  "Revert the `mode-motion-hook' to its original value.
-With optional arg BUFFER-ONLY-P non-nil, only revert in BUFFER
-\(defaults to `\(current-buffer\)'\); otherwise, revert for all existing
-buffers of MODE \(defaults to `major-mode' of BUFFER\)."
-  (interactive
-    (let* ((buffer-only-p
-	   (y-or-n-p "Revert mode-motion-hook only for current buffer ? "))
-	   (buffer (if buffer-only-p
-		       (current-buffer)
-		     (get-buffer (read-buffer-name
-				  "Revert mode-motion-hook of buffer : "
-				  (buffer-name (current-buffer))))))
-	   (mode (if buffer-only-p
-		     (save-excursion
-		       (set-buffer buffer)
-		       major-mode)
-		   (intern-soft (completing-read "Major mode: "
-						 obarray
-						 'fboundp	
-						 nil 
-						 (symbol-name major-mode))))))
-      (list buffer-only-p buffer mode)))
-  (if buffer-only-p
-      (mode-motion+-hook-uninstall buffer)
-    (save-excursion
-      (mapcar (function
-	       (lambda (buf)
-		 (set-buffer buf)
-		 (and (eq mode major-mode)
-		      (mode-motion+-hook-uninstall buf))))
-	      (buffer-list)))))
-  
-
-;; Setting buffer, mode and default motion handlers
-
-(defun set-buffer-motion-handler (buffer handler-name)
-  "Make the motion handler named HANDLER-NAME (a symbol) the buffer
-motion handler of BUFFER.  If HANDLER-NAME is nil, the corresponding
-buffer motion handler is removed.  If HANDLER-NAME isn't the name of a
-known motion handler, an error is signaled. When called interactively,
-completion is provided for available buffers and motion handlers.
-
-	1.\) buffer motion handler
-	2.\) mode motion handler
-	3.\) default motion handler"
-  (interactive (list (read-buffer-name "Set motion handler of buffer: "
-				       (buffer-name (current-buffer)))
-		     (read-motion-handler-name)))
-
-  ;; kill old mode motion extent, because the new handler
-  ;; might want to initialize it differently
-  (if mode-motion-extent 
-      (progn 
-	(detach-extent mode-motion-extent)
-	(setq mode-motion-extent nil)))
-  (or buffer (setq buffer (current-buffer)))
-  (or (get-buffer buffer)
-      (error "No such buffer: %s" buffer))
-  (save-excursion 
-    (set-buffer buffer)
-    (setq buffer-motion-handler
-	  ;; remove it if `nil'
-	  (and handler-name
-	       ;; set the handler if known
-	       (or (find-motion-handler handler-name)
-		   ;; error otherwise
-		   (error "Not a known motion handler: %s"
-			  handler-name)))))
-  (if (interactive-p)
-      (if handler-name
-	  (message "Motion handler for buffer %s is `%s'." 
-		   (current-buffer) handler-name)
-	  (message "Motion handler removed for buffer %s." 
-		   (current-buffer))))
-  handler-name)
-
-(defun read-buffer-name (prompt &optional initial-input)
-  (completing-read prompt
-		   (mapcar #'(lambda (buf) (list (buffer-name buf)))
-			   (buffer-list))
-		   ;; don't take buffers that start with a blank
-		   #'(lambda (list) (not (eq (aref (car list) 0) ? )))
-		   t
-		   initial-input))
-
-(defun set-mode-motion-handler (mode handler-name)
-  "Make the motion handler named HANDLER-NAME (a symbol) the mode motion
-handler for all buffers with major-mode MODE.  If HANDLER-NAME is nil,
-the corresponding mode motion handler is removed.  If HANDLER-NAME
-isn't the name of a known motion handler, an error is signaled. When
-called interactively, completion is provided for available motion
-handlers.
-
-	1.\) buffer motion handler
-	2.\) mode motion handler
-	3.\) default motion handler"
-  (interactive (list (intern (completing-read "Major mode: "
-					      obarray
-					      'fboundp	
-					      nil 
-					      (symbol-name major-mode)))
-		     (read-motion-handler-name)))
-  ;; kill old mode motion extent, because the new handler
-  ;; might want to initialize it differently
-  (if mode-motion-extent 
-      (progn 
-	(detach-extent mode-motion-extent)
-	(setq mode-motion-extent nil)))
-  (put mode 'mode-motion-handler 
-	;; remove it if `nil'
-	(and handler-name
-	     ;; set the handler if known
-	     (or (find-motion-handler handler-name)
-		 ;; error otherwise
-		 (error "Not a known mode motion handler: %s" handler-name))))
-  (if (interactive-p)
-      (if handler-name
-	  (message "Motion handler for %s is `%s'." mode handler-name)
-	  (message "Mode motion handler for %s removed." mode)))
-  handler-name)
-
-(defun set-default-motion-handler (handler-name)
-  "Make the motion handler named HANDLER-NAME (a symbol) the default.
-
-If HANDLER-NAME is nil, the current default motion handler is removed.  If
-HANDLER-NAME isn't the name of a known motion handler, an error is
-signalled. When called interactively, completion is provided for available
-motion handlers.
-
-The motion handler used in a given buffer is determined by the following
-most-specific first list: buffer motion handler, mode motion handler, default
-motion handler." 
-  (interactive (list (read-motion-handler-name)))
-  ;; kill old mode motion extent, because the new handler
-  ;; might want to initialize it differently
-  (if mode-motion-extent 
-      (progn 
-	(detach-extent mode-motion-extent)
-	(setq mode-motion-extent nil)))
-  (setq default-motion-handler
-	;; remove it if `nil'
-	(and handler-name
-	     ;; set the handler if known
-	     (or (find-motion-handler handler-name)
-		 ;; error otherwise
-		 (error "Not a known motion handler: %s" handler-name))))
-  (if (interactive-p)
-      (if handler-name
-	  (message "Default motion handler is `%s'." handler-name)
-	  (message "Default motion handler removed.")))
-  handler-name)
-
-(defun read-motion-handler-name ()
-  (intern-soft (completing-read "Motion handler: "
-				(mapcar #'(lambda (entry)
-					    (list (symbol-name (car entry))))
-					motion-handler-alist)
-				nil t)))
-
-;; clear the last active motion extent when leaving a frame.
-(defun mode-motion-clear-extent (&optional extent)
-  "Clear EXTENT, i.e. make it have no visible effects on the frame.
-EXTENT defaults to the current buffer's mode-motion-extent."
-  (or extent (setq extent mode-motion-extent))
-  (and extent 
-       (extent-live-p extent)
-       (not (extent-detached-p extent))
-       (extent-buffer extent)
-       (buffer-name (extent-buffer extent))
-       (progn 
-	 ;; unhighlight it 
-	 (highlight-extent extent nil)
-	 ;; make it span a region that isn't visible and selectable
-	 ;; Can this be done more elegantly? 
-	 (detach-extent extent))))
-
-(defun mode-motion-clear-last-extent (&optional frame)
-  "Clear the mode-motion-last-extent."
-  (or (popup-up-p) (mode-motion-clear-extent mode-motion-last-extent)))
-
-(defun mode-motion+-highlight (event)
-  "Highlight the thing under the mouse using a mode-specific motion handler.
-See list-motion-handlers for more details."
-  (mode-motion-clear-last-extent)
-  (and (event-buffer event)
-       (cond ((and mouse-grabbed-buffer
-		   ;; first try to do minibuffer specific highlighting
-		   (find-motion-handler 'minibuffer)
-		   (let ((mode-motion-highlight-lines-when-behind nil))
-		     (and (event-point event)
-			  (or (extent-at (event-point event)
-					 (event-buffer event) 'highlight)
-			      (mode-motion-highlight-with-handler
-			       (find-motion-handler 'minibuffer) event))))))
-	     (t (mode-motion-highlight-with-handler
-		 (get-current-motion-handler) event))))
-  ;; Return nil since now this is used as a hook, and we want to let
-  ;; any other hook run after us.
-  nil)
-
-(defun get-current-motion-handler ()
-  (or (and (boundp 'buffer-motion-handler) buffer-motion-handler)
-      (get major-mode 'mode-motion-handler)
-      default-motion-handler))
-
-(defun mode-motion-highlight-with-handler (handler event)
-  ;; Perform motion highlighting using HANDLER. Information about the
-  ;; current mouse position is taken form EVENT. 
-  (and handler
-       (let ((point (event-point event))
-	     (buffer (event-buffer event))
-	     (window (event-window event))
-	     (window-config (current-window-configuration))
-	     (buffer-save (current-buffer))
-	     (point-save (point))
-	     region)
-	 ;; save-window-excursion and restore buffer
-	 (unwind-protect
-	     (progn
-	       (and buffer
-		    (set-buffer buffer)
-		    (select-window window))
-	       ;; Create a new mode-motion-extent if there isn't one 
-	       ;; (or a destroyed one)
-	       (if (and (extent-live-p mode-motion-extent)
-			(extent-buffer mode-motion-extent))
-		   ()
-		 (setq mode-motion-extent (make-extent nil nil buffer))
-		 (set-extent-priority mode-motion-extent 1))
-	       (if (and 
-		    ;; compute the region to be highlighted
-		    (setq region
-			  (if point
-			      ;; compute the mode-motion region using the 
-			      ;; handlers boundary function
-			      (condition-case nil;; c
-				  (funcall
-				   (motion-handler-boundary-function handler)
-				   point)
-				;; Messages that appear during computing the
-				;; region may be displayed not done
-				;; here because it's rather disturbing
-				(error
-				 ;; (setq message (format "%s" (car (cdr c))))
-				 nil))
-			    ;; otherwise highlight the whole line mouse is
-			    ;; behind but only if the line isn't empty
-			    (if mode-motion-highlight-lines-when-behind
-				(unwind-protect
-				    (progn 
-				      ;; (message "%s" (event-window event))
-				      (move-to-window-line
-				       (if (and (= emacs-major-version 19)
-						(< emacs-minor-version 12))
-					   (- (event-y event)
-					      (nth 1 (window-edges window)))
-					 (event-y event)))
-				      (beginning-of-line)
-				      (if (= (following-char) ?\n)
-					  ;; empty line 
-					  ()
-					(thing-region
-					 (point)
-					 (progn 
-					   (end-of-line)
-					   ;; for `follow-point' behavoir
-					   (setq point (point))
-					   ;; fetch also the newline, if any
-					   ;; -- handy for copying >1 line
-					   (if (eobp) point (1+ point))))))
-				  (goto-char point-save)))))
-		    ;; (message "region: %s" region)
-		    ;; the region might be in reverse order. Stop in this case
-		    (<= (car region) (cdr region)))
-		   (if (or (not (motion-handler-follow-point handler))
-			   (pos-visible-in-window-p point))
-		       (progn
-			 (set-extent-endpoints
-			  mode-motion-extent (car region) (cdr region))
-			 (set-extent-face
-			  mode-motion-extent (motion-handler-face handler))
-			 ;; make point follow the mouse or point to
-			 ;; the beginning of the line do not move the
-			 ;; cursor if a mark is set.
-			 (cond ((and (motion-handler-follow-point handler)
-				     (not (mark)))
-				(goto-char point)
-				;; kludge to keep the cursor out the way
-				(if (or (eq (motion-handler-boundary-function
-					     handler)
-					    'line-boundaries)
-					(eq (motion-handler-boundary-function
-					     handler)
-					    'visible-line-boundaries))
-				    (beginning-of-line))))
-			 (if (and mode-motion-focus-on-window
-				  (or (eq mode-motion-focus-on-window t)
-				      (motion-handler-follow-point handler)))
-			     ;; Select the current window FROM OUTSIDE the
-			     ;; `save-window-excursion' that surrounds the call
-			     ;; to the current function. This also avoids
-			     ;; conflicts with running process filters.
-			     (enqueue-eval-event 'select-window
-						 (selected-window)))
-			 ;; snap in effect, but it ain't yet workin'
-			 ;; (message "X: %sl; Y: %s"(event-x event)(event-y event))
-			 ;; (and motion-handler-snap-in
-			 ;;    (set-mouse-position
-			 ;;    (window-frame (event-window event))
-			 ;;    (event-x event)
-			 ;;    (event-y event)))
-			 (setq mode-motion-last-extent mode-motion-extent)
-			 ;; signal success
-			 t))
-		 ;; signal failiure
-		 nil))
-	   (set-window-configuration window-config)
-	   (set-buffer buffer-save)))))
-
-;; Motion Event debugging
-;;
-;; Useful to see what information is available from motion events
-
-(defun debug-motion-handler (event)
-   (let* ((window (event-window event))
-	  (frame (or (event-frame event) (selected-frame)))
-	  (buffer (and window (event-buffer event)))
-	  (point  (and buffer (event-point event))))
-     (with-output-to-temp-buffer "*Debug Motion Handler Output*"
-       (princ 
-	(format "\
- Window: %s
- Frame: %s
- Buffer: %s
- (event-x, event-y): (%s, %s)
- (event-x-pixel, event-y-pixel): (%s, %s)
- Point: %s
- Timestamp: %s"
-	window 
-        frame 
-        buffer 
-        (event-x event) (event-y event) 
-        (event-x-pixel event) (event-y-pixel event)
-        point 
-        (event-timestamp event))))))
-
-;(let ((mouse-motion-handler 'debug-motion-handler)
-;      (temp-buffer-show-function nil))
-;  (read-char))
-
-;; Set of copy/kill/move functions for usage with highlighted regions
-
-(put 'mode-motion-move 'pending-delete t)
-(put 'mode-motion-copy 'pending-delete t)
-
-(defun mode-motion-move ()
-  "Move the motion active region to point." 
-  (interactive)
-  (mode-motion-insert-text (mode-motion-copy/delete t)))
-
-(defun mode-motion-kill ()
-  "Kill the motion active region and push it onto the kill ring."
-  (interactive)
-  (mode-motion-copy/delete t t t))
-
-(defun mode-motion-copy ()
-  "Copy the motion active region to point."
-  (interactive)
-  (mode-motion-insert-text (mode-motion-copy/delete)))
-
-(defun mode-motion-copy-as-kill ()
-  "Delete the motion active region and push it onto the kill ring.
-Set point to the place where deletion happened."
-  (interactive)
-  (mode-motion-copy/delete nil t)
-  (message "Text copied to the to ring and cut buffer."))
-
-(defun mode-motion-copy/delete (&optional delete copy-as-kill set-point)
-  "Return the string that is designated by the current motion active region. 
-Arguments are:
-           EVENT - a mouse click event used to identify the buffer and window 
-&optional DELETE - delete the motion active text region
-    COPY-AS-KILL - copy the string to the kill ring
-       SET-POINT - set point to the start of the motion active region."
-  (let ((old-buf (current-buffer))
-	(old-window (selected-window)))
-    (unwind-protect 
-	(let ((extent (or primary-selection-extent
-			  (and (extentp mode-motion-last-extent)
-			       (not (extent-property mode-motion-last-extent
-						     'detached))
-			       mode-motion-last-extent))))
-
-	  (if (and (extentp extent)
-		   (set-buffer (extent-buffer extent))
-		   (not 
-		    ;; zero length extents
-		    (= (extent-start-position extent)
-		       (extent-end-position extent))))
-
-	      (let* ((start (extent-start-position extent))
-		     (end (extent-end-position extent))
-		     (text 
-		      (buffer-substring
-		       (extent-start-position extent)
-		       (extent-end-position extent))))
-
-		(cond (copy-as-kill
-		       (copy-region-as-kill start end)
-		       (if (or (not kill-hooks)
-				(eq kill-hooks 'ignore))
-			   (progn 
-			     (x-own-selection-internal 'PRIMARY text)
-			     (x-own-clipboard text)))))
-
-		(cond (delete 
-		       (kill-region start end)
-		       (x-own-selection-internal 'PRIMARY text)
-		       ;; (select-window window)
-		       (if set-point 
-			   (goto-char start))))
-
-		(setq this-command 'mode-motion+)
-		text)
-	    (error "No current primary or motion selection.")
-	    ))
-      (set-buffer old-buf)
-      (select-window old-window))))
-
-(defun mode-motion-insert-text (text)
-  "Insert TEXT at point. Also insert one space if the 
-preceding character is a word constituent or a closing paren."
-  (or text (error "No highlighted text to copy."))
-  (let ((prec-char-syntax (char-syntax (preceding-char))))
-    (if (memq  prec-char-syntax '(?w ?\))) (insert " "))
-    (insert text)))
-
-;; Boundary functions
-;;
-;; The following  functions are already provided by the thing package:
-;; thing-boundaries
-;; thing-symbol
-;; thing-word
-
-(defun char-boundaries (point) (thing-region point (1+ point)))
-      
-(defun visible-line-boundaries (point)
-  (save-excursion
-    (goto-char point)
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (if (and (eq major-mode 'dired-mode)
-	     (save-excursion (dired-move-to-filename)))
-	(let ((start (point)))
-	  (end-of-line)
-	  (skip-chars-backward " \t")
-	  (thing-region start (point))))))
-
-(defun line-boundaries (point)
-  (save-excursion
-    (goto-char point)
-    (beginning-of-line)
-    (if (and (eq major-mode 'dired-mode)
-	     (save-excursion (dired-move-to-filename)))
-	(let ((start (point)))
-	  (end-of-line)
-	  (thing-region start (point))))))
-
-(defun cvs-line-boundaries (point)
-    (save-excursion
-      (goto-char point)
-      (beginning-of-line)
-      (if (looking-at "^[* ] ")
-	  (thing-region  (point) (progn (end-of-line) (point))))))
-      
-(defun latex-boundaries (here)
-  (setq *last-thing* 'sexp)
-  (tex-boundaries 
-   here ?\\ "a-zA-Z"
-   ;; begin-fwd-regexp
-   "\\\\begin *{ *\\([a-z]*\\) *}"
-   ;; end-fwd-regexp
-   "\\(\\\\end *{ *%s *}\\)\\|\\(\\\\begin *{ *%s *}\\)"
-   ;; begin-bwd-regexp
-   "\\\\end *{ *\\([a-z]*\\) *}"
-   ;; begin-bwd-regexp
-   "\\(\\\\end *{ *%s *}\\)\\|\\(\\\\begin *{ *%s *}\\)"
-   ;; param-cmd-regexp
-   "\\\\[a-zA-Z]+[ \n\t]*{"))
-
-(defvar texinfo-paired-commands 
-  (mapconcat 
-   'identity 
-   '(
-     "enumerate"
-     "example"
-     "group"
-     "ifinfo" 
-     "iftex" 
-     "ignore" 
-     "itemize"
-     "menu"
-     "quotation"
-     "table"
-     "tex"
-     "titlepage"
-     ) 
-   "\\|"))
-
-(defvar texinfo-begin-fwd-regexp 
-  (format "@\\(%s\\)" texinfo-paired-commands))
-(defvar texinfo-end-bwd-regexp
-  (format "@end *\\(%s\\)" texinfo-paired-commands))
-
-(defun texinfo-boundaries (here)
-  (tex-boundaries 
-   here ?@ "a-z"
-   texinfo-begin-fwd-regexp
-   ;; end-fwd-regexp
-   "\\(@end *%s\\)\\|\\(@%s\\)"
-   ;; end-bwd-regexp
-   texinfo-end-bwd-regexp
-   ;; begin-bwd-regexp
-   "\\(@end *%s\\)\\|\\(@%s\\)"
-   ;; param-cmd-regexp
-   "@\\(TeX\\|[a-zA]+\\)[ \n\t]*{"))
-
-(defun tex-boundaries 
-  (here cmd-start-character cmd-word-character
-	begin-fwd-regexp end-fwd-regexp
-	end-bwd-regexp begin-bwd-regexp
-	param-cmd-regexp)
-  "Generic TeX dialect scanner.
-Parameters: 
-cmd-start-character: character that starts a command 
-	(`\' in (La)TeX, `@' in Texinfo)
-cmd-word-character:  regexpression to be used by the function
-	`skip-chars-backward' allowing to skip over command 
-	characters other than `cmd-start-character'
-begin-fwd-regexp: regexpression matching the begin part of a 
-	text stretch, used in forward search. 
-end-fwd-regexp: regexpression matching the end part of a 
-	text stretch, used in forward search
-end-bwd-regexp: regexpression matching the end part of a 
-	text stretch, used in backward search.
-begin-bwd-regexp: regexpression matching the begin part of a 
-	text stretch, used in backward search.
-param-cmd-regexp: regexpression matching a parameterized command 
-        \(including the open parenthesis\)"
-  (save-excursion
-    (goto-char here)
-    (cond ((= (following-char) cmd-start-character)
-	   (forward-char 1))
-	  ((= (char-syntax (following-char)) ?w)
-	   (skip-chars-backward cmd-word-character)))
-    (if (/= (preceding-char) cmd-start-character)
-	(thing-boundaries here)
-      (forward-char -1)
-      (catch 'return 
-	(cond ((looking-at begin-fwd-regexp)
-	       (let* ((start (point))
-		      (env (buffer-substring 
-			    (match-beginning 1) (match-end 1)))
-		      (regexp (format end-fwd-regexp env env))
-		      (count 0))
-		 (while (re-search-forward regexp nil t)
-		   (cond ((match-beginning 2) ; \begin
-			  (setq count (1+ count)))
-			 ((match-beginning 1) ; \end
-			  (setq count (1- count))
-			  (if (= count 0) 
-			      (throw 'return 
-				     (thing-region start (point)))))))))
-	      ((looking-at end-bwd-regexp)
-	       (let* ((end (match-end 0))
-		      (env (buffer-substring 
-			    (match-beginning 1) (match-end 1)))
-		      (regexp 
-		       (format begin-bwd-regexp env env))
-		      (count 1))
-		 (while (re-search-backward regexp nil t)
-		   (cond ((match-beginning 1) ; \end
-			  (setq count (1+ count)))
-			 ((match-beginning 2) ; \begin
-			  (setq count (1- count))
-			  (if (= count 0) 
-			      (throw 'return (thing-region (point) end))))
-			 ))))
-	      ;; tex macros of the form \cmd {...}
-	      ((looking-at param-cmd-regexp)
-	       (thing-region 
-		(point)
-		(progn 
-		  (goto-char (1- (match-end 0)))
-		  (forward-sexp 1)
-		  (point))))
-	      ;; fetch the current macro (with backslash)
-	      (t (thing-region (point) (progn (forward-word 1) (point)))))))))
-
-;; special parse of buffer for valid selectable info
-(defun minibuffer-selection-boundaries (point)
-  (let ((old-syntax (syntax-table)))
-    (unwind-protect
-	(progn 
-	  ;; best syntax table for recognizing symbols
-	  (set-syntax-table emacs-lisp-mode-syntax-table)
-	  (let ((file-completion (eq minibuffer-completion-table
-				     'read-file-name-internal))
-		region
-		minibuf-string		;contents of minibuffer
-		buffer-string		;string to be highlighted (or not)
-		prefix			;prefix calculated from minibuf-string
-		string			;string to be verified in the
-					;completion table 
-		)
-	    (and
-
-	     (setq region (if file-completion
-			      (thing-filename point)
-			    (thing-symbol point)))
-
-	     (setq
-	      minibuf-string		; contents of minibuffer
-	      (save-excursion
-		(set-buffer mouse-grabbed-buffer)
-		(buffer-string))
-
-	      buffer-string		; string to be highlighted (or not)
-	      (buffer-substring (car region) (cdr region))
-		       
-	      prefix
-	      (if file-completion
-		  (file-name-nondirectory minibuf-string)
-		minibuf-string)
-
-	      string
-	      (if file-completion
-		  (concat (file-name-directory minibuf-string) buffer-string)
-		buffer-string))
-	     
-	     (if (or (and (fboundp 'ange-ftp-ftp-path)
-			  (or (ange-ftp-ftp-path buffer-string)
-			      (ange-ftp-ftp-path string)))
-		     (and (fboundp 'efs-ftp-path)
-			  (or (efs-ftp-path buffer-string)
-			      (efs-ftp-path string))))
-		 ;; #### Like our counterpart in mode-motion: evil evil evil
-		 t
-	       (if file-completion
-		   (try-completion string
-				   minibuffer-completion-table
-				   minibuffer-completion-predicate)
-		 (eq 't (try-completion string
-					minibuffer-completion-table
-					minibuffer-completion-predicate))))
-
-	     ;; the result is the region to be highlighted
-	     region)))
-      (set-syntax-table old-syntax))))
-
-;; C source code scanner 
-(defvar c-statement-starting-keyword-regexpr
-  "\\(if\\|for\\|while\\|do\\|switch\\|break\\|continue\\)\\b")
-
-(defun c-boundaries (here)
-  (setq *last-thing* 'sexp)
-  (save-excursion
-    (goto-char here)
-    (let ((following-char (following-char))
-	  (preceding-char (preceding-char))
-	  aux)
-      (if (= (char-syntax following-char) ?w)
-	  (progn 
-	    (skip-chars-backward "a-zA-Z")
-	    (setq aux (point))
-	    (skip-chars-backward "\n\t ")
-	    (if (= (preceding-char) ?#)
-		(forward-char -1)
-	      (goto-char aux))))
-      (if (and (= following-char ?*)
-	       (= preceding-char ?/))
-	  (forward-char -1))
-      (if (and (= following-char ?/)
-	       (= preceding-char ?*))
-	  (forward-char -1))
-      (cond
-       ((= (following-char) ?#) (c-scan-preproc-macros))
-       ((looking-at "/\\*")	; begin comment
-	(let ((start (match-beginning 0)))
-	  (if (search-forward "*/" nil t)
-	      (thing-region start (match-end 0)))))
-       ((looking-at "\\*/")	; end comment
-	(let ((end (match-end 0)))
-	  (if (search-backward "/*" nil t)
-	      (thing-region (match-beginning 0) end))))
-       ((looking-at c-statement-starting-keyword-regexpr) ; if for while do etc
-	(thing-region (match-beginning 0)
-		      (c-forward-statement 
-		       (buffer-substring (match-beginning 1) (match-end 1)))))
-       ((looking-at "else\\b")
-	(thing-region (match-beginning 0) (c-forward-else)))
-       (t (if (= (char-syntax (following-char)) ?.)
-	      (thing-region here  (1+ here))
-	    (thing-boundaries here)))))))
-
-
-(defun c-scan-preproc-macros ()
-  (cond 
-   ((looking-at "^#[ \n\t]*include[ \n\t]*[<\"][^>\"]*[>\"]")   ; #include
-    (thing-region (match-beginning 0) (match-end 0)))
-   ((looking-at "^#[ \n\t]*\\(define\\|undef\\)") ; #define, #undef
-    (thing-region
-     (match-beginning 0) 
-     (progn 
-       (end-of-line)
-       (while (= (preceding-char) ?\\)
-	 (forward-line 1)
-	 (end-of-line))
-       (point))))
-   ;; #if, #ifdef, #ifndef, #else, #elif
-   ((looking-at "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|else\\|elif\\)\\b")
-    (let ((start (match-beginning 0))
-	  (counter 1)
-	  match)
-      (goto-char (match-end 0))
-      (while (and (>= counter 1)
-		  (re-search-forward 
-		   "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|endif\\)\\b"
-		   nil t))
-	(setq match 
-	      (buffer-substring (match-beginning 1) (match-end 1)))
-	(setq counter 
-	      (if (string= match "endif")
-		  (1- counter)
-		(1+ counter))))
-      (if (= counter 0)
-	  (thing-region start (match-end 0)))))
-   ((looking-at "^#[ \n\t]*endif\\b")   ; #endif
-    (let ((end (match-end 0))
-	  (counter 1)
-	  match)
-      (goto-char (match-beginning 0))
-      (while (and (>= counter 1)
-		  (re-search-backward
-		   "^#[ \n\t]*\\(if\\|ifdef\\|ifndef\\|endif\\)\\b"
-		   nil t))
-	(setq match 
-	      (buffer-substring (match-beginning 1) (match-end 1)))
-	(setq counter 
-	      (if (string= match "endif")
-		  (1+ counter)
-		(1- counter))))
-      (if (= counter 0)
-	  (thing-region (match-beginning 0) end))))))
-
-(defun c-skip-over-comment ()
-  (let ((aux (point)))
-    (skip-chars-forward "\n\t ")
-    (or (and (= (following-char) ?/)
-	     (= (char-after (1+ (point))) ?*)
-	     (search-forward "*/" nil t)
-	     (point))
-	(goto-char aux))))
-
-(defun c-forward-statement (&optional keyword)
-  (c-skip-over-comment)
-  (skip-chars-forward " \n\t")
-  (or keyword (setq keyword 
-		    (if (looking-at c-statement-starting-keyword-regexpr)
-			(buffer-substring 
-			 (match-beginning 1)
-			 (match-end 1)))))
-  (if keyword
-      (cond ((string= keyword "if")
-	     (c-forward-if))
-	    ((string= keyword "do")
-	     (c-forward-do-while))
-	    ((member keyword '("for" "while" "switch"))
-	     (c-forward-for/while/switch))
-	    ((member keyword '("break" "continue"))
-	     (c-forward-break/continue)))
-    (cond ((= (following-char) ?\{)
-	   (forward-list 1)
-	   (point))
-	  (t
-	   ;; Here I use that each C statement other then 
-	   ;; a bloc, if, while, for, do ... ends in a `;'
-	   (let (char)
-	     (catch 'exit
-	       (while t
-		 (if (eobp) (throw 'exit nil))
-		 (setq char (following-char))
-		 (cond ((= (char-syntax char) ?.) 
-			(forward-char 1)
-			(if (= char ?\;) (throw 'exit (point))))
-		       (t (forward-sexp 1)
-			  (skip-chars-forward " \n\t"))))))))))
-
-(defun c-forward-if ()
-  (let (aux)
-    (forward-word 1) ; if
-    (forward-list 1) 
-    (c-forward-statement)
-    (setq aux (point))
-    (skip-chars-forward "\n\t ")
-    (if (looking-at "else\\b")
-	(c-forward-else)
-	(goto-char aux))))
-
-(defun c-forward-else ()
-  (forward-word 1) ; else
-  (c-forward-statement))
-
-(defun c-forward-for/while/switch ()
-  (forward-word 1) ; for
-  (forward-list 1)
-  (c-forward-statement))
-
-(defun c-forward-do-while ()
-  (forward-word 1) ; do ... while
-  (c-forward-statement)
-  (c-forward-for/while/switch))
-
-(defun c-forward-switch ()
-  (forward-word 1) ; switch
-  (forward-list 2)
-  (point))
-
-(defun c-forward-break/continue ()
-  (forward-word 1) ; keyword
-  (c-skip-over-comment)
-  (skip-chars-forward "\n\t ")
-  (if (= (following-char) ?\;)
-      (goto-char (1+ (point)))))
-
-;; Tcl syntax scanner
-(defvar tcl-builtin-commands nil
-  "Alist of information about tcl syntax for the tcl-boundaries function.  
-An entry has the form 
-	\( . \) 
-where 
-	     is the name of a tcl command
-	 is one of 
-            list of integers: the number of possible arguments
-	    t:		      any number of arguments")
-
-(defconst tcl-commands
-  '(
-    ("append"	. (2 . nil))
-    ("array"	. (2 . 3))
-    ("break"	. 0)
-    ("case" 	. 3)
-    ("catch"	. 1)
-    ("cd"	. 1)
-    ("close"	. 1)
-    ("concat"	. t)
-    ("continue"	. 0)
-    ("else" 	. (1 . nil))
-    ("elseif"	. (1 . nil))
-    ("eof"	. 1)
-    ("error"	. t)
-    ("eval"     . t)
-    ("exec"     . t)
-    ("exit"	. (0 . 1))
-    ("expr" 	. 1)
-    ("file"	. (2 . nil))
-    ("flush"	. 1)
-    ("for" 	. 4)
-    ("foreach" 	. 3)
-    ("format"	. (1 . nil))
-    ("gets"	. (1 . 2))
-    ("glob"	. t)
-    ("global" 	. (1 . nil))
-    ("history"	. t)
-    ("if" 	. (2 . nil))
-    ("incr" 	. (1 . 2))
-    ("info"	. (1 . 4))
-    ("join"	. (1 . 2))
-    ("lappend"	. (2 . nil))
-    ("lindex" 	. 2)
-    ("linsert"	. (3 . nil))
-    ("list"	. t)
-    ("llength" 	. 1)
-    ("lrange" 	. 3)
-    ("lreplace"	. (3 . nil))
-    ("lsearch" 	. 2)
-    ("lsort"	. 1)
-    ("open"	. (1 . 2))
-    ("proc" 	. 3)
-    ("puts"	. (1 . 3))
-    ("pwd"	. 0)
-    ("read"	. (1 . 2))
-    ("regexp"	. (2 . nil))
-    ("regsub"	. (4 . 6))
-    ("rename"	. 2)
-    ("return"	. (0 .1))
-    ("scan"	. (3 . nil))
-    ("seek"	. (2 . 3))
-    ("set" 	. (1 . 2))
-    ("source"	. 1)
-    ("split"	. (1 . 2))
-    ("string"	. (2 . 4))
-    ("tell"	. 1)
-    ("time"	. (1 .2))
-    ("trace"	. (1 . nil))
-    ("unknown"	. (1 . nil))
-    ("unset"	. (1 . nil))
-    ("uplevel"	. (1 . nil))
-    ("upvar"	. (2 . nil))
-    ("while" 	. 2)
-    ))
-
-(defconst tk-commands
-  '(("bind"	. 3)
-    ("button"	. t)
-    ("canvas"	. t)
-    ("frame"	. t)
-    ("label"	. t)
-    ("listbox"	. t)
-    ("menu"	. t)
-    ("menubutton"	. t)
-    ("pack"	. t)
-    ("scrollbar"	. t)
-    ("tree"	. t)
-    ("wm"		. t)
-    ))
-
-(defconst tcl-tk-commands
-  (nconc tcl-commands tk-commands))
-  
-(defconst tcl-tk-commands-regexp
-  (format "\\(%s\\\)\\W" (mapconcat 'car tcl-tk-commands "\\|")))
-
-(defun tcl-boundaries (here)
-  (save-excursion
-    (goto-char here)
-    (skip-chars-backward "a-z")
-    (if (looking-at 
-	 tcl-tk-commands-regexp)
-	(let* ((count 0) 
-	      (start (point))
-	      (keyword (buffer-substring
-			(match-beginning 1)
-			(match-end 1)))
-	      (syntax-description 
-	       (cdr (assoc keyword tcl-tk-commands))))
-	  (goto-char (match-end 0))
-	  (while (not (looking-at "[ \t]*[]\n;}]"))
-	    (setq count (1+ count))
-	    (tcl-forward-sexp1)
-	    ;; skipping over the parentheses of array expressions:
-	    (while (not (or (looking-at "[ \t]*[]\n;}]")
-			    (= (char-syntax (following-char)) ? )))
-	      (tcl-forward-sexp1)))
-
-	  (if (cond ((eq syntax-description t))
-		    ((integerp syntax-description) 
-		     (= syntax-description count))
-		    ((consp syntax-description)
-		     (and (<= (car syntax-description) count)
-			  (or (null (cdr syntax-description))
-			      (<= count (cdr syntax-description))))))
-	      (progn 
-		(message "`%s' matched."  keyword)
-		(thing-region start (point)))
-	    (progn 
-	      (message "wrong syntax: `%s'."  keyword)
-	      nil)))
-      (message "")
-      (thing-boundaries here))))
-
-(defun tcl-forward-sexp (&optional arg)
-  "Move forward across one balanced tcl expression.
-With argument, do it that many times."
-  (interactive "p")
-  (if (< arg 0) (error "negative argument not allowed"))
-  (or arg (setq arg 1))
-  (while (> arg 0)
-    (tcl-forward-sexp1)
-    (setq arg (1- arg))))
-
-(defun tcl-forward-sexp1 ()
-  (interactive "")  
-  (let ((start (point))
-	next-char syntax (first-scan t))
-    (setq next-char (following-char)
-	  syntax (char-syntax next-char))
-
-    (while (or (= next-char ?\;)
-	       (memq syntax '(? ?>)))
-      (forward-char 1)
-      (setq next-char (following-char)
-	    syntax (char-syntax next-char)))
-
-    (condition-case var
-	(catch 'exit 
-	  (while t
-	    (setq next-char (following-char)
-		  syntax (char-syntax next-char))
-	    (cond ((= next-char ?\;)
-		   (throw 'exit nil))
-		  ((memq syntax (if first-scan '(? ?>) '(? ?> ?\))))
-		   (throw 'exit nil))
-		  (t 
-		   (goto-char (or (scan-sexps (point) 1) 
-				  (point-max)))))
-	    (setq first-scan nil)))
-      (error (goto-char start)
-	     (error (car (cdr var)))))))
-
-;; (define-key tcl-mode-map "\M-\C-f" 'tcl-forward-sexp)
-
-(defun mode-motion-eval-func (eval-func)
-  (let ((old-buf (current-buffer))
-	(old-window (selected-window)))
-    (unwind-protect 
-	(let ((extent (or primary-selection-extent
-			  (and (extentp mode-motion-last-extent)
-			       (not (extent-property mode-motion-last-extent
-						     'detached))
-			       mode-motion-last-extent))))
-
-	  (if (and (extentp extent)
-		   (set-buffer (extent-buffer extent))
-		   (not 
-		    ;; zero length extents
-		    (= (extent-start-position extent)
-		       (extent-end-position extent))))
-
-	      (let* ((start (extent-start-position extent))
-		     (end (extent-end-position extent)))
-
-		(funcall eval-func start end))
-
-	    (error "No current primary or motion selection.")
-	    ))
-      (set-buffer old-buf)
-      (select-window old-window))))
-
-(defun mode-motion-eval-region ()
-  (interactive)
-  (mode-motion-eval-func 'eval-region))
-
-
-;; Motion highlight faces and initialization.
-
-(defun sect-handler (string)
-  "Return the symbol corresponding to the foo-STRING handler for this sect."
-  (intern-soft (concat (symbol-name mode-motion+-religion) string)))
-
-(defun mode-motion-init-handlers-according-to-religion (&optional forcep)
-  (interactive)
-  ;; Initialise default motion handlers depending on religious sect!
-  (let ((foo-thing (sect-handler "-thing"))
-	(foo-c (sect-handler "-c"))
-	(foo-LaTeX (sect-handler "-laTeX"))
-	(foo-line@ (sect-handler "-line@"))
-	(foo-vline@ (sect-handler "-vline@")))
-    (if forcep
-	(progn
-	  (setq default-motion-handler (find-motion-handler foo-thing))
-	  (set-mode-motion-handler 'emacs-lisp-mode foo-thing)
-	  (set-mode-motion-handler 'lisp-interaction-mode foo-thing)
-	  (set-mode-motion-handler 'c-mode foo-c)
-	  (set-mode-motion-handler 'c++-mode foo-c)
-	  (set-mode-motion-handler 'c++-c-mode foo-c)
-	  (set-mode-motion-handler 'tex-mode foo-LaTeX)
-	  (set-mode-motion-handler 'latex-mode foo-LaTeX)
-	  (set-mode-motion-handler 'Buffer-menu-mode foo-vline@)
-	  (set-mode-motion-handler 'Electric-Buffer-menu-mode foo-vline@)
-	  (set-mode-motion-handler 'gnus-Group-mode foo-vline@)
-	  (set-mode-motion-handler 'gnus-Subject-mode foo-vline@)
-	  (set-mode-motion-handler 'gnus-group-mode foo-vline@)
-	  (set-mode-motion-handler 'gnus-subject-mode foo-vline@)
-	  (set-mode-motion-handler 'gnus-summary-mode foo-vline@)
-	  (set-mode-motion-handler 'dired-mode foo-line@)
-	  (set-mode-motion-handler 'compilation-mode foo-line@)
-	  (set-mode-motion-handler 'occur-mode foo-line@)
-	  (set-mode-motion-handler 'tar-mode foo-vline@)
-	  (set-mode-motion-handler 'rmail-summary-mode foo-vline@)
-	  (set-mode-motion-handler 'vm-summary-mode (sect-handler "-line"))
-	  (set-mode-motion-handler 'tcl-mode (sect-handler "-tcl"))
-	  (set-mode-motion-handler 'texinfo-mode (sect-handler "-TeXinfo"))
-	  (set-mode-motion-handler 'cvs-mode (sect-handler "-cvs-line")))
-      (setq default-motion-handler
-	    (or default-motion-handler (find-motion-handler foo-thing)))
-      (or (get 'emacs-lisp-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'emacs-lisp-mode foo-thing))
-      (or (get 'lisp-interaction-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'lisp-interaction-mode foo-thing))
-      (or (get 'c-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'c-mode foo-c))
-      (or (get 'c++-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'c++-mode foo-c))
-      (or (get 'c++-c-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'c++-c-mode foo-c))
-      (or (get 'tex-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'tex-mode foo-LaTeX))
-      (or (get 'latex-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'latex-mode foo-LaTeX))
-      (or (get 'Buffer-menu-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'Buffer-menu-mode foo-vline@))
-      (or (get 'Electric-Buffer-menu-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'Electric-Buffer-menu-mode foo-vline@))
-      (or (get 'gnus-Group-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'gnus-Group-mode foo-vline@))
-      (or (get 'gnus-Subject-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'gnus-Subject-mode foo-vline@))
-      (or (get 'gnus-group-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'gnus-group-mode foo-vline@))
-      (or (get 'gnus-subject-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'gnus-subject-mode foo-vline@))
-      (or (get 'gnus-summary-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'gnus-summary-mode foo-vline@))
-      (or (get 'dired-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'dired-mode foo-line@))
-      (or (get 'compilation-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'compilation-mode foo-line@))
-      (or (get 'occur-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'occur-mode foo-line@))
-      (or (get 'tar-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'tar-mode foo-vline@))
-      (or (get 'rmail-summary-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'rmail-summary-mode foo-vline@))
-      (or (get 'vm-summary-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'vm-summary-mode (sect-handler "-line")))
-      (or (get 'tcl-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'tcl-mode (sect-handler "-tcl")))
-      (or (get 'texinfo-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'texinfo-mode (sect-handler "-TeXinfo")))
-      (or (get 'cvs-mode 'mode-motion-handler)
-	  (set-mode-motion-handler 'cvs-mode (sect-handler "-cvs-line"))))))
-
-;; Null Handlers (for disabling motion highlighting)
-(defun thing-null (here) nil)
-(make-motion-handler 'no-thing 'thing-null)
-(make-motion-handler 'no-c 'thing-null)
-(make-motion-handler 'no-laTeX 'thing-null)
-(make-motion-handler 'no-line 'thing-null)
-(make-motion-handler 'no-line@ 'thing-null)
-(make-motion-handler 'no-vline 'thing-null)
-(make-motion-handler 'no-vline@ 'thing-null)
-(make-motion-handler 'no-tcl 'thing-null)
-(make-motion-handler 'no-TeXinfo 'thing-null)
-(make-motion-handler 'no-cvs-line 'thing-null)
-
-(defun mode-motion-init ()
-  "enable mode-motion+ package"
-  (interactive)
-
-(setq mode-motion-last-extent nil)
-  
-(global-set-key '(meta button2) 'mode-motion-copy)
-(global-set-key '(meta shift button2) 'mode-motion-move)
-(global-set-key '(meta control button2) 'mode-motion-kill)
-(global-set-key '(meta control shift button2) 'mode-motion-copy-as-kill)
-(global-set-key '(meta control symbol button2) 'mode-motion-copy-as-kill)
-
-(if mode-motion-setup-cut-and-paste-bindings
-    (progn 
-      (global-set-key 'f16 'mode-motion-copy-as-kill) ; Copy
-      (global-set-key 'f18 'yank)	              ; Paste
-      (global-set-key 'f20 'mode-motion-kill)))       ; Cut
-
-;; I don't want the thing-boundaries function select whitespaces 
-(setq thing-report-whitespace nil thing-report-char-p nil)
-
-;; bold motion face (bold, if this is not the default, unbold otherwise)
-(if (find-face 'motion-bold)
-    ()
-  (make-face 'motion-bold)
-  (make-face-bold 'motion-bold)
-  (or (face-differs-from-default-p 'motion-bold)
-      (make-face-unbold 'motion-bold)))
-
-;; an underline face
-(if (find-face 'motion-underline)
-    ()
-  (make-face 'motion-underline)
-  (set-face-underline-p 'motion-underline t))
-
-;; an inverted face
-(if (find-face 'motion-inverted)
-    ()
-  (make-face 'motion-inverted)
-  (make-face-bold 'motion-inverted)
-  (invert-face 'motion-inverted))
-
-(if (find-face 'motion-gray)
-    ()
-  (make-face 'motion-gray)
-  (set-face-background-pixmap 'motion-gray "gray1.xbm"))
- 
-;; Motion Handlers
-
-;; Special Minibuffer handler
-
-(make-motion-handler 'minibuffer 'minibuffer-selection-boundaries 'highlight t nil)
-
-;; Things
-(make-motion-handler 'bold-thing 'thing-boundaries 'motion-bold)
-(make-motion-handler 'gray-thing 'thing-boundaries 'motion-gray)
-(make-motion-handler 'highlight-thing 'thing-boundaries 'highlight)
-(make-motion-handler 'invert-thing 'thing-boundaries 'motion-inverted)
-(make-motion-handler 'underline-thing 'thing-boundaries 'motion-underline)
-
-;; Lines
-(make-motion-handler 'bold-line 'line-boundaries 'motion-bold)
-(make-motion-handler 'gray-line 'line-boundaries 'motion-gray)
-(make-motion-handler 'highlight-line 'line-boundaries 'highlight)
-(make-motion-handler 'invert-line 'line-boundaries 'motion-inverted)
-(make-motion-handler 'underline-line 'line-boundaries 'motion-underline)
-(make-motion-handler 'bold-line@ 'line-boundaries 'motion-bold t t)
-(make-motion-handler 'gray-line@ 'line-boundaries 'motion-gray nil t)
-(make-motion-handler 'highlight-line@ 'line-boundaries 'highlight nil t)
-(make-motion-handler 'invert-line@ 'line-boundaries 'motion-inverted nil t)
-(make-motion-handler 'underline-line@ 'line-boundaries 'motion-underline nil t)
-
-;; Visible text of line
-(make-motion-handler 'bold-vline 'visible-line-boundaries 'motion-bold)
-(make-motion-handler 'gray-vline 'visible-line-boundaries 'motion-gray)
-(make-motion-handler 'highlight-vline 'visible-line-boundaries 'highlight)
-(make-motion-handler 'invert-vline 'visible-line-boundaries 'motion-inverted)
-(make-motion-handler 'underline-vline 'visible-line-boundaries 'motion-underline)
-(make-motion-handler 'bold-vline@ 'visible-line-boundaries 'motion-bold t t)
-(make-motion-handler 'gray-vline@ 'visible-line-boundaries 'motion-gray nil t)
-(make-motion-handler 'highlight-vline@ 'visible-line-boundaries 'highlight nil t)
-(make-motion-handler 'invert-vline@ 'visible-line-boundaries 'motion-inverted nil t)
-(make-motion-handler 'underline-vline@ 'visible-line-boundaries 'motion-underline nil t)
-
-;; CVS lines
-(make-motion-handler 'bold-cvs-line 'cvs-line-boundaries 'motion-bold)
-(make-motion-handler 'gray-cvs-line 'cvs-line-boundaries 'motion-gray)
-(make-motion-handler 'highlight-cvs-line 'cvs-line-boundaries 'highlight)
-(make-motion-handler 'invert-cvs-line 'cvs-line-boundaries 'motion-inverted)
-(make-motion-handler
- 'underline-cvs-line 'cvs-line-boundaries 'motion-underline)
-
-;; (La)TeX 
-(make-motion-handler 'bold-LaTeX 'latex-boundaries 'motion-bold)
-(make-motion-handler 'gray-LaTeX 'latex-boundaries 'motion-gray)
-(make-motion-handler 'highlight-LaTeX 'latex-boundaries 'highlight)
-(make-motion-handler 'invert-LaTeX 'latex-boundaries 'motion-inverted)
-(make-motion-handler 'underline-LaTeX 'latex-boundaries 'motion-underline)
-
-;; TeXinfo
-(make-motion-handler 'bold-TeXinfo 'texinfo-boundaries 'motion-bold)
-(make-motion-handler 'gray-TeXinfo 'texinfo-boundaries 'motion-gray)
-(make-motion-handler 'highlight-TeXinfo 'texinfo-boundaries 'highlight)
-(make-motion-handler 'invert-TeXinfo 'texinfo-boundaries 'motion-inverted)
-(make-motion-handler 'underline-TeXinfo 'texinfo-boundaries 'motion-underline)
-
-;; C and C++
-(make-motion-handler 'bold-c 'c-boundaries 'motion-bold)
-(make-motion-handler 'gray-c 'c-boundaries 'motion-gray)
-(make-motion-handler 'highlight-c 'c-boundaries 'highlight)
-(make-motion-handler 'invert-c 'c-boundaries 'motion-inverted)
-(make-motion-handler 'underline-c 'c-boundaries 'motion-underline)
-
-;; Tcl/Tk
-(make-motion-handler 'bold-tcl 'tcl-boundaries 'motion-bold)
-(make-motion-handler 'gray-tcl 'tcl-boundaries 'motion-gray)
-(make-motion-handler 'highlight-tcl 'tcl-boundaries 'highlight)
-(make-motion-handler 'invert-tcl 'tcl-boundaries 'motion-inverted)
-(make-motion-handler 'underline-tcl 'tcl-boundaries 'motion-underline)
-
-;; mouse tracker
-(make-motion-handler 'track-mouse@ 'char-boundaries nil nil t)
-(make-motion-handler 'highlight-char 'char-boundaries 'highlight)
-
-;; augment the basic mouse motion handler (if any)
-(setq-default mode-motion-hook 
-	      (if (listp mode-motion-hook)
-		  (if (memq #'mode-motion+-highlight mode-motion-hook)
-		      mode-motion-hook
-		    (append mode-motion-hook (list #'mode-motion+-highlight)))
-		(list mode-motion-hook #'mode-motion+-highlight)))
-
-(or mode-motion+-religion 
-    (setq mode-motion+-religion (if (x-display-color-p) 'underline 'invert)))
-
-(add-menu '("Options") (car mode-motion+-options-menu)
-	  (cdr mode-motion+-options-menu)
-	  "Paren Highlighting")
-
-;; shut your eyes, this is a kludge. I didn't have time to find/write
-;; a function to do this.
-(or (member ["Eval Motion Region" mode-motion-eval-region t]
-	    lisp-interaction-mode-popup-menu)
-    (and (setq lisp-interaction-mode-popup-menu
-	       (copy-sequence lisp-interaction-mode-popup-menu))
-	 (setcdr (nthcdr 1 lisp-interaction-mode-popup-menu)
-		 (cons ["Eval Motion Region" mode-motion-eval-region t]
-		       (nthcdr 2 lisp-interaction-mode-popup-menu)))))
-
-(or (member ["Eval Motion Region" mode-motion-eval-region t]
-	    emacs-lisp-mode-popup-menu)
-    (and (setq emacs-lisp-mode-popup-menu
-	       (copy-sequence emacs-lisp-mode-popup-menu))
-	 (setcdr (nthcdr 3 emacs-lisp-mode-popup-menu)
-		 (cons ["Eval Motion Region" mode-motion-eval-region t]
-		       (nthcdr 4 emacs-lisp-mode-popup-menu)))))
-
-;; Clear the last active motion extent when leaving a frame.
-(if (boundp 'mouse-leave-frame-hook)
-    (add-hook 'mouse-leave-frame-hook 'mode-motion-clear-last-extent)
-  (add-hook 'mouse-leave-screen-hook 'mode-motion-clear-last-extent))
-	       
-(run-hooks 'mode-motion+-load-hook)
-(mode-motion-init-handlers-according-to-religion)
-
-(if (interactive-p) (message "mode-motion+ enabled")))
-
-(if (and (not purify-flag)
-	 (or (not (boundp 'opt-mode-motion+)) opt-mode-motion+))
-    (mode-motion-init))
-
-(provide 'mode-motion+)
-;; end mode-motion+
diff --git a/xemacs-packages/lisp/edit-utils/narrow-stack.el b/xemacs-packages/lisp/edit-utils/narrow-stack.el
deleted file mode 100644
index 012b2243..00000000
--- a/xemacs-packages/lisp/edit-utils/narrow-stack.el
+++ /dev/null
@@ -1,120 +0,0 @@
-;;; narrow-stack version 1.0
-;;
-;; Copyright (C) 1999 Jesper Kjær Pedersen 
-;;
-;; Author: Jesper Kjær Pedersen 
-;; Home page: http://www.imada.sdu.dk/~blackie/emacs/
-;; Created: 18 Apr. 1999
-;; Keywords: narrow
-
-;; 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:
-;; Narrowing, as implemented in Emacs has one limitation, which I find very
-;; annoying, namely that it is not possible to narrow within a narrowing,
-;; and then widen again to the previous narrowing.
-;; This package implements an extension to narrowing, which makes this
-;; possible.
-;; 
-;; This package has been developed as part of my job on writing the book
-;; "Sams Teach yourself Emacs in 24 hours".
-;; For more information about this book, please go to the page www.mcp.com
-;; and search for the word Emacs.
-;;
-;; To install this package, copy this file to a directory in your load-path
-;; and insert the following into your .emacs file:
-;; (require 'narrow-stack)
-;; (narrow-stack-mode)
-
-;;; History Information
-;; 1.0.1 Added documentation for functions
-;; 1.0   First official relase.
-
-(require 'advice)
-(defvar ns-stack '()
-  "the stack of earlier narrows")
-(make-variable-buffer-local 'ns-stack)
-
-(defvar narrow-stack-mode nil
-  "narrow-stack-mode implements a stack of narrows. Thus with
-narrow-stack-mode you may narrow within narrowing, and widen to the
-previous narrowing.\n\nFor more information on narrowing, see narrow-to-region")
-
-(defun ns-narrow-to-region (start end)
-  "narrow to the region marked, in a way, which makes it possible to widen
-to the given view later.\n\nFor more information on narrowing, see narrow-to-region"
-  (interactive "r")
-  (let* ((pm (point-marker))
-        (ns-elm (list (point-min) pm)))
-    (set-marker pm (+ 1 (point-max)))
-    (if (and (null ns-stack) (ns-is-narrowed))
-        (progn
-          ;; narrow-stack do not have any information about
-          ;; narrowing of this buffer, though it is narrowed.
-          ;; Push an extra element to the stack, to avoid that the function
-          ;; widen rather than ns-widen is called, when this element is widened.
-          (setq ns-stack (cons ns-elm (cons ns-elm ns-stack))))
-      (setq ns-stack (cons ns-elm  ns-stack)))
-    (narrow-to-region start end)))
-
-(defun ns-widen () 
-  "widen the view to the previous narrowing, or to the whole view if no
-previous narrowing exists.\n\nFor more information on narrowing, see narrow-to-region"
-  (interactive "")
-  (if (<= (length ns-stack) 1)
-      ; One element on the stack means that only one level of narrowing
-      ; exists. Thus narrowing should be disabled.
-      (widen)
-    (let ((new-start (caar ns-stack))
-          (new-end   (- (cadar ns-stack) 1)))
-      (progn 
-        (setq ns-stack (cdr ns-stack))
-        (narrow-to-region new-start new-end)
-
-        ;; Delete the marker. Is this necessary?
-        ;(set-marker new-end nil)
-        ))))
-
-(defun ns-is-narrowed ()
-  (or (not (= (point-min) 1)) (not (= (1+ (buffer-size)) (point-max)))))
-
-;;;###autoload
-(defun narrow-stack-mode (&optional arg)
-"narrow-stack-mode implements a stack of narrows. Thus with
-narrow-stack-mode you may narrow within narrowing, and widen to the
-previous narrowing\n\nFor more information on narrowing, see narrow-to-region"
-  (interactive "P")
-  (setq narrow-stack-mode 
-        (if (null arg) 
-            (not narrow-stack-mode)
-          (> (prefix-numeric-value arg) 0)))
-  (if narrow-stack-mode
-      (progn
-        (substitute-key-definition 'narrow-to-region 'ns-narrow-to-region global-map)
-        (substitute-key-definition 'widen 'ns-widen global-map)
-        (ad-enable-advice 'widen 'before 'ns-widen-advice))
-    (progn
-      (substitute-key-definition 'ns-narrow-to-region 'narrow-to-region  global-map)
-      (substitute-key-definition 'ns-widen 'widen global-map)
-      (ad-disable-advice 'widen 'before 'ns-widen-advice)))
-  (ad-activate 'widen))
-
-(defadvice widen (before ns-widen-advice dis)
-  (setq ns-stack '()))
-
-(provide 'narrow-stack)
-
-;;; narrow-stack.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/outl-mouse.el b/xemacs-packages/lisp/edit-utils/outl-mouse.el
deleted file mode 100644
index 96603e9a..00000000
--- a/xemacs-packages/lisp/edit-utils/outl-mouse.el
+++ /dev/null
@@ -1,684 +0,0 @@
-;;; outl-mouse.el --- outline mode mouse commands for Emacs
-
-;; Copyright (C) 1997 Free Software Foundation, Inc.
-;; Copyright 1994 (C) Andy Piper 
-
-;; Author: Andy Piper 
-;; Maintainer: XEmacs Development Team
-;; Keywords: outlines, mouse
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; outl-mouse.el v1.3.8:
-
-;; Defines button one to hide  blocks when clicked on outline-up-arrow
-;; and expand blocks when clicked on outline-down-arrow.  Features are
-;; activated   when   outline-minor-mode  or   outline-mode are turned
-;; on. There is also a menu for each glyph on button 3. 
-
-;; To use put:
-;; 	(require 'outl-mouse)
-;; in your .emacs file.
-
-;; If you use func-menu all  the time and  want outl-mouse on all  the
-;; time as well then put:
-;;	(setq outline-sync-with-func-menu t)
-;; outlining will then be turned on when func-menu is. Note that this
-;; requires a patch to func-menu 2.16 (in 19.10) to work:
-
-;RCS file: func-menu.el,v
-;retrieving revision 1.1
-;diff -r1.1 func-menu.el
-;180a181,183
-;> (defvar fume-found-function-hook nil
-;>   "*Hook to call after every function match.")
-;> 
-;1137,1138c1140,1142
-;<         (if (listp funcname)
-;<             (setq funclist (cons funcname funclist)))
-;---
-;>         (cond ((listp funcname)
-;>              (setq funclist (cons funcname funclist))
-;>              (save-excursion (run-hooks 'fume-found-function-hook))))
-
-;; If you  want mac-style outlining  then set  outline-mac-style to t.
-;; If you   want    the  outline   arrows on    the    left then   set
-;; outline-glyphs-on-left  to t. If you  have xpm then arrows are much
-;; better defined.
-
-;; This package uses func-menu to  define outline regexps if they  are
-;; not already defined. You should no longer need to use out-xtra.
-
-;; You can define the package to  do something other than outlining by
-;; setting outline-fold-in-function and outline-fold-out-function.
-
-;; You can define the color of outline arrows, but only in your .emacs.
-
-;; Only works in XEmacs 19.10 and onwards. 
-
-;;; Code:
-
-;; User definable variables.
-
-(defgroup outl-mouse nil
-  "Outline mouse mode commands for Emacs"
-  :prefix "outline-"
-  :group 'outlines
-  :group 'mouse)
-
-
-(defcustom outline-mac-style nil
-  "*If t then outline glyphs will be right and down arrows."
-  :type 'boolean
-  :group 'outl-mouse)
-
-(defcustom outline-glyphs-on-left nil
-  "*The position of outline glyphs on a line."
-  :type 'boolean
-  :group 'outl-mouse)
-
-(defcustom outline-glyph-colour "Gray75"
-  "*The colour of outlining arrows."
-  :type 'color
-  :group 'outl-mouse)
-
-(defcustom outline-glyph-shade-colour "Gray40"
-  "*The shadow colour of outlining arrows."
-  :type 'color
-  :group 'outl-mouse)
-
-(defcustom outline-glyph-lit-colour "Gray90"
-  "*The lit colour of outlining arrows."
-  :type 'color
-  :group 'outl-mouse)
-
-(defvar outline-fold-in-function 'outline-fold-in
-  "Function to call for folding in. 
-The function should take an annotation argument.")
-(make-variable-buffer-local 'outline-fold-in-function)
-
-(defvar outline-fold-out-function 'outline-fold-out
-  "Function to call for folding out. 
-The function should take an annotation argument.")
-(make-variable-buffer-local 'outline-fold-out-function)
-
-(defcustom outline-sync-with-func-menu nil
-  "*If t then outline glyphs are permanently added by func-menu scans.
-If outline-minor-mode is turned off then turning it back on will have
-no effect. Instead the buffer should be rescanned from the function
-menu."
-  :type 'boolean
-  :group 'outl-mouse)
-
-(defcustom outline-move-point-after-click t
-  "*If t then point is moved to the current heading when clicked."
-  :type 'boolean
-  :group 'outl-mouse)
-
-(defcustom outline-scanning-message "Adding glyphs... (%3d%%)"
-  "*Progress message during the scanning of the buffer.
-Set this to nil to inhibit progress messages."
-  :type 'string
-  :group 'outl-mouse)
-
-;;
-;; No user definable variables beyond this point.
-;;
-
-;; I'll bet there's a neat way to do this with specifiers -- a pity the
-;; sucks so badly on it. -sb
-(defconst outline-up-arrow ; XEmacs
-  (make-glyph ; an up-arrow
-   (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
-static char * arrow[] = {
-\"10 10 5 1\",
-\" 	c none\",
-\".	c " outline-glyph-lit-colour "\",
-\"X	c " outline-glyph-shade-colour "\",
-\"o	c " outline-glyph-colour "\",
-\"O	c " outline-glyph-shade-colour "\",
-\"    .X    \",
-\"    .X    \",
-\"   ..XX   \",
-\"   ..XX   \",
-\"  ..ooXX  \",
-\"  ..ooXX  \",
-\" ..ooooXX \",
-\" ..ooooXX \",
-\"..OOOOOOXX\",
-\"OOOOOOOOOO\"};")))
-	 ((featurep 'x)
-	  (vector 'xbm
-		  :data
-		  (list 10 10
-			(concat "\000\000\000\000\060\000\060\000\150\000"
-				"\150\000\324\000\324\000\376\001\376\001"))))
-	 (t "^")))
-  "Bitmap object for outline up glyph.")
-
-(defconst outline-up-arrow-mask ; XEmacs
-  (make-glyph ; an up-arrow
-   (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
-static char * arrow[] = {
-\"10 10 5 1\",
-\" 	c none\",
-\".	c " outline-glyph-shade-colour "\",
-\"X	c " outline-glyph-lit-colour "\",
-\"o	c " outline-glyph-colour "\",
-\"O	c " outline-glyph-lit-colour "\",
-\"    .X    \",
-\"    .X    \",
-\"   ..XX   \",
-\"   ..XX   \",
-\"  ..ooXX  \",
-\"  ..ooXX  \",
-\" ..ooooXX \",
-\" ..ooooXX \",
-\"..OOOOOOXX\",
-\"OOOOOOOOOO\"};")))
-	 ((featurep 'x)
-	  (vector 'xbm
-		  :data 
-		  (list 10 10
-			(concat "\000\000\000\000\060\000\060\000\130\000"
-				"\130\000\254\000\274\000\006\001\376\001"))))
-	 (t "+")))
-  "Bitmap object for outline depressed up glyph.")
-
-(defconst outline-down-arrow ; XEmacs
-  (make-glyph	; a down-arrow
-   (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
-static char * down[] = {
-\"10 10 5 1\",
-\" 	c " outline-glyph-lit-colour "\",
-\".	c " outline-glyph-lit-colour "\",
-\"X	c " outline-glyph-shade-colour "\",
-\"o	c none\",
-\"O	c " outline-glyph-colour "\",
-\"          \",
-\"..      XX\",
-\"o..OOOOXXo\",
-\"o..OOOOXXo\",
-\"oo..OOXXoo\",
-\"oo..OOXXoo\",
-\"ooo..XXooo\",
-\"ooo..XXooo\",
-\"oooo.Xoooo\",
-\"oooo.Xoooo\"};")))
-	 ((featurep 'x)
-	  (vector 'xbm
-		  :data 
-		  (list 10 10
-			(concat "\000\000\000\000\376\001\202\001\364\000"
-				"\324\000\150\000\150\000\060\000\060\000"))))
-	 (t "v")))
-  "Bitmap object for outline down glyph.")
-
-(defconst outline-down-arrow-mask ; XEmacs
-  (make-glyph	; a down-arrow
-   (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
-static char * down[] = {
-\"10 10 5 1\",
-\" 	c " outline-glyph-shade-colour "\",
-\".	c " outline-glyph-shade-colour "\",
-\"X	c " outline-glyph-lit-colour "\",
-\"o	c none\",
-\"O	c " outline-glyph-colour "\",
-\"          \",
-\"..      XX\",
-\"o..OOOOXXo\",
-\"o..OOOOXXo\",
-\"oo..OOXXoo\",
-\"oo..OOXXoo\",
-\"ooo..XXooo\",
-\"ooo..XXooo\",
-\"oooo.Xoooo\",
-\"oooo.Xoooo\"};")))
-	 ((featurep 'x)
-	  (vector 'xbm
-		  :data
-		  (list 10 10
-			(concat "\000\000\000\000\376\001\376\001\254\000"
-				"\254\000\130\000\130\000\060\000\060\000"))))
-	 (t "+")))
-  "Bitmap object for outline depressed down glyph.")
-
-(defconst outline-right-arrow
-  (make-glyph	; a right-arrow
-   (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
-static char * right[] = {
-\"10 10 5 1\",
-\" 	c " outline-glyph-lit-colour "\",
-\".	c " outline-glyph-lit-colour "\",
-\"X	c none\",
-\"o	c " outline-glyph-colour "\",
-\"O	c " outline-glyph-shade-colour "\",
-\" .XXXXXXXX\",
-\" ...XXXXXX\",
-\"  ....XXXX\",
-\"  oo....XX\",
-\"  oooo....\",
-\"  ooooOOOO\",
-\"  ooOOOOXX\",
-\"  OOOOXXXX\",
-\" OOOXXXXXX\",
-\" OXXXXXXXX\"};")))
-	 ((featurep 'x)
-	  (vector 'xbm
-		  :data
-		  (list 10 10
-			(concat "\000\000\006\000\032\000\142\000\232\001"
-				"\352\001\172\000\036\000\006\000\000\000"))))
-	 (t ">")))
-  "Bitmap object for outline right glyph.")
-
-(defconst outline-right-arrow-mask
-  (make-glyph	; a right-arrow
-   (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
-static char * right[] = {
-\"10 10 5 1\",
-\" 	c " outline-glyph-shade-colour "\",
-\".	c " outline-glyph-shade-colour "\",
-\"X	c none\",
-\"o	c " outline-glyph-colour "\",
-\"O	c " outline-glyph-lit-colour "\",
-\" .XXXXXXXX\",
-\" ...XXXXXX\",
-\"  ....XXXX\",
-\"  oo....XX\",
-\"  oooo....\",
-\"  ooooOOOO\",
-\"  ooOOOOXX\",
-\"  OOOOXXXX\",
-\" OOOXXXXXX\",
-\" OXXXXXXXX\"};")))
-	 ((featurep 'x)
-	  (vector 'xbm
-		  :data
-		  (list 10 10
-			(concat "\000\000\006\000\036\000\176\000\346\001"
-				"\236\001\146\000\036\000\006\000\000\000"))))
-	 (t "+")))
-  "Bitmap object for outline depressed right glyph.")
-
-(defvar outline-glyph-menu
-  '("Outline Commands"
-    ["Hide all"		hide-body			t]
-    ["Hide all subtrees" hide-subtrees-same-level	t]
-    ["Hide subtree"	hide-subtree                    t]
-;   ["Hide body"        hide-body                       t]
-    "---"
-    ["Show all"		show-all			t]
-    ["Show subtree"	show-subtree                    t]
-    ["Show body"        show-entry                      t]
-    "---"
-    ["Update buffer"	outline-add-glyphs		t]
-    ["Rescan buffer"	outline-rescan-buffer		t])
-  "Menu of commands for outline glyphs.")
-
-(set-glyph-contrib-p outline-down-arrow nil)
-(set-glyph-contrib-p outline-up-arrow nil)
-(set-glyph-contrib-p outline-down-arrow-mask nil)
-(set-glyph-contrib-p outline-up-arrow-mask nil)
-(set-glyph-contrib-p outline-right-arrow nil)
-(set-glyph-contrib-p outline-right-arrow-mask nil)
-
-(require 'annotations)
-(require 'advice)			; help me doctor !
-(require 'outline)
-(require 'func-menu)			; for those most excellent regexps.
-
-(add-hook 'outline-mode-hook 'outline-mouse-hooks)
-(add-hook 'outline-minor-mode-hook 'outline-mouse-hooks)
-;; I thought this was done already ...
-(make-variable-buffer-local 'outline-regexp)
-(make-variable-buffer-local 'outline-level)
-
-(cond (outline-sync-with-func-menu
-       (add-hook 'fume-found-function-hook 'outline-heading-add-glyph-1)
-       (setq-default fume-rescan-buffer-hook '(lambda () 
-						(outline-minor-mode 1)))))
-
-(defadvice fume-set-defaults (after fume-set-defaults-ad activate)
-  "Advise fume-set-defaults to setup outline regexps."
-  (if (and (not (assq 'outline-regexp (buffer-local-variables)))
-	   fume-function-name-regexp)
-      (progn
-	(setq outline-regexp (if (listp fume-function-name-regexp)
-				 (car fume-function-name-regexp)
-			       fume-function-name-regexp))
-	(setq outline-level '(lambda () 1)))))
-
-(defadvice outline-minor-mode (after outline-mode-mouse activate)
-  "Advise outline-minor-mode to delete glyphs when switched off."
-  (if (not outline-minor-mode)
-      (progn 
-	(outline-delete-glyphs)
-	(show-all))))
-
-;; advise all outline commands so that glyphs are synced after use
-(defadvice show-all (after show-all-ad activate)
-  "Advise show-all to sync headings."
-  (outline-sync-visible-sub-headings-in-region (point-min) (point-max)))
-
-(defadvice hide-subtree (after hide-subtree-ad activate)
-  "Advise hide-subtree to sync headings."
-  (outline-sync-visible-sub-headings))
-
-(defadvice hide-entry (after hide-entry-ad activate)
-  "Advise hide-entry to sync headings."
-  (outline-sync-visible-sub-headings))
-
-(defadvice hide-body (after hide-body-ad activate)
-  "Advise hide-body to sync headings."
-  (outline-sync-visible-sub-headings-in-region (point-min) (point-max)))
-
-(defadvice show-subtree (after show-subtree-ad activate)
-  "Advise show-subtree to sync headings."
-  (outline-sync-visible-sub-headings))
-
-(defadvice show-entry (after show-entry-ad activate)
-  "Advise shown-entry to sync headings."
-  (outline-sync-visible-sub-headings))
-
-;;;###autoload
-(defun outl-mouse-mode ()
-  "Calls outline-mode, with outl-mouse extensions"
-  (interactive)
-  (outline-mode))
-    
-;;;###autoload
-(defun outl-mouse-minor-mode (&optional arg)
-  "Toggles outline-minor-mode, with outl-mouse extensions"
-  (interactive "P")
-  (outline-minor-mode arg))
-
-(defun hide-subtrees-same-level ()
-  "Hide all subtrees below the current level."
-  (interactive)
-  (save-excursion
-    (while (progn
-	     (hide-subtree)
-      	     (condition-case nil
-		 (progn
-		   (outline-forward-same-level 1)
-		   t)
-	       (error nil))))))
-
-(defun outline-mouse-hooks ()
-  "Hook for installing outlining with the mouse."
-  ;; use function menu regexps if not set
-  (fume-set-defaults)
-  ;; only add glyphs when we're not synced.
-  (if (not outline-sync-with-func-menu) (outline-add-glyphs))
-  ;; add C-a to local keymap
-  (let ((outline (cond ((keymapp (lookup-key (current-local-map)
-					     outline-minor-mode-prefix))
-			(lookup-key (current-local-map)
-				    outline-minor-mode-prefix))
-		       (t
-			(define-key (current-local-map)
-			  outline-minor-mode-prefix (make-sparse-keymap))
-			(lookup-key (current-local-map) 
-				    outline-minor-mode-prefix)))))
-    (define-key outline "\C-a" 'outline-heading-add-glyph)
-    (define-key outline-mode-map "\C-c\C-a" 'outline-heading-add-glyph)))
-
-(defun outline-add-glyphs ()
-  "Add annotations and glyphs to all heading lines that don't have them."
-  (interactive)
-  (save-excursion
-    (and outline-scanning-message (display-message
-				   'progress
-				   (format outline-scanning-message 0)))
-    (goto-char (point-min))
-    (if (not (outline-on-heading-p)) (outline-next-visible-heading-safe))
-    (while 
-	(progn
-	  (outline-heading-add-glyph-1)
-	  (and outline-scanning-message 
-	       (display-message
-		'progress
-		(format outline-scanning-message (fume-relative-position))))
-	  (outline-next-visible-heading-safe)))
-    (and outline-scanning-message 
-	 (display-message
-	  'progress
-	  (format "%s done" (format outline-scanning-message 100))))))
-
-(defun outline-delete-glyphs ()
-  "Remove annotations and glyphs from heading lines."
-  (save-excursion
-    (mapcar 'outline-heading-delete-glyph (annotation-list))))
-
-(defun outline-rescan-buffer ()
-  "Remove and insert all annotations."
-  (interactive)
-  (outline-delete-glyphs)
-  (outline-add-glyphs)
-  (save-excursion
-    (outline-sync-visible-sub-headings-in-region (point-min) (point-max))))
-
-(defun outline-heading-delete-glyph (ext)
-  "Delete annotation and glyph from a heading with annotation EXT."
-  (if (and 
-       (progn
-	 (goto-char (extent-start-position ext))
-	 (beginning-of-line)
-	 (outline-on-heading-p))
-       (extent-property ext 'outline))
-      (delete-annotation ext))
-  nil)
-
-(defun outline-heading-add-glyph ()
-  "Interactive version of outline-heading-add-glyph-1."
-  (interactive)
-  (save-excursion
-    (outline-heading-add-glyph-1)))
-
-(defun outline-heading-add-glyph-1 ()
-  "Add glyph to the end of heading line which point is on.
- Returns nil if point is not on a heading or glyph already exists."
-  (if (or (not (outline-on-heading-p))
-	  (outline-heading-has-glyph-p)
-	  (save-excursion (forward-line) (outline-on-heading-p)))
-      nil
-    (outline-back-to-heading)
-    (let ((anot2 
-	   (make-annotation (if outline-mac-style 
-				outline-right-arrow
-			      outline-down-arrow)
-			    (save-excursion (if outline-glyphs-on-left nil
-					      (outline-end-of-heading))
-					    (point))
-			    'text nil t 
-			    (if outline-mac-style
-				outline-right-arrow-mask
-			      outline-down-arrow-mask)))
-	  (anot1 
-	   (make-annotation (if outline-mac-style
-				outline-down-arrow
-			      outline-up-arrow)
-			    (save-excursion (if outline-glyphs-on-left nil
-					      (outline-end-of-heading))
-					    (point))
-			    'text nil t 
-			    (if outline-mac-style
-				outline-down-arrow-mask
-			      outline-up-arrow-mask))))
-      ;; we cunningly make the annotation data point to its twin.
-      (set-annotation-data anot1 anot2)
-      (set-extent-property anot1 'outline 'up)
-      (set-annotation-action anot1 'outline-up-click)
-      (set-annotation-menu anot1 outline-glyph-menu)
-      (set-extent-priority anot1 1)
-      (set-annotation-data anot2 anot1)
-      (set-extent-property anot2 'outline 'down)
-      (set-annotation-menu anot2 outline-glyph-menu)
-      (set-annotation-action anot2 'outline-down-click)
-      (annotation-hide anot2))
-    t))
-
-(defun outline-heading-has-glyph-p ()
-  "Return t if heading has an outline glyph."
-  (catch 'found
-    (mapcar
-     '(lambda(a)
-	(if (extent-property a 'outline)
-	    (throw 'found t)))
-     (annotations-in-region (save-excursion (outline-back-to-heading) (point))
-			    (save-excursion (outline-end-of-heading) 
-					    (+ 1 (point)))
-			    (current-buffer)))
-    nil))
-
-(defun outline-sync-visible-sub-headings-in-region (pmin pmax)
-  "Make sure all annotations on headings in region PMIN PMAX are 
-displayed correctly."
-  (mapcar '(lambda (x) 
-	     (goto-char (extent-start-position x))
-	     (beginning-of-line)
-	     (cond ((and (eq (extent-property x 'outline) 'down)
-			 ;; skip things we can't see
-			 (not (eq (preceding-char) ?\^M)))
-		    (if (outline-more-to-hide)
-			;; reveal my twin
-			(annotation-reveal (annotation-data x))
-		      (annotation-hide (annotation-data x)))
-		    (if (not (outline-hidden-p))
-			;; hide my self
-			(annotation-hide x)
-		      (annotation-reveal x)))))
-	  (annotations-in-region pmin pmax (current-buffer))))
-
-(defun outline-sync-visible-sub-headings ()
-  "Make sure all annotations on sub-headings below the one point is on are 
-displayed correctly."
-  (outline-sync-visible-sub-headings-in-region 
-   (point) 
-   (progn (outline-end-of-subtree) (point))))
-
-(defun outline-fold-out (annotation)
-  "Fold out the current heading."
-  (beginning-of-line)
-;  (if (not (equal (condition-case nil
-;		      (save-excursion (outline-next-visible-heading 1)
-;				      (point))
-;		    (error nil))
-;		  (save-excursion (outline-next-heading) 
-;				  (if (eobp) nil (point)))))
-  (if (save-excursion (outline-next-heading) 
-		      (eq (preceding-char) ?\^M))
-      (progn 
-	(save-excursion (show-children))
-	(outline-sync-visible-sub-headings))
-    ;; mess with single entry
-    (if (outline-hidden-p) 
-	(progn 
-	  (save-excursion (show-entry))
-	  ;; reveal my twin and hide me
-	  (annotation-hide annotation)
-	  (annotation-reveal (annotation-data annotation))))))
-
-(defun outline-fold-in (annotation)
-  "Fold in the current heading."
-  (beginning-of-line)
-  ;; mess with single entries
-  (if (not (outline-hidden-p))
-      (progn
-	(save-excursion (hide-entry))
-	(if (not (outline-more-to-hide))
-	    (annotation-hide annotation))
-	(annotation-reveal (annotation-data annotation)))
-    ;; otherwise look for more leaves
-    (save-excursion 
-      (if (outline-more-to-hide t)
-	  (hide-subtree)
-	(hide-leaves)))
-    ;; sync everything
-    (outline-sync-visible-sub-headings)))
-
-(defun outline-more-to-hide (&optional arg)
-  "Return t if there are more visible sub-headings or text.
-With ARG return t only if visible sub-headings have no visible text."
-  (if (not (outline-hidden-p))
-      (if arg nil t)
-    (save-excursion
-      (and (< (funcall outline-level) (condition-case nil
-					  (progn 
-					    (outline-next-visible-heading 1)
-					    (funcall outline-level))
-					(error 0)))
-	   (if (and (not (outline-hidden-p)) arg)
-	       nil t)))))
-
-(defun outline-hidden-p ()
-  "Return t if point is on the header of a hidden subtree."
-  (save-excursion
-    (let ((end-of-entry (save-excursion (outline-next-heading))))
-      ;; Make sure that the end of the entry really exists.
-      (if (not end-of-entry)
-	  (setq end-of-entry (point-max)))
-      (outline-back-to-heading)
-      ;; If there are ANY ^M's, the entry is hidden.
-      (search-forward "\^M" end-of-entry t))))
-
-(defun outline-next-visible-heading-safe ()
-  "Safely go to the next visible heading. 
-nil is returned if there is none."
-  (condition-case nil
-      (progn
-	(outline-next-visible-heading 1)
-	t)
-    (error nil)))
-
-(defun outline-up-click (data ev)
-  "Annotation action for clicking on an up arrow.
-DATA is the annotation data. EV is the mouse click event."
-  (save-excursion
-    (goto-char (extent-end-position (event-glyph-extent ev)))
-    (funcall outline-fold-in-function (event-glyph-extent ev)))
-  (if outline-move-point-after-click
-      (progn
-	(goto-char (extent-end-position (event-glyph-extent ev)))
-	(beginning-of-line))))
-; This line demonstrates a bug in redisplay
-(defun outline-down-click (data ev)
-  "Annotation action for clicking on a down arrow.
-DATA is the annotation data. EV is the mouse click event."
-  (save-excursion
-    (goto-char (extent-end-position (event-glyph-extent ev)))
-    (funcall outline-fold-out-function (event-glyph-extent ev)))
-  (if outline-move-point-after-click
-      (progn
-	(goto-char (extent-end-position (event-glyph-extent ev)))
-	(beginning-of-line))))
-
-
-(provide 'outl-mouse)
-(provide 'outln-18)			; fool auctex - outline is ok now.
-
-;; Local Variables:
-;; outline-regexp: ";;; \\|(def.."
-;; End:
-
-;;; outl-mouse.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/page-ext.el b/xemacs-packages/lisp/edit-utils/page-ext.el
deleted file mode 100644
index 38bd7a6d..00000000
--- a/xemacs-packages/lisp/edit-utils/page-ext.el
+++ /dev/null
@@ -1,793 +0,0 @@
-;;; page-ext.el --- extended page handling commands
-
-;; Copyright (C) 1990, 1991, 1993, 1994 Free Software Foundation
-
-;; Maintainer: Robert J. Chassell 
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; You may use these commands to handle an address list or other
-;; small data base.
-
-
-;;; Summary
-
-;; The current page commands are:
-
-;;     forward-page         C-x ]
-;;     backward-page        C-x [
-;;     narrow-to-page       C-x p
-;;     count-lines-page     C-x l
-;;     mark-page            C-x C-p  (change this to C-x C-p C-m)
-;;     sort-pages           not bound
-;;     what-page            not bound
-
-;; The new page handling commands all use `C-x C-p' as a prefix.  This
-;; means that the key binding for `mark-page' must be changed.
-;; Otherwise, no other changes are made to the current commands or
-;; their bindings.
-
-;; New page handling commands:
-
-;;     next-page                        C-x C-p C-n
-;;     previous-page                    C-x C-p C-p
-;;     search-pages                     C-x C-p C-s
-;;     add-new-page                     C-x C-p C-a
-;;     sort-pages-buffer                C-x C-p s      
-;;     set-page-delimiter               C-x C-p C-l
-;;     pages-directory                  C-x C-p C-d   
-;;     pages-directory-for-addresses    C-x C-p d
-;;        pages-directory-goto          C-c C-c
-
-
-;;; Using the page commands
- 
-;; The page commands are helpful in several different contexts.  For
-;; example, programmers often divide source files into sections using the
-;; `page-delimiter'; you can use the `pages-directory' command to list
-;; the sections.
-
-;; You may change the buffer local value of the `page-delimiter' with
-;; the `set-page-delimiter' command.  This command is bound to `C-x C-p
-;; C-l' The command prompts you for a new value for the page-delimiter.
-;; Called with a prefix-arg, the command resets the value of the
-;; page-delimiter to its original value.
-
-;; You may set several user options:
-;;
-;;   The `pages-directory-buffer-narrowing-p' variable causes the
-;;   `pages-directory-goto' command to narrow to the destination page.
-;;
-;;   The `pages-directory-for-adding-page-narrowing-p' variable, causes the
-;;   `add-new-page' command to narrow to the new entry.
-;;
-;;   The `pages-directory-for-adding-new-page-before-current-page-p' variable
-;;   causes the `add-new-page' command to insert a new page before current
-;;   page.
-;;
-;; These variables are true by default.
-;;
-;; Additional, addresses-related user options are described in the next page
-;; of this file.
-
-
-;;; Handling an address list or small data base
-
-;; You may use the page commands to handle an address list or other
-;; small data base.  Put each address or entry on its own page.  The
-;; first line of text in each page is a `header line' and is listed by
-;; the `pages-directory' or `pages-directory-for-addresses' command.
-
-;; Specifically:
-;; 
-;;   1. Begin each entry with a `page-delimiter' (which is, by default,
-;;      `^L' at the beginning of the line).
-;; 
-;;   2. The first line of text in each entry is the `heading line'; it
-;;      will appear in the pages-directory-buffer which is constructed
-;;      using the `C-x C-p C-d' (pages-directory) command or the `C-x
-;;      C-p d' (pages-directory-for-addresses) command.
-;; 
-;;      The heading line may be on the same line as the page-delimiter
-;;      or it may follow after.  It is the first non-blank line on the
-;;      page.  Conventionally, the heading line is placed on the line
-;;      immediately following the line containing page-delimiter.
-;;
-;;   3. Follow the heading line with the body of the entry.  The body
-;;      extends up to the next `page-delimiter'.  The body may be of any
-;;      length.  It is conventional to place a blank line after the last
-;;      line of the body.
-
-;; For example, a file might look like this:
-;; 
-;;     FSF
-;;     Free Software Foundation
-;;     59 Temple Place - Suite 330
-;;     Boston, MA 02111-1307  USA.
-;;     (617) 542-5942
-;;     gnu@prep.ai.mit.edu
-;; 
-;;     
-;;     House Subcommittee on Intellectual Property,
-;;     U.S. House of Representatives,
-;;     Washington, DC  20515
-;;     
-;;     Congressional committee concerned with permitting or preventing
-;;     monopolistic restrictions on the use of software technology.
-;; 
-;;     
-;;     George Lakoff
-;;     ``Women, Fire, and Dangerous Things:
-;;     What Categories Reveal about the Mind''
-;;     1987, Univ. of Chicago Press
-;; 
-;;     About philosophy, Whorfian effects, and linguistics.
-;; 
-;;      
-;;     OBI   (On line text collection.)
-;;     Open Book Initiative
-;;     c/o Software Tool & Die
-;;     1330 Beacon St, Brookline, MA 02146 USA
-;;     (617) 739-0202 
-;;     obi@world.std.com
-
-;; In this example, the heading lines are:
-;;
-;;     FSF
-;;     House Subcommittee on Intellectual Property
-;;     George Lakoff
-;;     OBI (On line text collection.)
-
-;; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the
-;; buffer alphabetically.
-
-;; You may use any of the page commands, including the `next-page',
-;; `previous-page', `add-new-page', `mark-page', and `search-pages'
-;; commands.
-
-;; You may use either the `C-x C-p d' (pages-directory-for-addresses)
-;; or the `C-x C-p C-d' (pages-directory) command to construct and
-;; display a directory of all the heading lines.
-
-;; In the directory, you may position the cursor over a heading line
-;; and type `C-c C-c' (pages-directory-goto) to go to the entry to
-;; which it refers in the pages buffer.
-
-;; You can type `C-c C-p C-a' (add-new-page) to add a new entry in the
-;; pages buffer or address file.  This is the same command you use to
-;; add a new entry when you are in the pages buffer or address file.
-
-;; If you wish, you may create several different directories,
-;; one for each different buffer.
-
-;; `pages-directory-for-addresses' in detail
-
-;; The `pages-directory-for-addresses' assumes a default addresses
-;; file.  You do not need to specify the addresses file but merely type
-;; `C-x C-p d' from any buffer.  The command finds the file, constructs
-;; a directory for it, and switches you to the directory.  If you call
-;; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a
-;; file name.
-
-;; You may customize the addresses commands:
-
-;;   The `pages-addresses-file-name' variable determines the name of
-;;   the addresses file; by default it is "~/addresses".
-
-;;   The `pages-directory-for-addresses-goto-narrowing-p' variable
-;;   determines whether `pages-directory-goto' narrows the addresses
-;;   buffer to the entry, which it does by default.
-
-;;   The `pages-directory-for-addresses-buffer-keep-windows-p' variable
-;;   determines whether `pages-directory-for-addresses' deletes other
-;;   windows to show as many lines as possible on the screen or works
-;;   in the usual Emacs manner and keeps other windows.  Default is to
-;;   keep other windows.
-
-;;   The `pages-directory-for-adding-addresses-narrowing-p' variable
-;;   determines whether `pages-directory-for-addresses' narrows the
-;;   addresses buffer to a new entry when you are adding that entry.
-;;   Default is to narrow to new entry, which means you see a blank
-;;   screen before you write the new entry.
-
-;; `pages-directory' in detail
-
-;; Call the `pages-directory' command from the buffer for which you
-;; want a directory created; it creates a directory for the buffer and
-;; pops you to the directory.
-
-;; The `pages-directory' command has several options:
-
-;;   Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory'
-;;   prompts you for a regular expression and only lists only those
-;;   header lines that are part of pages that contain matches to the
-;;   regexp.  In the example above, `C-u C-x C-p C-d 617 RET' would
-;;   match the telephone area code of the first and fourth entries, so
-;;   only the header lines of those two entries would appear in the
-;;   pages-directory-buffer.
-;; 
-;;   Called with a numeric argument, the `pages-directory' command
-;;   lists the number of lines in each page.  This is helpful when you
-;;   are printing hardcopy.  
-
-;;   Called with a negative numeric argument, the `pages-directory'
-;;   command lists the lengths of pages whose contents match a regexp.
-
-;;; Code:
-
-
-;;; Customarily customizable variable definitions
-
-(defgroup pages nil
-  "Extended page-handling commands."
-  :group 'extensions)
-
-
-(defcustom pages-directory-buffer-narrowing-p t
-  "*If non-nil, `pages-directory-goto' narrows pages buffer to entry."
-  :type 'boolean
-  :group 'pages)
-
-(defcustom pages-directory-for-adding-page-narrowing-p t
-  "*If non-nil, `add-new-page' narrows page buffer to new entry."
-  :type 'boolean
-  :group 'pages)
-
-(defcustom pages-directory-for-adding-new-page-before-current-page-p t
-  "*If non-nil, `add-new-page' inserts new page before current page."
-  :type 'boolean
-  :group 'pages)
-
-
-;;; Addresses related variables
-
-(defcustom pages-addresses-file-name "~/addresses"
-  "*Standard name for file of addresses. Entries separated by page-delimiter.
-Used by `pages-directory-for-addresses' function."
-  :type 'file
-  :group 'pages)
-
-(defcustom pages-directory-for-addresses-goto-narrowing-p t
-  "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry."
-  :type 'boolean
-  :group 'pages)
-
-(defcustom pages-directory-for-addresses-buffer-keep-windows-p t
-  "*If nil, `pages-directory-for-addresses' deletes other windows."
-  :type 'boolean
-  :group 'pages)
-
-(defcustom pages-directory-for-adding-addresses-narrowing-p t
-  "*If non-nil, `add-new-page' narrows addresses buffer to new entry."
-  :type 'boolean
-  :group 'pages)
-
-
-;;; Key bindings for page handling functions
-
-(global-unset-key "\C-x\C-p")
-
-(defvar ctl-x-ctl-p-map (make-sparse-keymap)
-  "Keymap for subcommands of C-x C-p, which are for page handling.")
-
-(define-key ctl-x-map "\C-p" 'ctl-x-ctl-p-prefix)
-(fset 'ctl-x-ctl-p-prefix ctl-x-ctl-p-map)
-
-(define-key ctl-x-ctl-p-map "\C-n" 'next-page)
-(define-key ctl-x-ctl-p-map "\C-p" 'previous-page)
-(define-key ctl-x-ctl-p-map "\C-a" 'add-new-page)
-(define-key ctl-x-ctl-p-map "\C-m" 'mark-page)
-(define-key ctl-x-ctl-p-map "\C-s" 'search-pages)
-(define-key ctl-x-ctl-p-map "s"    'sort-pages-buffer)
-(define-key ctl-x-ctl-p-map "\C-l" 'set-page-delimiter)
-(define-key ctl-x-ctl-p-map "\C-d" 'pages-directory)
-(define-key ctl-x-ctl-p-map "d"    'pages-directory-for-addresses)
-
-
-;;; Page movement function definitions
-
-(defun next-page (&optional count)
-  "Move to the next page bounded by the `page-delimiter' variable.
-With arg (prefix if interactive), move that many pages."
-  (interactive "p")
-  (or count (setq count 1))
-  (widen)
-  ;; Cannot use forward-page because of problems at page boundaries.
-  (while (and (> count 0) (not (eobp)))
-    (if (re-search-forward page-delimiter nil t)
-        nil
-      (goto-char (point-max)))
-    (setq count (1- count)))
-  ;; If COUNT is negative, we want to go back -COUNT + 1 page boundaries.
-  ;; The first page boundary we reach is the top of the current page,
-  ;; which doesn't count.
-  (while (and (< count 1) (not (bobp)))
-    (if (re-search-backward page-delimiter nil t)
-	(goto-char (match-beginning 0))
-      (goto-char (point-min)))
-    (setq count (1+ count)))
-  (narrow-to-page)
-  (goto-char (point-min))
-  (recenter 0))
-
-(defun previous-page (&optional count)
-  "Move to the previous page bounded by the `page-delimiter' variable.
-With arg (prefix if interactive), move that many pages."
-  (interactive "p")
-  (or count (setq count 1))
-  (next-page (- count)))
-
-
-;;; Adding and searching pages
-
-(defun add-new-page (header-line)
-  "Insert new page.  Prompt for header line.
-
-If point is in the pages directory buffer, insert the new page in the
-buffer associated with the directory.
-
-Insert the new page just before current page if
-  pages-directory-for-adding-new-page-before-current-page-p  variable
-is non-nil.  Else insert at exact location of point.
-
-Narrow to new page if
-  pages-directory-for-adding-page-narrowing-p variable
-is non-nil.
-
-Page begins with a `^L' as the default page-delimiter.  
-Use \\[set-page-delimiter] to change the page-delimiter.
-Point is left in the body of page."
-  (interactive "sHeader line: ")
-  (widen)
-  ;; If in pages directory buffer
-  (if (eq major-mode 'pages-directory-mode) 
-      (progn
-        ;; Add new page before or after current page?
-        (if pages-directory-for-adding-new-page-before-current-page-p
-            (pages-directory-goto)
-          (pages-directory-goto)
-          (forward-page)
-          (or (eobp) (forward-line -1)))))
-  (widen)
-  ;; Move point before current delimiter if desired.
-  (and pages-directory-for-adding-new-page-before-current-page-p
-       (if (re-search-backward page-delimiter nil t)
-           (goto-char (match-beginning 0))
-         ;; If going to beginning of file, insert a page-delimiter
-         ;; before current first page.
-         (goto-char (point-min))
-         (insert
-          (format "%s\n"
-                  ;; Remove leading `^' from page-delimiter string
-                  (if (eq '^ (car (read-from-string page-delimiter)))
-                      (substring page-delimiter 1))))         
-         (goto-char (point-min))))
-  ;; Insert page delimiter at beginning of line.
-  (if (not (looking-at "^."))   (forward-line 1))
-  (insert (format "%s\n%s\n\n\n" 
-                  (if (eq '^ (car (read-from-string page-delimiter)))
-                      (substring page-delimiter 1))
-                  header-line))
-  (forward-line -1)
-  (and pages-directory-for-adding-page-narrowing-p (narrow-to-page)))
-
-(defvar pages-last-search nil
-  "Value of last regexp searched for.  Initially, nil.")
-
-(defun search-pages (regexp)
-  "Search for REGEXP, starting from point, and narrow to page it is in."
-  (interactive (list
-                (read-string
-                 (format "Search for `%s' (end with RET): "
-                         (or pages-last-search "regexp")))))
-  (if (equal regexp "")
-      (setq regexp pages-last-search)
-    (setq pages-last-search regexp))
-  (widen)
-  (re-search-forward regexp)
-  (narrow-to-page))
-
-
-;;; Sorting pages
-
-(autoload 'sort-subr "sort" "Primary function for sorting." t nil)
-
-(defun sort-pages-in-region (reverse beg end)
-  "Sort pages in region alphabetically.  Prefix arg means reverse order.  
-
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort)."
-
-;;; This sort function handles ends of pages differently than
-;;; `sort-pages' and works better with lists of addresses and similar
-;;; files.
-
-  (interactive "P\nr")
-  (save-restriction
-    (narrow-to-region beg end)
-    (goto-char (point-min))
-    ;;; `sort-subr' takes three arguments
-    (sort-subr reverse
-
-               ;; NEXTRECFUN is called with point at the end of the
-               ;; previous record. It moves point to the start of the
-               ;; next record.
-	       (function (lambda ()
-                           (re-search-forward page-delimiter nil t)
-                           (skip-chars-forward " \t\n")
-                           ))
-
-               ;; ENDRECFUN is called with point within the record.
-               ;; It should move point to the end of the record.
-	       (function (lambda ()
-                           (if (re-search-forward
-                                page-delimiter
-                                nil
-                                t)
-                               (goto-char (match-beginning 0))
-                             (goto-char (point-max))))))))
-
-(defun sort-pages-buffer (&optional reverse)
-  "Sort pages alphabetically in buffer.  Prefix arg means reverse order. 
-\(Non-nil arg if not interactive.\)"
-
-  (interactive "P")
-  (or reverse (setq reverse nil))
-  (widen)
-  (let ((beginning (point-min))
-        (end (point-max)))
-    (sort-pages-in-region reverse beginning end)))
-
-
-;;; Pages directory ancillary definitions
-
-(defvar pages-directory-previous-regexp nil
-  "Value of previous regexp used by `pages-directory'.
-\(This regular expression may be used to select only those pages that
-contain matches to the regexp.\)")
-
-(defvar pages-buffer nil
-  "The buffer for which the pages-directory function creates the directory.")
-
-(defvar pages-directory-prefix "*Directory for:"
-  "Prefix of name of temporary buffer for pages-directory.")
-
-(defvar pages-pos-list nil
-  "List containing the positions of the pages in the pages-buffer.")
-
-(defvar pages-directory-map nil
-  "Keymap for the pages-directory-buffer.")
-
-(if pages-directory-map
-    ()
-  (setq pages-directory-map (make-sparse-keymap))
-  (define-key pages-directory-map "\C-c\C-c"
-    'pages-directory-goto)
-  (define-key pages-directory-map "\C-c\C-p\C-a" 'add-new-page))
-
-(defvar original-page-delimiter "^\f"
-  "Default page delimiter.")
-
-(defun set-page-delimiter (regexp reset-p)
-  "Set buffer local value of page-delimiter to REGEXP.
-Called interactively with a prefix argument, reset `page-delimiter' to
-its original value.
-
-In a program, non-nil second arg causes first arg to be ignored and
-resets the page-delimiter to the original value."
-  
-  (interactive
-   (if current-prefix-arg
-       (list original-page-delimiter "^\f")
-     (list (read-string "Set page-delimiter to regexp: " page-delimiter)
-           nil)))
-  (make-local-variable 'original-page-delimiter)
-  (make-local-variable 'page-delimiter)
-  (setq original-page-delimiter
-        (or original-page-delimiter page-delimiter))
-  (if (not reset-p)
-      (setq page-delimiter regexp)
-    (setq page-delimiter original-page-delimiter))
-  (if (interactive-p)
-      (message "The value of `page-delimiter' is now: %s" page-delimiter)))
-
-
-;;; Pages directory main definitions
-
-(defun pages-directory
-  (pages-list-all-headers-p count-lines-p &optional regexp)
-  "Display a directory of the page headers in a temporary buffer.
-A header is the first non-blank line after the page-delimiter.
-\\[pages-directory-mode]
-You may move point to one of the lines in the temporary buffer,
-then use \\ to go to the same line in the pages buffer.
-
-In interactive use:
-
-    1. With no prefix arg, display all headers.
-
-    2. With prefix arg, display the headers of only those pages that
-       contain matches to a regular expression for which you are
-       prompted.
-
-    3. With numeric prefix arg, for every page, print the number of
-       lines within each page.
-
-    4. With negative numeric prefix arg, for only those pages that
-       match a regular expression, print the number of lines within
-       each page.
-
-When called from a program, non-nil first arg means list all headers;
-non-nil second arg means print numbers of lines in each page; if first
-arg is nil, optional third arg is regular expression.
-
-If the buffer is narrowed, the `pages-directory' command creates a
-directory for only the accessible portion of the buffer."
-  
-  (interactive
-   (cond ((not current-prefix-arg)
-          (list t nil nil))
-         ((listp current-prefix-arg) 
-          (list nil
-                nil
-                (read-string
-                 (format "Select according to `%s' (end with RET): "
-                         (or pages-directory-previous-regexp "regexp")))))
-         ((> (prefix-numeric-value current-prefix-arg) 0)
-          (list t t nil))
-         ((< (prefix-numeric-value current-prefix-arg) 0)          
-          (list nil
-                t
-                (read-string
-                 (format "Select according to `%s' (end with RET): "
-                         (or pages-directory-previous-regexp "regexp")))))))
-  
-  (if (equal regexp "")
-      (setq regexp pages-directory-previous-regexp)
-    (setq pages-directory-previous-regexp regexp))
-  
-  (if (interactive-p)
-      (message "Creating directory for: %s "
-               (buffer-name)))
-  
-  (let ((target-buffer (current-buffer))
-        (pages-directory-buffer
-	 (concat pages-directory-prefix " " (buffer-name)))
-        (linenum 1)
-        (pages-buffer-original-position (point))
-        (pages-buffer-original-page 0))
-    
-    ;; `with-output-to-temp-buffer' binds the value of the variable
-    ;; `standard-output' to the buffer named as its first argument,
-    ;; but does not switch to that buffer.
-    (with-output-to-temp-buffer pages-directory-buffer
-      (save-excursion
-        (set-buffer standard-output)
-        (pages-directory-mode)
-        (insert
-         "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
-        (setq pages-buffer target-buffer)
-        (setq pages-pos-list nil))
-      
-      (if pages-list-all-headers-p
-          
-          ;; 1. If no prefix argument, list all headers
-          (save-excursion
-            (goto-char (point-min))
-            
-            ;; (a) Point is at beginning of buffer; but the first
-            ;;     page may not begin with a page-delimiter
-            (save-restriction
-              ;; If page delimiter is at beginning of buffer, skip it
-              (if (and (save-excursion
-                         (re-search-forward page-delimiter nil t))
-                       (= 1 (match-beginning 0)))
-                  (goto-char (match-end 0)))
-              (narrow-to-page)
-              (pages-copy-header-and-position count-lines-p))
-            
-            ;; (b) Search within pages buffer for next page-delimiter
-            (while (re-search-forward page-delimiter nil t)
-              (pages-copy-header-and-position count-lines-p)))
-        
-        ;; 2. Else list headers whose pages match regexp.
-        (save-excursion
-          ;; REMOVED  save-restriction  AND  widen  FROM HERE
-          (goto-char (point-min))
-          
-          ;; (a) Handle first page
-          (save-restriction
-            (narrow-to-page)
-            ;; search for selection regexp
-            (if (save-excursion (re-search-forward regexp nil t))
-                (pages-copy-header-and-position count-lines-p)))
-          
-          ;; (b) Search for next page-delimiter
-          (while (re-search-forward page-delimiter nil t)
-            (save-restriction
-              (narrow-to-page)
-              ;; search for selection regexp
-              (if (save-excursion (re-search-forward regexp nil t))
-                  (pages-copy-header-and-position count-lines-p)
-                )))))
-      
-      (set-buffer standard-output)
-      ;; Put positions in increasing order to go with buffer.
-      (setq pages-pos-list (nreverse pages-pos-list))
-      (if (interactive-p)
-          (message "%d matching lines in: %s"
-                   (length pages-pos-list) (buffer-name target-buffer))))
-    (pop-to-buffer pages-directory-buffer)
-    (sit-for 0)  ; otherwise forward-line fails if N > window height.
-    (forward-line (if (= 0 pages-buffer-original-page)
-                      1
-                    pages-buffer-original-page))))
-
-(defun pages-copy-header-and-position (count-lines-p)
-  "Copy page header and its position to the Pages Directory.
-Only arg non-nil, count lines in page and insert before header.
-Used by `pages-directory' function."
-  
-  (let (position line-count)
-
-    (if count-lines-p
-        (save-excursion
-          (save-restriction
-            (narrow-to-page)
-            (setq line-count (count-lines (point-min) (point-max))))))
-
-    ;; Keep track of page for later cursor positioning
-    (if (<= (point) pages-buffer-original-position)
-        (setq pages-buffer-original-page
-              (1+ pages-buffer-original-page)))
-    
-    (save-excursion
-      ;; go to first non-blank char after the page-delimiter
-      (skip-chars-forward " \t\n")     
-      ;; set the marker here; this the place to which the
-      ;; `pages-directory-goto' command will go 
-      (setq position (make-marker))
-      (set-marker position (point))
-      (let ((start (point))
-            (end (save-excursion (end-of-line) (point))))
-        ;; change to directory buffer
-        (set-buffer standard-output)
-        ;; record page position 
-        (setq pages-pos-list (cons position pages-pos-list))
-        ;; insert page header
-        (insert-buffer-substring target-buffer start end))
-      
-      (if count-lines-p
-          (save-excursion
-            (beginning-of-line)
-            (insert (format "%3d: " line-count))))
-      
-      (terpri))
-    (end-of-line 1)))
-
-(defun pages-directory-mode ()
-  "Mode for handling the pages-directory buffer.
-
-Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go
-to the same line in the pages buffer."
-
-  (kill-all-local-variables)
-  (use-local-map pages-directory-map)
-  (setq major-mode 'pages-directory-mode)
-  (setq mode-name "Pages-Directory")
-  (make-local-variable 'pages-buffer)
-  (make-local-variable 'pages-pos-list)
-  (make-local-variable 'pages-directory-buffer-narrowing-p))
-
-(defun pages-directory-goto ()
-  "Go to the corresponding line in the pages buffer."
-
-;;; This function is mostly a copy of `occur-mode-goto-occurrence'
-
-  (interactive)
-  (if (or (not pages-buffer)
-	  (not (buffer-name pages-buffer)))
-      (progn
-	(setq pages-buffer nil
-	      pages-pos-list nil)
-	(error "Buffer in which pages were found is deleted.")))
-  (beginning-of-line)
-  (let* ((pages-number (1- (count-lines (point-min) (point))))
-	 (pos (nth pages-number pages-pos-list))
-         (end-of-directory-p (eobp))
-         (narrowing-p  pages-directory-buffer-narrowing-p))
-    (pop-to-buffer pages-buffer)  
-    (widen)
-    (if end-of-directory-p
-        (goto-char (point-max))
-      (goto-char (marker-position pos)))
-    (if narrowing-p (narrow-to-page))))
-
-
-;;; The `pages-directory-for-addresses' function and ancillary code
-
-(defun pages-directory-for-addresses (&optional filename)
-  "Find addresses file and display its directory.
-By default, create and display directory of `pages-addresses-file-name'.
-Optional argument is FILENAME.  In interactive use, with prefix
-argument, prompt for file name and provide completion.
-
-Move point to one of the lines in the displayed directory,
-then use \\[pages-directory-goto] to go to the same line
-in the addresses buffer.
-
-If    pages-directory-for-addresses-goto-narrowing-p    is non-nil,
-`pages-directory-goto' narrows addresses buffer to entry.
-
-If    pages-directory-for-addresses-buffer-keep-windows-p     is nil,
-this command deletes other windows when it displays the addresses 
-directory."
-
-  (interactive
-   (list (if current-prefix-arg
-             (read-file-name "Filename: " pages-addresses-file-name))))
-
-  (if (interactive-p)
-      (message "Creating directory for: %s "
-               (or filename pages-addresses-file-name)))
-  (if (file-exists-p (or filename pages-addresses-file-name))
-      (progn
-        (set-buffer
-         (find-file-noselect
-          (expand-file-name
-           (or filename pages-addresses-file-name))))
-        (widen)
-        (pages-directory t nil nil)
-        (pages-directory-address-mode)
-        (setq pages-directory-buffer-narrowing-p
-              pages-directory-for-addresses-goto-narrowing-p)
-        (or pages-directory-for-addresses-buffer-keep-windows-p
-            (delete-other-windows))
-        (save-excursion
-          (goto-char (point-min))
-          (delete-region (point) (save-excursion (end-of-line) (point)))
-          (insert
-           "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
-          (set-buffer-modified-p nil)
-          ))
-    (error "No addresses file found!")))
-
-(defun pages-directory-address-mode ()
-  "Mode for handling the Addresses Directory buffer.
-
-Move point to one of the lines in this buffer,
-then use \\[pages-directory-goto] to go
-to the same line in the pages buffer."
-
-  (use-local-map pages-directory-map)
-  (setq major-mode 'pages-directory-address-mode)
-  (setq mode-name "Addresses Directory")
-  (make-local-variable 'pages-buffer)
-  (make-local-variable 'pages-pos-list)
-  (make-local-variable 'pages-directory-buffer-narrowing-p))
-
-
-;;; Place `provide' at end of file.
-(provide 'page-ext)
-
-;;;;;;;;;;;;;;;; end of page-ext.el ;;;;;;;;;;;;;;;;
-
diff --git a/xemacs-packages/lisp/edit-utils/paren.el b/xemacs-packages/lisp/edit-utils/paren.el
deleted file mode 100644
index ec1cef85..00000000
--- a/xemacs-packages/lisp/edit-utils/paren.el
+++ /dev/null
@@ -1,413 +0,0 @@
-;;; paren.el --- highlight (un)matching parens and whole expressions
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-;; Copyright (C) 1993, 1994, 1995 Tinker Systems
-;;
-;; Author: Jonathan Stigelman 
-;; Note:   (some code scammed from simple.el and blink-paren.el)
-;; Maintainer: Jonathan Stigelman 
-;; Keywords: languages, faces
-
-;;; This file is part of XEmacs.
-;;; 
-;;; XEmacs 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.
-;;; 
-;;; XEmacs 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 XEmacs; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Synched up with: Not synched with FSF.
-;;; Way different from FSF.
-
-;;; Commentary:
-
-;; Purpose of this package:
-;;
-;;   This package highlights matching parens (or whole sexps) for easier
-;;   editing of source code, particularly lisp source code.
-;; 
-;; The `paren-highlight' hook function runs after each command and
-;; checks to see if the cursor is at a parenthesis.  If so, then it
-;; highlights, in one of several ways, the matching parenthesis.
-;; 
-;; Priority is given to matching parentheses right before the cursor because
-;; that's what makes sense when you're typing a lot of closed parentheses.
-;; 
-;; This is especially intuitive if you frequently use forward-sexp (M-C-f)
-;; and backward-sexp (M-C-b) to maneuver around in source code.
-;; 
-;; Different faces are used for matching and mismatching parens so that it
-;; is easier to see mistakes as you type them.  Audible feedback is optional.
-;; 
-;; If a (mis)matching paren is offscreen, then a message is sent to the modeline.
-;; 
-;; If paren-mode is `sexp', entire S-expressions are highlighted instead of
-;; just matching parens.
-
-;;; Code:
-
-(defgroup paren-matching nil
-  "Highlight (un)matching of parens and expressions."
-  :prefix "paren-"
-  :group 'matching)
-
-
-;;;###autoload
-(defcustom paren-mode nil
-  "*Sets the style of parenthesis highlighting.
-Valid values are nil, `blink-paren', `paren', and `sexp'.
-  nil		no parenthesis highlighting.
-  blink-paren	causes the matching paren to blink.
-  paren		causes the matching paren to be highlighted but not to blink.
-  sexp		whole expression enclosed by the local paren at its mate.
-  sexp-surround whole surrounding expression, even if point is not at paren.
-  nested	(not yet implemented) use variable shading to see the
-		nesting of an expression.  Also groks regular expressions
-		and shell quoting.
-
-This variable is global by default, but you can make it buffer-local and
-highlight parentheses differently in different major modes."
-  :type '(radio (const :tag "None (default)" nil)
-		(const :tag "Blinking Paren" blink-paren)
-		(const :tag "Highlighted Paren" paren)
-		(const :tag "Highlighted Expression" sexp)
-		(const :tag "Highlighted Surrounding Expression" sexp-surround))
-  :set (lambda (symbol value)
-	 (paren-set-mode value))
-  :initialize 'custom-initialize-default
-  :require 'paren
-  :group 'paren-matching)
-
-(defcustom paren-message-offscreen t
-  "*Non-nil means display a message if matching open paren is offscreen."
-  :type 'boolean
-  :group 'paren-matching)
-
-(defcustom paren-ding-unmatched nil
-  "*Make noise if the cursor is at an unmatched paren.
-
-If t, then typing or passing over an unmatched paren will ring the bell
-using the `paren' sound.  If nil, then the bell will not ring even if an
-unmatched paren is typed.  If neither t nor nil, then the bell will not ring
-when the cursor moves over unmatched parens but will ring if one is typed."
-  :type '(choice (const :tag "off" nil)
-		 (const :tag "on" t)
-		 (const :tag "other" other))
-  :group 'paren-matching)
-
-(defcustom paren-backwards-message nil
-  "*Control what context is reported when a matching paren is offscreen.
-
-If nil, the matching paren and the following context is reported;
-if non-nil, the matching paren and the previous context.
-
-This variable should normally be set in a language major mode hook as
-appropriate for the syntax of a program in that language."
-  :type 'boolean
-  :group 'paren-matching)
-(make-variable-buffer-local 'paren-backwards-message)
-
-
-(make-face 'paren-match)
-(or (face-differs-from-default-p 'paren-match)
-    (copy-face 'highlight 'paren-match))
-
-(make-face 'paren-mismatch)
-(cond ((face-differs-from-default-p 'paren-mismatch) nil)
-      (t (let ((color-tag (list 'x 'color))
-	       (mono-tag (list 'x 'mono))
-	       (gray-tag (list 'x 'grayscale)))
-	   (set-face-background 'paren-mismatch "DeepPink" 'global color-tag)
-	   (set-face-reverse-p 'paren-mismatch t 'global 'tty)
-	   (set-face-background 'paren-mismatch [modeline background] 'global
-				mono-tag)
-	   (set-face-foreground 'paren-mismatch [modeline foreground] 'global
-				mono-tag)
-	   (set-face-background 'paren-mismatch [modeline background] 'global
-				gray-tag)
-	   (set-face-foreground 'paren-mismatch [modeline foreground] 'global
-				gray-tag))))
-
-(make-face 'paren-blink-off)
-(or (face-differs-from-default-p 'paren-blink-off)
-    (set-face-foreground 'paren-blink-off (face-background 'default)))
-
-;; this is either paren-match or paren-mismatch...
-(defvar paren-blink-on-face nil)
-
-(defcustom paren-blink-interval 0.2
-  "*If the cursor is on a parenthesis, the matching parenthesis will blink.
-This variable controls how long each phase of the blink lasts in seconds.
-This should be a fractional part of a second (a float.)"
-  :type 'number
-  :group 'paren-matching)
-
-(defcustom paren-max-blinks (* 5 60 5)	; 5 minutes is plenty...
-  ;; idea from Eric Eide 
-  "*Maximum number of times that a matching parenthesis will blink.
-Set this to NIL if you want indefinite blinking."
-  :type '(choice (const nil) number)
-  :group 'paren-matching)
-
-;; timeout to blink the face
-(defvar paren-timeout-id nil)
-
-;; Code:
-
-(defvar paren-n-blinks)
-(defvar paren-extent nil)
-
-(defsubst pos-visible-in-window-safe (pos)
-  "safe version of pos-visible-in-window-p"
-  (condition-case nil
-      ;; #### - is this needed in XEmacs???
-      (pos-visible-in-window-p pos)
-      (args-out-of-range nil)))
-
-;; called before a new command is executed in the pre-command-hook
-;; cleanup by removing the extent and the time-out
-(defun paren-nuke-extent ()
-  (condition-case c  ; don't ever signal an error in pre-command-hook!
-      (let ((inhibit-quit t))
-	(if paren-timeout-id
-	    (disable-timeout (prog1 paren-timeout-id
-			       (setq paren-timeout-id nil))))
-	(if paren-extent
-	    (delete-extent (prog1 paren-extent
-			     (setq paren-extent nil)))))
-    (error
-     (message "paren-nuke-extent error! %s" c))))
-
-;; callback for the timeout
-;; swap the face of the extent on the matching paren
-(defun paren-blink-timeout (arg)
-  ;; The extent could have been deleted for some reason and not point to a
-  ;; buffer anymore.  So catch any error to remove the timeout.
-  (condition-case ()
-      (if (and paren-max-blinks
-	       (> (setq paren-n-blinks (1+ paren-n-blinks)) paren-max-blinks))
-	  (paren-nuke-extent)
-	(set-extent-face paren-extent 
-			 (if (eq (extent-face paren-extent)
-				 paren-blink-on-face)
-			     'paren-blink-off
-			   paren-blink-on-face)))
-    (error (paren-nuke-extent))))
-
-;; Show a match where the parenthesis is not on screen.
-;;
-;; In the forwards case (like lisp):
-;;   Display from the matching paren through to the end of the line.  If only
-;;   whitespace after the paren, then append the next line.
-;;
-;; Backwards case (like C):
-;;   Display from the matching paren back to the start of its line.  If only
-;;   whitespace before the paren, then prepend the previous line.
-
-(defun paren-describe-match (pos mismatch)  
-  (or (window-minibuffer-p (selected-window))
-      (save-excursion
-	(goto-char pos)
-	(message "%s: %s"
-		 (if mismatch "MISMATCH" "Matches")
-                 (replace-in-string
-                  (buffer-substring
-                   (save-excursion
-                     (if paren-backwards-message
-                         (progn
-                           (skip-syntax-backward " ")
-                           (beginning-of-line (if (bolp) 0 1))
-                           (skip-syntax-forward " "))
-                       (forward-char 1)
-                       (skip-syntax-forward " ")
-                       (end-of-line (if (eolp) 2 1)))
-                     (point)) 
-                   (if paren-backwards-message (1+ (point)) (point)))
-                  "[\n\t ]+" " " t)))))
-
-(defun paren-maybe-ding ()
-  (and (or (eq paren-ding-unmatched t)
-	   (and paren-ding-unmatched
-		(eq this-command 'self-insert-command)))
-       (progn
-	 (message "Unmatched parenthesis.")
-	 (ding nil 'paren))))
-
-;; Find the place to show, if there is one,
-;; and show it until input arrives.
-(defun paren-highlight ()
-  "This highlights matching parentheses.
-
-See the variables:
-  paren-message-offscreen   use modeline when matching paren is offscreen?
-  paren-ding-unmatched	    make noise when passing over mismatched parens?
-  paren-mode		    'blink-paren, 'paren, 'sexp or 'sexp-surround
-  blink-matching-paren-distance  maximum distance to search for parens.
-
-and the following faces:
-  paren-match, paren-mismatch, paren-blink-off"
-
-  ;; I suppose I could check here to see if a keyboard macro is executing,
-  ;; but I did a quick empirical check and couldn't tell that there was any
-  ;; difference in performance
-
-  (let ((oldpos (point))
-	(pface nil)			; face for paren...nil kills the overlay
-	(dir (and paren-mode
-		  (not (input-pending-p))
-		  (not executing-kbd-macro)
-		  (cond ((eq (char-syntax (preceding-char)) ?\))
-			 -1)
-			((eq (char-syntax (following-char)) ?\()
-			 1))))
-	pos mismatch)
-
-    (save-excursion
-      (if (or (not dir)
-	      (not (save-restriction
-		     ;; Determine the range within which to look for a match.
-		     (if blink-matching-paren-distance
-			 (narrow-to-region
-			  (max (point-min)
-			       (- (point) blink-matching-paren-distance))
-			  (min (point-max)
-			       (+ (point) blink-matching-paren-distance))))
-
-		     ;; Scan across one sexp within that range.
-		     (condition-case nil
-			 (setq pos (scan-sexps (point) dir))
-		       ;; NOTE - if blink-matching-paren-distance is set,
-		       ;; then we can have spurious unmatched parens.
-		       (error (paren-maybe-ding)
-			      nil)))))
-
-	  ;; No paren at point, so possible highlight sexp around
-	  (when (eq paren-mode 'sexp-surround)
-	    (let ((pnt (save-excursion
-			 (condition-case nil
-			     (cons (progn (up-list -1) (point))
-				   (or (scan-lists (point) 1 0)
-				       (buffer-end 1)))
-			   (error nil)))))
-	      (when (and pnt (> (cdr pnt) (car pnt)))
-		(setq paren-extent (make-extent (car pnt) (cdr pnt)))
-		(set-extent-face paren-extent 'paren-match) 
-		(set-extent-priority paren-extent 100))))
-	    
-	;; See if the "matching" paren is the right kind of paren
-	;; to match the one we started at.
-	(let ((beg (min pos oldpos)) (end (max pos oldpos)))
-	  (setq mismatch
-		(and (/= (char-syntax (char-after beg)) ?\\)
-		     (/= (char-syntax (char-after beg)) ?\$)
-		     ;; XEmacs change
-		     (matching-paren (char-after beg))
-		     (/= (char-after (1- end))
-			 (matching-paren (char-after beg)))))
-	  (if (or (eq paren-mode 'sexp) (eq paren-mode 'sexp-surround))
-	      (setq paren-extent (make-extent beg end))))
-	(and mismatch
-	     (paren-maybe-ding))
- 	(setq pface (if mismatch
-			'paren-mismatch
-		      'paren-match))
-	(and (memq paren-mode '(blink-paren paren))
-	     (setq paren-extent (make-extent (- pos dir) pos)))
-
-	(if (and paren-message-offscreen
-		 (eq dir -1)
-                 (not (current-message))
-		 (not (window-minibuffer-p (selected-window)))
-		 (not (pos-visible-in-window-safe pos)))
-            (paren-describe-match pos mismatch))
-		 
-	;; put the right face on the extent
-	(cond (pface
-	       (set-extent-face paren-extent pface) 
-	       (set-extent-priority paren-extent 100) ; want this to be high
-	       (and (eq paren-mode 'blink-paren)
-		    (setq paren-blink-on-face pface
-			  paren-n-blinks 0
-			  paren-timeout-id
-			  (and paren-blink-interval
-			       (add-timeout paren-blink-interval
-					    'paren-blink-timeout
-					    nil
-					    paren-blink-interval))))))
-	))))
-
-
-;;;###autoload
-(defun paren-set-mode (arg &optional quiet)
-  "Cycles through possible values for `paren-mode', force off with negative arg.
-When called from lisp, a symbolic value for `paren-mode' can be passed directly.
-See also `paren-mode' and `paren-highlight'."
-  (interactive "P")
-  ;; kill off the competition, er, uh, eliminate redundancy...
-  (setq post-command-hook (delq 'show-paren-command-hook post-command-hook))
-  (setq pre-command-hook (delq 'blink-paren-pre-command pre-command-hook))
-  (setq post-command-hook (delq 'blink-paren-post-command post-command-hook))
-
-  (let* ((paren-modes '(blink-paren paren sexp sexp-surround))
-	 (paren-next-modes (cons nil (append paren-modes (list nil)))))
-    (setq paren-mode (if (and (numberp arg) (< arg 0))
-			 nil		; turn paren highlighting off
-		       (cond ((and arg (symbolp arg)) arg)
-			     ((and (numberp arg) (> arg 0))
-			      (nth (1- arg) paren-modes))
-			     ((numberp arg) nil)
-			     (t (car (cdr (memq paren-mode
-						paren-next-modes)))))
-		       )))
-  (cond (paren-mode
-	 (add-hook 'post-command-hook 'paren-highlight)
-	 (add-hook 'pre-command-hook 'paren-nuke-extent)
-	 (setq blink-matching-paren nil))
-	((not (local-variable-p 'paren-mode (current-buffer)))
-	 (remove-hook 'post-command-hook 'paren-highlight)
-	 (remove-hook 'pre-command-hook 'paren-nuke-extent)
-	 (paren-nuke-extent)		; overkill
-	 (setq blink-matching-paren t)
-	 ))
-  (or quiet (message "Paren mode is %s" (or paren-mode "OFF"))))
-
-(eval-when-compile
-  ;; suppress compiler warning.
-  (defvar highlight-paren-expression))
-
-;; No no no!
-;(paren-set-mode (if (and (boundp 'highlight-paren-expression)
-;			    ;; bletcherous blink-paren no-naming-convention
-;			    highlight-paren-expression)
-;		       'sexp
-;		     (if (eq 'x (device-type (selected-device)))
-;			 'blink-paren
-;		       'paren))
-;		t)
-
-;;;###autoload
-(make-obsolete 'blink-paren 'paren-set-mode)
-
-;;;###autoload
-(defun blink-paren (&optional arg)
-  "Obsolete.  Use `paren-set-mode' instead."
-  (interactive "P") 
-  (paren-set-mode (if (and (numberp arg) (> arg 0))
-		      'blink-paren -1) t))
-
-(provide 'blink-paren)
-(provide 'paren)
-
-;; Local Variables:
-;; byte-optimize: t
-;; End:
-
-;;; paren.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/permanent-buffers.el b/xemacs-packages/lisp/edit-utils/permanent-buffers.el
deleted file mode 100644
index 578ece34..00000000
--- a/xemacs-packages/lisp/edit-utils/permanent-buffers.el
+++ /dev/null
@@ -1,228 +0,0 @@
-;;; permanent-buffers.el --- Permanent buffers management package.
-
-;; Copyright (C) 1997-99 Didier Verna.
-
-;; Author:        Didier Verna 
-;; Maintainer:    Didier Verna 
-;; Created:       Wed Dec 31 10:16:30 1997 under XEmacs 20.5 (beta 15)
-;; Last Revision: Mon Mar 15 11:34:01 1999
-;; Keywords:      extensions
-
-;; This file is part of XEmacs
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; if not, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Synched up with: Not in FSF Emacs.
-
-
-;;; Commentary:
-
-;; Contents management by FCM version 0.1.
-
-;; A permanent buffer is a buffer that you don't want to kill, mainly used for
-;; testing or temporary stuff. The *scratch* buffer is the most famous example
-;; of what could be a permanent buffer. This package allows you to define
-;; several permanent buffers (the scratch buffer can be one of them) that
-;; will never disapear. If you kill them or save their contents, they will be
-;; regenerated. You can also specify a set of lisp forms to eval in the buffer
-;; when it is (re)generated.
-
-;; The package is implemented in a minor-mode fashion. You can customize the
-;; default value of `permanent-buffers-mode' or use
-;; `turn-on-permanent-buffers' at startup. Within an XEmacs session, use
-;; `permanent-buffers-mode' or `tun-o[n|ff]-oermanent-buffers'. You might also
-;; want to customize `permanent-buffers-alist'.
-
-
-;;; Change Log:
-
-;; Mon Mar 15 1999: - Misc code cleanup,
-;;                  - added 'editing parent group,
-;;                  - provide 'permanent-buffers,
-;;                  - customise'd and autoload'ed the initial mode value.
-;; Mon Jan  5 1998: Added menu support.
-;; Fri Jan  1 1998: Packaging, doc, cleanup.
-;; Wed Dec 31 1997: Initial Version.
-
-
-;;; Code:
-
-;; Public variables =========================================================
-
-(defgroup permanent-buffers nil
-  "Permanent Buffers Management."
-  :group 'editing)
-
-(defcustom permanent-buffers-alist
-  '(("*scratch*" (lisp-interaction-mode))
-    ("*text*" (text-mode)))
-  "*An alist of permanent buffers. See `permanent-buffers-mode' for more
-details on what a permanent buffer is.
-Each element looks like (NAME FORM ...) where NAME is the name of the
-buffer, and FORMs are lisp expressions to be executed when the buffer
-is regenerated (this buffer will be current when evaluating the
-expressions)."
-  :group 'permanent-buffers
-  :type '(repeat (cons :tag "Permanent buffer"
-		       (string :tag "Buffer name")
-		       (repeat :tag "Forms to execute" (sexp :tag "")))))
-
-;;;###autoload
-(defcustom permanent-buffers-mode nil
-  "Indicates whether the `permanent-buffers' behavior is active. You can
-customize this variable to change the default value. To change the value
-during an XEmacs session, please use the function instead."
-  :type 'boolean
-  :set (lambda (sym val)
-	 (permanent-buffers-mode (if val 1 -1)))
-  :initialize 'custom-initialize-default
-  :require 'permanent-buffers
-  :group 'permanent-buffers)
-
-
-;; Private variables ========================================================
-
-(defconst permanent-buffers-version "1.2")
-
-(make-variable-buffer-local
- (defvar permanent-buffers-setup-done nil
-   ;; This variable indicates whether the setup has been done in this buffer.
-   ;; It is always buffer local, and is used mainly for initialisation. For
-   ;; instance, if the *scratch* buffer is permanent, it exists at startup but
-   ;; has not been set up. Checking this variable allows us to set it up
-   ;; anyway.
-   ))
-
-(defvar permanent-buffers-menu
-  '("Permanent Buffers"
-    :filter permanent-buffers-menu-filter
-    [ "Enable" (permanent-buffers-mode nil)
-      :style toggle :selected permanent-buffers-mode ])
-  ;; A 'Buffers' submenu with a a toggle button to [en/dis]able the
-  ;; permanent buffers behavior, and a list of permanent buffers to switch
-  ;; to (thanks to the filter).
-  )
-
-
-;; Private functions ========================================================
-
-(defun permanent-buffers-menu-filter (menu-items)
-  ;; This filter builds a list of available permanent buffers and appends
-  ;; push buttons to `switch-to-buffer' them, in the submenu.
-  (let ((bufs permanent-buffers-alist)
-	(menu menu-items)
-	buf)
-    (while (setq buf (pop bufs))
-      (setq menu (append menu
-			 `([,(car buf)
-			    (switch-to-buffer ,(car buf))
-			    permanent-buffers-mode ]))))
-    menu))
-
-(defun permanent-buffers-setup-all ()
-  ;; Recheck the whole list, and possibly regenerate missing ones.
-  (let ((bufs permanent-buffers-alist)
-	buf permbuf)
-    ;; Check whether a permanent buffer doesn't exist, or is attached to a
-    ;; file.
-    (while (setq buf (pop bufs))
-      (setq permbuf (get-buffer (car buf)))
-      (cond ((not permbuf) ;; Killed buffer.
-	     (with-current-buffer (get-buffer-create (car buf))
-	       (eval (cons 'progn (cdr buf)))
-	       (setq permanent-buffers-setup-done t)))
-	    ((buffer-file-name permbuf) ;; Buffer attached to a file.
-	     (with-current-buffer permbuf
-	       (rename-buffer (file-name-nondirectory buffer-file-name) t))
-	     (with-current-buffer (get-buffer-create (car buf))
-	       (eval (cons 'progn (cdr buf)))
-	       (setq permanent-buffers-setup-done t)))
-	    ((not permanent-buffers-setup-done) ;; OK, but setup not done.
-	     (with-current-buffer (get-buffer-create (car buf))
-	       (eval (cons 'progn (cdr buf)))
-	       (setq permanent-buffers-setup-done t)))))
-    ))
-
-(defun permanent-buffers-kill-buffer-function ()
-  ;; Are we in a permanent buffer ?
-  (let ((buf (assoc (buffer-name) permanent-buffers-alist)))
-    (when buf
-      ;; Rename this buffer just before killing it, in order to free its name.
-      ;; Otherwise, we would generate a buffer name.
-      (rename-buffer (car buf) t)
-      (with-current-buffer (get-buffer-create (car buf))
-	(eval (cons 'progn (cdr buf)))
-	(setq permanent-buffers-setup-done t))
-      )))
-
-;; We don't have any way to remember the old buffer name, since there isn't
-;; any `before-set-visited-file-name-hook'. So check the whole list. It's a
-;; bit too much, but ...
-(defun permanent-buffers-asvfn-function ()
-  (permanent-buffers-setup-all))
-
-
-;; Public functions =========================================================
-
-;;;###autoload
-(defun permanent-buffers-mode (arg)
-  "Toggle on/off the permanent buffers behavior. With a prefix > 0 turn it on.
-A permanent buffer is a special buffer, not attached to any file, that can't
-be killed or saved-as. If you kill it or save it as a file, it will be
-regenerated fresh and empty. See also the variable `permanent-buffers-alist'."
-  (interactive "P")
-  (let ((turn-it-on (if (null arg) (not permanent-buffers-mode)
-		      (> (prefix-numeric-value arg) 0))))
-    (cond ((and turn-it-on (not permanent-buffers-mode))
-	   ;; Menubar stuff
-	   (when (featurep 'menubar)
-	     (add-submenu  '("Buffers")
-			   permanent-buffers-menu
-			   ;; This way of dealing with the position in
-			   ;; menus is ugly ... :-(
-			   '"--"))
-	   ;; Recheck the whole list first.
-	   (permanent-buffers-setup-all)
-	   (add-hook 'after-set-visited-file-name-hooks
-		     'permanent-buffers-asvfn-function)
-	   (add-hook 'kill-buffer-hook
-		     'permanent-buffers-kill-buffer-function)
-	   (setq permanent-buffers-mode t))
-	  ((and permanent-buffers-mode (not turn-it-on))
-	   (setq permanent-buffers-mode nil)
-	   (remove-hook 'after-set-visited-file-name-hooks
-			'permanent-buffers-asvfn-function)
-	   (remove-hook 'kill-buffer-hook
-			'permanent-buffers-kill-buffer-function))
-	  )))
-
-;;;###autoload
-(defun turn-on-permanent-buffers ()
-  "Unconditionally turn on the `permanent-buffers' behavior."
-  (interactive)
-  (permanent-buffers-mode 1))
-
-(defun turn-off-permanent-buffers ()
-  "Unconditionally turn off the `permanent-buffers' behavior."
-  (interactive)
-  (permanent-buffers-mode -1))
-
-(defun permanent-buffers-version ()
-  (interactive)
-  (message "permanent-buffers version %s" permanent-buffers-version))
-
-(provide 'permanent-buffers)
-
-;;; permanent-buffers.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/popper.el b/xemacs-packages/lisp/edit-utils/popper.el
deleted file mode 100644
index 8b4823fe..00000000
--- a/xemacs-packages/lisp/edit-utils/popper.el
+++ /dev/null
@@ -1,1817 +0,0 @@
-;;; popper.el --- shrink-wrapped temporary windows for Emacs
-
-;;;     Author: Chris McConnell 
-;;; Maintainer: Greg Klanderman 
-;;;    Version: 2.40 XEmacs 1.5
-;;;       Date: September 24, 1998
-;;;    Created: 1990 (?)
-;;;   Keywords: temporary window, popup window
-
-
-;;; Copyright (C) 1990, 1991, 1992 Chris McConnell, ccm@cs.cmu.edu.
-;;; Thanks to Ken Laprade for suggestions and patches.
-
-;;; Copyright (C) 1997, 1998 Greg Klanderman
-
-
-;;; This file is part of GNU Emacs.
-
-;;; GNU Emacs is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY.  No author or distributor
-;;; accepts responsibility to anyone for the consequences of using it
-;;; or for whether it serves any particular purpose or works at all,
-;;; unless he says so in writing.  Refer to the GNU Emacs General Public
-;;; License for full details.
-
-;;; Everyone is granted permission to copy, modify and redistribute
-;;; GNU Emacs, but only under the conditions described in the
-;;; GNU Emacs General Public License.   A copy of this license is
-;;; supposed to have been given to you along with GNU Emacs so you
-;;; can know your rights and responsibilities.  It should be in a
-;;; file named COPYING.  Among other things, the copyright notice
-;;; and this notice must be preserved on all copies.
-
-
-;;; Commentary:
-
-;;; 1. VERSION:
-;;;
-;;; This version of popper is based on version 2.40, which as far as I can
-;;; tell is the last version distributed by Chris McConnell, the original
-;;; author of popper.  I have been unsuccessful at contacting him and so
-;;; have decided to take over maintenance of the package for XEmacs.  New
-;;; versions distributed by me will be designated "2.40 XEmacs X.Y".  This
-;;; designation is not meant to imply that this is an XEmacs-specific
-;;; version, only that it is the version distributed with XEmacs.  This
-;;; version incorporates significant bug fixes and changes with respect to
-;;; the original.  Overall it should work much better.  Please let me know
-;;; if you have any problems or suggestions.
-
-;;; 2. DESCRIPTION:
-;;;
-;;; This module provides a single shrink-wrapped window for displaying
-;;; temporary text called the popper window.  At any time there is at
-;;; most one popper window on a given emacs frame.  If there is an entry
-;;; for the buffer being displayed on popper-min-heights, the size of
-;;; the window will be from that entry.  If the buffer is empty, the
-;;; size of the window will be popper-empty-min.  Otherwise its size
-;;; will be the minimum of the number of lines of text being displayed
-;;; and half the number of lines in the currently selected window when
-;;; the popper window was created.  It will work with any function that
-;;; uses temporary windows or that has been wrapped with popper-wrap.
-;;; The window can be scrolled or buried from any other window.
-;;;
-;;; When a buffer is displayed using the function
-;;; with-output-to-temp-buffer, the text will be displayed in the
-;;; popper window if the name of the buffer is in popper-pop-buffers
-;;; or popper-pop-buffers is set to `t' and the name is not in
-;;; popper-no-pop-buffers.  If you have a buffer with a process, you
-;;; can cause it to automatically scroll by setting
-;;; popper-scroll-buffers to `t' or to a list of buffer names to
-;;; scroll.  Many kinds of completion and help information are
-;;; displayed this way.  In general any buffer with *'s around its
-;;; name will be a temporary buffer.  Some commands like shell-command
-;;; do not use with-output-to-temp-buffer even though you might like
-;;; to have their output be temporary.  For commands like this, you
-;;; can define a wrapper using the function popper-wrap.
-;;;
-;;; If popper-use-message-buffer is non-nil then popper output that is
-;;; one line or less will be displayed in the minibuffer.
-;;;
-;;; The default binding for C-x o is changed so that when a buffer is
-;;; displayed in a popper window, it will be skipped if it is in
-;;; popper-buffers-to-skip or popper-buffers-to-skip is `t' and it is
-;;; not in popper-buffers-no-skip.
-
-;;; 3. USAGE:
-;;;
-;;; Load this file, preferably after byte-compiling it.  By default
-;;; popper does not install itself unless the variable
-;;; `popper-install-when-load' has been set non-nil before it is loaded.
-;;; To manually install popper, type the command M-x popper-install.  If
-;;; you later decide popper is not your cup-o-tea, you may un-install it
-;;; using the command M-x popper-unstall.
-;;;
-;;; Once installed, all temporary windows will be handled by popper by
-;;; default.  If you do not define custom key bindings using the
-;;; popper-load-hook, the bindings for manipulating the popper temporary
-;;; window will be:
-;;; 
-;;;   * C-z C-z, C-z z, C-z 1 : popper-bury-output
-;;;     Alternately hide or show the temporary pop-up window.
-;;;   
-;;;   * C-z C-v, C-z v : popper-scroll-output
-;;;     Scroll the popper output window.
-;;;   
-;;;   * C-z M-v, C-z V : popper-scroll-output-back
-;;;     Scroll the popper output window backwards.
-;;;   
-;;;   * C-z < : popper-beginning-of-buffer
-;;;     Scroll the popper output window to the beginning of the buffer.
-;;;   
-;;;   * C-z > : popper-end-of-buffer
-;;;     Scroll the popper output window to the end of the buffer.
-;;;   
-;;;   * C-z C-j, C-z j, C-z C-o, C-z o : popper-jump-to-popper
-;;;     Select the popper window, or jump back to the previous window
-;;;     if the popper window is already selected.  With a C-u argument,
-;;;     show the popper window first if necessary.
-;;;   
-;;;   * C-z C-s : popper-isearch-forward
-;;;     Do incremental search forward in the popper buffer.
-;;;   
-;;;   * C-z C-r : popper-isearch-backward
-;;;     Do incremental search backward in the popper buffer.
-;;;   
-;;;   * C-z C-M-s : popper-isearch-forward-regexp
-;;;     Do regexp incremental search forward in the popper buffer.
-;;;   
-;;;   * C-z C-M-r : popper-isearch-backward-regexp
-;;;     Do regexp incremental search backward in the popper buffer.
-;;;   
-;;;   * C-z g : popper-grow-output
-;;;     Grow the popper output window.
-;;;   
-;;;   * C-z G, C-z M-g : popper-shrink-output
-;;;     Shrink the popper output window.
-;;;   
-;;;   * C-z C-b, C-z b : popper-switch-buffer
-;;;     Prompt for a different popper temporary buffer to show.
-;;;   
-;;;   * C-z C-k, C-z k : popper-kill
-;;;     Kill or bury the current popper buffer and drop it off of the
-;;;     stack of popper buffers for this frame.  If the stack of popper
-;;;     buffers (for the selected frame) is not empty, show the new
-;;;     top-most buffer.  The buffer is killed if it has been saved with
-;;;     `popper-save'; otherwise it is just buried.
-;;;   
-;;;   * C-z C-x, C-z x : popper-cycle
-;;;     Cycle through all popper buffers (for the selected frame) by
-;;;     dropping the current popper buffer to bottom of the stack.
-;;;   
-;;;   * C-z s : popper-save
-;;;     Save the current popper buffer by renaming it so that it won't be
-;;;     overwritten. 
-;;;
-;;;   * C-x o : popper-other-window
-;;;     Like other-window, but (by default) skips the popper window.
-;;;     Use a C-u prefix to select the popper window.  See the variables
-;;;     `popper-buffers-to-skip' and `popper-buffers-no-skip'.
-;;;
-;;;   * C-x 0 : popper-delete-window
-;;;     Like delete-window, but hides and re-shows the popper window
-;;;     around the call to delete-window.  Also, the variable
-;;;     `popper-delete-window-can-delete-frame' can be set to nil to
-;;;     prevent deletion of the frame if the user attempts to delete the
-;;;     last window.
-;;;
-;;; Note that "C-z" is the popper-prefix, and that many bindings in the
-;;; popper map are chosen by analogy to a similar command in the "C-x"
-;;; map.  If you have suggestions for more intuitive or easily typed
-;;; bindings, or additional user commands that would be nice, please let
-;;; me know.
-
-;;; 4. USER CUSTOMIZATION:
-;;; 
-;;; See the section `Popper user variables' below for configurable
-;;; variables.  Here is a sample load hook for your .emacs:
-;;;
-;;; (defun gk:popper-load-hook ()
-;;;   (setq popper-install-when-load t)          ; Hooray!
-;;;   (setq popper-mode-line-text " Popper")     ; I know the key bindings
-;;;   (setq popper-no-pop-buffers '("^Man: "))   ; don't pop manual buffers
-;;;   (setq popper-max-heights '((".*" . (40)))) ; use at most 40%
-;;;   (setq popper-delete-window-can-delete-frame nil) ; extremely losing...
-;;;   )
-;;; (add-hook 'popper-load-hook 'gk:popper-load-hook)
-;;; (require 'popper)
-;;;
-;;; Once popper is installed, you may wrap a command that does not use
-;;; `with-output-to-temp-buffer' so that it will work with popper as
-;;; follows:
-;;;
-;;; (popper-wrap command "*Command Output*")
-;;;
-;;; This may not yet work in all cases.  It is known not to work for
-;;; M-x compile at this time (See the TODO list below).
-;;;
-;;; When loaded, popper checks the values of certain user variable for
-;;; possible problems, unless `popper-inhibit-warnings' is non-nil.  In
-;;; addition, if `popper-fix-incompatible-settings' has been set non-nil,
-;;; popper will set these variables to values known to work best.
-;;; See also the variable `popper-suggested-settings'.
-
-;;; 5. WARNINGS:
-;;;
-;;; This package redefines the value of `temp-buffer-show-function'.
-;;; It also advises the functions `split-window' and `pop-to-buffer'
-;;; so that the popper window is buried before calling the old
-;;; definition.  The macro `popper-wrap' uses defadvice.
-
-;;; 6. CHANGE-LOG / HISTORY:
-;;;
-;;; September 24, 1998
-;;;   * Increment version to XEmacs 1.5.
-;;;   * In `popper-shrink-window' obey window-min-height in the pixels case.
-;;;
-;;; September 14, 1998
-;;;   * Avoid popping up the window in `popper-show' when message buffer got
-;;;     used via `popper-use-message-buffer'.
-;;;   * Setting `popper-inhibit-warnings' should not also inhibit fixing 
-;;;     incompatible settings when `popper-fix-incompatible-settings' is true.
-;;;
-;;; May 28, 1998
-;;;   * Increment version to XEmacs 1.4.
-;;;   * In popper-shrink-window, in the pixels case need to compute size
-;;;     with respect to the popper buffer's point-min.  Also if point-max
-;;;     is visible, call popper-end-of-buffer.
-;;;   * Bugfix - popper-beginning-of-buffer needs buffer arg for point-min.
-;;;   * Bugfixes in popper-delete-window for display jump avoidance.
-;;;   * Bugfix popper-end-of-buffer, popper-grow-output, and
-;;;     popper-do-delete-window when popper-use-pixel-heights=t.
-;;;
-;;; May 20, 1998
-;;;   * Increment the version number to XEmacs 1.3.
-;;;   * In popper-delete-window, if we delete the frame, we shouldn't re-show
-;;;     popper window.  Also, restore popper parent if it didn't get deleted.
-;;;   * More pixel-level display jump avoidance.
-;;;
-;;; May 19, 1998
-;;;   * Remove popper-text-lines-pixel-height and popper-vertical-pixel-motion,
-;;;     instead use the new primitives window-displayed-text-pixel-height and
-;;;     vertical-motion-pixels which do the right things fast.
-;;;   * Function window-text-pixel-height changed name to
-;;;     window-text-area-pixel-height.
-;;;
-;;; May 12, 1998
-;;;   * Optimize popper-text-lines-pixel-height and
-;;;     popper-vertical-pixel-motion to be fast in the case that all lines are
-;;;     default height.  Fall back to slow code when this assumption fails.
-;;;
-;;; May 7, 1998
-;;;   * Add internal variable `popper-select-window-has-norecord' to control 
-;;;     whether `select-window' has the argument.  Use it in
-;;;     `popper-select-window', a new function used throughout.
-;;;     Also define macro `popper-with-selected-window' and use it.
-;;;
-;;; May 6, 1998
-;;;   * Work on popper-show-output scrolling of parent to keep point visible.
-;;;     For the pixels case use the new function popper-vertical-pixel-motion.
-;;;   * Clean up customization.
-;;;
-;;; May 5, 1998
-;;;   * Roll-back-the-parent code in popper-bury-output should still avoid
-;;;     redisplay jump if the popper-restore-scroll property does not match.
-;;;   * Re-work popper-shrink-window for pixels case.
-;;;     New function popper-text-lines-pixel-height. 
-;;;   * Avoid select-window where possible.
-;;;   * Various cleanups.
-;;;
-;;; Mar 30, 1998
-;;;   * Try to undo the most egregious effects of select-window calling
-;;;     record-buffer - in popper-show and popper-do-search.
-;;;
-;;; Mar 27, 1998
-;;;   * Restore the popper-parent's window-start when the popper window gets
-;;;     buried, if we had to move it down to keep the parent's point visible.
-;;;     New variable `popper-context-lines'.
-;;;   * Various cleanup.
-;;;
-;;; Mar 15, 1998
-;;;   * First pass at customization.
-;;;   * When splitting windows, restore the popper window from its original
-;;;     parent window.
-;;;
-;;; Mar 14, 1998
-;;;   * Use advice to redefine `pop-to-buffer' and `split-window'.
-;;;   * Turn `popper-output-buffers' into a frame property.  We should now
-;;;     handle multiple frames correctly.  Do things the old way if we don't
-;;;     have `set-frame-property'.
-;;;   * Don't use `window-displayed-height' - it is unreliable.  Define and
-;;;     use `popper-window-displayed-height' which works so long as all the
-;;;     text in question is in the default face's font.
-;;;
-;;; Mar 12, 1998
-;;;   * Use a frame property to store the window popper-jump-to-popper came
-;;;     from so we can go back if later called from the popper window.
-;;;
-;;; Mar 8, 1998
-;;;   * New internal variable `popper-use-pixel-heights' determines whether
-;;;     popper does pixel-level adjustments of the window size.  Enabled
-;;;     when the needed functions are available.  New functions
-;;;     `popper-window-height', `popper-enlarge-window', and
-;;;     `popper-height-to-chars' abstract this decision from the rest of
-;;;     the code.
-;;;   * Define window-displayed-height as best we can if it doesn't exist.
-;;;   * New function popper-build-keymap called from popper-install.
-;;;   * Have popper-grow-output obey window-min-height.
-;;;   * Put popper-eat-newlines code in its own function:
-;;;     popper-trim-whitespace.
-;;;   * Fix: popper-min-height should return at least window-min-height.
-;;;   * Fix logic error in popper-skip-buffer-p
-;;;   * Make popper-last-output-window local variable in popper-show-output
-;;;   * Nuke popper-temp-buffer-show-function - Emacs 18.xx compatibility
-;;;     is is likely long gone.
-;;;
-;;; Mar 4, 1998
-;;;   * Use symbol-value rather than eval to get value of the symbol
-;;;     stored in popper-temp-buffer-show-function.
-;;;
-;;; Feb 25, 1998: Version XEmacs 1.2
-;;;   * XEmacs now uses temp-buffer-show-function for showing
-;;;     byte-compilation and display-warning warnings, so we 
-;;;     no longer need to have handling these on the TODO list.
-;;;   * Don't ever let blank space be shown below (point-max).
-;;;     If this happens, please report it as a bug.
-;;;   * Several other bugfixes + cleanup
-;;;   * New function popper-shrink-output
-;;;   * Keep zmacs region when appropriate
-;;;   * Don't install popper on loading, use (popper-install),
-;;;     or set popper-install-when-load non-nil before loading
-;;;     or in your popper-load-hook.
-;;;   * New user variable popper-install-when-load 
-;;;     and private var popper-installed-p.
-;;;     New function popper-install, autoloaded.
-;;;     New function popper-unstall to uninstall.
-;;;   * Save original show function in popper-original-show-function
-;;;   * Add popper-jump-to-popper.
-;;;   * Default popper-fix-incompatible-settings to nil.
-;;;   * Reformat commentary.
-;;;
-;;; Feb 23, 1998: Version XEmacs 1.1
-;;;   * Add popper-beginning-of-buffer, popper-end-of-buffer
-;;;   * Add popper-isearch-* functions.
-;;;
-;;; Feb 22, 1998: Version XEmacs 1.0
-;;;   * To be packaged with XEmacs 20.5b28.
-;;;
-;;; Updated March 1997 -- February 1998 by Greg Klanderman
-;;;   * Fix up unreadable indentation 
-;;;   * Fix off-by-one error in popper-eat-newlines code
-;;;   * Fix lossage in popper-other-window
-;;;   * Modularize predicates for skip, handle, scroll
-;;;   * Took out fsf-19 alternate args for where-is-internal;
-;;;     the docs didn't seem to indicate this was correct,
-;;;     and it seg faulted FSF 19.27 when I tried it.
-;;;   * Much code cleanup and reorganization
-;;;   * Keep split-window from creating "half lines", eg, compute the
-;;;     size if the size arg is nil (meaning "split in half").
-;;;     This caused popper windows to sometimes have a partial blank  
-;;;     line or text line at the bottom which was rather annoying.
-;;;     This seems to also be the cause of the "won't change only window 
-;;;     bug".  Eg, the window is height 9, gets split into two windows 
-;;;     of height 4 (actually 4.5, but window-height returns 4) then
-;;;     things get hosed...  Also wrapped a (when more-than-one ..)
-;;;     around the enlarge-window since the error may still happen when 
-;;;     somebody mixes different height fonts or has
-;;;     modeline-shadow-thickness non-zero.
-;;;   * Handle more emacs/XEmacs versions (hopefully! (let me know..))
-;;;   * Fix second off-by-one error in popper-shrink-window which allowed
-;;;     it to inadvertently enlarge the window by at most one line
-;;;   * Added popper-max-heights variable to set max size of pop up windows
-;;;   * Add popper-split-preserve-popper-size, defaults to t.  The old 
-;;;     behavior meant to deal with incongruity in behavior of split-window
-;;;     with and without arg from the popper-parent window.
-;;;      - when set t: without arg, splits window in half as if popper
-;;;        weren't there; with arg N, splits at N lines, relative to bottom
-;;;        of pop up window.
-;;;      - when set nil: we hide just popper, split, and reshow popper
-;;;        without trying to preserve pop up size; its just like the popper
-;;;        weren't there.
-;;;   * Found the variable split-window-keep-point, set nil = a good thing
-;;;   * Fix bug with split-window redefinition when called from 
-;;;     split-window-vertically and split-window-keep-point=nil.
-;;;     Is this solution too much of a hack??
-;;;   * Fix delete-window too (a la split-window).  Instead of redefinition,
-;;;     define popper-delete-window and replace keymap entries
-;;;   * Delete-window deletes frame if its the only window - bad bad bad.
-;;;     Make popper-delete-window obey the new variable
-;;;     popper-delete-window-can-delete-frame
-;;;   * Have popper-delete-window avoid display jump when deleting the
-;;;     topmost window
-;;;   * Define popper-kill (on C-z k) and popper-cycle (on C-z x) to kill
-;;;     and cycle the popper buffer, respectively.
-;;;   * Define popper-save (on C-z s) to rename popper buffer so it's saved
-;;;   * Introduce popper-prefix variable and popper-map keymap
-;;;   * Made the popper-pop-buffers list and kin be regexp lists
-
-;;; 7. TODO / KNOWN BUGS:
-;;;
-;;; finish code cleanup
-;;;
-;;; process stuff is totally broken
-;;; process stuff should allow growing as output is produced
-;;;
-;;; list ranking preference of window to split
-;;;     recognized values: 'current, 'topmost, 'biggest
-;;;     current == current, or previous if minibuffer
-;;;     others are self explanatory
-;;;     or just have a hook or two (from minibuf or not)
-;;;
-;;; popper-gravity - 'top or 'bottom
-
-
-;;; ======================================================================
-
-
-;;; Code:
-
-;;;
-;;; Do the right thing if we're being re-loaded
-;;;
-
-(eval-when-compile
-  (defvar popper-installed-p)
-  (defvar popper-install-when-load))
-  
-(when (and (boundp 'popper-installed-p)
-           popper-installed-p)
-  (setq popper-install-when-load t)
-  (popper-unstall))
-
-
-;;;
-;;; Popper user variables
-;;;
-
-(defgroup popper nil
-  "Shrink wrapped display of temporary pop-up buffers."
-  :group 'environment)
-
-(defcustom popper-install-when-load nil
-  "*If non-nil, install popper when it is loaded.
-If this variable is set and saved with M-x customize-variable, popper
-will be loaded and initialized automatically when emacs is started."
-  :type    'boolean
-  :require 'popper
-  :group   'popper)
-
-(defcustom popper-load-hook nil
-  "*List of functions to run when the popper module is loaded, but prior
-to popper installation.  This is a good place to change any options."
-  :type  'hook
-  :group 'popper)
-
-(defcustom popper-prefix "\C-z"
-  "*If non-nil, where to install the popper prefix keymap"
-  :type  '(choice
-           (const :tag "No binding" nil)
-           (sexp :tag "Binding"))
-  :group 'popper)
-
-(defcustom popper-use-message-buffer nil
-  "*If non-nil makes output to popper-buffers that is one line or less
-go to the minibuffer."
-  :type  'boolean
-  :group 'popper)
-
-(defcustom popper-context-lines 1
-  "*Number of lines of context to keep above point when popper is shown.
-Usually when the popper window is displayed, the parent window's
-start position is adjusted to minimize the display jump.  This
-variable specifies how many lines of context to keep visible when
-the window must be scrolled to keep point visible."
-  :type  'integer
-  :group 'popper)
-
-(defcustom popper-pop-buffers t
-  "*List of buffers to put in the shrink-wrapped pop-up window.  
-If it is T, all temporary buffers will be put in the pop-up window."
-  :type  '(choice
-           (const :tag "All" t)
-           (const :tag "None" nil)
-           (repeat :tag "Buffer list" (regexp :tag "Buffer regexp")))
-  :group 'popper)
-
-(defcustom popper-no-pop-buffers nil
-  "*If popper-pop-buffers is T, these buffers will not be put into the
-pop-up window."
-  :type  '(choice
-           (const :tag "None" nil)
-           (repeat :tag "Buffer list" (regexp :tag "Buffer regexp")))
-  :group 'popper)
-
-(defcustom popper-buffers-to-skip popper-pop-buffers
-  "*\\[popper-other-window] will skip over these buffers when they are
-used in a temporary window.  If it is T, all popper windows will be
-skipped except those in popper-buffers-no-skip."
-  :type  '(choice
-           (const :tag "All" t)
-           (const :tag "None" nil)
-           (repeat :tag "Buffer list" (regexp :tag "Buffer regexp")))
-  :group 'popper)
-
-(defcustom popper-buffers-no-skip nil
-  "*\\[popper-other-window] will not skip these buffers when they are
-used in a popper window if popper-buffers-to-skip is T."
-  :type  '(choice
-           (const :tag "None" nil)
-           (repeat :tag "Buffer list" (regexp :tag "Buffer regexp")))
-  :group 'popper)
-
-(defcustom popper-eat-newlines t
-  "*Boolean for eating trailing newlines in popper buffers."
-  :type  'boolean
-  :group 'popper)
-
-(defcustom popper-scroll-buffers t
-  "*If set to T or a list of buffer names, cause buffers with
-associated processes to scroll automatically."
-  :type  '(choice
-           (const :tag "All" t)
-           (repeat :tag "Buffer list" (regexp :tag "Buffer regexp")))
-  :group 'popper)
-
-(defcustom popper-empty-min (max 1 (1- window-min-height))
-  "*Minimum number of lines to display for an empty popper buffer.
-If it is a list, it is a percentage 0-100 of the available space."
-  :type  '(choice
-           (integer :tag "Lines")
-           (list :tag "Percent" (integer)))
-  :group 'popper)
-
-(defcustom popper-min-heights nil
-  "*List of cons where each car is a regular expression pattern to
-match a buffer name and the cdr is the minimum number of lines to
-allow when popping buffers that match the regular expression.  If the
-number is a list, it is interpreted as the percentage of available
-space 0-100 to use for the window."
-  :type  '(choice
-           (const :tag "None" nil)
-           (repeat
-            (cons (regexp :tag "Buffer regexp")
-                  (choice (integer :tag "Lines")
-                          (list :tag "Percent" (integer))))))
-  :group 'popper)
-
-(defcustom popper-max-heights nil
-  "*List of cons where each car is a regular expression pattern to
-match a buffer name and the cdr is the maximum number of lines to
-allow when popping up buffers that match the regular expression.  If the
-number is a list, it is interpreted as the percentage of available
-space 0-100 to use for the window."
-  :type  '(choice
-           (const :tag "None" nil)
-           (repeat
-            (cons (regexp :tag "Buffer regexp")
-                  (choice (integer :tag "Lines")
-                          (list :tag "Percent" (integer))))))
-  :group 'popper)
-
-(defcustom popper-mode-line-text nil
-  "*Minor mode text for mode line of popper buffers.  If nil, it will
-be set to a short help message on first use of popper."
-  :type  '(choice (const :tag "Default" nil)
-                  (string :tag "Text"))
-  :group 'popper)
-
-(defcustom popper-split-preserve-popper-size nil
-  "*When non-nil, split-window from the popper parent window should
-preserve the pop up window's height."
-  :type  'boolean
-  :group 'popper)
-
-(defcustom popper-delete-window-can-delete-frame t
-  "*When non-nil, `popper-delete-window' will behave like `delete-window'
-and when deleting the last window on a frame also delete that frame.
-When nil, an attempt to delete the last window on a frame is ignored."
-  :type  'boolean
-  :group 'popper)
-
-(defcustom popper-use-pixel-heights
-  (and (fboundp 'window-pixel-height)
-       (fboundp 'window-text-area-pixel-height)
-       (fboundp 'enlarge-window-pixels)
-       (fboundp 'window-displayed-text-pixel-height)
-       (fboundp 'vertical-motion-pixels)
-       (let ((func (symbol-function 'vertical-motion)))
-         (and (subrp func)  ;; have 3rd inpixels arg?
-              (> (subr-max-args func) 2))))
-  "*Boolean indicating whether popper should perform pixel level
-window height adjustments."
-  :type  'boolean
-  :group 'popper)
-
-(defcustom popper-inhibit-warnings nil
-  "*When non-nil, popper checks the settings of certain Emacs user
-variables that might adversely affect popper."
-  :type  'boolean
-  :group 'popper)
-
-(defcustom popper-fix-incompatible-settings nil
-  "*When non-nil, if popper finds settings of certain Emacs user
-variables that might adversely affect popper it sets them appropriately."
-  :type  'boolean
-  :group 'popper)
-
-(defvar popper-map nil
-  "The popper keymap.  For complete control over this,
-set its bindings from your popper-load-hook.")
-
-
-;;;
-;;; Popper internal variables
-;;;
-
-(defvar popper-installed-p nil
-  "Is popper currently installed (active)?")
-
-(defvar popper-output-buffers nil
-  "LIFO list of buffers displayed in the popper window.
-Only used if your emacs does not support frame properties.")
-
-(defvar popper-buffer nil
-  "Indicates buffer is a popper for minor-mode-alist.")
-(make-variable-buffer-local 'popper-buffer)
-
-(defvar popper-original-filter nil
-  "Original process filter, used by `popper-scroll-filter'.")
-(make-variable-buffer-local 'popper-original-filter)
-
-(defvar popper-prefix-original-binding nil
-  "Save the key binding that is replaced by the popper keymap.")
-
-(defvar popper-original-show-function nil
-  "Saves the original value of `temp-buffer-show-function'.")
-
-;;; #### how losing is this?
-(defvar popper-suggested-settings
-  '((help-selects-help-window  . nil)
-    (window-min-height         . 2)
-    (scroll-step               . 1)
-    (scroll-on-clipped-lines   . nil)
-    (pop-up-frames             . nil)
-    (pop-up-windows            . t)
-    (temp-buffer-shrink-to-fit . nil)
-    (split-window-keep-point   . nil))
-  "Suggested settings for Emacs variables when popper is in use.")
-
-(defvar popper-wrap-advised-functions nil
-  "List of functions advised by popper-wrap.
-Used by popper-unstall-popper-wrap.")
-
-(defvar popper-select-window-has-norecord 
-  (let ((func (symbol-function 'select-window)))
-    (and (subrp func)
-         (> (subr-max-args func) 1)))
-  "Does `select-window' take a second optional argument `norecord'?")
-
-
-;;;
-;;; General purpose utilities - sure would be nice if these were in emacs
-;;;
-
-(defun popper-mem (item list &optional elt=)
-  "Test to see if ITEM is equal to an item in LIST.
-Optional comparison function ELT= defaults to equal."
-  (let ((elt= (or elt= (function equal)))
-	(done nil))
-    (while (and list (not done))
-      (if (funcall elt= item (car list))
-	  (setq done list)
-        (setq list (cdr list))))
-    done))
-
-(defun popper-assoc (item list &optional elt=)
-  "Test to see if ITEM is equal to the car of an element of LIST.
-Optional comparison function ELT= defaults to equal.
-The value is actually the element of LIST whose car equals KEY."
-  (let ((elt= (or elt= (function equal)))
-	(done nil))
-    (while (and list (not done))
-      (if (funcall elt= item (car (car list)))
-	  (setq done (car list))
-        (setq list (cdr list))))
-    done))
-
-(defun popper-match-buffer-name (buff regx)
-  "Match a buffer name to a regular expression"
-  (string-match regx buff))
-
-(defun popper-filter (list &optional pred)
-  "Filter LIST with predicate PRED.
-Return a new list containing all elements in LIST for which PRED returns
-a non-nil value."
-  (let ((pred (or pred (function (lambda (x) x))))
-        (result nil))
-    (while list
-      (if (funcall pred (car list))
-          (setq result (cons (car list) result)))
-      (setq list (cdr list)))
-    (nreverse result)))
-
-
-;;;
-;;; Popper internal utilities 
-;;;
-
-(defun popper-warn (&rest args)
-  "Display a popper warning."
-  (display-warning 'popper (apply 'format args)))
-
-(defun popper-handle-buffer-p (&optional buff)
-  "Determine if popper is handling BUFF.  BUFF can be a buffer name
-or a buffer.  If not specified, it defaults to the current buffer."
-  (let ((buff-name  (if (stringp buff) buff (buffer-name buff))))
-    (or (and (eq popper-pop-buffers t)
-             (not (popper-mem buff-name popper-no-pop-buffers
-                              'popper-match-buffer-name)))
-        (and (listp popper-pop-buffers)
-             (popper-mem buff-name popper-pop-buffers
-                         'popper-match-buffer-name)))))
-
-(defun popper-scroll-buffer-p (&optional buff)
-  "Determine if popper should scroll process output in BUFF"
-  (let ((buff-name  (if (stringp buff) buff (buffer-name buff))))
-    (or (eq popper-scroll-buffers t)
-        (popper-mem buff-name popper-scroll-buffers
-                    'popper-match-buffer-name))))
-
-(defun popper-skip-buffer-p (&optional buffer)
-  "Determine if popper-other-window should skip BUFFER, which
-defaults to the current buffer."
-  (let* ((buff (or buffer (current-buffer)))
-         (name (buffer-name buff)))
-    (and (eq (popper-output-buffer) buff)
-         (or (and (eq popper-buffers-to-skip t)
-                  (not (popper-mem name popper-buffers-no-skip
-                                   'popper-match-buffer-name)))
-             (and (listp popper-buffers-to-skip)
-                  (popper-mem buff popper-buffers-to-skip
-                              'popper-match-buffer-name))))))
-
-(defun popper-select-window (window)
-  "Select WINDOW, using `select-window'.  Pass the `norecord' flag
-if this emacs supports it."
-  (if popper-select-window-has-norecord
-      (select-window window 'norecord)
-    (select-window window)))
-
-(defmacro popper-with-selected-window (window &rest body)
-  "Execute forms in BODY with WINDOW as the selected window.
-The value returned is the value of the last form in BODY."
-  (let ((old-win (gensym "popper-wsw")))
-    `(let ((,old-win (selected-window)))
-       (unwind-protect
-           (progn (popper-select-window ,window)
-                  ,@body)
-         (popper-select-window ,old-win)))))
-(put 'popper-with-selected-window 'lisp-indent-function 1)
-
-(defun popper-select (&optional window)
-  "Select WINDOW and its buffer.  WINDOW defaults to selected-window."
-  (setq window (or window (selected-window)))
-  (popper-select-window window)
-  (set-buffer (window-buffer window)))
-
-(defun popper-get-output-buffers ()
-  "Get the value of `popper-output-buffers' for the current frame."
-  (if (fboundp 'set-frame-property)
-      (frame-property (selected-frame)
-                      'popper-output-buffers)
-    popper-output-buffers))
-
-(defun popper-set-output-buffers (value)
-  "Set the value of `popper-output-buffers' for the current frame."
-  (if (fboundp 'set-frame-property)
-      (set-frame-property (selected-frame)
-                          'popper-output-buffers
-                          value)
-    (setq popper-output-buffers value)))  
-
-(defun popper-first-buffer ()
-  "Remove killed buffers and return the first buffer on
-popper-output-buffers for this frame."
-  (let ((output-buffers
-         (popper-filter (popper-get-output-buffers)
-                        (lambda (buf) (buffer-name buf)))))
-    (popper-set-output-buffers output-buffers)
-    (car output-buffers)))
-
-(defun popper-output-buffer ()
-  "Return the buffer being displayed in the popper window."
-  (popper-first-buffer)
-  (if (not (eq (selected-window) (next-window nil 'no)))
-      (let ((buffers (popper-get-output-buffers))
-	    (gotit nil))
-	(while buffers
-	  (let* ((buffer (car buffers))
-		 (window (and (buffer-name buffer)
-                              (get-buffer-window buffer))))
-	    (if (and window (not gotit))
-		(setq gotit buffer)
-              (save-excursion
-                (set-buffer (car buffers))
-                (setq popper-buffer nil)))
-            (setq buffers (cdr buffers))))
-	(if gotit
-            ;; move it to front
-            (popper-set-output-buffers
-             (cons gotit (delq gotit (popper-get-output-buffers)))))
-	gotit)))
-
-;;; #### next-window wraps around ??
-(defun popper-parent ()
-  "Return the parent of the popper window."
-  (let ((output (popper-output-buffer)))
-    (if output (next-window (get-buffer-window output) 'no))))
-
-(defun popper-window-height (&optional window)
-  "Return the height of WINDOW as measured by popper.
-This may be in pixels or characters, depending on the value
-of the variable `popper-use-pixel-heights'."
-  (setq window (or window (selected-window)))
-  (if popper-use-pixel-heights
-      (window-pixel-height window)
-    (window-height window)))
-
-;;; #### this should probably go away eventually
-(defun popper-height-to-chars (height)
-  "Convert height to a height in characters, according to
-the variable `popper-use-pixel-heights'."
-  (if popper-use-pixel-heights
-      (/ height (face-height 'default))
-    height))
-
-(defun popper-enlarge-window (n)
-  "Enlarge current window by N, which may be measured in
-pixels or characters depending on the value of the
-variable `popper-use-pixel-heights'."
-  (if popper-use-pixel-heights
-      (enlarge-window-pixels n)
-    (enlarge-window n)))
-
-;;; #### this should probably go away eventually
-(defun popper-window-displayed-height (&optional window)
-  "Return the displayed height of WINDOW as a number of lines
-in the font of the default face."
-  (if popper-use-pixel-heights
-      (/ (window-text-area-pixel-height window)
-         (face-height 'default))
-    (1- (window-height window))))
-
-(defun popper-window-heights (window)
-  "Return a list of the heights of all of the windows following WINDOW."
-  (let ((heights nil)
-        (startwin window))
-    (while (progn 
-	     (setq window (next-window window 'no))
-	     (not (eq window startwin)))
-      (setq heights (cons (popper-window-height window)
-                          heights)))
-    (nreverse heights)))
-
-(defun popper-min-height ()
-  "Return the minimum height to use for the popper buffer in the
-current window.  This is either an entry from popper-min-heights,
-popper-empty-min if the buffer is empty or window-min-height."
-  (let ((min (or (cdr (popper-assoc (buffer-name) popper-min-heights
-                                    'popper-match-buffer-name))
-                 (if (= (point-min) (point-max))
-                     popper-empty-min
-                   window-min-height))))
-    (max (if (consp min)
-             ;; Floating percentage
-             (round (/ (* (+ (window-height) (window-height (next-window)))
-                          (car min))
-                       100.0))
-           min)
-         window-min-height)))
-
-(defun popper-max-height (buff)
-  "Return the maximum height to use for a popper buffer to be
-created by splitting the current window.  This is either an entry
-from popper-max-heights, or half the height of the current window."
-  (let ((val (or (cdr (popper-assoc (buffer-name buff) popper-max-heights
-                                    'popper-match-buffer-name))
-                 '(50))))
-    (when (consp val)                        ; Floating percentage
-	(setq val (round (/ (* (window-height) (car val)) 100.0))))
-    (max (min val (- (window-height) window-min-height))
-         window-min-height)))
-
-;;; #### look at this
-(defun popper-scroll-filter (process output)
-  "Scroll and keep last point in window."
-  (let* ((old (selected-window))
-	 (buffer (process-buffer process))
-	 (window (get-buffer-window buffer)))
-    (save-excursion
-      (set-buffer buffer)
-      (if popper-original-filter
-	  (funcall popper-original-filter process output)
-        ;; #### is this case an error ??
-        (goto-char (process-mark process))
-        (insert output)
-        (set-marker (process-mark process) (point))))
-    (if (and window)
-	(progn
-          ;; #### grow the popup if needed & not maxed out
-	  (select-window window)
-	  (goto-char (point-max))
-	  (move-to-window-line nil)
-	  (select-window old)))))
-
-;;; #### probably other cleanup
-(defun popper-show-output (&optional buffer size)
-  "Bring the output window up showing optional BUFFER in window of
-SIZE.  If SIZE is not specified, then shrink the window.  Finally
-select the original window.  SIZE is measured in either pixels or
-characters, according to `popper-use-pixel-heights'."
-  ;; if we're in the popper buffer, bury first since by the
-  ;; time we detect it below it's difficult to handle
-  (if (eq (window-buffer (selected-window))
-          (popper-output-buffer))
-      (popper-bury-output t))
-  (let* ((window (selected-window))
-	 (old-buffer (window-buffer window))
-	 (buffer (get-buffer-create
-		  (or buffer (popper-first-buffer) 
-		      (error "No popper buffers"))))
-         (char-size (and size (popper-height-to-chars size)))
-	 start parent last-output-window
-	 (min-height (+ window-min-height (or char-size window-min-height)))
-	 (one-line-p (= 1 (save-excursion
-                            (set-buffer buffer)
-                            (count-lines (point-min) (point-max))))))
-    (if (and one-line-p popper-use-message-buffer)
-	(message (buffer-substring (point-min buffer) (point-max buffer) buffer))
-      (setq last-output-window window)
-      (if (eq buffer old-buffer)
-          (popper-shrink-window)   ; already shown => just shrink
-	(if (eq window (minibuffer-window)) 
-	    (let* ((parent (popper-parent)))
-	      (popper-bury-output t)
-	      (popper-select-window (setq window (or parent
-                                                     (previous-window)))))
-          (if (not (eq old-buffer (popper-output-buffer)))
-              (popper-bury-output t)))
-	(if (< (window-height window) min-height)
-	    (enlarge-window (- min-height ;; #### ok??
-                               (window-height window))))
-	(setq start (window-start window))
-        (if size
-            (progn
-              (split-window nil char-size)
-              (if popper-use-pixel-heights
-                  (enlarge-window-pixels (- size
-                                            (window-pixel-height)))))
-          (split-window nil (popper-max-height buffer)))
-	(set-window-buffer window buffer)
-	(set-buffer buffer)
-	(setq popper-buffer t)
-	(popper-set-output-buffers
-         (cons buffer (delq buffer (popper-get-output-buffers))))
-	(if (not size)
-            (popper-shrink-window))
-	(setq parent (next-window window 'no))
-	(popper-select parent)
-	;; Move the window so that top lines get covered unless it would
-	;; cover point in which case point is at top of window
-	(save-excursion
-	  (set-window-start parent start)
-          (if popper-use-pixel-heights
-              (progn (goto-char start)
-                     (vertical-motion-pixels
-                      (window-pixel-height window)))
-            (move-to-window-line (window-height window)))
-	  (set-window-start parent (point)))
-	(let ((point (save-excursion
-                       (vertical-motion (- popper-context-lines))
-                       (point))))
-	  (if (not (pos-visible-in-window-p (point)))
-	      (set-window-start (selected-window) point)))
-        ;; save how you scrolled in a frame property so we can
-        ;; scroll back when we later bury the popper window
-        (set-frame-property
-         (selected-frame)
-         'popper-restore-scroll
-         (list window                        ; popper window
-               (popper-window-height window) ; height of popper window
-               parent                        ; parent window
-               (window-buffer parent)        ; parent buffer
-               start                         ; old parent window start
-               (window-start)))              ; new parent window start
-        ;; restore buffer and selected window
-	(if (eq last-output-window (minibuffer-window))
-	    (popper-select-window (minibuffer-window)))
-	(set-buffer old-buffer)))))
-
-(defun popper-trim-whitespace ()
-  "Trim leading and trailing whitespace in buffer"
-  (let ((buffer-read-only nil)
-        (buffer-modified-p (buffer-modified-p)))
-    (save-excursion
-      ;; Delete trailing blank space
-      (goto-char (point-max))
-      (skip-chars-backward " \t\n")
-      (if (< (point) (point-max))
-          (delete-region (point) (point-max)))
-      ;; Delete leading blank space
-      (goto-char (point-min))
-      (skip-chars-forward " \t\n")
-      (beginning-of-line)
-      (if (> (point) (point-min))
-          (delete-region (point-min) (point)))
-      ;; restore modified-p
-      (set-buffer-modified-p buffer-modified-p))))
-
-;;; #### process stuff needs testing
-;;; #### be careful not to allow blank space shown after (point-max)
-(defun popper-shrink-window ()
-  "Shrink the current window if larger than its buffer unless it has
-an entry in popper-min-heights or it is empty in which case
-popper-empty-min is used."
-  (let* ((window (selected-window))
-	 (window-lines (popper-window-displayed-height window)))
-    (set-buffer (window-buffer window))
-    (let ((process (get-buffer-process (current-buffer))))
-      ;; fix up leading & trailing space if desired and buffer has no process
-      (when (and popper-eat-newlines (not process))
-        (popper-trim-whitespace))
-      ;; keep scrolling process pop-ups  #### broken
-      (when (and process (popper-scroll-buffer-p (current-buffer)))
-        (while (not (marker-position (process-mark process)))
-          (accept-process-output))
-        (goto-char (point-max))
-        ;; (set-marker (process-mark process) (point))
-        (insert ? ) ;; #### what?
-        (set-mark (point))
-        (when (not popper-original-filter)
-          (setq popper-original-filter (process-filter process))
-          (set-process-filter process 'popper-scroll-filter)))
-      ;; finally, shrink as needed
-      (if popper-use-pixel-heights
-          (enlarge-window-pixels
-           (let ((old-start (window-start)))
-             (unwind-protect
-                 (progn
-                   (set-window-start window (point-min))
-                   (max
-                    (- (* (face-height 'default) (popper-min-height))
-                       (window-pixel-height))
-                    (- (window-displayed-text-pixel-height nil 'noclipped)
-                       (window-text-area-pixel-height))))
-               (set-window-start window old-start)
-               (if (pos-visible-in-window-p (point-max) window)
-                   (popper-end-of-buffer)))))
-        (enlarge-window (- (max (1+ (save-excursion 
-                                      (goto-char (point-min))
-                                      (vertical-motion (1- window-lines))))
-                                (1- (popper-min-height)))
-                           window-lines))))))
-
-(defun popper-show (buffer)
-  "Function to display BUFFER in a popper window if it is in
-popper-pop-buffers or popper-pop-buffers is T and it is not in
-popper-no-pop-buffers.  This is used by popper as the value of
-`temp-buffer-show-function'."
-  (cond ((popper-handle-buffer-p buffer)
-         (popper-show-output buffer)
-         (popper-beginning-of-buffer 'noshow)
-         ;; select-window calls record-buffer.. ugh
-         (if (and (not popper-select-window-has-norecord)
-                  (popper-output-buffer)) 
-             (bury-buffer (popper-output-buffer))))
-        ((and popper-original-show-function  ; paranoia
-              (not (eq popper-original-show-function
-                       'popper-show)))
-         (let ((orig-show popper-original-show-function)
-               (popper-original-show-function nil)) ; more paranoia
-           (funcall orig-show buffer)))
-        (t
-         (display-buffer buffer)))
-  (setq minibuffer-scroll-window (get-buffer-window buffer)))
-
-(defun popper-read-popper-buffer (prompt &optional default)
-  "Read the name of a popper buffer and return as a string.
-Prompts with PROMPT.  Optional second arg DEFAULT is value
-to return if user enters an empty line."
-  (let* ((prompt (if default 
-                     (format "%s(default %s) "
-                             (gettext prompt)
-                             (if (bufferp default)
-                                 (buffer-name default)
-                               default))
-                   prompt))
-         (alist (mapcar (lambda (b) (cons (buffer-name b) b))
-                        (popper-get-output-buffers)))
-         (result (completing-read prompt alist nil t
-                                  nil 'buffer-history)))
-    (if (equal result "")
-        (setq result default))
-    (if (bufferp result)
-        (buffer-name result)
-      result)))
-
-(defun popper-do-search (&optional search-fn)
-  "Perform a search in the popper window's buffer."
-  (setq search-fn (or search-fn 'isearch-forward))
-  (let ((buffer (popper-output-buffer)))
-    (if buffer
-        (popper-with-selected-window (get-buffer-window buffer)
-          (funcall search-fn))
-      (error "No popper window displayed"))))
-
-
-;;;
-;;; Popper user commands
-;;;
-
-(defun popper-bury-output (&optional no-show)
-  "Bury the popper output.  If no popper output window is active, show 
-the popper output window, unless optional argument NO-SHOW is non-nil."
-  (interactive "_")
-  (let ((buffer (popper-output-buffer)))
-    (if buffer
-	(let* ((old (current-buffer))
-	       (old-window (selected-window))
-	       (output (get-buffer-window buffer))
-	       (start (popper-window-height output))
-	       (parent (next-window output 'no))
-	       (height (popper-window-height output))
-	       (heights (popper-window-heights output))
-               (more-than-one (cdr heights)))
-	  (bury-buffer buffer)
-	  (delete-window output)
-	  (popper-select parent)
-          (while heights
-            ;; only resize if it makes sense, eg there's more than one window
-            (when more-than-one
-              (popper-enlarge-window (- (+ height (car heights))
-                                        (popper-window-height))))
-            ;; reset the parent's window-start
-            (if start
-                (let ((vals (frame-property (selected-frame)
-                                            'popper-restore-scroll)))
-                  (if (and
-                       vals 
-                       (eq (nth 0 vals) output) ; popper window
-                       (eq (nth 1 vals) height) ; height of popper window
-                       (eq (nth 2 vals) parent) ; parent window
-                       (eq (nth 3 vals) (window-buffer parent)) ; parent buff
-                       (eq (nth 5 vals) (window-start parent))) ; parent start
-                      ;; have frame property and is applicable
-                      (set-window-start parent (nth 4 vals))
-                    ;; otherwise just avoid a redisplay jump...
-                    (condition-case ()
-                        (if popper-use-pixel-heights
-                            (save-excursion
-                              (goto-char (window-start))
-                              (vertical-motion-pixels (- start))
-                              (set-window-start parent (point)))
-                          (scroll-down (popper-height-to-chars start)))
-                      (error nil)))))
-            (popper-select-window (next-window (selected-window) 'no))
-            (setq height 0
-                  start  nil)
-            (setq heights (cdr heights)))
-	  (set-buffer old)
-	  (if (not (eq old-window output))
-	      (popper-select-window old-window)))
-      (if (not no-show)
-          (popper-show-output)))))
-
-(defun popper-scroll-output (&optional n reverse)
-  "Scroll text of the popper window upward ARG lines; or near full
-screen if no ARG.  When calling from a program, supply a number as
-argument or nil.  If the output window is not being displayed, it will
-be brought up."
-  (interactive "_P")
-  (let ((buffer (popper-output-buffer)))
-    (if buffer
-        (popper-with-selected-window (get-buffer-window buffer)
-          (if (pos-visible-in-window-p (point-max))
-              (popper-beginning-of-buffer)
-            (condition-case ()
-                (if reverse
-                    (scroll-down n)
-                  (scroll-up n))
-              (error ;; can scroll-up ever signal an error ??
-               (if (or (null n) (and (numberp n) (> n 0)))
-                   (popper-beginning-of-buffer)
-                 (popper-end-of-buffer)))))
-          (if (pos-visible-in-window-p (point-max))
-              (popper-end-of-buffer))
-          (if (pos-visible-in-window-p (point-min))
-              (popper-beginning-of-buffer))
-          (set-window-point (selected-window) (window-start)))
-      ;; wasn't shown, so show it
-      (popper-show-output))))
-
-(defun popper-scroll-output-back (&optional n)
-  "Scroll text of the popper window downward ARG lines; or near full
-screen if no ARG.  When calling from a program, supply a number as
-argument or nil.  If the output window is not being displayed, it will
-be brought up."
-  (interactive "_P")
-  (popper-scroll-output n t))
-
-(defun popper-beginning-of-buffer (&optional noshow)
-  "Scroll the text of the popper window to the beginning of the buffer."
-  (interactive "_")
-  (let ((buffer (popper-output-buffer)))
-    (if buffer
-	(let ((window (get-buffer-window buffer)))
-          (set-window-start window (point-min buffer))
-          (set-window-point window (point-min buffer)))
-      (or noshow
-          (popper-show-output)))))
-
-(defun popper-end-of-buffer (&optional noshow)
-  "Scroll the text of the popper window to the end of the buffer."
-  (interactive "_")
-  (let ((buffer (popper-output-buffer)))
-    (if buffer
-        (popper-with-selected-window (get-buffer-window buffer)
-          (goto-char (point-max))
-          (if popper-use-pixel-heights
-              (vertical-motion-pixels (- (vertical-motion 0 nil t)
-                                         (window-text-area-pixel-height))
-                                      nil
-                                      -1) ;; at-most
-            (vertical-motion (- 1 (popper-window-displayed-height))))
-          (set-window-start (selected-window) (point)))
-      (or noshow
-          (popper-show-output)))))
-
-(defun popper-isearch-forward ()
-  "Do incremental search forward in the popper window."
-  (interactive)
-  (popper-do-search 'isearch-forward))
-
-(defun popper-isearch-backward ()
-  "Do incremental search backward in the popper window."
-  (interactive)
-  (popper-do-search 'isearch-backward))
-
-(defun popper-isearch-forward-regexp ()
-  "Do incremental search forward in the popper window."
-  (interactive)
-  (popper-do-search 'isearch-forward-regexp))
-
-(defun popper-isearch-backward-regexp ()
-  "Do incremental search backward in the popper window."
-  (interactive)
-  (popper-do-search 'isearch-backward-regexp))
-
-(defun popper-grow-output (&optional n)
-  "Grow the popper window by ARG (default 1) lines.  If the popper
-window is not being shown, it will be brought up."
-  (interactive "_p")
-  (let* ((buffer (popper-output-buffer))
-         (popwin (and buffer (get-buffer-window buffer)))
-         (oldh   (popper-window-height popwin)))
-    (if buffer
-        (save-excursion
-          (popper-with-selected-window popwin
-            (setq n (max (- window-min-height (window-height))
-                         (min n (- (window-height
-                                    (next-window popwin 'no))
-                                   window-min-height))))
-            (enlarge-window n)
-            (popper-select (next-window (selected-window) 'no))
-            ;; #### need to adjust the popper-restore-scroll frame property
-            ;; #### should save pixel remainder & use it if more growth later
-            (save-excursion
-              (goto-char (window-start))
-              (if popper-use-pixel-heights
-                  (vertical-motion-pixels (- (window-pixel-height popwin)
-                                             oldh))
-                (vertical-motion n))
-              (set-window-start (selected-window) (point)))))
-      (popper-show-output))))
-
-(defun popper-shrink-output (&optional n)
-  "Shrink the popper window by ARG (default 1) lines.  If the popper
-window is not being shown, it will be brought up."
-  (interactive "_p")
-  (popper-grow-output (- n)))
-
-(defun popper-jump-to-popper (arg)
-  (interactive "P")
-  "Select the popper window, if one exists.
-With ARG, pop up the popper window first."
-  (let* ((buffer    (popper-output-buffer))
-         (window    (and buffer (get-buffer-window buffer)))
-         (back      (frame-property (selected-frame)
-                                    'popper-window-before-jump))
-         (jump-back (and (eq window (selected-window))
-                         (windowp back)
-                         (window-live-p back)
-                         (eq (window-frame back) (selected-frame)))))
-    (cond (jump-back (select-window back))
-          (window    (set-frame-property (selected-frame)
-                                         'popper-window-before-jump
-                                         (selected-window))
-                     (popper-select-window window)
-                     t)
-          (arg       (popper-show-output)
-                     (popper-jump-to-popper nil))
-          (t         (error "No popper window displayed")
-                     nil))))
-
-(defun popper-other-window (arg)
-  "Select the arg'th other window.  If arg is a C-u prefix, the popper
-window will be selected.  Otherwise, windows that contain buffers in
-popper-buffers-to-skip will be skipped or if popper-buffers-to-skip is
-T those that are not in popper-buffers-no-skip.  This is the popper
- replacement for the function `other-window'"
-  (interactive "P")
-  (if (consp arg)
-      ;; select popper window
-      (popper-jump-to-popper nil)
-    ;; otherwise, normal other-window behavior, but skip popper windows
-    (let ((win (selected-window))
-          last-win
-          dirn)
-      (setq arg  (if (eq arg '-) -1 (if (integerp arg) arg 1)))
-      (setq dirn (if (> arg 0) 'next-window 'previous-window))
-      (setq arg  (abs arg))
-      (while (> arg 0)
-        (setq last-win win)
-        (setq win (funcall dirn win))
-        ;; if we landed on a buffer we want to skip, keep going
-        ;; until we find one which is ok or we exhaust all windows
-        (while (and (popper-skip-buffer-p (window-buffer win))
-                    (not (eq win last-win)))
-          (setq win (funcall dirn win)))
-        ;; decr arg
-        (setq arg (1- arg)))
-      (select-window win))))
-
-(defun popper-switch-buffer (buffer)
-  "Switch the popper window to BUFFER.  Interactively,
-prompt for another popper output buffer to switch to."
-  (interactive
-   (list (let ((dflt (car (if (popper-output-buffer)
-                              (cdr (popper-get-output-buffers))
-                            (popper-get-output-buffers)))))
-           (when dflt 
-             (popper-read-popper-buffer "Popper buffer " dflt)))))
-  (if buffer
-      (popper-show-output buffer)
-    (error "No popper buffer to switch to")))
-
-(defun popper-kill ()
-  "Remove the current popper buffer from the LIFO stack of popper 
-buffers and show the new topmost buffer, if there is one."
-  (interactive "_")
-  (let ((buf (popper-output-buffer)))
-    (when buf
-      (popper-bury-output t)
-      (popper-set-output-buffers (delq buf (popper-get-output-buffers)))
-      (if (string-match "^popper-save:" (buffer-name buf))
-          (kill-buffer buf)
-        (bury-buffer buf))
-      (if (car (popper-get-output-buffers))
-          (popper-show-output)))))
-
-(defun popper-cycle ()
-  "Move the current popper buffer to the end of the LIFO stack of 
-popper buffers and show the new topmost buffer, if there is one."
-  (interactive "_")
-  (let ((buf (popper-output-buffer)))
-    (when buf
-      (popper-bury-output t)
-      (popper-set-output-buffers
-       (append (delq buf (popper-get-output-buffers))
-                    (list buf)))
-      (if (car (popper-get-output-buffers))
-          (popper-show-output)))))
-
-(defun popper-save ()
-  "Rename the current popper buffer to a unique name,
-so that it will be preserved."
-  (interactive "_")
-  (let ((buf (popper-output-buffer)))
-    (cond ((null buf)
-           (error "No popper buffer to save"))
-          ((string-match "^popper-save:" (buffer-name buf))
-           (message "Popper buffer already saved"))
-          (t
-           (save-excursion
-             (set-buffer buf)
-             (rename-buffer
-              (generate-new-buffer-name
-               (concat "popper-save:" (buffer-name buf)))))))))
-
-(defun popper-do-delete-window (window force)
-  "Helper function for `popper-delete-window'."
-  (or window (setq window (selected-window)))
-  (if (or popper-delete-window-can-delete-frame
-          (cdr (window-list nil 'never)))
-      (let* ((sib (next-window window 'never))
-             (fixup (and (eq window (frame-highest-window))
-                         (not (eq window sib))))
-             (dwin-ht (window-height window))
-             (dwin-pix (popper-window-height window)))
-        ;; delete it
-        (delete-window window force)
-        ;; when deleting the topmost window, counteract the display jump
-        (when fixup
-          (save-excursion
-            (set-buffer (window-buffer sib))
-            (goto-char (window-start sib))
-            (if popper-use-pixel-heights
-                (vertical-motion-pixels (- dwin-pix))
-              (vertical-motion (- dwin-ht)))
-            (set-window-start sib (point)))))
-    (error "Won't delete last window on a frame")))
-
-(defun popper-delete-window (&optional window force)
-  "Remove WINDOW from the display.  Default is selected window.
-If window is the only one on the frame, the frame is destroyed.
-Normally, you cannot delete the last non-minibuffer-only frame (you must
-use `save-buffers-kill-emacs' or `kill-emacs').  However, if optional
-second argument FORCE is non-nil, you can delete the last frame. (This
-will automatically call `save-buffers-kill-emacs'.)
-
-This function is similar to `delete-window', but buries the popper window
-when the window is actually being deleted.  Also, if the variable 
-`popper-delete-window-can-delete-frame' is nil, the frame won't be deleted
-if the window is the only window on the frame.  Finally, when the topmost
-window is deleted, the display jump is avoided if possible."
-  (interactive)
-  (or window (setq window (selected-window)))
-  (let ((parent (popper-parent)))
-    (if parent
-	(let ((pop-size (and popper-split-preserve-popper-size
-                             (popper-window-height
-                              (get-buffer-window (popper-output-buffer))))))
-          (if (eq parent window) ; deleting parent - choose a new one
-              (setq parent (next-window parent 'never)))
-	  (popper-bury-output t)
-	  (prog1
-	      (popper-do-delete-window window force)
-            (when (window-live-p parent)
-              (popper-with-selected-window parent
-                (popper-show-output nil pop-size))
-              (if (and (popper-output-buffer)
-                       (eq (selected-window)
-                           (get-buffer-window (popper-output-buffer))))
-                  (popper-other-window nil)))))
-      (popper-do-delete-window window force))))
-
-
-;;;
-;;; Function redefinitions
-;;;
-
-;; HACK: This is used by the redefined `split-window' as a post-command-hook
-;; to reshow the popper window after split-window-vertically finishes.  Is
-;; this too ugly, or is there a better way to accomplish this?
-(defvar popper-split-window-pop-size nil)
-(defvar popper-split-window-parent   nil)
-(defun popper-split-window-reshow-output ()
-  (remove-hook 'post-command-hook 'popper-split-window-reshow-output)
-  (let ((parent (if (and (window-live-p popper-split-window-parent)
-                         (eq (window-frame popper-split-window-parent)
-                             (selected-frame)))
-                    popper-split-window-parent
-                  (selected-window))))
-    (if (eq parent (selected-window))
-        (popper-show-output nil popper-split-window-pop-size)
-      (popper-with-selected-window parent
-        (popper-show-output nil popper-split-window-pop-size))))
-  (setq popper-split-window-pop-size nil)
-  (setq popper-split-window-parent   nil))
-
-(defun popper-install-redefinitions ()
-  ;;
-  ;; Don't do this stuff until popper-install() is called
-  ;;
-  (require 'advice)
-  (ad-start-advice)
-
-  ;; Outer `split-window' advice: bury and restore the popper window
-  ;; around the call to split-window.
-  (defadvice split-window (around popper:split-window-outer last activate)
-    ;; (split-window &optional WINDOW SIZE HOR-FLAG)
-    (let ((the-size (ad-get-arg 1))
-          (horizontally (ad-get-arg 2))
-          (parent (popper-parent)))
-      (if (eq parent (selected-window))
-          (let ((pop-size (and popper-split-preserve-popper-size
-                               (popper-window-height
-                                (get-buffer-window (popper-output-buffer))))))
-            (if (and the-size pop-size (not horizontally))
-                (ad-set-arg 1 (+ the-size (popper-height-to-chars pop-size))))
-            (popper-bury-output t)
-            (prog1
-                ad-do-it
-              (if (and (eq this-command 'split-window-vertically)
-                       (not split-window-keep-point))
-                  (progn ; total hack to reshow *after* s-w-vertically
-                    (setq popper-split-window-pop-size pop-size)
-                    (setq popper-split-window-parent   parent)
-                    (add-hook 'post-command-hook
-                              'popper-split-window-reshow-output))
-                (popper-show-output nil pop-size))))
-        ad-do-it)))
-
-  ;; Inner `split-window' advice: compute the size if not specified -- 
-  ;; this prevents a line from getting split in half, which is ugly and
-  ;; causes other nightmares because then the sum of the new window-heights
-  ;; is not equal to the original window-height.
-  (defadvice split-window (around popper:split-window-inner last activate)
-    ;; (split-window &optional WINDOW SIZE HOR-FLAG)
-    (let ((horizontally (ad-get-arg 2)))
-      (if (null (ad-get-arg 1))
-          (ad-set-arg 1
-                      (max (/ (if horizontally
-                                  (window-width window)
-                                (window-height window))
-                              2)
-                           (if horizontally
-                               window-min-width
-                             window-min-height))))
-      ad-do-it))
-
-  ;; Advice for `pop-to-buffer': bury popper output window around call
-  (defadvice pop-to-buffer (around popper:pop-to-buffer activate)
-    ;; (pop-to-buffer BUFFER &optional OTHER-WINDOW ON-FRAME)
-    (let ((the-buffer (ad-get-arg 0))
-          (parent (popper-parent)))
-      (if (and parent 
-               (not (eq (get-buffer the-buffer)
-                        (popper-output-buffer))))
-          (progn
-            (popper-bury-output t)
-            ad-do-it
-            (popper-select-window parent)
-            (popper-show-output)
-            (sit-for 0) ; allow display update
-            ;; now do it again but use existing window
-            (ad-set-arg 1 nil)
-            ad-do-it)
-        ad-do-it)))
-
-  ) ;; end of popper-install-redefinitions()
-
-(defun popper-unstall-redefinitions ()
-  ;;
-  ;; uninstall popper redefinitions
-  ;;
-  (ad-remove-advice 'split-window 'around 'popper:split-window-inner)
-  (ad-remove-advice 'split-window 'around 'popper:split-window-outer)
-  (ad-update 'split-window)
-
-  (ad-remove-advice 'pop-to-buffer 'around 'popper:pop-to-buffer)
-  (ad-update 'pop-to-buffer)
-  )
-
-
-;;;
-;;; Wrap functions that don't use with-output-to-temp-buffer
-;;;
-
-(defun popper-wrap-register (function)
-  "Register FUNCTION as popper-wrap'ed."
-  (setq popper-wrap-advised-functions
-        (cons function
-              (delq function
-                    popper-wrap-advised-functions))))
-
-(defmacro popper-wrap (function buffer)
-  "Define a wrapper on FUNCTION so that BUFFER will be a pop up window."
-  (let ((name (intern (concat "popper-wrapper:" (symbol-name function)))))
-    `(progn
-       (popper-wrap-register ',function)
-       (defadvice ,function (around ,name activate)
-         (let ((shown nil))
-           (save-window-excursion 
-             ad-do-it
-             (setq shown (get-buffer-window ,buffer)))
-           (if shown
-               (funcall temp-buffer-show-function
-                        ,buffer)))))))
-
-(defun popper-install-popper-wrap ()
-  ;;
-  ;; Don't do this stuff until popper-install() is called
-  ;;
-  (require 'advice)
-  (ad-start-advice)
-
-  (popper-wrap shell-command           "*Shell Command Output*")
-  (popper-wrap shell-command-on-region "*Shell Command Output*")
-  )
-
-(defun popper-unstall-popper-wrap ()
-  ;;
-  ;; unadvise any popper-wrapped functions
-  ;;
-  (let ((funcs popper-wrap-advised-functions))
-    (while funcs
-      (let ((name (intern (concat "popper-wrapper:"
-                                  (symbol-name (car funcs))))))
-        (ad-remove-advice (car funcs) 'around name)
-        (ad-update (car funcs))
-        (setq funcs (cdr funcs)))))
-  (setq popper-wrap-advised-functions nil))
-
-
-;;;
-;;; Define installation / de-installation functions
-;;;
-
-(defun popper-build-keymap ()
-  "Create the popper keymap if necessary and define default bindings."
-  (unless popper-map
-    (setq popper-map (make-sparse-keymap "popper-map")))
-
-  ;; define standard bindings
-  (define-key popper-map "1"       'popper-bury-output)
-  (define-key popper-map "z"       'popper-bury-output)
-  (define-key popper-map "\C-z"    'popper-bury-output)
-
-  (define-key popper-map "v"       'popper-scroll-output)
-  (define-key popper-map "\C-v"    'popper-scroll-output)
-  (define-key popper-map 'down     'popper-scroll-output)
-
-  (define-key popper-map "V"       'popper-scroll-output-back)
-  (define-key popper-map "\M-v"    'popper-scroll-output-back)
-  (define-key popper-map 'up       'popper-scroll-output-back)
-
-  (define-key popper-map "<"       'popper-beginning-of-buffer)
-  (define-key popper-map ">"       'popper-end-of-buffer)
-
-  (define-key popper-map "j"       'popper-jump-to-popper)
-  (define-key popper-map "\C-j"    'popper-jump-to-popper)
-  (define-key popper-map "o"       'popper-jump-to-popper)
-  (define-key popper-map "\C-o"    'popper-jump-to-popper)
-
-  (define-key popper-map "\C-s"    'popper-isearch-forward)
-  (define-key popper-map "\C-r"    'popper-isearch-backward)
-  (define-key popper-map "\M-\C-s" 'popper-isearch-forward-regexp)
-  (define-key popper-map "\M-\C-r" 'popper-isearch-backward-regexp)
-
-  (define-key popper-map "g"       'popper-grow-output)
-  (define-key popper-map "G"       'popper-shrink-output)
-  (define-key popper-map "\M-g"    'popper-shrink-output)
-
-  (define-key popper-map "b"       'popper-switch-buffer)
-  (define-key popper-map "\C-b"    'popper-switch-buffer)
-
-  (define-key popper-map "k"       'popper-kill)
-  (define-key popper-map "\C-k"    'popper-kill)
-
-  (define-key popper-map "x"       'popper-cycle)
-  (define-key popper-map "\C-x"    'popper-cycle)
-
-  (define-key popper-map "s"       'popper-save))
-
-;; define installer function and autoload it
-;;;###autoload
-(defun popper-install ()
-  "Install popper into Emacs."
-  (interactive) 
-
-  (if popper-installed-p
-      (error "Popper is already installed.")
-
-    ;; save original temp-buffer-show-function
-    ;; but avoid saving popper's show function...
-    (when (and (null popper-original-show-function)
-               (not (eq temp-buffer-show-function
-                        'popper-show)))
-      (setq popper-original-show-function
-            temp-buffer-show-function))
-
-    ;; install temp-buffer-show-function
-    (setq temp-buffer-show-function 'popper-show)
-
-    ;; set default key bindings unless already specified by user
-    (unless popper-map
-      ;; make the keymap.  user can override completely by making
-      ;; their own map from the load hook
-      (popper-build-keymap))
-
-    ;; install the popper-map, saving original binding
-    (when popper-prefix
-      (setq popper-prefix-original-binding
-            (lookup-key global-map popper-prefix))
-      (define-key global-map popper-prefix popper-map))
-
-    ;; replace bindings for `other-window' with `popper-other-window'
-    (substitute-key-definition 'other-window
-                               'popper-other-window
-                               global-map)
-
-    ;; replace bindings for `delete-window' with `popper-delete-window'
-    (substitute-key-definition 'delete-window
-                               'popper-delete-window
-                               global-map)
-
-    ;; install modeline indication for popper
-    (unless (assq 'popper-buffer minor-mode-alist)
-      (setq minor-mode-alist
-            (cons '(popper-buffer popper-mode-line-text) minor-mode-alist)))
-
-    ;; set popper modeline text unless already specified by user
-    ;; do this *after* keys get set...
-    (unless popper-mode-line-text
-      (setq popper-mode-line-text
-            (list (format 
-                   " %s bury, %s scroll" 
-                   (key-description
-                    (where-is-internal 'popper-bury-output nil t))
-                   (key-description
-                    (where-is-internal 'popper-scroll-output nil t))))))
-
-    ;; redefine `split-window' and `pop-to-buffer'
-    (popper-install-redefinitions)
-
-    ;; install popper-wrap
-    (popper-install-popper-wrap)
-
-    ;; warn about possible trouble...
-    (mapc (lambda (pair)
-            (when (boundp (car pair))
-              (unless (eq (eval (car pair)) (cdr pair))
-                (unless popper-inhibit-warnings
-                  (popper-warn "Popper suggests setting variable `%s' to %s.%s"
-                               (car pair) (cdr pair)
-                               (if (and (symbolp (car pair))
-                                        popper-fix-incompatible-settings)
-                                   " Did it."
-                                 "")))
-                (if (and (symbolp (car pair))
-                         popper-fix-incompatible-settings)
-                    (set (car pair) (cdr pair))))))
-          popper-suggested-settings)
-    (setq popper-inhibit-warnings t)
-
-    ;; remember that we're installed
-    (setq popper-installed-p t)
-    (message "Installed popper."))
-
-  ) ; end of popper-install()
-
-(defun popper-unstall ()
-  "Un-install popper from Emacs."
-  (interactive)
-
-  (if (not popper-installed-p)
-      (error "Popper isn't installed.")
-
-    ;; uninstall temp-buffer-show-function
-    (setq temp-buffer-show-function nil)
-
-    ;; try to restore original temp-buffer-show-function,
-    ;; but avoid restoring popper's show function...
-    (when (and popper-original-show-function
-               (not (eq popper-original-show-function
-                        'popper-show)))
-      (setq temp-buffer-show-function
-            popper-original-show-function))
-    (setq popper-original-show-function nil)
-
-    ;; uninstall the popper-map
-    (when popper-prefix
-      (define-key global-map popper-prefix popper-prefix-original-binding))
-
-    ;; restore bindings for `other-window'
-    (substitute-key-definition 'popper-other-window
-                               'other-window
-                               global-map)
-
-    ;; restore bindings for `delete-window'
-    (substitute-key-definition 'popper-delete-window
-                               'delete-window
-                               global-map)
-
-    ;; redefinitions
-    (popper-unstall-redefinitions)
-
-    ;; popper-wrap
-    (popper-unstall-popper-wrap)
-
-    ;; not installed
-    (setq popper-installed-p nil)
-    (message "Un-installed popper."))
-
-  ) ; end of popper-unstall()
-
-
-;;;
-;;; Installation actions
-;;;
-
-;; run our load-hook
-(run-hooks 'popper-load-hook)
-
-;; if user requested it, install popper now
-(when popper-install-when-load
-  (popper-install))
-
-
-;;;
-;;; Finally, provide the feature
-;;;
-
-(provide 'popper)
-
-
-;;; popper.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/power-macros.el b/xemacs-packages/lisp/edit-utils/power-macros.el
deleted file mode 100644
index af28944b..00000000
--- a/xemacs-packages/lisp/edit-utils/power-macros.el
+++ /dev/null
@@ -1,1932 +0,0 @@
-;;{{{ Copyright
-
-;; Copyright (C) 1999,2000 Jesper K. Pedersen 
-;;
-;; Author: Jesper Kjær Pedersen 
-;; Home page: http://www.imada.sdu.dk/~blackie/emacs/
-;; This project started: 25 May 1999
-;; This release: 
-;; Version 1.2
-;; Keywords: macros
-
-;; 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
-
-;; Keyboard Macros are a very powerful tool, if you know how to use them
-;; the right way!  Without this extension it is, however, a bit difficult in
-;; Emacs to define and maintain several macros at a time. This problem is
-;; solved with this package.
-;;
-;; When you have loaded this package Emacs will, upon completion of 
-;; macro definition, ask you which key you want to assign this macro
-;; to and ask for a description of the macro. 
-;; If something is already bound to this key, Emacs will ask you 
-;; whether you want to override this binding. Furthermore, this
-;; package also takes care of saving the macro to your .emacs file 
-;; for later Emacs sessions.
-;;
-;; The description for all the defined macros may be obtained with the
-;; function `pm-manage-macros'. Using this function you can also 
-;; manage you power-macros. You execute this function by pressing `M-x' and
-;; typing `pm-manage-macros'.
-
-;;}}}
-;;{{{ Installation description
-
-;; To install this package, copy this file to a directory in your 
-;; load-path and insert the following into your .emacs file:
-;; (require 'power-macros)
-;; 
-;; To configure the package, simply type:
-;; `M-x customize-group RET power-macros'
-
-;;}}}
-;;{{{ History information
-
-;; 0.1 First official release.
-;; 0.1.1 Fixed a few spelling errors (thanks to
-;;       camille.troillard@worldonline.fr).
-;; 0.2 Made the package into a real minor mode, added a menu to the
-;;     menu-bar, and made it customizable using customize.
-;; 0.2.1 Added support for XEmacs menus,
-;;       thanks to Jan Vroonhof )
-;;       and added a power-macros-hook.
-;;       Fixed installation description.
-;; 0.3a  - Major rewrites.
-;;       - Added support for binding keys either global, local, or for
-;;         a given mode.
-;;       - Added support for saving and loading macros in several files.
-;;       - Made the search for a possible collision with the key being
-;;         bound.
-;;       - Made managing of macros very easy using a context sensitive
-;;         buffer with the description of all the macros.
-;; 0.4a  - Major rewrites (again). This time due to realizing that 
-;;         there is no such thing as a buffer local key map, which is 
-;;         used together with major-mode map, minor-modes maps, and 
-;;         the global map.
-;;       - Lots of code cleanup, this is the last release before a 
-;;         stable release is made.
-;;       - Made it work with XEmacs (again).
-;; 1.0   - Minor bug-fixes - and of course first stable release.
-;; 1.1a1 - Answering with either RET or C-g to the question on
-;;         which key to bind keyboard macros now makes power macros
-;;         stop. This is for calling power-macros directly after 
-;;         having defined a macro.
-;;       - Macros are now by default saved to .emacs. This also means 
-;;         that the files macros are saved to are edited rather than 
-;;         overwritten.
-;;       - Removed pm-load as this function is not necessary anymore,
-;;         simply used load-file instead.
-;;       - Macros are now properly removed from files in case where
-;;         the last macro is removed.
-;;       - When power-macro-mode has been loaded, pm-define will now
-;;         by default be invoked when a macro has been recorded. This
-;;         may be changed with the variable
-;;         `power-macros-run-on-end-macro'.
-;;       - As a result of this new strategy,
-;;         `power-macros-advice-end-kbd-macro' has been removed.
-;;       - Cleaned up the descriptions, so they now follow the
-;;         convention that it should be possible to read the first
-;;         line of the description separately.
-;;       - The keybinding for `pm-manage-macros' has been removed on
-;;         request from Richard Stallman. Now you need to invoke it
-;;         as M-x pm-manage-macros.
-;;       - Pressing one of the power-macro bound keys in the manage
-;;         buffer, now has the same effect on the description text in
-;;         front of a field, as it has on the field itself.
-;;       - The package is no longer a minor-mode. This is due to a
-;;         request from Richard Stallman, who wants to include it with
-;;         Emacs version 21. This means that you only need to load
-;;         this package and then it will activate upon completing
-;;         macro definition.
-;;       - The package does no longer depend on the `cl' package.
-;; 1.1a2 - Fixed a bug which made 1.1a1 break (when the function
-;;         y-n-question wasn't defined).
-;; 1.1a3 - Documentation changes (thanks to David Wolff
-;;         ).
-;;       - Lots of documentation changes on request from RMS.
-;;       - pm-edit-desc do no longer copy the global keymap, 
-;;         RMS told me that this was not necesary.  
-;;       - pm-ask-for-mode now ask with simple y/n question on request 
-;;         from RMS.
-;;       - It is now possible to continue defining a macro from the
-;;         managing buffer.
-;;         It does, however, require a patch for it to work in 
-;;         Gnu Emacs 20.3.1
-;;       - `pm-edit-field' now asks whether you want to copy the macro 
-;;         using y-or-n-p.
-;;       - `pm-move-outside' now asks using `yes-or-no-p'.
-;;       - Made the function pm-available-modes much simpler and much
-;;         faster thanks to John Wiegley .
-;; 1.1a4 - pm-define now tells the user how to restart power-macros, when
-;;         he has pressed RET to the question on which key to bind the
-;;         macro.
-;;       - Moved power-macros from customize group `Convenience'
-;;         to `convenience'.
-;;       - Added support in the manage buffer for macros not defined
-;;         with power-macros.
-;;       - The user will now be asked for a new key if he discovers that
-;;         the key he was about to bind to (with pm-defin) is no good.
-;;       - When asking for a key to bind to, the cursor will now be located
-;;         in the minibuffer.
-;;       - The user is now queryed for a name for the macro.
-;;       - When the option `power-macros-verbose-on-load' is set,
-;;         power-macros will tell which macros it loads.
-;;       - Mode specific macro editing does now work (with regard to the
-;;         names of the functions bound to mode specific keys).
-;;       - Keys read now works with XEmacs.
-;; 1.1a5 - A huge thanks to Rob van Vulpen , who
-;;         spell checked, grammer checked and much more on version 1.1a5.
-;;       - It didn't work for XEmacs 20, since no (require 'edmacro) wasn't included,
-;;         thanks to David Berthelot  for pointing this out for me.
-;;       - Replaced edmacro-events-to-keys with events-to-keys for XEmacs.
-;; 1.2   - Released.
-
-;;}}}
-;;{{{ User definitions
-
-(defgroup power-macros nil
-  "Power Macros makes it much easier to work with macros.
-The following features are the reason for that:
-- With power-macros you may bind a macro directly to a key after 
-  having defined it.
-- With power-macros you may give your macros a description, which 
-  makes it easier to maintain them.
-- With power-macros you may define macros as being global or 
-  major-mode specific.
-- With power-macros your macros are automatically saved to your .emacs 
-  file for later sessions."
-
-  :group 'convenience)
-
-(defcustom power-macros-file user-init-file
-  "File in which new macros are saved by default.
-If you change the file name to something different from `.emacs' then
-you should insert the following line into your .emacs file:
-\(load power-macros-file)
-to ensure that macros are still loaded on startup."
-  :type 'file
-  :group 'power-macros)
-
-(defcustom power-macros-save-on-change t
-  "Non-nil means save macro to their files whenever a change is made.
-That is, whenever a change is made in the macro-manage buffer."
-  :type 'boolean
-  :group 'power-macros)
-
-(defcustom power-macros-run-on-end-macro t
-  "Non-nil means that power-macros is executed upon macro definition.
-When disabled you may invoke power-macros (that is `pm-define' to
-be accurate) by pressing \\[pm-define]."
-  :type 'boolean
-  :group 'power-macros)
-
-(defcustom power-macros-verbose-on-load t
-  "Non-nil means that `pm-def-macro' will inform which macros are loaded."
-  :type 'boolean
-  :group 'power-macros)
-
-;;}}}
-
-;;--------------------------------------------------
-;;                   CODE
-;;--------------------------------------------------
-
-;;{{{ To-do
-
-; TO-DO:
-; - When moving a macro from one file to another when managing the 
-;   macros, it should be checked for possible collisions with a power
-;   macro in the new file.
-; - When the user ends editing a keyboard macro (with kbd-edit-kbdmacro)
-;   it should be checked if the power macros should be saved.
-; - pm-set-mode-key should check for minor-modes too.
-; - pm-update-manage-buffer should also update pm-tuple-list.
-
-;;}}}
-
-(require 'edmacro)
-(require 'advice)
-(eval-when-compile (require 'cl))
-
-; Make the compiler shut up under GNU-Emacs:
-(eval-when-compile 
-  (or (featurep 'xemacs) 
-      (boundp 'event-closest-point)
-      (defun event-closest-point (dummy) 'dummy))
-  (or (featurep 'xemacs)
-      (boundp 'events-to-keys)
-      (defun events-to-keys(dummy) 'dummy))
-)
-
-;;{{{ Misc. setup
-
-(message "Loading power-macros...")
-
-(defvar pm-warn-buffer nil
-  "Buffer used when generating warnings on possible key overriding.")
-
-(defvar pm-macro-files '()
-  "List of files containing power macro definitions.") 
-
-(defvar pm-continuing-macro nil
-  "Contains the macro name when continuing a macro definition.")
-
-;;------------------------------------------------------------
-;; Variables used in the power-macro major mode
-;;------------------------------------------------------------
-(defvar pm-normal-edit-map (make-keymap)
-  "This key map is used when not editing the description field.")
-
-(defvar pm-desc-edit-map (make-keymap)
-  "This key map is used when editing the description field.")
-
-(defvar pm-token-list nil
-  "List of fields in the manage buffer.
-Each element in the list is a list itself with the following
-items:
-1: The type (either text, key, type, file, or description)
-2: The start point of the text in front of the field
-3: The start point of the field
-4: The end point of the field.")
-
-(defvar pm-tuple-list nil
-  "List of of each of the tuple in the power-macro buffer.
-Each tuple consist of the following information:
-\(physical start point, logical start point, end point, macro name)")
-
-(defvar pm-start-point nil
-  "Start of the description field being edited in the mange buffer.")
-
-(defvar pm-current-end-point nil
-  "End of the description field being edited in the manage buffer.")
-
-(defvar pm-old-end-point nil
-  "Original end of the description field being edited in the manage buffer.
-That is the location of the end before the editing started.")
-
-(defvar pm-old-desc nil
-  "Copy of the description field being edited in the manage buffer.")
-
-(defvar pm-current-macro nil
-  "Name of macro for which the description field is being edited.")
-
-(defvar pm-del-text "Marked for deletion"
-  "Text used to indicate that a record has been marked for deletion.")
-
-(defvar pm-sort-function 'string<
-  "Latest function used to sort the content of the management buffer.")
-
-;; Key bindings for power macros.
-(substitute-key-definition 'end-kbd-macro 'pm-end-kbd-macro global-map)
-(substitute-key-definition 'start-kbd-macro 'pm-start-kbd-macro global-map)
-
-;;}}}
-;;{{{ Definition of macros
-
-(defun pm-start-kbd-macro (arg)
-  "Starts defining a keyboard macro."
-  (interactive "P")
-  (setq pm-continuing-macro nil)
-  (start-kbd-macro arg))
-
-(defun pm-end-kbd-macro ()
-  "End defining keyboard macros and call power-macros on the new macro."
-  (interactive)
-  (end-kbd-macro)
-  (if pm-continuing-macro
-      (pm-end-of-continued-definition)
-    (if power-macros-run-on-end-macro
-        (pm-define))))
-
-(defun pm-define ()
-  "Bind the latest defined keyboard macro to a key, and describe it.
-This will make Emacs ask for 
-- a key to bind the macro to
-- which type it should be 
-- if the macro should be saved for future Emacs session
-- a description for the macro."
-  (interactive)
-
-  ;; Test if a macro exists.
-  (or last-kbd-macro
-      (error (substitute-command-keys "No keyboard macro has been defined yet. Define one with \\[start-kbd-macro]")))
-
-  (let ((ask-again t))
-    (while ask-again
-      (let* ((cursor-in-echo-area t) ; Ensures that the cursor is in 
-                                     ; the echo aread for the next question.
-            (key (pm-read-key-sequence "Bind macro to which key? (RET to quit) ")))
-        (if (member key '("\C-m" [return] "\C-g" [(control ?g)]))
-            (progn
-              (message 
-               (substitute-command-keys 
-                "Macro not bound to any key. Press `\\[pm-define]' if you regret this."))
-              (setq ask-again nil))
-          
-          (let* ((mode (pm-ask-for-mode t))
-                 (file (if (y-or-n-p "Should the macro be saved for future sessions? ")
-                           (expand-file-name power-macros-file) ""))
-                 (existing-name (pm-get-macros key mode file))
-                 (macro-name (pm-ask-for-macro-name existing-name)))
-        
-            ;; Verify if it is ok to bind to the key given.
-            (when (catch 'pm-stop-def
-                  (pm-possible-override t key mode file)
-                  t)
-              
-              
-              ;; Bind and describe the key.
-              (pm-describe key mode file macro-name existing-name)
-              (setq ask-again nil))
-          ))))))
-
-
-(defun pm-describe (key mode file macro-name old-name)
-  "This function sets up a buffer for describing a keyboard macro."
-  (let* ((desc (pm-get-desc key mode file))
-         (buffer (current-buffer)))
-    (switch-to-buffer (pm-create-buffer))
-    (text-mode)
-    (use-local-map (make-keymap))
-    (local-set-key [(control c) (control c)] 
-                   `(lambda () (interactive) 
-                      (pm-end-description ,key ',mode ,file 
-                                          ',macro-name ',old-name)))
-    (insert "Type a description of the macro below this line, and press C-c C-c\n")
-    (insert "------------------------------------------------------------------\n")
-    (if desc
-        (insert desc))))
-
-(defun pm-end-description (key mode file macro-name old-name)
-  "Finish macro definition when the user has typed a description.
-
-This function is invoked when the user presses C-c C-c in the
-description buffer presented to him when he has just defined a macro. 
-
-This function takes care of:
-- Assigning the macro to the key.
-- Removing the description buffer.
-- Invoking the save function.
-- Saving the description information"
-
-  (beginning-of-buffer)
-  (if (re-search-forward "-------------- *$" nil t)
-      (forward-char))
-
-  (pm-set-info mode key (buffer-substring (point) (point-max)) 
-               file macro-name)
-  (kill-buffer (current-buffer))
-  (name-last-kbd-macro macro-name)
-  (pm-set-key macro-name)
-
-  ;; Now delete the old macro if the names differs.
-  (if (and (not (eq macro-name old-name)) 
-           (not (eq old-name nil)))
-      (unintern old-name))
-
-  (pm-maybe-save)
-  (message "Assigned macro to %s" (key-description key) "."))
-
-
-(defun pm-ask-for-mode (initial-definition)
-  "Function used to ask about kind of macro (global or mode specific).
-Returns either `global' indicating that the macro should be a global
-macro, or a symbol representing the chosen mode, for example
-`c++-major-mode'."
-  
-  (let* ((global-def 
-          (not (if initial-definition
-                   (y-or-n-p "Should the macro only be defined for the current major mode? ")
-                 (y-or-n-p "Should the macro only be defined for a single major mode? ")))))
-
-    (if global-def
-        'global
-
-      ;; The macro should be mode specific!
-      (if initial-definition
-          major-mode
-
-        ;; The mode is being changed from the manage-buffer, ask for the new mode.
-        (let ((mode (completing-read 
-                     "Mode name: " (pm-available-modes)
-                     nil 1)))
-          (if (string= mode "")
-              (error "No mode selected.")
-            (intern mode)))))))
-
-;;}}}
-;;{{{ Manage buffer
-
-;;{{{ Building the buffer.
-
-(defun pm-manage-macros ()
-  "Bring up a manage buffer for editing properties of power macros."
-  (interactive)
-
-  ;; Switch to the buffer and insert the header.
-  (switch-to-buffer (pm-create-buffer))
-  (pm-macro-manage-mode)
-  (use-local-map pm-normal-edit-map)
-
-  (insert (substitute-command-keys 
-"Manage macro key bindings, file save to macro to, and much more.
-
-In this buffer you have the following possibilities:
-- Press enter or the left mouse button on one of the fields to edit
-  them. When you are done editing the key, type or file field, you
-  are asked if your edits should form a new macro, or just update the
-  existing one.
-- Move from field to field with the tabulator key.
-- Move from macro to macro by pressing page up / page down.
-- Mark a macro for deletion by pressing `d'.
-- Remove the deletion mark by pressing `u'.
-- Delete macros marked for deletion by pressing `x'.
-- Sort the entries by pressing either `s' or `S' on top of the field
-  you wish to use for sorting.
-- To edit one of the macros, simply press `e' on top of the macro.
-- Continue recording a macro by pressing `c'.
-- Press C-c C-c or \\[kill-buffer] to kill the buffer.
-
-"))
-
-  (let (key desc file macro-name mode p1 p2 tuple-start)
-    (setq pm-token-list '())
-    (setq pm-tuple-list '())    
-    (dolist (macro (pm-sort (pm-get-available-macros)))
-      (pm-initialize-macro macro)
-      (setq  key (get macro 'key)
-             desc (get macro 'documentation)
-             file (get macro 'file)
-             mode (get macro 'mode)
-             )
-
-      ;;---------- Separator
-      (setq tuple-physical-start (point))
-      (insert "--------------------------------------------------\n")
-      (setq tuple-logical-start (point))
-
-      ;; Insert a number of spaces equal to the length of the delete
-      ;; text, to avoid that all the other fields moves, when a tuple
-      ;; is marked for deletion.
-      (insert (make-string (length pm-del-text) ?\ ) "\n")
-      
-      ;;---------- Name
-      (setq p1 (point))
-      (insert "Name: ")
-      (setq p2 (point))
-      (insert (symbol-name macro) "\n")
-      (push (list 'name p1 p2 (point)) pm-token-list)
-      (add-text-properties p2 (point) '(mouse-face highlight))
-
-      ;;---------- Key
-      (setq p1 (point))
-      (insert "Key : ")
-      (setq p2 (point))
-      (if key
-          (insert (key-description key) "\n")
-        (insert "Not bound to any key.\n"))
-      (push (list 'key p1 p2 (point)) pm-token-list)
-      (add-text-properties p2 (point) '(mouse-face highlight))
-
-      ;; ---------- Type
-      (setq p1 (point))
-      (insert "Type: ")
-      (setq p2 (point))
-      (insert (if (eq mode 'global) "global"
-                (if (not mode) "unknown"
-                  (concat "mode - " (symbol-name mode))))
-              "\n")
-      (push (list 'type p1 p2 (point)) pm-token-list)
-      (add-text-properties p2 (point) '(mouse-face highlight))
-
-      ;; ---------- File
-      (setq p1 (point))
-      (insert "File: ")
-      (setq p2 (point))
-      (insert (if (string= file "") "none" file) "\n")
-      (push (list 'file p1 p2 (point)) pm-token-list)
-      (add-text-properties p2 (point) '(mouse-face highlight))
-
-      ;; ---------- Description
-      (setq p1 (point))
-      (insert "Description: ")
-      (setq p2 (point))
-      (if (string= desc "")
-          (insert "No description.")
-        (insert desc))
-      (add-text-properties p2 (point) '(left-margin 3))
-      (fill-region p2 (point))
-      (insert "\n")
-      (push (list 'desc p1 p2 (point)) pm-token-list)
-      (add-text-properties p2 (point) '(mouse-face highlight))
-
-      ;;---------- End of tuple
-      (if (not (featurep 'xemacs))
-          (insert "\n"))
-
-      (push (list tuple-physical-start tuple-logical-start (point) 
-                  macro) pm-tuple-list))
-    
-    (setq pm-token-list (nreverse pm-token-list))
-    (setq pm-tuple-list (nreverse pm-tuple-list))
-    (setq buffer-read-only t)
-    (set-buffer-modified-p nil)
-    (goto-char (point-min))
-    ))
-
-;;}}}
-;;{{{ Major mode definition
-
-(define-derived-mode pm-macro-manage-mode fundamental-mode 
-  "Macro Manage" "Mode for managing macros."
-
-  ;; ---------- Normal edit map
-  (define-key pm-normal-edit-map [(tab)] 'pm-next-field)
-  (define-key pm-normal-edit-map [(meta tab)] 'pm-prev-field)
-  (define-key pm-normal-edit-map [(next)] 'pm-next-macro)
-  (define-key pm-normal-edit-map [(prior)] 'pm-prev-macro)
-  (define-key pm-normal-edit-map [(control c) (control c)] 
-    (lambda () (interactive) (kill-buffer (current-buffer))))
-  (define-key pm-normal-edit-map [(return)] 'pm-edit-field-return)
-  (if (featurep 'xemacs)
-      (define-key pm-normal-edit-map [(button1)] 'pm-edit-field-mouse)
-    (define-key pm-normal-edit-map [(mouse-1)] 'pm-edit-field-mouse))
-  (define-key pm-normal-edit-map [(d)] 'pm-set-delete-mark)
-  (define-key pm-normal-edit-map [(u)] 'pm-unset-delete-mark)
-  (define-key pm-normal-edit-map [(x)] 'pm-execute-deletion)
-  (define-key pm-normal-edit-map [(e)] 'pm-edit-kbd-macro)
-  (define-key pm-normal-edit-map [(s)] (lambda () (interactive) 
-                                         (pm-set-sort-func 'string<)))
-  (define-key pm-normal-edit-map [(S)] (lambda () (interactive) 
-                                         (pm-set-sort-func 'pm-string>)))
-  (define-key pm-normal-edit-map [(c)] 'pm-continue-define-macro)
-
-  ;; ---------- Description edit map
-  ;; Ordinary movement functions should still exists in the rest of
-  ;; the buffer when editing the description field. Therefore only 
-  ;; inserting commands are disabled. This does however not disable
-  ;; commands like delete, return and backspace.
-  ;; Therefore the rest of the buffer is also made read-only.
-
-  (suppress-keymap pm-desc-edit-map)
-  (substitute-key-definition 'undefined 'pm-move-outside 
-                             pm-desc-edit-map)
-  (define-key pm-desc-edit-map [(return)] 'pm-move-outside)
-  (define-key pm-desc-edit-map [(delete)] 'pm-move-outside)
-  (define-key pm-desc-edit-map [(backspace)] 'pm-move-outside)
-  (define-key pm-desc-edit-map [(control k)] 'pm-move-outside)
-  (define-key pm-desc-edit-map [(control w)] 'pm-move-outside)
-  (define-key pm-desc-edit-map [(control g)] 
-    (lambda () (interactive) (pm-end-edit-or-abort-desc-field 'abort)))
-  
- )
-
-;;}}}
-;;{{{ Movement functions
-
-(defun pm-next-field ()
-  "Jumps to the next field in the manage buffer."
-  (interactive)
-  (pm-jump (lambda (x y) (< x y)) pm-token-list))
-
-(defun pm-prev-field ()
-  "Jumps to the previous field in the manage buffer."
-  (interactive)
-  (pm-jump (lambda (x y) (> x y)) (reverse pm-token-list)))
-
-(defun pm-next-macro ()
-  "Jumps to the key field of the next macro in the manage buffer."
-  (interactive)
-  (pm-jump (lambda (x y) (< x y)) pm-token-list 'name)  
-)
-
-(defun pm-prev-macro ()
-  "Jumps to the key field of the previous macro in the manage buffer."
-  (interactive)
-  (pm-jump (lambda (x y) (> x y)) (reverse pm-token-list) 'name)  
-)
-
-(defun pm-jump (dirp l &optional type)
-  "Jumps to the next or previous field in the manage buffer.
-If the optional type is given, then the field must be of the given
-type."
-  (let ((p (point))
-        (found nil)
-        (first-pos nil))
-    (while l
-      (when (and (not first-pos) (or (not type) (eq type (caar l))))
-        (setq first-pos (cadar l)))
-      (if (and (funcall dirp p (cadar l)) (or (not type) 
-                                              (eq type (caar l))))
-          (progn 
-            (goto-char (cadar l))
-            (setq l '())
-            (setq found t))
-        (setq l (cdr l))))
-    (if (not found)
-        (goto-char first-pos))))
-
-;;}}}
-;;{{{ Editing functions
-
-(defun pm-edit-field-return ()
-  "See the description for `pm-edit-field'."
-  (interactive)
-  (pm-edit-field nil))
-
-(defun pm-edit-field-mouse (event)
-  "See the description for `pm-edit-field'."
-  (interactive "e")
-  (if (featurep 'xemacs)
-      (goto-char (event-closest-point event)))
-  (pm-edit-field t))
-
-(defun pm-edit-field (is-mouse)
-  "Edits the field at point or under mouse in the manage buffer.
-
-If the field is a description field, Emacs lets the user edit it in
-the manage buffer. Otherwise he is asked for a new value in the
-mini-buffer.
-
-This function is invoked when either the enter key or the
-first mouse button is pressed in the manage buffer."
-
-  (let* ((elm (pm-get-context))
-        (widget-type (car elm))
-        (startText (cadr elm))
-        (startField (caddr elm))
-        (end (cadddr elm))
-        (macro (if (not (eq widget-type 'text))
-                   (pm-get-macro-at-point)
-                 nil))
-        (key (get macro 'key))
-        (file (get macro 'file))
-        (mode (get macro 'mode))
-        (desc (get macro 'documentation))
-        (do-reload nil)
-        do-copy tuple)
-
-    (cond 
-     
-     ((eq widget-type 'text)
-      (if (not is-mouse)
-          (beep)))
-
-     ((eq widget-type 'desc)
-      (pm-edit-desc startField end macro))
-
-     ((eq widget-type 'name)
-      (pm-edit-name startField end macro))
-
-     (t
-      (progn
-        ;; Ask if the macro should be copied before editing.
-        (setq do-copy 
-              (y-or-n-p
-               "Do you want to copy the macro before editing it? "))
-        
-        ;; Call the specific editing functions.
-        (cond ((eq widget-type 'key)
-               (setq key (pm-edit-key startField end mode file)))
-              ((eq widget-type 'type)
-               (setq mode (pm-edit-type startField end key file)))
-              ((eq widget-type 'file)
-               (setq file (pm-edit-file startField end)))
-              (t (error "Unknown widget-type `%s'" widget-type)))
-        
-        ;; Now delete the original macro if there is one on the 
-        ;; given key.
-        (let ((existing-macro (pm-get-macros key mode file)))
-          (if existing-macro
-              (progn
-                (pm-delete-macro existing-macro)
-                (setq do-reload t))))
-        
-        ;; Update the key bindings.
-        (if do-copy
-            ;; Copy the macro
-            (let ((other-macro (pm-ask-for-macro-name nil)))
-              (fset other-macro (symbol-function macro))
-              (setplist other-macro 
-                        (copy-sequence (symbol-plist macro)))
-              (setq macro other-macro); this makes the code below
-                                        ; common for both paths
-              (setq do-reload t)
-              )
-          ;; Edit the key
-          (pm-unset-key macro)
-          )
-        
-        ;; Set the new value for the new macro.
-        (pm-set-info mode key desc file macro)
-        
-        ;; Define the binding for the new key.
-        (pm-set-key macro)
-        
-        ;; Update the buffer if type is copy.
-        (if do-reload
-            (pm-manage-macros))))) ; Lets restart, that's the easiest!
-
-    (set-buffer-modified-p nil)))
-
-;;}}}
-;;{{{ Editing of key, type, file, and name
-
-(defun pm-edit-name (start end macro)
-  "Change the name for macro at point in the manage buffer."
-  (let ((new-macro (pm-ask-for-macro-name macro)))
-    (if (eq macro new-macro)
-        (message "Name is unchanged.")
-      
-      (fset new-macro (symbol-function macro))
-      (setplist new-macro
-                (copy-sequence (symbol-plist macro)))
-      (pm-delete-macro macro)
-      (pm-set-key new-macro)
-
-      (pm-manage-macros))))
-
-(defun pm-edit-key (start end mode file)
-  "Change the key for macro at point in the manage buffer.
-
-This function is invoked when enter is pressed on the `key' field of
-the manage buffer."
-  (let* ((cursor-in-echo-area t)
-         (key (pm-read-key-sequence "Which key: "))
-         (key-descs (key-description key)))
-
-    ;; Check if the new binding is ok.
-    (pm-possible-override nil key mode file)
-
-    (pm-update-manage-buffer start end key-descs)
-    key ; Return value.
-    ))
-
-
-(defun pm-edit-type (start end key file)
-  "Change the type for macro at point in the manage buffer.
-
-This function is invoked when enter is pressed on the `type' field of
-the manage buffer."
-  (let ((mode (pm-ask-for-mode nil))
-        text)
-    (if (not (eq mode 'global))
-             (setq text (format "mode - %s" (symbol-name mode)))
-      (setq text (symbol-name mode)))
-
-    ;; Check if the new binding is ok.
-    ;; (pm-possible-override nil key mode file)
-    ;; This check has been disabled as it most often only will report a
-    ;; conflict with the macro itself.
-
-    (pm-update-manage-buffer start end text)
-    mode ; Return value.
-    ))
-
-(defun pm-edit-file (start end)
-  "Change the file to which macro at point, in the manage buffer, is saved. 
-
-This function is invoked when enter is pressed on the `file' field of
-the manage buffer."
-  (let* ((old-name (buffer-substring start end))
-         (file (pm-read-file-name "New file name: " 
-                                  (file-name-directory old-name) nil)))
-    (pm-update-manage-buffer start end 
-                             (if (string= file "") "none" file))
-    file))
-
-(defun pm-read-file-name (prompt dir default)
-  "Reads a filename from the mini-buffer and checks if it is a directory."
-  (let ((save (y-or-n-p "Should the macro be saved for future sessions? "))
-        (file-name-history pm-macro-files))
-    (if save
-        (let* ((f (read-file-name prompt dir default))
-               (file (if (string= f "") f (expand-file-name f))))
-          (if (and file (file-directory-p file))
-              (error "Filename is a name of a directory.")
-            file))
-      "")))
-
-;;}}}
-;;{{{ Editing of description
-
-(defun pm-edit-desc (start end macro)
-  "Set up the manage buffer to edit the description for macro at point.
-
-This means that the whole buffer (except the region containing the
-description) is read-only.
-
-This function is invoked when enter is pressed on the description
-field in the manage buffer."
-
-  ;; Make the desc part writable.
-  (setq buffer-read-only nil)
-
-  ;; Go to start of region and record information about the text.
-  (goto-char start)
-  (setq pm-start-point (point))
-  (setq pm-current-end-point (copy-marker end))
-  (setq pm-old-end-point end)
-  (setq pm-old-desc (buffer-substring start (- end 1)))
-  (setq pm-current-macro macro)
-
-  ;; Change the bindings.
-  (use-local-map pm-desc-edit-map)
-  (let ((keym (copy-keymap global-map))) ;; It is necesary to copy the map for
-                                         ;; things to work in XEmacs.
-    (define-key keym [(control c) (control c)] 
-      (lambda () (interactive) (pm-end-edit-or-abort-desc-field 'end)))
-    (define-key keym [(control g)] 
-      (lambda () (interactive) 
-        (pm-end-edit-or-abort-desc-field 'abort)))
-    (if (featurep 'xemacs)
-        (add-text-properties start end `(keymap ,keym))
-      (add-text-properties start end `(local-map ,keym))))
-
-  ;; Make it impossible to insert at the beginning of the buffer.
-  (add-text-properties 1 2 '(front-sticky (read-only)))
-  
-  ;; Make it possible to insert at the first point in the description
-  ;; area.
-  (add-text-properties (- start 1) start 
-                       '(rear-nonsticky (face read-only)))
-
-  ;; Now make everything else than the description area read-only.
-  ;; This is to ensure that the user has not bound any strange key,
-  ;; which is not disabled by the new key map.
-  (make-face 'pm-face)
-  (set-face-foreground 'pm-face "grey")
-  (add-text-properties (point-min) start '(read-only t face pm-face))
-  (add-text-properties (- end 1) (point-max) 
-                       '(read-only t face pm-face))
-  (message "Press C-c C-c to submit changes or C-g to abort.")
-)
-
-(defun pm-end-edit-or-abort-desc-field (type)
-  "Restores the editing properties of the manage buffer.
-
-When the user ends editing a description field in the manage buffer,
-then the manage buffer must be activated again, that is pressing
-enter on one of the fields should edit this field, etc."
-  (setq inhibit-read-only t)
-  (remove-text-properties (point-min) (point-max) 
-                          '(read-only t local-map t keymap t face t))
-  (setq inhibit-read-only nil)
-
-  (if (eq type 'abort)
-      (progn
-        (delete-region pm-start-point pm-current-end-point)
-        (goto-char pm-start-point)
-        (insert pm-old-desc "\n"))
-    (progn
-      (pm-update-info-lists pm-start-point (- pm-current-end-point
-                                              pm-old-end-point))
-      (set-text-properties pm-start-point (point) 
-                           '(mouse-face highlight))
-      (put pm-current-macro 'documentation 
-           (buffer-substring-no-properties pm-start-point 
-                                           pm-current-end-point))))
-  (setq pm-current-end-point nil)
-  (use-local-map pm-normal-edit-map)
-  (setq buffer-read-only t))
-
-(defun pm-move-outside (&rest x)
-  "Query user for edits outside the description field of the manage buffer.
-
-When the user is editing a description in the manage buffer, then
-he must complete these edits before proceeding with other edits. If he
-makes an edit outside the region containing the description, then he
-is queried whether he wants to discard his edits."
-
-  (interactive)
-
-  (let ((discard
-         (yes-or-no-p "You have moved outside the description area, discard edits? ")))
-    (if discard
-        (pm-end-edit-or-abort-desc-field 'abort)
-      (progn
-        ;; c or control g has been pressed.
-        (goto-char pm-start-point)
-        (message "Continue editing the description. End with either C-c C-c or C-g")
-        ))))
-
-;;}}}
-;;{{{ Info-list management
-
-(defun pm-get-context ()
-  "Returns the type of field at point in the manage buffer.
-
-The return value is an item from the list `pm-token-list'."
-
-  (let ((p (point))
-        (l pm-token-list)
-        (last-end (point-min))
-        type start end res elm startText startField) 
-    (if (null l)
-        (list 'text nil nil nil)
-      (if (< p (cadr (car l)))
-          (list 'text (point-min) nil (cadr (car l)))
-        (progn
-          (while l
-            (setq elm (car l)
-                  l (cdr l)
-                  type (car elm)
-                  startText (cadr elm)
-                  startField (caddr elm)
-                  end (cadddr elm))
-            (if (< p startText)
-                (setq res (list 'text nil nil nil))
-              (if (< p end)
-                  (setq res elm)))
-            (if (not (null res))
-                (setq l '()))
-            (setq last-end end))
-          
-          (if (null res)
-              (list 'text nil nil nil)
-            res))))))
-
-
-(defun pm-update-info-lists (start incr)
-  "Updates `token-list' and `tuple-list' with INCR at pos START."
-
-  ;; Update the token list.
-  (let ((res '())
-        tuple-type tuple-start tuple-end)
-    (dolist (elm (reverse pm-token-list))
-      (setq tuple-type (car elm)
-           tuple-startText (cadr elm)
-           tuple-startField (caddr elm)
-           tuple-end (cadddr elm))
-      (if (> tuple-startField start)
-          (push (list tuple-type (+ tuple-startText incr) 
-                      (+ tuple-startField incr)
-                      (+ tuple-end incr)) res)
-        (if (= tuple-startField start)
-            (push (list tuple-type tuple-startText tuple-startField 
-                        (+ tuple-end incr)) res)
-          (push elm res))))
-    (setq pm-token-list res))
-
-  ;; Update the tuple list.
-  (let ((res '())
-        p-start l-start end name)
-    (dolist (elm (reverse pm-tuple-list))
-      (setq p-start (car elm)
-            l-start (cadr elm)
-            end (caddr elm)
-            name (cadddr elm))
-      (if (> p-start start)
-          (push (list (+ p-start incr) (+ l-start incr) (+ end incr) 
-                      name) res)
-        (push elm res)))
-    (setq pm-tuple-list res)))
-
-
-(defun pm-update-manage-buffer (start end text)
-  "Inserts TEXT in place of content from START to END in the manage buffer.
-Furthermore it also makes the text highlight when mouse is over the
-given region."
-
-  (setq buffer-read-only nil)
-  
-  (delete-region start end)
-  (goto-char start)
-  (insert text "\n")
-  
-  (add-text-properties start (+ start (length text))
-                       '(mouse-face highlight))
-  (setq buffer-read-only t)
-
-  ;; Now update the info lists.
-  (pm-update-info-lists start (+ 1 (- (length text) (- end start))))
-)
-    
-(defun pm-delete-tuple-in-token-list (start end)
-  "Removes tuples from `pm-token-list' in the region between START and END."
-  (let ((l pm-token-list) 
-        elm t-start t-end)
-    (setq pm-token-list '())
-    (while l
-      (setq elm (car l)
-            l (cdr l)
-            t-start (cadr elm)
-            t-end (cadddr elm))
-      (if (not (and (>= t-start start) (<= t-end end)))
-          (push elm pm-token-list)))
-    (setq pm-token-list (nreverse pm-token-list))))
-
-(defun pm-get-delete-pos ()
-  "Finds position for \"delete\" for macro at point in manage buffer.
-That is, the position where the word \"delete\" may be inserted when
-the user presses `d' in the manage buffer."
-  (pm-get-tuple-info 'cadar))
-
-(defun pm-get-macro-at-point ()
-  "Returns the name of the macro at point."
-  (pm-get-tuple-info 'cadddar))
-
-(defun pm-get-tuple-info (f)
-  "Returns information from the tuple at point in the manage buffer.
-The actual information is determined by the function F given as
-argument to the function."
-  (let ((p (point))
-        (l pm-tuple-list)
-        (res nil))
-    (if (null l)
-        (error "No macros exists!")
-      (if (< p (cadar l))
-          (error "Not located on a macro!"))
-      (while l
-        (if (< p (caddar l))
-            (setq res (funcall f l)
-                  l '())
-          (setq l (cdr l))))
-      (if (eq res nil)
-          (error "Not located on a macro!"))
-      res)))
-
-;;}}}
-;;{{{ Deletion
-
-(defun pm-set-delete-mark ()
-  "Mark the macro at point, in the manage buffer, for deletion."
-  (interactive)
-  (pm-set-or-unset-delete-mark 'set))
-
-(defun pm-unset-delete-mark ()
-  "Remove the deletion mark, for macro at point, in manage buffer."
-  (interactive)
-  (pm-set-or-unset-delete-mark 'unset))
-
-(defun pm-set-or-unset-delete-mark (type)
-  "Set or unset the deletion mark for macro at point in the manage buffer."
-  (save-excursion
-    (let ((pos (pm-get-delete-pos)))
-      (setq buffer-read-only nil)
-      (goto-char pos)
-      (delete-region pos (+ pos (length pm-del-text)))
-      (if (eq type 'set)
-          (progn
-            (insert pm-del-text)
-            (set-text-properties pos (point) '(face modeline)))
-        (insert (make-string (length pm-del-text) ?\ )))
-      (setq buffer-read-only t)
-      (set-buffer-modified-p nil))))
-
-
-(defun pm-execute-deletion ()
-  "Delete the macros marked for deletion in the manage buffer."
-  (interactive)
-  (setq buffer-read-only nil)
-  (save-excursion
-    (let ((new-list '())
-          elm p-start l-start end name)
-    
-      (while pm-tuple-list
-        (setq elm (car pm-tuple-list)
-              pm-tuple-list (cdr pm-tuple-list)
-              p-start (car elm)
-              l-start (cadr elm)
-              end (caddr elm)
-              name (cadddr elm))
-        (goto-char l-start)
-        (if (looking-at pm-del-text)
-            (progn
-              (delete-region p-start end)
-              (pm-delete-tuple-in-token-list p-start end)
-              (pm-update-info-lists p-start (- p-start end))
-              (pm-delete-macro name))
-          (push elm new-list)))
-      (setq pm-tuple-list (nreverse new-list))))
-  (setq buffer-read-only t)
-  (set-buffer-modified-p nil)
-  (pm-maybe-save))
-
-(defun pm-delete-macro (macro)
-  "Deletes the macro named MACRO, and remove its key-bindings."
-  (pm-unset-key macro)
-  (unintern macro))
-
-;;}}}
-;;{{{ Edit macro definition
-
-;; The tricky part with the function below is that edit-kbd-macro does 
-;; not support a back-end to enter the edit buffer. Thus I need to go
-;; trough the front-end, which requires that I answer a question in
-;; the mini-buffer. Luckily this can be solved with a macro ;-)
-
-(defun pm-edit-kbd-macro ()
-  "Edits the keyboard macro at point in the manage buffer."
-  (interactive)
-  (let* ((macro (pm-get-macro-at-point))
-         (macro-str (symbol-name macro))
-         (mode (get macro 'mode))
-         (new-mac (vconcat [?\M-x] "edit-kbd-macro" [return ?\M-x]
-                           macro-str [return])))
-
-    ;; I need to switch buffer to avoid that d,e,x have the meaning
-    ;; pm-delete-macro, pm-edit-kbd-macro etc. 
-    (switch-to-buffer (get-buffer-create "*power-macro-dummy*"))
-    (funcall mode)
-      
-    (execute-kbd-macro new-mac)
-    ;; Any idea how I can get pm-maybe-save executed when the user
-    ;; finishes editing the macro? The hook doesn't work when I enter
-    ;; the editing the above way.
-    ))
-
-;;}}}
-;;{{{ Continuing macro definition
-
-(defun pm-continue-define-macro ()
-  "Continue defining macro definition from manage macro buffer."
-  (interactive)
-  (let* ((macro (pm-get-macro-at-point))
-         (definition (copy-sequence (symbol-function macro))))
-    (setq last-kbd-macro definition)
-    (switch-to-buffer nil)
-    (if (y-or-n-p "Continue macro definition in this buffer? ")
-        (progn
-          (setq pm-continuing-macro macro)
-          (start-kbd-macro t))
-      (progn
-        (switch-to-buffer nil)
-        (message "Aborted continued macro definition")))))
-                                     
-(defun pm-end-of-continued-definition ()
-  "Ends the continued definition of a macro."
-  (interactive)
-  (fset pm-continuing-macro (copy-sequence last-kbd-macro))
-  (setq pm-continuing-macro nil))
-
-;;}}}
-;;{{{ Sorting
-
-(defun pm-sort (macros)
-  "Sorts the macros in the manage buffer.
-This is done based on the value of the variable `pm-sort-function'."
-  (sort macros pm-sort-function))
-
-(defun pm-set-sort-func (direction)
-  "Sorts the tuple in the manage buffer based on the field at point."
-  (let* ((elm (pm-get-context))
-        (type (car elm)))
-
-    (if (eq type 'text)
-        (error "You must press `s' on top of a field.")
-      (if (eq type 'name)
-          (setq pm-sort-function 'string<)
-        (setq pm-sort-function
-              `(lambda (x y) (,direction (format "%s" (get x ',type))
-                                         (format "%s" (get y ',type))))))))
-  (pm-manage-macros))
-
-(defun pm-string> (x y) (not (string< x y)))
-
-;;}}}
-
-;;}}}
-;;{{{ Saving
-
-(defun pm-maybe-save ()
-  "Verifies whether changes in the manage buffer should be saved.
-
-This function is invoked whenever a change is made in the manage
-buffer."
-  (if power-macros-save-on-change
-      (pm-save)))
-
-
-(defun pm-save ()
-  "Saves the macros to files."
-  (interactive)
-  (let (macros)
-    (dolist (file pm-macro-files)
-      (setq macros (pm-select `(lambda (name) 
-                                 (equal (get name 'file) ,file)) 
-                              (pm-get-available-macros)))
-      (set-buffer (find-file-noselect file))
-      (pm-save-delete file)
-      
-      (dolist (macro macros)        
-        (pm-write-tuple-to-buffer (current-buffer) macro))
-
-      (when (null macros)
-        (setq pm-macro-files (delete file pm-macro-files)))
-      
-      (write-file file)
-)))
-
-
-(defun pm-save-delete (file)
-  "Delete all the invocations of `pm-def-macro' in the current buffer.
-Leave point at the location of the last call, or after the last
-expression."
-  (goto-char (point-min))
-  (let ((last-pos (point-max))
-        sexp)
-    (while (setq sexp 
-                 (condition-case nil
-                     (read (current-buffer))
-                   (end-of-file nil)))
-
-      ; Repeat until we have read the whole buffer.
-      (when (and (listp sexp) (eq (car sexp) 'pm-def-macro))
-        (delete-region (save-excursion
-                         (backward-sexp)
-                         (point))
-                       (point))
-
-        ; ensure that no spaces are added just because we save a
-        ; number of times
-        (when (and (looking-at "$") (/= (point) (point-max)))
-          (delete-char 1)) 
-        (when (and (looking-at "$") (/= (point) (point-max)))
-          (delete-char 1)) 
-
-        (setq last-pos (point))))
-    (goto-char last-pos)))
-
-(defun pm-write-tuple-to-buffer (buf macro)
-  "This functions prints out MACRO to BUF."
-  (let* ((mode (get macro 'mode))
-        (key (get macro 'key))
-        (desc (get macro 'documentation))
-        )
-    
-    ;; print header.
-    (princ (concat "(;-" (pm-center ?- 66 " power-macros ") "-\n") buf)
-    (let ((text (concat (key-description key)
-                        " - "
-                        (if (eq mode 'global)
-                            "global definition"
-                          (concat "specific for " 
-                                  (symbol-name mode))))))
-      (princ (concat " ;-" (pm-center ?\ 66 text) "-\n") buf))
-    (princ (concat " ;" (make-string 68 ?-) "\n") buf)
-                                    
-    (princ "\tpm-def-macro\n\t'" buf)
-    (prin1 macro buf) (princ "\n\t'" buf)
-    (prin1 mode buf) (princ " " buf)
-    (prin1 key buf) (princ "\n\t" buf)
-    (prin1 desc buf) (princ "\n\t" buf)
-    (prin1 (format-kbd-macro macro) buf)
-    (princ (concat "\n ;" (make-string 68 ?-) "\n") buf)
-    (princ ")\n\n" buf)
-))
-
-
-(defun pm-center (fill-char num text)
-  "Returns TEXT with FILL-CHAR around it to center it on a line width NUM."
-  (let* ((mid (max (/ (- num (length text)) 2) 0))
-        (extra (max (- num (length text) (* 2 mid)) 0)))
-    (concat (make-string mid fill-char) text 
-            (make-string (+ extra mid) fill-char))))
-
-;;}}}
-;;{{{ Loading
-
-(defun pm-def-macro (macro-name mode key desc macro-def)
-  "Defines a new macro.
-This function is the one written into the init file."
-  (let* ((file (if load-file-name 
-                   load-file-name 
-                 (if buffer-file-name
-                     buffer-file-name
-                   (error "I can't figure out the current file name. You must call pm-def-macro from your .emacs file or another file loaded!")))))
-
-    ;; Verify that no symbol exists with the given name.
-    (if (fboundp macro-name)
-        (error "A macro or function with name `%s' does already exists." macro-name))
-
-    ;; Define the macro.
-    (fset macro-name (read-kbd-macro macro-def))
-    
-    ;; Set the info about the macro.
-    (pm-set-info mode key desc (expand-file-name file) macro-name)
-
-    ;; Bind the key.
-    (pm-set-key macro-name)
-
-    ;; Inform the definition of the macro.
-    (if power-macros-verbose-on-load
-        (message "loaded macro `%s'" macro-name))))
-
-;;}}}
-;;{{{ Database Management
-
-;; These functions takes care of managing the key bindings,
-;; descriptions and file information The data is located as
-;; properties in the symbol defining the macro.
-;;
-;; The following elements exist:
-;;     key           - The key for which this macro is bound.
-;;     documentation - The description of this macro.
-;;     file          - The file in which this macro is saved.
-;;     mode          - The name of the major mode for mode specific
-;;                     macros or the symbol global.
-
-(defun pm-get-macros (key mode file &optional all)
-  "Returns the macro bound to KEY for mode MODE for file FILE.
-Any of the fields might be nil, which means that they are wild-cards. 
-If ALL is t, then a list of matches is returned."
-  (let ((list (pm-get-available-macros))
-        (res '())
-        macro)
-    (while list
-      (setq macro (car list)
-            list (cdr list))
-      (if (and (or (null key) (equal (get macro 'key) key))
-               (or (null mode) (eq (get macro 'mode) mode))
-               (or (null file) (equal (get macro 'file) file)))
-          (push macro res)))
-
-    (if all
-        res
-      (if (> (length res) 1)
-          (error "Internal error: More that one tuple matched the query.")
-        (car res)))))
-
-(defun pm-get-desc (key mode file)
-  "Returns macro description for the given key/mode/file."
-  (let ((name (pm-get-macros key mode file)))
-    (if (null name)
-        ""
-      (get name 'documentation))))
-
-(defun pm-set-info (mode key desc file macro-name)
-  "Inserts information into the power-macro database."
-  (put macro-name 'mode mode)
-  (put macro-name 'key key)
-  (put macro-name 'documentation desc)
-  (put macro-name 'file file)
-  (if (and (not (string= file "")) (not (member file pm-macro-files)))
-      (push file pm-macro-files)))
-
-(defun pm-get-available-macros ()
-  "Returns the keyboard macros defined."
-  (let* ((macros '())
-         (find-macros 
-         (lambda (s)
-           (if (and (fboundp s)
-                    (or (stringp (symbol-function s))
-                        (vectorp (symbol-function s))))
-               (setq macros (cons s macros))))))
-    (mapatoms find-macros)
-    macros))
-
-(defun pm-initialize-macro (macro)
-  "Initialized a macro with the attributes required by power-macro."
-  (let ((key (get macro 'key))
-        (desc (get macro 'documentation))
-        (file (get macro 'file))
-        mode map map-name)
-
-    (when (eq key nil)
-      ;; Search for a key where this macro is bound to.
-      (let ((keys (where-is-internal macro global-map)))
-        (if keys
-            ;; The key was bound to the global map.
-            (progn
-              (put macro 'key (car keys))
-              (put macro 'mode 'global))
-
-          ;; Search for a key binding in one of the mode maps.
-          (dolist (mode-l (pm-available-modes))
-            (setq mode (car mode-l))
-            (setq map-name (intern (concat mode "-map")))
-            (setq map (if (boundp map-name)
-                          (eval map-name)
-                        nil))
-            (when (keymapp map)
-              (setq keys (where-is-internal macro map))
-              (when keys
-                (put macro 'key (car keys))
-                (put macro 'mode (intern mode))))))))
-
-    (when (eq file nil)
-      (put macro 'file ""))
-
-    (when (eq desc nil)
-      (put macro 'documentation ""))))
-
-;;}}}
-;;{{{ Key binding check
-
-;;{{{ Description
-
-; The function pm-possible-override takes care of warning the user if
-; he is about to overwrite a key or shadow key. Below the rules for
-; checking this are described.
-
-;--------------- meaning of symbols ---------------
-; 
-; (+) Means that the given test is implemented.
-; (-) Means that the given test is not implemented. This is either
-;     because I don't know how to do it, or because I find it very
-;     unlikely that it will ever be used.
-;
-; (key, mode, file) in set pm-bind
-;     Check if pm-macros contain a definition for the given
-;     key,type,mode,file tuple.
-;     A dash means that the given field does have a meaning (only used
-;     for mode).
-;     An asterisk is a wildcard meaning that this field should not be
-;     included when searching for tuples.
-
-; Key in set map.
-;    Check if key is bound in the given map.
-;
-; Override.
-;    This means that if the given check returns true, then the new
-;    definition will override the given match(es).
-;
-; Shadows.
-;    This means that if the given check returns true, then the new
-;    definition will shadow the given match(es). Which means that the
-;    existing definition(s) will not be visible.
-;
-; Invisible
-;    This means that if the given check returns true, then the new
-;    definition will have no effect. 
-;
-; Note: that the two clauses above might only be true for the given 
-; mode or the given buffer.
-; 
-; 1)
-;    This means test number one for both new bindings and existing
-;    bindings.
-; 1 new)
-;    This means test number one. It should, however, only be done for
-;    new bindings.
-
-;--------------- Want to bind a global key ---------------
-; (+) 1)     Override  - (key,global,-,file) in set PM-bind
-; (-) 2)     Override  - (key,global,-,*)    in set PM-bind
-; (+) 3)     Override  - key in set global-map
-; (-) 4 new) Invisible - (key,active-modes,*) in set PM-bind
-; (+) 5 new) Invisible - key in set *-active-mode-map
-; (-) 6)     Invisible - (key,*-mode,*) in set PM-bind
-; (-) 7)     Invisible - key in set *-mode-map
-
-;--------------- Want to bind a mode specific key ---------------
-; (+) 1)      Override  - (key,mode,file) in set PM-bind
-; (-) 2)      Override  - (key,mode,*) in set PM-bind
-; (+) 3)      Override  - key in set mode-map
-; (-) 4)      Shadows   - (key,global,*) in set PM-bind
-; (+) 5)      Shadows   - key in set global-map
-; (-) 6 new)  Invisible - (key,active-minor-modes,*) in set PM-bind
-; (+) 7 new)  Invisible - key in set active-minor-modes-maps
-; (-) 8)      Invisible - (key,*-minor-mode,*) in set PM-bind
-; (-) 9)      Invisible - key in set *-minor-modes-map
-
-;;}}}
-;;{{{ pm-possible-override
-
-(defun pm-possible-override (new-def key mode file) 
-  "Check whether the new key binding violates an existing one.
-For a list of all the different checks, please see the description in
-the source code."
-
-  (let* ((buf (pm-create-buffer "*Warning*"))
-         (any-output nil)
-         main-macro macro-list macro)
-    (setq pm-warn-buffer buf)
-    (pm-insert "Your new definition might violate an existing definition. Below you
-see a report of what will happen if you make your binding.")
-
-    
-    ;; First we need to attach power-macro information to every macro.
-    (dolist (macro (pm-get-available-macros))
-      (pm-initialize-macro macro))
-
-    ;; -------------------------------
-    ;; Rule no. 1 is the same for both
-    ;; -------------------------------
-    (setq main-macro (pm-get-macros key mode file))
-    (if main-macro
-        (progn
-          (setq any-output t)
-          (pm-insert "\n
----------------------------------------------------------------------
-
-This definition will " (pm-outstand "replace") " an existing macro on the same key,
-with the same type and defined in the same file. Its description is:\n")
-          (pm-insert (pm-indent (get main-macro 'documentation)))))
-
-      
-    ;; -------- The rest of the rules ---------
-    (setq any-output (or (cond 
-                          ((eq mode 'global) 
-                           (pm-override-global new-def key file 
-                                               main-macro))
-                          
-                          (t
-                           (pm-override-mode new-def key file mode 
-                                             main-macro))) 
-                         any-output))
-
-    (pm-insert "\n") ; This is to ensure that there is a location, 
-                     ; which is not with the left-margin property.
-
-    (if any-output
-        (save-excursion
-          (switch-to-buffer buf)
-          (pm-indent-regarding-to-properties)
-          (setq buffer-read-only t)
-          (goto-char (point-min))
-          (if (not (yes-or-no-p "Continue defining the macro? "))
-              ;; Stop defining the macro.
-              (progn
-                (kill-buffer buf)
-                (throw 'pm-stop-def nil)))))
-    
-      ;; Finally kill the buffer.
-    (kill-buffer buf)))
-
-;;}}}
-;;{{{ pm-override-global
-
-(defun pm-override-global (new-def key file main-macro)
-  "Checks if the new global key binding violates an existing binding.
-See the source code for all the different checks."
-
-  (let ((any-output nil))
-        
-
-    ;; --------------------------------
-    ;; Rule no. 3
-    ;; Override - key in set global-map
-    ;; --------------------------------
-    (setq any-output 
-          (or (pm-check-binding 'global key 'conflict main-macro) 
-              any-output))
-
-    ;; ----------------------------------------
-    ;; Rule no. 5 (only for new macros)
-    ;; Invisible - key in set *-active-mode-map
-    ;; ----------------------------------------
-    (if new-def
-        (setq any-output
-              (or (pm-check-binding 'mode key 'invisible  
-                                    main-macro major-mode) 
-                  any-output)))
-
-    (if new-def
-        (setq any-output
-              (or (pm-check-binding 'minor-mode key 'invisible 
-                                    main-macro) 
-                  any-output)))
-
-
-    any-output)) ; Return value.
-
-;;}}}
-;;{{{ pm-override-mode
-
-(defun pm-override-mode (new-def key file mode main-macro)
-  "Checks if the new mode key binding violates an existing bindings.
-See the source code for all the different checks."
-
-  (let ((any-output nil))
-
-    ;; ---------------------------------------
-    ;; Rule no. 3
-    ;; Override  - key in set current-mode-map
-    ;; ---------------------------------------
-    (setq any-output
-          (or (pm-check-binding 'mode key 'conflict  main-macro mode)
-              any-output))
-    
-
-    ;; ---------------------------------
-    ;; Rule no. 5
-    ;; Shadows   - key in set global-map
-    ;; ---------------------------------
-    (setq any-output
-          (or (pm-check-binding 'global key 'shadows main-macro)
-              any-output))
-
-    ;; ----------------------------------------------
-    ;; Rule no. 7 (only for new macros)
-    ;; Invisible - key in set active-minor-modes-maps
-    ;; ----------------------------------------------
-    (if new-def
-        (setq any-output
-              (or (pm-check-binding 'minor-mode key 'invisible 
-                                    main-macro)
-                  any-output)))
-
-    any-output)) ; Return value.
-
-;;}}}
-;;{{{ pm-check-binding
-
-(defun pm-check-binding (type key warn-type main-macro &optional mode)
-  "Verify if a key binding of type TYPE exists for KEY.
-If this is the case then this function will insert a warning of type
-WARN-TYPE, telling that there is a problem. 
-The function returns whether there was anything to report.
-
-WARN-TYPE is one of: conflict, invisible, shadows
-TYPE is one of: global, mode, minor-mode."
-
-  (let* (map-name
-         (func (cond ((eq type 'global) (pm-lookup-key global-map key))
-                     ((eq type 'mode)
-                      (progn
-                        (setq map-name (intern 
-                                        (concat (symbol-name mode) 
-                                                "-map")))
-                        (if (boundp map-name)
-                            (pm-lookup-key (eval map-name) key)
-                          nil)))
-                     ((eq type 'minor-mode) 
-                      (pm-get-minor-mode-binding key))
-                     (t (error "Internal error: Unknown type."))))
-         (where (symbol-name type)))
-    (if (and func (not (eq func main-macro)))
-        (progn
-
-          (pm-insert "\n---------------------------------------------------------------------\n\n")
-          ;; Insert the warning text.
-          (if (eq warn-type 'conflict)
-              (pm-insert "This definition will " 
-                         (pm-outstand "conflict") " with ")
-            (if (eq warn-type 'invisible)
-                (pm-insert "This definition will " 
-                           (pm-outstand "be invisible") " because of ")
-              (if (eq warn-type 'shadows)
-                  (pm-insert "This definition will " 
-                             (pm-outstand "shadow") " for the ")
-              (error (format "Unknown type %s" warn-type)))))
-
-          ;; Now insert the description for the function.
-          (if (symbolp func) ;; This is a function name.
-              (if (fboundp func) ;; The function exists.
-
-                  (if (member func (pm-get-available-macros))
-              
-                      ;; This is a macro with a description.
-                      (pm-insert "the " where " macro loaded from\nthe file '" 
-                                 (get func 'file) 
-                                 "'. Its description is:\n"
-                                 (pm-indent (get func 'documentation)))
-                      
-                    ;; This is another existing function.
-                    (pm-insert "the " where " function '" 
-                               (symbol-name func) 
-                               "'\nwhich has the following description:\n"
-                               (pm-indent (documentation func))))
-
-                ;; The function doesn't seem to be defined.
-                (pm-insert "the " where 
-                           " function '" (symbol-name func) "' which,\n"
-                           "however, doesn't seem to be defined. (At least not at the moment.)"))
-            
-            ;; Hmm it was not a symbol, then it might be a 
-            ;; lambda expression.
-            ;; Does there exists other possibilities?
-            (pm-insert "the following " where " definition:\n" 
-                       (format "%s" func)))
-
-
-          t) ;; Return value.
-      nil)))
-
-;;}}}
-;;{{{ Misc
-
-(defun pm-outstand (text)
-  "Adds bold properties to the string given as argument."
-  (let ((new-text (concat text))) ;; We need to copy it to avoid adding
-                                  ;; properties to the original widget.
-    (add-text-properties 0 (length new-text) '(face bold) new-text)
-    new-text))
-
-(defun pm-indent (text)
-  "Returns TEXT but with the exception that it has indentation properties."
-  (let ((new-text (concat text))) ;; We need to copy it to avoid adding
-                                  ;; properties to the original widget.
-    (add-text-properties 0 (length new-text) '(left-margin 3) new-text)
-    new-text))
-
-
-(defun pm-indent-regarding-to-properties ()
-  "Indent the warning buffer with respect to the text property `left-margin'.
-This function runs through the buffer with warnings about overriding
-keys etc. and executes fill-region on the locations where the text 
-property left-margin is set."
-  (let ((cont t)
-        (end (point-min))
-        start)
-    (while cont
-      (setq cont nil)
-      (setq start (next-single-property-change end 'left-margin))
-      (if start
-          (if (not (get-text-property start 'left-margin))
-              (setq cont t
-                    end (+ end 1))
-            (progn
-              (setq end (next-single-property-change start 
-                                                     'left-margin))
-              (if end
-                  (progn
-                    (fill-region start end)
-                    (setq end (+ end 1))
-                    (setq cont t)))))))))
-  
-
-
-(defun pm-lookup-key (map key)
-  "Returns the function definition bound to key if it exists.
-If no definition is bound to the key, then nil is returned."
-  (let ((func (lookup-key map key)))
-    (if (and func (not (numberp func)))
-        func
-      nil)))
-
-
-
-(defun pm-get-minor-mode-binding (key)
-  "Returns the visible definitions of KEY in the active minor modes."
-  (let ((maps (current-minor-mode-maps))
-        (binding nil))
-    (while maps
-      (setq binding (lookup-key (car maps) key))
-      (if (and binding (not (numberp binding)))
-          (setq maps '())
-        (setq binding nil))
-      (setq maps (cdr maps)))
-    binding))
-
-(defun pm-insert (&rest args)
-  "Inserts text into the buffer pm-warn-buffer."
-  (save-excursion
-    (set-buffer pm-warn-buffer)
-    (eval `(insert ,@args))))
-
-;;}}}
-
-;;}}}
-;;{{{ Actual key (un)binding
-
-(defun pm-unset-key (macro)
-  "Removes the binding for MACRO."
-  (let ((key (get macro 'key))
-        (mode (get macro 'mode)))
-    (if (eq mode 'global)
-        (if (eq (lookup-key global-map key) macro)
-            (global-unset-key key))
-
-      ;; Mode specific binding.
-      (let* ((map (intern (concat (symbol-name mode) "-map"))))
-        (if (boundp map)
-            (if (eq (lookup-key (eval map) key) macro)
-                (define-key (eval map) key nil))
-
-          ;; No map exists, we must then unadvice the function and run
-          ;; through all buffers.
-          (if (fboundp mode)
-              (pm-set-or-unset-mode-key macro mode key 'unset)))))))
-
-(defun pm-set-key (macro)
-  "Bind MACRO as described in the power-macro database."
-
-  (let ((mode (get macro 'mode))
-        (key (get macro 'key)))
-    (if (eq mode 'global)
-        (global-set-key key macro)
-
-      ;; Major-mode macro.
-      (let ((map (intern (concat (symbol-name mode) "-map"))))
-        (if (boundp map)
-            (define-key (eval map) key macro)
-
-          ;; A mode-map didn't exists so now we need to make the 
-          ;; binding much more manual.
-          (pm-set-or-unset-mode-key macro mode key 'set))))))
-
-(defun pm-set-or-unset-mode-key (macro mode key type)
-  "(Un)set binding for MACRO in existing and future buffers with mode MODE."
-
-  (let ((all-buffers (buffer-list))
-        (adv-name (intern (concat (symbol-name macro) "-advice"))))
-
-    ;; Run through all the buffers and bind the key for buffers 
-    ;; with the given major mode.
-    (dolist (buf all-buffers)
-      (save-excursion 
-        (set-buffer buf)
-        (when (eq major-mode mode)
-          (if (eq type 'set)
-              (local-set-key key macro)
-            
-            ;; Unset the key if it is bound to the macro.
-            (if (and (current-local-map)
-                     (eq (lookup-key (current-local-map) key) macro))
-                (local-unset-key key))))))
-    
-    (if (eq type 'set)
-        (eval `(defadvice ,mode (after ,adv-name activate)
-                 (local-set-key ,key ',macro)))
-      (ad-remove-advice mode 'after adv-name))
-    ))
-
-;;}}}
-;;{{{ Utility functions
-
-(defun pm-create-buffer (&optional name)
-  "Switches to the named buffer or to the power-macros buffer.
-The buffer is created if it doesn't exist."
-  (let* ((nm (if name name "*Power Macros Description*"))
-        (old-buf (get-buffer nm)))
-    (if old-buf
-        (kill-buffer old-buf))
-    (get-buffer-create nm)))
-
-
-(defun pm-ass-remove (var list)
-  "Removes VAR from assoc list LIST."
-  (if (null list)
-      '()
-    (if (eq (caar list) var)
-        (pm-ass-remove var (cdr list))
-      (cons (car list) (pm-ass-remove var (cdr list))))))
-
-
-;; Does select not exist in core lisp?
-(defun pm-select (func list)
-  "Returns a list with elements from LIST, which matches the predicate FUNC."
-  (let ((res '()))
-    (while list
-      (if (funcall func (car list))
-          (push (car list) res))
-      (setq list (cdr list)))
-    (nreverse res)))
-
-(defun pm-available-modes ()
-  "Returns the list of available modes."
-  (let ((mode-list (mapcar 'symbol-name
-                           (apropos-internal "-mode\\'" 'fboundp))))
-    (mapcar 'list mode-list)))
-
-(defun cadddar (l)
-  (cadddr (car l)))
-
-(defun pm-new-dummy-macro-name ()
-  "Generates a new name for a macro."
-  (let ((num 1)
-        (name 'pm-macro-1))
-    (while (fboundp name)
-      (setq num (+ num 1))
-      (setq name (intern (format "pm-macro-%s" num))))
-    (symbol-name name)))
-
-
-(defun pm-ask-for-macro-name (old-name)
-  "Ask for a name for a new macro."
-  (let ((ask-again t)
-       (name (intern 
-              (if old-name (symbol-name old-name) (pm-new-dummy-macro-name)))))
-    (while ask-again
-      (setq name
-            (intern (read-from-minibuffer "A short unique name for the macro: "
-                                          (symbol-name name))))
-      (if (and (not (eq name old-name)) (fboundp name))
-          (progn
-            (message "Symbol exists!")
-            (sit-for 1))
-        (setq ask-again nil)))
-    name)) ; Return value.
-
-(defun pm-read-key-sequence (question)
-  "Reads a key sequence."
-  (let ((key (read-key-sequence question nil t)))
-    (if (featurep 'xemacs)
-        (events-to-keys key)
-      key)))
-
-;;}}}
-
-(provide 'power-macros)
-(message "Loading power-macros...done")
-
-
diff --git a/xemacs-packages/lisp/edit-utils/recent-files.el b/xemacs-packages/lisp/edit-utils/recent-files.el
deleted file mode 100644
index 8576cf3c..00000000
--- a/xemacs-packages/lisp/edit-utils/recent-files.el
+++ /dev/null
@@ -1,769 +0,0 @@
-;;; recent-files.el --- Maintain menu of recently opened files.
-;;; $Header: /pack/xemacscvs/XEmacs/packages/xemacs-packages/edit-utils/recent-files.el,v 1.9 2004/11/08 02:38:42 ben Exp $
-;;;
-;;; Copyright (C) 1994, 1995 Juergen Nickelsen 
-;;; Copyright (C) 2002 Ben Wing.
-;;;
-;; Keywords: menu, file
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-;;;
-;;; recent-files.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 XEmacs; see the file COPYING.  If not, write to the
-;;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-;;; ------------------------------------------------------------------
-;;;
-;;; Enough of this boring stuff. To install recent-files, put the
-;;; following statements into your .emacs file 
-;;;    (load "recent-files")
-;;;    (recent-files-initialize)
-;;; and place the file recent-files.el in a directory in your XEmacs's
-;;; load-path.  In order to use recent-files with dired, dired has to
-;;; be loaded first.  recent-files is known to work with Lucid Emacs /
-;;; XEmacs 19.8 and higher; it does not work correctly with 19.6 or
-;;; earlier versions due to a bug in add-menu.
-;;;
-;;; recent-files adds the menu "Recent Files" (or whatever name you
-;;; choose, see "Customization:" below) to Emacs's menubar. Its
-;;; entries are the files (and directories) that have recently been
-;;; opened by Emacs. You can open one of these files again by
-;;; selecting its entry in the "Recent Files" menu. The list of file
-;;; entries in this menu is preserved from one Emacs session to
-;;; another. You can prevent Emacs from saving this list by selecting
-;;; "Don't save recent-files list on exit" from the menu. If you have
-;;; disabled saving, you can re-enable it by selecting "Save
-;;; recent-files list on exit".
-;;;
-;;; The menu has permanent and non-permanent entries. Permanent
-;;; entries are marked with an asterisk in front of the filename. The
-;;; non-permanent entries are hidden in a submenu.
-;;;
-;;; Each time you open a file in Emacs, it is added as a non-permanent
-;;; entry to the menu. The value of `recent-files-number-of-entries'
-;;; determines how many non-permanent entries are held in the
-;;; menu. When the number of non-permanent entries reaches this value,
-;;; the least recently added non-permanent entry is removed from the
-;;; menu when another non-permanent entry is added. It is not removed
-;;; from the list, though; it may reappear when entries are deleted
-;;; from the list. The number of entries saved to disk is the value of
-;;; the variable `recent-files-number-of-saved-entries'.
-;;;
-;;; Permanent entries are not removed from the menu. You can make a
-;;; file entry permanent by selecting "Make  permanent" (where
-;;;  is the name of the current buffer) when the current
-;;; buffer holds this file. "Make  non-permanent" makes the
-;;; file entry of the current buffer non-permanent.
-;;;
-;;; The command "Kill buffer  and delete entry" is handy when
-;;; you have accidently opened a file but want to keep neither the
-;;; buffer nor the entry.
-;;;
-;;; You can erase the list of non-permanent entries by selecting
-;;; "Erase non-permanent entries" from the menu.
-;;;
-;;; Customization:
-;;;
-;;; There are lots of variables to control the behaviour of
-;;; recent-files. You do not have to change any of them if you like it
-;;; as it comes out of the box. However, you may want to look at these
-;;; options to make it behave different.
-;;;
-;;; `recent-files-number-of-entries'
-;;;    Controls how many non-permanent entries are shown in the
-;;;    recent-files list.  The default is 15. 
-;;;
-;;; `recent-files-number-of-saved-entries'
-;;;    Controls how many non-permanent entries are saved to disk when
-;;;    Emacs exits or recent-files-save-the-list is called. The
-;;;    default is 50.
-;;;
-;;; `recent-files-save-file'
-;;;    The name of the file where the recent-files list is saved
-;;;    between Emacs session. You probably don't need to change this.
-;;;    The default is ".recent-files.el" in your home directory.
-;;;
-;;; `recent-files-dont-include'
-;;;    A list of regular expressions for files that should not be
-;;;    included into the recent-files list. This list is empty by
-;;;    default. For instance, a list to exclude all .newsrc
-;;;    files, all auto-save-files, and all files in the /tmp
-;;;    directory (but not the /tmp directory itself) would look
-;;;    like this:
-;;;         (setq recent-files-dont-include
-;;;               '("/\\.newsrc" "~$" "^/tmp/."))
-;;;    The default is empty.
-;;;
-;;; `recent-files-use-full-names'
-;;;    If the value of this variable is non-nil, the full pathnames of
-;;;    the files are shown in the recent-files menu. Otherwise only
-;;;    the filename part (or the last name component if it is a
-;;;    directory) is shown in the menu. The default it t, i.e. show
-;;;    full names.
-;;;
-;;; `recent-files-filename-replacements'
-;;;    This is a list of pairs of regular expressions and replacement
-;;;    strings. If a filename matches one of the regular expressions,
-;;;    the matching part is replaced by the replacement string for
-;;;    display in the recent-files menu.
-;;;    Example: My home directory is "/users/mmc/nickel/". I want to
-;;;    replace it with "~/". I also want to replace the directory
-;;;    "/imports/teleservices/mmc/avc2/", where I work a lot, with
-;;;    ".../avc2/". The list then looks like
-;;;        (setq recent-files-filename-replacements
-;;;              '(("/users/mmc/nickel/" . "~/")
-;;;                ("/imports/teleservices/mmc/avc2/" . ".../avc2/")))
-;;;    Only the first match is replaced. So, if you have several
-;;;    entries in this list that may match a filename simultaneously,
-;;;    put the one you want to match (usually the most special) in
-;;;    front of the others. The default is to replace the home
-;;;    directory with "~".
-;;;
-;;; `recent-files-sort-function'
-;;;    Contains a function symbol to sort the display of filenames in
-;;;    the recent-files menu. Supplied are two functions,
-;;;    'recent-files-dont-sort and 'recent-files-sort-alphabetically.
-;;;    The first, which is the default, preserves the order of "most
-;;;    recent on top". 
-;;;
-;;; `recent-files-permanent-submenu'
-;;;    If this variable is non-nil, the permanent entries are put into
-;;;    a separate submenu of the recent-files menu. The default is
-;;;    nil.
-;;;
-;;; `recent-files-non-permanent-submenu'
-;;;    If this variable is non-nil, the non-permanent entries are put
-;;;    into a separate submenu of the recent-files menu. [[The default
-;;;    is currently t, but probably should be nil, and we may change it
-;;;    back. (You can set both `recent-files-permanent-submenu' and
-;;;    `recent-files-non-permanent-submenu' to t to have both lists in
-;;;    separate submenus.)]] Now defaults to nil.
-;;;
-;;; `recent-files-commands-submenu'
-;;;    If this variable is non-nil, the commands if recent-files are
-;;;    placed in a submenu of the recent-files menu. The default is
-;;;    nil.
-;;;
-;;; `recent-files-commands-submenu-title'
-;;;    If the commands are placed in a submenu, this string is used as
-;;;    the title of the submenu. The default is "Commands...".
-;;;
-;;; `recent-files-actions-on-top'
-;;;    If this variable is non-nil, the "action" menu entries ("Make
-;;;     permanent" etc.) are put on top of the menu. Otherwise
-;;;    they appear below the file entries or submenus. The default is
-;;;    nil.
-;;;
-;;; `recent-files-permanent-first'
-;;;    If this variable is t, the permanent entries are put first in
-;;;    the recent-files menu, i.e. above the non-permanent entries. If
-;;;    the value is nil, non-permanent entries appear first. If the
-;;;    value is neither t nor nil, the entries are sorted according to
-;;;    recent-files-sort-function. The default is 'sort.
-;;;
-;;; `recent-files-find-file-command'
-;;;    This variable contains to commandto execute when a file entry
-;;;    is selected from the menu. Usually this will be `find-file',
-;;;    which is the default.
-;;;
-;;; KNOWN BUG:
-;;;   - recent-files overwrites the recent-files-save-file
-;;;     unconditionally when Emacs exits. If you have two Emacs
-;;;     processes running, the one exiting later will overwrite the
-;;;     file without merging in the new entries from the other Emacs
-;;;     process. This can be avoided by disabling the save on exit from
-;;;     the menu.
-
-(if (not (string-match "XEmacs" (emacs-version)))
-    (error "recent-files works with Lucid Emacs / XEmacs only."))
-
-(provide 'recent-files)
-
-
-;;; User options
-
-(defgroup recent-files nil
-  "Maintain a menu of recently opened files."
-  :group 'files
-  :group 'menu)
-
-(defgroup recent-files-menu nil
-  "Menu options of recent-files."
-  :prefix "recent-files-"
-  :group 'recent-files)
-
-
-(defcustom recent-files-number-of-entries 15
-  "*Maximum of non-permanent entries in the recent-files menu."
-  :type 'integer
-  :group 'recent-files)
-
-(defcustom recent-files-number-of-saved-entries 50
-  "*Maximum of non-permanent entries saved to `recent-files-save-file'."
-  :type 'integer
-  :group 'recent-files)
-
-(defcustom recent-files-save-file (expand-file-name "~/.recent-files.el")
-  "*File to save the recent-files list in."
-  :type 'file
-  :group 'recent-files)
-
-(defcustom recent-files-dont-include nil
-  "*List of regexps for filenames *not* to keep in recent-files."
-  :type '(repeat regexp)
-  :group 'recent-files)
-
-(defcustom recent-files-use-full-names t
-  "*If non-nil, use the full pathname of a file in the recent-files menu.
-Otherwise use only the filename part. The `recent-files-filename-replacements'
-are not applied in the latter case."
-  :type 'boolean
-  :group 'recent-files)
-
-(defcustom recent-files-filename-replacements
-  (list (cons (regexp-quote (expand-file-name "~")) "~"))
-  "*List of regexp/replacement pairs for filename filenames.
-If a filename of a filename matches one of the regexps, it is replaced
-by the corresponding replacement."
-  :type '(repeat (cons regexp (string :tag "Replacement")))
-  :group 'recent-files)
-
-(defcustom recent-files-sort-function (function recent-files-dont-sort)
-  "*Function to sort the recent-files list with.
-The value `recent-files-dont-sort' means to keep the \"most recent on top\"
-order."
-  :type 'function
-  :group 'recent-files)
-
-(defcustom recent-files-permanent-submenu nil
-  "*If non-nil, put the permanent entries of recent-files into a submenu."
-  :type 'boolean
-  :group 'recent-files-menu)
-
-(defcustom recent-files-non-permanent-submenu nil
-  "*If non-nil, put the non-permanent entries of recent-files into a submenu."
-  :type 'boolean
-  :group 'recent-files-menu)
-
-(defcustom recent-files-commands-submenu nil
-  "*If non-nil, put the commands of recent-files into a submenu."
-  :type 'boolean
-  :group 'recent-files-menu)
-
-(defcustom recent-files-commands-submenu-title "Commands..."
-  "*Title of the commands submenu of recent-files."
-  :type 'string
-  :group 'recent-files-menu)
-
-(defcustom recent-files-menu-title "Recent Files"
-  "*Name to be displayed as title of the recent-files menu."
-  :type 'string
-  :group 'recent-files-menu)
-
-(defcustom recent-files-menu-path nil
-  "*Path where to add the recent-files menu.
-A value of nil means add it as top-level menu.
-For more information look up the documentation of `add-menu'."
-  :type '(choice (const :tag "Top Level" nil)
-		 (sexp :tag "Menu Path"))
-  :group 'recent-files-menu)
-
-(defcustom recent-files-add-menu-before nil
-  "*Name of the menu before which the recent-files menu shall be added.
-A value of nil means add it as the last menu in recent-files-menu-path.
-For more information look up the documentation of `add-menu'."
-  :type '(choice (string :tag "Name")
-		 (const :tag "Last" nil))
-  :group 'recent-files-menu)
-
-(defcustom recent-files-actions-on-top nil
-  "*If non-nil, put the actions on top of the recent-files menu."
-  :type 'boolean
-  :group 'recent-files-menu)
-
-(defcustom recent-files-permanent-first 'sort
-  "*Control the placement of entries in the recent-files menu.
-If the value is t, permanent entries are put first.
-If the value is nil, non-permanent entries are put first.
-If the value is neither, the entries are mixed following
-recent-files-sort-function if neither appear in a submenu."
-  :type '(choice (const :tag "Permanent First" t)
-		 (const :tag "Non-Permanent First" nil)
-		 (sexp :tag "Mixed"))
-  :group 'recent-files-menu)
-
-(defcustom recent-files-find-file-command (function find-file)
-  "*Command to invoke with an entry of the recent-files list."
-  :type 'function
-  :group 'recent-files)
-
-(defcustom recent-files-include-save-now nil
-  "*If non-nil, have a menu entry to save the recent-files list immediately."
-  :type 'boolean
-  :group 'recent-files-menu)
-
-;;; Internal variables
-
-(defconst recent-files-save-list-on-exit t
-  "If non-nil, save the recent-files list on exit.
-This value is toggled by a menu entry.")
-
-(defvar recent-files-list nil
-  "List of recently opened files.
-Entries are pairs like ( . ).
-If  is non-nil, the file stays permanently in the list.")
-
-(defvar recent-files-commands-menu
-  '(list (vector (concat "Make " lastpart " permanent")
-		 (function recent-files-make-permanent)
-		 (and lastpart
-		      (not (recent-files-permanent-p filename))
-		      ;; (not (not ...)) is needed to enforce t for non-nil
-		      (not (not (recent-files-retrieve-entry filename)))))
-	 (vector (concat "Make " lastpart " non-permanent")
-		 (function recent-files-make-non-permanent)
-		 (and lastpart
-		      (recent-files-permanent-p filename)
-		      (not (not (recent-files-retrieve-entry filename)))))
-	 (vector "Erase non-permanent entries"
-		 (function recent-files-erase-non-permanent)
-		 t)
-	 (vector (if recent-files-save-list-on-exit
-		     "Don't save recent-files list on exit"
-		   "Save recent-files list on exit")
-		 ;; for some weird reason a (function (lambda ...))
-		 ;; doesn't work here
-		 (function recent-files-toggle-save-list-on-exit)
-		 t)
-	 (vector "Save recent-files list now"
-		 (function recent-files-save-the-list)
-		 t)
-	 (vector (concat "Kill buffer " lastpart
-			 " and delete entry")
-		 (function recent-files-kill-buffer-delete-entry)
-		 lastpart))
-  "Command menu definition for recent-files.
-This definition is evaluated in a context where `filename' holds the file
-name of the current buffer and `lastpart' holds the last component of
-`filename'.")
-
-(defvar recent-files-menu-omit-chars-list '(?n ?m ?e ?d ?s ?k))
-
-
-(defconst recent-files-save-file-header
-  ";; This file is generated by recent-files.
-;; The car of each entry of recent-files-save-list is to appear in the
-;; `recent-files' menu. If the cdr of an entry is t, the file is to stay
-;; in the menu permanently.
-;; Saved at %s.
-
-" "Header to be written into the `recent-files-save-file'.")
-
-
-(defconst recent-files-buffer-name " *recent files save list*"
-  "Name of the buffer to build the save file in.")
-
-(defvar recent-files-list-changed-p t
-  "Non-nil if the recent-files-list has changed after last menubar update.")
-
-(defvar recent-files-last-buffer nil
-  "Buffer at the time of last recent-files menu rebuild.
-If the buffer has changed, the menu must be rebuilt.")
-
-;;; Module initialization
-
-;;;###autoload
-(defun recent-files-initialize ()
-  "Initialize the recent-files menu."
-  (interactive)
-  (add-hook 'find-file-hooks (function recent-files-find-and-write-file-hook))
-  (add-hook 'dired-after-readin-hook
-	    (function recent-files-find-and-write-file-hook))
-  (add-hook 'kill-emacs-hook (function recent-files-save-the-list))
-  (add-hook 'activate-menubar-hook (function recent-files-update-menu))
-  (add-hook 'write-file-hooks (function recent-files-find-and-write-file-hook))
-  ;; Initialize recent-files-list only if it is non-nil.
-  (cond (recent-files-list
-	 (message "recent-files is already initialized."))
-	((file-readable-p recent-files-save-file)
-	 (setq recent-files-list-changed-p t)
-	 (load-file recent-files-save-file)))
-  (recent-files-update-menu))
-
-
-(defun recent-files-version ()
-  "Return a string identifying the current version of recent-files.
-If called interactively, show it in the echo area."
-  (interactive)
-  (let ((version "$Header: /pack/xemacscvs/XEmacs/packages/xemacs-packages/edit-utils/recent-files.el,v 1.9 2004/11/08 02:38:42 ben Exp $"))
-    (if (interactive-p)
-	(message version)
-      version)))
-      
-
-;;; Hook functions
-
-(defun recent-files-find-and-write-file-hook ()
-  "Find-file-hook, write-file-hook, and dired-mode-hook for recent-files.
-Inserts the name of the file just opened or written into the
-`recent-files-list' and updates the recent-files menu."
-  (recent-files-add-file (recent-files-get-file-name))
-  nil)
-
-
-(defun recent-files-get-file-name ()
-  "Return the filename of the current buffer or nil, if there is none.
-This functions is supposed to do \"the right thing\" also for some modes
-with no buffer-file-name. Currently supported: 'dired-mode."
-  (cond (buffer-file-name
-	 buffer-file-name)
-	((eq major-mode 'dired-mode)
-	 (dired-current-directory))))
-
-
-(defun recent-files-save-the-list ()
-  "Save the current `recent-files-list' to the file `recent-files-save-file'.
-This is done by writing a `setq' statement to `recent-files-list' into
-the file."
-  (interactive)
-  (if recent-files-save-list-on-exit
-      (let ((l (recent-files-enforce-max-length
-		recent-files-number-of-saved-entries
-		recent-files-list)))
-	(save-excursion
-	  (set-buffer (get-buffer-create recent-files-buffer-name))
-	  (erase-buffer)
-	  (insert (format recent-files-save-file-header (current-time-string)))
-	  (insert "(setq recent-files-list \n      '(")
-	  (if l
-	      (progn
-		(while l
-		  (if (bolp)
-		      (insert "        "))
-		  (prin1 (car l) (current-buffer))
-		  (insert "\n")
-		  (setq l (cdr l)))
-		(forward-line -1)))
-	  (end-of-line)
-	  (insert "))")
-	  (if (file-writable-p recent-files-save-file)
-	      (write-region (point-min) (point-max) recent-files-save-file))
-	  (kill-buffer (current-buffer))))))
-
-
-;;; Construct the menu
-
-(defun recent-files-maybe-generate-accelerator-spec (list)
-  "Add auto-generated accelerators, if such capability exists.
-This is a basic wrapper around `submenu-generate-accelerator-spec'; if it
-exists, we just call it; otherwise, we do nothing."
-  (if (fboundp 'submenu-generate-accelerator-spec)
-      (submenu-generate-accelerator-spec list
-					 recent-files-menu-omit-chars-list)
-    list))
-
-(defun recent-files-update-menu ()
-  "Update the recent-files menu from the recent-files-list."
-  (if (or recent-files-list-changed-p
-	  (not recent-files-last-buffer)
-	  (not (eq recent-files-last-buffer
-		   (current-buffer))))
-      ;; This is an ugly mess...
-      (let ((action-menu-entries
-	     (let ((entries
-		    (let* ((filename (recent-files-get-file-name))
-			   (lastpart (recent-files-last-part-of-name
-				      filename)))
-		      (eval recent-files-commands-menu))))
-	       (if recent-files-commands-submenu
-		   (list (cons recent-files-commands-submenu-title
-			       entries))
-		 entries)))	       
-	    permanent non-permanent all)
-	;; ... getting weirder by the minute ...
-	(if (or recent-files-permanent-submenu
-		recent-files-non-permanent-submenu
-		(null recent-files-permanent-first)
-		(eq t recent-files-permanent-first))
-	    (progn 
-	      (setq permanent (recent-files-maybe-generate-accelerator-spec
-			       (recent-files-make-file-menu-entries
-				recent-files-list
-				(function recent-files-filter-permanent))))
-	      (setq non-permanent (recent-files-maybe-generate-accelerator-spec
-				   (recent-files-make-file-menu-entries
-				    recent-files-list
-				    (function
-				     recent-files-filter-non-permanent)))))
-	  (setq all (recent-files-maybe-generate-accelerator-spec
-		     (recent-files-make-file-menu-entries
-		      recent-files-list
-		      (function (lambda (l) l))))))
-	(if recent-files-permanent-submenu
-	    (setq permanent
-		  (list (cons "Permanent entries..."
-			      permanent))))
-	(if recent-files-non-permanent-submenu
-	    (setq non-permanent
-		  (list (cons "Non-permanent entries..."
-			      non-permanent))))
-    ;;; ... and now even uglier.
-	(let ((menu (nconc
-		     (if recent-files-actions-on-top
-			 (append action-menu-entries (list "-----")))
-		     (if (or recent-files-permanent-submenu
-			     recent-files-non-permanent-submenu)
-			 (if recent-files-permanent-first
-			     (nconc permanent non-permanent)
-			   (nconc non-permanent permanent))
-		       ;; in this case, neither permanent nor non-permanent
-		       ;; files are in submenus.  we need to decide whether
-		       ;; to separate them or combine them, and in the
-		       ;; former case, which one goes first.  also, we
-		       ;; regenerate the accelerator specs to be continuous
-		       ;; across all of them. (it's easier to do it this
-		       ;; way than try to carefully avoid generating them
-		       ;; twice, and totally safe, since the
-		       ;; spec-generating code knows how to remove existing
-		       ;; auto-generated specs before adding new ones.)
-		       (cond ((eq t recent-files-permanent-first)
-			      (recent-files-maybe-generate-accelerator-spec
-			       (nconc permanent non-permanent)))
-			     ((null recent-files-permanent-first)
-			      (recent-files-maybe-generate-accelerator-spec
-			       (nconc non-permanent permanent)))
-			     (t all)))
-		     (if (not recent-files-actions-on-top)
-			 (cons "-----"
-			       action-menu-entries)))))
-	  (add-menu recent-files-menu-path recent-files-menu-title
-		    menu recent-files-add-menu-before))
-	(setq recent-files-list-changed-p nil)
-	(setq recent-files-last-buffer (current-buffer))))
-  nil)
-
-
-(defun recent-files-retrieve-entry (filename)
-  "Retrieve an entry from the recent-files list."
-  (assoc filename recent-files-list))
-
-
-(defun recent-files-make-file-menu-entries (recent-list filter)
-  "Make file menu entries for recent-files from RECENT-LIST using FILTER."
-  (mapcar (function recent-files-entry-to-menu-entry)
-	  (funcall filter
-		   (funcall recent-files-sort-function
-				  (recent-files-enforce-max-length
-				   recent-files-number-of-entries
-				   recent-list)))))
-
-
-(defun recent-files-last-part-of-name (filename)
-  "Return last part of FILENAME."
-  (if filename
-      (if (and (file-directory-p filename)
-	       (equal (substring filename -1) "/"))
-	  (concat (file-name-nondirectory
-		   (substring filename 0 -1))
-		  "/")
-	(file-name-nondirectory filename))))
-
-
-(defun recent-files-filter-permanent (recent-list)
-  "Return list of permanent entries in RECENT-LIST."
-  (cond ((null recent-list) nil)
-	((recent-files-permanent-p (car (car recent-list)))
-	 (cons (car recent-list)
-	       (recent-files-filter-permanent (cdr recent-list))))
-	(t (recent-files-filter-permanent (cdr recent-list)))))
-
-
-(defun recent-files-filter-non-permanent (recent-list)
-  "Return list of non-permanent entries in RECENT-LIST."
-  (cond ((null recent-list) nil)
-	((recent-files-permanent-p (car (car recent-list)))
-	 (recent-files-filter-non-permanent (cdr recent-list)))
-	(t (cons (car recent-list)
-		 (recent-files-filter-non-permanent (cdr recent-list))))))
-
-
-(defun recent-files-permanent-p (filename)
-  "Return non-nil if FILENAME is a permanent entry in the recent-files menu."
-  (cdr (recent-files-retrieve-entry filename)))
-
-
-(defun recent-files-entry-to-menu-entry (entry)
-  "Build a menu entry from an entry in `recent-files-list'."
-  (let ((prepend (if (cdr entry)
-                     (if recent-files-permanent-submenu "" "* ")
-		   (if recent-files-non-permanent-submenu "" "  "))))
-    (vector (concat prepend
-                    (if recent-files-use-full-names
-                        (recent-files-replace-filenames (car entry))
-		      (recent-files-last-part-of-name (car entry))))
-            (list recent-files-find-file-command (car entry))
-            t)))
-
-
-(defun recent-files-replace-filenames (filename)
-  "Replace the part of FILENAME that matches a regular expression
-in recent-files-filename-replacements with the corresponding replacement.
-If FILENAME does not match any regular expression, return it unchanged.
-Only the first matching regexp/replacement pair is applied."
-  (let ((replist recent-files-filename-replacements)
-	(retval filename)
-	(matched nil))
-    (while (and replist
-		(not matched))
-      (if (string-match (car (car replist)) filename)
-	  (progn
-	    (setq matched t)
-	    (setq retval (concat (substring filename 0 (match-beginning 0))
-				 (cdr (car replist))
-				 (substring filename (match-end 0))))))
-      (setq replist (cdr replist)))
-    retval))
-
-
-;;; add a new entry
-
-(defun recent-files-add-file (filename)
-  "Add file FILENAME to `recent-files-list'.
-FILENAME is not really added if it matches one of the regexps in
-`recent-files-dont-include'."
-  (if (and filename (recent-files-no-match filename recent-files-dont-include))
-      (progn
-	(setq recent-files-list-changed-p t)
-	(setq recent-files-list
-	      (cons (or (recent-files-retrieve-entry filename)
-			(cons filename nil))
-		    (recent-files-remove-entry filename
-					       recent-files-list))))))
-
-
-(defun recent-files-dont-sort (recent-list)
-  "Return RECENT-LIST.
-This is a dummy sorting function for the recent-files-list."
-  recent-list)
-
-(defun recent-files-sort-alphabetically (recent-list)
-  "Return RECENT-LIST sorted alphabetically by the cars of the elements."
-  (sort recent-list (function
-		     (lambda (e1 e2)
-		       (string-lessp (car e1) (car e2))))))
-
-
-(defun recent-files-enforce-max-length (n l)
-  "Return a list of all permanent and the first N non-permanent entries of L.
-Preserve the order of the entries."
-  (let ((count 0)
-	(newlist nil))
-    (while l
-      (if (cdr (car l))
-	  (setq newlist (cons (car l) newlist))
-	(if (< count n)
-	    (setq newlist (cons (car l) newlist)))
-	(setq count (1+ count)))
-      (setq l (cdr l)))
-    (nreverse newlist)))
-
-
-(defun recent-files-remove-entry (fname recent-list)
-  "Delete all elements that have FNAME as a car from RECENT-LIST.
-The constructed list returned, RECENT-LIST is not changed.
-Comparison is done with equal."
-  (let ((newlist nil))
-    (while recent-list
-      (if (not (equal (car (car recent-list)) fname))
-	  (setq newlist (cons (car recent-list) newlist)))
-      (setq recent-list (cdr recent-list)))
-    (nreverse newlist)))
-
-(defun recent-files-no-match (string re-list)
-  "Return t if STRING matches none of the regexps in RE-LIST."
-  (while (and re-list
-	      (not (string-match (car re-list) string)))
-    (setq re-list (cdr re-list)))
-  (null re-list))
-
-
-;;; Menu commands
-
-(defun recent-files-make-permanent ()
-  "Make the file in current buffer a permanent entry in recent-files."
-  (interactive)
-  (rplacd (recent-files-retrieve-entry (recent-files-get-file-name)) t)
-  (setq recent-files-list-changed-p t))
-
-
-(defun recent-files-make-non-permanent ()
-  "Make the file in current buffer a non-permanent entry in recent-files."
-  (interactive)
-  (rplacd (recent-files-retrieve-entry (recent-files-get-file-name)) nil)
-  (setq recent-files-list-changed-p t))
-
-
-(defun recent-files-kill-buffer-delete-entry ()
-  "Kill the current buffer and delete its entry in the recent-files menu."
-  (interactive)
-  (setq recent-files-list
-	(recent-files-remove-entry (recent-files-get-file-name)
-				   recent-files-list))
-  (setq recent-files-list-changed-p t)
-  (kill-buffer (current-buffer)))
-
-(defun recent-files-erase-non-permanent ()
-  "Erase all non-permanent entries from the recent-files menu."
-  (interactive)
-  (setq recent-files-list
-	(recent-files-filter-permanent recent-files-list))
-  (setq recent-files-list-changed-p t))
-
-(defun recent-files-toggle-save-list-on-exit ()
-  "Toggle the value of `recent-files-save-list-on-exit'."
-  (interactive)
-  (setq recent-files-save-list-on-exit (not recent-files-save-list-on-exit))
-  (setq recent-files-list-changed-p t))
-
-;; User commands
-;;;###autoload
-(defun recent-files-visit-file (filename &optional codesys)
-  "Visit a recent file.
-Visit a file FILENAME that was visited recently.  Optional second argument
-specifies the coding system to use when decoding the file.  Interactively,
-with a prefix argument, you will be prompted for the coding system."
-  (interactive (list (progn
-                       (unless recent-files-list
-                         (recent-files-initialize))
-                       (completing-read "Recent file: " recent-files-list))
-                     (if current-prefix-arg
-                         (read-coding-system "Coding system: ")
-                       nil)))
-  (find-file filename codesys))
-;;; EOF
diff --git a/xemacs-packages/lisp/edit-utils/redo.el b/xemacs-packages/lisp/edit-utils/redo.el
deleted file mode 100644
index a0229d7a..00000000
--- a/xemacs-packages/lisp/edit-utils/redo.el
+++ /dev/null
@@ -1,203 +0,0 @@
-;;; redo.el -- Redo/undo system for XEmacs
-
-;; Copyright (C) 1985, 1986, 1987, 1993-1995 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-;; Copyright (C) 1997 Kyle E. Jones
-
-;; Author: Kyle E. Jones, February 1997
-;; Keywords: lisp, extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; Derived partly from lisp/prim/simple.el in XEmacs.
-
-;; Emacs' normal undo system allows you to undo an arbitrary
-;; number of buffer changes.  These undos are recorded as ordinary
-;; buffer changes themselves.  So when you break the chain of
-;; undos by issuing some other command, you can then undo all
-;; the undos.  The chain of recorded buffer modifications
-;; therefore grows without bound, truncated only at garbage
-;; collection time.
-;;
-;; The redo/undo system is different in two ways:
-;;   1. The undo/redo command chain is only broken by a buffer
-;;      modification.  You can move around the buffer or switch
-;;      buffers and still come back and do more undos or redos.
-;;   2. The `redo' command rescinds the most recent undo without
-;;      recording the change as a _new_ buffer change.  It
-;;      completely reverses the effect of the undo, which
-;;      includes making the chain of buffer modification records
-;;      shorter by one, to counteract the effect of the undo
-;;      command making the record list longer by one.
-;;
-;; Installation:
-;;
-;; Save this file as redo.el, byte compile it and put the
-;; resulting redo.elc file in a directory that is listed in
-;; load-path.
-;;
-;; In your .emacs file, add
-;;   (require 'redo)
-;; and the system will be enabled.
-
-;;; Code:
-
-(provide 'redo)
-
-(defvar redo-version "1.02"
-  "Version number for the Redo package.")
-
-(defvar last-buffer-undo-list nil
-  "The head of buffer-undo-list at the last time an undo or redo was done.")
-(make-variable-buffer-local 'last-buffer-undo-list)
-
-(make-variable-buffer-local 'pending-undo-list)
-
-;; Emacs 20 variable
-(defvar undo-in-progress)
-
-(defun redo (&optional count)
-  "Redo the the most recent undo.
-Prefix arg COUNT means redo the COUNT most recent undos.
-If you have modified the buffer since the last redo or undo,
-then you cannot redo any undos before then."
-  (interactive "*p")
-  (if (eq buffer-undo-list t)
-      (error "No undo information in this buffer"))
-  (if (eq last-buffer-undo-list nil)
-      (error "No undos to redo"))
-  (or (eq last-buffer-undo-list buffer-undo-list)
-      ;; skip one undo boundary and all point setting commands up
-      ;; until the next undo boundary and try again.
-      (let ((p buffer-undo-list))
-	(and (null (car-safe p)) (setq p (cdr-safe p)))
-	(while (and p (integerp (car-safe p)))
-	  (setq p (cdr-safe p)))
-	(eq last-buffer-undo-list p))
-      (error "Buffer modified since last undo/redo, cannot redo"))
-  (and (or (eq buffer-undo-list pending-undo-list)
-	   (eq (cdr buffer-undo-list) pending-undo-list))
-       (error "No further undos to redo in this buffer"))
-  (or (eq (selected-window) (minibuffer-window))
-      (message "Redo..."))
-  (let ((modified (buffer-modified-p))
-	(undo-in-progress t)
-	(recent-save (recent-auto-save-p))
-	(old-undo-list buffer-undo-list)
-	(p (cdr buffer-undo-list))
-	(records-between 0))
-    ;; count the number of undo records between the head of the
-    ;; undo chain and the pointer to the next change.  Note that
-    ;; by `record' we mean clumps of change records, not the
-    ;; boundary records.  The number of records will always be a
-    ;; multiple of 2, because an undo moves the pending pointer
-    ;; forward one record and prepend a record to the head of the
-    ;; chain.  Thus the separation always increases by two.  When
-    ;; we decrease it we will decrease it by a multiple of 2
-    ;; also.
-    (while p
-      (cond ((eq p pending-undo-list)
-	     (setq p nil))
-	    ((null (car p))
-	     (setq records-between (1+ records-between))
-	     (setq p (cdr p)))
-	    (t
-	     (setq p (cdr p)))))
-    ;; we're off by one if pending pointer is nil, because there
-    ;; was no boundary record in front of it to count.
-    (and (null pending-undo-list)
-	 (setq records-between (1+ records-between)))
-    ;; don't allow the user to redo more undos than exist.
-    ;; only half the records between the list head and the pending
-    ;; pointer are undos that are a part of this command chain.
-    (setq count (min (/ records-between 2) count)
-	  p (primitive-undo (1+ count) buffer-undo-list))
-    (if (eq p old-undo-list)
-	nil ;; nothing happened
-      ;; set buffer-undo-list to the new undo list.  if has been
-      ;; shortened by `count' records.
-      (setq buffer-undo-list p)
-      ;; primitive-undo returns a list without a leading undo
-      ;; boundary.  add one.
-      (undo-boundary)
-      ;; now move the pending pointer backward in the undo list
-      ;; to reflect the redo.  sure would be nice if this list
-      ;; were doubly linked, but no... so we have to run down the
-      ;; list from the head and stop at the right place.
-      (let ((n (- records-between count)))
-	(setq p (cdr old-undo-list))
-	(while (and p (> n 0))
-	  (if (null (car p))
-	      (setq n (1- n)))
-	  (setq p (cdr p)))
-	(setq pending-undo-list p)))
-    (and modified (not (buffer-modified-p))
-	 (delete-auto-save-file-if-necessary recent-save))
-    (or (eq (selected-window) (minibuffer-window))
-	(message "Redo!"))
-    (setq last-buffer-undo-list buffer-undo-list)))
-
-(defun undo (&optional arg)
-  "Undo some previous changes.
-Repeat this command to undo more changes.
-A numeric argument serves as a repeat count."
-  (interactive "*p")
-  (let ((modified (buffer-modified-p))
-	(recent-save (recent-auto-save-p)))
-    (or (eq (selected-window) (minibuffer-window))
-	(message "Undo..."))
-    (or (eq last-buffer-undo-list buffer-undo-list)
-	;; skip one undo boundary and all point setting commands up
-	;; until the next undo boundary and try again.
-	(let ((p buffer-undo-list))
-	  (and (null (car-safe p)) (setq p (cdr-safe p)))
-	  (while (and p (integerp (car-safe p)))
-	    (setq p (cdr-safe p)))
-	  (eq last-buffer-undo-list p))
-	(progn (undo-start)
-	       (undo-more 1)))
-    (undo-more (or arg 1))
-    ;; Don't specify a position in the undo record for the undo command.
-    ;; Instead, undoing this should move point to where the change is.
-    ;;
-    ;;;; The old code for this was mad!  It deleted all set-point
-    ;;;; references to the position from the whole undo list,
-    ;;;; instead of just the cells from the beginning to the next
-    ;;;; undo boundary.  This does what I think the other code
-    ;;;; meant to do.
-    (let ((list buffer-undo-list)
-    	  (prev nil))
-      (while (and list (not (null (car list))))
-    	(if (integerp (car list))
-    	    (if prev
-    		(setcdr prev (cdr list))
-    	      ;; impossible now, but maybe not in the future 
-    	      (setq buffer-undo-list (cdr list))))
-    	(setq prev list
-    	      list (cdr list))))
-    (and modified (not (buffer-modified-p))
-	 (delete-auto-save-file-if-necessary recent-save)))
-  (or (eq (selected-window) (minibuffer-window))
-      (message "Undo!"))
-  (setq last-buffer-undo-list buffer-undo-list))
-
-;;; redo.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/reportmail.el b/xemacs-packages/lisp/edit-utils/reportmail.el
deleted file mode 100644
index cc029bfa..00000000
--- a/xemacs-packages/lisp/edit-utils/reportmail.el
+++ /dev/null
@@ -1,997 +0,0 @@
-;; REPORTMAIL: Display time and load in mode line of Emacs.
-;; Originally time.el in the emacs distribution.
-;; Mods by BCP, DCP, and JWZ to display incoming mail.
-;;
-;; Mods by Bob Weiner to eliminate repeated beeps on startup, to eliminate
-;;   redundancy in subject display and to move mail indicator display to
-;;   follow the time string.
-;;
-;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY.  No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing.  Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License.   A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities.  It should be in a
-;; file named COPYING.  Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;
-; Installation
-; ------------
-;
-; To use reportmail, add the following to your .emacs file:
-;
-;    (load-library "reportmail")
-;
-;    ;; Edit this list as appropriate
-;    (setq display-time-my-addresses
-;     '("Benjamin.Pierce" "bcp" "Benjamin Pierce" "Benjamin C. Pierce"))
-; 
-;    ;; By default, mail arrival is reported with a message but no beep
-;    (setq display-time-mail-ring-bell t)
-; 
-;    (display-time)
-; 
-; When new mail arrives, a brief blurb about it will be displayed in the
-; mode line, and a more verbose message will be printed in the echo area.
-; But unlike most echo-area messages, this message will not go away at
-; the next keystroke - it doesn't go away until the next extended-command
-; is used.  This is cool because that means you won't miss seeing the 
-; subject of the newly-arrived mail because you happened to be typing when
-; it arrived.
-;
-; But if you set the variable `display-time-flush-echo-area' to t, then this
-; message will be cleared every `display-time-interval' seconds.  This means
-; the message will be around for at most 30 seconds or so, which you may
-; prefer.
-;
-; Site Configuration
-; ------------------
-;
-; The variables display-time-incoming-mail-file and 
-; display-time-message-separator identify the location and format of 
-; your waiting messages.  If you are in the CMU SCS environment, or
-; are on a generic BSD unix system, this code should work right away.
-; Otherwise, you might need to modify the values of these to make things
-; work.
-;
-; Junk Mail
-; ---------
-;
-; The reportmail package has a notion of "junk mail," which can be used to
-; reduce the frequency of irritating interruptions by reporting only the
-; arrival of messages that seem to be interesting.  If you're on a lot
-; of high-volume mailing lists, this can be quite convenient.  To use
-; this facility, add something like the following to your .emacs file:
-; 
-;   ;; The value of this variable is a list of lists, where the first
-;   ;; element in each list is the name of a header field and the
-;   ;; remaining elements are various elements of the value of this
-;   ;; header field that signal the junkiness of a message.  
-;   (setq display-time-junk-mail-checklist
-;     '(("From" "bcp" "Benjamin Pierce" "Benjamin.Pierce"
-;               "Mail Delivery Subsystem" "network" "daemon@bartok")
-;       ("To" "sml-request" "sml-redistribution-request" 
-;        "scheme" "TeXhax-Distribution-list")
-;       ("Resent-From" "Benjamin.Pierce")
-;       ("Sender" "WRITERS" "Haskell" "Electronic Music Digest" "NEW-LIST")))
-;   
-; By default, the entries in this list are matched exactly as 
-; substrings of the given header fields.  If an entry begins with 
-; the character ^ it will be matched as a regular expression.  If the 
-; variable display-time-match-using-regexps is set, then all entries
-; will be matched as regular expressions.
-;
-; Note that elements of display-time-my-addresses are NOT automatically
-; included in display-time-junk-mail-checklist.  If you want mail from
-; yourself to be considered junkmail, you must add your addresses to 
-; display-time-junk-mail-checklist too.
-;
-;
-; Xbiff Interface
-; ---------------
-;
-; If you normally keep your emacs window iconified, reportmail can 
-; maintain an xbiff or xbiff++ display as well.  The xbiff window will only
-; be highlighted when non-junk mail is waiting to be read.  For example:
-;
-;    (if window-system-version
-;        (setq display-time-use-xbiff t))
-;    (setq display-time-xbiff-arg-list '("-update" "30" "-geometry" "+0+0"))
-;    (setq display-time-xbiff-program "xbiff++")
-;
-; Other
-; -----
-;
-; There are several other user-customization variables that you may wish
-; to modify.  These are documented below.
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;
-; HISTORY
-;
-; 19 dec 93	Jamie Zawinski 
-;	Protected it from edits of the *reportmail* buffer; made the process
-;	filters not interfere with the match data.
-;
-; 15 dec 93	Jamie Zawinski 
-;	Kyle renamed timer.el to itimer.el; made this use the new names.
-;
-; 27 aug 93	Jamie Zawinski 
-;	Use mail-extr to parse addresses if it is loadable.
-;
-; 15 oct 92	Benjamin Pierce (bcp@cs.cmu.edu)
-;	Merged recent changes
-;
-; 14 oct 92	Jamie Zawinski 
-;	Added support for xbiff++.
-;
-; 17 sep 92	Benjamin Pierce (bcp@cs.cmu.edu)
-;	Improvements to message display code.
-;
-; 15 sep 92	Benjamin Pierce (bcp@cs.cmu.edu)
-;	Minor bug fixes.
-;
-; 1 may 92	Jamie Zawinski 
-;	Converted to work with Kyle Jones' timer.el package.
-;
-; 3 may 91	Jamie Zawinski 
-;	Made the display-time-sentinel make a fuss when the process dies.
-;
-; 26 mar 91	Jamie Zawinski 
-;	Merged with BCP's latest posted version
-;
-;  5 mar 91	Jamie Zawinski 
-;	Added compatibility with Emacs 18.57.
-;
-; 25 Jan 91	Benjamin Pierce (bcp@cs.cmu.edu)
-;	Added facility for regular-expression matching of junk-mail
-;	checklist.  Set inhibit-local-variables to t inside of 
-;	display-time-process-new-mail to prevent letterbombs 
-;	(suggested by jwz).
-;
-; 15 feb 91	Jamie Zawinski 
-;	Made the values of display-time-message-separator and 
-;	display-time-incoming-mail-file be initialized when this code
-;	starts, instead of forcing the user to do it.  This means that
-;	this code can safely be dumped with emacs.  Also, it now notices
-;	when it's at CMU, and defaults to something reasonable.  Removed
-;	display-time-wait-hard, because I learned how to make echo-area
-;	messages be persistent (not go away at the first key).  I wish
-;	GC messages didn't destroy it, though...
-;
-; 20 Dec 90	Jamie Zawinski 
-;	Added new variables: display-time-no-file-means-no-mail, 
-;	display-time-wait-hard, and display-time-junk-mail-ring-bell.
-;	Made display-time-message-separator be compared case-insensitively.
-;	Made the junk-mail checklist use a member-search rather than a 
-;	prefix-search.
-;
-; 22 Jul 90	Benjamin Pierce (bcp@cs.cmu.edu)
-;	Added support for debugging.
-;
-; 19 Jul 90	Benjamin Pierce (bcp@cs.cmu.edu)
-;	Improved user documentation and eliminated known CMU dependencies.
-;
-; 13 Jul 90	Mark Leone (mleone@cs.cmu.edu)
-;	Added display-time-use-xbiff option.  Various layout changes.
-;
-; 20 May 90	Benjamin Pierce (bcp@proof)
-;	Fixed a bug that occasionally caused fields to be extracted
-;	from the wrong buffer.
-;
-; 14 May 90	Benjamin Pierce (bcp@proof)
-;	Added concept of junk mail and ability to display message
-;	recipient in addition to sender and subject.  (Major internal
-;	reorganization was needed to implement this cleanly.)
-;
-; 18 Nov 89	Benjamin Pierce (bcp@proof)
-;	Fixed to work when display-time is called with 
-;	global-mode-string not a list
-;
-; 15 Jan 89	David Plaut (dcp@k)
-;	Added ability to discard load from displayed string
-;
-;	To use: (setq display-time-load nil)
-;
-;	Added facility for reporting incoming mail (modeled after gosmacs
-;	reportmail.ml package written by Benjamin Pierce).
-
-
-(if (string-match "XEmacs" emacs-version)
-    (require 'itimer))
-
-(condition-case ()
-    (require 'mail-extr)
-  (error nil))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;                       User Variables                          ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar display-time-announce-mail t
-  "*Toggles whether name of mail sender is displayed in mode line.")
-
-(defvar display-time-announce-junk-mail-too nil
-  "*When non-NIL, announce incoming junk mail as well as interesting mail")
-
-(defvar display-time-time t
-  "*Toggles whether the time is displayed.")
-
-(defvar display-time-load nil
-  "*Toggles whether machine load is displayed.")
-
-(defvar display-time-day-and-date nil
-  "*Toggles whether day and date are displayed.")
-
-(defvar display-time-mail-ring-bell nil
-  "*Toggles whether bell is rung on mail arrival.")
-
-(defvar display-time-junk-mail-ring-bell nil
-  "*Toggles whether bell is rung on junk mail arrival.
-If display-time-mail-ring-bell is nil, this variable is ignored.")
-
-(defvar display-time-my-addresses nil
-  "*Report the addressee of incoming mail in the message announcement, 
-unless it appears in this list  (See also display-time-match-using-regexps.)")
-;; For example:
-;; (setq display-time-my-addresses
-;;  '("Benjamin.Pierce" "bcp" "Benjamin Pierce" "Benjamin C. Pierce"))
-
-(defvar display-time-junk-mail-checklist nil
-  "*A list of lists of strings.  In each sublist, the first component is the
-name of a message field and the rest are values that flag a piece of
-junk mail.  If an entry begins with the character ^ it is matched as
-a regular expression rather than an exact prefix of the given header 
-field.  (See also display-time-match-using-regexps.)  
-
-Note: elements of display-time-my-addresses are NOT automatically
-      included in display-time-junk-mail-checklist")
-;; For example:
-;; (setq display-time-junk-mail-checklist
-;;  '(("From" "bcp" "Benjamin Pierce" "Benjamin.Pierce"
-;;            "Mail Delivery Subsystem" "network" "daemon@bartok")
-;;    ("To" "sml-request" "sml-redistribution-request" "computermusic" 
-;;     "scheme" "TeXhax-Distribution-list")
-;;    ("Resent-From" "Benjamin.Pierce")
-;;    ("Sender" "WRITERS" "Haskell" "Electronic Music Digest" "NEW-LIST")))
-
-(defvar display-time-match-using-regexps nil "*When non-nil, elements of 
-display-time-junk-mail-checklist and display-time-my-addresses are matched
-as regular expressions instead of literal prefixes of header fields.")
-
-(defvar display-time-max-from-length 35
-  "*Truncate sender name to this length in mail announcements")
-
-(defvar display-time-max-to-length 11
-  "*Truncate addressee name to this length in mail announcements")
-
-(defvar display-time-interval 30
-  "*Seconds between updates of time in the mode line.  Also used
-as interval for checking incoming mail.")
-
-(defvar display-time-no-file-means-no-mail t
-  "*Set this to T if you are on a system which deletes your mail-spool file 
-when there is no new mail.")
-
-(defvar display-time-incoming-mail-file nil
-  "*User's incoming mail file.  Default is value of environment variable MAIL,
-if set;  otherwise /usr/spool/mail/$USER is used.")
-
-(defvar display-time-message-separator nil)
-
-(defvar display-time-flush-echo-area nil
-  "*If true, then display-time's echo-area message will be 
-automatically cleared when display-time-interval has expired.")
-
-(defvar display-time-use-xbiff nil
-  "*If set, display-time uses xbiff to announce new mail.")
-
-(defvar display-time-xbiff-program "xbiff") ; xbiff++ if you're cool
-
-(defvar display-time-xbiff-arg-list nil
-  "*List of arguments passed to xbiff.  Useful for setting geometry, etc.")
-;;; For example: 
-;;; (setq display-time-xbiff-arg-list '("-update" "30" "-geometry" "+0+0"))
-
-(defvar display-time-mail-arrived-file nil
-  "New mail announcements saved in this file if xbiff used.  Deleted when 
-mail is read.  Xbiff is used to monitor existence of this file.
-This file will contain the headers (and only the headers) of all of the
-messages in your inbox.  If you do not wish this to be readable by others, 
-you should name a file here which is in a protected directory.  Protecting
-the file itself is not sufficient, because the file gets deleted and
-recreated, and emacs does not make it easy to create protected files.")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;                       Internal Variables                      ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar display-time-loadst-process nil
-  "The process providing time, load, and mail info.")
-
-(defvar display-time-xbiff-process nil
-  "The xbiff process used to announce incoming mail.")
-
-(defvar display-time-string nil
-  "Time displayed in mode line")
-
-(defvar display-time-mail-buffer-name "*reportmail*"
-  "Name of buffer used for announcing mail.")
-
-(defvar display-time-may-need-to-reset t
-  "Set to NIL when display-time-total-reset has not been called 
-since the last time we changed from having mail in the queue to an empty
-queue.")
-
-(defvar display-time-debugging nil
-  "*When non-NIL, reportmail records various status information
-as it's working.")
-
-(defvar display-time-debugging-delay nil 
-   "*When non-nil and display-time-debugging is set, sit for this 
-long after displaying each debugging message in mode line")
-
-(defvar display-time-debugging-buffer "*Reportmail-Debugging*"
-  "Status messages are appended here.")
-  
-(defvar display-time-max-debug-info 20000
-  "Maximum size of debugging buffer")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;                       Macros                                  ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro display-time-del-file (filename)
-  (list 'if (list 'file-exists-p filename) (list 'delete-file filename)))
-
-(defmacro display-time-debug (mesg &rest args)
-  (list
-     'if 'display-time-debugging
-         (list 'display-time-debug-mesg
-	       (append (list 'format mesg) args))))
-
-(defmacro display-time-save-match-data (&rest body)
-  ;; Execute the BODY forms, restoring the global value of the match data.
-  ;; We need this because it's antisocial for process filters to change
-  ;; the regexp match registers.
-  (list 'let '((_match_data_ (match-data)))
-	(list 'unwind-protect
-	      (cons 'progn body)
-	      '(store-match-data _match_data_))))
-
-(defun display-time-init ()
-  ;; If the mail-file isn't set, figure it out.
-  (or display-time-incoming-mail-file
-      (setq display-time-incoming-mail-file
-	    (or (getenv "MAIL")
-		(let ((user-name (or (getenv "USER") (user-login-name))))
-		  (and user-name
-		       (cond ((file-directory-p "/usr/spool/mail/") ; bsd
-			      (concat "/usr/spool/mail/" user-name))
-			     ((file-directory-p "/var/mail/") ; sysv
-			      (concat "/usr/spool/mail/" user-name)))))
-		"")))
-  ;; If the message-separator isn't set, set it to "From " unless
-  ;; the local hostname ends in ".CMU.EDU", where "^C" is used.
-  (or display-time-message-separator
-      (setq display-time-message-separator
-	    (let ((case-fold-search t))
-	      (if (string-match "\\.cmu\\.edu" (system-name))
-		  "\^C"
-		  "From "))))
-  ;; if this isn't set, these are probably right...
-  (or display-time-my-addresses
-      (setq display-time-my-addresses
-	    (list (user-full-name) (user-login-name))))
-  ;;
-  (or display-time-mail-arrived-file
-      (setq display-time-mail-arrived-file
-	    (expand-file-name ".mail-arrived" (user-home-directory))))
-  )
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;                       Time Display                            ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun display-time-kill ()
-  "Kill all display-time processes.  Done automatically if display-time
-is re-invoked."
-  (interactive)
-  (display-time-debug "display-time-kill")
-  (if display-time-loadst-process (delete-process display-time-loadst-process))
-  (if display-time-xbiff-process (delete-process display-time-xbiff-process))
-)
-
-(defun display-time ()
-  "Displays current time, date, load level, and incoming mail status in 
-mode line of each buffer (if corresponding user variables are set)."
-  (interactive)
-  (display-time-debug "display-time")
-  (display-time-init)
-  (let ((process-connection-type nil))	; UIUCDCS mod
-    (save-excursion
-      (display-time-kill)
-      (if (or (string-equal "" display-time-incoming-mail-file)
-	      (and (not display-time-no-file-means-no-mail)
-		   (not (file-exists-p display-time-incoming-mail-file))))
-	  (progn 
-	     (message "Reportmail: mail spool file \"%s\" not found" 
-		      display-time-incoming-mail-file)
-	     (sit-for 1)
-	     (beep)))
-      (if (not global-mode-string) (setq global-mode-string '("")))
-      (if (not (listp global-mode-string))
-	  (setq global-mode-string (list global-mode-string "  ")))
-      (if (not (memq 'display-time-string global-mode-string))
-	  (setq global-mode-string
-		(append global-mode-string '(display-time-string))))
-      (setq display-time-string "time and load")
-      
-      (if (featurep 'itimer)
-	  (let ((old (get-itimer "display-time")))
-	    (if old (delete-itimer old))
-	    (start-itimer "display-time" 'display-time-timer-function
-			  display-time-interval display-time-interval)
-	    (display-time-timer-function))
-	;; if we don't have timers, then use one of the process mechanisms.
-	(setq display-time-loadst-process
-	      (if (string-match "18\\.5[0-5]" (emacs-version))
-		  (start-process "display-time-loadst" nil
-				 "loadst" 
-				 "-n" (int-to-string display-time-interval))
-		(start-process "display-time-wakeup" nil
-			       (concat exec-directory "wakeup")
-			       (int-to-string display-time-interval))))
-	(process-kill-without-query display-time-loadst-process)
-	(set-process-sentinel display-time-loadst-process 
-			      'display-time-sentinel)
-	(set-process-filter display-time-loadst-process
-			    (if (string-match "^18\\.5[0-5]" (emacs-version))
-				'display-time-filter-18-55
-			      'display-time-filter-18-57)))
-      
-      (if display-time-use-xbiff
-	  (progn
-	    (display-time-del-file display-time-mail-arrived-file)
-	    (setq display-time-xbiff-process
-		  (apply 'start-process "display-time-xbiff" nil
-			 display-time-xbiff-program
-			 "-file" display-time-mail-arrived-file
-			 display-time-xbiff-arg-list))
-	    (process-kill-without-query display-time-xbiff-process)
-	    (sit-for 1)			; Need time to see if xbiff fails.
-	    (if (/= 0 (process-exit-status display-time-xbiff-process))
-		(error "Display time: xbiff failed.  Check xbiff-arg-list"))))))
-  (display-time-total-reset))
-
-
-(defun display-time-sentinel (proc reason)
- (display-time-save-match-data
-  ;; notice if the process has died an untimely death...
-  (display-time-debug "display-time-sentinel")
-  (cond ((memq (process-status proc) '(stop exit closed signal))
-	 (if (and (stringp reason) (string-match "\n?\n*\\'" reason))
-	     (setq reason (substring reason 0 (match-beginning 0))))
-	 (beep)
-	 (setq display-time-string (format "%s" reason))
-	 (display-time-message "")
-	 (message "process %s: %s (%s)" proc reason (process-status proc))))
-  (display-time-force-redisplay)))
-
-(defun display-time-filter-18-55 (proc string)
- (display-time-save-match-data
-  (if display-time-flush-echo-area (display-time-message ""))
-  ;; Desired data can't need more than the last 30 chars,
-  ;; so save time by flushing the rest.
-  ;; This way, if we have many different times all collected at once,
-  ;; we can discard all but the last few very fast.
-  (display-time-debug "display-time-filter-18-55")
-  (if (> (length string) 30) (setq string (substring string -30)))
-  ;; Now discard all but the very last one.
-  (while (and (> (length string) 4)
-	      (string-match "[0-9]+:[0-9][0-9].." string 4))
-    (setq string (substring string (match-beginning 0))))
-  (if (string-match "[^0-9][0-9]+:" string)
-      (setq string (substring string 0 (1+ (match-beginning 0)))))
-  ;; If we're announcing mail and mail has come, process any new messages
-  (if display-time-announce-mail
-      (if (string-match "Mail" string)
-	  (display-time-process-new-mail)
-	  (display-time-total-reset)))
-  ;; Format the mode line time display
-  (let ((time-string (if (string-match "Mail" string)
-			 (if display-time-announce-mail 
-			     display-time-mail-modeline
-			     "Mail "))))
-    (if (and display-time-time (string-match "[0-9]+:[0-9][0-9].." string))
-	(setq time-string 
-	      (concat time-string
-		      (substring string (match-beginning 0) (match-end 0))
-		      " ")))
-    (if display-time-day-and-date
-	(setq time-string
-	      (concat time-string
-		      (substring (current-time-string) 0 11))))
-    (if (and display-time-load (string-match "[0-9]+\\.[0-9][0-9]" string))
-	(setq time-string
-	      (concat time-string
-		      (substring string (match-beginning 0) (match-end 0))
-		      " ")))
-    ;; Install the new time for display.
-    (setq display-time-string time-string)
-    (display-time-force-redisplay))))
-
-(defun display-time-filter-18-57 (proc string) ; args are ignored
- (display-time-save-match-data
-  (display-time-debug "display-time-filter-18-57")
-  (if display-time-flush-echo-area
-      (progn
-	(display-time-debug "flush echo area")
-	(display-time-message "")))
-  (let ((mailp (and (file-exists-p display-time-incoming-mail-file)
-		    (not (eq 0 (nth 7 (file-attributes
-				       display-time-incoming-mail-file)))))))
-    (if display-time-announce-mail
-	(if mailp
-	    (display-time-process-new-mail)
-	    (display-time-total-reset)))
-    ;; Format the mode line time display
-    (let ((time-string (if mailp
-			   (if display-time-announce-mail
-			       display-time-mail-modeline
-			       "Mail "))))
-      (if display-time-time
-	  (let* ((time (current-time-string))
-		 (hour (read (substring time 11 13)))
-		 (pm (>= hour 12)))
-	    (if (> hour 12) (setq hour (- hour 12)))
-	    (if (= hour 0) (setq hour 12))
-	    (setq time-string
-		  (concat time-string
-			  (format "%d" hour) (substring time 13 16)
-			  (if pm "pm " "am ")))))
-      (if display-time-day-and-date
-	  (setq time-string
-		(concat time-string
-			(substring (current-time-string) 0 11))))
-      (if display-time-load
-	  (setq time-string
-	      (concat time-string
-		      (condition-case ()
-                          (let* ((la (car (load-average)))
-                                 (load (if (zerop la)
-                                           nil
-                                         (format "%03d" la))))
-                            (if load
-                                (concat (substring load 0 -2)
-                                        "." (substring load -2))
-			      ""))
-                        (error "load-error"))
-		      " ")))
-      ;; Install the new time for display.
-      (setq display-time-string time-string)
-
-      (display-time-force-redisplay)))))
-
-(defun display-time-timer-function ()
-  (display-time-filter-18-57 nil nil))
-
-(defun display-time-force-redisplay ()
-  "Force redisplay of all buffers' mode lines to be considered."
-  (save-excursion (set-buffer (other-buffer)))
-  (set-buffer-modified-p (buffer-modified-p))
-  ;; Do redisplay right now, if no input pending.
-  (sit-for 0))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;                       Mail processing                         ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar display-time-mail-who-from ""
-  "Short-form name of sender of last piece of interesting unread mail")
-
-(defvar display-time-mail-modeline ""
-  "Terse mail announcement (displayed in modeline)")
-
-(defvar display-time-previous-mail-buffer-max 1
-  "The length of the mail buffer the last time we looked at it")
-
-(defvar display-time-msg-count 0
-  "How many interesting messages have arrived")
-
-(defvar display-time-junk-msg-count 0
-  "How many junk messages have arrived")
-
-(defvar display-time-last-message nil) ; enormous hack
-
-
-;; A test procedure for trying out new display-time features
-;(defun display-time-test ()
-;  (interactive)
-;  (display-time-reset-mail-processing)
-;  (display-time-process-new-mail))
-
-(defun display-time-manual-reset ()
-  "Utility function to be called externally to make reportmail notice
-that things may have changed."
-  (display-time-debug "Manual reset")
-  (display-time-timer-function))
-
-(defun display-time-total-reset ()
-  (display-time-debug "display-time-total-reset")
-  (if display-time-may-need-to-reset
-   (progn
-    (setq display-time-may-need-to-reset nil)
-    (display-time-debug "Resetting mail processing")
-    (let ((mail-buffer (get-buffer display-time-mail-buffer-name)))
-      (cond (mail-buffer
-	     ;; unmodify it before killing it in case it has accidentally
-	     ;; been typed in to.
-	     (save-excursion
-	       (set-buffer mail-buffer)
-	       (set-buffer-modified-p nil))
-	     (kill-buffer mail-buffer))))
-    (if display-time-use-xbiff
-	;; This function is only called when no mail is in the spool.
-	;; Hence we should delete the mail-arrived file.
-	(display-time-del-file display-time-mail-arrived-file))
-    (display-time-reset)
-    )))
-
-(defun display-time-reset ()
-  (display-time-debug "display-time-reset")
-  (setq display-time-msg-count 0)
-  (setq display-time-junk-msg-count 0)
-  (setq display-time-mail-who-from "Junk mail")
-  (setq display-time-mail-modeline "")
-  (setq display-time-previous-mail-buffer-max 1)
-  (display-time-message "") ; clear the echo-area.
-  )
-
-(or (fboundp 'buffer-disable-undo)
-    (fset 'buffer-disable-undo 'buffer-flush-undo))
-
-(defun display-time-process-new-mail ()
-  (setq display-time-may-need-to-reset t)
-  (let ((mail-buffer (get-buffer display-time-mail-buffer-name))
-	(inhibit-local-variables t)
-	(enable-local-variables nil))
-    (if (not (and mail-buffer (verify-visited-file-modtime mail-buffer)))
-      (save-window-excursion
-       (save-excursion
-	(display-time-debug "Spool file has changed... rereading...")
-	(cond (mail-buffer
-	       ;; unmodify it before killing it in case it has accidentally
-	       ;; been typed in to.
-	       (save-excursion
-		 (set-buffer mail-buffer)
-		 (set-buffer-modified-p nil))
-	       (kill-buffer mail-buffer))))
-	;; Change to pop-to-buffer when we're debugging:
-	(set-buffer (get-buffer-create display-time-mail-buffer-name))
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)
-	(condition-case nil
-	    ;; I wish we didn't have to mark the buffer as visiting the file,
-	    ;; since that interferes with the user's ability to use find-file
-	    ;; on their spool file, but there's no way to simulate what
-	    ;; verify-visited-file-modtime does.  Lose lose.
-	    (let ((buffer-read-only nil))
-	      (insert-file-contents display-time-incoming-mail-file t))
-	  (file-error nil))
-	;; this buffer belongs to us; hands off.
-	(setq buffer-read-only t)
-	(display-time-process-mail-buffer)))))
-
-(defun display-time-process-mail-buffer ()
-  (if (< display-time-previous-mail-buffer-max (point-max))
-      (let ((case-fold-search nil))
-	(goto-char display-time-previous-mail-buffer-max)
-	(if (not (looking-at
-		  (regexp-quote display-time-message-separator)))
-	    (display-time-reset)))
-    (display-time-reset))
-  (goto-char display-time-previous-mail-buffer-max)
-  (if display-time-use-xbiff
-      (save-excursion
-	(set-buffer (get-buffer-create " *reportmail-tmp*"))
-	(erase-buffer)))
-  (let ((case-fold-search nil)
-	(start (point))
-	end junkp ring-bell)
-    (while (not (eobp))
-      (if (search-forward (concat "\n" display-time-message-separator)
-			  nil 'end)
-	  (setq end (1+ (match-beginning 0)))
-	(setq end (point-max)))
-      (narrow-to-region start end)
-      (setq junkp (display-time-process-this-message))
-      (if (and display-time-mail-ring-bell (not ring-bell))
-	  (setq ring-bell (if junkp display-time-junk-mail-ring-bell t)))
-      (widen)
-      (goto-char (if (= end (point-max)) (point-max) (1+ end)))
-      (setq start end))
-
-    (if ring-bell
-	(if (string-match "XEmacs" emacs-version)
-	    (beep nil 'reportmail)
-	  (beep))))
-  
-  (if display-time-use-xbiff
-      (save-excursion
-	(set-buffer (get-buffer-create " *reportmail-tmp*"))
-	(if (zerop (buffer-size))
-	    nil
-	  (write-region (point-min) (point-max)
-			display-time-mail-arrived-file
-			t 'nomsg)
-	  (erase-buffer)
-;	  ;; there's no way to get append-to-file to not dump the message
-;	  ;; "Wrote file ..." in the echo area, so re-write the last message
-;	  ;; we intended to write.
-;	  (if display-time-last-message
-;	      (display-time-message "%s" display-time-last-message))
-	  )))
-  
-  (setq display-time-previous-mail-buffer-max (point-max)))
-
-(defun display-time-process-this-message ()
-  (display-time-debug "display-time-process-this-message")
-  (let ((junk-p (display-time-junk-message)))
-    (if junk-p
-	(display-time-process-junk-message)
-      (display-time-process-good-message))
-    ;; Update mode line contents
-    (setq display-time-mail-modeline 
-	  (concat "[" (display-time-format-msg-count) 
-		  display-time-mail-who-from
-		  "] "))
-    (display-time-debug "New mode line: %s " display-time-mail-modeline)
-    junk-p))
-
-(defun display-time-junk-message ()
-  "Check to see whether this message is interesting"
-
-  (display-time-debug "Comparing current message to junk mail checklist")
-
-  (let ((checklist display-time-junk-mail-checklist)
-	(junk nil))
-    (while (and checklist (not junk))
-      (if (display-time-member 
-	   (display-time-get-field (car (car checklist)))
-	   (cdr (car checklist)))
-	  (setq junk t)
-	  (setq checklist (cdr checklist))))
-    junk))
-
-(defun display-time-message (&rest message-args)
-  (let ((str (apply 'format message-args))
-	(in-echo-area-already (eq (selected-window) (minibuffer-window))))
-    (setq display-time-last-message str)
-    ;; don't stomp the echo-area-buffer if reading from the minibuffer now.
-    (display-time-debug "display-time-message (%s)" str)
-    (if (not in-echo-area-already)
-	(save-excursion
-	  (save-window-excursion
-	    (display-time-debug "Overwriting echo area with message")
-	    (select-window (minibuffer-window))
-	    (delete-region (point-min) (point-max))
-	    (insert str))))
-    ;; if we're reading from the echo-area, and all we were going to do is
-    ;; clear the thing, like, don't bother, that's annoying.
-    (if (and in-echo-area-already (string= "" str))
-	nil
-      (if (and (string= str "") (string-match "^19" emacs-version))
-	  (message nil)
-	(message "%s" str)))))
-
-(defun display-time-process-good-message ()
-  (display-time-debug "Formatting message announcement (good message)")
-
-  ;; Update the message counter
-  (setq display-time-msg-count (+ display-time-msg-count 1))
-
-  ;; Format components of announcement
-  (let* ((subject (display-time-get-field "Subject" ""))
-	 (from (display-time-get-field "From" ""))
-	 (to (display-time-get-field "To" ""))
-	 (print-subject (if (string= subject "")
-			    ""
-			    (concat " (" subject ")")))
-	 (print-from (display-time-truncate from display-time-max-from-length))
-	 (short-from (display-time-truncate 
-		      (display-time-extract-short-addr from) 25))
-	 (print-to (if (display-time-member to display-time-my-addresses)
-		       ""
-		       (display-time-truncate 
-			(display-time-extract-short-addr to)
-			display-time-max-to-length))))
-
-    ;; Announce message
-    (let ((msg (concat 
-		   (display-time-format-msg-count)
-		   "Mail " 
-		   (if (string= print-to "") "" 
-		       (concat "to " print-to " "))
-		   "from " print-from 
-		   print-subject)))
-      (if display-time-use-xbiff
-	  (save-excursion
-	    (let* ((tmp-buf (get-buffer-create " *reportmail-tmp*"))
-		   (buf (current-buffer))
-		   (start (point-min))
-		   (end (save-excursion
-			  (goto-char start)
-			  (search-forward "\n\n" nil 0)
-			  (point))))
-	      (set-buffer tmp-buf)
-	      (goto-char (point-max))
-	      (insert-buffer-substring buf start end)
-	      (insert "\n\n")
-	      )))
-      (display-time-debug "Message: %s" msg)
-      (display-time-message "%s" msg))
-    ;; Update mode line information
-    (setq display-time-mail-who-from short-from)))
-
-(defun display-time-process-junk-message ()
-  (display-time-debug "Formatting message announcement (junk message)")
-
-  ;; Update the message counter
-  (setq display-time-junk-msg-count (+ display-time-junk-msg-count 1))
-
-  ;; Format components of announcement
-  (let* ((subject (display-time-get-field "Subject" ""))
-	 (from (display-time-get-field "From" ""))
-	 (to (display-time-get-field "To" ""))
-	 (print-subject (if (string= subject "")
-			    ""
-			    (concat " (" subject ")")))
-	 (print-from (display-time-truncate from display-time-max-from-length))
-	 (short-from (display-time-truncate 
-		      (display-time-extract-short-addr from) 25))
-	 (print-to (if (display-time-member to display-time-my-addresses)
-		       ""
-		       (display-time-truncate 
-			(display-time-extract-short-addr to)
-			display-time-max-to-length))))
-
-    ;; Announce message
-    (if display-time-announce-junk-mail-too
-	  (let ((msg (concat 
-		      (display-time-format-msg-count)
-		      "Junk Mail " 
-		      (if (string= print-to "") "" 
-			(concat "to " print-to " "))
-		      "from " print-from 
-		      print-subject)))
-	    (display-time-message "%s" msg)
-	    (display-time-debug "Message: %s" msg)))))
-
-(defun display-time-format-msg-count ()
-   (if (> (+ display-time-msg-count display-time-junk-msg-count) 1) 
-       (concat 
-	(int-to-string display-time-msg-count) 
-	(if (> display-time-junk-msg-count 0)
-	    (concat "(" (int-to-string display-time-junk-msg-count) ")"))
-	": ")
-       ""))
-
-(defun display-time-get-field (field &optional default)
-  (cond ((not (equal (buffer-name) display-time-mail-buffer-name))
-    (beep)
-    (message "reportmail bug: processing buffer %s, not %s"
-	     (buffer-name)
-	     display-time-mail-buffer-name)
-    (sit-for 2)))
-  (goto-char (point-min))
-  (let* ((case-fold-search t)
-	 (result
-	 (if (re-search-forward (concat "^" field ":[ |\C-i]*") nil t)
-	     (let ((start (point)))
-	       (end-of-line)
-	       (while (looking-at "\n[ \t]")
-		 (forward-line 1)
-		 (end-of-line))
-	       (buffer-substring start (point)))
-	     (or default ""))))
-    (display-time-debug "value of %s field is %s" field result)
-    result))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;                       Auxilliary Functions                    ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun display-time-member (e l)
-  "Is string E matched by an element of list L?
-When an element of L begins with ^, match it as a regexp.  Otherwise,
-ignore case and match exactly.  If display-time-match-using-regexps is
-non-nil, always match using regexps."
-  (let ((done nil)
-	(result nil))
-    (while (not done)
-      (cond 
-       ((null l) (setq done t))
-       ((or display-time-match-using-regexps (= (elt (car l) 0) ?^))
-	(if (string-match (car l) e)
-	    (setq result l done t)
-	  (setq l (cdr l))))
-       ((string-match (regexp-quote (downcase (car l))) (downcase e)) 
-	(setq result l done t))
-       (t 
-	(setq l (cdr l)))))
-    result))
-
-(defun display-time-truncate (s max)
-  (if (and s (>= (length s) max))
-      (concat (substring s 0 max) "\\")
-      s))
-
-(defun display-time-extract-short-addr (long-addr)
-  (let ((result (and (fboundp 'mail-extract-address-components)
-		     (mail-extract-address-components long-addr))))
-    (or (nth 0 result)  ; hairily extracted real name
-	(let ((name "\\([A-Za-z0-9-_+\\. ]+\\)"))
-	  (setq long-addr (or (nth 2 result) long-addr))
-	  (if (or 
-	       ;; David Plaut 	 -> David Plaut
-	       ;; (doesn't happen if mail-extr loaded)
-	       (string-match (concat name "[ |	]+<.+>") long-addr)
-	
-	       ;; anything (David Plaut) anything	 -> David Plaut
-	       ;; (doesn't happen if mail-extr loaded)
-	       (string-match ".+(\\(.+\\)).*" long-addr)
-	 
-	       ;; plaut%address.bitnet@vma.cc.cmu.edu -> plaut
-	       (string-match (concat name "%.+@.+") long-addr)
-
-	       ;; random!uucp!addresses!dcp@uu.relay.net -> dcp
-	       (string-match (concat ".*!" name "@.+") long-addr)
-
-	       ;; David.Plaut@CS.CMU.EDU		 -> David.Plaut
-	       (string-match (concat name "@.+") long-addr)
-	       )
-	      (substring long-addr (match-beginning 1) (match-end 1))
-	    long-addr)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;                       Debugging Support                       ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar display-time-debugging-messages nil
-  "When non-NIL, reportmail displays status messages in real time.")
-
-(defun display-time-debug-mesg (mesg)
- (display-time-save-match-data
-  (if display-time-debugging-messages
-      (progn 
-	(message "Reportmail: %s" mesg)
-	(sit-for 1)
-	))
-  (save-excursion
-    (save-window-excursion
-      (set-buffer (get-buffer-create display-time-debugging-buffer))
-      (goto-char (point-max))
-      (insert (substring (current-time-string) 11 16) "  " mesg "\n")
-      ;; Make sure the debugging buffer doesn't get out of hand
-      (if (> (point-max) display-time-max-debug-info)
-	  (delete-region (point-min) 
-			 (- (point-max) display-time-max-debug-info)))))
-  (if display-time-debugging-delay
-      (progn (message "Reportmail: %s" mesg)
-	     (sit-for display-time-debugging-delay)))))
-
-(provide 'reportmail)
diff --git a/xemacs-packages/lisp/edit-utils/resume.el b/xemacs-packages/lisp/edit-utils/resume.el
deleted file mode 100644
index ecbcf740..00000000
--- a/xemacs-packages/lisp/edit-utils/resume.el
+++ /dev/null
@@ -1,131 +0,0 @@
-;;; resume.el --- process command line args from within a suspended Emacs job
-;; Copyright (C) 1988, 1992 Free Software Foundation, Inc.
-
-;; Author: Joe Wells 
-;; Adapted-By: ESR
-;; Keywords: processes
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: 19.34
-
-;;; Commentary:
-
-;; The purpose of this library is to handle command line arguments
-;; when you resume an existing Emacs job.
-
-;; In order to use it, you must put this code in your .emacs file.
-
-;; (add-hook 'suspend-hook 'resume-suspend-hook)
-;; (add-hook 'suspend-resume-hook 'resume-process-args)
-
-;; You can't get the benefit of this library by using the `emacs' command,
-;; since that always starts a new Emacs job.  Instead you must use a
-;; command called `edit' which knows how to resume an existing Emacs job
-;; if you have one, or start a new Emacs job if you don't have one.
-
-;; To define the `edit' command, run the script etc/emacs.csh (if you use CSH),
-;; or etc/emacs.bash if you use BASH.  You would normally do this in your
-;; login script.
-
-;; Stephan Gildea suggested bug fix (gildea@bbn.com).
-;; Ideas from Michael DeCorte and other people.
-
-;;; Code:
-
-(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args")
-  "*This file is where arguments are placed for a suspended emacs job.")
-
-(defvar resume-emacs-args-buffer " *Command Line Args*"
-  "Buffer that is used by resume-process-args.")
-
-(defun resume-process-args ()
-  "Handler for command line args given when Emacs is resumed."
-  (let ((start-buffer (current-buffer))
-	(args-buffer (get-buffer-create resume-emacs-args-buffer))
-	length args
-	(command-line-default-directory default-directory))
-    (unwind-protect
-	(progn
-	  (set-buffer args-buffer)
-	  (erase-buffer)
-	  ;; get the contents of resume-emacs-args-file
-	  (condition-case ()
-	      (let ((result (insert-file-contents resume-emacs-args-file)))
-		(setq length (car (cdr result))))
-	    ;; the file doesn't exist, ergo no arguments
-	    (file-error
-	     (erase-buffer)
-	     (setq length 0)))
-	  (if (<= length 0)
-	      (setq args nil)
-	    ;; get the arguments from the buffer
-	    (goto-char (point-min))
-	    (while (not (eobp))
-	      (skip-chars-forward " \t\n")
-	      (let ((begin (point)))
-		(skip-chars-forward "^ \t\n")
-		(setq args (cons (buffer-substring begin (point)) args)))
-	      (skip-chars-forward " \t\n"))
-	    ;; arguments are now in reverse order
-	    (setq args (nreverse args))
-	    ;; make sure they're not read again
-	    (erase-buffer))
-	  (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file)
-	  ;; if nothing was in buffer, args will be null
-	  (or (null args)
-	      (setq command-line-default-directory
-		    (file-name-as-directory (car args))
-		    args (cdr args)))
-	  ;; actually process the arguments
-	  ;; XEmacs: command-line-1 doesn't take a parameter
-	  (let ((command-line-args-left args))
-	    (command-line-1)))
-      ;; If the command line args don't result in a find-file, the
-      ;; buffer will be left in args-buffer.  So we change back to the
-      ;; original buffer.  The reason I don't just use
-      ;; (let ((default-directory foo))
-      ;;    (command-line-1 args))
-      ;; in the context of the original buffer is because let does not
-      ;; work properly with buffer-local variables.
-      (if (eq (current-buffer) args-buffer)
-	  (set-buffer start-buffer)))))
-
-;;;###autoload
-(defun resume-suspend-hook ()
-  "Clear out the file used for transmitting args when Emacs resumes."
-  (save-excursion
-    (set-buffer (get-buffer-create resume-emacs-args-buffer))
-    (erase-buffer)
-    (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file)))
-
-(defun resume-write-buffer-to-file (buffer file)
-  "Writes the contents of BUFFER into FILE, if permissions allow."
-  (if (not (file-writable-p file))
-      (error "No permission to write file %s" file))
-  (save-excursion
-    (set-buffer buffer)
-    (clear-visited-file-modtime)
-    (save-restriction
-      (widen)
-      (write-region (point-min) (point-max) file nil 'quiet))
-    (set-buffer-modified-p nil)))
-
-(provide 'resume)
-
-;;; resume.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/rsz-minibuf.el b/xemacs-packages/lisp/edit-utils/rsz-minibuf.el
deleted file mode 100644
index c21a6e89..00000000
--- a/xemacs-packages/lisp/edit-utils/rsz-minibuf.el
+++ /dev/null
@@ -1,233 +0,0 @@
-;;; rsz-minibuf.el --- dynamically resize minibuffer to display entire contents
-
-;; Copyright (C) 1990 Roland McGrath
-;; Copyright (C) 1993, 1994 Noah S. Friedman
-
-;; Author: Noah Friedman 
-;; Author: Roland McGrath 
-;; Modified for Lucid Emacs By: Peter Stout 
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: minibuffer, window, frames, display
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  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.
-
-;;; Synched up with: Not synched.
-
-;;; Commentary:
-
-;; This file has received maintenance by the XEmacs development team.
-
-;; $Id: rsz-minibuf.el,v 1.1.1.1 1998/01/14 06:36:14 steve Exp $
-
-;; This package allows the entire contents (or as much as possible) of the
-;; minibuffer to be visible at once when typing.  As the end of a line is
-;; reached, the minibuffer will resize itself.  When the user is done
-;; typing, the minibuffer will return to its original size.
-
-;; In window systems where it is possible to have a frame in which the
-;; minibuffer is the only window, the frame itself can be resized.  In FSF
-;; GNU Emacs 19.22 and earlier, the frame may not be properly returned to
-;; its original size after it ceases to be active because
-;; `minibuffer-exit-hook' didn't exist until version 19.23.
-
-;; NOTE: The code to resize frames has not been tested under Lucid Emacs,
-;; because detached minibuffers are broken.
-
-;; Note that the minibuffer and echo area are not the same!  They simply
-;; happen to occupy roughly the same place on the frame.  Messages put in
-;; the echo area will not cause any resizing by this package.
-
-;; This package is considered a minor mode but it doesn't put anything in
-;; minor-mode-alist because this mode is specific to the minibuffer, which
-;; has no modeline.
-
-;; To use this package, put the following in your .emacs:
-;;
-;;     (autoload 'resize-minibuffer-mode "rsz-minibuf" nil t)
-;;
-;; Invoking the command `resize-minibuffer-mode' will then enable this mode.
-
-;;; Code:
-
-
-
-(defgroup resize-minibuffer nil
-  "Dynamically resize minibuffer to display entire contents"
-  :group 'frames)
-
-
-(defcustom resize-minibuffer-mode nil
-  "*If non-`nil', resize the minibuffer so its entire contents are visible."
-  :type 'boolean
-  :require 'rsz-minibuf
-  :group 'resize-minibuffer)
-
-(defcustom resize-minibuffer-window-max-height nil
-  "*Maximum size the minibuffer window is allowed to become.
-If less than 1 or not a number, the limit is the height of the frame in
-which the active minibuffer window resides."
-  :type '(choice (const nil) integer)
-  :group 'resize-minibuffer)
-
-(defcustom resize-minibuffer-window-exactly t
-  "*If non-`nil', make minibuffer exactly the size needed to display all its contents.
-Otherwise, the minibuffer window can temporarily increase in size but
-never get smaller while it is active."
-  :type 'boolean
-  :group 'resize-minibuffer)
-
-
-(defcustom resize-minibuffer-frame nil
-  "*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height."
-  :type 'boolean
-  :group 'resize-minibuffer)
-
-(defcustom resize-minibuffer-frame-max-height nil
-  "*Maximum size the minibuffer frame is allowed to become.
-If less than 1 or not a number, there is no limit.")
-
-(defcustom resize-minibuffer-frame-exactly nil
-  "*If non-`nil', make minibuffer frame exactly the size needed to display all its contents.
-Otherwise, the minibuffer frame can temporarily increase in size but
-never get smaller while it is active."
-  :type 'boolean
-  :group 'resize-minibuffer)
-
-
-;;;###autoload
-(defun resize-minibuffer-mode (&optional prefix)
-  "Enable or disable resize-minibuffer mode.
-A negative prefix argument disables this mode.  A positive argument or
-argument of 0 enables it.
-
-When this minor mode is enabled, the minibuffer is dynamically resized to
-contain the entire region of text put in it as you type.
-
-The variable `resize-minibuffer-mode' is set to t or nil depending on
-whether this mode is active or not.
-
-The maximum height to which the minibuffer can grow is controlled by the
-variable `resize-minibuffer-window-max-height'.
-
-The variable `resize-minibuffer-window-exactly' determines whether the
-minibuffer window should ever be shrunk to make it no larger than needed to
-display its contents.
-
-When using a window system, it is possible for a minibuffer to be the sole
-window in a frame.  Since that window is already its maximum size, the only
-way to make more text visible at once is to increase the size of the frame.
-The variable `resize-minibuffer-frame' controls whether this should be
-done.  The variables `resize-minibuffer-frame-max-height' and
-`resize-minibuffer-frame-exactly' are analogous to their window
-counterparts."
-  (interactive "p")
-  (or prefix (setq prefix 0))
-  (cond
-   ((>= prefix 0)
-    (setq resize-minibuffer-mode t))
-   (t
-    (setq resize-minibuffer-mode nil))))
-
-(defun resize-minibuffer-setup ()
-  (cond
-   (resize-minibuffer-mode
-    (cond
-     ((and (not (eq 'tty (console-type)))
-	   (eq 'only (plist-get (frame-properties) 'minibuffer)))
-      (and resize-minibuffer-frame
-	   (progn
-	     (make-local-hook 'minibuffer-exit-hook)
-	     (add-hook 'minibuffer-exit-hook 'resize-minibuffer-frame-restore
-		       nil t)
-	     (make-local-hook 'post-command-hook)
-	     (add-hook 'post-command-hook 'resize-minibuffer-frame nil t)
-	     (unless (and (boundp 'icomplete-mode)
-			  icomplete-mode)
-	       (resize-minibuffer-frame)))))
-     (t
-      (make-local-hook 'post-command-hook)
-      (add-hook 'post-command-hook 'resize-minibuffer-window nil t)
-      (unless (and (boundp 'icomplete-mode)
-		   icomplete-mode)
-	(resize-minibuffer-window)))))))
-
-(defun resize-minibuffer-count-window-lines (&optional start end)
-  "Return number of window lines occupied by text in region.
-The number of window lines may be greater than the number of actual lines
-in the buffer if any wrap on the display due to their length.
-
-Optional arguments START and END default to point-min and point-max,
-respectively."
-  (or start (setq start (point-min)))
-  (or end   (setq end   (point-max)))
-  (if (= start end)
-      0
-    (save-excursion
-      (save-restriction
-        (widen)
-	(narrow-to-region start end)
-	(goto-char start)
-        (vertical-motion (buffer-size))))))
-
-
-;; Resize the minibuffer window to contain the minibuffer's contents.
-;; The minibuffer must be the current window.
-(defun resize-minibuffer-window ()
-  (let ((height (window-height))
-	(lines (1+ (resize-minibuffer-count-window-lines))))
-    (and (numberp resize-minibuffer-window-max-height)
-	 (> resize-minibuffer-window-max-height 0)
-	 (setq lines (min
-		      lines
-		      resize-minibuffer-window-max-height)))
-    (or (if resize-minibuffer-window-exactly
-	    (= lines height)
-	  (<= lines height))
-	(enlarge-window (- lines height)))))
-
-
-;; Resize the minibuffer frame to contain the minibuffer's contents.
-;; The minibuffer frame must be the current frame.
-(defun resize-minibuffer-frame ()
-  (let ((height (frame-height))
-	(lines (1+ (resize-minibuffer-count-window-lines))))
-    (and (numberp resize-minibuffer-frame-max-height)
-	 (> resize-minibuffer-frame-max-height 0)
-	 (setq lines (min
-		      lines
-		      resize-minibuffer-frame-max-height)))
-    (cond
-     ((> lines height)
-      (set-frame-size (selected-frame) (frame-width) lines))
-     ((and resize-minibuffer-frame-exactly
-	   (> height (plist-get minibuffer-frame-plist 'height))
-	   (< lines height))
-      (set-frame-size (selected-frame) (frame-width) lines)))))
-
-;; Restore the original height of the frame.
-(defun resize-minibuffer-frame-restore ()
-  (set-frame-size (selected-frame) (frame-width)
-		  (plist-get minibuffer-frame-plist 'height)))
-
-
-(provide 'rsz-minibuf)
-
-(add-hook 'minibuffer-setup-hook 'resize-minibuffer-setup)
-
-;;; rsz-minibuf.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/saveconf.el b/xemacs-packages/lisp/edit-utils/saveconf.el
deleted file mode 100644
index 12bb9c55..00000000
--- a/xemacs-packages/lisp/edit-utils/saveconf.el
+++ /dev/null
@@ -1,285 +0,0 @@
-;;; Save Emacs buffer and window configuration between editing sessions.
-;;; Copyright (C) 1987, 1988, 1989 Kyle E. Jones
-;;;
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 1, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; A copy of the GNU General Public License can be obtained from the
-;;; program's author (send electronic mail to kyle@cs.odu.edu) or from
-;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
-;;; 02139, USA.
-;;;
-;;; Send bug reports to kyle@cs.odu.edu.
-
-;;; Synched up with: Not in FSF.
-
-;; This package of functions gives Emacs the ability to remember which
-;; files were being visited, the windows that were on them, and the
-;; value of point in their buffers the last Emacs session in the same
-;; directory.  This is an emulation of an old Gosling Emacs feature.
-;;
-;; The relevant commands are save-context and recover-context.
-;;
-;; Most of the time you'll want an Emacs session's context saved even if
-;; you choose not to recover it later.  To avoid having to manually
-;; M-x save-context at each emacs exit, put the line:
-;;    (setq auto-save-and-recover-context t)
-;; in your .emacs or in default.el in the lisp directory of the Emacs
-;; distribution.  The context will then automatically be saved when
-;; Emacs exits.
-;;
-;; By default only the contexts of visible buffers (buffers with windows
-;; on them) are saved.  Setting the variable save-buffer-context to t
-;; causes the contexts of all buffers to be saved.
-;;
-;; Put this file in the "lisp" directory of the emacs distribution in a
-;; file called saveconf.el.  Byte-compile it.
-;;
-;; There are two ways to use this package.
-;;   1) Put the line
-;;       (require 'saveconf)
-;;      in the file site-init.el in the lisp directory of the Emacs
-;;      directory and rebuild Emacs.  If you get the "Pure Lisp storage
-;;      exhausted" error message when rebuilding Emacs, increase PURESIZE
-;;      in src/config.h by about 30000 bytes and try again.  It's almost
-;;      certain that this will happen to you so you might as well increase
-;;      PURESIZE beforehand.
-;;
-;;      This is the preferred mode of operation because it allows the
-;;      package to become part of Emacs' startup sequence and automatically
-;;      restore context in a directory if Emacs is invoked without any
-;;      command line arguments.
-;;
-;;   2) Put these lines
-;;       (require 'saveconf)
-;;       (if (null (cdr command-line-args))
-;;           (setq inihibit-startup-message (recover-context)))
-;;      at the end of your .emacs file or the default.el file in the
-;;      lisp directory of the Emacs distribution.  This causes the
-;;      context saved in the current directory to be recovered whenever
-;;      Emacs is invoked without any arguments.
-
-(provide 'saveconf)
-
-(defconst save-context-version "Norma Jean"
-  "A unique string which is placed at the beginning of every saved context
-file.  If the string at the beginning of the context file doesn't match the
-value of this variable the `recover-context' command will ignore the file's
-contents.")
-
-(defvar auto-save-and-recover-context nil
-  "*If non-nil the `save-context' command will always be run before Emacs is
-exited.  Also upon Emacs startup, if this variable is non-nil and Emacs is
-passed no command line arguments, `recover-context' will be run.")
-
-(defvar save-buffer-context nil
-  "*If non-nil the `save-context' command will save the context
-of buffers that are visiting files, as well as the contexts of buffers
-that have windows.")
-
-(defvar save-context-predicate
-  (function (lambda (w)
-	      (and (buffer-file-name (window-buffer w))
-		   (not (string-match "^\\(/usr\\)?/tmp/"
-				      (buffer-file-name (window-buffer w)))))))
-  "*Value is a predicate function which determines which windows' contexts
-are saved.  When the `save-context' command is invoked, this function will
-be called once for each existing Emacs window.  The function should accept
-one argument which will be a window object, and should return non-nil if
-the window's context should be saved.")
-
-
-;; kill-emacs' function definition must be saved
-(if (not (fboundp 'just-kill-emacs))
-    (fset 'just-kill-emacs (symbol-function 'kill-emacs)))
-
-;; Make Emacs call recover-context at startup if appropriate.
-(setq top-level
-      (list 'let '((starting-up (not command-line-processed)))
-	    (list 'prog1
-		  top-level
-		  '(and starting-up auto-save-and-recover-context
-			(null (cdr command-line-args)) (recover-context)))))
-
-(defun kill-emacs (&optional query)
-  "End this Emacs session.
-Prefix ARG or optional first ARG non-nil means exit with no questions asked,
-even if there are unsaved buffers.  If Emacs is running non-interactively
-and ARG is an integer, then Emacs exits with ARG as its exit code.
-
-If the variable `auto-save-and-restore-context' is non-nil,
-the function save-context will be called first."
-  (interactive "P")
-  ;; check the purify flag.  try to save only if this is a dumped Emacs.
-  ;; saving context from a undumped Emacs caused a NULL pointer to be
-  ;; referenced through.  I'm not sure why.
-  (if (and auto-save-and-recover-context (null purify-flag))
-      (save-context))
-  (just-kill-emacs query))
-
-(defun save-context ()
-  "Save context of all Emacs windows (files visited and position of point).
-The information goes into a file called .emacs_ in the directory
-where the Emacs session was started.  The context can be recovered with the
-`recover-context' command, provided you are in the same directory where
-the context was saved.
-
-If the variable `save-buffer-context' is non-nil, the context of all buffers
-visiting files will be saved as well.
-
-Window sizes and shapes are not saved, since these may not be recoverable
-on terminals with a different number of rows and columns."
-  (interactive)
-  (condition-case error-data
-      (let (context-buffer mark save-file-name)
-	(setq save-file-name (concat (original-working-directory)
-				     ".emacs_" (user-login-name)))
-	(if (not (file-writable-p save-file-name))
-	    (if (file-writable-p (original-working-directory))
-		(error "context is write-protected, %s" save-file-name)
-	      (error "can't access directory, %s"
-		     (original-working-directory))))
-	;;
-	;; set up a buffer for the saved context information
-	;; Note that we can't set the visited file yet, because by
-	;; giving the buffer a file to visit we are making it
-	;; eligible to have it's context saved.
-	;;
-	(setq context-buffer (get-buffer-create " *Context Info*"))
-	(set-buffer context-buffer)
-	(erase-buffer)
-	(set-buffer-modified-p nil)
-	;;
-	;; record the context information
-	;;
-	(mapcar
-	 (function
-	  (lambda (w)
-	    (cond ((funcall save-context-predicate w)
-		   (prin1 (buffer-file-name (window-buffer w)) context-buffer)
-		   (princ " " context-buffer)
-		   (prin1 (window-point w) context-buffer)
-		   (princ "\n" context-buffer)))))
-	 (window-list))
-	
-	;;
-	;; nil is the data sentinel.  We will insert it later if we
-	;; need it but for now just remember where the last line of
-	;; window context ended.
-	;;
-	(setq mark (point))
-
-	;;
-	;; If `save-buffer-context' is non-nil we save buffer contexts.
-	;;
-	(if save-buffer-context
-	    (mapcar
-	     (function
-	      (lambda (b)
-		(set-buffer b)
-		(cond (buffer-file-name
-		       (prin1 buffer-file-name context-buffer)
-		       (princ " " context-buffer)
-		       (prin1 (point) context-buffer)
-		       (princ "\n" context-buffer)))))
-	     (buffer-list)))
-
-	;;
-	;; If the context-buffer contains information, we add the version
-	;;   string and sentinels, and write out the saved context.
-	;; If the context-buffer is empty, we don't create a file at all.
-	;; If there's an old saved context in this directory we attempt
-	;;   to delete it.
-	;;
-	(cond ((buffer-modified-p context-buffer)
-	       (set-buffer context-buffer)
-	       (setq buffer-offer-save nil)
-	       ;; sentinel for EOF
-	       (insert "nil\n")
-	       ;; sentinel for end of window contexts
-	       (goto-char mark)
-	       (insert "nil\n")
-	       ;; version string
-	       (goto-char (point-min))
-	       (prin1 save-context-version context-buffer)
-	       (insert "\n\n")
-	       ;; so kill-buffer won't need confirmation later
-	       (set-buffer-modified-p nil)
-	       ;; save it
-	       (write-region (point-min) (point-max) save-file-name
-			     nil 'quiet))
-	      (t (condition-case data
-		     (delete-file save-file-name) (error nil))))
-
-	(kill-buffer context-buffer))
-    (error nil)))
-
-(defun recover-context ()
-  "Recover an Emacs context saved by `save-context' command.
-Files that were visible in windows when the context was saved are visited and
-point is set in each window to what is was when the context was saved."
-  (interactive)
-  (condition-case error-data
-      ;;
-      ;; Set up some local variables.
-      ;;
-      (let (sexpr context-buffer recover-file-name)
-	(setq recover-file-name (concat (original-working-directory)
-					".emacs_" (user-login-name)))
-	(if (not (file-readable-p recover-file-name))
-	    (error "can't access context, %s" recover-file-name))
-	;;
-	;; create a temp buffer and copy the saved context into it.
-	;;
-	(setq context-buffer (get-buffer-create " *Recovered Context*"))
-	(set-buffer context-buffer)
-	(erase-buffer)
-	(insert-file-contents recover-file-name nil)
-	;; so kill-buffer won't need confirmation later
-	(set-buffer-modified-p nil)
-	;;
-	;; If it's empty forget it.
-	;;
-	(if (zerop (buffer-size))
-	    (error "context file is empty, %s" recover-file-name))
-	;;
-	;; check the version and make sure it matches ours
-	;;
-	(setq sexpr (read context-buffer))
-	(if (not (equal sexpr save-context-version))
-	    (error "version string incorrect, %s" sexpr))
-	;;
-	;; Recover the window contexts
-	;;
-	(while (setq sexpr (read context-buffer))
-	  (select-window (get-largest-window))
-	  (if (buffer-file-name)
-	      (split-window))
-	  (other-window 1)
-	  (find-file sexpr)
-	  (goto-char (read context-buffer)))
-	;;
-	;; Recover buffer contexts, if any.
-	;;
-	(while (setq sexpr (read context-buffer)
-                     point (read context-buffer))
-	  (set-buffer (find-file-noselect sexpr t))
-	  (if (zerop (buffer-size))
-	      (kill-buffer (current-buffer))
-	    (goto-char point)))
-	(bury-buffer "*scratch*")
-	(kill-buffer context-buffer)
-	t )
-    (error nil)))
-	 
-(defun original-working-directory ()
-  (save-excursion
-    (set-buffer (get-buffer-create "*scratch*"))
-    default-directory))
diff --git a/xemacs-packages/lisp/edit-utils/savehist.el b/xemacs-packages/lisp/edit-utils/savehist.el
deleted file mode 100644
index b9b0c54a..00000000
--- a/xemacs-packages/lisp/edit-utils/savehist.el
+++ /dev/null
@@ -1,375 +0,0 @@
-;;; savehist.el --- Save minibuffer history.
-
-;; Copyright (C) 1997,2005 Free Software Foundation
-
-;; Author: Hrvoje Niksic 
-;; Keywords: minibuffer
-;; Version: 23
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Many editors (e.g. Vim) have the feature of saving minibuffer
-;; history to an external file after exit.  This package provides the
-;; same feature in Emacs.  When set up, it saves recorded minibuffer
-;; histories to a file (`~/.emacs-history' by default).  Additional
-;; variables may be specified by customizing
-;; `savehist-additional-variables'.
-
-;; To use savehist, turn on savehist-mode by putting the following in
-;; `~/.emacs':
-;;
-;;     (savehist-mode 1)
-;;
-;; or with customize: `M-x customize-option RET savehist-mode RET'.
-;;
-;; You can also explicitly save history with `M-x savehist-save' and
-;; load it by loading the `savehist-file' with `M-x load-file'.
-
-;; If you are using a version of Emacs that does not ship with this
-;; package, be sure to have `savehist.el' in a directory that is in
-;; your load-path, and to byte-compile it.
-
-;;; Code:
-
-(require 'custom)
-(eval-when-compile
-  (require 'cl))
-
-;; User variables
-
-(defgroup savehist nil
-  "Save minibuffer history."
-  :group 'minibuffer)
-
-;;;###autoload
-(defcustom savehist-mode nil
-  "Mode for automatic saving of minibuffer history.
-Set this by calling the `savehist-mode' function or using the customize
-interface."
-  :type 'boolean
-  :set (lambda (symbol value) (savehist-mode (or value 0)))
-  :initialize 'custom-initialize-default
-  :require 'savehist
-  :group 'savehist)
-
-(defcustom savehist-save-minibuffer-history t
-  "*If non-nil, save all recorded minibuffer histories.
-If you want to save only specific histories, use `savehist-save-hook' to
-modify the value of `savehist-minibuffer-history-variables'."
-  :type 'boolean
-  :group 'savehist)
-
-(defcustom savehist-additional-variables ()
-  "*List of additional variables to save.
-Each element is a symbol whose value will be persisted across Emacs
-sessions that use savehist.  The contents of variables should be
-printable with the Lisp printer.  You don't need to add minibuffer
-history variables to this list, all minibuffer histories will be
-saved automatically as long as `savehist-save-minibuffer-history' is
-non-nil.
-
-User options should be saved with the customize interface.  This
-list is useful for saving automatically updated variables that are not
-minibuffer histories, such as `compile-command' or `kill-ring'."
-  :type '(repeat variable)
-  :group 'savehist)
-
-(defcustom savehist-file
-  (cond
-   ;; Backward compatibility with previous versions of savehist.
-   ((file-exists-p "~/.emacs-history") "~/.emacs-history")
-   ((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/"))
-    "~/.emacs.d/history")
-   ((and (featurep 'xemacs) (file-directory-p "~/.xemacs/"))
-    "~/.xemacs/history")
-   ;; For users without `~/.emacs.d/' or `~/.xemacs/'.
-   (t "~/.emacs-history"))
-  "*File name where minibuffer history is saved to and loaded from.
-The minibuffer history is a series of Lisp expressions loaded
-automatically when `savehist-mode' is turned on.  See `savehist-mode'
-for more details.
-
-If you want your minibuffer history shared between Emacs and XEmacs,
-customize this value and make sure that `savehist-coding-system' is
-set to a coding system that exists in both emacsen."
-  :type 'file
-  :group 'savehist)
-
-(defcustom savehist-file-modes #o600
-  "*Default permissions of the history file.
-This is decimal, not octal.  The default is 384 (0600 in octal).
-Set to nil to use the default permissions that Emacs uses, typically
-mandated by umask.  The default is a bit more restrictive to protect
-the user's privacy."
-  :type 'integer
-  :group 'savehist)
-
-(defcustom savehist-autosave-interval (* 5 60)
-  "*The interval between autosaves of minibuffer history.
-If set to nil, disables timer-based autosaving."
-  :type 'integer
-  :group 'savehist)
-
-(defcustom savehist-save-hook nil
-  "Hook called by `savehist-save' before saving the variables.
-You can use this hook to influence choice and content of variables to
-save."
-  :type 'hook)
-
-;; This should be capable of representing characters used by Emacs.
-;; We prefer UTF-8 over ISO 2022 because it is well-known outside
-;; Mule.  XEmacs prir to 21.5 had UTF-8 provided by an external
-;; package which may not be loaded, which is why we check for version.
-(defvar savehist-coding-system (if (and (featurep 'xemacs)
-					(<= emacs-major-version 21)
-					(< emacs-minor-version 5))
-				   'iso-2022-8 'utf-8)
-  "The coding system savehist uses for saving the minibuffer history.
-Changing this value while Emacs is running is supported, but considered
-unwise, unless you know what you are doing.")
-
-;; Internal variables.
-
-(defvar savehist-timer nil)
-
-(defvar savehist-last-checksum nil)
-
-(defvar savehist-minibuffer-history-variables nil
-  "List of minibuffer histories.
-The contents of this variable is built while Emacs is running, and saved
-along with minibuffer history.  You can change its value off
-`savehist-save-hook' to influence which variables are saved.")
-
-;; Coding system without any conversion, used for calculating an
-;; internal checksum.  Should be as fast as possible, ideally simply
-;; exposing the internal representation of buffer text.
-(defconst savehist-no-conversion (if (featurep 'xemacs) 'binary 'no-conversion))
-
-;; Whether the history has already been loaded.  This prevents
-;; toggling savehist-mode from destroying existing minibuffer history.
-(defvar savehist-loaded nil)
-
-(when (featurep 'xemacs)
-  ;; Must declare this under XEmacs, which doesn't have built-in
-  ;; minibuffer history truncation.
-  (defvar history-length 100))
-
-;; Functions.
-
-;;;###autoload
-(defun savehist-mode (arg)
-  "Toggle savehist-mode.
-Positive ARG turns on `savehist-mode'.  When on, savehist-mode causes
-minibuffer history to be saved periodically and when exiting Emacs.
-When turned on for the first time in an Emacs session, it causes the
-previous minibuffer history to be loaded from `savehist-file'.
-
-This mode should normally be turned on from your Emacs init file.
-Calling it at any other time replaces your current minibuffer histories,
-which is probably undesirable."
-  (interactive "P")
-  (setq savehist-mode
-	(if (null arg)
-	    (not savehist-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (if (not savehist-mode)
-      (savehist-uninstall)
-    (when (and (not savehist-loaded)
-	       (file-exists-p savehist-file))
-      (condition-case errvar
-	  (progn
-	    ;; Don't set coding-system-for-read -- we rely on the
-	    ;; coding cookie to convey that information.  That way, if
-	    ;; the user changes the value of savehist-coding-system,
-	    ;; we can still correctly load the old file.
-	    (load savehist-file nil (not (interactive-p)))
-	    (setq savehist-loaded t))
-	(error
-	 ;; Don't install the mode if reading failed.  Doing so would
-	 ;; effectively destroy the user's data at the next save.
-	 (setq savehist-mode nil)
-	 (savehist-uninstall)
-	 (signal (car errvar) (cdr errvar)))))
-    (savehist-install))
-  ;; Return the new setting.
-  savehist-mode)
-(add-minor-mode 'savehist-mode "")
-
-(defun savehist-load ()
-  "Obsolete function provided for transition from old versions of savehist.
-Don't call this from new code, use (savehist-mode 1) instead.
-
-This function loads the variables stored in `savehist-file' and turns on
-savehist-mode.  If savehist-file is in the old format that doesn't record
-the value of `savehist-minibuffer-history-variables', that value is
-deducted from the contents of the file."
-  (savehist-mode 1)
-  ;; Old versions of savehist distributed with XEmacs didn't save
-  ;; savehist-minibuffer-history-variables.  If that variable is nil
-  ;; after loading the file, try to intuit the intended value.
-  (when (null savehist-minibuffer-history-variables)
-    (setq savehist-minibuffer-history-variables
-          (with-temp-buffer
-	    (ignore-errors
-	      (insert-file-contents savehist-file))
-            (let ((vars ()) form)
-              (while (setq form (condition-case nil
-				    (read (current-buffer)) (error nil)))
-		;; Each form read is of the form (setq VAR VALUE).
-		;; Collect VAR, i.e. (nth form 1).
-                (push (nth 1 form) vars))
-              vars)))))
-(make-obsolete 'savehist-load 'savehist-mode)
-
-(defun savehist-install ()
-  "Hook savehist into Emacs.
-Normally invoked by calling `savehist-mode' to set the minor mode.
-Installs `savehist-autosave' in `kill-emacs-hook' and on a timer.   To
-undo this, call `savehist-uninstall'."
-  (add-hook 'minibuffer-setup-hook 'savehist-minibuffer-hook)
-  (add-hook 'kill-emacs-hook 'savehist-autosave)
-  ;; Install an invocation of savehist-autosave on a timer.  This
-  ;; should not cause noticeable delays for users -- savehist-autosave
-  ;; executes in under 5 ms on my system.
-  (when (and savehist-autosave-interval
-	     (null savehist-timer))
-    (setq savehist-timer
-	  (if (featurep 'xemacs)
-	      (start-itimer
-	       "savehist" 'savehist-autosave savehist-autosave-interval
-	       savehist-autosave-interval)
-	    (run-with-timer savehist-autosave-interval
-			    savehist-autosave-interval 'savehist-autosave)))))
-
-(defun savehist-uninstall ()
-  "Undo installing savehist.
-Normally invoked by calling `savehist-mode' to unset the minor mode."
-  (remove-hook 'minibuffer-setup-hook 'savehist-minibuffer-hook)
-  (remove-hook 'kill-emacs-hook 'savehist-autosave)
-  (when savehist-timer
-    (if (featurep 'xemacs)
-	(delete-itimer savehist-timer)
-      (cancel-timer savehist-timer))
-    (setq savehist-timer nil)))
-
-(defun savehist-save (&optional auto-save)
-  "Save the values of minibuffer history variables.
-Unbound symbols referenced in `savehist-additional-variables' are ignored.
-If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
- and don't save the buffer if they are the same."
-  (interactive)
-  (with-temp-buffer
-    (insert
-     (format ";; -*- mode: emacs-lisp; coding: %s -*-\n" savehist-coding-system)
-     ";; Minibuffer history file, automatically generated by `savehist'.\n\n")
-    (run-hooks 'savehist-save-hook)
-    (let ((print-length nil)
-	  (print-string-length nil)
-	  (print-level nil)
-	  (print-readably t)
-	  (print-quoted t))
-      ;; Save the minibuffer histories, along with the value of
-      ;; savehist-minibuffer-history-variables itself.
-      (when savehist-save-minibuffer-history
-	(prin1 `(setq savehist-minibuffer-history-variables
-		      ',savehist-minibuffer-history-variables)
-	       (current-buffer))
-	(insert ?\n)
-	(dolist (symbol savehist-minibuffer-history-variables)
-	  (when (boundp symbol)
-	    (let ((value (savehist-trim-history (symbol-value symbol))))
-	      (when value		; don't save empty histories
-		(prin1 `(setq ,symbol ',value) (current-buffer))
-		(insert ?\n))))))
-      ;; Save the additional variables.
-      (dolist (symbol savehist-additional-variables)
-	(when (boundp symbol)
-	  (let ((value (symbol-value symbol)))
-	    (when (savehist-printable value)
-	      (prin1 `(setq ,symbol ',value) (current-buffer))
-	      (insert ?\n))))))
-    ;; If autosaving, avoid writing if nothing has changed since the
-    ;; last write.
-    (let ((checksum (md5 (current-buffer) nil nil savehist-no-conversion)))
-      (unless (and auto-save (equal checksum savehist-last-checksum))
-	;; Set file-precious-flag when saving the buffer because we
-	;; don't want a half-finished write ruining the entire
-	;; history.  Remember that this is run from a timer and from
-	;; kill-emacs-hook, and also that multiple Emacs instances
-	;; could write to this file at once.
-	(let ((file-precious-flag t)
-	      (coding-system-for-write savehist-coding-system))
-	  (write-region (point-min) (point-max) savehist-file nil
-			(unless (interactive-p) 'quiet)))
-	(when savehist-file-modes
-	  (set-file-modes savehist-file savehist-file-modes))
-	(setq savehist-last-checksum checksum)))))
-
-(defun savehist-autosave ()
-  "Save the minibuffer history if it has been modified since the last save.
-Does nothing if savehist-mode is off."
-  (when savehist-mode
-    (savehist-save t)))
-
-(defun savehist-trim-history (value)
-  ;; Retain only the first history-length items in VALUE.  Only used
-  ;; under XEmacs, which doesn't (yet) implement automatic trimming of
-  ;; history lists to history-length items.
-  (if (and (featurep 'xemacs)
-	   (natnump history-length)
-	   (> (length value) history-length))
-      ;; Equivalent to `(subseq value 0 history-length)', but doesn't
-      ;; need cl-extra at run-time.
-      (loop repeat history-length collect (pop value))
-    value))
-
-(defun savehist-printable (value)
-  "Return non-nil if VALUE is printable."
-  (cond
-   ;; Quick response for oft-encountered types known to be printable.
-   ((stringp value))
-   ((numberp value))
-   ((symbolp value))
-   (t
-    ;; For others, check explicitly.
-    (with-temp-buffer
-      (condition-case nil
-	  (let ((print-readably t) (print-level nil))
-	  ;; Print the value into a buffer...
-	  (prin1 value (current-buffer))
-	  ;; ...and attempt to read it.
-	  (read (point-min-marker))
-	  ;; The attempt worked: the object is printable.
-	  t)
-	;; The attempt failed: the object is not printable.
-	(error nil))))))
-
-(defun savehist-minibuffer-hook ()
-  ;; XEmacs sets minibuffer-history-variable to t to mean "no history
-  ;; is being recorded".
-  (unless (eq minibuffer-history-variable t)
-    (add-to-list 'savehist-minibuffer-history-variables
-		 minibuffer-history-variable)))
-
-(provide 'savehist)
-
-;; arch-tag: b3ce47f4-c5ad-4ebc-ad02-73aba705cf9f
-
-;;; savehist.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/saveplace.el b/xemacs-packages/lisp/edit-utils/saveplace.el
deleted file mode 100644
index 385479e2..00000000
--- a/xemacs-packages/lisp/edit-utils/saveplace.el
+++ /dev/null
@@ -1,243 +0,0 @@
-;;; saveplace.el --- automatically save place in files
-
-;; Copyright (C) 1993, 1994, 2001 Free Software Foundation, Inc.
-
-;; Author: Karl Fogel 
-;; Maintainer: FSF
-;; Created: July, 1993
-;; Keywords: bookmarks, placeholders
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Emacs 21.2
-
-;;; Commentary:
-
-;; Automatically save place in files, so that visiting them later
-;; (even during a different Emacs session) automatically moves point
-;; to the saved position, when the file is first found.  Uses the
-;; value of buffer-local variable save-place to determine whether to
-;; save position or not.
-;;
-;; Thanks to Stefan Schoef, who sent a patch with the
-;; `save-place-version-control' stuff in it.
-
-;;; Code:
-
-;; this is what I was using during testing:
-;; (define-key ctl-x-map "p" 'toggle-save-place)
-
-(defgroup save-place nil
-  "Automatically save place in files."
-  :group 'data)
-
-
-(defvar save-place-alist nil
-  "Alist of saved places to go back to when revisiting files.
-Each element looks like (FILENAME . POSITION);
-visiting file FILENAME goes automatically to position POSITION
-rather than the beginning of the buffer.
-This alist is saved between Emacs sessions.")
-
-(defcustom save-place nil
-  "*Non-nil means automatically save place in each file.
-This means when you visit a file, point goes to the last place
-where it was when you previously visited the same file.
-This variable is automatically buffer-local.
-
-If you wish your place in any file to always be automatically saved,
-simply put this in your `~/.emacs' file:
-
-\(setq-default save-place t\)"
-  :type 'boolean
-  :require 'saveplace
-  :group 'save-place)
-
-(make-variable-buffer-local 'save-place)
-
-(defcustom save-place-file (convert-standard-filename "~/.emacs-places")
-  "*Name of the file that records `save-place-alist' value."
-  :type 'file
-  :group 'save-place)
-
-(defcustom save-place-version-control nil
-  "*Controls whether to make numbered backups of master save-place file.
-It can have four values: t, nil, `never', and `nospecial'.  The first
-three have the same meaning that they do for the variable
-`version-control', and the final value `nospecial' means just use the
-value of `version-control'."
-  :type '(radio (const :tag "Unconditionally" t)
-		(const :tag "For VC Files" nil)
-		(const never)
-		(const :tag "Use value of `version-control'" nospecial))
-  :group 'save-place)
-
-(defvar save-place-loaded nil
-  "Non-nil means that the `save-place-file' has been loaded.")
-
-(defcustom save-place-limit nil
-  "Maximum number of entries to retain in the list; nil means no limit."
-  :type '(choice (integer :tag "Entries" :value 1)
-		 (const :tag "No Limit" nil))
-  :group 'save-place)
-
-(defun toggle-save-place (&optional parg)
-  "Toggle whether to save your place in this file between sessions.
-If this mode is enabled, point is recorded when you kill the buffer
-or exit Emacs.  Visiting this file again will go to that position,
-even in a later Emacs session.
-
-If called with a prefix arg, the mode is enabled if and only if
-the argument is positive.
-
-To save places automatically in all files, put this in your `.emacs' file:
-
-\(setq-default save-place t\)"
-  (interactive "P")
-  (if (not buffer-file-name)
-      (message "Buffer `%s' not visiting a file" (buffer-name))
-    (if (and save-place (or (not parg) (<= parg 0)))
-	(progn
-	  (message "No place will be saved in this file")
-	  (setq save-place nil))
-      (message "Place will be saved")
-      (setq save-place t))))
-
-(defun save-place-to-alist ()
-  ;; put filename and point in a cons box and then cons that onto the
-  ;; front of the save-place-alist, if save-place is non-nil.
-  ;; Otherwise, just delete that file from the alist.
-  ;; first check to make sure alist has been loaded in from the master
-  ;; file.  If not, do so, then feel free to modify the alist.  It
-  ;; will be saved again when Emacs is killed.
-  (or save-place-loaded (load-save-place-alist-from-file))
-  (if buffer-file-name
-      (progn
-        (let ((cell (assoc buffer-file-name save-place-alist))
-	      (position (if (not (eq major-mode 'hexl-mode))
-			    (point)
-			  (1+ (hexl-current-address)))))
-          (if cell
-              (setq save-place-alist (delq cell save-place-alist)))
-	  (if (and save-place
-		   (not (= position 1)))  ;; Optimize out the degenerate case.
-            (setq save-place-alist
-		    (cons (cons buffer-file-name position)
-			  save-place-alist)))))))
-
-(defun save-place-alist-to-file ()
-  (let ((file (expand-file-name save-place-file)))
-    (save-excursion
-      (message "Saving places to %s..." file)
-      (set-buffer (get-buffer-create " *Saved Places*"))
-      (delete-region (point-min) (point-max))
-      (print save-place-alist (current-buffer))
-      (let ((version-control
-	     (cond
-	      ((null save-place-version-control) nil)
-	      ((eq 'never save-place-version-control) 'never)
-	      ((eq 'nospecial save-place-version-control) version-control)
-	      (t
-	       t))))
-	(write-file file)
-	(kill-buffer (current-buffer))
-	(message "Saving places to %s...done" file)))))
-
-(defun load-save-place-alist-from-file ()
-  (if (not save-place-loaded)
-      (progn
-        (setq save-place-loaded t)
-        (let ((file (expand-file-name save-place-file)))
-          ;; make sure that the alist does not get overwritten, and then
-          ;; load it if it exists:
-          (if (file-readable-p file)
-              (save-excursion
-                (message "Loading places from %s..." save-place-file)
-                ;; don't want to use find-file because we have been
-                ;; adding hooks to it.
-                (set-buffer (get-buffer-create " *Saved Places*"))
-                (delete-region (point-min) (point-max))
-                (insert-file-contents file)
-                (goto-char (point-min))
-                (setq save-place-alist 
-                      (car (read-from-string
-                            (buffer-substring (point-min) (point-max)))))
-
-		;; If there is a limit, and we're over it, then we'll
-		;; have to truncate the end of the list:
-		(if save-place-limit
-		    (if (<= save-place-limit 0)
-			;; Zero gets special cased.  I'm not thrilled
-			;; with this, but the loop for >= 1 is tight.
-			(setq save-place-alist nil)
-		      ;; Else the limit is >= 1, so enforce it by
-		      ;; counting and then `setcdr'ing.
-		      (let ((s save-place-alist)
-			    (count 1))
-			(while s
-			  (if (>= count save-place-limit)
-			      (setcdr s nil)
-			    (setq count (1+ count)))
-			  (setq s (cdr s))))))
-                  
-                (kill-buffer (current-buffer))
-                (message "Loading places from %s...done" file)))
-          nil))))
-
-(defun save-places-to-alist ()
-  ;; go through buffer-list, saving places to alist if save-place is
-  ;; non-nil, deleting them from alist if it is nil.
-  (let ((buf-list (buffer-list)))
-    (while buf-list
-      ;; put this into a save-excursion in case someone is counting on
-      ;; another function in kill-emacs-hook to act on the last buffer
-      ;; they were in:
-      (save-excursion
-	(set-buffer (car buf-list))
-	;; save-place checks buffer-file-name too, but we can avoid
-	;; overhead of function call by checking here too.
-	(and buffer-file-name (save-place-to-alist))
-	(setq buf-list (cdr buf-list))))))
-
-(defun save-place-find-file-hook ()
-  (or save-place-loaded (load-save-place-alist-from-file))
-  (let ((cell (assoc buffer-file-name save-place-alist)))
-    (if cell
-	(progn
-	  (or after-find-file-from-revert-buffer
-	      (goto-char (cdr cell)))
-	  ;; and make sure it will be saved again for later
-	  (setq save-place t)))))
-
-(defun save-place-kill-emacs-hook ()
-  ;; First update the alist.  This loads the old save-place-file if nec.
-  (save-places-to-alist)
-  ;; Now save the alist in the file, if we have ever loaded the file
-  ;; (including just now).
-  (if save-place-loaded
-      (save-place-alist-to-file)))
-
-(add-hook 'find-file-hooks 'save-place-find-file-hook t)
-
-(add-hook 'kill-emacs-hook 'save-place-kill-emacs-hook)
-
-(add-hook 'kill-buffer-hook 'save-place-to-alist)
-
-(provide 'saveplace) ; why not...
-
-;;; saveplace.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/scroll-in-place.el b/xemacs-packages/lisp/edit-utils/scroll-in-place.el
deleted file mode 100644
index e9a17afa..00000000
--- a/xemacs-packages/lisp/edit-utils/scroll-in-place.el
+++ /dev/null
@@ -1,1588 +0,0 @@
-
-;;;; -*-Emacs-Lisp-*- Improved Vertical Scrolling Commands
-;;;; Written by Eric Eide, last modified on 1994/11/18 21:23:01.
-;;;; (C) Copyright 1993, 1994, Eric Eide and the University of Utah
-;;;;
-;;;; 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 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 GNU Emacs.  If you did not, write to the Free Software Foundation,
-;;;; Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;;; AUTHORS
-;;;;
-;;;; This package was written by Eric Eide (eeide@cs.utah.edu) and was based on
-;;;; a very similar package ("scroll-fix") by Joe Wells.  Almost all of the
-;;;; code in this file is original, but I owe a great debt to Mr. Wells for his
-;;;; ideas and his original implementation.
-;;;;
-;;;;   Eric Eide (eeide@cs.utah.edu)
-;;;;   University of Utah
-;;;;   3190 Merrill Engineering Building
-;;;;   Salt Lake City, Utah  84112
-;;;;
-;;;;   Joe Wells (jbw@cs.bu.edu)
-;;;;
-;;;; Joe Wells' "scroll-fix" package is Copyright (C) 1988, 1989, and 1991 by
-;;;; the Free Software Foundation.  It is distributed under the terms of the
-;;;; GNU General Public License.
-
-;;;; LISP CODE DIRECTORY INFORMATION
-;;;;
-;;;; LCD Archive Entry:
-;;;; scroll-in-place|Eric Eide|eeide@cs.utah.edu|
-;;;; Improved vertical scrolling commands|
-;;;; 1994/11/18 21:23:01|1.3|~/misc/scroll-in-place.el.Z|
-
-;;;; SUMMARY
-;;;;
-;;;; This package provides improved vertical scrolling commands for GNU Emacs.
-;;;; These new commands offer the following features:
-;;;;
-;;;; + When a scrolling command is executed, GNU Emacs tries to keep point as
-;;;;   close as possible to its original window position (window line and
-;;;;   column).  This is what "scroll in place" means: point stays "in place"
-;;;;   within the window.  (There are times when point must be moved from its
-;;;;   original window position in order to execute the scroll; see below.)
-;;;;
-;;;;   The variable `scroll-in-place', which is true by default, determines
-;;;;   whether or not the standard GNU Emacs scrolling commands (`scroll-down',
-;;;;   `scroll-up', `scroll-other-window-down', and `scroll-other-window') use
-;;;;   the "in place" features listed here.  When `scroll-in-place' is `nil'
-;;;;   the standard GNU Emacs scrolling commands essentially just call the
-;;;;   original versions of themselves.  (Note that even when `scroll-in-place'
-;;;;   is `nil' the new versions of `scroll-down' and `scroll-up' have slightly
-;;;;   different behavior when a minibuffer window is the selected window.  See
-;;;;   below.)
-;;;;
-;;;;   It is possible to turn off (or turn on) "in place" scrolling for certain
-;;;;   buffers by making buffer-local bindings of the variable `scroll-in-
-;;;;   place' for those buffers.  The variable `scroll-in-place' is not usually
-;;;;   buffer-local, but you can make it so if you desire.
-;;;;
-;;;; + Because the improved scrolling commands keep point at its original
-;;;;   window position, these scrolling commands are "reversible."  The
-;;;;   `scroll-up' command undoes the effect of the immediately previous
-;;;;   `scroll-down' command (if any) and vice versa.  In other words, if you
-;;;;   scroll up and then immediately scroll back down, the window config-
-;;;;   uration is restored to its exact original state.  This allows you to
-;;;;   browse through a buffer more easily, as you can always get back to the
-;;;;   original configuration.
-;;;;
-;;;;   Note, however, that the improved scrolling commands are guaranteed to be
-;;;;   reversible only if there are no intervening non-scrolling commands.
-;;;;   Also, if you give a prefix argument to a scrolling command (in order to
-;;;;   specify the number of lines to scroll by), previous scrolling commands
-;;;;   may no longer be reversible.  More specifically, if the new prefix
-;;;;   argument has a different magnitude than the previous scrolling distance,
-;;;;   then any previous scrolling commands are not reversible.  The new prefix
-;;;;   argument takes precedence.
-;;;;
-;;;;   You might find it useful to think of the scrolling commands as forming
-;;;;   "chains."  A scrolling command either starts or continues a chain.  By
-;;;;   issuing a non-scrolling command or by changing the number of lines to be
-;;;;   scrolled, you break the chain.  (Note that simply changing the scrolling
-;;;;   direction won't break the chain; changing the absolute number of lines
-;;;;   to be scrolled is what breaks the chain.)  Scrolling commands are
-;;;;   guaranteed to be reversible only within the current chain.  Hopefully
-;;;;   that's clear enough.
-;;;;
-;;;; + When a scrolling command is given a prefix argument (which specifies the
-;;;;   number of lines to scroll by), then that argument becomes the default
-;;;;   scrolling distance for all immediately subsequent scrolling commands.
-;;;;   This means that you can easily set the scrolling distance for a chain
-;;;;   of scrolling commands.  Note that a new prefix argument or any non-
-;;;;   scrolling command breaks the chain (as described above), and any further
-;;;;   scrolling commands will use the usual defaults (or the prefix argument
-;;;;   you specify at that time, of course).
-;;;;
-;;;;   However, there are cases in which one doesn't want the current scrolling
-;;;;   command to use the default scrolling distance that was set by the
-;;;;   previous scrolling command.  For example, suppose that you had special
-;;;;   commands that scrolled one line up and one line down.  When you invoke
-;;;;   one of these commands, the "in place" scrolling routines set the default
-;;;;   scrolling distance to be just one line.  Now suppose that you use one of
-;;;;   your special commands and then immediately invoke `scroll-up' (`C-v'),
-;;;;   expecting it to scroll by a near windowful of text.  You would be
-;;;;   disappointed --- because the previous command set the default scrolling
-;;;;   distance to be just one line, `scroll-up' just scrolls by one line.
-;;;;
-;;;;   To solve this problem, "scroll-in-place" allows you to divide scrolling
-;;;;   commands into separate "groups."  Commands in a group can only form
-;;;;   chains with (and therefore, inherit defaults from) commands in the same
-;;;;   group.  (Note that no command can be in more than one group.)  If you
-;;;;   invoke a scrolling command that is not in the same group as that of the
-;;;;   immediately previous scrolling command, then the previous chain is
-;;;;   broken and you start a new chain --- with a new set of defaults.
-;;;;
-;;;;   So to solve the problem described above, you could put your one-line
-;;;;   scrolling commands in their own group.  Once that is done, the standard
-;;;;   scrolling commands will not form chains with your one-line scrolling
-;;;;   commands, and therefore will not use the default scrolling distance set
-;;;;   by those commands.  Problem solved!
-;;;;
-;;;;   By default, all "in place" scrolling commands are in a single group.  If
-;;;;   you want to partition some commands into separate groups, you must do
-;;;;   that yourself *before* any "in place" commands are invoked.  For more
-;;;;   information about grouping commands, see the documentation for the
-;;;;   variables `scroll-command-groups' and `scroll-default-command-group'.
-;;;;
-;;;; + The improved scrolling commands will avoid displaying empty lines past
-;;;;   the end of the buffer when possible.  In other words, just as you can't
-;;;;   see "dead space" before the beginning of the buffer text, the new
-;;;;   scrolling commands try to avoid displaying "dead space" past the end of
-;;;;   the buffer text.  This behavior is somewhat configurable; see the
-;;;;   documentation for the variable `scroll-allow-blank-lines-past-eob'.
-;;;;
-;;;;   Dead space will be displayed if it is necessary in order to make a
-;;;;   previous scrolling action reversible, however.
-;;;;
-;;;; + If the scrolling commands cannot keep point at its initial window
-;;;;   position (because a buffer boundary is on screen and the window can't be
-;;;;   scrolled as far as necessary to keep point at the right place), point is
-;;;;   allowed to temporarily stray from its initial window position.  That is,
-;;;;   point moves the correct number of window lines, even if it means that it
-;;;;   has to stray from its desired window position.  This straying is undone
-;;;;   when (and if) the scrolling action is reversed.
-;;;;
-;;;; + If a scrolling command tries to move point past a buffer boundary, point
-;;;;   is instead moved to the boundary (the beginning or the end of the buffer
-;;;;   as appropriate) and an appropriate message is displayed.  This motion is
-;;;;   reversible, of course.
-;;;;
-;;;;   However, if point was already at the buffer boundary when the scrolling
-;;;;   command was invoked, the command signals an appropriate error instead.
-;;;;
-;;;; + When a minibuffer window is the selected window, the new versions of
-;;;;   `scroll-up' and `scroll-down' either scroll the window in the variable
-;;;;   `minibuffer-scroll-window' (which is usually the window of completions)
-;;;;   or the `next-window' if there is no `minibuffer-scroll-window'.  This is
-;;;;   usually much more useful than scrolling the minibuffer itself.  (Note
-;;;;   that this feature is available even when the variable `scroll-in-place'
-;;;;   is `nil'.)
-;;;;
-;;;; + When a scrolling command is scrolling a window other than the selected
-;;;;   window, it will signal an appropriate buffer boundary error if the
-;;;;   window cannot be scrolled (because the appropriate buffer boundary is
-;;;;   already visible).  This means that an error is signalled even in cases
-;;;;   that would be allowed (by "straying" point or by moving it to the buffer
-;;;;   boundary) if the window were selected.
-;;;;
-;;;;   (If an error were not signalled in these cases, then there would be many
-;;;;   cases in which the last scroll in a particular direction would appear to
-;;;;   do nothing because only the point position would change --- the
-;;;;   displayed text would stay the same!  To avoid these cases the scrolling
-;;;;   commands signal boundary errors "prematurely" when the window to be
-;;;;   scrolled is not selected.)
-;;;;
-;;;; So how is this package different than Joe Wells' "scroll-fix" package?
-;;;;
-;;;; + This package provides "in place" behavior for the standard GNU Emacs
-;;;;   commands by default; "scroll-fix" does not.
-;;;;
-;;;; + "scroll-fix" behaves differently when the window is near a buffer
-;;;;   boundary.  Instead of allowing point to stray, "scroll-fix" first does
-;;;;   an incomplete scroll (i.e., moves point less than the full distance in
-;;;;   order to keep point at the desired window position) and then pops point
-;;;;   to the buffer boundary.  I think that the behavior of this package is
-;;;;   somewhat move intuitive, especially for small scrolling distances.
-;;;;
-;;;; + The scrolling commands in this package will appropriately signal buffer
-;;;;   boundary errors; the commands in "scroll-fix" never signal boundary
-;;;;   errors.  This makes it difficult to allow "scroll-fix" to replace the
-;;;;   standard `scroll-down' and `scroll-up' commands because some other
-;;;;   packages (e.g., VM and GNUS) expect the scrolling commands to signal
-;;;;   these errors as necessary.
-;;;;
-;;;; + This package handles long lines correctly.  (But see PROBLEMS, below.)
-;;;;
-;;;; + "scroll-fix" handles prefix arguments differently.  In "scroll-fix", a
-;;;;   number-containing prefix argument always breaks any running chain of
-;;;;   scrolling commands.  The prefix argument `-' (the symbol minus,
-;;;;   generated by `C-u -') causes a temporary change in direction --- a
-;;;;   change for only the current command.  In this package, however, a
-;;;;   number-containing prefix argument only breaks a running chain if it has
-;;;;   a different magnitude than the default scrolling distance, and the
-;;;;   prefix argument `-' causes a permanent change in the sign of the default
-;;;;   scrolling distance --- a change visible to immediately subsequent
-;;;;   scrolling commands.
-;;;;
-;;;; + This package keeps track of the set of "in place" scrolling commands
-;;;;   dynamically, in order to detect "chains" of scrolling commands.
-;;;;   "scroll-fix" has a fixed list of scrolling commands, so "scroll-fix"
-;;;;   cannot keep track of some chains.  (Again, "scroll-fix" interacts badly
-;;;;   with VM and GNUS.)  And because "scroll-fix" keeps a static list of
-;;;;   scrolling commands, it is a bad idea to call its "in place" commands
-;;;;   from a program.  This package, because it maintains the information
-;;;;   dynamically, has no such problems.
-;;;;
-;;;; + This package allows one to divide the "in place" scrolling commands into
-;;;;   groups; a command in a group only forms chains with the members of its
-;;;;   group.  "scroll-fix" has no notion of command groups.
-;;;;
-;;;; + This package provides "in place" versions of the standard GNU Emacs
-;;;;   commands `scroll-other-window-down' and `scroll-other-window'.
-;;;;
-;;;; + This package will refuse to scroll non-selected windows (by signalling
-;;;;   an error) when the displayed text would not change, as described in the
-;;;;   feature list above.
-;;;;
-;;;; + When a minibuffer window is selected, this package always scrolls a
-;;;;   window other than the minibuffer.  "scroll-fix" will scroll another
-;;;;   window only if the entire minibuffer contents are visible.
-;;;;
-;;;; + "scroll-fix" provides a command to toggle the "in place" behavior of the
-;;;;   standard GNU Emacs commands.  This package doesn't; you'll have to set
-;;;;   the option manually with the command `set-variable'.
-;;;;
-;;;; + This package has gratuitous variable renaming (insert smile here!):
-;;;;
-;;;;   "scroll-fix" user variable            Equivalent in this package
-;;;;   -----------------------------------------------------------------------
-;;;;   scroll-in-place                       (none)
-;;;;   scroll-in-place-replace-original      scroll-in-place
-;;;;   scroll-in-place-eob-blank-allowed     scroll-allow-blank-lines-past-eob
-;;;;
-;;;; + This package allows programmers to specify the default scrolling
-;;;;   distance (i.e., the default distance used when starting a new chain of
-;;;;   scrolling commands) for custom scrolling commands.
-
-;;;; COMMANDS AND FUNCTIONS
-;;;;
-;;;; This package provides the following "in place" versions of GNU Emacs'
-;;;; standard vertical scrolling commands:
-;;;;
-;;;;   scroll-down-in-place
-;;;;   scroll-up-in-place
-;;;;   scroll-other-window-down-in-place
-;;;;   scroll-other-window-in-place
-;;;;
-;;;; The variable `scroll-in-place', which is true by default, determines
-;;;; whether or not the new versions of the standard GNU Emacs scrolling
-;;;; commands (`scroll-down', `scroll-up', `scroll-other-window-down', and
-;;;; `scroll-other-window') use the "in place" features listed above.  When
-;;;; `scroll-in-place' is `nil' the standard GNU Emacs scrolling commands
-;;;; essentially just call the original versions of themselves.  (Note that
-;;;; even when `scroll-in-place' is `nil' the new versions of `scroll-down' and
-;;;; `scroll-up' have slightly different behavior when a minibuffer window is
-;;;; the selected window.  See the feature list above.)
-;;;;
-;;;; NOTE that this package redefines the standard GNU Emacs commands `scroll-
-;;;; down', `scroll-up', `scroll-other-window-down', and `scroll-other-window'
-;;;; (in order to check the variable `scroll-in-place', as described above).
-;;;; The command `scroll-other-window-down' first appeared as a standard
-;;;; command in the FSF's GNU Emacs 19.26.
-;;;;
-;;;; This package also provides the following functions and variables which are
-;;;; of use to programmers:
-;;;;
-;;;;   scroll-window
-;;;;   scroll-window-in-place
-;;;;   scroll-window-in-place-continue-sequence
-;;;;   scroll-default-lines (variable)
-;;;;   scroll-command-groups (variable)
-;;;;
-;;;; The `scroll-window-in-place' function is the heart of the "in place"
-;;;; scrolling commands.  `scroll-window' is a function that checks the
-;;;; variable `scroll-in-place' and calls the appropriate scrolling function
-;;;; (either `scroll-window-in-place' or one of the original versions of
-;;;; `scroll-down' and `scroll-up').  The function `scroll-window-in-place-
-;;;; continue-sequence' is provided in order to preserve running "chains" of
-;;;; scrolling commands as described above.
-;;;;
-;;;; The variable `scroll-default-lines' determines the default scrolling
-;;;; distance when a new chain of "in place" scrolling commands begins.  If
-;;;; this variable is not a number, then the default distance is the height of
-;;;; the window to be scrolled minus `next-screen-context-lines'.  The variable
-;;;; `scroll-command-groups' contains the explicit groups of "in place"
-;;;; scrolling commands; for more information read the variable documentation.
-
-;;;; YOUR .EMACS FILE
-;;;;
-;;;; To use this package, you simply need to load it from within your ".emacs"
-;;;; file:
-;;;;
-;;;;   (require 'scroll-in-place)
-;;;;
-;;;; By default, this package provides for the standard GNU Emacs vertical
-;;;; scrolling commands (`scroll-down', `scroll-up', `scroll-other-window-
-;;;; down', and `scroll-other-window') to use the "in place" features.  If you
-;;;; would rather not have this, set the variable `scroll-in-place' to `nil':
-;;;;
-;;;;   (setq scroll-in-place nil)
-;;;;
-;;;; When `scroll-in-place' is `nil' you will have to bind keys in order to
-;;;; call the "in place" scrolling commands.  For example, you might want to do
-;;;; the following:
-;;;;
-;;;;   (global-set-key "\M-v" 'scroll-down-in-place)
-;;;;   (global-set-key "\C-v" 'scroll-up-in-place)
-;;;;
-;;;; Sun users should also read the PROBLEMS section, below.
-;;;;
-;;;; ADVANCED CUSTOMIZATION
-;;;;
-;;;; If you want to partition certain "in place" scrolling commands into
-;;;; separate groups, you should do something like the following:
-;;;;
-;;;;   ;; Make one group containing the commands `scroll-down-one-line' and
-;;;;   ;; `scroll-up-one-line'.  (These are not standard GNU Emacs commands.)
-;;;;   (setq scroll-command-groups
-;;;;         (list '(scroll-down-one-line scroll-up-one-line)))
-;;;;
-;;;; You could write the `scroll-down-one-line' command like this:
-;;;;
-;;;;   (defun scroll-down-one-line (arg)
-;;;;     "Scroll down one line, or number of lines specified by prefix arg."
-;;;;     (interactive "P")
-;;;;     (let ((scroll-default-lines 1))
-;;;;       (scroll-down-in-place arg)))
-;;;;
-;;;; If you want to disable "in place" scrolling for windows that display a
-;;;; particular buffer (while leaving it available in other windows), you can
-;;;; make `scroll-in-place' a buffer-local variable for that buffer and then
-;;;; bind that local copy of `scroll-in-place' to `nil'.  This is the kind of
-;;;; thing that one generally does in a major mode hook.  For example, you can
-;;;; disable "in place" scrolling of GNUS article windows with the following
-;;;; code:
-;;;;
-;;;;   (setq gnus-article-mode-hook
-;;;;         (function (lambda ()
-;;;;                     (make-local-variable 'scroll-in-place)
-;;;;                     (setq scroll-in-place nil))))
-;;;;   ;; Set the variable `gnus-Article-mode-hook' instead if you are using
-;;;;   ;; an old version of GNUS, say version 3.13 or 3.14.
-;;;;
-;;;; The variable `scroll-allow-blank-lines-past-eob' can also be made local to
-;;;; particular buffers, if you desire.  (But why would you want to do that?)
-
-;;;; PROBLEMS
-;;;;
-;;;; + It is sometimes difficult for one's eyes to follow an incomplete scroll
-;;;;   (i.e., a scroll in which the text doesn't move as far as one expected),
-;;;;   especially when the scrolled window is not selected (and therefore that
-;;;;   window's point is not highlighted).  One can lose one's place in the
-;;;;   text.
-;;;;
-;;;; + The names `scroll-down-in-place' and `scroll-up-in-place' conflict with
-;;;;   two commands in the GNU Emacs terminal-specific file "term/sun.el".
-;;;;   This means that in order to load this package correctly, Sunterm users
-;;;;   will have to use the hook `term-setup-hook'.  For example, you might put
-;;;;   the following form in your ".emacs" file:
-;;;;
-;;;;   (setq term-setup-hook (function (lambda () (require 'scroll-in-place))))
-;;;;
-;;;;   If this is confusing, get help from your local GNU Emacs guru.
-;;;;
-;;;; + `scroll-determine-goal-column' tries to honor the variable `track-eol'
-;;;;   if it is set.  But when lines are being wrapped we can't move point past
-;;;;   the wrap --- or else it is possible that scrolling won't work correctly.
-;;;;   In short, this package honors `track-eol' as best it can.
-;;;;
-;;;; + `scroll-window-in-place' can become confused when something changes the
-;;;;   window "out from under it."  By "confused" I mean that it is possible
-;;;;   for `scroll-window-in-place' to think that it should continue the
-;;;;   running sequence of "in place" scrolls when it should really probably
-;;;;   start a new sequence.  For example, if a process filter inserts text
-;;;;   into the buffer and moves point, `scroll-window-in-place' loses track of
-;;;;   where point should be and where the window should start.  Commands that
-;;;;   call a "scroll in place" function and then subsequently move point can
-;;;;   also confuse `scroll-window-in-place'.
-;;;;
-;;;;   To correct some of this confusion, `scroll-window-in-place' could keep
-;;;;   track of the final positions of `window-start' and `window-point',
-;;;;   possibly with both markers and character positions.  In my experience
-;;;;   the "in place" scrolling commands are almost never confused (except by
-;;;;   fancy packages that do their own fancy kinds of scrolling, as described
-;;;;   below), so the extra sanity checking isn't worth the effort.  If your
-;;;;   mileage varies let me know.
-;;;;
-;;;; + The "in place" scrolling commands can interact poorly with packages that
-;;;;   provide their own special scrolling commands.  For example, there are
-;;;;   varying degrees of conflict with Rmail, VM, and GNUS.
-;;;;
-;;;;   RMAIL
-;;;;
-;;;;   In the version of Rmail that is part of the FSF's GNU Emacs 19 (19.25
-;;;;   through 19.28 at least), the command `rmail-summary-scroll-msg-down' in
-;;;;   the file "rmailsum.el" fails to work properly when "in place" scrolling
-;;;;   is enabled for the Rmail message buffer.  (The source of the conflict:
-;;;;   the "in place" scrolling commands and Emacs' standard scrolling commands
-;;;;   interpret the argument '- in different ways.)  Fortunately it is easy to
-;;;;   patch Rmail.  Send me mail if you would like to receive a copy of these
-;;;;   patches.
-;;;;
-;;;;   I know of no conflicts between the "in place" scrolling commands and
-;;;;   older versions of Rmail (i.e., versions that came with GNU Emacs 18).
-;;;;
-;;;;   VM
-;;;;
-;;;;   `scroll-window-in-place' is *very* confused by VM 5's message scrolling
-;;;;   commands, especially because VM 5 rebuilds Emacs' window configuration
-;;;;   from scratch so often.  I have written an experimental set of patches
-;;;;   for VM 5.70 that allows VM 5 to use the "scroll-in-place" features; send
-;;;;   me mail if you would like to receive a copy of these patches.  I hope
-;;;;   that someday my patches will be incorporated into VM.
-;;;;
-;;;;   `scroll-window-in-place' is not confused by VM 4.41's message scrolling
-;;;;   commands, however.
-;;;;
-;;;;   GNUS
-;;;;
-;;;;   `scroll-window-in-place' can be *slightly* confused by GNUS' article
-;;;;   scrolling commands because they move point to the last line of the
-;;;;   article window and then scroll the text.  (This is the case for at least
-;;;;   GNUS versions 3.13 through 4.1, inclusive.)  The potential conflict is
-;;;;   so minor, however, that you'll probably never notice it.  I never do.
-;;;;
-;;;;   A severe conflict, however, exists between the "in place" scrolling
-;;;;   commands and the add-on "gnus-hide" package.  "gnus-hide" can elide
-;;;;   signatures at the ends of articles but it does so in a way that causes
-;;;;   `scroll-window-in-place', as invoked by the GNUS scrolling commands, not
-;;;;   to signal end-of-buffer conditions at the right times.  Someday I may
-;;;;   write new article scrolling commands for GNUS.
-;;;;
-;;;; + Process filters that call scrolling functions can cause confusion.  They
-;;;;   may break running chains of "in place" scrolling commands and they may
-;;;;   set up inappropriate defaults for future scrolling commands.  Maybe this
-;;;;   is a moot problem, as I am currently unaware of any process filters that
-;;;;   invoke scrolling commands (although many filters move point around,
-;;;;   which will also confuse `scroll-window-in-place').
-
-;; sb -- Added turn-on and turn-off hook functions to prepare for making this
-;;  a standardly dumped package with XEmacs.
-
-;; (provide 'scroll-in-place) at the end of this file.
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Here are the variable declarations, both user options and internal
-;;;; variables.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar scroll-in-place t
-  "*When this variable is true (i.e., non-`nil'), the standard GNU Emacs
-vertical scrolling commands `scroll-down', `scroll-up', `scroll-other-window-
-down', and `scroll-other-window' will attempt to keep point at its current
-position in the window (window line and column).  In other words, point stays
-\"in place\" within the window.
-
-When this variable is `nil' the standard GNU Emacs vertical scrolling commands
-behave as usual.  The \"in place\" equivalents, however, are still available as
-separate commands.
-
-This variable may be made buffer-local in order to disable (or enable) \"in
-place\" scrolling in particular buffers."
-  ;; I have thought about dividing `scroll-in-place' into three variables: a
-  ;; list of commands that always scroll in place, a list of commands that
-  ;; never scroll in place, and a flag that determines the default behavior of
-  ;; other scrolling commands.  This could make it easier to make "in place"
-  ;; scrolling the default because one could single out certain ill-behaved
-  ;; commands.  But as of now I'm sure that the added complexity would really
-  ;; be worth it.
-  )
-
-(defvar scroll-allow-blank-lines-past-eob nil
-  "*When this variable is `nil' the \"in place\" scrolling commands will avoid
-displaying empty lines past the end of the buffer text.  In other words, just
-as you can't see \"dead space\" before the beginning of the buffer text, the
-\"in place\" scrolling commands try to avoid displaying \"dead space\" past the
-end of the buffer text.  This helps make the most of window real estate.
-
-Note that sometimes it is necessary to display \"dead space\" in order to make
-a previous scrolling action reversible.
-
-When this variable is non-`nil' the \"in place\" scrolling commands will always
-allow blank lines to be shown past the end of the buffer.")
-
-;;;;
-;;;; The following variables are not user options, but are intended to be set
-;;;; by code outside this package.
-;;;;
-
-(defvar scroll-default-lines nil
-  "The default number of lines to be scrolled by when a new sequence of \"in
-place\" scrolling commands begins.  Of course, when an explicit number of lines
-is specified, that explicit number takes precedence.  See the documentation for
-the function `scroll-window-in-place' for more information.
-
-If this variable is not bound to a number, then the default number of lines is
-the height of the window to be scrolled minus `next-screen-context-lines'.
-
-This variable should not be set globally!  Commands that want to specify a
-default scrolling distance should just bind the variable `scroll-default-lines'
-temporarily.")
-
-(defvar scroll-command-groups '((scroll-up-one scroll-down-one)
-				(scrollbar-line-up scrollbar-line-down)
-				(scrollbar-page-up scrollbar-page-down))
-  "The explicitly specified \"groups\" of \"in place\" scrolling commands.
-This variable should be set before or immediately after the \"in place\"
-scrolling package is loaded, and then not changed after that.
-
-Usually, \"in place\" scrolling commands share state (e.g., the number of lines
-to scroll by) with any and all immediately previous \"in place\" scrolling
-commands.  Sometimes, however, this is undesirable.  In these cases the \"in
-place\" scrolling commands can be divided into groups.  A command in a group
-only shares state with members of its group.
-
-Each element of `scroll-command-groups' is a list that contains all of the
-members of a unique command group.  For example, if there were only one
-explicit group and that group contained the commands `scroll-down-one-line' and
-`scroll-up-one-line', then `scroll-command-groups' would be set to:
-
-  ((scroll-down-one-line scroll-up-one-line))
-
-Commands that are not in any explicitly specified group are added to a default
-group.  That group is stored in the variable `scroll-default-command-group'.
-
-The \"in place\" scrolling functions assume that all of the scrolling command
-groups are nonintersecting (i.e., no command is in more than one group) and
-only contain \"in place\" scrolling commands.")
-
-;;;;
-;;;; The variables below this point are internal to this package.
-;;;;
-
-(defvar scroll-default-command-group nil
-  "The set of \"in place\" scrolling commands that are not members of any
-explicitly defined group of commands.  This set of commands is an implicitly
-defined group, constructed as \"in place\" commands are invoked, and members of
-this group share state among themselves.  See the documentation for the
-variable `scroll-command-groups' for more information.")
-
-(defvar scroll-initially-displayed-lines 0
-  "The number of window lines that contained buffer text when the current
-sequence of \"in place\" scrolling commands started.  Unless the variable
-`scroll-in-place-allow-blank-lines-past-eob' is true, the \"in place\"
-scrolling commands ensure that at least this many text lines are visible at all
-times.")
-
-(defvar scroll-previous-window nil
-  "The window that was most recently scrolled by an \"in place\" scrolling
-command.")
-
-(defvar scroll-previous-lines 0
-  "The number of window lines that the previous \"in place\" scrolling command
-attempted to scroll.")
-
-(defvar scroll-goal-column 0
-  "The desired horizontal window position for point, used by the \"in place\"
-scrolling commands.")
-
-(defvar scroll-boundary-previous-point nil
-  "The value of point before point was moved to a buffer boundary.")
-
-(defvar scroll-boundary-previous-lines 0
-  "The number of lines that point moved when it moved to a buffer boundary.")
-
-(defvar scroll-boundary-error-command nil
-  "The value of `this-command' when an \"in place\" scrolling command signalled
-a buffer boundary error.  This is used to decide how subsequent scrolling
-commands should recover from the error.")
-
-(defvar scroll-boundary-error-point nil
-  "The value of point when an \"in place\" scrolling command signalled a buffer
-boundary error.  This is used to decide how subsequent scrolling commands
-should recover from the error."
-  ;; This variable is used as a flag, indicating whether or not the previous
-  ;; "in place" scrolling command signalled an error.
-  )
-
-(defvar scroll-window-debt 0
-  "The difference between the number of lines an \"in place\" scrolling command
-tried to scroll a window and the number of lines that the window actually
-scrolled.  This difference is the \"debt\" in the window's starting position.
-Subsequent \"in place\" scrolling commands try to make up this debt.")
-
-(defconst scroll-pos-visible-bug-p
-  ;; On September 14, 1993, David Hughes  told me that
-  ;; Lucid GNU Emacs 19.8 had inherited the bug from Epoch... sigh.
-  (let ((old-match-data (match-data)))
-    (unwind-protect
-	(or (and (boundp 'epoch::version)
-		 (if (string-match "\\`4\\." emacs-version) t nil)
-		 )
-	    (and (string-match "Lucid" emacs-version)
-		 (if (string-match "\\`19\\.8\\." emacs-version) t nil)
-		 )
-	    )
-      (store-match-data old-match-data)))
-  "A flag, set when this version of GNU Emacs has a buggy version of the
-function `pos-visible-in-window-p' that returns `nil' when given `(point-max)'
-and `(point-max)' is on the last line of the window.  Currently, this flag is
-set for all versions of Epoch 4 and for Lucid GNU Emacs 19.8.")
-
-
-;; Hook functions to make turning the mode on and off easier.
-(defun turn-on-scroll-in-place ()
-  "Unconditionally turn on scroll-in-place mode."
-  (set (make-local-variable 'scroll-in-place) t))
-
-(defun turn-off-scroll-in-place ()
-  "Unconditionally turn on scroll-in-place mode."
-  (set (make-local-variable 'scroll-in-place) nil))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Here are the window-choosing auxiliary functions used by the new scrolling
-;;;; commands.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun scroll-choose-window ()
-  "Choose the window to be scrolled by the commands `scroll-down', `scroll-up',
-`scroll-down-in-place', and `scroll-up-in-place'.
-
-The rules are simple.  If the selected window is not a minibuffer window, then
-just choose the selected window.
-
-However, when a minibuffer window is selected, look first for the `minibuffer-
-scroll-window'.  The `minibuffer-scroll-window' is usually the window that
-displays completions.  If it exists, choose it; otherwise choose the next
-window after the selected window in the canonical ordering of windows.  The
-next window is generally the one below the selected window, or the one at the
-top of the screen if the selected window is at the bottom of the screen."
-  (let ((selected-window (selected-window)))
-    (if (window-minibuffer-p selected-window)
-	;; A minibuffer window is selected --- scroll some other window.
-	(if (window-live-p minibuffer-scroll-window)
-	    minibuffer-scroll-window
-	  ;; We know that the (selected) minibuffer is active, so `next-window'
-	  ;; will examine all of the frames that share this minibuffer.
-	  ;; Should we consider `other-window-scroll-buffer' here?  I don't
-	  ;; believe so.
-	  (next-window selected-window))
-      selected-window)))
-
-;;;
-;;;
-;;;
-
-(defun scroll-choose-other-window ()
-  "Choose the window to be scrolled by the commands `scroll-other-window-down',
-`scroll-other-window', `scroll-other-window-down-in-place', and `scroll-other-
-window-in-place'.
-
-The rules are these.  If the selected window is not a minibuffer window, then
-choose either:
-
-  + a window that displays the `other-window-scroll-buffer', if that buffer
-    exists.  Note, this function will display that buffer if necessary.
-
-  + the next window after the selected window in the canonical ordering of
-    windows.  The next window is generally the one below the selected window,
-    or the one at the top of the screen if the selected window is at the bottom
-    of the screen.
-
-However, when a minibuffer window is selected, look first for the `minibuffer-
-scroll-window'.  The `minibuffer-scroll-window' is usually the window that
-displays completions.  If it exists, choose it; otherwise choose the window to
-be scrolled as described above (`other-window-scroll-buffer' or next window).
-
-This function is essentially a Lisp version of the function `other-window-for-
-scrolling' which first appeared in the FSF's GNU Emacs 19.26."
-  (let* ((no-error nil)
-	 (selected-window (selected-window))
-	 (other-window nil))
-    (setq other-window
-	  (cond ((and (window-minibuffer-p selected-window)
-		      (window-live-p minibuffer-scroll-window))
-		 ;; Don't signal an error when `minibuffer-scroll-window' is
-		 ;; the minibuffer itself --- which would be really weird, but
-		 ;; isn't necessarily erroneous.
-		 (setq no-error t)
-		 minibuffer-scroll-window)
-		
-		((and ;; `other-window-scroll-buffer' is an Emacs 19 invention.
-		      (boundp 'other-window-scroll-buffer)
-		      (bufferp other-window-scroll-buffer)
-		      ;; `buffer-name' is `nil' if the buffer has been killed.
-		      (buffer-name other-window-scroll-buffer))
-		 ;; This is what FSF GNU Emacs 19.26 does, but it occurred to
-		 ;; me: what if one of these forms returns the selected window?
-		 ;; Signalling an error would be bad news, so I added a flag.
-		 (setq no-error t)
-		 (or (get-buffer-window other-window-scroll-buffer)
-		     (display-buffer other-window-scroll-buffer t)))
-		
-		((let ((next-window (next-window selected-window)))
-		   (if (eq next-window selected-window)
-		       nil
-		     next-window)))
-		
-		(t
-		 ;; In Emacs 19 (FSF, Lucid, and XEmacs), look for a window on
-		 ;; another visible frame.  This could be written for
-		 ;; Epoch, too, I suppose...
-		 (condition-case nil
-		     (let ((this-window (next-window selected-window nil t)))
-		       (while (not (or (eq this-window selected-window)
-				       (scroll-choose-window-frame-visible-p
-					this-window)))
-			 (setq this-window (next-window this-window nil t)))
-		       this-window)
-		   ;; In older versions of Emacs, `next-window' didn't accept
-		   ;; three arguments.  Catch this error and then return the
-		   ;; selected window --- which will cause another error to be
-		   ;; signalled later on.
-		   (wrong-number-of-arguments selected-window))
-		 )
-		))
-    
-    (if (and (not no-error)
-	     (eq selected-window other-window))
-	(error "There is no other window."))
-    other-window))
-
-;;;
-;;;
-;;;
-
-(defun scroll-choose-window-frame-visible-p (window)
-  "Return a true value if the frame of the given WINDOW is visible."
-  (cond ((fboundp 'window-frame)
-	 (eq t (frame-visible-p (window-frame window))))
-	(t t)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Here are the "in place" scrolling commands (interactive functions) and the
-;;;; replacements for the standard GNU Emacs vertical scrolling commands.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;;
-;;;; Here are the new scroll "in place" commands.
-;;;;
-
-(defun scroll-down-in-place (&optional lines)
-  "Scroll the text of the current window downward by LINES lines, leaving point
-as close as possible to its current window position (window line and column).
-In other words, point is left \"in place\" within the window.  As a special
-case, when the current window is a minibuffer window, this command scrolls the
-`minibuffer-scroll-window' (which is usually the list of completions) if it
-exists, or otherwise the next window in the canonical ordering of windows.
-
-If the optional argument LINES is `nil', scroll the window by the same amount
-it was moved by the immediately previous \"in place\" scrolling command, or by
-the value of the variable `scroll-default-lines' (usually almost a windowful)
-if the previous command was not an \"in place\" scrolling command (or when that
-previous command scrolled some other window, or when other circumstances
-prevent the previous scrolling distance from being used).  If LINES is the
-symbol `-', then the scrolling distance is determined as if LINES had been
-`nil' and then that distance is multiplied by -1.
-
-If the window cannot be scrolled by the full distance, point is allowed to
-stray from its initial position so that it can move the full number of lines.
-If point cannot move the full number of lines, point is moved to the buffer
-boundary.  Any immediately subsequent \"in place\" scrolling commands will try
-to restore point to its initial window position."
-  (interactive "P")
-  (scroll-window-in-place (scroll-choose-window) lines -1))
-
-;;;
-;;;
-;;;
-
-(defun scroll-up-in-place (&optional lines)
-  "Scroll the text of the current window upward by LINES lines, leaving point
-as close as possible to its current window position (window line and column).
-In other words, point is left \"in place\" within the window.  As a special
-case, when the current window is a minibuffer window, this command scrolls the
-`minibuffer-scroll-window' (which is usually the list of completions) if it
-exists, or otherwise the next window in the canonical ordering of windows.
-
-If the optional argument LINES is `nil', scroll the window by the same amount
-it was moved by the immediately previous \"in place\" scrolling command, or by
-the value of the variable `scroll-default-lines' (usually almost a windowful)
-if the previous command was not an \"in place\" scrolling command (or when that
-previous command scrolled some other window, or when other circumstances
-prevent the previous scrolling distance from being used).  If LINES is the
-symbol `-', then the scrolling distance is determined as if LINES had been
-`nil' and then that distance is multiplied by -1.
-
-If the window cannot be scrolled by the full distance, point is allowed to
-stray from its initial position so that it can move the full number of lines.
-If point cannot move the full number of lines, point is moved to the buffer
-boundary.  Any immediately subsequent \"in place\" scrolling commands will try
-to restore point to its initial window position."
-  (interactive "P")
-  (scroll-window-in-place (scroll-choose-window) lines 1))
-
-;;;
-;;; The command `scroll-other-window-down' first appeared in FSF GNU Emacs
-;;; 19.26.
-;;;
-
-(defun scroll-other-window-down-in-place (&optional lines)
-  "Scroll the text of the next window downward by LINES lines, leaving point in
-that window as close as possible to its current window position (window line
-and column).  In other words, point is left \"in place\" within the window.
-The next window is generally the one below the current one, or the one at the
-top of the screen if the current window is at the bottom of the screen.  In
-special circumstances this command will scroll a window other than the next
-window.  Read the documentation for the function `scroll-choose-other-window'
-for details.
-
-If the optional argument LINES is `nil', scroll the window by the same amount
-it was moved by the immediately previous \"in place\" scrolling command, or by
-the value of the variable `scroll-default-lines' (usually almost a windowful)
-if the previous command was not an \"in place\" scrolling command (or when that
-previous command scrolled some other window, or when other circumstances
-prevent the previous scrolling distance from being used).  If LINES is the
-symbol `-', then the scrolling distance is determined as if LINES had been
-`nil' and then that distance is multiplied by -1.
-
-If the window cannot be scrolled by the full distance, point is allowed to
-stray from its initial position so that it can move the full number of lines.
-If point cannot move the full number of lines, point is moved to the buffer
-boundary.  Any immediately subsequent \"in place\" scrolling commands will try
-to restore point to its initial window position.
-
-If it is impossible to scroll the text of the window at all (because a buffer
-boundary is already visible), this command signals a buffer boundary error.
-The error is signalled even if point could otherwise move the full number of
-lines."
-  (interactive "P")
-  (scroll-window-in-place (scroll-choose-other-window) lines -1))
-
-;;;
-;;;
-;;;
-
-(defun scroll-other-window-in-place (&optional lines)
-  "Scroll the text of the next window upward by LINES lines, leaving point in
-that window as close as possible to its current window position (window line
-and column).  In other words, point is left \"in place\" within the window.
-The next window is generally the one below the current one, or the one at the
-top of the screen if the current window is at the bottom of the screen.  In
-special circumstances this command will scroll a window other than the next
-window.  Read the documentation for the function `scroll-choose-other-window'
-for details.
-
-If the optional argument LINES is `nil', scroll the window by the same amount
-it was moved by the immediately previous \"in place\" scrolling command, or by
-the value of the variable `scroll-default-lines' (usually almost a windowful)
-if the previous command was not an \"in place\" scrolling command (or when that
-previous command scrolled some other window, or when other circumstances
-prevent the previous scrolling distance from being used).  If LINES is the
-symbol `-', then the scrolling distance is determined as if LINES had been
-`nil' and then that distance is multiplied by -1.
-
-If the window cannot be scrolled by the full distance, point is allowed to
-stray from its initial position so that it can move the full number of lines.
-If point cannot move the full number of lines, point is moved to the buffer
-boundary.  Any immediately subsequent \"in place\" scrolling commands will try
-to restore point to its initial window position.
-
-If it is impossible to scroll the text of the window at all (because a buffer
-boundary is already visible), this command signals a buffer boundary error.
-The error is signalled even if point could otherwise move the full number of
-lines."
-  (interactive "P")
-  (scroll-window-in-place (scroll-choose-other-window) lines 1))
-
-;;;;
-;;;; Here are the replacements for GNU Emacs' standard vertical scrolling
-;;;; commands.
-;;;;
-
-(or (fboundp 'original-scroll-down)
-    (fset 'original-scroll-down (symbol-function 'scroll-down)))
-(or (fboundp 'original-scroll-up)
-    (fset 'original-scroll-up (symbol-function 'scroll-up)))
-(or (fboundp 'original-scroll-other-window-down)
-    ;; `scroll-other-window-down' first appeared in FSF GNU Emacs 19.26.
-    (if (fboundp 'scroll-other-window-down)
-	(fset 'original-scroll-other-window-down
-	      (symbol-function 'scroll-other-window-down))
-      ))
-(or (fboundp 'original-scroll-other-window)
-    (fset 'original-scroll-other-window (symbol-function 'scroll-other-window))
-    )
-
-;;;
-;;;
-;;;
-
-(defun scroll-down (&optional lines window)
-  "Scroll the text of WINDOW downward by LINES lines.
-If WINDOW is nil, use the selected window -- but as a special case, when
-the current window is a minibuffer window, this command scrolls the
-`minibuffer-scroll-window' (which is usually the list of completions) if it
-exists, or otherwise the next window in the canonical ordering of windows.
-
-The argument LINES is optional.  Its meaning depends on the current value of
-the variable `scroll-in-place'.
-
-When the variable `scroll-in-place' is true, this command works just like the
-command `scroll-down-in-place', scrolling the current window and leaving point
-\"in place\" within the window.  See the documentation for the command
-`scroll-down-in-place' for more information.
-
-When the variable `scroll-in-place' is `nil' this command invokes the standard
-GNU Emacs version of `scroll-down'.  In that case, when LINES is `nil' the
-current window is scrolled by nearly a complete windowful of text.
-
-Note that this command correctly handles cases in which `scroll-in-place' has a
-buffer-local value in the window to be scrolled.  That value is honored."
-  (interactive "P")
-  (scroll-window (or window (scroll-choose-window)) lines -1))
-
-;;;
-;;;
-;;;
-
-(defun scroll-up (&optional lines window)
-  "Scroll the text of WINDOW upward by LINES lines.
-If WINDOW is nil, use the selected window -- but as a special case, when
-the current window is a minibuffer window, this command scrolls the
-`minibuffer-scroll-window' (which is usually the list of completions) if it
-exists, or otherwise the next window in the canonical ordering of windows.
-
-The argument LINES is optional.  Its meaning depends on the current value of
-the variable `scroll-in-place'.
-
-When the variable `scroll-in-place' is true, this command works just like the
-command `scroll-up-in-place', scrolling the current window and leaving point
-\"in place\" within the window.  See the documentation for the command
-`scroll-up-in-place' for more information.
-
-When the variable `scroll-in-place' is `nil' this command invokes the standard
-GNU Emacs version of `scroll-up'.  In that case, when LINES is `nil' the
-current window is scrolled by nearly a complete windowful of text.
-
-Note that this command correctly handles cases in which `scroll-in-place' has a
-buffer-local value in the window to be scrolled.  That value is honored."
-  (interactive "P")
-  (scroll-window (or window (scroll-choose-window)) lines 1))
-
-;;;
-;;; NOTE that in the FSF GNU Emacs 19.26 version of `scroll-other-window-down',
-;;; the `lines' argument is required.  I've left it optional in order to be
-;;; like `scroll-other-window'.
-;;;
-
-(defun scroll-other-window-down (&optional lines)
-  "Scroll the text of the next window downward by LINES lines.  The next window
-is generally the one below the current one, or the one at the top of the screen
-if the current window is at the bottom of the screen.  In special circumstances
-this command will scroll a window other than the next window.  Read the
-documentation for the function `scroll-choose-other-window' for details.
-
-The argument LINES is optional.  Its meaning depends on the current value of
-the variable `scroll-in-place'.
-
-When the variable `scroll-in-place' is true, this command works just like the
-command `scroll-other-window-down-in-place', scrolling the next window and
-leaving point \"in place\" within that window.  See the documentation for the
-command `scroll-other-window-down-in-place' for more information.
-
-When the variable `scroll-in-place' is `nil' this command invokes the standard
-GNU Emacs version of `scroll-other-window-down'.  In that case, when LINES is
-`nil' the next window is scrolled by nearly a complete windowful of text.
-\(Note that `scroll-other-window-down' first appeared as a standard command in
-the FSF's GNU Emacs 19.26.  If the builtin version of that command is not
-available in the current Emacs system, an equivalent action is invoked
-instead.)
-
-Note that this command correctly handles cases in which `scroll-in-place' has a
-buffer-local value in the window to be scrolled.  That value is honored."
-  (interactive "P")
-  ;; This code is similar to the body of `scroll-window', below.
-  (let* ((other-window (scroll-choose-other-window))
-	 (other-window-buffer (window-buffer other-window)))
-    (if ;; Allow `scroll-in-place' to be a buffer-local variable.
-	(save-excursion (set-buffer other-window-buffer) scroll-in-place)
-	(scroll-window-in-place other-window lines -1)
-      
-      ;; Paranoid, we forcibly break any running sequence of "in place"
-      ;; scrolling commands.
-      (setq scroll-previous-window nil)
-      ;; For XEmacs and Lucid GNU Emacs, preserve the region's state.
-      (if (boundp 'zmacs-region-stays)
-	  (setq zmacs-region-stays t))
-      (if (fboundp 'original-scroll-other-window-down)
-	  (original-scroll-other-window-down lines)
-	;; `scroll-other-window-down' first appeared as a builtin in FSF GNU
-	;; Emacs 19.26, so it may not be available in the current Emacs system.
-	;; Do the equivalent thing.
-	(original-scroll-other-window (cond
-				       ((null lines) '-)
-				       ((eq lines '-) nil)
-				       (t (- (prefix-numeric-value lines)))
-				       ))
-	))
-    ))
-
-;;;
-;;;
-;;;
-
-(defun scroll-other-window (&optional lines)
-  "Scroll the text of the next window upward by LINES lines.  The next window
-is generally the one below the current one, or the one at the top of the screen
-if the current window is at the bottom of the screen.  In special circumstances
-this command will scroll a window other than the next window.  Read the
-documentation for the function `scroll-choose-other-window' for details.
-
-The argument LINES is optional.  Its meaning depends on the current value of
-the variable `scroll-in-place'.
-
-When the variable `scroll-in-place' is true, this command works just like the
-command `scroll-other-window-in-place', scrolling the next window and leaving
-point \"in place\" within that window.  See the documentation for the command
-`scroll-other-window-in-place' for more information.
-
-When the variable `scroll-in-place' is `nil' this command invokes the standard
-GNU Emacs version of `scroll-other-window'.  In that case, when LINES is `nil'
-the next window is scrolled by nearly a complete windowful of text.
-
-Note that this command correctly handles cases in which `scroll-in-place' has a
-buffer-local value in the window to be scrolled.  That value is honored."
-  (interactive "P")
-  ;; This code is similar to the body of `scroll-window', below.
-  (let* ((other-window (scroll-choose-other-window))
-	 (other-window-buffer (window-buffer other-window)))
-    (if ;; Allow `scroll-in-place' to be a buffer-local variable.
-	(save-excursion (set-buffer other-window-buffer) scroll-in-place)
-	(scroll-window-in-place other-window lines 1)
-      
-      ;; Paranoid, we forcibly break any running sequence of "in place"
-      ;; scrolling commands.
-      (setq scroll-previous-window nil)
-      ;; For XEmacs and Lucid GNU Emacs, preserve the region's state.
-      (if (boundp 'zmacs-region-stays)
-	  (setq zmacs-region-stays t))
-      (original-scroll-other-window lines))
-    ))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Here are the new functions `scroll-window-in-place', `scroll-window', and
-;;;; `scroll-window-in-place-continue-sequence'.  These functions are intended
-;;;; to be available to programs outside this package.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun scroll-window-in-place (window lines direction)
-  "Scroll WINDOW vertically by the given number of window LINES in the given
-DIRECTION, leaving the window's point as close as possible to its original
-window position (window line and column).  In other words, the window's point
-is left \"in place\" within the window.
-
-Note that the window to be scrolled does not have to be the selected window,
-and that this function does not change which window is selected.
-
-LINES specifies the number of window lines to scroll and is interpreted as if
-it were a raw prefix argument.  If LINES is `nil', the window is scrolled by
-the amount it was moved by the immediately previous \"in place\" scrolling
-command, or by the value of the variable `scroll-default-lines' (by default,
-almost a windowful) if the previous command was not an \"in place\" scrolling
-command (or when WINDOW is not the previously scrolled window, or when the
-value of `this-command' is not in the same group as the previous scrolling
-command (see the documentation for the variable `scroll-command-groups'), or
-when other circumstances prevent the previous scrolling distance from being
-used).  If LINES is the symbol `-', then the scrolling distance is determined
-as if LINES had been `nil' and then that distance is multiplied by -1.
-
-DIRECTION determines the direction of the scrolling motion.  The values -1 and
-`down' indicate downward motion; the values 1 and `up' indicate upward motion.
-Any other value causes an error.
-
-If the window cannot be scrolled by the full distance (because the window hits
-the boundary of its buffer), the window's point is allowed to stray from its
-initial position so that it can move the full number of lines.  If point cannot
-move the full number of lines, point is moved to the buffer boundary (unless it
-was already there, in which case a buffer boundary error is signalled instead).
-Any immediately subsequent \"in place\" scrolling commands will try to restore
-point to its initial window position.
-
-Unless the variable `scroll-allow-blank-lines-past-eob' is true, this function
-avoids displaying blank lines past the end of the buffer except as necessary to
-make a previous \"in place\" scrolling action reversible.  Effectively, this
-means that this function will not display any more past-end-of-buffer blank
-lines than were visible when the current sequence of \"in place\" scrolling
-commands started.  When the variable `scroll-allow-blank-lines-past-eob' is
-true, this function will display as many blank lines as is necessary to keep
-point \"in place\" in the window.
-
-Note that if WINDOW is not the selected window and it is impossible to scroll
-the text of WINDOW at all (because a buffer boundary is already visible), then
-this function signals a buffer boundary error.  The error is signalled even if
-point could otherwise move the full number of lines."
-  (let* (;; Make sure that the user doesn't quit in the middle and leave us
-	 ;; with our variables out of sync.
-	 (inhibit-quit t)
-	 (original-window (selected-window))
-	 (original-buffer (current-buffer))
-	 (window-height (- (window-height window)
-			   (if (window-minibuffer-p window)
-			       0 1)))
-	 (this-command-group (scroll-get-command-group this-command))
-	 (continue-scroll-p
-	  (and ;; We're scrolling the previously scrolled window...
-	       (windowp scroll-previous-window)
-	       (eq window scroll-previous-window)
-	       ;; ...and the last command was an "in place" scrolling command
-	       ;; that can be continued by this command.
-	       (if (eq last-command t)
-		   ;; If the previous command signalled an error, the value of
-		   ;; `last-command' is `t'.  Try to see if we signalled the
-		   ;; error and if point is where we left it.  (NOTE that FSF
-		   ;; GNU Emacs 19.23+ no longer sets `last-command' to `t'
-		   ;; when a command signals an error.  This is OK because the
-		   ;; else part of this `if' does the appropriate thing.)
-		   (and	scroll-boundary-error-point
-			(eq (window-point window) scroll-boundary-error-point)
-			(memq scroll-boundary-error-command this-command-group)
-			)
-		 ;; Otherwise...
-		 (memq last-command this-command-group))
-	       ))
-	 (lines-value (prefix-numeric-value lines))
-	 )
-    
-    ;; For XEmacs and Lucid GNU Emacs, preserve the region's state.  Note that
-    ;; these Emacsen will forcibly deactivate the region if we signal an error
-    ;; later on.  Is this bad?
-    (if (boundp 'zmacs-region-stays)
-	(setq zmacs-region-stays t))
-    ;; Parse the direction into a unit distance (1 or -1).
-    (setq direction (scroll-parse-direction direction))
-    
-    (setq scroll-previous-window window
-	  ;; `(setq scroll-boundary-error-command nil)' is not necessary.
-	  scroll-boundary-error-point nil)
-    (unwind-protect
-	(progn
-	  ;; `select-window' does an implicit `set-buffer'.
-	  (select-window window)
-	  
-	  (if (or ;; The current command is not a continuation of a running
-		  ;; sequence of "in place" scrolling commands...
-		  (not continue-scroll-p)
-		  ;; ...or we were given an explicit number of lines to scroll,
-		  ;; and that number has a different magnitude than the last
-		  ;; number of lines we scrolled...
-	          (and (or (numberp lines) (consp lines))
-		       (/= scroll-previous-lines lines-value)
-		       (/= scroll-previous-lines (- lines-value)))
-		  ;; ...or the last successful scrolling command moved to a
-		  ;; buffer boundary, but the buffer is no longer in the state
-		  ;; we left it.  (This can occur if, for example, we signal an
-		  ;; end-of-buffer error and something catches it and moves
-		  ;; point or renarrows.  VM, for example, does this.)
-		  (and scroll-boundary-previous-point
-		       (or (not (or (bobp) (eobp)))
-			   (< scroll-boundary-previous-point (point-min))
-			   (> scroll-boundary-previous-point (point-max))
-			   (eq scroll-boundary-previous-point (point)))))
-	      
-	      ;; We're starting a new sequence of scrolling commands.
-	      (setq lines (if (or (numberp lines) (consp lines))
-			      lines-value
-			    ;; The default number of lines...
-			    (* (if (eq lines '-) -1 1)
-			       (if (numberp scroll-default-lines)
-				   scroll-default-lines
-				 (max (- window-height
-					 next-screen-context-lines)
-				      1))))
-		    scroll-previous-lines lines
-		    scroll-goal-column (scroll-determine-goal-column window)
-		    scroll-boundary-previous-point nil
-		    ;; `(setq scroll-boundary-previous-lines 0)' is not
-		    ;; necessary.
-		    scroll-window-debt 0
-		    scroll-initially-displayed-lines
-		    (if scroll-allow-blank-lines-past-eob
-			0
-		      (save-excursion
-			(goto-char (window-start window))
-			(vertical-motion (1- window-height)))))
-	    
-	    ;; Otherwise we want to scroll by the same number of lines (but
-	    ;; possibly in a different direction) that we scrolled in previous
-	    ;; invocations of this function.
-	    (cond ((null lines)
-		   (setq lines scroll-previous-lines))
-		  ((eq lines '-)
-		   (setq lines (- scroll-previous-lines)
-			 scroll-previous-lines lines))
-		  (t
-		   (setq lines lines-value
-			 scroll-previous-lines lines)))
-	    )
-	  
-	  (setq lines (* direction lines))
-	  
-	  ;; If point is not in the window, center window around point.  We try
-	  ;; to account for a bug in `pos-visible-in-window-p' in some versions
-	  ;; of Emacs (see `scroll-pos-visible-bug-p', above).
-	  (save-excursion
-	    (if (pos-visible-in-window-p (let ((point (point)))
-					   (if (and scroll-pos-visible-bug-p
-						    (= point (point-max)))
-					       (max (1- point) (point-min))
-					     point))
-					 window)
-		nil
-	      (vertical-motion (/ (- window-height) 2))
-	      (set-window-start window (point))))
-	  
-	  (cond ((and scroll-boundary-previous-point
-		      ;; `lines' is the same sign as the direction from point
-		      ;; to the `scroll-boundary-previous-point'.
-		      (cond ((> lines 0)
-			     (> (- scroll-boundary-previous-point (point)) 0))
-			    ((< lines 0)
-			     (< (- scroll-boundary-previous-point (point)) 0))
-			    (t nil)))
-		 ;; We're moving away from the buffer boundary.
-		 (goto-char scroll-boundary-previous-point)
-		 ;; Always move here (i.e., don't reject cases in which the
-		 ;; window doesn't move).
-		 (scroll-set-window-start window
-					  (- scroll-boundary-previous-lines))
-		 ;; (message "Back, window debt is %s." scroll-window-debt)
-		 (setq scroll-boundary-previous-point nil))
-
-		((= lines 0)
-		 ;; We're going nowhere, so save ourselves some work.
-		 ;; (message "Scrolled zero lines.")
-		 )
-		
-		(t
-		 ;; Perform the scrolling motion.
-		 (let ((initial-point (point))
-		       (moved nil))
-		   ;; First move point and see how far it goes.
-		   (setq moved (vertical-motion lines))
-		   (if (= moved lines)
-		       (progn
-			 ;; Point moved the full distance.  Move to the desired
-			 ;; column and then try to move the window the full
-			 ;; distance, too.
-			 (move-to-column (+ (current-column)
-					    scroll-goal-column))
-			 (or (scroll-set-window-start window moved
-						      original-window)
-			     (scroll-signal-boundary-error initial-point
-							   lines))
-			 ;; (message "Normal, window debt is %s."
-			 ;;          scroll-window-debt)
-			 )
-		     ;; Point couldn't move all the way.  Move to the buffer
-		     ;; boundary if we're not already there, or signal a buffer
-		     ;; boundary error otherwise.
-		     (let ((boundary-point (if (< lines 0)
-					       (point-min)
-					     (point-max)))
-			   (boundary-symbol (if (< lines 0)
-						'beginning-of-buffer
-					      'end-of-buffer)))
-		       (if (= initial-point boundary-point)
-			   (scroll-signal-boundary-error initial-point lines)
-			 ;; Scroll the window by as many lines as point could
-			 ;; move.
-			 (or (scroll-set-window-start window moved
-						      original-window)
-			     (scroll-signal-boundary-error initial-point
-							   lines))
-			 (message "%s" (get boundary-symbol 'error-message))
-			 ;; (message "Boundary, window debt is %s."
-			 ;;          scroll-window-debt)
-			 (setq scroll-boundary-previous-lines moved)
-			 (setq scroll-boundary-previous-point initial-point)
-			 (goto-char boundary-point))
-		       )))
-		 )))
-      
-      ;; The unwind forms of the `unwind-protect', above.  Restore the
-      ;; originally selected window and current buffer.
-      (select-window original-window)
-      (set-buffer original-buffer)))
-  
-  ;; The standard GNU Emacs scrolling commands return `nil' so we do, too.
-  nil)
-
-;;;
-;;;
-;;;
-
-(defun scroll-window (window lines direction)
-  "Scroll WINDOW vertically by the given number of window LINES in the given
-DIRECTION.  Note that the window to be scrolled does not have to be the
-selected window, and that this function does not change which window is
-selected.
-
-When the variable `scroll-in-place' is true, this function simply invokes the
-function `scroll-window-in-place' to scroll the window and leave point \"in
-place\" within that window.  See the documentation for `scroll-window-in-place'
-for more information.
-
-When the variable `scroll-in-place' is `nil' this function invokes the original
-version of the standard GNU Emacs command `scroll-down' or `scroll-up', as
-determined by DIRECTION, to scroll the window.  If DIRECTION is -1 or `down',
-the original `scroll-down' is called; if DIRECTION is 1 or `up', the original
-`scroll-up' is called.  Any other DIRECTION is an error.  LINES is interpreted
-as if it were a raw prefix argument.  If LINES is `nil', the window is scrolled
-by almost a complete windowful.  If LINES is the symbol `-', the window is
-scrolled by almost a complete windowful in the opposite direction.
-
-Note that this function correctly handles cases in which `scroll-in-place' has
-a buffer-local value in the WINDOW's buffer.  That value is honored."
-  (let ((current-buffer (current-buffer))
-	(selected-window (selected-window))
-	(window-buffer (window-buffer window)))
-    (if ;; Allow `scroll-in-place' to be a buffer-local variable.
-	(if (eq current-buffer window-buffer)
-	    scroll-in-place
-	  (save-excursion (set-buffer window-buffer) scroll-in-place))
-	(scroll-window-in-place window lines direction)
-      
-      (unwind-protect
-	  (progn
-	    ;; Paranoid, we forcibly break any running sequence of "in place"
-	    ;; scrolling commands.
-	    (setq scroll-previous-window nil)
-	    ;; For XEmacs and Lucid GNU Emacs, preserve the region's state.
-	    (if (boundp 'zmacs-region-stays)
-		(setq zmacs-region-stays t))
-	    (select-window window)
-	    (if (= (scroll-parse-direction direction) 1)
-		(original-scroll-up lines)
-	      (original-scroll-down lines)))
-	(select-window selected-window)
-	(set-buffer current-buffer))
-      )))
-
-;;;
-;;; The following function is sometimes useful.  For example, I call it from
-;;; functions that are invoked by certain mouse button down events in order to
-;;; preserve any running chain of "in place" scrolling commands.  This lets me
-;;; continue the sequence from my mouse button up functions.
-;;;
-;;; I haven't yet needed a function to purposely break a running sequence of
-;;; "in place" scrolling commands.  Such a function would be easy to write,
-;;; however; just set the variable `scroll-previous-window' to `nil'.
-;;;
-
-(defun scroll-window-in-place-continue-sequence ()
-  "If the previous command was a \"scroll in place\" command, set the variable
-`this-command' to the name of that previous command.  This ensures that any
-running sequence of \"in place\" scrolling commands will not be broken by the
-current command.  See the documentation for the commands `scroll-down-in-place'
-and `scroll-up-in-place' for more information about \"in place\" scrolling.
-
-NOTE that you don't need to call this function if the current command scrolls
-in place!  You only need to call this function when the current command is not
-a \"scroll in place\" command but you still want to preserve any running
-sequence of \"in place\" commands.  Such situations are rare.
-
-NOTE that this function sets `this-command' in order to trick the \"in place\"
-scrolling commands.  If something else subsequently sets `this-command', any
-running sequence of scrolling commands will probably be broken anyway."
-  (if (if (eq last-command t)
-	  ;; If `last-command' is `t', then the previous command signalled an
-	  ;; error.  See if the last invocation of `scroll-window-in-place'
-	  ;; signalled an error.  (NOTE that FSF GNU Emacs 19.23+ no longer
-	  ;; sets `last-command' to `t' when a command signals an error.  This
-	  ;; is OK because the else part of this `if' does the appropriate
-	  ;; thing.)
-	  scroll-boundary-error-point
-	;; Otherwise, the value of `last-command' must belong to some group of
-	;; "in place" scrolling commands.
-	(or (memq last-command scroll-default-command-group)
-	    (let ((groups scroll-command-groups)
-		  (found nil))
-	      (while (and groups (not found))
-		(if (memq last-command (car groups))
-		    (setq found t)
-		  (setq groups (cdr groups)))
-		)
-	      found)))
-      (setq this-command last-command)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Here are the various auxiliary functions called by the function `scroll-
-;;;; window-in-place'.  None of the functions are intended to be called from
-;;;; outside this package.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun scroll-get-command-group (command)
-  "Return the group of \"in place\" scrolling commands that contains the given
-COMMAND.  This is the list of commands with which the given command may share
-state and form \"chains.\"
-
-This function is an auxiliary for the function `scroll-window-in-place'.  Don't
-call this function from other code."
-  ;; This function assumes that the given command is an "in place" scrolling
-  ;; command.
-  (let ((groups scroll-command-groups)
-	(found nil))
-    (while (and groups (not found))
-      (if (memq command (car groups))
-	  (setq found t)
-	(setq groups (cdr groups)))
-      )
-    (if groups
-	(car groups)
-      ;; Otherwise return the default command group.  If necessary, add the
-      ;; given command to the default command group.
-      (or (memq command scroll-default-command-group)
-	  (setq scroll-default-command-group
-		(cons command scroll-default-command-group)))
-      scroll-default-command-group)
-    ))
-
-;;;
-;;;
-;;;
-
-(defun scroll-parse-direction (direction)
-  "Return the signed unit distance for the given DIRECTION.  If DIRECTION is
-unacceptable, signal an error."
-  (cond ((or (eq direction 1) (eq direction -1)) direction)
-	((eq direction 'up) 1)
-	((eq direction 'down) -1)
-	(t (signal 'args-out-of-range (list 'direction direction)))
-	))
-
-;;;
-;;;
-;;;
-
-(defun scroll-determine-goal-column (window)
-  "Return the goal column for the \"in place\" vertical scrolling commands.
-This is the horizontal window position at which these commands try to keep
-point.
-
-This function is an auxiliary for the function `scroll-window-in-place'.  Don't
-call this function from other code."
-  ;; NOTE that `window' must be the selected window!  `scroll-window-in-place'
-  ;; ensures that this is so.
-  (cond ((or truncate-lines
-	     (and truncate-partial-width-windows
-		  (< (window-width window) (frame-width)))
-	     (> (window-hscroll window) 0))
-	 ;; Lines in this window are being truncated.
-	 (if (and track-eol (eolp))
-	     9999
-	   (current-column)))
-	((and track-eol (eolp))
-	 ;; In some ways this isn't quite right, as point doesn't track the
-	 ;; ends of wrapped lines.  But if it did so, point would be on the
-	 ;; wrong window line.  This is the best we can do.
-	 (1- (window-width window)))
-	(t (% (current-column) (1- (window-width window))))
-	))
-
-;;;
-;;;
-;;;
-
-(defun scroll-set-window-start (window lines &optional original-window)
-  "Move the `window-start' of the given window, which must be the selected
-window.  If the window was successfully scrolled, update the variable
-`scroll-window-debt' and return `t'.  Otherwise return `nil'.
-
-This function is an auxiliary for the function `scroll-window-in-place'.  Don't
-call this function from other code."
-  (save-excursion
-    (goto-char (window-start window))
-    ;; Try to move the window start by the specified number of lines.  In
-    ;; addition, try to make up any existing debt in the window start's
-    ;; position and make sure that we don't move too close to the end of the
-    ;; buffer.
-    (let ((moved (+ (vertical-motion (+ lines
-					scroll-window-debt
-					scroll-initially-displayed-lines))
-		    (vertical-motion (- scroll-initially-displayed-lines)))))
-      ;; If we're not scrolling the `original-window' (i.e., the originally
-      ;; selected window), punt if we didn't move the window start at all.
-      (if (and original-window
-	       (not (eq window original-window))
-	       (= moved 0))
-	  nil
-	;; Otherwise update the window start and keep track of the debt in our
-	;; position.  Return `t' to indicate success.
-	(set-window-start window (point))
-	(setq scroll-window-debt (- (+ lines scroll-window-debt) moved))
-	t))
-    ))
-
-;;;
-;;;
-;;;
-
-(defun scroll-signal-boundary-error (initial-point lines)
-  "Move point to its initial location and signal an appropriate buffer boundary
-error.
-
-This function is an auxiliary for the function `scroll-window-in-place'.  Don't
-call this function from other code."
-  (goto-char initial-point)
-  ;; Remember what we were doing and where point was when we signalled the
-  ;; error so that subsequent "in place" scrolling commands can decide how to
-  ;; recover.
-  (setq scroll-boundary-error-command this-command
-	scroll-boundary-error-point initial-point)
-  (when signal-error-on-buffer-boundary
-    (signal (if (< lines 0) 'beginning-of-buffer 'end-of-buffer)
-	    nil)))
-
-
-;;; Some convenience redefinitions for modes that don't like scroll-in-place
-(add-hook 'vm-mode-hook 'turn-off-scroll-in-place)
-(add-hook 'vm-select-message-hook 'turn-off-scroll-in-place)
-(add-hook 'vm-summary-mode-hook 'turn-off-scroll-in-place)
-
-(add-hook 'list-mode-hook 'turn-off-scroll-in-place)
-
-;; This doesn't work with Red Gnus
-;; (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Finally, here is the `provide' statement.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(provide 'scroll-in-place)
-
-;;; scroll-in-place.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/search-buffers.el b/xemacs-packages/lisp/edit-utils/search-buffers.el
deleted file mode 100644
index 91b0b67f..00000000
--- a/xemacs-packages/lisp/edit-utils/search-buffers.el
+++ /dev/null
@@ -1,300 +0,0 @@
-;;; search-buffers.el --- Searching REGEXP in all buffers for XEmacs
-
-;; Copyright (C) 1998 Adrian Aichner
-
-;; Author: Adrian Aichner, Teradyne GmbH Munich 
-;; Date: Sat Dec 26 1998
-;; Version: $Revision: 1.2 $
-;; Keywords: internal
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not synched.
-
-;;; Commentary:
-
-;; The Idea:
-;; Search all live buffers for REGEXP and present matching lines in
-;; separate buffer with hyperlinks to their occurences.
-
-;; The Concept:
-;; After creating countless buffers in an XEmacs session, user
-;; executes
-;; M-x list-matches-in-buffers RET \ RET .* RET
-;; to find all matches of the single word "problem" in any of them.
-;; The result is presented in a buffer named
-;; *Matches for "\" in buffers*
-;; with hyperlinks to any occurence.  User may navigate to the next
-;; (n) or previous (p) match.
-
-;; The Status:
-;; Basic functionality is complete.
-
-;; The Author:
-;; Adrian Aichner, Teradyne GmbH Munich, Sun., Dec. 26, 1998.
-
-;;; Code:
-
-(defvar search-buffers-current-extent nil)
-
-(defvar search-buffers-highlight-xtnt nil)
-
-(defvar search-buffer nil)
-
-;;;###autoload
-(defun list-matches-in-buffers (regexp)
-  "List lines matching REGEXP in any matching buffer.
-All buffers chosen via `buffer-regexp-list' are searched.  Results are
-displayed in a buffer named *Matches for \"REGEXP\" in buffers*
-including hyperlinks to visit any match in any buffer."
-  (interactive "sREGEXP: ")
-  (if (equal regexp "")
-      (error "cannot search buffers for empty regexp."))
-  (let ((b (get-buffer-create
-	    (format "*Matches for \"%s\" in buffers*" regexp)))
-	(xtnt-keymap (make-keymap)))
-    ;; Prepare local keymap and variables for buffer displaying
-    ;; matches.
-    (save-excursion
-      (set-buffer b)
-      (kill-all-local-variables)
-      (make-variable-buffer-local 'search-buffers-current-extent)
-      (setq search-buffers-current-extent nil)
-      (make-variable-buffer-local 'kill-buffer-hook)
-      (setq kill-buffer-hook 'search-buffers-cleanup)
-      (toggle-read-only -1)
-      (erase-buffer)
-      (define-key xtnt-keymap
-	[(button1)]
-	'switch-to-match-by-event)
-      (define-key xtnt-keymap
-	[?n]
-	'switch-to-next-match-by-extent)
-      (define-key xtnt-keymap
-	[?p]
-	'switch-to-previous-match-by-extent)
-      (define-key xtnt-keymap
-	[?q]
-	(function
-	 (lambda ()
-	   (interactive)
-	   (kill-buffer search-buffer))))
-      (use-local-map xtnt-keymap))
-    ;; Map over matching buffers to build list of matching lines.
-    (mapc
-     (function
-      (lambda (buffer-name)
-	(set-buffer buffer-name)
-	(goto-char (point-min))
-	;; Carefully search for REGEXP moving to limit of search to
-	;; avoid infinite looping.
-	(while (search-forward-regexp regexp (point-max) 'move)
-	  (let* ((line-num (count-lines (point-min) (point)))
-		 (bol (point-at-bol))
-		 (eol (point-at-eol))
-		 (line (buffer-substring bol eol))
-		 (beg (- (match-beginning 0) bol))
-		 (end (- (match-end 0) bol))
-		 offset
-		 xtnt)
-	    (goto-char eol)
-	    (save-excursion
-	      (set-buffer b)
-	      ;; For buffers other than the search-buffer, insert
-	      ;; match information in the search-buffer (which is
-	      ;; current).
-	      (unless (equal (get-buffer buffer-name) (current-buffer))
-		(insert (format "%s:%d:"
-				buffer-name line-num))
-		(setq offset (point))
-		(insert (format "%s\n" line))
-		;; Make an extent to be used as hyperlink to the
-		;; matching string in the buffer currently being
-		;; searched.
-		(setq xtnt (make-extent (+ offset beg) (+ offset end)))
-		;; Detaching these extents defeats their utility.
-		(set-extent-property xtnt 'detachable nil)
-		;; Set properties to
-		;; o locate matching string (buffer-name, line-num,
-		;;   line-char-begin, line-char-end),
-		;; o set hyperlink appearance (face, mouse-face),
-		;; o set extent's keymap for buffer navigation
-		;;   (keymap):
-		(set-extent-property xtnt 'buffer-name buffer-name)
-		(set-extent-property xtnt 'line-num line-num)
-		(set-extent-property xtnt 'line-char-begin beg)
-		(set-extent-property xtnt 'line-char-end end)
-		(set-extent-property xtnt 'face 'bold)
-		(set-extent-property xtnt 'mouse-face 'highlight)
-		(if (featurep 'atomic-extents)
-		    (set-extent-property xtnt 'atomic t))
-		(set-extent-property xtnt 'keymap xtnt-keymap)))))))
-     (buffer-regexp-list))
-    ;; Pop to the beginning of buffer displaying matching lines.  Mark
-    ;; that buffer unmodified and read-only.
-    (pop-to-buffer b)
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (toggle-read-only t)))
-
-(defun switch-to-match-by-event (event)
-  "Pop to buffer determined by the extent associated with event EVENT.
-See `switch-to-match-by-extent' for details on the extent properties
-required by these functions."
-  (interactive "e")
-;;; DEBUG
-;;;   (display-info event)
-  (pop-to-buffer (event-buffer event))
-  (switch-to-match-by-extent
-   (extent-at
-    (event-point event)
-    (event-buffer event))))
-
-(defun switch-to-next-match-by-extent ()
-  (interactive)
-  ;; Store next extent to be the current one.
-  (setq search-buffers-current-extent
-	(next-extent (or search-buffers-current-extent
-			 (current-buffer))))
-  ;; Switch to the buffer described by the current extent, if defined.
-  (if search-buffers-current-extent
-      (switch-to-match-by-extent search-buffers-current-extent)
-    (message "End of matches.")))
-
-(defun switch-to-previous-match-by-extent ()
-  (interactive)
-  ;; Store previous extent to be the current one.
-  (setq search-buffers-current-extent
-	(previous-extent (or search-buffers-current-extent
-			     (current-buffer))))
-  ;; Switch to the buffer described by the current extent, if defined.
-  (if search-buffers-current-extent
-      (switch-to-match-by-extent search-buffers-current-extent)
-    (message "Begin of matches.")))
-
-(defun switch-to-match-by-extent (xtnt)
-  (if xtnt
-      (let ((buffer-name
-	     (get xtnt 'buffer-name))
-	    (line-char-begin
-	     (get xtnt 'line-char-begin))
-	    (line-char-end
-	     (get xtnt 'line-char-end))
-	    (line-num
-	     (get xtnt 'line-num))
-	    (xtnt-keymap (make-keymap))
-	    (search-buffer (current-buffer))
-	    offset)
-	(setq search-buffers-current-extent xtnt)
-	(goto-char
-	 (extent-start-position xtnt))
-	;; Pop to bufer indicated by extent.
-	(if (get-buffer buffer-name)
-	    (pop-to-buffer (get-buffer buffer-name))
-	  (message "No such buffer %s." buffer-name))
-;;; DEBUG
-;;;	(display-info (allocate-event 'button-press '(button 1)))
-	(if line-num
-	    (goto-line line-num))
-	(setq offset (point))
-	(if line-char-begin
-	    (forward-char line-char-begin))
-	(if search-buffers-highlight-xtnt
-	    (delete-extent search-buffers-highlight-xtnt))
-	(setq search-buffers-highlight-xtnt
-	      (make-extent (+ offset (or line-char-begin 0))
-			   (+ offset (or line-char-end 0))))
-	(define-key xtnt-keymap
-	  [(button1)]
-	  'switch-to-match-by-event)
-	(set-extent-property search-buffers-highlight-xtnt
-			     'face 'highlight)
-	(set-extent-property search-buffers-highlight-xtnt
-			     'buffer-name (buffer-name search-buffer))
-	(set-extent-property search-buffers-highlight-xtnt
-			     'keymap xtnt-keymap)
-	(other-window 1))))
-
-(defun display-info (event)
-  (interactive "e")
-  (with-current-buffer
-      (get-buffer-create "*Matches Info*")
-    (erase-buffer)
-    (event-info event)
-    (mapcar-extents 'extent-info 'identity (event-buffer event))))
-
-(defun extent-info (xtnt)
-  (insert (format "%s\n" (extent-properties xtnt))))
-
-(defun event-info (event)
-  (insert (format "%s\n" (event-properties event))))
-
-(defun search-buffers-cleanup ()
-  (if search-buffers-highlight-xtnt
-      (delete-extent search-buffers-highlight-xtnt))
-  (if search-buffer
-      (setq search-buffer nil)))
-
-(defun profile-it (arg)
-  (interactive "P")
-  (with-output-to-temp-buffer "*Profiling Output*"
-    (unless (null arg)
-      (clear-profiling-info))
-    (profile-results
-     (profile 
-      (list-matches-in-buffers "fix")))))
-;;; Function Name            Ticks    %/Total   Call Count
-;;; =====================    =====    =======   ==========
-;;; count-lines              1570     69.224    450
-;;; search-forward-regexp    117      5.159     483
-;;; buffer-substring         106      4.674     450
-;;; insert                   102      4.497     450
-;;; format                   78       3.439     451
-;;; save-excursion           52       2.293     451
-;;; set-buffer               50       2.205     484
-;;; set-extent-property      34       1.499     1350
-;;; let*                     32       1.411     450
-
-(defun buffer-regexp-list ()
-  "Return the list of buffer names matching REGEXP.
-The list of buffer names is displayed for the user to either confirm
-or re-enter a REGEXP to choose the desired list of buffers."
-  (interactive)
-  (let (buffers regexp tmpbuf)
-    (while
-	(progn
-	  (setq regexp (read-string "Buffer Name REGEXP: " ".*"))
-	  (setq tmpbuf (format "*Buffers matching \"%s\"*" regexp))
-	  (setq buffers
-		(mapcan
-		 (function
-		  (lambda (b)
-		    (if (string-match regexp (buffer-name b))
-			(list (buffer-name b)))))
-		 (buffer-list)))
-	  (with-output-to-temp-buffer
-	      tmpbuf
-	    (mapc
-	     (function
-	      (lambda (b)
-		(prin1 b)
-		(princ "\n")))
-	     buffers))
-	  (not (y-or-n-p "OK to use these buffers? "))))
-    (kill-buffer tmpbuf)
-    buffers))
diff --git a/xemacs-packages/lisp/edit-utils/setnu.el b/xemacs-packages/lisp/edit-utils/setnu.el
deleted file mode 100644
index 54c700f1..00000000
--- a/xemacs-packages/lisp/edit-utils/setnu.el
+++ /dev/null
@@ -1,449 +0,0 @@
-;;; 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.")
-
-;;;###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
-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/xemacs-packages/lisp/edit-utils/shell-font.el b/xemacs-packages/lisp/edit-utils/shell-font.el
deleted file mode 100644
index 7fff485d..00000000
--- a/xemacs-packages/lisp/edit-utils/shell-font.el
+++ /dev/null
@@ -1,161 +0,0 @@
-;; Decorate a shell buffer with fonts.
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;; Do this: (add-hook 'shell-mode-hook 'install-shell-fonts)
-;; and the prompt in your shell-buffers will appear bold-italic, process
-;; output will appear in normal face, and typein will appear in bold.
-;;
-;; The faces shell-prompt, shell-input and shell-output can be modified
-;; as desired, for example, (copy-face 'italic 'shell-prompt).
-
-;; Written by Jamie Zawinski, overhauled by Eric Benson.
-
-;; TODO:
-;; =====
-;; Parse ANSI/VT100 escape sequences to turn on underlining/boldface/etc.
-;; Automatically run nuke-nroff-bs?
-
-
-(require 'text-props)	; for put-nonduplicable-text-property
-
-(make-face 'shell-prompt)
-(if (not (face-differs-from-default-p 'shell-prompt))
-    (copy-face 'bold-italic 'shell-prompt))
-
-(make-face 'shell-input)
-(if (not (face-differs-from-default-p 'shell-input))
-    (copy-face 'bold 'shell-input))
-
-(make-face 'shell-output)
-(if (not (face-differs-from-default-p 'shell-output))
-    (progn (make-face-unbold 'shell-output)
-	   (make-face-unitalic 'shell-output)
-	   (set-face-underline-p 'shell-output nil)))
-
-(defvar shell-font-read-only-prompt nil
-  "*Set all shell prompts to be read-only")
-
-(defvar shell-font-current-face 'shell-input)
-
-(defun shell-font-fontify-region (start end delete-count)
-  ;; for use as an element of after-change-functions; fontifies the inserted text.
-  (if (= start end)
-      nil
-;    ;; This creates lots of extents (one per user-typed character)
-;    ;; which is wasteful of memory.
-;    (let ((e (make-extent start end)))
-;      (set-extent-face e shell-font-current-face)
-;      (set-extent-property e 'shell-font t))
-
-    ;; This efficiently merges extents
-    (put-nonduplicable-text-property start end 'face shell-font-current-face)
-    (and shell-font-read-only-prompt
-	 (eq shell-font-current-face 'shell-prompt)
-	 (put-nonduplicable-text-property start end 'read-only t))
-    ))
-
-(defun shell-font-hack-prompt (limit)
-  "Search backward from point-max for text matching the comint-prompt-regexp,
-and put it in the `shell-prompt' face.  LIMIT is the left bound of the search."
-  (save-excursion
-    (goto-char (point-max))
-    (save-match-data
-     (cond ((re-search-backward comint-prompt-regexp limit t)
-	    (goto-char (match-end 0))
-	    (cond ((= (point) (point-max))
-		   (skip-chars-backward " \t")
-		   (let ((shell-font-current-face 'shell-prompt))
-		     (shell-font-fontify-region
-		      (match-beginning 0) (point) 0)))))))))
-
-;; David Hughes 22nd April 1998
-(defun shell-font-hack-input (string)
-  (save-excursion
-    (save-match-data
-      (goto-char (- (point-max) (length (replace-in-string string "\^M" ""))))
-      (skip-chars-forward " \t")
-      (let ((beg (point))
-            (end (save-excursion (re-search-forward "\n" nil t)))
-            (shell-font-current-face 'shell-input))
-        (beginning-of-line)
-        (and end
-             (looking-at comint-prompt-regexp)
-             (re-search-forward comint-prompt-regexp)
-             (= beg (point))
-             (shell-font-fontify-region beg end 0))))))
-
-(defvar shell-font-process-filter nil
-  "In an interaction buffer with shell-font, this is the original proc filter.
-shell-font encapsulates this.")
-
-(defun shell-font-process-filter (proc string)
-  "Invoke the original process filter, then set fonts on the output.
-The original filter is in the buffer-local variable shell-font-process-filter."
-  (let ((cb (current-buffer))
-	(pb (process-buffer proc)))
-    (if (null pb)
-	;; If the proc has no buffer, leave it alone.
-	(funcall shell-font-process-filter proc string)
-      ;; Don't do save excursion because some proc filters want to change
-      ;; the buffer's point.
-      (set-buffer pb)
-      (let ((p (marker-position (process-mark proc))))
-	(prog1
-	    ;; this let must not be around the `set-buffer' call.
-	    (let ((shell-font-current-face 'shell-output))
-	      (funcall shell-font-process-filter proc string))
-          (shell-font-hack-prompt p)
-          ;; David Hughes 22nd April 1998
-	  (if comint-process-echoes (shell-font-hack-input string))
-	  (set-buffer cb))))))
-
-;;;###autoload
-(defun install-shell-fonts ()
-  "Decorate the current interaction buffer with fonts.
-This uses the faces called `shell-prompt', `shell-input' and `shell-output';
-you can alter the graphical attributes of those with the normal
-face-manipulation functions."
-  (let* ((proc (or (get-buffer-process (current-buffer))
-		   (error "no process in %S" (current-buffer))))
-	 (old (or (process-filter proc)
-		  (error "no process filter on %S" proc))))
-    (make-local-variable 'after-change-functions)
-    (add-hook 'after-change-functions 'shell-font-fontify-region)
-    (make-local-variable 'shell-font-current-face)
-    (setq shell-font-current-face 'shell-input)
-    (make-local-variable 'shell-font-process-filter)
-    (or (eq old 'shell-font-process-filter) ; already set
-	(setq shell-font-process-filter old))
-    (set-process-filter proc 'shell-font-process-filter))
-  nil)
-
-(add-hook 'shell-mode-hook	'install-shell-fonts)
-(add-hook 'telnet-mode-hook	'install-shell-fonts)
-(add-hook 'gdb-mode-hook	'install-shell-fonts)
-
-;; for compatibility with the 19.8 version
-;(fset 'install-shell-font-prompt 'install-shell-fonts)
-(make-obsolete 'install-shell-font-prompt 'install-shell-fonts)
-
-(provide 'shell-font)
-
-;;; shell-font.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/tempo.el b/xemacs-packages/lisp/edit-utils/tempo.el
deleted file mode 100644
index a3a80660..00000000
--- a/xemacs-packages/lisp/edit-utils/tempo.el
+++ /dev/null
@@ -1,759 +0,0 @@
-;;; tempo.el --- Flexible template insertion
-
-;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: David K}gedal 
-;; Created: 16 Feb 1994
-;; K}gedal's last version number: 1.2.4
-;; Keywords: extensions, languages, 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:
-
-;; This file provides a simple way to define powerful templates, or
-;; macros, if you wish. It is mainly intended for, but not limited to,
-;; other programmers to be used for creating shortcuts for editing
-;; certain kind of documents. It was originally written to be used by
-;; a HTML editing mode written by Nelson Minar ,
-;; and his html-helper-mode.el is probably the best example of how to
-;; use this program.
-
-;; A template is defined as a list of items to be inserted in the
-;; current buffer at point. Some of the items can be simple strings,
-;; while other can control formatting or define special points of
-;; interest in the inserted text.
-
-;; If a template defines a "point of interest" that point is inserted
-;; in a buffer-local list of "points of interest" that the user can
-;; jump between with the commands `tempo-backward-mark' and
-;; `tempo-forward-mark'. If the template definer provides a prompt for
-;; the point, and the variable `tempo-interactive' is non-nil, the
-;; user will be prompted for a string to be inserted in the buffer,
-;; using the minibuffer.
-
-;; The template can also define one point to be replaced with the
-;; current region if the template command is called with a prefix (or
-;; a non-nil argument).
-
-;; More flexible templates can be created by including lisp symbols,
-;; which will be evaluated as variables, or lists, which will be
-;; evaluated as lisp expressions.
-
-;; See the documentation for tempo-define-template for the different
-;; items that can be used to define a tempo template.
-
-;; One of the more powerful features of tempo templates are automatic
-;; completion. With every template can be assigned a special tag that
-;; should be recognized by `tempo-complete-tag' and expanded to the
-;; complete template. By default the tags are added to a global list
-;; of template tags, and are matched against the last word before
-;; point. But if you assign your tags to a specific list, you can also
-;; specify another method for matching text in the buffer against the
-;; tags. In the HTML mode, for instance, the tags are matched against
-;; the text between the last `<' and point.
-
-;; When defining a template named `foo', a symbol named
-;; `tempo-template-foo' will be created whose value as a variable will
-;; be the template definition, and its function value will be an
-;; interactive function that inserts the template at the point.
-
-;; The latest tempo.el distribution can be fetched from
-;; ftp.lysator.liu.se in the directory /pub/emacs
-
-;; There is also a WWW page at
-;; http://www.lysator.liu.se/~davidk/elisp/ which has some information
-
-;;; Known bugs:
-
-;; If the 'o is the first element in a template, strange things can
-;; happen when the template is inserted at the beginning of a
-;; line. This is due to strange behaviour in open-line. But it should
-;; be easily avoided.
-
-;; The 'o tag is also a problem when including the region. This will
-;; be looked into.
-
-;; Clicking mouse-2 in the completion buffer gives strange results.
-
-;; There is a bug in some emacs versions that prevents completion from
-;; working. If it doesn't work for you, send me a note indicating your
-;; emacs version and your problems.
-
-;;; Contributors:
-
-;; These people have given me important feedback and new ideas for
-;; tempo.el. Thanks.
-
-;; Nelson Minar 
-;; Richard Stallman 
-;; Lars Lindberg 
-;; Glen Whitney 
-
-;;; Code:
-
-;;; User options
-
-(defgroup tempo nil
-  "Flexible template insertion."
-  :prefix "tempo-"
-  :group 'extensions)
-
-(defcustom tempo-interactive t ;; wing change
-  "*Prompt user for strings in templates.
-If this variable is non-nil, `tempo-insert' prompts the
-user for text to insert in the templates"
-  :type 'boolean
-  :group 'tempo)
-
-(defcustom tempo-insert-region nil
-  "*Automatically insert current region when there is a `r' in the template.
-If this variable is nil, `r' elements will be treated just like `p'
-elements, unless the template function is given a prefix (or a non-nil
-argument).  If this variable is non-nil, the behaviour is reversed.
-
-In Transient Mark mode, this option is unused."
-  :type 'boolean
-  :group 'tempo)
-
-(defcustom tempo-show-completion-buffer t
-  "*If non-nil, show a buffer with possible completions, when only
-a partial completion can be found."
-  :type 'boolean
-  :group 'tempo)
-
-(defcustom tempo-leave-completion-buffer nil
-  "*If nil, a completion buffer generated by \\[tempo-complete-tag]
-disappears at the next keypress; otherwise, it remains forever."
-  :type 'boolean
-  :group 'tempo)
-
-;;; Internal variables
-
-(defvar tempo-insert-string-functions nil
-  "List of functions to run when inserting a string.
-Each function is called with a single arg, STRING and should return
-another string.  This could be used for making all strings upcase by
-setting it to '(upcase), for example.")
-
-(defvar tempo-tags nil
-  "An association list with tags and corresponding templates.")
-
-(defvar tempo-local-tags '((tempo-tags . nil))
-  "A list of locally installed tag completion lists.
-It is a association list where the car of every element is a symbol
-whose variable value is a template list.  The cdr part, if non-nil, is a
-function or a regexp that defines the string to match.  See the
-documentation for the function `tempo-complete-tag' for more info.
-
-`tempo-tags' is always in the last position in this list.")
-
-(defvar tempo-collection nil
-  "A collection of all the tags defined for the current buffer.")
-
-(defvar tempo-dirty-collection t
-  "Indicates if the tag collection needs to be rebuilt.")
-
-(defvar tempo-marks nil
-  "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.")
-
-(defvar tempo-match-finder "\\b\\([^\\b]+\\)\\="
-  "The regexp or function used to find the string to match against tags.
-
-If `tempo-match-finder is a string, it should contain a regular
-expression with at least one \\( \\) pair.  When searching for tags,
-`tempo-complete-tag' calls `re-search-backward' with this string, and
-the string between the first \\( and \\) is used for matching against
-each string in the tag list.  If one is found, the whole text between
-the first \\( and the point is replaced with the inserted template.
-
-You will probably want to include \\ \= at the end of the regexp to
-make sure that the string is matched only against text adjacent to the
-point.
-
-If `tempo-match-finder' is a symbol, it should be a function that
-returns a pair of the form (STRING . POS), where STRING is the string
-used for matching and POS is the buffer position after which text
-should be replaced with a template.")
-
-(defvar tempo-user-elements nil
-  "Element handlers for user-defined elements.
-A list of symbols which are bound to functions that take one argument.
-This function should return something to be sent to `tempo-insert' if
-it recognizes the argument, and nil otherwise.")
-
-(defvar tempo-named-insertions nil
-  "Temporary storage for named insertions.")
-
-(defvar tempo-region-start (make-marker)
-  "Region start when inserting around the region.")
-
-(defvar tempo-region-stop (make-marker)
-  "Region stop when inserting around the region.")
-
-;; Make some variables local to every buffer
-
-(make-variable-buffer-local 'tempo-marks)
-(make-variable-buffer-local 'tempo-local-tags)
-(make-variable-buffer-local 'tempo-match-finder)
-(make-variable-buffer-local 'tempo-collection)
-(make-variable-buffer-local 'tempo-dirty-collection)
-
-;;; Functions
-
-;;
-;; tempo-define-template
-
-(defun tempo-define-template (name elements &optional tag documentation taglist)
-  "Define a template.
-This function creates a template variable `tempo-template-NAME' and an
-interactive function `tempo-template-NAME' that inserts the template
-at the point.  The created function is returned.
-
-NAME is a string that contains the name of the template, ELEMENTS is a
-list of elements in the template, TAG is the tag used for completion,
-DOCUMENTATION is the documentation string for the insertion command
-created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
-should be added to).  If TAGLIST is nil and TAG is non-nil, TAG is
-added to `tempo-tags'
-
-The elements in ELEMENTS can be of several types:
-
- - A string.  It is sent to the hooks in `tempo-insert-string-functions',
-   and the result is inserted.
- - The symbol 'p.  This position is saved in `tempo-marks'.
- - The symbol 'r.  If `tempo-insert' is called with ON-REGION non-nil
-   the current region is placed here.  Otherwise it works like 'p.
- - (p PROMPT  ) If `tempo-interactive' is non-nil, the
-   user is prompted in the minibuffer with PROMPT for a string to be
-   inserted.  If the optional parameter NAME is non-nil, the text is
-   saved for later insertion with the `s' tag.  If there already is
-   something saved under NAME that value is used instead and no
-   prompting is made.  If NOINSERT is provided and non-nil, nothing is
-   inserted, but text is still saved when a NAME is provided.  For
-   clarity, the symbol 'noinsert should be used as argument.
- - (P PROMPT  ) Works just like the previous tag, but
-   forces `tempo-interactive' to be true.
- - (r PROMPT  ) like the previous, but if
-   `tempo-interactive' is nil and `tempo-insert' is called with
-   ON-REGION non-nil, the current region is placed here.  This usually
-   happens when you call the template function with a prefix argument.
- - (s NAME) Inserts text previously read with the (p ..) construct.
-   Finds the insertion saved under NAME and inserts it.  Acts like 'p
-   if `tempo-interactive' is nil.
- - '& If there is only whitespace between the line start and point,
-   nothing happens.  Otherwise a newline is inserted.
- - '% If there is only whitespace between point and end of line
-   nothing happens.  Otherwise a newline is inserted.
- - 'n inserts a newline.
- - '> The line is indented using `indent-according-to-mode'.  Note that
-   you often should place this item after the text you want on the
-   line.
- - 'r> Like r, but it also indents the region.
- - 'n> Inserts a newline and indents line.
- - 'o Like '% but leaves the point before the newline.
- - nil.  It is ignored.
- - Anything else.  It is evaluated and the result is treated as an
-   element to be inserted.  One additional tag is useful for these
-   cases.  If an expression returns a list '(l foo bar), the elements
-   after 'l will be inserted according to the usual rules.  This makes
-   it possible to return several elements from one expression."
-
-  (let* ((template-name (intern (concat "tempo-template-"
-				       name)))
-	 (command-name template-name))
-    (set template-name elements)
-    (fset command-name (list 'lambda (list '&optional 'arg)
-			     (or documentation
-				 (concat "Insert a " name "."))
-			     (list 'interactive "*P")
-			     (list 'tempo-insert-template (list 'quote
-								template-name)
-				   (list 'if 'tempo-insert-region
-					 (list 'not 'arg) 'arg))))
-    (and tag
-	 (tempo-add-tag tag template-name taglist))
-    command-name))
-
-;;;
-;;; tempo-insert-template
-
-(defun tempo-insert-template (template on-region)
-  "Insert a template.
-TEMPLATE is the template to be inserted.  If ON-REGION is non-nil the
-`r' elements are replaced with the current region.  In Transient Mark
-mode, ON-REGION is ignored and assumed true if the region is active."
-  (unwind-protect
-      (progn
-	(if (or (and (boundp 'transient-mark-mode) ; For Emacs
-		     transient-mark-mode
-		     (boundp 'mark-active) ; XEmacs change
-		     mark-active)
-		(and (boundp 'zmacs-regions) ; For XEmacs
-		     zmacs-regions (mark)))
-	    (setq on-region t))
-	(and on-region
-	     (set-marker tempo-region-start (min (mark) (point)))
-	     (set-marker tempo-region-stop (max (mark) (point))))
-	(if on-region
-	    (goto-char tempo-region-start))
-	(save-excursion
-	  (tempo-insert-mark (point-marker))
-	  (mapcar (function (lambda (elt)
-			      (tempo-insert elt on-region)))
-		  (symbol-value template))
-	  (tempo-insert-mark (point-marker)))
-	(tempo-forward-mark))
-    (tempo-forget-insertions)
-    ;; Should I check for zmacs here too???
-    (and (boundp 'transient-mark-mode)
-	 transient-mark-mode
-	 (fboundp 'deactivate-mark) ; XEmacs change
-	 (deactivate-mark))))
-
-;;;
-;;; tempo-insert
-
-(defun tempo-insert (element on-region)
-  "Insert a template element.
-Insert one ELEMENT from a template.  If ON-REGION is non-nil the `r'
-elements are replaced with the current region.
-
-See documentation for `tempo-define-template' for the kind of elements
-possible."
-  (cond ((stringp element) (tempo-process-and-insert-string element))
-	((and (consp element)
-	      (eq (car element) 'p)) (tempo-insert-prompt-compat
-				      (cdr element)))
-	((and (consp element)
-	      (eq (car element) 'P)) (let ((tempo-interactive t))
-				       (tempo-insert-prompt-compat
-					(cdr element))))
-;;;	((and (consp element)
-;;;	      (eq (car element) 'v)) (tempo-save-named
-;;;				      (nth 1 element)
-;;;				      nil
-;;;				      (nth 2 element)))
-	((and (consp element)
-	      (eq (car element) 'r)) (if on-region
-					 (goto-char tempo-region-stop)
-				       (tempo-insert-prompt-compat
-					(cdr element))))
-	((and (consp element)
-	      (eq (car element) 's)) (tempo-insert-named (car (cdr element))))
-	((and (consp element)
-	      (eq (car element) 'l)) (mapcar (function
-					      (lambda (elt)
-						(tempo-insert elt on-region)))
-					     (cdr element)))
-	((eq element 'p) (tempo-insert-mark (point-marker)))
-	((eq element 'r) (if on-region
-			     (goto-char tempo-region-stop)
-			   (tempo-insert-mark (point-marker))))
-	((eq element 'r>) (if on-region
-			      (progn
-				(goto-char tempo-region-stop)
-				(indent-region (mark) (point) nil))
-			    (tempo-insert-mark (point-marker))))
-	((eq element '>) (indent-according-to-mode))
-	((eq element '&) (if (not (or (= (current-column) 0)
-				      (save-excursion
-					(re-search-backward
-					 "^\\s-*\\=" nil t))))
-			     (insert "\n")))
-	((eq element '%) (if (not (or (eolp)
-				      (save-excursion
-					(re-search-forward
-					 "\\=\\s-*$" nil t))))
-			     (insert "\n")))
-	((eq element 'n) (insert "\n"))
-	((eq element 'n>) (insert "\n") (indent-according-to-mode))
-	;; Bug: If the 'o is the first element in a template, strange
-	;; things can happen when the template is inserted at the
-	;; beginning of a line.
-	((eq element 'o) (if (not (or on-region
-				      (eolp)
-				      (save-excursion
-					(re-search-forward
-					 "\\=\\s-*$" nil t))))
-			     (open-line 1)))
-	((null element))
-	(t (tempo-insert (or (tempo-is-user-element element)
-			     (eval element))
-			 on-region))))
-
-;;;
-;;; tempo-insert-prompt
-
-(defun tempo-insert-prompt-compat (prompt)
-  "Compatibility hack for `tempo-insert-prompt'.
-PROMPT can be either a prompt string, or a list of arguments to
-`tempo-insert-prompt', or nil."
-  (if (consp prompt)			; not nil either
-      (apply 'tempo-insert-prompt prompt)
-    (tempo-insert-prompt prompt)))
-
-(defun tempo-insert-prompt (prompt &optional save-name no-insert)
-  "Prompt for a text string and insert it in the current buffer.
-If the variable `tempo-interactive' is non-nil the user is prompted
-for a string in the minibuffer, which is then inserted in the current
-buffer.  If `tempo-interactive' is nil, the current point is placed on
-`tempo-mark'.
-
-PROMPT is the prompt string, SAVE-NAME is a name to save the inserted
-text under.  If the optional argument NO-INSERT is non-nil, no text i
-inserted.  This can be useful when there is a SAVE-NAME.
-
-If there already is a value for SAVE-NAME, it is used and the user is
-never prompted."
-  (let (insertion
-	(previous (and save-name
-		       (tempo-lookup-named save-name))))
-    (cond
-     ;; Insert  previous value, unless no-insert is non-nil
-     ((and previous
-	   (not no-insert))
-      (tempo-insert-named save-name)) ; A double lookup here, but who
-				      ; cares
-     ;; If no-insert is non-nil, don't insert the previous value. Just
-     ;; keep it
-     (previous
-      nil)
-     ;; No previous value. Prompt or insert mark
-     (tempo-interactive
-      (if (not (stringp prompt))
-	  (error "tempo: The prompt (%s) is not a string" prompt))
-      (setq insertion (read-string prompt))
-      (or no-insert
-	  (insert insertion))
-      (if save-name
-	  (tempo-save-named save-name insertion)))
-     (t
-      (tempo-insert-mark (point-marker))))))
-
-;;;
-;;; tempo-is-user-element
-
-(defun tempo-is-user-element (element)
-  "Tries all the user-defined ELEMENT handlers in `tempo-user-elements'."
-  ;; Sigh... I need (some list)
-  (catch 'found
-    (mapcar (function (lambda (handler)
-			(let ((result (funcall handler element)))
-			  (if result (throw 'found result)))))
-	    tempo-user-elements)
-    (throw 'found nil)))
-
-;;;
-;;; tempo-forget-insertions
-
-(defun tempo-forget-insertions ()
-  "Forget all the saved named insertions."
-  (setq tempo-named-insertions nil))
-
-;;;
-;;; tempo-save-named
-
-(defun tempo-save-named (name data)	; Had an optional prompt for 'v
-  "Save some data for later insertion.
-The contents of DATA is saved under the name NAME.
-
-The data can later be retrieved with `tempo-lookup-named'.
-
-This function returns nil, so it can be used in a template without
-inserting anything."
-  (setq tempo-named-insertions
-	(cons (cons name data)
-	      tempo-named-insertions))
-  nil)
-
-;;;
-;;; tempo-lookup-named
-
-(defun tempo-lookup-named (name)
-  "Lookup some saved data under the name NAME.
-Returns the data if NAME was found, and nil otherwise."
-  (cdr (assq name tempo-named-insertions)))
-
-;;;
-;;; tempo-insert-named
-
-(defun tempo-insert-named (name)
-  "Insert the previous insertion saved under a named specified in NAME.
-If there is no such name saved, a tempo mark is inserted.
-
-Note that if the data is a string, it will not be run through the string
-processor."
-  (let* ((insertion (tempo-lookup-named name)))
-    (cond ((null insertion)
-	   (tempo-insert-mark (point-marker)))
-	  ((stringp insertion)
-	   (insert insertion))
-	  (t
-	   (tempo-insert insertion nil)))))
-
-
-;;;
-;;; tempo-process-and-insert-string
-
-(defun tempo-process-and-insert-string (string)
-  "Insert a string from a template.
-Run a STRING through the preprocessors in `tempo-insert-string-functions'
-and insert the results."
-  (cond ((null tempo-insert-string-functions)
-	 nil)
-	((symbolp tempo-insert-string-functions)
-	 (setq string
-	       (funcall tempo-insert-string-functions string)))
-	((listp tempo-insert-string-functions)
-	 (dolist (fn tempo-insert-string-functions)
-	   (setq string (funcall fn string))))
-	(t
-	 (error "Bogus value in tempo-insert-string-functions: %s"
-		tempo-insert-string-functions)))
-  (insert string))
-
-;;;
-;;; tempo-insert-mark
-
-(defun tempo-insert-mark (mark)
-  "Insert a MARK `tempo-marks' while keeping it sorted."
-  (cond ((null tempo-marks) (setq tempo-marks (list mark)))
-	((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks)))
-	(t (let ((lp tempo-marks))
-	     (while (and (cdr lp)
-			 (<= (car (cdr lp)) mark))
-	       (setq lp (cdr lp)))
-	     (if (not (= mark (car lp)))
-		 (setcdr lp (cons mark (cdr lp))))))))
-	  
-;;;
-;;; tempo-forward-mark
-
-(defun tempo-forward-mark ()
-  "Jump to the next mark in `tempo-forward-mark-list'."
-  (interactive)
-  (let ((next-mark (catch 'found
-		     (mapcar
-		      (function
-		       (lambda (mark)
-			 (if (< (point) mark)
-			     (throw 'found mark))))
-		      tempo-marks)
-		     ;; return nil if not found
-		     nil)))
-    (if next-mark
-	(goto-char next-mark))))
-
-;;;
-;;; tempo-backward-mark
-
-(defun tempo-backward-mark ()
-  "Jump to the previous mark in `tempo-back-mark-list'."
-  (interactive)
-  (let ((prev-mark (catch 'found
-		     (let (last)
-		       (mapcar
-			(function
-			 (lambda (mark)
-			   (if (<= (point) mark)
-			       (throw 'found last))
-			   (setq last mark)))
-			tempo-marks)
-		       last))))
-    (if prev-mark
-	(goto-char prev-mark))))
-	
-;;;
-;;; tempo-add-tag
-
-(defun tempo-add-tag (tag template &optional tag-list)
-  "Add a template tag.
-Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
-or to `tempo-tags' if TAG-LIST is nil."
-
-  (interactive "sTag: \nCTemplate: ")
-  (if (null tag-list)
-      (setq tag-list 'tempo-tags))
-  (if (not (assoc tag (symbol-value tag-list)))
-      (set tag-list (cons (cons tag template) (symbol-value tag-list))))
-  (tempo-invalidate-collection))
-
-;;;
-;;; tempo-use-tag-list
-
-(defun tempo-use-tag-list (tag-list &optional completion-function)
-  "Install TAG-LIST to be used for template completion in the current buffer.
-TAG-LIST is a symbol whose variable value is a tag list created with
-`tempo-add-tag'.
-
-COMPLETION-FUNCTION is an obsolete option for specifying an optional
-function or string that is used by `\\[tempo-complete-tag]' to find a
-string to match the tag against.  It has the same definition as the
-variable `tempo-match-finder'.  In this version, supplying a
-COMPLETION-FUNCTION just sets `tempo-match-finder' locally."
-  (let ((old (assq tag-list tempo-local-tags)))
-    (if old
-	(setcdr old completion-function)
-      (setq tempo-local-tags (cons (cons tag-list completion-function)
-				   tempo-local-tags))))
-  (if completion-function
-      (setq tempo-match-finder completion-function))
-  (tempo-invalidate-collection))
-
-;;;
-;;; tempo-invalidate-collection
-
-(defun tempo-invalidate-collection ()
-  "Mark the tag collection as obsolete.
-Whenever it is needed again it will be rebuilt."
-  (setq tempo-dirty-collection t))
-
-;;;
-;;; tempo-build-collection
-
-(defun tempo-build-collection ()
-  "Build a collection of all the tags and return it.
-If `tempo-dirty-collection' is nil, the old collection is reused."
-  (prog1
-      (or (and (not tempo-dirty-collection)
-	       tempo-collection)
-	  (setq tempo-collection
-		(apply (function append)
-		       (mapcar (function (lambda (tag-list)
-					; If the format for
-					; tempo-local-tags changes,
-					; change this
-					   (eval (car tag-list))))
-			       tempo-local-tags))))
-    (setq tempo-dirty-collection nil)))
-
-;;;
-;;; tempo-find-match-string
-
-(defun tempo-find-match-string (finder)
-  "Find a string to be matched against a tag list.
-FINDER is a function or a string.  Returns (STRING . POS), or nil
-if no reasonable string is found."
-  (cond ((stringp finder)
-	 (let (successful)
-	   (save-excursion
-	     (or (setq successful (re-search-backward finder nil t))
-		 0))
-	   (if successful
-	       (cons (buffer-substring (match-beginning 1)
-				       (match-end 1)) ; This seems to be a
-					; bug in emacs
-		     (match-beginning 1))
-	     nil)))
-	(t
-	 (funcall finder))))
-
-;;;
-;;; tempo-complete-tag
-
-(defun tempo-complete-tag (&optional silent)
-  "Look for a tag and expand it.
-All the tags in the tag lists in `tempo-local-tags'
-\(this includes `tempo-tags') are searched for a match for the text
-before the point.  The way the string to match for is determined can
-be altered with the variable `tempo-match-finder'.  If
-`tempo-match-finder' returns nil, then the results are the same as
-no match at all.
-
-If a single match is found, the corresponding template is expanded in
-place of the matching string.
-
-If a partial completion or no match at all is found, and SILENT is
-non-nil, the function will give a signal.
-
-If a partial completion is found and `tempo-show-completion-buffer' is
-non-nil, a buffer containing possible completions is displayed."
-
-  ;; This function may look like a hack, but this is how I want it to
-  ;; work.
-  (interactive "*")
-  (let* ((collection (tempo-build-collection))
-	 (match-info (tempo-find-match-string tempo-match-finder))
-	 (match-string (car match-info))
-	 (match-start (cdr match-info))
-	 (exact (assoc match-string collection))
-	 (compl (or (car exact)
-		    (and match-info (try-completion match-string collection)))))
-    (if compl (delete-region match-start (point)))
-    (cond ((null match-info) (or silent (ding)))
-	  ((null compl) (or silent (ding)))
-	  ((eq compl t) (tempo-insert-template
-			 (cdr (assoc match-string
-				     collection))
-			 nil))
-	  (t (if (setq exact (assoc compl collection))
-		 (tempo-insert-template (cdr exact) nil)
-	       (insert compl)
-	       (or silent (ding))
-	       (if tempo-show-completion-buffer
-		   (tempo-display-completions match-string
-					      collection)))))))
-
-
-;;;
-;;; tempo-display-completions
-
-(defun tempo-display-completions (string tag-list)
-  "Show a buffer containing possible completions for STRING."
-  (if tempo-leave-completion-buffer
-      (with-output-to-temp-buffer "*Completions*"
-	(display-completion-list
-	 (all-completions string tag-list)))
-    (save-window-excursion
-      (with-output-to-temp-buffer "*Completions*"
-	(display-completion-list
-	 (all-completions string tag-list)))
-      (sit-for 32767))))
-
-;;;
-;;; tempo-expand-if-complete
-
-(defun tempo-expand-if-complete ()
-  "Expand the tag before point if it is complete.
-Returns non-nil if an expansion was made and nil otherwise.
-
-This could as an example be used in a command that is bound to the
-space bar, and looks something like this:
-
-\(defun tempo-space ()
-  (interactive \"*\")
-  (or (tempo-expand-if-complete)
-      (insert \" \")))"
-
-  (interactive "*")
-  (let* ((collection (tempo-build-collection))
-	 (match-info (tempo-find-match-string tempo-match-finder))
-	 (match-string (car match-info))
-	 (match-start (cdr match-info))
-	 (exact (assoc match-string collection)))
-    (if exact
-	(progn
-	  (delete-region match-start (point))
-	  (tempo-insert-template (cdr exact) nil)
-	  t)
-      nil)))
-
-(provide 'tempo)
-
-;;; tempo.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/toolbar-utils.el b/xemacs-packages/lisp/edit-utils/toolbar-utils.el
deleted file mode 100644
index 0ef97343..00000000
--- a/xemacs-packages/lisp/edit-utils/toolbar-utils.el
+++ /dev/null
@@ -1,484 +0,0 @@
-;;; toolbar-utils.el --- Toolbar utility functions for XEmacs
-
-;; Copyright (C) 1997, 2002 by Free Software Foundation, Inc.
-
-;; Author: Stephen J. Turnbull 
-;;         Jeff Miller 
-;; Created: 1997
-;; Last-Modified: 03 December 2002
-;; Keywords: gui, services
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; This file contains utilities for managing XEmacs toolbars.
-;; It doesn't seem to make sense to provide GNU compatibility here.
-;; Instead, it seems much more reliable to reimplement the XEmacs
-;; APIs for GNU.
-
-;; This code is inspired by that written by Jeff Miller, and retains
-;; his APIs.  However, it is a thorough rewrite.
-;; See also edit-toolbar.el by Peter D. Pezaris 
-
-;;; Change Log: see package ChangeLog.
-
-;; To do:
-
-;; 1. Probably should convert all these to use &keywords?
-;; 2. Behavior-like implementation of "mode locales".
-;; 3. Implement toolbar-replace-button (by position or content).
-;; 5. Make an xemacs-toolbar version to do something sane in GNU.
-
-;;; Code:
-
-;;;###autoload
-(defun restore-initial-toolbar ()
-  "Restores the default toolbar defined by initial-toolbar-spec.
-
-There is also a cache of killed buttons in `button-palette'."
-  (interactive)
-  (set-specifier default-toolbar initial-toolbar-spec))
-
-;;; Variables:
-
-;; #### need parent group
-(defgroup edit-toolbar nil
-  "Tools for interactive editing and non-interactive management of toolbars.")
-
-(defcustom toolbar-button-default-position 'right
-  "Default position for adding toolbar buttons on the fly.
-
-See `toolbar-add-button-on-the-fly' for possible values and meanings."
-  :type 'sexp
-  :group 'edit-toolbar)
-
-;; This needs to be a toolbar descriptor.  We should make a function to
-;; stick it in a non-default toolbar, with surgery done on the function
-;; so that pressing the palette buttons moves them to another toolbar.
-(defvar button-palette nil
-  "List of buttons cut from toolbars.
-
-Note this is actually a toolbar descriptor.")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; User commands:
-
-;; toolbar-add-button-on-the-fly
-
-;; #### This really belongs in edit-toolbar.el, except that it requires
-;; functions from this file and edit-toolbar.el otherwise would not.
-;;;###autoload
-(defun toolbar-add-button-on-the-fly (description command label
-				      &optional position locale)
-  "Add an button at POSITION to the default toolbar of the selected window.
-Returns t.
-
-#### The return value may change.  Tell stephen@xemacs.org what value
-you think would be (most) useful.
-
-DESCRIPTION is a string describing the action, and displayed as help.
-COMMAND is an interactive command (ie, a symbol with an interactive function
-definition) implementing the action.
-LABEL is a string used to label the button.
-POSITION is an optional position (a non-negative integer, or one of the
-symbols 'left, 'right, or 'extreme-right, see `toolbar-add-item').
-LOCALE is an optional locale, defaulting to the current buffer.  If current-
-buffer-only is not what you want, and you don't understand specifier locales,
-use 'global.  It's safe and probably does what you want.
-
-#### No error checking, use at your own risk."
-
-  (interactive (list (read-string "Description: ")
-		     (read-command "Command: ")
-		     (read-string "Button label: ")
-		     (read (completing-read
-			    "Position: "
-			    (lambda (x junk morejunk)
-			      (cond ((let ((y (read x)))
-				       (and (integerp y)
-					    (<= 0 y)))
-				     x)
-				    ((try-completion x '(("left")
-							 ("extreme-right")
-							 ("right"))))))
-		       nil nil nil nil "right"))
-		     current-prefix-arg))
-
-  (let ((domain (selected-window))
-	(button (toolbar-new-button label command description)))
-    (set-specifier default-toolbar
-		   (toolbar-add-item (specifier-instance default-toolbar
-							 domain)
-				     button
-				     position)
-		   (or locale (current-buffer))))
-  t)
-
-;; toolbar-add-kbd-macro
-
-;;;###autoload
-(defun toolbar-add-kbd-macro (mac icon is-file)
-  "Add a button invoking a keyboard macro to the toolbar of the current buffer.
-The button is added at the end of the left group.
-
-MAC is a keyboard macro name, or the empty string or nil to use a copy of
-the last keyboard macro defined.
-ICON is a string specifying the icon to be used.  If IS-FILE is non-nil,
-it is interpreted as the name of an image file, and searched for using
-`locate-data-file'.  Otherwise it is used verbatim as a label.
-
-Interactively, prompts for the macro name MAC and an ICON.  IS-FILE is
-non-nil if a prefix argument was used.
-
-Warning: the interpretation of the prefix argument is likely to change."
-  (interactive
-   (list (read-string "Macro name (RET to use last defined macro): ")
-	 (read-string (format "Icon %s: "
-			      (if current-prefix-arg "image" "label")))
-	 current-prefix-arg))
-  (let* ((locale (current-buffer))
-	 (position nil)
-	 (mac (if (or (null mac) (= 0 (length mac)))
-		  ;; is there an argument pro or con to copy-sequence?
-		  last-kbd-macro
-		(intern mac)))
-	 ;; #### this actually probably just works, and we don't even need
-	 ;; the IS-FILE argument at all
-	 (icon (if is-file
-		   (error 'unimplemented "We don't do image icons yet")
-		 icon))
-	 ;; this is actually the help string
-	 (label (cond ((and is-file mac))
-		      ;;  #### should truncate image file extension if any
-		      ((and (stringp icon) (< 0 (length icon))) icon)
-		      (t "KbdMac")))
-	 (button (toolbar-new-button icon
-				     `(lambda ()
-					(interactive)
-					(execute-kbd-macro ,mac))
-				     label)))
-    ;; #### need to abstract this
-    ;; something like (toolbar-update-toolbar TOOLBAR ITEM POS LOCALE)
-    (set-specifier default-toolbar
-		   (toolbar-add-item (cdadar
-				      (specifier-spec-list default-toolbar
-							   locale))
-				     button
-				     position)
-		   locale))
-  t)
-
-;; #### this should be a behavior
-;;;###autoload
-(defun toolbar-add-execute-macro-button ()
-  "Add a button to the global toolbar to execute the last keyboard macro.
-
-Unlike `toolbar-add-kbd-macro', this does not copy the macro.  The macro
-executed will change with redefinitions.
-
-Due to a simple implementation, this button will not appear in buffers with
-local toolbars if invoked after the toolbar is installed.  If you like this
-button, it's probably best to invoke this function in your init file."
-  (interactive)
-  (let* ((locale 'global)
-	 (spec (cdadar (specifier-spec-list default-toolbar locale)))
-	 (button (toolbar-new-button "LastMac"
-				     #'toolbar-execute-last-kbd-macro
-				     "Execute last defined keyboard macro")))
-    (set-specifier default-toolbar (toolbar-add-item spec button) locale)))
-
-;; if this is defsubst, XEmacs 21.4.10 crashes?
-(defun toolbar-execute-last-kbd-macro ()
-  (interactive)
-  (execute-kbd-macro last-kbd-macro))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Lisp API functions:
-
-;; adding items to a toolbar, with convenience functions for constructing
-;; valid buttons, spacers, and toolbar descriptors
-
-;;;###autoload
-(defun toolbar-update-toolbar (item &optional toolbar position locale)
-  "Use ITEM to update TOOLBAR at POSITION in LOCALE.
-
-ITEM is a toolbar button or spacer specification (eg, from
-`toolbar-new-button' or `toolbar-new-spacer').
-Optional TOOLBAR is a toolbar specifier object.  It defaults to the value
-of `default-toolbar'.
-Optional POSITION is a non-negative integer or a symbol (for valid values,
-see `toolbar-add-item').  The default is 'right.
-Optional LOCALE is a specifier locale.  The default is 'global.  (This
-default is not yet set in stone; it's best not to depend on it.)
-
-This is a convenience function for helper applications or minor modes that
-would like to add a small number of buttons to an existing toolbar.  For
-constructing toolbars from scratch, use list and vector primitives, or
-`toolbar-add-item'."
-  (setq toolbar (or toolbar default-toolbar))
-  (setq position (or position 'right))
-  (setq locale (or locale 'global))
-  (let ((spec (cdadar (specifier-spec-list toolbar locale))))
-    (set-specifier toolbar (toolbar-add-item spec item position) locale)))
-
-
-;;;###autoload
-(defun toolbar-add-item (toolbar-spec item &optional position)
-  "Add ITEM to TOOLBAR-SPEC at POSITION, and return TOOLBAR-SPEC.
-Uses functions that alter list structure.
-
-TOOLBAR-SPEC is a toolbar descriptor (eg, from `toolbar-new-toolbar').
-ITEM is a toolbar button or spacer specification (eg, from
-`toolbar-new-button' or `toolbar-new-spacer').
-Optional POSITION is a non-negative integer, with 0 being the extreme left and
-\(length TOOLBAR-SPEC) the extreme right.  The symbols 'left, 'right, and
-'extreme-right are also accepted.  'left is synonymous with 0.  'right places
-ITEM at the right end of the left group of buttons.  'extreme-right places
-ITEM at the extreme right of the toolbar, creating a right group if one
-does not exist.
-
-#### This function does not yet support inserting the group delimiter nil
-as an explicit item.
-
-POSITION may be greater than (length TOOLBAR-SPEC), in which case it is
-truncated to (length TOOLBAR-SPEC).  Note that (length TOOLBAR-SPEC) is not
-synonymous with either 'right or 'extreme-right."
-  (check-valid-instantiator toolbar-spec 'toolbar)
-  (check-toolbar-button-syntax item)
-  (unless position (setq position toolbar-button-default-position))
-  (cond ((eq position 'right)
-	 (let ((tail (memq nil toolbar-spec)))
-	   (if (not tail)
-	       (nconc toolbar-spec (list item))
-	     ;; is this overly tricky?
-	     (setcar tail item)
-	     (setcdr tail (cons nil (cdr tail)))
-	     toolbar-spec)))
-	((or (eq position 'left) (eq position 0))
-	 (cons item toolbar-spec))
-	((eq position 'extreme-right)
-	 (nconc toolbar-spec (if (memq nil toolbar-spec)
-				 (list item)
-			       (list nil item))))
-	((and (integerp position) (< 0 position))
-	 (let ((tail (nthcdr 1 toolbar-spec)))
-	   (if (null tail)
-	       (nconc toolbar-spec (list item))
-	     ;; is this overly tricky?
-	     (setcdr tail (cons (car tail) (cdr tail)))
-	     (setcar tail item)
-	     toolbar-spec)))
-	(t (error 'wrong-type-argument
-		  'integer-or-symbol
-		  position))))
-
-;;;###autoload
-(defun toolbar-new-button (icon-spec command help-string
-			   &optional initially-disabled)
-  "Return a checked toolbar button specification.
-
-ICON-SPEC should be a list of glyphs (from `make-glyph'), a glyph, or a
-string to use as the button's icon.  If a string or single glyph, it will
-be used for the button-up glyph.  If a list, it may contain 1 to 6 glyphs,
-which XEmacs will use for button up, button down, button disabled, button
-up with caption, button down with caption, and button disabled with caption,
-in that order.  Missing or nil glyphs will be defaulted.  (#### Strings as
-list elements are not supported but could be.)
-COMMAND is the (interactive) command to invoke when the button is pressed.
-HELP-STRING is a string briefly describing the command, displayed in the
-echo area or as balloon help when the pointer enters the button.
-Optional argument INITIALLY-DISABLED, if non-nil, specifies that the button
-should initially be disabled.
-
-See `default-toolbar' or the Lispref (node toolbars) for more information."
-  (setq icon-spec (cond ((glyphp icon-spec) (list icon-spec))
-			((stringp icon-spec) (list (make-glyph icon-spec)))
-			((listp icon-spec) icon-spec)))
-  (let ((button-spec
-	 (vector icon-spec command (not initially-disabled) help-string)))
-    (check-toolbar-button-syntax button-spec)
-    button-spec))
-
-;;;###autoload
-(defun toolbar-new-spacer (style &optional size)
-  "Returns a checked toolbar spacer \"button\".
-
-STYLE is one of the symbols '2d or '3d, indicating whether the area is
-displayed without shadows (giving it a flat appearance), or with shadows
-\(giving it a raised, 3-d appearance).  There is no default.
-#### We may set a default style.  Tell stephen@xemacs.org which you use.
-SIZE specifies the length, in pixels, of the blank area.  If omitted,
-it defaults to a device-specific value (8 pixels for X devices)."
-  (let* ((style (or style '2d))
-	 (button (if size
-		     (vector :style style :size size)
-		   (vector :style style))))
-    (check-toolbar-button-syntax button)
-    button))
-
-;;;###autoload
-(defun make-toolbar-instantiator (&optional toolbar-spec domain)
-  "Return a checked toolbar instantiator, a list of vectors.
-
-TOOLBAR-SPEC may be a list of buttons (ie, a toolbar descriptor, see
-`default-toolbar'), a toolbar specifier object, or a symbol whose value is
-a toolbar specifier object.  If a toolbar specifier object or variable
-containing one, the specification for DOMAIN is used.  If non-nil, DOMAIN
-must be a window, a frame, or a device, otherwise it defaults to the selected
-window (see `specifier-instance').  The list thus generated is checked and
-returned.
-
-If TOOLBAR-SPEC is a list, it is copied; it is safe to pass other packages'
-toolbar initializers to this function.  However, you probably do not want
-to change any of the objects in the returned specification.  They are
-returned as is, not copied.
-
-See `default-toolbar' or the Lispref (node toolbars) for more information."
-  (setq toolbar-spec
-	(cond ((null toolbar-spec) nil)
-
-	      ((symbolp toolbar-spec)
-	       (specifier-instance (symbol-value toolbar-spec) domain))
-	      ((specifierp toolbar-spec)
-	       (specifier-instance toolbar-spec domain))
-	      ((listp toolbar-spec) (copy-sequence toolbar-spec))
-	      (t toolbar-spec)))	; errors by check-valid-instantiator
-  (check-valid-instantiator toolbar-spec 'toolbar)
-  toolbar-spec)
-
-;; removing buttons from a toolbar
-
-;;;###autoload
-(defun toolbar-kill-item-pos (pos &optional toolbar locale)
-  "Kill the item at position POS of TOOLBAR in LOCALE.
-Killed buttons are prepended to `button-palette'.
-
-LOCALE defaults to 'global.  If there are multiple specs for LOCALE, take
-the first one.
-
-This function currently does not accept symbolic positions a la
-`toolbar-add-item'.  Use `toolbar-find-item' to locate whole buttons and
-spacers, and `toolbar-find-button' to locate buttons by characteristics.
-See also `toolbar-find-button-by-icon', `toolbar-find-button-by-command',
-and `toolbar-find-button-by-help-string'."
-  (setq locale (or locale 'global))
-  (let ((spec (cdadar (specifier-spec-list (or toolbar default-toolbar)
-					   locale))))
-    (setq button-palette (cons (nth pos spec) button-palette))
-    (set-specifier toolbar (if (eq pos 0)
-			       (cdr spec)
-			     (setcdr (nthcdr (1- pos) spec) 
-				     (nthcdr (1+ pos) spec)))
-		   locale)))
-
-;; locating buttons by their content, returning a position
-
-;;;###autoload
-(defun toolbar-find-button (item &optional toolbar locale)
-  "Return the position of a button containing ITEM in its specification.
-
-ITEM may specify a button, spacer, icon, command, help string, or nil.
-If ITEM is nil, find the separator between the group of buttons to be left
-justified, and the group to be right justified.  (Distinctions among the
-various \"search key types\" are somewhat heuristic but are probably
-reliable enough to use in library code.)
-
-If TOOLBAR is non-nil, search it; otherwise search the default toolbar.
-If LOCALE is non-nil, get TOOLBAR's descriptor in that locale, otherwise
-use the global locale."
-  (setq toolbar (or toolbar default-toolbar))
-  (setq locale (or locale 'global))
-  (cond ((or (null item) (vectorp item)) (toolbar-find-item item))
-	((commandp item) (toolbar-find-button-by-command item toolbar locale))
-	((stringp item)
-	 (toolbar-find-button-by-help-string item toolbar locale))
-	(t (toolbar-find-button-by-icon item toolbar locale))))
-
-;;;###autoload
-(defun toolbar-find-item (item &optional toolbar locale)
-  "Return the position of ITEM, a button, spacer, or nil.
-TOOLBAR and LOCALE determine the descriptor to be searched.
-
-If ITEM is nil, find the separator between the group of buttons to be left
-justified, and the group to be right justified.
-If there are several matching items, the first is returned.  If none is
-found, return nil."
-  (catch 'found
-    (let ((pos 0))
-      (while toolbar
-	(if (equal (car toolbar) item) (throw 'found pos))
-	(setq pos (1+ pos))
-	(setq toolbar (cdr toolbar)))
-      nil)))
-
-;; internals -- if you think these should be autoloaded, let me know
-(defun toolbar-find-button-by-icon (icon &optional toolbar locale)
-  "Return the position of a button with icon ICON.
-ICON must be a list of glyphs or a symbols whose value is a list of glyphs.
-TOOLBAR and LOCALE determine the descriptor to be searched.
-
-If there are several matching buttons, the first is returned."
-  (flet ((thunk (x) (if (symbolp x) (symbol-value x) x)))
-    (toolbar-find-button-by-element icon 0 toolbar locale #'thunk)))
-
-(defun toolbar-find-button-by-command (cmd &optional toolbar locale)
-  "Return the position of a button invoking command CMD.
-TOOLBAR and LOCALE determine the descriptor to be searched.
-
-If there are several matching buttons, the first is returned."
-  (toolbar-find-button-by-element cmd 2 toolbar locale))
-
-(defun toolbar-find-button-by-help-string (str &optional toolbar locale)
-  "Return the position of a button with help-string STR.
-TOOLBAR and LOCALE determine the descriptor to be searched.
-
-If there are several matching buttons, the first is returned.
-This function will not find spacers."
-  (toolbar-find-button-by-element str 3 toolbar locale))
-
-(defun toolbar-find-button-by-element (object index toolbar locale
-				       &optional thunk)
-  "Return the position of a button containing OBJECT in element INDEX.
-TOOLBAR and LOCALE determine the descriptor to be searched.
-
-Optional argument THUNK is a function of one argument which is used to
-normalize OBJECT for comparison.
-
-If there are several matching buttons, the first is returned.
-This function will not find spacers."
-  (setq toolbar (or toolbar default-toolbar))
-  (setq locale (or locale 'global))
-  (if thunk (setq object (funcall thunk object)))
-  (let ((desc (cdadar (specifier-spec-list toolbar locale)))
-	(pos 0))
-    ;; #### rewrite this as a catch ... throw
-    (while (not (equal object (let ((el (aref (car desc) index)))
-				(if thunk (funcall thunk el) el))))
-      (setq desc (cdr desc))
-      (setq pos (1+ pos)))
-    (if toolbar pos nil)))
-
-(provide 'toolbar-utils)
-
-;;; toolbar-utils.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/tree-menu.el b/xemacs-packages/lisp/edit-utils/tree-menu.el
deleted file mode 100644
index d0ddd8f5..00000000
--- a/xemacs-packages/lisp/edit-utils/tree-menu.el
+++ /dev/null
@@ -1,199 +0,0 @@
-;;; tree-menu.el
-;;; v1.20; 10-May-1994
-;;; Copyright (C) 1994 Heiko Muenkel
-;;; email: muenkel@tnt.uni-hannover.de
-;;;
-;;;  This program is free software; you can redistribute it and/or modify
-;;;  it under the terms of the GNU General Public License as published by
-;;;  the Free Software Foundation; either version 1, or (at your option)
-;;;  any later version.
-;;;
-;;;  This program is distributed in the hope that it will be useful,
-;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;  GNU General Public License for more details.
-;;;
-;;;  You should have received a copy of the GNU General Public License
-;;;  along with this program; if not, write to the Free Software
-;;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-;;;
-;;; Synched up with: Not in FSF.
-;;; 
-;;; Description:
-;;;
-;;;	Provides the functions `tree-make-file-list' and `tree-make-menu'.
-;;;	With these functions it is possible to generate file browsing menus,
-;;; 	where each menu-item calls the same function, but on different files.
-;;;	Example: 
-;;; 		(popup-menu (cons "Open File"
-;;;		  	          (tree-make-menu (tree-make-file-list "~/")
-;;;				  		  'find-file
-;;;				  		  t
-;;;				  		  t
-;;;				  		  '("\\..*"))))
-;;;
-;;;	Note: This function is very time consuming ! Therefore you should
-;;;	      call `tree-make-file-list' once and make several menus
-;;;	      from the same list. And you should only rebuild the menu if 
-;;;	      it is necessary, if you've a big directory tree.
-;;;
-;;; Installation: 
-;;;   
-;;;	Put this file in one of your lisp load directories.
-;;;
-;;;  Changed 18-May-1995, Kyle Jones
-;;;    Removed the need for the utils.el package and references thereto.
-;;;    Changed file-truename calls to tree-menu-file-truename so
-;;;    the calls could be made compatible with FSF Emacs 19's
-;;;    file-truename function.
-
-(defvar tree-ls-flags "-AFLR" 
-  "*A String with the flags used in the function tree-ls-in-temp-buffer 
-for the ls command. Be careful if you want to change this variable. 
-The ls command must append a / on all files which are directories. 
-The original flags are -AFLR.")
-
-
-(defun tree-ls-in-temp-buffer (dir temp-buffer)
-"List the directory DIR in the TEMP-BUFFER."
-  (switch-to-buffer temp-buffer)
-  (erase-buffer)
-  (call-process "ls" nil temp-buffer nil tree-ls-flags dir)
-  (goto-char (point-min))
-  (while (search-forward "//" nil t)
-    (replace-match "/"))
-  (goto-char (point-min)))
-
-
-(defvar tree-temp-buffername "*tree*"
-  "Name of the temp buffers in tree.")
-
-
-(defun tree-make-file-list-1 (root list)
-  (let ((filename (buffer-substring (point) (progn
-					      (end-of-line)
-					      (point)))))
-    (while (not (string= filename ""))
-      (setq 
-       list 
-       (append
-	list
-	(list
-	 (cond ((char-equal (char-after (- (point) 1)) ?/)
-		;; Directory
-		(setq filename (substring filename 0 (1- (length filename))))
-		(save-excursion
-		  (search-forward (concat root filename ":"))
-		  (forward-line)
-		  (tree-make-file-list-1 (concat root filename "/")
-						(list (tree-menu-file-truename 
-						       filename
-						       root)))))
-	       ((char-equal (char-after (- (point) 1)) ?*)
-		;; Executable
-		(setq filename (substring filename 0 (1- (length filename))))
-		(tree-menu-file-truename filename root))
-	       (t (tree-menu-file-truename filename root))))))
-      (forward-line)
-      (setq filename (buffer-substring (point) (progn
-						 (end-of-line)
-						 (point)))))
-    list))
-
-
-(defun tree-menu-file-truename (file &optional root)
-  (file-truename (expand-file-name file root)))
-
-(defun tree-make-file-list (dir)
-  "Makes a list with the files and subdirectories of DIR.
-The list looks like: ((dirname1 file1 file2) 
-                      file3
-                      (dirname2 (dirname3 file4 file5) file6))"
-  (save-window-excursion
-    (setq dir (expand-file-name dir))
-    (if (not (string= (substring dir -1) "/"))
-	(setq dir (concat dir "/")))
-;;    (while (string-match "/$" dir)
-;;      (setq dir (substring dir 0 -1)))
-    (tree-ls-in-temp-buffer dir
-				 (generate-new-buffer-name 
-				  tree-temp-buffername))
-    (let ((list nil))
-      (setq list (tree-make-file-list-1 dir nil))
-      (kill-buffer (current-buffer))
-      list)))
-
-
-(defun tree-hide-file-p (filename re-hidden-file-list)
-  "t, if one of the regexps in RE-HIDDEN-FILE-LIST matches the FILENAME."
-  (cond ((not re-hidden-file-list) nil)
-	((string-match (car re-hidden-file-list) 
-		       (tree-menu-file-truename filename)))
-	(t (tree-hide-file-p filename (cdr re-hidden-file-list)))))
-
-
-(defun tree-make-menu (dirlist 
-		       function 
-		       selectable 
-		       &optional 
-		       no-hidden-dirs
-		       re-hidden-file-list
-		       include-current-dir)
-  "Returns a menu list.
-Each item of the menu list has the form 
- [\"subdir\" (FUNCTION \"dir\") SELECTABLE].
-Hidden directories (with a leading point) are suppressed, 
-if NO-HIDDEN-DIRS are non nil. Also all files which are
-matching a regexp in RE-HIDDEN-FILE-LIST are suppressed.
-If INCLUDE-CURRENT-DIR non nil, then an additional command
-for the current directory (.) is inserted."
-  (let ((subdir nil)
-	(menulist nil))
-    (while (setq subdir (car dirlist))
-      (setq dirlist (cdr dirlist))
-      (cond ((and (stringp subdir)
-		  (not (tree-hide-file-p subdir re-hidden-file-list)))
-	     (setq menulist
-		   (append menulist
-			   (list
-			    (vector (file-name-nondirectory subdir)
-				    (list function subdir)
-				    selectable)))))
-	    ((and (listp subdir)
-		  (or (not no-hidden-dirs)
-		      (not (char-equal 
-			    ?.
-			    (string-to-char 
-			     (file-name-nondirectory (car subdir))))))
-		  (setq menulist
-			(append 
-			 menulist
-			 (list
-			  (cons (file-name-nondirectory (car subdir))
-				(if include-current-dir
-				    (cons
-				     (vector "."
-					     (list function
-						   (car subdir))
-					     selectable)
-				     (tree-make-menu (cdr subdir)
-						     function
-						     selectable
-						     no-hidden-dirs
-						     re-hidden-file-list
-						     include-current-dir
-						     ))
-				  (tree-make-menu (cdr subdir)
-						  function
-						  selectable
-						  no-hidden-dirs
-						  re-hidden-file-list
-						  ))))))))
-	    (t nil))
-      )
-    menulist
-    )
-  )
-
-
-(provide 'tree-menu)
diff --git a/xemacs-packages/lisp/edit-utils/uniquify.el b/xemacs-packages/lisp/edit-utils/uniquify.el
deleted file mode 100644
index e6ff82b5..00000000
--- a/xemacs-packages/lisp/edit-utils/uniquify.el
+++ /dev/null
@@ -1,478 +0,0 @@
-;;; uniquify.el --- unique buffer names dependent on file name
-
-;; Copyright (c) 1989, 1995, 1996, 1997 Free Software Foundation, Inc.
-
-;; Author: Dick King 
-;; Maintainer: Michael Ernst 
-;; Created: 15 May 86
-;; Time-stamp: <99/11/11 09:50:44 aj>
-
-;; 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:
-
-;; Emacs's standard method for making buffer names unique adds <2>, <3>,
-;; etc. to the end of (all but one of) the buffers.  This file replaces
-;; that behavior, for buffers visiting files and dired buffers, with a
-;; uniquification that adds parts of the file name until the buffer names
-;; are unique.  For instance, buffers visiting /u/mernst/tmp/Makefile and
-;; /usr/projects/zaphod/Makefile would be named Makefile|tmp and
-;; Makefile|zaphod, respectively (instead of Makefile and Makefile<2>).
-;; Other buffer name styles are also available.
-
-;; To use this file, load it or add (require 'uniquify) to your ".emacs"
-;; and set `uniquify-buffer-name-style' to one of its non-nil alternative
-;; values.
-
-;; For other options, see "User-visible variables", below.
-
-;; A version of uniquify.el that works under Emacs 18, Emacs 19, XEmacs 19,
-;; and InfoDock is available from the maintainer.
-
-;;; Change Log:
-
-;; Originally by Dick King  15 May 86
-;; Converted for Emacs 18 by Stephen Gildea 
-;; Make uniquify-min-dir-content 0 truly non-invasive.  gildea 23 May 89
-;; Some cleanup.  uniquify-min-dir-content default 0.  gildea 01 Jun 89
-;; Don't rename to "".  Michael Ernst  15 Jun 94
-;; Add kill-buffer-hook.  Kenneth Manheimer  09 May 95
-;; Add advice for rename-buffer and create-file-buffer, handle dired buffers,
-;;  kill-buffer-rationalize-buffer-names-p, documentation.  mernst 24 May 95
-;; Remove free variables, fix typos.  mernst 5 Jun 95
-;; Efficiently support Emacs 19.27 & earlier.  ken.manheimer, mernst 10 Jun 95
-;; Rename user options to "uniquify-...", add uniquify-reverse-dir-content-p,
-;;  add uniquify-ask-about-buffer-names-p.  king, mernst 13 Jun 95
-;; Prefix functions by "uniquify-..."; rename mnemonic-buffer-names to
-;;  uniquify-buffer-name-style; add 'forward and 'post-forward-angle-brackets
-;;  styles; remove uniquify-reverse-dir-content-p; add
-;;  uniquify-trailing-separator-p.  mernst 4 Aug 95
-;; Don't call expand-file-name on nil.  mernst 7 Jan 96
-;; Check whether list-buffers-directory is bound.  mernst 11 Oct 96
-;; Ignore non-file non-dired buffers. Colin Rafferty  3 Mar 97
-;; Use last component, not "", for file name of directories.  mernst 27 Jun 97
-;; Use directory-file-name; code cleanup.  mernst 6 Sep 97
-;; Add uniquify-ignore-buffers-re.
-;;  Andre Srinivasan  9 Sep 97
-
-;; Valuable feedback was provided by
-;; Paul Smith ,
-;; Alastair Burt ,
-;; Bob Weiner ,
-;; Albert L. Ting ,
-;; gyro@reasoning.com,
-;; Bryan O'Sullivan .
-
-
-;;; Code:
-
-(provide 'uniquify)
-
-;;; User-visible variables
-
-(defgroup uniquify nil
-  "Unique buffer names dependent on file name"
-  :group 'applications)
-
-
-(defcustom uniquify-buffer-name-style nil
-  "*If non-nil, buffer names are uniquified with parts of directory name.
-The value determines the buffer name style and is one of `forward',
-`reverse', `post-forward' (the default), or `post-forward-angle-brackets'.
-For example, files `/foo/bar/mumble/name' and `/baz/quux/mumble/name'
-would have the following buffer names in the various styles:
-  forward        bar/mumble/name  quux/mumble/name
-  reverse        name\\mumble\\bar  name\\mumble\\quux
-  post-forward   name|bar/mumble  name|quux/mumble
-  post-forward-angle-brackets   name  name
-  nil            name  name<2>"
-  :type '(radio (const forward)
-		(const reverse)
-		(const post-forward)
-		(const post-forward-angle-brackets)
-		(const :tag "standard Emacs behavior (nil)" nil))
-  :group 'uniquify)
-
-(defcustom uniquify-after-kill-buffer-p nil
-  "*If non-nil, rerationalize buffer names after a buffer has been killed.
-This can be dangerous if Emacs Lisp code is keeping track of buffers by their
-names (rather than keeping pointers to the buffers themselves)."
-  :type 'boolean
-  :group 'uniquify)
-
-(defcustom uniquify-ask-about-buffer-names-p nil
-  "*If non-nil, permit user to choose names for buffers with same base file.
-If the user chooses to name a buffer, uniquification is preempted and no
-other buffer names are changed."
-  :type 'boolean
-  :group 'uniquify)
-
-(defcustom uniquify-ignore-buffers-re nil
-  "*Regular expression matching buffer names that should not be uniquified.
-For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename
-draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the
-visited file name isn't the same as that of the buffer."
-  :type '(choice (const :tag "Uniquify all buffers" nil) regexp)
-  :group 'uniquify)
-
-(defcustom uniquify-ignore-buffers-mode-re "^Info-mode$"
-  "*Regexp matching names of major modes of buffers that should not be uniquified.
-For instance, set this to \"^\\\\(Info\\\\)\\\\|\\\\(message\\\\)-mode$\" to avoid
-having uniquify rename Info and mail message buffers."
-  :type '(choice (const :tag "Uniquify all buffers" nil) regexp)
-  :group 'uniquify)
-
-(defcustom uniquify-ignore-buffers-query-functions
-  '(uniquify-ignore-buffers-re
-    uniquify-ignore-buffers-mode-re)
-  "*Functions to call to determine if a buffer name should not be uniquified.
-The functions are called with one argument, the buffer.  If any function
-returns t, the buffer name is not uniquified."
-  :type '(repeat (function :format "%v"))
-  :group 'uniquify)
-
-(defcustom uniquify-min-dir-content 0
-  "*Minimum number of directory name components included in buffer name."
-  :type 'integer
-  :group 'uniquify)
-
-(defcustom uniquify-separator nil
-  "*String separator for buffer name components.
-When `uniquify-buffer-name-style' is `post-forward', separates
-base file name from directory part in buffer names (default \"|\").
-When `uniquify-buffer-name-style' is `reverse', separates all
-file name components (default \"\\\")."
-  :type '(choice (const nil) string)
-  :group 'uniquify)
-
-(defcustom uniquify-trailing-separator-p nil
-  "*If non-nil, add a file name separator to dired buffer names.
-If `uniquify-buffer-name-style' is `forward', add the separator at the end;
-if it is `reverse', add the separator at the beginning; otherwise, this
-variable is ignored."
-  :type 'boolean
-  :group 'uniquify)
-
-
-;;; Utilities
-
-(defmacro uniquify-push (item list)
-  (` (setq (, list) (cons (, item) (, list)))))
-
-;; For directories, return the last component, not the empty string.
-(defun uniquify-file-name-nondirectory (file-name)
-  (file-name-nondirectory (directory-file-name file-name)))
-
-;; uniquify-fix-list data structure
-(defmacro uniquify-fix-item-base (a)
-  (` (car (, a))))
-(defmacro uniquify-fix-item-filename (a)
-  (` (car (cdr (, a)))))
-(defmacro uniquify-fix-item-buffer (a)
-  (` (car (cdr (cdr (, a))))))
-;; Not a macro: passed to mapcar.
-(defun uniquify-fix-item-unrationalized-buffer (item)
-  (or (car (cdr (cdr (cdr item)))) nil))	;maybe better in the future
-
-(defun uniquify-fix-item-filename-lessp (fixlist1 fixlist2)
-  (uniquify-filename-lessp (uniquify-fix-item-filename fixlist1)
-			   (uniquify-fix-item-filename fixlist2)))
-
-;; Internal variables used free
-(defvar uniquify-non-file-buffer-names nil)
-(defvar uniquify-possibly-resolvable nil)
-
-;;; Main entry point.
-
-(defun uniquify-rationalize-file-buffer-names (&optional newbuffile newbuf)
-  "Makes file buffer names unique by adding segments from file name.
-If `uniquify-min-dir-content' > 0, always pulls that many
-file name elements.  Arguments cause only a subset of buffers to be renamed."
-  (interactive)
-  (let (fix-list
-	uniquify-non-file-buffer-names)
-    (let ((buffers (buffer-list)))
-      (while buffers
-	(let* ((buffer (car buffers))
-	       (bfn (if (eq buffer newbuf)
-                        (and newbuffile
-			     (expand-file-name
-			      (if (file-directory-p newbuffile)
-				  (directory-file-name newbuffile)
-			       newbuffile)))
-		      (uniquify-buffer-file-name buffer)))
-	       (rawname (and bfn (uniquify-file-name-nondirectory bfn)))
-	       (deserving (and rawname
-                               (not (run-hook-with-args-until-success
-                                     'uniquify-ignore-buffers-query-functions
-                                     buffer))
-			       (or (not newbuffile)
-				   (equal rawname
-					  (uniquify-file-name-nondirectory
-					   newbuffile))))))
-	  (if deserving
-	      (uniquify-push (list rawname bfn buffer nil) fix-list)
-	    (uniquify-push (list (buffer-name buffer))
-			   uniquify-non-file-buffer-names)))
-	(setq buffers (cdr buffers))))
-    ;; selects buffers whose names may need changing, and others that
-    ;; may conflict.
-    (setq fix-list
-	  (sort fix-list 'uniquify-fix-item-filename-lessp))
-    ;; bringing conflicting names together
-    (uniquify-rationalize-a-list fix-list uniquify-min-dir-content)
-    (mapcar 'uniquify-fix-item-unrationalized-buffer fix-list)))
-
-;; uniquify's version of buffer-file-name; result never contains trailing slash
-(defun uniquify-buffer-file-name (buffer)
-  "Return name of file BUFFER is visiting, or nil if none.
-Works on dired buffers and ordinary file-visiting buffers, but no others."
-  (or (buffer-file-name buffer)
-      (and (featurep 'dired)
-	   (save-excursion
-	     (set-buffer buffer)
-	     (and
-	      (eq major-mode 'dired-mode) ; do nothing if not a dired buffer
-	      (if (boundp 'list-buffers-directory) ; (XEmacs does define this!)
-		  (and list-buffers-directory
-		       (directory-file-name list-buffers-directory))
-		;; don't use default-directory if dired-directory is nil
-		(and dired-directory
-		     (expand-file-name
-		      (directory-file-name
-		       (if (consp dired-directory)
-			   (car dired-directory)
-			 dired-directory))))))))))
-
-;; This examines the filename components in reverse order.
-(defun uniquify-filename-lessp (s1 s2)
-  (let ((s1f (uniquify-file-name-nondirectory s1))
-	(s2f (uniquify-file-name-nondirectory s2)))
-    (and (not (equal s2f ""))
-	 (or (string-lessp s1f s2f)
-	     (and (equal s1f s2f)
-		  (let ((s1d (file-name-directory s1))
-			(s2d (file-name-directory s2)))
-		    (and (not (<= (length s2d) 1))
-			 (or (<= (length s1d) 1)
-			     (uniquify-filename-lessp
-			      (substring s1d 0 -1)
-			      (substring s2d 0 -1))))))))))
-
-(defun uniquify-rationalize-a-list (fix-list depth)
-  (let (conflicting-sublist	; all elements have the same proposed name
-	(old-name "")
-	proposed-name uniquify-possibly-resolvable)
-    (while fix-list
-      (let ((item (car fix-list)))
-	(setq proposed-name (uniquify-get-proposed-name item depth))
-	(if (not (equal proposed-name old-name))
-	    (progn
-	      (uniquify-rationalize-conflicting-sublist
-	       conflicting-sublist old-name depth)
-	      (setq conflicting-sublist nil)))
-	(uniquify-push item conflicting-sublist)
-	(setq old-name proposed-name))
-      (setq fix-list (cdr fix-list)))
-    (uniquify-rationalize-conflicting-sublist
-     conflicting-sublist old-name depth)))
-
-(defvar uniquify-directory-matching-regexp
-  (format "\\(^\\|%1$s[^%1$s]*\\)%1$s"
-	  (regexp-quote (string directory-sep-char))))
-
-(defun uniquify-get-proposed-name (item depth)
-  (let (index
-	(extra-string "")
-	(n depth)
-	(base (uniquify-fix-item-base item))
-	(fn (uniquify-fix-item-filename item)))
-    (while (and (> n 0)
-		(setq index (string-match
-			     (concat uniquify-directory-matching-regexp
-				     (regexp-quote extra-string)
-				     (regexp-quote base)
-				     "\\'")
-			     fn)))
-      (setq extra-string (substring fn
-				    (if (zerop index) 0 (1+ index))
-				    ;; (- (length base)) fails for base = "".
-				    ;; Equivalently, we could have used
-				    ;; (apply 'substring ...
-				    ;;        (and (not (string= "" base))
-				    ;;             (list (- (length base)))))
-				    (- (length fn) (length base)))
-	    n (1- n)))
-    (if (zerop n) (setq uniquify-possibly-resolvable t))
-
-
-    ;; Distinguish directories by adding extra separator.
-    (if (and uniquify-trailing-separator-p
-	     (file-directory-p fn)
-	     (not (string-equal base "")))
-	(cond ((eq uniquify-buffer-name-style 'forward)
-	       (setq base (concat base "/")))
-	      ((eq uniquify-buffer-name-style 'reverse)
-	       (setq base (concat (or uniquify-separator "\\") base)))))
-
-    ;; Trim trailing separator on directory part
-    (if (and (not (string-equal extra-string ""))
-	     (or (eq uniquify-buffer-name-style 'post-forward)
-		 (eq uniquify-buffer-name-style 'post-forward-angle-brackets)))
-	(setq extra-string (substring extra-string 0
-				      (- (length extra-string) 1))))
-
-    (cond ((string-equal extra-string "")
-	   base)
-	  ((string-equal base "")
-	   extra-string)
-	  ((eq uniquify-buffer-name-style 'forward)
-	   (concat extra-string base))
-	  ((eq uniquify-buffer-name-style 'reverse)
-	   (concat base (uniquify-reverse-components extra-string)))
-	  ((eq uniquify-buffer-name-style 'post-forward)
-	   (concat base (or uniquify-separator "|") extra-string))
-	  ((eq uniquify-buffer-name-style 'post-forward-angle-brackets)
-	   (concat base "<" extra-string ">"))
-	  (t (error "Bad value for uniquify-buffer-name-style: %s"
-		    uniquify-buffer-name-style)))))
-
-
-;; Deal with conflicting-sublist, all of whose elements have identical
-;; "base" components.
-(defun uniquify-rationalize-conflicting-sublist (conflicting-sublist old-name depth)
-  (or (null conflicting-sublist)
-      (and (null (cdr conflicting-sublist))
-	   (not (assoc old-name uniquify-non-file-buffer-names))
-	   (or (and (not (string= old-name ""))
-		    (uniquify-rename-buffer (car conflicting-sublist) old-name))
-	       t))
-      (if uniquify-possibly-resolvable
-	  (uniquify-rationalize-a-list conflicting-sublist (1+ depth)))))
-
-(defun uniquify-rename-buffer (item newname)
-  (let ((buffer (uniquify-fix-item-buffer item)))
-    (if (not (equal newname (buffer-name buffer)))
-	(let ((unset (current-buffer))
-	      ;; avoid hooks on rename-buffer
-	      (uniquify-buffer-name-style nil))
-	  (set-buffer buffer)
-	  (rename-buffer newname)
-	  (set-buffer unset))))
-  (rplaca (nthcdr 3 item) t))
-
-(defun uniquify-reverse-components (instring)
-  (let ((sofar '())
-	(cursor 0)
-	(len (length instring))
-	(sep (or uniquify-separator "\\")))
-    (while (< cursor len)
-      (if (= (aref instring cursor) directory-sep-char)
-          (setq sofar (cons sep sofar)
-                cursor (1+ cursor))
-        (let ((first-dirsep (or (string-match (string directory-sep-char)
-					     instring cursor)
-			       len)))
-          (setq sofar (cons (substring instring cursor first-dirsep) sofar)
-                cursor first-dirsep))))
-    (apply (function concat) sofar)))
-
-
-;;; Hooks from the rest of Emacs
-
-;; The logical place to put all this code is in generate-new-buffer-name.
-;; It's written in C, so we would add a generate-new-buffer-name-function
-;; which, if non-nil, would be called instead of the C.  One problem with
-;; that is that generate-new-buffer-name takes a potential buffer name as
-;; its argument -- not other information, such as what file the buffer will
-;; visit.
-
-;; The below solution works because generate-new-buffer-name is called
-;; only by rename-buffer (which, as of 19.29, is never called from C) and
-;; generate-new-buffer, which is called only by Lisp functions
-;; create-file-buffer and rename-uniquely.  Rename-uniquely generally
-;; isn't used for buffers visiting files, so it's sufficient to hook
-;; rename-buffer and create-file-buffer.  (Setting find-file-hooks isn't
-;; sufficient.)
-
-(defadvice rename-buffer (after rename-buffer-uniquify activate)
-  "Uniquify buffer names with parts of directory name."
-  (if (and uniquify-buffer-name-style
-	   ;; UNIQUE argument
-	   (ad-get-arg 1))
-      (progn
-	(if uniquify-after-kill-buffer-p
-	    ;; call with no argument; rationalize vs. old name as well as new
-	    (uniquify-rationalize-file-buffer-names)
-	  ;; call with argument: rationalize vs. new name only
-	  (uniquify-rationalize-file-buffer-names
-	   (uniquify-buffer-file-name (current-buffer)) (current-buffer)))
-	(setq ad-return-value (buffer-name (current-buffer))))))
-
-(defadvice create-file-buffer (after create-file-buffer-uniquify activate)
-  "Uniquify buffer names with parts of directory name."
-  (if uniquify-buffer-name-style
-      (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value)))
-
-;; Buffer deletion
-;; Rerationalize after a buffer is killed, to reduce coinciding buffer names.
-;; This mechanism uses `kill-buffer-hook', which runs *before* deletion.
-;; That means that the kill-buffer-hook function cannot just delete the
-;; buffer -- it has to set something to do the rationalization *later*.
-;; It actually puts another function on `post-command-hook'.  This other
-;; function runs the rationalization and then removes itself from the hook.
-;; Is there a better way to accomplish this?
-;; (This ought to set some global variables so the work is done only for
-;; buffers with names similar to the deleted buffer.  -MDE)
-
-(defun delay-uniquify-rationalize-file-buffer-names ()
-  "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'.
-For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion."
-  (if (and uniquify-buffer-name-style
-	   uniquify-after-kill-buffer-p)
-      (add-hook 'post-command-hook
-		'delayed-uniquify-rationalize-file-buffer-names)))
-
-(defun delayed-uniquify-rationalize-file-buffer-names ()
-  "Rerationalize buffer names and remove self from `post-command-hook'.
-See also `delay-rationalize-file-buffer-names' for hook setter."
-  (uniquify-rationalize-file-buffer-names)
-  (remove-hook 'post-command-hook
-	       'delayed-uniquify-rationalize-file-buffer-names))
-
-(defun uniquify-ignore-buffers-re (buffer)
-  "Returns t if the BUFFER's name matches  `uniquify-ignore-buffers-re'.
-Meant to be called from the `uniquify-ignore-buffers-query-functions'."
-  (and uniquify-ignore-buffers-re
-       (string-match
-        uniquify-ignore-buffers-re
-        (buffer-name buffer))))
-
-(defun uniquify-ignore-buffers-mode-re (buffer)
-  "Returns t if the BUFFER's major mode matches `uniquify-ignore-buffers-mode-re'.
-Meant to be called from the `uniquify-ignore-buffers-query-functions'."
-  (and uniquify-ignore-buffers-mode-re
-       (string-match
-        uniquify-ignore-buffers-mode-re
-        (symbol-name (with-current-buffer buffer
-                       major-mode)))))
-
-
-(add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names)
-
-;;; uniquify.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/vertical-mode.el b/xemacs-packages/lisp/edit-utils/vertical-mode.el
deleted file mode 100644
index 513cf5e1..00000000
--- a/xemacs-packages/lisp/edit-utils/vertical-mode.el
+++ /dev/null
@@ -1,76 +0,0 @@
-;;; -*- Emacs-Lisp -*-
-;;; vertical-mode.el --- Vertical mode for emacs
-
-;; Copyright (C) 1998-2000 Pavel Machek 
-;;
-;; Author: Pavel Machek 
-;; Version: $Id: vertical-mode.el,v 1.2 2002/03/24 20:52:50 youngs Exp $
-;; Keywords: 
-;; Requirements: 
-
-;; This file is part of XEmacs
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; 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 conviently edit things that are oriented vertically
-; (like tables in computer programs): after each action, cursor moves down. Therefore,
-; to move block of text to the right, you simply enter vertical mode and then hold
-; spacebar, waiting for autorepeat to do the job for you.
-
-;;; Code:
-
-(defun vertical-after-change (from to num)
-  "Function called after each change of text in vertical minor mode"
-  (goto-char vertical-goto-point)
-  (next-line 1))
-
-(defun vertical-before-change (from to)
-  (setq vertical-goto-point from)
-  (setq vertical-goto-column (current-column)))
-
-(defvar vertical-mode nil
-   "Vertical mode")
-
-(make-variable-buffer-local 'vertical-goto-point)
-(make-variable-buffer-local 'vertical-goto-column)
-(make-variable-buffer-local 'vertical-mode)
-
-;;;###autoload
-(defun vertical-mode (&optional arg)
-   "This function toggles vertical mode on and off."
-   (interactive)
-   (setq vertical-mode 
-      (if (null arg) (not vertical-mode)
-         (> (prefix-numeric-value arg) 0)))
-   (force-mode-line-update)
-   (make-local-hook 'before-change-functions)
-   (make-local-hook 'after-change-functions)
-   (if vertical-mode
-       (progn
-	 (add-hook 'before-change-functions 'vertical-before-change nil t)
-	 (add-hook 'after-change-functions 'vertical-after-change nil t))
-       (progn
-	 (remove-hook 'before-change-functions 'vertical-before-change t)
-	 (remove-hook 'after-change-functions 'vertical-after-change t))))
-
-(setq 
- minor-mode-alist (cons 
-		   '(vertical-mode " Vertical") minor-mode-alist))
-
-(provide 'vertical-mode)
-;;; vertical-mode.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/where-was-i-db.el b/xemacs-packages/lisp/edit-utils/where-was-i-db.el
deleted file mode 100644
index bcda156b..00000000
--- a/xemacs-packages/lisp/edit-utils/where-was-i-db.el
+++ /dev/null
@@ -1,364 +0,0 @@
-;;; where-was-i-db.el --- Keep persistent state in visited files.
-
-;; Copyright (C) 1997 by Free Software Foundation, Inc.
-;; Copyright (C) 1997 by Software in the Public Interest, Inc. (Debian GNU/Linux)
-;; Copyright (C) 1997 by Karl M. Hegbloom - Donated to the FSF and SPI.
-
-;; Author: Karl M. Hegbloom 
-;; Keywords: tools, data, wp
-;; Version: 1.3
-;; X-Requires: (:emacs "XEmacs" :>= 20.4 :feature 'berkeley-db)
-;; X-RCS-ID: #Id: where-was-i-db.el,v 1.3 1998/01/02 23:45:29 karlheg Exp karlheg #
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; This program hopes to become a standard and favored XEmacs feature
-;; on setups with Berkeley DB installed.  It is one of the first to
-;; exemplify automatic installation and deinstallation of editor
-;; features utilizing the `customize' interface, autoloading, lazy
-;; loading, and the `unload-feature' facility.
-
-;; Thank You all for the experience and the FREE source code.
-
-;; This Good Thing will make XEmacs keep track of where you were last
-;; time you visited a file.
-;;
-;; It works by installing functions on the `find-file-hooks' and on
-;; the buffer-local `kill-buffer-hook'.  When a buffer is killed, if
-;; it was visiting a file, and place saving has been enabled for it, a
-;; database entry is made, saving the location of `point'.  When you
-;; visit a file, the database is queried, keyed on `buffer-file-name',
-;; and if an entry is found, point is set to the value retrieved, and
-;; place saving is enabled again for that buffer.
-;;
-;; There is a command, which is initially not bound to a keystroke in
-;; this incarnation; and may never be, since I think completion works
-;; well enough:
-;;
-;; `M-x toggle-where-was-i'  aka `M-x tog[TAB]w[TAB]'
-;;
-;; ... that will turn place saving on and off on a per-file, buffer-
-;; local basis.	 If `where-was-i-db' has been turned off in a buffer
-;; and then you kill it, or exit XEmacs, any record for that file will
-;; be purged from the database, and you'll start at the top of the
-;; file next time you open it, with place saving turned off there.
-;;
-;; Place saving is automatically still `on' when you visit a file you'd
-;; toggled it on for  in a previous session or visitation.  (That's the
-;; point of it, after all.)
-;;
-;; Toggling place saving on in a buffer visiting a file is all that is
-;; required to cause the `where-was-i-db' feature to be autoloaded, as
-;; `toggle-where-was-i' will call on `install-where-was-i' if the
-;; `wwi-ffh' has not yet been installed.  That WILL NOT cause this
-;; feature to be automatically enabled in your next XEmacs invocation,
-;; however.  For that, you must customize and save
-;; `wwi-auto-install-on-startup-flag'.
-;; There is more information about this in its docstring.
-;;
-;;  This feature can be unloaded with:
-;;
-;; `C-u M-x install-where-was-i'
-;;
-;; ... this will call `unload-feature', as well as traverse the
-;; `buffer-list' removing the buffer-local `kill-buffer-hook'
-;; installed by this program.  Note that any buffers that got place
-;; saving enabled by having had an entry in the database for them when
-;; they were first visited (thus restoring point to where it was the
-;; last time you had visited the file), will not have an updated entry
-;; made, nor the old entry removed (as would happen if you
-;; `toggle-where-was-i' to off in just that buffer), after you
-;; uninstall this feature like that.
-;;
-;; If you toggle it on again in a buffer visiting a file, then kill
-;; that buffer, the point will be saved for it.  When you kill the
-;; other buffers that had place saving enabled before you uninstalled
-;; the feature with `C-u M-x install-where-was-i', no `where-was-i-db'
-;; database update will happen for them, since their buffer-local
-;; `kill-buffer-hook' will have been cleaned of the member
-;; `wwi-save-where-i-am', the function that writes the `point' entry
-;; to the database when a buffer is killed.  If you then re-visit one
-;; of those files, point will get restored to the location it did the
-;; last time you visited that file with `where-was-i-db' installed.
-;;
-;; To remove a file from the place saving database, simply visit it,
-;; `M-x toggle-where-was-i' to switch `where-was-i-db' off, then kill
-;; that buffer.  You can see how this works by looking at the
-;; definition of `wwi-save-where-i-am'.  I dare you not to...  (may as
-;; well use VI.)
-;;
-;; After a period of time, the database of saved file positions will
-;; become cluttered with the names of files that no longer exist.  You
-;; may vacume out the crumbs using:
-;;
-;; `M-x wwi-vacume-where-was-i-db'
-;;
-;; ... which will prompt you for an optional regular expression to
-;; match files you want records removed for.  It will traverse the
-;; database and remove entries for file names that either match the
-;; regexp, or that are (not (file-exists-p file-name)).	 The main
-;; reason for this command is the removal of stale entries, for files
-;; that no longer exist on the filesystem.
-;;
-;; Note also that running `wwi-vacume-where-was-i-db' will cause EFS
-;; traffic, if you've saved your place in any remote files.  Don't be
-;; surprised if your dialing daemon picks up the phone when you run
-;; the vacume function.  You should be able to purge the database of
-;; all EFS entries with a simple regular expression passed to
-;; `wwi-vacume-where-was-i-db'.  Of course, you might not want to do
-;; that, for obvious reasons.  If it isn't obvious, use VI or PICO.
-
-;;; History:
-
-;; This program is modelled after and obsoletes "saveplace.el",
-;; written by Karl Fogel  in July 1993.
-
-;;; Code:
-
-(eval-when 'load
-  (require 'berkeley-db))
-
-;;; Utility functions:
-
-(defun wwi-with-open-database
-  (db-file-name db-sym db-thunk &optional type subtype access mode)
-  "Open the database DB-FILE-NAME, binding the resultant object to
-DB-SYM, and `funcall' DB-THUNK inside that context, closing the
-database on exit from the block.  TYPE, SUBTYPE, ACCESS, and MODE, if
-given, are passed to `open-database', and default to 'berkeley-db,
-'hash, \"rw+\", #o644, respectively."
-  (unwind-protect
-      (progn
-	(or (set db-sym (open-database (expand-file-name db-file-name)
-				       (or type 'berkeley-db)
-				       (or subtype 'hash)
-				       (or access "rw+")
-				       (or mode #o644)))
-	    (cerror "Couldn't open `%s'." db-file-name))
-	(funcall db-thunk))
-    (and (symbol-value db-sym) (close-database (symbol-value db-sym)))))
-
-(put 'wwi-with-open-database 'lisp-indent-function 1)
-
-;;; Customize definitions:
-(defgroup where-was-i nil
-  "Remember where you were in files you have visited."
-  :group 'files)
-
-(defcustom wwi-auto-install-on-startup-flag nil
-  "Setting and saving this option will cause `where-was-i-db' to be
-loaded with `require' when your options.el file is loaded, and setting
-it to `on' will cause it to install its hooks at that time also.
-
-Resetting it to the factory-default should make it no longer be
-auto-required.
-
-Please read the documentation to `toggle-where-was-i'."
-  :type 'boolean
-  :tag "Auto-install on startup?"
-  :require 'where-was-i-db
-  :group 'where-was-i)
-
-(defcustom where-was-i-db
-  (cond
-   ((boundp 'load-user-init-file-p)
-    (paths-construct-path (list user-init-directory ".wwi.db")))
-   (t
-    (paths-construct-path
-     (list (concat "~" (or init-file-user ""))
-	   user-init-directory
-	   ".wwi.db"))))
-  "Location and filename of the `where-was-i-db' database file.
-The default location is usually the right place for it."
-  :type 'file
-  :tag "Database file-name"
-  :group 'where-was-i)
-
-;;; Install when loading?
-(when wwi-auto-install-on-startup-flag
-  (setq wwi-auto-install-on-startup-flag nil)
-  (install-where-was-i)
-  (message "`where-was-i-db' enabled."))
-
-;;; The toggle and install functions:
-;;;###autoload
-(defun toggle-where-was-i (&optional parg)
-  "Toggle whether to save your place in this file between sessions.
-
-Toggling place saving on in a file's buffer will cause
-`where-was-i-db' to install its hooks, via `install-where-was-i'.  You
-do not need to explicitly run an install function -- just toggle it on
-for a file for which you want the cursor position to be saved.  In
-order for this feature to be automatically installed at startup, you
-must customize `wwi-auto-install-on-startup-flag'.
-
-Place saving is enabled ONLY for files in which you've explicitly
-toggled it on for.  This prevents application programs, such as Gnus,
-W3, VM, or your own programs from making extraneous `where-was-i-db'
-database entries for their machine-generated files.
-
-If this mode is enabled, point is recorded for you when you kill the
-buffer or exit XEmacs.  Visiting a file again that has had a database
-entry made in this fashion will cause `point' to be restored to the
-saved position, even in a later XEmacs editing session.
-
-If called with a prefix arg, the mode is enabled if and only if the
-argument is positive.  This is for use by program code.  In that case,
-you may also like to bind the value of `where-was-i-db'.  You should
-not globally `setq' it; but bind it with a `let' around the code for
-which you wish point saved in a separate-from-the-main database.
-
-There is more information in the comment header of this program.  It
-may be worth reading.  If you haven't installed the `.el' codes for
-reference, on at least one machine in your system, you deserve to
-lose.
-"
-  ;; The above note is refering to the fact that the `el' files are
-  ;; often packaged separately from the byte-compiled `.elc'.  
-  (interactive "P")
-  (when (not buffer-file-name)
-    (error (format "Buffer `%s' not visiting a file" (buffer-name))))
-  (when (not (memq 'wwi-ffh find-file-hooks))
-    (install-where-was-i))
-  (if (or toggle-where-was-i (and parg (<= parg 0)))
-      (progn
-	(display-message 'no-log "No place will be saved in this file when the buffer is killed.")
-	(setq toggle-where-was-i nil))
-    (display-message 'no-log "Your place will be saved when this buffer is killed.")
-    (make-local-hook 'kill-buffer-hook)
-    (add-hook 'kill-buffer-hook 'wwi-save-where-i-am nil t)
-    (setq toggle-where-was-i t)))
-
-;;;###autoload
-(defun install-where-was-i (&optional parg)
-  "Unconditionally activate `where-was-i-db' by installing some hook
-functions.  An optional prefix arg <= 0 will uninstall the feature.
-
-See the function documentation to `toggle-where-was-i' for more
-information about the `where-was-i-db' feature, and consult the code
-itself for more information about unloading the feature."
-  (interactive "p")
-  (if (and parg (<= parg 0))
-      (progn
-	(remove-hook 'find-file-hooks 'wwi-ffh)
-	(dolist (buf (buffer-list))
-	  (with-current-buffer buf
-	    (remove-hook 'kill-buffer-hook 'wwi-save-where-i-am t)))
-	;; #### Does `unload-feature' handle buffer-local and permanent-local variables (yet)?
-	(unload-feature 'where-was-i-db))
-    (add-hook 'find-file-hooks 'wwi-ffh)
-    (put 'toggle-where-was-i :menu-tag "Save where you are here?")
-    (add-minor-mode 'toggle-where-was-i " S")))
-
-;;; Buffer-local state variable:
-;;;###autoload
-(defconst toggle-where-was-i nil
-  ;; This should be Off by default, and autoloaded so that it is
-  ;; properly initialized at startup.
-  "This is set when `where-was-i-db' place saving is enabled for this
-buffer's file.  This must be set by `M-x toggle-where-was-i', since it
-performs additional actions beyond just toggling this permanent
-buffer-local flag variable.")
-(make-variable-buffer-local 'toggle-where-was-i)
-(put 'toggle-where-was-i 'permanent-local t)
-
-;;; The hook functions:
-(defun wwi-save-where-i-am ()
-  "Save the location of point to the `where-was-i-db' database, if
-`toggle-where-was-i' is non-null.  If `toggle-where-was-i' is nil, any
-entry for this `buffer-file-name' will be cleared.
-
-This function gets placed on the buffer-local `kill-buffer-hook' by
-`wwi-ffh' via `install-where-was-i'.
-
-See also: `toggle-where-was-i'."
-  (and buffer-file-name
-       (wwi-with-open-database where-was-i-db
-	 'wwi-db
-	 #'(lambda ()
-	     (if toggle-where-was-i
-		 (put-database buffer-file-name
-			       (format "%S" (case major-mode
-					      ((hexl-mode) (hexl-current-address))
-					      (t (point))))
-			       wwi-db t)
-	       (remove-database buffer-file-name wwi-db))))))
-
-(defun wwi-ffh ()
-  "`find-file-hooks' function for `where-was-i-db' that looks up
-`buffer-file-name' in `where-was-i-db', and restores `point' if
-there's an entry for this file.
-
-This gets installed on the global `find-file-hooks' when you execute
-`install-where-was-i', or `toggle-where-was-i'."
-  (unless after-find-file-from-revert-buffer
-    (let ((pos (wwi-with-open-database where-was-i-db
-		 'wwi-db #'(lambda ()
-			     (string-to-int
-			      (get-database buffer-file-name wwi-db "-1"))))))
-      (if (>= pos 0)
-	  (progn
-	    (case major-mode
-	      ((hexl-mode) (hexl-goto-address pos))
-	      (t (goto-char pos)))
-	    (toggle-where-was-i 1))
-	(toggle-where-was-i -1)))))	; mostly just for the message.
-
-
-;;; Database cleanup commands:
-
-;; #### This function tickles the crash bug that I reported... XEmacs
-;; aborts in make_uninit_string().  Why???  #### Please advise.
-(defun wwi-vacume-where-was-i-db (&optional regexp)
-
-  "Clean the `where-was-i-db' database of records for nonexistent
-files or whos file names match an optionally specified REGEXP.
-
-Note also that running `wwi-vacume-where-was-i-db' will cause EFS
-traffic, if you've saved your place in any remote files.  Don't be
-surprised if your dialing daemon picks up the phone when you run the
-vacume function.  You should be able to purge the database of all EFS
-entries with a simple regular expression passed to
-`wwi-vacume-where-was-i-db'.  Of course, you might not want to do
-that, for obvious reasons.  If it isn't obvious, use VI or PICO.
-"
-  ;; (interactive "sRegexp, or [<-Enter] for none: ")
-  (wwi-with-open-database where-was-i-db
-    'wwi-db
-    #'(lambda ()
-	(map-database #'(lambda (key val)
-			  (or (and regexp
-				   (string-match regexp key)
-				   (progn
-				     (remove-database key wwi-db)
-				     (message "Removing match: %s" key)))
-			      (file-exists-p key)
-			      (progn
-				(remove-database key wwi-db)
-				(message "Removing nonexisting: %s" key))))
-		      wwi-db))))
-
-(put 'wwi-with-open-database 'lisp-indent-function 1)
-
-(provide 'where-was-i-db)
-
-;;; where-was-i-db.el ends here
diff --git a/xemacs-packages/lisp/edit-utils/winring.el b/xemacs-packages/lisp/edit-utils/winring.el
deleted file mode 100644
index 337e4398..00000000
--- a/xemacs-packages/lisp/edit-utils/winring.el
+++ /dev/null
@@ -1,594 +0,0 @@
-;;; winring.el --- Window configuration rings
-
-;; Copyright (C) 1998, 1999 Free Software Foundation, Inc.
-
-;; Author:   1997-2004 Barry A. Warsaw
-;; Contact:  gnu@wooz.org (Barry A. Warsaw)
-;; Homepage: http://barry.warsaw.us/elisp
-;; Created:  March 1997
-;; Keywords: frames tools
-
-(defconst winring-version "$Revision: 1.2 $"
-  "winring version number.")
-
-;; 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:
-;;
-;; This package provides lightweight support for circular rings of
-;; window configurations.  A window configuration is the layout of
-;; windows and associated buffers within a frame.  There is always at
-;; least one configuration on the ring, the current configuration.
-;; You can create new configurations and cycle through the layouts in
-;; either direction.  You can also delete configurations from the ring
-;; (except the last one of course!).  Window configurations are named,
-;; and you can jump to and delete named configurations.  Display of
-;; the current window configuration name in the mode line is only
-;; supported as of Emacs 20.3 and XEmacs 21.0.
-;;
-;; Window configuration rings are frame specific.  That is, each frame
-;; has its own ring which can be cycled through independently of other
-;; frames.  This is the way I like it.
-;;
-;; You are always looking at the current window configuration for each
-;; frame, which consists of the windows in the frame, the buffers in
-;; those windows, and point in the current buffer.  As you run
-;; commands such as "C-x 4 b", "C-x 2", and "C-x 0" you are modifying
-;; the current window configuration.  When you jump to a new
-;; configuration, the layout that existed before the jump is captured,
-;; and the ring is rotated to the selected configuration.  Window
-;; configurations are captured with `current-window-configuration',
-;; however winring also saves point for the current buffer.
-
-;; To use, make sure this file is on your `load-path' and put the
-;; following in your .emacs file:
-;;
-;; (require 'winring)
-;; (winring-initialize)
-;;
-;; Note that by default, this binds the winring keymap to the C-x 7
-;; prefix, but you can change this by setting the value of
-;; `winring-keymap-prefix', before you call `winring-initialize'.
-;; Note that this is a change from previous versions of winring; the
-;; prefix used to be M-o but was changed on the suggestion of RMS.
-
-;; The following commands are defined:
-;;
-;;    C-x 7 n -- Create a new window configuration.  The new
-;;               configuration will contain a single buffer, the one
-;;               named in the variable `winring-new-config-buffer-name'
-;;
-;;               With C-u, winring prompts for the name of the new
-;;               configuration.  If you don't use C-u the function in
-;;               `winring-name-generator' will be called to get the
-;;               new configuration's name.
-;;
-;;    C-x 7 2 -- Create a duplicate of the current window
-;;               configuration.  C-u has the same semantics as with
-;;               "C-x 7 c".
-;;
-;;    C-x 7 j -- Jump to a named configuration (prompts for the name).
-;;
-;;    C-x 7 0 -- Kill the current window configuration and rotate to the
-;;               previous layout on the ring.  You cannot delete the
-;;               last configuration in the ring.  With C-u, prompts
-;;               for the name of the configuration to kill.
-;;
-;;    C-x 7 o -- Go to the next configuration on the ring.
-;;
-;;    C-x 7 p -- Go to the previous configuration on the ring.
-;;
-;;               Note that the sequence `C-x 7 o C-x 7 p' is a no-op;
-;;               it leaves you in the same configuration you were in
-;;               before the sequence.
-;;
-;;    C-x 7 r -- Rename the current window configuration.
-;;
-;;    C-x 7 b -- Submit a bug report on winring.
-;;
-;;    C-x 7 v -- Echo the winring version.
-
-;; As mentioned, window configuration names can be displayed in the
-;; modeline, but this feature only works with Emacs 20.3 and XEmacs
-;; 21.0.  A patch for XEmacs 20.4 to support this feature is available
-;; at the URL below.  Note that the default value of
-;; `winring-show-names' is currently nil by default because if your
-;; X/Emacs doesn't have the necessary support, ugly things can happen
-;; (no you won't crash your X/Emacs -- it just won't do what you
-;; want).
-;;
-;; If your X/Emacs has the necessary support, you can turn on display
-;; of window configuration names by setting `winring-show-names' to
-;; t.  If you don't like the position in the modeline where winring
-;; names are shown, you can change this by passing in your own
-;; modeline hacker function to `winring-initialize'.
-
-;;; History:
-;;
-;; A long long time ago there was a package called `wicos' written by
-;; Heikki Suopanki, which was based on yet another earlier package
-;; called `screens' also written by Suopanki.  This in turn was based
-;; on the Unix tty session manager `screen' (unrelated to Emacs) by
-;; Oliver Laumann, Juergen Weigert, and Michael Schroeder.
-;;
-;; Wicos essentially provided fancy handling for window
-;; configurations.  I liked the basic ideas, but wicos broke with
-;; later versions of Emacs and XEmacs.  I re-implemented just the
-;; functionality I wanted, simplifying things in the process, and
-;; porting the code to run with XEmacs 19 and 20, and Emacs 20 (I
-;; don't know if winring works in Emacs 19.34).
-;;
-;; Wicos used the M-o prefix which I've recently changed to C-x 7 as
-;; the default, by suggestion of RMS.  Wicos also had some support for
-;; multiple frames, and saving configurations on all visible frames,
-;; but it didn't work too well, and I like frame independent rings
-;; better.
-;;
-;; I know of a few other related packages:
-;;
-;;    - `escreen' by Noah Friedman.  A much more ambitious package
-;;       that does Emacs window session management.  Very cool, but I
-;;       wanted something more lightweight.
-;;
-;;    - `wconfig' by Bob Weiner as part of Hyperbole.  I think wconfig
-;;      is similar in spirit to winring; it seems to have also have
-;;      named window configurations, but not frame-specific window
-;;      rings.
-;;
-;;    - `winner' by Ivar Rummelhoff.  This package comes with Emacs
-;;      20, and appears to differ from winring by providing undo/redo
-;;      semantics to window configuration changes.  winner is a minor
-;;      mode and does seem to support frame-specific window rings.
-;;
-;;    - `tapestry' by Kyle Jones and distributed with the VM package.
-;;      A much more featured package, but there is a lot of overlap
-;;      and it seems more designed for programmatic rather than
-;;      interactive use.
-
-;;    - XEmacs has some built-in support for window configuration
-;;      stacks, but I wanted to use a ring structure for managing
-;;      configurations.
-
-;; Please feel free to email me if my rendition of history, or my
-;; explanation of the related packages, is inaccurate.
-
-;;; Code:
-
-(require 'ring)
-
-
-(defgroup winring nil
-  "Window configuration rings"
-  :prefix "winring-"
-  :group 'frames)
-
-(defcustom winring-ring-size 7
-  "*Size of the window configuration ring."
-  :type 'integer
-  :group 'winring)
-
-(defcustom winring-prompt-on-create 'usually
-  "*When true, prompt for new configuration name on creation.
-If not t and not nil, prompt for configuration name on creation,
-except when creating the initial configuration on a new frame."
-  :type '(radio
-	  (const :tag "Never prompt for configuration name" nil)
-	  (const :tag "Always prompt for configuration name" t)
-	  (const :tag "Prompt for all but initial configuration name"
-		 usually)
-	  )
-  :group 'winring)
-
-(defcustom winring-new-config-buffer-name "*scratch*"
-  "*Name of the buffer to switch to when a new configuration is created."
-  :type 'string
-  :group 'winring)
-
-(defcustom winring-show-names nil
-  "*If non-nil, window configuration names are shown in the modeline.
-If nil, the name is echoed in the minibuffer when switching window
-configurations."
-  :type 'boolean
-  :group 'winring)
-
-(defcustom winring-name-generator 'winring-next-name
-  "*Function that generates new automatic window configuration names.
-When a new window configuration is created with `winring-new-configuration',
-and the user did not specify an explicit name, this function is called with
-no arguments to get the new name.  It must return a string."
-  :type 'function
-  :group 'winring)
-
-;; Not yet customized
-(defvar winring-keymap-prefix "\C-x7"
-  "*Prefix key that the `winring-map' is placed on in the global keymap.
-If you change this, you must do it before calling `winring-initialize'.")
-
-
-;; Set up keymap
-(defvar winring-map nil
-  "Keymap used for winring, window configuration rings.")
-(if winring-map
-    nil
-  (setq winring-map (make-sparse-keymap))
-  (define-key winring-map "b" 'winring-submit-bug-report)
-  (define-key winring-map "n" 'winring-new-configuration)
-  (define-key winring-map "2" 'winring-duplicate-configuration)
-  (define-key winring-map "j" 'winring-jump-to-configuration)
-  (define-key winring-map "0" 'winring-delete-configuration)
-  (define-key winring-map "o" 'winring-next-configuration)
-  (define-key winring-map "p" 'winring-prev-configuration)
-  (define-key winring-map "r" 'winring-rename-configuration)
-  (define-key winring-map "v" 'winring-version)
-  )
-
-
-
-;; Winring names
-(defvar winring-name nil
-  "The name of the currently displayed window configuration.")
-
-(defvar winring-name-index 1
-  "Index used as a sequence number for new unnamed window configurations.")
-
-(defvar winring-name-history nil
-  "History variable for window configuration name prompts.")
-
-(defun winring-next-name ()
-  (let ((name (format "%03d" winring-name-index)))
-    (setq winring-name-index (1+ winring-name-index))
-    name))
-
-
-
-;; Compatibility
-(defun winring-set-frame-ring (frame ring)
-  (cond
-   ;; XEmacs
-   ((fboundp 'set-frame-property)
-    (set-frame-property frame 'winring-ring ring))
-   ;; Emacs
-   ((fboundp 'modify-frame-parameters)
-    (modify-frame-parameters frame (list (cons 'winring-ring ring))))
-   ;; Not supported
-   (t (error "This version of Emacs is not supported by winring"))))
-
-(defun winring-get-frame-ring (frame)
-  (cond
-   ;; XEmacs
-   ((fboundp 'frame-property)
-    (frame-property frame 'winring-ring))
-   ;; Emacs 20
-   ((fboundp 'frame-parameter)
-    (frame-parameter frame 'winring-ring))
-   ;; Emacs 19.34
-   ((fboundp 'frame-parameters)
-    (cdr (assq 'winring-ring (frame-parameters frame))))
-   ;; Unsupported
-   (t (error "This version of Emacs is not supported by winring"))))
-
-(defun winring-create-frame-hook (frame)
-  ;; generate the name, but specify the newly created frame
-  (winring-set-name (and (eq winring-prompt-on-create t)
-			 (read-string "Initial window configuration name? "
-				      nil 'winring-name-history))
-		    frame))
-
-
-;; Utilities
-(defun winring-set-name (&optional name frame)
-  "Set the window configuration name.
-Optional NAME is the name to use; if not given, then
-`winring-name-generator' is `funcall'd with no arguments to get the
-generated name.  Optional FRAME is the frame to set the name for; if
-not given then the currently selected frame is used."
-  (let ((name (or name (funcall winring-name-generator)))
-	(frame (or frame (selected-frame))))
-    (if (fboundp 'add-spec-to-specifier)
-	;; The XEmacs way.  Only supported in hacked 20.4 or 21.0
-	(add-spec-to-specifier winring-name name frame)
-      ;; the Emacs way.  Only supported in Emacs 20.3
-      (modify-frame-parameters frame (list (cons 'winring-name name)))
-      ))
-  (if (not winring-show-names)
-      (message "Switching to window configuration: %s" name)))
-
-(defun winring-get-ring ()
-  (let* ((frame (selected-frame))
-	 (ring (winring-get-frame-ring frame)))
-    (when (not ring)
-      (setq ring (make-ring winring-ring-size))
-      (winring-set-frame-ring frame ring))
-    ring))
-
-(defsubst winring-name-of (config)
-  (car config))
-
-(defsubst winring-conf-of (config)
-  (car (cdr config)))
-
-(defsubst winring-point-of (config)
-  (nth 2 config))
-
-(defsubst winring-name-of-current ()
-  (if (fboundp 'specifier-instance)
-      ;; In XEmacs, this variable holds a specifier which
-      ;; must be instanced to get the current
-      ;; configuration name.
-      (specifier-instance winring-name)
-    ;; In Emacs, just use the variable's string value
-    ;; directly, since the `displayed' value is kept as a
-    ;; frame parameter
-    winring-name))
-
-(defun winring-save-current-configuration (&optional at-front)
-  (let* ((ring (winring-get-ring))
-	 (name (winring-name-of-current))
-	 (here (point))
-	 (conf (list name (current-window-configuration) here)))
-    (if at-front
-	(ring-insert-at-beginning ring conf)
-      (ring-insert ring conf))))
-
-(defun winring-restore-configuration (item)
-  (let ((conf (winring-conf-of item))
-	(name (winring-name-of item))
-	(here (winring-point-of item)))
-    (set-window-configuration conf)
-    ;; current-window-configuration does not save point in current
-    ;; window.  That sucks!
-    (goto-char here)
-    (winring-set-name name))
-  (force-mode-line-update))
-
-(defun winring-complete-name ()
-  (let* ((ring (winring-get-ring))
-	 (n (1- (ring-length ring)))
-	 (current (winring-name-of-current))
-	 (table (list (cons current -1)))
-	 name)
-    ;; populate the completion table
-    (while (<= 0 n)
-      (setq table (cons (cons (winring-name-of (ring-ref ring n)) n) table)
-	    n (1- n)))
-    (setq name (completing-read
-		(format "Window configuration name (%s): " current)
-		table nil 'must nil 'winring-name-history))
-    (if (string-equal name "")
-	(setq name current))
-    (cdr (assoc name table))))
-
-(defun winring-read-name (prompt)
-  (let* ((ring (winring-get-ring))
-	 (n (1- (ring-length ring)))
-	 (table (list (winring-name-of-current)))
-	 name)
-    ;; get the list of all the names in the ring
-    (while (<= 0 n)
-      (setq table (cons (winring-name-of (ring-ref ring n)) table)
-	    n (1- n)))
-    (setq name (read-string prompt nil 'winring-name-history))
-    (if (member name table)
-	(error "Window configuration name already in use: %s" name))
-    name))
-
-
-;; Commands
-
-;;;###autoload
-(defun winring-new-configuration (&optional arg)
-  "Save the current window configuration and create an empty new one.
-The buffer shown in the new empty configuration is defined by
-`winring-new-config-buffer-name'.
-
-With \\[universal-argument] prompt for the new configuration's name.
-Otherwise, the function in `winring-name-generator' will be called to
-get the new configuration's name."
-  (interactive "P")
-  (let ((name (and (or arg winring-prompt-on-create)
-		   (winring-read-name "New window configuration name? "))))
-    ;; Empty string is not allowed
-    (if (string-equal name "")
-	(setq name (funcall winring-name-generator)))
-    (winring-save-current-configuration)
-    (delete-other-windows)
-    (switch-to-buffer winring-new-config-buffer-name)
-    (winring-set-name name)))
-
-;;;###autoload
-(defun winring-duplicate-configuration (&optional arg)
-  "Push the current window configuration on the ring, and duplicate it.
-
-With \\[universal-argument] prompt for the new configuration's name.
-Otherwise, the function in `winring-name-generator' will be called to
-get the new configuration's name."
-  (interactive "P")
-  (let ((name (and (or arg winring-prompt-on-create)
-		   (winring-read-name "New window configuration name? "))))
-    ;; Empty string is not allowed
-    (if (string-equal name "")
-	(setq name (funcall winring-name-generator)))
-    (winring-save-current-configuration)
-    (winring-set-name name)))
-
-;;;###autoload
-(defun winring-next-configuration ()
-  "Switch to the next window configuration for this frame."
-  (interactive)
-  (let ((next (ring-remove (winring-get-ring))))
-    (winring-save-current-configuration)
-    (winring-restore-configuration next)))
-
-;;;###autoload
-(defun winring-prev-configuration ()
-  "Switch to the previous window configuration for this frame."
-  (interactive)
-  (let ((prev (ring-remove (winring-get-ring) 0)))
-    (winring-save-current-configuration 'at-front)
-    (winring-restore-configuration prev)))
-
-;;;###autoload
-(defun winring-jump-to-configuration ()
-  "Go to the named window configuration."
-  (interactive)
-  (let* ((ring (winring-get-ring))
-	 (index (winring-complete-name))
-	 item)
-    ;; if the current configuration was chosen, winring-complete-name
-    ;; returns -1
-    (when (<= 0 index)
-      (setq item (ring-remove ring index))
-      (winring-save-current-configuration)
-      (winring-restore-configuration item))
-    ))
-
-;;;###autoload
-(defun winring-delete-configuration (&optional arg)
-  "Delete the current configuration and switch to the next one.
-With \\[universal-argument] prompt for named configuration to delete."
-  (interactive "P")
-  (let ((ring (winring-get-ring))
-	index)
-    (if (or (not arg)
-	    (> 0 (setq index (winring-complete-name))))
-	;; remove the current one, so install the next one
-	(winring-restore-configuration (ring-remove ring))
-      ;; otherwise, remove the named one but don't change the current config
-      (ring-remove ring index)
-      )))
-
-;;;###autoload
-(defun winring-rename-configuration ()
-  "Rename the current configuration to NAME."
-  (interactive)
-  (winring-set-name (winring-read-name "New window configuration name? ")))
-
-
-
-(defconst winring-help-address "bwarsaw@python.org"
-  "Address accepting bug report submissions.")
-
-(defun winring-version ()
-  "Echo the current version of winring in the minibuffer."
-  (interactive)
-  (message "Using winring version %s" winring-version)
-  ;;(setq zmacs-region-stays t)
-  )
-
-(defun winring-submit-bug-report (comment-p)
-  "Submit via mail a bug report on winring.
-With \\[universal-argument] just send any type of comment."
-  (interactive
-   (list (not (y-or-n-p
-	       "Is this a bug report? (hit `n' to send other comments) "))))
-  (let ((reporter-prompt-for-summary-p (if comment-p
-					   "(Very) brief summary: "
-					 t)))
-    (require 'reporter)
-    (reporter-submit-bug-report
-     winring-help-address		 ;address
-     (concat "winring " winring-version) ;pkgname
-     ;; varlist
-     (if comment-p nil
-       '(winring-ring-size
-	 winring-new-config-buffer-name
-	 winring-show-names
-	 winring-name-generator
-	 winring-keymap-prefix))
-     nil				;pre-hooks
-     nil				;post-hooks
-     "Dear Barry,")			;salutation
-    (if comment-p nil
-      (set-mark (point))
-      (insert
-"Please replace this text with a description of your problem.\n\
-The more accurately and succinctly you can describe the\n\
-problem you are encountering, the more likely I can fix it\n\
-in a timely way.\n\n")
-      (exchange-point-and-mark)
-      ;;(setq zmacs-region-stays t)
-      )))
-
-
-
-;; Initialization.  This is completely different b/w Emacs and XEmacs.
-;; The Emacs 20.3 way is to create a frame-local variable (this is a
-;; new feature with Emacs 20.3), and save the config name as a frame
-;; property.
-;;
-;; In XEmacs 21.0 (a.k.a. 20.5), you create a generic specifier, and
-;; save the config name as an instantiator over the current frame
-;; locale.
-
-;; Be sure to do this only once
-(defvar winring-initialized nil)
-
-(defun winring-initialize (&optional hack-modeline-function)
-  (unless winring-initialized
-    ;;
-    ;; Create the variable that holds the window configuration name
-    ;;
-    (cond
-     ;; The Emacs 20.3 way: frame-local variables
-     ((fboundp 'make-variable-frame-local)
-      (make-variable-frame-local 'winring-name))
-     ;; The XEmacs 21 way: specifiers
-     ((fboundp 'make-specifier)
-      (setq winring-name (make-specifier 'generic)))
-     ;; Not supported in older X/Emacsen
-     (t nil))
-    ;;
-    ;; Glom the configuration name into the mode-line.  I've
-    ;; experimented with a couple of different locations, including
-    ;; for Emacs 20.3 mode-line-frame-identification, and for XEmacs,
-    ;; just splicing it before the modeline-buffer-identification.
-    ;; Sticking it on the very left side of the modeline, even before
-    ;; mode-line-modified seems like the most useful and
-    ;; cross-compatible place.
-    ;;
-    ;; Note that you can override the default hacking of the modeline
-    ;; by passing in your own `hack-modeline-function'.
-    ;;
-    (if hack-modeline-function
-	(funcall hack-modeline-function)
-      ;; Else, default insertion hackery
-      (let ((format (list 'winring-show-names
-			  '("<" winring-name "> ")))
-	    (splice (cdr mode-line-format)))
-	(setcar splice (list format (car splice)))))
-    ;;
-    ;; We need to add a hook so that all newly created frames get
-    ;; initialized properly.  Again, different for Emacs and XEmacs.
-    ;;
-    (if (boundp 'create-frame-hook)
-	;; XEmacs
-	(add-hook 'create-frame-hook 'winring-create-frame-hook)
-      ;; better be Emacs!
-      (add-hook 'after-make-frame-functions 'winring-create-frame-hook))
-    ;;
-    ;; Now set the initial configuration name on the initial frame...
-    (winring-create-frame-hook (selected-frame))
-    ;; ...the keymap...
-    (global-set-key winring-keymap-prefix winring-map)
-    ;; ...and the init fence
-    (setq winring-initialized t)))
-
-
-
-(provide 'winring)
-;;; winring.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/ChangeLog b/xemacs-packages/lisp/mail-lib/ChangeLog
deleted file mode 100644
index d1cb3461..00000000
--- a/xemacs-packages/lisp/mail-lib/ChangeLog
+++ /dev/null
@@ -1,1378 +0,0 @@
-2006-03-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.76 released.
-
-2006-03-08  Simon Josefsson  
-
-	* smtpmail.el: Sync with GNU Emacs, adds support for GnuTLS and
-	some other fixes.
-
-	* tls.el: Sync with GNU Emacs, adds support for OpenSSL.
-
-	* starttls.el: Sync cosmetic fixes with GNU Emacs CVS HEAD.
-
-2005-10-28  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.75 released.
-
-2005-10-26  Simon Josefsson  
-
-	* smtpmail.el (smtpmail-send-queued-mail): Code cleanup, tiny
-	patch from Hrvoje Niksic .
-
-2005-09-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.74 released.
-
-2005-09-23  Simon Josefsson  
-
-	* reporter.el: Change maintainer to FSF, since nobody from the
-	XEmacs camp has touched this file for ages and it has effectively
-	been maintained by the FSF for quite some time through syncing
-	anyway.
-
-2005-08-08  Richard M. Stallman  
-
-	* mail/reporter.el (reporter-dump-state): Use insert-buffer-substring.
-
-2005-06-02  Katsumi Yamaoka  
-
-	* starttls.el (starttls-set-process-query-on-exit-flag):
-	Use eval-and-compile.
-
-2005-05-31  Katsumi Yamaoka  
-
-	* starttls.el (starttls-set-process-query-on-exit-flag): Alias to
-	set-process-query-on-exit-flag or process-kill-without-query.
-	(starttls-open-stream-gnutls): Use it instead of
-	process-kill-without-query.
-	(starttls-open-stream): Ditto.
-
-2001-11-22  Colin Walters  
-
-	* mail/reporter.el (reporter-submit-bug-report): Doc fixes.
-
-2005-04-03  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.73 released.
-
-2005-04-02  Aidan Kehoe  
-
-	* sendmail.el (mail-do-fcc): Write the Unix mail file using the
-	binary coding system, as is appropriate for a file where non-ASCII
-	characters are encoded using separate MIME character sets for
-	every message, and thus no other single Mule coding system is
-	appropriate.
-
-2005-03-09  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.72 released.
-
-2005-03-09  Steve Youngs  
-
-	Support Firefox in browse-url.
-
-	* browse-url.el (browse-url-browser-function): Add firefox.
-	(browse-url-firefox-program): New.
-	(browse-url-firefox-arguments): New.
-	(browse-url-firefox-startup-arguments): New.
-	(browse-url-firefox-new-window-is-tab): New.
-	(browse-url-default-browser): Add firefox.
-	(browse-url-firefox): New.
-	(browse-url-firefox-sentinel): New.
-
-	* browse-url-xemacs.el: Add menu item for Firefox.
-
-2005-02-28  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.71 released.
-
-2005-02-26  Simon Josefsson  
-
-	* browse-url.el (browse-url-netscape): Fix last commit.  Reported
-	by "Johann 'Myrkraverk' Oskarsson"
-	.
-
-2005-02-22  Simon Josefsson  
-
-	* browse-url.el (browse-url-netscape-new-window-is-tab): New
-	variable.
-	(browse-url-netscape): Use it.  Doc fix.  Reported by "Johann
-	'Myrkraverk' Oskarsson" .
-
-2004-11-30  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.70 released.
-
-2004-11-29  Simon Josefsson  
-
-	* netrc.el: Use encrypt.el from ecrypto, instead of gnus-encrypt.
-	Sync with Gnus CVS.
-
-2004-11-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.69 released.
-
-2004-11-07  Ben Wing  
-
-	* sendmail.el:
-	* sendmail.el (mail-signature):
-	* sendmail.el (mail-default-directory): New.
-	* sendmail.el (mail-use-dsn): New.
-	* sendmail.el (mail-mode-syntax-table):
-	* sendmail.el (mail-font-lock-keywords):
-	* sendmail.el (mail-mode-abbrev-table): New.
-	* sendmail.el (mail-mode):
-	* sendmail.el (mail-mode-fill-paragraph):
-	* sendmail.el (mail-mode-map):
-	* sendmail.el (sendmail-send-it):
-	* sendmail.el (mail-sent-via):
-	* sendmail.el (mail-reply-to):
-	* sendmail.el (mail-split-line): New.
-	* sendmail.el (mail):
-	* sendmail.el (mail-recover-1): New.
-	* sendmail.el (mail-recover):
-	Synch with FSF 21.3.
-
-2004-09-16  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.68 released.
-
-2004-05-28  Simon Josefsson  
-
-	* smtpmail.texi (Authentication): Improve STARTTLS discussion.
-
-2004-02-29  Simon Josefsson  
-
-	* smtpmail.texi (Authentication): Changed the list of supported
-	authentication mechanisms from CRAM-MD5, PLAIN and LOGIN-MD5 to
-	CRAM-MD5 and LOGIN, tiny patch from Andreas Voegele
-	.
-
-2003-04-23  Simon Josefsson  
-
-	* smtpmail.texi: Fix license (the invariant sections mentioned has
-	never been part of the smtp manual).  Align info dir entry with
-	other emacs packages.
-
-2004-08-04  Teodor Zlatanov  
-
-	* netrc.el: removed old encryption support, autoload gnus-encrypt.el
-	(netrc-parse): use gnus-encrypt.el functions
-
-2004-05-23  Lars Magne Ingebrigtsen  
-
-	* netrc.el (netrc-services-file): New variable.
-	(netrc-parse-services): New function.
-	(netrc-find-service-name): New function.
-	(netrc-find-service-number): New function.
-	(netrc-port-equal): New function.
-	(netrc-machine): Use it.
-
-2004-01-05  Teodor Zlatanov  
-
-	* netrc.el: autoload password-read
-	(netrc): new configuration group
-	(netrc-encoding-method, netrc-openssl-path): configuration
-	variables for encoding and decoding of files with symmetric
-	ciphers
-	(netrc-encode): assistant function to encode a file with
-	netrc-encoding-method
-	(netrc-parse): added interactive parameter, added optional
-	decoding if netrc-encoding-method is non-nil but otherwise
-	behavior is standard
-	(netrc-encrypting-method, netrc-encrypt, netrc-parse):
-	s/encode/encrypt/ everywhere
-
-2004-01-05  Jesper Harder  
-
-	* netrc.el (netrc-point-at-eol): Replace with point-at-eol.
-
-2004-09-16  Simon Josefsson  
-
-	* rfc2104.el: Add arch cookie.
-
-2003-09-20  Simon Josefsson  
-
-	* tls.el (tls-process-connection-type): Doc fix.
-
-2004-06-11  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.67 released.
-
-2004-06-11  Simon Josefsson  
-
-	* mail-extr.el: Revert and remove coding cookie.  See
-	<87659y93co.fsf@tleepslib.sk.tsukuba.ac.jp> on xemacs-beta.
-	(mail-extr-skip-whitespace-forward)
-	(mail-extr-skip-whitespace-backward): Revert last patch.  See
-	<87isdy949c.fsf@tleepslib.sk.tsukuba.ac.jp> on xemacs-patches.
-
-2004-06-10  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.66 released.
-
-2004-05-26  Simon Josefsson  
-
-	* starttls.el: Merge with my GNUTLS based starttls.el.
-	(starttls-gnutls-program, starttls-use-gnutls)
-	(starttls-extra-arguments, starttls-process-connection-type)
-	(starttls-connect, starttls-failure, starttls-success): New variables.
-	(starttls-program, starttls-extra-args): Doc fix.
-	(starttls-negotiate-gnutls, starttls-open-stream-gnutls): New funs.
-	(starttls-negotiate, starttls-open-stream): Check `starttls-use-gnutls'
-	and pass on to corresponding *-gnutls function if it is set.
-
-2004-06-10  Simon Josefsson  
-
-	* mail-extr.el: Sync with Emacs CVS, with log entries until and
-	including 2003-05-18.
-	(mail-extr-address-syntax-table): Remove non-ASCII (from Emacs CVS
-	sync, not introduced by me).
-	(mail-extr-skip-whitespace-forward)
-	(mail-extr-skip-whitespace-backward): Ditto.  (See comment in
-	code.)
-
-2003-10-23  Dave Love  
-
-	* mail/mail-extr.el (mail-extr-address-syntax-table): Remove
-	non-ASCII unibyte chars.
-
-2003-05-18  Stefan Monnier  
-
-	* mail/mail-extr.el: Use explicit coding tag.
-
-2004-04-13  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.65 released.
-
-2004-04-09  Simon Josefsson  
-
-	* smtpmail.el: Add comment, based on report by kdc@rcn.com (Kevin
-	D. Clark).
-
-2003-12-07  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.64 released.
-
-2003-11-06  Mats Lidell  
-
-	* browse-url.el: Sync up with GNU Emacs CVS version 1.32 including
-	the following changes below before entry 2003-10-31
-
-2003-07-31  John Paul Wallington  
-
-	* browse-url.el (browse-url-epiphany): Doc fix.
-
-2003-07-07  Richard M. Stallman  
-
-	* net/browse-url.el (browse-url-browser-function):
-	Add alternative for Epiphany.
-	(browse-url-epiphany-program, browse-url-epiphany-arguments)
-	(browse-url-epiphany-startup-arguments)
-	(browse-url-epiphany-new-window-is-tab): New variables.
-	(browse-url-epiphany, browse-url-epiphany-sentinel): New functions.
-
-2003-04-12  Stefan Monnier  
-
-	* net/browse-url.el: Don't autoload all these defcustoms.
-	(browse-url-default-macosx-browser): New fun.
-	(browse-url-browser-function): Use it for system-type = darwin.
-	(browse-url-usr1-signal): Remove.
-	(browse-url-mosaic): Use SIGUSR1 directly instead.
-	(browse-url-gnome-moz-program): New var.
-	(browse-url-gnome-moz, browse-url-default-browser): Use it.
-
-2003-10-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.63 released.
-
-2003-09-12  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.62 released.
-
-2003-09-12  Hrvoje Niksic  
-
-	* pop3.el (pop3-movemail): Use binary coding system when writing
-	to crashbox.  Since binary was used to read the data from the
-	network, using it for writing guarantees that the same octets will
-	be stored that were retrieved from the server.
-
-2003-09-04  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.61 released.
-
-2003-09-04  Martin Gasbichler 
-
-	* browse-url.el (browse-url-mozilla): Fix position of
-	parenthesis.
-
-2003-08-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.60 released.
-
-2003-08-21  Christian Schmitt  
-
-	* browse-url.el (browse-url-mozilla): Make Mozilla browser work
-	under Windows.
-
-2003-05-14  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.59 released.
-
-2003-05-13  Simon Josefsson  
-
-	* smtpmail.el (smtpmail-open-stream): Don't hard code
-	starttls-program.
-
-2003-05-02  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.58 released.
-
-2003-05-02  Steve Youngs  
-
-	* tls.el: New.
-
-	* Makefile (ELCS): Add tls.elc.
-
-	* package-info.in (provides): Add tls.
-
-2003-03-09  Ben Wing  
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-	Use EXPLICIT_DOCS instead of explicitly giving the targets
-	and dependencies.
-
-2003-03-14  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.57 released.
-
-2003-03-11  Simon Josefsson  
-
-	* smtpmail.texi: Doc fix.
-
-2003-02-23  Alex Schroeder 
-
-	* smtpmail.texi (How Mail Works): New.
-
-2003-02-23  Simon Josefsson  
-
-	* smtpmail.texi: New file.
-
-	* Makefile: Build smtpmail.info.
-
-2003-01-13  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.56 released.
-
-2003-01-06  Simon Josefsson  
-
-	* browse-url.el (browse-url-mozilla-program): Autoload.  Suggested
-	by Ville Skyttä.
-
-2003-01-05  Simon Josefsson  
-
-	* browse-url-xemacs.el (browse-url-menu): Make Mozilla really be
-	mozilla.  Check if mozilla is installed before activating menu
-	entry.
-
-2002-11-29  Ben Wing  
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-12-06  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.55 released.
-
-2002-11-17  Simon Josefsson  
-
-	* browse-url.el (browse-url-default-browser): Change priority.
-	(browse-url-default-browser): Prefer w3m over MMM and lynx.
-
-2002-11-16  Nix  
-
-	* browse-url.el: Update copyright date, function list.
-	(browse-url-gnudoit-program): Say that it's used by emacs-w3m
-        as well as w3.
-	(browse-url-default-browser): Look for w3m first.
-
-	(browse-url-w3m): New function.
-	(browse-url-w3m-gnudoit): Likewise.
-	(browse-url-browser-function): Add to here...
-	* browse-url-xemacs.el (browse-url-menu): ... and here.
-
-2002-11-13  Ville Skyttä  
-
-	* smtpmail.el (smtp-via-smtp): Add missing paren.
-
-2002-11-13  Simon Josefsson  
-
-	* mail/smtpmail.el (smtpmail-via-smtp): Fall back to
-	user-mail-address as sender.
-
-2002-11-01  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.54 released.
-
-2002-10-15  Ville Skyttä  
-
-	* Makefile (srckit): Remove.
-
-2002-10-12  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.53 released.
-
-2002-10-11  Simon Josefsson  
-
-	* mail/sendmail.el (mail-envelope-from): New option `header' to
-	use RFC 2822 From: header as the envelope address.
-	(mail-envelope-from): New function, this should be used instead of
-	looking at the `mail-envelope-from' variable.
-	(sendmail-send-it): Use it.
-
-	* mail/smtpmail.el (smtpmail-via-smtp): Use it.
-
-2002-10-10  Simon Josefsson  
-
-	* browse-url.el (browse-url-mozilla): Doc fix.
-
-2002-10-10  Steve Youngs  
-
-	* browse-url.el (browse-url-mozilla-new-window-is-tab): New.
-	(browse-url-mozilla): Use it.
-
-2002-09-30  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.52 released.
-
-2002-09-28  Simon Josefsson  
-
-	* smtpmail.el (smtpmail-via-smtp): Only negotiate starttls on
-	streams that were opened using starttls.
-
-2002-09-26  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.51 released.
-
-2002-09-24  Simon Josefsson  
-
-	* mail/mail-extr.el (mail-extr-ignore-single-names): Change default.
-	(mail-extract-address-components): Doc fix.
-
-2002-09-25  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.50 released.
-
-2002-09-17  Simon Josefsson  
-
-	* smtpmail.el: Sync with Emacs CVS (following ChangeLog entries
-	from Emacs, until 2002-09-16 change).
-
-2002-09-12  Simon Josefsson  
-
-	* mail/smtpmail.el (smtpmail-send-it): Don't use : in filenames
-	(for cygwin). Suggested by Andrew Senior .
-	Use expand-file-name.  Also don't require time-stamp.
-
-2002-09-11  Simon Josefsson  
-
-	* mail/smtpmail.el (smtpmail-default-smtp-server): Doc fix.
-
-2002-08-30  Simon Josefsson  
-
-	* mail/smtpmail.el (smtpmail-via-smtp): Delete process buffer
-	unless s-debug-info is enabled.
-
-2002-05-12  Richard M. Stallman  
-
-	* mail/smtpmail.el (smtpmail-mail-address): New variable.
-	(smtpmail-send-it): Bind and use that instead of `mail-address'.
-	(smtpmail-via-smtp): Likewise.
-
-2002-05-09  Simon Josefsson  
-
-	* mail/smtpmail.el (smtpmail-send-it): Use user-mail-address from
-	calling buffer.
-
-2002-05-08  Richard M. Stallman  
-
-	* mail/smtpmail.el (netrc-machine, netrc-get): Add autoloads.
-
-2002-09-16  Simon Josefsson  
-
-	* Makefile (REQUIRES): Add ecrypto.
-
-2002-09-06  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.49 released.
-
-2002-09-02  Ville Skyttä  
-
-	* Makefile (REQUIRES): Self-require.
-
-	* highlight-headers.el: Use browse-url to open URLs,
-	provide obsolete aliases for backwards compatibility.
-
-2002-07-31  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.48 released.
-
-2002-07-26  Simon Josefsson  
-
-	* browse-url.el (browse-url-netscape-send): Doc fix.
-	(comments): Added ";; XEmacs" markers were we differ from Emacs.
-
-2002-06-21  Richard M. Stallman  
-
-	* net/browse-url.el (browse-url-at-mouse): Don't pass an arg
-	to browse-url-at-point.
-
-2002-07-23  John Paul Wallington  
-
-	* browse-url.el (browse-url-lynx-input-attempts): Use defcustom.
-	(browse-url-lynx-input-delay): Add custom type and group.
-
-2002-07-08  Simon Josefsson  
-
-	* mail-extr.el (mail-extr-all-top-level-domains): Update names.
-
-2002-07-14  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.47 released.
-
-2002-06-30  Ville Skyttä  
-
-	* browse-url.el (browse-url-delete-temp-file):
-	Convert comments to docstring.
-	(browse-url-netscape-send)
-	(browse-url-lynx-emacs): Docstring fixes.
-
-2002-06-30  Simon Josefsson  
-
-	* browse-url.el (browse-url-opera): Fix doc.
-
-	* mail-extr.el: Sync up with Emacs.
-	(mail-extr): Add :prefix.
-	(mail-extr-full-name-prefixes): purecopy. fix :type.
-	(mail-extr-mailbox-match-case-fold): Remove variable, this is now
-	the default.
-	(mail-extr-delete-char): Removed (obsolete v19 stuff).
-	(mail-extr-skip-whitespace-forward): 
-	(mail-extr-skip-whitespace-backward): 
-	(mail-extr-nuke-char-at): 
-	(mail-extr-safe-move-sexp): 
-	(mail-extr-undo-backslash-quoting): Defsubst.
-	(mail-extr-nuke-outside-range): Doc fix.
-	(mail-extr-last): Removed (obsoleted by `last').
-	(mail-extract-address-components): New optional argument ALL.
-	(mail-extract-address-components): MAJOR changes, unclear rationale.
-	(mail-extr-voodoo): MAJOR changes, unclear rationale.
-	(all-top-level-domains): Renamed to mail-extr-all-top-level-domains.
-	(mail-extr-all-top-level-domains): Updated.
-	(what-domain): Use m-e-a-t-l-d.
-
-2002-04-30  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.46 released.
-
-2002-04-27  Simon Josefsson  
-
-	* package-info.in (provides): Add netrc.
-
-	* Makefile (ELCS): Add netrc.el to package.
-
-2002-04-27  Simon Josefsson  
-
-	* smtpmail.el: Sync up with Emacs CVS. Autoload netrc and base64.
-	(smtpmail-auth-credentials): Support .authinfo.
-	(smtpmail-try-auth-methods): Support .authinfo.
-
-	* smtpmail.el (smtpmail-queue-counter): New internal variable.
-	(smtpmail-send-it): Use it, fix fast resending bug.
-
-2002-04-24  Simon Josefsson  
-
-	* netrc.el: New file, from gnus-util.el.
-
-2002-04-12  Simon Josefsson  
-
-	* browse-url.el (browse-url-temp-file-list): Removed, unused.
-	(browse-url-maybe-new-window): Negate test (from Emacs).
-	(browse-url-delete-temp-file-list): Removed, unused.
-	(browse-url-delete-temp-file): Sync with Emacs.
-	(browse-url-mozilla): Fix doc.
-	(browse-url-galeon): Use --existing and --noraise correctly.
-
-2002-04-24  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.45 released.
-
-2002-04-07  Simon Josefsson  
-
-	* browse-url.el (browse-url-browser-function): Revert :type fix
-	because buggy custom in XEmacs.
-
-2002-03-29  Simon Josefsson  
-
-	* browse-url.el (require): Require thingatpt and executable.
-
-2002-03-29  Ville Skyttä  
-
-	* Makefile (REQUIRES): Add fsf-compat and sh-script, needed by
-	browse-url.
-
-2002-03-25  Steve Youngs  
-
-	* Makefile (VERSION): 1.44 released.
-
-2002-03-15  Simon Josefsson  
-
-	* browse-url.el (browse-url-filename-alist): Don't begin docstring
-	with *, you don't want to set this one with M-x set-variable.
-
-2002-03-15  Ville Skyttä  
-
-	* browse-url.el (browse-url-browser-function): Add Opera.
-	(browse-url-opera-program, browse-url-opera-arguments)
-	(browse-url-opera-startup-arguments, browse-url-opera)
-	(browse-url-opera-sentinel): New.
-	(browse-url-default-browser): Add Opera, fix order in docstring.
-	(browse-url-netscape-program, browse-url-netscape-arguments)
-	(browse-url-netscape-startup-arguments, browse-url-mozilla-program)
-	(browse-url-mozilla-arguments, browse-url-mozilla-startup-arguments)
-	(browse-url-galeon-program, browse-url-galeon-arguments)
-	(browse-url-galeon-startup-arguments)
-	(browse-url-galeon-new-window-is-tab, browse-url-mosaic-program)
-	(browse-url-mosaic-arguments, browse-url-mosaic-pidfile)
-	(browse-url-filename-alist, browse-url-of-file-hook)
-	(browse-url-CCI-port, browse-url-xterm-program)
-	(browse-url-lynx-emacs-args, browse-url-gnudoit-program)
-	(browse-url-temp-dir, browse-url-netscape-version)
-	(browse-url-lynx-input-delay, browse-url-kde-program)
-	(browse-url-gnome-moz-arguments): Begin docs with *.
-
-	* browse-url-xemacs.el (browse-url-menu): Add Opera.
-
-2002-01-19  Simon Josefsson  
-
-	* browse-url.el (browse-url-url-at-point): Work around bug in
-	XEmacs `set-text-properties'.
-
-2002-01-13  Steve Youngs  
-
-	* package-info.in (provides): Update to include all provides.
-
-2002-01-09  Simon Josefsson  
-
-	* smtpmail.el (smtpmail-send-queued-mail): Use binary instead of
-	no-conversion (no-conversion does conversion in XEmacs).
-
-2002-01-08  Simon Josefsson  
-
-	Emacs 21 sync.
-
-	* browse-url.el (browse-url): Add :link.
-	(browse-url-browser-function): Change UNIX default to
-	`browse-url-default-browser'.
-	(browse-url-browser-function): Add Mozilla.
-	(browse-url-browser-function): Add "Default browser".
-	(browse-url-browser-display, browse-url-mozilla-program)
-	(browse-url-mozilla-arguments)
-	(browse-url-mozilla-startup-arguments, browse-url-galeon-program)
-	(browse-url-galeon-arguments)
-	(browse-url-galeon-startup-arguments)
-	(browse-url-galeon-new-window-is-tab): New variables.
-	(browse-url-netscape-display): Removed.
-	(browse-url-filename-alist): Notice URLs.
-	(browse-url-process-environment): Don't use netscape browser.
-	(browse-url-default-browser, browse-url-mozilla,
-	(browse-url-mozilla-sentinel, browse-url-galeon) 
-	(browse-url-galeon-sentinel): New functions.
-	(browse-url-lynx-emacs): Fix errors.
-	(browse-url-galeon): Removed. (Rewritten above.)
-
-2001-12-26  Simon Josefsson  
-
-	* smtpmail.el (smtpmail-send-it): Use
-	`mail-sendmail-undelimit-header'.
-	(mail-check-safe-charset): Autoload it.
-
-2001-12-21  Simon Josefsson  .
-
-	* smtpmail.el (smtpmail-send-queued-mail): Use
-	with-temp-buffer instead of find-file-noselect, and bind
-	coding-system-for-read to no-conversion when reading the queued
-	messages.
-
-2001-12-10  Eli Zaretskii  
-
-	* smtpmail.el (smtpmail-send-queued-mail): Insert the
-	enqueued messages literally.
-
-2001-11-30  Stefan Monnier  
-
-	* smtpmail.el: Use with-current-buffer.
-	(message-make-date, message-make-message-id): Autoload when needed.
-	(smtpmail-send-it): Use them to add `Date:' and `Message-Id:'
-	headers when missing.
-
-2001-11-25  Pavel Janík  
-
-	* smtpmail.el (smtpmail-deduce-address-list): Don't use
-	insert-string.
-
-2001-11-13  Simon Josefsson  
-
-	* smtpmail.el (top-level): Change maintainer to Simon
-	Josefsson, cleanup the smtpmail.el header.
-
-	* smtpmail.el (top-level): Don't require cl.
-	(smtpmail-cred-server, smtpmail-cred-port, smtpmail-cred-key)
-	(smtpmail-cred-user, smtpmail-cred-cert, smtpmail-cred-passwd)
-	(smtpmail-intersection): New utility funs.
-	(smtpmail-find-credentials): Use them.
-	(smtpmail-intersection): New function.
-	(smtpmail-open-stream): Use stringp instead of string-to-list.
-	(smtpmail-open-stream, smtpmail-try-auth-methods): New functions,
-	separated from smtpmail-via-smtp.
-
-	* smtpmail.el (top-level): Autoload starttls, mail-utils and
-	rfc2104.  Require base64 and cl.
-	(smtpmail-smtp-service): Doc fix.
-	(smtpmail-debug-info): Doc fix.
-	(smtpmail-auth-credentials): Fix default.  Fix doc.
-	(smtpmail-starttls-credentials): Fix doc.
-	(smtpmail-debug-verb): New variable.
-	(smtpmail-deduce-address-list, smtpmail-send-it): Don't require
-	mail-utils (it is autoloaded).
-	(smtpmail-via-smtp): Use `smtpmail-debug-verb' to control VERB.
-
-2001-12-27  Simon Josefsson  
-
-	* sendmail.el (mail-envelope-from): Fix :type.  Suggested by
-	"Golubev I. N." .
-	(sendmail-send-it): Copy `mail-envelope-from' from calling buffer.
-	From "Golubev I. N." .
-
-2001-11-27  Simon Josefsson  
-
-	* sendmail.el (top-level): Don't require mail-abbrev.
-
-	* mail-abbrevs.el (mail-abbrev-mailrc-file): Defun.  Autoload.
-
-2001-11-22  Simon Josefsson  
-
-	* sendmail.el (top-level): Require mail-abbrevs when compiling,
-	for the `mail-abbrev-mailrc-file' macro.
-
-2001-10-15  Simon Josefsson  
-
-	* smtpmail.el (smtpmail-via-smtp): Use `mail-envelope-from'
-	in MAIL FROM.
-
-2001-10-15  Simon Josefsson  
-
-	* smtpmail.el: Doc fix.
-
-	* browse-url.el: Update maintainer.
-	(browse-url-browser-function): Upcase "Galeon".
-
-2001-10-13  Simon Josefsson  
-
-	* sendmail.el (sendmail-send-it): Fix local-variable-p arg.
-
-2001-10-14  Andy Piper  
-
-	* browse-url.el (browse-url-browser-function): do the windows
-	thing for cygwin.
-
-2001-10-10  Simon Josefsson  
-
-	Emacs 21 sync.
-
-	* sendmail.el (mail-aliases-setup): Don't autoload (autoloaded in
-	mail-abbrev).
-	(mail-font-lock-keywords): Delay evaluation of
-	`mail-header-separator'.
-	(mail-font-lock-keywords): Various changes.
-	(mail-mode): Use `mail-mode-auto-fill' as
-	`normal-auto-fill-function'.
-	(mail-mode): Use `mail-mode-fill-function' as
-	`fill-paragraph-function'.
-	(mail-mode): Add `comment-start'.
-	(mail-mode): Add `adaptive-fill-regexp'.
-	(mail-mode): Add `adaptive-fill-first-line-regexp'.
-	(mail-mode): Fix `paragraph-start' regexp.
-	(sendmail-send-it): Copy `buffer-file-coding-system' over to temp
-	buffer.
-	(sendmail-send-it): Use `mail-header-end'.
-	(sendmail-send-it): Better handling of empty subjects.
-	(sendmail-send-it): Deliver in background (-odb) unless
-	`mail-interactive'.
-	(sendmail-send-it): Better detection of no recipients.
-	(mail-indent-citation): Various fixes.
-	(mail-recover): Default-directory is bound in `mail-mode', no need
-	to do it twice.
-
-2001-08-22  Stefan Monnier  
-
-	* sendmail.el (mail-mode): Use adaptive-fill-regexp.
-
-2001-03-21  Gerd Moellmann  
-
-	* sendmail.el (sendmail-send-it): Don't parse Resent-*
-	headers.  Always invoke sendmail with option -t.
-
-2000-12-21  Miles Bader  
-
-	* sendmail.el (mail-mode): Set `comment-start' to the yank prefix.
-
-2001-10-06  Simon Josefsson  
-
-	Emacs 21 sync.
-
-	* reporter.el (top-level): Remove outdated version and last
-	modified fields.
-	(reporter-calculate-separator): Remove.
-	(reporter-submit-bug-report): Don't use it.  This may be bogus, if
-	it causes problems, revert.
-	(reporter-bug-hook): Ditto, use `rfc822-goto-eoh' instead.
-	(reporter-submit-bug-report): Doc fix for font-locking.
-
-2001-07-15  Stefan Monnier  
-
-	* reporter.el (reporter-submit-bug-report):
-	Don't abuse make-variable-buffer-local.  Fix call to add-hook.
-
-2000-05-26  Dave Love  
-
-	* reporter.el (reporter-version): Deleted.
-
-2001-10-10  Simon Josefsson  
-
-	* mail-utils.el (mail-check-safe-charset): Fix typo.
-
-	* rfc2104.el: Add ";;; Code:" to comply to coding style.
-
-2001-09-22  Simon Josefsson  
-
-	* sendmail.el (top-level): Require rfc822
-	(mail-dir): Removed variable. (Implementation using this variable
-	didn't seem finished, so I reverted the little that was done, see
-	`mail').
-	(mail-alias-modtime): New variable.  Used to keep track of
-	~/.mailrc modtime.
-	(mail-use-multiple-buffers-p): Customize variable.
-	(sendmail-sync-aliases): Re-instated (renamed from
-	`sendmail-synch-aliases'). Used to compare ~/.mailrc modtime.
-	(mail-setup): Require mail-abbrevs.
-	(mail-setup): Call `sendmail-sync-aliases' to see if ~/.mailrc
-	changed.
-	(mail-setup): Kill local variable `buffer-file-coding-system'.
-	(mail-setup): Inactivate input method.
-	(mail-mode): Doc fix.
-	(mail-mode-map): Derive from `text-mode-map'.
-	(mail-menubar-menu): Change "Go to field:" to "Navigation:"
-	(because not all commands where fields.).
-	(mail-menubar-menu): Add FCC and Expand Aliases.
-	(mail-bury): Use `window-dedicated-p'.
-	(mail-bury): Support `mail-dedicated-frame'.
-	(mail-send): Doc fix.
-	(mail-send): Complain about invalid headers.
-	(mail-do-fcc): Revert some of the XEmacs hackery, instead go
-	through some effort to make sure the file and any open buffers are
-	updated (earlier version could cause missing Fcc's).
-	(mail-do-fcc-cached-timezone, mail-do-fcc-insert-date-header):
-	Removed, functions from `mail-utils' are used instead.
-	(mail-do-fcc-rmail-internal): Removed, handled inline in
-	`mail-do-fcc' slightly different.
-	(mail-sent-via): Reinstate function.  Use `mail-header-end'.
-	(mail-reply-to): Let `mail-position-on-field' insert header.
-	(mail): Remove duplicated doc.
-	(mail): Don't use mail-dir.
-
-2001-09-16  Björn Torkelsson  
-
-	* Makefile (ELCS): adding browse-url-xemacs
-
-2001-09-13  Simon Josefsson  
-
-	* browse-url-xemacs.el: New file, moved the last work here.
-
-2001-09-10  Björn Torkelsson  
-
-	* browse-url.el: added menus for choosing which browser to open
-	URL:s with (moved from menubar-items)
-
-2001-08-25  Simon Josefsson  
-
-	* sendmail.el (mail-reply-buffer): Rename to `mail-reply-action'.
-	(mail-reply-action, mail-send-actions): Make permanent-local.
-	(mail-default-headers, mail-bury-selects-summary, mail-send-hook):
-	Defcustom
-	(mail-send-nonascii): New variable.
-	(mail-setup): `mail-reply-buffer' -> `mail-reply-action'.
-	(mail-setup): Insert newlines.
-	(mail-setup): Put property on `mail-header-separator'.
-	(mail-setup): Support lisp expr `mail-signature'.
-	(mail-mode): `mail-reply-buffer' -> `mail-reply-action'.
-	(mail-header-end, mail-text-start, mail-sendmail-delimit-header)
-	(mail-sendmail-undelimit-header, mail-mode-auto-fill)
-	(mail-mode-fill-paragraph): New functions.
-	(mail-mode-map): Add `mail-yank-region'.
-	(mail-mode-map): Add `mail-attach-file'.
-	(mail-menubar-menu): `mail-reply-buffer' -> `mail-reply-action'.
-	(rmail-summary-buffer): Remove.
-	(sendmail-send-it): Doc fix.
-	(sendmail-send-it): Look for `sendmail-program' in caller's
-	buffer.
-	(mail-position-on-field): Use `mail-header-end'.  Fix.
-	(mail-text, mail-fill-yanked-message): Use `mail-text-start'.
-	(mail-fill-yanked-message): Call `fill-individual-paragraphs' with
-	`mail-citation-prefix-regexp' (Note: `f-i-p' don't support regexp
-	there, but a regexp is non-nil so it works anyway.  `f-i-p' should
-	be synced as well.)
-	(mail-indent-citation): Yank clear headers.
-	(mail-yank-original): Doc fix.
-	(mail-yank-original): `mail-reply-buffer' -> `mail-reply-action'.
-	(mail-yank-original): Use `mail-reply-action' instead of old
-	logic.
-	(mail-yank-original): Remove text properties.
-	(mail-yank-original): Bind `mark-even-if-inactive' (for
-	transient-mark-mode, if XEmacs adds it in the future).
-	(mail-yank-original): Bind `mail-citation-header' before running
-	`mail-citation-hook'.
-	(mail-yank-original): Don't active mark.
-	(mail-yank-clear-headers): Exchange start and end if necessary.
-	(mail-yank-region, mail-attach-file): New functions.
-	(mail): Doc fix.
-	(mail): Auto save fixes.
-
-2001-08-25  Simon Josefsson  
-
-	* browse-url.el (browse-url-browser-function): Add Regexp/function
-	alist custom option. (Emacs sync.)
-
-2001-08-01  Simon Josefsson  
-
-	* rfc822.el (rfc822-goto-eoh): Add compatibility
-	`rfc822-goto-eoh'. (Emacs has it in simple.el.)
-
-2001-07-30  Simon Josefsson  
-
-	* smtpmail.el (smtpmail-via-smtp): Send EHLO/HELO again after
-	STARTTLS, as per RFC 2487.
-
-2001-07-28  Simon Josefsson  
-
-	First part of Emacs 21 sync.
-
-	* sendmail.el (sendmail): New defgroup.
-	(mail-from-style): Defcustom.
-	(mail-specify-envelope-from, mail-envelope-from): New variables.
-	(mail-self-blind):
-	(mail-interactive):
-	(mail-yank-ignored-headers):
-	(send-mail-function): Defcustom.
-	(mail-header-separator): Defcustom. Category text property (?).
-	(mail-archive-file-name):
-	(mail-default-reply-to):
-	(mail-alias-file):
-	(mail-setup-hook):
-	(mail-yank-prefix):
-	(mail-indentation-spaces):
-	(mail-citation-hook): Defcustom.
-	(mail-citation-header):
-	(mail-citation-prefix-regexp): New variables.
-	(mail-signature): Defcustom.  Risky-local-variable property (?).
-	(mail-signature-file): Defcustom.
-	(sendmail-send-it): Support system-default mail-from-style.
-	Support mail-{specify-,}envelope-from.
-
-	Emacs 21 sync.
-	
-	* smtpmail.el (smtpmail-maybe-append-domain): Renamed from
-	`maybe-append-domain'.
-	(smtpmail-warn-about-unknown-extensions): New variable.
-	(smtpmail-via-smtp): Use new function and variable.
-
-2001-06-16  Simon Josefsson  
-
-	Emacs 21 sync.
-
-	* browse-url.el (toplevel): Add 2000, 2001 to copyright. Sync
-	comments.
-	(browse-url-browser-function): Fix doc.
-	(browse-url-browser-function): Rename "kfm" to "KDE". Add GNOME.
-	(browse-url-new-window-flag): Renamed from
-	`browse-url-new-window-p'.
-	(browse-url-new-window-p): Defalias.
-	(browse-url-filename-alist): Add DOS *:\* magic.
-	(browse-url-kde-program, browse-url-kde-args): Add variable.
-	(browse-url-url-at-point): Remove conditioning.
-	(browse-url-maybe-new-window): New macro.
-	(browse-url-file-url, browse-url): Use `dolist'.
-	(browse-url-at-mouse): Use `mouse-set-point' instead of previous
-	more complicated logic.
-	(browse-url-event-buffer, browse-url-event-point): Removed.
-	(browse-url-netscape): Use ` instead of (list ...).
-	(browse-url-gnome-moz-arguments): New variable.
-	(browse-url-gnome-moz): New function.
-	(browse-url-kde): Renamed from `browse-url-kfm'.
-	(browse-url-kfm): Defalias.
-	(browse-url-{netscape,mosaic,cci,w3,lynx-emacs,mail}): Use
-	`browse-url-maybe-new-window' macro.
-
-2001-06-08  Matt Curtin  
-
-	Integrated new function graciously supplied by 
-	Mikael Hedin .
-	
-	* browse-url.el: Added Galeon support.
-
-2001-05-27  Don Pellegrino 
-
-	* smtpmail.el (smtpmail-auth-supported): Add `login'.
-	(smtpmail-via-smtp): Check for `login' mech properly.
-
-2001-05-15  Simon Josefsson  
-
-	Emacs 21 sync.
-
-	* rfc822.el (rfc822-bad-address): Remove \n\t from message.
-	(rfc822-looking-at): Use `set-match-data' instead of
-	`store-match-data'.
-	(rfc822-snarf-word):
-	(rfc822-snarf-subdomain):
-	(rfc822-addresses):
-	(rfc822-addresses-1): Remove \0177-\377 from regexp. (It didn't
-	work as intended, matching ascii > 127 (think mule), and it also
-	generated unnecessary complaints on mail addresses.)
-	(rfc822-addresses-1): Allow multiple "." inside RFC822 strings.
-	(rfc822-addresses-1): More error handling.
-	(rfc822-addresses): Remove old hack to ignore bad addresses. The
-	old hack behaves badly on e.g.
-	"lcm36651@uxa.cso.uiuc.edu (Hi!  ;)), jas@pdc.kth.se"
-	while without the hack it works better, you get an RFC822 comment
-	containing an error message.
-	(top level): Remove 1993 copyright (was probably the earlier
-	XEmacs modification).
-
-2001-03-30  David M. Karr 
-
-	* smtpmail.el (smtpmail-send-it): Use (user-mail-address).
-
-2001-03-24  Simon Josefsson  
-
-	Sync with Emacs -- Mike Taylor, 11th October 1999 to add support
-	for automatically appending a domain to RCPT TO: addresses.
-	
-	* smtpmail.el (smtpmail-sendto-domain): New variable.
-	(maybe-append-domain): New function.
-	(smtpmail-via-smtp): Use it.
-
-2001-03-22  Simon Josefsson  
-
-	* smtpmail.el (smtpmail-via-smtp): Support EHLO SIZE arguments.
-
-2001-03-14  Edward M. Lee  
-
-	* sendmail.el (send-mail-function): Use smtp by default on cygwin.
-
-2001-02-16  Simon Josefsson  
-
-	* base64.el: Synch with Gnus: Require cl.  Use defalias instead of
-	fset. Add variable base64-binary-coding-system. Use it.  Change
-	base64-*insert-char.  Add optional argument no-line-break for
-	compatibility to base64-encode*.
-
-2000-12-31  Simon Josefsson  
-
-	* reporter.el: Incorporate doc fixes from Emacs 21, update
-	maintainer field.
-
-2000-12-31  Simon Josefsson  
-
-	* mailheader.el: Sync with Emacs 21 (Doc fixes, support string
-	`headers' in mail-header-format).
-
-	* starttls.el: Sync with Emacs 21 (Change copyright status to
-	reflect FSF assignment, remove starttls-open-ssl-stream, improve
-	customize of variables).
-
-	* rfc2104.el: Sync with Emacs 21 (Add SHA-1 example, test case
-	reference, rfc2104-hexstring-to-bitstring, refresh copyright
-	date).
-
-2000-11-26  Simon Josefsson  
-
-	* mail-utils.el (mail-y-or-n-p, mail-flatten-list)
-	(mail-check-safe-charset): New functions, from LMI's message.el.
-
-	* smtpmail.el (smtpmail-send-it): Use it; check for bad
-	characters.
-
-	* sendmail.el (sendmail-send-it): Use it; check for bad
-	characters.
-
-2000-11-18  Simon Josefsson  
-
-	* smtpmail.el (smtpmail-via-smtp): Use `set-process-coding-system'
-	instead of `set-buffer-process-coding-system'.  Only use it if
-	`mule' or `file-coding' is provided.
-	(smtpmail-send-data-1): Call `encode-coding-string' only if `mule'
-	or `file-coding' is provided.
-
-2000-06-26  Charles G Waldman  
- 
-        * mail-abbrevs.el: Remove v18 compatibility code.
-        (mail-rename-buffer-regexp) New variable.
-        (mail-maybe-rename-buffer) New function.
-        (sendmail-pre-abbrev-expand-hook) Call `mail-maybe-rename-buffer'.
-
-2000-11-08  Simon Josefsson  
-
-	* smtpmail.el: Added auth and starttls support.
-
-	* starttls.el: New file.
-
-2000-11-08  Steve Youngs  
-
-	* base64.el: Moved from w3 package.
-
-	* rfc2104.el: Moved from gnus package.
-
-	* Makefile (ELCS): Add rfc2104.elc, base64.elc.
-
-2000-10-26  Yoshiki Hayashi  
-
-	* smtpmail.el (smtpmail-send-data-1): Replace MULE 2.3 functions
-	to current ones.
-
-2000-10-24  Simon Josefsson  
-
-	* smtpmail.el: Sync with Emacs 20.7
-
-2000-10-12  Yoshiki Hayashi  
-
-	* mail-utils.el (rmail-dont-reply-to): Remove comma
-	following spaces.  Patch from Gerd.
-
-2000-10-05  Martin Buchholz  
-
-	* *: Mega typo fix.
-
-2000-08-07  Sean MacLennan  
-
-	* browse-url.el (browse-url-mosaic): Add support for mMosiac
-
-2000-06-05  Ben Wing  
-
-	* sendmail.el (send-mail-function): use smtpmail-send-it
-	under MS Windows -- there is no sendmail.
-
-2000-03-13  Matt Curtin  
-
-	* browse-url.el: Included change suggested by Baoqiu Cui
-	 to prevent a call that will fail to
-	`set-text-properties'.  Fixed the check for the Windoze
-	display in `browse-url-netscape'. Fixed the XEmacs interface to
-	the default browser for Windoze.
-
-2000-03-05  Kyle Jones  
-
-	* sendmail.el (mail-send): call expand-abbrev only if parent
-	function is called interactively.  Previously expand-abbrev was
-	called in all cases.
-
-	  (mail-to): ditto.
-	  (mail-subject): ditto.
-	  (mail-cc): ditto.
-	  (mail-bcc): ditto.
-	  (mail-fcc): ditto.
-	  (mail-reply-to): ditto.
-	  (mail-text): ditto.
-
-2000-02-16  Yoshiki Hayashi  
-
-	* mail-utils.el (rmail-dont-reply-to): Fix the case for
-	multiple comma separated addresses.  Patch from Gerd.
-
-2000-01-05  Yoshiki Hayashi  
-
-	* mail-utils.el: Synch with FSF 20.5.
-
-2000-01-08  Andreas Jaeger  
-
-	* browse-url.el: Added support for kfm.  
-	Patch by Neal Becker .
-
-2000-01-07  Andreas Jaeger  
-
-	* Makefile (ELCS): Added mailheader.
-
-	* mailheader: Moved from package gnus to here Gnus 5.8.x usage.
-
-1999-12-09  Gunnar Evermann  
-
-	* browse-url.el (browse-url-event-buffer): Replace posn-buffer &
-	event-start with event-buffer.
-	(browse-url-event-point): Replace posn-point & event-start with
-	event-point.
-
-1999-12-05  Andreas Jaeger  
-
-	* Makefile (REQUIRES): Add eterm.
-	Patch by Jan Vroonhof . 
-
-1999-11-14  Matt Curtin  
-
-	* browse-url.el synched with Emacs 20.4
-
-1999-04-09  Andy Piper  
-
-	* pop3.el: sync with 1.3s.
-
-1999-04-13  Adrian Aichner  
-
-	* pop3.el (pop3-get-message-numbers): Reverse msg-list when used
-	to push (which reverses again) elements found in UIDL.
-
-1999-04-09  Andy Piper  
-
-	* pop3.el (pop3-clean-region): don't misinterpret From: lines.
-	(pop3-nnmail-movemail): new gnus replacement function.
-	
-1999-03-05  SL Baur  
-
-	* highlight-headers.el (highlight-headers-follow-url-function):
-	Document KFM support.
-	(highlight-headers-follow-url-kfm): New function.
-	From Neal Becker 
-
-	* browse-url.el (browse-url-browser-function): Add KFM support.
-	(browse-url-kfm): New function.
-	From Neal Becker 
-
-1999-01-20  Charles G Waldman  
-
-	* sendmail.el (sendmail-send-it): Execute sendmail in
-	  background if mail-interactive is nil, and don't 
-	  try to check error exit.
-
-1998-10-31  Gregory Neil Shapiro  
-
-	* sendmail.el (sendmail-send-it): Catch error exits from
-	  sendmail-program and report the failure to the user.
-
-1998-06-08  Martin Buchholz  
-
-	* browse-url.el: browse-url-grail requires &optional new-window
-	arg, like all other browse-url-* functions.
-	- remove unused variabled `pidbuf'
-	- remove global setq of variable `enc'
-
-1998-06-01  SL Baur  
-
-	* mail-abbrevs.el: Unconditionally initialize keymaps.
-
-1998-05-10  SL Baur  
-
-	* mail-abbrevs.el (mail-abbrev-init-keys): New function.
-	Initialize keys only when called and do it on a keymap the caller 
-	provides.
-
-1998-05-09  SL Baur  
-
-	* Customize `message-url'.
-	From Michael Ernst 
-
-1998-05-01  SL Baur  
-
-	* sendmail.el (mail-mode): Use easymenu to add the menu.
-
-1998-04-28  SL Baur  
-
-	* mail-utils.el (mail-rewrite-address-function): New variable.
-	(mail-strip-quoted-names): Use it.
-	
-1998-04-22  Didier Verna  
-
-	* browse-url.el (browse-url-cci): ;;;###autoload was missing.
-
-1998-04-21  SL Baur  
-
-	* highlight-headers.el (highlight-headers-follow-url-netscape):
-	Print URL in minibuffer status messages.
-	From Bob Weiner 
-
-1998-03-22  Barry A. Warsaw  
-
-	* reporter.el-3.35.
-
-Thu Mar 19 12:24:19 1998  Barry A. Warsaw  
-
-	* reporter.el:  Released 3.34 to RMS and SLB.
-
-Thu Mar 19 17:22:21 1998  Barry A. Warsaw  
-
-	* reporter.el (mail-user-agent): Removed all mail-user-agent
-	related definitions since these are now part of X/Emacs.
-
-	* reporter.el (reporter-beautify-list): Break infloop when
-	reaching the end of the buffer without crossing an unbalanced
-	paren.  Use scan-sexps instead of forward-sexp for the loop break
-	test.
-
-Mon Jan 13 17:10:24 1997  Barry A. Warsaw  
-
-	* reporter.el (reporter-submit-bug-report): Only call
-	display-buffer if pop-up-windows is non-nil.
-
-Thu Jan  9 23:04:46 1997  Barry A. Warsaw  
-
-	* reporter.el: Merged in RMS changes from 29-Aug-1996.
-
-1998-02-24  SL Baur  
-
-	* rmail-mini.el: Define rmail-mode-map.
-	From John W. Jones 
-
-1998-01-24  SL Baur  
-
-	* Makefile (VERSION): Update to package standard 1.0.
-
-1998-01-18  SL Baur  
-
-	* rmailout.el: Add provide 'feature.
-
-	* highlight-headers.el (highlight-headers-follow-url-netscape):
-	Fix processing of sending URL to remote Netscape.
-	From Raymond Toy 
-
-1998-01-11  SL Baur  
-
-	* Makefile: Update to newer package interface.
-
-1998-01-09  SL Baur  
-
-	* mail-abbrevs.el: Synched with the version in InfoDock 3.6.2.
-
-1998-01-02  SL Baur  
-
-	* Makefile: Update to newer package interface.
-
-1997-12-21  SL Baur  
-
-	* Makefile (ELCS): Add reporter.el.
-
-1997-12-20  SL Baur  
-
-	* browse-url.el: Remove explicit (require 'dired).
-	toplevel: Fix guard on (require 'term).
-	
-	* Makefile: Created.
-
diff --git a/xemacs-packages/lisp/mail-lib/_pkg.el b/xemacs-packages/lisp/mail-lib/_pkg.el
deleted file mode 100644
index 0c5ce427..00000000
--- a/xemacs-packages/lisp/mail-lib/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'mail-lib
-		 :version 1.76
-          :author-version "No-Upstream-Ver"
-		 :type 'regular)
diff --git a/xemacs-packages/lisp/mail-lib/auto-autoloads.el b/xemacs-packages/lisp/mail-lib/auto-autoloads.el
deleted file mode 100644
index 243ebc3a..00000000
--- a/xemacs-packages/lisp/mail-lib/auto-autoloads.el
+++ /dev/null
@@ -1,572 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'mail-lib-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "mail-lib/_pkg.el")
-
-(package-provide 'mail-lib :version 1.76 :author-version "No-Upstream-Ver" :type 'regular)
-
-;;;***
-
-;;;### (autoloads nil "browse-url-xemacs" "mail-lib/browse-url-xemacs.el")
-
-(progn (defun browse-url-xemacs-init-menu nil (if (featurep 'menubar) (add-submenu '("Options" "Internet") browse-url-menu))))
-
-;;;***
-
-;;;### (autoloads (browse-url-opera browse-url-kde browse-url-generic browse-url-mail browse-url-mmm browse-url-lynx-emacs browse-url-lynx-xterm browse-url-w3m-gnudoit browse-url-w3m browse-url-w3-gnudoit browse-url-w3 browse-url-iximosaic browse-url-cci browse-url-grail browse-url-mosaic browse-url-gnome-moz browse-url-galeon browse-url-firefox browse-url-mozilla browse-url-netscape browse-url-default-browser browse-url-at-mouse browse-url-at-point browse-url browse-url-of-region browse-url-of-dired-file browse-url-of-buffer browse-url-of-file) "browse-url" "mail-lib/browse-url.el")
-
-(defcustom browse-url-browser-function (cond ((memq system-type '(windows-nt ms-dos cygwin32)) 'browse-url-default-windows-browser) ((memq system-type '(darwin)) 'browse-url-default-macosx-browser) (t 'browse-url-default-browser)) "*Function to display the current buffer in a WWW browser.\nThis is used by the `browse-url-at-point', `browse-url-at-mouse', and\n`browse-url-of-file' commands.\n\nIf the value is not a function it should be a list of pairs\n(REGEXP . FUNCTION).  In this case the function called will be the one\nassociated with the first REGEXP which matches the current URL.  The\nfunction is passed the URL and any other args of `browse-url'.  The last\nregexp should probably be \".\" to specify a default browser." :type '(choice (function-item :tag "Emacs W3" :value browse-url-w3) (function-item :tag "W3 in another Emacs via `gnudoit'" :value browse-url-w3-gnudoit) (function-item :tag "Emacs W3M" :value browse-url-w3) (function-item :tag "W3M in another Emacs via `gnudoit'" :value browse-url-w3-gnudoit) (function-item :tag "Mozilla" :value browse-url-mozilla) (function-item :tag "Firefox" :value browse-url-firefox) (function-item :tag "Galeon" :value browse-url-galeon) (function-item :tag "Epiphany" :value browse-url-epiphany) (function-item :tag "Netscape" :value browse-url-netscape) (function-item :tag "Mosaic" :value browse-url-mosaic) (function-item :tag "Mosaic using CCI" :value browse-url-cci) (function-item :tag "IXI Mosaic" :value browse-url-iximosaic) (function-item :tag "Lynx in an xterm window" :value browse-url-lynx-xterm) (function-item :tag "Lynx in an Emacs window" :value browse-url-lynx-emacs) (function-item :tag "Grail" :value browse-url-grail) (function-item :tag "MMM" :value browse-url-mmm) (function-item :tag "KDE" :value browse-url-kde) (function-item :tag "Opera" :value browse-url-opera) (function-item :tag "Specified by `Browse Url Generic Program'" :value browse-url-generic) (function-item :tag "Default Windows browser" :value browse-url-default-windows-browser) (function-item :tag "Default Mac OS X browser" :value browse-url-default-macosx-browser) (function-item :tag "GNOME invoking Mozilla" :value browse-url-gnome-moz) (function-item :tag "Default browser" :value browse-url-default-browser) (function :tag "Your own function")) :group 'browse-url)
-
-(defcustom browse-url-browser-display nil "*The X display for running the browser, if not same as Emacs'." :type '(choice string (const :tag "Default" nil)) :group 'browse-url)
-
-(defcustom browse-url-mozilla-program "mozilla" "*The name by which to invoke Mozilla." :type 'string :group 'browse-url)
-
-(defcustom browse-url-firefox-program "firefox" "*The name by which to invoke Firefox." :type 'string :group 'browse-url)
-
-(defcustom browse-url-galeon-program "galeon" "*The name by which to invoke Galeon." :type 'string :group 'browse-url)
-
-(defcustom browse-url-new-window-flag nil "*If non-nil, always open a new browser window with appropriate browsers.\nPassing an interactive argument to \\[browse-url], or specific browser\ncommands reverses the effect of this variable.  Requires Netscape version\n1.1N or later or XMosaic version 2.5 or later if using those browsers." :type 'boolean :group 'browse-url)
-
-(defvaralias 'browse-url-new-window-p 'browse-url-new-window-flag)
-
-(defcustom browse-url-save-file nil "*If non-nil, save the buffer before displaying its file.\nUsed by the `browse-url-of-file' command." :type 'boolean :group 'browse-url)
-
-(defcustom browse-url-generic-program nil "*The name of the browser program used by `browse-url-generic'." :type '(choice string (const :tag "None" nil)) :group 'browse-url)
-
-(autoload 'browse-url-of-file "browse-url" "\
-Ask a WWW browser to display FILE.
-Display the current buffer's file if FILE is nil or if called
-interactively.  Turn the filename into a URL with function
-`browse-url-file-url'.  Pass the URL to a browser using the
-`browse-url' function then run `browse-url-of-file-hook'." t nil)
-
-(autoload 'browse-url-of-buffer "browse-url" "\
-Ask a WWW browser to display BUFFER.
-Display the current buffer if BUFFER is nil.  Display only the
-currently visible part of BUFFER (from a temporary file) if buffer is
-narrowed." t nil)
-
-(autoload 'browse-url-of-dired-file "browse-url" "\
-In Dired, ask a WWW browser to display the file named on this line." t nil)
-
-(autoload 'browse-url-of-region "browse-url" "\
-Ask a WWW browser to display the current region." t nil)
-
-(autoload 'browse-url "browse-url" "\
-Ask a WWW browser to load URL.
-Prompts for a URL, defaulting to the URL at or before point.  Variable
-`browse-url-browser-function' says which browser to use." t nil)
-
-(autoload 'browse-url-at-point "browse-url" "\
-Ask a WWW browser to load the URL at or before point.
-Doesn't let you edit the URL like `browse-url'.  Variable
-`browse-url-browser-function' says which browser to use." t nil)
-
-(autoload 'browse-url-at-mouse "browse-url" "\
-Ask a WWW browser to load a URL clicked with the mouse.
-The URL is the one around or before the position of the mouse click
-but point is not changed.  Doesn't let you edit the URL like
-`browse-url'.  Variable `browse-url-browser-function' says which browser
-to use." t nil)
-
-(autoload 'browse-url-default-browser "browse-url" "\
-Find a suitable browser and ask it to load URL.
-Default to the URL around or before point.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new window, if possible, otherwise use
-a random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-The order attempted is emacs-w3m, gnome-moz-remote, Mozilla, Firefox,
-Galeon, Konqueror, Netscape, Opera, Mosaic, IXI Mosaic, Lynx in an
-xterm, MMM, and then W3." nil nil)
-
-(autoload 'browse-url-netscape "browse-url" "\
-Ask the Netscape WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-netscape-arguments' are also passed to Netscape.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Netscape window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-netscape-new-window-is-tab' is non-nil, then
-whenever a document would otherwise be loaded in a new window, it
-is loaded in a new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-(autoload 'browse-url-mozilla "browse-url" "\
-Ask the Mozilla WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-mozilla-arguments' are also passed to Mozilla.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Mozilla window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-mozilla-new-window-is-tab' is non-nil, then whenever a
-document would otherwise be loaded in a new window, it is loaded in a
-new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-On MS-Windows systems the optional `new-window' parameter is ignored.
-Mozilla for Windows does not support the \"-remote\" command line
-parameter. Therefore the `browse-url-new-window-flag', 
-`browse-url-new-window-flag' and `browse-url-mozilla-new-window-is-tab'
-are ignored as well. Mozilla on Windows will always open the
-requested URL in a new window." t nil)
-
-(autoload 'browse-url-firefox "browse-url" "\
-Ask the Firefox WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-firefox-arguments' are also passed to Firefox.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Firefox window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-firefox-new-window-is-tab' is non-nil, then whenever a
-document would otherwise be loaded in a new window, it is loaded in a
-new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-On MS-Windows systems the optional `new-window' parameter is ignored.
-Firefox for Windows does not support the \"-remote\" command line
-parameter. Therefore the `browse-url-new-window-flag', 
-`browse-url-new-window-flag' and `browse-url-firefox-new-window-is-tab'
-are ignored as well. Firefox on Windows will always open the
-requested URL in a new window." t nil)
-
-(autoload 'browse-url-galeon "browse-url" "\
-Ask the Galeon WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-galeon-arguments' are also passed to Galeon.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Galeon window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-galeon-new-window-is-tab' is non-nil, then whenever a
-document would otherwise be loaded in a new window, it is loaded in a
-new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-(autoload 'browse-url-gnome-moz "browse-url" "\
-Ask Mozilla/Netscape to load URL via the GNOME program `gnome-moz-remote'.
-Default to the URL around or before point.  The strings in variable
-`browse-url-gnome-moz-arguments' are also passed.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new browser window, otherwise use an
-existing one.  A non-nil interactive prefix argument reverses the
-effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-(autoload 'browse-url-mosaic "browse-url" "\
-Ask the XMosaic WWW browser to load URL.
-
-Default to the URL around or before point.  The strings in variable
-`browse-url-mosaic-arguments' are also passed to Mosaic and the
-program is invoked according to the variable
-`browse-url-mosaic-program'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Mosaic window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-(defvar browse-url-grail (concat (or (getenv "GRAILDIR") "~/.grail") "/user/rcgrail.py") "\
-Location of Grail remote control client script `rcgrail.py'.
-Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.")
-
-(autoload 'browse-url-grail "browse-url" "\
-Ask the Grail WWW browser to load URL.
-Default to the URL around or before point.  Runs the program in the
-variable `browse-url-grail'." t nil)
-
-(autoload 'browse-url-cci "browse-url" "\
-Ask the XMosaic WWW browser to load URL.
-Default to the URL around or before point.
-
-This function only works for XMosaic version 2.5 or later.  You must
-select `CCI' from XMosaic's File menu, set the CCI Port Address to the
-value of variable `browse-url-CCI-port', and enable `Accept requests'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new browser window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-(autoload 'browse-url-iximosaic "browse-url" "\
-Ask the IXIMosaic WWW browser to load URL.
-Default to the URL around or before point." t nil)
-
-(autoload 'browse-url-w3 "browse-url" "\
-Ask the w3 WWW browser to load URL.
-Default to the URL around or before point.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new window.  A non-nil interactive
-prefix argument reverses the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-(autoload 'browse-url-w3-gnudoit "browse-url" "\
-Ask another Emacs running gnuserv to load the URL using the W3 browser.
-The `browse-url-gnudoit-program' program is used with options given by
-`browse-url-gnudoit-args'.  Default to the URL around or before point." t nil)
-
-(autoload 'browse-url-w3m "browse-url" "\
-Ask the emacs-w3m WWW browser to load URL.
-Default to the URL around or before point.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new window.  A non-nil interactive
-prefix argument reverses the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-(autoload 'browse-url-w3m-gnudoit "browse-url" "\
-Ask the Emacs running gnuserv to load the URL using the emacs-w3m browser.
-The `browse-url-gnudoit-program' program is used with options given by
-`browse-url-gnudoit-args'.  Default to the URL around or before point." t nil)
-
-(autoload 'browse-url-lynx-xterm "browse-url" "\
-Ask the Lynx WWW browser to load URL.
-Default to the URL around or before point.  A new Lynx process is run
-in an Xterm window using the Xterm program named by `browse-url-xterm-program'
-with possible additional arguments `browse-url-xterm-args'." t nil)
-
-(autoload 'browse-url-lynx-emacs "browse-url" "\
-Ask the Lynx WWW browser to load URL.
-Default to the URL around or before point.  With a prefix argument, run
-a new Lynx process in a new buffer.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new lynx in a new term window,
-otherwise use any existing one.  A non-nil interactive prefix argument
-reverses the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-(autoload 'browse-url-mmm "browse-url" "\
-Ask the MMM WWW browser to load URL.
-Default to the URL around or before point." t nil)
-
-(autoload 'browse-url-mail "browse-url" "\
-Open a new mail message buffer within Emacs.
-Default to using the mailto: URL around or before point as the
-recipient's address.  Supplying a non-nil interactive prefix argument
-will cause the mail to be composed in another window rather than the
-current one.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil use `compose-mail-other-window', otherwise `compose-mail'.  A
-non-nil interactive prefix argument reverses the effect of
-`browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-(autoload 'browse-url-generic "browse-url" "\
-Ask the WWW browser defined by `browse-url-generic-program' to load URL.
-Default to the URL around or before point.  A fresh copy of the
-browser is started up in a new process with possible additional arguments
-`browse-url-generic-args'.  This is appropriate for browsers which
-don't offer a form of remote control." t nil)
-
-(autoload 'browse-url-kde "browse-url" "\
-Ask the KDE WWW browser to load URL.
-Default to the URL around or before point." t nil)
-
-(autoload 'browse-url-opera "browse-url" "\
-Ask the Opera WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-opera-arguments' are also passed to Opera.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Opera window, otherwise use an
-existing one.  A non-nil interactive prefix argument reverses the
-effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'." t nil)
-
-;;;***
-
-;;;### (autoloads (highlight-headers-follow-url highlight-headers) "highlight-headers" "mail-lib/highlight-headers.el")
-
-(autoload 'highlight-headers "highlight-headers" "\
-Highlight message headers between start and end.
-Faces used:
-  message-headers			the part before the colon
-  message-header-contents		the part after the colon
-  message-highlighted-header-contents	contents of \"special\" headers
-  message-cited-text			quoted text from other messages
-  message-url				URLs (WWW uniform resource locators)
-
-Variables used:
-
-  highlight-headers-regexp			what makes a \"special\" header
-  highlight-headers-citation-regexp		matches lines of quoted text
-  highlight-headers-citation-header-regexp	matches headers for quoted text
-
-If HACK-SIG is true,then we search backward from END for something that
-looks like the beginning of a signature block, and don't consider that a
-part of the message (this is because signatures are often incorrectly
-interpreted as cited text.)" nil nil)
-
-(define-obsolete-function-alias 'highlight-headers-follow-url-netscape 'browse-url-netscape)
-
-(define-obsolete-function-alias 'highlight-headers-follow-url-kfm 'browse-url-kde)
-
-(define-obsolete-function-alias 'highlight-headers-follow-url-mosaic 'browse-url-mosaic)
-
-(autoload 'highlight-headers-follow-url "highlight-headers" nil t nil)
-
-;;;***
-
-;;;### (autoloads (define-mail-alias build-mail-aliases mail-aliases-setup mail-abbrev-mailrc-file) "mail-abbrevs" "mail-lib/mail-abbrevs.el")
-
-(defcustom mail-abbrev-mailrc-file nil "Name of file with mail aliases.   If nil, ~/.mailrc is used." :type '(choice (const :tag "Default" nil) file) :group 'mail-abbrevs)
-
-(autoload 'mail-abbrev-mailrc-file "mail-abbrevs" nil nil nil)
-
-(defvar mail-aliases nil "\
-Word-abbrev table of mail address aliases.
-If this is nil, it means the aliases have not yet been initialized and
-should be read from the .mailrc file.  (This is distinct from there being
-no aliases, which is represented by this being a table with no entries.)")
-
-(autoload 'mail-aliases-setup "mail-abbrevs" nil nil nil)
-
-(autoload 'build-mail-aliases "mail-abbrevs" "\
-Read mail aliases from .mailrc and set mail-aliases." nil nil)
-
-(autoload 'define-mail-alias "mail-abbrevs" "\
-Define NAME as a mail-alias that translates to DEFINITION.
-If DEFINITION contains multiple addresses, separate them with commas." t nil)
-
-;;;***
-
-;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" "mail-lib/mail-extr.el")
-
-(autoload 'mail-extract-address-components "mail-extr" "\
-Given an RFC-822 address ADDRESS, extract full name and canonical address.
-Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
-If no name can be extracted, FULL-NAME will be nil.  Also see
-`mail-extr-ignore-single-names'.
-
-If the optional argument ALL is non-nil, then ADDRESS can contain zero
-or more recipients, separated by commas, and we return a list of
-the form ((FULL-NAME CANONICAL-ADDRESS) ...) with one element for
-each recipient.  If ALL is nil, then if ADDRESS contains more than
-one recipients, all but the first is ignored.
-
-ADDRESS may be a string or a buffer.  If it is a buffer, the visible
-\(narrowed) portion of the buffer will be interpreted as the address.
-\(This feature exists so that the clever caller might be able to avoid
-consing a string.)" nil nil)
-
-(autoload 'what-domain "mail-extr" "\
-Convert mail domain DOMAIN to the country it corresponds to." t nil)
-
-;;;***
-
-;;;### (autoloads (mail-fetch-field mail-file-babyl-p) "mail-utils" "mail-lib/mail-utils.el")
-
-(defcustom mail-use-rfc822 nil "*If non-nil, use a full, hairy RFC822 parser on mail addresses.\nOtherwise, (the default) use a smaller, somewhat faster, and\noften correct parser." :type 'boolean :group 'mail)
-
-(autoload 'mail-file-babyl-p "mail-utils" nil nil nil)
-
-(autoload 'mail-fetch-field "mail-utils" "\
-Return the value of the header field whose type is FIELD-NAME.
-The buffer is expected to be narrowed to just the header of the message.
-If second arg LAST is non-nil, use the last field of type FIELD-NAME.
-If third arg ALL is non-nil, concatenate all such fields with commas between.
-If 4th arg LIST is non-nil, return a list of all such fields." nil nil)
-
-;;;***
-
-;;;### (autoloads (pop3-movemail pop3-nnmail-movemail) "pop3" "mail-lib/pop3.el")
-
-(autoload 'pop3-nnmail-movemail "pop3" "\
-Function to move mail from INBOX on a pop3 server to file CRASHBOX." nil nil)
-
-(autoload 'pop3-movemail "pop3" "\
-Transfer contents of a maildrop to the specified CRASHBOX." nil nil)
-
-;;;***
-
-;;;### (autoloads (reporter-submit-bug-report) "reporter" "mail-lib/reporter.el")
-
-(autoload 'reporter-submit-bug-report "reporter" "\
-Begin submitting a bug report via email.
-
-ADDRESS is the email address for the package's maintainer.  PKGNAME is
-the name of the package (if you want to include version numbers,
-you must put them into PKGNAME before calling this function).
-Optional PRE-HOOKS and POST-HOOKS are passed to `reporter-dump-state'.
-Optional SALUTATION is inserted at the top of the mail buffer,
-and point is left after the salutation.
-
-VARLIST is the list of variables to dump (see `reporter-dump-state'
-for details).  The optional argument PRE-HOOKS and POST-HOOKS are
-passed to `reporter-dump-state'.  Optional argument SALUTATION is text
-to be inserted at the top of the mail buffer; in that case, point is
-left after that text.
-
-This function prompts for a summary if `reporter-prompt-for-summary-p'
-is non-nil.
-
-This function does not send a message; it uses the given information
-to initialize a message, which the user can then edit and finally send
-\(or decline to send).  The variable `mail-user-agent' controls which
-mail-sending package is used for editing and sending the message." nil nil)
-
-;;;***
-
-;;;### (autoloads nil "rmail-mini" "mail-lib/rmail-mini.el")
-
-(defcustom rmail-dont-reply-to-names nil "*A regexp specifying names to prune of reply to messages.\nA value of nil means exclude your own name only." :type '(choice regexp (const :tag "Your Name" nil)) :group 'rmail-reply)
-
-(defvar rmail-default-dont-reply-to-names "info-" "\
-A regular expression specifying part of the value of the default value of
-the variable `rmail-dont-reply-to-names', for when the user does not set
-`rmail-dont-reply-to-names' explicitly.  (The other part of the default
-value is the user's name.)
-It is useful to set this variable in the site customization file.")
-
-;;;***
-
-;;;### (autoloads (rmail-file-p) "rmailout" "mail-lib/rmailout.el")
-
-(autoload 'rmail-file-p "rmailout" nil nil nil)
-
-;;;***
-
-;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode user-mail-address) "sendmail" "mail-lib/sendmail.el")
-
-(defcustom mail-from-style 'angles "*Specifies how \"From:\" fields look.\n\nIf `nil', they contain just the return address like:\n	king@grassland.com\nIf `parens', they look like:\n	king@grassland.com (Elvis Parsley)\nIf `angles', they look like:\n	Elvis Parsley \nIf `system-default', allows the mailer to insert its default From field\nderived from the envelope-from address.\n\nThe email address passed to the mailer to specify the envelope-from\naddress is controlled by `mail-specify-envelope-from'." :type '(choice (const nil) (const parens) (const angles) (const system-default)) :group 'sendmail)
-
-(defcustom mail-specify-envelope-from nil "*If non-nil, specify the envelope-from address when sending mail.\nThe value used to specify it is whatever is found in\n`mail-envelope-from', with `user-mail-address' as fallback.\n\nOn most systems, specifying the envelope-from address\nis a privileged operation." :type 'boolean :group 'sendmail)
-
-(defcustom mail-self-blind nil "*Non-nil means insert BCC to self in messages to be sent.\nThis is done when the message is initialized,\nso you can remove or alter the BCC field to override the default." :type 'boolean :group 'sendmail)
-
-(defcustom mail-interactive nil "*Non-nil means when sending a message wait for and display errors.\nnil means let mailer mail back a message to report errors." :type 'boolean :group 'sendmail)
-
-(defvar rmail-ignored-headers (purecopy (concat "^\\(" (mapconcat 'identity '("Sender:" "References:" "Return-Path:" "Received:" "[^: 	\n]*Message-ID:" "Errors-To:" "Path:" "Expires:" "Xref:" "Lines:" "Approved:" "Distribution:" "Content-Length:" "Mime-Version:" "Content-Type:" "Content-Transfer-Encoding:" "X400-Received:" "X400-Originator:" "X400-Mts-Identifier:" "X400-Content-Type:" "Content-Identifier:" "Status:" "Summary-Line:" "X-Attribution:" "Via:" "Sent-Via:" "Mail-From:" "Origin:" "Comments:" "Originator:" "NF-ID:" "NF-From:" "Posting-Version:" "Posted:" "Posted-Date:" "Date-Received:" "Relay-Version:" "Article-I\\.D\\.:" "NNTP-Version:" "NNTP-Posting-Host:" "X-Mailer:" "X-Newsreader:" "News-Software:" "X-Received:" "X-References:" "X-Envelope-To:" "X-VMS-" "Remailed-" "X-Plantation:" "X-Windows:" "X-Pgp-") "\\|") "\\)")) "\
-*Gubbish header fields one would rather not see.")
-
-(defcustom mail-yank-ignored-headers (purecopy (concat rmail-ignored-headers "\\|" "^\\(" (mapconcat 'identity '("Resent-To:" "Resent-By:" "Resent-CC:" "To:" "Subject:" "In-Reply-To:") "\\|") "\\)")) "*Delete these headers from old message when it's inserted in a reply." :type 'regexp :group 'sendmail)
-
-(defcustom send-mail-function (if (or (eq system-type 'windows-nt) (eq system-type 'cygwin32)) 'smtpmail-send-it 'sendmail-send-it) "Function to call to send the current buffer as mail.\nThe headers should be delimited by a line which is\nnot a valid RFC822 header or continuation line,\nthat match the variable `mail-header-separator'.\nThis is used by the default mail-sending commands.  See also\n`message-send-mail-function' for use with the Message package." :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package") (function-item smtpmail-send-it :tag "Use SMTPmail package") (function-item feedmail-send-it :tag "Use Feedmail package") function) :group 'sendmail)
-
-(defcustom mail-header-separator "--text follows this line--" "*Line used to separate headers from text in messages being composed." :type 'string :group 'sendmail)
-
-(defcustom mail-archive-file-name nil "*Name of file to write all outgoing messages in, or nil for none.\nThis can be an inbox file or an Rmail file." :type '(choice file (const nil)) :group 'sendmail)
-
-(defcustom mail-default-reply-to nil "*Address to insert as default Reply-to field of outgoing messages.\nIf nil, it will be initialized from the REPLYTO environment variable\nwhen you first send mail." :type '(choice (const nil) string) :group 'sendmail)
-
-(defcustom mail-alias-file nil "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'.\nThis file defines aliases to be expanded by the mailer; this is a different\nfeature from that of defining aliases in `.mailrc' to be expanded in Emacs.\nThis variable has no effect unless your system uses sendmail as its mailer." :type '(choice (const nil) file) :group 'sendmail)
-
-(defcustom mail-yank-prefix "> " "*Prefix insert on lines of yanked message being replied to.\nnil means use indentation." :type '(choice (const nil) string) :group 'sendmail)
-
-(defcustom mail-signature nil "*Text inserted at end of mail buffer when a message is initialized.\nIf t, it means to insert the contents of the file `mail-signature-file'.\nIf a string, that string is inserted.\n (To make a proper signature, the string should begin with \\n\\n-- \\n,\n  which is the standard way to delimit a signature in a message.)\nOtherwise, it should be an expression; it is evaluated\nand should insert whatever you want to insert." :type '(choice (const :tag "None" nil) (const :tag "Use `.signature' file" t) (string :tag "String to insert") (sexp :tag "Expression to evaluate")) :group 'sendmail)
-
-(defcustom mail-default-directory "~/" "*Directory for mail buffers.\nValue of `default-directory' for mail buffers.\nThis directory is used for auto-save files of mail buffers." :type '(directory :tag "Directory") :group 'sendmail :version "21.4")
-
-(autoload 'user-mail-address "sendmail" "\
-Query the user for his mail address, unless it is already known." t nil)
-
-(autoload 'mail-mode "sendmail" "Major mode for editing mail to be sent.\nLike Text Mode but with these additional commands:\n\\[mail-send]  mail-send (send the message)    \\[mail-send-and-exit]  mail-send-and-exit\nHere are commands that move to a header field (and create it if there isn't):\n	 \\[mail-to]  move to To:	\\[mail-subject]  move to Subject:\n	 \\[mail-cc]  move to CC:	\\[mail-bcc]  move to BCC:\n	 \\[mail-fcc]  move to FCC:      \\[mail-reply-to] move to Reply-To:\n\\[mail-text]  mail-text (move to beginning of message text).\n\\[mail-signature]  mail-signature (insert `mail-signature-file' file).\n\\[mail-yank-original]  mail-yank-original (insert current message, in Rmail).\n\\[mail-fill-yanked-message]  mail-fill-yanked-message (fill what was yanked).\n\\[mail-sent-via]  mail-sent-via (add a Sent-via field for each To or CC).\nTurning on Mail mode runs the normal hooks `text-mode-hook' and\n`mail-mode-hook' (in that order)." t nil)
-(add-hook 'same-window-buffer-names "*mail*")
-
-(autoload 'mail "sendmail" "\
-Edit a message to be sent.  Prefix arg means resume editing (don't erase).
-When this function returns, the buffer `*mail*' is selected.
-The value is t if the message was newly initialized; otherwise, nil.
-
-Optionally, the signature file `mail-signature-file' can be inserted at the
-end; see the variable `mail-signature'.
-
-\\
-While editing message, type \\[mail-send-and-exit] to send the message and exit.
-
-Various special commands starting with C-c are available in sendmail mode
-to move to message header fields:
-\\{mail-mode-map}
-
-If `mail-self-blind' is non-nil, a BCC to yourself is inserted
-when the message is initialized.
-
-If `mail-default-reply-to' is non-nil, it should be an address (a string);
-a Reply-to: field with that address is inserted.
-
-If `mail-archive-file-name' is non-nil, an FCC field with that file name
-is inserted.
-
-The normal hook `mail-setup-hook' is run after the message is
-initialized.  It can add more default fields to the message.
-
-When calling from a program, the first argument if non-nil says
-not to erase the existing contents of the `*mail*' buffer.
-
-The second through fifth arguments,
- TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
- the initial contents of those header fields.
- These arguments should not have final newlines.
-The sixth argument REPLYBUFFER is a buffer which contains an
- original message being replied to, or else an action
- of the form (FUNCTION . ARGS) which says how to insert the original.
- Or it can be nil, if not replying to anything.
-The seventh argument ACTIONS is a list of actions to take
- if/when the message is sent.  Each action looks like (FUNCTION . ARGS);
- when the message is sent, we apply FUNCTION to ARGS.
- This is how Rmail arranges to mark messages `answered'." t nil)
-
-(autoload 'mail-other-window "sendmail" "\
-Like `mail' command, but display mail buffer in another window." t nil)
-
-(autoload 'mail-other-frame "sendmail" "\
-Like `mail' command, but display mail buffer in another frame." t nil)
-
-;;;***
-
-;;;### (autoloads (smtpmail-send-queued-mail smtpmail-send-it) "smtpmail" "mail-lib/smtpmail.el")
-
-(autoload 'smtpmail-send-it "smtpmail" nil nil nil)
-
-(autoload 'smtpmail-send-queued-mail "smtpmail" "\
-Send mail that was queued as a result of setting `smtpmail-queue-mail'." t nil)
-
-;;;***
-
-(provide 'mail-lib-autoloads)
diff --git a/xemacs-packages/lisp/mail-lib/base64.el b/xemacs-packages/lisp/mail-lib/base64.el
deleted file mode 100644
index 572a5d37..00000000
--- a/xemacs-packages/lisp/mail-lib/base64.el
+++ /dev/null
@@ -1,278 +0,0 @@
-;;; base64.el,v --- Base64 encoding functions
-;; Author: Kyle E. Jones
-;; Created: 1997/03/12 14:37:09
-;; Version: 1.6
-;; Keywords: extensions
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Copyright (C) 1997 Kyle E. Jones
-;;;
-;;; This file is not part of GNU Emacs, but the same permissions apply.
-;;;
-;;; GNU Emacs is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; GNU Emacs is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;;; Boston, MA 02111-1307, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(eval-when-compile (require 'cl))
-
-;; For non-MULE
-(if (not (fboundp 'char-int))
-    (defalias 'char-int 'identity))
-
-(defvar base64-alphabet
-  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
-
-(defvar base64-decoder-program nil
-  "*Non-nil value should be a string that names a MIME base64 decoder.
-The program should expect to read base64 data on its standard
-input and write the converted data to its standard output.")
-
-(defvar base64-decoder-switches nil
-  "*List of command line flags passed to the command named by
-base64-decoder-program.")
-
-(defvar base64-encoder-program nil
-  "*Non-nil value should be a string that names a MIME base64 encoder.
-The program should expect arbitrary data on its standard
-input and write base64 data to its standard output.")
-
-(defvar base64-encoder-switches nil
-  "*List of command line flags passed to the command named by
-base64-encoder-program.")
-
-(defconst base64-alphabet-decoding-alist
-  '(
-    ( ?A . 00) ( ?B . 01) ( ?C . 02) ( ?D . 03) ( ?E . 04) ( ?F . 05)
-    ( ?G . 06) ( ?H . 07) ( ?I . 08) ( ?J . 09) ( ?K . 10) ( ?L . 11)
-    ( ?M . 12) ( ?N . 13) ( ?O . 14) ( ?P . 15) ( ?Q . 16) ( ?R . 17)
-    ( ?S . 18) ( ?T . 19) ( ?U . 20) ( ?V . 21) ( ?W . 22) ( ?X . 23)
-    ( ?Y . 24) ( ?Z . 25) ( ?a . 26) ( ?b . 27) ( ?c . 28) ( ?d . 29)
-    ( ?e . 30) ( ?f . 31) ( ?g . 32) ( ?h . 33) ( ?i . 34) ( ?j . 35)
-    ( ?k . 36) ( ?l . 37) ( ?m . 38) ( ?n . 39) ( ?o . 40) ( ?p . 41)
-    ( ?q . 42) ( ?r . 43) ( ?s . 44) ( ?t . 45) ( ?u . 46) ( ?v . 47)
-    ( ?w . 48) ( ?x . 49) ( ?y . 50) ( ?z . 51) ( ?0 . 52) ( ?1 . 53)
-    ( ?2 . 54) ( ?3 . 55) ( ?4 . 56) ( ?5 . 57) ( ?6 . 58) ( ?7 . 59)
-    ( ?8 . 60) ( ?9 . 61) ( ?+ . 62) ( ?/ . 63)
-    ))
-
-(defvar base64-alphabet-decoding-vector
-  (let ((v (make-vector 123 nil))
-	(p base64-alphabet-decoding-alist))
-    (while p
-      (aset v (car (car p)) (cdr (car p)))
-      (setq p (cdr p)))
-    v))
-
-(defvar base64-binary-coding-system 'binary)
-
-(defun base64-run-command-on-region (start end output-buffer command
-					   &rest arg-list)
-  (let ((tempfile nil) status errstring default-process-coding-system 
-	(coding-system-for-write base64-binary-coding-system)
-	(coding-system-for-read base64-binary-coding-system))
-    (unwind-protect
-	(progn
-	  (setq tempfile (make-temp-name "base64"))
-	  (setq status
-		(apply 'call-process-region
-		       start end command nil
-		       (list output-buffer tempfile)
-		       nil arg-list))
-	  (cond ((equal status 0) t)
-		((zerop (save-excursion
-			  (set-buffer (find-file-noselect tempfile))
-			  (buffer-size)))
-		 t)
-		(t (save-excursion
-		     (set-buffer (find-file-noselect tempfile))
-		     (setq errstring (buffer-string))
-		     (kill-buffer nil)
-		     (cons status errstring)))))
-      (ignore-errors
-	(delete-file tempfile)))))
-
-(if (featurep 'xemacs)
-    (defalias 'base64-insert-char 'insert-char)
-  (defun base64-insert-char (char &optional count ignored buffer)
-    (if (or (null buffer) (eq buffer (current-buffer)))
-	(insert-char char count)
-      (with-current-buffer buffer
-	(insert-char char count))))
-  (setq base64-binary-coding-system 'no-conversion))
-
-(defun base64-decode-region (start end)
-  (interactive "r")
-  ;;(message "Decoding base64...")
-  (let ((work-buffer nil)
-	(done nil)
-	(counter 0)
-	(bits 0)
-	(lim 0) inputpos
-	(non-data-chars (concat "^=" base64-alphabet)))
-    (unwind-protect
-	(save-excursion
-	  (setq work-buffer (generate-new-buffer " *base64-work*"))
-	  (buffer-disable-undo work-buffer)
-	  (if base64-decoder-program
-	      (let* ((binary-process-output t) ; any text already has CRLFs
-		     (status (apply 'base64-run-command-on-region
-				    start end work-buffer
-				    base64-decoder-program
-				    base64-decoder-switches)))
-		(if (not (eq status t))
-		    (error "%s" (cdr status))))
-	    (goto-char start)
-	    (skip-chars-forward non-data-chars end)
-	    (while (not done)
-	      (setq inputpos (point))
-	      (cond
-	       ((> (skip-chars-forward base64-alphabet end) 0)
-		(setq lim (point))
-		(while (< inputpos lim)
-		  (setq bits (+ bits
-				(aref base64-alphabet-decoding-vector
-				      (char-int (char-after inputpos)))))
-		  (setq counter (1+ counter)
-			inputpos (1+ inputpos))
-		  (cond ((= counter 4)
-			 (base64-insert-char (lsh bits -16) 1 nil work-buffer)
-			 (base64-insert-char (logand (lsh bits -8) 255) 1 nil
-					     work-buffer)
-			 (base64-insert-char (logand bits 255) 1 nil
-					     work-buffer)
-			 (setq bits 0 counter 0))
-			(t (setq bits (lsh bits 6)))))))
-	      (cond
-	       ((or (= (point) end)
-		    (eq (char-after (point)) ?=))
-		(if (and (= (point) end) (> counter 1))
-		    (message 
-		     "at least %d bits missing at end of base64 encoding"
-		     (* (- 4 counter) 6)))
-		(setq done t)
-		(cond ((= counter 1)
-		       (error "at least 2 bits missing at end of base64 encoding"))
-		      ((= counter 2)
-		       (base64-insert-char (lsh bits -10) 1 nil work-buffer))
-		      ((= counter 3)
-		       (base64-insert-char (lsh bits -16) 1 nil work-buffer)
-		       (base64-insert-char (logand (lsh bits -8) 255)
-					   1 nil work-buffer))
-		      ((= counter 0) t)))
-	       (t (skip-chars-forward non-data-chars end)))))
-	  (or (markerp end) (setq end (set-marker (make-marker) end)))
-	  (goto-char start)
-	  (insert-buffer-substring work-buffer)
-	  (delete-region (point) end))
-      (and work-buffer (kill-buffer work-buffer))))
-  ;;(message "Decoding base64... done")
-  )
-
-(defun base64-encode-region (start end &optional no-line-break)
-  (interactive "r")
-  (message "Encoding base64...")
-  (let ((work-buffer nil)
-	(counter 0)
-	(cols 0)
-	(bits 0)
-	(alphabet base64-alphabet)
-	inputpos)
-    (unwind-protect
-	(save-excursion
-	  (setq work-buffer (generate-new-buffer " *base64-work*"))
-	  (buffer-disable-undo work-buffer)
-	  (if base64-encoder-program
-	      (let ((status (apply 'base64-run-command-on-region
-				   start end work-buffer
-				   base64-encoder-program
-				   base64-encoder-switches)))
-		(if (not (eq status t))
-		    (error "%s" (cdr status))))
-	    (setq inputpos start)
-	    (while (< inputpos end)
-	      (setq bits (+ bits (char-int (char-after inputpos))))
-	      (setq counter (1+ counter))
-	      (cond ((= counter 3)
-		     (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil
-					 work-buffer)
-		     (base64-insert-char
-		      (aref alphabet (logand (lsh bits -12) 63))
-		      1 nil work-buffer)
-		     (base64-insert-char
-		      (aref alphabet (logand (lsh bits -6) 63))
-		      1 nil work-buffer)
-		     (base64-insert-char
-		      (aref alphabet (logand bits 63))
-		      1 nil work-buffer)
-		     (setq cols (+ cols 4))
-		     (cond ((and (= cols 72)
-				 (not no-line-break))
-			    (base64-insert-char ?\n 1 nil work-buffer)
-			    (setq cols 0)))
-		     (setq bits 0 counter 0))
-		    (t (setq bits (lsh bits 8))))
-	      (setq inputpos (1+ inputpos)))
-	    ;; write out any remaining bits with appropriate padding
-	    (if (= counter 0)
-		nil
-	      (setq bits (lsh bits (- 16 (* 8 counter))))
-	      (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil
-				  work-buffer)
-	      (base64-insert-char (aref alphabet (logand (lsh bits -12) 63))
-				  1 nil work-buffer)
-	      (if (= counter 1)
-		  (base64-insert-char ?= 2 nil work-buffer)
-		(base64-insert-char (aref alphabet (logand (lsh bits -6) 63))
-				    1 nil work-buffer)
-		(base64-insert-char ?= 1 nil work-buffer)))
-	    (if (and (> cols 0)
-		     (not no-line-break))
-	    	(base64-insert-char ?\n 1 nil work-buffer)))
-	  (or (markerp end) (setq end (set-marker (make-marker) end)))
-	  (goto-char start)
-	  (insert-buffer-substring work-buffer)
-	  (delete-region (point) end))
-      (and work-buffer (kill-buffer work-buffer))))
-  (message "Encoding base64... done"))
-
-(defun base64-encode (string &optional no-line-break)
-  (save-excursion
-    (set-buffer (get-buffer-create " *base64-encode*"))
-    (erase-buffer)
-    (insert string)
-    (base64-encode-region (point-min) (point-max) no-line-break)
-    (skip-chars-backward " \t\r\n")
-    (delete-region (point-max) (point))
-    (prog1
-	(buffer-string)
-      (kill-buffer (current-buffer)))))
-
-(defun base64-decode (string)
-  (save-excursion
-    (set-buffer (get-buffer-create " *base64-decode*"))
-    (erase-buffer)
-    (insert string)
-    (base64-decode-region (point-min) (point-max))
-    (goto-char (point-max))
-    (skip-chars-backward " \t\r\n")
-    (delete-region (point-max) (point))
-    (prog1
-	(buffer-string)
-      (kill-buffer (current-buffer)))))
-
-(defalias 'base64-decode-string 'base64-decode)
-(defalias 'base64-encode-string 'base64-encode)
-
-(provide 'base64)
diff --git a/xemacs-packages/lisp/mail-lib/browse-url-xemacs.el b/xemacs-packages/lisp/mail-lib/browse-url-xemacs.el
deleted file mode 100644
index 709dce3e..00000000
--- a/xemacs-packages/lisp/mail-lib/browse-url-xemacs.el
+++ /dev/null
@@ -1,170 +0,0 @@
-;;; browse-url-xemacs.el --- browse-url stuff for XEmacs
-
-;; Copyright (C) 1991-1995, 1997-1998 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-;; Copyright (C) 1995 Sun Microsystems.
-;; Copyright (C) 1995, 1996, 2000 Ben Wing.
-;; Copyright (C) 1997 MORIOKA Tomohiko.
-
-;; Maintainer: XEmacs Development Team
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; 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 code comes from menubar-items.el in XEmacs core.
-
-;;; Code:
-
-(defvar browse-url-menu)
-
-;;;###autoload
-(progn
-  (defun browse-url-xemacs-init-menu ()
-    (if (featurep 'menubar) 
-	(add-submenu '("Options" "Internet") browse-url-menu)
-      )))
-
-(cond ((featurep 'xemacs)
-       (defvar browse-url-menu
-	 '("%_Open URLs With"
-	   ["%_Emacs-W3"
-	    (customize-set-variable 'browse-url-browser-function 'browse-url-w3)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-w3)
-	    :active (and (fboundp 'browse-url-w3)
-			 (fboundp 'w3-fetch))]
-	   ["Emacs-%_W3 (gnudoit)"
-	    (customize-set-variable 'browse-url-browser-function 'browse-url-w3-gnudoit)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-w3-gnudoit)
-	    :active (fboundp 'browse-url-w3-gnudoit)]
-	   ["%_Netscape"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-netscape)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-netscape)
-	    :active (fboundp 'browse-url-netscape)]
-	   ["%_Mosaic"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-mosaic)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-mosaic)
-	    :active (fboundp 'browse-url-mosaic)]
-	   ["Mosaic (%_CCI)"
-	    (customize-set-variable 'browse-url-browser-function 'browse-url-cci)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-cci)
-	    :active (fboundp 'browse-url-cci)]
-	   ["%_IXI Mosaic"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-iximosaic)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-iximosaic)
-	    :active (fboundp 'browse-url-iximosaic)]
-	   ["%_Lynx (xterm)"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-lynx-xterm)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-lynx-xterm)
-	    :active (fboundp 'browse-url-lynx-xterm)]
-	   ["L%_ynx (xemacs)"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-lynx-emacs)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-lynx-emacs)
-	    :active (fboundp 'browse-url-lynx-emacs)]
-	   ["%_Grail"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-grail)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-grail)
-	    :active (fboundp 'browse-url-grail)]
-	   ["%_KDE"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-kde)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-kde)
-	    :active (fboundp 'browse-url-kde)]
-	   ["Mo%_zilla"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-mozilla)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-mozilla)
-	    :active (and (fboundp 'browse-url-mozilla)
-			 (executable-find browse-url-mozilla-program))]
-	   ["%_Firefox"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-firefox)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-firefox)
-	    :active (and (fboundp 'browse-url-firefox)
-			 (executable-find browse-url-firefox-program))]
-	   ["G%_aleon"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-galeon)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-galeon)
-	    :active (fboundp 'browse-url-galeon)]
-	   ["%_Opera"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-opera)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-opera)
-	    :active (fboundp 'browse-url-opera)]
-	   ["%_MMM"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-mmm)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-mmm)
-	    :active (fboundp 'browse-url-mmm)]
-	   ["MS-Windows Default %_Browser"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-default-windows-browser)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-default-windows-browser)
-	    :active (and (fboundp 'mswindows-shell-execute)
-			 (fboundp 'browse-url-default-windows-browser))]
-	   ["G%_eneric Browser"
-	    (customize-set-variable 'browse-url-browser-function
-				    'browse-url-generic)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-generic)
-	    :active (and (boundp 'browse-url-generic-program)
-			 browse-url-generic-program
-			 (fboundp 'browse-url-generic))]
-	   ["Emacs-W%_3M"
-	    (customize-set-variable 'browse-url-browser-function 'browse-url-w3m)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-w3m)
-	    :active (and (fboundp 'browse-url-w3m)
-			 (fboundp 'w3m-goto-url-new-session))]
-	   ["Emacs-W3M (gn%_udoit)"
-	    (customize-set-variable 'browse-url-browser-function 'browse-url-w3m-gnudoit)
-	    :style radio
-	    :selected (eq browse-url-browser-function 'browse-url-w3m-gnudoit)
-	    :active (fboundp 'browse-url-w3m-gnudoit)]
-	   ))
-
-	 
-       (browse-url-xemacs-init-menu)
-       ))
-
-(provide 'browse-url-xemacs)
-
-;;; browse-url-xemacs.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/browse-url.el b/xemacs-packages/lisp/mail-lib/browse-url.el
deleted file mode 100644
index 32b09c3c..00000000
--- a/xemacs-packages/lisp/mail-lib/browse-url.el
+++ /dev/null
@@ -1,1604 +0,0 @@
-;;; browse-url.el --- pass a URL to a WWW browser
-
-;; Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001, 2002, 2003, 2005
-;;   Free Software Foundation, Inc.
-
-;; Author: Denis Howe 
-;; Maintainer: XEmacs Development Team
-;; Created: 03 Apr 1995
-;; Keywords: hypertext, hypermedia, mouse
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with:  Version 1.32 in CVS
-
-;;; Commentary:
-
-;; This package provides functions which read a URL (Uniform Resource
-;; Locator) from the minibuffer, defaulting to the URL around point,
-;; and ask a World-Wide Web browser to load it.  It can also load the
-;; URL associated with the current buffer.  Different browsers use
-;; different methods of remote control so there is one function for
-;; each supported browser.  If the chosen browser is not running, it
-;; is started.  Currently there is support for the following browsers,
-;; some of them probably now obsolete:
-
-;; Function                           Browser     Earliest version
-;; browse-url-mozilla                 Mozilla     Don't know
-;; browse-url-firefox                 Firefox     Don't know (1st tried with 1.0.1)
-;; browse-url-galeon                  Galeon      Don't know
-;; browse-url-epiphany                Epiphany    Don't know
-;; browse-url-netscape                Netscape    1.1b1
-;; browse-url-mosaic                  XMosaic/mMosaic <= 2.4
-;; browse-url-cci                     XMosaic     2.5
-;; browse-url-w3                      w3          0
-;; browse-url-w3-gnudoit              w3 remotely
-;; browse-url-w3m                     w3m         0.2.1, probably
-;; browse-url-w3m-gnudoit             w3m remotely 0.2.1, probably
-;; browse-url-iximosaic               IXI Mosaic  ?
-;; browse-url-lynx-*	              Lynx	     0
-;; browse-url-grail                   Grail       0.3b1
-;; browse-url-mmm                     MMM         ?
-;; browse-url-generic                 arbitrary
-;; browse-url-default-windows-browser MS-Windows browser
-;; browse-url-default-macosx-browser  Mac OS X browser
-;; browse-url-gnome-moz               GNOME interface to Mozilla
-;; browse-url-kde                     KDE konqueror (kfm)
-;; browse-url-opera                   Opera
-
-;; [A version of the Netscape browser is now free software
-;; , albeit not GPLed, so it is
-;; reasonable to have that as the default.]
-
-;; Note that versions of Netscape before 1.1b1 did not have remote
-;; control.  .
-
-;; Browsers can cache Web pages so it may be necessary to tell them to
-;; reload the current page if it has changed (e.g. if you have edited
-;; it).  There is currently no perfect automatic solution to this.
-
-;; Netscape allows you to specify the id of the window you want to
-;; control but which window DO you want to control and how do you
-;; discover its id?
-
-;; If using XMosaic before version 2.5, check the definition of
-;; browse-url-usr1-signal below.
-;; 
-
-;; XMosaic version 2.5 introduced Common Client Interface allowing you
-;; to control mosaic through Unix sockets.
-;; 
-
-;; William M. Perry's excellent "w3" WWW browser for
-;; Emacs 
-;; has a function w3-follow-url-at-point, but that
-;; doesn't let you edit the URL like browse-url.
-;; The `gnuserv' package that can be used to control it in another
-;; Emacs process is available from
-;; .
-
-;; Grail is the freely available WWW browser implemented in Python, a
-;; cool object-oriented freely available interpreted language.  Grail
-;; 0.3b1 was the first version to have remote control as distributed.
-;; For more information on Grail see
-;;  and for more information on
-;; Python see .  Grail support in
-;; browse-url.el written by Barry Warsaw .
-
-;; MMM is a semi-free WWW browser implemented in Objective Caml, an
-;; interesting impure functional programming language.  See
-;; .
-
-;; Lynx is now distributed by the FSF.  See also
-;; .
-
-;; Free graphical browsers that could be used by `browse-url-generic'
-;; include Chimera  and
-;; , Arena
-;;  and Amaya
-;; .  mMosaic
-;; ,
-;;  (with development
-;; support for Java applets and multicast) can be used like Mosaic by
-;; setting `browse-url-mosaic-program' appropriately.
-
-;; I [Denis Howe, not Dave Love] recommend Nelson Minar
-;; 's excellent html-helper-mode.el for editing
-;; HTML and thank Nelson for his many useful comments on this code.
-;; 
-
-;; See also hm--html-menus .  For composing correct HTML see also
-;; PSGML the general SGML structure editor package
-;; ; hm--html-menus can be used
-;; with this.
-
-;; This package generalises function html-previewer-process in Marc
-;; Andreessen's html-mode (LCD modes/html-mode.el.Z).  See also the
-;; ffap.el package.  The huge hyperbole package also contains similar
-;; functions.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Help!
-
-;; Can you write and test some code for the Macintrash and Windoze
-;; Netscape remote control APIs?  (See the URL above).
-
-;; Do any other browsers have remote control?
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Usage
-
-;; To display the URL at or before point:
-;; M-x browse-url-at-point RET
-;; or, similarly but with the opportunity to edit the URL extracted from
-;; the buffer, use:
-;; M-x browse-url
-
-;; To display a URL by shift-clicking on it, put this in your ~/.emacs
-;; file:
-;;      (global-set-key [S-mouse-2] 'browse-url-at-mouse)
-;; (Note that using Shift-mouse-1 is not desirable because
-;; that event has a standard meaning in Emacs.)
-
-;; To display the current buffer in a web browser:
-;; M-x browse-url-of-buffer RET
-
-;; To display the current region in a web browser:
-;; M-x browse-url-of-region RET
-
-;; In Dired, to display the file named on the current line:
-;; M-x browse-url-of-dired-file RET
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Customisation (~/.emacs)
-
-;; To see what variables are available for customization, type
-;; `M-x set-variable browse-url TAB'.  Better, use
-;; `M-x customize-group browse-url'.
-
-;; Bind the browse-url commands to keys with the `C-c C-z' prefix
-;; (as used by html-helper-mode):
-;;	(global-set-key "\C-c\C-z." 'browse-url-at-point)
-;;	(global-set-key "\C-c\C-zb" 'browse-url-of-buffer)
-;;	(global-set-key "\C-c\C-zr" 'browse-url-of-region)
-;;	(global-set-key "\C-c\C-zu" 'browse-url)
-;;	(global-set-key "\C-c\C-zv" 'browse-url-of-file)
-;;	(add-hook 'dired-mode-hook
-;;		  (lambda ()
-;;	             (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file)))
-
-;; Browse URLs in mail messages under RMAIL by clicking mouse-2:
-;;	(add-hook 'rmail-mode-hook (lambda () ; rmail-mode startup
-;;	  (define-key rmail-mode-map [mouse-2] 'browse-url-at-mouse)))
-;; Alternatively, add `goto-address' to `rmail-show-message-hook'.
-
-;; Gnus provides a standard feature to activate URLs in article
-;; buffers for invocation of browse-url.
-
-;; Use the Emacs w3 browser when not running under X11:
-;;	(or (eq window-system 'x)
-;;	    (setq browse-url-browser-function 'browse-url-w3))
-
-;; To always save modified buffers before displaying the file in a browser:
-;;	(setq browse-url-save-file t)
-
-;; To get round the Netscape caching problem, you could EITHER have
-;; write-file in html-helper-mode make Netscape reload the document:
-;;
-;;	(autoload 'browse-url-netscape-reload "browse-url"
-;;	  "Ask a WWW browser to redisplay the current file." t)
-;;	(add-hook 'html-helper-mode-hook
-;;		  (lambda ()
-;;		     (add-hook 'local-write-file-hooks
-;;			       (lambda ()
-;;				  (let ((local-write-file-hooks))
-;;				    (save-buffer))
-;;				  (browse-url-netscape-reload)
-;;				  t)			; => file written by hook
-;;			       t)))			; append to l-w-f-hooks
-;;
-;; OR have browse-url-of-file ask Netscape to load and then reload the
-;; file:
-;;
-;;	(add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload)
-
-;; You may also want to customise browse-url-netscape-arguments, e.g.
-;;	(setq browse-url-netscape-arguments '("-install"))
-;;
-;; or similarly for the other browsers.
-
-;; To invoke different browsers for different URLs:
-;;      (setq browse-url-browser-function '(("^mailto:" . browse-url-mail)
-;;      				    ("." . browse-url-netscape)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Code:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Variables
-
-(eval-when-compile (require 'thingatpt)
-                   (require 'term)
-                   (require 'executable))
-
-(defgroup browse-url nil
-  "Use a web browser to look at a URL."
-  :prefix "browse-url-"
-  :link '(emacs-commentary-link "browse-url")
-  :group 'hypermedia)
-
-;;;###autoload
-(defcustom browse-url-browser-function
-  (cond
-   ((memq system-type '(windows-nt ms-dos cygwin32)) ;; XEmacs change
-    'browse-url-default-windows-browser)
-   ((memq system-type '(darwin)) 'browse-url-default-macosx-browser)
-   (t 'browse-url-default-browser))
-  "*Function to display the current buffer in a WWW browser.
-This is used by the `browse-url-at-point', `browse-url-at-mouse', and
-`browse-url-of-file' commands.
-
-If the value is not a function it should be a list of pairs
-\(REGEXP . FUNCTION).  In this case the function called will be the one
-associated with the first REGEXP which matches the current URL.  The
-function is passed the URL and any other args of `browse-url'.  The last
-regexp should probably be \".\" to specify a default browser."
-  :type '(choice
-	  (function-item :tag "Emacs W3" :value  browse-url-w3)
-	  (function-item :tag "W3 in another Emacs via `gnudoit'"
-			 :value  browse-url-w3-gnudoit)
-	  (function-item :tag "Emacs W3M" :value  browse-url-w3)
-	  (function-item :tag "W3M in another Emacs via `gnudoit'"
-			 :value  browse-url-w3-gnudoit)
-	  (function-item :tag "Mozilla" :value  browse-url-mozilla)
-	  (function-item :tag "Firefox" :value browse-url-firefox)
-	  (function-item :tag "Galeon" :value  browse-url-galeon)
-	  (function-item :tag "Epiphany" :value  browse-url-epiphany)
-	  (function-item :tag "Netscape" :value  browse-url-netscape)
-	  (function-item :tag "Mosaic" :value  browse-url-mosaic)
-	  (function-item :tag "Mosaic using CCI" :value  browse-url-cci)
-	  (function-item :tag "IXI Mosaic" :value  browse-url-iximosaic)
-	  (function-item :tag "Lynx in an xterm window"
-			 :value browse-url-lynx-xterm)
-	  (function-item :tag "Lynx in an Emacs window"
-			 :value browse-url-lynx-emacs)
-	  (function-item :tag "Grail" :value  browse-url-grail)
-	  (function-item :tag "MMM" :value  browse-url-mmm)
-	  (function-item :tag "KDE" :value browse-url-kde)
-	  (function-item :tag "Opera" :value browse-url-opera) ;; XEmacs
-	  (function-item :tag "Specified by `Browse Url Generic Program'"
-			 :value browse-url-generic)
-	  (function-item :tag "Default Windows browser"
-			 :value browse-url-default-windows-browser)
-	  (function-item :tag "Default Mac OS X browser"
-			 :value browse-url-default-macosx-browser)
-	  (function-item :tag "GNOME invoking Mozilla"
-			 :value browse-url-gnome-moz)
-	  (function-item :tag "Default browser"
-			 :value browse-url-default-browser)
-	  (function :tag "Your own function")
-	  ;; XEmacs: Emacs has an `alist' custom type here, but custom
-	  ;; in XEmacs is buggy and cannot handle it, so we don't
-	  ;; include the following:
-	  ;; (alist :tag "Regexp/function association list"
-	  ;;        :key-type regexp :value-type function))
-	  )
-  :group 'browse-url)
-
-(defcustom browse-url-netscape-program "netscape"
-  ;; Info about netscape-remote from Karl Berry.
-  "*The name by which to invoke Netscape.
-
-The free program `netscape-remote' from
- is said to start
-up very much quicker than `netscape'.  Reported to compile on a GNU
-system, given vroot.h from the same directory, with cc flags
- -DSTANDALONE -L/usr/X11R6/lib -lXmu -lX11."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-netscape-arguments nil
-  "*A list of strings to pass to Netscape as arguments."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments
-  "*A list of strings to pass to Netscape when it starts up.
-Defaults to the value of `browse-url-netscape-arguments' at the time
-`browse-url' is loaded."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-;;;###autoload
-(defcustom browse-url-browser-display nil
-  "*The X display for running the browser, if not same as Emacs'."
-  :type '(choice string (const :tag "Default" nil))
-  :group 'browse-url)
-
-;;;###autoload
-(defcustom browse-url-mozilla-program "mozilla"
-  "*The name by which to invoke Mozilla."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-mozilla-arguments nil
-  "*A list of strings to pass to Mozilla as arguments."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-mozilla-startup-arguments browse-url-mozilla-arguments
-  "*A list of strings to pass to Mozilla when it starts up.
-Defaults to the value of `browse-url-mozilla-arguments' at the time
-`browse-url' is loaded."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-;;;###autoload
-(defcustom browse-url-firefox-program "firefox"
-  "*The name by which to invoke Firefox."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-firefox-arguments nil
-  "*A list of strings to pass to Firefox as arguments."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-firefox-startup-arguments browse-url-firefox-arguments
-  "*A list of strings to pass to Firefox when it starts up.
-Defaults to the value of `browse-url-firefox-arguments' at the time
-`browse-url' is loaded."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-;;;###autoload
-(defcustom browse-url-galeon-program "galeon"
-  "*The name by which to invoke Galeon."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-galeon-arguments nil
-  "*A list of strings to pass to Galeon as arguments."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-galeon-startup-arguments browse-url-galeon-arguments
-  "*A list of strings to pass to Galeon when it starts up.
-Defaults to the value of `browse-url-galeon-arguments' at the time
-`browse-url' is loaded."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-epiphany-program "epiphany"
-  "*The name by which to invoke Epiphany."
-:type 'string
-:group 'browse-url)
-
-(defcustom browse-url-epiphany-arguments nil
-  "*A list of strings to pass to Epiphany as arguments."
-:type '(repeat (string :tag "Argument"))
-:group 'browse-url)
-
-(defcustom browse-url-epiphany-startup-arguments browse-url-epiphany-arguments
-  "*A list of strings to pass to Epiphany when it starts up.
-Defaults to the value of `browse-url-epiphany-arguments' at the time
-`browse-url' is loaded."
-:type '(repeat (string :tag "Argument"))
-:group 'browse-url)
-
-(defcustom browse-url-mozilla-new-window-is-tab nil
-  "*Whether to open up new windows in a tab or a new window.
-If non-nil, then open the URL in a new tab rather than a new window if
-`browse-url-mozilla' is asked to open it in a new window."
-  :type 'boolean
-  :group 'browse-url)
-
-(defcustom browse-url-firefox-new-window-is-tab nil
-  "*Whether to open up new windows in a tab or a new window.
-If non-nil, then open the URL in a new tab rather than a new window if
-`browse-url-firefox' is asked to open it in a new window."
-  :type 'boolean
-  :group 'browse-url)
-
-(defcustom browse-url-galeon-new-window-is-tab nil
-  "*Whether to open up new windows in a tab or a new window.
-If non-nil, then open the URL in a new tab rather than a new window if
-`browse-url-galeon' is asked to open it in a new window."
-  :type 'boolean
-  :group 'browse-url)
-
-(defcustom browse-url-epiphany-new-window-is-tab nil
-  "*Whether to open up new windows in a tab or a new window.
-If non-nil, then open the URL in a new tab rather than a new window if
-`browse-url-epiphany' is asked to open it in a new window."
-:type 'boolean
-:group 'browse-url)
-
-(defcustom browse-url-netscape-new-window-is-tab nil
-  "*Whether to open up new windows in a tab or a new window.
-If non-nil, then open the URL in a new tab rather than a new window if
-`browse-url-netscape' is asked to open it in a new window."
-  :type 'boolean
-  :group 'browse-url)
-
-;;;###autoload
-(defcustom browse-url-new-window-flag nil
-  "*If non-nil, always open a new browser window with appropriate browsers.
-Passing an interactive argument to \\[browse-url], or specific browser
-commands reverses the effect of this variable.  Requires Netscape version
-1.1N or later or XMosaic version 2.5 or later if using those browsers."
-  :type 'boolean
-  :group 'browse-url)
-
-;; XEmacs backwards compatibility
-;;;###autoload
-(defvaralias 'browse-url-new-window-p 'browse-url-new-window-flag)
-   
-(defcustom browse-url-mosaic-program "xmosaic"
-  "*The name by which to invoke Mosaic (or mMosaic)."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-mosaic-arguments nil
-  "*A list of strings to pass to Mosaic as arguments."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-mosaic-pidfile "~/.mosaicpid"
-  "*The name of the pidfile created by Mosaic."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-filename-alist
-  (\`					; Backquote syntax won't work.
-   (("^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*" . "ftp://\\2/")
-    ;; The above loses the username to avoid the browser prompting for
-    ;; it in anonymous cases.  If it's not anonymous the next regexp
-    ;; applies.
-    ("^/\\([^:@]+@\\)?\\([^:]+\\):/*" . "ftp://\\1\\2/")
-    (,@ (if (memq system-type '(windows-nt ms-dos cygwin32)) ;; XEmacs change
-	    '(("^\\([a-zA-Z]:\\)[\\/]" . "file:\\1/")
-              ("^[\\/][\\/]+" . "file://"))))
-    ("^/+" . "file:/")))
-  "An alist of (REGEXP . STRING) pairs used by `browse-url-of-file'.
-Any substring of a filename matching one of the REGEXPs is replaced by
-the corresponding STRING using `replace-match', not treating STRING
-literally.  All pairs are applied in the order given.  The default
-value converts ange-ftp/EFS-style file names into ftp URLs and prepends
-`file:' to any file name beginning with `/'.
-
-For example, adding to the default a specific translation of an ange-ftp
-address to an HTTP URL:
-
-    (setq browse-url-filename-alist
-	  '((\"/webmaster@webserver:/home/www/html/\" .
-	     \"http://www.acme.co.uk/\")
-            (\"^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*\" . \"ftp://\\2/\")
-            (\"^/\\([^:@]+@\\)?\\([^:]+\\):/*\" . \"ftp://\\1\\2/\")
-	    (\"^/+\" . \"file:/\")))
-"
-  :type '(repeat (cons :format "%v"
-                       (regexp :tag "Regexp")
-                       (string :tag "Replacement")))
-  :group 'browse-url)
-
-;;;###autoload
-(defcustom browse-url-save-file nil
-  "*If non-nil, save the buffer before displaying its file.
-Used by the `browse-url-of-file' command."
-  :type 'boolean
-  :group 'browse-url)
-
-(defcustom browse-url-of-file-hook nil
-  "*Run after `browse-url-of-file' has asked a browser to load a file.
-
-Set this to `browse-url-netscape-reload' to force Netscape to load the
-file rather than displaying a cached copy."
-  :type 'hook
-  :options '(browse-url-netscape-reload)
-  :group 'browse-url)
-
-(defcustom browse-url-CCI-port 3003
-  "*Port to access XMosaic via CCI.
-This can be any number between 1024 and 65535 but must correspond to
-the value set in the browser."
-  :type 'integer
-  :group 'browse-url)
-
-(defcustom browse-url-CCI-host "localhost"
-  "*Host to access XMosaic via CCI.
-This should be the host name of the machine running XMosaic with CCI
-enabled.  The port number should be set in `browse-url-CCI-port'."
-  :type 'string
-  :group 'browse-url)
-
-(defvar browse-url-temp-file-name nil)
-(make-variable-buffer-local 'browse-url-temp-file-name)
-
-(defcustom browse-url-xterm-program "xterm"
-  "*The name of the terminal emulator used by `browse-url-lynx-xterm'.
-This might, for instance, be a separate colour version of xterm."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-xterm-args nil
-  "*A list of strings defining options for `browse-url-xterm-program'.
-These might set its size, for instance."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-lynx-emacs-args (and (not window-system)
-                                           '("-show_cursor"))
-  "*A list of strings defining options for Lynx in an Emacs buffer.
-
-The default is none in a window system, otherwise `-show_cursor' to
-indicate the position of the current link in the absence of
-highlighting, assuming the normal default for showing the cursor."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-gnudoit-program "gnuclient" ;; XEmacs
-  "*The name of the `gnudoit' program.
-Used by `browse-url-w3-gnudoit' and `browse-url-w3m-gnudoit'."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-gnudoit-args '("-batch" "-eval") ;; XEmacs
-  "*A list of strings defining options for `browse-url-gnudoit-program'.
-These might set the port, for instance."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-;;;###autoload
-(defcustom browse-url-generic-program nil
-  "*The name of the browser program used by `browse-url-generic'."
-  :type '(choice string (const :tag "None" nil))
-  :group 'browse-url)
-
-(defcustom browse-url-generic-args nil
-  "*A list of strings defining options for `browse-url-generic-program'."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-temp-dir (temp-directory) ;; XEmacs change
-  "*The name of a directory for browse-url's temporary files.
-Such files are generated by functions like `browse-url-of-region'.
-You might want to set this to somewhere with restricted read permissions
-for privacy's sake."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-netscape-version
-  3
-  "*The version of Netscape you are using.
-This affects how URL reloading is done; the mechanism changed
-incompatibly at version 4."
-  :type 'number
-  :group 'browse-url)
-
-(defcustom browse-url-lynx-input-field 'avoid
-  "*Action on selecting an existing Lynx buffer at an input field.
-What to do when sending a new URL to an existing Lynx buffer in Emacs
-if the Lynx cursor is on an input field (in which case the `g' command
-would be entered as data).  Such fields are recognized by the
-underlines ____.  Allowed values: nil: disregard it, 'warn: warn the
-user and don't emit the URL, 'avoid: try to avoid the field by moving
-down (this *won't* always work)."
-  :type '(choice (const :tag "Move to try to avoid field" :value avoid)
-                 (const :tag "Disregard" :value nil)
-                 (const :tag "Warn, don't emit URL" :value warn))
-  :group 'browse-url)
-
-(defcustom browse-url-lynx-input-attempts 10
-  "*How many times to try to move down from a series of lynx input fields."
-:type 'integer
-:group 'browse-url)
-
-(defcustom browse-url-lynx-input-delay 0.2
-  "*How many seconds to wait for lynx between moves down from an input field."
-:type 'number
-:group 'browse-url)
-
-(defcustom browse-url-kde-program "kfmclient"
-  "*The name by which to invoke the KDE web browser."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-kde-args '("openURL")
-  "*A list of strings defining options for `browse-url-kde-program'."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-opera-program "opera"
-  "*The name by which to invoke Opera."
-  :type 'string
-  :group 'browse-url)
-
-(defcustom browse-url-opera-arguments '()
-  "*A list of strings to pass to Opera as arguments."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-(defcustom browse-url-opera-startup-arguments browse-url-opera-arguments
-  "*A list of strings to pass to Opera when it starts up.
-Defaults to the value of `browse-url-opera-arguments' at the time
-`browse-url' is loaded."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; URL input
-
-(defun browse-url-url-at-point ()
-  (let ((url (thing-at-point 'url)))
-    (unless (zerop (length url)) ;; XEmacs bug workaround,
-				 ;; `set-text-properties' in XEmacs <=
-				 ;; 21.4.6 doesn't handle 0-0.
-      (set-text-properties 0 (length url) nil url))
-    url))
-
-;; Having this as a separate function called by the browser-specific
-;; functions allows them to be stand-alone commands, making it easier
-;; to switch between browsers.
-
-(defun browse-url-interactive-arg (prompt)
-  "Read a URL from the minibuffer, prompting with PROMPT.
-Default to the URL at or before point.  If invoked with a mouse button,
-set point to the position clicked first.  Return a list for use in
-`interactive' containing the URL and `browse-url-new-window-flag' or its
-negation if a prefix argument was given."
-  (let ((event (elt (this-command-keys) 0)))
-    (and (listp event) (mouse-set-point event)))
-  (list (read-string prompt (browse-url-url-at-point))
-	(not (eq (null browse-url-new-window-flag)
-		 (null current-prefix-arg)))))
-
-;; interactive-p needs to be called at a function's top-level, hence
-;; the macro.
-(defmacro browse-url-maybe-new-window (arg)
-  `(if (not (interactive-p))
-       ,arg
-     browse-url-new-window-flag))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Browse current buffer
-
-;;;###autoload
-(defun browse-url-of-file (&optional file)
-  "Ask a WWW browser to display FILE.
-Display the current buffer's file if FILE is nil or if called
-interactively.  Turn the filename into a URL with function
-`browse-url-file-url'.  Pass the URL to a browser using the
-`browse-url' function then run `browse-url-of-file-hook'."
-  (interactive)
-  (or file
-      (setq file (buffer-file-name))
-      (error "Current buffer has no file"))
-  (let ((buf (get-file-buffer file)))
-    (if buf
-	(save-excursion
-	  (set-buffer buf)
-	  (cond ((not (buffer-modified-p)))
-		(browse-url-save-file (save-buffer))
-		(t (message "%s modified since last save" file))))))
-  (browse-url (browse-url-file-url file))
-  (run-hooks 'browse-url-of-file-hook))
-
-(defun browse-url-file-url (file)
-  "Return the URL corresponding to FILE.
-Use variable `browse-url-filename-alist' to map filenames to URLs."
-  ;; URL-encode special chars, do % first
-  (let ((s 0))
-    (while (setq s (string-match "%" file s))
-      (setq file (replace-match "%25" t t file)
-	    s (1+ s))))
-  (while (string-match "[*\"()',=;? ]" file)
-    (let ((enc (format "%%%x" (aref file (match-beginning 0)))))
-      (setq file (replace-match enc t t file))))
-  (dolist (map browse-url-filename-alist)
-    (when (and map (string-match (car map) file))
-      (setq file (replace-match (cdr map) t nil file))))
-  file)
-
-;;;###autoload
-(defun browse-url-of-buffer (&optional buffer)
-  "Ask a WWW browser to display BUFFER.
-Display the current buffer if BUFFER is nil.  Display only the
-currently visible part of BUFFER (from a temporary file) if buffer is
-narrowed."
-  (interactive)
-  (save-excursion
-    (and buffer (set-buffer buffer))
-    (let ((file-name
-	   ;; Ignore real name if restricted
-	   (and (= (- (point-max) (point-min)) (buffer-size))
-		(or buffer-file-name
-		    (and (boundp 'dired-directory) dired-directory)))))
-      (or file-name
-	  (progn
-	    (or browse-url-temp-file-name
-		(setq browse-url-temp-file-name
-		      (convert-standard-filename
-		       (make-temp-name ;; XEmacs doesn't have make-temp-file
-			(expand-file-name "burl" browse-url-temp-dir)))))
-	    (setq file-name browse-url-temp-file-name)
-	    (write-region (point-min) (point-max) file-name nil 'no-message)))
-      (browse-url-of-file file-name))))
-
-(defun browse-url-delete-temp-file (&optional temp-file-name)
-  "Delete `browse-url-temp-file-name' from the file system.
-If the optional argument TEMP-FILE-NAME is non-nil, delete it instead."
-  (let ((file-name (or temp-file-name browse-url-temp-file-name)))
-    (if (and file-name (file-exists-p file-name))
-	(delete-file file-name))))
-
-(add-hook 'kill-buffer-hook 'browse-url-delete-temp-file)
-
-;;;###autoload
-(defun browse-url-of-dired-file ()
-  "In Dired, ask a WWW browser to display the file named on this line."
-  (interactive)
-  (browse-url-of-file (dired-get-filename)))
-
-;;;###autoload
-(defun browse-url-of-region (min max)
-  "Ask a WWW browser to display the current region."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region min max)
-      (browse-url-of-buffer))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Browser-independent commands
-
-;; A generic command to call the current browse-url-browser-function
-
-;;;###autoload
-(defun browse-url (url &rest args)
-  "Ask a WWW browser to load URL.
-Prompts for a URL, defaulting to the URL at or before point.  Variable
-`browse-url-browser-function' says which browser to use."
-  (interactive (browse-url-interactive-arg "URL: "))
-  (unless (interactive-p)
-    (setq args (or args (list browse-url-new-window-flag))))
-  (if (functionp browse-url-browser-function)
-      (apply browse-url-browser-function url args)
-    ;; The `function' can be an alist; look down it for first match
-    ;; and apply the function (which might be a lambda).
-    (catch 'done
-      (dolist (bf browse-url-browser-function)
-	(when (string-match (car bf) url)
-	  (apply (cdr bf) url args)
-	  (throw 'done t)))
-      (error "No browse-url-browser-function matching URL %s"
-	     url))))
-
-;;;###autoload
-(defun browse-url-at-point (&optional arg)
-  "Ask a WWW browser to load the URL at or before point.
-Doesn't let you edit the URL like `browse-url'.  Variable
-`browse-url-browser-function' says which browser to use."
-  (interactive "P")
-  (let ((url (browse-url-url-at-point)))
-    (if url
-	(browse-url url (if arg
-			    (not browse-url-new-window-flag)
-			  browse-url-new-window-flag))
-      (error "No URL found"))))
-
-;;;###autoload
-(defun browse-url-at-mouse (event)
-  "Ask a WWW browser to load a URL clicked with the mouse.
-The URL is the one around or before the position of the mouse click
-but point is not changed.  Doesn't let you edit the URL like
-`browse-url'.  Variable `browse-url-browser-function' says which browser
-to use."
-  (interactive "e")
-  (save-excursion
-    (mouse-set-point event)
-    ;; This handles browse-url-new-window-flag properly
-    ;; when it gets no arg.
-    (browse-url-at-point)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Browser-specific commands
-
-;; --- Default MS-Windows browser ---
-
-(defun browse-url-default-windows-browser (url &optional new-window)
-  (interactive (browse-url-interactive-arg "URL: "))
-  (if (featurep 'xemacs) ;; XEmacs change
-      (mswindows-shell-execute "open" url)
-    (w32-shell-execute "open" url)))
-
-(defun browse-url-default-macosx-browser (url &optional new-window)
-  (interactive (browse-url-interactive-arg "URL: "))
-  (start-process (concat "open " url) nil "open" url))
-
-;; --- Netscape ---
-
-(defun browse-url-process-environment ()
-  "Set DISPLAY in the environment to the X display the browser will use.
-This is either the value of variable `browse-url-browser-display' if
-non-nil, or the same display as Emacs if different from the current
-environment, otherwise just use the current environment."
-  (let ((display (or browse-url-browser-display (browse-url-emacs-display))))
-    (if display
-	(cons (concat "DISPLAY=" display) process-environment)
-      process-environment)))
-
-(defun browse-url-emacs-display ()
-  "Return the X display Emacs is running on.
-This is nil if the display is the same as the DISPLAY environment variable.
-
-Actually Emacs could be using several displays; this just returns the
-one showing the selected frame."
-  (let ((display (cdr-safe (assq 'display (frame-parameters)))))
-    (and (not (equal display (getenv "DISPLAY")))
-         display)))
-
-;;;###autoload
-(defun browse-url-default-browser (url &rest args)
-  "Find a suitable browser and ask it to load URL.
-Default to the URL around or before point.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new window, if possible, otherwise use
-a random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-The order attempted is emacs-w3m, gnome-moz-remote, Mozilla, Firefox,
-Galeon, Konqueror, Netscape, Opera, Mosaic, IXI Mosaic, Lynx in an
-xterm, MMM, and then W3."
-  (apply
-    (cond
-     ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
-     ((executable-find browse-url-mozilla-program) 'browse-url-mozilla)
-     ((executable-find browse-url-firefox-program) 'browse-url-firefox)
-     ((executable-find browse-url-galeon-program) 'browse-url-galeon)
-     ((executable-find browse-url-kde-program) 'browse-url-kde)
-     ((executable-find browse-url-netscape-program) 'browse-url-netscape)
-     ((executable-find browse-url-opera-program) 'browse-url-opera)
-     ((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
-     ((executable-find "tellw3b") 'browse-url-iximosaic)
-     ((fboundp 'w3m-goto-url-new-session) 'browse-url-w3m)
-     ((executable-find browse-url-xterm-program) 'browse-url-lynx-xterm)
-     ((executable-find "mmm") 'browse-url-mmm)
-     (t 'browse-url-w3))
-     url args))
-
-;;;###autoload
-(defun browse-url-netscape (url &optional new-window)
-  "Ask the Netscape WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-netscape-arguments' are also passed to Netscape.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Netscape window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-netscape-new-window-is-tab' is non-nil, then
-whenever a document would otherwise be loaded in a new window, it
-is loaded in a new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "URL: "))
-  ;; URL encode any `confusing' characters in the URL.  This needs to
-  ;; include at least commas; presumably also close parens.
-  (while (string-match "[,)]" url)
-    (setq url (replace-match
-	       (format "%%%x" (string-to-char (match-string 0 url))) t t url)))
-  (let* ((process-environment (browse-url-process-environment))
-	 (process
-	  (apply 'start-process
-		 (concat "netscape " url) nil
-		 browse-url-netscape-program
-		 (append
-		  browse-url-netscape-arguments
-		  (if (eq (console-type) 'mswindows) ;; XEmacs change
-		      (list url)
-		    (append
-		     (if new-window '("-noraise"))
-		     (list "-remote"
-			   (concat "openURL(" url
-				   (if (browse-url-maybe-new-window
-					new-window)
-				       (if browse-url-netscape-new-window-is-tab
-					   ",new-tab"
-					 ",new-window"))
-				   ")"))))))))
-    (set-process-sentinel process
-			  `(lambda (process change)
-			     (browse-url-netscape-sentinel process ,url)))))
-
-(defun browse-url-netscape-sentinel (process url)
-  "Handle a change to the process communicating with Netscape."
-  (or (eq (process-exit-status process) 0)
-      (let* ((process-environment (browse-url-process-environment)))
-	;; Netscape not running - start it
-	(message "Starting Netscape...")
-	(apply 'start-process (concat "netscape" url) nil
-	       browse-url-netscape-program
-	       (append browse-url-netscape-startup-arguments (list url))))))
-
-(defun browse-url-netscape-reload ()
-  "Ask Netscape to reload its current document.
-How depends on `browse-url-netscape-version'."
-  (interactive)
-  ;; Backwards incompatibility reported by
-  ;; .
-  (browse-url-netscape-send (if (>= browse-url-netscape-version 4)
-				"xfeDoCommand(reload)"
-				"reload")))
-
-(defun browse-url-netscape-send (command)
-  "Send a remote control command to Netscape."
-  (let* ((process-environment (browse-url-process-environment)))
-    (apply 'start-process "netscape" nil
-           browse-url-netscape-program
-           (append browse-url-netscape-arguments
-                   (list "-remote" command)))))
-
-;;;###autoload
-(defun browse-url-mozilla (url &optional new-window)
-  "Ask the Mozilla WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-mozilla-arguments' are also passed to Mozilla.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Mozilla window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-mozilla-new-window-is-tab' is non-nil, then whenever a
-document would otherwise be loaded in a new window, it is loaded in a
-new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-On MS-Windows systems the optional `new-window' parameter is ignored.
-Mozilla for Windows does not support the \"-remote\" command line
-parameter. Therefore the `browse-url-new-window-flag', 
-`browse-url-new-window-flag' and `browse-url-mozilla-new-window-is-tab'
-are ignored as well. Mozilla on Windows will always open the
-requested URL in a new window."
-  (interactive (browse-url-interactive-arg "URL: "))
-  ;; URL encode any `confusing' characters in the URL.  This needs to
-  ;; include at least commas; presumably also close parens.
-  (while (string-match "[,)]" url)
-    (setq url (replace-match
-	       (format "%%%x" (string-to-char (match-string 0 url))) t t url)))
-  (let* ((process-environment (browse-url-process-environment))
-         (process
-	  (apply 'start-process
-		 (concat "mozilla " url) nil
-		 browse-url-mozilla-program
-		 (append
-		  browse-url-mozilla-arguments
-          (if (or (featurep 'dos-w32)
-                  (string-match "win32" system-configuration))
-              (list url)
-            (list "-remote"
-                  (concat "openURL("
-                          url
-                          (if (browse-url-maybe-new-window
-                               new-window)
-                              (if browse-url-mozilla-new-window-is-tab
-                                  ",new-tab"
-                                ",new-window"))
-                          ")")))))))
-    (set-process-sentinel process
-			  `(lambda (process change)
-			     (browse-url-mozilla-sentinel process ,url)))))
-
-(defun browse-url-mozilla-sentinel (process url)
-  "Handle a change to the process communicating with Mozilla."
-  (or (eq (process-exit-status process) 0)
-      (let* ((process-environment (browse-url-process-environment)))
-	;; Mozilla is not running - start it
-	(message "Starting Mozilla...")
-	(apply 'start-process (concat "mozilla " url) nil
-	       browse-url-mozilla-program
-	       (append browse-url-mozilla-startup-arguments (list url))))))
-
-;;;###autoload
-(defun browse-url-firefox (url &optional new-window)
-  "Ask the Firefox WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-firefox-arguments' are also passed to Firefox.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Firefox window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-firefox-new-window-is-tab' is non-nil, then whenever a
-document would otherwise be loaded in a new window, it is loaded in a
-new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'.
-
-On MS-Windows systems the optional `new-window' parameter is ignored.
-Firefox for Windows does not support the \"-remote\" command line
-parameter. Therefore the `browse-url-new-window-flag', 
-`browse-url-new-window-flag' and `browse-url-firefox-new-window-is-tab'
-are ignored as well. Firefox on Windows will always open the
-requested URL in a new window."
-  (interactive (browse-url-interactive-arg "URL: "))
-  ;; URL encode any `confusing' characters in the URL.  This needs to
-  ;; include at least commas; presumably also close parens.
-  (while (string-match "[,)]" url)
-    (setq url (replace-match
-	       (format "%%%x" (string-to-char (match-string 0 url))) t t url)))
-  (let* ((process-environment (browse-url-process-environment))
-         (process
-	  (apply 'start-process
-		 (concat "firefox " url) nil
-		 browse-url-firefox-program
-		 (append
-		  browse-url-firefox-arguments
-          (if (or (featurep 'dos-w32)
-                  (string-match "win32" system-configuration))
-              (list url)
-            (list "-remote"
-                  (concat "openURL("
-                          url
-                          (if (browse-url-maybe-new-window
-                               new-window)
-                              (if browse-url-firefox-new-window-is-tab
-                                  ",new-tab"
-                                ",new-window"))
-                          ")")))))))
-    (set-process-sentinel process
-			  `(lambda (process change)
-			     (browse-url-firefox-sentinel process ,url)))))
-
-(defun browse-url-firefox-sentinel (process url)
-  "Handle a change to the process communicating with Firefox."
-  (or (eq (process-exit-status process) 0)
-      (let* ((process-environment (browse-url-process-environment)))
-	;; Firefox is not running - start it
-	(message "Starting Firefox...")
-	(apply 'start-process (concat "firefox " url) nil
-	       browse-url-firefox-program
-	       (append browse-url-firefox-startup-arguments (list url))))))
-
-;;;###autoload
-(defun browse-url-galeon (url &optional new-window)
-  "Ask the Galeon WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-galeon-arguments' are also passed to Galeon.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Galeon window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-galeon-new-window-is-tab' is non-nil, then whenever a
-document would otherwise be loaded in a new window, it is loaded in a
-new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "URL: "))
-  ;; URL encode any `confusing' characters in the URL.  This needs to
-  ;; include at least commas; presumably also close parens.
-  (while (string-match "[,)]" url)
-    (setq url (replace-match
-	       (format "%%%x" (string-to-char (match-string 0 url))) t t url)))
-  (let* ((process-environment (browse-url-process-environment))
-         (process (apply 'start-process
-			 (concat "galeon " url)
-			 nil
-			 browse-url-galeon-program
-			 (append
-			  browse-url-galeon-arguments
-                          (if (browse-url-maybe-new-window new-window)
-			      (if browse-url-galeon-new-window-is-tab
-				  '("--new-tab")
-				'("--new-window" "--noraise"))
-                            '("--existing"))
-                          (list url)))))
-    (set-process-sentinel process
-			  `(lambda (process change)
-			     (browse-url-galeon-sentinel process ,url)))))
-
-(defun browse-url-galeon-sentinel (process url)
-  "Handle a change to the process communicating with Galeon."
-  (or (eq (process-exit-status process) 0)
-      (let* ((process-environment (browse-url-process-environment)))
-	;; Galeon is not running - start it
-	(message "Starting Galeon...")
-	(apply 'start-process (concat "galeon " url) nil
-	       browse-url-galeon-program
-	       (append browse-url-galeon-startup-arguments (list url))))))
-
-(defun browse-url-epiphany (url &optional new-window)
-  "Ask the Epiphany WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-galeon-arguments' are also passed to Epiphany.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Epiphany window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-If `browse-url-epiphany-new-window-is-tab' is non-nil, then whenever a
-document would otherwise be loaded in a new window, it is loaded in a
-new tab in an existing window instead.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "URL: "))
-  ;; URL encode any `confusing' characters in the URL.  This needs to
-  ;; include at least commas; presumably also close parens.
-  (while (string-match "[,)]" url)
-    (setq url (replace-match
-	       (format "%%%x" (string-to-char (match-string 0 url))) t t url)))
-  (let* ((process-environment (browse-url-process-environment))
-         (process (apply 'start-process
-			 (concat "epiphany " url)
-			 nil
-			 browse-url-epiphany-program
-			 (append
-			  browse-url-epiphany-arguments
-                          (if (browse-url-maybe-new-window new-window)
-			      (if browse-url-epiphany-new-window-is-tab
-				  '("--new-tab")
-				'("--new-window" "--noraise"))
-                            '("--existing"))
-                          (list url)))))
-    (set-process-sentinel process
-			  `(lambda (process change)
-			     (browse-url-epiphany-sentinel process ,url)))))
-
-(defun browse-url-epiphany-sentinel (process url)
-  "Handle a change to the process communicating with Epiphany."
-  (or (eq (process-exit-status process) 0)
-      (let* ((process-environment (browse-url-process-environment)))
-	;; Epiphany is not running - start it
-	(message "Starting Epiphany...")
-	(apply 'start-process (concat "epiphany " url) nil
-	       browse-url-epiphany-program
-	       (append browse-url-epiphany-startup-arguments (list url))))))
-
-;; GNOME means of invoking either Mozilla or Netscape.
-(defvar browse-url-gnome-moz-program "gnome-moz-remote")
-(defcustom browse-url-gnome-moz-arguments '()
-  "*A list of strings passed to the GNOME mozilla viewer as arguments."
-  :type '(repeat (string :tag "Argument"))
-  :group 'browse-url)
-
-;;;###autoload
-(defun browse-url-gnome-moz (url &optional new-window)
-  "Ask Mozilla/Netscape to load URL via the GNOME program `gnome-moz-remote'.
-Default to the URL around or before point.  The strings in variable
-`browse-url-gnome-moz-arguments' are also passed.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new browser window, otherwise use an
-existing one.  A non-nil interactive prefix argument reverses the
-effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "URL: "))
-  (apply 'start-process (concat "gnome-moz-remote " url)
-	 nil
-	 browse-url-gnome-moz-program
-	 (append
-	  browse-url-gnome-moz-arguments
-	  (if (browse-url-maybe-new-window new-window)
-	    '("--newwin"))
-	  (list "--raise" url))))
-
-;; --- Mosaic ---
-
-;;;###autoload
-(defun browse-url-mosaic (url &optional new-window)
-  "Ask the XMosaic WWW browser to load URL.
-
-Default to the URL around or before point.  The strings in variable
-`browse-url-mosaic-arguments' are also passed to Mosaic and the
-program is invoked according to the variable
-`browse-url-mosaic-program'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Mosaic window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "Mosaic URL: "))
-  (let ((pidfile (expand-file-name browse-url-mosaic-pidfile))
-	pid)
-    (if (file-readable-p pidfile)
-	(save-excursion
-	  (find-file pidfile)
-	  (goto-char (point-min))
-	  (setq pid (read (current-buffer)))
-	  (kill-buffer nil)))
-    (if (and pid (zerop (signal-process pid 0))) ; Mosaic running
-	(save-excursion
-	  (find-file (format "/tmp/Mosaic.%d" pid))
-	  (erase-buffer)
-	  (insert (if (browse-url-maybe-new-window new-window)
-		      "newwin\n"
-		    "goto\n")
-		  url "\n")
-	  (save-buffer)
-	  (kill-buffer nil)
-	  ;; Send signal SIGUSR to Mosaic
-	  (message "Signalling Mosaic...")
-	  (signal-process pid 'SIGUSR1)
-	  ;; Or you could try:
-	  ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
-	  (message "Signalling Mosaic...done")
-	  )
-      ;; Mosaic not running - start it
-      (message "Starting Mosaic...")
-      (apply 'start-process "xmosaic" nil browse-url-mosaic-program
-	     (append browse-url-mosaic-arguments (list url)))
-      (message "Starting Mosaic...done"))))
-
-;; --- Grail ---
-
-;;;###autoload
-(defvar browse-url-grail
-  (concat (or (getenv "GRAILDIR") "~/.grail") "/user/rcgrail.py")
-  "Location of Grail remote control client script `rcgrail.py'.
-Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.")
-
-;;;###autoload
-(defun browse-url-grail (url &optional new-window)
-  "Ask the Grail WWW browser to load URL.
-Default to the URL around or before point.  Runs the program in the
-variable `browse-url-grail'."
-  (interactive (browse-url-interactive-arg "Grail URL: "))
-  (message "Sending URL to Grail...")
-  (save-excursion
-    (set-buffer (get-buffer-create " *Shell Command Output*"))
-    (erase-buffer)
-    ;; don't worry about this failing.
-    (if (browse-url-maybe-new-window new-window)
-	(call-process browse-url-grail nil 0 nil "-b" url)
-      (call-process browse-url-grail nil 0 nil url))
-    (message "Sending URL to Grail... done")))
-
-;; --- Mosaic using CCI ---
-
-;;;###autoload
-(defun browse-url-cci (url &optional new-window)
-  "Ask the XMosaic WWW browser to load URL.
-Default to the URL around or before point.
-
-This function only works for XMosaic version 2.5 or later.  You must
-select `CCI' from XMosaic's File menu, set the CCI Port Address to the
-value of variable `browse-url-CCI-port', and enable `Accept requests'.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new browser window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "Mosaic URL: "))
-  (open-network-stream "browse-url" " *browse-url*"
-		       browse-url-CCI-host browse-url-CCI-port)
-  ;; Todo: start browser if fails
-  (process-send-string "browse-url"
-		       (concat "get url (" url ") output "
-			       (if (browse-url-maybe-new-window new-window)
-				   "new"
-				 "current")
-			       "\r\n"))
-  (process-send-string "browse-url" "disconnect\r\n")
-  (delete-process "browse-url"))
-
-;; --- IXI Mosaic ---
-
-;;;###autoload
-(defun browse-url-iximosaic (url &optional new-window)
-  ;; new-window ignored
-  "Ask the IXIMosaic WWW browser to load URL.
-Default to the URL around or before point."
-  (interactive (browse-url-interactive-arg "IXI Mosaic URL: "))
-  (start-process "tellw3b" nil "tellw3b"
-		 "-service WWW_BROWSER ixi_showurl " url))
-
-;; --- W3 ---
-
-;;;###autoload
-(defun browse-url-w3 (url &optional new-window)
-  "Ask the w3 WWW browser to load URL.
-Default to the URL around or before point.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new window.  A non-nil interactive
-prefix argument reverses the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "W3 URL: "))
-  (require 'w3)				; w3-fetch-other-window not autoloaded
-  (if (browse-url-maybe-new-window new-window)
-      (w3-fetch-other-window url)
-    (w3-fetch url)))
-
-;;;###autoload
-(defun browse-url-w3-gnudoit (url &optional new-window)
-  ;; new-window ignored
-  "Ask another Emacs running gnuserv to load the URL using the W3 browser.
-The `browse-url-gnudoit-program' program is used with options given by
-`browse-url-gnudoit-args'.  Default to the URL around or before point."
-  (interactive (browse-url-interactive-arg "W3 URL: "))
-    (apply 'start-process (concat "gnudoit:" url) nil
-	   browse-url-gnudoit-program
-	   (append browse-url-gnudoit-args
-		   (list (concat "(w3-fetch \"" url "\")")
-			 "(raise-frame)"))))
-
-;; --- emacs-w3m ---
-
-;;;###autoload
-(defun browse-url-w3m (url &optional new-window)
-  "Ask the emacs-w3m WWW browser to load URL.
-Default to the URL around or before point.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new window.  A non-nil interactive
-prefix argument reverses the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "W3M URL: "))
-  (if (browse-url-maybe-new-window new-window)
-      (progn
-        (split-window) (other-window 1)))
-  (w3m-goto-url-new-session url))
-
-;;;###autoload
-(defun browse-url-w3m-gnudoit (url &optional new-window)
-  ;; new-window ignored
-  "Ask the Emacs running gnuserv to load the URL using the emacs-w3m browser.
-The `browse-url-gnudoit-program' program is used with options given by
-`browse-url-gnudoit-args'.  Default to the URL around or before point."
-  (interactive (browse-url-interactive-arg "W3M URL: "))
-    (apply 'start-process (concat "gnudoit:" url) nil
-	   browse-url-gnudoit-program
-	   (append browse-url-gnudoit-args
-		   (list (concat "(w3m-goto-url-new-session \"" url "\")")
-			 "(raise-frame)"))))
-
-;; --- Lynx in an xterm ---
-
-;;;###autoload
-(defun browse-url-lynx-xterm (url &optional new-window)
-  ;; new-window ignored
-  "Ask the Lynx WWW browser to load URL.
-Default to the URL around or before point.  A new Lynx process is run
-in an Xterm window using the Xterm program named by `browse-url-xterm-program'
-with possible additional arguments `browse-url-xterm-args'."
-  (interactive (browse-url-interactive-arg "Lynx URL: "))
-  (apply #'start-process `(,(concat "lynx" url) nil ,browse-url-xterm-program
-             ,@browse-url-xterm-args "-e" "lynx"
-	     ,url)))
-
-;; --- Lynx in an Emacs "term" window ---
-
-;;;###autoload
-(defun browse-url-lynx-emacs (url &optional new-buffer)
-  "Ask the Lynx WWW browser to load URL.
-Default to the URL around or before point.  With a prefix argument, run
-a new Lynx process in a new buffer.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new lynx in a new term window,
-otherwise use any existing one.  A non-nil interactive prefix argument
-reverses the effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "Lynx URL: "))
-  (let* ((system-uses-terminfo t)       ; Lynx uses terminfo
-	 ;; (term-term-name "vt100") ; ??
-	 (buf (get-buffer "*lynx*"))
-	 (proc (and buf (get-buffer-process buf)))
-	 (n browse-url-lynx-input-attempts))
-    (if (and (browse-url-maybe-new-window new-buffer) buf)
-	;; Rename away the OLD buffer. This isn't very polite, but
-	;; term insists on working in a buffer named *lynx* and would
-	;; choke on *lynx*<1>
-	(progn (set-buffer buf)
-	       (rename-uniquely)))
-    (if (or (browse-url-maybe-new-window new-buffer)
-	    (not buf)
-	    (not proc)
-	    (not (memq (process-status proc) '(run stop))))
-	;; start a new lynx
-	(progn
-          (setq buf
-                (apply #'make-term
-                       `("lynx" "lynx" nil ,@browse-url-lynx-emacs-args
-			 ,url)))
-          (switch-to-buffer buf)
-          (term-char-mode)
-          (set-process-sentinel
-           (get-buffer-process buf)
-           ;; Don't leave around a dead one (especially because of its
-           ;; munged keymap.)
-           (lambda (process event)
-             (if (not (memq (process-status process) '(run stop)))
-                 (let ((buf (process-buffer process)))
-                   (if buf (kill-buffer buf)))))))
-      ;; send the url to lynx in the old buffer
-      (let ((win (get-buffer-window buf t)))
-	(if win
-	    (select-window win)
-	  (switch-to-buffer buf)))
-      (if (eq (following-char) ?_)
-	  (cond ((eq browse-url-lynx-input-field 'warn)
-		 (error "Please move out of the input field first"))
-		((eq browse-url-lynx-input-field 'avoid)
-		 (while (and (eq (following-char) ?_) (> n 0))
-		   (term-send-down) ; down arrow
-		   (sit-for browse-url-lynx-input-delay))
-		 (if (eq (following-char) ?_)
-		     (error "Cannot move out of the input field, sorry")))))
-      (term-send-string proc (concat "g" ; goto
-				     "\C-u" ; kill default url
-				     url
-				     "\r")))))
-
-;; --- MMM ---
-
-;;;###autoload
-(defun browse-url-mmm (url &optional new-window)
-  "Ask the MMM WWW browser to load URL.
-Default to the URL around or before point."
-  (interactive (browse-url-interactive-arg "MMM URL: "))
-  (message "Sending URL to MMM...")
-  (save-excursion
-    (set-buffer (get-buffer-create " *Shell Command Output*"))
-    (erase-buffer)
-    ;; mmm_remote just SEGVs if the file isn't there...
-    (if (or (file-exists-p (expand-file-name "~/.mmm_remote"))
-	    ;; location in v 0.4:
-	    (file-exists-p (expand-file-name "~/.mmm/remote")))
-	(call-process "mmm_remote" nil 0 nil url)
-      (call-process "mmm" nil 0 nil "-external" url))
-    (message "Sending URL to MMM... done")))
-
-;; --- mailto ---
-
-;;;###autoload
-(defun browse-url-mail (url &optional new-window)
-  "Open a new mail message buffer within Emacs.
-Default to using the mailto: URL around or before point as the
-recipient's address.  Supplying a non-nil interactive prefix argument
-will cause the mail to be composed in another window rather than the
-current one.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil use `compose-mail-other-window', otherwise `compose-mail'.  A
-non-nil interactive prefix argument reverses the effect of
-`browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "Mailto URL: "))
-  (save-excursion
-    (let ((to (if (string-match "^mailto:" url)
-		  (substring url 7)
-		url)))
-      (if (browse-url-maybe-new-window new-window)
-	  (compose-mail-other-window to nil nil nil
-				     (list 'insert-buffer (current-buffer)))
-	(compose-mail to nil nil nil nil
-		      (list 'insert-buffer (current-buffer)))))))
-
-;; --- Random browser ---
-
-;;;###autoload
-(defun browse-url-generic (url &optional new-window)
-  ;; new-window ignored
-  "Ask the WWW browser defined by `browse-url-generic-program' to load URL.
-Default to the URL around or before point.  A fresh copy of the
-browser is started up in a new process with possible additional arguments
-`browse-url-generic-args'.  This is appropriate for browsers which
-don't offer a form of remote control."
-  (interactive (browse-url-interactive-arg "URL: "))
-  (if (not browse-url-generic-program)
-    (error "No browser defined (`browse-url-generic-program')"))
-  (apply 'start-process (concat browse-url-generic-program url) nil
-	 browse-url-generic-program
-	 (append browse-url-generic-args (list url))))
-
-;; --- KDE ---
-
-;;;###autoload
-(defun browse-url-kde (url &optional new-window)
-  "Ask the KDE WWW browser to load URL.
-Default to the URL around or before point."
-  (interactive (browse-url-interactive-arg "KDE URL: "))
-  (message "Sending URL to KDE...")
-  (apply #'start-process `(,(concat "KDE" url) nil ,browse-url-kde-program
-			   ,@browse-url-kde-args ,url)))
-
-(defalias 'browse-url-kfm 'browse-url-kde) ;; XEmacs backwards compatibility
-
-;; --- Opera ---
-
-;;;###autoload
-(defun browse-url-opera (url &optional new-window)
-  "Ask the Opera WWW browser to load URL.
-Default to the URL around or before point.  The strings in variable
-`browse-url-opera-arguments' are also passed to Opera.
-
-When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new Opera window, otherwise use an
-existing one.  A non-nil interactive prefix argument reverses the
-effect of `browse-url-new-window-flag'.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of `browse-url-new-window-flag'."
-  (interactive (browse-url-interactive-arg "URL: "))
-  ;; URL encode any `confusing' characters in the URL.  This needs to
-  ;; include at least commas; presumably also close parens.
-  (while (string-match "[,)]" url)
-    (setq url (replace-match
-	       (format "%%%x" (string-to-char (match-string 0 url))) t t url)))
-  (let* ((process-environment (browse-url-process-environment))
-         (process (apply 'start-process
-			 (concat "opera " url) nil
-			 browse-url-opera-program
-			 (append
-			  browse-url-opera-arguments
-			  (list "-remote"
-				(concat "openURL("
-					url
-					(if new-window ",new-window")
-					")"))))))
-    (set-process-sentinel process
-			  `(lambda (process change)
-			     (browse-url-opera-sentinel process ,url)))))
-
-(defun browse-url-opera-sentinel (process url)
-  "Handle a change to the process communicating with Opera."
-  (or (eq (process-exit-status process) 0)
-      (let* ((process-environment (browse-url-process-environment)))
-	;; Opera is not running - start it
-	(message "Starting Opera...")
-	(apply 'start-process (concat "opera " url) nil
-	       browse-url-opera-program
-	       (append browse-url-opera-startup-arguments (list url))))))
-
-(provide 'browse-url)
-
-;;; browse-url.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/custom-load.el b/xemacs-packages/lisp/mail-lib/custom-load.el
deleted file mode 100644
index 341b4538..00000000
--- a/xemacs-packages/lisp/mail-lib/custom-load.el
+++ /dev/null
@@ -1,25 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'message '("sendmail"))
-(custom-add-loads 'starttls '("starttls"))
-(custom-add-loads 'mail-abbrevs '("mail-abbrevs"))
-(custom-add-loads 'tls '("tls"))
-(custom-add-loads 'mail '("mail-utils" "highlight-headers" "mail-abbrevs" "mail-extr" "rmail-mini" "sendmail" "smtpmail" "starttls"))
-(custom-add-loads 'rmail-reply '("rmail-mini"))
-(custom-add-loads 'hypermedia '("browse-url"))
-(custom-add-loads 'highlight-headers-faces '("highlight-headers"))
-(custom-add-loads 'comm '("tls"))
-(custom-add-loads 'smtpmail '("smtpmail"))
-(custom-add-loads 'faces '("highlight-headers"))
-(custom-add-loads 'browse-url '("browse-url"))
-(custom-add-loads 'news '("highlight-headers"))
-(custom-add-loads 'highlight-headers '("highlight-headers"))
-(custom-add-loads 'sendmail '("sendmail"))
-(custom-add-loads 'rmail '("rmail-mini"))
-(custom-add-loads 'mail-extr '("mail-extr"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/highlight-headers.el b/xemacs-packages/lisp/mail-lib/highlight-headers.el
deleted file mode 100644
index 04f2534f..00000000
--- a/xemacs-packages/lisp/mail-lib/highlight-headers.el
+++ /dev/null
@@ -1,556 +0,0 @@
-;;; highlight-headers.el --- highlighting message headers.
-
-;; Copyright (C) 1992, 1993, 1994, 1995, 2002 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Tinker Systems
-
-;; Keywords: mail, news
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;; This code is shared by RMAIL and VM.
-;;
-;; Faces:
-;;
-;; message-headers			the part before the colon
-;; message-header-contents		the part after the colon
-;; message-highlighted-header-contents	contents of "special" headers
-;; message-cited-text			quoted text from other messages
-;;
-;; Variables:
-;;
-;; highlight-headers-regexp			what makes a "special" header
-;; highlight-headers-citation-regexp		matches lines of quoted text
-;; highlight-headers-citation-header-regexp	matches headers for quoted text
-
-(defgroup highlight-headers nil
-  "Fancify rfc822 documents."
-  :group 'mail
-  :group 'news)
-
-(defgroup highlight-headers-faces nil
-  "Faces of highlighted headers."
-  :group 'highlight-headers
-  :group 'faces)
-
-(defface message-headers '((t (:bold t)))
-  "Face used for header part before colon."
-  :group 'highlight-headers-faces)
-
-(defface message-header-contents '((t (:italic t)))
-  "Face used for header part after colon."
-  :group 'highlight-headers-faces)
-
-(defface message-highlighted-header-contents '((t (:italic t :bold t)))
-  "Face used for contents of \"special\" headers."
-  :group 'highlight-headers-faces)
-
-(defface message-cited-text '((t (:italic t)))
-  "Face used for cited text."
-  :group 'highlight-headers-faces)
-
-(defface message-url '((t (:bold t)))
-  "Face used for URLs."
-  :group 'highlight-headers-faces)
-
-(defface x-face '((t (:background "white" :foreground "black")))
-  "Face used for X-Face icon."
-  :group 'highlight-headers-faces)
-
-;;(condition-case nil
-;;    (face-name 'message-addresses)
-;;  (wrong-type-argument
-;;   (make-face 'message-addresses)
-;;   (or (face-differs-from-default-p 'message-addresses)
-;;       (progn
-;;	 (copy-face 'bold-italic 'message-addresses)
-;;	 (set-face-underline-p 'message-addresses
-;;			       (face-underline-p
-;;				'message-highlighted-header-contents))))))
-
-(defcustom highlight-headers-regexp "Subject[ \t]*:"
-  "*The headers whose contents should be emphasized more.
-The contents of these headers will be displayed in the face 
-`message-highlighted-header-contents' instead of `message-header-contents'."
-  :type 'regexp
-  :group 'highlight-headers)
-
-(defcustom highlight-headers-citation-regexp
-  (concat "^\\("
-	  (mapconcat 'identity
-	   '("[ \t]*[a-zA-Z0-9_]+>+"	; supercite
-	     "[ \t]*[>]+"		; ">" with leading spaces
-	     "[]}<>|:]+[ \t]*"		; other chars, no leading space
-	     )
-	   "\\|")
-	  "\\)[ \t]*")
-  "*The pattern to match cited text.
-Text in the body of a message which matches this will be displayed in
-the face `message-cited-text'."
-  :type 'regexp
-  :group 'highlight-headers)
-
-(defcustom highlight-headers-citation-header-regexp
-  (concat "^In article\\|^In message\\|"
-	  "^[^ \t].*\\(writes\\|wrote\\|said\\):\n"
-	  (substring highlight-headers-citation-regexp 1))
-  "*The pattern to match the prolog of a cited block.
-Text in the body of a message which matches this will be displayed in
-the `message-headers' face."
-  :type 'regexp
-  :group 'highlight-headers)
-
-(defcustom highlight-headers-highlight-citation-too nil
-  "*Whether the whole citation line should go in the `message-cited-text' face.
-If nil, the text matched by `highlight-headers-citation-regexp' is in the
-default face, and the remainder of the line is in the message-cited-text face."
-  :type 'boolean
-  :group 'highlight-headers)
-
-(defcustom highlight-headers-max-message-size 10000
-  "*If the message body is larger than this many chars, don't highlight it.
-This is to prevent us from wasting time trying to fontify things like
-uuencoded files and large digests.  If this is nil, all messages will
-be highlighted."
-  :type '(choice integer
-		 (const :tag "Highlight All" nil))
-  :group 'highlight-headers)
-
-(defcustom highlight-headers-hack-x-face-p (featurep 'xface)
-  "*If true, then the bitmap in an X-Face header will be displayed
-in the buffer.  This assumes you have the `uncompface' and `icontopbm'
-programs on your path."
-  :type 'boolean
-  :group 'highlight-headers)
-
-(defcustom highlight-headers-convert-quietly nil
-  "*Non-nil inhibits the message that is normally displayed when external
-filters are used to convert an X-Face header.  This has no effect if
-XEmacs is compiled with internal support for x-faces."
-  :type 'boolean
-  :group 'highlight-headers)
-
-(defcustom highlight-headers-invert-x-face-data nil 
-  "*If true, causes the foreground and background bits in an X-Face
-header to be flipped before the image is displayed. If you use a
-light foreground color on a dark background color, you probably want
-to set this to t. This assumes that you have the `pnminvert' program
-on your path.  This doesn't presently work with internal xface support."
-  :type 'boolean
-  :group 'highlight-headers)
-
-
-;;;###autoload
-(defun highlight-headers (start end hack-sig)
-  "Highlight message headers between start and end.
-Faces used:
-  message-headers			the part before the colon
-  message-header-contents		the part after the colon
-  message-highlighted-header-contents	contents of \"special\" headers
-  message-cited-text			quoted text from other messages
-  message-url				URLs (WWW uniform resource locators)
-
-Variables used:
-
-  highlight-headers-regexp			what makes a \"special\" header
-  highlight-headers-citation-regexp		matches lines of quoted text
-  highlight-headers-citation-header-regexp	matches headers for quoted text
-
-If HACK-SIG is true,then we search backward from END for something that
-looks like the beginning of a signature block, and don't consider that a
-part of the message (this is because signatures are often incorrectly
-interpreted as cited text.)"
-  (if (< end start)
-      (let ((s start)) (setq start end end s)))
-  (let* ((too-big (and highlight-headers-max-message-size
-		       (> (- end start)
-			  highlight-headers-max-message-size)))
-	 (real-end end)
-	 e p hend)
-    ;; delete previous highlighting
-    (map-extents (function (lambda (extent ignore)
-			     (if (extent-property extent 'headers)
-				 (delete-extent extent))
-			     nil))
-		 (current-buffer) start end)
-    (save-excursion
-      (save-restriction
-	(widen)
-	;; take off signature
-	(if (and hack-sig (not too-big))
-	    (save-excursion
-	      (goto-char end)
-	      (if (re-search-backward "\n--+ *\n" start t)
-		  (if (eq (char-after (point)) ?\n)
-		      (setq end (1+ (point)))
-		    (setq end (point))))))
-	(narrow-to-region start end)
-
-	(save-restriction
-	  ;; narrow down to just the headers...
-	  (goto-char start)
-	  ;; If this search fails then the narrowing performed above
-	  ;; is sufficient
-	  (if (re-search-forward "^$" nil t)
-	      (narrow-to-region (point-min) (point)))
-	  (goto-char start)
-	  (while (not (eobp))
-	    (cond
-	     ((looking-at "^\\([^ \t\n:]+[ \t]*:\\) *\\(.*\\(\n[ \t].*\\)*\n\\)")
-	      (setq hend (match-end 0))
-	      (setq e (make-extent (match-beginning 1) (match-end 1)))
-	      (set-extent-face e 'message-headers)
-	      (set-extent-property e 'headers t)
-	      (setq p (match-end 1))
-	      (cond
-	       ((and highlight-headers-hack-x-face-p
-		     (save-match-data (looking-at "^X-Face: *")))
-		;; make the whole header invisible
-		(setq e (make-extent (match-beginning 0) (match-end 0)))
-		(set-extent-property e 'invisible t)
-		(set-extent-property e 'headers t)
-		;; now extract the xface and put it somewhere interesting
-		(let ((xface (highlight-headers-x-face-to-pixmap
-			      (match-beginning 2)
-			      (match-end 2))))
-		  (if (not xface)
-		      nil		; just leave the header invisible if
-					; we can't convert the face for some
-					; reason 
-		    (cond ((save-excursion
-			     (goto-char (point-min))
-			     (save-excursion (re-search-forward "^From: *"
-								nil t)))
-			   (setq e (make-extent (match-end 0)
-						(match-end 0))))
-			  (t
-			   ;; okay, make the beginning of the invisible
-			   ;; move forward to only hide the modem noise...
-			   (set-extent-endpoints e
-						 (match-beginning 2)
-						 (1- (match-end 2)))
-			   ;; kludge: if a zero-length extent exists at the
-			   ;; starting point of an invisible extent, then
-			   ;; it's invisible... even if the invisible extent
-			   ;; is start-open.  
-			   (setq e (make-extent (1- (match-beginning 2))
-						(match-beginning 2)))
-			   ))
-		    (set-extent-property e 'headers t)
-		    (set-extent-end-glyph e xface))
-		  ))
-;;; I don't think this is worth the effort
-;;;           ((looking-at "\\(From\\|Resent-From\\)[ \t]*:")
-;;;            (setq current 'message-highlighted-header-contents)
-;;;            (goto-char (match-end 0))
-;;;            (or (looking-at ".*(\\(.*\\))")
-;;;                (looking-at "\\(.*\\)<")
-;;;                (looking-at "\\(.*\\)[@%]")
-;;;                (looking-at "\\(.*\\)"))
-;;;            (end-of-line)
-;;;            (setq e (make-extent p (match-beginning 1)))
-;;;            (set-extent-face e current)
-;;;            (set-extent-property e 'headers t)
-;;;            (setq e (make-extent (match-beginning 1) (match-end 1)))
-;;;            (set-extent-face e 'message-addresses)
-;;;            (set-extent-property e 'headers t)
-;;;            (setq e (make-extent (match-end 1) (point)))
-;;;            (set-extent-face e current)
-;;;            (set-extent-property e 'headers t)
-;;;            )
-	       ((and highlight-headers-regexp
-		     (save-match-data (looking-at highlight-headers-regexp)))
-		(setq e (make-extent (match-beginning 2) (match-end 2)))
-		(set-extent-face e 'message-highlighted-header-contents)
-		(set-extent-property e 'headers t))
-	       (t
-		(setq e (make-extent (match-beginning 2) (match-end 2)))
-		(set-extent-face e 'message-header-contents)
-		(set-extent-property e 'headers t))
- 	       )
- 	      (goto-char hend))
- 	     ;; ignore non-header field name lines
- 	     (t (forward-line 1)))))
-
-	;; now do the body, unless it's too big....
-	(if too-big
-	    nil
-	  (while (not (eobp))
-	    (cond ((null highlight-headers-citation-regexp)
-		   nil)
-		  ((looking-at highlight-headers-citation-regexp)
-		   (or highlight-headers-highlight-citation-too
-		       (goto-char (match-end 0)))
-		   (or (save-excursion
-			 (beginning-of-line)
-			 (let ((case-fold-search nil)) ; aaaaah, unix...
-			   (looking-at "^>From ")))
-		       (setq current 'message-cited-text)))
-;;;                ((or (looking-at "^In article\\|^In message")
-;;;                     (looking-at
-;;;            "^[^ \t].*\\(writes\\|wrote\\|said\\):\n[ \t]+[A-Z]*[]}<>|]"))
-;;;                 (setq current 'message-headers))
-		  ((null highlight-headers-citation-header-regexp)
-		   nil)
-		  ((looking-at highlight-headers-citation-header-regexp)
-		   (setq current 'message-headers))
-		  (t (setq current nil)))
-	    (cond (current
-		   (setq p (point))
-		   (forward-line 1) ; this is to put the \n in the face too
-		   (setq e (make-extent p (point)))
-		   (forward-char -1)
-		   (set-extent-face e current)
-		   (set-extent-property e 'headers t)
-		   ))
-	    (forward-line 1)))
-	))
-    (save-excursion
-      (save-restriction
-	(widen)
-	(narrow-to-region start real-end)
-	(highlight-headers-mark-urls start real-end)))
-    ))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; X-Face header conversion:
-
-;;; This cache is only used if x-face conversion is done with external
-;;; filters.  If XEmacs is compiled --with-xface, then it's better to
-;;; convert it twice than to suck up memory for a potentially large cache of
-;;; stuff that's not difficult to recreate.
-(defvar highlight-headers-x-face-to-pixmap-cache nil)
-
-(defun highlight-headers-x-face-to-pixmap (start end)
-  (let* ((string (if (stringp start) start (buffer-substring start end)))
-	 (data (assoc string highlight-headers-x-face-to-pixmap-cache)))
-    (if (featurep 'xface)
-	(let ((new-face (make-glyph (concat "X-Face: " string))))
-	  (set-glyph-face new-face 'x-face)
-	  new-face)
-      ;; YUCK this is the old two-external-filters-plus-a-bunch-of-lisp method
-      (if data
-	  (cdr data)
-	(setq data (cons string
-			 (condition-case c
-			     (highlight-headers-parse-x-face-data start end)
-			   (error
-			    (display-error c nil)
-			    (sit-for 2)
-			    nil))))
-	(setq highlight-headers-x-face-to-pixmap-cache
-	      (cons data highlight-headers-x-face-to-pixmap-cache))
-	(cdr data)))
-    ))
-
-;;; Kludge kludge kludge for displaying the bitmap in the X-Face header.
-
-;;; This depends on the following programs: icontopbm, from the pbmplus
-;;; toolkit (available everywhere) and uncompface, which comes with
-;;; several faces-related packages, and can also be had at ftp.clark.net
-;;; in /pub/liebman/compface.tar.Z.  See also xfaces 3.*.  Not needed
-;;; for this, but a very nice xbiff replacment.
-
-(defconst highlight-headers-x-face-bitrev
-  (purecopy
-   (eval-when-compile
-     (let* ((v (make-string 256 0))
-	    (i (1- (length v))))
-       (while (>= i 0)
-	 (let ((j 7)
-	       (k 0))
-	   (while (>= j 0)
-	     (if (/= 0 (logand i (lsh 1 (- 7 j))))
-		 (setq k (logior k (lsh 1 j))))
-	     (setq j (1- j)))
-	   (aset v i k))
-	 (setq i (1- i)))
-       v))))
-
-(defun highlight-headers-parse-x-face-data (start end)
-  (save-excursion
-    (let ((b (current-buffer))
-	  (lines 0)
-	  p)
-      (or highlight-headers-convert-quietly
-	  (message "Converting X-Face header to pixmap ..."))
-      (set-buffer (get-buffer-create " *x-face-tmp*"))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (if (stringp start)
-	  (insert start)
-	(insert-buffer-substring b start end))
-      (while (search-forward "\n" nil t)
-	(skip-chars-backward " \t\n")
-	(setq p (point))
-	(skip-chars-forward " \t\n")
-	(delete-region p (point)))
-      (call-process-region (point-min) (point-max) "uncompface" t t nil)
-      (goto-char (point-min))
-      (while (not (eobp))
-	(or (looking-at "0x....,0x....,0x...., *$")
-	    (error "unexpected uncompface output"))
-	(forward-line 1)
-	(setq lines (1+ lines))
-	(delete-char -1))
-      (goto-char (point-min))
-      (insert (format "/* Format_version=1, Width=%d, Height=%d" lines lines))
-      (insert ", Depth=1, Valid_bits_per_item=16\n */\n")
-      (while (not (eobp))
-	(insert ?\t)
-	(forward-char 56) ; 7 groups per line
-	(insert ?\n))
-      (forward-char -1)
-      (delete-char -1)  ; take off last comma
-      ;;
-      ;; Ok, now we've got the format that "icontopbm" knows about.
-      (call-process-region (point-min) (point-max) "icontopbm" t t nil)
-      ;; Invert the image if the user wants us to...
-      (if highlight-headers-invert-x-face-data
-	  (call-process-region (point-min) (point-max) "pnminvert" t t nil))
-      ;;
-      ;; If PBM is using binary mode, we're winning.
-      (goto-char (point-min))
-      (let ((new-face))
-	(cond ((looking-at "P4\n")
-	       (forward-line 2)
-	       (delete-region (point-min) (point))
-	       (while (not (eobp))
-		 (insert (aref highlight-headers-x-face-bitrev
-			       (following-char)))
-		 (delete-char 1))
-	       (setq new-face (make-glyph
-			       (vector 'xbm :data
-				       (list lines lines (prog1 (buffer-string)
-							   (erase-buffer))))))
-	       (set-glyph-image new-face "[xface]" 'global 'tty)
-	       (set-glyph-face new-face 'x-face))
-	      (t ; fix me
-	       (error "I only understand binary-format PBM...")))
-	(or highlight-headers-convert-quietly
-	    (message "Converting X-Face header to pixmap ... done."))
-	new-face)
-      )))
-
-
-;;; "The Internet's new BBS!" -Boardwatch Magazine
-;;; URL support by jwz@jwz.org
-
-(defcustom highlight-headers-mark-urls (string-match "XEmacs" emacs-version)
-  "*Whether to make URLs clickable in message bodies."
-  :type 'boolean
-  :group 'highlight-headers)
-
-;; We use browse-url for opening the URLs.
-
-(defvar highlight-headers-follow-url-function 'w3-fetch "Not used.")
-(make-obsolete-variable 'highlight-headers-follow-url-function
-			'browse-url-browser-function)
-
-(defvar highlight-headers-follow-url-netscape-auto-raise t "Not used.")
-(make-obsolete-variable
- 'highlight-headers-follow-url-netscape-auto-raise "see `browse-url-netscape'")
-
-(define-obsolete-variable-alias
-  'highlight-headers-follow-url-netscape-new-window
-  'browse-url-new-window-flag)
-
-;;;###autoload
-(define-obsolete-function-alias
-  'highlight-headers-follow-url-netscape 'browse-url-netscape)
-
-;;;###autoload
-(define-obsolete-function-alias
-  'highlight-headers-follow-url-kfm 'browse-url-kde)
-
-;;;###autoload
-(define-obsolete-function-alias
-  'highlight-headers-follow-url-mosaic 'browse-url-mosaic)
-
-(defvar highlight-headers-url-keymap
-  (let ((m (make-sparse-keymap)))
-    (set-keymap-name m 'highlight-headers-url-keymap)
-    (if (string-match "XEmacs" emacs-version)
-	(progn
-	  (define-key m 'button2 'highlight-headers-follow-url)
-	  ))
-    m))
-
-;;;###autoload
-(defun highlight-headers-follow-url (event)
-  (interactive "e")
-  (let* ((p (event-point event))
-	 (buffer (window-buffer (event-window event)))
-	 (extent (and p (extent-at p buffer 'highlight)))
-	 (url (and extent
-		   (save-excursion
-		     (set-buffer buffer)
-		     (buffer-substring (extent-start-position extent)
-				       (extent-end-position extent))))))
-    (if (and url (string-match "\\`<\\([^>]+\\)>\\'" url))
-	(setq url (concat "news:"
-			  (substring url (match-beginning 1) (match-end 1)))))
-    (if url
-	(browse-url url)
-      (beep))))
-
-
-(defconst highlight-headers-url-pattern
-  (concat
-   "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|s?news\\|telnet\\|mailbox\\):"
-	  "\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?"
-	  "[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]+"
-	  ))
-
-(defun highlight-headers-mark-urls (start end)
-  (cond
-   (highlight-headers-mark-urls
-    (save-excursion
-      (goto-char start)
-      (while (re-search-forward highlight-headers-url-pattern nil t)
-	(let ((s (match-beginning 0))
-	      e
-	      extent)
-	  (goto-char (match-end 0))
-	  ;(skip-chars-forward "^ \t\n\r")
-	  (skip-chars-backward ".?#!*()")
-	  (setq e (point))
-	  (setq extent (make-extent s e))
-	  (set-extent-face extent 'bold)
-	  (set-extent-property extent 'highlight t)
-	  (set-extent-property extent 'headers t)
-	  (set-extent-property extent 'keymap highlight-headers-url-keymap)
-	  ))
-
-      (goto-char start)
-      (while (re-search-forward "^Message-ID: \\(<[^>\n]+>\\)" nil t)
-	(let ((s (match-beginning 1))
-	      (e (match-end 1))
-	      extent)
-	  (setq extent (make-extent s e))
-	  (set-extent-face extent 'message-url)
-	  (set-extent-property extent 'highlight t)
-	  (set-extent-property extent 'headers t)
-	  (set-extent-property extent 'keymap highlight-headers-url-keymap)))
-      ))))
-
-
-(provide 'highlight-headers)
diff --git a/xemacs-packages/lisp/mail-lib/mail-abbrevs.el b/xemacs-packages/lisp/mail-lib/mail-abbrevs.el
deleted file mode 100644
index f3e59b45..00000000
--- a/xemacs-packages/lisp/mail-lib/mail-abbrevs.el
+++ /dev/null
@@ -1,649 +0,0 @@
-;;; mail-abbrev.el --- Abbrev-expansion of mail aliases.
-
-;;; Copyright (C) 1985-1994 Free Software Foundation, Inc.
-
-;; Created: 19 oct 90, Jamie Zawinski 
-;; Modified: 5 apr 92, Roland McGrath 
-;; Maintainer: XEmacs Development Team
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with:  Not synched.
-
-;;; Commentary:
-
-;; This file ensures that, when the point is in a To:, CC:, BCC:, or From: 
-;; field, word-abbrevs are defined for each of your mail aliases.  These
-;; aliases will be defined from your .mailrc file (or the file specified by
-;; the MAILRC environment variable) if it exists.  Your mail aliases will
-;; expand any time you type a word-delimiter at the end of an abbreviation.
-
-;; What you see is what you get: no abbreviations will be expanded after you
-;; have sent the mail, unlike the old system.  This means you don't suffer
-;; the annoyance of having the system do things behind your back -- if an
-;; address you typed is going to be rewritten, you know it immediately,
-;; instead of after the mail has been sent and it's too late to do anything
-;; about it.  You will never again be screwed because you forgot to delete an
-;; old alias from your .mailrc when a new local user arrives and is given a
-;; userid which conflicts with one of your aliases, for example.
-
-;; Your mail alias abbrevs will be in effect only when the point is in an
-;; appropriate header field.  When in the body of the message, or other
-;; header fields, the mail aliases will not expand.  Rather, the normal
-;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if 
-;; defined.  So if you use mail-mode specific abbrevs, this code will not
-;; adversely affect you.  You can control which header fields the abbrevs
-;; are used in by changing the variable mail-abbrev-mode-regexp.
-
-;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word
-;; boundaries; also, header continuation-lines will be properly indented.
-
-;; You can also insert a mail alias with mail-interactive-insert-alias
-;; (bound to C-c C-a), which prompts you for an alias (with completion)
-;; and inserts its expansion at point.
-
-;; This file fixes a bug in the old system which prohibited your .mailrc
-;; file from having lines like
-
-;;     alias someone "John Doe "
-
-;; That is, if you want an address to have embedded spaces, simply surround it
-;; with quotes.  This is necessary because the format of the .mailrc file
-;; bogusly uses spaces as address delimiters.  The following line defines an
-;; alias which expands to three addresses:
-
-;;     alias foobar addr-1 addr-2 "address three "
-
-;; (This is bogus because mail-delivery programs want commas, not spaces,
-;; but that's what the file format is, so we have to live with it.)
-
-;; If you like, you can call the function define-mail-alias to define your
-;; mail-aliases instead of using a .mailrc file.  When you call it in this
-;; way, addresses are separated by commas.
-
-;; CAVEAT: This works on most Sun systems; I have been told that some versions
-;; of /bin/mail do not understand double-quotes in the .mailrc file.  So you
-;; should make sure your version does before including verbose addresses like
-;; this.  One solution to this, if you are on a system whose /bin/mail doesn't
-;; work that way, (and you still want to be able to /bin/mail to send mail in
-;; addition to emacs) is to define minimal aliases (without full names) in
-;; your .mailrc file, and use define-mail-alias to redefine them when sending
-;; mail from emacs; this way, mail sent from /bin/mail will work, and mail
-;; sent from emacs will be pretty.
-
-;; Aliases in the mailrc file may be nested.  If you define aliases like
-;;     alias group1 fred ethel
-;;     alias group2 larry curly moe
-;;     alias everybody group1 group2
-;; Then when you type "everybody" on the To: line, it will be expanded to
-;;     fred, ethyl, larry, curly, moe
-
-;; Aliases may also contain forward references; the alias of "everybody" can
-;; precede the aliases of "group1" and "group2".
-
-;; This code also understands the "source" .mailrc command, for reading
-;; aliases from some other file as well.
-
-;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs
-;; normally cannot contain hyphens, but this code works around that for the
-;; specific case of mail-alias word-abbrevs.
-
-;; To read in the contents of another .mailrc-type file from emacs, use the
-;; command Meta-X merge-mail-aliases.  The rebuild-mail-aliases command is
-;; similar, but will delete existing aliases first.
-
-;; If you want multiple addresses separated by a string other than ", " then
-;; you can set the variable mail-alias-separator-string to it.  This has to
-;; be a comma bracketed by whitespace if you want any kind of reasonable
-;; behaviour.
-
-;; Some versions of /bin/mail append the contents of multiple definitions of
-;; the same alias together, so that
-;;     alias group one two three
-;;     alias group four five
-;; would define "group" as "one two three four five" instead of "four five".
-;; This code does *not* support that syntax, because it's a horrible syntax
-;; and isn't worth the effort or added code complexity.  (So there.)
-;;
-;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, Noah
-;; Friedman, and Michelangelo Grigni for suggestions and bug reports.
-
-
-;;; Code:
-
-(require 'sendmail)
-
-(defgroup mail-abbrevs nil
-  "Mail abbreviation (addressbook)"
-  :group 'mail)
-
-;;;###autoload
-(defcustom mail-abbrev-mailrc-file nil
-  "Name of file with mail aliases.   If nil, ~/.mailrc is used."
-  :type '(choice (const :tag "Default" nil)
-		 file)
-  :group 'mail-abbrevs)
-
-;;;###autoload
-(defun mail-abbrev-mailrc-file ()
-  (or mail-abbrev-mailrc-file
-      (setq mail-abbrev-mailrc-file
-	    (or (getenv "MAILRC") "~/.mailrc"))))
-
-;; originally defined in sendmail.el - used to be an alist, now is a table.
-;;;###autoload
-(defvar mail-aliases nil
-  "Word-abbrev table of mail address aliases.
-If this is nil, it means the aliases have not yet been initialized and
-should be read from the .mailrc file.  (This is distinct from there being
-no aliases, which is represented by this being a table with no entries.)")
-
-;;;###autoload
-(defun mail-aliases-setup ()
-  (if (and (not (vectorp mail-aliases))
-	   (file-exists-p (mail-abbrev-mailrc-file)))
-      (build-mail-aliases))
-  (make-local-variable 'pre-abbrev-expand-hook)
-  (setq pre-abbrev-expand-hook
-    (cond ((and (listp pre-abbrev-expand-hook)
-		(not (eq 'lambda (car pre-abbrev-expand-hook))))
-	   (cons 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook))
-	  (t
-	   (list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook))))
-  (abbrev-mode 1))
-
-;;;###autoload
-(defun build-mail-aliases (&optional file recursivep)
-  "Read mail aliases from .mailrc and set mail-aliases."
-  (setq file (expand-file-name (or file (mail-abbrev-mailrc-file))))
-  (or (vectorp mail-aliases)
-      (setq mail-aliases (make-abbrev-table)))
-  (message "Parsing %s..." file)
-  (let ((buffer nil)
-	(obuf (current-buffer)))
-    (unwind-protect
-	(progn
-	  (setq buffer (generate-new-buffer "mailrc"))
-	  (buffer-disable-undo buffer)
-	  (set-buffer buffer)
-	  (cond ((get-file-buffer file)
-		 (insert (save-excursion
-			   (set-buffer (get-file-buffer file))
-			   (buffer-substring (point-min) (point-max)))))
-		((not (file-exists-p file)))
-		(t (insert-file-contents file)))
-	  ;; Don't lose if no final newline.
-	  (goto-char (point-max))
-	  (or (eq (preceding-char) ?\n) (newline))
-	  (goto-char (point-min))
-	  ;; Delete comments from the file
-	  (while (search-forward "# " nil t)
-	    (let ((p (- (point) 2)))
-	      (end-of-line)
-	      (delete-region p (point))))
-	  (goto-char (point-min))
-	  ;; handle "\\\n" continuation lines
-	  (while (not (eobp))
-	    (end-of-line)
-	    (if (= (preceding-char) ?\\)
-		(progn (delete-char -1) (delete-char 1) (insert ?\ ))
-	        (forward-char 1)))
-	  (goto-char (point-min))
-	  (while (re-search-forward
-		  "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t)
-	    (beginning-of-line)
-	    (if (looking-at "source[ \t]+\\([^ \t\n]+\\)")
-		(progn
-		  (end-of-line)
-		  (build-mail-aliases
-		   (substitute-in-file-name
-		    (buffer-substring (match-beginning 1) (match-end 1)))
-		   t))
-	      (re-search-forward "[ \t]+\\([^ \t\n]+\\)")
-	      (let* ((name (buffer-substring
-			    (match-beginning 1) (match-end 1)))
-		     (start (progn (skip-chars-forward " \t") (point))))
-		(end-of-line)
-;		(message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1)
-		(define-mail-alias
-		    name
-		    (buffer-substring start (point))
-		    t))))
-	  ;; Resolve forward references in .mailrc file.
-	  ;; This would happen automatically before the first abbrev was
-	  ;; expanded, but why not do it now.
-	  (or recursivep (mail-resolve-all-aliases))
-	  )
-      (if buffer (kill-buffer buffer))
-      (set-buffer obuf)))
-    (message "Parsing %s... done" file)
-    ;; Bob Weiner, Altrasoft, 12/10/96: Return nil so can be
-    ;; used as a local-write-file-hook in ~/.mailrc.
-    nil)
-
-(defcustom mail-alias-separator-string ", "
-  "*A string inserted between addresses in multi-address mail aliases.
-This has to contain a comma, so \", \" is a reasonable value.  You might 
-also want something like \",\\n    \" to get each address on its own line."
-  :type 'string
-  :group 'mail-abbrevs)
-
-;; define-mail-alias sets this flag, which causes mail-resolve-all-aliases
-;; to be called before expanding abbrevs if it's necessary.
-(defvar mail-abbrev-aliases-need-to-be-resolved t)
-
-;; originally defined in mailalias.el ; build-mail-aliases calls this with
-;; stuff parsed from the .mailrc file.
-;;
-;;;###autoload
-(defun define-mail-alias (name definition &optional from-mailrc-file)
-  "Define NAME as a mail-alias that translates to DEFINITION.
-If DEFINITION contains multiple addresses, separate them with commas."
-  ;; When this is called from build-mail-aliases, the third argument is
-  ;; true, and we do some evil space->comma hacking like /bin/mail does.
-  (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
-  ;; Read the defaults first, if we have not done so.
-  (if (vectorp mail-aliases)
-      nil
-    (setq mail-aliases (make-abbrev-table))
-    (if (file-exists-p (mail-abbrev-mailrc-file))
-	(build-mail-aliases)))
-  ;; strip garbage from front and end
-  (if (string-match "\\`[ \t\n,]+" definition)
-      (setq definition (substring definition (match-end 0))))
-  (if (string-match "[ \t\n,]+\\'" definition)
-      (setq definition (substring definition 0 (match-beginning 0))))
-  (let ((result '())
-	(start 0)
-	(L (length definition))
-	end)
-    (while start
-      ;; If we're reading from the mailrc file, then addresses are delimited
-      ;; by spaces, and addresses with embedded spaces must be surrounded by
-      ;; single or double-quotes.  Otherwise, addresses are separated by
-      ;; commas.
-      (if from-mailrc-file
-	  (cond ((eq ?\" (aref definition start))
-		 (setq start (1+ start)
-		       end (string-match "\"[ \t,]*" definition start)))
-		((eq ?\' (aref definition start))
-		 (setq start (1+ start)
-		       end (string-match "\'[ \t,]*" definition start)))
-		(t
-		 (setq end (string-match "[ \t,]+" definition start))))
-	(setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
-      (setq result (cons (substring definition start end) result))
-      (setq start (and end
-		       (/= (match-end 0) L)
-		       (match-end 0))))
-    (setq definition (mapconcat (function identity)
-				(nreverse result)
-				mail-alias-separator-string)))
-  (setq mail-abbrev-aliases-need-to-be-resolved t)
-  (setq name (downcase name))
-  ;; use an abbrev table instead of an alist for mail-aliases.
-  (let ((abbrevs-changed abbrevs-changed))  ; protect this from being changed.
-    (define-abbrev mail-aliases name definition 'mail-abbrev-expand-hook)))
-
-
-(defun mail-resolve-all-aliases ()
-  "Resolve all forward references in the mail aliases table."
-  (if mail-abbrev-aliases-need-to-be-resolved
-      (progn
-;;	(message "Resolving mail aliases...")
-	(if (vectorp mail-aliases)
-	    (mapatoms (function mail-resolve-all-aliases-1) mail-aliases))
-	(setq mail-abbrev-aliases-need-to-be-resolved nil)
-;;	(message "Resolving mail aliases... done.")
-	)))
-
-(defun mail-resolve-all-aliases-1 (sym &optional so-far)
-  (if (memq sym so-far)
-      (error "mail alias loop detected: %s"
-	     (mapconcat 'symbol-name (cons sym so-far) " <- ")))
-  (let ((definition (and (boundp sym) (symbol-value sym))))
-    (if definition
-	(let ((result '())
-	      (start 0))
-	  (while start
-	    (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start)))
-	      (setq result (cons (substring definition start end) result)
-		    start (and end (match-end 0)))))
-	  (setq definition
-		(mapconcat (function (lambda (x)
-			     (or (mail-resolve-all-aliases-1
-				   (intern-soft (downcase x) mail-aliases)
-				   (cons sym so-far))
-				 x)))
-			   (nreverse result)
-			   mail-alias-separator-string))
-	  (set sym definition))))
-  (symbol-value sym))
-
-
-(defun mail-abbrev-expand-hook ()
-  "For use as the fourth arg to define-abbrev.
-After expanding a mail-abbrev, if fill-mode is on and we're past the
-fill-column, break the line at the previous comma, and indent the next
-line."
-  (save-excursion
-    (let ((p (point))
-	  bol comma fp)
-      (beginning-of-line)
-      (setq bol (point))
-      (goto-char p)
-      (while (and auto-fill-function
-		  (>= (current-column) fill-column)
-		  (search-backward "," bol t))
-	(setq comma (point))
-	(forward-char 1)		; Now we are just past the comma.
-	(insert "\n")
-	(delete-horizontal-space)
- 	(setq p (point))
-	;; Prevent abbrev expansion from happening again, since
-	;; sendmail-pre-abbrev-expand-hook will already have done it.
-	(let ((abbrev-mode nil))
-	  (indent-relative))
-	(setq fp (buffer-substring p (point)))
-	;; Go to the end of the new line.
-	(end-of-line)
-	(if (> (current-column) fill-column)
-	    ;; It's still too long; do normal auto-fill.
-	    (let ((fill-prefix (or fp "\t")))
-	      (do-auto-fill)))
-	;; Resume the search.
-	(goto-char comma)
-	))))
-
-;;; Syntax tables and abbrev-expansion
-
-(defcustom mail-abbrev-mode-regexp
-  "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):"
-  "*Regexp to select mail-headers in which mail aliases should be expanded.
-This string it will be handed to `looking-at' with the point at the beginning
-of the current line; if it matches, abbrev mode will be turned on, otherwise
-it will be turned off.  (You don't need to worry about continuation lines.)
-This should be set to match those mail fields in which you want abbreviations
-turned on."
-  :type 'regexp
-  :group 'mail-abbrevs)
-
-(defcustom mail-rename-buffer-regexp
-  "^\\(?:Resent-\\)?\\To:[ \t]*\\(.+\\)"
-  "*Regexp to select mail-headers which should be used to automatically set
-the name of the mail composition buffer.  Set this to an empty string to disable
-auto-renaming."
-  :type 'regexp
-  :group 'mail-abbrevs)
-
-(defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table)
-  "The syntax table which is used in send-mail mode message bodies.")
-
-(defvar mail-mode-header-syntax-table
-  (let ((tab (copy-syntax-table text-mode-syntax-table)))
-    ;; This makes the characters "@%!._-" be considered symbol-consituents
-    ;; but not word-constituents, so forward-sexp will move you over an
-    ;; entire address, but forward-word will only move you over a sequence
-    ;; of alphanumerics.  (Clearly the right thing.)
-    (modify-syntax-entry ?@ "_" tab)
-    (modify-syntax-entry ?% "_" tab)
-    (modify-syntax-entry ?! "_" tab)
-    (modify-syntax-entry ?. "_" tab)
-    (modify-syntax-entry ?_ "_" tab)
-    (modify-syntax-entry ?- "_" tab)
-    (modify-syntax-entry ?< "(>" tab)
-    (modify-syntax-entry ?> ")<" tab)
-    tab)
-  "The syntax table used in send-mail mode when in a mail-address header.
-mail-mode-syntax-table is used when the cursor is in the message body or in
-non-address headers.")
-
-(defvar mail-abbrev-syntax-table
-  (let ((tab (copy-syntax-table mail-mode-header-syntax-table)))
-    (if (vectorp tab)
-	(let ((i (1- (length tab)))
-	      (_ (aref (standard-syntax-table) ?_))
-	      (w (aref (standard-syntax-table) ?w)))
-	  (while (>= i 0)
-	    (if (= (aref tab i) _) (aset tab i w))
-	    (setq i (1- i))))
-      (map-syntax-table
-       #'(lambda (key val)
-	   (if (eq (char-syntax-from-code val) ?_)
-	       (put-char-table key (set-char-syntax-in-code val ?w) tab)
-	       ))
-       tab))
-    tab)
-  "The syntax-table used for abbrev-expansion purposes; this is not actually
-made the current syntax table of the buffer, but simply controls the set of
-characters which may be a part of the name of a mail-alias.")
-
-
-(defun mail-abbrev-in-expansion-header-p ()
-  "Whether point is in a mail-address header field."
-  (let ((case-fold-search t))
-    (and ;;
-         ;; we are on an appropriate header line...
-     (save-excursion
-       (beginning-of-line)
-       ;; skip backwards over continuation lines.
-       (while (and (looking-at "^[ \t]")
-		   (not (= (point) (point-min))))
-	 (forward-line -1))
-       ;; are we at the front of an appropriate header line?
-       (looking-at mail-abbrev-mode-regexp))
-     ;;
-     ;; ...and we are before the mail-header-separator
-     (< (point)
-	(save-excursion
-	  (goto-char (point-min))
-	  (search-forward (concat "\n" mail-header-separator "\n")
-			  nil 0)
-	  (point))))))
-
-(defvar mail-mode-abbrev-table) ; quiet the compiler
-(defvar message-mode-map) ; quiet the compiler
-
-(defun mail-maybe-rename-buffer ()
-  (let ((case-fold-search t))
-    (and ;; user has not disabled this feature...
-     (not (string-equal mail-rename-buffer-regexp ""))
-         ;; ... and we are before the mail-header-separator...
-     (< (point)
-	(save-excursion
-	  (goto-char (point-min))
-	  (search-forward (concat "\n" mail-header-separator "\n")
-			  nil 0)
-	  (point)))
-     ;; ... and we are on an appropriate header line
-     (save-excursion
-       (beginning-of-line)
-       ;; skip backwards over continuation lines.
-       (while (and (looking-at "^[ \t]")
-		   (not (= (point) (point-min))))
-	 (forward-line -1))
-       (looking-at mail-rename-buffer-regexp))
-     (rename-buffer (concat "mail to " (match-string 1)) t))))
-
-(defun sendmail-pre-abbrev-expand-hook ()
-  (if mail-abbrev-aliases-need-to-be-resolved
-      (mail-resolve-all-aliases))
-  (if (and mail-aliases (not (eq mail-aliases t)))
-      (if (not (mail-abbrev-in-expansion-header-p))
-	  ;;
-	  ;; If we're not in a mail header in which mail aliases should
-	  ;; be expanded, then use the normal mail-mode abbrev table (if any)
-	  ;; and the normal mail-mode syntax table.
-	  ;;
-	  (progn
-	    (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table)
-					  mail-mode-abbrev-table))
-	    (set-syntax-table mail-mode-syntax-table))
-	;;
-	;; Otherwise, we are in a To: (or CC:, or whatever) header, and
-	;; should use word-abbrevs to expand mail aliases.
-	;;   -  First, install the mail-aliases as the word-abbrev table.
-	;;   -  Then install the mail-abbrev-syntax-table, which temporarily
-	;;      marks all of the non-alphanumeric-atom-characters (the "_"
-	;;      syntax ones) as being normal word-syntax.  We do this because
-	;;      the C code for expand-abbrev only works on words, and we want
-	;;      these characters to be considered words for the purpose of
-	;;      abbrev expansion.
-	;;   -  Then we call expand-abbrev again, recursively, to do the abbrev
-	;;      expansion with the above syntax table.
-	;;   -  Then we do a trick which tells the expand-abbrev frame which
-	;;      invoked us to not continue (and thus not expand twice.)
-	;;      This means that any abbrev expansion will happen as a result
-	;;      of this function's call to expand-abbrev, and not as a result
-	;;      of the call to expand-abbrev which invoked *us*.
-	;;   -  Then we set the syntax table to mail-mode-header-syntax-table,
-	;;      which doesn't have anything to do with abbrev expansion, but
-	;;      is just for the user's convenience (see its doc string.)
-	;;
-	(mail-maybe-rename-buffer)
-	(setq local-abbrev-table mail-aliases)
-	;; If the character just typed was non-alpha-symbol-syntax, then don't
-	;; expand the abbrev now (that is, don't expand when the user types -.)
-	;; Check the character's syntax in the mail-mode-header-syntax-table.
-	(set-syntax-table mail-mode-header-syntax-table)
-	(or (and last-command-char
-		 (eq (char-syntax last-command-char) ?_))
-	    (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
-	      ;; Use this table so that abbrevs can have hyphens in them.
-	      (set-syntax-table mail-abbrev-syntax-table)
-	      (expand-abbrev)
-	      ;; Now set it back to what it was before.
-	      (set-syntax-table mail-mode-header-syntax-table)))
-	(setq abbrev-start-location (point)  ; This is the trick.
-	      abbrev-start-location-buffer (current-buffer))
-	)))
-
-;;; Reading addresses from the minibuffer; by David Hughes 
-
-(defun mail-abbrev-minibuffer-setup-hook ()
-  ;; Use as the value of minibuffer-setup-hook when reading addresses
-  ;; from the minibuffer, as in:
-  ;;  (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
-  ;;    (read-string "Who: "))
-  (if (and (not (vectorp mail-aliases))
-	   (file-exists-p (mail-abbrev-mailrc-file)))
-      (build-mail-aliases))
-  (make-local-variable 'pre-abbrev-expand-hook)
-  (setq pre-abbrev-expand-hook
-	(function
-	 (lambda ()
-	   (setq local-abbrev-table mail-aliases)
-	   (set-syntax-table mail-mode-header-syntax-table)
-	   (or (and last-command-char
-		    (eq (char-syntax last-command-char) ?_))
-	       (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
-		 ;; Use this table so that abbrevs can have hyphens in them.
-		 (set-syntax-table mail-abbrev-syntax-table)
-		 (expand-abbrev)
-		 ;; Now set it back to what it was before.
-		 (set-syntax-table mail-mode-header-syntax-table)))
-	   (setq abbrev-start-location (point)  ; This is the trick.
-		 abbrev-start-location-buffer (current-buffer)))))
-  (abbrev-mode 1))
-
-
-;;; utilities
-
-(defun merge-mail-aliases (file)
-  "Merge mail aliases from the given file with existing ones."
-  (interactive (list
-		(let ((insert-default-directory t)
-		      (default-directory (expand-file-name "~/"))
-		      (def (mail-abbrev-mailrc-file)))
-		  (read-file-name
-		    (format "Read additional aliases from file: (default %s) "
-			    def)
-		    default-directory
-		    (expand-file-name def default-directory)
-		    t))))
-  (build-mail-aliases file))
-
-(defun rebuild-mail-aliases (file)
-  "Rebuild all the mail aliases from the given file."
-  (interactive (list
-		(let ((insert-default-directory t)
-		      (default-directory (expand-file-name "~/"))
-		      (def (mail-abbrev-mailrc-file)))
-		  (read-file-name
-		   (format "Read mail aliases from file: (default %s) " def)
-		   default-directory
-		   (expand-file-name def default-directory)
-		   t))))
-  (setq mail-aliases nil)
-  (build-mail-aliases file))
-
-(defun mail-interactive-insert-alias (&optional alias)
-  "Prompt for and insert a mail alias."
-  (interactive (progn
-		(if (not (vectorp mail-aliases)) (mail-aliases-setup))
-		(list (completing-read "Expand alias: " mail-aliases nil t))))
-  (if (not (vectorp mail-aliases)) (mail-aliases-setup))
-  (insert (or (and alias (symbol-value (intern-soft alias mail-aliases))) "")))
-
-(defun abbrev-hacking-next-line (&optional arg)
-  "Just like `next-line' (\\\\[next-line]) but expands abbrevs \
-when at end of line."
-  (interactive "_p")
-  (if (and (looking-at "[ \t]*\n")
-	   (= (char-syntax (preceding-char)) ?w))
-      (expand-abbrev))
-  (next-line (or arg 1)))
-
-(defun abbrev-hacking-end-of-buffer (&optional arg)
-  "Just like `end-of-buffer' (\\\\[end-of-buffer]) but expands \
-abbrevs when at end of buffer."
-  (interactive "_P")
-  (if (and (looking-at "[ \t]*\n")
-	   (= (char-syntax (preceding-char)) ?w))
-      (expand-abbrev))
-  (end-of-buffer arg))
-
-(defun mail-abbrev-init-keys (keymap)
-  "Initialize Mail Abbrevs for the given keymap."
-
-  (define-key keymap "\C-c\C-a" 'mail-interactive-insert-alias)
-
-  ;;(define-key mail-mode-map "\C-n" 'abbrev-hacking-next-line)
-  ;;(define-key mail-mode-map "\M->" 'abbrev-hacking-end-of-buffer)
-  (let ((subst '((next-line . abbrev-hacking-next-line)
-		 (fkey-next-line . abbrev-hacking-next-line)
-		 (end-of-buffer . abbrev-hacking-end-of-buffer)
-		 (fkey-end-of-buffer . abbrev-hacking-end-of-buffer)
-		 )))
-    (while subst
-      (let ((keys
-	     (delq nil
-		   (nconc (where-is-internal (car (car subst)) keymap)
-			  (where-is-internal (car (car subst)))))))
-	(while keys
-	  (define-key keymap (car keys) (cdr (car subst)))
-	  (pop keys)))
-      (pop subst))))
-
-(mail-abbrev-init-keys mail-mode-map)
-(when (boundp 'message-mode-map)
-  (mail-abbrev-init-keys message-mode-map))
-
-(provide 'mail-abbrevs)
-
-;;; mail-abbrevs.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/mail-extr.el b/xemacs-packages/lisp/mail-lib/mail-extr.el
deleted file mode 100644
index 5b58f144..00000000
--- a/xemacs-packages/lisp/mail-lib/mail-extr.el
+++ /dev/null
@@ -1,2132 +0,0 @@
-;;; mail-extr.el --- extract full name and address from RFC 822 mail header
-
-;; Copyright (C) 1991, 1992, 1993, 1994, 1997, 2001
-;;   Free Software Foundation, Inc.
-
-;; Author: Joe Wells 
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Emacs 21.3 CVS as of 2004-06-10.
-
-;;; Commentary:
-
-;; The entry point of this code is
-;;
-;;    mail-extract-address-components: (address &optional all)
-;;
-;;    Given an RFC-822 ADDRESS, extract full name and canonical address.
-;;    Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
-;;    If no name can be extracted, FULL-NAME will be nil.
-;;    ADDRESS may be a string or a buffer.  If it is a buffer, the visible
-;;     (narrowed) portion of the buffer will be interpreted as the address.
-;;     (This feature exists so that the clever caller might be able to avoid
-;;     consing a string.)
-;;    If ADDRESS contains more than one RFC-822 address, only the first is
-;;     returned.
-;;
-;;    If ALL is non-nil, that means return info about all the addresses
-;;     that are found in ADDRESS.  The value is a list of elements of
-;;     the form (FULL-NAME CANONICAL-ADDRESS), one per address.
-;;
-;; This code is more correct (and more heuristic) parser than the code in
-;; rfc822.el.  And despite its size, it's fairly fast.
-;;
-;; There are two main benefits:
-;;
-;; 1. Higher probability of getting the correct full name for a human than
-;;    any other package we know of.  (On the other hand, it will cheerfully
-;;    mangle non-human names/comments.)
-;; 2. Address part is put in a canonical form.
-;;
-;; The interface is not yet carved in stone; please give us suggestions.
-;;
-;; We have an extensive test-case collection of funny addresses if you want to
-;; work with the code.  Developing this code requires frequent testing to
-;; make sure you're not breaking functionality.  The test cases aren't included
-;; because they are over 100K.
-;;
-;; If you find an address that mail-extr fails on, please send it to the
-;; maintainer along with what you think the correct results should be.  We do
-;; not consider it a bug if mail-extr mangles a comment that does not
-;; correspond to a real human full name, although we would prefer that
-;; mail-extr would return the comment as-is.
-;;
-;; Features:
-;;
-;; * Full name handling:
-;;
-;;   * knows where full names can be found in an address.
-;;   * avoids using empty comments and quoted text.
-;;   * extracts full names from mailbox names.
-;;   * recognizes common formats for comments after a full name.
-;;   * puts a period and a space after each initial.
-;;   * understands & referring to the mailbox name, capitalized.
-;;   * strips name prefixes like "Prof.", etc.
-;;   * understands what characters can occur in names (not just letters).
-;;   * figures out middle initial from mailbox name.
-;;   * removes funny nicknames.
-;;   * keeps suffixes such as Jr., Sr., III, etc.
-;;   * reorders "Last, First" type names.
-;;
-;; * Address handling:
-;;
-;;   * parses rfc822 quoted text, comments, and domain literals.
-;;   * parses rfc822 multi-line headers.
-;;   * does something reasonable with rfc822 GROUP addresses.
-;;   * handles many rfc822 noncompliant and garbage addresses.
-;;   * canonicalizes addresses (after stripping comments/phrases outside <>).
-;;     * converts ! addresses into .UUCP and %-style addresses.
-;;     * converts rfc822 ROUTE addresses to %-style addresses.
-;;     * truncates %-style addresses at leftmost fully qualified domain name.
-;;     * handles local relative precedence of ! vs. % and @ (untested).
-;;
-;; It does almost no string creation.  It primarily uses the built-in
-;; parsing routines with the appropriate syntax tables.  This should
-;; result in greater speed.
-;;
-;; TODO:
-;;
-;; * handle all test cases.  (This will take forever.)
-;; * software to pick the correct header to use (eg., "Senders-Name:").
-;; * multiple addresses in the "From:" header (almost all of the necessary
-;;   code is there).
-;; * flag to not treat `,' as an address separator.  (This is useful when
-;;   there is a "From:" header but no "Sender:" header, because then there
-;;   is only allowed to be one address.)
-;; * mailbox name does not necessarily contain full name.
-;; * fixing capitalization when it's all upper or lowercase.  (Hard!)
-;; * some of the domain literal handling is missing.  (But I've never even
-;;   seen one of these in a mail address, so maybe no big deal.)
-;; * arrange to have syntax tables byte-compiled.
-;; * speed hacks.
-;; * delete unused variables.
-;; * arrange for testing with different relative precedences of ! vs. @
-;;   and %.
-;; * insert documentation strings!
-;; * handle X.400-gatewayed addresses according to RFC 1148.
-
-;;; Change Log:
-;;
-;; Thu Feb 17 17:57:33 1994  Jamie Zawinski (jwz@lucid.com)
-;;
-;;	* merged with jbw's latest version
-;;
-;; Wed Feb  9 21:56:27 1994  Jamie Zawinski (jwz@lucid.com)
-;;
-;;      * high-bit chars in comments weren't treated as word syntax
-;;
-;; Sat Feb  5 03:13:40 1994  Jamie Zawinski (jwz@lucid.com)
-;;
-;;      * call replace-match with fixed-case arg
-;;
-;; Thu Dec 16 21:56:45 1993  Jamie Zawinski (jwz@lucid.com)
-;;
-;;      * some more cleanup, doc, added provide
-;;
-;; Tue Mar 23 21:23:18 1993  Joe Wells  (jbw at csd.bu.edu)
-;;
-;; 	* Made mail-full-name-prefixes a user-customizable variable.
-;;        Allow passing the address as a buffer as well as a string.
-;;        Allow [ and ] as name characters (Finnish character set).
-;;
-;; Mon Mar 22 21:20:56 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;;
-;; 	* Handle "null" addresses.  Handle = used for spacing in mailbox
-;; 	  name.  Fix bug in handling of ROUTE-ADDR-type addresses that are
-;; 	  missing their brackets.  Handle uppercase "JR".  Extract full
-;; 	  names from X.400 addresses encoded in RFC-822.  Fix bug in
-;;        handling of multiple addresses where first has trailing comment.
-;;        Handle more kinds of telephone extension lead-ins.
-;;
-;; Mon Mar 22 20:16:57 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;;
-;; 	* Handle HZ encoding for embedding GB encoded chinese characters.
-;;
-;; Mon Mar 22 00:46:12 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;;
-;; 	* Fixed too broad matching of ham radio call signs.  Fixed bug in
-;; 	  handling an unmatched ' in a name string.  Enhanced recognition
-;; 	  of when . in the mailbox name terminates the name portion.
-;; 	  Narrowed conversion of . to space to only the necessary
-;; 	  situation.  Deal with VMS's stupid date stamps.  Handle a unique
-;; 	  way of introducing an alternate address.  Fixed spacing bug I
-;; 	  introduced in switching last name order.  Fixed bug in handling
-;; 	  address with ! and % but no @.  Narrowed the cases in which
-;; 	  certain trailing words are discarded.
-;;
-;; Sun Mar 21 21:41:06 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;;
-;; 	* Fixed bugs in handling GROUP addresses.  Certain words in the
-;; 	  middle of a name no longer terminate it.  Handle LISTSERV list
-;;        names.  Ignore comment field containing mailbox name.
-;;
-;; Sun Mar 21 14:39:38 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;;
-;; 	* Moved variant-method code back into main function.  Handle
-;; 	underscores as spaces in comments.  Handle leading nickname.  Add
-;; 	flag to ignore single-word names.  Other changes.
-;;
-;; Mon Feb  1 22:23:31 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;;
-;; 	* Added in changes by Rod Whitby and Jamie Zawinski.  This
-;;        includes the flag mail-extr-guess-middle-initial and the fix for
-;;        handling multiple addresses correctly.  (Whitby just changed
-;;	  a > to a <.)
-;;
-;; Mon Apr  6 23:59:09 1992  Joe Wells  (jbw at bigbird.bu.edu)
-;;
-;; 	* Cleaned up some more.  Release version 1.0 to world.
-;;
-;; Sun Apr  5 19:39:08 1992  Joe Wells  (jbw at bigbird.bu.edu)
-;;
-;; 	* Cleaned up full name extraction extensively.
-;;
-;; Sun Feb  2 14:45:24 1992  Joe Wells  (jbw at bigbird.bu.edu)
-;;
-;; 	* Total rewrite.  Integrated mail-canonicalize-address into
-;; 	mail-extract-address-components.  Now handles GROUP addresses more
-;; 	or less correctly.  Better handling of lots of different cases.
-;;
-;; Fri Jun 14 19:39:50 1991
-;;	* Created.
-
-;;; Code:
-
-
-(defgroup mail-extr nil
-  "Extract full name and address from RFC 822 mail header."
-  :prefix "mail-extr-"
-  :group 'mail)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; User configuration variable definitions.
-;;
-
-(defcustom mail-extr-guess-middle-initial nil
-  "*Whether to try to guess middle initial from mail address.
-If true, then when we see an address like \"John Smith \"
-we will assume that \"John Q. Smith\" is the fellow's name."
-  :type 'boolean
-  :group 'mail-extr)
-
-(defcustom mail-extr-ignore-single-names nil
-  "*Whether to ignore a name that is just a single word.
-If true, then when we see an address like \"Idiot \"
-we will act as though we couldn't find a full name in the address."
-  :type 'boolean
-  :group 'mail-extr)
-
-;; Matches a leading title that is not part of the name (does not
-;; contribute to uniquely identifying the person).
-(defcustom mail-extr-full-name-prefixes
-  (purecopy
-   "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]")
-  "*Matches prefixes to the full name that identify a person's position.
-These are stripped from the full name because they do not contribute to
-uniquely identifying the person."
-  :type 'regexp
-  :group 'mail-extr)
-
-(defcustom mail-extr-@-binds-tighter-than-! nil
-  "*Whether the local mail transport agent looks at ! before @."
-  :type 'boolean
-  :group 'mail-extr)
-
-(defcustom mail-extr-mangle-uucp nil
-  "*Whether to throw away information in UUCP addresses
-by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
-  :type 'boolean
-  :group 'mail-extr)
-
-;;----------------------------------------------------------------------
-;; what orderings are meaningful?????
-;;(defvar mail-operator-precedence-list '(?! ?% ?@))
-;; Right operand of a % or a @ must be a domain name, period.  No other
-;; operators allowed.  Left operand of a @ is an address relative to that
-;; site.
-
-;; Left operand of a ! must be a domain name.  Right operand is an
-;; arbitrary address.
-;;----------------------------------------------------------------------
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Constant definitions.
-;;
-
-;; Any character that can occur in a name, not counting characters that
-;; separate parts of a multipart name (hyphen and period).
-;; Yes, there are weird people with digits in their names.
-;; You will also notice the consideration for the
-;; Swedish/Finnish/Norwegian character set.
-;; XEmacs: Add \200-\376 range (not \377 due to bug (?) in search.c...).
-(defconst mail-extr-all-letters-but-separators
-  (purecopy "][A-Za-z{|}'~0-9`\200-\376")) ;; XEmacs
-
-;; Any character that can occur in a name in an RFC822 address including
-;; the separator (hyphen and possibly period) for multipart names.
-;; #### should . be in here?
-(defconst mail-extr-all-letters
-  (purecopy (concat mail-extr-all-letters-but-separators "---")))
-
-;; Any character that can start a name.
-;; Keep this set as minimal as possible.
-(defconst mail-extr-first-letters (purecopy "A-Za-z")) ;; XEmacs
-
-;; Any character that can end a name.
-;; Keep this set as minimal as possible.
-(defconst mail-extr-last-letters (purecopy "[A-Za-z`'.")) ;; XEmacs
-
-(defconst mail-extr-leading-garbage "\\W+")
-
-;; (defconst mail-extr-non-name-chars
-;;   (purecopy (concat "^" mail-extr-all-letters ".")))
-;; (defconst mail-extr-non-begin-name-chars
-;;   (purecopy (concat "^" mail-extr-first-letters)))
-;; (defconst mail-extr-non-end-name-chars
-;;   (purecopy (concat "^" mail-extr-last-letters)))
-
-;; Matches an initial not followed by both a period and a space.
-;; (defconst mail-extr-bad-initials-pattern
-;;   (purecopy
-;;    (format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)"
-;;            mail-extr-all-letters mail-extr-first-letters mail-extr-all-letters)))
-
-;; Matches periods used instead of spaces.  Must not match the period
-;; following an initial.
-(defconst mail-extr-bad-dot-pattern
-  (purecopy
-   (format "\\([%s][%s]\\)\\.+\\([%s]\\)"
-	   mail-extr-all-letters
-	   mail-extr-last-letters
-	   mail-extr-first-letters)))
-
-;; Matches an embedded or leading nickname that should be removed.
-;; (defconst mail-extr-nickname-pattern
-;;   (purecopy
-;;    (format "\\([ .]\\|\\`\\)[\"'`\[\(]\\([ .%s]+\\)[\]\"'\)] "
-;;            mail-extr-all-letters)))
-
-;; Matches the occurrence of a generational name suffix, and the last
-;; character of the preceding name.  This is important because we want to
-;; keep such suffixes: they help to uniquely identify the person.
-;; *** Perhaps this should be a user-customizable variable.  However, the
-;; *** regular expression is fairly tricky to alter, so maybe not.
-(defconst mail-extr-full-name-suffix-pattern
-  (purecopy
-   (format
-    "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)"
-    mail-extr-all-letters mail-extr-all-letters)))
-
-(defconst mail-extr-roman-numeral-pattern (purecopy "V?I+V?\\b"))
-
-;; Matches a trailing uppercase (with other characters possible) acronym.
-;; Must not match a trailing uppercase last name or trailing initial
-(defconst mail-extr-weird-acronym-pattern
-  (purecopy "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)"))
-
-;; Matches a mixed-case or lowercase name (not an initial).
-;; #### Match Latin1 lower case letters here too?
-;; (defconst mail-extr-mixed-case-name-pattern
-;;   (purecopy
-;;    (format
-;;     "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)"
-;;     mail-extr-all-letters mail-extr-last-letters
-;;     mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters
-;;     mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters)))
-
-;; Matches a trailing alternative address.
-;; #### Match Latin1 letters here too?
-;; #### Match _ before @ here too?
-(defconst mail-extr-alternative-address-pattern
-  (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]"))
-
-;; Matches a variety of trailing comments not including comma-delimited
-;; comments.
-(defconst mail-extr-trailing-comment-start-pattern
-  (purecopy " [-{]\\|--\\|[+@#>, Mark Feit
-;; , Michael Covington .
-;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KA9WGN KD3FU KD6EUI KD6HBW
-;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH
-;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO
-(defconst mail-extr-ham-call-sign-pattern
-  (purecopy "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)"))
-
-;; Possible trailing suffixes: "\\(/\\(KT\\|A[AEG]\\|[R0-9]\\)\\)?"
-;; /KT == Temporary Technician (has CSC but not "real" license)
-;; /AA == Temporary Advanced
-;; /AE == Temporary Extra
-;; /AG == Temporary General
-;; /R  == repeater
-;; /#  == stations operating out of home district
-;; I don't include these in the regexp above because I can't imagine
-;; anyone putting them with their name in an e-mail address.
-
-;; Matches normal single-part name
-(defconst mail-extr-normal-name-pattern
-  (purecopy (format "\\b[%s][%s]+[%s]"
-		    mail-extr-first-letters
-		    mail-extr-all-letters-but-separators
-		    mail-extr-last-letters)))
-
-;; Matches a single word name.
-;; (defconst mail-extr-one-name-pattern
-;;   (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'")))
-
-;; Matches normal two names with missing middle initial
-;; The first name is not allowed to have a hyphen because this can cause
-;; false matches where the "middle initial" is actually the first letter
-;; of the second part of the first name.
-(defconst mail-extr-two-name-pattern
-  (purecopy
-   (concat "\\`\\(" mail-extr-normal-name-pattern
-	   "\\|" mail-extr-initial-pattern
-	   "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)")))
-
-(defconst mail-extr-listserv-list-name-pattern
-  (purecopy "Multiple recipients of list \\([-A-Z]+\\)"))
-
-(defconst mail-extr-stupid-vms-date-stamp-pattern
-  (purecopy
-   "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *"))
-
-;;; HZ -- GB (PRC Chinese character encoding) in ASCII embedding protocol
-;;
-;; In ASCII mode, a byte is interpreted as an ASCII character, unless a '~' is
-;; encountered. The character '~' is an escape character. By convention, it
-;; must be immediately followed ONLY by '~', '{' or '\n' (), with the
-;; following special meaning.
-;;
-;; o The escape sequence '~~' is interpreted as a '~'.
-;; o The escape-to-GB sequence '~{' switches the mode from ASCII to GB.
-;; o The escape sequence '~\n' is a line-continuation marker to be consumed
-;;   with no output produced.
-;;
-;; In GB mode, characters are interpreted two bytes at a time as (pure) GB
-;; codes until the escape-from-GB code '~}' is read. This code switches the
-;; mode from GB back to ASCII.  (Note that the escape-from-GB code '~}'
-;; ($7E7D) is outside the defined GB range.)
-(defconst mail-extr-hz-embedded-gb-encoded-chinese-pattern
-  (purecopy "~{\\([^~].\\|~[^\}]\\)+~}"))
-
-;; The leading optional lowercase letters are for a bastardized version of
-;; the encoding, as is the optional nature of the final slash.
-(defconst mail-extr-x400-encoded-address-pattern
-  (purecopy "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'"))
-
-(defconst mail-extr-x400-encoded-address-field-pattern-format
-  (purecopy "/%s=\\([^/]+\\)\\(/\\|\\'\\)"))
-
-(defconst mail-extr-x400-encoded-address-surname-pattern
-  ;; S stands for Surname (family name).
-  (purecopy
-   (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]")))
-
-(defconst mail-extr-x400-encoded-address-given-name-pattern
-  ;; G stands for Given name.
-  (purecopy
-   (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]")))
-
-(defconst mail-extr-x400-encoded-address-full-name-pattern
-  ;; PN stands for Personal Name.  When used it represents the combination
-  ;; of the G and S fields.
-  ;; "The one system I used having this field asked it with the prompt
-  ;; `Personal Name'.  But they mapped it into G and S on outgoing real
-  ;; X.400 addresses.  As they mapped G and S into PN on incoming..."
-  (purecopy
-   (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]")))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Syntax tables used for quick parsing.
-;;
-
-(defconst mail-extr-address-syntax-table (make-syntax-table))
-(defconst mail-extr-address-comment-syntax-table (make-syntax-table))
-(defconst mail-extr-address-domain-literal-syntax-table (make-syntax-table))
-(defconst mail-extr-address-text-comment-syntax-table (make-syntax-table))
-(defconst mail-extr-address-text-syntax-table (make-syntax-table))
-(mapc
- (lambda (pair)
-   (let ((syntax-table (symbol-value (car pair))))
-     (dolist (item (cdr pair))
-       (if (eq 2 (length item))
-	   ;; modifying syntax of a single character
-	   (modify-syntax-entry (car item) (car (cdr item)) syntax-table)
-	 ;; modifying syntax of a range of characters
-	 (let ((char (nth 0 item))
-	       (bound (nth 1 item))
-	       (syntax (nth 2 item)))
-	   (while (<= char bound)
-	     (modify-syntax-entry char syntax syntax-table)
-	     (setq char (1+ char))))))))
- '((mail-extr-address-syntax-table
-    (?\000 ?\037 "w")			;control characters
-    (?\040	 " ")			;SPC
-    (?! ?~	 "w")			;printable characters
-    (?\177	 "w")			;DEL
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?\( ".")
-    (?\) ".")
-    (?<  ".")
-    (?>  ".")
-    (?@  ".")
-    (?,  ".")
-    (?\; ".")
-    (?:  ".")
-    (?\\ "\\")
-    (?\" "\"")
-    (?.  ".")
-    (?\[ ".")
-    (?\] ".")
-    ;; % and ! aren't RFC822 characters, but it is convenient to pretend
-    (?%  ".")
-    (?!  ".") ;; this needs to be word-constituent when not in .UUCP mode
-    )
-   (mail-extr-address-comment-syntax-table
-    (?\000 ?\377 "w")
-    (?\040 " ")
-    (?\240 " ")
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?\( "\(\)")
-    (?\) "\)\(")
-    (?\\ "\\"))
-   (mail-extr-address-domain-literal-syntax-table
-    (?\000 ?\377 "w")
-    (?\040 " ")
-    (?\240 " ")
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?\[ "\(\]")			;??????
-    (?\] "\)\[")			;??????
-    (?\\ "\\"))
-   (mail-extr-address-text-comment-syntax-table
-    (?\000 ?\377 "w")
-    (?\040 " ")
-    (?\240 " ")
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?\( "\(\)")
-    (?\) "\)\(")
-    (?\[ "\(\]")
-    (?\] "\)\[")
-    (?\{ "\(\}")
-    (?\} "\)\{")
-    (?\\ "\\")
-    (?\" "\"")
-    ;; (?\' "\)\`")
-    ;; (?\` "\(\'")
-    )
-   (mail-extr-address-text-syntax-table
-    (?\000 ?\177 ".")
-    (?\200 ?\377 "w")
-    (?\040 " ")
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?A ?Z "w")
-    (?a ?z "w")
-    (?-    "w")
-    (?\}   "w")
-    (?\{   "w")
-    (?|    "w")
-    (?\'   "w")
-    (?~    "w")
-    (?0 ?9 "w"))
-   ))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Utility functions and macros.
-;;
-
-;; Fixme: There are Latin-1 nbsp below.  If such characters should be
-;; included, this is the wrong thing to do -- it should use syntax (or
-;; regexp char classes).
-
-(defsubst mail-extr-skip-whitespace-forward ()
-  ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.
-  (skip-chars-forward " \t\n\r\240"))
-
-(defsubst mail-extr-skip-whitespace-backward ()
-  ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded.
-  (skip-chars-backward " \t\n\r\240"))
-
-
-(defsubst mail-extr-undo-backslash-quoting (beg end)
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      ;; undo \ quoting
-      (while (search-forward "\\" nil t)
-	(delete-char -1)
-	(or (eobp)
-	    (forward-char 1))))))
-
-(defsubst mail-extr-nuke-char-at (pos)
-  (save-excursion
-    (goto-char pos)
-    (delete-char 1)
-    (insert ?\ )))
-
-(put 'mail-extr-nuke-outside-range
-     'edebug-form-spec '(symbolp &optional form form atom))
-
-(defmacro mail-extr-nuke-outside-range (list-symbol
-					beg-symbol end-symbol
-					&optional no-replace)
-  "Delete all elements outside BEG..END in LIST.
-LIST-SYMBOL names a variable holding a list of buffer positions
-BEG-SYMBOL and END-SYMBOL name variables delimiting a range
-Each element of LIST-SYMBOL which lies outside of the range is
- deleted from the list.
-Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
- which lie outside of the range, one character at that position is
- replaced with a SPC."
-  (or (memq no-replace '(t nil))
-      (error "no-replace must be t or nil, evaluable at macroexpand-time"))
-  `(let ((temp ,list-symbol)
-	   ch)
-       (while temp
-	 (setq ch (car temp))
-	 (when (or (> ch ,end-symbol)
-		   (< ch ,beg-symbol))
-	   ,@(if no-replace
-		   nil
-		 `((mail-extr-nuke-char-at ch)))
-	   (setcar temp nil))
-	 (setq temp (cdr temp)))
-       (setq ,list-symbol (delq nil ,list-symbol))))
-
-(defun mail-extr-demarkerize (marker)
-  ;; if arg is a marker, destroys the marker, then returns the old value.
-  ;; otherwise returns the arg.
-  (if (markerp marker)
-      (let ((temp (marker-position marker)))
-	(set-marker marker nil)
-	temp)
-    marker))
-
-(defun mail-extr-markerize (pos)
-  ;; coerces pos to a marker if non-nil.
-  (if (or (markerp pos) (null pos))
-      pos
-    (copy-marker pos)))
-
-(defsubst mail-extr-safe-move-sexp (arg)
-  ;; Safely skip over one balanced sexp, if there is one.  Return t if success.
-  (condition-case error
-      (progn
-	(goto-char (or (scan-sexps (point) arg) (point)))
-	t)
-    (error
-     ;; #### kludge kludge kludge kludge kludge kludge kludge !!!
-     (if (string-equal (nth 1 error) "Unbalanced parentheses")
-	 nil
-       (while t
-	 (signal (car error) (cdr error)))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; The main function to grind addresses
-;;
-
-(defvar disable-initial-guessing-flag)	; dynamic assignment
-(defvar cbeg)				; dynamic assignment
-(defvar cend)				; dynamic assignment
-
-;;;###autoload
-(defun mail-extract-address-components (address &optional all)
-  "Given an RFC-822 address ADDRESS, extract full name and canonical address.
-Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
-If no name can be extracted, FULL-NAME will be nil.  Also see
-`mail-extr-ignore-single-names'.
-
-If the optional argument ALL is non-nil, then ADDRESS can contain zero
-or more recipients, separated by commas, and we return a list of
-the form ((FULL-NAME CANONICAL-ADDRESS) ...) with one element for
-each recipient.  If ALL is nil, then if ADDRESS contains more than
-one recipients, all but the first is ignored.
-
-ADDRESS may be a string or a buffer.  If it is a buffer, the visible
-\(narrowed) portion of the buffer will be interpreted as the address.
-\(This feature exists so that the clever caller might be able to avoid
-consing a string.)"
-  (let ((canonicalization-buffer (get-buffer-create " *canonical address*"))
-	(extraction-buffer (get-buffer-create " *extract address components*"))
-	value-list)
-
-    (with-current-buffer (get-buffer-create extraction-buffer)
-      (fundamental-mode)
-      (buffer-disable-undo extraction-buffer)
-      (set-syntax-table mail-extr-address-syntax-table)
-      (widen)
-      (erase-buffer)
-      (setq case-fold-search nil)
-
-      ;; Insert extra space at beginning to allow later replacement with <
-      ;; without having to move markers.
-      (insert ?\ )
-
-      ;; Insert the address itself.
-      (cond ((stringp address)
-	     (insert address))
-	    ((bufferp address)
-	     (insert-buffer-substring address))
-	    (t
-	     (error "Invalid address: %s" address)))
-
-      (set-text-properties (point-min) (point-max) nil)
-
-      (with-current-buffer (get-buffer-create canonicalization-buffer)
-	(fundamental-mode)
-	(buffer-disable-undo canonicalization-buffer)
-	(setq case-fold-search nil))
-
-
-      ;; Unfold multiple lines.
-      (goto-char (point-min))
-      (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t)
-	(replace-match "\\1 " t))
-
-      ;; Loop over addresses until we have as many as we want.
-      (while (and (or all (null value-list))
-		  (progn (goto-char (point-min))
-			 (skip-chars-forward " \t")
-			 (not (eobp))))
-	(let (char
-	      end-of-address
-	      <-pos >-pos @-pos colon-pos comma-pos !-pos %-pos \;-pos
-	      group-:-pos group-\;-pos route-addr-:-pos
-	      record-pos-symbol
-	      first-real-pos last-real-pos
-	      phrase-beg phrase-end
-	      cbeg cend			; dynamically set from -voodoo
-	      quote-beg quote-end
-	      atom-beg atom-end
-	      mbox-beg mbox-end
-	      \.-ends-name
-	      temp
-	      ;;	name-suffix
-	      fi mi li			; first, middle, last initial
-	      saved-%-pos saved-!-pos saved-@-pos
-	      domain-pos \.-pos insert-point
-	      ;;	mailbox-name-processed-flag
-	      disable-initial-guessing-flag) ; dynamically set from -voodoo
-
-	  (set-syntax-table mail-extr-address-syntax-table)
-	  (goto-char (point-min))
-
-	  ;; Insert extra space at beginning to allow later replacement with <
-	  ;; without having to move markers.
-	  (or (eq (following-char) ?\ )
-	      (insert ?\ ))
-
-	  ;; First pass grabs useful information about address.
-	  (while (progn
-		   (mail-extr-skip-whitespace-forward)
-		   (not (eobp)))
-	    (setq char (char-after (point)))
-	    (or first-real-pos
-		(if (not (eq char ?\())
-		    (setq first-real-pos (point))))
-	    (cond
-	     ;; comment
-	     ((eq char ?\()
-	      (set-syntax-table mail-extr-address-comment-syntax-table)
-	      ;; only record the first non-empty comment's position
-	      (if (and (not cbeg)
-		       (save-excursion
-			 (forward-char 1)
-			 (mail-extr-skip-whitespace-forward)
-			 (not (eq ?\) (char-after (point))))))
-		  (setq cbeg (point)))
-	      ;; TODO: don't record if unbalanced
-	      (or (mail-extr-safe-move-sexp 1)
-		  (forward-char 1))
-	      (set-syntax-table mail-extr-address-syntax-table)
-	      (if (and cbeg
-		       (not cend))
-		  (setq cend (point))))
-	     ;; quoted text
-	     ((eq char ?\")
-	      ;; only record the first non-empty quote's position
-	      (if (and (not quote-beg)
-		       (save-excursion
-			 (forward-char 1)
-			 (mail-extr-skip-whitespace-forward)
-			 (not (eq ?\" (char-after (point))))))
-		  (setq quote-beg (point)))
-	      ;; TODO: don't record if unbalanced
-	      (or (mail-extr-safe-move-sexp 1)
-		  (forward-char 1))
-	      (if (and quote-beg
-		       (not quote-end))
-		  (setq quote-end (point))))
-	     ;; domain literals
-	     ((eq char ?\[)
-	      (set-syntax-table mail-extr-address-domain-literal-syntax-table)
-	      (or (mail-extr-safe-move-sexp 1)
-		  (forward-char 1))
-	      (set-syntax-table mail-extr-address-syntax-table))
-	     ;; commas delimit addresses when outside < > pairs.
-	     ((and (eq char ?,)
-		   (or (and (null <-pos)
-			    ;; Handle ROUTE-ADDR address that is missing its <.
-			    (not (eq ?@ (char-after (1+ (point))))))
-		       (and >-pos
-			    ;; handle weird munged addresses
-			    ;; BUG FIX: This test was reversed.  Thanks to the
-			    ;; brilliant Rod Whitby 
-			    ;; for discovering this!
-			    (< (car (last <-pos)) (car >-pos)))))
-	      ;; The argument contains more than one address.
-	      ;; Temporarily hide everything after this one.
-	      (setq end-of-address (copy-marker (1+ (point)) t))
-	      (narrow-to-region (point-min) (1+ (point)))
-	      (delete-char 1)
-	      (setq char ?\() ; HAVE I NO SHAME??
-	      )
-	     ;; record the position of various interesting chars, determine
-	     ;; legality later.
-	     ((setq record-pos-symbol
-		    (cdr (assq char
-			       '((?< . <-pos) (?> . >-pos) (?@ . @-pos)
-				 (?: . colon-pos) (?, . comma-pos) (?! . !-pos)
-				 (?% . %-pos) (?\; . \;-pos)))))
-	      (set record-pos-symbol
-		   (cons (point) (symbol-value record-pos-symbol)))
-	      (forward-char 1))
-	     ((eq char ?.)
-	      (forward-char 1))
-	     ((memq char '(
-			   ;; comment terminator illegal
-			   ?\)
-			   ;; domain literal terminator illegal
-			   ?\]
-			   ;; \ allowed only within quoted strings,
-			   ;; domain literals, and comments
-			   ?\\
-			   ))
-	      (mail-extr-nuke-char-at (point))
-	      (forward-char 1))
-	     (t
-	      (forward-word 1)))
-	    (or (eq char ?\()
-		;; At the end of first address of a multiple address header.
-		(and (eq char ?,)
-		     (eobp))
-		(setq last-real-pos (point))))
-
-	  ;; Use only the leftmost <, if any.  Replace all others with spaces.
-	  (while (cdr <-pos)
-	    (mail-extr-nuke-char-at (car <-pos))
-	    (setq <-pos (cdr <-pos)))
-
-	  ;; Use only the rightmost >, if any.  Replace all others with spaces.
-	  (while (cdr >-pos)
-	    (mail-extr-nuke-char-at (nth 1 >-pos))
-	    (setcdr >-pos (nthcdr 2 >-pos)))
-
-	  ;; If multiple @s and a :, but no < and >, insert around buffer.
-	  ;; Example: @foo.bar.dom,@xxx.yyy.zzz:mailbox@aaa.bbb.ccc
-	  ;; This commonly happens on the UUCP "From " line.  Ugh.
-	  (when (and (> (length @-pos) 1)
-		      (eq 1 (length colon-pos))	;TODO: check if between last two @s
-		      (not \;-pos)
-		      (not <-pos))
-	    (goto-char (point-min))
-	    (delete-char 1)
-	    (setq <-pos (list (point)))
-	    (insert ?<))
-
-	  ;; If < but no >, insert > in rightmost possible position
-	  (when (and <-pos (null >-pos))
-	    (goto-char (point-max))
-	    (setq >-pos (list (point)))
-	    (insert ?>))
-
-	  ;; If > but no <, replace > with space.
-	  (when (and >-pos (null <-pos))
-	    (mail-extr-nuke-char-at (car >-pos))
-	    (setq >-pos nil))
-
-	  ;; Turn >-pos and <-pos into non-lists
-	  (setq >-pos (car >-pos)
-		<-pos (car <-pos))
-
-	  ;; Trim other punctuation lists of items outside < > pair to handle
-	  ;; stupid MTAs.
-	  (when <-pos			; don't need to check >-pos also
-	    ;; handle bozo software that violates RFC 822 by sticking
-	    ;; punctuation marks outside of a < > pair
-	    (mail-extr-nuke-outside-range @-pos <-pos >-pos t)
-	    ;; RFC 822 says nothing about these two outside < >, but
-	    ;; remove those positions from the lists to make things
-	    ;; easier.
-	    (mail-extr-nuke-outside-range !-pos <-pos >-pos t)
-	    (mail-extr-nuke-outside-range %-pos <-pos >-pos t))
-
-	  ;; Check for : that indicates GROUP list and for : part of
-	  ;; ROUTE-ADDR spec.
-	  ;; Can't possibly be more than two :.  Nuke any extra.
-	  (while colon-pos
-	    (setq temp (car colon-pos)
-		  colon-pos (cdr colon-pos))
-	    (cond ((and <-pos >-pos
-			(> temp <-pos)
-			(< temp >-pos))
-		   (if (or route-addr-:-pos
-			   (< (length @-pos) 2)
-			   (> temp (car @-pos))
-			   (< temp (nth 1 @-pos)))
-		       (mail-extr-nuke-char-at temp)
-		     (setq route-addr-:-pos temp)))
-		  ((or (not <-pos)
-		       (and <-pos
-			    (< temp <-pos)))
-		   (setq group-:-pos temp))))
-
-	  ;; Nuke any ; that is in or to the left of a < > pair or to the left
-	  ;; of a GROUP starting :.  Also, there may only be one ;.
-	  (while \;-pos
-	    (setq temp (car \;-pos)
-		  \;-pos (cdr \;-pos))
-	    (cond ((and <-pos >-pos
-			(> temp <-pos)
-			(< temp >-pos))
-		   (mail-extr-nuke-char-at temp))
-		  ((and (or (not group-:-pos)
-			    (> temp group-:-pos))
-			(not group-\;-pos))
-		   (setq group-\;-pos temp))))
-
-	  ;; Nuke unmatched GROUP syntax characters.
-	  (when (and group-:-pos (not group-\;-pos))
-	    ;; *** Do I really need to erase it?
-	    (mail-extr-nuke-char-at group-:-pos)
-	    (setq group-:-pos nil))
-	  (when (and group-\;-pos (not group-:-pos))
-	    ;; *** Do I really need to erase it?
-	    (mail-extr-nuke-char-at group-\;-pos)
-	    (setq group-\;-pos nil))
-
-	  ;; Handle junk like ";@host.company.dom" that sendmail adds.
-	  ;; **** should I remember comment positions?
-	  (when group-\;-pos
-	    ;; this is fine for now
-	    (mail-extr-nuke-outside-range !-pos group-:-pos group-\;-pos t)
-	    (mail-extr-nuke-outside-range @-pos group-:-pos group-\;-pos t)
-	    (mail-extr-nuke-outside-range %-pos group-:-pos group-\;-pos t)
-	    (mail-extr-nuke-outside-range comma-pos group-:-pos group-\;-pos t)
-	    (and last-real-pos
-		 (> last-real-pos (1+ group-\;-pos))
-		 (setq last-real-pos (1+ group-\;-pos)))
-	    ;; *** This may be wrong:
-	    (and cend
-		 (> cend group-\;-pos)
-		 (setq cend nil
-		       cbeg nil))
-	    (and quote-end
-		 (> quote-end group-\;-pos)
-		 (setq quote-end nil
-		       quote-beg nil))
-	    ;; This was both wrong and unnecessary:
-	    ;;(narrow-to-region (point-min) group-\;-pos)
-
-	    ;; *** The entire handling of GROUP addresses seems rather lame.
-	    ;; *** It deserves a complete rethink, except that these addresses
-	    ;; *** are hardly ever seen.
-	    )
-
-	  ;; Any commas must be between < and : of ROUTE-ADDR.  Nuke any
-	  ;; others.
-	  ;; Hell, go ahead and nuke all of the commas.
-	  ;; **** This will cause problems when we start handling commas in
-	  ;; the PHRASE part .... no it won't ... yes it will ... ?????
-	  (mail-extr-nuke-outside-range comma-pos 1 1)
-
-	  ;; can only have multiple @s inside < >.  The fact that some MTAs
-	  ;; put de-bracketed ROUTE-ADDRs in the UUCP-style "From " line is
-	  ;; handled above.
-
-	  ;; Locate PHRASE part of ROUTE-ADDR.
-	  (when <-pos
-	    (goto-char <-pos)
-	    (mail-extr-skip-whitespace-backward)
-	    (setq phrase-end (point))
-	    (goto-char (or ;;group-:-pos
-			(point-min)))
-	    (mail-extr-skip-whitespace-forward)
-	    (if (< (point) phrase-end)
-		(setq phrase-beg (point))
-	      (setq phrase-end nil)))
-
-	  ;; handle ROUTE-ADDRS with real ROUTEs.
-	  ;; If there are multiple @s, then we assume ROUTE-ADDR syntax, and
-	  ;; any % or ! must be semantically meaningless.
-	  ;; TODO: do this processing into canonicalization buffer
-	  (when route-addr-:-pos
-	    (setq !-pos nil
-		  %-pos nil
-		  >-pos (copy-marker >-pos)
-		  route-addr-:-pos (copy-marker route-addr-:-pos))
-	    (goto-char >-pos)
-	    (insert-before-markers ?X)
-	    (goto-char (car @-pos))
-	    (while (setq @-pos (cdr @-pos))
-	      (delete-char 1)
-	      (setq %-pos (cons (point-marker) %-pos))
-	      (insert "%")
-	      (goto-char (1- >-pos))
-	      (save-excursion
-		(insert-buffer-substring extraction-buffer
-					 (car @-pos) route-addr-:-pos)
-		(delete-region (car @-pos) route-addr-:-pos))
-	      (or (cdr @-pos)
-		  (setq saved-@-pos (list (point)))))
-	    (setq @-pos saved-@-pos)
-	    (goto-char >-pos)
-	    (delete-char -1)
-	    (mail-extr-nuke-char-at route-addr-:-pos)
-	    (mail-extr-demarkerize route-addr-:-pos)
-	    (setq route-addr-:-pos nil
-		  >-pos (mail-extr-demarkerize >-pos)
-		  %-pos (mapcar 'mail-extr-demarkerize %-pos)))
-
-	  ;; de-listify @-pos
-	  (setq @-pos (car @-pos))
-
-	  ;; TODO: remove comments in the middle of an address
-
-	  (with-current-buffer canonicalization-buffer
-	    (widen)
-	    (erase-buffer)
-	    (insert-buffer-substring extraction-buffer)
-
-	    (if <-pos
-		(narrow-to-region (progn
-				    (goto-char (1+ <-pos))
-				    (mail-extr-skip-whitespace-forward)
-				    (point))
-				  >-pos)
-	      (if (and first-real-pos last-real-pos)
-		  (narrow-to-region first-real-pos last-real-pos)
-		;; ****** Oh no!  What if the address is completely empty!
-		;; *** Is this correct?
-		(narrow-to-region (point-max) (point-max))))
-
-	    (and @-pos %-pos
-		 (mail-extr-nuke-outside-range %-pos (point-min) @-pos))
-	    (and %-pos !-pos
-		 (mail-extr-nuke-outside-range !-pos (point-min) (car %-pos)))
-	    (and @-pos !-pos (not %-pos)
-		 (mail-extr-nuke-outside-range !-pos (point-min) @-pos))
-
-	    ;; Error condition:?? (and %-pos (not @-pos))
-
-	    ;; WARNING: THIS CODE IS DUPLICATED BELOW.
-	    (when (and %-pos (not @-pos))
-	      (goto-char (car %-pos))
-	      (delete-char 1)
-	      (setq @-pos (point))
-	      (insert "@")
-	      (setq %-pos (cdr %-pos)))
-
-	    (when (and mail-extr-mangle-uucp !-pos)
-	      ;; **** I don't understand this save-restriction and the
-	      ;; narrow-to-region inside it.  Why did I do that?
-	      (save-restriction
-		(cond ((and @-pos
-			    mail-extr-@-binds-tighter-than-!)
-		       (goto-char @-pos)
-		       (setq %-pos (cons (point) %-pos)
-			     @-pos nil)
-		       (delete-char 1)
-		       (insert "%")
-		       (setq insert-point (point-max)))
-		      (mail-extr-@-binds-tighter-than-!
-		       (setq insert-point (point-max)))
-		      (%-pos
-		       (setq insert-point (car (last %-pos))
-			     saved-%-pos (mapcar 'mail-extr-markerize %-pos)
-			     %-pos nil
-			     @-pos (mail-extr-markerize @-pos)))
-		      (@-pos
-		       (setq insert-point @-pos)
-		       (setq @-pos (mail-extr-markerize @-pos)))
-		      (t
-		       (setq insert-point (point-max))))
-		(narrow-to-region (point-min) insert-point)
-		(setq saved-!-pos (car !-pos))
-		(while !-pos
-		  (goto-char (point-max))
-		  (cond ((and (not @-pos)
-			      (not (cdr !-pos)))
-			 (setq @-pos (point))
-			 (insert-before-markers "@ "))
-			(t
-			 (setq %-pos (cons (point) %-pos))
-			 (insert-before-markers "% ")))
-		  (backward-char 1)
-		  (insert-buffer-substring
-		   (current-buffer)
-		   (if (nth 1 !-pos)
-		       (1+ (nth 1 !-pos))
-		     (point-min))
-		   (car !-pos))
-		  (delete-char 1)
-		  (or (save-excursion
-			(mail-extr-safe-move-sexp -1)
-			(mail-extr-skip-whitespace-backward)
-			(eq ?. (preceding-char)))
-		      (insert-before-markers
-		       (if (save-excursion
-			     (mail-extr-skip-whitespace-backward)
-			     (eq ?. (preceding-char)))
-			   ""
-			 ".")
-		       "uucp"))
-		  (setq !-pos (cdr !-pos))))
-	      (and saved-%-pos
-		   (setq %-pos (append (mapcar 'mail-extr-demarkerize
-					       saved-%-pos)
-				       %-pos)))
-	      (setq @-pos (mail-extr-demarkerize @-pos))
-	      (narrow-to-region (1+ saved-!-pos) (point-max)))
-
-	    ;; WARNING: THIS CODE IS DUPLICATED ABOVE.
-	    (when (and %-pos (not @-pos))
-	      (goto-char (car %-pos))
-	      (delete-char 1)
-	      (setq @-pos (point))
-	      (insert "@")
-	      (setq %-pos (cdr %-pos)))
-
-	    (when (setq %-pos (nreverse %-pos))	; implies @-pos valid
-	      (setq temp %-pos)
-	      (catch 'truncated
-		(while temp
-		  (goto-char (or (nth 1 temp)
-				 @-pos))
-		  (mail-extr-skip-whitespace-backward)
-		  (save-excursion
-		    (mail-extr-safe-move-sexp -1)
-		    (setq domain-pos (point))
-		    (mail-extr-skip-whitespace-backward)
-		    (setq \.-pos (eq ?. (preceding-char))))
-		  (when (and \.-pos
-			     ;; #### string consing
-			     (let ((s (intern-soft
-				       (buffer-substring domain-pos (point))
-				       mail-extr-all-top-level-domains)))
-			       (and s (get s 'domain-name))))
-		    (narrow-to-region (point-min) (point))
-		    (goto-char (car temp))
-		    (delete-char 1)
-		    (setq @-pos (point))
-		    (setcdr temp nil)
-		    (setq %-pos (delq @-pos %-pos))
-		    (insert "@")
-		    (throw 'truncated t))
-		  (setq temp (cdr temp)))))
-	    (setq mbox-beg (point-min)
-		  mbox-end (if %-pos (car %-pos)
-			     (or @-pos
-				 (point-max))))
-
-	    (when @-pos
-	      ;; Make the domain-name part lowercase since it's case
-	      ;; insensitive anyway.
-	      (downcase-region (1+ @-pos) (point-max))))
-
-	  ;; Done canonicalizing address.
-	  ;; We are now back in extraction-buffer.
-
-	  ;; Decide what part of the address to search to find the full name.
-	  (cond (
-		 ;; Example: "First M. Last" 
-		 (and phrase-beg
-		      (eq quote-beg phrase-beg)
-		      (<= quote-end phrase-end))
-		 (narrow-to-region (1+ quote-beg) (1- quote-end))
-		 (mail-extr-undo-backslash-quoting (point-min) (point-max)))
-
-		;; Example: First Last 
-		(phrase-beg
-		 (narrow-to-region phrase-beg phrase-end))
-
-		;; Example: fml@foo.bar.dom (First M. Last)
-		(cbeg
-		 (narrow-to-region (1+ cbeg) (1- cend))
-		 (mail-extr-undo-backslash-quoting (point-min) (point-max))
-
-		 ;; Deal with spacing problems
-		 (goto-char (point-min))
-;;;	     (cond ((not (search-forward " " nil t))
-;;;		    (goto-char (point-min))
-;;;		    (cond ((search-forward "_" nil t)
-;;;			   ;; Handle the *idiotic* use of underlines as spaces.
-;;;			   ;; Example: fml@foo.bar.dom (First_M._Last)
-;;;			   (goto-char (point-min))
-;;;			   (while (search-forward "_" nil t)
-;;;			     (replace-match " " t)))
-;;;			  ((search-forward "." nil t)
-;;;			   ;; Fix . used as space
-;;;			   ;; Example: danj1@cb.att.com (daniel.jacobson)
-;;;			   (goto-char (point-min))
-;;;			   (while (re-search-forward mail-extr-bad-dot-pattern nil t)
-;;;			     (replace-match "\\1 \\2" t))))))
-		 )
-
-		;; Otherwise we try to get the name from the mailbox portion
-		;; of the address.
-		;; Example: First_M_Last@foo.bar.dom
-		(t
-		 ;; *** Work in canon buffer instead?  No, can't.  Hmm.
-		 (goto-char (point-max))
-		 (narrow-to-region (point) (point))
-		 (insert-buffer-substring canonicalization-buffer
-					  mbox-beg mbox-end)
-		 (goto-char (point-min))
-
-		 ;; Example: First_Last.XXX@foo.bar.dom
-		 (setq \.-ends-name (re-search-forward "[_0-9]" nil t))
-
-		 (goto-char (point-min))
-
-		 (if (not mail-extr-mangle-uucp)
-		     (modify-syntax-entry ?! "w" (syntax-table)))
-
-		 (while (progn
-			  (mail-extr-skip-whitespace-forward)
-			  (not (eobp)))
-		   (setq char (char-after (point)))
-		   (cond
-		    ((eq char ?\")
-		     (setq quote-beg (point))
-		     (or (mail-extr-safe-move-sexp 1)
-			 ;; TODO: handle this error condition!!!!!
-			 (forward-char 1))
-		     ;; take into account deletions
-		     (setq quote-end (- (point) 2))
-		     (save-excursion
-		       (backward-char 1)
-		       (delete-char 1)
-		       (goto-char quote-beg)
-		       (or (eobp)
-			   (delete-char 1)))
-		     (mail-extr-undo-backslash-quoting quote-beg quote-end)
-		     (or (eq ?\  (char-after (point)))
-			 (insert " "))
-		     ;;		 (setq mailbox-name-processed-flag t)
-		     (setq \.-ends-name t))
-		    ((eq char ?.)
-		     (if (memq (char-after (1+ (point))) '(?_ ?=))
-			 (progn
-			   (forward-char 1)
-			   (delete-char 1)
-			   (insert ?\ ))
-		       (if \.-ends-name
-			   (narrow-to-region (point-min) (point))
-			 (delete-char 1)
-			 (insert " ")))
-		     ;;		 (setq mailbox-name-processed-flag t)
-		     )
-		    ((memq (char-syntax char) '(?. ?\\))
-		     (delete-char 1)
-		     (insert " ")
-		     ;;		 (setq mailbox-name-processed-flag t)
-		     )
-		    (t
-		     (setq atom-beg (point))
-		     (forward-word 1)
-		     (setq atom-end (point))
-		     (goto-char atom-beg)
-		     (save-restriction
-		       (narrow-to-region atom-beg atom-end)
-		       (cond
-
-			;; Handle X.400 addresses encoded in RFC-822.
-			;; *** Shit!  This has to handle the case where it is
-			;; *** embedded in a quote too!
-			;; *** Shit!  The input is being broken up into atoms
-			;; *** by periods!
-			((looking-at mail-extr-x400-encoded-address-pattern)
-
-			 ;; Copy the contents of the individual fields that
-			 ;; might hold name data to the beginning.
-			 (mapc
-			  (lambda (field-pattern)
-			    (when
-				(save-excursion
-				  (re-search-forward field-pattern nil t))
-			      (insert-buffer-substring (current-buffer)
-						       (match-beginning 1)
-						       (match-end 1))
-			      (insert " ")))
-			  (list mail-extr-x400-encoded-address-given-name-pattern
-				mail-extr-x400-encoded-address-surname-pattern
-				mail-extr-x400-encoded-address-full-name-pattern))
-
-			 ;; Discard the rest, since it contains stuff like
-			 ;; routing information, not part of a name.
-			 (mail-extr-skip-whitespace-backward)
-			 (delete-region (point) (point-max))
-
-			 ;; Handle periods used for spacing.
-			 (while (re-search-forward mail-extr-bad-dot-pattern nil t)
-			   (replace-match "\\1 \\2" t))
-
-			 ;;		     (setq mailbox-name-processed-flag t)
-			 )
-
-			;; Handle normal addresses.
-			(t
-			 (goto-char (point-min))
-			 ;; Handle _ and = used for spacing.
-			 (while (re-search-forward "\\([^_=]+\\)[_=]" nil t)
-			   (replace-match "\\1 " t)
-			   ;;		       (setq mailbox-name-processed-flag t)
-			   )
-			 (goto-char (point-max))))))))
-
-		 ;; undo the dirty deed
-		 (if (not mail-extr-mangle-uucp)
-		     (modify-syntax-entry ?! "." (syntax-table)))
-		 ;;
-		 ;; If we derived the name from the mailbox part of the address,
-		 ;; and we only got one word out of it, don't treat that as a
-		 ;; name.  "foo@bar" --> (nil "foo@bar"), not ("foo" "foo@bar")
-		 ;; (if (not mailbox-name-processed-flag)
-		 ;;     (delete-region (point-min) (point-max)))
-		 ))
-
-	  (set-syntax-table mail-extr-address-text-syntax-table)
-
-	  (mail-extr-voodoo mbox-beg mbox-end canonicalization-buffer)
-	  (goto-char (point-min))
-
-	  ;; If name is "First Last" and userid is "F?L", then assume
-	  ;; the middle initial is the second letter in the userid.
-	  ;; Initial code by Jamie Zawinski 
-	  ;; *** Make it work when there's a suffix as well.
-	  (goto-char (point-min))
-	  (when (and mail-extr-guess-middle-initial
-		     (not disable-initial-guessing-flag)
-		     (eq 3 (- mbox-end mbox-beg))
-		     (progn
-		       (goto-char (point-min))
-		       (looking-at mail-extr-two-name-pattern)))
-	    (setq fi (char-after (match-beginning 0))
-		  li (char-after (match-beginning 3)))
-	    (with-current-buffer canonicalization-buffer
-	      ;; char-equal is ignoring case here, so no need to upcase
-	      ;; or downcase.
-	      (let ((case-fold-search t))
-		(and (char-equal fi (char-after mbox-beg))
-		     (char-equal li (char-after (1- mbox-end)))
-		     (setq mi (char-after (1+ mbox-beg))))))
-	    (when (and mi
-		       ;; TODO: use better table than syntax table
-		       (eq ?w (char-syntax mi)))
-	      (goto-char (match-beginning 3))
-	      (insert (upcase mi) ". ")))
-
-	  ;; Nuke name if it is the same as mailbox name.
-	  (let ((buffer-length (- (point-max) (point-min)))
-		(i 0)
-		(names-match-flag t))
-	    (when (and (> buffer-length 0)
-		       (eq buffer-length (- mbox-end mbox-beg)))
-	      (goto-char (point-max))
-	      (insert-buffer-substring canonicalization-buffer
-				       mbox-beg mbox-end)
-	      (while (and names-match-flag
-			  (< i buffer-length))
-		(or (eq (downcase (char-after (+ i (point-min))))
-			(downcase
-			 (char-after (+ i buffer-length (point-min)))))
-		    (setq names-match-flag nil))
-		(setq i (1+ i)))
-	      (delete-region (+ (point-min) buffer-length) (point-max))
-	      (if names-match-flag
-		  (narrow-to-region (point) (point)))))
-
-	  ;; Nuke name if it's just one word.
-	  (goto-char (point-min))
-	  (and mail-extr-ignore-single-names
-	       (not (re-search-forward "[- ]" nil t))
-	       (narrow-to-region (point) (point)))
-
-	  ;; Record the result
-	  (setq value-list
-		(cons (list (if (not (= (point-min) (point-max)))
-				(buffer-string))
-			    (with-current-buffer canonicalization-buffer
-			      (if (not (= (point-min) (point-max)))
-				  (buffer-string))))
-		      value-list))
-
-	  ;; Unless one address is all we wanted,
-	  ;; delete this one from extraction-buffer
-	  ;; and get ready to extract the next address.
-	  (when all
-	    (if end-of-address
-		(narrow-to-region 1 end-of-address)
-	      (widen))
-	    (delete-region (point-min) (point-max))
-	    (widen))
-	  )))
-    (if all (nreverse value-list) (car value-list))
-    ))
-
-(defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer)
-  (let ((word-count 0)
-	(case-fold-search nil)
-	mixed-case-flag lower-case-flag ;;upper-case-flag
-	suffix-flag last-name-comma-flag
-	;;cbeg cend
-	initial
-	begin-again-flag
-	drop-this-word-if-trailing-flag
-	drop-last-word-if-trailing-flag
-	word-found-flag
-	this-word-beg last-word-beg
-	name-beg name-end
-	name-done-flag
-	)
-    (save-excursion
-      (set-syntax-table mail-extr-address-text-syntax-table)
-
-      ;; Get rid of comments.
-      (goto-char (point-min))
-      (while (not (eobp))
-	;; Initialize for this iteration of the loop.
-	(skip-chars-forward "^({[\"'`")
-	(let ((cbeg (point)))
-	  (set-syntax-table mail-extr-address-text-comment-syntax-table)
-	  (if (memq (following-char) '(?\' ?\`))
-	      (search-forward "'" nil 'move
-			      (if (eq ?\' (following-char)) 2 1))
-	    (or (mail-extr-safe-move-sexp 1)
-		(goto-char (point-max))))
-	  (set-syntax-table mail-extr-address-text-syntax-table)
-	  (when (eq (char-after cbeg) ?\()
-	    ;; Delete the comment itself.
-	    (delete-region cbeg (point))
-	    ;; Canonicalize whitespace where the comment was.
-	    (skip-chars-backward " \t")
-	    (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)")
-		(replace-match "")
-	      (setq cbeg (point))
-	      (skip-chars-forward " \t")
-	      (if (bobp)
-		  (delete-region (point) cbeg)
-		(just-one-space))))))
-
-      ;; This was moved above.
-      ;; Fix . used as space
-      ;; But it belongs here because it occurs not only as
-      ;;   rypens@reks.uia.ac.be (Piet.Rypens)
-      ;; but also as
-      ;;   "Piet.Rypens" 
-      ;;(goto-char (point-min))
-      ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t)
-      ;;  (replace-match "\\1 \\2" t))
-
-      (unless (search-forward " " nil t)
-	(goto-char (point-min))
-	(cond ((search-forward "_" nil t)
-	       ;; Handle the *idiotic* use of underlines as spaces.
-	       ;; Example: fml@foo.bar.dom (First_M._Last)
-	       (goto-char (point-min))
-	       (while (search-forward "_" nil t)
-		 (replace-match " " t)))
-	      ((search-forward "." nil t)
-	       ;; Fix . used as space
-	       ;; Example: danj1@cb.att.com (daniel.jacobson)
-	       (goto-char (point-min))
-	       (while (re-search-forward mail-extr-bad-dot-pattern nil t)
-		 (replace-match "\\1 \\2" t)))))
-
-      ;; Loop over the words (and other junk) in the name.
-      (goto-char (point-min))
-      (while (not name-done-flag)
-
-	(when word-found-flag
-	  ;; Last time through this loop we skipped over a word.
-	  (setq last-word-beg this-word-beg)
-	  (setq drop-last-word-if-trailing-flag
-		drop-this-word-if-trailing-flag)
-	  (setq word-found-flag nil))
-
-	(when begin-again-flag
-	  ;; Last time through the loop we found something that
-	  ;; indicates we should pretend we are beginning again from
-	  ;; the start.
-	  (setq word-count 0)
-	  (setq last-word-beg nil)
-	  (setq drop-last-word-if-trailing-flag nil)
-	  (setq mixed-case-flag nil)
-	  (setq lower-case-flag nil)
-	  ;;	       (setq upper-case-flag nil)
-	  (setq begin-again-flag nil))
-
-	;; Initialize for this iteration of the loop.
-	(mail-extr-skip-whitespace-forward)
-	(if (eq word-count 0) (narrow-to-region (point) (point-max)))
-	(setq this-word-beg (point))
-	(setq drop-this-word-if-trailing-flag nil)
-
-	;; Decide what to do based on what we are looking at.
-	(cond
-
-	 ;; Delete title
-	 ((and (eq word-count 0)
-	       (looking-at mail-extr-full-name-prefixes))
-	  (goto-char (match-end 0))
-	  (narrow-to-region (point) (point-max)))
-
-	 ;; Stop after name suffix
-	 ((and (>= word-count 2)
-	       (looking-at mail-extr-full-name-suffix-pattern))
-	  (mail-extr-skip-whitespace-backward)
-	  (setq suffix-flag (point))
-	  (if (eq ?, (following-char))
-	      (forward-char 1)
-	    (insert ?,))
-	  ;; Enforce at least one space after comma
-	  (or (eq ?\  (following-char))
-	      (insert ?\ ))
-	  (mail-extr-skip-whitespace-forward)
-	  (cond ((memq (following-char) '(?j ?J ?s ?S))
-		 (capitalize-word 1)
-		 (if (eq (following-char) ?.)
-		     (forward-char 1)
-		   (insert ?.)))
-		(t
-		 (upcase-word 1)))
-	  (setq word-found-flag t)
-	  (setq name-done-flag t))
-
-	 ;; Handle SCA names
-	 ((looking-at "MKA \\(.+\\)")	; "Mundanely Known As"
-	  (goto-char (match-beginning 1))
-	  (narrow-to-region (point) (point-max))
-	  (setq begin-again-flag t))
-
-	 ;; Check for initial last name followed by comma
-	 ((and (eq ?, (following-char))
-	       (eq word-count 1))
-	  (forward-char 1)
-	  (setq last-name-comma-flag t)
-	  (or (eq ?\  (following-char))
-	      (insert ?\ )))
-
-	 ;; Stop before trailing comma-separated comment
-	 ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
-	 ;; *** This case is redundant???
-	 ;;((eq ?, (following-char))
-	 ;; (setq name-done-flag t))
-
-	 ;; Delete parenthesized/quoted comment/nickname
-	 ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
-	  (setq cbeg (point))
-	  (set-syntax-table mail-extr-address-text-comment-syntax-table)
-	  (cond ((memq (following-char) '(?\' ?\`))
-		 (or (search-forward "'" nil t
-				     (if (eq ?\' (following-char)) 2 1))
-		     (delete-char 1)))
-		(t
-		 (or (mail-extr-safe-move-sexp 1)
-		     (goto-char (point-max)))))
-	  (set-syntax-table mail-extr-address-text-syntax-table)
-	  (setq cend (point))
-	  (cond
-	   ;; Handle case of entire name being quoted
-	   ((and (eq word-count 0)
-		 (looking-at " *\\'")
-		 (>= (- cend cbeg) 2))
-	    (narrow-to-region (1+ cbeg) (1- cend))
-	    (goto-char (point-min)))
-	   (t
-	    ;; Handle case of quoted initial
-	    (if (and (or (= 3 (- cend cbeg))
-			 (and (= 4 (- cend cbeg))
-			      (eq ?. (char-after (+ 2 cbeg)))))
-		     (not (looking-at " *\\'")))
-		(setq initial (char-after (1+ cbeg)))
-	      (setq initial nil))
-	    (delete-region cbeg cend)
-	    (if initial
-		(insert initial ". ")))))
-
-	 ;; Handle *Stupid* VMS date stamps
-	 ((looking-at mail-extr-stupid-vms-date-stamp-pattern)
-	  (replace-match "" t))
-
-	 ;; Handle Chinese characters.
-	 ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern)
-	  (goto-char (match-end 0))
-	  (setq word-found-flag t))
-
-	 ;; Skip initial garbage characters.
-	 ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
-	 ((and (eq word-count 0)
-	       (looking-at mail-extr-leading-garbage))
-	  (goto-char (match-end 0))
-	  ;; *** Skip backward over these???
-	  ;; (skip-chars-backward "& \"")
-	  (narrow-to-region (point) (point-max)))
-
-	 ;; Various stopping points
-	 ((or
-
-	   ;; Stop before ALL CAPS acronyms, if preceded by mixed-case
-	   ;; words.  Example: XT-DEM.
-	   (and (>= word-count 2)
-		mixed-case-flag
-		(looking-at mail-extr-weird-acronym-pattern)
-		(not (looking-at mail-extr-roman-numeral-pattern)))
-
-	   ;; Stop before trailing alternative address
-	   (looking-at mail-extr-alternative-address-pattern)
-
-	   ;; Stop before trailing comment not introduced by comma
-	   ;; THIS CASE MUST BE AFTER AN EARLIER CASE.
-	   (looking-at mail-extr-trailing-comment-start-pattern)
-
-	   ;; Stop before telephone numbers
-	   (and (>= word-count 1)
-		(looking-at mail-extr-telephone-extension-pattern)))
-	  (setq name-done-flag t))
-
-	 ;; Delete ham radio call signs
-	 ((looking-at mail-extr-ham-call-sign-pattern)
-	  (delete-region (match-beginning 0) (match-end 0)))
-
-	 ;; Fixup initials
-	 ((looking-at mail-extr-initial-pattern)
-	  (or (eq (following-char) (upcase (following-char)))
-	      (setq lower-case-flag t))
-	  (forward-char 1)
-	  (if (eq ?. (following-char))
-	      (forward-char 1)
-	    (insert ?.))
-	  (or (eq ?\  (following-char))
-	      (insert ?\ ))
-	  (setq word-found-flag t))
-
-	 ;; Handle BITNET LISTSERV list names.
-	 ((and (eq word-count 0)
-	       (looking-at mail-extr-listserv-list-name-pattern))
-	  (narrow-to-region (match-beginning 1) (match-end 1))
-	  (setq word-found-flag t)
-	  (setq name-done-flag t))
-
-	 ;; Handle & substitution, when & is last and is not first.
-	 ((and (> word-count 0)
-	       (eq ?\  (preceding-char))
-	       (eq (following-char) ?&)
-	       (eq (1+ (point)) (point-max)))
-	  (delete-char 1)
-	  (capitalize-region
-	   (point)
-	   (progn
-	     (insert-buffer-substring canonicalization-buffer
-				      mbox-beg mbox-end)
-	     (point)))
-	  (setq disable-initial-guessing-flag t)
-	  (setq word-found-flag t))
-
-	 ;; Handle & between names, as in "Bob & Susie".
-	 ((and (> word-count 0) (eq (following-char) ?\&))
-	  (setq name-beg (point))
-	  (setq name-end (1+ name-beg))
-	  (setq word-found-flag t)
-	  (goto-char name-end))
-
-	 ;; Regular name words
-	 ((looking-at mail-extr-name-pattern)
-	  (setq name-beg (point))
-	  (setq name-end (match-end 0))
-
-	  ;; Certain words will be dropped if they are at the end.
-	  (and (>= word-count 2)
-	       (not lower-case-flag)
-	       (or
-		;; Trailing 4-or-more letter lowercase words preceded by
-		;; mixed case or uppercase words will be dropped.
-		(looking-at "[a-z][a-z][a-z][a-z]+[ \t]*\\'") ;; XEmacs
-		;; Drop a trailing word which is terminated with a period.
-		(eq ?. (char-after (1- name-end))))
-	       (setq drop-this-word-if-trailing-flag t))
-
-	  ;; Set the flags that indicate whether we have seen a lowercase
-	  ;; word, a mixed case word, and an uppercase word.
-	  (if (re-search-forward "[a-z]" name-end t)
-	      (if (progn
-		    (goto-char name-beg)
-		    (re-search-forward "[A-Z]" name-end t))
-		  (setq mixed-case-flag t)
-		(setq lower-case-flag t))
-;;	    (setq upper-case-flag t)
-	    )
-
-	  (goto-char name-end)
-	  (setq word-found-flag t))
-
-	 ;; Allow a number as a word, if it doesn't mean anything else.
-	 ((looking-at "[0-9]+\\>")
-	  (setq name-beg (point))
-	  (setq name-end (match-end 0))
-	  (goto-char name-end)
-	  (setq word-found-flag t))
-
-	 (t
-	  (setq name-done-flag t)
-	  ))
-
-	;; Count any word that we skipped over.
-	(if word-found-flag
-	    (setq word-count (1+ word-count))))
-
-      ;; If the last thing in the name is 2 or more periods, or one or more
-      ;; other sentence terminators (but not a single period) then keep them
-      ;; and the preceding word.  This is for the benefit of whole sentences
-      ;; in the name field: it's better behavior than dropping the last word
-      ;; of the sentence...
-      (if (and (not suffix-flag)
-	       (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'"))
-	  (goto-char (setq suffix-flag (point-max))))
-
-      ;; Drop everything after point and certain trailing words.
-      (narrow-to-region (point-min)
-			(or (and drop-last-word-if-trailing-flag
-				 last-word-beg)
-			    (point)))
-
-      ;; Xerox's mailers SUCK!!!!!!
-      ;; We simply refuse to believe that any last name is PARC or ADOC.
-      ;; If it looks like that is the last name, that there is no meaningful
-      ;; here at all.  Actually I guess it would be best to map patterns
-      ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't
-      ;; actually know that that is what's going on.
-      (unless suffix-flag
-	(goto-char (point-min))
-	(let ((case-fold-search t))
-	  (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'")
-	      (erase-buffer))))
-
-      ;; If last name first put it at end (but before suffix)
-      (when last-name-comma-flag
-	(goto-char (point-min))
-	(search-forward ",")
-	(setq name-end (1- (point)))
-	(goto-char (or suffix-flag (point-max)))
-	(or (eq ?\  (preceding-char))
-	    (insert ?\ ))
-	(insert-buffer-substring (current-buffer) (point-min) name-end)
-	(goto-char name-end)
-	(skip-chars-forward "\t ,")
-	(narrow-to-region (point) (point-max)))
-
-      ;; Delete leading and trailing junk characters.
-      ;; *** This is probably completely unneeded now.
-      ;;(goto-char (point-max))
-      ;;(skip-chars-backward mail-extr-non-end-name-chars)
-      ;;(if (eq ?. (following-char))
-      ;;    (forward-char 1))
-      ;;(narrow-to-region (point)
-      ;;                  (progn
-      ;;                    (goto-char (point-min))
-      ;;                    (skip-chars-forward mail-extr-non-begin-name-chars)
-      ;;                    (point)))
-
-      ;; Compress whitespace
-      (goto-char (point-min))
-      (while (re-search-forward "[ \t\n]+" nil t)
-	(replace-match (if (eobp) "" " ") t))
-      )))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Table of top-level domain names.
-;;
-;; This is used during address canonicalization; be careful of format changes.
-;; Keep in mind that the country abbreviations follow ISO-3166.  There is
-;; a U.S. FIPS that specifies a different set of two-letter country
-;; abbreviations.
-;;
-;; Updated by the RIPE Network Coordination Centre.
-;;
-;; Source: ISO 3166 Maintenance Agency
-;; http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt
-;; http://www.iana.org/domain-names.htm
-;; http://www.iana.org/cctld/cctld-whois.htm
-;; Latest change: Mon Jul  8 14:21:59 CEST 2002
-
-(defconst mail-extr-all-top-level-domains
-  (let ((ob (make-vector 739 0)))
-    (mapc
-     (lambda (x)
-       (put (intern (downcase (car x)) ob)
-	    'domain-name
-	    (if (nth 2 x)
-		(format (nth 2 x) (nth 1 x))
-	      (nth 1 x))))
-     '(
-       ;; ISO 3166 codes:
-       ("ad" "Andorra")
-       ("ae" "United Arab Emirates")
-       ("af" "Afghanistan")
-       ("ag" "Antigua and Barbuda")
-       ("ai" "Anguilla")
-       ("al" "Albania")
-       ("am" "Armenia")
-       ("an" "Netherlands Antilles")
-       ("ao" "Angola")
-       ("aq" "Antarctica")		; continent
-       ("ar" "Argentina"	"Argentine Republic")
-       ("as" "American Samoa")
-       ("at" "Austria"		"The Republic of %s")
-       ("au" "Australia")
-       ("aw" "Aruba")
-       ("az" "Azerbaijan")
-       ("ba" "Bosnia-Herzegovina")
-       ("bb" "Barbados")
-       ("bd" "Bangladesh")
-       ("be" "Belgium"		"The Kingdom of %s")
-       ("bf" "Burkina Faso")
-       ("bg" "Bulgaria")
-       ("bh" "Bahrain")
-       ("bi" "Burundi")
-       ("bj" "Benin")
-       ("bm" "Bermuda")
-       ("bn" "Brunei Darussalam")
-       ("bo" "Bolivia"		"Republic of %s")
-       ("br" "Brazil"		"The Federative Republic of %s")
-       ("bs" "Bahamas")
-       ("bt" "Bhutan")
-       ("bv" "Bouvet Island")
-       ("bw" "Botswana")
-       ("by" "Belarus")
-       ("bz" "Belize")
-       ("ca" "Canada")
-       ("cc" "Cocos (Keeling) Islands")
-       ("cd" "Congo"            "The Democratic Republic of the %s")
-       ("cf" "Central African Republic")
-       ("cg" "Congo")
-       ("ch" "Switzerland"	"The Swiss Confederation")
-       ("ci" "Ivory Coast")		; Cote D'ivoire
-       ("ck" "Cook Islands")
-       ("cl" "Chile"		"The Republic of %s")
-       ("cm" "Cameroon")		; In .fr domain
-       ("cn" "China"		"The People's Republic of %s")
-       ("co" "Colombia")
-       ("cr" "Costa Rica"	"The Republic of %s")
-       ("cu" "Cuba")
-       ("cv" "Cape Verde")
-       ("cx" "Christmas Island")
-       ("cy" "Cyprus")
-       ("cz" "Czech Republic")
-       ("de" "Germany")
-       ("dj" "Djibouti")
-       ("dk" "Denmark")
-       ("dm" "Dominica")
-       ("do" "Dominican Republic"	"The %s")
-       ("dz" "Algeria")
-       ("ec" "Ecuador"		"The Republic of %s")
-       ("ee" "Estonia")
-       ("eg" "Egypt"		"The Arab Republic of %s")
-       ("eh" "Western Sahara")
-       ("er" "Eritrea")
-       ("es" "Spain"		"The Kingdom of %s")
-       ("et" "Ethiopia")
-       ("fi" "Finland"		"The Republic of %s")
-       ("fj" "Fiji")
-       ("fk" "Falkland Islands (Malvinas)")
-       ("fm" "Micronesia"	"Federated States of %s")
-       ("fo" "Faroe Islands")
-       ("fr" "France")
-       ("ga" "Gabon")
-       ("gb" "United Kingdom")
-       ("gd" "Grenada")
-       ("ge" "Georgia")
-       ("gf" "French Guiana")
-       ("gh" "Ghana")
-       ("gi" "Gibraltar")
-       ("gl" "Greenland")
-       ("gm" "Gambia")
-       ("gn" "Guinea")
-       ("gp" "Guadeloupe (Fr.)")
-       ("gq" "Equatorial Guinea")
-       ("gr" "Greece"		"The Hellenic Republic (%s)")
-       ("gs" "South Georgia and The South Sandwich Islands")
-       ("gt" "Guatemala")
-       ("gu" "Guam (U.S.)")
-       ("gw" "Guinea-Bissau")
-       ("gy" "Guyana")
-       ("hk" "Hong Kong")
-       ("hm" "Heard Island and Mcdonald Islands")
-       ("hn" "Honduras")
-       ("hr" "Croatia"		"Croatia (Hrvatska)")
-       ("ht" "Haiti")
-       ("hu" "Hungary"		"The Hungarian Republic")
-       ("id" "Indonesia")
-       ("ie" "Ireland")
-       ("il" "Israel"		"The State of %s")
-       ("im" "Isle of Man"	"The %s") ; NOT in ISO 3166-1 of 2001-02-26
-       ("in" "India"		"The Republic of %s")
-       ("io" "British Indian Ocean Territory")
-       ("iq" "Iraq")
-       ("ir" "Iran"		"Islamic Republic of %s")
-       ("is" "Iceland"		"The Republic of %s")
-       ("it" "Italy"		"The Italian Republic")
-       ("jm" "Jamaica")
-       ("jo" "Jordan")
-       ("jp" "Japan")
-       ("ke" "Kenya")
-       ("kg" "Kyrgyzstan")
-       ("kh" "Cambodia")
-       ("ki" "Kiribati")
-       ("km" "Comoros")
-       ("kn" "Saint Kitts and Nevis")
-       ("kp" "Korea (North)"	"Democratic People's Republic of Korea")
-       ("kr" "Korea (South)"	"Republic of Korea")
-       ("kw" "Kuwait")
-       ("ky" "Cayman Islands")
-       ("kz" "Kazakhstan")
-       ("la" "Lao People's Democratic Republic")
-       ("lb" "Lebanon")
-       ("lc" "Saint Lucia")
-       ("li" "Liechtenstein")
-       ("lk" "Sri Lanka"	"The Democratic Socialist Republic of %s")
-       ("lr" "Liberia")
-       ("ls" "Lesotho")
-       ("lt" "Lithuania")
-       ("lu" "Luxembourg")
-       ("lv" "Latvia")
-       ("ly" "Libyan Arab Jamahiriya")
-       ("ma" "Morocco")
-       ("mc" "Monaco")
-       ("md" "Moldova"		"The Republic of %s")
-       ("mg" "Madagascar")
-       ("mh" "Marshall Islands")
-       ("mk" "Macedonia"	"The Former Yugoslav Republic of %s")
-       ("ml" "Mali")
-       ("mm" "Myanmar")
-       ("mn" "Mongolia")
-       ("mo" "Macao")
-       ("mp" "Northern Mariana Islands")
-       ("mq" "Martinique")
-       ("mr" "Mauritania")
-       ("ms" "Montserrat")
-       ("mt" "Malta")
-       ("mu" "Mauritius")
-       ("mv" "Maldives")
-       ("mw" "Malawi")
-       ("mx" "Mexico"		"The United Mexican States")
-       ("my" "Malaysia")
-       ("mz" "Mozambique")
-       ("na" "Namibia")
-       ("nc" "New Caledonia (Fr.)")
-       ("ne" "Niger")			; In .fr domain
-       ("nf" "Norfolk Island")
-       ("ng" "Nigeria")
-       ("ni" "Nicaragua"	"The Republic of %s")
-       ("nl" "Netherlands"	"The Kingdom of the %s")
-       ("no" "Norway"		"The Kingdom of %s")
-       ("np" "Nepal")			; Via .in domain
-       ("nr" "Nauru")
-       ("nu" "Niue")
-       ("nz" "New Zealand")
-       ("om" "Oman")
-       ("pa" "Panama")
-       ("pe" "Peru")
-       ("pf" "French Polynesia")
-       ("pg" "Papua New Guinea")
-       ("ph" "Philippines"	"The Republic of the %s")
-       ("pk" "Pakistan")
-       ("pl" "Poland")
-       ("pm" "Saint Pierre and Miquelon")
-       ("pn" "Pitcairn")
-       ("pr" "Puerto Rico (U.S.)")
-       ("ps" "Palestinian Territory, Occupied")
-       ("pt" "Portugal"		"The Portuguese Republic")
-       ("pw" "Palau")
-       ("py" "Paraguay")
-       ("qa" "Qatar")
-       ("re" "Reunion (Fr.)")		; In .fr domain
-       ("ro" "Romania")
-       ("ru" "Russia"		"Russian Federation")
-       ("rw" "Rwanda")
-       ("sa" "Saudi Arabia")
-       ("sb" "Solomon Islands")
-       ("sc" "Seychelles")
-       ("sd" "Sudan")
-       ("se" "Sweden"		"The Kingdom of %s")
-       ("sg" "Singapore"	"The Republic of %s")
-       ("sh" "Saint Helena")
-       ("si" "Slovenia")
-       ("sj" "Svalbard and Jan Mayen") ; In .no domain
-       ("sk" "Slovakia"		"The Slovak Republic")
-       ("sl" "Sierra Leone")
-       ("sm" "San Marino")
-       ("sn" "Senegal")
-       ("so" "Somalia")
-       ("sr" "Suriname")
-       ("st" "Sao Tome and Principe")
-       ("su" "U.S.S.R." "The Union of Soviet Socialist Republics")
-       ("sv" "El Salvador")
-       ("sy" "Syrian Arab Republic")
-       ("sz" "Swaziland")
-       ("tc" "Turks and Caicos Islands")
-       ("td" "Chad")
-       ("tf" "French Southern Territories")
-       ("tg" "Togo")
-       ("th" "Thailand"		"The Kingdom of %s")
-       ("tj" "Tajikistan")
-       ("tk" "Tokelau")
-       ("tl" "East Timor")
-       ("tm" "Turkmenistan")
-       ("tn" "Tunisia")
-       ("to" "Tonga")
-       ("tp" "East Timor")
-       ("tr" "Turkey"		"The Republic of %s")
-       ("tt" "Trinidad and Tobago")
-       ("tv" "Tuvalu")
-       ("tw" "Taiwan"		"%s, Province of China")
-       ("tz" "Tanzania"		"United Republic of %s")
-       ("ua" "Ukraine")
-       ("ug" "Uganda")
-       ("uk" "United Kingdom"	"The %s of Great Britain and Northern Ireland")
-       ("um" "United States Minor Outlying Islands")
-       ("us" "United States"	"The %s of America")
-       ("uy" "Uruguay"		"The Eastern Republic of %s")
-       ("uz" "Uzbekistan")
-       ("va" "Holy See (Vatican City State)")
-       ("vc" "Saint Vincent and the Grenadines")
-       ("ve" "Venezuela"	"The Republic of %s")
-       ("vg" "Virgin Islands, British")
-       ("vi" "Virgin Islands, U.S.")
-       ("vn" "Vietnam")
-       ("vu" "Vanuatu")
-       ("wf" "Wallis and Futuna")
-       ("ws" "Samoa")
-       ("ye" "Yemen")
-       ("yt" "Mayotte")
-       ("yu" "Yugoslavia"	"Yugoslavia, AKA Serbia-Montenegro")
-       ("za" "South Africa"	"The Republic of %s")
-       ("zm" "Zambia")
-       ("zw" "Zimbabwe"		"Republic of %s")
-       ;; Generic Domains:
-       ("aero" t                "Air Transport Industry")
-       ("biz" t                 "Businesses")
-       ("com" t			"Commercial")
-       ("coop" t                "Cooperative Associations")
-       ("info" t                "Info")
-       ("museum" t              "Museums")
-       ("name" t                "Individuals")
-       ("net" t			"Network")
-       ("org" t			"Non-profit Organization")
-       ;;("pro" t                 "Credentialed professionals")
-       ;;("bitnet" t		"Because It's Time NET")
-       ("gov" t			"United States Government")
-       ("edu" t			"Educational")
-       ("mil" t			"United States Military")
-       ("int" t			"International Treaties")
-       ;;("nato" t		"North Atlantic Treaty Organization")
-       ("uucp" t		"Unix to Unix CoPy")
-       ;; Infrastructure Domains:
-       ("arpa" t		"Advanced Research Projects Agency (U.S. DoD)")
-       ))
-    ob))
-
-;;;###autoload
-(defun what-domain (domain)
-  "Convert mail domain DOMAIN to the country it corresponds to."
-  (interactive
-   (let ((completion-ignore-case t))
-     (list (completing-read "Domain: "
-			    mail-extr-all-top-level-domains nil t))))
-  (or (setq domain (intern-soft (downcase domain)
-				mail-extr-all-top-level-domains))
-      (error "No such domain"))
-  (message "%s: %s" (upcase (symbol-name domain)) (get domain 'domain-name)))
-
-
-;(let ((all nil))
-;  (mapatoms #'(lambda (x)
-;		(if (and (boundp x)
-;			 (string-match "^mail-extr-" (symbol-name x)))
-;		    (setq all (cons x all)))))
-;  (setq all (sort all #'string-lessp))
-;  (cons 'setq
-;	(apply 'nconc (mapcar #'(lambda (x)
-;				  (list x (symbol-value x)))
-;			      all))))
-
-
-(provide 'mail-extr)
-
-;;; arch-tag: 7785fade-1073-4ed6-b4f6-28db34a7982d
-;;; mail-extr.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/mail-utils.el b/xemacs-packages/lisp/mail-lib/mail-utils.el
deleted file mode 100644
index fb184482..00000000
--- a/xemacs-packages/lisp/mail-lib/mail-utils.el
+++ /dev/null
@@ -1,315 +0,0 @@
-;;; mail-utils.el --- utility functions used both by rmail and rnews
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail, news
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 20.5.
-
-;;; Commentary:
-
-;; Utility functions for mail and netnews handling.  These handle fine
-;; points of header parsing.
-
-;;; Code:
-
-;;; We require lisp-mode to make sure that lisp-mode-syntax-table has
-;;; been initialized.
-(require 'lisp-mode)
-		     
-;;;###autoload
-(defcustom mail-use-rfc822 nil "\
-*If non-nil, use a full, hairy RFC822 parser on mail addresses.
-Otherwise, (the default) use a smaller, somewhat faster, and
-often correct parser."
-  :type 'boolean
-  :group 'mail)
-
-;; Returns t if file FILE is an Rmail file.
-;;;###autoload
-(defun mail-file-babyl-p (file)
-  (let ((buf (generate-new-buffer " *rmail-file-p*")))
-    (unwind-protect
-	(save-excursion
-	  (set-buffer buf)
-	  (insert-file-contents file nil 0 100)
-	  (looking-at "BABYL OPTIONS:"))
-      (kill-buffer buf))))
-
-(defun mail-string-delete (string start end)
-  "Returns a string containing all of STRING except the part
-from START (inclusive) to END (exclusive)."
-  (if (null end) (substring string 0 start)
-    (concat (substring string 0 start)
-	    (substring string end nil))))
-
-(defvar mail-rewrite-address-function nil
-  "Function called at the end of `mail-strip-quoted-names' if defined.
-May be used for X.400 rewriting, etc.")
-
-(defun mail-strip-quoted-names (address)
-  "Delete comments and quoted strings in an address list ADDRESS.
-Also delete leading/trailing whitespace and replace FOO  with just BAR.
-Return a modified address list."
-  (if (null address)
-      nil
-    (if mail-use-rfc822
-	(progn (require 'rfc822)
-	       (mapconcat 'identity (rfc822-addresses address) ", "))
-      (let (pos)
-
-       ;; Detect nested comments.
-       (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address)
-	   ;; Strip nested comments.
-	   (save-excursion
-	     (set-buffer (get-buffer-create " *temp*"))
-	     (erase-buffer)
-	     (insert address)
-	     (set-syntax-table lisp-mode-syntax-table)
-	     (goto-char 1)
-	     (while (search-forward "(" nil t)
-	       (forward-char -1)
-	       (skip-chars-backward " \t")
-	       (delete-region (point)
-			      (save-excursion
-				(condition-case ()
-				    (forward-sexp 1)
-				  (error (goto-char (point-max))))
-				  (point))))
-	     (setq address (buffer-string))
-	     (erase-buffer))
-	 ;; Strip non-nested comments an easier way.
-	 (while (setq pos (string-match 
-			    ;; This doesn't hack rfc822 nested comments
-			    ;;  `(xyzzy (foo) whinge)' properly.  Big deal.
-			    "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)"
-			    address))
-	   (setq address
-		 (mail-string-delete address
-				     pos (match-end 0)))))
-
-       ;; strip surrounding whitespace
-       (string-match "\\`[ \t\n]*" address)
-       (setq address (substring address
-				(match-end 0)
-				(string-match "[ \t\n]*\\'" address
-					      (match-end 0))))
-
-       ;; strip `quoted' names (This is supposed to hack `"Foo Bar" ')
-       (setq pos 0)
-       (while (setq pos (string-match
-                          "\\([ \t]?\\)[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*"
-			  address pos))
-	 ;; If the next thing is "@", we have "foo bar"@host.  Leave it.
-	 (if (and (> (length address) (match-end 0))
-		  (= (aref address (match-end 0)) ?@))
-	     (setq pos (match-end 0))
-	   (setq address
-		 (mail-string-delete address
-                                     (match-end 1) (match-end 0)))))
-       ;; Retain only part of address in <> delims, if there is such a thing.
-       (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,:]*>\\)"
-				      address))
-	 (let ((junk-beg (match-end 1))
-	       (junk-end (match-beginning 2))
-	       (close (match-end 0)))
-	   (setq address (mail-string-delete address (1- close) close))
-	   (setq address (mail-string-delete address junk-beg junk-end))))
-       (if (fboundp mail-rewrite-address-function)
-	   (funcall mail-rewrite-address-function address)
-	 address)))))
-
-
-;; rmail-dont-reply-to-names is an autoloaded variable in rmail-mini.el
-(defun rmail-dont-reply-to (userids)
-  "Returns string of mail addresses USERIDS sans any recipients
-that start with matches for `rmail-dont-reply-to-names'.
-Usenet paths ending in an element that matches are removed also."
-  (if (null rmail-dont-reply-to-names)
-      (setq rmail-dont-reply-to-names
-	    (concat (if rmail-default-dont-reply-to-names
-			(concat rmail-default-dont-reply-to-names "\\|")
-		        "")
-		    (concat (regexp-quote (user-login-name))
-			    "\\>"))))
-  (let ((match (concat "\\(^\\|,\\)[ \t\n]*"
-		       ;; Can anyone figure out what this is for?
-		       ;; Is it an obsolete remnant of another way of
-		       ;; handling Foo Bar ?
-		       "\\([^,\n]*[!<]\\|\\)"
-		       "\\("
-			     rmail-dont-reply-to-names
-		       "\\|"
-		             ;; Include the human name that precedes .
-			     "\\([^\,.<\"]\\|\"[^\"]*\"\\)*"
-			     "<\\(" rmail-dont-reply-to-names "\\)"
-		       "\\)[^,]*"))
-	(case-fold-search t)
-	pos epos)
-    (while (setq pos (string-match match userids pos))
-      ;; If there's a match, it starts at the beginning of the string,
-      ;; or with `,'.  We must delete from that position to the
-      ;; end of the user-id which starts at match-beginning 2.
-      (let (inside-quotes quote-pos)
-	(save-match-data
-	  (while (and (setq quote-pos (string-match "\"" userids quote-pos))
-		      (< quote-pos pos))
-	    (setq quote-pos (1+ quote-pos))
-	    (setq inside-quotes (not inside-quotes))))
-	(if inside-quotes
-	    ;; Advance to next even-parity quote, and scan from there.
-	    (setq pos (string-match "\"" userids pos))
-	  (setq userids (replace-match "" nil nil userids)))))
-    ;; get rid of any trailing commas
-    (if (setq pos (string-match "[ ,\t\n]*\\'" userids))
-	(setq userids (substring userids 0 pos)))
-    ;; remove leading spaces. they bother me.
-    (if (string-match "\\(\\s \\|,\\)*" userids)
-	(substring userids (match-end 0))
-      userids)))
-
-
-;;;###autoload
-(defun mail-fetch-field (field-name &optional last all list)
-  "Return the value of the header field whose type is FIELD-NAME.
-The buffer is expected to be narrowed to just the header of the message.
-If second arg LAST is non-nil, use the last field of type FIELD-NAME.
-If third arg ALL is non-nil, concatenate all such fields with commas between.
-If 4th arg LIST is non-nil, return a list of all such fields."
-  (save-excursion
-    (goto-char (point-min))
-    (let ((case-fold-search t)
-	  (name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*")))
-      (if (or all list)
-	  (let ((value (if all "")))
-	    (while (re-search-forward name nil t)
-	      (let ((opoint (point)))
-		(while (progn (forward-line 1)
-			      (looking-at "[ \t]")))
-		;; Back up over newline, then trailing spaces or tabs
-		(forward-char -1)
-		(skip-chars-backward " \t" opoint)
-		(if list
-		    (setq value (cons (buffer-substring-no-properties
-				       opoint (point))
-				      value))
-		  (setq value (concat value
-				      (if (string= value "") "" ", ")
-				      (buffer-substring-no-properties
-				       opoint (point)))))))
-	    (if list
-		value
-	      (and (not (string= value "")) value)))
-	(if (re-search-forward name nil t)
-	    (progn
-	      (if last (while (re-search-forward name nil t)))
-	      (let ((opoint (point)))
-		(while (progn (forward-line 1)
-			      (looking-at "[ \t]")))
-		;; Back up over newline, then trailing spaces or tabs
-		(forward-char -1)
-		(skip-chars-backward " \t" opoint)
-		(buffer-substring-no-properties opoint (point)))))))))
-
-;; Parse a list of tokens separated by commas.
-;; It runs from point to the end of the visible part of the buffer.
-;; Whitespace before or after tokens is ignored,
-;; but whitespace within tokens is kept.
-(defun mail-parse-comma-list ()
-  (let (accumulated
-	beg)
-    (skip-chars-forward " \t\n")
-    (while (not (eobp))
-      (setq beg (point))
-      (skip-chars-forward "^,")
-      (skip-chars-backward " \t\n")
-      (setq accumulated
-	    (cons (buffer-substring-no-properties beg (point))
-		  accumulated))
-      (skip-chars-forward "^,")
-      (skip-chars-forward ", \t\n"))
-    accumulated))
-
-(defun mail-comma-list-regexp (labels)
-  (let (pos)
-    (setq pos (or (string-match "[^ \t]" labels) 0))
-    ;; Remove leading and trailing whitespace.
-    (setq labels (substring labels pos (string-match "[ \t]*$" labels pos)))
-    ;; Change each comma to \|, and flush surrounding whitespace.
-    (while (setq pos (string-match "[ \t]*,[ \t]*" labels))
-      (setq labels
-	    (concat (substring labels 0 pos)
-		    "\\|"
-		    (substring labels (match-end 0))))))
-  labels)
-
-(defun mail-rfc822-time-zone (time)
-  (let* ((sec (or (car (current-time-zone time)) 0))
-	 (absmin (/ (abs sec) 60)))
-    (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
-
-(defun mail-rfc822-date ()
-  (let* ((time (current-time))
-	 (s (current-time-string time)))
-    (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s)
-    (concat (substring s (match-beginning 2) (match-end 2)) " "
-	    (substring s (match-beginning 1) (match-end 1)) " "
-	    (substring s (match-beginning 4) (match-end 4)) " "
-	    (substring s (match-beginning 3) (match-end 3)) " "
-	    (mail-rfc822-time-zone time))))
-
-(defun mail-y-or-n-p (question &rest text)
-  "Ask QUESTION, displaying the rest of the arguments as strings in a buffer."
-  (setq text (mail-flatten-list text))
-  (save-window-excursion
-    (save-excursion
-      (with-output-to-temp-buffer " *SMTP information message*"
-	(set-buffer " *SMTP information message*")
-	(fundamental-mode)		; for Emacs 20.4+
-	(mapcar 'princ text)
-	(goto-char (point-min))))
-    (y-or-n-p question)))
-
-(defun mail-flatten-list (list)
-  "Return a new, flat list that contains all elements of LIST.
-
-\(mail-flatten-list '(1 (2 3 (4 5 (6))) 7))
-=> (1 2 3 4 5 6 7)"
-  (cond ((consp list)
-	 (apply 'append (mapcar 'mail-flatten-list list)))
-	(list
-	 (list list))))
-
-(defun mail-check-safe-charset ()
-  "Check that buffer contain characters that will be safely encoded."
-  (if (featurep 'mule)
-      (let ((bad-charsets (set-difference
-			   (find-charset-region (point-min) (point-max))
-			   '(ascii latin-iso8859-1 control-1))))
-	(when bad-charsets
-	  (or (mail-y-or-n-p 
-	       "Your message contain invalid characters. Continue? "
-	       "You're trying to send a message that contain characters\nin the following character set:\n\n" (mapconcat 'symbol-name bad-charsets ", ") "\n\nThese characters cannot be sent without proper encoding.  Please\nconsider using a MIME enabled mail composer (such as `message').\nContinuing is likely to cause mail corruption.")
-	      (error "Message contain invalid character"))))))
-
-(provide 'mail-utils)
-
-;;; mail-utils.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/mailheader.el b/xemacs-packages/lisp/mail-lib/mailheader.el
deleted file mode 100644
index 76b9cfc5..00000000
--- a/xemacs-packages/lisp/mail-lib/mailheader.el
+++ /dev/null
@@ -1,195 +0,0 @@
-;;; mailheader.el --- mail header parsing, merging, formatting
-
-;; Copyright (C) 1996, 2002, 2003, 2004, 2005 by Free Software Foundation, Inc.
-
-;; Author: Erik Naggum 
-;; Keywords: tools, mail, news
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; 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 package provides an abstraction to RFC822-style messages, used in
-;; mail, news, and some other systems.  The simple syntactic rules for such
-;; headers, such as quoting and line folding, are routinely reimplemented
-;; in many individual packages.  This package removes the need for this
-;; redundancy by representing message headers as association lists,
-;; offering functions to extract the set of headers from a message, to
-;; parse individual headers, to merge sets of headers, and to format a set
-;; of headers.
-
-;; The car of each element in the message-header alist is a symbol whose
-;; print name is the name of the header, in all lower-case.  The cdr of an
-;; element depends on the operation.  After extracting headers from a
-;; message, it is a string, the value of the header.  An extracted set of
-;; headers may be parsed further, which may turn it into a list, whose car
-;; is the original value and whose subsequent elements depend on the
-;; header.  For formatting, it is evaluated to obtain the strings to be
-;; inserted.  For merging, one set of headers consists of strings, while
-;; the other set will be evaluated with the symbols in the first set of
-;; headers bound to their respective values.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl))
-
-;; Make the byte-compiler shut up.
-(defvar headers)
-
-(defun mail-header-extract ()
-  "Extract headers from current buffer after point.
-Returns a header alist, where each element is a cons cell (name . value),
-where NAME is a symbol, and VALUE is the string value of the header having
-that name."
-  (let ((message-headers ()) (top (point))
-	start end)
-    (while (and (setq start (point))
-		(> (skip-chars-forward "^\0- :") 0)
-		(= (following-char) ?:)
-		(setq end (point))
-		(progn (forward-char)
-		       (> (skip-chars-forward " \t") 0)))
-      (let ((header (intern (downcase (buffer-substring start end))))
-	    (value (list (buffer-substring
-			  (point) (progn (end-of-line) (point))))))
-	(while (progn (forward-char) (> (skip-chars-forward " \t") 0))
-	  (push (buffer-substring (point) (progn (end-of-line) (point)))
-		value))
-	(push (if (cdr value)
-		  (cons header (mapconcat #'identity (nreverse value) " "))
-		  (cons header (car value)))
-	      message-headers)))
-    (goto-char top)
-    (nreverse message-headers)))
-
-(defun mail-header-extract-no-properties ()
-  "Extract headers from current buffer after point, without properties.
-Returns a header alist, where each element is a cons cell (name . value),
-where NAME is a symbol, and VALUE is the string value of the header having
-that name."
-  (mapcar
-   (lambda (elt)
-     (set-text-properties 0 (length (cdr elt)) nil (cdr elt))
-     elt)
-   (mail-header-extract)))
-
-(defun mail-header-parse (parsing-rules headers)
-  "Apply PARSING-RULES to HEADERS.
-PARSING-RULES is an alist whose keys are header names (symbols) and whose
-value is a parsing function.  The function takes one argument, a string,
-and return a list of values, which will destructively replace the value
-associated with the key in HEADERS, after being prepended with the original
-value."
-  (dolist (rule parsing-rules)
-    (let ((header (assq (car rule) headers)))
-      (when header
-	(if (consp (cdr header))
-	    (setf (cddr header) (funcall (cdr rule) (cadr header)))
-	  (setf (cdr header)
-		(cons (cdr header) (funcall (cdr rule) (cdr header))))))))
-  headers)
-
-(defsubst mail-header (header &optional header-alist)
-  "Return the value associated with header HEADER in HEADER-ALIST.
-If the value is a string, it is the original value of the header.  If the
-value is a list, its first element is the original value of the header,
-with any subsequent elements being the result of parsing the value.
-If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
-  (cdr (assq header (or header-alist headers))))
-
-(defun mail-header-set (header value &optional header-alist)
-  "Set the value associated with header HEADER to VALUE in HEADER-ALIST.
-HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
-See `mail-header' for the semantics of VALUE."
-  (let* ((alist (or header-alist headers))
-	(entry (assq header alist)))
-    (if entry
-	(setf (cdr entry) value)
-	(nconc alist (list (cons header value)))))
-  value)
-
-(defsetf mail-header (header &optional header-alist) (value)
-  `(mail-header-set ,header ,value ,header-alist))
-
-(defun mail-header-merge (merge-rules headers)
-  "Return a new header alist with MERGE-RULES applied to HEADERS.
-MERGE-RULES is an alist whose keys are header names (symbols) and whose
-values are forms to evaluate, the results of which are the new headers.  It
-should be a string or a list of string.  The first element may be nil to
-denote that the formatting functions must use the remaining elements, or
-skip the header altogether if there are no other elements.
-  The macro `mail-header' can be used to access headers in HEADERS."
-  (mapcar
-   (lambda (rule)
-     (cons (car rule) (eval (cdr rule))))
-   merge-rules))
-
-(defvar mail-header-format-function
-  (lambda (header value)
-    "Function to format headers without a specified formatting function."
-    (insert (capitalize (symbol-name header))
-	    ": "
-	    (if (consp value) (car value) value)
-	    "\n")))
-
-(defun mail-header-format (format-rules headers)
-  "Use FORMAT-RULES to format HEADERS and insert into current buffer.
-HEADERS should be an alist of the form (HEADER . VALUE),
-where HEADER is a header field name (a symbol or a string),
-and VALUE is the contents for that header field.
-
-FORMAT-RULES is an alist of elements (HEADER . FUNCTION) Here HEADER
-is a header field name (a symbol), and FUNCTION is how to format that
-header field, if it appears in HEADERS.  Each FUNCTION should take two
-arguments: the header symbol, and the value of that header.  The value
-returned by FUNCTION is inserted in the buffer unless it is nil.
-
-If the function for a header field is nil, or if no function is
-specified for a particular header field, the default action is to
-insert the value of the header, unless it is nil.
-
-The headers are inserted in the order of the FORMAT-RULES.
-A key of t in FORMAT-RULES represents any otherwise unmentioned headers.
-A key of nil has as its value a list of defaulted headers to ignore."
-  (let ((ignore (append (cdr (assq nil format-rules))
-			(mapcar #'car format-rules))))
-    (dolist (rule format-rules)
-      (let* ((header (car rule))
-	    (value (mail-header header)))
-	(if (stringp header)
-	    (setq header (intern header)))
-	(cond ((null header) 'ignore)
-	      ((eq header t)
-	       (dolist (defaulted headers)
-		 (unless (memq (car defaulted) ignore)
-		   (let* ((header (car defaulted))
-			  (value (cdr defaulted)))
-		     (if (cdr rule)
-			 (funcall (cdr rule) header value)
-		       (funcall mail-header-format-function header value))))))
-	      (value
-	       (if (cdr rule)
-		   (funcall (cdr rule) header value)
-		 (funcall mail-header-format-function header value))))))
-    (insert "\n")))
-
-(provide 'mailheader)
-
-;;; arch-tag: 6e7aa221-80b5-4b3d-b46f-fd66ab567be0
-;;; mailheader.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/netrc.el b/xemacs-packages/lisp/mail-lib/netrc.el
deleted file mode 100644
index e9de8a6e..00000000
--- a/xemacs-packages/lisp/mail-lib/netrc.el
+++ /dev/null
@@ -1,203 +0,0 @@
-;;; netrc.el --- .netrc parsing functionality
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004
-;;        Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen 
-;; Modularizer: Ted Zlatanov 
-;; Keywords: news
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Just the .netrc parsing functionality, abstracted so other packages
-;; besides Gnus can use it.
-
-;;; Code:
-
-;;;
-;;; .netrc and .authinfo rc parsing
-;;;
-
-;; autoload encrypt
-(eval-and-compile
-  (autoload 'encrypt-find-model "encrypt")
-  (autoload 'encrypt-insert-file-contents "encrypt"))
-
-(defgroup netrc nil
- "Netrc configuration.")
-
-(defvar netrc-services-file "/etc/services"
-  "The name of the services file.")
-
-(defun netrc-parse (file)
-  (interactive "fFile to Parse: ")
-  "Parse FILE and return an list of all entries in the file."
-  (when (file-exists-p file)
-    (with-temp-buffer
-      (let ((tokens '("machine" "default" "login"
-		      "password" "account" "macdef" "force"
-		      "port"))
-	    (encryption-model (encrypt-find-model file))
-	    alist elem result pair)
-
-	(if encryption-model
-	    (encrypt-insert-file-contents file encryption-model)
-	  (insert-file-contents file))
-
-	(goto-char (point-min))
-	;; Go through the file, line by line.
-	(while (not (eobp))
-	  (narrow-to-region (point) (point-at-eol))
-	  ;; For each line, get the tokens and values.
-	  (while (not (eobp))
-	    (skip-chars-forward "\t ")
-	    ;; Skip lines that begin with a "#".
-	    (if (eq (char-after) ?#)
-		(goto-char (point-max))
-	      (unless (eobp)
-		(setq elem
-		      (if (= (following-char) ?\")
-			  (read (current-buffer))
-			(buffer-substring
-			 (point) (progn (skip-chars-forward "^\t ")
-					(point)))))
-		(cond
-		 ((equal elem "macdef")
-		  ;; We skip past the macro definition.
-		  (widen)
-		  (while (and (zerop (forward-line 1))
-			      (looking-at "$")))
-		  (narrow-to-region (point) (point)))
-		 ((member elem tokens)
-		  ;; Tokens that don't have a following value are ignored,
-		  ;; except "default".
-		  (when (and pair (or (cdr pair)
-				      (equal (car pair) "default")))
-		    (push pair alist))
-		  (setq pair (list elem)))
-		 (t
-		  ;; Values that haven't got a preceding token are ignored.
-		  (when pair
-		    (setcdr pair elem)
-		    (push pair alist)
-		    (setq pair nil)))))))
-	  (when alist
-	    (push (nreverse alist) result))
-	  (setq alist nil
-		pair nil)
-	  (widen)
-	  (forward-line 1))
-	(nreverse result)))))
-
-(defun netrc-machine (list machine &optional port defaultport)
-  "Return the netrc values from LIST for MACHINE or for the default entry.
-If PORT specified, only return entries with matching port tokens.
-Entries without port tokens default to DEFAULTPORT."
-  (let ((rest list)
-	result)
-    (while list
-      (when (equal (cdr (assoc "machine" (car list))) machine)
-	(push (car list) result))
-      (pop list))
-    (unless result
-      ;; No machine name matches, so we look for default entries.
-      (while rest
-	(when (assoc "default" (car rest))
-	  (push (car rest) result))
-	(pop rest)))
-    (when result
-      (setq result (nreverse result))
-      (while (and result
-		  (not (netrc-port-equal
-			(or port defaultport "nntp")
-			(or (netrc-get (car result) "port")
-			    defaultport "nntp"))))
-	(pop result))
-      (car result))))
-
-(defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults)
-  "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST.
-Matches a machine from MACHINES and a port from PORTS, giving
-default ports DEFAULTS to `netrc-machine'.
-
-MODE can be \"login\" or \"password\", suitable for passing to
-`netrc-get'."
-  (let ((authinfo-list (if (stringp authinfo-file-or-list)
-			   (netrc-parse authinfo-file-or-list)
-			 authinfo-file-or-list))
-	(ports (or ports '(nil)))
-	(defaults (or defaults '(nil)))
-	info)
-    (dolist (machine machines)
-      (dolist (default defaults)
-	(dolist (port ports)
-	  (let ((alist (netrc-machine authinfo-list machine port default)))
-	  (setq info (or (netrc-get alist mode) info))))))
-    info))
-
-(defun netrc-get (alist type)
-  "Return the value of token TYPE from ALIST."
-  (cdr (assoc type alist)))
-
-(defun netrc-port-equal (port1 port2)
-  (when (numberp port1)
-    (setq port1 (or (netrc-find-service-name port1) port1)))
-  (when (numberp port2)
-    (setq port2 (or (netrc-find-service-name port2) port2)))
-  (equal port1 port2))
-
-(defun netrc-parse-services ()
-  (when (file-exists-p netrc-services-file)
-    (let ((services nil))
-      (with-temp-buffer
-	(insert-file-contents netrc-services-file)
-	(while (search-forward "#" nil t)
-	  (delete-region (1- (point)) (line-end-position)))
-	(goto-char (point-min))
-	(while (re-search-forward
-		"^ *\\([^ \n\t]+\\)[ \t]+\\([0-9]+\\)/\\([^ \t\n]+\\)" nil t)
-	  (push (list (match-string 1) (string-to-number (match-string 2))
-		      (intern (downcase (match-string 3))))
-		services))
-	(nreverse services)))))
-
-(defun netrc-find-service-name (number &optional type)
-  (let ((services (netrc-parse-services))
-	service)
-    (setq type (or type 'tcp))
-    (while (and (setq service (pop services))
-		(not (and (= number (cadr service))
-			  (eq type (caddr service)))))
-      )
-    (car service)))
-
-(defun netrc-find-service-number (name &optional type)
-  (let ((services (netrc-parse-services))
-	service)
-    (setq type (or type 'tcp))
-    (while (and (setq service (pop services))
-		(not (and (string= name (car service))
-			  (eq type (caddr service)))))
-      )
-    (cadr service)))
-
-(provide 'netrc)
-
-;;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55
-;;; netrc.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/pop3.el b/xemacs-packages/lisp/mail-lib/pop3.el
deleted file mode 100644
index a494186a..00000000
--- a/xemacs-packages/lisp/mail-lib/pop3.el
+++ /dev/null
@@ -1,789 +0,0 @@
-;;; pop3.el --- Post Office Protocol (RFC 1460) interface
-
-;; Copyright (C) 1996, 1997, 1998 Free Software Foundation, Inc.
-;; Copyright (C) 1997 Franklin Lee
-
-;; Author: Richard L. Pieri 
-;; Author: Franklin Lee 
-;; Author: Andy Piper 
-
-;; Maintainer:      Andy Piper 
-
-;; Keywords: mail, pop3
-;; Version: 2.06
-
-;; Sync'ed up with: official pop3.el version 1.3s.  
-;; This version is a fork of the original pop3.el and the changes have
-;; not been merged back in to that version due to political difficulties.
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Most of the standard and optional Post Office Protocol version 3
-;; (RFC 1460) commands are implemented.
-
-;; This program was inspired by Kyle E. Jones's vm-pop program.
-
-;; This version has been enhanced for speed, UIDL and regexp matching
-;; of headers by Andy Piper .  UIDL support has been
-;; mostly stolen from epop3mail. Please address problems with this
-;; version (2.xx) to me.
-
-;; Speed has been enhanced by trying to slurp a maildrop in one
-;; go. Also performance is vastly affected by how many POP3 commands
-;; are issued, thus I have tried to cut down on this. Note that now
-;; the single biggest time hog by a long way is
-;; accept-process-output. I don't know of a good way to fix this as
-;; this program is now close to the theoretical maximum as measured
-;; against movemail. Under cygwin (and probably windows also) I think
-;; socket I/O is just plain slow. YMMV.
-
-;;; Setup:
-
-;; To use this with gnus add:
-;;	(setq nnmail-movemail-program 'pop3-nnmail-movemail)
-;; to your .emacs
-
-;; You may also want to add the following
-;;	(setq pop3-leave-mail-on-server t)
-
-;; If you (like me) use gnus to only pick up some of your mail you can
-;; add something like:
-;;	(setq pop3-retr-regexp "..:.*someaddress")
-;; You probably want to leave mail on server in this instance as this
-;; will prevent matching every message in your maildrop every time you
-;; read mail. If you do this you may want to:
-;;	(setq pop3-delete-retrieved-mail t)
-;; so that mail you have actually downloaded gets deleted from your
-;; maildrop.
-
-;;; Code:
-
-(require 'mail-utils)
-
-(defconst pop3-version "2.06-xemacs")
-
-(defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil)
-  "*POP3 maildrop.")
-(defvar pop3-mailhost (or (getenv "MAILHOST") nil)
-  "*POP3 mailhost.")
-(defvar pop3-port 110
-  "*POP3 port.")
-
-(defvar pop3-password-required t
-  "*Non-nil if a password is required when connecting to POP server.")
-
-(defvar pop3-password nil
-  "*Password to use when connecting to POP server.")
-
-(defvar pop3-authentication-scheme 'pass
-  "*POP3 authentication scheme.
-Defaults to 'pass, for the standard USER/PASS authentication.  Other valid
-values are 'apop.")
-
-(defvar pop3-timestamp nil
-  "Timestamp returned when initially connected to the POP server.
-Used for APOP authentication.")
-
-(defvar pop3-extended-response-beginning nil
-  "Start of the region containing the last pop3 extended response.
-This does NOT include the initial response from `pop3-read-response'.")
-
-(defvar pop3-extended-response-end nil
-  "End of the region containing the last pop3 extended response.")
-
-(defvar pop3-leave-mail-on-server nil
-  "Non-nil if mail is to be left on the server and UIDL used for message retrieval.")
-
-(defvar pop3-delete-retrieved-mail nil
-  "Non-nil if mail that has been retrieved is to be deleted from the server.
-This is not the opposite to `pop3-leave-mail-on-server' since it is
-possible to not download all mail, hence leaving mail on the server
-and hence requiring the use of UIDL support, but still wanting to
-delete the mail that has been downloaded. If
-`pop3-leave-mail-on-server' is nil then this variable has no effect.")
-
-(defvar pop3-retr-regexp nil
-  "If non-nil only retrieve messages matching this regexp.")
-
-(defvar pop3-maximum-message-size nil
-  "If non-nil only download messages smaller than this.")
-
-(defvar pop3-uidl-file-name "~/.uidls"
-  "File in which to store the UIDL of processed messages.")
-
-(defvar pop3-cache-password nil
-  "Whether to cache the pop password or not.
-If NIL ask for password each time mail is retrieved. Otherwise cache
-the password.")
-
-(defvar pop3-read-point nil)
-(defvar pop3-debug nil)
-(defvar pop3-uidl-support 'dont-know
-  "Whether the server supports UIDL.
-Nil means no, t means yes, not-nil-or-t means yet to be determined.")
-
-(defvar pop3-utab nil
-  "Uidl hash table.")
-
-;;;###autoload
-(defun pop3-nnmail-movemail (inbox crashbox)
-  "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
-  (let ((pop3-maildrop
-         (substring inbox (match-end (string-match "^po:" inbox)))))
-    (pop3-movemail crashbox)))
-
-;;;###autoload
-(defun pop3-movemail (&optional crashbox)
-  "Transfer contents of a maildrop to the specified CRASHBOX."
-  (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
-  (let* ((process (pop3-open-server pop3-mailhost pop3-port))
-	 (crashbuf (get-buffer-create " *pop3-retr*"))
-	 (n 1)
-	 (msgid 1)
-	 (msglen 0)
-	 message-count
-	 (password pop3-password)
-	 (retrieved-messages '())
-	 message-list)
-    ;; for debugging only
-    (if pop3-debug (switch-to-buffer (process-buffer process)))
-    ;; query for password
-    (if (and pop3-password-required (not pop3-password))
-	(setq password
-	      (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
-    (cond ((equal 'apop pop3-authentication-scheme)
-	   (pop3-apop process password pop3-maildrop))
-	  ((equal 'pass pop3-authentication-scheme)
-	   (pop3-user process pop3-maildrop)
-	   (pop3-pass process password))
-	  (t (error "Invalid POP3 authentication scheme.")))
-    ;; cache the password if required
-    (when pop3-cache-password
-      (setq pop3-password password))
-    ;; reset uidl support
-    (unless pop3-uidl-support 
-      (setq pop3-uidl-support 'dont-know))
-    ;; get messages that are suitable for download
-    (message "Retrieving message list...")
-    (setq message-list (pop3-get-message-numbers process))
-    (setq message-count (length message-list))
-    (message (format "Retrieving message list...%d unread" message-count))
-    ;; now get messages
-    (unwind-protect
-	(while (<= n message-count)
-	  (setq msgid (car (car message-list)))
-	  (setq msglen (cdr (car message-list)))
-	  (setq message-list (cdr message-list))
-	  ;; only retrieve messages matching our regexp or in the uidl list
-	  (if (or (not msgid)
-		  ;; don't download messages that are too large
-		  (and pop3-maximum-message-size 
-		       (> msglen pop3-maximum-message-size))
-		  (and (or (null pop3-leave-mail-on-server)
-			   ;; we top messages that are longer than 10k
-			   ;; since retrieving a large message only to
-			   ;; ignore it is wasteful.
-			   (> msglen 10000))
-		       pop3-retr-regexp
-		       (not (string-match pop3-retr-regexp
-					  (pop3-top process msgid)))))
-	      (message (format "Ignoring message %d of %d from %s..."
-			       n message-count pop3-mailhost))
-	    (message (format "Retrieving message %d of %d from %s..."
-			     n message-count pop3-mailhost))
-	    (if (pop3-retr process msgid crashbuf)
-		(setq retrieved-messages (cons msgid retrieved-messages))
-	      (message (format "Retrieving message %d of %d from %s...ignored"
-			       n message-count pop3-mailhost))))
-	  ;; deleted a whole bunch of stuff here that updates the crashbox
-	  ;; incrementally. This is way slow and mostly uneccessary, gnus
-	  ;; and others will simply slurp the whole mail buffer anyway so
-	  ;; why bother?
-	  (setq n (+ 1 n)))
-      ;; frob the crash buffer at the end
-      (set-buffer crashbuf)
-      (let ((coding-system-for-write 'binary))
-	(append-to-file (point-min) (point-max) crashbox))
-      ;; mark messages as read
-      (when pop3-leave-mail-on-server
-	(pop3-save-uidls))
-      ;; now delete the messages we have retrieved
-      (unless (and pop3-leave-mail-on-server (null pop3-delete-retrieved-mail))
-	(mapcar
-	 '(lambda (n)
-	    (message (format "Deleting message %d of %d from %s..."
-			     n message-count pop3-mailhost))
-	    (pop3-dele process n)) retrieved-messages))
-      (pop3-quit process))
-    (kill-buffer crashbuf)
-    )
-  t)
-
-(defun pop3-open-server (mailhost port)
-  "Open TCP connection to MAILHOST.
-Returns the process associated with the connection."
-  (let ((process-buffer
-	 (get-buffer-create (format "trace of POP session to %s" mailhost)))
-	(process)
-	(coding-system-for-read 'binary)
-	(coding-system-for-write 'binary))
-    (save-excursion
-      (set-buffer process-buffer)
-      (erase-buffer))
-    (setq process
-	  (open-network-stream "POP" process-buffer mailhost port))
-    (setq pop3-read-point (point-min))
-    (let ((response (pop3-read-response process t)))
-      (setq pop3-timestamp
-	    (substring response (or (string-match "<" response) 0)
-		       (+ 1 (or (string-match ">" response) -1)))))
-    process
-    ))
-
-;; Support functions
-
-(defun pop3-process-filter (process output)
-  (save-excursion
-    (set-buffer (process-buffer process))
-    (goto-char (point-max))
-    (insert output)))
-
-(defun pop3-send-command (process command)
-    (set-buffer (process-buffer process))
-    (goto-char (point-max))
-;;    (if (= (aref command 0) ?P)
-;;	(insert "PASS \r\n")
-;;      (insert command "\r\n"))
-    (setq pop3-read-point (point))
-    (goto-char (point-max))
-    (process-send-string process (concat command "\r\n"))
-    )
-
-(defun pop3-read-response (process &optional return)
-  "Read the response from the server.
-Return the response string if optional second argument is non-nil."
-  (let ((case-fold-search nil)
-	match-end)
-    (save-excursion
-      (set-buffer (process-buffer process))
-      (goto-char pop3-read-point)
-      (while (not (search-forward "\r\n" nil t))
-	(accept-process-output process)
-	(goto-char pop3-read-point))
-      (setq match-end (point))
-      (goto-char pop3-read-point)
-      (if (looking-at "-ERR")
-	  (signal 'error (list (buffer-substring (point) (- match-end 2))))
-	(if (not (looking-at "+OK"))
-	    (progn (setq pop3-read-point match-end) nil)
-	  (setq pop3-read-point match-end)
-	  (if return
-	      (buffer-substring (point) match-end)
-	    t)
-	  )))))
-
-(defun pop3-string-to-list (string &optional regexp)
-  "Chop up a string into a list."
-  (let ((list)
-	(regexp (or regexp " "))
-	(string (if (string-match "\r" string)
-		    (substring string 0 (match-beginning 0))
-		  string)))
-    (store-match-data nil)
-    (while string
-      (if (string-match regexp string)
-	  (setq list (cons (substring string 0 (- (match-end 0) 1)) list)
-		string (substring string (match-end 0)))
-	(setq list (cons string list)
-	      string nil)))
-    (nreverse list)))
-
-(defvar pop3-read-passwd nil)
-(defun pop3-read-passwd (prompt)
-  (if (not pop3-read-passwd)
-      (if (load "passwd" t)
-	  (setq pop3-read-passwd 'read-passwd)
-	(autoload 'ange-ftp-read-passwd "ange-ftp")
-	(setq pop3-read-passwd 'ange-ftp-read-passwd)))
-  (funcall pop3-read-passwd prompt))
-
-(defun pop3-clean-region (start end)
-  "Convert CRLF line endings to LF line endings.
-Also remove '.' from the beginning of lines.
-Also escape 'From ' after '\n\n' with '>' (for mbox)."
-  (setq end (set-marker (make-marker) end))
-  (save-excursion
-    (goto-char start)
-    (while (and (< (point) end) (search-forward "\r\n" end t))
-      (replace-match "\n" t t))
-    (goto-char start)
-	(while (re-search-forward "\n\n\\(From \\)" end t)
-	  (replace-match "\n\n>\\1" t nil))
-    (goto-char start)
-    (while (and (< (point) end) (re-search-forward "^\\." end t))
-      (replace-match "" t t)
-      (forward-char)))
-  (set-marker end nil))
-
-(defun pop3-munge-message-separator (start end)
-  "Check to see if a message separator exists.  If not, generate one."
-  (if (not (fboundp 'message-make-date)) (autoload 'message-make-date "message"))
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      (if (not (or (looking-at "From .?") ; Unix mail
-		   (looking-at "\001\001\001\001\n") ; MMDF
-		   (looking-at "BABYL OPTIONS:") ; Babyl
-		   ))
-	  (let ((from (mail-strip-quoted-names (mail-fetch-field "From")))
-		(date (pop3-string-to-list (or (mail-fetch-field "Date")
-					       (message-make-date))))
-		(From_))
-	    ;; sample date formats I have seen
-	    ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
-	    ;; Date: 08 Jul 1996 23:22:24 -0400
-	    ;; should be
-	    ;; Tue Jul 9 09:04:21 1996
-	    (setq date
-		  (cond ((string-match "[A-Z]" (nth 0 date))
-			 (format "%s %s %s %s %s"
-				 (nth 0 date) (nth 2 date) (nth 1 date)
-				 (nth 4 date) (nth 3 date)))
-			(t
-			 ;; this really needs to be better but I don't feel
-			 ;; like writing a date to day converter.
-			 (format "Sun %s %s %s %s"
-				 (nth 1 date) (nth 0 date)
-				 (nth 3 date) (nth 2 date)))
-			))
-	    (setq From_ (format "\nFrom %s  %s\n" from date))
-	    (while (string-match "," From_)
-	      (setq From_ (concat (substring From_ 0 (match-beginning 0))
-				  (substring From_ (match-end 0)))))
-	    (goto-char (point-min))
-	    (insert From_)
-	    (re-search-forward "\n\n")
-	    (narrow-to-region (point) (point-max))
-	    (let ((size (- (point-max) (point-min))))
-	      (goto-char (point-min))
-	      (widen)
-	      (forward-line -1)
-	      (insert (format "Content-Length: %s\n" size)))
-	    )))))
-
-;; UIDL support, mostly copied from epop3
-
-(defun pop3-get-message-numbers (process)
-  "Get the list of message numbers and lengths to retrieve via PROCESS."
-  ;; we use the LIST comand first anyway to get the message lengths.
-  ;; then if we're leaving mail on the server, see if the UIDL command
-  ;; is implemented. if so, we use it to get the message number list.
-  (let ((msg-list (pop3-list process))
-	(uidl (if pop3-leave-mail-on-server
-		  (pop3-get-uidl process)))
-	(tmplist '()))
-    (when msg-list
-      (setq msg-list (cdr msg-list))
-      (if (eq pop3-uidl-support t)
-	  ;; remove elements not in the uidl, this assumes the uidl is short
-	  (mapcar '(lambda (elt)
-		     (when (memq (car elt) uidl)
-		       (push elt tmplist))) (reverse msg-list))
-	(setq tmplist msg-list))
-      tmplist)))
-
-(defun pop3-get-list (process)
-  "Use PROCESS to get a list of message numbers."
-  (let ((pairs (pop3-list process))
-	(tmplist '()))
-    (when pairs
-      (mapcar '(lambda (elt)
-		 (push (car elt) tmplist))
-	      (cdr pairs)) tmplist)))
-
-(defun pop3-get-uidl (process)
-  "Use PROCESS to get a list of unread message numbers."
-  (let ((pairs (pop3-uidl process)))
-    (if (or (null pairs) (null pop3-uidl-support))
-	(setq pop3-uidl-support nil)
-      (setq pop3-uidl-support t)
-      (pop3-init-uidl-tables)
-      (mapcar 'pop3-update-tables (cdr pairs))
-      (pop3-get-unread-message-numbers))))
-
-(defun pop3-init-uidl-tables ()
-  "Create the hash table for uidl processing.
-This is only sensible to do when 'pop3-leave-mail-on-server' is non-nil."
-  (save-excursion
-    (with-temp-buffer
-      (let ((uid nil))
-	(when (file-readable-p pop3-uidl-file-name)
-	  (insert-file-contents pop3-uidl-file-name))
-	(setq pop3-utab (make-hash-table :test 'equal))
-	(goto-char (point-min))
-	(while (looking-at "\\([^ \n\t]+\\)")
-	  (setq uid (buffer-substring (match-beginning 1) (match-end 1)))
-	  (puthash uid (cons nil t) pop3-utab)
-	  (forward-line 1))))))
-
-(defun pop3-get-unread-message-numbers ()
-  "Return a sorted list of unread msg numbers to retrieve."
-  (let ((pop3-tmplist '()))
-    (maphash '(lambda (key val)
-		(if (not (cdr val))
-		    (push (car val) pop3-tmplist))) pop3-utab) 
-    (sort pop3-tmplist '<)))
-
-(defun pop3-update-tables (pair)
-  "Update uidl hash-tables given a PAIR list (msgno uid)."
-  (let ((msgno (car pair))
-        (uid (cdr pair)))
-    (if (null (gethash uid pop3-utab))
-	(puthash uid (cons msgno nil) pop3-utab)
-      (puthash uid (cons msgno t) pop3-utab))))
-    
-;    (if (null (gethash msgno pop3-utab))
-;        (puthash uid uid pop3-utab))))
-
-(defun pop3-save-uidls ()
-  "Save the updated UIDLs to disk for use next time."
-  ;;
-  ;; write the uidl, msgid to the local uidl file EXCEPT the ones which
-  ;; don't have msgnos, since they've been deleted from the server
-  ;;
-
-  (when (and pop3-leave-mail-on-server
-             pop3-utab
-             (hash-table-count pop3-utab))
-    (save-excursion
-      (with-temp-buffer
-        ;; back this up because we'll write to it later.
-        (when (file-readable-p pop3-uidl-file-name)
-          (copy-file pop3-uidl-file-name
-                     (concat pop3-uidl-file-name ".old")
-                     t t))
-        (maphash '(lambda (key val)
-		    (when (car val)
-		      (insert (format "%s\n" key))))
-		 pop3-utab)
-        (write-file pop3-uidl-file-name)))))
-
-;; The Command Set
-
-;; AUTHORIZATION STATE
-
-(defun pop3-user (process user)
-  "Send USER information to POP3 server."
-  (pop3-send-command process (format "USER %s" user))
-  (let ((response (pop3-read-response process t)))
-    (if (not (and response (string-match "+OK" response)))
-	(error (format "USER %s not valid." user)))))
-
-(defun pop3-pass (process password)
-  "Send authentication information to the server."
-  (pop3-send-command process (format "PASS %s" password))
-  (let ((response (pop3-read-response process t)))
-    (if (not (and response (string-match "+OK" response)))
-	(pop3-quit process))))
-
-(defun pop3-apop (process password user)
-  "Send alternate authentication information to the server."
-  (if (not (fboundp 'md5)) (autoload 'md5 "md5"))
-  (let ((hash (md5 (concat pop3-timestamp password))))
-    (pop3-send-command process (format "APOP %s %s" user hash))
-    (let ((response (pop3-read-response process t)))
-      (if (not (and response (string-match "+OK" response)))
-	  (pop3-quit process)))))
-
-;; TRANSACTION STATE
-
-(defun pop3-stat (process)
-  "Return the number of messages in the maildrop and the maildrop's size."
-  (pop3-send-command process "STAT")
-  (let ((response (pop3-read-response process t)))
-    (list (string-to-int (nth 1 (pop3-string-to-list response)))
-	  (string-to-int (nth 2 (pop3-string-to-list response))))
-    ))
-
-(defun pop3-retr (process msg crashbuf)
-  "Retrieve message-id MSG to buffer CRASHBUF."
-  (pop3-send-command process (format "RETR %s" msg))
-  (pop3-read-response process)
-;  (accept-process-output process)
-  (save-excursion
-    (let ((retrieved t))
-      (pop3-get-extended-response process)
-      (pop3-munge-message-separator pop3-extended-response-beginning
-				    pop3-extended-response-end)
-      ;; only get message if it matches
-      (if (or (null pop3-leave-mail-on-server)
-	      (null pop3-retr-regexp)
-	      (and (goto-char pop3-extended-response-beginning)
-		   (re-search-forward pop3-retr-regexp pop3-extended-response-end t)))
-	  (append-to-buffer crashbuf pop3-extended-response-beginning
-			    pop3-extended-response-end)
-	;; we didn't get it
-	(setq retrieved nil))
-      (delete-region pop3-extended-response-beginning
-		     pop3-extended-response-end)
-      retrieved)))
-
-(defun pop3-dele (process msg)
-  "Mark message-id MSG as deleted."
-  (pop3-send-command process (format "DELE %s" msg))
-  (pop3-read-response process))
-
-(defun pop3-noop (process msg)
-  "No-operation."
-  (pop3-send-command process "NOOP")
-  (pop3-read-response process))
-
-(defun pop3-last (process)
-  "Return highest accessed message-id number for the session."
-  (pop3-send-command process "LAST")
-  (let ((response (pop3-read-response process t)))
-    (string-to-int (nth 1 (pop3-string-to-list response)))
-    ))
-
-(defun pop3-rset (process)
-  "Remove all delete marks from current maildrop."
-  (pop3-send-command process "RSET")
-  (pop3-read-response process))
-
-;; UPDATE
-
-(defun pop3-quit (process)
-  "Close connection to POP3 server.
-Tell server to remove all messages marked as deleted, unlock the maildrop,
-and close the connection."
-  (pop3-send-command process "QUIT")
-  (pop3-read-response process t)
-  (if process
-      (save-excursion
-	(set-buffer (process-buffer process))
-	(goto-char (point-max))
-	(delete-process process))))
-
-(defun pop3-uidl (process &optional msgno)
-  "Return the results of a UIDL command in PROCESS for optional MSGNO.
-If UIDL is unsupported on this mail server or if msgno is invalid, return nil.
-Otherwise, return a list in the form
-
-   (N (1 UIDL-1) (2 UIDL-2) ... (N UIDL-N))
-
-where
-
-   N is an integer for the number of UIDLs returned (could be 0)
-   UIDL-n is a string."
-
-  (if msgno
-      (pop3-send-command process (format "UIDL %d" msgno))
-    (pop3-send-command process "UIDL"))
-  
-  (let ((uidl-not-supported nil))
-    (condition-case ()
-        (pop3-read-response process t)
-      (error (setq uidl-not-supported t)))
-
-    (unless uidl-not-supported
-      (let ((retlist '())
-            (uidl nil)
-            (msgno nil))
-        (save-excursion
-          (pop3-get-extended-response process)
-          (goto-char pop3-extended-response-beginning)
-	  
-          (while (looking-at "\\([^ \n\t]*\\) \\([^ \n\t]*\\)")
-            (setq msgno (string-to-int
-                         (buffer-substring (match-beginning 1) (match-end 1))))
-            (setq uidl (buffer-substring (match-beginning 2) (match-end 2)))
-            (push (cons msgno uidl) retlist)
-            (beginning-of-line 2))
-          (cons (length retlist) (nreverse retlist)))))))
-
-(defun pop3-list (process &optional msgno)
-  "Return the results of a LIST command for PROCESS and optional MSGNO.
-If (optional) msgno is invalid, return nil.  Otherwise, return a list
-in the form
-
-   (N (1 LEN-1) (2 LEN-2) ... (N LEN-N))
-
-where
-
-   N is an integer for the number of msg/len pairs (could be 0)
-   LEN-n is an integer."
-  (let ((bad-msgno nil))
-
-    (if msgno
-	(pop3-send-command process (format "LIST %d" msgno))
-      (pop3-send-command process "LIST"))
-
-    (condition-case ()
-	(pop3-read-response process t)
-      (error (setq bad-msgno t)))
-    
-    (unless bad-msgno
-      (let ((retlist '())
-	    (len nil)
-	    (msgno nil))
-	(save-excursion
-	  (pop3-get-extended-response process)
-	  (goto-char pop3-extended-response-beginning)
-	  
-	  (while (looking-at "\\([^ \n\t]*\\) \\([^ \n\t]*\\)")
-	    (setq msgno (string-to-int
-			 (buffer-substring (match-beginning 1) (match-end 1))))
-	    (setq len (string-to-int
-		       (buffer-substring (match-beginning 2) (match-end 2))))
-	    (push (cons msgno len) retlist)
-	    (beginning-of-line 2))
-	  (cons (length retlist) (nreverse retlist)))))))
-
-(defun pop3-top (process msgno &optional lines)
-  "Return the top LINES of messages for PROCESS and MSGNO.
-If msgno is invalid, return nil.  Otherwise, return a string."
-  (let ((bad-msgno nil))
-    (pop3-send-command process (format "TOP %d %d" msgno (or lines 1)))
-    ;; get a response
-    (condition-case ()
-	(pop3-read-response process t)
-      (error (setq bad-msgno t)))
-
-    (unless bad-msgno
-      (save-excursion
-	(pop3-get-extended-response process)
-	(buffer-substring pop3-extended-response-beginning
-			  pop3-extended-response-end)))))
-
-;;; Utility code
-
-(defun pop3-get-extended-response (process)
-  "Get the extended pop3 response in the PROCESS buffer."
-  (let ((start pop3-read-point) end)
-    (set-buffer (process-buffer process))
-    (while (not (re-search-forward "^\\.\r\n" nil t))
-      (accept-process-output process)
-      (goto-char start))
-    (setq pop3-extended-response-beginning start)
-    (setq pop3-read-point (point-marker))
-    (goto-char (match-beginning 0))
-    (setq end (point-marker)
-	  pop3-extended-response-end (point-marker))
-    (pop3-clean-region start end)))
-
-
-;; Summary of POP3 (Post Office Protocol version 3) commands and responses
-
-;;; AUTHORIZATION STATE
-
-;; Initial TCP connection
-;; Arguments: none
-;; Restrictions: none
-;; Possible responses:
-;;  +OK [POP3 server ready]
-
-;; USER name
-;; Arguments: a server specific user-id (required)
-;; Restrictions: authorization state [after unsuccessful USER or PASS
-;; Possible responses:
-;;  +OK [valid user-id]
-;;  -ERR [invalid user-id]
-
-;; PASS string
-;; Arguments: a server/user-id specific password (required)
-;; Restrictions: authorization state, after successful USER
-;; Possible responses:
-;;  +OK [maildrop locked and ready]
-;;  -ERR [invalid password]
-;;  -ERR [unable to lock maildrop]
-
-;;; TRANSACTION STATE
-
-;; STAT
-;; Arguments: none
-;; Restrictions: transaction state
-;; Possible responses:
-;;  +OK nn mm [# of messages, size of maildrop]
-
-;; LIST [msg]
-;; Arguments: a message-id (optional)
-;; Restrictions: transaction state; msg must not be deleted
-;; Possible responses:
-;;  +OK [scan listing follows]
-;;  -ERR [no such message]
-
-;; TOP msg [lines]
-;; Arguments: a message-id (required), number of lines (optional)
-;; Restrictions: transaction state; msg must not be deleted
-;; Possible responses:
-;;  +OK [partial message listing follows]
-;;  -ERR [no such message]
-
-;; UIDL [msg]
-;; Arguments: a message-id (optional)
-;; Restrictions: transaction state; msg must not be deleted
-;; Possible responses:
-;;  +OK [uidl listing follows]
-;;  -ERR [no such message]
-
-;; RETR msg
-;; Arguments: a message-id (required)
-;; Restrictions: transaction state; msg must not be deleted
-;; Possible responses:
-;;  +OK [message contents follow]
-;;  -ERR [no such message]
-
-;; DELE msg
-;; Arguments: a message-id (required)
-;; Restrictions: transaction state; msg must not be deleted
-;; Possible responses:
-;;  +OK [message deleted]
-;;  -ERR [no such message]
-
-;; NOOP
-;; Arguments: none
-;; Restrictions: transaction state
-;; Possible responses:
-;;  +OK
-
-;; LAST
-;; Arguments: none
-;; Restrictions: transaction state
-;; Possible responses:
-;;  +OK nn [highest numbered message accessed]
-
-;; RSET
-;; Arguments: none
-;; Restrictions: transaction state
-;; Possible responses:
-;;  +OK [all delete marks removed]
-
-;;; UPDATE STATE
-
-;; QUIT
-;; Arguments: none
-;; Restrictions: none
-;; Possible responses:
-;;  +OK [TCP connection closed]
-
-;; pop3 ends here
-(provide 'pop3)
-
diff --git a/xemacs-packages/lisp/mail-lib/reporter.el b/xemacs-packages/lisp/mail-lib/reporter.el
deleted file mode 100644
index 058d0a83..00000000
--- a/xemacs-packages/lisp/mail-lib/reporter.el
+++ /dev/null
@@ -1,413 +0,0 @@
-;;; reporter.el --- customizable bug reporting of lisp programs
-
-;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
-
-;; Author:          1993-1998 Barry A. Warsaw
-;; Maintainer:      FSF
-;; Created:         19-Apr-1993
-;; Keywords: maint mail 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; End User Interface
-;; ==================
-;; The variable `mail-user-agent' contains a symbol indicating which
-;; Emacs mail package end users would like to use to compose outgoing
-;; mail.  See that variable for details (it is no longer defined in
-;; this file).
-
-;; Lisp Package Authors
-;; ====================
-;; reporter.el was written primarily for Emacs Lisp package authors so
-;; that their users can more easily report bugs.  When invoked,
-;; `reporter-submit-bug-report' will set up an outgoing mail buffer
-;; with the appropriate bug report address, including a lisp
-;; expression the maintainer of the package can evaluate to completely
-;; reproduce the environment in which the bug was observed (e.g. by
-;; using `eval-last-sexp').  This package proved especially useful
-;; during my development of CC Mode, which is highly dependent on its
-;; configuration variables.
-;;
-;; Do a "C-h f reporter-submit-bug-report" for more information.
-;; Here's an example usage:
-;;
-;;(defconst mypkg-version "9.801")
-;;(defconst mypkg-maintainer-address "mypkg-help@foo.com")
-;;(defun mypkg-submit-bug-report ()
-;;  "Submit via mail a bug report on mypkg"
-;;  (interactive)
-;;  (require 'reporter)
-;;  (reporter-submit-bug-report
-;;   mypkg-maintainer-address
-;;   (concat "mypkg.el " mypkg-version)
-;;   (list 'mypkg-variable-1
-;;         'mypkg-variable-2
-;;         ;; ...
-;;         'mypkg-variable-last)))
-
-;;; Code:
-
-
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; Package author interface variables
-
-(defvar reporter-prompt-for-summary-p nil
-  "Interface variable controlling prompting for problem summary.
-When non-nil, `reporter-submit-bug-report' prompts the user for a
-brief summary of the problem, and puts this summary on the Subject:
-line.  If this variable is a string, that string is used as the prompt
-string.
-
-Default behavior is to not prompt (i.e. nil).  If you want reporter to
-prompt, you should `let' bind this variable before calling
-`reporter-submit-bug-report'.  Note that this variable is not
-buffer-local so you should never just `setq' it.")
-
-(defvar reporter-dont-compact-list nil
-  "Interface variable controlling compacting of list values.
-When non-nil, this must be a list of variable symbols.  When a
-variable containing a list value is formatted in the bug report mail
-buffer, it normally is compacted so that its value fits one the fewest
-number of lines.  If the variable's symbol appears in this list, its
-value is printed in a more verbose style, specifically, one elemental
-sexp per line.
-
-Note that this variable is not buffer-local so you should never just
-`setq' it.  If you want to changes its default value, you should `let'
-bind it.")
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; End of editable variables
-
-
-(defvar reporter-eval-buffer nil
-  "Buffer to retrieve variable's value from.
-This is necessary to properly support the printing of buffer-local
-variables.  Current buffer will always be the mail buffer being
-composed.")
-
-(defvar reporter-initial-text nil
-  "The automatically created initial text of a bug report.")
-(make-variable-buffer-local 'reporter-initial-text)
-
-
-
-;; status feedback to the user
-(defvar reporter-status-message nil)
-(defvar reporter-status-count nil)
-
-(defun reporter-update-status ()
-  "Periodically output a status message."
-  (if (zerop (% reporter-status-count 10))
-      (progn
-	(message reporter-status-message)
-	(setq reporter-status-message (concat reporter-status-message "."))))
-  (setq reporter-status-count (1+ reporter-status-count)))
-
-
-;; dumping/pretty printing of values
-(defun reporter-beautify-list (maxwidth compact-p)
-  "Pretty print a list."
-  (reporter-update-status)
-  (let ((move t)
-	linebreak indent-enclosing-p indent-p here)
-    (condition-case nil			;loop exit
-	(progn
-	  (down-list 1)
-	  (setq indent-enclosing-p t)
-	  (while move
-	    (setq here (point))
-	    ;; The following line is how we break out of the while
-	    ;; loop, in one of two ways.  Either we've hit the end of
-	    ;; the buffer, in which case scan-sexps returns nil, or
-	    ;; we've crossed unbalanced parens and it will raise an
-	    ;; error we're expecting to catch.
-	    (setq move (scan-sexps (point) 1))
-	    (goto-char move)
-	    (if (<= maxwidth (current-column))
-		(if linebreak
-		    (progn
-		      (goto-char linebreak)
-		      (newline-and-indent)
-		      (setq linebreak nil))
-		  (goto-char here)
-		  (setq indent-p (reporter-beautify-list maxwidth compact-p))
-		  (goto-char here)
-		  (forward-sexp 1)
-		  (if indent-p
-		      (newline-and-indent))
-		  t)
-	      (if compact-p
-		  (setq linebreak (point))
-		(newline-and-indent))
-	      ))
-	  t)
-      (error indent-enclosing-p))))
-
-(defun reporter-lisp-indent (indent-point state)
-  "A better lisp indentation style for bug reporting."
-  (save-excursion
-    (goto-char (1+ (nth 1 state)))
-    (current-column)))
-
-(defun reporter-dump-variable (varsym mailbuf)
-  "Pretty-print the value of the variable in symbol VARSYM.
-MAILBUF is the mail buffer being composed."
-  (reporter-update-status)
-  (condition-case nil
-      (let ((val (save-excursion
-		   (set-buffer reporter-eval-buffer)
-		   (symbol-value varsym)))
-	    (sym (symbol-name varsym))
-	    (print-escape-newlines t)
-	    (maxwidth (1- (window-width)))
-	    (here (point)))
-	(insert "     " sym " "
-		(cond
-		 ((memq val '(t nil)) "")
-		 ((listp val) "'")
-		 ((symbolp val) "'")
-		 (t ""))
-		(prin1-to-string val))
-	(lisp-indent-line)
-	;; clean up lists, but only if the line as printed was long
-	;; enough to wrap
-	(if (and val			;nil is a list, but short
-		 (listp val)
-		 (<= maxwidth (current-column)))
-	    (save-excursion
-	      (let ((compact-p (not (memq varsym reporter-dont-compact-list)))
-		    (lisp-indent-function 'reporter-lisp-indent))
-		(goto-char here)
-		(reporter-beautify-list maxwidth compact-p))))
-	(insert "\n"))
-    (void-variable
-     (save-excursion
-       (set-buffer mailbuf)
-       (mail-position-on-field "X-Reporter-Void-Vars-Found")
-       (end-of-line)
-       (insert (symbol-name varsym) " ")))
-    (error
-     (error ""))))
-
-(defun reporter-dump-state (pkgname varlist pre-hooks post-hooks)
-  "Dump the state of the mode specific variables.
-PKGNAME contains the name of the mode as it will appear in the bug
-report (you must explicitly concat any version numbers).
-
-VARLIST is the list of variables to dump.  Each element in
-VARLIST can be a variable symbol, or a cons cell.  If a symbol,
-this will be passed to `reporter-dump-variable' for insertion
-into the mail buffer.  If a cons cell, the car must be a variable
-symbol and the cdr must be a function which will be `funcall'd
-with arguments the symbol and the mail buffer being composed.  Use
-this to write your own custom variable value printers for
-specific variables.
-
-Note that the global variable `reporter-eval-buffer' will be bound to
-the buffer in which `reporter-submit-bug-report' was invoked.  If you
-want to print the value of a buffer local variable, you should wrap
-the `eval' call in your custom printer inside a `set-buffer' (and
-probably a `save-excursion').  `reporter-dump-variable' handles this
-properly.
-
-PRE-HOOKS is run after the Emacs version and PKGNAME are inserted, but
-before the VARLIST is dumped.  POST-HOOKS is run after the VARLIST is
-dumped."
-  (let ((buffer (current-buffer)))
-    (set-buffer buffer)
-    (insert "Emacs  : " (emacs-version) "\n")
-    (and pkgname
-	 (insert "Package: " pkgname "\n"))
-    (run-hooks 'pre-hooks)
-    (if (not varlist)
-	nil
-      (insert "\ncurrent state:\n==============\n")
-      ;; create an emacs-lisp-mode buffer to contain the output, which
-      ;; we'll later insert into the mail buffer
-      (condition-case fault
-	  (let ((mailbuf (current-buffer))
-		(elbuf (get-buffer-create " *tmp-reporter-buffer*")))
-	    (save-excursion
-	      (set-buffer elbuf)
-	      (emacs-lisp-mode)
-	      (erase-buffer)
-	      (insert "(setq\n")
-	      (lisp-indent-line)
-	      (mapcar
-	       (function
-		(lambda (varsym-or-cons-cell)
-		  (let ((varsym (or (car-safe varsym-or-cons-cell)
-				    varsym-or-cons-cell))
-			(printer (or (cdr-safe varsym-or-cons-cell)
-				     'reporter-dump-variable)))
-		    (funcall printer varsym mailbuf)
-		    )))
-	       varlist)
-	      (lisp-indent-line)
-	      (insert ")\n"))
-	    (insert-buffer-substring elbuf))
-	(error
-	 (insert "State could not be dumped due to the following error:\n\n"
-		 (format "%s" fault)
-		 "\n\nYou should still send this bug report."))))
-    (run-hooks 'post-hooks)
-    ))
-
-
-(defun reporter-compose-outgoing ()
-  "Compose the outgoing mail buffer.
-
-Return the selected paradigm, with the current buffer tacked onto the
-beginning of the list."
-  (let* ((agent mail-user-agent)
-	 (compose (get mail-user-agent 'composefunc)))
-    ;; Sanity check.  If this fails then we'll try to use the SENDMAIL
-    ;; protocol, otherwise we must signal an error.
-    (if (not (and compose (functionp compose)))
-	(progn
-	  (setq agent 'sendmail-user-agent
-		compose (get agent 'composefunc))
-	  (if (not (and compose (functionp compose)))
-	      (error "Could not find a valid `mail-user-agent'")
-	    (ding)
-	    (message "`%s' is an invalid `mail-user-agent'; using `sendmail-user-agent'"
-		     mail-user-agent)
-	    )))
-    (funcall compose)
-    agent))
-
-
-;;;###autoload
-(defun reporter-submit-bug-report
-  (address pkgname varlist &optional pre-hooks post-hooks salutation)
-"Begin submitting a bug report via email.
-
-ADDRESS is the email address for the package's maintainer.  PKGNAME is
-the name of the package (if you want to include version numbers,
-you must put them into PKGNAME before calling this function).
-Optional PRE-HOOKS and POST-HOOKS are passed to `reporter-dump-state'.
-Optional SALUTATION is inserted at the top of the mail buffer,
-and point is left after the salutation.
-
-VARLIST is the list of variables to dump (see `reporter-dump-state'
-for details).  The optional argument PRE-HOOKS and POST-HOOKS are
-passed to `reporter-dump-state'.  Optional argument SALUTATION is text
-to be inserted at the top of the mail buffer; in that case, point is
-left after that text.
-
-This function prompts for a summary if `reporter-prompt-for-summary-p'
-is non-nil.
-
-This function does not send a message; it uses the given information
-to initialize a message, which the user can then edit and finally send
-\(or decline to send).  The variable `mail-user-agent' controls which
-mail-sending package is used for editing and sending the message."
-  (let ((reporter-eval-buffer (current-buffer))
-	final-resting-place
-	after-sep-pos
-	(reporter-status-message "Formatting bug report buffer...")
-	(reporter-status-count 0)
-	(problem (and reporter-prompt-for-summary-p
-		      (read-string (if (stringp reporter-prompt-for-summary-p)
-				       reporter-prompt-for-summary-p
-				     "(Very) brief summary of problem: "))))
-	(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 address)
-    ;; insert problem summary if available
-    (if (and reporter-prompt-for-summary-p problem pkgname)
-	(progn
-	  (mail-position-on-field "subject")
-	  (insert pkgname "; " problem)))
-    ;; move point to the body of the message
-    (mail-text)
-    (forward-line 1)
-    (setq after-sep-pos (point))
-    (and salutation (insert "\n" salutation "\n\n"))
-    (unwind-protect
-	(progn
-	  (setq final-resting-place (point-marker))
-	  (insert "\n\n")
-	  (reporter-dump-state pkgname varlist pre-hooks post-hooks)
-	  (goto-char final-resting-place))
-      (set-marker final-resting-place nil))
-
-    ;; save initial text and set up the `no-empty-submission' hook.
-    ;; This only works for mailers that support a pre-send hook, and
-    ;; for which the paradigm has a non-nil value for the `hookvar'
-    ;; key in its agent (i.e. sendmail.el's mail-send-hook).
-    (save-excursion
-      (goto-char (point-max))
-      (skip-chars-backward " \t\n")
-      (setq reporter-initial-text (buffer-substring after-sep-pos (point))))
-    (if (setq hookvar (get agent 'hookvar))
-	(add-hook hookvar 'reporter-bug-hook nil t))
-
-    ;; 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 "Please enter your report.  Type %s to send, %s to abort."
-	       sendkey abortkey))
-    ))
-
-(defun reporter-bug-hook ()
-  "Prohibit sending mail if empty bug report."
-  (let ((after-sep-pos
-	 (save-excursion
-	   (rfc822-goto-eoh)
-	   (forward-line 1)
-	   (point))))
-    (save-excursion
-      (goto-char (point-max))
-      (skip-chars-backward " \t\n")
-      (if (and (= (- (point) after-sep-pos)
-		  (length reporter-initial-text))
-	       (string= (buffer-substring after-sep-pos (point))
-			reporter-initial-text))
-	  (error "Empty bug report cannot be sent"))
-      )))
-
-
-(provide 'reporter)
-
-;;; arch-tag: 33612ff4-fbbc-4be2-b183-560ce9e0199b
-;;; reporter.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/rfc2104.el b/xemacs-packages/lisp/mail-lib/rfc2104.el
deleted file mode 100644
index bdacc19e..00000000
--- a/xemacs-packages/lisp/mail-lib/rfc2104.el
+++ /dev/null
@@ -1,120 +0,0 @@
-;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes
-
-;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson 
-;; Keywords: mail
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; This is a quick'n'dirty, low performance, implementation of RFC2104.
-;;;
-;;; Example:
-;;;
-;;; (require 'md5)
-;;; (rfc2104-hash 'md5 64 16 "Jefe" "what do ya want for nothing?")
-;;; "750c783e6ab0b503eaa86e310a5db738"
-;;;
-;;; (require 'sha-1)
-;;; (rfc2104-hash 'sha1-encode 64 20 "Jefe" "what do ya want for nothing?")
-;;; "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"
-;;;
-;;; 64 is block length of hash function (64 for MD5 and SHA), 16 is
-;;; resulting hash length (16 for MD5, 20 for SHA).
-;;;
-;;; Tested with Emacs 20.2 and XEmacs 20.3.
-;;;
-;;; Test case reference: RFC 2202.
-
-;;; Release history:
-;;;
-;;; 1998-08-16  initial release posted to gnu.emacs.sources
-;;; 1998-08-17  use append instead of char-list-to-string
-;;; 1998-08-26  don't require hexl
-;;; 1998-09-25  renamed from hmac.el to rfc2104.el, also renamed functions
-;;; 1999-10-23  included in pgnus
-;;; 2000-08-15  `rfc2104-hexstring-to-bitstring'
-;;; 2000-05-12  added sha-1 example, added test case reference
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-;; Magic character for inner HMAC round. 0x36 == 54 == '6'
-(defconst rfc2104-ipad ?\x36)
-
-;; Magic character for outer HMAC round. 0x5C == 92 == '\'
-(defconst rfc2104-opad ?\x5C)
-
-;; Not so magic character for padding the key. 0x00
-(defconst rfc2104-zero ?\x00)
-
-;; Alist for converting hex to decimal.
-(defconst rfc2104-hex-alist
-  '((?0 . 0)	      (?a . 10)	      (?A . 10)
-    (?1 . 1)	      (?b . 11)	      (?B . 11)
-    (?2 . 2)	      (?c . 12)	      (?C . 12)
-    (?3 . 3)	      (?d . 13)	      (?D . 13)
-    (?4 . 4)	      (?e . 14)	      (?E . 14)
-    (?5 . 5)	      (?f . 15)	      (?F . 15)
-    (?6 . 6)
-    (?7 . 7)
-    (?8 . 8)
-    (?9 . 9)))
-
-(defun rfc2104-hex-to-int (str)
-  (if str
-      (if (listp str)
-	  (+ (* 16 (rfc2104-hex-to-int (cdr str)))
-	     (cdr (assoc (car str) rfc2104-hex-alist)))
-	(rfc2104-hex-to-int (reverse (append str nil))))
-    0))
-
-(defun rfc2104-hexstring-to-bitstring (str)
-  (let (out)
-    (while (< 0 (length str))
-      (push (rfc2104-hex-to-int (substring str -2)) out)
-      (setq str (substring str 0 -2)))
-    (concat out)))
-
-(defun rfc2104-hash (hash block-length hash-length key text)
-  (let* (;; if key is longer than B, reset it to HASH(key)
-	 (key (if (> (length key) block-length)
-		  (funcall hash key) key))
-	 (k_ipad (append key nil))
-	 (k_opad (append key nil)))
-    ;; zero pad k_ipad/k_opad
-    (while (< (length k_ipad) block-length)
-      (setq k_ipad (append k_ipad (list rfc2104-zero))))
-    (while (< (length k_opad) block-length)
-      (setq k_opad (append k_opad (list rfc2104-zero))))
-    ;; XOR key with ipad/opad into k_ipad/k_opad
-    (setq k_ipad (mapcar (lambda (c) (logxor c rfc2104-ipad)) k_ipad))
-    (setq k_opad (mapcar (lambda (c) (logxor c rfc2104-opad)) k_opad))
-    ;; perform outer hash
-    (funcall hash (concat k_opad (rfc2104-hexstring-to-bitstring
-				  ;; perform inner hash
-				  (funcall hash (concat k_ipad text)))))))
-
-(provide 'rfc2104)
-
-;;; arch-tag: cf671d5c-a45f-4a09-815e-704e59e43950
-;;; rfc2104.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/rfc822.el b/xemacs-packages/lisp/mail-lib/rfc822.el
deleted file mode 100644
index 8007914f..00000000
--- a/xemacs-packages/lisp/mail-lib/rfc822.el
+++ /dev/null
@@ -1,329 +0,0 @@
-;;; rfc822.el --- hairy rfc822 parser for mail and news and suchlike
-
-;; Copyright (C) 1986, 87, 1990 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik 
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Emacs 21.0.103
-;;; Commentary:
-
-;; Support functions for parsing RFC-822 headers, used by mail and news
-;; modes.  
-
-;;; Code:
-
-;; uses address-start free, throws to address
-(defun rfc822-bad-address (reason)
-  (save-restriction
-    (insert "_^_")
-    (narrow-to-region address-start
-		      (if (re-search-forward "[,;]" nil t)
-			  (max (point-min) (1- (point)))
-			(point-max)))
-    ;; make the error string be suitable for inclusion in (...)
-    (let ((losers '("\\" "(" ")" "\n")))
-      (while losers
-	(goto-char (point-min))
-	(while (search-forward (car losers) nil t)
-	  (backward-char 1)
-	  (insert ?\\)
-	  (forward-char 1))
-	(setq losers (cdr losers))))
-    (goto-char (point-min)) (insert "(Unparsable address -- "
-				    reason
-				    ": \"")
-    (goto-char (point-max)) (insert "\")"))
-  (rfc822-nuke-whitespace)
-  (throw 'address (buffer-substring address-start (point))))
-
-(defun rfc822-nuke-whitespace (&optional leave-space)
-  (let (ch)
-    (while (cond ((eobp)
-		  nil)
-		 ((= (setq ch (following-char)) ?\()
-		  (forward-char 1)
-		  (while (if (eobp)
-			     (rfc822-bad-address "Unbalanced comment (...)")
-			   (/= (setq ch (following-char)) ?\)))
-		    (cond ((looking-at "[^()\\]+")
-			   (replace-match ""))
-			  ((= ch ?\()
-			   (rfc822-nuke-whitespace))
-			  ((< (point) (1- (point-max)))
-			   (delete-char 2))
-			  (t
-			   (rfc822-bad-address "orphaned backslash"))))
-		  ;; delete remaining "()"
-		  (forward-char -1)
-		  (delete-char 2)
-		  t)
-		 ((memq ch '(?\ ?\t ?\n))
-		  (delete-region (point)
-				 (progn (skip-chars-forward " \t\n") (point)))
-		  t)
-		 (t
-		  nil)))
-    (or (not leave-space)
-	(eobp)
-	(bobp)
-	(= (preceding-char) ?\ )
-	(insert ?\ ))))
-
-(defun rfc822-looking-at (regex &optional leave-space)
-  (if (cond ((stringp regex)
-	     (if (looking-at regex)
-		 (progn (goto-char (match-end 0))
-			t)))
-	    (t
-	     (if (and (not (eobp))
-		      (= (following-char) regex))
-		 (progn (forward-char 1)
-			t))))
-      (let ((tem (match-data)))
-	(rfc822-nuke-whitespace leave-space)
-	(set-match-data tem)
-	t)))
-
-(defun rfc822-snarf-word ()
-  ;; word is atom | quoted-string
-  (cond ((= (following-char) ?\")
-	 ;; quoted-string
-	 (or (rfc822-looking-at "\"\\([^\"\\\n]\\|\\\\.\\|\\\\\n\\)*\"")
-	     (rfc822-bad-address "Unterminated quoted string")))
-	((rfc822-looking-at "[^][\000-\037 ()<>@,;:\\\".]+")
-	 ;; atom
-	 )
-	(t
-	 (rfc822-bad-address "Rubbish in address"))))
-
-(defun rfc822-snarf-words ()
-  (rfc822-snarf-word)
-  (while (rfc822-looking-at ?.)
-    (rfc822-snarf-word)))
-
-(defun rfc822-snarf-subdomain ()
-  ;; sub-domain is domain-ref | domain-literal
-  (cond ((= (following-char) ?\[)
-	 ;; domain-ref
-	 (or (rfc822-looking-at "\\[\\([^][\\\n]\\|\\\\.\\|\\\\\n\\)*\\]")
-	     (rfc822-bad-address "Unterminated domain literal [...]")))
-	((rfc822-looking-at "[^][\000-\037 ()<>@,;:\\\".]+")
-	 ;; domain-literal = atom
-	 )
-	(t
-	 (rfc822-bad-address "Rubbish in host/domain specification"))))
-
-(defun rfc822-snarf-domain ()
-  (rfc822-snarf-subdomain)
-  (while (rfc822-looking-at ?.)
-    (rfc822-snarf-subdomain)))
-
-(defun rfc822-snarf-frob-list (name separator terminator snarfer
-				    &optional return)
-  (let ((first t)
-	(list ())
-	tem)
-    (while (cond ((eobp)
-		  (rfc822-bad-address
-		    (format "End of addresses in middle of %s" name)))
-		 ((rfc822-looking-at terminator)
-		  nil)
-		 ((rfc822-looking-at separator)
-		  ;; multiple separators are allowed and do nothing.
-		  (while (rfc822-looking-at separator))
-		  t)
-		 (first
-		  t)
-		 (t
-		  (rfc822-bad-address
-		    (format "Gubbish in middle of %s" name))))
-      (setq tem (funcall snarfer)
-	    first nil)
-      (and return tem
-	   (setq list (if (listp tem)
-			  (nconc (reverse tem) list)
-			  (cons tem list)))))
-    (nreverse list)))
-
-;; return either an address (a string) or a list of addresses
-(defun rfc822-addresses-1 (&optional allow-groups)
-  ;; Looking for an rfc822 `address'
-  ;; Either a group (1*word ":" [#mailbox] ";")
-  ;; or a mailbox (addr-spec | 1*word route-addr)
-  ;;  addr-spec is (local-part "@" domain)
-  ;;  route-addr is ("<" [1#("@" domain) ":"] addr-spec ">")
-  ;;  local-part is (word *("." word))
-  ;;  word is (atom | quoted-string)
-  ;;  quoted-string is ("\([^\"\\n]\|\\.\|\\\n\)")
-  ;;  atom is [^\000-\037\177 ()<>@,;:\".[]]+
-  ;;  domain is sub-domain *("." sub-domain)
-  ;;  sub-domain is domain-ref | domain-literal
-  ;;  domain-literal is  "[" *(dtext | quoted-pair) "]"
-  ;;  dtext is "[^][\\n"
-  ;;  domain-ref is atom
-  (let ((address-start (point))
-	(n 0))
-    (catch 'address
-      ;; optimize common cases:
-      ;;  foo
-      ;;  foo.bar@bar.zap
-      ;; followed by "\\'\\|,\\|([^()\\]*)\\'"
-      ;; other common cases are:
-      ;;  foo bar 
-      ;;  "foo bar" 
-      ;;  those aren't hacked yet.
-      (if (and (rfc822-looking-at "[^][\000-\037 ()<>@,;:\\\"]+\\(\\|@[^][\000-\037 ()<>@,;:\\\"]+\\)" t)
-	       (progn (or (eobp)
-			  (rfc822-looking-at ?,))))
-	  (progn
-	    ;; rfc822-looking-at may have inserted a space
-	    (or (bobp) (/= (preceding-char) ?\ ) (delete-char -1))
-	    ;; relying on the fact that rfc822-looking-at 
-	    ;;  doesn't mung match-data
-	    (throw 'address (buffer-substring address-start (match-end 0)))))
-      (goto-char address-start)
-      (while t
-	(cond ((and (= n 1) (rfc822-looking-at ?@))
-	       ;; local-part@domain
-	       (rfc822-snarf-domain)
-	       (throw 'address
-		 (buffer-substring address-start (point))))
-	      ((rfc822-looking-at ?:)
-	       (cond ((not allow-groups)
-		      (rfc822-bad-address "A group name may not appear here"))
-		     ((= n 0)
-		      (rfc822-bad-address "No name for :...; group")))
-	       ;; group
-	       (throw 'address
-		 ;; return a list of addresses
-		 (rfc822-snarf-frob-list ":...; group" ?\, ?\;
-					 'rfc822-addresses-1 t)))
-	      ((rfc822-looking-at ?<)
-	       (let ((start (point))
-		     (strip t))
-		 (cond ((rfc822-looking-at ?>)
-			;; empty path
-			())
-		       ((and (not (eobp)) (= (following-char) ?\@))
-			;; <@foo.bar,@baz:quux@abcd.efg>
-			(rfc822-snarf-frob-list "<...> address" ?\, ?\:
-			  (function (lambda ()
-				      (if (rfc822-looking-at ?\@)
-					  (rfc822-snarf-domain)
-					(rfc822-bad-address
-					  "Gubbish in route-addr")))))
-			(rfc822-snarf-words)
-			(or (rfc822-looking-at ?@)
-			    (rfc822-bad-address "Malformed <..@..> address"))
-			(rfc822-snarf-domain)
-			(setq strip nil))
-		       ((progn (rfc822-snarf-words) (rfc822-looking-at ?@))
-			; allow  (losing unix seems to do this)
-			(rfc822-snarf-domain)))
-		 (let ((end (point)))
-		   (if (rfc822-looking-at ?\>)
-		       (throw 'address
-			 (buffer-substring (if strip start (1- start))
-					   (if strip end (1+ end))))
-		     (rfc822-bad-address "Unterminated <...> address")))))
-	      ((looking-at "[^][\000-\037 ()<>@,;:\\.]")
-	       ;; this allows "." to be part of the words preceding
-	       ;; an addr-spec, since many broken mailers output
-	       ;; "Hern K. Herklemeyer III
-	       ;;   "
-               (let ((again t))
-                 (while again
-                   (or (= n 0) (bobp) (= (preceding-char) ?\ )
-                       (insert ?\ ))
-                   (rfc822-snarf-words)
-                   (setq n (1+ n))
-                   (setq again (or (rfc822-looking-at ?.)
-                                   (looking-at "[^][\000-\037 ()<>@,;:\\.]"))))))
-	      ((= n 0)
-	       (throw 'address nil))
-	      ((= n 1) ; allow "foo" (losing unix seems to do this)
-	       (throw 'address
-		 (buffer-substring address-start (point))))
-              ((> n 1)
-               (rfc822-bad-address "Missing comma between addresses or badly-formatted address"))
-	      ((or (eobp) (= (following-char) ?,))
-	       (rfc822-bad-address "Missing comma or route-spec"))
-	      (t
-	       (rfc822-bad-address "Strange character or missing comma")))))))
-
-			   
-(defun rfc822-addresses (header-text)
-  (if (string-match "\\`[ \t]*\\([^][\000-\037 ()<>@,;:\\\".]+\\)[ \t]*\\'"
-                    header-text)
-      ;; Make very simple case moderately fast.
-      (list (substring header-text (match-beginning 1) (match-end 1)))
-    (let ((buf (generate-new-buffer " rfc822")))
-      (unwind-protect
-	(save-excursion
-	  (set-buffer buf)
-	  (make-local-variable 'case-fold-search)
-	  (setq case-fold-search nil)	;For speed(?)
-	  (insert header-text)
-	  ;; unfold continuation lines
-	  (goto-char (point-min))
-
-	  (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t)
-	    (replace-match "\\1 " t))
-
-	  (goto-char (point-min))
-	  (rfc822-nuke-whitespace)
-	  (let ((list ())
-		tem
-		address-start); this is for rfc822-bad-address
-	    (while (not (eobp))
-	      (setq address-start (point))
-	      (setq tem
-		    (catch 'address ; this is for rfc822-bad-address
-		      (cond ((rfc822-looking-at ?\,)
-			     nil)
-			    ((looking-at "[][\000-\037@;:\\.>)]")
-			     (forward-char)
-			     (rfc822-bad-address
-			       (format "Strange character \\%c found"
-				       (preceding-char))))
-			    (t
-			     (rfc822-addresses-1 t)))))
-	      (cond ((null tem))
-		    ((stringp tem)
-		     (setq list (cons tem list)))
-		    (t
-		     (setq list (nconc (nreverse tem) list)))))
-	    (nreverse list)))
-      (and buf (kill-buffer buf))))))
-
-;; XEmacs addition (from Emacs simple.el)
-(when (not (fboundp 'rfc822-goto-eoh))
-  (defun rfc822-goto-eoh ()
-    ;; Go to header delimiter line in a mail message, following RFC822 rules
-    (goto-char (point-min))
-    (while (looking-at "^[^: \n]+:\\|^[ \t]")
-      (forward-line 1))
-    (point)))
-
-(provide 'rfc822)
-
-;;; rfc822.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/rmail-mini.el b/xemacs-packages/lisp/mail-lib/rmail-mini.el
deleted file mode 100644
index 46b3bf15..00000000
--- a/xemacs-packages/lisp/mail-lib/rmail-mini.el
+++ /dev/null
@@ -1,74 +0,0 @@
-;;; rmail-mini.el --- minimal core of "RMAIL" mail reader for Emacs.
-
-;; Copyright (C) 1985,86,87,88,93,94,95,96,97 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Emacs 20.1.
-
-;;; Commentary:
-
-;; Stripped of all cruft to support Gnus
-
-;;; Code:
-
-;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu
-;;   New features include attribute and keyword support, message
-;;   selection by dispatch table, summary by attributes and keywords,
-;;   expunging by dispatch table, sticky options for file commands.
-
-;; Extended by Bob Weiner of Motorola
-;;   New features include: rmail and rmail-summary buffers remain
-;;   synchronized and key bindings basically operate the same way in both
-;;   buffers, summary by topic or by regular expression, rmail-reply-prefix
-;;   variable, and a bury rmail buffer (wipe) command.
-
-(defgroup rmail nil
-  "Mail reader for Emacs."
-  :group 'mail)
-
-(defgroup rmail-reply nil
-  "Rmail reply options."
-  :prefix "rmail-"
-  :group 'rmail)
-
-(setq rmail-mode-map (make-sparse-keymap))
-
-;;;###autoload
-(defcustom rmail-dont-reply-to-names nil "\
-*A regexp specifying names to prune of reply to messages.
-A value of nil means exclude your own name only."
-  :type '(choice regexp (const :tag "Your Name" nil))
-  :group 'rmail-reply)
-
-;;;###autoload
-(defvar rmail-default-dont-reply-to-names "info-" "\
-A regular expression specifying part of the value of the default value of
-the variable `rmail-dont-reply-to-names', for when the user does not set
-`rmail-dont-reply-to-names' explicitly.  (The other part of the default
-value is the user's name.)
-It is useful to set this variable in the site customization file.")
-
-
-(provide 'rmail)
-(provide 'rmail-mini)
-
-;;; rmail-mini.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/rmailout.el b/xemacs-packages/lisp/mail-lib/rmailout.el
deleted file mode 100644
index f2358e55..00000000
--- a/xemacs-packages/lisp/mail-lib/rmailout.el
+++ /dev/null
@@ -1,263 +0,0 @@
-;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
-
-;; Copyright (C) 1985, 1987, 1993 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-;; Temporary until Emacs always has this variable.
-(defvar rmail-delete-after-output nil
-  "*Non-nil means automatically delete a message that is copied to a file.")
-
-(defvar rmail-output-file-alist nil
-  "*Alist matching regexps to suggested output Rmail files.
-This is a list of elements of the form (REGEXP . NAME-EXP).
-The suggestion is taken if REGEXP matches anywhere in the message buffer.
-NAME-EXP may be a string constant giving the file name to use,
-or more generally it may be any kind of expression that returns
-a file name as a string.")
-
-;;; There are functions elsewhere in Emacs that use this function; check
-;;; them out before you change the calling method.
-(defun rmail-output-to-rmail-file (file-name &optional count)
-  "Append the current message to an Rmail file named FILE-NAME.
-If the file does not exist, ask if it should be created.
-If file is being visited, the message is appended to the Emacs
-buffer visiting that file.
-If the file exists and is not an Rmail file, 
-the message is appended in inbox format.
-
-A prefix argument N says to output N consecutive messages
-starting with the current one.  Deleted messages are skipped and don't count."
-  (interactive
-   (let ((default-file
-	   (let (answer tail)
-	     (setq tail rmail-output-file-alist)
-	     ;; Suggest a file based on a pattern match.
-	     (while (and tail (not answer))
-	       (save-excursion
-		 (goto-char (point-min))
-		 (if (re-search-forward (car (car tail)) nil t)
-		     (setq answer (eval (cdr (car tail)))))
-		 (setq tail (cdr tail))))
-	     ;; If not suggestions, use same file as last time.
-	     (or answer rmail-last-rmail-file))))
-     (list (setq rmail-last-rmail-file
-		 (if default-file
-		     (read-file-name
-		      (concat "Output message to Rmail file: (default "
-			      (file-name-nondirectory default-file)
-			      ") ")
-		      (file-name-directory default-file)
-		      default-file)
-		   (read-file-name "Output message to Rmail file: ")))
-	   (prefix-numeric-value current-prefix-arg))))
-  (or count (setq count 1))
-  (setq file-name
-	(expand-file-name file-name
-			  (file-name-directory rmail-last-rmail-file)))
-  (if (and (file-readable-p file-name) (not (rmail-file-p file-name)))
-      (rmail-output file-name count)
-    (rmail-maybe-set-message-counters)
-    (setq file-name (abbreviate-file-name file-name))
-    (or (get-file-buffer file-name)
-	(file-exists-p file-name)
-	(if (yes-or-no-p
-	     (concat "\"" file-name "\" does not exist, create it? "))
-	    (let ((file-buffer (create-file-buffer file-name)))
-	      (save-excursion
-		(set-buffer file-buffer)
-		(rmail-insert-rmail-file-header)
-		(let ((require-final-newline nil))
-		  (write-region (point-min) (point-max) file-name t 1)))
-	      (kill-buffer file-buffer))
-	  (error "Output file does not exist")))
-    (while (> count 0)
-      (let (redelete)
-	(unwind-protect
-	    (progn
-	      (save-restriction
-		(widen)
-		(if (rmail-message-deleted-p rmail-current-message)
-		    (progn (setq redelete t)
-			   (rmail-set-attribute "deleted" nil)))
-		;; Decide whether to append to a file or to an Emacs buffer.
-		(save-excursion
-		  (let ((buf (get-file-buffer file-name))
-			(cur (current-buffer))
-			(beg (1+ (rmail-msgbeg rmail-current-message)))
-			(end (1+ (rmail-msgend rmail-current-message))))
-		    (if (not buf)
-			(append-to-file beg end file-name)
-		      (if (eq buf (current-buffer))
-			  (error "Can't output message to same file it's already in"))
-		      ;; File has been visited, in buffer BUF.
-		      (set-buffer buf)
-		      (let ((buffer-read-only nil)
-			    (msg (and (boundp 'rmail-current-message)
-				      rmail-current-message)))
-			;; If MSG is non-nil, buffer is in RMAIL mode.
-			(if msg
-			    (progn
-			      (rmail-maybe-set-message-counters)
-			      (widen)
-			      (narrow-to-region (point-max) (point-max))
-			      (insert-buffer-substring cur beg end)
-			      (goto-char (point-min))
-			      (widen)
-			      (search-backward "\n\^_")
-			      (narrow-to-region (point) (point-max))
-			      (rmail-count-new-messages t)
-			      (rmail-show-message msg))
-			  ;; Output file not in rmail mode => just insert at
-			  ;; the end.
-			  (narrow-to-region (point-min) (1+ (buffer-size)))
-			  (goto-char (point-max))
-			  (insert-buffer-substring cur beg end)))))))
-	      (rmail-set-attribute "filed" t))
-	  (if redelete (rmail-set-attribute "deleted" t))))
-      (setq count (1- count))
-      (if rmail-delete-after-output
-	  (rmail-delete-forward)
-	(if (> count 0)
-	    (rmail-next-undeleted-message 1))))))
-
-;; Returns t if file FILE is an Rmail file.
-;;;###autoload
-(defun rmail-file-p (file)
-  (let ((buf (generate-new-buffer " *rmail-file-p*")))
-    (unwind-protect
-	(save-excursion
-	  (set-buffer buf)
-	  (insert-file-contents file nil 0 100)
-	  (looking-at "BABYL OPTIONS:"))
-      (kill-buffer buf))))
-
-;;; There are functions elsewhere in Emacs that use this function; check
-;;; them out before you change the calling method.
-;;; ####Boy, FROM-GNUS, what wonderful abstraction.  You loser.
-(defun rmail-output (file-name &optional count noattribute from-gnus)
-  "Append this message to Unix mail file named FILE-NAME.
-A prefix argument N says to output N consecutive messages
-starting with the current one.  Deleted messages are skipped and don't count.
-When called from lisp code, N may be omitted.
-
-If the pruned message header is shown on the current message, then
-messages will be appended with pruned headers; otherwise, messages
-will be appended with their original headers.
-
-The optional third argument NOATTRIBUTE, if non-nil, says not
-to set the `filed' attribute, and not to display a message.
-
-The optional fourth argument FROM-GNUS is set when called from GNUS."
-  (interactive
-   (list (setq rmail-last-file
-	       (read-file-name
-		(concat "Output message to Unix mail file"
-			(if rmail-last-file
-			    (concat " (default "
-				    (file-name-nondirectory rmail-last-file)
-				    "): " )
-			  ": "))			
-		(and rmail-last-file (file-name-directory rmail-last-file))
-		rmail-last-file))
-	 (prefix-numeric-value current-prefix-arg)))
-  (or count (setq count 1))
-  (setq file-name
-	(expand-file-name file-name
-			  (and rmail-last-file
-			       (file-name-directory rmail-last-file))))
-  (if (and (file-readable-p file-name) (rmail-file-p file-name))
-      (rmail-output-to-rmail-file file-name count)
-    (let ((orig-count count)
-	  (rmailbuf (current-buffer))
-	  (case-fold-search t)
-	  (tembuf (get-buffer-create " rmail-output"))
-	  (original-headers-p
-	   (and (not from-gnus)
-		(save-excursion 
-		  (save-restriction
-		    (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
-		    (goto-char (point-min))
-		    (forward-line 1)
-		    (= (following-char) ?0)))))
-	  header-beginning
-	  mail-from)
-      (while (> count 0)
-	(or from-gnus
-	    (setq mail-from
-		  (save-excursion
-		    (save-restriction
-		      (widen)
-		      (goto-char (rmail-msgbeg rmail-current-message))
-		      (setq header-beginning (point))
-		      (search-forward "\n*** EOOH ***\n")
-		      (narrow-to-region header-beginning (point))
-		      (mail-fetch-field "Mail-From")))))
-	(save-excursion
-	  (set-buffer tembuf)
-	  (erase-buffer)
-	  (insert-buffer-substring rmailbuf)
-	  (insert "\n")
-	  (goto-char (point-min))
-	  (if mail-from
-	      (insert mail-from "\n")
-	    (insert "From "
-		    (mail-strip-quoted-names (or (mail-fetch-field "from")
-						 (mail-fetch-field "really-from")
-						 (mail-fetch-field "sender")
-						 "unknown"))
-		    " " (current-time-string) "\n"))
-	  ;; ``Quote'' "\nFrom " as "\n>From "
-	  ;;  (note that this isn't really quoting, as there is no requirement
-	  ;;   that "\n[>]+From " be quoted in the same transparent way.)
-	  (while (search-forward "\nFrom " nil t)
-	    (forward-char -5)
-	    (insert ?>))
-	  (write-region (point-min) (point-max) file-name t
-			(if noattribute 'nomsg)))
-	(or noattribute
-	    (if (equal major-mode 'rmail-mode)
-		(rmail-set-attribute "filed" t)))
-	(setq count (1- count))
-	(or from-gnus
-	    (let ((next-message-p
-		   (if rmail-delete-after-output
-		       (rmail-delete-forward)
-		     (if (> count 0)
-			 (rmail-next-undeleted-message 1))))
-		  (num-appended (- orig-count count)))
-	      (if (and next-message-p original-headers-p)
-		  (rmail-toggle-header))
-	      (if (and (> count 0) (not next-message-p))
-		  (progn 
-		    (error
-		     (save-excursion
-		       (set-buffer rmailbuf)
-		       (format "Only %d message%s appended" num-appended
-			       (if (= num-appended 1) "" "s"))))
-		    (setq count 0))))))
-      (kill-buffer tembuf))))
-
-(provide 'rmailout)
-
-;;; rmailout.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/sendmail.el b/xemacs-packages/lisp/mail-lib/sendmail.el
deleted file mode 100644
index 4952e28c..00000000
--- a/xemacs-packages/lisp/mail-lib/sendmail.el
+++ /dev/null
@@ -1,1849 +0,0 @@
-;;; sendmail.el --- mail sending commands for Emacs.  -*- byte-compile-dynamic: t -*-
-
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001, 2002, 2003
-;;   Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Emacs 21.3
-
-;;; Commentary:
-
-;; This mode provides mail-sending facilities from within Emacs.  It is
-;; documented in the Emacs user's manual.
-
-;;; Code:
-
-(require 'rfc822)
-
-(defgroup sendmail nil
-  "Mail sending commands for Emacs."
-  :prefix "mail-"
-  :group 'mail)
-
-;;;###autoload
-(defcustom mail-from-style 'angles "\
-*Specifies how \"From:\" fields look.
-
-If `nil', they contain just the return address like:
-	king@grassland.com
-If `parens', they look like:
-	king@grassland.com (Elvis Parsley)
-If `angles', they look like:
-	Elvis Parsley 
-If `system-default', allows the mailer to insert its default From field
-derived from the envelope-from address.
-
-The email address passed to the mailer to specify the envelope-from
-address is controlled by `mail-specify-envelope-from'."
-  :type '(choice (const nil) (const parens) (const angles)
-		 (const system-default))
-  :group 'sendmail)
-
-;;;###autoload
-(defcustom mail-specify-envelope-from nil
-  "*If non-nil, specify the envelope-from address when sending mail.
-The value used to specify it is whatever is found in
-`mail-envelope-from', with `user-mail-address' as fallback.
-
-On most systems, specifying the envelope-from address
-is a privileged operation."
-  :type 'boolean
-  :group 'sendmail)
-
-(defcustom mail-envelope-from nil
-  "*If non-nil, designate the envelope-from address when sending mail.
-If this is nil while `mail-specify-envelope-from' is non-nil, the
-content of `user-mail-address' is used."
-  :type '(choice (string :tag "From-name")
-		 (const :tag "Use From: header from message" header)
-		 (const :tag "Use `user-mail-address'" nil))
-  :group 'sendmail)
-
-;;;###autoload
-(defcustom mail-self-blind nil "\
-*Non-nil means insert BCC to self in messages to be sent.
-This is done when the message is initialized,
-so you can remove or alter the BCC field to override the default."
-  :type 'boolean
-  :group 'sendmail)
-
-;;;###autoload
-(defcustom mail-interactive nil "\
-*Non-nil means when sending a message wait for and display errors.
-nil means let mailer mail back a message to report errors."
-  :type 'boolean
-  :group 'sendmail)
-
-;;; XEmacs change: moved rmail-ignored-headers here from rmail.el so that
-;;; the value of mail-yank-ignored-headers can default from it.  Both of
-;;; these end up in loaddefs.el, but "sendmail" comes before "rmail", so...
-;;;
-;;;###autoload
-(defvar rmail-ignored-headers 
-  (purecopy
-   (concat
-    "^\\("
-    (mapconcat
-     'identity
-     '(;; RFC822
-       "Sender:" "References:" "Return-Path:" "Received:"
-       "[^: \t\n]*Message-ID:" "Errors-To:"
-       ;; RFC977 (NNTP)
-       "Path:" "Expires:" "Xref:" "Lines:" "Approved:" "Distribution:"
-       ;; SYSV mail:
-       "Content-Length:"
-       ;; MIME:
-       "Mime-Version:" "Content-Type:" "Content-Transfer-Encoding:"
-       ;; X400
-       "X400-Received:" "X400-Originator:" "X400-Mts-Identifier:"
-       "X400-Content-Type:" "Content-Identifier:"
-       ;; RMAIL and /usr/ucb/mail:
-       "Status:" "Summary-Line:"
-       ;; Supercite:
-       "X-Attribution:"
-       ;; Other random junk occasionally seen:
-       "Via:" "Sent-Via:" "Mail-From:" "Origin:" "Comments:" "Originator:"
-       "NF-ID:" "NF-From:" "Posting-Version:" "Posted:" "Posted-Date:"
-       "Date-Received:" "Relay-Version:" "Article-I\\.D\\.:" "NNTP-Version:"
-       "NNTP-Posting-Host:" "X-Mailer:" "X-Newsreader:" "News-Software:"
-       "X-Received:" "X-References:" "X-Envelope-To:"
-       "X-VMS-" "Remailed-" "X-Plantation:" "X-Windows:" "X-Pgp-"
-       )
-     "\\|")
-    "\\)"))
-  "*Gubbish header fields one would rather not see.")
-
-
-;;;###autoload
-(defcustom mail-yank-ignored-headers
-  (purecopy
-   (concat rmail-ignored-headers "\\|"
-	   "^\\("
-	   (mapconcat 'identity
-		      '(;; RFC822
-			"Resent-To:" "Resent-By:" "Resent-CC:"
-			"To:" "Subject:" "In-Reply-To:"
-			)
-		      "\\|")
-	   "\\)")) "\
-*Delete these headers from old message when it's inserted in a reply."
-  :type 'regexp
-  :group 'sendmail)
-
-;; Useful to set in site-init.el
-;;;###autoload
-(defcustom send-mail-function (if (or (eq system-type 'windows-nt)
-				      (eq system-type 'cygwin32))
-				  ;; there is no sendmail on windows.
-				  'smtpmail-send-it
-				'sendmail-send-it)
-  "Function to call to send the current buffer as mail.
-The headers should be delimited by a line which is
-not a valid RFC822 header or continuation line,
-that match the variable `mail-header-separator'.
-This is used by the default mail-sending commands.  See also
-`message-send-mail-function' for use with the Message package."
-  :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package")
-		(function-item smtpmail-send-it :tag "Use SMTPmail package")
-		(function-item feedmail-send-it :tag "Use Feedmail package")
-		function)
-  :group 'sendmail)
-
-;;;###autoload
-(defcustom mail-header-separator "--text follows this line--" "\
-*Line used to separate headers from text in messages being composed."
-  :type 'string
-  :group 'sendmail)
-
-;; Set up mail-header-separator for use as a category text property.
-(put 'mail-header-separator 'rear-nonsticky '(category))
-;;; This was a nice idea, for preventing accidental modification of
-;;; the separator.   But I found it also prevented or obstructed
-;;; certain deliberate operations, such as copying the separator line
-;;; up to the top to send myself a copy of an already sent outgoing message
-;;; and other things.  So I turned it off.  --rms.
-;;;(put 'mail-header-separator 'read-only t)
-
-;;;###autoload
-(defcustom mail-archive-file-name nil "\
-*Name of file to write all outgoing messages in, or nil for none.
-This can be an inbox file or an Rmail file."
-  :type '(choice file (const nil))
-  :group 'sendmail)
-
-;;;###autoload
-(defcustom mail-default-reply-to nil
-  "*Address to insert as default Reply-to field of outgoing messages.
-If nil, it will be initialized from the REPLYTO environment variable
-when you first send mail."
-  :type '(choice (const nil) string)
-  :group 'sendmail)
-
-;;;###autoload
-(defcustom mail-alias-file nil
-  "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
-This file defines aliases to be expanded by the mailer; this is a different
-feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
-This variable has no effect unless your system uses sendmail as its mailer."
-  :type '(choice (const nil) file)
-  :group 'sendmail)
-
-; XEmacs:
-(defvaralias 'mail-personal-alias-file 'mail-abbrev-mailrc-file)
-
-(defcustom mail-setup-hook nil
-  "Normal hook, run each time a new outgoing mail message is initialized.
-The function `mail-setup' runs this hook."
-  :type 'hook
-  :options '(fortune-to-signature spook mail-abbrevs-setup)
-  :group 'sendmail)
-
-;; XEmacs: `mail-aliases' moved to `mail-abbrevs.el'.
-
-(defvar mail-alias-modtime nil
-  "The modification time of your mail alias file when it was last examined.")
-
-;;;###autoload
-(defcustom mail-yank-prefix "> "		; XEmacs change
-  "*Prefix insert on lines of yanked message being replied to.
-nil means use indentation."
-  :type '(choice (const nil) string)
-  :group 'sendmail)
-
-(defcustom mail-indentation-spaces 3
-  "*Number of spaces to insert at the beginning of each cited line.
-Used by `mail-yank-original' via `mail-indent-citation'."
-  :type 'integer
-  :group 'sendmail)
-(defvar mail-yank-hooks nil
-  "Obsolete hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between (point) and (mark t).
-And each hook function should leave point and mark around the citation
-text as modified.
-
-This is a normal hook, misnamed for historical reasons.
-It is semi-obsolete and mail agents should no longer use it.")
-
-(defcustom mail-citation-hook nil
-  "*Hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between (point) and (mark t),
-and should leave point and mark around the citation text as modified.
-The hook functions can find the header of the cited message
-in the variable `mail-citation-header', whether or not this is included
-in the cited portion of the message.
-
-If this hook is entirely empty (nil), a default action is taken
-instead of no action."
-  :type 'hook
-  :group 'sendmail)
-
-(defvar mail-citation-header nil
-  "While running `mail-citation-hook', this variable holds the message header.
-This enables the hook functions to see the whole message header
-regardless of what part of it (if any) is included in the cited text.")
-
-(defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*"
-  "*Regular expression to match a citation prefix plus whitespace.
-It should match whatever sort of citation prefixes you want to handle,
-with whitespace before and after; it should also match just whitespace.
-The default value matches citations like `foo-bar>' plus whitespace."
-  :type 'regexp
-  :group 'sendmail)
-
-(defvar mail-abbrevs-loaded nil)
-(defvar mail-mode-map nil)
-
-; XEmacs: Removed autoloads of `build-mail-aliases' and `expand-mail-aliases'.
-; See `mail-abbrevs.el'.
-
-;;;###autoload
-(defcustom mail-signature nil
-  "*Text inserted at end of mail buffer when a message is initialized.
-If t, it means to insert the contents of the file `mail-signature-file'.
-If a string, that string is inserted.
- (To make a proper signature, the string should begin with \\n\\n-- \\n,
-  which is the standard way to delimit a signature in a message.)
-Otherwise, it should be an expression; it is evaluated
-and should insert whatever you want to insert."
-  :type '(choice (const :tag "None" nil)
-		 (const :tag "Use `.signature' file" t)
-		 (string :tag "String to insert")
-		 (sexp :tag "Expression to evaluate"))
-  :group 'sendmail)
-(put 'mail-signature 'risky-local-variable t)
-
-(defcustom mail-signature-file "~/.signature"
-  "*File containing the text inserted at end of mail buffer."
-  :type 'file
-  :group 'sendmail)
-
-;;;###autoload
-(defcustom mail-default-directory "~/"
-  "*Directory for mail buffers.
-Value of `default-directory' for mail buffers.
-This directory is used for auto-save files of mail buffers."
-  :type '(directory :tag "Directory")
-  :group 'sendmail
-  :version "21.4")
-
-(defvar mail-reply-action nil)
-(defvar mail-send-actions nil
-  "A list of actions to be performed upon successful sending of a message.")
-(put 'mail-reply-action 'permanent-local t)
-(put 'mail-send-actions 'permanent-local t)
-
-(defcustom mail-default-headers nil
-  "*A string containing header lines, to be inserted in outgoing messages.
-It is inserted before you edit the message,
-so you can edit or delete these lines."
-  :type '(choice (const nil) string)
-  :group 'sendmail)
-
-(defcustom mail-bury-selects-summary t
-  "*If non-nil, try to show RMAIL summary buffer after returning from mail.
-The functions \\[mail-send-on-exit] or \\[mail-dont-send] select
-the RMAIL summary buffer before returning, if it exists and this variable
-is non-nil."
-  :type 'boolean
-  :group 'sendmail)
-
-(defcustom mail-send-nonascii 'mime
-  "*Specify whether to allow sending non-ASCII characters in mail.
-If t, that means do allow it.  nil means don't allow it.
-`query' means ask the user each time.
-`mime' means add an appropriate MIME header if none already present.
-The default is `mime'.
-Including non-ASCII characters in a mail message can be problematical
-for the recipient, who may not know how to decode them properly."
-  :type '(choice (const t) (const nil) (const query) (const mime))
-  :group 'sendmail)
-
-(defcustom mail-use-dsn nil
-  "*Ask MTA for notification of failed, delayed or successful delivery.
-Note that only some MTAs (currently only recent versions of Sendmail)
-support Delivery Status Notification."
-  :group 'sendmail
-  :type '(repeat (radio (const :tag "Failure" failure)
-			(const :tag "Delay" delay)
-			(const :tag "Success" success)))
-  :version "21.4")
-
-;; Note: could use /usr/ucb/mail instead of sendmail;
-;; options -t, and -v if not interactive.
-(defvar mail-mailer-swallows-blank-line
-  (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration)
-	   (file-readable-p "/etc/sendmail.cf")
-	   (let ((buffer (get-buffer-create " *temp*")))
-	     (unwind-protect
-		 (save-excursion
-		   (set-buffer buffer)
-		   (insert-file-contents "/etc/sendmail.cf")
-		   (goto-char (point-min))
-		   (let ((case-fold-search nil))
-		     (re-search-forward "^OR\\>" nil t)))
-	       (kill-buffer buffer))))
-      ;; According to RFC822, "The field-name must be composed of printable
-      ;; ASCII characters (i.e. characters that have decimal values between
-      ;; 33 and 126, except colon)", i.e. any chars except ctl chars,
-      ;; space, or colon.
-      '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
-  "Set this non-nil if the system's mailer runs the header and body together.
-\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
-The value should be an expression to test whether the problem will
-actually occur.")
-
-;; XEmacs: RMS doesn't like this behavior but it seems more logical to
-;; me. --ben
-(defcustom mail-use-multiple-buffers-p t 
-  "Non-nil means `mail' will create a new buffer if one already exists."
-  :type 'boolean
-  :group 'sendmail)
-
-(defvar mail-mode-syntax-table
-  (let ((st (make-syntax-table)))
-    ;; define-derived-mode will make it inherit from text-mode-syntax-table.
-    (modify-syntax-entry ?% ". " st)
-    st)
-  "Syntax table used while in `mail-mode'.")
-
-(defvar mail-font-lock-keywords
-  (eval-when-compile
-    (let* ((cite-chars "[>|}]")
-	   (cite-prefix "[A-Za-z]")
-	   (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
-      (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face)
-	    '("^\\(B?CC\\|Reply-to\\):" . font-lock-keyword-face)
-	    '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
-	      (1 font-lock-comment-face) (2 font-lock-type-face nil t))
-	    ;; Use EVAL to delay in case `mail-header-separator' gets changed.
-	    '(eval .
-	      (let ((separator (if (zerop (length mail-header-separator))
-				   " \\`\\' "
-				 (regexp-quote mail-header-separator))))
-		(cons (concat "^" separator "$") 'font-lock-warning-face)))
-	    ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
-	    `(,cite-chars
-	      (,(concat "\\=[ \t]*"
-			"\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
-			"\\(" cite-chars "[ \t]*\\)\\)+"
-			"\\(.*\\)")
-	       (beginning-of-line) (end-of-line)
-	       (2 font-lock-constant-face nil t)
-	       (4 font-lock-comment-face nil t)))
-	    '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$"
-	      . font-lock-string-face))))
-  "Additional expressions to highlight in Mail mode.")
-(put 'mail-mode 'font-lock-defaults '(mail-font-lock-keywords t))
-
-;; Courtesy of Per Abrahamsen  in an attempt to make
-;; Emacs and XEmacs less stupid about default mail addresses.
-
-;; We trust the administrator if he has set `mail-host-address'.
-;; We trust the user if he has already customized `user-mail-address'.
-(defcustom query-user-mail-address (and (not mail-host-address)
-					(not user-mail-address))
-  "If non-nil, prompt the user for his mail address."
-  :group 'message
-  :type 'boolean)
-
-;;;###autoload
-(defun user-mail-address ()
-  "Query the user for his mail address, unless it is already known."
-  (interactive)
-  (when (and (not noninteractive) query-user-mail-address)
-    (let ((addr (or user-mail-address
-		    (concat (user-login-name) "@"
-				    (or mail-host-address
-					(system-name))))))
-      (setq user-mail-address
-	    (read-string "Your mail address? " (cons addr 0)))
-      (setq query-user-mail-address nil)
-      ;; TODO: Run sanity check from Gnus here.
-      (when (y-or-n-p "Save address for future sessions? ")
-	(put 'user-mail-address 'saved-value
-	     (list user-mail-address))
-	(put 'query-user-mail-address 'saved-value '(nil))
-        (require 'cus-edit)
-	(custom-save-all))))
-  (if user-mail-address
-      user-mail-address
-    (setq user-mail-address (concat (user-login-name) "@"
-                                    (or mail-host-address
-                                        (system-name))))))
-
-(defun sendmail-sync-aliases ()
-  (let ((modtime (nth 5 (file-attributes (mail-abbrev-mailrc-file))))) ; XEmacs
-    (or (equal mail-alias-modtime modtime)
-	(setq mail-alias-modtime modtime
-	      mail-aliases t))))
-
-(defun mail-setup (to subject in-reply-to cc replybuffer actions)
-  (require 'mail-abbrevs)
-  (or mail-default-reply-to
-      (setq mail-default-reply-to (getenv "REPLYTO")))
-  (sendmail-sync-aliases)
-  (if (eq mail-aliases t)
-      (progn
-	(setq mail-aliases nil)
-	;; XEmacs: call to `build-mail-alias' removed, done by
-	;; `mail-aliases-setup' below.
-	))
-  ;; Don't leave this around from a previous message.
-  (kill-local-variable 'buffer-file-coding-system)
-  ;; This doesn't work for enable-multibyte-characters.
-  ;; (kill-local-variable 'enable-multibyte-characters)
-  ;; XEmacs, don't (set-buffer-multibyte default-enable-multibyte-characters)
-  (if (and (boundp 'current-input-method) current-input-method) ;; XEmacs
-      (inactivate-input-method))
-  (setq mail-send-actions actions)
-  (mail-aliases-setup) ;; XEmacs
-  (setq mail-reply-action replybuffer)
-  (goto-char (point-min))
-  (insert "To: ")
-  (save-excursion
-    (if to
-        ;; Here removed code to extract names from within <...>
-        ;; on the assumption that mail-strip-quoted-names
-        ;; has been called and has done so.
-	(let ((fill-prefix "\t")
-              (address-start (point)))
-	  (insert to "\n")
-          (fill-region-as-paragraph address-start (point-max))
-	  (goto-char (point-max))
-	  (unless (bolp)
-	    (newline)))
-      (newline))
-    (if cc
-	(let ((fill-prefix "\t")
-	      (address-start (progn (insert "CC: ") (point))))
-	  (insert cc "\n")
-	  (fill-region-as-paragraph address-start (point-max))
-	  (goto-char (point-max))
-	  (unless (bolp)
-	    (newline))))
-    (if in-reply-to
-        (let ((fill-prefix "\t")
-	      (fill-column 78)
-	      (address-start (point)))
-	  (insert "In-reply-to: " in-reply-to "\n")
-	  (fill-region-as-paragraph address-start (point-max))
-	  (goto-char (point-max))
-	  (unless (bolp)
-	    (newline))))
-    (insert "Subject: " (or subject "") "\n")
-    (if mail-default-headers
-	(insert mail-default-headers))
-    (if mail-default-reply-to
-	(insert "Reply-to: " mail-default-reply-to "\n"))
-    (if mail-self-blind
-	(insert "BCC: " (user-login-name) "\n")) ;; XEmacs
-    (if mail-archive-file-name
-	(insert "FCC: " mail-archive-file-name "\n"))
-    (put-text-property (point)
-		       (progn
-			 (insert mail-header-separator "\n")
-			 (1- (point)))
-		       'category 'mail-header-separator)
-    ;; Insert the signature.  But remember the beginning of the message.
-    (if to (setq to (point)))
-    (cond ((eq mail-signature t)
-	   (if (file-exists-p mail-signature-file)
-	       (progn
-		 (insert "\n\n-- \n")
-		 (insert-file-contents mail-signature-file))))
-	  ((stringp mail-signature)
-	   (insert mail-signature))
-	  (t
-	   (eval mail-signature)))
-    (goto-char (point-max))
-    (or (bolp) (newline)))
-  (if to (goto-char to))
-  (or to subject in-reply-to
-      (set-buffer-modified-p nil))
-  (run-hooks 'mail-setup-hook))
-
-(defcustom mail-mode-hook nil
-  "Hook run by Mail mode."
-  :group 'sendmail
-  :type 'hook
-  :options '(footnote-mode))
-
-(defvar mail-mode-abbrev-table text-mode-abbrev-table)
-;;;###autoload
-(define-derived-mode mail-mode text-mode "Mail"
-  "Major mode for editing mail to be sent.
-Like Text Mode but with these additional commands:
-\\[mail-send]  mail-send (send the message)    \\[mail-send-and-exit]  mail-send-and-exit
-Here are commands that move to a header field (and create it if there isn't):
-	 \\[mail-to]  move to To:	\\[mail-subject]  move to Subject:
-	 \\[mail-cc]  move to CC:	\\[mail-bcc]  move to BCC:
-	 \\[mail-fcc]  move to FCC:      \\[mail-reply-to] move to Reply-To:
-\\[mail-text]  mail-text (move to beginning of message text).
-\\[mail-signature]  mail-signature (insert `mail-signature-file' file).
-\\[mail-yank-original]  mail-yank-original (insert current message, in Rmail).
-\\[mail-fill-yanked-message]  mail-fill-yanked-message (fill what was yanked).
-\\[mail-sent-via]  mail-sent-via (add a Sent-via field for each To or CC).
-Turning on Mail mode runs the normal hooks `text-mode-hook' and
-`mail-mode-hook' (in that order)."
-  (make-local-variable 'mail-reply-action)
-  (make-local-variable 'mail-send-actions)
-  (setq buffer-offer-save t)
-  (setq mail-reply-action nil)
-  (make-local-variable 'mail-send-actions)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'normal-auto-fill-function)
-  (setq normal-auto-fill-function 'mail-mode-auto-fill)
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'mail-mode-fill-paragraph)
-  ;; Allow using comment commands to add/remove quoting (this only does
-  ;; anything if mail-yank-prefix is set to a non-nil value).
-  (set (make-local-variable 'comment-start) mail-yank-prefix)
-  (make-local-variable 'adaptive-fill-regexp)
-  (setq adaptive-fill-regexp
-	(concat "[ \t]*[-[A-Za-z0-9]]+>+[ \t]*\\|"
-		adaptive-fill-regexp))
-  (make-local-variable 'adaptive-fill-first-line-regexp)
-  (setq adaptive-fill-first-line-regexp
-	(concat "[ \t]*[-[A-Za-z0-9]]*>+[ \t]*\\|"
-		adaptive-fill-first-line-regexp))
-  (turn-on-auto-fill)	; XEmacs - maybe filladapt should be default, too.
-  ;; `-- ' precedes the signature.  `-----' appears at the start of the
-  ;; lines that delimit forwarded messages.
-  ;; Lines containing just >= 3 dashes, perhaps after whitespace,
-  ;; are also sometimes used and should be separators.
-  (setq paragraph-start (concat (regexp-quote mail-header-separator)
-				"$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
-				"\\|[ \t]*[[A-Za-z0-9]]*>+[ \t]*$\\|[ \t]*$\\|"
-				"-- $\\|---+$\\|"
-				page-delimiter))
-  (setq paragraph-separate paragraph-start)
-  (if (featurep 'menubar)
-      (easy-menu-add mail-menubar-menu)))
-
-(defun mail-header-end ()
-  "Return the buffer location of the end of headers, as a number."
-  (save-restriction
-    (widen)
-    (save-excursion
-      (rfc822-goto-eoh)
-      (point))))
-
-(defun mail-text-start ()
-  "Return the buffer location of the start of text, as a number."
-  (save-restriction
-    (widen)
-    (save-excursion
-      (rfc822-goto-eoh)
-      (forward-line 1)
-      (point))))
-
-(defun mail-sendmail-delimit-header ()
-  "Set up whatever header delimiter convention sendmail will use.
-Concretely: replace the first blank line in the header with the separator."
-  (rfc822-goto-eoh)
-  (insert mail-header-separator)
-  (point))
-
-(defun mail-sendmail-undelimit-header ()
-  "Remove header separator to put the message in correct form for sendmail.
-Leave point at the start of the delimiter line."
-  (rfc822-goto-eoh)
-  (delete-region (point) (progn (end-of-line) (point))))
-
-(defun mail-mode-auto-fill ()
-  "Carry out Auto Fill for Mail mode.
-If within the headers, this makes the new lines into continuation lines."
-  (if (< (point) (mail-header-end))
-      (let ((old-line-start (save-excursion (beginning-of-line) (point))))
-	(if (do-auto-fill)
-	    (save-excursion
-	      (beginning-of-line)
-	      (while (not (eq (point) old-line-start))
-		;; Use insert-before-markers in case we're inserting
-		;; before the saved value of point (which is common).
-		(insert-before-markers "   ")
-		(forward-line -1))
-	      t)))
-    (do-auto-fill)))
-
-(defun mail-mode-fill-paragraph (arg)
-  ;; Do something special only if within the headers.
-  (if (< (point) (mail-header-end))
-      (let (beg end fieldname)
-	(when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
-		(setq beg (point)))
-	(setq fieldname
-		(downcase (buffer-substring beg (1- (match-end 0))))))
-	(forward-line 1)
-	;; Find continuation lines and get rid of their continuation markers.
-	(while (looking-at "[ \t]")
-	  (delete-horizontal-space)
-	  (forward-line 1))
-	(setq end (point-marker))
-	(goto-char beg)
-	;; If this field contains addresses,
-	;; make sure we can fill after each address.
-	(if (member fieldname
-		    '("to" "cc" "bcc" "from" "reply-to"
-		      "resent-to" "resent-cc" "resent-bcc"
-		      "resent-from" "resent-reply-to"))
-	    (while (search-forward "," end t)
-	      (or (looking-at "[ \t]")
-		  (insert " "))))
-	(fill-region-as-paragraph beg end)
-	;; Mark all lines except the first as continuations.
-	(goto-char beg)
-	(forward-line 1)
-	(while (< (point) end)
-	  (insert "  ")
-	  (forward-line 1))
-	(move-marker end nil)
-	t)))
-
-;;; Set up keymap.
-
-(if mail-mode-map
-    nil
-  (setq mail-mode-map (make-sparse-keymap))
-  ;; XEmacs: (define-key mail-mode-map "\M-\t" 'mail-complete)
-  (define-key mail-mode-map "\C-c?" 'describe-mode)
-  (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to)
-  (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc)
-  (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc)
-  (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc)
-  (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject)
-  (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-to)
-  (define-key mail-mode-map "\C-c\C-t" 'mail-text)
-  (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
-  (define-key mail-mode-map "\C-c\C-r" 'mail-yank-region)
-  ;; XEmacs: (define-key mail-mode-map [remap split-line] 'mail-split-line)
-  (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
-  (define-key mail-mode-map "\C-c\C-w" 'mail-signature)
-  ;; XEmacs: (define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)
-  (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit)
-  (define-key mail-mode-map "\C-c\C-s" 'mail-send)
-  (define-key mail-mode-map "\C-c\C-i" 'mail-attach-file))
-
-;;; mail-mode popup menu
-
-(defvar mail-menubar-menu
-  (purecopy
-   '("Mail"
-     "Sending Mail:"
-     "----"
-     ["Send and Exit"		mail-send-and-exit		t]
-     ["Send Mail"		mail-send			t]
-     "----"
-     "Navigation:"
-     "----"
-     ["To:"			mail-to				t]
-     ["Subject:"		mail-subject			t]
-     ["CC:"			mail-cc				t]
-     ["FCC:"			mail-fcc			t]
-     ["BCC:"			mail-bcc			t]
-     ["Reply-To:"		mail-reply-to			t]
-     ;; XEmacs   ["Sent Via:"		mail-sent-via			t]
-     ["Text"			mail-text			t]
-     "----"
-     "Miscellaneous Commands:"
-     "----"
-     ["Expand Aliases"          expand-mail-aliases             t]
-     ["Yank Original"		mail-yank-original
-      (not (null mail-reply-action))]
-     ["Fill Yanked Message"	mail-fill-yanked-message
-      (save-excursion
-	(goto-char (point-min))
-	(and (search-forward (concat "\n" mail-header-separator
-				     "\n") nil t)
-	     (not (looking-at "[ \t\n]*\\'"))))]
-     ["Insert Signature"	mail-signature
-      (and (stringp mail-signature-file)
-	   (file-exists-p mail-signature-file))]
-     ["Insert File..."		insert-file			t]
-     ["Insert Buffer..."	insert-buffer			t]
-     "----"
-     ["Cancel"			mail-dont-send			t]
-     ))
-   "Menubar menu for `mail-mode'.")
-
-(defvar mail-popup-menu
-  (purecopy
-   (cons "Sendmail Commands"
-	 (cdr mail-menubar-menu)))
-  "Menubar menu for `mail-mode'.")
-
-
-;; User-level commands for sending.
-
-(defun mail-send-and-exit (arg)
-  "Send message like `mail-send', then, if no errors, exit from mail buffer.
-Prefix arg means don't delete this window."
-  (interactive "P")
-  (mail-send)
-  (mail-bury arg))
-
-(defun mail-dont-send (arg)
-  "Don't send the message you have been editing.
-Prefix arg means don't delete this window."
-  (interactive "P")
-  (mail-bury arg))
-
-(defun mail-bury (arg)
-  "Bury this mail buffer."
-  (let ((newbuf (other-buffer (current-buffer))))
-    (bury-buffer (current-buffer))
-    (if (and (or (window-dedicated-p (frame-selected-window))
-		 (cdr (assq 'mail-dedicated-frame (frame-parameters))))
-	     (not (null (delq (selected-frame) (visible-frame-list)))))
-	(delete-frame (selected-frame))
-      (let (rmail-flag summary-buffer)
-	(and (not arg)
-	     (not (one-window-p))
-	     (save-excursion
-	       (set-buffer (window-buffer (next-window (selected-window) 'not)))
-	       (setq rmail-flag (eq major-mode 'rmail-mode))
-	       (setq summary-buffer
-		     (and mail-bury-selects-summary
-			  (boundp 'rmail-summary-buffer)
-			  rmail-summary-buffer
-			  (buffer-name rmail-summary-buffer)
-			  (not (get-buffer-window rmail-summary-buffer))
-			  rmail-summary-buffer))))
-	(if rmail-flag
-	    ;; If the Rmail buffer has a summary, show that.
-	    (if summary-buffer (switch-to-buffer summary-buffer)
-	      (delete-window))
-	  (switch-to-buffer newbuf))))))
-
-(defcustom mail-send-hook nil
-  "Hook run just before sending mail with `mail-send'."
-  :type 'hook
-  :options '(flyspell-mode-off)
-  :group 'sendmail)
-
-(defun mail-send ()
-  "Send the message in the current buffer.
-If `mail-interactive' is non-nil, wait for success indication
-or error messages, and inform user.
-Otherwise any failure is reported in a message back to
-the user from the mailer."
-  (interactive)
-  (if (if buffer-file-name
-        (y-or-n-p "Send buffer contents as mail message? ")
-      (or (buffer-modified-p)
-          (y-or-n-p "Message already sent; resend? ")))
-      (let ((inhibit-read-only t)
-	    (opoint (point)))
-	;; Complain about any invalid line.
-	(goto-char (point-min))
-	(while (< (point) (mail-header-end))
-	  (unless (looking-at "[ \t]\\|.*:\\|$")
-	    (push-mark opoint)
-	    (error "Invalid header line (maybe a continuation line lacks initial whitespace)"))
-	  (forward-line 1))
-	(goto-char opoint)
-	(if (interactive-p) (expand-abbrev))  ;; XEmacs: for mail-abbrevs
-	(run-hooks 'mail-send-hook)
-	(message "Sending...")
-	(funcall send-mail-function)
-	;; Now perform actions on successful sending.
-	(while mail-send-actions
-	  (condition-case nil
-	      (apply (car (car mail-send-actions))
-		     (cdr (car mail-send-actions)))
-	    (error))
-	  (setq mail-send-actions (cdr mail-send-actions)))
-	(message "Sending...done")
-
-        ;; If buffer has no file, mark it as unmodified and delete autosave.
-        (cond ((or (not buffer-file-name)
-                   (not (buffer-modified-p)))
-               (set-buffer-modified-p nil)
-               (delete-auto-save-file-if-necessary t))
-              ((or noninteractive
-                   (y-or-n-p (format "Save file %s? " buffer-file-name)))
-               (save-buffer))))))
-
-(defun mail-envelope-from ()
-  "Return the envelope mail address to use when sending mail.
-This function uses `mail-envelope-from'."
-  (if (eq mail-envelope-from 'header)
-      (nth 1 (mail-extract-address-components
- 	      (mail-fetch-field "From")))
-    mail-envelope-from))
-
-;; This does the real work of sending a message via sendmail.
-;; It is called via the variable send-mail-function.
-
-(defun sendmail-send-it ()
-  "Send the current mail buffer using the Sendmail package.
-This is a suitable value for `send-mail-function'.  It sends using the
-external program defined by `sendmail-program'."
-  (require 'mail-utils)
-  (let ((errbuf (if mail-interactive
-		    (generate-new-buffer " sendmail errors")
-		  0))
-	(tembuf (generate-new-buffer " sendmail temp"))
-	;; XEmacs: comment out
-;	(multibyte enable-multibyte-characters)
-	(case-fold-search nil)
-	;; XEmacs: comment out
-;	(selected-coding (select-message-coding-system))
-;;;	resend-to-addresses
-	delimline
-	fcc-was-found
-	(mailbuf (current-buffer))
-	(program (if (boundp 'sendmail-program)
-		     sendmail-program
-		   "/usr/lib/sendmail"))
-	;; Examine these variables now, so that
-	;; local binding in the mail buffer will take effect.
-	(envelope-from
-	 (and mail-specify-envelope-from
-	      ;; XEmacs: use (user-mail-address)
-	      (or (mail-envelope-from) (user-mail-address)))))
-    (unwind-protect
-	(save-excursion
-	  (set-buffer tembuf)
-	  (erase-buffer)
-	  ;; XEmacs: commented out
-; 	  (unless multibyte
-; 	    (set-buffer-multibyte nil))
-	  (insert-buffer-substring mailbuf)
-	  (goto-char (point-max))
-	  ;; require one newline at the end.
-	  (or (= (preceding-char) ?\n)
-	      (insert ?\n))
-	  ;; Change header-delimiter to be what sendmail expects.
-	  (goto-char (mail-header-end))
-	  (delete-region (point) (progn (end-of-line) (point)))
-	  (setq delimline (point-marker))
-;XEmacs removed.  See second paragraph in `mail-abbrevs.el' for rationale.
-;	  (sendmail-sync-aliases)
-;	  (if mail-aliases
-;	      (expand-mail-aliases (point-min) delimline))
-	  (goto-char (point-min))
-	  ;; Ignore any blank lines in the header
-	  (while (and (re-search-forward "\n\n\n*" delimline t)
-		      (< (point) delimline))
-	    (replace-match "\n"))
-	  (goto-char (point-min))
-	  (let ((case-fold-search t))
-;;;	    (goto-char (point-min))
-;;;	    (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t)
-;;;	      (setq resend-to-addresses
-;;;		    (save-restriction
-;;;		      (narrow-to-region (point)
-;;;					(save-excursion
-;;;					  (forward-line 1)
-;;;					  (while (looking-at "^[ \t]")
-;;;					    (forward-line 1))
-;;;					  (point)))
-;;;		      (append (mail-parse-comma-list)
-;;;			      resend-to-addresses)))
-;;;	      ;; Delete Resent-BCC ourselves
-;;;	      (if (save-excursion (beginning-of-line)
-;;;				  (looking-at "resent-bcc"))
-;;;		  (delete-region (save-excursion (beginning-of-line) (point))
-;;;				 (save-excursion (end-of-line) (1+ (point))))))
-;;; Apparently this causes a duplicate Sender.
-;;;	    ;; If the From is different than current user, insert Sender.
-;;;	    (goto-char (point-min))
-;;;	    (and (re-search-forward "^From:"  delimline t)
-;;;		 (progn
-;;;		   (require 'mail-utils)
-;;;		   (not (string-equal
-;;;			 (mail-strip-quoted-names
-;;;			  (save-restriction
-;;;			    (narrow-to-region (point-min) delimline)
-;;;			    (mail-fetch-field "From")))
-;;;			 (user-login-name))))
-;;;		 (progn
-;;;		   (forward-line 1)
-;;;		   (insert "Sender: " (user-login-name) "\n")))
-	    ;; Don't send out a blank subject line
-	    (goto-char (point-min))
-	    (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
-		(replace-match "")
-	      ;; This one matches a Subject just before the header delimiter.
-	      (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t)
-		       (= (match-end 0) delimline))
-		  (replace-match "")))
-	    ;; Put the "From:" field in unless for some odd reason
-	    ;; they put one in themselves.
-	    (goto-char (point-min))
-	    (if (not (re-search-forward "^From:" delimline t))
-		(let* ((login (user-mail-address))
-		       (fullname (user-full-name)))
-		  (cond ((eq mail-from-style 'angles)
-			 (insert "From: " fullname)
-			 (let ((fullname-start (+ (point-min) 6))
-			       (fullname-end (point-marker)))
-			   (goto-char fullname-start)
-			   ;; Look for a character that cannot appear unquoted
-			   ;; according to RFC 822.
-			   (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
-						  fullname-end 1)
-			       (progn
-				 ;; Quote fullname, escaping specials.
-				 (goto-char fullname-start)
-				 (insert "\"")
-				 (while (re-search-forward "[\"\\]"
-							   fullname-end 1)
-				   (replace-match "\\\\\\&" t))
-				 (insert "\""))))
-			 (insert " <" login ">\n"))
-			((eq mail-from-style 'parens)
-			 (insert "From: " login " (")
-			 (let ((fullname-start (point)))
-			   (insert fullname)
-			   (let ((fullname-end (point-marker)))
-			     (goto-char fullname-start)
-			     ;; RFC 822 says \ and nonmatching parentheses
-			     ;; must be escaped in comments.
-			     ;; Escape every instance of ()\ ...
-			     (while (re-search-forward "[()\\]" fullname-end 1)
-			       (replace-match "\\\\\\&" t))
-			     ;; ... then undo escaping of matching parentheses,
-			     ;; including matching nested parentheses.
-			     (goto-char fullname-start)
-			     (while (re-search-forward
-				     "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
-				     fullname-end 1)
-			       (replace-match "\\1(\\3)" t)
-			       (goto-char fullname-start))))
-			 (insert ")\n"))
-			((null mail-from-style)
-			 (insert "From: " login "\n"))
-			((eq mail-from-style 'system-default)
-			 nil)
-			(t (error "Invalid value for `mail-from-style'")))))
-	    ;; XEmacs: commented out #### why?
-; 	    ;; Possibly add a MIME header for the current coding system
-; 	    (let (charset)
-; 	      (goto-char (point-min))
-; 	      (and (eq mail-send-nonascii 'mime)
-; 		   (not (re-search-forward "^MIME-version:" delimline t))
-; 		   (progn (skip-chars-forward "\0-\177")
-; 			  (/= (point) (point-max)))
-; 		   selected-coding
-; 		   (setq charset
-; 			 (coding-system-get selected-coding 'mime-charset))
-; 		   (goto-char delimline)
-; 		   (insert "MIME-version: 1.0\n"
-; 			   "Content-type: text/plain; charset="
-; 			   (symbol-name charset) "\n"
-; 			   "Content-Transfer-Encoding: 8bit\n")))
-	    ;; Insert an extra newline if we need it to work around
-	    ;; Sun's bug that swallows newlines.
-	    (goto-char (1+ delimline))
-	    (if (eval mail-mailer-swallows-blank-line)
-		(newline))
-	    ;; Find and handle any FCC fields.
-	    (goto-char (point-min))
-	    (if (re-search-forward "^FCC:" delimline t)
-		(progn
-		  (setq fcc-was-found t)
-		  (mail-do-fcc delimline)))
-	    (if mail-interactive
-		(save-excursion
-		  (set-buffer errbuf)
-		  (erase-buffer))))
-
-	  ;; XEmacs change
-	  (mail-check-safe-charset)
-
-	  (goto-char (point-min))
-	  (if (let ((case-fold-search t))
-		(re-search-forward "^To:\\|^cc:\\|^bcc:\\|^resent-to:\
-\\|^resent-cc:\\|^resent-bcc:"
-				   delimline t))
-	      (let* ((default-directory "/")
-		     ;; XEmacs: commented out #### why?
-;		     (coding-system-for-write selected-coding)
-		     (args
-		      (append (list (point-min) (point-max)
-				    program
-				    nil errbuf nil "-oi")
-			      ;; Always specify who from,
-			      ;; since some systems have
-			      ;; broken sendmails.
-			      (and envelope-from
-				   (list "-f" envelope-from))
-;;; 			      ;; Don't say "from root" if running under su.
-;;; 			      (and (equal (user-real-login-name) "root")
-;;; 				   (list "-f" (user-login-name)))
-			      (and mail-alias-file
-				   (list (concat "-oA" mail-alias-file)))
-			      (if mail-interactive
-				  ;; These mean "report errors to terminal"
-				  ;; and "deliver interactively"
-				  '("-oep" "-odi")
-				;; These mean "report errors by mail"
-				;; and "deliver in background".
-				'("-oem" "-odb"))
-;;;			      ;; Get the addresses from the message
-;;;			      ;; unless this is a resend.
-;;;			      ;; We must not do that for a resend
-;;;			      ;; because we would find the original addresses.
-;;;			      ;; For a resend, include the specific addresses.
-;;;			      (or resend-to-addresses
-				  '("-t")
-;;;				  )
-			      (if mail-use-dsn
-				  (list "-N" (mapconcat 'symbol-name
-							mail-use-dsn ",")))
-			      )
-		      )
-		     (exit-value (apply 'call-process-region args)))
-		(or (null exit-value) (zerop exit-value)
-		    (error "Sending...failed with exit value %d" exit-value)))
-	    (or fcc-was-found
-		(error "No recipients")))
-	  (if mail-interactive
-	      (save-excursion
-		(set-buffer errbuf)
-		(goto-char (point-min))
-		(while (re-search-forward "\n\n* *" nil t)
-		  (replace-match "; "))
-		(if (not (zerop (buffer-size)))
-		    (error "Sending...failed to %s"
-			   (buffer-substring (point-min) (point-max)))))))
-      (kill-buffer tembuf)
-      (if (bufferp errbuf)
-	  (kill-buffer errbuf)))))
-
-;;; XEmacs FCC hackery, by jwz.  This version works on BABYL and VM buffers.
-;;; To accomplish the latter, VM is loaded when this file is compiled.
-;;; Don't worry, it's only loaded at compile-time.
-;;; The hackery somewhat reverted by jas to prevent mail lossage.
-
-(defun mail-do-fcc (header-end)
-  (let (fcc-list
-	(rmailbuf (current-buffer))
-	(time (current-time))
-	(tembuf (generate-new-buffer " rmail output"))
-	(case-fold-search t))
-    (or (markerp header-end) (error "header-end must be a marker"))
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward "^FCC:[ \t]*" header-end t)
-	(setq fcc-list (cons (buffer-substring (point)
-					       (progn
-						 (end-of-line)
-						 (skip-chars-backward " \t")
-						 (point)))
-			     fcc-list))
-	(delete-region (match-beginning 0)
-		       (progn (forward-line 1) (point))))
-      (set-buffer tembuf)
-      (erase-buffer)
-      ;; This initial newline is written out if the fcc file already exists.
-      (insert "\nFrom " (user-login-name) " "
-	      (current-time-string time) "\n")
-      ;; Insert the time zone before the year.
-      (forward-char -1)
-      (forward-word -1)
-      (require 'mail-utils)
-      (insert (mail-rfc822-time-zone time) " ")
-      (goto-char (point-max))
-      (insert-buffer-substring rmailbuf)
-      ;; Make sure messages are separated.
-      (goto-char (point-max))
-      (insert ?\n)
-      (goto-char 2)
-      ;; ``Quote'' "^From " as ">From "
-      ;;  (note that this isn't really quoting, as there is no requirement
-      ;;   that "^[>]+From " be quoted in the same transparent way.)
-      (let ((case-fold-search nil))
-	(while (search-forward "\nFrom " nil t)
-	  (forward-char -5)
-	  (insert ?>)))
-      (while fcc-list
-	(let* ((buffer (find-buffer-visiting (car fcc-list)))
-	       (curbuf (current-buffer))
-	       dont-write-the-file
-	       buffer-matches-file
-	       (beg (point-min)) (end (point-max))
-	       (beg2 (save-excursion (goto-char (point-min))
-				     (forward-line 2) (point))))
-	  (if buffer
-	      ;; File is present in a buffer => append to that buffer.
-	      (save-excursion
-		(set-buffer buffer)
-		(setq buffer-matches-file
-		      (and (not (buffer-modified-p))
-			   (verify-visited-file-modtime buffer)))
-		;; Keep the end of the accessible portion at the same place
-		;; unless it is the end of the buffer.
-		(let ((max (if (/= (1+ (buffer-size)) (point-max))
-			       (point-max))))
-		  (unwind-protect
-		      ;; Code below lifted from rmailout.el
-		      ;; function rmail-output-to-rmail-file:
-		      (let ((buffer-read-only nil)
-			    (msg (and (boundp 'rmail-current-message)
-				      rmail-current-message)))
-			;; If MSG is non-nil, buffer is in RMAIL mode.
-			(if msg
-			    (progn
-			      ;; Append to an ordinary buffer as a
-			      ;; Unix mail message.
-			      (rmail-maybe-set-message-counters)
-			      (widen)
-			      (narrow-to-region (point-max) (point-max))
-			      (insert "\C-l\n0, unseen,,\n*** EOOH ***\n"
-				      "Date: " (mail-rfc822-date) "\n")
-			      (insert-buffer-substring curbuf beg2 end)
-			      (insert "\n\C-_")
-			      (goto-char (point-min))
-			      (widen)
-			      (search-backward "\n\^_")
-			      (narrow-to-region (point) (point-max))
-			      (rmail-count-new-messages t)
-			      (rmail-show-message msg)
-			      (setq max nil))
-			  (if (with-current-buffer buffer ;; XEmacs
-				(eq major-mode 'vm-mode))
-			      (with-current-buffer buffer
-				(mail-do-fcc-vm-internal tembuf))
-			    ;; Output file not in rmail mode
-			    ;; => just insert at the end.
-			    (narrow-to-region (point-min) (1+ (buffer-size)))
-			    (goto-char (point-max))
-			    (insert-buffer-substring curbuf beg end)))
-			(or buffer-matches-file
-			    (progn
-			      (if (y-or-n-p (format "Save file %s? "
-						    (car fcc-list)))
-				  (save-buffer))
-			      (setq dont-write-the-file t))))
-		    (if max (narrow-to-region (point-min) max))))))
-	  ;; Append to the file directly,
-	  ;; unless we've already taken care of it.
-	  ;; (It's OK if it is an RMAIL or VM file -- the message will be
-	  ;; parsed when the file is read in.)
-	  (unless dont-write-the-file
-	    (if (and (file-exists-p (car fcc-list))
-		     ;; Check that the file isn't empty.  We don't
-		     ;; want to insert a newline at the start of an
-		     ;; empty file.
-		     (not (zerop (nth 7 (file-attributes (car fcc-list)))))
-		     (mail-file-babyl-p (car fcc-list)))
-		;; If the file is a Babyl file,
-		;; convert the message to Babyl format.
-		(let ((coding-system-for-write
-		       (or rmail-file-coding-system
-			   'emacs-mule)))
-		  (save-excursion
-		    (set-buffer (get-buffer-create " mail-temp"))
-		    (setq buffer-read-only nil)
-		    (erase-buffer)
-		    (insert "\C-l\n0, unseen,,\n*** EOOH ***\n"
-			    "Date: " (mail-rfc822-date) "\n")
-		    (insert-buffer-substring curbuf beg2 end)
-		    (insert "\n\C-_")
-		    (write-region (point-min) (point-max) (car fcc-list) t)
-		    (erase-buffer)))
-	      ;; MIME processing should have eliminated any characters
-	      ;; outside the range 0-255; if MIME processing hasn't been
-	      ;; done, there's no reasonable expectation that the data will
-	      ;; be preserved in a Unix mailbox, so we just write tildes for
-	      ;; those chars. We set the coding system for write to 'binary
-	      ;; to prevent any double-encoding that may occur if
-	      ;; buffer-file-coding-system has been initialised to a
-	      ;; non-binary-compatible coding system like, say, UTF-8.
-	      (let ((coding-system-for-write 'binary))
-		(write-region (1+ (point-min)) (point-max) (car fcc-list) t))))
-	  (and buffer (not dont-write-the-file)
-	       (with-current-buffer buffer
-		 (set-visited-file-modtime))))
-	(setq fcc-list (cdr fcc-list))))
-    (kill-buffer tembuf)))
-
-;; XEmacs:
-(defun mail-do-fcc-vm-internal (buffer)
-  (or (eq major-mode 'vm-mode) (error "this only works in vm-mode"))
-  (let ((buffer-read-only nil)
-	(foreign-folder-p (not (eq vm-folder-type 'From_))))
-
-    (if foreign-folder-p
-	;; `buffer' has already been prepared with a "From " line which
-	;; has a sensible user-id and date in it, but if we're FCCing to
-	;; a VM folder that isn't in From_ format, we must discard that
-	;; and let VM do whatever voodoo it needs to do.  (Actually we
-	;; could do this all the time, but then all FCCed messages would
-	;; have "From VM ..." envelopes, which is less attractive.)
-	(save-excursion
-	  (set-buffer buffer)
-	  (goto-char (point-min))
-	  (skip-chars-forward "\n")
-	  (forward-line)
-	  (delete-region (point-min) (point))))
-
-    ;; Use eval to inhibit compilation of the following code.
-    ;; The code contains macros, and to compile them a (reuqire
-    ;; 'vm-misc) is needed.  When VM stopped being bundled with
-    ;; XEmacs, this require call became impossible.
-    (eval
-     (quote
-      ;; Largely copied from #'vm-save-message in vm-save.el
-      (vm-save-restriction
-       (widen)
-       (goto-char (point-max))
-       (if foreign-folder-p
-	   (vm-write-string (current-buffer)
-			    (vm-leading-message-separator vm-folder-type)))
-       (insert-buffer-substring buffer)
-       (if foreign-folder-p
-	   (vm-write-string (current-buffer)
-			    (vm-trailing-message-separator vm-folder-type)))
-
-       (vm-increment vm-messages-not-on-disk)
-       (vm-set-buffer-modified-p t)
-       (vm-clear-modification-flag-undos)
-       (vm-check-for-killed-summary)
-       (vm-assimilate-new-messages)
-       (vm-update-summary-and-mode-line))))))
-
-(defun mail-sent-via ()
-  "Make a Sent-via header line from each To or CC header line."
-  (interactive)
-  (save-excursion
-    ;; put a marker at the end of the header
-    (let ((end (copy-marker (mail-header-end)))
-	  (case-fold-search t)
-	  ;to-line
-	  )
-      (goto-char (point-min))
-      ;; search for the To: lines and make Sent-via: lines from them
-      ;; search for the next To: line
-      (while (re-search-forward "^\\(to\\|cc\\):" end t)
-	;; Grab this line plus all its continuations, sans the `to:'.
-	(let ((to-line
-	       (buffer-substring (point)
-				 (progn
-				   (if (re-search-forward "^[^ \t\n]" end t)
-				       (backward-char 1)
-				     (goto-char end))
-				   (point)))))
-	  ;; Insert a copy, with altered header field name.
-	  (insert-before-markers "Sent-via:" to-line))))))
-
-(defun mail-to ()
-  "Move point to end of To-field."
-  (interactive)
-  (if (interactive-p) (expand-abbrev))  ; XEmacs: for mail-abbrevs
-  (mail-position-on-field "To"))
-
-(defun mail-subject ()
-  "Move point to end of Subject-field."
-  (interactive)
-  (if (interactive-p) (expand-abbrev))  ; XEmacs: for mail-abbrevs
-  (mail-position-on-field "Subject"))
-
-(defun mail-cc ()
-  "Move point to end of CC-field.  Create a CC field if none."
-  (interactive)
-  (if (interactive-p) (expand-abbrev))  ; XEmacs: for mail-abbrevs
-  (or (mail-position-on-field "cc" t)
-      (progn (mail-position-on-field "to")
-	     (insert "\nCC: "))))
-
-(defun mail-bcc ()
-  "Move point to end of BCC-field.  Create a BCC field if none."
-  (interactive)
-  (if (interactive-p) (expand-abbrev))  ; XEmacs: for mail-abbrevs
-  (or (mail-position-on-field "bcc" t)
-      (progn (mail-position-on-field "to")
-	     (insert "\nBCC: "))))
-
-(defun mail-fcc (folder)
-  "Add a new FCC field, with file name completion."
-  (interactive "FFolder carbon copy: ")
-  (if (interactive-p) (expand-abbrev))  ; XEmacs: for mail-abbrevs
-  (or (mail-position-on-field "fcc" t)	;Put new field after exiting FCC.
-      (mail-position-on-field "to"))
-  (insert "\nFCC: " folder))
-
-(defun mail-reply-to ()
-  "Move point to end of Reply-To-field.  Create a Reply-To field if none."
-  (interactive)
-  (if (interactive-p) (expand-abbrev))  ; XEmacs: for mail-abbrevs
-  (mail-position-on-field "Reply-To"))
-
-(defun mail-position-on-field (field &optional soft)
-  (let (end
-	(case-fold-search t))
-    (setq end (mail-header-end))
-    (goto-char (point-min))
-    (if (re-search-forward (concat "^" (regexp-quote field) ":") end t)
-	(progn
-	  (re-search-forward "^[^ \t]" nil 'move)
-	  (beginning-of-line)
-	  (skip-chars-backward "\n")
-	  t)
-      (or soft
-	  (progn (goto-char end)
-		 (insert field ": \n")
-		 (skip-chars-backward "\n")))
-      nil)))
-
-(defun mail-text ()
-  "Move point to beginning of message text."
-  (interactive)
-  (if (interactive-p) (expand-abbrev))  ; XEmacs: for mail-abbrevs
-  (goto-char (mail-text-start)))
-
-(defun mail-signature (&optional atpoint)
-  "Sign letter with signature based on `mail-signature-file'.
-Prefix arg means put contents at point."
-  (interactive "P")
-  (save-excursion
-    (or atpoint
-	(goto-char (point-max)))
-    (skip-chars-backward " \t\n")
-    (end-of-line)
-    (or atpoint
-	(delete-region (point) (point-max)))
-    (if (stringp mail-signature)
-	(insert mail-signature)
-      (insert "\n\n-- \n")
-      (insert-file-contents (expand-file-name mail-signature-file)))))
-
-(defun mail-fill-yanked-message (&optional justifyp)
-  "Fill the paragraphs of a message yanked into this one.
-Numeric argument means justify as well."
-  (interactive "P")
-  (save-excursion
-    (goto-char (mail-text-start))
-    (fill-individual-paragraphs (point)
-				(point-max)
-				justifyp
-				mail-citation-prefix-regexp)))
-
-(defun mail-indent-citation ()
-  "Modify text just inserted from a message to be cited.
-The inserted text should be the region.
-When this function returns, the region is again around the modified text.
-
-Normally, indent each nonblank line `mail-indentation-spaces' spaces.
-However, if `mail-yank-prefix' is non-nil, insert that prefix on each line."
-  (mail-yank-clear-headers (region-beginning) (region-end))
-  (if (null mail-yank-prefix)
-      (indent-rigidly (region-beginning) (region-end)
-		      mail-indentation-spaces)
-    (save-excursion
-      (let ((end (set-marker (make-marker) (region-end))))
-	(goto-char (region-beginning))
-	(while (< (point) end)
-	  (insert mail-yank-prefix)
-	  (forward-line 1))))))
-
-(defun mail-yank-original (arg)
-  "Insert the message being replied to, if any (in rmail).
-Puts point after the text and mark before.
-Normally, indents each nonblank line ARG spaces (default 3).
-However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
-
-Just \\[universal-argument] as argument means don't indent, insert no prefix,
-and don't delete any header fields."
-  (interactive "P")
-  (if mail-reply-action
-      (let ((start (point))
-	    (original mail-reply-action))
-	(and (consp original) (eq (car original) 'insert-buffer)
-	     (setq original (nth 1 original)))
-	(if (consp original)
-	    (apply (car original) (cdr original))
-	  ;; If the original message is in another window in the same frame,
-	  ;; delete that window to save screen space.
-	  ;; t means don't alter other frames.
-	  (delete-windows-on original t)
-	  (insert-buffer original)
-	  (set-text-properties (point) (mark t) nil))
-	(if (consp arg)
-	    nil
-	  (goto-char start)
-	  (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
-					   mail-indentation-spaces))
-		;; Avoid error in Transient Mark mode
-		;; on account of mark's being inactive.
-		(mark-even-if-inactive t))
-	    (cond (mail-citation-hook
-		   ;; Bind mail-citation-header to the inserted
-		   ;; message's header.
-		   (let ((mail-citation-header
-			  (buffer-substring-no-properties
-			   start
-			   (save-excursion
-			     (save-restriction
-			       (narrow-to-region start (point-max))
-			       (goto-char start)
-			       (rfc822-goto-eoh)
-			       (point))))))
-		     (run-hooks 'mail-citation-hook)))
-		  (mail-yank-hooks
-		   (run-hooks 'mail-yank-hooks))
-		  (t
-		   (mail-indent-citation)))))
-	;; This is like exchange-point-and-mark, but doesn't activate the mark.
-	;; It is cleaner to avoid activation, even though the command
-	;; loop would deactivate the mark because we inserted text.
-	(goto-char (prog1 (mark t)
-		     (set-marker (mark-marker) (point) (current-buffer))))
-	(if (not (eolp)) (insert ?\n)))))
-
-(defun mail-yank-clear-headers (start end)
-  (if (< end start)
-      (let (temp)
-	(setq temp start start end end temp)))
-  (if mail-yank-ignored-headers
-      (save-excursion
-	(goto-char start)
-	(if (search-forward "\n\n" end t)
-	    (save-restriction
-	      (narrow-to-region start (point))
-	      (goto-char start)
-	      (while (let ((case-fold-search t))
-		       (re-search-forward mail-yank-ignored-headers nil t))
-		(beginning-of-line)
-		(delete-region (point)
-			       (progn (re-search-forward "\n[^ \t]")
-				      (forward-char -1)
-				      (point)))))))))
-
-(defun mail-yank-region (arg)
-  "Insert the selected region from the message being replied to.
-Puts point after the text and mark before.
-Normally, indents each nonblank line ARG spaces (default 3).
-However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
-
-Just \\[universal-argument] as argument means don't indent, insert no prefix,
-and don't delete any header fields."
-  (interactive "P")
-  (and (consp mail-reply-action)
-       (eq (car mail-reply-action) 'insert-buffer)
-       (with-current-buffer (nth 1 mail-reply-action)
-	 (or (mark t)
-	     (error "No mark set: %S" (current-buffer))))
-       (let ((buffer (nth 1 mail-reply-action))
-	     (start (point))
-	     ;; Avoid error in Transient Mark mode
-	     ;; on account of mark's being inactive.
-	     (mark-even-if-inactive t))
-	 ;; Insert the citation text.
-	 (insert (with-current-buffer buffer
-		   (buffer-substring-no-properties (point) (mark))))
-	 (push-mark start)
-	 ;; Indent or otherwise annotate the citation text.
-	 (if (consp arg)
-	     nil
-	   (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
-					    mail-indentation-spaces)))
-	     (if mail-citation-hook
-		 ;; Bind mail-citation-hook to the original message's header.
-		 (let ((mail-citation-header
-			(with-current-buffer buffer
-			  (buffer-substring-no-properties
-			   (point-min)
-			   (save-excursion
-			     (goto-char (point-min))
-			     (rfc822-goto-eoh)
-			     (point))))))
-		   (run-hooks 'mail-citation-hook))
-	       (if mail-yank-hooks
-		   (run-hooks 'mail-yank-hooks)
-		 (mail-indent-citation))))))))
-
-(defun mail-split-line ()
-  "Split current line, moving portion beyond point vertically down.
-If the current line has `mail-yank-prefix', insert it on the new line."
-  (interactive "*")
-  (split-line
-   ;; XEmacs: #### fix this
-   ;mail-yank-prefix
-   ))
-
-
-(defun mail-attach-file (&optional file)
-  "Insert a file at the end of the buffer, with separator lines around it."
-  (interactive "fAttach file: ")
-  (save-excursion
-    (goto-char (point-max))
-    (or (bolp) (newline))
-    (newline)
-    (let ((start (point))
-	  middle)
-      (insert (format "===File %s===" file))
-      (insert-char ?= (max 0 (- 60 (current-column))))
-      (newline)
-      (setq middle (point))
-      (insert "============================================================\n")
-      (push-mark)
-      (goto-char middle)
-      (insert-file-contents file)
-      (or (bolp) (newline))
-      (goto-char start))))
-
-;; Put these commands last, to reduce chance of lossage from quitting
-;; in middle of loading the file.
-
-;;;###autoload (add-hook 'same-window-buffer-names "*mail*")
-
-;;;###autoload
-(defun mail (&optional noerase to subject in-reply-to cc replybuffer actions)
-  "Edit a message to be sent.  Prefix arg means resume editing (don't erase).
-When this function returns, the buffer `*mail*' is selected.
-The value is t if the message was newly initialized; otherwise, nil.
-
-Optionally, the signature file `mail-signature-file' can be inserted at the
-end; see the variable `mail-signature'.
-
-\\
-While editing message, type \\[mail-send-and-exit] to send the message and exit.
-
-Various special commands starting with C-c are available in sendmail mode
-to move to message header fields:
-\\{mail-mode-map}
-
-If `mail-self-blind' is non-nil, a BCC to yourself is inserted
-when the message is initialized.
-
-If `mail-default-reply-to' is non-nil, it should be an address (a string);
-a Reply-to: field with that address is inserted.
-
-If `mail-archive-file-name' is non-nil, an FCC field with that file name
-is inserted.
-
-The normal hook `mail-setup-hook' is run after the message is
-initialized.  It can add more default fields to the message.
-
-When calling from a program, the first argument if non-nil says
-not to erase the existing contents of the `*mail*' buffer.
-
-The second through fifth arguments,
- TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
- the initial contents of those header fields.
- These arguments should not have final newlines.
-The sixth argument REPLYBUFFER is a buffer which contains an
- original message being replied to, or else an action
- of the form (FUNCTION . ARGS) which says how to insert the original.
- Or it can be nil, if not replying to anything.
-The seventh argument ACTIONS is a list of actions to take
- if/when the message is sent.  Each action looks like (FUNCTION . ARGS);
- when the message is sent, we apply FUNCTION to ARGS.
- This is how Rmail arranges to mark messages `answered'."
-  (interactive "P")
-  ;; XEmacs: major changes here
-  (if mail-use-multiple-buffers-p
-;;; This is commented out because I found it was confusing in practice.
-;;; It is easy enough to rename *mail* by hand with rename-buffer
-;;; if you want to have multiple mail buffers.
-;;; And then you can control which messages to save. --rms.
-;;; Put it back in, conditional on mail-use-multiple-buffers-p --jas
-      (let ((index 1)
-	    buffer)
-	;; If requested, look for a mail buffer that is modified and go to it.
-	(if noerase
-	    (progn
-	      (while (and (setq buffer
-				(get-buffer (if (= 1 index) "*mail*"
-					      (format "*mail*<%d>" index))))
-			  (not (buffer-modified-p buffer)))
-		(setq index (1+ index)))
-	      (if buffer (switch-to-buffer buffer)
-		;; If none exists, start a new message.
-		;; This will never re-use an existing unmodified mail buffer
-		;; (since index is not 1 anymore).  Perhaps it should.
-		(setq noerase nil))))
-	;; Unless we found a modified message and are happy, start a
-	;; new message.
-	(if (not noerase)
-	    (progn
-	      ;; Look for existing unmodified mail buffer.
-	      (while (and (setq buffer
-				(get-buffer (if (= 1 index) "*mail*"
-					      (format "*mail*<%d>" index))))
-			  (buffer-modified-p buffer))
-		(setq index (1+ index)))
-	      ;; If none, make a new one.
-	      (or buffer
-		  (setq buffer (generate-new-buffer "*mail*")))
-	      ;; Go there and initialize it.
-	      (switch-to-buffer buffer)
-	      (erase-buffer)
-	      (setq default-directory (expand-file-name "~/"))
-	      (auto-save-mode auto-save-default)
-	      (mail-mode)
-	      (mail-setup to subject in-reply-to cc replybuffer actions)
-	      (if (and buffer-auto-save-file-name
-		       (file-exists-p buffer-auto-save-file-name))
-		  (message "Auto save file for draft message exists; consider M-x mail-recover"))
-	      t)))
-
-    (pop-to-buffer "*mail*")
-    ;; Avoid danger that the auto-save file can't be written.
-    (let ((dir (expand-file-name
-		(file-name-as-directory mail-default-directory))))
-      (if (file-exists-p dir)
-	  (setq default-directory dir)))
-    ;; Only call auto-save-mode if necessary, to avoid changing auto-save file.
-    (if (or (and auto-save-default (not buffer-auto-save-file-name))
-	    (and (not auto-save-default) buffer-auto-save-file-name))
-	(auto-save-mode auto-save-default))
-    (mail-mode)
-    ;; Disconnect the buffer from its visited file
-    ;; (in case the user has actually visited a file *mail*).
-;  (set-visited-file-name nil)
-    (let (initialized)
-      (and (not noerase)
-	 (if buffer-file-name
-	     (if (buffer-modified-p)
-		 (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ")
-		   (if (y-or-n-p "Disconnect buffer from visited file? ")
-		       (set-visited-file-name nil))
-		   t)
-	       (when (y-or-n-p "Reinitialize buffer, and disconnect it from the visited file? ")
-		 (set-visited-file-name nil)
-		 t))
-	   ;; A non-file-visiting buffer.
-	   (if (buffer-modified-p)
-	       (y-or-n-p "Unsent message being composed; erase it? ")
-	     t))
-	 (let ((inhibit-read-only t))
-	   (erase-buffer)
-	   (mail-setup to subject in-reply-to cc replybuffer actions)
-	   (setq initialized t)))
-      (if (and buffer-auto-save-file-name
-	       (file-exists-p buffer-auto-save-file-name))
-	  (message "Auto save file for draft message exists; consider M-x mail-recover"))
-      initialized)))
-
-(defun mail-recover-1 ()
-  "Pop up a list of auto-saved draft messages so you can recover one of them."
-  (interactive)
-  (let ((file-name (make-auto-save-file-name))
-	(ls-lisp-support-shell-wildcards t)
-	non-random-len wildcard)
-    ;; Remove the random part from the auto-save-file-name, and
-    ;; create a wildcard which matches possible candidates.
-    ;; Note: this knows that make-auto-save-file-name appends
-    ;; "##" to the buffer name, where RANDOM-STUFF
-    ;; is the result of (make-temp-name "").
-    (setq non-random-len
-	  (- (length file-name) (length (make-temp-name "")) 1))
-    (setq wildcard (concat (substring file-name 0 non-random-len) "*"))
-    (if (null (file-expand-wildcards wildcard))
-	(message "There are no auto-saved drafts to recover")
-      ;; Bind dired-trivial-filenames to t because all auto-save file
-      ;; names are normally ``trivial'', so Dired will set point after
-      ;; all the files, at buffer bottom.  We want it on the first
-      ;; file instead.
-      (let ((dired-trivial-filenames t))
-	(dired-other-window wildcard (concat dired-listing-switches "t")))
-      (rename-buffer "*Auto-saved Drafts*" t)
-      (save-excursion
-	(goto-char (point-min))
-	(or (looking-at " Move to the draft file you want to recover,")
-	    (let ((inhibit-read-only t))
-	      ;; Each line starts with a space so that Font Lock mode
-	      ;; won't highlight the first character.
-	      (insert "\
- Move to the draft file you want to recover, then type C-c C-c
- to recover text of message whose composition was interrupted.
- To browse text of a draft, type v on the draft file's line.
-
- You can also delete some of these files;
- type d on a line to mark that file for deletion.
-
- List of possible auto-save files for recovery:
-
-"))))
-      (use-local-map
-       (let ((map (make-sparse-keymap)))
-	 (set-keymap-parent map (current-local-map))
-	 map))
-      (define-key (current-local-map) "v"
-	(lambda ()
-	  (interactive)
-	  (let ((coding-system-for-read 'emacs-mule-unix))
-	    (dired-view-file))))
-      (define-key (current-local-map) "\C-c\C-c"
-	(lambda ()
-	  (interactive)
-	  (let ((fname (dired-get-filename))
-		;; Auto-saved files are written in the internal
-		;; representation, so they should be read accordingly.
-		(coding-system-for-read 'emacs-mule-unix))
-	    (switch-to-buffer-other-window "*mail*")
-	    (let ((buffer-read-only nil))
-	      (erase-buffer)
-	      (insert-file-contents fname nil)
-	      ;; insert-file-contents will set buffer-file-coding-system
-	      ;; to emacs-mule, which is probably not what they want to
-	      ;; use for sending the message.  But we don't know what
-	      ;; was its value before the buffer was killed or Emacs
-	      ;; crashed.  We therefore reset buffer-file-coding-system
-	      ;; to the default value, so that either the default does
-	      ;; TRT, or the user will get prompted for the right
-	      ;; encoding when they send the message.
-	      (setq buffer-file-coding-system
-		    default-buffer-file-coding-system))))))))
-
-(defun mail-recover ()
-  "Recover interrupted mail composition from auto-save files.
-
-If the mail buffer has a current valid auto-save file,
-the command recovers that file.  Otherwise, it displays a
-buffer showing the existing auto-saved draft messages;
-you can move to one of them and type C-c C-c to recover that one."
-  (interactive)
-  ;; In case they invoke us from some random buffer...
-  (switch-to-buffer "*mail*")
-  ;; If *mail* didn't exist, set its directory, so that auto-saved
-  ;; drafts will be found.
-  (let ((dir (expand-file-name
-	      (file-name-as-directory mail-default-directory))))
-    (if (file-exists-p dir)
-	(setq default-directory dir)))
-  (or (eq major-mode 'mail-mode)
-      (mail-mode))
-  (let ((file-name buffer-auto-save-file-name))
-    (cond ((and file-name (file-exists-p file-name))
-	   (let ((dispbuf
-		  ;; This used to invoke `ls' via call-process, but
-		  ;; dired-noselect is more portable to systems where
-		  ;; `ls' is not a standard program (it will use
-		  ;; ls-lisp instead).
-		  (dired-noselect file-name
-				  (concat dired-listing-switches "t"))))
-	     (save-selected-window
-	       (select-window (display-buffer dispbuf t))
-	       (goto-char (point-min))
-	       (forward-line 2)
-	       (dired-move-to-filename)
-	       (setq dispbuf (rename-buffer "*Directory*" t)))
-	     (if (not (yes-or-no-p
-		       (format "Recover mail draft from auto save file %s? "
-			       file-name)))
-		 (error "mail-recover cancelled")
-	       (let ((buffer-read-only nil)
-		     (buffer-coding buffer-file-coding-system)
-		     ;; Auto-save files are written in internal
-		     ;; representation of non-ASCII characters.
-		     (coding-system-for-read 'emacs-mule-unix))
-		 (erase-buffer)
-		 (insert-file-contents file-name nil)
-		 (setq buffer-file-coding-system buffer-coding)))))
-	  (t (mail-recover-1)))))
-
-;;;###autoload
-(defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions)
-  "Like `mail' command, but display mail buffer in another window."
-  (interactive "P")
-  (let ((pop-up-windows t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (pop-to-buffer "*mail*"))
-  (mail noerase to subject in-reply-to cc replybuffer sendactions))
-
-;;;###autoload
-(defun mail-other-frame (&optional noerase to subject in-reply-to cc replybuffer sendactions)
-  "Like `mail' command, but display mail buffer in another frame."
-  (interactive "P")
-  (let ((pop-up-frames t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (pop-to-buffer "*mail*"))
-  (mail noerase to subject in-reply-to cc replybuffer sendactions))
-
-;;; Do not add anything but external entries on this page.
-
-(provide 'sendmail)
-
-;;; sendmail.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/smtpmail.el b/xemacs-packages/lisp/mail-lib/smtpmail.el
deleted file mode 100644
index f5d127f0..00000000
--- a/xemacs-packages/lisp/mail-lib/smtpmail.el
+++ /dev/null
@@ -1,983 +0,0 @@
-;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
-
-;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005,
-;;   2006 Free Software Foundation, Inc.
-
-;; Author: Tomoji Kagatani 
-;; Maintainer: Simon Josefsson 
-;; w32 Maintainer: Brian D. Carlstrom 
-;; ESMTP support: Simon Leinen 
-;; Hacked by Mike Taylor, 11th October 1999 to add support for
-;; automatically appending a domain to RCPT TO: addresses.
-;; AUTH=LOGIN support: Stephen Cranefield 
-;; Keywords: mail
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Send Mail to smtp host from smtpmail temp buffer.
-
-;; Please add these lines in your .emacs(_emacs) or use customize.
-;;
-;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
-;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus
-;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST")
-;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
-;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")
-;;(setq smtpmail-debug-info t) ; only to debug problems
-;;(setq smtpmail-auth-credentials  ; or use ~/.authinfo
-;;      '(("YOUR SMTP HOST" 25 "username" "password")))
-;;(setq smtpmail-starttls-credentials
-;;      '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert")))
-;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an
-;; integer or a string, just as long as they match (eq).
-
-;; To queue mail, set smtpmail-queue-mail to t and use
-;; smtpmail-send-queued-mail to send.
-
-;; Modified by Stephen Cranefield ,
-;; 22/6/99, to support SMTP Authentication by the AUTH=LOGIN mechanism.
-;; See http://help.netscape.com/products/server/messaging/3x/info/smtpauth.html
-;; Rewritten by Simon Josefsson to use same credential variable as AUTH
-;; support below.
-
-;; Modified by Simon Josefsson , 22/2/99, to support SMTP
-;; Authentication by the AUTH mechanism.
-;; See http://www.ietf.org/rfc/rfc2554.txt
-
-;; Modified by Simon Josefsson , 2000-10-07, to support
-;; STARTTLS.  Requires external program
-;; ftp://ftp.opaopa.org/pub/elisp/starttls-*.tar.gz.
-;; See http://www.ietf.org/rfc/rfc2246.txt, http://www.ietf.org/rfc/rfc2487.txt
-
-;;; Code:
-
-(require 'sendmail)
-(autoload 'starttls-open-stream "starttls")
-(autoload 'starttls-negotiate "starttls")
-(autoload 'mail-strip-quoted-names "mail-utils")
-(autoload 'mail-check-safe-charset "mail-utils")
-(autoload 'message-make-date "message")
-(autoload 'message-make-message-id "message")
-(autoload 'rfc2104-hash "rfc2104")
-(autoload 'base64-decode-string "base64")
-(autoload 'netrc-parse "netrc")
-(autoload 'netrc-machine "netrc")
-(autoload 'netrc-get "netrc")
-
-;;;
-(defgroup smtpmail nil
-  "SMTP protocol for sending mail."
-  :group 'mail)
-
-
-(defcustom smtpmail-default-smtp-server nil
-  "*Specify default SMTP server.
-This only has effect if you specify it before loading the smtpmail library."
-  :type '(choice (const nil) string)
-  :group 'smtpmail)
-
-(defcustom smtpmail-smtp-server
-  (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
-  "*The name of the host running SMTP server."
-  :type '(choice (const nil) string)
-  :group 'smtpmail)
-
-(defcustom smtpmail-smtp-service 25
-  "*SMTP service port number.
-The default value would be \"smtp\" or 25 ."
-  :type '(choice (integer :tag "Port") (string :tag "Service"))
-  :group 'smtpmail)
-
-(defcustom smtpmail-local-domain nil
-  "*Local domain name without a host name.
-If the function (system-name) returns the full internet address,
-don't define this value."
-  :type '(choice (const nil) string)
-  :group 'smtpmail)
-
-(defcustom smtpmail-sendto-domain nil
-  "*Local domain name without a host name.
-This is appended (with an @-sign) to any specified recipients which do
-not include an @-sign, so that each RCPT TO address is fully qualified.
-\(Some configurations of sendmail require this.)
-
-Don't bother to set this unless you have get an error like:
-	Sending failed; SMTP protocol error
-when sending mail, and the *trace of SMTP session to *
-buffer includes an exchange like:
-	RCPT TO: 
-	501 : recipient address must contain a domain
-"
-  :type '(choice (const nil) string)
-  :group 'smtpmail)
-
-(defcustom smtpmail-debug-info nil
-  "Whether to print info in buffer *trace of SMTP session to *.
-See also `smtpmail-debug-verb' which determines if the SMTP protocol should
-be verbose as well."
-  :type 'boolean
-  :group 'smtpmail)
-
-(defcustom smtpmail-debug-verb nil
-  "Whether this library sends the SMTP VERB command or not.
-The commands enables verbose information from the SMTP server."
-  :type 'boolean
-  :group 'smtpmail)
-
-(defcustom smtpmail-code-conv-from nil ;; *junet*
-  "*smtpmail code convert from this code to *internal*..for tiny-mime.."
-  :type 'boolean
-  :group 'smtpmail)
-
-(defcustom smtpmail-queue-mail nil
-  "*Specify if mail is queued (if t) or sent immediately (if nil).
-If queued, it is stored in the directory `smtpmail-queue-dir'
-and sent with `smtpmail-send-queued-mail'."
-  :type 'boolean
-  :group 'smtpmail)
-
-(defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
-  "*Directory where `smtpmail.el' stores queued mail."
-  :type 'directory
-  :group 'smtpmail)
-
-(defcustom smtpmail-auth-credentials "~/.authinfo"
-  "Specify username and password for servers, directly or via .netrc file.
-This variable can either be a filename pointing to a file in netrc(5)
-format, or list of four-element lists that contain, in order,
-`servername' (a string), `port' (an integer), `user' (a string) and
-`password' (a string, or nil to query the user when needed).  If you
-need to enter a `realm' too, add it to the user string, so that it
-looks like `user@realm'."
-  :type '(choice file
-		 (repeat (list (string  :tag "Server")
-		       (integer :tag "Port")
-		       (string  :tag "Username")
-		       (choice (const :tag "Query when needed" nil)
-				       (string  :tag "Password")))))
-  :group 'smtpmail)
-
-(defcustom smtpmail-starttls-credentials '(("" 25 "" ""))
-  "Specify STARTTLS keys and certificates for servers.
-This is a list of four-element list with `servername' (a string),
-`port' (an integer), `key' (a filename) and `certificate' (a filename)."
-  :type '(repeat (list (string  :tag "Server")
-		       (integer :tag "Port")
-		       (file    :tag "Key")
-		       (file    :tag "Certificate")))
-  :group 'smtpmail)
-
-(defcustom smtpmail-warn-about-unknown-extensions nil
-  "*If set, print warnings about unknown SMTP extensions.
-This is mainly useful for development purposes, to learn about
-new SMTP extensions that might be useful to support."
-  :type 'boolean
-  :group 'smtpmail)
-
-(defvar smtpmail-queue-index-file "index"
-  "File name of queued mail index,
-This is relative to `smtpmail-queue-dir'.")
-
-(defvar smtpmail-address-buffer)
-(defvar smtpmail-recipient-address-list)
-
-(defvar smtpmail-queue-counter 0)
-
-;; Buffer-local variable.
-(defvar smtpmail-read-point)
-
-(defvar smtpmail-queue-index (concat smtpmail-queue-dir
-				     smtpmail-queue-index-file))
-
-(defconst smtpmail-auth-supported '(cram-md5 plain login)
-  "List of supported SMTP AUTH mechanisms.")
-
-;;;
-;;;
-;;;
-
-(defvar smtpmail-mail-address nil
-  "Value to use for envelope-from address for mail from ambient buffer.")
-
-;;;###autoload
-(defun smtpmail-send-it ()
-  (let ((errbuf (if mail-interactive
-		    (generate-new-buffer " smtpmail errors")
-		  0))
-	(tembuf (generate-new-buffer " smtpmail temp"))
-	(case-fold-search nil)
-	delimline
-	(mailbuf (current-buffer))
-	;; Examine this variable now, so that
-	;; local binding in the mail buffer will take effect.
-	(smtpmail-mail-address
-	 (or (and mail-specify-envelope-from (mail-envelope-from))
-	     (user-mail-address))) ;; XEmacs
-	;; XEmacs: Don't frob `smtpmail-code-conv-from' here
-	)
-    (unwind-protect
-	(save-excursion
-	  (set-buffer tembuf)
-	  (erase-buffer)
-	  (insert-buffer-substring mailbuf)
-	  (goto-char (point-max))
-	  ;; require one newline at the end.
-	  (or (= (preceding-char) ?\n)
-	      (insert ?\n))
-	  ;; Change header-delimiter to be what sendmail expects.
-	  (mail-sendmail-undelimit-header)
-	  (setq delimline (point-marker))
-;;	  (sendmail-synch-aliases)
-	  (if (and mail-aliases (fboundp 'expand-mail-aliases)) ; XEmacs
-	      (expand-mail-aliases (point-min) delimline))
-	  (goto-char (point-min))
-	  ;; ignore any blank lines in the header
-	  (while (and (re-search-forward "\n\n\n*" delimline t)
-		      (< (point) delimline))
-	    (replace-match "\n"))
-	  (let ((case-fold-search t))
-	    ;; We used to process Resent-... headers here,
-	    ;; but it was not done properly, and the job
-	    ;; is done correctly in smtpmail-deduce-address-list.
-	    ;; Don't send out a blank subject line
-	    (goto-char (point-min))
-	    (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
-		(replace-match "")
-	      ;; This one matches a Subject just before the header delimiter.
-	      (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t)
-		       (= (match-end 0) delimline))
-		  (replace-match "")))
-	    ;; Put the "From:" field in unless for some odd reason
-	    ;; they put one in themselves.
-	    (goto-char (point-min))
-	    (if (not (re-search-forward "^From:" delimline t))
-		(let* ((login smtpmail-mail-address)
-		       (fullname (user-full-name)))
-		  (cond ((eq mail-from-style 'angles)
-			 (insert "From: " fullname)
-			 (let ((fullname-start (+ (point-min) 6))
-			       (fullname-end (point-marker)))
-			   (goto-char fullname-start)
-			   ;; Look for a character that cannot appear unquoted
-			   ;; according to RFC 822.
-			   (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
-						  fullname-end 1)
-			       (progn
-				 ;; Quote fullname, escaping specials.
-				 (goto-char fullname-start)
-				 (insert "\"")
-				 (while (re-search-forward "[\"\\]"
-							   fullname-end 1)
-				   (replace-match "\\\\\\&" t))
-				 (insert "\""))))
-			 (insert " <" login ">\n"))
-			((eq mail-from-style 'parens)
-			 (insert "From: " login " (")
-			 (let ((fullname-start (point)))
-			   (insert fullname)
-			   (let ((fullname-end (point-marker)))
-			     (goto-char fullname-start)
-			     ;; RFC 822 says \ and nonmatching parentheses
-			     ;; must be escaped in comments.
-			     ;; Escape every instance of ()\ ...
-			     (while (re-search-forward "[()\\]" fullname-end 1)
-			       (replace-match "\\\\\\&" t))
-			     ;; ... then undo escaping of matching parentheses,
-			     ;; including matching nested parentheses.
-			     (goto-char fullname-start)
-			     (while (re-search-forward
-				     "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
-				     fullname-end 1)
-			       (replace-match "\\1(\\3)" t)
-			       (goto-char fullname-start))))
-			 (insert ")\n"))
-			((null mail-from-style)
-			 (insert "From: " login "\n")))))
-	    ;; Insert a `Message-Id:' field if there isn't one yet.
-	    (goto-char (point-min))
-	    (unless (re-search-forward "^Message-Id:" delimline t)
-	      (insert "Message-Id: " (message-make-message-id) "\n"))
-	    ;; Insert a `Date:' field if there isn't one yet.
-	    (goto-char (point-min))
-	    (unless (re-search-forward "^Date:" delimline t)
-	      (insert "Date: " (message-make-date) "\n"))
-	    ;; Insert an extra newline if we need it to work around
-	    ;; Sun's bug that swallows newlines.
-	    (goto-char (1+ delimline))
-	    (if (eval mail-mailer-swallows-blank-line)
-		(newline))
-	    ;; Find and handle any FCC fields.
-	    (goto-char (point-min))
-	    (if (re-search-forward "^FCC:" delimline t)
-		(mail-do-fcc delimline))
-	    (if mail-interactive
-		(with-current-buffer errbuf
-		  (erase-buffer))))
-	  ;;
-	  ;;
-	  ;;
-	  (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
-	  (setq smtpmail-recipient-address-list
-		    (smtpmail-deduce-address-list tembuf (point-min) delimline))
-	  (kill-buffer smtpmail-address-buffer)
-
-	  ;; XEmacs change
-	  (mail-check-safe-charset)
-
-	  (smtpmail-do-bcc delimline)
-	  ; Send or queue
-	  (if (not smtpmail-queue-mail)
-	      (if (not (null smtpmail-recipient-address-list))
-		  (if (not (smtpmail-via-smtp
-			    smtpmail-recipient-address-list tembuf))
-		      (error "Sending failed; SMTP protocol error"))
-		(error "Sending failed; no recipients"))
-	    (let* ((file-data
-		    (expand-file-name
-		     (format "%s_%i"
-			     (format-time-string "%Y-%m-%d_%H:%M:%S")
-			     (setq smtpmail-queue-counter
-				   (1+ smtpmail-queue-counter)))
-		     smtpmail-queue-dir))
-		   (file-data (convert-standard-filename file-data))
-		   (file-elisp (concat file-data ".el"))
-		   (buffer-data (create-file-buffer file-data))
-		   (buffer-elisp (create-file-buffer file-elisp))
-		   (buffer-scratch "*queue-mail*"))
-	      (unless (file-exists-p smtpmail-queue-dir)
-		(make-directory smtpmail-queue-dir t))
-	      (with-current-buffer buffer-data
-		(erase-buffer)
-		(insert-buffer-substring tembuf)
-		(write-file file-data)
-		(set-buffer buffer-elisp)
-		(erase-buffer)
-		(insert (concat
-			 "(setq smtpmail-recipient-address-list '"
-			 (prin1-to-string smtpmail-recipient-address-list)
-			 ")\n"))
-		(write-file file-elisp)
-		(set-buffer (generate-new-buffer buffer-scratch))
-		(insert (concat file-data "\n"))
-		(append-to-file (point-min)
-				(point-max)
-				smtpmail-queue-index)
-		)
-	      (kill-buffer buffer-scratch)
-	      (kill-buffer buffer-data)
-	      (kill-buffer buffer-elisp))))
-      (kill-buffer tembuf)
-      (if (bufferp errbuf)
-	  (kill-buffer errbuf)))))
-
-;;;###autoload
-(defun smtpmail-send-queued-mail ()
-  "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
-  (interactive)
-  (with-temp-buffer
-    ;;; Get index, get first mail, send it, update index, get second
-    ;;; mail, send it, etc...
-    (let ((file-msg ""))
-      (insert-file-contents smtpmail-queue-index)
-      (goto-char (point-min))
-      (while (not (eobp))
-	(setq file-msg (buffer-substring (point) (line-end-position)))
-	(load file-msg)
-	;; Insert the message literally: it is already encoded as per
-	;; the MIME headers, and code conversions might guess the
-	;; encoding wrongly.
-	(with-temp-buffer
-	  (let ((coding-system-for-read 'binary)) ;; XEmacs
-	    (insert-file-contents file-msg))
-          (let ((smtpmail-mail-address
-                 (or (and mail-specify-envelope-from (mail-envelope-from))
-                     (user-mail-address)))) ;; XEmacs
-            (if (not (null smtpmail-recipient-address-list))
-                (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
-                                            (current-buffer)))
-                    (error "Sending failed; SMTP protocol error"))
-              (error "Sending failed; no recipients"))))
-	(delete-file file-msg)
-	(delete-file (concat file-msg ".el"))
-	(delete-region (point-at-bol) (point-at-bol 2)))
-      (write-region (point-min) (point-max) smtpmail-queue-index))))
-
-;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
-
-(defun smtpmail-fqdn ()
-  (if smtpmail-local-domain
-      (concat (system-name) "." smtpmail-local-domain)
-    (system-name)))
-
-(defsubst smtpmail-cred-server (cred)
-  (nth 0 cred))
-
-(defsubst smtpmail-cred-port (cred)
-  (nth 1 cred))
-
-(defsubst smtpmail-cred-key (cred)
-  (nth 2 cred))
-
-(defsubst smtpmail-cred-user (cred)
-  (nth 2 cred))
-
-(defsubst smtpmail-cred-cert (cred)
-  (nth 3 cred))
-
-(defsubst smtpmail-cred-passwd (cred)
-  (nth 3 cred))
-
-(defun smtpmail-find-credentials (cred server port)
-  (catch 'done
-    (let ((l cred) el)
-      (while (setq el (pop l))
-	(when (and (equal server (smtpmail-cred-server el))
-		   (equal port (smtpmail-cred-port el)))
-	  (throw 'done el))))))
-
-(defun smtpmail-maybe-append-domain (recipient)
-  (if (or (not smtpmail-sendto-domain)
-	  (string-match "@" recipient))
-      recipient
-    (concat recipient "@" smtpmail-sendto-domain)))
-
-(defun smtpmail-intersection (list1 list2)
-  (let ((result nil))
-    (dolist (el2 list2)
-      (when (memq el2 list1)
-	(push el2 result)))
-    (nreverse result)))
-
-(defvar starttls-extra-args)
-(defvar starttls-extra-arguments)
-
-(defun smtpmail-open-stream (process-buffer host port)
-  (let ((cred (smtpmail-find-credentials
-	       smtpmail-starttls-credentials host port)))
-    (if (null (and cred (condition-case ()
-			    (with-no-warnings
-			      (require 'starttls)
-			      (call-process (if starttls-use-gnutls
-						starttls-gnutls-program
-					      starttls-program)))
-			  (error nil))))
-	;; The normal case.
-	(open-network-stream "SMTP" process-buffer host port)
-      (let* ((cred-key (smtpmail-cred-key cred))
-	     (cred-cert (smtpmail-cred-cert cred))
-	     (starttls-extra-args
-	      (append
-	       starttls-extra-args
-	       (when (and (stringp cred-key) (stringp cred-cert)
-			  (file-regular-p
-			   (setq cred-key (expand-file-name cred-key)))
-			  (file-regular-p
-			   (setq cred-cert (expand-file-name cred-cert))))
-		 (list "--key-file" cred-key "--cert-file" cred-cert))))
-	     (starttls-extra-arguments
-	      (append
-	       starttls-extra-arguments
-	       (when (and (stringp cred-key) (stringp cred-cert)
-			  (file-regular-p
-			   (setq cred-key (expand-file-name cred-key)))
-			  (file-regular-p
-			   (setq cred-cert (expand-file-name cred-cert))))
-		 (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
-	(starttls-open-stream "SMTP" process-buffer host port)))))
-
-(defun smtpmail-try-auth-methods (process supported-extensions host port)
-  (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
-	 (mech (car (smtpmail-intersection smtpmail-auth-supported mechs)))
-	 (cred (if (stringp smtpmail-auth-credentials)
-		   (let* ((netrc (netrc-parse smtpmail-auth-credentials))
-                          (port-name (format "%s" (or port "smtp")))
-			  (hostentry (netrc-machine netrc host port-name
-                                                    port-name)))
-                     (when hostentry
-                       (list host port
-                             (netrc-get hostentry "login")
-                             (netrc-get hostentry "password"))))
-		 (smtpmail-find-credentials
-		  smtpmail-auth-credentials host port)))
-	 (passwd (when cred
-		   (or (smtpmail-cred-passwd cred)
-		       (read-passwd
-			(format "SMTP password for %s:%s: "
-				(smtpmail-cred-server cred)
-				(smtpmail-cred-port cred))))))
-	 ret)
-    (when (and cred mech)
-      (cond
-       ((eq mech 'cram-md5)
-	(smtpmail-send-command process (upcase (format "AUTH %s" mech)))
-	(if (or (null (car (setq ret (smtpmail-read-response process))))
-		(not (integerp (car ret)))
-		(>= (car ret) 400))
-	    (throw 'done nil))
-	(when (eq (car ret) 334)
-	  (let* ((challenge (substring (cadr ret) 4))
-		 (decoded (base64-decode-string challenge))
-		 (hash (rfc2104-hash 'md5 64 16 passwd decoded))
-		 (response (concat (smtpmail-cred-user cred) " " hash))
-		 (encoded (base64-encode-string response)))
-	    (smtpmail-send-command process (format "%s" encoded))
-	    (if (or (null (car (setq ret (smtpmail-read-response process))))
-		    (not (integerp (car ret)))
-		    (>= (car ret) 400))
-		(throw 'done nil)))))
-       ((eq mech 'login)
-	(smtpmail-send-command process "AUTH LOGIN")
-	(if (or (null (car (setq ret (smtpmail-read-response process))))
-		(not (integerp (car ret)))
-		(>= (car ret) 400))
-	    (throw 'done nil))
-	(smtpmail-send-command
-	 process (base64-encode-string (smtpmail-cred-user cred)))
-	(if (or (null (car (setq ret (smtpmail-read-response process))))
-		(not (integerp (car ret)))
-		(>= (car ret) 400))
-	    (throw 'done nil))
-	(smtpmail-send-command process (base64-encode-string passwd))
-	(if (or (null (car (setq ret (smtpmail-read-response process))))
-		(not (integerp (car ret)))
-		(>= (car ret) 400))
-	    (throw 'done nil)))
-       ((eq mech 'plain)
-	;; We used to send an empty initial request, and wait for an
-	;; empty response, and then send the password, but this
-	;; violate a SHOULD in RFC 2222 paragraph 5.1.  Note that this
-	;; is not sent if the server did not advertise AUTH PLAIN in
-	;; the EHLO response.  See RFC 2554 for more info.
-	(smtpmail-send-command process
-			       (concat "AUTH PLAIN "
-				       (base64-encode-string
-					(concat "\0"
-						(smtpmail-cred-user cred)
-						"\0"
-						passwd))))
-	(if (or (null (car (setq ret (smtpmail-read-response process))))
-		(not (integerp (car ret)))
-		(not (equal (car ret) 235)))
-	    (throw 'done nil)))
-
-       (t
-	(error "Mechanism %s not implemented" mech)))
-      ;; Remember the password.
-      (when (and (not (stringp smtpmail-auth-credentials))
-		 (null (smtpmail-cred-passwd cred)))
-	(setcar (cdr (cdr (cdr cred))) passwd)))))
-
-(defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
-  (let ((process nil)
-	(host (or smtpmail-smtp-server
-		  (error "`smtpmail-smtp-server' not defined")))
-	(port smtpmail-smtp-service)
-        ;; smtpmail-mail-address should be set to the appropriate
-        ;; buffer-local value by the caller, but in case not:
-        (envelope-from (or smtpmail-mail-address
-                           (and mail-specify-envelope-from
-                                (mail-envelope-from))
-                           (user-mail-address))) ;; XEmacs
-	response-code
-	greeting
-	process-buffer
-	(supported-extensions '()))
-    (unwind-protect
-	(catch 'done
-	  ;; get or create the trace buffer
-	  (setq process-buffer
-		(get-buffer-create (format "*trace of SMTP session to %s*" host)))
-
-	  ;; clear the trace buffer of old output
-	  (with-current-buffer process-buffer
-	    (setq buffer-undo-list t)
-	    (erase-buffer))
-
-	  ;; open the connection to the server
-	  (setq process (smtpmail-open-stream process-buffer host port))
-	  (and (null process) (throw 'done nil))
-
-	  ;; set the send-filter
-	  (set-process-filter process 'smtpmail-process-filter)
-
-	  (with-current-buffer process-buffer
-	    ;; XEmacs change
-	    (if (or (featurep 'mule) (featurep 'file-coding))
-		(set-process-coding-system process 'no-conversion-unix 'no-conversion-unix))
-	    (make-local-variable 'smtpmail-read-point)
-	    (setq smtpmail-read-point (point-min))
-
-
-	    (if (or (null (car (setq greeting (smtpmail-read-response process))))
-		    (not (integerp (car greeting)))
-		    (>= (car greeting) 400))
-		(throw 'done nil)
-	      )
-
-	    (let ((do-ehlo t)
-		  (do-starttls t))
-	      (while do-ehlo
-	    ;; EHLO
-	    (smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn)))
-
-	    (if (or (null (car (setq response-code
-				     (smtpmail-read-response process))))
-		    (not (integerp (car response-code)))
-		    (>= (car response-code) 400))
-		(progn
-		  ;; HELO
-		  (smtpmail-send-command
-		   process (format "HELO %s" (smtpmail-fqdn)))
-
-		  (if (or (null (car (setq response-code
-					   (smtpmail-read-response process))))
-			  (not (integerp (car response-code)))
-			  (>= (car response-code) 400))
-		      (throw 'done nil)))
-	      (dolist (line (cdr (cdr response-code)))
-		(let ((name (mapcar (lambda (s) (intern (downcase s)))
-				    (split-string (substring line 4) "[ ]"))))
-		  (and (eq (length name) 1)
-		       (setq name (car name)))
-		    (and name
-		       (cond ((memq (if (consp name) (car name) name)
-				    '(verb xvrb 8bitmime onex xone
-						  expn size dsn etrn
-				      enhancedstatuscodes
-				      help xusr
-				      auth=login auth starttls))
-				(setq supported-extensions
-				      (cons name supported-extensions)))
-			       (smtpmail-warn-about-unknown-extensions
-			      (message "Unknown extension %s" name)))))))
-
-	    (if (and do-starttls
-		     (smtpmail-find-credentials smtpmail-starttls-credentials host port)
-		     (member 'starttls supported-extensions)
-		     (numberp (process-id process)))
-		(progn
-		  (smtpmail-send-command process (format "STARTTLS"))
-		  (if (or (null (car (setq response-code (smtpmail-read-response process))))
-			  (not (integerp (car response-code)))
-			  (>= (car response-code) 400))
-		      (throw 'done nil))
-		  (starttls-negotiate process)
-		  (setq do-starttls nil))
-	      (setq do-ehlo nil))))
-
-	    (smtpmail-try-auth-methods process supported-extensions host port)
-
-	    (if (or (member 'onex supported-extensions)
-		    (member 'xone supported-extensions))
-		(progn
-		  (smtpmail-send-command process (format "ONEX"))
-		  (if (or (null (car (setq response-code (smtpmail-read-response process))))
-			  (not (integerp (car response-code)))
-			  (>= (car response-code) 400))
-		      (throw 'done nil))))
-
-	    (if (and smtpmail-debug-verb
-		     (or (member 'verb supported-extensions)
-			 (member 'xvrb supported-extensions)))
-		(progn
-		  (smtpmail-send-command process (format "VERB"))
-		  (if (or (null (car (setq response-code (smtpmail-read-response process))))
-			  (not (integerp (car response-code)))
-			  (>= (car response-code) 400))
-		      (throw 'done nil))))
-
-	    (if (member 'xusr supported-extensions)
-		(progn
-		  (smtpmail-send-command process (format "XUSR"))
-		  (if (or (null (car (setq response-code (smtpmail-read-response process))))
-			  (not (integerp (car response-code)))
-			  (>= (car response-code) 400))
-		      (throw 'done nil))))
-
-	    ;; MAIL FROM:
-	    (let ((size-part
-		   (if (or (member 'size supported-extensions)
-			   (assoc 'size supported-extensions))
-		       (format " SIZE=%d"
-			       (with-current-buffer smtpmail-text-buffer
-				 ;; size estimate:
-				 (+ (- (point-max) (point-min))
-				    ;; Add one byte for each change-of-line
-				    ;; because of CR-LF representation:
-				    (count-lines (point-min) (point-max)))))
-		     ""))
-		  (body-part
-		   (if (member '8bitmime supported-extensions)
-		       ;; FIXME:
-		       ;; Code should be added here that transforms
-		       ;; the contents of the message buffer into
-		       ;; something the receiving SMTP can handle.
-		       ;; For a receiver that supports 8BITMIME, this
-		       ;; may mean converting BINARY to BASE64, or
-		       ;; adding Content-Transfer-Encoding and the
-		       ;; other MIME headers.  The code should also
-		       ;; return an indication of what encoding the
-		       ;; message buffer is now, i.e. ASCII or
-		       ;; 8BITMIME.
-		       (if nil
-			   " BODY=8BITMIME"
-			 "")
-		     "")))
-;	      (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
-	      (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
-                                                     envelope-from
-						     size-part
-						     body-part))
-
-	      (if (or (null (car (setq response-code (smtpmail-read-response process))))
-		      (not (integerp (car response-code)))
-		      (>= (car response-code) 400))
-		  (throw 'done nil)
-		))
-
-	    ;; RCPT TO:
-	    (let ((n 0))
-	      (while (not (null (nth n recipient)))
-		(smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient))))
-		(setq n (1+ n))
-
-		(setq response-code (smtpmail-read-response process))
-		(if (or (null (car response-code))
-			(not (integerp (car response-code)))
-			(>= (car response-code) 400))
-		    (throw 'done nil)
-		  )
-		))
-
-	    ;; DATA
-	    (smtpmail-send-command process "DATA")
-
-	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
-		    (not (integerp (car response-code)))
-		    (>= (car response-code) 400))
-		(throw 'done nil)
-	      )
-
-	    ;; Mail contents
-	    (smtpmail-send-data process smtpmail-text-buffer)
-
-	    ;;DATA end "."
-	    (smtpmail-send-command process ".")
-
-	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
-		    (not (integerp (car response-code)))
-		    (>= (car response-code) 400))
-		(throw 'done nil)
-	      )
-
-	    ;;QUIT
-;	    (smtpmail-send-command process "QUIT")
-;	    (and (null (car (smtpmail-read-response process)))
-;		 (throw 'done nil))
-	    t ))
-      (if process
-	  (with-current-buffer (process-buffer process)
-	    (smtpmail-send-command process "QUIT")
-	    (smtpmail-read-response process)
-
-;	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
-;		    (not (integerp (car response-code)))
-;		    (>= (car response-code) 400))
-;		(throw 'done nil)
-;	      )
-	    (delete-process process)
-	    (unless smtpmail-debug-info
-	      (kill-buffer process-buffer)))))))
-
-
-(defun smtpmail-process-filter (process output)
-  (with-current-buffer (process-buffer process)
-    (goto-char (point-max))
-    (insert output)))
-
-(defun smtpmail-read-response (process)
-  (let ((case-fold-search nil)
-	(response-strings nil)
-	(response-continue t)
-	(return-value '(nil ()))
-	match-end)
-    (catch 'done
-      (while response-continue
-	(goto-char smtpmail-read-point)
-	(while (not (search-forward "\r\n" nil t))
-	  (unless (memq (process-status process) '(open run))
-	    (throw 'done nil))
-	  (accept-process-output process)
-	  (goto-char smtpmail-read-point))
-
-	(setq match-end (point))
-	(setq response-strings
-	      (cons (buffer-substring smtpmail-read-point (- match-end 2))
-		    response-strings))
-
-	(goto-char smtpmail-read-point)
-	(if (looking-at "[0-9]+ ")
-	    (let ((begin (match-beginning 0))
-		  (end (match-end 0)))
-	      (if smtpmail-debug-info
-		  (message "%s" (car response-strings)))
-
-	      (setq smtpmail-read-point match-end)
-
-	      ;; ignore lines that start with "0"
-	      (if (looking-at "0[0-9]+ ")
-		  nil
-		(setq response-continue nil)
-		(setq return-value
-		      (cons (string-to-number
-			     (buffer-substring begin end))
-			    (nreverse response-strings)))))
-
-	  (if (looking-at "[0-9]+-")
-	      (progn (if smtpmail-debug-info
-			 (message "%s" (car response-strings)))
-		     (setq smtpmail-read-point match-end)
-		     (setq response-continue t))
-	    (progn
-	      (setq smtpmail-read-point match-end)
-	      (setq response-continue nil)
-	      (setq return-value
-		    (cons nil (nreverse response-strings)))))))
-      (setq smtpmail-read-point match-end))
-    return-value))
-
-
-(defun smtpmail-send-command (process command)
-  (goto-char (point-max))
-  (if (= (aref command 0) ?P)
-      (insert "PASS \r\n")
-    (insert command "\r\n"))
-  (setq smtpmail-read-point (point))
-  (process-send-string process command)
-  (process-send-string process "\r\n"))
-
-(defun smtpmail-send-data-1 (process data)
-  (goto-char (point-max))
-
-  ;; XEmacs change
-  (if (and (or (featurep 'mule) (featurep 'file-coding))
-	   (not (null smtpmail-code-conv-from)))
-      (setq data (encode-coding-string data smtpmail-code-conv-from)))
-
-  (if smtpmail-debug-info
-      (insert data "\r\n"))
-
-  (setq smtpmail-read-point (point))
-  ;; Escape "." at start of a line
-  (if (eq (string-to-char data) ?.)
-      (process-send-string process "."))
-  (process-send-string process data)
-  (process-send-string process "\r\n")
-  )
-
-(defun smtpmail-send-data (process buffer)
-  (let ((data-continue t) sending-data)
-    (with-current-buffer buffer
-      (goto-char (point-min)))
-    (while data-continue
-      (with-current-buffer buffer
-        (setq sending-data (buffer-substring (point-at-bol) (point-at-eol)))
-	(end-of-line 2)
-        (setq data-continue (not (eobp))))
-      (smtpmail-send-data-1 process sending-data))))
-
-(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
-  "Get address list suitable for smtp RCPT TO: 
."
-  (unwind-protect
-      (with-current-buffer smtpmail-address-buffer
-	(erase-buffer)
-	(let
-	    ((case-fold-search t)
-	     (simple-address-list "")
-	     this-line
-	     this-line-end
-	     addr-regexp)
-	  (insert-buffer-substring smtpmail-text-buffer header-start header-end)
-	  (goto-char (point-min))
-	  ;; RESENT-* fields should stop processing of regular fields.
-	  (save-excursion
-	    (setq addr-regexp
-		  (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):"
-					 header-end t)
-		      "^Resent-\\(to\\|cc\\|bcc\\):"
-		    "^\\(To:\\|Cc:\\|Bcc:\\)")))
-
-	  (while (re-search-forward addr-regexp header-end t)
-	    (replace-match "")
-	    (setq this-line (match-beginning 0))
-	    (forward-line 1)
-	    ;; get any continuation lines
-	    (while (and (looking-at "^[ \t]+") (< (point) header-end))
-	      (forward-line 1))
-	    (setq this-line-end (point-marker))
-	    (setq simple-address-list
-		  (concat simple-address-list " "
-			  (mail-strip-quoted-names (buffer-substring this-line this-line-end))))
-	    )
-	  (erase-buffer)
-	  (insert " " simple-address-list "\n")
-	  (subst-char-in-region (point-min) (point-max) 10 ?  t);; newline --> blank
-	  (subst-char-in-region (point-min) (point-max) ?, ?  t);; comma   --> blank
-	  (subst-char-in-region (point-min) (point-max)  9 ?  t);; tab     --> blank
-
-	  (goto-char (point-min))
-	  ;; tidyness in case hook is not robust when it looks at this
-	  (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
-
-	  (goto-char (point-min))
-	  (let (recipient-address-list)
-	    (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
-	      (backward-char 1)
-	      (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1))
-						 recipient-address-list))
-	      )
-	    (setq smtpmail-recipient-address-list recipient-address-list))
-
-	  )
-	)
-    )
-  )
-
-
-(defun smtpmail-do-bcc (header-end)
-  "Delete [Resent-]BCC: and their continuation lines from the header area.
-There may be multiple BCC: lines, and each may have arbitrarily
-many continuation lines."
-  (let ((case-fold-search t))
-    (save-excursion
-      (goto-char (point-min))
-      ;; iterate over all BCC: lines
-      (while (re-search-forward "^\\(RESENT-\\)?BCC:" header-end t)
-	(delete-region (match-beginning 0)
-		       (progn (forward-line 1) (point)))
-	;; get rid of any continuation lines
-	(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
-	  (replace-match ""))))))
-
-
-(provide 'smtpmail)
-
-;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
-;;; smtpmail.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/starttls.el b/xemacs-packages/lisp/mail-lib/starttls.el
deleted file mode 100644
index 022035f3..00000000
--- a/xemacs-packages/lisp/mail-lib/starttls.el
+++ /dev/null
@@ -1,296 +0,0 @@
-;;; starttls.el --- STARTTLS functions
-
-;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno 
-;; Author: Simon Josefsson 
-;; Created: 1999/11/20
-;; Keywords: TLS, SSL, OpenSSL, GNUTLS, mail, news
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; 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 module defines some utility functions for STARTTLS profiles.
-
-;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP"
-;;	by Chris Newman  (1999/06)
-
-;; This file now contains a combination of the two previous
-;; implementations both called "starttls.el".  The first one is Daiki
-;; Ueno's starttls.el which uses his own "starttls" command line tool,
-;; and the second one is Simon Josefsson's starttls.el which uses
-;; "gnutls-cli" from GNUTLS.
-;;
-;; If "starttls" is available, it is prefered by the code over
-;; "gnutls-cli", for backwards compatibility.  Use
-;; `starttls-use-gnutls' to toggle between implementations if you have
-;; both tools installed.  It is recommended to use GNUTLS, though, as
-;; it performs more verification of the certificates.
-
-;; The GNUTLS support requires GNUTLS 0.9.90 (released 2003-10-08) or
-;; later, from , or "starttls"
-;; from .
-
-;; Usage is similar to `open-network-stream'.  For example:
-;;
-;; (when (setq tmp (starttls-open-stream
-;;			"test" (current-buffer) "yxa.extundo.com" 25))
-;;   (accept-process-output tmp 15)
-;;   (process-send-string tmp "STARTTLS\n")
-;;   (accept-process-output tmp 15)
-;;   (message "STARTTLS output:\n%s" (starttls-negotiate tmp))
-;;   (process-send-string tmp "EHLO foo\n"))
-
-;; An example run yields the following output:
-;;
-;; 220 yxa.extundo.com ESMTP Sendmail 8.12.11/8.12.11/Debian-3; Wed, 26 May 2004 19:12:29 +0200; (No UCE/UBE) logging access from: c494102a.s-bi.bostream.se(OK)-c494102a.s-bi.bostream.se [217.215.27.65]
-;; 220 2.0.0 Ready to start TLS
-;; 250-yxa.extundo.com Hello c494102a.s-bi.bostream.se [217.215.27.65], pleased to meet you
-;; 250-ENHANCEDSTATUSCODES
-;; 250-PIPELINING
-;; 250-EXPN
-;; 250-VERB
-;; 250-8BITMIME
-;; 250-SIZE
-;; 250-DSN
-;; 250-ETRN
-;; 250-AUTH DIGEST-MD5 CRAM-MD5 PLAIN LOGIN
-;; 250-DELIVERBY
-;; 250 HELP
-;; nil
-;;
-;; With the message buffer containing:
-;;
-;; STARTTLS output:
-;; *** Starting TLS handshake
-;; - Server's trusted authorities:
-;;    [0]: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
-;; - Certificate type: X.509
-;;  - Got a certificate list of 2 certificates.
-;;
-;;  - Certificate[0] info:
-;;  # The hostname in the certificate matches 'yxa.extundo.com'.
-;;  # valid since: Wed May 26 12:16:00 CEST 2004
-;;  # expires at: Wed Jul 26 12:16:00 CEST 2023
-;;  # serial number: 04
-;;  # fingerprint: 7c 04 4b c1 fa 26 9b 5d 90 22 52 3c 65 3d 85 3a
-;;  # version: #1
-;;  # public key algorithm: RSA
-;;  #   Modulus: 1024 bits
-;;  # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=Mail server,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
-;;  # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
-;;
-;;  - Certificate[1] info:
-;;  # valid since: Sun May 23 11:35:00 CEST 2004
-;;  # expires at: Sun Jul 23 11:35:00 CEST 2023
-;;  # serial number: 00
-;;  # fingerprint: fc 76 d8 63 1a c9 0b 3b fa 40 fe ed 47 7a 58 ae
-;;  # version: #3
-;;  # public key algorithm: RSA
-;;  #   Modulus: 1024 bits
-;;  # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
-;;  # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com
-;;
-;; - Peer's certificate issuer is unknown
-;; - Peer's certificate is NOT trusted
-;; - Version: TLS 1.0
-;; - Key Exchange: RSA
-;; - Cipher: ARCFOUR 128
-;; - MAC: SHA
-;; - Compression: NULL
-
-;;; Code:
-
-(defgroup starttls nil
-  "Support for `Transport Layer Security' protocol."
-  :version "21.1"
-  :group 'mail)
-
-(defcustom starttls-gnutls-program "gnutls-cli"
-  "Name of GNUTLS command line tool.
-This program is used when GNUTLS is used, i.e. when
-`starttls-use-gnutls' is non-nil."
-  :type 'string
-  :group 'starttls)
-
-(defcustom starttls-program "starttls"
-  "The program to run in a subprocess to open an TLSv1 connection.
-This program is used when the `starttls' command is used,
-i.e. when `starttls-use-gnutls' is nil."
-  :type 'string
-  :group 'starttls)
-
-(defcustom starttls-use-gnutls (not (executable-find starttls-program))
-  "*Whether to use GNUTLS instead of the `starttls' command."
-  :type 'boolean
-  :group 'starttls)
-
-(defcustom starttls-extra-args nil
-  "Extra arguments to `starttls-program'.
-These apply when the `starttls' command is used, i.e. when
-`starttls-use-gnutls' is nil."
-  :type '(repeat string)
-  :group 'starttls)
-
-(defcustom starttls-extra-arguments nil
-  "Extra arguments to `starttls-program'.
-These apply when GNUTLS is used, i.e. when `starttls-use-gnutls' is non-nil.
-
-For example, non-TLS compliant servers may require
-'(\"--protocols\" \"ssl3\").  Invoke \"gnutls-cli --help\" to
-find out which parameters are available."
-  :type '(repeat string)
-  :group 'starttls)
-
-(defcustom starttls-process-connection-type nil
-  "*Value for `process-connection-type' to use when starting STARTTLS process."
-  :type 'boolean
-  :group 'starttls)
-
-(defcustom starttls-connect "- Simple Client Mode:\n\n"
-  "*Regular expression indicating successful connection.
-The default is what GNUTLS's \"gnutls-cli\" outputs."
-  ;; GNUTLS cli.c:main() prints this string when it is starting to run
-  ;; in the application read/write phase.  If the logic, or the string
-  ;; itself, is modified, this must be updated.
-  :type 'regexp
-  :group 'starttls)
-
-(defcustom starttls-failure "\\*\\*\\* Handshake has failed"
-  "*Regular expression indicating failed TLS handshake.
-The default is what GNUTLS's \"gnutls-cli\" outputs."
-  ;; GNUTLS cli.c:do_handshake() prints this string on failure.  If the
-  ;; logic, or the string itself, is modified, this must be updated.
-  :type 'regexp
-  :group 'starttls)
-
-(defcustom starttls-success "- Compression: "
-  "*Regular expression indicating completed TLS handshakes.
-The default is what GNUTLS's \"gnutls-cli\" outputs."
-  ;; GNUTLS cli.c:do_handshake() calls, on success,
-  ;; common.c:print_info(), that unconditionally print this string
-  ;; last.  If that logic, or the string itself, is modified, this
-  ;; must be updated.
-  :type 'regexp
-  :group 'starttls)
-
-(defun starttls-negotiate-gnutls (process)
-  "Negotiate TLS on PROCESS opened by `open-starttls-stream'.
-This should typically only be done once.  It typically returns a
-multi-line informational message with information about the
-handshake, or nil on failure."
-  (let (buffer info old-max done-ok done-bad)
-    (if (null (setq buffer (process-buffer process)))
-	;; XXX How to remove/extract the TLS negotiation junk?
-	(signal-process (process-id process) 'SIGALRM)
-      (with-current-buffer buffer
-	(save-excursion
-	  (setq old-max (goto-char (point-max)))
-	  (signal-process (process-id process) 'SIGALRM)
-	  (while (and (processp process)
-		      (eq (process-status process) 'run)
-		      (save-excursion
-			(goto-char old-max)
-			(not (or (setq done-ok (re-search-forward
-						starttls-success nil t))
-				 (setq done-bad (re-search-forward
-						 starttls-failure nil t))))))
-	    (accept-process-output process 1 100)
-	    (sit-for 0.1))
-	  (setq info (buffer-substring-no-properties old-max (point-max)))
-	  (delete-region old-max (point-max))
-	  (if (or (and done-ok (not done-bad))
-		  ;; Prevent mitm that fake success msg after failure msg.
-		  (and done-ok done-bad (< done-ok done-bad)))
-	      info
-	    (message "STARTTLS negotiation failed: %s" info)
-	    nil))))))
-
-(defun starttls-negotiate (process)
-  (if starttls-use-gnutls
-      (starttls-negotiate-gnutls process)
-    (signal-process (process-id process) 'SIGALRM)))
-
-(eval-and-compile
-  (if (fboundp 'set-process-query-on-exit-flag)
-      (defalias 'starttls-set-process-query-on-exit-flag
-	'set-process-query-on-exit-flag)
-    (defalias 'starttls-set-process-query-on-exit-flag
-      'process-kill-without-query)))
-
-(defun starttls-open-stream-gnutls (name buffer host port)
-  (message "Opening STARTTLS connection to `%s'..." host)
-  (let* (done
-	 (old-max (with-current-buffer buffer (point-max)))
-	 (process-connection-type starttls-process-connection-type)
-	 (process (apply #'start-process name buffer
-			 starttls-gnutls-program "-s" host
-			 "-p" (if (integerp port)
-				  (int-to-string port)
-				port)
-			 starttls-extra-arguments)))
-    (starttls-set-process-query-on-exit-flag process nil)
-    (while (and (processp process)
-		(eq (process-status process) 'run)
-		(save-excursion
-		  (set-buffer buffer)
-		  (goto-char old-max)
-		  (not (setq done (re-search-forward
-				   starttls-connect nil t)))))
-      (accept-process-output process 0 100)
-      (sit-for 0.1))
-    (if done
-	(with-current-buffer buffer
-	  (delete-region old-max done))
-      (delete-process process)
-      (setq process nil))
-    (message "Opening STARTTLS connection to `%s'...%s"
-	     host (if done "done" "failed"))
-    process))
-
-(defun starttls-open-stream (name buffer host port)
-  "Open a TLS connection for a port to a host.
-Returns a subprocess object to represent the connection.
-Input and output work as for subprocesses; `delete-process' closes it.
-Args are NAME BUFFER HOST PORT.
-NAME is name for process.  It is modified if necessary to make it unique.
-BUFFER is the buffer (or `buffer-name') to associate with the process.
- Process output goes at end of that buffer, unless you specify
- an output stream or filter function to handle the output.
- BUFFER may be also nil, meaning that this process is not associated
- with any buffer
-Third arg is name of the host to connect to, or its IP address.
-Fourth arg PORT is an integer specifying a port to connect to.
-If `starttls-use-gnutls' is nil, this may also be a service name, but
-GNUTLS requires a port number."
-  (if starttls-use-gnutls
-      (starttls-open-stream-gnutls name buffer host port)
-    (let* ((process-connection-type starttls-process-connection-type)
-	   (process (apply #'start-process
-			   name buffer starttls-program
-			   host (format "%s" port)
-			   starttls-extra-args)))
-      (starttls-set-process-query-on-exit-flag process nil)
-      process)))
-
-(provide 'starttls)
-
-;;; arch-tag: 648b3bd8-63bd-47f5-904c-7c819aea2297
-;;; starttls.el ends here
diff --git a/xemacs-packages/lisp/mail-lib/tls.el b/xemacs-packages/lisp/mail-lib/tls.el
deleted file mode 100644
index c3eb5896..00000000
--- a/xemacs-packages/lisp/mail-lib/tls.el
+++ /dev/null
@@ -1,159 +0,0 @@
-;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson 
-;; Keywords: comm, tls, gnutls, ssl
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This package implements a simple wrapper around "gnutls-cli" to
-;; make Emacs support TLS/SSL.
-;;
-;; Usage is the same as `open-network-stream', i.e.:
-;;
-;; (setq tmp (open-tls-stream "test" (current-buffer) "news.mozilla.org" 563))
-;; ...
-;; #
-;; (process-send-string tmp "mode reader\n")
-;; 200 secnews.netscape.com Netscape-Collabra/3.52 03615 NNRP ready ...
-;; nil
-;; (process-send-string tmp "quit\n")
-;; 205
-;; nil
-
-;; To use this package as a replacement for ssl.el by William M. Perry
-;; , you need to evaluate the following:
-;;
-;; (defalias 'open-ssl-stream 'open-tls-stream)
-
-;;; Code:
-
-(eval-and-compile
-  (autoload 'format-spec "format-spec")
-  (autoload 'format-spec-make "format-spec"))
-
-(defgroup tls nil
-  "Transport Layer Security (TLS) parameters."
-  :group 'comm)
-
-(defcustom tls-program '("gnutls-cli -p %p %h"
-			 "gnutls-cli -p %p %h --protocols ssl3"
-			 "openssl s_client -connect %h:%p -no_ssl2")
-  "List of strings containing commands to start TLS stream to a host.
-Each entry in the list is tried until a connection is successful.
-%s is replaced with server hostname, %p with port to connect to.
-The program should read input on stdin and write output to
-stdout.  Also see `tls-success' for what the program should output
-after successful negotiation."
-  :type '(repeat string)
-  :group 'tls)
-
-(defcustom tls-process-connection-type nil
-  "*Value for `process-connection-type' to use when starting TLS process."
-  :type 'boolean
-  :group 'tls)
-
-(defcustom tls-success "- Handshake was completed\\|SSL handshake has read "
-  "*Regular expression indicating completed TLS handshakes.
-The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
-\"openssl s_client\" outputs."
-  :type 'regexp
-  :group 'tls)
-
-(defcustom tls-certtool-program (executable-find "certtool")
-  "Name of  GnuTLS certtool.
-Used by `tls-certificate-information'."
-  :type '(repeat string)
-  :group 'tls)
-
-(defun tls-certificate-information (der)
-  "Parse X.509 certificate in DER format into an assoc list."
-  (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
-			     (base64-encode-string der)
-			     "\n-----END CERTIFICATE-----\n"))
-	(exit-code 0))
-    (with-current-buffer (get-buffer-create " *certtool*")
-      (erase-buffer)
-      (insert certificate)
-      (setq exit-code (condition-case ()
-			  (call-process-region (point-min) (point-max)
-					       tls-certtool-program
-					       t (list (current-buffer) nil) t
-					       "--certificate-info")
-			(error -1)))
-      (if (/= exit-code 0)
-	  nil
-	(let ((vals nil))
-	  (goto-char (point-min))
-	  (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
-	    (push (cons (match-string 1) (match-string 2)) vals))
-	  (nreverse vals))))))
-
-(defun open-tls-stream (name buffer host port)
-  "Open a TLS connection for a port to a host.
-Returns a subprocess-object to represent the connection.
-Input and output work as for subprocesses; `delete-process' closes it.
-Args are NAME BUFFER HOST PORT.
-NAME is name for process.  It is modified if necessary to make it unique.
-BUFFER is the buffer (or buffer-name) to associate with the process.
- Process output goes at end of that buffer, unless you specify
- an output stream or filter function to handle the output.
- BUFFER may be also nil, meaning that this process is not associated
- with any buffer
-Third arg is name of the host to connect to, or its IP address.
-Fourth arg PORT is an integer specifying a port to connect to."
-  (let ((cmds tls-program) cmd done)
-    (message "Opening TLS connection to `%s'..." host)
-    (while (and (not done) (setq cmd (pop cmds)))
-      (message "Opening TLS connection with `%s'..." cmd)
-      (let* ((process-connection-type tls-process-connection-type)
-	     (process (start-process
-		       name buffer shell-file-name shell-command-switch
-		       (format-spec
-			cmd
-			(format-spec-make
-			 ?h host
-			 ?p (if (integerp port)
-				(int-to-string port)
-			      port)))))
-	     response)
-	(while (and process
-		    (memq (process-status process) '(open run))
-		    (save-excursion
-		      (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
-		      (goto-char (point-min))
-		      (not (setq done (re-search-forward tls-success nil t)))))
-	  (accept-process-output process 1)
-	  (sit-for 1))
-	(message "Opening TLS connection with `%s'...%s" cmd
-		 (if done "done" "failed"))
-	(if done
-	    (setq done process)
-	  (delete-process process))))
-    (message "Opening TLS connection to `%s'...%s"
-	     host (if done "done" "failed"))
-    done))
-
-(provide 'tls)
-
-;;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac
-;;; tls.el ends here
diff --git a/xemacs-packages/lisp/net-utils/ChangeLog b/xemacs-packages/lisp/net-utils/ChangeLog
deleted file mode 100644
index a15ab016..00000000
--- a/xemacs-packages/lisp/net-utils/ChangeLog
+++ /dev/null
@@ -1,469 +0,0 @@
-2005-10-12  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.48 released.
-
-2005-10-06  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.47 released.
-
-2005-10-01  Steve Youngs  
-
-	* xml.el (xml-parse-region):
-	* xml.el (xml-parse-tag):
-	Fix bug where an empty element written as  incorrectly has a
-	list of children.
-	From: David Aspinall 
-
-2005-05-01  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.46 released.
-
-2005-05-01  Steve Youngs  
-
-	* google-query.el (google-query-url-at-point): New.  Runs
-	`browse-url' without the need for `thing-at-point'.
-	(google-query-url-at-mouse): New.  As above, via a rat.
-	(google-query-map): Use them.
-	(google-query-kill-buffer): New.  Convenience function for killing
-	the results buffer without being asked confirmation.
-	(google-query-mode-map): New.  Keymap for results buffer.
-	(google-query-ext-map): New.  Keymap for extents in results
-	buffer.  Replaces `google-query-map'.
-	(google-query-map): Removed.
-	(google-query-make-url-extents): Use `google-query-ext-map'
-	instead of `google-query-map'.
-	(google-query-mode): New.  Major mode for results buffer.
-	(google-query-process-results): Use `google-query-mode' instead of
-	fooling around with electric help.
-	Tweak the code for filtering out all the useless crud that google
-	returns. 
-	Fill the results.
-
-2005-03-14  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.45 released.
-
-2005-03-13  Steve Youngs  
-
-	* dns-mode.el: New file.
-
-2004-09-29  Steve Youngs  
-
-	* Makefile (REQUIRES): Add ecrypto.
-	(MAINTAINER): Update my email address.
-
-2004-07-14  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.44 released.
-
-2004-06-10  Steve Youngs  
-
-	* mozmail.el: Add some comments about an alternative way to set
-	things up on GNOME.
-	From Juergen Kreileder 
-
-2004-05-19  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.43 released.
-
-2004-05-16  Steve Youngs  
-
-	* mozmail.el: Autoload `wl-draft' for wanderlust.
-	(mozmail-default-mua): Add Wanderlust.
-	(mozmail-compose-wanderlust): New.
-	Wanderlust additions are
-	From Markus Knittig 
-
-	(mozmail-split-url): Allow for incorrect case used in mailto link
-	keywords.
-
-	Update commentary section.
-
-2004-04-01  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.42 released.
-
-2004-04-01  Steve Youngs  
-
-	* mozmail.el: Remove an autoload.
-
-2004-04-01  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.41 released.
-
-2004-04-01  Steve Youngs  
-
-	* Makefile (REQUIRES): Add mh-e, mew.
-
-	* mozmail.el (mozmail-default-mua): New.
-	(mozmail-populate-headers): New.
-	(mozmail-compose-vm): New.
-	From Jeff Nye 
-	(mozmail-compose-mhe): New.
-	(mozmail-compose-mew): New.
-	(mozmail-compose-emacs): New.
-	(mozmail-compose-rmail): New.
-	(mozmail): Use `mozmail-compose' instead of
-	`mozmail-compose-gnus'. 
-
-	Update the file's commentary section.
-
-2004-03-31  Steve Youngs  
-
-	* mozmail.el (mozmail): New custom group.
-	(mozmail-gnus-is-plugged): New.
-	(mozmail-compose-gnus): Use it.
-
-2004-03-19  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.40 released.
-
-2004-03-19  Steve Youngs  
-
-	* mozmail.el: url-unhex-string is in url-util.el in the upstream
-	url package, but it is in url.el in the XEmacs W3 package.
-	Conditionalise the autoload.
-
-2004-03-19  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.39 released.
-
-2004-03-19  Steve Youngs  
-
-	* dns.el (dns-make-network-process): Use `open-network-stream'
-	instead of `gnus-xmas-open-network-stream'.
-	Don't require gnus-xmas.
-
-	* mozmail.el (mozmail-split-string): New.  For GNU/Emacs
-	compatibility. 
-	(mozmail-split-url): Use it.
-
-2004-01-04  Mario Lang  
-
-	* dns.el: Add support for AAAA records (see RFC 3596)
-	Fix typo PRT -> PTR
-	Parse MX, PTR and SOA replies (see RFC 1035)
-
-2004-01-12  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.38 released.
-
-2004-01-12  Steve Youngs  
-
-	* Makefile (REQUIRES): Add fsf-compat for browse-clt12.
-	(DONTCOMPILE): New.
-	(ELCS): Use it.
-
-2004-01-07  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.37 released.
-
-2004-01-07  Steve Youngs  
-
-	* google-query.el: Don't autoload `url-hexify-string'.
-	(google-query-unreserved-chars): New.
-	(google-query-hexify-string): New.
-	(google-query): Use it.
-	Remove eye-candy.
-
-	(google-query-result-count): New.
-	(google-query): Use it.
-	From Jeff Mincy 
-
-2004-01-05  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.36 released.
-
-2004-01-05  Steve Youngs  
-
-	* google-query.el: New.
-
-	* mozmail.el: New.
-
-	* package-info.in (provides): Add `google-query', `mozmail'.
-
-2003-12-03  Katsumi Yamaoka  
-
-	* dns.el: Fix misplaced eval-when-compile.
-
-2003-12-04  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.35 released.
-
-2003-12-03  Steve Youngs  
-
-	* xml.el: defalias `match-string-no-properties' to
-	`match-string'. 
-
-	* webster-www.el: Autoload `w3-form-encode-xwfu' at compile time.
-
-	* net-utils.el: Autoload `ffap-string-at-point' at compile time.
-
-	* feedmail.el: Require smtpmail at compile time.
-
-	* browse-cltl2.el (url-retrieve): Autoload it.
-
-	* Makefile (AUTHOR_VERSION): Set to N/A.
-	(MAINTAINER): Set to me.
-	(ELCS): Change to something a whole lot easier to maintain using
-	patsubst.
-	(REQUIRES): Remove fsf-compat, add vm.
-
-2003-11-29  Jerry James  
-
-	* dns.el: Autoloading 'gnus-xmacs-open-network-stream did not
-	work.  Require gnus-xmas when compiling instead.
-
-2003-11-18  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.34 released.
-
-2003-11-17  Steve Youngs  
-
-	* xemacsbug.el (report-xemacs-bug-packages-list): New.
-	(report-xemacs-bug): Use it.
-
-2003-10-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.33 released.
-
-2003-05-02  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.32 released.
-
-2003-05-02  Steve Youngs  
-
-	* dig.el: New.
-
-	* dns.el: New.
-
-	* xml.el: New.
-
-	* Makefile (ELCS): Add dig.elc, dns.elc, xml.elc.
-
-	* package-info.in (provides): Add dig, dns, xml.
-
-2003-03-09  Ben Wing  
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-
-2003-01-24  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.31 released.
-
-2003-01-23  Steve Youngs  
-
-	* xemacsbug.el (report-xemacs-bug-beta-extra-headers): Default to
-	nil. 
-	(report-xemacs-bug-hook): Remove code that converted non-ASCII
-	characters to hex.  As advised by Stephen Turnbull.
-
-2003-01-18  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.30 released.
-
-2003-01-16  Steve Youngs  
-
-	* xemacsbug.el (report-xemacs-bug): Prepend "[Bug:
-	emacs-program-version]" to subject header.
-	Move all the instructions and explanations into the "*Bug Help*"
-	buffer.
-	List loaded modules.
-	(report-xemacs-bug-help): New.
-	(report-xemacs-bug-hook): Use electric help.
-	Fix bug that was causing an error when searching for the Cc
-	header. 
-
-2003-01-13  Steve Youngs  
-
-	* xemacsbug.el (report-xemacs-bug): Different mail-user-agent's
-	have different hooks, add code to cater to this.
-	(report-xemacs-bug-hook): Ditto.
-	Don't put stuff in *Bug Help* buffer if
-	'report-xemacs-bug-no-explanations' is t.
-
-2003-01-12  Steve Youngs  
-
-	* xemacsbug.el (report-xemacs-bug-address): Put address in angled
-	brackets. 
-	(report-xemacs-bug-beta-address): Ditto.
-	(report-xemacs-bug-beta-extra-headers): Change Cc to my address.
-	(report-xemacs-bug): Update Instructions.
-
-2003-01-03  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.29 released.
-
-2002-12-17  Jerry James  
-
-	* Makefile (REQUIRES): Add bbdb and gnus to autoload macro
-	definitions, and rmail, tm, and apel to satisfy transitive
-	dependencies on gnus.
-	* feedmail.el: Require bbdb-com at compile time to define
-	the bbdb-search macro.
-
-2002-11-29  Ben Wing  
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15  Ville Skyttä  
-
-	* Makefile (srckit): Remove.
-
-2002-08-29  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.28 released.
-
-2002-08-27  Ville Skyttä  
-
-	* Makefile (REQUIRES): Add fsf-compat, eterm and sh-script,
-	they're indirectly required.
-
-2002-08-19  Steve Youngs  
-
-	* xemacsbug.el (report-xemacs-bug): Show the correct key bindings
-	for MH-e.
-
-2002-06-27  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.27 released.
-
-2002-06-26  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.26 released.
-
-	* net-utils.el: Remove $Log keyword and some of the entries that
-	are in the ChengeLog.
-
-2002-06-24  Adrian Aichner  
-
-	* net-utils.el (traceroute-program-options): Fix custom type
-	(repeat string).
-	* net-utils.el (ping-program-options): Ditto.
-	* net-utils.el (ipconfig-program-options): Ditto.
-	* net-utils.el (netstat-program-options): Ditto.
-	* net-utils.el (arp-program-options): Ditto.
-	* net-utils.el (route-program-options): Ditto.
-	* net-utils.el (nslookup-program-options): Ditto.
-	* net-utils.el (ftp-program-options): Ditto.
-
-2002-06-04  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.25 released.
-
-	* xemacsbug.el (report-xemacs-bug-extra-headers): New.
-	(report-xemacs-bug-beta-extra-headers): New.
-	(report-xemacs-bug): Use them.
-	Test whether using a beta XEmacs with 'xemacs-betaname'.
-
-2002-02-23  Steve Youngs  
-
-	* package-info.in (provides): Typo.
-
-2002-02-23  Peter Arius  
-
-	* shadowfile.el (shadow-write-info-file): Use 'buffer-live-p' to
-	check for killed buffers.
-	(shadow-write-todo-file): Ditto.
-	(shadow-save-todo-file): Ditto.
-
-2001-09-28  Stephen J. Turnbull  
-
-	* xemacsbug.el (report-emacs-bug):  Missing autoload.
-
-2001-08-22  Steve Youngs  
-
-	* xemacsbug.el (report-xemacs-bug): Use 'report-xemacs-bug-hook'
-	instead of 'report-emacs-bug-hook'.
-
-2001-08-15  Steve Youngs  
-
-	* xemacsbug.el (report-xemacs-bug): Include the load-path
-	shadows in the bug report. (Thanks to Adrian A. for help on this)
-
-2001-08-07  Steve Youngs  
-
-	* xemacsbug.el (report-xemacs-bug-send-init): New.
-	(report-xemacs-bug): Use it.
-
-2001-08-06  Steve Youngs  
-
-	* emacsbug.el: Removed.
-
-	* xemacsbug.el: New file, replaces the old 'emacsbug.el'.
-
-	* Makefile (ELCS): Remove emacsbug.elc and use xemacsbug.elc.
-
-2001-07-14  Steve Youngs  
-
-	* emacsbug.el (report-emacs-bug-address): Change address to
-	xemacs-beta@xemacs.org.
-
-2001-07-05  Adrian Aichner  
-
-	* webjump.el (webjump-sample-sites): Update webster site.
-
-2001-07-03  Stephen J. Turnbull  
-
-	* emacsbug.el(report-emacs-bug-address): Move comment closer.
-	Change to "xemacs-beta@cvs.xemacs.org" to improve response time.
-
-2001-05-12  Steve Youngs  
-
-	* feedmail.el: Sync with version 10.
-
-2001-01-09  Gunnar Evermann  
-
-	* emacsbug.el (report-emacs-bug-info): Jump to info node
-	"(xemacs)Bugs".
-	From Klaus Frank 
-
-2000-10-05  Martin Buchholz  
-
-	* *: Mega typo fix.
-
-1998-07-01  SL Baur  
-
-	* feedmail.el: synched with version 8.
-
-1998-05-18  Damon Lipparelli  
-
-	* metamail.el: (metamail-region): replace bogus use of `concat'.
-
-1998-06-01  SL Baur  
-
-	* browse-cltl2.el: Synch with v1.1.4.
-
-1998-04-05  Tomasz Cholewo  
-
-	* webster-www.el (webster-www-thesaurus): New function.
-
-1998-03-30  SL Baur  
-
-	* feedmail.el: Updated.
-
-1998-03-22  SL Baur  
-
-	* net-utils.el: Add autoload cookies for convenience.
-	(ping-program-options): It's system type 'linux in XEmacs.
-
-1998-03-10  SL Baur  
-
-	* webjump.el (webjump-sample-sites): Fix typo.
-	(webjump): Use assoc-ignore-case for locating the proper URL
-
-1998-01-24  SL Baur  
-
-	* Makefile (VERSION): Update to package standard 1.0.
-	* package-info.in: Ditto.
-
-1998-01-12  SL Baur  
-
-	* Makefile: Update to newer package interface.
-
-1998-01-05  SL Baur  
-
-	* Makefile: Created.
diff --git a/xemacs-packages/lisp/net-utils/_pkg.el b/xemacs-packages/lisp/net-utils/_pkg.el
deleted file mode 100644
index f8e9cf76..00000000
--- a/xemacs-packages/lisp/net-utils/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'net-utils
-		 :version 1.48
-          :author-version "N/A"
-		 :type 'single-file)
diff --git a/xemacs-packages/lisp/net-utils/auto-autoloads.el b/xemacs-packages/lisp/net-utils/auto-autoloads.el
deleted file mode 100644
index f07b5a55..00000000
--- a/xemacs-packages/lisp/net-utils/auto-autoloads.el
+++ /dev/null
@@ -1,186 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'net-utils-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "net-utils/_pkg.el")
-
-(package-provide 'net-utils :version 1.48 :author-version "N/A" :type 'single-file)
-
-;;;***
-
-;;;### (autoloads (dns-mode-soa-increment-serial dns-mode) "dns-mode" "net-utils/dns-mode.el")
-
-(autoload 'dns-mode "dns-mode" "Major mode for viewing and editing DNS master files.\nThis mode is inherited from text mode.  It add syntax\nhighlighting, and some commands for handling DNS master files.\nIts keymap inherits from `text-mode' and it has the same\nvariables for customizing indentation.  It has its own abbrev\ntable and its own syntax table.\n\nTurning on DNS mode runs `dns-mode-hook'." t nil)
-
-(autoload 'dns-mode-soa-increment-serial "dns-mode" "\
-Locate SOA record and increment the serial field." t nil)
-(add-to-list 'auto-mode-alist '("\\.soa\\'" . dns-mode))
-
-;;;***
-
-;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts) "feedmail" "net-utils/feedmail.el")
-
-(autoload 'feedmail-run-the-queue-no-prompts "feedmail" "\
-Like feedmail-run-the-queue, but suppress confirmation prompts." t nil)
-
-(autoload 'feedmail-run-the-queue-global-prompt "feedmail" "\
-Like feedmail-run-the-queue, but with a global confirmation prompt.
-This is generally most useful if run non-interactively, since you can 
-bail out with an appropriate answer to the global confirmation prompt." t nil)
-
-(autoload 'feedmail-run-the-queue "feedmail" "\
-Visit each message in the feedmail queue directory and send it out.
-Return value is a list of three things: number of messages sent, number of
-messages skipped, and number of non-message things in the queue (commonly
-backup file names and the like)." t nil)
-
-(autoload 'feedmail-queue-reminder "feedmail" "\
-Perform some kind of reminder activity about queued and draft messages.
-Called with an optional symbol argument which says what kind of event
-is triggering the reminder activity.  The default is 'on-demand, which
-is what you typically would use if you were putting this in your emacs start-up
-or mail hook code.  Other recognized values for WHAT-EVENT (these are passed
-internally by feedmail):
-
-   after-immediate      (a message has just been sent in immediate mode)
-   after-queue          (a message has just been queued)
-   after-draft          (a message has just been placed in the draft directory)
-   after-run            (the queue has just been run, possibly sending messages)
-
-WHAT-EVENT is used as a key into the table feedmail-queue-reminder-alist.  If
-the associated value is a function, it is called without arguments and is expected
-to perform the reminder activity.  You can supply your own reminder functions 
-by redefining feedmail-queue-reminder-alist.  If you don't want any reminders, 
-you can set feedmail-queue-reminder-alist to nil." t nil)
-
-;;;***
-
-;;;### (autoloads (google-query-region google-query) "google-query" "net-utils/google-query.el")
-
-(autoload 'google-query "google-query" "\
-Query google for STRING." t nil)
-
-(autoload 'google-query-region "google-query" "\
-Query google for the string BEG END." t nil)
-
-;;;***
-
-;;;### (autoloads (metamail-region metamail-buffer metamail-interpret-body metamail-interpret-header) "metamail" "net-utils/metamail.el")
-
-(autoload 'metamail-interpret-header "metamail" "\
-Interpret a header part of a MIME message in current buffer.
-Its body part is not interpreted at all." t nil)
-
-(autoload 'metamail-interpret-body "metamail" "\
-Interpret a body part of a MIME message in current buffer.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted.
-Its header part is not interpreted at all." t nil)
-
-(autoload 'metamail-buffer "metamail" "\
-Process current buffer through `metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted." t nil)
-
-(autoload 'metamail-region "metamail" "\
-Process current region through 'metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted." t nil)
-
-;;;***
-
-;;;### (autoloads (network-connection network-connection-to-service whois-reverse-lookup whois finger ftp nslookup nslookup-host route arp netstat ipconfig ping traceroute) "net-utils" "net-utils/net-utils.el")
-
-(autoload 'traceroute "net-utils" "\
-Run traceroute program for TARGET." t nil)
-
-(autoload 'ping "net-utils" "\
-Ping HOST.
-If your system's ping continues until interrupted, you can try setting 
-`ping-program-options'." t nil)
-
-(autoload 'ipconfig "net-utils" "\
-Run ipconfig program." t nil)
-
-(defalias 'ifconfig 'ipconfig)
-
-(autoload 'netstat "net-utils" "\
-Run netstat program." t nil)
-
-(autoload 'arp "net-utils" "\
-Run the arp program." t nil)
-
-(autoload 'route "net-utils" "\
-Run the route program." t nil)
-
-(autoload 'nslookup-host "net-utils" "\
-Lookup the DNS information for HOST." t nil)
-
-(autoload 'nslookup "net-utils" "\
-Run nslookup program." t nil)
-
-(autoload 'ftp "net-utils" "\
-Run ftp program." t nil)
-
-(autoload 'finger "net-utils" "\
-Finger USER on HOST." t nil)
-
-(autoload 'whois "net-utils" "\
-Send SEARCH-STRING to server defined by the `whois-server-name' variable.
-With argument, prompt for whois server." t nil)
-
-(autoload 'whois-reverse-lookup "net-utils" nil t nil)
-
-(autoload 'network-connection-to-service "net-utils" "\
-Open a network connection to SERVICE on HOST." t nil)
-
-(autoload 'network-connection "net-utils" "\
-Open a network connection to HOST on PORT." t nil)
-
-;;;***
-
-;;;### (autoloads (remote-compile) "rcompile" "net-utils/rcompile.el")
-
-(autoload 'remote-compile "rcompile" "\
-Compile the current buffer's directory on HOST.  Log in as USER.
-See \\[compile]." t nil)
-
-;;;***
-
-;;;### (autoloads (webjump) "webjump" "net-utils/webjump.el")
-
-(autoload 'webjump "webjump" "\
-Jumps to a Web site from a programmable hotlist.
-
-See the documentation for the `webjump-sites' variable for how to customize the
-hotlist.
-
-Please submit bug reports and other feedback to the author, Neil W. Van Dyke
-.
-
-The latest version can be gotten from `http://www.cs.brown.edu/people/nwv/'.
-That Web site also contains `webjump-plus.el', a larger and more frequently
-updated sample WebJump hotlist." t nil)
-
-;;;***
-
-;;;### (autoloads (report-xemacs-bug) "xemacsbug" "net-utils/xemacsbug.el")
-
-(autoload 'report-xemacs-bug "xemacsbug" "\
-Report a bug in XEmacs.
-Prompts for bug subject.  Leaves you in a mail buffer." t nil)
-
-(defalias 'report-emacs-bug 'report-xemacs-bug)
-
-;;;***
-
-(provide 'net-utils-autoloads)
diff --git a/xemacs-packages/lisp/net-utils/browse-cltl2.el b/xemacs-packages/lisp/net-utils/browse-cltl2.el
deleted file mode 100644
index 64037cd1..00000000
--- a/xemacs-packages/lisp/net-utils/browse-cltl2.el
+++ /dev/null
@@ -1,482 +0,0 @@
-; -*- Mode: Emacs-Lisp -*- 
-;;; browse-cltl2.el --- browse the hypertext-version of 
-;;;                     "Common Lisp the Language, 2nd. Edition"
-
-;; Revision 1.1.4
-;; last edited on 19.5.1998
-
-;; Copyright (C) 1997, 1998 Holger Schauer
-
-;; Author: Holger Schauer 
-;; Keywords: utils lisp ilisp www
-
-;; This file is part of XEmacs.
-
-;; Developed under XEmacs 19.14. Also tested on Emacs 19.29, 19.32 
-;; and XEmacs 19.11, 19.16, 20.3. Should work with newer versions, too.
-;; Required: browse-url.el
-;; Recommended: url.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 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., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-;; This gives you two top-level-functions useful when programming lisp:
-;; cltl2-view-function-definition and cltl2-view-index
-;; cltl2-view-function-definition asks you for a name of a lisp
-;; function (or variable) and will open up your favourite browser
-;; (as specified by `browse-url-browser-function') loading the page
-;; which documents it.
-
-;;; Installation: (as usual)
-;; Put browse-cltl2.el somewhere where emacs can find it.
-;; browse-cltl2.el requires a working browse-url, url and cl.
-;; Insert the following lines in your .emacs:
-;;
-;;      (autoload 'cltl2-view-function-definition "browse-cltl2")
-;;      (autoload 'cltl2-view-index "browse-cltl2")
-;;      (autoload 'cltl2-lisp-mode-install "browse-cltl2")
-;;      (add-hook 'lisp-mode-hook 'cltl2-lisp-mode-install)
-;;      (add-hook 'ilisp-mode-hook 'cltl2-lisp-mode-install)
-;;
-;; This should also add the needed hooks to lisp-mode (and ilisp-mode).
-
-;; Gnu Emacs:
-;; For Gnu Emacs there doesn't seem to be a lisp-mode-hook so you're
-;; on your own with the key-settings.
-;; No url.el:
-;; If you don't have url.el set *cltl2-use-url* to nil
-;; and set *cltl2-fetch-method* to 'local or 'local-index-only.
-;; This implies that you need a local copy of the index page of
-;; CLtL2 (which you can get from the normal hypertext-version at CMU),
-;; so you need to point *cltl2-local-file-pos* and *cltl2-index-file-name*
-;; to the place where you put it.
-;; Old versions of Emacs (Emacs 19.29 and XEmacs 19.11 for example):
-;; When you want to use a local copy (or a local copy of the index file)
-;; check the documentation on find-file-noselect. If it doesn't mention
-;; an option called RAWFILE set *cltl2-old-find-file-noselect* to 't.
-
-
-;;; Customization:
-;; By default, browse-cltl2 will use a local copy of CLtL2, looking
-;; for it in /usr/doc/html/cltl. This can be modified with the help
-;; of the following variables:
-;; *cltl2-fetch-method*, *cltl2-url*, *cltl-local-file-pos*
-;; See the documentation on this variables for more info.
-;;
-;;; TODO:
-;; In this version we can't separate between functions, variables, 
-;; constants and loop clauses. This is not that hard to change,
-;; but it is more difficult to distinguish what the user is
-;; looking for. Until I receive several requests for it, I won't
-;; implement it, because there are not that much constructs like * and + 
-;; which have two (or more) semantics.
-
-;;; Changes:
-;; 28-01-97: HS: now we're using cl-puthash all over the place because
-;;          this is common on XEmacs 19.11 and upwards and Gnu Emacs.
-;;          Added information on how to install without url.el
-;;
-;; 29-01-97 HS: included conditionalized versions of the required
-;;         functions match-string and buffer-live-p. 
-;;         Suggested by Simon Marshall .
-;;         Included new variable *cltl2-use-url* with which one can
-;;         specify if he has url.el or not. Introduced variable
-;;         *cltl2-old-find-file-noselect*.
-;;
-;; 05-02-97 HS: added two variables for the key-bindings,
-;;         *cltl2-vfd-key* *cltl2-vi-key*.
-;;
-;; 18-02-97 HS: use compatible keybindings that work on Gnu Emacs and XEmacs.
-;;         Made cltl2-lisp-mode-install an interactive function.
-;;
-;; 28-02-98 HS: use symbol-near-point to obtain a default value to
-;;         search for and added a history for already searched entries.
-;;
-;; 22-04-98 HS: added an error message if index-file does not exist.
-;;
-;; 27-04-98 HS: fixed a bug with the minibuffer history. Thanks to
-;;          Sam Mikes  for pointing out the
-;;          existence of `minibuffer-history-minimum-string-length'
-;;
-;; 19-05-98 HS: changed #' to (function ... in order to make it work
-;;          with older emacsen. `minibuffer-history-minimum-string-length'
-;;          is also unknown to older emacsen. `read-string' had only
-;;          two arguments in Emacs 19.29.
-
-
-(defvar *cltl2-use-url* 'nil
- "Enables or disables retrieval of the index-file via WWW (or more
- exactly by the use of the function url-retrieve from url.el).
- Default is 't.")
-
-;; needed things
-(require 'cl)
-(require 'browse-url)
-(autoload 'url-retrieve "url")
-
-(when (not *cltl2-use-url*)
-   (require 'url))
-
-;;; ******************************
-;;; Some variable and constant definitions
-;;; ******************************
-(defvar *cltl2-fetch-method* 'local
- "This sets the method by which the index-file will be fetched. Three
-  methods are possible: 'local assumes that all files are local. 
-  'local-index-only assumes that just the index-file is locally but
-  all other files will be fetched via www. 'www means that the index-file
-  will be fetched via WWW, too. Don't change the value of this variable
-  after loading.")
-
-(defvar *cltl2-url* 
- "http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/"
- "The url where the hypertext-version of Common Lisp the Language
- can be found. Note that this assumes to be the top-level of the
- directory structure which should be the same as in the hypertext
- version as provided by the CMU AI Repository. Defaults to
- http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/
- Note the / at the end.")
-
-(defvar *cltl2-local-file-pos* "/usr/doc/html/cltl/"
- "A directory where the CLtl2 can be found. Note that this assumes
- to be the top-level of the directory structure which should be the
- same as in the hypertext version as provided by the CMU AI Repository.
- Defaults to /usr/doc/html/cltl/ Note the / at the end.")
-
-(defconst *cltl2-index-file-name* "clm/index.html"
- "The name of the index-file, typically with directory on front. 
-  Defaults to clm/index.html, as this is the momentary position from
-  the top-level directory of the CLtL2-home. Defaults to clm/index.html.
-  Note that there is no leading /.")
-
-(defvar *cltl2-index-home* 
-  (concatenate 'string
-     (case *cltl2-fetch-method*
-       ('local *cltl2-local-file-pos*)
-       ('local-index-only *cltl2-local-file-pos*)
-       ('www *cltl2-url*))
-     *cltl2-index-file-name*)
- "The absolute path which will be used to fetch the index.")
-
-(defvar *cltl2-home*
-  (concatenate 
-   'string
-   (case *cltl2-fetch-method*
-     ('local *cltl2-local-file-pos*)
-     ('local-index-only *cltl2-url*)
-     ('www *cltl2-url*))
-     "clm/")
-  "This specifies the home-position of the CLtL2. The value of this variable
-  will be concatenated with the name of the nodes of the CLtL2.")
-
-(defvar *cltl2-index-buffer-name* "*cltl2-index*"
- "The name of the buffer which holds the index for CLtL2.")
-
-(defvar *cltl2-old-find-file-noselect* 'nil
- "Older versions of Emacs (at least XEmacs 19.11) don't support the
- option RAWFILE with the function FIND-FILE-NO-SELECT. Set this variable
- to 't if you have such an old version. It will cause fontification and
- other useless stuff on the buffer in which the index is fetched. If
- you don't use a local copy (of the index) this won't bother you.")
-
-(defvar *cltl2-vfd-key* 
-  (if (featurep 'ilisp)
-      '[(control z) h]
-     '[(control c) b])
- "Shortcut for accessing cltl2-view-function-definition. Use meaningful
- setting with Ilisp.")
-
-(defvar *cltl2-vi-key* 
-  (if (featurep 'ilisp)
-      '[(control z) H]
-     '[(control c) B])
- "Shortcut for accessing cltl2-view-index. Use meaningful
- setting with Ilisp.")
-
-(defvar *browse-cltl2-ht* (make-hash-table 0))
-(defconst *cltl2-search-regexpr* 
-  "\\(.+\\)"
-  "A regular expression how to check for entries in the index-file
-  of CLtL2. Note that you have to modify this and the 
-  prepare-get-entry*-functions if you want to change the search.")
-
-(defvar *browse-cltl2-history* nil
-  "History of CLtL2-entries to lookup.")
-
-;;; ******************************
-;;; First of all: Compatibility stuff
-;;; ******************************
-; no match-string in old versions
-(if (not (fboundp (function match-string)))
-    (defun match-string (num &optional string)
-      "Return string of text matched by last search.
- NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
- Zero means the entire text matched by the whole regexp or whole string.
- STRING should be given if the last search was by `string-match' on STRING."
-      (if (match-beginning num)
-	  (if string
-	      (substring string (match-beginning num) (match-end num))
-	      (buffer-substring 
-	       (match-beginning num) (match-end num))))))
-
-; no buffer-live-p in old versions
- (if (not (fboundp (function buffer-live-p)))
-     (defun buffer-live-p (buf-or-name)
-       "Checks if BUF-OR-NAME is a live buffer. Returns non-nil
- if BOF-OR-NAME is an editor buffer which has not been deleted.
- Imitating a built-in function from newer Emacs versions."
-       (let ((object (if (bufferp buf-or-name) 
-                          buf-or-name
-			(get-buffer buf-or-name))))
-	 (and (bufferp object) (buffer-name object)))))
-
-; no add-submenu in old versions of XEmacs       
-(if (and (string-match "XEmacs\\|Lucid" emacs-version)
-	 (not (fboundp 'add-submenu)))
-    (defun add-submenu (menu-path submenu &optional before)
-  "Add a menu to the menubar or one of its submenus.
-If the named menu exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
- If MENU-PATH is nil, then the menu will be added to the menubar itself.
-SUBMENU is the new menu to add.
- See the documentation of `current-menubar' for the syntax.
-BEFORE, if provided, is the name of a menu before which this menu should
- be added, if this menu is not on its parent already.  If the menu is already
- present, it will not be moved."
-  (add-menu menu-path (car submenu) (cdr submenu) before)))
-
-; stolen from XEmacs 19.15 syntax.el
-(if (not (fboundp (function symbol-near-point)))
-    (defun symbol-near-point ()
-      "Return the first textual item to the nearest point."
-      (interactive)
-	;alg stolen from etag.el
-      (save-excursion
-	(if (not (memq (char-syntax (preceding-char)) '(?w ?_)))
-	    (while (not (looking-at "\\sw\\|\\s_\\|\\'"))
-	      (forward-char 1)))
-	(while (looking-at "\\sw\\|\\s_")
-	  (forward-char 1))
-	(if (re-search-backward "\\sw\\|\\s_" nil t)
-	    (regexp-quote
-	     (progn (forward-char 1)
-		    (buffer-substring (point)
-				      (progn (forward-sexp -1)
-					     (while (looking-at "\\s'")
-					       (forward-char 1))
-					     (point)))))
-	  nil))))
-
-; needed for 19.11, I think
-(if (not (fboundp (function url-lazy-message)))
-  (defun url-lazy-message (&rest args)
-    "Just like `message', but is a no-op if called more than once a second.
-Will not do anything if url-show-status is nil."
-    (if (or (null url-show-status)
-	    (= url-lazy-message-time
-	       (setq url-lazy-message-time (nth 1 (current-time)))))
-	nil
-      (apply 'message args))))
-
-; old find-file-noselect has no RAWFILE argument
-(if *cltl2-old-find-file-noselect*
-    (unless (boundp 'cltl2-old-find-file-noselect-func)
-      (setf (symbol-value 'cltl2-old-find-file-noselect-func)
-	    (symbol-function 'find-file-noselect))
-      (setf (symbol-function 'find-file-noselect)
-	    (function 
-	     (lambda (file &optional nowarn rawfile)
-	       (funcall cltl2-old-find-file-noselect-func file nowarn))))))
-  
-;;; ******************************
-;;; Functions for fetching the index file
-;;; ******************************
-(defun cltl2-fetch-index ()
-  "Fetches the index page of the CLtl2 and puts it in its own
- buffer called *cltl2-index*."
-  ;; if the index isn't here load it into a buffer
-  (when (or (not (get-buffer *cltl2-index-buffer-name*))
-	    (not (buffer-live-p *cltl2-index-buffer-name*)))
-    (message "Fetching the CLtL2 index file ...")
-    (case *cltl2-fetch-method* 
-      ('local 
-       (cltl2-fetch-index-by-file))
-      ('local-index-only
-       (cltl2-fetch-index-by-file))
-      ('www
-       (cltl2-fetch-index-by-www))))
-  
-  (cltl2-prepare-index)
-)
-
-;; fetch methods
-(defun cltl2-fetch-index-by-file ()
-  "Fetch the index from disk."
-  (if (not (file-readable-p *cltl2-index-home*))
-      (error "CLtL2 index file not readable: %s." *cltl2-index-home*))
-
-  (setf *cltl2-index-buffer-name*
-	(find-file-noselect *cltl2-index-home* 'nil 't)))
-
-(defun cltl2-fetch-index-by-www ()
- "Fetch the index via WWW."
- (save-excursion
-   (let ((old-url-working-buffer url-working-buffer))
-     (setf url-working-buffer *cltl2-index-buffer-name*)
-     (url-retrieve *cltl2-index-home*)
-     (setf url-working-buffer old-url-working-buffer))))
-
-
-;;; ******************************
-;;; Main functions for viewing
-;;; ******************************
-(defun cltl2-view-function-definition (entry)
-  "First checks if function can be found in the CLtL2-index-file.
- If it can be found, uses the function browse-url to have a look
- at the corresponding documentation from CLtL2."
-  (interactive 
-   (let ((ol-hist-val (if (boundp 'minibuffer-history-minimum-string-length)
-			  minibuffer-history-minimum-string-length
-			nil))
-	 (entry-val nil))
-     (setq minibuffer-history-minimum-string-length nil)
-     (setq entry-val
-	   (list (read-from-minibuffer
-		  (concatenate 'string
-			       "CLtL2-Entry to lookup (default " 
-			       (symbol-near-point) "):")
-		  nil nil nil
-		  '*browse-cltl2-history*)))
-     (setq minibuffer-history-minimum-string-length ol-hist-val)
-     entry-val))
-	   
-  (cond ((equal "" entry)
-	 (setf entry (symbol-near-point))
-	 (setf *browse-cltl2-history*
-	       (push entry *browse-cltl2-history*))))
-
-  (when (cltl2-index-unprepared-p)
-    (cltl2-fetch-index))
-  
-  (let ((entry-url (cltl2-find-url-for-function (intern entry))))
-    (when entry-url
-     (message "Loading found entry for %s into browser.." entry)
-     (browse-url 
-      (concatenate 'string *cltl2-home* entry-url)))))
-
-(defun cltl2-find-url-for-function (entry)
-  "Checks if we can find a page for function ENTRY and
- constructs an URL from it."
-  (let ((entry-url (gethash entry *browse-cltl2-ht*)))
-    (when (not entry-url)
-      (error "No entry in CLtL2 for %s" entry))
-    entry-url))
-
-(defun cltl2-view-index ()
-  "Browse-urls the index file."
-  (interactive)
-  (browse-url *cltl2-index-home*))
-
-;;; ******************************
-;;; Preparing the index (the hashtable)
-;;; ******************************
-(defun cltl2-prepare-index ()
- "Jumps to the *cltl2-index* buffer and scans it, creating a hashtable
- for all entries."
- (message "Preparing CLtL2 index.")
- (save-excursion
-   (set-buffer *cltl2-index-buffer-name*)
-   (goto-char (point-min))
-
-   ; search for entry
-   (do ((point (re-search-forward 
-                 *cltl2-search-regexpr* 
-		 nil t)
-	       (re-search-forward 
-		*cltl2-search-regexpr* 
-		nil t)))
-       ; until we can't find anymore
-       ((null point)); (format "Index-preparation done."))
-     ; put found entry in hash-table
-     (cl-puthash 
-      (cltl2-prepare-get-entry-name)
-      (cltl2-prepare-get-entry-url)
-      *browse-cltl2-ht*))))
-
-(defun cltl2-prepare-get-entry-name ()
- "Get the enrty name from the last match of regexp-search for entries."
- (let ((name-string (intern (match-string 2))))
-   (format "%s" name-string)
- name-string))
-
-(defun cltl2-prepare-get-entry-url ()
- "Get the enrty url from the last match of regexp-search for entries."
- (let ((url (match-string 1)))
-   (format "%s" url)
-   url))
-
-(defun cltl2-index-unprepared-p ()
- "Check if the index is already prepared."
- ; If the hashtable has entries the index is prepared.
- (not (and (hash-table-p *browse-cltl2-ht*)
-	   (>= (hash-table-count *browse-cltl2-ht*) 1))))
- 
-;;; ******************************
-;;; Hooking into lisp mode and ilisp-mode
-;;; ******************************
-(defun cltl2-lisp-mode-install ()
- "Adds browse-cltl2 to lisp-mode. If you use ilisp (installed via a hook
- on lisp-mode) add browse-cltl2 to ilisp. Check the variables *cltl2-vfd-key*
- and *cltl2-vi-key* for the keybindings. Under XEmacs we will add ourself to
- the corresponding menus if there exists one."
- (interactive)
- ; set key bindings
- (local-set-key *cltl2-vfd-key* 'cltl2-view-function-definition)
- (local-set-key *cltl2-vi-key* 'cltl2-view-index)
- ; under XEmacs hook ourself into the menu if there is one
- (when (string-match "XEmacs\\|Lucid" emacs-version)
-   (cond ((and (featurep 'ilisp-easy-menu)
-	       ; this is for the menu as provided by ilisp-easy-menu
-	       (not (null (car (find-menu-item current-menubar '("ILisp"))))))
-	  (add-submenu
-	   '("ILisp" "Documentation")
-	   '("Browse CLtL2"
-	     [ "View entry" cltl2-view-function-definition t]
-	     [ "View index" cltl2-view-index t] )))
-	   ; perhaps an other Ilisp-Menu is there ?
-	 ((not (null (car (find-menu-item current-menubar '("ILisp")))))
-	  (add-submenu
-	   '("Lisp")
-	   '("Browse CLtL2"
-	     [ "View entry" cltl2-view-function-definition t]
-	     [ "View index" cltl2-view-index t] )))
-           ; or at least a Lisp-Menu ?
-	 ((not (null (car (find-menu-item current-menubar '("Lisp")))))
-	  (add-submenu
-	   '("Lisp")
-	   '("Browse CLtL2"
-	     [ "View entry" cltl2-view-function-definition t]
-	     [ "View index" cltl2-view-index t] )))))
-)
-
-(add-hook 'lisp-mode-hook 'cltl2-lisp-mode-install)
-(add-hook 'ilisp-mode-hook 'cltl2-lisp-mode-install)
-
-;;; Providing ourself. 
-(provide 'ilisp-browse-cltl2)
-;;; browse-cltl2.el ends here.
diff --git a/xemacs-packages/lisp/net-utils/custom-load.el b/xemacs-packages/lisp/net-utils/custom-load.el
deleted file mode 100644
index 28cc6674..00000000
--- a/xemacs-packages/lisp/net-utils/custom-load.el
+++ /dev/null
@@ -1,31 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'shell '("net-utils"))
-(custom-add-loads 'feedmail-debug '("feedmail"))
-(custom-add-loads 'google '("google-query"))
-(custom-add-loads 'mail '("feedmail" "metamail" "mozmail" "xemacsbug"))
-(custom-add-loads 'tools '("rcompile"))
-(custom-add-loads 'feedmail-header '("feedmail"))
-(custom-add-loads 'hypermedia '("google-query" "metamail"))
-(custom-add-loads 'dig '("dig"))
-(custom-add-loads 'feedmail-spray '("feedmail"))
-(custom-add-loads 'feedmail-queue '("feedmail"))
-(custom-add-loads 'remote-compile '("rcompile"))
-(custom-add-loads 'metamail '("metamail"))
-(custom-add-loads 'shadowfile '("shadowfile"))
-(custom-add-loads 'mozmail '("mozmail"))
-(custom-add-loads 'files '("shadowfile"))
-(custom-add-loads 'xemacsbug '("xemacsbug"))
-(custom-add-loads 'feedmail-misc '("feedmail"))
-(custom-add-loads 'maint '("xemacsbug"))
-(custom-add-loads 'dns-mode '("dns-mode"))
-(custom-add-loads 'feedmail '("feedmail"))
-(custom-add-loads 'processes '("metamail" "rcompile"))
-(custom-add-loads 'net-utils '("net-utils"))
-(custom-add-loads 'feedmail-headers '("feedmail"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/net-utils/dig.el b/xemacs-packages/lisp/net-utils/dig.el
deleted file mode 100644
index e71d6dbb..00000000
--- a/xemacs-packages/lisp/net-utils/dig.el
+++ /dev/null
@@ -1,188 +0,0 @@
-;;; dig.el --- Domain Name System dig interface
-;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson 
-;; Keywords: DNS BIND dig
-
-;; 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:
-
-;; This provide an interface for "dig".
-;;
-;; For interactive use, try M-x dig and type a hostname.  Use `q' to quit
-;; dig buffer.
-;;
-;; For use in elisp programs, call `dig-invoke' and use
-;; `dig-extract-rr' to extract resource records.
-
-;;; Release history:
-
-;; 2000-10-28  posted on gnu.emacs.sources
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defgroup dig nil
-  "Dig configuration.")
-
-(defcustom dig-program "dig"
-  "Name of dig (domain information groper) binary."
-  :type 'file
-  :group 'dig)
-
-(defcustom dig-dns-server nil
-  "DNS server to query.
-If nil, use system defaults."
-  :type '(choice (const :tag "System defaults")
-		 string)
-  :group 'dig)
-
-(defcustom dig-font-lock-keywords
-  '(("^;; [A-Z]+ SECTION:" 0 font-lock-keyword-face)
-    ("^;;.*" 0 font-lock-comment-face)
-    ("^; <<>>.*" 0 font-lock-type-face)
-    ("^;.*" 0 font-lock-function-name-face))
-  "Default expressions to highlight in dig mode."
-  :type 'sexp
-  :group 'dig)
-
-(defun dig-invoke (domain &optional
-			  query-type query-class query-option
-			  dig-option server)
-  "Call dig with given arguments and return buffer containing output.
-DOMAIN is a string with a DNS domain. QUERY-TYPE is an optional string
-with a DNS type. QUERY-CLASS is an optional string with a DNS class.
-QUERY-OPTION is an optional string with dig \"query options\".
-DIG-OPTIONS is an optional string with parameters for the dig program.
-SERVER is an optional string with a domain name server to query.
-
-Dig is an external program found in the BIND name server distribution,
-and is a commonly available debugging tool."
-  (let (buf cmdline)
-    (setq buf (generate-new-buffer "*dig output*"))
-    (if dig-option (push dig-option cmdline))
-    (if query-option (push query-option cmdline))
-    (if query-class (push query-class cmdline))
-    (if query-type (push query-type cmdline))
-    (push domain cmdline)
-    (if server (push (concat "@" server) cmdline)
-      (if dig-dns-server (push (concat "@" dig-dns-server) cmdline)))
-    (apply 'call-process dig-program nil buf nil cmdline)
-    buf))
-
-(defun dig-extract-rr (domain &optional type class)
-  "Extract resource records for DOMAIN, TYPE and CLASS from buffer.
-Buffer should contain output generated by `dig-invoke'."
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward
-	 (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+"
-		 (upcase (or class "IN")) "[\t ]+" (upcase (or type "A")))
-	 nil t)
-	(let (b e)
-	  (end-of-line)
-	  (setq e (point))
-	  (beginning-of-line)
-	  (setq b (point))
-	  (when (search-forward " (" e t)
-	    (search-forward " )"))
-	  (end-of-line)
-	  (setq e (point))
-	  (buffer-substring b e))
-      (and (re-search-forward (concat domain "\\.?[\t ]+[0-9wWdDhHmMsS]+[\t ]+"
-				      (upcase (or class "IN"))
-				      "[\t ]+CNAME[\t ]+\\(.*\\)$") nil t)
-	   (dig-extract-rr (match-string 1) type class)))))
-
-(defun dig-rr-get-pkix-cert (rr)
-  (let (b e str)
-    (string-match "[^\t ]+[\t ]+[0-9wWdDhHmMsS]+[\t ]+IN[\t ]+CERT[\t ]+\\(1\\|PKIX\\)[\t ]+[0-9]+[\t ]+[0-9]+[\t ]+(?" rr)
-    (setq b (match-end 0))
-    (string-match ")" rr)
-    (setq e (match-beginning 0))
-    (setq str (substring rr b e))
-    (while (string-match "[\t \n\r]" str)
-      (setq str (replace-match "" nil nil str)))
-    str))
-
-;; XEmacs does it like this.  For Emacs, we have to set the
-;; `font-lock-defaults' buffer-local variable.
-(put 'dig-mode 'font-lock-defaults '(dig-font-lock-keywords t))
-
-(put 'dig-mode 'mode-class 'special)
-
-(defvar dig-mode-map nil)
-(unless dig-mode-map
-  (setq dig-mode-map (make-sparse-keymap))
-  (suppress-keymap dig-mode-map)
-
-  (define-key dig-mode-map "q" 'dig-exit))
-
-(defun dig-mode ()
-  "Major mode for displaying dig output."
-  (interactive)
-  (kill-all-local-variables)
-  (setq mode-name "dig")
-  (setq major-mode 'dig-mode)
-  (use-local-map dig-mode-map)
-  (buffer-disable-undo)
-  (unless (featurep 'xemacs)
-    (set (make-local-variable 'font-lock-defaults)
-	 '(dig-font-lock-keywords t)))
-  (when (featurep 'font-lock)
-    (font-lock-set-defaults)))
-
-(defun dig-exit ()
-  "Quit dig output buffer."
-  (interactive)
-  (kill-buffer (current-buffer)))
-
-(defun dig (domain &optional
-		   query-type query-class query-option dig-option server)
-  "Query addresses of a DOMAIN using dig, by calling `dig-invoke'.
-Optional arguments are passed to `dig-invoke'."
-  (interactive "sHost: ")
-  (switch-to-buffer
-   (dig-invoke domain query-type query-class query-option dig-option server))
-  (goto-char (point-min))
-  (and (search-forward ";; ANSWER SECTION:" nil t)
-       (forward-line))
-  (dig-mode)
-  (setq buffer-read-only t)
-  (set-buffer-modified-p nil))
-
-;; named for consistency with query-dns in dns.el
-(defun query-dig (domain &optional
-			 query-type query-class query-option dig-option server)
-  "Query addresses of a DOMAIN using dig.
-It works by calling `dig-invoke' and `dig-extract-rr'.  Optional
-arguments are passed to `dig-invoke' and `dig-extract-rr'.  Returns
-nil for domain/class/type queries that results in no data."
-(let ((buffer (dig-invoke domain query-type query-class
-			  query-option dig-option server)))
-  (when buffer
-    (switch-to-buffer buffer)
-    (let ((digger (dig-extract-rr domain query-type query-class)))
-      (kill-buffer buffer)
-      digger))))
-
-(provide 'dig)
-
-;;; dig.el ends here
diff --git a/xemacs-packages/lisp/net-utils/dns-mode.el b/xemacs-packages/lisp/net-utils/dns-mode.el
deleted file mode 100644
index 400f8720..00000000
--- a/xemacs-packages/lisp/net-utils/dns-mode.el
+++ /dev/null
@@ -1,198 +0,0 @@
-;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files
-;; Copyright (c) 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson 
-;; Keywords: DNS master zone file SOA
-
-;; 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:
-
-;; Use M-x dns-mode RET to invoke in master files.
-;;
-;; C-c C-s  Increment SOA serial.
-;;          Understands YYYYMMDDNN, Unix time, and serial number formats,
-;;          and complains if it fail to find SOA serial.
-;;
-;; Put something similar to the following in your ~/.emacs to use this file:
-;;
-;; (load "~/path/to/dns-mode.el")
-;; (setq auto-mode-alist (cons '("\\.soa\\'" . dns-mode) auto-mode-alist))
-
-;;; References:
-
-;; RFC 1034, "DOMAIN NAMES - CONCEPTS AND FACILITIES", P. Mockapetris.
-;; RFC 1035, "DOMAIN NAMES - IMPLEMENTATION AND SPECIFICATION", P. Mockapetris.
-
-;;; Release history:
-
-;; 2004-09-11  Posted on gnu.emacs.sources.
-;; 2004-09-13  Ported to XEmacs.
-;; 2004-09-14  Installed in Emacs CVS.
-
-;;; Code:
-
-(defgroup dns-mode nil
-  "DNS master file mode configuration.")
-
-(defconst dns-mode-classes '("IN" "CS" "CH" "HS")
-  "List of strings with known DNS classes.")
-
-(defconst dns-mode-types '("A" "NS" "MD" "MF" "CNAME" "SOA" "MB" "MG" "MR"
-			   "NULL" "WKS" "PTR" "HINFO" "MINFO" "MX" "TXT"
-			   "RP" "AFSDB" "X25" "ISDN" "RT" "NSAP" "NSAP"
-			   "SIG" "KEY" "PX" "GPOS" "AAAA" "LOC" "NXT"
-			   "EID" "NIMLOC" "SRV" "ATMA" "NAPTR" "KX" "CERT"
-			   "A6" "DNAME" "SINK" "OPT" "APL" "DS" "SSHFP"
-			   "RRSIG" "NSEC" "DNSKEY" "UINFO" "UID" "GID"
-			   "UNSPEC" "TKEY" "TSIG" "IXFR" "AXFR" "MAILB"
-			   "MAILA")
-  "List of strings with known DNS types.")
-
-;; Font lock.
-
-(defvar dns-mode-control-entity-face 'font-lock-keyword-face
-  "Name of face used for control entities, e.g. $ORIGIN.")
-
-(defvar dns-mode-bad-control-entity-face 'font-lock-warning-face
-  "Name of face used for non-standard control entities, e.g. $FOO.")
-
-(defvar dns-mode-type-face 'font-lock-type-face
-  "Name of face used for DNS types, e.g., SOA.")
-
-(defvar dns-mode-class-face 'font-lock-constant-face
-  "Name of face used for DNS classes, e.g., IN.")
-
-(defcustom dns-mode-font-lock-keywords
-  `(("^$ORIGIN" 0 ,dns-mode-control-entity-face)
-    ("^$INCLUDE" 0 ,dns-mode-control-entity-face)
-    ("^$[a-z0-9A-Z]+" 0 ,dns-mode-bad-control-entity-face)
-    (,(regexp-opt dns-mode-classes) 0 ,dns-mode-class-face)
-    (,(regexp-opt dns-mode-types) 0 ,dns-mode-type-face))
-  "Font lock keywords used to highlight text in DNS master file mode."
-  :type 'sexp
-  :group 'dns-mode)
-
-;; Syntax table.
-
-(defvar dns-mode-syntax-table
-  (let ((table (make-syntax-table)))
-    (modify-syntax-entry ?\; "<   " table)
-    (modify-syntax-entry ?\n ">   " table)
-    table)
-  "Syntax table in use in DNS master file buffers.")
-
-;; Keymap.
-
-(defvar dns-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-c\C-s" 'dns-mode-soa-increment-serial)
-    map)
-  "Keymap for DNS master file mode.")
-
-;; Menu.
-
-(defvar dns-mode-menu nil
-  "Menubar used in DNS master file mode.")
-
-(easy-menu-define dns-mode-menu dns-mode-map
-  "DNS Menu."
-  '("DNS"
-    ["Increment SOA serial" dns-mode-soa-increment-serial t]))
-
-;; Mode.
-
-;;;###autoload
-(define-derived-mode dns-mode text-mode "DNS"
-  "Major mode for viewing and editing DNS master files.
-This mode is inherited from text mode.  It add syntax
-highlighting, and some commands for handling DNS master files.
-Its keymap inherits from `text-mode' and it has the same
-variables for customizing indentation.  It has its own abbrev
-table and its own syntax table.
-
-Turning on DNS mode runs `dns-mode-hook'."
-  (set (make-local-variable 'comment-start) ";")
-  (set (make-local-variable 'comment-end) "")
-  (set (make-local-variable 'comment-start-skip) ";+ *")
-  (unless (featurep 'xemacs)
-    (set (make-local-variable 'font-lock-defaults)
-	 '(dns-mode-font-lock-keywords nil nil ((?_ . "w")))))
-  (easy-menu-add dns-mode-menu dns-mode-map))
-
-;; Tools.
-
-;;;###autoload
-(defun dns-mode-soa-increment-serial ()
-  "Locate SOA record and increment the serial field."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (unless (re-search-forward
-	     (concat "^\\(\\(\\([^ \t]+[ \t]+\\)?[^ \t]+"
-		     "[ \t]+\\)?[^ \t]+[ \t]+\\)?SOA") nil t)
-      (error "Cannot locate SOA record"))
-    (if (re-search-forward (concat "\\<\\("
-				   ;; year
-				   "\\(198\\|199\\|20[0-9]\\)[0-9]"
-				   ;; month
-				   "\\(0[0-9]\\|10\\|11\\|12\\)"
-				   ;; day
-				   "\\([012][0-9]\\|30\\|31\\)"
-				   ;; counter
-				   "\\([0-9]\\{1,3\\}\\)"
-				   "\\)\\>")
-			   nil t)
-	;; YYYYMMDDIII format, one to three I's.
-	(let* ((serial (match-string 1))
-	       (counterstr (match-string 5))
-	       (counter (string-to-number counterstr))
-	       (now (format-time-string "%Y%m%d"))
-	       (nowandoldserial (concat now counterstr)))
-	  (if (string< serial nowandoldserial)
-	      (let ((new (format "%s00" now)))
-		(replace-match new nil nil nil 1)
-		(message "Replaced old serial %s with %s" serial new))
-	    (if (string= serial nowandoldserial)
-		(let ((new (format (format "%%s%%0%dd" (length counterstr))
-				   now (1+ counter))))
-		  (replace-match new nil nil nil 1)
-		  (message "Replaced old serial %s with %s" serial new))
-	      (error "Current SOA serial is in the future"))))
-      (if (re-search-forward "\\<\\([0-9]\\{9,10\\}\\)\\>" nil t)
-	  ;; Unix time
-	  (let* ((serial (match-string 1))
-		 (new (format-time-string "%s")))
-	    (if (not (string< serial new))
-		(error "Current SOA serial is in the future")
-	      (replace-match new nil nil nil 1)
-	      (message "Replaced old serial %s with %s" serial new)))
-	(if (re-search-forward "\\<\\([0-9]+\\)\\>" nil t)
-	    ;; Just any serial number.
-	    (let* ((serial (match-string 1))
-		   (new (format "%d" (1+ (string-to-number serial)))))
-	      (replace-match new nil nil nil 1)
-	      (message "Replaced old serial %s with %s" serial new))
-	  (error "Cannot locate serial number in SOA record"))))))
-
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.soa\\'" . dns-mode))
-
-(provide 'dns-mode)
-
-;; arch-tag: 6a179f0a-072f-49db-8b01-37b8f23998c0
-;;; dns-mode.el ends here
diff --git a/xemacs-packages/lisp/net-utils/dns.el b/xemacs-packages/lisp/net-utils/dns.el
deleted file mode 100644
index d573d896..00000000
--- a/xemacs-packages/lisp/net-utils/dns.el
+++ /dev/null
@@ -1,374 +0,0 @@
-;;; dns.el --- Domain Name Service lookups
-;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen 
-;; Keywords: network
-
-;; 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:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'mm-util)
-
-(defvar dns-timeout 5
-  "How many seconds to wait when doing DNS queries.")
-
-(defvar dns-servers nil
-  "Which DNS servers to query.
-If nil, /etc/resolv.conf will be consulted.")
-
-;;; Internal code:
-
-(defvar dns-query-types
-  '((A 1)
-    (NS 2)
-    (MD 3)
-    (MF 4)
-    (CNAME 5)
-    (SOA 6)
-    (MB 7)
-    (MG 8)
-    (MR 9)
-    (NULL 10)
-    (WKS 11)
-    (PTR 12)
-    (HINFO 13)
-    (MINFO 14)
-    (MX 15)
-    (TXT 16)
-    (AAAA 28) ; RFC3596
-    (AXFR 252)
-    (MAILB 253)
-    (MAILA 254)
-    (* 255))
-  "Names of query types and their values.")
-
-(defvar dns-classes
-  '((IN 1)
-    (CS 2)
-    (CH 3)
-    (HS 4))
-  "Classes of queries.")
-
-(defun dns-write-bytes (value &optional length)
-  (let (bytes)
-    (dotimes (i (or length 1))
-      (push (% value 256) bytes)
-      (setq value (/ value 256)))
-    (dolist (byte bytes)
-      (insert byte))))
-
-(defun dns-read-bytes (length)
-  (let ((value 0))
-    (dotimes (i length)
-      (setq value (logior (* value 256) (following-char)))
-      (forward-char 1))
-    value))
-
-(defun dns-get (type spec)
-  (cadr (assq type spec)))
-
-(defun dns-inverse-get (value spec)
-  (let ((found nil))
-    (while (and (not found)
-		spec)
-      (if (eq value (cadr (car spec)))
-	  (setq found (caar spec))
-	(pop spec)))
-    found))
-
-(defun dns-write-name (name)
-  (dolist (part (split-string name "\\."))
-    (dns-write-bytes (length part))
-    (insert part))
-  (dns-write-bytes 0))
-
-(defun dns-read-string-name (string buffer)
-  (mm-with-unibyte-buffer
-    (insert string)
-    (goto-char (point-min))
-    (dns-read-name buffer)))
-
-(defun dns-read-name (&optional buffer)
-  (let ((ended nil)
-	(name nil)
-	length)
-    (while (not ended)
-      (setq length (dns-read-bytes 1))
-      (if (= 192 (logand length (lsh 3 6)))
-	  (let ((offset (+ (* (logand 63 length) 256)
-			   (dns-read-bytes 1))))
-	    (save-excursion
-	      (when buffer
-		(set-buffer buffer))
-	      (goto-char (1+ offset))
-	      (setq ended (dns-read-name buffer))))
-	(if (zerop length)
-	    (setq ended t)
-	  (push (buffer-substring (point)
-				  (progn (forward-char length) (point)))
-		name))))
-    (if (stringp ended)
-	(if (null name)
-	    ended
-	  (concat (mapconcat 'identity (nreverse name) ".") "." ended))
-      (mapconcat 'identity (nreverse name) "."))))
-
-(defun dns-write (spec &optional tcp-p)
-  "Write a DNS packet according to SPEC.
-If TCP-P, the first two bytes of the package with be the length field."
-  (with-temp-buffer
-    (dns-write-bytes (dns-get 'id spec) 2)
-    (dns-write-bytes
-     (logior
-      (lsh (if (dns-get 'response-p spec) 1 0) -7)
-      (lsh
-       (cond
-	((eq (dns-get 'opcode spec) 'query) 0)
-	((eq (dns-get 'opcode spec) 'inverse-query) 1)
-	((eq (dns-get 'opcode spec) 'status) 2)
-	(t (error "No such opcode: %s" (dns-get 'opcode spec))))
-       -3)
-      (lsh (if (dns-get 'authoritative-p spec) 1 0) -2)
-      (lsh (if (dns-get 'truncated-p spec) 1 0) -1)
-      (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
-    (dns-write-bytes
-     (cond 
-      ((eq (dns-get 'response-code spec) 'no-error) 0)
-      ((eq (dns-get 'response-code spec) 'format-error) 1)
-      ((eq (dns-get 'response-code spec) 'server-failure) 2)
-      ((eq (dns-get 'response-code spec) 'name-error) 3)
-      ((eq (dns-get 'response-code spec) 'not-implemented) 4)
-      ((eq (dns-get 'response-code spec) 'refused) 5)
-      (t 0)))
-    (dns-write-bytes (length (dns-get 'queries spec)) 2)
-    (dns-write-bytes (length (dns-get 'answers spec)) 2)
-    (dns-write-bytes (length (dns-get 'authorities spec)) 2)
-    (dns-write-bytes (length (dns-get 'additionals spec)) 2)
-    (dolist (query (dns-get 'queries spec))
-      (dns-write-name (car query))
-      (dns-write-bytes (cadr (assq (or (dns-get 'type query) 'A)
-				   dns-query-types)) 2)
-      (dns-write-bytes (cadr (assq (or (dns-get 'class query) 'IN)
-				   dns-classes)) 2))
-    (dolist (slot '(answers authorities additionals))
-      (dolist (resource (dns-get slot spec))
-	(dns-write-name (car resource))
-      (dns-write-bytes (cadr (assq (dns-get 'type resource) dns-query-types))
-		       2)
-      (dns-write-bytes (cadr (assq (dns-get 'class resource) dns-classes))
-		       2)
-      (dns-write-bytes (dns-get 'ttl resource) 4)
-      (dns-write-bytes (length (dns-get 'data resource)) 2)
-      (insert (dns-get 'data resource))))
-    (when tcp-p
-      (goto-char (point-min))
-      (dns-write-bytes (buffer-size) 2))
-    (buffer-string)))
-
-(defun dns-read (packet)
-  (mm-with-unibyte-buffer
-    (let ((spec nil)
-	  queries answers authorities additionals)
-      (insert packet)
-      (goto-char (point-min))
-      (push (list 'id (dns-read-bytes 2)) spec)
-      (let ((byte (dns-read-bytes 1)))
-	(push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
-	      spec)
-	(let ((opcode (logand byte (lsh 7 3))))
-	  (push (list 'opcode
-		      (cond ((eq opcode 0) 'query)
-			    ((eq opcode 1) 'inverse-query)
-			    ((eq opcode 2) 'status)))
-		spec))
-	(push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
-					 nil t)) spec)
-	(push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
-	      spec)
-	(push (list 'recursion-desired-p
-		    (if (zerop (logand byte (lsh 1 0))) nil t)) spec))
-      (let ((rc (logand (dns-read-bytes 1) 15)))
-	(push (list 'response-code
-		    (cond
-		     ((eq rc 0) 'no-error)
-		     ((eq rc 1) 'format-error)
-		     ((eq rc 2) 'server-failure)
-		     ((eq rc 3) 'name-error)
-		     ((eq rc 4) 'not-implemented)
-		     ((eq rc 5) 'refused)))
-	      spec))
-      (setq queries (dns-read-bytes 2))
-      (setq answers (dns-read-bytes 2))
-      (setq authorities (dns-read-bytes 2))
-      (setq additionals (dns-read-bytes 2))
-      (let ((qs nil))
-	(dotimes (i queries)
-	  (push (list (dns-read-name)
-		      (list 'type (dns-inverse-get (dns-read-bytes 2)
-						   dns-query-types))
-		      (list 'class (dns-inverse-get (dns-read-bytes 2)
-						    dns-classes)))
-		qs))
-	(push (list 'queries qs) spec))
-    (dolist (slot '(answers authorities additionals))
-      (let ((qs nil)
-	    type)
-	(dotimes (i (symbol-value slot))
-	  (push (list (dns-read-name)
-		      (list 'type
-			    (setq type (dns-inverse-get (dns-read-bytes 2)
-							dns-query-types)))
-		      (list 'class (dns-inverse-get (dns-read-bytes 2)
-						    dns-classes))
-		      (list 'ttl (dns-read-bytes 4))
-		      (let ((length (dns-read-bytes 2)))
-			(list 'data
-			      (dns-read-type
-			       (buffer-substring
-				(point)
-				(progn (forward-char length) (point)))
-			       type))))
-		qs))
-	(push (list slot qs) spec)))
-    (nreverse spec))))
-
-(defun dns-read-int32 ()
-  ;; Full 32 bit Integers can't be handled by Emacs.  If we use
-  ;; floats, it works.
-  (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0)
-		    (dns-read-bytes 3))))
-
-(defun dns-read-type (string type)
-  (let ((buffer (current-buffer))
-	(point (point)))
-    (prog1
-	(mm-with-unibyte-buffer
-	  (insert string)
-	  (goto-char (point-min))
-	  (cond
-	   ((eq type 'A)
-	    (let ((bytes nil))
-	      (dotimes (i 4)
-		(push (dns-read-bytes 1) bytes))
-	      (mapconcat 'number-to-string (nreverse bytes) ".")))
-	   ((eq type 'AAAA)
-	    (let (hextets)
-	      (dotimes (i 8)
-		(push (dns-read-bytes 2) hextets))
-	      (mapconcat (lambda (n) (format "%x" n)) (nreverse hextets) ":")))
-	   ((eq type 'SOA)
-	    (list (list 'mname (dns-read-name buffer))
-		  (list 'rname (dns-read-name buffer))
-		  (list 'serial (dns-read-int32))
-		  (list 'refresh (dns-read-int32))
-		  (list 'retry (dns-read-int32))
-		  (list 'expire (dns-read-int32))
-		  (list 'minimum (dns-read-int32))))
-	   ((eq type 'MX)
-	    (cons (dns-read-bytes 2) (dns-read-name buffer)))
-	   ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR))
-	    (dns-read-string-name string buffer))
-	   (t string)))
-      (goto-char point))))
-
-(defun dns-parse-resolv-conf ()
-  (when (file-exists-p "/etc/resolv.conf")
-    (with-temp-buffer
-      (insert-file-contents "/etc/resolv.conf")
-      (goto-char (point-min))
-      (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t)
-	(push (match-string 1) dns-servers))
-      (setq dns-servers (nreverse dns-servers)))))
-
-;;; Interface functions.
-(defmacro dns-make-network-process (server)
-  (if (featurep 'xemacs)
-      `(let ((coding-system-for-read 'binary)
-	     (coding-system-for-write 'binary))
-	 (open-network-stream "dns" (current-buffer)
-			      ,server "domain" 'udp))
-    `(let ((server ,server)
-	   (coding-system-for-read 'binary)
-	   (coding-system-for-write 'binary))
-       (if (fboundp 'make-network-process)
-	   (make-network-process
-	    :name "dns"
-	    :coding 'binary
-	    :buffer (current-buffer)
-	    :host server
-	    :service "domain"
-	    :type 'datagram)
-	 ;; Older versions of Emacs doesn't have
-	 ;; `make-network-process', so we fall back on opening a TCP
-	 ;; connection to the DNS server.
-	 (open-network-stream "dns" (current-buffer) server "domain")))))
-
-(defun query-dns (name &optional type fullp)
-  "Query a DNS server for NAME of TYPE.
-If FULLP, return the entire record returned."
-  (setq type (or type 'A))
-  (unless dns-servers
-    (dns-parse-resolv-conf))
-
-  (if (not dns-servers)
-      (message "No DNS server configuration found")
-    (mm-with-unibyte-buffer
-      (let ((process (condition-case ()
-			 (dns-make-network-process (car dns-servers))
-		       (error
-			(message "dns: Got an error while trying to talk to %s"
-				 (car dns-servers))
-			nil)))
-	    (tcp-p (and (not (fboundp 'make-network-process))
-			(not (featurep 'xemacs))))
-	    (step 100)
-	    (times (* dns-timeout 1000))
-	    (id (random 65000)))
-	(when process
-	  (process-send-string
-	   process
-	   (dns-write `((id ,id)
-			(opcode query)
-			(queries ((,name (type ,type))))
-			(recursion-desired-p t))
-		      tcp-p))
-	  (while (and (zerop (buffer-size))
-		      (> times 0))
-	    (accept-process-output process 0 step)
-	    (decf times step))
-	  (ignore-errors
-	    (delete-process process))
-	  (when tcp-p
-	    (goto-char (point-min))
-	    (delete-region (point) (+ (point) 2)))
-	  (unless (zerop (buffer-size))
-	    (let ((result (dns-read (buffer-string))))
-	      (if fullp
-		  result
-		(let ((answer (car (dns-get 'answers result))))
-		  (when (eq type (dns-get 'type answer))
-		    (dns-get 'data answer)))))))))))
-
-(provide 'dns)
-
-;;; dns.el ends here
diff --git a/xemacs-packages/lisp/net-utils/feedmail.el b/xemacs-packages/lisp/net-utils/feedmail.el
deleted file mode 100644
index 5e48ad6a..00000000
--- a/xemacs-packages/lisp/net-utils/feedmail.el
+++ /dev/null
@@ -1,3160 +0,0 @@
-;;; feedmail.el --- assist other email packages to massage outgoing messages 
-;;; A replacement for parts of GNUemacs' sendmail.el (specifically,
-;;; it's what handles your outgoing mail after you hit C-c C-c in mail
-;;; mode).  See below for a list of additional features, including the
-;;; ability to queue messages for later sending.  If you are using
-;;; fakemail as a subprocess, you can switch to feedmail and eliminate
-;;; the use of fakemail.
-
-;;; feedmail works with recent versions of GNUemacs (20.x series) and
-;;; XEmacs (tested with 20.4 and later betas).  It probably no longer
-;;; works with GNUemacs v18, though I haven't tried that in a long
-;;; time.  Makoto.Nakagawa@jp.compaq.com reports: "I have a report
-;;; that with a help of APEL library, feedmail works fine under emacs
-;;; 19.28.  You can get APEL from ftp://ftp.m17n.org/pub/mule/apel/.
-;;; you need apel-10.2 or later to make feedmail work under emacs
-;;; 19.28."
-
-;;; Sorry, no manual yet in this release.  Look for one with the next
-;;; release.  Or the one after that.  Or maybe later.
-
-;; As far as I'm concerned, anyone can do anything they want with
-;; this specific piece of code.  No warranty or promise of support is
-;; offered.  This code is hereby released into the public domain.
-
-;; Author: WJCarpenter , 
-;; Version: 10
-;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft
-;; Where: 
-;; Thanks: My thanks to the many people who have sent me suggestions
-;;    and fixes over time, as well as those who have tested many beta
-;;    iterations.  Some are cited in comments in code fragments below,
-;;    but that doesn't correlate well with the list of folks who have
-;;    actually helped me along the way.
-
-;;; Commentary:
-;;
-;; If you use feedmail, I invite you to send me some email about it.
-;; I appreciate feedback about problems you find or suggestions for
-;; improvements or added features (even though I can't predict when
-;; I'll incorporate changes).  It's also OK with me if you send me a
-;; note along the lines of "I use feedmail and find it useful" or "I
-;; tried feedmail and didn't find it useful, so I stopped using it".
-;;
-;; It is most useful, when sending a bug report, if you tell me what
-;; version of emacs you are using, what version of feedmail you are
-;; using, and what versions of other email-related elisp packages you
-;; are using.  If in doubt about any of that, send the bug report
-;; anyhow.
-;; 
-;; =====
-;; A NOTE TO THOSE WHO WOULD CHANGE THIS CODE...  Since it is PD,
-;; you're within your rights to do whatever you want.  If you do
-;; publish a new version with your changes in it, please (1) insert
-;; lisp comments describing the changes, (2) insert lisp comments
-;; that clearly delimit where your changes are, (3) email me a copy
-;; (I can't always consistently follow the relevant usenet groups),
-;; and (4) use a version number that is based on the version you're
-;; changing along with something that indicates you changed it.  For
-;; example,
-;;
-;;        (defconst feedmail-patch-level "123")
-;;        (defconst feedmail-patch-level "123-XYZ-mods")
-;;
-;; The point of the last item, of course, is to try to minimize
-;; confusion.  Odds are good that if your idea makes sense to me that
-;; it will show up in some future version of feedmail, though it's
-;; hard to say when releases will tumble out.
-;; =====
-;;
-;; This file requires the mail-utils library.
-;;
-;; This file requires the smtpmail library if you use
-;; feedmail-buffer-to-smtpmail.  It requires the smtp library if
-;; you use feedmail-buffer-smtp.
-;;
-;; This file requires the custom library.  Unfortunately, there are
-;; two incompatible versions of the custom library.  If you don't have
-;; custom or you have the old version, this file will still load and
-;; work properly.  If you don't know what custom is all about and want
-;; to edit your user option elisp variables the old fashioned way,
-;; just imagine that all the "defcustom" stuff you see below is really
-;; "defvar", and ignore everthing else.  For info about custom, see
-;; .
-;;
-;; This code does in elisp a superset of the stuff that used to be done
-;; by the separate program "fakemail" for processing outbound email.
-;; In other words, it takes over after you hit "C-c C-c" in mail mode.
-;; By appropriate setting of options, you can still use "fakemail",
-;; or you can even revert to sendmail (which is not too popular
-;; locally).  See the variables at the top of the elisp for how to
-;; achieve these effects (there are more features than in this bullet
-;; list, so trolling through the variable and function doc strings may
-;; be worth your while):
-;;
-;;    --- you can park outgoing messages into a disk-based queue and
-;;        stimulate sending them all later (handy for laptop users);
-;;        there is also a queue for draft messages
-;;
-;;    --- you can get one last look at the prepped outbound message and
-;;        be prompted for confirmation
-;;
-;;    --- removes BCC:/RESENT-BCC: headers after getting address info
-;;
-;;    --- does smart filling of address headers
-;;
-;;    --- calls a routine to process FCC: lines and removes them
-;;
-;;    --- empty headers are removed
-;;
-;;    --- can force FROM: or SENDER: line
-;;
-;;    --- can generate a MESSAGE-ID: line
-;;
-;;    --- can generate a DATE: line; the date can be the time the
-;;        message was written or the time it is being sent
-;;
-;;    --- strips comments from address info (both "()" and "<>" are
-;;        handled via a call to mail-strip-quoted-names); the
-;;        comments are stripped in the simplified address list given
-;;        to a subprocess, not in the headers in the mail itself
-;;        (they are left unchanged, modulo smart filling)
-;;
-;;    --- error info is pumped into a normal buffer instead of the
-;;        minibuffer
-;;
-;;    --- just before the optional prompt for confirmation, lets you
-;;        run a hook on the prepped message and simplified address
-;;        list
-;;
-;;    --- you can specify something other than /bin/mail for the
-;;        subprocess
-;;
-;;    --- you can generate/modify an X-MAILER: message header
-;;
-;; After a long list of options below, you will find the function
-;; feedmail-send-it. Hers's the best way to use the stuff in this
-;; file:
-;;
-;; Save this file as feedmail.el somewhere on your elisp
-;; loadpath; byte-compile it.  Put the following lines somewhere in
-;; your ~/.emacs stuff:
-;;
-;;     (setq send-mail-function 'feedmail-send-it)
-;;     (autoload 'feedmail-send-it "feedmail")
-;;
-;; If you plan to use the queue stuff, also use this:
-;;
-;;     (setq feedmail-enable-queue t)
-;;     (autoload 'feedmail-run-the-queue "feedmail")
-;;     (autoload 'feedmail-run-the-queue-no-prompts "feedmail")
-;;     (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist))
-;;
-;; though VM users might find it more comfortable to use this instead of
-;; the above example's last line:
-;;
-;;     (setq auto-mode-alist (cons '("\\.fqm$" . feedmail-vm-mail-mode) auto-mode-alist))
-;;
-;; If you end up getting asked about killing modified buffers all the time
-;; you are probably being prompted from outside feedmail.  You can probably
-;; get cured by doing the defadvice stuff described in the documentation
-;; for the variable feedmail-queue-buffer-file-name below.
-;;
-;; If you are wondering how to send your messages to some SMTP server
-;; (which is not really a feedmail-specific issue), you are probably
-;; looking for smtpmail.el, and it is probably already present in your
-;; emacs installation.  Look at smtpmail.el for how to set that up, and
-;; then do this to hook it into feedmail:
-;;
-;;     (autoload 'feedmail-buffer-to-smtpmail "feedmail" nil t)
-;;     (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtpmail)
-;;
-;; Alternatively, the FLIM  project
-;; provides a library called smtp.el.  If you want to use that, the above lines
-;; would be:
-;;
-;;     (autoload 'feedmail-buffer-to-smtp "feedmail" nil t)
-;;     (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtp)
-;;
-;; If you are using the desktop.el library to restore your sessions, you might 
-;; like to add the suffix ".fqm" to the list of non-saved things via the variable
-;; desktop-files-not-to-save.
-;;
-;; If you are planning to call feedmail-queue-reminder from your .emacs or
-;; something similar, you might need this:
-;;
-;;     (autoload 'feedmail-queue-reminder "feedmail")
-;;
-;; If you ever use rmail-resend and queue messages, you should do this:
-;;
-;;     (setq feedmail-queue-alternative-mail-header-separator "")
-;;
-;; If you want to automatically spell-check messages, but not when sending
-;; them from the queue, you could do something like this:
-;;
-;;     (autoload 'feedmail-mail-send-hook-splitter "feedmail")
-;;     (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
-;;     (add-hook 'feedmail-mail-send-hook 'ispell-message)
-;;
-;; If you are using message-mode to compose and send mail, feedmail will
-;; probably work fine with that (someone else tested it and told me it worked).
-;; Follow the directions above, but make these adjustments instead:
-;;
-;;     (setq message-send-mail-function 'feedmail-send-it)
-;;     (add-hook 'message-mail-send-hook 'feedmail-mail-send-hook-splitter)
-;;
-;; If you use message-mode and you make use of feedmail's queueing
-;; stuff, you might also like to adjust these variables to appropriate 
-;; values for message-mode:
-;;
-;;     feedmail-queue-runner-mode-setter
-;;     feedmail-queue-runner-message-sender
-;;      
-;; If you are using the "cmail" email package, there is some built-in
-;; support for feedmail in recent versions.  To enable it, you should:
-;;
-;;     (setq cmail-use-feedmail t)
-;;
-;;;;;;;;
-;;
-;; I think the LCD is no longer being updated, but if it were, this
-;; would be a proper LCD record.  There is an old version of
-;; feedmail.el in the LCD archive.  It works but is missing a lot of
-;; features.
-;;
-;; LCD record:
-;; feedmail|WJCarpenter|bill@carpenter.ORG,bill@bubblegum.net|Outbound mail queue handling|01-04-22|10|feedmail.el
-;;
-;; Change log:
-;; original,      31 March 1991
-;; patchlevel 1,   5 April 1991
-;; patchlevel 2,  24 May   1991
-;; 5-may-92  jwz	Conditionalized calling expand-mail-aliases, since that
-;;			function doesn't exist in Lucid GNU Emacs or when using
-;;			mail-abbrevs.el.
-;; patchlevel 3,   3 October 1996
-;;         added queue stuff; still works in v18
-;; patchlevel 4, issued by someone else
-;; patchlevel 5, issued by someone else
-;; patchlevel 6, not issued as far as I know
-;; patchlevel 7,  20 May 1997
-;;         abandon futile support of GNUemacs v18 (sorry if that hurts you)
-;;         provide a DATE: header by default
-;;         provide a default for generating MESSAGE-ID: header contents
-;;            and use it by default (slightly changed API)
-;;         return value from feedmail-run-the-queue
-;;         new wrapper function feedmail-run-the-queue-no-prompts
-;;         user-mail-address as default for FROM:
-;;         properly deal with RESENT-{TO,CC,BCC}
-;;         BCC and RESENT-* now included in smart filling
-;;         limited support for a "drafts" directory
-;;         user-configurable default message action
-;;         allow timeout for confirmation prompt (where available)
-;;         move FCC handling to as late as possible to get max
-;;            header munging in the saved file
-;;         work around sendmail.el's prompts when working from queue
-;;         more reliably detect voluntary user bailouts
-;;         offer to save modified buffers visiting queue files
-;;         offer to delete old file copies of messages being queued
-;;         offer to delete queue files when sending immediately
-;;         queue filename convention preserves queue order
-;;         default queue and draft directory names that work on VMS
-;;         deduced address list now really a list, not a string (API change)
-;;         no more address buffer
-;;         when sending immediately, brief reminder of queue/draft counts
-;;         copy trace of smtpmail stuff to feedmail error buffer on no-go
-;;         more granularity on when to confirm sending
-;;         pause a bit for errors while running queue
-;;         try to clean up some pesky auto-save files from the
-;;            queue/draft directories
-;;         feedmail-force-expand-mail-aliases in case you can't figure
-;;            any other way
-;;         cleanup some of my sloppiness about case-fold-search (a strange
-;;            variable)
-;;         best effort following coding conventions from GNUemacs
-;;            elisp manual appendix
-;;         "customize" (see custom.el)
-;;         when user selects "immediate send", clear action prompt since
-;;            hooks may take a while to operate, and user may think the
-;;            response didn't take
-;;         fixes to the argument conventions for the
-;;            feedmail-queue-runner-* functions; allows
-;;            feedmail-run-the-queue[-no-prompts] to properly be called
-;;            non-interactively
-;;         eliminate reliance on directory-sep-char and feedmail-sep-thing
-;;         tweak smart filling (reminded of comma problem by levitte@lp.se)
-;;         option to control writing in text vs binary mode
-;; patchlevel 8, 15 June 1998
-;;         reliable re-editing of text-mode (vs binary) queued messages
-;;         user option to keep BCC: in FCC: copy (keep by default)
-;;         user option to delete body from FCC: copy (keep by default)
-;;         feedmail-deduce-bcc-where for envelope (API change for
-;;           feedmail-deduce-address list)
-;;         feedmail-queue-alternative-mail-header-separator
-;;         at message action prompt, "I"/"S" bypass message confirmation prompt
-;;         feedmail-mail-send-hook-splitter, feedmail-mail-send-hook,
-;;           feedmail-mail-send-hook-queued
-;;         user can supply stuff for message action prompt
-;;         variable feedmail-queue-runner-confirm-global, function feedmail-run-the-queue-global-prompt
-;;         bugfix: absolute argument to directory-files (tracked down for me
-;;           by gray@austin.apc.slb.com (Douglas Gray Stephens)); relative
-;;           pathnames can tickle stuff in ange-ftp remote directories
-;;           (perhaps because feedmail is careless about its working
-;;           directory)
-;;         feedmail-deduce-envelope-from
-;;         always supply envelope "from" (user-mail-address) to sendmail
-;;         feedmail-message-id-suffix
-;;         feedmail-queue-reminder, feedmail-queue-reminder-alist (after suggestions
-;;           and/or code fragments from tonyl@Eng.Sun.COM (Tony Lam) and
-;;           burge@newvision.com (Shane Burgess); bumped up the default value of
-;;           feedmail-queue-chatty-sit-for since info is more complex sometimes
-;;         feedmail-enable-spray (individual transmissions, crude mailmerge)
-;;         blank SUBJECT: no longer a special case; see feedmail-nuke-empty-headers
-;;         fiddle-plexes data structure used lots of places; see feedmail-fiddle-plex-blurb
-;;         feedmail-fiddle-plex-user-list
-;;         feedmail-is-a-resend
-;;         honor mail-from-style in constructing default for feedmail-from-line
-;;         re-implement feedmail-from-line and feedmail-sender-line with
-;;           fiddle-plexes; slightly modified semantics for feedmail-sender-line
-;;         feedmail-queue-default-file-slug; tidy up some other slug details
-;;         feedmail-queue-auto-file-nuke
-;;         feedmail-queue-express-to-queue and feedmail-queue-express-to-draft
-;;         strong versions of "q"ueue and "d"raft answers (always make a new file)
-;; patchlevel 9, 23 March 2001
-;;         feedmail-queue-buffer-file-name to work around undesirable mail-send prompt
-;;         at message action prompt, can scroll message buffer with "<" and ">";
-;;           C-v no longer scrolls help buffer
-;;         conditionalize (discard-input) in message action prompt to avoid killing
-;;           define-kbd-macro
-;;         fixed error if feedmail-x-mailer-line was nil
-;;         feedmail-binmail-template only uses /bin/rmail if it exists
-;;         relocate feedmail-queue-alternative-mail-header-separator stuff
-;;         added feedmail-vm-mail-mode, which make a good auto-mode-alist entry
-;;           for FQM files if you're a VM user
-;;         change buffer-substring calls to buffer-substring-no-properties for
-;;           speed-up (suggested by Howard Melman )
-;;         feedmail-sendmail-f-doesnt-sell-me-out to contol "-f" in call to sendmail
-;;           in feedmail-buffer-to-sendmail
-;;         better trapping of odd conditions during the running of the queue;
-;;           thanks to Yigal Hochberg for helping me test much of this by remote
-;;           control
-;;         feedmail-debug and feedmail-debug-sit-for
-;;         feedmail-display-full-frame
-;;         feedmail-queue-express-hook
-;;         added example function feedmail-spray-via-bbdb
-;;         use expand-file-name for setting default directory names
-;;         define feedmail-binmail-linuxish-template as a suggestion for
-;;           the value of feedmail-binmail-template on Linux and maybe other
-;;           systems with non-classic /bin/[r]mail behavior
-;;         guard against nil user-mail-address in generating MESSAGE-ID:
-;;         feedmail-queue-slug-suspect-regexp is now a variable to
-;;           accomodate non-ASCII environments (thanks to 
-;;           Makoto.Nakagawa@jp.compaq.com for this suggestion)
-;;         feedmail-buffer-to-smtp, to parallel feedmail-buffer-to-smtpmail
-;; patchlevel 10, 22 April 2001
-;;         DATE: and MESSAGE-ID stuff now forces system-time-locale to "C"
-;;           (brought to my attention by Makoto.Nakagawa@jp.compaq.com)
-;; patchlevel 11
-;;
-;; todo (probably in patchlevel 10):
-;;         write texinfo manual
-;;         maybe partition into multiple files, including files of examples
-;;
-;;; Code:
-
-(defconst feedmail-patch-level "10")
-
-(eval-when-compile (require 'smtpmail))
-
-;; from :
-;; If you write software that must work without the new custom, you
-;; can use this hack stolen from w3-cus.el:
-(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 feedmail nil
-  "Assist other email packages to massage outgoing messages."
-  :group 'mail)
-
-(defgroup feedmail-misc nil
-  "Miscellaneous feedmail options that don't fit in other groups."
-  :group 'feedmail)
-
-(defgroup feedmail-headers nil
-  "Options related to manipulating specific headers or types of headers."
-  :group 'feedmail)
-
-(defgroup feedmail-queue nil
-  "Options related to queuing messages for later sending."
-  :group 'feedmail)
-
-(defgroup feedmail-debug nil
-  "Options related to debug messages for later sending."
-  :group 'feedmail)
-
-
-(defcustom feedmail-confirm-outgoing nil
-  "*If non-nil, give a y-or-n confirmation prompt before sending mail.
-This is done after the message is completely prepped, and you'll be
-looking at the top of the message in a buffer when you get the prompt.
-If set to the symbol 'queued, give the confirmation prompt only while
-running the queue (however, the prompt is always suppressed if you are
-processing the queue via feedmail-run-the-queue-no-prompts).  If set
-to the symbol 'immediate, give the confirmation prompt only when
-sending immediately.  For any other non-nil value, prompt in both
-cases.  You can give a timeout for the prompt; see variable
-feedmail-confirm-outgoing-timeout."
-  :group 'feedmail-misc
-  :type 'boolean
-  )
-
-
-(defcustom feedmail-display-full-frame 'queued
-  "*If non-nil, show prepped messages in a full frame.
-If nil, the prepped message will be shown, for confirmation or
-otherwise, in some window in the current frame without resizing
-anything.  That may or may not display enough of the message to
-distinguish it from others.  If set to the symbol 'queued, take
-this action only when running the queue.  If set to the symbol
-'immediate, take this action only when sending immediately.  For
-any other non-nil value, take the action in both cases.  Even if
-you're not confirming the sending of immediate or queued messages,
-it can still be interesting to see a lot about them as they are
-shuttled robotically onward."
-  :group 'feedmail-misc
-  :type 'boolean
-  )
-
-
-(defcustom feedmail-confirm-outgoing-timeout nil
-  "*If non-nil, a timeout in seconds at the send confirmation prompt.
-If a positive number, it's a timeout before sending.  If a negative
-number, it's a timeout before not sending.  This will not work if your
-version of emacs doesn't include the function y-or-n-p-with-timeout
-(e.g., some versions of XEmacs)."
-  :group 'feedmail-misc
-  :type '(choice (const nil) integer)
-)
-
-
-(defcustom feedmail-nuke-bcc t
-  "*If non-nil remove BCC: lines from the message headers.
-In any case, the BCC: lines do participate in the composed address
-list.  You may want to leave them in if you're using sendmail
-(see feedmail-buffer-eating-function)."
-  :group 'feedmail-headers
-  :type 'boolean
-)
-
-
-(defcustom feedmail-nuke-resent-bcc t
-  "*If non-nil remove RESENT-BCC: lines from the message headers.
-In any case, the RESENT-BCC: lines do participate in the composed
-address list.  You may want to leave them in if you're using sendmail
-(see feedmail-buffer-eating-function)."
-  :group 'feedmail-headers
-  :type 'boolean
-)
-
-
-(defcustom feedmail-deduce-bcc-where nil
-  "*Where should BCC:/RESENT-BCC: addresses appear in the envelope list?
-Addresses for the message envelope are deduced by examining
-appropriate address headers in the message.  Generally, they will show
-up in the list of deduced addresses in the order that the headers
-happen to appear (duplicate addresses are eliminated in any case).
-This variable can be set to the symbol 'first, in which case the
-BCC:/RESENT-BCC: addresses will appear at the beginning in the list;
-or, it can be set to the symbol 'last, in which case they will appear
-at the end of the list.
-
-Why should you care?  Well, maybe you don't, and certainly the same
-things could be accomplished by affecting the order of message headers
-in the outgoing message.  Some people use BCC: as a way of getting
-their own \"come back\" copy of each message they send.  If BCC:
-addresses are not handled first, there can be substantial delays in
-seeing the message again.  Some configurations of sendmail, for example,
-seem to try to deliver to each addressee at least once, immediately
-and serially, so slow SMTP conversations can add up to a delay.  There
-is an option for either 'first or 'last because you might have a
-delivery agent that processes the addresses backwards."
-  :group 'feedmail-headers
-  :type 'boolean
-)
-
-
-(defcustom feedmail-fill-to-cc t
-  "*If non-nil do smart filling of addressee header lines.
-Smart filling means breaking long lines at appropriate points and
-making continuation lines.  Despite the function name, it includes
-TO:, CC:, BCC: (and their RESENT-* forms), as well as FROM: and
-REPLY-TO: (though they seldom need it).  If nil, the lines are left
-as-is.  The filling is done after mail address alias expansion."
-  :group 'feedmail-headers
-  :type 'boolean
-)
-
-
-(defcustom feedmail-fill-to-cc-fill-column default-fill-column
-  "*Fill column used by feedmail-fill-to-cc."
-  :group 'feedmail-headers
-  :type 'integer
-)
-
-
-(defcustom feedmail-nuke-bcc-in-fcc nil
-  "*If non-nil remove [RESENT-]BCC: lines in message copies saved via FCC:.
-This is independent of whether the BCC: header lines are actually sent
-with the message (see feedmail-nuke-bcc).  Though not implied in the name,
-the same FCC: treatment applies to both BCC: and RESENT-BCC: lines."
-  :group 'feedmail-headers
-  :type 'boolean
-)
-
-
-(defcustom feedmail-nuke-body-in-fcc nil
-  "*If non-nil remove body of message in copies saved via FCC:.
-If an positive integer value, leave (up to) that many lines of the
-beginning of the body intact.  The result is that the FCC: copy will
-consist only of the message headers, serving as a sort of an outgoing
-message log."
-  :group 'feedmail-headers
-  :type '(choice (const nil) (const t) integer)
-;;  :type 'boolean
-)
-
-
-(defcustom feedmail-force-expand-mail-aliases nil
-  "*If non-nil force the calling of expand-mail-aliases.
-Normally, feedmail tries to figure out if you're using mailalias or
-mailabbrevs and only calls expand-mail-aliases if it thinks you're
-using the mailalias package.  This user option can be used to force
-the issue since there are configurations which fool the figuring
-out."
-  :group 'feedmail-headers
-  :type 'boolean
-)
-
-
-(defcustom feedmail-nuke-empty-headers t
-  "*If non-nil, remove header lines which have no contents.
-A completely empty SUBJECT: header is always removed, regardless of
-the setting of this variable.  The only time you would want them left
-in would be if you used some headers whose presence indicated
-something rather than their contents.  This is rare in Internet email
-but common in some proprietary systems."
-  :group 'feedmail-headers
-  :type 'boolean
-)
-
-;; wjc sez:  I think the use of the SENDER: line is pretty pointless,
-;; but I left it in to be compatible with sendmail.el and because
-;; maybe some distant mail system needs it.  Really, though, if you
-;; want a sender line in your mail, just put one in there and don't
-;; wait for feedmail to do it for you.  (Yes, I know all about
-;; RFC-822 and RFC-1123, but are you *really* one of those cases
-;; they're talking about?  I doubt it.)
-(defcustom feedmail-sender-line nil
-  "*If non-nil and the email has no SENDER: header, use this value.
-May be nil, in which case nothing in particular is done with respect
-to SENDER: lines.  By design, will not replace an existing SENDER:
-line, but you can achieve that with a fiddle-plex 'replace action.
-NB: it makes no sense to use the value t since there is no sensible
-default for SENDER:.
-
-If not nil, it may be a string, a fiddle-plex, or a function which
-returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous).  If a string, it
-should be just the contents of the header, not the name of the header
-itself nor the trailing newline.  If a function, it will be called
-with no arguments.  For an explanation of fiddle-plexes, see the
-documentation for the variable feedmail-fiddle-plex-blurb.  In all
-cases the name element of the fiddle-plex is ignored and is hardwired
-by feedmail to either \"X-Sender\" or \"X-Resent-Sender\".
-
-You can probably leave this nil, but if you feel like using it, a good
-value would be a string of a fully-qualified domain name form of your
-address.  For example, \"bill@bubblegum.net (WJCarpenter)\".  The SENDER:
-header is fiddled after the FROM: header is fiddled."
-  :group 'feedmail-headers
-  :type '(choice (const nil) string)
-)
-
-
-(defcustom feedmail-force-binary-write t
-  "*If non-nil, force writing file as binary.  Applies to queues and FCC:.
-On systems where there is a difference between binary and text files,
-feedmail will temporarily manipulate the values of buffer-file-type
-and/or default-buffer-file-type to make the writing as binary.  If
-nil, writing will be in text mode.  On systems where there is no
-distinction or where it is controlled by other variables or other
-means, this option has no effect."
-  :group 'feedmail-misc
-  :type 'boolean
-)
-
-
-(defcustom feedmail-from-line t
-  "*If non-nil and the email has no FROM: header, use this value.
-May be t, in which case a default is computed (and you probably won't
-be happy with it).  May be nil, in which case nothing in particular is
-done with respect to FROM: lines.  By design, will not replace an
-existing FROM: line, but you can achieve that with a fiddle-plex 'replace
-action.
-
-If neither nil nor t, it may be a string, a fiddle-plex, or a function
-which returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous).  If a string, it
-should be just the contents of the header, not the name of the header
-itself nor the trailing newline.  If a function, it will be called
-with no arguments.  For an explanation of fiddle-plexes, see the
-documentation for the variable feedmail-fiddle-plex-blurb.  In all
-cases the name element of the fiddle-plex is ignored and is hardwired
-by feedmail to either \"X-From\" or \"X-Resent-From\".
-
-A good value would be a string fully-qualified domain name form of
-your address.  For example, \"bill@bubblegum.net (WJCarpenter)\".  The
-default value of this variable uses the standard elisp variable
-user-mail-address which should be set on every system but has a decent
-chance of being wrong.  It also honors mail-from-style.  Better to set
-this variable explicitly to the string you want or find some other way
-to arrange for the message to get a FROM: line."
-  :group 'feedmail-headers
-  :type '(choice (const nil) string)
-)
-
-
-(defcustom feedmail-sendmail-f-doesnt-sell-me-out nil
-  "*Says whether the sendmail program issues a warning header if called with \"-f\".
-The sendmail program has a useful feature to let you set the envelope FROM
-address via a command line option, \"-f\".  Unfortunately, it also has a widely
-disliked default behavior of selling you out if you do that by inserting
-an unattractive warning in the headers.  It looks something like this:
-
-  X-Authentication-Warning: u1.example.com: niceguy set sender to niceguy@example.com using -f
-
-It is possible to configure sendmail to not do this, but such a reconfiguration
-is not an option for many users.  As this is the default behavior of most
-sendmail installations, one can mostly only wish it were otherwise.  If feedmail
-believes the sendmail program will sell you out this way, it won't use the \"-f\"
-option when calling sendmail.  If it doesn't think sendmail will sell you out,
-it will use the \"-f\" \(since it is a handy feature\).  You control what
-feedmail thinks with this variable.  The default is nil, meaning that feedmail
-will believe that sendmail will sell you out."
-  :group 'feedmail-headers
-  :type 'boolean
-)
-
-
-(defcustom feedmail-deduce-envelope-from t
-  "*If non-nil, deduce message envelope \"from\" from header FROM: or SENDER:.
-In other words, if there is a SENDER: header in the message, temporarily
-change the value of user-mail-address to be the same while the message
-is being sent.  If there is no SENDER: header, use the FROM: header,
-if any.  Address values are taken from the actual message just before
-it is sent, and the process is independent of the values of
-feedmail-from-line and/or feedmail-sender-line.
-
-There are many and good reasons for having the message header
-FROM:/SENDER: be different from the message envelope \"from\"
-information.  However, for most people and for most circumstances, it
-is usual for them to be the same (this is probably especially true for
-the case where the user doesn't understand the difference between the
-two in the first place).
-
-The idea behind this feature is that you can have everything set up
-some normal way for yourself.  If for some reason you want to send a
-message with another FROM: line, you can just type it at the top of
-the message, and feedmail will take care of \"fixing up\" the envelope
-\"from\".  This only works for mail senders which make use of
-user-mail-address as the envelope \"from\" value.  For some mail
-senders (e.g., feedmail-buffer-to-bin-mail), there is no simple way to
-influence what they will use as the envelope."
-  :group 'feedmail-headers
-  :type 'boolean
-)
-
-
-(defcustom feedmail-x-mailer-line-user-appendage nil
-  "*See feedmail-x-mailer-line."
-  :group 'feedmail-headers
-  :type '(choice (const nil) string)
-)
-
-
-(defcustom feedmail-x-mailer-line t
-  "*Control the form of an X-MAILER: header in an outgoing message.
-Moderately useful for debugging, keeping track of your correspondents'
-mailer preferences, or just wearing your MUA on your sleeve.  You
-should probably know that some people are fairly emotional about the
-presence of X-MAILER: lines in email.
-
-If nil, nothing is done about X-MAILER:.
-
-If t, an X-MAILER: header of a predetermined format is produced,
-combining its efforts with any existing X-MAILER: header.  If you want
-to take the default construct and just add a little blob of your own
-at the end, define the variable feedmail-x-mailer-line-user-appendage
-as that blob string.  A value of t is equivalent to using the function 
-feedmail-default-x-mailer-generator.
-
-If neither nil nor t, it may be a string, a fiddle-plex, or a function
-which returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous).  If a string, it
-should be just the contents of the header, not the name of the header
-itself nor the trailing newline.  If a function, it will be called
-with no arguments.  For an explanation of fiddle-plexes, see the
-documentation for the variable feedmail-fiddle-plex-blurb.  In all
-cases the name element of the fiddle-plex is ignored and is hardwired
-by feedmail to either \"X-Mailer\" or \"X-Resent-Mailer\"."
-  :group 'feedmail-headers
-  :type '(choice (const t) (const nil) string function)
-)
-
-
-(defcustom feedmail-message-id-generator t
-  "*Specifies the creation of a MESSAGE-ID: header field.
-
-If nil, nothing is done about MESSAGE-ID:.
-
-If t, a MESSAGE-ID: header of a predetermined format is produced, but
-only if there is not already a MESSAGE-ID: in the message.  A value of
-t is equivalent to using the function feedmail-default-message-id-generator.
-
-If neither nil nor t, it may be a string, a fiddle-plex, or a function
-which returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous).  If a string, it
-should be just the contents of the header, not the name of the header
-itself nor the trailing newline.  If a function, it will be called
-with one argument: the possibly-nil name of the file associated with
-the message buffer.  For an explanation of fiddle-plexes, see the
-documentation for the variable feedmail-fiddle-plex-blurb.  In all
-cases the name element of the fiddle-plex is ignored and is hardwired
-by feedmail to either \"Message-ID\" or \"Resent-Message-ID\".
-
-You should let feedmail generate a MESSAGE-ID: for you unless you are sure
-that whatever you give your messages to will do it for you (e.g., most
-configurations of sendmail).  Even if the latter case is true, it
-probably won't hurt you to generate your own, and it will then show up
-in the saved message if you use FCC:."
-  :group 'feedmail-headers
-  :type '(choice (const nil) function)
-)
-
-
-(defcustom feedmail-message-id-suffix nil
-  "*If non-nil, used as a suffix in generated MESSAGE-ID: headers for uniqueness.
-The function feedmail-default-message-id-generator creates its work based
-on a formatted date-time string, a random number, and a domain-looking suffix.
-You can control the suffix used by assigning a string value to this variable.  If
-you don't supply one, the value of the variable user-mail-address will be used.
-If the value of feedmail-message-id-suffix contains an \"@\" character, the string
-will be used verbatim, else an \"@\" character will be prepended automatically."
-  :group 'feedmail-headers
-  :type 'string
-)
-
-;; this was suggested in various forms by several people; first was
-;; Tony DeSimone in Oct 1992; sorry to be so tardy
-(defcustom feedmail-date-generator t
-  "*Specifies the creation of a DATE: header field.
-
-If nil, nothing is done about DATE:.
-
-If t, a DATE: header of a predetermined format is produced, but only
-if there is not already a DATE: in the message.  A value of t is
-equivalent to using the function feedmail-default-date-generator.
-
-If neither nil nor t, it may be a string, a fiddle-plex, or a function
-which returns either nil, t, a string, or a fiddle-plex (or, in fact,
-another function, but let's not be ridiculous).  If a string, it
-should be just the contents of the header, not the name of the header
-itself nor the trailing newline.  If a function, it will be called
-with one argument: the possibly-nil name of the file associated with
-the message buffer.  For an explanation of fiddle-plexes, see the
-documentation for the variable feedmail-fiddle-plex-blurb.  In all
-cases the name element of the fiddle-plex is ignored and is hardwired
-by feedmail to either \"Date\" or \"Resent-Date\".
-
-If you decide to format your own date field, do us all a favor and know
-what you're doing.  Study the relevant parts of RFC-822 and RFC-1123.
-Don't make me come up there!
-
-You should let feedmail generate a DATE: for you unless you are sure
-that whatever you give your messages to will do it for you (e.g., most
-configurations of sendmail).  Even if the latter case is true, it
-probably won't hurt you to generate your own, and it will then show up
-in the saved message if you use FCC:."
-  :group 'feedmail-headers
-  :type '(choice (const nil) function)
-)
-
-
-(defcustom feedmail-fiddle-headers-upwardly t
-  "*Non-nil means fiddled header fields should be inserted at the top of the header.
-Nil means insert them at the bottom.  This is mostly a novelty issue since
-the standards define the ordering of header fields to be immaterial and it's
-fairly likely that some MTA/MUA along the way will have its own idea of what the
-order should be, regardless of what you specify."
-  :group 'feedmail-header
-  :type 'boolean
-  )
-
-
-(defcustom feedmail-fiddle-plex-user-list nil
-  "If non-nil, should be a list of one or more fiddle-plexes.
-Each element of the list can also be a function which returns a
-fiddle-plex.
-
-feedmail will use this list of fiddle-plexes to manipulate user-specified
-message header fields.  It does this after it has completed all normal
-message header field manipulation and before calling feedmail-last-chance-hook.
-
-For an explanation of fiddle-plexes, see the documentation for the
-variable feedmail-fiddle-plex-blurb.  In contrast to some other fiddle-plex
-manipulation functions, in this context, it makes no sense to have an element
-which is nil, t, or a simple string."
-  :group 'feedmail-header
-  :type 'list
-  )
-
-
-(defcustom feedmail-enable-spray nil
-  "If non-nil, transmit message separately to each addressee.
-feedmail normally accumulates a list of addressees and passes the message
-along with that list to a buffer-eating function which expects any number
-of addressees.  If this variable is non-nil, however, feedmail will
-repeatedly call the same buffer-eating function.  Each time, the list of
-addressees will be just one item from the original list.  This only affects
-the message envelope addresses and doesn't affect what appears in the 
-message headers except as noted.
-
-Spray mode is usually pointless, and if you can't think of a good reason for
-it, you should avoid it since it is inherently less efficient than normal 
-multiple delivery.  One reason to use it is to overcome mis-featured mail
-transports which betray your trust by revealing BCC: addressees in the
-headers of a message.  Another use is to do a crude form of mailmerge, for
-which see feedmail-spray-address-fiddle-plex-list.
-
-If one of the calls to the buffer-eating function results in an error,
-what happens next is carelessly defined, so beware.  This should get ironed
-out in some future release, and there could be other API changes for spraying
-as well."
-  :group 'feedmail-spray
-  :type 'boolean
-  )
-
-(defvar feedmail-spray-this-address nil
-  "Do not set or change this variable, except as provided via feedmail-spray-address-fiddle-plex-list.")
-
-(defcustom feedmail-spray-address-fiddle-plex-list nil
-  "User-supplied specification for a crude form of mailmerge capability.
-When spraying is enabled, feedmail composes a list of envelope addresses.
-In turn, feedmail-spray-this-address is temporarily set to each address
-\(stripped of any comments and angle brackets\) and a function is called which 
-fiddles message headers according to this variable.  For an overview of
-fiddle-plex data structures, see the documentation for feedmail-fiddle-plex-blurb.
-
-May be nil, in which case nothing in particular is done about message
-headers for specific addresses.
-
-May be t, in which case a \"TO:\" header is added to the message with
-the stripped address as the header contents.  The fiddle-plex operator
-is 'supplement.
-
-May be a string, in which case the string is assumed to be the name of
-a message header field with the stripped address serving as the value.
-The fiddle-plex operator is 'supplement.
-
-May be a function, in which case it is called with no arguments and is
-expected to return nil, t, a string, another function, or a fiddle-plex.
-The result is used recursively.  The function may alter the value of the
-variable feedmail-spray-this-address, perhaps to embellish it with a 
-human name.  It would be logical in such a case to return as a value a
-string naming a message header like \"TO\" or an appropriately constructed
-fiddle-plex.  For an example, see feedmail-spray-via-bbdb.
-
-May be a list of any combination of the foregoing and/or
-fiddle-plexes.  (A value for this variable which consists of a single
-fiddle-plex must be nested inside another list to avoid ambiguity.)
-If a list, each item is acted on in turn as described above.
-
-For example,
-
-  (setq feedmail-spray-address-fiddle-plex-list 'feedmail-spray-via-bbdb)
-
-The idea of the example is that, during spray mode, as each message is
-about to be transmitted to an individual address, the function will be
-called and will consult feedmail-spray-this-address to find the
-stripped envelope email address (no comments or angle brackets).  The
-function should return an embellished form of the address.
-
-The recipe for sending form letters is:  (1) create a message with all
-addressees on BCC: headers; (2) tell feedmail to remove BCC: headers
-before sending the message; (3) create a function which will embellish 
-stripped addresses, if desired; (4) define feedmail-spray-address-fiddle-plex-list
-appropriately; (5) send the message with feedmail-enable-spray set
-non-nil; (6) stand back and watch co-workers wonder at how efficient
-you are at accomplishing inherently inefficient things."
-  :group 'feedmail-spray
-  :type 'list
-  )
-
-;; jwj -- Get the definition of bbdb-search
-(eval-when-compile (require 'bbdb-com))
-
-(defun feedmail-spray-via-bbdb ()
-  "Example function for use with feedmail spray mode.
-NB: it's up to the user to have the BBDB environment already set up properly
-before using this."
-  (let (net-rec q-net-addy embellish)
-	(setq q-net-addy (concat "^" (regexp-quote feedmail-spray-this-address) "$"))
-	(setq net-rec (bbdb-search (bbdb-records) nil nil q-net-addy))
-	(if (and (car net-rec) (not (cdr net-rec)))
-		(setq net-rec (car net-rec))
-	  (setq net-rec nil))
-	(if net-rec (setq embellish (bbdb-dwim-net-address net-rec)))
-	(if embellish
-		(list "To" embellish 'supplement)
-	  (list "To" feedmail-spray-this-address 'supplement))))
-
-
-(defcustom feedmail-enable-queue nil
-  "*If non-nil, provide for stashing outgoing messages in a queue.
-This is the master on/off switch for feedmail message queuing.
-Queuing is quite handy for laptop-based users.  It's also handy if you
-get a lot of mail and process it more or less sequentially.  For
-example, you might change your mind about contents of a reply based on
-a message you see a bit later.
-
-There is a separate queue for draft messages, intended to prevent
-you from accidentally sending incomplete messages.  The queues are
-disk-based and intended for later transmission.  The messages are
-queued in their raw state as they appear in the mail-mode buffer and
-can be arbitrarily edited later, before sending, by visiting the
-appropriate file in the queue directory (and setting the buffer to
-mail-mode or whatever).  If you visit a file in the queue directory
-and try to queue it again, it will just get saved in its existing file
-name.  You can move a message from the draft to the main queue or vice
-versa by pretending to send it and then selecting whichever queue
-directory you want at the prompt.  The right thing will happen.
-
-To transmit all the messages in the queue, invoke the command
-feedmail-run-the-queue or feedmail-run-the-queue-no-prompts."
-  :group 'feedmail-queue
-  :type 'boolean
-)
-
-
-(defcustom feedmail-queue-runner-confirm-global nil
-  "*If non-nil, give a y-or-n confirmation prompt before running the queue.
-Prompt even if the queue is about to be processed as a result of a call to
-feedmail-run-the-queue-no-prompts.  This gives you a way to bail out
-without having to answer no to the individual message prompts."
-  :group 'feedmail-queue
-  :type 'boolean)
-
-
-;; I provided a default for VMS because someone asked for it (the
-;; normal default doesn't work there), but, puh-lease!, it is a user
-;; definable option, so if you don't like the default, change it to
-;; whatever you want.  I am unable to directly test the VMS goop
-;; provided here by levitte@lp.se (Richard Levitte - VMS Whacker).
-(defcustom feedmail-queue-directory
-  (if (memq system-type '(axp-vms vax-vms))
-      (expand-file-name (concat (getenv "HOME") "[.MAIL.Q]"))
-	(expand-file-name "~/mail/q"))
-  "*Name of a directory where messages will be queued.
-Directory will be created if necessary.  Should be a string that
-doesn't end with a slash.  Default, except on VMS, is \"~/mail/q\"."
-  :group 'feedmail-queue
-  :type 'string
-)
-
-
-(defcustom feedmail-queue-draft-directory
-  (if (memq system-type '(axp-vms vax-vms))
-      (expand-file-name (concat (getenv "HOME") "[.MAIL.DRAFT]"))
-	(expand-file-name "~/mail/draft"))
-  "*Name of an directory where DRAFT messages will be queued.
-Directory will be created if necessary.  Should be a string that
-doesn't end with a slash.  Default, except on VMS, is \"~/mail/draft\"."
-  :group 'feedmail-queue
-  :type 'string
-)
-
-
-(defcustom feedmail-ask-before-queue t
-  "*If non-nil, feedmail will ask what you want to do with the message.
-Default choices for the message action prompt will include sending it
-immediately, putting it in the main queue, putting it in the draft
-queue, or returning to the buffer to continue editing.  Only matters if
-queuing is enabled.  If nil, the message is placed in the main queue
-without a prompt."
-  :group 'feedmail-queue
-  :type 'boolean
-)
-
-
-(defcustom feedmail-ask-before-queue-prompt "FQM: Message action (q, i, d, e, ?)? [%s]: "
-  "*A string which will be used for the message action prompt.
-If it contains a \"%s\", that will be replaced with the value of
-feedmail-ask-before-queue-default."
-  :group 'feedmail-queue
-  :type 'string
-)
-
-
-(defcustom feedmail-ask-before-queue-reprompt "FQM: Please type q, i, d, or e; or ? for help [%s]: "
-  "*A string which will be used for repompting after invalid input.
-If it contains a \"%s\", that will be replaced with the value of
-feedmail-ask-before-queue-default."
-  :group 'feedmail-queue
-  :type 'string
-)
-
-
-(defcustom feedmail-ask-before-queue-default "queue"
-  "*Meaning if user hits return in response to the message action prompt.
-Should be a character or a string; if a string, only the first
-character is significant.  Useful values are those described in
-the help for the message action prompt."
-  :group 'feedmail-queue
-  :type '(choice string integer)		;use integer to get char
-)
-
-
-(defvar feedmail-prompt-before-queue-standard-alist
-  '((?q . feedmail-message-action-queue)
-	(?Q . feedmail-message-action-queue-strong)
-
-	(?d . feedmail-message-action-draft)
-	(?r . feedmail-message-action-draft)
-	(?D . feedmail-message-action-draft-strong)
-	(?R . feedmail-message-action-draft-strong)
-
-	(?e . feedmail-message-action-edit)
-	(?E . feedmail-message-action-edit)
-	(?\C-g . feedmail-message-action-edit)
-	(?n . feedmail-message-action-edit)
-	(?N . feedmail-message-action-edit)
-
-	(?i . feedmail-message-action-send)
-	(?I . feedmail-message-action-send-strong)
-	(?s . feedmail-message-action-send)
-	(?S . feedmail-message-action-send-strong)
-
-	(?* . feedmail-message-action-toggle-spray)
-
-	(?> . feedmail-message-action-scroll-up)
-	(?< . feedmail-message-action-scroll-down)
-	(?  . feedmail-message-action-scroll-up)
-;;	(?\C-v . feedmail-message-action-help)
-	(?? . feedmail-message-action-help))
-  "An alist of choices for the message action prompt.
-All of the values are function names, except help, which is a special
-symbol that calls up help for the prompt (the help describes the
-actions from the standard alist).  To customize your own choices,
-define a similar alist called feedmail-prompt-before-queue-user-alist.
-The actual alist used for message action will be the standard alist
-overlaid with the user-alist.  To neutralize an item in the standard
-alist without providing a replacement, define an appropriate element
-in the user alist with a value of nil." )
-
-
-(defcustom feedmail-prompt-before-queue-user-alist nil
-  "See feedmail-prompt-before-queue-standard-alist."
-  :group 'feedmail-queue
-  :type 'alist
-  )
-
-
-(defcustom feedmail-prompt-before-queue-help-supplement nil
-  "User-provided supplementary help string for the message action prompt.
-When the message action prompt is shown, the user can as for verbose help,
-at which point a buffer pops up describing the meaning of possible
-responses to the prompt.  Through various customizations (see, for
-example, feedmail-prompt-before-queue-user-alist), the available responses
-and the prompt itself can be changed.  If this variable is set to a string
-value, that string is written to the help buffer after the standard info.
-It may contain embedded line breaks.  It will be printed via princ."
-  :group 'feedmail-queue
-  :type 'string
-  )
-
-
-(defcustom feedmail-queue-reminder-alist
-  '((after-immediate . feedmail-queue-reminder-brief)
-	(after-queue . feedmail-queue-reminder-medium)
-	(after-draft . feedmail-queue-reminder-medium)
-	(after-run . feedmail-queue-reminder-brief)
-	(on-demand . feedmail-run-the-queue-global-prompt))
-  "See feedmail-queue-reminder."
-  :group 'feedmail-queue
-  :type 'alist
-  )
-
-
-(defcustom feedmail-queue-chatty t
-  "*If non-nil, blat a few status messages and such in the mini-buffer.
-If nil, just do the work and don't pester people about what's going on.
-In some cases, though, specific options inspire mini-buffer prompting.
-That's not affected by this variable setting.  Also does not control
-reporting of error/abnormal conditions."
-  :group 'feedmail-queue
-  :type 'boolean
-)
-
-
-(defcustom feedmail-queue-chatty-sit-for 2
-  "*Duration of pause after most queue-related messages.
-After some messages are divulged, it is prudent to pause before
-something else obliterates them.  This value controls the duration of
-the pause."
-  :group 'feedmail-queue
-  :type 'integer
-)
-
-
-(defcustom feedmail-queue-run-orderer nil
-  "*If non-nil, name a function which will sort the queued messages.
-The function is called during a running of the queue for sending, and
-takes one argument, a list of the files in the queue directory.  It
-may contain the names of non-message files, and it's okay to leave
-them in the list when reordering it; they get skipped over later.
-When nil, the default action processes the messages in normal sort
-order by queued file name, which will typically result in the order
-they were placed in the queue."
-  :group 'feedmail-queue
-  :type '(choice (const nil) function)
-)
-
-
-(defcustom feedmail-queue-use-send-time-for-date nil
-  "*If non-nil, use send time for the DATE: header value.
-This variable is used by the default date generating function,
-feedmail-default-date-generator.  If nil, the default, the
-last-modified timestamp of the queue file is used to create the
-message DATE: header; if there is no queue file, the current time is
-used.  If you are using VM, it might be supplying this header for
-you.  To suppress VM's version
-
-	(setq vm-mail-header-insert-date nil)"
-  :group 'feedmail-queue
-  :type 'boolean
-)
-
-
-(defcustom feedmail-queue-use-send-time-for-message-id nil
-  "*If non-nil, use send time for the MESSAGE-ID: header value.
-This variable is used by the default MESSAGE-ID: generating function,
-feedmail-default-message-id-generator.  If nil, the default, the
-last-modified timestamp of the queue file is used to create the
-message MESSAGE-ID: header; if there is no queue file, the current time is
-used.  If you are using VM, it might be supplying this header for
-you.  To suppress VM's version
-
-	(setq vm-mail-header-insert-message-id nil)"
-  :group 'feedmail-queue
-  :type 'boolean
-)
-
-
-(defcustom feedmail-ask-for-queue-slug nil
-  "*If non-nil, prompt user for part of the queue file name.
-The file will automatically get the FQM suffix and an embedded
-sequence number for uniqueness, so don't specify that.  feedmail will
-get rid of all characters other than alphanumeric and hyphen in the
-results.  If this variable is nil or if you just hit return in
-response to the prompt, feedmail queuing will take care of things
-properly.  At the prompt, completion is available if you want to see
-what filenames are already in use, though, as noted, you will not be
-typing a complete file name.  You probably don't want to be bothered
-with this prompting since feedmail, by default, uses queue file names
-based on the subjects of the messages."
-  :group 'feedmail-queue
-  :type 'boolean
-)
-
-
-(defcustom feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker
-  "*If non-nil, a function which creates part of the queued file name.
-Takes a single argument giving the name of the directory into
-which the message will be queued.  The returned string should be just
-the non-directory filename part, without FQM suffix or uniquifying
-sequence numbers.  The current buffer holds the raw message.  The
-default function creates the slug based on the message subject, if
-any."
-  :group 'feedmail-queue
-  :type '(choice (const nil) function)
-)
-
-
-(defcustom feedmail-queue-slug-suspect-regexp "[^a-z0-9-]+"
-  "*Regular expression for characters/substrings to be replaced.
-When feedmail creates a filename from a subject string, it puts hyphens
-in place of strings which may cause problems in filenames.  By default,
-only alphanumeric and hyphen characters are kept, and all others are
-converted.  In non-ASCII environments, it may be more helpful to
-tweak this regular expression to reflect local or personal language 
-conventions.  Substitutions are done repeatedly until the regular expression
-no longer matches to transformed string.  Used by function
-feedmail-tidy-up-slug and indirectly by feedmail-queue-subject-slug-maker."
-  :group 'feedmail-queue
-  :type 'string
-)
-
-
-(defcustom feedmail-queue-default-file-slug t
-  "*Indicates what to use for subject-less messages when forming a file name.
-When feedmail queues a message, it creates a unique file name.  By default, 
-the file name is based in part on the subject of the message being queued.
-If there is no subject, consult this variable.  See documentation for the
-function feedmail-queue-subject-slug-maker.
-
-If t, an innocuous default is used.
-
-If a string, it is used directly.
-
-If a function, it is called with no arguments from the buffer containing the raw
-text of the message.  It must return a string (which may be empty).
-
-If the symbol 'ask, you will be prompted for a string in the mini-buffer.
-Filename completion is available so that you can inspect what's already been
-used, but feedmail will do further manipulation on the string you return, so
-it's not expected to be a complete filename."
-  :group 'feedmail-queue
-  :type 'string
-)
-
-
-(defcustom feedmail-queue-fqm-suffix ".fqm"
-  "*The FQM suffix used to distinguish feedmail queued message files.
-You probably want this to be a period followed by some letters and/or
-digits.  The distinction is to be able to tell them from other random
-files that happen to be in the feedmail-queue-directory or
-feedmail-queue-draft-directory. By the way, FQM stands for feedmail
-queued message."
-  :group 'feedmail-queue
-  :type 'string
-)
-
-
-(defcustom feedmail-nuke-buffer-after-queue nil
-  "*If non-nil, silently kill the buffer after a message is queued.
-You might like that since a side-effect of queueing the message is
-that its buffer name gets changed to the filename.  That means that
-the buffer won't be reused for the next message you compose.  If you
-are using VM for creating messages, you probably want to leave this
-nil, since VM has its own options for managing the recycling of
-message buffers."
-  :group 'feedmail-queue
-  :type 'boolean
-)
-
-
-(defcustom feedmail-queue-auto-file-nuke nil
-  "*If non-nil, automatically delete queue files when a message is sent.
-Normally, feedmail will notice such files when you send a message in
-immediate mode (i.e., not when you're running the queue) and will ask if
-you want to delete them.  Since the answer is usually yes, setting this
-variable to non-nil will tell feedmail to skip the prompt and just delete 
-the file without bothering you."
-  :group 'feedmail-queue
-  :type 'boolean
-)
-
-
-(defcustom feedmail-debug nil
-  "*If non-nil, blat a debug messages and such in the mini-buffer.
-This is intended as an aid to tracing what's going on but is probably
-of casual real use only to the feedmail developer."
-  :group 'feedmail-debug
-  :type 'boolean
-)
-
-
-(defcustom feedmail-debug-sit-for 0
-  "*Duration of pause after feedmail-debug messages.
-After some messages are divulged, it may be helpful to pause before
-something else obliterates them.  This value controls the duration of
-the pause.  If the value is nil or 0, the sit-for is not done, which
-has the effect of not pausing at all.  Debug messages can be seen after
-the fact in the messages buffer."
-  :group 'feedmail-debug
-  :type 'integer
-)
-
-
-(defvar feedmail-queue-buffer-file-name nil
-  "If non-nil, has the value normally expected of 'buffer-file-name'.
-You are not intended to set this to something in your configuration.  Rather,
-you might programmatically set it to something via a hook or function
-advice or whatever.  You might like to do this if you are using a mail 
-composition program that eventually uses sendmail.el's 'mail-send'
-function to process the message.  If there is a filename associated
-with the message buffer, 'mail-send' will ask you for confirmation.
-There's no trivial way to avoid it.  It's unwise to just set the value 
-of 'buffer-file-name' to nil because that will defeat feedmail's file
-management features.  Instead, arrange for this variable to be set to
-the value of 'buffer-file-name' before setting that to nil.  An easy way 
-to do that would be with defadvice on 'mail-send' \(undoing the
-assignments in a later advice\).
-
-feedmail will pretend that 'buffer-file-name', if nil, has the value
-assigned of 'feedmail-queue-buffer-file-name' and carry out its normal 
-activities.  feedmail does not restore the non-nil value of
-'buffer-file-name'.  For safe bookkeeping, the user should insure that 
-feedmail-queue-buffer-file-name is restored to nil.
-
-Example 'defadvice' for mail-send:
-
-   (defadvice mail-send (before feedmail-mail-send-before-advice activate)
-     (setq feedmail-queue-buffer-file-name buffer-file-name)
-     (setq buffer-file-name nil))
-   
-   (defadvice mail-send (after feedmail-mail-send-after-advice activate)
-     (if feedmail-queue-buffer-file-name (setq buffer-file-name feedmail-queue-buffer-file-name))
-     (setq feedmail-queue-buffer-file-name nil))
-")
-
-;; defvars to make byte-compiler happy(er)
-(defvar feedmail-error-buffer        nil "not a user option variable")
-(defvar feedmail-prepped-text-buffer nil "not a user option variable")
-(defvar feedmail-raw-text-buffer     nil "not a user option variable")
-(defvar feedmail-address-list        nil "not a user option variable")
-
-
-(defun feedmail-mail-send-hook-splitter ()
-  "Facilitate dividing mail-send-hook things into queued and immediate cases.
-If you have mail-send-hook functions that should only be called for sending/
-queueing messages or only be called for the sending of queued messages, this is
-for you.  Add this function to mail-send-hook with something like this:
-
-	(add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
-
-Then add the functions you want called to either feedmail-mail-send-hook-queued
-or feedmail-mail-send-hook, as apprpriate.  The distinction is that
-feedmail-mail-send-hook will be called when you send mail from a composition
-buffer (typically by typing C-c C-c), whether the message is sent immediately
-or placed in the queue or drafts directory.  feedmail-mail-send-hook-queued is
-called when messages are being sent from the queue directory, typically via a
-call to feedmail-run-the-queue."
-  (feedmail-say-debug ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active)
-  (if feedmail-queue-runner-is-active
-	  (run-hooks 'feedmail-mail-send-hook-queued)
-	(run-hooks 'feedmail-mail-send-hook))
-)
-
-
-(defvar feedmail-mail-send-hook nil
-  "*See documentation for feedmail-mail-send-hook-splitter.")
-
-
-(defvar feedmail-mail-send-hook-queued nil
-  "*See documentation for feedmail-mail-send-hook-splitter.")
-
-
-(defun feedmail-confirm-addresses-hook-example ()
-  "An example of a feedmail-last-chance-hook.
-It shows the simple addresses and gets a confirmation.  Use as:
- (setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example)."
-  (save-window-excursion
-	(display-buffer (set-buffer (get-buffer-create " F-C-A-H-E")))
-	(erase-buffer)
-	(insert (mapconcat 'identity feedmail-address-list " "))
-	(if (not (y-or-n-p "How do you like them apples? "))
-		(error "FQM: Sending...gave up in last chance hook")
-	  )))
-
-
-(defcustom feedmail-last-chance-hook nil
-  "*User's last opportunity to modify the message on its way out.
-It has already had all the header prepping from the standard package.
-The next step after running the hook will be to push the buffer into a
-subprocess that mails the mail.  The hook might be interested in
-these: (1) feedmail-prepped-text-buffer contains the header and body
-of the message, ready to go; (2) feedmail-address-list contains a list
-of simplified recipients of addresses which are to be given to the
-subprocess (the hook may change the list); (3) feedmail-error-buffer
-is an empty buffer intended to soak up errors for display to the user.
-If the hook allows interactive activity, the user should not send more
-mail while in the hook since some of the internal buffers will be
-reused and things will get confused."
-  :group 'feedmail-misc
-  :type 'hook
-)
-
-
-(defcustom feedmail-before-fcc-hook nil
-  "*User's last opportunity to modify the message before FCC action.
-When this hook runs, the current buffer is already the appropriate
-buffer.  It has already had all the header prepping from the standard
-package.  The next step after running the hook will be to save the
-message via FCC: processing. The hook might be interested in these:
-(1) feedmail-prepped-text-buffer contains the header and body of the
-message, ready to go; (2) feedmail-address-list contains a list of
-simplified recipients of addressees to whom the message was sent (3)
-feedmail-error-buffer is an empty buffer intended to soak up errors
-for display to the user.  If the hook allows interactive activity, the
-user should not send more mail while in the hook since some of the
-internal buffers will be reused and things will get confused.  It's
-not necessary to arrange for the undoing of any changes you make to
-the buffer."
-  :group 'feedmail-misc
-  :type 'hook
-)
-
-(defcustom feedmail-queue-express-hook nil
-  "*Chance to modify a message being sent directly to a queue.
-Run by feedmail-queue-express-to-queue and feedmail-queue-express-to-draft.
-For example, you might want to run vm-mime-encode-composition to take
-care of attachments.  If you subsequently edit the message buffer, you
-can undo the encoding."
-  :group 'feedmail-queue
-  :type 'hook
-)
-
-(defcustom feedmail-queue-runner-mode-setter
-  '(lambda (&optional arg) (mail-mode))
-  "*A function to set the proper mode of a message file.  Called when
-the message is read back out of the queue directory with a single
-argument, the optional argument used in the call to
-feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
-
-Most people want mail-mode, so the default value is an anonymous
-function which is just a wrapper to ignore the supplied argument when
-calling it, but here's your chance to have something different.
-If you are a VM user, you might like feedmail-vm-mail-mode, though you
-really don't need that \(and it's not particularly well-tested\).
-
-Called with funcall, not call-interactively."
-  :group 'feedmail-queue
-  :type 'function
-)
-
-
-(defcustom feedmail-queue-alternative-mail-header-separator nil
-  "*Alternative header demarcation for queued messages.
-If you sometimes get alternative values for mail-header-separator in
-queued messages, set the value of this variable to whatever it is.
-For example, rmail-resend uses a mail-header-separator value of empty
-string (\"\") when you send/queue a message.
-
-When trying to send a queued message, if the value of this variable is
-non-nil, feedmail will first try to send the message using the value
-of mail-header-separator.  If it can't find that, it will temporarily
-set mail-header-separator to the value of
-feedmail-queue-alternative-mail-header-separator and try again."
-  :group 'feedmail-queue
-  :type 'string
-)
-
-
-(defcustom feedmail-queue-runner-message-sender
-  '(lambda (&optional arg) (mail-send))
-  "*Function to initiate sending a message file.
-Called for each message read back out of the queue directory with a
-single argument, the optional argument used in the call to
-feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
-Interactively, that argument will be the prefix argument.  
-Most people want mail-send (bound to C-c C-s in mail-mode), but here's
-your chance to have something different.  The default value is just a
-wrapper function which discards the optional argument and calls
-mail-send.  If you are a VM user, you might like vm-mail-send, though
-you really don't need that.  Called with funcall, not call-interactively."
-  :group 'feedmail-queue
-  :type 'function
-)
-
-
-(defcustom feedmail-queue-runner-cleaner-upper
-  '(lambda (fqm-file &optional arg)
-	 (delete-file fqm-file)
-	 (if arg (feedmail-say-chatter "Nuked %s" fqm-file)))
-  "*Function that will be called after a message has been sent.  It's
-not called in the case of errors.  This function is called with two
-arguments, the name of the message queue file for the message just
-sent, and the optional argument used in the call to
-feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
-Interactively, that argument will be the prefix argument.  In any
-case, the affiliated buffer is killed elsewhere, so don't do that
-inside this function.  Return value is ignored.
-
-The default action is an anonymous function which gets rid of the file
-from the queue directory.  With a non-nil second argument, a brief
-message is give for each file deleted.  You could replace this
-function, for example, to archive all of your sent messages someplace
-(though there are better ways to get that particular result)."
-  :group 'feedmail-queue
-  :type 'function
-)
-
-
-(defvar feedmail-queue-runner-is-active nil
-  "*Non-nil means we're inside the logic of the queue-running loop.
-That is, iterating over all messages in the queue to send them.  In
-that case, the value is the name of the queued message file currently
-being processed.  This can be used for differentiating customized code
-for different scenarios.  Users shouldn't set or change this
-variable, but may depend on its value as described here.")
-
-
-(defvar feedmail-is-a-resend nil
-  "*Non-nil means the the message is a RESEND (in the RFC-822 sense).
-This affects the composition of certain headers.  feedmail sets this
-variable as soon as it starts prepping the message text buffer, so any
-user-supplied functions can rely on it.  Users shouldn't set or change this
-variable, but may depend on its value as described here.")
-
-
-(defcustom feedmail-buffer-eating-function 'feedmail-buffer-to-binmail
-  "*Function used to send the prepped buffer to a subprocess.
-The function's three (mandatory) arguments are: (1) the buffer
-containing the prepped message; (2) a buffer where errors should be
-directed; and (3) a list containing the addresses individually as
-strings.  Popular choices for this are feedmail-buffer-to-binmail,
-feedmail-buffer-to-smtpmail, feedmail-buffer-to-sendmail, and
-feedmail-buffer-to-smtp.  If you use the sendmail form, you probably
-want to set feedmail-nuke-bcc and/or feedmail-nuke-resent-bcc to nil.
-If you use the binmail form, check the value of
-feedmail-binmail-template."
-  :group 'feedmail-misc
-  :type 'function
-)
-
-
-(defconst feedmail-binmail-linuxish-template
-  (concat 
-  "(echo From "
-  (if (boundp 'user-login-name) user-login-name "feedmail")
-  " ; cat -) | /usr/bin/rmail %s")
-  "*Good candidate for Linux systems and maybe others.
-You may need to modify this if your \"rmail\" is in a different place.
-For example, I hear that in some Debian systems, it's /usr/sbin/rmail.
-See feedmail-binmail-template documentation."
-)
-
-
-(defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s"
-									   (if (file-exists-p "/bin/rmail")
-										   "/bin/rmail %s" "/bin/mail %s"))
-  "*Command template for the subprocess which will get rid of the
-mail.  It can result in any command understandable by /bin/sh.  Might
-not work at all in non-UNIX environments.  The single '%s', if
-present, gets replaced by the space-separated, simplified list of
-addressees.  Used in feedmail-buffer-to-binmail to form the shell
-command which will receive the contents of the prepped buffer as
-stdin.  The default value uses /bin/rmail (if it exists) unless
-mail-interactive has been set non-nil.
-
-If you'd like your errors to come back as mail instead of immediately
-in a buffer, try /bin/rmail instead of /bin/mail.  If /bin/rmail
-exists, this can be accomplished by keeping the default nil setting of
-mail-interactive.  You might also like to consult local mail experts
-for any other interesting command line possibilities.  Some versions
-of UNIX have an rmail program which behaves differently than
-/bin/rmail and complains if feedmail gives it a message on stdin.  If
-you don't know about such things and if there is no local expert to
-consult, stick with /bin/mail or use one of the other buffer eating
-functions.
-
-The above description applies to \"classic\" UNIX /bin/mail and /bin/rmail.
-On most Linux systems and perhaps other places, /bin/mail behaves
-completely differently and shouldn't be used at all in this template.
-Instead of /bin/rmail, there is a /usr/bin/rmail, and it can be used
-with a wrapper.  The wrapper is necessary because /usr/bin/rmail on such
-systems requires that the first line of the message appearing on standard
-input have a UNIX-style From_ postmark.  If you have such a system, the
-wrapping can be accomplished by setting the value of feedmail-binmail-template
-to 'feedmail-binmail-linuxish-template'.  You should then send some test
-messages to make sure it works as expected."
-  :group 'feedmail-misc
-  :type 'string
-)
-
-
-;; feedmail-buffer-to-binmail, feedmail-buffer-to-sendmail, and
-;; feedmail-buffer-to-smptmail are the only things provided for values
-;; for the variable feedmail-buffer-eating-function.  It's pretty easy
-;; to write your own, though.
-(defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid)
-  "Function which actually calls /bin/mail as a subprocess.
-Feeds the buffer to it."
-  (feedmail-say-debug ">in-> feedmail-buffer-to-binmail %s" addr-listoid)
-  (set-buffer prepped)
-  (apply
-   'call-process-region
-   (append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c"
-				 (format feedmail-binmail-template
-						 (mapconcat 'identity addr-listoid " "))))))
-
-
-(defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid)
-  "Function which actually calls sendmail as a subprocess.
-Feeds the buffer to it.  Probably has some flaws for RESENT-* and
-other complicated cases.  Takes addresses from message headers and
-might disappoint you with BCC: handling.  In case of odd results, consult
-local gurus."
-  (feedmail-say-debug ">in-> feedmail-buffer-to-sendmail %s" addr-listoid)
-  (set-buffer prepped)
-  (apply 'call-process-region
-		 (append (list (point-min) (point-max)
-					   (if (boundp 'sendmail-program) sendmail-program "/usr/lib/sendmail")
-					   nil errors-to nil "-oi" "-t")
-				 ;; provide envelope "from" to sendmail; results will vary
-				 (if feedmail-sendmail-f-doesnt-sell-me-out (list "-f" user-mail-address))
-				 ;; These mean "report errors by mail" and "deliver in background".
-				 (if (null mail-interactive) '("-oem" "-odb")))))
-
-;; provided by jam@austin.asc.slb.com (James A. McLaughlin);
-;; simplified by WJC after more feedmail development;
-;; idea (but not implementation) of copying smtpmail trace buffer to
-;; feedmail error buffer from:
-;;   Mon 14-Oct-1996; Douglas Gray Stephens
-;;   modified to insert error for displaying
-(defun feedmail-buffer-to-smtpmail (prepped errors-to addr-listoid)
-  "Function which actually calls smtpmail-via-smtp to send buffer as e-mail."
-  ;; I'm not sure smtpmail.el is careful about the following
-  ;; return value, but it also uses it internally, so I will fear
-  ;; no evil.
-  (feedmail-say-debug ">in-> feedmail-buffer-to-smtpmail %s" addr-listoid)
-  (require 'smtpmail)
-  (if (not (smtpmail-via-smtp addr-listoid prepped))
-	  (progn
-		(set-buffer errors-to)
-		(insert "Send via smtpmail failed.  Probable SMTP protocol error.\n")
-		(insert "Look for details below or in the *Messages* buffer.\n\n")
-		(let ((case-fold-search t)
-			  ;; don't be overconfident about the name of the trace buffer
-			  (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server))))
-		  (mapcar
-		   '(lambda (buffy)
-			  (if (string-match tracer (buffer-name buffy))
-				  (progn
-					(insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
-					(insert-buffer buffy)
-					(insert "\n\n"))))
-		   (buffer-list))))))
-
-;; FLIM's smtp.el pointed out to me by Kenichi Handa 
-(defun feedmail-buffer-to-smtp (prepped errors-to addr-listoid)
-  "Function which actually calls smtp-via-smtp to send buffer as e-mail."
-  (feedmail-say-debug ">in-> feedmail-buffer-to-smtp %s" addr-listoid)
-  (require 'smtp)
-  (if (not (smtp-via-smtp user-mail-address addr-listoid prepped))
-	  (progn
-		(set-buffer errors-to)
-		(insert "Send via smtp failed.  Probable SMTP protocol error.\n")
-		(insert "Look for details below or in the *Messages* buffer.\n\n")
-		(let ((case-fold-search t)
-			  ;; don't be overconfident about the name of the trace buffer
-			  (tracer (concat "trace.*smtp.*" (regexp-quote smtp-server))))
-		  (mapcar
-		   '(lambda (buffy)
-			  (if (string-match tracer (buffer-name buffy))
-				  (progn
-					(insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
-					(insert-buffer buffy)
-					(insert "\n\n"))))
-		   (buffer-list))))))
-
-;; just a place to park a docstring
-(defconst feedmail-fiddle-plex-blurb nil
-  "A fiddle-plex is a concise way of specifying how to fiddle with a header field.
-It is a list of up to 4 elements: NAME, VALUE, ACTION, FOLDING.  The element
-VALUE can also be a list sometimes.
-
-NAME is the name of the header field to be fiddled with.  Although case doesn't
-matter in looking for headers, case of NAME is preserved when a header is inserted
-via fiddling.  It shouldn't include the trailing colon.
-
-VALUE is either nil, a simple string, a function returning nil or a string, or,
-as described below for ACTION 'combine, a list of up to three values.
-
-ACTION describes the nature of the fiddling to be done.  Possibilities
-for ACTION (default is 'supplement):
-
-  'supplement   Leave other like fields as-is, insert this one.
-
-  'replace      Delete other like fields, if any, and insert this one.
-
-  'create       Insert this one only if no like field exists.
-
-  'combine      Combine aggregate values of like fields with this one.
-                In this case, VALUE has a special form.  It is a list
-                of three items: VAL-PRE, VAL-LIKE, and VAL-POST.
-                VAL-PRE and VAL-POST are strings or nil.  VAL-LIKE may
-                be either a string or a function (it may also be nil,
-                but there's not much point to that).
-
-                Values of like header fields are aggregated, leading and
-                trailing whitespace is removed, and embedded
-                whitespace is left as-is.  If there are no like
-                fields, or the aggregate value is an empty string,
-                VAL-LIKE is not used.  Else, if VAL-LIKE is a function,
-                it is called with two arguments: NAME and the
-                aggregate like values.  Else, if VAL-LIKE is a string, it is 
-                used as a format string where a single \%s will be
-                replaced by the aggregate values of like fields.
-
-                VAL-PRE, the results of using VAL-LIKE, and VAL-POST
-                are concatenated, and the result, if not nil and not
-                an empty string, is used as the new value for the
-                field.  Although this description sounds a bit
-                complicated, the idea is to provide a mechanism for
-                combining the old value with a new value in a flexible
-                way.  For example, if you wanted to add a new value to
-                an existing header field by adding a semi-colon and
-                then starting the new value on a continuation line,
-                you might specify this:
-
-                 (nil \"%s;\\n\\t\" \"This is my new value\")
-
-FOLDING can be nil, in which case VALUE is used as-is.  If FOLDING is
-non-nil, feedmail \"smart filling\" is done on VALUE just before
-insertion.
-")
-
-(defun feedmail-vm-mail-mode (&optional arg)
-  "Make something like a buffer that has been created via vm-mail.
-The optional argument is ignored and is just for argument compatibility with
-feedmail-queue-runner-mode-setter.  This function is suitable for being 
-applied to a file after you've just read it from disk: for example, a
-feedmail FQM message file from a queue.  You could use something like
-this:
-
-\(setq auto-mode-alist \(cons \'\(\"\\\\.fqm$\" . feedmail-vm-mail-mode\) auto-mode-alist\)\)
-"
-  (feedmail-say-debug ">in-> feedmail-vm-mail-mode")
-  (let ((the-buf (current-buffer)))
-	(vm-mail)
-	(delete-region (point-min) (point-max))
-	(insert-buffer the-buf)
-	(setq buffer-file-name (buffer-file-name the-buf))
-	(set-buffer-modified-p (buffer-modified-p the-buf))
-	;; For some versions of emacs, saving the message to a queue
-	;; triggers running the mode function on the buffer, and that
-	;; leads (through a series of events I don't really understand)
-	;; to this function being called while the buffer is still
-	;; marked modified even though it is in the process of being
-	;; saved.  I guess the function gets called during the renaming
-	;; that takes place en route to the save.
-	;;
-	;; This clearing of the marker probably wastes a buffer copy
-	;; but it's easy to do and more reliable than figuring out what
-	;; each variant of emacs does in this strange case.
-	(set-buffer-modified-p nil the-buf)
-	(kill-buffer the-buf)
-	))
-
-
-(defun feedmail-send-it ()
-  "A function which is a suitable value for send-mail-function.
-To use it, you probably want something like this in your .emacs or
-similar place:
-
-  (setq send-mail-function 'feedmail-send-it)
-  (autoload 'feedmail-send-it \"feedmail\")"
-
-  (feedmail-say-debug ">in-> feedmail-send-it")
-  (save-excursion
-	(let ((bfn-jiggle nil))
-	  ;; if buffer-file-name is nil, temporarily use the stashed value
-	  (if (and (not buffer-file-name) feedmail-queue-buffer-file-name)
-		  (setq buffer-file-name feedmail-queue-buffer-file-name
-				bfn-jiggle t))
-	  ;; avoid matching trouble over slash vs backslash by getting canonical
-	  (if feedmail-queue-directory
-		  (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
-	  (if feedmail-queue-draft-directory
-		  (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
-	  (if (not feedmail-enable-queue) (feedmail-send-it-immediately-wrapper)
-		;; else, queuing is enabled, should we ask about it or just do it?
-		(if feedmail-ask-before-queue
-			(funcall (feedmail-queue-send-edit-prompt))
-		  (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue)))
-	  ;; put this back
-	  (if bfn-jiggle (setq feedmail-queue-buffer-file-name buffer-file-name))
-	  )))
-
-
-(defun feedmail-message-action-send ()
-  ;; hooks can make this take a while so clear the prompt
-  (feedmail-say-debug ">in-> feedmail-message-action-send")
-  (message "FQM: Immediate send...")
-  (feedmail-send-it-immediately-wrapper))
-
-
-;; From a VM mailing list discussion and some suggestions from Samuel Mikes 
-(defun feedmail-queue-express-to-queue ()
-  "*Send message directly to the queue, with a minimum of fuss and bother."
-  (interactive)
-  (feedmail-say-debug ">in-> feedmail-queue-express-to-queue")
-  (run-hooks 'feedmail-queue-express-hook)
-  (let ((feedmail-enable-queue t)
-		(feedmail-ask-before-queue nil)
-		(feedmail-queue-reminder-alist nil)
-		(feedmail-queue-chatty-sit-for 0))
-	(feedmail-send-it)
-	)
-)
-
-
-(defun feedmail-queue-express-to-draft ()
-  "*Send message directly to the draft queue, with a minimum of fuss and bother."
-  (interactive)
-  (feedmail-say-debug ">in-> feedmail-queue-express-to-draft")
-  (let ((feedmail-queue-directory feedmail-queue-draft-directory))
-	(feedmail-queue-express-to-queue)
-	)
-)
-
-
-(defun feedmail-message-action-send-strong ()
-  (feedmail-say-debug ">in-> feedmail-message-action-send-strong")
-  (let ((feedmail-confirm-outgoing nil)) (feedmail-message-action-send)))
-
-
-(defun feedmail-message-action-edit ()
-  (feedmail-say-debug ">in-> feedmail-message-action-edit")
-  (error "FQM: Message not queued; returning to edit"))
-
-
-(defun feedmail-message-action-draft ()
-  (feedmail-say-debug ">in-> feedmail-message-action-draft")
-  (feedmail-dump-message-to-queue feedmail-queue-draft-directory 'after-draft))
-
-
-(defun feedmail-message-action-draft-strong ()
-  (feedmail-say-debug ">in-> feedmail-message-action-draft-strong")
-  (let ((buffer-file-name nil))
-	(feedmail-message-action-draft)))
-
-
-(defun feedmail-message-action-queue ()
-  (feedmail-say-debug ">in-> feedmail-message-action-queue")
-  (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))
-
-
-(defun feedmail-message-action-queue-strong ()
-  (feedmail-say-debug ">in-> feedmail-message-action-queue-strong")
-  (let ((buffer-file-name nil))
-	(feedmail-message-action-queue)))
-
-
-(defun feedmail-message-action-toggle-spray ()
-  (feedmail-say-debug ">in-> feedmail-message-action-toggle-spray")
-  (let ((feedmail-enable-spray (not feedmail-enable-spray)))
-	(if feedmail-enable-spray
-		(message "FQM: For this message, spray toggled ON")
-	  (message "FQM: For this message, spray toggled OFF"))
-	(sit-for 3)
-	;; recursion, but harmless
-	(feedmail-send-it)))
-
-
-(defconst feedmail-p-h-b-n "*FQM Help*")
-
-(defun feedmail-message-action-help ()
-  (feedmail-say-debug ">in-> feedmail-message-action-help")
-  (let ((d-string " ")
-		(fqm-help (get-buffer feedmail-p-h-b-n)))
-	(if (stringp feedmail-ask-before-queue-default)
-		(setq d-string feedmail-ask-before-queue-default)
-	  (setq d-string  (char-to-string feedmail-ask-before-queue-default)))
-	(if (and fqm-help (get-buffer-window fqm-help))
-		(feedmail-scroll-buffer 'up fqm-help)
-	  (feedmail-message-action-help-blat d-string))
-	;; recursive, but no worries (it goes deeper on user action)
-	(feedmail-send-it)))
-
-(defun feedmail-message-action-help-blat (d-string)
-  (feedmail-say-debug ">in-> feedmail-message-action-help-blat")
-  (with-output-to-temp-buffer feedmail-p-h-b-n
-    (princ "You're dispatching a message and feedmail queuing is enabled.
-Typing ? again will normally scroll this help buffer.
-
-Choices:
-   q  QUEUE        for later sending \(via feedmail-run-the-queue\)
-   Q  QUEUE!       like \"q\", but always make a new file
-   i  IMMEDIATELY  send this \(but not the other queued messages\)
-   I  IMMEDIATELY! like \"i\", but skip following confirmation prompt
-   d  DRAFT        queue in the draft directory
-   D  DRAFT!       like \"d\", but always make a new file
-   e  EDIT         return to the message edit buffer \(don't send or queue\)
-   *  SPRAY        toggle spray mode \(individual message transmissions\)
-   >  SCROLL UP    scroll message up \(toward end of message\)
-   <  SCROLL DOWN  scroll message down \(toward beginning of message\)
-   ?  HELP         show or scroll this help buffer
-
-Synonyms:
-   s  SEND         immediately \(same as \"i\"\)
-   S  SEND!        immediately \(same as \"I\"\)
-   r  ROUGH        draft \(same as \"d\"\)
-   R  ROUGH!       draft \(same as \"D\"\)
-   n  NOPE         didn't mean it \(same as \"e\"\)
-   y  YUP          do the default behavior \(same as \"C-m\"\)
-  SPC SCROLL UP    \(same as \">\"\)
-
-The user-configurable default is currently \"")
-	(princ d-string)
-	(princ "\".  For other possibilities,
-see the variable feedmail-prompt-before-queue-user-alist.
-")
-	(and (stringp feedmail-prompt-before-queue-help-supplement)
-		 (princ feedmail-prompt-before-queue-help-supplement))
-    (save-excursion (set-buffer standard-output) (if (fboundp 'help-mode) (help-mode)))))
-
-
-(defun feedmail-message-action-scroll-up ()
-  (feedmail-say-debug ">in-> feedmail-message-action-scroll-up")
-  (feedmail-scroll-buffer 'up)
-  ;; recursive, but no worries (it goes deeper on user action)
-  (feedmail-send-it))
-
-
-(defun feedmail-message-action-scroll-down ()
-  (feedmail-say-debug ">in-> feedmail-message-action-scroll-down")
-  (feedmail-scroll-buffer 'down)
-  ;; recursive, but no worries (it goes deeper on user action)
-  (feedmail-send-it))
-
-
-;;;###autoload
-(defun feedmail-run-the-queue-no-prompts (&optional arg)
-  "Like feedmail-run-the-queue, but suppress confirmation prompts."
-  (interactive "p")
-  (feedmail-say-debug ">in-> feedmail-run-the-queue-no-prompts")
-  (let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg)))
-
-;;;###autoload
-(defun feedmail-run-the-queue-global-prompt (&optional arg)
-  "Like feedmail-run-the-queue, but with a global confirmation prompt.
-This is generally most useful if run non-interactively, since you can 
-bail out with an appropriate answer to the global confirmation prompt."
-  (interactive "p")
-  (feedmail-say-debug ">in-> feedmail-run-the-queue-global-prompts")
-  (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
-
-;;;###autoload
-(defun feedmail-run-the-queue (&optional arg)
-  "Visit each message in the feedmail queue directory and send it out.
-Return value is a list of three things: number of messages sent, number of
-messages skipped, and number of non-message things in the queue (commonly
-backup file names and the like)."
-  (interactive "p")
-  (feedmail-say-debug ">in-> feedmail-run-the-queue")
-  ;; avoid matching trouble over slash vs backslash by getting canonical
-  (if feedmail-queue-directory
-	  (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
-  (if feedmail-queue-draft-directory
-	  (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
-  (let* ((maybe-file)
-		 (qlist (feedmail-look-at-queue-directory feedmail-queue-directory))
-		 (dlist (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
-		 (q-cnt (nth 0 qlist))
-		 (q-oth (nth 1 qlist))
-		 (d-cnt (nth 0 dlist))
-		 (d-oth (nth 1 dlist))
-		 (messages-sent 0)
-		 (messages-skipped 0)
-		 (blobby-buffer)
-		 (already-buffer)
-		 (do-the-run t)
-		 (list-of-possible-fqms))
-	(if (and (> q-cnt 0) feedmail-queue-runner-confirm-global)
-		(setq do-the-run
-			  (if (fboundp 'y-or-n-p-with-timeout)
-				  (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d,  Queue: %dm+%d; run the queue? "
-												 d-cnt d-oth q-cnt q-oth)
-										 5 nil)
-				(y-or-n-p (format "FQM: Draft: %dm+%d,  Queue: %dm+%d; run the queue? "
-								  d-cnt d-oth q-cnt q-oth))
-				)))
-	(if (not do-the-run)
-		(setq messages-skipped q-cnt)
-	  (save-window-excursion
-		(setq list-of-possible-fqms (directory-files feedmail-queue-directory t))
-		(if feedmail-queue-run-orderer
-			(setq list-of-possible-fqms (funcall feedmail-queue-run-orderer list-of-possible-fqms)))
-		(mapcar
-		 '(lambda (blobby)
-			(setq maybe-file (expand-file-name blobby feedmail-queue-directory))
-			(cond
-			 ((file-directory-p maybe-file) nil) ; don't care about subdirs	
-			 ((feedmail-fqm-p blobby)
-			  (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby)))
-			   (setq already-buffer
-					 (if (fboundp 'find-buffer-visiting) ; missing from XEmacs
-						 (find-buffer-visiting maybe-file)
-					   (get-file-buffer maybe-file)))
-			   (if (and already-buffer (buffer-modified-p already-buffer))
-				   (save-window-excursion
-					 (display-buffer (set-buffer already-buffer))
-					 (if (fboundp 'y-or-n-p-with-timeout)
-						 ;; make a guess that the user just forgot to save
-						 (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t)
-							 (save-buffer))
-					   (if (y-or-n-p (format "FQM: Visiting %s; save before send? " blobby))
-						   (save-buffer))
-					   )))
-			
-			   (set-buffer blobby-buffer)
-			   (setq buffer-offer-save nil)
-			   (buffer-disable-undo blobby-buffer)
-			   (insert-file-contents-literally maybe-file)
-			   (setq buffer-file-type t) ;;binary
-			   (goto-char (point-min))
-			   ;; if at least two line-endings with CRLF, translate the file
-			   (if (looking-at ".*\r\n.*\r\n")
-				   (while (search-forward "\r\n" nil t)
-					 (replace-match "\n" nil t)))
-;;			   ;; work around text-vs-binary wierdness
-;;			   ;; if we don't find the normal M-H-S, try reading the file a different way
-;; 			   (if (not (feedmail-find-eoh t))
-;;				   (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil))
-;;					 (erase-buffer)
-;;					 (insert-file-contents maybe-file)))
-			   (funcall feedmail-queue-runner-mode-setter arg)
-			   (condition-case signal-stuff  ; don't give up the loop if user skips some
-				   (let ((feedmail-enable-queue nil)
-						 (feedmail-queue-runner-is-active maybe-file))
-					 ;; if can't find EOH, this is no message!
-					 (if (not (feedmail-find-eoh t))
-						 (progn
-						   (feedmail-say-chatter "Skipping %s; no mail-header-separator" maybe-file)
-						   (error "FQM: you should never see this message")))
-					 (feedmail-say-debug "Prepping %s" maybe-file)
-					 ;; the catch is a way out for users to voluntarily skip sending a message
-					 (catch 'skip-me-q (funcall feedmail-queue-runner-message-sender arg))
-					 (set-buffer blobby-buffer)
-					 (if (buffer-modified-p) ; still modified, means wasn't sent
-						 (progn
-						   (setq messages-skipped (1+ messages-skipped))
-						   (feedmail-say-chatter "%s wasn't sent by %s" maybe-file feedmail-buffer-eating-function))
-					   (setq messages-sent (1+ messages-sent))
-					   (funcall feedmail-queue-runner-cleaner-upper maybe-file arg)
-					   (if (and already-buffer (not (file-exists-p maybe-file)))
-						   ;; we have gotten rid of the file associated with the
-						   ;; buffer, so update the buffer's notion of that
-						   (save-excursion
-							 (set-buffer already-buffer)
-							 (setq buffer-file-name nil)))))
-				 ;; the handler for the condition-case
-				 (error (setq messages-skipped (1+ messages-skipped))
-						(ding t)
-						(message "FQM: Trapped '%s', message left in queue." (car signal-stuff))
-						(sit-for 3)
-						(message "FQM: Trap details: \"%s\""
-								 (mapconcat 'identity (cdr signal-stuff) "\" \""))
-						(sit-for 3)))
-			   (kill-buffer blobby-buffer)
-			   (feedmail-say-chatter "%d to go, %d sent, %d skipped (%d other files ignored)"
-									(- q-cnt messages-sent messages-skipped)
-									messages-sent messages-skipped q-oth)
-			   )))
-		  list-of-possible-fqms)))
-	(if feedmail-queue-chatty
-		(progn 
-		  (feedmail-say-chatter "%d sent, %d skipped (%d other files ignored)"
-								messages-sent messages-skipped q-oth)
-		  (feedmail-queue-reminder 'after-run)
-		  (sit-for feedmail-queue-chatty-sit-for)))
-	(list messages-sent messages-skipped q-oth)))
-
-
-;;;###autoload
-(defun feedmail-queue-reminder (&optional what-event)
-  "Perform some kind of reminder activity about queued and draft messages.
-Called with an optional symbol argument which says what kind of event
-is triggering the reminder activity.  The default is 'on-demand, which
-is what you typically would use if you were putting this in your emacs start-up
-or mail hook code.  Other recognized values for WHAT-EVENT (these are passed
-internally by feedmail):
-
-   after-immediate      (a message has just been sent in immediate mode)
-   after-queue          (a message has just been queued)
-   after-draft          (a message has just been placed in the draft directory)
-   after-run            (the queue has just been run, possibly sending messages)
-
-WHAT-EVENT is used as a key into the table feedmail-queue-reminder-alist.  If
-the associated value is a function, it is called without arguments and is expected
-to perform the reminder activity.  You can supply your own reminder functions 
-by redefining feedmail-queue-reminder-alist.  If you don't want any reminders, 
-you can set feedmail-queue-reminder-alist to nil."
-  (interactive "p")
-  (feedmail-say-debug ">in-> feedmail-queue-reminder %s" what-event)
-  (let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder)
-	(setq entry (assoc key feedmail-queue-reminder-alist))
-	(setq reminder (cdr entry))
-	(if (fboundp reminder) (funcall reminder)))
-  )
-
-
-(defun feedmail-queue-reminder-brief ()
-  "Brief display of draft and queued message counts in minibuffer."
-  (interactive)
-  (feedmail-say-debug ">in-> feedmail-queue-reminder-brief")
-  (let (q-cnt d-cnt q-lis d-lis)
-	(setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
-	(setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
-	(setq q-cnt (car q-lis))
-	(setq d-cnt (car d-lis))
-	(if (or (> q-cnt 0) (> d-cnt 0))
-		(progn
-		  (message "FQM: [D: %d,  Q: %d]" d-cnt q-cnt))))
-  )
-
-
-(defun feedmail-queue-reminder-medium ()
-  "Verbose display of draft and queued message counts in minibuffer."
-  (interactive)
-  (feedmail-say-debug ">in-> feedmail-queue-reminder-medium")
-  (let (q-cnt d-cnt q-oth d-oth q-lis d-lis)
-	(setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
-	(setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
-	(setq q-cnt (car q-lis))
-	(setq d-cnt (car d-lis))
-	(setq q-oth (nth 1 q-lis))
-	(setq d-oth (nth 1 d-lis))
-	(if (or (> q-cnt 0) (> d-cnt 0))
-		(progn
-		  (message "FQM: Draft: %dm+%d in \"%s\",  Queue: %dm+%d in \"%s\""
-				   d-cnt d-oth (file-name-nondirectory feedmail-queue-draft-directory)
-				   q-cnt q-oth (file-name-nondirectory feedmail-queue-directory)))))
-  )
-
-
-(defun feedmail-queue-send-edit-prompt ()
-  "Ask whether to queue, send immediately, or return to editing a message, etc."
-  (feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt")
-  (feedmail-queue-send-edit-prompt-inner
-   feedmail-ask-before-queue-default
-   feedmail-ask-before-queue-prompt
-   feedmail-ask-before-queue-reprompt
-   'feedmail-message-action-help
-   feedmail-prompt-before-queue-standard-alist
-   feedmail-prompt-before-queue-user-alist
-   ))
-
-(defun feedmail-queue-runner-prompt ()
-  "Ask whether to queue, send immediately, or return to editing a message, etc."
-  (feedmail-say-debug ">in-> feedmail-queue-runner-prompt")
-  (feedmail-queue-send-edit-prompt-inner
-   feedmail-ask-before-queue-default
-   feedmail-ask-before-queue-prompt
-   feedmail-ask-before-queue-reprompt
-   'feedmail-message-action-help
-   feedmail-prompt-before-queue-standard-alist
-   feedmail-prompt-before-queue-user-alist
-   ))
-
-(defun feedmail-queue-send-edit-prompt-inner (default prompt reprompt helper standard-alist user-alist)
-  (feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt-inner")
-  ;; Some implementation ideas here came from the userlock.el code
-  (or defining-kbd-macro (discard-input))
-  (save-window-excursion
-	(let ((answer) (d-char) (d-string " "))
-	  (if (stringp default)
-		  (setq d-char   (string-to-char default)
-				d-string default)
-		(setq d-string  (char-to-string default))
-		(setq d-char    default)
-		)
-      (while (null answer)
-		(message prompt d-string)
-		(let ((user-sez
-			   (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0))
-				 (read-char-exclusive))))
-		  (if (= user-sez help-char)
-			  (setq answer '(^ . helper))
-			(if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y))
-				(setq user-sez d-char))
-			;; these char-to-int things because of some incomprensible difference
-			;; between the two in byte-compiled stuff between GNUemacs and XEmacs
-			;; (well, I'm sure someone could comprehend it, but I say 'uncle')
-			(setq answer (or (assoc user-sez user-alist)
-							 (and (fboundp 'char-to-int)
-								  (assoc (char-to-int user-sez) user-alist))
-							 (assoc user-sez standard-alist)
-							 (and (fboundp 'char-to-int)
-								  (assoc (char-to-int user-sez) standard-alist))))
-			(if (or (null answer) (null (cdr answer)))
-				(progn
-				  (beep)
-				  (message reprompt d-string)
-				  (sit-for 3)))
-			 )))
-	  (cdr answer)
-	  )))
-
-(defun feedmail-scroll-buffer (direction &optional buffy)
-  ;; scrolling fun
-  ;; emacs convention is that scroll-up moves text up, window down
-  (feedmail-say-debug ">in-> feedmail-scroll-buffer %s" direction)
-  (save-selected-window
-	(let ((signal-error-on-buffer-boundary nil)
-		  (fqm-window (display-buffer (if buffy buffy (current-buffer)))))
-	  (select-window fqm-window)
-	  (if (eq direction 'up)
-		  (if (pos-visible-in-window-p (point-max) fqm-window)
-			  ;; originally just (goto-char (point-min)), but
-			  ;; pos-visible-in-window-p seems oblivious to that
-			  (scroll-down 999999)
-			(scroll-up))
-		(if (pos-visible-in-window-p (point-min) fqm-window)
-			(scroll-up 999999)
-		  (scroll-down))))))
-		
-
-(defun feedmail-look-at-queue-directory (queue-directory)
-  "Find out some things about a queue directory.
-Result is a list containing a count of queued messages in the
-directory, a count of other files in the directory, and a high water
-mark for prefix sequence numbers.  Subdirectories are not included in
-the counts."
-  (feedmail-say-debug ">in-> feedmail-look-at-queue-directory %s" queue-directory)
-  (let ((q-cnt 0) (q-oth 0) (high-water 0) (blobbet))
-	;; iterate, counting things we find along the way in the directory
-	(if (file-directory-p queue-directory)
-		(mapcar
-		 '(lambda (blobby)
-			(cond
-			 ((file-directory-p blobby) nil) ; don't care about subdirs
-			 ((feedmail-fqm-p blobby)
-			  (setq blobbet (file-name-nondirectory blobby))
-			  (if (string-match "^[0-9][0-9][0-9]-" blobbet)
-				  (let ((water-mark))
-					(setq water-mark (string-to-int (substring blobbet 0 3)))
-					(if (> water-mark high-water) (setq high-water water-mark))))
-			  (setq q-cnt (1+ q-cnt)))
-			 (t (setq q-oth (1+ q-oth)))
-			 ))
-		 (directory-files queue-directory t)))
-	(list q-cnt q-oth high-water)))
-
-(defun feedmail-tidy-up-slug (slug)
-  "Utility for mapping out suspect characters in a potential filename"
-  (feedmail-say-debug ">in-> feedmail-tidy-up-slug %s" slug)
-  ;; even programmers deserve a break sometimes, so cover nil for them
-  (if (null slug) (setq slug ""))
-  ;; replace all non-alphanumerics with hyphen for safety
-  (while (string-match feedmail-queue-slug-suspect-regexp slug) (setq slug (replace-match "-" nil nil slug)))
-  ;; collapse multiple hyphens to one
-  (while (string-match "--+" slug) (setq slug (replace-match "-" nil nil slug)))
-  ;; for tidyness, peel off leading hyphens
-  (if (string-match "^-*" slug) (setq slug (replace-match "" nil nil slug)))
-  ;; for tidyness, peel off trailing hyphens
-  (if (string-match "-*$" slug) (setq slug (replace-match "" nil nil slug)))
-  slug
-)  
-
-(defun feedmail-queue-subject-slug-maker (&optional queue-directory)
-  "Create a name for storing the message in the queue.
-Optional argument QUEUE-DIRECTORY specifies into which directory the
-file will be placed.  The name is based on the SUBJECT: header (if
-there is one).  If there is no subject,
-feedmail-queue-default-file-slug is consulted Special characters are
-mapped to mostly alphanumerics for safety."
-  (feedmail-say-debug ">in-> feedmail-queue-subject-slug-maker %s" queue-directory)
-  (let ((eoh-marker) (case-fold-search t) (subject "") (s-point))
-	(setq eoh-marker (feedmail-find-eoh))
-	(goto-char (point-min))
-	;; get raw subject value (first line, anyhow)
-	(if (re-search-forward "^SUBJECT:" eoh-marker t)
-		(progn (setq s-point (point))
-			   (end-of-line)
-			   (setq subject (buffer-substring-no-properties s-point (point)))))
-	(setq subject (feedmail-tidy-up-slug subject))
-	(if (zerop (length subject))
-		(setq subject
-			  (cond
-			   ((stringp feedmail-queue-default-file-slug) feedmail-queue-default-file-slug)
-			   ((fboundp feedmail-queue-default-file-slug)
-				(save-excursion (funcall feedmail-queue-default-file-slug)))
-			   ((eq feedmail-queue-default-file-slug 'ask)
-				(file-name-nondirectory
-				 (read-file-name "FQM: Message filename slug? "
-								 (file-name-as-directory queue-directory) subject nil subject)))
-			   (t "no subject"))
-			  ))
-	(feedmail-tidy-up-slug subject) ;; one more time, with feeling
-	))
-
-
-(defun feedmail-create-queue-filename (queue-directory)
-  (feedmail-say-debug ">in-> feedmail-create-queue-filename %s" queue-directory)
-  (let ((slug "wjc"))
-	(cond
-	 (feedmail-queue-slug-maker
-	  (save-excursion (setq slug (funcall feedmail-queue-slug-maker queue-directory))))
-	 (feedmail-ask-for-queue-slug
-	  (setq slug (file-name-nondirectory
-				  (read-file-name (concat "FQM: Message filename slug? [" slug "]? ")
-								 (file-name-as-directory queue-directory) slug nil slug))))
-	  )
-	(setq slug (feedmail-tidy-up-slug slug))
-	(setq slug (format "%03d-%s" (1+ (nth 2 (feedmail-look-at-queue-directory queue-directory))) slug))
-	(concat
-	 (expand-file-name slug queue-directory)
-	 feedmail-queue-fqm-suffix)
-	))
-
-
-(defun feedmail-dump-message-to-queue (queue-directory what-event)
-  (feedmail-say-debug ">in-> feedmail-dump-message-to-queue %s %s" queue-directory what-event)
-  (or (file-accessible-directory-p queue-directory)
-	  ;; progn to get nil result no matter what
-	  (progn (make-directory queue-directory t) nil)
-	  (file-accessible-directory-p queue-directory)
-	  (error (concat "FQM: Message not queued; trouble with directory " queue-directory)))
-  (let ((filename)
-		(is-fqm)
-		(is-in-this-dir)
-		(previous-buffer-file-name buffer-file-name))
-	(if buffer-file-name
-		(progn
-		  (setq is-fqm (feedmail-fqm-p buffer-file-name))
-		  (setq is-in-this-dir (string-equal
-								(directory-file-name (expand-file-name queue-directory))
-								(directory-file-name (expand-file-name (file-name-directory buffer-file-name)))))))
-	;; if visiting a queued message, just save
-	(if (and is-fqm is-in-this-dir)
-		(setq filename buffer-file-name)
-	  (setq filename (feedmail-create-queue-filename queue-directory)))
-	;; make binary file on DOS/Win95/WinNT, etc
-	(let ((buffer-file-type feedmail-force-binary-write)) (write-file filename))
-	;; convenient for moving from draft to q, for example
-	(if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir))
-			 (let (d b s)
-			   (setq b (file-name-nondirectory previous-buffer-file-name))
-			   (setq d (file-name-directory previous-buffer-file-name))
-			   (setq s (substring d (1- (length d))))
-			   (setq d (substring d 0 (1- (length d))))
-			   (setq d (file-name-nondirectory d))
-			   (y-or-n-p (format "FQM: Was previously %s%s%s; delete that? " d s b))
-			   )
-			 )
-		(delete-file previous-buffer-file-name))
-	(if feedmail-nuke-buffer-after-queue
-		(let ((a-s-file-name buffer-auto-save-file-name))
-		  ;; be aggressive in nuking auto-save files
-		  (and (kill-buffer (current-buffer))
-			   delete-auto-save-files
-			   (file-exists-p a-s-file-name)
-			   (delete-file a-s-file-name))))
-	(feedmail-say-chatter "Queued in %s" filename)
-	(if feedmail-queue-chatty
-		(progn
-		  (feedmail-queue-reminder what-event)
-		  (sit-for feedmail-queue-chatty-sit-for)))))
-
-
-;; from a similar function in mail-utils.el
-(defun feedmail-rfc822-time-zone (time)
-  (feedmail-say-debug ">in-> feedmail-rfc822-time-zone %s" time)
-  (let* ((sec (or (car (current-time-zone time)) 0))
-		 (absmin (/ (abs sec) 60)))
-    (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
-
-(defun feedmail-rfc822-date (arg-time)
-  (feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time)
-  (let ((time (if arg-time arg-time (current-time)))
-		(system-time-locale "C"))
-	(concat
-	 (format-time-string "%a, %e %b %Y %T " time)
-	 (feedmail-rfc822-time-zone time)
-	 )))
-
-
-(defun feedmail-send-it-immediately-wrapper ()
-  "Wrapper to catch skip-me-i"
-  (if (eq 'skip-me-i (catch 'skip-me-i (feedmail-send-it-immediately)))
-	  (error "FQM: Sending...abandonned!")))
-
-(defun feedmail-send-it-immediately ()
-  "Handle immediate sending, including during a queue run."
-  (feedmail-say-debug ">in-> feedmail-send-it-immediately")
-  (let ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*"))
-		 (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*"))
-		 (feedmail-raw-text-buffer (current-buffer))
-		 (feedmail-address-list)
-		 (eoh-marker)
-		 (bcc-holder)
-		 (resent-bcc-holder)
-		 (a-re-rtcb  "^RESENT-\\(TO\\|CC\\|BCC\\):")
-		 (a-re-rtc   "^RESENT-\\(TO\\|CC\\):")
-		 (a-re-rb    "^RESENT-BCC:")
-		 (a-re-dtcb  "^\\(TO\\|CC\\|BCC\\):")
-		 (a-re-dtc   "^\\(TO\\|CC\\):")
-		 (a-re-db    "^BCC:")
-		 (mail-header-separator mail-header-separator) ;; to get a temporary changable copy
-		 )
-    (unwind-protect
-		(save-excursion
-		  (set-buffer feedmail-error-buffer) (erase-buffer)
-		  (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
-
-		  ;; jam contents of user-supplied mail buffer into our scratch buffer
-		  (insert-buffer feedmail-raw-text-buffer)
-
-		  ;; require one newline at the end.
-		  (goto-char (point-max))
-		  (or (= (preceding-char) ?\n) (insert ?\n))
-
-		  (let ((case-fold-search nil))
-			;; Change header-delimiter to be what mailers expect (empty line).
-			(feedmail-say-debug "looking for m-h-s \"%s\"" mail-header-separator)
-			(setq eoh-marker (feedmail-find-eoh)) ;; leaves match data in place or signals error
-			(feedmail-say-debug "found m-h-s %s" eoh-marker)
-			(setq mail-header-separator "")
-			(replace-match ""))
-;;			(replace-match "\\1")) ;; might be empty or "\r"
-
-		  ;; mail-aliases nil = mail-abbrevs.el
-		  (feedmail-say-debug "expanding mail aliases")
-		  (if (or feedmail-force-expand-mail-aliases
-				  (and (fboundp 'expand-mail-aliases) mail-aliases))
-			  (expand-mail-aliases (point-min) eoh-marker))
-
-		  ;; make it pretty
-		  (if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker))
-		  ;; ignore any blank lines in the header
-		  (goto-char (point-min))
-		  (while (and (re-search-forward "\n\n\n*" eoh-marker t) (< (point) eoh-marker))
-			(replace-match "\n"))
-	
-		  (let ((case-fold-search t) (addr-regexp))
-			(goto-char (point-min))
-			;; there are some RFC-822 combinations/cases missed here,
-			;; but probably good enough and what users expect
-			;;
-			;; use resent-* stuff only if there is at least one non-empty one
-			(setq feedmail-is-a-resend
-				  (re-search-forward
-				   ;; header name, followed by optional whitespace, followed by
-				   ;; non-whitespace, followed by anything, followed by newline;
-				   ;; the idea is empty RESENT-* headers are ignored
-				   "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)\\s-*\\S-+.*$"
-				   eoh-marker t))
-			;; if we say so, gather the BCC stuff before the main course
-			(if (eq feedmail-deduce-bcc-where 'first)
-				(progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
-					   (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
-			;; the main course
-			(if (or (eq feedmail-deduce-bcc-where 'first) (eq feedmail-deduce-bcc-where 'last))
-				;; handled by first or last cases, so don't get BCC stuff
-				(progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtc) (setq addr-regexp a-re-dtc))
-					   (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))
-			  ;; not handled by first or last cases, so also get BCC stuff
-			  (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtcb) (setq addr-regexp a-re-dtcb))
-					 (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
-			;; if we say so, gather the BCC stuff after the main course
-			(if (eq feedmail-deduce-bcc-where 'last)
-				(progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
-					   (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
-			(if (not feedmail-address-list) (error "FQM: Sending...abandoned, no addressees"))
-			;; not needed, but meets user expectations
-			(setq feedmail-address-list (nreverse feedmail-address-list))
-			;; Find and handle any BCC fields.
-			(setq bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^BCC:"))
-			(setq resent-bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^RESENT-BCC:"))
-			(if (and bcc-holder (not feedmail-nuke-bcc))
-				(progn (goto-char (point-min))
-					   (insert bcc-holder)))
-			(if (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
-				(progn (goto-char (point-min))
-					   (insert resent-bcc-holder)))
-			(goto-char (point-min))
-
-			;; fiddle about, fiddle about, fiddle about....
-			(feedmail-fiddle-from)
-			(feedmail-fiddle-sender)
-			(feedmail-fiddle-x-mailer)
-			(feedmail-fiddle-message-id
-			 (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
-			(feedmail-fiddle-date
-			 (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
-			(feedmail-fiddle-list-of-fiddle-plexes feedmail-fiddle-plex-user-list)
-
-			;; don't send out a blank headers of various sorts
-			;; (this loses on continued line with a blank first line)
-			(goto-char (point-min))
-			(and feedmail-nuke-empty-headers ; hey, who's an empty-header?
-				 (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t)
-				   (replace-match ""))))
-
-		  (feedmail-say-debug "last chance hook: %s" feedmail-last-chance-hook)
-		  (run-hooks 'feedmail-last-chance-hook)
-
-		  (save-window-excursion
-			(let ((fcc (feedmail-accume-n-nuke-header eoh-marker "^FCC:"))
-				  (also-file)
-				  (confirm (cond
-							((eq feedmail-confirm-outgoing 'immediate)
-							 (not feedmail-queue-runner-is-active))
-							((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active)
-							(t feedmail-confirm-outgoing)))
-				  (fullframe (cond
-							  ((eq feedmail-display-full-frame 'immediate)
-							   (not feedmail-queue-runner-is-active))
-							  ((eq feedmail-display-full-frame 'queued) feedmail-queue-runner-is-active)
-							  (t feedmail-display-full-frame))))
-			  (if fullframe
-				  (progn
-					(switch-to-buffer feedmail-prepped-text-buffer t)
-					(delete-other-windows)))
-			  (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer))
-				  (let ((user-mail-address (feedmail-envelope-deducer eoh-marker)))
-					(feedmail-say-debug "give it to buffer-eater")
-					(feedmail-give-it-to-buffer-eater)
-					(feedmail-say-debug "gave it to buffer-eater")
-					(if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer)))
-						(progn			; if a file but not running the queue, offer to delete it
-						  (setq also-file (expand-file-name also-file))
-						  (if (or feedmail-queue-auto-file-nuke
-								  (y-or-n-p (format "FQM: Delete message file %s? " also-file)))
-							  (save-excursion
-								;; if we delete the affiliated file, get rid
-								;; of the file name association and make sure we 
-								;; don't annoy people with a prompt on exit
-								(delete-file also-file)
-								(set-buffer feedmail-raw-text-buffer)
-								(setq buffer-offer-save nil)
-								(setq buffer-file-name nil)
-								)
-							)))
-					(goto-char (point-min))
-					;; re-insert and handle any FCC fields (and, optionally, any BCC).
-					(if fcc (let ((default-buffer-file-type feedmail-force-binary-write))
-							  (insert fcc)
-							  (if (not feedmail-nuke-bcc-in-fcc)
-								  (progn (if bcc-holder (insert bcc-holder))
-										 (if resent-bcc-holder (insert resent-bcc-holder))))
-							  
-							  (run-hooks 'feedmail-before-fcc-hook)
-
-							  (if feedmail-nuke-body-in-fcc
-								  (progn (goto-char eoh-marker)
-										 (if (natnump feedmail-nuke-body-in-fcc)
-											 (forward-line feedmail-nuke-body-in-fcc))
-										 (delete-region (point) (point-max))
-										 ))
-							  (mail-do-fcc eoh-marker)
-							  )))
-										; user bailed out of one-last-look
-				(if feedmail-queue-runner-is-active
-					(throw 'skip-me-q 'skip-me-q)
-				  (throw 'skip-me-i 'skip-me-i))
-				))))						; unwind-protect body (save-excursion)
-
-	  ;; unwind-protect cleanup forms
-	  (kill-buffer feedmail-prepped-text-buffer)
-	  (set-buffer feedmail-error-buffer)
-	  (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer)
-		(progn (display-buffer feedmail-error-buffer)
-			   ;; read fast ... the meter is running
-			   (if feedmail-queue-runner-is-active
-				   (progn
-					 (ding t)
-					 (feedmail-say-chatter "Sending...failed")))
-			   (error "FQM: Sending...failed")))
-	  (set-buffer feedmail-raw-text-buffer))
-	)									; let
-  (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
-	  (progn
-		(feedmail-queue-reminder 'after-immediate)
-		(sit-for feedmail-queue-chatty-sit-for)))
-  )
-
-
-(defun feedmail-fiddle-header (name value &optional action folding)
-  "Internal feedmail function for jamming fields into message header.
-NAME, VALUE, ACTION, and FOLDING are the four elements of a
-fiddle-plex, as described in the documentation for the variable
-feedmail-fiddle-plex-blurb."
-  (feedmail-say-debug ">in-> feedmail-fiddle-header %s %s %s %s" name value action folding)
-  (let ((case-fold-search t)
-		(header-colon (concat (regexp-quote name) ":"))
-		header-regexp eoh-marker has-like ag-like val-like that-point)
-	(setq header-regexp (concat "^" header-colon))
-	(setq eoh-marker (feedmail-find-eoh))
-	(goto-char (point-min))
-	(setq has-like (re-search-forward header-regexp eoh-marker t))
-
-	(if (not action) (setq action 'supplement))
-	(cond
-	 ((eq action 'supplement)
-	  ;; trim leading/trailing whitespace
-	  (if (string-match "\\`[ \t\n]+" value)
-		  (setq value (substring value (match-end 0))))
-	  (if (string-match "[ \t\n]+\\'" value)
-		  (setq value (substring value 0 (match-beginning 0))))
-	  (if (> (length value) 0)
-		  (progn
-			(if feedmail-fiddle-headers-upwardly
-				(goto-char (point-min))
-			  (goto-char eoh-marker))
-			(setq that-point (point))
-			(insert name ": " value "\n")
-			(if folding (feedmail-fill-this-one that-point (point))))))
-
-	 ((eq action 'replace)
-	  (if has-like (feedmail-accume-n-nuke-header eoh-marker header-regexp))
-	  (feedmail-fiddle-header name value 'supplement folding))
-
-	 ((eq action 'create)
-	  (if (not has-like) (feedmail-fiddle-header name value 'supplement folding)))
-
-	 ((eq action 'combine)
-	  (setq val-like (nth 1 value))
-	  (setq ag-like (or (feedmail-accume-n-nuke-header eoh-marker header-regexp) ""))
-	  ;; get rid of initial header name from first instance (front of string)
-	  (if (string-match (concat header-regexp "[ \t\n]+") ag-like)
-		  (setq ag-like (replace-match "" t t ag-like)))
-	  ;; get rid of embedded header names from subsequent instances
-	  (while (string-match (concat "\n" header-colon "[ \t\n]+") ag-like)
-		(setq ag-like (replace-match "\n\t" t t ag-like)))
-	  ;; trim leading/trailing whitespace
-	  (if (string-match "\\`[ \t\n]+" ag-like)
-		  (setq ag-like (substring ag-like (match-end 0))))
-	  (if (string-match "[ \t\n]+\\'" ag-like)
-		  (setq ag-like (substring ag-like 0 (match-beginning 0))))
-	  ;; if ag-like is not nil and not an empty string, transform it via a function
-	  ;; call or format operation
-	  (if (> (length ag-like) 0)
-		  (setq ag-like
-				(cond
-				 ((and (symbolp val-like) (fboundp val-like))
-				  (funcall val-like name ag-like))
-				 ((stringp val-like)
-				  (format val-like ag-like))
-				 (t nil))))
-	  (feedmail-fiddle-header name (concat (nth 0 value) ag-like (nth 2 value)) 'supplement folding)))
-	))
-
-(defun feedmail-give-it-to-buffer-eater ()
-  (feedmail-say-debug ">in-> feedmail-give-it-to-buffer-eater")
-  (save-excursion
-	(if feedmail-enable-spray
-		(mapcar
-		 '(lambda (feedmail-spray-this-address)
-			(let ((spray-buffer (get-buffer-create " *FQM Outgoing Email Spray*")))
-			  (save-excursion 
-				(set-buffer spray-buffer)
-				(erase-buffer)
-				;; not life's most efficient methodology, but spraying isn't
-				;; an every-5-minutes event either
-				(insert-buffer feedmail-prepped-text-buffer)
-				;; There's a good case to me made that each separate transmission of
-				;; a message in the spray should have a distinct MESSAGE-ID:.  There
-				;; is also a less compelling argument in the other direction.  I think
-				;; they technically should have distinct MESSAGE-ID:s, but I doubt that
-				;; anyone cares, practically.  If someone complains about it, I'll add
-				;; it.
-				(feedmail-fiddle-list-of-spray-fiddle-plexes feedmail-spray-address-fiddle-plex-list)
-				;; this (let ) is just in case some buffer eater
-				;; is cheating and using the global variable name instead
-				;; of its argument to find the buffer
-				(let ((feedmail-prepped-text-buffer spray-buffer))
-				  (funcall feedmail-buffer-eating-function
-						   feedmail-prepped-text-buffer
-						   feedmail-error-buffer
-						   (list feedmail-spray-this-address))))
-			  (kill-buffer spray-buffer)
-			  ))
-		 feedmail-address-list)
-	  (feedmail-say-debug "calling buffer-eater %s" feedmail-buffer-eating-function)
-	  (funcall feedmail-buffer-eating-function
-			   feedmail-prepped-text-buffer
-			   feedmail-error-buffer
-			   feedmail-address-list))))
-
-
-(defun feedmail-envelope-deducer (eoh-marker)
-  "If feedmail-deduce-envelope-from is false, simply return
-user-mail-address.  Else, look for SENDER: or FROM: (or RESENT-*) and
-return that value."
-  (feedmail-say-debug ">in-> feedmail-envelope-deducer %s" eoh-marker)
-  (if (not feedmail-deduce-envelope-from)
-	  user-mail-address
-	(let ((from-list))
-	  (setq from-list
-			(feedmail-deduce-address-list
-			 (current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^RESENT-SENDER:" "^SENDER:")
-			 from-list))
-	  (if (not from-list)
-		  (setq from-list
-				(feedmail-deduce-address-list
-				 (current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^RESENT-FROM:" "^FROM:")
-				 from-list)))
-	  (if (and from-list (car from-list)) (car from-list) user-mail-address))))
-
-
-(defun feedmail-fiddle-from ()
-  "Fiddle FROM:."
-  (feedmail-say-debug ">in-> feedmail-fiddle-from")
-  ;; default is to fall off the end of the list and do nothing
-  (cond
-   ;; nil means do nothing
-   ((eq nil feedmail-from-line) nil)
-   ;; t is the same a using the default computation, so compute it and recurse
-   ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins)
-   ;; improvement using user-mail-address suggested by
-   ;;   gray@austin.apc.slb.com (Douglas Gray Stephens)
-   ((eq t feedmail-from-line)
-	(let ((feedmail-from-line 
-		   (let ((at-stuff
-				  (if user-mail-address user-mail-address (concat (user-login-name) "@" (system-name)))))
-			 (cond
-			  ((eq mail-from-style nil) at-stuff)
-			  ((eq mail-from-style 'parens) (concat at-stuff " (" (user-full-name) ")"))
-			  ((eq mail-from-style 'angles) (concat "\"" (user-full-name) "\" <" at-stuff ">"))
-			  ))))
-		   (feedmail-fiddle-from)))
-
-   ;; if it's a string, simply make a fiddle-plex out of it and recurse
-   ((stringp feedmail-from-line)
-	(let ((feedmail-from-line (list "ignored" feedmail-from-line 'create)))
-	  (feedmail-fiddle-from)))
-
-   ;; if it's a function, call it and recurse with the resulting value
-   ((and (symbolp feedmail-from-line) (fboundp feedmail-from-line))
-	(let ((feedmail-from-line (funcall feedmail-from-line)))
-	  (feedmail-fiddle-from)))
-
-   ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
-   ((listp feedmail-from-line)
-	(feedmail-fiddle-header
-	 (if feedmail-is-a-resend "Resent-From" "From")
-	 (nth 1 feedmail-from-line)      ;; value
-	 (nth 2 feedmail-from-line)      ;; action
-	 (nth 3 feedmail-from-line)))))  ;; folding
-
-
-(defun feedmail-fiddle-sender ()
-  (feedmail-say-debug ">in-> feedmail-fiddle-sender")
-  "Fiddle SENDER:."
-  ;; default is to fall off the end of the list and do nothing
-  (cond
-   ;; nil means do nothing
-   ((eq nil feedmail-sender-line) nil)
-   ;; t is not allowed, but handled it just to avoid bugs later
-   ((eq t feedmail-sender-line) nil)
-
-   ;; if it's a string, simply make a fiddle-plex out of it and recurse
-   ((stringp feedmail-sender-line)
-	(let ((feedmail-sender-line (list "ignored" feedmail-sender-line 'create)))
-	  (feedmail-fiddle-sender)))
-
-   ;; if it's a function, call it and recurse with the resulting value
-   ((and (symbolp feedmail-sender-line) (fboundp feedmail-sender-line))
-	(let ((feedmail-sender-line (funcall feedmail-sender-line)))
-	  (feedmail-fiddle-sender)))
-
-   ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
-   ((listp feedmail-sender-line)
-	(feedmail-fiddle-header
-	 (if feedmail-is-a-resend "Resent-Sender" "Sender")
-	 (nth 1 feedmail-sender-line)      ;; value
-	 (nth 2 feedmail-sender-line)      ;; action
-	 (nth 3 feedmail-sender-line)))))  ;; folding
-
-
-(defun feedmail-default-date-generator (maybe-file)
-  "Default function for generating DATE: header contents."
-  (feedmail-say-debug ">in-> feedmail-default-date-generator")
-  (if maybe-file
-	  (progn
-		(feedmail-say-debug (concat "4 cre " (feedmail-rfc822-date (nth 4 (file-attributes maybe-file)))))
-		(feedmail-say-debug (concat "5 mod " (feedmail-rfc822-date (nth 5 (file-attributes maybe-file)))))
-		(feedmail-say-debug (concat "6 sta " (feedmail-rfc822-date (nth 6 (file-attributes maybe-file)))))))
-  (let ((date-time))
-	(if (and (not feedmail-queue-use-send-time-for-date) maybe-file)
-		(setq date-time (nth 5 (file-attributes maybe-file))))
-	(feedmail-rfc822-date date-time))
-  )
-
-
-(defun feedmail-fiddle-date (maybe-file)
-  "Fiddle DATE:.  See documentation of feedmail-date-generator."
-  (feedmail-say-debug ">in-> feedmail-fiddle-date")
-  ;; default is to fall off the end of the list and do nothing
-  (cond
-   ;; nil means do nothing
-   ((eq nil feedmail-date-generator) nil)
-   ;; t is the same a using the function feedmail-default-date-generator, so let it and recurse
-   ((eq t feedmail-date-generator)
-	(let ((feedmail-date-generator (feedmail-default-date-generator maybe-file)))
-	  (feedmail-fiddle-date maybe-file)))
-
-   ;; if it's a string, simply make a fiddle-plex out of it and recurse
-   ((stringp feedmail-date-generator)
-	(let ((feedmail-date-generator (list "ignored" feedmail-date-generator 'create)))
-	  (feedmail-fiddle-date maybe-file)))
-
-   ;; if it's a function, call it and recurse with the resulting value
-   ((and (symbolp feedmail-date-generator) (fboundp feedmail-date-generator))
-	(let ((feedmail-date-generator (funcall feedmail-date-generator maybe-file)))
-	  (feedmail-fiddle-date maybe-file)))
-
-   ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
-   ((listp feedmail-date-generator)
-	(feedmail-fiddle-header
-	 (if feedmail-is-a-resend "Resent-Date" "Date")
-	 (nth 1 feedmail-date-generator)      ;; value
-	 (nth 2 feedmail-date-generator)      ;; action
-	 (nth 3 feedmail-date-generator)))))  ;; folding
-
-
-(defun feedmail-default-message-id-generator (maybe-file)
-  "Default function for generating MESSAGE-ID: header contents.
-Based on a date and a sort of random number for tie breaking.  Unless
-feedmail-message-id-suffix is defined, uses user-mail-address, so be
-sure it's set.  If both are nil, creates a quasi-random suffix that is
-probably not appropriate for you."
-  (feedmail-say-debug ">in-> feedmail-default-message-id-generator %s" maybe-file)
-  (let ((date-time)
-		(system-time-locale "C")
-		(end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address)))
-	(if (not end-stuff) (setq end-stuff (format "%d.example.com" (random))))
-	(if (string-match "^\\(.*\\)@" end-stuff)
-		(setq end-stuff
-			  (concat (if (equal (match-beginning 1) (match-end 1)) "" "-") end-stuff))
-	  (setq end-stuff (concat "@" end-stuff)))
-	(if (and (not feedmail-queue-use-send-time-for-message-id) maybe-file)
-		(setq date-time (nth 5 (file-attributes maybe-file))))
-	(format "<%d-%s%s%s>"
-			(mod (random) 10000)
-			(format-time-string "%a%d%b%Y%H%M%S" date-time)
-			(feedmail-rfc822-time-zone date-time)
-			end-stuff))
-  )
-
-(defun feedmail-fiddle-message-id (maybe-file)
-  "Fiddle MESSAGE-ID:.  See documentation of feedmail-message-id-generator."
-  (feedmail-say-debug ">in-> feedmail-fiddle-message-id %s" maybe-file)
-  ;; default is to fall off the end of the list and do nothing
-  (cond
-   ;; nil means do nothing
-   ((eq nil feedmail-message-id-generator) nil)
-   ;; t is the same a using the function feedmail-default-message-id-generator, so let it and recurse
-   ((eq t feedmail-message-id-generator)
-	(let ((feedmail-message-id-generator (feedmail-default-message-id-generator maybe-file)))
-	  (feedmail-fiddle-message-id maybe-file)))
-
-   ;; if it's a string, simply make a fiddle-plex out of it and recurse
-   ((stringp feedmail-message-id-generator)
-	(let ((feedmail-message-id-generator (list "ignored" feedmail-message-id-generator 'create)))
-	  (feedmail-fiddle-message-id maybe-file)))
-
-   ;; if it's a function, call it and recurse with the resulting value
-   ((and (symbolp feedmail-message-id-generator) (fboundp feedmail-message-id-generator))
-	(let ((feedmail-message-id-generator (funcall feedmail-message-id-generator maybe-file)))
-	  (feedmail-fiddle-message-id maybe-file)))
-
-   ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
-   ((listp feedmail-message-id-generator)
-	(feedmail-fiddle-header
-	 (if feedmail-is-a-resend "Resent-Message-ID" "Message-ID")
-	 (nth 1 feedmail-message-id-generator)      ;; value
-	 (nth 2 feedmail-message-id-generator)      ;; action
-	 (nth 3 feedmail-message-id-generator)))))  ;; folding
-
-
-(defun feedmail-default-x-mailer-generator ()
-  "Default function for generating X-MAILER: header contents."
-  (feedmail-say-debug ">in-> feedmail-default-x-mailer-generator")
-  (concat
-   (let ((case-fold-search t)) (if (string-match "emacs" emacs-version) "" "emacs "))
-   emacs-version " (via feedmail " feedmail-patch-level
-   (if feedmail-queue-runner-is-active " Q" " I")
-   (if feedmail-enable-spray "S" "")
-   (if feedmail-x-mailer-line-user-appendage ") " ")")
-   feedmail-x-mailer-line-user-appendage))
-
-
-(defun feedmail-fiddle-x-mailer ()
-  "Fiddle X-MAILER:.  See documentation of feedmail-x-mailer-line."
-  (feedmail-say-debug ">in-> feedmail-fiddle-x-mailer")
-  ;; default is to fall off the end of the list and do nothing
-  (cond
-   ;; nil means do nothing
-   ((eq nil feedmail-x-mailer-line) nil)
-   ;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse
-   ((eq t feedmail-x-mailer-line)
-	(let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator)))
-	  (feedmail-fiddle-x-mailer)))
-
-   ;; if it's a string, simply make a fiddle-plex out of it and recurse
-   ((stringp feedmail-x-mailer-line)
-	(let ((feedmail-x-mailer-line (list "ignored" (list feedmail-x-mailer-line ";\n\t%s") 'combine)))
-	  (feedmail-fiddle-x-mailer)))
-
-   ;; if it's a function, call it and recurse with the resulting value
-   ((and (symbolp feedmail-x-mailer-line) (fboundp feedmail-x-mailer-line))
-	(let ((feedmail-x-mailer-line (funcall feedmail-x-mailer-line)))
-	  (feedmail-fiddle-x-mailer)))
-
-   ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
-   ((listp feedmail-x-mailer-line)
-	(feedmail-fiddle-header
-	 (if feedmail-is-a-resend "X-Resent-Mailer" "X-Mailer")
-	 (nth 1 feedmail-x-mailer-line)      ;; value
-	 (nth 2 feedmail-x-mailer-line)      ;; action
-	 (nth 3 feedmail-x-mailer-line)))))  ;; folding
-
-
-(defun feedmail-fiddle-spray-address (addy-plex)
-  "Fiddle header for single spray address.  Uses feedmail-spray-this-address."
-  (feedmail-say-debug ">in-> feedmail-fiddle-spray-address %s" addy-plex)
-  ;; default is to fall off the end of the list and do nothing
-  (cond
-   ;; nil means do nothing
-   ((eq nil addy-plex) nil)
-   ;; t means the same as using "TO: and unembellished addy
-   ((eq t addy-plex)
-	(let ((addy-plex (list "To" feedmail-spray-this-address)))
-	  (feedmail-fiddle-spray-address addy-plex)))
-
-   ;; if it's a string, simply make a fiddle-plex out of it and recurse, assuming
-   ;; the string names a header field (e.g., "TO")
-   ((stringp addy-plex)
-	(let ((addy-plex (list addy-plex feedmail-spray-this-address)))
-	  (feedmail-fiddle-spray-address addy-plex)))
-
-   ;; if it's a function, call it and recurse with the resulting value
-   ((and (symbolp addy-plex) (fboundp addy-plex))
-	(let ((addy-plex (funcall addy-plex)))
-	  (feedmail-fiddle-spray-address addy-plex)))
-
-   ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
-   ((listp addy-plex)
-	(feedmail-fiddle-header
-	 (nth 0 addy-plex)      ;; name
-	 (nth 1 addy-plex)      ;; value
-	 (nth 2 addy-plex)      ;; action
-	 (nth 3 addy-plex)))))  ;; folding
-
-
-(defun feedmail-fiddle-list-of-spray-fiddle-plexes (list-of-fiddle-plexes)
-  "Fiddling based on a list of fiddle-plexes for spraying."
-  (feedmail-say-debug ">in-> feedmail-fiddle-list-of-spray-fiddle-plexes")
-  ;; default is to fall off the end of the list and do nothing
-  (let ((lofp list-of-fiddle-plexes) fp)
-	(if (listp lofp)
-		(while lofp
-		  (setq fp (car lofp))
-		  (setq lofp (cdr lofp))
-		  (feedmail-fiddle-spray-address fp))
-	  (feedmail-fiddle-spray-address lofp))))
-
-
-(defun feedmail-fiddle-list-of-fiddle-plexes (list-of-fiddle-plexes)
-  "Fiddling based on a list of fiddle-plexes.  Values t, nil, and string are pointless."
-  (feedmail-say-debug ">in-> feedmail-fiddle-list-of-fiddle-plexes")
-  ;; default is to fall off the end of the list and do nothing
-  (let ((lofp list-of-fiddle-plexes) fp)
-	(while lofp
-	  (setq fp (car lofp))
-	  (setq lofp (cdr lofp))
-	  (cond
-
-	   ;; if it's a function, call it and recurse with the resulting value
-	   ((and (symbolp fp) (fboundp fp))
-		(let ((lofp (list (funcall fp)))) (feedmail-fiddle-list-of-fiddle-plexes lofp)))
-
-	   ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
-	   ((listp fp)
-		(feedmail-fiddle-header
-		 (nth 0 fp)
-		 (nth 1 fp)        ;; value
-		 (nth 2 fp)        ;; action
-		 (nth 3 fp)))))))  ;; folding
-
-
-(defun feedmail-accume-n-nuke-header (header-end header-regexp)
-  "Delete headers matching a regexp and their continuation lines.
-There may be multiple such lines, and each may have arbitrarily
-many continuation lines.  Return an accumulation of the deleted
-headers, including the intervening newlines."
-  (feedmail-say-debug ">in-> feedmail-accume-n-nuke-header %s %s" header-end header-regexp)
-  (let ((case-fold-search t) (dropout))
-	(save-excursion
-	  (goto-char (point-min))
-	  ;; iterate over all matching lines
-	  (while (re-search-forward header-regexp header-end t)
-		(forward-line 1)
-		(setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point))))
-		(delete-region (match-beginning 0) (point))
-		;; get rid of any continuation lines
-		(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
-		  (forward-line 1)
-		  (setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point))))
-		  (replace-match ""))))
-	(identity dropout)))
-
-(defun feedmail-fill-to-cc-function (header-end)
-  "Smart filling of address headers (don't be fooled by the name).
-The filling tries to avoid splitting lines except at commas.  This
-avoids, in particular, splitting within parenthesized comments in
-addresses.  Headers filled include FROM:, REPLY-TO:, TO:, CC:, BCC:,
-RESENT-TO:, RESENT-CC:, and RESENT-BCC:."
-  (feedmail-say-debug ">in-> feedmail-fill-to-cc-function")
-  (let ((case-fold-search t)
-		this-line
-		this-line-end)
-	(save-excursion
-	  (goto-char (point-min))
-	  ;; iterate over all TO:/CC:, etc, lines
-	  (while
-		  (re-search-forward
-		   "^\\(FROM:\\|REPLY-TO:\\|TO:\\|CC:\\|BCC:\\|RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)"
-		   header-end t)
-		(setq this-line (match-beginning 0))
-		;; replace 0 or more leading spaces with a single space
-		(and (looking-at "[ \t]*") (replace-match " "))
-		(forward-line 1)
-		;; get any continuation lines
-		(while (and (looking-at "[ \t]+") (< (point) header-end))
-		  (forward-line 1))
-		(setq this-line-end (point-marker))
-		(save-excursion (feedmail-fill-this-one this-line this-line-end))
-		))))
-
-
-(defun feedmail-fill-this-one (this-line this-line-end)
-  "In-place smart filling of the region bounded by the two arguments."
-  (feedmail-say-debug ">in-> feedmail-fill-this-one")
-  (let ((fill-prefix "\t")
-		(fill-column feedmail-fill-to-cc-fill-column))
-	;; The general idea is to break only on commas.  Collapse
-	;; multiple whitespace to a single blank; change
-	;; all the blanks to something unprintable; change the
-	;; commas to blanks; fill the region; change it back.
-	(goto-char this-line)
-	(while (re-search-forward "\\s-+" (1- this-line-end) t)
-	  (replace-match " "))
-	
-	(subst-char-in-region this-line this-line-end ?   2 t) ; blank->C-b
-	(subst-char-in-region this-line this-line-end ?, ?  t) ; comma->blank
-	
-	(fill-region-as-paragraph this-line this-line-end)
-	
-	(subst-char-in-region this-line this-line-end ?  ?, t) ; comma<-blank
-	(subst-char-in-region this-line this-line-end  2 ?  t) ; blank<-C-b
-	
-	;; look out for missing commas before continuation lines
-	(goto-char this-line)
-	(while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t)
-	  (replace-match "\\1,\n\t"))
-	))
-
-
-(require 'mail-utils)					; pick up mail-strip-quoted-names
-(defun feedmail-deduce-address-list (message-buffer header-start header-end addr-regexp address-list)
-  "Get address list with all comments and other excitement trimmed.
-Addresses are collected only from headers whose names match the fourth
-argument Returns a list of strings.  Duplicate addresses will have
-been weeded out."
-  (feedmail-say-debug ">in-> feedmail-deduce-address-list %s %s" addr-regexp address-list)
-  (let ((simple-address)
-		(address-blob)
-		(this-line)
-		(this-line-end))
-	(unwind-protect
-		(save-excursion
-		  (set-buffer (get-buffer-create " *FQM scratch*")) (erase-buffer)
-		  (insert-buffer-substring message-buffer header-start header-end)
-		  (goto-char (point-min))
-		  (let ((case-fold-search t))
-			(while (re-search-forward addr-regexp (point-max) t)
-			  (replace-match "")
-			  (setq this-line (match-beginning 0))
-			  (forward-line 1)
-			  ;; get any continuation lines
-			  (while (and (looking-at "^[ \t]+") (< (point) (point-max)))
-				(forward-line 1))
-			  (setq this-line-end (point-marker))
-			  ;; only keep if we don't have it already
-			  (setq address-blob
-					(mail-strip-quoted-names (buffer-substring-no-properties this-line this-line-end)))
-			  (while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob)
-				(setq simple-address (substring address-blob (match-beginning 2) (match-end 2)))
-				(setq address-blob (replace-match "" t t address-blob))
-				(if (not (member simple-address address-list))
-					(add-to-list 'address-list simple-address)))
-			  ))
-		  (kill-buffer nil)))
-	(identity address-list)))
-
-
-(defun feedmail-one-last-look (feedmail-prepped-text-buffer)
-  "Offer the user one last chance to give it up."
-  (feedmail-say-debug ">in-> feedmail-one-last-look")
-  (save-excursion
-	(save-window-excursion
-	  (switch-to-buffer feedmail-prepped-text-buffer)
-	  (if (and (fboundp 'y-or-n-p-with-timeout) (numberp feedmail-confirm-outgoing-timeout))
-		  (y-or-n-p-with-timeout
-		   "FQM: Send this email? "
-		   (abs feedmail-confirm-outgoing-timeout)
-		   (> feedmail-confirm-outgoing-timeout 0))
-		(y-or-n-p "FQM: Send this email? "))
-	  )))
-
-(defun feedmail-fqm-p (might-be)
-  "Internal; does filename end with FQM suffix?"
-  (feedmail-say-debug ">in-> feedmail-fqm-p %s" might-be)
-  (string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") might-be))
-
-
-(defun feedmail-say-debug (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9)
-  "Internal; emits debug messages in standard format."
-  (if feedmail-debug
-	  (progn
-		(funcall 'message (concat "FQM DB: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9)
-		(and feedmail-debug-sit-for (not (= 0 feedmail-debug-sit-for))
-			 (sit-for feedmail-debug-sit-for)))))
-
-(defun feedmail-say-chatter (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9)
-  "Internal; emits queue chatter messages in standard format."
-  (if feedmail-queue-chatty
-	  (progn
-		(funcall 'message (concat "FQM: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9)
-		(and feedmail-queue-chatty-sit-for (not (= 0 feedmail-queue-chatty-sit-for))
-			 (sit-for feedmail-queue-chatty-sit-for)))))
-
-(defun feedmail-find-eoh (&optional noerror)
-  "Internal; finds the end of message header fields, returns mark just before it"
-  ;; all this funny business with line endings is to account for CRLF
-  ;; weirdness that I don't think I'll ever figure out
-  (feedmail-say-debug ">in-> feedmail-find-eoh %s" noerror)
-  (let ((mhs mail-header-separator)
-		(alt-mhs feedmail-queue-alternative-mail-header-separator)
-		r-mhs r-alt-mhs)
-	(setq r-mhs (concat "^" (regexp-quote mhs) "$"))
-	(setq r-alt-mhs (concat "^" (regexp-quote (or alt-mhs "")) "$"))
-	(save-excursion
-	  (goto-char (point-min))
-	  (if (or
-		   (re-search-forward r-mhs nil t)
-		   (and alt-mhs (re-search-forward r-alt-mhs nil t)))
-		  (progn (beginning-of-line) (point-marker))
-		(if noerror
-			nil
-		  (error "FQM: Can't find message-header-separator or alternate"))))))
-
-(provide 'feedmail)
-;;; feedmail.el ends here
diff --git a/xemacs-packages/lisp/net-utils/google-query.el b/xemacs-packages/lisp/net-utils/google-query.el
deleted file mode 100644
index e69ab4f4..00000000
--- a/xemacs-packages/lisp/net-utils/google-query.el
+++ /dev/null
@@ -1,351 +0,0 @@
-;; google-query.el --- Query Google from within XEmacs.   -*- Emacs-Lisp -*-
-
-;; Copyright (C) 2003, 2004 Steve Youngs
-
-;; RCS: $Id: google-query.el,v 1.7 2005/05/01 01:09:38 youngs Exp $
-;; Author:        Steve Youngs 
-;; Maintainer:    Steve Youngs 
-;; Created:       <2003-12-16>
-;; Last-Modified: <2005-05-01 10:49:42 (steve)>
-;; Keywords:      web google search query
-
-;; This file is part of google-query.
-
-;; 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.
-;;
-;; 3. Neither the name of the author nor the names of any contributors
-;;    may be used to endorse or promote products derived from this
-;;    software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "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 THE REGENTS 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.
-
-;;; Commentary:
-;; 
-;;   I got the idea for this from Erik Arneson's `google-search.el'
-;;   which you can get from 
-;;
-;;   There are 2 entry points here, `google-query' and
-;;   `google-query-region'.  The former will prompt for a string to
-;;   query Google for, and the latter will query Google for whatever
-;;   text is in the active region in the current buffer.  Bind these
-;;   functions to some global keys for convenience.
-;;
-;;   Once the query completes XEmacs pops up a buffer containing
-;;   the query results, sans all the cruft an advertising you get
-;;   from Google.  Hitting button2 or RET on a URL will fire up your
-;;   default browser with that URL.
-
-;;; Todo:
-;;
-;;   
-
-;;; ChangeLog:
-;;
-;;  From this point on, `google-query.el' is in the XEmacs packages
-;;  CVS repository.  For further changes please consult
-;;  ./xemacs-packages/net-utils/ChangeLog.
-;;
-;;  Revision 1.4  2003-12-16 23:15:46+10  steve
-;;  Deactivate the region after sending the query from
-;;  `google-query-region' because processing the results works on
-;;  regions.
-;;
-;;  Revision 1.3  2003-12-16 18:38:10+10  steve
-;;  Rename `google-search-version' to `google-query-version'.
-;;
-;;  Revision 1.2  2003-12-16 18:24:50+10  steve
-;;  Fix a couple of byte-compiler warnings.
-;;
-;;  Revision 1.1  2003-12-16 17:10:03+10  steve
-;;  Initial revision
-;;
-
-;;; Code:
-
-(defun google-query-version (&optional arg)
-  "Return the current version info for google-query.
-
-With optional argument ARG, insert version info at point in the current
-buffer."
-  (interactive "P")
-  (let (ver)
-    (with-temp-buffer
-      (erase-buffer)
-      (insert-file (locate-library "google-query.el"))
-      (goto-char (point-min))
-      (re-search-forward 
-       "google-query\\.el,v\\s-\\([0-9]+[0-9\\.]*[0-9]+\\)" nil t)
-      (setq ver (match-string 1)))
-    (if (interactive-p)
-	(if arg
-	    (insert (format "Google Query v%s" ver))
-	  (message "Google Query v%s" ver))
-      ver)))
-
-(eval-and-compile
-  (autoload 'with-electric-help "ehelp")
-  (autoload 'browse-url "browse-url" nil t))
-
-(defgroup google nil
-  "Why leave XEmacs just to search Google..."
-  :prefix "google-"
-  :group 'hypermedia)
-
-(defcustom google-query-maxlen 100
-  "Maximum string length of query string.
-
-This prevents you from accidentally sending a five megabyte query
-string to Google.
-
-You can set this reasonably high, all the same.  I think the maximum
-length that Google can take is 2048 characters."
-  :type 'number
-  :group 'google)
-
-(defcustom google-query-result-count 10
-  "Max number of results to return from a `google-query'."
-  :type 'number
-  :group 'google)
-
-(defcustom google-query-mirror "www.google.com"
-  "*Your favourite Google mirror.
-
-Omit the \"http://\" part, all we want here is a domain."
-  :type 'string
-  :group 'google)
-
-(defcustom google-query-debug nil
-  "When non-nil keep the process buffer around."
-  :type 'boolean
-  :group 'google)
-
-(defun google-query-commentary ()
-  "*Display the commentary section of google-query.el."
-  (interactive)
-  (with-electric-help
-   '(lambda ()
-      (insert
-       (with-temp-buffer
-	 (erase-buffer)
-	 (insert (lm-commentary (locate-library "google-query.el")))
-	 (goto-char (point-min))
-	 (while (re-search-forward "^;+ ?" nil t)
-	   (replace-match "" nil nil))
-	 (buffer-string (current-buffer)))))
-   "*Google-query Commentary*"))
-
-(defun google-query-copyright ()
-  "*Display the copyright notice for google-query."
-  (interactive)
-  (with-electric-help
-   '(lambda ()
-      (insert
-       (with-temp-buffer
-	 (erase-buffer)
-	 (insert-file-contents (locate-library "google-query.el"))
-	 (goto-char (point-min))
-	 (re-search-forward ";;; Commentary" nil t)
-	 (beginning-of-line)
-	 (narrow-to-region (point-min) (point))
-	 (while (re-search-backward "^;+ ?" nil t)
-	   (replace-match "" nil nil))
-	 (buffer-string (current-buffer)))))
-   "*Google-query Copyright Notice*"))
-
-;; Ripped from thingatpt.el
-(defconst google-query-url-regexp
-  (concat
-   "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)"
-   "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+")
-  "A regular expression matching URLs.")
-
-(defun google-query-url-at-point ()
-  "Browse to a URL from the google-query buffer."
-  (interactive)
-  (when (extentp (extent-at (point)))
-    (browse-url (extent-string (extent-at (point))))))
-
-(defun google-query-url-at-mouse (event)
-  "Browse to a URL at EVENT via the mouse from the google-query buffer."
-  (interactive "e")
-  (when (extentp (extent-at-event event))
-    (browse-url (extent-string (extent-at-event event)))))
-
-(defun google-query-kill-buffer ()
-  (interactive)
-  (kill-buffer nil))
-
-(defconst google-query-mode-map
-  (let* ((map (make-sparse-keymap 'google-query-mode-map)))
-    (define-key map [space] 'scroll-up)
-    (define-key map [delete] 'scroll-down)
-    (define-key map [q] 'bury-buffer)
-    (define-key map [Q] 'google-query-kill-buffer)
-    map)
-  "A keymap for the google query buffer.")
-
-(defconst google-query-ext-map
-  (let* ((map (make-sparse-keymap 'google-query-ext-map)))
-    (define-key map [button2] 'google-query-url-at-mouse)
-    (define-key map [return] 'google-query-url-at-point)
-    map)
-  "A keymap for the extents in google query results buffer.")
-
-;; Unashamedly stolen from Bill Perry's URL package.
-(defconst google-query-unreserved-chars
-  '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
-       ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
-       ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
-       ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
-  "A list of characters that are _NOT_ reserved in the URL spec.
-This is taken from RFC 2396.")
-
-;; Unashamedly stolen from Bill Perry's URL package.
-(defun google-query-hexify-string (str)
-  "Escape characters STR so STR can be used in a URL."
-  (mapconcat
-   (lambda (char)
-     ;; Fixme: use a char table instead.
-     (if (not (memq char google-query-unreserved-chars))
-	 (if (< char 16)
-	     (format "%%0%X" char)
-	   (if (> char 255)
-	       (error "Hexifying multibyte character %s" str))
-	   (format "%%%X" char))
-       (char-to-string char)))
-   str ""))
-
-(defun google-query-make-url-extents ()
-  "Create extent objects for all the URLs in the buffer."
-  (goto-char (point-min))
-  (save-excursion
-    (while (re-search-forward google-query-url-regexp nil t)
-      (let ((extent (make-extent (match-beginning 0) (match-end 0)))
-	    (echo "RET or Button2 to visit this URL."))
-	(set-extent-property extent 'face 'bold)
-	(set-extent-property extent 'mouse-face 'highlight)
-	(set-extent-property extent 'keymap google-query-ext-map)
-	(set-extent-property extent 'help-echo echo)
-	(set-extent-property extent 'balloon-help echo)
-	(set-extent-property extent 'duplicable t)))))
-
-(defun google-query-mode ()
-  "Major mode for google-query results buffer.
-\\{google-query-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map google-query-mode-map)
-  (setq mode-name "Google")
-  (setq major-mode 'google-query-mode))
-
-(defun google-query-process-results (results)
-  "Process the RESULTS of `google-query'."
-  (let ((buf (get-buffer-create "*google-query-results*"))
-	matches)
-    (switch-to-buffer buf)
-    (google-query-mode)
-    (erase-buffer)
-    (insert results)
-    (goto-char (point-min))
-    ;; Get rid of lots of useless raw HTML and advertising.
-    (re-search-forward "dict&q=" nil t)
-    (forward-line 1)
-    (kill-region (point-min) (point))
-    (goto-char (point-min))
-    (re-search-forward "" nil t)
-      (setq matches (push (match-string 1) matches)))
-    (setq matches (nreverse matches))
-    ;; Replace the contents of the buffer with our matches.
-    (erase-buffer)
-    (insert "Google Query Results\n====================\n\n")
-    (while matches
-      (insert (car matches))
-      (insert "\n\n")
-      (setq matches (cdr matches)))
-    (goto-char (point-min))
-    (center-line 2)
-    (mapcar
-     '(lambda (x) (save-excursion (eval x)))
-     '((replace-string "" " ")
-       (replace-string "" "")
-       (replace-regexp "<.*>" " ")
-       (replace-string ">" " ")))
-    (save-excursion
-      (fill-region (point) (point-max)))
-    (google-query-make-url-extents)))
-
-;;;###autoload
-(defun google-query (string)
-  "Query google for STRING."
-  (interactive "sQuery Google for: ")
-  (let* ((host google-query-mirror)
-	 (user-agent (concat "XEmacs-" emacs-program-version))
-	 (str (google-query-hexify-string 
-	       (truncate-string-to-width string google-query-maxlen)))
-	 (query (concat "search?&q=" str 
-			"&num=" (format "%d" google-query-result-count)))
-	 (coding-system-for-read 'binary)
-	 (coding-system-for-write 'binary)
-	 (google (open-network-stream
-		  "google-query"
-		  " *google-query-proc*"
-		  host
-		  80))
-	 (pbuf (process-buffer google)))
-    (process-send-string
-     google
-     (concat "GET /" query " HTTP/1.1\r\n"
-	     "MIME-Version: 1.0\r\n"
-	     "Connection: close\r\n"
-	     "Extension: Security/Digest Security/SSL\r\n"
-	     "Host: " host "\r\n"
-	     "Accept: */*\r\n"
-	     "User-Agent: " user-agent "\r\n\r\n"))
-    (message "Talking to Google, please wait...")
-    (while (eq (process-status google) 'open)
-      (sleep-for 0.05))
-    (google-query-process-results (buffer-string pbuf))
-    (unless google-query-debug
-      (kill-buffer pbuf))))
-
-;;;###autoload    
-(defun google-query-region (beg end)
-  "Query google for the string BEG END."
-  (interactive "r")
-  (let ((str (buffer-substring-no-properties beg end)))
-    (zmacs-deactivate-region)
-    (google-query str)))
-
-(provide 'google-query)
-;;; google-query.el ends here
-
-;Local Variables:
-;time-stamp-start: "Last-Modified:[ 	]+\\\\?[\"<]+"
-;time-stamp-end: "\\\\?[\">]"
-;time-stamp-line-limit: 10
-;time-stamp-format: "%4y-%02m-%02d %02H:%02M:%02S (%u)"
-;End:
diff --git a/xemacs-packages/lisp/net-utils/metamail.el b/xemacs-packages/lisp/net-utils/metamail.el
deleted file mode 100644
index c3d15be5..00000000
--- a/xemacs-packages/lisp/net-utils/metamail.el
+++ /dev/null
@@ -1,226 +0,0 @@
-;;; metamail.el --- Metamail interface for GNU Emacs
-
-;; Copyright (C) 1993, 1996  Masanobu UMEDA
-
-;; Author: Masanobu UMEDA 
-;; Version: $Header: /pack/xemacscvs/XEmacs/packages/xemacs-packages/net-utils/metamail.el,v 1.3 2000/10/06 08:53:23 youngs Exp $
-;; Keywords: mail, news, mime, multimedia
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; I trashed all the differences this file had from the FSF version.
-;;  So sue me.  -sb
-
-;; The latest version will be at:
-;;	ftp://ftp.kyutech.ac.jp/pub/MultiMedia/mime/emacs-mime-tools.shar
-
-;; Note: Metamail does not have all options which is compatible with
-;; the environment variables.  For that reason, matamail.el have to
-;; hack the environment variables.  In addition, there is no way to
-;; display all header fields without extra informative body messages
-;; which are suppressed by "-q" option.
-
-;; The following definition is what I'm using with GNUS 4:
-;;(setq gnus-show-mime-method
-;;      (function
-;;       (lambda ()
-;;        (metamail-interpret-header)
-;;        (let ((metamail-switches     ;Suppress header fields in a body.
-;;               (append metamail-switches '("-q"))))
-;;          (metamail-interpret-body)))))
-
-;; The idea of using metamail to process MIME messages is from
-;; gnus-mime.el by Spike .
-
-;;; Code:
-
-(defgroup metamail nil
-  "Metamail interface for Emacs."
-  :group 'mail
-  :group 'hypermedia
-  :group 'processes)
-
-(defcustom metamail-program-name "metamail"
-  "*Metamail program name."
-  :type 'string
-  :group 'metamail)
-
-(defcustom metamail-mailer-name "emacs"
-  "*Mailer name set to MM_MAILER environment variable."
-  :type 'string
-  :group 'metamail)
-
-(defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
-  "*Environment variables passed to `metamail'.
-It must be a list of strings that have the format ENVVARNAME=VALUE.
-It is not expected to be altered globally by `set' or `setq'.
-Instead, change its value temporary using `let' or `let*' form.")
-
-(defcustom metamail-switches '("-x" "-d" "-z")
-  "*Switches for `metamail' program.
-`-z' is required to remove zap file.
-It is not expected to be altered globally by `set' or `setq'.
-Instead, change its value temporary using `let' or `let*' form.
-`-m MAILER' argument is automatically generated from the
-`metamail-mailer-name' variable."
-  :type '(repeat (string :tag "Switch"))
-  :group 'metamail)
-
-;;;###autoload
-(defun metamail-interpret-header ()
-  "Interpret a header part of a MIME message in current buffer.
-Its body part is not interpreted at all."
-  (interactive)
-  (save-excursion
-    (let* ((buffer-read-only nil)
-	   (metamail-switches           ;Inhibit processing an empty body.
-	    (append metamail-switches '("-c" "text/plain" "-E" "7bit")))
-	   (end (progn
-		  (goto-char (point-min))
-		  (search-forward "\n\n" nil 'move)
-		  ;; An extra newline is inserted by metamail if there
-		  ;; is no body part.  So, insert a dummy body by
-		  ;; itself.
-		  (insert "\n")
-		  (point))))
-      (metamail-region (point-min) end nil nil 'nodisplay)
-      ;; Remove an extra newline inserted by myself.
-      (goto-char (point-min))
-      (if (search-forward "\n\n\n" nil t)
-	  (delete-char -1))
-      )))
-
-;;;###autoload
-(defun metamail-interpret-body (&optional viewmode nodisplay)
-  "Interpret a body part of a MIME message in current buffer.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted.
-Its header part is not interpreted at all."
-  (interactive "p")
-  (save-excursion
-    (let ((contype nil)
-	  (encoding nil)
-         (end (progn
-                (goto-char (point-min))
-                (search-forward "\n\n" nil t)
-                (point))))
-      ;; Find Content-Type and Content-Transfer-Encoding from the header.
-      (save-restriction
-	(narrow-to-region (point-min) end)
-	(setq contype 
-	      (or (mail-fetch-field "Content-Type") "text/plain"))
-	(setq encoding 
-	      (or (mail-fetch-field "Content-Transfer-Encoding") "7bit")))
-      ;; Interpret the body part only.
-      (let ((metamail-switches         ;Process body part only.
-	     (append metamail-switches
-		     (list "-b" "-c" contype "-E" encoding))))
-	(metamail-region end (point-max) viewmode nil nodisplay))
-      ;; Mode specific hack.
-      (cond ((eq major-mode 'rmail-mode)
-	     ;; Adjust the marker of this message if in Rmail mode buffer.
-	     (set-marker (aref rmail-message-vector (1+ rmail-current-message))
-			 (point-max))))
-      )))
-
-;;;###autoload
-(defun metamail-buffer (&optional viewmode buffer nodisplay)
-  "Process current buffer through `metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted."
-  (interactive "p")
-  (metamail-region (point-min) (point-max) viewmode buffer nodisplay))
-
-;;;###autoload
-(defun metamail-region (beg end &optional viewmode buffer nodisplay)
-  "Process current region through 'metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted."
-  (interactive "r\np")
-  (let ((curbuf (current-buffer))
-	(buffer-read-only nil)
-	(metafile (make-temp-name "/tmp/metamail"))
-	(option-environment
-	 (list (format "EMACS_VIEW_MODE=%s" 
-		       (if (numberp viewmode) viewmode 1)))))
-    (save-excursion
-      ;; Gee!  Metamail does not output to stdout if input comes from
-      ;; stdin.
-      (let ((selective-display nil)  ;Disable ^M to nl translation.
-	    (kanji-fileio-code 2)    ;Write in JIS code when nemacs.
-	    (file-coding-system      ;Write in JUNET style when mule.
-	     (if (featurep 'mule) '*junet*))
-	    (coding-system-for-write ;Write in iso-2022-jp style
-	     'iso-2022-jp)           ;	when XEmacs/mule
-	    )
-	(write-region beg end metafile nil 'nomessage))
-      (if buffer
-	  (set-buffer buffer))
-      (setq buffer-read-only nil)
-      ;; Clear destination buffer.
-      (if (eq curbuf (current-buffer))
-	  (delete-region beg end)
-	(delete-region (point-min) (point-max)))
-      ;; We have to pass the environment variable KEYHEADS to display
-      ;; all header fields.  Metamail should have an optional argument
-      ;; to pass such information directly.
-      (let ((process-environment
-	     (append process-environment
-		     metamail-environment option-environment)))
-	;; Specify character coding system.
-	(if (boundp 'NEMACS)
-	    (define-program-kanji-code nil metamail-program-name 2)) ;JIS
-	(if (featurep 'mule)
-	    (if (fboundp 'define-program-coding-system)
-		(define-program-coding-system
-		  nil
-		  metamail-program-name
-		  'junet)
-	      ;; XEmacs with MULE
-	      (setq buffer-file-coding-system 'junet)))
-	(apply (function call-process)
-	       metamail-program-name
-	       nil
-	       t                        ;Output to current buffer
-	       (not nodisplay)          ;Force redisplay
-	       (append metamail-switches
-		       (list "-m" (or metamail-mailer-name "emacs"))
-		       (list metafile))))
-      ;; `metamail' may not delete the temporary file!
-      (condition-case error
-	  (delete-file metafile)
-	(error nil))
-      )))
-
-(provide 'metamail)
-
-;;; metamail.el ends here
diff --git a/xemacs-packages/lisp/net-utils/mozmail.el b/xemacs-packages/lisp/net-utils/mozmail.el
deleted file mode 100644
index 8d476ffc..00000000
--- a/xemacs-packages/lisp/net-utils/mozmail.el
+++ /dev/null
@@ -1,463 +0,0 @@
-;; mozmail.el --- Open mailto links from Mozilla in an (X)Emacs mailer.
-
-;; Copyright (C) 2003,04 Steve Youngs
-
-;; RCS: $Id: mozmail.el,v 1.8 2004/07/14 08:51:55 youngs Exp $
-;; Author:        Steve Youngs 
-;; Maintainer:    Steve Youngs 
-;; Created:       <2003-12-22>
-;; Last-Modified: <2004-06-10 18:43:58 (steve)>
-;; Homepage:      None, contact maintainer for the latest version.
-;;                Or get it from the XEmacs "net-utils" package.
-;; Keywords:      mail
-
-;; This file is part of mozmail.
-
-;; 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.
-;;
-;; 3. Neither the name of the author nor the names of any contributors
-;;    may be used to endorse or promote products derived from this
-;;    software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "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 THE REGENTS 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.
-
-;;; Commentary:
-;; 
-;;   Mozilla is a terrific web browser, but for mail and news I
-;;   much prefer XEmacs & Gnus.  Once this is set up, clicking on a
-;;   mailto link in Mozilla will fire up an (X)Emacs MUA with all
-;;   the appropriate fields filled in.  MUAs that are supported at
-;;   this time are: Gnus, VM, MH-E, MEW, Wanderlust, RMail, and the
-;;   built-in Emacs mailer.
-;;
-;; Setup (Mozilla):
-;;
-;;   To get this to work you will need a very recent version of Mozilla,
-;;   I was using 1.6b when I wrote this.  If you get `mozmail.el' to
-;;   work with older versions of Mozilla, please let me know.
-;;
-;;   The first thing you must do is tweak your Mozilla settings so
-;;   mailto links will invoke an external process.  Fire up Mozilla,
-;;   and in the location bar type: about:config
-;;
-;;   That will give you a list of all of your settings.  There are
-;;   litterally hundreds of them so prune them down by typing
-;;   "protocol-handler" in the filter bar.  Now right-click on one of
-;;   the items in the list and choose "New -> Boolean".  In the
-;;   resulting dialog, type:
-;;   "network.protocol-handler.external.mailto" (sans quotes).
-;;   Another dialog will appear prompting for a value for this new
-;;   variable, enter "true" (sans quotes).
-;;
-;;   Next, add another variable: right-click on a list item and choose "New
-;;   -> String", in the dialog put: "network.protocol-handler.app.mailto".
-;;   In the value dialog for this variable, put: "mozmail.sh".
-;;
-;;   That's all you need to do on the Mozilla side of things.  Restarting
-;;   Mozilla probably wouldn't be a bad idea.
-;;
-;; Setup (Shell Script):
-;;
-;;   You will also need a very small (2 line) wrapper script.  Copy
-;;   the following text to `mozmail.sh', put it somewhere in your
-;;   $PATH and make it executable.
-;;
-;;      #!/bin/bash
-;;      gnuclient -eval "(mozmail \"$1\")"
-;;
-;; Setup ((X)Emacs):
-;;
-;;   Add the following to your init file...
-;;
-;;   (gnuserv-start)
-;;   (require 'mozmail)
-;;
-;;   People who use MUA's other than Gnus will need to customise the
-;;   variable `mozmail-default-mua'.  See that variable's doc string
-;;   for details.
-;;
-;;   Gnus users can optionally customise `mozmail-gnus-is-plugged' to
-;;   run Gnus in either "plugged" or "unplugged" modes.
-;;
-;; Alternative Setup for GNOME users:
-;;
-;;   I received some feedback from a user who had this to say about
-;;   setting mozmail up with GNOME (on Debian):
-;;
-;;   Here's different way to enable it for GNOME users (at least on
-;;   Debian).  Instead of modifying Mozilla's preferences just run
-;;   gnome-default-applications-properties (see the
-;;   Applications/Desktop Preferences/Advanced/Preferred Applications
-;;   menu entry), on the "Mail Reader" tab select "Custom Mail Reader"
-;;   and enter "mozmail.sh %s".
-;;
-;;   With this mozmail gets used by all Mozilla based browser on my
-;;   system.
-
-;;; Todo:
-;;
-;;   o Can this be done without using gnuserv/gnuclient?
-
-;;; ChangeLog:
-;;
-;;  From this point on, `mozmail.el' is in the XEmacs packages CVS
-;;  repository.  For further changes please consult
-;;  ./xemacs-packages/net-utils/ChangeLog.
-;;
-;;  Revision 1.1  2003-12-23 14:49:47+10  steve
-;;  Initial revision
-;;
-
-;;; Code:
-(defun mozmail-version (&optional arg)
-  "Return the current version info for mozmail.
-
-With optional argument ARG, insert version info at point in the current
-buffer."
-  (interactive "P")
-  (let (ver)
-    (with-temp-buffer
-      (erase-buffer)
-      (insert-file (locate-library "mozmail.el"))
-      (goto-char (point-min))
-      (re-search-forward 
-       "mozmail\\.el,v\\s-\\([0-9]+[0-9\\.]*[0-9]+\\)" nil t)
-      (setq ver (match-string 1)))
-    (if (interactive-p)
-	(if arg
-	    (insert (format "mozmail v%s" ver))
-	  (message "mozmail v%s" ver))
-      ver)))
-
-(eval-and-compile
-  (if (featurep 'url-util)
-      (autoload 'url-unhex-string "url-util")
-    (autoload 'url-unhex-string "url"))
-  (autoload 'with-electric-help "ehelp")
-  (autoload 'gnus-alive-p "gnus-util")
-  (autoload 'gnus-group-mail "gnus-msg" nil t)
-  (autoload 'message-goto-to "message" nil t)
-  (autoload 'message-goto-subject "message" nil t)
-  (autoload 'message-goto-cc "message" nil t)
-  (autoload 'message-goto-bcc "message" nil t)
-  (autoload 'message-goto-body "message" nil t)
-  (autoload 'gnus "gnus" nil t)
-  (autoload 'vm-mail "vm-startup" nil t)
-  (autoload 'mew-send "mew" nil t)
-  (autoload 'wl-draft "wl-draft" nil t)
-  (autoload 'mh-smail "mh-comp" nil t)
-  (autoload 'rmail-mail "rmail" nil t)
-  (autoload 'mail-to "sendmail" nil t)
-  (autoload 'mail-cc "sendmail" nil t)
-  (autoload 'mail-bcc "sendmail" nil t)
-  (autoload 'mail-subject "sendmail" nil t)
-  (autoload 'mail-text "sendmail" nil t))
-
-(eval-when-compile
-  (defalias 'mozmail-compose 'ignore))
-
-(defun mozmail-commentary ()
-  "*Display the commentary section of mozmail.el."
-  (interactive)
-  (with-electric-help
-   '(lambda ()
-      (insert
-       (with-temp-buffer
-	 (erase-buffer)
-	 (insert (lm-commentary (locate-library "mozmail.el")))
-	 (goto-char (point-min))
-	 (while (re-search-forward "^;+ ?" nil t)
-	   (replace-match "" nil nil))
-	 (buffer-string (current-buffer)))))
-   "*Mozmail Commentary*"))
-
-(defun mozmail-copyright ()
-  "*Display the copyright notice for mozmail."
-  (interactive)
-  (with-electric-help
-   '(lambda ()
-      (insert
-       (with-temp-buffer
-	 (erase-buffer)
-	 (insert-file-contents (locate-library "mozmail.el"))
-	 (goto-char (point-min))
-	 (re-search-forward ";;; Commentary" nil t)
-	 (beginning-of-line)
-	 (narrow-to-region (point-min) (point))
-	 (while (re-search-backward "^;+ ?" nil t)
-	   (replace-match "" nil nil))
-	 (buffer-string (current-buffer)))))
-   "*Mozmail Copyright Notice*"))
-
-(defgroup mozmail nil
-  "Customisations for mozmail."
-  :prefix "mozmail-"
-  :group 'mail)
-
-(defcustom mozmail-gnus-is-plugged t
-  "*When non-nil use Gnus in \"plugged\" mode."
-  :type 'boolean
-  :group 'mozmail)
-
-(defcustom mozmail-default-mua gnus
-  "*The default \(X\)Emacs mailer to use.
-
-Valid symbols are: gnus, vm, mhe, mew, wanderlust, rmail, emacs.
-
-CAUTION: If you wish to set this variable outside of the custom
-interface, you MUST set it via `customize-set-variable'.
-
-For example:
-
-    \(customize-set-variable 'mozmail-default-mua 'gnus\)"
-  :type '(choice (const :tag "Gnus" :value gnus)
-		 (const :tag "VM" :value vm)
-		 (const :tag "MH-E" :value mhe)
-		 (const :tag "MEW" :value mew)
-		 (const :tag "Wanderlust" :value wanderlust)
-		 (const :tag "RMail" :value rmail)
-		 (const :tag "Emacs Mail" :value emacs))
-  :require 'mozmail
-  :initialize (lambda (symbol value)
-		(progn
-		  (let ((gnus 'gnus)
-			(vm 'vm)
-			(mhe 'mhe)
-			(mew 'mew)
-			(wanderlust 'wanderlust)
-			(rmail 'rmail)
-			(emacs 'emacs))
-		    (custom-initialize-default symbol value)
-		    (defalias 'mozmail-compose
-		      (intern (format "mozmail-compose-%s" value)))))
-		(message (format "%s set to %s" symbol value)))
-  :set (lambda (symbol value)
-	 (defalias 'mozmail-compose
-	   (intern (format "mozmail-compose-%s" value)))
-	 (message (format "%s set to %s" symbol value)))
-  :group 'mozmail)
-
-(defun mozmail-compose-gnus (to &optional subject cc bcc body)
-  "Compose a mail in Gnus from a Mozilla mailto link.
-
-Argument TO is the receipient of the mail.
-Optional argument SUBJECT is the mail's subject.
-Optional argument CC - carbon copy.
-Optional argument BCC - blind carbon copy.
-Optional argument BODY - text that will appear in the body of the
-mail."
-  (unless (gnus-alive-p)
-    (if mozmail-gnus-is-plugged
-	(gnus)
-      (gnus-unplugged)))
-  (gnus-group-mail)
-  (message-goto-to)
-  (insert (url-unhex-string to))
-  (when subject
-    (message-goto-subject)
-    (insert (url-unhex-string subject)))
-  (when cc
-    (message-goto-cc)
-    (insert (url-unhex-string cc)))
-  (when bcc
-    (message-goto-bcc)
-    (insert (url-unhex-string bcc)))
-  (when body
-    (message-goto-body)
-    (insert (url-unhex-string body 'allow-newlines))))
-
-(defun mozmail-populate-headers (to &optional subject cc bcc body)
-  "Populate the mail headers from a mailto link.
-
-Argument TO is the receipient of the mail.
-Optional argument SUBJECT is the mail's subject.
-Optional argument CC - carbon copy.
-Optional argument BCC - blind carbon copy.
-Optional argument BODY - text that will appear in the body of the
-mail."
-  (mail-to)
-  (insert (url-unhex-string to))
-  (when subject
-    (mail-subject)
-    (insert (url-unhex-string subject)))
-  (when cc
-    (mail-cc)
-    (insert (url-unhex-string cc)))
-  (when bcc
-    (mail-bcc)
-    (insert (url-unhex-string bcc)))
-  (when body
-    (mail-text)
-    (insert (url-unhex-string body 'allow-newlines))))
-
-(defun mozmail-compose-vm (to &optional subject cc bcc body)
-  "Compose a mail in VM from a Mozilla mailto link.
-
-Argument TO is the receipient of the mail.
-Optional argument SUBJECT is the mail's subject.
-Optional argument CC - carbon copy.
-Optional argument BCC - blind carbon copy.
-Optional argument BODY - text that will appear in the body of the
-mail."
-  (vm-mail)
-  (mozmail-populate-headers to subject cc bcc body))
-
-(defun mozmail-compose-mhe (to &optional subject cc bcc body)
-  "Compose a mail in MH-E from a Mozilla mailto link.
-
-Argument TO is the receipient of the mail.
-Optional argument SUBJECT is the mail's subject.
-Optional argument CC - carbon copy.
-Optional argument BCC - blind carbon copy.
-Optional argument BODY - text that will appear in the body of the
-mail."
-  (mh-smail)
-  (mozmail-populate-headers to subject cc bcc body))
-
-(defun mozmail-compose-mew (to &optional subject cc bcc body)
-  "Compose a mail in MEW from a Mozilla mailto link.
-
-Argument TO is the receipient of the mail.
-Optional argument SUBJECT is the mail's subject.
-Optional argument CC - carbon copy.
-Optional argument BCC - blind carbon copy.
-Optional argument BODY - text that will appear in the body of the
-mail."
-  (mew-send)
-  (mozmail-populate-headers to subject cc bcc body))
-
-(defun mozmail-compose-wanderlust (to &optional subject cc bcc body)
-  "Compose a mail in Wanderlust from a Mozilla mailto link.
-
-Argument TO is the receipient of the mail.
-Optional argument SUBJECT is the mail's subject.
-Optional argument CC - carbon copy.
-Optional argument BCC - blind carbon copy.
-Optional argument BODY - text that will appear in the body of the
-mail."
-  (wl-draft)
-  (mozmail-populate-headers to subject cc bcc body))
-
-(defun mozmail-compose-emacs (to &optional subject cc bcc body)
-  "Compose a mail in Emacs from a Mozilla mailto link.
-
-Argument TO is the receipient of the mail.
-Optional argument SUBJECT is the mail's subject.
-Optional argument CC - carbon copy.
-Optional argument BCC - blind carbon copy.
-Optional argument BODY - text that will appear in the body of the
-mail."
-  (mail)
-  (mozmail-populate-headers to subject cc bcc body))
-
-(defun mozmail-compose-rmail (to &optional subject cc bcc body)
-  "Compose a mail in RMail from a Mozilla mailto link.
-
-Argument TO is the receipient of the mail.
-Optional argument SUBJECT is the mail's subject.
-Optional argument CC - carbon copy.
-Optional argument BCC - blind carbon copy.
-Optional argument BODY - text that will appear in the body of the
-mail."
-  (rmail-mail)
-  (mozmail-populate-headers to subject cc bcc body))
-
-(defun mozmail-split-string (string char)
-  "Does `split-string-by-char' in XEmacs and `split-string' in GNU/Emacs."
-  (if (featurep 'xemacs)
-      ;; XEmacs
-      (split-string-by-char string char)
-    ;; GNU/Emacs
-    (split-string string (char-to-string char))))
-
-(defun mozmail-split-url (url sym)
-  "Split a mailto URL into its various components.
-
-Argument URL is a mailto URL.
-Argument SYM is a symbol representing the field name that you
-want a value for.  Valid symbols are: `to', `subject', `cc', `bcc',
-and `body'."
-  (let ((value nil))
-    (cond ((eq sym 'to)
-	   (setq value (substring (car (mozmail-split-string url ?\?)) 7)))
-	  ((eq sym 'subject)
-	   (setq url (cdr (mozmail-split-string url ?\?)))
-	   (when url
-	     (setq url (mozmail-split-string (car url) ?&))
-	     (while url
-	       (when (string= "subject=" (downcase (substring (car url) 0 8)))
-		 (setq value (substring (car url) 8)))
-	       (setq url (cdr url)))))
-	  ((eq sym 'cc)
-	   (setq url (cdr (mozmail-split-string url ?\?)))
-	   (when url
-	     (setq url (mozmail-split-string (car url) ?&))
-	     (while url
-	       (when (string= "cc=" (downcase (substring (car url) 0 3)))
-		 (setq value (substring (car url) 3)))
-	       (setq url (cdr url)))))
-	  ((eq sym 'bcc)
-	   (setq url (cdr (mozmail-split-string url ?\?)))
-	   (when url
-	     (setq url (mozmail-split-string (car url) ?&))
-	     (while url
-	       (when (string= "bcc=" (downcase (substring (car url) 0 4)))
-		 (setq value (substring (car url) 4)))
-	       (setq url (cdr url)))))
-	  ((eq sym 'body)
-	   (setq url (cdr (mozmail-split-string url ?\?)))
-	   (when url
-	     (setq url (mozmail-split-string (car url) ?&))
-	     (while url
-	       (when (string= "body=" (downcase (substring (car url) 0 5)))
-		 (setq value (substring (car url) 5)))
-	       (setq url (cdr url)))))
-	  (t
-	   (error 'invalid-argument sym)))
-    value))
-
-(defun mozmail (url)
-  "Use an (X)Emacs MUA as the target of a Mozilla mailto link.
-
-See `mozmail-commentary' for instructions on how to set this up in
-Mozilla."
-  ;; A URL that consists of just "mailto:" and nothing else is obviously
-  ;; wrong.
-  (when (string= (substring url 7) "")
-    (error 'invalid-argument url))
-  (let ((to (mozmail-split-url url 'to))
-	(subject (mozmail-split-url url 'subject))
-	(cc (mozmail-split-url url 'cc))
-	(bcc (mozmail-split-url url 'bcc))
-	(body (mozmail-split-url url 'body)))
-    (mozmail-compose to subject cc bcc body)))
-
-(provide 'mozmail)
-
-;;; mozmail.el ends here
-
-;Local Variables:
-;time-stamp-start: "Last-Modified:[ 	]+\\\\?[\"<]+"
-;time-stamp-end: "\\\\?[\">]"
-;time-stamp-line-limit: 10
-;time-stamp-format: "%4y-%02m-%02d %02H:%02M:%02S (%u)"
-;End:
diff --git a/xemacs-packages/lisp/net-utils/net-utils.el b/xemacs-packages/lisp/net-utils/net-utils.el
deleted file mode 100644
index d43e2ce1..00000000
--- a/xemacs-packages/lisp/net-utils/net-utils.el
+++ /dev/null
@@ -1,674 +0,0 @@
-;;; net-utils.el --- Network functions
-
-;; Author:  Peter Breton 
-;; Created: Sun Mar 16 1997
-;; Version: $Id: net-utils.el,v 1.4 2003/12/03 01:35:17 youngs Exp $
-;; Keywords: 
-;; Time-stamp: 
-
-;;; Commentary:
-;;
-;; There are three main areas of functionality:
-;; 
-;; * Wrap common network utility programs (ping, traceroute, netstat,
-;; nslookup, arp, route). Note that these wrappers are of the diagnostic
-;; functions of these programs only.
-;; 
-;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
-;; 
-;; * Support connections to HOST/PORT, generally for debugging and the like.
-;; In other words, for doing much the same thing as "telnet HOST PORT", and
-;; then typing commands.
-
-;;; Change log:
-;;
-;; Revision 1.1  1998/03/26 03:39:21  steveb
-;; New file net-utils.el.
-;;
-;; Revision 1.5  1998/03/11 00:27:18  pbreton
-;; Changed name to net-utils
-;; Added AUTOLOAD comments
-;; Added net-utils-version variable
-;; Don't use /usr/sbin/ping anymore, depend on ping-program-options
-;; ping-program-options default set for Linux
-;; Finger can now take USER@HOST as an argument
-;; network-service-connection is no longer interactive
-;;
-;; Revision 1.4  1998/03/06 03:57:03  pbreton
-;; Changed defvars to defcustoms
-;; Use /usr/sbin/ping (if it exists) instead of ping
-;; Fixed typo in traceroute-program
-;; Fontlock is no longer required
-;;
-;; Revision 1.2  1998/03/05 12:05:15  pbreton
-;; Posted to gnu.emacs.sources
-;;
-;; Revision 1.1  1998/03/05 11:31:28  pbreton
-;; Initial revision
-;;
-;;
-;; AUTOLOADS
-;;
-;; Put these in your .emacs, or just require the whole file. 
-;; 
-;; (autoload 'traceroute                    "net-utils" nil t)
-;; (autoload 'ping			    "net-utils" nil t)
-;; (autoload 'ipconfig			    "net-utils" nil t)
-;; (autoload 'arp			    "net-utils" nil t)
-;; (autoload 'route			    "net-utils" nil t)
-;; (autoload 'netstat			    "net-utils" nil t)
-;; (autoload 'nslookup			    "net-utils" nil t)
-;; (autoload 'nslookup-host		    "net-utils" nil t)
-;; (autoload 'finger			    "net-utils" nil t)
-;; (autoload 'whois			    "net-utils" nil t)
-;; (autoload 'network-connection            "net-utils" nil t)
-;; (autoload 'network-connection-to-service "net-utils" nil t)
-
-
-;;; Code:
-(eval-when-compile
-  (require 'comint)
-  (autoload 'ffap-string-at-point "ffap"))
-
-(defconst net-utils-version (substring "$Revision: 1.4 $" 11 -2)
-  "The version number of net-utils (as string).  The complete RCS id is:
-
-  $Id: net-utils.el,v 1.4 2003/12/03 01:35:17 youngs Exp $")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Customization Variables
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defgroup net-utils nil
-  "Network utility functions."
-  :prefix "dirtrack-"
-  :group 'shell
-  )
-
-(defcustom net-utils-remove-ctl-m 
-  (member system-type (list 'windows-nt 'msdos))
-  "If non-nil, remove control-Ms from output."
-  :group 'net-utils
-  :type  'boolean
-  )
-
-(defcustom traceroute-program  
-  (if (eq system-type 'windows-nt) 
-      "tracert"
-    "traceroute")
-  "Program to trace network hops to a destination."
-  :group 'net-utils
-  :type  'string
-  )
-
-(defcustom traceroute-program-options nil
-  "Options for the traceroute program."
-  :group 'net-utils
-  :type  '(repeat string)
-  )
-
-(defcustom ping-program "ping"
-  "Program to send network test packets to a host."
-  :group 'net-utils
-  :type  'string
-  )
-
-;; On Linux and Irix, the system's ping program seems to send packets
-;; indefinitely unless told otherwise
-(defcustom ping-program-options 
-  (and (memq system-type (list 'linux 'gnu/linux 'irix))
-       (list "-c" "4"))
-  "Options for the ping program.
-These options can be used to limit how many ICMP packets are emitted."
-  :group 'net-utils
-  :type  '(repeat string)
-  )
-
-(defcustom ipconfig-program  
-  (if (eq system-type 'windows-nt)
-      "ipconfig"
-    "ifconfig")
-  "Program to print network configuration information."
-  :group 'net-utils
-  :type  'string
-  )
-
-(defcustom ipconfig-program-options
-   (list    
-    (if (eq system-type 'windows-nt)
-	"/all" "-a"))
-  "Options for ipconfig-program."
-  :group 'net-utils
-  :type  '(repeat string)
-  )
-
-(defcustom netstat-program  "netstat"
-  "Program to print network statistics."
-  :group 'net-utils
-  :type  'string
-  )
-
-(defcustom netstat-program-options nil
-  "Options for netstat-program."
-  :group 'net-utils
-  :type  '(repeat string)
-  )
-
-(defcustom arp-program  "arp"
-  "Program to print IP to address translation tables."
-  :group 'net-utils
-  :type  'string
-  )
-
-(defcustom arp-program-options 
-  (list "-a")
-  "Options for arp-program."
-  :group 'net-utils
-  :type  '(repeat string)
-  )
-
-(defcustom route-program  
-  (if (eq system-type 'windows-nt)
-      "route"
-    "netstat")
-  "Program to print routing tables."
-  :group 'net-utils
-  :type  'string
-  )
-
-(defcustom route-program-options 
-  (if (eq system-type 'windows-nt)
-      (list "print")
-    (list "-r"))
-  "Options for route-program."
-  :group 'net-utils
-  :type  '(repeat string)
-  )
-
-(defcustom nslookup-program  "nslookup"
-  "Program to interactively query DNS information."
-  :group 'net-utils
-  :type  'string
-  )
-
-(defcustom nslookup-program-options  nil
-  "List of options to pass to the nslookup program."
-  :group 'net-utils
-  :type  '(repeat string)
-  )
-
-(defcustom nslookup-prompt-regexp "^> "
-  "Regexp to match the nslookup prompt."
-  :group 'net-utils
-  :type  'regexp
-  )
-
-(defcustom ftp-program "ftp"
-  "Progam to run to do FTP transfers."
-  :group 'net-utils
-  :type  'string
-  )
-
-(defcustom ftp-program-options nil
-  "List of options to pass to the FTP program."
-  :group 'net-utils
-  :type  '(repeat string)
-  )
-
-(defcustom ftp-prompt-regexp "^ftp>"
-  "Regexp which matches the FTP program's prompt."
-  :group 'net-utils
-  :type  'regexp
-  )
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Nslookup goodies
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defconst nslookup-font-lock-keywords
-  (and window-system
-       (progn
-	 (require 'font-lock)
-	 (list
-	  (list nslookup-prompt-regexp 0 font-lock-reference-face)
-	  (list "^[A-Za-z0-9 _]+:"     0 font-lock-type-face)
-	  (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>" 
-		1 font-lock-keyword-face)
-	  ;; Dotted quads
-	  (list 
-	   (mapconcat 'identity
-		      (make-list 4 "[0-9]+")
-		      "\\.")
-	   0 font-lock-variable-name-face)
-	  ;; Host names
-	  (list 
-	   (let ((host-expression "[-A-Za-z0-9]+"))
-	     (concat 
-	      (mapconcat 'identity
-			 (make-list 2 host-expression)
-			 "\\.")
-	      "\\(\\." host-expression "\\)*")
-	     )
-	   0 font-lock-variable-name-face)
-	  )))
-	 "Expressions to font-lock for nslookup.")
-
-(defvar nslookup-abbrev-table (make-abbrev-table)
-  "Abbrev table for nslookup.")
-
-(define-abbrev nslookup-abbrev-table "e"   "exit")
-(define-abbrev nslookup-abbrev-table "f"   "finger")
-(define-abbrev nslookup-abbrev-table "h"   "help")
-(define-abbrev nslookup-abbrev-table "lse" "lserver")
-(define-abbrev nslookup-abbrev-table "r"   "root")
-(define-abbrev nslookup-abbrev-table "s"   "set")
-(define-abbrev nslookup-abbrev-table "se"  "server")
-(define-abbrev nslookup-abbrev-table "v"   "viewer")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; FTP goodies
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar ftp-abbrev-table (make-abbrev-table)
-  "Abbrev table for ftp.")
-
-(define-abbrev ftp-abbrev-table "q"    "quit")
-(define-abbrev ftp-abbrev-table "g"    "get")
-(define-abbrev ftp-abbrev-table "p"    "prompt")
-(define-abbrev ftp-abbrev-table "anon" "anonymous")
-
-(defconst ftp-font-lock-keywords
-  (and window-system
-       (progn
-	 (require 'font-lock)
-	 (list
-	  (list ftp-prompt-regexp 0 font-lock-reference-face)))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Utility functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun net-utils-remove-ctrl-m-filter (process output-string)
-  "Remove trailing control Ms."
-  (let ((old-buffer (current-buffer))
-	(filtered-string output-string))
-    (unwind-protect
-	(let ((moving))
-	  (set-buffer (process-buffer process))
-	  (setq moving (= (point) (process-mark process)))
-	  
-	  (while (string-match "\r" filtered-string)
-	       (setq filtered-string
-		     (replace-match "" nil nil filtered-string)))
-
-	  (save-excursion
-	    ;; Insert the text, moving the process-marker.
-	    (goto-char (process-mark process))
-	    (insert filtered-string)
-	    (set-marker (process-mark process) (point)))
-	  (if moving (goto-char (process-mark process))))
-      (set-buffer old-buffer))))
-  
-(defmacro net-utils-run-program (name header program &rest args)
-  "Run a network information program."
-  (` 
-   (let ((buf (get-buffer-create (concat "*" (, name) "*"))))
-     (set-buffer buf)
-     (erase-buffer)
-     (insert (, header) "\n")
-     (set-process-filter 
-      (apply 'start-process (, name) buf (, program) (,@ args))
-      'net-utils-remove-ctrl-m-filter)
-     (display-buffer buf))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Wrappers for external network programs
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;###autoload
-(defun traceroute (target)
-  "Run traceroute program for TARGET."
-  (interactive "sTarget: ")
-  (let ((options 
-	 (if traceroute-program-options
-	     (append traceroute-program-options (list target))
-	   (list target))))
-    (net-utils-run-program
-     (concat "Traceroute" " " target)
-     (concat "** Traceroute ** " traceroute-program " ** " target)
-     traceroute-program
-     options
-     )))
-
-;;;###autoload
-(defun ping (host)
-  "Ping HOST.
-If your system's ping continues until interrupted, you can try setting 
-`ping-program-options'."
-  (interactive 
-   (list
-    (progn
-      (require 'ffap)
-      (read-from-minibuffer 
-       "Ping host: " 
-       (or (ffap-string-at-point 'machine) "")))))
-  (let ((options 
-	 (if ping-program-options
-	     (append ping-program-options (list host))
-	   (list host))))
-    (net-utils-run-program
-     (concat "Ping" " " host)
-     (concat "** Ping ** " ping-program " ** " host)
-     ping-program
-     options
-     )))
-
-;;;###autoload
-(defun ipconfig ()
-  "Run ipconfig program."
-  (interactive)
-  (net-utils-run-program
-   "Ipconfig"
-   (concat "** Ipconfig ** " ipconfig-program " ** ")
-   ipconfig-program
-   ipconfig-program-options
-   ))
-
-;; This is the normal name on most Unixes.
-;;;###autoload
-(defalias 'ifconfig 'ipconfig) 
-
-;;;###autoload
-(defun netstat ()
-  "Run netstat program."
-  (interactive)
-  (net-utils-run-program
-   "Netstat"
-   (concat "** Netstat ** " netstat-program " ** ")
-   netstat-program
-   netstat-program-options
-   ))
-
-;;;###autoload
-(defun arp ()
-  "Run the arp program."
-  (interactive)
-  (net-utils-run-program
-   "Arp"
-   (concat "** Arp ** " arp-program " ** ")
-   arp-program
-   arp-program-options
-   ))
-
-;;;###autoload
-(defun route ()
-  "Run the route program."
-  (interactive)
-  (net-utils-run-program
-   "Route"
-   (concat "** Route ** " route-program " ** ")
-   route-program
-   route-program-options
-   ))
-
-;; FIXME -- Needs to be a process filter
-;; (defun netstat-with-filter (filter)
-;;   "Run netstat program."
-;;   (interactive "sFilter: ")
-;;   (netstat)
-;;   (set-buffer (get-buffer "*Netstat*"))
-;;   (goto-char (point-min))
-;;   (delete-matching-lines filter)
-;;   )
-
-;;;###autoload
-(defun nslookup-host (host)
-  "Lookup the DNS information for HOST."
-  (interactive
-   (list
-    (read-from-minibuffer 
-     "Lookup host: " 
-     (or (ffap-string-at-point 'machine) ""))))
-  (let ((options 
-	 (if nslookup-program-options
-	     (append nslookup-program-options (list host))
-	   (list host))))
-    (net-utils-run-program
-     "Nslookup"
-     (concat "** "
-      (mapconcat 'identity
-		(list "Nslookup" host nslookup-program)
-		" ** "))
-     nslookup-program
-     options
-     )))
-
-;;;###autoload
-(defun nslookup ()
-  "Run nslookup program."
-  (interactive)
-  (comint-run nslookup-program)
-  (set-process-filter (get-buffer-process "*nslookup*")
-   'net-utils-remove-ctrl-m-filter)
-  (set 
-   (make-local-variable 'font-lock-defaults)
-   '((nslookup-font-lock-keywords)))
-  (set 
-   (make-local-variable 'local-abbrev-table)
-   nslookup-abbrev-table)
-  (abbrev-mode t)
-  (make-local-variable 'comint-prompt-regexp)
-  (setq comint-prompt-regexp nslookup-prompt-regexp)
-  )
-
-;; This is a lot less than ange-ftp, but much simpler.
-;;;###autoload
-(defun ftp (host)
-  "Run ftp program."
-  (interactive "sFtp to Host: ")
-  (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
-    (set-buffer buf)
-    (comint-mode)
-    (comint-exec buf (concat "ftp-" host) ftp-program nil
-		 (if ftp-program-options
-		     (append (list host) ftp-program-options)
-		   (list host)))
-    (set 
-     (make-local-variable 'font-lock-defaults)
-     '((ftp-font-lock-keywords)))
-
-    (make-local-variable 'comint-prompt-regexp)
-    (setq comint-prompt-regexp ftp-prompt-regexp)
-
-    ;; Already buffer local!
-    (setq comint-output-filter-functions
-	  (list 'comint-watch-for-password-prompt))
-    (set 
-     (make-local-variable 'local-abbrev-table)
-     ftp-abbrev-table)
-    (abbrev-mode t)
-    (switch-to-buffer-other-window buf)
-    ))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Network Connections
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Full list is available at:
-;; ftp://ftp.isi.edu/in-notes/iana/assignments/port-numbers
-(defvar network-connection-service-alist 
-  (list
-    (cons 'echo          7)
-    (cons 'active-users 11)
-    (cons 'daytime      13)
-    (cons 'chargen      19)
-    (cons 'ftp          21)
-    (cons 'telnet	23)
-    (cons 'smtp		25)
-    (cons 'time		37)
-    (cons 'whois        43)
-    (cons 'gopher       70)
-    (cons 'finger       79)
-    (cons 'www		80)
-    (cons 'pop2		109)
-    (cons 'pop3		110)
-    (cons 'sun-rpc	111)
-    (cons 'nntp		119)
-    (cons 'ntp		123)
-    (cons 'netbios-name 137)
-    (cons 'netbios-data 139)
-    (cons 'irc		194)
-    (cons 'https	443)
-    (cons 'rlogin	513)
-    )
-  "Alist of services and associated TCP port numbers.
-This list in not complete.")
-
-;; Workhorse macro
-(defmacro run-network-program (process-name host port 
-					    &optional initial-string)
-  (`
-   (let ((tcp-connection)
-	 (buf)
-	 )
-    (setq buf (get-buffer-create (concat "*" (, process-name) "*")))
-    (set-buffer buf)
-    (or 
-     (setq tcp-connection
-	   (open-network-stream 
-	    (, process-name)
-	    buf
-	    (, host)
-	    (, port)
-	    ))
-     (error "Could not open connection to %s" (, host)))
-    (erase-buffer)
-    (set-marker (process-mark tcp-connection) (point-min))
-    (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
-    (and (, initial-string)
-	 (process-send-string tcp-connection 
-			      (concat (, initial-string) "\r\n")))
-    (display-buffer buf))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Simple protocols
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Finger protocol
-;;;###autoload
-(defun finger (user host)
-  "Finger USER on HOST."
-  ;; One of those great interactive statements that's actually
-  ;; longer than the function call! The idea is that if the user
-  ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
-  ;; host name. If we don't see an "@", we'll prompt for the host.
-  (interactive
-    (progn
-      (require 'ffap)
-      (let* ((answer (read-from-minibuffer "Finger User: " 
-					   (ffap-string-at-point 'url))) 
-	     (index  (string-match (regexp-quote "@") answer))
-	     )
-	(if index
-	    (list 
-	     (substring answer 0 index)
-	     (substring answer (1+ index)))
-	  (list
-	   answer
-	   (read-from-minibuffer 
-	    "At Host: " 
-	    (or (ffap-string-at-point 'machine) "")))))))
-  (let* (
-	 (user-and-host (concat user "@" host))
-	 (process-name 
-	  (concat "Finger [" user-and-host "]"))
-	 )
-    (run-network-program 
-     process-name 
-     host 
-     (cdr (assoc 'finger network-connection-service-alist))
-     user-and-host
-     )))
-
-(defcustom whois-server-name "whois.internic.net"
-  "Host name for the whois service."
-  :group 'net-utils
-  :type  'string
-  )
-
-;; Whois protocol
-;;;###autoload
-(defun whois (arg search-string)
-  "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
-With argument, prompt for whois server."
-  (interactive "P\nsWhois: ")
-  (let ((host 
-	 (if arg
-	     (read-from-minibuffer "Whois server name: ")
-	   whois-server-name))
-	)
-    (run-network-program 
-     "Whois"
-     host
-     (cdr (assoc 'whois network-connection-service-alist))
-     search-string
-     )))
-
-(defcustom whois-reverse-lookup-server "whois.arin.net"
-  "Server which provides inverse DNS mapping."
-  :group 'net-utils
-  :type  'string
-  )
-
-;;;###autoload
-(defun whois-reverse-lookup ()
-  (interactive)
-  (let ((whois-server-name whois-reverse-lookup-server))
-    (call-interactively 'whois)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; General Network connection
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;###autoload
-(defun network-connection-to-service (host service)
-  "Open a network connection to SERVICE on HOST."
-  (interactive 
-   (list
-    (progn
-      (require 'ffap)
-      (read-from-minibuffer "Host: " 
-			    (ffap-string-at-point 'machine)))
-    (completing-read "Service: " 
-		     (mapcar 
-		      (function 
-		       (lambda (elt)
-			 (list (symbol-name (car elt)))))
-		      network-connection-service-alist))))
-  (network-connection 
-   host 
-   (cdr (assoc (intern service) network-connection-service-alist)))
-  )
-
-;;;###autoload
-(defun network-connection (host port)
-  "Open a network connection to HOST on PORT."
-  (interactive "sHost: \nnPort: ")
-  (network-service-connection host (number-to-string port)))
-
-(defun network-service-connection (host service)
-  "Open a network connection to SERVICE on HOST."
-  (let (
-	(process-name (concat "Network Connection [" host " " service "]"))
-	(portnum (string-to-number service))
-	)
-    (or (zerop portnum) (setq service portnum))
-    (make-comint 
-     process-name
-     (cons host service))
-    (pop-to-buffer (get-buffer (concat "*" process-name "*")))
-    ))
-
-(provide 'net-utils)
-
-;;; net-utils.el ends here
diff --git a/xemacs-packages/lisp/net-utils/rcompile.el b/xemacs-packages/lisp/net-utils/rcompile.el
deleted file mode 100644
index f4373cfb..00000000
--- a/xemacs-packages/lisp/net-utils/rcompile.el
+++ /dev/null
@@ -1,197 +0,0 @@
-;;; rcompile.el --- run a compilation on a remote machine
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Albert    
-;; Maintainer: FSF
-;; Created: 1993 Oct 6
-;; Version: 1.1
-;; Keywords: tools, processes
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This package is for running a remote compilation and using emacs to parse
-;; the error messages. It works by rsh'ing the compilation to a remote host
-;; and parsing the output. If the file visited at the time remote-compile was
-;; called was loaded remotely (ange-ftp), the host and user name are obtained
-;; by the calling ange-ftp-ftp-name on the current directory. In this case the
-;; next-error command will also ange-ftp the files over. This is achieved
-;; automatically because the compilation-parse-errors function uses
-;; default-directory to build it's file names. If however the file visited was
-;; loaded locally, remote-compile prompts for a host and user and assumes the
-;; files mounted locally (otherwise, how was the visited file loaded).
-
-;; See the user defined variables section for more info.
-
-;; I was contemplating redefining "compile" to "remote-compile" automatically
-;; if the file visited was ange-ftp'ed but decided against it for now. If you
-;; feel this is a good idea, let me know and I'll consider it again.
-
-;;; Installation:
-
-;; To use rcompile, you also need to give yourself permission to connect to
-;; the remote host.  You do this by putting lines like:
-
-;; monopoly alon
-;; vme33
-;;
-;; in a file named .rhosts in the home directory (of the remote machine).
-;; Be careful what you put in this file. A line like:
-;;
-;; +
-;;
-;; Will allow anyone access to your account without a password. I suggest you
-;; read the rhosts(5) manual page before you edit this file (if you are not
-;; familiar with it already) 
-
-;;; Code:
-
-(provide 'rcompile)
-(require 'compile)
-;;; The following should not be needed.
-;;; (eval-when-compile (require 'ange-ftp))
-
-;;;; user defined variables
-
-(defgroup remote-compile nil
-  "Run a compilation on a remote machine"
-  :group 'processes
-  :group 'tools)
-
-
-(defcustom remote-compile-host nil
-  "*Host for remote compilations."
-  :type '(choice string (const nil))
-  :group 'remote-compile)
-
-(defcustom remote-compile-user nil
-  "User for remote compilations.
-nil means use the value returned by \\[user-login-name]."
-  :type '(choice string (const nil))
-  :group 'remote-compile)
-
-(defcustom remote-compile-run-before nil
-  "*Command to run before compilation.
-This can be used for setting up environment variables,
-since rsh does not invoke the shell as a login shell and files like .login
-\(tcsh\) and .bash_profile \(bash\) are not run.
-nil means run no commands."
-  :type '(choice string (const nil))
-  :group 'remote-compile)
-
-(defcustom remote-compile-prompt-for-host nil
-  "*Non-nil means prompt for host if not available from filename."
-  :type 'boolean
-  :group 'remote-compile)
-
-(defcustom remote-compile-prompt-for-user nil
-  "*Non-nil means prompt for user if not available from filename."
-  :type 'boolean
-  :group 'remote-compile)
-
-;;;; internal variables
-
-;; History of remote compile hosts and users
-(defvar remote-compile-host-history nil)
-(defvar remote-compile-user-history nil)
-
-
-;;;; entry point
-
-;;;###autoload
-(defun remote-compile (host user command)
-  "Compile the current buffer's directory on HOST.  Log in as USER.
-See \\[compile]."
-  (interactive
-   (let ((parsed 
-	  ;; XEmacs change
-	  (cond
-	   ((featurep 'efs)
-	    (efs-ftp-path default-directory))
-	   ((featurep 'ange-ftp)
-	    (if (fboundp 'ange-ftp-ftp-name)
-		(ange-ftp-ftp-name default-directory)
-	      (ange-ftp-ftp-path default-directory)))
-	   (t nil)))
-         host user command prompt)
-     (if parsed
-         (setq host (nth 0 parsed)
-               user (nth 1 parsed))
-       (setq prompt (if (stringp remote-compile-host)
-                        (format "Compile on host (default %s): "
-                                remote-compile-host)
-                      "Compile on host: ")
-             host (if (or remote-compile-prompt-for-host
-                          (null remote-compile-host))
-                      (read-from-minibuffer prompt
-                                            "" nil nil
-                                            'remote-compile-host-history)
-                    remote-compile-host)
-             user (if remote-compile-prompt-for-user
-                      (read-from-minibuffer (format
-                                             "Compile by user (default %s)"
-                                             (or remote-compile-user
-                                                 (user-login-name)))
-                                            "" nil nil
-                                            'remote-compile-user-history)
-                    remote-compile-user)))
-     (setq command (read-from-minibuffer "Compile command: "
-                                         compile-command nil nil
-                                         '(compile-history . 1)))
-     (list (if (string= host "") remote-compile-host host)
-           (if (string= user "") remote-compile-user user)
-           command)))
-  (setq compile-command command)
-  (cond (user
-         (setq remote-compile-user user))
-        ((null remote-compile-user)
-         (setq remote-compile-user (user-login-name))))
-  (let* ((parsed
-	  ;; XEmacs change
-	  (cond
-	   ((featurep 'efs)
-	    (efs-ftp-path default-directory))
-	   ((featurep 'ange-ftp)
-	    (if (fboundp 'ange-ftp-ftp-name)
-		(ange-ftp-ftp-name default-directory)
-	      (ange-ftp-ftp-path default-directory)))
-	   (t nil)))
-         (compile-command
-          (format "%s %s -l %s \"(%scd %s; %s)\""
-		  remote-shell-program
-                  host
-                  remote-compile-user
-                  (if remote-compile-run-before
-                      (concat remote-compile-run-before "; ")
-                    "")
-                  (if parsed (nth 2 parsed) default-directory)
-                  compile-command)))
-    (setq remote-compile-host host)
-    (save-some-buffers nil nil)
-    (compile-internal compile-command "No more errors")
-    ;; Set comint-file-name-prefix in the compilation buffer so
-    ;; compilation-parse-errors will find referenced files by ange-ftp.
-    (save-excursion
-      (set-buffer compilation-last-buffer)
-      (setq comint-file-name-prefix (concat "/" user "@" host ":")))))
-
-;;; rcompile.el ends here
diff --git a/xemacs-packages/lisp/net-utils/shadowfile.el b/xemacs-packages/lisp/net-utils/shadowfile.el
deleted file mode 100644
index 2325faea..00000000
--- a/xemacs-packages/lisp/net-utils/shadowfile.el
+++ /dev/null
@@ -1,863 +0,0 @@
-;;; shadowfile.el --- automatic file copying for Emacs 19
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Boris Goldowsky 
-;; Keywords: comm
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;; LCD Archive Entry:
-;; shadowfile|Boris Goldowsky|boris@gnu.ai.mit.edu|
-;; Helps you keep identical copies of files in multiple places.|
-;; $Date: 2002/02/23 04:13:01 $ |$Revision: 1.2 $|~/misc/shadowfile.el.Z|
-
-;;; Synched up with: FSF 19.30.
-
-;; Commentary:
-
-;;  This package helps you to keep identical copies of files in more than one
-;;  place - possibly on different machines.  When you save a file, it checks
-;;  whether it is on the list of files with "shadows", and if so, it tries to
-;;  copy it when you exit emacs (or use the shadow-copy-files command).
-
-;; Installation & Use:
-
-;;  Put (require 'shadowfile) in your .emacs; add clusters (if necessary)
-;;  and file groups with shadow-define-cluster,
-;;  shadow-define-literal-group, and shadow-define-regexp-group (see the
-;;  documentation for these functions for information on how and when to
-;;  use them).  After doing this once, everything should be automatic.
-
-;;  The lists of clusters and shadows are saved in a file called .shadows,
-;;  so that they can be remembered from one emacs session to another, even
-;;  (as much as possible) if the emacs session terminates abnormally.  The
-;;  files needing to be copied are stored in .shadow_todo; if a file cannot
-;;  be copied for any reason, it will stay on the list to be tried again
-;;  next time.  The .shadows file should itself have shadows on all your
-;;  accounts so that the information in it is consistent everywhere, but
-;;  .shadow_todo is local information and should have no shadows.
-
-;;  If you do not want to copy a particular file, you can answer "no" and
-;;  be asked again next time you hit C-x 4 s or exit emacs.  If you do not
-;;  want to be asked again, use shadow-cancel, and you will not be asked
-;;  until you change the file and save it again.  If you do not want to
-;;  shadow that file ever again, you can edit it out of the .shadows
-;;  buffer.  Anytime you edit the .shadows buffer, you must type M-x
-;;  shadow-read-files to load in the new information, or your changes will
-;;  be overwritten!
-
-;; Bugs & Warnings:
-;;
-;;  - It is bad to have two emacses both running shadowfile at the same
-;;  time.  It tries to detect this condition, but is not always successful.
-;;
-;;  - You have to be careful not to edit a file in two locations
-;;  before shadowfile has had a chance to copy it; otherwise
-;;  "updating shadows" will overwrite one of the changed versions.
-;;
-;;  - It ought to check modification times of both files to make sure
-;;  it is doing the right thing.  This will have to wait until
-;;  file-newer-than-file-p works between machines.
-;;
-;;  - It will not make directories for you, it just fails to copy files
-;;  that belong in non-existent directories.
-;;
-;;  Please report any bugs to me (boris@gnu.ai.mit.edu).  Also let me know
-;;  if you have suggestions or would like to be informed of updates.
-
-;;; Code:
-
-(provide 'shadowfile)
-(require 'efs-auto)
-
-;;; I don't think this is very cool...  hope it works without the setting.
-(setq find-file-visit-truename t)	; makes life easier with symbolic links
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Variables
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defgroup shadowfile nil
-  "Keep identical copies of files in more than one place."
-  :group 'files
-  :prefix "shadow")
-
-(defcustom shadow-noquery nil
-  "*If t, always copy shadow files without asking.
-If nil \(the default), always ask.  If not nil and not t, ask only if there
-is no buffer currently visiting the file."
-  :type 'boolean
-  :group 'shadowfile)
-
-(defcustom shadow-inhibit-message nil
-  "*If nonnil, do not display a message when a file needs copying."
-  :type 'boolean
-  :group 'shadowfile)
-
-(defcustom shadow-inhibit-overload nil
-  "If nonnil, shadowfile won't redefine C-x C-c.
-Normally it overloads the function `save-buffers-kill-emacs' to check
-for files have been changed and need to be copied to other systems."
-  :type 'boolean
-  :group 'shadowfile)
-
-(defcustom shadow-info-file nil
-  "File to keep shadow information in.  
-The shadow-info-file should be shadowed to all your accounts to
-ensure consistency.  Default: ~/.xemacs/shadows"
-  :type '(choice (const :tag "Default" nil)
-		 (file))
-  :group 'shadowfile)
-
-(defcustom shadow-todo-file nil
-  "File to store the list of uncopied shadows in.
-This means that if a remote system is down, or for any reason you cannot or
-decide not to copy your shadow files at the end of one emacs session, it will
-remember and ask you again in your next emacs session.
-This file must NOT be shadowed to any other system, it is host-specific.
-Default: ~/.xemacs/shadow_todo"
-  :type '(choice (const :tag "Default" nil)
-		 (file))
-  :group 'shadowfile)
-
-;;; The following two variables should in most cases initialize themselves
-;;; correctly.  They are provided as variables in case the defaults are wrong
-;;; on your machine \(and for efficiency).
-
-(defvar shadow-system-name (system-name)
-  "The complete hostname of this machine.")
-
-(defvar shadow-homedir nil
-  "Your home directory on this machine.")
-
-;;;
-;;; Internal variables whose values are stored in the info and todo files:
-;;;
-
-(defvar shadow-clusters nil
-  "List of host clusters \(see shadow-define-cluster).")
-
-(defvar shadow-literal-groups nil
-  "List of files that are shared between hosts.
-This list contains shadow structures with literal filenames, created by
-shadow-define-group.")
-
-(defvar shadow-regexp-groups nil
-  "List of file types that are shared between hosts.
-This list contains shadow structures with regexps matching filenames, 
-created by shadow-define-regexp-group.")
-
-;;;
-;;; Other internal variables:
-;;;
-
-(defvar shadow-files-to-copy nil)	; List of files that need to
-					; be copied to remote hosts.
-
-(defvar shadow-hashtable nil)		; for speed
-
-(defvar shadow-info-buffer nil)		; buf visiting shadow-info-file
-(defvar shadow-todo-buffer nil)		; buf visiting shadow-todo-file
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Syntactic sugar; General list and string manipulation
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro shadow-when (condition &rest body)
-  ;; From cl.el
-  "(shadow-when CONDITION . BODY) => evaluate BODY if CONDITION is true."
-  (` (if (not (, condition))  ()  (,@ body))))
-  
-(defun shadow-union (a b)
-  "Add members of list A to list B
-if they are not equal to items already in B."
-  (if (null a)
-      b
-    (if (member (car a) b)
-	(shadow-union (cdr a) b)
-      (shadow-union (cdr a) (cons (car a) b)))))
-
-(defun shadow-find (func list)
-  "If FUNC applied to some element of LIST is nonnil, 
-return the first such element."
-  (while (and list (not (funcall func (car list))))
-    (setq list (cdr list)))
-  (car list))
-
-(defun shadow-remove-if (func list)
-  "Remove elements satisfying FUNC from LIST.
-Nondestructive; actually returns a copy of the list with the elements removed."
-  (if list
-      (if (funcall func (car list))
-	  (shadow-remove-if func (cdr list))
-	(cons (car list) (shadow-remove-if func (cdr list))))
-    nil))
-
-(defun shadow-join (strings sep)
-  "Concatenate elements of the list of STRINGS with SEP between each."
-  (cond ((null strings) "")
-	((null (cdr strings)) (car strings))
-	((concat (car strings) " " (shadow-join (cdr strings) sep)))))
-
-(defun shadow-regexp-superquote (string)
-  "Like regexp-quote, but includes the ^ and $ 
-to make sure regexp matches nothing but STRING."
-  (concat "^" (regexp-quote string) "$"))
-
-(defun shadow-suffix (prefix string)
-  "If PREFIX begins STRING, return the rest.
-Return value is nonnil if PREFIX and STRING are string= up to the length of
-PREFIX."
-  (let ((lp (length prefix))
-	(ls (length string)))
-    (if (and (>= ls lp)
-	     (string= prefix (substring string 0 lp)))
-	(substring string lp))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Clusters and sites
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; I use the term `site' to refer to a string which may be the name of a
-;;; cluster or a literal hostname.  All user-level commands should accept
-;;; either.
-
-(defun shadow-make-cluster (name primary regexp)
-  "Creates a shadow cluster 
-called NAME, using the PRIMARY hostname, REGEXP matching all hosts in the
-cluster.  The variable shadow-clusters associates the names of clusters to
-these structures. 
-   This function is for program use: to create clusters interactively, use
-shadow-define-cluster instead."
-  (list name primary regexp))
-
-(defmacro shadow-cluster-name (cluster)
-  "Return the name of the CLUSTER."
-  (list 'elt cluster 0))
-
-(defmacro shadow-cluster-primary (cluster)
-  "Return the primary hostname of a CLUSTER."
-  (list 'elt cluster 1))
-
-(defmacro shadow-cluster-regexp (cluster)
-  "Return the regexp matching hosts in a CLUSTER."
-  (list 'elt cluster 2))
-
-(defun shadow-set-cluster (name primary regexp)
-  "Put cluster NAME on the list of clusters,
-replacing old definition if any.  PRIMARY and REGEXP are the
-information defining the cluster.  For interactive use, call
-shadow-define-cluster instead."
-  (let ((rest (shadow-remove-if
-	       (function (lambda (x) (equal name (car x))))
-	       shadow-clusters)))
-    (setq shadow-clusters 
-	  (cons (shadow-make-cluster name primary regexp)
-		rest))))
-
-(defmacro shadow-get-cluster (name)
-  "Return cluster named NAME, or nil."
-  (list 'assoc name 'shadow-clusters))
-
-(defun shadow-site-primary (site)
-  "If SITE is a cluster, return primary host, otherwise return SITE."
-  (let ((c (shadow-get-cluster site)))
-    (if c
-	(shadow-cluster-primary c)
-      site)))
-
-;;; SITES
-
-(defun shadow-site-cluster (site)
-  "Given a SITE \(hostname or cluster name), return the cluster
-that it is in, or nil."
-  (or (assoc site shadow-clusters)
-      (shadow-find
-       (function (lambda (x)
-		   (string-match (shadow-cluster-regexp x)
-				 site)))
-       shadow-clusters)))
-
-(defun shadow-read-site ()
-  "Read a cluster name or hostname from the minibuffer."
-  (let ((ans (completing-read "Host or cluster name [RET when done]: "
-			      shadow-clusters)))
-    (if (equal "" ans)
-	nil
-      ans)))
-
-(defun shadow-site-match (site1 site2)
-  "Nonnil iff SITE1 is or includes SITE2.  
-Each may be a host or cluster name; if they are clusters, regexp of site1 will
-be matched against the primary of site2."
-  (or (string-equal site1 site2) ; quick check
-      (let* ((cluster1 (shadow-get-cluster site1))
-	     (primary2 (shadow-site-primary site2)))
-	(if cluster1
-	    (string-match (shadow-cluster-regexp cluster1) primary2)
-	  (string-equal site1 primary2)))))
-
-(defun shadow-get-user (site)
-  "Returns the default username for a site."
-  (efs-get-user (shadow-site-primary site)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Filename manipulation
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun shadow-parse-fullpath (fullpath)
-  "Parse PATH into \(site user path) list,
-or leave it alone if it already is one.  Returns nil if the argument is not a
-full efs ftp pathname."
-  (if (listp fullpath)
-      fullpath
-    (efs-ftp-path fullpath)))
-
-(defun shadow-parse-path (path)
-  "Parse any PATH into \(site user path) list.
-Argument can be a simple path, full efs ftp path, or already a hup list."
-  (or (shadow-parse-fullpath path)
-      (list shadow-system-name
-	    (user-login-name)
-	    path)))
-
-(defsubst shadow-make-fullpath (host user path)
-  "Make an efs style fullpath out of HOST, USER (optional), and PATH.
-This is probably not as general as it ought to be."
-  (concat "/" 
-	  (if user (concat user "@"))
-	  host ":"
-	  path))
-
-(defun shadow-replace-path-component (fullpath newpath)
-  "Return FULLPATH with the pathname component changed to NEWPATH."
-  (let ((hup (shadow-parse-fullpath fullpath)))
-    (shadow-make-fullpath (nth 0 hup) (nth 1 hup) newpath)))
-
-(defun shadow-local-file (file)
-  "If FILENAME is at this site,
-remove /user@host part.  If refers to a different system or a different user on
-this system, return nil."
-  (let ((hup (shadow-parse-fullpath file)))
-    (cond ((null hup) file)
-	  ((and (shadow-site-match (nth 0 hup) shadow-system-name)
-		(string-equal (nth 1 hup) (user-login-name)))
-	   (nth 2 hup))
-	  (t nil))))
-
-(defun shadow-expand-cluster-in-file-name (file)
-  "If hostname part of FILE is a cluster, expand it
-into the cluster's primary hostname.  Will return the pathname bare if it is
-a local file."
-  (let ((hup (shadow-parse-path file))
-	cluster)
-    (cond ((null hup) file)
-	  ((shadow-local-file hup))
-	  ((shadow-make-fullpath (shadow-site-primary (nth 0 hup))
-				 (nth 1 hup)
-				 (nth 2 hup))))))
-
-(defun shadow-expand-file-name (file &optional default)
-  "Expand file name and get file's true name."
-  (file-truename (expand-file-name file default)))
-
-(defun shadow-contract-file-name (file)
-  "Simplify FILENAME
-by replacing (when possible) home directory with ~, and hostname with cluster
-name that includes it.  Filename should be absolute and true."
-  (let* ((hup (shadow-parse-path file))
-	 (homedir (if (shadow-local-file hup)
-		      shadow-homedir
-		    (file-name-as-directory
-		     (nth 2 (shadow-parse-fullpath 
-			     (expand-file-name
-			      (shadow-make-fullpath
-			       (nth 0 hup) (nth 1 hup) "~")))))))
-	 (suffix (shadow-suffix homedir (nth 2 hup)))
-	 (cluster (shadow-site-cluster (nth 0 hup))))
-    (shadow-make-fullpath
-     (if cluster
-	 (shadow-cluster-name cluster)
-       (nth 0 hup))
-     (nth 1 hup)
-     (if suffix 
-	 (concat "~/" suffix)
-       (nth 2 hup)))))
-
-(defun shadow-same-site (pattern file)
-  "True if the site of PATTERN and of FILE are on the same site.
-If usernames are supplied, they must also match exactly.  PATTERN and FILE may
-be lists of host, user, path, or efs ftp pathnames.  FILE may also be just a
-local filename."
-  (let ((pattern-sup (shadow-parse-fullpath pattern))
-	(file-sup    (shadow-parse-path file)))
-    (and
-     (shadow-site-match (nth 0 pattern-sup) (nth 0 file-sup))
-     (or (null (nth 1 pattern-sup))
-	 (string-equal (nth 1 pattern-sup) (nth 1 file-sup))))))
-
-(defun shadow-file-match (pattern file &optional regexp)
- "Returns t if PATTERN matches FILE.
-If REGEXP is supplied and nonnil, the pathname part of the pattern is a regular
-expression, otherwise it must match exactly.  The sites and usernames must
-match---see shadow-same-site.  The pattern must be in full efs ftp format, but
-the file can be any valid filename.  This function does not do any filename
-expansion or contraction, you must do that yourself first."
- (let* ((pattern-sup (shadow-parse-fullpath pattern))
-	(file-sup (shadow-parse-path file)))
-   (and (shadow-same-site pattern-sup file-sup)
-	(if regexp 
-	    (string-match (nth 2 pattern-sup) (nth 2 file-sup))
-	  (string-equal (nth 2 pattern-sup) (nth 2 file-sup))))))
- 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; User-level Commands
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun shadow-define-cluster (name)
-  "Edit \(or create) the definition of a cluster.
-This is a group of hosts that share directories, so that copying to or from
-one of them is sufficient to update the file on all of them.  Clusters are
-defined by a name, the network address of a primary host \(the one we copy
-files to), and a regular expression that matches the hostnames of all the sites
-in the cluster."
-  (interactive (list (completing-read "Cluster name: " shadow-clusters () ())))
-  (let* ((old (shadow-get-cluster name))
-	 (primary (read-string "Primary host: "
-			       (if old (shadow-cluster-primary old) 
-				 name)))
-	 (regexp   (let (try-regexp)
-		     (while (not
-			     (string-match 
-			      (setq try-regexp
-				    (read-string 
-				     "Regexp matching all host names: "
-				     (if old (shadow-cluster-regexp old)
-				       (shadow-regexp-superquote primary))))
-			      primary))
-		       (message "Regexp doesn't include the primary host!")
-		       (sit-for 2))
-		     try-regexp))
-;	 (username (read-no-blanks-input 
-;		    (format "Username [default: %s]: " 
-;			    (shadow-get-user primary))
-;		    (if old (or (shadow-cluster-username old) "")
-;		      (user-login-name))))
-	 )
-;    (if (string-equal "" username) (setq username nil))
-    (shadow-set-cluster name primary regexp)))
-
-(defun shadow-define-literal-group ()
-  "Declare a single file to be shared between sites.
-It may have different filenames on each site.  When this file is edited, the
-new version will be copied to each of the other locations.  Sites can be
-specific hostnames, or names of clusters \(see shadow-define-cluster)."
-  (interactive)
-  (let* ((hup (shadow-parse-fullpath 
-	       (shadow-contract-file-name (buffer-file-name))))
-	 (path (nth 2 hup))
-	 user site group)
-    (while (setq site (shadow-read-site))
-      (setq user (read-string (format "Username [default %s]: "
-				      (shadow-get-user site)))
-	    path (read-string "Filename: " path))
-      (setq group (cons (shadow-make-fullpath site 
-					      (if (string-equal "" user)
-						  (shadow-get-user site)
-						user)
-					      path)
-			group)))
-    (setq shadow-literal-groups (cons group shadow-literal-groups)))
-  (shadow-write-info-file))
-
-(defun shadow-define-regexp-group ()
-  "Make each of a group of files be shared between hosts.
-Prompts for regular expression; files matching this are shared between a list
-of sites, which are also prompted for. The filenames must be identical on all
-hosts \(if they aren't, use shadow-define-group instead of this function).
-Each site can be either a hostname or the name of a cluster \(see
-shadow-define-cluster)."
-  (interactive)
-  (let ((regexp (read-string 
-		 "Filename regexp: " 
-		 (if (buffer-file-name)
-		     (shadow-regexp-superquote
-		      (nth 2
-			   (shadow-parse-path
-			    (shadow-contract-file-name
-			     (buffer-file-name))))))))
-	site sites usernames)
-    (while (setq site (shadow-read-site))
-      (setq sites (cons site sites))
-      (setq usernames 
-	    (cons (read-string (format "Username for %s: " site)
-			       (shadow-get-user site))
-		  usernames)))
-    (setq shadow-regexp-groups 
-	  (cons (shadow-make-group regexp sites usernames)
-		shadow-regexp-groups))
-    (shadow-write-info-file)))
-    
-(defun shadow-shadows ()
-  ;; Mostly for debugging.
-  "Interactive function to display shadows of a buffer."
-  (interactive)
-  (let ((msg (shadow-join (mapcar (function cdr)
-				  (shadow-shadows-of (buffer-file-name)))
-			  " ")))
-    (message "%s"
-	     (if (zerop (length msg)) 
-		 "No shadows."
-	       msg))))
-
-(defun shadow-copy-files (&optional arg)
-  "Copy all pending shadow files.
-With prefix argument, copy all pending files without query.
-Pending copies are stored in variable shadow-files-to-copy, and in
-shadow-todo-file if necessary.  This function is invoked by
-shadow-save-buffers-kill-emacs, so it is not usually necessary to
-call it manually."
-  (interactive "P")
-  (if (and (not shadow-files-to-copy) (interactive-p))
-      (message "No files need to be shadowed.")
-    (save-excursion
-      (map-y-or-n-p (function
-		     (lambda (pair)
-		       (or arg shadow-noquery
-			   (format "Copy shadow file %s? " (cdr pair)))))
-		    (function shadow-copy-file)
-		    shadow-files-to-copy
-		    '("shadow" "shadows" "copy"))
-      (shadow-write-todo-file t))))
-
-(defun shadow-cancel ()
-  "Cancel the instruction to copy some files.
-Prompts for which copy operations to cancel.  You will not be asked to copy
-them again, unless you make more changes to the files.  To cancel a shadow
-permanently, remove the group from shadow-literal-groups or
-shadow-regexp-groups."
-  (interactive)
-  (map-y-or-n-p (function (lambda (pair)
-			    (format "Cancel copying %s to %s? " 
-				    (car pair) (cdr pair))))
-		(function (lambda (pair) 
-			    (shadow-remove-from-todo pair)))
-		shadow-files-to-copy
-		'("shadow" "shadows" "cancel copy"))
-  (message "There are %d shadows to be updated." 
-	   (length shadow-files-to-copy))
-  (shadow-write-todo-file))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Internal functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun shadow-make-group (regexp sites usernames)
-  "Makes a description of a file group---
-actually a list of regexp efs ftp file names---from REGEXP \(name of file to
-be shadowed), list of SITES, and corresponding list of USERNAMES for each
-site."
-  (if sites
-      (cons (shadow-make-fullpath (car sites) (car usernames) regexp)
-	    (shadow-make-group regexp (cdr sites) (cdr usernames)))
-    nil))
-
-(defun shadow-copy-file (s)
-  "Copy one shadow file."
-  (let* ((buffer 
-	  (cond ((get-file-buffer 
-		  (abbreviate-file-name (shadow-expand-file-name (car s)))))
-		((not (file-readable-p (car s)))
-		 (if (y-or-n-p
-		      (format "Cannot find file %s--cancel copy request?"
-			      (car s)))
-		     (shadow-remove-from-todo s))
-		 nil)
-		((or (eq t shadow-noquery)
-		     (y-or-n-p 
-		      (format "No buffer for %s -- update shadow anyway?"
-			      (car s))))
-		 (find-file-noselect (car s)))))
-	 (to (shadow-expand-cluster-in-file-name (cdr s))))
-    (shadow-when buffer
-      (set-buffer buffer)
-      (save-restriction
-	(widen)
-	(condition-case i 
-	    (progn
-	      (write-region (point-min) (point-max) to)
-	      (shadow-remove-from-todo s))
-	  (error (message "Shadow %s not updated!" (cdr s))))))))
-
-(defun shadow-shadows-of (file)
-  "Returns copy operations needed to update FILE.
-Filename should have clusters expanded, but otherwise can have any format.  
-Return value is a list of dotted pairs like \(from . to), where from
-and to are absolute file names."
-  (or (symbol-value (intern-soft file shadow-hashtable))
-      (let* ((absolute-file (shadow-expand-file-name
-			     (or (shadow-local-file file) file)
-			     shadow-homedir))
-	     (canonical-file (shadow-contract-file-name absolute-file))
-	     (shadows 
-	      (mapcar (function (lambda (shadow)
-				  (cons absolute-file shadow)))
-		      (append
-		       (shadow-shadows-of-1
-			canonical-file shadow-literal-groups nil)
-		       (shadow-shadows-of-1
-			canonical-file shadow-regexp-groups t)))))
-	(set (intern file shadow-hashtable) shadows))))
-
-(defun shadow-shadows-of-1 (file groups regexp)
-  "Return list of FILE's shadows in GROUPS, 
-which are considered as regular expressions if third arg REGEXP is true."
-  (if groups
-      (let ((nonmatching
-	     (shadow-remove-if 
-	      (function (lambda (x) (shadow-file-match x file regexp)))
-	      (car groups))))
-	(append (cond ((equal nonmatching (car groups)) nil)
-		      (regexp 
-		       (let ((realpath (nth 2 (shadow-parse-fullpath file))))
-			 (mapcar 
-			  (function 
-			   (lambda (x) 
-			     (shadow-replace-path-component x realpath)))
-			  nonmatching)))
-		      (t nonmatching))
-		(shadow-shadows-of-1 file (cdr groups) regexp)))))
-
-(defun shadow-add-to-todo ()
-  "If current buffer has shadows, add them to the list
-of files needing to be copied."
-  (let ((shadows (shadow-shadows-of 
-		  (shadow-expand-file-name 
-		   (buffer-file-name (current-buffer))))))
-    (shadow-when shadows
-      (setq shadow-files-to-copy
-	    (shadow-union shadows shadow-files-to-copy))
-      (shadow-when (not shadow-inhibit-message)
-	(message "%s" (substitute-command-keys
-		       "Use \\[shadow-copy-files] to update shadows."))
-	(sit-for 1))
-      (shadow-write-todo-file)))
-  nil)     ; Return nil for write-file-hooks
-
-(defun shadow-remove-from-todo (pair)
-  "Remove PAIR from shadow-files-to-copy.
-PAIR must be (eq to) one of the elements of that list."
-  (setq shadow-files-to-copy 
-	(shadow-remove-if (function (lambda (s) (eq s pair)))
-			  shadow-files-to-copy)))
-
-(defun shadow-read-files ()
-  "Visits and loads shadow-info-file and shadow-todo-file,
-thus restoring shadowfile's state from your last emacs session.
-Returns t unless files were locked; then returns nil."
-  (interactive)
-  (if (and (fboundp 'file-locked-p)
-	   (or (stringp (file-locked-p shadow-info-file))
-	       (stringp (file-locked-p shadow-todo-file))))
-      (progn
-	(message "Shadowfile is running in another emacs; can't have two.")
-	(beep)
-	(sit-for 3)
-	nil)
-    (save-excursion
-      (shadow-when shadow-info-file
-	(set-buffer (setq shadow-info-buffer
-			  (find-file-noselect shadow-info-file)))
-	(shadow-when (and (not (buffer-modified-p))
-			  (file-newer-than-file-p (make-auto-save-file-name)
-						  shadow-info-file))
-	  (erase-buffer)
-	  (message "Data recovered from %s." 
-		   (car (insert-file-contents (make-auto-save-file-name))))
-	  (sit-for 1))
-	(eval-current-buffer))
-      (shadow-when shadow-todo-file
-	(set-buffer (setq shadow-todo-buffer 
-			  (find-file-noselect shadow-todo-file)))
-	(shadow-when (and (not (buffer-modified-p))
-			  (file-newer-than-file-p (make-auto-save-file-name)
-						  shadow-todo-file))
-	  (erase-buffer)
-	  (message "Data recovered from %s." 
-		   (car (insert-file-contents (make-auto-save-file-name))))
-	  (sit-for 1))
-	(eval-current-buffer nil))
-      (shadow-invalidate-hashtable))
-    t))
-
-(defun shadow-write-info-file ()
-  "Write out information to shadow-info-file.
-Also clears shadow-hashtable, since when there are new shadows defined, the old
-hashtable info is invalid."
-  (shadow-invalidate-hashtable)
-  (if shadow-info-file
-      (save-excursion
-	(or (buffer-live-p shadow-info-buffer)
-	    (setq shadow-info-buffer (find-file-noselect shadow-info-file)))
-	(set-buffer shadow-info-buffer)
-	(delete-region (point-min) (point-max))
-	(shadow-insert-var 'shadow-clusters)
-	(shadow-insert-var 'shadow-literal-groups)
-	(shadow-insert-var 'shadow-regexp-groups))))
-
-(defun shadow-write-todo-file (&optional save)
-  "Write out information to shadow-todo-file.  
-With nonnil argument also saves the buffer."
-  (save-excursion
-    (or (buffer-live-p shadow-todo-buffer)
-	(setq shadow-todo-buffer (find-file-noselect shadow-todo-file)))
-    (set-buffer shadow-todo-buffer)
-    (delete-region (point-min) (point-max))
-    (shadow-insert-var 'shadow-files-to-copy)
-    (if save (shadow-save-todo-file))))
-
-(defun shadow-save-todo-file ()
-  (if (and (buffer-live-p shadow-todo-buffer)
-	   (buffer-modified-p shadow-todo-buffer))
-      (save-excursion
-	(set-buffer shadow-todo-buffer)
-	(condition-case nil		; have to continue even in case of 
-	    (basic-save-buffer)		; error, otherwise kill-emacs might
-	  (error			; not work!
-	   (message "WARNING: Can't save shadow todo file; it is locked!")
-	   (sit-for 1))))))
-
-(defun shadow-invalidate-hashtable ()
-  (setq shadow-hashtable (make-vector 37 0)))
-
-(defun shadow-insert-var (variable)
-  "Prettily insert a setq command for VARIABLE.
-which, when later evaluated, will restore it to its current setting.
-SYMBOL must be the name of a variable whose value is a list."
-  (let ((standard-output (current-buffer)))
-    (insert (format "(setq %s" variable))
-    (cond ((consp (eval variable))
-	   (insert "\n  '(") 
-	   (prin1 (car (eval variable)))
-	   (let ((rest (cdr (eval variable))))
-	     (while rest
-	       (insert "\n    ")
-	       (prin1 (car rest))
-	       (setq rest (cdr rest)))
-	     (insert "))\n\n")))
-	  (t (insert " ")
-	     (prin1 (eval variable))
-	     (insert ")\n\n")))))
-
-(defun shadow-save-buffers-kill-emacs (&optional arg)
-  "Offer to save each buffer and copy shadows, then kill this Emacs process.
-With prefix arg, silently save all file-visiting buffers, then kill.
-
-Extended by shadowfile to automatically save `shadow-todo-file' and
-look for files that have been changed and need to be copied to other systems."
-  ;; This function is necessary because we need to get control and save
-  ;; the todo file /after/ saving other files, but /before/ the warning
-  ;; message about unsaved buffers (because it can get modified by the
-  ;; action of saving other buffers).  `kill-emacs-hook' is no good
-  ;; because it is not called at the correct time, and also because it is
-  ;; called when the terminal is disconnected and we cannot ask whether
-  ;; to copy files.
-  (interactive "P")
-  (shadow-save-todo-file)
-  (save-some-buffers arg t)
-  (shadow-copy-files)
-  (shadow-save-todo-file)
-  (and (or (not (memq t (mapcar (function
-				 (lambda (buf) (and (buffer-file-name buf)
-						    (buffer-modified-p buf))))
-				(buffer-list))))
-	   (yes-or-no-p "Modified buffers exist; exit anyway? "))
-       (or (not (fboundp 'process-list))
-	   ;; process-list is not defined on VMS.
-	   (let ((processes (process-list))
-		 active)
-	     (while processes
-	       (and (memq (process-status (car processes)) '(run stop open))
-		    (let ((val (process-kill-without-query (car processes))))
-		      (process-kill-without-query (car processes) val)
-		      val)
-		    (setq active t))
-	       (setq processes (cdr processes)))
-	     (or (not active)
-		 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
-       (kill-emacs)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Lucid Emacs compatibility 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; This is on hold until someone tells me about a working version of
-;; map-ynp for Lucid Emacs.
-
-;(shadow-when (string-match "Lucid" emacs-version)
-;  (require 'symlink-fix)
-;  (require 'efs-auto)
-;  (require 'map-ynp)
-;  (if (not (fboundp 'file-truename))
-;      (fset 'shadow-expand-file-name 
-;	    (symbol-function 'symlink-expand-file-name)))
-;  (if (not (fboundp 'efs-ftp-name))
-;      (fset 'efs-ftp-name
-;	    (symbol-function 'efs-ftp-path))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Hook us up
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; File shadowing is activated at load time, unless this this file is
-;;; being preloaded, in which case it is added to after-init-hook.
-;;; Thanks to Richard Caley for this scheme.
-
-(defun shadow-initialize ()
-  (if (null shadow-homedir)
-      (setq shadow-homedir
-	    (file-name-as-directory (shadow-expand-file-name "~"))))
-  (if (null shadow-info-file)
-      (setq shadow-info-file 
-	    (shadow-expand-file-name "~/.shadows")))
-  (if (null shadow-todo-file)
-      (setq shadow-todo-file 
-	    (shadow-expand-file-name "~/.shadow_todo")))
-  (if (not (shadow-read-files))
-      (progn
-	(message "Shadowfile information files not found - aborting")
-	(beep)
-	(sit-for 3))
-    (shadow-when (and (not shadow-inhibit-overload)
-		      (not (fboundp 'shadow-orig-save-buffers-kill-emacs)))
-      (fset 'shadow-orig-save-buffers-kill-emacs 
-	    (symbol-function 'save-buffers-kill-emacs))
-      (fset 'save-buffers-kill-emacs
-	    (symbol-function 'shadow-save-buffers-kill-emacs)))
-    (add-hook 'write-file-hooks 'shadow-add-to-todo)
-    (define-key ctl-x-4-map "s" 'shadow-copy-files)))
-
-(if noninteractive
-    (add-hook 'after-init-hook 'shadow-initialize)
-  (shadow-initialize))
-
-;;;Local Variables:
-;;;eval:(put 'shadow-when 'lisp-indent-hook 1)
-;;;End:
-
-;;; shadowfile.el ends here
diff --git a/xemacs-packages/lisp/net-utils/webjump.el b/xemacs-packages/lisp/net-utils/webjump.el
deleted file mode 100644
index d55bad5e..00000000
--- a/xemacs-packages/lisp/net-utils/webjump.el
+++ /dev/null
@@ -1,454 +0,0 @@
-;;; webjump.el --- programmable Web hotlist
-     
-;; Copyright (C) 1996-1997 Free Software Foundation
-
-;; Author:    Neil W. Van Dyke 
-;; Created:   09-Aug-1996
-;; Keywords:  comm www
-;; X-URL:     http://www.cs.brown.edu/people/nwv/
-
-;; 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.
-
-;;; Change Log:
-
-;; [Version 1.5, 02-Jun-1997, nwv@acm.org] Prepared for first inclusion in GNU
-;; Emacs distribution by merging in RMS' minor changes and moving some sample
-;; Web site entries out.  Also updated Lycos and Yahoo sample entries.
-
-;; [Version 1.4, 17-Sep-1996, nwv@acm.org] Removed the evil "defconst-TEST"
-;; that slipped into 1.3.  Organized webjump-sample-sites and modified the
-;; content a bit.
-
-;; [Version 1.3, 30-Aug-1996, nwv@acm.org] Fixed broken `if' function in
-;; `webjump-to-javaapi' (bugfix already posted).  Added `webjump-to-iwin'.
-;; Added comment on purpose of `webjump-sample-sites'.  Added
-;; `webjump-read-choice'.
-
-;; [Version 1.2, 16-Aug-1996, nwv@acm.org] Oops, got Gamelan mixed up with
-;; Digital Espresso somehow.  Added `mirrors' builtin and used it for the
-;; sample GNU Archive site.  Added some other sample sites.  Split sample sites
-;; out into separate constant.  Misc. small changes.  Copyright has been
-;; transferred to the FSF.
-
-;; [Version 1.1, 10-Aug-1996, nwv@acm.org] Added missing call to
-;; `webjump-url-fix' (thanks to Istvan Marko  for pointing this
-;; out).  Added ``builtins'' concept in order to support `simple-query' builtin
-;; for covering the majority of cases.  Added a couple more sample sites.
-
-;; [Version 1.0, 09-Aug-1996, nwv@acm.org] Wrote initial version and posted to
-;; gnu.emacs.sources.
-
-;;; Commentary:
-
-;; WebJump provides a sort of ``programmable hotlist'' of Web sites that can
-;; quickly be invoked in your Web browser.  Each Web site in the hotlist has a
-;; name, and you select the desired site name via a completing string prompt in
-;; the minibuffer.  The URL for each Web site is defined as a static string or
-;; a built-in or custom function, allowing interactive prompting for
-;; site-specific queries and options.
-
-;; Note that WebJump was originally intended to complement your conventional
-;; browser-based hotlist, not replace it.  (Though there's no reason you
-;; couldn't use WebJump for your entire hotlist if you were so inclined.)
-
-;; The `webjump-sites' variable, which defines the hotlist, defaults to some
-;; example sites.  You'll probably want to override it with your own favorite
-;; sites.  The documentation for the variable describes the syntax.
-
-;; You may wish to add something like the following to your `.emacs' file:
-;;
-;;   (require 'webjump)
-;;   (global-set-key "\C-cj" 'webjump)
-;;   (setq webjump-sites
-;;         (append '(
-;;                   ("My Home Page" . "www.someisp.net/users/joebobjr/")
-;;                   ("Pop's Site"   . "www.joebob-and-son.com/")
-;;                   )
-;;                 webjump-sample-sites))
-;;
-;; The above loads this package, binds `C-c j' to invoke WebJump, and adds your
-;; personal favorite sites to the hotlist.
-
-;; The `webjump-sample-sites' variable mostly contains some site entries that
-;; are expected to be generally relevant to most Emacs users.  Some additional
-;; site entries are defined in the separate and more frequently updated
-;; `webjump-plus' package, which is available from the author's Web site.
-
-;; The `browse-url' package is used to submit URLs to the browser, so any
-;; browser-specific configuration should be done there.
-
-;; WebJump inherits a small amount code from my `altavista.el' package, and is
-;; intended to obsolete that package.
-
-;;; Code:
-
-;;-------------------------------------------------------- Package Dependencies
-
-(require 'browse-url)
-
-;;------------------------------------------------------------------- Constants
-
-(defvar webjump-version "1.5")
-
-(defvar webjump-sample-sites
-  '(
-
-    ;; FSF, not including Emacs-specific.
-    ("GNU Project FTP Archive" .
-     [mirrors "ftp://prep.ai.mit.edu/pub/gnu/"
-              ;; ASIA:
-              "ftp://ftp.cs.titech.ac.jp"
-              "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/prep"
-              "ftp://cair-archive.kaist.ac.kr/pub/gnu"
-              "ftp://ftp.nectec.or.th/pub/mirrors/gnu"
-              ;; AUSTRALIA:
-              "ftp://archie.au/gnu"
-              "ftp://archie.oz/gnu"
-              "ftp://archie.oz.au/gnu"
-              ;; AFRICA:
-              "ftp://ftp.sun.ac.za/pub/gnu"
-              ;; MIDDLE-EAST:
-              "ftp://ftp.technion.ac.il/pub/unsupported/gnu"
-              ;; EUROPE:
-              "ftp://irisa.irisa.fr/pub/gnu"
-              "ftp://ftp.univ-lyon1.fr/pub/gnu"
-              "ftp://ftp.mcc.ac.uk"
-              "ftp://unix.hensa.ac.uk/mirrors/uunet/systems/gnu"
-              "ftp://src.doc.ic.ac.uk/gnu"
-              "ftp://ftp.ieunet.ie/pub/gnu"
-              "ftp://ftp.eunet.ch"
-              "ftp://nic.switch.ch/mirror/gnu"
-              "ftp://ftp.informatik.rwth-aachen.de/pub/gnu"
-              "ftp://ftp.informatik.tu-muenchen.de"
-              "ftp://ftp.win.tue.nl/pub/gnu"
-              "ftp://ftp.nl.net"
-              "ftp://ftp.etsimo.uniovi.es/pub/gnu"
-              "ftp://ftp.funet.fi/pub/gnu"
-              "ftp://ftp.denet.dk"
-              "ftp://ftp.stacken.kth.se"
-              "ftp://isy.liu.se"
-              "ftp://ftp.luth.se/pub/unix/gnu"
-              "ftp://ftp.sunet.se/pub/gnu"
-              "ftp://archive.eu.net"
-              ;; SOUTH AMERICA: 
-              "ftp://ftp.inf.utfsm.cl/pub/gnu"
-              "ftp://ftp.unicamp.br/pub/gnu"
-              ;; WESTERN CANADA:
-              "ftp://ftp.cs.ubc.ca/mirror2/gnu"
-              ;; USA:
-              "ftp://wuarchive.wustl.edu/systems/gnu"
-              "ftp://labrea.stanford.edu"
-              "ftp://ftp.digex.net/pub/gnu"
-              "ftp://ftp.kpc.com/pub/mirror/gnu"
-              "ftp://f.ms.uky.edu/pub3/gnu"
-              "ftp://jaguar.utah.edu/gnustuff"
-              "ftp://ftp.hawaii.edu/mirrors/gnu"
-              "ftp://uiarchive.cso.uiuc.edu/pub/gnu"
-              "ftp://ftp.cs.columbia.edu/archives/gnu/prep"
-              "ftp://gatekeeper.dec.com/pub/GNU"
-              "ftp://ftp.uu.net/systems/gnu"])
-    ("GNU Project Home Page" . "www.fsf.org")
-
-    ;; Emacs.
-    ("Eieio" . "ftp.ultranet.com/pub/zappo/")
-    ("Emacs Lisp Archive" .
-     "ftp://archive.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive/")
-    ("Insidious Big Brother Database" . "home.netscape.com/people/jwz/bbdb/")
-    ("Mailcrypt" . "cag-www.lcs.mit.edu/mailcrypt/")
-    ("WebJump" . "http://www.cs.brown.edu/people/nwv/projects/webjump/")
-    ("XEmacs Home" . "www.xemacs.org")
-    ("Yahoo: Emacs" .
-     "www.yahoo.com/Computers_and_Internet/Software/Text_Editors/Emacs/")
-
-    ;; Internet search engines.
-    ("AltaVista" . 
-     [simple-query
-      "www.altavista.digital.com"
-      "www.altavista.digital.com/cgi-bin/query?pg=aq&what=web&fmt=.&q="
-      "&r=&d0=&d1="])
-    ("Archie" .
-     [simple-query "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl"
-		   "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl?query=" ""])
-    ("Lycos" .
-     [simple-query "www.lycos.com"
-                   "www.lycos.com/cgi-bin/pursuit?cat=lycos&query=" ""])
-    ("Yahoo" . 
-     [simple-query "www.yahoo.com" "search.yahoo.com/bin/search?p=" ""])
-
-    ;; Misc. general interest.
-    ("Interactive Weather Information Network" . webjump-to-iwin)
-    ("Usenet FAQs" . 
-     [simple-query "www.cis.ohio-state.edu/hypertext/faq/usenet/FAQ-List.html"
-		   "www.cis.ohio-state.edu/htbin/search-usenet-faqs/form?find="
-		   ""])
-    ("RTFM Usenet FAQs by Group" .
-     "ftp://rtfm.mit.edu/pub/usenet-by-group/")
-    ("RTFM Usenet FAQs by Hierachy" .
-     "ftp://rtfm.mit.edu/pub/usenet-by-hierarchy/")
-    ("Webster" . 
-     [simple-query "humanities.uchicago.edu/forms_unrest/webster.form.html"
-		   "machaut.uchicago.edu/cgi-bin/WEBSTER.sh?WORD=" ""])
-    ("X Consortium Archive" . "ftp.x.org")
-    ("Yahoo: Reference" . "www.yahoo.com/Reference/")
-
-    ;; Computer social issues, privacy, professionalism.
-    ("Association for Computing Machinery" . "www.acm.org")
-    ("Computer Professionals for Social Responsibility" . "www.cpsr.org/dox/")
-    ("Electronic Frontier Foundation" . "www.eff.org")
-    ("IEEE Computer Society" . "www.computer.org")
-    ("Pretty Good Privacy" . "web.mit.edu/network/pgp.html")
-    ("Risks Digest" . webjump-to-risks)
-
-    ;; Fun.
-    ("Bastard Operator from Hell" . "www.replay.com/bofh/")
-
-    )
-  "Sample hotlist for WebJump.  See the documentation for the `webjump'
-function and the `webjump-sites' variable.")
-
-(defvar webjump-state-to-postal-alist
-  '(("Alabama" . "al") ("Alaska" . "ak") ("Arizona" . "az") ("Arkansas" . "ar")
-    ("California" . "ca") ("Colorado" . "co") ("Connecticut" . "ct")
-    ("Delaware" . "de") ("Florida" . "fl") ("Georgia" . "ga") ("Hawaii" . "hi")
-    ("Idaho" . "id") ("Illinois" . "il") ("Indiana" . "in") ("Iowa" . "ia")
-    ("Kansas" . "ks") ("Kentucky" . "ky") ("Louisiana" . "la") ("Maine" . "me")
-    ("Maryland" . "md") ("Massachusetts" . "ma") ("Michigan" . "mi")
-    ("Minnesota" . "mn") ("Mississippi" . "ms") ("Missouri" . "mo")
-    ("Montana" . "mt") ("Nebraska" . "ne") ("Nevada" . "nv")
-    ("New Hampshire" . "nh") ("New Jersey" . "nj") ("New Mexico" . "nm")
-    ("New York" . "ny") ("North Carolina" . "nc") ("North Dakota" . "nd")
-    ("Ohio" . "oh") ("Oklahoma" . "ok") ("Oregon" . "or")
-    ("Pennsylvania" . "pa") ("Rhode Island" . "ri") ("South Carolina" . "sc")
-    ("South Dakota" . "sd") ("Tennessee" . "tn") ("Texas" . "tx")
-    ("Utah" . "ut") ("Vermont" . "vt") ("Virginia" . "va")
-    ("Washington" . "wa") ("West Virginia" . "wv") ("Wisconsin" . "wi")
-    ("Wyoming" . "wy")))
-
-;;------------------------------------------------------------ Option Variables
-
-(defvar webjump-sites
-  webjump-sample-sites
-  "*Hotlist for WebJump.
-
-The hotlist is represented as an association list, with the CAR of each cell
-being the name of the Web site, and the CDR being the definition for the URL of
-that site.  The URL definition can be a string (the URL), a vector (specifying
-a special \"builtin\" which returns a URL), a symbol (name of a function which
-returns a URL), or a list (which when `eval'ed yields a URL).
-
-If the URL definition is a vector, then a \"builtin\" is used.  A builtin has a
-Lisp-like syntax, with the name as the first element of the vector, and any
-arguments as the following elements.  The three current builtins are `name',
-which returns the name of the site as the URL, `simple-query', which
-returns a URL that is a function of a query entered by the user, and `mirrors',
-which allows the user to select from among multiple mirror sites for the same
-content.
-
-The first argument to the `simple-query' builtin is a static URL to use if the
-user enters a blank query.  The second and third arguments are the prefix and
-suffix, respectively, to add to the encoded query the user enters.  This
-builtin covers Web sites that have single-string searches with the query
-embedded in the URL.
-
-The arguments to the `mirrors' builtin are URLs of mirror sites.
-
-If the symbol of a function is given, then the function will be called with the
-Web site name (the one you specified in the CAR of the alist cell) as a
-parameter.  This might come in handy for various kludges.
-
-For convenience, if the `http://', `ftp://', or `file://' prefix is missing
-from a URL, WebJump will make a guess at what you wanted and prepend it before
-submitting the URL.")
-
-;;------------------------------------------------------- Sample Site Functions
-
-(defun webjump-to-iwin (name)
-  (let ((prefix "http://iwin.nws.noaa.gov/")
-        (state (webjump-read-choice name "state"
-                                    (append '(("Puerto Rico" . "pr"))
-                                            webjump-state-to-postal-alist))))
-    (if state
-        (concat prefix "iwin/" state "/"
-                (webjump-read-choice name "option"
-                                     '(("Hourly Report" . "hourly")
-                                       ("State Forecast" . "state")
-                                       ("Local Forecast" . "local")
-                                       ("Zone Forecast" . "zone")
-                                       ("Short-Term Forecast" . "shortterm")
-                                       ("Weather Summary" . "summary")
-                                       ("Public Information" . "public")
-                                       ("Climatic Data" . "climate")
-                                       ("Aviation Products" . "aviation")
-                                       ("Hydro Products" . "hydro")
-                                       ("Special Weather" . "special")
-                                       ("Watches and Warnings" . "warnings"))
-                                     "zone")
-                ".html")
-      prefix)))
-
-(defun webjump-to-risks (name)
-  (let (issue volume)
-    (if (and (setq volume (webjump-read-number (concat name " volume")))
-	     (setq issue  (webjump-read-number (concat name " issue"))))
-	(format "catless.ncl.ac.uk/Risks/%d.%02d.html" volume issue)
-      "catless.ncl.ac.uk/Risks/")))
-
-;;-------------------------------------------------------------- Core Functions
-
-;;;###autoload
-(defun webjump ()
-  "Jumps to a Web site from a programmable hotlist.
-
-See the documentation for the `webjump-sites' variable for how to customize the
-hotlist.
-
-Please submit bug reports and other feedback to the author, Neil W. Van Dyke
-.
-
-The latest version can be gotten from `http://www.cs.brown.edu/people/nwv/'.
-That Web site also contains `webjump-plus.el', a larger and more frequently
-updated sample WebJump hotlist."
-  (interactive)
-  (let* ((completion-ignore-case t)
-	 (item (assoc-ignore-case
-		(completing-read "WebJump to site: " webjump-sites nil t)
-		webjump-sites))
-	 (name (car item))
-	 (expr (cdr item)))
-    (funcall browse-url-browser-function
-	     (webjump-url-fix
-	      (cond ((not expr) "")
-		    ((stringp expr) expr)
-		    ((vectorp expr) (webjump-builtin expr name))
-		    ((listp expr) (eval expr))
-		    ((symbolp expr)
-		     (if (fboundp expr)
-			 (funcall expr name)
-		       (error "WebJump URL function \"%s\" undefined." expr)))
-		    (t (error "WebJump URL expression for \"%s\" invalid."
-			      name)))))))
-
-(defun webjump-builtin (expr name)
-  (if (< (length expr) 1)
-      (error "WebJump URL builtin for \"%s\" empty." name))
-  (let ((builtin (aref expr 0)))
-    (cond
-     ((eq builtin 'mirrors)
-      (if (= (length expr) 1)
-          (error
-           "WebJump URL builtin \"mirrors\" for \"%s\" needs at least 1 arg."))
-      (webjump-choose-mirror name (cdr (append expr nil))))
-     ((eq builtin 'name)
-      name)
-     ((eq builtin 'simple-query)
-      (webjump-builtin-check-args expr name 3)
-      (webjump-do-simple-query name (aref expr 1) (aref expr 2) (aref expr 3)))
-     (t (error "WebJump URL builtin \"%s\" for \"%s\" invalid."
-	       builtin name)))))
-
-(defun webjump-builtin-check-args (expr name count)
-  (or (= (length expr) (1+ count))
-      (error "WebJump URL builtin \"%s\" for \"%s\" needs %d args."
-	     (aref expr 0) name count)))
-
-(defun webjump-choose-mirror (name urls)
-  (webjump-read-url-choice (concat name " mirror")
-                           urls
-                           (webjump-mirror-default urls)))
-
-(defun webjump-do-simple-query (name noquery-url query-prefix query-suffix)
-  (let ((query (webjump-read-string (concat name " query"))))
-    (if query
-	(concat query-prefix (webjump-url-encode query) query-suffix)
-      noquery-url)))
-
-(defun webjump-mirror-default (urls)
-  ;; Note: This should be modified to apply some simple kludges/heuristics to
-  ;; pick a site which is likely "close".  As a tie-breaker among candidates
-  ;; judged equally desirable, randomness might be used.
-  (car urls))
-
-(defun webjump-read-choice (name what choices &optional default)
-  (let* ((completion-ignore-case t)
-         (choice (completing-read (concat name " " what ": ") choices nil t)))
-    (if (webjump-null-or-blank-string-p choice)
-        default
-      (cdr (assoc choice choices)))))
-
-(defun webjump-read-number (prompt)
-  ;; Note: I should make this more robust someday.
-  (let ((input (webjump-read-string prompt)))
-    (if input (string-to-number input))))
-  
-(defun webjump-read-string (prompt)
-  (let ((input (read-string (concat prompt ": "))))
-    (if (webjump-null-or-blank-string-p input) nil input)))
-  
-(defun webjump-read-url-choice (what urls &optional default)
-  ;; Note: Convert this to use `webjump-read-choice' someday.
-  (let* ((completions (mapcar (function (lambda (n) (cons n n)))
-                              urls))
-	 (input (completing-read (concat what
-                                         ;;(if default " (RET for default)" "")
-                                         ": ")
-                                 completions
-                                 nil
-                                 t)))
-    (if (webjump-null-or-blank-string-p input)
-        default
-      (car (assoc input completions)))))
-
-(defun webjump-null-or-blank-string-p (str)
-  (or (null str) (string-match "^[ \t]*$" str)))
-
-(defun webjump-url-encode (str)
-  (mapconcat '(lambda (c)
-		(cond ((= c 32) "+")
-		      ((or (and (>= c ?a) (<= c ?z))
-			   (and (>= c ?A) (<= c ?Z))
-			   (and (>= c ?0) (<= c ?9)))
-		       (char-to-string c))
-		      (t (upcase (format "%%%02x" c)))))
-	     str
-	     ""))
-
-(defun webjump-url-fix (url)
-  (if (webjump-null-or-blank-string-p url)
-      ""
-    (webjump-url-fix-trailing-slash
-     (cond
-      ((string-match "^[a-zA-Z]+:" url) url)
-      ((string-match "^/" url) (concat "file://" url))
-      ((string-match "^\\([^\\./]+\\)" url)
-       (concat (if (string= (downcase (match-string 1 url)) "ftp")
-		   "ftp"
-		 "http")
-	       "://"
-	       url))
-      (t url)))))
-
-(defun webjump-url-fix-trailing-slash (url)
-  (if (string-match "^[a-zA-Z]+://[^/]+$" url)
-      (concat url "/")
-    url))
-
-;;-----------------------------------------------------------------------------
-
-(provide 'webjump)
-
-;; webjump.el ends here
diff --git a/xemacs-packages/lisp/net-utils/webster-www.el b/xemacs-packages/lisp/net-utils/webster-www.el
deleted file mode 100644
index f2f7020b..00000000
--- a/xemacs-packages/lisp/net-utils/webster-www.el
+++ /dev/null
@@ -1,71 +0,0 @@
-;;; webster-www.el --- Look up a word in WWW Merriam-Webster dictionaries
-
-;; Copyright (c) 1997, 1998 Tomasz Cholewo 
-
-;; Authors: Tomasz Cholewo 
-;;          Soren Dayton 
-;; Modified: 1998/04/05
-;; Version: 1.2
-;; Keywords: comm, hypermedia
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: not in FSF.
-
-;;; Code:
-(eval-when-compile
-  (autoload 'w3-form-encode-xwfu "w3-forms"))
-
-(defcustom webster-www-url-format "http://www.m-w.com/cgi-bin/mweb?book=%s&va=%s"
-  "URL format to reference for Webster's dictionaries.
-It is used in a call to `format' with a book name
-(\"Dictionary\" or \"Thesaurus\") as its first argument
-and a word to look up as its second argument."
-  :type 'string)
-
-(defun webster-www-dictionary (arg)
-  "Look up a word in Webster Dictionary at http://www.m-w.com."
-  (interactive (list (webster-www-prompt "Dictionary")))
-  (webster-www-fetch "Dictionary" arg))
-
-(fset 'webster-www (symbol-function 'webster-www-dictionary))
-
-(defun webster-www-thesaurus (arg)
-  "Look up a word in Webster Thesaurus at http://www.m-w.com."
-  (interactive (list (webster-www-prompt "Thesaurus")))
-  (webster-www-fetch "Thesaurus" arg))
-
-(defun webster-www-prompt (book)
-  (let* ((prompt (concat
-	          (concat "Look up word in Webster " book " (")
- 			  (current-word) "): "))
-         (arg (read-string prompt)))
-    (if (equal "" arg) (current-word) arg)))
-
-(defun webster-www-fetch (book word)
-  (require 'url)
-  (require 'w3-forms)
-  (require 'browse-url)
-  (browse-url
-   (format webster-www-url-format
- 	   book
- 	   (w3-form-encode-xwfu word))))
-
-(provide 'webster-www)
-
-;;; webster-www.el ends here
diff --git a/xemacs-packages/lisp/net-utils/xemacsbug.el b/xemacs-packages/lisp/net-utils/xemacsbug.el
deleted file mode 100644
index 9eabd4bb..00000000
--- a/xemacs-packages/lisp/net-utils/xemacsbug.el
+++ /dev/null
@@ -1,353 +0,0 @@
-;;; xemacsbug.el --- command to report XEmacs bugs to appropriate mailing list.
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-;; Copyright (C) 2001 Steve Youngs 
-
-;; Author: Steve Youngs 
-;; Based on 'emacsbug.el' by: K. Shane Hartman
-
-;; Maintainer: XEmacs Development Team
-;; Keywords: maint mail bugs
-
-;; Not fully installed because it can work only on Internet hosts.
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not synched.
-
-;;; Commentary:
-
-;; `M-x report-xemacs-bug ' starts an email note to the XEmacs maintainers
-;; describing a problem.  Here's how it's done...
-
-;;; Code:
-
-(require 'sendmail)
-(require 'shadow)
-
-(eval-when-compile
-  (defvar mh-before-send-letter-hook))
-
-(defgroup xemacsbug nil
-  "Sending XEmacs bug reports."
-  :group 'maint
-  :group 'mail)
-
-;; >> These should be addresses which are accessible to your machine,
-;; >> otherwise you can't use this file.  It will only work on the
-;; >> internet with this address.
-
-(defcustom report-xemacs-bug-address "XEmacs Beta "
-  "*Address of mailing list for XEmacs bugs."
-  :group 'xemacsbug
-  :type 'string)
-
-(defcustom report-xemacs-bug-extra-headers nil
-  "*An alist of mail-header value pairs for XEamcs bugs.
-
-It takes the format (HEADER . VALUE) where both HEADER and VALUE are
-strings. See `compose-mail'."
-  :group 'xemacsbug
-  :type '(repeat 
-	  (cons (string :tag "Header") 
-		(string :tag "Value"))))
-
-(defcustom report-xemacs-bug-beta-address "XEmacs Beta "
-  "*Address of mailing list for XEmacs beta bugs."
-  :group 'xemacsbug
-  :type 'string)
-
-(defcustom report-xemacs-bug-beta-extra-headers nil
-  "*An alist of mail-header value pairs for XEmacs beta bugs.
-
-It takes the format (HEADER . VALUE) where both HEADER and VALUE are
-strings. See `compose-mail'."
-  :group 'xemacsbug
-  :type '(repeat 
-	  (cons (string :tag "Header") 
-		(string :tag "Value"))))
-
-(defvar report-xemacs-bug-orig-text nil
-  "The automatically-created initial text of bug report.")
-
-(defcustom report-xemacs-bug-no-confirmation nil
-  "*If non-nil, suppress the confirmations asked for the sake of novice users."
-  :group 'xemacsbug
-  :type 'boolean)
-
-(defcustom report-xemacs-bug-no-explanations nil
-  "*If non-nil, suppress the explanations given for the sake of novice users."
-  :group 'xemacsbug
-  :type 'boolean)
-
-(defcustom report-xemacs-bug-send-init nil
-  "*If non-nil, include the user's init.el file in the bug report."
-  :group 'xemacsbug
-  :type 'boolean)
-
-(defconst report-xemacs-bug-help
-"\nThis bug report will be sent to the XEmacs Development Team,
-not to your local site managers!!
-
-Please write in English, because the XEmacs maintainers do not have
-translators to read other languages for them.
-
-Please describe as succinctly as possible:
-\t- What happened.
-\t- What you thought should have happened.
-\t- Precisely what you were doing at the time.
-
-Also include a reliable recipe for triggering the bug, as well as
-any C and lisp back-traces that you may have.
-\(setq stack-trace-on-error t\), or \(setq debug-on-error t\) if you
-are familiar with the debugger, to get a lisp back-trace.
-To get a core file for the C back-trace on a GNU/Linux system do 
-'ulimit -c unlimited' in the shell prior to starting XEmacs.
-
-Type \\[report-xemacs-bug-info] to visit in Info the XEmacs Manual section
-about when and how to write a bug report,
-and what information to supply so that the bug can be fixed.
-Type SPC to scroll through this section and its subsections.
-
-You are very welcome to scan through the bug report and remove any
-potentially sensitive data.
-
-Turn off this help buffer permanently by adding:
-
-\t \(setq report-xemacs-bug-no-explanations t\)
-
-To your ~/.xemacs/init.el")
-
-(defun report-xemacs-bug-help ()
-  "Display the help buffer for `report-xemacs-bug'."
-  (with-electric-help
-   '(lambda () 
-      (define-key (current-local-map) "\C-c\C-i" 'report-xemacs-bug-info)
-      (princ (substitute-command-keys report-xemacs-bug-help)) nil) "*Bug Help*"))
-
-(defun report-xemacs-bug-packages-list ()
-  "Insert into the current buffer a list of installed packages."
-  (let ((pkgs packages-package-list))
-    (while pkgs
-      (insert
-       (format "(%s ver: %s upstream: %s)\n"
-	       (nth 0 (car pkgs))
-	       (nth 2 (car pkgs))
-	       (nth 4 (car pkgs))))
-      (setq pkgs (cdr pkgs)))))
-
-;;;###autoload
-(defun report-xemacs-bug (topic &optional recent-keys)
-  "Report a bug in XEmacs.
-Prompts for bug subject.  Leaves you in a mail buffer."
-  ;; This strange form ensures that (recent-keys) is the value before
-  ;; the bug subject string is read.
-  (interactive (reverse (list (recent-keys) (read-string "Bug Subject: "))))
-  (let (user-point)
-    (setq topic (concat "[Bug: " emacs-program-version "] " topic))
-    (if xemacs-betaname
-	  (compose-mail report-xemacs-bug-beta-address
-			topic
-			report-xemacs-bug-beta-extra-headers)
-      (compose-mail report-xemacs-bug-address
-		    topic
-		    report-xemacs-bug-extra-headers))
-    ;; The rest of this does not execute
-    ;; if the user was asked to confirm and said no.
-    (goto-char (point-min))
-    (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
-    (forward-line 1)
-    (insert "================================================================\n")
-    (insert "Dear Bug Team!\n\n")
-    (setq user-point (point))
-    (insert "\n\n================================================================\n
-System Info to help track down your bug:
----------------------------------------\n\n")
-    ;; Insert the output of 'describe-installation'.
-    (insert (symbol-value 'Installation-string))
-    ;; Load-path shadows can cause some grief.
-    (flet ((append-message
-	     (&rest args) ())
-	   (clear-message
-	     (&optional label frame stdout-p no-restore)
-	     ()))
-      (insert "\n\nLoad-Path Lisp Shadows:\n"
-	      "----------------------\n")
-      (let ((before-shadows (point)))
-	(insert
-	  (format "%s"
-		  (find-emacs-lisp-shadows load-path)))
-	(save-restriction
-	  (narrow-to-region before-shadows (point))
-	  (fill-paragraph t)
-	  (insert "\n"))))
-    ;; Insert a list of installed packages.
-    (insert "\n\nInstalled XEmacs Packages:\n"
-	    "-------------------------\n")
-    (report-xemacs-bug-packages-list)
-    (insert "\n")
-    ;; Insert a list of installed modules.
-    (if (fboundp 'list-modules)
-	(progn
-	  (insert "\n\nInstalled Modules:\n"
-		  "-----------------\n")
-	    (let* ((mods (list-modules)))
-	      (while mods
-		(cl-prettyprint (cdr (car mods)))
-		(setq mods (cdr mods))))))
-    ;; Insert a list of loaded features
-    (let ((before-features (point)))
-      (insert
-       (format "\n\nFeatures:\n--------\n\n%s" (symbol-value 'features)))
-      (save-restriction
-	(narrow-to-region before-features (point))
-	(fill-paragraph t)
-	(insert "\n")))
-    ;; Insert recent keystrokes.
-    (insert "\n\n"
-	    "Recent keystrokes:\n-----------------\n\n")
-    (let ((before-keys (point)))
-      (insert (key-description recent-keys))
-      (save-restriction
-	(narrow-to-region before-keys (point))
-	(goto-char before-keys)
-	(while (progn (move-to-column 50) (not (eobp)))
-	  (search-forward " " nil t)
-	  (insert "\n"))))
-    ;; Insert recent minibuffer messages.
-    (insert "\n\n\nRecent messages (most recent first):\n"
-	    "-----------------------------------\n")
-    (let ((standard-output (current-buffer)))
-      (print-recent-messages 20)
-      (insert "\n"))
-    ;; Insert the contents of the user's init file if it exists.
-    (if report-xemacs-bug-send-init
-      (if (file-readable-p user-init-file)
-	  (save-excursion
-	    (goto-char (point-max))
-	    (beginning-of-line)
-	    (insert "\n\nUser Init File:\n--------------\n\n")
-	    (insert-file-contents user-init-file))))
-    ;; This is so the user has to type something
-    ;; in order to send easily.
-    (use-local-map (let ((map (make-sparse-keymap)))
-		     (set-keymap-parents map (current-local-map))
-		     map))
-    (define-key (current-local-map) "\C-c\C-i" 'report-xemacs-bug-info)
-    ;; Make it less likely people will send empty messages.
-    (cond
-     ((eq mail-user-agent 'sendmail-user-agent)
-      (make-local-variable 'mail-send-hook)
-      (add-hook 'mail-send-hook 'report-xemacs-bug-hook))
-     ((eq mail-user-agent 'message-user-agent)
-      (make-local-variable 'message-send-hook)
-      (add-hook 'message-send-hook 'report-xemacs-bug-hook))
-     ((eq mail-user-agent 'mh-e-user-agent)
-      (make-local-variable 'mh-before-send-letter-hook)
-      (add-hook 'mh-before-send-letter-hook 'report-xemacs-bug-hook))
-     (t
-      (make-local-variable 'mail-send-hook)
-      (add-hook 'mail-send-hook 'report-xemacs-bug-hook)))
-    (save-excursion
-      (goto-char (point-max))
-      (skip-chars-backward " \t\n")
-      (make-local-variable 'report-xemacs-bug-orig-text)
-      (setq report-xemacs-bug-orig-text (buffer-substring (point-min) (point))))
-    (goto-char user-point))
-  (delete-other-windows)
-  (unless report-xemacs-bug-no-explanations
-    (report-xemacs-bug-help)
-    (cond
-     ((eq mail-user-agent 'sendmail-user-agent)
-      (message (substitute-command-keys
-		"Type \\[mail-send-and-exit] to send the bug report, \\[kill-buffer] to cancel.")))
-     ((eq mail-user-agent 'message-user-agent)
-      (message (substitute-command-keys
-		"Type \\[message-send-and-exit] to send the bug report, \\[kill-buffer] to cancel.")))
-     ((eq mail-user-agent 'mh-e-user-agent)
-      (message (substitute-command-keys
-		"Type \\[mh-send-letter] to send the bug report, \\[kill-buffer] to cancel.")))
-     (t
-      (message (substitute-command-keys
-		"Type \\[mail-send-and-exit] to send the bug report, \\[kill-buffer] to cancel."))))))
-
-
-;; For backwards compatibility
-;;;###autoload
-(defalias 'report-emacs-bug 'report-xemacs-bug)
-
-(defun report-xemacs-bug-info ()
-  "Go to the Info node on reporting XEmacs bugs."
-  (interactive)
-  (Info-goto-node "(xemacs)Bugs"))
-
-(defun report-xemacs-bug-hook ()
-  "Hook run before sending a bug report."
-  (save-excursion
-    (goto-char (point-max))
-    (skip-chars-backward " \t\n")
-    (if (and (= (- (point) (point-min))
-		(length report-xemacs-bug-orig-text))
-	     (equal (buffer-substring (point-min) (point))
-		    report-xemacs-bug-orig-text))
-	(error "No text entered in bug report"))
-
-    ;; The last warning for novice users.
-    (if (or report-xemacs-bug-no-confirmation
-	    (yes-or-no-p
-	     "Send this bug report to the XEmacs maintainers? "))
-	;; Just send the current mail.
-	nil
-      (goto-char (point-min))
-      (let* ((top (point)))
-	(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
-	(save-restriction
-	  (narrow-to-region top (point))
-	  (goto-char (point-min))
-	  (if (re-search-forward "^To: " (eobp) t)
-	      (let ((pos (point)))
-		(end-of-line)
-		(delete-region pos (point))))
-	  (goto-char (point-min))
-	  (if (re-search-forward "^Cc: " (eobp) t)
-	      (let ((pos (point)))
-		(end-of-line)
-		(delete-region pos (point))))))
-      (cond
-       ((eq mail-user-agent 'sendmail-user-agent)
-	(kill-local-variable 'mail-send-hook))
-       ((eq mail-user-agent 'message-user-agent)
-	(kill-local-variable 'message-send-hook))
-       ((eq mail-user-agent 'mh-e-user-agent)
-	(kill-local-variable 'mh-before-send-letter-hook))
-       (t
-	(kill-local-variable 'mail-send-hook)))
-      (unless report-xemacs-bug-no-explanations
-	(with-electric-help
-	 '(lambda ()
-	    (insert "\n
-You invoked the command M-x report-xemacs-bug,
-but you decided not to mail the bug report to the XEmacs maintainers.
-
-If you want to mail it to someone else instead,
-please insert the proper e-mail address after \"To: \",
-and send the mail again.") nil) "*Bug Help*"))
-      (error "Sending Bug Report Cancelled"))))
-
-(provide 'xemacsbug)
-
-;;; xemacsbug.el ends here
diff --git a/xemacs-packages/lisp/net-utils/xml.el b/xemacs-packages/lisp/net-utils/xml.el
deleted file mode 100644
index 2277cdbf..00000000
--- a/xemacs-packages/lisp/net-utils/xml.el
+++ /dev/null
@@ -1,507 +0,0 @@
-;;; xml.el --- XML parser
-
-;;; !!! This version has been modified from the version distributed with
-;;; XEmacs to fix a bug parsing empty elements, for Proof General.  !!!
-
-;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
-
-;; Author: Emmanuel Briot  
-;; Maintainer: Emmanuel Briot 
-;; Keywords: xml
-
-;; 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:
-
-;; This file contains a full XML parser. It parses a file, and returns a list
-;; that can be used internally by any other lisp file.
-;; See some example in todo.el
-
-;;; FILE FORMAT
-
-;; It does not parse the DTD, if present in the XML file, but knows how to
-;; ignore it. The XML file is assumed to be well-formed. In case of error, the
-;; parsing stops and the XML file is shown where the parsing stopped.
-;;
-;; It also knows how to ignore comments, as well as the special ?xml? tag
-;; in the XML file.
-;;
-;; The XML file should have the following format:
-;;    value
-;;       value2
-;;       value3
-;;    
-;; Of course, the name of the nodes and attributes can be anything. There can
-;; be any number of attributes (or none), as well as any number of children
-;; below the nodes.
-;;
-;; There can be only top level node, but with any number of children below.
-
-;;; LIST FORMAT
-
-;; The functions `xml-parse-file' and `xml-parse-tag' return a list with
-;; the following format:
-;;
-;;    xml-list   ::= (node node ...)
-;;    node       ::= (tag_name attribute-list . child_node_list)
-;;    child_node_list ::= child_node child_node ...
-;;    child_node ::= node | string
-;;    tag_name   ::= string
-;;    attribute_list ::= (("attribute" . "value") ("attribute" . "value") ...)
-;;                       | nil
-;;    string     ::= "..."
-;;
-;; Some macros are provided to ease the parsing of this list
-
-;;; Code:
-
-(eval-and-compile
-  (defalias 'match-string-no-properties 'match-string))
-
-;;*******************************************************************
-;;**
-;;**  Macros to parse the list
-;;**
-;;*******************************************************************
-
-(defsubst xml-node-name (node)
-  "Return the tag associated with NODE.
-The tag is a lower-case symbol."
-  (car node))
-
-(defsubst xml-node-attributes (node)
-  "Return the list of attributes of NODE.
-The list can be nil."
-  (nth 1 node))
-
-(defsubst xml-node-children (node)
-  "Return the list of children of NODE.
-This is a list of nodes, and it can be nil."
-  (cddr node))
-
-(defun xml-get-children (node child-name)
-  "Return the children of NODE whose tag is CHILD-NAME.
-CHILD-NAME should be a lower case symbol."
-  (let ((match ()))
-    (dolist (child (xml-node-children node))
-      (if child
-	  (if (equal (xml-node-name child) child-name)
-	      (push child match))))
-    (nreverse match)))
-
-(defun xml-get-attribute (node attribute)
-  "Get from NODE the value of ATTRIBUTE.
-An empty string is returned if the attribute was not found."
-  (if (xml-node-attributes node)
-      (let ((value (assoc attribute (xml-node-attributes node))))
-	(if value
-	    (cdr value)
-	  ""))
-    ""))
-
-;;*******************************************************************
-;;**
-;;**  Creating the list
-;;**
-;;*******************************************************************
-
-(defun xml-parse-file (file &optional parse-dtd)
-  "Parse the well-formed XML FILE.
-If FILE is already edited, this will keep the buffer alive.
-Returns the top node with all its children.
-If PARSE-DTD is non-nil, the DTD is parsed rather than skipped."
-  (let ((keep))
-    (if (get-file-buffer file)
-	(progn
-	  (set-buffer (get-file-buffer file))
-	  (setq keep (point)))
-      (find-file file))
-    
-    (let ((xml (xml-parse-region (point-min)
-				 (point-max)
-				 (current-buffer)
-				 parse-dtd)))
-      (if keep
-	  (goto-char keep)
-	(kill-buffer (current-buffer)))
-      xml)))
-
-(defun xml-parse-region (beg end &optional buffer parse-dtd)
-  "Parse the region from BEG to END in BUFFER.
-If BUFFER is nil, it defaults to the current buffer.
-Returns the XML list for the region, or raises an error if the region
-is not a well-formed XML file.
-If PARSE-DTD is non-nil, the DTD is parsed rather than skipped,
-and returned as the first element of the list"
-  (let (xml result dtd)
-    (save-excursion
-      (if buffer
-	  (set-buffer buffer))
-      (goto-char beg)
-      (while (< (point) end)
-	(if (search-forward "<" end t)
-	    (progn
-	      (forward-char -1)
-	      (if (null xml)
-		  (progn
-		    (setq result (xml-parse-tag end parse-dtd))
-		    (cond
-		     ((null result))
-		     ((listp (car result))
-		      (setq dtd (car result))
-		      (add-to-list 'xml (cdr result)))
-		     (t
-		      (add-to-list 'xml result))))
-
-		;;  translation of rule [1] of XML specifications
-		(error "XML files can have only one toplevel tag")))
-	  (goto-char end)))
-      (if parse-dtd
-	  (cons dtd (nreverse xml))
-	(nreverse xml)))))
-
-
-(defun xml-parse-tag (end &optional parse-dtd)
-  "Parse the tag that is just in front of point.
-The end tag must be found before the position END in the current buffer.
-If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and
-returned as the first element in the list.
-Returns one of:
-   - a list : the matching node
-   - nil    : the point is not looking at a tag.
-   - a cons cell: the first element is the DTD, the second is the node"
-  (cond
-   ;; Processing instructions (like the  tag at the
-   ;; beginning of a document)
-   ((looking-at "<\\?")
-    (search-forward "?>" end)
-    (skip-chars-forward " \t\n")
-    (xml-parse-tag end))
-   ;;  Character data (CDATA) sections, in which no tag should be interpreted
-   ((looking-at "" end t)
-	(error "CDATA section does not end anywhere in the document"))
-      (buffer-substring-no-properties pos (match-beginning 0))))
-   ;;  DTD for the document
-   ((looking-at "" end)
-    nil)
-   ;;  end tag
-   ((looking-at " \t\n]+\\)")
-    (goto-char (match-end 1))
-    (let* ((case-fold-search nil) ;; XML is case-sensitive.
-	   (node-name (match-string 1))
-	   ;; Parse the attribute list.
-	   (children (list (xml-parse-attlist end) (intern node-name)))
-	   pos)
-
-      ;; is this an empty element ?
-      (if (looking-at "/>")
-	  (progn
-	    (forward-char 2)
-	    (nreverse children))
-
-	;; is this a valid start tag ?
-	(if (eq (char-after) ?>)
-	    (progn
-	      (forward-char 1)
-	      ;;  Now check that we have the right end-tag. Note that this
-	      ;;  one might contain spaces after the tag name
-	      (while (not (looking-at (concat "")))
-		(cond
-		 ((looking-at " (point) end)
-		  (error "XML: End tag for %s not found before end of region"
-			 node-name))
-	      (nreverse children))
-
-	  ;;  This was an invalid start tag
-	  (error "XML: Invalid attribute list")
-	  ))))
-   (t ;; This is not a tag.
-    (error "XML: Invalid character"))
-   ))
-
-(defun xml-parse-attlist (end)
-  "Return the attribute-list that point is looking at.
-The search for attributes end at the position END in the current buffer.
-Leaves the point on the first non-blank character after the tag."
-  (let ((attlist ())
-	name)
-    (skip-chars-forward " \t\n")
-    (while (looking-at "\\([a-zA-Z_:][-a-zA-Z0-9._:]*\\)[ \t\n]*=[ \t\n]*")
-      (setq name (intern (match-string 1)))
-      (goto-char (match-end 0))
-
-      ;; Do we have a string between quotes (or double-quotes),
-      ;;  or a simple word ?
-      (unless (looking-at "\"\\([^\"]*\\)\"")
-	(unless (looking-at "'\\([^']*\\)'")
-	  (error "XML: Attribute values must be given between quotes")))
-
-      ;; Each attribute must be unique within a given element
-      (if (assoc name attlist)
-	  (error "XML: each attribute must be unique within an element"))
-      
-      (push (cons name (match-string-no-properties 1)) attlist)
-      (goto-char (match-end 0))
-      (skip-chars-forward " \t\n")
-      (if (> (point) end)
-	  (error "XML: end of attribute list not found before end of region"))
-      )
-    (nreverse attlist)))
-
-;;*******************************************************************
-;;**
-;;**  The DTD (document type declaration)
-;;**  The following functions know how to skip or parse the DTD of
-;;**  a document
-;;**
-;;*******************************************************************
-
-(defun xml-skip-dtd (end)
-  "Skip the DTD that point is looking at.
-The DTD must end before the position END in the current buffer.
-The point must be just before the starting tag of the DTD.
-This follows the rule [28] in the XML specifications."
-  (forward-char (length "")
-      (error "XML: invalid DTD (excepting name of the document)"))
-  (condition-case nil
-      (progn
-	(forward-word 1)  ;; name of the document
-	(skip-chars-forward " \t\n")
-	(if (looking-at "\\[")
-	    (re-search-forward "\\][ \t\n]*>" end)
-	  (search-forward ">" end)))
-    (error (error "XML: No end to the DTD"))))
-
-(defun xml-parse-dtd (end)
-  "Parse the DTD that point is looking at.
-The DTD must end before the position END in the current buffer."
-  (forward-char (length "")
-      (error "XML: invalid DTD (excepting name of the document)"))
-  
-  ;;  Get the name of the document
-  (looking-at "\\sw+")
-  (let ((dtd (list (match-string-no-properties 0) 'dtd))
-	type element end-pos)
-    (goto-char (match-end 0))
-
-    (skip-chars-forward " \t\n")
-
-    ;;  External DTDs => don't know how to handle them yet
-    (if (looking-at "SYSTEM")
-	(error "XML: Don't know how to handle external DTDs"))
-    
-    (if (not (= (char-after) ?\[))
-	(error "XML: Unknown declaration in the DTD"))
-
-    ;;  Parse the rest of the DTD
-    (forward-char 1)
-    (while (and (not (looking-at "[ \t\n]*\\]"))
-		(<= (point) end))
-      (cond
-
-       ;;  Translation of rule [45] of XML specifications
-       ((looking-at
-	 "[\t \n]*]+\\)>")
-
-	(setq element (intern (match-string-no-properties 1))
-	      type    (match-string-no-properties 2))
-	(setq end-pos (match-end 0))
-	
-	;;  Translation of rule [46] of XML specifications
-	(cond
-	 ((string-match "^EMPTY[ \t\n]*$" type)     ;; empty declaration
-	  (setq type 'empty))
-	 ((string-match "^ANY[ \t\n]*$" type)       ;; any type of contents
-	  (setq type 'any))
-	 ((string-match "^(\\(.*\\))[ \t\n]*$" type) ;; children ([47])
-	  (setq type (xml-parse-elem-type (match-string-no-properties 1 type))))
-	 ((string-match "^%[^;]+;[ \t\n]*$" type)   ;; substitution
-	  nil)
-	 (t
-	  (error "XML: Invalid element type in the DTD")))
-
-	;;  rule [45]: the element declaration must be unique
-	(if (assoc element dtd)
-	    (error "XML: elements declaration must be unique in a DTD (<%s>)"
-		   (symbol-name element)))
-	
-	;;  Store the element in the DTD
-	(push (list element type) dtd)
-	(goto-char end-pos))
-
-
-       (t
-	(error "XML: Invalid DTD item"))
-       )
-      )
-
-    ;;  Skip the end of the DTD
-    (search-forward ">" end)
-    (nreverse dtd)))
-
-
-(defun xml-parse-elem-type (string)
-  "Convert a STRING for an element type into an elisp structure."
-
-  (let (elem modifier)
-    (if (string-match "(\\([^)]+\\))\\([+*?]?\\)" string)
-	(progn
-	  (setq elem     (match-string 1 string)
-		modifier (match-string 2 string))
-	  (if (string-match "|" elem)
-	      (setq elem (cons 'choice
-			       (mapcar 'xml-parse-elem-type
-				       (split-string elem "|"))))
-	    (if (string-match "," elem)
-		(setq elem (cons 'seq
-				 (mapcar 'xml-parse-elem-type
-					 (split-string elem ","))))
-	      )))
-      (if (string-match "[ \t\n]*\\([^+*?]+\\)\\([+*?]?\\)" string)
-	  (setq elem     (match-string 1 string)
-		modifier (match-string 2 string))))
-
-    (if (and (stringp elem) (string= elem "#PCDATA"))
-	(setq elem 'pcdata))
-    
-    (cond
-     ((string= modifier "+")
-      (list '+ elem))
-     ((string= modifier "*")
-      (list '* elem))
-     ((string= modifier "?")
-      (list '? elem))
-     (t
-      elem))))
-
-
-;;*******************************************************************
-;;**
-;;**  Substituting special XML sequences
-;;**
-;;*******************************************************************
-
-(defun xml-substitute-special (string)
-  "Return STRING, after subsituting special XML sequences."
-  (while (string-match "&" string)
-    (setq string (replace-match "&"  t nil string)))
-  (while (string-match "<" string)
-    (setq string (replace-match "<"  t nil string)))
-  (while (string-match ">" string)
-    (setq string (replace-match ">"  t nil string)))
-  (while (string-match "'" string)
-    (setq string (replace-match "'"  t nil string)))
-  (while (string-match """ string)
-    (setq string (replace-match "\"" t nil string)))
-  string)
-
-;;*******************************************************************
-;;**
-;;**  Printing a tree.
-;;**  This function is intended mainly for debugging purposes.
-;;**
-;;*******************************************************************
-
-(defun xml-debug-print (xml)
-  (dolist (node xml)
-    (xml-debug-print-internal node "")))
-
-(defun xml-debug-print-internal (xml indent-string)
-  "Outputs the XML tree in the current buffer.
-The first line indented with INDENT-STRING."
-  (let ((tree xml)
-	attlist)
-    (insert indent-string "<" (symbol-name (xml-node-name tree)))
-    
-    ;;  output the attribute list
-    (setq attlist (xml-node-attributes tree))
-    (while attlist
-      (insert " ")
-      (insert (symbol-name (caar attlist)) "=\"" (cdar attlist) "\"")
-      (setq attlist (cdr attlist)))
-    
-    (insert ">")
-    
-    (setq tree (xml-node-children tree))
-
-    ;;  output the children
-    (dolist (node tree)
-      (cond
-       ((listp node)
-	(insert "\n")
-	(xml-debug-print-internal node (concat indent-string "  ")))
-       ((stringp node) (insert node))
-       (t
-	(error "Invalid XML tree"))))
-
-    (insert "\n" indent-string
-	    "")))
-
-(provide 'xml)
-
-;;; xml.el ends here
diff --git a/xemacs-packages/lisp/os-utils/ChangeLog b/xemacs-packages/lisp/os-utils/ChangeLog
deleted file mode 100644
index d4c5622f..00000000
--- a/xemacs-packages/lisp/os-utils/ChangeLog
+++ /dev/null
@@ -1,317 +0,0 @@
-2006-02-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.37 released.
-
-2006-02-26  Mike Sperber  
-
-	* inf-lisp.el (inferior-lisp-install-letter-bindings): Re-instate
-	autoloads commented out by jwz eons ago---for some people, ILISP
-	does suck more than inf-lisp.el.
-
-2005-01-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.36 released.
-
-2005-01-29  Ville Skyttä  
-
-	* os-utils.texi: Spelling fixes, add document title.
-
-	* arc-mode.el: Sync with GNU Emacs 20.2, add *.[ejw]ar to
-	auto-mode-alist association.
-
-2004-01-13  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.35 released.
-
-2003-10-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.34 released.
-
-2003-10-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.33 released.
-
-2003-10-03  Ilya N. Golubev  
-
-	* background.el (background-search-job-space): Fix byte-compiler
-	warning.
-	(background): Fix (usually not happening) direct
-	`background-get-job-name-simple' call.
-
-	* rlogin.el (rlogin-parse-words): Fix (supposed) match-data
-	restoring.
-
-2003-10-03  Ilya N. Golubev  
-
-	* rlogin.el (rlogin): Remove unneeded duplication of process
-	marker setting done inside `comint-exec'.
-
-2003-10-03  Ilya N. Golubev  
-
-	* background.el (background): Use `insert-before-markers' for text
-	to output, like `comint-output-filter' does.
-
-2003-09-22  Steve Youngs  
-
-	* Makefile (EXPLICIT_DOCS): Removed.
-	(STANDARD_DOCS): Use this instead.
-
-2003-08-28  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.32 released.
-
-2003-08-28  Jake Colman  
-
-	* Makefile (EXPLICIT_DOCS): New.  Added texi documentation.
-
-2003-06-01  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.31 released.
-
-2003-05-26  Stephen J. Turnbull  
-
-	* jka-compr.el (jka-compr-insert-file-contents): New docstring.
-	Implement REPLACE argument correctly.  Thanks to Martin Schwenke
-	 for reporting and testing.  Bugfix suggested
-	by Richard Stallman .
-	(Maintainer): Update to XEmacs Development Team.
-
-2003-03-09  Ben Wing  
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-
-2003-01-13  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.30 released.
-
-2003-01-06  Ville Skyttä  
-
-	* arc-mode.el: Make auto-mode-alist modifications autoload-only.
-
-2002-11-29  Ben Wing  
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15  Ville Skyttä  
-
-	* Makefile (srckit): Remove.
-
-2002-10-07  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.29 released.
-
-2002-09-30  Ville Skyttä  
-
-	* arc-mode.el: Add autoloaded auto-mode-alist association.
-
-2002-05-10  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.28 released.
-
-2002-05-09  Ben Wing  
-
-	* arc-mode.el (archive-*-write-file-member):
-	* arc-mode.el (archive-lzh-summarize):
-	* arc-mode.el (archive-zip-summarize):
-	Use #o... not ?\... to get octal integers.  ?\ in XEmacs
-	gives chars and you will get syntax errors or worse.
-
-2002-05-07  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.27 released.
-
-2002-04-26  James LewisMoss  
-
-	* background.el (background-get-job-name): var holding the func to
-	use to generate the background buffer id/name.
-	(background-search-job-space): search buffer list for a buffer
-	generated from FORM (which includes a %d number field) and return
-	the first that no longer has a process connected to it.
-	(background-get-job-name-simple): generate a simple background
-	buffer name "background-%d"
-	(format-quote-string): just replace % with %% in string so format
-	won't be unhappy.
-	(get-bottom-dir): grab last dir part in string (/usr/foo/bar -> bar)
-	(background-get-job-name-command): more complex background namer
-	"BG()%d"
-	(background-get-job-name-command-n-dir): and a more complex
-	background namer "BG()()%d"
-	(background): use new background-get-job-name custom var to
-	generate the background name.
-
-2002-01-13  Steve Youngs  
-
-	* package-info.in (provides): Remove 'lpr', it's in 'ps-print'.
-	And update to include all provides.
-
-2002-01-09  Steve Youngs  
-
-	* Makefile (ELCS): Remove 'lpr.elc' as it's now in 'ps-print'
-
-2000-11-09  Sean MacLennan  
-
-	* uncompress.el: Synced with GNU Emacs 20.7
-
-2000-10-05  Martin Buchholz  
-
-	* *: Mega typo fix.
-
-2000-09-15  Adrian Aichner  
-
-	* crypt.el (crypt-find-file-hook): Fix (null-buffer-file-name)
-	typo.
-
-2000-08-16  Andreas Jaeger  
-
-	* crypt.el (crypt-find-file-hook): Add missing closing brace.
-
-2000-08-04  Didier Verna  
-
-	* Makefile (VERSION): increment.
-	(ELCS): add missing `mchat.elc'.
-	* mchat.el: version 2.1 is released.
-
-2000-03-13  Johannes Ziegler 
-
-	* crypt.el (crypt-encoding-alist): Gzip Files with .gz and .tgz
-	extension.
-	(crypt-find-file-hook): renaming of then ungzipped buffers
-	name.gz => name and name.tgz => name.tar
-
-2000-02-23  Jan Vroonhof  
-
-	* jka-compr.el: Globally replace 'no-conversion with 'binary
-
-2000-02-09  Martin Buchholz  
-
-	* crypt.el (crypt-build-encoding-alist): Remove bzip2 `--quiet'
-	option, not available before bzip2 0.9.5.
-	Fix two byte-compiler warnings.
-
-1999-09-20  James LewisMoss  
-
-	* crypt.el (crypt-build-encoding-alist): Add bzip2 data to
-	encoding list.
-	(crypt-find-file-hook): Add .bz2 as an ending to be stripped when
-	loading.
-
-1999-11-08  Yoshiki Hayashi  
-
-	* jka-compr.el (auto-compression-mode): Pass original
-	argument to toggle-auto-compression.
-
-1999-08-08  Jan Vroonhof  
-
-	* jka-compr.el (jka-compr-call-process): Guard against use of
-	file-coding-system-for-read.
-	(jka-compr-insert-file-contents): idem.
-	(jka-value-if-bound): New function.
-
-1999-07-20  Darryl Okahata  
-
-	* tar-mode.el: `tar-regexp' must only match the names of
-	uncompressed tar files.  If it matches the names of compressed tar
-	files, tar-mode will attempt to parse the compressed tar file as
-	an uncompressed tar file, causing an error.  Note that this will
-	not affect either crypt.el nor jka-compr.el, as they will properly
-	uncompress a buffer before entering tar-mode.
-
-1999-07-15  SL Baur  
-
-	* jka-compr.el (jka-compr-install): Only diddle with
-	file-coding-system-alist in XEmacs with file-coding.
-	(jka-compr-uninstall): Ditto.
-
-1999-06-29  SL Baur  
-
-	* Makefile (ELCS): ps-print.el removed.
-
-1999-03-19  Didier Verna  
-
-	* mchat.el: version 2.0 released.
-
-1998-12-30  Martin Buchholz  
-
-	* tar-mode.el (tar-regexp): Add autoload cookie.
-	(auto-mode-alist): Add autoload cookie.
-
-1998-10-01  SL Baur  
-
-	* ssh.el (ssh-send-Ctrl-C): send-string -> process-send-string.
-	(ssh-send-Ctrl-D): Ditto.
-	(ssh-send-Ctrl-Z): Ditto.
-	(ssh-send-Ctrl-backslash): Ditto.
-	* rlogin.el (rlogin-send-Ctrl-C): Ditto.
-	(rlogin-send-Ctrl-D): Ditto.
-	(rlogin-send-Ctrl-Z): Ditto.
-	(rlogin-send-Ctrl-backslash): Ditto.
-
-1998-09-30  SL Baur  
-
-	* ftelnet.el: New file.
-	* ssh.el: Sync to version 1.6
-	* rlogin.el: Sync to version 1.43
-
-1998-09-10  Noah Friedman  
-
-	* rlogin.el (rlogin): If using make-local-hook, pass the 4th arg
-	`t' to add-hook also to modify the new local value.
-	* ssh.el (ssh): Here also.
-
-1998-07-14  SL Baur  
-
-	* rlogin.el: Global replace send-string -> process-send-string.
-	* ssh.el: Ditto.
-
-1998-06-07  Tomasz Cholewo  
-
-	* jka-compr.el (jka-compr-partial-uncompress): Fix integer in concat.
-
-1998-06-13  SL Baur  
-
-	* lpr.el (print-region-1): Remove references to `buffer-file-type'.
-
-1998-04-17  SL Baur  
-
-	* rlogin.el-1.40.
-
-1998-04-06  Hrvoje Niksic  
-
-	* tar-mode.el (tar-subfile-mode): Call `auto-save-mode' with a 0,
-	argument, not nil.
-	(tar-regexp): Include `.tar.gz' files.
-
-1998-02-21  Aki Vehtari  
-
-	* tar-mode.el:  Add "q" for quit, and use "C" for copy and "R" for
-	rename as in dired.
-
-1998-02-15  SL Baur  
-
-	* jka-compr.el: Reenable auto-compression-mode symbol.
-
-1998-01-24  SL Baur  
-
-	* Makefile (VERSION): Update to package standard 1.0.
-	* package-info.in: Ditto.
-
-1998-01-11  SL Baur  
-
-	* Makefile: Update to newer package interface.
-
-1998-01-05  SL Baur  
-
-	* Makefile: Update to newer packages interface.
-
-1997-12-27  Jens-Ulrik Holger Petersen  
-
-	* tar-mode.el: Minimal synchage with Emacs 20.  Moved `tar-' to the
-	front of all identifiers.  Some docstring improvements too.
-	(tar-mode-map): Added keybindings for [up], [down] and [return].
-
-1997-12-24  SL Baur  
-
-	* Makefile: Created.
diff --git a/xemacs-packages/lisp/os-utils/_pkg.el b/xemacs-packages/lisp/os-utils/_pkg.el
deleted file mode 100644
index ad2bb67a..00000000
--- a/xemacs-packages/lisp/os-utils/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'os-utils
-		 :version 1.37
-          :author-version "No-Upstream-Ver"
-		 :type 'single-file)
diff --git a/xemacs-packages/lisp/os-utils/arc-mode.el b/xemacs-packages/lisp/os-utils/arc-mode.el
deleted file mode 100644
index 3f439640..00000000
--- a/xemacs-packages/lisp/os-utils/arc-mode.el
+++ /dev/null
@@ -1,1598 +0,0 @@
-;;; arc-mode.el --- simple editing of archives
-
-;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
-
-;; Author: Morten Welinder 
-;; Keywords: archives msdog editing major-mode
-;; Favourite-brand-of-beer: None, I hate beer.
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: GNU Emacs 20.2, with differences in comparing chars with
-;;; `eq' instead of `=', and applying `char-int' to various `memq's, and
-;;; using #o instead of ?\ for octal numbers.  See also inline comments.
-
-;;; Commentary:
-
-;; NAMING: "arc" is short for "archive" and does not refer specifically
-;; to files whose name end in ".arc"
-;;
-;; This code does not decode any files internally, although it does
-;; understand the directory level of the archives.  For this reason,
-;; you should expect this code to need more fiddling than tar-mode.el
-;; (although it at present has fewer bugs :-)  In particular, I have
-;; not tested this under Ms-Dog myself.
-;; -------------------------------------
-;; INTERACTION: arc-mode.el should play together with
-;;
-;; * ange-ftp.el: Remote archives (i.e., ones that ange-ftp has brought
-;;                to you) are handled by doing all updates on a local
-;;                copy.  When you make changes to a remote file the
-;;                changes will first take effect when the archive buffer
-;;                is saved.  You will be warned about this.
-;;
-;; * dos-fns.el:  (Part of Emacs 19).  You get automatic ^M^J <--> ^J
-;;                conversion.
-;;
-;; arc-mode.el does not work well with crypt++.el; for the archives as
-;; such this could be fixed (but wouldn't be useful) by declaring such
-;; archives to be "remote".  For the members this is a general Emacs
-;; problem that 19.29's file formats may fix.
-;; -------------------------------------
-;; ARCHIVE TYPES: Currently only the archives below are handled, but the
-;; structure for handling just about anything is in place.
-;;
-;;                        Arc     Lzh     Zip     Zoo
-;;                        --------------------------------
-;; View listing           Intern  Intern  Intern  Intern
-;; Extract member         Y       Y       Y       Y
-;; Save changed member    Y       Y       Y       Y
-;; Add new member         N       N       N       N
-;; Delete member          Y       Y       Y       Y
-;; Rename member          Y       Y       N       N
-;; Chmod                  -       Y       Y       -
-;; Chown                  -       Y       -       -
-;; Chgrp                  -       Y       -       -
-;;
-;; Special thanks to Bill Brodie  for very useful tips
-;; on the first released version of this package.
-;;
-;; This code is partly based on tar-mode.el from Emacs.
-;; -------------------------------------
-;; ARCHIVE STRUCTURES:
-;; (This is mostly for myself.)
-;;
-;; ARC         A series of (header,file).  No interactions among members.
-;;
-;; LZH         A series of (header,file).  Headers are checksummed.  No
-;;             interaction among members.
-;;
-;; ZIP         A series of (lheader,fil) followed by a "central directory"
-;;             which is a series of (cheader) followed by an end-of-
-;;             central-dir record possibly followed by junk.  The e-o-c-d
-;;             links to c-d.  cheaders link to lheaders which are basically
-;;             cut-down versions of the cheaders.
-;;
-;; ZOO         An archive header followed by a series of (header,file).
-;;             Each member header points to the next.  The archive is
-;;             terminated by a bogus header with a zero next link.
-;; -------------------------------------
-;; HOOKS: `foo' means one of the supported archive types.
-;;
-;; archive-mode-hook
-;; archive-foo-mode-hook
-;; archive-extract-hooks
-
-;;; Code:
-
-;; -------------------------------------------------------------------------
-;; Section: Configuration.
-
-(defgroup archive nil
-  "Simple editing of archives."
-  :group 'data)
-
-(defgroup archive-arc nil
-  "ARC-specific options to archive."
-  :group 'archive)
-
-(defgroup archive-lzh nil
-  "LZH-specific options to archive."
-  :group 'archive)
-
-(defgroup archive-zip nil
-  "ZIP-specific options to archive."
-  :group 'archive)
-
-(defgroup archive-zoo nil
-  "ZOO-specific options to archive."
-  :group 'archive)
-
-
-(defcustom archive-dos-members t
-  "*If non-nil then recognize member files using ^M^J as line terminator."
-  :type 'boolean
-  :group 'archive)
-
-(defcustom archive-tmpdir
-  (expand-file-name
-   (make-temp-name (if (eq system-type 'ms-dos) "ar" "archive.tmp"))
-   (or (getenv "TMPDIR") (getenv "TMP") "/tmp"))
-  "*Directory for temporary files made by arc-mode.el"
-  :type 'directory
-  :group 'archive)
-
-(defcustom archive-remote-regexp "^/[^/:]*[^/:.]:"
-  "*Regexp recognizing archive files names that are not local.
-A non-local file is one whose file name is not proper outside Emacs.
-A local copy of the archive will be used when updating."
-  :type 'regexp
-  :group 'archive)
-
-(defcustom archive-extract-hooks nil
-  "*Hooks to run when an archive member has been extracted."
-  :type 'hook
-  :group 'archive)
-;; ------------------------------
-;; Arc archive configuration
-
-;; We always go via a local file since there seems to be no reliable way
-;; to extract to stdout without junk getting added.
-(defcustom archive-arc-extract
-  '("arc" "x")
-  "*Program and its options to run in order to extract an arc file member.
-Extraction should happen to the current directory.  Archive and member
-name will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-arc)
-
-(defcustom archive-arc-expunge
-  '("arc" "d")
-  "*Program and its options to run in order to delete arc file members.
-Archive and member names will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-arc)
-
-(defcustom archive-arc-write-file-member
-  '("arc" "u")
-  "*Program and its options to run in order to update an arc file member.
-Archive and member name will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-arc)
-;; ------------------------------
-;; Lzh archive configuration
-
-(defcustom archive-lzh-extract
-  '("lha" "pq")
-  "*Program and its options to run in order to extract an lzh file member.
-Extraction should happen to standard output.  Archive and member name will
-be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-lzh)
-
-(defcustom archive-lzh-expunge
-  '("lha" "d")
-  "*Program and its options to run in order to delete lzh file members.
-Archive and member names will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-lzh)
-
-(defcustom archive-lzh-write-file-member
-  '("lha" "a")
-  "*Program and its options to run in order to update an lzh file member.
-Archive and member name will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-lzh)
-;; ------------------------------
-;; Zip archive configuration
-
-(defcustom archive-zip-use-pkzip (memq system-type '(ms-dos windows-nt))
-  "*If non-nil then pkzip option are used instead of zip options.
-Only set to true for msdog systems!"
-  :type 'boolean
-  :group 'archive-zip)
-
-(defcustom archive-zip-extract
-  (if archive-zip-use-pkzip '("pkunzip" "-e") '("unzip" "-qq" "-c"))
-  "*Program and its options to run in order to extract a zip file member.
-Extraction should happen to standard output.  Archive and member name will
-be added.  If `archive-zip-use-pkzip' is non-nil then this program is
-expected to extract to a file junking the directory part of the name."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-zip)
-
-;; For several reasons the latter behaviour is not desirable in general.
-;; (1) It uses more disk space.  (2) Error checking is worse or non-
-;; existent.  (3) It tends to do funny things with other systems' file
-;; names.
-
-(defcustom archive-zip-expunge
-  (if archive-zip-use-pkzip '("pkzip" "-d") '("zip" "-d" "-q"))
-  "*Program and its options to run in order to delete zip file members.
-Archive and member names will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-zip)
-
-(defcustom archive-zip-update
-  (if archive-zip-use-pkzip '("pkzip" "-u") '("zip" "-q"))
-  "*Program and its options to run in order to update a zip file member.
-Options should ensure that specified directory will be put into the zip
-file.  Archive and member name will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-zip)
-
-(defcustom archive-zip-update-case
-  (if archive-zip-use-pkzip archive-zip-update '("zip" "-q" "-k"))
-  "*Program and its options to run in order to update a case fiddled zip member.
-Options should ensure that specified directory will be put into the zip file.
-Archive and member name will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-zip)
-
-(defcustom archive-zip-case-fiddle t
-  "*If non-nil then zip file members are case fiddled.
-Case fiddling will only happen for members created by a system that
-uses caseless file names."
-  :type 'boolean
-  :group 'archive-zip)
-;; ------------------------------
-;; Zoo archive configuration
-
-(defcustom archive-zoo-extract
-  '("zoo" "xpq")
-  "*Program and its options to run in order to extract a zoo file member.
-Extraction should happen to standard output.  Archive and member name will
-be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-zoo)
-
-(defcustom archive-zoo-expunge
-  '("zoo" "DqPP")
-  "*Program and its options to run in order to delete zoo file members.
-Archive and member names will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-zoo)
-
-(defcustom archive-zoo-write-file-member
-  '("zoo" "a")
-  "*Program and its options to run in order to update a zoo file member.
-Archive and member name will be added."
-  :type '(list (string :tag "Program")
-		(repeat :tag "Options"
-			:inline t
-			(string :format "%v")))
-  :group 'archive-zoo)
-;; -------------------------------------------------------------------------
-;; Section: Variables
-
-(defvar archive-subtype nil "*Symbol describing archive type.")
-(defvar archive-file-list-start nil "*Position of first contents line.")
-(defvar archive-file-list-end nil "*Position just after last contents line.")
-(defvar archive-proper-file-start nil "*Position of real archive's start.")
-(defvar archive-read-only nil "*Non-nil if the archive is read-only on disk.")
-(defvar archive-remote nil "*Non-nil if the archive is outside file system.")
-(defvar archive-local-name nil "*Name of local copy of remote archive.")
-(defvar archive-mode-map nil "*Local keymap for archive mode listings.")
-(defvar archive-file-name-indent nil "*Column where file names start.")
-
-(defvar archive-alternate-display nil
-  "*Non-nil when alternate information is shown.")
-(make-variable-buffer-local 'archive-alternate-display)
-(put 'archive-alternate-display 'permanent-local t)
-
-(defvar archive-superior-buffer nil "*In archive members, points to archive.")
-(put 'archive-superior-buffer 'permanent-local t)
-
-(defvar archive-subfile-mode nil "*Non-nil in archive member buffers.")
-(make-variable-buffer-local 'archive-subfile-mode)
-(put 'archive-subfile-mode 'permanent-local t)
-
-(defvar archive-subfile-dos nil
-  "Negation of `buffer-file-type', which see.")
-(make-variable-buffer-local 'archive-subfile-dos)
-(put 'archive-subfile-dos 'permanent-local t)
-
-(defvar archive-files nil
-  "Vector of file descriptors.
-Each descriptor is a vector of the form
- [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]")
-(make-variable-buffer-local 'archive-files)
-
-;; XEmacs change: `archive-lemacs' removed, `running-xemacs' used instead.
-
-;; -------------------------------------------------------------------------
-;; Section: Support functions.
-
-(defsubst archive-name (suffix)
-  (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
-
-(defun archive-l-e (str &optional len)
-  "Convert little endian string/vector to integer.
-Alternatively, first argument may be a buffer position in the current buffer
-in which case a second argument, length, should be supplied."
-  (if (stringp str)
-      (setq len (length str))
-    (setq str (buffer-substring str (+ str len))))
-  (let ((result 0)
-        (i 0))
-    (while (< i len)
-      (setq i (1+ i)
-            result (+ (ash result 8) (aref str (- len i)))))
-    result))
-
-(defun archive-int-to-mode (mode)
-  "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------"
-  (let ((str (make-string 10 ?-)))
-    (or (zerop (logand 16384 mode)) (aset str 0 ?d))
-    (or (zerop (logand  8192 mode)) (aset str 0 ?c)) ; completeness
-    (or (zerop (logand   256 mode)) (aset str 1 ?r))
-    (or (zerop (logand   128 mode)) (aset str 2 ?w))
-    (or (zerop (logand    64 mode)) (aset str 3 ?x))
-    (or (zerop (logand    32 mode)) (aset str 4 ?r))
-    (or (zerop (logand    16 mode)) (aset str 5 ?w))
-    (or (zerop (logand     8 mode)) (aset str 6 ?x))
-    (or (zerop (logand     4 mode)) (aset str 7 ?r))
-    (or (zerop (logand     2 mode)) (aset str 8 ?w))
-    (or (zerop (logand     1 mode)) (aset str 9 ?x))
-    (or (zerop (logand  1024 mode)) (aset str 3 (if (zerop (logand 64 mode))
-						    ?S ?s)))
-    (or (zerop (logand  2048 mode)) (aset str 6 (if (zerop (logand  8 mode))
-						    ?S ?s)))
-    str))
-
-(defun archive-calc-mode (oldmode newmode &optional error)
-  "From the integer OLDMODE and the string NEWMODE calculate a new file mode.
-NEWMODE may be an octal number including a leading zero in which case it
-will become the new mode.\n
-NEWMODE may also be a relative specification like \"og-rwx\" in which case
-OLDMODE will be modified accordingly just like chmod(2) would have done.\n
-If optional third argument ERROR is non-nil an error will be signaled if
-the mode is invalid.  If ERROR is nil then nil will be returned."
-  (cond ((string-match "^0[0-7]*$" newmode)
-	 (let ((result 0)
-	       (len (length newmode))
-	       (i 1))
-	   (while (< i len)
-	     (setq result (+ (lsh result 3) (aref newmode i) (- ?0))
-		   i (1+ i)))
-	   (logior (logand oldmode 65024) result)))
-	((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode)
-	 (let ((who 0)
-	       (result oldmode)
-	       (op (aref newmode (match-beginning 2)))
-	       (bits 0)
-	       (i (match-beginning 3)))
-	   (while (< i (match-end 3))
-	     (let ((rwx (aref newmode i)))
-	       (setq bits (logior bits (cond ((= rwx ?r)  292)
-					     ((= rwx ?w)  146)
-					     ((= rwx ?x)   73)
-					     ((= rwx ?s) 3072)
-					     ((= rwx ?t)  512)))
-		     i (1+ i))))
-	   (while (< who (match-end 1))
-	     (let* ((whoc (aref newmode who))
-		    (whomask (cond ((= whoc ?a) 4095)
-				   ((= whoc ?u) 1472)
-				   ((= whoc ?g) 2104)
-				   ((= whoc ?o)    7))))
-	       (if (= op ?=)
-		   (setq result (logand result (lognot whomask))))
-	       (if (= op ?-)
-		   (setq result (logand result (lognot (logand whomask bits))))
-		 (setq result (logior result (logand whomask bits)))))
-	     (setq who (1+ who)))
-	   result))
-	(t
-	 (if error
-	     (error "Invalid mode specification: %s" newmode)))))
-
-(defun archive-dosdate (date)
-  "Stringify dos packed DATE record."
-  (let ((year (+ 1980 (logand (ash date -9) 127)))
-        (month (logand (ash date -5) 15))
-        (day (logand date 31)))
-    (if (or (> month 12) (< month 1))
-        ""
-      (format "%2d-%s-%d"
-              day
-              (aref ["Jan" "Feb" "Mar" "Apr" "May" "Jun"
-                     "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] (1- month))
-              year))))
-
-(defun archive-dostime (time)
-  "Stringify dos packed TIME record."
-  (let ((hour (logand (ash time -11) 31))
-        (minute (logand (ash time -5) 53))
-        (second (* 2 (logand time 31)))) ; 2 seconds resolution
-    (format "%02d:%02d:%02d" hour minute second)))
-
-;;(defun archive-unixdate (low high)
-;;  "Stringify unix (LOW HIGH) date."
-;;  (let ((str (current-time-string (cons high low))))
-;;    (format "%s-%s-%s"
-;;	    (substring str 8 9)
-;;	    (substring str 4 7)
-;;	    (substring str 20 24))))
-
-;;(defun archive-unixtime (low high)
-;;  "Stringify unix (LOW HIGH) time."
-;;  (let ((str (current-time-string (cons high low))))
-;;    (substring str 11 19)))
-
-(defun archive-get-lineno ()
-  (if (>= (point) archive-file-list-start)
-      (count-lines archive-file-list-start
-		   (save-excursion (beginning-of-line) (point)))
-    0))
-
-(defun archive-get-descr (&optional noerror)
-  "Return the descriptor vector for file at point.
-Does not signal an error if optional second argument NOERROR is non-nil."
-  (let ((no (archive-get-lineno)))
-    (if (and (>= (point) archive-file-list-start)
-             (< no (length archive-files)))
-	(let ((item (aref archive-files no)))
-	  (if (vectorp item)
-	      item
-	    (if (not noerror)
-		(error "Entry is not a regular member of the archive"))))
-      (if (not noerror)
-          (error "Line does not describe a member of the archive")))))
-;; -------------------------------------------------------------------------
-;; Section: the mode definition
-
-;;;###autoload
-(defun archive-mode (&optional force)
-  "Major mode for viewing an archive file in a dired-like way.
-You can move around using the usual cursor motion commands.
-Letters no longer insert themselves.
-Type `e' to pull a file out of the archive and into its own buffer;
-or click mouse-2 on the file's line in the archive mode buffer.
-
-If you edit a sub-file of this archive (as with the `e' command) and
-save it, the contents of that buffer will be saved back into the
-archive.
-
-\\{archive-mode-map}"
-  ;; This is not interactive because you shouldn't be turning this
-  ;; mode on and off.  You can corrupt things that way.
-  (if (zerop (buffer-size))
-      ;; At present we cannot create archives from scratch
-      (funcall default-major-mode)
-    (if (and (not force) archive-files) nil
-      (let* ((type (archive-find-type))
-	     (typename (copy-sequence (symbol-name type))))
-	(aset typename 0 (upcase (aref typename 0)))
-	(kill-all-local-variables)
-	(make-local-variable 'archive-subtype)
-	(setq archive-subtype type)
-
-	;; Buffer contains treated image of file before the file contents
-	(make-local-variable 'revert-buffer-function)
-	(setq revert-buffer-function 'archive-mode-revert)
-	(auto-save-mode 0)
-	(make-local-variable 'local-write-file-hooks)
-	(add-hook 'local-write-file-hooks 'archive-write-file)
-
-	;; Real file contents is binary
-	(make-local-variable 'require-final-newline)
-	(setq require-final-newline nil)
-	(make-local-variable 'enable-local-variables)
-	(setq enable-local-variables nil)
-	(if (boundp 'default-buffer-file-type)
-	    (setq buffer-file-type t))
-
-	(make-local-variable 'archive-read-only)
-	(setq archive-read-only (not (file-writable-p (buffer-file-name))))
-
-	;; Should we use a local copy when accessing from outside Emacs?
-	(make-local-variable 'archive-local-name)
-	(make-local-variable 'archive-remote)
-	(setq archive-remote (string-match archive-remote-regexp
-					   (buffer-file-name)))
-
-	(setq major-mode 'archive-mode)
-	(setq mode-name (concat typename "-Archive"))
-	;; Run archive-foo-mode-hook and archive-mode-hook
-	(run-hooks (archive-name "mode-hook") 'archive-mode-hook)
-	(use-local-map archive-mode-map))
-
-      (make-local-variable 'archive-proper-file-start)
-      (make-local-variable 'archive-file-list-start)
-      (make-local-variable 'archive-file-list-end)
-      (make-local-variable 'archive-file-name-indent)
-      (archive-summarize)
-      (setq buffer-read-only t))))
-
-;; Archive mode is suitable only for specially formatted data.
-(put 'archive-mode 'mode-class 'special)
-
-;; XEmacs addition
-(defun archive-quit ()
-  "Bury the current archive buffer."
-  (interactive)
-  (bury-buffer))
-
-;; -------------------------------------------------------------------------
-;; Section: Key maps
-
-(if archive-mode-map nil
-  (setq archive-mode-map (make-keymap))
-  (suppress-keymap archive-mode-map)
-  (define-key archive-mode-map " " 'archive-next-line)
-  (define-key archive-mode-map "a" 'archive-alternate-display)
-  ;;(define-key archive-mode-map "c" 'archive-copy)
-  (define-key archive-mode-map "d" 'archive-flag-deleted)
-  (define-key archive-mode-map "\C-d" 'archive-flag-deleted)
-  (define-key archive-mode-map "e" 'archive-extract)
-  (define-key archive-mode-map "f" 'archive-extract)
-  (define-key archive-mode-map "\C-m" 'archive-extract)
-  (define-key archive-mode-map "g" 'revert-buffer)
-  (define-key archive-mode-map "h" 'describe-mode)
-  (define-key archive-mode-map "m" 'archive-mark)
-  (define-key archive-mode-map "n" 'archive-next-line)
-  (define-key archive-mode-map "\C-n" 'archive-next-line)
-  (define-key archive-mode-map [down] 'archive-next-line)
-  (define-key archive-mode-map "o" 'archive-extract-other-window)
-  (define-key archive-mode-map "p" 'archive-previous-line)
-  (define-key archive-mode-map "\C-p" 'archive-previous-line)
-  (define-key archive-mode-map [up] 'archive-previous-line)
-  (define-key archive-mode-map "r" 'archive-rename-entry)
-  (define-key archive-mode-map "u" 'archive-unflag)
-  (define-key archive-mode-map "\M-\C-?" 'archive-unmark-all-files)
-  (define-key archive-mode-map "v" 'archive-view)
-  (define-key archive-mode-map "x" 'archive-expunge)
-  ;; XEmacs: "\177" -> 'backspace and 'delete.
-  (define-key archive-mode-map 'backspace 'archive-unflag-backwards)
-  (define-key archive-mode-map 'delete 'archive-unflag-backwards)
-  (define-key archive-mode-map "E" 'archive-extract-other-window)
-  (define-key archive-mode-map "M" 'archive-chmod-entry)
-  (define-key archive-mode-map "G" 'archive-chgrp-entry)
-  (define-key archive-mode-map "O" 'archive-chown-entry)
-
-  (if running-xemacs
-      (progn
-	;; Not a nice "solution" but it'll have to do
-	(define-key archive-mode-map "q" 'archive-quit)
-	(define-key archive-mode-map "\C-xu" 'archive-undo)
-	(define-key archive-mode-map "\C-_" 'archive-undo))
-    (substitute-key-definition 'undo 'archive-undo
-			       archive-mode-map global-map))
-
-  (define-key archive-mode-map
-    (if running-xemacs 'button2 [mouse-2]) 'archive-mouse-extract)
-
-  (if running-xemacs
-      ()				; out of luck
-    ;; Get rid of the Edit menu bar item to save space.
-    (define-key archive-mode-map [menu-bar edit] 'undefined)
-
-    (define-key archive-mode-map [menu-bar immediate]
-      (cons "Immediate" (make-sparse-keymap "Immediate")))
-    (define-key archive-mode-map [menu-bar immediate alternate]
-      '("Alternate Display" . archive-alternate-display))
-    (put 'archive-alternate-display 'menu-enable
-	 '(boundp (archive-name "alternate-display")))
-    (define-key archive-mode-map [menu-bar immediate view]
-      '("View This File" . archive-view))
-    (define-key archive-mode-map [menu-bar immediate display]
-      '("Display in Other Window" . archive-display-other-window))
-    (define-key archive-mode-map [menu-bar immediate find-file-other-window]
-      '("Find in Other Window" . archive-extract-other-window))
-    (define-key archive-mode-map [menu-bar immediate find-file]
-      '("Find This File" . archive-extract))
-
-    (define-key archive-mode-map [menu-bar mark]
-      (cons "Mark" (make-sparse-keymap "Mark")))
-    (define-key archive-mode-map [menu-bar mark unmark-all]
-      '("Unmark All" . archive-unmark-all-files))
-    (define-key archive-mode-map [menu-bar mark deletion]
-      '("Flag" . archive-flag-deleted))
-    (define-key archive-mode-map [menu-bar mark unmark]
-      '("Unflag" . archive-unflag))
-    (define-key archive-mode-map [menu-bar mark mark]
-      '("Mark" . archive-mark))
-
-    (define-key archive-mode-map [menu-bar operate]
-      (cons "Operate" (make-sparse-keymap "Operate")))
-    (define-key archive-mode-map [menu-bar operate chown]
-      '("Change Owner..." . archive-chown-entry))
-    (put 'archive-chown-entry 'menu-enable
-	 '(fboundp (archive-name "chown-entry")))
-    (define-key archive-mode-map [menu-bar operate chgrp]
-      '("Change Group..." . archive-chgrp-entry))
-    (put 'archive-chgrp-entry 'menu-enable
-	 '(fboundp (archive-name "chgrp-entry")))
-    (define-key archive-mode-map [menu-bar operate chmod]
-      '("Change Mode..." . archive-chmod-entry))
-    (put 'archive-chmod-entry 'menu-enable
-	 '(fboundp (archive-name "chmod-entry")))
-    (define-key archive-mode-map [menu-bar operate rename]
-      '("Rename to..." . archive-rename-entry))
-    (put 'archive-rename-entry 'menu-enable
-	 '(fboundp (archive-name "rename-entry")))
-    ;;(define-key archive-mode-map [menu-bar operate copy]
-    ;;  '("Copy to..." . archive-copy))
-    (define-key archive-mode-map [menu-bar operate expunge]
-      '("Expunge Marked Files" . archive-expunge))
-  ))
-
-(let* ((item1 '(archive-subfile-mode " Archive"))
-       (item2 '(archive-subfile-dos " Dos"))
-       (items (if (memq system-type '(ms-dos windows-nt))
-		  (list item1) ; msdog has its own indicator
-		(list item1 item2))))
-  (or (member item1 minor-mode-alist)
-      (setq minor-mode-alist (append items minor-mode-alist))))
-;; -------------------------------------------------------------------------
-(defun archive-find-type ()
-  (widen)
-  (goto-char (point-min))
-  ;; The funny [] here make it unlikely that the .elc file will be treated
-  ;; as an archive by other software.
-  (let (case-fold-search)
-    (cond ((looking-at "[P]K\003\004") 'zip)
-	  ((looking-at "..-l[hz][0-9]-") 'lzh)
-	  ((looking-at "....................[\334]\247\304\375") 'zoo)
-	  ((and (looking-at "\C-z")	; signature too simple, IMHO
-		(string-match "\\.[aA][rR][cC]$"
-			      (or buffer-file-name (buffer-name))))
-	   'arc)
-	  (t (error "Buffer format not recognized.")))))
-;; -------------------------------------------------------------------------
-(defun archive-summarize ()
-  "Parse the contents of the archive file in the current buffer.
-Place a dired-like listing on the front;
-then narrow to it, so that only that listing
-is visible (and the real data of the buffer is hidden)."
-  (widen)
-  (let (buffer-read-only)
-    (message "Parsing archive file...")
-    (buffer-disable-undo (current-buffer))
-    (setq archive-files (funcall (archive-name "summarize")))
-    (message "Parsing archive file...done.")
-    (setq archive-proper-file-start (point-marker))
-    (narrow-to-region (point-min) (point))
-    (set-buffer-modified-p nil)
-    (buffer-enable-undo))
-  (goto-char archive-file-list-start)
-  (archive-next-line 0))
-
-(defun archive-resummarize ()
-  "Recreate the contents listing of an archive."
-  (let ((modified (buffer-modified-p))
-	(no (archive-get-lineno))
-	buffer-read-only)
-    (widen)
-    (delete-region (point-min) archive-proper-file-start)
-    (archive-summarize)
-    (set-buffer-modified-p modified)
-    (goto-char archive-file-list-start)
-    (archive-next-line no)))
-
-(defun archive-summarize-files (files)
-  "Insert a description of a list of files annotated with proper mouse face."
-  (setq archive-file-list-start (point-marker))
-  (setq archive-file-name-indent (if files (aref (car files) 1) 0))
-  ;; We don't want to do an insert for each element since that takes too
-  ;; long when the archive -- which has to be moved in memory -- is large.
-  (insert
-   (apply
-    (function concat)
-    (mapcar
-     (function 
-      (lambda (fil)
-	;; Using `concat' here copies the text also, so we can add
-	;; properties without problems.
-	(let ((text (concat (aref fil 0) "\n")))
-	  ;; XEmacs change: enabled for XEmacs too.
-	  (put-text-property (aref fil 1) (aref fil 2)
-			     'mouse-face 'highlight
-			     text)
-	  text)))
-     files)))
-  (setq archive-file-list-end (point-marker)))
-
-(defun archive-alternate-display ()
-  "Toggle alternative display.
-To avoid very long lines some archive mode don't show all information.
-This function changes the set of information shown for each files."
-  (interactive)
-  (setq archive-alternate-display (not archive-alternate-display))
-  (archive-resummarize))
-;; -------------------------------------------------------------------------
-;; Section: Local archive copy handling
-
-(defun archive-maybe-copy (archive)
-  (if archive-remote
-      (let ((start (point-max)))
-	(setq archive-local-name (expand-file-name
-				  (file-name-nondirectory archive)
-				  archive-tmpdir))
-	(make-directory archive-tmpdir t)
-	(save-restriction
-	  (widen)
-	  (write-region start (point-max) archive-local-name nil 'nomessage))
-	archive-local-name)
-    (if (buffer-modified-p) (save-buffer))
-    archive))
-
-(defun archive-maybe-update (unchanged)
-  (if archive-remote
-      (let ((name archive-local-name)
-	    (modified (buffer-modified-p))
-	    buffer-read-only)
-	(if unchanged nil
-	  (erase-buffer)
-	  (insert-file-contents name)
-	  (archive-mode t))
-	(archive-delete-local name)
-	(if (not unchanged)
-	    (message "Archive file must be saved for changes to take effect"))
-	(set-buffer-modified-p (or modified (not unchanged))))))
-
-(defun archive-delete-local (name)
-  "Delete file NAME and its parents up to and including `archive-tmpdir'."
-  (let ((again t)
-	(top (directory-file-name (file-name-as-directory archive-tmpdir))))
-    (condition-case nil
-	(delete-file name)
-      (error nil))
-    (while again
-      (setq name (directory-file-name (file-name-directory name)))
-      (condition-case nil
-	  (delete-directory name)
-	(error nil))
-      (if (string= name top) (setq again nil)))))
-;; -------------------------------------------------------------------------
-;; Section: Member extraction
-
-(defun archive-mouse-extract (event)
-  "Extract a file whose name you click on."
-  (interactive "e")
-  (mouse-set-point event)
-  (switch-to-buffer
-   (save-excursion
-     (archive-extract)
-     (current-buffer))))
-
-(defun archive-extract (&optional other-window-p)
-  "In archive mode, extract this entry of the archive into its own buffer."
-  (interactive)
-  (let* ((view-p (eq other-window-p 'view))
-	 (descr (archive-get-descr))
-         (ename (aref descr 0))
-         (iname (aref descr 1))
-         (archive-buffer (current-buffer))
-         (arcdir default-directory)
-         (archive (buffer-file-name))
-         (arcname (file-name-nondirectory archive))
-         (bufname (concat (file-name-nondirectory iname) " (" arcname ")"))
-         (extractor (archive-name "extract"))
-         (read-only-p (or archive-read-only view-p))
-         (buffer (get-buffer bufname))
-         (just-created nil))
-      (if buffer
-          nil
-	(setq archive (archive-maybe-copy archive))
-        (setq buffer (get-buffer-create bufname))
-        (setq just-created t)
-        (save-excursion
-          (set-buffer buffer)
-          (setq buffer-file-name
-                (expand-file-name (concat arcname ":" iname)))
-          (setq buffer-file-truename
-                (abbreviate-file-name buffer-file-name))
-          ;; Set the default-directory to the dir of the superior buffer.
-          (setq default-directory arcdir)
-          (make-local-variable 'archive-superior-buffer)
-          (setq archive-superior-buffer archive-buffer)
-          (make-local-variable 'local-write-file-hooks)
-          (add-hook 'local-write-file-hooks 'archive-write-file-member)
-          (setq archive-subfile-mode descr)
-	  (setq archive-subfile-dos nil)
-	  (if (boundp 'default-buffer-file-type)
-	      (setq buffer-file-type t))
-	  (if (fboundp extractor)
-	      (funcall extractor archive ename)
-	    (archive-*-extract archive ename (symbol-value extractor)))
-          (if archive-dos-members (archive-check-dos))
-          (goto-char (point-min))
-          (rename-buffer bufname)
-          (setq buffer-read-only read-only-p)
-	  (setq buffer-undo-list nil)
-          (set-buffer-modified-p nil)
-	  (setq buffer-saved-size (buffer-size))
-          (normal-mode)
-	  ;; Just in case an archive occurs inside another archive.
-	  (if (eq major-mode 'archive-mode)
-	      (setq archive-remote t))
-	  (run-hooks 'archive-extract-hooks))
-	(archive-maybe-update t))
-      (if view-p
-	  ;; XEmacs change: `view-buffer's 2nd arg difference
-          (progn
-            (view-buffer buffer)
-            (and just-created (setq view-exit-action 'kill-buffer)))
-        (if (eq other-window-p 'display)
-            (display-buffer buffer)
-          (if other-window-p
-              (switch-to-buffer-other-window buffer)
-            (switch-to-buffer buffer))))))
-
-(defun archive-*-extract (archive name command)
-  (let* ((default-directory (file-name-as-directory archive-tmpdir))
-	 (tmpfile (expand-file-name (file-name-nondirectory name)
-				    default-directory)))
-    (make-directory (directory-file-name default-directory) t)
-    (apply 'call-process
-	   (car command)
-	   nil
-	   nil
-	   nil
-	   (append (cdr command) (list archive name)))
-    (insert-file-contents tmpfile)
-    (archive-delete-local tmpfile)))
-
-(defun archive-extract-by-stdout (archive name command)
-  (let ((binary-process-output t)) ; for Ms-Dos
-    (apply 'call-process
-	   (car command)
-	   nil
-	   t
-	   nil
-	   (append (cdr command) (list archive name)))))
-
-(defun archive-extract-other-window ()
-  "In archive mode, find this member in another window."
-  (interactive)
-  (archive-extract t))
-
-(defun archive-display-other-window ()
-  "In archive mode, display this member in another window."
-  (interactive)
-  (archive-extract 'display))
-
-(defun archive-view ()
-  "In archive mode, view the member on this line."
-  (interactive)
-  (archive-extract 'view))
-
-(defun archive-add-new-member (arcbuf name)
-  "Add current buffer to the archive in ARCBUF naming it NAME."
-  (interactive
-   (list (get-buffer
-	  (read-buffer "Buffer containing archive: "
-		       ;; Find first archive buffer and suggest that
-		       (let ((bufs (buffer-list)))
-			 (while (and bufs (not (eq (save-excursion
-						     (set-buffer (car bufs))
-						     major-mode)
-						   'archive-mode)))
-			   (setq bufs (cdr bufs)))
-			 (if bufs
-			     (car bufs)
-			   (error "There are no archive buffers")))
-		       t))
-	 (read-string "File name in archive: "
-		      (if buffer-file-name
-			  (file-name-nondirectory buffer-file-name)
-			""))))
-  (save-excursion
-    (set-buffer arcbuf)
-    (or (eq major-mode 'archive-mode)
-	(error "Buffer is not an archive buffer"))
-    (if archive-read-only
-	(error "Archive is read-only")))
-  (if (eq arcbuf (current-buffer))
-      (error "An archive buffer cannot be added to itself"))
-  (if (string= name "")
-      (error "Archive members may not be given empty names"))
-  (let ((func (save-excursion (set-buffer arcbuf)
-			      (archive-name "add-new-member")))
-	(membuf (current-buffer)))
-    (if (fboundp func)
-	(save-excursion
-	  (set-buffer arcbuf)
-	  (funcall func buffer-file-name membuf name))
-      (error "Adding a new member is not supported for this archive type"))))
-;; -------------------------------------------------------------------------
-;; Section: IO stuff
-
-(defun archive-check-dos (&optional force)
-  "*Possibly handle a buffer with ^M^J terminated lines."
-  (save-restriction
-    (widen)
-    (save-excursion
-      (goto-char (point-min))
-      (setq archive-subfile-dos
-	    (or force (not (search-forward-regexp "[^\r]\n" nil t))))
-      (if (boundp 'default-buffer-file-type)
-	  (setq buffer-file-type (not archive-subfile-dos)))
-      (if archive-subfile-dos
-          (let ((modified (buffer-modified-p)))
-            (buffer-disable-undo (current-buffer))
-            (goto-char (point-min))
-            (while (search-forward "\r\n" nil t)
-              (replace-match "\n"))
-            (buffer-enable-undo)
-            (set-buffer-modified-p modified))))))
-
-(defun archive-write-file-member ()
-  (if archive-subfile-dos
-      (save-restriction
-	(widen)
-        (save-excursion
-          (goto-char (point-min))
-          ;; We don't want our ^M^J <--> ^J changes to show in the undo list
-          (let ((undo-list buffer-undo-list))
-            (unwind-protect
-                (progn
-                  (setq buffer-undo-list t)
-                  (while (search-forward "\n" nil t)
-                    (replace-match "\r\n"))
-                  (setq archive-subfile-dos nil)
-		  (if (boundp 'default-buffer-file-type)
-		      (setq buffer-file-type t))
-                  ;; OK, we're now have explicit ^M^Js -- save and re-unixfy
-                  (archive-write-file-member))
-              (progn
-                (archive-check-dos t)
-                (setq buffer-undo-list undo-list))))
-          t))
-    (save-excursion
-      (save-restriction
-        (message "Updating archive...")
-        (widen)
-	(let ((writer  (save-excursion (set-buffer archive-superior-buffer)
-				       (archive-name "write-file-member")))
-	      (archive (save-excursion (set-buffer archive-superior-buffer)
-				       (buffer-file-name))))
-	  (if (fboundp writer)
-	      (funcall writer archive archive-subfile-mode)
-	    (archive-*-write-file-member archive
-					 archive-subfile-mode
-					 (symbol-value writer))))
-	(set-buffer-modified-p nil)
-        (message "Updating archive...done")
-        (set-buffer archive-superior-buffer)
-        (revert-buffer)
-        t))))
-
-(defun archive-*-write-file-member (archive descr command)
-  (let* ((ename (aref descr 0))
-         (tmpfile (expand-file-name ename archive-tmpdir))
-         (top (directory-file-name (file-name-as-directory archive-tmpdir)))
-	 (default-directory (file-name-as-directory top)))
-    (unwind-protect
-        (progn
-          (make-directory (file-name-directory tmpfile) t)
-	  (write-region (point-min) (point-max) tmpfile nil 'nomessage)
-	  (if (aref descr 3)
-	      ;; Set the file modes, but make sure we can read it.
-	      (set-file-modes tmpfile (logior #o400 (aref descr 3))))
-          (let ((exitcode (apply 'call-process
-                                 (car command)
-                                 nil
-                                 nil
-                                 nil
-                                 (append (cdr command) (list archive ename)))))
-            (if (equal exitcode 0)
-                nil
-              (error "Updating was unsuccessful (%S)" exitcode))))
-      (archive-delete-local tmpfile))))
-
-(defun archive-write-file ()
-  (save-excursion
-    (write-region archive-proper-file-start (point-max) buffer-file-name nil t)
-    (set-buffer-modified-p nil)
-    t))
-;; -------------------------------------------------------------------------
-;; Section: Marking and unmarking.
-
-(defun archive-flag-deleted (p &optional type)
-  "In archive mode, mark this member to be deleted from the archive.
-With a prefix argument, mark that many files."
-  (interactive "p")
-  (or type (setq type ?D))
-  (beginning-of-line)
-  (let ((sign (if (>= p 0) +1 -1))
-	(modified (buffer-modified-p))
-        buffer-read-only)
-    (while (not (zerop p))
-      (if (archive-get-descr t)
-          (progn
-            (delete-char 1)
-            (insert type)))
-      (forward-line sign)
-      (setq p (- p sign)))
-    (set-buffer-modified-p modified))
-  (archive-next-line 0))
-
-(defun archive-unflag (p)
-  "In archive mode, un-mark this member if it is marked to be deleted.
-With a prefix argument, un-mark that many files forward."
-  (interactive "p")
-  (archive-flag-deleted p ? ))
-
-(defun archive-unflag-backwards (p)
-  "In archive mode, un-mark this member if it is marked to be deleted.
-With a prefix argument, un-mark that many members backward."
-  (interactive "p")
-  (archive-flag-deleted (- p) ? ))
-
-(defun archive-unmark-all-files ()
-  "Remove all marks."
-  (interactive)
-  (let ((modified (buffer-modified-p))
-	buffer-read-only)
-    (save-excursion
-      (goto-char archive-file-list-start)
-      (while (< (point) archive-file-list-end)
-        (or (= (following-char) ? )
-            (progn (delete-char 1) (insert ? )))
-        (forward-line 1)))
-    (set-buffer-modified-p modified)))
-
-(defun archive-mark (p)
-  "In archive mode, mark this member for group operations.
-With a prefix argument, mark that many members.
-Use \\[archive-unmark-all-files] to remove all marks."
-  (interactive "p")
-  (archive-flag-deleted p ?*))
-
-(defun archive-get-marked (mark &optional default)
-  (let (files)
-    (save-excursion
-      (goto-char archive-file-list-start)
-      (while (< (point) archive-file-list-end)
-        (if (= (following-char) mark)
-	    (setq files (cons (archive-get-descr) files)))
-        (forward-line 1)))
-    (or (nreverse files)
-	(and default
-	     (list (archive-get-descr))))))
-;; -------------------------------------------------------------------------
-;; Section: Operate
-
-(defun archive-next-line (p)
-  (interactive "p")
-  (forward-line p)
-  (or (eobp)
-      (forward-char archive-file-name-indent)))
-
-(defun archive-previous-line (p)
-  (interactive "p")
-  (archive-next-line (- p)))
-
-(defun archive-chmod-entry (new-mode)
-  "Change the protection bits associated with all marked or this member.
-The new protection bits can either be specified as an octal number or
-as a relative change like \"g+rw\" as for chmod(2)"
-  (interactive "sNew mode (octal or relative): ")
-  (if archive-read-only (error "Archive is read-only"))
-  (let ((func (archive-name "chmod-entry")))
-    (if (fboundp func)
-	(progn
-	  (funcall func new-mode (archive-get-marked ?* t))
-	  (archive-resummarize))
-      (error "Setting mode bits is not supported for this archive type"))))
-
-(defun archive-chown-entry (new-uid)
-  "Change the owner of all marked or this member."
-  (interactive "nNew uid: ")
-  (if archive-read-only (error "Archive is read-only"))
-  (let ((func (archive-name "chown-entry")))
-    (if (fboundp func)
-	(progn
-	  (funcall func new-uid (archive-get-marked ?* t))
-	  (archive-resummarize))
-      (error "Setting owner is not supported for this archive type"))))
-
-(defun archive-chgrp-entry (new-gid)
-  "Change the group of all marked or this member."
-  (interactive "nNew gid: ")
-  (if archive-read-only (error "Archive is read-only"))
-  (let ((func (archive-name "chgrp-entry")))
-    (if (fboundp func)
-	(progn
-	  (funcall func new-gid (archive-get-marked ?* t))
-	  (archive-resummarize))
-      (error "Setting group is not supported for this archive type"))))
-
-(defun archive-expunge ()
-  "Do the flagged deletions."
-  (interactive)
-  (let (files)
-    (save-excursion
-      (goto-char archive-file-list-start)
-      (while (< (point) archive-file-list-end)
-        (if (= (following-char) ?D)
-	    (setq files (cons (aref (archive-get-descr) 0) files)))
-        (forward-line 1)))
-    (setq files (nreverse files))
-    (and files
-	 (or (not archive-read-only)
-	     (error "Archive is read-only"))
-	 (or (yes-or-no-p (format "Really delete %d member%s? "
-				  (length files)
-				  (if (null (cdr files)) "" "s")))
-	     (error "Operation aborted"))
-	 (let ((archive (archive-maybe-copy (buffer-file-name)))
-	       (expunger (archive-name "expunge")))
-	   (if (fboundp expunger)
-	       (funcall expunger archive files)
-	     (archive-*-expunge archive files (symbol-value expunger)))
-	   (archive-maybe-update nil)
-	   (if archive-remote
-	       (archive-resummarize)
-	     (revert-buffer))))))
-
-(defun archive-*-expunge (archive files command)
-  (apply 'call-process
-	 (car command)
-	 nil
-	 nil
-	 nil
-	 (append (cdr command) (cons archive files))))
-
-(defun archive-rename-entry (newname)
-  "Change the name associated with this entry in the tar file."
-  (interactive "sNew name: ")
-  (if archive-read-only (error "Archive is read-only"))
-  (if (string= newname "")
-      (error "Archive members may not be given empty names"))
-  (let ((func (archive-name "rename-entry"))
-	(descr (archive-get-descr)))
-    (if (fboundp func)
-        (progn
-	  (funcall func (buffer-file-name) newname descr)
-	  (archive-resummarize))
-      (error "Renaming is not supported for this archive type"))))
-
-(defun archive-mode-revert (&optional no-autosave no-confirm)
-  "Revert the buffer and recompute the dired-like listing."
-  (let ((no (archive-get-lineno)))
-    (setq archive-files nil)
-    (let ((revert-buffer-function nil))
-      (revert-buffer t t))
-    (archive-mode)
-    (goto-char archive-file-list-start)
-    (archive-next-line no)))
-
-(defun archive-undo ()
-  "Undo in an archive buffer.
-This doesn't recover lost files, it just undoes changes in the buffer itself."
-  (interactive)
-  (let (buffer-read-only)
-    (undo)))
-;; -------------------------------------------------------------------------
-;; Section: Arc Archives
-
-(defun archive-arc-summarize ()
-  (let ((p 1)
-	(totalsize 0)
-	(maxlen 8)
-        files
-	visual)
-    (while (and (< (+ p 29) (point-max))
-		(eq (char-after p) ?\C-z)
-		(> (char-after (1+ p)) 0))
-      (let* ((namefld (buffer-substring (+ p 2) (+ p 2 13)))
-	     (fnlen   (or (string-match "\0" namefld) 13))
-	     (efnname (substring namefld 0 fnlen))
-             (csize   (archive-l-e (+ p 15) 4))
-             (moddate (archive-l-e (+ p 19) 2))
-             (modtime (archive-l-e (+ p 21) 2))
-             (ucsize  (archive-l-e (+ p 25) 4))
-	     (fiddle  (string= efnname (upcase efnname)))
-             (ifnname (if fiddle (downcase efnname) efnname))
-             (text    (format "  %8d  %-11s  %-8s  %s"
-                              ucsize
-                              (archive-dosdate moddate)
-                              (archive-dostime modtime)
-                              ifnname)))
-        (setq maxlen (max maxlen fnlen)
-	      totalsize (+ totalsize ucsize)
-	      visual (cons (vector text
-				   (- (length text) (length ifnname))
-				   (length text))
-			   visual)
-	      files (cons (vector efnname ifnname fiddle nil (1- p))
-                          files)
-              p (+ p 29 csize))))
-    (goto-char (point-min))
-    (let ((dash (concat "- --------  -----------  --------  "
-			(make-string maxlen ?-)
-			"\n")))
-      (insert "M   Length  Date         Time      File\n"
-	      dash)
-      (archive-summarize-files (nreverse visual))
-      (insert dash
-	      (format "  %8d                         %d file%s"
-		      totalsize
-		      (length files)
-		      (if (= 1 (length files)) "" "s"))
-	      "\n"))
-    (apply 'vector (nreverse files))))
-
-(defun archive-arc-rename-entry (archive newname descr)
-  (if (string-match "[:\\\\/]" newname)
-      (error "File names in arc files may not contain a path"))
-  (if (> (length newname) 12)
-      (error "File names in arc files are limited to 12 characters"))
-  (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0"
-					 (length newname))))
-	buffer-read-only)
-    (save-restriction
-      (save-excursion
-	(widen)
-	(goto-char (+ archive-proper-file-start (aref descr 4) 2))
-	(delete-char 13)
-	(insert name)))))
-;; -------------------------------------------------------------------------
-;; Section: Lzh Archives
-
-(defun archive-lzh-summarize ()
-  (let ((p 1)
-	(totalsize 0)
-	(maxlen 8)
-        files
-	visual)
-    (while (progn (goto-char p) (looking-at "..-l[hz][0-9]-"))
-      (let* ((hsize   (char-after p))
-             (csize   (archive-l-e (+ p 7) 4))
-             (ucsize  (archive-l-e (+ p 11) 4))
-	     (modtime (archive-l-e (+ p 15) 2))
-	     (moddate (archive-l-e (+ p 17) 2))
-	     (fnlen   (char-after (+ p 21)))
-	     (efnname (buffer-substring (+ p 22) (+ p 22 fnlen)))
-	     (fiddle  (string= efnname (upcase efnname)))
-             (ifnname (if fiddle (downcase efnname) efnname))
-	     (p2      (+ p 22 fnlen))
-	     (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
-	     (mode    (if (eq creator ?U) (archive-l-e (+ p2 8) 2) #o666))
-	     (modestr (if mode (archive-int-to-mode mode) "??????????"))
-	     (uid     (if (eq creator ?U) (archive-l-e (+ p2 10) 2)))
-	     (gid     (if (eq creator ?U) (archive-l-e (+ p2 12) 2)))
-	     (text    (if archive-alternate-display
-			  (format "  %8d  %5S  %5S  %s"
-				  ucsize
-				  (or uid "?")
-				  (or gid "?")
-				  ifnname)
-			(format "  %10s  %8d  %-11s  %-8s  %s"
-				modestr
-				ucsize
-				(archive-dosdate moddate)
-				(archive-dostime modtime)
-				ifnname))))
-        (setq maxlen (max maxlen fnlen)
-	      totalsize (+ totalsize ucsize)
-	      visual (cons (vector text
-				   (- (length text) (length ifnname))
-				   (length text))
-			   visual)
-	      files (cons (vector efnname ifnname fiddle mode (1- p))
-                          files)
-              p (+ p hsize 2 csize))))
-    (goto-char (point-min))
-    (let ((dash (concat (if archive-alternate-display
-			    "- --------  -----  -----  "
-			  "- ----------  --------  -----------  --------  ")
-			(make-string maxlen ?-)
-			"\n"))
-	  (header (if archive-alternate-display
-		       "M   Length    Uid    Gid  File\n"
-		    "M   Filemode    Length  Date         Time      File\n"))
-	  (sumline (if archive-alternate-display
-		       "  %8d                %d file%s"
-		     "              %8d                         %d file%s")))
-      (insert header dash)
-      (archive-summarize-files (nreverse visual))
-      (insert dash
-	      (format sumline
-		      totalsize
-		      (length files)
-		      (if (= 1 (length files)) "" "s"))
-	      "\n"))
-    (apply 'vector (nreverse files))))
-
-(defconst archive-lzh-alternate-display t)
-
-(defun archive-lzh-extract (archive name)
-  (archive-extract-by-stdout archive name archive-lzh-extract))
-
-(defun archive-lzh-resum (p count)
-  (let ((sum 0))
-    (while (> count 0)
-      (setq count (1- count)
-	    sum (+ sum (char-after p))
-	    p (1+ p)))
-    (logand sum 255)))
-
-(defun archive-lzh-rename-entry (archive newname descr)
-  (save-restriction
-    (save-excursion
-      (widen)
-      (let* ((p        (+ archive-proper-file-start (aref descr 4)))
-	     (oldhsize (char-after p))
-	     (oldfnlen (char-after (+ p 21)))
-	     (newfnlen (length newname))
-	     (newhsize (+ oldhsize newfnlen (- oldfnlen)))
-	     buffer-read-only)
-	(if (> newhsize 255)
-	    (error "The file name is too long"))
-	(goto-char (+ p 21))
-	(delete-char (1+ oldfnlen))
-	(insert newfnlen newname)
-	(goto-char p)
-	(delete-char 2)
-	(insert newhsize (archive-lzh-resum p newhsize))))))
-
-(defun archive-lzh-ogm (newval files errtxt ofs)
-  (save-restriction
-    (save-excursion
-      (widen)
-      (while files
-	(let* ((fil (car files))
-	       (p (+ archive-proper-file-start (aref fil 4)))
-	       (hsize   (char-after p))
-	       (fnlen   (char-after (+ p 21)))
-	       (p2      (+ p 22 fnlen))
-	       (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
-	       buffer-read-only)
-	  (if (= creator ?U)
-	      (progn
-		(or (numberp newval)
-		    (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2))))
-		(goto-char (+ p2 ofs))
-		(delete-char 2)
-		(insert (logand newval 255) (lsh newval -8))
-		(goto-char (1+ p))
-		(delete-char 1)
-		(insert (archive-lzh-resum (1+ p) hsize)))
-	    (message "Member %s does not have %s field"
-		     (aref fil 1) errtxt)))
-	(setq files (cdr files))))))
-
-(defun archive-lzh-chown-entry (newuid files)
-  (archive-lzh-ogm newuid files "an uid" 10))
-
-(defun archive-lzh-chgrp-entry (newgid files)
-  (archive-lzh-ogm newgid files "a gid" 12))
-
-(defun archive-lzh-chmod-entry (newmode files)
-  (archive-lzh-ogm
-   ;; This should work even though newmode will be dynamically accessed.
-   (function (lambda (old) (archive-calc-mode old newmode t)))
-   files "a unix-style mode" 8))
-;; -------------------------------------------------------------------------
-;; Section: Zip Archives
-
-(defun archive-zip-summarize ()
-  (goto-char (- (point-max) (- 22 18)))
-  (search-backward-regexp "[P]K\005\006")
-  (let ((p (1+ (archive-l-e (+ (point) 16) 4)))
-        (maxlen 8)
-	(totalsize 0)
-        files
-	visual)
-    (while (string= "PK\001\002" (buffer-substring p (+ p 4)))
-      (let* ((creator (char-after (+ p 5)))
-	     (method  (archive-l-e (+ p 10) 2))
-             (modtime (archive-l-e (+ p 12) 2))
-             (moddate (archive-l-e (+ p 14) 2))
-             (ucsize  (archive-l-e (+ p 24) 4))
-             (fnlen   (archive-l-e (+ p 28) 2))
-             (exlen   (archive-l-e (+ p 30) 2))
-             (fclen   (archive-l-e (+ p 32) 2))
-             (lheader (archive-l-e (+ p 42) 4))
-             (efnname (buffer-substring (+ p 46) (+ p 46 fnlen)))
-	     (isdir   (and (= ucsize 0)
-			   (string= (file-name-nondirectory efnname) "")))
-	     (mode    (cond ((memq (char-int creator) '(2 3)) ; Unix + VMS
-			     (archive-l-e (+ p 40) 2))
-			    ((memq (char-int creator)
-				   '(0 5 6 7 10 11)) ; Dos etc.
-			     (logior #o444
-				     (if isdir (logior 16384 #o111) 0)
-				     (if (zerop
-					  (logand 1 (char-after (+ p 38))))
-					 #o222 0)))
-			    (t nil)))
-	     (modestr (if mode (archive-int-to-mode mode) "??????????"))
-	     (fiddle  (and archive-zip-case-fiddle
-			   (not (not (memq (char-int creator) '(0 2 4 5 9))))))
-             (ifnname (if fiddle (downcase efnname) efnname))
-             (text    (format "  %10s  %8d  %-11s  %-8s  %s"
-			      modestr
-                              ucsize
-                              (archive-dosdate moddate)
-                              (archive-dostime modtime)
-                              ifnname)))
-        (setq maxlen (max maxlen fnlen)
-	      totalsize (+ totalsize ucsize)
-	      visual (cons (vector text
-				   (- (length text) (length ifnname))
-				   (length text))
-			   visual)
-	      files (cons (if isdir
-			      nil
-			    (vector efnname ifnname fiddle mode
-				    (list (1- p) lheader)))
-                          files)
-              p (+ p 46 fnlen exlen fclen))))
-    (goto-char (point-min))
-    (let ((dash (concat "- ----------  --------  -----------  --------  "
-			(make-string maxlen ?-)
-			"\n")))
-      (insert "M Filemode      Length  Date         Time      File\n"
-	      dash)
-      (archive-summarize-files (nreverse visual))
-      (insert dash
-	      (format "              %8d                         %d file%s"
-		      totalsize
-		      (length files)
-		      (if (= 1 (length files)) "" "s"))
-	      "\n"))
-    (apply 'vector (nreverse files))))
-
-(defun archive-zip-extract (archive name)
-  (if archive-zip-use-pkzip
-      (archive-*-extract archive name archive-zip-extract)
-    (archive-extract-by-stdout archive name archive-zip-extract)))
-
-(defun archive-zip-write-file-member (archive descr)
-  (archive-*-write-file-member
-   archive
-   descr
-   (if (aref descr 2) archive-zip-update-case archive-zip-update)))
-
-(defun archive-zip-chmod-entry (newmode files)
-  (save-restriction
-    (save-excursion
-      (widen)
-      (while files
-	(let* ((fil (car files))
-	       (p (+ archive-proper-file-start (car (aref fil 4))))
-	       (creator (char-after (+ p 5)))
-	       (oldmode (aref fil 3))
-	       (newval  (archive-calc-mode oldmode newmode t))
-	       buffer-read-only)
-	  (cond ((memq (char-int creator) '(2 3)) ; Unix + VMS
-		 (goto-char (+ p 40))
-		 (delete-char 2)
-		 (insert (logand newval 255) (lsh newval -8)))
-		((memq (char-int creator) '(0 5 6 7 10 11)) ; Dos etc.
-		 (goto-char (+ p 38))
-		 (insert (logior (logand (char-after (point)) 254)
-				 (logand (logxor 1 (lsh newval -7)) 1)))
-		 (delete-char 1))
-		(t (message "Don't know how to change mode for this member"))))
-	(setq files (cdr files))))))
-;; -------------------------------------------------------------------------
-;; Section: Zoo Archives
-
-(defun archive-zoo-summarize ()
-  (let ((p (1+ (archive-l-e 25 4)))
-        (maxlen 8)
-	(totalsize 0)
-        files
-	visual)
-    (while (and (string= "\334\247\304\375" (buffer-substring p (+ p 4)))
-		(> (archive-l-e (+ p 6) 4) 0))
-      (let* ((next    (1+ (archive-l-e (+ p 6) 4)))
-             (moddate (archive-l-e (+ p 14) 2))
-             (modtime (archive-l-e (+ p 16) 2))
-             (ucsize  (archive-l-e (+ p 20) 4))
-	     (namefld (buffer-substring (+ p 38) (+ p 38 13)))
-	     (dirtype (char-after (+ p 4)))
-	     (lfnlen  (if (= dirtype 2) (char-after (+ p 56)) 0))
-	     (ldirlen (if (= dirtype 2) (char-after (+ p 57)) 0))
-	     (fnlen   (+ ldirlen
-			 (if (> lfnlen 0)
-			     (1- lfnlen)
-			   (or (string-match "\0" namefld) 13))))
-	     (efnname (concat
-		       (if (> ldirlen 0)
-			   (concat (buffer-substring
-				    (+ p 58 lfnlen) (+ p 58 lfnlen ldirlen -1))
-				   "/")
-			 "")
-		       (if (> lfnlen 0)
-			   (buffer-substring (+ p 58) (+ p 58 lfnlen -1))
-			 (substring namefld 0 fnlen))))
-	     (fiddle  (and (= lfnlen 0) (string= efnname (upcase efnname))))
-             (ifnname (if fiddle (downcase efnname) efnname))
-             (text    (format "  %8d  %-11s  %-8s  %s"
-                              ucsize
-                              (archive-dosdate moddate)
-                              (archive-dostime modtime)
-                              ifnname)))
-        (setq maxlen (max maxlen fnlen)
-	      totalsize (+ totalsize ucsize)
-	      visual (cons (vector text
-				   (- (length text) (length ifnname))
-				   (length text))
-			   visual)
-	      files (cons (vector efnname ifnname fiddle nil (1- p))
-                          files)
-              p next)))
-    (goto-char (point-min))
-    (let ((dash (concat "- --------  -----------  --------  "
-			(make-string maxlen ?-)
-			"\n")))
-      (insert "M   Length  Date         Time      File\n"
-	      dash)
-      (archive-summarize-files (nreverse visual))
-      (insert dash
-	      (format "  %8d                         %d file%s"
-		      totalsize
-		      (length files)
-		      (if (= 1 (length files)) "" "s"))
-	      "\n"))
-    (apply 'vector (nreverse files))))
-
-(defun archive-zoo-extract (archive name)
-  (archive-extract-by-stdout archive name archive-zoo-extract))
-;; -------------------------------------------------------------------------
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\(?:arc\\|[ejw]ar\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode))
-
-(provide 'archive-mode)
-
-;;; arc-mode.el ends here.
diff --git a/xemacs-packages/lisp/os-utils/auto-autoloads.el b/xemacs-packages/lisp/os-utils/auto-autoloads.el
deleted file mode 100644
index 5136441d..00000000
--- a/xemacs-packages/lisp/os-utils/auto-autoloads.el
+++ /dev/null
@@ -1,400 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'os-utils-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "os-utils/_pkg.el")
-
-(package-provide 'os-utils :version 1.37 :author-version "No-Upstream-Ver" :type 'single-file)
-
-;;;***
-
-;;;### (autoloads (archive-mode) "arc-mode" "os-utils/arc-mode.el")
-
-(autoload 'archive-mode "arc-mode" "\
-Major mode for viewing an archive file in a dired-like way.
-You can move around using the usual cursor motion commands.
-Letters no longer insert themselves.
-Type `e' to pull a file out of the archive and into its own buffer;
-or click mouse-2 on the file's line in the archive mode buffer.
-
-If you edit a sub-file of this archive (as with the `e' command) and
-save it, the contents of that buffer will be saved back into the
-archive.
-
-\\{archive-mode-map}" nil nil)
-(add-to-list 'auto-mode-alist '("\\.\\(?:arc\\|[ejw]ar\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode))
-
-;;;***
-
-;;;### (autoloads (background) "background" "os-utils/background.el")
-
-(autoload 'background "background" "\
-Run COMMAND in the background like csh.  
-A message is displayed when the job starts and finishes.  The buffer is in
-comint mode, so you can send input and signals to the job.  The process object
-is returned if anyone cares.  See also comint-mode and the variables
-background-show and background-select.
-
-Optional second argument BUFFER-NAME is a buffer to insert the output into.
-If omitted, a buffer name is constructed from the command run." t nil)
-
-;;;***
-
-;;;### (autoloads (ftelnet) "ftelnet" "os-utils/ftelnet.el")
-(add-hook 'same-window-regexps "^\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
-
-(autoload 'ftelnet "ftelnet" "\
-Open a network login connection to HOST via the `telnet' program.
-Input is sent line-at-a-time to the remote connection.
-
-Communication with the remote host is recorded in a buffer *telnet-HOST*
-\(or *telnet-HOST:PORT* if using a nonstandard port number).
-If a prefix argument is given and the buffer *telnet-HOST* already exists,
-a new buffer with a different connection will be made.
-
-When called from a program, if the optional second argument is a string or
-buffer, it names the buffer to use.
-
-The variable `ftelnet-program' contains the name of the actual program to
-run.  It can be a relative or absolute path.
-
-The variable `ftelnet-explicit-args' is a list of arguments to give to the
-telnet program when starting.  They are added after any arguments given in
-INPUT-ARGS.
-
-If the default value of `ftelnet-directory-tracking-mode' is t, then the
-default directory in that buffer is set to a remote (FTP) file name to
-access your home directory on the remote machine.  Occasionally this causes
-an error, if you cannot access the home directory on that machine.  This
-error is harmless as long as you don't try to use that default directory.
-
-If `ftelnet-directory-tracking-mode' is neither t nor nil, then the default
-directory is initially set up to your (local) home directory.
-This is useful if the remote machine and your local machine
-share the same files via NFS.  This is the default.
-
-If you wish to change directory tracking styles during a session, use the
-function `ftelnet-directory-tracking-mode' rather than simply setting the
-variable." t nil)
-
-;;;***
-
-;;;### (autoloads (inferior-lisp) "inf-lisp" "os-utils/inf-lisp.el")
-
-(defvar inferior-lisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" "\
-*What not to save on inferior Lisp's input history.
-Input matching this regexp is not saved on the input history in Inferior Lisp
-mode.  Default is whitespace followed by 0 or 1 single-letter colon-keyword 
-\(as in :a, :c, etc.)")
-
-(defvar inferior-lisp-program "lisp" "\
-*Program name for invoking an inferior Lisp with for Inferior Lisp mode.")
-
-(defvar inferior-lisp-load-command "(load \"%s\")\n" "\
-*Format-string for building a Lisp expression to load a file.
-This format string should use `%s' to substitute a file name
-and should result in a Lisp expression that will command the inferior Lisp
-to load that file.  The default works acceptably on most Lisps.
-The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\"
-produces cosmetically superior output for this application,
-but it works only in Common Lisp.")
-
-(defvar inferior-lisp-prompt "^[^> \n]*>+:? *" "\
-Regexp to recognise prompts in the Inferior Lisp mode.
-Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl,
-and franz.  This variable is used to initialize `comint-prompt-regexp' in the 
-Inferior Lisp buffer.
-
-More precise choices:
-Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
-franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
-kcl: \"^>+ *\"
-
-This is a fine thing to set in your .emacs file.")
-
-(defvar inferior-lisp-mode-hook 'nil "\
-*Hook for customizing Inferior Lisp mode.")
-
-(autoload 'inferior-lisp "inf-lisp" "\
-Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
-If there is a process already running in `*inferior-lisp*', just switch
-to that buffer.
-With argument, allows you to edit the command line (default is value
-of `inferior-lisp-program').  Runs the hooks from
-`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
-\(Type \\[describe-mode] in the process buffer for a list of commands.)" t nil)
-(add-hook 'same-window-buffer-names "*inferior-lisp*")
-
-(define-function 'run-lisp 'inferior-lisp)
-
-;;;***
-
-;;;### (autoloads (jka-compr-install toggle-auto-compression jka-compr-load) "jka-compr" "os-utils/jka-compr.el")
-
-(autoload 'jka-compr-load "jka-compr" "\
-Documented as original." nil nil)
-(defun auto-compression-mode (&optional arg)
-"\
-Toggle automatic file compression and uncompression.
-With prefix argument ARG, turn auto compression on if positive, else off.
-Returns the new status of auto compression (non-nil means on)."
-(interactive "P")
-(if (not (fboundp 'jka-compr-installed-p))
-(require 'jka-compr))
-(toggle-auto-compression arg t))
-
-(autoload 'toggle-auto-compression "jka-compr" "\
-Toggle automatic file compression and uncompression.
-With prefix argument ARG, turn auto compression on if positive, else off.
-Returns the new status of auto compression (non-nil means on).
-If the argument MESSAGE is non-nil, it means to print a message
-saying whether the mode is now on or off." t nil)
-
-(autoload 'jka-compr-install "jka-compr" "\
-Install jka-compr.
-This adds entries to `file-name-handler-alist' and `auto-mode-alist'
-and `inhibit-first-line-modes-suffixes'." nil nil)
-
-;;;***
-
-;;;### (autoloads (ledit-from-lisp-mode ledit-mode) "ledit" "os-utils/ledit.el")
-
-(defconst ledit-save-files t "\
-*Non-nil means Ledit should save files before transferring to Lisp.")
-
-(defconst ledit-go-to-lisp-string "%?lisp" "\
-*Shell commands to execute to resume Lisp job.")
-
-(defconst ledit-go-to-liszt-string "%?liszt" "\
-*Shell commands to execute to resume Lisp compiler job.")
-
-(autoload 'ledit-mode "ledit" "\
-\\Major mode for editing text and stuffing it to a Lisp job.
-Like Lisp mode, plus these special commands:
-  \\[ledit-save-defun]	-- record defun at or after point
-	   for later transmission to Lisp job.
-  \\[ledit-save-region] -- record region for later transmission to Lisp job.
-  \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
-  \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
-	   and transmit saved text.
-\\{ledit-mode-map}
-To make Lisp mode automatically change to Ledit mode,
-do (setq lisp-mode-hook 'ledit-from-lisp-mode)" t nil)
-
-(autoload 'ledit-from-lisp-mode "ledit" nil nil nil)
-
-;;;***
-
-;;;### (autoloads (mchat-other-frame mchat) "mchat" "os-utils/mchat.el")
-
-(autoload 'mchat "mchat" "\
-Join MChat multicast group NAME at address ADDRESS. When called
-interactively, you will be prompted for the group name, and if the group is
-not registered, for the corresponding multicast address. Please refer to
-`mchat-predefined-groups' for a list of known groups, and
-`open-multicast-group' for the syntax of ADDRESS." t nil)
-
-(autoload 'mchat-other-frame "mchat" "\
-Like `mchat', but pop up a new frame." t nil)
-
-;;;***
-
-;;;### (autoloads (rlogin) "rlogin" "os-utils/rlogin.el")
-(add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)")
-
-(autoload 'rlogin "rlogin" "\
-Open a network login connection via `rlogin' with args INPUT-ARGS.
-INPUT-ARGS should start with a host name; it may also contain
-other arguments for `rlogin'.
-
-Input is sent line-at-a-time to the remote connection.
-
-Communication with the remote host is recorded in a buffer `*rlogin-HOST*'
-\(or `*rlogin-USER@HOST*' if the remote username differs).
-If a prefix argument is given and the buffer `*rlogin-HOST*' already exists,
-a new buffer with a different connection will be made.
-
-When called from a program, if the optional second argument BUFFER is
-a string or buffer, it specifies the buffer to use.
-
-The variable `rlogin-program' contains the name of the actual program to
-run.  It can be a relative or absolute path.
-
-The variable `rlogin-explicit-args' is a list of arguments to give to
-the rlogin when starting.  They are added after any arguments given in
-INPUT-ARGS.
-
-If the default value of `rlogin-directory-tracking-mode' is t, then the
-default directory in that buffer is set to a remote (FTP) file name to
-access your home directory on the remote machine.  Occasionally this causes
-an error, if you cannot access the home directory on that machine.  This
-error is harmless as long as you don't try to use that default directory.
-
-If `rlogin-directory-tracking-mode' is neither t nor nil, then the default
-directory is initially set up to your (local) home directory.
-This is useful if the remote machine and your local machine
-share the same files via NFS.  This is the default.
-
-If you wish to change directory tracking styles during a session, use the
-function `rlogin-directory-tracking-mode' rather than simply setting the
-variable." t nil)
-
-;;;***
-
-;;;### (autoloads (spell-string spell-region spell-word spell-buffer) "spell" "os-utils/spell.el")
-
-(put 'spell-filter 'risky-local-variable t)
-
-(autoload 'spell-buffer "spell" "\
-Check spelling of every word in the buffer.
-For each incorrect word, you are asked for the correct spelling
-and then put into a query-replace to fix some or all occurrences.
-If you do not want to change a word, just give the same word
-as its \"correct\" spelling; then the query replace is skipped." t nil)
-
-(autoload 'spell-word "spell" "\
-Check spelling of word at or before point.
-If it is not correct, ask user for the correct spelling
-and `query-replace' the entire buffer to substitute it." t nil)
-
-(autoload 'spell-region "spell" "\
-Like `spell-buffer' but applies only to region.
-Used in a program, applies from START to END.
-DESCRIPTION is an optional string naming the unit being checked:
-for example, \"word\"." t nil)
-
-(autoload 'spell-string "spell" "\
-Check spelling of string supplied as argument." t nil)
-
-;;;***
-
-;;;### (autoloads (ssh) "ssh" "os-utils/ssh.el")
-(add-hook 'same-window-regexps "^\\*ssh-.*\\*\\(\\|<[0-9]+>\\)")
-
-(autoload 'ssh "ssh" "\
-Open a network login connection via `ssh' with args INPUT-ARGS.
-INPUT-ARGS should start with a host name; it may also contain
-other arguments for `ssh'.
-
-Input is sent line-at-a-time to the remote connection.
-
-Communication with the remote host is recorded in a buffer `*ssh-HOST*'
-\(or `*ssh-USER@HOST*' if the remote username differs).
-If a prefix argument is given and the buffer `*ssh-HOST*' already exists,
-a new buffer with a different connection will be made.
-
-When called from a program, if the optional second argument BUFFER is
-a string or buffer, it specifies the buffer to use.
-
-The variable `ssh-program' contains the name of the actual program to
-run.  It can be a relative or absolute path.
-
-The variable `ssh-explicit-args' is a list of arguments to give to
-the ssh when starting.  They are prepended to any arguments given in
-INPUT-ARGS.
-
-If the default value of `ssh-directory-tracking-mode' is t, then the
-default directory in that buffer is set to a remote (FTP) file name to
-access your home directory on the remote machine.  Occasionally this causes
-an error, if you cannot access the home directory on that machine.  This
-error is harmless as long as you don't try to use that default directory.
-
-If `ssh-directory-tracking-mode' is neither t nor nil, then the default
-directory is initially set up to your (local) home directory.
-This is useful if the remote machine and your local machine
-share the same files via NFS.  This is the default.
-
-If you wish to change directory tracking styles during a session, use the
-function `ssh-directory-tracking-mode' rather than simply setting the
-variable." t nil)
-
-;;;***
-
-;;;### (autoloads (tar-mode) "tar-mode" "os-utils/tar-mode.el")
-
-(autoload 'tar-mode "tar-mode" "\
-Major mode for viewing a tar file as a dired-like listing of its contents.
-You can move around using the usual cursor motion commands. 
-Letters no longer insert themselves.
-Type `e' to pull a file out of the tar file and into its own buffer;
-or click mouse-2 on the file's line in the Tar mode buffer.
-Type `c' to copy an entry from the tar file into another file on disk.
-
-If you edit a sub-file of this archive (as with the `e' command) and 
-save it with Control-x Control-s, the contents of that buffer will be 
-saved back into the tar-file buffer; in this way you can edit a file 
-inside of a tar archive without extracting it and re-archiving it.
-
-See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
-\\{tar-mode-map}" nil nil)
-
-(defvar tar-regexp "\\.tar$" "\
-The regular expression used to identify tar file names.
-Note that this regular expression must not match compressed tar file
-names; if it does, tar-mode will attempt to parse the compressed tar
-file as an uncompressed tar file, which will generate an error.  This
-is not a problem, as other modules that handle compression will
-uncompress the buffer and call `tar-mode' appropriately.")
-
-(setq auto-mode-alist (cons (cons tar-regexp 'tar-mode) auto-mode-alist))
-
-;;;***
-
-;;;### (autoloads (rsh telnet) "telnet" "os-utils/telnet.el")
-(add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
-
-(autoload 'telnet "telnet" "\
-Open a network login connection to host named HOST (a string).
-With a prefix argument, prompts for the port name or number as well.
-Communication with HOST is recorded in a buffer `*PROGRAM-HOST*'
-where PROGRAM is the telnet program being used.  This program
-is controlled by the contents of the global variable `telnet-host-properties',
-falling back on the value of the global variable `telnet-program'.
-Normally input is edited in Emacs and sent a line at a time.
-See also `\\[rsh]'." t nil)
-(add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")
-
-(autoload 'rsh "telnet" "\
-Open a network login connection to host named HOST (a string).
-Communication with HOST is recorded in a buffer `*rsh-HOST*'.
-Normally input is edited in Emacs and sent a line at a time.
-See also `\\[telnet]'." t nil)
-
-;;;***
-
-;;;### (autoloads (terminal-emulator) "terminal" "os-utils/terminal.el")
-
-(autoload 'terminal-emulator "terminal" "\
-Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS.
-ARGS is a list of argument-strings.  Remaining arguments are WIDTH and HEIGHT.
-BUFFER's contents are made an image of the display generated by that program,
-and any input typed when BUFFER is the current Emacs buffer is sent to that
-program an keyboard input.
-
-Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS
-are parsed from an input-string using your usual shell.
-WIDTH and HEIGHT are determined from the size of the current window
--- WIDTH will be one less than the window's width, HEIGHT will be its height.
-
-To switch buffers and leave the emulator, or to give commands
-to the emulator itself (as opposed to the program running under it),
-type Control-^.  The following character is an emulator command.
-Type Control-^ twice to send it to the subprogram.
-This escape character may be changed using the variable `terminal-escape-char'.
-
-`Meta' characters may not currently be sent through the terminal emulator.
-
-Here is a list of some of the variables which control the behaviour
-of the emulator -- see their documentation for more information:
-terminal-escape-char, terminal-scrolling, terminal-more-processing,
-terminal-redisplay-interval.
-
-This function calls the value of terminal-mode-hook if that exists
-and is non-nil after the terminal buffer has been set up and the
-subprocess started.
-
-Presently with `termcap' only; if somebody sends us code to make this
-work with `terminfo' we will try to use it." t nil)
-
-;;;***
-
-(provide 'os-utils-autoloads)
diff --git a/xemacs-packages/lisp/os-utils/background.el b/xemacs-packages/lisp/os-utils/background.el
deleted file mode 100644
index 9ed0ba1d..00000000
--- a/xemacs-packages/lisp/os-utils/background.el
+++ /dev/null
@@ -1,184 +0,0 @@
-;;; background.el --- fun with background jobs
-
-;; Copyright (C) 1988 Joe Keane 
-;; Keywords: processes
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; - Adapted to use comint and cleaned up somewhat. Olin Shivers 5/90
-;; - Background failed to set the process buffer's working directory
-;;   in some cases. Fixed. Olin 6/14/90
-;; - Background failed to strip leading cd's off the command string
-;;   after performing them. This screwed up relative pathnames.
-;;   Furthermore, the proc buffer's default dir wasn't initialised 
-;;   to the user's buffer's default dir before doing the leading cd.
-;;   This also screwed up relative pathnames if the proc buffer already
-;;   existed and was set to a different default dir. Hopefully we've
-;;   finally got it right. The pwd is now reported in the buffer
-;;   just to let the user know. Bug reported by Piet Van Oostrum.
-;;   Olin 10/19/90
-;; - Fixed up the sentinel to protect match-data around invocations.
-;;   Also slightly rearranged the cd match code for similar reasons.
-;;   Olin 7/16/91
-;; - Dec 29 1995: changed for new stuff (shell-command-switch, second
-;;   arg to shell-command --> BUFFER-NAME arg to background) from
-;;   FSF 19.30.  Ben Wing
-
-;;; Code:
-
-(provide 'background)
-(require 'comint)
-
-(defgroup background nil
-  "Fun with background jobs"
-  :group 'processes)
-
-
-;; user variables
-(defcustom background-show t
-  "*If non-nil, background jobs' buffers are shown when they're started."
-  :type 'boolean
-  :group 'background)
-(defcustom background-select nil
-  "*If non-nil, background jobs' buffers are selected when they're started."
-  :type 'boolean
-  :group 'background)
-
-(defcustom background-get-job-name 'background-get-job-name-simple
-  "Function to use to generate the job name (and therefore the buffer name
-of processes run in the background."
-  :type '(choice
-           (function-item :tag "Simple Numbered"
-                          :value background-get-job-name-simple)
-           (function-item :tag "Command based"
-                          :value background-get-job-name-command)
-           (function-item :tag "Command and Directory based"
-                          :value background-get-job-name-command-n-dir)
-           )
-  :group 'background)
-
-
-(defun background-search-job-space (form)
-  (let ((job-number 1))
-    (while (get-process (format form job-number))
-      (setq job-number (1+ job-number)))
-    job-number))
-  
-(defun background-get-job-name-simple (command dir)
-  (let* ((form "background-%d")
-         (job-num (background-search-job-space form)))
-    (format form job-num)))
-
-(defun format-quote-string (str)
-  (replace-in-string str "%" "%%"))
-
-(defun get-bottom-dir (str)
-  (let* ((dasplit (split-string str "\/"))
-         (dalen (length dasplit)))
-    (if (= dalen 2)
-        (elt dasplit (- dalen 1))
-      (if (= (length (elt dasplit (- dalen 1))) 0)
-          (elt dasplit (- dalen 2))
-        (elt dasplit (- dalen 1))))))
-
-(defun background-get-job-name-command (command dir)
-  (let* ((form (concat (format "BG(%s" (format-quote-string command)) ")%d"))
-         (job-num (background-search-job-space form)))
-    (format form job-num)))
-
-(defun background-get-job-name-command-n-dir (command dir)
-  (let* ((form (concat (format "BG(%s)(%s"
-                               (format-quote-string (get-bottom-dir dir))
-                               (format-quote-string command)) ")%d"))
-         (job-num (background-search-job-space form)))
-    (format form job-num)))
-
-;;;###autoload
-(defun background (command &optional buffer-name)
-  "Run COMMAND in the background like csh.  
-A message is displayed when the job starts and finishes.  The buffer is in
-comint mode, so you can send input and signals to the job.  The process object
-is returned if anyone cares.  See also comint-mode and the variables
-background-show and background-select.
-
-Optional second argument BUFFER-NAME is a buffer to insert the output into.
-If omitted, a buffer name is constructed from the command run."
-  (interactive "s%% ")
-  (let* ((dir default-directory)
-         (job-name (if (functionp background-get-job-name)
-                       (apply background-get-job-name (list command dir))
-                     (background-get-job-name-simple command dir))))
-    (or buffer-name
-	(setq buffer-name (format "*%s*" job-name)))
-    (if background-select (pop-to-buffer buffer-name)
-      (if background-show (with-output-to-temp-buffer buffer-name)) ; cute
-      (set-buffer (get-buffer-create buffer-name)))
-    (erase-buffer)
-
-    (setq default-directory dir) ; Do this first, in case cd is relative path.
-    (if (string-match "^cd[\t ]+\\([^\t ;]+\\)[\t ]*;[\t ]*" command)
-	(let ((dir (substring command (match-beginning 1) (match-end 1))))
-	   (setq command (substring command (match-end 0)))
-	   (setq default-directory
-		 (file-name-as-directory (expand-file-name dir)))))
-
-    (insert-before-markers "--- working directory: " default-directory
-	    "\n% " command ?\n)
-
-    (let ((proc (get-buffer-process
-		 (comint-exec buffer-name job-name shell-file-name
-			      nil (list shell-command-switch command)))))
-      (comint-mode)
-      ;; COND because the proc may have died before the G-B-P is called.
-      (cond (proc (set-process-sentinel proc 'background-sentinel)
-		  (message "%d" (process-id proc))))
-      (setq mode-name "Background")
-      proc)))
-
-(defun background-sentinel (process msg)
-  "Called when a background job changes state."
-  (let ((ms (match-data))) ; barf
-    (unwind-protect
-	 (let ((msg (cond ((string= msg "finished\n") "Done")
-			  ((string-match "^exited" msg)
-			   (concat "Exit " (substring msg 28 -1)))
-			  ((zerop (length msg)) "Continuing")
-			  (t (concat (upcase (substring msg 0 1))
-				     (substring msg 1 -1))))))
-	   (message "[%s] %s %s" (process-name process)
-		    msg
-		    (nth 2 (process-command process)))
-	   (if (null (buffer-name (process-buffer process)))
-	       (set-process-buffer process nil) ; WHY? Olin.
-	       (if (memq (process-status process) '(signal exit))
-		   (save-excursion
-		     (set-buffer (process-buffer process))
-		     (let ((at-end (eobp)))
-		       (save-excursion
-			 (goto-char (point-max))
-			 (insert ?\n msg ? 
-				 (substring (current-time-string) 11 19) ?\n))
-		       (if at-end (goto-char (point-max))))
-		     (set-buffer-modified-p nil)))))
-      (store-match-data ms))))
-
-;;; background.el ends here
diff --git a/xemacs-packages/lisp/os-utils/crypt.el b/xemacs-packages/lisp/os-utils/crypt.el
deleted file mode 100644
index 09d557d7..00000000
--- a/xemacs-packages/lisp/os-utils/crypt.el
+++ /dev/null
@@ -1,2666 +0,0 @@
-;;; crypt.el --- code for handling all sorts of compressed and encrypted files
-
-;; Author: Lawrence R. Dodd 
-;;	Rod Whitby 
-;;	Kyle E. Jones 
-;; Maintainer: Lawrence R. Dodd 
-;; Created: crypt.el in 1988, crypt++.el on 18 Jan 1993
-;; Version: 2.83
-;; Date: 1994/03/31 12:30:17
-;; Keywords: extensions
-
-;;; Copyright (C) 1994 Lawrence R. Dodd
-;;; Copyright (C) 1993 Lawrence R. Dodd and Rod Whitby
-;;; Copyright (C) 1988, 1989, 1990 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 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., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;;; NOTE: Apparently not being maintained by the author, who now
-;;; uses jka-compr.el. --ben (1/26/96)
-;;; Included patch (1/26/96)
-
-;;; Please see notes on INSTALLATION and USAGE on the pages below.
-
-;;; LCD Archive Entry:
-;;; crypt++|Rod Whitby and Lawrence R. Dodd|dodd@roebling.poly.edu|
-;;; Code for handling all sorts of compressed and encrypted files.|
-;;; 1994/03/31 12:30:17|2.83|~/misc/crypt++.el.Z|
-
-;;; AVAILABLE: 
-;;; 
-;;; via anonymous ftp to roebling.poly.edu [128.238.5.31] in 
-;;; /pub/lisp/crypt++.el.gz
-;;; 
-;;; via anonymous ftp to archive.cis.ohio-state.edu [128.146.8.52] in 
-;;; /pub/gnu/emacs/elisp-archive/misc/crypt++.el.Z
-
-;;; BUG REPORTS
-;;; 
-;;; Type M-x crypt-submit-report to generate a bug report template or put your
-;;; cursor at the end of this line and type C-x C-e: (crypt-submit-report)
-;;; 
-;;; Please note that this bug-report facility (crypt-submit-report) uses Barry
-;;; Warsaw's reporter.el which is part of GNU Emacs v19 and bundled with many
-;;; other packages.  If needed, you can obtain a copy of reporter.el at
-;;; /roebling.poly.edu:/pub/reporter.el or the elisp-archive.  In fact,
-;;; crypt-submit-report will attempt to ange-ftp a copy for you from roebling
-;;; if you do not have one accessible.
-
-;;; Lawrence R. Dodd 
-;;; Polytechnic University
-;;; Brooklyn, New York USA
-
-;;; VERSION:
-;;;  
-;;; Version: 2.83
-;;; Ident: crypt++.el,v 2.82 1994/03/31 12:30:17 dodd Exp
-;;; Date: 1994/03/31 12:30:17
-
-
-;;; INSTALLATION:
-;;;
-;;; To use this package, simply put it in a file called "crypt.el" in a Lisp
-;;; directory known to Emacs (see `load-path'), byte-compile it (you may get a
-;;; warning saying that the function reporter-submit-bug-report is not known
-;;; to be defined -- ignore it), and put the line:
-;;;
-;;;                      (require 'crypt)
-;;;
-;;; in your ~/.emacs file or in the file default.el in the ../lisp directory
-;;; of the Emacs distribution.  Do not bother trying to autoload this file;
-;;; this package uses find-file and write-file hooks and thus should be loaded
-;;; the first time you visit any sort of file.  Any package loaded after this
-;;; one that appends something to `write-file-hooks' will not be executed
-;;; because this package writes out the file.  Other packages that append to
-;;; `write-file-hooks' should either be modified to prepend to that hook or be
-;;; loaded before this one (preferably the former).
-
-;;; NOTE: encryption users should set `crypt-encryption-type' to one of the
-;;; values in `crypt-encryption-alist' (see USAGE below).
-
-;;; SEE ALSO: /roebling.poly.edu:/pub/crypt++-fnf.el for file-not-found 
-;;; support for GNU Emacs.
-
-;;; SPECIAL NOTES:
-;;;  
-;;; If crypt is dumped with the emacs executable, or if it has already been
-;;; loaded in an emacs session, then modifying the variables used in building
-;;; the encryption and encoding tables will have no effect until these tables
-;;; are rebuilt.  This may be done with `M-x crypt-rebuild-tables'.  See USAGE
-;;; below to determine variables for which this is needed.  For example,
-;;; post-load changes to `crypt-encryption-file-extension' or
-;;; `crypt-freeze-vs-fortran' can be incorporated into the encryption table
-;;; via `M-x crypt-rebuild-tables'.  Similarly, post-load changes to
-;;; `crypt-bind-insert-file' are handled with `M-x crypt-bind-insert-file'.
-
-
-;;; USAGE:
-;;; 
-;;; By default, intended to be transparent.  User-defined variables 
-;;; 
-;;;     controlling ENCRYPTION are
-;;;  
-;;;        crypt-encryption-type
-;;;        crypt-encryption-file-extension
-;;;        crypt-never-ever-decrypt
-;;;        crypt-auto-write-buffer-encrypted
-;;;        crypt-confirm-password
-;;;        crypt-encrypted-disable-auto-save
-;;;        crypt-encryption-alist
-;;;  
-;;;     controlling ENCODING are
-;;;  
-;;;        crypt-auto-decode-buffer
-;;;        crypt-auto-write-buffer
-;;;        crypt-query-if-interactive
-;;;        crypt-no-extension-implies-plain
-;;;        crypt-freeze-vs-fortran
-;;;        crypt-compact-vs-C++
-;;;        crypt-ignored-filenames
-;;;        crypt-default-encoding
-;;;        crypt-encoded-disable-auto-save
-;;;        crypt-encoding-alist
-;;; 
-;;;     controlling file insertion are
-;;; 
-;;;        crypt-bind-insert-file
-;;;        crypt-auto-decode-insert
-;;;      
-;;; To find out more about these variables, load this file, put your cursor at 
-;;; the end of any of the variable names, and hit C-h v [RET].
-;;;  
-;;; NOTE: encryption users should set `crypt-encryption-type' to one of the
-;;; values in `crypt-encryption-alist'
-;;;
-;;; Although rarely needed, the following functions may be called interactively
-;;;
-;;;        (crypt-encoded-mode)
-;;;        (crypt-encode-region)
-;;;        (crypt-encrypted-mode)
-;;;        (crypt-encrypt-region)
-;;;        (crypt-set-encryption-key)
-;;;        (crypt-rebuild-tables)
-;;;        (crypt-insert-file)
-;;;        (crypt-bind-insert-file)
-;;;        (crypt-submit-report)
-;;;
-;;; To find out more about these functions, load this file, put your cursor
-;;; inside any of the `()' of the above lines, and hit C-h f [RET].
-
-
-;;; NOTES ON INTERFACES WITH OTHER PROGRAMS AND PACKAGES:
-;;;
-;;; GZIP: the environment variable GZIP of gzip can cause an error if it
-;;; contains `--verbose' because standard output messages will be appended to
-;;; gzip'ed files.  This corrupts the files.  The cleanest solution is to pass
-;;; the `--quiet' switch in `crypt-encoding-alist' to override this.  use gzip
-;;; version 1.0.4 or higher from prep.ai.mit.edu:/pub/gnu
-;;; 
-;;; TAR-MODE: works properly with version 1.28 (or higher) with v19 emacs.
-
-
-;;; DESCRIPTION:
-;;;
-;;; The basic purpose of this package of Lisp functions is to recognize
-;;; automatically encrypted and encoded (i.e., compressed) files when they are
-;;; first visited or written.  The BUFFER corresponding to the file is decoded
-;;; and/or decrypted before it is presented to the user.  The file itself is
-;;; unchanged on the disk.  When the buffer is subsequently saved to disk, a
-;;; hook function re-encodes the buffer before the actual disk write takes
-;;; place.
-;;;
-;;; This package recognizes all sorts of compressed files by a magic number at
-;;; the beginning of these files but uses a heuristic to detect encrypted
-;;; files.  If you are asked for an encryption key for a file that is in fact
-;;; not encrypted, just hit RET and the file will be accepted as is, and the
-;;; crypt minor mode will not be entered.
-;;;
-;;; Other types of encoding programs may be added to this package by using the
-;;; variable `crypt-encoding-alist' which contains a table of encoding
-;;; programs such as compress, gzip (GNU zip), freeze, and compact.
-;;;
-;;; This new extended version of crypt now monitors the filename extensions of
-;;; buffers that are written out using write-file (C-x C-w).  If the filename
-;;; extension matches one of the extensions listed in `crypt-encoding-alist,'
-;;; then this package will write the file out using the corresponding encoding
-;;; (compression) method. This is done whether or not the buffer originated
-;;; from a previously encoded (compressed) file.
-;;;
-;;; Thus, if the user is editing a file that may or may not have been encoded
-;;; originally (e.g., foobar.Z or foobar) and decides to write it to a
-;;; different file (e.g., barfoo or barfoo.z or barfoo.C).  This package will
-;;; examine the filename extension and write the buffer in plain format or an
-;;; alternate encoding (compression) format by searching through the entries
-;;; in the table of encoding methods `crypt-encoding-alist.'  This change in
-;;; encoding state is done automatically if the variable
-;;; `crypt-auto-write-buffer' is t otherwise the user is asked.
-
-
-;;; TO DO/KNOWN BUGS/HELP WANTED/APPLY WITHIN: 
-;;; 
-;;; All Users/hackers out there are strongly encouraged to pursue any of these
-;;; matters further (especially those that concern encryption and decryption!).
-;;; It is important to future programmers and modifiers of crypt++.el to know
-;;; about its perceived limitations.  Since necessity drives invention, users
-;;; who find any of the following features of crypt++.el annoying are asked to
-;;; make suggestions and send patches (again, especially those that concern
-;;; encryption and decryption!).
-;;; 
-;;; * currently crypt++ assumes that if a file is both encrypted and encoded
-;;;   (i.e., compressed) that the order in which it was done was encryption
-;;;   first _then_ compression.  As has been pointed by many people compression
-;;;   following encryption is useless since the encrypted file is basically
-;;;   random.  On the other hand, many agree that doing encryption _following_
-;;;   compression is better since it makes it harder to crack the encryption.
-;;;   We would like to make the ordering of these two user-configurable or if
-;;;   nothing else change the order.
-;;; 
-;;;   Having read the above however, Francois Pinard  
-;;;   writes that encryption following compression may not be harder to crack 
-;;;   since "the fact that the first few uncrypted bytes are expected (the 
-;;;   compress signature) facilitates a serious attempt at uncrypting." 
-;;;   jwz agrees with Francois.
-;;; 
-;;; * get write-region and append-to-file to handle encoded and encrypted
-;;;   files.  There is an interesting low-level encoding package by Jay Adams
-;;;    called jka-compr.el that might address some of these
-;;;   issues.  We encourage hackers out there to come up with crypt++ versions
-;;;   of write-region and append-to-file.  The difficulty is creating versions
-;;;   that mimic the originals as closely as possible.
-;;;
-;;; * instead of using call-process-region (which can fail badly if the region 
-;;;   is large and there's not much room in /tmp), write the region to a temp 
-;;;   file (with a customisable location) and use call-process directly.
-;;;
-;;; * users have mentioned trouble using crypt++ and hilit simultaneously since 
-;;;   the functions in write-file-hook for both write the file to disk and
-;;;   return t.  A possible solution is to have one of them write to a
-;;;   scratch buffer instead of to disk and return nil and then allow the
-;;;   other to do its work on the scratch buffer and write it to disk.  Thanks
-;;;   to Wayne Folta  and Amir J Katz .
-;;;   It would be nice to have another way in emacs to have an
-;;;   after-write-file-hook and a before-write-file-hook of some sort.
-;;;   Lucid Emacs has an after-write-file-hook.  Recent versions of hilit19.el 
-;;;   do not automatically attach to `write-file-hooks' and return t. 
-;;;   However, the general problem of multiple packages returning t still 
-;;;   remains.  dos-mode.el and crypt.el also conflict.
-;;;  
-;;; * another possible source of trouble is with encryption (and encoding) 
-;;;   programs sticking verbose output into buffers prior to being written to
-;;;   disk.  This was definitely occurring with gzip because of --verbose in
-;;;   the GZIP environment variable and is solved/hidden with the --quiet
-;;;   switch.  However, I suspect that some encryption problems out there are
-;;;   capable of similar things so the user should be careful.
-;;; 
-;;; * integrating crypt++ with a backgrounding package such as Olin Shivers' 
-;;;   `background.el' might be useful too.  thanks to Mark Borges 
-;;;    for suggesting this.
-;;; 
-;;; * Performing M-x crypt-encode-buffer or M-x crypt-encrypt-buffer and then
-;;;   saving the file would possibly cause errors.  It is better to toggle
-;;;   `crypt-encoded-mode' (or `crypt-encrypted-mode') and simply save the
-;;;   file.  It is for this reason that `crypt-encode-buffer' and
-;;;   `crypt-encrypt-buffer' are not interactive.
-;;; 
-;;; * use plists instead of alists replacing calls to `nth' with `get' 
-;;; 
-;;; * merge encryption code completely into encoding code making encryption
-;;;   just a special case of encoding.
-
-
-;;; Change log:
-;;;  
-;;; 1.1 - original version of crypt.el
-;;; 1.2 -
-;;;   jwz: works with tar-mode.el
-;;;   jwz: applied patch from piet, merged with Lawrence Dodd's gzip version
-;;; 1.3 -
-;;;   lrd: fixed compress-magic-regexp 
-;;; 1.4, 1.5, 1.6 -
-;;;   lrd: write-file compresses or gzips based on file extension
-;;; 2.1 -
-;;;   lrd: merged with Rod Whitby's table-driven version (major upgrade)
-;;; 2.2 -
-;;;   rjw: Changed file name to crypt++.el, so archie and lispdir can find it.
-;;; 2.3 -
-;;;   rjw: Separated the hook additions and minor mode alist additions.
-;;; 2.4 -
-;;;   rjw: Fixed the interactive form for crypt-buffer.
-;;; 2.5 - 
-;;;   lrd: doc mods, changed GNU free software notice (was out of date), added 
-;;;   anonymous ftp information
-;;; 2.6 - 
-;;;   lrd: added back in definition of `buffer' in defun crypt-buffer caused 
-;;;   an error when trying to read encrypted file; modified check for minor 
-;;;   mode alist addition; added gzip magic number warning
-;;; 2.7 - [posted to gnu.emacs.sources]
-;;;   lrd: added `TO DO' and `KNOW BUGS' section to header 
-;;; 2.8 - 
-;;;   lrd: added note about updating to v 1.24 of tar-mode.el
-;;;   Thanks to Mark Borges 
-;;; 2.9 -
-;;;   lrd: moved query about `crypt-freeze-vs-fortran' out of defvar for
-;;;   `crypt-encoding-alist,' an erroneous value of nil was being stuck into
-;;;   alist when user set `crypt-freeze-vs-fortran' was nil, doc mod.
-;;;   Thanks to Mark Borges 
-;;; 2.10 -
-;;;   rjw: moved query about `crypt-freeze-vs-fortran' back into defvar for
-;;;   `crypt-encoding-alist,' - used append to ignore the erroneous nil.
-;;; 2.11 -
-;;;   rjw: fixed a bug in my fix :-(
-;;; 2.12 -
-;;;   rjw: Defvar crypt-magic-regexp and crypt-magic-regexp-inverse and
-;;;   allow either a regexp or an elisp expression.
-;;;   Suggested by Franc,ois Pinard .
-;;; 2.13 - 
-;;;   lrd: added in info on lispdir.el, doc mods and some puttering while 
-;;;   looking over rjw's v 2.12 mods.
-;;; 2.14 - 
-;;;   lrd: doc mod - trivial huh? switched `compact' and  `gzip' in 
-;;;   `crypt-encoding-alist' - want gzip near top
-;;; 2.15 - 
-;;;   lrd: added in LCD Archive Entry and modified comments on tar-mode.el 
-;;;   since the version at the elisp-archive now works with crypt++.el
-;;; 2.16 - 
-;;;   lrd: provide `crypt' as well as `crypt++' allowing something like `ln -s 
-;;;   crypt++.el crypt.el' to be meaningful 
-;;;   Suggested (by|as) Per Abrahamsen 
-;;; 2.17 -
-;;;   lrd: clarified bug report procedure, added fancy pseudo-graphics, added 
-;;;   to the `TO DO' list, put RCS tags in LCD Archive entry
-;;; 2.18 - [posted to gnu.emacs.sources]
-;;;   lrd: included pointer to elisp archive in crypt-version description,
-;;;   changed "Decode buffer %s? " to "Decode %s? " in crypt-find-file-hook 
-;;;   to be more general (mainly for crypt-insert-file)
-;;; 2.19 -
-;;;   rjw: Added the crypt-compact-vs-C++ switch to distinguish compacted and
-;;;   C++ files.
-;;; 2.20 -
-;;;   lrd: (1) modified interactive form of crypt-buffer. (2) made search 
-;;;   case-insensitive in crypt-submit-report. (3) modified encoded-mode and 
-;;;   crypt-mode so that buffer-modified is not unconditionally set to nil 
-;;;   when the mode is not changed. Thanks to Gerd Hillebrand 
-;;;    for suggesting (2) and (3).
-;;; 2.21 -
-;;;   rjw: Added an entry to the TODO list about the hazards of using
-;;;   call-process-region on a large region and not much room in /tmp
-;;;   (David Carlisle ).
-;;; 2.22 - 
-;;;   lrd: allow write-file-hooks to contain functions as well as lists. 
-;;;   Contributed by Ken Laprade .
-;;; 2.23 - 
-;;;   lrd: made crypt-submit-report list values of more user-defined variables
-;;; 2.24 - 
-;;;   lrd: pass the -q switch to gzip to thwart the possibility of a --verbose
-;;;   in the GZIP environment variable
-;;; 2.25 -
-;;;   lrd: added some more to the TO DO list, clarified some things, also 
-;;;   untabified the entire file (I got tired of the control I's) 
-;;; 2.26 - 
-;;;   lrd: use the long-named options for GNU zip (self-documenting)
-;;; 2.27 - 
-;;;   lrd: included observation by Francois Pinard  
-;;;   and worked on text in TO DO/KNOWN BUGS list
-;;; 2.28 - 
-;;;   lrd: added two new variables in (crypt-submit-report) to the list stuck
-;;;   at the bottom of the mail message; changed the comments regarding the 
-;;;   user-defined variables.  added in default values in user defined 
-;;;   variables.  added to and removed stuff to the `TO DO' list.
-;;;
-;;;   (encoded-mode): 
-;;;   added in code to remove any auto-save-files that may have been formed
-;;;   before becoming an encoded buffer (for example a plain file saved to
-;;;   disk encoded had orphan auto-save-files left behind).  turning off
-;;;   auto-save-mode disables the creation of auto-save-files, but it also 
-;;;   disables the possibility of these being removed when the buffer is 
-;;;   saved.
-;;; 
-;;;   (crypt-region): 
-;;;   now call the encryption and decryption program directly instead of
-;;;   through the shell.  this is more secure since the shell will expose the
-;;;   password (key).  thanks to Jon Cargille .  defined
-;;;   two new variables `crypt-decryption-args' and `crypt-encryption-args' to
-;;;   take the arguments separately.  removed (let ((opoint)...)) construct 
-;;;   this was a throw back to some old dead code and was not being used.
-;;; 2.29 - 
-;;;   lrd: added three new variables in (crypt-submit-report); added to the 
-;;;   `TO DO' list.
-;;;  
-;;;   (encode-region,encode-buffer,encoded-mode): fixed interactive forms -
-;;;   the conversion to table version had eliminated some of the interactive
-;;;   features of these.  thanks to Kimball Collins 
-;;;   for point this out.  new interactive form uses functions
-;;;   `crypt-get-encoding-type' and `crypt-symbol-alist-to-table' and variable
-;;;   `crypt-default-encoding' to generate completion list of encoding types.
-;;; 
-;;;   (crypt-write-file-hook): two new user-defined variables
-;;;   `crypt-query-if-interactive' and `crypt-no-extension-implies-plain' and
-;;;   the buffer-local variable `buffer-interactive-mode' are used to help
-;;;   determined whether or not plain output is really desired for files
-;;;   without a compression file-name extension.  the default behavior is the
-;;;   same as before.
-;;; 2.30 - 
-;;;   lrd: added test for user-defined variable `crypt-never-ever-decrypt' 
-;;;   when finding a file.  some users may never wish to decrypt files 
-;;;   and like to edit binary files.  thanks to Nelson Minar 
-;;;   .  added to doc-strings of 
-;;;   `crypt-magic-regexp[-inverse]' -- these can be set to nil[t] and 
-;;;   accomplish the same thing as setting `crypt-never-ever-decrypt' to t
-;;; 2.31 - 
-;;;   rjw: Updated the comments in the encryption check section.
-;;; 2.32 - [posted to gnu.emacs.sources]
-;;;   lrd: added warning about `crypt-(de|en)cryption-program'; doc mod.
-;;; 2.33 - 
-;;;   lrd: if `crypt-(de|en)cryption-args' are nil then don't pass any
-;;;   arguments to (de|en)cryption program, nil is the default instead of
-;;;   "".  Thanks to Joe Ilacqua , David J. Schur
-;;;   , Peter Nuth , and Greg Larson 
-;;;   .  `-q' exists in gzip 1.0.3 but not `--quiet' changed 
-;;;   GZIP NOTE.  Thanks to Chris Moore .
-;;; 2.34 - 
-;;;   lrd: allow `crypt-(de|en)cryption-args' to be a list of strings -- more
-;;;   robust.  query for password (key), if none is set, when writing out file
-;;;   for which `buffer-save-encrypted' is t.  Thanks to John Interrante
-;;;   .  (crypt-write-file-hook): check filename
-;;;   extension against regexp `crypt-encryption-file-extension' and query for
-;;;   encryption, unless `crypt-auto-write-buffer-encrypted' is t (don't
-;;;   bother doing reverse check, encrypted to plain, not a common request).
-;;;   (crypt-mode): delete auto-save files (cf., encoded-mode), may exist now.
-;;;   (read-string-no-echo): applied patch from Piet van Oostrum
-;;;    -- set `cursor-in-echo-area' _after_ setting buffer
-;;;   (this was screwing up gnews).
-;;; 2.35 - 
-;;;   lrd: doc mod
-;;; 2.36 - 
-;;;   lrd: fixed typo, added RMAIL note.
-;;; 2.37 - [posted to gnu.emacs.sources]
-;;;   lrd: 
-;;;   (crypt-write-file-hook): search user-defined list
-;;;   `crypt-ignored-filenames' for possible match with `buffer-filename'
-;;;   before attempting conversion from compressed to plain format; useful for
-;;;   compressed incoming mail files (e.g., RMAIL, INBOX).
-;;;  
-;;;   (crypt-mode): query for key if not set already; need to switch order of
-;;;   recovering key and toggling crypt-mode in crypt-find-file-hook (thanks
-;;;   to Piet van Oostrum ).
-;;;  
-;;;   (crypt-buffer) and (encode-buffer): remove interactive form; use
-;;;   (crypt-mode) and (encoded-mode) instead so encryption and compression
-;;;   are done at the very end; leave interactive form in (crypt-region) and
-;;;   (encode-region) may still be used.
-;;;  
-;;;   (set-encryption-key): remove from `command-history' if called
-;;;   interactively - thanks to George M. Georgiou
-;;;   .
-;;; 2.38 - 
-;;;   lrd: added `crypt-' prefix to `(read-string-no-echo)' and `(save-point)'
-;;;   changed file extension for gzip files to `.z' _or_ `.gz' (future release
-;;;   of gzip with use later extension by default and so this should be
-;;;   changed to just `.gz' someday).
-;;; 2.39 - 
-;;;   lrd: doc mod. added in patch from jwz - `(crypt-read-string-no-echo)' is
-;;;   more secure, put property 'permanent-local on buffer-locals works for
-;;;   Lucid Emacs and doesn't harm v18 emacs, change `buffer-interactive-mode'
-;;;   to `buffer-interactive-encoded-mode.'
-;;; 2.40 - 
-;;;   lrd: put property 'preserved in case kill-fix.el is being used.
-;;; 2.41 - 
-;;;   lrd: all functions and variables now start with `crypt-', moved REVISION
-;;;   HISTORY to bottom of header, interactive version of
-;;;   `(crypt-encrypt-region)' clearer, `(crypt-read-string-no-echo)' now
-;;;   echos `.'
-;;; 2.42 -
-;;;   lrd: (crypt-check-extension-for-encoding): broke out of
-;;;   `(crypt-write-file-hook)'.  setting user variables
-;;;   `crypt-compact-vs-C++' and `crypt-freeze-vs-fortran' to nil no longer
-;;;   completely disables the reading compact'ed and frozen files but just
-;;;   disables the use of the file-extension tricks of
-;;;   `(crypt-check-extension-for-encoding).'  (crypt-encode-region): allow
-;;;   for a single line message from encoding program at top of region; if it
-;;;   is there, then remove it; kludge for `compact' program.
-;;; 2.43 - 
-;;;   lrd: (crypt-encode-region): generalize the clean up procedure; add
-;;;   element to `crypt-encoding-alist' and introduce new function
-;;;   `(crypt-encoding-cleanup-regexp)' to extract a compression specific
-;;;   regexp for erroneous message or lisp expression for cleanup.
-;;; 2.44 - 
-;;;   lrd: new element for `crypt-encoding-alist' handles whether or not
-;;;   file-name extension tricks may be play with encoding method; compact and
-;;;   freeze values default to `crypt-compact-vs-C++' and
-;;;   `crypt-freeze-vs-fortran' (thanks to rjw);
-;;;   (crypt-encoding-extension-tricks): new defun to handle this;
-;;;   (crypt-check-extension-for-encoding): monitors "tricks" entry of
-;;;   `crypt-encoding-alist' and adjust the bag of tricks it can apply.
-;;; 2.45 - 
-;;;   lrd: (crypt-encode-region): delete entire match of cleanup regexp by
-;;;   requiring newlines in GARBAGE-REGEXP-OR-LISPEXP.  (crypt-submit-report):
-;;;   use Warsaw's reporter.el.
-;;; 2.46 -
-;;;   lrd: (crypt-find-file-hook, crypt-write-file-hook): cleaned, documented,
-;;;   and replaced occurrences of `(cond (C BODY))' with `(if C BODY)';
-;;;   changed `crypt-magic-regexp' to `crypt-encryption-magic-regexp' and
-;;;   `crypt-magic-regexp-inverse' to `crypt-encryption-magic-regexp-inverse'
-;;;   for consistency with other variable names. new user-defined variable
-;;;   `crypt-encryption-minor-mode-name' instead of always "Crypt".  grouped
-;;;   all encryption variables together.
-;;; 2.47 - 
-;;;   lrd: somewhat major change - put program-specific encryption variables
-;;;   into a single table `crypt-encryption-alist' and let the variable
-;;;   `crypt-encryption-type' define the appropriate entry to use; new
-;;;   user-defined variable `crypt-confirm-password,' thanks to Jeff Clark
-;;;   . (crypt-submit-report): improved error 
-;;;   handling, thanks to baw. (crypt-write-file-hook): fixed bug with 
-;;;   `crypt-encoding-extension-tricks'
-;;; 2.48 - 
-;;;   lrd: added dummy argument to `crypt-encoding-alist' and
-;;;   `crypt-encryption-alist' and merged all defuns that work on their
-;;;   elements into defuns that all start with `crypt-get-' and look through
-;;;   both lists.  simplifies some of code and closer to treating encryption
-;;;   as a special case of encoding; crypt-minor-mode-alist: replaced (nth *)
-;;;   with `(crypt-get-minor-mode)' call; (crypt-encode-region): allow
-;;;   arguments to be list of strings; renamed (crypt-get-encoding-type) to
-;;;   (crypt-read-encoding-type) for clarity.
-;;; 2.49 - [posted to gnu.emacs.sources]
-;;;   lrd: (crypt-encode-region): ignore `args' if set to t
-;;; 2.50 - 
-;;;   lrd: (crypt-write-file-hook): in v19 we need to call `backup-buffer'
-;;;   ourselves -- we write out the file and return t so `basic-save-buffer'
-;;;   does not do it; also call `set-file-modes'
-;;; 2.51 -
-;;;   lrd: some `defvar's are now `defconst's and tar-mode note was changed.
-;;; 2.52 - 
-;;;   lrd: make doc strings conform to GNU standards.
-;;; 2.53 - 
-;;;   lrd: made header conform to GNU Conventional Headers standard.
-;;; 2.54 -
-;;;   lrd: `crypt-encryption-file-extension', `crypt-freeze-vs-fortran',
-;;;   `crypt-compact-vs-C++', `crypt-encryption-magic-regexp', and
-;;;   `crypt-encryption-magic-regexp-inverse' are used in defining the tables
-;;;   `crypt-encoding-alist' and `crypt-encryption-alist' and so need to be set
-;;;   _before_ loading crypt++.  use `add-hook' if it is available.
-;;; 2.55 - 
-;;;   lrd: new interactive function `crypt-insert-file' mimics `insert-file' 
-;;;   but attempts to decode or decrypt before insertion; bound `C-x i' if
-;;;   `crypt-bind-insert-file' is non-nil.  comment out doc-strings from 
-;;;   internal subroutines, saves space.
-;;; 2.56 -
-;;;   tfb: change the definitions of crypt-{encoding,encryption}-alist, to
-;;;   call the functions crypt-make-{encoding,encryption}-alist resp.
-;;;   Added crypt-reinit which regenerates these variables from their
-;;;   functions, thus allowing this stuff to be preloaded even if people
-;;;   set things in their init files.
-;;;   Tim Bradshaw  
-;;; 2.57 - 
-;;;   lrd: untabify; remove duplicate entry in `crypt-make-encoding-alist';
-;;;   change name of `crypt-make-*-alist' to `crypt-build-*-alist' and
-;;;   `crypt-reinit' to `crypt-rebuild-tables'; (crypt-read-string-no-echo):
-;;;   change local variable `form' to `help-form' so it is defined;
-;;;   `crypt-encryption-alist' and `crypt-encoding-alist' must be defined with
-;;;   `defconst' since we wish crypt++ to initialize these variables
-;;;   unconditionally; modify INSTALLATION section to reflect these changes.
-;;; 2.58 - 
-;;;   lrd: doc mod.
-;;; 2.59 - [posted to gnu.emacs.sources]
-;;;   lrd: (crypt-bind-insert-file): new function for changing "C-x i" in 
-;;;   initialization file or interactively.
-;;; 2.60 - 
-;;;   lrd: add `crypt-rebuild-tables' and `crypt-bind-insert-file' to 
-;;;   `after-init-hook' in GNU emacs v19 and to `term-setup-hook' in Lucid 
-;;;   emacs.  Change INSTALLATION notes.
-;;; 2.61 - [posted to gnu.emacs.sources]
-;;;   lrd: Doc mod.  Clean up the installation of minor mode indicators.
-;;; 2.62 - [posted to gnu.emacs.sources]
-;;;   lrd: installed patch from stig@hackvan.com to simplify crypt-get-* defuns
-;;;   (now defmacros).  Don't add to `term-setup-hook' unless no
-;;;   `after-init-hook' _and_ definitely running v19, otherwise Rod gets an 
-;;;   error at home :-<.  Don't assume C-x i had `insert-file' bound to it: 
-;;;   store old binding in `crypt-old-binding' before overwriting and use in 
-;;;   function `crypt-bind-insert-file.'
-;;; 2.63 - 
-;;;   lrd: (crypt-encode-buffer, crypt-encode-region, crypt-encrypt-buffer,
-;;;   crypt-encrypt-region): changed argument list putting optional buffer
-;;;   last and making default action to encode or encrypt. (crypt-encoded-p,
-;;;   crypt-encrypted-p): new functions that do the actual testing of file
-;;;   contents.  (crypt-find-file): uses these new functions.
-;;;   (crypt-rebuild-minor-modes-alist): new function to rebuild
-;;;   `minor-mode-alist' called by function crypt-rebuild-tables.
-;;;   (crypt-build-minor-mode-alist): new function called by
-;;;   `crypt-minor-mode-alist' to create itself.  `crypt-minor-mode-encrypted'
-;;;   removed because defined in function crypt-build-minor-mode-alist.
-;;; 2.64 - 
-;;;   lrd: (crypt-find-file-hook): temporarily remove the encrytion file
-;;;   extension to help determine the major mode, just like is done with the
-;;;   encoding file extension.  In order for this to work properly the file
-;;;   extension in `crypt-encryption-file-extension' and
-;;;   `crypt-encryption-alist' needs to be inside a pair of \\( \\).
-;;; 2.65 - 
-;;;   lrd: (crypt-find-file-hook): move determination of key, password, into
-;;;   (crypt-encrypted-p).
-;;; 2.66 - 
-;;;   lrd: (crypt-set-encryption-key): improve prompt string for encryption 
-;;;   key.
-;;; 2.67 - 
-;;;   lrd: (crypt-write-file-hook): make check for encryption file-name 
-;;;   extension case-sensitive.
-;;; 2.68 - 
-;;;   lrd: fixed check for previous addition to `minor-mode-alist' -- was not
-;;;   working. Check for an `add-hook' function; if one does not exist then
-;;;   use a copy of one from GNU Emacs 19.  When using `add-hook' to append to
-;;;   the `write-file-hooks' make sure that the version accepts the optional
-;;;   APPEND argument -- v19's does but the one in the elisp archive by Dan
-;;;   LaLiberte  does not append.  This causes problems.
-;;;   Thanks to Francesco Potorti`  for pointing this
-;;;   out.
-;;; 2.69 - [posted to gnu.emacs.sources]
-;;;   lrd: doc mod with regards `after-init-hook' and Lucid Emacs.  Add 
-;;;   pointer to crypt++-fnf.el for people who might be interested.
-;;; 2.70 -
-;;;   lrd: narrow conditions under which crypt-encryption-magic-regexp
-;;;   matches.  Thanks to Philippe Michel  and Francois
-;;;   Pinard  for helping explain this with regards 
-;;;   to ISO/Latin-1.
-;;; 2.71 -
-;;;   lrd: applied patches from Darrin Jewell  for DOS to UNIX
-;;;   support.  DOS entry added to crypt-build-encoding-alist.
-;;;   (crypt-dos-to-unix-region, crypt-unix-to-dos-region): New
-;;;   functions. (crypt-dos-has-ctrl-z): New buffer-local variable.
-;;;   (crypt-encode-region): allow for encoding and decoding programs to be
-;;;   elisp expressions.  If they are then apply them directly to region.
-;;;   Point out that crypt++.el conflicts with dos-mode.el.
-;;; 2.72 - 
-;;;   lrd: The limit for the regular expression search done by
-;;;   `crypt-encrypted-p' is extended to 100 by default.  The enlargement of
-;;;   search field is needed because of previous reduction in size of regexp
-;;;   being searched for.  (crypt-magic-search-limit): New variable defining
-;;;   this new limit.  (crypt-encrypted-p): Uses it and cleaned up.  Doc mod.
-;;;   Thanks to Philippe Michel , Francois Pinard
-;;;   , and Dave Goldberg .
-;;; 2.73 - [posted to gnu.emacs.sources]
-;;;   lrd: Apply patch from Kevin Rodgers  that
-;;;   uses more verbose messages and capitals.  Doc mod.
-;;; 2.74 - 
-;;;   lrd: Untabify.  (crypt-encrypted-p): Check value of
-;;;   `crypt-never-ever-decrypt' before anything else.
-;;; 2.75 - 
-;;;   lrd: (crypt-version): Remove call to `substring'.
-;;; 2.76 - 
-;;;   lrd: (crypt-encryption-magic-regexp-inverse): Add in regexp that will
-;;;   match ksh `.sh_history' files so that they are not interpreted as
-;;;   encrypted files.  Thanks to Francesco Potorti` .
-;;; 2.77 - [posted to gnu.emacs.sources]
-;;;   lrd: (crypt-bind-insert-file): Use substitute-key-definition to bind
-;;;   crypt-insert-file to whatever key insert-file is bound to (not
-;;;   necessarily C-x i).  Call crypt-bind-insert-file directly in
-;;;   file. Variable crypt-bind-insert-file: Doc mod.  Remove
-;;;   crypt-old-binding.  Replace `M-x foobar' in doc strings with
-;;;   `\\[foobar]'.
-;;; 2.78 - 
-;;;   lrd: (crypt-auto-write-answer-local): New internal variable.  Holds
-;;;   answer to query about file-extension tricks question per buffer.  Thanks
-;;;   to George Forman .  Remove Rod from list of
-;;;   maintainers...he's busy enough.  Merge multiple setq forms into single
-;;;   setq forms.
-;;; 2.79 -
-;;;   lrd: (crypt-y-or-n-p): New internal function for querying.  Tests the
-;;;   internal variable crypt-auto-write-answer-local to ensure single query.
-;;;   (crypt-check-extension-for-encoding): Replace all occurrences of queries
-;;;   involving y-or-no-p constructs with crypt-y-or-n-p.
-;;; 2.80 - [posted to gnu.emacs.sources]
-;;;   lrd: (crypt-set-encryption-key): Shorten interactive prompt.  Change
-;;;   documentation.
-;;; 2.81 - 
-;;;   lrd: (crypt-variable-list): Add shell and path variables.
-;;;   (crypt-confirm-password): Fix spelling error in doc.
-;;; 2.82 - 
-;;;   lrd: Applied patch from Noah Friedman . 
-;;;   (crypt-encoded-disable-auto-save, crypt-encrypted-disable-auto-save):
-;;;   New user-defined variables. (crypt-encoded-mode, crypt-encrypted-mode):
-;;;   Use them.
-;;; 2.83 -
-;;;   hniksic: Added custom.
-
-
-;;; Code:
-
-;;;; User definable variables.
-
-(progn
-  (defgroup crypt nil
-    "Handling compressed and encrypted files."
-    :group 'compression)
-  )
-
-(defcustom crypt-encryption-type 'crypt
-  "*Method of encryption.  Must be an element of `crypt-encryption-alist.'
-If you change this after crypt++ is loaded then do \\[crypt-rebuild-tables]."
-  :type 'symbol
-  :group 'crypt)
-
-(defcustom crypt-encryption-file-extension nil
-  "*Regexp for extension of files encrypted with `crypt-encryption-type.'
-Should be of the form \"\\\\(\\\\.foo\\\\)$\".  nil says use default values in
-`crypt-encryption-alist.'  If you change this after crypt++ is loaded then do
-\\[crypt-rebuild-tables]."
-  :type 'regexp
-  :group 'crypt)
-
-(defcustom crypt-never-ever-decrypt nil
-  "*t says never attempt to decrypt a buffer."
-  :type 'boolean
-  :group 'crypt)
-
-(defcustom crypt-auto-write-buffer-encrypted nil
-  "*t says files with `crypt-encryption-alist' file extension auto-encrypted.
-nil says query.  See `crypt-auto-write-buffer.'"
-  :type 'boolean
-  :group 'crypt)
-
-(defcustom crypt-confirm-password nil
-  "*t says confirm new passwords and when writing a newly encrypted buffer."
-  :type 'boolean
-  :group 'crypt)
-
-(defcustom crypt-encoded-disable-auto-save t
-  "*If t, turn off auto-save-mode for buffers which are encoded.
-If non-nil but not t, then no message is displayed.
-
-The default is t is because there isn't any way to tell emacs to encode the
-autosave file, so the autosave would be in a different format from the
-original.  The disadvantage of turning off autosaves is that any work you
-do in that buffer will be completely lost if the changes are not explicitly
-saved.
-
-It is probably best to set this variable to nil and use buffer-local
-variables in files for which you don't actually care about autosaves.
-Unencoded recovery data is better than none at all."
-  :type '(choice (const :tag "on" t)
-		 (const :tag "off" nil)
-		 (const :tag "no message" other))
-  :group 'crypt)
-
-(defcustom crypt-encrypted-disable-auto-save t
-  "*If t, turn off auto-save-mode for buffers which are encrypted.
-If non-nil but not t, then no message is displayed.
-
-The default is t is because there isn't any way to tell emacs to encrypt
-the autosave file, so the autosave would be in cleartext form.  The
-disadvantage of turning off autosaves is that any work you do in that
-buffer will be completely lost if the changes are not explicitly saved.
-
-You might consider setting this variable to nil and use buffer-local
-variables in files for which security is more important than data
-recovery."
-  :type '(choice (const :tag "on" t)
-		 (const :tag "off" nil)
-		 (const :tag "no message" other))
-  :group 'crypt)
-
-;;; ENCRYPTION
-
-;;; Encrypted files have no magic number, so we have to hack a way of
-;;; determining when a buffer should be decrypted.  we do this only buffers
-;;; that match a MAGIC-REGEXP very close to beginning of buffer and that do
-;;; _NOT_ match a MAGIC-REGEXP-INVERSE.
-;;;  
-;;; Currently MAGIC-REGEXP matches non-ASCII characters and
-;;; MAGIC-REGEXP-INVERSE will match Sun OS, 4.x BSD, and Ultrix executable
-;;; magic numbers, so binaries can still be edited (heh) without headaches.
-
-(defconst crypt-encryption-magic-regexp "[\000\200-\237]"
-  "Regexp that must be found very close to beginning of encrypted buffer.
-This is intended to be an internal variable \(not user-visible\).  If you
-change this after crypt++ is loaded then do \\[crypt-rebuild-tables].")
-
-(defconst crypt-encryption-magic-regexp-inverse
-  "\\`\201\001\\|^\\(..\\)?\\([\007\010\013]\001\\|\001[\007\010\013]\\)"
-  "Regexp that must *not* be found very close to beginning of encrypted buffer.
-This is intended to be an internal variable \(not user-visible\).  If you
-change this after crypt++ is loaded then do \\[crypt-rebuild-tables].")
-
-(defconst crypt-magic-search-limit 100
-  "Limit of regular expression search used to recognize encrypted files.
-Maximum position in file for presence of `crypt-encryption-magic-regexp' and
-absence of `crypt-encryption-magic-regexp-inverse'.")
-
-(defun crypt-build-encryption-alist ()
-  ;; Returns the encryption alist
-  (list
-   ;; crypt
-   (list 'crypt
-         crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
-         (or crypt-encryption-file-extension "\\(\\.e\\)$")
-         "crypt" "crypt"
-         nil
-         nil
-         "Crypt"
-         nil
-         t
-         )
-   ;; DES (Cipher Block Chaining - CBC) [DES' default]
-   (list 'des
-         crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
-         (or crypt-encryption-file-extension "\\(\\.des\\)$")
-         "des" "des"
-         '("-e" "-k")
-         '("-d" "-k")
-         "DES-CBC"
-         nil
-         t
-         )
-   ;; DES (Electronic Code Book - ECB)
-   (list 'des-ecb
-         crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
-         (or crypt-encryption-file-extension "\\(\\.des\\)$")
-         "des" "des"
-         '("-e" "-b" "-k")
-         '("-d" "-b" "-k")
-         "DES-ECB"
-         nil
-         t
-         )
-   ;; PGP
-   (list 'pgp
-         crypt-encryption-magic-regexp crypt-encryption-magic-regexp-inverse
-         (or crypt-encryption-file-extension "\\(\\.pgp\\)$")
-         "pgp" "pgp"
-         '("+batchmode" "+verbose=0" "-c" "-f" "-z")
-         '("+batchmode" "+verbose=0" "-f" "-z")
-         "PGP"
-         nil
-         t
-         )
-   ;; Add new elements here ...
-   ))
-
-(defconst crypt-encryption-alist (crypt-build-encryption-alist)
-  "List of elements describing the encryption methods available.
-each element looks like
-
-        \(ENCRYPTION-TYPE
-          MAGIC-REGEXP MAGIC-REGEXP-INVERSE
-          FILE-EXTENSION
-          ENCRYPT-PROGRAM DECRYPT-PROGRAM
-          ENCRYPT-ARGS
-          DECRYPT-ARGS
-          MINOR-MODE
-          GARBAGE-REGEXP-OR-LISPEXP
-          FILE-EXTENSION-TRICKS
-         \)
-
-ENCRYPTION-TYPE is a symbol denoting the encryption type.
-
-MAGIC-REGEXP regexp that must match very close to the beginning of an
-encrypted buffer.  This may also be some elisp expression to be evaluated at
-\(point-min\) that will return t for an encrypted buffer.  If this is set to
-nil then crypt++ will never try to decrypt a buffer.  Currently set to the
-internal variable `crypt-encryption-magic-regexp' which will match non-ASCII
-characters.
-
-MAGIC-REGEXP-INVERSE regexp that must _NOT_ match very close to the beginning
-of an encrypted buffer.  This may also be some elisp expression to be
-evaluated at \(point-min\) that will return t for a NON-encrypted buffer.
-If this is set to t then crypt++ will never try to decrypt a buffer.
-Currently set to the internal variable `crypt-encryption-magic-regexp-inverse'
-which will match Sun OS, 4.x BSD, and Ultrix executable magic numbers, so
-binaries can still be edited (heh) without headaches.
-
-FILE-EXTENSION regexp denoting the file extension usually appended the
-filename of files encrypted with ENCRYPT-PROGRAM.  The variable
-`crypt-encryption-file-extension' will over ride the default.
-
-ENCRYPT-PROGRAM name of executable file to be used for encryption.
-
-DECRYPT-PROGRAM name of executable file to be used for decryption.
-
-ENCRYPT-ARGS arguments to be passed to ENCRYPT-PROGRAM may be a string or a
-list of strings or nil.
-
-DECRYPT-ARGS arguments to be passed to DECRYPT-PROGRAM may be a string or a
-list of strings or nil.
-
-MINOR-MODE string denoting the name for the encrypted minor mode as it will
-appear in the mode line.
-
-GARBAGE-REGEXP-OR-LISPEXP dummy variable for compatibility with encoding.
-
-FILE-EXTENSION-TRICKS is t or nil depending on whether or not tricks
-converting between different encryption types can be done based on
-FILE-EXTENSION; typically t.
-")
-
-
-;;; ENCODING 
-
-(defcustom crypt-auto-decode-buffer t
-  "*t says buffers visiting encoded files will be decoded automatically.
-nil means to ask before doing the decoding."
-  :type 'boolean
-  :group 'crypt)
-
-(defcustom crypt-auto-write-buffer nil
-  "*t says save files with `crypt-encoding-alist' file extensions as encoded.
-nil says to ask before doing this encoding.  Similarly, buffers originating
-from encoded files to be written to files not ending in `crypt-encoding-alist'
-file extensions will be written in plain format automatically.  nil says to
-ask before doing this decoding."
-  :type 'boolean
-  :group 'crypt)
-
-;; This is an internal variable documented here and not in a DOCSTRING in
-;; order to save memory.  If this variable's value has been changed from its
-;; default, then it contains the answer to the question "Write out buffer
-;; foobar using `compression-type'?".  This question is asked only if *plain*
-;; buffer foobar is being written to disk *and* it has a provocative
-;; `compression-type' file-name extension (see DOCSTRING for variable
-;; crypt-auto-write-buffer).  The variable is local to all buffers with a
-;; default value of 'ask so if the situation described above arises, then the
-;; question is asked at least once, unless the user-defined variable
-;; crypt-auto-write-buffer is non-nil.
-(defvar crypt-auto-write-answer-local 'ask)
-(make-variable-buffer-local 'crypt-auto-write-answer-local)
-(setq-default crypt-auto-write-answer-local 'ask)
-(put 'crypt-auto-write-answer-local 'permanent-local t) ; for v19 Emacs
-(put 'crypt-auto-write-answer-local 'preserved t)       ; for kill-fix.el
-
-(defcustom crypt-query-if-interactive t
-  "*t says ask when saving buffers where `crypt-encoded-mode' was toggled.
-nil says that even if filename extension is plain (i.e., not listed in
-`crypt-encoding-alist') buffer will be written in an encoded format without
-asking.
-
-This variable is designed for users that edit a plain file (with plain
-extension) and then toggle `(crypt-encoded-mode)' and do not wish to be
-queried every time that they save the buffer.
-
-NOTE: if `(crypt-encoded-mode)' was not called interactively (the usual
-scenario) then the value of this variable has no effect on how the buffer is
-written to disk.  In such a case `crypt-no-extension-implies-plain' is then
-the relevant variable."
-  :type 'boolean
-  :group 'crypt)
-
-(defcustom crypt-no-extension-implies-plain t
-  "*t says file extensions not in `crypt-encoding-alist' may be written plain.
-if `crypt-auto-write-buffer' is also t then any file ending in a plain
-extension is written in plain format automatically, otherwise query user.
-
-nil says user works with encoded (compressed) files without file extensions
-and will not be queried each time they save these files.
-
-NOTE: (1) this does not effect find-file (C-x C-f) since that works with a
-magic regexp.  (2) there is no way to distinguish between write-file and
-save-buffer so nil will mean that neither will query."
-  :type 'boolean
-  :group 'crypt)
-
-(defcustom crypt-freeze-vs-fortran t
-  "*t says `.F' file extension denotes a frozen file not a Fortran file.
-If you change this variable after crypt++ has been loaded then do
-\\[crypt-rebuild-tables]."
-  :type 'boolean
-  :group 'crypt)
-
-(defcustom crypt-compact-vs-C++ nil
-  "*t says `.C' file extension denotes a compacted file not a C++ file.
-If you change this variable after crypt++ has been loaded then do
-\\[crypt-rebuild-tables]."
-  :type 'boolean
-  :group 'crypt)
-
-(defcustom crypt-ignored-filenames nil
-  "*List of regexp filenames for which encoded to plain conversion is not done.
-A filename with a plain extension, in encoded format, that is matched by one of
-these elements will be saved in encoded format without a query for conversion to
-plain format.
-
-This variable is provided for users that want to compress their incoming mail
-for RMAIL and VM which look for files `RMAIL' and `INBOX,' respectively, to
-store incoming mail.  For example, the gzip extensions on `RMAIL.gz' and
-`INBOX.gz' can be removed, this variable set to '\(\"INBOX$\" \"RMAIL$\"\) and
-no query about conversion to plain format will be made."
-  :type '(repeat regexp)
-  :group 'crypt)
-
-(defcustom crypt-default-encoding "gzip"
-  "*Default encoding type as string used when `crypt-encoded-mode' is toggled.
-Must match one of the elements of `crypt-encoding-alist'."
-  :type 'string
-  :group 'crypt)
-
-(defcustom crypt-dos-has-ctrl-z nil
-  "t if this buffer had a ctrl-z stripped from end, otherwise, nil.
-Buffer local and set by `crypt-dos-to-unix-region'"
-  :type 'boolean
-  :group 'crypt)
-(make-variable-buffer-local 'crypt-dos-has-ctrl-z)
-(setq-default crypt-dos-has-ctrl-z nil)
-(put 'crypt-dos-has-ctrl-z 'permanent-local t) ; for v19 Emacs
-(put 'crypt-dos-has-ctrl-z 'preserved t)       ; for kill-fix.el
-
-(defun crypt-build-encoding-alist ()
-  ;; Returns the encoding alist
-  (list
-   ;; compress 
-   (list 'compress
-         "\037\235" nil
-         "\\(\\.Z\\)$"
-         "compress" "uncompress"
-         nil nil
-         "Compress"
-         nil
-         t)
-   ;; gzip (GNU zip)
-   (list 'gzip
-         "\037\213" nil
-         "\\.\\(tgz\\|g?z\\)$"
-         "gzip" "gzip"
-         "--quiet" "--decompress --quiet"
-         "Zip"
-         nil
-         t)
-   ;; bzip2
-   (list 'bzip2
-         "BZh" nil
-         "\\(\\.bz2\\)$"
-         "bzip2" "bzip2"
-         "" "--decompress"
-         "Bzip2"
-         nil
-         t)
-   ;; freeze
-   (list 'freeze
-         "\037\236\\|\037\237" nil
-         "\\(\\.F\\)$"
-         "freeze" "freeze"
-         "" "-d"
-         "Freeze"
-         nil
-         crypt-freeze-vs-fortran)
-   ;; compact
-   (list 'compact
-         "\377\037" nil
-         "\\(\\.C\\)$"
-         "compact" "uncompact"
-         nil nil
-         "Compact"
-         "^Compression *:.*\n"
-         crypt-compact-vs-C++)
-   ;; DOS
-   (list 'dos
-         "[^\n\r]*\r$" nil
-         "\\(\\.DOS\\)$"
-         'crypt-unix-to-dos-region 'crypt-dos-to-unix-region
-         nil nil
-         "Dos"
-         nil
-         nil)
-   ;; Add new elements here ...
-   ))
-
-(defconst crypt-encoding-alist (crypt-build-encoding-alist)
-  "List of elements describing the encoding methods available.
-each element looks like
-
-        \(ENCODING-TYPE
-          MAGIC-REGEXP MAGIC-REGEXP-INVERSE
-          FILE-EXTENSION
-          ENCODE-PROGRAM DECODE-PROGRAM
-          ENCODE-ARGS DECODE-ARGS
-          MINOR-MODE
-          GARBAGE-REGEXP-OR-LISPEXP
-          FILE-EXTENSION-TRICKS
-         \)
-
-ENCODING-TYPE is a symbol denoting the encoding type.  Currently known
-encodings are (compress compact freeze gzip).
-
-MAGIC-REGEXP is a regexp that matches the magic number at the
-beginning of files encoded with ENCODING-TYPE.
-
-MAGIC-REGEXP-INVERSE dummy variable for compatibility with encryption.
-
-FILE-EXTENSION is a string denoting the file extension usually
-appended the filename of files encoded with ENCODING-TYPE.
-
-ENCODE-PROGRAM is a string denoting the name of the executable used to
-encode files.
-
-DECODE-PROGRAM is a string denoting the name of the executable used to
-decode files.
-
-ENCODE-ARGS arguments to be passed to ENCODE-PROGRAM may be a string or a
-list of strings or nil.
-
-DECODE-ARGS arguments to be passed to DECODE-PROGRAM may be a string or a
-list of strings or nil.
-
-MINOR-MODE is a string denoting the name for the encoded minor mode as 
-it will appear in the mode line.
-
-GARBAGE-REGEXP-OR-LISPEXP is (1) a regexp that matches any extraneous text
-that is produced by the ENCODE-COMMAND including any newlines and will be
-removed from the buffer before saving to disk; (2) a lisp expression that will
-clean up extraneous material in the buffer or nil.  This is normally not
-needed but can be derived for any ENCODE-COMMAND by checking the standard
-error that results from `sh -c \"cat foo | ENCODE-COMMAND > bar\"'.
-
-FILE-EXTENSION-TRICKS is t or nil depending on whether or not tricks
-converting between different encoding types can be done based on
-FILE-EXTENSION; typically t.
-")
-
-(defvar crypt-inhibit-formats (when (featurep 'mule) '(dos))
-  "*A list of crypt abilities to turn off.  In particular, setting this 
-variable to be '(dos) will stop the dos-mode CRLF <-> LF damage.")
-
-
-;;; This allows the user to alter contents of the encoding and encryption
-;;; table variables without having to reload all of crypt++.
-(defun crypt-rebuild-tables ()
-  "Rebuilds the encryption and encoding tables and `minor-mode-alist'.
-Allows user to alter variables used in building these tables.  May be called
-interactively or in an initialization file.  Part of `after-init-hook'."
-  (interactive)
-  (setq crypt-encryption-alist (crypt-build-encryption-alist)
-        crypt-encoding-alist (crypt-build-encoding-alist))
-  (crypt-rebuild-minor-modes-alist))
-
-
-;;; Buffer locals.
-
-(defvar crypt-buffer-save-encrypted nil
-  "*non-nil says save buffer encrypted with `crypt-encryption-type.'
-local to all buffers.")
-(make-variable-buffer-local 'crypt-buffer-save-encrypted)
-(put 'crypt-buffer-save-encrypted 'permanent-local t) ; for v19 Emacs
-(put 'crypt-buffer-save-encrypted 'preserved t)       ; for kill-fix.el
-
-(defvar crypt-buffer-encryption-key nil
-  "*Key used for encryption of current buffer.  Local to all buffers.")
-(make-variable-buffer-local 'crypt-buffer-encryption-key)
-(put 'crypt-buffer-encryption-key 'permanent-local t) ; for v19 Emacs
-(put 'crypt-buffer-encryption-key 'preserved t)       ; for kill-fix.el
-
-(defvar crypt-buffer-save-encoded nil
-  "*non-nil says buffer will be saved encoded.  Local to all buffers.")
-(make-variable-buffer-local 'crypt-buffer-save-encoded)
-(put 'crypt-buffer-save-encoded 'permanent-local t)   ; for v19 Emacs
-(put 'crypt-buffer-save-encoded 'preserved t)         ; for kill-fix.el
-
-(defvar crypt-buffer-encoding-type nil
-  "*non-nil says buffer is encoded with ENCODING-TYPE.  Local to all buffers.")
-(make-variable-buffer-local 'crypt-buffer-encoding-type)
-(put 'crypt-buffer-encoding-type 'permanent-local t)  ; for v19 Emacs
-(put 'crypt-buffer-encoding-type 'preserved t)        ; for kill-fix.el
-
-(defvar crypt-buffer-interactive-encoded-mode nil
-  "t says `crypt-encoded-mode' was toggled interactively, almost always nil.
-Local to all buffers.")
-(make-variable-buffer-local 'crypt-buffer-interactive-encoded-mode)
-(put 'crypt-buffer-interactive-encoded-mode 'permanent-local t) ; v19 Emacs
-(put 'crypt-buffer-interactive-encoded-mode 'preserved t)       ; kill-fix.el
-
-
-;;; Functions and macros that search `crypt-encryption-alist' and
-;;; `crypt-encoding-alist'.
-
-(defun crypt-get-alist-member (type n)
-  ;; Returns TYPE's Nth element
-  (nth n (or (assoc type crypt-encryption-alist)
-             (assoc type crypt-encoding-alist))))
-
-(defmacro crypt-get-magic-regexp (type)
-  ;; Returns regexp found at top of files encoded/encrypted with TYPE.
-  (list 'crypt-get-alist-member type 1))
-
-(defmacro crypt-get-magic-regexp-inverse (type)
-  ;; Returns regexp *not* found at top of files encoded/encrypted with TYPE.
-  (list 'crypt-get-alist-member type 2))
-
-(defmacro crypt-get-file-extension (type)
-  ;; Returns regexp matching extension of files encoded/encrypted with TYPE.
-  (list 'crypt-get-alist-member type 3))
-
-(defmacro crypt-get-encoding-program (type)
-  ;; Returns name of program, as string, used to encode/encrypt with TYPE.
-  (list 'crypt-get-alist-member type 4))
-
-(defmacro crypt-get-decoding-program (type)
-  ;; Returns name of program, as string, used to decode/decrypt with TYPE.
-  (list 'crypt-get-alist-member type 5))
-
-(defmacro crypt-get-encoding-args (type)
-  ;; Returns arguments passed to program used to encode/encrypt with TYPE.
-  (list 'crypt-get-alist-member type 6))
-
-(defmacro crypt-get-decoding-args (type)
-  ;; Returns arguments passed to program used to decode/decrypt with TYPE.
-  (list 'crypt-get-alist-member type 7))
-
-(defmacro crypt-get-minor-mode-name (type)
-  ;; Returns minor mode name, as string, for encoding/encrypting with TYPE.
-  (list 'crypt-get-alist-member type 8))
-
-(defmacro crypt-get-cleanup-regexp (type)
-  ;; Returns regexp or lisp-exp for cleaning up encoding/encrypting with TYPE.
-  (list 'crypt-get-alist-member type 9))
-
-(defmacro crypt-get-extension-tricks (type)
-  ;; Returns t if file extension tricks doable for encoding/encrypting with
-  ;; TYPE.
-  (list 'crypt-get-alist-member type 10))
-
-(defun crypt-buffer-save-name (type)
-  ;; Returns variable `crypt-buffer-save-TYPE', set to t if encoding with TYPE.
-  ;; local to all buffers.
-  (intern (concat "crypt-buffer-save-" (symbol-name type))))
-
-
-;;; Create a buffer-local variable for each type of encoding.
-;;; These variables are used to trigger the minor mode names.
-
-(defun crypt-build-minor-mode-alist ()
-  ;; Returns minor mode alist entries for encoded and encrypted buffers.
-  (append
-   ;; First the encrypted minor mode -- only one.
-   (list (list 'crypt-buffer-save-encrypted
-               (concat " " (crypt-get-minor-mode-name crypt-encryption-type))))
-   ;; Now the encoding minor modes.
-   (mapcar
-    (function
-     (lambda (element)
-       (let ((variable (crypt-buffer-save-name (car element))))
-         (make-variable-buffer-local variable)
-         (put variable 'permanent-local t) ; for v19 Emacs
-         (put variable 'preserved t)       ; for kill-fix.el
-         (list variable
-               (concat " " (crypt-get-minor-mode-name (car element)))))))
-    crypt-encoding-alist)))
-
-(defconst crypt-minor-mode-alist (crypt-build-minor-mode-alist)
-  "Alist containing encoded and encrypted minor modes.
-Derived from variable `crypt-encoding-alist' and function
-`crypt-build-minor-mode-encrypted'")
-
-(defun crypt-rebuild-minor-modes-alist ()
-  ;; Rebuilds the encryption and encoding minor modes and `minor-mode-alist.'
-  ;; Allows user to alter variables used in building this alist. Called by
-  ;; `crypt-rebuild-tables' and so part of `after-init-hook'."
-
-  ;; First remove old crypt minor mode entries from `minor-mode-alist'.
-  (if (memq (car crypt-minor-mode-alist) minor-mode-alist)
-      (let ((alist crypt-minor-mode-alist) elt)
-        (while (and alist (setq elt (car alist)))
-          (setq minor-mode-alist (delq elt minor-mode-alist)
-                alist (cdr alist)))))
-
-  ;; Get new crypt minor mode entries and add to minor-mode-alist.
-  (setq crypt-minor-mode-alist (crypt-build-minor-mode-alist)
-        minor-mode-alist (append crypt-minor-mode-alist minor-mode-alist)))
-
-
-(defmacro crypt-save-point (&rest body)
-  ;; Save value of point, evaluate FORMS, and restore value of point.  If the
-  ;; saved value of point is no longer valid go to (point-max).  This macro
-  ;; exists because, save-excursion loses track of point during some types of
-  ;; deletions.
-  (let ((var (make-symbol "saved-point")))
-    (list 'let (list (list var '(point)))
-          (list 'unwind-protect
-                (cons 'progn body)
-                (list 'goto-char var)))))
-
-
-(defun crypt-find-file-hook ()
-
-  ;; Hook run for decoding and/or decrypting the contents of a buffer.  Meant
-  ;; to be called as part of `find-file-hooks'
-
-  (let ((buffer-file-name buffer-file-name)
-        (old-buffer-file-name buffer-file-name)
-        (old-buffer-modified-p (buffer-modified-p))
-        (case-fold-search nil) ; case-sensitive
-        encrypted encoded buffer-read-only)
-
-    ;; DECODE AND/OR DECRYPT
-    (crypt-save-point
-
-     ;; Do we have to DECODE? If not, then move on.
-     (if (and (crypt-encoded-p)
-              (or crypt-auto-decode-buffer
-                  (y-or-n-p (format "Decode %s? " (buffer-name)))))
-
-         ;; Decode, uncompress, the buffer.
-         (progn
-         
-         (if (and (not (null buffer-file-name))
-                  (string-match "\\.Z$" buffer-file-name))
-             (set-visited-file-name
-              (substring buffer-file-name 0 (match-beginning 0)))
-           (if (and (not (null buffer-file-name))
-                    (string-match "\\.gz$" buffer-file-name))
-               (set-visited-file-name
-                (substring buffer-file-name 0 (match-beginning 0))))
-	   (if (and (not (null buffer-file-name))
-		    (string-match "\\.tgz$" buffer-file-name))
-	       (set-visited-file-name
-		(concat (substring buffer-file-name 0 (match-beginning 0)) ".tar")))
-           (if (and (not (null buffer-file-name))
-                    (string-match "\\.bz2$" buffer-file-name))
-               (set-visited-file-name
-                (substring buffer-file-name 0 (match-beginning 0)))))
-           (message "Decoding %s..." (buffer-name))
-           (crypt-encode-buffer t)
-
-           ;; Store the encoding mode.
-
-           ;; We can not yet go into the minor modes because the major mode
-           ;; may change later on and blow away all local variables (and thus
-           ;; the minor modes).  Only needed for vanilla v18.  Our
-           ;; buffer-locals defined 'permanent-local for v19 Emacs and
-           ;; 'preserved for kill-fix.el.
-
-           (setq encoded crypt-buffer-encoding-type)
-
-           ;; Strip encoded file's extension so later we can set buffer's
-           ;; major mode based on its file-name sans encoding extension.
-           (if (string-match (crypt-get-file-extension
-                              crypt-buffer-encoding-type) buffer-file-name)
-               (setq buffer-file-name
-                     (substring buffer-file-name 0 (match-beginning 1))))
-
-           ;; Decoding ends.
-           (if (not (input-pending-p))
-               (message "Decoding %s... done" (buffer-name)))))
-
-     ;; Do we have to DECRYPT? If not, then move on.
-     (if (crypt-encrypted-p)
-
-         ;; Decrypt buffer.
-         (progn
-                 
-           (message "Decrypting %s..." (buffer-name))
-           (crypt-encrypt-buffer crypt-buffer-encryption-key t)
-                 
-           ;; Save key in case major mode blows all buffer-locals. 
-
-           ;; Only needed for vanilla v18.  Our buffer-locals defined
-           ;; 'permanent-local for v19 Emacs and 'preserved for
-           ;; kill-fix.el.
-               
-           (setq encrypted crypt-buffer-encryption-key)
-                 
-           ;; Strip encrypted file's extension so later we can set buffer's
-           ;; major mode based on its file-name sans encrypting extension.
-           (if (and (crypt-get-extension-tricks crypt-encryption-type)
-                    (string-match (crypt-get-file-extension
-                                   crypt-encryption-type) buffer-file-name))
-               (setq buffer-file-name
-                     (substring buffer-file-name 0 (match-beginning 1))))
-
-           (if (not (input-pending-p))
-               (message "Decrypting %s... done" (buffer-name))))))
-
-    ;; MAJOR AND MINOR MODES
-
-    ;; OK, if any changes have been made to the buffer we need to rerun the
-    ;; code the does automatic selection of major mode.
-
-    (if (or encoded encrypted)
-
-        (progn
-
-          ;; Set the major mode.
-          (set-auto-mode)
-          (hack-local-variables)
-          
-          ;; Now set our own minor mode(s).
-          (if encoded
-              ;; Recover encoding type, may have been smashed by major mode,
-              ;; and toggle encoded mode.
-              (progn (setq crypt-buffer-encoding-type encoded)
-                     (crypt-encoded-mode 1)))
-          
-          (if encrypted
-              ;; Recover encryption key, may have been smashed by major mode,
-              ;; and toggle encrypted mode.
-              (progn (setq crypt-buffer-encryption-key encrypted)
-                     (crypt-encrypted-mode 1)))
-          
-          ;; Restore buffer file name now, so that lock file entry is removed
-          ;; properly.
-          (setq buffer-file-name old-buffer-file-name)
-          
-          ;; Restore buffer modified flag to its previous value.  Will also
-          ;; remove lock file entry for buffer if previous value was nil.
-          ;; This is why buffer-file-name had to be restored manually above.
-          (set-buffer-modified-p old-buffer-modified-p)))))
-
-(defun crypt-encoded-p (&optional buffer)
-  ;; Returns t if current buffer, or optionally BUFFER, is encoded.
-  ;; Sets `crypt-buffer-encoding-type' to encoding method.
-  (save-excursion
-    (and buffer (set-buffer buffer))
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (let ((alist crypt-encoding-alist) elt found)
-        (while (and alist (setq elt (car alist)) (not found))
-          (if (and (looking-at (nth 1 elt))
-		   (not (memq (nth 0 elt) crypt-inhibit-formats)))
-              (setq crypt-buffer-encoding-type (nth 0 elt)
-                    found t)
-            ;; Decrement
-            (setq alist (cdr alist))))
-        found))))
-
-(defun crypt-encrypted-p (&optional buffer)
-  ;; Returns t if current buffer, or optionally BUFFER, is encrypted.
-  ;; Look for MAGIC-REGEXP and absence of MAGIC-REGEXP-INVERSE.  If so, then
-  ;; assume it is an encrypted buffer.
-  ;; Sets `crypt-buffer-encryption-key' to password if not set already.
-
-  ;; Do not try to decrypt buffer if not wanted.
-  (if (not crypt-never-ever-decrypt)
-
-      (save-excursion
-        (and buffer (set-buffer buffer))
-
-        (save-restriction
-          (widen)
-          (goto-char (point-min))
-
-          (let ((magic-regexp (crypt-get-magic-regexp crypt-encryption-type))
-                (magic-regexp-inverse (crypt-get-magic-regexp-inverse
-                                       crypt-encryption-type))
-                (limit (min (point-max) crypt-magic-search-limit)))
-
-            ;; Check all encryption conditions.  If any fail, then return nil
-            ;; value of this if-form, else check for password.
-            (if (and
-
-                 ;; Check for existence of MAGIC-REGEXP.
-                 (if (stringp magic-regexp)
-                     ;; regular expression
-                     (re-search-forward magic-regexp limit t)
-                   ;; lisp expression
-                   (eval magic-regexp))
-
-                 (goto-char (point-min))
-
-                 ;; Check for absence of MAGIC-REGEXP-INVERSE.
-                 (not (if (stringp magic-regexp-inverse)
-                          ;; regular expression
-                          (re-search-forward magic-regexp-inverse limit t)
-                        ;; lisp expression
-                        (eval magic-regexp-inverse))))
-
-                (progn
-
-                  ;; Get key, i.e., the password?
-                  (or crypt-buffer-encryption-key
-                      ;; Do not confirm on reading an encrypted file.
-                      (let ((crypt-confirm-password nil))
-                        (call-interactively 'crypt-set-encryption-key)))
-             
-                  ;; Do not turn on encryption mode if no key: may be a binary
-                  ;; file.  Thanks to Paul Dworkin (paul@media-lab.media.mit.edu).
-                  (if (equal crypt-buffer-encryption-key "")
-                      ;; Return nil.
-                      (progn
-                        (message "No key given.  Assumed normal.")
-                        nil)
-                    ;; Return t.
-                    t))))))))
-
-
-;;; 
-
-(defun crypt-check-extension-for-encoding ()
-
-  ;; Checks file extensions for possible toggling of encoding modes.  Used for
-  ;; buffers to be written to disk and called by `crypt-write-file-hook'
-
-  ;; We try to flag a buffer to be written out in encoded form if the file
-  ;; ends in one of the file-extensions in `crypt-encoding-alist' even if
-  ;; `crypt-buffer-save-encoded' is nil.  Conversely, we try to write out a
-  ;; buffer as a plain file if it does _not_ end in one of these
-  ;; file-extensions even if `crypt-buffer-save-encoded' is non-nil.
-  
-  (let ((alist crypt-encoding-alist)
-        (case-fold-search nil)
-        found elt)
-
-    ;; Search through the file name extensions for a match.
-    (while (and alist (setq elt (car alist)) (not found))
-      (if (string-match (nth 3 elt) buffer-file-name)
-          (setq found t)
-        ;; Decrement.
-        (setq alist (cdr alist))))
-    
-    ;; Did we find a match? 
-    (if found
-        
-        ;; File name ends in a very provocative extension.
-
-        ;; Check to see if already an encoded file.
-        (if crypt-buffer-save-encoded
-            
-            ;; Already encoded - do the methods of encoding match?
-            (if (not (eq (nth 0 elt) crypt-buffer-encoding-type))
-                 
-                ;; A new encoding method is desired.
-
-                ;; Can we play some filename extension tricks with the 
-                ;; destination extension?
-                (if (crypt-get-extension-tricks (nth 0 elt))
-
-                    ;; Can play tricks.
-                    ;; Change the method of encoding?
-                    (if (crypt-y-or-n-p (format "Write %s using %s? "
-                                         (buffer-name) (nth 4 elt)))
-                
-                        ;; Case one.
-                        ;; Turn off original encoding and turn on new encoding.
-                        (progn (crypt-encoded-mode -1)
-                               (setq crypt-buffer-encoding-type (nth 0 elt))
-                               (crypt-encoded-mode 1)))
-
-                  ;; Can not play tricks - maybe wants a plain file?
-                  (if (crypt-y-or-n-p (format "Write %s a plain file? "
-                                              (buffer-name)))
-
-                      ;; Case three.
-                      ;; Turn off the minor mode and _then_ the flags.
-                      (progn
-                        (crypt-encoded-mode -1)
-                        (setq crypt-buffer-save-encoded nil
-                              crypt-buffer-encoding-type nil)))))
-          
-          ;; Was a plain file.
-          (if (and
-               ;; Can we play some filename extension tricks?
-               ;; If not then we must abort.
-               (crypt-get-extension-tricks (nth 0 elt))
-
-               (crypt-y-or-n-p (format "Write %s using %s? "
-                                       (buffer-name) (nth 4 elt))))
-              
-              ;; Case two.
-              ;; Turn on encoding flags and _then_ the minor mode.
-              (progn 
-                (setq crypt-buffer-save-encoded t
-                      crypt-buffer-encoding-type (nth 0 elt))
-                (crypt-encoded-mode 1))))
-      
-      ;; No match - a plain-jane file extension - but if the encoded flag is
-      ;; non-nil then the user may really want it written out in plain
-      ;; format so we must override this flag.
-      (if (and crypt-buffer-save-encoded
-               
-               ;; Search the list of files to be ignored.
-               ;; If `crypt-ignored-filenames' is nil then this let form 
-               ;; will return t.  If a match is found this form will return 
-               ;; nil.  Otherwise it will return t.
-               (let ((tlist crypt-ignored-filenames)
-                     case-fold-search found elt)
-
-                 ;; Search through the list of filenames for a match.
-                 (while (and tlist (setq elt (car tlist)) (not found))
-                   (if (string-match elt buffer-file-name)
-                       (setq found t)
-                     ;; Decrement.
-                     (setq tlist (cdr tlist))))
-                 
-                 ;; Return t if we can _not_ find a match.
-                 (not found))
-
-               ;; If `(crypt-encoded-mode)' was called interactively, then
-               ;; there is a high probability that no matter what the file
-               ;; name extension the user wishes to write the file out in some
-               ;; encoded format.  Thanks to Kimball Collins
-               ;;  for pointing out the need for
-               ;; this.  Unfortunately, still can not distinguish between
-               ;; write-file and save-buffer.  In the former the user may want
-               ;; to write in plain format (or indeed some other format).
-               
-               (if crypt-buffer-interactive-encoded-mode
-                   ;; Interactive
-                   crypt-query-if-interactive 
-                 ;; Non-interactive but still may want encoded format.
-                 crypt-no-extension-implies-plain)
-
-               (crypt-y-or-n-p (format "Write %s as a plain file? "
-                                       (buffer-name))))
-
-          ;; Case three.
-          ;; Turn off the minor mode and _then_ the flags.
-          (progn
-            (crypt-encoded-mode -1)
-            (setq crypt-buffer-save-encoded nil
-                  crypt-buffer-encoding-type nil))))))
-
-
-(defun crypt-y-or-n-p (prompt)
-  ;; Queries user based on `crypt-auto-write-buffer' and internal buffer-local
-  ;; variable `crypt-auto-write-answer-local'.  Returns value of
-  ;; `crypt-auto-write-answer-local', which is t or nil.
-
-  ;; Check if we need to ask user.  Should be 'ask, nil, or t.
-  (if (eq crypt-auto-write-answer-local 'ask) ; Default value.
-      ;; We may need to ask.
-      (or crypt-auto-write-buffer
-          ;; Ask and store the answer.  
-          ;; Note: we only store if we asked.
-          (setq crypt-auto-write-answer-local (y-or-n-p prompt)))
-    ;; Use previous answer.
-    crypt-auto-write-answer-local)) ; Will be nil or t.
-
-
-;;; This function should be called ONLY as a write-file hook.
-;;; Odd things will happen if it is called elsewhere.
-
-(defun crypt-write-file-hook ()
-  
-  ;; Hook for possibly writing out file, and backup file, in a non-plain
-  ;; format.  Terminates calls in `write-file-hooks' and should be at end of
-  ;; list.
-
-  ;; Check file-extension for possible toggling of encoding modes.
-  (crypt-check-extension-for-encoding)
-
-  ;; Check extension for encryption.
-  (if (and
-
-       ;; Maybe file ends with provocative extension w.r.t. encryption?
-       (stringp (crypt-get-file-extension crypt-encryption-type))
-       (let ((case-fold-search nil)) ; Make case-sensitive.
-         (string-match (crypt-get-file-extension crypt-encryption-type)
-                       buffer-file-name))
-       
-       ;; Can we play tricks?
-       (crypt-get-extension-tricks crypt-encryption-type)
-
-       ;; Match of filename extension - is file in plain format?
-       (not crypt-buffer-save-encrypted)
-       
-       ;; Query?
-       (or crypt-auto-write-buffer-encrypted
-           (y-or-n-p
-            (format "Write %s as an encrypted file? " (buffer-name)))))
-
-      (progn
-        ;; Set password and toggle `crypt-encrypted-mode'
-        (call-interactively 'crypt-set-encryption-key)
-        (crypt-encrypted-mode 1)))
-
-  ;; Now decide whether or not we need to continue with this defun. Does the
-  ;; buffer need to be saved in a non-plain form?  If not then writing is not
-  ;; done here but later in the write-file-hooks - probably at the end.
-
-  (if (or crypt-buffer-save-encoded crypt-buffer-save-encrypted)
-      
-      (save-excursion
-        (save-restriction
-
-          (let 
-              
-              ;; BINDINGS
-              ((copy-buffer (get-buffer-create " *crypt copy buffer*"))
-               (selective-display selective-display)
-               (buffer-read-only))
-            
-            ;; FORMS
-            (copy-to-buffer copy-buffer 1 (1+ (buffer-size)))
-            (narrow-to-region (point) (point))
-            
-            (unwind-protect
-                
-                ;; BODYFORM
-                (let (setmodes)
-
-                  ;; As of v19, if one of functions of the `write-file-hooks'
-                  ;; returns a non-nil value, then `basic-save-buffer' no
-                  ;; longer creates a backup file.  We must do it ourselves. 
-                  ;; this should be a no-op in v18.
-                  (or buffer-backed-up
-                      (setq setmodes (backup-buffer)))
-
-                  (insert-buffer-substring copy-buffer)
-                  (kill-buffer copy-buffer)
-                  
-                  ;; "Who would cross the Bridge of Death
-                  ;;  Must answer me
-                  ;;  These questions three
-                  ;;  Ere the other side he see."
-                  ;;
-                  ;; Bridgekeeper from Monty Python and the Holy Grail
-                  
-                  ;; [1] selective-display non-nil means we must convert
-                  ;; carriage returns to newlines now, and set the variable
-                  ;; selective-display temporarily to nil.
-                  (if selective-display
-                      (progn
-                        (goto-char (point-min))
-                        (subst-char-in-region (point-min) (point-max) ?\r ?\n)
-                        (setq selective-display nil)))
-                  
-                  ;; [2] encryption
-                  (if crypt-buffer-save-encrypted
-                      (progn
-                        ;; check for password
-                        (if (not crypt-buffer-encryption-key)
-                            (call-interactively 'crypt-set-encryption-key))
-                        (if (null crypt-buffer-encryption-key)
-                            (error "No encryption key set for buffer %s"
-                                   (buffer-name)))
-                        (if (not (stringp crypt-buffer-encryption-key))
-                            (error "Encryption key is not a string"))
-                        (message "Encrypting %s..." (buffer-name))
-                        (crypt-encrypt-buffer crypt-buffer-encryption-key)))
-                  
-                  ;; [3] encoding
-                  (if crypt-buffer-save-encoded
-                      (progn
-                        (message "Encoding %s..." (buffer-name))
-                        (crypt-encode-buffer)))
-                  
-                  ;; Now write buffer/region to disk.
-                  (write-region (point-min) (point-max) buffer-file-name nil t)
-                  (delete-region (point-min) (point-max))
-                  (set-buffer-modified-p nil)
-                  
-                  ;; Now that the file is written, set its modes.
-                  (if setmodes
-                      (condition-case ()
-                          (set-file-modes buffer-file-name setmodes)
-                        (error nil)))
-
-                  ;; Return t so that `basic-save-buffer' will know that the
-                  ;; save has already been done.
-                  
-                  ;; NOTE: this TERMINATES write-file-hooks so any hooks
-                  ;; following this one will not be executed.
-                  
-                  t )
-
-              ;; UNWINDFORMS
-              ;; unwind...sit back...take a load off...have a beer 
-
-              ;; If the encoded and encrypted stuff has already been removed
-              ;; then this is a no-op.  This form is executed if BODYFORM
-              ;; completes normally but the value of BODYFORM is returned -
-              ;; i.e., t is returned.
-
-              (delete-region (point-min) (point-max))))))))
-
-              
-;;;; ENCRYPTION
-
-(defun crypt-encrypt-region (start end key &optional decrypt)
-  "Encrypt region START to END using KEY and `crypt-encryption-type'.  When
-called interactively START and END default to point and mark \(START being the
-lesser of the two\), and KEY is prompted for.  With optional DECRYPT non-nil,
-decryption is done."
-
-  (interactive
-   (let (decrypt)
-     (barf-if-buffer-read-only)
-     (list (region-beginning)
-           (region-end)
-           (crypt-read-string-no-echo
-            (concat (if (setq decrypt (y-or-n-p "Decrypt region? ")) "De" "En")
-                    "crypt buffer using key: ")
-            ;; Do not confirm on decrypting region.
-            (if (not decrypt) crypt-confirm-password))
-           decrypt)))
-
-  (crypt-save-point
-
-   ;; We define the PROGRAM as the encryption program or decryption program
-   ;; listed for `crypt-encryption-type' of `crypt-encryption-alist.'  These
-   ;; should be just the name of the executable and should _not_ contain any
-   ;; arguments.  `(call-process-region)' would be confused if we tried to
-   ;; pass the arguments as part of the PROGRAM.  The arguments are passed
-   ;; through the encryption args or decryption args listed for
-   ;; `crypt-encryption-type' of `crypt-encryption-alist.'
-
-   ;; Thanks to Joe Ilacqua  and others for pointing out
-   ;; an error that occurs with some encryption programs (e.g., the crypt from
-   ;; Sun Microsystems, HPUX-8, and BSD) if `args' is `"".'  This will allow
-   ;; nil values and lists of strings for argument.
-
-   (let (prog args)
-
-     ;; Get the proper program and arguments.
-     (if decrypt
-         (setq prog (crypt-get-decoding-program crypt-encryption-type)
-               args (crypt-get-decoding-args crypt-encryption-type))
-       (setq prog (crypt-get-encoding-program crypt-encryption-type)
-             args (crypt-get-encoding-args crypt-encryption-type)))
-     
-     ;; Check arguments.
-     (cond
-
-      ;; nil or "" args - don't pass.
-      ((or (not args) (equal "" args))
-       (call-process-region start end prog t t nil key))
-       
-      ;; Check if the args are in the form of a list - must use apply.
-      ((listp args)
-       (apply 'call-process-region
-              (append (list start end prog t t nil) args (list key))))
-       
-      ;; Default - just a non-null string.
-      (t
-       (call-process-region start end prog t t nil args key))))))
-   
-     
-(defun crypt-encrypt-buffer (key &optional decrypt buffer)
-
-  ;; Use KEY to encrypt current buffer and with optional DECRYPT decrypt.
-  ;; With optional BUFFER, encrypt or decrypt that buffer.  Not meant to be
-  ;; called interactively, toggle `crypt-encrypted-mode' to encrypt an entire
-  ;; buffer.
-
-  (or buffer (setq buffer (current-buffer)))
-  (save-excursion (set-buffer buffer)
-                  (crypt-encrypt-region (point-min) (point-max) key decrypt)))
-
-
-;;;; ENCODING
-
-(defun crypt-encode-region (start end &optional decode)
-
-  "Encode region START to END.  When called interactively START and END
-default to point and mark \(START being the lesser of the two\).  With
-optional DECODE non-nil, decoding is done.
-
-If encoding is attempted, then checks for correct magic number at start of
-newly-encoded region.  If not found, then searches and deletes a user-defined
-regexp, or executes a user-defined lisp expression, as defined in
-`crypt-encoding-alist,' and checks again for magic number."
-
-  (interactive "*r\nP")
-
-  ;; If called interactively then we may need to determine the encoding type.
-  (if (and (interactive-p) (not crypt-buffer-encoding-type))
-      (crypt-read-encoding-type))
-
-  (crypt-save-point
-
-   ;; We define the PROGRAM as `shell-file-name' and have it call the encoding
-   ;; or decoding program with the arguments.
-
-   (let (prog args)
-
-     ;; Get the proper program and arguments.
-     (if decode
-         (setq prog (crypt-get-decoding-program crypt-buffer-encoding-type)
-               args (crypt-get-decoding-args crypt-buffer-encoding-type))
-       (setq prog (crypt-get-encoding-program crypt-buffer-encoding-type)
-             args (crypt-get-encoding-args crypt-buffer-encoding-type)))
-
-     (cond 
-
-      ;; prog is a string?
-      ((stringp prog)
-
-       ;; Check arguments.
-       (cond
-        
-        ;; Check if the args are in the form of a list, will catch 'nil.
-        ((listp args)
-         
-         ;; Cat all the strings together.
-         (while args
-           (setq prog (concat prog " " (car args))
-                 args (cdr args))))
-        
-        ;; Check if a non-null string.
-        ((and (not (string= "" args))
-              (not (eq args t))) ; just in case...
-         (setq prog (concat prog " " args))))
-       
-       (call-process-region start end shell-file-name t t nil "-c" prog))
-      
-      ;; Otherwise try and eval it.
-      (t
-       (eval (if args
-                 (list prog start end args)
-               (list prog start end))))))
-   
-   ;; Encoding or decoding region?
-   (if (not decode)
-
-       ;; Check if encoded region starts with magic number.
-       (let ((magic (crypt-get-magic-regexp crypt-buffer-encoding-type))
-             (clean (crypt-get-cleanup-regexp crypt-buffer-encoding-type))
-             (case-fold-search nil))
-         
-         ;; Top of region.
-         (goto-char start)
-         
-         ;; Check for magic number.
-         (if (not (looking-at magic))
-             
-             ;; Magic number not there. 
-
-             ;; Some compression programs produce an (inane) standard error
-             ;; message that gets piped into the buffer.  For example, some
-             ;; versions of compact output "Compression : 35.50%."  There may
-             ;; be some way to clean up buffer and check again.
-
-             (cond
-
-              ;; No mechanism to clean up - failed.
-              ((eq clean nil)
-               (error "Encoding failed!"))
-
-              ;; Cleanup a regexp string?
-              ((stringp clean)
-
-               ;; Is regexp there?
-               (if (looking-at clean)
-
-                   (progn
-                     ;; Delete the match.
-                     (delete-region (match-beginning 0) (match-end 0))
-
-                     ;; Check for magic again.
-                     (if (not (looking-at magic))
-                         (error "Encoding failed!")))))
-               
-              ;; Default: evaluate a lisp expression and check again.
-              (t (eval clean)
-                 (if (not (looking-at magic))
-                     (error "Encoding failed!")))))))))
-
-(defun crypt-encode-buffer (&optional decode buffer)
-
-  ;; Encode current buffer.  With optional DECODE non-nil decode and optional
-  ;; BUFFER, encode or decode that buffer.  Not meant to be called
-  ;; interactively, toggle `crypt-encoded-mode' to encode an entire buffer.
-
-  (or buffer (setq buffer (current-buffer)))
-  (save-excursion (set-buffer buffer)
-                  (crypt-encode-region (point-min) (point-max) decode)))
-
-
-;;;; DOS <--> UNIX
-(defun crypt-dos-to-unix-region (start end)
-  "Converts region from START to END, from dos to unix format.
-Replaces \"\\r\\n\" with \"\\n\" and, if exists, removes ^Z at end of file.
-Sets `crypt-dos-has-ctrl-z'."
-  (save-excursion
-    (save-restriction
-      (let ((remove-ctrl-z (equal end (point-max))))
-        (narrow-to-region start end)
-        (goto-char (point-min))
-        (while (search-forward "\r\n" nil t)
-          (replace-match "\n" nil t))
-        (if remove-ctrl-z
-            (progn
-              (goto-char (1- (point-max)))
-              (setq crypt-dos-has-ctrl-z (looking-at "\C-z"))
-              (if crypt-dos-has-ctrl-z (replace-match ""))))))))
-
-(defun crypt-unix-to-dos-region (start end)
-  "Converts region from START to END, from unix to dos format.
-Replaces \"\\n\" with \"\\r\\n\" and adds a ^Z at end of file if
-`crypt-dos-has-ctrl-z' is non-nil."
-  (save-excursion
-    (save-restriction
-      (let ((add-ctrl-z (and crypt-dos-has-ctrl-z
-                            (equal end (point-max)))))
-        (narrow-to-region start end)
-        (goto-char (point-min))
-        (while (search-forward "\n" nil t)
-          (replace-match "\r\n" nil t))
-        (if add-ctrl-z
-            (progn
-              (goto-char (point-max))
-              (insert "\C-z")))))))
-
-
-;;;; MODES
-
-(defun crypt-encrypted-mode (&optional arg)
-
-  "Toggle encrypted mode.  With ARG, turn on iff positive, otherwise turn off.
-minor mode in which buffers are automatically encrypted before being written.
-if toggled and a key has been set for the current buffer, then the current
-buffer is marked modified, since it needs to be rewritten with or without
-encryption.
-
-Entering encrypted mode causes auto-saving to be turned off in the current
-buffer, as there is no way in Emacs Lisp to force auto save files to be
-encrypted."
-
-  (interactive "P")
-  (let ((oldval crypt-buffer-save-encrypted))
-    (setq crypt-buffer-save-encrypted
-          (if arg (> arg 0) (not crypt-buffer-save-encrypted)))
-
-    (if crypt-buffer-save-encrypted
-        ;; We are going to save as encrypted, we will turn off auto-saving.
-        (progn
-;; NEVER do this.  Turning off auto-saving is one thing.  But if there's
-;; already an autosave for some other reason, what business does this
-;; package have tampering with it?
-;          ;; If an auto-save file already exists, then delete it.
-;          (if (and (stringp buffer-auto-save-file-name)
-;                   (file-exists-p buffer-auto-save-file-name))
-;              (delete-file buffer-auto-save-file-name))
-          ;; If the key is not set then ask for it.
-          (if (not crypt-buffer-encryption-key)
-              (call-interactively 'crypt-set-encryption-key))
-          ;; Turn-off auto-saving if crypt-encrypted-disable-auto-save non-nil.
-          (and crypt-encrypted-disable-auto-save
-               auto-save-default
-               (progn
-                 (auto-save-mode 0)
-                 (if (eq crypt-encrypted-disable-auto-save t)
-                     (message "Auto-save off (in this buffer)")))))
-
-      ;; We are not going to save as encrypted, we will turn on auto-saving
-      ;; but only if we are editing a file and the default says we should.
-      (auto-save-mode (if (and auto-save-default buffer-file-name) 1 0)))
-
-    (if crypt-buffer-encryption-key
-        ;; Set buffer-modified flag to t only if the mode has been changed, 
-        ;; old code set unconditionally to nil if mode was not changed .
-        ;; Modification suggested by: Gerd Hillebrand 
-        (if (not (eq oldval crypt-buffer-save-encrypted))
-            (set-buffer-modified-p t)))))
-
-
-;;; Forgetting encryption keys (by jwz)
-;;; This is really kind of bogus.  Good behavior would be:
-;;; - If a crypted buffer has not been "accessed" (edited? selected?
-;;;   viewed?) in N minutes, kill the buffer (since the plaintext is valuable.)
-;;; - If a crypted buffer is modified, but "idle", just forget the password
-;;;   instead of killing the buffer (though the plaintext is valuable, it's
-;;;   also unsaved...)
-;;; - The "idleness" of a modified buffer should be reset with every mod, so
-;;;   that an unsaved buffer that you have been constantly typing at for an
-;;;   hour doesn't lose its password.
-;;; - But, if a password for a buffer has been discarded, and then an attempt
-;;;   is made to save that buffer, then we should confirm that the newly-
-;;;   typed password is the same as the password used in the file on disk. 
-;;;   with PGP, we could check that by attempting to decrypt the file on
-;;;   disk into a scratch buffer and seeing if it contains the PGP error
-;;;   message.
-;;; - BUG: if a password has been forgotten, and you save, and are prompted,
-;;;   the old file has already been renamed to a backup!!  so if you ^G, the
-;;;   real file name no longer exists on disk - only as a ~ file.
-
-(defun crypt-forget-encryption-key ()
-  (cond (crypt-buffer-encryption-key
-	 (let ((inhibit-quit t))
-	   (fillarray crypt-buffer-encryption-key 0)
-	   (setq crypt-buffer-encryption-key nil))
-	 t)
-	(t nil)))
-
-(add-hook 'kill-buffer-hook 'crypt-forget-encryption-key)
-
-(defcustom crypt-forget-passwd-timeout (* 60 60)
-  "*Do not retain passwords for encrypted buffers more than this many seconds.
-If nil, keep them indefinitely."
-  :type '(choice integer (const :tag "indefinite" nil))
-  :group 'crypt)
-
-(defun crypt-reset-passwd-timer ()
-  (if (fboundp 'get-itimer)	; XEmacs, or anything with itimer.el loaded.
-      (let ((name "crypt-forget-passwds"))
-	(if (get-itimer name)
-	    (delete-itimer name))
-	(if crypt-forget-passwd-timeout
-	    (start-itimer name
-			  'crypt-reset-passwds-timeout
-			  crypt-forget-passwd-timeout)))))
-
-(defun crypt-reset-passwds-timeout ()
-  ;; run by the timer code to forget all passwords
-  (let ((buffers (buffer-list))
-	(inhibit-quit t)
-	(keep-going nil))
-    (while buffers
-      (save-excursion
-	(set-buffer (car buffers))
-	(cond ((and crypt-buffer-encryption-key
-		    (buffer-modified-p))
-	       ;; don't forget the password in modified buffers, but
-	       ;; do check again later (maybe it will be unmodified.)
-	       (setq keep-going t))
-	      (crypt-buffer-encryption-key
-	       ;; forget the password in unmodified buffers.
-	       (crypt-forget-encryption-key)
-	       ;; Mark the buffer read only so that it's not accidentally
-	       ;; edited; the smart thing to do is revert it, type the
-	       ;; encryption key (to make sure they same key is used)
-	       ;; and then edit it.
-	       (setq buffer-read-only t)
-	       (message "Password discarded in buffer %s"
-			(buffer-name (car buffers))))
-	      ))
-      (setq buffers (cdr buffers)))
-    (if keep-going
-	(crypt-reset-passwd-timer))
-    nil))
-
-
-;;; Originally `tek-symbol-alist-to-table' from tek-highlight.el.
-(defun crypt-symbol-alist-to-table (list)
-  ;; Converts an alist of symbols to a table suitable for `completing-read.'
-  ;; Called by `crypt-read-encoding-type'
-  (mapcar (function (lambda (x) (list (symbol-name (car x)))))
-          list))
-
-(defun crypt-read-encoding-type ()
-
-  ;; Function called to query user for `crypt-buffer-encoding-type' uses
-  ;; contents of `crypt-encoding-alist' and `crypt-default-encoding.'
-
-  ;; Use poor man's gmhist (i.e., we could have used gmhist's
-  ;; `completing-read-with-history-in' instead).
-  (let (
-        ;; Find the encoding type desired by user.
-        (type
-         (completing-read
-          (concat "encoding type (? for list): [" crypt-default-encoding "] ")
-          (crypt-symbol-alist-to-table crypt-encoding-alist))))
-    
-    ;; Test length of object returned by `completing-read'.
-    (if (zerop (length type))
-        
-        ;; Nothing there, i.e., user hit return -- use default.
-        (setq crypt-buffer-encoding-type (intern crypt-default-encoding))
-      
-      ;; Use the value from mini-buffer and update the default value.
-      (setq crypt-buffer-encoding-type (intern type)
-            crypt-default-encoding type))))
-
-(defun crypt-encoded-mode (&optional arg)
-
-  "Toggle encoded mode.  With ARG, turn on iff positive, otherwise turn off.
-minor mode in which buffers are automatically encoded before being written.  if
-toggled then current buffer is marked modified, since it needs to be written
-with or without encoding.
-
-Entering encoded mode causes auto-saving to be turned off in the current
-buffer, as there is no way in Emacs Lisp to force auto save files to be
-encoded."
-
-  (interactive "P")
-
-  ;; Set flag indicating whether or not `(crypt-encoded-mode)' was called 
-  ;; interactively.
-  (setq crypt-buffer-interactive-encoded-mode (interactive-p))
-
-  ;; If called interactively then need to determine encoding type.
-  (if (and crypt-buffer-interactive-encoded-mode
-           (not crypt-buffer-encoding-type))
-      (crypt-read-encoding-type))
-
-  ;; Save old value of `crypt-buffer-save-encoded'.
-  (let ((oldval crypt-buffer-save-encoded))
-
-    ;; Set the variable `crypt-buffer-save-encoded' to t if the argument is 
-    ;; positive, otherwise toggle its current value.
-    (setq crypt-buffer-save-encoded
-          (if arg (> arg 0) (not crypt-buffer-save-encoded)))
-
-    ;; Set the variable generated by `(crypt-buffer-save-name)' to the value
-    ;; stored in `crypt-buffer-save-encoded.'
-    (set-variable (crypt-buffer-save-name crypt-buffer-encoding-type)
-                  crypt-buffer-save-encoded)
-
-    (if crypt-buffer-save-encoded
-        ;; We are going to save as encoded, we might turn off auto-saving.
-        (progn
-;; NEVER do this.  Turning off auto-saving is one thing.  But if there's
-;; already an autosave for some other reason, what business does this
-;; package have tampering with it?
-;          ;; If an auto-save file already exists, then delete it.
-;          (if (and (stringp buffer-auto-save-file-name)
-;                   (file-exists-p buffer-auto-save-file-name))
-;              (delete-file buffer-auto-save-file-name))
-          ;; Turn-off auto-saving if crypt-encoded-disable-auto-save non-nil.
-          (and crypt-encoded-disable-auto-save
-               auto-save-default
-               (progn
-                 (auto-save-mode 0)
-                 (if (eq crypt-encoded-disable-auto-save t)
-                     (message "Auto-save off (in this buffer)")))))
-
-      ;; We are not going to save as encoded, we will turn on auto-saving but
-      ;; only if we are editing a file and the default says we should.
-      (auto-save-mode (if (and auto-save-default buffer-file-name) 1 0)))
-
-    ;; Have we toggled the mode? 
-
-    ;; If yes, then mark buffer as modified.  If not, then leave
-    ;; buffer-modified flag alone.
-
-    ;; The old code previously set the variable `set-buffer-modified-p' to a
-    ;; value of t if there was a mode change and (unconditionally) to nil
-    ;; if there was not a mode change.
-
-    ;; Modification suggested by: Gerd Hillebrand .
-
-    (if (not (eq oldval crypt-buffer-save-encoded))
-        (set-buffer-modified-p t))))
-
-
-;;;; Additional encryption functions
-
-;; For Emacs V18 compatibility
-(and (not (fboundp 'buffer-disable-undo))
-     (fboundp 'buffer-flush-undo)
-     (fset 'buffer-disable-undo 'buffer-flush-undo))
-
-(fset 'crypt-read-string-no-echo 'read-passwd)
-
-;(defun crypt-read-string-no-echo (prompt &optional confirm)
-;
-;  ;; Read a string from minibuffer, prompting with PROMPT, echoing periods.
-;  ;; Optional second argument CONFIRM non-nil means that the user will be
-;  ;; asked to type the string a second time for confirmation and if there is a
-;  ;; mismatch, the whole process is repeated.
-;  ;;
-;  ;;         Line editing keys are --
-;  ;;           C-h, DEL      rubout
-;  ;;           C-u, C-x      line kill
-;  ;;           C-q, C-v      literal next
-;  
-;  (catch 'return-value
-;    (save-excursion
-;
-;      (let ((input-buffer (get-buffer-create (make-temp-name " *password*")))
-;            char hold-password help-form kill-ring)
-;
-;        (set-buffer input-buffer)
-;        ;; Don't add to undo ring.
-;        (buffer-disable-undo input-buffer)
-;
-;        (let ((cursor-in-echo-area t)
-;              (echo-keystrokes 0))
-;
-;          (unwind-protect
-;
-;              ;; BODYFORM 
-;              ;; Repeat until we get a `throw'.
-;              (while t
-;                (erase-buffer)
-;                (message prompt)
-;
-;                ;; Read string.
-;                (while (not (memq (setq char (read-char)) '(?\C-m ?\C-j)))
-;                  (if (setq help-form
-;                            (cdr
-;                             (assq char
-;                                   '((?\C-h . (delete-char -1))
-;                                     (?\C-? . (delete-char -1))
-;                                     (?\C-u . (delete-region 1 (point)))
-;                                     (?\C-x . (delete-region 1 (point)))
-;                                     (?\C-q . (quoted-insert 1))
-;                                     (?\C-v . (quoted-insert 1))))))
-;                      (condition-case error-data
-;                          (eval help-form)
-;                        (error t))
-;                    ;; Just a plain character - insert into password buffer.
-;                    (insert char))
-;
-;                  ;; I think crypt-read-string-no-echo should echo asterisks.
-;                  ;; -- Jamie. How about periods like in ange-ftp? -- lrd
-;                  ;;
-;                  (message "%s%s" prompt (make-string (buffer-size) ?.)))
-;                
-;                ;; Do we have to confirm password?
-;                (cond
-;
-;                 ;; No confirmation requested - terminate.
-;                 ((not confirm)
-;                  (throw 'return-value (buffer-string)))
-;                 
-;                 ;; Can we compare (confirm) password values yet?
-;                 (hold-password
-;                  (if (string= hold-password (buffer-string))
-;                      ;; The two passwords match - terminate.
-;                      (throw 'return-value hold-password)
-;
-;                    ;; Mismatch - start over.
-;                    (progn
-;                      (message (concat prompt "[Mismatch. Start over]"))
-;                      (beep)
-;                      (sit-for 2)
-;                      (fillarray hold-password 0) ; destroy extra copy now
-;                      (setq hold-password nil))))
-;                 
-;                 ;; Store password and read again.
-;                 (t
-;                  (setq hold-password (buffer-string))
-;                  (message (concat prompt "[Retype to confirm]"))
-;                  (sit-for 2))))
-;            
-;            ;; UNWINDFORMS
-;            ;; Clean up.
-;            (set-buffer input-buffer)
-;            (set-buffer-modified-p nil)
-;            (buffer-disable-undo input-buffer) ; redundant, but why not be safe.
-;            (widen)
-;            (goto-char (point-min))
-;            (while (not (eobp)) (delete-char 1) (insert "*")) ; destroy now
-;            (kill-buffer input-buffer)))))))
-
-(defun crypt-set-encryption-key (key &optional buffer)
-
-  "Set the encryption KEY, a string, for current buffer or optionally BUFFER.
-If buffer is in encrypted mode, then it is also marked as modified, since it
-needs to be saved with the new key."
-
-  (interactive
-   (progn
-     (barf-if-buffer-read-only)
-     (list (crypt-read-string-no-echo
-            (format "Encryption key for %s? [RET to ignore]: " (buffer-name))
-            crypt-confirm-password))))
-
-  ;; For security reasons we remove `(crypt-set-encryption-key "password")' 
-  ;; from the `command-history' list if called interactively.
-  (if (interactive-p)
-      (setq command-history (cdr command-history)))
-
-  (or buffer (setq buffer (current-buffer)))
-
-  (save-excursion
-    (set-buffer buffer)
-    (if (equal key crypt-buffer-encryption-key)
-        (message "Key is identical to original, no change.")
-
-      (progn
-	;; jwz: destroy old string
-	(if (and crypt-buffer-encryption-key
-		 (not (eq crypt-buffer-encryption-key key)))
-	    (fillarray crypt-buffer-encryption-key 0))
-        (setq crypt-buffer-encryption-key key)
-
-        ;; Don't touch the modify flag unless we're in `(crypt-encrypted-mode)'.
-        (if crypt-buffer-save-encrypted
-            (set-buffer-modified-p t))
-
-	(crypt-reset-passwd-timer)
-	))))
-
-
-;;;; Install hooks and mode indicators.
-
-;;; Check if mode indicators are not already installed and then prepend them.
-(and (not (assq 'crypt-buffer-save-encrypted minor-mode-alist))
-     (setq minor-mode-alist (append crypt-minor-mode-alist minor-mode-alist)))
-
-;;; Install the hooks. 
-
-;;; If add-hook isn't already defined overwrite it with our own.
-;;; Note the `add-hook' function must take the optional APPEND argument.
-(if (not (fboundp 'add-hook))
-    ;; No add-hook found. 
-    ;; Use `add-hook' from GNU Emacs v19.
-    (defun add-hook (hook function &optional append)
-      "Add to the value of HOOK the function FUNCTION.
-FUNCTION is not added if already present.
-FUNCTION is added (if necessary) at the beginning of the hook list
-unless the optional argument APPEND is non-nil, in which case
-FUNCTION is added at the end.
-
-HOOK should be a symbol, and FUNCTION may be any valid function.  If
-HOOK is void, it is first set to nil.  If HOOK's value is a single
-function, it is changed to a list of functions."
-      (or (boundp hook) (set hook nil))
-      ;; If the hook value is a single function, turn it into a list.
-      (let ((old (symbol-value hook)))
-        (if (or (not (listp old)) (eq (car old) 'lambda))
-            (set hook (list old))))
-      (or (if (consp function)
-              ;; Clever way to tell whether a given lambda-expression
-              ;; is equal to anything in the hook.
-              (let ((tail (assoc (cdr function) (symbol-value hook))))
-                (equal function tail))
-            (memq function (symbol-value hook)))
-          (set hook 
-               (if append
-                   (nconc (symbol-value hook) (list function))
-                 (cons function (symbol-value hook)))))))
-
-;;; Attach ourselves to the find-file-hooks and find-file-not-found-hooks. 
-(add-hook 'find-file-hooks 'crypt-find-file-hook)
-(add-hook 'find-file-not-found-hooks 'crypt-find-file-hook)
-
-;; Take care when appending to write-file-hook.  User's version of add-hook
-;; may not have APPEND option.  If it fails then do it by hand.  I wish
-;; everyone would upgrade - lrd 8/31/93.
-(condition-case nil
-    (add-hook 'write-file-hooks 'crypt-write-file-hook t) ; *must* append this
-  (error
-   ;; Do it by hand.  Not as robust as `add-hook'.
-
-   ;; Contributed by Ken Laprade 
-   ;; Really should use some sort of add-hook - 16 Feb 93 - KCL
-   (or (and (listp write-file-hooks) (not (eq (car write-file-hooks) 'lambda)))
-       (setq write-file-hooks (list write-file-hooks)))
-
-   (cond
-    ((not (memq 'crypt-write-file-hook write-file-hooks))
-     ;; make this hook last on purpose
-     (setq write-file-hooks (append write-file-hooks
-                                    (list 'crypt-write-file-hook)))))))
-
-;; In order that the tables and key-binding correctly reflect user's
-;; preferences we add ourselves to the `after-init-hook' GNU Emacs v19 and
-;; Lucid Emacs v 19.8 (or later) or `term-setup-hook' in Lucid Emacs v 19.7
-;; (or earlier).  These are run *after* ~/.emacs and ../lisp/default.el are
-;; loaded.  Unfortunately, v18 does not have `after-init-hook' and
-;; `term-setup-hook' is just a single function.  It is a bit of a pain trying
-;; to work our functions in properly without overwriting the user's value.
-;; Therefore, we do nothing and hope they upgrade to v19 soon.
-
-(cond ((boundp 'after-init-hook)
-       ;; Must be running GNU Emacs v19 :->
-       (add-hook 'after-init-hook 'crypt-rebuild-tables)
-       (add-hook 'after-init-hook 'crypt-rebuild-minor-modes-alist)
-       (add-hook 'after-init-hook 'crypt-bind-insert-file))
-
-      ((and (string-match "^19" emacs-version) t)
-       ;; Probably running Lucid Emacs v19.7 (or earlier) since it,
-       ;; unfortunately, does not have `after-init-hook'.  Use
-       ;; `term-setup-hook' instead and hope they upgrade to Lucid 19.8 or GNU
-       ;; Emacs 19.
-       (add-hook 'term-setup-hook 'crypt-rebuild-tables)
-       (add-hook 'term-setup-hook 'crypt-rebuild-minor-modes-alist)
-       (add-hook 'term-setup-hook 'crypt-bind-insert-file)))
-
-
-;;; Code for conditionally decoding/decrypting an inserted file
-
-(defcustom crypt-bind-insert-file t
-  "*t value means bind `crypt-insert-file' over `insert-file'.
-If you wish to change this variable after crypt++ has been loaded then do
-\\[crypt-bind-insert-file]."
-  :type 'boolean
-  :group 'crypt)
-
-(defcustom crypt-auto-decode-insert nil
-  "*t says decode/decrypt files that are inserted with `crypt-insert-file'.
-nil says to ask before doing this."
-  :type 'boolean
-  :group 'crypt)
-
-;;; Bind `crypt-insert-file' over wherever `insert-file' is bound?
-(defun crypt-bind-insert-file ()
-
-  "Bind `crypt-insert-file' in place of `insert-file' or reverse based on
-`crypt-bind-insert-file'.  Part of `after-init-hook'."
-
-  (interactive)
-
-  (if (interactive-p)
-      (setq crypt-bind-insert-file
-            (y-or-n-p "Bind crypt-insert-file over insert-file? ")))
-
-  (if crypt-bind-insert-file
-      (substitute-key-definition
-       'insert-file 'crypt-insert-file (current-global-map))
-    (substitute-key-definition
-     'crypt-insert-file 'insert-file (current-global-map))))
-
-;;; Now call it.
-(crypt-bind-insert-file)
-
-;;; crypt++ replacement for `insert-file'
-(defun crypt-insert-file (filename &optional codesys)
-  "Insert decoded/decrypted contents of file FILENAME into buffer after point.
-Set mark after the inserted text.
-
-Under XEmacs/Mule, optional second argument specifies the
-coding system to use when decoding the file.  Interactively,
-with a prefix argument, you will be prompted for the coding system.
-
-This function is meant for the user to run interactively.
-Don't call it from programs!  Use `insert-file-contents' instead.
-\(Its calling sequence is different; see its documentation\).
-
-This version will attempt to decrypt and/or decode file before inserting.
-see variable `crypt-auto-decode-insert'."
-  (interactive "*fInsert file: \nZCoding system: ")
-  (if (file-directory-p filename)
-      (signal 'file-error (list "Opening input file" "file is a directory"
-                                filename)))
-  (let* (format-alist ; format.el only confuses people in this context
-	 (tem
-	 (if codesys
-	     (let ((coding-system-for-read
-		    (get-coding-system codesys)))
-	       (crypt-insert-file-contents filename))
-	   (crypt-insert-file-contents filename))))
-    (push-mark (+ (point) (car (cdr tem))))))
-
-(defun crypt-insert-file-contents (file)
-
-  ;; Similar to `insert-file-contents' except decoding/decrypting of FILE
-  ;; attempted.  See `crypt-insert-file' and `crypt-auto-decode-insert'
-
-  (let (temp-buffer
-        temp-list
-        (crypt-auto-decode-buffer crypt-auto-decode-insert)
-        (orig-buffer (current-buffer)))
-    
-    ;; Create a temporary buffer and decode and decrypt it.
-    (save-excursion
-      
-      ;; Temporary buffer, use the same name as the file to be inserted.
-      (setq temp-buffer (generate-new-buffer (file-name-nondirectory file)))
-      (set-buffer temp-buffer)
-      
-      ;; Original insert-file-contents - save list.
-      (setq temp-list (insert-file-contents file nil))
-
-      ;; Make temp-buffer unmodified.
-      (set-buffer-modified-p nil)
-      
-      ;; Need to set buffer name to file name for crypt++.
-      (setq buffer-file-name file)
-      
-      ;; Decode and decrypt, if necessary.
-      (crypt-find-file-hook)
-      
-      ;; Find the length of the file to be inserted. `insert-file-contents' 
-      ;; returns it for the original encoded/encrypted file.
-      (setcdr temp-list (cons (buffer-size) ()))
-      
-      ;; Now insert temp-buffer into original buffer.
-      (set-buffer orig-buffer)
-      (insert-buffer temp-buffer)
-      
-      ;; Kill the temporary buffer.
-      (kill-buffer temp-buffer))
-    
-    ;; Return modified list from `insert-file-contents'.
-    temp-list))
-
-
-;;;; BUG REPORTS
-
-;;; This section is provided for reports.
-;;; Using Barry A. Warsaw's reporter.el
-
-(defconst crypt-version "2.82"
-  "Revision number of crypt++.el -- handles compressed and encrypted files.
-Type \\[crypt-submit-report] to send a bug report.  Available via anonymous
-ftp in
-
-   /roebling.poly.edu:/pub/lisp/crypt++.el.gz
-   /archive.cis.ohio-state.edu:/pub/gnu/emacs/elisp-archive/misc/crypt++.el.Z")
-
-(defconst crypt-help-address
-  "dodd@roebling.poly.edu"
-  "Address(es) accepting submission of reports on crypt++.el.")
-
-(defconst crypt-maintainer "Larry"
-  "First name(s) of people accepting submission of reports on crypt++.el.")
-
-(defconst crypt-file "crypt++.el"
-  "Name of file containing emacs lisp code.")
-
-(defconst crypt-variable-list
-  (list 'shell-file-name ; These
-        'load-path       ; are
-        'exec-path       ; useful.
-        'crypt-encryption-type 
-        'crypt-encryption-file-extension
-        'crypt-never-ever-decrypt
-        'crypt-auto-write-buffer-encrypted
-        'crypt-confirm-password
-        'crypt-encrypted-disable-auto-save
-        'crypt-auto-decode-buffer
-        'crypt-auto-write-buffer
-        'crypt-query-if-interactive
-        'crypt-no-extension-implies-plain
-        'crypt-freeze-vs-fortran
-        'crypt-compact-vs-C++
-        'crypt-ignored-filenames
-        'crypt-default-encoding
-        'crypt-encoded-disable-auto-save
-        'crypt-bind-insert-file
-        'crypt-auto-decode-insert
-        'crypt-encoding-alist
-        'crypt-encryption-alist
-        )
-  "List of variables to be appended to reports sent by `crypt-submit-report.'")
-
-(defun crypt-submit-report ()
-  "Submit via reporter.el a bug report on program.  Send report on `crypt-file'
-version `crypt-version,' to `crypt-maintainer' at address `crypt-help-address'
-listing variables `crypt-variable-list' in the message."
-  (interactive)
-
-  ;; In case we can't find reporter...
-  (condition-case nil
-      (progn
-        ;; Get it if we can.
-        (require 'reporter)
-
-        (reporter-submit-bug-report
-         crypt-help-address                     ; address
-         (concat crypt-file " " crypt-version)  ; pkgname
-         crypt-variable-list                    ; varlist
-         nil nil                                ; pre-hooks and post-hooks
-         (concat "Yo! " crypt-maintainer ","))) ; salutation
-
-    ;; ...fail gracefully.
-    (error 
-     (beep)
-
-     ;; Do they have ange-ftp?
-     (if (and (featurep 'ange-ftp)
-              (y-or-n-p (concat "Sorry, reporter.el not found.  "
-                                "Can I ange-ftp it for you? ")))
-
-         ;; Yes.  Then Ange-ftp a copy from roebling.
-         (let ((ange-ftp-generate-anonymous-password t))
-           ;; Might want to use the elisp archive official site?  But
-           ;; then it would have to be uncompressed, etc. Ick!
-           (find-file-other-window
-            "/anonymous@roebling.poly.edu:/pub/reporter.el")
-           (eval-current-buffer)
-           (message (concat "Save reporter.el somewhere in `load-path' "
-                            "and try again.")))
-       
-       ;; No ange-ftp.
-       (message "Sorry, reporter.el not found.")
-       (sit-for 3)
-       (message (concat "Get it from archive.cis.ohio-state.edu "
-                        "or roebling.poly.edu"))))))
-
-;;; Provide this package as crypt++ as well as crypt.
-(provide 'crypt++)
-(provide 'crypt)
-
-;;; crypt++.el ends here.
diff --git a/xemacs-packages/lisp/os-utils/custom-load.el b/xemacs-packages/lisp/os-utils/custom-load.el
deleted file mode 100644
index c7fca7ae..00000000
--- a/xemacs-packages/lisp/os-utils/custom-load.el
+++ /dev/null
@@ -1,26 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'ssh '("ssh"))
-(custom-add-loads 'tar '("tar-mode"))
-(custom-add-loads 'telnet '("telnet"))
-(custom-add-loads 'crypt '("crypt"))
-(custom-add-loads 'comint '("telnet"))
-(custom-add-loads 'mchat '("mchat"))
-(custom-add-loads 'jka-compr '("jka-compr"))
-(custom-add-loads 'rlogin '("rlogin"))
-(custom-add-loads 'data '("arc-mode" "jka-compr" "tar-mode"))
-(custom-add-loads 'compression '("jka-compr"))
-(custom-add-loads 'archive-lzh '("arc-mode"))
-(custom-add-loads 'archive '("arc-mode"))
-(custom-add-loads 'archive-arc '("arc-mode"))
-(custom-add-loads 'archive-zoo '("arc-mode"))
-(custom-add-loads 'archive-zip '("arc-mode"))
-(custom-add-loads 'processes '("background" "rlogin" "ssh"))
-(custom-add-loads 'background '("background"))
-(custom-add-loads 'unix '("rlogin" "ssh" "tar-mode"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/os-utils/ftelnet.el b/xemacs-packages/lisp/os-utils/ftelnet.el
deleted file mode 100644
index bd5e5054..00000000
--- a/xemacs-packages/lisp/os-utils/ftelnet.el
+++ /dev/null
@@ -1,425 +0,0 @@
-;;; ftelnet.el --- remote login interface
-
-;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Noah S. Friedman
-
-;; Author: Noah Friedman
-;; Maintainer: Noah Friedman 
-;; Status: Works in Emacs 19.27 and later.
-;; Keywords: unix, comm
-
-;; LCD Archive Entry:
-;; ftelnet|Noah Friedman|friedman@prep.ai.mit.edu|
-;; remote login interface|
-;; $Date: 1998/10/02 05:58:07 $|$Revision: 1.1 $|~/misc/ftelnet.el.gz|
-
-;; $Id: ftelnet.el,v 1.1 1998/10/02 05:58:07 steveb 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, write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue.; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This code originally derived from emacs 19.29 rlogin.el, and was then
-;; modified substantially for use with telnet.
-
-;; Support for remote logins using `telnet'.
-;; This program is layered on top of shell.el; the code here only accounts
-;; for the variations needed to handle a remote process, e.g. directory
-;; tracking and the sending of some special characters.
-
-;; If you wish for ftelnet mode to prompt you in the minibuffer for
-;; passwords when a password prompt appears, just enter m-x send-invisible
-;; and type in your line, or add `comint-watch-for-password-prompt' to
-;; `comint-output-filter-functions'.
-
-;;; Code:
-
-(require 'comint)
-(require 'shell)
-
-(defvar ftelnet-program "telnet"
-  "*Name of program to invoke telnet")
-
-(defvar ftelnet-explicit-args nil
-  "*List of arguments to pass to telnet on the command line.")
-
-(defvar ftelnet-mode-hook nil
-  "*Hooks to run after setting current buffer to ftelnet-mode.")
-
-(defvar ftelnet-process-connection-type nil
-  "*If non-`nil', use a pty for the local telnet process.
-If `nil', use a pipe (if pipes are supported on the local system).
-
-Generally it is better not to waste ptys on systems which have a static
-number of them.  On the other hand, some implementations of `telnet' assume
-a pty is being used, and errors will result from using a pipe instead.")
-
-(defvar ftelnet-directory-tracking-mode 'local
-  "*Control whether and how to do directory tracking in a telnet buffer.
-
-nil means don't do directory tracking.
-
-t means do so using an ftp remote file name.
-
-Any other value means do directory tracking using local file names.
-This works only if the remote machine and the local one
-share the same directories (through NFS).  This is the default.
-
-This variable becomes local to a buffer when set in any fashion for it.
-
-It is better to use the function of the same name to change the behavior of
-directory tracking in a telnet session once it has begun, rather than
-simply setting this variable, since the function does the necessary
-re-synching of directories.")
-
-(make-variable-buffer-local 'ftelnet-directory-tracking-mode)
-
-(defvar ftelnet-host nil
-  "The name of the remote host.  This variable is buffer-local.
-There is usually no need to set this yourself.
-")
-
-(defvar ftelnet-remote-user nil
-  "The username used on the remote host.
-This variable is buffer-local and defaults to your local user name.
-There is usually no need to set this yourself.")
-
-;; Initialize telnet mode map.
-; (setq ftelnet-mode-map nil)
-(defvar ftelnet-mode-map '())
-(cond
- ((null ftelnet-mode-map)
-  (setq ftelnet-mode-map (if (consp shell-mode-map)
-                            (cons 'keymap shell-mode-map)
-                          (copy-keymap shell-mode-map)))
-  (define-key ftelnet-mode-map "\C-c\C-c" 'ftelnet-send-interrupt)
-  (define-key ftelnet-mode-map "\C-c\C-d" 'ftelnet-send-eof)
-  (define-key ftelnet-mode-map "\C-c\C-z" 'ftelnet-send-suspend)
-  (define-key ftelnet-mode-map "\C-c\C-\\" 'ftelnet-send-quit)
-  (define-key ftelnet-mode-map "\C-c\C-]" 'ftelnet-send-escape)
-  (define-key ftelnet-mode-map "\C-d" 'ftelnet-delete-or-send-eof)
-  (define-key ftelnet-mode-map "\C-i" 'ftelnet-tab-or-complete)))
-
-(defvar ftelnet-urgent-alist
-  '((escape      . "\C-]")
-    (erase       . "\C-?")
-    (flushoutput . "\C-o")
-    (interrupt   . "\C-c")
-    (kill        . "\C-u")
-    (quit        . "\C-\\")
-    (eof         . "\C-d")))
-
-(defvar ftelnet-history nil
-  "*History ring for ftelnet input arguments.")
-
-
-;; See comments near ftelnet-pop-to-buffer for an explanation.
-;;;###autoload (add-hook 'same-window-regexps "^\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
-
-;;;###autoload
-(defun ftelnet (input-args &optional buffer)
-  "Open a network login connection to HOST via the `telnet' program.
-Input is sent line-at-a-time to the remote connection.
-
-Communication with the remote host is recorded in a buffer *telnet-HOST*
-\(or *telnet-HOST:PORT* if using a nonstandard port number\).
-If a prefix argument is given and the buffer *telnet-HOST* already exists,
-a new buffer with a different connection will be made.
-
-When called from a program, if the optional second argument is a string or
-buffer, it names the buffer to use.
-
-The variable `ftelnet-program' contains the name of the actual program to
-run.  It can be a relative or absolute path.
-
-The variable `ftelnet-explicit-args' is a list of arguments to give to the
-telnet program when starting.  They are added after any arguments given in
-INPUT-ARGS.
-
-If the default value of `ftelnet-directory-tracking-mode' is t, then the
-default directory in that buffer is set to a remote (FTP) file name to
-access your home directory on the remote machine.  Occasionally this causes
-an error, if you cannot access the home directory on that machine.  This
-error is harmless as long as you don't try to use that default directory.
-
-If `ftelnet-directory-tracking-mode' is neither t nor nil, then the default
-directory is initially set up to your (local) home directory.
-This is useful if the remote machine and your local machine
-share the same files via NFS.  This is the default.
-
-If you wish to change directory tracking styles during a session, use the
-function `ftelnet-directory-tracking-mode' rather than simply setting the
-variable."
-  (interactive (list
-		(read-from-minibuffer "telnet host (and optional port): "
-                                      nil nil nil 'ftelnet-history)
-		current-prefix-arg))
-  (let* ((process-connection-type ftelnet-process-connection-type)
-         (args (if ftelnet-explicit-args
-                   (append (ftelnet-parse-words input-args)
-                           ftelnet-explicit-args)
-                 (ftelnet-parse-words input-args)))
-         ;; skip args starting with `-'
-         (nonopt-args (let ((l args))
-                        (while (= ?- (aref (car l) 0))
-                          (setq l (cdr l)))
-                        l))
-	 (host (car nonopt-args))
-	 (port (car (cdr nonopt-args)))
-         (buffer-name (if port
-                          (format "*telnet-%s:%s*" host port)
-                        (format "*telnet-%s*" host)))
-	 proc)
-
-    (cond ((null buffer))
-	  ((stringp buffer)
-	   (setq buffer-name buffer))
-          ((bufferp buffer)
-           (setq buffer-name (buffer-name buffer)))
-          ((numberp buffer)
-           (setq buffer-name (format "%s<%d>" buffer-name buffer)))
-          (t
-           (setq buffer-name (generate-new-buffer-name buffer-name))))
-
-    (setq buffer (get-buffer-create buffer-name))
-    (ftelnet-pop-to-buffer buffer-name)
-
-    (cond
-     ((comint-check-proc buffer-name))
-     (t
-      (comint-exec buffer buffer-name ftelnet-program nil args)
-      (setq proc (get-buffer-process buffer))
-      ;; Set process-mark to point-max in case there is text in the
-      ;; buffer from a previous exited process.
-      (set-marker (process-mark proc) (point-max))
-
-      ;; comint-output-filter-functions is treated like a hook: it is
-      ;; processed via run-hooks or run-hooks-with-args in later versions
-      ;; of emacs.
-      ;; comint-output-filter-functions should already have a
-      ;; permanent-local property, at least in emacs 19.27 or later.
-      (cond
-       ((fboundp 'make-local-hook)
-        (make-local-hook 'comint-output-filter-functions)
-        (add-hook 'comint-output-filter-functions 'ftelnet-carriage-filter
-                  nil t))
-       (t
-        (make-local-variable 'comint-output-filter-functions)
-        (add-hook 'comint-output-filter-functions 'ftelnet-carriage-filter)))
-
-      (ftelnet-mode)
-
-      ;; initial filter to get remote user name if connecting to a telnet
-      ;; login port.
-      (cond
-       ((or (null port)
-            (string= port "23"))
-        (add-hook 'comint-output-filter-functions
-                  'ftelnet-user-output-filter)))
-
-      (make-local-variable 'ftelnet-host)
-      (setq ftelnet-host host)
-      (make-local-variable 'ftelnet-remote-user)
-      (setq ftelnet-remote-user nil)
-
-      (cond
-       ((eq t ftelnet-directory-tracking-mode))
-       ((null ftelnet-directory-tracking-mode))
-       (t
-        (cd-absolute (concat comint-file-name-prefix "~/"))))))))
-
-(defun ftelnet-mode ()
-  "Set major-mode for ftelnet sessions.
-If `ftelnet-mode-hook' is set, run it."
-  (interactive)
-  (kill-all-local-variables)
-  (shell-mode)
-  (setq major-mode 'ftelnet-mode)
-  (setq mode-name "ftelnet")
-  (use-local-map ftelnet-mode-map)
-  (setq shell-dirtrackp ftelnet-directory-tracking-mode)
-  (make-local-variable 'comint-file-name-prefix)
-  (run-hooks 'ftelnet-mode-hook))
-
-(defun ftelnet-directory-tracking-mode (&optional prefix)
-  "Do remote or local directory tracking, or disable entirely.
-
-If called with no prefix argument or a unspecified prefix argument (just
-``\\[universal-argument]'' with no number) do remote directory tracking via
-ange-ftp.  If called as a function, give it no argument.
-
-If called with a negative prefix argument, disable directory tracking
-entirely.
-
-If called with a positive, numeric prefix argument, e.g.
-
-         \\[universal-argument] 1 \\[ftelnet-directory-tracking-mode]
-
-then do directory tracking but assume the remote filesystem is the same as
-the local system.  This only works in general if the remote machine and the
-local one share the same directories (through NFS)."
-  (interactive "P")
-  (cond
-   ((or (null prefix)
-        (consp prefix))
-    (setq ftelnet-directory-tracking-mode t)
-    (setq shell-dirtrackp t)
-    (setq comint-file-name-prefix
-          (concat "/" ftelnet-remote-user "@" ftelnet-host ":")))
-   ((< prefix 0)
-    (setq ftelnet-directory-tracking-mode nil)
-    (setq shell-dirtrackp nil))
-   (t
-    (setq ftelnet-directory-tracking-mode 'local)
-    (setq comint-file-name-prefix "")
-    (setq shell-dirtrackp t)))
-  (cond
-   (shell-dirtrackp
-    (let* ((proc (get-buffer-process (current-buffer)))
-           (proc-mark (process-mark proc))
-           (current-input (buffer-substring proc-mark (point-max)))
-           (orig-point (point))
-           (offset (and (>= orig-point proc-mark)
-                        (- (point-max) orig-point))))
-      (unwind-protect
-          (progn
-            (delete-region proc-mark (point-max))
-            (goto-char (point-max))
-            (shell-resync-dirs))
-        (goto-char proc-mark)
-        (insert current-input)
-        (if offset
-            (goto-char (- (point-max) offset))
-          (goto-char orig-point)))))))
-
-;; Parse a line into its constituent parts (words separated by
-;; whitespace).  Return a list of the words.
-(defun ftelnet-parse-words (line)
-  (let ((list nil)
-	(posn 0)
-        (match-data (match-data)))
-    (while (string-match "[^ \t\n]+" line posn)
-      (setq list (cons (substring line (match-beginning 0) (match-end 0))
-                       list))
-      (setq posn (match-end 0)))
-    (store-match-data (match-data))
-    (nreverse list)))
-
-;; Starting in Emacs 19.29, the variable same-window-regexps modifies how
-;; pop-to-buffer works; in particular, if the name of the buffer being
-;; switched to matches one of the regexps in same-window-regexps (which may
-;; be buffer-local to the current buffer), then pop-to-buffer acts like
-;; switch-to-buffer.  This gives users more control.
-;; This also explains the related autoload cookie near the top of the file.
-(defun ftelnet-pop-to-buffer (buffer)
-  (if (boundp 'same-window-regexps)
-      (pop-to-buffer buffer)
-    (switch-to-buffer buffer)))
-
-
-;; This should go on comint-output-filter-functions initially.
-;; Once it detects that a username has been prompted for, it adds an input
-;; filter that saves the username.
-(defun ftelnet-user-output-filter (s)
-  (let ((data (match-data)))
-    (cond
-     ;; I fail to see how or why a process filter would get invoked with
-     ;; output consisting of the empty string, but it happens.
-     ((string= s ""))
-     ((string-match "\\(ogin: \\)\\|\\(sername: \\)$" s)
-      (add-hook 'comint-input-filter-functions 'ftelnet-user-input-filter))
-     ((string-match "^[\C-m\n]+$" s))
-     ((string-match "assword:[ \t]*$" s))
-     ((string-match ".*\\(incorrect\\)\\|\\(authorization failure\\)$" s))
-     ((null ftelnet-remote-user))
-     ((and ftelnet-remote-user
-           (string-match (concat ftelnet-remote-user "[\C-m\n]*$") s)))
-     (t
-      (remove-hook 'comint-output-filter-functions 'ftelnet-user-output-filter)
-      (remove-hook 'comint-input-filter-functions 'ftelnet-user-input-filter)
-      (cond
-       ((eq ftelnet-directory-tracking-mode t)
-        (cd-absolute comint-file-name-prefix)))))
-    (store-match-data data)))
-
-(defun ftelnet-user-input-filter (s)
-  (remove-hook 'comint-input-filter-functions 'ftelnet-user-input-filter)
-  (setq ftelnet-remote-user (car (ftelnet-parse-words s)))
-  (cond
-   ((eq ftelnet-directory-tracking-mode t)
-    (setq comint-file-name-prefix
-          (concat "/" ftelnet-remote-user "@" ftelnet-host ":")))))
-
-(defun ftelnet-carriage-filter (string)
-  (let* ((point-marker (point-marker))
-         (end (process-mark (get-buffer-process (current-buffer))))
-         (beg (or (and (boundp 'comint-last-output-start)
-                       comint-last-output-start)
-                  (- end (length string)))))
-    (goto-char beg)
-    (while (search-forward "\C-m" end t)
-      (delete-char -1))
-    (goto-char point-marker)))
-
-
-;; Definitions for keybindings
-
-(defun ftelnet-send-urgently (urgsym)
-  (let ((s (cdr (assq urgsym ftelnet-urgent-alist))))
-    (and s (comint-send-string nil s))))
-
-(defun ftelnet-send-escape ()
-  (interactive)
-  (ftelnet-send-urgently 'escape))
-
-(defun ftelnet-send-interrupt ()
-  (interactive)
-  (ftelnet-send-urgently 'interrupt))
-
-(defun ftelnet-send-eof ()
-  (interactive)
-  (ftelnet-send-urgently 'eof))
-
-(defun ftelnet-send-quit ()
-  (interactive)
-  (ftelnet-send-urgently 'quit))
-
-(defun ftelnet-send-suspend ()
-  (interactive)
-  (comint-send-string nil "\C-z"))
-
-(defun ftelnet-delete-or-send-eof (arg)
-  "\
-Delete ARG characters forward, or send an eof to process if at end of buffer."
-  (interactive "p")
-  (if (eobp)
-      (ftelnet-send-eof)
-    (delete-char arg)))
-
-(defun ftelnet-tab-or-complete ()
-  "Complete file name if doing directory tracking, or just insert TAB."
-  (interactive)
-  (if ftelnet-directory-tracking-mode
-      (comint-dynamic-complete)
-    (insert "\C-i")))
-
-
-(provide 'ftelnet)
-
-;; local variables:
-;; vc-make-backup-files: t
-;; end:
-
-;;; ftelnet.el ends here
diff --git a/xemacs-packages/lisp/os-utils/inf-lisp.el b/xemacs-packages/lisp/os-utils/inf-lisp.el
deleted file mode 100644
index d26dd00a..00000000
--- a/xemacs-packages/lisp/os-utils/inf-lisp.el
+++ /dev/null
@@ -1,636 +0,0 @@
-;;; inf-lisp.el --- an inferior-lisp mode
-;;; Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Olin Shivers 
-;; Keywords: processes, lisp
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.30.
-
-;;; Commentary:
-
-;;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
-
-;;; This file defines a a lisp-in-a-buffer package (inferior-lisp
-;;; mode) built on top of comint mode.  This version is more
-;;; featureful, robust, and uniform than the Emacs 18 version.  The
-;;; key bindings are also more compatible with the bindings of Hemlock
-;;; and Zwei (the Lisp Machine emacs).
-
-;;; Since this mode is built on top of the general command-interpreter-in-
-;;; a-buffer mode (comint mode), it shares a common base functionality, 
-;;; and a common set of bindings, with all modes derived from comint mode.
-;;; This makes these modes easier to use.
-
-;;; For documentation on the functionality provided by comint mode, and
-;;; the hooks available for customizing it, see the file comint.el.
-;;; For further information on inferior-lisp mode, see the comments below.
-
-;;; Needs fixin:
-;;; The load-file/compile-file default mechanism could be smarter -- it
-;;; doesn't know about the relationship between filename extensions and
-;;; whether the file is source or executable. If you compile foo.lisp
-;;; with compile-file, then the next load-file should use foo.bin for
-;;; the default, not foo.lisp. This is tricky to do right, particularly
-;;; because the extension for executable files varies so much (.o, .bin,
-;;; .lbin, .mo, .vo, .ao, ...).
-;;;
-;;; It would be nice if inferior-lisp (and inferior scheme, T, ...) modes
-;;; had a verbose minor mode wherein sending or compiling defuns, etc.
-;;; would be reflected in the transcript with suitable comments, e.g.
-;;; ";;; redefining fact". Several ways to do this. Which is right?
-;;;
-;;; When sending text from a source file to a subprocess, the process-mark can 
-;;; move off the window, so you can lose sight of the process interactions.
-;;; Maybe I should ensure the process mark is in the window when I send
-;;; text to the process? Switch selectable?
-
-;;; Code:
-
-(require 'comint)
-(require 'lisp-mode)
-
-
-;;;###autoload
-(defvar inferior-lisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'"
-  "*What not to save on inferior Lisp's input history.
-Input matching this regexp is not saved on the input history in Inferior Lisp
-mode.  Default is whitespace followed by 0 or 1 single-letter colon-keyword 
-\(as in :a, :c, etc.)")
-
-(defvar inferior-lisp-mode-map nil)
-(cond ((not inferior-lisp-mode-map)
-       (setq inferior-lisp-mode-map (make-sparse-keymap))
-       (set-keymap-name inferior-lisp-mode-map 'inferior-lisp-mode-map)
-       (set-keymap-parents inferior-lisp-mode-map
-			   (list comint-mode-map shared-lisp-mode-map))
-       (define-key inferior-lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp)
-       (define-key inferior-lisp-mode-map "\C-c\C-l" 'lisp-load-file)
-       (define-key inferior-lisp-mode-map "\C-c\C-k" 'lisp-compile-file)
-       (define-key inferior-lisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
-       (define-key inferior-lisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
-       (define-key inferior-lisp-mode-map "\C-c\C-f"
-	 'lisp-show-function-documentation)
-       (define-key inferior-lisp-mode-map "\C-c\C-v"
-	 'lisp-show-variable-documentation)))
-
-;;; These commands augment Lisp mode, so you can process Lisp code in
-;;; the source files.
-(define-key lisp-mode-map "\M-\C-x"  'lisp-eval-defun)     ; Gnu convention
-(define-key lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) ; Gnu convention
-(define-key lisp-mode-map "\C-c\C-e" 'lisp-eval-defun)
-(define-key lisp-mode-map "\C-c\C-r" 'lisp-eval-region)
-(define-key lisp-mode-map "\C-c\C-c" 'lisp-compile-defun)
-(define-key lisp-mode-map "\C-c\C-z" 'switch-to-lisp)
-(define-key lisp-mode-map "\C-c\C-l" 'lisp-load-file)
-(define-key lisp-mode-map "\C-c\C-k" 'lisp-compile-file)  ; "kompile" file
-(define-key lisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
-(define-key lisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
-(define-key lisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
-(define-key lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)
-
-;;; This function exists for backwards compatibility.
-;;; Previous versions of this package bound commands to C-c 
-;;; bindings, which is not allowed by the gnumacs standard.
-
-;;;  "This function binds many inferior-lisp commands to C-c  bindings,
-;;;where they are more accessible. C-c  bindings are reserved for the
-;;;user, so these bindings are non-standard. If you want them, you should
-;;;have this function called by the inferior-lisp-load-hook:
-;;;    (setq inferior-lisp-load-hook '(inferior-lisp-install-letter-bindings))
-;;;You can modify this function to install just the bindings you want."
-(defun inferior-lisp-install-letter-bindings ()
-  (define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go)
-  (define-key lisp-mode-map "\C-cr" 'lisp-eval-region-and-go)
-  (define-key lisp-mode-map "\C-cc" 'lisp-compile-defun-and-go)
-  (define-key lisp-mode-map "\C-cz" 'switch-to-lisp)
-  (define-key lisp-mode-map "\C-cl" 'lisp-load-file)
-  (define-key lisp-mode-map "\C-ck" 'lisp-compile-file)
-  (define-key lisp-mode-map "\C-ca" 'lisp-show-arglist)
-  (define-key lisp-mode-map "\C-cd" 'lisp-describe-sym)
-  (define-key lisp-mode-map "\C-cf" 'lisp-show-function-documentation)
-  (define-key lisp-mode-map "\C-cv" 'lisp-show-variable-documentation)
-  
-  (define-key inferior-lisp-mode-map "\C-cl" 'lisp-load-file)
-  (define-key inferior-lisp-mode-map "\C-ck" 'lisp-compile-file)
-  (define-key inferior-lisp-mode-map "\C-ca" 'lisp-show-arglist)
-  (define-key inferior-lisp-mode-map "\C-cd" 'lisp-describe-sym)
-  (define-key inferior-lisp-mode-map "\C-cf" 'lisp-show-function-documentation)
-  (define-key inferior-lisp-mode-map "\C-cv"
-    'lisp-show-variable-documentation))
-
-
-;;;###autoload
-(defvar inferior-lisp-program "lisp"
-  "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.")
-
-;;;###autoload
-(defvar inferior-lisp-load-command "(load \"%s\")\n"
-  "*Format-string for building a Lisp expression to load a file.
-This format string should use `%s' to substitute a file name
-and should result in a Lisp expression that will command the inferior Lisp
-to load that file.  The default works acceptably on most Lisps.
-The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\"
-produces cosmetically superior output for this application,
-but it works only in Common Lisp.")
-
-;;;###autoload
-(defvar inferior-lisp-prompt "^[^> \n]*>+:? *"
-  "Regexp to recognise prompts in the Inferior Lisp mode.
-Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl,
-and franz.  This variable is used to initialize `comint-prompt-regexp' in the 
-Inferior Lisp buffer.
-
-More precise choices:
-Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
-franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
-kcl: \"^>+ *\"
-
-This is a fine thing to set in your .emacs file.")
-
-(defvar inferior-lisp-buffer nil "*The current inferior-lisp process buffer.
-
-MULTIPLE PROCESS SUPPORT
-===========================================================================
-To run multiple Lisp processes, you start the first up
-with \\[inferior-lisp].  It will be in a buffer named `*inferior-lisp*'.
-Rename this buffer with \\[rename-buffer].  You may now start up a new
-process with another \\[inferior-lisp].  It will be in a new buffer,
-named `*inferior-lisp*'.  You can switch between the different process
-buffers with \\[switch-to-buffer].
-
-Commands that send text from source buffers to Lisp processes --
-like `lisp-eval-defun' or `lisp-show-arglist' -- have to choose a process
-to send to, when you have more than one Lisp process around.  This
-is determined by the global variable `inferior-lisp-buffer'.  Suppose you
-have three inferior Lisps running:
-    Buffer              Process
-    foo                 inferior-lisp
-    bar                 inferior-lisp<2>
-    *inferior-lisp*     inferior-lisp<3>
-If you do a \\[lisp-eval-defun] command on some Lisp source code, 
-what process do you send it to?
-
-- If you're in a process buffer (foo, bar, or *inferior-lisp*), 
-  you send it to that process.
-- If you're in some other buffer (e.g., a source file), you
-  send it to the process attached to buffer `inferior-lisp-buffer'.
-This process selection is performed by function `inferior-lisp-proc'.
-
-Whenever \\[inferior-lisp] fires up a new process, it resets
-`inferior-lisp-buffer' to be the new process's buffer.  If you only run
-one process, this does the right thing.  If you run multiple
-processes, you can change `inferior-lisp-buffer' to another process
-buffer with \\[set-variable].")
-
-;;;###autoload
-(defvar inferior-lisp-mode-hook '() 
-  "*Hook for customizing Inferior Lisp mode.")
-
-(defun inferior-lisp-mode () 
-  "Major mode for interacting with an inferior Lisp process.  
-Runs a Lisp interpreter as a subprocess of Emacs, with Lisp I/O through an
-Emacs buffer.  Variable `inferior-lisp-program' controls which Lisp interpreter
-is run.  Variables `inferior-lisp-prompt', `inferior-lisp-filter-regexp' and
-`inferior-lisp-load-command' can customize this mode for different Lisp
-interpreters.
-
-For information on running multiple processes in multiple buffers, see
-documentation for variable `inferior-lisp-buffer'.
-
-\\{inferior-lisp-mode-map}
-
-Customization: Entry to this mode runs the hooks on `comint-mode-hook' and
-`inferior-lisp-mode-hook' (in that order).
-
-You can send text to the inferior Lisp process from other buffers containing
-Lisp source.  
-    switch-to-lisp switches the current buffer to the Lisp process buffer.
-    lisp-eval-defun sends the current defun to the Lisp process.
-    lisp-compile-defun compiles the current defun.
-    lisp-eval-region sends the current region to the Lisp process.
-    lisp-compile-region compiles the current region.
-
-    Prefixing the lisp-eval/compile-defun/region commands with
-    a \\[universal-argument] causes a switch to the Lisp process buffer after sending
-    the text.
-
-Commands:
-Return after the end of the process' output sends the text from the 
-    end of process to point.
-Return before the end of the process' output copies the sexp ending at point
-    to the end of the process' output, and sends it.
-Delete converts tabs to spaces as it moves back.
-Tab indents for Lisp; with argument, shifts rest
-    of expression rigidly with the current line.
-C-M-q does Tab on each line starting within following expression.
-Paragraphs are separated only by blank lines.  Semicolons start comments.
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it."
-  (interactive)
-  (comint-mode)
-  (setq comint-prompt-regexp inferior-lisp-prompt)
-  (setq major-mode 'inferior-lisp-mode)
-  (setq mode-name "Inferior Lisp")
-  (setq mode-line-process '(":%s"))
-  (lisp-mode-variables t)
-  (use-local-map inferior-lisp-mode-map)    ;c-c c-k for "kompile" file
-  (setq comint-get-old-input (function lisp-get-old-input))
-  (setq comint-input-filter (function lisp-input-filter))
-  (setq comint-input-sentinel 'ignore)
-  (run-hooks 'inferior-lisp-mode-hook))
-
-(defun lisp-get-old-input ()
-  "Return a string containing the sexp ending at point."
-  (save-excursion
-    (let ((end (point)))
-      (backward-sexp)
-      (buffer-substring (point) end))))
-
-(defun lisp-input-filter (str)
-  "t if STR does not match `inferior-lisp-filter-regexp'."
-  (not (string-match inferior-lisp-filter-regexp str)))
-
-;;;###autoload
-(defun inferior-lisp (cmd)
-  "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
-If there is a process already running in `*inferior-lisp*', just switch
-to that buffer.
-With argument, allows you to edit the command line (default is value
-of `inferior-lisp-program').  Runs the hooks from
-`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
-\(Type \\[describe-mode] in the process buffer for a list of commands.)"
-  (interactive (list (if current-prefix-arg
-			 (read-string "Run lisp: " inferior-lisp-program)
-		       inferior-lisp-program)))
-  (if (not (comint-check-proc "*inferior-lisp*"))
-      (let ((cmdlist (inferior-lisp-args-to-list cmd)))
-	(set-buffer (apply (function make-comint)
-			   "inferior-lisp" (car cmdlist) nil (cdr cmdlist)))
-	(inferior-lisp-mode)))
-  (setq inferior-lisp-buffer "*inferior-lisp*")
-  (pop-to-buffer "*inferior-lisp*"))
-;;;###autoload (add-hook 'same-window-buffer-names "*inferior-lisp*")
-
-;;;###autoload
-(define-function 'run-lisp 'inferior-lisp)
-
-;;; Break a string up into a list of arguments.
-;;; This will break if you have an argument with whitespace, as in
-;;; string = "-ab +c -x 'you lose'".
-(defun inferior-lisp-args-to-list (string)
-  (let ((where (string-match "[ \t]" string)))
-    (cond ((null where) (list string))
-	  ((not (= where 0))
-	   (cons (substring string 0 where)
-		 (inferior-lisp-args-to-list (substring string (+ 1 where)
-							(length string)))))
-	  (t (let ((pos (string-match "[^ \t]" string)))
-	       (if (null pos)
-		   nil
-		 (inferior-lisp-args-to-list (substring string pos
-							(length string)))))))))
-
-(defun lisp-eval-region (start end &optional and-go)
-  "Send the current region to the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "r\nP")
-  (comint-send-region (inferior-lisp-proc) start end)
-  (comint-send-string (inferior-lisp-proc) "\n")
-  (if and-go (switch-to-lisp t)))
-
-(defun lisp-eval-defun (&optional and-go)
-  "Send the current defun to the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "P")
-  (save-excursion
-   (end-of-defun)
-    (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
-   (let ((end (point)))
-     (beginning-of-defun)
-      (lisp-eval-region (point) end)))
-  (if and-go (switch-to-lisp t)))
-			 
-(defun lisp-eval-last-sexp (&optional and-go)
-  "Send the previous sexp to the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "P")
-  (lisp-eval-region (save-excursion (backward-sexp) (point)) (point) and-go))
-
-;;; Common Lisp COMPILE sux. 
-(defun lisp-compile-region (start end &optional and-go)
-  "Compile the current region in the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "r\nP")
-  (comint-send-string
-   (inferior-lisp-proc)
-   (format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n"
-	   (buffer-substring start end)))
-  (if and-go (switch-to-lisp t)))
-			 
-(defun lisp-compile-defun (&optional and-go)
-  "Compile the current defun in the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "P")
-  (save-excursion
-    (end-of-defun)
-    (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
-    (let ((e (point)))
-      (beginning-of-defun)
-      (lisp-compile-region (point) e)))
-  (if and-go (switch-to-lisp t)))
-
-(defun switch-to-lisp (eob-p)
-  "Switch to the inferior Lisp process buffer.
-With argument, positions cursor at end of buffer."
-  (interactive "P")
-  (if (get-buffer inferior-lisp-buffer)
-      (pop-to-buffer inferior-lisp-buffer)
-    (error "No current inferior Lisp buffer"))
-  (cond (eob-p
-	 (push-mark)
-	 (goto-char (point-max)))))
-
-
-;;; Now that lisp-compile/eval-defun/region takes an optional prefix arg,
-;;; these commands are redundant. But they are kept around for the user
-;;; to bind if he wishes, for backwards functionality, and because it's
-;;; easier to type C-c e than C-u C-c C-e.
-
-(defun lisp-eval-region-and-go (start end)
-  "Send the current region to the inferior Lisp, and switch to its buffer."
-  (interactive "r")
-  (lisp-eval-region start end t))
-
-(defun lisp-eval-defun-and-go ()
-  "Send the current defun to the inferior Lisp, and switch to its buffer."
-  (interactive)
-  (lisp-eval-defun t))
-
-(defun lisp-compile-region-and-go (start end)
-  "Compile the current region in the inferior Lisp, and switch to its buffer."
-  (interactive "r")
-  (lisp-compile-region start end t))
-
-(defun lisp-compile-defun-and-go ()
-  "Compile the current defun in the inferior Lisp, and switch to its buffer."
-  (interactive)
-  (lisp-compile-defun t))
-
-;;; A version of the form in H. Shevis' soar-mode.el package. Less robust.
-;;; (defun lisp-compile-sexp (start end)
-;;;   "Compile the s-expression bounded by START and END in the inferior lisp.
-;;; If the sexp isn't a DEFUN form, it is evaluated instead."
-;;;   (cond ((looking-at "(defun\\s +")
-;;; 	 (goto-char (match-end 0))
-;;; 	 (let ((name-start (point)))
-;;; 	   (forward-sexp 1)
-;;; 	   (process-send-string "inferior-lisp"
-;;; 				(format "(compile '%s #'(lambda "
-;;; 					(buffer-substring name-start
-;;; 							  (point)))))
-;;; 	 (let ((body-start (point)))
-;;; 	   (goto-char start) (forward-sexp 1) ; Can't use end-of-defun.
-;;; 	   (process-send-region "inferior-lisp"
-;;; 				(buffer-substring body-start (point))))
-;;; 	 (process-send-string "inferior-lisp" ")\n"))
-;;; 	(t (lisp-eval-region start end)))))
-;;; 
-;;; (defun lisp-compile-region (start end)
-;;;   "Each s-expression in the current region is compiled (if a DEFUN)
-;;; or evaluated (if not) in the inferior lisp."
-;;;   (interactive "r")
-;;;   (save-excursion
-;;;     (goto-char start) (end-of-defun) (beginning-of-defun) ; error check
-;;;     (if (< (point) start) (error "region begins in middle of defun"))
-;;;     (goto-char start)
-;;;     (let ((s start))
-;;;       (end-of-defun)
-;;;       (while (<= (point) end) ; Zip through
-;;; 	(lisp-compile-sexp s (point)) ; compiling up defun-sized chunks.
-;;; 	(setq s (point))
-;;; 	(end-of-defun))
-;;;       (if (< s end) (lisp-compile-sexp s end)))))
-;;; 
-;;; End of HS-style code
-
-
-(defvar lisp-prev-l/c-dir/file nil
-  "Record last directory and file used in loading or compiling.
-This holds a cons cell of the form `(DIRECTORY . FILE)'
-describing the last `lisp-load-file' or `lisp-compile-file' command.")
-
-(defvar lisp-source-modes '(lisp-mode)
-  "*Used to determine if a buffer contains Lisp source code.
-If it's loaded into a buffer that is in one of these major modes, it's
-considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'.
-Used by these commands to determine defaults.")
-
-(defun lisp-load-file (file-name)
-  "Load a Lisp file into the inferior Lisp process."
-  (interactive (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file
-				  lisp-source-modes nil))  ; NIL because LOAD
-					; doesn't need an exact name
-  (comint-check-source file-name) ; Check to see if buffer needs saved.
-  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
-				     (file-name-nondirectory file-name)))
-  (comint-send-string (inferior-lisp-proc)
-		      (format inferior-lisp-load-command file-name))
-  (switch-to-lisp t))
-
-(defun lisp-compile-file (file-name)
-  "Compile a Lisp file in the inferior Lisp process."
-  (interactive (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file
-				  lisp-source-modes nil)) ; NIL = don't need
-                                                          ; suffix .lisp
-  (comint-check-source file-name) ; Check to see if buffer needs saved.
-  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
-				     (file-name-nondirectory file-name)))
-  (comint-send-string (inferior-lisp-proc) (concat "(compile-file \""
-						   file-name
-						   "\"\)\n"))
-  (switch-to-lisp t))
-
-
-
-;;; Documentation functions: function doc, var doc, arglist, and
-;;; describe symbol.
-;;; ===========================================================================
-
-;;; Command strings
-;;; ===============
-
-(defvar lisp-function-doc-command
-  "(let ((fn '%s))
-     (format t \"Documentation for ~a:~&~a\"
-	     fn (documentation fn 'function))
-     (values))\n"
-  "Command to query inferior Lisp for a function's documentation.")
-
-(defvar lisp-var-doc-command
-  "(let ((v '%s))
-     (format t \"Documentation for ~a:~&~a\"
-	     v (documentation v 'variable))
-     (values))\n"
-  "Command to query inferior Lisp for a variable's documentation.")
-
-(defvar lisp-arglist-command
-  "(let ((fn '%s))
-     (format t \"Arglist for ~a: ~a\" fn (arglist fn))
-     (values))\n"
-  "Command to query inferior Lisp for a function's arglist.")
-
-(defvar lisp-describe-sym-command
-  "(describe '%s)\n"
-  "Command to query inferior Lisp for a variable's documentation.")
-
-
-;;; Ancillary functions
-;;; ===================
-
-;;; Reads a string from the user.
-(defun lisp-symprompt (prompt default)
-  (list (let* ((prompt (if default
-			   (format "%s (default %s): " prompt default)
-			 (concat prompt ": ")))
-	       (ans (read-string prompt)))
-	  (if (zerop (length ans)) default ans))))
-
-
-;;; Adapted from function-called-at-point in help.el.
-(defun lisp-fn-called-at-pt ()
-  "Returns the name of the function called in the current call.
-The value is nil if it can't find one."
-  (condition-case nil
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
-	  (backward-up-list 1)
-	  (forward-char 1)
-	  (let ((obj (read (current-buffer))))
-	    (and (symbolp obj) obj))))
-    (error nil)))
-
-
-;;; Adapted from variable-at-point in help.el.
-(defun lisp-var-at-pt ()
-  (condition-case ()
-      (save-excursion
-	(forward-sexp -1)
-	(skip-chars-forward "'")
-	(let ((obj (read (current-buffer))))
-	  (and (symbolp obj) obj)))
-    (error nil)))
-
-
-;;; Documentation functions: fn and var doc, arglist, and symbol describe.
-;;; ======================================================================
-
-(defun lisp-show-function-documentation (fn)
-  "Send a command to the inferior Lisp to give documentation for function FN.
-See variable `lisp-function-doc-command'."
-  (interactive (lisp-symprompt "Function doc" (lisp-fn-called-at-pt)))
-  (comint-proc-query (inferior-lisp-proc)
-		     (format lisp-function-doc-command fn)))
-
-(defun lisp-show-variable-documentation (var)
-  "Send a command to the inferior Lisp to give documentation for function FN.
-See variable `lisp-var-doc-command'."
-  (interactive (lisp-symprompt "Variable doc" (lisp-var-at-pt)))
-  (comint-proc-query (inferior-lisp-proc) (format lisp-var-doc-command var)))
-
-(defun lisp-show-arglist (fn)
-  "Send a query to the inferior Lisp for the arglist for function FN.
-See variable `lisp-arglist-command'."
-  (interactive (lisp-symprompt "Arglist" (lisp-fn-called-at-pt)))
-  (comint-proc-query (inferior-lisp-proc) (format lisp-arglist-command fn)))
-
-(defun lisp-describe-sym (sym)
-  "Send a command to the inferior Lisp to describe symbol SYM.
-See variable `lisp-describe-sym-command'."
-  (interactive (lisp-symprompt "Describe" (lisp-var-at-pt)))
-  (comint-proc-query (inferior-lisp-proc)
-		     (format lisp-describe-sym-command sym)))
-
-
-;;  "Returns the current inferior Lisp process.
-;; See variable `inferior-lisp-buffer'."
-(defun inferior-lisp-proc ()
-  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-lisp-mode)
-				      (current-buffer)
-				    inferior-lisp-buffer))))
-    (or proc
-	(error "No Lisp subprocess; see variable `inferior-lisp-buffer'"))))
-
-
-;;; Do the user's customization...
-;;;===============================
-(defvar inferior-lisp-load-hook nil
-  "This hook is run when the library `inf-lisp' is loaded.
-This is a good place to put keybindings.")
-
-(run-hooks 'inferior-lisp-load-hook)
-
-;;; CHANGE LOG
-;;; ===========================================================================
-;;; 7/21/92 Jim Blandy
-;;; - Changed all uses of the cmulisp name or prefix to inferior-lisp;
-;;;   this is now the official inferior lisp package.  Use the global
-;;;   ChangeLog from now on.
-;;; 5/24/90 Olin
-;;; - Split cmulisp and cmushell modes into separate files. 
-;;;   Not only is this a good idea, it's apparently the way it'll be rel 19.
-;;; - Upgraded process sends to use comint-send-string instead of
-;;;   process-send-string.
-;;; - Explicit references to process "cmulisp" have been replaced with
-;;;   (cmulisp-proc). This allows better handling of multiple process bufs.
-;;; - Added process query and var/function/symbol documentation
-;;;   commands. Based on code written by Douglas Roberts.
-;;; - Added lisp-eval-last-sexp, bound to C-x C-e.
-;;;
-;;; 9/20/90 Olin
-;;; Added a save-restriction to lisp-fn-called-at-pt. This bug and fix
-;;; reported by Lennart Staflin.
-;;;
-;;; 3/12/90 Olin
-;;; - lisp-load-file and lisp-compile-file no longer switch-to-lisp.
-;;;   Tale suggested this.
-;;; - Reversed this decision 7/15/91. You need the visual feedback.
-;;;
-;;; 7/25/91 Olin
-;;; Changed all keybindings of the form C-c . These are
-;;; supposed to be reserved for the user to bind. This affected
-;;; mainly the compile/eval-defun/region[-and-go] commands.
-;;; This was painful, but necessary to adhere to the gnumacs standard.
-;;; For some backwards compatibility, see the 
-;;;     cmulisp-install-letter-bindings
-;;; function.
-;;;
-;;; 8/2/91 Olin
-;;; - The lisp-compile/eval-defun/region commands now take a prefix arg,
-;;;   which means switch-to-lisp after sending the text to the Lisp process.
-;;;   This obsoletes all the -and-go commands. The -and-go commands are
-;;;   kept around for historical reasons, and because the user can bind
-;;;   them to key sequences shorter than C-u C-c C-.
-;;; - If M-x cmulisp is invoked with a prefix arg, it allows you to
-;;;   edit the command line.
-
-(provide 'inf-lisp)
-
-;;; inf-lisp.el ends here
diff --git a/xemacs-packages/lisp/os-utils/jka-compr.el b/xemacs-packages/lisp/os-utils/jka-compr.el
deleted file mode 100644
index f6bba049..00000000
--- a/xemacs-packages/lisp/os-utils/jka-compr.el
+++ /dev/null
@@ -1,989 +0,0 @@
-;;; jka-compr.el --- reading/writing/loading compressed files
-
-;; Copyright (C) 1993, 1994  Free Software Foundation, Inc.
-
-;; Author: jka@ece.cmu.edu (Jay K. Adams)
-;; Maintainer: XEmacs Development Team
-;; Keywords: data
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;; Synched up with: FSF 20.3.10.1
-
-;;; Commentary: 
-
-;; This package implements low-level support for reading, writing,
-;; and loading compressed files.  It hooks into the low-level file
-;; I/O functions (including write-region and insert-file-contents) so
-;; that they automatically compress or uncompress a file if the file
-;; appears to need it (based on the extension of the file name).
-;; Packages like Rmail, VM, GNUS, and Info should be able to work
-;; with compressed files without modification.
-
-
-;; INSTRUCTIONS:
-;;
-;; To use jka-compr, simply load this package, and edit as usual.
-;; Its operation should be transparent to the user (except for
-;; messages appearing when a file is being compressed or
-;; uncompressed).
-;;
-;; The variable, jka-compr-compression-info-list can be used to
-;; customize jka-compr to work with other compression programs.
-;; The default value of this variable allows jka-compr to work with
-;; Unix compress and gzip.
-;;
-;; If you are concerned about the stderr output of gzip and other
-;; compression/decompression programs showing up in your buffers, you
-;; should set the discard-error flag in the compression-info-list.
-;; This will cause the stderr of all programs to be discarded.
-;; However, it also causes emacs to call compression/uncompression
-;; programs through a shell (which is specified by jka-compr-shell).
-;; This may be a drag if, on your system, starting up a shell is
-;; slow.
-;;
-;; If you don't want messages about compressing and decompressing
-;; to show up in the echo area, you can set the compress-name and
-;; decompress-name fields of the jka-compr-compression-info-list to
-;; nil.
-
-
-;; APPLICATION NOTES:
-;;
-;; crypt++
-;;   jka-compr can coexist with crypt++ if you take all the decompression
-;;   entries out of the crypt-encoding-list.  Clearly problems will arise if
-;;   you have two programs trying to compress/decompress files.  jka-compr
-;;   will not "work with" crypt++ in the following sense: you won't be able to
-;;   decode encrypted compressed files--that is, files that have been
-;;   compressed then encrypted (in that order).  Theoretically, crypt++ and
-;;   jka-compr could properly handle a file that has been encrypted then
-;;   compressed, but there is little point in trying to compress an encrypted
-;;   file.
-;;
-
-
-;; ACKNOWLEDGMENTS
-;; 
-;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs.  Many people
-;; have made helpful suggestions, reported bugs, and even fixed bugs in 
-;; jka-compr.  I recall the following people as being particularly helpful.
-;;
-;;   Jean-loup Gailly
-;;   David Hughes
-;;   Richard Pieri
-;;   Daniel Quinlan
-;;   Chris P. Ross
-;;   Rick Sladkey
-;;
-;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
-;; Version 18 of Emacs.
-;;
-;; After I had made progress on the original jka-compr for V18, I learned of a
-;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
-;; what I was trying to do.  I looked over the jam-zcat source code and
-;; probably got some ideas from it.
-;;
-
-;;; Code:
-
-(defgroup compression nil
-  "Data compression utilities"
-  :group 'data)
-
-(defgroup jka-compr nil
-  "jka-compr customization"
-  :group 'compression)
-
-
-(defcustom jka-compr-shell "sh"
-  "*Shell to be used for calling compression programs.
-The value of this variable only matters if you want to discard the
-stderr of a compression/decompression program (see the documentation
-for `jka-compr-compression-info-list')."
-  :type 'string
-  :group 'jka-compr)
-
-(defvar jka-compr-use-shell
-  (not (memq system-type '(ms-dos windows-nt))))
-
-;;; I have this defined so that .Z files are assumed to be in unix
-;;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
-(defcustom jka-compr-compression-info-list
-  ;;[regexp
-  ;; compr-message  compr-prog  compr-args
-  ;; uncomp-message uncomp-prog uncomp-args
-  ;; can-append auto-mode-flag]
-  '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
-     "compressing"    "compress"     ("-c")
-     "uncompressing"  "uncompress"   ("-c")
-     nil t]
-    ["\\.bz2\\(~\\|\\.~[0-9]+~\\)?\\'" ; XEmacs change
-     "bzip2ing"       "bzip2"        nil
-     "unbzip2ing"     "bzip2"        ("-d")
-     nil t]
-    ["\\.tgz\\'"
-     "zipping"        "gzip"         ("-c" "-q")
-     "unzipping"      "gzip"         ("-c" "-q" "-d")
-     t nil]
-    ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'"
-     "zipping"        "gzip"         ("-c" "-q")
-     "unzipping"      "gzip"         ("-c" "-q" "-d")
-     t t])
-
-  "List of vectors that describe available compression techniques.
-Each element, which describes a compression technique, is a vector of
-the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
-UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
-APPEND-FLAG EXTENSION], where:
-
-   regexp                is a regexp that matches filenames that are
-                         compressed with this format
-
-   compress-msg          is the message to issue to the user when doing this
-                         type of compression (nil means no message)
-
-   compress-program      is a program that performs this compression
-
-   compress-args         is a list of args to pass to the compress program
-
-   uncompress-msg        is the message to issue to the user when doing this
-                         type of uncompression (nil means no message)
-
-   uncompress-program    is a program that performs this compression
-
-   uncompress-args       is a list of args to pass to the uncompress program
-
-   append-flag           is non-nil if this compression technique can be
-                         appended
-
-   auto-mode flag        non-nil means strip the regexp from file names
-                         before attempting to set the mode.
-
-Because of the way `call-process' is defined, discarding the stderr output of
-a program adds the overhead of starting a shell each time the program is
-invoked."
-  :type '(repeat (vector :tag "Compression Technique" ; XEmacs change
-			 regexp
-			 (choice :tag "Compress Message"
-				 (string :format "%v")
-				 (const :tag "No Message" nil))
-			 (string :tag "Compress Program")
-			 (repeat :tag "Compress Arguments" string)
-			 (choice :tag "Uncompress Message"
-				 (string :format "%v")
-				 (const :tag "No Message" nil))
-			 (string :tag "Uncompress Program")
-			 (repeat :tag "Uncompress Arguments" string)
-			 (boolean :tag "Append")
-			 (boolean :tag "Auto Mode")))
-  :group 'jka-compr)
-
-(defvar jka-compr-mode-alist-additions
-  (list (cons "\\.tgz\\'" 'tar-mode))
-  "A list of pairs to add to `auto-mode-alist' when jka-compr is installed.")
-
-;; List of all the elements we actually added to file-coding-system-alist.
-(defvar jka-compr-added-to-file-coding-system-alist nil)
-
-(defvar jka-compr-file-name-handler-entry
-  nil
-  "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
-
-;;; Functions for accessing the return value of jka-compr-get-compression-info
-(defun jka-compr-info-regexp               (info)  (aref info 0))
-(defun jka-compr-info-compress-message     (info)  (aref info 1))
-(defun jka-compr-info-compress-program     (info)  (aref info 2))
-(defun jka-compr-info-compress-args        (info)  (aref info 3))
-(defun jka-compr-info-uncompress-message   (info)  (aref info 4))
-(defun jka-compr-info-uncompress-program   (info)  (aref info 5))
-(defun jka-compr-info-uncompress-args      (info)  (aref info 6))
-(defun jka-compr-info-can-append           (info)  (aref info 7))
-(defun jka-compr-info-strip-extension      (info)  (aref info 8))
-
-
-(defun jka-compr-get-compression-info (filename)
-  "Return information about the compression scheme of FILENAME.
-The determination as to which compression scheme, if any, to use is
-based on the filename itself and `jka-compr-compression-info-list'."
-  (catch 'compression-info
-    (let ((case-fold-search nil))
-      (mapcar
-       (function (lambda (x)
-		   (and (string-match (jka-compr-info-regexp x) filename)
-			(throw 'compression-info x))))
-       jka-compr-compression-info-list)
-      nil)))
-
-
-;; XEmacs change
-(defmacro jka-value-if-bound (symbol)
-  `(if (boundp (quote ,symbol)) ,symbol))
-
-;; XEmacs change
-(define-error 'compression-error "Compression error" 'file-error)
-
-(defvar jka-compr-acceptable-retval-list '(0 2 141))
-
-
-(defun jka-compr-error (prog args infile message &optional errfile)
-
-  (let ((errbuf (get-buffer-create " *jka-compr-error*"))
-	(curbuf (current-buffer)))
-    (with-current-buffer errbuf
-      (widen) (erase-buffer)
-      (insert (format "Error while executing \"%s %s < %s\"\n\n"
-		      prog
-		      (mapconcat 'identity args " ")
-		      infile))
-
-      (and errfile
-	   (insert-file-contents errfile)))
-     (display-buffer errbuf))
-
-  (signal 'compression-error
-	  (list "Opening input file" (format "error %s" message) infile)))
-
-
-(defvar jka-compr-dd-program
-  "/bin/dd")
-
-
-(defvar jka-compr-dd-blocksize 256)
-
-
-(defun jka-compr-partial-uncompress (prog message args infile beg len)
-  "Call program PROG with ARGS args taking input from INFILE.
-Fourth and fifth args, BEG and LEN, specify which part of the output
-to keep: LEN chars starting BEG chars from the beginning."
-  (let* ((skip (/ beg jka-compr-dd-blocksize))
-	 (prefix (- beg (* skip jka-compr-dd-blocksize)))
-	 (count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
-	 (start (point))
-	 (err-file (jka-compr-make-temp-name))
-	 (run-string (format "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null"
-			     prog
-			     (mapconcat 'identity args " ")
-			     err-file
-			     jka-compr-dd-program
-			     jka-compr-dd-blocksize
-			     skip
-			     ;; dd seems to be unreliable about
-			     ;; providing the last block.  So, always
-			     ;; read one more than you think you need.
-			     ;; XEmacs change -- de-ebolify
-			     (if count
-				 (concat "count=" (number-to-string (1+ count)))
-			       ""))))
-
-    (unwind-protect
-	(or (memq (call-process jka-compr-shell
-				infile t nil "-c"
-				run-string)
-		  jka-compr-acceptable-retval-list)
-	    
-	    (jka-compr-error prog args infile message err-file))
-
-      (jka-compr-delete-temp-file err-file))
-
-    ;; Delete the stuff after what we want, if there is any.
-    (and
-     len
-     (< (+ start prefix len) (point))
-     (delete-region (+ start prefix len) (point)))
-
-    ;; Delete the stuff before what we want.
-    (delete-region start (+ start prefix))))
-
-
-(defun jka-compr-call-process (prog message infile output temp args)
-  (if jka-compr-use-shell
-
-      (let ((err-file (jka-compr-make-temp-name))
-	    (coding-system-for-read (or
-				     ;; XEmacs Change
-				     (jka-value-if-bound
-				           coding-system-for-read) 
-				     'undecided))
-	    (coding-system-for-write 'binary))
-	    
-	(unwind-protect
-
-	    (or (memq
-		 (call-process jka-compr-shell infile
-			       (if (stringp output) nil output)
-			       nil
-			       "-c"
-			       (format "%s %s 2> %s %s"
-				       prog
-				       (mapconcat 'identity args " ")
-				       err-file
-				       (if (stringp output)
-					   (concat "> " output)
-					 "")))
-		 jka-compr-acceptable-retval-list)
-
-		(jka-compr-error prog args infile message err-file))
-
-	  (jka-compr-delete-temp-file err-file)))
-
-    (or (zerop
-	 (apply 'call-process
-		prog
-		infile
-		(if (stringp output) temp output)
-		nil
-		args))
-	(jka-compr-error prog args infile message))
-
-    (and (stringp output)
-	 (with-current-buffer temp
-	   (write-region (point-min) (point-max) output)
-	   (erase-buffer)))))
-
-
-;;; Support for temp files.  Much of this was inspired if not lifted
-;;; from ange-ftp.
-
-(defcustom jka-compr-temp-name-template
-  (expand-file-name "jka-com" (temp-directory))
-  "Prefix added to all temp files created by jka-compr.
-There should be no more than seven characters after the final `/'."
-  :type 'string
-  :group 'jka-compr)
-
-(defvar jka-compr-temp-name-table (make-vector 31 nil))
-
-(defun jka-compr-make-temp-name (&optional local-copy)
-  "This routine will return the name of a new file."
-  (let* ((lastchar ?a)
-	 (prevchar ?a)
-	 (template (concat jka-compr-temp-name-template "aa"))
-	 (lastpos (1- (length template)))
-	 (not-done t)
-	 file
-	 entry)
-
-    (while not-done
-      (aset template lastpos lastchar)
-      (setq file (concat (make-temp-name template) "#"))
-      (setq entry (intern file jka-compr-temp-name-table))
-      (if (or (get entry 'active)
-	      (file-exists-p file))
-
-	  (progn
-	    (setq lastchar (1+ lastchar))
-	    (if (> lastchar ?z)
-		(progn
-		  (setq prevchar (1+ prevchar))
-		  (setq lastchar ?a)
-		  (if (> prevchar ?z)
-		      (error "Can't allocate temp file.")
-		    (aset template (1- lastpos) prevchar)))))
-
-	(put entry 'active (not local-copy))
-	(setq not-done nil)))
-
-    file))
-
-
-(defun jka-compr-delete-temp-file (temp)
-
-  (put (intern temp jka-compr-temp-name-table)
-       'active nil)
-
-  (condition-case ()
-      (delete-file temp)
-    (error nil)))
-
-;;; 20.0-b92 change
-;;; Now receives both `lockname' and `codesys' from Fwrite_region_internal
-;;; what makes it compatible with write-region
-(defun jka-compr-write-region (start end file &optional append visit lockname coding-system)
-  (let* ((filename (expand-file-name file))
-	 (visit-file (if (stringp visit) (expand-file-name visit) filename))
-	 (info (jka-compr-get-compression-info visit-file)))
-      
-      (if info
-
-	  (let ((can-append (jka-compr-info-can-append info))
-		(compress-program (jka-compr-info-compress-program info))
-		(compress-message (jka-compr-info-compress-message info))
-		(uncompress-program (jka-compr-info-uncompress-program info))
-		(uncompress-message (jka-compr-info-uncompress-message info))
-		(compress-args (jka-compr-info-compress-args info))
-		(uncompress-args (jka-compr-info-uncompress-args info))
-		(base-name (file-name-nondirectory visit-file))
-		temp-file temp-buffer
-		;; we need to leave `last-coding-system-used' set to its
-		;; value after calling write-region the first time, so
-		;; that `basic-save-buffer' sees the right value.
-		;; XEmacs change: we don't have `last-coding-system-used'.
-		;; (coding-system-used last-coding-system-used)
-		)
-
-	    (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
-	    (with-current-buffer temp-buffer
-	      (widen) (erase-buffer))
-
-	    (if (and append
-		     (not can-append)
-		     (file-exists-p filename))
-		
-		(let* ((local-copy (file-local-copy filename))
-		       (local-file (or local-copy filename)))
-		  
-		  (setq temp-file local-file))
-
-	      (setq temp-file (jka-compr-make-temp-name)))
-
-	    (and 
-	     compress-message
-	     (message "%s %s..." compress-message base-name))
-	    
-	    (jka-compr-run-real-handler 'write-region
-					;; XEmacs change: add lockname, c-s
-					(list start end temp-file t 'dont
-					      lockname coding-system
-					      ))
-
-	    ;; save value used by the real write-region
-	    ;; without any code conversion.
-	    (let ((coding-system-for-read 'binary))
-	      (jka-compr-call-process compress-program
-				      (concat compress-message
-					      " " base-name)
-				      temp-file
-				      temp-buffer
-				      nil
-				      compress-args))
-
-	    (with-current-buffer temp-buffer
-	      (let ((coding-system-for-write 'binary))
-		(if (memq system-type '(ms-dos windows-nt))
-		    (setq buffer-file-type t) )
-		(jka-compr-run-real-handler 'write-region
-					    (list (point-min) (point-max)
-						  filename
-						  (and append can-append) 'dont
-						  lockname coding-system
-						  ))
-		(erase-buffer)) )
-	    (jka-compr-delete-temp-file temp-file)
-
-	    (and
-	     compress-message
-	     (message "%s %s...done" compress-message base-name))
-
-	    (cond
-	     ((eq visit t)
-	      (setq buffer-file-name filename)
-	      (set-visited-file-modtime))
-	     ((stringp visit)
-	      (setq buffer-file-name visit)
-	      (let ((buffer-file-name filename))
-		(set-visited-file-modtime))))
-
-	    (and (or (eq visit t)
-		     (eq visit nil)
-		     (stringp visit))
-		 (message "Wrote %s" visit-file))
-
-	    ;; ensure `last-coding-system-used' has an appropriate value
-	    ;; XEmacs change: don't have `last-coding-system-used'
-	    ;; (setq last-coding-system-used coding-system-used)
-
-	    nil)
-	      
-	(jka-compr-run-real-handler 'write-region
-				    (list start end filename append visit
-					  ;; XEmacs change
-					  lockname coding-system
-					  )))))
-
-
-(defun jka-compr-insert-file-contents (file &optional visit beg end replace)
-  "Insert contents of FILE in current buffer after point.
-Returns list of absolute file name and length of data inserted.
-
-If second argument VISIT is non-nil, the buffer's visited filename
-and last save file modtime are set, and it is marked unmodified.
-If visiting and the file does not exist, visiting is completed
-before the error is signaled.
-
-The optional third and fourth arguments BEG and END
-specify what portion of the file to insert.
-If VISIT is non-nil, BEG and END must be nil.
-If optional fifth argument REPLACE is non-nil,
-it means replace the current buffer contents (in the accessible portion)
-with the file contents.  This is better than simply deleting and inserting
-the whole thing because (1) it preserves some marker positions
-and (2) it puts less data in the undo list.  (#### Is (2) true?)
-
-Coding system determination differs from `insert-file-contents'.  It is set
-to 'undecided unless `coding-system-for-read' is bound.  WARNING: That means
-this function is likely broken under Mule.  Use jka-compr at your own risk
-in Mule Emacsen."
-  (barf-if-buffer-read-only)
-
-  (and (or beg end)
-       visit
-       (error "Attempt to visit less than an entire file"))
-
-  (let* ((filename (expand-file-name file))
-	 (info (jka-compr-get-compression-info filename)))
-
-    (if info
-
-	(let ((uncompress-message (jka-compr-info-uncompress-message info))
-	      (uncompress-program (jka-compr-info-uncompress-program info))
-	      (uncompress-args (jka-compr-info-uncompress-args info))
-	      (base-name (file-name-nondirectory filename))
-	      (notfound nil)
-	      (local-copy
-	       (jka-compr-run-real-handler 'file-local-copy (list filename)))
-	      local-file
-	      size start
-	      (coding-system-for-read	       
-	       (or
-		;; XEmacs change
-		(jka-value-if-bound coding-system-for-read)
-		'undecided)))
-		   ;; XEmacs change; skip multibyte-mode crap
-;		   (and (null enable-multibyte-characters)
-;			(or (auto-coding-alist-lookup
-;			     (jka-compr-byte-compiler-base-file-name file))
-;			    'raw-text))
-;		   (let ((coding (find-operation-coding-system
-;				  'insert-file-contents
-;				  (jka-compr-byte-compiler-base-file-name file))))
-;		     (and (consp coding) (car coding)))
-;		   'undecided)) )
-	  (setq local-file (or local-copy filename))
-
-	  (and
-	   visit
-	   (setq buffer-file-name filename))
-
-	  (unwind-protect		; to make sure local-copy gets deleted
-
-	      (progn
-		  
-		(and
-		 uncompress-message
-		 (message "%s %s..." uncompress-message base-name))
-
-		(condition-case error-code
-
-		    (progn
-		      (if replace
-			  (goto-char (point-min)))
-		      (setq start (point))
-		      (if (or beg end)
-			  (jka-compr-partial-uncompress uncompress-program
-							(concat uncompress-message
-								" " base-name)
-							uncompress-args
-							local-file
-							(or beg 0)
-							(if (and beg end)
-							    (- end beg)
-							  end))
-			;; If visiting, bind off buffer-file-name so that
-			;; file-locking will not ask whether we should
-			;; really edit the buffer.
-			(let ((buffer-file-name
-			       (if visit nil buffer-file-name)))
-			  (jka-compr-call-process uncompress-program
-						  (concat uncompress-message
-							  " " base-name)
-						  local-file
-						  t
-						  nil
-						  uncompress-args)))
-		      (setq size (- (point) start))
-		      (if replace
-			  (delete-region (point) (point-max)))
-		      (goto-char start))
-		  (error
-		   (if (and (eq (car error-code) 'file-error)
-			    (eq (nth 3 error-code) local-file))
-		       (if visit
-			   (setq notfound error-code)
-			 (signal 'file-error 
-				 (cons "Opening input file"
-				       (nthcdr 2 error-code))))
-		     (signal (car error-code) (cdr error-code))))))
-
-	    (and
-	     local-copy
-	     (file-exists-p local-copy)
-	     (delete-file local-copy)))
-
-	  (and
-	   visit
-	   (progn
-	     (unlock-buffer)
-	     (setq buffer-file-name filename)
-	     (set-visited-file-modtime)))
-	    
-	  (and
-	   uncompress-message
-	   (message "%s %s...done" uncompress-message base-name))
-
-	  (and
-	   visit
-	   notfound
-	   (signal 'file-error
-		   (cons "Opening input file" (nth 2 notfound))))
-
-	  ;; This is done in insert-file-contents after we return.
-	  ;; That is a little weird, but better to go along with it now
-	  ;; than to change it now.
-
-	  ;; Run the functions that insert-file-contents would.
-;	  (let ((p after-insert-file-functions)
-;		(insval size))
-;	    (while p
-;	      (setq insval (funcall (car p) size))
-;	      (if insval
-;		  (progn
-;		    (or (integerp insval)
-;			(signal 'wrong-type-argument
-;				(list 'integerp insval)))
-;		    (setq size insval)))
-;	      (setq p (cdr p))))
-
-	  (list filename size))
-
-      (jka-compr-run-real-handler 'insert-file-contents
-				  (list file visit beg end replace)))))
-
-
-(defun jka-compr-file-local-copy (file)
-  (let* ((filename (expand-file-name file))
-	 (info (jka-compr-get-compression-info filename)))
-
-    (if info
-
-	(let ((uncompress-message (jka-compr-info-uncompress-message info))
-	      (uncompress-program (jka-compr-info-uncompress-program info))
-	      (uncompress-args (jka-compr-info-uncompress-args info))
-	      (base-name (file-name-nondirectory filename))
-	      (local-copy
-	       (jka-compr-run-real-handler 'file-local-copy (list filename)))
-	      (temp-file (jka-compr-make-temp-name t))
-	      (temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
-	      (notfound nil)
-	      local-file)
-
-	  (setq local-file (or local-copy filename))
-
-	  (unwind-protect
-
-	      (with-current-buffer temp-buffer
-		  
-		(and
-		 uncompress-message
-		 (message "%s %s..." uncompress-message base-name))
-
-		;; Here we must read the output of uncompress program
-		;; and write it to TEMP-FILE without any code
-		;; conversion.  An appropriate code conversion (if
-		;; necessary) is done by the later I/O operation
-		;; (e.g. load).
-		(let ((coding-system-for-read 'binary)
-		      (coding-system-for-write 'binary))
-		  (jka-compr-call-process uncompress-program
-					  (concat uncompress-message
-						  " " base-name)
-					  local-file
-					  t
-					  nil
-					  uncompress-args)
-
-		  (and
-		   uncompress-message
-		   (message "%s %s...done" uncompress-message base-name))
-
-		  (write-region
-		   (point-min) (point-max) temp-file nil 'dont)))
-
-	    (and
-	     local-copy
-	     (file-exists-p local-copy)
-	     (delete-file local-copy))
-
-	    (kill-buffer temp-buffer))
-
-	  temp-file)
-	    
-      (jka-compr-run-real-handler 'file-local-copy (list filename)))))
-
-
-;;; Support for loading compressed files.
-;;; XEmacs: autoload this function
-;;;###autoload
-(defun jka-compr-load (file &optional noerror nomessage nosuffix)
-  "Documented as original."
-
-  (let* ((local-copy (jka-compr-file-local-copy file))
-	 (load-file (or local-copy file)))
-
-    (unwind-protect
-
-	(let (inhibit-file-name-operation
-	      inhibit-file-name-handlers)
-	  (or nomessage
-	      (message "Loading %s..." file))
-
-	  (let ((load-force-doc-strings t))
-	    (load load-file noerror t t))
-
-	  (or nomessage
-	      (message "Loading %s...done." file)))
-
-      (jka-compr-delete-temp-file local-copy))
-
-    t))
-
-(defun jka-compr-byte-compiler-base-file-name (file)
-  (let ((info (jka-compr-get-compression-info file)))
-    (if (and info (jka-compr-info-strip-extension info))
-	(save-match-data
-	  (substring file 0 (string-match (jka-compr-info-regexp info) file)))
-      file)))
-
-(put 'write-region 'jka-compr 'jka-compr-write-region)
-(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
-(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
-(put 'load 'jka-compr 'jka-compr-load)
-(put 'byte-compiler-base-file-name 'jka-compr
-     'jka-compr-byte-compiler-base-file-name)
-
-(defvar jka-compr-inhibit nil
-  "Non-nil means inhibit automatic uncompression temporarily.
-Lisp programs can bind this to t to do that.
-It is not recommended to set this variable permanently to anything but nil.")
-
-(defun jka-compr-handler (operation &rest args)
-  (save-match-data
-    (let ((jka-op (get operation 'jka-compr)))
-      (if (and jka-op (not jka-compr-inhibit))
-	  (apply jka-op args)
-	(jka-compr-run-real-handler operation args)))))
-
-;; If we are given an operation that we don't handle,
-;; call the Emacs primitive for that operation,
-;; and manipulate the inhibit variables
-;; to prevent the primitive from calling our handler again.
-(defun jka-compr-run-real-handler (operation args)
-  (let ((inhibit-file-name-handlers
-	 (cons 'jka-compr-handler
-	       (and (eq inhibit-file-name-operation operation)
-		    inhibit-file-name-handlers)))
-	(inhibit-file-name-operation operation))
-    (apply operation args)))
-
-;;;###autoload(defun auto-compression-mode (&optional arg)
-;;;###autoload  "\
-;;;###autoloadToggle automatic file compression and uncompression.
-;;;###autoloadWith prefix argument ARG, turn auto compression on if positive, else off.
-;;;###autoloadReturns the new status of auto compression (non-nil means on)."
-;;;###autoload  (interactive "P")
-;;;###autoload  (if (not (fboundp 'jka-compr-installed-p))
-;;;###autoload      (require 'jka-compr))
-;;;###autoload  (toggle-auto-compression arg t))
-
-;; XEmacs:  autoload this function
-;;;###autoload
-(defun toggle-auto-compression (&optional arg message)
-  "Toggle automatic file compression and uncompression.
-With prefix argument ARG, turn auto compression on if positive, else off.
-Returns the new status of auto compression (non-nil means on).
-If the argument MESSAGE is non-nil, it means to print a message
-saying whether the mode is now on or off."
-  (interactive "P\np")
-  (let* ((installed (jka-compr-installed-p))
-	 (flag (if (null arg)
-		   (not installed)
-		 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))))
-
-    (cond
-     ((and flag installed) t)		; already installed
-
-     ((and (not flag) (not installed)) nil) ; already not installed
-
-     (flag
-      (jka-compr-install))
-
-     (t
-      (jka-compr-uninstall)))
-
-
-    (and message
-	 (if flag
-	     (message "Automatic file (de)compression is now ON.")
-	   (message "Automatic file (de)compression is now OFF.")))
-
-    flag))
-
-(defun jka-compr-build-file-regexp ()
-  (concat
-   "\\("
-   (mapconcat
-    'jka-compr-info-regexp
-    jka-compr-compression-info-list
-    "\\)\\|\\(")
-   "\\)"))
-
-;;; XEmacs:
-;;;###autoload
-(defun jka-compr-install ()
-  "Install jka-compr.
-This adds entries to `file-name-handler-alist' and `auto-mode-alist'
-and `inhibit-first-line-modes-suffixes'."
-
-  (setq jka-compr-file-name-handler-entry
-	(cons (jka-compr-build-file-regexp) 'jka-compr-handler))
-
-  (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry
-				      file-name-handler-alist))
-
-  (when (boundp 'file-coding-system-alist)
-    (setq jka-compr-added-to-file-coding-system-alist nil))
-
-  (mapcar
-   (function (lambda (x)
-	       ;; Don't do multibyte encoding on the compressed files.
-	       (when (boundp 'file-coding-system-alist)
-	       (let ((elt (cons (jka-compr-info-regexp x)
-                                '(binary . binary))))
-		 (setq file-coding-system-alist
-		       (cons elt file-coding-system-alist))
-		 (setq jka-compr-added-to-file-coding-system-alist
-		       (cons elt jka-compr-added-to-file-coding-system-alist)))
-	       )
-	       (and (jka-compr-info-strip-extension x)
-		    ;; Make entries in auto-mode-alist so that modes
-		    ;; are chosen right according to the file names
-		    ;; sans `.gz'.
-		    (setq auto-mode-alist
-			  (cons (list (jka-compr-info-regexp x)
-				      nil 'jka-compr)
-				auto-mode-alist))
-		    ;; Also add these regexps to
-		    ;; inhibit-first-line-modes-suffixes, so that a
-		    ;; -*- line in the first file of a compressed tar
-		    ;; file doesn't override tar-mode.
-		    ;; XEmacs: the (now)superfluous conditional doesn't hurt
-		    (and (boundp 'inhibit-first-line-modes-suffixes)
-			 (setq inhibit-first-line-modes-suffixes
-			       (cons (jka-compr-info-regexp x)
-				     inhibit-first-line-modes-suffixes))))))
-   jka-compr-compression-info-list)
-  (setq auto-mode-alist
-	(append auto-mode-alist jka-compr-mode-alist-additions)))
-
-
-(defun jka-compr-uninstall ()
-  "Uninstall jka-compr.
-This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
-and `inhibit-first-line-modes-suffixes' that were added
-by `jka-compr-installed'."
-  ;; Delete from inhibit-first-line-modes-suffixes
-  ;; what jka-compr-install added.
-  (mapcar
-     (function (lambda (x)
-		 (and (jka-compr-info-strip-extension x)
-		      ;; XEmacs: the (now)superfluous conditional doesn't hurt
-		      (and (boundp 'inhibit-first-line-modes-suffixes)
-			   (setq inhibit-first-line-modes-suffixes
-				 (delete (jka-compr-info-regexp x)
-					 inhibit-first-line-modes-suffixes)))))
-	       )
-     jka-compr-compression-info-list)
-
-  (let* ((fnha (cons nil file-name-handler-alist))
-	 (last fnha))
-
-    (while (cdr last)
-      (if (eq (cdr (car (cdr last))) 'jka-compr-handler)
-	  (setcdr last (cdr (cdr last)))
-	(setq last (cdr last))))
-
-    (setq file-name-handler-alist (cdr fnha)))
-
-  (let* ((ama (cons nil auto-mode-alist))
-	 (last ama)
-	 entry)
-
-    (while (cdr last)
-      (setq entry (car (cdr last)))
-      (if (or (member entry jka-compr-mode-alist-additions)
-	      (and (consp (cdr entry))
-		   (eq (nth 2 entry) 'jka-compr)))
-	  (setcdr last (cdr (cdr last)))
-	(setq last (cdr last))))
-    
-    (setq auto-mode-alist (cdr ama)))
-
-  (when (boundp 'file-coding-system-alist)
-  (let* ((ama (cons nil file-coding-system-alist))
-	 (last ama)
-	 entry)
-
-    (while (cdr last)
-      (setq entry (car (cdr last)))
-      (if (member entry jka-compr-added-to-file-coding-system-alist)
-	  (setcdr last (cdr (cdr last)))
-	(setq last (cdr last))))
-
-    (setq file-coding-system-alist (cdr ama))))
-)
-      
-(defun jka-compr-installed-p ()
-  "Return non-nil if jka-compr is installed.
-The return value is the entry in `file-name-handler-alist' for jka-compr."
- 
-  (let ((fnha file-name-handler-alist)
-	(installed nil))
-
-    (while (and fnha (not installed))
-      (and (eq (cdr (car fnha)) 'jka-compr-handler)
-	   (setq installed (car fnha)))
-      (setq fnha (cdr fnha)))
-
-    installed))
-
-
-;;; Add the file I/O hook if it does not already exist.
-;;; Make sure that jka-compr-file-name-handler-entry is eq to the
-;;; entry for jka-compr in file-name-handler-alist.
-;; No no no no!
-;(and (jka-compr-installed-p)
-;     (jka-compr-uninstall))
-
-
-;; No no no no!
-;(jka-compr-install)
-
-
-(provide 'jka-compr)
-
-;; jka-compr.el ends here.
diff --git a/xemacs-packages/lisp/os-utils/kermit.el b/xemacs-packages/lisp/os-utils/kermit.el
deleted file mode 100644
index 8bf015c3..00000000
--- a/xemacs-packages/lisp/os-utils/kermit.el
+++ /dev/null
@@ -1,151 +0,0 @@
-;;; kermit.el --- additions to shell mode for use with kermit, etc.
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Jeff Norden 
-;; Created: 15 Feb 1988
-;; Keywords: comm
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.30.
-
-;;; Commentary:
-
-;; I'm not sure, but I think somebody asked about running kermit under shell
-;; mode a while ago.  Anyway, here is some code that I find useful.  The result
-;; is that I can log onto machines with primitive operating systems (VMS and
-;; ATT system V :-), and still have the features of shell-mode available for
-;; command history, etc.  It's also handy to be able to run a file transfer in
-;; an emacs window.  The transfer is in the "background", but you can also
-;; monitor or stop it easily.
-
-;; The ^\ key is bound to a function for sending escape sequences to kermit,
-;; and ^C^Q can be used to send any control characters needed thru to the
-;; system you connect to.  A more serious problem is that some brain-dead
-;; systems will not recognize a ^J as an end-of-line character.  So LFD is
-;; bound to a new function which acts just like CR usually does in shell-mode,
-;; but a ^M is sent as an end-of-line.  Functions are also provided to swap the
-;; bindings of CR and LFD.  I've also included a filter which will clean out
-;; any ^M's or ^@'s that get typed at you, but I don't really recommend it.
-;; There doesn't seem to be an acceptably fast way to do this via emacs-lisp.
-;; Invoking kermit by the command " kermit | tr -d '\015' " seems to work
-;; better (on my system anyway).
-
-;; Here's how I've been using this setup.  We have several machines connected
-;; thru a fairly stupid terminal switch.  If I want to connect to unix system,
-;; then I use the LFD key to talk to the switch, and ignore any ^M's in the
-;; buffer, and do a " stty -echo nl " after I log in.  Then the only real
-;; difference from being in local shell-mode is that you need to type
-;; ^C^Q^C to send an interrupt, and ^C^Q^Z for a stop signal, etc.  (since ^C^C
-;; just generates a local stop signal, which kermit ignores).
-;; To connect to a VMS system, I use a shell script to invoke kermit thru the
-;; tr filter, do "M-X kermit-send-cr", and then tell VMS that I'm on a 
-;; half-duplex terminal.
-
-;; Some caveats:
-;; 1) Kermit under shell mode is a real pain if you don't have pty's.  I
-;; recently discovered this on our 3b2/400.  When kermit can't find a tty, it
-;; assumes it is supposed to be in remote mode.  So the simple command "kermit"
-;; won't work in shell mode on such a system.  You can get around this by using
-;; the -c (connect) command line option, which means you also have to specify a
-;; line and baud on the command line, as in "kermit -l /dev/tty53 -b 9600 -c".
-;; However, this will cause kermit to exit when the connection is closed.  So
-;; in order to do a file transfer, you have to think ahead and add -r
-;; (receive) to the command line.  This means that you can't use the server
-;; feature.  The only fix I can see is to muck around with the source code for
-;; kermit, although this probably wouldn't be too hard.  What is needed is an
-;; option to force kermit to be local, to use stdin and stdout for interactive
-;; speech, and to forget about cbreak mode.
-
-;; Please let me know if any bugs turn up.
-;; Feb 1988, Jeff Norden - jeff@colgate.csnet
-
-;;; Code:
-
-(require 'shell)
-
-(defvar kermit-esc-char "\C-\\" "*Kermit's escape char")
-
-(defun kermit-esc ()
-  "For sending escape sequences to a kermit running in shell mode."
-  (interactive)
-  (process-send-string 
-   (get-buffer-process (current-buffer))
-   (concat kermit-esc-char (char-to-string (read-char)))))
-
-(defun kermit-send-char ()
-  "Send an arbitrary character to a program in shell mode."
-  (interactive)
-  (process-send-string 
-   (get-buffer-process (current-buffer))
-   (char-to-string (read-char))))
-
-(define-key shell-mode-map "\C-\\" 'kermit-esc)
-(define-key shell-mode-map "\C-c\C-q" 'kermit-send-char)
-;; extra bindings for folks suffering form ^S/^Q braindamage:
-(define-key shell-mode-map "\C-c\\" 'kermit-esc)
-
-(defun kermit-send-input-cr ()
-  "Like \\[comint-send-input] but end the line with carriage-return."
-  (interactive)
-  (comint-send-input)
-  (comint-send-string (get-buffer-process (current-buffer)) "\r"))
-
-;; This is backwards of what makes sense, but ...
-(define-key shell-mode-map "\n" 'kermit-send-input-cr)
-
-(defun kermit-default-cr ()
-  "Make RETURN end the line with carriage-return and LFD end it with a newline.
-This is useful for talking to other systems on which carriage-return
-is the normal way to end a line."
-  (interactive)
-  (define-key shell-mode-map "\r" 'kermit-send-input-cr)
-  (define-key shell-mode-map "\n" 'comint-send-input))
-
-(defun kermit-default-nl ()
-  "Make RETURN end the line with a newline char.  This is the default state.
-In this state, use LFD to send a line and end it with a carriage-return."
-  (interactive)
-  (define-key shell-mode-map "\n" 'kermit-send-input-cr)
-  (define-key shell-mode-map "\r" 'comint-send-input))
-
-(defun kermit-clean-filter (proc str)
-  "Strip ^M and ^@ characters from process output."
-  (save-excursion
-    (let ((beg (process-mark proc)))
-      (set-buffer (process-buffer proc))
-      (goto-char beg)
-      (insert-before-markers str)
-      (while (re-search-backward "[\r\C-a]+" beg t)
-	(replace-match "")))))
-
-(defun kermit-clean-on ()
-  "Delete all null characters and ^M's from the kermit output.
-Note that another (perhaps better) way to do this is to use the
-command `kermit | tr -d '\\015''."
-  (interactive)
-  (set-process-filter (get-buffer-process (current-buffer))
-		      'kermit-clean-filter))
-
-(defun kermit-clean-off ()
-  "Cancel a previous kermit-clean-shell-on command."
-  (interactive)
-  (set-process-filter (get-buffer-process (current-buffer)) nil))
-
-;;; kermit.el ends here
diff --git a/xemacs-packages/lisp/os-utils/ledit.el b/xemacs-packages/lisp/os-utils/ledit.el
deleted file mode 100644
index 3e85c20d..00000000
--- a/xemacs-packages/lisp/os-utils/ledit.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; ledit.el --- Emacs side of ledit interface
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keyword: languages
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This is a major mode for editing Liszt.  See etc/LEDIT for details.
-
-;;; Code:
-
-;;; To do:
-;;; o lisp -> emacs side of things (grind-definition and find-definition)
-
-(defvar ledit-mode-map nil)
-
-(defconst ledit-zap-file (concat "/tmp/" (user-login-name) ".l1")
-  "File name for data sent to Lisp by Ledit.")
-(defconst ledit-read-file (concat "/tmp/" (user-login-name) ".l2")
-  "File name for data sent to Ledit by Lisp.")
-(defconst ledit-compile-file 
-  (concat "/tmp/" (user-login-name) ".l4")
-  "File name for data sent to Lisp compiler by Ledit.")
-(defconst ledit-buffer "*LEDIT*"
-  "Name of buffer in which Ledit accumulates data to send to Lisp.")
-
-;;;###autoload
-(defconst ledit-save-files t "\
-*Non-nil means Ledit should save files before transferring to Lisp.")
-;;;###autoload
-(defconst ledit-go-to-lisp-string "%?lisp" "\
-*Shell commands to execute to resume Lisp job.")
-;;;###autoload
-(defconst ledit-go-to-liszt-string "%?liszt" "\
-*Shell commands to execute to resume Lisp compiler job.")
-
-(defun ledit-save-defun ()
-  "Save the current defun in the ledit buffer"
-  (interactive)
-  (save-excursion
-   (end-of-defun)
-   (let ((end (point)))
-     (beginning-of-defun)
-     (append-to-buffer ledit-buffer (point) end))
-   (message "Current defun saved for Lisp")))
-
-(defun ledit-save-region (beg end)
-  "Save the current region in the ledit buffer"
-  (interactive "r")
-  (append-to-buffer ledit-buffer beg end)
-  (message "Region saved for Lisp"))
-
-(defun ledit-zap-defun-to-lisp ()
-  "Carry the current defun to Lisp."
-  (interactive)
-  (ledit-save-defun)
-  (ledit-go-to-lisp))
-
-(defun ledit-zap-defun-to-liszt ()
-  "Carry the current defun to liszt."
-  (interactive)
-  (ledit-save-defun)
-  (ledit-go-to-liszt))
-
-(defun ledit-zap-region-to-lisp (beg end)
-  "Carry the current region to Lisp."
-  (interactive "r")
-  (ledit-save-region beg end)
-  (ledit-go-to-lisp))
-
-(defun ledit-go-to-lisp ()
-  "Suspend Emacs and restart a waiting Lisp job."
-  (interactive)
-  (if ledit-save-files
-      (save-some-buffers))
-  (if (get-buffer ledit-buffer)
-      (save-excursion
-       (set-buffer ledit-buffer)
-       (goto-char (point-min))
-       (write-region (point-min) (point-max) ledit-zap-file)
-       (erase-buffer)))
-  (suspend-emacs ledit-go-to-lisp-string)
-  (load ledit-read-file t t))
-
-(defun ledit-go-to-liszt ()
-  "Suspend Emacs and restart a waiting Liszt job."
-  (interactive)
-  (if ledit-save-files
-      (save-some-buffers))
-  (if (get-buffer ledit-buffer)
-      (save-excursion
-       (set-buffer ledit-buffer)
-       (goto-char (point-min))
-       (insert "(declare (macros t))\n")
-       (write-region (point-min) (point-max) ledit-compile-file)
-       (erase-buffer)))
-  (suspend-emacs ledit-go-to-liszt-string)
-  (load ledit-read-file t t))
-
-(defun ledit-setup ()
-  "Set up key bindings for the Lisp/Emacs interface."
-  (if (not ledit-mode-map)
-      (progn (setq ledit-mode-map (nconc (make-sparse-keymap) 
-					 shared-lisp-mode-map))))
-  (define-key ledit-mode-map "\e\^d" 'ledit-save-defun)
-  (define-key ledit-mode-map "\e\^r" 'ledit-save-region)
-  (define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp)
-  (define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt))
-
-(ledit-setup)
-
-;;;###autoload
-(defun ledit-mode ()
-  "\\Major mode for editing text and stuffing it to a Lisp job.
-Like Lisp mode, plus these special commands:
-  \\[ledit-save-defun]	-- record defun at or after point
-	   for later transmission to Lisp job.
-  \\[ledit-save-region] -- record region for later transmission to Lisp job.
-  \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
-  \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
-	   and transmit saved text.
-\\{ledit-mode-map}
-To make Lisp mode automatically change to Ledit mode,
-do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
-  (interactive)
-  (lisp-mode)
-  (ledit-from-lisp-mode))
-
-;;;###autoload
-(defun ledit-from-lisp-mode ()
-  (use-local-map ledit-mode-map)
-  (setq mode-name "Ledit")
-  (setq major-mode 'ledit-mode)
-  (run-hooks 'ledit-mode-hook))
-
-;;; ledit.el ends here
diff --git a/xemacs-packages/lisp/os-utils/mchat.el b/xemacs-packages/lisp/os-utils/mchat.el
deleted file mode 100644
index 1c48751e..00000000
--- a/xemacs-packages/lisp/os-utils/mchat.el
+++ /dev/null
@@ -1,1353 +0,0 @@
-;;; mchat.el --- Multicast Chatting package for XEmacs
-
-;; Copyright (C) 1997-2000 Didier Verna.
-
-;; Author:        Didier Verna 
-;; Maintainer:    Didier Verna 
-;; Created:       Mon Feb 15 18:45:02 1999 under XEmacs 21.2 (beta 9)
-;; Last Revision: Fri Aug  4 13:47:56 2000
-;; Keywords:      comm processes
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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.
-
-
-;;; Commentary:
-
-;; Contents management by FCM version 0.1.
-
-;; MChat is a package allowing a conversation to take place between a
-;; potentially infinite number of people across the Internet. It uses the
-;; Multicast support that I've added to XEmacs in the early 21.0 days. At that
-;; time a rudimentary version of MChat was written, merely to illustrate the
-;; feature, and almost nobody knew it, appart from the other developpers. This
-;; version is much improved and completely backward incompatible ;-).
-
-;; #### NOTE: before using this package, you most likely have to customize the
-;; `mchat-nsl-method' first. It specifies a program like nsl or nslookup in
-;; order to retrieve the IP number of your machine.
-
-;; The main entry point to the package is the `mchat' function which allows
-;; you to open a multicast group based on the MChat protocol. There are a
-;; number a variables that you can customize in the 'mchat custom group. Their
-;; doc-string is rather self-explanatory I think. You might also want to look
-;; at the bindings (C-h b) in MChat buffers, or at the menubar entries to get
-;; an idea of what you can do.
-
-;; #### WARNING: the current version (but there's also a limitation in the
-;; internals of XEmacs's processes) doesn't let you send messages longer than
-;; 500 octets or so, including the protocol header. I plan to change this in
-;; the future (see the todo list).
-
-
-;;; Acknowledgements:
-
-;; The original idea of MChat is from Philippe Dax . Akim
-;; Demaille  was *THE* beta tester for the 2.0 release. Many
-;; good ideas come from him.
-
-
-;;; TODO:
-
-;; - implement fragmentation support. When we have a proper packaging scheme
-;;   for providing both lisp and C modules, I'll probably rewrite the
-;;   multicast support as a module because the current process abstraction is
-;;   not very well suited to it. In UDP, you'd like to have access to more of
-;;   the datagrams components, and use proper non-connected mode routines to
-;;   send/receive to/from the network.
-;; - maybe implement dynamic heart-bit
-
-
-;;; Change Log:
-
-
-;;; Code:
-
-
-;; User Configurable stuff ==================================================
-
-(defgroup mchat nil
-  "Multicast Chatting package.")
-
-(defcustom mchat-user-tag (user-full-name)
-  "*The tag to use to identify your messages."
-  :group 'mchat
-  :type 'string)
-
-(defcustom mchat-registered-groups nil
-  "*Alist of registered mchat groups. Each element looks like
-(NAME ADDRESS) where NAME is a string used to identify the group, and
-ADDRESS is the multicast address. NAME must be unique. Please refer to
-`open-multicast-group' for the syntax of ADDRESS."
-  :group 'mchat
-  :type '(repeat (group (string :tag "   Name")
-		        (string :tag "Address"))))
-
-(defcustom mchat-message-cache-size 32
-  "*Number of sent messages to remember for each MChat group."
-  :group 'mchat
-  :type 'integer)
-
-(defcustom mchat-circulate-messages nil
-  "*If non nil, consider the message caches as circular lists, allowing
-to jump directly from one end to the other."
-  :group 'mchat
-  :type 'boolean)
-
-(defcustom mchat-ring-sound t
-  "*Sound to use when somebody rings an MChat group (see `sound-alist').
-Otherwise, t means just beep and nil means don't ever produce any sound."
-  :group 'mchat
-  :type 'symbol)
-
-(defcustom mchat-flash-on-message 'needed
-  "*When you receive a message in an MChat group, the selected frame can
-be flashed according to the value of this variable:
-- if t, always flash when a message arrives. As a special exception, this
-  doesn't flash when you are in one of the two MChat buffers corresponding
-  to this group.
-- if 'needed, flash only when the MChat buffer is not visible,
-- if nil, never flash.
-
-NOTE: currently, it's not always possible to figure out exactly whether
-the MChat buffer is visible (for instance if its frame is mapped, but
-obscured by some other window)."
-  :group 'mchat
-  :type '(choice (const :tag "always" t)
-		 (const :tag "needed" needed)
-		 (const :tag "never" nil)))
-
-(defcustom mchat-major-mode-string "MChat"
-  "*String to use in the modeline when the MChat major mode is active."
-  :group 'mchat
-  :type 'string)
-
-(defcustom mchat-major-mode-hooks nil
-  "*Hooks to run after setting up the MChat major mode."
-  :group 'mchat
-  :type 'hook)
-
-(defcustom mchat-minor-mode-string " mchat"
-  "*String to use in the modeline when the MChat minor mode is active."
-  :group 'mchat
-  :type 'string)
-
-(defcustom mchat-minor-mode-hooks nil
-  "*Hooks to run after setting up the MChat minor mode."
-  :group 'mchat
-  :type 'hook)
-
-(defcustom mchat-before-send-hooks nil
-  "*Hooks to run before sending a message. The hooks are executed in the
-MChat message buffer."
-  :group 'mchat
-  :type 'hook)
-
-(defcustom mchat-treat-message-hooks nil
-  "*Hooks to run after a message is received. The hooks will be called with
-two arguments, the beginning and end position of the message in the MChat
-group buffer. The group buffer will be current when the hooks are executed."
-  :group 'mchat
-  :type 'hook)
-
-(defcustom mchat-message-buffer-major-mode 'text
-  "*Major mode to use for MChat message buffers (less the -mode suffix)."
-  :group 'mchat
-  :type 'symbol)
-
-(defcustom mchat-loaded-hooks nil
-  "*Hooks run when mchat is loaded."
-  :group 'mchat
-  :type 'hook)
-
-(defcustom mchat-window-percent 75
-  "*Percentage of frame occupied by the Group buffer. The rest will go to the
-message buffer."
-  :group 'mchat
-  :type 'integer)
-
-(defcustom mchat-nsl-method
-  '("nsl"
-    (system-name)
-    "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)"
-    1)
-  "*Method to use in order to retrieve one IP address from your machine. It
-looks like (PROGRAM ARGS REGEXP START) where:
-- PROGRAM is the program to be called (a string)
-- ARGS is a lisp expression returning a string of arguments you might want to
-  pass to PROGRAM,
-- REGEXP is the regexp to find the IP address in the output of PROGRAM,
-- START is the indice of the sub-match returning the first component of the
-  address."
-  :group 'mchat
-  :type '(list (string  :tag "    Program")
-	       (sexp    :tag "  Arguments")
-	       (string  :tag "     Regexp")
-	       (integer :tag "First match")))
-
-(defface mchat-comment-face '((t (:italic t)))
-  "*Face used when inserting text that is not a message in the MChat group
-buffers."
-  :group 'mchat)
-
-(defface mchat-tag-face '((t (:bold t)))
-  "*Face used for identifying the sender of a message."
-  :group 'mchat)
-
-
-;; Private variables ========================================================
-
-;; $Format: "(defconst mchat-prcs-major-version \"$ProjectMajorVersion$\")"$
-(defconst mchat-prcs-major-version "version-2-1")
-;; $Format: "(defconst mchat-prcs-minor-version \"$ProjectMinorVersion$\")"$
-(defconst mchat-prcs-minor-version "1")
-(defconst mchat-version
-  (let ((level mchat-prcs-minor-version)
-	major minor status)
-    (string-match "\\(branch\\|version\\)-\\([0-9]+\\)-\\([0-9]+\\)"
-		  mchat-prcs-major-version)
-    (setq major (match-string 2 mchat-prcs-major-version)
-	  minor (match-string 3 mchat-prcs-major-version)
-	  status (match-string 1 mchat-prcs-major-version))
-    (cond ((string= status "version")
-	   (setq level (int-to-string (1- (string-to-int level))))
-	   (if (string-equal level "0")
-	       (concat major "." minor)
-	     (concat major "." minor "." level)))
-	  ((string= status "branch")
-	   (concat major "." minor "-b" level)))
-    ))
-
-;; #### NOTE: the group informations stored in each entry are constant stuff.
-;; Things likely to change (like members) are stored in buffer-local
-;; variables.
-(defvar mchat-groups nil
-  ;; List of all currently active mchat groups.
-  ;; Each element of the list is of the form: (NAME ADDRESS (KEY . VALUE) ...)
-  ;; NAME is the name use to identify the group,
-  ;; ADDRESS is the multicast address for the group,
-  ;; KEY can currently be one of the following:
-  ;; buffer:       VALUE is the message edition buffer for this group,
-  ;; proc:         VALUE is the process id associated with this group,
-  ;; zombie-check: VALUE is the timeout id corresponding to the zonbie check.
-  )
-
-;; Used to retrieve back the group desc from mchat-groups.
-(make-variable-buffer-local
- (defvar mchat-group-name nil
-   ;; Becomes automatically buffer local when set. Contains the name of the
-   ;; MChat group the buffer is associated with.
-   ))
-
-;; See the note on top of `mchat-groups'
-(make-variable-buffer-local
- (defvar mchat-group-members nil
-   ;; Becomes automatically buffer local when set. This is a list of group
-   ;; members. Each element looks like: (ID (KEY . VALUE) ...)
-   ;; ID is the unique identifier for each member.
-   ;; KEY can be one the following:
-   ;; tag:        VALUE is the tag to used to identify messages from this guy,
-   ;; time-stamp: VALUE is the last time I received a message from this guy.
-   ;; messges:    VALUE is a list of buffered messages to be processed *after*
-   ;;             we get information on the guy (especially the tag).
-   ))
-
-(make-variable-buffer-local
- (defvar mchat-heart-bit-timeout nil
-   ;; Becomes automatically buffer local when set. The heart-bit timeout id.
-   ))
-
-(make-variable-buffer-local
- (defvar mchat-message-cache nil
-   ;; Becomes automatically buffer local when set. The cache of messages
-   ;; already sent.
-   ))
-
-(make-variable-buffer-local
- (defvar mchat-message-cache-indice nil
-   ;; Becomes automatically buffer local when set. The cache indice of the
-   ;; message currently displayed in the mchat message buffer.
-   ))
-
-(make-variable-buffer-local
- (defvar mchat-unsent-message nil
-   ;; Becomes automatically buffer local when set. Remembers a message being
-   ;; edited we're moving in the messages history
-   ))
-
-(defconst mchat-submenu
-  '("MChat"
-    :included mchat-group-name
-    "Message:"
-    "-"
-    [ "send it" mchat-message t ]
-    [ "discard it" mchat-discard-message t ]
-    [ "pop next" mchat-next-message t ]
-    [ "pop previous" mchat-previous-message t ]
-    [ "pop first" mchat-first-message t ]
-    [ "pop last" mchat-last-message t ]
-    "Group:"
-    "--"
-    [ "erase buffer" mchat-erase-buffer t ]
-    [ "ring bell" mchat-ring t ]
-    [ "show who's here" mchat-who t ]
-    [ "show info" mchat-info t ]
-    ;;[ "listening is " mchat-suspend t "on" ]
-    [ "quit" mchat-quit t ]
-    "Control:"
-    "---"
-    [ "register group" mchat-register t ]
-    [ "unregister group" mchat-unregister t ]
-    [ "switch group" mchat-switch-to-group t ]
-    [ "bury group" mchat-bury t ]
-    "Misc."
-    "----"
-    [ "MChat version" mchat-version t ]
-    )
-  ;; MChat-menu definition.
-  )
-
-
-;; MChat protocol management routines =======================================
-
-;; Here's a description of the MChat protocol (version 2.0) in pseudo-BNF:
-
-;; MESSAGE := PROTO_VERSION USER_ID LENGTH DATA
-;; PROTO_VERSION := PROTO_MAJOR (1 octet) PROTO_MINOR (1 octet)
-;;                  (see `mchat-protocol-*-version')
-;; USER_ID := USER_IP USER_PID
-;; LENGTH := length of the data segment (2 octets)
-;; DATA := ATOM ATOM_DATA
-;; USER_IP := one IP address of the machine we're running on (4 octets)
-;; USER_PID := PID of the process running an MChat client (8 octets)
-
-;; ATOM : meaning (see `mchat-protocol-atom-*')
-;; 'join :     join the group
-;; 'quit :      quit the group
-;; 'whois :     ask  for info
-;; 'iam :      send info on me
-;; 'ring :      ring the group
-;; 'msg  :         send a message to the group
-;; 'heart-bit : just show people that we exist
-
-;; The user id serves for identifying uniquely each member of the group. Some
-;; of them could use the same tag however.
-
-;; The main use of the LENGTH field is because of possible messages
-;; concatenation. It's then important to separate each message from the next
-;; one.
-
-;; - 'join and 'quit are sent once.
-;; - 'iam should be sent if somebody sent a 'whois request about me.
-;; - 'whois should be sent when we receive something (except 'join and 'iam)
-;;   about a member we don't know.
-;; 'heart-bit should be sent only if we were idle for a long time.
-
-
-;; Each one must be representable on 8 bits, but I doubt I'll ever reach 255.
-;; $Format: "(defconst mchat-protocol-major-version $ProtocolMajorVersion$)"$
-(defconst mchat-protocol-major-version 2)
-;; $Format: "(defconst mchat-protocol-minor-version $ProtocolMinorVersion$)"$
-(defconst mchat-protocol-minor-version 0)
-
-(defconst mchat-protocol-version
-  (let ((str "\0\0"))
-    (aset str 0 (int-to-char mchat-protocol-major-version))
-    (aset str 1 (int-to-char mchat-protocol-minor-version))
-    str))
-
-(defconst mchat-heart-bit-delay 60
-  ;; Maximum inactivity period.
-  )
-
-(defconst mchat-zombie-latency 5
-  ;; If I didn't receive any message (heart-bit included) from a member after
-  ;; this number of times the heart-bit, the guy must have been killed.
-  )
-
-(defvar mchat-user-id nil
-  ;; #### FIXME: is it necessary to use 64bits for pids ?
-  ;; 12 octets header for all mchat messages. Octets list with explanation:
-  ;; 0- 3 -> IP address
-  ;; 4-12 -> emacs pid on 64 bits
-  ;; The pair IP-addres/emacs pid makes a unique identifier for everybody.
-  )
-
-(defun mchat-user-id ()
-  ;; Build and return the user id, or nil.
-  (condition-case nil
-      (let ((str (make-string 12 0))
-	    (pid (emacs-pid))
-	    (i 0)
-	    (n (cadddr mchat-nsl-method)))
-	(with-temp-buffer
-	  (call-process (car mchat-nsl-method)
-			nil (current-buffer)
-			nil (eval (cadr mchat-nsl-method)))
-	  (goto-char (point-min))
-	  (re-search-forward (caddr mchat-nsl-method))
-	  (while (< i 4)
-	    (aset str i
-		  (int-to-char (string-to-int (match-string (+ i n)))))
-	    (setq i (1+ i)))
-	  (setq i 11)
-	  (while (> i 4)
-	    (setq n (% pid 256))
-	    (aset str i (int-to-char n))
-	    (setq pid (/ (- pid n) 256))
-	    (setq i (1- i))))
-	str)
-    (t nil)
-    ))
-
-;; MChat protocol atoms
-(defconst mchat-protocol-atom-join      (int-to-char 0))
-(defconst mchat-protocol-atom-quit      (int-to-char 1))
-(defconst mchat-protocol-atom-whois     (int-to-char 10))
-(defconst mchat-protocol-atom-iam       (int-to-char 11))
-(defconst mchat-protocol-atom-ring      (int-to-char 50))
-(defconst mchat-protocol-atom-msg       (int-to-char 100))
-(defconst mchat-protocol-atom-heart-bit (int-to-char 255))
-
-;; Message sending routines ------------------------------------------------
-
-;; #### NOTE: should implement message fragmentation
-(defun mchat-send (proc data)
-  ;; send DATA to the process PROC, in the MChat protocol format. Disable the
-  ;; heart bit before sending, and restores it afterwards.
-  (let ((data-len "\0\0")
-	(len (length data))
-	n)
-    (with-current-buffer (process-buffer proc)
-      (disable-timeout mchat-heart-bit-timeout)
-      ;; compute and add the length of the message
-      (setq n (% len 256))
-      (aset data-len 1 (int-to-char n))
-      (setq n (/ (- len n) 256))
-      (aset data-len 0 n)
-      (process-send-string proc (concat mchat-protocol-version
-					mchat-user-id
-					data-len
-					data))
-      (setq mchat-heart-bit-timeout
-	    (add-timeout mchat-heart-bit-delay 'mchat-heart-bit proc
-			 mchat-heart-bit-delay)))
-    ))
-
-(defun mchat-send-join (proc)
-  ;; Sends a `join' message
-  (mchat-send proc (concat (char-to-string mchat-protocol-atom-join)
-			   mchat-user-tag)))
-
-(defun mchat-send-quit (proc)
-  ;; Sends a `quit' message
-  (mchat-send proc (char-to-string mchat-protocol-atom-quit)))
-
-(defun mchat-send-whois (proc data)
-  ;; Sends a `whois' message
-  (mchat-send proc (concat (char-to-string mchat-protocol-atom-whois)
-			   data)))
-
-(defun mchat-send-iam (proc)
-  ;; Sends a `iam' message
-  (mchat-send proc (concat (char-to-string mchat-protocol-atom-iam)
-			   mchat-user-tag)))
-
-(defun mchat-send-ring (proc)
-  ;; Sends a `ring' message
-  (mchat-send proc (char-to-string mchat-protocol-atom-ring)))
-
-(defun mchat-send-msg (proc data)
-  ;; Sends a real text message
-  (mchat-send proc (concat (char-to-string mchat-protocol-atom-msg)
-			   data)))
-
-(defun mchat-send-heart-bit (proc)
-  ;; sends the heart-bit message
-  (mchat-send proc (char-to-string mchat-protocol-atom-heart-bit)))
-
-
-;; Message receiving routines ----------------------------------------------
-
-;; stolen from gnus.
-(defun mchat-current-time ()
-  ;; Return the current time in seconds
-  (let ((tm (current-time)))
-    (+ (* (car tm) 65536.0)
-       (cadr tm)
-       (/ (or (caddr tm) 0) 1000000.0))
-    ))
-
-(defmacro mchat-with-face (face &rest body)
-  ;; Execute BODY and put the result in face FACE
-  `(let ((start (point)))
-     ,@body
-     (set-extent-face (make-extent start (point)) ,face)
-     ))
-(put 'mchat-with-face 'lisp-indent-function 1)
-
-(defmacro mchat-insertion (&rest body)
-  ;; Execute BODY in current buffer as if it was a process output, and put it
-  ;; in face FACE.
-  ;; #### WARNING: BODY must use `insert-before-markers', not `insert'.
-  `(save-excursion
-     (let ((proc (get-buffer-process (current-buffer)))
-	   buffer-read-only)
-       (goto-char (process-mark proc))
-       ,@body
-       (set-marker (process-mark proc) (point)))
-     ))
-(put 'mchat-insertion 'lisp-indent-function 0)
-
-;; #### NOTE: For some reason, I've noticed that I'm likely to receive several
-;; messages twice. I couldn't figure out why in the multicast API. Maybe a
-;; problem of loopback of some sort ? Just ignore doublets anyway.
-(defun mchat-treat-join (grp id data) ;; DATA is the user tag
-  (let* ((proc (cdr (assoc 'proc grp)))
-	 (buf (process-buffer proc))
-	 who)
-    (with-current-buffer buf
-      (setq who (assoc id mchat-group-members))
-      (unless who
-	;; update the members list
-	(setq who (list id
-			(cons 'tag data)
-			(cons 'time-stamp (mchat-current-time))))
-	(push who mchat-group-members)
-	(mchat-insertion
-	    (mchat-with-face 'mchat-comment-face
-	      (insert-before-markers (concat data " joins.\n"))))
-	))
-    ))
-
-(defun mchat-treat-quit (grp id)
-  (let ((buf (process-buffer (cdr (assoc 'proc grp))))
-	who)
-    (with-current-buffer buf
-      (setq who (assoc id mchat-group-members))
-      (when who ;; otherwise, I didn't know the guy anyway
-	(mchat-insertion
-	    (mchat-with-face 'mchat-comment-face
-	      (insert-before-markers
-	       (concat (or (cdr (assoc 'tag who)) "") " quits.\n"))))
-	;; remove the guy
-	(setq mchat-group-members (remassoc id mchat-group-members))
-	))
-    ))
-
-;; #### NOTE: those two functions should probably use the CL package to
-;; perform substitutions, but I'm not sure it's worth it. Maybe if one day I
-;; have more things to update in the members structure, I could write a more
-;; general function.
-(defun mchat-update-time-stamp (id)
-  ;; Update the timestamp for user ID in current MChat group buffer
-  (let ((who (assoc id mchat-group-members)))
-    (setq mchat-group-members (remassoc id mchat-group-members))
-    (setq who (remassoc 'time-stamp who))
-    (setq who (append who (list (cons 'time-stamp (mchat-current-time)))))
-    (push who mchat-group-members)
-    ))
-
-(defun mchat-bufferize-message (id data)
-  ;; Add a message to the unprocessed list
-  (let* ((who (assoc id mchat-group-members))
-	 (messages (assoc 'messages who)))
-    (setq mchat-group-members (remassoc id mchat-group-members))
-    (setq who (remassoc 'messages who))
-    (if messages
-	(setq messages (append messages (list data)))
-      ;; else
-      (setq messages (list 'messages data)))
-    (setq who (append who messages))
-    (push who mchat-group-members)
-    ))
-
-(defun mchat-treat-whois (grp id data) ;; DATA is the user id to check
-  (let* ((proc (cdr (assoc 'proc grp)))
-	 (buf (process-buffer proc))
-	 who)
-    ;; honor the request
-    (when (string-equal mchat-user-id data)
-      (mchat-send-iam proc))
-    ;; update the guy
-    (with-current-buffer buf
-      (setq who (assoc id mchat-group-members))
-      (cond ((not who) ;; yet unknown
-	     ;; update the members list
-	     (setq who (list id	(cons 'time-stamp (mchat-current-time))))
-	     (push who mchat-group-members)
-	     (mchat-send-whois proc id))
-	    ((not (assoc 'tag who)) ;; half-known
-	     (mchat-update-time-stamp id)
-	     (mchat-send-whois proc id))
-	    (t ;; completely known
-	     (mchat-update-time-stamp id))))
-    ))
-
-(defun mchat-treat-iam (grp id data) ;; DATA is the user tag
-  (let ((buf (process-buffer (cdr (assoc 'proc grp))))
-	who)
-    (with-current-buffer buf
-      (setq who (assoc id mchat-group-members))
-      (cond ((not who) ;; yet unknown
-	     (setq who (list id
-			     (cons 'tag data)
-			     (cons 'time-stamp (mchat-current-time))))
-	     (push who mchat-group-members)
-	     (mchat-insertion
-	       (mchat-with-face 'mchat-comment-face
-		 (insert-before-markers (concat data " is here.\n")))))
-	    ((not (assoc 'tag who)) ;; half-known
-	     (let ((messages (cdr (assoc 'messages who))))
-	       (setq who (append who (list (cons 'tag data))))
-	       (when messages
-		 (setq who (remassoc 'messages who)))
-	       (setq mchat-group-members (remassoc id mchat-group-members))
-	       (push who mchat-group-members)
-	       (mchat-update-time-stamp id)
-	       (mchat-insertion
-		 (mchat-with-face 'mchat-comment-face
-		   (insert-before-markers (concat data " is here.\n"))))
-	       (when messages
-		 (let (msg)
-		   (while (setq msg (pop messages))
-		     (mchat-treat-data grp id msg))))))
-	    (t ;; completely known
-	     ;; #### FIXME: should check if tag is still the same
-	     (mchat-update-time-stamp id))))
-    ))
-
-(defun mchat-ding ()
-  ;; like 'ding but check mchat-ring-sound
-  (cond ((eq mchat-ring-sound t) ;; just the bell
-	 (ding t))
-	(mchat-ring-sound ;; a real sound. Try it or use the bell
-	 (if (and (or (featurep 'native-sound)
-		      (featurep 'nas-sound))
-		  (device-sound-enabled-p))
-	     (ding t mchat-ring-sound)
-	   ;; else
-	   (ding t)))))
-
-;; Handles my own messages
-(defun mchat-treat-ring (grp id)
-  (let* ((proc (cdr (assoc 'proc grp)))
-	 (buf (process-buffer proc))
-	 who)
-    (if (string-equal id mchat-user-id)
-	(with-current-buffer buf
-	  (mchat-insertion
-	    (mchat-with-face 'mchat-comment-face
-	      (insert-before-markers "I ring.\n")))
-	  (mchat-ding))
-      ;; else
-      (with-current-buffer buf
-	(setq who (assoc id mchat-group-members))
-	(cond ((not who) ;; unknown
-	       (setq who (list id
-			       (cons 'time-stamp (mchat-current-time))
-			       (list 'messages
-				     (char-to-string
-				      mchat-protocol-atom-ring))
-			       ))
-	       (push who mchat-group-members)
-	       (mchat-send-whois proc id))
-	      ((not (assoc 'tag who)) ;; half known
-	       (mchat-bufferize-message id (char-to-string
-					    mchat-protocol-atom-ring))
-	       (mchat-update-time-stamp id)
-	       (mchat-send-whois proc id))
-	      (t ;;completely known
-	       (mchat-update-time-stamp id)
-	       (mchat-insertion
-		 (mchat-with-face 'mchat-comment-face
-		   (insert-before-markers
-		    (concat (cdr (assoc 'tag who)) " rings.\n"))))
-	       (mchat-ding)))))
-    ))
-
-;; Handles my own messages
-(defun mchat-treat-msg (grp id data) ;; DATA is a normal message
-  (let* ((proc (cdr (assoc 'proc grp)))
-	 (buf (process-buffer proc))
-	 who flash)
-    (if (string-equal id mchat-user-id)
-	(with-current-buffer buf
-	  (mchat-insertion
-	    (mchat-with-face 'mchat-tag-face
-	      (insert-before-markers "I say:\n"))
-	    (let ((beg (point))
-		  end)
-	      (insert-before-markers (concat data "\n"))
-	      (setq end (point))
-	      (run-hook-with-args 'mchat-treat-message-hooks
-				  beg end))))
-      ;; else
-      (with-current-buffer buf
-	(setq who (assoc id mchat-group-members))
-	(cond ((not who) ;; unknown
-	       (setq who (list id
-			       (cons 'time-stamp (mchat-current-time))
-			       (list 'messages
-				     (concat (char-to-string
-					      mchat-protocol-atom-msg)
-					     data))
-			       ))
-	       (push who mchat-group-members)
-	       (mchat-send-whois proc id))
-	      ((not (assoc 'tag who)) ;; half known
-	       (mchat-bufferize-message
-		id
-		(concat (char-to-string mchat-protocol-atom-msg)
-			data))
-	       (mchat-update-time-stamp id)
-	       (mchat-send-whois proc id))
-	      (t ;; completely known
-	       (setq flash t)
-	       (mchat-insertion
-		 (mchat-with-face 'mchat-tag-face
-		   (insert-before-markers
-		    (concat (cdr (assoc 'tag who)) " says:\n")))
-		 (let ((beg (point))
-		       end)
-		   (insert-before-markers (concat data "\n"))
-		   (setq end (point))
-		   (run-hook-with-args 'mchat-treat-message-hooks
-				       beg end))))))
-      ;; #### WARNING: do this outside buf !!
-      ;; Now possibly flash if the buffer is not visible (but not if
-      ;; we're in it).
-      (when flash
-	(cond ((and (eq mchat-flash-on-message t)
-		    (not (eq (current-buffer) buf))
-		    (not (eq (current-buffer)
-			     (cdr (assoc 'buffer grp)))))
-	       (let ((visible-bell t)) (ding t t)))
-	      ((and (eq mchat-flash-on-message 'needed)
-		    (not (get-buffer-window buf 'visible)))
-	       (let ((visible-bell t)) (ding t t))))))
-    ))
-
-(defun mchat-treat-heart-bit (grp id)
-  (let* ((proc (cdr (assoc 'proc grp)))
-	 (buf (process-buffer proc))
-	 who)
-    (with-current-buffer buf
-      (setq who (assoc id mchat-group-members))
-      (cond ((not who) ;; unknown
-	     (setq who (list id (cons 'time-stamp (mchat-current-time))))
-	     (push who mchat-group-members)
-	     (mchat-send-whois proc id))
-	    ((not (assoc 'tag who)) ;; half known
-	     (mchat-update-time-stamp id)
-	     (mchat-send-whois proc id))
-	    (t ;; completely known
-	     (mchat-update-time-stamp id))))
-    ))
-
-(defun mchat-treat-data (grp id data)
-  ;; treat an MChat protocol message for group GRP. Branch to the proper
-  ;; subroutine
-  (cond ((eq (aref data 0) mchat-protocol-atom-join) ;; join
-	 (unless (string-equal id mchat-user-id)
-	   (mchat-treat-join grp id (substring data 1))))
-	((eq (aref data 0) mchat-protocol-atom-quit) ;; quit
-	 (unless (string-equal id mchat-user-id)
-	   (mchat-treat-quit grp id)))
-	((eq (aref data 0) mchat-protocol-atom-whois) ;; whois
-	 (unless (string-equal id mchat-user-id)
-	   (mchat-treat-whois grp id (substring data 1))))
-	((eq (aref data 0) mchat-protocol-atom-iam) ;; iam
-	 (unless (string-equal id mchat-user-id)
-	   (mchat-treat-iam grp id (substring data 1))))
-	;; Handle my own messages
-	((eq (aref data 0) mchat-protocol-atom-ring) ;; ring
-	 (mchat-treat-ring grp id))
-	;; Handle my own messages
-	((eq (aref data 0) mchat-protocol-atom-msg) ;; msg
-	 (mchat-treat-msg grp id (substring data 1)))
-	((eq (aref data 0) mchat-protocol-atom-heart-bit) ;; heart bit
-	 (unless (string-equal id mchat-user-id)
-	   (mchat-treat-heart-bit grp id)))
-	))
-
-;; #### FIXME: I think we can loose UDP packets, but we can assume that if one
-;; is received, it's not corrupted, right ?
-;; Also, I think I've encountered cases where packets were concatenated, so I
-;; handle this by adding the length of each DATA segment, and calling again
-;; the process filter myself if the message is too long.
-(defun mchat-process-filter (proc str)
-  ;; Filter for all received mchat messages
-  (let ((grp (catch 'found
-	       (let ((grps mchat-groups) grp)
-		 (while (setq grp (pop grps))
-		   (if (equal proc (cdr (assoc 'proc grp)))
-		       (throw 'found grp))))))
-	(major (char-to-int (aref str 0)))
-	(minor (char-to-int (aref str 1)))
-	id len data next)
-    ;; Check that we understand this protocol version:
-    (if (> (+ (* 256 major) minor)
-	   (+ (* 256 mchat-protocol-major-version)
-	      mchat-protocol-minor-version))
-	(with-current-buffer (process-buffer proc)
-	  (mchat-insertion
-	    (mchat-with-face 'mchat-comment-face
-	      (insert-before-markers
-	       "Received a message with MChat protocol version "
-	       (int-to-string major) "." (int-to-string minor) " !\n")
-	      (insert-before-markers
-	       "Please check if you have an outdated package.\n")
-	      (insert-before-markers
-	       "(also, note that this might just be a corrupted message)\n")
-	      )))
-      ;; else, this protocol version is understood, decode the message.
-      ;; #### NOTE: the following stuff could change for newer protocol
-      ;; versions. Just there's only one now (2.0).
-      (setq id (substring str 2 14)
-	    len (+ (* 256 (char-to-int (aref str 14)))
-		   (char-to-int (aref str 15)))
-	    data (substring str 16 (+ 16 len))
-	    next (and (> (length str) (+ 16 len))
-		      (substring str (+ 16 len))))
-      (mchat-treat-data grp id data)
-      (and next (mchat-process-filter proc next)))
-    ))
-
-
-;; MChat groups display routines ============================================
-
-;; Each frame in which an MChat group is displayed gets a
-;; 'mchat-window-configurations property. This property is a list of
-;; window configurations current before each call to `mchat-switch-to-group'.
-
-(defun mchat-switch-to-group (grp)
-  "Switch to the MChat group GRP in the current frame. This function remembers
-the previous window configuration, that you will be able to get back using
-`mchat-bury'."
-  (interactive
-   (list (assoc (completing-read "Group: " mchat-groups nil t) mchat-groups)))
-  ;; Remember the window configuration
-  (set-frame-property (selected-frame) 'mchat-window-configurations
-		      (cons (current-window-configuration)
-			    (frame-property (selected-frame)
-					    'mchat-window-configurations)))
-  ;; Setup the frame for this group
-  (delete-other-windows)
-  (switch-to-buffer (process-buffer (cdr (assoc 'proc grp))))
-  (split-window nil (/ (* (window-height) mchat-window-percent) 100))
-  (other-window 1)
-  (switch-to-buffer (cdr (assoc 'buffer grp)))
-  )
-
-(defun mchat-bury ()
-  "Bury the MChat group displayed in the current frame. This function
-actually restores the window configuration immediately preceding the last call
-to `mchat-switch-to-group' in this frame.
-
-If this frame didn't display an MChat group before (properly speaking, that is
-if `mchat-switch-to-group' was not called in this frame before), this function
-does nothing."
-  (interactive)
-  (let ((wcs (frame-property (selected-frame) 'mchat-window-configurations)))
-    (when wcs
-      (set-frame-property (selected-frame)
-			  'mchat-window-configurations (cdr wcs))
-      ;; #### NOTE: `set-window-configuration' doesn't seem to produce any
-      ;; errors when the window configuration can't be restored (like, if one
-      ;; buffer is killed, or something).
-      (set-window-configuration (car wcs)))
-    ))
-
-
-;; MChat group destruction routines =========================================
-
-(defun mchat-kill-group (grp)
-  ;; Destroy the group and clean up.
-  ;; XEmacs handles deleting the processes associated with buffers being
-  ;; killed, but I prefer to do it myself, in priority.
-  (let* ((proc (cdr (assoc 'proc grp)))
-	 (group-buffer (process-buffer proc))
-	 (message-buffer (cdr (assoc 'buffer grp)))
-	 (zombie-check (cdr (assoc 'zombie-check grp))))
-    ;; #### WARNING: this is the first thing to do, because mchat-send reputs
-    ;; the timeout after sending the message !!
-    (mchat-send-quit proc)
-    ;; Don't call the hooks !!
-    (with-current-buffer group-buffer
-      (disable-timeout mchat-heart-bit-timeout)
-      (remove-hook 'kill-buffer-hook 'mchat-kill-buffer-hook t))
-    (with-current-buffer message-buffer
-      (remove-hook 'kill-buffer-hook 'mchat-kill-buffer-hook t))
-    (disable-timeout zombie-check)
-    (delete-process proc)
-    (kill-buffer group-buffer)
-    (kill-buffer message-buffer)
-    (setq mchat-groups (remassoc (car grp) mchat-groups))
-    ))
-
-
-;; MChat modes routines =====================================================
-
-;; #### NOTE: for the moment, all of the following functions are supposed to
-;; be run only from an MChat buffer. Maybe we could make some of them query
-;; the group otherwise, but there again, I don't find this particularly
-;; useful.
-
-(defsubst mchat-interactive ()
-  (let* ((grp (assoc mchat-group-name mchat-groups)))
-    (if grp
-	(list grp)
-      (error "No MChat group associated with this buffer."))
-    ))
-
-(defun mchat-quit (grp)
-  "Quit the MChat group GRP."
-  (interactive (mchat-interactive))
-  (mchat-bury)
-  (mchat-kill-group grp))
-
-(defun mchat-ring (grp)
-  "Ring the bell on the MChat group GRP. If people are not looking at the
-buffer, at least they can hear you... Hmm maybe I should have called this
-function `mchat-annoy-user'... See also `mchat-flash-on-message'."
-  (interactive (mchat-interactive))
-  (mchat-send-ring (cdr (assoc 'proc grp))))
-
-(defsubst mchat-maybe-remember-message ()
-  ;; Remember the message being edited, *even* if it's still empty. Indeed, we
-  ;; want to get it back after moving in the cache.
-  (when (or (buffer-modified-p) (eq 0 (length (buffer-substring))))
-    (setq mchat-unsent-message (buffer-substring))))
-
-(defun mchat-next-message (grp &optional n)
-  "Restore the next Nth message (previous if N is negative) in the
-message buffer of group GRP. The variable `mchat-circulate-messages' controls
-the behavior when N is out of bounds. If N is not given, it is 1 by default.
-
-When called interactively, use the prefix to change N."
-  (interactive (append
-		(mchat-interactive)
-		(list (if current-prefix-arg
-			  (prefix-numeric-value current-prefix-arg)
-			1))))
-  (unless (eq 0 n)
-    (with-current-buffer (cdr (assoc 'buffer grp))
-      (mchat-maybe-remember-message)
-      ;; When moving in the cache the unset message must be virtually part of
-      ;; the cache in order to get it back.
-      (let* ((cache (append mchat-message-cache (list mchat-unsent-message)))
-	     (len (length cache))
-	     (indice (or mchat-message-cache-indice (1- len))))
-	;; find the new indice
-	(setq n (+ indice n))
-	(cond (mchat-circulate-messages
-	       (while (< n 0)
-		 (setq n (+ n len)))
-	       (setq n (% n len)))
-	      (t
-	       (if (< n 0)
-		   (setq n 0)
-		 (if (>= n len)
-		     (setq n (1- len))))))
-	;; Pop the message
-	(erase-buffer)
-	(insert (nth n cache))
-	(setq mchat-message-cache-indice n)
-	(unless (and (eq n (1- len)) (> (length (buffer-substring)) 0))
-	  (set-buffer-modified-p nil))
-	))
-    ))
-
-(defun mchat-previous-message (grp)
-  "Restore the previous message in the message buffer of group GRP. See also
-the variable `mchat-circulate-messages'"
-  (interactive (mchat-interactive))
-  (mchat-next-message grp -1))
-
-(defsubst mchat-pop-cached-message (n)
-  ;; Pops the message number n from the cache.
-  (erase-buffer)
-  (insert (nth n mchat-message-cache))
-  (setq mchat-message-cache-indice n)
-  (set-buffer-modified-p nil))
-
-(defun mchat-first-message (grp)
-  "Restore the oldest cached message in the message buffer of group GRP."
-  (interactive (mchat-interactive))
-  (with-current-buffer (cdr (assoc 'buffer grp))
-    (when mchat-message-cache
-      (mchat-maybe-remember-message)
-      (mchat-pop-cached-message 0))
-    ))
-
-;; #### NOTE: contrary to `mchat-next-message', this function doesn't consider
-;; the message currently edited as part of the cache. However, it is
-;; remembered and can be accessed with one `M-n'.
-(defun mchat-last-message (grp)
-  "Restore the youngest cached message in the message buffer of group GRP."
-  (interactive (mchat-interactive))
-  (with-current-buffer (cdr (assoc 'buffer grp))
-    (when mchat-message-cache
-      (mchat-maybe-remember-message)
-      (mchat-pop-cached-message (1- (length mchat-message-cache))))
-    ))
-
-(defun mchat-message (grp)
-  "Send the contents of the message buffer to the MChat group GRP."
-  (interactive (mchat-interactive))
-  (with-current-buffer (cdr (assoc 'buffer grp))
-    ;; the hooks might change something, so run them here.
-    (run-hooks 'mchat-before-send-hooks)
-    (let ((str (buffer-substring)))
-      (cond ((or (not str) (= 0 (length str)))
-	     (error "The message buffer is empty."))
-	    ((> (length str) 450)
-	     (error "Message too long. Please send it in shorter pieces."))
-	    (t
-	     (when (buffer-modified-p) ;; a new message
-	       ;; make room for it in the cache ('and should be enough)
-	       (while (>= (length mchat-message-cache)
-			  mchat-message-cache-size)
-		 (pop mchat-message-cache))
-	       ;; add it
-	       (setq mchat-message-cache
-		     (append mchat-message-cache (list str)))
-	       (setq mchat-message-cache-indice nil)
-	       (setq mchat-unsent-message nil)
-	       (erase-buffer)
-	       (set-buffer-modified-p nil))
-	     ;; Finally, send it
-	     (mchat-send-msg (cdr (assoc 'proc grp)) str)
-	     )))
-    ))
-
-(defun mchat-info (grp)
-  "Display information on the current MChat group."
-  (interactive (mchat-interactive))
-  (message "\"%s\" on %s" (car grp) (cadr grp)))
-
-(defun mchat-who (grp)
-  "Display the list of known members of the current group."
-  (interactive (mchat-interactive))
-  (with-current-buffer (process-buffer (cdr (assoc 'proc grp)))
-    (mchat-insertion
-	(mchat-with-face 'mchat-comment-face
-	  (let ((members mchat-group-members)
-		member)
-	    (if (not members)
-		(insert-before-markers
-		 "You're the only one, Max. Getting bored?\n")
-	      ;; else
-	      (insert-before-markers
-	       (concat "People currently known on `" (car grp) "' are:\n"))
-	      (while (setq member (pop members))
-		(insert-before-markers
-		 (concat "- "(cdr (assoc 'tag member)) ",\n")))
-	      (delete-backward-char 2)
-	      (insert-before-markers ".\n")))
-	  ))
-    ))
-
-(defun mchat-erase-buffer (grp)
-  "Erase the current MChat group buffer."
-  (interactive (mchat-interactive)) ;; this is just a protection
-  (with-current-buffer (process-buffer (cdr (assoc 'proc grp)))
-    (let ((buffer-read-only nil))
-      (erase-buffer))
-    ))
-
-(defun mchat-discard-message (grp)
-  "Discard the contents of the current MChat message buffer."
-  (interactive (mchat-interactive))
-  (with-current-buffer (cdr (assoc 'buffer grp))
-    (erase-buffer)))
-
-(defun mchat-register (grp)
-  "Register the current group (add it to `mchat-registered-groups')."
-  (interactive (mchat-interactive))
-  (if (assoc (car grp) mchat-registered-groups)
-      (error "This group is already defined.")
-    ;; else
-    (setq mchat-registered-groups
-	  (append `((,(car grp) ,(cadr grp))) mchat-registered-groups))
-    (when (y-or-n-p "Group registered. Keep it for future sessions ? ")
-      ;; #### FIXME: should I use Custom also to set the variable, or only if
-      ;; we want to save the value ?
-      (custom-set-variables
-       `(mchat-registered-groups (quote ,mchat-registered-groups) t))
-      (custom-save-all))
-    ))
-
-(defun mchat-unregister (grp)
-  "Unregister the current group (remove it to `mchat-registered-groups')."
-  (interactive (mchat-interactive))
-  (setq mchat-registered-groups (remassoc (car grp) mchat-registered-groups))
-  (when (y-or-n-p "Group unregistered. Forget it for future sessions ? ")
-    ;; #### FIXME: should I use Custom also to set the variable, or only if
-    ;; we want to save the value ?
-    (custom-set-variables
-     `(mchat-registered-groups (quote ,mchat-registered-groups) t))
-    (custom-save-all)
-    ))
-
-(defun mchat-version ()
-  "Show the current version of MChat."
-  (interactive)
-  (message "MChat version %s" mchat-version))
-
-
-;; MChat major mode (for the group buffers) =================================
-
-;; #### NOTE: I could let more bindings here (the message ones in particular),
-;; but since people are not supposed to live in the group buffer, I restrict
-;; the commands available on purpose.
-
-(defvar mchat-major-mode-map
-  (let ((m (make-sparse-keymap 'mchat-major-mode-map)))
-    ;; -
-    (define-key m "e" 'mchat-erase-buffer)
-    (define-key m "b" 'mchat-ring)
-    (define-key m "w" 'mchat-who)
-    (define-key m "i" 'mchat-info)
-;;; (define-key m "s" 'mchat-suspend)
-    (define-key m "q" 'mchat-quit)
-    ;; --
-    (define-key m "r" 'mchat-register)
-    (define-key m "u" 'mchat-unregister)
-    (define-key m "o" 'mchat-switch-to-group)
-    (define-key m "x" 'mchat-bury)
-    ;; ---
-    (define-key m "v" 'mchat-version)
-    m)
-  ;; MChat major mode keymap
-  )
-
-(defun mchat-major-mode ()
-  "Turns on the MChat major mode. Used for MChat group buffers. You're not
-supposed to use this. To join an MChat group, use `mchat' instead."
-  (kill-all-local-variables)
-  (setq buffer-read-only t)
-  (use-local-map mchat-major-mode-map)
-  (setq major-mode 'mchat-major-mode)
-  (setq mode-name mchat-major-mode-string)
-  (when (featurep 'menubar)
-    (setq mode-popup-menu mchat-submenu))
-  (run-hooks 'mchat-major-mode-hooks))
-
-
-;; MChat minor mode (for the message buffers) ===============================
-
-(defvar mchat-minor-mode-map
-  (let ((m (make-sparse-keymap 'mchat-minor-mode-map)))
-    ;; -
-    (define-key m [(control c) (control c)] 'mchat-message)
-    (define-key m [(control c) (control d)] 'mchat-discard-message)
-    (define-key m [(meta n)] 'mchat-next-message)
-    (define-key m [(meta p)] 'mchat-previous-message)
-    (define-key m [(meta P)] 'mchat-first-message)
-    (define-key m [(meta N)] 'mchat-last-message)
-    ;; --
-    (define-key m [(control c) (control e)] 'mchat-erase-buffer)
-    (define-key m [(control c) (control b)] 'mchat-ring)
-    (define-key m [(control c) (control w)] 'mchat-who)
-    (define-key m [(control c) (control i)] 'mchat-info)
-;;; (define-key m "s" 'mchat-suspend)
-    (define-key m [(control c) (control q)] 'mchat-quit)
-    ;; ---
-    (define-key m [(control c) (control r)] 'mchat-register)
-    (define-key m [(control c) (control u)] 'mchat-unregister)
-    (define-key m [(control c) (control o)] 'mchat-switch-to-group)
-    (define-key m [(control c) (control x)] 'mchat-bury)
-    ;; ----
-    (define-key m [(control c) (control v)] 'mchat-version)
-    m)
-  ;; MChat minor mode keymap
-  )
-
-(make-variable-buffer-local
- (defvar mchat-minor-mode nil))
-
-(defun mchat-minor-mode (arg)
-  "Toggles the MChat minor mode. Used for MChat message buffers. You're not
-supposed to use this. To join an MChat group, use `mchat' instead."
-  (interactive "*P")
-  (setq mchat-minor-mode
-	(if (null arg) (not mchat-minor-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (when (featurep 'menubar)
-    ;; I know, I know, this should be the *major* mode menu, not mine.
-    (setq mode-popup-menu mchat-submenu))
-  (run-hooks 'mchat-minor-mode-hooks))
-
-(add-minor-mode
- 'mchat-minor-mode mchat-minor-mode-string mchat-minor-mode-map)
-
-
-;; MChat group creation routines ============================================
-
-;; It's OK to call mchat-kill-group, because it's OK to re-kill killed
-;; buffers.
-(defun mchat-kill-buffer-hook ()
-  (mchat-kill-group (assoc mchat-group-name mchat-groups)))
-
-(defun mchat-heart-bit (proc)
-  ;; Timeout to resend a `heart-bit' message
-  (mchat-send-heart-bit proc))
-
-(defun mchat-zombie-check (buffer)
-  (with-current-buffer buffer
-    (let ((members mchat-group-members)
-	  (now (mchat-current-time))
-	  member)
-      (while (setq member (pop members))
-	(when (> now (+ (cdr (assoc 'time-stamp member))
-			(* mchat-heart-bit-delay mchat-zombie-latency)))
-	  ;; this guy must be dead
-	  (setq mchat-group-members
-		(remassoc (car member) mchat-group-members))
-	  (mchat-insertion
-	    (mchat-with-face 'mchat-comment-face
-	      (insert-before-markers
-	       (concat (cdr (assoc 'tag member)) " seems to have died.\n"))))
-	  )))
-    ))
-
-(defun mchat-create-group (name address)
-  ;; Ensure the user id is created, create the MChat group NAME at address
-  ;; ADDRESS, update mchat-groups, and return the group description.
-  ;; #### NOTE: previously, the user id was created at load time which was
-  ;; VERY BAD, because the user would not have the opportunity to correct a
-  ;; bogus nsl-method.
-  (unless mchat-user-id
-    (or (setq mchat-user-id (mchat-user-id))
-	(error "Can't build user id. Please check your mchat-nsl-method.")
-	))
-  (let* ((bufname (concat "MChat (" name ")"))
-	 (proc (open-multicast-group bufname bufname address))
-	 (buf (get-buffer-create (concat "MChat message (" name ")")))
-	 (desc `(,name
-		 ,address
-		 (buffer . ,buf)
-		 (proc . ,proc))))
-    ;; Group buffer setup
-    (with-current-buffer bufname
-      (mchat-major-mode)
-      (setq mchat-group-name name)
-      ;; #### NOTE: it's a bit silly, but sending the 'join message will
-      ;; delete this timeout and reput it after :-/
-      (setq mchat-heart-bit-timeout
-	    (add-timeout mchat-heart-bit-delay 'mchat-heart-bit proc
-			 mchat-heart-bit-delay))
-      ;; I'm not sure this is really needed all the time, but in case the
-      ;; menubar is not the default one, make sure we have the submenu.
-      (and (featurep 'menubar) (add-submenu nil mchat-submenu))
-      (make-local-hook 'kill-buffer-hook)
-      (add-hook 'kill-buffer-hook 'mchat-kill-buffer-hook nil t))
-    ;; Message buffer setup
-    (with-current-buffer buf
-      (apply (intern (concat (symbol-name mchat-message-buffer-major-mode)
-			     "-mode"))
-	     nil) ;; I'm not sure why this is needed.
-      (setq mchat-group-name name)
-      (mchat-minor-mode 1)
-      (make-local-hook 'kill-buffer-hook)
-      (add-hook 'kill-buffer-hook 'mchat-kill-buffer-hook nil t))
-    ;; Final setup:
-    (set-process-filter proc 'mchat-process-filter)
-    (set-marker (process-mark proc) (point) (process-buffer proc))
-    (setq desc
-	  (append desc (list (cons 'zombie-check
-				   (add-timeout (* mchat-zombie-latency
-						   mchat-heart-bit-delay)
-						'mchat-zombie-check
-						(process-buffer proc)
-						(* mchat-zombie-latency
-						   mchat-heart-bit-delay))))))
-    ;; say `hello'
-    (mchat-send-join proc)
-    (setq mchat-groups (cons desc mchat-groups))
-    desc))
-
-;; #### FIXME: remove this function. It seems to be used only once.
-(defun mchat-known-groups ()
-  ;; Returns an alist of elements of the form (NAME  ADDRESS) for ALL groups
-  ;; known to MChat. This includes those in `mchat-registered-groups', and
-  ;; those that are currently known but not registered. Since group names must
-  ;; be unique, it's quicker to match the names only.
-  (let ((grps mchat-groups) grp res)
-    (while (setq grp (pop grps))
-      (if (not (assoc (car grp) mchat-registered-groups))
-	  (setq res (cons (list (car grp) (cadr grp)) res))))
-    (append res mchat-registered-groups)
-    ))
-
-(defsubst mchat-all-interactive ()
-  ;; We don't allow the same name for different groups, so if a known group
-  ;; name is given, don't ask for the address. The completion occurs for both
-  ;; predefined groups and groups that exist but are not registered.
-  (let* ((grps (mchat-known-groups))
-	 (grpname (completing-read "Name: " grps))
-	 (grpaddr (or (cadr (assoc grpname grps))
-		      (read-string "Address: "))))
-    (list grpname grpaddr)
-    ))
-
-(defmacro mchat-sanity-check ()
-  ;; For non interactive calls, check the validity of the given address, or
-  ;; find it. Really, I'm too good to you, guys.
-  `(unless (interactive-p)
-     (let ((grp (assoc name mchat-registered-groups)))
-       (if grp
-	   (if (not address)
-	       (setq address (cadr grp))
-	     (or (equal address (cadr grp))
-		 (error "Address doesn't not match group name!")))
-	 (or address
-	     (error "No address given for unregistered group!"))))))
-
-(defmacro mchat-maybe-create-and-switch-to-group (&rest body)
-  ;; Maybe create the group, execute body, and setup the frame
-  `(let ((grp (assoc name mchat-groups)))
-     (unless grp
-       (setq grp (mchat-create-group name address)))
-     ,@body
-     (mchat-switch-to-group grp)))
-
-;;;###autoload
-(defun mchat (name &optional address)
-  "Join MChat multicast group NAME at address ADDRESS. When called
-interactively, you will be prompted for the group name, and if the group is
-not registered, for the corresponding multicast address. Please refer to
-`mchat-predefined-groups' for a list of known groups, and
-`open-multicast-group' for the syntax of ADDRESS."
-  (interactive (mchat-all-interactive))
-  (mchat-sanity-check)
-  (mchat-maybe-create-and-switch-to-group))
-
-;;;###autoload
-(defun mchat-other-frame (name &optional address)
-  "Like `mchat', but pop up a new frame."
-  (interactive (mchat-all-interactive))
-  (mchat-sanity-check)
-  (mchat-maybe-create-and-switch-to-group
-   (select-frame (make-frame))))
-
-(provide 'mchat)
-
-(run-hooks 'mchat-loaded-hooks)
-
-;;; mchat.el ends here
diff --git a/xemacs-packages/lisp/os-utils/rlogin.el b/xemacs-packages/lisp/os-utils/rlogin.el
deleted file mode 100644
index 8ba99bf2..00000000
--- a/xemacs-packages/lisp/os-utils/rlogin.el
+++ /dev/null
@@ -1,368 +0,0 @@
-;;; rlogin.el --- remote login interface
-
-;; Copyright (C) 1992-1995, 1997, 1998 Free Software Foundation, Inc.
-
-;; Author: Noah Friedman
-;; Maintainer: Noah Friedman 
-;; Keywords: unix, comm
-
-;; $Id: rlogin.el,v 1.6 2003/10/08 06:27:24 viteno Exp $
-
-;; 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:
-
-;; Support for remote logins using `rlogin'.
-;; This program is layered on top of shell.el; the code here only accounts
-;; for the variations needed to handle a remote process, e.g. directory
-;; tracking and the sending of some special characters.
-
-;; If you wish for rlogin mode to prompt you in the minibuffer for
-;; passwords when a password prompt appears, just enter m-x send-invisible
-;; and type in your line, or add `comint-watch-for-password-prompt' to
-;; `comint-output-filter-functions'.
-
-;;; Code:
-
-(require 'comint)
-(require 'shell)
-
-(defgroup rlogin nil
-  "Remote login interface"
-  :group 'processes
-  :group 'unix)
-
-(defcustom rlogin-program "rlogin"
-  "*Name of program to invoke rlogin"
-  :type 'string
-  :group 'rlogin)
-
-(defcustom rlogin-explicit-args nil
-  "*List of arguments to pass to rlogin on the command line."
-  :type '(repeat (string :tag "Argument"))
-  :group 'rlogin)
-
-(defcustom rlogin-mode-hook nil
-  "*Hooks to run after setting current buffer to rlogin-mode."
-  :type 'hook
-  :group 'rlogin)
-
-(defcustom rlogin-process-connection-type
-  (save-match-data
-    ;; Solaris 2.x `rlogin' will spew a bunch of ioctl error messages if
-    ;; stdin isn't a tty.
-    (cond ((and (boundp 'system-configuration)
-                (stringp system-configuration)
-                (string-match "-solaris2" system-configuration))
-           t)
-          (t nil)))
-  "*If non-`nil', use a pty for the local rlogin process.
-If `nil', use a pipe (if pipes are supported on the local system).
-
-Generally it is better not to waste ptys on systems which have a static
-number of them.  On the other hand, some implementations of `rlogin' assume
-a pty is being used, and errors will result from using a pipe instead."
-  :type '(choice (const :tag "pipes" nil)
-		 (other :tag "ptys" t))
-  :group 'rlogin)
-
-(defcustom rlogin-directory-tracking-mode 'local
-  "*Control whether and how to do directory tracking in an rlogin buffer.
-
-nil means don't do directory tracking.
-
-t means do so using an ftp remote file name.
-
-Any other value means do directory tracking using local file names.
-This works only if the remote machine and the local one
-share the same directories (through NFS).  This is the default.
-
-This variable becomes local to a buffer when set in any fashion for it.
-
-It is better to use the function of the same name to change the behavior of
-directory tracking in an rlogin session once it has begun, rather than
-simply setting this variable, since the function does the necessary
-re-synching of directories."
-  :type '(choice (const :tag "off" nil)
-		 (const :tag "ftp" t)
-		 (other :tag "local" local))
-  :group 'rlogin)
-
-(make-variable-buffer-local 'rlogin-directory-tracking-mode)
-
-(defcustom rlogin-host nil
-  "*The name of the remote host.  This variable is buffer-local."
-  :type '(choice (const nil) string)
-  :group 'rlogin)
-
-(defcustom rlogin-remote-user nil
-  "*The username used on the remote host.
-This variable is buffer-local and defaults to your local user name.
-If rlogin is invoked with the `-l' option to specify the remote username,
-this variable is set from that."
-  :type '(choice (const nil) string)
-  :group 'rlogin)
-
-;; Initialize rlogin mode map.
-(defvar rlogin-mode-map '())
-(cond
- ((null rlogin-mode-map)
-  (setq rlogin-mode-map (if (consp shell-mode-map)
-                            (cons 'keymap shell-mode-map)
-                          (copy-keymap shell-mode-map)))
-  (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
-  (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D)
-  (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
-  (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
-  (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)
-  (define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete)))
-
-
-;;;###autoload (add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)")
-
-(defvar rlogin-history nil)
-
-;;;###autoload
-(defun rlogin (input-args &optional buffer)
-  "Open a network login connection via `rlogin' with args INPUT-ARGS.
-INPUT-ARGS should start with a host name; it may also contain
-other arguments for `rlogin'.
-
-Input is sent line-at-a-time to the remote connection.
-
-Communication with the remote host is recorded in a buffer `*rlogin-HOST*'
-\(or `*rlogin-USER@HOST*' if the remote username differs\).
-If a prefix argument is given and the buffer `*rlogin-HOST*' already exists,
-a new buffer with a different connection will be made.
-
-When called from a program, if the optional second argument BUFFER is
-a string or buffer, it specifies the buffer to use.
-
-The variable `rlogin-program' contains the name of the actual program to
-run.  It can be a relative or absolute path.
-
-The variable `rlogin-explicit-args' is a list of arguments to give to
-the rlogin when starting.  They are added after any arguments given in
-INPUT-ARGS.
-
-If the default value of `rlogin-directory-tracking-mode' is t, then the
-default directory in that buffer is set to a remote (FTP) file name to
-access your home directory on the remote machine.  Occasionally this causes
-an error, if you cannot access the home directory on that machine.  This
-error is harmless as long as you don't try to use that default directory.
-
-If `rlogin-directory-tracking-mode' is neither t nor nil, then the default
-directory is initially set up to your (local) home directory.
-This is useful if the remote machine and your local machine
-share the same files via NFS.  This is the default.
-
-If you wish to change directory tracking styles during a session, use the
-function `rlogin-directory-tracking-mode' rather than simply setting the
-variable."
-  (interactive (list
-		(read-from-minibuffer "rlogin arguments (hostname first): "
-				      nil nil nil 'rlogin-history)
-		current-prefix-arg))
-
-  (let* ((process-connection-type rlogin-process-connection-type)
-         (args (if rlogin-explicit-args
-                   (append (rlogin-parse-words input-args)
-                           rlogin-explicit-args)
-                 (rlogin-parse-words input-args)))
-	 (host (car args))
-	 (user (or (car (cdr (member "-l" args)))
-                   (user-login-name)))
-         (buffer-name (if (string= user (user-login-name))
-                          (format "*rlogin-%s*" host)
-                        (format "*rlogin-%s@%s*" user host))))
-
-    (cond ((null buffer))
-	  ((stringp buffer)
-	   (setq buffer-name buffer))
-          ((bufferp buffer)
-           (setq buffer-name (buffer-name buffer)))
-          ((numberp buffer)
-           (setq buffer-name (format "%s<%d>" buffer-name buffer)))
-          (t
-           (setq buffer-name (generate-new-buffer-name buffer-name))))
-
-    (setq buffer (get-buffer-create buffer-name))
-    (pop-to-buffer buffer-name)
-
-    (cond
-     ((comint-check-proc buffer-name))
-     (t
-      (comint-exec buffer buffer-name rlogin-program nil args)
-
-      ;; comint-output-filter-functions is treated like a hook: it is
-      ;; processed via run-hooks or run-hooks-with-args in later versions
-      ;; of emacs.
-      ;; comint-output-filter-functions should already have a
-      ;; permanent-local property, at least in emacs 19.27 or later.
-      (cond
-       ((fboundp 'make-local-hook)
-        (make-local-hook 'comint-output-filter-functions)
-        (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter
-                  nil t))
-       (t
-        (make-local-variable 'comint-output-filter-functions)
-        (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter)))
-
-      (rlogin-mode)
-
-      (make-local-variable 'rlogin-host)
-      (setq rlogin-host host)
-      (make-local-variable 'rlogin-remote-user)
-      (setq rlogin-remote-user user)
-
-      (condition-case ()
-          (cond ((eq rlogin-directory-tracking-mode t)
-                 ;; Do this here, rather than calling the tracking mode
-                 ;; function, to avoid a gratuitous resync check; the default
-                 ;; should be the user's home directory, be it local or remote.
-                 (setq comint-file-name-prefix
-                       (concat "/" rlogin-remote-user "@" rlogin-host ":"))
-                 (cd-absolute comint-file-name-prefix))
-                ((null rlogin-directory-tracking-mode))
-                (t
-                 (cd-absolute (concat comint-file-name-prefix "~/"))))
-        (error nil))))))
-
-(put 'rlogin-mode 'mode-class 'special)
-
-(defun rlogin-mode ()
-  "Set major-mode for rlogin sessions.
-If `rlogin-mode-hook' is set, run it."
-  (interactive)
-  (kill-all-local-variables)
-  (shell-mode)
-  (setq major-mode 'rlogin-mode)
-  (setq mode-name "rlogin")
-  (use-local-map rlogin-mode-map)
-  (setq shell-dirtrackp rlogin-directory-tracking-mode)
-  (make-local-variable 'comint-file-name-prefix)
-  (run-hooks 'rlogin-mode-hook))
-
-(defun rlogin-directory-tracking-mode (&optional prefix)
-  "Do remote or local directory tracking, or disable entirely.
-
-If called with no prefix argument or a unspecified prefix argument (just
-``\\[universal-argument]'' with no number) do remote directory tracking via
-ange-ftp.  If called as a function, give it no argument.
-
-If called with a negative prefix argument, disable directory tracking
-entirely.
-
-If called with a positive, numeric prefix argument, e.g.
-``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'',
-then do directory tracking but assume the remote filesystem is the same as
-the local system.  This only works in general if the remote machine and the
-local one share the same directories (through NFS)."
-  (interactive "P")
-  (cond
-   ((or (null prefix)
-        (consp prefix))
-    (setq rlogin-directory-tracking-mode t)
-    (setq shell-dirtrackp t)
-    (setq comint-file-name-prefix
-          (concat "/" rlogin-remote-user "@" rlogin-host ":")))
-   ((< prefix 0)
-    (setq rlogin-directory-tracking-mode nil)
-    (setq shell-dirtrackp nil))
-   (t
-    (setq rlogin-directory-tracking-mode 'local)
-    (setq comint-file-name-prefix "")
-    (setq shell-dirtrackp t)))
-  (cond
-   (shell-dirtrackp
-    (let* ((proc (get-buffer-process (current-buffer)))
-           (proc-mark (process-mark proc))
-           (current-input (buffer-substring proc-mark (point-max)))
-           (orig-point (point))
-           (offset (and (>= orig-point proc-mark)
-                        (- (point-max) orig-point))))
-      (unwind-protect
-          (progn
-            (delete-region proc-mark (point-max))
-            (goto-char (point-max))
-            (shell-resync-dirs))
-        (goto-char proc-mark)
-        (insert current-input)
-        (if offset
-            (goto-char (- (point-max) offset))
-          (goto-char orig-point)))))))
-
-
-;; Parse a line into its constituent parts (words separated by
-;; whitespace).  Return a list of the words.
-(defun rlogin-parse-words (line)
-  (let ((list nil)
-	(posn 0)
-        (match-data (match-data)))
-    (while (string-match "[^ \t\n]+" line posn)
-      (setq list (cons (substring line (match-beginning 0) (match-end 0))
-                       list))
-      (setq posn (match-end 0)))
-    (set-match-data match-data)
-    (nreverse list)))
-
-(defun rlogin-carriage-filter (string)
-  (let* ((point-marker (point-marker))
-         (end (process-mark (get-buffer-process (current-buffer))))
-         (beg (or (and (boundp 'comint-last-output-start)
-                       comint-last-output-start)
-                  (- end (length string)))))
-    (goto-char beg)
-    (while (search-forward "\C-m" end t)
-      (delete-char -1))
-    (goto-char point-marker)))
-
-(defun rlogin-send-Ctrl-C ()
-  (interactive)
-  (process-send-string nil "\C-c"))
-
-(defun rlogin-send-Ctrl-D ()
-  (interactive)
-  (process-send-string nil "\C-d"))
-
-(defun rlogin-send-Ctrl-Z ()
-  (interactive)
-  (process-send-string nil "\C-z"))
-
-(defun rlogin-send-Ctrl-backslash ()
-  (interactive)
-  (process-send-string nil "\C-\\"))
-
-(defun rlogin-delchar-or-send-Ctrl-D (arg)
-  "\
-Delete ARG characters forward, or send a C-d to process if at end of buffer."
-  (interactive "p")
-  (if (eobp)
-      (rlogin-send-Ctrl-D)
-    (delete-char arg)))
-
-(defun rlogin-tab-or-complete ()
-  "Complete file name if doing directory tracking, or just insert TAB."
-  (interactive)
-  (if rlogin-directory-tracking-mode
-      (comint-dynamic-complete)
-    (insert "\C-i")))
-
-(provide 'rlogin)
-
-;;; rlogin.el ends here
diff --git a/xemacs-packages/lisp/os-utils/spell.el b/xemacs-packages/lisp/os-utils/spell.el
deleted file mode 100644
index 23c31df9..00000000
--- a/xemacs-packages/lisp/os-utils/spell.el
+++ /dev/null
@@ -1,156 +0,0 @@
-;;; spell.el --- spelling correction interface for Emacs.
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: wp, unix
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This mode provides an Emacs interface to the UNIX spell(1) program.
-;; Entry points are `spell-buffer', `spell-word', `spell-region' and
-;; `spell-string'.  These facilities are documented in the Emacs user's
-;; manual.
-
-;;; Code:
-
-(defvar spell-command "spell"
-  "*Command to run the spell program.")
-
-(defvar spell-filter nil
-  "*Filter function to process text before passing it to spell program.
-This function might remove text-processor commands.
-nil means don't alter the text before checking it.")
-
-;;;###autoload
-(put 'spell-filter 'risky-local-variable t)
-
-;;;###autoload
-(defun spell-buffer ()
-  "Check spelling of every word in the buffer.
-For each incorrect word, you are asked for the correct spelling
-and then put into a query-replace to fix some or all occurrences.
-If you do not want to change a word, just give the same word
-as its \"correct\" spelling; then the query replace is skipped."
-  (interactive)
-  (spell-region (point-min) (point-max) "buffer"))
-
-;;;###autoload
-(defun spell-word ()
-  "Check spelling of word at or before point.
-If it is not correct, ask user for the correct spelling
-and `query-replace' the entire buffer to substitute it."
-  (interactive)
-  (let (beg end spell-filter)
-    (save-excursion
-     (if (not (looking-at "\\<"))
-	 (forward-word -1))
-     (setq beg (point))
-     (forward-word 1)
-     (setq end (point)))
-    (spell-region beg end (buffer-substring beg end))))
-
-;;;###autoload
-(defun spell-region (start end &optional description)
-  "Like `spell-buffer' but applies only to region.
-Used in a program, applies from START to END.
-DESCRIPTION is an optional string naming the unit being checked:
-for example, \"word\"."
-  (interactive "r")
-  (let ((filter spell-filter)
-	(buf (get-buffer-create " *temp*")))
-    (save-excursion
-     (set-buffer buf)
-     (widen)
-     (erase-buffer))
-    (message "Checking spelling of %s..." (or description "region"))
-    (if (and (null filter) (= ?\n (char-after (1- end))))
-	(if (string= "spell" spell-command)
-	    (call-process-region start end "spell" nil buf)
-	  (call-process-region start end shell-file-name
-			       nil buf nil "-c" spell-command))
-      (let ((oldbuf (current-buffer)))
-	(save-excursion
-	 (set-buffer buf)
-	 (insert-buffer-substring oldbuf start end)
-	 (or (bolp) (insert ?\n))
-	 (if filter (funcall filter))
-	 (if (string= "spell" spell-command)
-	     (call-process-region (point-min) (point-max) "spell" t buf)
-	   (call-process-region (point-min) (point-max) shell-file-name
-				t buf nil "-c" spell-command)))))
-    (message "Checking spelling of %s...%s"
-	     (or description "region")
-	     (if (save-excursion
-		  (set-buffer buf)
-		  (> (buffer-size) 0))
-		 "not correct"
-	       "correct"))
-    (let (word newword
-	  (case-fold-search t)
-	  (case-replace t))
-      (while (save-excursion
-	      (set-buffer buf)
-	      (> (buffer-size) 0))
-	(save-excursion
-	 (set-buffer buf)
-	 (goto-char (point-min))
-	 (setq word (downcase
-		     (buffer-substring (point)
-				       (progn (end-of-line) (point)))))
-	 (forward-char 1)
-	 (delete-region (point-min) (point))
-	 (setq newword
-	       (read-input (concat "`" word
-				   "' not recognized; edit a replacement: ")
-			   word))
-	 (flush-lines (concat "^" (regexp-quote word) "$")))
-	(if (not (equal word newword))
-	    (progn
-	     (goto-char (point-min))
-	     (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b")
-				   newword)))))))
-
-
-;;;###autoload
-(defun spell-string (string)
-  "Check spelling of string supplied as argument."
-  (interactive "sSpell string: ")
-  (let ((buf (get-buffer-create " *temp*")))
-    (save-excursion
-     (set-buffer buf)
-     (widen)
-     (erase-buffer)
-     (insert string "\n")
-     (if (string= "spell" spell-command)
-	 (call-process-region (point-min) (point-max) "spell"
-			      t t)
-       (call-process-region (point-min) (point-max) shell-file-name
-			    t t nil "-c" spell-command))
-     (if (= 0 (buffer-size))
-	 (message "%s is correct" string)
-       (goto-char (point-min))
-       (while (search-forward "\n" nil t)
-	 (replace-match " "))
-       (message "%sincorrect" (buffer-substring 1 (point-max)))))))
-
-;;; spell.el ends here
diff --git a/xemacs-packages/lisp/os-utils/ssh.el b/xemacs-packages/lisp/os-utils/ssh.el
deleted file mode 100644
index c12eae0e..00000000
--- a/xemacs-packages/lisp/os-utils/ssh.el
+++ /dev/null
@@ -1,363 +0,0 @@
-;;; ssh.el --- remote login interface
-
-;; Copyright (C) 1996, 1997, 1998 Noah S. Friedman
-
-;; Author: Noah Friedman 
-;; Maintainer: friedman@splode.com
-;; Keywords: unix, comm
-;; Created: 1996-07-03
-
-;; $Id: ssh.el,v 1.6 1998/09/11 01:14:34 friedman 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:
-
-;; Support for remote logins using `ssh'.
-;; This program is layered on top of shell.el; the code here only accounts
-;; for the variations needed to handle a remote process, e.g. directory
-;; tracking and the sending of some special characters.
-
-;; If you wish for ssh mode to prompt you in the minibuffer for
-;; passwords when a password prompt appears, just enter m-x send-invisible
-;; and type in your line, or add `comint-watch-for-password-prompt' to
-;; `comint-output-filter-functions'.
-
-;;; Code:
-
-(require 'comint)
-(require 'shell)
-
-(defgroup ssh nil
-  "Secure remote login interface"
-  :group 'processes
-  :group 'unix)
-
-(defcustom ssh-program "ssh"
-  "*Name of program to invoke ssh"
-  :type 'string
-  :group 'ssh)
-
-(defcustom ssh-explicit-args '()
-  "*List of arguments to pass to ssh on the command line."
-  :type '(repeat (string :tag "Argument"))
-  :group 'ssh)
-
-(defcustom ssh-mode-hook nil
-  "*Hooks to run after setting current buffer to ssh-mode."
-  :type 'hook
-  :group 'ssh)
-
-(defcustom ssh-process-connection-type t
-  "*If non-`nil', use a pty for the local ssh process.
-If `nil', use a pipe (if pipes are supported on the local system).
-
-Generally it is better not to waste ptys on systems which have a static
-number of them.  However, ssh won't allocate a pty on the remote host
-unless one is used locally as well."
-  :type '(choice (const :tag "ptys" t)
-		 (const :tag "pipes" nil))
-  :group 'ssh)
-
-(defcustom ssh-directory-tracking-mode 'local
-  "*Control whether and how to do directory tracking in an ssh buffer.
-
-nil means don't do directory tracking.
-
-t means do so using an ftp remote file name.
-
-Any other value means do directory tracking using local file names.
-This works only if the remote machine and the local one
-share the same directories (through NFS).  This is the default.
-
-This variable becomes local to a buffer when set in any fashion for it.
-
-It is better to use the function of the same name to change the behavior of
-directory tracking in an ssh session once it has begun, rather than
-simply setting this variable, since the function does the necessary
-re-synching of directories."
-  :type '(choice (const :tag "off" nil)
-		 (const :tag "ftp" t)
-		 (const :tag "local" local))
-  :group 'ssh)
-
-(make-variable-buffer-local 'ssh-directory-tracking-mode)
-
-(defcustom ssh-host nil
-  "*The name of the remote host.  This variable is buffer-local."
-  :type '(choice (const nil) string)
-  :group 'ssh)
-
-(defcustom ssh-remote-user nil
-  "*The username used on the remote host.
-This variable is buffer-local and defaults to your local user name.
-If ssh is invoked with the `-l' option to specify the remote username,
-this variable is set from that."
-  :type '(choice (const nil) string)
-  :group 'ssh)
-
-;; Initialize ssh mode map.
-(defvar ssh-mode-map '())
-(cond
- ((null ssh-mode-map)
-  (setq ssh-mode-map (if (consp shell-mode-map)
-                            (cons 'keymap shell-mode-map)
-                          (copy-keymap shell-mode-map)))
-  (define-key ssh-mode-map "\C-c\C-c" 'ssh-send-Ctrl-C)
-  (define-key ssh-mode-map "\C-c\C-d" 'ssh-send-Ctrl-D)
-  (define-key ssh-mode-map "\C-c\C-z" 'ssh-send-Ctrl-Z)
-  (define-key ssh-mode-map "\C-c\C-\\" 'ssh-send-Ctrl-backslash)
-  (define-key ssh-mode-map "\C-d" 'ssh-delchar-or-send-Ctrl-D)
-  (define-key ssh-mode-map "\C-i" 'ssh-tab-or-complete)))
-
-
-;;;###autoload (add-hook 'same-window-regexps "^\\*ssh-.*\\*\\(\\|<[0-9]+>\\)")
-
-(defvar ssh-history nil)
-
-;;;###autoload
-(defun ssh (input-args &optional buffer)
-  "Open a network login connection via `ssh' with args INPUT-ARGS.
-INPUT-ARGS should start with a host name; it may also contain
-other arguments for `ssh'.
-
-Input is sent line-at-a-time to the remote connection.
-
-Communication with the remote host is recorded in a buffer `*ssh-HOST*'
-\(or `*ssh-USER@HOST*' if the remote username differs\).
-If a prefix argument is given and the buffer `*ssh-HOST*' already exists,
-a new buffer with a different connection will be made.
-
-When called from a program, if the optional second argument BUFFER is
-a string or buffer, it specifies the buffer to use.
-
-The variable `ssh-program' contains the name of the actual program to
-run.  It can be a relative or absolute path.
-
-The variable `ssh-explicit-args' is a list of arguments to give to
-the ssh when starting.  They are prepended to any arguments given in
-INPUT-ARGS.
-
-If the default value of `ssh-directory-tracking-mode' is t, then the
-default directory in that buffer is set to a remote (FTP) file name to
-access your home directory on the remote machine.  Occasionally this causes
-an error, if you cannot access the home directory on that machine.  This
-error is harmless as long as you don't try to use that default directory.
-
-If `ssh-directory-tracking-mode' is neither t nor nil, then the default
-directory is initially set up to your (local) home directory.
-This is useful if the remote machine and your local machine
-share the same files via NFS.  This is the default.
-
-If you wish to change directory tracking styles during a session, use the
-function `ssh-directory-tracking-mode' rather than simply setting the
-variable."
-  (interactive (list
-		(read-from-minibuffer "ssh arguments (hostname first): "
-				      nil nil nil 'ssh-history)
-		current-prefix-arg))
-
-  (let* ((process-connection-type ssh-process-connection-type)
-         (args (ssh-parse-words input-args))
-	 (host (car args))
-	 (user (or (car (cdr (member "-l" args)))
-                   (user-login-name)))
-         (buffer-name (if (string= user (user-login-name))
-                          (format "*ssh-%s*" host)
-                        (format "*ssh-%s@%s*" user host)))
-	 proc)
-
-    (and ssh-explicit-args
-         (setq args (append ssh-explicit-args args)))
-
-    (cond ((null buffer))
-	  ((stringp buffer)
-	   (setq buffer-name buffer))
-          ((bufferp buffer)
-           (setq buffer-name (buffer-name buffer)))
-          ((numberp buffer)
-           (setq buffer-name (format "%s<%d>" buffer-name buffer)))
-          (t
-           (setq buffer-name (generate-new-buffer-name buffer-name))))
-
-    (setq buffer (get-buffer-create buffer-name))
-    (pop-to-buffer buffer-name)
-
-    (cond
-     ((comint-check-proc buffer-name))
-     (t
-      (comint-exec buffer buffer-name ssh-program nil args)
-      (setq proc (get-buffer-process buffer))
-      ;; Set process-mark to point-max in case there is text in the
-      ;; buffer from a previous exited process.
-      (set-marker (process-mark proc) (point-max))
-
-      ;; comint-output-filter-functions is treated like a hook: it is
-      ;; processed via run-hooks or run-hooks-with-args in later versions
-      ;; of emacs.
-      ;; comint-output-filter-functions should already have a
-      ;; permanent-local property, at least in emacs 19.27 or later.
-      (cond
-       ((fboundp 'make-local-hook)
-        (make-local-hook 'comint-output-filter-functions)
-        (add-hook 'comint-output-filter-functions 'ssh-carriage-filter nil t))
-       (t
-        (make-local-variable 'comint-output-filter-functions)
-        (add-hook 'comint-output-filter-functions 'ssh-carriage-filter)))
-
-      (ssh-mode)
-
-      (make-local-variable 'ssh-host)
-      (setq ssh-host host)
-      (make-local-variable 'ssh-remote-user)
-      (setq ssh-remote-user user)
-
-      (condition-case ()
-          (cond ((eq ssh-directory-tracking-mode t)
-                 ;; Do this here, rather than calling the tracking mode
-                 ;; function, to avoid a gratuitous resync check; the default
-                 ;; should be the user's home directory, be it local or remote.
-                 (setq comint-file-name-prefix
-                       (concat "/" ssh-remote-user "@" ssh-host ":"))
-                 (cd-absolute comint-file-name-prefix))
-                ((null ssh-directory-tracking-mode))
-                (t
-                 (cd-absolute (concat comint-file-name-prefix "~/"))))
-        (error nil))))))
-
-(put 'ssh-mode 'mode-class 'special)
-
-(defun ssh-mode ()
-  "Set major-mode for ssh sessions.
-If `ssh-mode-hook' is set, run it."
-  (interactive)
-  (kill-all-local-variables)
-  (shell-mode)
-  (setq major-mode 'ssh-mode)
-  (setq mode-name "ssh")
-  (use-local-map ssh-mode-map)
-  (setq shell-dirtrackp ssh-directory-tracking-mode)
-  (make-local-variable 'comint-file-name-prefix)
-  (run-hooks 'ssh-mode-hook))
-
-(defun ssh-directory-tracking-mode (&optional prefix)
-  "Do remote or local directory tracking, or disable entirely.
-
-If called with no prefix argument or a unspecified prefix argument (just
-``\\[universal-argument]'' with no number) do remote directory tracking via
-ange-ftp.  If called as a function, give it no argument.
-
-If called with a negative prefix argument, disable directory tracking
-entirely.
-
-If called with a positive, numeric prefix argument, e.g.
-``\\[universal-argument] 1 M-x ssh-directory-tracking-mode\'',
-then do directory tracking but assume the remote filesystem is the same as
-the local system.  This only works in general if the remote machine and the
-local one share the same directories (through NFS)."
-  (interactive "P")
-  (cond
-   ((or (null prefix)
-        (consp prefix))
-    (setq ssh-directory-tracking-mode t)
-    (setq shell-dirtrackp t)
-    (setq comint-file-name-prefix
-          (concat "/" ssh-remote-user "@" ssh-host ":")))
-   ((< prefix 0)
-    (setq ssh-directory-tracking-mode nil)
-    (setq shell-dirtrackp nil))
-   (t
-    (setq ssh-directory-tracking-mode 'local)
-    (setq comint-file-name-prefix "")
-    (setq shell-dirtrackp t)))
-  (cond
-   (shell-dirtrackp
-    (let* ((proc (get-buffer-process (current-buffer)))
-           (proc-mark (process-mark proc))
-           (current-input (buffer-substring proc-mark (point-max)))
-           (orig-point (point))
-           (offset (and (>= orig-point proc-mark)
-                        (- (point-max) orig-point))))
-      (unwind-protect
-          (progn
-            (delete-region proc-mark (point-max))
-            (goto-char (point-max))
-            (shell-resync-dirs))
-        (goto-char proc-mark)
-        (insert current-input)
-        (if offset
-            (goto-char (- (point-max) offset))
-          (goto-char orig-point)))))))
-
-
-;; Parse a line into its constituent parts (words separated by
-;; whitespace).  Return a list of the words.
-(defun ssh-parse-words (line)
-  (let ((list nil)
-	(posn 0)
-        (match-data (match-data)))
-    (while (string-match "[^ \t\n]+" line posn)
-      (setq list (cons (substring line (match-beginning 0) (match-end 0))
-                       list))
-      (setq posn (match-end 0)))
-    (store-match-data (match-data))
-    (nreverse list)))
-
-(defun ssh-carriage-filter (string)
-  (let* ((point-marker (point-marker))
-         (end (process-mark (get-buffer-process (current-buffer))))
-         (beg (or (and (boundp 'comint-last-output-start)
-                       comint-last-output-start)
-                  (- end (length string)))))
-    (goto-char beg)
-    (while (search-forward "\C-m" end t)
-      (delete-char -1))
-    (goto-char point-marker)))
-
-(defun ssh-send-Ctrl-C ()
-  (interactive)
-  (process-send-string nil "\C-c"))
-
-(defun ssh-send-Ctrl-D ()
-  (interactive)
-  (process-send-string nil "\C-d"))
-
-(defun ssh-send-Ctrl-Z ()
-  (interactive)
-  (process-send-string nil "\C-z"))
-
-(defun ssh-send-Ctrl-backslash ()
-  (interactive)
-  (process-send-string nil "\C-\\"))
-
-(defun ssh-delchar-or-send-Ctrl-D (arg)
-  "\
-Delete ARG characters forward, or send a C-d to process if at end of buffer."
-  (interactive "p")
-  (if (eobp)
-      (ssh-send-Ctrl-D)
-    (delete-char arg)))
-
-(defun ssh-tab-or-complete ()
-  "Complete file name if doing directory tracking, or just insert TAB."
-  (interactive)
-  (if ssh-directory-tracking-mode
-      (comint-dynamic-complete)
-    (insert "\C-i")))
-
-(provide 'ssh)
-
-;;; ssh.el ends here
diff --git a/xemacs-packages/lisp/os-utils/tar-mode.el b/xemacs-packages/lisp/os-utils/tar-mode.el
deleted file mode 100644
index da1a29ac..00000000
--- a/xemacs-packages/lisp/os-utils/tar-mode.el
+++ /dev/null
@@ -1,1407 +0,0 @@
-;;; tar-mode.el --- simple editing of tar files from GNU emacs
-
-;; Copyright (C) 1990-1993, 1997 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski 
-;; Keywords: unix
-;; Created: 4 Apr 1990
-;; Version: 1.32
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: partially synched with Emacs 20.
-
-;;; Commentary:
-
-;; This package attempts to make dealing with Unix 'tar' archives easier.
-;; When this code is loaded, visiting a file whose name ends in '.tar' will
-;; cause the contents of that archive file to be displayed in a Dired-like
-;; listing.  It is then possible to use the customary Dired keybindings to
-;; extract sub-files from that archive, either by reading them into their own
-;; editor buffers, or by copying them directly to arbitrary files on disk.
-;; It is also possible to delete sub-files from within the tar file and write
-;; the modified archive back to disk, or to edit sub-files within the archive
-;; and re-insert the modified files into the archive.  See the documentation
-;; string of tar-mode for more info.
-
-;; To autoload, add this to your .emacs file:
-;;
-;;  (setq auto-mode-alist (cons '("\\.tar$" . tar-mode) auto-mode-alist))
-;;  (autoload 'tar-mode "tar-mode")
-;;
-;; But beware: for certain tar files - those whose very first file has 
-;; a -*- property line - autoloading won't work.  See the function 
-;; "tar-normal-mode" to understand why.
-
-;; This code now understands the extra fields that GNU tar adds to tar files.
-
-;; This interacts correctly with "uncompress.el" in the Emacs library,
-;; and with sufficiently recent versions of "crypt.el" by Kyle Jones.
-
-;;    ***************   TO DO   *************** 
-;;
-;; o  chmod should understand "a+x,og-w".
-;;
-;; o  It's not possible to add a NEW file to a tar archive; not that 
-;;    important, but still...
-;;
-;; o  The code is less efficient that it could be - in a lot of places, I
-;;    pull a 512-character string out of the buffer and parse it, when I could
-;;    be parsing it in place, not garbaging a string.  Should redo that.
-;;
-;; o  I'd like a command that searches for a string/regexp in every subfile
-;;    of an archive, where  would leave you in a subfile-edit buffer.
-;;    (Like M-s in VM and M-r in the Zmacs mail reader.)
-;;
-;; o  Sometimes (but not always) reverting the tar-file buffer does not 
-;;    re-grind the listing, and you are staring at the binary tar data.
-;;    Typing 'g' again immediately after that will always revert and re-grind
-;;    it, though.  I have no idea why this happens.
-;;
-;; o  Tar-mode interacts poorly with crypt.el and zcat.el because the tar
-;;    write-file-hook actually writes the file.  Instead it should remove the
-;;    header (and conspire to put it back afterwards) so that other write-file
-;;    hooks which frob the buffer have a chance to do their dirty work.  There
-;;    might be a problem if the tar write-file-hook does not come *first* on
-;;    the list.
-;;
-;; o  Block files, sparse files, continuation files, and the various header
-;;    types aren't editable.  Actually I don't know that they work at all.
-;;    If you know that they work, or know that they don't, please let me know.
-;;
-;; o  Tar files inside of tar files don't work.
-;;
-;; o  When using crypt-mode, you can't save a compressed or encrypted subfile
-;;    of a tar file back into the tar file: it is saved uncompressed.
-
-;;; Code:
-
-(defgroup tar ()
-  "Simple editing of tar files from GNU emacs."
-  :group 'unix
-  :group 'data)
-
-
-(defcustom tar-anal-blocksize 20
-  "*The blocksize of tar files written by Emacs, or nil, meaning don't care.
-The blocksize of a tar file is not really the size of the blocks; rather, it is
-the number of blocks written with one system call.  When tarring to a tape, 
-this is the size of the *tape* blocks, but when writing to a file, it doesn't
-matter much.  The only noticeable difference is that if a tar file does not
-have a blocksize of 20, the tar program will issue a warning; all this really
-controls is how many null padding bytes go on the end of the tar file."
-  :type 'integer
-  :group 'tar)
-
-(defcustom tar-update-datestamp t
-  "*Whether tar-mode should play fast and loose with sub-file datestamps;
-if this is true, then editing and saving a tar file entry back into its
-tar file will update its datestamp.  If false, the datestamp is unchanged.
-You may or may not want this - it is good in that you can tell when a file
-in a tar archive has been changed, but it is bad for the same reason that
-editing a file in the tar archive at all is bad - the changed version of 
-the file never exists on disk.
-
-This does not work in Emacs 18, because there's no way to get the current 
-time as an integer - if this var is true, then editing a file sets its date
-to midnight, Jan 1 1970 GMT, which happens to be what 0 encodes."
-  :type 'boolean
-  :group 'tar)
-
-
-;;; First, duplicate some Common Lisp functions; I used to just (require 'cl)
-;;; but "cl.el" was messing some people up (also it's really big).
-
-;; No need for that stuff anymore -- XEmacs preloads cl.el anyway.
-
-
-;;; down to business.
-
-(defmacro tar-make-header (name mode uid git size date ck lt ln
-				magic uname gname devmaj devmin)
-  (list 'vector name mode uid git size date ck lt ln
-	magic uname gname devmaj devmin))
-
-(defmacro tar-header-name (x) (list 'aref x 0))
-(defmacro tar-header-mode (x) (list 'aref x 1))
-(defmacro tar-header-uid  (x) (list 'aref x 2))
-(defmacro tar-header-gid  (x) (list 'aref x 3))
-(defmacro tar-header-size (x) (list 'aref x 4))
-(defmacro tar-header-date (x) (list 'aref x 5))
-(defmacro tar-header-checksum  (x) (list 'aref x 6))
-(defmacro tar-header-link-type (x) (list 'aref x 7))
-(defmacro tar-header-link-name (x) (list 'aref x 8))
-(defmacro tar-header-magic (x) (list 'aref x 9))
-(defmacro tar-header-uname (x) (list 'aref x 10))
-(defmacro tar-header-gname (x) (list 'aref x 11))
-(defmacro tar-header-dmaj (x) (list 'aref x 12))
-(defmacro tar-header-dmin (x) (list 'aref x 13))
-
-(defmacro tar-make-desc (data-start tokens)
-  (list 'cons data-start tokens))
-
-(defmacro tar-desc-data-start (x) (list 'car x))
-(defmacro tar-desc-tokens     (x) (list 'cdr x))
-
-(defconst tar-name-offset 0)
-(defconst tar-mode-offset (+ tar-name-offset 100))
-(defconst tar-uid-offset  (+ tar-mode-offset 8))
-(defconst tar-gid-offset  (+ tar-uid-offset 8))
-(defconst tar-size-offset (+ tar-gid-offset 8))
-(defconst tar-time-offset (+ tar-size-offset 12))
-(defconst tar-chk-offset  (+ tar-time-offset 12))
-(defconst tar-linkp-offset (+ tar-chk-offset 8))
-(defconst tar-link-offset (+ tar-linkp-offset 1))
-;;; GNU-tar specific slots.
-(defconst tar-magic-offset (+ tar-link-offset 100))
-(defconst tar-uname-offset (+ tar-magic-offset 8))
-(defconst tar-gname-offset (+ tar-uname-offset 32))
-(defconst tar-dmaj-offset (+ tar-gname-offset 32))
-(defconst tar-dmin-offset (+ tar-dmaj-offset 8))
-(defconst tar-end-offset (+ tar-dmin-offset 8))
-
-(defun tar-tokenize-header-block (string)
-  "Return a `tar-header' structure.
-This is a list of name, mode, uid, gid, size, 
-write-date, checksum, link-type, and link-name."
-  (cond ((< (length string) 512) nil)
-	(;(some 'plusp string)		 ; <-- oops, massive cycle hog!
-	 (or (not (= 0 (aref string 0))) ; This will do.
-	     (not (= 0 (aref string 101))))
-	 (let* ((name-end (1- tar-mode-offset))
-		(link-end (1- tar-magic-offset))
-		(uname-end (1- tar-gname-offset))
-		(gname-end (1- tar-dmaj-offset))
-		(link-p (aref string tar-linkp-offset))
-		(magic-str (substring string tar-magic-offset (1- tar-uname-offset)))
-		(uname-valid-p (or (string= "ustar  " magic-str) (string= "GNUtar " magic-str)))
-		name
-		(nulsexp   "[^\000]*\000"))
-	   (and (string-match nulsexp string tar-name-offset) (setq name-end (min name-end (1- (match-end 0)))))
-	   (and (string-match nulsexp string tar-link-offset) (setq link-end (min link-end (1- (match-end 0)))))
-	   (and (string-match nulsexp string tar-uname-offset) (setq uname-end (min uname-end (1- (match-end 0)))))
-	   (and (string-match nulsexp string tar-gname-offset) (setq gname-end (min gname-end (1- (match-end 0)))))
-	   (setq name (substring string tar-name-offset name-end)
-		 link-p (if (or (= link-p 0) (= link-p ?0))
-			    nil
-			  (- link-p ?0)))
-	   (if (and (null link-p) (string-match "/$" name)) (setq link-p 5)) ; directory
-	   (tar-make-header
-	    name
-	    (tar-parse-octal-integer string tar-mode-offset (1- tar-uid-offset))
-	    (tar-parse-octal-integer string tar-uid-offset (1- tar-gid-offset))
-	    (tar-parse-octal-integer string tar-gid-offset (1- tar-size-offset))
-	    (tar-parse-octal-integer string tar-size-offset (1- tar-time-offset))
-	    (tar-parse-octal-integer-32 string tar-time-offset (1- tar-chk-offset))
-	    (tar-parse-octal-integer string tar-chk-offset (1- tar-linkp-offset))
-	    link-p
-	    (substring string tar-link-offset link-end)
-	    uname-valid-p
-	    (and uname-valid-p (substring string tar-uname-offset uname-end))
-	    (and uname-valid-p (substring string tar-gname-offset gname-end))
-	    (tar-parse-octal-integer string tar-dmaj-offset (1- tar-dmin-offset))
-	    (tar-parse-octal-integer string tar-dmin-offset (1- tar-end-offset))
-	    )))
-	(t 'empty-tar-block)))
-
-
-(defun tar-parse-octal-integer (string &optional start end)
-  (if (null start) (setq start 0))
-  (if (null end) (setq end (length string)))
-  (if (= (aref string start) 0)
-      0
-    (let ((n 0))
-      (while (< start end)
-	(setq n (if (< (aref string start) ?0) n
-		  (+ (* n 8) (- (aref string start) 48)))
-	      start (1+ start)))
-      n)))
-
-(defun tar-parse-octal-integer-32 (string &optional start end)
-  ;; like tar-parse-octal-integer, but returns a cons of two 16-bit numbers,
-  ;; since elisp can't handle integers of that magnitude.
-  (or start (setq start 0))
-  (or end (setq end (length string)))
-  (let ((top (tar-parse-octal-integer string start (- end 6)))
-	(bot (tar-parse-octal-integer string (- end 6) end)))
-    (setq top (logior (ash top 2) (ash bot -16)))
-    (setq bot (logand bot 65535))
-    (cons top bot)))
-
-(defun tar-parse-octal-integer-safe (string)
-  (let ((L (length string)))
-    (if (= L 0) (error "empty string"))
-    (dotimes (i L)
-      (if (or (< (aref string i) ?0)
-	      (> (aref string i) ?7))
-	  (error "'%c' is not an octal digit."))))
-  (tar-parse-octal-integer string))
-
-
-(defun tar-header-block-checksum (string)
-  "Compute and return a tar-acceptable checksum for this block."
-  (let* ((chk-field-start tar-chk-offset)
-	 (chk-field-end (+ chk-field-start 8))
-	 (sum 0)
-	 (i 0))
-    ;; Add up all of the characters except the ones in the checksum field.
-    ;; Add that field as if it were filled with spaces.
-    (while (< i chk-field-start)
-      (setq sum (+ sum (aref string i))
-	    i (1+ i)))
-    (setq i chk-field-end)
-    (while (< i 512)
-      (setq sum (+ sum (aref string i))
-	    i (1+ i)))
-    (+ sum (* 32 8))))
-
-(defun tar-header-block-check-checksum (hblock desired-checksum file-name)
-  "Beep and print a warning if the checksum doesn't match."
-  (if (not (= desired-checksum (tar-header-block-checksum hblock)))
-      (progn (beep) (message "Invalid checksum for file %s!" file-name))))
-
-(defun tar-header-block-recompute-checksum (hblock)
-  "Modifies the given string to have a valid checksum field."
-  (let* ((chk (tar-header-block-checksum hblock))
-	 (chk-string (format "%6o" chk))
-	 (l (length chk-string)))
-    (aset hblock 154 0)
-    (aset hblock 155 32)
-    (dotimes (i l) (aset hblock (- 153 i) (aref chk-string (- l i 1)))))
-  hblock)
-
-
-(defun tar-grind-file-mode (mode string start)
-  "Store `-rw--r--r--' indicating MODE into STRING beginning at START.
-MODE should be an integer which is a file mode value."
-  (aset string start       (if (zerop (logand 256 mode)) ?- ?r))
-  (aset string (+ start 1) (if (zerop (logand 128 mode)) ?- ?w))
-  (aset string (+ start 2) (if (zerop (logand  64 mode)) ?- ?x)) 
-  (aset string (+ start 3) (if (zerop (logand  32 mode)) ?- ?r))
-  (aset string (+ start 4) (if (zerop (logand  16 mode)) ?- ?w))
-  (aset string (+ start 5) (if (zerop (logand   8 mode)) ?- ?x))
-  (aset string (+ start 6) (if (zerop (logand   4 mode)) ?- ?r))
-  (aset string (+ start 7) (if (zerop (logand   2 mode)) ?- ?w))
-  (aset string (+ start 8) (if (zerop (logand   1 mode)) ?- ?x))
-  (if (zerop (logand 1024 mode)) nil (aset string (+ start 2) ?s))
-  (if (zerop (logand 2048 mode)) nil (aset string (+ start 5) ?s))
-  string)
-
-
-(defconst tar-can-print-dates (or (fboundp 'current-time)
-				  (fboundp 'current-time-seconds))
-  "true if this emacs has been built with time-printing support")
-
-(defun tar-summarize-header-block (tar-hblock &optional mod-p)
-  "Returns a line similar to the output of `tar -vtf'."
-  (let ((name (tar-header-name tar-hblock))
-	(mode (tar-header-mode tar-hblock))
-	(uid (tar-header-uid tar-hblock))
-	(gid (tar-header-gid tar-hblock))
-	(uname (tar-header-uname tar-hblock))
-	(gname (tar-header-gname tar-hblock))
-	(size (tar-header-size tar-hblock))
-	(time (tar-header-date tar-hblock))
-	(ck (tar-header-checksum tar-hblock))
-	(link-p (tar-header-link-type tar-hblock))
-	(link-name (tar-header-link-name tar-hblock))
-	)
-    (let* ((left 11)
-	   (namew 8)
-	   (groupw 8)
-	   (sizew 8)
-	   (datew (if tar-can-print-dates 15 2))
-	   (slash (1- (+ left namew)))
-	   (lastdigit (+ slash groupw sizew))
-	   (namestart (+ lastdigit datew))
-	   (string (make-string (+ namestart (length name) (if link-p (+ 5 (length link-name)) 0)) 32))
-	   (type (tar-header-link-type tar-hblock)))
-      (aset string 0 (if mod-p ?* ? ))
-      (aset string 1
-	    (cond ((or (eq type nil) (eq type 0)) ?-)
-		  ((eq type 1) ?l)	; link
-		  ((eq type 2) ?s)	; symlink
-		  ((eq type 3) ?c)	; char special
-		  ((eq type 4) ?b)	; block special
-		  ((eq type 5) ?d)	; directory
-		  ((eq type 6) ?p)	; FIFO/pipe
-		  ((eq type 20) ?*)	; directory listing
-		  ((eq type 29) ?M)	; multivolume continuation
-		  ((eq type 35) ?S)	; sparse
-		  ((eq type 38) ?V)	; volume header
-		  ))
-      (tar-grind-file-mode mode string 2)
-      (setq uid (if (= 0 (length uname)) (int-to-string uid) uname))
-      (setq gid (if (= 0 (length gname)) (int-to-string gid) gname))
-      (setq size (int-to-string size))
-      (dotimes (i (min (1- namew) (length uid))) (aset string (- slash i) (aref uid (- (length uid) i 1))))
-      (aset string (1+ slash) ?/)
-      (dotimes (i (min (1- groupw) (length gid))) (aset string (+ (+ slash 2) i) (aref gid i)))
-      (dotimes (i (min sizew (length size))) (aset string (- lastdigit i) (aref size (- (length size) i 1))))
-
-      (if tar-can-print-dates
-	  (let* ((year (substring (current-time-string) -4))
-		 ;; in v18, current-time-string doesn't take an argument
-		 (file (current-time-string time))
-		 (file-year (substring file -4))
-		 (str (if (equal year file-year)
-			  (substring file 4 16)
-			(concat (substring file 4 11) " " file-year))))
-	    (dotimes (i 12) (aset string (- namestart (- 13 i)) (aref str i)))))
-
-      (dotimes (i (length name)) (aset string (+ namestart i) (aref name i)))
-      (if (or (eq link-p 1) (eq link-p 2))
-	  (progn
-	    (dotimes (i 3) (aset string (+ namestart 1 (length name) i) (aref (if (= link-p 1) "==>" "-->") i)))
-	    (dotimes (i (length link-name)) (aset string (+ namestart 5 (length name) i) (aref link-name i)))))
-      string)))
-
-
-;; buffer-local variables in the tar file's buffer:
-;;
-(defvar tar-parse-info)			; the header structures
-(defvar tar-header-offset)		; the end of the "pretty" data
-
-(defun tar-summarize-buffer ()
-  "Parse the contents of the tar file in the current buffer, and place a
-dired-like listing on the front; then narrow to it, so that only that listing
-is visible (and the real data of the buffer is hidden)."
-  (message "parsing tar file...")
-  (let* ((result '())
-	 (pos 1)
-	 (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
-	 (bs100 (max 1 (/ bs 100)))
-	 (tokens nil))
-    (while (not (eq tokens 'empty-tar-block))
-      (if (> (+ pos 512) (point-max))
-	  (error "truncated tar file"))
-      (let* ((hblock (buffer-substring pos (+ pos 512))))
-	(setq tokens (tar-tokenize-header-block hblock))
-	(setq pos (+ pos 512))
-	(message "parsing tar file...%s%%"
-				;(/ (* pos 100) bs)   ; this gets round-off lossage
-		 (/ pos bs100)		; this doesn't
-		 )
-	(if (eq tokens 'empty-tar-block)
-	    nil
-	  (if (null tokens) (error "premature EOF parsing tar file."))
-	  (if (eq (tar-header-link-type tokens) 20)
-	      ;; Foo.  There's an extra empty block after these.
-	      (setq pos (+ pos 512)))
-	  (let ((size (tar-header-size tokens)))
-	    (if (< size 0)
-		(error "%s has size %s - corrupted."
-		       (tar-header-name tokens) size))
-			;
-			; This is just too slow.  Don't really need it anyway....
-			;(tar-check-header-block-checksum
-			;  hblock (tar-checksum-header-block hblock)
-			;  (tar-header-name tokens))
-	    
-	    (setq result (cons (tar-make-desc pos tokens) result))
-	    
-	    (if (and (null (tar-header-link-type tokens))
-		     (> size 0))
-		(setq pos
-		      (+ pos 512 (ash (ash (1- size) -9) 9)) ; this works
-			;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't
-		      ))
-	    ))))
-    (make-local-variable 'tar-parse-info)
-    (setq tar-parse-info (nreverse result)))
-  (message "parsing tar file...formatting...")
-  (save-excursion
-    (goto-char (point-min))
-    (let ((buffer-read-only nil))
-      (dolist (tar-desc tar-parse-info)
-	(insert
-	 (tar-summarize-header-block (tar-desc-tokens tar-desc))
-	 "\n"))
-      (make-local-variable 'tar-header-offset)
-      (setq tar-header-offset (point))
-      (narrow-to-region 1 tar-header-offset)
-      (set-buffer-modified-p nil)))
-  (message "parsing tar file...done."))
-
-
-(defvar tar-mode-map nil "*Local keymap for tar-mode listings.")
-
-(if tar-mode-map
-    nil
-  (setq tar-mode-map (make-keymap))
-  (suppress-keymap tar-mode-map)
-  ;; Commands to mark certain categories of files
-  ;; Upper case keys for operating on the marked files
-  (define-key tar-mode-map "C" 'tar-copy)
-  (define-key tar-mode-map "R" 'tar-rename-entry)
-  (define-key tar-mode-map "M" 'tar-chmod-entry)
-  (define-key tar-mode-map "G" 'tar-chgrp-entry)
-  (define-key tar-mode-map "O" 'tar-chown-entry)
-  ;; Lower keys for commands not operating on all the marked files
-  (define-key tar-mode-map "d" 'tar-flag-deleted)
-  (define-key tar-mode-map "\^D" 'tar-flag-deleted)
-  (define-key tar-mode-map "e" 'tar-extract)
-  (define-key tar-mode-map "f" 'tar-extract)
-  (define-key tar-mode-map [return] 'tar-extract)
-  (define-key tar-mode-map "g" 'revert-buffer)
-  (define-key tar-mode-map "h" 'describe-mode)
-  (define-key tar-mode-map "o" 'tar-extract-other-window)
-  (define-key tar-mode-map "q" 'tar-quit)
-  (define-key tar-mode-map "u" 'tar-unflag)
-  (define-key tar-mode-map "v" 'tar-view)
-  (define-key tar-mode-map "x" 'tar-expunge)
-  (define-key tar-mode-map 'backspace 'tar-unflag-backwards)
-  (define-key tar-mode-map 'delete 'tar-unflag-backwards)
-  (define-key tar-mode-map "E" 'tar-extract-other-window)
-  ;; moving
-  (define-key tar-mode-map " " 'tar-next-line)
-  (define-key tar-mode-map "n" 'tar-next-line)
-  (define-key tar-mode-map "\^N" 'tar-next-line)
-  (define-key tar-mode-map [down] 'tar-next-line)
-  (define-key tar-mode-map "p" 'tar-previous-line)
-  (define-key tar-mode-map "\^P" 'tar-previous-line)
-  (define-key tar-mode-map [up] 'tar-previous-line)
-
-  (cond ((and (featurep 'xemacs)
-	      (not (featurep 'infodock)))
-	 (define-key tar-mode-map 'button2 'tar-track-mouse-and-extract-file)
-	 (define-key tar-mode-map 'button3 'tar-popup-menu)))
-  )
-
-
-;; XEmacs menu mouse/support added by Heiko Muenkel
-;; muenkel@tnt.uni-hannover.de
-
-(autoload 'dired-mark-region "dired-xemacs-menu")
-
-(defvar tar-menu
-  '("Tar Mode Commands"
-    ["Copy Subfile to Disk" tar-copy t]
-    ["Rename Subfile" tar-rename-entry t]
-    "----"
-    ["Delete Flaged Subfiles" tar-expunge t]
-    ["Flag Subfile for Deletion" tar-flag-deleted t]
-    ["Flag Subfiles in Region for Deletion"
-     (dired-mark-region '(tar-flag-deleted 1))
-     (mark)]
-    ["Unflag Subfile" tar-unflag t]
-    ["Unflag Subfiles in Region"
-     (dired-mark-region '(tar-flag-deleted 1 t))
-     (mark)]
-    "----"
-    ["Change Permissions of Subfile..." tar-chmod-entry t]
-    ["Change Group of Subfile..." tar-chgrp-entry t]
-    ["Change Owner of Subfile..." tar-chown-entry t]
-    "----"
-    ["Edit Subfile Other Window" tar-extract-other-window t]
-    ["Edit Subfile" tar-extract t]
-    ["View Subfile" tar-view t]
-    "----"
-    ["Quit Tar Mode" tar-quit t]
-    ))
-
-
-(defun tar-track-mouse-and-extract-file (event)
-  "Visit the tar-file-entry upon which the mouse is clicked."
-  (interactive "e")
-  (mouse-set-point event)
-  (tar-next-line 0)
-  (let (buffer)
-    (save-excursion
-      (tar-extract)
-      (setq buffer (current-buffer)))
-    (switch-to-buffer buffer)))
-
-(defun tar-popup-menu (event)
-  "Display the tar-mode menu."
-  (interactive "@e")
-  (mouse-set-point event)
-  (tar-next-line 0)
-  (popup-menu tar-menu))
-
-
-;; tar mode is suitable only for specially formatted data.
-(put 'tar-mode 'mode-class 'special)
-(put 'tar-subfile-mode 'mode-class 'special)
-
-;;;###autoload
-(defun tar-mode ()
-  "Major mode for viewing a tar file as a dired-like listing of its contents.
-You can move around using the usual cursor motion commands. 
-Letters no longer insert themselves.
-Type `e' to pull a file out of the tar file and into its own buffer;
-or click mouse-2 on the file's line in the Tar mode buffer.
-Type `c' to copy an entry from the tar file into another file on disk.
-
-If you edit a sub-file of this archive (as with the `e' command) and 
-save it with Control-x Control-s, the contents of that buffer will be 
-saved back into the tar-file buffer; in this way you can edit a file 
-inside of a tar archive without extracting it and re-archiving it.
-
-See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
-\\{tar-mode-map}"
-  ;; this is not interactive because you shouldn't be turning this
-  ;; mode on and off.  You can corrupt things that way.
-  (make-local-variable 'tar-header-offset)
-  (make-local-variable 'tar-parse-info)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline nil)	; binary data, dude...
-  (make-local-variable 'revert-buffer-function)
-  (setq revert-buffer-function 'tar-mode-revert)
-  (setq major-mode 'tar-mode)
-  (setq mode-name "Tar")
-  (use-local-map tar-mode-map)
-  (auto-save-mode 0)
-  (widen)
-  (if (and (boundp 'tar-header-offset) tar-header-offset)
-      (narrow-to-region 1 tar-header-offset)
-    (tar-summarize-buffer))
-  (cond ((string-match "XEmacs" emacs-version)
-	 (require 'mode-motion)
-	 (setq mode-motion-hook 'mode-motion-highlight-line)
-	 (when (and (boundp 'current-menubar)
-		    current-menubar
-		    (not (assoc "Tar" current-menubar)))
-	   (set-buffer-menubar (copy-sequence current-menubar))
-	   (add-menu nil "Tar" (cdr tar-menu)))
-	 ))
-  (run-hooks 'tar-mode-hook))
-
-;; buffer-local variables in subfile mode.
-;;
-(defvar tar-subfile-mode nil)		; whether the minor-mode is on
-(defvar tar-superior-buffer)		; parent buffer
-(defvar tar-superior-descriptor)	; header object of this file
-(defvar tar-subfile-buffer-id)		; pretty name-string
-(defvar subfile-orig-mlbid)		; orig mode-line-buffer-identification
-
-(defun tar-subfile-mode (p)
-  "Minor mode for editing an element of a tar-file.
-This mode arranges for \"saving\" this buffer to write the data
-into the tar-file buffer that it came from.  The changes will actually
-appear on disk when you save the tar-file's buffer."
-  (interactive "P")
-  (or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
-      (error "This buffer is not an element of a tar file."))
-  (or (assq 'tar-subfile-mode minor-mode-alist)
-      (setq minor-mode-alist (append minor-mode-alist
-				     (list '(tar-subfile-mode " TarFile")))))
-  (make-local-variable 'tar-subfile-mode)
-  (setq tar-subfile-mode
-	(if (null p)
-	    (not tar-subfile-mode)
-	  (> (prefix-numeric-value p) 0)))
-  (cond (tar-subfile-mode
-	 ;; copy the local keymap so that we don't accidentally
-	 ;; alter a keymap like 'lisp-mode-map' which is shared
-	 ;; by all buffers in that mode.
-	 (let ((m (current-local-map)))
-	   (if m (use-local-map (copy-keymap m))))
-	 (local-set-key "\^X\^S" 'tar-subfile-save-buffer)
-	 ;; turn off auto-save.
-	 (setq buffer-auto-save-file-name nil)
-	 (auto-save-mode 0)
-	 (run-hooks 'tar-subfile-mode-hook))
-	(t
-	 ;; remove the local binding for C-x C-s.
-	 (local-unset-key "\^X\^S")
-	 (if subfile-orig-mlbid
-	     (set (make-local-variable 'mode-line-buffer-identification)
-		  subfile-orig-mlbid))
-	 (setq tar-superior-buffer nil
-	       tar-superior-descriptor nil
-	       subfile-orig-mlbid nil)
-	 ))
-  )
-
-(defun tar-subfile-after-write-file-hook ()
-  ;; if the buffer has a filename, then it is no longer associated with
-  ;; the tar file.  Turn off subfile mode.
-  (if (and buffer-file-name tar-subfile-mode)
-      (tar-subfile-mode -1)))
-
-(defun tar-mode-revert (&optional no-autosave no-confirm)
-  "Revert this buffer and turn on tar mode again, to re-compute the
-directory listing."
-  (setq tar-header-offset nil)
-  (let ((revert-buffer-function nil))
-    (revert-buffer t no-confirm)
-    (widen))
-  (tar-mode))
-
-
-(defun tar-next-line (p)
-  (interactive "p")
-  (forward-line p)
-  (if (eobp) nil (forward-char (if tar-can-print-dates 48 36))))
-
-(defun tar-previous-line (p)
-  (interactive "p")
-  (tar-next-line (- p)))
-
-(defun tar-current-descriptor (&optional noerror)
-  "Returns the tar-descriptor of the current line, or signals an error."
-  ;; I wish lines had plists, like in ZMACS...
-  (or (nth (count-lines (point-min)
-			(save-excursion (beginning-of-line) (point)))
-	   tar-parse-info)
-      (if noerror
-	  nil
-	(error "This line does not describe a tar-file entry."))))
-
-
-(defun tar-extract (&optional other-window-p)
-  "In tar-mode, extract this entry of the tar file into its own buffer."
-  (interactive)
-  (let* ((view-p (eq other-window-p 'view))
-	 (descriptor (tar-current-descriptor))
-	 (tokens (tar-desc-tokens descriptor))
-	 (name (tar-header-name tokens))
-	 (size (tar-header-size tokens))
-	 (link-p (tar-header-link-type tokens))
-	 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1))
-	 (end (+ start size)))
-    (if link-p
-	(error "This is a %s, not a real file."
-	       (cond ((eq link-p 5) "directory")
-		     ((eq link-p 20) "tar directory header")
-		     ((eq link-p 29) "multivolume-continuation")
-		     ((eq link-p 35) "sparse entry")
-		     ((eq link-p 38) "volume header")
-		     (t "link"))))
-    (if (zerop size) (error "This is a zero-length file."))
-    (let* ((tar-buffer (current-buffer))
-	   (bufname (file-name-nondirectory name))
-	   (bufid (concat		;" (" name " in "
-		   " (in "
-		   (file-name-nondirectory (buffer-file-name))
-		   ")"))
-	   (read-only-p (or buffer-read-only view-p))
-	   (buffer nil)
-	   (buffers (buffer-list))
-	   (just-created nil))
-      ;; find a buffer visiting this subfile from this tar file.
-      (while (and buffers (not buffer))
-	(set-buffer (car buffers))
-	(if (and (null (buffer-file-name (car buffers)))
-		 (boundp 'tar-superior-descriptor)
-		 (eq tar-superior-descriptor descriptor))
-	    (setq buffer (car buffers))
-	  (setq buffers (cdr buffers))))
-      (set-buffer tar-buffer)
-      (if buffer
-	  nil
-	(setq buffer (generate-new-buffer bufname))
-	(setq just-created t)
-	(unwind-protect
-	    (progn
-	      (widen)
-	      (save-excursion
-		(set-buffer buffer)
-		(insert-buffer-substring tar-buffer start end)
-		(goto-char 0)
-		(let ((lock-directory nil)) ; disable locking
-		  (set-visited-file-name name) ; give it a name to decide mode.
-		  ;;		  (normal-mode)  ; pick a mode.
-		  ;;		  (after-find-file nil nil)  ; pick a mode; works with crypt.el
-		  ;; Ok, instead of running after-find-file, just invoke the
-		  ;; find-file-hooks instead.  This does everything we want
-		  ;; from after-find-file, without losing when visiting .tar
-		  ;; files via ange-ftp: doesn't probe the ftp site for the
-		  ;; name of the subfile.
-		  (normal-mode t)
-		  (run-hooks 'find-file-hooks)
-		  (set-visited-file-name nil) ; nuke the name - not meaningful.
-		  )
-		(make-local-variable 'tar-superior-buffer)
-		(make-local-variable 'tar-superior-descriptor)
-		(make-local-variable 'mode-line-buffer-identification)
-		(make-local-variable 'tar-subfile-buffer-id)
-		(make-local-variable 'subfile-orig-mlbid)
-		(setq tar-superior-buffer tar-buffer)
-		(setq tar-superior-descriptor descriptor)
-		(setq tar-subfile-buffer-id bufid)
-		(setq subfile-orig-mlbid mode-line-buffer-identification)
-		(cond ((stringp mode-line-buffer-identification)
-		       (setq mode-line-buffer-identification
-			     (list mode-line-buffer-identification))))
-		(let ((ms (car mode-line-buffer-identification))
-		      n)
-		  (cond ((and (stringp ms)
-			      (string-match "%\\([0-9]+\\)b\\'" ms))
-			 (setq mode-line-buffer-identification
-			       (cons
-				(concat (substring ms 0
-						   (1- (match-beginning 1)))
-					(substring ms (1+ (match-end 1))))
-				(cons
-				 (list (car (read-from-string
-					     (substring ms (match-beginning 1)
-							(match-end 1))))
-				       (concat "%b" tar-subfile-buffer-id))
-				 (cdr mode-line-buffer-identification)))))
-			(t
-			 (setq mode-line-buffer-identification
-			       (list "Emacs: "
-				     (list 17
-					   (concat "%b"
-						   tar-subfile-buffer-id)))))))
-		(tar-subfile-mode 1)
-		
-		(setq buffer-read-only read-only-p)
-		(set-buffer-modified-p nil))
-	      (set-buffer tar-buffer))
-	  (narrow-to-region 1 tar-header-offset)))
-      (if view-p
-	  (progn
-	    (view-buffer-other-window buffer)
-	    (save-excursion
-	      (set-buffer buffer)
-	      ;; for view-less.el; view.el can't do this.
-	      (set (make-local-variable 'view-kill-on-exit) t)))
-	(if other-window-p
-	    (switch-to-buffer-other-window buffer)
-	  (switch-to-buffer buffer))))))
-
-
-(defun tar-extract-other-window ()
-  "In tar-mode, extract this entry of the tar file into its own buffer."
-  (interactive)
-  (tar-extract t))
-
-(defun tar-view ()
-  "In tar-mode, view the tar file entry on this line."
-  (interactive)
-  (tar-extract 'view))
-
-
-(defun tar-read-file-name (&optional prompt)
-  "Read a file name with this line's entry as the default."
-  (or prompt (setq prompt "Copy to: "))
-  (let* ((default-file (expand-file-name
-			(tar-header-name (tar-desc-tokens
-					  (tar-current-descriptor)))))
-	 (target (expand-file-name
-		  (read-file-name prompt
-				  (file-name-directory default-file)
-				  default-file nil))))
-    (if (or (string= "" (file-name-nondirectory target))
-	    (file-directory-p target))
-	(setq target (concat (if (string-match "/$" target)
-				 (substring target 0 (1- (match-end 0)))
-			       target)
-			     "/"
-			     (file-name-nondirectory default-file))))
-    target))
-
-
-(defun tar-copy (&optional to-file)
-  "In tar-mode, extract this entry of the tar file into a file on disk.
-If TO-FILE is not supplied, it is prompted for, defaulting to the name of
-the current tar-entry."
-  (interactive (list (tar-read-file-name)))
-  (let* ((descriptor (tar-current-descriptor))
-	 (tokens (tar-desc-tokens descriptor))
-	 (name (tar-header-name tokens))
-	 (size (tar-header-size tokens))
-	 (link-p (tar-header-link-type tokens))
-	 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1))
-	 (end (+ start size)))
-    (if link-p (error "This is a link, not a real file."))
-    (if (zerop size) (error "This is a zero-length file."))
-    (let* ((tar-buffer (current-buffer))
-	   buffer)
-      (unwind-protect
-	  (progn
-	    (setq buffer (generate-new-buffer "*tar-copy-tmp*"))
-	    (widen)
-	    (save-excursion
-	      (set-buffer buffer)
-	      (insert-buffer-substring tar-buffer start end)
-	      (set-buffer-modified-p nil) ; in case we abort
-	      (write-file to-file)
-	      (message "Copied tar entry %s to %s" name to-file)
-	      (set-buffer tar-buffer)))
-	(narrow-to-region 1 tar-header-offset)
-	(if buffer (kill-buffer buffer)))
-      )))
-
-
-(defun tar-flag-deleted (p &optional unflag)
-  "In tar-mode, mark this sub-file to be deleted from the tar file.
-With a prefix argument, mark that many files."
-  (interactive "p")
-  (beginning-of-line)
-  (dotimes (i (if (< p 0) (- p) p))
-    (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line.
-	(progn
-	  (delete-char 1)
-	  (insert (if unflag " " "D"))))
-    (forward-line (if (< p 0) -1 1)))
-  (if (eobp) nil (forward-char 36)))
-
-(defun tar-unflag (p)
-  "In tar-mode, un-mark this sub-file if it is marked to be deleted.
-With a prefix argument, un-mark that many files forward."
-  (interactive "p")
-  (tar-flag-deleted p t))
-
-(defun tar-unflag-backwards (p)
-  "In tar-mode, un-mark this sub-file if it is marked to be deleted.
-With a prefix argument, un-mark that many files backward."
-  (interactive "p")
-  (tar-flag-deleted (- p) t))
-
-
-(defun tar-expunge-internal ()
-  "Expunge the tar-entry specified by the current line."
-  (let* ((descriptor (tar-current-descriptor))
-	 (tokens (tar-desc-tokens descriptor))
-	 (line (tar-desc-data-start descriptor))
-	 (name (tar-header-name tokens))
-	 (size (tar-header-size tokens))
-	 (link-p (tar-header-link-type tokens))
-	 (start (tar-desc-data-start descriptor))
-	 (following-descs (cdr (memq descriptor tar-parse-info))))
-    (if link-p (setq size 0))		; size lies for hard-links.
-    ;;
-    ;; delete the current line...
-    (beginning-of-line)
-    (let ((line-start (point)))
-      (end-of-line) (forward-char)
-      (let ((line-len (- (point) line-start)))
-	(delete-region line-start (point))
-	;;
-	;; decrement the header-pointer to be in synch...
-	(setq tar-header-offset (- tar-header-offset line-len))))
-    ;;
-    ;; delete the data pointer...
-    (setq tar-parse-info (delq descriptor tar-parse-info))
-    ;;
-    ;; delete the data from inside the file...
-    (widen)
-    (let* ((data-start (+ start tar-header-offset -513))
-	   (data-end (+ data-start 512 (ash (ash (+ size 511) -9) 9))))
-      (delete-region data-start data-end)
-      ;;
-      ;; and finally, decrement the start-pointers of all following
-      ;; entries in the archive.  This is a pig when deleting a bunch
-      ;; of files at once - we could optimize this to only do the
-      ;; iteration over the files that remain, or only iterate up to
-      ;; the next file to be deleted.
-      (let ((data-length (- data-end data-start)))
-	(dolist (desc following-descs)
-	  (setf (tar-desc-data-start desc)
-		(- (tar-desc-data-start desc) data-length))))
-      ))
-  (narrow-to-region 1 tar-header-offset))
-
-
-(defun tar-expunge (&optional noconfirm)
-  "In tar-mode, delete all the archived files flagged for deletion.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive)
-  (if (or noconfirm
-	  (y-or-n-p "Expunge files marked for deletion? "))
-      (let ((n 0))
-	(save-excursion
-	  (goto-char 0)
-	  (while (not (eobp))
-	    (if (looking-at "D")
-		(progn (tar-expunge-internal)
-		       (setq n (1+ n)))
-	      (forward-line 1)))
-	  ;; after doing the deletions, add any padding that may be necessary.
-	  (tar-pad-to-blocksize)
-	  (narrow-to-region 1 tar-header-offset)
-	  )
-	(if (zerop n)
-	    (message "Nothing to expunge.")
-	    (message "%s files expunged.  Be sure to save this buffer." n)))))
-
-
-(defun tar-clear-modification-flags ()
-  "Remove the stars at the beginning of each line."
-  (interactive)
-  (save-excursion
-    (goto-char 0)
-    (while (< (point) tar-header-offset)
-      (if (looking-at "*")
-	  (progn (delete-char 1) (insert " ")))
-      (forward-line 1))))
-
-
-(defun tar-chown-entry (new-uid)
-  "Change the user-id associated with this entry in the tar file.
-If this tar file was written by GNU tar, then you will be able to edit
-the user id as a string; otherwise, you must edit it as a number.
-You can force editing as a number by calling this with a prefix arg.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive (list
-		(let ((tokens (tar-desc-tokens (tar-current-descriptor))))
-		  (if (or current-prefix-arg
-			  (not (tar-header-magic tokens)))
-		      (let (n)
-			(while (not (numberp (setq n (read-minibuffer
-						      "New UID number: "
-						      (format "%s" (tar-header-uid tokens)))))))
-			n)
-		    (read-string "New UID string: " (tar-header-uname tokens))))))
-  (cond ((stringp new-uid)
-	 (setf (tar-header-uname (tar-desc-tokens (tar-current-descriptor)))
-	       new-uid)
-	 (tar-alter-one-field tar-uname-offset (concat new-uid "\000")))
-	(t
-	 (setf (tar-header-uid (tar-desc-tokens (tar-current-descriptor)))
-	       new-uid)
-	 (tar-alter-one-field
-	  tar-uid-offset
-	  (concat (substring (format "%6o" new-uid) 0 6) "\000 ")))))
-
-
-(defun tar-chgrp-entry (new-gid)
-  "Change the group-id associated with this entry in the tar file.
-If this tar file was written by GNU tar, then you will be able to edit
-the group id as a string; otherwise, you must edit it as a number.
-You can force editing as a number by calling this with a prefix arg.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive (list
-		(let ((tokens (tar-desc-tokens (tar-current-descriptor))))
-		  (if (or current-prefix-arg
-			  (not (tar-header-magic tokens)))
-		      (let (n)
-			(while (not (numberp (setq n (read-minibuffer
-						      "New GID number: "
-						      (format "%s" (tar-header-gid tokens)))))))
-			n)
-		    (read-string "New GID string: " (tar-header-gname tokens))))))
-  (cond ((stringp new-gid)
-	 (setf (tar-header-gname (tar-desc-tokens (tar-current-descriptor)))
-	       new-gid)
-	 (tar-alter-one-field tar-gname-offset
-			      (concat new-gid "\000")))
-	(t
-	 (setf (tar-header-gid (tar-desc-tokens (tar-current-descriptor)))
-	       new-gid)
-	 (tar-alter-one-field
-	  tar-gid-offset
-	  (concat (substring (format "%6o" new-gid) 0 6) "\000 ")))))
-
-(defun tar-rename-entry (new-name)
-  "Change the name associated with this entry in the tar file.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive
-   (list (read-string "New name: "
-		      (tar-header-name
-		       (tar-desc-tokens (tar-current-descriptor))))))
-  (if (string= "" new-name) (error "zero length name"))
-  (if (> (length new-name) 98) (error "name too long"))
-  (setf (tar-header-name (tar-desc-tokens (tar-current-descriptor)))
-	new-name)
-  (tar-alter-one-field 0
-		       (substring (concat new-name (make-string 99 0)) 0 99)))
-
-
-(defun tar-chmod-entry (new-mode)
-  "Change the protection bits associated with this entry in the tar file.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive (list (tar-parse-octal-integer-safe
-		      (read-string "New protection (octal): "))))
-  (setf (tar-header-mode (tar-desc-tokens (tar-current-descriptor)))
-	new-mode)
-  (tar-alter-one-field
-   tar-mode-offset
-   (concat (substring (format "%6o" new-mode) 0 6) "\000 ")))
-
-
-(defun tar-alter-one-field (data-position new-data-string)
-  (let* ((descriptor (tar-current-descriptor))
-	 (tokens (tar-desc-tokens descriptor)))
-    (unwind-protect
-	(save-excursion
-	  ;;
-	  ;; update the header-line.
-	  (beginning-of-line)
-	  (let ((p (point)))
-	    (forward-line 1)
-	    (delete-region p (point))
-	    (insert (tar-summarize-header-block tokens) "\n")
-	    (setq tar-header-offset (point-max)))
-	  
-	  (widen)
-	  (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513)))
-	    ;;
-	    ;; delete the old field and insert a new one.
-	    (goto-char (+ start data-position))
-	    (delete-region (point) (+ (point) (length new-data-string))) ; <--
-	    (insert new-data-string)	; <--
-	    ;;
-	    ;; compute a new checksum and insert it.
-	    (let ((chk (tar-header-block-checksum
-			(buffer-substring start (+ start 512)))))
-	      (goto-char (+ start tar-chk-offset))
-	      (delete-region (point) (+ (point) 8))
-	      (insert (format "%6o" chk))
-	      (insert 0)
-	      (insert ? )
-	      (setf (tar-header-checksum tokens) chk)
-	      ;;
-	      ;; ok, make sure we didn't botch it.
-	      (tar-header-block-check-checksum
-	       (buffer-substring start (+ start 512))
-	       chk (tar-header-name tokens)))))
-      (narrow-to-region 1 tar-header-offset))))
-
-
-(defun tar-subfile-save-buffer ()
-  "In tar subfile mode, save this buffer into its parent tar-file buffer.
-This doesn't write anything to disk; you must save the parent tar-file buffer
-to make your changes permanent."
-  (interactive)
-  (cond (buffer-file-name
-	 ;; tar-subfile buffers should have nil as buffer-file-name.  If they
-	 ;; ever gain a buffer-file-name, that means they have been written to
-	 ;; a real disk file, as with ^X^W.  If this happens, behave just like
-	 ;; `save-buffer.'
-	 (call-interactively 'save-buffer))
-	(t
-	 (tar-subfile-save-buffer-internal))))
-
-(defun tar-subfile-save-buffer-internal ()
-  (if (not (and (boundp 'tar-superior-buffer) tar-superior-buffer))
-      (error "This buffer has no superior tar file buffer."))
-  (or (buffer-name tar-superior-buffer)
-      (error "The superior tar file's buffer has been killed."))
-  (if (not (and (boundp 'tar-superior-descriptor) tar-superior-descriptor))
-      (error "This buffer doesn't have an index into its superior tar file!"))
-
-  ;; Notice when crypt.el has uncompressed while reading the subfile, and
-  ;; signal an error if the user tries to save back into the parent file
-  ;; (because it won't work - the .Z subfile it writes won't really be
-  ;; compressed.)
-  ;;
-					;  ;; These are for the old crypt.el
-					;  (if (and (boundp 'buffer-save-encrypted) buffer-save-encrypted)
-					;      (error "Don't know how to encrypt back into a tar file."))
-					;  (if (and (boundp 'buffer-save-compacted) buffer-save-compacted)
-					;      (error "Don't know how to compact back into a tar file."))
-					;  (if (and (boundp 'buffer-save-compressed) buffer-save-compressed)
-					;      (error "Don't know how to compress back into a tar file."))
-					;  (if (and (boundp 'buffer-save-gzipped) buffer-save-gzipped)
-					;      (error "Don't know how to gzip back into a tar file."))
-
-  ;; These are for the new crypt++.el
-  (if (and (boundp 'crypt-buffer-save-encrypted) crypt-buffer-save-encrypted)
-      (error "Don't know how to encrypt back into a tar file."))
-  (if (and (boundp 'crypt-buffer-save-compact) crypt-buffer-save-compact)
-      (error "Don't know how to compact back into a tar file."))
-  (if (and (boundp 'crypt-buffer-save-compress) crypt-buffer-save-compress)
-      (error "Don't know how to compress back into a tar file."))
-  (if (and (boundp 'crypt-buffer-save-gzip) crypt-buffer-save-gzip)
-      (error "Don't know how to gzip back into a tar file."))
-  (if (and (boundp 'crypt-buffer-save-freeze) crypt-buffer-save-freeze)
-      (error "Don't know how to freeze back into a tar file."))
-
-  (save-excursion
-    (let ((subfile (current-buffer))
-	  (subfile-size (buffer-size))
-	  (descriptor tar-superior-descriptor))
-      (set-buffer tar-superior-buffer)
-      (let* ((tokens (tar-desc-tokens descriptor))
-	     (start (tar-desc-data-start descriptor))
-	     (name (tar-header-name tokens))
-	     (size (tar-header-size tokens))
-	     (size-pad (ash (ash (+ size 511) -9) 9))
-	     (head (memq descriptor tar-parse-info))
-	     (following-descs (cdr head)))
-	(if (not head)
-	    (error "Can't find this tar file entry in its parent tar file!"))
-	(unwind-protect
-	    (save-excursion
-	      (widen)
-	      ;; delete the old data...
-	      (let* ((data-start (+ start tar-header-offset -1))
-		     (data-end (+ data-start (ash (ash (+ size 511) -9) 9))))
-		(delete-region data-start data-end)
-		;; insert the new data...
-		(goto-char data-start)
-		(insert-buffer subfile)
-		;;
-		;; pad the new data out to a multiple of 512...
-		(let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9)))
-		  (goto-char (+ data-start subfile-size))
-		  (insert (make-string (- subfile-size-pad subfile-size) 0))
-		  ;;
-		  ;; update the data pointer of this and all following files...
-		  (setf (tar-header-size tokens) subfile-size)
-		  (let ((difference (- subfile-size-pad size-pad)))
-		    (dolist (desc following-descs)
-		      (setf (tar-desc-data-start desc)
-			    (+ (tar-desc-data-start desc) difference))))
-		  ;;
-		  ;; Update the size field in the header block.
-		  (let ((header-start (- data-start 512)))
-		    (goto-char (+ header-start tar-size-offset))
-		    (delete-region (point) (+ (point) 12))
-		    (insert (format "%11o" subfile-size))
-		    (insert ? )
-		    ;;
-		    ;; Maybe update the datestamp.
-		    (if (not tar-update-datestamp)
-			nil
-		      (goto-char (+ header-start tar-time-offset))
-		      (delete-region (point) (+ (point) 12))
-		      (let (now top bot)
-			(cond ((fboundp 'current-time)
-			       (setq now (current-time))
-			       (setcdr now (car (cdr now))))
-					;			((fboundp 'current-time-seconds)
-					;			 (setq now (current-time-seconds)))
-			      )
-			(setq top (car now)
-			      bot (cdr now))
-			(cond
-			 (now
-			  (setf (tar-header-date tokens) now)
-			  ;; hair to print two 16-bit numbers as one octal number.
-			  (setq bot (logior (ash (logand top 3) 16) bot))
-			  (setq top (ash top -2))
-			  (insert (format "%5o" top))
-			  (insert (format "%06o " bot)))
-			 (t
-			  ;; otherwise, set it to the epoch.
-			  (insert (format "%11o " 0))
-			  (setf (tar-header-date tokens) (cons 0 0))
-			  ))))
-		    ;;
-		    ;; compute a new checksum and insert it.
-		    (let ((chk (tar-header-block-checksum
-				(buffer-substring header-start data-start))))
-		      (goto-char (+ header-start tar-chk-offset))
-		      (delete-region (point) (+ (point) 8))
-		      (insert (format "%6o" chk))
-		      (insert 0)
-		      (insert ? )
-		      (setf (tar-header-checksum tokens) chk)))
-		  ;;
-		  ;; alter the descriptor-line...
-		  ;;
-		  (let ((position (- (length tar-parse-info) (length head))))
-		    (goto-char 1)
-		    (next-line position)
-		    (beginning-of-line)
-		    (let ((p (point))
-			  (m (set-marker (make-marker) tar-header-offset)))
-		      (forward-line 1)
-		      (delete-region p (point))
-		      (insert-before-markers (tar-summarize-header-block tokens t) "\n")
-		      (setq tar-header-offset (marker-position m)))
-		    )))
-	      ;; after doing the insertion, add any final padding that may be necessary.
-	      (tar-pad-to-blocksize))
-	  (narrow-to-region 1 tar-header-offset)))
-      (set-buffer-modified-p t)		; mark the tar file as modified
-      (set-buffer subfile)
-      (set-buffer-modified-p nil)	; mark the tar subfile as unmodified
-      (message "saved into tar-buffer \"%s\" - remember to save that buffer!"
-	       (buffer-name tar-superior-buffer))
-      )))
-
-
-(defun tar-pad-to-blocksize ()
-  "If we are being anal about tar file blocksizes, fix up the current buffer.
-Leaves the region wide."
-  (if (null tar-anal-blocksize)
-      nil
-    (widen)
-    (let* ((last-desc (nth (1- (length tar-parse-info)) tar-parse-info))
-	   (start (tar-desc-data-start last-desc))
-	   (tokens (tar-desc-tokens last-desc))
-	   (link-p (tar-header-link-type tokens))
-	   (size (if link-p 0 (tar-header-size tokens)))
-	   (data-end (+ start size))
-	   (bbytes (ash tar-anal-blocksize 9))
-	   (pad-to (+ bbytes (* bbytes (/ (1- data-end) bbytes))))
-	   (buffer-read-only nil)	; ##
-	   )
-      ;; If the padding after the last data is too long, delete some;
-      ;; else insert some until we are padded out to the right number of blocks.
-      ;;
-      (goto-char (+ (or tar-header-offset 0) data-end))
-      (if (> (1+ (buffer-size)) (+ (or tar-header-offset 0) pad-to))
-	  (delete-region (+ (or tar-header-offset 0) pad-to) (1+ (buffer-size)))
-	(insert (make-string (- (+ (or tar-header-offset 0) pad-to)
-				(1+ (buffer-size)))
-			     0)))
-      )))
-
-
-(defun tar-maybe-write-file ()
-  "Used as a write-file-hook to write tar-files out correctly."
-  ;;
-  ;; If the current buffer is in tar-mode and has its header-offset set,
-  ;; remove the header from the file, call the remaining write-file hooks,
-  ;; and then write out the buffer (if and only if one of the write-file
-  ;; hooks didn't write it already).  Then put the header back on the
-  ;; buffer.  Many thanks to Piet van Oostrum for this code, which causes
-  ;; correct interaction with crypt.el (and probably anything like it.)
-  ;;
-  ;; Kludge: in XEmacs Emacs, write-file-hooks is bound to nil before the
-  ;; write-file-hooks are run, to prevent them from being run recursively
-  ;; (this is more of a danger in v19-vintage emacses, which have both
-  ;; write-file-hooks and write-contents-hooks.)  So, we need to reference
-  ;; an internal variable of basic-save-buffer to get the list of hooks
-  ;; remaining to be run.
-  ;;
-  (and (eq major-mode 'tar-mode)
-       (and (boundp 'tar-header-offset) tar-header-offset)
-       (let* ((hooks (cond ((string-match "XEmacs" emacs-version)
-			    ;; Internal to basic-save-buffer in XEmacs.
-			    (symbol-value 'hooks))
-			   ((string-lessp "19" emacs-version)
-			    ;; I think this is what we need to do in fsfmacs.
-			    (append write-contents-hooks write-file-hooks))
-			   (t
-			    write-file-hooks)))
-	      (remaining-hooks (cdr (memq 'tar-maybe-write-file hooks)))
-	      header-string
-	      done)
-	 (save-excursion
-	   (save-restriction
-	     (widen)
-	     (tar-clear-modification-flags)
-	     (setq header-string (buffer-substring 1 tar-header-offset))
-	     (delete-region 1 tar-header-offset)
-	     (unwind-protect
-		 (progn
-		   (while (and remaining-hooks
-			       (not (setq done (funcall (car remaining-hooks)))))
-		     (setq remaining-hooks (cdr remaining-hooks)))
-		   (cond ((not done)
-			  (write-region 1 (1+ (buffer-size))
-					buffer-file-name nil t)
-			  (setq done t))))
-	       (goto-char 1)
-	       (insert header-string)
-	       (set-buffer-modified-p nil))))
-	 done)))
-
-
-;;; Patch it in.
-
-;;;###autoload
-(defvar tar-regexp "\\.tar$"
-  "The regular expression used to identify tar file names.
-Note that this regular expression must not match compressed tar file
-names; if it does, tar-mode will attempt to parse the compressed tar
-file as an uncompressed tar file, which will generate an error.  This
-is not a problem, as other modules that handle compression will
-uncompress the buffer and call `tar-mode' appropriately.")
-
-;;;###autoload
-(setq auto-mode-alist
-      (cons (cons tar-regexp 'tar-mode) auto-mode-alist))
-
-;; Note: the tar write-file-hook should go on the list *before* any other
-;; hooks which might write the file.  Since things like crypt-mode add things
-;; to the end of the write-file-hooks, this will normally be the case.
-
-					;(or (boundp 'write-file-hooks) (setq write-file-hooks nil))
-					;(or (listp write-file-hooks)
-					;    (setq write-file-hooks (list write-file-hooks)))
-					;(or (memq 'tar-maybe-write-file write-file-hooks)
-					;    (setq write-file-hooks
-					;	  (cons 'tar-maybe-write-file write-file-hooks)))
-
-(add-hook 'write-file-hooks 'tar-maybe-write-file) ; ####write-contents-hooks??
-(cond ((boundp 'after-save-hook)
-       (add-hook 'after-save-hook 'tar-subfile-after-write-file-hook))
-      ((boundp 'after-write-file-hooks)
-       (add-hook 'after-write-file-hooks 'tar-subfile-after-write-file-hook))
-      (t (error "neither after-save-hook nor after-write-file-hooks?")))
-
-
-;;; This is a hack.  For files ending in .tar, we want -*- lines to be
-;;; completely ignored - if there is one, it applies to the first file
-;;; in the archive, and not the archive itself!  Similarly for local
-;;; variables specifications in the last file of the archive.
-
-(defun tar-normal-mode (&optional find-file)
-  "Choose the major mode for this buffer automatically.
-Also sets up any specified local variables of the file.
-Uses the visited file name, the -*- line, and the local variables spec.
-
-This function is called automatically from `find-file'.  In that case,
-if `inhibit-local-variables' is non-`nil' we require confirmation before
-processing a local variables spec.  If you run `normal-mode' explicitly,
-confirmation is never required.
-
-Note that this version of this function has been hacked to interact
-correctly with tar files - when visiting a file which matches
-'tar-regexp', the -*- line and local-variables are not examined,
-as they would apply to a file within the archive rather than the archive
-itself."
-  (interactive)
-  (if (and buffer-file-name
-	   (string-match tar-regexp buffer-file-name))
-      (tar-mode)
-    (tar-real-normal-mode find-file)))
-
-;; We have to shadow this as well to get along with crypt.el.
-;; Shadowing this alone isn't enough, though; we need to shadow 
-;; tar-normal-mode in order to inhibit the local variables of the
-;; last file in the tar archive.
-;;
-(defun tar-set-auto-mode ()
-  "Select major mode appropriate for current buffer.
-May base decision on visited file name (See variable  auto-mode-list)
-or on buffer contents (-*- line or local variables spec), but does not look
-for the \"mode:\" local variable.  For that, use  hack-local-variables.
-
-Note that this version of this function has been hacked to interact
-correctly with tar files - when visiting a file which matches
-'tar-regexp', the -*- line and local-variables are not examined,
-as they would apply to a file within the archive rather than the archive
-itself."
-  (interactive)
-  (if (and buffer-file-name
-	   (string-match tar-regexp buffer-file-name))
-      (tar-mode)
-    (tar-real-set-auto-mode)))
-
-(if (not (fboundp 'tar-real-normal-mode))
-    (fset 'tar-real-normal-mode (symbol-function 'normal-mode)))
-(fset 'normal-mode 'tar-normal-mode)
-
-(if (not (fboundp 'tar-real-set-auto-mode))
-    (fset 'tar-real-set-auto-mode (symbol-function 'set-auto-mode)))
-(fset 'set-auto-mode 'tar-set-auto-mode)
-
-(defun tar-quit ()
-  "Kill the current tar buffer."
-  (interactive)
-  (kill-buffer nil))
-
-(provide 'tar-mode)
-
-;;; tar-mode.el ends here
diff --git a/xemacs-packages/lisp/os-utils/telnet.el b/xemacs-packages/lisp/os-utils/telnet.el
deleted file mode 100644
index e9ae16dd..00000000
--- a/xemacs-packages/lisp/os-utils/telnet.el
+++ /dev/null
@@ -1,341 +0,0 @@
-;;; telnet.el --- run a telnet session from within an Emacs buffer
-
-;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: William F. Schelter
-;; Keywords: comm, unix
-;; Maintainer: Pete Ware 
-
-;; 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:
-
-;; This mode is intended to be used for telnet or rsh to a remote host;
-;; `telnet' and `rsh' are the two entry points.  Multiple telnet or rsh
-;; sessions are supported.
-;;
-;; Normally, input is sent to the remote telnet/rsh line-by-line, as you
-;; type RET or LFD.  C-c C-c sends a C-c to the remote immediately; 
-;; C-c C-z sends C-z immediately.  C-c C-q followed by any character
-;; sends that character immediately.
-;;
-;; All RET characters are filtered out of the output coming back from the
-;; remote system.  The mode tries to do other useful translations based
-;; on what it sees coming back from the other system before the password
-;; query.  It knows about UNIX, ITS, TOPS-20 and Explorer systems.
-;;
-;; You can use the global telnet-host-properties to associate a telnet
-;; program and login name with each host you regularly telnet to.
-
-;;; Code:
-
-;; to do fix software types for lispm:
-;; to eval current expression.  Also to try to send escape keys correctly.
-;; essentially we'll want the rubout-handler off.
-
-;; filter is simplistic but should be okay for typical shell usage.
-;; needs hacking if it is going to deal with asynchronous output in a sane
-;; manner
-
-(require 'comint)
-
-(defgroup telnet nil
-  "Run a telnet session from within an Emacs buffer."
-  :group 'comint)
-
-(defvar telnet-host-properties ()
-  "Specify which telnet program to use for particular hosts.
-Each element has the form (HOSTNAME PROGRAM [LOGIN-NAME])
-HOSTNAME says which machine the element applies to.
-PROGRAM says which program to run, to talk to that machine.
-LOGIN-NAME, which is optional, says what to log in as on that machine.")
-
-(defvar telnet-new-line "\r")
-(defvar telnet-mode-map nil)
-(defvar telnet-default-prompt-pattern "^[^#$%>\n]*[#$%>] *")
-(defvar telnet-prompt-pattern telnet-default-prompt-pattern)
-
-(defvar telnet-replace-c-g nil)
-(make-variable-buffer-local
- (defvar telnet-remote-echoes t
-   "True if the telnet process will echo input."))
-(make-variable-buffer-local
- (defvar telnet-interrupt-string "\C-c" "String sent by C-c."))
-
-(defvar telnet-count 0
-  "Number of output strings read from the telnet process
-while looking for the initial password.")
-;; (make-variable-buffer-local 'telnet-count)
-
-(defcustom telnet-program "telnet"
-  "*Program to run to open a telnet connection."
-  :type 'string
-  :group 'telnet)
-
-(defcustom rsh-eat-password-string nil
-  "Non-nil means rsh will look for a string matching a password prompt."
-  :type 'boolean
-  :group 'telnet)
-
-(defvar telnet-initial-count -75
-  "Initial value of `telnet-count'.  Should be set to the negative of the
-number of terminal writes telnet will make setting up the host connection.")
-
-(defvar telnet-maximum-count 4
-  "Maximum value `telnet-count' can have.
-After this many passes, we stop looking for initial setup data.
-Should be set to the number of terminal writes telnet will make
-rejecting one login and prompting again for a username and password.")
-
-(defun telnet-interrupt-subjob ()
-  (interactive)
-  "Interrupt the program running through telnet on the remote host."
-  (process-send-string nil telnet-interrupt-string))
-
-(defun telnet-c-z ()
-  (interactive)
-  (process-send-string nil "\C-z"))
-
-;; Keep telnet- prefix)
-(defun telnet-send-process-next-char ()
-  (interactive)
-  (process-send-string nil
-	       (char-to-string
-		(let ((inhibit-quit t))
-		  (prog1 (read-char)
-		    (setq quit-flag nil))))))
-
-; initialization on first load.
-(if telnet-mode-map
-    nil
-  (setq telnet-mode-map (make-sparse-keymap))
-  (set-keymap-parent telnet-mode-map comint-mode-map)
-  (define-key telnet-mode-map "\C-m" 'telnet-send-input)
-;  (define-key telnet-mode-map "\C-j" 'telnet-send-input)
-  (define-key telnet-mode-map "\C-c\C-q" 'telnet-send-process-next-char)
-  (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob) 
-  (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z))
-
-;;maybe should have a flag for when have found type
-(defun telnet-check-software-type-initialize (string)
-  "Tries to put correct initializations in.  Needs work."
-  (let ((case-fold-search t))
-    (cond ((string-match "unix" string)
-	   (setq telnet-prompt-pattern shell-prompt-pattern)
-	   (setq telnet-new-line "\n"))
-	  ((string-match "tops-20" string) ;;maybe add telnet-replace-c-g
-	   (setq telnet-prompt-pattern  "[@>] *"))
-	  ((string-match "its" string)
-	   (setq telnet-prompt-pattern  "^[^*>\n]*[*>] *"))
-	  ((string-match "explorer" string) ;;explorer telnet needs work
-	   (setq telnet-replace-c-g ?\n))))
-  (setq comint-prompt-regexp telnet-prompt-pattern))
-
-(defun telnet-initial-filter (proc string)
-  (let ((case-fold-search t))
-    ;For reading up to and including password; also will get machine type.
-    (cond ((string-match "No such host" string)
-	   (kill-buffer (process-buffer proc))
-	   (error "No such host."))
-	  ((string-match "passw" string)
-	   (telnet-filter proc string)
-	   (let ((password (comint-read-noecho "Password: " t)))
-	     (setq telnet-count 0)
-	     (process-send-string proc (concat password telnet-new-line))))
-	  (t (telnet-check-software-type-initialize string)
-	     (telnet-filter proc string)
-	     (cond ((> telnet-count telnet-maximum-count)
-		    ;; (set-process-filter proc 'telnet-filter) Kludge
-		    ;; for shell-fonts -- this is the only mode that
-		    ;; actually changes what its process filter is at
-		    ;; run time, which confuses shell-font.  So we
-		    ;; special-case that here.
-		    ;; #### Danger, knows an internal shell-font variable name.
-		    (let ((old-filter (process-filter proc)))
-		      (if (eq old-filter 'shell-font-process-filter)
-			  (set (make-local-variable 'shell-font-process-filter)
-			       'telnet-filter)
-			(set-process-filter proc 'telnet-filter))))
-		   (t (setq telnet-count (1+ telnet-count))))))))
-
-;; Identical to comint-simple-send, except that it sends telnet-new-line
-;; instead of "\n".
-(defun telnet-simple-send (proc string)
-  (comint-send-string proc string)
-  (comint-send-string proc telnet-new-line))
-
-(defun telnet-filter (proc string)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (save-match-data
-     (let* ((last-insertion (marker-position (process-mark proc)))
-	    (delta (- (point) last-insertion))
-	    (ie (and comint-last-input-end
-		     (marker-position comint-last-input-end)))
-	    (w (get-buffer-window (current-buffer)))
-	    (ws (and w (window-start w))))
-       (goto-char last-insertion)
-	;; Insert STRING, omitting all C-m characters.
-       (insert-before-markers string)
-       (set-marker (process-mark proc) (point))
-       ;; the insert-before-markers may have screwed window-start
-       ;; and likely moved comint-last-input-end.  This is why the
-       ;; insertion-reaction should be a property of markers, not
-       ;; of the function which does the inserting.
-       (if ws (set-window-start w ws t))
-       (if ie (set-marker comint-last-input-end ie))
-       (while (progn (skip-chars-backward "^\C-m" last-insertion)
-		     (> (point) last-insertion))
-	 (delete-region (1- (point)) (point)))
-       (goto-char (process-mark proc))
-       (and telnet-replace-c-g
-	    (subst-char-in-region last-insertion (point) ?\C-g
-				  telnet-replace-c-g t))
-      ;; If point is after the insertion place, move it
-      ;; along with the text.
-      (if (> delta 0)
-	  (goto-char (+ (process-mark proc) delta)))))))
-
-(defun telnet-send-input ()
-  (interactive)
-  (let ((proc (get-buffer-process (current-buffer)))
-	p1 p2)
-    (if (and telnet-remote-echoes
-	     (>= (point) (process-mark proc)))
-	(save-excursion
-	  (if comint-eol-on-send (end-of-line))
-	  (setq p1 (marker-position (process-mark proc))
-		p2 (point))))
-    (prog1
-	(comint-send-input)
-      ;; at this point, comint-send-input has moved the process mark, inserted
-      ;; a newline, and possibly inserted the (echoed) output.  If the host is
-      ;; in remote-echo mode, then delete our local copy of the command, and
-      ;; the newline that comint-send-input sent.
-      (if p1
-	  (delete-region p1 (1+ p2))))))
-
-;;;###autoload (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
-
-;;;###autoload
-(defun telnet (host &optional port)
-  "Open a network login connection to host named HOST (a string).
-With a prefix argument, prompts for the port name or number as well.
-Communication with HOST is recorded in a buffer `*PROGRAM-HOST*'
-where PROGRAM is the telnet program being used.  This program
-is controlled by the contents of the global variable `telnet-host-properties',
-falling back on the value of the global variable `telnet-program'.
-Normally input is edited in Emacs and sent a line at a time.
-See also `\\[rsh]'."
-  (interactive (list (read-string "Open telnet connection to host: ")
-		     (if current-prefix-arg
-			 (read-string "Port name or number: ")
-		       nil)))
-  (let* ((comint-delimiter-argument-list '(?\  ?\t))
-	 (properties (cdr (assoc host telnet-host-properties)))
-	 (telnet-program (if properties (car properties) telnet-program))
-         (name (concat telnet-program "-" (comint-arguments host 0 nil) ))
-	 (buffer (get-buffer (concat "*" name "*")))
-	 (telnet-options (if (cdr properties) (cons "-l" (cdr properties))))
-	 process)
-    (if (and buffer (get-buffer-process buffer))
-	(pop-to-buffer buffer)
-      (pop-to-buffer 
-       (apply 'make-comint name telnet-program nil telnet-options))
-      (setq process (get-buffer-process (current-buffer)))
-      (set-process-filter process 'telnet-initial-filter)
-      
-      ;; SunOS and IRIX don't print "unix" in their rsh or telnet
-      ;; login banners, so let's get a reasonable default here.
-      ;; #### This patch from jwz mimics what is done in rsh done
-      ;; below.  However, it (along with the one in rsh) mean that
-      ;; telnet-check-software-type-initialize is effectively a
-      ;; wastoid function.  Reworking it like it claims to need is
-      ;; probably the better solution but I'm not going to do it.
-      ;; --cet
-      (telnet-check-software-type-initialize "unix")
-      
-      ;; Don't send the `open' cmd till telnet is ready for it.
-      (accept-process-output process)
-      (erase-buffer)
-      (process-send-string process (concat "open " host
-					   (if port (concat " " port) "")
-					   "\n"))
-      (setq comint-input-sender 'telnet-simple-send)
-      (setq telnet-count telnet-initial-count)
-      (telnet-mode))))
-
-(put 'telnet-mode 'mode-class 'special)
-
-(defun telnet-mode ()
-  "This mode is for using telnet (or rsh) from a buffer to another host.
-It has most of the same commands as comint-mode.
-There is a variable ``telnet-interrupt-string'' which is the character
-sent to try to stop execution of a job on the remote host.
-Data is sent to the remote host when RET is typed.
-
-\\{telnet-mode-map}
-"
-  (interactive)
-  (comint-mode)
-  (setq major-mode 'telnet-mode
-        mode-name "Telnet"
-        comint-prompt-regexp telnet-prompt-pattern)
-  (use-local-map telnet-mode-map)
-  (set (make-local-variable 'telnet-count) telnet-initial-count)
-  (run-hooks 'telnet-mode-hook))
-
-;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")
-
-;;;###autoload
-(defun rsh (host)
-  "Open a network login connection to host named HOST (a string).
-Communication with HOST is recorded in a buffer `*rsh-HOST*'.
-Normally input is edited in Emacs and sent a line at a time.
-See also `\\[telnet]'."
-  (interactive "sOpen rsh connection to host: ")
-  (require 'shell)
-  (let ((name (concat "rsh-" host )))
-    (pop-to-buffer (make-comint name remote-shell-program nil host))
-    (setq telnet-count telnet-initial-count)
-    ;;
-    ;; SunOS doesn't print "unix" in its rsh login banner, so let's get a
-    ;; reasonable default here.  There do exist non-Unix machines which
-    ;; speak the rsh protocol, but let's hope they print their OS name
-    ;; when one connects.
-    ;;
-    (telnet-check-software-type-initialize "unix")
-    ;;
-    ;; I think we should use telnet-filter here instead of -initial-filter,
-    ;; because rsh generally doesn't prompt for a password, and gobbling the
-    ;; first line that contains "passw" is extremely antisocial.  More
-    ;; antisocial than echoing a password, and more likely than connecting
-    ;; to a non-Unix rsh host these days...
-    ;;
-    ;; I disagree with the above.  -sb
-    ;;
-    (set-process-filter (get-process name) (if rsh-eat-password-string
-					       'telnet-initial-filter
-					     'telnet-filter))
-    ;; (set-process-filter (get-process name) 'telnet-filter)
-    ;; run last so that hooks can change things.
-    (telnet-mode)))
-
-(provide 'telnet)
-
-;;; telnet.el ends here
diff --git a/xemacs-packages/lisp/os-utils/terminal.el b/xemacs-packages/lisp/os-utils/terminal.el
deleted file mode 100644
index 3f566029..00000000
--- a/xemacs-packages/lisp/os-utils/terminal.el
+++ /dev/null
@@ -1,1280 +0,0 @@
-;;; terminal.el --- terminal emulator for GNU Emacs.
-;; Keywords: comm, terminals
-
-;; Copyright (C) 1986, 1987, 1988, 1989, 1993 Free Software Foundation, Inc.
-;; Written by Richard Mlynarik, November 1986.
-;; Face and attribute support added by Richard Mlynarik, April 1996.
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not synched with FSF.
-
-;;#### TODO
-;;#### terminfo?
-
-;;#### One probably wants to do setenv MORE -c when running with
-;;####   more-processing enabled.
-
-(provide 'terminal)
-(require 'ehelp)
-
-(defvar terminal-escape-char ?\C-^
-  "*All characters except for this are passed verbatim through the
-terminal-emulator.  This character acts as a prefix for commands
-to the emulator program itself.  Type this character twice to send
-it through the emulator.  Type ? after typing it for a list of
-possible commands.
-This variable is local to each terminal-emulator buffer.")
-
-(defvar terminal-scrolling t
-  "*If non-nil, the terminal-emulator will `scroll' when output occurs
-past the bottom of the screen.  If nil, output will `wrap' to the top
-of the screen.
-This variable is local to each terminal-emulator buffer.")
-
-(defvar terminal-more-processing t
-  "*If non-nil, do more-processing.
-This variable is local to each terminal-emulator buffer.")
-
-;; If you are the sort of loser who uses scrolling without more breaks
-;; and expects to actually see anything, you should probably set this to
-;; around 400
-(defvar terminal-redisplay-interval 5000
-  "*Maximum number of characters which will be processed by the
-terminal-emulator before a screen redisplay is forced.
-Set this to a large value for greater throughput,
-set it smaller for more frequent updates but overall slower
-performance.")
-
-(defvar terminal-more-break-insertion
-  "*** More break -- Press space to continue ***")
-
-(defvar terminal-escape-map nil)
-(defvar terminal-map nil)
-(defvar terminal-more-break-map nil)
-(if terminal-map
-    nil
-  (let ((map (make-keymap)))
-    (set-keymap-name map 'terminal-map)
-
-    (let ((meta-prefix-char -1)
-          (s (make-string 1 0))
-          (i 0))
-      (while (< i 256)
-        (aset s 0 i)
-        (define-key map s 'te-pass-through)
-        (setq i (1+ i))))
-
-    ;(define-key map "\C-l"
-    ;  '(lambda () (interactive) (te-pass-through) (redraw-display)))
-    (setq terminal-map map)))
-
-(if terminal-escape-map
-    nil
-  (let ((map (make-keymap)))
-    (set-keymap-name map 'terminal-escape-map)
-    (let ((s (make-string 1 ?0)))
-      (while (<= (aref s 0) ?9)
-	(define-key map s 'digit-argument)
-	(aset s 0 (1+ (aref s 0)))))
-    (define-key map "b" 'switch-to-buffer)
-    (define-key map "o" 'other-window)
-    (define-key map "e" 'te-set-escape-char)
-    (define-key map "\C-l" 'redraw-display)
-    (define-key map "\C-o" 'te-flush-pending-output)
-    (define-key map "m" 'te-toggle-more-processing)
-    (define-key map "x" 'te-escape-extended-command)
-    (define-key map "?" 'te-escape-help)
-    (define-key map (vector help-char) 'te-escape-help)
-    (setq terminal-escape-map map)))
-
-(defvar te-escape-command-alist '())
-(if te-escape-command-alist
-    nil
-  (setq te-escape-command-alist
-	'(("Set Escape Character" . te-set-escape-char)
-	  ("Refresh" . redraw-display)
-	  ("Record Output" . te-set-output-log)
-	  ("Photo" . te-set-output-log)
-	  ("Tofu" . te-tofu) ;; confuse the uninitiated
-	  ("Stuff Input" . te-stuff-string)
-	  ("Flush Pending Output" . te-flush-pending-output)
-	  ("Enable More Processing" . te-enable-more-processing)
-	  ("Disable More Processing" . te-disable-more-processing)
-	  ("Scroll at end of page" . te-do-scrolling)
-	  ("Wrap at end of page" . te-do-wrapping)
-	  ("Switch To Buffer" . switch-to-buffer)
-	  ("Other Window" . other-window)
-	  ("Kill Buffer" . kill-buffer)
-	  ("Help" . te-escape-help)
-	  ("Set Redisplay Interval" . te-set-redisplay-interval)
-	  )))
-
-;(setq terminal-more-break-map nil)
-(if terminal-more-break-map
-    nil
-  (let ((map (make-keymap)))
-    (set-keymap-name map 'terminal-more-break-map)
-
-    (let ((meta-prefix-char -1)
-          (s (make-string 1 0))
-          (i 0))
-      (while (< i 256)
-        (aset s 0 i)
-        (define-key map s 'te-more-break-unwind)
-        (setq i (1+ i))))
-
-    (define-key map (vector help-char) 'te-more-break-help)
-    (define-key map " " 'te-more-break-resume)
-    (define-key map "\C-l" 'redraw-display)
-    (define-key map "\C-o" 'te-more-break-flush-pending-output)
-    ;;#### this isn't right
-    ;(define-key map "\^?" 'te-more-break-flush-pending-output) ;DEL
-    (define-key map "\r" 'te-more-break-advance-one-line)
-
-    (setq terminal-more-break-map map)))
-  
-(defvar te-width)
-(defvar te-height)
-(defvar te-process)
-(defvar te-pending-output)
-(defvar te-saved-point)
-(defvar te-pending-output-info)
-(defvar te-log-buffer)
-(defvar te-more-count)
-(defvar te-redisplay-count)
-(defvar te-current-face)
-(defvar te-current-attributes)
-
-(make-face 'terminal-default)
-
-(make-face 'terminal-standout)
-(if (not (face-differs-from-default-p 'terminal-standout))
-    (copy-face 'bold 'terminal-standout))
-
-(make-face 'terminal-underline)
-(cond ((face-differs-from-default-p 'terminal-underline))
-      ((find-face 'underline)
-       (copy-face 'underline 'terminal-underline))
-      (t
-       (set-face-underline-p 'terminal-underline t)))
-
-(make-face 'terminal-standout-underline)
-(cond ((face-differs-from-default-p 'terminal-standout-underline))
-      (t
-       (copy-face 'terminal-standout 'terminal-standout-underline)
-       (set-face-underline-p 'terminal-standout-underline t)))
-
-(defun te-insert-blank (count)
-  (let ((p (point)))
-    (insert-char ?\  count)
-    (put-text-property p (point) 'face 'terminal-default)))
-
-
-;;;;  escape map
-
-(defun te-escape-p (event)
-  (cond ((eventp terminal-escape-char)
-         (cond ((key-press-event-p event)
-                (and (key-press-event-p terminal-escape-char)
-                     (= (event-modifier-bits event)
-                        (event-modifier-bits terminal-escape-char))
-                     (eq (event-key event)
-                         (event-key terminal-escape-char))))
-               ((button-press-event-p event)
-                (and (button-press-event-p terminal-escape-char)
-                     (= (event-modifier-bits event)
-                        (event-modifier-bits terminal-escape-char))
-                     (eq (event-button event)
-                         (event-button terminal-escape-char))))
-               (t nil)))
-        ((numberp terminal-escape-char)
-         (let ((c (event-to-character event nil t nil)))
-           (and c (= c terminal-escape-char))))
-        (t
-         nil)))
-
-
-(defun te-escape ()
-  (interactive)
-  (let ((c (let ((cursor-in-echo-area t)
-                 (prompt (if prefix-arg
-                             (format "Emacs Terminal escape> %d "
-                                     (prefix-numeric-value prefix-arg))
-                             "Emacs Terminal escape> ")))
-             (message "%s" prompt)
-             (let ((e (next-command-event)))
-               (while (button-release-event-p e)
-                 (setq e (next-command-event e)))
-               (if (te-escape-p e)
-                   e
-                   (progn
-                     (setq unread-command-event e)
-                     (lookup-key terminal-escape-map
-                                 (read-key-sequence prompt))))))))
-    (cond ((eventp c)
-           (message nil)
-           (copy-event c last-command-event)
-           (let ((terminal-escape-char -259))
-             (te-pass-through)))
-          (c
-           (call-interactively c)))))
-
-(defun te-escape-help ()
-  "Provide help on commands available after terminal-escape-char is typed."
-  (interactive)
-  (message "Terminal emulator escape help...")
-  (let ((char (single-key-description terminal-escape-char)))
-    (with-electric-help
-      (function (lambda ()
-	 (princ (format "Terminal-emulator escape, invoked by \"%s\"
-Type \"%s\" twice to send a single \"%s\" through.
-
-Other chars following \"%s\" are interpreted as follows:\n"
-			char char char char))
-
-	 (princ (substitute-command-keys "\\{terminal-escape-map}\n"))
-	 (princ (format "\nSubcommands of \"%s\" (%s)\n"
-			(where-is-internal 'te-escape-extended-command
-					   terminal-escape-map t)
-			'te-escape-extended-command))
-	 (let ((l (if (fboundp 'sortcar)
-		      (sortcar (copy-sequence te-escape-command-alist)
-			       'string<)
-		      (sort (copy-sequence te-escape-command-alist)
-			    (function (lambda (a b)
-                              (string< (car a) (car b))))))))
-	   (while l
-	     (let ((doc (or (documentation (cdr (car l)))
-			    "Not documented")))
-	       (if (string-match "\n" doc)
-		   ;; just use first line of documentation
-		   (setq doc (substring doc 0 (match-beginning 0))))
-	       (princ "  \"")
-	       (princ (car (car l)))
-	       (princ "\":\n     ")
-	       (princ doc)
-	       (write-char ?\n))
-	     (setq l (cdr l))))
-	 nil)))))
-
-			
-
-(defun te-escape-extended-command ()
-  (interactive)
-  (let ((c (let ((completion-ignore-case t))
-	     (completing-read "terminal command: "
-			      te-escape-command-alist
-			      nil t))))
-    (if c
-	(catch 'foo
-	  (setq c (downcase c))
-	  (let ((l te-escape-command-alist))
-	    (while l
-	      (if (string= c (downcase (car (car l))))
-		  (throw 'foo (call-interactively (cdr (car l))))
-		(setq l (cdr l)))))))))
-
-;; not used.
-(defun te-escape-extended-command-unread ()
-  (interactive)
-  (setq unread-command-event last-command-event)
-  (te-escape-extended-command))
-
-(defun te-set-escape-char (c)
-  "Change the terminal-emulator escape character."
-  (interactive (list (let ((cursor-in-echo-area t))
-                       (message "Set escape character to: ")
-                       (let ((e (next-command-event)))
-                         (while (button-release-event-p e)
-                           (setq e (next-command-event e)))
-                         e))))
-  (cond ((te-escape-p c)
-         (message "\"%s\" is escape char"))
-        ((and (eventp terminal-escape-char)
-              (event-to-character terminal-escape-char nil t nil))
-         (message "\"%s\" is now escape; \"%s\" passes though"
-                  (single-key-description c)
-                  (single-key-description terminal-escape-char)))
-        (t
-         (message "\"%s\" is now escape"
-                  (single-key-description c))
-         ;; Let mouse-events, for example, go back to looking at global map
-         (local-unset-key (vector terminal-escape-char))))
-  (local-set-key (vector c) 'te-escape) ;ensure it's defined
-  (setq terminal-escape-char c))
-
-
-(defun te-stuff-string (string)
-  "Read a string to send to through the terminal emulator
-as though that string had been typed on the keyboard.
-
-Very poor man's file transfer protocol."
-  (interactive "sStuff string: ")
-  (process-send-string te-process string))
-
-(defun te-set-output-log (name)
-  "Record output from the terminal emulator in a buffer."
-  (interactive (list (if te-log-buffer
-			 nil
-		       (read-buffer "Record output in buffer: "
-				    (format "%s output-log"
-					    (buffer-name (current-buffer)))
-				    nil))))
-  (if (or (null name) (equal name ""))
-      (progn (setq te-log-buffer nil)
-	     (message "Output logging off."))
-    (if (get-buffer name)
-	nil
-      (save-excursion
-	(set-buffer (get-buffer-create name))
-	(fundamental-mode)
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)))
-    (setq te-log-buffer (get-buffer name))
-    (message "Recording terminal emulator output into buffer \"%s\""
-	     (buffer-name te-log-buffer))))
-
-(defun te-tofu ()
-  "Discontinue output log."
-  (interactive)
-  (te-set-output-log nil))
-  
-
-(defun te-toggle (sym arg)
-  (set sym (cond ((not (numberp arg)) arg)
-		 ((= arg 1) (not (symbol-value sym)))
-		 ((< arg 0) nil)
-		 (t t))))
-
-(defun te-toggle-more-processing (arg)
-  (interactive "p")
-  (message (if (te-toggle 'terminal-more-processing arg)
-	       "More processing on" "More processing off"))
-  (if terminal-more-processing (setq te-more-count -1)))
-
-(defun te-toggle-scrolling (arg)
-  (interactive "p")
-  (message (if (te-toggle 'terminal-scrolling arg)
-	       "Scroll at end of page" "Wrap at end of page")))
-
-(defun te-enable-more-processing ()
-  "Enable ** MORE ** processing"
-  (interactive)
-  (te-toggle-more-processing t))
-
-(defun te-disable-more-processing ()
-  "Disable ** MORE ** processing"
-  (interactive)
-  (te-toggle-more-processing nil))
-
-(defun te-do-scrolling ()
-  "Scroll at end of page (yuck)"
-  (interactive)
-  (te-toggle-scrolling t))
-
-(defun te-do-wrapping ()
-  "Wrap to top of window at end of page"
-  (interactive)
-  (te-toggle-scrolling nil))
-
-
-(defun te-set-redisplay-interval (arg)
-  "Set the maximum interval (in output characters) between screen updates.
-Set this number to large value for greater throughput,
-set it smaller for more frequent updates (but overall slower performance."
-  (interactive "NMax number of output chars between redisplay updates: ")
-  (setq arg (max arg 1))
-  (setq terminal-redisplay-interval arg
-	te-redisplay-count 0))
-
-;;;; more map
-
-;; every command -must- call te-more-break-unwind
-;; or grave lossage will result
-
-(put 'te-more-break-unread 'suppress-keymap t)
-(defun te-more-break-unread ()
-  (interactive)
-  (if (te-escape-p last-command-event)
-      (call-interactively 'te-escape)
-    (message "Continuing from more break (\"%s\" typed, %d chars output pending...)"
-	     (single-key-description last-command-event)
-	     (te-pending-output-length))
-    (setq te-more-count 259259)
-    (te-more-break-unwind)
-    (let ((terminal-more-processing nil))
-      (te-pass-through))))
-
-(defun te-more-break-resume ()
-  "Proceed past the **MORE** break,
-allowing the next page of output to appear"
-  (interactive)
-  (message "Continuing from more break")
-  (te-more-break-unwind))
-
-(defun te-more-break-help ()
-  "Provide help on commands available in a terminal-emulator **MORE** break"
-  (interactive)
-  (message "Terminal-emulator more break help...")
-  (sit-for 0)
-  (with-electric-help
-    (function (lambda ()
-      (princ "Terminal-emulator more break.\n\n")
-      (princ (format "Type \"%s\" (te-more-break-resume)\n%s\n"
-		     (where-is-internal 'te-more-break-resume
-					terminal-more-break-map t)
-		     (documentation 'te-more-break-resume)))
-      (princ (substitute-command-keys "\\{terminal-more-break-map}\n"))
-      (princ "Any other key is passed through to the program
-running under the terminal emulator and disables more processing until
-all pending output has been dealt with.")
-      nil))))
-
-
-(defun te-more-break-advance-one-line ()
-  "Allow one more line of text to be output before doing another more break."
-  (interactive)
-  (setq te-more-count 1)
-  (te-more-break-unwind))
-
-(defun te-more-break-flush-pending-output ()
-  "Discard any output which has been received by the terminal emulator but
-not yet proceesed and then proceed from the more break."
-  (interactive)
-  (te-more-break-unwind)
-  (te-flush-pending-output))
-
-(defun te-flush-pending-output ()
-  "Discard any as-yet-unprocessed output which has been received by
-the terminal emulator."
-  (interactive)
-  ;; this could conceivably be confusing in the presence of
-  ;; escape-sequences spanning process-output chunks
-  (if (null (cdr te-pending-output))
-      (message "(There is no output pending)")
-    (let ((length (te-pending-output-length)))
-      (message "Flushing %d chars of pending output" length)
-      (setq te-pending-output
-	    (list 0 (format "\n*** %d chars of pending output flushed ***\n"
-			    length)))
-      (te-update-pending-output-display)
-      (te-process-output nil)
-      (sit-for 0))))
-
-
-(defun te-pass-through ()
-  "Send the last character typed through the terminal-emulator
-without any interpretation"
-  (interactive)
-  (if (te-escape-p last-command-event)
-      (call-interactively 'te-escape)
-    (and terminal-more-processing
-	 (null (cdr te-pending-output))
-	 (te-set-more-count nil))
-    (let ((c (event-to-character last-command-event nil t nil)))
-      (if c (process-send-string te-process (make-string 1 c))))
-    (te-process-output t)))
-
-(defun te-set-window-start ()
-  (let* ((w (get-buffer-window (current-buffer)))
-	 (h (if w (window-height w))))
-    (cond ((not w)) ; buffer not displayed
-	  ((>= h (/ (- (point) (point-min)) (1+ te-width)))
-	   ;; this is the normal case
-	   (set-window-start w (point-min)))
-	  ;; this happens if some vandal shrinks our window.
-	  ((>= h (/ (- (point-max) (point)) (1+ te-width)))
-	   (set-window-start w (- (point-max) (* h (1+ te-width)) -1)))
-	  ;; I give up.
-	  (t nil))))
-
-(defun te-pending-output-length ()
-  (let ((length (car te-pending-output))
-	(tem (cdr te-pending-output)))
-    (while tem
-      (setq length (+ length (length (car tem))) tem (cdr tem)))
-    length))
-
-;;;; more break hair
-
-(defun te-more-break ()
-  (te-set-more-count t)
-  (make-local-variable 'te-more-old-point)
-  (setq te-more-old-point (point))
-  (make-local-variable 'te-more-old-local-map)
-  (setq te-more-old-local-map (current-local-map))
-  (use-local-map terminal-more-break-map)
-  (make-local-variable 'te-more-old-filter)
-  (setq te-more-old-filter (process-filter te-process))
-  (make-local-variable 'te-more-old-mode-line-format)
-  (setq te-more-old-mode-line-format mode-line-format
-	mode-line-format (list "--   **MORE**  "
-			       mode-line-buffer-identification
-			       "%-"))
-  (set-process-filter te-process
-    (function (lambda (process string)
-		(save-excursion
-		  (set-buffer (process-buffer process))
-		  (setq te-pending-output (nconc te-pending-output
-						 (list string))))
-		  (te-update-pending-output-display))))
-  (te-update-pending-output-display)
-  (if (eq (window-buffer (selected-window)) (current-buffer))
-      (message "More break "))
-  (or (eobp)
-      (null terminal-more-break-insertion)
-      (save-excursion
-	(forward-char 1)
-	(delete-region (point) (+ (point) te-width))
-	(insert terminal-more-break-insertion)))
-  (run-hooks 'terminal-more-break-hook)
-  (sit-for 0) ;get display to update
-  (throw 'te-process-output t))
-
-(defun te-more-break-unwind ()
-  (interactive)
-  (use-local-map te-more-old-local-map)
-  (set-process-filter te-process te-more-old-filter)
-  (goto-char te-more-old-point)
-  (setq mode-line-format te-more-old-mode-line-format)
-  (set-buffer-modified-p (buffer-modified-p))
-  (let ((buffer-read-only nil))
-    (cond ((eobp))
-	  (terminal-more-break-insertion
-	   (forward-char 1)
-	   (delete-region (point)
-			  (+ (point) (length terminal-more-break-insertion)))
-	   (te-insert-blank te-width)
-	   (goto-char te-more-old-point)))
-    (setq te-more-old-point nil)
-    (let ((te-more-count 259259))
-      (te-newline)))
-  ;(sit-for 0)
-  (te-process-output t))
-
-(defun te-set-more-count (newline)
-  (let ((line (/ (- (point) (point-min)) (1+ te-width))))
-    (if newline (setq line (1+ line)))
-    (cond ((= line te-height)
-	   (setq te-more-count te-height))
-	  ;#### something is strange.  Investigate this!
-	  ((= line (1- te-height))
-	   (setq te-more-count te-height))
-	  ((or (< line (/ te-height 2))
-	       (> (- te-height line) 10))
-	   ;; break at end of this page
-	   (setq te-more-count (- te-height line)))
-	  (t
-	   ;; migrate back towards top (ie bottom) of screen.
-	   (setq te-more-count (- te-height
-				  (if (> te-height 10) 2 1)))))))
-
-
-;;;; More or less straight-forward terminal escapes
-
-;; ^j, meaning `newline' to non-display programs.
-;; (Who would think of ever writing a system which doesn't understand
-;;  display terminals natively?  Un*x:  The Operating System of the Future.)
-(defun te-newline ()
-  "Move down a line, optionally do more processing, perhaps wrap/scroll,
-move to start of new line, clear to end of line."
-  (end-of-line)
-  (cond ((not terminal-more-processing))
-	((< (setq te-more-count (1- te-more-count)) 0)
-	 (te-set-more-count t))
-	((eq te-more-count 0)
-	 ;; this doesn't return
-	 (te-more-break)))
-  (if (eobp)
-      (progn
-	(delete-region (point-min) (+ (point-min) te-width))
-	(goto-char (point-min))
-	(if terminal-scrolling
-	    (progn (delete-char 1)
-		   (goto-char (point-max))
-		   (insert ?\n))))
-    (forward-char 1)
-    (delete-region (point) (+ (point) te-width)))
-  (te-insert-blank te-width)
-  (beginning-of-line)
-  (te-set-window-start))
-
-;; ^p ^j
-;; Handle the `do' or `nl' termcap capability.
-;;#### I am not sure why this broken, obsolete, capability is here.
-;;#### Perhaps it is for VIle.  No comment was made about why it
-;;#### was added (in "Sun Dec  6 01:22:27 1987  Richard Stallman")
-(defun te-down-vertically-or-scroll ()
-  "Move down a line vertically, or scroll at bottom."
-  (let ((column (current-column)))
-    (end-of-line)
-    (if (eobp)
-	(progn
-	  (delete-region (point-min) (+ (point-min) te-width))
-	  (goto-char (point-min))
-	  (delete-char 1)
-	  (goto-char (point-max))
-	  (insert ?\n)
-	  (te-insert-blank te-width)
-	  (beginning-of-line))
-      (forward-line 1))
-    (move-to-column column))
-  (te-set-window-start))
-
-; ^p = x+32 y+32
-(defun te-move-to-position ()
-  ;; must offset by #o40 since cretinous unix won't send a 004 char through
-  (let ((y (- (te-get-char) 32))
-	(x (- (te-get-char) 32)))
-    (if (or (> x te-width)
-	    (> y te-height))
-	() ;(error "fucked %d %d" x y)
-      (goto-char (+ (point-min) x (* y (1+ te-width))))
-      ;(te-set-window-start?)
-      ))
-  (setq te-more-count -1))
-
-
-
-;; ^p c
-(defun te-clear-rest-of-line ()
-  (save-excursion
-    (let ((n (- (point) (progn (end-of-line) (point)))))
-      (delete-region (point) (+ (point) n))
-      (te-insert-blank (- n)))))
-
-
-;; ^p C
-(defun te-clear-rest-of-screen ()
-  (save-excursion
-    (te-clear-rest-of-line)
-    (while (progn (end-of-line) (not (eobp)))
-      (forward-char 1) (end-of-line)
-      (delete-region (- (point) te-width) (point))
-      (te-insert-blank te-width))))
-      
-
-;; ^p ^l
-(defun te-clear-screen ()
-  ;; regenerate buffer to compensate for (nonexistent!!) bugs.
-  (erase-buffer)
-  (let ((i 0))
-    (while (< i te-height)
-      (setq i (1+ i))
-      (te-insert-blank te-width)
-      (insert ?\n)))
-  (delete-region (1- (point-max)) (point-max))
-  (goto-char (point-min))
-  (setq te-more-count -1))
-
-
-;; ^p ^o count+32
-(defun te-insert-lines ()
-  (if (not (bolp))
-      ();(error "fooI")
-    (save-excursion
-      (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
-	     (n (min (- (te-get-char) ?\ ) line))
-	     (i 0))
-	(delete-region (- (point-max) (* n (1+ te-width))) (point-max))
-	(if (eq (point) (point-max)) (insert ?\n))
-	(while (< i n)
-	  (setq i (1+ i))
-	  (te-insert-blank te-width)
-	  (or (eq i line) (insert ?\n))))))
-  (setq te-more-count -1))
-
-
-;; ^p ^k count+32
-(defun te-delete-lines ()
-  (if (not (bolp))
-      ();(error "fooD")
-    (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
-	   (n (min (- (te-get-char) ?\ ) line))
-	   (i 0))
-      (delete-region (point)
-		     (min (+ (point) (* n (1+ te-width))) (point-max)))
-      (save-excursion
-	(goto-char (point-max))
-	(while (< i n)
-	  (setq i (1+ i))
-	  (te-insert-blank te-width)
-	  (or (eq i line) (insert ?\n))))))
-  (setq te-more-count -1))
-
-;; ^p ^a
-(defun te-beginning-of-line ()
-  (beginning-of-line))
-
-;; ^p ^b
-(defun te-backward-char ()
-  (if (not (bolp))
-      (backward-char 1)))
-
-;; ^p ^f
-(defun te-forward-char ()
-  (if (not (eolp))
-      (forward-char 1)))
-
-
-;; ^p *
-(defun te-change-attribute ()
-  (let* ((attribute (te-get-char))
-         (on (= (te-get-char) ?1))
-         (standout (assq 'standout te-current-attributes))
-         (underline (assq 'underline te-current-attributes))
-         (frob (function (lambda ()
-                 ;; This would be even more of a combinatorial mess if I
-                 ;;  decided I wanted to support anything more than the two
-                 ;;  standout and underline attributes.
-                 (setq te-current-face
-                       (or (cdr (assoc te-current-attributes
-                                       '((((standout . t) (underline . nil))
-                                          . terminal-standout)
-                                         (((standout . nil) (underline . t))
-                                          . terminal-standout)
-                                         (((standout . t) (underline . nil))
-                                          . terminal-standout-underline))))
-                           'terminal-default))))))
-    (cond ((= attribute ?+) ;standout on/off
-           (setcdr standout on)
-           (funcall frob))
-          ((= attribute ?_) ;underline on/off
-           (setcdr underline on)
-           (funcall frob))
-          ;; reverse, blink, half-bright, double-bright, blank, protect
-          ;; ??Colours??
-          (t ;; #\space
-           (setcdr underline nil)
-           (setcdr standout nil)
-           (setq te-current-face 'terminal-default)))))
-
-
-;; 0177
-(defun te-delete ()
-  (if (bolp)
-      ()
-    (delete-region (1- (point)) (point))
-    (te-insert-blank 1)
-    (forward-char -1)))
-
-;; ^p ^g
-(defun te-beep ()
-  (beep))
-
-
-;; ^p _ count+32
-(defun te-insert-spaces ()
-  (let* ((p (point))
-	 (n (min (- (te-get-char) 32)
-		 (- (progn (end-of-line) (point)) p))))
-    (if (<= n 0)
-	nil
-      (delete-char (- n))
-      (goto-char p)
-      (insert-char ?\  n))
-    (goto-char p)))
-
-;; ^p d count+32  (should be ^p ^d but cretinous un*x won't send ^d chars!!!)
-(defun te-delete-char ()
-  (let* ((p (point))
-	 (n (min (- (te-get-char) 32)
-		 (- (progn (end-of-line) (point)) p))))
-    (if (<= n 0)
-	nil
-      (te-insert-blank n)
-      (goto-char p)
-      (delete-char n))
-    (goto-char p)))
-
-
-
-;; disgusting unix-required shit
-;;  Are we living twenty years in the past yet?
-
-(defun te-losing-unix ()
-  ;(what lossage)
-  ;(message "fucking-unix: %d" char)
-  )
-
-;; ^i
-(defun te-output-tab ()
-  (let* ((p (point))
-	 (x (- p (progn (beginning-of-line) (point))))
-	 (l (min (- 8 (logand x 7))
-		 (progn (end-of-line) (- (point) p)))))
-    (goto-char (+ p l))))
-
-;; Also:
-;;  ^m => beginning-of-line (for which it -should- be using ^p ^a, right?!!)
-;;  ^g => te-beep (for which it should use ^p ^g)
-;;  ^h => te-backward-char (for which it should use ^p ^b)
-
-
-
-(defun te-filter (process string)
-  (let* ((obuf (current-buffer)))
-    ;; can't use save-excursion, as that preserves point, which we don't want
-    (unwind-protect
-	(progn
-	  (set-buffer (process-buffer process))
-	  (goto-char te-saved-point)
-	  (and (bufferp te-log-buffer)
-	       (if (null (buffer-name te-log-buffer))
-		   ;; killed
-		   (setq te-log-buffer nil)
-		 (set-buffer te-log-buffer)
-		 (goto-char (point-max))
-		 (insert-before-markers string)
-		 (set-buffer (process-buffer process))))
-	  (setq te-pending-output (nconc te-pending-output (list string)))
-	  (te-update-pending-output-display)
-          (te-process-output (eq (current-buffer)
-                                 (window-buffer (selected-window))))
-	  (set-buffer (process-buffer process))
-	  (setq te-saved-point (point)))
-      (set-buffer obuf))))
-
-;; fucking unix has -such- braindamaged lack of tty control...
-(defun te-process-output (preemptable)
-  ;;#### There seems no good reason to ever disallow preemption
-  (setq preemptable t)
-  (catch 'te-process-output
-    (let ((buffer-read-only nil)
-	  (string nil) ostring start char (matchpos nil))
-      (while (cdr te-pending-output)
-	(setq ostring string
-	      start (car te-pending-output)
-	      string (car (cdr te-pending-output))
-	      char (aref string start))
-	(if (eq (setq start (1+ start)) (length string))
-	    (progn (setq te-pending-output
-			   (cons 0 (cdr (cdr te-pending-output)))
-			 start 0
-			 string (car (cdr te-pending-output)))
-		   (te-update-pending-output-display))
-	    (setcar te-pending-output start))
-	(if (and (> char ?\037) (< char ?\377))
-	    (cond ((eolp)
-		   ;; unread char
-		   (if (eq start 0)
-		       (setq te-pending-output
-			     (cons 0 (cons (make-string 1 char)
-					   (cdr te-pending-output))))
-		       (setcar te-pending-output (1- start)))
-		   (te-newline))
-		  ((null string)
-		   (delete-char 1) (insert char)
-                   (put-text-property (1- (point)) (point)
-                                      'face te-current-face)
-		   (te-redisplay-if-necessary 1))
-		  (t
-		   (let ((end (or (and (eq ostring string) matchpos)
-				  (setq matchpos (string-match
-						   "[\000-\037\177-\377]"
-						   string start))
-				  (length string))))
-		     (delete-char 1) (insert char)
-		     (setq char (point))
-                     (put-text-property (1- char) char 'face te-current-face)
-                     (end-of-line)
-		     (setq end (min end (+ start (- (point) char))))
-		     (goto-char char)
-		     (if (eq end matchpos) (setq matchpos nil))
-		     (delete-region (point) (+ (point) (- end start)))
-                     (setq char (point))
-		     (insert (if (and (eq start 0)
-				      (eq end (length string)))
-				 string
-			         (substring string start end)))
-                     (put-text-property char (point) 'face te-current-face)
-		     (if (eq end (length string))
-			 (setq te-pending-output
-			       (cons 0 (cdr (cdr te-pending-output))))
-		         (setcar te-pending-output end))
-		     (te-redisplay-if-necessary (1+ (- end start))))))
-	  ;; I suppose if I split the guts of this out into a separate
-	  ;;  function we could trivially emulate different terminals
-	  ;; Who cares in any case?  (Apart from stupid losers using rlogin)
-	  (funcall
-	    (if (eq char ?\^p)
-	        (or (cdr (assq (te-get-char)
-			       '((?= . te-move-to-position)
-				 (?c . te-clear-rest-of-line)
-				 (?C . te-clear-rest-of-screen)
-				 (?\C-o . te-insert-lines)
-				 (?\C-k . te-delete-lines)
-                                 (?* . te-change-attribute)
-				 ;; not necessary, but help sometimes.
-				 (?\C-a . te-beginning-of-line)
-				 (?\C-b . te-backward-char)
-				 ;; should be C-d, but un*x
-				 ;;  pty's won't send \004 through!
-                                 ;; Can you believe this?
-				 (?d . te-delete-char)
-				 (?_ . te-insert-spaces)
-				 ;; random
-				 (?\C-f . te-forward-char)
-				 (?\C-g . te-beep)
-				 (?\C-j . te-down-vertically-or-scroll)
-				 (?\C-l . te-clear-screen)
-				 )))
-		    'te-losing-unix)
-	        (or (cdr (assq char
-			       '((?\C-j . te-newline)
-				 (?\177 . te-delete)
-				 ;; Did I ask to be sent these characters?
-				 ;; I don't remember doing so, either.
-				 ;; (Perhaps some operating system or
-				 ;; other is completely incompetent...)
-				 (?\C-m . te-beginning-of-line) ;fuck me harder
-				 (?\C-g . te-beep)             ;again and again!
-				 (?\C-h . te-backward-char)     ;wa12id!!
-				 (?\C-i . te-output-tab))))     ;(spiked)
-		    'te-losing-unix)))		      ;That feels better
-	  (te-redisplay-if-necessary 1))
-	(and preemptable
-	     (input-pending-p)
-	     ;; preemptable output!  Oh my!!
-	     (throw 'te-process-output t)))))
-  ;; We must update window-point in every window displaying our buffer
-  (let* ((s (selected-window))
-	 (w s))
-    (while (not (eq s (setq w (next-window w))))
-      (if (eq (window-buffer w) (current-buffer))
-	  (set-window-point w (point))))))
-
-(defun te-get-char ()
-  (if (cdr te-pending-output)
-      (let ((start (car te-pending-output))
-	    (string (car (cdr te-pending-output))))
-	(prog1 (aref string start)
-	  (if (eq (setq start (1+ start)) (length string))
-	      (setq te-pending-output (cons 0 (cdr (cdr te-pending-output))))
-	      (setcar te-pending-output start))))
-    (catch 'char
-      (let ((filter (process-filter te-process)))
-	(unwind-protect
-	    (progn
-	      (set-process-filter te-process
-				  (function (lambda (p s)
-                                    (or (eq (length s) 1)
-                                        (setq te-pending-output (list 1 s)))
-                                    (throw 'char (aref s 0)))))
-	      (accept-process-output te-process))
-	  (set-process-filter te-process filter))))))
-
-
-(defun te-redisplay-if-necessary (length)
-  (and (<= (setq te-redisplay-count (- te-redisplay-count length)) 0)
-       (eq (current-buffer) (window-buffer (selected-window)))
-       (waiting-for-user-input-p)
-       (progn (te-update-pending-output-display)
-	      (sit-for 0)
-	      (setq te-redisplay-count terminal-redisplay-interval))))
-
-(defun te-update-pending-output-display ()
-  (if (null (cdr te-pending-output))
-      (setq te-pending-output-info "")      
-    (let ((length (te-pending-output-length)))
-      (if (< length 1500)
-	  (setq te-pending-output-info "")
-	(setq te-pending-output-info (format "(%dK chars output pending) "
-					     (/ (+ length 512) 1024))))))
-  ;; update mode line
-  (set-buffer-modified-p (buffer-modified-p)))
-
-
-(defun te-sentinel (process message)
-  (cond ((eq (process-status process) 'run))
-	((null (buffer-name (process-buffer process)))) ;deleted
-	(t (let ((b (current-buffer)))
-	     (save-excursion
-	       (set-buffer (process-buffer process))
-	       (setq buffer-read-only nil)
-	       (fundamental-mode)
-	       (goto-char (point-max))
-	       (delete-blank-lines)
-	       (delete-horizontal-space)
-	       (insert "\n*******\n" message "*******\n"))
-	     (if (and (eq b (process-buffer process))
-		      (waiting-for-user-input-p))
-		 (progn (goto-char (point-max))
-			(recenter -1)))))))
-
-(defvar te-stty-string "stty -nl erase '^?' kill '^u' intr '^c' echo pass8"
-  "Shell command to set terminal modes for terminal emulator.")
-;; This used to have `new' in it, but that loses outside BSD
-;; and it's apparently not needed in BSD.
-
-(defvar explicit-shell-file-name nil
-  "*If non-nil, is file name to use for explicitly requested inferior shell.")
-
-;;;###autoload
-(defun terminal-emulator (buffer program args &optional width height)
-  "Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS.
-ARGS is a list of argument-strings.  Remaining arguments are WIDTH and HEIGHT.
-BUFFER's contents are made an image of the display generated by that program,
-and any input typed when BUFFER is the current Emacs buffer is sent to that
-program an keyboard input.
-
-Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS
-are parsed from an input-string using your usual shell.
-WIDTH and HEIGHT are determined from the size of the current window
--- WIDTH will be one less than the window's width, HEIGHT will be its height.
-
-To switch buffers and leave the emulator, or to give commands
-to the emulator itself (as opposed to the program running under it),
-type Control-^.  The following character is an emulator command.
-Type Control-^ twice to send it to the subprogram.
-This escape character may be changed using the variable `terminal-escape-char'.
-
-`Meta' characters may not currently be sent through the terminal emulator.
-
-Here is a list of some of the variables which control the behaviour
-of the emulator -- see their documentation for more information:
-terminal-escape-char, terminal-scrolling, terminal-more-processing,
-terminal-redisplay-interval.
-
-This function calls the value of terminal-mode-hook if that exists
-and is non-nil after the terminal buffer has been set up and the
-subprocess started.
-
-Presently with `termcap' only; if somebody sends us code to make this
-work with `terminfo' we will try to use it."
-  (interactive
-    (cons (save-excursion
-	    (set-buffer (get-buffer-create "*terminal*"))
-	    (buffer-name (if (or (not (boundp 'te-process))
-				 (null te-process)
-				 (not (eq (process-status te-process)
-					  'run)))
-			     (current-buffer)
-			   (generate-new-buffer "*terminal*"))))
-	  (append
-	    (let* ((default-s
-		     ;; Default shell is same thing M-x shell uses.
-		     (or explicit-shell-file-name
-			 (getenv "ESHELL")
-			 (getenv "SHELL")
-			 "/bin/sh"))
-		   (s (read-shell-command
-		       (format "Run program in emulator: (default %s) "
-			       default-s))))
-	      (if (equal s "")
-		  (list default-s '())
-                  (te-parse-program-and-args s))))))
-  (switch-to-buffer buffer)
-  (if (null width) (setq width (- (window-width (selected-window)) 1)))
-  (if (null height) (setq height (- (window-height (selected-window)) 1)))
-  (terminal-mode)
-  (setq te-width width te-height height)
-  (setq mode-line-buffer-identification
-	(list (format "Emacs terminal %dx%d: %%b  " te-width te-height)
-	      'te-pending-output-info))
-  (let ((buffer-read-only nil))
-    (te-clear-screen))
-  (let (process)
-    (while (setq process (get-buffer-process (current-buffer)))
-      (if (y-or-n-p (format "Kill process %s? " (process-name process)))
-	  (delete-process process)
-	(error "Process %s not killed" (process-name process)))))
-  (condition-case err
-      (let ((termcap
-             ;; Because of Unix Brain Death(tm), we can't change
-             ;;  the terminal type of a running process, and so
-             ;;  terminal size and scrollability are wired-down
-             ;;  at this point.  ("Detach?  What's that?")
-             (concat (format "emacs-virtual:co#%d:li#%d:%s:km:"
-                             ;; Sigh.  These can't be dynamically changed.
-                             te-width te-height (if terminal-scrolling
-                                                    "" "ns:"))
-                     ;;-- Basic things
-                     ;; cursor-motion, bol, forward/backward char
-                     "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:"
-                     ;; newline, clear eof/eof, audible bell
-                     "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:"
-                     ;; insert/delete char/line
-                     "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :"
-                     ;;-- Not-widely-known (ie nonstandard) flags, which mean
-                     ;; o writing in the last column of the last line
-                     ;;   doesn't cause idiotic scrolling, and
-                     ;; o don't use idiotische c-s/c-q sogenannte
-                     ;;   ``flow control'' auf keinen Fall.
-                     "LP:NF:"
-                     ;;-- For stupid or obsolete programs
-                     "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p=  :"
-                     ;;-- For disgusting programs.
-                     ;; (VI? What losers need these, I wonder?)
-                     "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:"
-                     "ms:me=^p*  :"
-                     (if (face-equal 'terminal-default 'terminal-standout)
-                         "" "so=^p*+1:se=^p*+0")
-                     (if (face-equal 'terminal-default 'terminal-underline)
-                         "" "us=^p*_1:ue=^p*_0")
-                     )))
-	(if (fboundp 'start-subprocess)
-	    ;; this winning function would do everything, except that
-	    ;;  rms doesn't want it.
-	    (setq te-process (start-subprocess "terminal-emulator"
-			       program args
-			       'channel-type 'terminal
-			       'filter 'te-filter
-			       'buffer (current-buffer)
-			       'sentinel 'te-sentinel
-			       'modify-environment
-			         (list (cons "TERM" "emacs-virtual")
-				       (cons "TERMCAP" termcap))))
-	  ;; so instead we resort to this...
-	  (setq te-process
-                (let ((process-environment
-                       (cons "TERM=emacs-virtual"
-                             (cons (concat "TERMCAP=" termcap)
-                                   process-environment))))
-                  (start-process "terminal-emulator"
-                                 (current-buffer)
-                                 "/bin/sh" "-c"
-                                 ;; Yuck!!! Start a shell to set some
-                                 ;; terminal control characteristics.
-                                 ;; Then exec the program we wanted.
-                                 (format "%s; exec %s"
-                                         te-stty-string
-                                         (mapconcat 'te-quote-arg-for-sh
-                                                    (cons program args)
-                                                    " ")))))
-	  (set-process-filter te-process 'te-filter)
-	  (set-process-sentinel te-process 'te-sentinel)))
-    (error (fundamental-mode)
-	   (signal (car err) (cdr err))))
-  ;; sigh
-  (setq inhibit-quit t)			;sport death
-  (use-local-map terminal-map)
-  (run-hooks 'terminal-mode-hook)
-  (message "Entering emacs terminal-emulator...  Type %s %s for help"
-	   (single-key-description terminal-escape-char)
-	   (mapconcat 'single-key-description
-		      (where-is-internal 'te-escape-help
-					 terminal-escape-map
-					 t)
-		      " ")))
-
-
-(defun te-parse-program-and-args (s)
-  (cond ((string-match "\\`\\([a-zA-Z0-9-+=_.@/:]+[ \t]*\\)+\\'" s)
-	 (let ((l ()) (p 0))
-	   (while p
-	     (setq l (cons (if (string-match
-				"\\([a-zA-Z0-9-+=_.@/:]+\\)\\([ \t]+\\)*"
-				s p)
-			       (prog1 (substring s p (match-end 1))
-				 (setq p (match-end 0))
-				 (if (eq p (length s)) (setq p nil)))
-			       (prog1 (substring s p)
-				 (setq p nil)))
-			   l)))
-	   (setq l (nreverse l))
-	   (list (car l) (cdr l))))
-	((and (string-match "[ \t]" s) (not (file-exists-p s)))
-	 (list shell-file-name (list "-c" (concat "exec " s))))
-	(t (list s ()))))
-
-(put 'terminal-mode 'mode-class 'special)
-;; This is only separated out from function terminal-emulator
-;; to keep the latter a little more managable.
-(defun terminal-mode ()
-  "Set up variables for use of the terminal-emulator.
-One should not call this -- it is an internal function
-of the terminal-emulator"
-  (kill-all-local-variables)
-  (buffer-disable-undo (current-buffer))
-  (setq major-mode 'terminal-mode)
-  (setq mode-name "terminal")
-; (make-local-variable 'Helper-return-blurb)
-; (setq Helper-return-blurb "return to terminal simulator")
-  (setq mode-line-process '(": %s"))
-  (setq buffer-read-only t)
-  (setq truncate-lines t)
-  (make-local-variable 'terminal-escape-char)
-  (setq terminal-escape-char (default-value 'terminal-escape-char))
-  (make-local-variable 'terminal-scrolling)
-  (setq terminal-scrolling (default-value 'terminal-scrolling))
-  (make-local-variable 'terminal-more-processing)
-  (setq terminal-more-processing (default-value 'terminal-more-processing))
-  (make-local-variable 'terminal-redisplay-interval)
-  (setq terminal-redisplay-interval (default-value 'terminal-redisplay-interval))
-  (make-local-variable 'te-width)
-  (make-local-variable 'te-height)
-  (make-local-variable 'te-process)
-  (make-local-variable 'te-pending-output)
-  (setq te-pending-output (list 0))
-  (make-local-variable 'te-saved-point)
-  (setq te-saved-point (point-min))
-  (make-local-variable 'te-pending-output-info) ;for the mode line
-  (setq te-pending-output-info "")
-  (make-local-variable 'inhibit-quit)
-  ;(setq inhibit-quit t)
-  (make-local-variable 'te-log-buffer)
-  (setq te-log-buffer nil)
-  (make-local-variable 'te-more-count)
-  (setq te-more-count -1)
-  (make-local-variable 'te-redisplay-count)
-  (setq te-redisplay-count terminal-redisplay-interval)
-  (make-local-variable 'te-current-face)
-  (setq te-current-face 'terminal-default)
-  (make-local-variable 'te-current-attributes)
-  (setq te-current-attributes (list (cons 'standout nil)
-                                    (cons 'underline nil)))
-  ;(use-local-map terminal-mode-map)
-  ;; terminal-mode-hook is called above in function terminal-emulator
-  (make-local-variable 'meta-prefix-char)
-  (setq meta-prefix-char -1)            ;death to ASCII lossage
-  )
-
-;;;; what a complete loss
-
-(defun te-quote-arg-for-sh (fuckme)
-  (cond ((string-match "\\`[a-zA-Z0-9-+=_.@/:]+\\'"
-		       fuckme)
-	 fuckme)
-	((not (string-match "[$]" fuckme))
-	 ;; "[\"\\]" are special to sh and the lisp reader in the same way
-	 (prin1-to-string fuckme))
-	(t
-	 (let ((harder "")
-	       (cretin 0)
-	       (stupid 0))
-	   (while (cond ((>= cretin (length fuckme))
-			 nil)
-			;; this is the set of chars magic with "..." in `sh'
-			((setq stupid (string-match "[\"\\$]"
-						    fuckme cretin))
-			 t)
-			(t (setq harder (concat harder
-						(substring fuckme cretin)))
-			   nil))
-	     (setq harder (concat harder (substring fuckme cretin stupid)
-                                  ;; Can't use ?\\ since `concat'
-                                  ;; unfortunately does prin1-to-string
-                                  ;; on fixna.  Amazing.
-				  "\\"
-				  (substring fuckme
-					     stupid
-					     (1+ stupid)))
-		   cretin (1+ stupid)))
-	   (concat "\"" harder "\"")))))
diff --git a/xemacs-packages/lisp/os-utils/uncompress.el b/xemacs-packages/lisp/os-utils/uncompress.el
deleted file mode 100644
index ae84da39..00000000
--- a/xemacs-packages/lisp/os-utils/uncompress.el
+++ /dev/null
@@ -1,111 +0,0 @@
-;;; uncompress.el --- auto-decompression hook for visiting .Z files
-
-;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: unix extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: 20.7.
-
-;;; Commentary:
-
-;; This package can be used to arrange for automatic uncompress of
-;; compressed files when they are visited.
-;; All that's necessary is to load it.  This can conveniently be done from
-;; your .emacs file.
-
-;; M-x auto-compression-mode is a more modern replacement for this package.
-
-;;; Code:
-
-;; When we are about to make a backup file,
-;; uncompress the file we visited
-;; so that making the backup can work properly.
-;; This is used as a write-file-hook.
-
-(defvar uncompress-program "gunzip"
-  "Program to use for uncompression.")
-
-(defun uncompress-backup-file ()
-  (and buffer-file-name make-backup-files (not buffer-backed-up)
-       (not (file-exists-p buffer-file-name))
-       (call-process uncompress-program nil nil nil buffer-file-name))
-  nil)
-
-(or (assoc "\\.Z$" auto-mode-alist)
-    (setq auto-mode-alist
-	  (cons '("\\.Z$" . uncompress-while-visiting) auto-mode-alist)))
-(or (assoc "\\.gz$" auto-mode-alist)
-    (setq auto-mode-alist
-	  (cons '("\\.gz$" . uncompress-while-visiting) auto-mode-alist)))
-(or (assoc "\\.tgz$" auto-mode-alist)
-    (setq auto-mode-alist
-	  (cons '("\\.tgz$" . uncompress-while-visiting) auto-mode-alist)))
-
-(defun 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."
-  (if (and (not (null buffer-file-name))
-	   (string-match "\\.Z$" buffer-file-name))
-      (set-visited-file-name
-       (substring buffer-file-name 0 (match-beginning 0)))
-    (if (and (not (null buffer-file-name))
-	     (string-match "\\.gz$" buffer-file-name))
-	(set-visited-file-name
-	 (substring buffer-file-name 0 (match-beginning 0)))
-      (if (and (not (null buffer-file-name))
-               (string-match "\\.tgz$" buffer-file-name))
-          (set-visited-file-name
-           (concat (substring buffer-file-name 0 (match-beginning 0)) ".tar")))))
-  (message "Uncompressing...")
-  (let ((buffer-read-only nil))
-    (shell-command-on-region (point-min) (point-max) uncompress-program t))
-  (message "Uncompressing...done")
-  (set-buffer-modified-p nil)
-  (make-local-variable 'write-file-hooks)
-  (or (memq 'uncompress-backup-file write-file-hooks)
-      (setq write-file-hooks (cons 'uncompress-backup-file write-file-hooks)))
-  (normal-mode))
-
-(or (memq 'find-compressed-version find-file-not-found-hooks)
-    (setq find-file-not-found-hooks
-	  (cons 'find-compressed-version find-file-not-found-hooks)))
-
-(defun find-compressed-version ()
-  "Hook to read and uncompress the compressed version of a file."
-  ;; Just pretend we had visited the compressed file,
-  ;; and uncompress-while-visiting will do the rest.
-  (let (name)
-    (if (file-exists-p (setq name (concat buffer-file-name ".Z")))
-	(setq buffer-file-name name)
-      (if (file-exists-p (setq name (concat buffer-file-name ".gz")))
-	  (setq buffer-file-name name)))
-    (if (eq name buffer-file-name)
-	(progn
-	  (insert-file-contents buffer-file-name t)
-	  (goto-char (point-min))
-	  ;; No need for this, because error won't be set to t
-	  ;; if this function returns t.
-	  ;; (setq error nil)
-	  t))))
-
-(provide 'uncompress)
-
-;;; uncompress.el ends here
diff --git a/xemacs-packages/lisp/perl-modes/ChangeLog b/xemacs-packages/lisp/perl-modes/ChangeLog
deleted file mode 100644
index 4eeeba69..00000000
--- a/xemacs-packages/lisp/perl-modes/ChangeLog
+++ /dev/null
@@ -1,103 +0,0 @@
-2006-05-01  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.09 released.
-
-2006-04-29  Aidan Kehoe  
-
-	* cperl-mode.el (cperl-short-docs):
-	'\u' => '\\u' as it should have been in the first place. 
-	
-2005-04-27  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.08 released.
-
-2005-04-21  Malcolm Purvis  
-
-	* cperl-mode.el: Sync with upstream version 5.0.
-
-2005-02-10  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.07 released.
-
-2005-02-10  Aidan Kehoe  
-
-	* cperl-mode.el: Mark the previous changes as XEmacs-specific changes.
-
-2005-02-09  Aidan Kehoe  
-
-	* cperl-mode.el: Autoload cperl-perldoc, cperl-perldoc-at-point.
-	* cperl-mode.el (cperl-mode-map): 
-	  Bind them to C-cC-hp, C-cC-hP, respectively. 
-
-2004-08-13  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.06 released.
-
-2004-08-12  Ville Skyttä  
-
-	* cperl-mode.el: Sync with upstream version 4.35.
-
-2003-10-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.05 released.
-
-2003-03-09  Ben Wing  
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-
-2003-01-18  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.04 released.
-
-2003-01-13  Vasily Korytov  
-
-	* cperl-mode.el: Define `cperl-dark-background',
-	`cperl-dark-foreground', `cperl-nonoverridable-face',
-	`cperl-array-face' and `cperl-hash-face' on tty as well.
-
-2003-01-13  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.03 released.
-
-2003-01-06  Ville Skyttä  
-
-	* cperl-mode.el: Make auto-mode and interpreter-mode-alist
-	entries autoload-only.
-
-2002-11-29  Ben Wing  
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15  Ville Skyttä  
-
-	* Makefile (srckit): Remove.
-
-2002-10-08  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.02 released.
-
-2002-10-07  Björn Torkelsson  
-
-	* cperl-mode.el (cperl-invalid-face): fix typo
-
-2002-10-07  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.01 released.
-
-2002-09-30  Ville Skyttä  
-
-	* cperl-mode.el: Add autoloaded auto-mode-alist and
-	interpreter-mode-alist associations.
-
-2002-09-25  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.00 released.
-
-2002-09-20  Ville Skyttä  
-
-	* Package created, moved perl-mode and cperl-mode from the
-	prog-modes package here.
-
diff --git a/xemacs-packages/lisp/perl-modes/_pkg.el b/xemacs-packages/lisp/perl-modes/_pkg.el
deleted file mode 100644
index ff7f9d20..00000000
--- a/xemacs-packages/lisp/perl-modes/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'perl-modes
-		 :version 1.09
-          :author-version "No-Upstream-Ver"
-		 :type 'single-file)
diff --git a/xemacs-packages/lisp/perl-modes/auto-autoloads.el b/xemacs-packages/lisp/perl-modes/auto-autoloads.el
deleted file mode 100644
index 4998dc60..00000000
--- a/xemacs-packages/lisp/perl-modes/auto-autoloads.el
+++ /dev/null
@@ -1,193 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'perl-modes-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "perl-modes/_pkg.el")
-
-(package-provide 'perl-modes :version 1.09 :author-version "No-Upstream-Ver" :type 'single-file)
-
-;;;***
-
-;;;### (autoloads (cperl-perldoc-at-point cperl-perldoc cperl-mode) "cperl-mode" "perl-modes/cperl-mode.el")
-
-(fset 'perl-mode 'cperl-mode)
-
-(autoload 'cperl-mode "cperl-mode" "\
-Major mode for editing Perl code.
-Expression and list commands understand all C brackets.
-Tab indents for Perl code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-
-Various characters in Perl almost always come in pairs: {}, (), [],
-sometimes <>.  When the user types the first, she gets the second as
-well, with optional special formatting done on {}.  (Disabled by
-default.)  You can always quote (with \\[quoted-insert]) the left
-\"paren\" to avoid the expansion.  The processing of < is special,
-since most the time you mean \"less\".  CPerl mode tries to guess
-whether you want to type pair <>, and inserts is if it
-appropriate.  You can set `cperl-electric-parens-string' to the string that
-contains the parenths from the above list you want to be electrical.
-Electricity of parenths is controlled by `cperl-electric-parens'.
-You may also set `cperl-electric-parens-mark' to have electric parens
-look for active mark and \"embrace\" a region if possible.'
-
-CPerl mode provides expansion of the Perl control constructs:
-
-   if, else, elsif, unless, while, until, continue, do,
-   for, foreach, formy and foreachmy.
-
-and POD directives (Disabled by default, see `cperl-electric-keywords'.)
-
-The user types the keyword immediately followed by a space, which
-causes the construct to be expanded, and the point is positioned where
-she is most likely to want to be.  eg. when the user types a space
-following \"if\" the following appears in the buffer: if () { or if ()
-} { } and the cursor is between the parentheses.  The user can then
-type some boolean expression within the parens.  Having done that,
-typing \\[cperl-linefeed] places you - appropriately indented - on a
-new line between the braces (if you typed \\[cperl-linefeed] in a POD
-directive line, then appropriate number of new lines is inserted).
-
-If CPerl decides that you want to insert \"English\" style construct like
-
-            bite if angry;
-
-it will not do any expansion.  See also help on variable
-`cperl-extra-newline-before-brace'.  (Note that one can switch the
-help message on expansion by setting `cperl-message-electric-keyword'
-to nil.)
-
-\\[cperl-linefeed] is a convenience replacement for typing carriage
-return.  It places you in the next line with proper indentation, or if
-you type it inside the inline block of control construct, like
-
-            foreach (@lines) {print; print}
-
-and you are on a boundary of a statement inside braces, it will
-transform the construct into a multiline and will place you into an
-appropriately indented blank line.  If you need a usual
-`newline-and-indent' behaviour, it is on \\[newline-and-indent],
-see documentation on `cperl-electric-linefeed'.
-
-Use \\[cperl-invert-if-unless] to change a construction of the form
-
-	    if (A) { B }
-
-into
-
-            B if A;
-
-\\{cperl-mode-map}
-
-Setting the variable `cperl-font-lock' to t switches on font-lock-mode
-\(even with older Emacsen), `cperl-electric-lbrace-space' to t switches
-on electric space between $ and {, `cperl-electric-parens-string' is
-the string that contains parentheses that should be electric in CPerl
-\(see also `cperl-electric-parens-mark' and `cperl-electric-parens'),
-setting `cperl-electric-keywords' enables electric expansion of
-control structures in CPerl.  `cperl-electric-linefeed' governs which
-one of two linefeed behavior is preferable.  You can enable all these
-options simultaneously (recommended mode of use) by setting
-`cperl-hairy' to t.  In this case you can switch separate options off
-by setting them to `null'.  Note that one may undo the extra
-whitespace inserted by semis and braces in `auto-newline'-mode by
-consequent \\[cperl-electric-backspace].
-
-If your site has perl5 documentation in info format, you can use commands
-\\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it.
-These keys run commands `cperl-info-on-current-command' and
-`cperl-info-on-command', which one is which is controlled by variable
-`cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings'
-\(in turn affected by `cperl-hairy').
-
-Even if you have no info-format documentation, short one-liner-style
-help is available on \\[cperl-get-help], and one can run perldoc or
-man via menu.
-
-It is possible to show this help automatically after some idle time.
-This is regulated by variable `cperl-lazy-help-time'.  Default with
-`cperl-hairy' (if the value of `cperl-lazy-help-time' is nil) is 5
-secs idle time .  It is also possible to switch this on/off from the
-menu, or via \\[cperl-toggle-autohelp].  Requires `run-with-idle-timer'.
-
-Use \\[cperl-lineup] to vertically lineup some construction - put the
-beginning of the region at the start of construction, and make region
-span the needed amount of lines.
-
-Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
-`cperl-pod-face', `cperl-pod-head-face' control processing of POD and
-here-docs sections.  With capable Emaxen results of scan are used
-for indentation too, otherwise they are used for highlighting only.
-
-Variables controlling indentation style:
- `cperl-tab-always-indent'
-    Non-nil means TAB in CPerl mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- `cperl-indent-left-aligned-comments'
-    Non-nil means that the comment starting in leftmost column should indent.
- `cperl-auto-newline'
-    Non-nil means automatically newline before and after braces,
-    and after colons and semicolons, inserted in Perl code.  The following
-    \\[cperl-electric-backspace] will remove the inserted whitespace.
-    Insertion after colons requires both this variable and
-    `cperl-auto-newline-after-colon' set.
- `cperl-auto-newline-after-colon'
-    Non-nil means automatically newline even after colons.
-    Subject to `cperl-auto-newline' setting.
- `cperl-indent-level'
-    Indentation of Perl statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- `cperl-continued-statement-offset'
-    Extra indentation given to a substatement, such as the
-    then-clause of an if, or body of a while, or just a statement continuation.
- `cperl-continued-brace-offset'
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to `cperl-continued-statement-offset'.
- `cperl-brace-offset'
-    Extra indentation for line if it starts with an open brace.
- `cperl-brace-imaginary-offset'
-    An open brace following other text is treated as if it the line started
-    this far to the right of the actual line indentation.
- `cperl-label-offset'
-    Extra indentation for line that is a label.
- `cperl-min-label-indent'
-    Minimal indentation for line that is a label.
-
-Settings for K&R and BSD indentation styles are
-  `cperl-indent-level'                5    8
-  `cperl-continued-statement-offset'  5    8
-  `cperl-brace-offset'               -5   -8
-  `cperl-label-offset'               -5   -8
-
-CPerl knows several indentation styles, and may bulk set the
-corresponding variables.  Use \\[cperl-set-style] to do this.  Use
-\\[cperl-set-style-back] to restore the memorized preexisting values
-\(both available from menu).
-
-If `cperl-indent-level' is 0, the statement after opening brace in
-column 0 is indented on
-`cperl-brace-offset'+`cperl-continued-statement-offset'.
-
-Turning on CPerl mode calls the hooks in the variable `cperl-mode-hook'
-with no args.
-
-DO NOT FORGET to read micro-docs (available from `Perl' menu)
-or as help on variables `cperl-tips', `cperl-problems',
-`cperl-non-problems', `cperl-praise', `cperl-speed'." t nil)
-
-(autoload 'cperl-perldoc "cperl-mode" "\
-Run `perldoc' on WORD." t nil)
-
-(autoload 'cperl-perldoc-at-point "cperl-mode" "\
-Run a `perldoc' on the word around point." t nil)
-(add-to-list 'auto-mode-alist '("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode))
-(add-to-list 'interpreter-mode-alist '("perl" . perl-mode))
-
-;;;***
-
-;;;### (autoloads nil "perl-mode" "perl-modes/perl-mode.el")
-
-;;;***
-
-(provide 'perl-modes-autoloads)
diff --git a/xemacs-packages/lisp/perl-modes/cperl-mode.el b/xemacs-packages/lisp/perl-modes/cperl-mode.el
deleted file mode 100644
index bd64585a..00000000
--- a/xemacs-packages/lisp/perl-modes/cperl-mode.el
+++ /dev/null
@@ -1,8578 +0,0 @@
-;;; cperl-mode.el --- Perl code editing commands for XEmacs
-
-;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2003
-;;     Free Software Foundation, Inc.
-
-;; Author: Ilya Zakharevich and Bob Olson
-;; Maintainer: XEmacs Development Team 
-;; Keywords: languages, Perl
-
-;; This file is part of GNU Emacs.
-
-;;; This code started from the following message of long time ago
-;;; (IZ), but Bob does not maintain this mode any more:
-
-;;; From: olson@mcs.anl.gov (Bob Olson)
-;;; Newsgroups: comp.lang.perl
-;;; Subject: cperl-mode: Another perl mode for Gnuemacs
-;;; Date: 14 Aug 91 15:20:01 GMT
-
-;; Copyright (C) Ilya Zakharevich and Bob Olson
-
-;; This file may be distributed
-;; either under the same terms as GNU Emacs, or under the same terms
-;; as Perl. You should have received a copy of Perl Artistic license
-;; along with the Perl distribution.
-
-;; 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.
-
-;;; Corrections made by Ilya Zakharevich cperl@ilyaz.org
-;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
-;;; XEmacs 'delete key behavior handling added for XEmacs 20.x by
-;;; Gary D. Foster 
-;;; Karl M. Hegbloom 
-
-;;; Commentary:
-
-;; $Id: cperl-mode.el,v 5.0 2003/02/17 01:33:20 vera Exp vera $
-
-;;; If your Emacs does not default to `cperl-mode' on Perl files:
-;;; To use this mode put the following into
-;;; your .emacs file:
-
-;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t)
-
-;; You can either fine-tune the bells and whistles of this mode or
-;; bulk enable them by putting
-
-;; (setq cperl-hairy t)
-
-;; in your .emacs file.  (Emacs rulers do not consider it politically
-;; correct to make whistles enabled by default.)
-
-;; DO NOT FORGET to read micro-docs (available from `Perl' menu)   <<<<<<
-;; or as help on variables `cperl-tips', `cperl-problems',         <<<<<<
-;; `cperl-non-problems', `cperl-praise', `cperl-speed'.            <<<<<<
-
-;; Additional useful commands to put into your .emacs file (before
-;; Emacs 20.3):
-
-;; (setq auto-mode-alist
-;;      (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode))  auto-mode-alist ))
-;; (setq interpreter-mode-alist (append interpreter-mode-alist
-;; 				        '(("miniperl" . perl-mode))))
-
-;; The mode information (on C-h m) provides some customization help.
-;; If you use font-lock feature of this mode, it is advisable to use
-;; either lazy-lock-mode or fast-lock-mode.  I prefer lazy-lock.
-
-;; Faces used now: three faces for first-class and second-class keywords
-;; and control flow words, one for each: comments, string, labels,
-;; functions definitions and packages, arrays, hashes, and variable
-;; definitions.  If you do not see all these faces, your font-lock does
-;; not define them, so you need to define them manually.
-;; Maybe you have an obsolete font-lock from 19.28 or earlier.  Upgrade.
-
-;; If you have a grayscale monitor, and do not have the variable
-;; font-lock-display-type bound to 'grayscale, insert
-
-;; (setq font-lock-display-type 'grayscale)
-
-;; into your .emacs file (this is relevant before Emacs 20).
-
-;; This mode supports font-lock, imenu and mode-compile.  In the
-;; hairy version font-lock is on, but you should activate imenu
-;; yourself (note that mode-compile is not standard yet).  Well, you
-;; can use imenu from keyboard anyway (M-x imenu), but it is better
-;; to bind it like that:
-
-;; (define-key global-map [M-S-down-mouse-3] 'imenu)
-
-;;; Font lock bugs as of v4.32:
-
-;; The following kinds of Perl code erroneously start strings:
-;; \$`  \$'  \$"
-;; $opt::s  $opt_s  $opt{s}  (s => ...)  /\s+.../
-;; likewise with m, tr, y, q, qX instead of s
-
-;;; In fact the version of font-lock that this version supports can be
-;;; much newer than the version you actually have. This means that a
-;;; lot of faces can be set up, but are not visible on your screen
-;;; since the coloring rules for this faces are not defined.
-
-;;; Updates: ========================================
-
-;;; Made less hairy by default: parentheses not electric,
-;;; linefeed not magic. Bug with abbrev-mode corrected.
-
-;;;; After 1.4:
-;;;  Better indentation:
-;;;  subs inside braces should work now,
-;;;  Toplevel braces obey customization.
-;;;  indent-for-comment knows about bad cases, cperl-indent-for-comment
-;;;  moves cursor to a correct place.
-;;;  cperl-indent-exp written from the scratch! Slow... (quadratic!) :-(
-;;;        (50 secs on DB::DB (sub of 430 lines), 486/66)
-;;;  Minor documentation fixes.
-;;;  Imenu understands packages as prefixes (including nested).
-;;;  Hairy options can be switched off one-by-one by setting to null.
-;;;  Names of functions and variables changed to conform to `cperl-' style.
-
-;;;; After 1.5:
-;;;  Some bugs with indentation of labels (and embedded subs) corrected.
-;;;  `cperl-indent-region' done (slow :-()).
-;;;  `cperl-fill-paragraph' done.
-;;;  Better package support for `imenu'.
-;;;  Progress indicator for indentation (with `imenu' loaded).
-;;;  `Cperl-set' was busted, now setting the individual hairy option
-;;;     should be better.
-
-;;;; After 1.6:
-;;; `cperl-set-style' done.
-;;; `cperl-check-syntax' done.
-;;; Menu done.
-;;; New config variables `cperl-close-paren-offset' and `cperl-comment-column'.
-;;; Bugs with `cperl-auto-newline' corrected.
-;;; `cperl-electric-lbrace' can work with `cperl-auto-newline' in situation
-;;; like $hash{.
-
-;;;; 1.7 XEmacs (arius@informatik.uni-erlangen.de):
-;;; - use `next-command-event', if `next-command-events' does not exist
-;;; - use `find-face' as def. of `is-face'
-;;; - corrected def. of `x-color-defined-p'
-;;; - added const defs for font-lock-comment-face,
-;;;   font-lock-keyword-face and font-lock-function-name-face
-;;; - added def. of font-lock-variable-name-face
-;;; - added (require 'easymenu) inside an `eval-when-compile'
-;;; - replaced 4-argument `substitute-key-definition' with ordinary
-;;;   `define-key's
-;;; - replaced `mark-active' in menu definition by `cperl-use-region-p'.
-;;; Todo (at least):
-;;; - use emacs-vers.el (http://www.cs.utah.edu/~eeide/emacs/emacs-vers.el.gz)
-;;;   for portable code?
-;;; - should `cperl-mode' do a
-;;;	(if (featurep 'easymenu) (easy-menu-add cperl-menu))
-;;;   or should this be left to the user's `cperl-mode-hook'?
-
-;;; Some bugs introduced by the above fix corrected (IZ ;-).
-;;; Some bugs under XEmacs introduced by the correction corrected.
-
-;;; Some more can remain since there are two many different variants.
-;;; Please feedback!
-
-;;; We do not support fontification of arrays and hashes under
-;;; obsolete font-lock any more. Upgrade.
-
-;;;; after 1.8 Minor bug with parentheses.
-;;;; after 1.9 Improvements from Joe Marzot.
-;;;; after 1.10
-;;;  Does not need easymenu to compile under XEmacs.
-;;;  `vc-insert-headers' should work better.
-;;;  Should work with 19.29 and 19.12.
-;;;  Small improvements to fontification.
-;;;  Expansion of keywords does not depend on C-? being backspace.
-
-;;; after 1.10+
-;;; 19.29 and 19.12 supported.
-;;; `cperl-font-lock-enhanced' deprecated. Use font-lock-extra.el.
-;;; Support for font-lock-extra.el.
-
-;;;; After 1.11:
-;;; Tools submenu.
-;;; Support for perl5-info.
-;;; `imenu-go-find-at-position' in Tools requires imenu-go.el (see hints above)
-;;; Imenu entries do not work with stock imenu.el. Patch sent to maintainers.
-;;; Fontifies `require a if b;', __DATA__.
-;;; Arglist for auto-fill-mode was incorrect.
-
-;;;; After 1.12:
-;;; `cperl-lineup-step' and `cperl-lineup' added: lineup constructions
-;;; vertically.
-;;; `cperl-do-auto-fill' updated for 19.29 style.
-;;; `cperl-info-on-command' now has a default.
-;;; Workaround for broken C-h on XEmacs.
-;;; VC strings escaped.
-;;; C-h f now may prompt for function name instead of going on,
-;;; controlled by `cperl-info-on-command-no-prompt'.
-
-;;;; After 1.13:
-;;; Msb buffer list includes perl files
-;;; Indent-for-comment uses indent-to
-;;; Can write tag files using etags.
-
-;;;; After 1.14:
-;;; Recognizes (tries to ;-) {...} which are not blocks during indentation.
-;;; `cperl-close-paren-offset' affects ?\] too (and ?\} if not block)
-;;; Bug with auto-filling comments started with "##" corrected.
-
-;;;; Very slow now: on DB::DB 0.91, 486/66:
-
-;;;Function Name                             Call Count  Elapsed Time  Average Time
-;;;========================================  ==========  ============  ============
-;;;cperl-block-p                             469         3.7799999999  0.0080597014
-;;;cperl-get-state                           505         163.39000000  0.3235445544
-;;;cperl-comment-indent                      12          0.0299999999  0.0024999999
-;;;cperl-backward-to-noncomment              939         4.4599999999  0.0047497337
-;;;cperl-calculate-indent                    505         172.22000000  0.3410297029
-;;;cperl-indent-line                         505         172.88000000  0.3423366336
-;;;cperl-use-region-p                        40          0.0299999999  0.0007499999
-;;;cperl-indent-exp                          1           177.97000000  177.97000000
-;;;cperl-to-comment-or-eol                   1453        3.9800000000  0.0027391603
-;;;cperl-backward-to-start-of-continued-exp  9           0.0300000000  0.0033333333
-;;;cperl-indent-region                       1           177.94000000  177.94000000
-
-;;;; After 1.15:
-;;; Takes into account white space after opening parentheses during indent.
-;;; May highlight pods and here-documents: see `cperl-pod-here-scan',
-;;; `cperl-pod-here-fontify', `cperl-pod-face'. Does not use this info
-;;; for indentation so far.
-;;; Fontification updated to 19.30 style.
-;;; The change 19.29->30 did not add all the required functionality,
-;;;     but broke "font-lock-extra.el". Get "choose-color.el" from
-;;;       ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs
-
-;;;; After 1.16:
-;;;       else # comment
-;;;    recognized as a start of a block.
-;;;  Two different font-lock-levels provided.
-;;;  `cperl-pod-head-face' introduced. Used for highlighting.
-;;;  `imenu' marks pods, +Packages moved to the head.
-
-;;;; After 1.17:
-;;;  Scan for pods highlights here-docs too.
-;;;  Note that the tag of here-doc may be rehighlighted later by lazy-lock.
-;;;  Only one here-doc-tag per line is supported, and one in comment
-;;;  or a string may break fontification.
-;;;  POD headers were supposed to fill one line only.
-
-;;;; After 1.18:
-;;;  `font-lock-keywords' were set in 19.30 style _always_. Current scheme
-;;;    may  break under XEmacs.
-;;;  `cperl-calculate-indent' dis suppose that `parse-start' was defined.
-;;;  `fontified' tag is added to fontified text as well as `lazy-lock' (for
-;;;    compatibility with older lazy-lock.el) (older one overfontifies
-;;;    something nevertheless :-().
-;;;  Will not indent something inside pod and here-documents.
-;;;  Fontifies the package name after import/no/bootstrap.
-;;;  Added new entry to menu with meta-info about the mode.
-
-;;;; After 1.19:
-;;;  Prefontification works much better with 19.29. Should be checked
-;;;   with 19.30 as well.
-;;;  Some misprints in docs corrected.
-;;;  Now $a{-text} and -text => "blah" are fontified as strings too.
-;;;  Now the pod search is much stricter, so it can help you to find
-;;;    pod sections which are broken because of whitespace before =blah
-;;;    - just observe the fontification.
-
-;;;; After 1.20
-;;;  Anonymous subs are indented with respect to the level of
-;;;    indentation of `sub' now.
-;;;  {} is recognized as hash after `bless' and `return'.
-;;;  Anonymous subs are split by `cperl-linefeed' as well.
-;;;  Electric parens embrace a region if present.
-;;;  To make `cperl-auto-newline' useful,
-;;;    `cperl-auto-newline-after-colon' is introduced.
-;;;  `cperl-electric-parens' is now t or nul. The old meaning is moved to
-;;;  `cperl-electric-parens-string'.
-;;;  `cperl-toggle-auto-newline' introduced, put on C-c C-a.
-;;;  `cperl-toggle-abbrev' introduced, put on C-c C-k.
-;;;  `cperl-toggle-electric' introduced, put on C-c C-e.
-;;;  Beginning-of-defun-regexp was not anchored.
-
-;;;; After 1.21
-;;;  Auto-newline grants `cperl-extra-newline-before-brace' if "{" is typed
-;;;    after ")".
-;;;  {} is recognized as expression after `tr' and friends.
-
-;;;; After 1.22
-;;;  Entry Hierarchy added to imenu. Very primitive so far.
-;;;  One needs newer `imenu-go'.el. A patch to `imenu' is needed as well.
-;;;  Writes its own TAGS files.
-;;;  Class viewer based on TAGS files. Does not trace @ISA so far.
-;;;  19.31: Problems with scan for PODs corrected.
-;;;  First POD header correctly fontified.
-;;;  I needed (setq imenu-use-keymap-menu t) to get good imenu in 19.31.
-;;;  Apparently it makes a lot of hierarchy code obsolete...
-
-;;;; After 1.23
-;;;  Tags filler now scans *.xs as well.
-;;;  The info from *.xs scan is used by the hierarchy viewer.
-;;;  Hierarchy viewer documented.
-;;;  Bug in 19.31 imenu documented.
-
-;;;; After 1.24
-;;;  New location for info-files mentioned,
-;;;  Electric-; should work better.
-;;;  Minor bugs with POD marking.
-
-;;;; After 1.25 (probably not...)
-;;;  `cperl-info-page' introduced.
-;;;  To make `uncomment-region' working, `comment-region' would
-;;;  not insert extra space.
-;;;  Here documents delimiters better recognized
-;;;  (empty one, and non-alphanums in quotes handled). May be wrong with 1<<14?
-;;;  `cperl-db' added, used in menu.
-;;;  imenu scan removes text-properties, for better debugging
-;;;    - but the bug is in 19.31 imenu.
-;;;  formats highlighted by font-lock and prescan, embedded comments
-;;;  are not treated.
-;;;  POD/friends scan merged in one pass.
-;;;  Syntax class is not used for analyzing the code, only char-syntax
-;;;  may be checked against _ or'ed with w.
-;;;  Syntax class of `:' changed to be _.
-;;;  `cperl-find-bad-style' added.
-
-;;;; After 1.25
-;;;  When search for here-documents, we ignore commented << in simplest cases.
-;;;  `cperl-get-help' added, available on C-h v and from menu.
-;;;  Auto-help added. Default with `cperl-hairy', switchable on/off
-;;;   with startup variable `cperl-lazy-help-time' and from
-;;;   menu. Requires `run-with-idle-timer'.
-;;;  Highlighting of @abc{@efg} was wrong - interchanged two regexps.
-
-;;;; After 1.27
-;;;  Indentation: At toplevel after a label - fixed.
-;;;  1.27 was put to archives in binary mode ===> DOSish :-(
-
-;;;; After 1.28
-;;;  Thanks to Martin Buchholz : misprints in
-;;;  comments and docstrings corrected, XEmacs support cleaned up.
-;;;  The closing parenths would enclose the region into matching
-;;;  parens under the same conditions as the opening ones.
-;;;  Minor updates to `cperl-short-docs'.
-;;;  Will not consider <<= as start of here-doc.
-
-;;;; After 1.29
-;;;  Added an extra advice to look into Micro-docs. ;-).
-;;;  Enclosing of region when you press a closing parenth is regulated by
-;;;  `cperl-electric-parens-string'.
-;;;  Minor updates to `cperl-short-docs'.
-;;;  `initialize-new-tags-table' called only if present (Does this help
-;;;     with generation of tags under XEmacs?).
-;;;  When creating/updating tag files, new info is written at the old place,
-;;;     or at the end (is this a wanted behaviour? I need this in perl build directory).
-
-;;;; After 1.30
-;;;  All the keywords from keywords.pl included (maybe with dummy explanation).
-;;;  No auto-help inside strings, comment, here-docs, formats, and pods.
-;;;  Shrinkwrapping of info, regulated by `cperl-max-help-size',
-;;;  `cperl-shrink-wrap-info-frame'.
-;;;  Info on variables as well.
-;;;  Recognision of HERE-DOCS improved yet more.
-;;;  Autonewline works on `}' without warnings.
-;;;  Autohelp works again on $_[0].
-
-;;;; After 1.31
-;;;  perl-descr.el found its author - hi, Johan!
-;;;  Some support for correct indent after here-docs and friends (may
-;;;  be superseeded by eminent change to Emacs internals).
-;;;  Should work with older Emaxen as well ( `-style stuff removed).
-
-;;;; After 1.32
-
-;;;  Started to add support for `syntax-table' property (should work
-;;;  with patched Emaxen), controlled by
-;;;  `cperl-use-syntax-table-text-property'. Currently recognized:
-;;;    All quote-like operators: m, s, y, tr, qq, qw, qx, q,
-;;;    // in most frequent context:
-;;;          after block or
-;;;                    ~ { ( = | & + - * ! , ;
-;;;          or
-;;;                    while if unless until and or not xor split grep map
-;;;    Here-documents, formats, PODs,
-;;;    ${...}
-;;;    'abc$'
-;;;    sub a ($); sub a ($) {}
-;;;  (provide 'cperl-mode) was missing!
-;;;  `cperl-after-expr-p' is now much smarter after `}'.
-;;;  `cperl-praise' added to mini-docs.
-;;;  Utilities try to support subs-with-prototypes.
-
-;;;; After 1.32.1
-;;;  `cperl-after-expr-p' is now much smarter after "() {}" and "word {}":
-;;;     if word is "else, map, grep".
-;;;  Updated for new values of syntax-table constants.
-;;;  Uses `help-char' (at last!) (disabled, does not work?!)
-;;;  A couple of regexps where missing _ in character classes.
-;;;  -s could be considered as start of regexp, 1../blah/ was not,
-;;;  as was not /blah/ at start of file.
-
-;;;; After 1.32.2
-;;;  "\C-hv" was wrongly "\C-hf"
-;;;  C-hv was not working on `[index()]' because of [] in skip-chars-*.
-;;;  `__PACKAGE__' supported.
-;;;  Thanks for Greg Badros: `cperl-lazy-unstall' is more complete,
-;;;  `cperl-get-help' is made compatible with `query-replace'.
-
-;;;; As of Apr 15, development version of 19.34 supports
-;;;; `syntax-table' text properties. Try setting
-;;;; `cperl-use-syntax-table-text-property'.
-
-;;;; After 1.32.3
-;;;  We scan for s{}[] as well (in simplest situations).
-;;;  We scan for $blah'foo as well.
-;;;  The default is to use `syntax-table' text property if Emacs is good enough.
-;;;  `cperl-lineup' is put on C-M-| (=C-M-S-\\).
-;;;  Start of `cperl-beautify-regexp'.
-
-;;;; After 1.32.4
-;;; `cperl-tags-hier-init' did not work in text-mode.
-;;; `cperl-noscan-files-regexp' had a misprint.
-;;; Generation of Class Hierarchy was broken due to a bug in `x-popup-menu'
-;;;  in 19.34.
-
-;;;; After 1.33:
-;;; my,local highlight vars after {} too.
-;;; TAGS could not be created before imenu was loaded.
-;;; `cperl-indent-left-aligned-comments' created.
-;;; Logic of `cperl-indent-exp' changed a little bit, should be more
-;;;  robust w.r.t. multiline strings.
-;;; Recognition of blah'foo takes into account strings.
-;;; Added '.al' to the list of Perl extensions.
-;;; Class hierarchy is "mostly" sorted (need to rethink algorthm
-;;;  of pruning one-root-branch subtrees to get yet better sorting.)
-;;; Regeneration of TAGS was busted.
-;;; Can use `syntax-table' property when generating TAGS
-;;;  (governed by  `cperl-use-syntax-table-text-property-for-tags').
-
-;;;; After 1.35:
-;;; Can process several =pod/=cut sections one after another.
-;;; Knows of `extproc' when under `emx', indents with `__END__' and `__DATA__'.
-;;; `cperl-under-as-char' implemented (XEmacs people like broken behaviour).
-;;; Beautifier for regexps fixed.
-;;; `cperl-beautify-level', `cperl-contract-level' coded
-;;;
-;;;; Emacs's 20.2 problems:
-;;; `imenu.el' has bugs, `imenu-add-to-menubar' does not work.
-;;; Couple of others problems with 20.2 were reported, my ability to check/fix
-;;; them is very reduced now.
-
-;;;; After 1.36:
-;;;  'C-M-|' in XEmacs fixed
-
-;;;; After 1.37:
-;;;  &&s was not recognized as start of regular expression;
-;;;  Will "preprocess" the contents of //e part of s///e too;
-;;;  What to do with s# blah # foo #e ?
-;;;  Should handle s;blah;foo;; better.
-;;;  Now the only known problems with regular expression recognition:
-;;;;;;;  s/bar/	- different delimiters (end ignored)
-;;;;;;;  s/foo/\\bar/	- backslash at start of subst (made into one chunk)
-;;;;;;;  s/foo//	- empty subst (made into one chunk + '/')
-;;;;;;;  s/foo/(bar)/	- start-group at start of subst (internal group will not match backwards)
-
-;;;; After 1.38:
-;;;  We highlight closing / of s/blah/foo/e;
-;;;  This handles s# blah # foo #e too;
-;;;  s//blah/, s///, s/blah// works again, and s#blah## too, the algorithm
-;;;   is much simpler now;
-;;;  Next round of changes: s\\\ works, s/foo/,
-;;;   comments between the first and the second part allowed
-;;;  Another problem discovered:
-;;;;;;;  s[foo] e	- e part delimited by different <> (will not match)
-;;;  `cperl-find-pods-heres' somehow maybe called when string-face is undefined
-;;;   - put a stupid workaround for 20.1
-
-;;;; After 1.39:
-;;;  Could indent here-docs for comments;
-;;;  These problems fixed:
-;;;;;;;  s/foo/\\bar/	- backslash at start of subst (made into two chunk)
-;;;;;;;  s[foo] e	- "e" part delimited by "different" <> (will match)
-;;;  Matching brackets honor prefices, may expand abbreviations;
-;;;  When expanding abbrevs, will remove last char only after
-;;;    self-inserted whitespace;
-;;;  More convenient "Refress hard constructs" in menu;
-;;;  `cperl-add-tags-recurse', `cperl-add-tags-recurse-noxs'
-;;;    added (for -batch mode);
-;;;  Better handling of errors when scanning for Perl constructs;
-;;;;;;;  Possible "problem" with class hierarchy in Perl distribution
-;;;;;;;    directory: ./ext duplicates ./lib;
-;;;  Write relative paths for generated TAGS;
-
-;;;; After 1.40:
-;;;  s  /// may be separated by "\n\f" too;
-;;;  `s  #blah' recognized as a comment;
-;;;  Would highlight s/abc//s wrong;
-;;;  Debugging code in `cperl-electric-keywords' was leaking a message;
-
-;;;; After 1.41:
-;;;  XEmacs: added 'pod-spell' and 'make-pod-list'
-;;;  XEmacs: Two functions used to run ispell only on pod/here regions
-;;;  RMS changes for 20.3 merged
-
-;;;; 2.0.1.0: RMS mode (has 3 misprints)
-
-;;;; After 2.0:
-;;;  RMS whitespace changes for 20.3 merged
-
-;;;; After 2.1:
-;;;  History updated
-
-;;;; After 2.2:
-;;;  Merge `c-style-alist' since `c-mode' is no more.  (Somebody who
-;;;    uses the styles should check that they work OK!)
-;;;  All the variable warnings go away, some undef functions too.
-
-;;;; After 2.3:
-;;;  Added `cperl-perldoc' (thanks to Anthony Foiani )
-;;;  Added `cperl-pod-to-manpage' (thanks to Nick Roberts )
-;;;  All the function warnings go away.
-
-;;;; After 2.4:
-;;;  `Perl doc', `Regexp' submenus created (latter to allow short displays).
-;;;  `cperl-clobber-lisp-bindings' added.
-;;;  $a->y() is not y///.
-;;;  `cperl-after-block-p' was missing a `save-excursion' => wrong results.
-;;;  `cperl-val' was defined too late.
-;;;  `cperl-init-faces' was failing.
-;;;  Init faces when loading `ps-print'.
-
-;;;; After 2.4:
-;;;  `cperl-toggle-autohelp' implemented.
-;;;  `while SPACE LESS' was buggy.
-;;;  `-text' in `[-text => 1]' was not highlighted.
-;;;  `cperl-after-block-p' was FALSE after `sub f {}'.
-
-;;;; After 2.5:
-;;;  `foreachmy', `formy' expanded too.
-;;;  Expand `=pod-directive'.
-;;;  `cperl-linefeed' behaves reasonable in POD-directive lines.
-;;;  `cperl-electric-keyword' prints a message, governed by
-;;;    `cperl-message-electric-keyword'.
-
-;;;; After 2.6:
-;;;  Typing `}' was not checking for being block or not.
-;;;  Beautifying levels in RE: Did not know about lookbehind;
-;;;			       finding *which* level was not intuitive;
-;;;			       `cperl-beautify-levels' added.
-;;;  Allow here-docs contain `=head1' and friends (at least for keywords).
-
-;;;; After 2.7:
-;;;  Fix for broken `font-lock-unfontify-region-function'.  Should
-;;;    preserve `syntax-table' properties even with `lazy-lock'.
-
-;;;; After 2.8:
-;;;  Some more compile time warnings crept in.
-;;;  `cperl-indent-region-fix-else' implemented.
-;;;  `cperl-fix-line-spacing' implemented.
-;;;  `cperl-invert-if-unless' implemented (C-c C-t and in Menu).
-;;;  Upgraded hints to mention 20.2's goods/bads.
-;;;  Started to use `cperl-extra-newline-before-brace-multiline',
-;;;    `cperl-break-one-line-blocks-when-indent',
-;;;    `cperl-fix-hanging-brace-when-indent', `cperl-merge-trailing-else'.
-
-;;;; After 2.9:
-;;;  Workaround for another `font-lock's `syntax-table' text-property bug.
-;;;  `zerop' could be applied to nil.
-;;;  At last, may work with `font-lock' without setting `cperl-font-lock'.
-;;;    (We expect that starting from 19.33, `font-lock' supports keywords
-;;;     being a function - what is a correct version?)
-;;;  Rename `cperl-indent-region-fix-else' to
-;;;    `cperl-indent-region-fix-constructs'.
-;;;  `cperl-fix-line-spacing' could be triggered inside strings, would not
-;;;     know what to do with BLOCKs of map/printf/etc.
-;;;  `cperl-merge-trailing-else' and `cperl-fix-line-spacing' handle
-;;;     `continue' too.
-;;;  Indentation after {BLOCK} knows about map/printf/etc.
-;;;  Finally: treat after-comma lines as continuation lines.
-
-;;;; After 2.10:
-;;;  `continue' made electric.
-;;;  Electric `do' inserts `do/while'.
-;;;  Some extra compile-time warnings crept in.
-;;;  `font-lock' of 19.33 could not handle font-lock-keywords being a function
-;;;      returning a symbol.
-
-;;;; After 2.11:
-;;;  Changes to make syntaxification to be autoredone via `font-lock'.
-;;;    Switched on by `cperl-syntaxify-by-font-lock', off by default so far.
-
-;;;; After 2.12:
-;;;  Remove some commented out chunks.
-;;;  Styles are slightly updated (a lot of work is needed, especially
-;;;    with new `cperl-fix-line-spacing').
-
-;;;; After 2.13:
-;;;  Old value of style is memorized when choosing a new style, may be
-;;;    restored from the same menu.
-;;;  Mode-documentation added to micro-docs.
-;;;  `cperl-praise' updated.
-;;;  `cperl-toggle-construct-fix' added on C-c C-w and menu.
-;;;  `auto-fill-mode' added on C-c C-f and menu.
-;;;  `PerlStyle' style added.
-;;;  Message for termination of scan corrected.
-
-;;;; After 2.14:
-
-;;;  Did not work with -q
-
-;;;; After 2.15:
-
-;;;  `cperl-speed' hints added.
-;;;  Minor style fixes.
-
-;;;; After 2.15:
-;;;  Make backspace electric after expansion of `else/continue' too.
-
-;;;; After 2.16:
-;;;  Starting to merge changes to RMS emacs version.
-
-;;;; After 2.17:
-;;;  Merged custom stuff and darn `font-lock-constant-face'.
-
-;;;; After 2.18:
-;;;  Bumped the version to 3.1
-
-;;;; After 3.1:
-;;;  Fixed customization to honor cperl-hairy.
-;;;  Created customization groups.  Sent to RMS to include into 2.3.
-
-;;;; After 3.2:
-;;;  Interaction of `font-lock-hot-pass' and `cperl-syntaxify-by-font-lock'.
-;;;  (`cperl-after-block-and-statement-beg'):
-;;;  (`cperl-after-block-p'):
-;;;  (`cperl-after-expr-p'):	It is BLOCK if we reach lim when backup sexp.
-;;;  (`cperl-indent-region'):	Make a marker for END - text added/removed.
-;;;  (`cperl-style-alist', `cperl-styles-entries')
-;;;		Include `cperl-merge-trailing-else' where the value is clear.
-
-;;;; After 3.3:
-;;;  (`cperl-tips'):
-;;;  (`cperl-problems'):	Improvements to docs.
-
-;;;; After 3.4:
-;;;  (`cperl-mode'):		Make lazy syntaxification possible.
-;;;  (`cperl-find-pods-heres'): Safe a position in buffer where it is safe to
-;;;				restart syntaxification.
-;;;  (`cperl-syntaxify-by-font-lock'): Set to t, should be safe now.
-
-;;;; After 3.5:
-;;;  (`cperl-syntaxify-by-font-lock'): Better default, customizes to
-;;;				`message' too.
-
-;;;; After 3.6:
-;;;  (`cperl-find-pods-heres'): changed so that -d ?foo? is a RE.
-;;;  (`cperl-array-face'): changed name from `font-lock-emphasized-face'.
-;;;  (`cperl-hash-face'): changed name from  `font-lock-other-emphasized-face'.
-;;;  Use `defface' to define these two extra faces.
-
-;;;; After 3.7:
-;;;  Can use linear algorithm for indentation if Emacs supports it:
-;;;  indenting DB::DB (800+ lines) improved from 69 sec to 11 sec
-;;;  (73 vs 15 with imenu).
-;;;  (`cperl-emacs-can-parse'):	New state.
-;;;  (`cperl-indent-line'):	Corrected to use global state.
-;;;  (`cperl-calculate-indent'):	Likewise.
-;;;  (`cperl-fix-line-spacing'):	Likewise (not used yet).
-
-;;;; After 3.8:
-;;;  (`cperl-choose-color'):	Converted to a function (to be compilable in text-mode).
-
-;;;; After 3.9:
-;;;  (`cperl-dark-background '):	Disable without window-system.
-
-;;;; After 3.10:
-;;;  Do `defface' only if window-system.
-
-;;;; After 3.11:
-;;;  (`cperl-fix-line-spacing'):	sped up to bail out early.
-;;;  (`cperl-indent-region'):	Disable hooks during the call (how to call them later?).
-
-;;;  Now indents 820-line-long function in 6.5 sec (including syntaxification) the first time
-;;;  (when buffer has few properties), 7.1 sec the second time.
-
-;;;Function Name                              Call Count  Elapsed Time  Average Time
-;;;=========================================  ==========  ============  ============
-;;;cperl-indent-exp                           1           10.039999999  10.039999999
-;;;cperl-indent-region                        1           10.0          10.0
-;;;cperl-indent-line                          821         6.2100000000  0.0075639464
-;;;cperl-calculate-indent                     821         5.0199999999  0.0061144945
-;;;cperl-backward-to-noncomment               2856        2.0500000000  0.0007177871
-;;;cperl-fontify-syntaxically                 2           1.78          0.8900000000
-;;;cperl-find-pods-heres                      2           1.78          0.8900000000
-;;;cperl-update-syntaxification               1           1.78          1.78
-;;;cperl-fix-line-spacing                     769         1.4800000000  0.0019245773
-;;;cperl-after-block-and-statement-beg        163         1.4100000000  0.0086503067
-;;;cperl-block-p                              775         1.1800000000  0.0015225806
-;;;cperl-to-comment-or-eol                    3652        1.1200000000  0.0003066812
-;;;cperl-after-block-p                        165         1.0500000000  0.0063636363
-;;;cperl-commentify                           141         0.22          0.0015602836
-;;;cperl-get-state                            813         0.16          0.0001968019
-;;;cperl-backward-to-start-of-continued-exp   26          0.12          0.0046153846
-;;;cperl-delay-update-hook                    2107        0.0899999999  4.271...e-05
-;;;cperl-protect-defun-start                  141         0.0700000000  0.0004964539
-;;;cperl-after-label                          407         0.0599999999  0.0001474201
-;;;cperl-forward-re                           139         0.0299999999  0.0002158273
-;;;cperl-comment-indent                       26          0.0299999999  0.0011538461
-;;;cperl-use-region-p                         8           0.0           0.0
-;;;cperl-lazy-hook                            15          0.0           0.0
-;;;cperl-after-expr-p                         8           0.0           0.0
-;;;cperl-font-lock-unfontify-region-function  1           0.0           0.0
-
-;;;Function Name                              Call Count  Elapsed Time  Average Time
-;;;=========================================  ==========  ============  ============
-;;;cperl-fix-line-spacing                     769         1.4500000000  0.0018855656
-;;;cperl-indent-line                          13          0.3100000000  0.0238461538
-;;;cperl-after-block-and-statement-beg        69          0.2700000000  0.0039130434
-;;;cperl-after-block-p                        69          0.2099999999  0.0030434782
-;;;cperl-calculate-indent                     13          0.1000000000  0.0076923076
-;;;cperl-backward-to-noncomment               177         0.0700000000  0.0003954802
-;;;cperl-get-state                            13          0.0           0.0
-;;;cperl-to-comment-or-eol                    179         0.0           0.0
-;;;cperl-get-help-defer                       1           0.0           0.0
-;;;cperl-lazy-hook                            11          0.0           0.0
-;;;cperl-after-expr-p                         2           0.0           0.0
-;;;cperl-block-p                              13          0.0           0.0
-;;;cperl-after-label                          5           0.0           0.0
-
-;;;; After 3.12:
-;;;  (`cperl-find-pods-heres'): do not warn on `=cut' if doing a chunk only.
-
-;;;; After 3.13:
-;;;  (`cperl-mode'): load pseudo-faces on `cperl-find-pods-heres' (for 19.30).
-;;;  (`x-color-defined-p'): was not compiling on XEmacs
-;;;  (`cperl-find-pods-heres'): 1 << 6 was OK, but 1<<6 was considered as HERE
-;;;                              made into a string.
-
-;;;; After 3.14:
-;;;  (`cperl-find-pods-heres'): Postpone addition of faces after syntactic step
-;;;				Recognition of  was wrong.
-;;;  (`cperl-clobber-lisp-bindings'): if set, C-c variants are the old ones
-;;;  (`cperl-unwind-to-safe'):	New function.
-;;;  (`cperl-fontify-syntaxically'): Use `cperl-unwind-to-safe' to start at reasonable position.
-
-;;;; After 3.15:
-;;;  (`cperl-forward-re'):	Highlight the trailing / in s/foo// as string.
-;;;			Highlight the starting // in s//foo/ as function-name.
-
-;;;; After 3.16:
-;;;  (`cperl-find-pods-heres'): Highlight `gem' in s///gem as a keyword.
-
-;;;; After 4.0:
-;;;  (`cperl-find-pods-heres'): `qr' added
-;;;  (`cperl-electric-keyword'):	Likewise
-;;;  (`cperl-electric-else'):		Likewise
-;;;  (`cperl-to-comment-or-eol'):	Likewise
-;;;  (`cperl-make-regexp-x'):	Likewise
-;;;  (`cperl-init-faces'):	Likewise, and `lock' (as overridable?).
-;;;  (`cperl-find-pods-heres'): Knows that split// is null-RE.
-;;;				Highlights separators in 3-parts expressions
-;;;				as labels.
-
-;;;; After 4.1:
-;;;  (`cperl-find-pods-heres'):	<> was considered as a glob
-;;;  (`cperl-syntaxify-unwind'): New configuration variable
-;;;  (`cperl-fontify-m-as-s'):	New configuration variable
-
-;;;; After 4.2:
-;;;  (`cperl-find-pods-heres'): of the last line being `=head1' fixed.
-
-;;;  Handling of a long construct is still buggy if only the part of
-;;;  construct touches the updated region (we unwind to the start of
-;;;  long construct, but the end may have residual properties).
-
-;;;  (`cperl-unwind-to-safe'):	would not go to beginning of buffer.
-;;;  (`cperl-electric-pod'):	check for after-expr was performed
-;;;				inside of POD too.
-
-;;;; After 4.3:
-;;;  (`cperl-backward-to-noncomment'):	better treatment of PODs and HEREs.
-
-;;;  Indent-line works good, but indent-region does not - at toplevel...
-;;;  (`cperl-unwind-to-safe'):	Signature changed.
-;;;  (`x-color-defined-p'):     was defmacro'ed with a tick.  Remove another def.
-;;;  (`cperl-clobber-mode-lists'): New configuration variable.
-;;;  (`cperl-array-face'): One of definitions was garbled.
-
-;;;; After 4.4:
-;;;  (`cperl-not-bad-style-regexp'):	Updated.
-;;;  (`cperl-make-regexp-x'):	Misprint in a message.
-;;;  (`cperl-find-pods-heres'):	$a-1 ? foo : bar; was a regexp.
-;;;                             `<< (' was considered a start of POD.
-;;;  Init:			`cperl-is-face' was busted.
-;;;  (`cperl-make-face'):	New macros.
-;;;  (`cperl-force-face'):	New macros.
-;;;  (`cperl-init-faces'):	Corrected to use new macros;
-;;;				`if' for copying `reference-face' to
-;;;				`constant-face' was backward.
-;;;  (`font-lock-other-type-face'): Done via `defface' too.
-
-;;;; After 4.5:
-;;;  (`cperl-init-faces-weak'):	use `cperl-force-face'.
-;;;  (`cperl-after-block-p'):	After END/BEGIN we are a block.
-;;;  (`cperl-mode'):		`font-lock-unfontify-region-function'
-;;;				was set to a wrong function.
-;;;  (`cperl-comment-indent'):	Commenting __END__ was not working.
-;;;  (`cperl-indent-for-comment'):	Likewise.
-;;;				(Indenting is still misbehaving at toplevel.)
-
-;;;; After 4.5:
-;;;  (`cperl-unwind-to-safe'):	Signature changed, unwinds end too.
-;;;  (`cperl-find-pods-heres'):	mark qq[]-etc sections as syntax-type=string
-;;;  (`cperl-fontify-syntaxically'): Unwinds start and end to go out of
-;;;				     long strings (not very successful).
-
-;;;   >>>>  CPerl should be usable in write mode too now <<<<
-
-;;;  (`cperl-syntaxify-by-font-lock'): Better default - off in text-mode.
-;;;  (`cperl-tips'): 		Updated docs.
-;;;  (`cperl-problems'):	Updated docs.
-
-;;;; After 4.6:
-;;;  (`cperl-calculate-indent'):	Did not consider `,' as continuation mark for statements.
-;;;  (`cperl-write-tags'):	Correct for XEmacs's `visit-tags-table-buffer'.
-
-;;;; After 4.7:
-;;;  (`cperl-calculate-indent'): Avoid parse-data optimization at toplevel.
-;;;				 Should indent correctly at toplevel too.
-;;;  (`cperl-tags-hier-init'):	Gross hack to pretend we work (are we?).
-;;;  (`cperl-find-pods-heres'):	Was not processing sub protos after a comment ine.
-;;;				Was treating $a++ <= 5 as a glob.
-
-;;;; After 4.8:
-;;;  (toplevel):		require custom unprotected => failure on 19.28.
-;;;  (`cperl-xemacs-p')		defined when compile too
-;;;  (`cperl-tags-hier-init'):	Another try to work around XEmacs problems
-;;;				Better progress messages.
-;;;  (`cperl-find-tags'):	Was writing line/pos in a wrong order,
-;;;				pos off by 1 and not at beg-of-line.
-;;;  (`cperl-etags-snarf-tag'): New macro
-;;;  (`cperl-etags-goto-tag-location'): New macro
-;;;  (`cperl-write-tags'):	When removing old TAGS info was not
-;;;				relativizing filename
-
-;;;; After 4.9:
-;;;  (`cperl-version'):		New variable.  New menu entry
-
-;;;; After 4.10:
-;;;  (`cperl-tips'):		Updated.
-;;;  (`cperl-non-problems'):	Updated.
-;;;  random:			References to future 20.3 removed.
-
-;;;; After 4.11:
-;;;  (`perl-font-lock-keywords'): Would not highlight `sub foo($$);'.
-;;;  Docstrings:		Menu was described as `CPerl' instead of `Perl'
-
-;;;; After 4.12:
-;;;  (`cperl-toggle-construct-fix'): Was toggling to t instead of 1.
-;;;  (`cperl-ps-print-init'):	Associate `cperl-array-face', `cperl-hash-face'
-;;;				remove `font-lock-emphasized-face'.
-;;;				remove `font-lock-other-emphasized-face'.
-;;;				remove `font-lock-reference-face'.
-;;;				remove `font-lock-keyword-face'.
-;;;				Use `eval-after-load'.
-;;;  (`cperl-init-faces'):	remove init `font-lock-other-emphasized-face'.
-;;;				remove init `font-lock-emphasized-face'.
-;;;				remove init `font-lock-keyword-face'.
-;;;  (`cperl-tips-faces'):	New variable and an entry into Mini-docs.
-;;;  (`cperl-indent-region'):	Do not indent whitespace lines
-;;;  (`cperl-indent-exp'):	Was not processing else-blocks.
-;;;  (`cperl-calculate-indent'): Remove another parse-data optimization
-;;;				 at toplevel: would indent correctly.
-;;;  (`cperl-get-state'):	NOP line removed.
-
-;;;; After 4.13:
-;;;  (`cperl-ps-print-init'):	Remove not-CPerl-related faces.
-;;;  (`cperl-ps-print'):	New function and menu entry.
-;;;  (`cperl-ps-print-face-properties'):	New configuration variable.
-;;;  (`cperl-invalid-face'):	New configuration variable.
-;;;  (`cperl-nonoverridable-face'):	New face.  Renamed from
-;;;					`font-lock-other-type-face'.
-;;;  (`perl-font-lock-keywords'):	Highlight trailing whitespace
-;;;  (`cperl-contract-levels'):	Documentation corrected.
-;;;  (`cperl-contract-level'):	Likewise.
-
-;;;; After 4.14:
-;;;  (`cperl-ps-print'): `ps-print-face-extension-alist' was not in old Emaxen,
-;;;				same with `ps-extend-face-list'
-;;;  (`cperl-ps-extend-face-list'):	New macro.
-
-;;;; After 4.15:
-;;;  (`cperl-init-faces'):	Interpolate `cperl-invalid-face'.
-;;;  (`cperl-forward-re'):	Emit a meaningful error instead of a cryptic
-;;;				one for uncomplete REx near end-of-buffer.
-;;;  (`cperl-find-pods-heres'):	Tolerate unfinished REx at end-of-buffer.
-
-;;;; After 4.16:
-;;;  (`cperl-find-pods-heres'): `unwind-protect' was left commented.
-
-;;;; After 4.17:
-;;;  (`cperl-invalid-face'):	Change to ''underline.
-
-;;;; After 4.18:
-;;;  (`cperl-find-pods-heres'):	/ and ? after : start a REx.
-;;;  (`cperl-after-expr-p'):	Skip labels when checking
-;;;  (`cperl-calculate-indent'): Correct for labels when calculating
-;;;					indentation of continuations.
-;;;				Docstring updated.
-
-;;;; After 4.19:
-;;;  Minor (mostly spelling) corrections from 20.3.3 merged.
-
-;;;; After 4.20:
-;;;  (`cperl-tips'):		Another workaround added.  Sent to RMS for 20.4.
-
-;;;; After 4.21:
-;;;  (`cperl-praise'):		Mention linear-time indent.
-;;;  (`cperl-find-pods-heres'):	@if ? a : b was considered a REx.
-
-;;;; After 4.22:
-;;;  (`cperl-after-expr-p'):	Make true after __END__.
-;;;  (`cperl-electric-pod'):	"SYNOPSIS" was misspelled.
-
-;;;; After 4.23:
-;;;  (`cperl-beautify-regexp-piece'):	Was not allowing for *? after a class.
-;;;					Allow for POSIX char-classes.
-;;;					Remove trailing whitespace when
-;;;					adding new linebreak.
-;;;					Add a level counter to stop shallow.
-;;;					Indents unprocessed groups rigidly.
-;;;  (`cperl-beautify-regexp'):	Add an optional count argument to go that
-;;;				many levels deep.
-;;;  (`cperl-beautify-level'):	Likewise
-;;;  Menu:			Add new entries to Regexp menu to do one level
-;;;  (`cperl-contract-level'):	Was entering an infinite loop
-;;;  (`cperl-find-pods-heres'):	Typo (double quoting).
-;;;				Was detecting < $file > as FH instead of glob.
-;;;				Support for comments in RExen (except
-;;;				for m#\#comment#x), governed by
-;;;				`cperl-regexp-scan'.
-;;;  (`cperl-regexp-scan'):	New customization variable.
-;;;  (`cperl-forward-re'):	Improve logic of resetting syntax table.
-
-;;;; After 4.23 and: After 4.24:
-;;;  (`cperl-contract-levels'):	Restore position.
-;;;  (`cperl-beautify-level'):	Likewise.
-;;;  (`cperl-beautify-regexp'):	Likewise.
-;;;  (`cperl-commentify'):	Rudimental support for length=1 runs
-;;;  (`cperl-find-pods-heres'):	Process 1-char long REx comments too /a#/x
-;;;				Processes REx-comments in #-delimited RExen.
-;;;				MAJOR BUG CORRECTED: after a misparse
-;;;				  a body of a subroutine could be corrupted!!!
-;;;				  One might need to reeval the function body
-;;;				  to fix things.  (A similar bug was
-;;;				  present in `cperl-indent-region' eons ago.)
-;;; To reproduce:
-;;   (defun foo () (let ((a '(t))) (insert (format "%s" a)) (setcar a 'BUG) t))
-;;   (foo)
-;;   (foo)
-;;; C-x C-e the above three lines (at end-of-line).  First evaluation
-;;; of `foo' inserts (t), second one inserts (BUG) ?!
-;;;
-;;; In CPerl it was triggered by inserting then deleting `/' at start of
-;;;      /  a (?# asdf  {[(}asdf )ef,/;
-
-;;;; After 4.25:
-;;; (`cperl-commentify'):	Was recognizing length=2 "strings" as length=1.
-;;; (`imenu-example--create-perl-index'):
-;;;				Was not enforcing syntaxification-to-the-end.
-;;; (`cperl-invert-if-unless'):	Allow `for', `foreach'.
-;;; (`cperl-find-pods-heres'):	Quote `cperl-nonoverridable-face'.
-;;;				Mark qw(), m()x as indentable.
-;;; (`cperl-init-faces'):	Highlight `sysopen' too.
-;;;				Highlight $var in `for my $var' too.
-;;; (`cperl-invert-if-unless'):	Was leaving whitespace at end.
-;;; (`cperl-linefeed'):		Was splitting $var{$foo} if point after `{'.
-;;; (`cperl-calculate-indent'): Remove old commented out code.
-;;;				Support (primitive) indentation of qw(), m()x.
-
-
-;;;; After 4.26:
-;;; (`cperl-problems'):		Mention `fill-paragraph' on comment. \"" and
-;;;				q [] with intervening newlines.
-;;; (`cperl-autoindent-on-semi'):	New customization variable.
-;;; (`cperl-electric-semi'):	Use `cperl-autoindent-on-semi'.
-;;; (`cperl-tips'):		Mention how to make CPerl the default mode.
-;;; (`cperl-mode'):		Support `outline-minor-mode'
-;;;				(Thanks to Mark A. Hershberger).
-;;; (`cperl-outline-level'):	New function.
-;;; (`cperl-highlight-variables-indiscriminately'):	New customization var.
-;;; (`cperl-init-faces'):	Use `cperl-highlight-variables-indiscriminately'.
-;;;				(Thanks to Sean Kamath ).
-;;; (`cperl-after-block-p'):	Support CHECK and INIT.
-;;; (`cperl-init-faces'):	Likewise and "our".
-;;;				(Thanks to Doug MacEachern ).
-;;; (`cperl-short-docs'):	Likewise and "our".
-
-
-;;;; After 4.27:
-;;; (`cperl-find-pods-heres'):	Recognize \"" as a string.
-;;;				Mark whitespace and comments between q and []
-;;;				  as `syntax-type' => `prestring'.
-;;;				Allow whitespace between << and "FOO".
-;;; (`cperl-problems'):		Remove \"" and q [] with intervening newlines.
-;;;				Mention multiple < t.
-;;;				Do not recognize $opt_s and $opt::s as s///.
-;;;  (`cperl-perldoc'):		Use case-sensitive search (contributed).
-;;;  (`cperl-fix-line-spacing'): Allow "_" in $vars of foreach etc. when
-;;;				underscore isn't a word char (gdj-contributed).
-;;;  (`defun-prompt-regexp'):	Allow prototypes.
-;;;  (`cperl-vc-header-alist'):	Extract numeric version from the Id.
-;;;  Toplevel:			Put toggle-autohelp into the mode menu.
-;;;				Better docs for toggle/set/unset autohelp.
-;;;  (`cperl-electric-backspace-untabify'): New customization variable
-;;;  (`cperl-after-expr-p'):	Works after here-docs, formats, and PODs too
-;;;				(affects many electric constructs).
-;;;  (`cperl-calculate-indent'): Takes into account `first-format-line' ==>
-;;;				works after format.
-;;;  (`cperl-short-docs'):	Make it work with ... too.
-;;;				"array context" ==> "list context"
-;;;  (`cperl-electric-keyword'): make $if (etc: "$@%&*") non-electric
-;;;				'(' after keyword would insert a doubled paren
-;;;  (`cperl-electric-paren'):	documented affected by `cperl-electric-parens'
-;;;  (`cperl-electric-rparen'):	Likewise
-;;;  (`cperl-build-manpage'):	New function by Nick Roberts
-;;;  (`cperl-perldoc'):		Make it work in XEmacs too
-
-;;;; After 4.36:
-;;;  (`cperl-find-pods-heres'):	Recognize s => 1 and {s} (as a key or varname),
-;;;				{ s:: } and { s::bar::baz } as varnames.
-;;;  (`cperl-after-expr-p'):	Updates syntaxification before checks
-;;;  (`cperl-calculate-indent'): Likewise
-;;;				Fix wrong indent of blocks starting with POD
-;;;  (`cperl-after-block-p'):	Optional argument for checking for a pre-block
-;;;				Recognize `continue' blocks too.
-;;;  (`cperl-electric-brace'):	use `cperl-after-block-p' for detection;
-;;;				Now works for else/continue/sub blocks
-;;;  (`cperl-short-docs'):	Minor edits; make messages fit 80-column screen
-
-;;;; After 4.37:
-;;;  `cperl-add-tags-recurse-noxs-fullpath'
-;;;    added (for -batch mode);
-
-;;; Code:
-
-
-(if (fboundp 'eval-when-compile)
-    (eval-when-compile
-      (condition-case nil
-	  (require 'custom)
-	(error nil))
-      (condition-case nil
-	  (require 'man)
-	(error nil))
-      (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
-      (defvar cperl-can-font-lock
-	(or cperl-xemacs-p
-	    (and (boundp 'emacs-major-version)
-		 (or window-system
-		     (> emacs-major-version 20)))))
-      (if cperl-can-font-lock
-	  (require 'font-lock))
-      (defvar msb-menu-cond)
-      (defvar gud-perldb-history)
-      (defvar font-lock-background-mode) ; not in Emacs
-      (defvar font-lock-display-type)	; ditto
-      (or (fboundp 'defgroup)
-	  (defmacro defgroup (name val doc &rest arr)
-	    nil))
-      (or (fboundp 'custom-declare-variable)
-	  (defmacro defcustom (name val doc &rest arr)
-	    (` (defvar (, name) (, val) (, doc)))))
-      (or (and (fboundp 'custom-declare-variable)
-	       (string< "19.31" emacs-version))	;  Checked with 19.30: defface does not work
-	  (defmacro defface (&rest arr)
-	    nil))
-      ;; Avoid warning (tmp definitions)
-      (or (fboundp 'x-color-defined-p)
-	  (defmacro x-color-defined-p (col)
-	    (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col))))
-		  ;; XEmacs >= 19.12
-		  ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col))))
-		  ;; XEmacs 19.11
-		  ((fboundp 'x-valid-color-name-p) (` (x-valid-color-name-p (, col))))
-		  (t '(error "Cannot implement color-defined-p")))))
-      (defmacro cperl-is-face (arg)	; Takes quoted arg
-	(cond ((fboundp 'find-face)
-	       (` (find-face (, arg))))
-	      (;;(and (fboundp 'face-list)
-	       ;;	(face-list))
-	       (fboundp 'face-list)
-	       (` (member (, arg) (and (fboundp 'face-list)
-				       (face-list)))))
-	      (t
-	       (` (boundp (, arg))))))
-      (defmacro cperl-make-face (arg descr) ; Takes unquoted arg
-	(cond ((fboundp 'make-face)
-	       (` (make-face (quote (, arg)))))
-	      (t
-	       (` (defvar (, arg) (quote (, arg)) (, descr))))))
-      (defmacro cperl-force-face (arg descr) ; Takes unquoted arg
-	(` (progn
-	     (or (cperl-is-face (quote (, arg)))
-		 (cperl-make-face (, arg) (, descr)))
-	     (or (boundp (quote (, arg))) ; We use unquoted variants too
-		 (defvar (, arg) (quote (, arg)) (, descr))))))
-      (if cperl-xemacs-p
-	  (defmacro cperl-etags-snarf-tag (file line)
-	    (` (progn
-		 (beginning-of-line 2)
-		 (list (, file) (, line)))))
-	(defmacro cperl-etags-snarf-tag (file line)
-	  (` (etags-snarf-tag))))
-      (if cperl-xemacs-p
-	  (defmacro cperl-etags-goto-tag-location (elt)
-	    (`;;(progn
-	     ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0)))
-	     ;; (set-buffer (get-file-buffer (elt (, elt) 0)))
-	     ;; Probably will not work due to some save-excursion???
-	     ;; Or save-file-position?
-	     ;; (message "Did I get to line %s?" (elt (, elt) 1))
-	     (goto-line (string-to-int (elt (, elt) 1)))))
-	;;)
-	(defmacro cperl-etags-goto-tag-location (elt)
-	  (` (etags-goto-tag-location (, elt)))))))
-
-(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
-
-(defvar cperl-can-font-lock
-  (or cperl-xemacs-p
-      (and (boundp 'emacs-major-version)
-	   (or window-system
-	       (> emacs-major-version 20)))))
-
-(condition-case nil
-    (require 'custom)
-  (error nil))				; Already fixed by eval-when-compile
-
-(defun cperl-choose-color (&rest list)
-  (let (answer)
-    (while list
-      (or answer
-	  (if (or (x-color-defined-p (car list))
-		  (null (cdr list)))
-	      (setq answer (car list))))
-      (setq list (cdr list)))
-    answer))
-
-
-(defgroup cperl nil
-  "Major mode for editing Perl code."
-  :prefix "cperl-"
-  :group 'languages)
-
-(defgroup cperl-indentation-details nil
-  "Indentation."
-  :prefix "cperl-"
-  :group 'cperl)
-
-(defgroup cperl-affected-by-hairy nil
-  "Variables affected by `cperl-hairy'."
-  :prefix "cperl-"
-  :group 'cperl)
-
-(defgroup cperl-autoinsert-details nil
-  "Auto-insert tuneup."
-  :prefix "cperl-"
-  :group 'cperl)
-
-(defgroup cperl-faces nil
-  "Fontification colors."
-  :prefix "cperl-"
-  :group 'cperl)
-
-(defgroup cperl-speed nil
-  "Speed vs. validity tuneup."
-  :prefix "cperl-"
-  :group 'cperl)
-
-(defgroup cperl-help-system nil
-  "Help system tuneup."
-  :prefix "cperl-"
-  :group 'cperl)
-
-
-(defcustom cperl-extra-newline-before-brace nil
-  "*Non-nil means that if, elsif, while, until, else, for, foreach
-and do constructs look like:
-
-	if ()
-	{
-	}
-
-instead of:
-
-	if () {
-	}"
-  :type 'boolean
-  :group 'cperl-autoinsert-details)
-
-(defcustom cperl-extra-newline-before-brace-multiline
-  cperl-extra-newline-before-brace
-  "*Non-nil means the same as `cperl-extra-newline-before-brace', but
-for constructs with multiline if/unless/while/until/for/foreach condition."
-  :type 'boolean
-  :group 'cperl-autoinsert-details)
-
-(defcustom cperl-indent-level 2
-  "*Indentation of CPerl statements with respect to containing block."
-  :type 'integer
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-lineup-step nil
-  "*`cperl-lineup' will always lineup at multiple of this number.
-If nil, the value of `cperl-indent-level' will be used."
-  :type '(choice (const nil) integer)
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-brace-imaginary-offset 0
-  "*Imagined indentation of a Perl open brace that actually follows a statement.
-An open brace following other text is treated as if it were this far
-to the right of the start of its line."
-  :type 'integer
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-brace-offset 0
-  "*Extra indentation for braces, compared with other text in same context."
-  :type 'integer
-  :group 'cperl-indentation-details)
-(defcustom cperl-label-offset -2
-  "*Offset of CPerl label lines relative to usual indentation."
-  :type 'integer
-  :group 'cperl-indentation-details)
-(defcustom cperl-min-label-indent 1
-  "*Minimal offset of CPerl label lines."
-  :type 'integer
-  :group 'cperl-indentation-details)
-(defcustom cperl-continued-statement-offset 2
-  "*Extra indent for lines not starting new statements."
-  :type 'integer
-  :group 'cperl-indentation-details)
-(defcustom cperl-continued-brace-offset 0
-  "*Extra indent for substatements that start with open-braces.
-This is in addition to cperl-continued-statement-offset."
-  :type 'integer
-  :group 'cperl-indentation-details)
-(defcustom cperl-close-paren-offset -1
-  "*Extra indent for substatements that start with close-parenthesis."
-  :type 'integer
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-auto-newline nil
-  "*Non-nil means automatically newline before and after braces,
-and after colons and semicolons, inserted in CPerl code.  The following
-\\[cperl-electric-backspace] will remove the inserted whitespace.
-Insertion after colons requires both this variable and
-`cperl-auto-newline-after-colon' set."
-  :type 'boolean
-  :group 'cperl-autoinsert-details)
-
-(defcustom cperl-autoindent-on-semi nil
-  "*Non-nil means automatically indent after insertion of (semi)colon.
-Active if `cperl-auto-newline' is false."
-  :type 'boolean
-  :group 'cperl-autoinsert-details)
-
-(defcustom cperl-auto-newline-after-colon nil
-  "*Non-nil means automatically newline even after colons.
-Subject to `cperl-auto-newline' setting."
-  :type 'boolean
-  :group 'cperl-autoinsert-details)
-
-(defcustom cperl-tab-always-indent t
-  "*Non-nil means TAB in CPerl mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used."
-  :type 'boolean
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-font-lock nil
-  "*Non-nil (and non-null) means CPerl buffers will use `font-lock-mode'.
-Can be overwritten by `cperl-hairy' if nil."
-  :type '(choice (const null) boolean)
-  :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-lbrace-space nil
-  "*Non-nil (and non-null) means { after $ should be preceded by ` '.
-Can be overwritten by `cperl-hairy' if nil."
-  :type '(choice (const null) boolean)
-  :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-parens-string "({[]})<"
-  "*String of parentheses that should be electric in CPerl.
-Closing ones are electric only if the region is highlighted."
-  :type 'string
-  :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-parens nil
-  "*Non-nil (and non-null) means parentheses should be electric in CPerl.
-Can be overwritten by `cperl-hairy' if nil."
-  :type '(choice (const null) boolean)
-  :group 'cperl-affected-by-hairy)
-
-(defvar zmacs-regions)			; Avoid warning
-
-(defcustom cperl-electric-parens-mark
-  (and window-system
-       (or (and (boundp 'transient-mark-mode) ; For Emacs
-		transient-mark-mode)
-	   (and (boundp 'zmacs-regions) ; For XEmacs
-		zmacs-regions)))
-  "*Not-nil means that electric parens look for active mark.
-Default is yes if there is visual feedback on mark."
-  :type 'boolean
-  :group 'cperl-autoinsert-details)
-
-(defcustom cperl-electric-linefeed nil
-  "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy.
-In any case these two mean plain and hairy linefeeds together.
-Can be overwritten by `cperl-hairy' if nil."
-  :type '(choice (const null) boolean)
-  :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-keywords nil
-  "*Not-nil (and non-null) means keywords are electric in CPerl.
-Can be overwritten by `cperl-hairy' if nil."
-  :type '(choice (const null) boolean)
-  :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-electric-backspace-untabify t
-  "*Not-nil means electric-backspace will untabify in CPerl."
-  :type 'boolean
-  :group 'cperl-autoinsert-details)
-
-(defcustom cperl-hairy nil
-  "*Not-nil means most of the bells and whistles are enabled in CPerl.
-Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
-`cperl-electric-parens', `cperl-electric-linefeed', `cperl-electric-keywords',
-`cperl-info-on-command-no-prompt', `cperl-clobber-lisp-bindings',
-`cperl-lazy-help-time'."
-  :type 'boolean
-  :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-comment-column 32
-  "*Column to put comments in CPerl (use \\[cperl-indent] to lineup with code)."
-  :type 'integer
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-vc-header-alist '((SCCS "($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;")
-				   (RCS "($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;"))
-  "*What to use as `vc-header-alist' in CPerl."
-  :type '(repeat (list symbol string))
-  :group 'cperl)
-
-(defcustom cperl-clobber-mode-lists
-  (not
-   (and
-    (boundp 'interpreter-mode-alist)
-    (assoc "miniperl" interpreter-mode-alist)
-    (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist)))
-  "*Whether to install us into `interpreter-' and `extension' mode lists."
-  :type 'boolean
-  :group 'cperl)
-
-(defcustom cperl-info-on-command-no-prompt nil
-  "*Not-nil (and non-null) means not to prompt on C-h f.
-The opposite behaviour is always available if prefixed with C-c.
-Can be overwritten by `cperl-hairy' if nil."
-  :type '(choice (const null) boolean)
-  :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-clobber-lisp-bindings nil
-  "*Not-nil (and non-null) means not overwrite C-h f.
-The function is available on \\[cperl-info-on-command], \\[cperl-get-help].
-Can be overwritten by `cperl-hairy' if nil."
-  :type '(choice (const null) boolean)
-  :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-lazy-help-time nil
-  "*Not-nil (and non-null) means to show lazy help after given idle time.
-Can be overwritten by `cperl-hairy' to be 5 sec if nil."
-  :type '(choice (const null) (const nil) integer)
-  :group 'cperl-affected-by-hairy)
-
-(defcustom cperl-pod-face 'font-lock-comment-face
-  "*The result of evaluation of this expression is used for POD highlighting."
-  :type 'face
-  :group 'cperl-faces)
-
-(defcustom cperl-pod-head-face 'font-lock-variable-name-face
-  "*The result of evaluation of this expression is used for POD highlighting.
-Font for POD headers."
-  :type 'face
-  :group 'cperl-faces)
-
-(defcustom cperl-here-face 'font-lock-string-face
-  "*The result of evaluation of this expression is used for here-docs highlighting."
-  :type 'face
-  :group 'cperl-faces)
-
-;; XEmacs change: removed extra ' from ''underline
-(defcustom cperl-invalid-face 'underline ; later evaluated by `font-lock'
-  "*The result of evaluation of this expression highlights trailing whitespace."
-  :type 'face
-  :group 'cperl-faces)
-
-(defcustom cperl-pod-here-fontify '(featurep 'font-lock)
-  "*Not-nil after evaluation means to highlight POD and here-docs sections."
-  :type 'boolean
-  :group 'cperl-faces)
-
-(defcustom cperl-fontify-m-as-s t
-  "*Not-nil means highlight 1arg regular expressions operators same as 2arg."
-  :type 'boolean
-  :group 'cperl-faces)
-
-(defcustom cperl-highlight-variables-indiscriminately nil
-  "*Non-nil means perform additional highlighting on variables.
-Currently only changes how scalar variables are highlighted.
-Note that that variable is only read at initialization time for
-the variable `perl-font-lock-keywords-2', so changing it after you've
-entered CPerl mode the first time will have no effect."
-  :type 'boolean
-  :group 'cperl)
-
-(defcustom cperl-pod-here-scan t
-  "*Not-nil means look for POD and here-docs sections during startup.
-You can always make lookup from menu or using \\[cperl-find-pods-heres]."
-  :type 'boolean
-  :group 'cperl-speed)
-
-(defcustom cperl-regexp-scan t
-  "*Not-nil means make marking of regular expression more thorough.
-Effective only with `cperl-pod-here-scan'.  Not implemented yet."
-  :type 'boolean
-  :group 'cperl-speed)
-
-(defcustom cperl-imenu-addback nil
-  "*Not-nil means add backreferences to generated `imenu's.
-May require patched `imenu' and `imenu-go'.  Obsolete."
-  :type 'boolean
-  :group 'cperl-help-system)
-
-(defcustom cperl-max-help-size 66
-  "*Non-nil means shrink-wrapping of info-buffer allowed up to these percents."
-  :type '(choice integer (const nil))
-  :group 'cperl-help-system)
-
-(defcustom cperl-shrink-wrap-info-frame t
-  "*Non-nil means shrink-wrapping of info-buffer-frame allowed."
-  :type 'boolean
-  :group 'cperl-help-system)
-
-(defcustom cperl-info-page "perl"
-  "*Name of the info page containing perl docs.
-Older version of this page was called `perl5', newer `perl'."
-  :type 'string
-  :group 'cperl-help-system)
-
-(defcustom cperl-use-syntax-table-text-property
-  (boundp 'parse-sexp-lookup-properties)
-  "*Non-nil means CPerl sets up and uses `syntax-table' text property."
-  :type 'boolean
-  :group 'cperl-speed)
-
-(defcustom cperl-use-syntax-table-text-property-for-tags
-  cperl-use-syntax-table-text-property
-  "*Non-nil means: set up and use `syntax-table' text property generating TAGS."
-  :type 'boolean
-  :group 'cperl-speed)
-
-(defcustom cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$"
-  "*Regexp to match files to scan when generating TAGS."
-  :type 'regexp
-  :group 'cperl)
-
-(defcustom cperl-noscan-files-regexp
-  "/\\(\\.\\.?\\|SCCS\\|RCS\\|CVS\\|blib\\)$"
-  "*Regexp to match files/dirs to skip when generating TAGS."
-  :type 'regexp
-  :group 'cperl)
-
-(defcustom cperl-regexp-indent-step nil
-  "*Indentation used when beautifying regexps.
-If nil, the value of `cperl-indent-level' will be used."
-  :type '(choice integer (const nil))
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-indent-left-aligned-comments t
-  "*Non-nil means that the comment starting in leftmost column should indent."
-  :type 'boolean
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-under-as-char t
-  "*Non-nil means that the _ (underline) should be treated as word char."
-  :type 'boolean
-  :group 'cperl)
-
-(defcustom cperl-extra-perl-args ""
-  "*Extra arguments to use when starting Perl.
-Currently used with `cperl-check-syntax' only."
-  :type 'string
-  :group 'cperl)
-
-(defcustom cperl-message-electric-keyword t
-  "*Non-nil means that the `cperl-electric-keyword' prints a help message."
-  :type 'boolean
-  :group 'cperl-help-system)
-
-(defcustom cperl-indent-region-fix-constructs 1
-  "*Amount of space to insert between `}' and `else' or `elsif'
-in `cperl-indent-region'.  Set to nil to leave as is.  Values other
-than 1 and nil will probably not work."
-  :type '(choice (const nil) (const 1))
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-break-one-line-blocks-when-indent t
-  "*Non-nil means that one-line if/unless/while/until/for/foreach BLOCKs
-need to be reformatted into multiline ones when indenting a region."
-  :type 'boolean
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-fix-hanging-brace-when-indent t
-  "*Non-nil means that BLOCK-end `}' may be put on a separate line
-when indenting a region.
-Braces followed by else/elsif/while/until are excepted."
-  :type 'boolean
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-merge-trailing-else t
-  "*Non-nil means that BLOCK-end `}' followed by else/elsif/continue
-may be merged to be on the same line when indenting a region."
-  :type 'boolean
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-indent-parens-as-block nil
-  "*Non-nil means that non-block ()-, {}- and []-groups are indented as blocks,
-but for trailing \",\" inside the group, which won't increase indentation.
-One should tune up `cperl-close-paren-offset' as well."
-  :type 'boolean
-  :group 'cperl-indentation-details)
-
-(defcustom cperl-syntaxify-by-font-lock
-  (and cperl-can-font-lock
-       (boundp 'parse-sexp-lookup-properties))
-  "*Non-nil means that CPerl uses `font-lock's routines for syntaxification."
-  :type '(choice (const message) boolean)
-  :group 'cperl-speed)
-
-(defcustom cperl-syntaxify-unwind
-  t
-  "*Non-nil means that CPerl unwinds to a start of a long construction
-when syntaxifying a chunk of buffer."
-  :type 'boolean
-  :group 'cperl-speed)
-
-(defcustom cperl-ps-print-face-properties
-  '((font-lock-keyword-face		nil nil		bold shadow)
-    (font-lock-variable-name-face	nil nil		bold)
-    (font-lock-function-name-face	nil nil		bold italic box)
-    (font-lock-constant-face		nil "LightGray"	bold)
-    (cperl-array-face			nil "LightGray"	bold underline)
-    (cperl-hash-face			nil "LightGray"	bold italic underline)
-    (font-lock-comment-face		nil "LightGray"	italic)
-    (font-lock-string-face		nil nil		italic underline)
-    (cperl-nonoverridable-face		nil nil		italic underline)
-    (font-lock-type-face		nil nil		underline)
-    (underline				nil "LightGray"	strikeout))
-  "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'."
-  :type '(repeat (cons symbol
-		       (cons (choice (const nil) string)
-			     (cons (choice (const nil) string)
-				   (repeat symbol)))))
-  :group 'cperl-faces)
-
-(if cperl-can-font-lock
-    (progn
-      (defvar cperl-dark-background
-	(cperl-choose-color "navy" "os2blue" "darkgreen"))
-      (defvar cperl-dark-foreground
-	(cperl-choose-color "orchid1" "orange"))
-
-      (defface cperl-nonoverridable-face
-	(` ((((class grayscale) (background light))
-	     (:background "Gray90" :italic t :underline t))
-	    (((class grayscale) (background dark))
-	     (:foreground "Gray80" :italic t :underline t :bold t))
-	    (((class color) (background light))
-	     (:foreground "chartreuse3"))
-	    (((class color) (background dark))
-	     (:foreground (, cperl-dark-foreground)))
-	    (t (:bold t :underline t))))
-	"Font Lock mode face used to highlight array names."
-	:group 'cperl-faces)
-
-      (defface cperl-array-face
-	(` ((((class grayscale) (background light))
-	     (:background "Gray90" :bold t))
-	    (((class grayscale) (background dark))
-	     (:foreground "Gray80" :bold t))
-	    (((class color) (background light))
-	     (:foreground "Blue" :background "lightyellow2" :bold t))
-	    (((class color) (background dark))
-	     (:foreground "yellow" :background (, cperl-dark-background) :bold t))
-	    (t (:bold t))))
-	"Font Lock mode face used to highlight array names."
-	:group 'cperl-faces)
-
-      (defface cperl-hash-face
-	(` ((((class grayscale) (background light))
-	     (:background "Gray90" :bold t :italic t))
-	    (((class grayscale) (background dark))
-	     (:foreground "Gray80" :bold t :italic t))
-	    (((class color) (background light))
-	     (:foreground "Red" :background "lightyellow2" :bold t :italic t))
-	    (((class color) (background dark))
-	     (:foreground "Red" :background (, cperl-dark-background) :bold t :italic t))
-	    (t (:bold t :italic t))))
-	"Font Lock mode face used to highlight hash names."
-	:group 'cperl-faces)))
-
-
-
-;;; Short extra-docs.
-
-(defvar cperl-tips 'please-ignore-this-line
-  "Get maybe newer version of this package from
-  ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs
-and/or
-  ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
-Subdirectory `cperl-mode' may contain yet newer development releases and/or
-patches to related files.
-
-For best results apply to an older Emacs the patches from
-  ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches
-\(this upgrades syntax-parsing abilities of Emaxen v19.34 and
-v20.2 up to the level of Emacs v20.3 - a must for a good Perl
-mode.)  As of beginning of 2003, XEmacs may provide a similar ability.
-
-Get support packages choose-color.el (or font-lock-extra.el before
-19.30), imenu-go.el from the same place.  \(Look for other files there
-too... ;-).  Get a patch for imenu.el in 19.29.  Note that for 19.30 and
-later you should use choose-color.el *instead* of font-lock-extra.el
-\(and you will not get smart highlighting in C :-().
-
-Note that to enable Compile choices in the menu you need to install
-mode-compile.el.
-
-If your Emacs does not default to `cperl-mode' on Perl files, and you
-want it to: put the following into your .emacs file:
-
-  (autoload 'perl-mode \"cperl-mode\" \"alternate mode for editing Perl programs\" t)
-
-or
-
-  (defalias 'perl-mode 'cperl-mode)
-
-Get perl5-info from
-  $CPAN/doc/manual/info/perl-info.tar.gz
-older version was on
-  http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz
-
-If you use imenu-go, run imenu on perl5-info buffer (you can do it
-from Perl menu).  If many files are related, generate TAGS files from
-Tools/Tags submenu in Perl menu.
-
-If some class structure is too complicated, use Tools/Hierarchy-view
-from Perl menu, or hierarchic view of imenu.  The second one uses the
-current buffer only, the first one requires generation of TAGS from
-Perl/Tools/Tags menu beforehand.
-
-Run Perl/Tools/Insert-spaces-if-needed to fix your lazy typing.
-
-Switch auto-help on/off with Perl/Tools/Auto-help.
-
-Though with contemporary Emaxen CPerl mode should maintain the correct
-parsing of Perl even when editing, sometimes it may be lost.  Fix this by
-
-  M-x norm RET
-
-or
-
-  \\[normal-mode]
-
-In cases of more severe confusion sometimes it is helpful to do
-
-  M-x load-l RET cperl-mode RET
-  M-x norm RET
-
-or
-
-  \\[load-library] cperl-mode RET
-  \\[normal-mode]
-
-Before reporting (non-)problems look in the problem section of online
-micro-docs on what I know about CPerl problems.")
-
-(defvar cperl-problems 'please-ignore-this-line
-  "Description of problems in CPerl mode.
-Some faces will not be shown on some versions of Emacs unless you
-install choose-color.el, available from
-   ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/
-
-`fill-paragraph' on a comment may leave the point behind the
-paragraph.  Parsing of lines with several <= 19.12
-	  (setq unread-command-events (list (eval '(character-to-event c))))))
-  (defun cperl-putback-char (c)		; XEmacs <= 19.11
-    (set 'unread-command-event (eval '(character-to-event c))))) ; Avoid warnings
-
-(or (fboundp 'uncomment-region)
-    (defun uncomment-region (beg end)
-      (interactive "r")
-      (comment-region beg end -1)))
-
-(defvar cperl-do-not-fontify
-  (if (string< emacs-version "19.30")
-      'fontified
-    'lazy-lock)
-  "Text property which inhibits refontification.")
-
-(defsubst cperl-put-do-not-fontify (from to &optional post)
-  ;; If POST, do not do it with postponed fontification
-  (if (and post cperl-syntaxify-by-font-lock)
-      nil
-    (put-text-property (max (point-min) (1- from))
-		       to cperl-do-not-fontify t)))
-
-(defcustom cperl-mode-hook nil
-  "Hook run by CPerl mode."
-  :type 'hook
-  :group 'cperl)
-
-(defvar cperl-syntax-state nil)
-(defvar cperl-syntax-done-to nil)
-(defvar cperl-emacs-can-parse (> (length (save-excursion
-					   (parse-partial-sexp (point) (point)))) 9))
-
-;; Make customization possible "in reverse"
-(defsubst cperl-val (symbol &optional default hairy)
-  (cond
-   ((eq (symbol-value symbol) 'null) default)
-   (cperl-hairy (or hairy t))
-   (t (symbol-value symbol))))
-
-;;; Probably it is too late to set these guys already, but it can help later:
-
-(and cperl-clobber-mode-lists
-     (setq auto-mode-alist
-      (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode))  auto-mode-alist ))
-     (and (boundp 'interpreter-mode-alist)
-	  (setq interpreter-mode-alist (append interpreter-mode-alist
-					       '(("miniperl" . perl-mode))))))
-(if (fboundp 'eval-when-compile)
-    (eval-when-compile
-      (mapcar (lambda (p)
-		(condition-case nil
-		    (require p)
-		  (error nil)))
-	      '(imenu easymenu etags timer man info))
-      (if (fboundp 'ps-extend-face-list)
-	  (defmacro cperl-ps-extend-face-list (arg)
-	    (` (ps-extend-face-list (, arg))))
-	(defmacro cperl-ps-extend-face-list (arg)
-	  (` (error "This version of Emacs has no `ps-extend-face-list'"))))
-      ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs,
-      ;; macros instead of defsubsts don't work on Emacs, so we do the
-      ;; expansion manually.  Any other suggestions?
-      (if cperl-can-font-lock
-	  (require 'font-lock))
-      (require 'cl)))
-
-(defvar cperl-mode-abbrev-table nil
-  "Abbrev table in use in CPerl mode buffers.")
-
-(add-hook 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-")))
-
-(defvar cperl-mode-map () "Keymap used in CPerl mode.")
-
-(if cperl-mode-map nil
-  (setq cperl-mode-map (make-sparse-keymap))
-  (cperl-define-key "{" 'cperl-electric-lbrace)
-  (cperl-define-key "[" 'cperl-electric-paren)
-  (cperl-define-key "(" 'cperl-electric-paren)
-  (cperl-define-key "<" 'cperl-electric-paren)
-  (cperl-define-key "}" 'cperl-electric-brace)
-  (cperl-define-key "]" 'cperl-electric-rparen)
-  (cperl-define-key ")" 'cperl-electric-rparen)
-  (cperl-define-key ";" 'cperl-electric-semi)
-  (cperl-define-key ":" 'cperl-electric-terminator)
-  (cperl-define-key "\C-j" 'newline-and-indent)
-  (cperl-define-key "\C-c\C-j" 'cperl-linefeed)
-  (cperl-define-key "\C-c\C-t" 'cperl-invert-if-unless)
-  (cperl-define-key "\C-c\C-a" 'cperl-toggle-auto-newline)
-  (cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev)
-  (cperl-define-key "\C-c\C-w" 'cperl-toggle-construct-fix)
-  (cperl-define-key "\C-c\C-f" 'auto-fill-mode)
-  (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
-  (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp)
-  (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
-  (cperl-define-key [?\C-\M-\|] 'cperl-lineup
-		    [(control meta |)])
-  ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
-  ;;(cperl-define-key "\e;" 'cperl-indent-for-comment)
-  ;; XEmacs change: bind cperl-electric-delete to 'delete
-  (if cperl-xemacs-p
-      (progn
-        (cperl-define-key 'backspace 'cperl-electric-backspace)
-        (cperl-define-key 'delete 'cperl-electric-delete))
-    (cperl-define-key "\177" 'cperl-electric-backspace))
-  (cperl-define-key "\t" 'cperl-indent-command)
-  ;; don't clobber the backspace binding:
-  (cperl-define-key "\C-c\C-hF" 'cperl-info-on-command
-		    [(control c) (control h) F])
-  (if (cperl-val 'cperl-clobber-lisp-bindings)
-      (progn
-	(cperl-define-key "\C-hf"
-			  ;;(concat (char-to-string help-char) "f") ; does not work
-			  'cperl-info-on-command
-			  [(control h) f])
-	(cperl-define-key "\C-hv"
-			  ;;(concat (char-to-string help-char) "v") ; does not work
-			  'cperl-get-help
-			  [(control h) v])
-	(cperl-define-key "\C-c\C-hf"
-			  ;;(concat (char-to-string help-char) "f") ; does not work
-			  (key-binding "\C-hf")
-			  [(control c) (control h) f])
-	(cperl-define-key "\C-c\C-hv"
-			  ;;(concat (char-to-string help-char) "v") ; does not work
-			  (key-binding "\C-hv")
-			  [(control c) (control h) v]))
-    (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command
-		      [(control c) (control h) f])
-    ;;; XEmacs change: added bindings for cperl-perldoc, 
-    ;;; cperl-perldoc-at-point.
-    (cperl-define-key "\C-c\C-hp" 'cperl-perldoc
-		      [(control c) (control h) p])
-    (cperl-define-key "\C-c\C-hP" 'cperl-perldoc-at-point
-		      [(control c) (control h) P])
-    (cperl-define-key "\C-c\C-hv"
-		      ;;(concat (char-to-string help-char) "v") ; does not work
-		      'cperl-get-help
-		      [(control c) (control h) v]))
-  (if (and cperl-xemacs-p
-	   (<= emacs-minor-version 11) (<= emacs-major-version 19))
-      (progn
-	;; substitute-key-definition is usefulness-deenhanced...
-	(cperl-define-key "\M-q" 'cperl-fill-paragraph)
-	(cperl-define-key "\e;" 'cperl-indent-for-comment)
-	(cperl-define-key "\e\C-\\" 'cperl-indent-region))
-    (substitute-key-definition
-     'indent-sexp 'cperl-indent-exp
-     cperl-mode-map global-map)
-    (substitute-key-definition
-     'fill-paragraph 'cperl-fill-paragraph
-     cperl-mode-map global-map)
-    (substitute-key-definition
-     'indent-region 'cperl-indent-region
-     cperl-mode-map global-map)
-    (substitute-key-definition
-     'indent-for-comment 'cperl-indent-for-comment
-     cperl-mode-map global-map)))
-
-(defvar cperl-menu)
-(defvar cperl-lazy-installed)
-(defvar cperl-old-style nil)
-(condition-case nil
-    (progn
-      (require 'easymenu)
-      (easy-menu-define
-       cperl-menu cperl-mode-map "Menu for CPerl mode"
-       '("Perl"
-	 ["Beginning of function" beginning-of-defun t]
-	 ["End of function" end-of-defun t]
-	 ["Mark function" mark-defun t]
-	 ["Indent expression" cperl-indent-exp t]
-	 ["Fill paragraph/comment" cperl-fill-paragraph t]
-	 "----"
-	 ["Line up a construction" cperl-lineup (cperl-use-region-p)]
-	 ["Invert if/unless/while etc" cperl-invert-if-unless t]
-	 ("Regexp"
-	  ["Beautify" cperl-beautify-regexp
-	   cperl-use-syntax-table-text-property]
-	  ["Beautify one level deep" (cperl-beautify-regexp 1)
-	   cperl-use-syntax-table-text-property]
-	  ["Beautify a group" cperl-beautify-level
-	   cperl-use-syntax-table-text-property]
-	  ["Beautify a group one level deep" (cperl-beautify-level 1)
-	   cperl-use-syntax-table-text-property]
-	  ["Contract a group" cperl-contract-level
-	   cperl-use-syntax-table-text-property]
-	  ["Contract groups" cperl-contract-levels
-	   cperl-use-syntax-table-text-property])
-	 ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
-	 "----"
-	 ["Indent region" cperl-indent-region (cperl-use-region-p)]
-	 ["Comment region" cperl-comment-region (cperl-use-region-p)]
-	 ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)]
-	 "----"
-	 ["Run" mode-compile (fboundp 'mode-compile)]
-	 ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
-					(get-buffer "*compilation*"))]
-	 ["Next error" next-error (get-buffer "*compilation*")]
-	 ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]
-	 "----"
-	 ["Debugger" cperl-db t]
-	 "----"
-	 ("Tools"
-	  ["Imenu" imenu (fboundp 'imenu)]
-	  ["Insert spaces if needed" cperl-find-bad-style t]
-	  ["Class Hierarchy from TAGS" cperl-tags-hier-init t]
-	  ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]
-	  ["CPerl pretty print (exprmntl)" cperl-ps-print 
-	   (fboundp 'ps-extend-face-list)]
-	  ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)]
-	  ("Tags"
-;;;	     ["Create tags for current file" cperl-etags t]
-;;;	     ["Add tags for current file" (cperl-etags t) t]
-;;;	     ["Create tags for Perl files in directory" (cperl-etags nil t) t]
-;;;	     ["Add tags for Perl files in directory" (cperl-etags t t) t]
-;;;	     ["Create tags for Perl files in (sub)directories"
-;;;	      (cperl-etags nil 'recursive) t]
-;;;	     ["Add tags for Perl files in (sub)directories"
-;;;	      (cperl-etags t 'recursive) t])
-;;;; cperl-write-tags (&optional file erase recurse dir inbuffer)
-	   ["Create tags for current file" (cperl-write-tags nil t) t]
-	   ["Add tags for current file" (cperl-write-tags) t]
-	   ["Create tags for Perl files in directory"
-	    (cperl-write-tags nil t nil t) t]
-	   ["Add tags for Perl files in directory"
-	    (cperl-write-tags nil nil nil t) t]
-	   ["Create tags for Perl files in (sub)directories"
-	    (cperl-write-tags nil t t t) t]
-	   ["Add tags for Perl files in (sub)directories"
-	    (cperl-write-tags nil nil t t) t]))
-	 ("Perl docs"
-	  ["Define word at point" imenu-go-find-at-position 
-	   (fboundp 'imenu-go-find-at-position)]
-	  ["Help on function" cperl-info-on-command t]
-	  ["Help on function at point" cperl-info-on-current-command t]
-	  ["Help on symbol at point" cperl-get-help t]
-	  ["Perldoc" cperl-perldoc t]
-	  ["Perldoc on word at point" cperl-perldoc-at-point t]
-	  ["View manpage of POD in this file" cperl-build-manpage t]
-	  ["Auto-help on" cperl-lazy-install 
-	   (and (fboundp 'run-with-idle-timer)
-		(not cperl-lazy-installed))]
-	  ["Auto-help off" cperl-lazy-unstall
-	   (and (fboundp 'run-with-idle-timer)
-		cperl-lazy-installed)])
-	 ("Toggle..."
-	  ["Auto newline" cperl-toggle-auto-newline t]
-	  ["Electric parens" cperl-toggle-electric t]
-	  ["Electric keywords" cperl-toggle-abbrev t]
-	  ["Fix whitespace on indent" cperl-toggle-construct-fix t]
-	  ["Auto-help on Perl constructs" cperl-toggle-autohelp t]
-	  ["Auto fill" auto-fill-mode t]) 
-	 ("Indent styles..."
-	  ["CPerl" (cperl-set-style "CPerl") t]
-	  ["PerlStyle" (cperl-set-style "PerlStyle") t]
-	  ["GNU" (cperl-set-style "GNU") t]
-	  ["C++" (cperl-set-style "C++") t]
-	  ["FSF" (cperl-set-style "FSF") t]
-	  ["BSD" (cperl-set-style "BSD") t]
-	  ["Whitesmith" (cperl-set-style "Whitesmith") t]
-	  ["Current" (cperl-set-style "Current") t]
-	  ["Memorized" (cperl-set-style-back) cperl-old-style])
-	 ("Micro-docs"
-	  ["Tips" (describe-variable 'cperl-tips) t]
-	  ["Problems" (describe-variable 'cperl-problems) t]
-	  ["Non-problems" (describe-variable 'cperl-non-problems) t]
-	  ["Speed" (describe-variable 'cperl-speed) t]
-	  ["Praise" (describe-variable 'cperl-praise) t]
-	  ["Faces" (describe-variable 'cperl-tips-faces) t]
-	  ["CPerl mode" (describe-function 'cperl-mode) t]
-	  ["CPerl version" 
-	   (message "The version of master-file for this CPerl is %s" 
-		    cperl-version) t]))))
-  (error nil))
-
-(autoload 'c-macro-expand "cmacexp"
-  "Display the result of expanding all C macros occurring in the region.
-The expansion is entirely correct because it uses the C preprocessor."
-  t)
-
-(defvar cperl-imenu--function-name-regexp-perl
-  (concat
-   "^\\("
-	"[ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\(([^()]*)[ \t]*\\)?"
-   "\\|"
-	"=head\\([12]\\)[ \t]+\\([^\n]+\\)$"
-   "\\)"))
-
-(defvar cperl-outline-regexp
-  (concat cperl-imenu--function-name-regexp-perl "\\|" "\\`"))
-
-(defvar cperl-mode-syntax-table nil
-  "Syntax table in use in CPerl mode buffers.")
-
-(defvar cperl-string-syntax-table nil
-  "Syntax table in use in CPerl mode string-like chunks.")
-
-(if cperl-mode-syntax-table
-    ()
-  (setq cperl-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" cperl-mode-syntax-table)
-  (modify-syntax-entry ?/ "." cperl-mode-syntax-table)
-  (modify-syntax-entry ?* "." cperl-mode-syntax-table)
-  (modify-syntax-entry ?+ "." cperl-mode-syntax-table)
-  (modify-syntax-entry ?- "." cperl-mode-syntax-table)
-  (modify-syntax-entry ?= "." cperl-mode-syntax-table)
-  (modify-syntax-entry ?% "." cperl-mode-syntax-table)
-  (modify-syntax-entry ?< "." cperl-mode-syntax-table)
-  (modify-syntax-entry ?> "." cperl-mode-syntax-table)
-  (modify-syntax-entry ?& "." cperl-mode-syntax-table)
-  (modify-syntax-entry ?$ "\\" cperl-mode-syntax-table)
-  (modify-syntax-entry ?\n ">" cperl-mode-syntax-table)
-  (modify-syntax-entry ?# "<" cperl-mode-syntax-table)
-  (modify-syntax-entry ?' "\"" cperl-mode-syntax-table)
-  (modify-syntax-entry ?` "\"" cperl-mode-syntax-table)
-  (if cperl-under-as-char
-      (modify-syntax-entry ?_ "w" cperl-mode-syntax-table))
-  (modify-syntax-entry ?: "_" cperl-mode-syntax-table)
-  (modify-syntax-entry ?| "." cperl-mode-syntax-table)
-  (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table))
-  (modify-syntax-entry ?$ "." cperl-string-syntax-table)
-  (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment )
-
-
-
-;; provide an alias for working with emacs 19.  the perl-mode that comes
-;; with it is really bad, and this lets us seamlessly replace it.
-;;;###autoload
-(fset 'perl-mode 'cperl-mode)
-(defvar cperl-faces-init nil)
-;; Fix for msb.el
-(defvar cperl-msb-fixed nil)
-(defvar font-lock-syntactic-keywords)
-(defvar perl-font-lock-keywords)
-(defvar perl-font-lock-keywords-1)
-(defvar perl-font-lock-keywords-2)
-(defvar outline-level)
-(if (fboundp 'defvaralias)
-    (let ((f 'defvaralias)) ; Some functions deduce stuff from the mode name...
-      (funcall f 'cperl-font-lock-keywords   'perl-font-lock-keywords)
-      (funcall f 'cperl-font-lock-keywords-1 'perl-font-lock-keywords-1)
-      (funcall f 'cperl-font-lock-keywords-2 'perl-font-lock-keywords-2)))
-
-(defvar cperl-use-major-mode 'perl-mode)
-
-;;;###autoload
-(defun cperl-mode ()
-  "Major mode for editing Perl code.
-Expression and list commands understand all C brackets.
-Tab indents for Perl code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-
-Various characters in Perl almost always come in pairs: {}, (), [],
-sometimes <>.  When the user types the first, she gets the second as
-well, with optional special formatting done on {}.  (Disabled by
-default.)  You can always quote (with \\[quoted-insert]) the left
-\"paren\" to avoid the expansion.  The processing of < is special,
-since most the time you mean \"less\".  CPerl mode tries to guess
-whether you want to type pair <>, and inserts is if it
-appropriate.  You can set `cperl-electric-parens-string' to the string that
-contains the parenths from the above list you want to be electrical.
-Electricity of parenths is controlled by `cperl-electric-parens'.
-You may also set `cperl-electric-parens-mark' to have electric parens
-look for active mark and \"embrace\" a region if possible.'
-
-CPerl mode provides expansion of the Perl control constructs:
-
-   if, else, elsif, unless, while, until, continue, do,
-   for, foreach, formy and foreachmy.
-
-and POD directives (Disabled by default, see `cperl-electric-keywords'.)
-
-The user types the keyword immediately followed by a space, which
-causes the construct to be expanded, and the point is positioned where
-she is most likely to want to be.  eg. when the user types a space
-following \"if\" the following appears in the buffer: if () { or if ()
-} { } and the cursor is between the parentheses.  The user can then
-type some boolean expression within the parens.  Having done that,
-typing \\[cperl-linefeed] places you - appropriately indented - on a
-new line between the braces (if you typed \\[cperl-linefeed] in a POD
-directive line, then appropriate number of new lines is inserted).
-
-If CPerl decides that you want to insert \"English\" style construct like
-
-            bite if angry;
-
-it will not do any expansion.  See also help on variable
-`cperl-extra-newline-before-brace'.  (Note that one can switch the
-help message on expansion by setting `cperl-message-electric-keyword'
-to nil.)
-
-\\[cperl-linefeed] is a convenience replacement for typing carriage
-return.  It places you in the next line with proper indentation, or if
-you type it inside the inline block of control construct, like
-
-            foreach (@lines) {print; print}
-
-and you are on a boundary of a statement inside braces, it will
-transform the construct into a multiline and will place you into an
-appropriately indented blank line.  If you need a usual
-`newline-and-indent' behaviour, it is on \\[newline-and-indent],
-see documentation on `cperl-electric-linefeed'.
-
-Use \\[cperl-invert-if-unless] to change a construction of the form
-
-	    if (A) { B }
-
-into
-
-            B if A;
-
-\\{cperl-mode-map}
-
-Setting the variable `cperl-font-lock' to t switches on font-lock-mode
-\(even with older Emacsen), `cperl-electric-lbrace-space' to t switches
-on electric space between $ and {, `cperl-electric-parens-string' is
-the string that contains parentheses that should be electric in CPerl
-\(see also `cperl-electric-parens-mark' and `cperl-electric-parens'),
-setting `cperl-electric-keywords' enables electric expansion of
-control structures in CPerl.  `cperl-electric-linefeed' governs which
-one of two linefeed behavior is preferable.  You can enable all these
-options simultaneously (recommended mode of use) by setting
-`cperl-hairy' to t.  In this case you can switch separate options off
-by setting them to `null'.  Note that one may undo the extra
-whitespace inserted by semis and braces in `auto-newline'-mode by
-consequent \\[cperl-electric-backspace].
-
-If your site has perl5 documentation in info format, you can use commands
-\\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it.
-These keys run commands `cperl-info-on-current-command' and
-`cperl-info-on-command', which one is which is controlled by variable
-`cperl-info-on-command-no-prompt' and `cperl-clobber-lisp-bindings'
-\(in turn affected by `cperl-hairy').
-
-Even if you have no info-format documentation, short one-liner-style
-help is available on \\[cperl-get-help], and one can run perldoc or
-man via menu.
-
-It is possible to show this help automatically after some idle time.
-This is regulated by variable `cperl-lazy-help-time'.  Default with
-`cperl-hairy' (if the value of `cperl-lazy-help-time' is nil) is 5
-secs idle time .  It is also possible to switch this on/off from the
-menu, or via \\[cperl-toggle-autohelp].  Requires `run-with-idle-timer'.
-
-Use \\[cperl-lineup] to vertically lineup some construction - put the
-beginning of the region at the start of construction, and make region
-span the needed amount of lines.
-
-Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
-`cperl-pod-face', `cperl-pod-head-face' control processing of POD and
-here-docs sections.  With capable Emaxen results of scan are used
-for indentation too, otherwise they are used for highlighting only.
-
-Variables controlling indentation style:
- `cperl-tab-always-indent'
-    Non-nil means TAB in CPerl mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- `cperl-indent-left-aligned-comments'
-    Non-nil means that the comment starting in leftmost column should indent.
- `cperl-auto-newline'
-    Non-nil means automatically newline before and after braces,
-    and after colons and semicolons, inserted in Perl code.  The following
-    \\[cperl-electric-backspace] will remove the inserted whitespace.
-    Insertion after colons requires both this variable and
-    `cperl-auto-newline-after-colon' set.
- `cperl-auto-newline-after-colon'
-    Non-nil means automatically newline even after colons.
-    Subject to `cperl-auto-newline' setting.
- `cperl-indent-level'
-    Indentation of Perl statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- `cperl-continued-statement-offset'
-    Extra indentation given to a substatement, such as the
-    then-clause of an if, or body of a while, or just a statement continuation.
- `cperl-continued-brace-offset'
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to `cperl-continued-statement-offset'.
- `cperl-brace-offset'
-    Extra indentation for line if it starts with an open brace.
- `cperl-brace-imaginary-offset'
-    An open brace following other text is treated as if it the line started
-    this far to the right of the actual line indentation.
- `cperl-label-offset'
-    Extra indentation for line that is a label.
- `cperl-min-label-indent'
-    Minimal indentation for line that is a label.
-
-Settings for K&R and BSD indentation styles are
-  `cperl-indent-level'                5    8
-  `cperl-continued-statement-offset'  5    8
-  `cperl-brace-offset'               -5   -8
-  `cperl-label-offset'               -5   -8
-
-CPerl knows several indentation styles, and may bulk set the
-corresponding variables.  Use \\[cperl-set-style] to do this.  Use
-\\[cperl-set-style-back] to restore the memorized preexisting values
-\(both available from menu).
-
-If `cperl-indent-level' is 0, the statement after opening brace in
-column 0 is indented on
-`cperl-brace-offset'+`cperl-continued-statement-offset'.
-
-Turning on CPerl mode calls the hooks in the variable `cperl-mode-hook'
-with no args.
-
-DO NOT FORGET to read micro-docs (available from `Perl' menu)
-or as help on variables `cperl-tips', `cperl-problems',
-`cperl-non-problems', `cperl-praise', `cperl-speed'."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map cperl-mode-map)
-  (if (cperl-val 'cperl-electric-linefeed)
-      (progn
-	(local-set-key "\C-J" 'cperl-linefeed)
-	(local-set-key "\C-C\C-J" 'newline-and-indent)))
-  (if (and
-       (cperl-val 'cperl-clobber-lisp-bindings)
-       (cperl-val 'cperl-info-on-command-no-prompt))
-      (progn
-	;; don't clobber the backspace binding:
-	(cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f])
-	(cperl-define-key "\C-c\C-hf" 'cperl-info-on-command
-			  [(control c) (control h) f])))
-  (setq major-mode cperl-use-major-mode)
-  (setq mode-name "CPerl")
-  (if (not cperl-mode-abbrev-table)
-      (let ((prev-a-c abbrevs-changed))
-	(define-abbrev-table 'cperl-mode-abbrev-table '(
-		("if" "if" cperl-electric-keyword 0)
-		("elsif" "elsif" cperl-electric-keyword 0)
-		("while" "while" cperl-electric-keyword 0)
-		("until" "until" cperl-electric-keyword 0)
-		("unless" "unless" cperl-electric-keyword 0)
-		("else" "else" cperl-electric-else 0)
-		("continue" "continue" cperl-electric-else 0)
-		("for" "for" cperl-electric-keyword 0)
-		("foreach" "foreach" cperl-electric-keyword 0)
-		("formy" "formy" cperl-electric-keyword 0)
-		("foreachmy" "foreachmy" cperl-electric-keyword 0)
-		("do" "do" cperl-electric-keyword 0)
-		("=pod" "=pod" cperl-electric-pod 0)
-		("=over" "=over" cperl-electric-pod 0)
-		("=head1" "=head1" cperl-electric-pod 0)
-		("=head2" "=head2" cperl-electric-pod 0)
-		("pod" "pod" cperl-electric-pod 0)
-		("over" "over" cperl-electric-pod 0)
-		("head1" "head1" cperl-electric-pod 0)
-		("head2" "head2" cperl-electric-pod 0)))
-	(setq abbrevs-changed prev-a-c)))
-  (setq local-abbrev-table cperl-mode-abbrev-table)
-  (abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0))
-  (set-syntax-table cperl-mode-syntax-table)
-  (make-local-variable 'outline-regexp)
-  ;; (setq outline-regexp imenu-example--function-name-regexp-perl)
-  (setq outline-regexp cperl-outline-regexp)
-  (make-local-variable 'outline-level)
-  (setq outline-level 'cperl-outline-level)
-  (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)
-  ;; XEmacs addition
-  (when cperl-xemacs-p
-    (make-local-variable 'paren-backwards-message)
-    (setq paren-backwards-message t))
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'cperl-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column cperl-comment-column)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+ *")
-  (make-local-variable 'defun-prompt-regexp)
-  (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)\\([ \t]*([^()]*)[ \t]*\\)?[ \t]*")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'cperl-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (make-local-variable 'indent-region-function)
-  (setq indent-region-function 'cperl-indent-region)
-  ;;(setq auto-fill-function 'cperl-do-auto-fill) ; Need to switch on and off!
-  (make-local-variable 'imenu-create-index-function)
-  (setq imenu-create-index-function
-	(function cperl-imenu--create-perl-index))
-  (make-local-variable 'imenu-sort-function)
-  (setq imenu-sort-function nil)
-  (make-local-variable 'vc-header-alist)
-  (set 'vc-header-alist cperl-vc-header-alist) ; Avoid warning
-  (make-local-variable 'font-lock-defaults)
-  (setq	font-lock-defaults
-	(cond
-	 ((string< emacs-version "19.30")
-	  '(perl-font-lock-keywords-2))
-	 ((string< emacs-version "19.33") ; Which one to use?
-	  '((perl-font-lock-keywords
-	     perl-font-lock-keywords-1
-	     perl-font-lock-keywords-2)))
-	 (t
-	  '((cperl-load-font-lock-keywords
-	     cperl-load-font-lock-keywords-1
-	     cperl-load-font-lock-keywords-2)))))
-  (make-local-variable 'cperl-syntax-state)
-  (if cperl-use-syntax-table-text-property
-      (progn
-	(make-local-variable 'parse-sexp-lookup-properties)
-	;; Do not introduce variable if not needed, we check it!
-	(set 'parse-sexp-lookup-properties t)
-	;; Fix broken font-lock:
-	(or (boundp 'font-lock-unfontify-region-function)
-	    (set 'font-lock-unfontify-region-function
-		 'font-lock-default-unfontify-region))
-        ;; XEmacs change: no unfontify stuff
-	(unless cperl-xemacs-p
-	  (make-local-variable 'font-lock-unfontify-region-function)
-	  (set 'font-lock-unfontify-region-function ;not present with old Emacs
-	       'cperl-font-lock-unfontify-region-function))
-	(make-local-variable 'cperl-syntax-done-to)
-	;; Another bug: unless font-lock-syntactic-keywords, font-lock
-	;;  ignores syntax-table text-property.  (t) is a hack
-	;;  to make font-lock think that font-lock-syntactic-keywords
-	;;  are defined
-	(make-local-variable 'font-lock-syntactic-keywords)
-	(setq font-lock-syntactic-keywords
-	      (if cperl-syntaxify-by-font-lock
-		  '(t (cperl-fontify-syntaxically))
-		'(t)))))
-  (make-local-variable 'cperl-old-style)
-  ;; XEmacs addition: set fill-paragraph-function.  Note that older versions
-  ;; of our fill.el don't buffer-localize it.
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'cperl-fill-paragraph)
-  (if (boundp 'normal-auto-fill-function) ; 19.33 and later
-      (set (make-local-variable 'normal-auto-fill-function)
-	   'cperl-do-auto-fill)	      ; RMS has it as #'cperl-do-auto-fill ???
-    (or (fboundp 'cperl-old-auto-fill-mode)
-	(progn
-	  (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
-	  (defun auto-fill-mode (&optional arg)
-	    (interactive "P")
-	    (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning
-	    (and auto-fill-function (memq major-mode '(perl-mode cperl-mode))
-		 (setq auto-fill-function 'cperl-do-auto-fill))))))
-  (if (cperl-enable-font-lock)
-      (if (cperl-val 'cperl-font-lock)
-	  (progn (or cperl-faces-init (cperl-init-faces))
-		 (font-lock-mode 1))))
-  (and (boundp 'msb-menu-cond)
-       (not cperl-msb-fixed)
-       (cperl-msb-fix))
-  (if (featurep 'easymenu)
-      (easy-menu-add cperl-menu))	; A NOP in Emacs.
-  (run-hooks 'cperl-mode-hook)
-  ;; After hooks since fontification will break this
-  (if cperl-pod-here-scan
-      (or cperl-syntaxify-by-font-lock
-       (progn (or cperl-faces-init (cperl-init-faces-weak))
-	      (cperl-find-pods-heres)))))
-
-;; Fix for perldb - make default reasonable
-(defun cperl-db ()
-  (interactive)
-  (require 'gud)
-  (perldb (read-from-minibuffer "Run perldb (like this): "
-				(if (consp gud-perldb-history)
-				    (car gud-perldb-history)
-				  (concat "perl " ;;(file-name-nondirectory
-					  ;; I have problems
-					  ;; in OS/2
-					  ;; otherwise
-					  (buffer-file-name)))
-				nil nil
-				'(gud-perldb-history . 1))))
-
-(defun cperl-msb-fix ()
-  ;; Adds perl files to msb menu, supposes that msb is already loaded
-  (setq cperl-msb-fixed t)
-  (let* ((l (length msb-menu-cond))
-	 (last (nth (1- l) msb-menu-cond))
-	 (precdr (nthcdr (- l 2) msb-menu-cond)) ; cdr of this is last
-	 (handle (1- (nth 1 last))))
-    (setcdr precdr (list
-		    (list
-		     '(memq major-mode '(cperl-mode perl-mode))
-		     handle
-		     "Perl Files (%d)")
-		    last))))
-
-;; This is used by indent-for-comment
-;; to decide how much to indent a comment in CPerl code
-;; based on its context.  Do fallback if comment is found wrong.
-
-(defvar cperl-wrong-comment)
-(defvar cperl-st-cfence '(14))		; Comment-fence
-(defvar cperl-st-sfence '(15))		; String-fence
-(defvar cperl-st-punct '(1))
-(defvar cperl-st-word '(2))
-(defvar cperl-st-bra '(4 . ?\>))
-(defvar cperl-st-ket '(5 . ?\<))
-
-
-(defun cperl-comment-indent ()
-  (let ((p (point)) (c (current-column)) was phony)
-    (if (looking-at "^#") 0		; Existing comment at bol stays there.
-      ;; Wrong comment found
-      (save-excursion
-	(setq was (cperl-to-comment-or-eol)
-	      phony (eq (get-text-property (point) 'syntax-table)
-			cperl-st-cfence))
-	(if phony
-	    (progn
-	      (re-search-forward "#\\|$") ; Hmm, what about embedded #?
-	      (if (eq (preceding-char) ?\#)
-		  (forward-char -1))
-	      (setq was nil)))
-	(if (= (point) p)
-	    (progn
-	      (skip-chars-backward " \t")
-	      (max (1+ (current-column)) ; Else indent at comment column
-		   comment-column))
-	  (if was nil
-	    (insert comment-start)
-	    (backward-char (length comment-start)))
-	  (setq cperl-wrong-comment t)
-	  (indent-to comment-column 1)	; Indent minimum 1
-	  c)))))			; except leave at least one space.
-
-;;;(defun cperl-comment-indent-fallback ()
-;;;  "Is called if the standard comment-search procedure fails.
-;;;Point is at start of real comment."
-;;;  (let ((c (current-column)) target cnt prevc)
-;;;    (if (= c comment-column) nil
-;;;      (setq cnt (skip-chars-backward "[ \t]"))
-;;;      (setq target (max (1+ (setq prevc
-;;;			     (current-column))) ; Else indent at comment column
-;;;		   comment-column))
-;;;      (if (= c comment-column) nil
-;;;	(delete-backward-char cnt)
-;;;	(while (< prevc target)
-;;;	  (insert "\t")
-;;;	  (setq prevc (current-column)))
-;;;	(if (> prevc target) (progn (delete-char -1) (setq prevc (current-column))))
-;;;	(while (< prevc target)
-;;;	  (insert " ")
-;;;	  (setq prevc (current-column)))))))
-
-(defun cperl-indent-for-comment ()
-  "Substitute for `indent-for-comment' in CPerl."
-  (interactive)
-  (let (cperl-wrong-comment)
-    (indent-for-comment)
-    (if cperl-wrong-comment
-	(progn (cperl-to-comment-or-eol)
-	       (forward-char (length comment-start))))))
-
-(defun cperl-comment-region (b e arg)
-  "Comment or uncomment each line in the region in CPerl mode.
-See `comment-region'."
-  (interactive "r\np")
-  (let ((comment-start "#"))
-    (comment-region b e arg)))
-
-(defun cperl-uncomment-region (b e arg)
-  "Uncomment or comment each line in the region in CPerl mode.
-See `comment-region'."
-  (interactive "r\np")
-  (let ((comment-start "#"))
-    (comment-region b e (- arg))))
-
-(defvar cperl-brace-recursing nil)
-
-(defun cperl-electric-brace (arg &optional only-before)
-  "Insert character and correct line's indentation.
-If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the
-place (even in empty line), but not after.  If after \")\" and the inserted
-char is \"{\", insert extra newline before only if
-`cperl-extra-newline-before-brace'."
-  (interactive "P")
-  (let (insertpos
-	(other-end (if (and cperl-electric-parens-mark
-			    (cperl-mark-active)
-			    (< (mark) (point)))
-		       (mark)
-		     nil)))
-    (if (and other-end
-	     (not cperl-brace-recursing)
-	     (cperl-val 'cperl-electric-parens)
-	     (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point)))
-	;; Need to insert a matching pair
-	(progn
-	  (save-excursion
-	    (setq insertpos (point-marker))
-	    (goto-char other-end)
-	    (setq last-command-char ?\{)
-	    (cperl-electric-lbrace arg insertpos))
-	  (forward-char 1))
-      ;; Check whether we close something "usual" with `}'
-      (if (and (eq last-command-char ?\})
-	       (not
-		(condition-case nil
-		    (save-excursion
-		      (up-list (- (prefix-numeric-value arg)))
-		      ;;(cperl-after-block-p (point-min))
-		      (or (cperl-after-expr-p nil "{;)")
-			  ;; after sub, else, continue
-			  (cperl-after-block-p nil 'pre)))
-		  (error nil))))
-	  ;; Just insert the guy
-	  (self-insert-command (prefix-numeric-value arg))
-	(if (and (not arg)		; No args, end (of empty line or auto)
-		 (eolp)
-		 (or (and (null only-before)
-			  (save-excursion
-			    (skip-chars-backward " \t")
-			    (bolp)))
-		     (and (eq last-command-char ?\{) ; Do not insert newline
-			  ;; if after ")" and `cperl-extra-newline-before-brace'
-			  ;; is nil, do not insert extra newline.
-			  (not cperl-extra-newline-before-brace)
-			  (save-excursion
-			    (skip-chars-backward " \t")
-			    (eq (preceding-char) ?\))))
-		     (if cperl-auto-newline
-			 (progn (cperl-indent-line) (newline) t) nil)))
-	    (progn
-	      (self-insert-command (prefix-numeric-value arg))
-	      (cperl-indent-line)
-	      (if cperl-auto-newline
-		  (setq insertpos (1- (point))))
-	      (if (and cperl-auto-newline (null only-before))
-		  (progn
-		    (newline)
-		    (cperl-indent-line)))
-	      (save-excursion
-		(if insertpos (progn (goto-char insertpos)
-				     (search-forward (make-string
-						      1 last-command-char))
-				     (setq insertpos (1- (point)))))
-		(delete-char -1))))
-	(if insertpos
-	    (save-excursion
-	      (goto-char insertpos)
-	      (self-insert-command (prefix-numeric-value arg)))
-	  (self-insert-command (prefix-numeric-value arg)))))))
-
-(defun cperl-electric-lbrace (arg &optional end)
-  "Insert character, correct line's indentation, correct quoting by space."
-  (interactive "P")
-  (let ((cperl-brace-recursing t)
-	(cperl-auto-newline cperl-auto-newline)
-	(other-end (or end
-		       (if (and cperl-electric-parens-mark
-				(cperl-mark-active)
-				(> (mark) (point)))
-			   (save-excursion
-			     (goto-char (mark))
-			     (point-marker))
-			 nil)))
-	pos after)
-    (and (cperl-val 'cperl-electric-lbrace-space)
-	 (eq (preceding-char) ?$)
-	 (save-excursion
-	   (skip-chars-backward "$")
-	   (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)"))
-	 (insert ?\ ))
-    ;; Check whether we are in comment
-    (if (and
-	 (save-excursion
-	   (beginning-of-line)
-	   (not (looking-at "[ \t]*#")))
-	 (cperl-after-expr-p nil "{;)"))
-	nil
-      (setq cperl-auto-newline nil))
-    (cperl-electric-brace arg)
-    (and (cperl-val 'cperl-electric-parens)
-	 (eq last-command-char ?{)
-	 (memq last-command-char
-	       (append cperl-electric-parens-string nil))
-	 (or (if other-end (goto-char (marker-position other-end)))
-	     t)
-	 (setq last-command-char ?} pos (point))
-	 (progn (cperl-electric-brace arg t)
-		(goto-char pos)))))
-
-(defun cperl-electric-paren (arg)
-  "Insert an opening parenthesis or a matching pair of parentheses.
-See `cperl-electric-parens'."
-  (interactive "P")
-  (let ((beg (save-excursion (beginning-of-line) (point)))
-	(other-end (if (and cperl-electric-parens-mark
-			    (cperl-mark-active)
-			    (> (mark) (point)))
-		       (save-excursion
-			 (goto-char (mark))
-			 (point-marker))
-		     nil)))
-    (if (and (cperl-val 'cperl-electric-parens)
-	     (memq last-command-char
-		   (append cperl-electric-parens-string nil))
-	     (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
-	     ;;(not (save-excursion (search-backward "#" beg t)))
-	     (if (eq last-command-char ?<)
-		 (progn
-		   (and abbrev-mode ; later it is too late, may be after `for'
-			(expand-abbrev))
-		   (cperl-after-expr-p nil "{;(,:="))
-	       1))
-	(progn
-	  (self-insert-command (prefix-numeric-value arg))
-	  (if other-end (goto-char (marker-position other-end)))
-	  (insert (make-string
-		   (prefix-numeric-value arg)
-		   (cdr (assoc last-command-char '((?{ .?})
-						   (?[ . ?])
-						   (?( . ?))
-						   (?< . ?>))))))
-	  (forward-char (- (prefix-numeric-value arg))))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun cperl-electric-rparen (arg)
-  "Insert a matching pair of parentheses if marking is active.
-If not, or if we are not at the end of marking range, would self-insert.
-Affected by `cperl-electric-parens'."
-  (interactive "P")
-  (let ((beg (save-excursion (beginning-of-line) (point)))
-	(other-end (if (and cperl-electric-parens-mark
-			    (cperl-val 'cperl-electric-parens)
-			    (memq last-command-char
-				  (append cperl-electric-parens-string nil))
-			    (cperl-mark-active)
-			    (< (mark) (point)))
-		       (mark)
-		     nil))
-	p)
-    (if (and other-end
-	     (cperl-val 'cperl-electric-parens)
-	     (memq last-command-char '( ?\) ?\] ?\} ?\> ))
-	     (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
-	     ;;(not (save-excursion (search-backward "#" beg t)))
-	     )
-	(progn
-	  (self-insert-command (prefix-numeric-value arg))
-	  (setq p (point))
-	  (if other-end (goto-char other-end))
-	  (insert (make-string
-		   (prefix-numeric-value arg)
-		   (cdr (assoc last-command-char '((?\} . ?\{)
-						   (?\] . ?\[)
-						   (?\) . ?\()
-						   (?\> . ?\<))))))
-	  (goto-char (1+ p)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun cperl-electric-keyword ()
-  "Insert a construction appropriate after a keyword.
-Help message may be switched off by setting `cperl-message-electric-keyword'
-to nil."
-  (let ((beg (save-excursion (beginning-of-line) (point)))
-	(dollar (and (eq last-command-char ?$)
-		     (eq this-command 'self-insert-command)))
-	(delete (and (memq last-command-char '(?\ ?\n ?\t ?\f))
-		     (memq this-command '(self-insert-command newline))))
-	my do)
-    (and (save-excursion
-	   (condition-case nil
-	       (progn
-		 (backward-sexp 1)
-		 (setq do (looking-at "do\\>")))
-	     (error nil))
-	   (cperl-after-expr-p nil "{;:"))
-	 (save-excursion
-	   (not
-	    (re-search-backward
-	     "[#\"'`]\\|\\"
-	     beg t)))
-	 (save-excursion (or (not (re-search-backward "^=" nil t))
-			     (or
-			      (looking-at "=cut")
-			      (and cperl-use-syntax-table-text-property
-				   (not (eq (get-text-property (point)
-							       'syntax-type)
-					    'pod))))))
-	 (save-excursion (forward-sexp -1) 
-			 (not (memq (following-char) (append "$@%&*" nil))))
-	 (progn
-	   (and (eq (preceding-char) ?y)
-		(progn			; "foreachmy"
-		  (forward-char -2)
-		  (insert " ")
-		  (forward-char 2)
-		  (setq my t dollar t
-			delete
-			(memq this-command '(self-insert-command newline)))))
-	   (and dollar (insert " $"))
-	   (cperl-indent-line)
-	   ;;(insert " () {\n}")
- 	   (cond
- 	    (cperl-extra-newline-before-brace
- 	     (insert (if do "\n" " ()\n"))
- 	     (insert "{")
- 	     (cperl-indent-line)
- 	     (insert "\n")
- 	     (cperl-indent-line)
- 	     (insert "\n}")
-	     (and do (insert " while ();")))
- 	    (t
- 	     (insert (if do " {\n} while ();" " () {\n}"))))
-	   (or (looking-at "[ \t]\\|$") (insert " "))
-	   (cperl-indent-line)
-	   (if dollar (progn (search-backward "$")
-			     (if my
-				 (forward-char 1)
-			       (delete-char 1)))
-	     (search-backward ")")
-	     (if (eq last-command-char ?\()
-		 (progn			; Avoid "if (())"
-		   (delete-backward-char 1)
-		   (delete-backward-char -1))))
-	   (if delete
-	       (cperl-putback-char cperl-del-back-ch))
-	   (if cperl-message-electric-keyword
-	       (message "Precede char by C-q to avoid expansion"))))))
-
-(defun cperl-ensure-newlines (n &optional pos)
-  "Make sure there are N newlines after the point."
-  (or pos (setq pos (point)))
-  (if (looking-at "\n")
-      (forward-char 1)
-    (insert "\n"))
-  (if (> n 1)
-      (cperl-ensure-newlines (1- n) pos)
-    (goto-char pos)))
-
-(defun cperl-electric-pod ()
-  "Insert a POD chunk appropriate after a =POD directive."
-  (let ((delete (and (memq last-command-char '(?\ ?\n ?\t ?\f))
-		     (memq this-command '(self-insert-command newline))))
-	head1 notlast name p really-delete over)
-    (and (save-excursion
-	   (forward-word -1)
-	   (and
-	    (eq (preceding-char) ?=)
-	    (progn
-	      (setq head1 (looking-at "head1\\>[ \t]*$"))
-	      (setq over (and (looking-at "over\\>[ \t]*$")
-			      (not (looking-at "over[ \t]*\n\n\n*=item\\>"))))
-	      (forward-char -1)
-	      (bolp))
-	    (or
-	     (get-text-property (point) 'in-pod)
-	     (cperl-after-expr-p nil "{;:")
-	     (and (re-search-backward
-		   ;; "\\(\\`\n?\\|\n\n\\)=\\sw+"
-		   "\\(\\`\n?\\|^\n\\)=\\sw+"
-		   (point-min) t)
-		  (not (or
-			(looking-at "=cut")
-			(and cperl-use-syntax-table-text-property
-			     (not (eq (get-text-property (point) 'syntax-type)
-				      'pod)))))))))
-	 (progn
-	   (save-excursion
-	     (setq notlast (re-search-forward "^\n=" nil t)))
-	   (or notlast
-	       (progn
-		 (insert "\n\n=cut")
-		 (cperl-ensure-newlines 2)
-		 (forward-word -2)
-		 (if (and head1
-			  (not
-			   (save-excursion
-			     (forward-char -1)
-			     (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\>"
-						 nil t)))) ; Only one
-		     (progn
-		       (forward-word 1)
-		       (setq name (file-name-sans-extension
-				   (file-name-nondirectory (buffer-file-name)))
-			     p (point))
-		       (insert " NAME\n\n" name
-			       " - \n\n=head1 SYNOPSIS\n\n\n\n"
-			       "=head1 DESCRIPTION")
-		       (cperl-ensure-newlines 4)
-		       (goto-char p)
-		       (forward-word 2)
-		       (end-of-line)
-		       (setq really-delete t))
-		   (forward-word 1))))
-	   (if over
-	       (progn
-		 (setq p (point))
-		 (insert "\n\n=item \n\n\n\n"
-			 "=back")
-		 (cperl-ensure-newlines 2)
-		 (goto-char p)
-		 (forward-word 1)
-		 (end-of-line)
-		 (setq really-delete t)))
-	   (if (and delete really-delete)
-	       (cperl-putback-char cperl-del-back-ch))))))
-
-(defun cperl-electric-else ()
-  "Insert a construction appropriate after a keyword.
-Help message may be switched off by setting `cperl-message-electric-keyword'
-to nil."
-  (let ((beg (save-excursion (beginning-of-line) (point))))
-    (and (save-excursion
-	   (backward-sexp 1)
-	   (cperl-after-expr-p nil "{;:"))
-	 (save-excursion
-	   (not
-	    (re-search-backward
-	     "[#\"'`]\\|\\"
-	     beg t)))
-	 (save-excursion (or (not (re-search-backward "^=" nil t))
-			     (looking-at "=cut")
-			     (and cperl-use-syntax-table-text-property
-				  (not (eq (get-text-property (point)
-							      'syntax-type)
-					   'pod)))))
-	 (progn
-	   (cperl-indent-line)
-	   ;;(insert " {\n\n}")
- 	   (cond
- 	    (cperl-extra-newline-before-brace
- 	     (insert "\n")
- 	     (insert "{")
- 	     (cperl-indent-line)
- 	     (insert "\n\n}"))
- 	    (t
- 	     (insert " {\n\n}")))
-	   (or (looking-at "[ \t]\\|$") (insert " "))
-	   (cperl-indent-line)
-	   (forward-line -1)
-	   (cperl-indent-line)
-	   (cperl-putback-char cperl-del-back-ch)
-	   (setq this-command 'cperl-electric-else)
-	   (if cperl-message-electric-keyword
-	       (message "Precede char by C-q to avoid expansion"))))))
-
-(defun cperl-linefeed ()
-  "Go to end of line, open a new line and indent appropriately.
-If in POD, insert appropriate lines."
-  (interactive)
-  (let ((beg (save-excursion (beginning-of-line) (point)))
-	(end (save-excursion (end-of-line) (point)))
-	(pos (point)) start over cut res)
-    (if (and				; Check if we need to split:
-					; i.e., on a boundary and inside "{...}"
-	 (save-excursion (cperl-to-comment-or-eol)
-			 (>= (point) pos)) ; Not in a comment
-	 (or (save-excursion
-	       (skip-chars-backward " \t" beg)
-	       (forward-char -1)
-	       (looking-at "[;{]"))     ; After { or ; + spaces
-	     (looking-at "[ \t]*}")	; Before }
-	     (re-search-forward "\\=[ \t]*;" end t)) ; Before spaces + ;
-	 (save-excursion
-	   (and
-	    (eq (car (parse-partial-sexp pos end -1)) -1)
-					; Leave the level of parens
-	    (looking-at "[,; \t]*\\($\\|#\\)") ; Comma to allow anon subr
-					; Are at end
-	    (cperl-after-block-p (point-min))
-	    (progn
-	      (backward-sexp 1)
-	      (setq start (point-marker))
-	      (<= start pos)))))	; Redundant?  Are after the
-					; start of parens group.
-	(progn
-	  (skip-chars-backward " \t")
-	  (or (memq (preceding-char) (append ";{" nil))
-	      (insert ";"))
-	  (insert "\n")
-	  (forward-line -1)
-	  (cperl-indent-line)
-	  (goto-char start)
-	  (or (looking-at "{[ \t]*$")	; If there is a statement
-					; before, move it to separate line
-	      (progn
-		(forward-char 1)
-		(insert "\n")
-		(cperl-indent-line)))
-	  (forward-line 1)		; We are on the target line
-	  (cperl-indent-line)
-	  (beginning-of-line)
-	  (or (looking-at "[ \t]*}[,; \t]*$") ; If there is a statement
-					; after, move it to separate line
-	      (progn
-		(end-of-line)
-		(search-backward "}" beg)
-		(skip-chars-backward " \t")
-		(or (memq (preceding-char) (append ";{" nil))
-		    (insert ";"))
-		(insert "\n")
-		(cperl-indent-line)
-		(forward-line -1)))
-	  (forward-line -1)		; We are on the line before target
-	  (end-of-line)
-	  (newline-and-indent))
-      (end-of-line)			; else - no splitting
-      (cond
-       ((and (looking-at "\n[ \t]*{$")
-	     (save-excursion
-	       (skip-chars-backward " \t")
-	       (eq (preceding-char) ?\)))) ; Probably if () {} group
-					; with an extra newline.
-	(forward-line 2)
-	(cperl-indent-line))
-       ((save-excursion			; In POD header
-	  (forward-paragraph -1)
-	  ;; (re-search-backward "\\(\\`\n?\\|\n\n\\)=head1\\b")
-	  ;; We are after \n now, so look for the rest
-	  (if (looking-at "\\(\\`\n?\\|\n\\)=\\sw+")
-	      (progn
-		(setq cut (looking-at "\\(\\`\n?\\|\n\\)=cut\\>"))
-		(setq over (looking-at "\\(\\`\n?\\|\n\\)=over\\>"))
-		t)))
-	(if (and over
-		 (progn
-		   (forward-paragraph -1)
-		   (forward-word 1)
-		   (setq pos (point))
-		   (setq cut (buffer-substring (point)
-					       (save-excursion
-						 (end-of-line)
-						 (point))))
-		   (delete-char (- (save-excursion (end-of-line) (point))
-				   (point)))
-		   (setq res (expand-abbrev))
-		   (save-excursion
-		     (goto-char pos)
-		     (insert cut))
-		   res))
-	    nil
-	  (cperl-ensure-newlines (if cut 2 4))
-	  (forward-line 2)))
-       ((get-text-property (point) 'in-pod) ; In POD section
-	(cperl-ensure-newlines 4)
-	(forward-line 2))
-       ((looking-at "\n[ \t]*$")	; Next line is empty - use it.
-        (forward-line 1)
-	(cperl-indent-line))
-       (t
-	(newline-and-indent))))))
-
-(defun cperl-electric-semi (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (if cperl-auto-newline
-      (cperl-electric-terminator arg)
-    (self-insert-command (prefix-numeric-value arg))
-    (if cperl-autoindent-on-semi
-	(cperl-indent-line))))
-
-(defun cperl-electric-terminator (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (let ((end (point))
-	(auto (and cperl-auto-newline
-		   (or (not (eq last-command-char ?:))
-		       cperl-auto-newline-after-colon)))
-	insertpos)
-    (if (and ;;(not arg)
-	     (eolp)
-	     (not (save-excursion
-		    (beginning-of-line)
-		    (skip-chars-forward " \t")
-		    (or
-		     ;; Ignore in comment lines
-		     (= (following-char) ?#)
-		     ;; Colon is special only after a label
-		     ;; So quickly rule out most other uses of colon
-		     ;; and do no indentation for them.
-		     (and (eq last-command-char ?:)
-			  (save-excursion
-			    (forward-word 1)
-			    (skip-chars-forward " \t")
-			    (and (< (point) end)
-				 (progn (goto-char (- end 1))
-					(not (looking-at ":"))))))
-		     (progn
-		       (beginning-of-defun)
-		       (let ((pps (parse-partial-sexp (point) end)))
-			 (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))))
-	(progn
-	  (self-insert-command (prefix-numeric-value arg))
-	  ;;(forward-char -1)
-	  (if auto (setq insertpos (point-marker)))
-	  ;;(forward-char 1)
-	  (cperl-indent-line)
-	  (if auto
-	      (progn
-		(newline)
-		(cperl-indent-line)))
-	  (save-excursion
-	    (if insertpos (goto-char (1- (marker-position insertpos)))
-	      (forward-char -1))
-	    (delete-char 1))))
-    (if insertpos
-	(save-excursion
-	  (goto-char insertpos)
-	  (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun cperl-electric-backspace (arg)
-  "Backspace, or remove the whitespace around the point inserted by an electric
-key.  Will untabivy if `cperl-electric-backspace-untabify' is non-nil."
-  (interactive "p")
-  (if (and cperl-auto-newline
-	   (memq last-command '(cperl-electric-semi
-				cperl-electric-terminator
-				cperl-electric-lbrace))
-	   (memq (preceding-char) '(?\  ?\t ?\n)))
-      (let (p)
-	(if (eq last-command 'cperl-electric-lbrace)
-	    (skip-chars-forward " \t\n"))
-	(setq p (point))
-	(skip-chars-backward " \t\n")
-	(delete-region (point) p))
-    (and (eq last-command 'cperl-electric-else)
-	 ;; We are removing the whitespace *inside* cperl-electric-else
-	 (setq this-command 'cperl-electric-else-really))
-    (if (and cperl-auto-newline
-	     (eq last-command 'cperl-electric-else-really)
-	     (memq (preceding-char) '(?\  ?\t ?\n)))
-	(let (p)
-	  (skip-chars-forward " \t\n")
-	  (setq p (point))
-	  (skip-chars-backward " \t\n")
-	  (delete-region (point) p))
-      (if cperl-electric-backspace-untabify
-	  (backward-delete-char-untabify arg)
-	(delete-backward-char arg)))))
-
-;; XEmacs addition
-;; helper function for deletion, which honors the desired delete direction
-;; behavior.  Added by Gary D. Foster,  and bound
-;; to the 'delete keysym by default.
-(defun cperl-electric-delete (arg)
-  "Delete, or remove the whitespace inserted by an electric key.
-Delete direction is controlled by the setting of `delete-key-deletes-forward'."
-  (interactive "*p")
-  (if (and cperl-auto-newline
-	   (memq last-command '(cperl-electric-semi
-				cperl-electric-terminator
-				cperl-electric-lbrace))
-	   (memq (preceding-char) '(?  ?\t ?\n)))
-      (let (p)
-	(if (eq last-command 'cperl-electric-lbrace)
-	    (skip-chars-forward " \t\n"))
-	(setq p (point))
-	(skip-chars-backward " \t\n")
-	(delete-region (point) p))
-    (if (fboundp 'backward-or-forward-delete-char)
-	(backward-or-forward-delete-char arg)
-      (backward-delete-char-untabify arg))))
-
-(defun cperl-inside-parens-p ()
-  (condition-case ()
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region (point)
-			    (progn (beginning-of-defun) (point)))
-	  (goto-char (point-max))
-	  (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
-    (error nil)))
-
-(defun cperl-indent-command (&optional whole-exp)
-  "Indent current line as Perl code, or in some cases insert a tab character.
-If `cperl-tab-always-indent' is non-nil (the default), always indent current
-line.  Otherwise, indent the current line only if point is at the left margin
-or in the line's indentation; otherwise insert a tab.
-
-A numeric argument, regardless of its value,
-means indent rigidly all the lines of the expression starting after point
-so that this line becomes properly indented.
-The relative indentation among the lines of the expression are preserved."
-  (interactive "P")
-  (cperl-update-syntaxification (point) (point))
-  (if whole-exp
-      ;; If arg, always indent this line as Perl
-      ;; and shift remaining lines of expression the same amount.
-      (let ((shift-amt (cperl-indent-line))
-	    beg end)
-	(save-excursion
-	  (if cperl-tab-always-indent
-	      (beginning-of-line))
-	  (setq beg (point))
-	  (forward-sexp 1)
-	  (setq end (point))
-	  (goto-char beg)
-	  (forward-line 1)
-	  (setq beg (point)))
-	(if (and shift-amt (> end beg))
-	    (indent-code-rigidly beg end shift-amt "#")))
-    (if (and (not cperl-tab-always-indent)
-	     (save-excursion
-	       (skip-chars-backward " \t")
-	       (not (bolp))))
-	(insert-tab)
-      (cperl-indent-line))))
-
-(defun cperl-indent-line (&optional parse-data)
-  "Indent current line as Perl code.
-Return the amount the indentation changed by."
-  (let ((case-fold-search nil)
-	(pos (- (point-max) (point)))
-	indent i beg shift-amt)
-    (setq indent (cperl-calculate-indent parse-data)
-	  i indent)
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((or (eq indent nil) (eq indent t))
-	   (setq indent (current-indentation) i nil))
-	  ;;((eq indent t)    ; Never?
-	  ;; (setq indent (cperl-calculate-indent-within-comment)))
-	  ;;((looking-at "[ \t]*#")
-	  ;; (setq indent 0))
-	  (t
-	   (skip-chars-forward " \t")
-	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((looking-at "[A-Za-z_][A-Za-z_0-9]*:[^:]")
-		  (and (> indent 0)
-		       (setq indent (max cperl-min-label-indent
-					 (+ indent cperl-label-offset)))))
-		 ((= (following-char) ?})
-		  (setq indent (- indent cperl-indent-level)))
-		 ((memq (following-char) '(?\) ?\])) ; To line up with opening paren.
-		  (setq indent (+ indent cperl-close-paren-offset)))
-		 ((= (following-char) ?{)
-		  (setq indent (+ indent cperl-brace-offset))))))
-    (skip-chars-forward " \t")
-    (setq shift-amt (and i (- indent (current-column))))
-    (if (or (not shift-amt)
-	    (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))
-
-(defun cperl-after-label ()
-  ;; Returns true if the point is after label.  Does not do save-excursion.
-  (and (eq (preceding-char) ?:)
-       (memq (char-syntax (char-after (- (point) 2)))
-	     '(?w ?_))
-       (progn
-	 (backward-sexp)
-	 (looking-at "[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))))
-
-(defun cperl-get-state (&optional parse-start start-state)
-  ;; returns list (START STATE DEPTH PRESTART),
-  ;; START is a good place to start parsing, or equal to
-  ;; PARSE-START if preset,
-  ;; STATE is what is returned by `parse-partial-sexp'.
-  ;; DEPTH is true is we are immediately after end of block
-  ;; which contains START.
-  ;; PRESTART is the position basing on which START was found.
-  (save-excursion
-    (let ((start-point (point)) depth state start prestart)
-      (if (and parse-start
-	       (<= parse-start start-point))
-	  (goto-char parse-start)
-	(beginning-of-defun)
-	(setq start-state nil))
-      (setq prestart (point))
-      (if start-state nil
-	;; Try to go out, if sub is not on the outermost level
-	(while (< (point) start-point)
-	  (setq start (point) parse-start start depth nil
-		state (parse-partial-sexp start start-point -1))
-	  (if (> (car state) -1) nil
-	    ;; The current line could start like }}}, so the indentation
-	    ;; corresponds to a different level than what we reached
-	    (setq depth t)
-	    (beginning-of-line 2)))	; Go to the next line.
-	(if start (goto-char start)))	; Not at the start of file
-      (setq start (point))
-      (or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
-      (list start state depth prestart))))
-
-(defun cperl-block-p ()		   ; Do not C-M-q !  One string contains ";" !
-  ;; Positions is before ?\{.  Checks whether it starts a block.
-  ;; No save-excursion!
-  (cperl-backward-to-noncomment (point-min))
-  (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label!  \C-@ at bobp
-					; Label may be mixed up with `$blah :'
-      (save-excursion (cperl-after-label))
-      (and (memq (char-syntax (preceding-char)) '(?w ?_))
-	   (progn
-	     (backward-sexp)
-	     ;; Need take into account `bless', `return', `tr',...
-	     (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax
-		      (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>")))
-		 (progn
-		   (skip-chars-backward " \t\n\f")
-		   (and (memq (char-syntax (preceding-char)) '(?w ?_))
-			(progn
-			  (backward-sexp)
-			  (looking-at
-			   "sub[ \t]+[a-zA-Z0-9_:]+[ \t\n\f]*\\(([^()]*)[ \t\n\f]*\\)?[#{]")))))))))
-
-(defvar cperl-look-for-prop '((pod in-pod) (here-doc-delim here-doc-group)))
-
-(defun cperl-calculate-indent (&optional parse-data) ; was parse-start
-  "Return appropriate indentation for current line as Perl code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment.
-
-Will not correct the indentation for labels, but will correct it for braces
-and closing parentheses and brackets."
-  (cperl-update-syntaxification (point) (point))
-  (save-excursion
-    (if (or
-	 (and (memq (get-text-property (point) 'syntax-type)
-		    '(pod here-doc here-doc-delim format))
-	      (not (get-text-property (point) 'indentable)))
-	 ;; before start of POD - whitespace found since do not have 'pod!
-	 (and (looking-at "[ \t]*\n=")
-	      (error "Spaces before POD section!"))
-	 (and (not cperl-indent-left-aligned-comments)
-	      (looking-at "^#")))
-	nil
-      (beginning-of-line)
-      (let ((indent-point (point))
-	    (char-after (save-excursion
-			  (skip-chars-forward " \t")
-			  (following-char)))
-	    (in-pod (get-text-property (point) 'in-pod))
-	    (pre-indent-point (point))
-	    p prop look-prop is-block delim)
-	(cond
-	 (in-pod
-	  ;; In the verbatim part, probably code example.  What to do???
-	  )
-	 (t
-	  (save-excursion
-	    ;; Not in POD
-	    (cperl-backward-to-noncomment nil)
-	    (setq p (max (point-min) (1- (point)))
-		  prop (get-text-property p 'syntax-type)
-		  look-prop (or (nth 1 (assoc prop cperl-look-for-prop))
-				'syntax-type))
-	    (if (memq prop '(pod here-doc format here-doc-delim))
-		(progn
-		  (goto-char (or (previous-single-property-change p look-prop)
-				 (point-min)))
-		  (beginning-of-line)
-		  (setq pre-indent-point (point)))))))
-	(goto-char pre-indent-point)
-	(let* ((case-fold-search nil)
-	       (s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
-	       (start (or (nth 2 parse-data)
-			  (nth 0 s-s)))
-	       (state (nth 1 s-s))
-	       (containing-sexp (car (cdr state)))
-	       old-indent)
-	  (if (and
-	       ;;containing-sexp		;; We are buggy at toplevel :-(
-	       parse-data)
-	      (progn
-		(setcar parse-data pre-indent-point)
-		(setcar (cdr parse-data) state)
-		(or (nth 2 parse-data)
-		    (setcar (cddr parse-data) start))
-		;; Before this point: end of statement
-		(setq old-indent (nth 3 parse-data))))
-	  (cond ((get-text-property (point) 'indentable)
-		 ;; indent to just after the surrounding open,
-		 ;; skip blanks if we do not close the expression.
-		 (goto-char (1+ (previous-single-property-change (point) 'indentable)))
-		 (or (memq char-after (append ")]}" nil))
-		     (looking-at "[ \t]*\\(#\\|$\\)")
-		     (skip-chars-forward " \t"))
-		 (current-column))
-		((or (nth 3 state) (nth 4 state))
-		 ;; return nil or t if should not change this line
-		 (nth 4 state))
-		;; XXXX Do we need to special-case this?
-		((null containing-sexp)
-		 ;; Line is at top level.  May be data or function definition,
-		 ;; or may be function argument declaration.
-		 ;; Indent like the previous top level line
-		 ;; unless that ends in a closeparen without semicolon,
-		 ;; in which case this line is the first argument decl.
-		 (skip-chars-forward " \t")
-		 (+ (save-excursion
-		      (goto-char start)
-		      (- (current-indentation)
-			 (if (nth 2 s-s) cperl-indent-level 0)))
-		    (if (= char-after ?{) cperl-continued-brace-offset 0)
-		    (progn
-		      (cperl-backward-to-noncomment (or old-indent (point-min)))
-		      ;; Look at previous line that's at column 0
-		      ;; to determine whether we are in top-level decls
-		      ;; or function's arg decls.  Set basic-indent accordingly.
-		      ;; Now add a little if this is a continuation line.
-		      (if (or (bobp)
-			      (eq (point) old-indent) ; old-indent was at comment
-			      (eq (preceding-char) ?\;)
-			      ;;  Had ?\) too
-			      (and (eq (preceding-char) ?\})
-				   (cperl-after-block-and-statement-beg
-				    (point-min))) ; Was start - too close
-			      (memq char-after (append ")]}" nil))
-			      (and (eq (preceding-char) ?\:) ; label
-				   (progn
-				     (forward-sexp -1)
-				     (skip-chars-backward " \t")
-				     (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:")))
-			      (get-text-property (point) 'first-format-line))
-			  (progn
-			    (if (and parse-data
-				     (not (eq char-after ?\C-j)))
-				(setcdr (cddr parse-data)
-					(list pre-indent-point)))
-			    0)
-			cperl-continued-statement-offset))))
-		((not
-		  (or (setq is-block
-			    (and (setq delim (= (char-after containing-sexp) ?{))
-				 (save-excursion ; Is it a hash?
-				   (goto-char containing-sexp)
-				   (cperl-block-p))))
-		      cperl-indent-parens-as-block))
-		 ;; group is an expression, not a block:
-		 ;; indent to just after the surrounding open parens,
-		 ;; skip blanks if we do not close the expression.
-		 (goto-char (1+ containing-sexp))
-		 (or (memq char-after
-			   (append (if delim "}" ")]}") nil))
-		     (looking-at "[ \t]*\\(#\\|$\\)")
-		     (skip-chars-forward " \t"))
-		 (+ (current-column)
-		    (if (and delim
-			     (eq char-after ?\}))
-			;; Correct indentation of trailing ?\}
-			(+ cperl-indent-level cperl-close-paren-offset)
-		      0)))
-;;;	      ((and (/= (char-after containing-sexp) ?{)
-;;;		    (not cperl-indent-parens-as-block))
-;;;	       ;; line is expression, not statement:
-;;;	       ;; indent to just after the surrounding open,
-;;;	       ;; skip blanks if we do not close the expression.
-;;;	       (goto-char (1+ containing-sexp))
-;;;	       (or (memq char-after (append ")]}" nil))
-;;;		   (looking-at "[ \t]*\\(#\\|$\\)")
-;;;		   (skip-chars-forward " \t"))
-;;;	       (current-column))
-;;;	      ((progn
-;;;		 ;; Containing-expr starts with \{.  Check whether it is a hash.
-;;;		 (goto-char containing-sexp)
-;;;		 (and (not (cperl-block-p))
-;;;		      (not cperl-indent-parens-as-block)))
-;;;	       (goto-char (1+ containing-sexp))
-;;;	       (or (eq char-after ?\})
-;;;		   (looking-at "[ \t]*\\(#\\|$\\)")
-;;;		   (skip-chars-forward " \t"))
-;;;	       (+ (current-column)	; Correct indentation of trailing ?\}
-;;;		  (if (eq char-after ?\}) (+ cperl-indent-level
-;;;					     cperl-close-paren-offset)
-;;;		    0)))
-		(t
-		 ;; Statement level.  Is it a continuation or a new statement?
-		 ;; Find previous non-comment character.
-		 (goto-char pre-indent-point)
-		 (cperl-backward-to-noncomment containing-sexp)
-		 ;; Back up over label lines, since they don't
-		 ;; affect whether our line is a continuation.
-		 ;; (Had \, too)
-		 (while	;;(or (eq (preceding-char) ?\,)
-		     (and (eq (preceding-char) ?:)
-			  (or ;;(eq (char-after (- (point) 2)) ?\') ; ????
-			   (memq (char-syntax (char-after (- (point) 2)))
-				 '(?w ?_))))
-		   ;;)
-		   (if (eq (preceding-char) ?\,)
-		       ;; Will go to beginning of line, essentially.
-		       ;; Will ignore embedded sexpr XXXX.
-		       (cperl-backward-to-start-of-continued-exp containing-sexp))
-		   (beginning-of-line)
-		   (cperl-backward-to-noncomment containing-sexp))
-		 ;; Now we get the answer.
-		 (if (not (or (eq (1- (point)) containing-sexp)
-			      (memq (preceding-char)
-				    (append (if is-block " ;{" " ,;{") '(nil)))
-			      (and (eq (preceding-char) ?\})
-				   (cperl-after-block-and-statement-beg
-				    containing-sexp))
-			      (get-text-property (point) 'first-format-line)))
-		     ;; This line is continuation of preceding line's statement;
-		     ;; indent  `cperl-continued-statement-offset'  more than the
-		     ;; previous line of the statement.
-		     ;;
-		     ;; There might be a label on this line, just
-		     ;; consider it bad style and ignore it.
-		     (progn
-		       (cperl-backward-to-start-of-continued-exp containing-sexp)
-		       (+ (if (memq char-after (append "}])" nil))
-			      0		; Closing parenth
-			    cperl-continued-statement-offset)
-			  (if (or is-block
-				  (not delim)
-				  (not (eq char-after ?\})))
-			      0
-			    ;; Now it is a hash reference
-			    (+ cperl-indent-level cperl-close-paren-offset))
-			  (if (looking-at "\\w+[ \t]*:")
-			      (if (> (current-indentation) cperl-min-label-indent)
-				  (- (current-indentation) cperl-label-offset)
-				;; Do not move `parse-data', this should
-				;; be quick anyway (this comment comes
-				;; from different location):
-				(cperl-calculate-indent))
-			    (current-column))
-			  (if (eq char-after ?\{)
-			      cperl-continued-brace-offset 0)))
-		   ;; This line starts a new statement.
-		   ;; Position following last unclosed open.
-		   (goto-char containing-sexp)
-		   ;; Is line first statement after an open-brace?
-		   (or
-		    ;; If no, find that first statement and indent like
-		    ;; it.  If the first statement begins with label, do
-		    ;; not believe when the indentation of the label is too
-		    ;; small.
-		    (save-excursion
-		      (forward-char 1)
-		      (setq old-indent (current-indentation))
-		      (let ((colon-line-end 0))
-			(while
-			    (progn (skip-chars-forward " \t\n")
-				   (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]"))
-			  ;; Skip over comments and labels following openbrace.
-			  (cond ((= (following-char) ?\#)
-				 (forward-line 1))
-				((= (following-char) ?\=)
-				 (goto-char
-				  (or (next-single-property-change (point) 'in-pod)
-				      (point-max)))) ; do not loop if no syntaxification
-				;; label:
-				(t
-				 (save-excursion (end-of-line)
-						 (setq colon-line-end (point)))
-				 (search-forward ":"))))
-			;; The first following code counts
-			;; if it is before the line we want to indent.
-			(and (< (point) indent-point)
-			     (if (> colon-line-end (point)) ; After label
-				 (if (> (current-indentation)
-					cperl-min-label-indent)
-				     (- (current-indentation) cperl-label-offset)
-				   ;; Do not believe: `max' is involved
-				   (+ old-indent cperl-indent-level))
-			       (current-column)))))
-		    ;; If no previous statement,
-		    ;; indent it relative to line brace is on.
-		    ;; For open brace in column zero, don't let statement
-		    ;; start there too.  If cperl-indent-level is zero,
-		    ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
-		    ;; For open-braces not the first thing in a line,
-		    ;; add in cperl-brace-imaginary-offset.
-
-		    ;; If first thing on a line:  ?????
-		    (+ (if (and (bolp) (zerop cperl-indent-level))
-			   (+ cperl-brace-offset cperl-continued-statement-offset)
-			 cperl-indent-level)
-		       (if (or is-block
-			       (not delim)
-			       (not (eq char-after ?\})))
-			   0
-			 ;; Now it is a hash reference
-			 (+ cperl-indent-level cperl-close-paren-offset))
-		       ;; Move back over whitespace before the openbrace.
-		       ;; If openbrace is not first nonwhite thing on the line,
-		       ;; add the cperl-brace-imaginary-offset.
-		       (progn (skip-chars-backward " \t")
-			      (if (bolp) 0 cperl-brace-imaginary-offset))
-		       ;; If the openbrace is preceded by a parenthesized exp,
-		       ;; move to the beginning of that;
-		       ;; possibly a different line
-		       (progn
-			 (if (eq (preceding-char) ?\))
-			     (forward-sexp -1))
-			 ;; In the case it starts a subroutine, indent with
-			 ;; respect to `sub', not with respect to the
-			 ;; first thing on the line, say in the case of
-			 ;; anonymous sub in a hash.
-			 ;;
-			 (skip-chars-backward " \t")
-			 (if (and (eq (preceding-char) ?b)
-				  (progn
-				    (forward-sexp -1)
-				    (looking-at "sub\\>"))
-				  (setq old-indent
-					(nth 1
-					     (parse-partial-sexp
-					      (save-excursion (beginning-of-line) (point))
-					      (point)))))
-			     (progn (goto-char (1+ old-indent))
-				    (skip-chars-forward " \t")
-				    (current-column))
-			   ;; Get initial indentation of the line we are on.
-			   ;; If line starts with label, calculate label indentation
-			   (if (save-excursion
-				 (beginning-of-line)
-				 (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
-			       (if (> (current-indentation) cperl-min-label-indent)
-				   (- (current-indentation) cperl-label-offset)
-				 ;; Do not move `parse-data', this should
-				 ;; be quick anyway:
-				 (cperl-calculate-indent))
-			     (current-indentation))))))))))))))
-
-(defvar cperl-indent-alist
-  '((string nil)
-    (comment nil)
-    (toplevel 0)
-    (toplevel-after-parenth 2)
-    (toplevel-continued 2)
-    (expression 1))
-  "Alist of indentation rules for CPerl mode.
-The values mean:
-  nil: do not indent;
-  number: add this amount of indentation.
-
-Not finished, not used.")
-
-(defun cperl-where-am-i (&optional parse-start start-state)
-  ;; Unfinished
-  "Return a list of lists ((TYPE POS)...) of good points before the point.
-POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'.
-
-Not finished, not used."
-  (save-excursion
-    (let* ((start-point (point))
-	   (s-s (cperl-get-state))
-	   (start (nth 0 s-s))
-	   (state (nth 1 s-s))
-	   (prestart (nth 3 s-s))
-	   (containing-sexp (car (cdr state)))
-	   (case-fold-search nil)
-	   (res (list (list 'parse-start start) (list 'parse-prestart prestart))))
-      (cond ((nth 3 state)		; In string
-	     (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string
-	    ((nth 4 state)		; In comment
-	     (setq res (cons '(comment) res)))
-	    ((null containing-sexp)
-	     ;; Line is at top level.
-	     ;; Indent like the previous top level line
-	     ;; unless that ends in a closeparen without semicolon,
-	     ;; in which case this line is the first argument decl.
-	     (cperl-backward-to-noncomment (or parse-start (point-min)))
-	     ;;(skip-chars-backward " \t\f\n")
-	     (cond
-	      ((or (bobp)
-		   (memq (preceding-char) (append ";}" nil)))
-	       (setq res (cons (list 'toplevel start) res)))
-	      ((eq (preceding-char) ?\) )
-	       (setq res (cons (list 'toplevel-after-parenth start) res)))
-	      (t
-	       (setq res (cons (list 'toplevel-continued start) res)))))
-	    ((/= (char-after containing-sexp) ?{)
-	     ;; line is expression, not statement:
-	     ;; indent to just after the surrounding open.
-	     ;; skip blanks if we do not close the expression.
-	     (setq res (cons (list 'expression-blanks
-				   (progn
-				     (goto-char (1+ containing-sexp))
-				     (or (looking-at "[ \t]*\\(#\\|$\\)")
-					 (skip-chars-forward " \t"))
-				     (point)))
-			     (cons (list 'expression containing-sexp) res))))
-	    ((progn
-	       ;; Containing-expr starts with \{.  Check whether it is a hash.
-	       (goto-char containing-sexp)
-	       (not (cperl-block-p)))
-	     (setq res (cons (list 'expression-blanks
-				   (progn
-				     (goto-char (1+ containing-sexp))
-				     (or (looking-at "[ \t]*\\(#\\|$\\)")
-					 (skip-chars-forward " \t"))
-				     (point)))
-			     (cons (list 'expression containing-sexp) res))))
-	    (t
-	     ;; Statement level.
-	     (setq res (cons (list 'in-block containing-sexp) res))
-	     ;; Is it a continuation or a new statement?
-	     ;; Find previous non-comment character.
-	     (cperl-backward-to-noncomment containing-sexp)
-	     ;; Back up over label lines, since they don't
-	     ;; affect whether our line is a continuation.
-	     ;; Back up comma-delimited lines too ?????
-	     (while (or (eq (preceding-char) ?\,)
-			(save-excursion (cperl-after-label)))
-	       (if (eq (preceding-char) ?\,)
-		   ;; Will go to beginning of line, essentially
-		   ;; Will ignore embedded sexpr XXXX.
-		   (cperl-backward-to-start-of-continued-exp containing-sexp))
-	       (beginning-of-line)
-	       (cperl-backward-to-noncomment containing-sexp))
-	     ;; Now we get the answer.
-	     (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\,
-		 ;; This line is continuation of preceding line's statement.
-		 (list (list 'statement-continued containing-sexp))
-	       ;; This line starts a new statement.
-	       ;; Position following last unclosed open.
-	       (goto-char containing-sexp)
-	       ;; Is line first statement after an open-brace?
-	       (or
-		;; If no, find that first statement and indent like
-		;; it.  If the first statement begins with label, do
-		;; not believe when the indentation of the label is too
-		;; small.
-		(save-excursion
-		  (forward-char 1)
-		  (let ((colon-line-end 0))
-		    (while (progn (skip-chars-forward " \t\n" start-point)
-				  (and (< (point) start-point)
-				       (looking-at
-					"#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]")))
-		      ;; Skip over comments and labels following openbrace.
-		      (cond ((= (following-char) ?\#)
-			     ;;(forward-line 1)
-			     (end-of-line))
-			    ;; label:
-			    (t
-			     (save-excursion (end-of-line)
-					     (setq colon-line-end (point)))
-			     (search-forward ":"))))
-		    ;; Now at the point, after label, or at start
-		    ;; of first statement in the block.
-		    (and (< (point) start-point)
-			 (if (> colon-line-end (point))
-			     ;; Before statement after label
-			     (if (> (current-indentation)
-				    cperl-min-label-indent)
-				 (list (list 'label-in-block (point)))
-			       ;; Do not believe: `max' is involved
-			       (list
-				(list 'label-in-block-min-indent (point))))
-			   ;; Before statement
-			   (list 'statement-in-block (point))))))
-		;; If no previous statement,
-		;; indent it relative to line brace is on.
-		;; For open brace in column zero, don't let statement
-		;; start there too.  If cperl-indent-level is zero,
-		;; use cperl-brace-offset + cperl-continued-statement-offset instead.
-		;; For open-braces not the first thing in a line,
-		;; add in cperl-brace-imaginary-offset.
-
-		;; If first thing on a line:  ?????
-		(+ (if (and (bolp) (zerop cperl-indent-level))
-		       (+ cperl-brace-offset cperl-continued-statement-offset)
-		     cperl-indent-level)
-		   ;; Move back over whitespace before the openbrace.
-		   ;; If openbrace is not first nonwhite thing on the line,
-		   ;; add the cperl-brace-imaginary-offset.
-		   (progn (skip-chars-backward " \t")
-			  (if (bolp) 0 cperl-brace-imaginary-offset))
-		   ;; If the openbrace is preceded by a parenthesized exp,
-		   ;; move to the beginning of that;
-		   ;; possibly a different line
-		   (progn
-		     (if (eq (preceding-char) ?\))
-			 (forward-sexp -1))
-		     ;; Get initial indentation of the line we are on.
-		     ;; If line starts with label, calculate label indentation
-		     (if (save-excursion
-			   (beginning-of-line)
-			   (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
-			 (if (> (current-indentation) cperl-min-label-indent)
-			     (- (current-indentation) cperl-label-offset)
-			   (cperl-calculate-indent))
-		       (current-indentation))))))))
-      res)))
-
-(defun cperl-calculate-indent-within-comment ()
-  "Return the indentation amount for line, assuming that
-the current line is to be regarded as part of a block comment."
-  (let (end star-start)
-    (save-excursion
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (setq end (point))
-      (and (= (following-char) ?#)
-	   (forward-line -1)
-	   (cperl-to-comment-or-eol)
-	   (setq end (point)))
-      (goto-char end)
-      (current-column))))
-
-
-(defun cperl-to-comment-or-eol ()
-  "Go to position before comment on the current line, or to end of line.
-Returns true if comment is found."
-  (let (state stop-in cpoint (lim (progn (end-of-line) (point))))
-    (beginning-of-line)
-    (if (or
-	 (eq (get-text-property (point) 'syntax-type) 'pod)
-	 (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t))
-	(if (eq (preceding-char) ?\#) (progn (backward-char 1) t))
-      ;; Else
-      (while (not stop-in)
-	(setq state (parse-partial-sexp (point) lim nil nil nil t))
-					; stop at comment
-	;; If fails (beginning-of-line inside sexp), then contains not-comment
-	(if (nth 4 state)		; After `#';
-					; (nth 2 state) can be
-					; beginning of m,s,qq and so
-					; on
-	    (if (nth 2 state)
-		(progn
-		  (setq cpoint (point))
-		  (goto-char (nth 2 state))
-		  (cond
-		   ((looking-at "\\(s\\|tr\\)\\>")
-		    (or (re-search-forward
-			 "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*"
-			 lim 'move)
-			(setq stop-in t)))
-		   ((looking-at "\\(m\\|q\\([qxwr]\\)?\\)\\>")
-		    (or (re-search-forward
-			 "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#"
-			 lim 'move)
-			(setq stop-in t)))
-		   (t			; It was fair comment
-		    (setq stop-in t)	; Finish
-		    (goto-char (1- cpoint)))))
-	      (setq stop-in t)		; Finish
-	      (forward-char -1))
-	  (setq stop-in t)))		; Finish 
-      (nth 4 state))))
-
-(defsubst cperl-1- (p)
-  (max (point-min) (1- p)))
-
-(defsubst cperl-1+ (p)
-  (min (point-max) (1+ p)))
-
-(defsubst cperl-modify-syntax-type (at how)
-  (if (< at (point-max))
-      (progn
-	(put-text-property at (1+ at) 'syntax-table how)
-	(put-text-property at (1+ at) 'rear-nonsticky t))))
-
-(defun cperl-protect-defun-start (s e)
-  ;; C code looks for "^\\s(" to skip comment backward in "hard" situations
-  (save-excursion
-    (goto-char s)
-    (while (re-search-forward "^\\s(" e 'to-end)
-      (put-text-property (1- (point)) (point) 'syntax-table cperl-st-punct))))
-
-(defun cperl-commentify (bb e string &optional noface)
-  (if cperl-use-syntax-table-text-property
-      (if (eq noface 'n)		; Only immediate
-	  nil
-	;; We suppose that e is _after_ the end of construction, as after eol.
-	(setq string (if string cperl-st-sfence cperl-st-cfence))
-	(if (> bb (- e 2))
-	    ;; one-char string/comment?!
-	    (cperl-modify-syntax-type bb cperl-st-punct)
-	  (cperl-modify-syntax-type bb string)
-	  (cperl-modify-syntax-type (1- e) string))
-	(if (and (eq string cperl-st-sfence) (> (- e 2) bb))
-	    (put-text-property (1+ bb) (1- e)
-			       'syntax-table cperl-string-syntax-table))
-	(cperl-protect-defun-start bb e))
-    ;; Fontify
-    (or noface
-	(not cperl-pod-here-fontify)
-	(put-text-property bb e 'face (if string 'font-lock-string-face
-					'font-lock-comment-face)))))
-
-(defvar cperl-starters '(( ?\( . ?\) )
-			 ( ?\[ . ?\] )
-			 ( ?\{ . ?\} )
-			 ( ?\< . ?\> )))
-
-(defun cperl-forward-re (lim end is-2arg set-st st-l err-l argument
-			     &optional ostart oend)
-  ;; Works *before* syntax recognition is done
-  ;; May modify syntax-type text property if the situation is too hard
-  (let (b starter ender st i i2 go-forward reset-st)
-    (skip-chars-forward " \t")
-    ;; ender means matching-char matcher.
-    (setq b (point)
-	  starter (if (eobp) 0 (char-after b))
-	  ender (cdr (assoc starter cperl-starters)))
-    ;; What if starter == ?\\  ????
-    (if set-st
-	(if (car st-l)
-	    (setq st (car st-l))
-	  (setcar st-l (make-syntax-table))
-	  (setq i 0 st (car st-l))
-	  (while (< i 256)
-	    (modify-syntax-entry i "." st)
-	    (setq i (1+ i)))
-	  (modify-syntax-entry ?\\ "\\" st)))
-    (setq set-st t)
-    ;; Whether we have an intermediate point
-    (setq i nil)
-    ;; Prepare the syntax table:
-    (and set-st
-	 (if (not ender)		; m/blah/, s/x//, s/x/y/
-	     (modify-syntax-entry starter "$" st)
-	   (modify-syntax-entry starter (concat "(" (list ender)) st)
-	   (modify-syntax-entry ender  (concat ")" (list starter)) st)))
-    (condition-case bb
-	(progn
-	  ;; We use `$' syntax class to find matching stuff, but $$
-	  ;; is recognized the same as $, so we need to check this manually.
-	  (if (and (eq starter (char-after (cperl-1+ b)))
-		   (not ender))
-	      ;; $ has TeXish matching rules, so $$ equiv $...
-	      (forward-char 2)
-	    (setq reset-st (syntax-table))
-	    (set-syntax-table st)
-	    (forward-sexp 1)
-	    (if (<= (point) (1+ b))
-		(error "Unfinished regular expression"))
-	    (set-syntax-table reset-st)
-	    (setq reset-st nil)
-	    ;; Now the problem is with m;blah;;
-	    (and (not ender)
-		 (eq (preceding-char)
-		     (char-after (- (point) 2)))
-		 (save-excursion
-		   (forward-char -2)
-		   (= 0 (% (skip-chars-backward "\\\\") 2)))
-		 (forward-char -1)))
-	  ;; Now we are after the first part.
-	  (and is-2arg			; Have trailing part
-	       (not ender)
-	       (eq (following-char) starter) ; Empty trailing part
-	       (progn
-		 (or (eq (char-syntax (following-char)) ?.)
-		     ;; Make trailing letter into punctuation
-		     (cperl-modify-syntax-type (point) cperl-st-punct))
-		 (setq is-2arg nil go-forward t))) ; Ignore the tail
-	  (if is-2arg			; Not number => have second part
-	      (progn
-		(setq i (point) i2 i)
-		(if ender
-		    (if (memq (following-char) '(?\  ?\t ?\n ?\f))
-			(progn
-			  (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
-			      (goto-char (match-end 0))
-			    (skip-chars-forward " \t\n\f"))
-			  (setq i2 (point))))
-		  (forward-char -1))
-		(modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
-		(if ender (modify-syntax-entry ender "." st))
-		(setq set-st nil)
-		(setq ender (cperl-forward-re lim end nil t st-l err-l
-					      argument starter ender)
-		      ender (nth 2 ender)))))
-      (error (goto-char lim)
-	     (setq set-st nil)
-	     (if reset-st
-		 (set-syntax-table reset-st))
-	     (or end
-		 (message
-		  "End of `%s%s%c ... %c' string/RE not found: %s"
-		  argument
-		  (if ostart (format "%c ... %c" ostart (or oend ostart)) "")
-		  starter (or ender starter) bb)
-		 (or (car err-l) (setcar err-l b)))))
-    (if set-st
-	(progn
-	  (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
-	  (if ender (modify-syntax-entry ender "." st))))
-    ;; i: have 2 args, after end of the first arg
-    ;; i2: start of the second arg, if any (before delim iff `ender').
-    ;; ender: the last arg bounded by parens-like chars, the second one of them
-    ;; starter: the starting delimiter of the first arg
-    ;; go-forward: has 2 args, and the second part is empty
-    (list i i2 ender starter go-forward)))
-
-(defvar font-lock-string-face)
-;;(defvar font-lock-reference-face)
-(defvar font-lock-constant-face)
-(defsubst cperl-postpone-fontification (b e type val &optional now)
-  ;; Do after syntactic fontification?
-  (if cperl-syntaxify-by-font-lock
-      (or now (put-text-property b e 'cperl-postpone (cons type val)))
-    (put-text-property b e type val)))
-
-;;; Here is how the global structures (those which cannot be
-;;; recognized locally) are marked:
-;;	a) PODs:
-;;		Start-to-end is marked `in-pod' ==> t
-;;		Each non-literal part is marked `syntax-type' ==> `pod'
-;;		Each literal part is marked `syntax-type' ==> `in-pod'
-;;	b) HEREs:
-;;		Start-to-end is marked `here-doc-group' ==> t
-;;		The body is marked `syntax-type' ==> `here-doc'
-;;		The delimiter is marked `syntax-type' ==> `here-doc-delim'
-;;	c) FORMATs:
-;;		First line (to =) marked `first-format-line' ==> t
-;;		After-this--to-end is marked `syntax-type' ==> `format'
-;;	d) 'Q'uoted string:
-;;		part between markers inclusive is marked `syntax-type' ==> `string'
-;;		part between `q' and the first marker is marked `syntax-type' ==> `prestring'
-
-(defun cperl-unwind-to-safe (before &optional end)
-  ;; if BEFORE, go to the previous start-of-line on each step of unwinding
-  (let ((pos (point)) opos)
-    (setq opos pos)
-    (while (and pos (get-text-property pos 'syntax-type))
-      (setq pos (previous-single-property-change pos 'syntax-type))
-      (if pos
-	  (if before
-	      (progn
-		(goto-char (cperl-1- pos))
-		(beginning-of-line)
-		(setq pos (point)))
-	    (goto-char (setq pos (cperl-1- pos))))
-	;; Up to the start
-	(goto-char (point-min))))
-    ;; Skip empty lines
-    (and (looking-at "\n*=")
-	 (/= 0 (skip-chars-backward "\n"))
-	 (forward-char))
-    (setq pos (point))
-    (if end
-	;; Do the same for end, going small steps
-	(progn
-	  (while (and end (get-text-property end 'syntax-type))
-	    (setq pos end
-		  end (next-single-property-change end 'syntax-type)))
-	  (or end pos)))))
-
-(defvar cperl-nonoverridable-face)
-(defvar font-lock-function-name-face)
-(defvar font-lock-comment-face)
-
-(defun cperl-find-pods-heres (&optional min max non-inter end ignore-max)
-  "Scans the buffer for hard-to-parse Perl constructions.
-If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify
-the sections using `cperl-pod-head-face', `cperl-pod-face',
-`cperl-here-face'."
-  (interactive)
-  (or min (setq min (point-min)
-		cperl-syntax-state nil
-		cperl-syntax-done-to min))
-  (or max (setq max (point-max)))
-  (let* ((cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go tmpend
-	 face head-face here-face b e bb tag qtag b1 e1 argument i c tail tb
-	 is-REx is-x-REx REx-comment-start REx-comment-end was-comment i2
-	 (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
-	 (modified (buffer-modified-p))
-	 (after-change-functions nil)
-	 (use-syntax-state (and cperl-syntax-state
-				(>= min (car cperl-syntax-state))))
-	 (state-point (if use-syntax-state
-			  (car cperl-syntax-state)
-			(point-min)))
-	 (state (if use-syntax-state
-		    (cdr cperl-syntax-state)))
-	 ;; (st-l '(nil)) (err-l '(nil)) ; Would overwrite - propagates from a function call to a function call!
-	 (st-l (list nil)) (err-l (list nil))
-	 ;; Somehow font-lock may be not loaded yet...
-	 (font-lock-string-face (if (boundp 'font-lock-string-face)
-				    font-lock-string-face
-				  'font-lock-string-face))
-	 (font-lock-constant-face (if (boundp 'font-lock-constant-face)
-				      font-lock-constant-face
-				    'font-lock-constant-face))
-	 (font-lock-function-name-face
-	  (if (boundp 'font-lock-function-name-face)
-	      font-lock-function-name-face
-	    'font-lock-function-name-face))
-	 (font-lock-comment-face
-	  (if (boundp 'font-lock-comment-face)
-	      font-lock-comment-face
-	    'font-lock-comment-face))
-	 (cperl-nonoverridable-face
-	  (if (boundp 'cperl-nonoverridable-face)
-	      cperl-nonoverridable-face
-	    'cperl-nonoverridable-face))
-	 (stop-point (if ignore-max
-			 (point-max)
-		       max))
-	 (search
-	  (concat
-	   "\\(\\`\n?\\|^\n\\)="
-	   "\\|"
-	   ;; One extra () before this:
-	   "<<"
-	   "\\("			; 1 + 1
-	   ;; First variant "BLAH" or just ``.
-	   "[ \t]*"			; Yes, whitespace is allowed!
-	   "\\([\"'`]\\)"		; 2 + 1 = 3
-	   "\\([^\"'`\n]*\\)"		; 3 + 1
-	   "\\3"
-	   "\\|"
-	   ;; Second variant: Identifier or \ID (same as 'ID') or empty
-	   "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
-	   ;; Do not have <<= or << 30 or <<30 or << $blah.
-	   ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
-	   "\\(\\)"		; To preserve count of pars :-( 6 + 1
-	   "\\)"
-	   "\\|"
-	   ;; 1+6 extra () before this:
-	   "^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
-	   (if cperl-use-syntax-table-text-property
-	       (concat
-		"\\|"
-		;; 1+6+2=9 extra () before this:
-		"\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
-		"\\|"
-		;; 1+6+2+1=10 extra () before this:
-		"\\([?/<]\\)"	; /blah/ or ?blah? or 
-		"\\|"
-		;; 1+6+2+1+1=11 extra () before this:
-		"\\[ \t]*\\([a-zA-Z_:'0-9]+[ \t]*\\)?\\(([^()]*)\\)"
-		"\\|"
-		;; 1+6+2+1+1+2=13 extra () before this:
-		"\\$\\(['{]\\)"
-		"\\|"
-		;; 1+6+2+1+1+2+1=14 extra () before this:
-		"\\(\\")
-		    (if ignore-max
-			nil		; Doing a chunk only
-		      (message "=cut is not preceded by a POD section")
-		      (or (car err-l) (setcar err-l (point))))
-		  (beginning-of-line)
-
-		  (setq b (point)
-			bb b
-			tb (match-beginning 0)
-			b1 nil)		; error condition
-		  ;; We do not search to max, since we may be called from
-		  ;; some hook of fontification, and max is random
-		  (or (re-search-forward "^\n=cut\\>" stop-point 'toend)
-		      (progn
-			(goto-char b)
-			(if (re-search-forward "\n=cut\\>" stop-point 'toend)
-			    (progn
-			      (message "=cut is not preceded by an empty line")
-			      (setq b1 t)
-			      (or (car err-l) (setcar err-l b))))))
-		  (beginning-of-line 2)	; An empty line after =cut is not POD!
-		  (setq e (point))
-		  (and (> e max)
-		       (progn
-			 (remove-text-properties
-			  max e '(syntax-type t in-pod t syntax-table t
-					      cperl-postpone t
-					      syntax-subtype t
-					      here-doc-group t
-					      rear-nonsticky t
-					      first-format-line t
-					      indentable t))
-			 (setq tmpend tb)))
-		  (put-text-property b e 'in-pod t)
-		  (put-text-property b e 'syntax-type 'in-pod)
-		  (goto-char b)
-		  (while (re-search-forward "\n\n[ \t]" e t)
-		    ;; We start 'pod 1 char earlier to include the preceding line
-		    (beginning-of-line)
-		    (put-text-property (cperl-1- b) (point) 'syntax-type 'pod)
-		    (cperl-put-do-not-fontify b (point) t)
-		    ;; mark the non-literal parts as PODs
-		    (if cperl-pod-here-fontify
-			(cperl-postpone-fontification b (point) 'face face t))
-		    (re-search-forward "\n\n[^ \t\f\n]" e 'toend)
-		    (beginning-of-line)
-		    (setq b (point)))
-		  (put-text-property (cperl-1- (point)) e 'syntax-type 'pod)
-		  (cperl-put-do-not-fontify (point) e t)
-		  (if cperl-pod-here-fontify
-		      (progn
-			;; mark the non-literal parts as PODs
-			(cperl-postpone-fontification (point) e 'face face t)
-			(goto-char bb)
-			(if (looking-at
-			     "=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$")
-			    ;; mark the headers
-			    (cperl-postpone-fontification
-			     (match-beginning 1) (match-end 1)
-			     'face head-face))
-			(while (re-search-forward
-				;; One paragraph
-				"^\n=[a-zA-Z0-9_]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
-				e 'toend)
-			  ;; mark the headers
-			  (cperl-postpone-fontification
-			   (match-beginning 1) (match-end 1)
-			   'face head-face))))
-		  (cperl-commentify bb e nil)
-		  (goto-char e)
-		  (or (eq e (point-max))
-		      (forward-char -1)))) ; Prepare for immediate POD start.
-	       ;; Here document
-	       ;; We do only one here-per-line
-               ;; ;; One extra () before this:
-	       ;;"<<"
-	       ;;  "\\("			; 1 + 1
-	       ;;  ;; First variant "BLAH" or just ``.
-	       ;;     "[ \t]*"			; Yes, whitespace is allowed!
-	       ;;     "\\([\"'`]\\)"	; 2 + 1
-	       ;;     "\\([^\"'`\n]*\\)"	; 3 + 1
-	       ;;     "\\3"
-	       ;;  "\\|"
-	       ;;  ;; Second variant: Identifier or \ID or empty
-	       ;;    "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
-	       ;;    ;; Do not have <<= or << 30 or <<30 or << $blah.
-	       ;;    ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
-	       ;;    "\\(\\)"		; To preserve count of pars :-( 6 + 1
-	       ;;  "\\)"
-	       ((match-beginning 2)	; 1 + 1
-		;; Abort in comment:
-		(setq b (point))
-		(setq state (parse-partial-sexp state-point b nil nil state)
-		      state-point b
-		      tb (match-beginning 0)
-		      i (or (nth 3 state) (nth 4 state)))
-		(if i
-		    (setq c t)
-		  (setq c (and
-			   (match-beginning 5)
-			   (not (match-beginning 6)) ; Empty
-			   (looking-at
-			    "[ \t]*[=0-9$@%&(]"))))
-		(if c			; Not here-doc
-		    nil			; Skip it.
-		  (if (match-beginning 5) ;4 + 1
-		      (setq b1 (match-beginning 5) ; 4 + 1
-			    e1 (match-end 5)) ; 4 + 1
-		    (setq b1 (match-beginning 4) ; 3 + 1
-			  e1 (match-end 4))) ; 3 + 1
-		  (setq tag (buffer-substring b1 e1)
-			qtag (regexp-quote tag))
-		  (cond (cperl-pod-here-fontify
-			 ;; Highlight the starting delimiter
-			 (cperl-postpone-fontification b1 e1 'face font-lock-constant-face)
-			 (cperl-put-do-not-fontify b1 e1 t)))
-		  (forward-line)
-		  (setq b (point))
-		  ;; We do not search to max, since we may be called from
-		  ;; some hook of fontification, and max is random
-		  (or (and (re-search-forward (concat "^" qtag "$")
-					      stop-point 'toend)
-			   (eq (following-char) ?\n))
-		    (progn		; Pretend we matched at the end
-		      (goto-char (point-max))
-		      (re-search-forward "\\'")
-		      (message "End of here-document `%s' not found." tag)
-		      (or (car err-l) (setcar err-l b))))
-		  (if cperl-pod-here-fontify
-		      (progn
-			;; Highlight the ending delimiter
-			(cperl-postpone-fontification (match-beginning 0) (match-end 0)
-						      'face font-lock-constant-face)
-			(cperl-put-do-not-fontify b (match-end 0) t)
-			;; Highlight the HERE-DOC
-			(cperl-postpone-fontification b (match-beginning 0)
-						      'face here-face)))
-		  (setq e1 (cperl-1+ (match-end 0)))
-		  (put-text-property b (match-beginning 0)
-				     'syntax-type 'here-doc)
-		  (put-text-property (match-beginning 0) e1
-				     'syntax-type 'here-doc-delim)
-		  (put-text-property b e1
-				     'here-doc-group t)
-		  (cperl-commentify b e1 nil)
-		  (cperl-put-do-not-fontify b (match-end 0) t)
-		  (if (> e1 max)
-		      (setq tmpend tb))))
-	       ;; format
-	       ((match-beginning 8)
-		;; 1+6=7 extra () before this:
-		;;"^[ \t]*\\(format\\)[ \t]*\\([a-zA-Z0-9_]+\\)?[ \t]*=[ \t]*$"
-		(setq b (point)
-		      name (if (match-beginning 8) ; 7 + 1
-			       (buffer-substring (match-beginning 8) ; 7 + 1
-						 (match-end 8)) ; 7 + 1
-			     "")
-		      tb (match-beginning 0))
-		(setq argument nil)
-		(put-text-property (save-excursion
-				     (beginning-of-line)
-				     (point))
-				   b 'first-format-line 't)
-		(if cperl-pod-here-fontify
-		    (while (and (eq (forward-line) 0)
-				(not (looking-at "^[.;]$")))
-		      (cond
-		       ((looking-at "^#")) ; Skip comments
-		       ((and argument	; Skip argument multi-lines
-			     (looking-at "^[ \t]*{"))
-			(forward-sexp 1)
-			(setq argument nil))
-		       (argument	; Skip argument lines
-			(setq argument nil))
-		       (t		; Format line
-			(setq b1 (point))
-			(setq argument (looking-at "^[^\n]*[@^]"))
-			(end-of-line)
-			;; Highlight the format line
-			(cperl-postpone-fontification b1 (point)
-						      'face font-lock-string-face)
-			(cperl-commentify b1 (point) nil)
-			(cperl-put-do-not-fontify b1 (point) t))))
-		  ;; We do not search to max, since we may be called from
-		  ;; some hook of fontification, and max is random
-		  (re-search-forward "^[.;]$" stop-point 'toend))
-		(beginning-of-line)
-		(if (looking-at "^\\.$") ; ";" is not supported yet
-		    (progn
-		      ;; Highlight the ending delimiter
-		      (cperl-postpone-fontification (point) (+ (point) 2)
-						    'face font-lock-string-face)
-		      (cperl-commentify (point) (+ (point) 2) nil)
-		      (cperl-put-do-not-fontify (point) (+ (point) 2) t))
-		  (message "End of format `%s' not found." name)
-		  (or (car err-l) (setcar err-l b)))
-		(forward-line)
-		(if (> (point) max)
-		    (setq tmpend tb))
-		(put-text-property b (point) 'syntax-type 'format))
-	       ;; Regexp:
-	       ((or (match-beginning 10) (match-beginning 11))
-		;; 1+6+2=9 extra () before this:
-		;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
-		;; "\\|"
-		;; "\\([?/<]\\)"	; /blah/ or ?blah? or 
-		(setq b1 (if (match-beginning 10) 10 11)
-		      argument (buffer-substring
-				(match-beginning b1) (match-end b1))
-		      b (point)
-		      i b
-		      c (char-after (match-beginning b1))
-		      bb (char-after (1- (match-beginning b1)))	; tmp holder
-		      ;; bb == "Not a stringy"
-		      bb (if (eq b1 10) ; user variables/whatever
-			     (and (memq bb (append "$@%*#_:-&>" nil)) ; $#y)
-				  (cond ((eq bb ?-) (eq c ?s)) ; -s file test
-					((eq bb ?\:) ; $opt::s
-					 (eq (char-after
-					      (- (match-beginning b1) 2))
-					     ?\:))
-					((eq bb ?\>) ; $foo->s
-					 (eq (char-after
-					      (- (match-beginning b1) 2))
-					     ?\-))
-					((eq bb ?\&)
-					 (not (eq (char-after	; &&m/blah/
-						   (- (match-beginning b1) 2))
-						  ?\&)))
-					(t t)))
-			   ;;  or <$file>
-			   (and (eq c ?\<)
-				;; Do not stringify , <$fh> :
-				(save-match-data
-				  (looking-at
-				   "\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\)?>"))))
-		      tb (match-beginning 0))
-		(goto-char (match-beginning b1))
-		(cperl-backward-to-noncomment (point-min))
-		(or bb
-		    (if (eq b1 11)	; bare /blah/ or ?blah? or 
-			(setq argument ""
-			      b1 nil
-			      bb	; Not a regexp?
-			      (progn
-				(not
-				 ;; What is below: regexp-p?
-				 (and
-				  (or (memq (preceding-char)
-					    (append (if (memq c '(?\? ?\<))
-							;; $a++ ? 1 : 2
-							"~{(=|&*!,;:"
-						      "~{(=|&+-*!,;:") nil))
-				      (and (eq (preceding-char) ?\})
-					   (cperl-after-block-p (point-min)))
-				      (and (eq (char-syntax (preceding-char)) ?w)
-					   (progn
-					     (forward-sexp -1)
-;;; After these keywords `/' starts a RE.  One should add all the
-;;; functions/builtins which expect an argument, but ...
-					     (if (eq (preceding-char) ?-)
-						 ;; -d ?foo? is a RE
-						 (looking-at "[a-zA-Z]\\>")
-					       (and
-						(not (memq (preceding-char)
-							   '(?$ ?@ ?& ?%)))
-						(looking-at
-						 "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))))
-				      (and (eq (preceding-char) ?.)
-					   (eq (char-after (- (point) 2)) ?.))
-				      (bobp))
-				  ;;  m|blah| ? foo : bar;
-				  (not
-				   (and (eq c ?\?)
-					cperl-use-syntax-table-text-property
-					(not (bobp))
-					(progn
-					  (forward-char -1)
-					  (looking-at "\\s|")))))))
-			      b (1- b))
-		      ;; s y tr m
-		      ;; Check for $a -> y
-		      (setq b1 (preceding-char)
-			    go (point))
-		      (if (and (eq b1 ?>)
-			       (eq (char-after (- go 2)) ?-))
-			  ;; Not a regexp
-			  (setq bb t))))
-		(or bb (setq state (parse-partial-sexp
-				    state-point b nil nil state)
-			     state-point b))
-		(setq bb (or bb (nth 3 state) (nth 4 state)))
-		(goto-char b)
-		(or bb
-		    (progn
-		      (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
-			  (goto-char (match-end 0))
-			(skip-chars-forward " \t\n\f"))
-		      (cond ((and (eq (following-char) ?\})
-				  (eq b1 ?\{))
-			     ;; Check for $a[23]->{ s }, @{s} and *{s::foo}
-			     (goto-char (1- go))
-			     (skip-chars-backward " \t\n\f")
-			     (if (memq (preceding-char) (append "$@%&*" nil))
-				 (setq bb t) ; @{y}
-			       (condition-case nil
-				   (forward-sexp -1)
-				 (error nil)))
-			     (if (or bb
-				     (looking-at ; $foo -> {s}
-				      "[$@]\\$*\\([a-zA-Z0-9_:]+\\|[^{]\\)\\([ \t\n]*->\\)?[ \t\n]*{")
-				     (and ; $foo[12] -> {s}
-				      (memq (following-char) '(?\{ ?\[))
-				      (progn
-					(forward-sexp 1)
-					(looking-at "\\([ \t\n]*->\\)?[ \t\n]*{"))))
-				 (setq bb t)
-			       (goto-char b)))
-			    ((and (eq (following-char) ?=)
-				  (eq (char-after (1+ (point))) ?\>))
-			     ;; Check for { foo => 1, s => 2 }
-			     ;; Apparently s=> is never a substitution...
-			     (setq bb t))
-			    ((and (eq (following-char) ?:)
-				  (eq b1 ?\{) ; Check for $ { s::bar }
-				  (looking-at "::[a-zA-Z0-9_:]*[ \t\n\f]*}")
-				  (progn 
-				    (goto-char (1- go))
-				    (skip-chars-backward " \t\n\f")
-				    (memq (preceding-char)
-					  (append "$@%&*" nil))))
-			     (setq bb t)))))
-		(if bb
-		    (goto-char i)
-		  ;; Skip whitespace and comments...
-		  (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
-		      (goto-char (match-end 0))
-		    (skip-chars-forward " \t\n\f"))
-		  (if (> (point) b)
-		      (put-text-property b (point) 'syntax-type 'prestring))
-		  ;; qtag means two-arg matcher, may be reset to
-		  ;;   2 or 3 later if some special quoting is needed.
-		  ;; e1 means matching-char matcher.
-		  (setq b (point)
-			;; has 2 args
-			i2 (string-match "^\\([sy]\\|tr\\)$" argument)
-			;; We do not search to max, since we may be called from
-			;; some hook of fontification, and max is random
-			i (cperl-forward-re stop-point end
-					    i2
-					    t st-l err-l argument)
-			;; Note that if `go', then it is considered as 1-arg
-			b1 (nth 1 i)	; start of the second part
-			tag (nth 2 i)	; ender-char, true if second part
-					; is with matching chars []
-			go (nth 4 i)	; There is a 1-char part after the end
-			i (car i)	; intermediate point
-			e1 (point)	; end
-			;; Before end of the second part if non-matching: ///
-			tail (if (and i (not tag))
-				 (1- e1))
-			e (if i i e1)	; end of the first part
-			qtag nil	; need to preserve backslashitis
-			is-x-REx nil)	; REx has //x modifier
-		  ;; Commenting \\ is dangerous, what about ( ?
-		  (and i tail
-		       (eq (char-after i) ?\\)
-		       (setq qtag t))
-		  (if (looking-at "\\sw*x") ; qr//x
-		      (setq is-x-REx t))
-		  (if (null i)
-		      ;; Considered as 1arg form
-		      (progn
-			(cperl-commentify b (point) t)
-			(put-text-property b (point) 'syntax-type 'string)
-			(if (or is-x-REx
-				;; ignore other text properties:
-				(string-match "^qw$" argument))
-			    (put-text-property b (point) 'indentable t))
-			(and go
-			     (setq e1 (cperl-1+ e1))
-			     (or (eobp)
-				 (forward-char 1))))
-		    (cperl-commentify b i t)
-		    (if (looking-at "\\sw*e") ; s///e
-			(progn
-			  (and
-			   ;; silent:
-			   (cperl-find-pods-heres b1 (1- (point)) t end)
-			   ;; Error
-			   (goto-char (1+ max)))
-			  (if (and tag (eq (preceding-char) ?\>))
-			      (progn
-				(cperl-modify-syntax-type (1- (point)) cperl-st-ket)
-				(cperl-modify-syntax-type i cperl-st-bra)))
-			  (put-text-property b i 'syntax-type 'string)
-			  (if is-x-REx
-			      (put-text-property b i 'indentable t)))
-		      (cperl-commentify b1 (point) t)
-		      (put-text-property b (point) 'syntax-type 'string)
-		      (if is-x-REx
-			  (put-text-property b i 'indentable t))
-		      (if qtag
-			  (cperl-modify-syntax-type (1+ i) cperl-st-punct))
-		      (setq tail nil)))
-		  ;; Now: tail: if the second part is non-matching without ///e
-		  (if (eq (char-syntax (following-char)) ?w)
-		      (progn
-			(forward-word 1) ; skip modifiers s///s
-			(if tail (cperl-commentify tail (point) t))
-			(cperl-postpone-fontification
-			 e1 (point) 'face 'cperl-nonoverridable-face)))
-		  ;; Check whether it is m// which means "previous match"
-		  ;; and highlight differently
-		  (setq is-REx
-			(and (string-match "^\\([sm]?\\|qr\\)$" argument)
-			     (or (not (= (length argument) 0))
-				 (not (eq c ?\<)))))
-		  (if (and is-REx
-			   (eq e (+ 2 b))
-			   ;; split // *is* using zero-pattern
-			   (save-excursion
-			     (condition-case nil
-				 (progn
-				   (goto-char tb)
-				   (forward-sexp -1)
-				   (not (looking-at "split\\>")))
-			       (error t))))
-		      (cperl-postpone-fontification
-		       b e 'face font-lock-function-name-face)
-		    (if (or i2		; Has 2 args
-			    (and cperl-fontify-m-as-s
-				 (or
-				  (string-match "^\\(m\\|qr\\)$" argument)
-				  (and (eq 0 (length argument))
-				       (not (eq ?\< (char-after b)))))))
-			(progn
-			  (cperl-postpone-fontification
-			   b (cperl-1+ b) 'face font-lock-constant-face)
-			  (cperl-postpone-fontification
-			   (1- e) e 'face font-lock-constant-face)))
-		    (if (and is-REx cperl-regexp-scan)
-			;; Process RExen better
-			(save-excursion
-			  (goto-char (1+ b))
-			  (while
-			      (and (< (point) e)
-				   (re-search-forward
-				    (if is-x-REx
-					(if (eq (char-after b) ?\#)
-					    "\\((\\?\\\\#\\)\\|\\(\\\\#\\)"
-					  "\\((\\?#\\)\\|\\(#\\)")
-				      (if (eq (char-after b) ?\#)
-					  "\\((\\?\\\\#\\)"
-					"\\((\\?#\\)"))
-				    (1- e) 'to-end))
-			    (goto-char (match-beginning 0))
-			    (setq REx-comment-start (point)
-				  was-comment t)
-			    (if (save-excursion
-				  (and
-				   ;; XXX not working if outside delimiter is #
-				   (eq (preceding-char) ?\\)
-				   (= (% (skip-chars-backward "$\\\\") 2) -1)))
-				;; Not a comment, avoid loop:
-				(progn (setq was-comment nil)
-				       (forward-char 1))
-			      (if (match-beginning 2)
-				  (progn
-				    (beginning-of-line 2)
-				    (if (> (point) e)
-					(goto-char (1- e))))
-				;; Works also if the outside delimiters are ().
-				(or (search-forward ")" (1- e) 'toend)
-				    (message
-				     "Couldn't find end of (?#...)-comment in a REx, pos=%s"
-				     REx-comment-start))))
-			    (if (>= (point) e)
-				(goto-char (1- e)))
-			    (if was-comment
-				(progn
-				  (setq REx-comment-end (point))
-				  (cperl-commentify
-				   REx-comment-start REx-comment-end nil)
-				  (cperl-postpone-fontification
-				   REx-comment-start REx-comment-end
-				   'face font-lock-comment-face))))))
-		    (if (and is-REx is-x-REx)
-			(put-text-property (1+ b) (1- e)
-					   'syntax-subtype 'x-REx)))
-		  (if i2
-		      (progn
-			(cperl-postpone-fontification
-			 (1- e1) e1 'face font-lock-constant-face)
-			(if (assoc (char-after b) cperl-starters)
-			    (cperl-postpone-fontification
-			     b1 (1+ b1) 'face font-lock-constant-face))))
-		  (if (> (point) max)
-		      (setq tmpend tb))))
-	       ((match-beginning 13)	; sub with prototypes
-		(setq b (match-beginning 0))
-		(if (memq (char-after (1- b))
-			  '(?\$ ?\@ ?\% ?\& ?\*))
-		    nil
-		  (setq state (parse-partial-sexp
-			       state-point b nil nil state)
-			state-point b)
-		  (if (or (nth 3 state) (nth 4 state))
-		      nil
-		    ;; Mark as string
-		    (cperl-commentify (match-beginning 13) (match-end 13) t))
-		  (goto-char (match-end 0))))
-	       ;; 1+6+2+1+1+2=13 extra () before this:
-	       ;;    "\\$\\(['{]\\)"
-	       ((and (match-beginning 14)
-		     (eq (preceding-char) ?\')) ; $'
-		(setq b (1- (point))
-		      state (parse-partial-sexp
-			     state-point (1- b) nil nil state)
-		      state-point (1- b))
-		(if (nth 3 state)	; in string
-		    (cperl-modify-syntax-type (1- b) cperl-st-punct))
-		(goto-char (1+ b)))
-	       ;; 1+6+2+1+1+2=13 extra () before this:
-	       ;;    "\\$\\(['{]\\)"
-	       ((match-beginning 14)	; ${
-		(setq bb (match-beginning 0))
-		(cperl-modify-syntax-type bb cperl-st-punct))
-	       ;; 1+6+2+1+1+2+1=14 extra () before this:
-	       ;;    "\\(\\ non-quoting outside string/comment
-		(setq bb (match-end 0)
-		      b (match-beginning 0))
-		(goto-char b)
-		(skip-chars-backward "\\\\")
-		;;;(setq i2 (= (% (skip-chars-backward "\\\\") 2) -1))
-		(setq state (parse-partial-sexp
-			     state-point b nil nil state)
-		      state-point b)
-		(if (or (nth 3 state) (nth 4 state) )
-		    nil
-		  (cperl-modify-syntax-type b cperl-st-punct))
-		(goto-char bb))
-	       (t (error "Error in regexp of the sniffer")))
-	      (if (> (point) stop-point)
-		  (progn
-		    (if end
-			(message "Garbage after __END__/__DATA__ ignored")
-		      (message "Unbalanced syntax found while scanning")
-		      (or (car err-l) (setcar err-l b)))
-		    (goto-char stop-point))))
-	    (setq cperl-syntax-state (cons state-point state)
-		  cperl-syntax-done-to (or tmpend (max (point) max))))
-	  (if (car err-l) (goto-char (car err-l))
-	    (or non-inter
-		(message "Scanning for \"hard\" Perl constructions... done"))))
-      (and (buffer-modified-p)
-	   (not modified)
-	   (set-buffer-modified-p nil))
-      (set-syntax-table cperl-mode-syntax-table))
-    (car err-l)))
-
-(defun cperl-backward-to-noncomment (lim)
-  ;; Stops at lim or after non-whitespace that is not in comment
-  (let (stop p pr)
-    (while (and (not stop) (> (point) (or lim 1)))
-      (skip-chars-backward " \t\n\f" lim)
-      (setq p (point))
-      (beginning-of-line)
-      (if (memq (setq pr (get-text-property (point) 'syntax-type))
-		'(pod here-doc here-doc-delim))
-	  (cperl-unwind-to-safe nil)
-      (or (looking-at "^[ \t]*\\(#\\|$\\)")
-	  (progn (cperl-to-comment-or-eol) (bolp))
-	  (progn
-	    (skip-chars-backward " \t")
-	    (if (< p (point)) (goto-char p))
-	    (setq stop t)))))))
-
-(defun cperl-after-block-p (lim &optional pre-block)
-  "Return true if the preceeding } ends a block or a following { starts one.
-Would not look before LIM.  If PRE-BLOCK is nil checks preceeding }.
-otherwise following {."
-  ;; We suppose that the preceding char is }.
-  (save-excursion
-    (condition-case nil
-	(progn
-	  (or pre-block (forward-sexp -1))
-	  (cperl-backward-to-noncomment lim)
-	  (or (eq (point) lim)
-	      (eq (preceding-char) ?\) ) ; if () {}    sub f () {}
-	      (if (eq (char-syntax (preceding-char)) ?w) ; else {}
-		  (save-excursion
-		    (forward-sexp -1)
-		    (or (looking-at "\\(else\\|continue\\|grep\\|map\\|BEGIN\\|END\\|CHECK\\|INIT\\)\\>")
-			;; sub f {}
-			(progn
-			  (cperl-backward-to-noncomment lim)
-			  (and (eq (char-syntax (preceding-char)) ?w)
-			       (progn
-				 (forward-sexp -1)
-				 (looking-at "sub\\>"))))))
-		(cperl-after-expr-p lim))))
-      (error nil))))
-
-(defun cperl-after-expr-p (&optional lim chars test)
-  "Return true if the position is good for start of expression.
-TEST is the expression to evaluate at the found position.  If absent,
-CHARS is a string that contains good characters to have before us (however,
-`}' is treated \"smartly\" if it is not in the list)."
-  (let ((lim (or lim (point-min)))
-	stop p pr)
-    (cperl-update-syntaxification (point) (point))
-    (save-excursion
-      (while (and (not stop) (> (point) lim))
-	(skip-chars-backward " \t\n\f" lim)
-	(setq p (point))
-	(beginning-of-line)
-	;;(memq (setq pr (get-text-property (point) 'syntax-type))
-	;;      '(pod here-doc here-doc-delim))
-	(if (get-text-property (point) 'here-doc-group)
-	    (progn
-	      (goto-char
-	       (previous-single-property-change (point) 'here-doc-group))
-	      (beginning-of-line 0)))
-	(if (get-text-property (point) 'in-pod)
-	    (progn
-	      (goto-char
-	       (previous-single-property-change (point) 'in-pod))
-	      (beginning-of-line 0)))
-	(if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
-	  ;; Else: last iteration, or a label
-	  (cperl-to-comment-or-eol)	; Will not move past "." after a format
-	  (skip-chars-backward " \t")
-	  (if (< p (point)) (goto-char p))
-	  (setq p (point))
-	  (if (and (eq (preceding-char) ?:)
-		   (progn
-		     (forward-char -1)
-		     (skip-chars-backward " \t\n\f" lim)
-		     (eq (char-syntax (preceding-char)) ?w)))
-	      (forward-sexp -1)		; Possibly label.  Skip it
-	    (goto-char p)
-	    (setq stop t))))
-      (or (bobp)			; ???? Needed
-	  (eq (point) lim)
-	  (looking-at "[ \t]*__\\(END\\|DATA\\)__") ; After this anything goes
-	  (progn
-	    (if test (eval test)
-	      (or (memq (preceding-char) (append (or chars "{;") nil))
-		  (and (eq (preceding-char) ?\})
-		       (cperl-after-block-p lim))
-		  (and (eq (following-char) ?.)	; in format: see comment above
-		       (eq (get-text-property (point) 'syntax-type)
-			   'format)))))))))
-
-(defun cperl-backward-to-start-of-continued-exp (lim)
-  (if (memq (preceding-char) (append ")]}\"'`" nil))
-      (forward-sexp -1))
-  (beginning-of-line)
-  (if (<= (point) lim)
-      (goto-char (1+ lim)))
-  (skip-chars-forward " \t"))
-
-(defun cperl-after-block-and-statement-beg (lim)
-  ;; We assume that we are after ?\}
-  (and
-   (cperl-after-block-p lim)
-   (save-excursion
-     (forward-sexp -1)
-     (cperl-backward-to-noncomment (point-min))
-     (or (bobp)
-	 (eq (point) lim)
-	 (not (= (char-syntax (preceding-char)) ?w))
-	 (progn
-	   (forward-sexp -1)
-	   (not
-	    (looking-at
-	     "\\(map\\|grep\\|printf?\\|system\\|exec\\|tr\\|s\\)\\>")))))))
-
-
-(defvar innerloop-done nil)
-(defvar last-depth nil)
-
-(defun cperl-indent-exp ()
-  "Simple variant of indentation of continued-sexp.
-
-Will not indent comment if it starts at `comment-indent' or looks like
-continuation of the comment on the previous line.
-
-If `cperl-indent-region-fix-constructs', will improve spacing on
-conditional/loop constructs."
-  (interactive)
-  (save-excursion
-    (let ((tmp-end (progn (end-of-line) (point))) top done)
-      (save-excursion
-	(beginning-of-line)
-	(while (null done)
-	  (setq top (point))
-	  (while (= (nth 0 (parse-partial-sexp (point) tmp-end
-					       -1)) -1)
-	    (setq top (point)))		; Get the outermost parenths in line
-	  (goto-char top)
-	  (while (< (point) tmp-end)
-	    (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
-	    (or (eolp) (forward-sexp 1)))
-	  (if (> (point) tmp-end)
-	      (save-excursion
-		(end-of-line)
-		(setq tmp-end (point)))
-	    (setq done t)))
-	(goto-char tmp-end)
-	(setq tmp-end (point-marker)))
-      (if cperl-indent-region-fix-constructs
-	  (cperl-fix-line-spacing tmp-end))
-      (cperl-indent-region (point) tmp-end))))
-
-(defun cperl-fix-line-spacing (&optional end parse-data)
-  "Improve whitespace in a conditional/loop construct.
-Returns some position at the last line."
-  (interactive)
-  (or end
-      (setq end (point-max)))
-  (let ((ee (save-excursion (end-of-line) (point)))
-	(cperl-indent-region-fix-constructs
-	 (or cperl-indent-region-fix-constructs 1))
-	p pp ml have-brace ret)
-    (save-excursion
-      (beginning-of-line)
-      (setq ret (point))
-      ;;  }? continue
-      ;;  blah; }
-      (if (not
-	   (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)")
-	       (setq have-brace (save-excursion (search-forward "}" ee t)))))
-	  nil				; Do not need to do anything
-	;; Looking at:
-	;; }
-	;; else
-	(if (and cperl-merge-trailing-else
-		 (looking-at
-		  "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>"))
-	    (progn
-	      (search-forward "}")
-	      (setq p (point))
-	      (skip-chars-forward " \t\n")
-	      (delete-region p (point))
-	      (insert (make-string cperl-indent-region-fix-constructs ?\ ))
-	      (beginning-of-line)))
-	;; Looking at:
-	;; }     else
-	(if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>")
-	    (progn
-	      (search-forward "}")
-	      (delete-horizontal-space)
-	      (insert (make-string cperl-indent-region-fix-constructs ?\ ))
-	      (beginning-of-line)))
-	;; Looking at:
-	;; else   {
-	(if (looking-at
-	     "[ \t]*}?[ \t]*\\<\\(\\els\\(e\\|if\\)\\|continue\\|unless\\|if\\|while\\|for\\(each\\)?\\|until\\)\\>\\(\t*\\|[ \t][ \t]+\\)[^ \t\n#]")
-	    (progn
-	      (forward-word 1)
-	      (delete-horizontal-space)
-	      (insert (make-string cperl-indent-region-fix-constructs ?\ ))
-	      (beginning-of-line)))
-	;; Looking at:
-	;; foreach my    $var
-	(if (looking-at
-	     "[ \t]*\\\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{")
-	    (progn
-	      (setq ml (match-beginning 8))
-	      (re-search-forward "[({]")
-	      (forward-char -1)
-	      (setq p (point))
-	      (if (eq (following-char) ?\( )
-		  (progn
-		    (forward-sexp 1)
-		    (setq pp (point)))
-		;; after `else' or nothing
-		(if ml			; after `else'
-		    (skip-chars-backward " \t\n")
-		  (beginning-of-line))
-		(setq pp nil))
-	      ;; Now after the sexp before the brace
-	      ;; Multiline expr should be special
-	      (setq ml (and pp (save-excursion (goto-char p)
-					       (search-forward "\n" pp t))))
-	      (if (and (or (not pp) (< pp end))
-		       (looking-at "[ \t\n]*{"))
-		  (progn
-		    (cond
-		     ((bolp)		; Were before `{', no if/else/etc
-		      nil)
-		     ((looking-at "\\(\t*\\| [ \t]+\\){")
-		      (delete-horizontal-space)
-		      (if (if ml
-			      cperl-extra-newline-before-brace-multiline
-			    cperl-extra-newline-before-brace)
-			  (progn
-			    (delete-horizontal-space)
-			    (insert "\n")
-			    (setq ret (point))
-			    (if (cperl-indent-line parse-data)
-				(progn
-				  (cperl-fix-line-spacing end parse-data)
-				  (setq ret (point)))))
-			(insert
-			 (make-string cperl-indent-region-fix-constructs ?\ ))))
-		     ((and (looking-at "[ \t]*\n")
-			   (not (if ml
-				    cperl-extra-newline-before-brace-multiline
-				  cperl-extra-newline-before-brace)))
-		      (setq pp (point))
-		      (skip-chars-forward " \t\n")
-		      (delete-region pp (point))
-		      (insert
-		       (make-string cperl-indent-region-fix-constructs ?\ ))))
-		    ;; Now we are before `{'
-		    (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]")
-			(progn
-			  (skip-chars-forward " \t\n")
-			  (setq pp (point))
-			  (forward-sexp 1)
-			  (setq p (point))
-			  (goto-char pp)
-			  (setq ml (search-forward "\n" p t))
-			  (if (or cperl-break-one-line-blocks-when-indent ml)
-			      ;; not good: multi-line BLOCK
-			      (progn
-				(goto-char (1+ pp))
-				(delete-horizontal-space)
-				(insert "\n")
-				(setq ret (point))
-				(if (cperl-indent-line parse-data)
-				    (setq ret (cperl-fix-line-spacing end parse-data)))))))))))
-	(beginning-of-line)
-	(setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee.
-	;; Now check whether there is a hanging `}'
-	;; Looking at:
-	;; } blah
-	(if (and
-	     cperl-fix-hanging-brace-when-indent
-	     have-brace
-	     (not (looking-at "[ \t]*}[ \t]*\\(\\<\\(els\\(if\\|e\\)\\|continue\\|while\\|until\\)\\>\\|$\\|#\\)"))
-	     (condition-case nil
-		 (progn
-		   (up-list 1)
-		   (if (and (<= (point) pp)
-			    (eq (preceding-char) ?\} )
-			    (cperl-after-block-and-statement-beg (point-min)))
-		       t
-		     (goto-char p)
-		     nil))
-	       (error nil)))
-	    (progn
-	      (forward-char -1)
-	      (skip-chars-backward " \t")
-	      (if (bolp)
-		  ;; `}' was the first thing on the line, insert NL *after* it.
-		  (progn
-		    (cperl-indent-line parse-data)
-		    (search-forward "}")
-		    (delete-horizontal-space)
-		    (insert "\n"))
-		(delete-horizontal-space)
-		(or (eq (preceding-char) ?\;)
-		    (bolp)
-		    (and (eq (preceding-char) ?\} )
-			 (cperl-after-block-p (point-min)))
-		    (insert ";"))
-		(insert "\n")
-		(setq ret (point)))
-	      (if (cperl-indent-line parse-data)
-		  (setq ret (cperl-fix-line-spacing end parse-data)))
-	      (beginning-of-line)))))
-    ret))
-
-(defvar cperl-update-start)		; Do not need to make them local
-(defvar cperl-update-end)
-(defun cperl-delay-update-hook (beg end old-len)
-  (setq cperl-update-start (min beg (or cperl-update-start (point-max))))
-  (setq cperl-update-end (max end (or cperl-update-end (point-min)))))
-
-(defun cperl-indent-region (start end)
-  "Simple variant of indentation of region in CPerl mode.
-Should be slow.  Will not indent comment if it starts at `comment-indent'
-or looks like continuation of the comment on the previous line.
-Indents all the lines whose first character is between START and END
-inclusive.
-
-If `cperl-indent-region-fix-constructs', will improve spacing on
-conditional/loop constructs."
-  (interactive "r")
-  (cperl-update-syntaxification end end)
-  (save-excursion
-    (let (cperl-update-start cperl-update-end (h-a-c after-change-functions))
-      (let ((indent-info (if cperl-emacs-can-parse
-			     (list nil nil nil)	; Cannot use '(), since will modify
-			   nil))
-	    (pm 0) (imenu-scanning-message "Indenting... (%3d%%)")
-	    after-change-functions	; Speed it up!
-	    st comm old-comm-indent new-comm-indent p pp i empty)
-	(if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook))
-	(goto-char start)
-	(setq old-comm-indent (and (cperl-to-comment-or-eol)
-				   (current-column))
-	      new-comm-indent old-comm-indent)
-	(goto-char start)
-	(setq end (set-marker (make-marker) end)) ; indentation changes pos
-	(or (bolp) (beginning-of-line 2))
-	(or (fboundp 'imenu-progress-message)
-	    (message "Indenting... For feedback load `imenu'..."))
-	(while (and (<= (point) end) (not (eobp))) ; bol to check start
-	  (and (fboundp 'imenu-progress-message)
-	       (imenu-progress-message
-		pm (/ (* 100 (- (point) start)) (- end start -1))))
-	  (setq st (point))
-	  (if (or
-	       (setq empty (looking-at "[ \t]*\n"))
-	       (and (setq comm (looking-at "[ \t]*#"))
-		    (or (eq (current-indentation) (or old-comm-indent
-						      comment-column))
-			(setq old-comm-indent nil))))
-	      (if (and old-comm-indent
-		       (not empty)
-		       (= (current-indentation) old-comm-indent)
-		       (not (eq (get-text-property (point) 'syntax-type) 'pod))
-		       (not (eq (get-text-property (point) 'syntax-table)
-				cperl-st-cfence)))
-		  (let ((comment-column new-comm-indent))
-		    (indent-for-comment)))
-	    (progn
-	      (setq i (cperl-indent-line indent-info))
-	      (or comm
-		  (not i)
-		  (progn
-		    (if cperl-indent-region-fix-constructs
-			(goto-char (cperl-fix-line-spacing end indent-info)))
-		    (if (setq old-comm-indent
-			      (and (cperl-to-comment-or-eol)
-				   (not (memq (get-text-property (point)
-								 'syntax-type)
-					      '(pod here-doc)))
-				   (not (eq (get-text-property (point)
-							       'syntax-table)
-					    cperl-st-cfence))
-				   (current-column)))
-			(progn (indent-for-comment)
-			       (skip-chars-backward " \t")
-			       (skip-chars-backward "#")
-			       (setq new-comm-indent (current-column))))))))
-	  (beginning-of-line 2))
-      	(if (fboundp 'imenu-progress-message)
-	    (imenu-progress-message pm 100)
-	  (message nil)))
-      ;; Now run the update hooks
-      (and after-change-functions
-	   cperl-update-end
-	   (save-excursion
-	     (goto-char cperl-update-end)
-	     (insert " ")
-	     (delete-char -1)
-	     (goto-char cperl-update-start)
-	     (insert " ")
-	     (delete-char -1))))))
-
-;; Stolen from lisp-mode with a lot of improvements
-;; XEmacs change: 5Dec2001: modified to always return t
-(defun cperl-fill-paragraph (&optional justify iteration)
-  "Like \\[fill-paragraph], but handle CPerl comments.
-If any of the current line is a comment, fill the comment or the
-block of it that point is in, preserving the comment's initial
-indentation and initial hashes.  Behaves usually outside of comment."
-  (interactive "P")
-  (let (;; Non-nil if the current line contains a comment.
-	has-comment
-
-	;; If has-comment, the appropriate fill-prefix for the comment.
-	comment-fill-prefix
-	;; Line that contains code and comment (or nil)
-	start
-	c spaces len dc (comment-column comment-column))
-    ;; Figure out what kind of comment we are looking at.
-    (save-excursion
-      (beginning-of-line)
-      (cond
-
-       ;; A line with nothing but a comment on it?
-       ((looking-at "[ \t]*#[# \t]*")
-	(setq has-comment t
-	      comment-fill-prefix (buffer-substring (match-beginning 0)
-						    (match-end 0))))
-
-       ;; A line with some code, followed by a comment?  Remember that the
-       ;; semi which starts the comment shouldn't be part of a string or
-       ;; character.
-       ((cperl-to-comment-or-eol)
-	(setq has-comment t)
-	(looking-at "#+[ \t]*")
-	(setq start (point) c (current-column)
-	      comment-fill-prefix
-	      (concat (make-string (current-column) ?\ )
-		      (buffer-substring (match-beginning 0) (match-end 0)))
-	      spaces (progn (skip-chars-backward " \t")
-			    (buffer-substring (point) start))
-	      dc (- c (current-column)) len (- start (point))
-	      start (point-marker))
-	(delete-char len)
-	(insert (make-string dc ?-)))))
-    (if (not has-comment)
-	(fill-paragraph justify)       ; Do the usual thing outside of comment
-      ;; Narrow to include only the comment, and then fill the region.
-      (save-restriction
-	(narrow-to-region
-	 ;; Find the first line we should include in the region to fill.
-	 (if start (progn (beginning-of-line) (point))
-	   (save-excursion
-	     (while (and (zerop (forward-line -1))
-			 (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")))
-	     ;; We may have gone to far.  Go forward again.
-	     (or (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")
-		 (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]*#+[ \t]*[^ \t\n#]")))
-	   (point)))
-	;; Remove existing hashes
-	(goto-char (point-min))
-	(while (progn (forward-line 1) (< (point) (point-max)))
-	  (skip-chars-forward " \t")
-	  (and (looking-at "#+")
-	       (delete-char (- (match-end 0) (match-beginning 0)))))
-
-	;; Lines with only hashes on them can be paragraph boundaries.
-	(let ((paragraph-start (concat paragraph-start "\\|^[ \t#]*$"))
-	      (paragraph-separate (concat paragraph-start "\\|^[ \t#]*$"))
-	      (fill-prefix comment-fill-prefix))
-	  (fill-paragraph justify)))
-      (if (and start)
-	  (progn
-	    (goto-char start)
-	    (if (> dc 0)
-		(progn (delete-char dc) (insert spaces)))
-	    (if (or (= (current-column) c) iteration) nil
-	      (setq comment-column c)
-	      (indent-for-comment)
-	      ;; Repeat once more, flagging as iteration
-	      (cperl-fill-paragraph justify t))))))
-  t)
-
-(defun cperl-do-auto-fill ()
-  ;; Break out if the line is short enough
-  (if (> (save-excursion
-	   (end-of-line)
-	   (current-column))
-	 fill-column)
-      (let ((c (save-excursion (beginning-of-line)
-			       (cperl-to-comment-or-eol) (point)))
-	    (s (memq (following-char) '(?\ ?\t))) marker)
-	(if (>= c (point)) nil
-	  (setq marker (point-marker))
-	  (cperl-fill-paragraph)
-	  (goto-char marker)
-	  ;; Is not enough, sometimes marker is a start of line
-	  (if (bolp) (progn (re-search-forward "#+[ \t]*")
-			    (goto-char (match-end 0))))
-	  ;; Following space could have gone:
-	  (if (or (not s) (memq (following-char) '(?\ ?\t))) nil
-	    (insert " ")
-	    (backward-char 1))
-	  ;; Previous space could have gone:
-	  (or (memq (preceding-char) '(?\ ?\t)) (insert " "))))))
-
-(defun cperl-imenu-addback (lst &optional isback name)
-  ;; We suppose that the lst is a DAG, unless the first element only
-  ;; loops back, and ISBACK is set.  Thus this function cannot be
-  ;; applied twice without ISBACK set.
-  (cond ((not cperl-imenu-addback) lst)
-	(t
-	 (or name
-	     (setq name "+++BACK+++"))
-	 (mapcar (lambda (elt)
-		   (if (and (listp elt) (listp (cdr elt)))
-		       (progn
-			 ;; In the other order it goes up
-			 ;; one level only ;-(
-			 (setcdr elt (cons (cons name lst)
-					   (cdr elt)))
-			 (cperl-imenu-addback (cdr elt) t name))))
-		 (if isback (cdr lst) lst))
-	 lst)))
-
-(defun cperl-imenu--create-perl-index (&optional regexp)
-  (require 'cl)
-  (require 'imenu)			; May be called from TAGS creator
-  (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '())
-	(index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function))
-	(index-meth-alist '()) meth
-	packages ends-ranges p marker
-	(prev-pos 0) char fchar index index1 name (end-range 0) package)
-    (goto-char (point-min))
-    (if noninteractive
-	(message "Scanning Perl for index")
-      (imenu-progress-message prev-pos 0))
-    (cperl-update-syntaxification (point-max) (point-max))
-    ;; Search for the function
-    (progn ;;save-match-data
-      (while (re-search-forward
-	      (or regexp cperl-imenu--function-name-regexp-perl)
-	      nil t)
-	(or noninteractive
-	    (imenu-progress-message prev-pos))
-	(cond
-	 ((and				; Skip some noise if building tags
-	   (match-beginning 2)		; package or sub
-	   (eq (char-after (match-beginning 2)) ?p) ; package
-	   (not (save-match-data
-		  (looking-at "[ \t\n]*;")))) ; Plain text word 'package'
-	  nil)
-	 ((and
-	   (match-beginning 2)		; package or sub
-	   ;; Skip if quoted (will not skip multi-line ''-strings :-():
-	   (null (get-text-property (match-beginning 1) 'syntax-table))
-	   (null (get-text-property (match-beginning 1) 'syntax-type))
-	   (null (get-text-property (match-beginning 1) 'in-pod)))
-	  (save-excursion
-	    (goto-char (match-beginning 2))
-	    (setq fchar (following-char)))
-	  ;; (if (looking-at "([^()]*)[ \t\n\f]*")
-	  ;;    (goto-char (match-end 0)))	; Messes what follows
-	  (setq char (following-char)	; ?\; for "sub foo () ;"
-		meth nil
-		p (point))
-	  (while (and ends-ranges (>= p (car ends-ranges)))
-	    ;; delete obsolete entries
-	    (setq ends-ranges (cdr ends-ranges) packages (cdr packages)))
-	  (setq package (or (car packages) "")
-		end-range (or (car ends-ranges) 0))
-	  (if (eq fchar ?p)
-	      (setq name (buffer-substring (match-beginning 3) (match-end 3))
-		    name (progn
-			   (set-text-properties 0 (length name) nil name)
-			   name)
-		    package (concat name "::")
-		    name (concat "package " name)
-		    end-range
-		    (save-excursion
-		      (parse-partial-sexp (point) (point-max) -1) (point))
-		    ends-ranges (cons end-range ends-ranges)
-		    packages (cons package packages)))
-	  ;;   )
-	  ;; Skip this function name if it is a prototype declaration.
-	  (if (and (eq fchar ?s) (eq char ?\;)) nil
-	    (setq name (buffer-substring (match-beginning 3) (match-end 3))
-		  marker (make-marker))
-	    (set-text-properties 0 (length name) nil name)
-	    (set-marker marker (match-end 3))
-	    (if (eq fchar ?p)
-		(setq name (concat "package " name))
-	      (cond ((string-match "[:']" name)
-		     (setq meth t))
-		    ((> p end-range) nil)
-		    (t
-		     (setq name (concat package name) meth t))))
-	    (setq index (cons name marker))
-	    (if (eq fchar ?p)
-		(push index index-pack-alist)
-	      (push index index-alist))
-	    (if meth (push index index-meth-alist))
-	    (push index index-unsorted-alist)))
-	 ((match-beginning 5)		; POD section
-	  ;; (beginning-of-line)
-	  (setq index (imenu-example--name-and-position)
-		name (buffer-substring (match-beginning 6) (match-end 6)))
-	  (set-text-properties 0 (length name) nil name)
-	  (if (eq (char-after (match-beginning 5)) ?2)
-	      (setq name (concat "   " name)))
-	  (setcar index name)
-	  (setq index1 (cons (concat "=" name) (cdr index)))
-	  (push index index-pod-alist)
-	  (push index1 index-unsorted-alist)))))
-    (or noninteractive
-	(imenu-progress-message prev-pos 100))
-    (setq index-alist
-	  (if (default-value 'imenu-sort-function)
-	      (sort index-alist (default-value 'imenu-sort-function))
-	    (nreverse index-alist)))
-    (and index-pod-alist
-	 (push (cons "+POD headers+..."
-		     (nreverse index-pod-alist))
-	       index-alist))
-    (and (or index-pack-alist index-meth-alist)
-	 (let ((lst index-pack-alist) hier-list pack elt group name)
-	   ;; Remove "package ", reverse and uniquify.
-	   (while lst
-	     (setq elt (car lst) lst (cdr lst) name (substring (car elt) 8))
-	     (if (assoc name hier-list) nil
-	       (setq hier-list (cons (cons name (cdr elt)) hier-list))))
-	   (setq lst index-meth-alist)
-	   (while lst
-	     (setq elt (car lst) lst (cdr lst))
-	     (cond ((string-match "\\(::\\|'\\)[_a-zA-Z0-9]+$" (car elt))
-		    (setq pack (substring (car elt) 0 (match-beginning 0)))
-		    (if (setq group (assoc pack hier-list))
-			(if (listp (cdr group))
-			    ;; Have some functions already
-			    (setcdr group
-				    (cons (cons (substring
-						 (car elt)
-						 (+ 2 (match-beginning 0)))
-						(cdr elt))
-					  (cdr group)))
-			  (setcdr group (list (cons (substring
-						     (car elt)
-						     (+ 2 (match-beginning 0)))
-						    (cdr elt)))))
-		      (setq hier-list
-			    (cons (cons pack
-					(list (cons (substring
-						     (car elt)
-						     (+ 2 (match-beginning 0)))
-						    (cdr elt))))
-				  hier-list))))))
-	   (push (cons "+Hierarchy+..."
-		       hier-list)
-		 index-alist)))
-    (and index-pack-alist
-	 (push (cons "+Packages+..."
-		     (nreverse index-pack-alist))
-	       index-alist))
-    (and (or index-pack-alist index-pod-alist
-	     (default-value 'imenu-sort-function))
-	 index-unsorted-alist
-	 (push (cons "+Unsorted List+..."
-		     (nreverse index-unsorted-alist))
-	       index-alist))
-    (cperl-imenu-addback index-alist)))
-
-
-;; Suggested by Mark A. Hershberger
-(defun cperl-outline-level ()
-  (looking-at outline-regexp)
-  (cond ((not (match-beginning 1)) 0)	; beginning-of-file
-	((match-beginning 2)
-	 (if (eq (char-after (match-beginning 2)) ?p)
-	     0				; package
-	   1))				; sub
-	((match-beginning 5)
-	 (if (eq (char-after (match-beginning 5)) ?1)
-	     1				; head1
-	   2))				; head2
-	(t 3)))				; should not happen
-
-
-(defvar cperl-compilation-error-regexp-alist
-  ;; This look like a paranoiac regexp: could anybody find a better one? (which WORK).
-  '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
-     2 3))
-  "Alist that specifies how to match errors in perl output.")
-
-(if (fboundp 'eval-after-load)
-    (eval-after-load
-	"mode-compile"
-      '(setq perl-compilation-error-regexp-alist
-	     cperl-compilation-error-regexp-alist)))
-
-
-(defun cperl-windowed-init ()
-  "Initialization under windowed version."
-  (if (or (featurep 'ps-print) cperl-faces-init)
-      ;; Need to init anyway:
-      (or cperl-faces-init (cperl-init-faces))
-    (add-hook 'font-lock-mode-hook
-	      (function
-	       (lambda ()
-		 (if (memq major-mode '(perl-mode cperl-mode))
-		     (progn
-		       (or cperl-faces-init (cperl-init-faces)))))))
-    (if (fboundp 'eval-after-load)
-	(eval-after-load
-	    "ps-print"
-	  '(or cperl-faces-init (cperl-init-faces))))))
-
-(defun cperl-load-font-lock-keywords ()
-  (or cperl-faces-init (cperl-init-faces))
-  perl-font-lock-keywords)
-
-(defun cperl-load-font-lock-keywords-1 ()
-  (or cperl-faces-init (cperl-init-faces))
-  perl-font-lock-keywords-1)
-
-(defun cperl-load-font-lock-keywords-2 ()
-  (or cperl-faces-init (cperl-init-faces))
-  perl-font-lock-keywords-2)
-
-(defvar perl-font-lock-keywords-1 nil
-  "Additional expressions to highlight in Perl mode.  Minimal set.")
-(defvar perl-font-lock-keywords nil
-  "Additional expressions to highlight in Perl mode.  Default set.")
-(defvar perl-font-lock-keywords-2 nil
-  "Additional expressions to highlight in Perl mode.  Maximal set.")
-
-(defvar font-lock-background-mode)
-(defvar font-lock-display-type)
-(defun cperl-init-faces-weak ()
-  ;; Allow `cperl-find-pods-heres' to run.
-  (or (boundp 'font-lock-constant-face)
-      (cperl-force-face font-lock-constant-face
-                        "Face for constant and label names")
-      ;;(setq font-lock-constant-face 'font-lock-constant-face)
-      ))
-
-(defun cperl-init-faces ()
-  (condition-case errs
-      (progn
-	(require 'font-lock)
-	(and (fboundp 'font-lock-fontify-anchored-keywords)
-	     (featurep 'font-lock-extra)
-	     (message "You have an obsolete package `font-lock-extra'.  Install `choose-color'."))
-	(let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored)
-	  (if (fboundp 'font-lock-fontify-anchored-keywords)
-	      (setq font-lock-anchored t))
-	  (setq
-	   t-font-lock-keywords
-	   (list
-	    (list "[ \t]+$" 0 cperl-invalid-face t)
-	    (cons
-	     (concat
-	      "\\(^\\|[^$@%&\\]\\)\\<\\("
-	      (mapconcat
-	       'identity
-	       '("if" "until" "while" "elsif" "else" "unless" "for"
-		 "foreach" "continue" "exit" "die" "last" "goto" "next"
-		 "redo" "return" "local" "exec" "sub" "do" "dump" "use"
-		 "require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT")
-	       "\\|")			; Flow control
-	      "\\)\\>") 2)		; was "\\)[ \n\t;():,\|&]"
-					; In what follows we use `type' style
-					; for overwritable builtins
-	    (list
-	     (concat
-	      "\\(^\\|[^$@%&\\]\\)\\<\\("
-	      ;; "CORE" "__FILE__" "__LINE__" "abs" "accept" "alarm"
-	      ;; "and" "atan2" "bind" "binmode" "bless" "caller"
-	      ;; "chdir" "chmod" "chown" "chr" "chroot" "close"
-	      ;; "closedir" "cmp" "connect" "continue" "cos" "crypt"
-	      ;; "dbmclose" "dbmopen" "die" "dump" "endgrent"
-	      ;; "endhostent" "endnetent" "endprotoent" "endpwent"
-	      ;; "endservent" "eof" "eq" "exec" "exit" "exp" "fcntl"
-	      ;; "fileno" "flock" "fork" "formline" "ge" "getc"
-	      ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
-	      ;; "gethostbyname" "gethostent" "getlogin"
-	      ;; "getnetbyaddr" "getnetbyname" "getnetent"
-	      ;; "getpeername" "getpgrp" "getppid" "getpriority"
-	      ;; "getprotobyname" "getprotobynumber" "getprotoent"
-	      ;; "getpwent" "getpwnam" "getpwuid" "getservbyname"
-	      ;; "getservbyport" "getservent" "getsockname"
-	      ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int"
-	      ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length"
-	      ;; "link" "listen" "localtime" "lock" "log" "lstat" "lt"
-	      ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne"
-	      ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
-	      ;; "quotemeta" "rand" "read" "readdir" "readline"
-	      ;; "readlink" "readpipe" "recv" "ref" "rename" "require"
-	      ;; "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek"
-	      ;; "seekdir" "select" "semctl" "semget" "semop" "send"
-	      ;; "setgrent" "sethostent" "setnetent" "setpgrp"
-	      ;; "setpriority" "setprotoent" "setpwent" "setservent"
-	      ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite"
-	      ;; "shutdown" "sin" "sleep" "socket" "socketpair"
-	      ;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink"
-	      ;; "syscall" "sysopen" "sysread" "system" "syswrite" "tell"
-	      ;; "telldir" "time" "times" "truncate" "uc" "ucfirst"
-	      ;; "umask" "unlink" "unpack" "utime" "values" "vec"
-	      ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor"
-	      "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|"
-	      "b\\(in\\(d\\|mode\\)\\|less\\)\\|"
-	      "c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|"
-	      "lose\\(\\|dir\\)\\|mp\\|o\\(s\\|n\\(tinue\\|nect\\)\\)\\)\\|"
-	      "CORE\\|d\\(ie\\|bm\\(close\\|open\\)\\|ump\\)\\|"
-	      "e\\(x\\(p\\|it\\|ec\\)\\|q\\|nd\\(p\\(rotoent\\|went\\)\\|"
-	      "hostent\\|servent\\|netent\\|grent\\)\\|of\\)\\|"
-	      "f\\(ileno\\|cntl\\|lock\\|or\\(k\\|mline\\)\\)\\|"
-	      "g\\(t\\|lob\\|mtime\\|e\\(\\|t\\(p\\(pid\\|r\\(iority\\|"
-	      "oto\\(byn\\(ame\\|umber\\)\\|ent\\)\\)\\|eername\\|w"
-	      "\\(uid\\|ent\\|nam\\)\\|grp\\)\\|host\\(by\\(addr\\|name\\)\\|"
-	      "ent\\)\\|s\\(erv\\(by\\(port\\|name\\)\\|ent\\)\\|"
-	      "ock\\(name\\|opt\\)\\)\\|c\\|login\\|net\\(by\\(addr\\|name\\)\\|"
-	      "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|"
-	      "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|"
-	      "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e"
-	      "\\(\\|ngth\\)\\|o\\(c\\(altime\\|k\\)\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|"
-	      "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|"
-	      "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|"
-	      "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin"
-	      "\\(k\\|e\\)\\|dir\\)\\|set\\|cv\\|verse\\|f\\|winddir\\|name"
-	      "\\)\\)\\|s\\(printf\\|qrt\\|rand\\|tat\\|ubstr\\|e\\(t\\(p\\(r"
-	      "\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|"
-	      "ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|"
-	      "m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|"
-	      "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|open\\|tem\\|write\\)\\|"
-	      "mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|"
-	      "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|"
-	      "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|"
-	      "w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|"
-	      "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\|PACKAGE__\\)"
-	      "\\)\\>") 2 'font-lock-type-face)
-	    ;; In what follows we use `other' style
-	    ;; for nonoverwritable builtins
-	    ;; Somehow 's', 'm' are not auto-generated???
-	    (list
-	     (concat
-	      "\\(^\\|[^$@%&\\]\\)\\<\\("
-	      ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "__END__" "chomp"
-	      ;; "chop" "defined" "delete" "do" "each" "else" "elsif"
-	      ;; "eval" "exists" "for" "foreach" "format" "goto"
-	      ;; "grep" "if" "keys" "last" "local" "map" "my" "next"
-	      ;; "no" "package" "pop" "pos" "print" "printf" "push"
-	      ;; "q" "qq" "qw" "qx" "redo" "return" "scalar" "shift"
-	      ;; "sort" "splice" "split" "study" "sub" "tie" "tr"
-	      ;; "undef" "unless" "unshift" "untie" "until" "use"
-	      ;; "while" "y"
-	      "AUTOLOAD\\|BEGIN\\|CHECK\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|"
-	      "o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|"
-	      "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|INIT\\|if\\|keys\\|"
-	      "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our\\|"
-	      "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|"
-	      "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|"
-	      "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|"
-	      "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
-	      "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
-	      "\\|[sm]"			; Added manually
-	      "\\)\\>") 2 'cperl-nonoverridable-face)
-	    ;;		(mapconcat 'identity
-	    ;;			   '("#endif" "#else" "#ifdef" "#ifndef" "#if"
-	    ;;			     "#include" "#define" "#undef")
-	    ;;			   "\\|")
-	    '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
-	      font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
-	    '("\\*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
-		     (2 font-lock-string-face t)
-		     (0 '(restart 2 t)))) ; To highlight $a{bc}{ef}
-		  (font-lock-anchored
-		   '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
-		     (2 font-lock-string-face t)
-		     ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
-		      nil nil
-		      (1 font-lock-string-face t))))
-		  (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
-		       2 font-lock-string-face t)))
-	    '("[\[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
-	      font-lock-string-face t)
-	    '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1
-	      font-lock-constant-face)	; labels
-	    '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets
-	      2 font-lock-constant-face)
-	    ;; Uncomment to get perl-mode-like vars
-            ;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face)
-            ;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
-            ;;;  (2 (cons font-lock-variable-name-face '(underline))))
-	    (cond ((featurep 'font-lock-extra)
-		   '("^[ \t]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
-		     (3 font-lock-variable-name-face)
-		     (4 '(another 4 nil
-				  ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
-				   (1 font-lock-variable-name-face)
-				   (2 '(restart 2 nil) nil t)))
-			nil t)))	; local variables, multiple
-		  (font-lock-anchored
-		   '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
-		     (3 font-lock-variable-name-face)
-		     ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)"
-		      nil nil
-		      (1 font-lock-variable-name-face))))
-		  (t '("^[ \t{}]*\\(my\\|local\\our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
-		       3 font-lock-variable-name-face)))
-	    '("\\= 19.12
-	  ;;		      ((fboundp 'valid-color-name-p) 'valid-color-name-p)
-	  ;;		      ;; XEmacs 19.11
-	  ;;		      (t 'x-valid-color-name-p))))
-	  (cperl-force-face font-lock-constant-face
-			    "Face for constant and label names")
-	  (cperl-force-face font-lock-variable-name-face
-			    "Face for variable names")
-	  (cperl-force-face font-lock-type-face
-			    "Face for data types")
-	  (cperl-force-face cperl-nonoverridable-face
-			    "Face for data types from another group")
-	  (cperl-force-face font-lock-comment-face
-			    "Face for comments")
-	  (cperl-force-face font-lock-function-name-face
-			    "Face for function names")
-	  (cperl-force-face cperl-hash-face
-			    "Face for hashes")
-	  (cperl-force-face cperl-array-face
-			    "Face for arrays")
-	  ;;(defvar font-lock-constant-face 'font-lock-constant-face)
-	  ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
-	  ;;(or (boundp 'font-lock-type-face)
-	  ;;    (defconst font-lock-type-face
-	  ;;	'font-lock-type-face
-	  ;;	"Face to use for data types."))
-	  ;;(or (boundp 'cperl-nonoverridable-face)
-	  ;;    (defconst cperl-nonoverridable-face
-	  ;;	'cperl-nonoverridable-face
-	  ;;	"Face to use for data types from another group."))
-	  ;;(if (not cperl-xemacs-p) nil
-	  ;;  (or (boundp 'font-lock-comment-face)
-	  ;;	(defconst font-lock-comment-face
-	  ;;	  'font-lock-comment-face
-	  ;;	  "Face to use for comments."))
-	  ;;  (or (boundp 'font-lock-keyword-face)
-	  ;;	(defconst font-lock-keyword-face
-	  ;;	  'font-lock-keyword-face
-	  ;;	  "Face to use for keywords."))
-	  ;;  (or (boundp 'font-lock-function-name-face)
-	  ;;	(defconst font-lock-function-name-face
-	  ;;	  'font-lock-function-name-face
-	  ;;	  "Face to use for function names.")))
-	  (if (and
-	       (not (cperl-is-face 'cperl-array-face))
-	       (cperl-is-face 'font-lock-emphasized-face))
-	      (copy-face 'font-lock-emphasized-face 'cperl-array-face))
-	  (if (and
-	       (not (cperl-is-face 'cperl-hash-face))
-	       (cperl-is-face 'font-lock-other-emphasized-face))
-	      (copy-face 'font-lock-other-emphasized-face
-			 'cperl-hash-face))
-	  (if (and
-	       (not (cperl-is-face 'cperl-nonoverridable-face))
-	       (cperl-is-face 'font-lock-other-type-face))
-	      (copy-face 'font-lock-other-type-face
-			 'cperl-nonoverridable-face))
-	  ;;(or (boundp 'cperl-hash-face)
-	  ;;    (defconst cperl-hash-face
-	  ;;	'cperl-hash-face
-	  ;;	"Face to use for hashes."))
-	  ;;(or (boundp 'cperl-array-face)
-	  ;;    (defconst cperl-array-face
-	  ;;	'cperl-array-face
-	  ;;	"Face to use for arrays."))
-	  ;; Here we try to guess background
-	  (let ((background
-		 (if (boundp 'font-lock-background-mode)
-		     font-lock-background-mode
-		   'light))
-		(face-list (and (fboundp 'face-list) (face-list))))
-;;;;	    (fset 'cperl-is-face
-;;;;		  (cond ((fboundp 'find-face)
-;;;;			 (symbol-function 'find-face))
-;;;;			(face-list
-;;;;			 (function (lambda (face) (member face face-list))))
-;;;;			(t
-;;;;			 (function (lambda (face) (boundp face))))))
-	    (defvar cperl-guessed-background
-	      (if (and (boundp 'font-lock-display-type)
-		       (eq font-lock-display-type 'grayscale))
-		  'gray
-		background)
-	      "Background as guessed by CPerl mode")
-	    (and (not (cperl-is-face 'font-lock-constant-face))
-		 (cperl-is-face 'font-lock-reference-face)
-		 (copy-face 'font-lock-reference-face 'font-lock-constant-face))
-	    (if (cperl-is-face 'font-lock-type-face) nil
-	      (copy-face 'default 'font-lock-type-face)
-	      (cond
-	       ((eq background 'light)
-		(set-face-foreground 'font-lock-type-face
-				     (if (x-color-defined-p "seagreen")
-					 "seagreen"
-				       "sea green")))
-	       ((eq background 'dark)
-		(set-face-foreground 'font-lock-type-face
-				     (if (x-color-defined-p "os2pink")
-					 "os2pink"
-				       "pink")))
-	       (t
-		(set-face-background 'font-lock-type-face "gray90"))))
-	    (if (cperl-is-face 'cperl-nonoverridable-face)
-		nil
-	      (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
-	      (cond
-	       ((eq background 'light)
-		(set-face-foreground 'cperl-nonoverridable-face
-				     (if (x-color-defined-p "chartreuse3")
-					 "chartreuse3"
-				       "chartreuse")))
-	       ((eq background 'dark)
-		(set-face-foreground 'cperl-nonoverridable-face
-				     (if (x-color-defined-p "orchid1")
-					 "orchid1"
-				       "orange")))))
-;;;	    (if (cperl-is-face 'font-lock-other-emphasized-face) nil
-;;;	      (copy-face 'bold-italic 'font-lock-other-emphasized-face)
-;;;	      (cond
-;;;	       ((eq background 'light)
-;;;		(set-face-background 'font-lock-other-emphasized-face
-;;;				     (if (x-color-defined-p "lightyellow2")
-;;;					 "lightyellow2"
-;;;				       (if (x-color-defined-p "lightyellow")
-;;;					   "lightyellow"
-;;;					 "light yellow"))))
-;;;	       ((eq background 'dark)
-;;;		(set-face-background 'font-lock-other-emphasized-face
-;;;				     (if (x-color-defined-p "navy")
-;;;					 "navy"
-;;;				       (if (x-color-defined-p "darkgreen")
-;;;					   "darkgreen"
-;;;					 "dark green"))))
-;;;	       (t (set-face-background 'font-lock-other-emphasized-face "gray90"))))
-;;;	    (if (cperl-is-face 'font-lock-emphasized-face) nil
-;;;	      (copy-face 'bold 'font-lock-emphasized-face)
-;;;	      (cond
-;;;	       ((eq background 'light)
-;;;		(set-face-background 'font-lock-emphasized-face
-;;;				     (if (x-color-defined-p "lightyellow2")
-;;;					 "lightyellow2"
-;;;				       "lightyellow")))
-;;;	       ((eq background 'dark)
-;;;		(set-face-background 'font-lock-emphasized-face
-;;;				     (if (x-color-defined-p "navy")
-;;;					 "navy"
-;;;				       (if (x-color-defined-p "darkgreen")
-;;;					   "darkgreen"
-;;;					 "dark green"))))
-;;;	       (t (set-face-background 'font-lock-emphasized-face "gray90"))))
-	    (if (cperl-is-face 'font-lock-variable-name-face) nil
-	      (copy-face 'italic 'font-lock-variable-name-face))
-	    (if (cperl-is-face 'font-lock-constant-face) nil
-	      (copy-face 'italic 'font-lock-constant-face))))
-	(setq cperl-faces-init t))
-    (error (message "cperl-init-faces (ignored): %s" errs))))
-
-
-(defun cperl-ps-print-init ()
-  "Initialization of `ps-print' components for faces used in CPerl."
-  (eval-after-load "ps-print"
-    '(setq ps-bold-faces
-	   ;; 			font-lock-variable-name-face
-	   ;;			font-lock-constant-face
-	   (append '(cperl-array-face
-		     cperl-hash-face)
-		   ps-bold-faces)
-	   ps-italic-faces
-	   ;;			font-lock-constant-face
-	   (append '(cperl-nonoverridable-face
-		     cperl-hash-face)
-		   ps-italic-faces)
-	   ps-underlined-faces
-	   ;;	     font-lock-type-face
-	   (append '(cperl-array-face
-		     cperl-hash-face
-		     underline
-		     cperl-nonoverridable-face)
-		   ps-underlined-faces))))
-
-(defvar ps-print-face-extension-alist)
-
-(defun cperl-ps-print (&optional file)
-  "Pretty-print in CPerl style.
-If optional argument FILE is an empty string, prints to printer, otherwise
-to the file FILE.  If FILE is nil, prompts for a file name.
-
-Style of printout regulated by the variable `cperl-ps-print-face-properties'."
-  (interactive)
-  (or file
-      (setq file (read-from-minibuffer
-		  "Print to file (if empty - to printer): "
-		  (concat (buffer-file-name) ".ps")
-		  nil nil 'file-name-history)))
-  (or (> (length file) 0)
-      (setq file nil))
-  (require 'ps-print)			; To get ps-print-face-extension-alist
-  (let ((ps-print-color-p t)
-	(ps-print-face-extension-alist ps-print-face-extension-alist))
-    (cperl-ps-extend-face-list cperl-ps-print-face-properties)
-    (ps-print-buffer-with-faces file)))
-
-;;; (defun cperl-ps-print-init ()
-;;;   "Initialization of `ps-print' components for faces used in CPerl."
-;;;   ;; Guard against old versions
-;;;   (defvar ps-underlined-faces nil)
-;;;   (defvar ps-bold-faces nil)
-;;;   (defvar ps-italic-faces nil)
-;;;   (setq ps-bold-faces
-;;; 	(append '(font-lock-emphasized-face
-;;; 		  cperl-array-face
-;;; 		  font-lock-keyword-face
-;;; 		  font-lock-variable-name-face
-;;; 		  font-lock-constant-face
-;;; 		  font-lock-reference-face
-;;; 		  font-lock-other-emphasized-face
-;;; 		  cperl-hash-face)
-;;; 		ps-bold-faces))
-;;;   (setq ps-italic-faces
-;;; 	(append '(cperl-nonoverridable-face
-;;; 		  font-lock-constant-face
-;;; 		  font-lock-reference-face
-;;; 		  font-lock-other-emphasized-face
-;;; 		  cperl-hash-face)
-;;; 		ps-italic-faces))
-;;;   (setq ps-underlined-faces
-;;; 	(append '(font-lock-emphasized-face
-;;; 		  cperl-array-face
-;;; 		  font-lock-other-emphasized-face
-;;; 		  cperl-hash-face
-;;; 		  cperl-nonoverridable-face font-lock-type-face)
-;;; 		ps-underlined-faces))
-;;;   (cons 'font-lock-type-face ps-underlined-faces))
-
-
-(if (cperl-enable-font-lock) (cperl-windowed-init))
-
-(defconst cperl-styles-entries
-  '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset
-    cperl-label-offset cperl-extra-newline-before-brace
-    cperl-merge-trailing-else
-    cperl-continued-statement-offset))
-
-(defconst cperl-style-alist
-  '(("CPerl"			     ; =GNU without extra-newline-before-brace
-     (cperl-indent-level               .  2)
-     (cperl-brace-offset               .  0)
-     (cperl-continued-brace-offset     .  0)
-     (cperl-label-offset               . -2)
-     (cperl-extra-newline-before-brace .  nil)
-     (cperl-merge-trailing-else	       .  t)
-     (cperl-continued-statement-offset .  2))
-    ("PerlStyle"			; CPerl with 4 as indent
-     (cperl-indent-level               .  4)
-     (cperl-brace-offset               .  0)
-     (cperl-continued-brace-offset     .  0)
-     (cperl-label-offset               . -4)
-     (cperl-extra-newline-before-brace .  nil)
-     (cperl-merge-trailing-else	       .  t)
-     (cperl-continued-statement-offset .  4))
-    ("GNU"
-     (cperl-indent-level               .  2)
-     (cperl-brace-offset               .  0)
-     (cperl-continued-brace-offset     .  0)
-     (cperl-label-offset               . -2)
-     (cperl-extra-newline-before-brace .  t)
-     (cperl-merge-trailing-else	       .  nil)
-     (cperl-continued-statement-offset .  2))
-    ("K&R"
-     (cperl-indent-level               .  5)
-     (cperl-brace-offset               .  0)
-     (cperl-continued-brace-offset     . -5)
-     (cperl-label-offset               . -5)
-     ;;(cperl-extra-newline-before-brace .  nil) ; ???
-     (cperl-merge-trailing-else	       .  nil)
-     (cperl-continued-statement-offset .  5))
-    ("BSD"
-     (cperl-indent-level               .  4)
-     (cperl-brace-offset               .  0)
-     (cperl-continued-brace-offset     . -4)
-     (cperl-label-offset               . -4)
-     ;;(cperl-extra-newline-before-brace .  nil) ; ???
-     (cperl-continued-statement-offset .  4))
-    ("C++"
-     (cperl-indent-level               .  4)
-     (cperl-brace-offset               .  0)
-     (cperl-continued-brace-offset     . -4)
-     (cperl-label-offset               . -4)
-     (cperl-continued-statement-offset .  4)
-     (cperl-merge-trailing-else	       .  nil)
-     (cperl-extra-newline-before-brace .  t))
-    ("Current")
-    ("Whitesmith"
-     (cperl-indent-level               .  4)
-     (cperl-brace-offset               .  0)
-     (cperl-continued-brace-offset     .  0)
-     (cperl-label-offset               . -4)
-     ;;(cperl-extra-newline-before-brace .  nil) ; ???
-     (cperl-continued-statement-offset .  4)))
-  "(Experimental) list of variables to set to get a particular indentation style.
-Should be used via `cperl-set-style' or via Perl menu.")
-
-(defun cperl-set-style (style)
-  "Set CPerl mode variables to use one of several different indentation styles.
-The arguments are a string representing the desired style.
-The list of styles is in `cperl-style-alist', available styles
-are GNU, K&R, BSD, C++ and Whitesmith.
-
-The current value of style is memorized (unless there is a memorized
-data already), may be restored by `cperl-set-style-back'.
-
-Chosing \"Current\" style will not change style, so this may be used for
-side-effect of memorizing only."
-  (interactive
-   (let ((list (mapcar (function (lambda (elt) (list (car elt)))) 
-		       cperl-style-alist)))
-     (list (completing-read "Enter style: " list nil 'insist))))
-  (or cperl-old-style
-      (setq cperl-old-style
-	    (mapcar (function
-		     (lambda (name)
-		       (cons name (eval name))))
-		    cperl-styles-entries)))
-  (let ((style (cdr (assoc style cperl-style-alist))) setting str sym)
-    (while style
-      (setq setting (car style) style (cdr style))
-      (set (car setting) (cdr setting)))))
-
-(defun cperl-set-style-back ()
-  "Restore a style memorised by `cperl-set-style'."
-  (interactive)
-  (or cperl-old-style (error "The style was not changed"))
-  (let (setting)
-    (while cperl-old-style
-      (setq setting (car cperl-old-style)
-	    cperl-old-style (cdr cperl-old-style))
-      (set (car setting) (cdr setting)))))
-
-(defun cperl-check-syntax ()
-  (interactive)
-  (require 'mode-compile)
-  (let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc")))
-    (eval '(mode-compile))))		; Avoid a warning
-
-(defun cperl-info-buffer (type)
-  ;; Returns buffer with documentation.  Creates if missing.
-  ;; If TYPE, this vars buffer.
-  ;; Special care is taken to not stomp over an existing info buffer
-  (let* ((bname (if type "*info-perl-var*" "*info-perl*"))
-	 (info (get-buffer bname))
-	 (oldbuf (get-buffer "*info*")))
-    (if info info
-      (save-window-excursion
-	;; Get Info running
-	(require 'info)
-	(cond (oldbuf
-	       (set-buffer oldbuf)
-	       (rename-buffer "*info-perl-tmp*")))
-	(save-window-excursion
-	  (info))
-	(Info-find-node cperl-info-page (if type "perlvar" "perlfunc"))
-	(set-buffer "*info*")
-	(rename-buffer bname)
-	(cond (oldbuf
-	       (set-buffer "*info-perl-tmp*")
-	       (rename-buffer "*info*")
-	       (set-buffer bname)))
-	(make-local-variable 'window-min-height)
-	(setq window-min-height 2)
-	(current-buffer)))))
-
-(defun cperl-word-at-point (&optional p)
-  "Return the word at point or at P."
-  (save-excursion
-    (if p (goto-char p))
-    (or (cperl-word-at-point-hard)
-	(progn
-	  (require 'etags)
-	  (funcall (or (and (boundp 'find-tag-default-function)
-			    find-tag-default-function)
-		       (get major-mode 'find-tag-default-function)
-		       ;; XEmacs 19.12 has `find-tag-default-hook'; it is
-		       ;; automatically used within `find-tag-default':
-		       'find-tag-default))))))
-
-(defun cperl-info-on-command (command)
-  "Show documentation for Perl command COMMAND in other window.
-If perl-info buffer is shown in some frame, uses this frame.
-Customized by setting variables `cperl-shrink-wrap-info-frame',
-`cperl-max-help-size'."
-  (interactive
-   (let* ((default (cperl-word-at-point))
-	  (read (read-string
-		 (format "Find doc for Perl function (default %s): "
-			 default))))
-     (list (if (equal read "")
-	       default
-	     read))))
-
-  (let ((buffer (current-buffer))
-	(cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
-	pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner
-	max-height char-height buf-list)
-    (if (string-match "^-[a-zA-Z]$" command)
-	(setq cmd-desc "^-X[ \t\n]"))
-    (setq isvar (string-match "^[$@%]" command)
-	  buf (cperl-info-buffer isvar)
-	  iniwin (selected-window)
-	  fr1 (window-frame iniwin))
-    (set-buffer buf)
-    (beginning-of-buffer)
-    (or isvar
-	(progn (re-search-forward "^-X[ \t\n]")
-	       (forward-line -1)))
-    (if (re-search-forward cmd-desc nil t)
-	(progn
-	  ;; Go back to beginning of the group (ex, for qq)
-	  (if (re-search-backward "^[ \t\n\f]")
-	      (forward-line 1))
-	  (beginning-of-line)
-	  ;; Get some of
-	  (setq pos (point)
-		buf-list (list buf "*info-perl-var*" "*info-perl*"))
-	  (while (and (not win) buf-list)
-	    (setq win (get-buffer-window (car buf-list) t))
-	    (setq buf-list (cdr buf-list)))
-	  (or (not win)
-	      (eq (window-buffer win) buf)
-	      (set-window-buffer win buf))
-	  (and win (setq fr2 (window-frame win)))
-	  (if (or (not fr2) (eq fr1 fr2))
-	      (pop-to-buffer buf)
-	    (special-display-popup-frame buf) ; Make it visible
-	    (select-window win))
-	  (goto-char pos)		; Needed (?!).
-	  ;; Resize
-	  (setq iniheight (window-height)
-		frheight (frame-height)
-		not-loner (< iniheight (1- frheight))) ; Are not alone
-	  (cond ((if not-loner cperl-max-help-size
-		   cperl-shrink-wrap-info-frame)
-		 (setq height
-		       (+ 2
-			  (count-lines
-			   pos
-			   (save-excursion
-			     (if (re-search-forward
-				  "^[ \t][^\n]*\n+\\([^ \t\n\f]\\|\\'\\)" nil t)
-				 (match-beginning 0) (point-max)))))
-		       max-height
-		       (if not-loner
-			   (/ (* (- frheight 3) cperl-max-help-size) 100)
-			 (setq char-height (frame-char-height))
-			 ;; Non-functioning under OS/2:
-			 (if (eq char-height 1) (setq char-height 18))
-			 ;; Title, menubar, + 2 for slack
-			 (- (/ (x-display-pixel-height) char-height) 4)))
-		 (if (> height max-height) (setq height max-height))
-		 ;;(message "was %s doing %s" iniheight height)
-		 (if not-loner
-		     (enlarge-window (- height iniheight))
-		   (set-frame-height (window-frame win) (1+ height)))))
-	  (set-window-start (selected-window) pos))
-      (message "No entry for %s found." command))
-    ;;(pop-to-buffer buffer)
-    (select-window iniwin)))
-
-(defun cperl-info-on-current-command ()
-  "Show documentation for Perl command at point in other window."
-  (interactive)
-  (cperl-info-on-command (cperl-word-at-point)))
-
-(defun cperl-imenu-info-imenu-search ()
-  (if (looking-at "^-X[ \t\n]") nil
-    (re-search-backward
-     "^\n\\([-a-zA-Z_]+\\)[ \t\n]")
-    (forward-line 1)))
-
-(defun cperl-imenu-info-imenu-name ()
-  (buffer-substring
-   (match-beginning 1) (match-end 1)))
-
-(defun cperl-imenu-on-info ()
-  (interactive)
-  (let* ((buffer (current-buffer))
-	 imenu-create-index-function
-	 imenu-prev-index-position-function
-	 imenu-extract-index-name-function
-	 (index-item (save-restriction
-		       (save-window-excursion
-			 (set-buffer (cperl-info-buffer nil))
-			 (setq imenu-create-index-function
-			       'imenu-default-create-index-function
-			       imenu-prev-index-position-function
-			       'cperl-imenu-info-imenu-search
-			       imenu-extract-index-name-function
-			       'cperl-imenu-info-imenu-name)
-			 (imenu-choose-buffer-index)))))
-    (and index-item
-	 (progn
-	   (push-mark)
-	   (pop-to-buffer "*info-perl*")
-	   (cond
-	    ((markerp (cdr index-item))
-	     (goto-char (marker-position (cdr index-item))))
-	    (t
-	     (goto-char (cdr index-item))))
-	   (set-window-start (selected-window) (point))
-	   (pop-to-buffer buffer)))))
-
-(defun cperl-lineup (beg end &optional step minshift)
-  "Lineup construction in a region.
-Beginning of region should be at the start of a construction.
-All first occurrences of this construction in the lines that are
-partially contained in the region are lined up at the same column.
-
-MINSHIFT is the minimal amount of space to insert before the construction.
-STEP is the tabwidth to position constructions.
-If STEP is nil, `cperl-lineup-step' will be used
-\(or `cperl-indent-level', if `cperl-lineup-step' is `nil').
-Will not move the position at the start to the left."
-  (interactive "r")
-  (let (search col tcol seen b e)
-    (save-excursion
-      (goto-char end)
-      (end-of-line)
-      (setq end (point-marker))
-      (goto-char beg)
-      (skip-chars-forward " \t\f")
-      (setq beg (point-marker))
-      (indent-region beg end nil)
-      (goto-char beg)
-      (setq col (current-column))
-      (if (looking-at "[a-zA-Z0-9_]")
-	  (if (looking-at "\\<[a-zA-Z0-9_]+\\>")
-	      (setq search
-		    (concat "\\<"
-			    (regexp-quote
-			     (buffer-substring (match-beginning 0)
-					       (match-end 0))) "\\>"))
-	    (error "Cannot line up in a middle of the word"))
-	(if (looking-at "$")
-	    (error "Cannot line up end of line"))
-	(setq search (regexp-quote (char-to-string (following-char)))))
-      (setq step (or step cperl-lineup-step cperl-indent-level))
-      (or minshift (setq minshift 1))
-      (while (progn
-	       (beginning-of-line 2)
-	       (and (< (point) end)
-		    (re-search-forward search end t)
-		    (goto-char (match-beginning 0))))
-	(setq tcol (current-column) seen t)
-	(if (> tcol col) (setq col tcol)))
-      (or seen
-	  (error "The construction to line up occurred only once"))
-      (goto-char beg)
-      (setq col (+ col minshift))
-      (if (/= (% col step) 0) (setq step (* step (1+ (/ col step)))))
-      (while
-	  (progn
-	    (setq e (point))
-	    (skip-chars-backward " \t")
-	    (delete-region (point) e)
-	    (indent-to-column col) ;(make-string (- col (current-column)) ?\ ))
-	    (beginning-of-line 2)
-	    (and (< (point) end)
-		 (re-search-forward search end t)
-		 (goto-char (match-beginning 0)))))))) ; No body
-
-(defun cperl-etags (&optional add all files)
-  "Run etags with appropriate options for Perl files.
-If optional argument ALL is `recursive', will process Perl files
-in subdirectories too."
-  (interactive)
-  (let ((cmd "etags")
-	(args '("-l" "none" "-r" "/\\<\\(package\\|sub\\)[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([{#]\\|$\\)\\)/\\4/"))
-	res)
-    (if add (setq args (cons "-a" args)))
-    (or files (setq files (list buffer-file-name)))
-    (cond
-     ((eq all 'recursive)
-      ;;(error "Not implemented: recursive")
-      (setq args (append (list "-e"
-			       "sub wanted {push @ARGV, $File::Find::name if /\\.[pP][Llm]$/}
-				use File::Find;
-				find(\\&wanted, '.');
-				exec @ARGV;"
-			       cmd) args)
-	    cmd "perl"))
-     (all
-      ;;(error "Not implemented: all")
-      (setq args (append (list "-e"
-			       "push @ARGV, <*.PL *.pl *.pm>;
-				exec @ARGV;"
-			       cmd) args)
-	    cmd "perl"))
-     (t
-      (setq args (append args files))))
-    (setq res (apply 'call-process cmd nil nil nil args))
-    (or (eq res 0)
-	(message "etags returned \"%s\"" res))))
-
-(defun cperl-toggle-auto-newline ()
-  "Toggle the state of `cperl-auto-newline'."
-  (interactive)
-  (setq cperl-auto-newline (not cperl-auto-newline))
-  (message "Newlines will %sbe auto-inserted now."
-	   (if cperl-auto-newline "" "not ")))
-
-(defun cperl-toggle-abbrev ()
-  "Toggle the state of automatic keyword expansion in CPerl mode."
-  (interactive)
-  (abbrev-mode (if abbrev-mode 0 1))
-  (message "Perl control structure will %sbe auto-inserted now."
-	   (if abbrev-mode "" "not ")))
-
-
-(defun cperl-toggle-electric ()
-  "Toggle the state of parentheses doubling in CPerl mode."
-  (interactive)
-  (setq cperl-electric-parens (if (cperl-val 'cperl-electric-parens) 'null t))
-  (message "Parentheses will %sbe auto-doubled now."
-	   (if (cperl-val 'cperl-electric-parens) "" "not ")))
-
-(defun cperl-toggle-autohelp ()
-  "Toggle the state of Auto-Help on Perl constructs (put in the message area).
-Delay of auto-help controlled by `cperl-lazy-help-time'."
-  (interactive)
-  (if (fboundp 'run-with-idle-timer)
-      (progn
-	(if cperl-lazy-installed
-	    (cperl-lazy-unstall)
-	  (cperl-lazy-install))
-	(message "Perl help messages will %sbe automatically shown now."
-		 (if cperl-lazy-installed "" "not ")))
-    (message "Cannot automatically show Perl help messages - run-with-idle-timer missing.")))
-
-(defun cperl-toggle-construct-fix ()
-  "Toggle whether `indent-region'/`indent-sexp' fix whitespace too."
-  (interactive)
-  (setq cperl-indent-region-fix-constructs
-	(if cperl-indent-region-fix-constructs
-	    nil
-	  1))
-  (message "indent-region/indent-sexp will %sbe automatically fix whitespace."
-	   (if cperl-indent-region-fix-constructs "" "not ")))
-
-;;;; Tags file creation.
-
-(defvar cperl-tmp-buffer " *cperl-tmp*")
-
-(defun cperl-setup-tmp-buf ()
-  (set-buffer (get-buffer-create cperl-tmp-buffer))
-  (set-syntax-table cperl-mode-syntax-table)
-  (buffer-disable-undo)
-  (auto-fill-mode 0)
-  (if cperl-use-syntax-table-text-property-for-tags
-      (progn
-	(make-local-variable 'parse-sexp-lookup-properties)
-	;; Do not introduce variable if not needed, we check it!
-	(set 'parse-sexp-lookup-properties t))))
-
-(defun cperl-xsub-scan ()
-  (require 'cl)
-  (require 'imenu)
-  (let ((index-alist '())
-	(prev-pos 0) index index1 name package prefix)
-    (goto-char (point-min))
-    (if noninteractive
-	(message "Scanning XSUB for index")
-      (imenu-progress-message prev-pos 0))
-    ;; Search for the function
-    (progn ;;save-match-data
-      (while (re-search-forward
-	      "^\\([ \t]*MODULE\\>[^\n]*\\\\|\\([a-zA-Z_][a-zA-Z_0-9]*\\)(\\|[ \t]*BOOT:\\)"
-	      nil t)
-	(or noninteractive
-	    (imenu-progress-message prev-pos))
-	(cond
-	 ((match-beginning 2)		; SECTION
-	  (setq package (buffer-substring (match-beginning 2) (match-end 2)))
-	  (goto-char (match-beginning 0))
-	  (skip-chars-forward " \t")
-	  (forward-char 1)
-	  (if (looking-at "[^\n]*\\")
-	      (setq prefix (buffer-substring (match-beginning 1) (match-end 1)))
-	    (setq prefix nil)))
-	 ((not package) nil)		; C language section
-	 ((match-beginning 3)		; XSUB
-	  (goto-char (1+ (match-beginning 3)))
-	  (setq index (imenu-example--name-and-position))
-	  (setq name (buffer-substring (match-beginning 3) (match-end 3)))
-	  (if (and prefix (string-match (concat "^" prefix) name))
-	      (setq name (substring name (length prefix))))
-	  (cond ((string-match "::" name) nil)
-		(t
-		 (setq index1 (cons (concat package "::" name) (cdr index)))
-		 (push index1 index-alist)))
-	  (setcar index name)
-	  (push index index-alist))
-	 (t				; BOOT: section
-	  ;; (beginning-of-line)
-	  (setq index (imenu-example--name-and-position))
-	  (setcar index (concat package "::BOOT:"))
-	  (push index index-alist)))))
-    (or noninteractive
-	(imenu-progress-message prev-pos 100))
-    index-alist))
-
-(defvar cperl-unreadable-ok nil)
-
-(defun cperl-find-tags (ifile xs topdir)
-  (let ((b (get-buffer cperl-tmp-buffer)) ind lst elt pos ret rel
-	(cperl-pod-here-fontify nil) f file)
-    (save-excursion
-      (if b (set-buffer b)
-	(cperl-setup-tmp-buf))
-      (erase-buffer)
-      (condition-case err
-	  (setq file (car (insert-file-contents ifile)))
-	(error (if cperl-unreadable-ok nil
-		 (if (y-or-n-p
-		      (format "File %s unreadable.  Continue? " ifile))
-		     (setq cperl-unreadable-ok t)
-		   (error "Aborting: unreadable file %s" ifile)))))
-      (if (not file)
-	  (message "Unreadable file %s" ifile)
-	(message "Scanning file %s ..." file)
-	(if (and cperl-use-syntax-table-text-property-for-tags
-		 (not xs))
-	    (condition-case err		; after __END__ may have garbage
-		(cperl-find-pods-heres nil nil noninteractive)
-	      (error (message "While scanning for syntax: %s" err))))
-	(if xs
-	    (setq lst (cperl-xsub-scan))
-	  (setq ind (cperl-imenu--create-perl-index))
-	  (setq lst (cdr (assoc "+Unsorted List+..." ind))))
-	(setq lst
-	      (mapcar
-	       (function
-		(lambda (elt)
-		  (cond ((string-match "^[_a-zA-Z]" (car elt))
-			 (goto-char (cdr elt))
-			 (beginning-of-line) ; pos should be of the start of the line
-			 (list (car elt)
-			       (point)
-			       (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
-			       (buffer-substring (progn
-						   (goto-char (cdr elt))
-						   ;; After name now...
-						   (or (eolp) (forward-char 1))
-						   (point))
-						 (progn
-						   (beginning-of-line)
-						   (point))))))))
-	       lst))
-	(erase-buffer)
-	(while lst
-	  (setq elt (car lst) lst (cdr lst))
-	  (if elt
-	      (progn
-		(insert (elt elt 3)
-			127
-			(if (string-match "^package " (car elt))
-			    (substring (car elt) 8)
-			  (car elt) )
-			1
-			(number-to-string (elt elt 2)) ; Line
-			","
-			(number-to-string (1- (elt elt 1))) ; Char pos 0-based
-			"\n")
-		(if (and (string-match "^[_a-zA-Z]+::" (car elt))
-			 (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]"
-				       (elt elt 3)))
-		    ;; Need to insert the name without package as well
-		    (setq lst (cons (cons (substring (elt elt 3) 
-						     (match-beginning 1)
-						     (match-end 1))
-					  (cdr elt))
-				    lst))))))
-	(setq pos (point))
-	(goto-char 1)
-	(setq rel file)
-	;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties
-	(set-text-properties 0 (length rel) nil rel)
-	(and (equal topdir (substring rel 0 (length topdir)))
-	     (setq rel (substring file (length topdir))))
-	(insert "\f\n" rel "," (number-to-string (1- pos)) "\n")
-	(setq ret (buffer-substring 1 (point-max)))
-	(erase-buffer)
-	(or noninteractive
-	    (message "Scanning file %s finished" file))
-	ret))))
-
-(defun cperl-add-tags-recurse-noxs ()
-  "Add to TAGS data for Perl (skipping XSUBs) in the current directory 
-and kids. Use as
-  emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
-        -f cperl-add-tags-recurse-noxs
-"
-  (cperl-write-tags nil nil t t nil t))
-
-(defun cperl-add-tags-recurse-noxs-fullpath ()
-  "Add to TAGS data for Perl (skipping XSUBs) in the current directory 
-and kids, using fullpath, so TAGS is relocatable. Use as
-  emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
-        -f cperl-add-tags-recurse-noxs-fullpath
-"
-  (cperl-write-tags nil nil t t nil t ""))
-
-(defun cperl-add-tags-recurse ()
-  "Add to TAGS file data for Perl files in the current directory and kids.
-Use as
-  emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
-        -f cperl-add-tags-recurse
-"
-  (cperl-write-tags nil nil t t))
-
-(defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir)
-  ;; If INBUFFER, do not select buffer, and do not save
-  ;; If ERASE is `ignore', do not erase, and do not try to delete old info.
-  (require 'etags)
-  (if file nil
-    (setq file (if dir default-directory (buffer-file-name)))
-    (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!")))
-  (or topdir
-      (setq topdir default-directory))
-  (let ((tags-file-name "TAGS")
-	(case-fold-search (eq system-type 'emx))
-	xs rel tm)
-    (save-excursion
-      (cond (inbuffer nil)		; Already there
-	    ((file-exists-p tags-file-name)
-	     (if cperl-xemacs-p
-		 (visit-tags-table-buffer)
-	       (visit-tags-table-buffer tags-file-name)))
-	    (t (set-buffer (find-file-noselect tags-file-name))))
-      (cond
-       (dir
-	(cond ((eq erase 'ignore))
-	      (erase
-	       (erase-buffer)
-	       (setq erase 'ignore)))
-	(let ((files
-	       (condition-case err
-		   (directory-files file t
-				    (if recurse nil cperl-scan-files-regexp)
-				    t)
-		 (error
-		  (if cperl-unreadable-ok nil
-		    (if (y-or-n-p
-			 (format "Directory %s unreadable.  Continue? " file))
-			(setq cperl-unreadable-ok t
-			      tm nil)	; Return empty list
-		      (error "Aborting: unreadable directory %s" file)))))))
-	  (mapcar (function 
-		   (lambda (file)
-		     (cond
-		      ((string-match cperl-noscan-files-regexp file)
-		       nil)
-		      ((not (file-directory-p file))
-		       (if (string-match cperl-scan-files-regexp file)
-			   (cperl-write-tags file erase recurse nil t noxs topdir)))
-		      ((not recurse) nil)
-		      (t (cperl-write-tags file erase recurse t t noxs topdir)))))
-		  files)))
-       (t
-	(setq xs (string-match "\\.xs$" file))
-	(if (not (and xs noxs))
-	    (progn
-	      (cond ((eq erase 'ignore) (goto-char (point-max)))
-		    (erase (erase-buffer))
-		    (t
-		     (goto-char 1)
-		     (setq rel file)
-		     ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties
-		     (set-text-properties 0 (length rel) nil rel)
-		     (and (equal topdir (substring rel 0 (length topdir)))
-			  (setq rel (substring file (length topdir))))
-		     (if (search-forward (concat "\f\n" rel ",") nil t)
-			 (progn
-			   (search-backward "\f\n")
-			   (delete-region (point)
-					  (save-excursion
-					    (forward-char 1)
-					    (if (search-forward "\f\n"
-								nil 'toend)
-						(- (point) 2)
-					      (point-max)))))
-		       (goto-char (point-max)))))
-	      (insert (cperl-find-tags file xs topdir))))))
-      (if inbuffer nil			; Delegate to the caller
-	(save-buffer 0)			; No backup
-	(if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs?
-	    (initialize-new-tags-table))))))
-
-(defvar cperl-tags-hier-regexp-list
-  (concat
-   "^\\("
-      "\\(package\\)\\>"
-     "\\|"
-      "sub\\>[^\n]+::"
-     "\\|"
-      "[a-zA-Z_][a-zA-Z_0-9:]*(\C-?[^\n]+::" ; XSUB?
-     "\\|"
-      "[ \t]*BOOT:\C-?[^\n]+::"		; BOOT section
-   "\\)"))
-
-(defvar cperl-hierarchy '(() ())
-  "Global hierarchy of classes.")
-
-(defun cperl-tags-hier-fill ()
-  ;; Suppose we are in a tag table cooked by cperl.
-  (goto-char 1)
-  (let (type pack name pos line chunk ord cons1 file str info fileind)
-    (while (re-search-forward cperl-tags-hier-regexp-list nil t)
-      (setq pos (match-beginning 0)
-	    pack (match-beginning 2))
-      (beginning-of-line)
-      (if (looking-at (concat
-		       "\\([^\n]+\\)"
-		       "\C-?"
-		       "\\([^\n]+\\)"
-		       "\C-a"
-		       "\\([0-9]+\\)"
-		       ","
-		       "\\([0-9]+\\)"))
-	  (progn
-	    (setq ;;str (buffer-substring (match-beginning 1) (match-end 1))
-		  name (buffer-substring (match-beginning 2) (match-end 2))
-		  ;;pos (buffer-substring (match-beginning 3) (match-end 3))
-		  line (buffer-substring (match-beginning 3) (match-end 3))
-		  ord (if pack 1 0)
-		  file (file-of-tag)
-		  fileind (format "%s:%s" file line)
-		  ;; Moves to beginning of the next line:
-		  info (cperl-etags-snarf-tag file line))
-	    ;; Move back
-	    (forward-char -1)
-	    ;; Make new member of hierarchy name ==> file ==> pos if needed
-	    (if (setq cons1 (assoc name (nth ord cperl-hierarchy)))
-		;; Name known
-		(setcdr cons1 (cons (cons fileind (vector file info))
-				    (cdr cons1)))
-	      ;; First occurrence of the name, start alist
-	      (setq cons1 (cons name (list (cons fileind (vector file info)))))
-	      (if pack
-		  (setcar (cdr cperl-hierarchy)
-			  (cons cons1 (nth 1 cperl-hierarchy)))
-		(setcar cperl-hierarchy
-			(cons cons1 (car cperl-hierarchy)))))))
-      (end-of-line))))
-
-(defun cperl-tags-hier-init (&optional update)
-  "Show hierarchical menu of classes and methods.
-Finds info about classes by a scan of loaded TAGS files.
-Supposes that the TAGS files contain fully qualified function names.
-One may build such TAGS files from CPerl mode menu."
-  (interactive)
-  (require 'etags)
-  (require 'imenu)
-  (if (or update (null (nth 2 cperl-hierarchy)))
-      (let ((remover (function (lambda (elt) ; (name (file1...) (file2..))
-				 (or (nthcdr 2 elt)
-				     ;; Only in one file
-				     (setcdr elt (cdr (nth 1 elt)))))))
-	    pack name cons1 to l1 l2 l3 l4 b)
-	;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
-	(setq cperl-hierarchy (list l1 l2 l3))
-	(if cperl-xemacs-p		; Not checked
-	    (progn
-	      (or tags-file-name
-		  ;; Does this work in XEmacs?
-		  (call-interactively 'visit-tags-table))
-	      (message "Updating list of classes...")
-	      (set-buffer (get-file-buffer tags-file-name))
-	      (cperl-tags-hier-fill))
-	  (or tags-table-list
-	      (call-interactively 'visit-tags-table))
-	  (mapcar 
-	   (function
-	    (lambda (tagsfile)
-	      (message "Updating list of classes... %s" tagsfile)
-	      (set-buffer (get-file-buffer tagsfile))
-	      (cperl-tags-hier-fill)))
-	   tags-table-list)
-	  (message "Updating list of classes... postprocessing..."))
-	(mapcar remover (car cperl-hierarchy))
-	(mapcar remover (nth 1 cperl-hierarchy))
-	(setq to (list nil (cons "Packages: " (nth 1 cperl-hierarchy))
-		       (cons "Methods: " (car cperl-hierarchy))))
-	(cperl-tags-treeify to 1)
-	(setcar (nthcdr 2 cperl-hierarchy)
-		(cperl-menu-to-keymap (cons '("+++UPDATE+++" . -999) (cdr to))))
-	(message "Updating list of classes: done, requesting display...")
-	;;(cperl-imenu-addback (nth 2 cperl-hierarchy))
-	))
-  (or (nth 2 cperl-hierarchy)
-      (error "No items found"))
-  (setq update
-;;;	(imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy))
-	(if (if (boundp 'display-popup-menus-p)
-		(let ((f 'display-popup-menus-p))
-		  (funcall f))
-	      window-system)
-	    (x-popup-menu t (nth 2 cperl-hierarchy))
-	  (require 'tmm)
-	  (tmm-prompt (nth 2 cperl-hierarchy))))
-  (if (and update (listp update))
-      (progn (while (cdr update) (setq update (cdr update)))
-	     (setq update (car update)))) ; Get the last from the list
-  (if (vectorp update)
-      (progn
-	(find-file (elt update 0))
-	(cperl-etags-goto-tag-location (elt update 1))))
-  (if (eq update -999) (cperl-tags-hier-init t)))
-
-(defun cperl-tags-treeify (to level)
-  ;; cadr of `to' is read-write.  On start it is a cons
-  (let* ((regexp (concat "^\\(" (mapconcat
-				 'identity
-				 (make-list level "[_a-zA-Z0-9]+")
-				 "::")
-			 "\\)\\(::\\)?"))
-	 (packages (cdr (nth 1 to)))
-	 (methods (cdr (nth 2 to)))
-	 l1 head tail cons1 cons2 ord writeto packs recurse
-	 root-packages root-functions ms many_ms same_name ps
-	 (move-deeper
-	  (function 
-	   (lambda (elt)
-	     (cond ((and (string-match regexp (car elt))
-			 (or (eq ord 1) (match-end 2)))
-		    (setq head (substring (car elt) 0 (match-end 1))
-			  tail (if (match-end 2) (substring (car elt) 
-							    (match-end 2)))
-			  recurse t)
-		    (if (setq cons1 (assoc head writeto)) nil
-		      ;; Need to init new head
-		      (setcdr writeto (cons (list head (list "Packages: ")
-						  (list "Methods: "))
-					    (cdr writeto)))
-		      (setq cons1 (nth 1 writeto)))
-		    (setq cons2 (nth ord cons1)) ; Either packs or meths
-		    (setcdr cons2 (cons elt (cdr cons2))))
-		   ((eq ord 2)
-		    (setq root-functions (cons elt root-functions)))
-		   (t
-		    (setq root-packages (cons elt root-packages))))))))
-    (setcdr to l1)			; Init to dynamic space
-    (setq writeto to)
-    (setq ord 1)
-    (mapcar move-deeper packages)
-    (setq ord 2)
-    (mapcar move-deeper methods)
-    (if recurse
-	(mapcar (function (lambda (elt)
-			  (cperl-tags-treeify elt (1+ level))))
-		(cdr to)))
-    ;;Now clean up leaders with one child only
-    (mapcar (function (lambda (elt)
-			(if (not (and (listp (cdr elt)) 
-				      (eq (length elt) 2))) nil
-			    (setcar elt (car (nth 1 elt)))
-			    (setcdr elt (cdr (nth 1 elt))))))
-	    (cdr to))
-    ;; Sort the roots of subtrees
-    (if (default-value 'imenu-sort-function)
-	(setcdr to
-		(sort (cdr to) (default-value 'imenu-sort-function))))
-    ;; Now add back functions removed from display
-    (mapcar (function (lambda (elt)
-			(setcdr to (cons elt (cdr to)))))
-	    (if (default-value 'imenu-sort-function)
-		(nreverse
-		 (sort root-functions (default-value 'imenu-sort-function)))
-	      root-functions))
-    ;; Now add back packages removed from display
-    (mapcar (function (lambda (elt)
-			(setcdr to (cons (cons (concat "package " (car elt)) 
-					       (cdr elt)) 
-					 (cdr to)))))
-	    (if (default-value 'imenu-sort-function)
-		(nreverse
-		 (sort root-packages (default-value 'imenu-sort-function)))
-	      root-packages))))
-
-;;;(x-popup-menu t
-;;;   '(keymap "Name1"
-;;;	    ("Ret1" "aa")
-;;;	    ("Head1" "ab"
-;;;	     keymap "Name2"
-;;;	     ("Tail1" "x") ("Tail2" "y"))))
-
-(defun cperl-list-fold (list name limit)
-  (let (list1 list2 elt1 (num 0))
-    (if (<= (length list) limit) list
-      (setq list1 nil list2 nil)
-      (while list
-	(setq num (1+ num)
-	      elt1 (car list)
-	      list (cdr list))
-	(if (<= num imenu-max-items)
-	    (setq list2 (cons elt1 list2))
-	  (setq list1 (cons (cons name
-				  (nreverse list2))
-			    list1)
-		list2 (list elt1)
-		num 1)))
-      (nreverse (cons (cons name
-			    (nreverse list2))
-		      list1)))))
-
-(defun cperl-menu-to-keymap (menu &optional name)
-  (let (list)
-    (cons 'keymap
-	  (mapcar
-	   (function
-	    (lambda (elt)
-	      (cond ((listp (cdr elt))
-		     (setq list (cperl-list-fold
-				 (cdr elt) (car elt) imenu-max-items))
-		     (cons nil
-			   (cons (car elt)
-				 (cperl-menu-to-keymap list))))
-		    (t
-		     (list (cdr elt) (car elt) t))))) ; t is needed in 19.34
-	   (cperl-list-fold menu "Root" imenu-max-items)))))
-
-
-(defvar cperl-bad-style-regexp
-  (mapconcat 'identity
-	     '("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign
-	       "[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char 
-	     "\\|")
-  "Finds places such that insertion of a whitespace may help a lot.")
-
-(defvar cperl-not-bad-style-regexp
-  (mapconcat 
-   'identity
-   '("[^-\t <>=+]\\(--\\|\\+\\+\\)"	; var-- var++
-     "[a-zA-Z0-9_][|&][a-zA-Z0-9_$]"	; abc|def abc&def are often used.
-     "&[(a-zA-Z0-9_$]"			; &subroutine &(var->field)
-     "<\\$?\\sw+\\(\\.\\sw+\\)?>"	;  
-     "-[a-zA-Z][ \t]+[_$\"'`a-zA-Z]"	; -f file, -t STDIN
-     "-[0-9]"				; -5
-     "\\+\\+"				; ++var
-     "--"				; --var
-     ".->"				; a->b
-     "->"				; a SPACE ->b
-     "\\[-"				; a[-1]
-     "\\\\[&$@*\\\\]"			; \&func
-     "^="				; =head
-     "\\$."				; $|
-     "<<[a-zA-Z_'\"`]"			; <" ; C
-     "-[a-zA-Z_0-9]+[ \t]*=>"		; -option => value
-     ;; Unaddressed trouble spots: = -abc, f(56, -abc) --- specialcased below
-     ;;"[*/+-|&<.]+="
-     )
-   "\\|")
-  "If matches at the start of match found by `my-bad-c-style-regexp',
-insertion of a whitespace will not help.")
-
-(defvar found-bad)
-
-(defun cperl-find-bad-style ()
-  "Find places in the buffer where insertion of a whitespace may help.
-Prompts user for insertion of spaces.
-Currently it is tuned to C and Perl syntax."
-  (interactive)
-  (let (found-bad (p (point)))
-    (setq last-nonmenu-event 13)	; To disable popup
-    (beginning-of-buffer)
-    (map-y-or-n-p "Insert space here? "
-		  (lambda (arg) (insert " "))
-		  'cperl-next-bad-style
-		  '("location" "locations" "insert a space into")
-		  '((?\C-r (lambda (arg)
-			     (let ((buffer-quit-function
-				    'exit-recursive-edit))
-			       (message "Exit with Esc Esc")
-			       (recursive-edit)
-			       t))	; Consider acted upon
-			   "edit, exit with Esc Esc")
-		    (?e (lambda (arg)
-			  (let ((buffer-quit-function
-				 'exit-recursive-edit))
-			    (message "Exit with Esc Esc")
-			    (recursive-edit)
-			    t))		; Consider acted upon
-			"edit, exit with Esc Esc"))
-		  t)
-    (if found-bad (goto-char found-bad)
-      (goto-char p)
-      (message "No appropriate place found"))))
-
-(defun cperl-next-bad-style ()
-  (let (p (not-found t) (point (point)) found)
-    (while (and not-found
-		(re-search-forward cperl-bad-style-regexp nil 'to-end))
-      (setq p (point))
-      (goto-char (match-beginning 0))
-      (if (or
-	   (looking-at cperl-not-bad-style-regexp)
-	   ;; Check for a < -b and friends
-	   (and (eq (following-char) ?\-)
-		(save-excursion
-		  (skip-chars-backward " \t\n")
-		  (memq (preceding-char) '(?\= ?\> ?\< ?\, ?\( ?\[ ?\{))))
-	   ;; Now check for syntax type
-	   (save-match-data
-	     (setq found (point))
-	     (beginning-of-defun)
-	     (let ((pps (parse-partial-sexp (point) found)))
-	       (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))
-	  (goto-char (match-end 0))
-	(goto-char (1- p))
-	(setq not-found nil
-	      found-bad found)))
-    (not not-found)))
-
-
-;;; Getting help
-(defvar cperl-have-help-regexp
-  ;;(concat "\\("
-  (mapconcat
-   'identity
-   '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable
-     "[$@]\\^[a-zA-Z]"			; Special variable
-     "[$@][^ \n\t]"			; Special variable
-     "-[a-zA-Z]"			; File test
-     "\\\\[a-zA-Z0]"			; Special chars
-     "^=[a-z][a-zA-Z0-9_]*"		; POD sections
-     "[-!&*+,-./<=>?\\\\^|~]+"		; Operator
-     "[a-zA-Z_0-9:]+"			; symbol or number
-     "x="
-     "#!")
-   ;;"\\)\\|\\("
-   "\\|")
-  ;;"\\)"
-  ;;)
-  "Matches places in the buffer we can find help for.")
-
-(defvar cperl-message-on-help-error t)
-(defvar cperl-help-from-timer nil)
-
-(defun cperl-word-at-point-hard ()
-  ;; Does not save-excursion
-  ;; Get to the something meaningful
-  (or (eobp) (eolp) (forward-char 1))
-  (re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]"
-		      (save-excursion (beginning-of-line) (point))
-		      'to-beg)
-  ;;  (cond
-  ;;   ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol
-  ;;    (skip-chars-backward " \n\t\r({[]});,")
-  ;;    (or (bobp) (backward-char 1))))
-  ;; Try to backtrace
-  (cond
-   ((looking-at "[a-zA-Z0-9_:]")	; symbol
-    (skip-chars-backward "a-zA-Z0-9_:")
-    (cond
-     ((and (eq (preceding-char) ?^)	; $^I
-	   (eq (char-after (- (point) 2)) ?\$))
-      (forward-char -2))
-     ((memq (preceding-char) (append "*$@%&\\" nil)) ; *glob
-      (forward-char -1))
-     ((and (eq (preceding-char) ?\=)
-	   (eq (current-column) 1))
-      (forward-char -1)))		; =head1
-    (if (and (eq (preceding-char) ?\<)
-	     (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; 
-	(forward-char -1)))
-   ((and (looking-at "=") (eq (preceding-char) ?x)) ; x=
-    (forward-char -1))
-   ((and (looking-at "\\^") (eq (preceding-char) ?\$)) ; $^I
-    (forward-char -1))
-   ((looking-at "[-!&*+,-./<=>?\\\\^|~]")
-    (skip-chars-backward "-!&*+,-./<=>?\\\\^|~")
-    (cond
-     ((and (eq (preceding-char) ?\$)
-	   (not (eq (char-after (- (point) 2)) ?\$))) ; $-
-      (forward-char -1))
-     ((and (eq (following-char) ?\>)
-	   (string-match "[a-zA-Z0-9_]" (char-to-string (preceding-char)))
-	   (save-excursion
-	     (forward-sexp -1)
-	     (and (eq (preceding-char) ?\<)
-		  (looking-at "\\$?[a-zA-Z0-9_:]+>")))) ; 
-      (search-backward "<"))))
-   ((and (eq (following-char) ?\$)
-	 (eq (preceding-char) ?\<)
-	 (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <$fh>
-    (forward-char -1)))
-  (if (looking-at cperl-have-help-regexp)
-      (buffer-substring (match-beginning 0) (match-end 0))))
-
-(defun cperl-get-help ()
-  "Get one-line docs on the symbol at the point.
-The data for these docs is a little bit obsolete and may be in fact longer
-than a line.  Your contribution to update/shorten it is appreciated."
-  (interactive)
-  (save-match-data			; May be called "inside" query-replace
-    (save-excursion
-      (let ((word (cperl-word-at-point-hard)))
-	(if word
-	    (if (and cperl-help-from-timer ; Bail out if not in mainland
-		     (not (string-match "^#!\\|\\\\\\|^=" word)) ; Show help even in comments/strings.
-		     (or (memq (get-text-property (point) 'face)
-			       '(font-lock-comment-face font-lock-string-face))
-			 (memq (get-text-property (point) 'syntax-type)
-			       '(pod here-doc format))))
-		nil
-	      (cperl-describe-perl-symbol word))
-	  (if cperl-message-on-help-error
-	      (message "Nothing found for %s..."
-		       (buffer-substring (point) (min (+ 5 (point)) (point-max))))))))))
-
-;;; Stolen from perl-descr.el by Johan Vromans:
-
-(defvar cperl-doc-buffer " *perl-doc*"
-  "Where the documentation can be found.")
-
-(defun cperl-describe-perl-symbol (val)
-  "Display the documentation of symbol at point, a Perl operator."
-  (let ((enable-recursive-minibuffers t)
-	args-file regexp)
-    (cond
-     ((string-match "^[&*][a-zA-Z_]" val)
-      (setq val (concat (substring val 0 1) "NAME")))
-     ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*\\[" val)
-      (setq val (concat "@" (substring val 1 (match-end 1)))))
-     ((string-match "^[$@]\\([a-zA-Z_:0-9]+\\)[ \t]*{" val)
-      (setq val (concat "%" (substring val 1 (match-end 1)))))
-     ((and (string= val "x") (string-match "^x=" val))
-      (setq val "x="))
-     ((string-match "^\\$[\C-a-\C-z]" val)
-      (setq val (concat "$^" (char-to-string (+ ?A -1 (aref val 1))))))
-     ((string-match "^CORE::" val)
-      (setq val "CORE::"))
-     ((string-match "^SUPER::" val)
-      (setq val "SUPER::"))
-     ((and (string= "<" val) (string-match "^<\\$?[a-zA-Z0-9_:]+>" val))
-      (setq val "")))
-    (setq regexp (concat "^"
-			 "\\([^a-zA-Z0-9_:]+[ \t]+\\)?"
-			 (regexp-quote val)
-			 "\\([ \t([/]\\|$\\)"))
-
-    ;; get the buffer with the documentation text
-    (cperl-switch-to-doc-buffer)
-
-    ;; lookup in the doc
-    (goto-char (point-min))
-    (let ((case-fold-search nil))
-      (list
-       (if (re-search-forward regexp (point-max) t)
-	   (save-excursion
-	     (beginning-of-line 1)
-	     (let ((lnstart (point)))
-	       (end-of-line)
-	       (message "%s" (buffer-substring lnstart (point)))))
-	 (if cperl-message-on-help-error
-	     (message "No definition for %s" val)))))))
-
-(defvar cperl-short-docs 'please-ignore-this-line
-  ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl)
-  "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
-...	Range (list context); flip/flop [no flop when flip] (scalar context).
-! ...	Logical negation.
-... != ...	Numeric inequality.
-... !~ ...	Search pattern, substitution, or translation (negated).
-$!	In numeric context: errno.  In a string context: error string.
-$\"	The separator which joins elements of arrays interpolated in strings.
-$#	The output format for printed numbers.  Default is %.15g or close.
-$$	Process number of this script.  Changes in the fork()ed child process.
-$%	The current page number of the currently selected output channel.
-
-	The following variables are always local to the current block:
-
-$1	Match of the 1st set of parentheses in the last match (auto-local).
-$2	Match of the 2nd set of parentheses in the last match (auto-local).
-$3	Match of the 3rd set of parentheses in the last match (auto-local).
-$4	Match of the 4th set of parentheses in the last match (auto-local).
-$5	Match of the 5th set of parentheses in the last match (auto-local).
-$6	Match of the 6th set of parentheses in the last match (auto-local).
-$7	Match of the 7th set of parentheses in the last match (auto-local).
-$8	Match of the 8th set of parentheses in the last match (auto-local).
-$9	Match of the 9th set of parentheses in the last match (auto-local).
-$&	The string matched by the last pattern match (auto-local).
-$'	The string after what was matched by the last match (auto-local).
-$`	The string before what was matched by the last match (auto-local).
-
-$(	The real gid of this process.
-$)	The effective gid of this process.
-$*	Deprecated: Set to 1 to do multiline matching within a string.
-$+	The last bracket matched by the last search pattern.
-$,	The output field separator for the print operator.
-$-	The number of lines left on the page.
-$.	The current input line number of the last filehandle that was read.
-$/	The input record separator, newline by default.
-$0	Name of the file containing the current perl script (read/write).
-$:     String may be broken after these characters to fill ^-lines in a format.
-$;	Subscript separator for multi-dim array emulation.  Default \"\\034\".
-$<	The real uid of this process.
-$=	The page length of the current output channel.  Default is 60 lines.
-$>	The effective uid of this process.
-$?	The status returned by the last ``, pipe close or `system'.
-$@	The perl error message from the last eval or do @var{EXPR} command.
-$ARGV	The name of the current file used with <> .
-$[	Deprecated: The index of the first element/char in an array/string.
-$\\	The output record separator for the print operator.
-$]	The perl version string as displayed with perl -v.
-$^	The name of the current top-of-page format.
-$^A     The current value of the write() accumulator for format() lines.
-$^D	The value of the perl debug (-D) flags.
-$^E     Information about the last system error other than that provided by $!.
-$^F	The highest system file descriptor, ordinarily 2.
-$^H     The current set of syntax checks enabled by `use strict'.
-$^I	The value of the in-place edit extension (perl -i option).
-$^L     What formats output to perform a formfeed.  Default is \f.
-$^M     A buffer for emergency memory allocation when running out of memory.
-$^O     The operating system name under which this copy of Perl was built.
-$^P	Internal debugging flag.
-$^T	The time the script was started.  Used by -A/-M/-C file tests.
-$^W	True if warnings are requested (perl -w flag).
-$^X	The name under which perl was invoked (argv[0] in C-speech).
-$_	The default input and pattern-searching space.
-$|	Auto-flush after write/print on current output channel?  Default 0.
-$~	The name of the current report format.
-... % ...	Modulo division.
-... %= ...	Modulo division assignment.
-%ENV	Contains the current environment.
-%INC	List of files that have been require-d or do-ne.
-%SIG	Used to set signal handlers for various signals.
-... & ...	Bitwise and.
-... && ...	Logical and.
-... &&= ...	Logical and assignment.
-... &= ...	Bitwise and assignment.
-... * ...	Multiplication.
-... ** ...	Exponentiation.
-*NAME	Glob: all objects refered by NAME.  *NAM1 = *NAM2 aliases NAM1 to NAM2.
-&NAME(arg0, ...)	Subroutine call.  Arguments go to @_.
-... + ...	Addition.		+EXPR	Makes EXPR into scalar context.
-++	Auto-increment (magical on strings).	++EXPR	EXPR++
-... += ...	Addition assignment.
-,	Comma operator.
-... - ...	Subtraction.
---	Auto-decrement (NOT magical on strings).	--EXPR	EXPR--
-... -= ...	Subtraction assignment.
--A	Access time in days since script started.
--B	File is a non-text (binary) file.
--C	Inode change time in days since script started.
--M	Age in days since script started.
--O	File is owned by real uid.
--R	File is readable by real uid.
--S	File is a socket .
--T	File is a text file.
--W	File is writable by real uid.
--X	File is executable by real uid.
--b	File is a block special file.
--c	File is a character special file.
--d	File is a directory.
--e	File exists .
--f	File is a plain file.
--g	File has setgid bit set.
--k	File has sticky bit set.
--l	File is a symbolic link.
--o	File is owned by effective uid.
--p	File is a named pipe (FIFO).
--r	File is readable by effective uid.
--s	File has non-zero size.
--t	Tests if filehandle (STDIN by default) is opened to a tty.
--u	File has setuid bit set.
--w	File is writable by effective uid.
--x	File is executable by effective uid.
--z	File has zero size.
-.	Concatenate strings.
-..	Range (list context); flip/flop (scalar context) operator.
-.=	Concatenate assignment strings
-... / ...	Division.	/PATTERN/ioxsmg	Pattern match
-... /= ...	Division assignment.
-/PATTERN/ioxsmg	Pattern match.
-... < ...    Numeric less than.		Glob.	See , <> as well.
-	Reads line from filehandle NAME (a bareword or dollar-bareword).
-	Glob (Unless pattern is bareword/dollar-bareword - see ).
-<>	Reads line from union of files in @ARGV (= command line) and STDIN.
-... << ...	Bitwise shift left.	<<	start of HERE-DOCUMENT.
-... <= ...	Numeric less than or equal to.
-... <=> ...	Numeric compare.
-... = ...	Assignment.
-... == ...	Numeric equality.
-... =~ ...	Search pattern, substitution, or translation
-... > ...	Numeric greater than.
-... >= ...	Numeric greater than or equal to.
-... >> ...	Bitwise shift right.
-... >>= ...	Bitwise shift right assignment.
-... ? ... : ...	Condition=if-then-else operator.   ?PAT? One-time pattern match.
-?PATTERN?	One-time pattern match.
-@ARGV	Command line arguments (not including the command name - see $0).
-@INC	List of places to look for perl scripts during do/include/use.
-@_    Parameter array for subroutines; result of split() unless in list context.
-\\  Creates reference to what follows, like \$var, or quotes non-\w in strings.
-\\0	Octal char, e.g. \\033.
-\\E	Case modification terminator.  See \\Q, \\L, and \\U.
-\\L	Lowercase until \\E .  See also \l, lc.
-\\U	Upcase until \\E .  See also \\u, uc.
-\\Q	Quote metacharacters until \\E .  See also quotemeta.
-\\a	Alarm character (octal 007).
-\\b	Backspace character (octal 010).
-\\c	Control character, e.g. \\c[ .
-\\e	Escape character (octal 033).
-\\f	Formfeed character (octal 014).
-\\l	Lowercase the next character.  See also \\L and \\u, lcfirst.
-\\n	Newline character (octal 012 on most systems).
-\\r	Return character (octal 015 on most systems).
-\\t	Tab character (octal 011).
-\\u	Upcase the next character.  See also \\U and \\l, ucfirst.
-\\x	Hex character, e.g. \\x1b.
-... ^ ...	Bitwise exclusive or.
-__END__	Ends program source.
-__DATA__	Ends program source.
-__FILE__	Current (source) filename.
-__LINE__	Current line in current source.
-__PACKAGE__	Current package.
-ARGV	Default multi-file input filehandle.   is a synonym for <>.
-ARGVOUT	Output filehandle with -i flag.
-BEGIN { ... }	Immediately executed (during compilation) piece of code.
-END { ... }	Pseudo-subroutine executed after the script finishes.
-CHECK { ... }	Pseudo-subroutine executed after the script is compiled.
-INIT { ... }	Pseudo-subroutine executed before the script starts running.
-DATA	Input filehandle for what follows after __END__	or __DATA__.
-accept(NEWSOCKET,GENERICSOCKET)
-alarm(SECONDS)
-atan2(X,Y)
-bind(SOCKET,NAME)
-binmode(FILEHANDLE)
-caller[(LEVEL)]
-chdir(EXPR)
-chmod(LIST)
-chop[(LIST|VAR)]
-chown(LIST)
-chroot(FILENAME)
-close(FILEHANDLE)
-closedir(DIRHANDLE)
-... cmp ...	String compare.
-connect(SOCKET,NAME)
-continue of { block } continue { block }.  Is executed after `next' or at end.
-cos(EXPR)
-crypt(PLAINTEXT,SALT)
-dbmclose(%HASH)
-dbmopen(%HASH,DBNAME,MODE)
-defined(EXPR)
-delete($HASH{KEY})
-die(LIST)
-do { ... }|SUBR while|until EXPR	executes at least once
-do(EXPR|SUBR([LIST]))	(with while|until executes at least once)
-dump LABEL
-each(%HASH)
-endgrent
-endhostent
-endnetent
-endprotoent
-endpwent
-endservent
-eof[([FILEHANDLE])]
-... eq ...	String equality.
-eval(EXPR) or eval { BLOCK }
-exec(LIST)
-exit(EXPR)
-exp(EXPR)
-fcntl(FILEHANDLE,FUNCTION,SCALAR)
-fileno(FILEHANDLE)
-flock(FILEHANDLE,OPERATION)
-for (EXPR;EXPR;EXPR) { ... }
-foreach [VAR] (@ARRAY) { ... }
-fork
-... ge ...	String greater than or equal.
-getc[(FILEHANDLE)]
-getgrent
-getgrgid(GID)
-getgrnam(NAME)
-gethostbyaddr(ADDR,ADDRTYPE)
-gethostbyname(NAME)
-gethostent
-getlogin
-getnetbyaddr(ADDR,ADDRTYPE)
-getnetbyname(NAME)
-getnetent
-getpeername(SOCKET)
-getpgrp(PID)
-getppid
-getpriority(WHICH,WHO)
-getprotobyname(NAME)
-getprotobynumber(NUMBER)
-getprotoent
-getpwent
-getpwnam(NAME)
-getpwuid(UID)
-getservbyname(NAME,PROTO)
-getservbyport(PORT,PROTO)
-getservent
-getsockname(SOCKET)
-getsockopt(SOCKET,LEVEL,OPTNAME)
-gmtime(EXPR)
-goto LABEL
-... gt ...	String greater than.
-hex(EXPR)
-if (EXPR) { ... } [ elsif (EXPR) { ... } ... ] [ else { ... } ] or EXPR if EXPR
-index(STR,SUBSTR[,OFFSET])
-int(EXPR)
-ioctl(FILEHANDLE,FUNCTION,SCALAR)
-join(EXPR,LIST)
-keys(%HASH)
-kill(LIST)
-last [LABEL]
-... le ...	String less than or equal.
-length(EXPR)
-link(OLDFILE,NEWFILE)
-listen(SOCKET,QUEUESIZE)
-local(LIST)
-localtime(EXPR)
-log(EXPR)
-lstat(EXPR|FILEHANDLE|VAR)
-... lt ...	String less than.
-m/PATTERN/iogsmx
-mkdir(FILENAME,MODE)
-msgctl(ID,CMD,ARG)
-msgget(KEY,FLAGS)
-msgrcv(ID,VAR,SIZE,TYPE.FLAGS)
-msgsnd(ID,MSG,FLAGS)
-my VAR or my (VAR1,...)	Introduces a lexical variable ($VAR, @ARR, or %HASH).
-our VAR or our (VAR1,...) Lexically enable a global variable ($V, @A, or %H).
-... ne ...	String inequality.
-next [LABEL]
-oct(EXPR)
-open(FILEHANDLE[,EXPR])
-opendir(DIRHANDLE,EXPR)
-ord(EXPR)	ASCII value of the first char of the string.
-pack(TEMPLATE,LIST)
-package NAME	Introduces package context.
-pipe(READHANDLE,WRITEHANDLE)	Create a pair of filehandles on ends of a pipe.
-pop(ARRAY)
-print [FILEHANDLE] [(LIST)]
-printf [FILEHANDLE] (FORMAT,LIST)
-push(ARRAY,LIST)
-q/STRING/	Synonym for 'STRING'
-qq/STRING/	Synonym for \"STRING\"
-qx/STRING/	Synonym for `STRING`
-rand[(EXPR)]
-read(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
-readdir(DIRHANDLE)
-readlink(EXPR)
-recv(SOCKET,SCALAR,LEN,FLAGS)
-redo [LABEL]
-rename(OLDNAME,NEWNAME)
-require [FILENAME | PERL_VERSION]
-reset[(EXPR)]
-return(LIST)
-reverse(LIST)
-rewinddir(DIRHANDLE)
-rindex(STR,SUBSTR[,OFFSET])
-rmdir(FILENAME)
-s/PATTERN/REPLACEMENT/gieoxsm
-scalar(EXPR)
-seek(FILEHANDLE,POSITION,WHENCE)
-seekdir(DIRHANDLE,POS)
-select(FILEHANDLE | RBITS,WBITS,EBITS,TIMEOUT)
-semctl(ID,SEMNUM,CMD,ARG)
-semget(KEY,NSEMS,SIZE,FLAGS)
-semop(KEY,...)
-send(SOCKET,MSG,FLAGS[,TO])
-setgrent
-sethostent(STAYOPEN)
-setnetent(STAYOPEN)
-setpgrp(PID,PGRP)
-setpriority(WHICH,WHO,PRIORITY)
-setprotoent(STAYOPEN)
-setpwent
-setservent(STAYOPEN)
-setsockopt(SOCKET,LEVEL,OPTNAME,OPTVAL)
-shift[(ARRAY)]
-shmctl(ID,CMD,ARG)
-shmget(KEY,SIZE,FLAGS)
-shmread(ID,VAR,POS,SIZE)
-shmwrite(ID,STRING,POS,SIZE)
-shutdown(SOCKET,HOW)
-sin(EXPR)
-sleep[(EXPR)]
-socket(SOCKET,DOMAIN,TYPE,PROTOCOL)
-socketpair(SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL)
-sort [SUBROUTINE] (LIST)
-splice(ARRAY,OFFSET[,LENGTH[,LIST]])
-split[(/PATTERN/[,EXPR[,LIMIT]])]
-sprintf(FORMAT,LIST)
-sqrt(EXPR)
-srand(EXPR)
-stat(EXPR|FILEHANDLE|VAR)
-study[(SCALAR)]
-sub [NAME [(format)]] { BODY }	sub NAME [(format)];	sub [(format)] {...}
-substr(EXPR,OFFSET[,LEN])
-symlink(OLDFILE,NEWFILE)
-syscall(LIST)
-sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
-system(LIST)
-syswrite(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
-tell[(FILEHANDLE)]
-telldir(DIRHANDLE)
-time
-times
-tr/SEARCHLIST/REPLACEMENTLIST/cds
-truncate(FILE|EXPR,LENGTH)
-umask[(EXPR)]
-undef[(EXPR)]
-unless (EXPR) { ... } [ else { ... } ] or EXPR unless EXPR
-unlink(LIST)
-unpack(TEMPLATE,EXPR)
-unshift(ARRAY,LIST)
-until (EXPR) { ... }					EXPR until EXPR
-utime(LIST)
-values(%HASH)
-vec(EXPR,OFFSET,BITS)
-wait
-waitpid(PID,FLAGS)
-wantarray	Returns true if the sub/eval is called in list context.
-warn(LIST)
-while  (EXPR) { ... }					EXPR while EXPR
-write[(EXPR|FILEHANDLE)]
-... x ...	Repeat string or array.
-x= ...	Repetition assignment.
-y/SEARCHLIST/REPLACEMENTLIST/
-... | ...	Bitwise or.
-... || ...	Logical or.
-~ ...		Unary bitwise complement.
-#!	OS interpreter indicator.  If contains `perl', used for options, and -x.
-AUTOLOAD {...}	Shorthand for `sub AUTOLOAD {...}'.
-CORE::		Prefix to access builtin function if imported sub obscures it.
-SUPER::		Prefix to lookup for a method in @ISA classes.
-DESTROY		Shorthand for `sub DESTROY {...}'.
-... EQ ...	Obsolete synonym of `eq'.
-... GE ...	Obsolete synonym of `ge'.
-... GT ...	Obsolete synonym of `gt'.
-... LE ...	Obsolete synonym of `le'.
-... LT ...	Obsolete synonym of `lt'.
-... NE ...	Obsolete synonym of `ne'.
-abs [ EXPR ]	absolute value
-... and ...		Low-precedence synonym for &&.
-bless REFERENCE [, PACKAGE]	Makes reference into an object of a package.
-chomp [LIST]	Strips $/ off LIST/$_.  Returns count.  Special if $/ eq ''!
-chr		Converts a number to char with the same ordinal.
-else		Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
-elsif		Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
-exists $HASH{KEY}	True if the key exists.
-format [NAME] =	 Start of output format.  Ended by a single dot (.) on a line.
-formline PICTURE, LIST	Backdoor into \"format\" processing.
-glob EXPR	Synonym of .
-lc [ EXPR ]	Returns lowercased EXPR.
-lcfirst [ EXPR ]	Returns EXPR with lower-cased first letter.
-grep EXPR,LIST  or grep {BLOCK} LIST	Filters LIST via EXPR/BLOCK.
-map EXPR, LIST	or map {BLOCK} LIST	Applies EXPR/BLOCK to elts of LIST.
-no PACKAGE [SYMBOL1, ...]  Partial reverse for `use'.  Runs `unimport' method.
-not ...		Low-precedence synonym for ! - negation.
-... or ...		Low-precedence synonym for ||.
-pos STRING    Set/Get end-position of the last match over this string, see \\G.
-quotemeta [ EXPR ]	Quote regexp metacharacters.
-qw/WORD1 .../		Synonym of split('', 'WORD1 ...')
-readline FH	Synonym of .
-readpipe CMD	Synonym of `CMD`.
-ref [ EXPR ]	Type of EXPR when dereferenced.
-sysopen FH, FILENAME, MODE [, PERM]	(MODE is numeric, see Fcntl.)
-tie VAR, PACKAGE, LIST	Hide an object behind a simple Perl variable.
-tied		Returns internal object for a tied data.
-uc [ EXPR ]	Returns upcased EXPR.
-ucfirst [ EXPR ]	Returns EXPR with upcased first letter.
-untie VAR	Unlink an object from a simple Perl variable.
-use PACKAGE [SYMBOL1, ...]  Compile-time `require' with consequent `import'.
-... xor ...		Low-precedence synonym for exclusive or.
-prototype \&SUB	Returns prototype of the function given a reference.
-=head1		Top-level heading.
-=head2		Second-level heading.
-=head3		Third-level heading (is there such?).
-=over [ NUMBER ]	Start list.
-=item [ TITLE ]		Start new item in the list.
-=back		End list.
-=cut		Switch from POD to Perl.
-=pod		Switch from Perl to POD.
-")
-
-(defun cperl-switch-to-doc-buffer ()
-  "Go to the perl documentation buffer and insert the documentation."
-  (interactive)
-  (let ((buf (get-buffer-create cperl-doc-buffer)))
-    (if (interactive-p)
-	(switch-to-buffer-other-window buf)
-      (set-buffer buf))
-    (if (= (buffer-size) 0)
-	(progn
-	  (insert (documentation-property 'cperl-short-docs
-					  'variable-documentation))
-	  (setq buffer-read-only t)))))
-
-(defun cperl-beautify-regexp-piece (b e embed level)
-  ;; b is before the starting delimiter, e before the ending
-  ;; e should be a marker, may be changed, but remains "correct".
-  ;; EMBED is nil iff we process the whole REx.
-  ;; The REx is guaranteed to have //x
-  ;; LEVEL shows how many levels deep to go
-  ;; position at enter and at leave is not defined
-  (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos)
-    (if (not embed)
-	(goto-char (1+ b))
-      (goto-char b)
-      (cond ((looking-at "(\\?\\\\#")	;  (?#) wrongly commented when //x-ing
-	     (forward-char 2)
-	     (delete-char 1)
-	     (forward-char 1))
-	    ((looking-at "(\\?[^a-zA-Z]")
-	     (forward-char 3))
-	    ((looking-at "(\\?")	; (?i)
-	     (forward-char 2))
-	    (t
-	     (forward-char 1))))
-    (setq c (if embed (current-indentation) (1- (current-column)))
-	  c1 (+ c (or cperl-regexp-indent-step cperl-indent-level)))
-    (or (looking-at "[ \t]*[\n#]")
-	(progn
-	  (insert "\n")))
-    (goto-char e)
-    (beginning-of-line)
-    (if (re-search-forward "[^ \t]" e t)
-	(progn			       ; Something before the ending delimiter
-	  (goto-char e)
-	  (delete-horizontal-space)
-	  (insert "\n")
-	  (indent-to-column c)
-	  (set-marker e (point))))
-    (goto-char b)
-    (end-of-line 2)
-    (while (< (point) (marker-position e))
-      (beginning-of-line)
-      (setq s (point)
-	    inline t)
-      (skip-chars-forward " \t")
-      (delete-region s (point))
-      (indent-to-column c1)
-      (while (and
-	      inline
-	      (looking-at
-	       (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1 word
-		       "\\|"		; Embedded variable
-		       "\\$\\([a-zA-Z0-9_]+\\([[{]\\)?\\|[^\n \t)|]\\)" ; 2 3
-		       "\\|"		; $ ^
-		       "[$^]"
-		       "\\|"		; simple-code simple-code*?
-		       "\\(\\\\.\\|[^][()#|*+?\n]\\)\\([*+{?]\\??\\)?" ; 4 5
-		       "\\|"		; Class
-		       "\\(\\[\\)"	; 6
-		       "\\|"		; Grouping
-		       "\\((\\(\\?\\)?\\)" ; 7 8
-		       "\\|"		; |
-		       "\\(|\\)")))	; 9
-	(goto-char (match-end 0))
-	(setq spaces t)
-	(cond ((match-beginning 1)	; Alphanum word + junk
-	       (forward-char -1))
-	      ((or (match-beginning 3)	; $ab[12]
-		   (and (match-beginning 5) ; X* X+ X{2,3}
-			(eq (preceding-char) ?\{)))
-	       (forward-char -1)
-	       (forward-sexp 1))
-	      ((match-beginning 6)	; []
-	       (setq tmp (point))
-	       (if (looking-at "\\^?\\]")
-		   (goto-char (match-end 0)))
-	       ;; XXXX POSIX classes?!
-	       (while (and (not pos)
-			   (re-search-forward "\\[:\\|\\]" e t))
-		 (if (eq (preceding-char) ?:)
-		     (or (re-search-forward ":\\]" e t)
-			 (error "[:POSIX:]-group in []-group not terminated"))
-		   (setq pos t)))
-	       (or (eq (preceding-char) ?\])
-		   (error "[]-group not terminated"))
-	       (if (eq (following-char) ?\{)
-		   (progn
-		     (forward-sexp 1)
-		     (and (eq (following-char) ??)
-			  (forward-char 1)))
-		 (re-search-forward "\\=\\([*+?]\\??\\)" e t)))
-	      ((match-beginning 7)	; ()
-	       (goto-char (match-beginning 0))
-	       (setq pos (current-column))
-	       (or (eq pos c1)
-		   (progn
-		     (delete-horizontal-space)
-		     (insert "\n")
-		     (indent-to-column c1)))
-	       (setq tmp (point))
-	       (forward-sexp 1)
-	       ;;	       (or (forward-sexp 1)
-	       ;;		   (progn
-	       ;;		     (goto-char tmp)
-	       ;;		     (error "()-group not terminated")))
-	       (set-marker m (1- (point)))
-	       (set-marker m1 (point))
-	       (if (= level 1)
-		   (if (progn		; indent rigidly if multiline
-			 ;; In fact does not make a lot of sense, since
-			 ;; the starting position can be already lost due
-			 ;; to insertion of "\n" and " "
-			 (goto-char tmp)
-			 (search-forward "\n" m1 t))
-		       (indent-rigidly (point) m1 (- c1 pos)))
-		 (setq level (1- level))
-		 (cond
-		  ((not (match-beginning 8))
-		   (cperl-beautify-regexp-piece tmp m t level))
-		  ((eq (char-after (+ 2 tmp)) ?\{) ; Code
-		   t)
-		  ((eq (char-after (+ 2 tmp)) ?\() ; Conditional
-		   (goto-char (+ 2 tmp))
-		   (forward-sexp 1)
-		   (cperl-beautify-regexp-piece (point) m t level))
-		  ((eq (char-after (+ 2 tmp)) ?<) ; Lookbehind
-		   (goto-char (+ 3 tmp))
-		   (cperl-beautify-regexp-piece (point) m t level))
-		  (t
-		   (cperl-beautify-regexp-piece tmp m t level))))
-	       (goto-char m1)
-	       (cond ((looking-at "[*+?]\\??")
-		      (goto-char (match-end 0)))
-		     ((eq (following-char) ?\{)
-		      (forward-sexp 1)
-		      (if (eq (following-char) ?\?)
-			  (forward-char))))
-	       (skip-chars-forward " \t")
-	       (setq spaces nil)
-	       (if (looking-at "[#\n]")
-		   (progn
-		     (or (eolp) (indent-for-comment))
-		     (beginning-of-line 2))
-		 (delete-horizontal-space)
-		 (insert "\n"))
-	       (end-of-line)
-	       (setq inline nil))
-	      ((match-beginning 9)	; |
-	       (forward-char -1)
-	       (setq tmp (point))
-	       (beginning-of-line)
-	       (if (re-search-forward "[^ \t]" tmp t)
-		   (progn
-		     (goto-char tmp)
-		     (delete-horizontal-space)
-		     (insert "\n"))
-		 ;; first at line
-		 (delete-region (point) tmp))
-	       (indent-to-column c)
-	       (forward-char 1)
-	       (skip-chars-forward " \t")
-	       (setq spaces nil)
-	       (if (looking-at "[#\n]")
-		   (beginning-of-line 2)
-		 (delete-horizontal-space)
-		 (insert "\n"))
-	       (end-of-line)
-	       (setq inline nil)))
-	(or (looking-at "[ \t\n]")
-	    (not spaces)
-	    (insert " "))
-	(skip-chars-forward " \t"))
-      (or (looking-at "[#\n]")
-	  (error "Unknown code `%s' in a regexp"
-		 (buffer-substring (point) (1+ (point)))))
-      (and inline (end-of-line 2)))
-    ;; Special-case the last line of group
-    (if (and (>= (point) (marker-position e))
-	     (/= (current-indentation) c))
-	(progn
-	  (beginning-of-line)
-	  (setq s (point))
-	  (skip-chars-forward " \t")
-	  (delete-region s (point))
-	  (indent-to-column c)))))
-
-(defun cperl-make-regexp-x ()
-  ;; Returns position of the start
-  ;; XXX this is called too often!  Need to cache the result!
-  (save-excursion
-    (or cperl-use-syntax-table-text-property
-	(error "I need to have a regexp marked!"))
-    ;; Find the start
-    (if (looking-at "\\s|")
-	nil				; good already
-      (if (looking-at "\\([smy]\\|qr\\)\\s|")
-	  (forward-char 1)
-	(re-search-backward "\\s|")))	; Assume it is scanned already.
-    ;;(forward-char 1)
-    (let ((b (point)) (e (make-marker)) have-x delim (c (current-column))
-	  (sub-p (eq (preceding-char) ?s)) s)
-      (forward-sexp 1)
-      (set-marker e (1- (point)))
-      (setq delim (preceding-char))
-      (if (and sub-p (eq delim (char-after (- (point) 2))))
-	  (error "Possible s/blah// - do not know how to deal with"))
-      (if sub-p (forward-sexp 1))
-      (if (looking-at "\\sw*x")
-	  (setq have-x t)
-	(insert "x"))
-      ;; Protect fragile " ", "#"
-      (if have-x nil
-	(goto-char (1+ b))
-	(while (re-search-forward "\\(\\=\\|[^\\\\]\\)\\(\\\\\\\\\\)*[ \t\n#]" e t) ; Need to include (?#) too?
-	  (forward-char -1)
-	  (insert "\\")
-	  (forward-char 1)))
-      b)))
-
-(defun cperl-beautify-regexp (&optional deep)
-  "Do it.  (Experimental, may change semantics, recheck the result.)
-We suppose that the regexp is scanned already."
-  (interactive "P")
-  (setq deep (if deep (prefix-numeric-value deep) -1))
-  (save-excursion
-    (goto-char (cperl-make-regexp-x))
-    (let ((b (point)) (e (make-marker)))
-      (forward-sexp 1)
-      (set-marker e (1- (point)))
-      (cperl-beautify-regexp-piece b e nil deep))))
-
-(defun cperl-regext-to-level-start ()
-  "Goto start of an enclosing group in regexp.
-We suppose that the regexp is scanned already."
-  (interactive)
-  (let ((limit (cperl-make-regexp-x)) done)
-    (while (not done)
-      (or (eq (following-char) ?\()
-	  (search-backward "(" (1+ limit) t)
-	  (error "Cannot find `(' which starts a group"))
-      (setq done
-	    (save-excursion
-	      (skip-chars-backward "\\")
-	      (looking-at "\\(\\\\\\\\\\)*(")))
-      (or done (forward-char -1)))))
-
-(defun cperl-contract-level ()
-  "Find an enclosing group in regexp and contract it.
-\(Experimental, may change semantics, recheck the result.)
-We suppose that the regexp is scanned already."
-  (interactive)
-  ;; (save-excursion		; Can't, breaks `cperl-contract-levels'
-  (cperl-regext-to-level-start)
-  (let ((b (point)) (e (make-marker)) s c)
-    (forward-sexp 1)
-    (set-marker e (1- (point)))
-    (goto-char b)
-    (while (re-search-forward "\\(#\\)\\|\n" e 'to-end)
-      (cond
-       ((match-beginning 1)		; #-comment
-	(or c (setq c (current-indentation)))
-	(beginning-of-line 2)		; Skip
-	(setq s (point))
-	(skip-chars-forward " \t")
-	(delete-region s (point))
-	(indent-to-column c))
-       (t
-	(delete-char -1)
-	(just-one-space))))))
-
-(defun cperl-contract-levels ()
-  "Find an enclosing group in regexp and contract all the kids.
-\(Experimental, may change semantics, recheck the result.)
-We suppose that the regexp is scanned already."
-  (interactive)
-  (save-excursion
-    (condition-case nil
-	(cperl-regext-to-level-start)
-      (error				; We are outside outermost group
-       (goto-char (cperl-make-regexp-x))))
-    (let ((b (point)) (e (make-marker)) s c)
-      (forward-sexp 1)
-      (set-marker e (1- (point)))
-      (goto-char (1+ b))
-      (while (re-search-forward "\\(\\\\\\\\\\)\\|(" e t)
-	(cond
-	 ((match-beginning 1)		; Skip
-	  nil)
-	 (t				; Group
-	  (cperl-contract-level)))))))
-
-(defun cperl-beautify-level (&optional deep)
-  "Find an enclosing group in regexp and beautify it.
-\(Experimental, may change semantics, recheck the result.)
-We suppose that the regexp is scanned already."
-  (interactive "P")
-  (setq deep (if deep (prefix-numeric-value deep) -1))
-  (save-excursion
-    (cperl-regext-to-level-start)
-    (let ((b (point)) (e (make-marker)))
-      (forward-sexp 1)
-      (set-marker e (1- (point)))
-      (cperl-beautify-regexp-piece b e nil deep))))
-
-(defun cperl-invert-if-unless ()
-  "Change `if (A) {B}' into `B if A;' etc if possible."
-  (interactive)
-  (or (looking-at "\\<")
-      (forward-sexp -1))
-  (if (looking-at "\\<\\(if\\|unless\\|while\\|until\\|for\\|foreach\\)\\>")
-      (let ((pos1 (point))
-	    pos2 pos3 pos4 pos5 s1 s2 state p pos45
-	    (s0 (buffer-substring (match-beginning 0) (match-end 0))))
-	(forward-sexp 2)
-	(setq pos3 (point))
-	(forward-sexp -1)
-	(setq pos2 (point))
-	(if (eq (following-char) ?\( )
-	    (progn
-	      (goto-char pos3)
-	      (forward-sexp 1)
-	      (setq pos5 (point))
-	      (forward-sexp -1)
-	      (setq pos4 (point))
-	      ;; XXXX In fact may be `A if (B); {C}' ...
-	      (if (and (eq (following-char) ?\{ )
-		       (progn
-			 (cperl-backward-to-noncomment pos3)
-			 (eq (preceding-char) ?\) )))
-		  (if (condition-case nil
-			  (progn
-			    (goto-char pos5)
-			    (forward-sexp 1)
-			    (forward-sexp -1)
-			    (looking-at "\\"))
-			(error nil))
-		      (error
-		       "`%s' (EXPR) {BLOCK} with `else'/`elsif'" s0)
-		    (goto-char (1- pos5))
-		    (cperl-backward-to-noncomment pos4)
-		    (if (eq (preceding-char) ?\;)
-			(forward-char -1))
-		    (setq pos45 (point))
-		    (goto-char pos4)
-		    (while (re-search-forward "\\<\\(for\\|foreach\\|if\\|unless\\|while\\|until\\)\\>\\|;" pos45 t)
-		      (setq p (match-beginning 0)
-			    s1 (buffer-substring p (match-end 0))
-			    state (parse-partial-sexp pos4 p))
-		      (or (nth 3 state)
-			  (nth 4 state)
-			  (nth 5 state)
-			  (error "`%s' inside `%s' BLOCK" s1 s0))
-		      (goto-char (match-end 0)))
-		    ;; Finally got it
-		    (goto-char (1+ pos4))
-		    (skip-chars-forward " \t\n")
-		    (setq s2 (buffer-substring (point) pos45))
-		    (goto-char pos45)
-		    (or (looking-at ";?[ \t\n]*}")
-			(progn
-			  (skip-chars-forward "; \t\n")
-			  (setq s2 (concat s2 "\n" (buffer-substring (point) (1- pos5))))))
-		    (and (equal s2 "")
-			 (setq s2 "1"))
-		    (goto-char (1- pos3))
-		    (cperl-backward-to-noncomment pos2)
-		    (or (looking-at "[ \t\n]*)")
-			(goto-char (1- pos3)))
-		    (setq p (point))
-		    (goto-char (1+ pos2))
-		    (skip-chars-forward " \t\n")
-		    (setq s1 (buffer-substring (point) p))
-		    (delete-region pos4 pos5)
-		    (delete-region pos2 pos3)
-		    (goto-char pos1)
-		    (insert s2 " ")
-		    (just-one-space)
-		    (forward-word 1)
-		    (setq pos1 (point))
-		    (insert " " s1 ";")
-		    (delete-horizontal-space)
-		    (forward-char -1)
-		    (delete-horizontal-space)
-		    (goto-char pos1)
-		    (just-one-space)
-		    (cperl-indent-line))
-		(error "`%s' (EXPR) not with an {BLOCK}" s0)))
-	  (error "`%s' not with an (EXPR)" s0)))
-    (error "Not at `if', `unless', `while', `until', `for' or `foreach'")))
-
-;;; By Anthony Foiani 
-;;; Getting help on modules in C-h f ?
-;;; This is a modified version of `man'.
-;;; Need to teach it how to lookup functions
-;;; XEmacs change: autoload added.
-;;;###autoload
-(defun cperl-perldoc (word)
-  "Run `perldoc' on WORD."
-  (interactive
-   (list (let* ((default-entry (cperl-word-at-point))
-                (input (read-string
-                        (format "perldoc entry%s: "
-                                (if (string= default-entry "")
-                                    ""
-                                  (format " (default %s)" default-entry))))))
-           (if (string= input "")
-               (if (string= default-entry "")
-                   (error "No perldoc args given")
-                 default-entry)
-             input))))
-  (require 'man)
-  (let* ((case-fold-search nil)
-	 (is-func (and
-		   (string-match "^[a-z]+$" word)
-		   (string-match (concat "^" word "\\>")
-				 (documentation-property
-				  'cperl-short-docs
-				  'variable-documentation))))
-	 (manual-program (if is-func "perldoc -f" "perldoc")))
-    ;; XEmacs change: don't use Man-getpage-in-background
-    (cond
-     (cperl-xemacs-p
-      (let ((Manual-program "perldoc")
-            (Manual-switches (if is-func (list "-f"))))
-        (manual-entry word)))
-     (t
-      (Man-getpage-in-background word)))))
-
-;;; XEmacs change: autoload added.
-;;;###autoload
-(defun cperl-perldoc-at-point ()
-  "Run a `perldoc' on the word around point."
-  (interactive)
-  (cperl-perldoc (cperl-word-at-point)))
-
-(defcustom pod2man-program "pod2man"
-  "*File name for `pod2man'."
-  :type 'file
-  :group 'cperl)
-
-;;; By Nick Roberts  (with changes)
-(defun cperl-pod-to-manpage ()
-  "Create a virtual manpage in Emacs from the Perl Online Documentation."
-  (interactive)
-  (require 'man)
-  (let* ((pod2man-args (concat buffer-file-name " | nroff -man "))
-	 (bufname (concat "Man " buffer-file-name))
-	 (buffer (generate-new-buffer bufname)))
-    (save-excursion
-      (set-buffer buffer)
-      (let ((process-environment (copy-sequence process-environment)))
-        ;; Prevent any attempt to use display terminal fanciness.
-        (setenv "TERM" "dumb")
-        (set-process-sentinel
-         (start-process pod2man-program buffer "sh" "-c"
-                        (format (cperl-pod2man-build-command) pod2man-args))
-         'Man-bgproc-sentinel)))))
-
-;;; Updated version by him too
-(defun cperl-build-manpage ()
-  "Create a virtual manpage in Emacs from the POD in the file."
-  (interactive)
-  (require 'man)
-  (cond
-   (cperl-xemacs-p
-    (let ((Manual-program "perldoc"))
-      (manual-entry buffer-file-name)))
-   (t
-    (let* ((manual-program "perldoc"))
-      (Man-getpage-in-background buffer-file-name)))))
-
-(defun cperl-pod2man-build-command ()
-  "Builds the entire background manpage and cleaning command."
-  (let ((command (concat pod2man-program " %s 2>/dev/null"))
-	;; XEmacs change: check if Man-filter-list is bound
-        (flist (and (boundp 'Man-filter-list) Man-filter-list)))
-    (while (and flist (car flist))
-      (let ((pcom (car (car flist)))
-            (pargs (cdr (car flist))))
-        (setq command
-              (concat command " | " pcom " "
-                      (mapconcat '(lambda (phrase)
-                                    (if (not (stringp phrase))
-                                        (error "Malformed Man-filter-list"))
-                                    phrase)
-                                 pargs " ")))
-        (setq flist (cdr flist))))
-    command))
-
-(defun cperl-lazy-install ())		; Avoid a warning
-(defun cperl-lazy-unstall ())		; Avoid a warning
-
-(if (fboundp 'run-with-idle-timer)
-    (progn
-      (defvar cperl-help-shown nil
-	"Non-nil means that the help was already shown now.")
-
-      (defvar cperl-lazy-installed nil
-	"Non-nil means that the lazy-help handlers are installed now.")
-
-      (defun cperl-lazy-install ()
-	"Switches on Auto-Help on Perl constructs (put in the message area).
-Delay of auto-help controlled by `cperl-lazy-help-time'."
-	(interactive)
-	(make-variable-buffer-local 'cperl-help-shown)
-	(if (and (cperl-val 'cperl-lazy-help-time)
-		 (not cperl-lazy-installed))
-	    (progn
-	      (add-hook 'post-command-hook 'cperl-lazy-hook)
-	      (run-with-idle-timer
-	       (cperl-val 'cperl-lazy-help-time 1000000 5)
-	       t
-	       'cperl-get-help-defer)
-	      (setq cperl-lazy-installed t))))
-
-      (defun cperl-lazy-unstall ()
-	"Switches off Auto-Help on Perl constructs (put in the message area).
-Delay of auto-help controlled by `cperl-lazy-help-time'."
-	(interactive)
-	(remove-hook 'post-command-hook 'cperl-lazy-hook)
-	(cancel-function-timers 'cperl-get-help-defer)
-	(setq cperl-lazy-installed nil))
-
-      (defun cperl-lazy-hook ()
-	(setq cperl-help-shown nil))
-
-      (defun cperl-get-help-defer ()
-	(if (not (memq major-mode '(perl-mode cperl-mode))) nil
-	  (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t))
-	    (cperl-get-help)
-	    (setq cperl-help-shown t))))
-      (cperl-lazy-install)))
-
-
-;;; Plug for wrong font-lock:
-
-(defun cperl-font-lock-unfontify-region-function (beg end)
-  (let* ((modified (buffer-modified-p)) (buffer-undo-list t)
-	 (inhibit-read-only t) (inhibit-point-motion-hooks t)
-	 before-change-functions after-change-functions
-	 deactivate-mark buffer-file-name buffer-file-truename)
-    (remove-text-properties beg end '(face nil))
-    (when (and (not modified) (buffer-modified-p))
-      (set-buffer-modified-p nil))))
-
-(defvar cperl-d-l nil)
-(defun cperl-fontify-syntaxically (end)
-  ;; Some vars for debugging only
-  ;; (message "Syntaxifying...")
-  (let ((dbg (point)) (iend end)
-	(istate (car cperl-syntax-state))
-	start)
-    (and cperl-syntaxify-unwind
-	 (setq end (cperl-unwind-to-safe t end)))
-    (setq start (point))
-    (or cperl-syntax-done-to
-	(setq cperl-syntax-done-to (point-min)))
-    (if (or (not (boundp 'font-lock-hot-pass))
-	    (eval 'font-lock-hot-pass)
-	    t)				; Not debugged otherwise
-	;; Need to forget what is after `start'
-	(setq start (min cperl-syntax-done-to start))
-      ;; Fontification without a change
-      (setq start (max cperl-syntax-done-to start)))
-    (and (> end start)
-	 (setq cperl-syntax-done-to start) ; In case what follows fails
-	 (cperl-find-pods-heres start end t nil t))
-    (if (eq cperl-syntaxify-by-font-lock 'message)
-	(message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s"
-		 dbg iend
-		 start end cperl-syntax-done-to
-		 istate (car cperl-syntax-state))) ; For debugging
-    nil))				; Do not iterate
-
-(defun cperl-fontify-update (end)
-  (let ((pos (point)) prop posend)
-    (while (< pos end)
-      (setq prop (get-text-property pos 'cperl-postpone))
-      (setq posend (next-single-property-change pos 'cperl-postpone nil end))
-      (and prop (put-text-property pos posend (car prop) (cdr prop)))
-      (setq pos posend)))
-  nil)					; Do not iterate
-
-(defun cperl-update-syntaxification (from to)
-  (if (and cperl-use-syntax-table-text-property
-	   cperl-syntaxify-by-font-lock
-	   (or (null cperl-syntax-done-to)
-	       (< cperl-syntax-done-to to)))
-      (progn
-	(save-excursion
-	  (goto-char from)
-	  (cperl-fontify-syntaxically to)))))
-
-(defvar cperl-version
-  (let ((v  "$Revision: 5.0 $"))
-    (string-match ":\\s *\\([0-9.]+\\)" v)
-    (substring v (match-beginning 1) (match-end 1)))
-  "Version of IZ-supported CPerl package this file is based on.")
-
-;; XEmacs addition
-(defun pod-spell ()
-  "A function to only check pod/here documentation."
-  (interactive "*")
-  (save-excursion
-    (let ((element 0)
-          (my-list (make-pod-list)))
-      (while (< element (length my-list))
-        (setq the-first (car (nth element my-list)))
-        (setq the-second (cadr (nth element my-list)))
-        (ispell-region (car (nth element my-list)) (cadr (nth element my-list)))
-        (setq element (1+ element))))))
-
-;; XEmacs addition
-(defun make-pod-list ()
-  "A function to make a list of syntactic elements which are pod/here documentation."
-  (interactive)
-  (goto-char (point-min))
-  (let ((current 0)
-        (pod-list '())
-        (last-state nil)
-        (done nil)
-        (line 0)
-        (pod-start 0))
-    (while (not done)
-      (setq the-state (get-text-property current 'in-pod))
-      (cond
-       ((and (eq last-state nil) (eq the-state t))   ;; a new pod is starting
-        (setq last-state the-state)
-        (setq pod-start current))
-       ((and (eq last-state t) (eq the-state nil))   ;; the end of a pod
-        (setq last-state the-state)
-        (setq pod-list (cons (list pod-start current) pod-list)))
-       ((eq current (point-max))
-        (setq done t)))
-      (setq line (1+ line))
-      (goto-line line)
-      (setq current (point)))  ;; end of the while loop.
-    (reverse pod-list)))        ;; I reversed it just to make it prettier
-
-;; XEmacs additions
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode))
-;;;###autoload(add-to-list 'interpreter-mode-alist '("perl" . perl-mode))
-
-(provide 'cperl-mode)
-
-;;; cperl-mode.el ends here
diff --git a/xemacs-packages/lisp/perl-modes/custom-load.el b/xemacs-packages/lisp/perl-modes/custom-load.el
deleted file mode 100644
index 1e77b193..00000000
--- a/xemacs-packages/lisp/perl-modes/custom-load.el
+++ /dev/null
@@ -1,16 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'cperl '("cperl-mode"))
-(custom-add-loads 'cperl-indentation-details '("cperl-mode"))
-(custom-add-loads 'cperl-speed '("cperl-mode"))
-(custom-add-loads 'cperl-affected-by-hairy '("cperl-mode"))
-(custom-add-loads 'cperl-autoinsert-details '("cperl-mode"))
-(custom-add-loads 'cperl-faces '("cperl-mode"))
-(custom-add-loads 'languages '("cperl-mode"))
-(custom-add-loads 'cperl-help-system '("cperl-mode"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/perl-modes/perl-mode.el b/xemacs-packages/lisp/perl-modes/perl-mode.el
deleted file mode 100644
index ae26edf3..00000000
--- a/xemacs-packages/lisp/perl-modes/perl-mode.el
+++ /dev/null
@@ -1,712 +0,0 @@
-;;; perl-mode.el --- Perl code editing commands for GNU Emacs
-
-;; Copyright (C) 1990, 1994  Free Software Foundation, Inc.
-
-;; Author: William F. Mann
-;; Maintainer: FSF
-;; Adapted-By: ESR
-;; Keywords: languages
-
-;; Adapted from C code editing commands 'c-mode.el', Copyright 1987 by the
-;; Free Software Foundation, under terms of its General Public License.
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.30.
-
-;;; Commentary:
-
-;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
-;; to your .emacs file and change the first line of your perl script to:
-;; #!/usr/bin/perl --	 # -*-Perl-*-
-;; With arguments to perl:
-;; #!/usr/bin/perl -P-	 # -*-Perl-*-
-;; To handle files included with do 'filename.pl';, add something like
-;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode))
-;;                               auto-mode-alist))
-;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode.
-
-;; This code is based on the 18.53 version c-mode.el, with extensive
-;; rewriting.  Most of the features of c-mode survived intact.
-
-;; I added a new feature which adds functionality to TAB; it is controlled
-;; by the variable perl-tab-to-comment.  With it enabled, TAB does the
-;; first thing it can from the following list:  change the indentation;
-;; move past leading white space; delete an empty comment; reindent a
-;; comment; move to end of line; create an empty comment; tell you that
-;; the line ends in a quoted string, or has a # which should be a \#.
-
-;; If your machine is slow, you may want to remove some of the bindings
-;; to electric-perl-terminator.  I changed the indenting defaults to be
-;; what Larry Wall uses in perl/lib, but left in all the options.
-
-;; I also tuned a few things:  comments and labels starting in column
-;; zero are left there by indent-perl-exp; perl-beginning-of-function
-;; goes back to the first open brace/paren in column zero, the open brace
-;; in 'sub ... {', or the equal sign in 'format ... ='; indent-perl-exp
-;; (meta-^q) indents from the current line through the close of the next
-;; brace/paren, so you don't need to start exactly at a brace or paren.
-
-;; It may be good style to put a set of redundant braces around your
-;; main program.  This will let you reindent it with meta-^q.
-
-;; Known problems (these are all caused by limitations in the Emacs Lisp
-;; parsing routine (parse-partial-sexp), which was not designed for such
-;; a rich language; writing a more suitable parser would be a big job):
-;; 1)  Regular expression delimiters do not act as quotes, so special
-;;       characters such as `'"#:;[](){} may need to be backslashed
-;;       in regular expressions and in both parts of s/// and tr///.
-;; 2)  The globbing syntax  is not recognized, so special
-;;       characters in the pattern string must be backslashed.
-;; 3)  The q, qq, and << quoting operators are not recognized; see below.
-;; 4)  \ (backslash) always quotes the next character, so '\' is
-;;       treated as the start of a string.  Use "\\" as a work-around.
-;; 5)  To make variables such a $' and $#array work, perl-mode treats
-;;       $ just like backslash, so '$' is the same as problem 5.
-;; 6)  Unfortunately, treating $ like \ makes ${var} be treated as an
-;;       unmatched }.  See below.
-;; 7)  When ' (quote) is used as a package name separator, perl-mode
-;;       doesn't understand, and thinks it is seeing a quoted string.
-
-;; Here are some ugly tricks to bypass some of these problems:  the perl
-;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
-;; but will trick perl-mode into starting a quoted string, which
-;; can be ended with another /`/.  Assuming you have no embedded
-;; back-ticks, this can used to help solve problem 3:
-;;
-;;     /`/; $ugly = q?"'$?; /`/;
-;;
-;; To solve problem 6, add a /{/; before each use of ${var}:
-;;     /{/; while (<${glob_me}>) ...
-;;
-;; Problem 7 is even worse, but this 'fix' does work :-(
-;;     $DB'stop#'
-;;         [$DB'line#'
-;;          ] =~ s/;9$//;
-
-
-;;; Code:
-
-(defvar perl-mode-abbrev-table nil
-  "Abbrev table in use in perl-mode buffers.")
-(define-abbrev-table 'perl-mode-abbrev-table ())
-
-(defvar perl-mode-map ()
-  "Keymap used in Perl mode.")
-(if perl-mode-map
-    ()
-  (setq perl-mode-map (make-sparse-keymap))
-  (set-keymap-name perl-mode-map 'perl-mode-map)
-  (define-key perl-mode-map "{" 'electric-perl-terminator)
-  (define-key perl-mode-map "}" 'electric-perl-terminator)
-  (define-key perl-mode-map ";" 'electric-perl-terminator)
-  (define-key perl-mode-map ":" 'electric-perl-terminator)
-  (define-key perl-mode-map "\e\C-a" 'perl-beginning-of-function)
-  (define-key perl-mode-map "\e\C-e" 'perl-end-of-function)
-  (define-key perl-mode-map "\e\C-h" 'mark-perl-function)
-  (define-key perl-mode-map "\e\C-q" 'indent-perl-exp)
-  (define-key perl-mode-map "\t" 'perl-indent-command))
-
-(autoload 'c-macro-expand "cmacexp"
-  "Display the result of expanding all C macros occurring in the region.
-The expansion is entirely correct because it uses the C preprocessor."
-  t)
-
-(defvar perl-mode-syntax-table nil
-  "Syntax table in use in perl-mode buffers.")
-
-(if perl-mode-syntax-table
-    ()
-  (setq perl-mode-syntax-table (make-syntax-table (standard-syntax-table)))
-  (modify-syntax-entry ?\n ">" perl-mode-syntax-table)
-  (modify-syntax-entry ?# "<" perl-mode-syntax-table)
-  (modify-syntax-entry ?$ "\\" perl-mode-syntax-table)
-  (modify-syntax-entry ?% "." perl-mode-syntax-table)
-  (modify-syntax-entry ?& "." perl-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" perl-mode-syntax-table)
-  (modify-syntax-entry ?* "." perl-mode-syntax-table)
-  (modify-syntax-entry ?+ "." perl-mode-syntax-table)
-  (modify-syntax-entry ?- "." perl-mode-syntax-table)
-  (modify-syntax-entry ?/ "." perl-mode-syntax-table)
-  (modify-syntax-entry ?< "." perl-mode-syntax-table)
-  (modify-syntax-entry ?= "." perl-mode-syntax-table)
-  (modify-syntax-entry ?> "." perl-mode-syntax-table)
-  (modify-syntax-entry ?\\ "\\" perl-mode-syntax-table)
-  (modify-syntax-entry ?` "\"" perl-mode-syntax-table)
-  (modify-syntax-entry ?| "." perl-mode-syntax-table)
-)
-
-;(defvar perl-imenu-generic-expression
-;  '(
-;    ;; Functions
-;    (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)\\(\\s-\\|\n\\)*{" 1 )
-;    ;;Variables
-;    ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1 )
-;    )
-;  "Imenu generic expression for Perl mode.  See `imenu-generic-expression'.")
-
-(defvar perl-font-lock-keywords (purecopy
-  (list
-;   ("if" "until" "while" "elsif" "else" "unless" "for" "foreach" "continue"
-;    "exit" "die" "last" "goto" "next" "redo" "return" "local" "exec")
-   (concat "\\<\\("
-	   "continue\\|die\\|e\\(ls\\(e\\|if\\)\\|x\\(ec\\|it\\)\\)\\|"
-	   "for\\(\\|each\\)\\|goto\\|if\\|l\\(ast\\|ocal\\)\\|next\\|"
-	   "re\\(do\\|turn\\)\\|un\\(less\\|til\\)\\|while"
-	   "\\)\\>")
-;   ("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" "#define" "#undef")
-   (cons (concat "#\\(define\\|e\\(lse\\|ndif\\)\\|"
-		 "i\\(f\\(\\|def\\|ndef\\)\\|nclude\\)\\|undef\\)\\>")
-	 'font-lock-reference-face)
-   '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \t]*[{]" 1 font-lock-function-name-face)
-   '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 1 font-lock-function-name-face)
-   '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face)
-   ))
-  "Additional expressions to highlight in Perl mode.")
-
-;A similar version.
-;(defconst perl-font-lock-keywords (purecopy
-;  (list
-;   (cons (concat "[ \n\t{]*\\("
-;		 (mapconcat 'identity
-;			    '("if" "until" "while" "elsif" "else" "unless"
-;			      "for" "foreach" "continue" "exit" "die" "last"
-;			      "goto" "next" "redo" "return" "local" "exec")
-;			    "\\|")
-;		 "\\)[ \n\t;(]")
-;	 1)
-;        (mapconcat 'identity
-;                   '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include"
-;                     "#define" "#undef")
-;                   "\\|")
-;        '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \n\t]*\\{"
-;          1 font-lock-function-name-face)
-;        '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 
-;          1 font-lock-function-name-face)
-;        ;; '("\\(--- .* ---\\|=== .* ===\\)" 1 font-lock-doc-string-face)
-;        ))
-;  "Additional expressions to highlight in Perl mode.")
-
-(put 'perl-mode 'font-lock-defaults '(perl-font-lock-keywords))
-
-(defvar perl-indent-level 4
-  "*Indentation of Perl statements with respect to containing block.")
-(defvar perl-continued-statement-offset 4
-  "*Extra indent for lines not starting new statements.")
-(defvar perl-continued-brace-offset -4
-  "*Extra indent for substatements that start with open-braces.
-This is in addition to `perl-continued-statement-offset'.")
-(defvar perl-brace-offset 0
-  "*Extra indentation for braces, compared with other text in same context.")
-(defvar perl-brace-imaginary-offset 0
-  "*Imagined indentation of an open brace that actually follows a statement.")
-(defvar perl-label-offset -2
-  "*Offset of Perl label lines relative to usual indentation.")
-
-(defvar perl-tab-always-indent t
-  "*Non-nil means TAB in Perl mode always indents the current line.
-Otherwise it inserts a tab character if you type it past the first
-nonwhite character on the line.")
-
-;; I changed the default to nil for consistency with general Emacs
-;; conventions -- rms.
-(defvar perl-tab-to-comment nil
-  "*Non-nil means TAB moves to eol or makes a comment in some cases.
-For lines which don't need indenting, TAB either indents an
-existing comment, moves to end-of-line, or if at end-of-line already,
-create a new comment.")
-
-(defvar perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:"
-  "*Lines starting with this regular expression are not auto-indented.")
-
-(defvar perl-mode-hook nil
-  "Invoked on entry to perl-mode.")
-
-
-;;; bluck. ;;;###autoload
-(defun perl-mode ()
-  "Major mode for editing Perl code.
-Expression and list commands understand all Perl brackets.
-Tab indents for Perl code.
-Comments are delimited with # ... \\n.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-\\{perl-mode-map}
-Variables controlling indentation style:
- perl-tab-always-indent
-    Non-nil means TAB in Perl mode should always indent the current line,
-    regardless of where in the line point is when the TAB command is used.
- perl-tab-to-comment
-    Non-nil means that for lines which don't need indenting, TAB will
-    either delete an empty comment, indent an existing comment, move 
-    to end-of-line, or if at end-of-line already, create a new comment.
- perl-nochange
-    Lines starting with this regular expression are not auto-indented.
- perl-indent-level
-    Indentation of Perl statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- perl-continued-statement-offset
-    Extra indentation given to a substatement, such as the
-    then-clause of an if or body of a while.
- perl-continued-brace-offset
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to `perl-continued-statement-offset'.
- perl-brace-offset
-    Extra indentation for line if it starts with an open brace.
- perl-brace-imaginary-offset
-    An open brace following other text is treated as if it were
-    this far to the right of the start of its line.
- perl-label-offset
-    Extra indentation for line that is a label.
-
-Various indentation styles:       K&R  BSD  BLK  GNU  LW
-  perl-indent-level                5    8    0    2    4
-  perl-continued-statement-offset  5    8    4    2    4
-  perl-continued-brace-offset      0    0    0    0   -4
-  perl-brace-offset               -5   -8    0    0    0
-  perl-brace-imaginary-offset      0    0    4    0    0
-  perl-label-offset               -5   -8   -2   -2   -2
-
-Turning on Perl mode runs the normal hook `perl-mode-hook'."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map perl-mode-map)
-  (setq major-mode 'perl-mode)
-  (setq mode-name "Perl")
-  (setq local-abbrev-table perl-mode-abbrev-table)
-  (set-syntax-table perl-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'perl-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'perl-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  ;; Tell imenu how to handle Perl.
-;  (make-local-variable 'imenu-generic-expression)
-;  (setq imenu-generic-expression perl-imenu-generic-expression)
-  (run-hooks 'perl-mode-hook))
-
-;; This is used by indent-for-comment
-;; to decide how much to indent a comment in Perl code
-;; based on its context.
-(defun perl-comment-indent ()
-  (if (and (bolp) (not (eolp)))
-      0					;Existing comment at bol stays there.
-    (save-excursion
-      (skip-chars-backward " \t")
-      (max (if (bolp)			;Else indent at comment column
-	       0			; except leave at least one space if
-	     (1+ (current-column)))	; not at beginning of line.
-	   comment-column))))
-
-(defun electric-perl-terminator (arg)
-  "Insert character and adjust indentation.
-If at end-of-line, and not in a comment or a quote, correct the's indentation."
-  (interactive "P")
-  (let ((insertpos (point)))
-    (and (not arg)			; decide whether to indent
-	 (eolp)
-	 (save-excursion
-	   (beginning-of-line)
-	   (and (not			; eliminate comments quickly
-		 (re-search-forward comment-start-skip insertpos t)) 
-		(or (/= last-command-char ?:)
-		    ;; Colon is special only after a label ....
-		    (looking-at "\\s-*\\(\\w\\|\\s_\\)+$"))
-		(let ((pps (parse-partial-sexp 
-			    (perl-beginning-of-function) insertpos)))
-		  (not (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))
-	 (progn				; must insert, indent, delete
-	   (insert-char last-command-char 1)
-	   (perl-indent-line)
-	   (delete-char -1))))
-  (self-insert-command (prefix-numeric-value arg)))
-
-;; not used anymore, but may be useful someday:
-;;(defun perl-inside-parens-p ()
-;;  (condition-case ()
-;;      (save-excursion
-;;	(save-restriction
-;;	  (narrow-to-region (point)
-;;			    (perl-beginning-of-function))
-;;	  (goto-char (point-max))
-;;	  (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
-;;    (error nil)))
-
-(defun perl-indent-command (&optional arg)
-  "Indent current line as Perl code, or optionally, insert a tab character.
-
-With an argument, indent the current line, regardless of other options.
-
-If `perl-tab-always-indent' is nil and point is not in the indentation
-area at the beginning of the line, simply insert a tab.
-
-Otherwise, indent the current line.  If point was within the indentation
-area it is moved to the end of the indentation area.  If the line was
-already indented properly and point was not within the indentation area,
-and if `perl-tab-to-comment' is non-nil (the default), then do the first
-possible action from the following list:
-
-  1) delete an empty comment
-  2) move forward to start of comment, indenting if necessary
-  3) move forward to end of line
-  4) create an empty comment
-  5) move backward to start of comment, indenting if necessary."
-  (interactive "P")
-  (if arg				; If arg, just indent this line
-      (perl-indent-line "\f")
-    (if (and (not perl-tab-always-indent)
-	     (> (current-column) (current-indentation)))
-	(insert-tab)
-      (let (bof lsexp delta (oldpnt (point)))
-	(beginning-of-line) 
-	(setq lsexp (point))
-	(setq bof (perl-beginning-of-function))
-	(goto-char oldpnt)
-	(setq delta (perl-indent-line "\f\\|;?#" bof))
-	(and perl-tab-to-comment
-	     (= oldpnt (point))		; done if point moved
-	     (if (listp delta)		; if line starts in a quoted string
-		 (setq lsexp (or (nth 2 delta) bof))
-	       (= delta 0))		; done if indenting occurred
-	     (let (eol state)
-	       (end-of-line) 
-	       (setq eol (point))
-	       (if (= (char-after bof) ?=)
-		   (if (= oldpnt eol)
-		       (message "In a format statement"))     
-		 (setq state (parse-partial-sexp lsexp eol))
-		 (if (nth 3 state)
-		     (if (= oldpnt eol)	; already at eol in a string
-			 (message "In a string which starts with a %c."
-				  (nth 3 state)))
-		   (if (not (nth 4 state))
-		       (if (= oldpnt eol) ; no comment, create one?
-			   (indent-for-comment))
-		     (beginning-of-line)
-		     (if (re-search-forward comment-start-skip eol 'move)
-			 (if (eolp)
-			     (progn	; kill existing comment
-			       (goto-char (match-beginning 0))
-			       (skip-chars-backward " \t")
-			       (kill-region (point) eol))
-			   (if (or (< oldpnt (point)) (= oldpnt eol))
-			       (indent-for-comment) ; indent existing comment
-			     (end-of-line)))
-		       (if (/= oldpnt eol)
-			   (end-of-line)
-			 (message "Use backslash to quote # characters.")
-			 (ding t))))))))))))
-
-(defun perl-indent-line (&optional nochange parse-start)
-  "Indent current line as Perl code.
-Return the amount the indentation 
-changed by, or (parse-state) if line starts in a quoted string."
-  (let ((case-fold-search nil)
-	(pos (- (point-max) (point)))
-	(bof (or parse-start (save-excursion (perl-beginning-of-function))))
-	beg indent shift-amt)
-    (beginning-of-line)
-    (setq beg (point))
-    (setq shift-amt
-	  (cond ((= (char-after bof) ?=) 0)
-		((listp (setq indent (calculate-perl-indent bof))) indent)
-		((looking-at (or nochange perl-nochange)) 0)
-		(t
-		 (skip-chars-forward " \t\f")
-		 (cond ((looking-at "\\(\\w\\|\\s_\\)+:")
-			(setq indent (max 1 (+ indent perl-label-offset))))
-		       ((= (following-char) ?})
-			(setq indent (- indent perl-indent-level)))
-		       ((= (following-char) ?{)
-			(setq indent (+ indent perl-brace-offset))))
-		 (- indent (current-column)))))
-    (skip-chars-forward " \t\f")
-    (if (and (numberp shift-amt) (/= 0 shift-amt))
-	(progn (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))
-
-(defun calculate-perl-indent (&optional parse-start)
-  "Return appropriate indentation for current line as Perl code.
-In usual case returns an integer: the column to indent to.
-Returns (parse-state) if line starts inside a string."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point))
-	  (case-fold-search nil)
-	  (colon-line-end 0)
-	  state containing-sexp)
-      (if parse-start			;used to avoid searching
-	  (goto-char parse-start)
-	(perl-beginning-of-function))
-      (while (< (point) indent-point)	;repeat until right sexp
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-; state = (depth_in_parens innermost_containing_list last_complete_sexp
-;          string_terminator_or_nil inside_commentp following_quotep
-;          minimum_paren-depth_this_scan)
-; Parsing stops if depth in parentheses becomes equal to third arg.
-	(setq containing-sexp (nth 1 state)))
-      (cond ((nth 3 state) state)	; In a quoted string?
-	    ((null containing-sexp)	; Line is at top level.
-	     (skip-chars-forward " \t\f")
-	     (if (= (following-char) ?{)
-		 0   ; move to beginning of line if it starts a function body
-	       ;; indent a little if this is a continuation line
-	       (perl-backward-to-noncomment)
-	       (if (or (bobp)
-		       (memq (preceding-char) '(?\; ?\})))
-		   0 perl-continued-statement-offset)))
-	    ((/= (char-after containing-sexp) ?{)
-	     ;; line is expression, not statement:
-	     ;; indent to just after the surrounding open.
-	     (goto-char (1+ containing-sexp))
-	     (current-column))
-	    (t
-	     ;; Statement level.  Is it a continuation or a new statement?
-	     ;; Find previous non-comment character.
-	     (perl-backward-to-noncomment)
-	     ;; Back up over label lines, since they don't
-	     ;; affect whether our line is a continuation.
-	     (while (or (eq (preceding-char) ?\,)
-			(and (eq (preceding-char) ?:)
-			     (memq (char-syntax (char-after (- (point) 2)))
-				   '(?w ?_))))
-	       (if (eq (preceding-char) ?\,)
-		   (perl-backward-to-start-of-continued-exp containing-sexp)
-		 (beginning-of-line))
-	       (perl-backward-to-noncomment))
-	     ;; Now we get the answer.
-	     (if (not (memq (preceding-char) '(?\; ?\} ?\{)))
-		 ;; This line is continuation of preceding line's statement;
-		 ;; indent  perl-continued-statement-offset  more than the
-		 ;; previous line of the statement.
-		 (progn
-		   (perl-backward-to-start-of-continued-exp containing-sexp)
-		   (+ perl-continued-statement-offset (current-column)
-		      (if (save-excursion (goto-char indent-point)
-					  (looking-at "[ \t]*{"))
-			  perl-continued-brace-offset 0)))
-	       ;; This line starts a new statement.
-	       ;; Position at last unclosed open.
-	       (goto-char containing-sexp)
-	       (or
-		 ;; If open paren is in col 0, close brace is special
-		 (and (bolp)
-		      (save-excursion (goto-char indent-point)
-				      (looking-at "[ \t]*}"))
-		      perl-indent-level)
-		 ;; Is line first statement after an open-brace?
-		 ;; If no, find that first statement and indent like it.
-		 (save-excursion
-		   (forward-char 1)
-		   ;; Skip over comments and labels following openbrace.
-		   (while (progn
-			    (skip-chars-forward " \t\f\n")
-			    (cond ((looking-at ";?#")
-				   (forward-line 1) t)
-				  ((looking-at "\\(\\w\\|\\s_\\)+:")
-				   (save-excursion 
-				     (end-of-line) 
-				     (setq colon-line-end (point)))
-				   (search-forward ":")))))
-		   ;; The first following code counts
-		   ;; if it is before the line we want to indent.
-		   (and (< (point) indent-point)
-			(if (> colon-line-end (point))
-			    (- (current-indentation) perl-label-offset)
-			  (current-column))))
-		 ;; If no previous statement,
-		 ;; indent it relative to line brace is on.
-		 ;; For open paren in column zero, don't let statement
-		 ;; start there too.  If perl-indent-level is zero,
-		 ;; use perl-brace-offset + perl-continued-statement-offset
-		 ;; For open-braces not the first thing in a line,
-		 ;; add in perl-brace-imaginary-offset.
-		 (+ (if (and (bolp) (zerop perl-indent-level))
-			(+ perl-brace-offset perl-continued-statement-offset)
-		      perl-indent-level)
-		    ;; Move back over whitespace before the openbrace.
-		    ;; If openbrace is not first nonwhite thing on the line,
-		    ;; add the perl-brace-imaginary-offset.
-		    (progn (skip-chars-backward " \t")
-			   (if (bolp) 0 perl-brace-imaginary-offset))
-		    ;; If the openbrace is preceded by a parenthesized exp,
-		    ;; move to the beginning of that;
-		    ;; possibly a different line
-		    (progn
-		      (if (eq (preceding-char) ?\))
-			  (forward-sexp -1))
-		      ;; Get initial indentation of the line we are on.
-		      (current-indentation))))))))))
-
-(defun perl-backward-to-noncomment ()
-  "Move point backward to after the first non-white-space, skipping comments."
-  (interactive)
-  (let (opoint stop)
-    (while (not stop)
-      (setq opoint (point))
-      (beginning-of-line)
-      (if (re-search-forward comment-start-skip opoint 'move 1)
-	  (progn (goto-char (match-end 1))
-		 (skip-chars-forward ";")))
-      (skip-chars-backward " \t\f")
-      (setq stop (or (bobp)
-		     (not (bolp))
-		     (forward-char -1))))))
-
-(defun perl-backward-to-start-of-continued-exp (lim)
-  (if (= (preceding-char) ?\))
-      (forward-sexp -1))
-  (beginning-of-line)
-  (if (<= (point) lim)
-      (goto-char (1+ lim)))
-  (skip-chars-forward " \t\f"))
-
-;; note: this may be slower than the c-mode version, but I can understand it.
-(defun indent-perl-exp ()
-  "Indent each line of the Perl grouping following point."
-  (interactive)
-  (let* ((case-fold-search nil)
-	 (oldpnt (point-marker))
-	 (bof-mark (save-excursion
-		     (end-of-line 2)
-		     (perl-beginning-of-function)
-		     (point-marker)))
-	 eol last-mark lsexp-mark delta)
-    (if (= (char-after (marker-position bof-mark)) ?=)
-	(message "Can't indent a format statement")
-      (message "Indenting Perl expression...")
-      (save-excursion (end-of-line) (setq eol (point)))
-      (save-excursion			; locate matching close paren
-	(while (and (not (eobp)) (<= (point) eol))
-	  (parse-partial-sexp (point) (point-max) 0))
-	(setq last-mark (point-marker)))
-      (setq lsexp-mark bof-mark)
-      (beginning-of-line)
-      (while (< (point) (marker-position last-mark))
-	(setq delta (perl-indent-line nil (marker-position bof-mark)))
-	(if (numberp delta)		; unquoted start-of-line?
-	    (progn 
-	      (if (eolp)
-		  (delete-horizontal-space))
-	      (setq lsexp-mark (point-marker))))
-	(end-of-line)
-	(setq eol (point))
-	(if (nth 4 (parse-partial-sexp (marker-position lsexp-mark) eol))
-	    (progn			; line ends in a comment
-	      (beginning-of-line)
-	      (if (or (not (looking-at "\\s-*;?#"))
-		      (listp delta)
-		      (and (/= 0 delta)
-			   (= (- (current-indentation) delta) comment-column)))
-		  (if (re-search-forward comment-start-skip eol t)
-		      (indent-for-comment))))) ; indent existing comment
-	(forward-line 1))
-      (goto-char (marker-position oldpnt))
-      (message "Indenting Perl expression...done"))))
-
-(defun perl-beginning-of-function (&optional arg)
-  "Move backward to next beginning-of-function, or as far as possible.
-With argument, repeat that many times; negative args move forward.
-Returns new value of point in all cases."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (if (< arg 0) (forward-char 1))
-  (and (/= arg 0)
-       (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\."
-			   nil 'move arg)
-       (goto-char (1- (match-end 0))))
-  (point))
-
-;; note: this routine is adapted directly from emacs lisp.el, end-of-defun;
-;; no bugs have been removed :-)
-(defun perl-end-of-function (&optional arg)
-  "Move forward to next end-of-function.
-The end of a function is found by moving forward from the beginning of one.
-With argument, repeat that many times; negative args move backward."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (let ((first t))
-    (while (and (> arg 0) (< (point) (point-max)))
-      (let ((pos (point)))
-	(while (progn
-		(if (and first
-			 (progn
-			  (forward-char 1)
-			  (perl-beginning-of-function 1)
-			  (not (bobp))))
-		    nil
-		  (or (bobp) (forward-char -1))
-		  (perl-beginning-of-function -1))
-		(setq first nil)
-		(forward-list 1)
-		(skip-chars-forward " \t")
-		(if (looking-at "[#\n]")
-		    (forward-line 1))
-		(<= (point) pos))))
-      (setq arg (1- arg)))
-    (while (< arg 0)
-      (let ((pos (point)))
-	(perl-beginning-of-function 1)
-	(forward-sexp 1)
-	(forward-line 1)
-	(if (>= (point) pos)
-	    (if (progn (perl-beginning-of-function 2) (not (bobp)))
-		(progn
-		  (forward-list 1)
-		  (skip-chars-forward " \t")
-		  (if (looking-at "[#\n]")
-		      (forward-line 1)))
-	      (goto-char (point-min)))))
-      (setq arg (1+ arg)))))
-
-(defun mark-perl-function ()
-  "Put mark at end of Perl function, point at beginning."
-  (interactive)
-  (push-mark (point))
-  (perl-end-of-function)
-  (push-mark (point))
-  (perl-beginning-of-function)
-  (backward-paragraph))
-
-(provide 'perl-mode)
-
-;;; perl-mode.el ends here
diff --git a/xemacs-packages/lisp/pgg/ChangeLog b/xemacs-packages/lisp/pgg/ChangeLog
deleted file mode 100644
index bc2f67c6..00000000
--- a/xemacs-packages/lisp/pgg/ChangeLog
+++ /dev/null
@@ -1,507 +0,0 @@
-2005-09-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.06 released.
-
-2005-08-15  Simon Josefsson  
-
-	* pgg.el (url-insert-file-contents): Don't autoload it, Emacs has
-	it in url-handlers.el and XEmacs in url.el.  Reported by Luca
-	Capello and Romain Francoise.
-	(pgg-fetch-key-function): Removed, not used?
-	(pgg-insert-url-with-w3): Require url, to get
-	url-insert-file-contents regardless of where it is defined.
-
-2005-08-08  Simon Josefsson  
-
-	* pgg.el: Autoload url-insert-file-contents instead of loading
-	w3/url.
-	(pgg-insert-url-with-w3): Don't load url here.
-
-2005-08-05  Daiki Ueno  
-
-	* pgg-parse.el (pgg-parse-hash-algorithm-alist): Add SHA-2.
-
-2005-07-25  Simon Josefsson  
-
-	* pgg.el (pgg-insert-url-with-w3): Don't load w3, it is possible
-	to have the url package without w3.  Reported by Daiki Ueno
-	 and Luigi Panzeri .
-
-2005-07-04  Juanma Barranquero  
-
-	* pgg-gpg.el (pgg-gpg):
-	* pgg-parse.el (pgg-parse):
-	* pgg-pgp.el (pgg-pgp):
-	* pgg-pgp5.el (pgg-pgp5): Finish `defgroup' description with period.
-
-2005-06-29  Katsumi Yamaoka  
-
-	* pgg.el (pgg-verify): Return the verification result.
-
-2005-05-30  Reiner Steib  
-
-	* pgg-gpg.el (pgg-gpg-snarf-keys-region): Replace `string-to-int'
-	by `string-to-number'.
-	* pgg-parse.el (pgg-read-body, pgg-read-bytes)
-	(pgg-format-key-identifier): Ditto.
-
-2005-05-09  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Fix PIN caching,
-	tiny patch from "Georg C. F. Greve" .
-
-2005-01-21  Derek Atkins   (tiny change)
-
-	* pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache.
-
-2004-09-16  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.05 released.
-
-2004-08-31  Reiner Steib  
-
-	* pgg.texi: Use @copying and @insertcopying.
-
-2004-01-17  Jesper Harder  
-
-	* pgg.texi (User Commands, Backend methods): do.
-
-2004-01-05  Simon Josefsson  
-
-	* pgg.texi (Caching passphrase): Fix PGG passphrase caching
-	section.
-
-2003-09-14  Jesper Harder  
-
-	* pgg.texi (Selecting an implementation, Caching passphrase)
-	(Initializing): Markup fix.
-
-2003-05-17  Adrian Aichner  
-
-	* pgg.texi (Prerequisites): Ruthless typo fixing.
-	* pgg.texi (Architecture): Ditto.
-	* pgg.texi (Backend methods): Ditto.
-
-2004-09-16  Simon Josefsson  
-
-	* Makefile (REQUIRES): Add ecrypto, for password.el.
-
-	* pgg.el: Sync with Gnus CVS until and including 2003-07-24 entry
-	below.
-
-2004-01-05  Simon Josefsson  
-
-	* pgg.el (pgg-passphrase-cache, pgg-run-at-time): Remove.
-	(pgg-add-passphrase-cache, pgg-remove-passphrase-cache): Use
-	the password package.
-
-2003-12-12  Katsumi Yamaoka  
-
-	* pgg.el (pgg-run-at-time): Ditto.
-
-2003-12-10  Katsumi Yamaoka  
-
-	* pgg.el (pgg-run-at-time): New function.
-	(pgg-add-passphrase-cache): Use it.
-
-2003-10-27  Simon Josefsson  
-
-	* pgg.el (pgg-decrypt-region): Don't set pgg-default-user-id.
-
-2003-07-24  Jesper Harder  
-
-	* pgg.el: Reapply changes from 2003-04-03 to fix security problem.
-	See http://www.debian.org/security/2003/dsa-339
-
-2004-09-16  Simon Josefsson  
-
-	* pgg-pgp.el, pgg-pgp5.el: Sync with Gnus CVS until and including
-	2003-07-24 entry below.
-
-2004-07-28  Simon Josefsson  
-
-	* pgg-pgp5.el (pgg-pgp5-encrypt-region): Accept sign
-	parameter (but don't use it, for now).
-
-2004-05-19  Lars Magne Ingebrigtsen  
-
-	* pgg-pgp.el (pgg-pgp-verify-region): Clean up.
-
-2004-05-19  Michael Schierl  
-
-	* pgg-pgp.el (pgg-pgp-verify-region): Default when signature
-	isn't a string.
-
-2003-07-28  Dave Love  
-
-	* pgg-pgp.el, pgg-pgp5.el: Require cl when compiling.
-
-2003-07-24  Jesper Harder  
-
-	* pgg-pgp.el, pgg-pgp5.el: Reapply changes from 2003-04-03 to fix
-	security problem.  See http://www.debian.org/security/2003/dsa-339
-
-2004-09-16  Simon Josefsson  
-
-	* pgg-parse.el: Sync with Gnus CVS until and including 2003-12-10
-	entry below.
-
-2004-01-15  Jesper Harder  
-
-	* pgg-parse.el: Remove unnecessary (require 'custom).
-
-2003-12-10  Simon Josefsson  
-
-	* pgg-parse.el (pgg-decode-packets): Rewrite to handle corrupt
-	input.
-	(pgg-decode-armor-region): Don't parse packet if decoding fail.
-
-2004-09-16  Simon Josefsson  
-
-	* pgg-gpg.el: Sync with Gnus CVS until and including 2003-07-24
-	entry below.
-
-2003-12-07  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-recipient-arg): Add.
-	(pgg-gpg-encrypt-region): Use it.  Tiny patch from Lloyd Zusman
-	.
-	(pgg-gpg-recipient-argument): Doc fix.  Renamed fro p-g-r-a.
-	(pgg-gpg-encrypt-region): Update.
-
-2003-11-15  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-lookup-all-secret-keys)
-	(pgg-gpg-lookup-key): Use regexp match instead of
-	split-string (split-string is different between emacs 21.2 and
-	21.4).  Reported by ultrasoul@ultrasoul.com (David D. Smith).
-
-2003-11-09  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-encrypt-region): Cache passphrase under hex
-	key id too (for decryption).
-	(pgg-gpg-sign-region): Likewise.
-
-2003-11-09  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-all-secret-keys): New variable.
-	(pgg-gpg-lookup-all-secret-keys): New function.
-	(pgg-gpg-select-matching-key): Likewise.
-	(pgg-gpg-decrypt-region): Use new functions.  From Satyaki Das
-	.
-
-2003-10-27  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): New optional
-	parameter key, overrides the key id used to store passphrase
-	under (uses true key id from gpg output if nil).
-	(pgg-gpg-encrypt-region): Search for passphrase using user suplied
-	string STR, instead of (pgg-lookup-key STR t).
-	(pgg-gpg-encrypt-region): Store passphrase under user suplied
-	string, instead of real key id taken from gpg output.
-	(pgg-gpg-decrypt-region): Likewise.
-	(pgg-gpg-sign-region): Likewise.
-
-2003-08-09  Jesper Harder  
-
-	* pgg-gpg.el (pgg-gpg-extra-args): Fix customization type.
-
-2003-08-07  Jesper Harder  
-
-	* pgg-gpg.el (pgg-gpg-process-region): Bind
-	default-enable-multibyte-characters to nil.
-
-2003-07-28  Dave Love  
-
-	* pgg-gpg.el: Require cl when compiling.
-
-2003-07-24  Jesper Harder  
-
-	* pgg-gpg.el (pgg-gpg-process-region): Add "--yes" to options.
-
-	* pgg-gpg.el: Reapply changes from 2003-04-03 to fix security
-	problem.  See http://www.debian.org/security/2003/dsa-339
-
-2004-09-16  Simon Josefsson  
-
-	* pgg-def.el: Sync with Gnus CVS until and including 2003-10-02
-	entry below
-
-2004-01-15  Jesper Harder  
-
-	* pgg-def.el: Remove unnecessary (require 'custom).
-
-2003-11-10  Simon Josefsson  
-
-	* pgg-def.el (pgg-encrypt-for-me): Change default from nil to t.
-
-2003-10-02  Jesper Harder  
-
-	* pgg-def.el (pgg-default-keyserver-address): Change to
-	subkeys.pgp.net.  From Michael Shields 
-
-2003-10-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.04 released.
-
-2003-05-14  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.03 released.
-
-2003-05-12  Simon Josefsson  
-
-	* pgg.texi: Add .info extension to output filename, revert
-	2003-03-17 change below after xemacs-beta discussion.
-
-2003-05-10  Ville Skyttä  
-
-	* pgg.el (pgg-temp-buffer-show-function): Reuse existing
-	visible output window if one is available.
-
-2003-05-09  Simon Josefsson  
-
-	* pgg.texi (Default user identity): Add.
-
-2003-03-17  Simon Josefsson  
-
-	* pgg.texi: Fix setfilename.  Tiny patch by Frank Haun
-	.
-
-2003-04-29  Simon Josefsson  
-
-	* pgg.el (run-at-time): Autoload it (fix xemacs compile
-	warnings).
-
-2003-04-24  Dave Love  
-
-	* pgg.el: Split eval-when-compile forms.
-
-2003-04-20  Simon Josefsson  
-
-	* pgg-def.el, pgg.el, pgg-gpg.el, pgg-parse.el, pgg-pgp5.el,
-	pgg-pgp.el: Fix license template.
-
-2003-04-16  Dave Love  
-
-	* pgg.el: Require cl when compiling.
-
-2003-04-07  Jesper Harder  
-
-	* pgg.el (pgg-decrypt-region): Don't use
-	`insert-buffer', the docstring says "This function is meant for
-	the user to run interactively.  Don't call it from programs!"
-
-2003-04-06  Jesper Harder  
-
-	* pgg-gpg.el (pgg-gpg-process-region): Revert previous change.
-
-	* pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region)
-	(pgg-pgp-snarf-keys-region): do.
-
-	* pgg-pgp5.el (pgg-pgp5-verify-region)
-	(pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): do.
-
-	* pgg.el (pgg-make-temp-file, pgg-temporary-file-directory): do.
-
-2003-04-03  Jesper Harder  
-
-	* pgg-gpg.el (pgg-gpg-process-region): do.
-
-	* pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region)
-	(pgg-pgp-snarf-keys-region): do.
-
-	* pgg-pgp5.el (pgg-pgp5-verify-region)
-	(pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): Use it.
-
-	* pgg.el (pgg-make-temp-file): New function. `make-temp-name' is
-	unsafe.
-	(pgg-temporary-file-directory): Remove.
-
-2003-03-04  Jesper Harder  
-
-	* pgg.el (pgg-read-passphrase): Simplify.
-
-2003-03-01  Satyaki Das  
-	(Trivial patch.)
-
-	* pgg-gpg.el (pgg-gpg-process-region): Insert process status into
-	errors-buffer. This produces a nicer error message in case of
-	problems.
-
-2003-02-08  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-process-region): Don't blink.  From Satyaki
-	Das .
-
-2003-03-09  Ben Wing  
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-	Use STANDARD_DOCS instead of explicitly giving the targets
-	and dependencies.
-
-2002-11-29  Ben Wing  
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-12-06  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.02 released.
-
-2002-11-11  Simon Josefsson  
-
-	* pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify): Display
-	output when called interactively.
-
-2002-11-02  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-encrypt-region): Makes PGG respect the
-	setting of the default user ID.  From Raymond Scholz
-	.
-
-2002-10-30  Simon Josefsson  
-
-	* pgg-def.el (pgg-passphrase-cache-expiry): New, defcustom.
-
-	* pgg.el (pgg-passphrase-cache-expiry): Removed.
-
-2002-10-22  TSUCHIYA Masatoshi  
-
-	* pgg.el (pgg-snarf-keys): Do not refer unbinded local variables.
-
-2002-10-22  Simon Josefsson  
-
-	* pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify)
-	(pgg-snarf-keys): Add.
-
-2002-10-10  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-verify-region): Filter out stuff into output
-	buffer and error buffer depending on type of information.
-
-	* pgg.el (pgg-verify-region): Use it.
-
-	* pgg-def.el (pgg-query-keyserver): New variable.
-
-	* pgg.el (pgg-decrypt-region): Bind pgg-default-user-id to
-	key-identifier in packet.  Is this a good idea?
-
-2002-10-09  Simon Josefsson  
-
-	* pgg.el (pgg-insert-url-with-w3): Ignore errors.
-	(pgg-fetch-key-function): Nil if w3 is not installed.
-
-2002-10-29  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.01 released.
-
-2002-10-20  Steve Youngs  
-
-	* pgg-parse.el (pgg-parse-public-key-algorithm-alist): XEmacs
-	doesn't have the 'alist custom type, use cons cells instead.
-	(pgg-parse-symmetric-key-algorithm-alist): Ditto.
-	(pgg-parse-hash-algorithm-alist): Ditto.
-	(pgg-parse-compression-algorithm-alist): Ditto.
-	(pgg-parse-signature-type-alist): Ditto.
-
-	* pgg-gpg.el (pgg-gpg-extra-args): Fix custom mismatch.
-
-	* pgg-pgp5.el (pgg-pgp5-extra-args): Ditto.
-
-	* pgg-pgp.el (pgg-pgp-extra-args): Ditto.
-
-2002-10-15  Ville Skyttä  
-
-	* Makefile (srckit): Remove.
-
-2002-10-07  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.00 released.
-
-2002-10-05  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt really
-	work.
-
-2002-10-04  Ville Skyttä  
-
-	* Package moved to official location.
-	* Makefile (VERSION): Use two digits, change to 0.99.
-	* .cvsignore: New.
-
-2002-10-04  Simon Josefsson  
-
-	* pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt work.
-
-	* pgg-pgp.el (pgg-pgp-verify-region): Inline
-	binary-write-decoded-region from MEL.
-
-	* pgg.texi: Document sign parameter.  Remove luna stuff.
-
-2002-10-04  Simon Josefsson  
-
-	* pgg.el (pgg-encrypt-region): Support sign.
-
-	* pgg-gpg.el (pgg-gpg-encrypt-region): Ditto.
-
-2002-10-01  Simon Josefsson  
-
-	* pgg-pgp.el: Don't require mel.  Don't use luna.
-	(pgg-scheme-pgp-instance, pgg-make-scheme-pgp): Remove.
-	(pgg-pgp-process-region): Use expand-file-name instead of concat.
-	(pgg-pgp-process-region): Don't use binary-funcall.
-
-	* pgg-pgp5.el (pgg-pgp5-process-region): Don't use binary-funcall.
-
-	* pgg-gpg.el (pgg-gpg-process-region): Use expand-file-name
-	instead of concat.
-
-	* pgg-pgp5.el (pgg-pgp5-process-region): Ditto.
-
-2002-09-29  Simon Josefsson  
-
-	* pgg-parse.el (pgg-char-int, pgg-string-as-unibyte): Prevent byte
-	compile warnings.
-
-	* pgg.el (pgg-decrypt-region): Don't parse packet.
-
-	* pgg.el, pgg-gpg.el, pgg-pgp5.el: Don't depend on luna.el.
-
-2002-09-29  Daiki Ueno 
-
-	* pgg.el: Remove dependency on calist.el.
-
-2002-09-28  Simon Josefsson  
-
-	* pgg.el (pgg-temporary-file-directory): New variable.
-	(pgg-verify-region): Don't assume set-buffer-multibyte exists.
-
-	* pgg-pgp5.el (pgg-pgp5-process-region, pgg-scheme-verify-region)
-	(pgg-scheme-snarf-keys-region): Use pgg-temporary-file-directory.
-
-	* pgg-parse.el (pgg-char-int): Defalias.
-	(pgg-format-key-identifier, pgg-byte-after, pgg-read-byte) 
-	(pgg-read-bytes, pgg-read-body): Use it.
-	(pgg-decode-packets): Don't use MEL, use base64-*.
-	(pgg-parse-armor): Don't assume set-buffer-multibyte exists.
-	(pgg-string-as-unibyte): Defalias.
-	(pgg-parse-armor-region): Use it.
-
-	* pgg-gpg.el (pgg-gpg-process-region): Use
-	pgg-temporary-file-directory.
-
-	* pgg-pgp5.el (pgg-scheme-verify-region): Inline
-	binary-write-decoded-region from MEL.
-
-	* pgg-pgp5.el, pgg-gpg.el: Don't require mel.
-
-	* pgg-parse.el (top-level): Remove dependency on static.el,
-	pccl.el, mel.el.
-	(pgg-parse-crc24, pgg-parse-crc24-string): Only define if
-	`define-ccl-program' is boundp, instead of using broken.
-
-2002-09-28  Simon Josefsson  
-
-	* New package, taken from APEL, FLIM and SEMI (EMIKO).
diff --git a/xemacs-packages/lisp/pgg/README b/xemacs-packages/lisp/pgg/README
deleted file mode 100644
index 1d156277..00000000
--- a/xemacs-packages/lisp/pgg/README
+++ /dev/null
@@ -1,4 +0,0 @@
-This PGG package was extracted from SEMI (EMIKO branch)
-(ftp://ftp.m17n.org/pub/mule/) on 2002-09-28 by Simon Josefsson and
-made independent from APEL and FLIM by Daiki Ueno and Simon Josefsson
-soon after.
diff --git a/xemacs-packages/lisp/pgg/_pkg.el b/xemacs-packages/lisp/pgg/_pkg.el
deleted file mode 100644
index 18c7ad08..00000000
--- a/xemacs-packages/lisp/pgg/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'pgg
-		 :version 1.06
-          :author-version "0.1"
-		 :type 'regular)
diff --git a/xemacs-packages/lisp/pgg/auto-autoloads.el b/xemacs-packages/lisp/pgg/auto-autoloads.el
deleted file mode 100644
index 3db4a933..00000000
--- a/xemacs-packages/lisp/pgg/auto-autoloads.el
+++ /dev/null
@@ -1,74 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'pgg-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "pgg/_pkg.el")
-
-(package-provide 'pgg :version 1.06 :author-version "0.1" :type 'regular)
-
-;;;***
-
-;;;### (autoloads (pgg-snarf-keys pgg-snarf-keys-region pgg-insert-key pgg-verify pgg-verify-region pgg-sign pgg-sign-region pgg-decrypt pgg-decrypt-region pgg-encrypt pgg-encrypt-region) "pgg" "pgg/pgg.el")
-
-(autoload 'pgg-encrypt-region "pgg" "\
-Encrypt the current region between START and END for RCPTS.
-If optional argument SIGN is non-nil, do a combined sign and encrypt." t nil)
-
-(autoload 'pgg-encrypt "pgg" "\
-Encrypt the current buffer for RCPTS.
-If optional argument SIGN is non-nil, do a combined sign and encrypt.
-If optional arguments START and END are specified, only encrypt within
-the region." t nil)
-
-(autoload 'pgg-decrypt-region "pgg" "\
-Decrypt the current region between START and END." t nil)
-
-(autoload 'pgg-decrypt "pgg" "\
-Decrypt the current buffer.
-If optional arguments START and END are specified, only decrypt within
-the region." t nil)
-
-(autoload 'pgg-sign-region "pgg" "\
-Make the signature from text between START and END.
-If the optional 3rd argument CLEARTEXT is non-nil, it does not create
-a detached signature.
-If this function is called interactively, CLEARTEXT is enabled
-and the the output is displayed." t nil)
-
-(autoload 'pgg-sign "pgg" "\
-Sign the current buffer.
-If the optional argument CLEARTEXT is non-nil, it does not create a
-detached signature.
-If optional arguments START and END are specified, only sign data
-within the region.
-If this function is called interactively, CLEARTEXT is enabled
-and the the output is displayed." t nil)
-
-(autoload 'pgg-verify-region "pgg" "\
-Verify the current region between START and END.
-If the optional 3rd argument SIGNATURE is non-nil, it is treated as
-the detached signature of the current region.
-
-If the optional 4th argument FETCH is non-nil, we attempt to fetch the
-signer's public key from `pgg-default-keyserver-address'." t nil)
-
-(autoload 'pgg-verify "pgg" "\
-Verify the current buffer.
-If the optional argument SIGNATURE is non-nil, it is treated as
-the detached signature of the current region.
-If the optional argument FETCH is non-nil, we attempt to fetch the
-signer's public key from `pgg-default-keyserver-address'.
-If optional arguments START and END are specified, only verify data
-within the region." t nil)
-
-(autoload 'pgg-insert-key "pgg" "\
-Insert the ASCII armored public key." t nil)
-
-(autoload 'pgg-snarf-keys-region "pgg" "\
-Import public keys in the current region between START and END." t nil)
-
-(autoload 'pgg-snarf-keys "pgg" "\
-Import public keys in the current buffer." t nil)
-
-;;;***
-
-(provide 'pgg-autoloads)
diff --git a/xemacs-packages/lisp/pgg/custom-load.el b/xemacs-packages/lisp/pgg/custom-load.el
deleted file mode 100644
index fe2e0326..00000000
--- a/xemacs-packages/lisp/pgg/custom-load.el
+++ /dev/null
@@ -1,14 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'mime '("pgg-def"))
-(custom-add-loads 'pgg '("pgg-def" "pgg-gpg" "pgg-parse" "pgg-pgp" "pgg-pgp5"))
-(custom-add-loads 'pgg-pgp5 '("pgg-pgp5"))
-(custom-add-loads 'pgg-pgp '("pgg-pgp"))
-(custom-add-loads 'pgg-parse '("pgg-parse"))
-(custom-add-loads 'pgg-gpg '("pgg-gpg"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/pgg/pgg-def.el b/xemacs-packages/lisp/pgg/pgg-def.el
deleted file mode 100644
index 6df4798a..00000000
--- a/xemacs-packages/lisp/pgg/pgg-def.el
+++ /dev/null
@@ -1,89 +0,0 @@
-;;; pgg-def.el --- functions/macros for defining PGG functions
-
-;; Copyright (C) 1999, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno 
-;; Created: 1999/11/02
-;; Keywords: PGP, OpenPGP, GnuPG
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(defgroup pgg ()
-  "Glue for the various PGP implementations."
-  :group 'mime)
-
-(defcustom pgg-default-scheme 'gpg
-  "Default PGP scheme."
-  :group 'pgg
-  :type '(choice (const :tag "GnuPG" gpg)
-		 (const :tag "PGP 5" pgp5)
-		 (const :tag "PGP" pgp)))
-
-(defcustom pgg-default-user-id (user-login-name)
-  "User ID of your default identity."
-  :group 'pgg
-  :type 'string)
-
-(defcustom pgg-default-keyserver-address "subkeys.pgp.net"
-  "Host name of keyserver."
-  :group 'pgg
-  :type 'string)
-
-(defcustom pgg-query-keyserver nil
-  "Whether PGG queries keyservers for missing keys when verifying messages."
-  :group 'pgg
-  :type 'boolean)
-
-(defcustom pgg-encrypt-for-me t
-  "If t, encrypt all outgoing messages with user's public key."
-  :group 'pgg
-  :type 'boolean)
-
-(defcustom pgg-cache-passphrase t
-  "If t, cache passphrase."
-  :group 'pgg
-  :type 'boolean)
-
-(defcustom pgg-passphrase-cache-expiry 16
-  "How many seconds the passphrase is cached.
-Whether the passphrase is cached at all is controlled by
-`pgg-cache-passphrase'."
-  :group 'pgg
-  :type 'integer)
-
-(defvar pgg-messages-coding-system nil
-  "Coding system used when reading from a PGP external process.")
-
-(defvar pgg-status-buffer " *PGG status*")
-(defvar pgg-errors-buffer " *PGG errors*")
-(defvar pgg-output-buffer " *PGG output*")
-
-(defvar pgg-echo-buffer "*PGG-echo*")
-
-(defvar pgg-scheme nil
-  "Current scheme of PGP implementation.")
-
-(defmacro pgg-truncate-key-identifier (key)
-  `(if (> (length ,key) 8) (substring ,key 8) ,key))
-
-(provide 'pgg-def)
-
-;;; arch-tag: c425f3ab-ed75-4055-bb46-431a418c94b7
-;;; pgg-def.el ends here
diff --git a/xemacs-packages/lisp/pgg/pgg-gpg.el b/xemacs-packages/lisp/pgg/pgg-gpg.el
deleted file mode 100644
index 6ba017c7..00000000
--- a/xemacs-packages/lisp/pgg/pgg-gpg.el
+++ /dev/null
@@ -1,275 +0,0 @@
-;;; pgg-gpg.el --- GnuPG support for PGG.
-
-;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno 
-;; Created: 1999/10/28
-;; Keywords: PGP, OpenPGP, GnuPG
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl)				; for gpg macros
-  (require 'pgg))
-
-(defgroup pgg-gpg ()
-  "GnuPG interface."
-  :group 'pgg)
-
-(defcustom pgg-gpg-program "gpg"
-  "The GnuPG executable."
-  :group 'pgg-gpg
-  :type 'string)
-
-(defcustom pgg-gpg-extra-args nil
-  "Extra arguments for every GnuPG invocation."
-  :group 'pgg-gpg
-  :type '(repeat (string :tag "Argument")))
-
-(defcustom pgg-gpg-recipient-argument "--recipient"
-  "GnuPG option to specify recipient."
-  :group 'pgg-gpg
-  :type '(choice (const :tag "New `--recipient' option" "--recipient")
-		 (const :tag "Old `--remote-user' option" "--remote-user")))
-
-(defvar pgg-gpg-user-id nil
-  "GnuPG ID of your default identity.")
-
-(defun pgg-gpg-process-region (start end passphrase program args)
-  (let* ((output-file-name (pgg-make-temp-file "pgg-output"))
-	 (args
-	  `("--status-fd" "2"
-	    ,@(if passphrase '("--passphrase-fd" "0"))
-	    "--yes" ; overwrite
-	    "--output" ,output-file-name
-	    ,@pgg-gpg-extra-args ,@args))
-	 (output-buffer pgg-output-buffer)
-	 (errors-buffer pgg-errors-buffer)
-	 (orig-mode (default-file-modes))
-	 (process-connection-type nil)
-	 exit-status)
-    (with-current-buffer (get-buffer-create errors-buffer)
-      (buffer-disable-undo)
-      (erase-buffer))
-    (unwind-protect
-	(progn
-	  (set-default-file-modes 448)
-	  (let ((coding-system-for-write 'binary)
-		(input (buffer-substring-no-properties start end))
-		(default-enable-multibyte-characters nil))
-	    (with-temp-buffer
-	      (when passphrase
-		(insert passphrase "\n"))
-	      (insert input)
-	      (setq exit-status
-		    (apply #'call-process-region (point-min) (point-max) program
-			   nil errors-buffer nil args))))
-	  (with-current-buffer (get-buffer-create output-buffer)
-	    (buffer-disable-undo)
-	    (erase-buffer)
-	    (if (file-exists-p output-file-name)
-		(let ((coding-system-for-read 'raw-text-dos))
-		  (insert-file-contents output-file-name)))
-	    (set-buffer errors-buffer)
-	    (if (not (equal exit-status 0))
-		(insert (format "\n%s exited abnormally: '%s'\n"
-				program exit-status)))))
-      (if (file-exists-p output-file-name)
-	  (delete-file output-file-name))
-      (set-default-file-modes orig-mode))))
-
-(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key)
-  (if (and pgg-cache-passphrase
-	   (progn
-	     (goto-char (point-min))
-	     (re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t)))
-      (pgg-add-passphrase-cache
-       (or key
-	   (progn
-	     (goto-char (point-min))
-	     (if (re-search-forward
-		  "^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t)
-		 (substring (match-string 0) -8))))
-       passphrase)))
-
-(defvar pgg-gpg-all-secret-keys 'unknown)
-
-(defun pgg-gpg-lookup-all-secret-keys ()
-  "Return all secret keys present in secret key ring."
-  (when (eq pgg-gpg-all-secret-keys 'unknown)
-    (setq pgg-gpg-all-secret-keys '())
-    (let ((args (list "--with-colons" "--no-greeting" "--batch"
-		      "--list-secret-keys")))
-      (with-temp-buffer
-	(apply #'call-process pgg-gpg-program nil t nil args)
-	(goto-char (point-min))
-	(while (re-search-forward
-		"^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)" nil t)
-	  (push (substring (match-string 2) 8)
-		pgg-gpg-all-secret-keys)))))
-  pgg-gpg-all-secret-keys)
-
-(defun pgg-gpg-lookup-key (string &optional type)
-  "Search keys associated with STRING."
-  (let ((args (list "--with-colons" "--no-greeting" "--batch"
-		    (if type "--list-secret-keys" "--list-keys")
-		    string)))
-    (with-temp-buffer
-      (apply #'call-process pgg-gpg-program nil t nil args)
-      (goto-char (point-min))
-      (if (re-search-forward "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)"
-			     nil t)
-	  (substring (match-string 2) 8)))))
-
-(defun pgg-gpg-encrypt-region (start end recipients &optional sign)
-  "Encrypt the current region between START and END.
-If optional argument SIGN is non-nil, do a combined sign and encrypt."
-  (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
-	 (passphrase
-	  (when sign
-	    (pgg-read-passphrase
-	     (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
-	     pgg-gpg-user-id)))
-	 (args
-	  (append
-	   (list "--batch" "--armor" "--always-trust" "--encrypt")
-	   (if sign (list "--sign" "--local-user" pgg-gpg-user-id))
-	   (if recipients
-	       (apply #'nconc
-		      (mapcar (lambda (rcpt)
-				(list pgg-gpg-recipient-argument rcpt))
-			      (append recipients
-				      (if pgg-encrypt-for-me
-					  (list pgg-gpg-user-id)))))))))
-    (pgg-as-lbt start end 'CRLF
-      (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
-    (when sign
-      (with-current-buffer pgg-errors-buffer
-	;; Possibly cache passphrase under, e.g. "jas", for future sign.
-	(pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
-	;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
-	(pgg-gpg-possibly-cache-passphrase passphrase)))
-    (pgg-process-when-success)))
-
-(defun pgg-gpg-decrypt-region (start end)
-  "Decrypt the current region between START and END."
-  (let* ((current-buffer (current-buffer))
-	 (message-keys (with-temp-buffer
-			 (insert-buffer-substring current-buffer)
-			 (pgg-decode-armor-region (point-min) (point-max))))
-	 (secret-keys (pgg-gpg-lookup-all-secret-keys))
-	 (key (pgg-gpg-select-matching-key message-keys secret-keys))
-	 (pgg-gpg-user-id (or key pgg-gpg-user-id pgg-default-user-id))
-	 (passphrase
-	  (pgg-read-passphrase
-	   (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
-	   pgg-gpg-user-id))
-	 (args '("--batch" "--decrypt")))
-    (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
-    (with-current-buffer pgg-errors-buffer
-      (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
-      (goto-char (point-min))
-      (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
-
-(defun pgg-gpg-select-matching-key (message-keys secret-keys)
-  "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS."
-  (loop for message-key in message-keys
-	for message-key-id = (and (equal (car message-key) 1)
-				  (cdr (assq 'key-identifier message-key)))
-	for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt))
-	when (and key (member key secret-keys)) return key))
-
-(defun pgg-gpg-sign-region (start end &optional cleartext)
-  "Make detached signature from text between START and END."
-  (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
-	 (passphrase
-	  (pgg-read-passphrase
-	   (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
-	   pgg-gpg-user-id))
-	 (args
-	  (list (if cleartext "--clearsign" "--detach-sign")
-		"--armor" "--batch" "--verbose"
-		"--local-user" pgg-gpg-user-id))
-	 (inhibit-read-only t)
-	 buffer-read-only)
-    (pgg-as-lbt start end 'CRLF
-      (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
-    (with-current-buffer pgg-errors-buffer
-      ;; Possibly cache passphrase under, e.g. "jas", for future sign.
-      (pgg-gpg-possibly-cache-passphrase passphrase pgg-gpg-user-id)
-      ;; Possibly cache passphrase under, e.g. B565716F, for future decrypt.
-      (pgg-gpg-possibly-cache-passphrase passphrase))
-    (pgg-process-when-success)))
-
-(defun pgg-gpg-verify-region (start end &optional signature)
-  "Verify region between START and END as the detached signature SIGNATURE."
-  (let ((args '("--batch" "--verify")))
-    (when (stringp signature)
-      (setq args (append args (list signature))))
-    (setq args (append args '("-")))
-    (pgg-gpg-process-region start end nil pgg-gpg-program args)
-    (with-current-buffer pgg-errors-buffer
-      (goto-char (point-min))
-      (while (re-search-forward "^gpg: \\(.*\\)\n" nil t)
-	(with-current-buffer pgg-output-buffer
-	  (insert-buffer-substring pgg-errors-buffer
-				   (match-beginning 1) (match-end 0)))
-	(delete-region (match-beginning 0) (match-end 0)))
-      (goto-char (point-min))
-      (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t))))
-
-(defun pgg-gpg-insert-key ()
-  "Insert public key at point."
-  (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
-	 (args (list "--batch" "--export" "--armor"
-		     pgg-gpg-user-id)))
-    (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
-    (insert-buffer-substring pgg-output-buffer)))
-
-(defun pgg-gpg-snarf-keys-region (start end)
-  "Add all public keys in region between START and END to the keyring."
-  (let ((args '("--import" "--batch" "-")) status)
-    (pgg-gpg-process-region start end nil pgg-gpg-program args)
-    (set-buffer pgg-errors-buffer)
-    (goto-char (point-min))
-    (when (re-search-forward "^\\[GNUPG:] IMPORT_RES\\>" nil t)
-      (setq status (buffer-substring (match-end 0)
-				     (progn (end-of-line)(point)))
-	    status (vconcat (mapcar #'string-to-number (split-string status))))
-      (erase-buffer)
-      (insert (format "Imported %d key(s).
-\tArmor contains %d key(s) [%d bad, %d old].\n"
-		      (+ (aref status 2)
-			 (aref status 10))
-		      (aref status 0)
-		      (aref status 1)
-		      (+ (aref status 4)
-			 (aref status 11)))
-	      (if (zerop (aref status 9))
-		  ""
-		"\tSecret keys are imported.\n")))
-    (append-to-buffer pgg-output-buffer (point-min)(point-max))
-    (pgg-process-when-success)))
-
-(provide 'pgg-gpg)
-
-;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
-;;; pgg-gpg.el ends here
diff --git a/xemacs-packages/lisp/pgg/pgg-parse.el b/xemacs-packages/lisp/pgg/pgg-parse.el
deleted file mode 100644
index 422ccc6a..00000000
--- a/xemacs-packages/lisp/pgg/pgg-parse.el
+++ /dev/null
@@ -1,515 +0,0 @@
-;;; pgg-parse.el --- OpenPGP packet parsing
-
-;; Copyright (C) 1999, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno 
-;; Created: 1999/10/28
-;; Keywords: PGP, OpenPGP, GnuPG
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;    This module is based on
-
-;;	[OpenPGP] RFC 2440: "OpenPGP Message Format"
-;;	    by John W. Noerenberg, II ,
-;;          Jon Callas , Lutz Donnerhacke ,
-;;          Hal Finney  and Rodney Thayer 
-;;	    (1998/11)
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defgroup pgg-parse ()
-  "OpenPGP packet parsing."
-  :group 'pgg)
-
-(defcustom pgg-parse-public-key-algorithm-alist
-  '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
-  "Alist of the assigned number to the public key algorithm."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-parse-symmetric-key-algorithm-alist
-  '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
-  "Alist of the assigned number to the simmetric key algorithm."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-parse-hash-algorithm-alist
-  '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2) (8 . SHA256) (9 . SHA384)
-    (10 . SHA512))
-  "Alist of the assigned number to the cryptographic hash algorithm."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-parse-compression-algorithm-alist
-  '((0 . nil); Uncompressed
-    (1 . ZIP)
-    (2 . ZLIB))
-  "Alist of the assigned number to the compression algorithm."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-parse-signature-type-alist
-  '((0 . "Signature of a binary document")
-    (1 . "Signature of a canonical text document")
-    (2 . "Standalone signature")
-    (16 . "Generic certification of a User ID and Public Key packet")
-    (17 . "Persona certification of a User ID and Public Key packet")
-    (18 . "Casual certification of a User ID and Public Key packet")
-    (19 . "Positive certification of a User ID and Public Key packet")
-    (24 . "Subkey Binding Signature")
-    (31 . "Signature directly on a key")
-    (32 . "Key revocation signature")
-    (40 . "Subkey revocation signature")
-    (48 . "Certification revocation signature")
-    (64 . "Timestamp signature."))
-  "Alist of the assigned number to the signature type."
-  :group 'pgg-parse
-  :type '(repeat
-	  (cons (sexp :tag "Number") (sexp :tag "Type"))))
-
-(defcustom pgg-ignore-packet-checksum t; XXX
-  "If non-nil checksum of each ascii armored packet will be ignored."
-  :group 'pgg-parse
-  :type 'boolean)
-
-(defvar pgg-armor-header-lines
-  '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
-    "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
-    "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
-    "^-----BEGIN PGP SIGNATURE-----\r?$")
-  "Armor headers.")
-
-(eval-and-compile
-  (defalias 'pgg-char-int (if (fboundp 'char-int)
-			      'char-int
-			    'identity)))
-
-(defmacro pgg-format-key-identifier (string)
-  `(mapconcat (lambda (c) (format "%02X" (pgg-char-int c)))
-	      ,string "")
-  ;; `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
-  ;;                 (string-to-number-list ,string)))
-  )
-
-(defmacro pgg-parse-time-field (bytes)
-  `(list (logior (lsh (car ,bytes) 8)
-		 (nth 1 ,bytes))
-	 (logior (lsh (nth 2 ,bytes) 8)
-		 (nth 3 ,bytes))
-	 0))
-
-(defmacro pgg-byte-after (&optional pos)
-  `(pgg-char-int (char-after ,(or pos `(point)))))
-
-(defmacro pgg-read-byte ()
-  `(pgg-char-int (char-after (prog1 (point) (forward-char)))))
-
-(defmacro pgg-read-bytes-string (nbytes)
-  `(buffer-substring
-    (point) (prog1 (+ ,nbytes (point))
-	      (forward-char ,nbytes))))
-
-(defmacro pgg-read-bytes (nbytes)
-  `(mapcar #'pgg-char-int (pgg-read-bytes-string ,nbytes))
-  ;; `(string-to-number-list (pgg-read-bytes-string ,nbytes))
-  )
-
-(defmacro pgg-read-body-string (ptag)
-  `(if (nth 1 ,ptag)
-       (pgg-read-bytes-string (nth 1 ,ptag))
-     (pgg-read-bytes-string (- (point-max) (point)))))
-
-(defmacro pgg-read-body (ptag)
-  `(mapcar #'pgg-char-int (pgg-read-body-string ,ptag))
-  ;; `(string-to-number-list (pgg-read-body-string ,ptag))
-  )
-
-(defalias 'pgg-skip-bytes 'forward-char)
-
-(defmacro pgg-skip-header (ptag)
-  `(pgg-skip-bytes (nth 2 ,ptag)))
-
-(defmacro pgg-skip-body (ptag)
-  `(pgg-skip-bytes (nth 1 ,ptag)))
-
-(defmacro pgg-set-alist (alist key value)
-  `(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
-
-(when (fboundp 'define-ccl-program)
-
-  (define-ccl-program pgg-parse-crc24
-    '(1
-      ((loop
-	(read r0) (r1 ^= r0) (r2 ^= 0)
-	(r5 = 0)
-	(loop
-	 (r1 <<= 1)
-	 (r1 += ((r2 >> 15) & 1))
-	 (r2 <<= 1)
-	 (if (r1 & 256)
-	     ((r1 ^= 390) (r2 ^= 19707)))
-	 (if (r5 < 7)
-	     ((r5 += 1)
-	      (repeat))))
-	(repeat)))))
-
-  (defun pgg-parse-crc24-string (string)
-    (let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
-      (ccl-execute-on-string pgg-parse-crc24 h string)
-      (format "%c%c%c"
-	      (logand (aref h 1) 255)
-	      (logand (lsh (aref h 2) -8) 255)
-	      (logand (aref h 2) 255)))))
-
-(defmacro pgg-parse-length-type (c)
-  `(cond
-    ((< ,c 192) (cons ,c 1))
-    ((< ,c 224)
-     (cons (+ (lsh (- ,c 192) 8)
-	      (pgg-byte-after (+ 2 (point)))
-	      192)
-	   2))
-    ((= ,c 255)
-     (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
-			 (pgg-byte-after (+ 3 (point))))
-		 (logior (lsh (pgg-byte-after (+ 4 (point))) 8)
-			 (pgg-byte-after (+ 5 (point)))))
-	   5))
-    (t;partial body length
-     '(0 . 0))))
-
-(defun pgg-parse-packet-header ()
-  (let ((ptag (pgg-byte-after))
-	length-type content-tag packet-bytes header-bytes)
-    (if (zerop (logand 64 ptag));Old format
-	(progn
-	  (setq length-type (logand ptag 3)
-		length-type (if (= 3 length-type) 0 (lsh 1 length-type))
-		content-tag (logand 15 (lsh ptag -2))
-		packet-bytes 0
-		header-bytes (1+ length-type))
-	  (dotimes (i length-type)
-	    (setq packet-bytes
-		  (logior (lsh packet-bytes 8)
-			  (pgg-byte-after (+ 1 i (point)))))))
-      (setq content-tag (logand 63 ptag)
-	    length-type (pgg-parse-length-type
-			 (pgg-byte-after (1+ (point))))
-	    packet-bytes (car length-type)
-	    header-bytes (1+ (cdr length-type))))
-    (list content-tag packet-bytes header-bytes)))
-
-(defun pgg-parse-packet (ptag)
-  (case (car ptag)
-    (1 ;Public-Key Encrypted Session Key Packet
-     (pgg-parse-public-key-encrypted-session-key-packet ptag))
-    (2 ;Signature Packet
-     (pgg-parse-signature-packet ptag))
-    (3 ;Symmetric-Key Encrypted Session Key Packet
-     (pgg-parse-symmetric-key-encrypted-session-key-packet ptag))
-    ;; 4        -- One-Pass Signature Packet
-    ;; 5        -- Secret Key Packet
-    (6 ;Public Key Packet
-     (pgg-parse-public-key-packet ptag))
-    ;; 7        -- Secret Subkey Packet
-    ;; 8        -- Compressed Data Packet
-    (9 ;Symmetrically Encrypted Data Packet
-     (pgg-read-body-string ptag))
-    (10 ;Marker Packet
-     (pgg-read-body-string ptag))
-    (11 ;Literal Data Packet
-     (pgg-read-body-string ptag))
-    ;; 12       -- Trust Packet
-    (13 ;User ID Packet
-     (pgg-read-body-string ptag))
-    ;; 14       -- Public Subkey Packet
-    ;; 60 .. 63 -- Private or Experimental Values
-    ))
-
-(defun pgg-parse-packets (&optional header-parser body-parser)
-  (let ((header-parser
-	 (or header-parser
-	     (function pgg-parse-packet-header)))
-	(body-parser
-	 (or body-parser
-	     (function pgg-parse-packet)))
-	result ptag)
-    (while (> (point-max) (1+ (point)))
-      (setq ptag (funcall header-parser))
-      (pgg-skip-header ptag)
-      (push (cons (car ptag)
-		  (save-excursion
-		    (funcall body-parser ptag)))
-	    result)
-      (if (zerop (nth 1 ptag))
-	  (goto-char (point-max))
-	(forward-char (nth 1 ptag))))
-    result))
-
-(defun pgg-parse-signature-subpacket-header ()
-  (let ((length-type (pgg-parse-length-type (pgg-byte-after))))
-    (list (pgg-byte-after (+ (cdr length-type) (point)))
-	  (1- (car length-type))
-	  (1+ (cdr length-type)))))
-
-(defun pgg-parse-signature-subpacket (ptag)
-  (case (car ptag)
-    (2 ;signature creation time
-     (cons 'creation-time
-	   (let ((bytes (pgg-read-bytes 4)))
-	     (pgg-parse-time-field bytes))))
-    (3 ;signature expiration time
-     (cons 'signature-expiry
-	   (let ((bytes (pgg-read-bytes 4)))
-	     (pgg-parse-time-field bytes))))
-    (4 ;exportable certification
-     (cons 'exportability (pgg-read-byte)))
-    (5 ;trust signature
-     (cons 'trust-level (pgg-read-byte)))
-    (6 ;regular expression
-     (cons 'regular-expression
-	   (pgg-read-body-string ptag)))
-    (7 ;revocable
-     (cons 'revocability (pgg-read-byte)))
-    (9 ;key expiration time
-     (cons 'key-expiry
-	   (let ((bytes (pgg-read-bytes 4)))
-	     (pgg-parse-time-field bytes))))
-    ;; 10 = placeholder for backward compatibility
-    (11 ;preferred symmetric algorithms
-     (cons 'preferred-symmetric-key-algorithm
-	   (cdr (assq (pgg-read-byte)
-		      pgg-parse-symmetric-key-algorithm-alist))))
-    (12 ;revocation key
-     )
-    (16 ;issuer key ID
-     (cons 'key-identifier
-	   (pgg-format-key-identifier (pgg-read-body-string ptag))))
-    (20 ;notation data
-     (pgg-skip-bytes 4)
-     (cons 'notation
-	   (let ((name-bytes (pgg-read-bytes 2))
-		 (value-bytes (pgg-read-bytes 2)))
-	     (cons (pgg-read-bytes-string
-		    (logior (lsh (car name-bytes) 8)
-			    (nth 1 name-bytes)))
-		   (pgg-read-bytes-string
-		    (logior (lsh (car value-bytes) 8)
-			    (nth 1 value-bytes)))))))
-    (21 ;preferred hash algorithms
-     (cons 'preferred-hash-algorithm
-	   (cdr (assq (pgg-read-byte)
-		      pgg-parse-hash-algorithm-alist))))
-    (22 ;preferred compression algorithms
-     (cons 'preferred-compression-algorithm
-	   (cdr (assq (pgg-read-byte)
-		      pgg-parse-compression-algorithm-alist))))
-    (23 ;key server preferences
-     (cons 'key-server-preferences
-	   (pgg-read-body ptag)))
-    (24 ;preferred key server
-     (cons 'preferred-key-server
-	   (pgg-read-body-string ptag)))
-    ;; 25 = primary user id
-    (26 ;policy URL
-     (cons 'policy-url (pgg-read-body-string ptag)))
-    ;; 27 = key flags
-    ;; 28 = signer's user id
-    ;; 29 = reason for revocation
-    ;; 100 to 110 = internal or user-defined
-    ))
-
-(defun pgg-parse-signature-packet (ptag)
-  (let* ((signature-version (pgg-byte-after))
-	 (result (list (cons 'version signature-version)))
-	 hashed-material field n)
-    (cond
-     ((= signature-version 3)
-      (pgg-skip-bytes 2)
-      (setq hashed-material (pgg-read-bytes 5))
-      (pgg-set-alist result
-		     'signature-type
-		     (cdr (assq (pop hashed-material)
-				pgg-parse-signature-type-alist)))
-      (pgg-set-alist result
-		     'creation-time
-		     (pgg-parse-time-field hashed-material))
-      (pgg-set-alist result
-		     'key-identifier
-		     (pgg-format-key-identifier
-		      (pgg-read-bytes-string 8)))
-      (pgg-set-alist result
-		     'public-key-algorithm (pgg-read-byte))
-      (pgg-set-alist result
-		     'hash-algorithm (pgg-read-byte)))
-     ((= signature-version 4)
-      (pgg-skip-bytes 1)
-      (pgg-set-alist result
-		     'signature-type
-		     (cdr (assq (pgg-read-byte)
-				pgg-parse-signature-type-alist)))
-      (pgg-set-alist result
-		     'public-key-algorithm
-		     (pgg-read-byte))
-      (pgg-set-alist result
-		     'hash-algorithm (pgg-read-byte))
-      (when (>= 10000 (setq n (pgg-read-bytes 2)
-			    n (logior (lsh (car n) 8)
-				      (nth 1 n))))
-	(save-restriction
-	  (narrow-to-region (point)(+ n (point)))
-	  (nconc result
-		 (mapcar (function cdr) ;remove packet types
-			 (pgg-parse-packets
-			  #'pgg-parse-signature-subpacket-header
-			  #'pgg-parse-signature-subpacket)))
-	  (goto-char (point-max))))
-      (when (>= 10000 (setq n (pgg-read-bytes 2)
-			    n (logior (lsh (car n) 8)
-				      (nth 1 n))))
-	(save-restriction
-	  (narrow-to-region (point)(+ n (point)))
-	  (nconc result
-		 (mapcar (function cdr) ;remove packet types
-			 (pgg-parse-packets
-			  #'pgg-parse-signature-subpacket-header
-			  #'pgg-parse-signature-subpacket)))))))
-
-    (setcdr (setq field (assq 'public-key-algorithm
-			      result))
-	    (cdr (assq (cdr field)
-		       pgg-parse-public-key-algorithm-alist)))
-    (setcdr (setq field (assq 'hash-algorithm
-			      result))
-	    (cdr (assq (cdr field)
-		       pgg-parse-hash-algorithm-alist)))
-    result))
-
-(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
-  (let (result)
-    (pgg-set-alist result
-		   'version (pgg-read-byte))
-    (pgg-set-alist result
-		   'key-identifier
-		   (pgg-format-key-identifier
-		    (pgg-read-bytes-string 8)))
-    (pgg-set-alist result
-		   'public-key-algorithm
-		   (cdr (assq (pgg-read-byte)
-			      pgg-parse-public-key-algorithm-alist)))
-    result))
-
-(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
-  (let (result)
-    (pgg-set-alist result
-		   'version
-		   (pgg-read-byte))
-    (pgg-set-alist result
-		   'symmetric-key-algorithm
-		   (cdr (assq (pgg-read-byte)
-			      pgg-parse-symmetric-key-algorithm-alist)))
-    result))
-
-(defun pgg-parse-public-key-packet (ptag)
-  (let* ((key-version (pgg-read-byte))
-	 (result (list (cons 'version key-version)))
-	 field)
-    (cond
-     ((= 3 key-version)
-      (pgg-set-alist result
-		     'creation-time
-		     (let ((bytes (pgg-read-bytes 4)))
-		       (pgg-parse-time-field bytes)))
-      (pgg-set-alist result
-		     'key-expiry (pgg-read-bytes 2))
-      (pgg-set-alist result
-		     'public-key-algorithm (pgg-read-byte)))
-     ((= 4 key-version)
-      (pgg-set-alist result
-		     'creation-time
-		     (let ((bytes (pgg-read-bytes 4)))
-		       (pgg-parse-time-field bytes)))
-      (pgg-set-alist result
-		     'public-key-algorithm (pgg-read-byte))))
-
-    (setcdr (setq field (assq 'public-key-algorithm
-			      result))
-	    (cdr (assq (cdr field)
-		       pgg-parse-public-key-algorithm-alist)))
-    result))
-
-(defun pgg-decode-packets ()
-  (if (re-search-forward "^=\\([A-Za-z0-9+/]\\{4\\}\\)$" nil t)
-      (let ((p (match-beginning 0))
-	    (checksum (match-string 1)))
-	(delete-region p (point-max))
-	(if (ignore-errors (base64-decode-region (point-min) p))
-	    (or (not (fboundp 'pgg-parse-crc24-string))
-		pgg-ignore-packet-checksum
-		(string-equal (base64-encode-string (pgg-parse-crc24-string
-						     (buffer-string)))
-			      checksum)
-		(progn
-		  (message "PGP packet checksum does not match")
-		  nil))
-	  (message "PGP packet contain invalid base64")
-	  nil))
-    (message "PGP packet checksum not found")
-    nil))
-
-(defun pgg-decode-armor-region (start end)
-  (save-restriction
-    (narrow-to-region start end)
-    (goto-char (point-min))
-    (re-search-forward "^-+BEGIN PGP" nil t)
-    (delete-region (point-min)
-		   (and (search-forward "\n\n")
-			(match-end 0)))
-    (when (pgg-decode-packets)
-      (goto-char (point-min))
-      (pgg-parse-packets))))
-
-(defun pgg-parse-armor (string)
-  (with-temp-buffer
-    (buffer-disable-undo)
-    (if (fboundp 'set-buffer-multibyte)
-	(set-buffer-multibyte nil))
-    (insert string)
-    (pgg-decode-armor-region (point-min)(point))))
-
-(eval-and-compile
-  (defalias 'pgg-string-as-unibyte (if (fboundp 'string-as-unibyte)
-				       'string-as-unibyte
-				     'identity)))
-
-(defun pgg-parse-armor-region (start end)
-  (pgg-parse-armor (pgg-string-as-unibyte (buffer-substring start end))))
-
-(provide 'pgg-parse)
-
-;;; arch-tag: 16c2eb82-1313-4a7c-a70f-420709b5b43e
-;;; pgg-parse.el ends here
diff --git a/xemacs-packages/lisp/pgg/pgg-pgp.el b/xemacs-packages/lisp/pgg/pgg-pgp.el
deleted file mode 100644
index 2735a0b7..00000000
--- a/xemacs-packages/lisp/pgg/pgg-pgp.el
+++ /dev/null
@@ -1,245 +0,0 @@
-;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
-
-;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno 
-;; Created: 1999/11/02
-;; Keywords: PGP, OpenPGP
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl)				; for pgg macros
-  (require 'pgg))
-
-(defgroup pgg-pgp ()
-  "PGP 2.* and 6.* interface."
-  :group 'pgg)
-
-(defcustom pgg-pgp-program "pgp"
-  "PGP 2.* and 6.* executable."
-  :group 'pgg-pgp
-  :type 'string)
-
-(defcustom pgg-pgp-shell-file-name "/bin/sh"
-  "File name to load inferior shells from.
-Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
-  :group 'pgg-pgp
-  :type 'string)
-
-(defcustom pgg-pgp-shell-command-switch "-c"
-  "Switch used to have the shell execute its command line argument."
-  :group 'pgg-pgp
-  :type 'string)
-
-(defcustom pgg-pgp-extra-args nil
-  "Extra arguments for every PGP invocation."
-  :group 'pgg-pgp
-  :type '(choice
-	  (const :tag "None" nil)
-	  (string :tag "Arguments")))
-
-(defvar pgg-pgp-user-id nil
-  "PGP ID of your default identity.")
-
-(defun pgg-pgp-process-region (start end passphrase program args)
-  (let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
-	 (args
-	  (append args
-		  pgg-pgp-extra-args
-		  (list (concat "2>" errors-file-name))))
-	 (shell-file-name pgg-pgp-shell-file-name)
-	 (shell-command-switch pgg-pgp-shell-command-switch)
-	 (process-environment process-environment)
-	 (output-buffer pgg-output-buffer)
-	 (errors-buffer pgg-errors-buffer)
-	 (process-connection-type nil)
-	 process status exit-status)
-    (with-current-buffer (get-buffer-create output-buffer)
-      (buffer-disable-undo)
-      (erase-buffer))
-    (when passphrase
-      (setenv "PGPPASSFD" "0"))
-    (unwind-protect
-	(progn
-	  (let ((coding-system-for-read 'binary)
-		(coding-system-for-write 'binary))
-	    (setq process
-		  (apply #'funcall
-			 #'start-process-shell-command "*PGP*" output-buffer
-			 program args)))
-	  (set-process-sentinel process #'ignore)
-	  (when passphrase
-	    (process-send-string process (concat passphrase "\n")))
-	  (process-send-region process start end)
-	  (process-send-eof process)
-	  (while (eq 'run (process-status process))
-	    (accept-process-output process 5))
-	  (setq status (process-status process)
-		exit-status (process-exit-status process))
-	  (delete-process process)
-	  (with-current-buffer output-buffer
-	    (pgg-convert-lbt-region (point-min)(point-max) 'LF)
-
-	    (if (memq status '(stop signal))
-		(error "%s exited abnormally: '%s'" program exit-status))
-	    (if (= 127 exit-status)
-		(error "%s could not be found" program))
-
-	    (set-buffer (get-buffer-create errors-buffer))
-	    (buffer-disable-undo)
-	    (erase-buffer)
-	    (insert-file-contents errors-file-name)))
-      (if (and process (eq 'run (process-status process)))
-	  (interrupt-process process))
-      (condition-case nil
-	  (delete-file errors-file-name)
-	(file-error nil)))))
-
-(defun pgg-pgp-lookup-key (string &optional type)
-  "Search keys associated with STRING."
-  (let ((args (list "+batchmode" "+language=en" "-kv" string)))
-    (with-current-buffer (get-buffer-create pgg-output-buffer)
-      (buffer-disable-undo)
-      (erase-buffer)
-      (apply #'call-process pgg-pgp-program nil t nil args)
-      (goto-char (point-min))
-      (cond
-       ((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
-	(buffer-substring (point)(+ 8 (point))))
-       ((re-search-forward "^Type" nil t);PGP 6.*
-	(beginning-of-line 2)
-	(substring
-	 (nth 2 (split-string
-		 (buffer-substring (point)(progn (end-of-line) (point)))))
-	 2))))))
-
-(defun pgg-pgp-encrypt-region (start end recipients)
-  "Encrypt the current region between START and END."
-  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
-	 (args
-	  `("+encrypttoself=off +verbose=1" "+batchmode"
-	    "+language=us" "-fate"
-	    ,@(if recipients
-		  (mapcar (lambda (rcpt) (concat "\"" rcpt "\""))
-			  (append recipients
-				  (if pgg-encrypt-for-me
-				      (list pgg-pgp-user-id))))))))
-    (pgg-pgp-process-region start end nil pgg-pgp-program args)
-    (pgg-process-when-success nil)))
-
-(defun pgg-pgp-decrypt-region (start end)
-  "Decrypt the current region between START and END."
-  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
-	 (key (pgg-pgp-lookup-key pgg-pgp-user-id 'encrypt))
-	 (passphrase
-	  (pgg-read-passphrase
-	   (format "PGP passphrase for %s: " pgg-pgp-user-id) key))
-	 (args
-	  '("+verbose=1" "+batchmode" "+language=us" "-f")))
-    (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
-    (pgg-process-when-success
-      (if pgg-cache-passphrase
-	  (pgg-add-passphrase-cache key passphrase)))))
-
-(defun pgg-pgp-sign-region (start end &optional clearsign)
-  "Make detached signature from text between START and END."
-  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
-	 (passphrase
-	  (pgg-read-passphrase
-	   (format "PGP passphrase for %s: " pgg-pgp-user-id)
-	   (pgg-pgp-lookup-key pgg-pgp-user-id 'sign)))
-	 (args
-	  (list (if clearsign "-fast" "-fbast")
-		"+verbose=1" "+language=us" "+batchmode"
-		"-u" pgg-pgp-user-id)))
-    (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
-    (pgg-process-when-success
-      (goto-char (point-min))
-      (when (re-search-forward "^-+BEGIN PGP" nil t);XXX
-	(let ((packet
-	       (cdr (assq 2 (pgg-parse-armor-region
-			     (progn (beginning-of-line 2)
-				    (point))
-			     (point-max))))))
-	  (if pgg-cache-passphrase
-	      (pgg-add-passphrase-cache
-	       (cdr (assq 'key-identifier packet))
-	       passphrase)))))))
-
-(defun pgg-pgp-verify-region (start end &optional signature)
-  "Verify region between START and END as the detached signature SIGNATURE."
-  (let* ((orig-file (pgg-make-temp-file "pgg"))
-	 (args '("+verbose=1" "+batchmode" "+language=us"))
-	 (orig-mode (default-file-modes)))
-    (unwind-protect
-	(progn
-	  (set-default-file-modes 448)
-	  (let ((coding-system-for-write 'binary)
-		jka-compr-compression-info-list jam-zcat-filename-list)
-	    (write-region start end orig-file)))
-      (set-default-file-modes orig-mode))
-    (if (stringp signature)
-	(progn
-	  (copy-file signature (setq signature (concat orig-file ".asc")))
-	  (setq args (append args (list signature orig-file))))
-      (setq args (append args (list orig-file))))
-    (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
-    (delete-file orig-file)
-    (if signature (delete-file signature))
-    (pgg-process-when-success
-      (goto-char (point-min))
-      (let ((case-fold-search t))
-	(while (re-search-forward "^warning: " nil t)
-	  (delete-region (match-beginning 0)
-			 (progn (beginning-of-line 2) (point)))))
-      (goto-char (point-min))
-      (when (re-search-forward "^\\.$" nil t)
-	(delete-region (point-min)
-		       (progn (beginning-of-line 2)
-			      (point)))))))
-
-(defun pgg-pgp-insert-key ()
-  "Insert public key at point."
-  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
-	 (args
-	  (list "+verbose=1" "+batchmode" "+language=us" "-kxaf"
-		(concat "\"" pgg-pgp-user-id "\""))))
-    (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
-    (insert-buffer-substring pgg-output-buffer)))
-
-(defun pgg-pgp-snarf-keys-region (start end)
-  "Add all public keys in region between START and END to the keyring."
-  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
-	 (key-file (pgg-make-temp-file "pgg"))
-	 (args
-	  (list "+verbose=1" "+batchmode" "+language=us" "-kaf"
-		key-file)))
-    (let ((coding-system-for-write 'raw-text-dos))
-      (write-region start end key-file))
-    (pgg-pgp-process-region start end nil pgg-pgp-program args)
-    (delete-file key-file)
-    (pgg-process-when-success nil)))
-
-(provide 'pgg-pgp)
-
-;;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c
-;;; pgg-pgp.el ends here
diff --git a/xemacs-packages/lisp/pgg/pgg-pgp5.el b/xemacs-packages/lisp/pgg/pgg-pgp5.el
deleted file mode 100644
index ffe467ec..00000000
--- a/xemacs-packages/lisp/pgg/pgg-pgp5.el
+++ /dev/null
@@ -1,250 +0,0 @@
-;;; pgg-pgp5.el --- PGP 5.* support for PGG.
-
-;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno 
-;; Created: 1999/11/02
-;; Keywords: PGP, OpenPGP
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl)				; for pgg macros
-  (require 'pgg))
-
-(defgroup pgg-pgp5 ()
-  "PGP 5.* interface."
-  :group 'pgg)
-
-(defcustom pgg-pgp5-pgpe-program "pgpe"
-  "PGP 5.* 'pgpe' executable."
-  :group 'pgg-pgp5
-  :type 'string)
-
-(defcustom pgg-pgp5-pgps-program "pgps"
-  "PGP 5.* 'pgps' executable."
-  :group 'pgg-pgp5
-  :type 'string)
-
-(defcustom pgg-pgp5-pgpk-program "pgpk"
-  "PGP 5.* 'pgpk' executable."
-  :group 'pgg-pgp5
-  :type 'string)
-
-(defcustom pgg-pgp5-pgpv-program "pgpv"
-  "PGP 5.* 'pgpv' executable."
-  :group 'pgg-pgp5
-  :type 'string)
-
-(defcustom pgg-pgp5-shell-file-name "/bin/sh"
-  "File name to load inferior shells from.
-Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
-  :group 'pgg-pgp5
-  :type 'string)
-
-(defcustom pgg-pgp5-shell-command-switch "-c"
-  "Switch used to have the shell execute its command line argument."
-  :group 'pgg-pgp5
-  :type 'string)
-
-(defcustom pgg-pgp5-extra-args nil
-  "Extra arguments for every PGP 5.* invocation."
-  :group 'pgg-pgp5
-  :type '(choice
-	  (const :tag "None" nil)
-	  (string :tag "Arguments")))
-
-(defvar pgg-pgp5-user-id nil
-  "PGP 5.* ID of your default identity.")
-
-(defun pgg-pgp5-process-region (start end passphrase program args)
-  (let* ((errors-file-name (pgg-make-temp-file "pgg-errors"))
-	 (args
-	  (append args
-		  pgg-pgp5-extra-args
-		  (list (concat "2>" errors-file-name))))
-	 (shell-file-name pgg-pgp5-shell-file-name)
-	 (shell-command-switch pgg-pgp5-shell-command-switch)
-	 (process-environment process-environment)
-	 (output-buffer pgg-output-buffer)
-	 (errors-buffer pgg-errors-buffer)
-	 (process-connection-type nil)
-	 process status exit-status)
-    (with-current-buffer (get-buffer-create output-buffer)
-      (buffer-disable-undo)
-      (erase-buffer))
-    (when passphrase
-      (setenv "PGPPASSFD" "0"))
-    (unwind-protect
-	(progn
-	  (let ((coding-system-for-read 'binary)
-		(coding-system-for-write 'binary))
-	    (setq process
-		  (apply #'funcall
-			 #'start-process-shell-command "*PGP*" output-buffer
-			 program args)))
-	  (set-process-sentinel process #'ignore)
-	  (when passphrase
-	    (process-send-string process (concat passphrase "\n")))
-	  (process-send-region process start end)
-	  (process-send-eof process)
-	  (while (eq 'run (process-status process))
-	    (accept-process-output process 5))
-	  (setq status (process-status process)
-		exit-status (process-exit-status process))
-	  (delete-process process)
-	  (with-current-buffer output-buffer
-	    (pgg-convert-lbt-region (point-min)(point-max) 'LF)
-
-	    (if (memq status '(stop signal))
-		(error "%s exited abnormally: '%s'" program exit-status))
-	    (if (= 127 exit-status)
-		(error "%s could not be found" program))
-
-	    (set-buffer (get-buffer-create errors-buffer))
-	    (buffer-disable-undo)
-	    (erase-buffer)
-	    (insert-file-contents errors-file-name)))
-      (if (and process (eq 'run (process-status process)))
-	  (interrupt-process process))
-      (condition-case nil
-	  (delete-file errors-file-name)
-	(file-error nil)))))
-
-(defun pgg-pgp5-lookup-key (string &optional type)
-  "Search keys associated with STRING."
-  (let ((args (list "+language=en" "-l" string)))
-    (with-current-buffer (get-buffer-create pgg-output-buffer)
-      (buffer-disable-undo)
-      (erase-buffer)
-      (apply #'call-process pgg-pgp5-pgpk-program nil t nil args)
-      (goto-char (point-min))
-      (when (re-search-forward "^sec" nil t)
-	(substring
-	 (nth 2 (split-string
-		 (buffer-substring (match-end 0)(progn (end-of-line)(point)))))
-	 2)))))
-
-(defun pgg-pgp5-encrypt-region (start end recipients &optional sign)
-  "Encrypt the current region between START and END."
-  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
-	 (args
-	  `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
-	    ,@(if recipients
-		  (apply #'append
-			 (mapcar (lambda (rcpt)
-				   (list "-r"
-					 (concat "\"" rcpt "\"")))
-				 (append recipients
-					 (if pgg-encrypt-for-me
-					     (list pgg-pgp5-user-id)))))))))
-    (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args)
-    (pgg-process-when-success nil)))
-
-(defun pgg-pgp5-decrypt-region (start end)
-  "Decrypt the current region between START and END."
-  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
-	 (passphrase
-	  (pgg-read-passphrase
-	   (format "PGP passphrase for %s: " pgg-pgp5-user-id)
-	   (pgg-pgp5-lookup-key pgg-pgp5-user-id 'encrypt)))
-	 (args
-	  '("+verbose=1" "+batchmode=1" "+language=us" "-f")))
-    (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args)
-    (pgg-process-when-success nil)))
-
-(defun pgg-pgp5-sign-region (start end &optional clearsign)
-  "Make detached signature from text between START and END."
-  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
-	 (passphrase
-	  (pgg-read-passphrase
-	   (format "PGP passphrase for %s: " pgg-pgp5-user-id)
-	   (pgg-pgp5-lookup-key pgg-pgp5-user-id 'sign)))
-	 (args
-	  (list (if clearsign "-fat" "-fbat")
-		"+verbose=1" "+language=us" "+batchmode=1"
-		"-u" pgg-pgp5-user-id)))
-    (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgps-program args)
-    (pgg-process-when-success
-      (when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX
-	(let ((packet
-	       (cdr (assq 2 (pgg-parse-armor-region
-			     (progn (beginning-of-line 2)
-				    (point))
-			     (point-max))))))
-	  (if pgg-cache-passphrase
-	      (pgg-add-passphrase-cache
-	       (cdr (assq 'key-identifier packet))
-	       passphrase)))))))
-
-(defun pgg-pgp5-verify-region (start end &optional signature)
-  "Verify region between START and END as the detached signature SIGNATURE."
-  (let ((orig-file (pgg-make-temp-file "pgg"))
-	(args '("+verbose=1" "+batchmode=1" "+language=us"))
-	(orig-mode (default-file-modes)))
-    (unwind-protect
-	(progn
-	  (set-default-file-modes 448)
-	  (let ((coding-system-for-write 'binary)
-		jka-compr-compression-info-list jam-zcat-filename-list)
-	    (write-region start end orig-file)))
-      (set-default-file-modes orig-mode))
-    (when (stringp signature)
-      (copy-file signature (setq signature (concat orig-file ".asc")))
-      (setq args (append args (list signature))))
-    (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpv-program args)
-    (delete-file orig-file)
-    (if signature (delete-file signature))
-    (with-current-buffer pgg-errors-buffer
-      (goto-char (point-min))
-      (if (re-search-forward "^Good signature" nil t)
-	  (progn
-	    (set-buffer pgg-output-buffer)
-	    (insert-buffer-substring pgg-errors-buffer)
-	    t)
-	nil))))
-
-(defun pgg-pgp5-insert-key ()
-  "Insert public key at point."
-  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
-	 (args
-	  (list "+verbose=1" "+batchmode=1" "+language=us" "-x"
-		(concat "\"" pgg-pgp5-user-id "\""))))
-    (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpk-program args)
-    (insert-buffer-substring pgg-output-buffer)))
-
-(defun pgg-pgp5-snarf-keys-region (start end)
-  "Add all public keys in region between START and END to the keyring."
-  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
-	 (key-file (pgg-make-temp-file "pgg"))
-	 (args
-	  (list "+verbose=1" "+batchmode=1" "+language=us" "-a"
-		key-file)))
-    (let ((coding-system-for-write 'raw-text-dos))
-      (write-region start end key-file))
-    (pgg-pgp5-process-region start end nil pgg-pgp5-pgpk-program args)
-    (delete-file key-file)
-    (pgg-process-when-success nil)))
-
-(provide 'pgg-pgp5)
-
-;;; arch-tag: 3dbd1073-6b3a-466c-9f55-5c587ffa6d7b
-;;; pgg-pgp5.el ends here
diff --git a/xemacs-packages/lisp/pgg/pgg.el b/xemacs-packages/lisp/pgg/pgg.el
deleted file mode 100644
index c9287ab8..00000000
--- a/xemacs-packages/lisp/pgg/pgg.el
+++ /dev/null
@@ -1,371 +0,0 @@
-;;; pgg.el --- glue for the various PGP implementations.
-
-;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno 
-;; Created: 1999/10/28
-;; Keywords: PGP
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'pgg-def)
-(require 'pgg-parse)
-(require 'password)
-
-;; Don't merge these two `eval-when-compile's.
-(eval-when-compile
-  (require 'cl))
-
-;;; @ utility functions
-;;;
-
-(defun pgg-invoke (func scheme &rest args)
-  (progn
-    (require (intern (format "pgg-%s" scheme)))
-    (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
-
-(put 'pgg-save-coding-system 'lisp-indent-function 2)
-
-(defmacro pgg-save-coding-system (start end &rest body)
-  `(if (interactive-p)
-       (let ((buffer (current-buffer)))
-	 (with-temp-buffer
-	   (let (buffer-undo-list)
-	     (insert-buffer-substring buffer ,start ,end)
-	     (encode-coding-region (point-min)(point-max)
-				   buffer-file-coding-system)
-	     (prog1 (save-excursion ,@body)
-	       (push nil buffer-undo-list)
-	       (ignore-errors (undo))))))
-     (save-restriction
-       (narrow-to-region ,start ,end)
-       ,@body)))
-
-(defun pgg-temp-buffer-show-function (buffer)
-  (let ((window (or (get-buffer-window buffer 'visible)
-		    (split-window-vertically))))
-    (set-window-buffer window buffer)
-    (shrink-window-if-larger-than-buffer window)))
-
-(defun pgg-display-output-buffer (start end status)
-  (if status
-      (progn
-	(delete-region start end)
-	(insert-buffer-substring pgg-output-buffer)
-	(decode-coding-region start (point) buffer-file-coding-system))
-    (let ((temp-buffer-show-function
-	   (function pgg-temp-buffer-show-function)))
-      (with-output-to-temp-buffer pgg-echo-buffer
-	(set-buffer standard-output)
-	(insert-buffer-substring pgg-errors-buffer)))))
-
-(defun pgg-read-passphrase (prompt &optional key)
-  (when pgg-cache-passphrase
-    (password-read prompt (setq key (pgg-truncate-key-identifier key)))))
-
-(defun pgg-add-passphrase-cache (key passphrase)
-  (let ((password-cache-expiry pgg-passphrase-cache-expiry))
-    (password-cache-add (setq key (pgg-truncate-key-identifier key))
-			passphrase)))
-
-(defun pgg-remove-passphrase-cache (key)
-  (password-cache-remove key))
-
-(defmacro pgg-convert-lbt-region (start end lbt)
-  `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
-     (goto-char ,start)
-     (case ,lbt
-       (CRLF
-	(while (progn
-		 (end-of-line)
-		 (> (marker-position pgg-conversion-end) (point)))
-	  (insert "\r")
-	  (forward-line 1)))
-       (LF
-	(while (re-search-forward "\r$" pgg-conversion-end t)
-	  (replace-match ""))))))
-
-(put 'pgg-as-lbt 'lisp-indent-function 3)
-
-(defmacro pgg-as-lbt (start end lbt &rest body)
-  `(let ((inhibit-read-only t)
-	 buffer-read-only
-	 buffer-undo-list)
-     (pgg-convert-lbt-region ,start ,end ,lbt)
-     (let ((,end (point)))
-       ,@body)
-     (push nil buffer-undo-list)
-     (ignore-errors (undo))))
-
-(put 'pgg-process-when-success 'lisp-indent-function 0)
-
-(defmacro pgg-process-when-success (&rest body)
-  `(with-current-buffer pgg-output-buffer
-     (if (zerop (buffer-size)) nil ,@body t)))
-
-(defalias 'pgg-make-temp-file
-  (if (fboundp 'make-temp-file)
-      'make-temp-file
-    (lambda (prefix &optional dir-flag)
-      (let ((file (expand-file-name
-		   (make-temp-name prefix)
-		   (if (fboundp 'temp-directory)
-		       (temp-directory)
-		     temporary-file-directory))))
-	(if dir-flag
-	    (make-directory file))
-	file))))
-
-;;; @ interface functions
-;;;
-
-;;;###autoload
-(defun pgg-encrypt-region (start end rcpts &optional sign)
-  "Encrypt the current region between START and END for RCPTS.
-If optional argument SIGN is non-nil, do a combined sign and encrypt."
-  (interactive
-   (list (region-beginning)(region-end)
-	 (split-string (read-string "Recipients: ") "[ \t,]+")))
-  (let ((status
-	 (pgg-save-coding-system start end
-	   (pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme)
-		       (point-min) (point-max) rcpts sign))))
-    (when (interactive-p)
-      (pgg-display-output-buffer start end status))
-    status))
-
-;;;###autoload
-(defun pgg-encrypt (rcpts &optional sign start end)
-  "Encrypt the current buffer for RCPTS.
-If optional argument SIGN is non-nil, do a combined sign and encrypt.
-If optional arguments START and END are specified, only encrypt within
-the region."
-  (interactive (list (split-string (read-string "Recipients: ") "[ \t,]+")))
-  (let* ((start (or start (point-min)))
-	 (end (or end (point-max)))
-	 (status (pgg-encrypt-region start end rcpts sign)))
-    (when (interactive-p)
-      (pgg-display-output-buffer start end status))
-    status))
-
-;;;###autoload
-(defun pgg-decrypt-region (start end)
-  "Decrypt the current region between START and END."
-  (interactive "r")
-  (let* ((buf (current-buffer))
-	 (status
-	  (pgg-save-coding-system start end
-	    (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme)
-			(point-min) (point-max)))))
-    (when (interactive-p)
-      (pgg-display-output-buffer start end status))
-    status))
-
-;;;###autoload
-(defun pgg-decrypt (&optional start end)
-  "Decrypt the current buffer.
-If optional arguments START and END are specified, only decrypt within
-the region."
-  (interactive "")
-  (let* ((start (or start (point-min)))
-	 (end (or end (point-max)))
-	 (status (pgg-decrypt-region start end)))
-    (when (interactive-p)
-      (pgg-display-output-buffer start end status))
-    status))
-
-;;;###autoload
-(defun pgg-sign-region (start end &optional cleartext)
-  "Make the signature from text between START and END.
-If the optional 3rd argument CLEARTEXT is non-nil, it does not create
-a detached signature.
-If this function is called interactively, CLEARTEXT is enabled
-and the the output is displayed."
-  (interactive "r")
-  (let ((status (pgg-save-coding-system start end
-		  (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)
-			      (point-min) (point-max)
-			      (or (interactive-p) cleartext)))))
-    (when (interactive-p)
-      (pgg-display-output-buffer start end status))
-    status))
-
-;;;###autoload
-(defun pgg-sign (&optional cleartext start end)
-  "Sign the current buffer.
-If the optional argument CLEARTEXT is non-nil, it does not create a
-detached signature.
-If optional arguments START and END are specified, only sign data
-within the region.
-If this function is called interactively, CLEARTEXT is enabled
-and the the output is displayed."
-  (interactive "")
-  (let* ((start (or start (point-min)))
-	 (end (or end (point-max)))
-	 (status (pgg-sign-region start end (or (interactive-p) cleartext))))
-    (when (interactive-p)
-      (pgg-display-output-buffer start end status))
-    status))
-  
-;;;###autoload
-(defun pgg-verify-region (start end &optional signature fetch)
-  "Verify the current region between START and END.
-If the optional 3rd argument SIGNATURE is non-nil, it is treated as
-the detached signature of the current region.
-
-If the optional 4th argument FETCH is non-nil, we attempt to fetch the
-signer's public key from `pgg-default-keyserver-address'."
-  (interactive "r")
-  (let* ((packet
-	  (if (null signature) nil
-	    (with-temp-buffer
-	      (buffer-disable-undo)
-	      (if (fboundp 'set-buffer-multibyte)
-		  (set-buffer-multibyte nil))
-	      (insert-file-contents signature)
-	      (cdr (assq 2 (pgg-decode-armor-region
-			    (point-min)(point-max)))))))
-	 (key (cdr (assq 'key-identifier packet)))
-	 status keyserver)
-    (and (stringp key)
-	 pgg-query-keyserver
-	 (setq key (concat "0x" (pgg-truncate-key-identifier key)))
-	 (null (pgg-lookup-key key))
-	 (or fetch (interactive-p))
-	 (y-or-n-p (format "Key %s not found; attempt to fetch? " key))
-	 (setq keyserver
-	       (or (cdr (assq 'preferred-key-server packet))
-		   pgg-default-keyserver-address))
-	 (pgg-fetch-key keyserver key))
-    (setq status 
-	  (pgg-save-coding-system start end
-	    (pgg-invoke "verify-region" (or pgg-scheme pgg-default-scheme)
-			(point-min) (point-max) signature)))
-    (when (interactive-p)
-      (let ((temp-buffer-show-function
-	     (function pgg-temp-buffer-show-function)))
-	(with-output-to-temp-buffer pgg-echo-buffer
-	  (set-buffer standard-output)
-	  (insert-buffer-substring (if status pgg-output-buffer
-				     pgg-errors-buffer)))))
-    status))
-
-;;;###autoload
-(defun pgg-verify (&optional signature fetch start end)
-  "Verify the current buffer.
-If the optional argument SIGNATURE is non-nil, it is treated as
-the detached signature of the current region.
-If the optional argument FETCH is non-nil, we attempt to fetch the
-signer's public key from `pgg-default-keyserver-address'.
-If optional arguments START and END are specified, only verify data
-within the region."
-  (interactive "")
-  (let* ((start (or start (point-min)))
-	 (end (or end (point-max)))
-	 (status (pgg-verify-region start end signature fetch)))
-    (when (interactive-p)
-      (let ((temp-buffer-show-function
-	     (function pgg-temp-buffer-show-function)))
-	(with-output-to-temp-buffer pgg-echo-buffer
-	  (set-buffer standard-output)
-	  (insert-buffer-substring (if status pgg-output-buffer
-				     pgg-errors-buffer)))))
-    status))
-
-;;;###autoload
-(defun pgg-insert-key ()
-  "Insert the ASCII armored public key."
-  (interactive)
-  (pgg-invoke "insert-key" (or pgg-scheme pgg-default-scheme)))
-
-;;;###autoload
-(defun pgg-snarf-keys-region (start end)
-  "Import public keys in the current region between START and END."
-  (interactive "r")
-  (pgg-save-coding-system start end
-    (pgg-invoke "snarf-keys-region" (or pgg-scheme pgg-default-scheme)
-		start end)))
-
-;;;###autoload
-(defun pgg-snarf-keys ()
-  "Import public keys in the current buffer."
-  (interactive "")
-  (pgg-snarf-keys-region (point-min) (point-max)))
-
-(defun pgg-lookup-key (string &optional type)
-  (pgg-invoke "lookup-key" (or pgg-scheme pgg-default-scheme) string type))
-
-(defvar pgg-insert-url-function  (function pgg-insert-url-with-w3))
-
-(defun pgg-insert-url-with-w3 (url)
-  (ignore-errors
-    (require 'url)
-    (let (buffer-file-name)
-      (url-insert-file-contents url))))
-
-(defvar pgg-insert-url-extra-arguments nil)
-(defvar pgg-insert-url-program nil)
-
-(defun pgg-insert-url-with-program (url)
-  (let ((args (copy-sequence pgg-insert-url-extra-arguments))
-	process)
-    (insert
-     (with-temp-buffer
-       (setq process
-	     (apply #'start-process " *PGG url*" (current-buffer)
-		    pgg-insert-url-program (nconc args (list url))))
-       (set-process-sentinel process #'ignore)
-       (while (eq 'run (process-status process))
-	 (accept-process-output process 5))
-       (delete-process process)
-       (if (and process (eq 'run (process-status process)))
-	   (interrupt-process process))
-       (buffer-string)))))
-
-(defun pgg-fetch-key (keyserver key)
-  "Attempt to fetch a KEY from KEYSERVER for addition to PGP or GnuPG keyring."
-  (with-current-buffer (get-buffer-create pgg-output-buffer)
-    (buffer-disable-undo)
-    (erase-buffer)
-    (let ((proto (if (string-match "^[a-zA-Z\\+\\.\\\\-]+:" keyserver)
-		     (substring keyserver 0 (1- (match-end 0))))))
-      (save-excursion
-	(funcall pgg-insert-url-function
-		 (if proto keyserver
-		   (format "http://%s:11371/pks/lookup?op=get&search=%s"
-			   keyserver key))))
-      (when (re-search-forward "^-+BEGIN" nil 'last)
-	(delete-region (point-min) (match-beginning 0))
-	(when (re-search-forward "^-+END" nil t)
-	  (delete-region (progn (end-of-line) (point))
-			 (point-max)))
-	(insert "\n")
-	(with-temp-buffer
-	  (insert-buffer-substring pgg-output-buffer)
-	  (pgg-snarf-keys-region (point-min)(point-max)))))))
-
-
-(provide 'pgg)
-
-;;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4
-;;; pgg.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/ChangeLog b/xemacs-packages/lisp/prog-modes/ChangeLog
deleted file mode 100644
index 6a789b2d..00000000
--- a/xemacs-packages/lisp/prog-modes/ChangeLog
+++ /dev/null
@@ -1,1560 +0,0 @@
-2006-05-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.07 released.
-
-2006-05-06  Ville Skyttä  
-
-	* javascript-mode.el: Improve regexps for finding prototype and
-	property style function declarations (thanks to Tsirkin Evgeny),
-	miscellaneous other cleanups.
-
-2005-12-05  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.06 released.
-
-2005-12-01  Ville Skyttä  
-
-	* diff-mode.el: Sync hunk and file recognition improvements and
-	some trivial bits from GNU Emacs CVS.
-	(diff-removed-face): Don't use :inherit (not in 21.4).
-	(diff-added-face): Ditto.
-	(diff-function-face): Ditto.
-	(diff-nonexistent-face): Ditto.
-
-2005-07-10  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.05 released.
-
-2005-07-08  Ville Skyttä  
-
-	* rpm-spec-mode.el (rpm-spec-build-command): Sync with upstream.
-	(rpm-section-regexp): Sync with rpm 4.4.1.
-	(rpm-tags-list): Ditto.
-	(rpm-spec-field-value): Improve macro expansion.
-
-	* rpm-spec-mode.el.upstream: Sync with upstream.
-
-2005-05-20  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.04 released.
-
-2005-05-20  Malcolm Purvis  
-
-	* sql.el (sql-mode-abbrev-table): Fix error generating the abbrev
-	table.
-
-2005-04-19  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.03 released.
-
-2005-04-18  Malcolm Purvis  
-
-	* sql.el: Sync with upstream 2.0.1.
-
-2005-02-03  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.02 released.
-
-	* verilog-mode.el: Sync with upstream 4.2.
-
-2004-08-17  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.01 released.
-
-2004-08-16  Stephen J. Turnbull  
-
-	* lua-mode.el (lua): Fix typo in defgroup docstring.
-
-2004-08-16  Ville Skyttä  
-
-	* diff-mode.el (diff-minor-mode): Autoload a dummy autoload
-	instead of define-minor-mode.
-
-	* lua-mode.el: Make auto-mode-alist modifications autoload-only.
-
-2004-08-15  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.00 released.
-
-2004-08-15  Ville Skyttä  
-
-	* lua-mode.el: New.
-	* lua-mode.el.upstream: New.
-
-	* package-info.in (provides): Add lua-mode.
-
-	* Makefile (ELCS): Add lua-mode.elc.
-
-	* prog-modes.texi: Add title (for HTML).
-	(lua-mode): New.
-
-	* diff-mode.el: Sync with GNU Emacs 21.3 (mostly).
-
-	* cvs.el (cvs-no-log-option): Default to nil.  `-l' is
-	available only in CVS versions from 1.11 to 1.11.6.  Thanks
-	to Jens Petersen .
-
-2004-08-13  Ville Skyttä  
-
-	* prog-modes.texi: Spelling fixes.
-
-2004-07-29  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.99 released.
-
-2004-07-26  Ville Skyttä  
-
-	* javascript-mode.el: GNU Emacs compatibility improvements.
-	(javascript-mode-map):	Default to c-make-inherited-keymap.
-	(javascript-menu): New.
-	Thanks to Igor Rayak.
-
-2004-06-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.98 released.
-
-	* diff-mode.el: Revert last change, it's bogus.  Thanks to Ville
-	Skyttä and Robert Widhopf.
-
-2004-06-06  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.97 released.
-
-2004-05-26  Robert Widhopf  http://www.robf.de
-
-	* diff-mode.el (diff-font-lock-keywords-1): There is only one
-	level of decoration, so make it level 1.
-	(diff-font-lock-keywords): This shoud be a list referring to the
-	actual variables for the levels.   
-
-2004-03-29  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.96 released.
-
-2004-03-02  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.95 released.
-
-2004-02-17  Jerry James  
-
-	* diff-mode.el: Test for combine-after-change-calls function, not
-	value, and use the ,@ notation.
-
-2004-01-27  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.94 released.
-
-2004-01-26  Jerry James  
-
-	* teco.el (teco-read-command): Fix parenthesizing error.
-
-2004-01-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.93 released.
-
-2004-01-25  Ville Skyttä  
-
-	* php-mode.el: Sync with upstream 1.1.0.
-
-	* prog-modes.texi: Typo/spelling fixes.
-
-2003-12-09  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.92 released.
-
-2003-12-08  Ville Skyttä  
-
-	* php-mode.el (php-mode): Make autoload hack autoload-only,
-	add interactive flag.
-
-2003-10-29  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.91 released.
-
-2003-10-19  Ville Skyttä  
-
-	* verilog-mode.el: Remove regexp-opt workarounds, defalias
-	verilog-regexp-opt to regexp-opt instead.
-
-	* php-mode.el (php-font-lock-keywords-3): Remove obsolete
-	regexp-opt comment.
-
-2003-10-16  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.90 released.
-
-2003-10-15  Peter Osterlund  
-
-	* p4.el: Sync with upstream version.
-
-2003-09-30  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.89 released.
-
-2003-09-30  Ville Skyttä  
-
-	* php-mode.el (php-font-lock-keywords-3): Use explicit grouping
-	with php-superglobals due to differences between our and GNU
-	regexp-opt implementations.
-
-2003-09-29  Ville Skyttä  
-
-	* php-mode.el: Sync with upstream 1.0.5, unbreak imenu
-	regexps while at it.
-
-2003-09-25  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.88 released.
-
-2003-09-24  Jake Colman  
-
-	* prog-modes.texi:  Major bulking up of the info content.
-
-2003-09-22  Steve Youngs  
-
-	* Makefile (EXPLICIT_DOCS): Removed.
-	(STANDARD_DOCS): Use this instead.
-
-2003-09-21  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.87 released.
-
-2003-09-19  Jake Colman  
-
-	* Makefile (EXPLICIT_DOCS): New.
-
-2003-09-03  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.86 released.
-
-2003-09-02  Ville Skyttä  
-
-	* rpm-spec-mode.el (rpm-spec-intitialize): Integer concatenation
-	fix for default-epoch != nil, avoid extra newline at the end.
-	Thanks to Enrico Scholz.
-
-2003-08-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.85 released.
-
-	* package-info.in: provide uil-mode.
-
-2003-08-31  Ville Skyttä  
-
-	* uil-mode.el: Add auto-mode-alist autoload cookie for *.uil.
-
-2003-08-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.84 released.
-
-2003-08-29  Jake Colman  
-
-	* Makefile (ELCS): added uil-mode
-
-2003-08-19  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.83 released.
-
-2003-08-18  Ville Skyttä  
-
-	* rpm-spec-mode.el: Add %check section (rpm >= 4.1.1).
-	Fix/sync XEmacs/GNU -style face docstrings.
-	Add support for highlighting specfile section markers.
-
-2003-08-05  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.82 released.
-
-2003-08-03  Ville Skyttä  
-
-	* rpm-spec-mode.el (rpm-build): Set EMACS=t in environment
-	to emulate `compilation-mode'.
-	(rpm-spec-faces): Add "rpm-spec-" prefix.
-
-2003-06-27  Damien Nadé  
-
-	* rpm-spec-mode.el (rpm-spec-field-value): Fix macro expansion.
-
-2003-07-21  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.81 released.
-
-2003-07-21  Stephen J. Turnbull  
-
-	* package-info.in (provides): Add 'make-mode.
-
-2003-07-21  Stephen J. Turnbull  
-
-	* make-mode.el (make-mode): Library should `provide' own name.
-
-2003-07-02  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.80 released.
-
-2003-06-27  Damien Nadé  
-
-	* rpm-spec-mode.el: New customization options.
-	(rpm-spec-default-release): New.
-	(rpm-spec-default-epoch): New.
-	(rpm-spec-default-build-section): New.
-	(rpm-spec-default-install-section): New.
-	(rpm-spec-default-clean-section): New.
-	(rpm-spec-default-buildroot): New.
-	(rpm-spec-mode-new-file-hook): New.
-
-2003-06-27  Ville Skyttä  
-
-	* rpm-spec-mode.el (rpm-spec-font-lock-keywords):
-	Allow underscores in tags (eg. for Summary(en_US)).
-	(auto-mode-alist): Use rpm-spec-mode for *.spec.in too.
-
-2003-06-20  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.79 released.
-
-2003-05-30  Ville Skyttä  
-
-	* php-mode.el: Sync with upstream 1.0.4.
-
-2003-06-11  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.78 released.
-
-2003-06-10  Vasily Korytov  
-
-	* javascript-mode.el: Add an auto-mode-alist entry and a
-	(speedbar-add-supported-extension) call for the *.pac files.
-	
-2003-06-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.77 released.
-
-2003-06-07  Adrian Aichner  
-
-	* asm-mode.el: Add auto-mode-alist autoload cookie for .asm files.
-
-2003-06-06  Adrian Aichner  
-
-	* m4-mode.el: auto-mode-alist cookie update.
-	* verilog-mode.el: Ditto.
-
-2003-06-01  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.76 released.
-
-2003-06-01  Adrian Aichner  
-
-	* mode-compile.el: Many typo fixes, some inspired by Norbert Koch.
-	* mode-compile.el (mode-compile-choosen-compiler): Removed.
-	Retaining compatibility via `define-obsolete-variable-alias'.
-	* mode-compile.el (mode-compile-chosen-compiler): New.  Suggested
-	by Robert Delius Royar.
-
-2003-06-01  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.75 released.
-
-	* Makefile (VERSION): XEmacs package 1.74 released.
-
-2003-06-01  Adrian Aichner  
-
-	* mode-compile.el: Typo fixes and sync with author version 2.28.
-	* mode-compile.el (cl): New require.
-	* mode-compile.el (compilation): Update of "Author's Emacs Page"
-	URL, currently not reachable either.
-	* mode-compile.el (mode-compile-modes-alist): Add cperl-mode.
-	* mode-compile.el (mode-compile-prefered-default-makerule):
-	Removed.  Retaining compatibility via
-	`define-obsolete-variable-alias'.
-	* mode-compile.el (mode-compile-preferred-default-makerule): New.
-	* mode-compile.el (mode-compile-version): Sync.
-	* mode-compile.el (mode-compile-help-address): Ditto.
-	* mode-compile.el (mc--makerule-completion): Typo fix.
-	* mode-compile.el (mode-compile-submit-bug-report): Update for
-	mode-compile-prefered-default-makerule.
-	* mode-compile.el (mode-compile): Add cperl-mode to doc string.
-	* mode-compile.el (mode-compile-kill): Ditto.
-
-2003-04-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.73 released.
-
-2003-03-22  Vasily Korytov  
-
-	* ksh-mode.el (ksh-mode-hook): Add a (defvar ...), so this
-	variable is documented.
-
-2003-03-09  Ben Wing  
-
-	* Makefile (diff-mode.elc):
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-
-2003-01-24  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.72 released.
-
-2002-01-19  Ville Skyttä  
-
-	* rpm-spec-mode.el (rpm-spec-use-compilation-mode): New.
-	(rpm-build): Prompt for saving if buffer modified, build
-	in compilation-mode if it's available and
-	rpm-spec-use-compilation-mode is non-nil.
-
-2003-01-20  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.71 released.
-
-2003-01-19  Ville Skyttä  
-
-	* javascript-mode.el: Add imenu support.
-	* make-mode.el: Make auto-mode-alist regexp less sloppy,
-	associate *.am with makefile-mode.
-
-2003-01-13  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.70 released.
-
-2003-01-06  Ville Skyttä  
-
-	* tcl.el: Make auto-mode and interpreter-mode-alist modifications
-	autoload-only.
-	* vrml-mode.el: Ditto.
-	* sql.el: Ditto.
-	* rpm-spec-mode.el: Ditto.
-	* rexx-mode.el: Ditto.
-	* prolog.el: Ditto.
-	* postscript.el: Ditto.
-	* pascal.el: Ditto.
-	* make-mode.el: Ditto.
-	* javascript-mode.el: Ditto.
-	* icon.el: Ditto.
-	* eiffel.el: Ditto.
-	* diff-mode.el: Ditto.
-	* awk-mode.el: Ditto.
-	* autoconf-mode.el: Ditto.
-	* asm-mode.el: Ditto.
-
-2003-01-03  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.69 released.
-
-2002-11-29  Ben Wing  
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-	(diff-mode.elc): Dependency on easy-mmode due to macros.
-
-2002-12-06  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.68 released.
-
-2002-11-20  Ville Skyttä  
-
-	* rpm-spec-mode.el (rpm-spec-font-lock-keywords): Handle
-	%config(noreplace) and friends.
-	(rpm-spec-initialize): Indent headings to column 16.
-
-2002-10-23  Stig Bjorlykke  
-
-	* rpm-spec-mode.el (rpm-spec-rpm-build-command): Removed.
-	(rpm-spec-nobuild): Replaced rpm-spec-test.
-	(rpm-spec-quiet): New.
-	(rpm-spec-indent-heading-values): New.
-	(rpm-spec-mode-map): Redefined key bindings.
-	(rpm-spec-mode-menu): Added "Quiet".  Changed "Testing only" to
-	"No build".  Renamed rpm-build-* functions.
-	(rpm-spec-mode): Find correct build command.
-	(rpm-build): Added check for quiet.
-	(rpm-update-mode-name): Added quiet.  Renamed test to nobuild.
-	(rpm-spec-initialize): Indent according to "indent-heading-values".
-	(rpm-add-change-log-entry): Add " - " if adding version.
-
-2002-10-20  Ville Skyttä  
-
-	* javascript-mode.el: Update my mail address.
-
-2002-10-15  Ville Skyttä  
-
-	* Makefile (srckit): Remove.
-
-2002-10-07  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.67 released.
-
-2002-10-06  Peter Osterlund  
-
-	* p4.el (p4-diff2): When invoking p4-diff2 interactively, default
-	  to showing the differences between the current rev and rev#
-	  minus one.
-	* p4.el (p4-minor-map): Don't modify the global keymap, use
-	  p4-minor-map instead.
-	* p4.el (p4-require-vc-p, p4-prev-toggle-fkn): Removed.
-	* p4.el (p4-print-with-rev-history-int): Renamed to p4-blame-int.
-	* p4.el (p4-activate-print-buffer, p4-blame-int): Colorize buffer
-	  using font lock mode.
-	* p4.el (p4-font-lock-buffer): New function.
-	* p4.el (p4-blame-int): Display date and author information for
-	  each source line.
-	* p4.el (p4-blame-int): Follow branches when assigning blame.
-	* p4.el (p4-resolve): If you switched directory to a different
-	  depot, p4-resolve didn't work until you manually killed the
-	  *p4 resolve* buffer.
-
-2002-10-04  Ville Skyttä  
-
-	* rpm-spec-mode.el (rpm-spec-rpm-build-command):
-	New custom variable for configuring the rpm build command.
-	(rpm-build): Use `rpm-spec-rpm-build-command'.
-	(rpm-spec-initialize): Minor tweaks to initial spec file.
-
-2002-09-30  Ville Skyttä  
-
-	* awk-mode.el: Add autoloaded auto-mode-alist and
-	interpreter-mode-alist associations.
-	* asm-mode.el: Ditto.
-	* autoconf-mode.el: Ditto.
-	* eiffel.el: Ditto.
-	* icon.el: Ditto.
-	* make-mode.el: Ditto.
-	* pascal.el: Ditto.
-	* postscript.el: Ditto.
-	* prolog.el: Ditto.
-	* rexx-mode.el: Ditto.
-	* tcl.el: Ditto.
-	* vrml-mode.el: Ditto.
-
-2002-09-25  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.66 released.
-
-2002-09-20  Ville Skyttä  
-
-	* Makefile (ELCS): Remove cperl-mode.elc and perl-mode.elc.
-	(REQUIRES): Remove ps-print, was needed by cperl-mode.
-
-	* package-info.in (provides): Remove cperl-mode and perl-mode.
-
-	* cperl-mode.el: Remove, move to perl-modes package.
-	* perl-mode.el: Ditto.
-	
-2002-09-18  Ville Skyttä  
-
-	* Makefile (ELCS): Remove ruby-mode.elc and inf-ruby.elc.
-
-	* package-info.in (provides): Remove inf-ruby and ruby-mode.
-
-	* inf-ruby.el: Remove, move to ruby-modes package.
-	* inf-ruby.el.upstream: Ditto.
-	* ruby-mode.el: Ditto.
-	* ruby-mode.el.upstream: Ditto.
-	
-2002-09-18  Ville Skyttä  
-
-	* Makefile (ELCS): Remove f90.elc, fortran.elc and
-	fortran-misc.elc.
-
-	* package-info.in (provides): Remove f90 and fortran.
-
-	* f90.el: Remove, move to fortran-modes package.
-	* fortran.el: Ditto.
-	* fortran-misc.el: Ditto.
-	
-2002-09-18  Ville Skyttä  
-
-	* Makefile (ELCS): Remove python-mode.elc and pydoc.elc.
-	(EXTRA_SOURCES): Removed.
-	(MAINTAINER): Change to xemacs-beta.
-
-	* package-info.in (provides): Remove python-mode and pydoc.
-
-	* pydoc.el: Removed, moved to python-modes package.
-	* pydoc.el.upstream: Ditto.
-	* pydoc-el-README: Ditto.
-	* pydoc_lisp.py: Ditto.
-	* python-mode.el: Ditto.
-	* python-mode.el.upstream: Ditto.
-
-2002-09-11  Ville Skyttä  
-
-	* javascript-mode.el (javascript-mode): Set menu name to
-	JavaScript (it's not C++), thanks to Geert Ribbers.
-	(javascript): Case tweak for custom group in menus.
-
-2002-08-29  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.65 released.
-
-2002-08-28  Ville Skyttä  
-
-	* javascript-mode.el: Make it work with GNU Emacs too,
-	fontify keywords immediately after '('.  Contributed by
-	Stefan Schlee .
-
-2002-08-26  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.64 released.
-
-2002-08-21  Ville Skyttä  
-
-	* inf-ruby.el: Sync with upstream version 1.3.2.2.
-	See inlined change log for detailed changes.
-	* inf-ruby.el.upstream: Ditto.
-
-2002-08-15  Peter Osterlund  
-
-	* p4.el (p4-prev-toggle-fkn, p4-exec-p4,
-	substitute-key-definition): Do not autoload. Autoloading causes
-	unnecessary overhead for those not using p4.el without really
-	helping those who do use it.
-
-2002-08-02  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.63 released.
-
-2002-08-02  Steve Youngs  
-
-	* p4.el (p4-prev-toggle-fkn): Autoload it.
-
-2002-08-02  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.62 released.
-
-2002-08-01  Peter Osterlund  
-
-	* p4.el: Include all stable features from the sourceforge cvs tree
-	(version 10.1 + some more).
-	* p4.el (p4-help-text): Disable automatic function help text
-	generation because a p4 server may not be accessible during byte
-	compilation.
-
-2002-08-01  Ville Skyttä  
-
-	* php-mode.el (php-mode): Workaround for problem with autoload
-	cookies and define-derived-mode.
-
-2002-07-31  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.61 released.
-
-2002-07-23  Ville Skyttä  
-
-	* rpm-spec-mode.el: Syntax highlighting tweaks.
-	(rpm-spec-mode): Call (rpm-update-mode-name)
-	on startup so modeline starts with correct status.
-
-2002-07-15  Adrian Aichner  
-
-	* ksh-mode.el: It's XEmacs, not Xemacs.
-	* php-mode.el: Ditto.
-	* php-mode.el (php-mode): Ditto.
-	* php-mode.el (php-font-lock-syntactic-keywords): Ditto.
-
-2002-07-14  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.60 released.
-
-2002-07-11  Ville Skyttä  
-
-	* rpm-spec-mode.el: Add --nodeps stuff.
-	(rpm-spec-nodeps): New.
-	(rpm-toggle-nodeps): New.
-	(rpm-spec-mode-map): Add entry for -nodeps.
-	(rpm-spec-mode-menu): Ditto.
-	(rpm-build): Handle -nodeps.
-
-2002-07-06  Ville Skyttä  
-
-	* rpm-spec-mode.el: Docstring fixes, cleanups.
-	(rpm-spec-user-full-name): New.
-	(rpm-spec-user-mail-address): New.
-	(rpm-add-change-log-entry): Use the new customizables.
-	(rpm-insert-packager): Ditto.
-
-2002-06-27  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.59 released.
-
-2002-06-26  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.58 released.
-
-2002-06-23  Ville Skyttä  
-
-	* cperl-mode.el (cperl-fix-line-spacing): Add missing \ in [ t].
-	* cperl-mode.el: Typo and docstring fixes.
-
-	* icon.el (icon-mode):
-	Check for existence of hs-special-modes-alist before using it.
-	* icon.el: checkdoc-fixed.
-
-2002-06-22  Ville Skyttä  
-
-	* make-mode.el: Partial sync with GNU Emacs 21.2.
-	(makefile-mode): Change customization group name to "makefile".
-	(makefile): New name for customization group.
-	(makefile-fill-paragraph): New.
-	(makefile-mode-abbrev-table): New.
-
-2002-06-17  Ville Skyttä  
-
-	* cperl-mode.el (cperl-syntaxify-unwind): Docstring typo fix,
-	thanks to Reuben Thomas.
-
-2002-06-07  Martin Schwenke  
-
-	* eiffel.el:
-	(eif-end-matching-keywords): now insists that "once" is followed by
-	whitespace and that the next character is not a double-quote.  This
-	fixes indentation and eif-end-of-feature bugs.  It also works for
-	SmallEiffel's once manifest strings.
-
-	* eiffel.el:
-	Changed name of file to eiffel.el - fixed various comments and the
-	provide.
-
-	Removed D. Colnet from copyright.  A recent exchange confirmed
-	that I haven't merged any of his changes.
-
-	Clarified eif-short bug is under *GNU* Emacs 19.34.
-
-2002-06-08  Ville Skyttä  
-
-	* ruby-mode.el: Sync with upstream version 1.25.2.10.
-	* ruby-mode.el.upstream: Ditto.
-
-2002-06-08  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.57 released.
-
-2002-06-05  Ville Skyttä  
-
-	* eiffel.el: New version from Martin Schwenke.
-	* eiffel3.el: Remove, obsoleted by Martin's version.
-	* Makefile (ELCS): Add eiffel.elc, remove eiffel3.elc.
-	* package-info.in (provides): Add eiffel-mode, remove eiffel3.
-
-2002-06-03  Steve Youngs  
-
-	* verilog-mode.el (verilog-mode): Add missing ';' in autoload
-	cookie. 
-	(verilog-version): Add autoload cookie.
-	(verilog-customize): Ditto.
-
-2002-05-21  Ville Skyttä  
-
-	* sql-mode.el: Add .sql files to auto-mode-alist.
-
-	* javascript-mode.el (javascript-mode): Fix prototype function
-	indentation, from Sebastian Delmont .
-
-	Sebastian's comments:
-
-	It looks like cc-mode doesn't like JavaScript's prototype
-	function declarations.	This triggers indentation errors in a few
-	cases, since the indentation engine considers the function block
-	as a brace-list	entry, and it won't detect language constructs
-	(i.e. "if", "switch", etc) inside it.  Here's a gnu.emacs.bug
-	thread that discusses the problem, and proposes a solution:
-	http://groups.google.com/groups?hl=en&lr=&th=bae37c6e427b29db&rnum=3
-
-2002-05-14  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.56 released.
-
-2002-05-12  Matt Tucker 
-
-	* cperl-mode.el (cperl-mode): buffer-localize fill-paragraph-function.
-
-2002-05-07  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.55 released.
-
-2002-05-03  Ville Skyttä  
-
-	* diff-mode.el: More syncing with GNU Emacs 21.2.
-	(diff-hunk-next): Created with easy-mmode-define-navigation.
-	(diff-hunk-prev): Ditto.
-	(diff-file-next): Ditto.
-	(diff-file-prev): Ditto.
-
-2002-05-02  Andrew Begel 
-
-	* autoconf-mode.el (autoconf-mode):
-	Use "dnl " instead of "dnl" as comment-start.
-
-2002-04-24  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.54 released.
-
-2002-04-21  Ville Skyttä  
-
-	* pydoc.el.upstream: New file.
-	* python-mode.el.upstream: Ditto.
-
-2002-04-20  David A. Panariti  
-
-	* python-mode.el (py-execute-region): 
-	Add fix to handle condition where py-which-shell is nil.
-
-	* pydoc.el: Handle new versions of python-mode.el in which
-	py-execute-region return t rather than a buffer[name].  The
-	following changes are executed only when py-execute-region 
-	returns	t.
-	(pydoc-call): Guesses the output buffer name to be the current
-	python process buffer or "*Python Output*".
-	(pydoc-initialize): Sets the output buffer to be the name of the
-	current python process buffer.
-
-2002-04-20  Ville Skyttä  
-
-	* rpm-spec-mode.el: Whitespace cleanup.
-	(rpm-spec-initialize): Tweaks to initial spec file.
-
-2002-04-12  Ville Skyttä  
-
-	* rpm-spec-mode.el: Docstring updates.
-	(rpm-tags-list): Bring up to date with RPM 4.1.
-	(rpm-add-change-log-entry): Eliminate no-version argument.
-	(rpm-spec-field-value): Ignore errors when finding the value,
-	avoid returning whitespace.
-	(rpm-find-spec-version): Handle Epoch/Serial, return nil
-	unless Version was found.
-
-2002-04-11  Ville Skyttä  
-
-	* ruby-mode.el: Sync with upstream revision 1.25.2.9.
-	* ruby-mode.el.upstream: Ditto.
-
-2002-04-09  Ville Skyttä  
-
-	* inf-ruby.el.upstream: New file.
-	* ruby-mode.el.upstream: Ditto.
-	* rpm-spec-mode.el.upstream: Ditto.
-
-2002-04-07  James LewisMoss  
-
-	* diff-mode.el (diff-reverse-direction): Check for --- and +++
-	before reversing the ^- or ^+.  Also extract out the regexp into a
-	var for clarity.
-	(diff-reverse-direction): if there is a region use that.  If not
-	do whole buffer.  Change doc string to go along with this and fix
-	typo in doc string.
-
-2002-04-07  Ville Skyttä  
-
-	* rpm-spec-mode.el: New.
-	* Makefile (REQUIRES): Add sh-script, needed by rpm-spec-mode.el.
-	* Makefile (ELCS): Add rpm-spec-mode.elc.
-	* package-info.in (provides): Add rpm-spec-mode.
-	
-	* diff-mode.el.upstream: Removed.
-
-2002-03-30  Jeff Mincy  
-
-	* tcl.el (tcl-mode): recheck for filladapt mode
-	(tcl-mode): refix imenu support
-
-2002-03-28  Ville Skyttä  
-
-	* icon.el: Sync with GNU Emacs 21.2.
-	* tcl.el: Ditto.
-	* diff-mode.el: Ditto, mostly.
-	* package-info.in (provides): Add icon.
-
-2002-03-25  Steve Youngs  
-
-	* Makefile (VERSION): 1.53 released.
-
-2002-03-24  Ville Skyttä  
-
-	* f90.el: Sync with GNU Emacs 21.2.
-	* awk-mode.el: Update sync status.
-	* modula2.el: Ditto.
-
-2002-03-20  Ville Skyttä  
-
-	* javascript-mode.el: Update to version 1.4.
-	Add inferior mode for a JavaScript shell, speedbar integration,
-	customization groups and variables.  Update copyright notice.
-	(javascript-font-lock-keywords): Treat "const" like "var".
-	(javascript-mode-hook): New.
-	(javascript-shell): New.
-	(javascript-shell-command): New.
-	(javascript-shell-command-args): New.
-	(javascript-shell-mode): New.
-	(javascript-shell-mode-hook): New.
-	(javascript-shell-prompt-pattern): New.
-
-2002-03-17  Ville Skyttä  
-
-	* tcl.el: Mostly sync with GNU Emacs 21.1.
-
-2002-03-15  Ville Skyttä  
-
-	* javascript-mode.el: Update to version 1.3.
-	Added javascript-mode-abbrev-table, use regexp-opt, doc updates.
-
-2002-03-14  Ville Skyttä  
-
-	* awk-mode.el: Mostly sync with GNU Emacs 21.1.
-
-2002-03-04  Ville Skyttä  
-
-	* f90.el: Sync with GNU Emacs 21.1.
-
-2002-02-28  Ville Skyttä  
-
-	* ruby-mode.el: New file.
-
-	* inf-ruby.el: Ditto.
-
-	* Makefile (REQUIRES): Added ilisp for inf-ruby.
-	* Makefile (ELCS): Added ruby-mode.elc and inf-ruby.elc.
-
-	* package-info.in (provides): Added ruby-mode and inf-ruby.
-
-2002-02-23  Ville Skyttä  
-
-	* modula2.el: Sync with FSF 21.1.
-
-	* package-info.in (provides): Added modula2.
-
-2002-02-21  Ville Skyttä  
-
-	* php-mode.el (php-file-patterns): Re-added autoload cookie.
-
-2002-02-21  Ville Skyttä  
-
-	* php-mode.el: Sync with upstream 1.0.2.
-
-2002-02-21  Ville Skyttä  
-
-	* sql.el: Sync with upstream 1.6.5, with trailing ^Ms removed.
-
-2002-02-21  Steve Youngs  
-
-	* Makefile (MAINTAINER): Change to Ville Skyttä
-	.
-
-2002-02-19  Ville Skyttä  
-
-	* javascript-mode.el: New file.
-	* package-info.in (provides): Added javascript-mode.
-	* Makefile (ELCS): Added javascript-mode.elc.
-
-2002-01-12  Jan Vroonhof  
-
-	* Makefile (REQUIRES): Require ps-print
-
-2002-01-03  Adrian Aichner  
-
-	* tcl.el (tcl-mode): Check for (boundp 'filladapt-mode).
-
-2001-12-27  Steve Youngs  
-
-	* php-mode.el (php-mode-abbrev-table): Revert my patch of
-	2001-12-20. 
-
-2001-12-23  Vin Shelton  
-
-	* php-mode.el: Remove trailing ^Ms.
-
-2001-12-18  Adrian Aichner  
-
-	* cvs.el (cvs-shell-command): Thou shalt obey shell-file-name and
-	shell-command-switch.
-	* cvs.el (cvs-shell-command-option): Ditto.
-	* cvs.el (cvs:merge-convert-symbolic-to-numeric): Ditto.
-
-2001-12-20  Steve Youngs  
-
-	* php-mode.el (php-mode-abbrev-table): Escape a parenthesis in a
-	string. 
-
-2001-12-19  Steve Youngs  
-
-	* Makefile (REQUIRES): Add dired for p4.
-
-	* p4.el (p4-running-xemacs): Autoload 'timerp', 'cancel-timer' and
-	'dired-get-filename'.
-
-	* php-mode.el (php-file-patterns): Add autoload cookie.
-
-2001-12-18  Steve Youngs  
-
-	* old-c-mode.el: New file.
-
-	* p4.el: Ditto.
-
-	* php-mode.el: Ditto.
-
-	* pydoc.el: Ditto.
-
-	* verilog-mode.el: Sync to author version 3.57
-
-	* Makefile (REQUIRES): Add vc, speedbar for p4 and php-mode.
-	(ELCS): Add old-c-mode.elc, p4.elc, php-mode.elc, pydoc.elc
-	(EXTRA_SOURCES): Add pydoc-el-README, pydoc_lisp.py
-
-	* package-info.in (provides): Update for new files.
-	
-2001-12-05  Vaclav Barta  
-
-	* cperl-mode.pl: Got fill-paragraph-or-region to use
-	cperl-fill-paragraph.
-
-2001-12-02  Steve Youngs  
-
-	* mode-compile.el (python-dbg-flags): Typo fix.
-
-2001-06-19  Barry Warsaw  
-
-	* python-mode.el (python-font-lock-keywords):
-	Add "yield" as a keyword to support the new "simple
-	generators" feature of 2.2.  See PEP 255.
-
-2001-06-18  Barry Warsaw  
-
-	* python-mode.el (py-continuation-offset):
-	New variable which controls how much to indent continuation
-	lines, defined as lines following those that end in backslash
-	continuing a block opening statement.
-
-2001-09-10  Raymond Toy  
-
-	* fortran.el (fortran-mode-map): Keep M-BS as backward-kill-word
-	and make C-M-h 'mark-fortran-subprogram.
-
-2001-08-15  Jeff Mincy  
-
-	* tcl.el (tcl-mode): check for filladapt mode
-	(tcl-mode): fix imenu support
-
-2001-07-31  Alex Schroeder  
-
-	* sql.el (sql-db2): Doc change.
-
-2001-07-23  Alex Schroeder  
-
-	* sql.el (sql-postgres): Add the database at the end of the
-	parameters instead of at beginning.
-	(sql-postgres-options): Doc change.
-
-2001-06-21  Jeff Mincy  
-
-	* diff-mode.el (vc-backend-diff): Fix when default-major-mode is text-mode, 
-	also enabled font-lock
-
-2001-06-18  Ben Wing  
-
-	* diff-mode.el:
-	* diff-mode.el (diff-jump-to-old-file-flag): Removed.
-	* diff-mode.el (diff-jump-to-old-file): New.
-	* diff-mode.el ('diff-jump-to-old-file-flag): New.
-	* diff-mode.el (diff-update-on-the-fly-flag): Removed.
-	* diff-mode.el (diff-update-on-the-fly): New.
-	* diff-mode.el ('diff-update-on-the-fly-flag): New.
-	* diff-mode.el (diff-begin-in-read-only-mode): New.
-	* diff-mode.el (diff-metify-map): New.
-	* diff-mode.el (diff-mode-map): New.
-	* diff-mode.el (diff-goto-source):
-	* diff-mode.el (diff-mode):
-	Reapply patch.
-
-2001-05-20  Ben Wing  
-
-	* diff-mode.el:
-	* diff-mode.el (diff-jump-to-old-file-flag): Removed.
-	* diff-mode.el (diff-jump-to-old-file): New.
-	* diff-mode.el (diff-update-on-the-fly-flag): Removed.
-	* diff-mode.el (diff-update-on-the-fly): New.
-	* diff-mode.el (diff-begin-in-read-only-mode): New.
-	* diff-mode.el (diff-metify-map): New.
-	* diff-mode.el (diff-mode-map): New.
-	* diff-mode.el (diff-goto-source):
-	* diff-mode.el (diff-mode):
-	Eliminate nonstandard -flag ending on variables.
-	
-	Add var to control whether we begin in read-only mode; FALSE
-	by default (principle of least surprise; and do not assume that
-	people opening any file named .diff have no interest in editing
-	it).
-
-	Comment out bogus behavior of setting the selection in
-	diff-goto-source.
-
-	Fix keymap-hacking tricks.
-
-2001-04-11  Barry Warsaw  
-
-	* python-mode.el: Bumping to version 4.0 since we now support only
-	XEmacs 21.1 and Emacs 20.7, although not all of the compatibility
-	code for older Emacsen has been removed.  Specifically, the old
-	"make sure we have a current custom.el library" stuff is removed,
-	as is the hack-around for an NTEmacs 19.34.6 make-temp-name bug.
-
-	Updated much of the Commentary section in the initial comments.
-
-	Much more importantly, I've integrated Ken Manheimer's pdbtrack
-	stuff, which is way cool.  When enabled (as by default), this
-	turns on the overlay arrow when pdb is entered, either in the
-	shell buffer or in the *Python* buffer.  Specifically:
-
-	(py-mode-map): Added C-c C-d to toggle pdb tracking.
-
-	(py-pdbtrack-do-tracking-p): New user customizable variable to
-	control whether overlay arrow tracking is enabled or not.  This
-	variable is buffer local and is turned on by default.
-
-	(py-pdbtrack-minor-mode-string): The string that's added to the
-	minor mode alist when actually doing pdb overlay arrow tracking.
-	User customizable.
-
-	(py-pdbtrack-toggle-stack-tracking, turn-on-pdbtrack,
-	turn-off-pdbtrack): New commands to control pdb tracking.
-
-	(py-pdbtrack-is-tracking-p): Helper variable used to control the
-	display of py-pdbtrack-minor-mode-string.  Set to true when the
-	overlay arrow is enabled, and false when it's disabled.
-
-	(py-pdbtrack-stack-entry-regexp, py-pdbtrack-input-prompt,
-	py-pdbtrack-track-range): Inherited from pdbtrack.el and renamed.
-
-	(py-pdbtrack-overlay-arrow, py-pdbtrack-track-stack-file): New
-	functions which actually do the tracking.
-
-	(py-shell): Add py-pdbtrack-track-stack-file to
-	comint-output-filter-functions.
-
-	Finally, add py-pdbtrack-track-stack-file to
-	comint-output-filter-functions at the file level.  This and the
-	py-shell addition should ensure that pdb tracking is installed
-	regardless of the order of operation.
-
-	Also, add py-pdbtrack-minor-mode-string to minor-mode-alist.
-
-2001-02-24  Barry Warsaw  
-
-	* python-mode.el (py-parse-state): Teach python-mode how to scan
-	code which follows multi-line list comprehensions.
-
-2001-02-20  Barry Warsaw  
-
-	* python-mode.el (py-execute-region): This one's easy... kill the
-	temporary file's buffer after executing its contents.
-
-2000-12-27  Barry Warsaw  
-
-	* python-mode.el (python-font-lock-keywords): Add highlighting of
-	`as' as a keyword, but only in "import foo as bar" statements
-	(including optional preceding `from' clause).
-
-2000-10-27  Barry Warsaw  
-
-	* python-mode.el (py-goto-beginning-of-tqs): When searching
-	backwards for the matching delimiter, watch out for backslash
-	escaped delimiters.  Also use = instead of eq for character
-	comparison (because a character is = to it's integer value, but
-	not eq to it).
-
-2000-06-23  Barry Warsaw  
-
-	* python-mode.el (py-execute-region): Make sure the new temporary
-	buffer is current for the insertion of the text.
-
-2000-05-23  Barry Warsaw  
-
-	* python-mode.el (py-execute-region): Based on suggestions by
-	Francois Pinard and Skip Montanaro, handle execution of indented
-	regions by inserting an "if 1:" in front of the block.  This
-	better preserves things like triple quoted strings and commented
-	regions.  This patch resolves PR#264.
-
-2001-04-23  Karl M. Hegbloom  
-
-	* cperl-mode.el (cperl-pod2man-build-command): Man-filter-list is
-	not always bound, depending on which man viewer you are using.
-	Only set flist when boundp Man-filter-list.
-
-2001-04-20  Trey Belew  
-
-	* cperl-mode.el (pod-spell): New.
-	(make-pod-list): New.
-
-2001-04-14  Alex Schroeder  
-
-	* sql.el (sql-escape-newlines-and-send): New function.
-	(sql-db2): Set comint-input-sender to
-	sql-escape-newlines-and-send.
-
-2001-04-13  Alex Schroeder  
-
-	* sql.el (sql-db2-program): New option.
-	(sql-db2-options): New option.
-	(sql-db2): New function.
-
-2001-04-06  Glynn Clements  
-
-	* awk-mode.el (awk-mode): Add necessary call to c-common-init
-
-2001-04-04  Alex Schroeder  
-
-	* sql.el (sql-mode-menu): Added highlighting entries.
-	(sql-highlight-oracle-keywords): New function.
-	(sql-highlight-postgres-keywords): New function.
-	(sql-highlight-ansi-keywords): New function.
-
-2001-03-24  Alex Schroeder  
-
-	* sql.el (sql-help): Doc change.
-
-2001-04-08  Steve Youngs  
-
-	* Makefile (REQUIRES): Add cc-mode, ps-print-nomule, fsf-compat, 
-	edit-utils, ediff, emerge & efs.
-
-2001-04-07  Mike Sperber 
-
-	* diff-mode.el (vc-backend-diff): Don't autoload.
-
-2001-04-05  Mike Sperber 
-
-	* diff-mode.el: 
-	* diff-mode.el.upstream: Added.
-
-	* Makefile (ELCS): Add diff-mode.elc.
-
-2001-03-05  Alex Schroeder  
-
-	* sql.el (sql-interbase): New function.
-	(sql-interbase-program): New option.
-	(sql-interbase-options): New option.
-	And some typos fixed: "customise" to "customize".
-
-2001-02-10  Matt Tucker  
-
-	* cperl-mode.el (cperl-mode): Initialize paren-backwards-message
-
-2001-02-10  Matt Tucker  
-
-	* cperl-mode.el (cperl-mode): Disable override of
-	font-lock-unfontify-region-function under XEmacs
-
-2001-01-27  Steve Youngs  
-
-	* sql.el: Sync with author version 1.4.25.
-
-2001-01-24  Andrew W. Nosenko  
-
-	* sql.el (sql-sybase): typo fix (was: query user about server two
-	times instead of server and database).
-
-2001-01-03  Alex Schroeder  
-
-	* sql.el (sql-sybase): Doc change.
-	(sql-mysql): Doc change.
-	(sql-postgres): Doc change.
-
-2000-11-02  Alex Schroeder  
-
-	* sql.el (sql-sybase-options): New option.
-	(sql-sybase): Use it.  Add sql-database to the list of parameters
-	provided for login.  The options -w 2048 -n are not used any more.
-	(sql-postgres-options): Changed default from "--pset" to "-P".
-	(sql-mysql-options): Doc change.
-	(sql-stop): Doc change.
-
-2000-10-31  Karl M. Hegbloom  
-
-	* make-mode.el (makefile-backslash-region): Make it put the
-	backslashes all the way out past the longest line in the region.
-	- Font lock and Imenu improvements.
-	    - eliminate use of `purecopy'.
-	With some enhancements by Yoshiki Hayashi  .
-
-2000-10-05  Alex Schroeder  
-
-	* sql.el (sql-sybase-options): New option.
-	(sql-sybase): Use it.  Add sql-database to the list of parameters
-	provided for login.  The options -w 2048 -n are not used any more.
-
-2000-10-08  Gunnar Evermann  
-
-	* teco.el: Change keyword to 'emulations'.
-
-2000-10-05  Martin Buchholz  
-
-	* *: Mega typo fix.
-
-2000-10-04  Nick V. Pakoulin  
-
-	* awk-mode.el: Small typo/error fixed in font-lock regexpr.
-
-2000-09-25  Alex Schroeder  
-
-	* sql.el (sql-mysql-options): New variable.
-	(sql-mysql): Use it.
-
-2000-10-03  Nick V. Pakoulin  
-
-	* awk-mode.el: Synched with FSF Emacs 20.7
-	Added some extra fontification.
-
-2000-08-07  Sean MacLennan  
-
-	* cperl-mode.el (cperl-init-faces): Allow XEmacs support of array
-	and hash faces.
-
-2000-08-29  Alex Schroeder  
-
-	* sql.el (sql-postgres): Use sql-postgres-options.
-	(sql-postgres-options): New variable.
-
-2000-08-28  Alex Schroeder  
-
-	* sql.el (sql-mode-menu): Work around missing variable mark-active
-	in XEmacs.
-	(sql-mode): Added call to easy-menu-add for XEmacs compatibility.
-	(sql-interactive-mode): Added call to easy-menu-add for XEmacs
-	compatibility.
-
-2000-08-15  Alex Schroeder  
-
-	* sql.el (sql-magic-go): Use comint-bol.
-	(sql-copy-column): Use comint-line-beginning-position.
-	(comint-line-beginning-position): Define a replacement for
-	comint-line-beginning-position if it is not fboundp.
-
-2000-08-07  Alex Schroeder  
-
-	* sql.el (sql-mode-map): TAB is no longer defined in sql-mode-map;
-	it didn't have any effect anyway.
-
-2000-07-28  Alex Schroeder  
-
-	* sql.el (sql-postgres): Jason Beegan's patch uses the parameters
-	--pset and pager=off instead of sending \\o|cat at the beginning
-	of the session.
-
-2000-07-17  Andreas Jaeger  
-
-	* sql.el: Version 1.4.15 from Alex Schroeder .
-
-2000-07-13  Adrian Aichner  
-
-	* mode-compile.el (mc--build-output-args): Protect filename
-	arguments by double-quotes to handle paths with embedded SPACE on
-	Windows NT.
-	* mode-compile.el (mc--set-command): Ditto.
-	* mode-compile.el (mc--shell-compile): Ditto.
-	* mode-compile.el (makefile-compile): Ditto.
-
-2000-07-13  Adrian Aichner  
-	* mode-compile.el: Import of mode-compile.el 2.27 from
-	http://www.tls.cena.fr/~boubaker/distrib/.
-
-2000-07-04  Andreas Jaeger  
-
-	* sql.el: Version 1.4.13 from Alex Schroeder.
-
-2000-06-29  AichnerAd  
-
-	* cperl-mode.el: Comment updates.
-	* cperl-mode.el (cperl-mode-map): Use `cperl-electric-delete'.
-	* cperl-mode.el (cperl-electric-delete): Bring back from previous
-	XEmacs version to support setting of `delete-key-deletes-forward'.
-
-2000-06-26  AichnerAd  
-
-	* cperl-mode.el: Add XEmacs license information, expand RCS keywords.
-	* cperl-mode.el (cperl-version): Expand Revision keyword.
-
-2000-06-25  Adrian Aichner  
-
-	* cperl-mode.el (cperl-perldoc): Make function work under XEmacs.
-	(cperl-version): sync with version 4.32 of Ilya Zakharevich
-	
-
-2000-05-12  Martin Buchholz  
-
-	* f90.el: Change Author address.
-
-2000-03-06  Yoshiki Hayashi  
-
-	* eiffel3.el (eif-init-color): Don't change font-lock-comment-face
-	and font-lock-string-face.
-	(Top level): Ditto.
-
-2000-01-19  Akim Demaille  
-
-	* autoconf-mode.el (autoconf-font-lock-keywords): Support `A._DEFUN'
-	definitions: Autoconf now uses AC_DEFUN, AU_DEFUN, AH_DEFUN, and
-	others are to come.
-
-2000-01-19  Andreas Jaeger  
-
-	* python-mode.el: Version 3.105 from Barry Warsaw.
-
-1999-12-04  Andreas Jaeger  
-
-	* sql.el (sql-mode-syntax-table): Recognize end of comments
-	inititated by "--".
-	Patch by Enrico Scholz .
-
-1999-10-05  Tim Bradshaw  
-
-	* make-mode.el (makefile-font-lock-keywords):
-	font-lock-preprocessor-face was used unquoted, quoted it.
-
-1999-11-11  Andreas Jaeger  
-
-	* ksh-mode.el: New version from Gary Ellison .
-
-1999-09-22  Martin Buchholz  
-
-	* autoconf-mode.el (autoconf-font-lock-keywords): Add font-lock
-	keywords for function definitions
-
-1999-07-15  Karl M. Hegbloom  
-
-	* make-mode.el: Better highlighting and imenu support.
-
-1999-06-05  Karl M. Hegbloom  
-
-	* sql.el (sql-mode): autoload
-	(sql-interactive-mode): ditto
-	(sql-oracle): ditto
-	(sql-sybase): ditto
-	(sql-informix): ditto
-	(sql-ingres): ditto
-	(sql-ms): ditto
-	(sql-postgres): ditto
-
-1999-07-06  SL Baur  
-
-	* make-mode.el (makefile-mode): Fix for InfoDock menus.
-	From Bob Weiner 
-
-1999-05-12  SL Baur  
-
-	* ksh-mode.el: Synch to ksh-mode.el-2.12
-	(ksh-mode-map): Bind DEL to
-	backward-or-forward-delete-char.
-	Restore 'ksh-mode feature.
-
-1999-02-05  Torbjorn Einarsson  
-
-	* f90.el Synched up with: FSF 20.3, except that
-	font-lock-reference-face is used in place of font-lock-constant-face.
-	(f90-break-before-delimiters): Changed type to boolean.
-	(f90-font-lock-keywords-1): Same regexps for Emacs and XEmacs and
-	changed font-lock-reference-face to font-lock-function-name-face.
-	(f90-font-lock-keywords-2):  Same regexps for Emacs and XEmacs and
-	changed font-lock-reference-face to font-lock-function-name-face.
-	(f90-font-lock-keywords-3): Same regexps for Emacs and XEmacs.
-	(f90-mode-syntax-table): Allow underscore in names, byt not $ etc
-	(f90-mode-map): Electric insert , + - * /
-	(f90-type-def-re): Correct indentation for TYPE block
-	(f90-imenu): Imenu support (FSF only).
-	(f90-mode): Using normal-auto-fill-function.
-	(f90-looking-at-if-then): Fixed bug in matching expressions.
-	(f90-looking-at-where-or-forall): Simplified code.
-	(f90-looking-at-type-like): Better reg-exp for TYPE block.
-	(f90-looking-at-program-block-start): Support for more types of
-	subroutines.
-	(f90-comment-indent): Better indentation of trailing comments.
-	(f90-no-block-limit): Fixed bug in block matching.
-	(f90-electric-insert): New function for auto-fill at operators.
-	(f90-indent-line): Simplified code.
-	(f90-break-line): Better behavior for breaking lines.
-	(f90-auto-fill-mode): Function removed.
-	(f90-do-auto-fill): Also update line.
-	(f90-fill-region): Changed due to new updating policy.
-	(f90-match-end): Fixed bug due to new syntax.
-
-1998-12-30  Martin Buchholz  
-
-	* python-mode.el: Upgrade to version 3.90 by simply copying
-	Barry Warsaw's copy.  Have we lost Oliver's and Bob's changes?
-	Snarfed from http://www.python.org/emacs/python-mode/python-mode.el
-
-1998-11-24  SL Baur  
-
-	* sql.el: New file.
-
-1998-10-15  SL Baur  
-
-	* cvs.el: New file.
-
-1998-09-30  Jan Vroonhof  
-
-	* cperl-mode.el: Do not mess with auto-mode-alist.
-
-1998-09-30  SL Baur  
-
-	* cperl.el: Update maintainer field.
-
-1998-09-29  Bob Weiner  
-
-	* python.el: (py-guess-indent-offset): Suppress message if
-	noninteractive.
-
-1998-09-28  SL Baur  
-
-	* verilog-mode.el (verilog-emacs-features): Correct major version
-	computation.
-
-1998-09-04  Gunnar Evermann  
-
-	* postscript.el: (postscript-font-lock-keywords) eliminate
-	redundancy from regexp for strings.
-
-1998-07-20  Tomasz Cholewo  
-
-	* postscript.el: Fixed syntax table entry for '}'.
-
-1998-07-14  SL Baur  
-
-	* prolog.el (prolog-consult-region): send-string ->
-	process-send-string.
-	(prolog-consult-region): send-region -> process-send-region.
-
-1998-05-04  Oliver Graf 
-
-	* python-mode.el(imenu-example--create-python-index):
-	added imenu Top-entry to fix 'empty' modules
-
-1998-04-29  SL Baur  
-
-	* simula.el (simula-mode): Autoload.
-
-	* m4-mode.el (m4-mode): Autoload.
-
-1998-02-08  Hrvoje Niksic  
-
-	* autoconf-mode.el: Recognize parens as such.
-
-1998-01-24  SL Baur  
-
-	* Makefile (VERSION): Update to package standard 1.0.
-	* package-info.in: Ditto.
-
-1998-01-12  SL Baur  
-
-	* Makefile (CATEGORY): Update to newer package interface.
-
-1998-01-05  SL Baur  
-
-	* python-mode.el updated to 3.28.
-
-1998-01-03  SL Baur  
-
-	* Makefile: Update to newer package interface.
-
-1997-12-23  SL Baur  
-
-	* tcl.el (tcl-submit-bug-report): Remove compile time dependency
-	on reporter.
-
-	* Makefile: Created.
diff --git a/xemacs-packages/lisp/prog-modes/_pkg.el b/xemacs-packages/lisp/prog-modes/_pkg.el
deleted file mode 100644
index dbcb85eb..00000000
--- a/xemacs-packages/lisp/prog-modes/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'prog-modes
-		 :version 2.07
-          :author-version "No-Upstream-Ver"
-		 :type 'single-file)
diff --git a/xemacs-packages/lisp/prog-modes/asm-mode.el b/xemacs-packages/lisp/prog-modes/asm-mode.el
deleted file mode 100644
index fb6d06fa..00000000
--- a/xemacs-packages/lisp/prog-modes/asm-mode.el
+++ /dev/null
@@ -1,265 +0,0 @@
-;;; asm-mode.el --- mode for editing assembler code
-
-;; Copyright (C) 1991 Free Software Foundation, Inc.
-
-;; Author: Eric S. Raymond 
-;; Maintainer: FSF
-;; Keywords: tools, languages
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This mode was written by Eric S. Raymond ,
-;; inspired by an earlier asm-mode by Martin Neitzel.
-
-;; This minor mode is based on text mode.  It defines a private abbrev table
-;; that can be used to save abbrevs for assembler mnemonics.  It binds just
-;; five keys:
-;;
-;;	TAB		tab to next tab stop
-;;	:		outdent preceding label, tab to tab stop
-;;	comment char	place or move comment
-;;			asm-comment-char specifies which character this is;
-;;			you can use a different character in different
-;;			Asm mode buffers.
-;;	C-j, C-m	newline and tab to tab stop
-;;
-;; Code is indented to the first tab stop level.
-
-;; This mode runs two hooks:
-;;   1) An asm-mode-set-comment-hook before the part of the initialization
-;; depending on asm-comment-char, and
-;;   2) an asm-mode-hook at the end of initialization.
-
-;;; Code:
-
-(defgroup asm nil
-  "Assembler programming"
-  :group 'languages)
-
-
-(defcustom asm-comment-char ?;
-  "*The comment-start character assumed by Asm mode."
-  :type 'sexp
-  :group 'asm)
-
-;; XEmacs change (This is the primary difference, why was this
-;;  feature removed? -sb)
-(defcustom asm-support-c-comments-p t
-  "*Support C style comments.  If t C style comments will be
-supported.  This is mainly for the benefit of font-lock."
-  :type 'boolean
-  :group 'asm)
-
-(defcustom asm-mode-syntax-table nil
-  "Syntax table used while in Asm mode.")
-
-(defvar asm-mode-abbrev-table nil
-  "Abbrev table used while in Asm mode.")
-(define-abbrev-table 'asm-mode-abbrev-table ())
-
-(defvar asm-mode-map nil
-  "Keymap for Asm mode.")
-
-(if asm-mode-map
-    nil
-  ;; XEmacs change
-  (setq asm-mode-map (make-sparse-keymap 'asm-mode-map))
-  ;; Note that the comment character isn't set up until asm-mode is called.
-  (define-key asm-mode-map ":"		'asm-colon)
-  (define-key asm-mode-map "\C-c;"	'comment-region)
-  (define-key asm-mode-map "\C-i"	'tab-to-tab-stop)
-  (define-key asm-mode-map "\C-j"	'asm-newline)
-  (define-key asm-mode-map "\C-m"	'asm-newline)
-  )
-
-(defconst asm-font-lock-keywords
- '(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\)?"
-    (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t))
-   ("^\\s +\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-keyword-face))
- "Additional expressions to highlight in Assembler mode.")
-
-;; XEmacs change
-(put 'asm-mode 'font-lock-defaults '(asm-font-lock-keywords))
-(defvar asm-code-level-empty-comment-pattern nil)
-(defvar asm-flush-left-empty-comment-pattern nil)
-(defvar asm-inline-empty-comment-pattern nil)
-
-;;;###autoload
-(defun asm-mode ()
-  "Major mode for editing typical assembler code.
-Features a private abbrev table and the following bindings:
-
-\\[asm-colon]\toutdent a preceding label, tab to next tab stop.
-\\[tab-to-tab-stop]\ttab to next tab stop.
-\\[asm-newline]\tnewline, then tab to next tab stop.
-\\[asm-comment]\tsmart placement of assembler comments.
-
-The character used for making comments is set by the variable
-`asm-comment-char' (which defaults to `?;').
-
-Alternatively, you may set this variable in `asm-mode-set-comment-hook',
-which is called near the beginning of mode initialization.
-
-Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization.
-
-Special commands:
-\\{asm-mode-map}
-"
-  (interactive)
-  (kill-all-local-variables)
-  (setq mode-name "Assembler")
-  (setq major-mode 'asm-mode)
-  (setq local-abbrev-table asm-mode-abbrev-table)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(asm-font-lock-keywords))
-  (make-local-variable 'asm-mode-syntax-table)
-  (setq asm-mode-syntax-table (make-syntax-table))
-  (set-syntax-table asm-mode-syntax-table)
-
-  (run-hooks 'asm-mode-set-comment-hook)
-  ;; Make our own local child of asm-mode-map
-  ;; so we can define our own comment character.
-  ;; XEmacs change
-  (let ((ourmap (make-sparse-keymap)))
-    (set-keymap-parents ourmap (list asm-mode-map))
-    (use-local-map ourmap))
-  (local-set-key (vector asm-comment-char) 'asm-comment)
-  ;; XEmacs change
-  (if asm-support-c-comments-p
-      (progn
-	(modify-syntax-entry ?/ ". 14" asm-mode-syntax-table)
-	(modify-syntax-entry ?* ". 23" asm-mode-syntax-table)
-	(modify-syntax-entry asm-comment-char "< b" asm-mode-syntax-table)
-	(modify-syntax-entry ?\n "> b" asm-mode-syntax-table))
-    (progn
-      (modify-syntax-entry asm-comment-char
-			   "<" asm-mode-syntax-table)
-      (modify-syntax-entry ?\n
-			   ">" asm-mode-syntax-table)))
-  (let ((cs (regexp-quote (char-to-string asm-comment-char))))
-    (make-local-variable 'comment-start)
-    (setq comment-start (concat cs " "))
-    (make-local-variable 'comment-start-skip)
-    (setq comment-start-skip (concat cs "+[ \t]*"))
-    (setq asm-inline-empty-comment-pattern (concat "^.+" cs "+ *$"))
-    (setq asm-code-level-empty-comment-pattern (concat "^[\t ]+" cs cs " *$"))
-    (setq asm-flush-left-empty-comment-pattern (concat "^" cs cs cs " *$"))
-    )
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (setq fill-prefix "\t")
-  (run-hooks 'asm-mode-hook))
-
-(defun asm-colon ()
-  "Insert a colon; if it follows a label, delete the label's indentation."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at "[ \t]+\\(\\sw\\|\\s_\\)+$")
-	(delete-horizontal-space)))
-  (insert ":")
-  (tab-to-tab-stop)
-  )
-
-(defun asm-newline ()
-  "Insert LFD + fill-prefix, to bring us back to code-indent level."
-  (interactive)
-  (if (eolp) (delete-horizontal-space))
-  (insert "\n")
-  (tab-to-tab-stop)
-  )
-
-(defun asm-line-matches (pattern &optional withcomment)
-  (save-excursion
-    (beginning-of-line)
-    (looking-at pattern)))
-
-(defun asm-pop-comment-level ()
-  ;; Delete an empty comment ending current line.  Then set up for a new one,
-  ;; on the current line if it was all comment, otherwise above it
-  (end-of-line)
-  (delete-horizontal-space)
-  (while (= (preceding-char) asm-comment-char)
-    (delete-backward-char 1))
-  (delete-horizontal-space)
-  (if (bolp)
-      nil
-    (beginning-of-line)
-    (open-line 1))
-  )
-
-
-(defun asm-comment ()
-  "Convert an empty comment to a `larger' kind, or start a new one.
-These are the known comment classes:
-
-   1 -- comment to the right of the code (at the comment-column)
-   2 -- comment on its own line, indented like code
-   3 -- comment on its own line, beginning at the left-most column.
-
-Suggested usage:  while writing your code, trigger asm-comment
-repeatedly until you are satisfied with the kind of comment."
-  (interactive)
-  (cond
-
-   ;; Blank line?  Then start comment at code indent level.
-   ((asm-line-matches "^[ \t]*$")
-    (delete-horizontal-space)
-    (tab-to-tab-stop)
-    (insert asm-comment-char comment-start))
-
-   ;; Nonblank line with no comment chars in it?
-   ;; Then start a comment at the current comment column
-   ((asm-line-matches (format "^[^%c\n]+$" asm-comment-char))
-    (indent-for-comment))
-
-   ;; Flush-left comment present?  Just insert character.
-   ((asm-line-matches asm-flush-left-empty-comment-pattern)
-    (insert asm-comment-char))
-
-   ;; Empty code-level comment already present?
-   ;; Then start flush-left comment, on line above if this one is nonempty. 
-   ((asm-line-matches asm-code-level-empty-comment-pattern)
-    (asm-pop-comment-level)
-    (insert asm-comment-char asm-comment-char comment-start))
-
-   ;; Empty comment ends line?
-   ;; Then make code-level comment, on line above if this one is nonempty. 
-   ((asm-line-matches asm-inline-empty-comment-pattern)
-    (asm-pop-comment-level)
-    (tab-to-tab-stop)
-    (insert asm-comment-char comment-start))
-
-   ;; If all else fails, insert character
-   (t
-    (insert asm-comment-char))
-
-   )
-  (end-of-line))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.[sS]\\'" . asm-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.asm\\'" . asm-mode))
-
-;;; asm-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/auto-autoloads.el b/xemacs-packages/lisp/prog-modes/auto-autoloads.el
deleted file mode 100644
index fea3bdf6..00000000
--- a/xemacs-packages/lisp/prog-modes/auto-autoloads.el
+++ /dev/null
@@ -1,1407 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'prog-modes-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "prog-modes/_pkg.el")
-
-(package-provide 'prog-modes :version 2.07 :author-version "No-Upstream-Ver" :type 'single-file)
-
-;;;***
-
-;;;### (autoloads (asm-mode) "asm-mode" "prog-modes/asm-mode.el")
-
-(autoload 'asm-mode "asm-mode" "\
-Major mode for editing typical assembler code.
-Features a private abbrev table and the following bindings:
-
-\\[asm-colon]	outdent a preceding label, tab to next tab stop.
-\\[tab-to-tab-stop]	tab to next tab stop.
-\\[asm-newline]	newline, then tab to next tab stop.
-\\[asm-comment]	smart placement of assembler comments.
-
-The character used for making comments is set by the variable
-`asm-comment-char' (which defaults to `?;').
-
-Alternatively, you may set this variable in `asm-mode-set-comment-hook',
-which is called near the beginning of mode initialization.
-
-Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization.
-
-Special commands:
-\\{asm-mode-map}
-" t nil)
-(add-to-list 'auto-mode-alist '("\\.[sS]\\'" . asm-mode))
-(add-to-list 'auto-mode-alist '("\\.asm\\'" . asm-mode))
-
-;;;***
-
-;;;### (autoloads (autoconf-mode) "autoconf-mode" "prog-modes/autoconf-mode.el")
-
-(autoload 'autoconf-mode "autoconf-mode" "\
-A major-mode to edit autoconf input files like configure.in
-\\{autoconf-mode-map}
-" t nil)
-(add-to-list 'auto-mode-alist '("\\.m4\\'" . autoconf-mode))
-(add-to-list 'auto-mode-alist '("configure\\.\\(in\\|ac\\)\\'" . autoconf-mode))
-
-;;;***
-
-;;;### (autoloads (awk-mode) "awk-mode" "prog-modes/awk-mode.el")
-
-(autoload 'awk-mode "awk-mode" "\
-Major mode for editing AWK code.
-This is much like C mode except for the syntax of comments.  It uses
-the same keymap as C mode and has the same variables for customizing
-indentation.  It has its own abbrev table and its own syntax table.
-
-Turning on AWK mode calls the value of the variable `awk-mode-hook'
-with no args, if that value is non-nil." t nil)
-(add-to-list 'auto-mode-alist '("\\.awk\\'" . awk-mode))
-(add-to-list 'interpreter-mode-alist '("awk\\b" . awk-mode))
-
-;;;***
-
-;;;### (autoloads (common-lisp-indent-function) "cl-indent" "prog-modes/cl-indent.el")
-
-(autoload 'common-lisp-indent-function "cl-indent" nil nil nil)
-
-;;;***
-
-;;;### (autoloads nil "diff-mode" "prog-modes/diff-mode.el")
-(autoload 'diff-mode "diff-mode" nil t)
-(autoload 'diff-minor-mode "diff-mode" nil t)
-(add-to-list 'auto-mode-alist '("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode))
-
-;;;***
-
-;;;### (autoloads (eiffel-mode) "eiffel" "prog-modes/eiffel.el")
-
-(autoload 'eiffel-mode "eiffel" "\
-Major mode for editing Eiffel programs.
-\\[indent-for-tab-command] indents the current Eiffel line correctly and
-\\[reindent-then-newline-and-indent] causes the current and next line to be
-properly indented.
-
-Key definitions:
-\\{eiffel-mode-map}
-
-If variable `eif-use-gnu-eiffel' is non-nil (default t) then support
-for using GNU SmallEiffel is enabled.  Run \\[eif-customize] to see
-compilation and indentation variables that can be customized." t nil)
-(add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
-
-;;;***
-
-;;;### (autoloads (icon-mode) "icon" "prog-modes/icon.el")
-
-(autoload 'icon-mode "icon" "\
-Major mode for editing Icon code.
-Expression and list commands understand all Icon brackets.
-Tab indents for Icon code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-\\{icon-mode-map}
-Variables controlling indentation style:
- icon-tab-always-indent
-    Non-nil means TAB in Icon mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- icon-auto-newline
-    Non-nil means automatically newline before and after braces
-    inserted in Icon code.
- icon-indent-level
-    Indentation of Icon statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- icon-continued-statement-offset
-    Extra indentation given to a substatement, such as the
-    then-clause of an if or body of a while.
- icon-continued-brace-offset
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to `icon-continued-statement-offset'.
- icon-brace-offset
-    Extra indentation for line if it starts with an open brace.
- icon-brace-imaginary-offset
-    An open brace following other text is treated as if it were
-    this far to the right of the start of its line.
-
-Turning on Icon mode calls the value of the variable `icon-mode-hook'
-with no args, if that value is non-nil." t nil)
-(add-to-list 'auto-mode-alist '("\\.icn\\'" . icon-mode))
-
-;;;***
-
-;;;### (autoloads (javascript-shell javascript-mode) "javascript-mode" "prog-modes/javascript-mode.el")
-
-(autoload 'javascript-mode "javascript-mode" "\
-Major mode for editing JavaScript code.
-
-See the documentation for `c++-mode': JavaScript mode is an extension of it.
-Use the hook `javascript-mode-hook' to execute custom code when entering
-JavaScript mode.
-
-\\{javascript-mode-map}" t nil)
-
-(autoload 'javascript-shell "javascript-mode" "\
-Run a JavaScript shell as an inferior process.
-
-Use the `javascript-shell-command' variable to set the command and
-`javascript-shell-command-args' for its arguments to specify the
-command line that invokes your preferred JavaScript shell.
-
-Free JavaScript shell implementations are available for example from
-.
-
-Usage examples:        command    arguments
- Mozilla SpiderMonkey  jsshell
- Mozilla Rhino         java       -jar /path/to/js.jar" t nil)
-(add-to-list 'auto-mode-alist '("\\.js$" . javascript-mode))
-(add-to-list 'auto-mode-alist '("\\.pac$" . javascript-mode))
-
-;;;***
-
-;;;### (autoloads (ksh-mode) "ksh-mode" "prog-modes/ksh-mode.el")
-
-(autoload 'ksh-mode "ksh-mode" "\
-ksh-mode $Revision: 1.4 $ - Major mode for editing (Bourne, Korn or Bourne again)
-shell scripts.
-Special key bindings and commands:
-\\{ksh-mode-map}
-Variables controlling indentation style:
-ksh-indent
-    Indentation of ksh statements with respect to containing block.
-    Default value is 2.
-ksh-case-indent
-    Additional indentation for statements under case items.
-    Default value is nil which will align the statements one position 
-    past the \")\" of the pattern.
-ksh-case-item-offset
-    Additional indentation for case items within a case statement.
-    Default value is 2.
-ksh-group-offset
-    Additional indentation for keywords \"do\" and \"then\".
-    Default value is -2.
-ksh-brace-offset
-    Additional indentation of \"{\" under functions or brace groupings.
-    Default value is 0.
-ksh-multiline-offset
-   Additional indentation of line that is preceded of a line ending with a
-   \\ to make it continue on next line.
-ksh-tab-always-indent
-    Controls the operation of the TAB key. If t (the default), always
-    reindent the current line.  If nil, indent the current line only if
-    point is at the left margin or in the line's indentation; otherwise
-    insert a tab.
-ksh-match-and-tell
-    If non-nil echo in the minibuffer the matching compound command
-    for the \"done\", \"}\", \"fi\", or \"esac\". Default value is t.
-
-ksh-align-to-keyword
-    Controls whether nested constructs align from the keyword or
-    the current indentation. If non-nil, indentation will be relative to
-    the column the keyword starts. If nil, indentation will be relative to
-    the current indentation of the line the keyword is on.
-    The default value is non-nil.
-
-ksh-comment-regexp
-  Regular expression used to recognize comments. Customize to support
-  ksh-like languages. Default value is \"\\s *#\".
-
-Style Guide.
- By setting
-    (setq ksh-indent default-tab-width)
-    (setq ksh-group-offset 0)
-
-    The following style is obtained:
-
-    if [ -z $foo ]
-	    then
-		    bar    # <-- ksh-group-offset is additive to ksh-indent
-		    foo
-    fi
-
- By setting
-    (setq ksh-indent default-tab-width)
-    (setq ksh-group-offset (- 0 ksh-indent))
-
-    The following style is obtained:
-
-    if [ -z $foo ]
-    then
-	    bar
-	    foo
-    fi
-
- By setting
-    (setq ksh-case-item-offset 1)
-    (setq ksh-case-indent nil)
-
-    The following style is obtained:
-
-    case x in *
-     foo) bar           # <-- ksh-case-item-offset
-          baz;;         # <-- ksh-case-indent aligns with \")\"
-     foobar) foo
-             bar;;
-    esac
-
- By setting
-    (setq ksh-case-item-offset 1)
-    (setq ksh-case-indent 6)
-
-    The following style is obtained:
-
-    case x in *
-     foo) bar           # <-- ksh-case-item-offset
-           baz;;        # <-- ksh-case-indent
-     foobar) foo
-           bar;;
-    esac
-    
-
-Installation:
-
- (setq ksh-mode-hook
-      (function (lambda ()
-         (font-lock-mode 1)             ;; font-lock the buffer
-         (setq ksh-indent 8)
-	 (setq ksh-group-offset -8)
-	 (setq ksh-brace-offset -8)   
-         (setq ksh-tab-always-indent t)
-         (setq ksh-match-and-tell t)
-         (setq ksh-align-to-keyword t)	;; Turn on keyword alignment
-	 )))" t nil)
-
-;;;***
-
-;;;### (autoloads (lua-mode) "lua-mode" "prog-modes/lua-mode.el")
-
-(autoload 'lua-mode "lua-mode" "\
-Major mode for editing lua scripts.
-The following keys are bound:
-\\{lua-mode-map}
-" t nil)
-(add-to-list 'auto-mode-alist '("\\.lua$" . lua-mode))
-
-;;;***
-
-;;;### (autoloads (m4-mode) "m4-mode" "prog-modes/m4-mode.el")
-
-(autoload 'm4-mode "m4-mode" "\
-A major-mode to edit m4 macro files
-\\{m4-mode-map}
-" t nil)
-
-;;;***
-
-;;;### (autoloads (makefile-mode) "make-mode" "prog-modes/make-mode.el")
-
-(autoload 'makefile-mode "make-mode" "\
-Major mode for editing Makefiles.
-This function ends by invoking the function(s) `makefile-mode-hook'.
-
-\\{makefile-mode-map}
-
-In the browser, use the following keys:
-
-\\{makefile-browser-map}
-
-Makefile mode can be configured by modifying the following variables:
-
-makefile-browser-buffer-name:
-    Name of the macro- and target browser buffer.
-
-makefile-target-colon:
-    The string that gets appended to all target names
-    inserted by `makefile-insert-target'.
-    \":\" or \"::\" are quite common values.
-
-makefile-macro-assign:
-   The string that gets appended to all macro names
-   inserted by `makefile-insert-macro'.
-   The normal value should be \" = \", since this is what
-   standard make expects.  However, newer makes such as dmake
-   allow a larger variety of different macro assignments, so you
-   might prefer to use \" += \" or \" := \" .
-
-makefile-tab-after-target-colon:
-   If you want a TAB (instead of a space) to be appended after the
-   target colon, then set this to a non-nil value.
-
-makefile-browser-leftmost-column:
-   Number of blanks to the left of the browser selection mark.
-
-makefile-browser-cursor-column:
-   Column in which the cursor is positioned when it moves
-   up or down in the browser.
-
-makefile-browser-selected-mark:
-   String used to mark selected entries in the browser.
-
-makefile-browser-unselected-mark:
-   String used to mark unselected entries in the browser.
-
-makefile-browser-auto-advance-after-selection-p:
-   If this variable is set to a non-nil value the cursor
-   will automagically advance to the next line after an item
-   has been selected in the browser.
-
-makefile-pickup-everything-picks-up-filenames-p:
-   If this variable is set to a non-nil value then
-   `makefile-pickup-everything' also picks up filenames as targets
-   (i.e. it calls `makefile-pickup-filenames-as-targets'), otherwise
-   filenames are omitted.
-
-makefile-cleanup-continuations-p:
-   If this variable is set to a non-nil value then Makefile mode
-   will assure that no line in the file ends with a backslash
-   (the continuation character) followed by any whitespace.
-   This is done by silently removing the trailing whitespace, leaving
-   the backslash itself intact.
-   IMPORTANT: Please note that enabling this option causes Makefile mode
-   to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\".
-
-makefile-browser-hook:
-   A function or list of functions to be called just before the
-   browser is entered. This is executed in the makefile buffer.
-
-makefile-special-targets-list:
-   List of special targets. You will be offered to complete
-   on one of those in the minibuffer whenever you enter a `.'.
-   at the beginning of a line in Makefile mode." t nil)
-(add-to-list 'auto-mode-alist '("\\.ma?ke?\\'" . makefile-mode))
-(add-to-list 'auto-mode-alist '("\\(GNU\\)?[Mm]akefile\\(\\.in\\)*\\'" . makefile-mode))
-(add-to-list 'auto-mode-alist '("\\.am\\'" . makefile-mode))
-(add-to-list 'interpreter-mode-alist '("make" . makefile-mode))
-
-;;;***
-
-;;;### (autoloads (mode-compile-kill mode-compile mode-compile-submit-bug-report) "mode-compile" "prog-modes/mode-compile.el")
-
-(defcustom mode-compile-make-program "make" "*The `make' program used to process makefiles.\n\nIf you have GNU make installed with name \"gmake\" use it." :type 'string :group 'compilation)
-
-(defcustom mode-compile-ignore-makefile-backups t "*Tell mode compile to ignore makefiles backup files when selecting the Makefile to use." :type 'boolean :group 'compilation)
-
-(defvar mode-compile-default-make-options "-k" "\
-Default options to give to `make'.")
-
-(defcustom mode-compile-make-options (eval mode-compile-default-make-options) "*Options to give to `make'.\nThis could be any form evaluating to a string.\n\nSome people asked me a way to modify the make options every time a\ncompilation command is launched, do that:\n (defun my-mode-compile-ask-make-options()\n   \"*Hook called by mode-compile, asking for make options.\"\n   (interactive)\n   (read-string \"Make options: \"\n                mode-compile-default-make-options))\n (setq mode-compile-make-options\n           'my-mode-compile-ask-make-options)" :type '(choice string (sexp :tag "Form evaluating to a string")) :group 'compilation)
-
-(defcustom mode-compile-preferred-default-makerule 'none "*Default makerule you would like to see in minibuffer as a default choice\nwhen selecting the make rule to build.\n\nPossible values are:\n'none    -- let mode-compile deciding for you.\n'all     -- try hard to show you the \"all\" rule.\n'default -- try hard to show you the \"default\" rule.\n'file    -- try to show you the name of the file which will be\n            result of compilation.\nThe 'none action is taken as default is something fail." :type '(radio :tag "Symbol" (const :tag "None - Let mode compile made the choice" :value none) (const :tag "All - Show the \"all\" rule" :value all) (const :tag "Default - Show the \"default\" rule" :value default) (const :tag "File - Show the \"result file name\" rule" :value file)) :group 'compilation)
-
-(defcustom mode-compile-ignore-makerule-regexp nil "*Makefile rules which must be ignored when building completion list.\n\nFor example if you want to remove all `files rules' set\nit to: \"\\\\.\\\\([aoc]\\\\|s[ao][.0-9]*\\\\)\". " :type '(choice (const :tag "none" :value nil) (const :tag "The `all files' rule" :value "\\.\\([aoc]\\|s[ao][.0-9]*\\)") regexp) :group 'compilation)
-
-(defcustom mode-compile-save-all-p nil "*Non-nil means save ALL the modified buffers without asking\nbefore launching compilation command." :type 'boolean :group 'compilation)
-
-(defcustom mode-compile-always-save-buffer-p nil "*Non-nil means save the current buffer without asking\nbefore launching compilation command." :type 'boolean :group 'compilation)
-
-(defcustom mode-compile-never-edit-command-p nil "*Non-nil means never ask to user to edit the compile command." :type 'boolean :group 'compilation)
-
-(defcustom mode-compile-other-frame-p nil "*Non-nil means compile in another frame.\n\nA new Emacs FRAME is created and the compilation command is executed\nin this other frame.  To specify the frame parameters see also\nvariable `mode-compile-frame-parameters-alist'." :type 'boolean :group 'compilation-frame)
-
-(defcustom mode-compile-before-compile-hook nil "Hook to be run before compile command is executed\nwhen `mode-compile' is invoked." :type 'hook :group 'compilation)
-
-(defcustom mode-compile-after-compile-hook nil "Hook to be run after compile command is executed\nwhen `mode-compile' is invoked." :type 'hook :group 'compilation)
-
-(defcustom mode-compile-before-kill-hook nil "Hook to be run before killing compile command is executed\nwhen `mode-compile-kill' is invoked." :type 'hook :group 'compilation)
-
-(defcustom mode-compile-after-kill-hook nil "Hook to be run after killing compile command is executed\nwhen `mode-compile-kill' is invoked." :type 'hook :group 'compilation)
-
-(defvar mode-compile-chosen-compiler nil "\
-*Global variable containing the name of the compiler
-which will be used for compiling without makefile.
-
- Could be used in combination with
- (cc|c++|ada|f77)-default-compiler-options
-to automatically choose the compiler specific options.
-
-example:
- (defun my-compiler-get-options()
-   (cond
-    ((string= mode-compile-chosen-compiler \"gcc\")
-      \"-Wall -pedantic-errors\")
-    ((string= mode-compile-chosen-compiler \"cc\")
-      \"cc options whatever they are...\")
-    (t
-     (message \"Don't know this compiler: %s\" mode-compile-chosen-compiler)
-     (read-string
-      (format \"Options for %s compiler: \" mode-compile-chosen-compiler)))))
-
-  (setq cc-default-compiler-options 'my-compiler-get-options)")
-
-(defcustom mode-compile-expert-p nil "*Non nil means `mode-compile' will not speaks too much.\n\nSee also variable variable mode-compile-reading-time." :type 'boolean :group 'compilation)
-
-(defcustom mode-compile-reading-time 1 "*Seconds to wait in verbose mode after printing a message.\n\nIn verbose mode mode-compile print too much messages that it is\nalmost impossible to read them. Just setting this delay leave you the\ntime to read all the messages. If you don't want any delay set it to\n`0'.\n\nSee also function sit-for." :type 'integer :group 'compilation)
-
-(defcustom emacs-lisp-byte-compile-dir-interactive-p t "*Non-nil means when byte-compiling a directory ask for each file\nneeding to be recompiled or not." :type 'boolean :group 'compilation-elisp)
-
-(defconst mode-compile-version "2.28" "\
-Current version of mode-compile package.
-
-mode-compile.el,v 2.28 2003/04/01 13:52:47 boubaker Exp
-Please send bugs-fixes/contributions/comments to boubaker@cena.fr")
-
-(autoload 'mode-compile-submit-bug-report "mode-compile" "\
-*Submit via mail a bug report on mode-compile v2.27." t nil)
-
-(autoload 'mode-compile "mode-compile" "\
-*Compile the file in the current buffer with a dynamically built command.
-
-The command is built according to the current major mode the function
-was invoked from.
-
-Running this command preceded by universal-argument (\\[universal-argument])
-allows remote compilation, the user is prompted for a host name to run the
-compilation command on.
-
-Currently know how to compile in:
- `c-mode' ,              -- function cc-compile.
- `java-mode' ,           -- function java-compile.
- `c++-mode',             -- function c++-compile.
- `ada-mode',             -- function ada-compile.
- `fortran-mode',         -- function f77-compile.
- `emacs-lisp-mode'       -- function elisp-compile.
- `lisp-interaction-mode' -- function elisp-compile.
- `makefile-mode'         -- function makefile-compile.
- `dired-mode'            -- function dired-compile.
- `sh-mode'               -- function sh-compile.
- `csh-mode'              -- function csh-compile.
- `zsh-mode'              -- function zsh-compile.
- `perl-mode'             -- function perl-compile.
- `cperl-mode'            -- function perl-compile.
- `tcl-mode'              -- function tcl-compile.
- `python-mode'           -- function python-compile.
- `fundamental-mode'      -- function guess-compile.
- `text-mode'             -- function guess-compile.
- `indented-text-mode'    -- function guess-compile.
- `compilation-mode'      -- function default-compile.
- The function `guess-compile' is called when mode is unknown.
-
-The variable `mode-compile-modes-alist' contain description of known
-modes.  The hooks variables `mode-compile-before-compile-hook' and
-`mode-compile-after-compile-hook' are run just before and after
-invoking the compile command of the mode.
-
-Use the command `mode-compile-kill' (\\[mode-compile-kill]) to abort a
-running compilation.
-
-Bound on \\[mode-compile]." t nil)
-
-(autoload 'mode-compile-kill "mode-compile" "\
-*Kill the running compilation launched by `mode-compile' (\\[mode-compile]) command.
-
-The compilation command is killed according to the current major mode
-the function was invoked from.
-
-Currently know how to kill compilations from:
- `c-mode' ,              -- function kill-compilation.
- `java-mode' ,           -- function kill-compilation.
- `c++-mode' ,            -- function kill-compilation.
- `ada-mode' ,            -- function kill-compilation.
- `fortran-mode' ,        -- function kill-compilation.
- `emacs-lisp-mode'       -- function keyboard-quit.
- `lisp-interaction-mode' -- function keyboard-quit.
- `makefile-mode'         -- function kill-compilation.
- `dired-mode'            -- function kill-compilation.
- `sh-mode'               -- function kill-compilation.
- `csh-mode'              -- function kill-compilation.
- `zsh-mode'              -- function kill-compilation.
- `perl-mode'             -- function kill-compilation.
- `cperl-mode'            -- function kill-compilation.
- `tcl-mode'              -- function kill-compilation.
- `python-mode'           -- function kill-compilation.
- `fundamental-mode'      -- Bound dynamically.
- `text-mode'             -- Bound dynamically.
- `indented-text-mode'    -- Bound dynamically.
- `compilation-mode'      -- function kill-compilation.
-
-The variable `mode-compile-modes-alist' contain description of ALL
-known modes.  The hooks variables `mode-compile-before-kill-hook' and
-`mode-compile-after-kill-hook' are run just before and after invoking
-the kill compile command of the mode.
-
-Bound on \\[mode-compile-kill]." t nil)
-
-;;;***
-
-;;;### (autoloads (modula-2-mode) "modula2" "prog-modes/modula2.el")
-
-(autoload 'modula-2-mode "modula2" "\
-This is a mode intended to support program development in Modula-2.
-All control constructs of Modula-2 can be reached by typing C-c
-followed by the first character of the construct.
-\\
-  \\[m2-begin] begin         \\[m2-case] case
-  \\[m2-definition] definition    \\[m2-else] else
-  \\[m2-for] for           \\[m2-header] header
-  \\[m2-if] if            \\[m2-module] module
-  \\[m2-loop] loop          \\[m2-or] or
-  \\[m2-procedure] procedure     Control-c Control-w with
-  \\[m2-record] record        \\[m2-stdio] stdio
-  \\[m2-type] type          \\[m2-until] until
-  \\[m2-var] var           \\[m2-while] while
-  \\[m2-export] export        \\[m2-import] import
-  \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
-  \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
-  \\[m2-compile] compile           \\[m2-next-error] next-error
-  \\[m2-link] link
-
-   `m2-indent' controls the number of spaces for each indentation.
-   `m2-compile-command' holds the command to compile a Modula-2 program.
-   `m2-link-command' holds the command to link a Modula-2 program." t nil)
-
-;;;***
-
-;;;### (autoloads (pascal-mode) "pascal" "prog-modes/pascal.el")
-
-(autoload 'pascal-mode "pascal" "\
-Major mode for editing Pascal code. \\
-TAB indents for Pascal code.  Delete converts tabs to spaces as it moves back.
-
-\\[pascal-complete-word] completes the word around current point with respect to position in code
-\\[pascal-show-completions] shows all possible completions at this point.
-
-Other useful functions are:
-
-\\[pascal-mark-defun]	- Mark function.
-\\[pascal-insert-block]	- insert begin ... end;
-\\[pascal-star-comment]	- insert (* ... *)
-\\[pascal-comment-area]	- Put marked area in a comment, fixing nested comments.
-\\[pascal-uncomment-area]	- Uncomment an area commented with \\[pascal-comment-area].
-\\[pascal-beg-of-defun]	- Move to beginning of current function.
-\\[pascal-end-of-defun]	- Move to end of current function.
-\\[pascal-goto-defun]	- Goto function prompted for in the minibuffer.
-\\[pascal-outline]	- Enter pascal-outline-mode (see also pascal-outline).
-
-Variables controlling indentation/edit style:
-
- pascal-indent-level      (default 3)
-    Indentation of Pascal statements with respect to containing block.
- pascal-case-indent       (default 2)
-    Indentation for case statements.
- pascal-auto-newline      (default nil)
-    Non-nil means automatically newline after semicolons and the punctuation
-    mark after an end.
- pascal-tab-always-indent (default t)
-    Non-nil means TAB in Pascal mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- pascal-auto-endcomments  (default t)
-    Non-nil means a comment { ... } is set after the ends which ends cases and
-    functions. The name of the function or case will be set between the braces.
- pascal-auto-lineup       (default t)
-    List of contexts where auto lineup of :'s or ='s should be done.
-
-See also the user variables pascal-type-keywords, pascal-start-keywords and
-pascal-separator-keywords.
-
-Turning on Pascal mode calls the value of the variable pascal-mode-hook with
-no args, if that value is non-nil." t nil)
-(add-to-list 'auto-mode-alist '("\\.p\\(?:as\\)?\\'" . pascal-mode))
-
-;;;***
-
-;;;### (autoloads nil "php-mode" "prog-modes/php-mode.el")
-
-(defcustom php-file-patterns (list "\\.php[s34]?\\'" "\\.phtml\\'" "\\.inc\\'") "*List of file patterns for which to automatically invoke php-mode." :type '(repeat (regexp :tag "Pattern")) :group 'php)
-(autoload 'php-mode "php-mode" nil t)
-
-(let ((php-file-patterns-temp php-file-patterns)) (while php-file-patterns-temp (add-to-list 'auto-mode-alist (cons (car php-file-patterns-temp) 'php-mode)) (setq php-file-patterns-temp (cdr php-file-patterns-temp))))
-
-;;;***
-
-;;;### (autoloads (postscript-mode) "postscript" "prog-modes/postscript.el")
-
-(autoload 'postscript-mode "postscript" "\
-Major mode for editing PostScript files.
-
-\\[ps-execute-buffer] will send the contents of the buffer to the NeWS
-server using psh(1).  \\[ps-execute-region] sends the current region.
-\\[ps-shell] starts an interactive psh(1) window which will be used for
-subsequent \\[ps-execute-buffer] or \\[ps-execute-region] commands.
-
-In this mode, TAB and \\[indent-region] attempt to indent code
-based on the position of {}, [], and begin/end pairs.  The variable
-ps-indent-level controls the amount of indentation used inside
-arrays and begin/end pairs.  
-
-\\{ps-mode-map}
-
-\\[postscript-mode] calls the value of the variable postscript-mode-hook 
-with no args, if that value is non-nil." t nil)
-(add-to-list 'auto-mode-alist '("\\.c?ps\\'" . postscript-mode))
-
-;;;***
-
-;;;### (autoloads (run-prolog inferior-prolog-mode prolog-mode) "prolog" "prog-modes/prolog.el")
-
-(autoload 'prolog-mode "prolog" "\
-Major mode for editing Prolog code for Prologs.
-Blank lines and `%%...' separate paragraphs.  `%'s start comments.
-Commands:
-\\{prolog-mode-map}
-Entry to this mode calls the value of `prolog-mode-hook'
-if that value is non-nil." t nil)
-
-(autoload 'inferior-prolog-mode "prolog" "\
-Major mode for interacting with an inferior Prolog process.
-
-The following commands are available:
-\\{inferior-prolog-mode-map}
-
-Entry to this mode calls the value of `prolog-mode-hook' with no arguments,
-if that value is non-nil.  Likewise with the value of `comint-mode-hook'.
-`prolog-mode-hook' is called after `comint-mode-hook'.
-
-You can send text to the inferior Prolog from other buffers
-using the commands `process-send-region', `process-send-string' and
-\\[prolog-consult-region].
-
-Commands:
-Tab indents for Prolog; with argument, shifts rest
- of expression rigidly with the current line.
-Paragraphs are separated only by blank lines and '%%'.
-'%'s start comments.
-
-Return at end of buffer sends line as input.
-Return not at end copies rest of line to end and sends it.
-\\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
-\\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
-\\[comint-stop-subjob] stops. \\[comint-quit-subjob] sends quit signal." t nil)
-
-(autoload 'run-prolog "prolog" "\
-Run an inferior Prolog process, input and output via buffer *prolog*." t nil)
-(add-to-list 'auto-mode-alist '("\\.prolog\\'" . prolog-mode))
-
-;;;***
-
-;;;### (autoloads (rexx-mode) "rexx-mode" "prog-modes/rexx-mode.el")
-
-(autoload 'rexx-mode "rexx-mode" "\
-Major mode for editing REXX code.
-\\{rexx-mode-map}
-
-Variables controlling indentation style:
- rexx-indent
-	The basic indentation for do-blocks.
- rexx-end-indent
-	The relative offset of the \"end\" statement. 0 places it in the
-	same column as the statements of the block. Setting it to the same
-	value as rexx-indent places the \"end\" under the do-line.
- rexx-cont-indent
-	The indention for lines following \"then\", \"else\" and \",\"
-	(continued) lines.
- rexx-tab-always-indent
-	Non-nil means TAB in REXX mode should always reindent the current 
-	line, regardless of where in the line the point is when the TAB
-	command is used.
-
-If you have set rexx-end-indent to a nonzero value, you probably want to
-remap RETURN to rexx-indent-newline-indent. It makes sure that lines
-indents correctly when you press RETURN.
-
-An extensive abbreviation table consisting of all the keywords of REXX are
-supplied. Expanded keywords are converted into upper case making it
-easier to distinguish them. To use this feature the buffer must be in
-abbrev-mode. (See example below.)
-
-Turning on REXX mode calls the value of the variable rexx-mode-hook with
-no args, if that value is non-nil.
-
-For example:
-\(setq rexx-mode-hook '(lambda ()
-			(setq rexx-indent 4)
-			(setq rexx-end-indent 4)
-			(setq rexx-cont-indent 4)
-			(local-set-key \"\\C-m\" 'rexx-indent-newline-indent)
-			(abbrev-mode 1)
-			))
-
-will make the END aligned with the DO/SELECT. It will indent blocks and
-IF-statements four steps and make sure that the END jumps into the
-correct position when RETURN is pressed. Finally it will use the abbrev
-table to convert all REXX keywords into upper case." t nil)
-(add-to-list 'interpreter-mode-alist '("rexx" . rexx-mode))
-
-;;;***
-
-;;;### (autoloads (rpm-spec-mode) "rpm-spec-mode" "prog-modes/rpm-spec-mode.el")
-
-(autoload 'rpm-spec-mode "rpm-spec-mode" "\
-Major mode for editing RPM spec files.
-This is much like C mode except for the syntax of comments.  It uses
-the same keymap as C mode and has the same variables for customizing
-indentation.  It has its own abbrev table and its own syntax table.
-
-Turning on RPM spec mode calls the value of the variable `rpm-spec-mode-hook'
-with no args, if that value is non-nil." t nil)
-(add-to-list 'auto-mode-alist '("\\.spec\\(\\.in\\)?$" . rpm-spec-mode))
-
-;;;***
-
-;;;### (autoloads (simula-mode) "simula" "prog-modes/simula.el")
-
-(autoload 'simula-mode "simula" "\
-Major mode for editing SIMULA code.
-\\{simula-mode-map}
-Variables controlling indentation style:
- simula-tab-always-indent
-    Non-nil means TAB in SIMULA mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- simula-indent-level
-    Indentation of SIMULA statements with respect to containing block.
- simula-substatement-offset
-    Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.
- simula-continued-statement-offset 3
-    Extra indentation for lines not starting a statement or substatement,
-    e.g. a nested FOR-loop.  If value is a list, each line in a multiple-
-    line continued statement will have the car of the list extra indentation
-    with respect to the previous line of the statement.
- simula-label-offset -4711
-    Offset of SIMULA label lines relative to usual indentation.
- simula-if-indent '(0 . 0)
-    Extra indentation of THEN and ELSE with respect to the starting IF.
-    Value is a cons cell, the car is extra THEN indentation and the cdr
-    extra ELSE indentation.  IF after ELSE is indented as the starting IF.
- simula-inspect-indent '(0 . 0)
-    Extra indentation of WHEN and OTHERWISE with respect to the
-    corresponding INSPECT.  Value is a cons cell, the car is
-    extra WHEN indentation and the cdr extra OTHERWISE indentation.
- simula-electric-indent nil
-    If this variable is non-nil, `simula-indent-line'
-    will check the previous line to see if it has to be reindented.
- simula-abbrev-keyword 'upcase
-    Determine how SIMULA keywords will be expanded.  Value is one of
-    the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table',
-    or nil if they should not be changed.
- simula-abbrev-stdproc 'abbrev-table
-    Determine how standard SIMULA procedure and class names will be
-    expanded. Value is one of the symbols `upcase', `downcase', `capitalize',
-    (as in) `abbrev-table', or nil if they should not be changed.
-
-Turning on SIMULA mode calls the value of the variable simula-mode-hook
-with no arguments, if that value is non-nil
-
-Warning: simula-mode-hook should not read in an abbrev file without calling
-the function simula-install-standard-abbrevs afterwards, preferably not
-at all." t nil)
-
-;;;***
-
-;;;### (autoloads (sql-linter sql-db2 sql-interbase sql-postgres sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix sql-sybase sql-oracle sql-product-interactive sql-mode sql-help sql-add-product-keywords) "sql" "prog-modes/sql.el")
-
-(autoload 'sql-add-product-keywords "sql" "\
-Add highlighting KEYWORDS for SQL PRODUCT.
-
-PRODUCT should be a symbol, the name of a sql product, such as
-`oracle'.  KEYWORDS should be a list; see the variable
-`font-lock-keywords'.  By default they are added at the beginning
-of the current highlighting list.  If optional argument APPEND is
-`set', they are used to replace the current highlighting list.
-If APPEND is any other non-nil value, they are added at the end
-of the current highlighting list.
-
-For example:
-
- (sql-add-product-keywords 'ms
-  '((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
-
-adds a fontification pattern to fontify identifiers ending in
-`_t' as data types." nil nil)
-
-(autoload 'sql-help "sql" "\
-Show short help for the SQL modes.
-
-Use an entry function to open an interactive SQL buffer.  This buffer is
-usually named `*SQL*'.  The name of the major mode is SQLi.
-
-Use the following commands to start a specific SQL interpreter:
-
-    PostGres: \\[sql-postgres]
-    MySQL: \\[sql-mysql]
-    SQLite: \\[sql-sqlite]
-
-Other non-free SQL implementations are also supported:
-
-    Solid: \\[sql-solid]
-    Oracle: \\[sql-oracle]
-    Informix: \\[sql-informix]
-    Sybase: \\[sql-sybase]
-    Ingres: \\[sql-ingres]
-    Microsoft: \\[sql-ms]
-    DB2: \\[sql-db2]
-    Interbase: \\[sql-interbase]
-    Linter: \\[sql-linter]
-
-But we urge you to choose a free implementation instead of these.
-
-Once you have the SQLi buffer, you can enter SQL statements in the
-buffer.  The output generated is appended to the buffer and a new prompt
-is generated.  See the In/Out menu in the SQLi buffer for some functions
-that help you navigate through the buffer, the input history, etc.
-
-If you have a really complex SQL statement or if you are writing a
-procedure, you can do this in a separate buffer.  Put the new buffer in
-`sql-mode' by calling \\[sql-mode].  The name of this buffer can be
-anything.  The name of the major mode is SQL.
-
-In this SQL buffer (SQL mode), you can send the region or the entire
-buffer to the interactive SQL buffer (SQLi mode).  The results are
-appended to the SQLi buffer without disturbing your SQL buffer." t nil)
-
-(autoload 'sql-mode "sql" "\
-Major mode to edit SQL.
-
-You can send SQL statements to the SQLi buffer using
-\\[sql-send-region].  Such a buffer must exist before you can do this.
-See `sql-help' on how to create SQLi buffers.
-
-\\{sql-mode-map}
-Customization: Entry to this mode runs the `sql-mode-hook'.
-
-When you put a buffer in SQL mode, the buffer stores the last SQLi
-buffer created as its destination in the variable `sql-buffer'.  This
-will be the buffer \\[sql-send-region] sends the region to.  If this
-SQLi buffer is killed, \\[sql-send-region] is no longer able to
-determine where the strings should be sent to.  You can set the
-value of `sql-buffer' using \\[sql-set-sqli-buffer].
-
-For information on how to create multiple SQLi buffers, see
-`sql-interactive-mode'.
-
-Note that SQL doesn't have an escape character unless you specify
-one.  If you specify backslash as escape character in SQL,
-you must tell Emacs.  Here's how to do that in your `~/.emacs' file:
-
-\(add-hook 'sql-mode-hook
-          (lambda ()
-	    (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))" t nil)
-
-(autoload 'sql-product-interactive "sql" "\
-Run product interpreter as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-oracle "sql" "\
-Run sqlplus by Oracle as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-oracle-program'.  Login uses
-the variables `sql-user', `sql-password', and `sql-database' as
-defaults, if set.  Additional command line parameters can be stored in
-the list `sql-oracle-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-oracle].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-sybase "sql" "\
-Run isql by SyBase as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-sybase-program'.  Login uses
-the variables `sql-server', `sql-user', `sql-password', and
-`sql-database' as defaults, if set.  Additional command line parameters
-can be stored in the list `sql-sybase-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-sybase].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-informix "sql" "\
-Run dbaccess by Informix as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-informix-program'.  Login uses
-the variable `sql-database' as default, if set.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-informix].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-sqlite "sql" "\
-Run sqlite as an inferior process.
-
-SQLite is free software.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-sqlite-program'.  Login uses
-the variables `sql-user', `sql-password', `sql-database', and
-`sql-server' as defaults, if set.  Additional command line parameters
-can be stored in the list `sql-sqlite-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-sqlite].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-mysql "sql" "\
-Run mysql by TcX as an inferior process.
-
-Mysql versions 3.23 and up are free software.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-mysql-program'.  Login uses
-the variables `sql-user', `sql-password', `sql-database', and
-`sql-server' as defaults, if set.  Additional command line parameters
-can be stored in the list `sql-mysql-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-mysql].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-solid "sql" "\
-Run solsql by Solid as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-solid-program'.  Login uses
-the variables `sql-user', `sql-password', and `sql-server' as
-defaults, if set.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-solid].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-ingres "sql" "\
-Run sql by Ingres as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-ingres-program'.  Login uses
-the variable `sql-database' as default, if set.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-ingres].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-ms "sql" "\
-Run osql by Microsoft as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-ms-program'.  Login uses the
-variables `sql-user', `sql-password', `sql-database', and `sql-server'
-as defaults, if set.  Additional command line parameters can be stored
-in the list `sql-ms-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-ms].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-postgres "sql" "\
-Run psql by Postgres as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-postgres-program'.  Login uses
-the variables `sql-database' and `sql-server' as default, if set.
-Additional command line parameters can be stored in the list
-`sql-postgres-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-postgres].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.  If your output lines end with ^M,
-your might try undecided-dos as a coding system.  If this doesn't help,
-Try to set `comint-output-filter-functions' like this:
-
-\(setq comint-output-filter-functions (append comint-output-filter-functions
-					     '(comint-strip-ctrl-m)))
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-interbase "sql" "\
-Run isql by Interbase as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-interbase-program'.  Login
-uses the variables `sql-user', `sql-password', and `sql-database' as
-defaults, if set.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-interbase].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-db2 "sql" "\
-Run db2 by IBM as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-db2-program'.  There is not
-automatic login.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-If you use \\[sql-accumulate-and-indent] to send multiline commands to
-db2, newlines will be escaped if necessary.  If you don't want that, set
-`comint-input-sender' back to `comint-simple-send' by writing an after
-advice.  See the elisp manual for more information.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-db2].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-
-(autoload 'sql-linter "sql" "\
-Run inl by RELEX as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-linter-program' - usually `inl'.
-Login uses the variables `sql-user', `sql-password', `sql-database' and
-`sql-server' as defaults, if set.  Additional command line parameters
-can be stored in the list `sql-linter-options'. Run inl -h to get help on
-parameters.
-
-`sql-database' is used to set the LINTER_MBX environment variable for
-local connections, `sql-server' refers to the server name from the
-`nodetab' file for the network connection (dbc_tcp or friends must run
-for this to work).  If `sql-password' is an empty string, inl will use
-an empty password.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)" t nil)
-(add-to-list 'auto-mode-alist '("\\.sql$" . sql-mode))
-
-;;;***
-
-;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl" "prog-modes/tcl.el")
-
-(autoload 'tcl-mode "tcl" "\
-Major mode for editing Tcl code.
-Expression and list commands understand all Tcl brackets.
-Tab indents for Tcl code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-
-Variables controlling indentation style:
-  `tcl-indent-level'
-    Indentation of Tcl statements within surrounding block.
-  `tcl-continued-indent-level'
-    Indentation of continuation line relative to first line of command.
-
-Variables controlling user interaction with mode (see variable
-documentation for details):
-  `tcl-tab-always-indent'
-    Controls action of TAB key.
-  `tcl-auto-newline'
-    Non-nil means automatically newline before and after braces, brackets,
-    and semicolons inserted in Tcl code.
-  `tcl-electric-hash-style'
-    Controls action of `#' key.
-  `tcl-use-hairy-comment-detector'
-    If t, use more complicated, but slower, comment detector.
-    This variable is only used in Emacs 19.
-  `tcl-use-smart-word-finder'
-    If not nil, use a smarter, Tcl-specific way to find the current
-    word when looking up help on a Tcl command.
-
-Turning on Tcl mode calls the value of the variable `tcl-mode-hook'
-with no args, if that value is non-nil.  Read the documentation for
-`tcl-mode-hook' to see what kinds of interesting hook functions
-already exist.
-
-Commands:
-\\{tcl-mode-map}" t nil)
-
-(autoload 'inferior-tcl "tcl" "\
-Run inferior Tcl process.
-Prefix arg means enter program name interactively.
-See documentation for function `inferior-tcl-mode' for more information." t nil)
-
-(autoload 'tcl-help-on-word "tcl" "\
-Get help on Tcl command.  Default is word at point.
-Prefix argument means invert sense of `tcl-use-smart-word-finder'." t nil)
-(add-to-list 'auto-mode-alist '("\\.\\(?:tcl\\|exp\\)\\'" . tcl-mode))
-(add-to-list 'interpreter-mode-alist '("^#!.*\\b\\(scope\\|wish\\|tcl\\|tclsh\\|expect\\)" . tcl-mode))
-
-;;;***
-
-;;;### (autoloads (teco-command) "teco" "prog-modes/teco.el")
-
-(autoload 'teco-command "teco" "\
-Read and execute a Teco command string." t nil)
-
-;;;***
-
-;;;### (autoloads (uil-mode) "uil-mode" "prog-modes/uil-mode.el")
-
-(autoload 'uil-mode "uil-mode" "\
-Major mode for editing UIL files.
-This is much like C mode except for the syntax of comments.  It uses
-the same keymap as C mode and has the same variables for customizing
-indentation.  It has its own abbrev table and its own syntax table.
-
-Turning on uil mode calls the value of the variable `uil-mode-hook'
-with no args, if that value is non-nil." t nil)
-(add-to-list 'auto-mode-alist '("\\.uil$" . uil-mode))
-
-;;;***
-
-;;;### (autoloads (verilog-mode verilog-customize verilog-version) "verilog-mode" "prog-modes/verilog-mode.el")
-(add-to-list 'auto-mode-alist '("\\.vh?\\'" . verilog-mode))
-(add-to-list 'auto-mode-alist '("\\.dv\\'" . verilog-mode))
-(add-to-list 'auto-mode-alist '("\\.vlog\\'" . verilog-mode))
-(add-to-list 'auto-mode-alist '("\\.verilog\\'" . verilog-mode))
-
-(autoload 'verilog-version "verilog-mode" "\
-Inform caller of the version of this file." t nil)
-
-(autoload 'verilog-customize "verilog-mode" "\
-Link to customize screen for Verilog." t nil)
-
-(autoload 'verilog-mode "verilog-mode" "\
-Major mode for editing Verilog code.
-\\
-
-NEWLINE, TAB indents for Verilog code.
-Delete converts tabs to spaces as it moves back.
-Supports highlighting.
-
-Variables controlling indentation/edit style:
-
- variable `verilog-indent-level'      (default 3)
-    Indentation of Verilog statements with respect to containing block.
- `verilog-indent-level-module'        (default 3)
-    Absolute indentation of Module level Verilog statements.
-    Set to 0 to get initial and always statements lined up
-    on the left side of your screen.
- `verilog-indent-level-declaration'   (default 3)
-    Indentation of declarations with respect to containing block.
-    Set to 0 to get them list right under containing block.
- `verilog-indent-level-behavioral'    (default 3)
-    Indentation of first begin in a task or function block
-    Set to 0 to get such code to lined up underneath the task or function keyword
- `verilog-indent-level-directive'     (default 1)
-    Indentation of `ifdef/`endif blocks
- `verilog-cexp-indent'              (default 1)
-    Indentation of Verilog statements broken across lines i.e.:
-    if (a)
-     begin
- `verilog-case-indent'              (default 2)
-    Indentation for case statements.
- `verilog-auto-newline'             (default nil)
-    Non-nil means automatically newline after semicolons and the punctuation
-    mark after an end.
- `verilog-auto-indent-on-newline'   (default t)
-    Non-nil means automatically indent line after newline
- `verilog-tab-always-indent'        (default t)
-    Non-nil means TAB in Verilog mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- `verilog-indent-begin-after-if'    (default t)
-    Non-nil means to indent begin statements following a preceding
-    if, else, while, for and repeat statements, if any.  otherwise,
-    the begin is lined up with the preceding token.  If t, you get:
-      if (a)
-         begin // amount of indent based on `verilog-cexp-indent'
-    otherwise you get:
-      if (a)
-      begin
- `verilog-auto-endcomments'         (default t)
-    Non-nil means a comment /* ... */ is set after the ends which ends
-      cases, tasks, functions and modules.
-    The type and name of the object will be set between the braces.
- `verilog-minimum-comment-distance' (default 10)
-    Minimum distance (in lines) between begin and end required before a comment
-    will be inserted.  Setting this variable to zero results in every
-    end acquiring a comment; the default avoids too many redundant
-    comments in tight quarters.
- `verilog-auto-lineup'              (default `(all))
-    List of contexts where auto lineup of :'s or ='s should be done.
-
-Turning on Verilog mode calls the value of the variable `verilog-mode-hook' with
-no args, if that value is non-nil.
-Other useful functions are:
-\\[verilog-complete-word]	-complete word with appropriate possibilities
-   (functions, verilog keywords...)
-\\[verilog-comment-region]	- Put marked area in a comment, fixing
-   nested comments.
-\\[verilog-uncomment-region]	- Uncomment an area commented with \\[verilog-comment-region].
-\\[verilog-insert-block]	- insert begin ... end;
-\\[verilog-star-comment]	- insert /* ... */
-\\[verilog-mark-defun]	- Mark function.
-\\[verilog-beg-of-defun]	- Move to beginning of current function.
-\\[verilog-end-of-defun]	- Move to end of current function.
-\\[verilog-label-be]	- Label matching begin ... end, fork ... join
-  and case ... endcase statements;
-
-\\[verilog-sk-always]  Insert a always @(AS) begin .. end block
-\\[verilog-sk-begin]  Insert a begin .. end block
-\\[verilog-sk-case]  Insert a case block, prompting for details
-\\[verilog-sk-else]  Insert an else begin .. end block
-\\[verilog-sk-for]  Insert a for (...) begin .. end block, prompting for details
-\\[verilog-sk-generate]  Insert a generate .. endgenerate block
-\\[verilog-sk-header]  Insert a nice header block at the top of file
-\\[verilog-sk-initial]  Insert an initial begin .. end block
-\\[verilog-sk-fork]  Insert a fork begin .. end .. join block
-\\[verilog-sk-module]  Insert a module .. (/*AUTOARG*/);.. endmodule block
-\\[verilog-sk-primitive]  Insert a primitive .. (.. );.. endprimitive block
-\\[verilog-sk-interface]  Insert an interface .. (.. );.. endinterface block
-\\[verilog-sk-repeat]  Insert a repeat (..) begin .. end block
-\\[verilog-sk-specify]  Insert a specify .. endspecify block
-\\[verilog-sk-task]  Insert a task .. begin .. end endtask block
-\\[verilog-sk-while]  Insert a while (...) begin .. end block, prompting for details
-\\[verilog-sk-casex]  Insert a casex (...) item: begin.. end endcase block, prompting for details
-\\[verilog-sk-casez]  Insert a casez (...) item: begin.. end endcase block, prompting for details
-\\[verilog-sk-if]  Insert an if (..) begin .. end block
-\\[verilog-sk-else-if]  Insert an else if (..) begin .. end block
-\\[verilog-sk-comment]  Insert a comment block
-\\[verilog-sk-assign]  Insert an assign .. = ..; statement
-\\[verilog-sk-function]  Insert a function .. begin .. end endfunction block
-\\[verilog-sk-input]  Insert an input declaration, prompting for details
-\\[verilog-sk-output]  Insert an output declaration, prompting for details
-\\[verilog-sk-state-machine]  Insert a state machine definition, prompting for details!
-\\[verilog-sk-inout]  Insert an inout declaration, prompting for details
-\\[verilog-sk-wire]  Insert a wire declaration, prompting for details
-\\[verilog-sk-reg]  Insert a register declaration, prompting for details" t nil)
-
-;;;***
-
-;;;### (autoloads (vrml-mode) "vrml-mode" "prog-modes/vrml-mode.el")
-
-(autoload 'vrml-mode "vrml-mode" "\
-Major mode for editing VRML code.
-Expression and list commands understand all VRML brackets.
-Tab indents for VRML code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-
-Variables controlling indentation style:
-  vrml-indent-level
-    Indentation of VRML statements within surrounding block.
-
-Variables controlling user interaction with mode (see variable
-documentation for details):
-  vrml-tab-always-indent
-    Controls action of TAB key.
-  vrml-auto-newline
-    Non-nil means automatically newline before and after braces
-    inserted in VRML code.
-
-Turning on VRML mode calls the value of the variable `vrml-mode-hook'
-with no args, if that value is non-nil.  Read the documentation for
-`vrml-mode-hook' to see what kinds of interesting hook functions
-already exist.
-
-Commands:
-\\{vrml-mode-map}" t nil)
-(add-to-list 'auto-mode-alist '("\\.wrl\\'" . vrml-mode))
-
-;;;***
-
-(provide 'prog-modes-autoloads)
diff --git a/xemacs-packages/lisp/prog-modes/autoconf-mode.el b/xemacs-packages/lisp/prog-modes/autoconf-mode.el
deleted file mode 100644
index 767beb18..00000000
--- a/xemacs-packages/lisp/prog-modes/autoconf-mode.el
+++ /dev/null
@@ -1,87 +0,0 @@
-;;; autoconf-mode.el --- autoconf code editing commands for Emacs
-
-;; Author: Martin Buchholz (martin@xemacs.org)
-;; Maintainer: Martin Buchholz
-;; Keywords: languages, faces, m4, configure
-
-;; This file is part of XEmacs
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: not in FSF.
-
-;;; Commentary:
-
-;; A major mode for editing autoconf input (like configure.in).
-;; Derived from m4-mode.el by Andrew Csillag (drew@staff.prodigy.com)
-
-;;; Code:
-
-;;thank god for make-regexp.el!
-(defvar autoconf-font-lock-keywords
-  `(("\\bdnl \\(.*\\)"  1 font-lock-comment-face t)
-    ("\\$[0-9*#@]" . font-lock-variable-name-face)
-    ("\\b\\(m4_\\)?\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|gnu\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|un\\(d\\(efine\\|ivert\\)\\|ix\\)\\)\\b" . font-lock-keyword-face)
-    ("^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" 3 font-lock-function-name-face)
-    "default font-lock-keywords")
-)
-
-(defvar autoconf-mode-syntax-table nil
-  "syntax table used in autoconf mode")
-(setq autoconf-mode-syntax-table (make-syntax-table))
-(modify-syntax-entry ?\" "\""  autoconf-mode-syntax-table)
-;;(modify-syntax-entry ?\' "\""  autoconf-mode-syntax-table)
-(modify-syntax-entry ?#  "<\n" autoconf-mode-syntax-table)
-(modify-syntax-entry ?\n ">#"  autoconf-mode-syntax-table)
-(modify-syntax-entry ?\( "()"   autoconf-mode-syntax-table)
-(modify-syntax-entry ?\) ")("   autoconf-mode-syntax-table)
-(modify-syntax-entry ?\[ "(]"  autoconf-mode-syntax-table)
-(modify-syntax-entry ?\] ")["  autoconf-mode-syntax-table)
-(modify-syntax-entry ?*  "."   autoconf-mode-syntax-table)
-(modify-syntax-entry ?_  "_"   autoconf-mode-syntax-table)
-
-(defvar autoconf-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-c\C-c" 'comment-region)
-    map))
-
-;;;###autoload
-(defun autoconf-mode ()
-  "A major-mode to edit autoconf input files like configure.in
-\\{autoconf-mode-map}
-"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map autoconf-mode-map)
-
-  (make-local-variable 'comment-start)
-  (setq comment-start "dnl ")
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-
-  (make-local-variable	'font-lock-defaults)  
-  (setq major-mode 'autoconf-mode)
-  (setq mode-name "Autoconf")
-  (setq font-lock-defaults `(autoconf-font-lock-keywords nil))
-  (set-syntax-table autoconf-mode-syntax-table)
-  (run-hooks 'autoconf-mode-hook))
-
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.m4\\'" . autoconf-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("configure\\.\\(in\\|ac\\)\\'" . autoconf-mode))
-
-(provide 'autoconf-mode)
-
-;;; autoconf-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/awk-mode.el b/xemacs-packages/lisp/prog-modes/awk-mode.el
deleted file mode 100644
index ed6460c1..00000000
--- a/xemacs-packages/lisp/prog-modes/awk-mode.el
+++ /dev/null
@@ -1,181 +0,0 @@
-;;; awk-mode.el --- AWK code editing commands for Emacs
-
-;; Copyright (C) 1988,94,96,2000  Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: unix, languages
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: GNU Emacs 21.2 except not derived from c-mode and we
-;;;                  have a bit different regexp-opt syntax.
-
-;;; Commentary:
-
-;; Sets up C-mode with support for awk-style #-comments and a lightly
-;; hacked syntax table.
-
-;;; Code:
-
-(defvar awk-mode-syntax-table nil
-  "Syntax table in use in Awk-mode buffers.")
-
-(if awk-mode-syntax-table
-    ()
-  (setq awk-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" awk-mode-syntax-table)
-  (modify-syntax-entry ?\n ">   " awk-mode-syntax-table)
-  (modify-syntax-entry ?\f ">   " awk-mode-syntax-table)
-  (modify-syntax-entry ?\# "<   " awk-mode-syntax-table)
-  (modify-syntax-entry ?/ "." awk-mode-syntax-table)
-  (modify-syntax-entry ?* "." awk-mode-syntax-table)
-  (modify-syntax-entry ?+ "." awk-mode-syntax-table)
-  (modify-syntax-entry ?- "." awk-mode-syntax-table)
-  (modify-syntax-entry ?= "." awk-mode-syntax-table)
-  (modify-syntax-entry ?% "." awk-mode-syntax-table)
-  (modify-syntax-entry ?< "." awk-mode-syntax-table)
-  (modify-syntax-entry ?> "." awk-mode-syntax-table)
-  (modify-syntax-entry ?& "." awk-mode-syntax-table)
-  (modify-syntax-entry ?| "." awk-mode-syntax-table)
-  (modify-syntax-entry ?_ "_" awk-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" awk-mode-syntax-table))
-
-(defvar awk-mode-abbrev-table nil
-  "Abbrev table in use in Awk-mode buffers.")
-(define-abbrev-table 'awk-mode-abbrev-table ())
-
-;; Regexps written with help from Peter Galbraith .
-(defconst awk-font-lock-keywords
-  (eval-when-compile
-    (list
-     ;;
-     ;; Regular expressions. npak@ispras.ru
-     ;; We shoul do it before any other fontification
-     ;; Split into two cases for Speed god.
-     (cons "^[ \t]*/\\(\\(\\([\\].\\)?[^/\\]*\\)+\\)"
-           '(1 'font-lock-string-face))
-     (cons "[-!~+*=&<>|(][ \t]*/\\(\\(\\([\\].\\)?[^/\\]*\\)+\\)"
-           '(1 font-lock-string-face))
-     ;;
-     ;; Function names.
-     '("^[ \t]*\\(function\\)\\>[ \t]*\\(\\sw+\\)?"
-       (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-     ;;
-     ;; Variable names.
-     ;; "RT", field identifiers $0, $1 etc added by npak@ispras.ru
-     (cons (concat
-            "\\<\\(?:"
-            (regexp-opt
-             '("ARGC" "ARGIND" "ARGV" "CONVFMT" "ENVIRON" "ERRNO"
-               "FIELDWIDTHS" "FILENAME" "FNR" "FS" "IGNORECASE" "NF" "NR"
-               "OFMT" "OFS" "ORS" "RLENGTH" "RS" "RT" "RSTART" "SUBSEP"))
-            "\\|\\$\\(?:[0-9]+\\|\\sw+\\)\\)\\>")
-           'font-lock-variable-name-face)
-     ;;
-     ;; Keywords.
-     ;; "do", "in", "nextfile" added by npak@ispras.ru
-     (concat
-      "\\<\\(?:"
-      (regexp-opt
-       '("BEGIN" "END" "break" "continue" "delete" "do" "else" "exit" "for"
-         "getline" "if" "in" "next" "nextfile" "print" "printf" "return"
-         "while"))
-      "\\)\\>")
-     ;;
-     ;; Builtins.
-     ;; "fflush" added by npak@ispras.ru
-     (list (concat
-            "\\<\\("
-            (regexp-opt
-             '("atan2" "close" "cos" "ctime" "exp" "gsub" "index" "int"
-               "length" "log" "match" "rand" "sin" "split" "sprintf"
-               "sqrt" "srand" "sub" "substr" "system" "time" "fflush"
-               "tolower" "toupper"))
-            "\\)(")
-           1 'font-lock-reference-face)
-     ;;
-     ;; Function call, variables. npak@ispras.ru
-     (list "\\<\\([A-Za-z_]\\sw*\\)("
-           1 'font-lock-function-name-face)
-     (list "\\<\\([A-Za-z_]\\sw*\\)\\($\\|[^(]\\)"
-           1 'font-lock-variable-name-face)
-     ;;
-     ;; Operators.  Is this too much?
-     ;; Yes, it is. npak@ispras.ru
-     ;(cons (regexp-opt '("&&" "||" "<=" "<" ">=" ">" "==" "!=" "!~" "~"))
-     ;      'font-lock-reference-face)
-     ))
- "Default expressions to highlight in AWK mode.")
-
-;; npak@ispras.ru
-(put 'awk-mode 'font-lock-defaults
-     '(awk-font-lock-keywords nil nil ((?_ . "w"))))
-
-;;;###autoload
-(defun awk-mode ()
-  "Major mode for editing AWK code.
-This is much like C mode except for the syntax of comments.  It uses
-the same keymap as C mode and has the same variables for customizing
-indentation.  It has its own abbrev table and its own syntax table.
-
-Turning on AWK mode calls the value of the variable `awk-mode-hook'
-with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (require 'cc-mode)
-  (c-initialize-cc-mode)
-  (use-local-map c-mode-map)
-  (c-common-init)
-  (setq major-mode 'awk-mode)
-  (setq mode-name "AWK")
-  (setq local-abbrev-table awk-mode-abbrev-table)
-  (set-syntax-table awk-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'c-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'c-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  ;; No need in XEmacs
-  ;(make-local-variable 'font-lock-defaults)
-  ;(setq font-lock-defaults '(awk-font-lock-keywords nil nil ((?_ . "w"))))
-  (run-hooks 'awk-mode-hook))
-
-;; XEmacs additions
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.awk\\'" . awk-mode))
-;;;###autoload(add-to-list 'interpreter-mode-alist '("awk\\b" . awk-mode))
-
-(provide 'awk-mode)
-
-;;; awk-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/cl-indent.el b/xemacs-packages/lisp/prog-modes/cl-indent.el
deleted file mode 100644
index fd1ca877..00000000
--- a/xemacs-packages/lisp/prog-modes/cl-indent.el
+++ /dev/null
@@ -1,513 +0,0 @@
-;;; cl-indent.el --- enhanced lisp-indent mode
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik 
-;; Created: July 1987
-;; Maintainer: FSF
-;; Keywords: lisp, tools
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34
-
-;;; Commentary:
-
-;; This package supplies a single entry point, common-lisp-indent-function,
-;; which performs indentation in the preferred style for Common Lisp code.
-;; To enable it:
-;;
-;; (setq lisp-indent-function 'common-lisp-indent-function)
-
-;;>> TODO
-;; :foo
-;;   bar
-;; :baz
-;;   zap
-;; &key (like &body)??
-
-;; &rest 1 in lambda-lists doesn't work
-;;  -- really want (foo bar
-;;                  baz)
-;;     not (foo bar
-;;              baz)
-;;  Need something better than &rest for such cases
-
-;;; Code:
-
-(defgroup lisp-indent nil
-  "Enhanced lisp-indent mode."
-  :group 'lisp)
-
-
-(defcustom lisp-indent-maximum-backtracking 3
-  "*Maximum depth to backtrack out from a sublist for structured indentation.
-If this variable is  0, no backtracking will occur and forms such as flet
-may not be correctly indented."
-  :type 'integer
-  :group 'lisp-indent)
-
-(defcustom lisp-tag-indentation 1
-  "*Indentation of tags relative to containing list.
-This variable is used by the function `lisp-indent-tagbody'."
-  :type 'integer
-  :group 'lisp-indent)
-
-(defcustom lisp-tag-body-indentation 3
-  "*Indentation of non-tagged lines relative to containing list.
-This variable is used by the function `lisp-indent-tagbody' to indent normal
-lines (lines without tags).
-The indentation is relative to the indentation of the parenthesis enclosing
-the special form.  If the value is t, the body of tags will be indented
-as a block at the same indentation as the first s-expression following
-the tag.  In this case, any forms before the first tag are indented
-by `lisp-body-indent'."
-  :type 'integer
-  :group 'lisp-indent)
-
-
-;;;###autoload
-(defun common-lisp-indent-function (indent-point state)
-  (let ((normal-indent (current-column)))
-    ;; Walk up list levels until we see something
-    ;;  which does special things with subforms.
-    (let ((depth 0)
-          ;; Path describes the position of point in terms of
-          ;;  list-structure with respect to containing lists.
-          ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)'
-          (path ())
-          ;; set non-nil when somebody works out the indentation to use
-          calculated
-          (last-point indent-point)
-          ;; the position of the open-paren of the innermost containing list
-          (containing-form-start (elt state 1))
-          ;; the column of the above
-          sexp-column)
-      ;; Move to start of innermost containing list
-      (goto-char containing-form-start)
-      (setq sexp-column (current-column))
-      ;; Look over successively less-deep containing forms
-      (while (and (not calculated)
-                  (< depth lisp-indent-maximum-backtracking))
-        (let ((containing-sexp (point)))
-          (forward-char 1)
-          (parse-partial-sexp (point) indent-point 1 t)
-          ;; Move to the car of the relevant containing form
-          (let (tem function method)
-            (if (not (looking-at "\\sw\\|\\s_"))
-                ;; This form doesn't seem to start with a symbol
-                (setq function nil method nil)
-              (setq tem (point))
-              (forward-sexp 1)
-              (setq function (downcase (buffer-substring tem (point))))
-              (goto-char tem)
-              (setq tem (intern-soft function)
-                    method (get tem 'common-lisp-indent-function))
-              (cond ((and (null method)
-                          (string-match ":[^:]+" function))
-                     ;; The pleblisp package feature
-                     (setq function (substring function
-                                               (1+ (match-beginning 0)))
-                           method (get (intern-soft function)
-                                       'common-lisp-indent-function)))
-                    ((and (null method))
-                     ;; backwards compatibility
-                     (setq method (get tem 'lisp-indent-function)))))
-            (let ((n 0))
-              ;; How far into the containing form is the current form?
-              (if (< (point) indent-point)
-                  (while (condition-case ()
-                             (progn
-                               (forward-sexp 1)
-                               (if (>= (point) indent-point)
-                                   nil
-                                 (parse-partial-sexp (point)
-                                                     indent-point 1 t)
-                                 (setq n (1+ n))
-                                 t))
-                           (error nil))))
-              (setq path (cons n path)))
-
-            ;; backwards compatibility.
-            (cond ((null function))
-                  ((null method)
-                   (if (null (cdr path))
-                       ;; (package prefix was stripped off above)
-                       (setq method (cond ((string-match "\\`def"
-                                                         function)
-                                           '(4 (&whole 4 &rest 1) &body))
-                                          ((string-match "\\`\\(with\\|do\\)-"
-                                                         function)
-                                           '(4 &body))))))
-                  ;; backwards compatibility.  Bletch.
-                  ((eq method 'defun)
-                   (setq method '(4 (&whole 4 &rest 1) &body))))
-
-            (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`))
-                        (not (eql (char-after (- containing-sexp 2)) ?\#)))
-                   ;; No indentation for "'(...)" elements
-                   (setq calculated (1+ sexp-column)))
-		  ((or (eql (char-after (1- containing-sexp)) ?\,)
-		       (and (eql (char-after (1- containing-sexp)) ?\@)
-			    (eql (char-after (- containing-sexp 2)) ?\,)))
-		   ;; ",(...)" or ",@(...)"
-		   (setq calculated normal-indent))
-                  ((eql (char-after (1- containing-sexp)) ?\#)
-                   ;; "#(...)"
-                   (setq calculated (1+ sexp-column)))
-                  ((null method))
-                  ((integerp method)
-                   ;; convenient top-level hack.
-                   ;;  (also compatible with lisp-indent-function)
-                   ;; The number specifies how many `distinguished'
-                   ;;  forms there are before the body starts
-                   ;; Equivalent to (4 4 ... &body)
-                   (setq calculated (cond ((cdr path)
-                                           normal-indent)
-                                          ((<= (car path) method)
-                                           ;; `distinguished' form
-                                           (list (+ sexp-column 4)
-                                                 containing-form-start))
-                                          ((= (car path) (1+ method))
-                                           ;; first body form.
-                                           (+ sexp-column lisp-body-indent))
-                                          (t
-                                           ;; other body form
-                                           normal-indent))))
-                  ((symbolp method)
-                   (setq calculated (funcall method
-                                             path state indent-point
-                                             sexp-column normal-indent)))
-                  (t
-                   (setq calculated (lisp-indent-259
-                                      method path state indent-point
-                                      sexp-column normal-indent)))))
-          (goto-char containing-sexp)
-          (setq last-point containing-sexp)
-          (if (not calculated)
-              (condition-case ()
-                   (progn (backward-up-list 1)
-                          (setq depth (1+ depth)))
-                (error (setq depth lisp-indent-maximum-backtracking))))))
-      calculated)))
-
-
-(defun lisp-indent-report-bad-format (m)
-  (error "%s has a badly-formed %s property: %s"
-         ;; Love those free variable references!!
-         function 'common-lisp-indent-function m))
-
-;; Blame the crufty control structure on dynamic scoping
-;;  -- not on me!
-(defun lisp-indent-259 (method path state indent-point
-                        sexp-column normal-indent)
-  (catch 'exit
-    (let ((p path)
-          (containing-form-start (elt state 1))
-          n tem tail)
-      ;; Isn't tail-recursion wonderful?
-      (while p
-        ;; This while loop is for destructuring.
-        ;; p is set to (cdr p) each iteration.
-        (if (not (consp method)) (lisp-indent-report-bad-format method))
-        (setq n (1- (car p))
-              p (cdr p)
-              tail nil)
-        (while n
-          ;; This while loop is for advancing along a method
-          ;; until the relevant (possibly &rest/&body) pattern
-          ;; is reached.
-          ;; n is set to (1- n) and method to (cdr method)
-          ;; each iteration.
-          (setq tem (car method))
-
-          (or (eq tem 'nil)             ;default indentation
-;             (eq tem '&lambda)         ;abbrev for (&whole 4 (&rest 1))
-              (and (eq tem '&body) (null (cdr method)))
-              (and (eq tem '&rest)
-                   (consp (cdr method)) (null (cdr (cdr method))))
-              (integerp tem)            ;explicit indentation specified
-              (and (consp tem)          ;destructuring
-                   (eq (car tem) '&whole)
-                   (or (symbolp (car (cdr tem)))
-                       (integerp (car (cdr tem)))))
-              (and (symbolp tem)        ;a function to call to do the work.
-                   (null (cdr method)))
-              (lisp-indent-report-bad-format method))
-
-          (cond ((and tail (not (consp tem)))
-                 ;; indent tail of &rest in same way as first elt of rest
-                 (throw 'exit normal-indent))
-                ((eq tem '&body)
-                 ;; &body means (&rest )
-                 (throw 'exit
-                   (if (and (= n 0)     ;first body form
-                            (null p))   ;not in subforms
-                       (+ sexp-column
-                          lisp-body-indent)
-                       normal-indent)))
-                ((eq tem '&rest)
-                 ;; this pattern holds for all remaining forms
-                 (setq tail (> n 0)
-                       n 0
-                       method (cdr method)))
-                ((> n 0)
-                 ;; try next element of pattern
-                 (setq n (1- n)
-                       method (cdr method))
-                 (if (< n 0)
-                     ;; Too few elements in pattern.
-                     (throw 'exit normal-indent)))
-                ((eq tem 'nil)
-                 (throw 'exit (list normal-indent containing-form-start)))
-;               ((eq tem '&lambda)
-;                ;; abbrev for (&whole 4 &rest 1)
-;                (throw 'exit
-;                  (cond ((null p)
-;                         (list (+ sexp-column 4) containing-form-start))
-;                        ((null (cdr p))
-;                         (+ sexp-column 1))
-;                        (t normal-indent))))
-                ((integerp tem)
-                 (throw 'exit
-                   (if (null p)         ;not in subforms
-                       (list (+ sexp-column tem) containing-form-start)
-                       normal-indent)))
-                ((symbolp tem)          ;a function to call
-                 (throw 'exit
-                   (funcall tem path state indent-point
-                            sexp-column normal-indent)))
-                (t
-                 ;; must be a destructing frob
-                 (if (not (null p))
-                     ;; descend
-                     (setq method (cdr (cdr tem))
-                           n nil)
-                   (setq tem (car (cdr tem)))
-                   (throw 'exit
-                     (cond (tail
-                            normal-indent)
-                           ((eq tem 'nil)
-                            (list normal-indent
-                                  containing-form-start))
-                           ((integerp tem)
-                            (list (+ sexp-column tem)
-                                  containing-form-start))
-                           (t
-                            (funcall tem path state indent-point
-                                     sexp-column normal-indent))))))))))))
-
-(defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent)
-  (if (not (null (cdr path)))
-      normal-indent
-    (save-excursion
-      (goto-char indent-point)
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (list (cond ((looking-at "\\sw\\|\\s_")
-                   ;; a tagbody tag
-                   (+ sexp-column lisp-tag-indentation))
-                  ((integerp lisp-tag-body-indentation)
-                   (+ sexp-column lisp-tag-body-indentation))
-                  ((eq lisp-tag-body-indentation 't)
-                   (condition-case ()
-                       (progn (backward-sexp 1) (current-column))
-                     (error (1+ sexp-column))))
-                  (t (+ sexp-column lisp-body-indent)))
-;            (cond ((integerp lisp-tag-body-indentation)
-;                   (+ sexp-column lisp-tag-body-indentation))
-;                  ((eq lisp-tag-body-indentation 't)
-;                   normal-indent)
-;                  (t
-;                   (+ sexp-column lisp-body-indent)))
-            (elt state 1)
-            ))))
-
-(defun lisp-indent-do (path state indent-point sexp-column normal-indent)
-  (if (>= (car path) 3)
-      (let ((lisp-tag-body-indentation lisp-body-indent))
-        (funcall (function lisp-indent-tagbody)
-		 path state indent-point sexp-column normal-indent))
-    (funcall (function lisp-indent-259)
-	     '((&whole nil &rest
- 		;; the following causes weird indentation
- 		;;(&whole 1 1 2 nil)
-		)
-	       (&whole nil &rest 1))
-	     path state indent-point sexp-column normal-indent)))
-
-(defun lisp-indent-function-lambda-hack (path state indent-point
-                                         sexp-column normal-indent)
-  ;; indent (function (lambda ()  )) kludgily.
-  (if (or (cdr path) ; wtf?
-          (> (car path) 3))
-      ;; line up under previous body form
-      normal-indent
-    ;; line up under function rather than under lambda in order to
-    ;;  conserve horizontal space.  (Which is what #' is for.)
-    (condition-case ()
-        (save-excursion
-          (backward-up-list 2)
-          (forward-char 1)
-          (if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)")
-              (+ lisp-body-indent -1 (current-column))
-              (+ sexp-column lisp-body-indent)))
-       (error (+ sexp-column lisp-body-indent)))))
-
-;; XEmacs change
-(defun lisp-indent-defmethod (path state indent-point
-                              sexp-column normal-indent)
-  ;; Look for a method combination specifier...
-  (let* ((combined (if (and (>= (car path) 3)
-                            (null (cdr path)))
-                       (save-excursion
-                         (goto-char (car (cdr state)))
-                         (forward-char)
-                         (forward-sexp)
-                         (forward-sexp)
-                         (forward-sexp)
-                         (backward-sexp)
-                         (if (looking-at ":")
-                             t
-                             nil))
-                       nil))
-	 (method (if combined
-		     '(4 4 (&whole 4 &rest 1) &body)
-		     '(4 (&whole 4 &rest 1) &body))))
-    (funcall (function lisp-indent-259)
-	     method
-	     path state indent-point sexp-column normal-indent)))
-
-
-(let ((l '((block 1)
-	   (catch 1)
-           (case        (4 &rest (&whole 2 &rest 1)))
-           (ccase . case) (ecase . case)
-           (typecase . case) (etypecase . case) (ctypecase . case)
-           (catch 1)
-           (cond        (&rest (&whole 2 &rest 1)))
-           (block 1)
-           (defvar      (4 2 2))
-           (defconstant . defvar) (defparameter . defvar)
-           (define-modify-macro
-                        (4 &body))
-           (define-setf-method
-                        (4 (&whole 4 &rest 1) &body))
-           (defsetf     (4 (&whole 4 &rest 1) 4 &body))
-           (defun       (4 (&whole 4 &rest 1) &body))
-           (defmacro . defun) (deftype . defun)
-	   ;; XEmacs change
-           (defmethod lisp-indent-defmethod)
-           (defstruct   ((&whole 4 &rest (&whole 2 &rest 1))
-                         &rest (&whole 2 &rest 1)))
-           (destructuring-bind
-                        ((&whole 6 &rest 1) 4 &body))
-           (do          lisp-indent-do)
-           (do* . do)
-           (dolist      ((&whole 4 2 1) &body))
-           (dotimes . dolist)
-           (eval-when	1)
-           (flet        ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body))
-                         &body))
-           (labels . flet)
-           (macrolet . flet)
-           ;; `else-body' style
-           (if          (nil nil &body))
-           ;; single-else style (then and else equally indented)
-           (if          (&rest nil))
-           ;(lambda     ((&whole 4 &rest 1) &body))
-           (lambda      ((&whole 4 &rest 1)
-                         &rest lisp-indent-function-lambda-hack))
-           (let         ((&whole 4 &rest (&whole 1 1 2)) &body))
-           (let* . let)
-           (compiler-let . let) ;barf
-           (locally	1)
-           ;(loop ...)
-           (multiple-value-bind
-                        ((&whole 6 &rest 1) 4 &body))
-           (multiple-value-call
-			(4 &body))
-           (multiple-value-list 1)
-           (multiple-value-prog1 1)
-           (multiple-value-setq
-			(4 2))
-           ;; Combines the worst features of BLOCK, LET and TAGBODY
-           (prog        ((&whole 4 &rest 1) &rest lisp-indent-tagbody))
-           (prog* . prog)
-           (prog1 1)
-           (prog2 2)
-           (progn 0)
-           (progv       (4 4 &body))
-           (return 0)
-           (return-from (nil &body))
-           (tagbody     lisp-indent-tagbody)
-           (throw 1)
-           (unless 1)
-           (unwind-protect
-                        (5 &body))
-           (when 1))))
-  (while l
-    (put (car (car l)) 'common-lisp-indent-function
-         (if (symbolp (cdr (car l)))
-             (get (cdr (car l)) 'common-lisp-indent-function)
-             (car (cdr (car l)))))
-    (setq l (cdr l))))
-
-
-;(defun foo (x)
-;  (tagbody
-;   foo
-;     (bar)
-;   baz
-;     (when (losing)
-;       (with-big-loser
-;           (yow)
-;         ((lambda ()
-;            foo)
-;          big)))
-;     (flet ((foo (bar baz zap)
-;              (zip))
-;            (zot ()
-;              quux))
-;       (do ()
-;           ((lose)
-;            (foo 1))
-;         (quux)
-;        foo
-;         (lose))
-;       (cond ((x)
-;              (win 1 2
-;                   (foo)))
-;             (t
-;              (lose
-;                3))))))
-          
-
-;(put 'while    'common-lisp-indent-function 1)
-;(put 'defwrapper'common-lisp-indent-function ...)
-;(put 'def 'common-lisp-indent-function ...)
-;(put 'defflavor        'common-lisp-indent-function ...)
-;(put 'defsubst 'common-lisp-indent-function ...)
-
-;(put 'with-restart 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body)))
-;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1)))))
-;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((* 1))) (3 4 ((* 1))) (4 &body)))
-;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body)))
-;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body)))))
-
-;;; cl-indent.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/custom-load.el b/xemacs-packages/lisp/prog-modes/custom-load.el
deleted file mode 100644
index c712216b..00000000
--- a/xemacs-packages/lisp/prog-modes/custom-load.el
+++ /dev/null
@@ -1,65 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'verilog-mode-actions '("verilog-mode"))
-(custom-add-loads 'prolog '("prolog"))
-(custom-add-loads 'pascal '("pascal"))
-(custom-add-loads 'tcl '("tcl"))
-(custom-add-loads 'icon '("icon"))
-(custom-add-loads 'php '("php-mode"))
-(custom-add-loads 'oop '("eiffel"))
-(custom-add-loads 'old-c '("old-c-mode"))
-(custom-add-loads 'eiffel '("eiffel"))
-(custom-add-loads 'compilation-remote '("mode-compile"))
-(custom-add-loads 'lua '("lua-mode"))
-(custom-add-loads 'lisp-indent '("cl-indent"))
-(custom-add-loads 'tools '("diff-mode" "make-mode" "mode-compile" "p4"))
-(custom-add-loads 'compile-perl '("mode-compile"))
-(custom-add-loads 'diff-mode '("diff-mode"))
-(custom-add-loads 'lisp '("cl-indent" "mode-compile"))
-(custom-add-loads 'diff '("diff-mode"))
-(custom-add-loads 'modula2 '("modula2"))
-(custom-add-loads 'compile-c '("mode-compile"))
-(custom-add-loads 'compilation-frame '("mode-compile"))
-(custom-add-loads 'javascript-shell '("javascript-mode"))
-(custom-add-loads 'verilog-mode-indent '("verilog-mode"))
-(custom-add-loads 'compile-sh '("mode-compile"))
-(custom-add-loads 'asm '("asm-mode"))
-(custom-add-loads 'compile-fortran '("mode-compile"))
-(custom-add-loads 'frames '("mode-compile"))
-(custom-add-loads 'rpm-spec-faces '("rpm-spec-mode"))
-(custom-add-loads 'compilation-script '("mode-compile"))
-(custom-add-loads 'makefile '("make-mode"))
-(custom-add-loads 'rpm-spec '("rpm-spec-mode"))
-(custom-add-loads 'compilation-elisp '("mode-compile"))
-(custom-add-loads 'compilation '("mode-compile"))
-(custom-add-loads 'SQL '("sql"))
-(custom-add-loads 'makemode '("make-mode"))
-(custom-add-loads 'vrml '("vrml-mode"))
-(custom-add-loads 'simula '("simula"))
-(custom-add-loads 'compile-java '("mode-compile"))
-(custom-add-loads 'compile-python '("mode-compile"))
-(custom-add-loads 'compile-csh '("mode-compile"))
-(custom-add-loads 'verilog-mode-auto '("verilog-mode"))
-(custom-add-loads 'eiffel-indent '("eiffel"))
-(custom-add-loads 'development '("mode-compile"))
-(custom-add-loads 'font-lock-highlighting-faces '("verilog-mode"))
-(custom-add-loads 'languages '("asm-mode" "icon" "javascript-mode" "lua-mode" "mode-compile" "modula2" "pascal" "php-mode" "prolog" "rexx-mode" "rpm-spec-mode" "simula" "tcl" "verilog-mode" "vrml-mode"))
-(custom-add-loads 'compilation-lang '("mode-compile"))
-(custom-add-loads 'faces '("make-mode" "rpm-spec-mode"))
-(custom-add-loads 'javascript '("javascript-mode"))
-(custom-add-loads 'compile-zsh '("mode-compile"))
-(custom-add-loads 'processes '("sql"))
-(custom-add-loads 'rexx '("rexx-mode"))
-(custom-add-loads 'eiffel-compile '("eiffel"))
-(custom-add-loads 'compile-ada '("mode-compile"))
-(custom-add-loads 'p4 '("p4"))
-(custom-add-loads 'compile-c++ '("mode-compile"))
-(custom-add-loads 'compile-tcl '("mode-compile"))
-(custom-add-loads 'c '("mode-compile"))
-(custom-add-loads 'verilog-mode '("verilog-mode"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/cvs.el b/xemacs-packages/lisp/prog-modes/cvs.el
deleted file mode 100644
index 17d302cf..00000000
--- a/xemacs-packages/lisp/prog-modes/cvs.el
+++ /dev/null
@@ -1,2028 +0,0 @@
-;; cvs.el --- Light cvs support for emacs (ediff + msb + dired + mode line)
-;;
-;; Copyright (C) 1995-1998 Frederic Lepied 
-;;
-;; Author: Frederic Lepied 
-;; Version: $Id: cvs.el,v 1.3 2004/08/15 19:12:35 scop Exp $
-;; Keywords: cvs ediff mode-line
-;;
-;; LCD Archive Entry:
-;; cvs|Frederic Lepied|Frederic.Lepied@sugix.frmug.org|
-;; Light cvs support for emacs (ediff + msb + dired + mode line).|
-;; $Date: 2004/08/15 19:12:35 $|$Revision: 1.3 $|~/modes/cvs.el.gz|
-;;
-;; 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., 675 Mass
-;; Ave, Cambridge, MA 02139, USA.
-;;
-;; Purpose of this package:
-;;   1. Display CVS revision in mode line.
-;;   2. Compare file changes between CVS revisions using ediff.
-;;   3. Some keystrokes and menu entries to execute cvs status, cvs log and
-;; cvsann (Thanks to Ray Nickson ).
-;;   4. Simple interface to cvs commit and cvs update commands.
-;;   5. Status listing per directory courtesy of Stephan Heuel
-;; .
-;;   6. msb support (better buffer selection).
-;;   7. dired support.
-;;   8. softlink tree support.
-;;   9. little module support (status and update).
-;;
-;; Installation:
-;;   put cvs.el in a directory in your load-path and byte compile it.
-;;   then put (require 'cvs) in your .emacs or in site-start.el
-;;
-;; Thanks to Darryl  Okahata  for the module status
-;; enhancements, branch merge new command and the module update new command.
-
-;;=============================================================================
-;; dependencies
-;;=============================================================================
-(require 'easymenu)
-
-;;=============================================================================
-(defconst cvs:version "$Id: cvs.el,v 1.3 2004/08/15 19:12:35 scop Exp $"
-  "Version number of cvs.el. To communicate with bug report")
-
-;;=============================================================================
-(defconst cvs:maintainer-address "cvs-help@sugix.frmug.org"
-  "Address to send any comment, bug or report")
-
-;;=============================================================================
-(defvar cvs:current-revision  nil
-  "Stores the CVS revision number of the file")
-(make-variable-buffer-local 'cvs:current-revision)
-
-;;=============================================================================
-(defvar cvs-temp-dir (or (getenv "TMPDIR")
-			 (getenv "TMP")
-			 (getenv "TEMP"))
-  "* if non nil, `cvs-temp-dir' is the directory where to extract versions.")
-
-;;=============================================================================
-(defvar cvs-command "cvs"
-  "Name of the cvs command including path if needed")
-
-;;=============================================================================
-(defvar cvsann-command "cvsann"
-  "Name of the cvsann command including path if needed")
-
-;;=============================================================================
-(defvar cvs-root nil
-  "*If non nil, `cvs-root' is the base directory of the CVS repository.")
-
-;;=============================================================================
-(defvar cvs-minor-mode-hooks nil
-  "Hooks run when Cvs mode is initialized")
-
-;;=============================================================================
-(defvar cvs-load-hooks nil
-  "Hooks run when cvs.el has been loaded")
-
-;;=============================================================================
-(defvar cvs-commit-hooks nil
-  "Hooks run entering commit buffer")
-
-;;=============================================================================
-(defvar cvs-before-commit-hooks nil
-  "Hooks run before commiting")
-
-;;=============================================================================
-(defvar cvs-add-hooks nil
-  "Hooks run after adding a file into CVS with `cvs-add'")
-
-;;=============================================================================
-(defvar cvs-mark-hooks nil
-  "Hooks run after marking or unmarking a file with `cvs-mark'")
-
-;;=============================================================================
-(defvar cvs-shell-command
-  (if (memq system-type '(ms-dos emx windows-nt))
-      shell-file-name
-    "/bin/sh")
-  "Name of the shell used in cvs commands.
-It is initialized from `shell-file-name' on most systems.
-NB: Not all shells may be adequate as `shell-file-name'.")
-
-;;=============================================================================
-(defvar cvs-shell-command-option
-  (cond ((memq system-type '(ms-dos windows-nt))
-         (if (boundp 'shell-command-switch)
-             shell-command-switch
-           "/c"))
-        (t                              ;Unix & EMX (Emacs 19 port to OS/2)
-         "-c"))
-  "Shell argument indicating that next argument is the command.
-It is initialized from `shell-command-switch' on most systems.
-NB: Not all shells may have an adequate `shell-command-switch'.")
-
-;;=============================================================================
-(defvar cvs-file-option "-F"
-  "CVS option to read log from a file.
-Some CVS versions need \"-f\" others need \"-F\".")
-
-;;=============================================================================
-(defvar cvs-diff-options ()
-  "*Optional arguments passed to the cvs diff command (`cvs-diff').
-For example you can do unified diff with '(\"-u\").")
-
-;;=============================================================================
-(defvar cvs-no-log-option nil
-  "CVS option not to log the cvs_command in the command history.")
-
-;;=============================================================================
-(defvar cvs-never-use-emerge nil
-  "* don't merge update conflicts with emerge function from ediff package if set to t.")
-
-;;=============================================================================
-(defvar cvs-ediff-merge-no-cleanup nil
-  "*If not nil, do not rename *ediff-merge* buffer after the merge.")
-
-;;=============================================================================
-(defvar cvs-save-prefix ".#"
-  "prefix used by cvs to save a file if there are conflicts while updating")
-
-;;=============================================================================
-;; minor mode status variable (buffer local).
-;;=============================================================================
-(defvar cvs-minor-mode nil
-  "Status variable to switch to CVS minor mode if sets to t")
-(make-variable-buffer-local 'cvs-minor-mode)
-(put 'cvs-minor-mode 'permanent-local t)
-
-;;=============================================================================
-(defvar cvs-minor-mode-in-modeline t
-  "If non-nil display the version number in the modeline.
-This variable has to be set before loading the package cvs.el.")
-
-;;=============================================================================
-;; minor mode status variable (buffer local).
-;;=============================================================================
-(defvar cvs:mark nil
-  "Status variable to say if a file will be commited in the next commit command.")
-(make-variable-buffer-local 'cvs:mark)
-(put 'cvs:mark 'permanent-local t)
-
-;;=============================================================================
-(defvar cvs:marked-list nil
-  "List of marked files. See `cvs-mark'")
-
-(defvar cvs:commit-list nil
-  "List of files uppon which to perform cvs commit")
-
-;;=============================================================================
-;; minor mode entry point.
-;;=============================================================================
-(defun cvs-minor-mode (&optional arg)
-  "
-Help to admin CVS controlled files :
-	\\[cvs-log]		display cvs log output.
-	\\[cvs-file-status]		display cvs status output.
-	\\[cvs-annotate]		display cvs annotate output.
-	\\[cvs-history]		display cvs history output.
-	\\[cvs-who]		display who is responsable of the selected region.
-	\\[cvs-description]		change the description message.
-	\\[cvs-change-log]		change a log message.
-	\\[cvs-edit]		run the cvs edit or unedit command.
-	\\[cvs-ediff-internal]		run ediff between current file and a revision.
-	\\[cvs-ediff]		run ediff between two revisions of the file.
-	\\[cvs-diff]		display diff between current file and a revision.
-	\\[cvs-version-other-window]		retrieve a specified version in an other window.
-	\\[cvs-update-file]		update the file from the repository.
-	\\[cvs-revert]		revert the file to a previous version from the repository.
-	\\[cvs-merge-backup]		run a merger to remove conflict from the update process.
-	\\[cvs-mark]		add/remove a file to the marked list (toggle).
-	\\[cvs-flush]		make the marked list empty.
-	\\[cvs-commit]		perform the cvs commit command on the marked list.
-	\\[cvs-commit-file]		perform the cvs commit command on the current file.
-	\\[cvs-status-process]		display the status of the files in the current module.
-	\\[cvs-marked-status]		display the status of the marked files.
-	\\[cvs-submit-report]		send a bug/comment report to the cvs.el maintainer."
-  (setq cvs-minor-mode (if (null arg) t (car arg)))
-  (if cvs-minor-mode
-      (progn
-	(easy-menu-add cvs:menu cvs:map)
-	(run-hooks 'cvs-minor-mode-hooks)))
-  cvs-minor-mode)
-
-;;=============================================================================
-;; register cvs minor mode keymap and mode line display.
-;;=============================================================================
-(defvar cvs:map (make-sparse-keymap)
-  "CVS minor mode keymap")
-
-(defvar cvs:commit-map (make-sparse-keymap)
-  "CVS commit edition buffer keymap")
-
-(define-key cvs:map "\C-cvW" 'cvs-who)
-(define-key cvs:map "\C-cvo" 'cvs-log)
-(define-key cvs:map "\C-cvs" 'cvs-file-status)
-(define-key cvs:map "\C-cve" 'cvs-editors)
-(define-key cvs:map "\C-cvw" 'cvs-watchers)
-(define-key cvs:map "\C-x\C-q" 'cvs-edit)
-(define-key cvs:map "\C-cvU" 'cvs-update-directory)
-(define-key cvs:map "\C-cvS" 'cvs-status-process)
-(define-key cvs:map "\C-cvM" 'cvs-marked-status)
-(define-key cvs:map "\C-cvB" 'cvs-merge-branch)
-(define-key cvs:map "\C-cvL" 'cvs-status-mark-changed)
-(define-key cvs:map "\C-cvd" 'cvs-ediff-internal)
-(define-key cvs:map "\C-cvi" 'cvs-diff)
-(define-key cvs:map "\C-cv\C-d" 'cvs-ediff)
-(define-key cvs:map "\C-cvv" 'cvs-version-other-window)
-(define-key cvs:map "\C-cvm" 'cvs-mark)
-(define-key cvs:map "\C-cvc" 'cvs-commit)
-(define-key cvs:map "\C-cvC" 'cvs-commit-file)
-(define-key cvs:map "\C-cvl" 'cvs-list)
-(define-key cvs:map "\C-cvf" 'cvs-flush)
-(define-key cvs:map "\C-cvu" 'cvs-update-file)
-(define-key cvs:map "\C-cvr" 'cvs-revert)
-(define-key cvs:map "\C-cvb" 'cvs-submit-report)
-(define-key cvs:map "\C-cvh" 'cvs-history)
-(define-key cvs:map "\C-cva" 'cvs-annotate)
-(define-key cvs:commit-map "\C-c\C-c" 'cvs-do-commit)
-(define-key cvs:commit-map "\C-c\C-d" 'cvs-bury-buffer)
-(define-key cvs:commit-map "\C-cvl" 'cvs-list)
-(easy-menu-define
- cvs:menu
- cvs:map
- "CVS minor mode keymap"
- '("CVS"
-    ["Update File" cvs-update-file t]
-    ["Commit File" cvs-commit-file t]
-    ["(Un)Edit" cvs-edit t]
-    ["Log" cvs-log t]
-    ["Annotate" cvs-annotate t]
-    ["History" cvs-history t]
-    ["File Status" cvs-file-status t]
-    ["Editors" cvs-editors t]
-    ["Watchers" cvs-watchers t]
-    ["EDiff" cvs-ediff-internal t]
-    ["Diff" cvs-diff t]
-    "-----------" 
-    ["Module Status" cvs-status-process t]
-    ["Update Module" cvs-update-directory t]
-    "-----------" 
-    ("Marking Files" 
-     ["(Un)Mark current buffer" cvs-mark t]
-     ["Show List" cvs-list t]
-     ["Flush List" cvs-flush t]
-     )
-    ("Action on Marked Files"
-     ["Commit" cvs-commit t]
-     ["Show Status" cvs-marked-status t]
-     )
-    ("Other Commands" 
-     ["EDiff two revs" cvs-ediff t]
-     ["Restore version" cvs-revert t]
-     ["Merge backup" cvs-merge-backup t]
-     ["Merge branch" cvs-merge-branch t]
-     ["Retrieve version" cvs-version-other-window t]
-     ["Change description" cvs-description t]
-     ["Change log message" cvs-change-log t]
-     ["Who" cvs-who t])
-    "--------" 
-    ["Send bug/comment report" cvs-submit-report t]))
-
-(defconst cvs:entry
-  (list 'cvs-minor-mode (cons "" '(" CVS:" cvs:current-revision)))
-  "Entry to display CVS revision number in mode line")
-
-(or (assq 'cvs-minor-mode minor-mode-alist)
-    (not cvs-minor-mode-in-modeline)
-    (setq minor-mode-alist (cons cvs:entry minor-mode-alist)))
-
-(or (assq 'cvs-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist (cons (cons 'cvs-minor-mode cvs:map)
-				     minor-mode-map-alist)))
-
-;;=============================================================================
-(defconst cvs:mark-entry
-  (list 'cvs:mark " marked")
-  "Entry to display CVS revision number in mode line")
-
-(or (assq 'cvs:mark minor-mode-alist)
-    (setq minor-mode-alist (cons cvs:mark-entry minor-mode-alist)))
-
-;;=============================================================================
-(defvar cvs:remote-regexp "^/[^/:]*[^/:]:"
-  "regexp to test if a file is accessed from ftp")
-
-(defun is-under-cvs ()
-  "Test if the file in the current buffer is under CVS.
-If so, set the variables `cvs:current-revision' and `cvs-minor-mode'."
-  (interactive)
-  (let ((result nil)
-	current-revision)
-    (if (and buffer-file-name
-	     (not (string-match cvs:remote-regexp buffer-file-name))) ; reject remote files
-	(progn
-	  (save-excursion
-	    (let* ((filename (file-truename buffer-file-name))
-		   (buffer (current-buffer))
-		   (entries-filename (concat (file-name-directory
-					      filename)
-					     "CVS/Entries")))
-	      (if (file-exists-p entries-filename)
-		  (progn
-		    (set-buffer (cvs:find-file-noselect entries-filename))
-		    (goto-char 1)
-		    (if (re-search-forward (concat "^/" 
-						   (file-name-nondirectory filename)
-						   "/\\([^/]*\\)/")
-					   nil t)
-			(progn
-			  (setq result t)
-			  (setq current-revision (buffer-substring
-						  (match-beginning 1)
-						  (match-end 1)))
-			  (if (looking-at ".*/T\\([^/\n][^/\n]*\\)[ \t]*\n")
-			      (let ( (tag (buffer-substring (match-beginning 1)
-							    (match-end 1))) )
-				(setq current-revision
-				      (format "%s-%s" tag current-revision))
-				))
-			  )
-		      )
-		    ))))
-		))
-    (if result
-	(progn
-	  (setq cvs:current-revision current-revision)
-	  (cvs-minor-mode)))
-    result))
-
-
-(defun cvs:get-numeric-revision (revision)
-  (progn
-    (if (string-match "-\\([.0-9][.0-9]*\\)$" revision)
-	(setq revision (match-string 1 revision)))
-    revision
-    ))
-
-
-(defun cvs:get-tag-revision (revision)
-  (let ( (case-fold-search t) )
-    (if (string-match "^\\([a-z].*\\)-[.0-9][.0-9]*$" revision)
-	(setq revision (match-string 1 revision)))
-    revision
-    ))
-
-;;=============================================================================
-(defun cvs-ediff (old-rev new-rev)
-  "Run Ediff between versions `old-rev' and `new-rev' of the current buffer."
-  (interactive "sFirst version to visit (default is latest version): 
-sSecond version to visit (default is latest version): ") 
-  (let ((old-vers (cvs-version-other-window old-rev)))
-    (other-window 1)
-    (cvs-version-other-window new-rev)
-    ;; current-buffer is now supposed to contain the old version
-    ;; in another window
-    ;; We delete the temp file that was created by vc.el for the old
-    ;; version
-    (ediff-buffers old-vers (current-buffer)
-		   (list (` (lambda () (delete-file (, (buffer-file-name))))))
-		   'ediff-revision)
-    ))
-
-;;=============================================================================
-(defun cvs-ediff-internal (rev)
-  "Run Ediff on version REV of the current buffer in another window.
-If the current buffer is named `F', the version is named `F.~REV~'.
-If `F.~REV~' already exists, it is used instead of being re-created."
-  (interactive "sVersion to visit (default is latest version): ")
-  (let ((newvers (current-buffer)))
-    (cvs-version-other-window rev)
-    ;; current-buffer is now supposed to contain the old version
-    ;; in another window
-    ;; We delete the temp file that was created by vc.el for the old
-    ;; version
-    (ediff-buffers (current-buffer) newvers
-		   (list (` (lambda () (delete-file (, (buffer-file-name))))))
-		   'ediff-revision)
-    ))
-
-;;=============================================================================
-(defun cvs-version-other-window (rev)
-  "Visit version REV of the current buffer in another window.
-If the current buffer is named `F', the version is named `F.~REV~'.
-If `F.~REV~' already exists, it is used instead of being re-created."
-  (interactive "sVersion to visit (default is latest version): ")
-  (if buffer-file-name
-      (let* ((version (if (string-equal rev "")
-			  "lst"
-			rev))
-	     (filename (if cvs-temp-dir
-			   (concat (file-name-as-directory cvs-temp-dir)
-				   (file-name-nondirectory buffer-file-name)
-				   ".~" version "~")
-			 (concat buffer-file-name ".~" version "~"))))
-	(if (or (file-exists-p filename)
-		(cvs:checkout (file-name-nondirectory buffer-file-name) rev
-			      filename))
-	    (find-file-other-window filename)))))
-
-;;=============================================================================
-(defun cvs:checkout (filename rev output-name)
-  "Checkout filename with revision `rev' to `output-name'."
-  (let ((command (if (string= rev "")
-		     (format "%s %s %s -Q update -p %s > %s" cvs-command
-			     (if cvs-root
-				 (format "-d %s" cvs-root) "")
-			     (if cvs-no-log-option
-				 cvs-no-log-option "")
-			     filename output-name)
-		     (format "%s %s %s -Q update -r %s -p %s > %s" cvs-command
-			     (if cvs-root
-				 (format "-d %s" cvs-root) "")
-			     (if cvs-no-log-option
-				 cvs-no-log-option "")
-			     rev filename output-name))))
-    (message "Retrieving version with command : %s" command)
-    (if (/= (call-process cvs-shell-command nil nil t cvs-shell-command-option command)
-	    0)
-	(error "Error while retrieving %s version of %s into %s"
-	       (if (string= "" rev) "last" rev) filename output-name)
-      output-name)))
-
-;;=============================================================================
-(defun cvs-add (msg &optional file)
-  "Add the current file into the CVS system"
-  (interactive "sEnter description : ")
-  (if (not file)
-      (setq file (buffer-file-name)))  
-  (let ((command (format "%s %s add -m \"%s\" %s" cvs-command
-			 (if cvs-root
-			     (format "-d %s" cvs-root) "")
-			 msg
-			 (file-name-nondirectory file)))
-	(filename (file-name-nondirectory file))
-	(buf (get-buffer-create "*CVS Add output*")))
-    (save-excursion
-      (set-buffer buf)
-      (setq buffer-read-only nil)
-      (erase-buffer))
-    (if (= (call-process cvs-shell-command nil buf t cvs-shell-command-option command)
-	   0)
-	(progn
-	  (is-under-cvs)
-	  (run-hooks 'cvs-add-hooks)
-	  (message "File added to CVS -- use 'commit' to make permanent")
-	  )
-      (cvs:display-temp-buffer buf "add")
-      (error "Error while registering %s into CVS" filename))))
-
-;;=============================================================================
-;; Change CVS description or log message
-;;=============================================================================
-(defvar cvs:temp-filename nil
-  "Internal variable used by cvs-description and cvs-change-log")
-(make-variable-buffer-local 'cvs:temp-filename)
-(put 'cvs:temp-filename 'permanent-local t)
-
-(defvar cvs:temp-revision nil
-  "Internal variable used by cvs-description and cvs-change-log")
-(make-variable-buffer-local 'cvs:temp-revision)
-(put 'cvs:temp-revision 'permanent-local t)
-
-(defun cvs:get-description (file)
-  (cvs:call-command cvs-command "*CVS temp*" "log"
-		    (list "log" "-r0" (file-name-nondirectory file)))
-  (save-excursion
-    (set-buffer "*CVS temp*")
-    (goto-char (point-min))
-    (if (not (search-forward-regexp "^description:" nil t))
-	(error "Invalid log output for file %s" rev file)
-      (let* ((min (progn
-		    (next-line 1) (beginning-of-line) (point)))
-	     (max (progn
-		    (search-forward "======================================")
-		    (beginning-of-line) (point)))
-	     (str (buffer-substring min max)))
-	(kill-buffer "*CVS temp*")
-	str))))
-
-(defun cvs-description (&optional file)
-  "Change the description of the current file into the CVS system"
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (let ((dir default-directory)
-	(str  (cvs:get-description file)))
-    (switch-to-buffer-other-window (get-buffer-create "*CVS Description*"))
-    (setq cvs:temp-filename file)
-    (setq default-directory dir)
-    (erase-buffer)
-    (insert str)
-    (insert "CVS: ----------------------------------------------------------------------\n")
-    (insert "CVS: Enter description.  Lines beginning with `CVS: ' are removed automatically\n")
-    (insert "CVS: changing description of " file "\n")
-    (insert "CVS: ----------------------------------------------------------------------\n")
-    (local-set-key "\C-c\C-c" 'cvs:do-description)
-    (goto-char 0)
-    (message "Type C-c C-c when done.")
-    ))
-
-(defun cvs:do-description ()
-  "Change the description of the current file into the CVS system"
-  (interactive)
-  (let ((msg nil)
-	(file-name cvs:temp-filename))
-    (goto-char 0)
-    (flush-lines "^CVS: .*$")
-    (setq msg (buffer-string))
-    (cvs-bury-buffer)
-    (let ((command (format "%s %s admin -t-\"%s\" %s" cvs-command
-			   (if cvs-root
-			       (format "-d %s" cvs-root) "")
-			   msg
-			   (file-name-nondirectory file-name)))
-	  (filename (file-name-nondirectory file-name))
-	  (buf (get-buffer-create "*CVS Admin output*")) )
-      (save-excursion
-	(set-buffer buf)
-	(setq buffer-read-only nil)
-	(erase-buffer))
-      (if (not (= (call-process cvs-shell-command nil buf t cvs-shell-command-option command)
-		  0))
-	  (progn
-	    (cvs:display-temp-buffer buf "admin")
-	    (error "Error while changing description of %s into CVS" filename))))))
-
-;;=============================================================================
-(defun cvs:get-change-log (file rev)
-  (cvs:call-command cvs-command "*CVS temp*" "log"
-		    (list "log" (concat "-r" rev) (file-name-nondirectory file)))
-  (save-excursion
-    (set-buffer "*CVS temp*")
-    (goto-char (point-min))
-    (if (not (search-forward-regexp "^date: " nil t))
-	(error "Revision %s doesn't exist for file %s" rev file)
-      (let* ((min (progn
-		    (next-line 1) (beginning-of-line) (point)))
-	     (max (progn
-		    (search-forward "======================================")
-		    (beginning-of-line) (point)))
-	     (str (buffer-substring min max)))
-	(kill-buffer "*CVS temp*")
-	str))))
-
-(defun cvs-change-log (rev &optional file)
-  "Change the description of the current file into the CVS system"
-  (interactive "sVersion (default is current version): ")
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (if (string= "" rev) 
-      (setq rev cvs:current-revision))
-  (let ((dir default-directory)
-	(str (cvs:get-change-log file rev)))
-    (switch-to-buffer-other-window (get-buffer-create "*CVS Description*"))
-    (setq cvs:temp-filename file)
-    (setq cvs:temp-revision rev)
-    (setq default-directory dir)
-    (erase-buffer)
-    (insert str)
-    (insert "CVS: ----------------------------------------------------------------------\n")
-    (insert "CVS: Enter Log.  Lines beginning with `CVS: ' are removed automatically\n")
-    (insert "CVS: changing log message of " file " for revision " rev "\n")
-    (insert "CVS: ----------------------------------------------------------------------\n")
-    (local-set-key "\C-c\C-c" 'cvs:do-change-log)
-    (goto-char 0)
-    (message "Type C-c C-c when done.")
-    ))
-
-(defun cvs:do-change-log ()
-  "Change the description of the current file into the CVS system"
-  (interactive)
-  (let ((msg nil)
-	(file-name cvs:temp-filename)
-	(rev cvs:temp-revision))
-    (goto-char 0)
-    (flush-lines "^CVS: .*$")
-    (setq msg (buffer-string))
-    (cvs-bury-buffer)
-    (let ((command (format "%s %s admin -m%s:\"%s\" %s" cvs-command
-			   (if cvs-root
-			       (format "-d %s" cvs-root) "")
-			   rev
-			   msg
-			   (file-name-nondirectory file-name)))
-	  (filename (file-name-nondirectory file-name))
-	  (buf (get-buffer-create "*CVS Admin output*")) )
-      (save-excursion
-	(set-buffer buf)
-	(setq buffer-read-only nil)
-	(erase-buffer))
-      (if (not (= (call-process cvs-shell-command nil buf t cvs-shell-command-option command)
-		  0))
-	  (progn
-	    (cvs:display-temp-buffer buf "admin")
-	    (error "Error while changing log message of %s into CVS" filename))))))
-
-;;=============================================================================
-(defun cvs-edit (&optional file)
-  "Run the cvs edit or unedit command on the file.
-If the file is read-only, runs the edit command else runs the unedit command."
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (let* ((revision cvs:current-revision)
-	 (filename (file-truename file))
-	 (default-directory (file-name-directory (expand-file-name filename)))
-	 (comm (if (file-writable-p file) "unedit" "edit"))
-	 (command-args (if cvs-root
-			   (list "-d" cvs-root comm
-				 (file-name-nondirectory filename))
-			 (list comm (file-name-nondirectory
-				     filename)) ))
-	(buf (get-buffer-create " *CVS Edit output*")) )
-    (save-excursion
-      (set-buffer buf)
-      (setq buffer-read-only nil)
-      (erase-buffer))
-    (if (= (apply 'call-process cvs-command nil buf t command-args) 0)
-	(let ((file-buf (get-file-buffer file)))
-	  (if file-buf
-	      (save-excursion
-		(set-buffer file-buf)
-		(revert-buffer t t))))
-      (cvs:display-temp-buffer buf "edit")
-      (error "Error while editing %s"
-	     (file-name-nondirectory filename)))))
-
-;;=============================================================================
-(defun cvs-update-file (&optional file)
-  "Update the current file from the repository"
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (save-buffer)
-  (let* ((revision (cvs:get-numeric-revision cvs:current-revision))
-	 (filename (file-truename file))
-	 (default-directory (file-name-directory (expand-file-name filename)))
-	 (command-args (if cvs-root
-			   (list "-d" cvs-root "update"
-				(file-name-nondirectory filename))
-			 (list "update" (file-name-nondirectory
-					 filename))))
-	 (buf (get-buffer-create "*CVS Update output*")))
-    (save-excursion
-      (set-buffer buf)
-      (setq buffer-read-only nil)
-      (erase-buffer))
-    (if (= (apply 'call-process cvs-command nil buf t command-args) 0)
-	(progn
-	  (cvs:merge-or-revert buf filename revision)
-	  (if (not (string-equal file filename))
-	      (let ((file-buf (get-file-buffer file)))
-		(if file-buf
-		    (save-excursion
-		      (set-buffer file-buf)
-		      (revert-buffer t t)))))
-	  (message (format "Updated \"%s\"" file))
-	  )
-      (cvs:display-temp-buffer buf "update")
-      (error "Error while updating %s"
-	     (file-name-nondirectory filename)))))
-
-;;=============================================================================
-(defun cvs-update-directory ()
-  "Update the current directory from the repository"
-  (interactive)
-  (let ((command-args (if cvs-root
-			  (list "-d" cvs-root "update")
-			(list "update")))
-	(buf (get-buffer-create "*CVS Update output*")))
-    (and (or (not (memq t (mapcar #'(lambda (buf) (and (buffer-file-name buf)
-						       (buffer-modified-p buf)))
-				  (buffer-list))))
-	     (yes-or-no-p "Modified buffers exist; update anyway? "))
-	 (progn
-	   (save-excursion
-	     (set-buffer buf)
-	     (setq buffer-read-only nil)
-	     (erase-buffer))
-	   (pop-to-buffer buf)
-	   (if (= (apply 'call-process cvs-command nil buf t command-args) 0)
-	       (progn
-		 (goto-char (point-max))
-		 (insert "\ncvs update finished.\n")
-		 (cvs:display-temp-buffer buf "update")
-		 )
-	     (progn
-	       (goto-char (point-max))
-	       (insert "\ncvs update finished with errors.\n")
-	       (cvs:display-temp-buffer buf "update")
-	       (error "Error while updating %s" default-directory)))
-	   ))
-    ))
-
-;;=============================================================================
-(defun cvs:merge-convert-symbolic-to-numeric (file name)
-  (let ( (tmpbuf " *CVSrev*")
-	 (cmd-format-args (format "%s %s update -p -r%%s %%s | head > /dev/null"
-				  cvs-command (if cvs-root
-						  (format "-d %s" cvs-root)
-						"")))
-	)
-    (if (string-match "^[a-z]" name)
-	(save-excursion
-	  (setq tmpbuf (get-buffer-create tmpbuf))
-	  (message "Converting symbolic name to numeric (please wait) ...")
-	  (buffer-disable-undo tmpbuf)
-	  (erase-buffer tmpbuf)
-	  (call-process cvs-shell-command nil tmpbuf nil
-                        cvs-shell-command-option
-                        (format cmd-format-args name file))
-	  (set-buffer tmpbuf)
-	  (goto-char (point-min))
-	  (if (not (re-search-forward "^VERS:[ \t]*\\([.0-9][.[0-9]*\\)[ \t]*$"
-				      nil t))
-	      (progn
-		(pop-to-buffer tmpbuf)
-		(error (format "Unable to convert symbolic name \"%s\"!" name))
-		))
-	  (setq name (buffer-substring (match-beginning 1) (match-end 1)))
-	  (kill-buffer tmpbuf)
-	  ))
-    name
-    ))
-
-(defun cvs:merge-query-args ()
-  (let ((case-fold-search t)
-	from to part1 part2
-	(filename (file-name-nondirectory buffer-file-name))
-	)
-    (while (and (setq to (read-from-minibuffer "Branch revision to merge? "))
-		(or (while (string-match "[ \t][ \t]*" to)
-		      (replace-match "" nil nil to))
-		    t)
-		(string-equal to ""))
-      )
-    (setq to (cvs:merge-convert-symbolic-to-numeric filename to))
-    (if (not (string-match "^\\([.0-9][.0-9]*\\)\\.\\([0-9][0-9]*\\)$" to))
-	(error (format "\"%s\" is not a valid revision!") to))
-    (setq part1 (match-string 1 to)
-	  part2 (match-string 2 to))
-    (setq part2 (1- (string-to-number part2)))
-    (if (> part2 0)
-	(progn
-	  (setq from (format "%s.%s" part1 part2))
-	  )
-      (progn
-	(if (not (string-match "^\\([.0-9][.0-9]*\\)\\.[0-9][0-9]*\\.[0-9][0-9]*$" to))
-	    (error (format "Unable to find the previous revision for revision %s!"
-			   to)))
-	(setq from (match-string 1 to))
-	))
-    (while (and (setq from (read-from-minibuffer "Merge back to revision? " from))
-		(or (while (string-match "[ \t][ \t]*" from)
-		      (replace-match "" nil nil from))
-		    t)
-		(string-equal from ""))
-      )
-    (setq from (cvs:merge-convert-symbolic-to-numeric filename from))
-    (if (not (string-match "^\\([.0-9][.0-9]*\\)\\.\\([0-9][0-9]*\\)$" from))
-	(error (format "\"%s\" is not a valid revision!") from))
-    (message (format "From %s to %s" from to))
-    (list from to)
-    ))
-
-
-(defun cvs-merge-branch (branch-from branch-to)
-  "Merge a branch into the current source file."
-  (interactive (cvs:merge-query-args))
-  (save-buffer)
-  (let ( status
-	 (command-args (append (if cvs-root
-				   (list "-d" cvs-root "update")
-				 (list "update"))
-			       (list (format "-j%s" branch-from)
-				     (format "-j%s" branch-to))
-			       (list (file-name-nondirectory buffer-file-name))))
-	 (filename (file-name-nondirectory buffer-file-name))
-	 (buf (get-buffer-create "*CVSmerge*"))
-	 )
-    (message (format "Merging branch %s to %s to %s ..."
-		     branch-from branch-to filename))
-    (save-excursion
-      (set-buffer buf)
-      (setq buffer-read-only nil)
-      (buffer-disable-undo buf)
-      (erase-buffer buf)
-      (display-buffer buf)
-      (sit-for 0)
-      )
-    (setq status (apply 'call-process cvs-command nil buf t command-args))
-    (message "Reverting buffer ...")
-    (revert-buffer t t)
-    (if (not (= status 0))
-	(progn
-	  (cvs:display-temp-buffer buf "branch merge")
-	  (error "Error while merging branch %s to %s to %s"
-		 branch-from branch-to filename)
-	  )
-      (progn
-	(message (format "Merged branch %s to %s to %s"
-			 branch-from branch-to filename))
-	))
-    ))
-
-
-;;=============================================================================
-(defun cvs:merge-or-revert (buf file revision)
-  "Revert the buffer or run `ediff-merge-files-with-ancestor' to merge the conflicts."
-  (let ((conflict (save-excursion
-		    (set-buffer buf)
-		    (goto-char (point-min))
-		    (search-forward "conflicts" nil t)))
-	(filename (file-name-nondirectory file)))
-    (if conflict
-	(message "conflict detected while updating %s" filename))
-    (if (or (not conflict)
-	    cvs-never-use-emerge
-	    (and (or (fboundp 'ediff-merge-files-with-ancestor)
-		     (fboundp 'emerge-files-with-ancestor))
-		 (not (y-or-n-p "Conflicts detected do you want to run emerge ? ")))
-	    )
-	(let ((file-buf (get-file-buffer filename)))
-	  (if file-buf
-	      (save-excursion
-		(set-buffer file-buf)
-		(revert-buffer t t))))
-      (rename-file file (concat filename ".old") t)
-      (rename-file (concat (file-name-directory filename)
-			   cvs-save-prefix
-			   (file-name-nondirectory filename) "." revision)
-		   file t)
-      (let ((ancestor (concat filename ".~" revision "~"))
-	    (new (concat filename ".~lst~")))
-	(cvs:checkout filename revision ancestor)
-	(cvs:checkout filename "" new)
-	(if (fboundp 'ediff-merge-files-with-ancestor)
-	    (progn
-	      (ediff-merge-files-with-ancestor new filename ancestor
-					       (list (` (lambda () 
-							  (delete-file (, ancestor))
-							  (delete-file (, new))))))
-;; 	      (delete-other-windows)
-;; 	      (write-file filename)
-;; 	      (revert-buffer t t)
-	      )
-	  (emerge-files-with-ancestor nil new filename ancestor filename
-				     (list (` (lambda () 
-						(delete-file (, ancestor))
-						(delete-file (, new))))))
-	  ))
-      )))
-
-;;=============================================================================
-;; ediff cleanup
-;;=============================================================================
-(add-hook 'ediff-cleanup-hook 'cvs:ediff-cleanup)
-
-(defun cvs:buffer (buf)
-  (save-excursion
-    (set-buffer buf)
-    (if cvs-minor-mode
-	buf) ) )
-
-(defun cvs:ediff-cleanup (&optional ask)
-  "In merge jobs, kill buffers A, B, and, ancestor. Renames buffer C.
-The buffer C is saved under the filename registered under CVS."
-  (cond ((and (not cvs-ediff-merge-no-cleanup)
-	      ediff-merge-job)
-	 (let ((buf (or (cvs:buffer ediff-buffer-A)
-			(cvs:buffer ediff-buffer-B) )) )
-	   (cond (buf
-		  (save-excursion
-		    (let ((filename (buffer-file-name buf)))
-		      (kill-buffer buf)
-		      (set-buffer ediff-buffer-C)
-		      (write-file filename nil)
-		      (revert-buffer t t) )
-		  ) ))
-	   )
-	 ;; clean all the buffers
-	 (ediff-janitor ask)
-	 )) )
-
-;;=============================================================================
-(defun cvs-merge-backup (&optional file)
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (let* ((filename (file-truename file))
-	 (files (directory-files (file-name-directory filename) nil
-				 (concat "\\.#" (file-name-nondirectory filename) "\\..*")))
-	 )
-    (if (not files)
-	(error "No backup file to merge!"))
-    (if (> 1 (length files))
-	(error "too much backup files (%d)" (length files)))
-    (let ((version (save-excursion
-		     (let ((buf (set-buffer (generate-new-buffer "*CVS work*")))
-			   result)
-		       (insert (car files))
-		       (goto-char 1)
-		       (re-search-forward (concat "\\.#" (file-name-nondirectory filename) "\\.\\(.*\\)$"))
-		       (setq result (buffer-substring (match-beginning 1) (match-end 1)))
-		       (kill-buffer buf)
-		       result))))
-      (if (or (fboundp 'ediff-merge-files-with-ancestor)
-	      (fboundp 'emerge-files-with-ancestor))
-	    (let ((ancestor (concat filename ".~" version "~"))
-		  (new (concat filename ".~lst~")))
-	      (cvs:checkout filename version ancestor)
-	      (cvs:checkout filename "" new)
-	      (if (fboundp 'ediff-merge-files-with-ancestor)
-		  (progn
-		    (ediff-merge-files-with-ancestor new (car files) ancestor
-						     (list (` (lambda () 
-								(delete-file (, ancestor))
-								(delete-file (, new))))))
-		    ;; 	      (delete-other-windows)
-		    ;; 	      (write-file filename)
-		    ;; 	      (revert-buffer t t)
-		    )
-		(emerge-files-with-ancestor nil new (car files) ancestor filename
-					    (list (` (lambda () 
-						       (delete-file (, ancestor))
-						       (delete-file (, new))))))
-		))
-	    )))
-    )
-
-;;=============================================================================
-(defun cvs:repository(&optional filename)
-  "Retrieve repository name of current CVS file"
-  (let ((result nil)
-	(filename (file-truename (or filename buffer-file-name))))
-    (if filename
-	(let ((repository-filename (concat (file-name-directory
-					    filename)
-					   "CVS/Repository")))
-	  (save-excursion
-	    (if (file-exists-p repository-filename)
-		(progn
-		  (set-buffer (cvs:find-file-noselect repository-filename))
-		  (goto-char 1)
-		  (end-of-line)
-		  (setq result (buffer-substring 1 (point)))
-		  )))))
-    result))
-	 
-
-;;=============================================================================
-(defun cvs-log (&optional file)
-  "Show the CVS log for the current buffer's file."
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (cvs:call-command cvs-command "*CVS Log*" "log"
-		    (list "log" (file-name-nondirectory file))))
-
-;;=============================================================================
-(defun cvs-file-status (&optional file)
-  "Show the CVS status information for the current buffer's file."
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (cvs:call-command cvs-command "*CVS Status*" "status"
-		    (list "status" (file-name-nondirectory file)
-			  )))
-
-;;=============================================================================
-(defun cvs-history (&optional file)
-  "Show the CVS history information for the current buffer's file."
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (cvs:call-command cvs-command "*CVS History*" "history"
-		    (list "history" (file-name-nondirectory file)
-			  )))
-
-;;=============================================================================
-(defun cvs-annotate (&optional file)
-  "Show the CVS annotate information for the current buffer's file."
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (let ((buf (cvs:call-command cvs-command "*CVS annotate*" "annotate"
-			       (list "annotate" (file-name-nondirectory
-						 file ) ) ))
-	(mode major-mode))
-    (if (and buf mode)
-	(save-excursion
-	  (set-buffer buf)
-	  (setq major-mode mode)
-	  ))))
-
-;;=============================================================================
-(defun cvs-editors (&optional file)
-  "Show the CVS editors information for the current buffer's file."
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (cvs:call-command cvs-command "*CVS Editors*" "editors"
-		    (list "editors" (file-name-nondirectory file)
-			  )))
-
-;;=============================================================================
-(defun cvs-watchers (&optional file)
-  "Show the CVS watchers information for the current buffer's file."
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (cvs:call-command cvs-command "*CVS Watchers*" "watchers"
-		    (list "watchers" (file-name-nondirectory file)
-			  )))
-
-;;=============================================================================
-(defun cvs-who (start end &optional file)
-  "Who was responsible for the CVS-controlled code in the region?"
-  (interactive "r")
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (save-restriction
-    (widen)
-    (setq start (count-lines 1 start)
-          end   (count-lines 1 end))
-    (let ((fil  (file-name-nondirectory 
-		 (file-name-nondirectory file)))
-          (all  (count-lines 1 (point-max))))
-      (cvs:call-command cvsann-command "*CVS Who*" "who" (list fil))
-      (set-buffer "*CVS Who*")
-      (let ((buffer-read-only nil))
-	(erase-buffer)
-	(cvs:call-command cvsann-command "*CVS Who*" "who" (list fil))
-	(setq buffer-read-only nil)
-	(if (< (count-lines 1 (point-max)) all)
-	    nil
-	  (goto-char 1)
-	  (forward-line end)
-	  (delete-region (point) (point-max))
-	  (goto-char 1)
-	  (forward-line start)
-	  (delete-region 1 (point)))))))
-
-;;=============================================================================
-(defun cvs-diff (rev &optional file)
-  "Run cvs diff with version REV of the current buffer."
-  (interactive "sVersion to visit (default is latest version): ")
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (if (string= "" rev) 
-      (setq rev "HEAD"))
-  (cvs:call-command cvs-command "*CVS Diff*" "diff"
-		    (append (list "diff")
-			    cvs-diff-options
-			    (list "-r" rev (file-name-nondirectory
-					    file)))))
-
-;;=============================================================================
-(defun cvs-revert (rev &optional file)
-  "Revert current file from a version from repository"
-;  (interactive "sVersion to revert from (default is latest version): ")
-  (interactive (list (read-from-minibuffer
-		      "Version to revert from: "
-		      (cvs:get-tag-revision cvs:current-revision))
-		     nil))
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (save-buffer)
-  (if (yes-or-no-p (concat "All your changes on " (file-name-nondirectory
-						   file)
-			   " will be lost! Do you want to continue ? "))
-      (progn
-	(rename-file file (concat file ".old") t)
-	(let (;(revision cvs:current-revision)
-	      (filename file)
-	      (command-args (append (if cvs-root
-					(list "-d" cvs-root "update")
-				      (list "update"))
-				    (cond
-				     ( (or (string= rev "") (string= rev "-A"))
-				       '("-A"))
-				     (t 
-				      (list "-r" rev)))
-				    (list (file-name-nondirectory file))))
-	      (buf (get-buffer-create "*CVS Revert output*")))
-	  (message "Reverting buffer ...")
-	  (save-excursion
-	    (set-buffer buf)
-	    (setq buffer-read-only nil)
-	    (erase-buffer))
-	  (let ((result (apply 'call-process cvs-command nil buf t command-args)))
-	    (revert-buffer t t)
-	    (cond ((not (= result 0))
-		   (cvs:display-temp-buffer buf "revert")
-		   (error "Error while reverting %s"
-			  (file-name-nondirectory file)))
-		  (t
-		   (message (format "Reverted \"%s\"" file)))
-		  )
-	    )))))
-
-;;=============================================================================
-(defun cvs-mark (&optional file)
-  "(Un)Mark the current file to be committed in the commit command (toggle)."
-  (interactive)
-  (if (not file)
-      (setq file (buffer-file-name)))
-  (if (not (member file cvs:marked-list))
-      (progn
-	(setq cvs:marked-list (cons file cvs:marked-list))
-	(setq cvs:mark t))
-    (setq cvs:marked-list (delete file cvs:marked-list))
-    (setq cvs:mark nil))
-  (run-hooks 'cvs-mark-hooks)
-  (force-mode-line-update))
-
-;;=============================================================================
-(defun cvs-flush-file (file)
-  "Flush a single file."
-  (if (get-file-buffer file)
-      (save-excursion
-	(set-buffer (get-file-buffer file))
-	(setq cvs:mark nil)))
-  )
-
-(defun cvs-flush ()
-  "Flush the list of files to be committed."
-  (interactive)
-  (mapcar 'cvs-flush-file cvs:commit-list)
-  (mapcar 'cvs-flush-file cvs:marked-list)
-  (setq cvs:marked-list nil)
-  (setq cvs:commit-list nil)
-  (message "Flushed file list")
-  (force-mode-line-update t))
-
-;;=============================================================================
-(defun cvs-commit (&optional l)
-  "Setup a buffer to enter comment associated with the commit process." 
-  (interactive)
-  (if (not l)
-      (setq l cvs:marked-list))
-  (setq cvs:commit-list (if (null l)
-			    (list buffer-file-name)
-			  l))
-  (let ((dir default-directory))
-    (switch-to-buffer-other-window (get-buffer-create "*CVS Commit*"))
-    (setq default-directory dir)
-    (erase-buffer)
-    (insert "\n")
-    (insert "CVS: ----------------------------------------------------------------------\n")
-    (insert "CVS: Enter Log.  Lines beginning with `CVS: ' are removed automatically\n")
-    (insert "CVS: committing files:\n")
-    (mapcar (function (lambda(c)
-			(insert "CVS: " c "\n")))
-		cvs:commit-list)
-    (insert "CVS: \n")
-    (insert "CVS: Type C-c C-c when done or C-c C-d to abort.\n")
-    (insert "CVS: ----------------------------------------------------------------------\n")
-
-    (use-local-map cvs:commit-map)
-    (goto-char 0)
-    (run-hooks 'cvs-commit-hooks)
-    (message "Type C-c C-c when done or C-c C-d to abort.")
-    ))
-
-;;=============================================================================
-(defun cvs-do-commit ()
-  "Commit the list of files cvs:marked-list"
-  (interactive)
-  (cvs:save)
-  (goto-char 0)
-  (flush-lines "^CVS: .*$")
-  (run-hooks 'cvs-before-commit-hooks)
-  (let* ((filename (make-temp-name (concat (or (and cvs-temp-dir
-						    (file-name-as-directory cvs-temp-dir))
-					       "/tmp/")
-					   "cvs")))
-	 (command-list (if cvs-root
-			   (list "-d" cvs-root "commit" cvs-file-option filename)
-			 (list "commit" cvs-file-option filename))))
-    (write-region (point-min) (point-max) filename)
-    (cvs-bury-buffer)
-    (let ((buf (set-buffer (get-buffer-create "*CVS Commit output*"))))
-      (setq buffer-read-only nil)
-      (goto-char (point-max))
-      (mapcar
-       (lambda(elt)
-	 (setq default-directory (car elt))
-	 (message "Committing in %s..." (car elt))
-	 (if (/= (apply 'call-process cvs-command nil t t
-			(append command-list (cdr elt)))
-		 0)
-	     (progn
-	       (cvs:display-temp-buffer buf "commit")
-	       (error "Error while committing %S in %s" (cdr elt) (car elt))
-	       ))
-	 (message "Committing in %s...done" (car elt)) )
-       (cvs:files-to-alist cvs:commit-list))
-      (insert "------------------------------------------------------------------------------\n")
-      (cvs:display-temp-buffer buf "commit")
-      (delete-file filename)
-      (save-excursion
-	(mapcar
-	 (lambda(name)
-	   (let ((buf (get-file-buffer name)))
-	     (if buf
-		 (progn
-		   (set-buffer buf)
-		   (revert-buffer t t)))))
-	 cvs:commit-list))))
-  (cvs-flush))
-
-;;=============================================================================
-(defun cvs:files-to-alist(l)
-  "Sort a list of files to an alist containing the directory as the key and
-the list of file names without directory as the value"
-  (let ((alist nil)
-	(elt nil)
-	(file nil))
-    (while l
-      (setq file (file-truename (car l)))
-      (setq elt (assoc (file-name-directory file) alist))
-      (if elt
-	  (setcdr elt
-		   (nconc (cdr elt) (list (file-name-nondirectory file))))
-	(setq alist (cons 
-		     (cons (file-name-directory file)
-			   (list (file-name-nondirectory file)))
-		     alist)))
-      (setq l (cdr l)))
-    alist))
-
-;;=============================================================================
-(defun cvs-list (&optional dir)
-  "List the files to commit cvs:marked-list in a buffer"
-  (interactive)
-  (if (null dir)
-      (setq dir default-directory))
-  (set-buffer (get-buffer-create "*CVS List of marked files to commit*"))
-  (setq buffer-read-only nil)
-  (setq default-directory dir)
-  (erase-buffer)
-  (goto-char (point-min))
-  (insert "Marked file(s):\n\n")
-  (if cvs:marked-list
-      (mapcar (function (lambda(c)
-			  (insert "  ")(insert c)(insert "\n")))
-	      cvs:marked-list)
-    (insert "  ***** No marked files *****\n"))
-  (set-buffer-modified-p nil)
-  (cvs:display-temp-buffer (current-buffer) "list"))
-
-;;=============================================================================
-;; extract from files.el and modified not to ask question to the user if the
-;; file needs to be reloaded.
-;;=============================================================================
-(defun cvs:find-file-noselect (filename)
-  "Read file FILENAME into a buffer and return the buffer.
-If a buffer exists visiting FILENAME, return that one, but
-verify that the file has not changed since visited or saved.
-The buffer is not selected, just returned to the caller."
-  (setq filename
-	(abbreviate-file-name
-	 (expand-file-name filename)))
-  (if (file-directory-p filename)
-      (error "%s is a directory." filename)
-    (let* ((buf (get-file-buffer filename))
-	   (truename (abbreviate-file-name (file-truename filename)))
-	   (number (nthcdr 10 (file-attributes truename)))
-	   ;; Find any buffer for a file which has same truename.
-	   (other (and (not buf) (get-file-buffer filename)))
-	   error)
-      ;; Let user know if there is a buffer with the same truename.
-      (if other
-	  (progn
-	    ;; Optionally also find that buffer.
-	    (if (or find-file-existing-other-name find-file-visit-truename)
-		(setq buf other))))
-      (if buf
-	  (or (verify-visited-file-modtime buf)
-	      (cond ((not (file-exists-p filename))
-		     (error "File %s no longer exists!" filename))
-		    (t
-		     (file-name-nondirectory filename)
-		     (save-excursion
-		       (set-buffer buf)
-		       (revert-buffer t t)))))
-	(save-excursion
-	  (setq buf (create-file-buffer filename))
-	  (set-buffer buf)
-	  (erase-buffer)
-	  (condition-case ()
-	      (insert-file-contents filename t)
-	    (file-error
-	     (setq error t)
-	     ;; Run find-file-not-found-hooks until one returns non-nil.
-	     (let ((hooks find-file-not-found-hooks))
-	       (while (and hooks
-			   (not (and (funcall (car hooks))
-				     ;; If a hook succeeded, clear error.
-				     (progn (setq error nil)
-					    ;; Also exit the loop.
-					    t))))
-		 (setq hooks (cdr hooks))))))
-	  ;; Find the file's truename, and maybe use that as visited name.
-	  (setq buffer-file-truename truename)
-	  (setq buffer-file-number number)
-	  ;; On VMS, we may want to remember which directory in a search list
-	  ;; the file was found in.
-	  (and (eq system-type 'vax-vms)
-	       (let (logical)
-		 (if (string-match ":" (file-name-directory filename))
-		     (setq logical (substring (file-name-directory filename)
-					      0 (match-beginning 0))))
-		 (not (member logical find-file-not-true-dirname-list)))
-	       (setq buffer-file-name buffer-file-truename))
-	  (if find-file-visit-truename
-	      (setq buffer-file-name
-		    (setq filename
-			  (expand-file-name buffer-file-truename))))
-	  ;; Set buffer's default directory to that of the file.
-	  (setq default-directory (file-name-directory filename))
-	  ;; Turn off backup files for certain file names.  Since
-	  ;; this is a permanent local, the major mode won't eliminate it.
-	  (and (not (funcall backup-enable-predicate buffer-file-name))
-	       (progn
-		 (make-local-variable 'backup-inhibited)
-		 (setq backup-inhibited t)))
-	  (after-find-file error t)))
-      buf)))
-
-;;=============================================================================
-;; NB duplicated from misc-fns.el
-;;=============================================================================
-(defun cvs:call-command (program bufname name &optional args)
-  "Call PROGRAM synchronously in a separate process.
-Input comes from /dev/null.
-Output goes to a buffer named BUFNAME, which is created or emptied first, and
-displayed afterward (if non-empty).
-Optional third arg is a list of arguments to pass to PROGRAM."
-  (let ((dir default-directory))
-    (set-buffer (get-buffer-create bufname))
-    (setq default-directory dir)
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (apply 'call-process program nil t nil 
-	   (if cvs-root
-	       (append (list "-d" cvs-root) args)
-	     args))
-    (goto-char 0)
-    (run-hooks (intern (concat "cvs-" name "-hooks")))
-    (cvs:display-temp-buffer (current-buffer) name)))
-
-(defun cvs:display-temp-buffer (buf name)
-  "Display buffer setting it read only, unmodified and binding key q to bury-buffer."
-  (save-excursion
-    (set-buffer buf)
-    (cvs-info-mode name)
-    (set-buffer-modified-p nil)
-    (setq buffer-read-only t))
-  (pop-to-buffer buf)
-  buf)
-
-(defun cvs-bury-buffer (&optional buf)
-  "Bury a buffer even if it is in a dedicated window"
-  (interactive)
-  (if (null buf)
-      (setq buf (current-buffer)))
-  (let ((win (get-buffer-window buf)))
-    (if (window-dedicated-p win)
-	(progn
-	  (delete-windows-on buf t)
-	  (bury-buffer buf))
-      (bury-buffer)
-      (other-window -1))))
-  
-;;=============================================================================
-;; major mode stuff to display CVS info buffers
-;;=============================================================================
-(defvar cvs-info-mode-hooks nil
-  "Hooks run when entering `cvs-info-mode'.")
-
-(defvar cvs-info-mode-map nil
-  "key map used by `cvs-info-mode'.")
-
-(if cvs-info-mode-map
-    ()
-  (require 'dired)
-
-   ;; Inherit from dired map
-  (if (not (fboundp 'set-keymap-parents))
-      ;; FSF way
-      (setq cvs-info-mode-map (cons 'keymap dired-mode-map))
-    ;; XEmacs way
-    (setq cvs-info-mode-map (make-sparse-keymap))
-    (set-keymap-parents cvs-info-mode-map dired-mode-map))
-
-  (define-key cvs-info-mode-map "U" 'cvs-status-update)
-  (define-key cvs-info-mode-map "C" 'cvs-status-mark-and-commit)
-  (define-key cvs-info-mode-map "g" 'cvs-status-process)
-  (define-key cvs-info-mode-map "\C-k" 'cvs-status-delete-file)
-  (define-key cvs-info-mode-map "q" 'cvs-bury-buffer)
-  (define-key cvs-info-mode-map " " 'scroll-up)
-  (define-key cvs-info-mode-map "\177" 'scroll-down)
-)
-
-(defun cvs-info-mode (name)
-  "Major mode to display CVS information buffers.
-Special commands:
-\\{cvs-info-mode-map}
-
-Turning on `cvs-info-mode' runs the hooks `cvs-info-mode-hooks'."
-  (interactive "s")
-  (use-local-map cvs-info-mode-map)
-  (setq cvs-dired-mode t)
-  (setq mode-name (concat "CVS " name))
-  (setq major-mode 'cvs-info-mode)
-  (run-hooks 'cvs-info-mode-hooks)
-)
-
-;;=============================================================================
-(defvar cvs:status-buffer "*CVS-Statuslist*"
-  "Name of the CVS module status buffer")
-
-(defvar cvs:status-file-keymap
-  (let ((m (make-sparse-keymap)))
-    (if (fboundp 'set-keymap-name)
-	(set-keymap-name m 'cvs:status-file-keymap))
-    (if (string-match "XEmacs" emacs-version)
-	(progn
-	  (define-key m 'button2 'dired-mouse-find-file)
-	  (define-key m [return] 'dired-find-file)
-	  ))
-    m)
-  "The keymap used for the highlighted messages in the status buffer.")
-
-(defun cvs-status-get-filename ()
-  (let ( (buf (current-buffer))
-	 (statbuf (get-buffer cvs:status-buffer)) )
-    (if (not (eq buf statbuf))
-	(error "The current buffer is not the Module Status buffer!"))
-    (cvs:get-filename)
-    ))
-
-(defun cvs-status-update ()
-  "Update all files that are marked as needing update."
-  (interactive)
-  (let (filename (statbuf (get-buffer cvs:status-buffer)) (filecount 0))
-    (message "Updating files ...")
-    (save-excursion
-      (if (not statbuf)
-	  (error "The CVS Module Status buffer does not exist!"))
-      (set-buffer statbuf)
-      (goto-char (point-min))
-      (while (re-search-forward "^ *[*] *Needs \\(Update\\|Patch\\)" (point-max) t)
-	(setq filename (expand-file-name (cvs-status-get-filename)))
-	(find-file-noselect filename)
-	(cvs-update-file filename)
-	(setq filecount (1+ filecount))
-	)
-      (message (format "Updated %d files" filecount))
-      )
-    ))
-
-(defun cvs-status-mark-changed (&optional no-display)
-  "Mark all Locally changed files in the Module Status buffer"
-  (interactive)
-  (let (filename (statbuf (get-buffer cvs:status-buffer)) (filecount 0)
-		 (oldcount (length cvs:marked-list)))
-    (save-excursion
-      (if (not statbuf)
-	  (error "The CVS Module Status buffer does not exist!"))
-      (set-buffer statbuf)
-      (goto-char (point-min))
-      (while (re-search-forward "^ *[*] *Locally " (point-max) t)
-	(setq filename (expand-file-name (cvs:get-filename)))
-	(if (not (member filename cvs:marked-list))
-	    (save-excursion
-	      (let ( (buf (get-file-buffer filename)) )
-		(if buf
-		    (set-buffer buf))
-		(cvs-mark filename)
-		(setq filecount (1+ filecount))
-		)))
-	)
-      (if (not no-display)
-	  (cvs-list))
-      (message (format "Marked %d new files, %d files already marked"
-		       filecount oldcount))
-      )
-    ))
-
-(defun cvs-status-mark-and-commit ()
-  "Mark and commit all Locally changed files in the Module Status buffer"
-  (interactive)
-  (cvs-status-mark-changed t)
-  (cvs-dired-commit))
-
-(defun cvs-status-delete-file ()
-  "Delete a file from the Module Status buffer.
-The file is only deleted from the buffer, and not from the disk.
-This command can only be executed from the Module Status buffer."
-  (interactive)
-  (let ( (buf (current-buffer))
-	 (statbuf (get-buffer cvs:status-buffer))
-	 case-fold-search buffer-read-only)
-    (if (not (eq buf statbuf))
-	(error "The current buffer is not the Module Status buffer!"))
-    (save-excursion
-      (beginning-of-line)
-      (if (looking-at " *[*] *[A-Z]")
-	  (progn
-	    (delete-region (point)
-			   (save-excursion
-			     (forward-line 1)
-			     (point)
-			     ))
-	    (set-buffer-modified-p nil)
-	    )
-	(error "No file on this line")
-	)
-      )
-    ))
-
-(defun cvs:status-filter (proc string)
-  "Filter for the cvs update process"
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (let ((buffer-read-only nil)
-	  (buf (get-buffer cvs:status-buffer))
-	  (start (process-mark proc))
-	  )
-      (goto-char (point-max))
-      (insert string)
-      (goto-char start)
-      (while (re-search-forward "^\\([A-Z?]\\) \\(.*\\)" (point-max) t)
-	(let* ((status (elt (buffer-substring (match-beginning 1) (match-end 1)) 0))
-	       (filename (buffer-substring (match-beginning 2) (match-end 2)))
-	       (status-name (cond
-			     ((eq status ?U) "Needs Update")
-			     ((eq status ?P) "Needs Patch")
-			     ((eq status ?A) "Locally Added")
-			     ((eq status ?R) "Locally Removed")
-			     ((eq status ?M) "Locally Modified")
-			     ((eq status ?C) "Conflict")
-			     ((eq status ??) "Unknown")
-			     (t (concat "Invalid " status)) )) )  
-	  (save-excursion
-	    (set-buffer buf)
-	    (goto-char (point-max))
-	    (let ( (buffer-read-only nil) 
-		   begin end extent)
-	      (if (fboundp 'make-extent)
-		  (progn
-		    (insert (format "  * %-17s : " status-name))
-		    (setq begin (point))
-		    (insert filename)
-		    (setq end (point))
-		    (insert "\n")
-		    (setq extent (make-extent begin end))
-		    (set-extent-face extent 'bold)
-		    (set-extent-property extent 'highlight t)
-		    (set-extent-property extent 'keymap cvs:status-file-keymap)
-		    )
-		(insert (format "  * %-17s : %s\n" status-name filename)))
-	      ))))
-      (set-marker (process-mark proc) (point))
-      )))
-
-(defun cvs:status-sentinel (process event)
-  "Sentinel for the cvs status process"
-  (save-excursion
-    (let ( (buf (get-buffer cvs:status-buffer))
-	   (oldbuf (current-buffer))
-	   )
-      (set-buffer buf)
-      (goto-char (point-max))
-      (let (buffer-read-only)
-	(insert "=================================================================\n")
-	(insert "    (Status complete)\n\n")
-	(insert
-	 (substitute-command-keys
-	  "Use:
-
-    \\[cvs-status-delete-file]		To delete files from the above list.
-    \\[cvs-status-mark-changed]	To mark all locally-modified, added or deleted files.
-
-    \\[cvs-dired-commit]	To commit all marked files.
-
-    \\[cvs-status-update]		To update all files marked as needing update.
-    \\[cvs-status-mark-and-commit]		To mark and commit all files marked as
-		locally-modified, added or deleted.
-
-    \\[cvs-dired-update-file]	To update the single file under the cursor.
-    \\[cvs-dired-commit-file]	To commit the single file under the cursor.
-"))
-	)
-      (cvs:display-temp-buffer buf "Statuslist")
-      (buffer-enable-undo buf)
-      (kill-buffer (process-buffer process))
-      (pop-to-buffer oldbuf)
-      )))
-
-(defun cvs-status-process (&optional files)
-  "Display the status of the current module files"
-  (interactive)
-  (let* ((args (cons "-d" (if cvs-root
-			      (append (list "-d" cvs-root) files) files)))
-	 (proc-buffer (get-buffer-create " *CVS-Temp*"))
-	 proc
-	 (dir default-directory)
-	 (buf (get-buffer-create cvs:status-buffer)))
-    (buffer-disable-undo proc-buffer)
-    (save-excursion
-      (set-buffer proc-buffer)
-      (erase-buffer))
-    (setq proc (eval (append
-		      (list 'start-process "cvs status" proc-buffer
-			    cvs-command "-n" "update")
-		      args)))
-    (set-process-filter proc 'cvs:status-filter)
-    (set-process-sentinel proc 'cvs:status-sentinel)
-    (set-marker (process-mark proc)
-		(save-excursion (set-buffer proc-buffer)
-				(point-min))
-		proc-buffer)
-    (save-excursion
-      (pop-to-buffer buf)
-      (setq default-directory dir)	; to make dired happy
-      (setq dired-subdir-alist (list (list dir (point-min))))
-      (cvs:display-temp-buffer buf "Statuslist")
-      (let ((buffer-read-only nil))
-	(erase-buffer)
-	(insert (format "%s\n" "Status of files, relative to the directory:"))
-	(insert (format "\t%s\n" dir))
-	(insert "=================================================================\n")
-	)
-      )
-    ))
-
-(defun cvs:current-line ()
-  "Return the current line as an integer."
-  (+ (count-lines (point-min) (point))
-     (if (eq (current-column) 0)
-	 1
-       0)))
-
-(defun cvs:get-filename ()
-  (let ((lineno (cvs:current-line)))
-    (and (not (eq lineno 1)) 
-	 (not (eq lineno 2))
-	 (save-excursion
-	   (beginning-of-line)
-	   (and (re-search-forward "^.+ : \\(.*\\)"
-				   (save-excursion (end-of-line) (point))
-				   t)
-		(buffer-substring (match-beginning 1) (match-end 1)) ) ) )
-    ) )
-
-(require 'advice)
-(defadvice dired-get-filename (around check-mode activate)
-  "Use an alternative function in cvs info mode"
-  (cond ((eq major-mode 'cvs-info-mode)
-	  (setq ad-return-value (cvs:get-filename)))
-	 (t
-	  ad-do-it)))
-
-(defun cvs-marked-status (&optional l)
-  "Show the status of marked files"
-  (interactive)
-  (if (not l)
-      (setq l cvs:marked-list))
-  (cvs-status-process l))
-
-;;=============================================================================
-;; explicitly committing current buffer
-;;=============================================================================
-(defun cvs-commit-file ()
-  "Explicitly commit current buffer.
-Even when there is a nonempty list of marked files.
-This function uses `cvs-commit'."
-  (interactive)
-  (let ((cvs:marked-list nil))
-    (cvs-commit)))
-
-;;=============================================================================
-(defun cvs:save ()
-  "Save the buffers modified in cvs:commit-list"
-  (let ((files cvs:commit-list))
-    (while files
-      (let ((buf (get-file-buffer (car files))))
-	(if (and buf
-		 (buffer-modified-p buf)
-		 (y-or-n-p (concat "Save file " (car files) "? ")))
-	    (save-excursion
-	      (set-buffer buf)
-	      (save-buffer)
-	      ))
-	(setq files (cdr files))))))
-
-;;=============================================================================
-(defun cvs-submit-report ()
-  "Report a problem, a suggestion or a comment about cvs.el"
-  (interactive)
-  (require 'reporter)
-  (reporter-submit-bug-report
-   cvs:maintainer-address
-   (concat "cvs.el " cvs:version)
-   '(cvs-temp-dir
-     cvs-command
-     cvs-root
-     cvs-minor-mode-hooks
-     cvs-load-hooks
-     cvs-commit-hooks
-     cvs-before-commit-hooks
-     cvs-add-hooks
-     cvs-shell-command
-     cvs-shell-command-option
-     cvs-file-option
-     cvs-no-log-option
-     cvs-never-use-emerge
-     cvs-save-prefix)
-   nil
-   (function (lambda()
-	       (insert (concat "\nCVSROOT=" (getenv "CVSROOT") "\n"))
-	       (call-process "cvs" nil t nil "-v")))
-   "Dear cvs.el maintainer,"
-   ))
-
-;;=============================================================================
-(defun cvs:hook ()
-  "`Find-file' and `revert-buffer' hooks for CVS detection.
-If detected, `cvs:hook' positions the ediff variable
-`ediff-version-control' to process diff between CVS revisions."
-  (if (is-under-cvs)
-      (progn
-	(if (not (boundp 'ediff-version-control-package))
-	    (setq ediff-version-control-package 'vc))
-	(make-local-variable 'ediff-version-control-package)
-	(setq ediff-version-control-package 'cvs))))
-
-(add-hook 'find-file-hooks (function cvs:hook))
-(add-hook 'after-revert-hook (function cvs:hook))
-
-;;=============================================================================
-;; msb support
-;;=============================================================================
-(defun cvs:add-msb-submenu ()
-  "Add msb entries to list CVS and CVS marked buffers"
-  (setq msb-menu-cond (append (list '((and (boundp 'cvs-minor-mode)
-					   cvs-minor-mode
-					   'multi)
-				      1015
-				      "CVS (%d)")
-				    '((and (boundp 'cvs-minor-mode)
-					   cvs-minor-mode
-					   cvs:mark
-					   'multi)
-				      1016
-				      "CVS marked files (%d)"))
-			      msb-menu-cond))
-  (add-hook 'cvs-mark-hooks (function (lambda()
-					(menu-bar-update-buffers t)))))
-
-(or (and (featurep 'msb)
-	 (cvs:add-msb-submenu))
-    (add-hook 'msb-after-load-hooks
-	      (function cvs:add-msb-submenu)))
-
-;;=============================================================================
-;; dired support
-;;=============================================================================
-(defun cvs:dired-hook ()
-  "`dired-mode-hook' to add support for cvs in dired buffers"
-  (let ((dir (concat (expand-file-name dired-directory) "CVS")))
-    (if (and (not (string-match cvs:remote-regexp dir))
-	     (file-directory-p dir))
-	(cvs-dired-mode)))
-  )
-
-(add-hook 'dired-mode-hook (function cvs:dired-hook))
-
-(defvar cvs-dired-mode nil
-  "Status variable to switch to CVS minor mode if sets to t")
-(make-variable-buffer-local 'cvs-dired-mode)
-(put 'cvs-dired-mode 'permanent-local t)
-
-(defconst cvs-dired:entry
-  (list 'cvs-dired-mode (cons "" '(" CVS")))
-  "Entry to display CVS in mode line")
-
-(defvar cvs-dired:map (make-sparse-keymap)
-  "CVS dired minor mode keymap")
-
-(define-key cvs-dired:map "\C-cvo" 'cvs-dired-log)
-(define-key cvs-dired:map "\C-cvs" 'cvs-dired-file-status)
-(define-key cvs-dired:map "\C-x\C-q" 'cvs-dired-edit)
-(define-key cvs-dired:map "\C-cve" 'cvs-dired-editors)
-(define-key cvs-dired:map "\C-cvw" 'cvs-dired-watchers)
-(define-key cvs-dired:map "\C-cvU" 'cvs-update-directory)
-(define-key cvs-dired:map "\C-cvS" 'cvs-status-process)
-(define-key cvs-dired:map "\C-cvM" 'cvs-dired-marked-status)
-(define-key cvs-dired:map "\C-cvA" 'cvs-dired-add)
-(define-key cvs-dired:map "\C-cvB" 'cvs-merge-branch)
-(define-key cvs-dired:map "\C-cvL" 'cvs-status-mark-changed)
-(define-key cvs-dired:map "\C-cvd" 'cvs-dired-ediff-internal)
-(define-key cvs-dired:map "\C-cv\C-d" 'cvs-dired-ediff)
-(define-key cvs-dired:map "\C-cvi" 'cvs-dired-diff)
-(define-key cvs-dired:map "\C-cvc" 'cvs-dired-commit)
-(define-key cvs-dired:map "\C-cvC" 'cvs-dired-commit-file)
-(define-key cvs-dired:map "\C-cvl" 'cvs-list)
-(define-key cvs-dired:map "\C-cvf" 'cvs-flush)
-(define-key cvs-dired:map "\C-cvu" 'cvs-dired-update-file)
-(define-key cvs-dired:map "\C-cvr" 'cvs-dired-revert)
-(define-key cvs-dired:map "\C-cvb" 'cvs-submit-report)
-(define-key cvs-dired:map "\C-cvh" 'cvs-dired-history)
-(define-key cvs-dired:map "\C-cva" 'cvs-dired-annotate)
-(easy-menu-define
- cvs-dired:menu
- cvs-dired:map
- "CVS dired minor mode keymap"
- '("CVS"
-    ["Add" cvs-dired-add t]
-    "-----------" 
-    ["Update File" cvs-dired-update-file t]
-    ["(Un)Edit" cvs-dired-edit t]
-    ["Commit File" cvs-dired-commit-file t]
-    ["Log" cvs-dired-log t]
-    ["Annotate" cvs-dired-annotate t]
-    ["History" cvs-dired-history t]
-    ["File Status" cvs-dired-file-status t]
-    ["Editors" cvs-dired-editors t]
-    ["Watchers" cvs-dired-watchers t]
-    ["EDiff" cvs-dired-ediff-internal t]
-    ["Diff" cvs-dired-diff t]
-    "-----------" 
-    ["Module Status" cvs-status-process t]
-    ["Update Module" cvs-update-directory t]
-    "-----------" 
-    ("Marking Files" 
-     ["Show List" cvs-list t]
-     ["Flush List" cvs-flush t]
-     )
-    ("Action on Marked Files"
-     ["Commit" cvs-dired-commit t]
-     ["Show Status" cvs-dired-marked-status t]
-     )
-    ("Other Commands" 
-     ["EDiff two revs" cvs-ediff t]
-     ["Restore version" cvs-dired-revert t]
-     ["Change description" cvs-dired-description t]
-     ["Change log message" cvs-dired-change-log t]
-     ["Merge backup" cvs-dired-merge-backup t]
-     ["Merge branch" cvs-merge-branch t])
-    "--------" 
-    ["Send mail report" cvs-submit-report t]))
-
-(or (assq 'cvs-dired-mode minor-mode-alist)
-    (setq minor-mode-alist (cons cvs-dired:entry minor-mode-alist)))
-
-(or (assq 'cvs-dired-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist (cons (cons 'cvs-dired-mode cvs-dired:map)
-				     minor-mode-map-alist)))
-
-(defun cvs-dired-mode ()
-  "Turn on cvs-dired minor mode."
-  (setq cvs-dired-mode t)
-  (easy-menu-add cvs-dired:menu cvs-dired:map)
-  )
-
-(defun cvs-dired-file-status ()
-  "Call `cvs-file-status' on current file."
-  (interactive)
-  (cvs-file-status (dired-get-filename)))
-
-(defun cvs-dired-edit ()
-  "Call `cvs-edit' on current file."
-  (interactive)
-  (let ((filename (dired-get-filename)))
-    (cvs-edit filename)
-    (dired-update-file-line filename) ) )
-
-(defun cvs-dired-editors ()
-  "Call `cvs-editors' on current file."
-  (interactive)
-  (cvs-editors (dired-get-filename)))
-
-(defun cvs-dired-watchers ()
-  "Call `cvs-watchers' on current file."
-  (interactive)
-  (cvs-watchers (dired-get-filename)))
-
-(defun cvs-dired-commit-file ()
-  "Call `cvs-commit-file' on current file."
-  (interactive)
-  (cvs-commit (list (dired-get-filename))))
-
-(defun cvs-dired-log ()
-  "Call `cvs-log' on current file."
-  (interactive)
-  (cvs-log (dired-get-filename)))
-
-(defun cvs-dired-annotate ()
-  "Call `cvs-annotate' on current file."
-  (interactive)
-  (cvs-annotate (dired-get-filename)))
-
-(defun cvs-dired-history ()
-  "Call `cvs-history' on current file."
-  (interactive)
-  (cvs-history (dired-get-filename)))
-
-(defun cvs-dired-update-file ()
-  "Call `cvs-update-file' on current file."
-  (interactive)
-  (cvs-update-file (dired-get-filename)))
-
-(defun cvs-dired-diff (rev)
-  "Call `cvs-diff' on current file."
-  (interactive "sVersion to visit (default is latest version): ")
-  (cvs-diff rev (dired-get-filename)))
-
-(defun cvs-dired-add (msg)
-  "Add current file to CVS."
-  (interactive "sEnter description : ")
-  (cvs-add msg (dired-get-filename)))
-
-(defun cvs-dired-description ()
-  "Call `cvs-description' on current file."
-  (interactive)
-  (cvs-description (dired-get-filename)))
-
-(defun cvs-dired-change-log (rev)
-  "Call `cvs-change-log' on current file."
-  (interactive "sVersion (default is current version): ")
-  (cvs-change-log rev (dired-get-filename)))
-
-(defun cvs-dired-revert (rev)
-  "Call `cvs-revert' on current file."
-  (interactive "sVersion to revert from (default is latest version): ")
-  (cvs-revert rev (dired-get-filename)))
-
-(defun cvs-dired-merge-backup ()
-  "Call `cvs-merge-backup' on current file."
-  (interactive)
-  (cvs-merge-backup (dired-get-filename)))
-
-(defun cvs-dired-commit ()
-  "Call `cvs-commit' on marked files."
-  (interactive)
-  (let ((l (or (let (f (dired-get-marked-files))
-		 (if (and f (> (length f) 0)) f nil)) cvs:marked-list)))
-    (if (not l)
-	(error "No marked files")
-      (cvs-commit l))))
-
-;; Of dubious use:
-;;(defun cvs-dired-update-marked ()
-;;  "Call `cvs-update-file' on marked files."
-;;  (interactive)
-;;  (let ((l (or (let (f (dired-get-marked-files))
-;;		 (if (and f (> (length f) 0)) f nil)) cvs:marked-list)))
-;;    (if (not l)
-;;	(error "No marked files")
-;;      (cvs-update-file l))))
-
-(defun cvs-dired-marked-status ()
-  "Call `cvs-marked-status' on marked files."
-  (interactive)
-  (let ((l (or (let (f (dired-get-marked-files))
-		 (if (and f (> (length f) 0)) f nil)) cvs:marked-list)))
-    (if (not l)
-	(error "No marked file")
-      (cvs-marked-status l))))
-
-(defun cvs-dired-ediff-internal ()
-  "Edit currect file and call `cvs-ediff-internal'."
-  (interactive)
-  (dired-find-file)
-  (call-interactively 'cvs-ediff-internal))
-
-(defun cvs-dired-ediff ()
-  "Edit currect file and call `cvs-ediff'."
-  (interactive)
-  (dired-find-file)
-  (call-interactively 'cvs-ediff))
-
-;;=============================================================================
-(run-hooks 'cvs-load-hooks)
-
-;;=============================================================================
-(provide 'cvs)
-
-;;; end of cvs.el
diff --git a/xemacs-packages/lisp/prog-modes/diff-mode.el b/xemacs-packages/lisp/prog-modes/diff-mode.el
deleted file mode 100644
index 906417d5..00000000
--- a/xemacs-packages/lisp/prog-modes/diff-mode.el
+++ /dev/null
@@ -1,1393 +0,0 @@
-;;; diff-mode.el --- a mode for viewing/editing context diffs
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
-
-;; Author: Stefan Monnier 
-;; Keywords: convenience patch diff
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Synched up with: GNU Emacs 21.3, except for the easy-mmode-defmap stuff.
-;;;                  Also various trivial bits synced from Emacs CVS 2004-08-13
-;;;                  and 2005-12-01.
-
-;;; Commentary:
-
-;; Provides support for font-lock, outline, navigation
-;; commands, editing and various conversions as well as jumping
-;; to the corresponding source file.
-
-;; Inspired by Pavel Machek's patch-mode.el ()
-;; Some efforts were spent to have it somewhat compatible with XEmacs'
-;; diff-mode as well as with compilation-minor-mode
-
-;; Bugs:
-
-;; - Reverse doesn't work with normal diffs.
-
-;; Todo:
-
-;; - Improve narrowed-view support.
-;; - re-enable (conditionally) the `compile' support after improving it to use
-;;   the same code as diff-goto-source.
-;; - Support for # comments in context->unified.
-;; - Do a fuzzy search in diff-goto-source.
-;; - Allow diff.el to use diff-mode.
-;;   This mostly means ability to jump from half-hunk to half-hunk
-;;   in context (and normal) diffs and to jump to the corresponding
-;;   (i.e. new or old) file.
-;; - Handle `diff -b' output in context->unified.
-
-;; Low priority:
-;; - Spice up the minor-mode with font-lock support.
-;; - Recognize pcl-cvs' special string for `cvs-execute-single'.
-
-;;; Code:
-
-;; XEmacs change
-(if (featurep 'diff)
-    (error 'invalid-state
-	   "The diff and diff-mode packages are incompatible."))
-
-(eval-when-compile (require 'cl))
-
-
-(defgroup diff-mode ()
-  "Major mode for viewing/editing diffs."
-  :version "21.1"
-  :group 'tools
-  :group 'diff)
-
-(defcustom diff-default-read-only nil
-  "If non-nil, `diff-mode' buffers default to being read-only."
-  :type 'boolean
-  :group 'diff-mode)
-
-(defcustom diff-jump-to-old-file nil
-  "*Non-nil means `diff-goto-source' jumps to the old file.
-Else, it jumps to the new file."
-  :type 'boolean
-  :group 'diff-mode)
-
-(defcustom diff-update-on-the-fly t
-  "*Non-nil means hunk headers are kept up-to-date on-the-fly.
-When editing a diff file, the line numbers in the hunk headers
-need to be kept consistent with the actual diff.  This can
-either be done on the fly (but this sometimes interacts poorly with the
-undo mechanism) or whenever the file is written (can be slow
-when editing big diffs)."
-  :type 'boolean
-  :group 'diff-mode)
-
-(defcustom diff-advance-after-apply-hunk t
-  "*Non-nil means `diff-apply-hunk' will move to the next hunk after applying."
-  :type 'boolean
-  :group 'diff-mode)
-
-
-(defvar diff-mode-hook nil
-  "Run after setting up the `diff-mode' major mode.")
-
-(defvar diff-outline-regexp
-  "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)")
-
-;;;;
-;;;; keymap, menu, ...
-;;;;
-
-;; XEmacs change: the clever keymap tricks here didn't work; fix them.
-
-(defmacro diff-defmap (var bindings doc)
-  `(defvar ,var
-     (let ((m (make-keymap)))
-       (dolist (b ,bindings)
-	 (define-key m (car b) (cdr b)))
-       m)
-     ,doc))
-
-(defmacro diff-metify-map (var bindings doc)
-  `(defvar ,var
-     (let ((m (make-keymap)))
-       (dolist (b ,bindings)
-	 (define-key m (char-to-string (+ 128 (string-to-char (car b))))
-	   (cdr b)))
-       m)
-     ,doc))
-
-(let ((bindings
-       '(;; from Pavel Machek's patch-mode
-	 ("n" . diff-hunk-next)
-	 ("N" . diff-file-next)
-	 ("p" . diff-hunk-prev)
-	 ("P" . diff-file-prev)
-	 ("k" . diff-hunk-kill)
-	 ("K" . diff-file-kill)
-	 ;; From compilation-minor-mode.
-	 ("}" . diff-file-next)
-	 ("{" . diff-file-prev)
-	 ("\C-m" . diff-goto-source)
-	 ("W" . widen)
-	 ;;("." . diff-goto-source)		;display-buffer
-	 ;;("f" . diff-goto-source)		;find-file
-	 ("o" . diff-goto-source)	;other-window
-	 ;;("w" . diff-goto-source)		;other-frame
-	 ;;("N" . diff-narrow)
-	 ;;("h" . diff-show-header)
-	 ;;("j" . diff-show-difference)	;jump to Nth diff
-	 ;;("q" . diff-quit)
-	 (" " . scroll-up)
-	 ("\177" . scroll-down)
-	 ;; Our very own bindings.
-	 ("A" . diff-ediff-patch)
-	 ("r" . diff-restrict-view)
-	 ("R" . diff-reverse-direction)
-	 ("U" . diff-context->unified)
-	 ("C" . diff-unified->context))))
-  (diff-defmap
-   diff-mode-shared-map bindings
-   "Keymap for read-only `diff-mode'. Only active in read-only mode.")
-  (diff-metify-map
-   diff-mode-map bindings
-   "Keymap for `diff-mode'.  See also `diff-mode-shared-map'."))
-
-;; from compilation-minor-mode
-(define-key diff-mode-map "\C-c\C-c" 'diff-goto-source)
-;; from GNU Emacs
-(define-key diff-mode-map "\C-c\C-s" 'diff-split-hunk)
-(define-key diff-mode-map "\C-c\C-a" 'diff-apply-hunk)
-(define-key diff-mode-map "\C-c\C-t" 'diff-test-hunk)
-
-(easy-menu-define diff-mode-menu diff-mode-map
-  "Menu for `diff-mode'."
-  '("Diff"
-    ["Jump to Source"		diff-goto-source	t]
-    ["Apply hunk"		diff-apply-hunk		t]
-    ["Apply diff with Ediff"	diff-ediff-patch	t]
-    ["-----" nil nil]
-    ["Reverse direction"	diff-reverse-direction	t]
-    ["Context -> Unified"	diff-context->unified	t]
-    ["Unified -> Context"	diff-unified->context	t]
-    ;;["Fixup Headers"		diff-fixup-modifs	(not buffer-read-only)]
-    ))
-
-(defcustom diff-minor-mode-prefix "\C-c="
-  "Prefix key for `diff-minor-mode' commands."
-  :type '(choice (string "\e") (string "C-c=") string)
-  :group 'diff-mode)
-
-(easy-mmode-defmap diff-minor-mode-map
-  `((,diff-minor-mode-prefix . ,diff-mode-shared-map))
-  "Keymap for `diff-minor-mode'.  See also `diff-mode-shared-map'.")
-
-
-;;;;
-;;;; font-lock support
-;;;;
-
-(defface diff-header-face
-  '((((type tty pc) (class color) (background light))
-     (:foreground "blue1" :bold t))
-    (((type tty pc) (class color) (background dark))
-     (:foreground "green" :bold t))
-    (((class color) (background light))
-     (:background "grey85"))
-    (((class color) (background dark))
-     (:background "grey45"))
-    (t (:bold t)))
-  "`diff-mode' face inherited by hunk and index header faces."
-  :group 'diff-mode)
-(defvar diff-header-face 'diff-header-face)
-
-(defface diff-file-header-face
-  '((((type tty pc) (class color) (background light))
-     (:foreground "yellow" :bold t))
-    (((type tty pc) (class color) (background dark))
-     (:foreground "cyan" :bold t))
-    (((class color) (background light))
-     (:background "grey70" :bold t))
-    (((class color) (background dark))
-     (:background "grey60" :bold t))
-    (t (:bold t)))			; :height 1.3
-  "`diff-mode' face used to highlight file header lines."
-  :group 'diff-mode)
-(defvar diff-file-header-face 'diff-file-header-face)
-
-(defface diff-index-face
-  ;; XEmacs change: no :inherit in 21.4, copy/pasted `diff-file-header-face'.
-  '((((type tty pc) (class color) (background light))
-     (:foreground "yellow" :bold t))
-    (((type tty pc) (class color) (background dark))
-     (:foreground "cyan" :bold t))
-    (((class color) (background light))
-     (:background "grey70" :bold t))
-    (((class color) (background dark))
-     (:background "grey60" :bold t))
-    (t (:bold t)))			; :height 1.3
-  "`diff-mode' face used to highlight index header lines."
-  :group 'diff-mode)
-(defvar diff-index-face 'diff-index-face)
-
-(defface diff-hunk-header-face
-  ;; XEmacs change: no :inherit in 21.4; copy/pasted `diff-header-face'.
-  '((((type tty pc) (class color) (background light))
-     (:foreground "blue1" :bold t))
-    (((type tty pc) (class color) (background dark))
-     (:foreground "green" :bold t))
-    (((class color) (background light))
-     (:background "grey85"))
-    (((class color) (background dark))
-     (:background "grey45"))
-    (t (:bold t)))
-  "`diff-mode' face used to highlight hunk header lines."
-  :group 'diff-mode)
-(defvar diff-hunk-header-face 'diff-hunk-header-face)
-
-(defface diff-removed-face
-  ;; XEmacs change: no :inherit in 21.4; copy/pasted `diff-changed-face'.
-  '((((type tty pc) (class color) (background light))
-     (:foreground "magenta" :bold t :italic t))
-    (((type tty pc) (class color) (background dark))
-     (:foreground "yellow" :bold t :italic t))
-    (t ()))
-  "`diff-mode' face used to highlight removed lines."
-  :group 'diff-mode)
-(defvar diff-removed-face 'diff-removed-face)
-
-(defface diff-added-face
-  ;; XEmacs change: no :inherit in 21.4; copy/pasted `diff-changed-face'.
-  '((((type tty pc) (class color) (background light))
-     (:foreground "magenta" :bold t :italic t))
-    (((type tty pc) (class color) (background dark))
-     (:foreground "yellow" :bold t :italic t))
-    (t ()))
-  "`diff-mode' face used to highlight added lines."
-  :group 'diff-mode)
-(defvar diff-added-face 'diff-added-face)
-
-(defface diff-changed-face
-  '((((type tty pc) (class color) (background light))
-     (:foreground "magenta" :bold t :italic t))
-    (((type tty pc) (class color) (background dark))
-     (:foreground "yellow" :bold t :italic t))
-    (t ()))
-  "`diff-mode' face used to highlight changed lines."
-  :group 'diff-mode)
-(defvar diff-changed-face 'diff-changed-face)
-
-(defface diff-function-face
-  ;; XEmacs change: no :inherit in 21.4; copy/pasted `diff-context-face'.
-  '((((class color) (background light))
-     (:foreground "grey50"))
-    (((class color) (background dark))
-     (:foreground "grey70"))
-    (t ))
-  "`diff-mode' face used to highlight function names produced by \"diff -p\"."
-  :group 'diff-mode)
-(defvar diff-function-face 'diff-function-face)
-
-(defface diff-context-face
-  '((((class color) (background light))
-     (:foreground "grey50"))
-    (((class color) (background dark))
-     (:foreground "grey70"))
-    (t ))
-  "`diff-mode' face used to highlight context and other side-information."
-  :group 'diff-mode)
-(defvar diff-context-face 'diff-context-face)
-
-(defface diff-nonexistent-face
-  ;; XEmacs change: no :inherit in 21.4; copy/pasted `diff-file-header-face'.
-  '((((type tty pc) (class color) (background light))
-     (:foreground "yellow" :bold t))
-    (((type tty pc) (class color) (background dark))
-     (:foreground "cyan" :bold t))
-    (((class color) (background light))
-     (:background "grey70" :bold t))
-    (((class color) (background dark))
-     (:background "grey60" :bold t))
-    (t (:bold t)))			; :height 1.3
-  "`diff-mode' face used to highlight nonexistent files in recursive diffs."
-  :group 'diff-mode)
-(defvar diff-nonexistent-face 'diff-nonexistent-face)
-
-(defvar diff-font-lock-keywords
-  '(("^\\(@@ -[0-9,]+ \\+[0-9,]+ @@\\)\\(.*\\)$" ;unified
-     (1 diff-hunk-header-face)
-     (2 diff-function-face))
-    ("^--- .+ ----$" . diff-hunk-header-face) ;context
-    ("^\\(\\*\\{15\\}\\)\\(.*\\)$"	;context
-     (1 diff-hunk-header-face)
-     (2 diff-function-face))
-    ("^\\*\\*\\* .+ \\*\\*\\*\\*". diff-hunk-header-face) ;context
-    ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\(\\S-+\\)\\(.*[^*-]\\)?\n"
-     (0 diff-header-face) (2 diff-file-header-face prepend))
-    ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face)
-    ("^!.*\n" . diff-changed-face)	;context
-    ("^[+>].*\n" . diff-added-face)
-    ("^[-<].*\n" . diff-removed-face)
-    ("^Index: \\(.+\\).*\n" (0 diff-header-face) (1 diff-index-face prepend))
-    ("^Only in .*\n" . diff-nonexistent-face)
-    ("^#.*" . font-lock-string-face)
-    ("^[^-=+*!<>].*\n" . diff-context-face)))
-
-(defconst diff-font-lock-defaults
-  '(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil)))
-
-(defvar diff-imenu-generic-expression
-  ;; Prefer second name as first is most likely to be a backup or
-  ;; version-control name.  The [\t\n] at the end of the unidiff pattern
-  ;; catches Debian source diff files (which lack the trailing date).
-  '((nil "\\+\\+\\+\\ \\([^\t\n]+\\)[\t\n]" 1) ; unidiffs
-    (nil "^--- \\([^\t\n]+\\)\t.*\n\\*" 1))) ; context diffs
-
-;; XEmacs change: we don't have combine-after-change-calls.
-(eval-when-compile
-  (unless (fboundp 'combine-after-change-calls)
-    (defmacro combine-after-change-calls (&rest body)
-      "Execute `body'."
-      `(progn ,@body))))
-
-;; XEmacs change: we don't have delete-and-extract-region
-(eval-when-compile
-  (unless (fboundp 'delete-and-extract-region)
-    (defun delete-and-extract-region (start end)
-      "Delete the text between START and END and return it."
-      (let ((str (buffer-substring start end)))
-	(delete-region start end)
-	str))))
-
-;;;;
-;;;; Compile support
-;;;;
-
-(defvar diff-file-regexp-alist
-  '(("Index: \\(.+\\)" 1)))
-
-(defvar diff-error-regexp-alist
-  '(("@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@" nil 2)
-    ("--- \\([0-9]+\\),[0-9]+ ----" nil 1)
-    ("\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)" nil 3)))
-
-;;;;
-;;;; Movement
-;;;;
-
-(defconst diff-hunk-header-re "^\\(@@ -[0-9,]+ \\+[0-9,]+ @@.*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$")
-(defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\* .+\n--- \\|[^-+!<>0-9@* ]\\).+\n" (substring diff-hunk-header-re 1)))
-(defvar diff-narrowed-to nil)
-
-(defun diff-end-of-hunk (&optional style)
-  (when (looking-at diff-hunk-header-re)
-    (unless style
-      ;; Especially important for unified (because headers are ambiguous).
-      (setq style (cdr (assq (char-after) '((?@ . unified) (?* . context))))))
-    (goto-char (match-end 0)))
-  (let ((end (and (re-search-forward (case style
-				       ;; A `unified' header is ambiguous.
-				       (unified (concat "^[^-+# \\]\\|"
-							diff-file-header-re))
-				       (context "^[^-+#! \\]")
-				       (normal "^[^<>#\\]")
-				       (t "^[^-+#!<> \\]"))
-				     nil t)
-		  (match-beginning 0))))
-    ;; The return value is used by easy-mmode-define-navigation.
-    (goto-char (or end (point-max)))))
-
-(defun diff-beginning-of-hunk ()
-  (beginning-of-line)
-  (unless (looking-at diff-hunk-header-re)
-    (forward-line 1)
-    (condition-case ()
-	(re-search-backward diff-hunk-header-re)
-      (error (error "Can't find the beginning of the hunk")))))
-
-(defun diff-beginning-of-file ()
-  (beginning-of-line)
-  (unless (looking-at diff-file-header-re)
-    (forward-line 2)
-    (condition-case ()
-	(re-search-backward diff-file-header-re)
-      (error (error "Can't find the beginning of the file")))))
-
-(defun diff-end-of-file ()
-  (re-search-forward "^[-+#!<>0-9@* \\]" nil t)
-  (re-search-forward (concat "^[^-+#!<>0-9@* \\]\\|" diff-file-header-re)
-		     nil 'move)
-  (if (match-beginning 1)
-      (goto-char (match-beginning 1))
-    (beginning-of-line)))
-
-;; Define diff-{hunk,file}-{prev,next}
-(easy-mmode-define-navigation
- diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk)
-(easy-mmode-define-navigation
- diff-file diff-file-header-re "file" diff-end-of-hunk)
-
-(defun diff-restrict-view (&optional arg)
-  "Restrict the view to the current hunk.
-If the prefix ARG is given, restrict the view to the current file instead."
-  (interactive "P")
-  (save-excursion
-    (if arg (diff-beginning-of-file) (diff-beginning-of-hunk))
-    (narrow-to-region (point)
-		      (progn (if arg (diff-end-of-file) (diff-end-of-hunk))
-			     (point)))
-    (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))))
-
-
-(defun diff-hunk-kill ()
-  "Kill current hunk."
-  (interactive)
-  (diff-beginning-of-hunk)
-  (let ((start (point))
-	(firsthunk (save-excursion
-		     (ignore-errors
-		       (diff-beginning-of-file) (diff-hunk-next) (point))))
-	(nexthunk  (save-excursion
-		     (ignore-errors
-		       (diff-hunk-next) (point))))
-	(nextfile (save-excursion
-		    (ignore-errors
-		      (diff-file-next) (point)))))
-    (if (and firsthunk (= firsthunk start)
-	     (or (null nexthunk)
-		 (and nextfile (> nexthunk nextfile))))
-	;; It's the only hunk for this file, so kill the file.
-	(diff-file-kill)
-      (diff-end-of-hunk)
-      (kill-region start (point)))))
-
-(defun diff-file-kill ()
-  "Kill current file's hunks."
-  (interactive)
-  (diff-beginning-of-file)
-  (let* ((start (point))
-	 (prevhunk (save-excursion
-		     (ignore-errors
-		       (diff-hunk-prev) (point))))
-	 (index (save-excursion
-		  (re-search-backward "^Index: " prevhunk t))))
-    (when index (setq start index))
-    (diff-end-of-file)
-    (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs.
-    (kill-region start (point))))
-
-(defun diff-kill-junk ()
-  "Kill spurious empty diffs."
-  (interactive)
-  (save-excursion
-    (let ((inhibit-read-only t))
-      (goto-char (point-min))
-      (while (re-search-forward (concat "^\\(Index: .*\n\\)"
-					"\\([^-+!* <>].*\n\\)*?"
-					"\\(\\(Index:\\) \\|"
-					diff-file-header-re "\\)")
-				nil t)
-	(delete-region (if (match-end 4) (match-beginning 0) (match-end 1))
-		       (match-beginning 3))
-	(beginning-of-line)))))
-
-(defun diff-count-matches (re start end)
-  (save-excursion
-    (let ((n 0))
-      (goto-char start)
-      (while (re-search-forward re end t) (incf n))
-      n)))
-
-(defun diff-split-hunk ()
-  "Split the current (unified diff) hunk at point into two hunks."
-  (interactive)
-  (beginning-of-line)
-  (let ((pos (point))
-	(start (progn (diff-beginning-of-hunk) (point))))
-    (unless (looking-at "@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@")
-      (error "diff-split-hunk only works on unified context diffs"))
-    (forward-line 1)
-    (let* ((start1 (string-to-number (match-string 1)))
-	   (start2 (string-to-number (match-string 2)))
-	   (newstart1 (+ start1 (diff-count-matches "^[- \t]" (point) pos)))
-	   (newstart2 (+ start2 (diff-count-matches "^[+ \t]" (point) pos))))
-      (goto-char pos)
-      ;; Hopefully the after-change-function will not screw us over.
-      (insert "@@ -" (number-to-string newstart1) ",1 +"
-	      (number-to-string newstart2) ",1 @@\n")
-      ;; Fix the original hunk-header.
-      (diff-fixup-modifs start pos))))
-
-
-;;;;
-;;;; jump to other buffers
-;;;;
-
-(defvar diff-remembered-files-alist nil)
-
-(defun diff-filename-drop-dir (file)
-  (when (string-match "/" file) (substring file (match-end 0))))
-
-(defun diff-merge-strings (ancestor from to)
-  "Merge the diff between ANCESTOR and FROM into TO.
-Returns the merged string if successful or nil otherwise.
-The strings are assumed not to contain any \"\\n\" (i.e. end of line).
-If ANCESTOR = FROM, returns TO.
-If ANCESTOR = TO, returns FROM.
-The heuristic is simplistic and only really works for cases
-like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")."
-  ;; Ideally, we want:
-  ;;   AMB ANB CMD -> CND
-  ;; but that's ambiguous if `foo' or `bar' is empty:
-  ;; a/foo a/foo1 b/foo.c -> b/foo1.c but not 1b/foo.c or b/foo.c1
-  (let ((str (concat ancestor "\n" from "\n" to)))
-    (when (and (string-match (concat
-			      "\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n"
-			      "\\1\\(.*\\)\\3\n"
-			      "\\(.*\\(\\2\\).*\\)\\'") str)
-	       (equal to (match-string 5 str)))
-      (concat (substring str (match-beginning 5) (match-beginning 6))
-	      (match-string 4 str)
-	      (substring str (match-end 6) (match-end 5))))))
-
-(defun diff-find-file-name (&optional old)
-  "Return the file corresponding to the current patch.
-Non-nil OLD means that we want the old file."
-  (save-excursion
-    (unless (looking-at diff-file-header-re)
-      (or (ignore-errors (diff-beginning-of-file))
-	  (re-search-forward diff-file-header-re nil t)))
-    (let* ((limit (save-excursion
-		   (condition-case ()
-		       (progn (diff-hunk-prev) (point))
-		     (error (point-min)))))
-	   (header-files
-	    (if (looking-at "[-*][-*][-*] \\(\\S-+\\)\\(\\s-.*\\)?\n[-+][-+][-+] \\(\\S-+\\)")
-		(list (if old (match-string 1) (match-string 3))
-		      (if old (match-string 3) (match-string 1)))
-	      (forward-line 1) nil))
-	   (fs (append
-		(when (save-excursion
-			(re-search-backward "^Index: \\(.+\\)" limit t))
-		  (list (match-string 1)))
-		header-files
-		(when (re-search-backward "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?" nil t)
-		  (list (if old (match-string 2) (match-string 4))
-			(if old (match-string 4) (match-string 2))))))
-	   (fs (delq nil fs)))
-      (or
-       ;; use any previously used preference
-       (cdr (assoc fs diff-remembered-files-alist))
-       ;; try to be clever and use previous choices as an inspiration
-       (dolist (rf diff-remembered-files-alist)
-	 (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
-	   (if (and newfile (file-exists-p newfile)) (return newfile))))
-       ;; look for each file in turn.  If none found, try again but
-       ;; ignoring the first level of directory, ...
-       (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
-	     (file nil nil))
-	   ((or (null files)
-		(setq file (do* ((files files (cdr files))
-				 (file (car files) (car files)))
-			       ((or (null file) (file-exists-p file))
-				file))))
-	    file))
-       ;; .rej patches implicitly apply to 
-       (and (string-match "\\.rej\\'" (or buffer-file-name ""))
-	    (let ((file (substring buffer-file-name 0 (match-beginning 0))))
-	      (when (file-exists-p file) file)))
-       ;; if all else fails, ask the user
-       (let ((file (read-file-name (format "Use file %s: " (or (first fs) ""))
-				   nil (first fs) t (first fs))))
-	 (set (make-local-variable 'diff-remembered-files-alist)
-	      (cons (cons fs file) diff-remembered-files-alist))
-	 file)))))
-
-
-(defun diff-mouse-goto-source (event)
-  "Run `diff-goto-source' for the diff at a mouse click."
-  (interactive "e")
-  (save-excursion
-    (mouse-set-point event)
-    (diff-goto-source)))
-
-
-(defun diff-ediff-patch ()
-  "Call `ediff-patch-file' on the current buffer."
-  (interactive)
-  (condition-case err
-      (ediff-patch-file nil (current-buffer))
-    (wrong-number-of-arguments (ediff-patch-file))))
-
-;;;;
-;;;; Conversion functions
-;;;;
-
-;;(defvar diff-inhibit-after-change nil
-;;  "Non-nil means inhibit `diff-mode's after-change functions.")
-
-(defun diff-unified->context (start end)
-  "Convert unified diffs to context diffs.
-START and END are either taken from the region (if a prefix arg is given) or
-else cover the whole bufer."
-  (interactive (if current-prefix-arg
-		   (list (mark) (point))
-		 (list (point-min) (point-max))))
-  (unless (markerp end) (setq end (copy-marker end)))
-  (let (;;(diff-inhibit-after-change t)
-	(inhibit-read-only t))
-    (save-excursion
-      (goto-char start)
-      (while (and (re-search-forward "^\\(\\(---\\) .+\n\\(\\+\\+\\+\\) .+\\|@@ -\\([0-9]+\\),\\([0-9]+\\) \\+\\([0-9]+\\),\\([0-9]+\\) @@.*\\)$" nil t)
-		  (< (point) end))
-	(combine-after-change-calls
-	  (if (match-beginning 2)
-	      ;; we matched a file header
-	      ;; XEmacs change: don't use `replace-match'
-	      ;; which has a different API there.
-	      (save-excursion
-		;; use reverse order to make sure the indices are kept valid
-		(delete-region (match-beginning 3) (match-end 3))
-		(goto-char (match-beginning 3))
-		(insert-string "---")
-		(delete-region (match-beginning 2) (match-end 2))
-		(goto-char (match-beginning 2))
-		(insert-string "***"))
-	    ;; we matched a hunk header
-	    (let ((line1 (match-string 4))
-		  (lines1 (match-string 5))
-		  (line2 (match-string 6))
-		  (lines2 (match-string 7)))
-	      (replace-match
-	       (concat "***************\n*** " line1 ","
-		       (number-to-string (+ (string-to-number line1)
-					    (string-to-number lines1)
-					    -1)) " ****"))
-	      (forward-line 1)
-	      (save-restriction
-		(narrow-to-region (point)
-				  (progn (diff-end-of-hunk 'unified) (point)))
-		(let ((hunk (buffer-string)))
-		  (goto-char (point-min))
-		  (if (not (save-excursion (re-search-forward "^-" nil t)))
-		      (delete-region (point) (point-max))
-		    (goto-char (point-max))
-		    (let ((modif nil) last-pt)
-		      (while (progn (setq last-pt (point))
-				    (= (forward-line -1) 0))
-			(case (char-after)
-			  (?  (insert " ") (setq modif nil) (backward-char 1))
-			  (?+ (delete-region (point) last-pt) (setq modif t))
-			  (?- (if (not modif)
-				  (progn (forward-char 1)
-					 (insert " "))
-				(delete-char 1)
-				(insert "! "))
-			      (backward-char 2))
-			  (?\\ (when (save-excursion (forward-line -1)
-						     (= (char-after) ?+))
-				 (delete-region (point) last-pt) (setq modif t)))
-			  (t (setq modif nil))))))
-		  (goto-char (point-max))
-		  (save-excursion
-		    (insert "--- " line2 ","
-			    (number-to-string (+ (string-to-number line2)
-						 (string-to-number lines2)
-						 -1)) " ----\n" hunk))
-		  ;;(goto-char (point-min))
-		  (forward-line 1)
-		  (if (not (save-excursion (re-search-forward "^+" nil t)))
-		      (delete-region (point) (point-max))
-		    (let ((modif nil) (delete nil))
-		      (while (not (eobp))
-			(case (char-after)
-			  (?  (insert " ") (setq modif nil) (backward-char 1))
-			  (?- (setq delete t) (setq modif t))
-			  (?+ (if (not modif)
-				  (progn (forward-char 1)
-					 (insert " "))
-				(delete-char 1)
-				(insert "! "))
-			      (backward-char 2))
-			  (?\\ (when (save-excursion (forward-line 1)
-						     (not (eobp)))
-				 (setq delete t) (setq modif t)))
-			  (t (setq modif nil)))
-			(let ((last-pt (point)))
-			  (forward-line 1)
-			  (when delete
-			    (delete-region last-pt (point))
-			    (setq delete nil)))))))))))))))
-
-(defun diff-context->unified (start end)
-  "Convert context diffs to unified diffs.
-START and END are either taken from the region (if a prefix arg is given) or
-else cover the whole bufer."
-  (interactive (if current-prefix-arg
-		   (list (mark) (point))
-		 (list (point-min) (point-max))))
-  (unless (markerp end) (setq end (copy-marker end)))
-  (let (;;(diff-inhibit-after-change t)
-	(inhibit-read-only t))
-    (save-excursion
-      (goto-char start)
-      (while (and (re-search-forward "^\\(\\(\\*\\*\\*\\) .+\n\\(---\\) .+\\|\\*\\{15\\}.*\n\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]+\\) \\*\\*\\*\\*\\)$" nil t)
-		  (< (point) end))
-	(combine-after-change-calls
-	  (if (match-beginning 2)
-	      ;; we matched a file header
-	      ;; XEmacs change: don't use `replace-match'
-	      ;; which has a different API there.
-	      (save-excursion
-	       ;; use reverse order to make sure the indices are kept valid
-		(delete-region (match-beginning 3) (match-end 3))
-		(goto-char (match-beginning 3))
-		(insert-string "+++")
-		(delete-region (match-beginning 2) (match-end 2))
-		(goto-char (match-beginning 2))
-		(insert-string "---"))
-	    ;; we matched a hunk header
-	    (let ((line1s (match-string 4))
-		  (line1e (match-string 5))
-		  (pt1 (match-beginning 0)))
-	      (replace-match "")
-	      (unless (re-search-forward
-		       "^--- \\([0-9]+\\),\\(-?[0-9]+\\) ----$" nil t)
-		(error "Can't find matching `--- n1,n2 ----' line"))
-	      (let ((line2s (match-string 1))
-		    (line2e (match-string 2))
-		    (pt2 (progn
-			   (delete-region (progn (beginning-of-line) (point))
-					  (progn (forward-line 1) (point)))
-			   (point-marker))))
-		(goto-char pt1)
-		(forward-line 1)
-		(while (< (point) pt2)
-		  (case (char-after)
-		    ((?! ?-) (delete-char 2) (insert "-") (forward-line 1))
-		    (?\ 		;merge with the other half of the chunk
-		     (let* ((endline2
-			     (save-excursion
-			       (goto-char pt2) (forward-line 1) (point)))
-			    (c (char-after pt2)))
-		       (case c
-			 ((?! ?+)
-			  (insert "+"
-				  (prog1 (buffer-substring (+ pt2 2) endline2)
-				    (delete-region pt2 endline2))))
-			 (?\ 		;FIXME: check consistency
-			  (delete-region pt2 endline2)
-			  (delete-char 1)
-			  (forward-line 1))
-			 (?\\ (forward-line 1))
-			 (t (delete-char 1) (forward-line 1)))))
-		    (t (forward-line 1))))
-		(while (looking-at "[+! ] ")
-		  (if (/= (char-after) ?!) (forward-char 1)
-		    (delete-char 1) (insert "+"))
-		  (delete-char 1) (forward-line 1))
-		(save-excursion
-		  (goto-char pt1)
-		  (insert "@@ -" line1s ","
-			  (number-to-string (- (string-to-number line1e)
-					       (string-to-number line1s)
-					       -1))
-			  " +" line2s ","
-			  (number-to-string (- (string-to-number line2e)
-					       (string-to-number line2s)
-					       -1)) " @@"))))))))))
-
-;; XEmacs change: extracted from `diff-reverse-direction'
-(defvar diff-patch-start-regexp
-  (concat
-   ;; start
-   "^\\("
-   ;; Typical start of diff
-   ;; --- file
-   ;; +++ file
-   "\\([-*][-*][-*] \\)\\(.+\\)\n"
-   "\\([-+][-+][-+] \\)\\(.+\\)"
-   ;; or
-   "\\|"
-   ;; I'm not sure
-   "\\*\\{15\\}.*\n"
-   "\\*\\*\\* \\(.+\\) \\*\\*\\*\\*"
-   ;; or
-   "\\|"
-   ;; hunk
-   "@@ -\\([0-9,]+\\) \\+\\([0-9,]+\\) @@.*"
-   ;; end
-   "\\)$"))
-
-
-;; XEmacs change: use region (mark) if set, do whole buffer otherwise
-(defun diff-reverse-direction (start end)
-  "Reverse the direction of the diffs.
-START and END are either taken from the region (if it is set) or
-else cover the whole buffer."
-  (interactive (if (mark)
-		   (list (mark) (point))
-		 (list (point-min) (point-max))))
-  (unless (markerp end) (setq end (copy-marker end)))
-  (let (;;(diff-inhibit-after-change t)
-	(inhibit-read-only t))
-    (save-excursion
-      (goto-char start)
-      ;; XEmacs change: use `diff-patch-start-regexp'
-      (while (and (re-search-forward diff-patch-start-regexp nil t)
-		  (< (point) end))
-	(combine-after-change-calls
-	  (cond
-	   ;; a file header
-	   ((match-beginning 2) (replace-match "\\2\\5\n\\4\\3" nil))
-	   ;; a context-diff hunk header
-	   ((match-beginning 6)
-	    (let ((pt-lines1 (match-beginning 6))
-		  (lines1 (match-string 6)))
-	      (replace-match "" nil nil nil 6)
-	      (forward-line 1)
-	      (let ((half1s (point)))
-		(while (looking-at "[-! \\][ \t]\\|#")
-		  (when (= (char-after) ?-) (delete-char 1) (insert "+"))
-		  (forward-line 1))
-		(let ((half1 (delete-and-extract-region half1s (point))))
-		  (unless (looking-at "^--- \\([0-9]+,-?[0-9]+\\) ----$")
-		    (insert half1)
-		    (error "Can't find matching `--- n1,n2 ----' line"))
-		  (let ((str1 (match-string 1)))
-		    (replace-match lines1 nil nil nil 1)
-		    (forward-line 1)
-		    (let ((half2s (point)))
-		      (while (looking-at "[!+ \\][ \t]\\|#")
-			(when (= (char-after) ?+) (delete-char 1) (insert "-"))
-			(forward-line 1))
-		      (let ((half2 (delete-and-extract-region half2s (point))))
-			(insert (or half1 ""))
-			(goto-char half1s)
-			(insert (or half2 ""))))
-		    (goto-char pt-lines1)
-		    (insert str1))))))
-	   ;; a unified-diff hunk header
-	   ((match-beginning 7)
-	    (replace-match "@@ -\\8 +\\7 @@" nil)
-	    (forward-line 1)
-	    (let ((c (char-after)) first last)
-	      (while (case (setq c (char-after))
-		       ;; XEmacs change: check for --- and +++ before reversing
-		       (?- (if (and (char= (char-after (+ 1 (point)))
-                                           ?-)
-                                    (char= (char-after (+ 2 (point)))
-                                           ?-))
-                               nil
-                               (progn
-                                 (setq first (or first (point)))
-                                 (delete-char 1)
-                                 (insert "+")
-                                 t)))
-		       (?+ (if (and (char= (char-after (+ 1 (point)))
-                                           ?+)
-                                    (char= (char-after (+ 2 (point)))
-                                           ?+))
-                               nil
-                               (progn
-                                 (setq last (or last (point)))
-                                 (delete-char 1)
-                                 (insert "-")
-                                 t)))
-		       ((?\\ ?#) t)
-		       (t (when (and first last (< first last))
-			    (insert (delete-and-extract-region first last)))
-			  (setq first nil last nil)
-			  (equal ?\  c)))
-		(forward-line 1))))))))))
-
-(defun diff-fixup-modifs (start end)
-  "Fixup the hunk headers (in case the buffer was modified).
-START and END are either taken from the region (if a prefix arg is given) or
-else cover the whole buffer."
-  (interactive (if current-prefix-arg
-		   (list (mark) (point))
-		 (list (point-min) (point-max))))
-  (let ((inhibit-read-only t))
-    (save-excursion
-      (goto-char end) (diff-end-of-hunk)
-      (let ((plus 0) (minus 0) (space 0) (bang 0))
-	(while (and (= (forward-line -1) 0) (<= start (point)))
-	  (if (not (looking-at
-		    (concat "@@ -[0-9,]+ \\+[0-9,]+ @@"
-			    "\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$"
-			    "\\|--- .+\n\\+\\+\\+ ")))
-	      (case (char-after)
-		(?\  (incf space))
-		(?+ (incf plus))
-		(?- (incf minus))
-		(?! (incf bang))
-		((?\\ ?#) nil)
-		(t  (setq space 0 plus 0 minus 0 bang 0)))
-	    (cond
-	     ((looking-at "@@ -[0-9]+,\\([0-9]*\\) \\+[0-9]+,\\([0-9]*\\) @@.*$")
-	      (let* ((old1 (match-string 1))
-		     (old2 (match-string 2))
-		     (new1 (number-to-string (+ space minus)))
-		     (new2 (number-to-string (+ space plus))))
-		(unless (string= new2 old2) (replace-match new2 t t nil 2))
-		(unless (string= new1 old1) (replace-match new1 t t nil 1))))
-	     ((looking-at "--- \\([0-9]+\\),\\([0-9]*\\) ----$")
-	      (when (> (+ space bang plus) 0)
-		(let* ((old1 (match-string 1))
-		       (old2 (match-string 2))
-		       (new (number-to-string
-			     (+ space bang plus -1 (string-to-number old1)))))
-		  (unless (string= new old2) (replace-match new t t nil 2)))))
-	     ((looking-at "\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]*\\) \\*\\*\\*\\*$")
-	      (when (> (+ space bang minus) 0)
-		(let* ((old (match-string 1))
-		       (new (format
-			     (concat "%0" (number-to-string (length old)) "d")
-			     (+ space bang minus -1 (string-to-number old)))))
-		  (unless (string= new old) (replace-match new t t nil 2))))))
-	    (setq space 0 plus 0 minus 0 bang 0)))))))
-
-;;;;
-;;;; Hooks
-;;;;
-
-(defun diff-write-contents-hooks ()
-  "Fixup hunk headers if necessary."
-  (if (buffer-modified-p) (diff-fixup-modifs (point-min) (point-max)))
-  nil)
-
-;; XEmacs change: we don't seem to have this feature.
-(defvar undo-in-progress nil)
-
-;; It turns out that making changes in the buffer from within an
-;; *-change-function is asking for trouble, whereas making them
-;; from a post-command-hook doesn't pose much problems
-(defvar diff-unhandled-changes nil)
-(defun diff-after-change-function (beg end len)
-  "Remember to fixup the hunk header.
-See `after-change-functions' for the meaning of BEG, END and LEN."
-  ;; Ignoring changes when inhibit-read-only is set is strictly speaking
-  ;; incorrect, but it turns out that inhibit-read-only is normally not set
-  ;; inside editing commands, while it tends to be set when the buffer gets
-  ;; updated by an async process or by a conversion function, both of which
-  ;; would rather not be uselessly slowed down by this hook.
-  (when (and (not undo-in-progress) (not inhibit-read-only))
-    (if diff-unhandled-changes
-	(setq diff-unhandled-changes
-	      (cons (min beg (car diff-unhandled-changes))
-		    (max end (cdr diff-unhandled-changes))))
-      (setq diff-unhandled-changes (cons beg end)))))
-
-(defun diff-post-command-hook ()
-  "Fixup hunk headers if necessary."
-  (when (consp diff-unhandled-changes)
-    (ignore-errors
-      (save-excursion
-	(goto-char (car diff-unhandled-changes))
-	(unless (ignore-errors
-		  (diff-beginning-of-hunk)
-		  (save-excursion
-		    (diff-end-of-hunk)
-		    (> (point) (car diff-unhandled-changes))))
-	  (goto-char (car diff-unhandled-changes))
-	  (re-search-forward diff-hunk-header-re (cdr diff-unhandled-changes))
-	  (diff-beginning-of-hunk))
-	(diff-fixup-modifs (point) (cdr diff-unhandled-changes))))
-    (setq diff-unhandled-changes nil)))
-
-;; XEmacs change: no autoload for this for the transition period
-(defadvice vc-backend-diff (around diff-mode-vc activate)
-  ;; BEWARE!! when this is autoloaded, CL might not be available
-  (condition-case ()
-      (with-current-buffer "*vc-diff*" (setq buffer-read-only nil))
-    (error nil))
-  ad-do-it
-  (condition-case ()
-      (with-current-buffer "*vc-diff*"
-        (if (or (eq major-mode default-major-mode)
-                (memq major-mode '(fundamental-mode text-mode diff-mode)))
-            (diff-mode))
-        (if (eq major-mode 'diff-mode) (font-lock-mode)))
-    (error nil)))
-
-
-;;;; 
-;;;; The main function
-;;;; 
-
-;; XEmacs hack: autoload a dummy autoload instead of a derived mode
-;;;###autoload(autoload 'diff-mode "diff-mode" nil t)
-(define-derived-mode diff-mode fundamental-mode "Diff"
-  "Major mode for viewing/editing context diffs.
-Supports unified and context diffs as well as (to a lesser extent)
-normal diffs.
-When the buffer is read-only, the ESC prefix is not necessary."
-  (set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults)
-  (set (make-local-variable 'outline-regexp) diff-outline-regexp)
-  (set (make-local-variable 'imenu-generic-expression)
-       diff-imenu-generic-expression)
-  ;; These are not perfect.  They would be better done separately for
-  ;; context diffs and unidiffs.
-  ;; (set (make-local-variable 'paragraph-start)
-  ;;        (concat "@@ "			; unidiff hunk
-  ;; 	       "\\|\\*\\*\\* "		; context diff hunk or file start
-  ;; 	       "\\|--- [^\t]+\t"))	; context or unidiff file
-  ;; 					; start (first or second line)
-  ;;   (set (make-local-variable 'paragraph-separate) paragraph-start)
-  ;;   (set (make-local-variable 'page-delimiter) "--- [^\t]+\t")
-  ;; compile support
-
-  ;;;; compile support is not good enough yet.  Also it can be annoying
-  ;; and should thus only be enabled conditionally.
-  ;; (set (make-local-variable 'compilation-file-regexp-alist)
-  ;;      diff-file-regexp-alist)
-  ;; (set (make-local-variable 'compilation-error-regexp-alist)
-  ;;      diff-error-regexp-alist)
-  ;; (when (string-match "\\.rej\\'" (or buffer-file-name ""))
-  ;;   (set (make-local-variable 'compilation-current-file)
-  ;; 	 (substring buffer-file-name 0 (match-beginning 0))))
-  ;; (compilation-shell-minor-mode 1)
-
-  (when (and (> (point-max) (point-min)) diff-default-read-only)
-    (toggle-read-only t))
-  ;; setup change hooks
-  (if (not diff-update-on-the-fly)
-      (add-hook 'write-contents-hooks 'diff-write-contents-hooks)
-    (make-local-variable 'diff-unhandled-changes)
-    ;; XEmacs change: make local
-    (make-local-hook 'after-change-functions)
-    (add-hook 'after-change-functions 'diff-after-change-function nil t)
-    ;; XEmacs change: make local
-    (make-local-hook 'post-command-hook)
-    (add-hook 'post-command-hook 'diff-post-command-hook nil t))
-
-  ;; Neat trick from Dave Love to add more bindings in read-only mode:
-  ;; XEmacs change: we don't have minor-mode-overriding-map-alist
-  (add-to-list (make-local-variable 'minor-mode-map-alist)
-	       (cons 'buffer-read-only diff-mode-shared-map))
-  ;; add-log support
-  (set (make-local-variable 'add-log-current-defun-function)
-       'diff-current-defun)
-  (set (make-local-variable 'add-log-buffer-file-name-function)
-       'diff-find-file-name))
-
-;; XEmacs hack: autoload a dummy autoload instead of a minor mode
-;;;###autoload(autoload 'diff-minor-mode "diff-mode" nil t)
-(define-minor-mode diff-minor-mode
-  "Minor mode for viewing/editing context diffs.
-\\{diff-minor-mode-map}"
-  nil " Diff" nil
-  ;; FIXME: setup font-lock
-  ;; setup change hooks
-  (if (not diff-update-on-the-fly)
-      (add-hook 'write-contents-hooks 'diff-write-contents-hooks)
-    (make-local-variable 'diff-unhandled-changes)
-    (add-hook 'after-change-functions 'diff-after-change-function nil t)
-    (add-hook 'post-command-hook 'diff-post-command-hook nil t)))
-
-
-;;;
-;;; Misc operations that have proved useful at some point.
-;;;
-
-(defun diff-next-complex-hunk ()
-  "Jump to the next \"complex\" hunk.
-\"Complex\" is approximated by \"the hunk changes the number of lines\".
-Only works for unified diffs."
-  (interactive)
-  (while
-      (and (re-search-forward "^@@ [-0-9]+,\\([0-9]+\\) [+0-9]+,\\([0-9]+\\) @@"
-			      nil t)
-	   (equal (match-string 1) (match-string 2)))))
-
-(defun diff-hunk-text (hunk destp &optional char-offset)
-  "Return the literal source text from HUNK.
-if DESTP is nil return the source, otherwise the destination text.
-If CHAR-OFFSET is non-nil, it should be a char-offset in
-HUNK, and instead of a string, a cons cell is returned whose car is the
-appropriate text, and whose cdr is the corresponding char-offset in that text."
-  (with-temp-buffer
-    (insert hunk)
-    (goto-char (point-min))
-    (let ((src-pos nil)
-	  (dst-pos nil)
-	  (divider-pos nil)
-	  (num-pfx-chars 2))
-      ;; Set the following variables:
-      ;;  SRC-POS     buffer pos of the source part of the hunk or nil if none
-      ;;  DST-POS     buffer pos of the destination part of the hunk or nil
-      ;;  DIVIDER-POS buffer pos of any divider line separating the src & dst
-      ;;  NUM-PFX-CHARS  number of line-prefix characters used by this format"
-      (cond ((looking-at "^@@")
-	     ;; unified diff
-	     (setq num-pfx-chars 1)
-	     (forward-line 1)
-	     (setq src-pos (point) dst-pos (point)))
-	    ((looking-at "^\\*\\*")
-	     ;; context diff
-	     (forward-line 2)
-	     (setq src-pos (point))
-	     (re-search-forward "^--- " nil t)
-	     (forward-line 0)
-	     (setq divider-pos (point))
-	     (forward-line 1)
-	     (setq dst-pos (point)))
-	    ((looking-at "^[0-9]+a[0-9,]+$")
-	     ;; normal diff, insert
-	     (forward-line 1)
-	     (setq dst-pos (point)))
-	    ((looking-at "^[0-9,]+d[0-9]+$")
-	     ;; normal diff, delete
-	     (forward-line 1)
-	     (setq src-pos (point)))
-	    ((looking-at "^[0-9,]+c[0-9,]+$")
-	     ;; normal diff, change
-	     (forward-line 1)
-	     (setq src-pos (point))
-	     (re-search-forward "^---$" nil t)
-	     (forward-line 0)
-	     (setq divider-pos (point))
-	     (forward-line 1)
-	     (setq dst-pos (point)))
-	    (t
-	     (error "Unknown diff hunk type")))
-
-      (if (if destp (null dst-pos) (null src-pos))
-	  ;; Implied empty text
-	  (if char-offset '("" . 0) "")
-
-	;; For context diffs, either side can be empty, (if there's only
-	;; added or only removed text).  We should then use the other side.
-	(cond ((equal src-pos divider-pos) (setq src-pos dst-pos))
-	      ((equal dst-pos (point-max)) (setq dst-pos src-pos)))
-
-	(when char-offset (goto-char (+ (point-min) char-offset)))
-
-	;; Get rid of anything except the desired text.
-	(save-excursion
-	  ;; Delete unused text region
-	  (let ((keep (if destp dst-pos src-pos)))
-	    (when (and divider-pos (> divider-pos keep))
-	      (delete-region divider-pos (point-max)))
-	    (delete-region (point-min) keep))
-	  ;; Remove line-prefix characters, and unneeded lines (unified diffs).
-	  (let ((kill-char (if destp ?- ?+)))
-	    (goto-char (point-min))
-	    (while (not (eobp))
-	      (if (eq (char-after) kill-char)
-		  (delete-region (point) (progn (forward-line 1) (point)))
-		(delete-char num-pfx-chars)
-		(forward-line 1)))))
-
-	(let ((text (buffer-substring-no-properties (point-min) (point-max))))
-	  (if char-offset (cons text (- (point) (point-min))) text))))))
-
-
-(defun diff-find-text (text)
-  "Return the buffer position of the nearest occurrence of TEXT.
-If TEXT isn't found, nil is returned."
-  (let* ((orig (point))
-	 (forw (and (search-forward text nil t)
-			  (match-beginning 0)))
-	 (back (and (goto-char (+ orig (length text)))
-		    (search-backward text nil t)
-			  (match-beginning 0))))
-	  ;; Choose the closest match.
-    (if (and forw back)
-	(if (> (- forw orig) (- orig back)) back forw)
-      (or back forw))))
-
-(defsubst diff-xor (a b) (if a (not b) b))
-
-(defun diff-find-source-location (&optional other-file reverse)
-  "Find out (BUF LINE-OFFSET POS SRC DST SWITCHED)."
-  (save-excursion
-    (let* ((other (diff-xor other-file diff-jump-to-old-file))
-	   (char-offset (- (point) (progn (diff-beginning-of-hunk) (point))))
-	   (hunk (buffer-substring (point)
-				   (save-excursion (diff-end-of-hunk) (point))))
-	   (old (diff-hunk-text hunk reverse char-offset))
-	   (new (diff-hunk-text hunk (not reverse) char-offset))
-	   ;; Find the location specification.
-	   (line (if (not (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?"))
-		     (error "Can't find the hunk header")
-		   (if other (match-string 1)
-		     (if (match-end 3) (match-string 3)
-		       (unless (re-search-forward "^--- \\([0-9,]+\\)" nil t)
-			 (error "Can't find the hunk separator"))
-		       (match-string 1)))))
-	   (file (or (diff-find-file-name other) (error "Can't find the file")))
-	   (buf (find-file-noselect file)))
-      ;; Update the user preference if he so wished.
-      (when (> (prefix-numeric-value other-file) 8)
-	(setq diff-jump-to-old-file other))
-      (with-current-buffer buf
-	(goto-line (string-to-number line))
-	(let* ((orig-pos (point))
-	       (pos (diff-find-text (car old)))
-	       (switched nil))
-	  (when (null pos)
-	    (setq pos (diff-find-text (car new)) switched t))
-	  (nconc
-	   (list buf)
-	   (if pos (list (count-lines orig-pos pos) pos) (list nil orig-pos))
-	   (if switched (list new old t) (list old new))))))))
-
-
-(defun diff-hunk-status-msg (line-offset reversed dry-run)
-  (let ((msg (if dry-run
-		 (if reversed "already applied" "not yet applied")
-	       (if reversed "undone" "applied"))))
-    (message (cond ((null line-offset) "Hunk text not found")
-		   ((= line-offset 0) "Hunk %s")
-		   ((= line-offset 1) "Hunk %s at offset %d line")
-		   (t "Hunk %s at offset %d lines"))
-	     msg line-offset)))
-
-
-(defun diff-apply-hunk (&optional reverse)
-  "Apply the current hunk to the source file and go to the next.
-By default, the new source file is patched, but if the variable
-`diff-jump-to-old-file' is non-nil, then the old source file is
-patched instead (some commands, such as `diff-goto-source' can change
-the value of this variable when given an appropriate prefix argument).
-
-With a prefix argument, REVERSE the hunk."
-  (interactive "P")
-  (destructuring-bind (buf line-offset pos old new &optional switched)
-      ;; If REVERSE go to the new file, otherwise go to the old.
-      (diff-find-source-location (not reverse) reverse)
-    (cond
-     ((null line-offset)
-      (error "Can't find the text to patch"))
-     ((and switched
-	   ;; A reversed patch was detected, perhaps apply it in reverse.
-	   (not (save-window-excursion
-		  (pop-to-buffer buf)
-		  (goto-char (+ pos (cdr old)))
-		  (y-or-n-p
-		   (if reverse
-		       "Hunk hasn't been applied yet; apply it now? "
-		     "Hunk has already been applied; undo it? ")))))
-      (message "(Nothing done)"))
-     (t
-      ;; Apply the hunk
-      (with-current-buffer buf
-	(goto-char pos)
-	(delete-char (length (car old)))
-	(insert (car new)))
-      ;; Display BUF in a window
-      (set-window-point (display-buffer buf) (+ pos (cdr new)))
-      (diff-hunk-status-msg line-offset (diff-xor switched reverse) nil)
-      (when diff-advance-after-apply-hunk
-	(diff-hunk-next))))))
-
-
-(defun diff-test-hunk (&optional reverse)
-  "See whether it's possible to apply the current hunk.
-With a prefix argument, try to REVERSE the hunk."
-  (interactive "P")
-  (destructuring-bind (buf line-offset pos src dst &optional switched)
-      ;; If REVERSE go to the new file, otherwise go to the old.
-      (diff-find-source-location (not reverse) reverse)
-    (set-window-point (display-buffer buf) (+ pos (cdr src)))
-    (diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
-
-
-(defun diff-goto-source (&optional other-file)
-  "Jump to the corresponding source line.
-`diff-jump-to-old-file' (or its opposite if the OTHER-FILE prefix arg
-is given) determines whether to jump to the old or the new file.
-If the prefix arg is bigger than 8 (for example with \\[universal-argument] \\[universal-argument])
-  then `diff-jump-to-old-file' is also set, for the next invocations."
-  (interactive "P")
-  ;; When pointing at a removal line, we probably want to jump to
-  ;; the old location, and else to the new (i.e. as if reverting).
-  ;; This is a convenient detail when using smerge-diff.
-  (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
-    (destructuring-bind (buf line-offset pos src dst &optional switched)
-	(diff-find-source-location other-file rev)
-      (pop-to-buffer buf)
-      (goto-char (+ pos (cdr src)))
-      (diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
-
-
-(defun diff-current-defun ()
-  "Find the name of function at point.
-For use in `add-log-current-defun-function'."
-  (destructuring-bind (buf line-offset pos src dst &optional switched)
-      (diff-find-source-location)
-    (save-excursion
-      (beginning-of-line)
-      (or (when (memq (char-after) '(?< ?-))
-	    ;; Cursor is pointing at removed text.  This could be a removed
-	    ;; function, in which case, going to the source buffer will
-	    ;; not help since the function is now removed.  Instead,
-	    ;; try to figure out the function name just from the code-fragment.
-	    (let ((old (if switched dst src)))
-	      (with-temp-buffer
-		(insert (car old))
-		(goto-char (cdr old))
-		(funcall (with-current-buffer buf major-mode))
-		(add-log-current-defun))))
-	  (with-current-buffer buf
-	    (goto-char (+ pos (cdr src)))
-	    (add-log-current-defun))))))
-
-;; XEmacs change: added.
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode))
-
-;; provide the package
-(provide 'diff-mode)
-
-;;; Old Change Log from when diff-mode wasn't part of Emacs:
-;; Revision 1.11  1999/10/09 23:38:29  monnier
-;; (diff-mode-load-hook): dropped.
-;; (auto-mode-alist): also catch *.diffs.
-;; (diff-find-file-name, diff-mode):  add smarts to find the right file
-;;     for *.rej files (that lack any file name indication).
-;;
-;; Revision 1.10  1999/09/30 15:32:11  monnier
-;; added support for "\ No newline at end of file".
-;;
-;; Revision 1.9  1999/09/15 00:01:13  monnier
-;; - added basic `compile' support.
-;; - have diff-kill-hunk call diff-kill-file if it's the only hunk.
-;; - diff-kill-file now tries to kill the leading garbage as well.
-;;
-;; Revision 1.8  1999/09/13 21:10:09  monnier
-;; - don't use CL in the autoloaded code
-;; - accept diffs using -T
-;;
-;; Revision 1.7  1999/09/05 20:53:03  monnier
-;; interface to ediff-patch
-;;
-;; Revision 1.6  1999/09/01 20:55:13  monnier
-;; (ediff=patch-file):  add bindings to call ediff-patch.
-;; (diff-find-file-name):  taken out of diff-goto-source.
-;; (diff-unified->context, diff-context->unified, diff-reverse-direction,
-;;  diff-fixup-modifs):  only use the region if a prefix arg is given.
-;;
-;; Revision 1.5  1999/08/31 19:18:52  monnier
-;; (diff-beginning-of-file, diff-prev-file):  fixed wrong parenthesis.
-;;
-;; Revision 1.4  1999/08/31 13:01:44  monnier
-;; use `combine-after-change-calls' to minimize the slowdown of font-lock.
-;;
-
-;; arch-tag: 2571d7ff-bc28-4cf9-8585-42e21890be66
-;;; diff-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/eiffel.el b/xemacs-packages/lisp/prog-modes/eiffel.el
deleted file mode 100644
index cf5754a9..00000000
--- a/xemacs-packages/lisp/prog-modes/eiffel.el
+++ /dev/null
@@ -1,2070 +0,0 @@
-;;; eiffel.el --- major mode for editing Eiffel files.
-
-;; Copyright (C) 1989, 1990, 1993, 1994, 1995, 1996, 1999, 2000, 2001, 2002
-;;                         Tower Technology Corporation,
-;;                         Free Software Foundation,
-;;                         Bob Weiner,
-;;                         C. Adrian
-
-;; Authors: 1989-1990 Stephen Omohundro, ISE and Bob Weiner
-;;          1993-1996 Tower Technology Corporation
-;;          1999-2002 Martin Schwenke 
-;; Maintainer: martin@meltin.net
-;; Keywords: eiffel languages oop
-;; Requires: font-lock, compile, easymenu
-
-;; This file is derived from eiffel4.el from Tower Technology Corporation.
-;;
-;; Known bugs:
-;;
-;; * eif-short buffer doesn't get font locked under GNU Emacs 19.34.
-;;
-;; This file is distributed under the same terms as 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:
-
-;;  NEW VERSIONS
-;;    The latest version of this mode is always available via:
-;;      http://meltin.net/hacks/emacs/
-
-;;  INSTALLATION
-;;    To install, simply copy this file into a directory in your
-;;    load-path and add the following two commands in your .emacs file:
-;;
-;;    (add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
-;;    (autoload 'eiffel-mode "eiffel" "Major mode for Eiffel programs" t)
-;;
-
-;;; History:
-;;
-
-;; Add history stuff here!!!
-
-;;; Code:
-
-(require 'font-lock)
-(require 'compile)
-(require 'easymenu)
-
-(defconst eiffel-version-string
-  "$Id: eiffel.el,v 2.34 2002/06/07 06:27:58 martins Exp $"
-  "Version string to make reporting bugs more meaningful.
-Note that if this file becomes part of GNU Emacs then the file might
-be changed by the Emacs maintainers without this version number
-changing.  This means that if you are reporting a bug for a version
-that was shipped with Emacs, you should report the Emacs version!")
-
-(defgroup eiffel nil
-  "Eiffel mode for Emacs"
-  :group 'oop)
-
-(defgroup eiffel-indent nil
-  "Indentation variables in Eiffel mode"
-  :prefix "eif-"
-  :group 'eiffel)
-
-(defgroup eiffel-compile nil
-  "Compilation support variables in Eiffel mode"
-  :prefix "eif-"
-  :group 'eiffel)
-
-(defun eif-customize ()
-  "Run \\[customize-group] for the `eiffel' group."
-  (interactive)
-  (customize-group 'eiffel))
-
-;; Indentation amount variables.
-;;
-;; The default values correspond to style used in ``Eiffel: The
-;; Language''.
-
-(defcustom eif-indent-increment 3
-  "*Default indentation interval (in spaces)."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-class-level-kw-indent 0
-  "*Indentation for Class level keywords.
-Specified as number of `eif-indent-increments'.  See the variable
-`eif-class-level-keywords'."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-class-level-kw-indent 0
-  "*Number of extra spaces to add to `eif-class-level-kw-indent'.
-This results in the actual indentation of a class level keyword.  Can
-be negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-class-level-comment-indent 0
-  "*Indentation of comments at the beginning of a class.
-Specified as number of `eif-indent-increments'."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-class-level-comment-indent 0
-  "*Number of spaces to add to `eif-class-level-comment-indent'.
-This results in the actual indentation of a class level comment.  Can
-be negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-inherit-level-kw-indent 2
-  "*Indentation of keywords falling under the Inherit clause.
-Specified as number of `eif-indent-increments'.  See the variable
-`eif-inherit-level-keywords'."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-inherit-level-kw-indent 0
-  "*Number of spaces to add to `eif-inherit-level-kw-indent'.
-This results in the actual indentation of an inherit level keyword.
-Can be negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-feature-level-indent 1
-  "*Indentation amount of features.
-Specified as number of `eif-indent-increments'."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-feature-level-indent 0
-  "*Number of spaces to add to `eif-feature-level-indent'.
-This results in the indentation of a feature.  Can be negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-feature-level-kw-indent 2
-  "*Indentation of keywords belonging to individual features.
-Specified as number of `eif-indent-increments'.  See the variable
-`eif-feature-level-keywords'."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-feature-level-kw-indent 0
-  "*Number of spaces to add to `eif-feature-level-kw-indent'.
-This results in the actual indentation of a feature level keyword.
-Can be negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-feature-level-comment-indent 3
-  "*Indentation of comments at the beginning of a feature.
-Specified as number of `eif-indent-increments'."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-feature-level-comment-indent 0
-  "*Number of spaces to add to `eif-feature-level-comment-indent'.
-This results in the actual indentation of a feature level comment.
-Can be negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-body-comment-indent 0
-  "*Indentation of comments in the body of a routine.
-Specified as number of `eif-indent-increments')"
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-body-comment-indent 0
-  "*Number of spaces to add to `eif-body-comment-indent'.
-This results in the actual indentation of a routine body comment.  Can
-be negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-check-keyword-indent 0
-  "*Extra indentation for the check clause as described in ETL.
-Specified as number of `eif-indent-increments'.  Default is 0, which
-is different than in ETL's 1."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-check-keyword-indent 0
-  "*Number of spaces to add to `eif-check-keyword-indent'.
-This results in the actual indentation of a check keyword.  Can be
-negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-rescue-keyword-indent -1
-  "*Extra indentation for the rescue clause as described in ETL.
-Specified as number of `eif-indent-increments'.  Default is -1."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-rescue-keyword-indent 0
-  "*Number of spaces to add to `eif-rescue-keyword-indent'.
-This results in the actual indentation of a rescue keyword.  Can be
-negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-then-indent 0
-  "*Indentation for a `then' appearing on a line by itself.
-This is as opposed to a `then' on the same line as an `if'.  Specified
-as number of `eif-indent-increments'."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-then-indent 1
-  "*Number of spaces to add to `eif-then-indent'.
-This results in the actual indentation of a `then' appearing on a line
-by itself.  Can be negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-continuation-indent 1
-  "*Extra indentation for a continued statement line.
-Specified as number of `eif-indent-increments'."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-continuation-indent 0
-  "*Number of spaces to add to `eif-continuation-indent'.
-This results in the actual indentation of a continued statement
-line.  Can be negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-string-continuation-indent 0
-  "*Extra indentation for a continued string.
-Specified as number of `eif-indent-increments'."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-extra-string-continuation-indent -1
-  "*Number of spaces to add to `eif-string-continuation-indent'.
-This results in the actual indentation of a continued string.  Can be
-negative."
-  :type 'integer
-  :group 'eiffel-indent)
-
-(defcustom eif-indent-string-continuations-relatively-flag t
-  "*Non-nil means string continuations are indented relative to 1st character.
-That is, `eif-string-continuation-indent' and
-`eif-extra-string-continuation-indent' are added to position of first
-character of string.  If nil, string continuations are indented
-relative to indent of previous line."
-  :type 'boolean
-  :group 'eiffel-indent)
-
-(defcustom eif-set-tab-width-flag t
-  "*Non-nil means `tab-width' is set to `eif-indent-increment' in `eiffel-mode'."
-  :type 'boolean
-  :group 'eiffel-indent)
-
-(defcustom eif-fill-max-save 4096
-  "*Maximum size of a paragraph to save before filling.
-Normally \\[eif-fill-paragraph] will mark a buffer as modified even if
-the fill operation does not make any changes.  If the paragraph being
-filled is smaller than the value of this variable then the contents of
-the paragraph will be saved for comparison with the paragraph after
-the fill operation.  If they are the same, the buffer modification
-state is restored.  Set this to 0 to disable this feature, or a very
-big number to enable it for all paragraphs."
-  :type 'integer
-  :group 'eiffel-indent)
-
-;;
-;; Compilation support for GNU SmallEiffel.
-;;
-
-(defcustom eif-use-gnu-eiffel t
-  "*If t include support for compilation using GNU SmallEiffel."
-  :type 'boolean
-  :group 'eiffel-compile)
-
-(defcustom eif-compile-command
-  (if (file-executable-p "/usr/bin/se-compile")
-      "se-compile"
-    "compile")
-  "*Program to use for compiling Eiffel programs.
-The default is \"compile\", unless \"/usr/bin/se-compile\" exists, as
-in Debian GNU/Linux, when the default value is \"se-compile\"."
-  :type 'string
-  :group 'eiffel-compile)
-
-(defcustom eif-short-command "short"
-  "*Program to use for producing short form of Eiffel classes."
-  :type 'string
-  :group 'eiffel-compile)
-
-(defcustom eif-compile-options ""
-  "*Options to use for compiling Eiffel programs."
-  :type 'string
-  :group 'eiffel-compile)
-
-;;
-;; Font-lock support.
-;;
-(defconst eiffel-font-lock-keywords
-  '(;; major keywords
-    ("\\(\\(^[ \t]*\\|[ \t]+\\)creation\\|^deferred[ \t]+class\\|^expanded[ \t]+class\\|^class\\|^feature\\|^indexing\\|\\(^[ \t]*\\|[ \t]+\\)inherit\\|^obsolete\\)[ \t\n]" 0 font-lock-keyword-face nil)
-    ;; assertions
-    ("\\(^\\|[^_\n]\\<\\)\\(check\\|ensure then\\|ensure\\|invariant\\|require else\\|require\\|variant\\)\\($\\|\\>[^_\n]\\)" 2 font-lock-reference-face nil)
-    ;; minor keywords
-    ("\\(^\\|[^_\n]\\<\\)\\(agent\\|alias\\|all\\|and not\\|and then\\|and\\|as\\|create\\|debug\\|deferred\\|do\\|else\\|elseif\\|end\\|export\\|external\\|from\\|frozen\\|if not\\|if\\|implies not\\|implies\\|infix\\|inspect\\|is deferred\\|is unique\\|is\\|like\\|local\\|loop\\|not\\|obsolete\\|old\\|once\\|or else\\|or not\\|or\\|precursor\\|prefix\\|redefine\\|rename\\|rescue\\|retry\\|select\\|separate\\|strip\\|then\\|undefine\\|unique\\|until\\|when\\|xor\\)\\($\\|\\>[^_\n]\\)" 2 font-lock-function-name-face nil)
-    ;; hidden comments
-    ("--|.*" 0 font-lock-keyword-face t)
-    ;; quoted expr's in comments
-    ("`[^`'\n]*'" 0 font-lock-string-face t))
-  "Regular expressions to use with font-lock mode.")
-
-(defconst eiffel-font-lock-defaults
-  '((eiffel-font-lock-keywords)
-    nil nil nil nil))
-
-(and (boundp 'font-lock-defaults-alist)
-     (add-to-list 'font-lock-defaults-alist
-		  (cons 'eiffel-mode
-			eiffel-font-lock-defaults)))
-
-;;
-;; No user-customizable definitions below this point.
-;;
-
-(defvar eif-compile-dir nil
-  "Current directory where Eiffel compilations are taking place.
-Possibly used for error location.")
-
-(defvar eif-compile-target nil
-  "Current Eiffel compilation target.")
-
-(defvar eif-root-proc "make"
-  "Current Eiffel root procedure.")
-
-(defvar eif-run-command nil
-  "Current command to run after Eiffel compile.")
-
-(defun eif-compilation-mode-hook ()
-  "Hook function to set local value for `compilation-error-screen-columns'.
-This should be nil for SmallEiffel compiles, because column positions are
-returned as character positions rather than screen columns."
-  ;; In Emacs > 20.7 compilation-error-screen-columns is buffer local.
-  (or (assq 'compilation-error-screen-columns (buffer-local-variables))
-      (make-local-variable 'compilation-error-screen-columns))
-  (setq compilation-error-screen-columns nil))
-
-(defun eif-compile ()
-  "Compile an Eiffel root class."
-  (interactive)
-
-  ;; Do the save first, since the user might still have their hand on
-  ;; the mouse.
-  (save-some-buffers (not compilation-ask-about-save) nil)
-
-  (setq eif-compile-dir (file-name-directory (buffer-file-name)))
-  (setq eif-compile-target
-	(file-name-sans-extension
-	 (read-string "Name of root class: "
-		      (or eif-compile-target
-			  (file-name-sans-extension
-			   (file-name-nondirectory (buffer-file-name)))))))
-  (setq eif-root-proc
-	(read-string "Name of root procedure: "
-		     eif-root-proc))
-  (let ((cmd (concat eif-compile-command
-		     " "    eif-compile-options
-		     " -o " eif-compile-target
-		     (if (eq system-type 'windows-nt) ".exe")
-		     " "    eif-compile-target
-		     " "    eif-root-proc))
-	(compilation-mode-hook (cons 'eif-compilation-mode-hook
-				     compilation-mode-hook)))
-    (compile-internal cmd "No more errors")))
-
-(defun eif-set-compile-options ()
-  "Set Eiffel compiler options."
-  (interactive)
-  (setq eif-compile-options
-	(read-string "Eiffel compiler options: " eif-compile-options)))
-
-;; Taken from Emacs 20.3 subr.el (just in case we're running under Emacs 19).
-(defun eif-split-string (string &optional separators)
-  "Split STRING into substrings separated by 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]+\".
-
-If there is match for SEPARATORS at the beginning of STRING, we do not
-include a null substring for that.  Likewise, if there is a match
-at the end of STRING, we do not include a null substring for that."
-  (let ((rexp (or separators "[ \f\t\n\r\v]+"))
-	(start 0)
-	notfirst
-	(list nil))
-    (while (and (string-match rexp string
-			      (if (and notfirst
-				       (= start (match-beginning 0))
-				       (< start (length string)))
-				  (1+ start) start))
-		(< (match-beginning 0) (length string)))
-      (setq notfirst t)
-      (or (eq (match-beginning 0) 0)
-	  (and (eq (match-beginning 0) (match-end 0))
-	       (eq (match-beginning 0) start))
-	  (setq list
-		(cons (substring string start (match-beginning 0))
-		      list)))
-      (setq start (match-end 0)))
-    (or (eq start (length string))
-	(setq list
-	      (cons (substring string start)
-		    list)))
-    (nreverse list)))
-
-(defun eif-run ()
-  "Run a compiled Eiffel program."
-  (interactive)
-  (setq eif-run-command
-	(read-string "Command to run: "
-		     (or eif-run-command
-			 eif-compile-target
-			 (file-name-sans-extension
-			  (if (eq system-type 'windows-nt)
-			      buffer-file-name
-			    (file-name-nondirectory (buffer-file-name)))))))
-
-  (let* ((tmp-buf (current-buffer))
-	 (words   (eif-split-string eif-run-command))
-	 (cmd     (expand-file-name (car words))))
-
-    (apply 'make-comint cmd cmd nil (cdr words))
-    (switch-to-buffer tmp-buf)
-    (switch-to-buffer-other-window (concat "*" cmd "*"))))
-
-;; This has been loosened up to spot parts of messages that contain
-;; references to multiple locations.  Thanks to Andreas
-;; .  Also, the column number is a character
-;; count rather than a screen column, so we need to make sure that
-;; compilation-error-screen-columns is nil.  Note that in XEmacs this
-;; variable doesn't exist, so we end up in the wrong column.  Hey, at
-;; least we're on the correct line!
-(add-to-list 'compilation-error-regexp-alist
-	     '("^Line \\([0-9]+\\) column \\([0-9]+\\) in [^ ]+ (\\([^)]+\\.[Ee]\\))" 3 1 2))
-
-(defun eif-short ()
-  "Display the short form of an Eiffel class."
-  (interactive)
-  (let* ((class (read-string
-		 "Class or file: "
-		 (if (buffer-file-name)
-		     (file-name-nondirectory (buffer-file-name)))))
-	 (buf (get-buffer-create (concat "*Eiffel - short " class "*"))))
-
-    (shell-command (concat eif-short-command " " class) buf)
-    (save-excursion
-      (set-buffer buf)
-      (let ((font-lock-defaults eiffel-font-lock-defaults))
-	(font-lock-fontify-buffer))
-      (toggle-read-only 1))))
-
-;;
-;; Indentation macros.
-;;
-
-(defmacro eif-class-level-kw-indent-m ()
-  "Indentation amount for Class level keywords (in number of spaces)."
-  '(+ (* eif-class-level-kw-indent eif-indent-increment)
-      eif-extra-class-level-kw-indent))
-
-(defmacro eif-class-level-comment-indent-m ()
-  "Indentation amount for Class level comments (in number of spaces)."
-  '(+ (* eif-class-level-comment-indent eif-indent-increment)
-      eif-extra-class-level-comment-indent))
-
-(defmacro eif-inherit-level-kw-indent-m ()
-  "Indentation amount for Inherit level keywords (in number of spaces)."
-  '(+ (* eif-inherit-level-kw-indent eif-indent-increment)
-      eif-extra-inherit-level-kw-indent))
-
-(defmacro eif-feature-level-indent-m ()
-  "Indentation amount for features (in number of spaces)."
-  '(+ (* eif-feature-level-indent eif-indent-increment)
-      eif-extra-feature-level-indent))
-
-(defmacro eif-feature-level-kw-indent-m ()
-  "Indentation amount for Feature level keywords (in number of spaces)."
-  '(+ (* eif-feature-level-kw-indent eif-indent-increment)
-      eif-extra-feature-level-kw-indent))
-
-(defmacro eif-body-comment-indent-m ()
-  "Indentation amount for comments in routine bodies (in number of spaces)."
-  '(+ (* eif-body-comment-indent eif-indent-increment)
-      eif-extra-body-comment-indent))
-
-(defmacro eif-feature-level-comment-indent-m ()
-  "Indentation amount for Feature level comments (in number of spaces)."
-  '(+ (* eif-feature-level-comment-indent eif-indent-increment)
-      eif-extra-feature-level-comment-indent))
-
-(defmacro eif-check-keyword-indent-m ()
-  "Indentation amount for Check keyword (in number of spaces)."
-  '(+ (* eif-check-keyword-indent eif-indent-increment)
-      eif-extra-check-keyword-indent))
-
-(defmacro eif-rescue-keyword-indent-m ()
-  "Indentation amount for Rescue keyword (in number of spaces)."
-  '(+ (* eif-rescue-keyword-indent eif-indent-increment)
-      eif-extra-rescue-keyword-indent))
-
-(defmacro eif-then-indent-m ()
-  "Indentation amount for `then' appearing on a line by itself (in number of spaces)."
-  '(+ (* eif-then-indent eif-indent-increment)
-      eif-extra-then-indent))
-
-(defmacro eif-continuation-indent-m ()
-  "Indentation amount for a statement continuation line (in number of spaces)."
-  '(+ (* eif-continuation-indent eif-indent-increment)
-      eif-extra-continuation-indent))
-
-(defmacro eif-string-continuation-indent-m ()
-  "Indentation amount for a statement continuation line (in number of spaces)."
-  '(+ (* eif-string-continuation-indent eif-indent-increment)
-      eif-extra-string-continuation-indent))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;          Keyword Regular Expression Variables.               ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defconst eif-all-keywords-regexp
-  "\\(indexing\\|class\\|inherit\\|creation\\|feature\\|invariant\\|rename\
-\\|redefine\\|undefine\\|select\\|export\\|require\\|local\\|deferred\
-\\|do\\|once\\|ensure\\|alias\\|external\\|check\\|rescue\\|debug\\|if\
-\\|inspect\\|from\\|else\\|elseif\\|when\\|until\\|variant\\|loop\\|then\
-\\|obsolete\\|end\\|separate\\)[^a-z0-9_]"
-  "Regular Expression to identify the presence of any eiffel keyword in a line.
-Does not include `is'.")
-
-;; Note invariant is handled as a special case since it is both a
-;; class-level and a from-level keyword
-;; Note obsolete is handled as a special case since it is both a
-;; class-level and a feature-level keyword
-(defconst eif-class-level-keywords
-  "\\(indexing\\|class\\|deferred[ \t]+class\\|expanded[ \t]+class\\|separate[ \t]+class\\|inherit\\|creation\\|feature\\)[^a-z0-9_]"
-  "Keywords introducing class-level clauses.
-Note that `invariant' and `obsolete' are not included here since can
-function as more than one type of keyword.")
-
-(defconst eif-inherit-level-keywords
-  "\\(rename\\|redefine\\|undefine\\|select\\|export\\)"
-  "Those keywords which introduce subclauses of the inherit clause.")
-
-(defconst eif-feature-level-keywords
-  "\\(require\\|local\\|deferred\\|separate\\|do\\|once\\|ensure\\|alias\\|external\\)[^a-z0-9_]"
-  "Those keywords which are internal to features (in particular, routines).")
-
-(defconst eif-end-keyword "end" "The `end' keyword.")
-
-(defconst eif-end-on-current-line ".*[ \t]end[ \t]*;?[ \t]*\\(--.*\\)?$"
-  "Regular expression to identify lines ending with the `end' keyword.")
-
-(defconst eif-non-id-char-regexp "[^a-z0-9_]"
-  "The characters that are not part of identifiers.")
-
-(defconst eif-end-keyword-regexp "\\(^\\|[^a-z0-9_]\\)end\\($\\|[^a-z0-9_]\\)"
-  "The `end' keyword with context.")
-
-(defconst eif-end-matching-keywords
-  "\\(check\\|class\\|debug\\|feature\\|rename\\|redefine\\|undefine\\|select\\|export\\|do\\|once[ \t\n]+[^\"]\\|deferred\\|separate\\|external\\|alias\\|if\\|inspect\\|from\\|debug\\)[^a-z0-9_]"
-  "Those keywords whose clause is terminated by an `end' keyword.")
-
-(defconst eif-control-flow-keywords
-  "\\(if\\|inspect\\|from\\|debug\\)"
-  "Keywords which introduce control-flow constructs.")
-
-(defconst eif-control-flow-matching-keywords
-  "\\(deferred\\|do\\|once\\|if\\|inspect\\|from\\|debug\\)[^a-z0-9_]"
-  "Keywords that may cause the indentation of an `eif-control-flow-keyword'.
-If these occur prior to an `eif-control-flow-keyword' then the
-`eif-control-flow-keyword' is indented.  Note that technically, `end'
-is part of this list but it is handled separately in the functions
-\[eif-matching-indent\] and \[eif-matching-kw\].")
-
-(defconst eif-check-keyword "check"
-  "The `check' keyword.")
-
-(defconst eif-check-keywords   "\\(check\\)[^a-z0-9_]"
-  "The `check' keyword (with trailing context).")
-
-(defconst eif-check-matching-keywords
-  "\\(deferred\\|do\\|once\\|if\\|inspect\\|from\\|debug\\)[^a-z0-9_]"
-  "Keywords that may cause the indentation of an `eif-check-keyword'.
-If these occur prior to an `eif-check-keyword' then the
-`eif-check-keyword' is indented.  Note that technically, `end' is part
-of this list but it is handled separately in the functions
-\[eif-matching-indent\] and \[eif-matching-kw\].  See also
-`eif-control-flow-matching-keywords'.")
-
-(defconst eif-rescue-keyword "rescue"  "The `rescue' keyword.")
-
-(defconst eif-obsolete-keyword "obsolete"  "The `obsolete' keyword.")
-
-(defconst eif-rescue-keywords   "\\(rescue\\)[^a-z0-9_]"
-  "The `rescue' keyword (with trailing context).")
-
-(defconst eif-rescue-matching-keywords
-  "\\(deferred\\|do\\|once\\)[^a-z0-9_]"
-  "Keywords that may cause the indentation of an `eif-rescue-keyword'.
-If these occur prior to an `eif-rescue-keyword' then the
-`eif-rescue-keyword' is indented.  Note that technically, `end' is
-part of this list but it is handled separately in the functions
-\[eif-matching-indent\] and \[eif-matching-kw\].  See also
-`eif-control-flow-matching-keywords'.")
-
-(defconst eif-from-level-keywords
-  "\\(until\\|variant\\|loop\\)[^a-z0-9_]"
-  "Keywords occuring inside of a from clause.")
-
-(defconst eif-from-keyword  "from" "The keyword `from'.")
-
-(defconst eif-if-or-inspect-level-keywords "\\(elseif\\|else\\|when\\)[^a-z0-9_]"
-  "Keywords occuring inside of an if or inspect clause.")
-
-(defconst eif-if-or-inspect-keyword "\\(if\\|inspect\\)[^a-z0-9_]"
-  "The `if' or `inspect' keywords.")
-
-(defconst eif-then-keyword ".*[ \t)]then[ \t]*$"
-  "The keyword `then' with possible leading text.")
-
-(defconst eif-solitary-then-keyword "then" "The keyword `then'.")
-
-(defconst eif-then-matching-keywords "\\(if\\|elseif\\|when\\)"
-  "Keywords that may alter the indentation of an `eif-then-keyword'.
-If one of these occur prior to an `eif-then-keyword' then this sets
-the indentation of the `eif-then-keyword'.  Note that technically,
-`end' is part of this list but it is handled separately in the
-functions \[eif-matching-indent\] and \[eif-matching-kw\].  See also
-`eif-control-flow-matching-keywords'.")
-
-(defconst eif-invariant-keyword "invariant" "The `invariant' keyword.")
-
-(defconst eif-invariant-matching-keywords
-  "\\(from\\|feature\\)"
-  "Keywords that may cause the indentation of an `eif-invarient-keyword'.
-If one of these occurs prior to an `eif-invariant-keyword' then the
-`eif-invariant-keyword' is indented.  Note that technically, `end' is
-part of this list but it is handled separately in the functions
-\[eif-matching-indent\] and \[eif-matching-kw\].  See also
-`eif-control-flow-matching-keywords'.")
-
-(defconst eif-obsolete-matching-keywords
-  "\\(is\\|class\\)"
-  "Keywords that may cause the indentation of an `eif-obsolete-keyword'.
-If one of these occurs prior to an `eif-obsolete-keyword' then the
-`eif-obsolete-keyword' is indented.")
-
-(defconst eif-white-space-regexp       "[ \t]*"
-  "RE to locate whitespace.")
-
-(defconst eif-comment-line-regexp      "[ \t]*\\(--.*\\)$"
-  "RE to match a line with a comment on it.")
-
-(defconst eif-non-source-line          "[ \t]*\\(--.*\\)?$"
-  "RE to match a line with a only a comment or whitespace.")
-
-(defconst eif-variable-or-const-regexp "[^()\n]*:[^=].*"
-  "RE to match a variable or constant declaration.")
-
-(defconst eif-indentation-keywords-regexp
-  "\\(indexing\\|class\\|check\\|rescue\\|inherit\\|creation\\|feature\\|invariant\\|rename\\|redefine\\|undefine\\|select\\|export\\|require\\|local\\|deferred\\|separate\\|do\\|once\\|ensure\\|alias\\|external\\|if\\|inspect\\|from\\|debug\\|else\\|elseif\\|when\\|until\\|variant\\|invariant\\|loop\\|obsolete\\)[^a-z0-9_]"
-  "RE to identify the presence of any eiffel keyword triggering indentation.")
-
-(defconst eif-feature-indentation-keywords-regexp
-  "\\(creation\\|feature\\)[^a-z0-9_]"
-  "Keywords which denote the presence of features following them.")
-
-(defconst eif-is-keyword-regexp "\\(.*[ \t)]\\)?is[ \t]*\\(--.*\\)?$"
-  "The `is' keyword (with some context).")
-
-(defconst eif-multiline-routine-is-keyword-regexp
-  ".*([^)]*)\\([ \t\n]*\\|[ \t\n]*:[][ \t\nA-Za-x0-9_,]*\\)is[ \t]*\\(--.*\\)?$"
-  "The `is' keyword (with some context).")
-
-(defconst eif-operator-regexp
-  "[ \t]*\\([@*/+]\\|-[^-]\\|\\<\\(and\\|or\\|implies\\)[ \t(]\\)"
-  "Eiffel operators - used to identify continuation lines.")
-
-(defconst eif-operator-eol-regexp
-  ".*\\([@*/+-]\\|\\ (eif-in-paren-expression) 0)
-		     (> (setq indent (eif-indent-multi-line)) -1))
-		(setq indent (eif-manifest-array-indent)))
-
-	    ;; multi-line parenthesis expression
-	    ;; Move string continuation lines as per configuration.
-	    (if (looking-at "%")
-		(setq indent (+ indent (eif-string-continuation-indent-m))))
-
-	  ;; Else Find the first preceding line with non-comment source on it
-	  ;; that is not a continuation line of a multi-line parnethesized
-	  ;; expression.
-
-	  ;; Record whether this line begins with an operator.  We assume
-	  ;; that the line is a continuation line if it begins with an operator
-	  (beginning-of-line)
-	  (if (looking-at eif-operator-regexp)
-	      (setq continuation t)
-	    (setq continuation nil))
-	  ;; Record whether the line being indented begins with an " :"
-	  ;; This is used in indenting assertion tag expressions.
-	  (if (looking-at "[ \t]*[a-zA-Z0-9_]+[ \t]*:")
-	      (setq id-colon t)
-	    (setq id-colon nil))
-
-	  (forward-line -1)
-	  (beginning-of-line)
-	  (while (and (looking-at eif-non-source-line) (not (= (point) 1)))
-	    (forward-line -1)
-	    (beginning-of-line))
-	  (if (eif-line-contains-close-paren)
-	      (backward-sexp))
-	  (end-of-line)
-	  (setq line-end (point))
-	  (beginning-of-line)
-	  (re-search-forward eif-white-space-regexp line-end t)
-
-	  (cond ((and (= (point) 1)
-		      originally-looking-at-comment
-		      (setq indent (eif-class-level-comment-indent-m))))
-		;; 'eif-is-keyword-regexp' case must precede
-		;; '(not eif-all-keywords-regexp)' case since "is" is not
-		;; part of 'eif-all-keywords-regexp'
-		((or (looking-at eif-is-keyword-regexp)
-		     (looking-at eif-multiline-routine-is-keyword-regexp)
-		     (looking-at eif-obsolete-keyword))
-		 (if originally-looking-at-comment
-		     ;; Then  the line we are trying to indent is a comment
-		     (setq indent (eif-feature-level-comment-indent-m))
-		   ;; Else  the line being indented is not a comment
-		   (setq indent (eif-feature-level-kw-indent-m))))
-		((looking-at eif-feature-indentation-keywords-regexp)
-		 (setq indent (eif-feature-level-indent-m)))
-		((looking-at eif-indentation-keywords-regexp)
-		 (if (looking-at eif-end-on-current-line)
-		     (setq indent (eif-current-line-indent))
-		   (setq indent
-			 (+ (eif-current-line-indent) eif-indent-increment))))
-		((looking-at eif-solitary-then-keyword)
-		 (setq indent (- (+ (eif-current-line-indent) eif-indent-increment)
-				 (eif-then-indent-m))))
-		((looking-at eif-then-keyword)
-		 (setq indent (eif-current-line-indent)))
-		((looking-at (concat eif-end-keyword eif-non-id-char-regexp))
-		 (if (= (setq indent (eif-current-line-indent))
-			(eif-feature-level-kw-indent-m))
-		     (setq indent (eif-feature-level-indent-m))
-		   (eif-matching-line)
-		   (if (string-match eif-check-keyword eif-matching-kw-for-end)
-		       (setq indent (- indent (eif-check-keyword-indent-m))))))
-		((looking-at eif-variable-or-const-regexp)
-		 ;;Either a variable declaration or a pre or post condition tag
-		 (if originally-looking-at-comment
-		     ;; Then  the line we are trying to indent is a comment
-		     (if (= (setq indent (eif-current-line-indent))
-			    (eif-feature-level-indent-m))
-			 ;; Then - a feature level comment
-			 (setq indent (eif-feature-level-comment-indent-m))
-		       ;; Else - some other kind of comment
-		       (setq indent (+ indent (eif-body-comment-indent-m))))
-		   ;; Else  the line being indented is not a comment
-		   (if (setq indent (eif-indent-assertion-continuation id-colon))
-		       indent
-		     ;; One of the ways of getting here is when we're
-		     ;; in a split line in an indexing clause.
-		     ;; Strings on their own need to be given some
-		     ;; extra indent.
-		     (if originally-looking-at-lone-string
-			 (if (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
-			     (setq indent (eif-current-line-indent))
-			   (setq indent (+ (eif-current-line-indent)
-					   eif-indent-increment)))
-		       (setq indent (eif-current-line-indent))))))
-		((setq indent (eif-manifest-array-start))
-		 indent)
-		((not (looking-at eif-all-keywords-regexp))
-		 (if originally-looking-at-comment
-		     ;; Then  the line we are trying to indent is a comment
-		     (cond ((eif-continuation-line)
-			    (setq indent
-				  (+ (- (eif-current-line-indent)
-					eif-indent-increment)
-				     (eif-body-comment-indent-m))))
-			   ;; preceding line is at eif-feature-level-indent -
-			   ;; assume that the preceding line is a parent
-			   ;; class in an inherit clause
-			   ((= (eif-current-line-indent)
-			       (eif-feature-level-indent-m))
-			    (setq indent
-				  (+ (eif-inherit-level-kw-indent-m)
-				     (eif-body-comment-indent-m))))
-			   (t
-			    (setq indent
-				  (+ (eif-current-line-indent)
-				     (eif-body-comment-indent-m)))))
-		   ;; Else line being indented is not a comment
-
-		   ;; The line the point is on is the one above the line being
-		   ;; indented
-		   (beginning-of-line)
-		   (if (or continuation (looking-at eif-operator-eol-regexp))
-		       ;; Then the line being indented is a continuation line
-		       (if  (eif-continuation-line)
-			   ;; The line preceding the line being indented is
-			   ;; also a continuation line.  Indent to the current
-			   ;; line indentation.
-			   (setq indent (eif-current-line-indent))
-			 ;; Else The line preceding the line being indented is
-			 ;; not a continuation line.  Indent an extra
-			 ;; eif-continuation-indent
-			 (setq indent (+ (eif-current-line-indent)
-					 (eif-continuation-indent-m))))
-		     ;; Else the line being indented is not a continuation line.
-		     (if (eif-continuation-line)
-			 (if id-colon
-			     ;; Then the line preceding the one being indented
-			     ;; is an assertion continuation.  Indent the current
-			     ;; line to the same level as the preceding assertion
-			     ;; tag.
-			     (setq indent (eif-indent-assertion-tag))
-			   ;; Then the line preceding the one being indented is
-			   ;; a continuation line.  Un-indent by an
-			   ;; eif-continuation-indent.
-			   (setq indent (- (eif-current-line-indent)
-					   eif-indent-increment)))
-		       ;; Else the line preceding the line being indented is
-		       ;; also not a continuation line.
-
-		       (if (and (looking-at "[ \t]*\"[^\"]*\"[ \t]*$")
-				(not originally-looking-at-lone-string))
-			   (setq indent (- (eif-current-line-indent)
-					   eif-indent-increment))
-			 ;; Else use the current indent.
-			 (setq indent (eif-current-line-indent)))))))))))
-    indent))
-
-(defun eif-continuation-line ()
-  "Return non-nil if the current line is a continuation line."
-  (or (looking-at eif-operator-regexp)
-      (save-excursion
-	(forward-line -1)
-	(beginning-of-line)
-	(looking-at eif-operator-eol-regexp))))
-
-(defun eif-indent-assertion-continuation (id-colon)
-  "Generally, are we in line that is a continuation of an assertion?
-More precisely, are we inside a pre or a post condition clause on a
-line that is a continuation of a multi-line assertion beginning with a
-tag?  If so, return the indentation of the continuation line.  The
-argument ID-COLON is t if the line we are indenting begins with
-\" :\", and nil otherwise."
-  (let ((limit (point)))
-    (if (save-excursion
-	  (if (re-search-backward (concat eif-feature-level-keywords "\\|"
-					  eif-end-keyword-regexp) nil t)
-	      (if (looking-at "ensure\\|require")
-		  (setq limit (point)))))
-	(save-excursion
-	  (end-of-line)
-	  (if (and (not id-colon) (re-search-backward ": *" limit t))
-	      (progn
-		(goto-char (match-end 0))
-		(current-column)))))))
-
-(defun eif-indent-assertion-tag ()
-  "Return indentation for part of a multi-line assertion.
-That is, the current line is assumed to be a continuation of a
-multi-line assertion, and we return the required indentation."
-  (save-excursion
-    (if (re-search-backward "ensure\\|require\\|variant\\|invariant" nil t)
-	(+ (eif-current-line-indent) eif-indent-increment)
-      ;; This option should not occur
-      (error "Could not find assertion tag"))))
-
-(defun eif-matching-indent (matching-keyword-regexp)
-  "Search backwards for a keyword in MATCHING-KEYWORD-REGEXP.
-Return the indentation of the keyword found.  If an `end' keyword
-occurs prior to finding one of the keywords in MATCHING-KEYWORD-REGEXP
-and it terminates a check clause, return the indentation of the `end'
-minus the value of `eif-check-keyword-indent'."
-  (let ((search-regexp (concat "[^a-z0-9A-Z_]"
-			       eif-end-keyword
-			       "[^a-z0-9A-Z_]\\|[^a-z0-9A-Z_]"
-			       matching-keyword-regexp))
-	(indent 0)
-	(continue t))
-    (save-excursion
-      (while (and (re-search-backward search-regexp 1 t)
-		  (eif-in-comment-or-quoted-string-p)))
-      (if (looking-at search-regexp)
-	  ;; Then
-	  (if (and (looking-at eif-end-keyword-regexp)
-		   (eif-matching-line)
-		   (string-match eif-check-keyword eif-matching-kw-for-end))
-	      ;; The keyword "end" was found that terminated a "check" clause
-	      (setq indent (- (eif-current-line-indent)
-			      (eif-check-keyword-indent-m)))
-	    ;; Else a keyword in "matching-keyword-regexp" or a normal
-	    ;; "end"was found
-	    (setq indent (eif-current-line-indent)))
-	;; Else
-	(message "No matching indent keyword was found"))
-      indent)))
-
-(defun eif-matching-kw (matching-keyword-regexp)
-  "Search backwards for a keyword in MATCHING-KEYWORD-REGEXP.
-Return the keyword found.  Also set the value of variable
-`eif-matching-indent' to the indentation of the keyword found.  If an
-`end' keyword occurs prior to finding one of the keywords in
-MATCHING-KEYWORD-REGEXP and it terminates a check clause, set the
-value of variable `eif-matching-indent' to the indentation of the
-`end' minus the value of `eif-check-keyword-indent'."
-  (let ((search-regexp (concat "[^a-z0-9A-Z_.]"
-			       eif-end-keyword
-			       "[^a-z0-9A-Z_.]\\|[^a-z0-9A-Z_.]"
-			       matching-keyword-regexp))
-	(keyword ""))
-    (save-excursion
-      ;; Search backward for a matching keyword.
-      (while (and (re-search-backward search-regexp 1 t)
-		  (eif-in-comment-or-quoted-string-p)))
-      (if (looking-at search-regexp)
-	  ;; Then - a keyword was found
-	  (progn
-	    (setq keyword
-		  (buffer-substring (match-beginning 0) (match-end 0)))
-	    (if (and (looking-at eif-end-keyword-regexp)
-		     (eif-matching-line)
-		     (string-match eif-check-keyword eif-matching-kw-for-end))
-		;; Then
-		(setq eif-matching-indent
-		      (- (eif-current-line-indent) (eif-check-keyword-indent-m)))
-	      ;; Else
-	      (setq eif-matching-indent (eif-current-line-indent))))
-	;; Else no keyword was found.  I think this is an error
-	(setq eif-matching-indent 0)
-	(message "No matching indent keyword was found"))
-      keyword)))
-
-(defun eif-line-contains-close-paren ()
-  "Return t if the current line contains a close paren, nil otherwise.
-If a close paren is found, the point is placed immediately after the
-last close paren on the line.  If no paren is found, the point is
-placed at the beginning of the line."
-  (let ((search-min 0))
-    (beginning-of-line)
-    (setq search-min (point))
-    (end-of-line)
-    (if (search-backward ")" search-min t)
-	;; Then
-	(progn
-	  (forward-char 1)
-	  t)
-      ;; Else
-      (beginning-of-line)
-      nil)))
-
-;; Not Currently Used
-;;(defun eif-quoted-string-on-line-p ()
-;;  "t if an Eiffel quoted string begins, ends, or is continued
-;;   on current line."
-;;  (save-excursion
-;;    (beginning-of-line)
-;;    ;; Line must either start with optional whitespace immediately followed
-;;    ;; by a '%' or include a '\"'.  It must either end with a '%' character
-;;    ;; or must include a second '\"' character.
-;;    (looking-at "^\\([ \t]*%\\|[^\"\n]*\"\\)[^\"\n]*\\(%$\\|\"\\)")))
-
-(defconst eif-opening-regexp
-  "\\<\\(external\\|check\\|deferred\\|do\\|once\\|from\\|if\\|inspect\\)\\>"
-  "Keywords that open eiffel nesting constructs.")
-(defconst eif-closing-regexp "\\"
-  "Keywords that close eiffel nesting constructs.")
-(defconst eif-do-regexp "\\"
-  "Keyword that opens eiffel routine body.")
-(defconst eif-opening-or-closing-regexp
-  (concat "\\(" eif-opening-regexp "\\|" eif-closing-regexp "\\)")
-  "Keywords that open or close eiffel nesting constructs.")
-
-;;
-;; Code to allow indenting whole eiffel blocks
-;;
-
-(defun eif-matching-line (&optional return-line-break direction)
-  "Return the position of the keyword matching the one on the current line.
-For example, a line containing the keyword `do' is matched by a line
-containing the keyword `end' and a line containing `end' may be
-matched by a number of opening keywords.  If the optional parameter
-RETURN-LINE-BREAK is non-nil, the character position returned is the
-beginning (or end) of the line containing the matching keyword instead
-of the position of the keyword itself.  If the second optional
-parameter, DIRECTION, is non-nil, the current line is not searched for
-a keyword.  Instead, if the value of direction is 'forward, the
-function acts as if an `eif-opening-regexp' is on the current line.
-If the value of direction is 'backward, the function acts as if a
-`eif-closing-regexp' is on the current line.  The effect of using the
-direction parameter is to locate either the opening or closing keyword
-of the syntactic construct containing the point."
-  (let ((nesting-level 0)
-	(search-end 0)
-	matching-point opening-keyword match-start match-end
-	success start-point)
-    (unwind-protect
-	(save-excursion
-	  (modify-syntax-entry ?_  "w  ")
-	  (setq eif-matching-kw-for-end "");; public variable set by this function
-	  (setq start-point (point))
-	  (end-of-line)
-	  (setq search-end (point))
-	  (beginning-of-line)
-	  ;; Set starting state: If direction was specified use it.
-	  ;; If direction is nil, search for a keyword on the current line
-	  ;; If the keyword is in eif-opening-regexp, set the search
-	  ;; direction to 'forward, if the keyword on the current line is `end'
-	  ;; set the search direction to 'backward.
-	  (cond ((eq direction 'forward)
-		 (end-of-line)       ;; So we wont see keywords on this line.
-		 (setq nesting-level 1))
-		((eq direction 'backward)
-		 (beginning-of-line) ;; So we wont see keywords on this line.
-		 (setq nesting-level -1))
-		((and (re-search-forward eif-opening-regexp search-end t)
-		      (eif-not-in-comment-or-quoted-string-p))
-		 (setq match-start (match-beginning 0))
-		 (goto-char match-start)
-		 (if (eif-not-in-comment-or-quoted-string-p)
-		     (setq nesting-level 1))
-		 (setq opening-keyword
-		       (cons (buffer-substring match-start (match-end 0))
-			     opening-keyword))
-		 (goto-char (match-end 0)))
-		((and (progn (beginning-of-line) t)
-		      (re-search-forward eif-closing-regexp search-end t)
-		      (eif-not-in-comment-or-quoted-string-p))
-		 (goto-char (match-beginning 0))
-		 (if (eif-not-in-comment-or-quoted-string-p)
-		     (setq nesting-level -1))))
-	  ;; Perform the search
-	  (while (not (= nesting-level 0))
-	    (if (> nesting-level 0)
-		;; Then search forward for the next keyword not in a comment
-		(while (and (re-search-forward eif-opening-or-closing-regexp nil 1)
-			    (goto-char (setq match-start (match-beginning 0)))
-			    (setq match-end   (match-end 0))
-			    (setq success t)
-			    (eif-in-comment-or-quoted-string-p))
-		  (goto-char match-end)
-		  (setq success nil))
-	      ;; Else search backward for the next keyword not in a comment
-	      (while (and (re-search-backward eif-opening-or-closing-regexp nil 1)
-			  (goto-char (setq match-start (match-beginning 0)))
-			  (setq success t)
-			  (eif-in-comment-or-quoted-string-p))
-		(setq success nil)))
-	    (cond ((and (looking-at eif-opening-regexp) success)
-		   ;; Found an opening keyword
-		   (if (> nesting-level 0)
-		       ;; Then
-		       (if (looking-at eif-do-regexp)
-			   ;; Then
-			   (setq nesting-level -1)
-			 ;; Else
-			 (setq opening-keyword
-			       (cons (buffer-substring match-start
-						       (match-end 0))
-				     opening-keyword))
-			 (goto-char (match-end 0)))
-		     ;; Else
-		     (if (= nesting-level -1)
-			 ;; Then
-			 (progn
-			   (setq eif-matching-kw-for-end
-				 (buffer-substring match-start (match-end 0)))
-			   (if (looking-at "[ \t\n]+")
-			       (goto-char (match-end 0))))
-		       ;; Else
-		       (if (looking-at eif-do-regexp)
-			   ;; Then
-			   (progn
-			     (goto-char (eif-matching-line nil 'forward))
-			     (setq nesting-level -1))))
-		     (setq opening-keyword (cdr opening-keyword))
-		     (if return-line-break
-			 (beginning-of-line)))
-		   (setq nesting-level (1+ nesting-level)))
-		  ((and (looking-at eif-closing-regexp) success)
-		   ;; Found an opening keyword
-		   (if (> nesting-level 0)
-		       ;; Then
-		       (progn
-			 (setq opening-keyword (cdr opening-keyword))
-			 (if return-line-break
-			     (end-of-line))
-			 (goto-char (match-end 0)))
-		     ;; Else
-		     (setq opening-keyword
-			   (cons (buffer-substring (match-beginning 0)
-						   (match-end 0))
-				 opening-keyword)))
-		   (setq nesting-level (1- nesting-level)))
-		  (t (message (concat "Could not find match"
-				      (if (car opening-keyword)
-					  (concat " for: "
-						  (car opening-keyword)))))
-		     (goto-char start-point)
-		     (setq nesting-level 0))))
-	  (setq matching-point (point)))
-      (modify-syntax-entry ?_  "_  "))
-    (set-mark matching-point)))
-
-;; ENHANCEME: Make this function correctly indent more than just routine
-;;            bodies and their sub-constructs.  At the least it should
-;;            handle whole routines also.
-(defun eif-indent-construct ()
-  "Indent an entire eiffel syntactic construct.
-It is assumed that the point is within a nesting construct ('do',
-`once', 'check', 'if', 'from', or 'inspect').  The whole construct is
-indented up to the matching end.  If the point is not within such a
-construct, then only that line is indented"
-  (interactive)
-  (let ((end-point 0))
-    (save-excursion
-      (end-of-line)
-      (if (not (= (point) (point-max))) (forward-char 1))
-      (goto-char (eif-matching-line t 'backward))
-      (setq end-point (eif-matching-line t 'forward))
-      (while (< (point) end-point)
-	(eif-indent-line)
-	(forward-line 1)
-	(beginning-of-line)))))
-
-(defun eif-indent-region (&optional start end)
-  "Indent the lines in the current region.
-The region may be specified using optional arguments START and END."
-  (interactive)
-  (let ((start-point (or start (region-beginning)))
-	(end-point   (copy-marker (or end (region-end)))))
-    (save-excursion
-      (goto-char start-point)
-      (cond ((eq major-mode 'eiffel-mode)
-	     (while (< (point) end-point)
-	       (if (not (looking-at "[ \t]*$"))
-		   (eif-indent-line))
-	       (forward-line 1)
-	       (beginning-of-line)))
-	    (t (error "Buffer must be in eiffel mode"))))))
-
-;;(defun eif-goto-matching-line (&optional direction)
-;;  "Place the cursor on the line which closes(opens) the current
-;;opening(closing) syntactic construct.  For example if the point
-;;is on `from', executing goto-matching-line places the point
-;;on the matching `end' and vice-versa."
-;;  (interactive)
-;;  (if (not direction)
-;;      (progn
-;;	(cond ((save-excursion (beginning-of-line) (looking-at "[ \t]*end.*$"))
-;;	       (goto-char (eif-matching-line nil 'backward)))
-;;	      ((looking-at "(")
-;;	       (forward-sexp))
-;;	      ((save-excursion (backward-char 1) (looking-at ")"))
-;;	       (backward-sexp))
-;;	      (t
-;;	       (goto-char (eif-matching-line nil 'forward)))))))
-
-(defun eif-forward-sexp ()
-  "Put cursor on line that closes the current opening syntactic construct.
-For example, if the point is on `from' then the point is placed on the
-matching `end'.  This also does matching of parens ala
-\\[forward-sexp]."
-  (interactive)
-  (cond ((looking-at "[[(]")
-	 (forward-sexp))
-	(t
-	 (goto-char (eif-matching-line nil 'forward)))))
-
-(defun eif-backward-sexp ()
-  "Put cursor on line that opens the current closing syntactic construct.
-For example, if the point is on the terminating `end' of an `if'
-statement, then the point is place on the opening `if'.  This also
-does matching of parens ala \\[backward-sexp]'."
-  (interactive)
-  (cond ((save-excursion (backward-char 1) (looking-at "[])]"))
-	 (backward-sexp))
-	(t
-	 (goto-char (eif-matching-line nil 'backward)))))
-
-(defun eif-local-indent (amount)
-  "Set the value of `eif-indent-increment' to AMOUNT buffer-locally."
-  (interactive "NNumber of spaces for eif-indent-increment: ")
-  (make-local-variable 'eif-indent-increment)
-  (setq eif-indent-increment amount))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;                      Utility Functions.                      ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun eif-feature-quote ()
-  "Put a `' around the current feature name."
-  (interactive)
-  (save-excursion
-    ;; Only try to go back to the beginning of the feature if we're
-    ;; not already there.
-    (if (/= (point)
-	    (save-excursion
-	      (forward-sexp)
-	      (backward-sexp)
-	      (point)))
-	(backward-sexp))
-    (insert "`")
-    (forward-sexp)
-    (insert "'"))
-  (if (looking-at "'")
-      (forward-char 1)))
-
-;; ----------------------------------------------------------------------
-;; This next portion of the file is derived from "eiffel.el"
-;; Copyright (C) 1989, 1990 Free Software Foundation, Inc. and Bob Weiner
-;; Available for use and distribution under the same terms as GNU Emacs.
-;; ----------------------------------------------------------------------
-
-(defvar eiffel-mode-map nil
-  "Keymap for Eiffel mode.")
-
-(if eiffel-mode-map
-    nil
-  (let ((map (make-sparse-keymap)))
-    (define-key map [(control j)]       'newline-and-indent)
-    (define-key map [(return)]          'reindent-then-newline-and-indent)
-    (define-key map [(meta control q)]  'eif-indent-construct)
-    (define-key map [(meta \')]         'eif-feature-quote)
-    (define-key map [(meta q)]          'eif-fill-paragraph)
-    (define-key map [(meta control a)]  'eif-beginning-of-feature)
-    (define-key map [(meta control e)]  'eif-end-of-feature)
-    (define-key map [(control x) ?n ?d] 'eif-narrow-to-feature)
-    (setq eiffel-mode-map map)))
-
-(defvar eiffel-mode-syntax-table nil
-  "Syntax table in use in Eiffel-mode buffers.")
-
-(if eiffel-mode-syntax-table
-    nil
-  (let ((table (make-syntax-table))
-	(i 0))
-    (while (< i ?0)
-      (modify-syntax-entry i "_   " table)
-      (setq i (1+ i)))
-    (setq i (1+ ?9))
-    (while (< i ?A)
-      (modify-syntax-entry i "_   " table)
-      (setq i (1+ i)))
-    (setq i (1+ ?Z))
-    (while (< i ?a)
-      (modify-syntax-entry i "_   " table)
-      (setq i (1+ i)))
-    (setq i (1+ ?z))
-    (while (< i 128)
-      (modify-syntax-entry i "_   " table)
-      (setq i (1+ i)))
-    (modify-syntax-entry ?  "    " table)
-    (modify-syntax-entry ?-  ". 12" table)
-    (modify-syntax-entry ?_  "_  " table)
-    (modify-syntax-entry ?\t "    " table)
-    (modify-syntax-entry ?\n ">   " table)
-    (modify-syntax-entry ?\f ">   " 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 ?` "." 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 ?\; "." table)
-    (modify-syntax-entry ?: "." table)
-    (modify-syntax-entry ?! "." table)
-    (modify-syntax-entry ?. "." table)
-    (setq eiffel-mode-syntax-table table)))
-
-(defun eif-add-menu ()
-  "Add the \"Eiffel\" menu to the menu bar."
-
-  (easy-menu-define
-   eiffel-mode-menu
-   eiffel-mode-map
-   "Menu for eiffel-mode."
-   (append (list "Eiffel")
-	   (if eif-use-gnu-eiffel
-	       (list
-		["Compile..."            eif-compile t]
-		["Compiler Options..."   eif-set-compile-options t]
-		["Next Compile Error..." next-error  t]
-		["Run..."                eif-run     t]
-		["Short..."              eif-short   t]
-		["----------" nil nil]))
-	   (list
-	    ["Indent Construct"    eif-indent-construct t]
-	    ["----------" nil nil]
-	    (list "Comments"
-		  ["Feature Quote" eif-feature-quote  (eif-in-comment-p)]
-		  ["Fill         " eif-fill-paragraph (eif-near-comment-p)])
-	    ["----------" nil nil]
-            ["Customize"           eif-customize     t])))
-  (easy-menu-add eiffel-mode-menu))
-
-;;;###autoload
-(defun eiffel-mode ()
-  "Major mode for editing Eiffel programs.
-\\[indent-for-tab-command] indents the current Eiffel line correctly and
-\\[reindent-then-newline-and-indent] causes the current and next line to be
-properly indented.
-
-Key definitions:
-\\{eiffel-mode-map}
-
-If variable `eif-use-gnu-eiffel' is non-nil (default t) then support
-for using GNU SmallEiffel is enabled.  Run \\[eif-customize] to see
-compilation and indentation variables that can be customized."
-
-  (interactive)
-
-  (kill-all-local-variables)
-
-  (setq major-mode 'eiffel-mode)
-  (setq mode-name "Eiffel")
-
-  (if eif-use-gnu-eiffel
-      (progn
-	(define-key eiffel-mode-map "\C-c\C-c" 'eif-compile)
-	(define-key eiffel-mode-map "\C-c\C-o" 'eif-set-compile-options)
-	(define-key eiffel-mode-map "\C-c\C-r" 'eif-run)
-	(define-key eiffel-mode-map "\C-c\C-s" 'eif-short))
-    (define-key eiffel-mode-map "\C-c\C-c" nil)
-    (define-key eiffel-mode-map "\C-c\C-o" nil)
-    (define-key eiffel-mode-map "\C-c\C-r" nil)
-    (define-key eiffel-mode-map "\C-c\C-s" nil))
-
-  (use-local-map eiffel-mode-map)
-  (eif-add-menu)
-  (set-syntax-table eiffel-mode-syntax-table)
-
-  ;; Make local variables.
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (make-local-variable 'require-final-newline)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (make-local-variable 'indent-line-function)
-  (make-local-variable 'indent-region-function)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-end)
-  (make-local-variable 'comment-column)
-  (make-local-variable 'comment-start-skip)
-  (make-local-variable 'font-lock-defaults)
-  ;; Now set their values.
-  (setq paragraph-start              (concat "^$\\|" page-delimiter)
-	paragraph-separate           paragraph-start
-	paragraph-ignore-fill-prefix t
-	require-final-newline        'ask
-	parse-sexp-ignore-comments   t
-	indent-line-function         'eif-indent-line
-	indent-region-function       'eif-indent-region
-	comment-start                "-- "
-	comment-end                  ""
-	comment-column               32
-	comment-start-skip           "--+|?[ \t]*"
-	font-lock-defaults           eiffel-font-lock-defaults)
-
-  (if eif-set-tab-width-flag
-      (setq tab-width eif-indent-increment))
-
-  (setq auto-fill-function 'eif-auto-fill)
-  (run-hooks 'eiffel-mode-hook))
-
-(defun eif-not-in-comment-or-quoted-string-p ()
-  "Return t if point is not in a comment or quoted string."
-  (not (eif-in-comment-or-quoted-string-p)))
-  
-(defun eif-in-comment-or-quoted-string-p ()
-  "Return t if point is in a comment or quoted string."
-  (or (eif-in-comment-p)
-      (eif-in-quoted-string-p)))
-  
-(defsubst eif-in-comment-p ()
-  "Return t if point is in a comment."
-  (interactive)
-  (save-excursion
-    (nth 4 (parse-partial-sexp
- 	    (save-excursion (beginning-of-line) (point))
- 	    (point)))))
-
-(defun eif-near-comment-p ()
-  "Return t if point is close enough to a comment for filling purposes."
-  (or (eif-in-comment-p)
-      (and (or (looking-at comment-start-skip)
-	       (and (looking-at "-")
-		    (not (bobp))
-		    (save-excursion
-		      (backward-char 1)
-		      (looking-at "-"))))
-	   (not (eif-in-quoted-string-p)))
-      (looking-at (concat "[ \t]*" comment-start-skip))))
-
-;; ENHANCEME: Currently eif-beginning-of-feature only works for
-;;            routines (`is' is crucial).  It should be made more
-;;            general.
-;;
-
-(defun eif-bof-p ()
-  "Return non-nil if point is at the beginning of a feature.
-This is defined as at the beginning of the feature name or anywhere in
-whitespace before the start of a feature (including at the end of the
-previous feature)."
-  (save-excursion
-    (save-match-data
-      (if (eif-in-comment-p)
-	  (end-of-line))
-      (looking-at (concat "\\(" eif-non-source-line "\\|\n\\)*"
-			  "[ \t]*\\b"
-			  eif-is-keyword-regexp)))))
-
-(defun eif-beginning-of-feature (&optional arg)
-  "Move backward to next feature beginning.
-With ARG, do it that many times.  Negative arg -N
-means move forward to Nth following beginning of feature.
-Returns t unless search stops due to beginning or end of buffer."
-  (interactive "p")
-
-  (or arg
-      (setq arg 1))
-
-  ;; If not in the whitespace at the beginning of a feature, or going
-  ;; forward, then do this from after the "is".
-  (if (and (or (not (eif-bof-p))
-	       (and arg (< arg 0) (not (eobp))))
-	   (looking-at eif-is-keyword-regexp))
-      (re-search-forward eif-is-keyword-regexp))
-
-  (let ((success t))
-    ;; Change arg towards zero as we search, failing if we hit edge of buffer.
-    (while (or (and (> arg 0) (or (not (bobp)) (setq success nil)))
-	       (and (< arg 0) (or (not (eobp)) (setq success nil))))
-      (if (re-search-backward eif-is-keyword-regexp nil 'move
-			      (if (> arg 0) 1 -1))
-	  ;; If we found one, count it and keep moving.
-	  (if (eif-not-in-comment-or-quoted-string-p)
-	      (progn
-		(if (> arg 0)
-		    (setq arg (1- arg))
-		  (setq arg (1+ arg)))))))
-    (if success
-	(progn
-	  (backward-sexp 1)
-	  (if (looking-at "(")
-	      (backward-word 1))
-	  (beginning-of-line)))
-    success))
-
-(defun eif-find-end-of-feature ()
-  "Find the `end' of the current feature definition.
-Assumes point is at the beginning of the feature."
-  (let ((current-level 0)
-        (previous-level 0))
-    (while (not (or (eobp) (and (= current-level 0) (= previous-level 1))))
-      (re-search-forward (concat eif-end-matching-keywords
-                                 "\\|" eif-end-keyword)
-                         nil 'move)
-      (backward-char 1)         ; matching eif-end-matching-keywords
-                                ; takes us one char to far
-      (if (eif-not-in-comment-or-quoted-string-p)
-          ;; After a level changing keyword.
-          (save-excursion
-            (backward-word 1)
-            (setq previous-level current-level)
-            (cond ((looking-at eif-end-matching-keywords)
-                   (setq current-level (1+ current-level)))
-                  ((looking-at eif-end-keyword)
-                   (setq current-level (1- current-level)))))))))
-
-;; Could we use eif-matching line here instead?  That is, we would
-;; search for the initial "do" and then match it.  No, because there
-;; isn't always a "do" and it gets too hard!
-(defun eif-end-of-feature-forward-only (arg)
-  "Move forward to end of feature, ARG times."
-
-  ;; We try going backwards to the beginning of the current feature on
-  ;; the first iteration.  If we get nowhere, the first iteration will
-  ;; not count and we will go forward instead.
-  (let ((on-first-iteration t))
-    (while (and (> arg 0) (not (eobp)))
-
-      (let ((pos (point)))
-	;; If the previous search put us at the beginning of a feature
-	;; (as well as the end), then stay here.
-	(if (not (eif-bof-p))
-	    (if (and on-first-iteration
-		     (save-excursion (eif-beginning-of-feature)))
-		;; First iteration and there is a beginning of feature
-		;; back there somewhere, so go to it and see how we
-		;; go.
-		(eif-beginning-of-feature)
-	      ;; Subsequent iteration or no feature, go forward
-	      ;; instead.
-	      (eif-beginning-of-feature -1)))
-	(setq on-first-iteration nil)
-
-        (eif-find-end-of-feature)
-
-	;; If the end of the feature we are at involved moving
-	;; forward, then we are rocking, so this iteration counts.
-	(if (> (point) pos)
-	    (progn
-	      (end-of-line)
-	      (setq arg (1- arg)))))))
-
-  (forward-line))
-
-(defun eif-end-of-feature (&optional arg)
-  "Move forward to end of feature.
-
-With argument, do it that many times.  Negative argument means move
-back ARG preceding ends of features."
-  (interactive "p")
-
-  ;; Default is to find the first feature's end.
-  (if (or (null arg)
-	  (= arg 0))
-      (setq arg 1))
-
-  (if (>= arg 0)
-      (eif-end-of-feature-forward-only arg)
-    (if (eif-beginning-of-feature (1+ (- arg)))
-	(eif-end-of-feature-forward-only 1))))
-
-(defun eif-narrow-to-feature ()
-  "Make text outside current feature invisible.
-The feature visible is the one that contains point or follows point."
-  (interactive)
-  (save-excursion
-    (widen)
-    (eif-end-of-feature)
-    (let ((end (point)))
-      (eif-beginning-of-feature)
-      (narrow-to-region (point) end))))
-
-(defun eif-current-line-indent ()
-  "Return the indentation of the line containing the point."
-  (save-excursion
-    (let ((line-end 0)
-	  (indent   0))
-      (end-of-line)
-      (setq line-end (point))
-      (beginning-of-line)
-      (re-search-forward eif-white-space-regexp line-end t)
-      (setq indent (current-column)))))
-
-(defun eif-in-quoted-string-p (&optional non-strict-p)
-  "Return t if point is in a quoted string.
-Optional argument NON-STRICT-P if true causes the function to return
-true even if the point is located in leading white space on a
-continuation line.  Normally leading white space is not considered part
-of the string."
-  (let ((initial-regexp "^[ \t]*%\\|[^%]\"\\|%[ \t]*$")
-	(search-limit (point))
-	(count 0))
-    (save-excursion
-      ;; Line must either start with optional whitespace immediately followed
-      ;; by a '%' or include a '\"' before the search-limit.
-      (beginning-of-line)
-      (while (re-search-forward initial-regexp search-limit t)
-	(setq count (1+ count))
-	(if (= count 1) (setq search-limit (1+ search-limit))))
-      ;; If the number of quotes (including continuation line markers)
-      ;; is odd, then we are inside of a string.  Also if non-strict-p
-      ;; and we are in the leading white space of a continuation line,
-      ;; then we are in a quote.
-      (or (= (% count 2) 1)
-	  (progn
-	    (beginning-of-line)
-	    (and non-strict-p
-		 (looking-at "^[ \t]*%")))))))
-
-;; ----------------------------------------------------------------------
-;; End of portion derived from "eiffel.el"
-;; ----------------------------------------------------------------------
-
-(defun eif-comment-prefix ()
-  "Return the prefix starting a comment that begins a line.
-Comments that are not the only thing on a line return nil as their prefix."
-  (save-excursion
-    (end-of-line)
-    (let ((limit (point)) len
-	  (in-string (eif-in-quoted-string-p)))
-      (beginning-of-line)
-      (cond ((re-search-forward "^[ \t]*--|?[ \t]*" limit t)
-	     (buffer-substring (match-beginning 0) (match-end 0)))
-	    ;; Handle string-literal continuation lines
-	    (in-string
-	     (end-of-line)
-	     (re-search-backward "^[ \t]*%\\|[^%]\"" nil t)
-	     (re-search-forward "%\\|\"" nil t)
-	     (setq len (1- (current-column)))
-	     (concat (make-string len ? ) "%"))))))
-
-(defun eif-auto-fill ()
-  "Auto-fill an Eiffel comment."
-  (let ((fill-prefix (eif-comment-prefix))
-	(pm (point-marker)))
-    (if (and (> (current-column) fill-column)
-	     fill-prefix)
-	(if (string-match "^[ \t]*%" fill-prefix)
-	    (progn
-	      (backward-char 1)
-	      (re-search-backward "[^][a-zA-Z0-9]" nil t)
-	      (forward-char 1)
-	      (insert "%\n")
-	      (insert fill-prefix)
-	      (goto-char pm))
-	  ;; (do-auto-fill)
-	  (backward-char 1)
-	  (re-search-backward "\\s-" nil t)
-	  (forward-char 1)
-	  (insert "\n")
-	  (insert fill-prefix)
-	  (goto-char pm)))))
-
-(defun eif-fill-paragraph ()
-  "Textually fills Eiffel comments ala \\[fill-paragraph]."
-  (interactive)
-  (save-excursion
-    (let ((current-point (point))
-	  (fill-prefix (eif-comment-prefix))
-	  last-point para-begin para-end)
-      (if fill-prefix
-	  (progn
-	    (setq last-point (point))
-	    (forward-line -1)
-	    (end-of-line)
-	    (while (and (not (= (point) last-point))
-			(eif-comment-prefix))
-	      (setq last-point (point))
-	      (forward-line -1)
-	      (end-of-line))
-	    (if (= (point) last-point)
-		(setq para-begin (save-excursion (beginning-of-line) (point)))
-	      (setq para-begin (1+ (point))))
-	    (goto-char current-point)
-	    (setq last-point (point))
-	    (forward-line 1)
-	    (end-of-line)
-	    (while (and (not (= (point) last-point))
-			(eif-comment-prefix))
-	      (setq last-point (point))
-	      (forward-line 1)
-	      (end-of-line))
-	    (if (= (point) last-point)
-		(setq para-end (point))
-	      (beginning-of-line)
-	      (setq para-end (point)))
-	    ;; Avert eyes now - gross hack follows...  how big can an
-	    ;; Eiffel comment be anyway?  :-)
-	    (let ((orig-region (and (<= (- para-end para-begin)
-					eif-fill-max-save)
-				    (buffer-substring para-begin para-end)))
-		  (orig-state  (buffer-modified-p))
-		  (ret  (fill-region para-begin para-end)))
-	      (and orig-region
-		   (<= para-end (point-max))
-		   (string-equal
-		    orig-region (buffer-substring para-begin para-end))
-		   (set-buffer-modified-p orig-state))
-	      ret))))))
-
-(defun eif-indent-line (&optional whole-exp)
-  "Indent the current line as Eiffel code.
-With optional argument WHOLE-EXP, indent any additional lines of the
-same clause rigidly along with this one (not implemented yet)."
-  (interactive "p")
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (let ((indent (eif-calc-indent)))
-      (if (not (= indent (current-column)))
-	  (progn
-	    (delete-horizontal-space)
-	    (indent-to indent)))))
-  (skip-chars-forward " \t"))
-
-(defun eif-move-to-prev-non-blank ()
-  "Move point to previous line excluding blank lines.
-Return t if successful, nil if not."
-  (beginning-of-line)
-  (re-search-backward "^[ \t]*[^ \t\n]" nil t))
-
-(defvar eif-last-feature-level-indent -1)
-(defvar eif-feature-level-indent-regexp nil)
-(defun eif-in-paren-expression ()
-  "Determine if we are inside of a parenthesized expression."
-  (interactive)
-  (let ((paren-count 0) (limit 0))
-    (save-excursion
-      (if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
-	  (setq limit
-		(re-search-backward eif-feature-level-indent-regexp nil t))
-	(setq eif-last-feature-level-indent (eif-feature-level-indent-m))
-	(setq eif-feature-level-indent-regexp
-	      (concat "^" (make-string eif-last-feature-level-indent ? )
-		      "[^ \t\n]"))
-	(setq limit
-	      (or (re-search-backward eif-feature-level-indent-regexp nil t)
-		  0))))
-    (save-excursion
-      (while (re-search-backward "[][()]" limit t)
-	(if (looking-at "[[(]")
-	    (setq paren-count (1+ paren-count))
-	  (setq paren-count (1- paren-count)))))
-    paren-count))
-
-(defun eif-manifest-array-indent ()
-  "Determine if we are inside of a manifest array."
-  (interactive)
-  (let ((paren-count 0)
-	(limit 0)
-	indent)
-    (save-excursion
-      (if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
-	  (setq limit
-		(re-search-backward eif-feature-level-indent-regexp nil t))
-	(setq eif-last-feature-level-indent (eif-feature-level-indent-m))
-	(setq eif-feature-level-indent-regexp
-	      (concat "^" (make-string eif-last-feature-level-indent ? )
-		      "[^ \t\n]"))
-	(setq limit
-	      (or (re-search-backward eif-feature-level-indent-regexp nil t)
-		  0))))
-    (save-excursion
-      (while (and (<= paren-count 0) (re-search-backward "<<\\|>>" nil t))
-	(if (looking-at "<<")
-	    (setq paren-count (1+ paren-count))
-	  (setq paren-count (1- paren-count))))
-      (if (> paren-count 0)
-	  (let ((eol (save-excursion (end-of-line) (point))))
-	    (setq indent
-		  (or (and (re-search-forward "[^< \t]" eol t)
-			   (1- (current-column)))
-		      (+ (current-column) 2))))))
-    indent))
-
-(defun eif-manifest-array-start ()
-  "Determine the indentation of the statement containing a manifest array."
-  (interactive)
-  (let ((paren-count 0)
-	(limit 0)
-	indent)
-    (save-excursion
-      (if (= eif-last-feature-level-indent (eif-feature-level-indent-m))
-	  (setq limit
-		(re-search-backward eif-feature-level-indent-regexp nil t))
-	(setq eif-last-feature-level-indent (eif-feature-level-indent-m))
-	(setq eif-feature-level-indent-regexp
-	      (concat "^" (make-string eif-last-feature-level-indent ? )
-		      "[^ \t\n]"))
-	(setq limit
-	      (or (re-search-backward eif-feature-level-indent-regexp nil t)
-		  0))))
-    (save-excursion
-      (while (and (<= paren-count 0) (re-search-backward "<<\\|>>" nil t))
-	(if (looking-at "<<")
-	    (setq paren-count (1+ paren-count))
-	  (setq paren-count (1- paren-count))))
-      (if (> paren-count 0)
-	  (let ((limit (progn (end-of-line) (point))))
-	    (beginning-of-line)
-	    (if (re-search-forward "^[ \t]*<<" limit t)
-		(setq indent (- (current-column) 2 eif-indent-increment))
-	      (re-search-forward "^[ \t]*" limit t)
-	      (setq indent (current-column))))))
-    indent))
-
-;; ----------------------------------------------------------------------
-;; The function below is derived from "eif-mult-fmt.el"
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-;; Copyright (C) 1990 Bob Weiner, Motorola Inc.
-;; Available for use and distribution under the same terms as GNU Emacs.
-;; ----------------------------------------------------------------------
-
-(defun eif-indent-multi-line (&optional parse-start)
-  "Return indentation for line within parentheses or double quotes.
-That is, we are in a multi-line parenthesised or double-quoted
-expression, and want to know the suggested indentation for the current
-line.  If we are not within such an expression then return -1.
-Optional argument PARSE-START is buffer position at which to begin
-parsing, default is to begin at the feature enclosing or preceding
-point."
-  (let ((eif-opoint (point))
-	(indent-point (progn (beginning-of-line) (point)))
-	(eif-ind-val -1)
-	(eif-in-str nil)
-	(eif-paren-depth 0)
-	(retry t)
-	state
-	;; setting this to a number inhibits calling hook
-	last-sexp containing-sexp)
-    (if parse-start
-	(goto-char parse-start)
-      (eif-beginning-of-feature))
-    ;; Find outermost containing sexp
-    (while (< (point) indent-point)
-      (setq state (parse-partial-sexp (point) indent-point 0)))
-    ;; Find innermost containing sexp
-    (while (and retry
-		state
-		(> (setq eif-paren-depth (elt state 0)) 0))
-      (setq retry nil)
-      (setq last-sexp (elt state 2))
-      (setq containing-sexp (elt state 1))
-      ;; Position following last unclosed open.
-      (goto-char (1+ containing-sexp))
-      ;; Is there a complete sexp since then?
-      (if (and last-sexp (> last-sexp (point)))
-	  ;; Yes, but is there a containing sexp after that?
-	  (let ((peek (parse-partial-sexp last-sexp indent-point 0)))
-	    (if (setq retry (car (cdr peek))) (setq state peek)))))
-    (if retry
-	nil
-      ;; Innermost containing sexp found
-      (goto-char (1+ containing-sexp))
-      (if (not last-sexp)
-	  ;; indent-point immediately follows open paren.
-	  nil
-	;; Find the start of first element of containing sexp.
-	(parse-partial-sexp (point) last-sexp 0 t)
-	(cond ((looking-at "\\s(")
-	       ;; First element of containing sexp is a list.
-	       ;; Indent under that list.
-	       )
-	      ((> (save-excursion (forward-line 1) (point))
-		  last-sexp)
-	       ;; This is the first line to start within the containing sexp.
-	       (backward-prefix-chars))
-	      (t
-	       ;; Indent beneath first sexp on same line as last-sexp.
-	       ;; Again, it's almost certainly a routine call.
-	       (goto-char last-sexp)
-	       (beginning-of-line)
-	       (parse-partial-sexp (point) last-sexp 0 t)
-	       (backward-prefix-chars))))
-      (setq eif-ind-val (current-column)))
-    ;; Point is at the point to indent under unless we are inside a string.
-    (setq eif-in-str (elt state 3))
-    (goto-char eif-opoint)
-    (if (not eif-in-str)
-	nil
-      ;; Inside a string, indent 1 past string start
-      (setq eif-paren-depth 1);; To account for being inside string
-      (save-excursion
-	(if (re-search-backward "\"" nil t)
-	    (if eif-indent-string-continuations-relatively-flag
-		(setq eif-ind-val (1+ (current-column)))
-	      (setq eif-ind-val (eif-current-line-indent)))
-	  (goto-char indent-point)
-	  (if (looking-at "^[ \t]*[^ \t\n]")
-	      (eif-move-to-prev-non-blank))
-	  (skip-chars-forward " \t")
-	  (setq eif-ind-val (current-column)))))
-    (if (> eif-paren-depth 0) eif-ind-val -1)))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.e\\'" . eiffel-mode))
-
-(provide 'eiffel)
-;;; eiffel.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/icon.el b/xemacs-packages/lisp/prog-modes/icon.el
deleted file mode 100644
index 57cde9ee..00000000
--- a/xemacs-packages/lisp/prog-modes/icon.el
+++ /dev/null
@@ -1,706 +0,0 @@
-;;; icon.el --- mode for editing Icon code
-
-;; Copyright (C) 1989 Free Software Foundation, Inc.
-
-;; Author: Chris Smith 
-;; Created: 15 Feb 89
-;; Keywords: languages
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: GNU Emacs 21.2, except that `font-lock-preprocessor-face'
-;;; is used instead of `font-lock-builtin-face' and
-;;; `font-lock-variable-name-face' instead of `font-lock-constant-face'.
-
-;;; Commentary:
-
-;; A major mode for editing the Icon programming language.
-
-;;; Code:
-
-(defvar icon-mode-abbrev-table nil
-  "Abbrev table in use in Icon-mode buffers.")
-(define-abbrev-table 'icon-mode-abbrev-table ())
-
-(defvar icon-mode-map ()
-  "Keymap used in Icon mode.")
-(if icon-mode-map
-    ()
-  (let ((map (make-sparse-keymap "Icon")))
-    (setq icon-mode-map (make-sparse-keymap))
-    (define-key icon-mode-map "{" 'electric-icon-brace)
-    (define-key icon-mode-map "}" 'electric-icon-brace)
-    (define-key icon-mode-map "\e\C-h" 'mark-icon-function)
-    (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun)
-    (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun)
-    (define-key icon-mode-map "\e\C-q" 'indent-icon-exp)
-    (define-key icon-mode-map "\177" 'backward-delete-char-untabify)
-  
-    (define-key icon-mode-map [menu-bar] (make-sparse-keymap "Icon"))
-    (define-key icon-mode-map [menu-bar icon]
-      (cons "Icon" map))
-    (define-key map [beginning-of-icon-defun] '("Beginning of function" . beginning-of-icon-defun))
-    (define-key map [end-of-icon-defun] '("End of function" . end-of-icon-defun))
-    (define-key map [comment-region] '("Comment Out Region" . comment-region))
-    (define-key map [indent-region] '("Indent Region" . indent-region))
-    (define-key map [indent-line] '("Indent Line" . icon-indent-command))
-    (put 'eval-region 'menu-enable 'mark-active)
-    (put 'comment-region 'menu-enable 'mark-active)
-    (put 'indent-region 'menu-enable 'mark-active)))
-
-(defvar icon-mode-syntax-table nil
-  "Syntax table in use in Icon-mode buffers.")
-
-(if icon-mode-syntax-table
-    ()
-  (setq icon-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" icon-mode-syntax-table)
-  (modify-syntax-entry ?# "<" icon-mode-syntax-table)
-  (modify-syntax-entry ?\n ">" icon-mode-syntax-table)
-  (modify-syntax-entry ?$ "." icon-mode-syntax-table)
-  (modify-syntax-entry ?/ "." icon-mode-syntax-table)
-  (modify-syntax-entry ?* "." icon-mode-syntax-table)
-  (modify-syntax-entry ?+ "." icon-mode-syntax-table)
-  (modify-syntax-entry ?- "." icon-mode-syntax-table)
-  (modify-syntax-entry ?= "." icon-mode-syntax-table)
-  (modify-syntax-entry ?% "." icon-mode-syntax-table)
-  (modify-syntax-entry ?< "." icon-mode-syntax-table)
-  (modify-syntax-entry ?> "." icon-mode-syntax-table)
-  (modify-syntax-entry ?& "." icon-mode-syntax-table)
-  (modify-syntax-entry ?| "." icon-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" icon-mode-syntax-table))
-
-(defgroup icon nil
-  "Mode for editing Icon code."
-  :group 'languages)
-
-(defcustom icon-indent-level 4
-  "*Indentation of Icon statements with respect to containing block."
-  :type 'integer
-  :group 'icon)
-
-(defcustom icon-brace-imaginary-offset 0
-  "*Imagined indentation of a Icon open brace that actually follows a statement."
-  :type 'integer
-  :group 'icon)
-
-(defcustom icon-brace-offset 0
-  "*Extra indentation for braces, compared with other text in same context."
-  :type 'integer
-  :group 'icon)
-
-(defcustom icon-continued-statement-offset 4
-  "*Extra indent for Icon lines not starting new statements."
-  :type 'integer
-  :group 'icon)
-
-(defcustom icon-continued-brace-offset 0
-  "*Extra indent for Icon substatements that start with open-braces.
-This is in addition to `icon-continued-statement-offset'."
-  :type 'integer
-  :group 'icon)
-
-(defcustom icon-auto-newline nil
-  "*Non-nil means automatically newline before and after braces Icon code.
-This applies when braces are inserted."
-  :type 'boolean
-  :group 'icon)
-
-(defcustom icon-tab-always-indent t
-  "*Non-nil means TAB in Icon mode should always reindent the current line.
-It will then reindent, regardless of where in the line point is
-when the TAB command is used."
-  :type 'boolean
-  :group 'icon)
-
-(defvar icon-imenu-generic-expression
-      '((nil "^[ \t]*procedure[ \t]+\\(\\sw+\\)[ \t]*("  1))
-  "Imenu expression for Icon mode.  See `imenu-generic-expression'.")
-
-
-
-;;;###autoload
-(defun icon-mode ()
-  "Major mode for editing Icon code.
-Expression and list commands understand all Icon brackets.
-Tab indents for Icon code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-\\{icon-mode-map}
-Variables controlling indentation style:
- icon-tab-always-indent
-    Non-nil means TAB in Icon mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- icon-auto-newline
-    Non-nil means automatically newline before and after braces
-    inserted in Icon code.
- icon-indent-level
-    Indentation of Icon statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- icon-continued-statement-offset
-    Extra indentation given to a substatement, such as the
-    then-clause of an if or body of a while.
- icon-continued-brace-offset
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to `icon-continued-statement-offset'.
- icon-brace-offset
-    Extra indentation for line if it starts with an open brace.
- icon-brace-imaginary-offset
-    An open brace following other text is treated as if it were
-    this far to the right of the start of its line.
-
-Turning on Icon mode calls the value of the variable `icon-mode-hook'
-with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map icon-mode-map)
-  (setq major-mode 'icon-mode)
-  (setq mode-name "Icon")
-  (setq local-abbrev-table icon-mode-abbrev-table)
-  (set-syntax-table icon-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'icon-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "# *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'icon-comment-indent)
-  (set (make-local-variable 'indent-line-function) 'icon-indent-line)
-  ;; font-lock support
-  (setq font-lock-defaults
-	'((icon-font-lock-keywords
-	   icon-font-lock-keywords-1 icon-font-lock-keywords-2)
-	  nil nil ((?_ . "w")) beginning-of-defun
-	  ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP.
-	  ;(font-lock-comment-start-regexp . "#")
-	  (font-lock-mark-block-function . mark-defun)))
-  ;; imenu support
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression icon-imenu-generic-expression)
-  ;; hideshow support
-  ;; we start from the assertion that `hs-special-modes-alist' is autoloaded.
-  ;; XEmacs change: it isn't necessarily in XEmacs.
-  (if (boundp 'hs-special-modes-alist)
-      (unless (assq 'icon-mode hs-special-modes-alist)
-	(setq hs-special-modes-alist
-	      (cons '(icon-mode  "\\" "\\" nil
-				 icon-forward-sexp-function)
-		    hs-special-modes-alist))))
-  (run-hooks 'icon-mode-hook))
-
-;; This is used by indent-for-comment to decide how much to
-;; indent a comment in Icon code based on its context.
-(defun icon-comment-indent ()
-  (if (looking-at "^#") 0 comment-column))
-
-(defun electric-icon-brace (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (let (insertpos)
-    (if (and (not arg)
-	     (eolp)
-	     (or (save-excursion
-		   (skip-chars-backward " \t")
-		   (bolp))
-		 (if icon-auto-newline
-		     (progn (icon-indent-line) (newline) t)
-		   nil)))
-	(progn
-	  (insert last-command-char)
-	  (icon-indent-line)
-	  (if icon-auto-newline
-	      (progn
-		(newline)
-		;; (newline) may have done auto-fill
-		(setq insertpos (- (point) 2))
-		(icon-indent-line)))
-	  (save-excursion
-	    (if insertpos (goto-char (1+ insertpos)))
-	    (delete-char -1))))
-    (if insertpos
-	(save-excursion
-	  (goto-char insertpos)
-	  (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun icon-indent-command (&optional whole-exp)
-  "Indent current line as Icon code, or in some cases insert a tab character.
-If `icon-tab-always-indent' is non-nil (the default), always indent current
-line.  Otherwise, indent the current line only if point is at the left margin
-or in the line's indentation; otherwise insert a tab.
-
-A numeric argument, regardless of its value, means indent rigidly all the
-lines of the expression starting after point so that this line becomes
-properly indented.  The relative indentation among the lines of the
-expression are preserved."
-  (interactive "P")
-  (if whole-exp
-      ;; If arg, always indent this line as Icon
-      ;; and shift remaining lines of expression the same amount.
-      (let ((shift-amt (icon-indent-line))
-	    beg end)
-	(save-excursion
-	  (if icon-tab-always-indent
-	      (beginning-of-line))
-	  (setq beg (point))
-	  (forward-sexp 1)
-	  (setq end (point))
-	  (goto-char beg)
-	  (forward-line 1)
-	  (setq beg (point)))
-	(if (> end beg)
-	    (indent-code-rigidly beg end shift-amt "#")))
-    (if (and (not icon-tab-always-indent)
-	     (save-excursion
-	       (skip-chars-backward " \t")
-	       (not (bolp))))
-	(insert-tab)
-      (icon-indent-line))))
-
-(defun icon-indent-line ()
-  "Indent current line as Icon code.
-Return the amount the indentation changed by."
-  (let ((indent (calculate-icon-indent nil))
-	beg shift-amt
-	(case-fold-search nil)
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil)
-	   (setq indent (current-indentation)))
-	  ((looking-at "^#")
-	   (setq indent 0))
-	  (t
-	   (skip-chars-forward " \t")
-	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((and (looking-at "else\\b")
-		       (not (looking-at "else\\s_")))
-		  (setq indent (save-excursion
-				 (icon-backward-to-start-of-if)
-				 (current-indentation))))
-		 ((or (= (following-char) ?})
-		      (looking-at "end\\b"))
-		  (setq indent (- indent icon-indent-level)))
-		 ((= (following-char) ?{)
-		  (setq indent (+ indent icon-brace-offset))))))
-    (skip-chars-forward " \t")
-    (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))
-
-(defun calculate-icon-indent (&optional parse-start)
-  "Return appropriate indentation for current line as Icon code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point))
-	  (case-fold-search nil)
-	  state
-	  containing-sexp
-	  toplevel)
-      (if parse-start
-	  (goto-char parse-start)
-	(setq toplevel (beginning-of-icon-defun)))
-      (while (< (point) indent-point)
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-	(setq containing-sexp (car (cdr state))))
-      (cond ((or (nth 3 state) (nth 4 state))
-	     ;; return nil or t if should not change this line
-	     (nth 4 state))
-	    ((and containing-sexp
-		  (/= (char-after containing-sexp) ?{))
-	     ;; line is expression, not statement:
-	     ;; indent to just after the surrounding open.
-	     (goto-char (1+ containing-sexp))
-	     (current-column))
-	    (t
-	      (if toplevel
-		  ;; Outside any procedures.
-		  (progn (icon-backward-to-noncomment (point-min))
-			 (if (icon-is-continuation-line)
-			     icon-continued-statement-offset 0))
-		;; Statement level.
-		(if (null containing-sexp)
-		    (progn (beginning-of-icon-defun)
-			   (setq containing-sexp (point))))
-		(goto-char indent-point)
-		;; Is it a continuation or a new statement?
-		;; Find previous non-comment character.
-		(icon-backward-to-noncomment containing-sexp)
-		;; Now we get the answer.
-		(if (icon-is-continuation-line)
-		    ;; This line is continuation of preceding line's statement;
-		    ;; indent  icon-continued-statement-offset  more than the
-		    ;; first line of the statement.
-		    (progn
-		      (icon-backward-to-start-of-continued-exp containing-sexp)
-		      (+ icon-continued-statement-offset (current-column)
-			 (if (save-excursion (goto-char indent-point)
-					     (skip-chars-forward " \t")
-					     (eq (following-char) ?{))
-			     icon-continued-brace-offset 0)))
-		  ;; This line starts a new statement.
-		  ;; Position following last unclosed open.
-		  (goto-char containing-sexp)
-		  ;; Is line first statement after an open-brace?
-		  (or
-		    ;; If no, find that first statement and indent like it.
-		    (save-excursion
-		      (if (looking-at "procedure\\s ")
-			  (forward-sexp 3)
-			(forward-char 1))
-		      (while (progn (skip-chars-forward " \t\n")
-				    (looking-at "#"))
-			;; Skip over comments following openbrace.
-			(forward-line 1))
-		      ;; The first following code counts
-		      ;; if it is before the line we want to indent.
-		      (and (< (point) indent-point)
-			   (current-column)))
-		    ;; If no previous statement,
-		    ;; indent it relative to line brace is on.
-		    ;; For open brace in column zero, don't let statement
-		    ;; start there too.  If icon-indent-level is zero,
-		    ;; use icon-brace-offset + icon-continued-statement-offset
-		    ;; instead.
-		    ;; For open-braces not the first thing in a line,
-		    ;; add in icon-brace-imaginary-offset.
-		    (+ (if (and (bolp) (zerop icon-indent-level))
-			   (+ icon-brace-offset
-			      icon-continued-statement-offset)
-			 icon-indent-level)
-		       ;; Move back over whitespace before the openbrace.
-		       ;; If openbrace is not first nonwhite thing on the line,
-		       ;; add the icon-brace-imaginary-offset.
-		       (progn (skip-chars-backward " \t")
-			      (if (bolp) 0 icon-brace-imaginary-offset))
-		       ;; Get initial indentation of the line we are on.
-		       (current-indentation))))))))))
-
-;; List of words to check for as the last thing on a line.
-;; If cdr is t, next line is a continuation of the same statement,
-;; if cdr is nil, next line starts a new (possibly indented) statement.
-
-(defconst icon-resword-alist
-  '(("by" . t) ("case" . t) ("create") ("do") ("dynamic" . t) ("else")
-    ("every" . t) ("if" . t) ("global" . t) ("initial" . t)
-    ("link" . t) ("local" . t) ("of") ("record" . t) ("repeat" . t)
-    ("static" . t) ("then") ("to" . t) ("until" . t) ("while" . t)))
-
-(defun icon-is-continuation-line ()
-  (let* ((ch (preceding-char))
-	 (ch-syntax (char-syntax ch)))
-    (if (eq ch-syntax ?w)
-	(assoc (buffer-substring
-		(progn (forward-word -1) (point))
-		(progn (forward-word 1) (point)))
-	       icon-resword-alist)
-      (not (memq ch '(0 ?\; ?\} ?\{ ?\) ?\] ?\" ?\' ?\# ?\, ?\. ?\n))))))
-
-(defun icon-backward-to-noncomment (lim)
-  (let (opoint stop)
-    (while (not stop)
-      (skip-chars-backward " \t\n\f" lim)
-      (setq opoint (point))
-      (beginning-of-line)
-      (if (and (nth 5 (parse-partial-sexp (point) opoint))
-	       (< lim (point)))
-	  (search-backward "#")
-	(setq stop t)))))
-
-(defun icon-backward-to-start-of-continued-exp (lim)
-  (if (memq (preceding-char) '(?\) ?\]))
-      (forward-sexp -1))
-  (beginning-of-line)
-  (skip-chars-forward " \t")
-  (cond
-   ((<= (point) lim) (goto-char (1+ lim)))
-   ((not (icon-is-continued-line)) 0)
-   ((and (eq (char-syntax (following-char)) ?w)
-	 (cdr
-	  (assoc (buffer-substring (point)
-				   (save-excursion (forward-word 1) (point)))
-		 icon-resword-alist))) 0)
-   (t (end-of-line 0) (icon-backward-to-start-of-continued-exp lim))))
-
-(defun icon-is-continued-line ()
-  (save-excursion
-    (end-of-line 0)
-    (icon-is-continuation-line)))
-
-(defun icon-backward-to-start-of-if (&optional limit)
-  "Move to the start of the last \"unbalanced\" if."
-  (or limit (setq limit (save-excursion (beginning-of-icon-defun) (point))))
-  (let ((if-level 1)
-	(case-fold-search nil))
-    (while (not (zerop if-level))
-      (backward-sexp 1)
-      (cond ((looking-at "else\\b")
-	     (setq if-level (1+ if-level)))
-	    ((looking-at "if\\b")
-	     (setq if-level (1- if-level)))
-	    ((< (point) limit)
-	     (setq if-level 0)
-	     (goto-char limit))))))
-
-(defun mark-icon-function ()
-  "Put mark at end of Icon function, point at beginning."
-  (interactive)
-  (push-mark (point))
-  (end-of-icon-defun)
-  (push-mark (point))
-  (beginning-of-line 0)
-  (beginning-of-icon-defun))
-
-(defun beginning-of-icon-defun ()
-  "Go to the start of the enclosing procedure; return t if at top level."
-  (interactive)
-  (if (re-search-backward "^procedure\\s \\|^end[ \t\n]" (point-min) 'move)
-      (looking-at "e")
-    t))
-
-(defun end-of-icon-defun ()
-  (interactive)
-  (if (not (bobp)) (forward-char -1))
-  (re-search-forward "\\(\\s \\|^\\)end\\(\\s \\|$\\)" (point-max) 'move)
-  (forward-word -1)
-  (forward-line 1))
-
-(defun indent-icon-exp ()
-  "Indent each line of the Icon grouping following point."
-  (interactive)
-  (let ((indent-stack (list nil))
-	(contain-stack (list (point)))
-	(case-fold-search nil)
-	restart outer-loop-done inner-loop-done state ostate
-	this-indent last-sexp last-depth
-	at-else at-brace at-do
-	(opoint (point))
-	(next-depth 0))
-    (save-excursion
-      (forward-sexp 1))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (and (not (eobp)) (not outer-loop-done))
-	(setq last-depth next-depth)
-	;; Compute how depth changes over this line
-	;; plus enough other lines to get to one that
-	;; does not end inside a comment or string.
-	;; Meanwhile, do appropriate indentation on comment lines.
-	(setq inner-loop-done nil)
-	(while (and (not inner-loop-done)
-		    (not (and (eobp) (setq outer-loop-done t))))
-	  (setq ostate state)
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  (if (and (car (cdr (cdr state)))
-		   (>= (car (cdr (cdr state))) 0))
-	      (setq last-sexp (car (cdr (cdr state)))))
-	  (if (or (nth 4 ostate))
-	      (icon-indent-line))
-	  (if (or (nth 3 state))
-	      (forward-line 1)
-	    (setq inner-loop-done t)))
-	(if (<= next-depth 0)
-	    (setq outer-loop-done t))
-	(if outer-loop-done
-	    nil
-	  (if (/= last-depth next-depth)
-	      (setq last-sexp nil))
-	  (while (> last-depth next-depth)
-	    (setq indent-stack (cdr indent-stack)
-		  contain-stack (cdr contain-stack)
-		  last-depth (1- last-depth)))
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  contain-stack (cons nil contain-stack)
-		  last-depth (1+ last-depth)))
-	  (if (null (car contain-stack))
-	      (setcar contain-stack (or (car (cdr state))
-					(save-excursion (forward-sexp -1)
-							(point)))))
-	  (forward-line 1)
-	  (skip-chars-forward " \t")
-	  (if (eolp)
-	      nil
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		;; Line is on an existing nesting level.
-		;; Lines inside parens are handled specially.
-		(if (/= (char-after (car contain-stack)) ?{)
-		    (setq this-indent (car indent-stack))
-		  ;; Line is at statement level.
-		  ;; Is it a new statement?  Is it an else?
-		  ;; Find last non-comment character before this line
-		  (save-excursion
-		    (setq at-else (looking-at "else\\W"))
-		    (setq at-brace (= (following-char) ?{))
-		    (icon-backward-to-noncomment opoint)
-		    (if (icon-is-continuation-line)
-			;; Preceding line did not end in comma or semi;
-			;; indent this line  icon-continued-statement-offset
-			;; more than previous.
-			(progn
-			  (icon-backward-to-start-of-continued-exp (car contain-stack))
-			  (setq this-indent
-				(+ icon-continued-statement-offset (current-column)
-				   (if at-brace icon-continued-brace-offset 0))))
-		      ;; Preceding line ended in comma or semi;
-		      ;; use the standard indent for this level.
-		      (if at-else
-			  (progn (icon-backward-to-start-of-if opoint)
-				 (setq this-indent (current-indentation)))
-			(setq this-indent (car indent-stack))))))
-	      ;; Just started a new nesting level.
-	      ;; Compute the standard indent for this level.
-	      (let ((val (calculate-icon-indent
-			   (if (car indent-stack)
-			       (- (car indent-stack))))))
-		(setcar indent-stack
-			(setq this-indent val))))
-	    ;; Adjust line indentation according to its contents
-	    (if (or (= (following-char) ?})
-		    (looking-at "end\\b"))
-		(setq this-indent (- this-indent icon-indent-level)))
-	    (if (= (following-char) ?{)
-		(setq this-indent (+ this-indent icon-brace-offset)))
-	    ;; Put chosen indentation into effect.
-	    (or (= (current-column) this-indent)
-		(progn
-		  (delete-region (point) (progn (beginning-of-line) (point)))
-		  (indent-to this-indent)))
-	    ;; Indent any comment following the text.
-	    (or (looking-at comment-start-skip)
-		(if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)
-		    (progn (indent-for-comment) (beginning-of-line))))))))))
-
-(defconst icon-font-lock-keywords-1
-  (eval-when-compile
-    (list
-     ;; Fontify procedure name definitions.
-       '("^[ \t]*\\(procedure\\)\\>[ \t]*\\(\\sw+\\)?"
-       ;; XEmacs change: builtin -> preprocessor.
-       (1 font-lock-preprocessor-face) (2 font-lock-function-name-face nil t))))
-  "Subdued level highlighting for Icon mode.")
-
-(defconst icon-font-lock-keywords-2
-  (append
-   icon-font-lock-keywords-1
-   (eval-when-compile
-     (list
-      ;; Fontify all type specifiers.
-      (cons
-       (regexp-opt  '("null" "string" "co-expression" "table" "integer"
-		      "cset"  "set" "real" "file" "list") 'words)
-       'font-lock-type-face)
-      ;; Fontify all keywords.
-      ;;
-      (cons
-       (regexp-opt
-	'("break" "do" "next" "repeat" "to" "by" "else" "if" "not" "return"
-	  "until" "case" "of" "while" "create" "every" "suspend" "default"
-	  "fail" "record" "then") 'words)
-       'font-lock-keyword-face)
-      ;; "end" "initial"
-      (cons (regexp-opt '("end" "initial") 'words)
-	    ;; XEmacs change: builtin -> preprocessor.
-	    'font-lock-preprocessor-face)
-      ;; Fontify all system variables.
-      (cons
-       (regexp-opt
-	'("&allocated" "&ascii" "&clock" "&col" "&collections" "&column"
-	  "&control" "&cset" "¤t" "&date" "&dateline" "&digits" "&dump"
-	  "&e" "&error" "&errornumber" "&errortext" "&errorvalue" "&errout"
-	  "&eventcode" "&eventsource" "&eventvalue" "&fail" "&features"
-	  "&file" "&host" "&input" "&interval" "&lcase" "&ldrag" "&letters"
-	  "&level" "&line" "&lpress" "&lrelease" "&main" "&mdrag" "&meta"
-	  "&mpress" "&mrelease" "&null" "&output" "&phi" "&pi" "&pos"
-	  "&progname" "&random" "&rdrag" "®ions" "&resize" "&row"
-	  "&rpress" "&rrelease" "&shift" "&source" "&storage" "&subject"
-	  "&time" "&trace" "&ucase" "&version" "&window" "&x" "&y") t)
-       ;; XEmacs change: constant -> variable-name.
-       'font-lock-variable-name-face)
-      ;; XEmacs change: this just causes too much trouble, commented out.
-;      (cons      ;; global local static declarations and link files
-;       (concat
-;	"^[ \t]*"
-;	(regexp-opt '("global" "link" "local" "static") t)
-;	"\\(\\sw+\\>\\)*")
-;       '((1 font-lock-builtin-face)
-;	 (font-lock-match-c-style-declaration-item-and-skip-to-next
-;	  (goto-char (or (match-beginning 2) (match-end 1))) nil
-;	  (1 (if (match-beginning 2)
-;		 font-lock-function-name-face
-;	       font-lock-variable-name-face)))))
-
-      (cons      ;; $define $elif $ifdef $ifndef $undef
-       (concat "^"
-	       (regexp-opt'("$define" "$elif" "$ifdef" "$ifndef" "$undef") t)
-	       "\\>[ \t]*\\([^ \t\n]+\\)?")
-	    ;; XEmacs change: builtin -> preprocessor.
-	    '((1 font-lock-preprocessor-face)
-	      (4 font-lock-variable-name-face nil t)))
-      (cons      ;; $dump $endif $else $include
-       (concat
-	"^" (regexp-opt'("$dump" "$endif" "$else" "$include") t) "\\>" )
-       ;; XEmacs change: builtin -> preprocessor.
-       'font-lock-preprocessor-face)
-      (cons      ;; $warning $error
-       (concat "^" (regexp-opt '("$warning" "$error") t)
-	       "\\>[ \t]*\\(.+\\)?")
-       ;; XEmacs change: builtin -> preprocessor.
-       '((1 font-lock-preprocessor-face) (3 font-lock-warning-face nil t))))))
-  "Gaudy level highlighting for Icon mode.")
-
-(defvar icon-font-lock-keywords icon-font-lock-keywords-1
-  "Default expressions to highlight in `icon-mode'.")
-
-;;;used by hs-minor-mode
-(defun icon-forward-sexp-function (arg)
-  (if (< arg 0)
-      (beginning-of-icon-defun)
-    (end-of-icon-defun)
-    (forward-char -1)))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.icn\\'" . icon-mode))
-
-(provide 'icon)
-
-;;; icon.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/javascript-mode.el b/xemacs-packages/lisp/prog-modes/javascript-mode.el
deleted file mode 100644
index 7e1aeda8..00000000
--- a/xemacs-packages/lisp/prog-modes/javascript-mode.el
+++ /dev/null
@@ -1,389 +0,0 @@
-;;; javascript-mode.el --- major mode for editing JavaScript code
-
-;; Copyright (C) 1997-2001 Steven Champeon
-;;               2002-2006 Ville Skyttä
-
-;; Author:     1997 Steven Champeon 
-;; Maintainer: Ville Skyttä 
-;; Keywords:   languages javascript
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;; Synched up with: not in GNU Emacs.
-
-;;; Commentary:
-
-;; javascript-mode was originally derived from java-cust.el
-;; (by Jonathan Payne) by Steven Champeon. It has been modified
-;; a lot afterwards by Ville Skyttä.
-
-;; Contributors:
-;;   Sreng Truong      (bug fix for 21.1)
-;;   Sebastian Delmont (fix for prototype function indentation problems)
-;;   Stefan Schlee     (GNU Emacs compatibility fixes)
-;;   Igor Rayak        (ditto)
-;;   Tsirkin Evgeny    (regexp improvement ideas)
-
-;; TODO:
-;; - Multiple font-lock/highlight levels.
-;; - Investigate if Semantic Bovinator should be used.
-;; - Check syntax-table stuff.
-
-;;; Code:
-
-(require 'cc-mode)
-(require 'comint)
-
-(eval-when-compile
-  (require 'regexp-opt)
-  (require 'font-lock)
-  (require 'speedbar)
-  )
-
-;; ------------------------------------------------------------------------ ;;
-
-(defconst javascript-mode-version "1.10" "Version of `javascript-mode'.")
-
-;; ------------------------------------------------------------------------ ;;
-
-(defgroup javascript nil
-  "Major mode for editing JavaScript code."
-  :tag "JavaScript"
-  :group 'languages
-  :prefix "javascript-")
-
-(defcustom javascript-mode-hook nil
-  "Hook for customizing `javascript-mode'."
-  :group 'javascript
-  :type 'hook)
-
-(defgroup javascript-shell nil
-  "JavaScript shell options."
-  :group 'javascript
-  :prefix "javascript-shell-")
-
-(defcustom javascript-shell-command "jsshell"
-  "*Command for starting `javascript-shell'.
-Set arguments for this command in `javascript-shell-command-args'."
-  :type 'string
-  :group 'javascript-shell)
-
-(defcustom javascript-shell-command-args '()
-  "*Command line arguments for `javascript-shell-command'."
-  :type '(repeat (string :tag "Argument"))
-  :group 'javascript-shell)
-
-(defcustom javascript-shell-prompt-pattern "^js> *"
-  "*JavaScript shell prompt pattern."
-  :type 'regexp
-  :group 'javascript-shell)
-
-(defcustom javascript-shell-mode-hook nil
-  "Hook for customizing `javascript-shell-mode'."
-  :type 'hook
-  :group 'javascript-shell)
-
-;; ------------------------------------------------------------------------ ;;
-
-(defvar javascript-mode-abbrev-table nil
-  "Abbrev table in use in `javascript-mode' buffers.")
-(define-abbrev-table 'javascript-mode-abbrev-table ())
-
-;; ------------------------------------------------------------------------ ;;
-
-(defvar javascript-mode-map (c-make-inherited-keymap)
-  "Keymap used in `javascript-mode' buffers.")
-
-(defvar javascript-menu nil)
-(easy-menu-define javascript-menu javascript-mode-map
-                  "JavaScript Mode Commands" (c-mode-menu "JavaScript"))
-
-;; ------------------------------------------------------------------------ ;;
-
-;; Reserved words in JavaScript.
-(defconst javascript-reserved-words
-  (eval-when-compile
-    (regexp-opt
-     '(
-       "abstract"
-       "boolean"
-       "break"
-       "byte"
-       "case"
-       "catch"
-       "char"
-       "class"
-       "const"
-       "continue"
-       "debugger"
-       "default"
-       "delete"
-       "do"
-       "double"
-       "else"
-       "enum"
-       "export"
-       "extends"
-       "false"
-       "final"
-       "finally"
-       "float"
-       "for"
-       "function"
-       "goto"
-       "if"
-       "implements"
-       "import"
-       "in"
-       "instanceof"
-       "int"
-       "interface"
-       "long"
-       "native"
-       "new"
-       "null"
-       "package"
-       "private"
-       "protected"
-       "public"
-       "return"
-       "short"
-       "static"
-       "super"
-       "switch"
-       "synchronized"
-       "this"
-       "throw"
-       "throws"
-       "transient"
-       "true"
-       "try"
-       "typeof"
-       "var"
-       "void"
-       "volatile"
-       "while"
-       "with"
-       ) t))
-  "Expression for matching reserved words in `javascript-mode' buffers.
-
-From Core JavaScript Reference 1.5, Reserved Words:
-")
-
-
-;; JavaScript identifiers
-;; This one is intentionally not too strict...
-(defconst javascript-identifier
-  "[a-zA-Z_\\$][a-zA-Z0-9_\\$]*"
-  "Expression for matching identifiers in `javascript-mode' buffers.
-
-From Core JavaScript Guide 1.5, Core Language Features:
-")
-
-;; ------------------------------------------------------------------------ ;;
-
-;; Font lock keywords etc
-
-;; eg. function foo(bar, quux)
-(defconst javascript-function-re
-  (concat "\\(^\\|[ \t;{]\\)"
-          "function[ \t]+"
-          "\\("
-          "\\(" javascript-identifier "\\.\\)*"
-          javascript-identifier
-          "\\)")
-  "Regular expression for matching \"normal\" function declarations.")
-
-;; eg. foo: function(bar, quux)
-(defconst javascript-property-function-re
-  (concat "\\(^\\|[ \t;{]+\\)"
-          "\\("
-          "\\(" javascript-identifier "\\.\\)*"
-          javascript-identifier
-          "\\)"
-          "[ \t]*:[ \t]*"
-          "\\(new[ \t]+Function\\|function\\)"
-          "[ \t]*(")
-  "Regular expression for matching property style function declarations.")
-
-;; eg. foo.bar.quux = function(baz)
-(defconst javascript-prototype-function-re
-  (concat "\\(^\\|[ \t;{]+\\)"
-          "\\("
-          "\\(" javascript-identifier "\\.\\)*"
-          javascript-identifier
-          "\\)"
-          "[ \t]*=[ \t]*"
-          "\\(new[ \t]+Function\\|function\\)"
-          "[ \t]*(")
-  "Regular expression for matching prototype style function declarations.")
-
-(defconst javascript-variable-re
-  (concat "\\(^\\|[ \t;{(]\\)\\(const\\|var\\)[ \t]+"
-          "\\("
-          javascript-identifier
-          "\\)")
-  "Regular expression for matching variables.")
-
-(defconst javascript-font-lock-keywords
-  (list
-
-   ;; Reserved words.
-   (cons (concat
-          "\\(^\\|[ \t;{(]\\)\\("
-          javascript-reserved-words
-          "\\)[ \t\n(){};,]")
-         '(2 'font-lock-keyword-face))
-
-   ;; Function declarations.
-   (cons javascript-function-re '(2 'font-lock-function-name-face))
-   (cons javascript-property-function-re '(2 'font-lock-function-name-face))
-   (cons javascript-prototype-function-re '(2 'font-lock-function-name-face))
-   ;; This would catch both declarations and calls.
-   ;(cons (concat
-   ;       "\\(^\\|[ \t.;{(]\\)\\("
-   ;       javascript-identifier
-   ;       "\\)[ \t]*(")
-   ;      '(2 'font-lock-function-name-face))
-
-   ;; Variables and constants.
-   (cons javascript-variable-re '(3 'font-lock-variable-name-face))
-   ;; This would catch more of them and properties as well.
-   ;(cons (concat
-   ;       "\\(^\\|[ \t(\\[\\.{;]\\)\\("
-   ;       javascript-identifier
-   ;       "\\)[ \t]*[^(]")
-   ;      '(2 'font-lock-variable-name-face))
-
-   )
-  "Highlighting rules for `javascript-mode' buffers.")
-
-;; ------------------------------------------------------------------------ ;;
-
-(defvar javascript-imenu-generic-expression
-  `((nil ,javascript-function-re 2)
-    (nil ,javascript-property-function-re 2)
-    (nil ,javascript-prototype-function-re 2)
-    ;; ("Variables" ,javascript-variable-re 3)
-    )
-  "Imenu generic expression for JavaScript mode.
-See `imenu-generic-expression'.")
-
-;; ------------------------------------------------------------------------ ;;
-
-;;;###autoload
-(defun javascript-mode ()
-  "Major mode for editing JavaScript code.
-
-See the documentation for `c++-mode': JavaScript mode is an extension of it.
-Use the hook `javascript-mode-hook' to execute custom code when entering
-JavaScript mode.
-
-\\{javascript-mode-map}"
-  (interactive)
-
-  (let ((current-c++-mode-hook (and (boundp 'c++-mode-hook) c++-mode-hook)))
-
-    ;; Temporarily disable the c++-mode hook; don't wanna run
-    ;; it when loading up c++-mode.
-    (setq c++-mode-hook nil)
-    (c++-mode)
-
-    ;; Do our stuff.
-    (setq major-mode 'javascript-mode mode-name "JavaScript")
-    (use-local-map javascript-mode-map)
-    (setq local-abbrev-table javascript-mode-abbrev-table)
-    (c-set-offset 'inher-cont '+)
-
-    ;; Change menu name.  Kudos to Geert Ribbers and Igor Rayak.
-    (easy-menu-remove '("C++"))
-    (easy-menu-add javascript-menu)
-
-    ;; GNU Emacs reportedly needs this for font locking to work properly.
-    (unless (featurep 'xemacs)
-      (set (make-local-variable 'font-lock-defaults)
-           '(javascript-font-lock-keywords nil nil)))
-
-    ;; cc-mode does not handle JavaScript prototype function declarations well.
-    ;; Thanks to Sebastian Delmont.
-    (set (make-local-variable 'c-lambda-key) "function")
-    (c-set-offset 'inlambda 0)
-
-    ;; imenu support.
-    (set (make-local-variable 'imenu-generic-expression)
-         javascript-imenu-generic-expression)
-
-    ;; Restore the original c++-mode-hook.
-    (setq c++-mode-hook current-c++-mode-hook)
-
-    (run-hooks 'javascript-mode-hook)))
-
-;; ------------------------------------------------------------------------ ;;
-
-;;;###autoload
-(defun javascript-shell ()
-  "Run a JavaScript shell as an inferior process.
-
-Use the `javascript-shell-command' variable to set the command and
-`javascript-shell-command-args' for its arguments to specify the
-command line that invokes your preferred JavaScript shell.
-
-Free JavaScript shell implementations are available for example from
-.
-
-Usage examples:        command    arguments
- Mozilla SpiderMonkey  jsshell
- Mozilla Rhino         java       -jar /path/to/js.jar"
-
-  (interactive)
-
-  (unless (comint-check-proc "*JavaScript*")
-    (set-buffer
-     (apply 'make-comint "JavaScript"
-            javascript-shell-command nil javascript-shell-command-args))
-    (javascript-shell-mode)
-    )
-
-  (pop-to-buffer "*JavaScript*")
-  )
-
-
-(defun javascript-shell-mode ()
-  "Major mode for interacting with a JavaScript shell."
-  (comint-mode)
-  (setq comint-prompt-regexp javascript-shell-prompt-pattern)
-  (setq mode-name 'javascript-shell-mode)
-  (setq mode-name "JavaScript Shell")
-  (setq mode-line-process '(":%s"))
-  (run-hooks 'javascript-shell-mode-hook)
-  )
-
-;; ------------------------------------------------------------------------ ;;
-
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.js$" . javascript-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.pac$" . javascript-mode))
-
-;; Speedbar handling
-(if (fboundp 'speedbar-add-supported-extension)
-    (speedbar-add-supported-extension '(".js" ".pac")))
-
-;; ------------------------------------------------------------------------ ;;
-
-(provide 'javascript-mode)
-
-;;; javascript-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/ksh-mode.el b/xemacs-packages/lisp/prog-modes/ksh-mode.el
deleted file mode 100644
index 809ba98f..00000000
--- a/xemacs-packages/lisp/prog-modes/ksh-mode.el
+++ /dev/null
@@ -1,1341 +0,0 @@
-;; ksh-mode.el --- sh (ksh, bash) script editing mode for GNU Emacs.
-
-;; Copyright (C) 1992-1999 Gary Ellison.
-
-;; This file is compatible with GNU Emacs but is not part of the official
-;; distribution.
-;;
-;; This program is free software; you can redistribute it and/or modify
-;; it at your option.
-;;   
-;; Gary Ellison makes no representations about the suitability
-;; of this software for any purpose.  It is provided "as is" without
-;; express or implied warranty.
-;;
-;; 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.
-
-;; $Source: /usr/CVSroot/XEmacs/packages/xemacs-packages/prog-modes/ksh-mode.el,v $ --  
-;;
-;; LCD Archive Entry:
-;; ksh-mode|Gary Ellison|gfe@interhack.net
-;; |Mode for editing sh/ksh/bash scripts
-;; |$Date: 2000/10/06 09:12:14 $|$Revision: 1.4 $|~/modes/ksh-mode.el.Z|
-
-;; Author: Gary Ellison 
-;;                   Interhack Posse
-;;
-;; Maintainer: Gary Ellison 
-;; Created: Fri Jun 19
-;; $Revision: 1.4 $
-;; Keywords: shell, korn, bourne, sh, ksh, bash
-;;
-;; Delta On   $Date: 2000/10/06 09:12:14 $
-;; Last Modified By: Gary Ellison
-;; Status          : Highly Functional
-;;
-
-;;; Commentary:
-
-;;
-;; Description:
-;;   sh, ksh, and bash script editing commands for emacs.
-;; 
-;; Installation:
-;;   Put ksh-mode.el in some directory in your load-path.
-;;   Refer to the installation section of ksh-mode's function definition.
-;;
-;; Usage:
-;;   This major mode assists shell script writers with indentation
-;;   control and control structure construct matching in much the same
-;;   fashion as other programming language modes. Invoke describe-mode
-;;   for more information.
-;; 
-;; Bugs:
-;;   When the ksh-align-to-keyword is non-nil and the nester
-;;   is a multi-command expression with a compound command
-;;   the lines following the compound end will align incorrectly
-;;   to the compound command instead of it's current indentation.
-;;   The fix will probably require the detection of syntax elements
-;;   in the nesting line.
-;;   
-;;   Function ending brace "}" must be on a separate line for indent-line
-;;   to do the right thing.
-;;
-;;   Explicit function definition matching will proclaim in the minibuffer
-;;   "No matching compound command" followed by "Matched ... "
-;;
-;;   indent-for-comment fails to recognize a comment starting in column 0,
-;;   hence it moves the comment-start in comment-column.
-
-;;; Code:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; HISTORY 
-;; 13-May-99            Gary Ellison
-;;    Removed some testing baggage which leaked into previous release.
-;;
-;; 29-Apr-99            Gary Ellison
-;;    I moved and forgot to submit a forwarding address to the codeoffice.
-;;    Minor mucks with font-lock.
-;;
-;; 28-Feb-97            Kevin Blake 
-;;    font-lock enhancements
-;;
-;; 4-Feb-97             Jim Berry 
-;;    Converted from use of font-lock-keywords to font-lock-defaults.
-;;
-;; 6-Apr-96             Gary Ellison 
-;;    Depreciated font-lock-doc-string-face.
-;;    Narly keywords inside strings bug fixed. 
-;;
-;; 8-Aug-95		Jack Repenning 
-;;    Fix documentation of `ksh-align-to-keyword' to conform to the 23
-;;    Feb default change.  Search for keywords obeying case, since the
-;;    shell does.
-;;
-;; 23-Feb-1995		Gary Ellison	
-;;    Merged Jonathan Stigelman  into 2.5 souce.
-;;
-;; 23 Feb 1995          Jonathan Stigelman 
-;;    Reshuffled documentation to make the format more consistant with other
-;;    elisp.  Added autoload and removed autoloading instructions from the
-;;    ksh-mode docstring.  Changed default value for `ksh-align-to-keyword'
-;;    to nil because it doesn't work properly.
-;;
-;; 2-Aug-1994		Gary Ellison	
-;;    Last Modified: Mon Jun 13 16:52:55 1994 #29 (Gary Ellison)
-;;    - Syntax table modifications to better support sexp navigation and
-;;      parsing.
-;;    - Fixed keyword regexps. Keywords were not being recoginized on the
-;;      same line as " ' `.
-;;
-;; 13-Jun-1994		Gary Ellison	
-;;    Last Modified: Wed Mar 30 14:12:26 1994 #28 (Gary Ellison)
-;;    - Minor excursion problem fixed in ksh-indent-command.
-;;
-;; 30-Mar-1994		Gary Ellison	
-;;    Last Modified: Fri Mar 25 15:42:29 1994 #25 (Gary Ellison)
-;;    - Implement user customizable ksh-comment-regexp.
-;;    - Make the keyword vs line indentation alignment customizable
-;;      by calling ksh-align-to-keyword based on variable of same
-;;      name. (If the code is obfuscated or convoluted I can attribute
-;;      this to a severe head cold and not malice :)
-;;
-;; 25-Mar-1994		Gary Ellison	
-;;    Last Modified: Fri Feb  4 13:06:30 1994 #23 (Gary Ellison)
-;;    - Nest relative to the line indentation not the keywords
-;;      column.
-;;
-;; 4-Feb-1994		Gary Ellison	
-;;    Last Modified: Wed Nov 10 10:03:01 1993 #18 (Gary Ellison)
-;;    - Add direct support for font-lock-mode. Thanks Espen Skoglund
-;;      for the regular expressions.
-;;
-;; 10-Nov-1993		Gary Ellison	
-;;    Last Modified: Tue Oct 12 15:23:06 1993 #17 (Gary Ellison)
-;;    Fix message on ksh-match-and-tell to not get invalid format
-;;    when a % appears in the string.
-;;
-;; 12-Oct-1993		Espen Skoglund .
-;;    Last Modified: Tue Oct 12 15:03:01 1993 #16 (Gary Ellison)
-;;    Apply Line continuation patch supplied by Espen Skoglund
-;;
-;; 1-Sep-1993		Gary Ellison	
-;;    Last Modified: Tue Aug 17 17:18:18 1993 #14 (Gary Ellison)
-;;    Get rid of this-line hack in ksh-get-nester-column.
-;;
-;; 17-Aug-1993		Gary Ellison	
-;;    Last Modified: Mon Jun 21 14:00:43 1993 #13 (Gary Ellison)
-;;    Code uses builtin current-indentation instead of lisp defun
-;;    ksh-indentation-on-this-line (thanks to Tom Tromey).
-;;    More and better doc strings.
-;;
-;; 5-Aug-1993		Tom Tromey 
-;;    Last Modified: Thu Aug  5 11:09:12 1993 #12 (Tom Tromey)
-;;    ksh-indent-region skips blank lines.  Uses let binding instead
-;;    of setq.  No longer marks buffer modified if indentation
-;;    doesn't change. 
-;;
-;; 21-Jun-1993		Gary Ellison	
-;;    Last Modified: Mon Mar 29 15:05:34 1993 #11 (Gary Ellison)
-;;    Use make-local-variables instead of make-variables-buffer-local
-;;    ksh-indent now supports nil (keyword aligned) or number (offset)
-;;    Support ksh-tab-always-indent feature
-;;    Variables offsetting indentation renamed to better reflect their
-;;    role.
-;;    Integrate keyword completion feature supplied by
-;;    Haavard Rue .
-;;
-;; 29-Mar-1993		Gary Ellison	
-;;    Last Modified: Tue Sep 29 16:14:02 1992 #10 (Gary Ellison)
-;;    Integrate line continuation patch supplied by
-;;    Haavard Rue 
-;;    Name back to ksh-mode to avoid confusion with sh-mode
-;;    by Thomas W. Strong, Jr. .
-;;
-;; 29-Sep-1992		Gary Ellison	
-;;    Last Modified: Wed Sep  2 08:51:40 1992 #9 (Gary Ellison)
-;;    Full support of ksh88 case items. 
-;;    Align statements under "do" and "then" keywords one position 
-;;    past the keyword.
-;;
-;; 2-Sep-1992		Gary Ellison	
-;;    Last Modified: Tue Aug  4 14:34:35 1992 #8 (Gary Ellison)
-;;    Use make-variable-buffer-local instead of make-local-variable
-;;    Get rid of superflous ksh-default variables.
-;;    Use end of word match \b for "then", "do", "else", "elif"
-;;    Support process substitution lists and exclude ksh 88 case items
-;;    Use default-tab-width for indentation defaults.
-;;    Moved installation instructions to the mode level documentation 
-;;    section.
-;;    Fixed auto-mode-alist documentation.
-;;
-;; 24-Jul-1992		Gary Ellison	
-;;    Last Modified: Fri Jul 24 09:45:11 1992 #7 (Gary Ellison)
-;;    Modified ksh-indent-region to use marker versus fixed end point.
-;;    comment-start-skip regexp no longer fooled by parameter substitution.
-;;    Added constant ksh-mode-version.
-;;
-;; 21-Jul-1992		Gary Ellison	
-;;    Last Modified: Tue Jul 21 15:53:57 1992 #6 (Gary Ellison)
-;;    Indent with tabs instead of spaces.
-;;    Can handle just about all styles.
-;;    Anti-newline in REs.
-;;    Word delim "\b" in REs
-;;    More syntax entries.
-;;    Variables with regexp suffix abbreviated to re
-;;    Better } handling
-;;    Implemented minimal indent-region-function
-;;    Mode documentation corrected.
-;;    Minor lisp source format changes.
-;;    
-;; 29-Jun-1992		Gary Ellison	
-;;    Last Modified: Mon Jun 29 15:39:35 1992 #5 (Gary Ellison)
-;;    Optimize line-to-string
-;;    Implicit/Explicit functions aok
-;;    More indentation variables
-;;    Superfluous defun killed.
-;;    renamed to sh-mode
-;;    
-;; 22-Jun-1992          Gary Ellison
-;;    Last Modified: Mon Jun 22 15:01:14 1992 #4 (Gary Ellison)
-;;    Cleanup pre att.emacs posting
-;;
-;; 19-Jun-1992          Gary Ellison
-;;    Last Modified: Fri Jun 19 17:19:14 1992 #3 (Gary Ellison)
-;;    Minimal case indent handling
-;;
-;; 19-Jun-1992          Gary Ellison
-;;    Last Modified: Fri Jun 19 16:23:26 1992 #2 (Gary Ellison)
-;;    Nesting handled except for case statement
-;;
-;; 19-Jun-1992          Gary Ellison
-;;    Last Modified: Fri Jun 19 10:03:07 1992 #1 (Gary Ellison)
-;;    Conception of this mode.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defconst ksh-mode-version "$Revision: 1.4 $"
-  "*Version numbers of this version of ksh-mode")
-
-;;
-;; Variables controlling indentation style
-;;
-
-(defvar ksh-indent 2 
-  ;; perhaps c-basic-offset would be okay to use as a default, but using
-  ;; default-tab-width as the default is ridiculous --Stig
-  "*Indentation of ksh statements with respect to containing block. A value
-of nil indicates compound list keyword \(\"do\" and \"then\"\) alignment.")
-(defvar ksh-case-item-offset ksh-indent
-  "*Additional indentation for case items within a case statement.")
-(defvar ksh-case-indent nil
-  "*Additional indentation for statements under case items.")
-(defvar ksh-group-offset (- ksh-indent)
-  "*Additional indentation for keywords \"do\" and \"then\".")
-(defvar ksh-brace-offset 0
-  "*Additional indentation of \"{\" under functions or brace groupings.")
-(defvar ksh-multiline-offset 1
-  "*Additional indentation of line that is preceded of a line ending with a
-\\ to make it continue on next line.")
-(defvar ksh-match-and-tell t
-  "*If non-nil echo in the minibuffer the matching compound command
-for the \"done\", \"}\", \"fi\", or \"esac\". ")
-(defvar ksh-tab-always-indent t
-  "*Controls the operation of the TAB key. If t (the default), always
-reindent the current line.  If nil, indent the current line only if
-point is at the left margin or in the line's indentation; otherwise
-insert a tab.")
-
-(defvar ksh-align-to-keyword nil
-  ;; #### - this is broken, so it should be disabled by default --Stig
-  "*Controls whether nested constructs align from the keyword or
-the current indentation. If non-nil, indentation will be relative to
-the column the keyword starts. If nil, indentation will be relative to
-the current indentation of the line the keyword is on.
-The default value is non-nil.  The non-nil case doesn't work very well.")
-
-(defvar ksh-comment-regexp "^\\s *#"
-  "*Regular expression used to recognize comments. Customize to support
-ksh-like languages.")
-
-(defun ksh-current-indentation ()
-  nil)
-;;
-(fset 'ksh-current-indentation 'current-column)
-;;
-;; Variables controlling completion
-(defvar ksh-completion-list '())
-(make-variable-buffer-local 'ksh-completion-list)
-(set-default 'ksh-completion-list  '())
-
-;;
-;; -type-  : type number, 0:misc, 1:variable, 2:function
-;; -regexp-: regexp used to parse the script
-;; -match- : used by match-beginning/end to pickup target
-;;
-(defvar ksh-completion-type-misc 0)
-(defvar ksh-completion-regexp-var "\\([A-Za-z_0-9]+\\)=")
-(defvar ksh-completion-type-var 1)
-(defvar ksh-completion-match-var 1) 
-(defvar ksh-completion-regexp-var2 "\\$\\({\\|{#\\)?\\([A-Za-z_0-9]+\\)[#%:}]?")
-(defvar ksh-completion-match-var2 2)
-(defvar ksh-completion-regexp-function
-  "\\(function\\)?[ \t]*\\([A-Za-z_0-9]+\\)[ \t]*([ \t]*)")
-(defvar ksh-completion-type-function 2)
-(defvar ksh-completion-match-function 2)
-
-;;
-;; Variable controlling fontification
-;;
-;(defvar ksh-keywords '("for" "in" "do" "done" "select" "case" "esac" "if"
-;"then" "elif" "else" "fi" "while" "until" "function" "time"
-;"alias" "bg" "break" "continue" "cd" "exit" "echo" "fc" "fg" "getopts" "jobs"
-;"kill" "let" "newgrp" "print" "pwd" "read" "readonly" "return" "set" "shift"
-;"test" "times" "trap" "typeset" "ulimit" "umask" "unalias" "unset" "wait" "whence"))
-
-(setq ksh-keywords "alias\\|b\\(g\\|reak\\)\\|c\\(ase\\|d\\|ontinue\\)\\|do\\(\\|ne\\)\\|e\\(cho\\|l\\(if\\|se\\)\\|sac\\|x\\(it\\|port\\)\\)\\|f\\([cgi]\\|or\\|unction\\)\\|getopts\\|i[fn]\\|jobs\\|kill\\|let\\|newgrp\\|p\\(rint\\|wd\\)\\|re\\(ad\\(\\|only\\)\\|turn\\)\\|s\\(e\\(lect\\|t\\)\\|hift\\)\\|t\\(est\\|hen\\|imes?\\|rap\\|ypeset\\)\\|u\\(limit\\|mask\\|n\\(alias\\|set\\|til\\)\\)\\|w\\(ait\\|h\\(ence\\|ile\\)\\)")
-
-;;       '("\\")
-	     1)
-       ;; Fontify function names
-       '("\\" 2 font-lock-variable-name-face)
-       ;; Fontify aliases
-       '("\\" 2 font-lock-type-face)
-       ;; Fontify $variables/parameters
-       '("\\(\\$\\([A-Za-z_#-][A-Za-z0-9_]*\\|{[^}]+}\\|([^)]+)\\)\\)"
-	 ;; The `if' is needed because the specific faces are unique to the
-	 ;; two emacsen.
-	 1 (if (string-match "XEmacs" emacs-version)
-	       font-lock-preprocessor-face
-	     font-lock-reference-face))
-       ))
-       "Expressions to font-lock in ksh-mode.")
-
-(defvar ksh-mode-hook nil
-  "Hook to run when entering ksh-mode.")
-
-;; For the ksh-mode function, a small suggestion.
-
-;;
-;; config font-lock mode
-
-;; First, some ugly stuff that is necessary to support GNU Emacs as
-;; well as XEmacs.
-;; Setting up things for font-lock
-;;  (if (string-match "XEmacs" emacs-version)
-;;      (progn
-;;	(make-local-variable 'font-lock-keywords)
-;;	(setq font-lock-keywords ksh-font-lock-keywords))
-;;    ;; Emacs
-;;    (make-local-variable 'font-lock-defaults)
-;;    (setq font-lock-defaults '(ksh-font-lock-keywords nil t))
-;;    )
-
-(put 'ksh-mode 'font-lock-defaults '(ksh-font-lock-keywords))
-
-;;
-;; Context/indentation regular expressions
-;; 
-;; indenting expressions
-;;
-;(defconst ksh-then-do-re     "^[^#\n]*\\s\"*\\b\\(then\\|do\\)\\b"
-(defconst ksh-then-do-re     "\\s *\\b\\(then\\|do\\)\\b"
-  "*Regexp used to locate grouping keywords: \"then\" and \"do\"" )
-
-(defconst ksh-do-re          "\\s *\\bdo\\(\\b\\|$\\)"
-  "*Regexp used to match keyword: do")
-
-(defconst ksh-then-re        "\\s *\\bthen\\(\\b\\|$\\)"
-  "*Regexp used to match keyword: then")
-
-;;
-;; Structure starting/indenting keywords
-;;
-(defconst ksh-else-re           "\\s *\\belse\\(\\b\\|$\\)"
-  "*Regexp used to match keyword: else")
-
-(defconst ksh-elif-re           "\\s *\\belif\\(\\b\\|$\\)"
-  "*Regexp used to match keyword: elif")
-
-(defconst ksh-brace-re           "\\S>*{[ \t\n]"
-  "*Regexp used to match syntactic entity: { ")
-
-(defconst ksh-case-item-end-re           "\\S>*;;[ \t\n]"
-  "*Regexp used to match case item end syntactic entity: ;;")
-
-(defconst ksh-keywords-re
-  "\\s *\\b\\(else\\|if\\|elif\\|case\\|while\\|for\\|until\\|select\\)\\b"
-  "*Regexp used to detect compound command keywords: if, else, elif case, 
-while, for, until, and select")
-
-
-(defconst ksh-if-re         "\\s *\\b\\(if\\)\\b"
-  "*Regexp used to match keyword: if")
-
-(defconst ksh-iteration-keywords-re 
-  "\\s *\\b\\(while\\|for\\|until\\|select\\)\\b"
-  "*Match one of the keywords: while, until, for, select")
-
-(defconst ksh-case-re           "\\s *\\bcase\\b"
-  "*Regexp used to match keyword: case")
-
-(defconst ksh-explicit-func-re
-  "^\\s *\\(function\\s [a-zA-z_][a-zA-Z0-1_]*\\)\\b"
-  "*Match an explicit function definition: function name")
-
-(defconst ksh-implicit-func-re
-  "^\\s *\\([a-zA-z_][a-zA-Z0-1_]*\\)\\s *()\\s *"
-  "*Match an implicit function definition: name ()")
-
-(defconst ksh-func-brace-re "^\\s *\\(.*{\\)[ \t\n]+"
-  "*Match a implicit function definition brace: name { ")
-
-;;
-;; indenting 
-(defconst ksh-case-item-re           "^[^#\n]*\\s\"*\\()\\)"
-  "*Regexp used to match case-items including ksh88")
-
-(defconst ksh-paren-re           "^[^#\n]*\\s\"*)[ \t\n]+"
-  "*Regexp used to match compound list & case items")
-
-;;
-;; structure ending keyword regular expressions
-(defconst ksh-fi-re            "\\s *\\bfi\\b"
-  "*Regexp used to match keyword: fi")
-
-(defconst ksh-esac-re          "\\s *\\besac\\b"
-  "*Regexp used to match keyword: esac")
-
-(defconst ksh-done-re          "\\s *\\bdone\\b"
-  "*Regexp used to match keyword: done")
-
-(defconst ksh-brace-end-re  "\\s *}\\s *"
-  "*Regexp used to match function brace-groups")
-
-(defconst ksh-multiline-re "^.*\\\\$"
-  "*Regexp used to match a line with a statement using more lines.")
-
-;;
-;;
-;; Create mode specific tables
-(defvar ksh-mode-syntax-table nil
-  "Syntax table used while in ksh mode.")
-(if ksh-mode-syntax-table
-    ()
-  (setq ksh-mode-syntax-table (make-syntax-table (standard-syntax-table)))
-  (modify-syntax-entry ?\( "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?\) "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?{ "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?} "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?\[ "(]" ksh-mode-syntax-table)
-  (modify-syntax-entry ?\] ")[" ksh-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" ksh-mode-syntax-table)
-  (modify-syntax-entry ?` "\"" ksh-mode-syntax-table)
-  (modify-syntax-entry ?\n ">" ksh-mode-syntax-table)
-  (modify-syntax-entry ?\f ">" ksh-mode-syntax-table)
-  (modify-syntax-entry ?# "<" ksh-mode-syntax-table)
-  (modify-syntax-entry ?_ "w" ksh-mode-syntax-table)
-  (modify-syntax-entry ?< "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?> "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?& "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?| "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?$ "\\" ksh-mode-syntax-table)
-  (modify-syntax-entry ?% "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?= "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?/ "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?+ "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?* "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?- "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?\; "." ksh-mode-syntax-table)
-  (modify-syntax-entry ?: "." ksh-mode-syntax-table)
-  )
-
-(defvar ksh-mode-abbrev-table nil
-  "Abbrev table used while in ksh mode.")
-(define-abbrev-table 'ksh-mode-abbrev-table ())
-
-(defvar ksh-mode-map nil 
-  "Keymap used in ksh mode")
-
-(if ksh-mode-map
-    ()
-  (setq ksh-mode-map (make-sparse-keymap))
-  (define-key ksh-mode-map "\t"    'ksh-indent-command)
-  (define-key ksh-mode-map "\t"    'ksh-indent-line)
-  (define-key ksh-mode-map "\C-j"    'reindent-then-newline-and-indent)
-  (define-key ksh-mode-map "\e\t"    'ksh-complete-symbol)
-  (define-key ksh-mode-map "\C-c\t"    'ksh-completion-init-and-pickup)
-  )
-
-
-;;;###autoload
-(defun ksh-mode ()
-  "ksh-mode $Revision: 1.4 $ - Major mode for editing (Bourne, Korn or Bourne again)
-shell scripts.
-Special key bindings and commands:
-\\{ksh-mode-map}
-Variables controlling indentation style:
-ksh-indent
-    Indentation of ksh statements with respect to containing block.
-    Default value is 2.
-ksh-case-indent
-    Additional indentation for statements under case items.
-    Default value is nil which will align the statements one position 
-    past the \")\" of the pattern.
-ksh-case-item-offset
-    Additional indentation for case items within a case statement.
-    Default value is 2.
-ksh-group-offset
-    Additional indentation for keywords \"do\" and \"then\".
-    Default value is -2.
-ksh-brace-offset
-    Additional indentation of \"{\" under functions or brace groupings.
-    Default value is 0.
-ksh-multiline-offset
-   Additional indentation of line that is preceded of a line ending with a
-   \\ to make it continue on next line.
-ksh-tab-always-indent
-    Controls the operation of the TAB key. If t (the default), always
-    reindent the current line.  If nil, indent the current line only if
-    point is at the left margin or in the line's indentation; otherwise
-    insert a tab.
-ksh-match-and-tell
-    If non-nil echo in the minibuffer the matching compound command
-    for the \"done\", \"}\", \"fi\", or \"esac\". Default value is t.
-
-ksh-align-to-keyword
-    Controls whether nested constructs align from the keyword or
-    the current indentation. If non-nil, indentation will be relative to
-    the column the keyword starts. If nil, indentation will be relative to
-    the current indentation of the line the keyword is on.
-    The default value is non-nil.
-
-ksh-comment-regexp
-  Regular expression used to recognize comments. Customize to support
-  ksh-like languages. Default value is \"\^\\\\s *#\".
-
-Style Guide.
- By setting
-    (setq ksh-indent default-tab-width)
-    (setq ksh-group-offset 0)
-
-    The following style is obtained:
-
-    if [ -z $foo ]
-	    then
-		    bar    # <-- ksh-group-offset is additive to ksh-indent
-		    foo
-    fi
-
- By setting
-    (setq ksh-indent default-tab-width)
-    (setq ksh-group-offset (- 0 ksh-indent))
-
-    The following style is obtained:
-
-    if [ -z $foo ]
-    then
-	    bar
-	    foo
-    fi
-
- By setting
-    (setq ksh-case-item-offset 1)
-    (setq ksh-case-indent nil)
-
-    The following style is obtained:
-
-    case x in *
-     foo) bar           # <-- ksh-case-item-offset
-          baz;;         # <-- ksh-case-indent aligns with \")\"
-     foobar) foo
-             bar;;
-    esac
-
- By setting
-    (setq ksh-case-item-offset 1)
-    (setq ksh-case-indent 6)
-
-    The following style is obtained:
-
-    case x in *
-     foo) bar           # <-- ksh-case-item-offset
-           baz;;        # <-- ksh-case-indent
-     foobar) foo
-           bar;;
-    esac
-    
-
-Installation:
-
- (setq ksh-mode-hook
-      (function (lambda ()
-         (font-lock-mode 1)             ;; font-lock the buffer
-         (setq ksh-indent 8)
-	 (setq ksh-group-offset -8)
-	 (setq ksh-brace-offset -8)   
-         (setq ksh-tab-always-indent t)
-         (setq ksh-match-and-tell t)
-         (setq ksh-align-to-keyword t)	;; Turn on keyword alignment
-	 )))"
-  ;;
-  ;; and away we go
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map ksh-mode-map)
-  (setq major-mode 'ksh-mode)
-  (setq mode-name "Ksh")
-  (setq local-abbrev-table ksh-mode-abbrev-table)
-  (set-syntax-table ksh-mode-syntax-table)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'ksh-indent-line)
-  (make-local-variable 'indent-region-function)
-  (setq indent-region-function 'ksh-indent-region)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+ *")
-  ;;
-  ;; Let the user customize
-  (run-hooks 'ksh-mode-hook)
-  (if (not ksh-align-to-keyword)
-      (ksh-align-to-keyword -1)
-    )
-  ) ;; defun
-
-;;
-;; Support functions
-
-(defun ksh-align-to-keyword (&optional arg)
-  "Toggle value of ksh-align-to-keyword and rebind the ksh-current-indentation
-function. With arg, force alignment to keyword if and only if arg is positive."
-  (interactive)
-  (if (null arg)			;just toggle
-      (cond ((not ksh-align-to-keyword)
-	     (setq ksh-align-to-keyword t)
-	     (fset 'ksh-current-indentation 'current-column))
-	    (t
-	     (setq ksh-align-to-keyword nil)
-	     (fset 'ksh-current-indentation 'current-indentation))
-	    )
-    (cond ((natnump arg)
-	   (setq ksh-align-to-keyword t)
-	   (fset 'ksh-current-indentation 'current-column))
-	  (t
-	   (setq ksh-align-to-keyword nil)
-	   (fset 'ksh-current-indentation 'current-indentation))
-	  ))
-  )
-
-(defun ksh-current-line ()
-  "Return the vertical position of point in the buffer.
-Top line is 1."
-  (+ (count-lines (point-min) (point))
-     (if (= (current-column) 0) 1 0))
-  )
-
-
-(defun ksh-line-to-string ()
-  "From point, construct a string from all characters on
-current line"
-  (skip-chars-forward " \t") ;; skip tabs as well as spaces
-  (buffer-substring (point)
-                    (progn
-                      (end-of-line 1)
-                      (point))))
-
-(defun ksh-get-nest-level ()
-  "Return a 2 element list (nest-level nest-line) describing where the
-current line should nest."
-  (let ((case-fold-search)
-	(level))
-    (save-excursion
-      (forward-line -1)
-      (while (and (not (bobp))
-		  (null level))
-	(if (and (not (looking-at "^\\s *$"))
- 		 (not (save-excursion
- 			(forward-line -1)
- 			(beginning-of-line)
-			(looking-at ksh-multiline-re)))
-		 (not (looking-at ksh-comment-regexp)))
-	    (setq level (cons (current-indentation)
-			      (ksh-current-line)))
-	  (forward-line -1)
-	  );; if
-	);; while
-      (if (null level)
-	  (cons (current-indentation) (ksh-current-line))
-	level)
-      )
-    )
-  )
-
-(defun ksh-looking-at-compound-list ()
-  "Return true if current line contains compound list initiating keyword"
-  (or 
-   (looking-at ksh-do-re)
-   (looking-at ksh-then-re)
-   ) ;; or
-  ) ;; defun
-
-(defun ksh-looking-at-case-item ()
-  "Return true if current line is a case-item .vs. paren compound list"
-  (save-excursion
-    (beginning-of-line)
-    ;;
-    ;; Handle paren indentation constructs for this line
-    (cond ((looking-at ksh-paren-re)
-	   (goto-line (cdr (ksh-get-nest-level)))
-	   ;;
-	   ;; The question is whether this is really a case item or just
-	   ;; parenthesized compound list.
-	   (cond ((or (looking-at ksh-case-re)
-		      (looking-at ksh-case-item-end-re)))
-		 ;;
-		 ;; turns out to be a parenthesized compound list
-		 ;; so propigate the nil for cond
-		 )
-	   ))
-    )
-  ) ;; defun
-
-
-(defun ksh-get-case-indent ()
-  "Return the column of the closest open case statement"
-  (save-excursion
-    (let (
-	  (nest-list (ksh-get-compound-level ksh-case-re ksh-esac-re (point)))
-	  )
-      (if (null nest-list)
-	  (progn 
-	    (if ksh-match-and-tell
-		(message "No matching case for ;;"))
-	    0)
-	(car nest-list)))
-    )
-  )
-
-(defun ksh-search-forward-sexp (sexp-re fence-post)
-  "Search for an sexp. Return t on success with point at the
-beginning of the sexp. Return nil on failure and restoring point
-to it's original position"
-  (let
-      ((old-pnt (point))
-       )
-    (while (and (< (point) fence-post)
-		(not (looking-at sexp-re)))
-      (ksh-forward-sexp))
-    
-    (if (>= (point) fence-post)
-	(progn (goto-char old-pnt)
-	       nil)
-      t)
-    ))
-
-(defun ksh-search-backward-sexp (sexp-re fence-post)
-  (let
-      ((old-pnt (point))
-       (sentinal nil)
-       )
-    (while
-	(progn
-	  (if (not sentinal)
-	      (backward-sexp 1))
-	  (and (> (point) fence-post)
-	       (not sentinal))
-	  )
-      (if (looking-at sexp-re)
-	  (save-excursion			;avoid comment foolage
-	    (let ((key-fence (point)))
-	      (beginning-of-line)
-	      (back-to-indentation)
-	      (while (and (ksh-search-forward-sexp sexp-re key-fence)
-			  (< (point) key-fence)))
-	      
-	      (if (= key-fence (point))
-		  (setq sentinal t))
-	      ))
-	))
-      
-      (if (< (point) fence-post)
-	  (progn (goto-char old-pnt)
-		 nil)
-	t)
-      ))
-
-
-;;
-;; Functions which make this mode what it is
-;;
-
-(defun ksh-get-nester-column (nest-line)
-  "Return the column to indent to with respect to nest-line taking 
-into consideration keywords and other nesting constructs."
-  (save-excursion 
-    (let ((fence-post)
-;	  (start-post)
-	  (nester-column)
- 	  (case-fold-search)
-	  (start-line (ksh-current-line)))
-      (cond
-       ;;
-       ;; Handle case item indentation constructs for this line
-       ((ksh-looking-at-case-item)
-	(save-excursion
-	  (goto-line nest-line)
-	  (back-to-indentation)
-	  (let ((fence-post (ksh-eol-point)))
-	    ;;
-	    ;; Now know there is a case-item so detect whether
-	    ;; it is first under case, just another case-item, or
-	    ;; a case-item and case-item-end all rolled together.
-	    ;;
-	    (cond ((ksh-search-forward-sexp ksh-case-re fence-post)
-		   (+ (ksh-current-indentation) ksh-case-item-offset))
-		  
-		  ((ksh-looking-at-case-item)
-		   (current-indentation))
-		  
-		  ((looking-at ksh-case-item-end-re)
-		   (end-of-line)
-		   (+ (ksh-get-case-indent) ksh-case-item-offset))
-		  )
-	    )))
-       (t;; Not a case-item.  What to do relative to the nest-line?
-	(save-excursion
-	  (goto-line nest-line)
-;	  (setq start-post (point))
-	  (setq fence-post (ksh-eol-point))
-	  (setq nester-column
-		(save-excursion
-		  (cond
-		   ;;
-		   ;; Check if we are in a continued statement
-		   ((and (looking-at ksh-multiline-re)
-			 (save-excursion
-			   (goto-line (1- start-line))
-			   (looking-at ksh-multiline-re)))
-		    (+ (current-indentation) ksh-multiline-offset))
-		   ;; In order to locate the column of the keyword,
-		   ;; which might be embedded within a case-item,
-		   ;; it is necessary to iterate over sexp.
-		   ((progn
-		      (save-excursion
-			(back-to-indentation)
-			(if (ksh-search-forward-sexp ksh-keywords-re fence-post)
-			    (progn
-			      ;;
-			      ;; special pun intended 'case'
-			      (if (looking-at ksh-case-re)
-				  (+ (ksh-current-indentation)
-				     ksh-case-item-offset)
-				(+ (ksh-current-indentation)
-				   (if (null ksh-indent)
-				       2 ksh-indent))))	
-			  nil))
-		      ))
-		   ;;
-		   ;;  handle then or do
-		   ((progn
-		      (save-excursion
-			(back-to-indentation)
-			(if (ksh-search-forward-sexp ksh-then-do-re fence-post)
-			    (progn
-			      (if (null ksh-indent)
-				  (+ (ksh-current-indentation) 1)
-				(+ (ksh-current-indentation) ksh-indent)))
-			  nil))))
-
-		   ((looking-at ksh-brace-re)
-		    (+ (current-indentation)
-		       (if (null ksh-indent)
-			   2 ksh-indent)
-		       ))
-		   ;;
-		   ;; Forces functions to first column
-		   ((or (looking-at ksh-implicit-func-re)
-			(looking-at ksh-explicit-func-re))
-		    (if (looking-at ksh-func-brace-re)
-			(if (null ksh-indent)
-			    2 ksh-indent)
-		      ksh-brace-offset))
-
-		   ;;
-		   ;; Need to first detect the end of a case-item
-		   ((looking-at ksh-case-item-end-re)
-		    (end-of-line)
-		    (+ (ksh-get-case-indent) ksh-case-item-offset))
-		   ;;
-		   ;; Now detect first statement under a case item
-		   ((ksh-looking-at-case-item)
-		    (if (null ksh-case-indent)
-			(progn
-			  (re-search-forward ksh-case-item-re fence-post t)
-			  (goto-char (match-end 1))
-			  (+ (current-column) 1))
-		      (+ (current-indentation) ksh-case-indent)))
-		   
-		   ;; This is hosed when using current-column
-		   ;; and there is a multi-command expression as the
-		   ;; nester.
-		   (t (current-indentation)))
-		  )
-		));; excursion over
-	;;
-	;; Handle additional indentation constructs for this line
-	(cond ((ksh-looking-at-compound-list)
-	       (+ nester-column ksh-group-offset))
-	      ((looking-at ksh-brace-re)
-	       (+ nester-column ksh-brace-offset))
-	      (t nester-column))
-	);; Not a case-item
-       )
-      );;let
-    );; excursion
-  ) ;; defun
-
-(defun ksh-indent-command ()
-  "Indent current line relative to containing block and allow for
-ksh-tab-always-indent customization"
-  (interactive)
-  (let (case-fold-search)
-    (cond ((save-excursion
-	     (skip-chars-backward " \t")
-	     (bolp))
-	   (ksh-indent-line))
-	  (ksh-tab-always-indent
-	   (save-excursion
-	     (ksh-indent-line)))
-	  (t (insert-tab))
-	  ))
-  )
-
-
-(defun ksh-indent-line ()
-  "Indent current line as far as it should go according
-to the syntax/context"
-  (interactive)
-  (let (case-fold-search)
-    (save-excursion
-      (beginning-of-line)
-      (if (bobp)
-	  nil
-	;;
-	;; Align this line to current nesting level
-	(let*
-	    (
-	     (level-list (ksh-get-nest-level)) ; Where to nest against
-	     ;;           (last-line-level (car level-list))
-	     (this-line-level (current-indentation))
-	     (nester-column (ksh-get-nester-column (cdr level-list)))
-	     (struct-match (ksh-match-structure-and-reindent))
-	     )
-	  (if struct-match
-	      (setq nester-column struct-match))
-	  (if (eq nester-column this-line-level)
-	      nil
-	    (beginning-of-line)
-	    (let ((beg (point)))
-	      (back-to-indentation)
-	      (delete-region beg (point)))
-	    (indent-to nester-column))
-	  );; let*
-	);; if
-      );; excursion
-    ;;
-    ;; Position point on this line
-    (let*
-	(
-	 (this-line-level (current-indentation))
-	 (this-bol (ksh-bol-point))
-	 (this-point (- (point) this-bol))
-	 )
-      (cond ((> this-line-level this-point);; point in initial white space
-	     (back-to-indentation))
-	    (t nil)
-	    );; cond
-      );; let*
-    );; let
-  );; defun
-
-
-(defun ksh-match-indent-level (begin-re end-re)
-  "Match the compound command and indent. Return nil on no match,
-indentation to use for this line otherwise."
-  (interactive)
-  (let* ((case-fold-search)
-	 (nest-list 
-	  (save-excursion
-	    (ksh-get-compound-level begin-re end-re (point))
-	    ))
-	 ) ;; bindings
-    (if (null nest-list)
-	(progn
-	  (if ksh-match-and-tell
-	      (message "No matching compound command"))
-	  nil) ;; Propagate a miss.
-      (let* (
-	     (nest-level (car nest-list))
-	     (match-line (cdr nest-list))
-	     ) ;; bindings
-	(if ksh-match-and-tell
-	    (save-excursion
-	      (goto-line match-line)
-	      (message "Matched ... %s" (ksh-line-to-string))
-	      ) ;; excursion
-	  ) ;; if ksh-match-and-tell
-	nest-level ;;Propagate a hit.
-	) ;; let*
-      ) ;; if
-    ) ;; let*
-  ) ;; defun ksh-match-indent-level
-
-(defun ksh-match-structure-and-reindent ()
-  "If the current line matches one of the indenting keywords
-or one of the control structure ending keywords then reindent. Also
-if ksh-match-and-tell is non-nil the matching structure will echo in
-the minibuffer"
-  (interactive)
-  (let (case-fold-search)
-    (save-excursion
-      (beginning-of-line)
-      (back-to-indentation)
-      (cond ((looking-at ksh-else-re)
-	     (ksh-match-indent-level ksh-if-re ksh-fi-re))
-	    ((looking-at ksh-elif-re)
-	     (ksh-match-indent-level ksh-if-re ksh-fi-re))
-	    ((looking-at ksh-fi-re)
-	     (ksh-match-indent-level ksh-if-re ksh-fi-re))
-	    ((looking-at ksh-done-re)
-	     (ksh-match-indent-level ksh-iteration-keywords-re ksh-done-re))
-	    ((looking-at ksh-esac-re)
-	     (ksh-match-indent-level ksh-case-re ksh-esac-re))
-	    ;;
-	    ((looking-at ksh-brace-end-re)
-	     (cond
-	      ((ksh-match-indent-level ksh-implicit-func-re ksh-brace-end-re))
-	      ((ksh-match-indent-level ksh-explicit-func-re ksh-brace-end-re))
-	      ((ksh-match-indent-level ksh-func-brace-re ksh-brace-end-re))
-	      (t nil)))
-	    (t nil)
-	    );; cond
-      )
-    ))
-
-
-(defun ksh-forward-sexp ()
-  "Special incantation to march over syntax expressions and
-avoid all sorts of nonsense"
-  (if (char-equal ?< (char-syntax (char-after (point))))
-      (end-of-line)
-    (if (char-equal ?. (char-syntax (char-after (point))))
-	(forward-char)
-      (forward-sexp 1))
-    )
-  (if (eolp)
-      (forward-line))
-  (skip-chars-forward ") \t")		;damn case
-  )
-
-
-(defun ksh-get-compound-level
-  (begin-re end-re anchor-point &optional balance-list)
-  "Determine how much to indent this structure. Return a list (level line) 
-of the matching compound command or nil if no match found."
-  (let* 
-      (;; Locate the next compound begin keyword bounded by point-min
-       (match-point
-	(if (and (ksh-search-backward-sexp begin-re (point-min))
-		 (>= (point) (point-min))
-		 )
-	    (point)
-	  0))
-
-       (nest-column (if (zerop match-point)
-			1 
-		      (progn
-			(goto-char match-point)
-			(ksh-current-indentation))))
-       (nest-list (cons 0 0))    ;; sentinel cons since cdr is >= 1
-       )
-    (if (zerop match-point)
-	nil ;; graceful exit from recursion
-      (progn
-	(if (nlistp balance-list)
-	    (setq balance-list (list)))
-	;; Now search forward from matching start keyword for end keyword
-	;; which will locate interceding compound commands
-	(while (and (consp nest-list) (zerop (cdr nest-list))
-		    (ksh-search-forward-sexp end-re anchor-point)
-		    (> anchor-point (point))
-		    )
-	  (if (not (memq (point) balance-list))
-	      (progn
-		(setq balance-list (cons (point) balance-list))
-		(goto-char match-point)  ;; beginning of compound cmd
-		(setq nest-list
-		      (ksh-get-compound-level begin-re end-re
-					      anchor-point balance-list))
-		)
-	    (ksh-forward-sexp)
-	    ))
-
-	(cond ((consp nest-list)
-	       (if (zerop (cdr nest-list))
-		 (progn
-		   (goto-char match-point)
-		   (cons nest-column (ksh-current-line)))
-		 nest-list))
-	      (t nil)
-	      )
-	)
-      )
-    )
-  )
-
-
-(defun ksh-indent-region (start end)
-  "From start to end, indent each line."
-  ;; The algorithm is just moving through the region line by line with
-  ;; the match noise turned off.  Only modifies nonempty lines.
-  (save-excursion
-    (let (ksh-match-and-tell
-	  (endmark (copy-marker end)))
-      
-      (goto-char start)
-      (beginning-of-line)
-      (setq start (point))
-      (while (> (marker-position endmark) start)
-	(if (not (and (bolp) (eolp)))
-	    (ksh-indent-line))
-	(forward-line 1)
-	(setq start (point)))
-
-      (set-marker endmark nil)
-      )
-    )
-  )
-
-;;
-;; Completion code supplied by Haavard Rue .
-;;
-;;
-;; add a completion with a given type to the list
-;;
-(defun ksh-addto-alist (completion type)
-  (setq ksh-completion-list
-	(append ksh-completion-list
-		(list (cons completion type)))))
-;;
-;; init the list and pickup all 
-;;
-(defun ksh-completion-init-and-pickup ()
-  (interactive)
-  (let (case-fold-search)
-    (ksh-completion-list-init)
-    (ksh-pickup-all)))
-
-;;
-;; init the list
-;;
-(defun ksh-completion-list-init ()
-  (interactive)
-  (setq ksh-completion-list
-	(list
-	 (cons "if"  ksh-completion-type-misc)
-	 (cons "while"  ksh-completion-type-misc)
-	 (cons "until"  ksh-completion-type-misc)
-	 (cons "select"  ksh-completion-type-misc)
-	 (cons "for"  ksh-completion-type-misc)
-	 (cons "continue"  ksh-completion-type-misc)
-	 (cons "function"  ksh-completion-type-misc)
-	 (cons "fi"  ksh-completion-type-misc)
-	 (cons "case"  ksh-completion-type-misc)
-	 (cons "esac"  ksh-completion-type-misc)
-	 (cons "break"  ksh-completion-type-misc)
-	 (cons "exit"  ksh-completion-type-misc)
-	 (cons "done"  ksh-completion-type-misc)
-	 (cons "do"  ksh-completion-type-misc))))
-
-(defun ksh-eol-point ()
-  (save-excursion
-    (end-of-line)
-    (point)))
-
-(defun ksh-bol-point ()
-  (save-excursion
-    (beginning-of-line)
-    (point)))
-
-(defun ksh-pickup-all ()
-  "Pickup all completions in buffer."
-  (interactive)
-  (ksh-pickup-completion-driver (point-min) (point-max) t))
-
-(defun ksh-pickup-this-line ()
-  "Pickup all completions in current line."
-  (interactive)
-  (ksh-pickup-completion-driver (ksh-bol-point) (ksh-eol-point) nil))
-
-(defun ksh-pickup-completion-driver (pmin pmax message)
-  "Driver routine for ksh-pickup-completion."
-  (if message
-      (message "pickup completion..."))
-  (let* (
-	 (i1
-	  (ksh-pickup-completion  ksh-completion-regexp-var
-				 ksh-completion-type-var
-				 ksh-completion-match-var
-				 pmin pmax))
-	 (i2
-	  (ksh-pickup-completion  ksh-completion-regexp-var2
-				 ksh-completion-type-var
-				 ksh-completion-match-var2
-				 pmin pmax))
-	 (i3
-	  (ksh-pickup-completion  ksh-completion-regexp-function
-				 ksh-completion-type-function
-				 ksh-completion-match-function
-				 pmin pmax)))
-    (if message
-	(message "pickup %d variables and %d functions." (+ i1 i2) i3))))
-
-(defun ksh-pickup-completion (regexp type match pmin pmax)
-  "Pickup completion in region and addit to the list, if not already
-there." 
-  (let ((i 0) kw obj)
-    (save-excursion
-      (goto-char pmin)
-      (while (and
-	      (re-search-forward regexp pmax t)
-	      (match-beginning match)
-	      (setq kw  (buffer-substring
-			 (match-beginning match)
-			 (match-end match))))
-	(progn
-	  (setq obj (assoc kw ksh-completion-list))
-	  (if (or (equal nil obj)
-		  (and (not (equal nil obj))
-		       (not (= type (cdr obj)))))
-	      (progn
-		(setq i (1+ i))
-		(ksh-addto-alist kw type))))))
-    i))
-
-(defun ksh-complete-symbol ()
-  "Perform completion."
-  (interactive)
-  (let* ((case-fold-search)
-	 (end (point))
-         (beg (unwind-protect
-                  (save-excursion
-                    (backward-sexp 1)
-                    (while (= (char-syntax (following-char)) ?\')
-                      (forward-char 1))
-                    (point))))
-         (pattern (buffer-substring beg end))
-	 (predicate 
-	  ;;
-	  ;; ` or $( mark a function
-	  ;;
-	  (save-excursion
-	    (goto-char beg)
-	    (if (or
-		 (save-excursion
-		   (backward-char 1)
-		   (looking-at "`"))
-		 (save-excursion
-		   (backward-char 2)
-		   (looking-at "\\$(")))
-		(function (lambda (sym)
-			    (equal (cdr sym) ksh-completion-type-function)))
-	      ;;
-	      ;; a $, ${ or ${# mark a variable
-	      ;;
-	      (if (or
-		   (save-excursion
-		     (backward-char 1)
-		     (looking-at "\\$"))
-		   (save-excursion
-		     (backward-char 2)
-		     (looking-at "\\${"))
-		   (save-excursion
-		     (backward-char 3)
-		     (looking-at "\\${#")))
-		  (function (lambda (sym)
-			      (equal (cdr sym)
-				     ksh-completion-type-var)))
-		;;
-		;; don't know. use 'em all
-		;;
-		(function (lambda (sym) t))))))
-	 ;;
-	 (completion (try-completion pattern ksh-completion-list predicate)))
-    ;;
-    (cond ((eq completion t))
-	  ;;
-	  ;; oops, what is this ?
-	  ;;
-          ((null completion)
-           (message "Can't find completion for \"%s\"" pattern))
-	  ;;
-	  ;; insert
-	  ;;
-          ((not (string= pattern completion))
-           (delete-region beg end)
-           (insert completion))
-	  ;;
-	  ;; write possible completion in the minibuffer,
-	  ;; use this instead of a separate buffer (usual)
-	  ;;
-          (t
-           (let ((list (all-completions pattern ksh-completion-list predicate))
-		 (string ""))
-	     (while list
-	       (progn
-		 (setq string (concat string (format "%s " (car list))))
-		 (setq list (cdr list))))
-	     (message string))))))
-
-(provide 'ksh-mode)
-;;; ksh-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/lua-mode.el b/xemacs-packages/lisp/prog-modes/lua-mode.el
deleted file mode 100644
index 69f941c3..00000000
--- a/xemacs-packages/lisp/prog-modes/lua-mode.el
+++ /dev/null
@@ -1,1115 +0,0 @@
-;;; lua-mode.el --- a major mode for editing Lua scripts
-
-;; FIXME: Update this version number and date
-;; $Id: lua-mode.el,v 1.26 2001/07/08 19:06:50 cvogler Exp $
-
-;; Copyright (C) 1997, 2001, 2004 Free Software Foundation, Inc.
-
-;; Author: 2004 various (support for Lua 5 and byte compilation)
-;;         2001 Christian Vogler 
-;;         1997 Bret Mogilefsky  starting from
-;;              tcl-mode by Gregor Schmid 
-;;              with tons of assistance from
-;;              Paul Du Bois  and
-;;              Aaron Smith .
-
-;; Keywords: languages, processes, tools
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with:
-;;;   http://lua-users.org/files/wiki_insecure/editors/lua-mode.el (20040814)
-
-;;; Commentary:
-
-;; Special Thanks to Simon Marshall  for
-;; font-lock patches.
-
-;; Additional font-lock highlighting and indentation tweaks by
-;; Adam D. Moss  
-
-;; This file was written with emacs using Jamie Lokier's folding mode
-;; That's what the funny ;;{{{ marks are there for
-
-;;{{{ Usage
-
-;; Lua-mode supports c-mode style formatting and sending of
-;; lines/regions/files to a lua interpreter. An interpreter (see
-;; variable `lua-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 lua mode, look at `lua-setup-keymap'
-;; or start `lua-mode' and type `\C-h m'.
-;; The keybindings may seem strange, since I prefer to use them with
-;; lua-prefix-key set to nil, but since those keybindings are already used
-;; the default for `lua-prefix-key' is `\C-c', which is the conventional
-;; prefix for major-mode commands.
-
-;; You can customise the keybindings either by setting `lua-prefix-key'
-;; or by putting the following in your .emacs
-;;      (setq lua-mode-map (make-sparse-keymap))
-;; and
-;;      (define-key lua-mode-map  )
-;; for all the functions you need.
-
-;;}}}
-;;{{{ Variables
-
-;; You may want to customize the following variables:
-;;
-;; lua-indent-level
-;; lua_always-show
-;;      lua-mode-map
-;;      lua-prefix-key
-;;      lua-mode-hook
-;; lua-default-application
-;; lua-default-command-switches
-
-;;}}}
-
-;;; Code:
-(defconst lua-using-xemacs (string-match "XEmacs" emacs-version)
-  "Nil unless using XEmacs).")
-
-;; We need that !
-(require 'comint)
-
-;;{{{ variables
-
-;; XEmacs addition
-(defgroup lua nil
-  "Major mode for editing Lua Code."
-  :group 'languages)
-
-;; XEmacs change: defvar -> defcustom and default to non-full path to "lua".
-(defcustom lua-default-application "lua"
-  "*Default application to run in lua subprocess."
-  :type 'string
-  :group 'lua)
-
-;; XEmacs change: defvar -> defcustom
-(defcustom lua-default-command-switches '()
-  "*Command switches for `lua-default-application'.
-Should be a list of strings."
-  :type '(repeat (string :tag "Switch"))
-  :group 'lua)
-
-(defvar lua-process nil
-  "The active lua subprocess corresponding to current buffer.")
-
-(defvar lua-process-buffer nil
-  "Buffer used for communication with lua subprocess for current buffer.")
-
-;; XEmacs change: defvar -> defcustom
-(defcustom lua-always-show t
-  "*Non-nil means display `lua-process-buffer' after sending a command."
-  :type 'boolean
-  :group 'lua)
-
-(defvar lua-mode-map nil
-  "Keymap used with `lua-mode'.")
-
-(defvar lua-prefix-key "\C-c"
-  "Prefix for all `lua-mode' commands.")
-
-;; XEmacs change: defvar -> defcustom
-(defcustom lua-mode-hook nil
-  "*Hooks called when lua mode fires up."
-  :type 'hook
-  :group 'lua)
-
-(defvar lua-region-start (make-marker)
-  "Start of special region for lua communication.")
-
-(defvar lua-region-end (make-marker)
-  "End of special region for lua communication.")
-
-;; XEmacs change: defvar -> defcustom
-(defcustom lua-indent-level 3
-  "*Amount by which lua subexpressions are indented."
-  :type 'integer
-  :group 'lua)
-
-(defvar lua-mode-menu (make-sparse-keymap "Lua")
-  "Keymap for `lua-mode's menu.")
-
-(defvar lua-xemacs-menu
-  '(["Restart With Whole File" lua-restart-with-whole-file t]
-    ["Kill Process" lua-kill-process t]
-    ["Hide Process Buffer" lua-hide-process-buffer t]
-    ["Show Process Buffer" lua-show-process-buffer t]
-    ["Beginning Of Proc" lua-beginning-of-proc t]
-    ["End Of Proc" lua-end-of-proc t]
-    ["Set Lua-Region Start" lua-set-lua-region-start t]
-    ["Set Lua-Region End" lua-set-lua-region-end t]
-    ["Send Lua-Region" lua-send-lua-region t]
-    ["Send Current Line" lua-send-current-line t]
-    ["Send Region" lua-send-region t]
-    ["Send Proc" lua-send-proc t]
-    ["Send Buffer" lua-send-buffer t])
-  "XEmacs menu for Lua mode.")
-
-;; XEmacs change: pre-generate regexps, don't eval-on-compile
-(defvar lua-font-lock-keywords
-  (list
-   ;;
-   ;; Function name declarations.
-   '("^[ \t]*\\<\\(\\(local[ \t]+\\)?function\\)\\>[ \t]+\\(\\(\\sw:\\|\\sw\\.\\|\\sw_\\|\\sw\\)+\\)"
-     (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
-
-   ;; Highlight multi-line comment blocks; since font-lock-mode doesn't
-   ;; claim to handle the highlighting of multi-line expressions elegantly
-   ;; this works best with lazy-lock-mode if your Emacs supports it, e.g.
-   ;; try (setq font-lock-support-mode 'lazy-lock-mode) in your ~/.emacs
-
-   ;; Multi-line comment blocks.
-   `("--.*\\(\\[\\[\\(\\]?[^]]\\)*\\]\\]\\)"
-     (1 font-lock-comment-face t))
-
-   ;;
-   ;; Keywords.
-   ;; (concat "\\<"
-   ;;         (regexp-opt '("and" "break" "do" "else" "elseif" "end" "false"
-   ;;                       "for" "function" "if" "in" "local" "nil" "not"
-   ;;                       "or" "repeat" "return" "then" "true" "until"
-   ;;                       "while") t)
-   ;;         "\\>")
-
-   "\\<\\(and\\|break\\|do\\|e\\(lse\\(if\\)?\\|nd\\)\\|f\\(alse\\|or\\|unction\\)\\|i[fn]\\|local\\|n\\(il\\|ot\\)\\|or\\|re\\(peat\\|turn\\)\\|t\\(hen\\|rue\\)\\|until\\|while\\)\\>"
-
-   "Default expressions to highlight in Lua mode."))
-
-(defvar lua-imenu-generic-expression
-;  '((nil "^[ \t]*function[ \t]+\\(\\(\\s_\\|\\sw\\)+\\)" 1)) ; Original
-  '((nil "^[ \t]*function[ \t]+\\(\\(\\sw:\\|\\sw_\\|\\sw\\.\\|\\sw\\)+\\)" 1)) ; Original
-  "Imenu generic expression for `lua-mode'.  See `imenu-generic-expression'.")
-
-(defvar lua-mode-abbrev-table nil
-  "Abbreviation table used in `lua-mode' buffers.")
-
-(define-abbrev-table 'lua-mode-abbrev-table
-  '(
-        ("end" "end" lua-indent-line 0)
-        ("else" "else" lua-indent-line 0)
-        ("elseif" "elseif" lua-indent-line 0)
-        ))
-
-(defconst lua-indent-whitespace " \t"
-  "Character set that constitutes whitespace for indentation in lua.")
-
-;;}}}
-;;{{{ lua-mode
-
-;;;###autoload
-(defun lua-mode ()
-  "Major mode for editing lua scripts.
-The following keys are bound:
-\\{lua-mode-map}
-"
-  (interactive)
-  (let ((switches nil)
-                  s)
-    (kill-all-local-variables)
-    (setq major-mode 'lua-mode)
-    (setq mode-name "Lua")
-    (set (make-local-variable 'lua-process) nil)
-    (set (make-local-variable 'lua-process-buffer) nil)
-    (make-local-variable 'lua-default-command-switches)
-    (set (make-local-variable 'indent-line-function) 'lua-indent-line)
-    (set (make-local-variable 'comment-start) "--")
-    (set (make-local-variable 'comment-start-skip) "--")
-    (set (make-local-variable 'font-lock-defaults)
-                        '(lua-font-lock-keywords nil nil ((?_ . "w"))))
-    (set (make-local-variable 'imenu-generic-expression)
-                        lua-imenu-generic-expression)
-         (setq local-abbrev-table lua-mode-abbrev-table)
-         (abbrev-mode 1)
-    (make-local-variable 'lua-default-eval)
-    (or lua-mode-map
-                  (lua-setup-keymap))
-    (use-local-map lua-mode-map)
-    (set-syntax-table (copy-syntax-table))
-    (modify-syntax-entry ?+ ".")
-    (modify-syntax-entry ?- ". 12")
-    (modify-syntax-entry ?* ".")
-    (modify-syntax-entry ?/ ".")
-    (modify-syntax-entry ?^ ".")
-    (modify-syntax-entry ?. ".")
-    (modify-syntax-entry ?> ".")
-    (modify-syntax-entry ?< ".")
-    (modify-syntax-entry ?= ".")
-    (modify-syntax-entry ?~ ".")
-    (modify-syntax-entry ?\n ">")
-    (modify-syntax-entry ?\' "\"")
-    (modify-syntax-entry ?\" "\"")
-    ;; _ needs to be part of a word, or the regular expressions will
-    ;; incorrectly regognize end_ to be matched by "\\"!
-    (modify-syntax-entry ?_ "w")
-    (if (and lua-using-xemacs
-	     (featurep 'menubar)
-	     current-menubar
-	     (not (assoc "Lua" current-menubar)))
-	(progn
-	  (set-buffer-menubar (copy-sequence current-menubar))
-	  (add-menu nil "Lua" lua-xemacs-menu)))
-    ;; Append Lua menu to popup menu for XEmacs.
-    (if (and lua-using-xemacs (boundp 'mode-popup-menu))
-	(setq mode-popup-menu
-	      (cons (concat mode-name " Mode Commands") lua-xemacs-menu)))
-    (run-hooks 'lua-mode-hook)))
-
-;; XEmacs change: make this autoload-only
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.lua$" . lua-mode))
-
-;;}}}
-;;{{{ lua-setup-keymap
-
-(defun lua-setup-keymap ()
-  "Set up keymap for lua mode.
-If the variable `lua-prefix-key' is nil, the bindings go directly
-to `lua-mode-map', otherwise they are prefixed with `lua-prefix-key'."
-  (setq lua-mode-map (make-sparse-keymap))
-  (define-key lua-mode-map [menu-bar lua-mode]
-    (cons "Lua" lua-mode-menu))
-  (define-key lua-mode-map "}" 'lua-electric-match)
-  (define-key lua-mode-map "]" 'lua-electric-match)
-  (define-key lua-mode-map ")" 'lua-electric-match)
-  (let ((map (if lua-prefix-key
-                                          (make-sparse-keymap)
-                                        lua-mode-map)))
-
-         ;; communication
-         (define-key map "\M-[" 'lua-beginning-of-proc)
-         (define-key map "\M-]" 'lua-end-of-proc)
-         (define-key map "\C-c" 'comment-region)
-         (if lua-prefix-key
-                  (define-key lua-mode-map lua-prefix-key map))
-         ))
-
-;;}}}
-;;{{{ indentation
-
-;;{{{ lua-electric-match
-
-(defun lua-electric-match (arg)
-  "Insert character and adjust indentation."
-  (interactive "P")
-  (insert-char last-command-char (prefix-numeric-value arg))
-  (lua-indent-line)
-  (blink-matching-open))
-
-;;}}}
-
-(defun lua-syntax-status ()
-  "Return the syntactic status of the character after the point."
-  (parse-partial-sexp (save-excursion (beginning-of-line) (point))
-		      (point)))
-
-(defun lua-string-p ()
-  "Return true if the point is in a string."
-  (elt (lua-syntax-status) 3))
-
-(defun lua-comment-p ()
-  "Return true if the point is in a comment."
-    (elt (lua-syntax-status) 4))
-
-(defun lua-comment-or-string-p ()
-  "Return true if the point is in a comment or string."
-  (let ((parse-result (lua-syntax-status)))
-    (or (elt parse-result 3) (elt parse-result 4))))
-
-
-;;{{{ lua-indent-line
-
-(defun lua-indent-line ()
-  "Indent current line as lua code.
-Return the amount the indentation changed by."
-  (let ((indent (max 0 (- (lua-calculate-indentation nil)
-			  (lua-calculate-indentation-left-shift))))
-	beg shift-amt
-	(case-fold-search nil)
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (skip-chars-forward lua-indent-whitespace)
-    (setq shift-amt (- indent (current-column)))
-    (when (not (zerop shift-amt))
-      (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
-    indent))
-
-;;}}}
-
-
-
-(defun lua-find-regexp (direction regexp &optional limit ignore-p)
-  "Search for a regular expression in the direction specified.
-DIRECTION is one of 'forward and 'backward.
-By default, matches in comments and strings are ignored, but what to ignore is
-configurable by specifying IGNORE-P.  If the REGEXP is found, return point
-position, nil otherwise.
-IGNORE-P returns true if the match at the current point position should be
-ignored, nil otherwise."
-  (let ((ignore-func (or ignore-p 'lua-comment-or-string-p))
-	(search-func (if (eq direction 'forward)
-			 're-search-forward 're-search-backward))
-	(case-fold-search nil))
-    (catch 'found
-      (while (funcall search-func regexp limit t)
-	(if (not (funcall ignore-func))
-	    (throw 'found (point)))))))
-
-
-;;{{{ lua-backwards-to-block-begin-or-end
-
-;; XEmacs change: pre-generate regexps, don't eval-on-compile
-(defconst lua-block-regexp
-  (concat
-   "\\(\\<"
-   ;;(regexp-opt '("do" "function" "repeat" "then"
-   ;;		   "else" "elseif" "end" "until") t)
-   "\\(do\\|e\\(?:lse\\(?:if\\)?\\|nd\\)\\|function\\|repeat\\|then\\|until\\)"
-   "\\>\\)\\|"
-   "\\([]()[{}]\\)"
-   ))
-
-(defun lua-backwards-to-block-begin-or-end ()
-  "Move backwards to nearest block begin or end.
-Return nil if not successful."
-  (interactive)
-  (lua-find-regexp 'backward lua-block-regexp))
-
-;;}}}
-
-(defconst lua-block-token-alist
-  ;; The absence of "else" is deliberate. This construct in a way both
-  ;; opens and closes a block. As a result, it is difficult to handle
-  ;; cleanly. It is also ambiguous - if we are looking for the match
-  ;; of "else", should we look backward for "then/elseif" or forward
-  ;; for "end"?
-  ;; Maybe later we will find a way to handle it.
-  '(("do"       "\\"                                   open)
-    ("function" "\\"                                   open)
-    ("repeat"   "\\"                                 open)
-    ("then"     "\\<\\(e\\(lseif\\|nd\\)\\)\\>"               open)
-    ("{"        "}"                                           open)
-    ("["        "]"                                           open)
-    ("("        ")"                                           open)
-    ("elseif"   "\\"                                  close)
-    ("end"      "\\<\\(do\\|function\\|then\\)\\>"            close)
-    ("until"    "\\"                                close)
-    ("}"        "{"                                           close)
-    ("]"        "\\["                                         close)
-    (")"        "("                                           close)))
-
-;; XEmacs change: pre-generate regexps, don't eval-on-compile
-(defconst lua-indentation-modifier-regexp
-  ;; The absence of else is deliberate, since it does not modify the
-  ;; indentation level per se. It only may cause the line, in which the
-  ;; else is, to be shifted to the left.
-  (concat
-   "\\(\\<"
-   ;; n.b. "local function" is a bit of a hack, allowing only a single space
-   ;;(regexp-opt '("do" "local function" "function" "repeat" "then") t)
-   "\\(do\\|function\\|local function\\|repeat\\|then\\)"
-   "\\>\\|"
-   ;;(regexp-opt '("{" "(" "["))
-   "[([{]"
-   "\\)\\|\\(\\<"
-   ;;(regexp-opt '("elseif" "end" "until") t)
-   "\\(e\\(?:lseif\\|nd\\)\\|until\\)"
-   "\\>\\|"
-   ;;(regexp-opt '("]" ")" "}"))
-   "[])}]"
-   "\\)"))
-
-
-(defun lua-find-matching-token-word (token search-start)
-  (let* ((token-info (assoc token lua-block-token-alist))
-	 (match (car (cdr token-info)))
-	 (match-type (car (cdr (cdr token-info))))
-	 (search-direction (if (eq match-type 'open) 'forward 'backward)))
-    ;; if we are searching forward from the token at the current point
-    ;; (i.e. for a closing token), need to step one character forward
-    ;; first, or the regexp will match the opening token.
-    (if (eq match-type 'open) (forward-char 1))
-    (if search-start (goto-char search-start))
-    (catch 'found
-      (while (lua-find-regexp search-direction lua-indentation-modifier-regexp)
-	;; have we found a valid matching token?
-	(let ((found-token (match-string 0))
-	      (found-pos (match-beginning 0)))
-	  (if (string-match match found-token)
-	      (throw 'found found-pos))
-	    ;; no - then there is a nested block. If we were looking for
-	    ;; a block begin token, found-token must be a block end
-	    ;; token; likewise, if we were looking for a block end token,
-	    ;; found-token must be a block begin token, otherwise there
-	    ;; is a grammatical error in the code.
-	    (if (not (and
-		      (eq (car (cdr (cdr (assoc found-token lua-block-token-alist))))
-			  match-type)
-		      (lua-find-matching-token-word found-token nil)))
-	      (throw 'found nil)))))))
-
-
-(defun lua-goto-matching-block-token (&optional search-start parse-start)
-  "Find block begion/end token matching the one at the point.
-This function moves the point to the token that matches the one
-at the current point.  Return the point position of the first character of
-the matching token if successful, nil otherwise."
-  (if parse-start (goto-char parse-start))
-  (let ((case-fold-search nil))
-    (if (looking-at lua-indentation-modifier-regexp)
-	(let ((position (lua-find-matching-token-word (match-string 0)
-						      search-start)))
-	  (and position
-	       (goto-char position))))))
-
-;; The following may be useful to speed up the search in the future.
-;      (let ((token-type (char-syntax (string-to-char token-to-match)))
-;	    matching-pos)
-;	(cond ((eq token-type ?\()
-;	       (setq matching-pos (scan-sexps (point) 1 (current-buffer) t))
-;	       (when matching-pos (goto-char matching-pos)))
-
-;	      ((eq token-type ?\))
-;	       ;; need to move one char forward, because scan-sexps
-;	       ;; expects the point to be one past the closing parenthesis
-;	       (forward-char 1)
-;	       (setq matching-pos (scan-sexps (point) -1 (current-buffer) t))
-;	       (when matching-pos (goto-char matching-pos)))
-
-;	      (t
-;	       (lua-goto-matching-token-word token-to-match search-start)))))))
-
-
-
-(defun lua-goto-matching-block (&optional noreport)
-  "Go to the keyword balancing the one under the point.
-If the point is on a keyword/brace that starts a block, go to the
-matching keyword that ends the block, and vice versa."
-  (interactive)
-  ;; search backward to the beginning of the keyword if necessary
-  (if (eq (char-syntax (following-char)) ?w)
-      (re-search-backward "\\<" nil t))
-  (let ((position (lua-goto-matching-block-token)))
-    (if (and (not position)
-	     (not noreport))
-	(error "Not on a block control keyword or brace")
-      position)))
-
-
-(defun lua-goto-nonblank-previous-line ()
-  "Put the point at the first previous line that is not blank.
-Return the point, or nil if it reached the beginning of the buffer."
-  (catch 'found
-    (beginning-of-line)
-    (while t
-      (if (bobp) (throw 'found nil))
-      (forward-char -1)
-      (beginning-of-line)
-      (if (not (looking-at "\\s *\\(--.*\\)?$")) (throw 'found (point))))))
-
-;; XEmacs change: pre-generate regexps, don't eval-on-compile
-(defconst lua-operator-class "-+*/^.=<>~")
-
-;; XEmacs change: pre-generate regexps, don't eval-on-compile
-(defconst lua-cont-eol-regexp
-  (concat
-   "\\(\\<"
-   ;;(regexp-opt '("and" "or" "not" "in" "for" "while" "local" "function") t)
-   "\\(and\\|f\\(?:or\\|unction\\)\\|in\\|local\\|not\\|or\\|while\\)"
-   "\\>\\|"
-   "\\(^\\|[^" lua-operator-class "]\\)"
-   ;;(regexp-opt '("+" "-" "*" "/" "^" ".." "==" "=" "<" ">" "<=" ">=" "~=") t)
-   "\\(\\.\\.\\|<=\\|==\\|>=\\|~=\\|[*+/<=>^-]\\)"
-   "\\)"
-   "\\s *\\="))
-
-;; XEmacs change: pre-generate regexps, don't eval-on-compile
-(defconst lua-cont-bol-regexp
-  (concat
-   "\\=\\s *"
-   "\\(\\<"
-   "\\(and\\|not\\|or\\)"
-   "\\>\\|"
-   ;;(regexp-opt '("+" "-" "*" "/" "^" ".." "==" "=" "<" ">" "<=" ">=" "~=") t)
-   "\\(\\.\\.\\|<=\\|==\\|>=\\|~=\\|[*+/<=>^-]\\)"
-   "\\($\\|[^" lua-operator-class "]\\)"
-   "\\)"))
-
-
-(defun lua-last-token-continues-p ()
-  "Return true if the last token on this line is a continuation token."
-  (let (line-begin
-	line-end)
-    (save-excursion
-      (beginning-of-line)
-      (setq line-begin (point))
-      (end-of-line)
-      (setq line-end (point))
-      ;; we need to check whether the line ends in a comment and
-      ;; skip that one.
-      (while (lua-find-regexp 'backward "-" line-begin 'lua-string-p)
-	(if (looking-at "--")
-	    (setq line-end (point))))
-      (goto-char line-end)
-      (re-search-backward lua-cont-eol-regexp line-begin t))))
-
-(defun lua-first-token-continues-p ()
-  "Return true if the first token on this line is a continuation token."
-  (let (line-end)
-    (save-excursion
-      (end-of-line)
-      (setq line-end (point))
-      (beginning-of-line)
-      (re-search-forward lua-cont-bol-regexp line-end t))))
-
-
-(defun lua-is-continuing-statement-p (&optional parse-start)
-  "Return non-nil if the line continues a statement.
-More specifically, return the point in the line that is continued.
-The criteria for a continuing statement are:
-
-* the last token of the previous line is a continuing op,
-  OR the first token of the current line is a continuing op
-
-AND
-
-* the indentation modifier of the preceding line is nonpositive.
-
-The latter is sort of a hack, but it is easier to use this criterion, instead
-of reducing the indentation when a continued statement also starts a new
-block. This is for aesthetic reasons: the indentation should be
-
-dosomething(d +
-   e + f + g)
-
-not
-
-dosomething(d +
-      e + f + g)"
-  (let ((prev-line nil))
-    (save-excursion
-      (if parse-start (goto-char parse-start))
-      (save-excursion (setq prev-line (lua-goto-nonblank-previous-line)))
-      (and prev-line
-	   (or (lua-first-token-continues-p)
-	       (and (goto-char prev-line)
-		    ;; check last token of previous nonblank line
-		    (lua-last-token-continues-p)))
-	   (<= (lua-calculate-indentation-block-modifier prev-line) 0)))))
-
-
-(defun lua-make-indentation-info-pair ()
-  "This is a helper function to `lua-calculate-indentation-info'.
-Don't use standalone."
-  (cond ((string-equal found-token "function")
-	 ;; this is the location where we need to start searching for the
-	 ;; matching opening token, when we encounter the next closing token.
-	 ;; It is primarily an optimization to save some searchingt ime.
-	 (cons 'absolute (+ (save-excursion (goto-char found-pos)
-					    (current-column))
-			    lua-indent-level)))
-	((string-equal found-token "(")
-	 ;; this is the location where we need to start searching for the
-	 ;; matching opening token, when we encounter the next closing token.
-	 ;; It is primarily an optimization to save some searchingt ime.
-	 (cons 'absolute (+ (save-excursion (goto-char found-pos)
-					    (current-column))
-			    1)))
-	((string-equal found-token "end")
-	 (save-excursion
-	   (lua-goto-matching-block-token nil found-pos)
-	   (if (looking-at "\\")
-	       (cons 'absolute
-		     (+ (current-indentation)
-			(lua-calculate-indentation-block-modifier
-			 nil (point))))
-	     (cons 'relative (- lua-indent-level)))))
-	((string-equal found-token ")")
-	 (save-excursion
-	   (lua-goto-matching-block-token nil found-pos)
-	   (cons 'absolute
-		 (+ (current-indentation)
-		    (lua-calculate-indentation-block-modifier
-		     nil (point))))))
-	(t
-	 (cons 'relative (if (nth 2 (match-data))
-			     ;; beginning of a block matched
-			     lua-indent-level
-			   ;; end of a block matched
-			   (- lua-indent-level))))))
-
-
-(defun lua-calculate-indentation-info (&optional parse-start parse-end)
-  "For each block token on the line, computes how it affects the indentation.
-The effect of each token can be either a shift relative to the current
-indentation level, or indentation to some absolute column.  This information
-is collected in a list of indentation info pairs, which denote absolute
-and relative each, and the shift/column to indent to."
-  (let* ((line-end (save-excursion (end-of-line) (point)))
-	 (search-stop (if parse-end (min parse-end line-end) line-end))
-	 (indentation-info nil))
-    (if parse-start (goto-char parse-start))
-    (save-excursion
-      (beginning-of-line)
-      (while (lua-find-regexp 'forward lua-indentation-modifier-regexp
-			      search-stop)
-	(let ((found-token (match-string 0))
-	      (found-pos (match-beginning 0))
-	      (found-end (match-end 0))
-	      (data (match-data)))
-	  (setq indentation-info
-		(cons (lua-make-indentation-info-pair) indentation-info)))))
-    indentation-info))
-
-
-(defun lua-accumulate-indentation-info (info)
-  "Accumulate the indentation information previously calculated by
-`lua-calculate-indentation-info'.  Return either the relative indentation
-shift, or the absolute column to indent to."
-  (let ((info-list (reverse info))
-	(type 'relative)
-	(accu 0))
-    (mapcar (lambda (x)
-	    (setq accu (if (eq 'absolute (car x))
-			   (progn (setq type 'absolute)
-				  (cdr x))
-			 (+ accu (cdr x)))))
-	  info-list)
-    (cons type accu)))
-
-(defun lua-calculate-indentation-block-modifier (&optional parse-start
-							   parse-end)
-  "Return amount by which this line modifies the indentation.
-Beginnings of blocks add lua-indent-level once each, and endings
-of blocks subtract `lua-indent-level' once each.  This function is used
-to determine how the indentation of the following line relates to this
-one."
-  (if parse-start (goto-char parse-start))
-  (let ((case-fold-search nil)
-	(indentation-info (lua-accumulate-indentation-info
-			   (lua-calculate-indentation-info nil parse-end))))
-    (if (eq (car indentation-info) 'absolute)
-	(- (cdr indentation-info) (current-indentation))
-      (+ (lua-calculate-indentation-left-shift)
-	 (cdr indentation-info)
-	 (if (lua-is-continuing-statement-p) (- lua-indent-level) 0)))))
-
-;; XEmacs change: pre-generate regexps, don't eval-on-compile
-(defconst lua-left-shift-regexp-1
-  (concat "\\("
-	  "\\(\\<"
-	  ;;(regexp-opt '("else" "elseif" "until") t)
-	  "\\(else\\(?:if\\)?\\|until\\)"
-	  "\\>\\)\\($\\|\\s +\\)"
-	  "\\)"))
-
-;; XEmacs change: pre-generate regexps, don't eval-on-compile
-(defconst lua-left-shift-regexp-2
-  (concat "\\(\\<"
-	  "\\(end\\)"
-	  "\\>\\)"))
-
-;; XEmacs change: pre-generate regexps, don't eval-on-compile
-(defconst lua-left-shift-regexp
-  ;; ("else", "elseif", "until" followed by whitespace, or "end"/closing
-  ;; brackets followed by
-  ;; whitespace, punctuation, or closing parentheses)
-  (concat lua-left-shift-regexp-1
-	  "\\|\\(\\("
-	  lua-left-shift-regexp-2
-	  "\\|\\("
-	  ;;(regexp-opt '("]" "}" ")"))
-	  "[])}]"
-	  "\\)\\)\\($\\|\\(\\s \\|\\s.\\)*\\)"
-	  "\\)"))
-
-(defconst lua-left-shift-pos-1
-  2)
-
-;; XEmacs change: don't eval-on-compile
-(defconst lua-left-shift-pos-2
-  (+ 3 (regexp-opt-depth lua-left-shift-regexp-1)))
-
-;; XEmacs change: don't eval-on-compile
-(defconst lua-left-shift-pos-3
-  (+ lua-left-shift-pos-2 (regexp-opt-depth lua-left-shift-regexp-2)))
-
-
-(defun lua-calculate-indentation-left-shift (&optional parse-start)
-  "Return amount, by which this line should be shifted left.
-Look for an uninterrupted sequence of block-closing tokens that starts
-at the beginning of the line.  For each of these tokens, shift indentation
-to the left by the amount specified in `lua-indent-level'."
-  (let (line-begin
-	(indentation-modifier 0)
-	(case-fold-search nil)
-	(block-token nil))
-    (save-excursion
-      (if parse-start (goto-char parse-start))
-      (beginning-of-line)
-      (setq line-begin (point))
-      ;; Look for the block-closing token sequence
-      (skip-chars-forward lua-indent-whitespace)
-      (catch 'stop
-	(while (and (looking-at lua-left-shift-regexp)
-		    (not (lua-comment-or-string-p)))
-	  (let ((last-token (or (match-string lua-left-shift-pos-1)
-				(match-string lua-left-shift-pos-2)
-				(match-string lua-left-shift-pos-3))))
-	    (if (not block-token) (setq block-token last-token))
-	    (if (not (string-equal block-token last-token)) (throw 'stop nil))
-	    (setq indentation-modifier (+ indentation-modifier
-					  lua-indent-level))
-		(forward-char (length (match-string 0))))))
-      indentation-modifier)))
-
-
-;;{{{ lua-calculate-indentation
-
-(defun lua-calculate-indentation (&optional parse-start)
-  "Return appropriate indentation for current line as Lua code.
-In usual case return an integer: the column to indent to."
-  (let ((pos (point))
-	shift-amt)
-    (save-excursion
-      (if parse-start (setq pos (goto-char parse-start)))
-      (beginning-of-line)
-      (setq shift-amt (if (lua-is-continuing-statement-p) lua-indent-level 0))
-      (if (bobp)          ; If we're at the beginning of the buffer, no change.
-	  (+ (current-indentation) shift-amt)
-	;; This code here searches backwards for a "block beginning/end"
-	;; It snarfs the indentation of that, plus whatever amount the
-	;; line was shifted left by, because of block end tokens. It
-	;; then adds the indentation modifier of that line to obtain the
-	;; final level of indentation.
-	;; Finally, if this line continues a statement from the
-	;; previous line, add another level of indentation.
-	(if (lua-backwards-to-block-begin-or-end)
-	    ;; now we're at the line with block beginning or end.
-	    (max (+ (current-indentation)
-		    (lua-calculate-indentation-block-modifier)
-		    shift-amt)
-		 0)
-	  ;; Failed to find a block begin/end.
-	  ;; Just use the previous line's indent.
-	  (goto-char pos)
-	  (beginning-of-line)
-	  (forward-line -1)
-	  (+ (current-indentation) shift-amt))))))
-
-;;}}}
-
-;;}}}
-;;{{{ searching
-
-;;{{{ lua-beginning-of-proc
-
-(defun lua-beginning-of-proc (&optional arg)
-  "Move backward to the beginning of a lua proc (or similar).
-With argument, do it that many times.  Negative arg -N
-means move forward to Nth following beginning of proc.
-Return 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 "^function[ \t]"))
-                  (forward-char 1))
-    (while (< arg 0)
-      (if (re-search-forward "^function[ \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 "^function[ \t]" nil t)
-                         (setq arg (1- arg))
-                  (setq ret nil
-                                  arg 0)))
-    ret))
-
-;;}}}
-;;{{{ lua-end-of-proc
-
-(defun lua-end-of-proc (&optional arg)
-  "Move forward to next end of lua 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 `end' 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 "^end" nil t)
-	  (setq arg (1- arg)
-		found t)
-	(setq ret nil
-	      arg 0)))
-    (while (< arg 0)
-      (if (re-search-backward "^end" 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
-
-;;{{{ lua-start-process
-
-(defun lua-start-process (name program &optional startfile &rest switches)
-  "Start a lua process named NAME, running PROGRAM."
-  (or switches
-      (setq switches lua-default-command-switches))
-  (setq lua-process-buffer (apply 'make-comint name program startfile switches))
-  (setq lua-process (get-buffer-process lua-process-buffer))
-  (save-excursion
-    (set-buffer lua-process-buffer))
-  )
-
-;;}}}
-;;{{{ lua-kill-process
-
-(defun lua-kill-process ()
-  "Kill lua subprocess and its buffer."
-  (interactive)
-  (if lua-process-buffer
-      (kill-buffer lua-process-buffer)))
-
-;;}}}
-;;{{{ lua-set-lua-region-start
-
-(defun lua-set-lua-region-start (&optional arg)
-  "Set start of region for use with `lua-send-lua-region'."
-  (interactive)
-  (set-marker lua-region-start (or arg (point))))
-
-;;}}}
-;;{{{ lua-set-lua-region-end
-
-(defun lua-set-lua-region-end (&optional arg)
-  "Set end of region for use with `lua-send-lua-region'."
-  (interactive)
-  (set-marker lua-region-end (or arg (point))))
-
-;;}}}
-;;{{{ send line/region/buffer to lua-process
-
-;;{{{ lua-send-current-line
-
-(defun lua-send-current-line ()
-  "Send current line to lua subprocess, found in `lua-process'.
-If `lua-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 lua-process
-             (eq (process-status lua-process) 'run))
-        (lua-start-process lua-default-application lua-default-application))
-    (comint-simple-send lua-process
-                      (concat lua-default-command-switches
-                                                  (buffer-substring start end) "
-\n"))
-    (forward-line 1)
-    (if lua-always-show
-        (display-buffer lua-process-buffer))))
-
-;;}}}
-;;{{{ lua-send-region
-
-(defun lua-send-region (start end)
-  "Send region to lua subprocess."
-  (interactive "r")
-  (or (and lua-process
-           (comint-check-proc lua-process-buffer))
-      (lua-start-process lua-default-application lua-default-application))
-  (comint-simple-send lua-process
-                              (buffer-substring start end))
-  (if lua-always-show
-      (display-buffer lua-process-buffer)))
-
-;;}}}
-;;{{{ lua-send-lua-region
-
-(defun lua-send-lua-region ()
-  "Send preset lua region to lua subprocess."
-  (interactive)
-  (or (and lua-region-start lua-region-end)
-      (error "lua-region not set"))
-  (or (and lua-process
-           (comint-check-proc lua-process-buffer))
-      (lua-start-process lua-default-application lua-default-application))
-  (comint-simple-send lua-process
-                              (buffer-substring lua-region-start lua-region-end)
-)
-  (if lua-always-show
-      (display-buffer lua-process-buffer)))
-
-;;}}}
-;;{{{ lua-send-proc
-
-(defun lua-send-proc ()
-  "Send proc around point to lua subprocess."
-  (interactive)
-  (let (beg end)
-    (save-excursion
-      (lua-beginning-of-proc)
-      (setq beg (point))
-      (lua-end-of-proc)
-      (setq end (point)))
-    (or (and lua-process
-             (comint-check-proc lua-process-buffer))
-        (lua-start-process lua-default-application lua-default-application))
-    (comint-simple-send lua-process
-                                (buffer-substring beg end))
-    (if lua-always-show
-        (display-buffer lua-process-buffer))))
-
-;;}}}
-;;{{{ lua-send-buffer
-
-; This needs work... -Bret
-(defun lua-send-buffer ()
-  "Send whole buffer to lua subprocess."
-  (interactive)
-  (or (and lua-process
-           (comint-check-proc lua-process-buffer))
-      (lua-start-process lua-default-application lua-default-application))
-  (if (buffer-modified-p)
-      (comint-simple-send lua-process
-                           (buffer-substring (point-min) (point-max)))
-    (comint-simple-send lua-process
-                        (concat "dofile(\""
-                                (buffer-file-name) "\")\n")))
-  (if lua-always-show
-      (display-buffer lua-process-buffer)))
-
-;;}}}
-
-;;}}}
-
-;;{{{ lua-restart-with-whole-file
-
-(defun lua-restart-with-whole-file ()
-  "Restart lua subprocess and send whole file as input."
-  (interactive)
-  (lua-kill-process)
-  (lua-start-process lua-default-application lua-default-application)
-  (lua-send-buffer))
-
-;;}}}
-;;{{{ lua-show-process-buffer
-
-(defun lua-show-process-buffer ()
-  "Make sure `lua-process-buffer' is being displayed."
-  (interactive)
-  (display-buffer lua-process-buffer))
-
-;;}}}
-;;{{{ lua-hide-process-buffer
-
-(defun lua-hide-process-buffer ()
-  "Delete all windows that display `lua-process-buffer'."
-  (interactive)
-  (delete-windows-on lua-process-buffer))
-
-;;}}}
-
-;;}}}
-
-;;{{{ menu bar
-
-(define-key lua-mode-menu [restart-with-whole-file]
-  '("Restart With Whole File" .  lua-restart-with-whole-file))
-(define-key lua-mode-menu [kill-process]
-  '("Kill Process" . lua-kill-process))
-
-(define-key lua-mode-menu [hide-process-buffer]
-  '("Hide Process Buffer" . lua-hide-process-buffer))
-(define-key lua-mode-menu [show-process-buffer]
-  '("Show Process Buffer" . lua-show-process-buffer))
-
-(define-key lua-mode-menu [end-of-proc]
-  '("End Of Proc" . lua-end-of-proc))
-(define-key lua-mode-menu [beginning-of-proc]
-  '("Beginning Of Proc" . lua-beginning-of-proc))
-
-(define-key lua-mode-menu [send-lua-region]
-  '("Send Lua-Region" . lua-send-lua-region))
-(define-key lua-mode-menu [set-lua-region-end]
-  '("Set Lua-Region End" . lua-set-lua-region-end))
-(define-key lua-mode-menu [set-lua-region-start]
-  '("Set Lua-Region Start" . lua-set-lua-region-start))
-
-(define-key lua-mode-menu [send-current-line]
-  '("Send Current Line" . lua-send-current-line))
-(define-key lua-mode-menu [send-region]
-  '("Send Region" . lua-send-region))
-(define-key lua-mode-menu [send-proc]
-  '("Send Proc" . lua-send-proc))
-(define-key lua-mode-menu [send-buffer]
-  '("Send Buffer" . lua-send-buffer))
-
-;;}}}
-
-(provide 'lua-mode)
-
-
-;;{{{ Emacs local variables
-
-;; Local Variables:
-;; folded-file: t
-;; End:
-
-;;}}}
-
-;;; lua-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/m4-mode.el b/xemacs-packages/lisp/prog-modes/m4-mode.el
deleted file mode 100644
index 56349268..00000000
--- a/xemacs-packages/lisp/prog-modes/m4-mode.el
+++ /dev/null
@@ -1,215 +0,0 @@
-;;; m4-mode.el --- m4 code editing commands for Emacs
-
-;; Author: Andrew Csillag (drew@staff.prodigy.com)
-;; Maintainer: Andrew Csillag (drew@staff.prodigy.com)
-;; Keywords: languages, faces
-
-;; 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:
-
-;; A smart editing mode for m4 macro definitions.  It seems to have most of the 
-;; syntax right (sexp motion commands work, but function motion commands don't).
-;; It also sets the font-lock syntax stuff for colorization
-
-;; By Drew Csillag (drew@staff.prodigy.com)
-;; $Id: m4-mode.el,v 1.3 2003/06/07 12:14:44 adrian Exp $
-
-;; History:
-
-;; Date     Version Who Action
-;; -------- ------- --- ----
-;; 09/13/96 1.0	    DC  Created
-;; 09/26/96 1.1	    DC  added syntax table stuff so now matches `'s
-;;          		now can use C-c C-b to m4 on buffer,C-c C-r for region
-;;                      added m4-comment-region (C-c C-c)
-;; 09/27/96 1.2	    DC  Redid header comment
-;;          1.3     DC  more cosmetic fixes 
-;;          1.4     DC  removed m4-comment-region, using comment-region instead
-;; 10/03/96         DC  added provide line
-;; 10/24/96 1.5     DC  fixed keyword regexp
-;; 10/29/96 1.6     DC  added m4_keywords for --prefix-builtins
-;;                      fixed syntax table so _define_ isn't keywordified
-;; 10/29/96 1.8     DC  fixed a problem where comments go fontified incorrectly
-;;                      if they had quotes in them
-;; 11/21/96 1.9     DC  collapsed 4 regexps into 1 and removed a duplicate,
-;;                      removed a duplicate backslash
-;; 05/16/97 1.10    DC  added contributed fixes and enhancements from 
-;;                      Martin Buchholz
-;;                      Can now specify options to m4 via m4-program-options
-;;                      Now terminates m4 processes when the buffer send
-is 
-;;                      done
-;;                      dnl and m4_dnl recognized as comment starters
- 
-;; To Do's:
-
-;; * want to make m4-m4-(buffer|region) look sorta like M-x compile look&feel ?
-;; * sexp motion commands don't seem to work right
-
-;; to autoload m4 lisp code:  
-;; (autoload 'm4-mode "m4-mode" nil t)
-;;
-;; or can use (load "m4-mode") or (require 'm4-mode) to just load it 
-;;
-;; to try to "auto-detect" m4 files:
-;; (setq auto-mode-alist 
-;;	 (cons '(".*\\.m4$" . m4-mode)
-;;	       auto-mode-alist))
-
-;;; Thanks: 
-;;;         to Akim Demaille and Terry Jones for the bug reports
-;;;         to Simon Marshall for the regexp tip
-;;;         to Martin Buchholz for some general fixes
-
-;;; Code:
-
-;;path to the m4 program
-(defvar m4-program 
-  (cond 
-   ((file-exists-p "/usr/local/bin/m4") "/usr/local/bin/m4")
-   ((file-exists-p "/usr/bin/m4") "/usr/bin/m4")
-   ((file-exists-p "/bin/m4") "/bin/m4")
-   ((file-exists-p "/usr/ccs/bin/m4") "/usr/ccs/bin/m4")
-   )
-)
-
-;;options to m4
-(defconst m4-program-options nil)
-;;to use --prefix-builtins, you can use
-;;(defconst m4-program-options '("-P"))
-;;or
-;;(defconst m4-program-options '("--prefix-builtins"))
-
-;;thank god for make-regexp.el!
-(defvar m4-font-lock-keywords
-  `(
-    ("\\(\\bdnl\\b\\|\\bm4_dnl\\b\\|^\\#\\).*$" .
-font-lock-comment-face)
-    ("\\$[*#@0-9]" . font-lock-variable-name-face)
-   
-("\\b\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|gnu\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|un\\(d\\(efine\\|ivert\\)\\|ix\\)\\)\\b"
-. font-lock-keyword-face)
-   
-("\\b\\(m4_\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(_undefine\\|exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|undivert\\)\\)\\b"
-. font-lock-keyword-face)
-    "default font-lock-keywords")
-)
-
-;;this may still need some work
-(defvar m4-mode-syntax-table nil
-  "syntax table used in m4 mode")
-(setq m4-mode-syntax-table (make-syntax-table))
-(modify-syntax-entry ?` "('" m4-mode-syntax-table)
-(modify-syntax-entry ?' ")`" m4-mode-syntax-table)
-(modify-syntax-entry ?# "<\n" m4-mode-syntax-table)
-(modify-syntax-entry ?\n ">#" m4-mode-syntax-table)
-(modify-syntax-entry ?{  "_" m4-mode-syntax-table)
-(modify-syntax-entry ?}  "_" m4-mode-syntax-table)
-(modify-syntax-entry ?*  "." m4-mode-syntax-table)
-(modify-syntax-entry ?_  "_" m4-mode-syntax-table)
-(modify-syntax-entry ?\" "w" m4-mode-syntax-table)
-
-(defvar m4-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-c\C-b" 'm4-m4-buffer)
-    (define-key map "\C-c\C-r" 'm4-m4-region)
-    (define-key map "\C-c\C-c" 'comment-region)
-    map))
-
-(defun m4-end-m4 (process event)
-  (cond ((equal event "kill\n") (princ "m4 process done"))
-	(t (princ
-	    (format "Process: %s had the event `%s'" process event)))))
-
-(defun m4-start-m4 ()
-  (eval (append (append '(start-process "m4process" "*m4 output*"
-m4-program)
-		m4-program-options) '("-e")))
-  (set-process-sentinel (get-process "m4process") 'm4-end-m4)
-)
-
-(defun m4-m4-buffer ()
-  "send contents of the current buffer to m4"
-  (interactive)
-  (m4-start-m4)
-  (process-send-region "m4process" (point-min) (point-max))
-  (process-send-eof "m4process")
-  (switch-to-buffer-other-window "*m4 output*")
-  (delete-process "m4process")
-)
-
-
-(defun m4-m4-region ()
-  "send contents of the current region to m4"
-  (interactive)
-  (m4-start-m4)
-  (process-send-region "m4process" (point) (mark))
-  (process-send-eof "m4process")
-  (switch-to-buffer-other-window "*m4 output*")
-)
-
-;;;###autoload
-(defun m4-mode ()
-  "A major-mode to edit m4 macro files
-\\{m4-mode-map}
-"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map m4-mode-map)
-
-  (make-local-variable 'comment-start)
-  (setq comment-start "#")
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-
-
-  (make-local-variable	'font-lock-defaults)  
-  (setq major-mode 'm4-mode
-	mode-name "m4"
-	font-lock-defaults '(m4-font-lock-keywords nil)
-	)
-  (set-syntax-table m4-mode-syntax-table)
-  (run-hooks 'm4-mode-hook))
-
-;; XEmacs additions
-;; APA: autoconf-mode is XEmacs' preferred m4 mode, see its autoload
-;; cookie.
-;; ;;;###autoload(add-to-list 'auto-mode-alist '(".*\\.m4$" . m4-mode))
-
-(provide 'm4-mode)
-;;stuff to play with for debugging
-;(char-to-string (char-syntax ?`))
-
-;;;how I generate the nasty looking regexps at the top
-;;;(make-regexp '("builtin" "changecom" "changequote" "changeword" "debugfile" 
-;;;		  "debugmode" "decr" "define" "defn" "divert" "divnum" "dnl" 
-;;;		  "dumpdef" "errprint" "esyscmd" "eval" "file" "format" "gnu"
-;;;		  "ifdef" "ifelse" "include" "incr" "index" "indir" "len" "line" 
-;;;		  "m4exit" "m4wrap" "maketemp" "patsubst" "popdef" "pushdef" "regexp" 
-;;;		  "shift" "sinclude" "substr" "syscmd" "sysval" "traceoff" "traceon" 
-;;;		  "translit" "undefine" "undivert" "unix"))
-;;;(make-regexp '("m4_builtin" "m4_changecom" "m4_changequote" "m4_changeword" 
-;;;		  "m4_debugfile" "m4_debugmode" "m4_decr" "m4_define" "m4_defn" 
-;;;		  "m4_divert" "m4_divnum" "m4_dnl" "m4_dumpdef" "m4_errprint" 
-;;;		  "m4_esyscmd" "m4_eval" "m4_file" "m4_format" "m4_ifdef" "m4_ifelse" 
-;;;		  "m4_include" "m4_incr" "m4_index" "m4_indir" "m4_len" "m4_line" 
-;;;		  "m4_m4exit" "m4_m4wrap" "m4_maketemp" "m4_patsubst" "m4_popdef" 
-;;;		  "m4_pushdef" "m4_regexp" "m4_shift" "m4_sinclude" "m4_substr" 
-;;;		  "m4_syscmd" "m4_sysval" "m4_traceoff" "m4_traceon" "m4_translit" 
-;;;		  "m4_m4_undefine" "m4_undivert"))
diff --git a/xemacs-packages/lisp/prog-modes/make-mode.el b/xemacs-packages/lisp/prog-modes/make-mode.el
deleted file mode 100644
index bca3dbf1..00000000
--- a/xemacs-packages/lisp/prog-modes/make-mode.el
+++ /dev/null
@@ -1,1684 +0,0 @@
-;;; make-mode.el --- makefile editing commands for Emacs
-
-;; Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-;; Author: Thomas Neumann 
-;;	Eric S. Raymond 
-;; Maintainer: XEmacs Development Team 
-;; Adapted-By: ESR
-;; Keywords: unix, tools
-
-;; RMS:
-;; This needs work.
-;; Also, the doc strings need fixing: the first line doesn't stand alone,
-;; and other usage is not high quality.  Symbol names don't have `...'.
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: GNU Emacs 19.34, partially with 21.2.
-
-;;; Commentary:
-
-;; A major mode for editing makefiles.  The mode knows about Makefile
-;; syntax and defines M-n and M-p to move to next and previous productions.
-;;
-;; The keys $, =, : and . are electric; they try to help you fill in a
-;; macro reference, macro definition, ordinary target name, or special
-;; target name, respectively.  Such names are completed using a list of
-;; targets and macro names parsed out of the makefile.  This list is
-;; automatically updated, if necessary, whenever you invoke one of
-;; these commands.  You can force it to be updated with C-c C-p.
-;;
-;; The command C-c C-f adds certain filenames in the current directory
-;; as targets.  You can filter out filenames by setting the variable
-;; makefile-ignored-files-in-pickup-regex.
-;;
-;; The command C-c C-u grinds for a bit, then pops up a report buffer
-;; showing which target names are up-to-date with respect to their
-;; prerequisites, which targets are out-of-date, and which have no
-;; prerequisites.
-;;
-;; The command C-c C-b pops up a browser window listing all target and
-;; macro names.  You can mark or unmark items wit C-c SPC, and insert
-;; all marked items back in the Makefile with C-c TAB.
-;;
-;; The command C-c TAB in the makefile buffer inserts a GNU make builtin.
-;; You will be prompted for the builtin's args.
-;;
-;; There are numerous other customization variables.
-
-;;
-;; To Do:
-;;
-;; * makefile-backslash-region should be given better behavior.
-;; * Consider binding C-c C-c to comment-region (like cc-mode).
-;; * Eliminate electric stuff entirely.
-;; * It might be nice to highlight targets differently depending on
-;;   whether they are up-to-date or not.  Not sure how this would
-;;   interact with font-lock.
-;; * Would be nice to edit the commands in ksh-mode and have
-;;   indentation and slashification done automatically.  Hard.
-;; * Consider removing browser mode.  It seems useless.
-;; * ":" should notice when a new target is made and add it to the
-;;   list (or at least set makefile-need-target-pickup).
-;; * Make browser into a major mode.
-;; * Clean up macro insertion stuff.  It is a mess.
-;; * Browser entry and exit is weird.  Normalize.
-;; * Browser needs to be rewritten.  Right now it is kind of a crock.
-;;   Should at least:
-;;    * Act more like dired/buffer menu/whatever.
-;;    * Highlight as mouse traverses.
-;;    * B2 inserts.
-;; * Update documentation above.
-;; * Update texinfo manual.
-;; * Update files.el.
-
-
-
-;;; Code:
-
-;; Sadly we need this for a macro.
-(eval-when-compile
-  (unless (featurep 'xemacs)
-    (require 'imenu))
-  (require 'dabbrev)
-  (require 'add-log))
-
-;; Used to generate some fancy regexps
-(require 'regexp-opt)
-
-;;; ------------------------------------------------------------
-;;; Configurable stuff
-;;; ------------------------------------------------------------
-
-(defgroup makefile nil
-  "Makefile editing commands for XEmacs."
-  :group 'tools
-  :prefix "makefile-")
-
-(defface makefile-space-face
-   '((((class color)) (:background  "hotpink"))
-     (t (:reverse-video t)))
-  "Face to use for highlighting leading spaces in Font-Lock mode."
-  :group 'faces
-  :group 'makemode)
-
-(defcustom makefile-browser-buffer-name "*Macros and Targets*"
-  "*Name of the macro- and target browser buffer."
-  :type 'string
-  :group 'makefile)
-
-(defcustom makefile-target-colon ":"
-  "*String to append to all target names inserted by `makefile-insert-target'.
-\":\" or \"::\" are common values."
-  :type 'string
-  :group 'makefile)
-
-(defcustom makefile-macro-assign " = "
-  "*String to append to all macro names inserted by `makefile-insert-macro'.
-The normal value should be \" = \", since this is what
-standard make expects.  However, newer makes such as dmake
-allow a larger variety of different macro assignments, so you
-might prefer to use \" += \" or \" := \" ."
-  :type 'string
-  :group 'makefile)
-
-(defcustom makefile-electric-keys nil
-  "*If non-nil, Makefile mode should install electric keybindings.
-Default is nil."
-  :type 'boolean
-  :group 'makefile)
-
-(defcustom makefile-use-curly-braces-for-macros-p nil
-  "*Controls the style of generated macro references.
-Non-nil means macro references should use curly braces, like `${this}'.
-nil means use parentheses, like `$(this)'."
-  :type 'boolean
-  :group 'makefile)
-
-(defcustom makefile-tab-after-target-colon t
-  "*If non-nil, insert a TAB after a target colon.
-Otherwise, a space is inserted.
-The default is t."
-  :type 'boolean
-  :group 'makefile)
-
-(defcustom makefile-browser-leftmost-column 10
-  "*Number of blanks to the left of the browser selection mark."
-  :type 'integer
-  :group 'makefile)
-
-(defcustom makefile-browser-cursor-column 10
-  "*Column the cursor goes to when it moves up or down in the Makefile browser."
-  :type 'integer
-  :group 'makefile)
-
-(defcustom makefile-backslash-column 48
-  "*Column in which `makefile-backslash-region' inserts backslashes."
-  :type 'integer
-  :group 'makefile)
-
-(defcustom makefile-browser-selected-mark "+  "
-  "*String used to mark selected entries in the Makefile browser."
-  :type 'string
-  :group 'makefile)
-
-(defcustom makefile-browser-unselected-mark "   "
-  "*String used to mark unselected entries in the Makefile browser."
-  :type 'string
-  :group 'makefile)
-
-(defcustom makefile-browser-auto-advance-after-selection-p t
-  "*If non-nil, cursor will move after item is selected in Makefile browser."
-  :type 'boolean
-  :group 'makefile)
-
-(defcustom makefile-pickup-everything-picks-up-filenames-p nil
-  "*If non-nil, `makefile-pickup-everything' picks up filenames as targets.
-This means it calls `makefile-pickup-filenames-as-targets'.
-Otherwise filenames are omitted."
-  :type 'boolean
-  :group 'makefile)
-
-(defcustom makefile-cleanup-continuations-p t
-  "*If non-nil, automatically clean up continuation lines when saving.
-A line is cleaned up by removing all whitespace following a trailing
-backslash.  This is done silently.
-IMPORTANT: Please note that enabling this option causes Makefile mode
-to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"."
-  :type 'boolean
-  :group 'makefile)
-
-;;; those suspicious line warnings are really annoying and
-;;; seem to be generated for every makefile I've ever seen.
-;;; add a simple mechanism to disable them.  -gk
-(defcustom makefile-warn-suspicious-lines-p t
-  "In non-nil, warn about suspicious lines when saving the makefile"
-  :type 'boolean
-  :group 'makefile)
-
-(defcustom makefile-browser-hook '()
-  "The hook to run when entering makefile browser."
-  :type 'hook
-  :group 'makefile)
-
-;;
-;; Special targets for DMake, Sun's make ...
-;; 
-(defcustom makefile-special-targets-list
-  '(("DEFAULT")      ("DONE")        ("ERROR")        ("EXPORT")
-    ("FAILED")       ("GROUPEPILOG") ("GROUPPROLOG")  ("IGNORE")
-    ("IMPORT")       ("INCLUDE")     ("INCLUDEDIRS")  ("INIT")
-    ("KEEP_STATE")   ("MAKEFILES")   ("MAKE_VERSION") ("NO_PARALLEL")
-    ("PARALLEL")     ("PHONY")       ("PRECIOUS")     ("REMOVE")
-    ("SCCS_GET")     ("SILENT")      ("SOURCE")       ("SUFFIXES")
-    ("WAIT")         ("c.o")         ("C.o")          ("m.o")
-    ("el.elc")       ("y.c")         ("s.o"))
-  "*List of special targets.
-You will be offered to complete on one of those in the minibuffer whenever
-you enter a \".\" at the beginning of a line in `makefile-mode'."
-  :type '(repeat (list string))
-  :group 'makefile)
-
-(defcustom makefile-runtime-macros-list
-  '(("@") ("&") (">") ("<") ("*") ("^") ("+") ("?") ("%") ("$"))
-  "*List of macros that are resolved by make at runtime.
-If you insert a macro reference using `makefile-insert-macro-ref', the name
-of the macro is checked against this list.  If it can be found its name will
-not be enclosed in { } or ( )."
-  :type '(repeat (list string))
-  :group 'makefile)
-
-;;; Some sample lines from one of the glibc makefiles:
-;;
-;; $(services:%=$(objpfx)libnss_%.so) $(objpfx)libnsl.so: $(common-objpfx)libc.so
-;; $(objpfx)libnss_compat.so: $(objpfx)libnsl.so$(libnsl.so-version)
-;; subdir-dirs = $(services:%=nss_%) ---> mustn't match.
-;; ordinary: blah blah
-;;
-;; Note that the first big subexpression (the only match capturing
-;; one) is used by font lock, imenu, and makefile-mode.
-(defconst makefile-dependency-regex
-  (eval-when-compile
-   (concat
-    "^"
-;;;   "\\(?:vpath[ \t]\\)\\{0,0\\}" ; doesn't work as intended
-;;; I want it to NOT highlight lines like:
-;;;vpath %.h $(subst $(empty) ,:,$(strip $(common-objpfx) $(objpfx) \
-;;;				      $(+sysdep_dirs) $(..)))
-;;; ... where the colon between the two commas makes it look like a
-;;; target.  The workaround is to write the line like:
-;;;colon := :
-;;;vpath %.h $(subst $(empty) ,$(colon),$(strip $(common-objpfx) $(objpfx) \
-;;;				      $(+sysdep_dirs) $(..)))
-;;; ... putting a space before vpath works too, but I highlight vpath later,
-;;; and that expects it to be anchored left.
-;;; I wonder if the "zero length negative assertion" (the \\{0,0\\} is
-;;; moving the scan cursor forward?  Bet that's it.  I should look
-;;; into the regexp engine at some point and see if I can fix it.
-;;; The libpcre is not too shabby.  Dunno if it's right for an Emacs.
-    "\\("
-      " *"
-      "\\(?:"
-            "\\$[\(\{][^\)\}]+[\)\}][^ \n\t#=:]+"
-        "\\|"
-            "[^ \n\t#=:]+"
-       "\\)"
-       "\\(?:"
-             "[ \t]+"
-	     "\\(?:"
-	           "\\$[\(\}][^\)\}]+[\)\}][^ \n\t#=:]+"
-	       "\\|"
-	           "[^ \n\t#=:]+"
-	      "\\)"
-       "\\)*"
-   "\\)" ; end match-string 1 (the only one we use.)
-   "[ \t]*:"
-   "\\(?:"
-          "[ \t]*$"
-     "\\|"
-          "[^=\n].*$"
-   "\\)"))
-  "Regex used to find dependency lines in a makefile.")
-
-;; Note that the first match capturing subexpression is used by font
-;; lock, Imenu, and makefile-mode.
-(defconst makefile-macroassign-regex
-    "^ *\\(?:export[ \t]+\\)?\\([^# \t\n][^#=: \t\n]*\\)[ \t]*[*:+?]?:?="
-  "Regex used to find macro assignment lines in a makefile.")
-
-(defconst makefile-imenu-generic-expression
-    `(("Targets" ,makefile-dependency-regex 1)
-      ("Macros" ,makefile-macroassign-regex 1)
-      ("Defines" "^define[ \t]+\\([-.a-zA-Z0-9_+]+\\)" 1)
-      ("Includes" "^[-s]?include[ \t]+\\([-.,/a-zA-Z0-9_+]+\\)" 1)
-      )
-  "See: `imenu-generic-expression'")
-
-(defconst makefile-ignored-files-in-pickup-regex
-  "\\(^\\..*\\)\\|\\(.*~$\\)\\|\\(.*,v$\\)\\|\\(\\.[chy]\\)"
-  "Regex for filenames that will NOT be included in the target list.")
-
-;Older version of same.
-;(defconst makefile-font-lock-keywords (purecopy
-;  (list
-;   '("^#.*$" . font-lock-comment-face)
-;   '("[^$]#.*$" . font-lock-comment-face)
-;   ;; rules
-;   '("^\\([^ \t\n]*%?[^ \t\n]*[ \t]*::?\\)[ \t]" 1 font-lock-type-face t)
-;   '("^\\(\\.[A-Za-z][A-Za-z]?\\..[ \t]*::?\\)" 1 font-lock-type-face t)
-;   '("^[^ \t\n]+[ \t]*:;?\\(.*\\)$" 1 font-lock-doc-string-face t)
-;   ;; variable definition
-;   '("^[_A-Za-z0-9]+[ \t]*\+?=" . font-lock-function-name-face)
-;   '("\\( \\|:=\\)[_A-Za-z0-9]+[ \t]*\\+=" . font-lock-function-name-face)
-;   ;; variable references
-;   '("\\(\\$\\$?\\([^ \t\n{(]\\|[{(][^ \t\n)}]+[)}]\\)\\)" 
-;     1 font-lock-keyword-face t)
-;   '("^include " . font-lock-string-face)
-;   ))
-
-(defconst makefile-font-lock-keywords
-  (list
-   ;; conditionals, vpath & include
-   (list
-    (concat "^ *\\("
-	    (regexp-opt
-	     (mapcar #'symbol-name
-		     '(ifeq ifneq else endif endef include sinclude)))
-	    "\\|-include\\)[ \t\n]+")
-    1 'font-lock-preprocessor-face)
-
-   '("^ *\\(ifn?def\\)[ \t]+\\(.*$\\)"
-     (1 font-lock-preprocessor-face) (2 font-lock-reference-face nil t))
-
-   ;; define
-   '("^ *\\(define\\)[ \t]+\\(.*$\\)"
-     (1 font-lock-preprocessor-face) (2 font-lock-variable-name-face nil t))
-
-   ;; vpath export unexport override
-   (list
-    (concat "^ *\\("
-	    (regexp-opt
-	     (mapcar #'symbol-name
-		     '(vpath export unexport override)))
-	    "\\)[ \t]+") 1 'font-lock-keyword-face 'prepend)
-
-   ;; Do dependencies.  These get the function name face.
-   (list makefile-dependency-regex 1 'font-lock-function-name-face 'prepend)
-
-   ;; Do macro assignments.  These get the "variable-name" face rather
-   ;; arbitrarily.
-   (list makefile-macroassign-regex 1 'font-lock-variable-name-face 'keep)
-
-   ;; Variable references even in targets/strings/comments:
-   (list
-    (concat "\\$[\(\{][ \t]*"
-;;; Commented off because
-;;; $($(var)-ext) still doesn't work.
-;;;  I want to highlight
-;;; ${${var}-ext} blah blah ${var2}
-;;;   ++^^^+^^^^              ^^^^
-;;; *not*
-;;; ${${var}-ext} blah blah ${var2}
-;;;   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;;; or just
-;;; ${${var}-ext} blah blah ${var2}
-;;;     ^^^                   ^^^^
-;;;	       "\\(?:"
-;;;	         "\\$[\(\{]"
-;;;		 "[^\)\}]+"
-;;;		 "[\)\}]"
-;;;	       "\\)*"
-	    "\\("
-	    "[-<@.a-zA-Z0-9+_]+"	; match-string 1
-	    "\\)"
-	    "\\(?:"
-	    "[^-.a-zA-Z0-9+_]\\{0,0\\}"
-	    "\\|"
-	    "[ \t]*[:\$].*?"
-	    "\\)"
-	    "[ \t]*[\}\)]")
-    1 'font-lock-reference-face 'prepend)
-
-   ;; and builtin special variable names
-   (list
-    (concat "\\$" (regexp-opt (mapcar #'car makefile-runtime-macros-list)))
-    '(0 font-lock-reference-face t))
-
-   ;; Make $(functions ...)
-   (list
-    (concat
-     "\\$[\(\{][ \t]*\\("
-     (regexp-opt
-      (mapcar #'symbol-name
-	      '(subst patsubst strip findstring filter filter-out sort
-		      dir notdir suffix basename addsuffix addprefix join word words
-		      wordlist firstword wildcard error warning shell origin foreach
-		      call)))
-     "\\)[ \t\n]+:\\{0,0\\}")
-    1 'font-lock-keyword-face 'prepend)
-
-   ;; Todo:, Fixme,and ### through ###### in comments.
-   '("#.*?[ \t]+\\([Tt][Oo][Dd][Oo]:?\\)" (1 font-lock-warning-face t))
-   '("#.*?[ \t]+\\(#\\{3,6\\}\\)[ \t\n]+" (1 font-lock-warning-face t))
-   '("#.*?[ \t]+\\([Ff][Ii][Xx] *[Mm][Ee]:?\\)" (1 font-lock-warning-face t))
-
-   ;; Highlight lines that contain just whitespace.
-   ;; They can cause trouble, especially if they start with a tab.
-   '("^[ \t]+$" . makefile-space-face)
-
-   ;; Highlight shell comments that Make treats as commands,
-   ;; since these can fool people.
-   '("^\t+#" 0 makefile-space-face t)
-
-   ;; Highlight spaces that precede tabs.
-   ;; They can make a tab fail to be effective.
-   '("^\\( +\\)\t" 1 makefile-space-face))
-  "Additional expressions to highlight in makefiles")
-
-(put 'makefile-mode 'font-lock-defaults '(makefile-font-lock-keywords))
-
-;;; ------------------------------------------------------------
-;;; The following configurable variables are used in the
-;;; up-to-date overview .
-;;; The standard configuration assumes that your `make' program
-;;; can be run in question/query mode using the `-q' option, this
-;;; means that the command
-;;;
-;;;    make -q foo
-;;;
-;;; should return an exit status of zero if the target `foo' is
-;;; up to date and a nonzero exit status otherwise.
-;;; Many makes can do this although the docs/manpages do not mention
-;;; it. Try it with your favourite one.  GNU make, System V make, and
-;;; Dennis Vadura's DMake have no problems.
-;;; Set the variable `makefile-brave-make' to the name of the
-;;; make utility that does this on your system.
-;;; To understand what this is all about see the function definition
-;;; of `makefile-query-by-make-minus-q' .
-;;; ------------------------------------------------------------
-
-(defcustom makefile-brave-make "make"
-  "*How to invoke make, for `makefile-query-targets'.
-This should identify a `make' command that can handle the `-q' option."
-  :type 'string
-  :group 'makefile)
-
-(defcustom makefile-query-one-target-method 'makefile-query-by-make-minus-q
-  "*Function to call to determine whether a make target is up to date.
-The function must satisfy this calling convention:
-
-* As its first argument, it must accept the name of the target to
-  be checked, as a string.
-
-* As its second argument, it may accept the name of a makefile
-  as a string.  Depending on what you're going to do you may
-  not need this.
-
-* It must return the integer value 0 (zero) if the given target
-  should be considered up-to-date in the context of the given
-  makefile, any nonzero integer value otherwise."
-  :type 'function
-  :group 'makefile)
-
-(defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*"
-  "*Name of the Up-to-date overview buffer."
-  :type 'string
-  :group 'makefile)
-
-;;; --- end of up-to-date-overview configuration ------------------
-
-(defvar makefile-mode-abbrev-table nil
-  "Abbrev table in use in Makefile buffers.")
-(if makefile-mode-abbrev-table
-    ()
-  (define-abbrev-table 'makefile-mode-abbrev-table ()))
-
-(defvar makefile-mode-map nil
-  "The keymap that is used in Makefile mode.")
-
-(if makefile-mode-map
-    ()
-  (setq makefile-mode-map (make-sparse-keymap 'makefile-mode-map))
-  ;; set up the keymap
-  (define-key makefile-mode-map "\C-c:" 'makefile-insert-target-ref)
-  (if makefile-electric-keys
-      (progn
-	(define-key makefile-mode-map "$" 'makefile-insert-macro-ref)
-	(define-key makefile-mode-map ":" 'makefile-electric-colon)
-	(define-key makefile-mode-map "=" 'makefile-electric-equal)
-	(define-key makefile-mode-map "." 'makefile-electric-dot)))
-  (define-key makefile-mode-map "\C-c\C-f" 'makefile-pickup-filenames-as-targets)
-  (define-key makefile-mode-map "\C-c\C-b" 'makefile-switch-to-browser)
-  (define-key makefile-mode-map "\C-c\C-c" 'comment-region)
-  (define-key makefile-mode-map "\C-c\C-p" 'makefile-pickup-everything)
-  (define-key makefile-mode-map "\C-c\C-u" 'makefile-create-up-to-date-overview)
-  (define-key makefile-mode-map "\C-c\C-i" 'makefile-insert-gmake-function)
-  (define-key makefile-mode-map "\C-c\C-\\" 'makefile-backslash-region)
-  (define-key makefile-mode-map "\M-p"     'makefile-previous-dependency)
-  (define-key makefile-mode-map "\M-n"     'makefile-next-dependency)
-  (define-key makefile-mode-map "\e\t"     'makefile-complete))
-
-;; XEmacs change
-(defconst makefile-menubar-menu
-    '("Makefile"
-      ["Move to Next Dependency" makefile-next-dependency t]
-      ["Move to Previous Dependency" makefile-previous-dependency t]
-      "---"
-      ["Find Targets and Macros" makefile-pickup-everything t]
-      ["Complete Target or Macro" makefile-complete t]
-      ["Pop up Makefile Browser" makefile-switch-to-browser t]))
-
-;; XEmacs change
-(defconst makefile-popup-menu
-    (cons "Makefile Mode Commands"
-	  (cdr makefile-menubar-menu)))
-
-(defvar makefile-browser-map nil
-  "The keymap that is used in the macro- and target browser.")
-(if makefile-browser-map
-    ()
-  (setq makefile-browser-map (make-sparse-keymap))
-  (define-key makefile-browser-map "n"    'makefile-browser-next-line)
-  (define-key makefile-browser-map "\C-n" 'makefile-browser-next-line)
-  (define-key makefile-browser-map "p"    'makefile-browser-previous-line)
-  (define-key makefile-browser-map "\C-p" 'makefile-browser-previous-line)
-  (define-key makefile-browser-map " "    'makefile-browser-toggle)
-  (define-key makefile-browser-map "i"    'makefile-browser-insert-selection)
-  (define-key makefile-browser-map "I"    'makefile-browser-insert-selection-and-quit)
-  (define-key makefile-browser-map "\C-c\C-m" 'makefile-browser-insert-continuation)
-  (define-key makefile-browser-map "q"    'makefile-browser-quit)
-  ;; disable horizontal movement
-  (define-key makefile-browser-map "\C-b" 'undefined)
-  (define-key makefile-browser-map "\C-f" 'undefined))
-
-
-(defvar makefile-mode-syntax-table nil)
-(if makefile-mode-syntax-table
-    ()
-  (setq makefile-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\( "()    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\) ")(    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\[ "(]    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\] ")[    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\{ "(}    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\} "){    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"     " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\` "\"     " makefile-mode-syntax-table)
-  (modify-syntax-entry ?#  "<     " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\n ">     " makefile-mode-syntax-table))
-
-
-;;; ------------------------------------------------------------
-;;; Internal variables.
-;;; You don't need to configure below this line.
-;;; ------------------------------------------------------------
-
-(defvar makefile-target-table nil
-  "Table of all target names known for this buffer.")
-
-(defvar makefile-macro-table nil
-  "Table of all macro names known for this buffer.")
-
-(defvar makefile-browser-client
-  "A buffer in Makefile mode that is currently using the browser.")
-
-(defvar makefile-browser-selection-vector nil)
-(defvar makefile-has-prereqs nil)
-(defvar makefile-need-target-pickup t)
-(defvar makefile-need-macro-pickup t)
-
-(defvar makefile-mode-hook '())
-
-;; Each element looks like '("GNU MAKE FUNCTION" "ARG" "ARG" ... )
-;; Each "ARG" is used as a prompt for a required argument.
-(defconst makefile-gnumake-functions-alist
-  '(
-    ;; Text functions
-    ("subst" "From" "To" "In")
-    ("patsubst" "Pattern" "Replacement" "In")
-    ("strip" "Text")
-    ("findstring" "Find what" "In")
-    ("filter" "Pattern" "Text")
-    ("filter-out" "Pattern" "Text")
-    ("sort" "List")
-    ;; Filename functions
-    ("dir" "Names")
-    ("notdir" "Names")
-    ("suffix" "Names")
-    ("basename" "Names")
-    ("addprefix" "Prefix" "Names")
-    ("addsuffix" "Suffix" "Names")
-    ("join" "List 1" "List 2")
-    ("word" "Index" "Text")
-    ("words" "Text")
-    ("firstword" "Text")
-    ("wildcard" "Pattern")
-    ;; Misc functions
-    ("foreach" "Variable" "List" "Text")
-    ("origin" "Variable")
-    ("shell" "Command")))
-
-
-;;; ------------------------------------------------------------
-;;; The mode function itself.
-;;; ------------------------------------------------------------
-
-;;;###autoload
-(defun makefile-mode ()
-  "Major mode for editing Makefiles.
-This function ends by invoking the function(s) `makefile-mode-hook'.
-
-\\{makefile-mode-map}
-
-In the browser, use the following keys:
-
-\\{makefile-browser-map}
-
-Makefile mode can be configured by modifying the following variables:
-
-makefile-browser-buffer-name:
-    Name of the macro- and target browser buffer.
-
-makefile-target-colon:
-    The string that gets appended to all target names
-    inserted by `makefile-insert-target'.
-    \":\" or \"::\" are quite common values.
-
-makefile-macro-assign:
-   The string that gets appended to all macro names
-   inserted by `makefile-insert-macro'.
-   The normal value should be \" = \", since this is what
-   standard make expects.  However, newer makes such as dmake
-   allow a larger variety of different macro assignments, so you
-   might prefer to use \" += \" or \" := \" .
-
-makefile-tab-after-target-colon:
-   If you want a TAB (instead of a space) to be appended after the
-   target colon, then set this to a non-nil value.
-
-makefile-browser-leftmost-column:
-   Number of blanks to the left of the browser selection mark.
-
-makefile-browser-cursor-column:
-   Column in which the cursor is positioned when it moves
-   up or down in the browser.
-
-makefile-browser-selected-mark:
-   String used to mark selected entries in the browser.
-
-makefile-browser-unselected-mark:
-   String used to mark unselected entries in the browser.
-
-makefile-browser-auto-advance-after-selection-p:
-   If this variable is set to a non-nil value the cursor
-   will automagically advance to the next line after an item
-   has been selected in the browser.
-
-makefile-pickup-everything-picks-up-filenames-p:
-   If this variable is set to a non-nil value then
-   `makefile-pickup-everything' also picks up filenames as targets
-   (i.e. it calls `makefile-pickup-filenames-as-targets'), otherwise
-   filenames are omitted.
-
-makefile-cleanup-continuations-p:
-   If this variable is set to a non-nil value then Makefile mode
-   will assure that no line in the file ends with a backslash
-   (the continuation character) followed by any whitespace.
-   This is done by silently removing the trailing whitespace, leaving
-   the backslash itself intact.
-   IMPORTANT: Please note that enabling this option causes Makefile mode
-   to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\".
-
-makefile-browser-hook:
-   A function or list of functions to be called just before the
-   browser is entered. This is executed in the makefile buffer.
-
-makefile-special-targets-list:
-   List of special targets. You will be offered to complete
-   on one of those in the minibuffer whenever you enter a `.'.
-   at the beginning of a line in Makefile mode."
-
-  (interactive)
-  (kill-all-local-variables)
-  (make-local-variable 'local-write-file-hooks)
-  (setq local-write-file-hooks
-	'(makefile-cleanup-continuations makefile-warn-suspicious-lines))
-  (make-local-variable 'makefile-target-table)
-  (make-local-variable 'makefile-macro-table)
-  (make-local-variable 'makefile-has-prereqs)
-  (make-local-variable 'makefile-need-target-pickup)
-  (make-local-variable 'makefile-need-macro-pickup)
-
-  ;; Font lock.
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(makefile-font-lock-keywords))
-
-  ;; Add-log.
-  (make-local-variable 'add-log-current-defun-function)
-  (setq add-log-current-defun-function 'makefile-add-log-defun)
-
-  ;; Imenu.
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression makefile-imenu-generic-expression)
-
-  ;; Dabbrev.
-  (make-local-variable 'dabbrev-abbrev-skip-leading-regexp)
-  (setq dabbrev-abbrev-skip-leading-regexp "\\$")
-
-  ;; Other abbrevs.
-  (setq local-abbrev-table makefile-mode-abbrev-table)
-
-  ;; Filling.
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'makefile-fill-paragraph)
-
-  ;; 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 'makefile-mode)
-  (setq mode-name "Makefile")
-
-  ;; Activate keymap and syntax table.
-  (use-local-map makefile-mode-map)
-  (set-syntax-table makefile-mode-syntax-table)
-
-  ;; Set menu
-  ;; XEmacs addition
-  (setq mode-popup-menu makefile-popup-menu)
-  (if (and (featurep 'menubar)
-	   (or (not (featurep 'infodock))
-	       (not (eq infodock-menubar-type 'menubar-infodock))))
-      (progn
-	;; make a local copy of the menubar, so our modes don't
-	;; change the global menubar
-	(set-buffer-menubar current-menubar)
-	(add-submenu nil makefile-menubar-menu)))
-
-  ;; Real TABs are important in makefiles
-  (setq indent-tabs-mode t)
-  (run-hooks 'makefile-mode-hook))
-
-
-
-;;; Motion code.
-
-(defun makefile-next-dependency ()
-  "Move point to the beginning of the next dependency line."
-  (interactive)
-  (let ((here (point)))
-    (end-of-line)
-    (if (re-search-forward makefile-dependency-regex (point-max) t)
-	(progn (beginning-of-line) t)	; indicate success
-      (goto-char here) nil)))
-
-(defun makefile-previous-dependency ()
-  "Move point to the beginning of the previous dependency line."
-  (interactive)
-  (let ((here (point)))
-    (beginning-of-line)
-    (if (re-search-backward makefile-dependency-regex (point-min) t)
-	(progn (beginning-of-line) t)	; indicate success
-      (goto-char here) nil)))
-
-
-
-;;; Electric keys.  Blech.
-
-(defun makefile-electric-dot (arg)
-  "Prompt for the name of a special target to insert.
-Only does electric insertion at beginning of line.
-Anywhere else just self-inserts."
-  (interactive "p")
-  (if (bolp)
-      (makefile-insert-special-target)
-    (self-insert-command arg)))
-
-(defun makefile-insert-special-target ()
-  "Prompt for and insert a special target name.
-Uses `makefile-special-targets' list."
-  (interactive)
-  (makefile-pickup-targets)
-  (let ((special-target
-	 (completing-read "Special target: "
-			  makefile-special-targets-list nil nil nil)))
-    (if (zerop (length special-target))
-	()
-      (insert "." special-target ":")
-      (makefile-forward-after-target-colon))))
-
-(defun makefile-electric-equal (arg)
-  "Prompt for name of a macro to insert.
-Only does prompting if point is at beginning of line.
-Anywhere else just self-inserts."
-  (interactive "p")
-  (makefile-pickup-macros)
-  (if (bolp)
-      (call-interactively 'makefile-insert-macro)
-    (self-insert-command arg)
-    ;; from here down is new -- if they inserted a macro without using
-    ;; the electric behavior, pick it up anyway   -gk
-    (save-excursion
-      (beginning-of-line)
-      (if (looking-at makefile-macroassign-regex)
-          (makefile-add-this-line-macro)))))
-
-(defun makefile-insert-macro (macro-name)
-  "Prepare definition of a new macro."
-  (interactive "sMacro Name: ")
-  (makefile-pickup-macros)
-  (if (not (zerop (length macro-name)))
-      (progn
-	(beginning-of-line)
-	(insert macro-name makefile-macro-assign)
-	(setq makefile-need-macro-pickup t)
-	(makefile-remember-macro macro-name))))
-
-(defun makefile-insert-macro-ref (macro-name)
-  "Complete on a list of known macros, then insert complete ref at point."
-  (interactive
-   (list
-    (progn
-      (makefile-pickup-macros)
-      (completing-read "Refer to macro: " makefile-macro-table nil nil nil))))
-  (makefile-do-macro-insertion macro-name))
-
-(defun makefile-insert-target (target-name)
-  "Prepare definition of a new target (dependency line)."
-  (interactive "sTarget: ")
-  (if (not (zerop (length target-name)))
-      (progn
-	(beginning-of-line)
-	(insert target-name makefile-target-colon)
-	(makefile-forward-after-target-colon)
-	(end-of-line)
-	(setq makefile-need-target-pickup t)
-	(makefile-remember-target target-name))))
-
-(defun makefile-insert-target-ref (target-name)
-  "Complete on a list of known targets, then insert TARGET-NAME at point."
-  (interactive
-   (list
-    (progn
-     (makefile-pickup-targets)
-     (completing-read "Refer to target: " makefile-target-table nil nil nil))))
-   (if (not (zerop (length target-name)))
-       (insert target-name " ")))
-
-(defun makefile-electric-colon (arg)
-  "Prompt for name of new target.
-Prompting only happens at beginning of line.
-Anywhere else just self-inserts."
-  (interactive "p")
-  (if (bolp)
-      (call-interactively 'makefile-insert-target)
-    (self-insert-command arg)))
-
-
-
-;;; ------------------------------------------------------------
-;;; Extracting targets and macros from an existing makefile
-;;; ------------------------------------------------------------
-
-(defun makefile-pickup-targets ()
-  "Notice names of all target definitions in Makefile."
-  (interactive)
-  (if (not makefile-need-target-pickup)
-      nil
-    (setq makefile-need-target-pickup nil)
-    (setq makefile-target-table nil)
-    (setq makefile-has-prereqs nil)
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward makefile-dependency-regex (point-max) t)
-	(makefile-add-this-line-targets)))
-    (message "Read targets OK.")))
-
-(defun makefile-add-this-line-targets ()
-  (save-excursion
-    (beginning-of-line)
-    (let ((done-with-line nil)
-	  (line-number (1+ (count-lines (point-min) (point)))))
-      (while (not done-with-line)
-	(skip-chars-forward " \t")
-	(if (not (setq done-with-line (or (eolp)
-					  (char-equal (char-after (point)) ?:))))
-	    (progn
-	      (let* ((start-of-target-name (point))
-		     (target-name
-		      (progn
-			(skip-chars-forward "^ \t:#")
-			(buffer-substring start-of-target-name (point))))
-		     (has-prereqs
-		      (not (looking-at ":[ \t]*$"))))
-		(if (makefile-remember-target target-name has-prereqs)
-		    (message "Picked up target \"%s\" from line %d"
-			     target-name line-number)))))))))
-
-(defun makefile-pickup-macros ()
-  "Notice names of all macro definitions in Makefile."
-  (interactive)
-  (if (not makefile-need-macro-pickup)
-      nil
-    (setq makefile-need-macro-pickup nil)
-    ;; changed the nil in the next line to makefile-runtime-macros-list
-    ;; so you don't have to confirm on every runtime macro entered...  -gk
-    (setq makefile-macro-table makefile-runtime-macros-list) 
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward makefile-macroassign-regex (point-max) t)
-	(makefile-add-this-line-macro)
-	(forward-line 1)))
-    (message "Read macros OK.")))
-
-(defun makefile-add-this-line-macro ()
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (if (not (eolp))
-	(let* ((start-of-macro-name (point))
-	       (line-number (1+ (count-lines (point-min) (point))))
-	       (macro-name (progn
-			     (skip-chars-forward "^ \t:#=*")
-			     (buffer-substring start-of-macro-name (point)))))
-	  (if (makefile-remember-macro macro-name)
-	      (message "Picked up macro \"%s\" from line %d"
-		       macro-name line-number))))))
-
-(defun makefile-pickup-everything (arg)
-  "Notice names of all macros and targets in Makefile.
-Prefix arg means force pickups to be redone."
-  (interactive "P")
-  (if arg
-      (progn
-	(setq makefile-need-target-pickup t)
-	(setq makefile-need-macro-pickup t)))
-  (makefile-pickup-macros)
-  (makefile-pickup-targets)
-  (if makefile-pickup-everything-picks-up-filenames-p
-      (makefile-pickup-filenames-as-targets)))
-
-(defun makefile-pickup-filenames-as-targets ()
-  "Scan the current directory for filenames to use as targets.
-Checks each filename against `makefile-ignored-files-in-pickup-regex'
-and adds all qualifying names to the list of known targets."
-  (interactive)
-  (let* ((dir (file-name-directory (buffer-file-name)))
-	 (raw-filename-list (if dir
-				(file-name-all-completions "" dir)
-			      (file-name-all-completions "" ""))))
-    (mapcar '(lambda (name)
-	       (if (and (not (file-directory-p name))
-			(not (string-match makefile-ignored-files-in-pickup-regex
-					   name)))
-		   (if (makefile-remember-target name)
-		       (message "Picked up file \"%s\" as target" name))))
-	    raw-filename-list)))
-
-
-
-;;; Completion.
-
-(defun makefile-complete ()
-  "Perform completion on Makefile construct preceding point.
-Can complete variable and target names.
-The context determines which are considered."
-  (interactive)
-  (let* ((beg (save-excursion
-		(skip-chars-backward "^$(){}:#= \t\n")
-		(point)))
-	 (try (buffer-substring beg (point)))
-	 (do-macros nil)
-	 (paren nil))
-
-    (save-excursion
-      (goto-char beg)
-      (let ((pc (preceding-char)))
-	(cond
-	 ;; Beginning of line means anything.
-	 ((bolp)
-	  ())
-
-	 ;; Preceding "$" means macros only.
-	 ((= pc ?$)
-	  (setq do-macros t))
-
-	 ;; Preceding "$(" or "${" means macros only.
-	 ((and (or (= pc ?{)
-		   (= pc ?\())
-	       (progn
-		 (setq paren pc)
-		 (backward-char)
-		 (and (not (bolp))
-		      (= (preceding-char) ?$))))
-	  (setq do-macros t)))))
-
-    ;; Try completion.
-    (let* ((table (append (if do-macros
-			      '()
-			    makefile-target-table)
-			  makefile-macro-table))
-	   (completion (try-completion try table)))
-      (cond
-       ;; Exact match, so insert closing paren or colon.
-       ((eq completion t)
-	(insert (if do-macros
-		    (if (eq paren ?{)
-			?}
-		      ?\))
-		  (if (save-excursion
-			(goto-char beg)
-			(bolp))
-		      ":"
-		    " "))))
-
-       ;; No match.
-       ((null completion)
-	(message "Can't find completion for \"%s\"" try)
-	(ding))
-
-       ;; Partial completion.
-       ((not (string= try completion))
-	;; FIXME it would be nice to supply the closing paren if an
-	;; exact, unambiguous match were found.  That is not possible
-	;; right now.  Ditto closing ":" for targets.
-	(delete-region beg (point))
-
-	;; DO-MACROS means doing macros only.  If not that, then check
-	;; to see if this completion is a macro.  Special insertion
-	;; must be done for macros.
-	(if (or do-macros
-		(assoc completion makefile-macro-table))
-	    (let ((makefile-use-curly-braces-for-macros-p
-		   (or (eq paren ?{)
-		       makefile-use-curly-braces-for-macros-p)))
-	      (delete-backward-char 2)
-	      (makefile-do-macro-insertion completion)
-	      (delete-backward-char 1))
-
-	  ;; Just insert targets.
-	  (insert completion)))
-
-       ;; Can't complete any more, so make completion list.  FIXME
-       ;; this doesn't do the right thing when the completion is
-       ;; actually inserted.  I don't think there is an easy way to do
-       ;; that.
-       (t
-	(message "Making completion list...")
-	(let ((list (all-completions try table)))
-	  (with-output-to-temp-buffer "*Completions*"
-	    (display-completion-list list)))
-	(message "Making completion list...done"))))))
-
-
-
-;; Backslashification.  Stolen from cc-mode.el.
-
-(defun makefile-backslashify-current-line (doit)
-  (end-of-line)
-  (if doit
-      (if (not (save-excursion
-		 (forward-char -1)
-		 (eq (char-after (point)) ?\\ )))
-	  (progn
-	    (if (>= (current-column) makefile-backslash-column)
-		(insert " \\")
-	      (while (<= (current-column) makefile-backslash-column)
-		(insert "\t")
-		(end-of-line))
-	      (delete-char -1)
-	      (while (< (current-column) makefile-backslash-column)
-		(insert " ")
-		(end-of-line))
-	      (insert "\\"))))
-    (if (not (bolp))
-	(progn
-	  (forward-char -1)
-	  (if (eq (char-after (point)) ?\\ )
-	      (let ((saved (save-excursion
-			    (end-of-line)
-			    (point))))
-		(skip-chars-backward " \t")
-		(delete-region (point) saved)))))))
-
-(defun makefile-backslash-region (beg end arg)
-  "Insert backslashes at end of every line in region.
-Useful for defining multi-line rules.
-If called with a prefix argument, trailing backslashes are removed."
-  (interactive "r\nP")
-  (save-excursion
-    (let ((do-lastline-p (progn (goto-char end) (not (bolp))))
-	  ;; dynamic binding relied on here.
-	  (makefile-backslash-column makefile-backslash-column))
-      (save-restriction
-	(narrow-to-region beg end)
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (end-of-line)
-	  (and (> (current-column) (- makefile-backslash-column 1))
-	       (setq makefile-backslash-column (+ (current-column) 1)))
-	  (forward-line 1))
-	(goto-char (point-min))
-	(while (not (save-excursion
-		      (forward-line 1)
-		      (eobp)))
-	  (makefile-backslashify-current-line (null arg))
-	  (forward-line 1)))
-      (and do-lastline-p
-	   (progn (goto-char end)
-		  (makefile-backslashify-current-line (null arg)))))))
-
-
-
-;; Filling
-
-(defun makefile-fill-paragraph (arg)
-  ;; Fill comments, backslashed lines, and variable definitions
-  ;; specially.
-  (save-excursion
-    (beginning-of-line)
-    (cond
-     ((looking-at "^#+ ")
-      ;; Found a comment.  Set the fill prefix and then fill.
-      (let ((fill-prefix (buffer-substring-no-properties (match-beginning 0)
-							 (match-end 0)))
-	    (fill-paragraph-function nil))
-	(fill-paragraph nil)
-	t))
-
-     ;; Must look for backslashed-region before looking for variable
-     ;; assignment.
-     ((save-excursion
-	(end-of-line)
-	(or
-	 (= (preceding-char) ?\\)
-	 (progn
-	   (end-of-line -1)
-	   (= (preceding-char) ?\\))))
-      ;; A backslash region.  Find beginning and end, remove
-      ;; backslashes, fill, and then reapply backslahes.
-      (end-of-line)
-      (let ((beginning
-	     (save-excursion
-	       (end-of-line 0)
-	       (while (= (preceding-char) ?\\)
-		 (end-of-line 0))
-	       (forward-char)
-	       (point)))
-	    (end
-	     (save-excursion
-	       (while (= (preceding-char) ?\\)
-		 (end-of-line 2))
-	       (point))))
-	(save-restriction
-	  (narrow-to-region beginning end)
-	  (makefile-backslash-region (point-min) (point-max) t)
-	  (let ((fill-paragraph-function nil))
-	    (fill-paragraph nil))
-	  (makefile-backslash-region (point-min) (point-max) nil)
-	  (goto-char (point-max))
-	  (if (< (skip-chars-backward "\n") 0)
-	      (delete-region (point) (point-max))))))
-
-     ((looking-at makefile-macroassign-regex)
-      ;; Have a macro assign.  Fill just this line, and then backslash
-      ;; resulting region.
-      (save-restriction
-	(narrow-to-region (point) (save-excursion
-				    (end-of-line)
-				    (forward-char)
-				    (point)))
-	(let ((fill-paragraph-function nil))
-	  (fill-paragraph nil))
-	(makefile-backslash-region (point-min) (point-max) nil)))))
-
-  ;; Always return non-nil so we don't fill anything else.
-  t)
-
-
-
-;;; ------------------------------------------------------------
-;;; Browser mode.
-;;; ------------------------------------------------------------
-
-(defun makefile-browser-format-target-line (target selected)
-  (format
-   (concat (make-string makefile-browser-leftmost-column ?\ )
-	   (if selected
-	       makefile-browser-selected-mark
-	     makefile-browser-unselected-mark)
-	   "%s%s")
-   target makefile-target-colon))
-
-(defun makefile-browser-format-macro-line (macro selected)
-   (concat (make-string makefile-browser-leftmost-column ?\ )
-	   (if selected
-	       makefile-browser-selected-mark
-	     makefile-browser-unselected-mark)
-	   (makefile-format-macro-ref macro)))
-
-(defun makefile-browser-fill (targets macros)
-  (let ((inhibit-read-only t))
-    (goto-char (point-min))
-    (erase-buffer)
-    (mapconcat
-     (function
-      (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n")))
-     targets
-     "")
-    (mapconcat
-     (function
-      (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n")))
-     macros
-     "")
-    (sort-lines nil (point-min) (point-max))
-    (goto-char (1- (point-max)))
-    (delete-char 1)			; remove unnecessary newline at eob
-    (goto-char (point-min))
-    (forward-char makefile-browser-cursor-column)))
-
-;;;
-;;; Moving up and down in the browser
-;;;
-
-(defun makefile-browser-next-line ()
-  "Move the browser selection cursor to the next line."
-  (interactive)
-  (if (not (makefile-last-line-p))
-      (progn
-	(forward-line 1)
-	(forward-char makefile-browser-cursor-column))))
-
-(defun makefile-browser-previous-line ()
-  "Move the browser selection cursor to the previous line."
-  (interactive)
-  (if (not (makefile-first-line-p))
-      (progn
-	(forward-line -1)
-	(forward-char makefile-browser-cursor-column))))
-
-;;;
-;;; Quitting the browser (returns to client buffer)
-;;;
-
-(defun makefile-browser-quit ()
-  "Leave the browser and return to the makefile buffer."
-  (interactive)
-  (let ((my-client makefile-browser-client))
-    (setq makefile-browser-client nil)	; we quitted, so NO client!
-    (set-buffer-modified-p nil)
-    (kill-buffer (current-buffer))
-    (pop-to-buffer my-client)))
-
-;;;
-;;; Toggle state of a browser item
-;;;
-
-(defun makefile-browser-toggle ()
-  "Toggle the selection state of the browser item at the cursor position."
-  (interactive)
-  (let ((this-line (count-lines (point-min) (point))))
-    (setq this-line (max 1 this-line))
-    (makefile-browser-toggle-state-for-line this-line)
-    (goto-line this-line)
-    (let ((inhibit-read-only t))
-      (beginning-of-line)
-      (if (makefile-browser-on-macro-line-p)
-	  (let ((macro-name (makefile-browser-this-line-macro-name)))
-	    (delete-region (point) (progn (end-of-line) (point)))
-	    (insert
-	     (makefile-browser-format-macro-line
-		macro-name
-		(makefile-browser-get-state-for-line this-line))))
-	(let ((target-name (makefile-browser-this-line-target-name)))
-	  (delete-region (point) (progn (end-of-line) (point)))
-	  (insert
-	   (makefile-browser-format-target-line
-	      target-name
-	      (makefile-browser-get-state-for-line this-line))))))
-    (beginning-of-line)
-    (forward-char makefile-browser-cursor-column)
-    (if makefile-browser-auto-advance-after-selection-p
-	(makefile-browser-next-line))))
-
-;;;
-;;; Making insertions into the client buffer
-;;;
-
-(defun makefile-browser-insert-continuation ()
-  "Insert a makefile continuation.
-In the makefile buffer, go to (end-of-line), insert a \'\\\'
-character, insert a new blank line, go to that line and indent by one TAB.
-This is most useful in the process of creating continued lines when copying
-large dependencies from the browser to the client buffer.
-\(point) advances accordingly in the client buffer."
-  (interactive)
-  (save-excursion
-    (set-buffer makefile-browser-client)
-    (end-of-line)
-    (insert "\\\n\t")))
-
-(defun makefile-browser-insert-selection ()
-  "Insert all selected targets and/or macros in the makefile buffer.
-Insertion takes place at point."
-  (interactive)
-  (save-excursion
-    (goto-line 1)
-    (let ((current-line 1))
-      (while (not (eobp))
-	(if (makefile-browser-get-state-for-line current-line)
-	    (makefile-browser-send-this-line-item))
-	(forward-line 1)
-	(setq current-line (1+ current-line))))))
-
-(defun makefile-browser-insert-selection-and-quit ()
-  (interactive)
-  (makefile-browser-insert-selection)
-  (makefile-browser-quit))
-
-(defun makefile-browser-send-this-line-item ()
-  (if (makefile-browser-on-macro-line-p)
-      (save-excursion
-	(let ((macro-name (makefile-browser-this-line-macro-name)))
-	  (set-buffer makefile-browser-client)
-	  (insert (makefile-format-macro-ref macro-name) " ")))
-    (save-excursion
-      (let ((target-name (makefile-browser-this-line-target-name)))
-	(set-buffer makefile-browser-client)
-	(insert target-name " ")))))
-
-(defun makefile-browser-start-interaction ()
-  (use-local-map makefile-browser-map)
-  (setq buffer-read-only t))
-
-(defun makefile-browse (targets macros)
-  (if (zerop (+ (length targets) (length macros)))
-      (progn
-	(beep)
-	(message "No macros or targets to browse! Consider running 'makefile-pickup-everything\'"))
-    (let ((browser-buffer (get-buffer-create makefile-browser-buffer-name)))
-	(pop-to-buffer browser-buffer)
-	(make-variable-buffer-local 'makefile-browser-selection-vector)
-	(makefile-browser-fill targets macros)
-	(shrink-window-if-larger-than-buffer)
-	(setq makefile-browser-selection-vector
-	      (make-vector (+ (length targets) (length macros)) nil))
-	(makefile-browser-start-interaction))))
-
-(defun makefile-switch-to-browser ()
-  (interactive)
-  (run-hooks 'makefile-browser-hook)
-  (setq makefile-browser-client (current-buffer))
-  (makefile-pickup-targets)
-  (makefile-pickup-macros)
-  (makefile-browse makefile-target-table
-                   ;; take out the runtime macros which were added for completion sake -gk
-                   (set-difference makefile-macro-table makefile-runtime-macros-list)))
-
-
-
-;;; ------------------------------------------------------------
-;;; Up-to-date overview buffer
-;;; ------------------------------------------------------------
-
-(defun makefile-create-up-to-date-overview ()
-  "Create a buffer containing an overview of the state of all known targets.
-Known targets are targets that are explicitly defined in that makefile;
-in other words, all targets that appear on the left hand side of a
-dependency in the makefile."
-  (interactive)
-  (if (y-or-n-p "Are you sure that the makefile being edited is consistent? ")
-      ;;
-      ;; The rest of this function operates on a temporary makefile, created by
-      ;; writing the current contents of the makefile buffer.
-      ;;
-      (let ((saved-target-table makefile-target-table)
-	    (this-buffer (current-buffer))
-	    (makefile-up-to-date-buffer
-	     (get-buffer-create makefile-up-to-date-buffer-name))
-	    (filename (makefile-save-temporary))
-	    ;;
-	    ;; Forget the target table because it may contain picked-up filenames
-	    ;; that are not really targets in the current makefile.
-	    ;; We don't want to query these, so get a new target-table with just the
-	    ;; targets that can be found in the makefile buffer.
-	    ;; The 'old' target table will be restored later.
-	    ;;
-	    (real-targets (progn
-			    (makefile-pickup-targets)
-			    makefile-target-table))
-	    (prereqs makefile-has-prereqs)
-	    )
-
-	(set-buffer makefile-up-to-date-buffer)
-	(setq buffer-read-only nil)
-	(erase-buffer)
-	(makefile-query-targets filename real-targets prereqs)
-	(if (zerop (buffer-size))		; if it did not get us anything
-	    (progn
-	      (kill-buffer (current-buffer))
-	      (message "No overview created!")))
-	(set-buffer this-buffer)
-	(setq makefile-target-table saved-target-table)
-	(if (get-buffer makefile-up-to-date-buffer-name)
-	    (progn
-	      (pop-to-buffer (get-buffer makefile-up-to-date-buffer-name))
-	      (shrink-window-if-larger-than-buffer)
-	      (sort-lines nil (point-min) (point-max))
-	      (setq buffer-read-only t))))))
-
-(defun makefile-save-temporary ()
-  "Create a temporary file from the current makefile buffer."
-  (let ((filename (makefile-generate-temporary-filename)))
-    (write-region (point-min) (point-max) filename nil 0)
-    filename))				; return the filename
-
-(defun makefile-generate-temporary-filename ()
-  "Create a filename suitable for use in `makefile-save-temporary'.
-Be careful to allow brain-dead file systems (DOS, SYSV ...) to cope
-with the generated name!"
-  (let ((my-name (user-login-name))
-	(my-uid (int-to-string (user-uid))))
-    (concat "mktmp"
-	  (if (> (length my-name) 3)
-	      (substring my-name 0 3)
-	    my-name)
-	  "."
-	  (if (> (length my-uid) 3)
-	      (substring my-uid 0 3)
-	    my-uid))))
-
-(defun makefile-query-targets (filename target-table prereq-list)
-  "Fill the up-to-date overview buffer.
-Checks each target in TARGET-TABLE using `makefile-query-one-target-method'
-and generates the overview, one line per target name."
-  (insert
-   (mapconcat
-    (function (lambda (item)
-		(let* ((target-name (car item))
-		       (no-prereqs (not (member target-name prereq-list)))
-		       (needs-rebuild (or no-prereqs
-					  (funcall
-					   makefile-query-one-target-method
-					   target-name
-					   filename))))
-		  (format "\t%s%s"
-			  target-name
-			  (cond (no-prereqs "  .. has no prerequisites")
-				(needs-rebuild "  .. NEEDS REBUILD")
-				(t "  .. is up to date"))))
-		))
-    target-table "\n"))
-  (goto-char (point-min))
-  (delete-file filename))		; remove the tmpfile
-
-(defun makefile-query-by-make-minus-q (target &optional filename)
-  (not (zerop
-	(call-process makefile-brave-make nil nil nil
-		      "-f" filename "-q" target))))
-
-
-
-;;; ------------------------------------------------------------
-;;; Continuation cleanup
-;;; ------------------------------------------------------------
-
-(defun makefile-cleanup-continuations ()
-  (if (eq major-mode 'makefile-mode)
-      (if (and makefile-cleanup-continuations-p
-	       (not buffer-read-only))
-	  (save-excursion
-	    (goto-char (point-min))
-	    (while (re-search-forward "\\\\[ \t]+$" (point-max) t)
-	      (replace-match "\\" t t))))))
-
-
-;;; ------------------------------------------------------------
-;;; Warn of suspicious lines
-;;; ------------------------------------------------------------
-
-(defun makefile-warn-suspicious-lines ()
-  (let ((dont-save nil))
-    (if (and (eq major-mode 'makefile-mode)
-	     makefile-warn-suspicious-lines-p)  ; -gk
-	(let ((suspicious
-	       (save-excursion
-		 (goto-char (point-min))
-		 (re-search-forward
-		  "\\(^[\t]+$\\)\\|\\(^[ ]+[\t]\\)" (point-max) t))))
-	  (if suspicious
-	      (let ((line-nr (count-lines (point-min) suspicious)))
-		(setq dont-save
-		      (not (y-or-n-p
-			    (format "Suspicious line %d. Save anyway "
-				    line-nr))))))))
-    dont-save))
-	  
-
-
-;;; ------------------------------------------------------------
-;;; GNU make function support
-;;; ------------------------------------------------------------
-
-(defun makefile-insert-gmake-function ()
-  "Insert a GNU make function call.
-Asks for the name of the function to use (with completion).
-Then prompts for all required parameters."
-  (interactive)
-  (let* ((gm-function-name (completing-read
-			     "Function: "
-			     makefile-gnumake-functions-alist
-			     nil t nil))
-	 (gm-function-prompts
-	  (cdr (assoc gm-function-name makefile-gnumake-functions-alist))))
-    (if (not (zerop (length gm-function-name)))
-	(insert (makefile-format-macro-ref
-		 (concat gm-function-name " "
-			 (makefile-prompt-for-gmake-funargs
-			    gm-function-name gm-function-prompts)))
-		" "))))
-
-(defun makefile-prompt-for-gmake-funargs (function-name prompt-list)
-  (mapconcat
-   (function (lambda (one-prompt)
-	       (read-string (format "[%s] %s: " function-name one-prompt)
-			    nil)))
-   prompt-list
-   ","))
-
-
-
-;;; ------------------------------------------------------------
-;;; Utility functions
-;;; ------------------------------------------------------------
-
-(defun makefile-do-macro-insertion (macro-name)
-  "Insert a macro reference."
-  (if (not (zerop (length macro-name)))
-      (if (assoc macro-name makefile-runtime-macros-list)
-	  (insert "$" macro-name)
-	(insert (makefile-format-macro-ref macro-name)))))
-
-(defun makefile-remember-target (target-name &optional has-prereqs)
-  "Remember a given target if it is not already remembered for this buffer."
-  (if (not (zerop (length target-name)))
-      (progn
-      (if (not (assoc target-name makefile-target-table))
-	  (setq makefile-target-table
-		(cons (list target-name) makefile-target-table)))
-      (if has-prereqs
-	  (setq makefile-has-prereqs
-		(cons target-name makefile-has-prereqs))))))
-
-(defun makefile-remember-macro (macro-name)
-  "Remember a given macro if it is not already remembered for this buffer."
-  (if (not (zerop (length macro-name)))
-      (if (not (assoc macro-name makefile-macro-table))
-	  (setq makefile-macro-table
-		(cons (list macro-name) makefile-macro-table)))))
-
-(defun makefile-forward-after-target-colon ()
-  "Move point forward after inserting the terminating colon of a target.
-This acts according to the value of `makefile-tab-after-target-colon'."
-  (if makefile-tab-after-target-colon
-      (insert "\t")
-    (insert " ")))
-
-(defun makefile-browser-on-macro-line-p ()
-  "Determine if point is on a macro line in the browser."
-  (save-excursion
-    (beginning-of-line)
-    (re-search-forward "\\$[{(]" (makefile-end-of-line-point) t)))
-
-(defun makefile-browser-this-line-target-name ()
-  "Extract the target name from a line in the browser."
-  (save-excursion
-    (end-of-line)
-    (skip-chars-backward "^ \t")
-    (buffer-substring (point) (1- (makefile-end-of-line-point)))))
-
-(defun makefile-browser-this-line-macro-name ()
-  "Extract the macro name from a line in the browser."
-  (save-excursion
-    (beginning-of-line)
-    (re-search-forward "\\$[{(]" (makefile-end-of-line-point) t)
-    (let ((macro-start (point)))
-      (skip-chars-forward "^})")
-      (buffer-substring macro-start (point)))))
-
-(defun makefile-format-macro-ref (macro-name)
-  "Format a macro reference.
-Uses `makefile-use-curly-braces-for-macros-p'."
-  (if (or (char-equal ?\( (string-to-char macro-name))
-	  (char-equal ?\{ (string-to-char macro-name)))
-      (format "$%s" macro-name)
-    (if makefile-use-curly-braces-for-macros-p
-	(format "${%s}" macro-name)
-      (format "$(%s)" macro-name))))
-
-(defun makefile-browser-get-state-for-line (n)
-  (aref makefile-browser-selection-vector (1- n)))
-
-(defun makefile-browser-set-state-for-line (n to-state)
-  (aset makefile-browser-selection-vector (1- n) to-state))
-
-(defun makefile-browser-toggle-state-for-line (n)
-  (makefile-browser-set-state-for-line n (not (makefile-browser-get-state-for-line n))))
-
-(defun makefile-beginning-of-line-point ()
-  (save-excursion
-    (beginning-of-line)
-    (point)))
-
-(defun makefile-end-of-line-point ()
-  (save-excursion
-    (end-of-line)
-    (point)))
-
-(defun makefile-last-line-p ()
-  (= (makefile-end-of-line-point) (point-max)))
-
-(defun makefile-first-line-p ()
-  (= (makefile-beginning-of-line-point) (point-min)))
-
-
-
-;;; Support for other packages, like add-log and imenu.
-
-(defun makefile-add-log-defun ()
-  "Return name of target or variable assignment that point is in.
-If it isn't in one, return nil."
-  (save-excursion
-    (let (found)
-      (beginning-of-line)
-      ;; Scan back line by line, noticing when we come to a
-      ;; variable or rule definition, and giving up when we see
-      ;; a line that is not part of either of those.
-      (while (not found)
-	(cond
-	 ((looking-at makefile-macroassign-regex)
-	  (setq found (buffer-substring-no-properties (match-beginning 1)
-						      (match-end 1))))
-	 ((looking-at makefile-dependency-regex)
-	  (setq found (buffer-substring-no-properties (match-beginning 1)
-						      (match-end 1))))
-	 ;; Don't keep looking across a blank line or comment.  Give up.
-	 ((looking-at "$\\|#")
-	  (setq found 'bobp))
-	 ((bobp)
-	  (setq found 'bobp)))
-	(or found
-	    (forward-line -1)))
-      (if (stringp found) found))))
-
-;; XEmacs additions
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.ma?ke?\\'" . makefile-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\(GNU\\)?[Mm]akefile\\(\\.in\\)*\\'" . makefile-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.am\\'" . makefile-mode))
-;;;###autoload(add-to-list 'interpreter-mode-alist '("make" . makefile-mode))
-
-;; provide 'makefile for bug-compatibility
-(provide 'makefile)
-(provide 'make-mode)
-;;; make-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/mode-compile.el b/xemacs-packages/lisp/prog-modes/mode-compile.el
deleted file mode 100644
index ff4b2c3b..00000000
--- a/xemacs-packages/lisp/prog-modes/mode-compile.el
+++ /dev/null
@@ -1,2667 +0,0 @@
-;;; mode-compile.el ---  Smart command for compiling files
-;;                       according to major-mode.
-;;
-;;   Copyright (c) 1994 - 2003 heddy Boubaker C.E.N.A.
-;;
-;;   Author: Heddy Boubaker 
-;;   Maintainer: Heddy Boubaker 
-;;   Created: June 1994
-;;   Last modified: 2003/04/01 13:52:47
-;;   Version: 2.28
-;;   Keywords: compile, compilation, modes, languages
-;;   Tested for:
-;;     XEmacs (Lucid GNU Emacs) >= 19.10
-;;     Must work with FSF GNU Emacs > 19.31 ;-)
-;;     Do not work anymore for Emacsen <= 18
-;;   Ftp access:
-;;    archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/misc/mode-compile.el.Z
-;;   WWW access:
-;;    
-;;
-;; LCD Archive Entry:
-;; mode-compile|Heddy Boubaker|boubaker@cena.fr|
-;; Smart command for compiling files according to major-mode and more.|
-;; 2003/04/01 13:52:47|2.28|~/misc/mode-compile.el.Z|
-;;
-;;; This file is NOT part of GNU Emacs but the same permissions apply.
-;;
-;; GNU Emacs is free software; you can redistribute  it and/or modify it under
-;; the terms  of  the GNU General   Public License as   published  by the Free
-;; Software Foundation;    either version 2,   or (at  your option)  any later
-;; version.
-;;
-;; GNU Emacs  is distributed in  the hope that it will  be useful, but WITHOUT
-;; ANY  WARRANTY; without  even the  implied   warranty of MERCHANTABILITY  or
-;; FITNESS  FOR A PARTICULAR PURPOSE.  See  the GNU General Public License for
-;; more details.
-;;
-;; You  should have received a  copy of the GNU  General  Public License along
-;; with GNU Emacs; see the  file COPYING.  If  not, write to the Free Software
-;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-;;
-;; @ Purpose:
-;; ==========
-;;
-;;  Provide `mode-compile' function as a replacement  for the use of `compile'
-;;  command which  is  very dumb  for  creating its  compilation command (use
-;;  "make  -k" by default).  `mode-compile'  is  a layer  above `compile'; Its
-;;  purpose is mainly   to  build a  smart  compile-command for  `compile'  to
-;;  execute  it. This   compile-command is   built   according  to number   of
-;;  parameters:
-;;   - the major-mode.
-;;   - presence or not of a makefile in current directory.
-;;   - the buffer-file-name and extension.
-;;   - what is in the current buffer (`main' function,"#!/path/shell", ...).
-;;   - and more ... (see Commentary section below).
-;;  Most  of  these  parameters  are  highly customizable  through Emacs  Lisp
-;;  variables  (to be  set  in your  .emacs  or  through Customization  menu).
-;;  Running  mode-compile after   an  universal-argument (C-u)  allows  remote
-;;  compilations, user is  prompted  for a host name   to run the  compilation
-;;  command on.   Another  function  provided  is  `mode-compile-kill'   which
-;;  terminate a running compilation session launched by `mode-compile'.
-;;
-;; @ Installation:
-;; ===============
-;;
-;;   Byte compile this file (*) somewhere in your `load-path' and add in
-;;  your .emacs:
-;;  (autoload 'mode-compile "mode-compile"
-;;   "Command to compile current buffer file based on the major mode" t)
-;;  (global-set-key "\C-cc" 'mode-compile)
-;;  (autoload 'mode-compile-kill "mode-compile"
-;;   "Command to kill a compilation launched by `mode-compile'" t)
-;;  (global-set-key "\C-ck" 'mode-compile-kill)
-;;
-;;  By  default mode-compile is  very verbose  and  waits a  few seconds (1 by
-;;  default) after  each message for   the user to have  time  to read it. You
-;;  could      set           variables      `mode-compile-expert-p'        and
-;;  `mode-compile-reading-time'   to  change  this    behaviour.  On X-Windows
-;;  systems  setting the variable  `mode-compile-other-frame-p'  will create a
-;;  new frame and launch the compilation command in it.
-;;
-;;  (*) Don't take care of messages:
-;;        ** reference to free variable efs-remote-shell-file-name
-;;      This is perfectly normal ;-}. But if you know a way to avoid it let me
-;;      know.
-;;
-;; @ Bug Reports:
-;; ==============
-;;
-;;   To   report a  bug  please  use function `mode-compile-submit-bug-report'
-;;   Please note that this bug-report facility uses Barry Warsaw's reporter.el
-;;   which is part of GNU Emacs v19 and bundled with many  other packages.  If
-;;   needed, you can obtain a copy of reporter.el at the elisp-archive.
-;;
-;; @ Documentation:
-;; ================
-;;
-;;  This section will explain how the `compile-command' are built according to
-;;  the `major-mode' and how to  customize it.  The major modes `mode-compile'
-;;  currently known are:
-;;   - c-mode, c++-mode, makefile-mode, dired-mode, ada-mode, emacs-lisp-mode,
-;;     lisp-interaction-mode, sh-mode, csh-mode, fundamental-mode,  text-mode,
-;;     indented-text-mode     compilation-mode,  fortran-mode,    c?perl-mode,
-;;     zsh-mode java-mode, tcl-mode, python-mode
-;;  For other modes a default behaviour is provided.
-;;
-;;  When    running    `mode-compile'  or     `mode-compile-kill'   the  hooks
-;;  `mode-compile-(before|after)-(compile|kill)-hook'  are   executed.     The
-;;  current   buffer   could   be      automatically    saved    if    variable
-;;  `mode-compile-always-save-buffer-p' is  set  to   `t'.  ALL  the  modified
-;;  buffers could  be automatically saved if variable `mode-compile-save-all-p'
-;;  is set to `t'.
-;;
-;; @@ fundamental-mode, text-mode, indented-text-mode & UNKNOWN MODES:
-;;    *** THIS IS TOO THE DEFAULT BEHAVIOR FOR UNKNOWN MODES ***
-;;    Try to guess what the file is by:
-;;   - 1st looking at its name and extension (see variable
-;;     `mode-compile-filename-regexp-alist').
-;;   - 2nd looking at string "#!/path/shell" at first line to extract shell
-;;     to run the script with (see variable `mode-compile-shell-alist').
-;;   - 3rd looking at a makefile in current directory.
-;;   - then calling `compile' with the last compile command which is
-;;     asked to be edited by user ...
-;;   The `kill-compile' command is then bound dynamically (buffer-local).
-;;
-;; @@ compilation-mode:
-;;    Call `compile' with the last compile command.
-;;
-;; @@ makefile-mode:
-;;    The makefile is run with make through `compile' (user is prompted
-;;   for        the        rule         to      run,      see         variable
-;;   `mode-compile-preferred-default-makerule'  to  see how  a   default choice
-;;   could be selected).
-;;
-;; @@ emacs-lisp-mode, lisp-interaction-mode:
-;;    If the buffer is a .el file byte-compile it to produce a .elc file,
-;;   else  just  byte-compile  the   buffer  (this   don't  use  `compile' but
-;;   `byte-compile').
-;;
-;; @@ dired-mode:
-;;   Find a makefile   in   the directory and  run    make with  it   (like in
-;;   makefile-mode),  else try  to byte-recompile  all .el   files older than
-;;   their associated  .elc  files (unlike  `byte-recompile-directory' this is
-;;   not  recursive),  finally if  no  .el  files  are present ask compilation
-;;   command to  user by  calling  `default-compile'.  To  find  a  makefile a
-;;   regexp is provided which name is `mode-compile-makefile-regexp'.
-;;
-;; @@ sh-mode, csh-mode, zsh-mode:
-;;    Run "[cz]?sh" with debugging arguments as specified in
-;;   `[cz]?sh-dbg-flags' on the currently edited file.
-;;
-;; @@ c?perl-mode:
-;;    Run  file with "perl   -w"  (can step   through errors  with  compile's
-;;    `next-error' command).
-;;
-;; @@ tcl-mode:
-;;    Run     file  with "wish"  (can     step  through errors with compile's
-;;    `next-error' command).
-;;
-;; @@ c-mode, c++-mode:
-;;   First it try to see if there is a makefile in the directory, makefiles to
-;;   look for are  specified  by the variable  `mode-compile-makefile-regexp'.
-;;   If yes two cases could happen: there  is only one  makefile so use it, or
-;;   there is more  than one (sometimes when  you need to  write portable soft
-;;   you  could have  some makefiles by  system:  SunOs.make, HP.make ...), in
-;;   that case prompt to  user for choice  (with smart completion).   Once the
-;;   makefile has been selected  it extract the rules from  it and ask to user
-;;   to   choose  a   rule  to  make  (with  smart  completion,  see  variable
-;;   `mode-compile-preferred-default-makerule'  to  see  how  a default choice
-;;   could be selected).
-;;
-;;   There are some cases where no makefiles are  presents (YES I KNOW this is
-;;   bad  practice but you  sometimes have no  needs  to write a Makefile). In
-;;   that case the  function try  to build  the most intelligent   compilation
-;;   command by using the favourite  user C/C++ compiler: value of environment
-;;   variable "CC"  or "CXX"  or  first found,   in  the PATH,   of  compilers
-;;   specified in variable  `cc-compilers-list' or `c++-compilers-list'.  Then
-;;   it look for the  varenv "CFLAGS" of  "CXXFLAGS" to append to the compiler
-;;   command,        find            the     file         to          compile:
-;;   .(c|cc|C|cpp)  (see    *)   and   ask   for
-;;   confirmation.  If  you  really trust mode-compile   will build  the right
-;;   command  and  want to  bypass confirmation  you  could  set the  variable
-;;   `mode-compile-never-edit-command-p' to t.
-;;
-;;   (*) How to find :
-;;    In both case the command try to guess which file has to be compiled:
-;;   It's a trivial choice when current buffer file is a
-;;   .(c|C|cc|cpp... -any file with extension specified in
-;;   `cc-source-file-ext-list' or `c++-source-file-ext-list') file but
-;;   when it's a .(h|H|hh) file what to do?  The variable
-;;   `cc-companion-file-regexp' or `c++-companion-file-regexp' specify
-;;   how to find a .(c|C|cc|cpp...) file from a .(h|H|hh...); This is
-;;   done by appending .(c|C|cc|cpp) to
-;;   .  In c-mode with default value
-;;   it produce:
-;;      file.h, file_[Pp].h -> file.c
-;;      I sometimes use files _p.h to indicate that the file is a private header
-;;      file for a .c file.
-;;   In c++-mode with default value it produce:
-;;      file.hh, file_[Pp].hh -> file.cc
-;;      I sometimes use files _p.cc to indicate that the file is a private header
-;;      file for a .cc file.
-;;   The output of compilation will be a
-;;   .o file if no `main' function is
-;;   found inside or a  EXECUTABLE file
-;;   if `main' function found.
-;;
-;; @@ ada-mode:
-;;   Same  as c/c++-mode but  run Ada compiler on the  Ada file.  There are no
-;;   companion file and no way to find a main function in Ada.
-;;
-;; @@ fortran-mode:
-;;    Same as c-mode but run Fortran compiler on .[Ff](or)? files.
-;;
-;; @@ java-mode:
-;;    Same as c-mode but call "javac" without the -o option on .java files
-;;
-;; @@  python-mode:
-;;    Run file with "python" (can step through errors with compile's
-;;    `next-error' command).
-;;
-;; @@  message-mode:
-;;    Run `message-send'.
-;;
-;; @ WhatsNew:
-;; ===========
-;;
-;;  Support for cperl-mode
-;;  Require cl 
-;;
-;; @ Contributors/Helpers:
-;; =======================
-;;
-;;   Adrian Aichner 
-;;   "William A. Perkins" 
-;;   Bin Mu 
-;;   Gael MARZIOU 
-;;   Christian Motschke 
-;;   boris 
-;;   Edward Hartnett .
-;;   Hartmut MANZ .
-;;   Henry Guillaume .
-;;   Ian Young 
-;;   Ilya Zakharevich .
-;;   Kevin Broadey .
-;;   Lawrence R. Dodd .
-;;   Martin Jost .
-;;   Michael Welsh Duggan .
-;;   Rolf EBERT .
-;;   Scott Hofmann .
-;;   Stefan Schoef .
-;;   John W. Harwell  - JWH.
-;;
-;; @ ToDo:
-;; =======
-;;
-;;   Extending this to some others programming languages (modes).
-;;   Writing an Info documentation.
-;;   Contributors are greatly accepted (send me diffs and don't forget to
-;;   update documentation and all comments too please).
-;;   Maybe Using ange-ftp parse .netrc utilities for remote host and
-;;   user infos.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;; @ Requirements ;;;
-
-;; mode-compile is not a replacement for compile
-;; it is just a layer above it.
-(require 'compile)
-;;; For Emacs-Lisp files compilations
-(require 'byte-compile "bytecomp")
-;;; For easy macros
-(require 'backquote)
-(require 'cl)
-(load-library "cl-macs")
-;; Pretty print elisp
-(require 'pp)
-;;; Setting obsolete vars
-(eval-and-compile
-  (condition-case ()
-      (require 'obsolete)
-    (error nil))
-  (if (and (featurep 'obsolete) (fboundp 'define-obsolete-variable-alias))
-      nil ;; We've got what we needed
-    (defmacro define-obsolete-variable-alias (old new)
-      (` (progn (defalias (, old) (, new))
-                (put (, old) 'byte-obsolete-variable (, new)))
-         ))))
-;;; For using custom - stolen from w3-cus.el -
-(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))))))
-
-;; Custom groups
-(defgroup compilation nil
-  "Compilations from within Emacs variables."
-  :link '(url-link :tag "Author's Emacs Page"
-                   "http://www.tls.cena.fr/~boubaker/Emacs/")
-  :group 'tools
-  :group 'development)
-(defgroup compilation-lang nil
-  "Language specific compilation options."
-  :group 'languages
-  :group 'compilation)
-(defgroup compilation-script nil
-  "Scripts compilation options."
-  :group 'compilation)
-(defgroup compilation-elisp nil
-  "Emacs development compilation options."
-  :group 'lisp
-  :group 'compilation)
-
-;; @ User variables ;;;
-;; @@ Common variables to mode-compile for all modes ;;;
-
-(defcustom mode-compile-modes-alist
-  '((c-mode                . (cc-compile        kill-compilation))
-    (java-mode             . (java-compile      kill-compilation))
-    (c++-mode              . (c++-compile       kill-compilation))
-    (ada-mode              . (ada-compile       kill-compilation))
-    (fortran-mode          . (f77-compile       kill-compilation))
-    (dired-mode            . (dired-compile     kill-compilation))
-    (emacs-lisp-mode       . (elisp-compile     keyboard-quit)) ; I'm SURE IT'S NOT the best way
-    (lisp-interaction-mode . (elisp-compile     keyboard-quit)) ; to kill a byte-compilation.
-    (makefile-mode         . (makefile-compile  kill-compilation))
-    (sh-mode               . (sh-compile        kill-compilation))
-    (csh-mode              . (csh-compile       kill-compilation))
-    (zsh-mode              . (zsh-compile       kill-compilation))
-    (perl-mode             . (perl-compile      kill-compilation))
-    (cperl-mode            . (perl-compile      kill-compilation))
-    (tcl-mode              . (tcl-compile       kill-compilation)) ; JWH
-    (python-mode           . (python-compile    kill-compilation)) ; BM
-    ;(message-mode          . (message-compile   kill-compilation))
-    (fundamental-mode      . (guess-compile     nil)) ; bound dynamically
-    (text-mode             . (guess-compile     nil)) ; itou
-    (indented-text-mode    . (guess-compile     nil)) ; itou
-    (compilation-mode      . (default-compile   kill-compilation)))
-  "Assoc list of compile/kill functions for some known modes.
-
-Each element look like (MODE . (COMPILE-FUNCTION KILL-FUNCTION))
- `mode-compile' will call COMPILE-FUNCTION and `mode-compile-kill'
- KILL-FUNCTION if current major-mode is MODE.
-
-If you want to add or modify a COMPILE-FUNCTION and its associated
-KILL-FUNCTION for MODE and don't want to hack `mode-compile' you could
-do the following (it exists however a more subtle method for
-modifying, this is left as an exercise for the reader :-):
- (defun my-mode-compile() ...)
- (defun my-mode-compile-kill() ...)
- (setq mode-compile-modes-alist
-       (append '((my-mode . (my-mode-compile my-mode-compile-kill)))
-               mode-compile-modes-alist))"
-  :type '(repeat
-          (cons :tag "Association: mode/compilation functions"
-                (function :tag "Mode")
-                (list :tag "Compilation functions"
-                      (choice :tag "Function to run the compilation"
-                              (function-item :tag "Default" :value default-compile)
-                              (function-item :tag "Guess" :value guess-compile)
-                              (function-item :tag "Emacs lisp byte compilation" :value elisp-compile)
-                              (function :tag "Your choice, take care..."))
-                      (choice :tag "Function to kill a running compilation"
-                              (function-item :tag "Just kill" :value kill-compilation)
-                              (const :tag "Nothing -- use with guess-compile --" :value nil)
-                              (function-item :tag "To use with elisp-compile" :value keyboard-quit)
-                              ;; This item could not be selected due to a custom (hum) feature ...
-                              (function :tag "Your choice, take care..." :value nil)))))
-  :group 'compilation)
-
-(defcustom mode-compile-filename-regexp-alist
-  ;; These could be in auto-mode-alist. But if you are like me
-  ;; and don't like these modes (prefer to edit these kind of
-  ;; files in text-mode) this is a nice way to compile them
-  ;; without to be bored with their associated modes.
-  '((mode-compile-makefile-regexp . makefile-mode)
-    ("\\.sh$"                     . sh-mode)
-    ("\\.csh$"                    . csh-mode)
-    ("\\.zsh$"                    . zsh-mode))
-  "Assoc list of major-modes for some filenames regexp.
-
-Each element look like (REGEXP . MODE) This variable is really similar
-to `auto-mode-alist' in the fact that it associate a MODE to a REGEXP
-matching a filename. The only differences is that you are not obliged
-to have the specified MODE available to use it (`guess-compile' use
-it), the MODE is only a pointer to an association in
-`mode-compile-modes-alist' to get the COMPILE-FUNCTION and the
-KILL-FUNCTION. The REGEXP could be a form which evaluate to a string.
-
-To add a new filename regexp do the following:
- (setq mode-compile-filename-regexp-alist
-       (append '((my-filename-regexp . some-mode-mode-compile-know)
-               mode-compile-modes-alist))"
-  :type '(repeat
-          (cons :tag "Association: filename/mode"
-           (choice :tag "Filename regexp match"
-            (regexp :tag "Regexp as a string")
-            (symbol :tag "Variable containing the regexp")
-            (sexp :tag "Form which evaluate to a string"))
-           ;; I need to bind dynamically this with const, ideas??
-           ;;`(choice
-           ;; ,@(mapcar (lambda (x) `(const ,(car x))) mode-compile-modes-alist))))
-           (function :tag "Mode to use -- should be a valid association in mode-compile-modes-alist --")))
-  :group 'compilation)
-
-(defcustom mode-compile-shell-alist
-  '(("sh"     .  sh-mode)
-    ("csh"    .  csh-mode)
-    ("zsh"    .  zsh-mode)
-    ("perl"   .  perl-mode)
-    ("tcl"    .   tcl-mode) ; JWH
-    ("python" . python-mode)) ; BM
-  "Assoc list of compile function for some known shells.
-
-Each element look like (SHELL . MODE) This variable look like
-`auto-mode-alist' in the fact that it associate a MODE to a name; A
-SHELL name here. The main difference is that you are not obliged to
-have the specified MODE available to use it (`guess-compile' use it),
-the MODE is only a pointer to an association in `mode-compile-modes-alist'
-to get the COMPILE-FUNCTION and the KILL-FUNCTION.
-
-To add a new shell do the following:
- (setq mode-compile-filename-shell-alist
-       (append '((my-shell-name . some-mode-mode-compile-know)
-               mode-compile-modes-alist))"
-  :type '(repeat
-          (cons :tag "Association: shell name/mode"
-           (string :tag "Shell name")
-           ;; I need to bind dynamically this with const, ideas??
-           ;;`(choice
-           ;; ,@(mapcar (lambda (x) `(const ,(car x))) mode-compile-modes-alist))))
-           (function :tag "Mode to use -- should be a valid association in mode-compile-modes-alist --")))
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-make-program "make"
-  "*The `make' program used to process makefiles.
-
-If you have GNU make installed with name \"gmake\" use it."
-  :type 'string
-  :group 'compilation)
-
-(defcustom mode-compile-makefile-regexp
-  "\\(^[Mm]akefile\\|.*\\.[mM][aA]?[kK][eE]?\\.?.*$\\)"
-  "Regexp matching 'could be' makefiles filenames."
-  :type 'regexp
-  :group 'compilation)
-
-(defcustom mode-compile-makefile-backups-regexp
-  "\\(\\(~\\|\\.[bB][aA][cC]?[kK]\\)$\\)\\|\\(\\(^\\|/\\)[.,][^/]+$\\)"
-  "Regexp to find if a Makefile is a backup or not"
-  :type 'regexp
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-ignore-makefile-backups t
-  "*Tell mode compile to ignore makefiles backup files when selecting the Makefile to use."
-  :type 'boolean
-  :group 'compilation)
-
-;;;###autoload
-(defvar mode-compile-default-make-options "-k"
-  "Default options to give to `make'.")
-;;;###autoload
-(defcustom mode-compile-make-options (eval mode-compile-default-make-options)
-  "*Options to give to `make'.
-This could be any form evaluating to a string.
-
-Some people asked me a way to modify the make options every time a
-compilation command is launched, do that:
- (defun my-mode-compile-ask-make-options()
-   \"*Hook called by mode-compile, asking for make options.\"
-   (interactive)
-   (read-string \"Make options: \"
-                mode-compile-default-make-options))
- (setq mode-compile-make-options
-           'my-mode-compile-ask-make-options)"
-  :type '(choice
-          string
-          (sexp :tag "Form evaluating to a string"))
-  :group 'compilation)
-
-;; XEmacs change: backwards compatibility.
-;; APA: Make sure variable typo fix does not cause breakage!
-;; Keep this before the associated defcustom.
-(define-obsolete-variable-alias
-  'mode-compile-prefered-default-makerule
-  'mode-compile-preferred-default-makerule)
-
-;;;###autoload
-(defcustom mode-compile-preferred-default-makerule 'none
-  "*Default makerule you would like to see in minibuffer as a default choice
-when selecting the make rule to build.
-
-Possible values are:
-'none    -- let mode-compile deciding for you.
-'all     -- try hard to show you the \"all\" rule.
-'default -- try hard to show you the \"default\" rule.
-'file    -- try to show you the name of the file which will be
-            result of compilation.
-The 'none action is taken as default is something fail."
-  :type '(radio :tag "Symbol"
-                (const :tag "None - Let mode compile made the choice" :value none)
-                (const :tag "All - Show the \"all\" rule" :value all)
-                (const :tag "Default - Show the \"default\" rule" :value default)
-                (const :tag "File - Show the \"result file name\" rule" :value file))
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-ignore-makerule-regexp nil
-  "*Makefile rules which must be ignored when building completion list.
-
-For example if you want to remove all `files rules' set
-it to: \"\\\\.\\\\([aoc]\\\\|s[ao][.0-9]*\\\\)\". "
-  :type '(choice (const :tag "none" :value nil)
-                 (const :tag "The `all files' rule" :value "\\.\\([aoc]\\|s[ao][.0-9]*\\)")
-                 regexp)
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-save-all-p nil
-  "*Non-nil means save ALL the modified buffers without asking
-before launching compilation command."
-  :type 'boolean
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-always-save-buffer-p nil
-  "*Non-nil means save the current buffer without asking
-before launching compilation command."
-  :type 'boolean
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-never-edit-command-p nil
-  "*Non-nil means never ask to user to edit the compile command."
-  :type 'boolean
-  :group 'compilation)
-
-;; @@ Compilation in other frame vars ;;;
-(defgroup compilation-frame nil
-  "Compile in another frame variables."
-  :group 'frames
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-other-frame-p nil
-  "*Non-nil means compile in another frame.
-
-A new Emacs FRAME is created and the compilation command is executed
-in this other frame.  To specify the frame parameters see also
-variable `mode-compile-frame-parameters-alist'."
-  :type 'boolean
-  :group 'compilation-frame)
-
-(defcustom mode-compile-other-frame-name "COMPILATION"
-  "Name of mode-compile's other frame.
-
-This name could be used in your .Xdefaults or .Xresources file as:
-Emacs.MODE-COMPILE-OTHER-FRAME-NAME.resource_to_be_set: ..."
-  :type 'string
-  :group 'compilation-frame)
-
-(defconst mode-compile-default-frame-parameters
-  (list
-   (cons 'name   mode-compile-other-frame-name)
-   (cons 'width  85)  ; columns
-   (cons 'height 30)) ; lines
-   "Default parameters for mode-compile's other frame.")
-
-(defvar mode-compile-frame-parameters-alist
-  (purecopy mode-compile-default-frame-parameters)
-  "Parameters for the new Compilation Screen created
-if variable `mode-compile-other-frame-p' is non nil..
-
-See also variable `mode-compile-default-frame-parameters' and
-`mode-compile-other-frame-name'.
-
-For informations about Screen/Frame parameters see:
-- Info, Nodes: Lispref::Screen::Screen Parameters
-- GNU Emacs Lisp Reference Manual, chapter 26 p375: Frames.")
-
-;; @@ Hooks ;;;
-
-;;;###autoload
-(defcustom mode-compile-before-compile-hook nil
-  "Hook to be run before compile command is executed
-when `mode-compile' is invoked."
-  :type 'hook
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-after-compile-hook nil
-  "Hook to be run after compile command is executed
-when `mode-compile' is invoked."
-  :type 'hook
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-before-kill-hook nil
-  "Hook to be run before killing compile command is executed
-when `mode-compile-kill' is invoked."
-  :type 'hook
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-after-kill-hook nil
-  "Hook to be run after killing compile command is executed
-when `mode-compile-kill' is invoked."
-  :type 'hook
-  :group 'compilation)
-
-;; @@ System dependencies ;;;
-
-(defvar mode-compile-exe-file-ext
-  (cond
-   ((memq system-type '(ms-dos emx windows-95 windows-98 windows-nt)) ".exe")
-   (t ""))
-  "*Extension of executable files (with dot included)")
-
-(defvar mode-compile-dir-separator-char
-  (cond
-   ;; MSDOSish file systems
-   ((memq system-type '(ms-dos emx windows-95 windows-98 windows-nt)) "\\")
-   ;; Unixish file systems
-   (t "/"))
-  "*Separator char between directories")
-
-;; @@ Facilities variables ;;;
-
-;; XEmacs change: backwards compatibility.
-;; APA: Make sure variable typo fix does not cause breakage!
-;; Keep this before the associated defvar.
-(define-obsolete-variable-alias
-  'mode-compile-choosen-compiler
-  'mode-compile-chosen-compiler)
-
-;;;###autoload
-(defvar mode-compile-chosen-compiler nil
-  "*Global variable containing the name of the compiler
-which will be used for compiling without makefile.
-
- Could be used in combination with
- (cc|c++|ada|f77)-default-compiler-options
-to automatically choose the compiler specific options.
-
-example:
- (defun my-compiler-get-options()
-   (cond
-    ((string= mode-compile-chosen-compiler \"gcc\")
-      \"-Wall -pedantic-errors\")
-    ((string= mode-compile-chosen-compiler \"cc\")
-      \"cc options whatever they are...\")
-    (t
-     (message \"Don't know this compiler: %s\" mode-compile-chosen-compiler)
-     (read-string
-      (format \"Options for %s compiler: \" mode-compile-chosen-compiler)))))
-
-  (setq cc-default-compiler-options 'my-compiler-get-options)")
-
-;; @@ User level ;;;
-
-;;;###autoload
-(defcustom mode-compile-expert-p nil
-  "*Non nil means `mode-compile' will not speaks too much.
-
-See also variable variable mode-compile-reading-time."
-  :type 'boolean
-  :group 'compilation)
-
-;;;###autoload
-(defcustom mode-compile-reading-time 1
-  "*Seconds to wait in verbose mode after printing a message.
-
-In verbose mode mode-compile print too much messages that it is
-almost impossible to read them. Just setting this delay leave you the
-time to read all the messages. If you don't want any delay set it to
-`0'.
-
-See also function sit-for."
-  :type 'integer
-  :group 'compilation)
-
-
-;; @@ Remote compilation vars ;;;
-(defgroup compilation-remote nil
-  "Remote compilations options."
-  :group 'compilation)
-
-(defcustom mode-compile-remote-hosts-alist '()
-  "Alist of favourite hosts names and the username
-to use to log on (HOSTNAME . USERNAME).
-
-If USERNAME is a function it will be called with HOSTNAME as argument
-and should return an USERNAME string (for example you could use
-something like efs-get-user - not tested -), if it is nil the function
-user-login-name will be used."
-  :type '(repeat
-          (cons
-           (string :tag "Hostname")
-           (choice
-            (const :tag "We'll use \'user-login-name" :value nil)
-            (string :tag "Username")
-            (function :tag "Function which return USERNAME given a HOSTNAME" :value efs-get-user))))
-  :group 'compilation-remote)
-
-(defcustom mode-compile-remote-execute-command "rsh"
-  "The shell command used to run a command remotely.
-\"rsh\" is the only choice I know but I'm far to know everything...
-
- This variable is set automatically with the value of
-remote-shell-program or efs-remote-shell-file-name at load time."
-  :type 'string
-  :group 'compilation)
-(eval-when 'load
-  (cond
-   ((not (string= mode-compile-remote-execute-command "rsh"))
-    ;; user changed default
-    nil)
-   ;; Try to not multiply definitions of the same stuff
-   ;; in too many emacs lisp packages ...
-   ((and (boundp 'remote-shell-program) remote-shell-program)
-    (setq mode-compile-remote-execute-command remote-shell-program))
-   ((and (boundp 'efs-remote-shell-file-name) efs-remote-shell-file-name)
-    (setq mode-compile-remote-execute-command efs-remote-shell-file-name))
-   ))
-
-(defcustom mode-compile-remote-execute-set-host-arg ""
-  "Argument To set the remote host name to the
-mode-compile-remote-execute-command,
-
-None is required for \"rsh\"."
-  :type 'string
-  :group 'compilation-remote)
-
-(defcustom mode-compile-remote-execute-set-command-arg ""
-  "Argument to set the command to be run remotely to the
-mode-compile-remote-execute-command.
-
-None is required for \"rsh\"."
-  :type 'string
-  :group 'compilation-remote)
-
-(defcustom mode-compile-remote-execute-set-username-arg "-l"
-  "Argument to set the username under which we will log on
-on the remote host, to give to mode-compile-remote-execute-command."
-  :type 'string
-  :group 'compilation-remote)
-
-(defcustom mode-compile-remote-execute-misc-args ""
-  "Misc additional arguments to give to the
-mode-compile-remote-execute-command."
-  :type 'string
-  :group 'compilation-remote)
-
-
-
-;; @@ c-mode compile variables ;;;
-(defgroup compile-c nil
-  "C Compilation options."
-  :group 'c
-  :group 'compilation-lang)
-
-(defcustom cc-compilers-list '( "gcc" "c89" "acc" "cc" )
-  "List of user's favourite C compilers in order of preference."
-  :type '(repeat (string :tag "C Compiler name"))
-  :group 'compile-c)
-
-(defcustom cc-companion-file-regexp "\\(_[Pp]\\)?\\.[pP]?h"
-  "Regexp to find associated .c file from a .h."
-  :type 'regexp
-  :group 'compile-c)
-
-(defcustom cc-default-compiler "cc"
-  "*Default C compiler to use when everything else fails.
-
-This could be any form evaluating to a string, so you could map it to
-a function asking you interactively to choose the compiler.
-
-example:
- (defun my-choose-compiler()
-   (read-string \"C compiler: \"))
- (setq cc-compilers-list '()
-       cc-default-compiler 'my-choose-compiler)"
-  :type '(choice string function)
-  :group 'compile-c)
-
-(defcustom cc-compiler-varenv "CC"
-  "Varenv indicating the C compiler to use."
-  :type 'string
-  :group 'compile-c)
-
-(defcustom cc-cflags-varenv "CFLAGS"
-  "Varenv indicating the C compiler flags to use."
-  :type 'string
-  :group 'compile-c)
-
-(defcustom cc-source-ext-list '( "c" )
-  "Extensions for C compilable source files."
-  :type '(repeat string)
-  :group 'compile-c)
-
-(defcustom cc-headers-ext-list '( "h" )
-  "Extensions for C headers source files."
-  :type '(repeat string)
-  :group 'compile-c)
-
-(defcustom cc-default-compiler-options "-g"
-  "*Default options to give to the C compiler.
-
-This could be any form evaluating to a string.
-See `mode-compile-chosen-compiler' variable."
-  :type '(choice
-          string
-          (sexp :tag "Form evaluating to a string"))
-  :group 'compile-c)
-
-(defcustom cc-source-file-ext-regexp "\\.c"
-  "Regexp to find, from its name, if a C file is compilable."
-  :type 'string
-  :group 'compile-c)
-
-(defcustom cc-build-output-args t
-  "Build output-args for c-mode."
-  :type 'boolean
-  :group 'compile-c)
-
-(defcustom cc-object-file-ext "o"
-  "Extension of objects file (result of compilation)
-in c mode."
-  :type 'string
-  :group 'compile-c)
-
-
-
-;; @@ java-mode compile variables ;;;
-(defgroup compile-java nil
-  "Java compilation options."
-  :group 'compilation-lang)
-
-(defcustom java-compilers-list '( "javac" )
-  "List of user's favourite java compilers in order of preference."
-  :type '(repeat (string :tag "Java Compiler name"))
-  :group 'compile-java)
-
-(defcustom java-companion-file-regexp ""
-  "Regexp to find associated compilable Java companion file.
-
-This is useless in Java because there do not exist uncompilable files."
-  :type 'regexp
-  :group 'compile-java)
-
-(defcustom java-default-compiler "javac"
-  "*Default C compiler to use when everything else fails.
-
-This could be any form evaluating to a string, so you could map it to
-a function asking you interactively to choose the compiler.
-
-example:
- (defun my-choose-compiler()
-   (read-string \"Java compiler: \"))
- (setq java-default-compiler 'my-choose-compiler)."
-  :type '(choice string function)
-  :group 'compile-java)
-
-(defcustom java-compiler-varenv "JAVAC"
-  "Varenv indicating the C compiler to use."
-  :type 'string
-  :group 'compile-java)
-
-(defcustom java-cflags-varenv "JAVAC_FLAGS"
-  "Varenv indicating the C compiler flags to use."
-  :type 'string
-  :group 'compile-java)
-
-(defcustom java-source-ext-list '( "java" )
-  "Extensions for Java compilable source files."
-  :type '(repeat string)
-  :group 'compile-java)
-
-(defcustom java-headers-ext-list '( "java" )
-  "Extensions for Java source files."
-  :type '(repeat string)
-  :group 'compile-java)
-
-(defcustom java-default-compiler-options "-O"
-  "*Default options to give to the Java compiler.
-
-This could be any form evaluating to a string.  See
-`mode-compile-chosen-compiler' variable."
-  :type '(choice
-          string
-          (sexp :tag "Form evaluating to a string"))
-  :group 'compile-java)
-
-(defcustom java-source-file-ext-regexp "\\.java"
-  "Regexp to find, from its name, if a Java file is compilable."
-  :type 'regexp
-  :group 'compile-java)
-
-(defcustom java-build-output-args nil
-  "Don't build output-args for Java-mode."
-  :type 'boolean
-  :group 'compile-java)
-
-(defcustom java-object-file-ext "class"
-  "Extension of objects file (result of compilation)
-in java mode."
-  :type 'string
-  :group 'compile-java)
-
-
-
-;; @@ c++-mode compile variables ;;;
-(defgroup compile-c++ nil
-  "C++ compilation options"
-  :group 'compilation-lang)
-
-(defcustom c++-compilers-list '( "g++" "gcc" "CC" )
-  "List of user's favourite C++ compilers in order of preference."
-  :type '(repeat (string :tag "C++ Compiler name"))
-  :group 'compile-c++)
-
-(defcustom c++-companion-file-regexp "\\(_[Pp]\\)?\\.\\([pP]?[Hh][Hh]?\\|[Hh]\\+\\+?\\)"
-  "Regexp to find associated compilable C++ companion file
-from a header file."
-  :type 'regexp
-  :group 'compile-c++)
-
-(defcustom c++-default-compiler "CC"
-  "*Default C++ compiler to use when everything else fails..
-
-This could be any form evaluating to a string, so you could map it to
-a function asking you interactively to choose the compiler.
-
-example:
- (defun my-choose-compiler()
-   (read-string \"C++ compiler: \"))
- (setq c++-default-compiler 'my-choose-compiler)"
-  :type '(choice string function)
-  :group 'compile-c++)
-
-(defcustom c++-compiler-varenv "CXX"
-  "Varenv indicating the C++ compiler to use."
-  :type 'string
-  :group 'compile-c++)
-
-(defcustom c++-cflags-varenv "CXXFLAGS"
-  "Varenv indicating the C++ compiler flags to use."
-  :type 'string
-  :group 'compile-c++)
-
-(defcustom c++-source-ext-list '( "cc" "C" "CC" "cpp" "cxx" "c++" "c+" )
-  "Extensions for C++ compilable source files."
-  :type '(repeat string)
-  :group 'compile-c++)
-
-(defcustom c++-headers-ext-list '( "H" "hh" "HH" "h++" "h+" "h" "hpp" "hxx" )
-  "Extensions for C++ headers source files."
-  :type '(repeat string)
-  :group 'compile-c++)
-
-(defcustom c++-default-compiler-options "-g"
-  "*Default options to give to the C++ compiler.
-This could be any form evaluating to a string.  See
-`mode-compile-chosen-compiler' variable."
-  :type '(choice
-          string
-          (sexp :tag "Form evaluating to a string"))
-  :group 'compile-c++)
-
-(defcustom c++-source-file-ext-regexp "\\.\\(cc\\|CC?\\|c\\+\\+?\\|cpp\\|cxx\\)"
-  "Regexp to find, from its name, if a C++ file is compilable."
-  :type 'regexp
-  :group 'compile-c++)
-
-(defcustom c++-build-output-args t
-  "Build output-args for c++-mode."
-  :type 'boolean
-  :group 'compile-c++)
-
-(defcustom c++-object-file-ext "o"
-  "Extension of objects file (result of compilation)
-in c++ mode."
-  :type 'string
-  :group 'compile-c++)
-
-
-
-;; @@ ada-mode compile variables ;;;
-(defgroup compile-ada nil
-  "Ada compilation options"
-  :group 'compilation-lang)
-
-(defcustom ada-compilers-list
-  '( "gcc" "gnat" "ada" )
-  "List of user's favourite Ada compilers in order of preference."
-  :type '(repeat (string :tag "Ada Compiler name"))
-  :group 'compile-ada)
-
-(defcustom ada-companion-file-regexp ""
-  "Regexp to find associated compilable Ada companion file from a spec file.
-
-This is useless in Ada because there do not exist uncompilable files."
-  :type 'regexp
-  :group 'compile-ada)
-
-(defcustom ada-default-compiler "ada"
-  "*Default Ada compiler to use when everything else fails.
-
-This could be any form evaluating to a string, so you could map it to
-a function asking you interactively to choose the compiler.
-
-example:
- (defun my-choose-compiler()
-   (read-string \"Ada compiler: \"))
- (setq ada-default-compiler 'my-choose-compiler)"
-  :type '(choice string function)
-  :group 'compile-ada)
-
-(defcustom ada-compiler-varenv "ADA"
-  "Varenv indicating the Ada compiler to use."
-  :type 'string
-  :group 'compile-ada)
-
-(defcustom ada-aflags-varenv "AFLAGS"
-  "Varenv indicating the Ada compiler flags to use."
-  :type 'string
-  :group 'compile-ada)
-
-(defcustom ada-source-ext-list '( "ads" "adb" "ada" "a" )
-  "Extensions for Ada compilable source files."
-  :type '(repeat string)
-  :group 'compile-ada)
-
-(defcustom ada-headers-ext-list '( "ads" "ada" "a" )
-  "Extensions for Ada spec source files."
-  :type '(repeat string)
-  :group 'compile-ada)
-
-(defcustom ada-default-compiler-options "-g"
-  "*Default options to give to the Ada compiler.
-
-This could be any form evaluating to a string.  See
-`mode-compile-chosen-compiler' variable."
-  :type '(choice
-          string
-          (sexp :tag "Form evaluating to a string"))
-  :group 'compile-ada)
-
-(defcustom ada-source-file-ext-regexp "\\.\\(ad[abs]\\|a\\)"
-  "Regexp to find, from its name, if an Ada file is compilable.
-
-This is useless in Ada because there do not exist uncompilable files."
-  :type 'regexp
-  :group 'compile-ada)
-
-(defcustom ada-build-output-args t
-  "Build output-args for ada-mode."
-  :type 'boolean
-  :group 'compile-ada)
-
-(defcustom ada-object-file-ext "o"
-  "Extension of objects file (result of compilation)
-in ada mode."
-  :type 'string
-  :group 'compile-ada)
-
-
-
-;; @@ fortran-mode compile variables ;;;
-(defgroup compile-fortran nil
-  "Fortran compilation options"
-  :group 'compilation-lang)
-
-(defcustom f77-compilers-list '( "f77" "fc" )
-  "List of user's favourite Fortran compilers in order of preference."
-  :type '(repeat (string :tag "C Compiler name"))
-  :group 'compile-fortran)
-
-(defcustom f77-companion-file-regexp "\\(_[Pp]\\)?\\.[pP]?inc"
-  "Regexp to find associated .f file from a .inc."
-  :type 'regexp
-  :group 'compile-fortran)
-
-(defcustom f77-default-compiler "f77"
-  "*Default fortran compiler to use when everything else fails..
-
-This could be any form evaluating to a string, so you could map it to
-a function asking you interactively to choose the compiler.
-
-example:
- (defun my-choose-compiler()
-   (read-string \"Fortran compiler: \"))
- (setq f77-default-compiler 'my-choose-compiler)"
-  :type '(choice string function)
-  :group 'compile-fortran)
-
-(defcustom f77-compiler-varenv "F77"
-  "Varenv indicating the fortran compiler to use."
-  :type 'string
-  :group 'compile-fortran)
-
-(defcustom f77-cflags-varenv "FCOPTS"
-  "Varenv indicating the fortran compiler flags to use."
-  :type 'string
-  :group 'compile-fortran)
-
-(defcustom f77-source-ext-list '( "f" "F" "for" "For" )
-  "Extensions for fortran compilable source files."
-  :type '(repeat string)
-  :group 'compile-fortran)
-
-(defcustom f77-headers-ext-list '( "inc" "h")
-  "Extensions for fortran include files."
-  :type '(repeat string)
-  :group 'compile-fortran)
-
-(defcustom f77-default-compiler-options "-w66 -a"
-  "*Default options to give to the fortran compiler.
-
-This could be any form evaluating to a string.  See
-`mode-compile-chosen-compiler' variable."
-  :type '(choice
-          string
-          (sexp :tag "Form evaluating to a string"))
-  :group 'compile-fortran)
-
-(defcustom f77-source-file-ext-regexp "\\.\\([Ff]\\|for\\)"
-  "Regexp to find, from its name, if a fortran file is compilable."
-  :type 'regexp
-  :group 'compile-fortran)
-
-(defcustom f77-build-output-args t
-  "Build output-args for f77-mode."
-  :type 'boolean
-  :group 'compile-fortran)
-
-(defcustom f77-object-file-ext "o"
-  "Extension of objects file (result of compilation)
-in Fortran mode."
-  :type 'string
-  :group 'compile-fortran)
-
-
-
-;; @@ sh-mode compile variables ;;;
-(defgroup compile-sh nil
-  "Sh (Bourne Shell scripts) compilation options"
-  :group 'compilation-script)
-
-(defcustom sh-command "sh"
-  "Command to run sh scripts"
-  :type 'string
-  :group 'compile-sh)
-
-(defcustom sh-dbg-flags "-fvx"
-  "*Flags to give to sh for debugging a Bourne Shell script.
-
-The -f flag must always be present."
-  :type 'string
-  :group 'compile-sh)
-
-(defvar sh-compilation-error-regexp-alist nil
-  ;; I'd never seen a Bourne shell returning file+line where a syntax
-  ;; error occurred.
-  "Alist that specifies how to match errors in sh output.
-
-See variable compilation-error-regexp-alist for more details.")
-
-
-;; @@ csh-mode compile variables ;;;
-(defgroup compile-csh nil
-  "Csh (C Shell) compilation options"
-  :group 'compilation-script)
-
-(defcustom csh-command "csh"
-  "Command to run csh scripts"
-  :type 'string
-  :group 'compile-csh)
-
-(defcustom csh-dbg-flags "-fVX"
-  "*Flags to give to csh for debugging a C Shell script.
-
-The -f flag must always be present."
-  :type 'string
-  :group 'compile-csh)
-
-(defvar csh-compilation-error-regexp-alist nil
-  ;; I'd never seen a C shell returning file+line where a syntax
-  ;; error occurred.
-  "Alist that specifies how to match errors in csh output.
-
-See variable compilation-error-regexp-alist for more details.")
-
-
-;; @@ zsh-mode compile variables ;;;
-(defgroup compile-zsh nil
-  "Zsh (Z Shell scripts) compilation options"
-  :group 'compilation-script)
-
-(defcustom zsh-command "zsh"
-  "Command to run zsh scripts"
-  :type 'string
-  :group 'compile-zsh)
-
-(defcustom zsh-dbg-flags "-nCvx"
-  "*Flags to give to zsh for debugging a Z Shell script."
-  :type 'string
-  :group 'compile-zsh)
-
-(defvar zsh-compilation-error-regexp-alist nil
-  ;; I'd never seen a Z shell returning file+line where a syntax
-  ;; error occurred.
-  "Alist that specifies how to match errors in csh output.
-
-See variable compilation-error-regexp-alist for more details.")
-
-
-;; @@ tcl-mode compile variables - JWH ;;;
-(defgroup compile-tcl nil
-  "Tcl compilation options"
-  :group 'compilation-script)
-
-(defcustom tcl-command "wish"
-  "Command to run tcl scripts"
-  :type 'string
-  :group 'compile-tcl)
-
-(defcustom tcl-dbg-flags ""
-  "*Flags to give to tcl -- none."
-  :type 'string
-  :group 'compile-tcl)
-
-(defvar tcl-compilation-error-regexp-alist
-  ;; TK  (file "/directory-path/filename.tcl" line XY)
-  '(
-    ("file \"\\([^ ]+\\)\" line \\([0-9]+\\)[)]" 1 2)
-    )
-  "Alist that specifies how to match errors in tcl output.
-
-See variable compilation-error-regexp-alist for more details.")
-
-
-;; @@ python-mode compile variables - BM ;;;
-(defgroup compile-python nil
-  "Python compilation options"
-  :group 'compilation-script)
-
-(defcustom python-command "python"
-  "Command to run python scripts"
-  :type 'string
-  :group 'compile-python)
-
-(defcustom python-dbg-flags ""
-  "*Flags to give to python -- none."
-  :type 'string
-  :group 'compile-python)
-
-(defvar python-compilation-error-regexp-alist
-  ;; TK  (file "/directory-path/filename.tcl" line XY in ZZZ)
-  '(
-    ("File \"\\([^ ]+\\)\", line \\([0-9]+\\).*" 1 2)
-    )
-  "Alist that specifies how to match errors in python output.
-
-See variable compilation-error-regexp-alist for more details.")
-
-
-;; @@ perl-mode compile variables ;;;
-(defgroup compile-perl nil
-  "Perl compilation options"
-  :group 'compilation-script)
-
-(defcustom perl-command "perl"
-  "Command to run perl."
-  :type 'string
-  :group 'compile-perl)
-
-(defcustom perl-dbg-flags "-w"
-  "*Flags to give to perl for debugging a Perl script."
-  :type 'string
-  :group 'compile-perl)
-
-(defvar perl-compilation-error-regexp-alist
-  ;; Contributed by Martin Jost
-  '(
-    ;; PERL 4
-    ("in file \\([^ ]+\\) at line \\([0-9]+\\).*" 1 2)
-    ;; PERL 5   Blubber at FILE line XY,  line ab.
-    ("at \\([^ ]+\\) line \\([0-9]+\\)," 1 2)
-    ;; PERL 5   Blubber at FILE line XY.
-    ("at \\([^ ]+\\) line \\([0-9]+\\)." 1 2)
-    )
-  ;; This look like a paranoiac regexp: could anybody find a better one? (which WORK).
-  ;;'(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\.,]" 2 3))
-  "Alist that specifies how to match errors in perl output.
-
-See variable compilation-error-regexp-alist for more details.")
-
-
-;; @@ emacs lisp compile variables ;;;
-
-;; XEmacs change: backwards compatibility.
-;; APA: Moved this before the associated defcustom.
-(define-obsolete-variable-alias
-  'mode-compile-byte-compile-dir-interactive-p
-  'emacs-lisp-byte-compile-dir-interactive-p)
-
-;;;###autoload
-(defcustom emacs-lisp-byte-compile-dir-interactive-p t
-  "*Non-nil means when byte-compiling a directory ask for each file
-needing to be recompiled or not."
-  :type 'boolean
-  :group 'compilation-elisp)
-
-(defcustom emacs-lisp-sources-regexp
-  (cond
-   ((boundp 'emacs-lisp-file-regexp)
-    emacs-lisp-file-regexp)
-   (t
-    "\\.el$"))
-  "Regexp to find emacs lisp sources files."
-  :type 'regexp
-  :group 'compilation-elisp)
-
-(defcustom emacs-lisp-bytecomp-ext "c"
-  "Extension added to byte-compiled emacs sources files."
-  :type 'string
-  :group 'compilation-elisp)
-
-
-;; @@ Misc declarations ;;;
-
-;;;###autoload
-(defconst mode-compile-version "2.28"
-  "Current version of mode-compile package.
-
-mode-compile.el,v 2.28 2003/04/01 13:52:47 boubaker Exp
-Please send bugs-fixes/contributions/comments to boubaker@cena.fr")
-
-(defconst mode-compile-help-address "heddy.Boubaker@cena.fr"
-  "E-Mail address of mode-compile maintainer.")
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; @ No user modifiable stuff below this line ;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Save old compile function. In case someone will bound
-;; mode-compile on 'compile.
-(or (fboundp 'mc--compile-sav)
-    (if (fboundp 'compile)
-        (progn
-          (fset 'mc--compile-sav (symbol-function 'compile))
-          (put 'compile 'compile-saved-on-mc--compile-sav t))
-      (error "`compile' function not known to be defined...")))
-
-;; @@ Internals variables and constants ;;;
-
-;; Mode specific
-(defvar mc--comp-lst          nil) ; c-mode,c++-mode,ada-mode,fortran-mode
-(defvar mc--def-comp          nil) ; itou
-(defvar mc--compfile-regexp   nil) ; itou
-(defvar mc--comp-varenv       nil) ; itou
-(defvar mc--comp-options      nil) ; itou
-(defvar mc--cflags-varenv     nil) ; itou
-(defvar mc--source-ext-lst    nil) ; itou
-(defvar mc--head-ext-lst      nil) ; itou
-(defvar mc--source-ext-regexp nil) ; itou
-(defvar mc--build-op-args     nil) ; itou
-(defvar mc--outfile-ext       nil) ; itou
-
-;; remote stuff
-(defvar mc--efs-path-list       nil)
-(defvar mc--remote-host         nil)
-(defvar mc--remote-host-history nil)
-(defvar mc--remote-username     nil)
-(defvar mc--remote-command      nil)
-(defvar mc--remote-pathname     nil)
-
-;; Frames/Windows stuff
-(defvar mc--other-frame nil)
-(defvar mc--ws (or
-                (and (fboundp 'console-type) (console-type))
-                (and (fboundp 'device-type)  (device-type))
-                window-system))
-
-(defvar mc--compile-command nil)
-;; Compile command used when no makefile has been found.
-;; This variable is buffer local to keep history for read-string.
-;; Unfortunately not a real history, keep only memory of
-;; the last compile command used.
-(make-variable-buffer-local 'mc--compile-command)
-
-(defvar mc--kill-compile nil)
-;; kill-compile command bound dynamically by `guess-compile'.
-(make-variable-buffer-local 'mc--kill-compile)
-
-(defvar mc--selected-makefile nil)
-(defvar mc--selected-makefile-history nil)
-;; User selected makefile among the list, to run make with.
-;; This variable is buffer local to keep history for completing-read
-;; Unfortunately not a real history, keep only memory of
-;; the last makefile used.
-(make-variable-buffer-local 'mc--selected-makefile)
-
-(defvar mc--selected-makerule nil)
-(defvar mc--selected-makerule-history nil)
-;; User selected make rule to rebuild.
-;; This variable is buffer local to keep history for completing-read
-;; Unfortunately not a real history, keep only memory of
-;; the last makerule used.
-(make-variable-buffer-local 'mc--selected-makerule)
-
-(defconst mc--find-C-main-regexp
-  "^[ \t]*\\(int\\|void\\)?[ \t\n]*main[ \t\n]*\(+" )
-;; Regexp to find the main() function in a C/C++ file
-
-(defconst mc--makefile-rules-regexp
-  "^\n*\\([^.$ \t#\n][^$ \t#\n:]*\\)[ \t]*:")
-;; Regexp to extract makefiles rules.
-;; But only those not containing references to $(VARIABLES)
-;; and not starting with `.'
-
-(defvar mc--makefile-rules nil)
-;; List of all rules extracted from makefile
-(make-variable-buffer-local 'mc--makefile-rules)
-
-(defvar mc--mkfl-buffer-tick nil)
-;; Tick counter for the buffer at the time of the rules extraction.
-(make-variable-buffer-local 'mc--mkfl-buffer-tick)
-
-(defvar mc--shell-args nil)
-;; Shell arguments for the script to debug.
-;; This variable is buffer local to keep history for read-string.
-;; Unfortunately not a real history, keep only memory of
-;; the last shell arguments used.
-(make-variable-buffer-local 'mc--shell-args)
-
-;; nil in GNU FSF Emacs, >= 0 in GNU Lucid Emacs/XEmacs
-(defconst mc--lucid-emacs-p (or (string-match "Lucid"  emacs-version)
-                                (string-match "XEmacs" emacs-version)))
-
-;; @@ Internals functions and macros ;;;
-
-(if (not (fboundp 'defsubst))
-    ;; Emacs 18
-    (fset 'defsubst (symbol-function 'defun)))
-
-(defun mc--compile (compile-command)
-  ;; Call compile with the compile command
-  ;; but append the remote-command before
-  (if (null mc--remote-command)
-      ;; local compile
-      (mc--compile-sav compile-command)
-    ;; remote compile
-    (let ((thisdir (expand-file-name (or default-directory "~"))))
-      (mc--compile-sav
-       (concat
-        ;; The command to launch remote commands
-        mc--remote-command
-        ;; Change to this buffer directory ...
-        "'( cd " thisdir " ; "
-        ;; then run the compile command
-        compile-command " )'")))))
-
-(defsubst mc--msg (msg &rest args)
-  ;; Print MSG with ARGS and wait to let time to user
-  ;; to read the message in minibuffer.
-  (cond ((not mode-compile-expert-p)
-         (apply 'message (concat "mode-compile: " msg) args)
-         (sit-for mode-compile-reading-time))))
-
-(cond
- ;; Check available frames functions
- ((fboundp 'make-frame)
-  ;; GNU Emacs
-  (fset 'mc--make-frame         (symbol-function 'make-frame))
-  (fset 'mc--select-frame       (symbol-function 'select-frame))
-  (fset 'mc--frame-live-p       (symbol-function 'frame-live-p))
-  (fset 'mc--make-frame-visible (symbol-function 'make-frame-visible))
-  (fset 'mc--raise-frame        (symbol-function 'raise-frame)))
- ((fboundp 'make-screen)
-  ;; XEmacs
-  (fset 'mc--make-frame         (symbol-function 'make-screen))
-  (fset 'mc--select-frame       (symbol-function 'select-screen))
-  (fset 'mc--frame-live-p       (symbol-function 'screen-live-p))
-  (fset 'mc--make-frame-visible (symbol-function 'make-screen-visible))
-  (fset 'mc--raise-frame        (symbol-function 'raise-screen)))
- ((fboundp 'new-screen)
-  ;; Lucid Emacs/obsolete
-  (fset 'mc--make-frame         (symbol-function 'new-screen))
-  (fset 'mc--select-frame       (symbol-function 'select-screen))
-  (fset 'mc--frame-live-p       (symbol-function 'screen-live-p))
-  (fset 'mc--make-frame-visible (symbol-function 'make-screen-visible))
-  (fset 'mc--raise-frame        (symbol-function 'raise-screen))))
-
-(defsubst mc--funcall (command &rest params)
-  ;; Run command with params in another frame or not:
-  ;; only if user ask for it and if window system is X
-  ;; (maybe test window-system is set will be enough?).
-  (cond ((and (eq mc--ws 'x)
-              mode-compile-other-frame-p)
-         ;; switch to another frame
-         (mc--msg "Switching to another frame to compile...")
-         (let ((buffer   (current-buffer))
-               (win-attr (or mode-compile-frame-parameters-alist
-                             mode-compile-default-frame-parameters))
-               (frame   (cond ((fboundp 'mc--frame-live-p)
-                                (if (mc--frame-live-p mc--other-frame)
-                                    mc--other-frame
-                                  nil))
-                               (t
-                                (mc--msg "Don't know how to check frame existence.")
-                                nil))))
-           (cond ((fboundp 'mc--make-frame)
-                  (mc--select-frame (or frame
-                                         (setq mc--other-frame
-                                               (mc--make-frame win-attr))))
-                  ;; I really don't understand why the 3 following
-                  ;; are necessary (raise-frame must be enough?).
-                  (mc--make-frame-visible mc--other-frame)
-                  (mc--raise-frame        mc--other-frame)
-                  (switch-to-buffer        buffer))
-                 (t
-                  (mc--msg "Don't know how to create a new frame."))))))
-  ;; Just run the command with its parameters
-  (apply command params))
-
-(defun mc--byte-compile-buffer()
-  (if (fboundp 'byte-compile-buffer) (byte-compile-buffer)
-    ;; No byte-compile-buffer
-    ;; Save current-buffer in a temporary file and byte-compile it.
-    (let ((tmp-file (concat (or (getenv "TMPDIR")
-                                (concat mode-compile-dir-separator-char "tmp"))
-                            mode-compile-dir-separator-char (make-temp-name "mc--"))))
-      (save-restriction
-        (widen)
-        (write-region (point-min) (point-max) tmp-file)
-        (condition-case err
-            (byte-compile-file tmp-file)
-          ;; handler
-          (error (mc--msg "Failing to byte-compile %s, #error %s"
-                          (buffer-name) err)))
-        (delete-file tmp-file)
-        (let ((elc-file (concat tmp-file emacs-lisp-bytecomp-ext)))
-          (if (file-writable-p elc-file)
-              (condition-case err
-                  (delete-file elc-file)
-                ;; handler
-                (error (mc--msg "Failing to delete %s, #error %s"
-                                elc-file err)))))
-        (message nil))))) ; to clean minibuffer
-
-(fset 'mc--member
-      (if (fboundp 'member)
-          (symbol-function 'member)
-        ;; No member function
-        (function
-         (lambda (elt list)
-           (catch 'elt-is-member
-             (while list
-               (if (equal elt (car list))
-                   (throw 'elt-is-member list))
-               (setq list (cdr list))))))))
-
-(fset 'mc--run-hooks
-      (if (fboundp 'run-hooks)
-          (symbol-function 'run-hooks)
-        ;; No run-hooks
-        (function
-         (lambda (hooklist)
-           (mapcar '(lambda (x)
-                      ;; report an error if x not a function
-                      (funcall x))
-                   hooklist)))))
-
-(defsubst mc--read-string (prompt &optional initial-contents)
-  ;; On Lucid Emacs I use compile-history as 3rd argument but
-  ;; no history is possible with GNU emacs.
-  (if mc--lucid-emacs-p
-      (read-string prompt initial-contents 'compile-history)
-    (read-string prompt initial-contents)))
-
-(defmacro mc--eval (sym &optional arg)
-  ;; Evaluate symbol
-  (` (cond
-      ((and (symbolp (, sym))
-            (fboundp (, sym)))
-       (funcall (, sym) (, arg)))
-      (t
-       (eval (, sym))))))
-
-(defmacro mc--common-completion (alist)
-  ;; Return the greatest common string for all
-  ;; possible completions in alist.
-  (` (try-completion "" (, alist))))
-
-(defun mc--byte-recompile-files (files)
-  ;; Byte recompile all FILES which are older than their
-  ;; .elc files in the current directory
-  (let ((tmp-fl files))
-    (while (car-safe tmp-fl)
-      (let* ((el-file  (car tmp-fl))
-             (elc-file (concat el-file emacs-lisp-bytecomp-ext)))
-        (mc--msg "Checking file %s ..." el-file)
-        ;; is el-file newer than elc-file (if exists)
-        (if (and (file-newer-than-file-p el-file elc-file)
-                 (or (not emacs-lisp-byte-compile-dir-interactive-p)
-                     (y-or-n-p (format "byte-recompile file %s? " el-file))))
-            (condition-case err
-                (byte-compile-file el-file)
-              ;; handler
-              (error (mc--msg "Failing to byte-compile %s, #error %s"
-                              el-file err))))
-        (setq tmp-fl (cdr-safe tmp-fl))))
-    (mc--msg "All files processed")))
-
-(defun mc--which (file)
-  ;; Find an executable FILE in exec-path
-  (if (not (stringp file))
-      (error "mc--which: nil FILE arg"))
-  (if mc--lucid-emacs-p
-      ;; Some Emacsen don't have locate-file some have...
-      ;; Lucid have it in standard, some others (GNU) have it
-      ;; (add-on pkg) but the syntax is not always consistent...
-;      (locate-file file exec-path nil 1)
-      (locate-file file exec-path mode-compile-exe-file-ext 1)
-    (let ((tmp-p-lst  exec-path)
-          (found      nil)
-          (file-found nil))
-      (while (and (car-safe tmp-p-lst)
-                  (not (setq found
-                             (file-executable-p
-                              (setq file-found
-                                    (concat (car tmp-p-lst)
-                                            mode-compile-dir-separator-char
-                                            file
-                                            mode-compile-exe-file-ext))))))
-        (setq tmp-p-lst (cdr-safe tmp-p-lst)))
-      (if found file-found nil))))
-
-(defun mc--find-compiler ()
-  ;; Find user's favourite mode compiler
-  (mc--msg "Searching for your favourite %s compiler ..." mode-name)
-  (let ((tmp-comp-lst mc--comp-lst)
-        (compiler     nil))
-    (or (getenv mc--comp-varenv)
-        (progn
-          (while (and tmp-comp-lst
-                      (not (setq compiler
-                                 (mc--which (car tmp-comp-lst)))))
-            (setq tmp-comp-lst (cdr tmp-comp-lst)))
-          (file-name-nondirectory (or compiler (mc--eval mc--def-comp)))))))
-
-(defun mc--find-to-compile-file (&optional fname)
-  ;; Find the name of the file to compile.
-  (let ((file-name (or fname
-                       (buffer-file-name)
-                       (error "Compilation abort: Buffer %s has no filename."
-                              (buffer-name))))
-        (assoc-file nil)
-        (found      nil)
-        (pos        0))
-    (cond
-     ((string-match mc--source-ext-regexp file-name)
-      ;; buffer is a compilable file
-      (file-name-nondirectory file-name))
-
-     ((setq pos (string-match mc--compfile-regexp file-name))
-      ;; Buffer is not a compilable file, try to find associated
-      ;; compilable file.
-      (let ((tmp-ext-lst mc--source-ext-lst))
-        (mc--msg "Looking for a compilable companion file for %s..."
-                 (file-name-nondirectory file-name))
-        (while (and tmp-ext-lst
-                    (not (setq found
-                               (file-readable-p
-                                (setq assoc-file
-                                      (concat
-                                       (substring file-name 0 pos)
-                                       "." (car tmp-ext-lst)))))))
-          (setq tmp-ext-lst (cdr tmp-ext-lst))))
-      (if found
-          ;; A compilable companion source file found
-          (file-name-nondirectory assoc-file)
-        ;; No compilable companion source file found
-        (mc--msg "Couldn't find any compilable companion file for %s ..."
-                 (file-name-nondirectory file-name))
-        nil))
-
-     (t
-      ;; Buffer has an unknown file extension
-      ;; Could I be more cool?
-      (error "Compilation abort: Don't know how to compile %s."
-             (file-name-nondirectory file-name))))))
-
-(defun mc--guess-compile-result-fname (infile)
-  ;; Try to guess if outfile will be an object file or
-  ;; an executable file by grepping for `main()' in INFILE.
-  (let ((base-fname
-         (substring infile 0
-                    (string-match mc--source-ext-regexp infile))))
-    (save-excursion
-      ;; Create a temporary buffer containing infile contents
-      (set-buffer (find-file-noselect infile))
-      (save-excursion
-        (save-restriction
-          (widen)
-          (goto-char (point-min))
-          ;; Grep into tmp buffer for main function
-          ;; THIS WILL NOT WORK FOR PROGRAMMING LANGUAGES
-          ;; WHICH ARE NOT C DIALECTS:
-          ;; In non C-ish modes I hope this regexp will never be found :-(
-          (if (re-search-forward mc--find-C-main-regexp (point-max) t)
-              (concat base-fname mode-compile-exe-file-ext)
-            (concat base-fname "." mc--outfile-ext)))))))
-
-(defun mc--build-output-args (infile)
-  ;; Build output arguments for compile command by scanning INFILE.
-  (mc--msg "Looking into %s to build compile command ..." infile)
-  (let ((out-file (mc--guess-compile-result-fname infile)))
-    (concat (if (string-match
-                 (concat "\\." mc--outfile-ext "$")
-                 out-file)
-                ;; outfile will be an object file
-                " -c "
-              ;; outfile will be an executable file
-              " ")
-            "\"" infile "\" -o \"" out-file "\"")))
-
-(defun mc--set-remote-cmd (remote-host &optional username pathname)
-  ;; Check validity of remote-host or ask one to user
-  ;; Then build the first part of the remote command
-  (if (stringp remote-host)
-      ;; Arg is the remote host name
-      (let ((host-infos (assoc remote-host
-                               mode-compile-remote-hosts-alist)))
-        (setq mc--remote-host
-              remote-host)
-        (setq mc--remote-username
-              (or username
-                  (let ((usrnam (cdr host-infos)))
-                    (if usrnam
-                        (cond
-                         ((stringp usrnam)
-                          usrnam)
-                         ((functionp usrnam)
-                          ;; usrnam is a function call it with hostname arg
-                          (funcall usrnam mc--remote-host))
-                         (t
-                          ;; What's that??
-                          (mc--msg "%s is not a valid option using user-login-name" (pp-to-string usrnam))
-                          (user-login-name)))
-                      (user-login-name)))))
-        (setq mc--remote-pathname pathname)
-        ;; Add host to the user's list
-        (or host-infos
-            (setq mode-compile-remote-hosts-alist
-                  (append (list (list remote-host))
-                          mode-compile-remote-hosts-alist)))
-        ;; Prepare the command
-        (setq mc--remote-command
-              (concat
-               ;; "rsh host -l username"
-               mode-compile-remote-execute-command           " "
-               mode-compile-remote-execute-set-host-arg      " "
-               mc--remote-host                               " "
-               mode-compile-remote-execute-set-username-arg  " "
-               mc--remote-username                           " "
-               mode-compile-remote-execute-misc-args         " "
-               mode-compile-remote-execute-set-command-arg   " "
-                )))
-    ;; Arg is: Ask to user then check
-    (let ((rhost (completing-read
-                  "Remote host to compile to: "
-                  mode-compile-remote-hosts-alist
-                  nil nil
-                  ;; Initial contents
-                  (or mc--remote-host
-                      (car-safe (car-safe mode-compile-remote-hosts-alist)))
-                  mc--remote-host-history)))
-      (or (string= rhost "")
-          (mc--set-remote-cmd rhost)))))
-
-;(defmacro mc--makefile-test-p (makefile)
-;  (` (and (, makefile)
-;          (not (string-equal     (, makefile) ""))
-;          (not (file-directory-p (, makefile)))
-;          (file-readable-p       (, makefile)))))
-(defun mc--makefile-test-p (makefile)
-  (cond
-   ((or (not makefile)
-        (string-equal makefile ""))
-    (mc--msg "Empty makefile selection")
-    nil)
-   ((file-directory-p makefile)
-    (mc--msg "Makefile selection %s is a directory !!" makefile)
-    nil)
-   ((not (file-readable-p makefile))
-    (mc--msg "Makefile %s unreadable" makefile)
-    nil)
-   (t)))
-
-
-(if (not (fboundp 'buffer-modified-tick))
-    (fset 'buffer-modified-tick
-          ;; always indicate modified
-          (function
-           (lambda()
-             (if mc--mkfl-buffer-tick
-                 (+ mc--mkfl-buffer-tick 1)
-               1)))))
-
-(defun  mc--get-makefile-rules (makefile)
-  ;; Try to find if makefile's buffer has been modified
-  ;; since last rule extraction
-  (if (or (not mc--mkfl-buffer-tick)
-          (not (equal mc--mkfl-buffer-tick
-                      (buffer-modified-tick))))
-      (save-excursion
-        (save-restriction
-          (widen)
-          (goto-char (point-min))
-          (setq mc--mkfl-buffer-tick (buffer-modified-tick))
-          (setq mc--makefile-rules   nil)
-          (mc--msg "Extracting rules from %s ..." makefile)
-          ;; Grep into tmp buffer for makefile rules
-          (while (re-search-forward mc--makefile-rules-regexp nil t)
-            (let ((rule (buffer-substring
-                         (match-beginning 1)
-                         (match-end       1))))
-              ;; add rule to list if it don't match the ignore regexp
-              ;; and if not already in rules list.
-              (if (and
-                   (or (not mode-compile-ignore-makerule-regexp)
-                       (not (string-match
-                             mode-compile-ignore-makerule-regexp
-                             rule)))
-                   (not (mc--member rule mc--makefile-rules)))
-                  (setq mc--makefile-rules
-                        (append mc--makefile-rules
-                                (list rule))))))))
-    (mc--msg "Rules had already been extracted from %s ..." makefile))
-  ;; Always add an empty rule to allow `default' choice.
-  (append mc--makefile-rules '([])))
-
-(defun mc--makerule-completion (alist outfile &optional pref)
-  ;; Return the makerule completion according to the preferred
-  ;; default makerule
-  (let ((preference (or pref
-                        mode-compile-preferred-default-makerule)))
-    (mc--msg "Preferred makerule choice is '%s" preference)
-    (cond
-     ((eq preference 'none)
-      ;; Just show max common completion string to user
-      (or (mc--common-completion alist) ""))
-
-     ((eq preference 'all)
-      ;; Find the all rule or 'none
-      (if (assoc "all" alist) "all"
-        (mc--makerule-completion alist outfile 'none)))
-
-     ((eq preference 'file)
-      ;; The out file is preferred or 'none
-      (or outfile (mc--makerule-completion alist outfile 'none)))
-
-     ((eq preference 'default)
-      ;; Find the default rule or ""
-      (if (assoc "default" alist) "default" ""))
-
-     (t
-      ;; Invalid preference return 'none
-      (mc--msg "Invalid `mode-compile-preferred-default-makerule': '%s"
-               mode-compile-preferred-default-makerule)
-      (mc--makerule-completion alist outfile 'none)))))
-
-(defun mc--choose-makefile-rule (makefile &optional outfile)
-  ;; Choose the makefile rule and set it makefile local
-  (save-excursion
-    ;; Switch to makefile buffer
-    (set-buffer (find-file-noselect makefile))
-    (setq mc--selected-makerule
-          ;; Add the name of the out file to the makefile
-          ;; rules list if not already in.
-          (let* ((mk-rules-alist (mc--get-makefile-rules makefile))
-                 (choices        (mapcar '(lambda (x) (list x))
-                                         (if (or (not outfile)
-                                                 (mc--member outfile
-                                                             mk-rules-alist))
-                                             mk-rules-alist
-                                           (append mk-rules-alist
-                                                   (list outfile))))))
-            (completing-read
-             (if mode-compile-expert-p
-                 "Make rule: "
-               "Using `make', enter rule to rebuild ([TAB] to complete): ")
-             choices
-             nil nil
-             ;; initial contents
-             (or mc--selected-makerule
-                 (mc--makerule-completion choices outfile
-                                          (if outfile 'file)))
-             mc--selected-makerule-history
-             )))))
-
-(defmacro mc--cleanup-makefile-list (makefile-list)
-  ;; Remove unusable and/or backups makefiles from list
-  (` (let ((newlist))
-       (mapcar
-        '(lambda (x)
-           (if (and (mc--makefile-test-p x)
-                    (or (not mode-compile-ignore-makefile-backups)
-                        (not (string-match
-                              mode-compile-makefile-backups-regexp
-                              x))))
-               (setq newlist (cons x newlist))
-             (mc--msg "Removing makefile \"%s\" from completion list"
-                      x)))
-        (, makefile-list))
-       newlist)))
-
-(defun mc--makefile-to-use (&optional directory)
-  ;; Find the makefile to use in the current directory
-  (let ((makefile-list (mc--cleanup-makefile-list
-                        (directory-files
-                         ;; I do not use the 5th parameter in Lucid Emacs
-                         ;; to be compatible with GNU Emacs which accept
-                         ;; only 4 parameters - no NOSORT -.
-                         (or directory default-directory)
-                         nil mode-compile-makefile-regexp t))))
-    (cond
-     ((not makefile-list)
-      ;; No makefile found
-      nil)
-
-     ((and (not (cdr-safe makefile-list))
-           (mc--makefile-test-p (car makefile-list)))
-      ;; Only one valid makefile
-      (car makefile-list))
-
-     (t
-      ;; Many makefiles in directory ask user to select one
-      (let ((choices  (mapcar
-                       '(lambda (x) (list x))
-                       makefile-list))
-            (makefile nil))
-        (while
-            ;; While the makefile do not pass the test.
-            (not (mc--makefile-test-p
-                  (setq makefile
-                        (completing-read
-                         (if mode-compile-expert-p
-                             "Makefile: "
-                           "Using `make', select makefile to use ([TAB] to complete): ")
-                         choices
-                         nil t
-                         ;; initial contents
-                         (or mc--selected-makefile
-                             (mc--common-completion choices))
-                         mc--selected-makefile-history
-                         )))))
-        makefile)))))
-
-(defun mc--set-command (&optional file)
-  ;; Return a compilation command, built according to the existence
-  ;; of a makefile or not, to compile FILE .
-  (setq completion-ignore-case nil) ; let completion be case sensitive
-  (let ((to-compile-fname (or file (mc--find-to-compile-file))))
-    (if (setq mc--selected-makefile (mc--makefile-to-use))
-        (progn
-          ;; A makefile found in the directory:
-          ;; using make to compile
-          (let ((out-fname (if to-compile-fname
-                               (mc--guess-compile-result-fname
-                                to-compile-fname)
-                             nil)))
-            ;; build make command by asking rule to user
-            (concat mode-compile-make-program " "
-                    (or (mc--eval mode-compile-make-options) "")
-                    " -f \"" mc--selected-makefile "\" "
-                    (mc--choose-makefile-rule
-                     mc--selected-makefile out-fname))))
-      ;; else
-      ;; No makefile: build compile command asking  for confirmation to user.
-      ;; Should this be replaced by the creation of a makefile (and then
-      ;; running it) as rms proposed me?
-      (or mc--compile-command
-          (setq mc--compile-command
-                (concat (setq mode-compile-chosen-compiler
-                              (mc--find-compiler)) " "
-                        (or (getenv mc--cflags-varenv)
-                            (mc--eval mc--comp-options))
-                        (if to-compile-fname
-                            (if mc--build-op-args
-				(mc--build-output-args to-compile-fname)
-			      (concat " " to-compile-fname)
-			      )
-                          " "))))
-      (if (not mode-compile-never-edit-command-p)
-          (setq mc--compile-command
-                (mc--read-string
-                 (if mode-compile-expert-p
-                     "Compile command: "
-                   (if to-compile-fname
-                       (format "Edit command to compile %s: "
-                               to-compile-fname)
-                     "Edit compile command: " ))
-                 mc--compile-command))
-        mc--compile-command))))
-
-(defun mc--shell-compile (shell dbgflags &optional errors-regexp-alist)
-  ;; Run SHELL with debug flags DBGFLAGS on current-buffer
-  (let* ((shcmd   (or (mc--which shell)
-                      (error "Compilation abort: command %s not found" shell)))
-         (shfile  (or mc--remote-pathname (buffer-file-name)
-                      (error "Compilation abort: Buffer %s has no filename"
-                             (buffer-name))))
-         (run-cmd (concat shcmd " " dbgflags " \"" shfile "\" "
-                          (setq mc--shell-args
-                                (read-string (if mode-compile-expert-p
-                                                 "Argv: "
-                                               (format "Arguments to %s %s script: "
-                                                       shfile shell))
-                                             mc--shell-args)))))
-    ;; Modify compilation-error-regexp-alist if needed
-    (if errors-regexp-alist
-        (progn
-          ;; Set compilation-error-regexp-alist from compile
-          (or (listp errors-regexp-alist)
-              (error "Compilation abort: In mc--shell-compile errors-regexp-alist not a list."))
-          ;; Add new regexp alist to compilation-error-regexp-alist
-          (mapcar '(lambda(x)
-                     (if (mc--member x compilation-error-regexp-alist) nil
-                       (setq compilation-error-regexp-alist
-                             (append (list x)
-                                     compilation-error-regexp-alist))))
-                  errors-regexp-alist)))
-    ;; Run compile with run-cmd
-    (mc--compile run-cmd)))
-
-(defmacro mc--assq-get-fcomp (asq)
-  ;; Return compile-function associated to ASQ
-  (` (let* ((mode  (cdr  (, asq)))
-            (massq (assq mode mode-compile-modes-alist)))
-       (if massq (car-safe (cdr massq))))))
-
-(defmacro mc--assq-get-fkill (asq)
-  ;; Return kill-compile-function associated to ASQ
-  (` (let* ((mode  (cdr  (, asq)))
-            (massq (assq mode mode-compile-modes-alist)))
-       (if massq (car-safe (cdr-safe (cdr massq)))))))
-
-(defun mc--lookin-for-shell ()
-  ;; Look into current-buffer to see if it is a shell script
-  ;; and return function to compile it or nil.
-  (mc--msg "Looking if buffer %s is a shell script..." (buffer-name))
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (if (looking-at "#![ \t]*/\\([^ \t\n]+/\\)\\([^ \t\n]+\\)")
-          (let* ((shell-name (buffer-substring (match-beginning 2)
-                                               (match-end       2)))
-                 (shell-assq (assoc shell-name mode-compile-shell-alist)))
-            (if shell-assq
-                (progn
-                  (mc--msg "Buffer is a %s script" shell-name)
-                  (setq mc--kill-compile (mc--assq-get-fkill shell-assq))
-                  (mc--assq-get-fcomp shell-assq))
-              nil))))))
-
-(defun mc--lookat-name ()
-  ;; Look at buffer file name to see if it can return a function
-  ;; to compile it or nil.
-  (mc--msg "Trying to guess compile command from buffer %s file name..."
-           (buffer-name))
-  (let ((fname (buffer-file-name)))
-    (if (not fname) nil
-      ;; try regexp from mode-compile-filename-regexp-alist
-      (let ((tmp-al mode-compile-filename-regexp-alist)
-            (found  nil))
-        (while (and tmp-al (car tmp-al) (not found))
-          ;; evaluate to string
-          (let ((regxp (mc--eval (car (car tmp-al)))))
-            (if (string-match regxp fname)
-                (setq found (car tmp-al)))
-            (setq tmp-al (cdr tmp-al))))
-        (if (not found)
-            nil
-          (mc--msg "File %s matches regexp %s" fname (car found))
-          (setq mc--kill-compile (mc--assq-get-fkill found))
-          (mc--assq-get-fcomp found))))))
-
-
-;; @ mode specific functions ;;;
-
-(defun cc-compile ()
-  "Run `compile' with a dynamically built command for `c-mode'.
-
-The command is built depending of the existence of a makefile (which could
-be specified by changing value of variable mode-compile-makefile-regexp) in
-the current directory or not.
-If no makefile is found try to run a C compiler on the file or its companion.
-
-See also variables:
- -- cc-compilers-list
- -- cc-default-compiler
- -- cc-companion-file-regexp
- -- cc-compiler-varenv
- -- cc-cflags-varenv
- -- cc-source-ext-list
- -- cc-headers-ext-list
- -- cc-source-file-ext-regexp"
-  (setq
-   mc--comp-lst          cc-compilers-list
-   mc--def-comp          cc-default-compiler
-   mc--compfile-regexp   cc-companion-file-regexp
-   mc--comp-varenv       cc-compiler-varenv
-   mc--comp-options      cc-default-compiler-options
-   mc--cflags-varenv     cc-cflags-varenv
-   mc--source-ext-lst    cc-source-ext-list
-   mc--head-ext-lst      cc-headers-ext-list
-   mc--source-ext-regexp cc-source-file-ext-regexp
-   mc--build-op-args     cc-build-output-args
-   mc--outfile-ext       cc-object-file-ext
-   )
-  (mc--compile (mc--set-command)))
-
-(defun java-compile ()
-  "Run `compile' with a dynamically built command for `java-mode'.
-
-The command is built depending of the existence of a makefile (which could
-be specified by changing value of variable mode-compile-makefile-regexp) in
-the current directory or not.
-If no makefile is found try to run a Java compiler on the file or its
-companion.
-
-See also variables:
- -- java-compilers-list
- -- java-default-compiler
- -- java-companion-file-regexp
- -- java-compiler-varenv
- -- java-cflags-varenv
- -- java-source-ext-list
- -- java-headers-ext-list
- -- java-source-file-ext-regexp"
-  (setq
-   mc--comp-lst          java-compilers-list
-   mc--def-comp          java-default-compiler
-   mc--compfile-regexp   java-companion-file-regexp
-   mc--comp-varenv       java-compiler-varenv
-   mc--comp-options      java-default-compiler-options
-   mc--cflags-varenv     java-cflags-varenv
-   mc--source-ext-lst    java-source-ext-list
-   mc--head-ext-lst      java-headers-ext-list
-   mc--source-ext-regexp java-source-file-ext-regexp
-   mc--build-op-args     java-build-output-args
-   mc--outfile-ext       java-object-file-ext
-   )
-  (mc--compile (mc--set-command)))
-
-(defun c++-compile ()
-  "Run `compile' with a dynamically built command for `c++-mode'.
-
-The command is built depending of the existence of a makefile (which could
-be specified by changing value of variable mode-compile-makefile-regexp) in
-the current directory or not.
-If no makefile is found try to run a C++ compiler on the file or its
-companion.
-
-See also variables:
- -- c++-compilers-list
- -- c++-default-compiler
- -- c++-companion-file-regexp
- -- c++-compiler-varenv
- -- c++-cflags-varenv
- -- c++-source-ext-list
- -- c++-headers-ext-list
- -- c++-source-file-ext-regexp"
-  (setq
-   mc--comp-lst          c++-compilers-list
-   mc--def-comp          c++-default-compiler
-   mc--compfile-regexp   c++-companion-file-regexp
-   mc--comp-varenv       c++-compiler-varenv
-   mc--comp-options      c++-default-compiler-options
-   mc--cflags-varenv     c++-cflags-varenv
-   mc--source-ext-lst    c++-source-ext-list
-   mc--head-ext-lst      c++-headers-ext-list
-   mc--source-ext-regexp c++-source-file-ext-regexp
-   mc--build-op-args     c++-build-output-args
-   mc--outfile-ext       c++-object-file-ext
-   )
-  (mc--compile (mc--set-command)))
-
-
-(defun ada-compile ()
-  "Run `compile' with a dynamically built command for `ada-mode'.
-
-The command is built depending of the existence of a makefile (which could
-be specified by changing value of variable mode-compile-makefile-regexp) in
-the current directory or not.
-If no makefile is found try to run an Ada compiler on the file.
-
-See also variables:
- -- ada-compilers-list
- -- ada-default-compiler
- -- ada-companion-file-regexp
- -- ada-compiler-varenv
- -- ada-aflags-varenv
- -- ada-source-ext-list
- -- ada-headers-ext-list
- -- ada-source-file-ext-regexp)"
-  (setq
-   mc--comp-lst          ada-compilers-list
-   mc--def-comp          ada-default-compiler
-   mc--compfile-regexp   ada-companion-file-regexp
-   mc--comp-varenv       ada-compiler-varenv
-   mc--comp-options      ada-default-compiler-options
-   mc--cflags-varenv     ada-aflags-varenv
-   mc--source-ext-lst    ada-source-ext-list
-   mc--head-ext-lst      ada-headers-ext-list
-   mc--source-ext-regexp ada-source-file-ext-regexp
-   mc--build-op-args     ada-build-output-args
-   mc--outfile-ext       ada-object-file-ext
-   )
-  (mc--compile (mc--set-command)))
-
-
-(defun f77-compile ()
-  "Run `compile' with a dynamically built command for `fortran-mode'.
-
-The command is built depending of the existence of a makefile (which could
-be specified by changing value of variable mode-compile-makefile-regexp) in
-the current directory or not.
-If no makefile is found try to run a Fortran compiler on the file or
-its companion..
-
-See also variables:
- -- f77-compilers-list
- -- f77-default-compiler
- -- f77-companion-file-regexp
- -- f77-compiler-varenv
- -- f77-cflags-varenv
- -- f77-source-ext-list
- -- f77-headers-ext-list
- -- f77-source-file-ext-regexp)"
-  (setq
-   mc--comp-lst          f77-compilers-list
-   mc--def-comp          f77-default-compiler
-   mc--compfile-regexp   f77-companion-file-regexp
-   mc--comp-varenv       f77-compiler-varenv
-   mc--cflags-varenv     f77-cflags-varenv
-   mc--comp-options      f77-default-compiler-options
-   mc--source-ext-lst    f77-source-ext-list
-   mc--head-ext-lst      f77-headers-ext-list
-   mc--source-ext-regexp f77-source-file-ext-regexp
-   mc--build-op-args     f77-build-output-args
-   mc--outfile-ext       f77-object-file-ext
-   )
-  (mc--compile (mc--set-command)))
-
-
-(defun elisp-compile ()
-  "Run `byte-compile' on the current Emacs lisp buffer.
-For `emacs-lisp-mode' and `lisp-interaction-mode'.
-
-Produce a `.elc' file if possible or `byte-compile' only the buffer."
-  (let ((comp-file (or (buffer-file-name) "")))
-    (if (string-match emacs-lisp-sources-regexp comp-file)
-        (progn
-          (mc--msg "Byte compiling file %s ..." comp-file)
-          (byte-compile-file comp-file))
-      (mc--msg "Byte compiling buffer %s #No .elc produced ..." (buffer-name))
-      (mc--byte-compile-buffer))))
-
-
-(defun makefile-compile (&optional makefile)
-  "Run `make' on the current-buffer (`makefile-mode').
-
-The user is prompted for a selection of make rules to build."
-  (let ((mkfile (or makefile (buffer-file-name)
-                    (error
-                     "Compilation abort: buffer %s has no file name"
-                     (buffer-name)))))
-    (setq mc--selected-makefile mkfile)
-    (setq mc--compile-command
-          (concat mode-compile-make-program " "
-                  (or (mc--eval mode-compile-make-options) "")
-                  " -f \"" mkfile "\" "
-                  (mc--choose-makefile-rule mkfile))))
-    (mc--compile mc--compile-command))
-
-
-(defun dired-compile ()
-  "Run `make' if a Makefile is present in current directory (`dired-mode').
-
-The user is prompted for a selection of a makefile to choose if many
-matching `mode-compile-makefile-regexp' are present in the directory and
-for the make rules to build. If directory contain no makefile the function
-try to find if there are some un-byte-compiled .el files and recompile them
-if needed.
-Ask for the complete `compile-command' if no makefile and no .el files found."
-  (let ((makefile (mc--makefile-to-use)))
-    (if makefile
-        ;; Makefile exists, compile with it
-        (makefile-compile makefile)
-      ;; No makefile found look for some .el files
-      (mc--msg "No makefile found, looking for .el files ...")
-      (let ((el-files (directory-files
-                       default-directory nil emacs-lisp-sources-regexp)))
-        (if el-files
-            ;; Some .el files found byte-recompile them
-            (mc--byte-recompile-files el-files)
-          ;; No .el files ask compile command to user
-          (mc--msg "No .el files found in directory %s" default-directory)
-          (default-compile))))))
-
-
-(defun sh-compile ()
-  "Run `sh-command' (Bourne Shell) with `sh-dbg-flags' on current-buffer (`sh-mode').
-
-User is prompted for arguments to run his sh program with.
-If you want to step through errors set the variable `sh-compilation-error-regexp-alist'
-to a value understandable by compile's `next-error'.
-See variables compilation-error-regexp-alist or sh-compilation-error-regexp-alist."
-  (mc--shell-compile sh-command sh-dbg-flags sh-compilation-error-regexp-alist))
-
-
-(defun csh-compile ()
-  "Run `csh-command' (C Shell) with `csh-dbg-flags' on current-buffer (`csh-mode').
-
-User is prompted for arguments to run his csh program with.
-If you want to step through errors set the variable `csh-compilation-error-regexp-alist'
-to a value understandable by compile's `next-error'.
-See variables compilation-error-regexp-alist or csh-compilation-error-regexp-alist."
-  (mc--shell-compile csh-command csh-dbg-flags csh-compilation-error-regexp-alist))
-
-
-(defun zsh-compile ()
-  "Run `zsh-command' (Z Shell) with `zsh-dbg-flags' on current-buffer (`zsh-mode').
-
-User is prompted for arguments to run his zsh program with.
-If you want to step through errors set the variable `zsh-compilation-error-regexp-alist'
-to a value understandable by compile's `next-error'.
-See variables compilation-error-regexp-alist or zsh-compilation-error-regexp-alist."
-  (mc--shell-compile zsh-command zsh-dbg-flags zsh-compilation-error-regexp-alist))
-
-
-(defun perl-compile ()
-  "Run Perl with `perl-dbg-flags' on current-buffer (`perl-mode').
-
-User is prompted for arguments to run his perl program with.
-If you want to step through errors set the variable `perl-compilation-error-regexp-alist'
-to a value understandable by compile's `next-error'.
-See variables compilation-error-regexp-alist or perl-compilation-error-regexp-alist."
-  (mc--shell-compile perl-command perl-dbg-flags perl-compilation-error-regexp-alist))
-
-
-(defun tcl-compile ()
-  ;; JWH
-  "Run `tcl-command' with `tcl-dbg-flags' on current-buffer (`tcl-mode').
-
-User is prompted for arguments to run his Tcl/Tk program with.
-If you want to step through errors set the variable `tcl-compilation-error-regexp-alist'
-to a value understandable by compile's `next-error'.
-See variables compilation-error-regexp-alist or tcl-compilation-error-regexp-alist."
-  (mc--shell-compile tcl-command tcl-dbg-flags tcl-compilation-error-regexp-alist))
-
-
-(defun python-compile ()
-  ;; BM
-  "Run `python-command' with `python-dbg-flags' on current-buffer (`python-mode').
-
-User is prompted for arguments to run his Python program with.
-If you want to step through errors set the variable `python-compilation-error-regexp-alist'
-to a value understandable by compile's `next-error'.
-See variables compilation-error-regexp-alist or python-compilation-error-regexp-alist."
-  (mc--shell-compile python-command python-dbg-flags python-compilation-error-regexp-alist))
-
-
-(defun default-compile ()
-  "Default function invoked by `mode-compile' (\\[mode-compile])
-when everything else failed.
-
-Ask to user to edit `compile-command' and run `compile' (\\[compile]) with it."
-  (setq mc--compile-command
-        (mc--read-string
-         (if mode-compile-expert-p
-             "Compile command: "
-           (format "Edit command to compile %s : " (buffer-name)))
-         (or mc--compile-command compile-command)))
-  (mc--compile mc--compile-command))
-
-(defvar mc--makefile) ;; Just to avoid compiler warning
-(defun guess-compile ()
-  "Try to guess how to compile current-buffer.
-
-When the compile command could not be extrapolated from major-mode this function
-is called which try to guess from number of parameters which command to build.
-The steps to guess which command to use to compile are:
-  1st : Look into the file to check if it is a shell script
-        See variable mode-compile-shell-alist
-  2nd : Try to guess from the file name
-        See variable mode-compile-filename-regexp-alist
-  3rd : Look for a makefile in the current directory
-        See variable mode-compile-makefile-regexp
-  Last: Give up and ask user for the command to use
-        See function default-compile"
-  (mc--msg "Trying to guess how to compile buffer %s ..." (buffer-name))
-  (let ((mc--makefile))
-    (funcall
-     (or
-      ;; step 1
-      (mc--lookin-for-shell)
-      ;; step 2
-      (mc--lookat-name)
-      ;; step 3
-      (progn
-        (mc--msg "Looking for a makefile in current directory...")
-        (if (setq mc--makefile (mc--makefile-to-use
-                                (and (buffer-file-name)
-                                     (file-name-directory (buffer-file-name)))))
-            (progn
-              (setq mc--kill-compile 'kill-compilation)
-              ;; Byte-compiling says `makefile' is not referenced.
-              '(lambda () (makefile-compile mc--makefile)))))
-      ;; step 4
-      (progn
-        (mc--msg "Don't know how to compile %s, giving up..."
-                 (buffer-name))
-        (setq mc--kill-compile 'kill-compilation)
-        'default-compile)))))
-
-
-;; @ user accessible/exported function ;;;
-
-;; get reporter-submit-bug-report when byte-compiling
-(and (fboundp 'eval-when-compile)
-     (eval-when-compile (require 'reporter)))
-
-;;;###autoload
-(defun mode-compile-submit-bug-report ()
-  "*Submit via mail a bug report on mode-compile v2.27."
-  (interactive)
-  (and
-   (y-or-n-p "Do you REALLY want to submit a report on mode-compile? ")
-   (require 'reporter)
-   (reporter-submit-bug-report
-    mode-compile-help-address
-    (concat "mode-compile " mode-compile-version)
-    (list
-     ;; Interesting mode-compile variables
-     'mode-compile-modes-alist
-     'mode-compile-filename-regexp-alist
-     'mode-compile-shell-alist
-     'mode-compile-makefile-regexp
-     'mode-compile-make-program
-     'mode-compile-default-make-options
-     'mode-compile-make-options
-     'mode-compile-reading-time
-     'mode-compile-expert-p
-     'mode-compile-never-edit-command-p
-     'mode-compile-save-all-p
-     'mode-compile-always-save-buffer-p
-     'mode-compile-before-compile-hook
-     'mode-compile-after-compile-hook
-     'mode-compile-before-kill-hook
-     'mode-compile-after-kill-hook
-     'mode-compile-other-frame-p
-     'mode-compile-other-frame-name
-     'mode-compile-frame-parameters-alist
-     'mode-compile-preferred-default-makerule
-     'emacs-lisp-byte-compile-dir-interactive-p
-     ;; others variables
-     'features
-     'compilation-error-regexp-alist
-     'compile-command
-     )
-    nil
-    nil
-    "Dear Heddy,")))
-
-
-;;;###autoload
-(defun mode-compile (&optional remote-host)
-  "*Compile the file in the current buffer with a dynamically built command.
-
-The command is built according to the current major mode the function
-was invoked from.
-
-Running this command preceded by universal-argument (\\[universal-argument])
-allows remote compilation, the user is prompted for a host name to run the
-compilation command on.
-
-Currently know how to compile in:
- `c-mode' ,              -- function cc-compile.
- `java-mode' ,           -- function java-compile.
- `c++-mode',             -- function c++-compile.
- `ada-mode',             -- function ada-compile.
- `fortran-mode',         -- function f77-compile.
- `emacs-lisp-mode'       -- function elisp-compile.
- `lisp-interaction-mode' -- function elisp-compile.
- `makefile-mode'         -- function makefile-compile.
- `dired-mode'            -- function dired-compile.
- `sh-mode'               -- function sh-compile.
- `csh-mode'              -- function csh-compile.
- `zsh-mode'              -- function zsh-compile.
- `perl-mode'             -- function perl-compile.
- `cperl-mode'            -- function perl-compile.
- `tcl-mode'              -- function tcl-compile.
- `python-mode'           -- function python-compile.
- `fundamental-mode'      -- function guess-compile.
- `text-mode'             -- function guess-compile.
- `indented-text-mode'    -- function guess-compile.
- `compilation-mode'      -- function default-compile.
- The function `guess-compile' is called when mode is unknown.
-
-The variable `mode-compile-modes-alist' contain description of known
-modes.  The hooks variables `mode-compile-before-compile-hook' and
-`mode-compile-after-compile-hook' are run just before and after
-invoking the compile command of the mode.
-
-Use the command `mode-compile-kill' (\\[mode-compile-kill]) to abort a
-running compilation.
-
-Bound on \\[mode-compile]."
-  (interactive "P")
-  ;; reinit
-  (setq
-   mc--efs-path-list  nil
-   mc--remote-command nil)
-  (if remote-host
-      ;; Remote compilation asked
-      ;; prepare remote command
-      (mc--set-remote-cmd remote-host)
-    ;; Not asked but check buffer-file-name to see
-    ;; if it is not an efs file
-    (setq mc--efs-path-list (and (fboundp 'efs-ftp-path)
-                                 (buffer-file-name)
-                                 (efs-ftp-path (buffer-file-name))))
-    (and mc--efs-path-list (mc--set-remote-cmd
-                            (car mc--efs-path-list)
-                            (nth 1 mc--efs-path-list)
-                            (nth 2 mc--efs-path-list))))
-  (if (and mode-compile-always-save-buffer-p
-           (buffer-file-name))
-      ;; save-buffer already check if buffer had been modified
-      (save-buffer))
-  (if mode-compile-save-all-p (save-some-buffers t))
-  ;; Check if compile-command set as local variable
-  (if (and
-       (boundp 'compile-command)
-       (local-variable-p 'compile-command (current-buffer))
-       compile-command ; not null
-       (if mc--compile-command
-           (equal compile-command mc--compile-command)
-         t)
-       )
-      ;; Just ask user and go
-      (progn
-        (mc--run-hooks 'mode-compile-before-compile-hook)
-        (default-compile)
-        (mc--run-hooks 'mode-compile-after-compile-hook)
-        )
-    ;; Here is the real work
-    (let ((mode-elem (assq major-mode mode-compile-modes-alist)))
-      (if mode-elem
-          ;; known mode
-          (progn
-            (mc--msg (substitute-command-keys
-                      "Compiling in %s mode ... \\[mode-compile-kill] to kill.")
-                     mode-name)
-            (mc--run-hooks 'mode-compile-before-compile-hook)
-            ;; mc--funcall can launch the compilation
-            ;; in another frame.
-            (mc--funcall   (car (cdr mode-elem)))
-            (mc--run-hooks 'mode-compile-after-compile-hook))
-        ;; unknown mode: try to guess
-        (mc--msg (substitute-command-keys
-                  "Don't know how to compile in %s mode, guessing... \\[mode-compile-kill] to kill.")
-                 mode-name)
-        (mc--run-hooks 'mode-compile-before-compile-hook)
-        ;; mc--funcall can launch the compilation
-        ;; in another frame.
-        (mc--funcall   'guess-compile)
-        (mc--run-hooks 'mode-compile-after-compile-hook)))))
-
-(provide 'mode-compile)
-
-
-;;;###autoload
-(defun mode-compile-kill()
-  "*Kill the running compilation launched by `mode-compile' (\\[mode-compile]) \
-command.
-
-The compilation command is killed according to the current major mode
-the function was invoked from.
-
-Currently know how to kill compilations from:
- `c-mode' ,              -- function kill-compilation.
- `java-mode' ,           -- function kill-compilation.
- `c++-mode' ,            -- function kill-compilation.
- `ada-mode' ,            -- function kill-compilation.
- `fortran-mode' ,        -- function kill-compilation.
- `emacs-lisp-mode'       -- function keyboard-quit.
- `lisp-interaction-mode' -- function keyboard-quit.
- `makefile-mode'         -- function kill-compilation.
- `dired-mode'            -- function kill-compilation.
- `sh-mode'               -- function kill-compilation.
- `csh-mode'              -- function kill-compilation.
- `zsh-mode'              -- function kill-compilation.
- `perl-mode'             -- function kill-compilation.
- `cperl-mode'            -- function kill-compilation.
- `tcl-mode'              -- function kill-compilation.
- `python-mode'           -- function kill-compilation.
- `fundamental-mode'      -- Bound dynamically.
- `text-mode'             -- Bound dynamically.
- `indented-text-mode'    -- Bound dynamically.
- `compilation-mode'      -- function kill-compilation.
-
-The variable `mode-compile-modes-alist' contain description of ALL
-known modes.  The hooks variables `mode-compile-before-kill-hook' and
-`mode-compile-after-kill-hook' are run just before and after invoking
-the kill compile command of the mode.
-
-Bound on \\[mode-compile-kill]."
-  (interactive)
-  (let ((mode-elem (assq major-mode mode-compile-modes-alist)))
-    (if mode-elem
-        ;; known mode
-        (progn
-          (mc--run-hooks 'mode-compile-before-kill-hook)
-          (mc--msg "Killing compilation in %s mode..." mode-name)
-          (let ((killfun (or (car-safe (cdr (cdr mode-elem)))
-                             mc--kill-compile
-                             nil)))
-            (if killfun
-                ;; I don't call mc--funcall here caus' we don't need
-                ;; to switch to another frame to kill a compilation.
-                (funcall killfun)
-              (mc--msg "Unable to kill compilation in %s mode..." mode-name))
-            (mc--run-hooks 'mode-compile-after-kill-hook)))
-      ;; unknown mode
-      (mc--msg "Don't know how to kill compilation in %s mode"
-               mode-name))))
-
-(provide 'mode-compile-kill)
-
-
-
-;;; Local variables:
-;;; outline-regexp: ";; @+"
-;;; eval: (outline-minor-mode 1)
-;;; End:
-
-;;; mode-compile.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/modula2.el b/xemacs-packages/lisp/prog-modes/modula2.el
deleted file mode 100644
index 9efeb199..00000000
--- a/xemacs-packages/lisp/prog-modes/modula2.el
+++ /dev/null
@@ -1,583 +0,0 @@
-;;; modula2.el --- Modula-2 editing support package
-
-;; Author: Michael Schmidt  
-;;	Tom Perrine 
-;; Maintainer: FSF
-;; Keywords: languages
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: GNU Emacs 21.2.
-
-;; The authors distributed this without a copyright notice
-;; back in 1988, so it is in the public domain.  The original included
-;; the following credit:
-
-;; Author Mick Jordan
-;; amended Peter Robinson
-
-;;; Commentary:
-
-;; A major mode for editing Modula-2 code.  It provides convenient abbrevs
-;; for Modula-2 keywords, knows about the standard layout rules, and supports
-;; a native compile command.
-
-;;; Code:
-
-(defgroup modula2 nil
-  "Major mode for editing Modula-2 code."
-  :prefix "m2-"
-  :group 'languages)
-
-;;; Added by Tom Perrine (TEP)
-(defvar m2-mode-syntax-table nil
-  "Syntax table in use in Modula-2 buffers.")
-
-(defcustom m2-compile-command "m2c"
-  "Command to compile Modula-2 programs."
-  :type 'string
-  :group 'modula2)
-
-(defcustom m2-link-command "m2l"
-  "Command to link Modula-2 programs."
-  :type 'string
-  :group 'modula2)
-
-(defcustom m2-link-name nil
-  "Name of the Modula-2 executable."
-  :type '(choice (const nil) string)
-  :group 'modula2)
-
-(defcustom m2-end-comment-column 75
-  "*Column for aligning the end of a comment, in Modula-2."
-  :type 'integer
-  :group 'modula2)
-
-(if m2-mode-syntax-table
-    ()
-  (let ((table (make-syntax-table)))
-    (modify-syntax-entry ?\\ "\\" table)
-    (modify-syntax-entry ?\( ". 1" table)
-    (modify-syntax-entry ?\) ". 4" table)
-    (modify-syntax-entry ?* ". 23" 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)
-    (setq m2-mode-syntax-table table)))
-
-;;; Added by TEP
-(defvar m2-mode-map nil
-  "Keymap used in Modula-2 mode.")
-
-(if m2-mode-map ()
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\^i" 'm2-tab)
-    (define-key map "\C-cb" 'm2-begin)
-    (define-key map "\C-cc" 'm2-case)
-    (define-key map "\C-cd" 'm2-definition)
-    (define-key map "\C-ce" 'm2-else)
-    (define-key map "\C-cf" 'm2-for)
-    (define-key map "\C-ch" 'm2-header)
-    (define-key map "\C-ci" 'm2-if)
-    (define-key map "\C-cm" 'm2-module)
-    (define-key map "\C-cl" 'm2-loop)
-    (define-key map "\C-co" 'm2-or)
-    (define-key map "\C-cp" 'm2-procedure)
-    (define-key map "\C-c\C-w" 'm2-with)
-    (define-key map "\C-cr" 'm2-record)
-    (define-key map "\C-cs" 'm2-stdio)
-    (define-key map "\C-ct" 'm2-type)
-    (define-key map "\C-cu" 'm2-until)
-    (define-key map "\C-cv" 'm2-var)
-    (define-key map "\C-cw" 'm2-while)
-    (define-key map "\C-cx" 'm2-export)
-    (define-key map "\C-cy" 'm2-import)
-    (define-key map "\C-c{" 'm2-begin-comment)
-    (define-key map "\C-c}" 'm2-end-comment)
-    (define-key map "\C-j"  'm2-newline)
-    (define-key map "\C-c\C-z" 'suspend-emacs)
-    (define-key map "\C-c\C-v" 'm2-visit)
-    (define-key map "\C-c\C-t" 'm2-toggle)
-    (define-key map "\C-c\C-l" 'm2-link)
-    (define-key map "\C-c\C-c" 'm2-compile)
-    (setq m2-mode-map map)))
-
-(defcustom m2-indent 5 
-  "*This variable gives the indentation in Modula-2-Mode."
-  :type 'integer
-  :group 'modula2)
-  
-;;;###autoload
-(defun modula-2-mode ()
-  "This is a mode intended to support program development in Modula-2.
-All control constructs of Modula-2 can be reached by typing C-c
-followed by the first character of the construct.
-\\
-  \\[m2-begin] begin         \\[m2-case] case
-  \\[m2-definition] definition    \\[m2-else] else
-  \\[m2-for] for           \\[m2-header] header
-  \\[m2-if] if            \\[m2-module] module
-  \\[m2-loop] loop          \\[m2-or] or
-  \\[m2-procedure] procedure     Control-c Control-w with
-  \\[m2-record] record        \\[m2-stdio] stdio
-  \\[m2-type] type          \\[m2-until] until
-  \\[m2-var] var           \\[m2-while] while
-  \\[m2-export] export        \\[m2-import] import
-  \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
-  \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
-  \\[m2-compile] compile           \\[m2-next-error] next-error
-  \\[m2-link] link
-
-   `m2-indent' controls the number of spaces for each indentation.
-   `m2-compile-command' holds the command to compile a Modula-2 program.
-   `m2-link-command' holds the command to link a Modula-2 program."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map m2-mode-map)
-  (setq major-mode 'modula-2-mode)
-  (setq mode-name "Modula-2")
-  (make-local-variable 'comment-column)
-  (setq comment-column 41)
-  (make-local-variable 'm2-end-comment-column)
-  (set-syntax-table m2-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-;  (make-local-variable 'indent-line-function)
-;  (setq indent-line-function 'c-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "(* ")
-  (make-local-variable 'comment-end)
-  (setq comment-end " *)")
-  (make-local-variable 'comment-column)
-  (setq comment-column 41)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "/\\*+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'c-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults
-	'((m3-font-lock-keywords
-	   m3-font-lock-keywords-1 m3-font-lock-keywords-2)
-	  nil nil ((?_ . "w") (?. . "w") (?< . ". 1") (?> . ". 4")) nil
-	  ;; Obsoleted by Emacs 19.35 parse-partial-sexp's COMMENTSTOP.
-	  ;(font-lock-comment-start-regexp . "(\\*")
-	  ))
-  (run-hooks 'm2-mode-hook))
-
-;; Regexps written with help from Ron Forrester 
-;; and Spencer Allain .
-(defconst m3-font-lock-keywords-1
-  '(
-    ;;
-    ;; Module definitions.
-    ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-    ;;
-    ;; Import directives.
-    ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>"
-     (1 font-lock-keyword-face)
-     (font-lock-match-c-style-declaration-item-and-skip-to-next
-      nil (goto-char (match-end 0))
-      (1 font-lock-constant-face)))
-    ;;
-    ;; Pragmas as warnings.
-    ;; Spencer Allain  says do them as comments...
-    ;; ("<\\*.*\\*>" . font-lock-warning-face)
-    ;; ... but instead we fontify the first word.
-    ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend)
-    )
-  "Subdued level highlighting for Modula-3 modes.")
-
-(defconst m3-font-lock-keywords-2
-  (append m3-font-lock-keywords-1
-   (eval-when-compile
-     (let ((m3-types
-	    (regexp-opt
-	     '("INTEGER" "BITS" "BOOLEAN" "CARDINAL" "CHAR" "FLOAT" "REAL"
-	       "LONGREAL" "REFANY" "ADDRESS" "ARRAY" "SET" "TEXT"
-	       "MUTEX" "ROOT" "EXTENDED")))
-	   (m3-keywords
-	    (regexp-opt
-	     '("AND" "ANY" "AS" "BEGIN" "BRANDED" "BY" "CASE" "CONST" "DIV"
-	       "DO" "ELSE" "ELSIF" "EVAL" "EXCEPT" "EXIT" "FINALLY"
-	       "FOR" "GENERIC" "IF" "IN" "LOCK" "LOOP" "METHODS" "MOD" "NOT"
-	       "OBJECT" "OF" "OR" "OVERRIDES" "READONLY" "RECORD" "REF"
-	       "REPEAT" "RETURN" "REVEAL" "THEN" "TO" "TRY"
-	       "TYPE" "TYPECASE" "UNSAFE" "UNTIL" "UNTRACED" "VAR" "VALUE"
-	       "WHILE" "WITH")))
-	   (m3-builtins
-	    (regexp-opt
-	     '("ABS" "ADR" "ADRSIZE" "BITSIZE" "BYTESIZE" "CEILING"
-	       "DEC" "DISPOSE" "FIRST" "FLOOR" "INC" "ISTYPE" "LAST"
-	       "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD"
-	       "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL")))
-	   )
-       (list
-	;;
-	;; Keywords except those fontified elsewhere.
-	(concat "\\<\\(" m3-keywords "\\)\\>")
-	;;
-	;; Builtins.
-	(cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face)
-	;;
-	;; Type names.
-	(cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face)
-	;;
-	;; Fontify tokens as function names.
-	'("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*"
-	  (1 font-lock-keyword-face)
-	  (font-lock-match-c-style-declaration-item-and-skip-to-next
-	   nil (goto-char (match-end 0))
-	   (1 font-lock-function-name-face)))
-	;;
-	;; Fontify constants as references.
-	'("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face)
-	))))
-  "Gaudy level highlighting for Modula-3 modes.")
-
-(defvar m3-font-lock-keywords m3-font-lock-keywords-1
-  "Default expressions to highlight in Modula-3 modes.")
-
-;; We don't actually have different keywords for Modula-2.  Volunteers?
-(defconst m2-font-lock-keywords-1 m3-font-lock-keywords-1
-  "Subdued level highlighting for Modula-2 modes.")
-
-(defconst m2-font-lock-keywords-2 m3-font-lock-keywords-2
-  "Gaudy level highlighting for Modula-2 modes.")
-
-(defvar m2-font-lock-keywords m2-font-lock-keywords-1
-  "Default expressions to highlight in Modula-2 modes.")
-
-(defun m2-newline ()
-  "Insert a newline and indent following line like previous line."
-  (interactive)
-  (let ((hpos (current-indentation)))
-    (newline)
-    (indent-to hpos)))
-
-(defun m2-tab ()
-  "Indent to next tab stop."
-  (interactive)
-  (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
-
-(defun m2-begin ()
-  "Insert a BEGIN keyword and indent for the next line."
-  (interactive)
-  (insert "BEGIN")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-case ()
-  "Build skeleton CASE statement, prompting for the ."
-  (interactive)
-  (let ((name (read-string "Case-Expression: ")))
-    (insert "CASE " name " OF")
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* case " name " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-definition ()
-  "Build skeleton DEFINITION MODULE, prompting for the ."
-  (interactive)
-  (insert "DEFINITION MODULE ")
-  (let ((name (read-string "Name: ")))
-    (insert name ";\n\n\n\nEND " name ".\n"))
-  (previous-line 3))
-
-(defun m2-else ()
-  "Insert ELSE keyword and indent for next line."
-  (interactive)
-  (m2-newline)
-  (backward-delete-char-untabify m2-indent ())
-  (insert "ELSE")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-for ()
-  "Build skeleton FOR loop statement, prompting for the loop parameters."
-  (interactive)
-  (insert "FOR ")
-  (let ((name (read-string "Loop Initialiser: ")) limit by)
-    (insert name " TO ")
-    (setq limit (read-string "Limit: "))
-    (insert limit)
-    (setq by (read-string "Step: "))
-    (if (not (string-equal by ""))
-	(insert " BY " by))
-    (insert " DO")
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* for " name " to " limit " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-header ()
-  "Insert a comment block containing the module title, author, etc."
-  (interactive)
-  (insert "(*\n    Title: \t")
-  (insert (read-string "Title: "))
-  (insert "\n    Created:\t")
-  (insert (current-time-string))
-  (insert "\n    Author: \t")
-  (insert (user-full-name))
-  (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
-  (insert "*)\n\n"))
-
-(defun m2-if ()
-  "Insert skeleton IF statement, prompting for ."
-  (interactive)
-  (insert "IF ")
-  (let ((thecondition (read-string ": ")))
-    (insert thecondition " THEN")
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* if " thecondition " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-loop ()
-  "Build skeleton LOOP (with END)."
-  (interactive)
-  (insert "LOOP")
-  (m2-newline)
-  (m2-newline)
-  (insert "END (* loop *);")
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-module ()
-  "Build skeleton IMPLEMENTATION MODULE, prompting for ."
-  (interactive)
-  (insert "IMPLEMENTATION MODULE ")
-  (let ((name (read-string "Name: ")))
-    (insert name ";\n\n\n\nEND " name ".\n")
-    (previous-line 3)
-    (m2-header)
-    (m2-type)
-    (newline)
-    (m2-var)
-    (newline)
-    (m2-begin)
-    (m2-begin-comment)
-    (insert " Module " name " Initialisation Code "))
-  (m2-end-comment)
-  (newline)
-  (m2-tab))
-
-(defun m2-or ()
-  (interactive)
-  (m2-newline)
-  (backward-delete-char-untabify m2-indent)
-  (insert "|")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-procedure ()
-  (interactive)
-  (insert "PROCEDURE ")
-  (let ((name (read-string "Name: " ))
-	args)
-    (insert name " (")
-    (insert (read-string "Arguments: ") ")")
-    (setq args (read-string "Result Type: "))
-    (if (not (string-equal args ""))
-	(insert " : " args))
-    (insert ";")
-    (m2-newline)
-    (insert "BEGIN")
-    (m2-newline)
-    (m2-newline)
-    (insert "END ")
-    (insert name)
-    (insert ";")
-    (end-of-line 0)
-    (m2-tab)))
-
-(defun m2-with ()
-  (interactive)
-  (insert "WITH ")
-  (let ((name (read-string "Record-Type: ")))
-    (insert name)
-    (insert " DO")
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* with " name " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-record ()
-  (interactive)
-  (insert "RECORD")
-  (m2-newline)
-  (m2-newline)
-  (insert "END (* record *);")
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-stdio ()
-  (interactive)
-  (insert "
-FROM TextIO IMPORT 
-   WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
-   WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
-   WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
-   WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
-   WriteString, ReadString, WhiteSpace, EndOfLine;
-
-FROM SysStreams IMPORT sysIn, sysOut, sysErr;
-
-"))
-
-(defun m2-type ()
-  (interactive)
-  (insert "TYPE")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-until ()
-  (interactive)
-  (insert "REPEAT")
-  (m2-newline)
-  (m2-newline)
-  (insert "UNTIL ")
-  (insert (read-string ": ") ";")
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-var ()
-  (interactive)
-  (m2-newline)
-  (insert "VAR")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-while ()
-  (interactive)
-  (insert "WHILE ")
-  (let ((name (read-string ": ")))
-    (insert name " DO" )
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* while " name " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-export ()
-  (interactive)
-  (insert "EXPORT QUALIFIED "))
-
-(defun m2-import ()
-  (interactive)
-  (insert "FROM ")
-  (insert (read-string "Module: "))
-  (insert " IMPORT "))
-
-(defun m2-begin-comment ()
-  (interactive)
-  (if (not (bolp))
-      (indent-to comment-column 0))
-  (insert "(*  "))
-
-(defun m2-end-comment ()
-  (interactive)
-  (if (not (bolp))
-      (indent-to m2-end-comment-column))
-  (insert "*)"))
-
-(defun m2-compile ()
-  (interactive)
-  (compile (concat m2-compile-command " " (buffer-name))))
-
-(defun m2-link ()
-  (interactive)
-  (if m2-link-name
-      (compile (concat m2-link-command " " m2-link-name))
-    (compile (concat m2-link-command " "
-		     (setq m2-link-name (read-string "Name of executable: "
-						     (buffer-name)))))))
-
-(defun m2-execute-monitor-command (command)
-  (let* ((shell shell-file-name)
-	 (csh (equal (file-name-nondirectory shell) "csh")))
-    (call-process shell nil t t "-cf" (concat "exec " command))))
-
-(defun m2-visit ()
-  (interactive)
-  (let ((deffile nil)
-	(modfile nil)
-	modulename)
-    (save-excursion
-      (setq modulename
-	    (read-string "Module name: "))
-      (switch-to-buffer "*Command Execution*")
-      (m2-execute-monitor-command (concat "m2whereis " modulename))
-      (goto-char (point-min))
-      (condition-case ()
-	  (progn (re-search-forward "\\(.*\\.def\\) *$")
-		 (setq deffile (buffer-substring (match-beginning 1)
-						 (match-end 1))))
-	(search-failed ()))
-      (condition-case ()
-	  (progn (re-search-forward "\\(.*\\.mod\\) *$")
-		 (setq modfile (buffer-substring (match-beginning 1)
-						 (match-end 1))))
-	(search-failed ()))
-      (if (not (or deffile modfile))
-	  (error "I can find neither definition nor implementation of %s"
-		 modulename)))
-    (cond (deffile
-	    (find-file deffile)
-	    (if modfile
-		(save-excursion
-		  (find-file modfile))))
-	  (modfile
-	   (find-file modfile)))))
-
-(defun m2-toggle ()
-  "Toggle between .mod and .def files for the module."
-  (interactive)
-  (cond ((string-equal (substring (buffer-name) -4) ".def")
-	 (find-file-other-window
-	  (concat (substring (buffer-name) 0 -4) ".mod")))
-	((string-equal (substring (buffer-name) -4) ".mod")
-	 (find-file-other-window
-	  (concat (substring (buffer-name) 0 -4)  ".def")))
-	((string-equal (substring (buffer-name) -3) ".mi")
-	 (find-file-other-window
-	  (concat (substring (buffer-name) 0 -3)  ".md")))
-	((string-equal (substring (buffer-name) -3) ".md")
-	 (find-file-other-window
-	  (concat (substring (buffer-name) 0 -3)  ".mi")))))
-
-(provide 'modula2)
-
-;;; modula2.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/old-c-mode.el b/xemacs-packages/lisp/prog-modes/old-c-mode.el
deleted file mode 100644
index ec107c5e..00000000
--- a/xemacs-packages/lisp/prog-modes/old-c-mode.el
+++ /dev/null
@@ -1,2024 +0,0 @@
-;;; old-c-mode.el --- Old and fast mode for C code in XEmacs
-
-;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc.
-
-;; Maintainer: Ben Wing 
-;; Keywords: c
-
-;; 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:
-
-;; Ported from GNU Emacs 20.7.
-
-;; cc-mode is dog-slow on large files, even on my 700 MHz Pentium III.
-;; This version works with no problems on the XEmacs source code and is
-;; very very fast.
-
-;;; Original commentary:
-
-;; [[A smart editing mode for C code.  It knows a lot about C syntax and tries
-;; to position the cursor according to C layout conventions.  You can
-;; change the details of the layout style with option variables.  Load it
-;; and do M-x describe-mode for details.]]
-
-;;; Code:
-(defgroup old-c nil
-  "Old C code editing commands for Emacs."
-  ;; This group should have no parent.
-  ;; We don't want it to be loaded except on explicit request.
-  :prefix "c-")
-
-
-(defvar c-mode-abbrev-table nil
-  "Abbrev table in use in C mode.")
-(define-abbrev-table 'c-mode-abbrev-table ())
-
-(defvar c-mode-map (make-sparse-keymap)
-  "Keymap used in C mode.")
-
-(define-key c-mode-map "{" 'electric-c-brace)
-(define-key c-mode-map "}" 'electric-c-brace)
-(define-key c-mode-map ";" 'electric-c-semi)
-(define-key c-mode-map "#" 'electric-c-sharp-sign)
-(define-key c-mode-map ":" 'electric-c-terminator)
-(define-key c-mode-map "\e\C-h" 'mark-c-function)
-(define-key c-mode-map "\e\C-q" 'indent-c-exp)
-(define-key c-mode-map "\ea" 'c-beginning-of-statement)
-(define-key c-mode-map "\ee" 'c-end-of-statement)
-(define-key c-mode-map "\C-c\C-n" 'c-forward-conditional)
-(define-key c-mode-map "\C-c\C-p" 'c-backward-conditional)
-(define-key c-mode-map "\C-c\C-u" 'c-up-conditional)
-(define-key c-mode-map "\t" 'c-indent-command)
-(define-key c-mode-map "\C-c\C-q"  'c-indent-defun)
-(define-key c-mode-map "\C-c\C-\\" 'c-backslash-region)
-(define-key c-mode-map "\C-c\C-c"  'comment-region)
-
-(autoload 'c-macro-expand "cmacexp"
-  "Display the result of expanding all C macros occurring in the region.
-The expansion is entirely correct because it uses the C preprocessor."
-  t)
-
-;;; begin stuff from cc-mode
-
-(defun c-mode-menu (modestr)
-  (let ((m
- 	 '(["%_Comment Out Region"     comment-region
-	    (c-fn-region-is-active-p)]
- 	   ["%_Uncomment Region"
- 	    (comment-region (region-beginning) (region-end) '(4))
- 	    (c-fn-region-is-active-p)]
- 	   ["%_Fill Comment Paragraph" c-fill-paragraph t]
- 	   "---"
- 	   ["%_Indent Expression"      c-indent-exp
- 	    (memq (char-after) '(?\( ?\[ ?\{))]
- 	   ["Indent %_Line or Region"  c-indent-line-or-region t]
- 	   ["U%_p Conditional"         c-up-conditional t]
- 	   ["B%_ackward Conditional"   c-backward-conditional t]
- 	   ["F%_orward Conditional"    c-forward-conditional t]
- 	   ["Insert Matching %_Endif"  c-insert-matching-endif t]
- 	   ["Bac%_kward Statement"     c-beginning-of-statement t]
- 	   ["Fo%_rward Statement"      c-end-of-statement t]
- 	   "---"
- 	   ["%_Macro Expand Region"    c-macro-expand (c-fn-region-is-active-p)]
- 	   ["%_Backslashify"           c-backslash-region
- 	    (c-fn-region-is-active-p)]
- 	   ["U%_nbackslashify"
- 	    (c-backslash-region (region-beginning) (region-end) '(4))
- 	    (c-fn-region-is-active-p)]
- 	   )))
-    (or (featurep 'menu-accelerator-support)
- 	(setq m (mapcar #'(lambda (def)
- 			    (if (vectorp def)
- 				(aset def 0 (replace-in-string (aref def 0)
- 							       "%_" "")))
- 			    def)
- 			m)))
-    (cons modestr m)))
-
-(defun c-populate-syntax-table (table)
-  ;; Populate the syntax TABLE
-  ;; DO NOT TRY TO SET _ (UNDERSCORE) TO WORD CLASS!
-  (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 ?|  "."     table)
-  (modify-syntax-entry ?\' "\""    table)
-  ;; Set up block and line oriented comments.  The new C standard
-  ;; mandates both comment styles even in C, so since all languages
-  ;; now require dual comments, we make this the default.
-  (cond
-   ;; XEmacs 19 & 20
-   ((memq '8-bit c-emacs-features)
-    (modify-syntax-entry ?/  ". 1456" table)
-    (modify-syntax-entry ?*  ". 23"   table))
-   ;; Emacs 19 & 20
-   ((memq '1-bit c-emacs-features)
-    (modify-syntax-entry ?/  ". 124b" table)
-    (modify-syntax-entry ?*  ". 23"   table))
-   ;; incompatible
-   (t (error "CC Mode is incompatible with this version of Emacs"))
-   )
-  (modify-syntax-entry ?\n "> b"  table)
-  ;; Give CR the same syntax as newline, for selective-display
-  (modify-syntax-entry ?\^m "> b" table))
-
-(defvar c-mode-syntax-table nil
-  "Syntax table used in c-mode buffers.")
-(if c-mode-syntax-table
-    ()
-  (setq c-mode-syntax-table (make-syntax-table))
-  (c-populate-syntax-table c-mode-syntax-table))
-
-(defvar c-current-comment-prefix nil
-  "The current comment prefix regexp.
-Set from `c-comment-prefix-regexp' at mode initialization.")
-(make-variable-buffer-local 'c-current-comment-prefix)
-
-;(defcustom-c-stylevar c-comment-prefix-regexp
-(defcustom c-comment-prefix-regexp
-  '((pike-mode . "//+!?\\|\\**")
-    (other . "//+\\|\\**"))
-  "*Regexp to match the line prefix inside comments.
-This regexp is used to recognize the fill prefix inside comments for
-correct paragraph filling and other things.
-
-If this variable is a string, it will be used in all CC Mode major
-modes.  It can also be an association list, to associate specific
-regexps to specific major modes.  The symbol for the major mode is
-looked up in the association list, and its value is used as the line
-prefix regexp.  If it's not found, then the symbol `other' is looked
-up and its value is used instead.
-
-The regexp should match the prefix used in both C++ style line
-comments and C style block comments, but it does not need to match a
-block comment starter.  In other words, it should at least match
-\"//\" for line comments and the string in `c-block-comment-prefix',
-which is sometimes inserted by CC Mode inside block comments.  It
-should not match any surrounding whitespace.
-
-Note that CC Mode modifies other variables from this one at mode
-initialization, so you will need to do \\[c-mode] (or whatever mode
-you're currently using) if you change it in a CC Mode buffer."
-  :type '(radio
-	  (regexp :tag "Regexp for all modes")
-	  (list
-	   :tag "Mode-specific regexps"
-	   (set
-	    :inline t :format "%v"
-	    (cons :format "%v"
-		  (const :format "C     " c-mode) (regexp :format "%v"))
-	    (cons :format "%v"
-		  (const :format "C++   " c++-mode) (regexp :format "%v"))
-	    (cons :format "%v"
-		  (const :format "ObjC  " objc-mode) (regexp :format "%v"))
-	    (cons :format "%v"
-		  (const :format "Java  " java-mode) (regexp :format "%v"))
-	    (cons :format "%v"
-		  (const :format "IDL   " idl-mode) (regexp :format "%v"))
-	    (cons :format "%v"
-		  (const :format "Pike  " pike-mode) (regexp :format "%v")))
-	   (cons :format "    %v"
-		 (const :format "Other " other) (regexp :format "%v"))))
-  :group 'old-c)
-
-(defvar c-append-paragraph-start "$")
-(make-variable-buffer-local 'c-append-paragraph-start)
-(defconst c-Java-javadoc-paragraph-start
-  "\\(@[a-zA-Z]+\\>\\|$\\)")
-(defconst c-Pike-pikedoc-paragraph-start
-  "\\(@[a-zA-Z]+\\>\\([^{]\\|$\\)\\|$\\)")
-
-;; Regexp to append to paragraph-separate.
-(defvar c-append-paragraph-separate "$")
-(make-variable-buffer-local 'c-append-paragraph-separate)
-(defconst c-Pike-pikedoc-paragraph-separate c-Pike-pikedoc-paragraph-start)
-
-;;; end stuff from cc-mode
-
-(defcustom c-indent-level 2
-  "*Indentation of C statements with respect to containing block."
-  :type 'integer
-  :group 'old-c)
-(defcustom c-brace-imaginary-offset 0
-  "*Imagined indentation of a C open brace that actually follows a statement."
-  :type 'integer
-  :group 'old-c)
-(defcustom c-brace-offset 0
-  "*Extra indentation for braces, compared with other text in same context."
-  :type 'integer
-  :group 'old-c)
-(defcustom c-argdecl-indent 5
-  "*Indentation level of declarations of C function arguments."
-  :type 'integer
-  :group 'old-c)
-(defcustom c-label-offset -2
-  "*Offset of C label lines and case statements relative to usual indentation."
-  :type 'integer
-  :group 'old-c)
-(defcustom c-continued-statement-offset 2
-  "*Extra indent for lines not starting new statements."
-  :type 'integer
-  :group 'old-c)
-(defcustom c-continued-brace-offset 0
-  "*Extra indent for substatements that start with open-braces.
-This is in addition to `c-continued-statement-offset'."
-  :type 'integer
-  :group 'old-c)
-(defconst c-style-alist
-  '(("GNU"
-     (c-indent-level               .  2)
-     (c-argdecl-indent             .  5)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     .  0)
-     (c-label-offset               . -2)
-     (c-continued-statement-offset .  2))
-    ("K&R"
-     (c-indent-level               .  5)
-     (c-argdecl-indent             .  0)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     . -5)
-     (c-label-offset               . -5)
-     (c-continued-statement-offset .  5))
-    ("BSD"
-     (c-indent-level               .  4)
-     (c-argdecl-indent             .  4)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     . -4)
-     (c-label-offset               . -4)
-     (c-continued-statement-offset .  4))
-    ("C++"
-     (c-indent-level               .  4)
-     (c-argdecl-indent             .  0)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     . -4)
-     (c-label-offset               . -4)
-     (c-continued-statement-offset .  4)
-     (c-auto-newline               .  t))
-    ("Whitesmith"
-     (c-indent-level               .  4)
-     (c-argdecl-indent             .  4)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     .  0)
-     (c-label-offset               . -4)
-     (c-continued-statement-offset .  4))))
-
-(defcustom c-auto-newline nil
-  "*Non-nil means automatically newline before and after braces,
-and after colons and semicolons, inserted in C code.
-If you do not want a leading newline before braces then use:
-  (define-key c-mode-map \"{\" 'electric-c-semi)"
-  :type 'boolean
-  :group 'old-c)
-
-(defcustom c-tab-always-indent t
-  "*Non-nil means TAB in C mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used."
-  :type 'boolean
-  :group 'old-c)
-
-;;; Regular expression used internally to recognize labels in switch
-;;; statements.
-(defconst c-switch-label-regexp "case[ \t'/(]\\|default[ \t]*:")
-
-;; This is actually the expression for C++ mode, but it's used for C too.
-(defvar c-imenu-generic-expression
-  (`
-   ((nil
-     (,
-      (concat
-       "^"				  ; beginning of line is required
-       "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
-       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; type specs; there can be no
-       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; more than 3 tokens, right?
-
-       "\\("				  ; last type spec including */&
-       "[a-zA-Z0-9_:]+"
-       "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)"	  ; either pointer/ref sign or whitespace
-       "\\)?"				  ; if there is a last type spec
-       "\\("			      ; name; take that into the imenu entry
-       "[a-zA-Z0-9_:~]+"		      ; member function, ctor or dtor...
-					; (may not contain * because then
-					; "a::operator char*" would become "char*"!)
-       "\\|"
-       "\\([a-zA-Z0-9_:~]*::\\)?operator"
-       "[^a-zA-Z1-9_][^(]*"	      ; ...or operator
-       " \\)"
-       "[ \t]*([^)]*)[ \t\n]*[^	      ;]" ; require something other than a ; after
-					; the (...) to avoid prototypes.  Can't
-					; catch cases with () inside the parentheses
-					; surrounding the parameters
-					; (like "int foo(int a=bar()) {...}"
-
-       )) 6)
-    ("Class"
-     (, (concat
-	 "^"				   ; beginning of line is required
-	 "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
-	 "class[ \t]+"
-	 "\\([a-zA-Z0-9_]+\\)"                ; this is the string we want to get
-	 "[ \t]*[:{]"
-	 )) 2)
-;; Example of generic expression for finding prototypes, structs, unions, enums.
-;; Uncomment if you want to find these too.  It will be a bit slower gathering
-;; the indexes.
-;    ("Prototypes"
-;     (,
-;      (concat
-;       "^"				  ; beginning of line is required
-;       "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
-;       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; type specs; there can be no
-;       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; more than 3 tokens, right?
-
-;       "\\("				  ; last type spec including */&
-;       "[a-zA-Z0-9_:]+"
-;       "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)"	  ; either pointer/ref sign or whitespace
-;       "\\)?"				  ; if there is a last type spec
-;       "\\("			      ; name; take that into the imenu entry
-;       "[a-zA-Z0-9_:~]+"		      ; member function, ctor or dtor...
-;					; (may not contain * because then
-;					; "a::operator char*" would become "char*"!)
-;       "\\|"
-;       "\\([a-zA-Z0-9_:~]*::\\)?operator"
-;       "[^a-zA-Z1-9_][^(]*"	      ; ...or operator
-;       " \\)"
-;       "[ \t]*([^)]*)[ \t\n]*;" 	; require ';' after
-;					; the (...) Can't
-;					; catch cases with () inside the parentheses
-;					; surrounding the parameters
-;					; (like "int foo(int a=bar());"
-;       )) 6)
-;    ("Struct"
-;     (, (concat
-;	 "^"				; beginning of line is required
-;	 "\\(static[ \t]+\\)?"		; there may be static or const.
-;	 "\\(const[ \t]+\\)?"
-;	 "struct[ \t]+"
-;	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
-;	 "[ \t]*[{]"
-;	 )) 3)
-;    ("Enum"
-;     (, (concat
-;	 "^"				; beginning of line is required
-;	 "\\(static[ \t]+\\)?"		; there may be static or const.
-;	 "\\(const[ \t]+\\)?"
-;	 "enum[ \t]+"
-;	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
-;	 "[ \t]*[{]"
-;	 )) 3)
-;    ("Union"
-;     (, (concat
-;	 "^"				; beginning of line is required
-;	 "\\(static[ \t]+\\)?"		; there may be static or const.
-;	 "\\(const[ \t]+\\)?"
-;	 "union[ \t]+"
-;	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
-;	 "[ \t]*[{]"
-;	 )) 3)
-    ))
-  "Imenu generic expression for C mode.  See `imenu-generic-expression'.")
-
-(defun c-mode ()
-  "Major mode for editing C code.
-Expression and list commands understand all C brackets.
-Tab indents for C code.
-Comments are delimited with /* ... */.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-\\{c-mode-map}
-Variables controlling indentation style:
- c-tab-always-indent
-    Non-nil means TAB in C mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- c-auto-newline
-    Non-nil means automatically newline before and after braces,
-    and after colons and semicolons, inserted in C code.
- c-indent-level
-    Indentation of C statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- c-continued-statement-offset
-    Extra indentation given to a substatement, such as the
-    then-clause of an if or body of a while.
- c-continued-brace-offset
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to c-continued-statement-offset.
- c-brace-offset
-    Extra indentation for line if it starts with an open brace.
- c-brace-imaginary-offset
-    An open brace following other text is treated as if it were
-    this far to the right of the start of its line.
- c-argdecl-indent
-    Indentation level of declarations of C function arguments.
- c-label-offset
-    Extra indentation for line that is a label, or case or default.
-
-Settings for K&R and BSD indentation styles are
-  c-indent-level                5    8
-  c-continued-statement-offset  5    8
-  c-brace-offset               -5   -8
-  c-argdecl-indent              0    8
-  c-label-offset               -5   -8
-
-Turning on C mode calls the value of the variable c-mode-hook with no args,
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map c-mode-map)
-  (setq major-mode 'c-mode)
-  (setq mode-name "C")
-
-;;; begin stuff from cc-mode
-
-  (make-local-variable 'require-final-newline)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (make-local-variable 'indent-line-function)
-  (make-local-variable 'indent-region-function)
-  (make-local-variable 'outline-regexp)
-  (make-local-variable 'outline-level)
-  (make-local-variable 'normal-auto-fill-function)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-end)
-  (make-local-variable 'comment-column)
-  (make-local-variable 'comment-start-skip)
-  (make-local-variable 'comment-multi-line)
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (make-local-variable 'adaptive-fill-mode)
-  (make-local-variable 'adaptive-fill-regexp)
-  (make-local-variable 'imenu-generic-expression) ;set in the mode functions
-;   ;; X/Emacs 20 only
-;   (and (boundp 'comment-line-break-function)
-;        (progn
-; 	 (make-local-variable 'comment-line-break-function)
-; 	 (setq comment-line-break-function
-; 	       'c-indent-new-comment-line)))
-  ;; now set their values
-  (setq require-final-newline t
-	parse-sexp-ignore-comments t
-	indent-line-function 'c-indent-line
-	indent-region-function 'c-indent-region
-	outline-regexp "[^#\n\^M]"
-	outline-level 'c-outline-level
-	normal-auto-fill-function 'c-do-auto-fill
-	comment-column 32
-	comment-start-skip "/\\*+ *\\|//+ *"
-	comment-multi-line t)
-;   ;; now set the mode style based on c-default-style
-;   (let ((style (if (stringp c-default-style)
-; 		   c-default-style
-; 		 (or (cdr (assq major-mode c-default-style))
-; 		     (cdr (assq 'other c-default-style))
-; 		     "gnu"))))
-;     ;; Override style variables if `c-old-style-variable-behavior' is
-;     ;; set.  Also override if we are using global style variables,
-;     ;; have already initialized a style once, and are switching to a
-;     ;; different style.  (It's doubtful whether this is desirable, but
-;     ;; the whole situation with nonlocal style variables is a bit
-;     ;; awkward.  It's at least the most compatible way with the old
-;     ;; style init procedure.)
-;     (c-set-style style (not (or c-old-style-variable-behavior
-; 				(and (not c-style-variables-are-local-p)
-; 				     c-indentation-style
-; 				     (not (string-equal c-indentation-style
-; 							style)))))))
-  ;; Fix things up for paragraph recognition and filling inside
-  ;; comments by using c-current-comment-prefix in the relevant
-  ;; places.  We use adaptive filling for this to make it possible to
-  ;; use filladapt or some other fancy package.
-  (setq c-current-comment-prefix
-	(if (listp c-comment-prefix-regexp)
-	    (cdr-safe (or (assoc major-mode c-comment-prefix-regexp)
-			  (assoc 'other c-comment-prefix-regexp)))
-	  c-comment-prefix-regexp))
-  (let ((comment-line-prefix
-	 (concat "[ \t]*\\(" c-current-comment-prefix "\\)[ \t]*")))
-    (setq paragraph-start (concat comment-line-prefix
-				  c-append-paragraph-start
-				  "\\|"
-				  page-delimiter)
-	  paragraph-separate (concat comment-line-prefix
-				     c-append-paragraph-separate
-				     "\\|"
-				     page-delimiter)
-	  paragraph-ignore-fill-prefix t
-	  adaptive-fill-mode t
-	  adaptive-fill-regexp
-	  (concat comment-line-prefix
-		  (if adaptive-fill-regexp
-		      (concat "\\(" adaptive-fill-regexp "\\)")
-		    "")))
-    (when (boundp 'adaptive-fill-first-line-regexp)
-      ;; XEmacs (20.x) adaptive fill mode doesn't have this.
-      (make-local-variable 'adaptive-fill-first-line-regexp)
-      (setq adaptive-fill-first-line-regexp
-	    (concat "\\`" comment-line-prefix
-		    ;; Maybe we should incorporate the old value here,
-		    ;; but then we have to do all sorts of kludges to
-		    ;; deal with the \` and \' it probably contains.
-		    "\\'"))))
-;   ;; we have to do something special for c-offsets-alist so that the
-;   ;; buffer local value has its own alist structure.
-;   (setq c-offsets-alist (copy-alist c-offsets-alist))
-  ;; setup the comment indent variable in a Emacs version portable way
-  ;; ignore any byte compiler warnings you might get here
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'c-comment-indent)
-  ;; add menus to menubar
-  (easy-menu-add (c-mode-menu mode-name))
-;   ;; put auto-hungry designators onto minor-mode-alist, but only once
-;   (or (assq 'c-auto-hungry-string minor-mode-alist)
-;       (setq minor-mode-alist
-; 	    (cons '(c-auto-hungry-string c-auto-hungry-string)
-; 		  minor-mode-alist)))
-
-;;; end stuff from cc-mode
-
-  (setq local-abbrev-table c-mode-abbrev-table)
-  (set-syntax-table c-mode-syntax-table)
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'c-fill-paragraph)
-  (setq comment-start "/* ")
-  (setq comment-end " */")
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression c-imenu-generic-expression)
-  (run-hooks 'c-mode-hook))
-
-(defun c-outline-level ()
-  ;; This so that `current-column' DTRT in otherwise-hidden text.
-  (let (buffer-invisibility-spec)
-    (save-excursion
-      (skip-chars-forward "\t ")
-      (current-column))))
-
-;; This is used by indent-for-comment
-;; to decide how much to indent a comment in C code
-;; based on its context.
-(defun c-comment-indent ()
-  (if (looking-at "^/\\*")
-      0				;Existing comment at bol stays there.
-    (let ((opoint (point)))
-      (save-excursion
-	(beginning-of-line)
-	(cond ((looking-at "[ \t]*}[ \t]*\\($\\|/\\*\\)")
-	       ;; A comment following a solitary close-brace
-	       ;; should have only one space.
-	       (search-forward "}")
-	       (1+ (current-column)))
-	      ((or (looking-at "^#[ \t]*endif[ \t]*")
-		   (looking-at "^#[ \t]*else[ \t]*"))
-	       7)			;2 spaces after #endif
-	      ((progn
-		 (goto-char opoint)
-		 (skip-chars-backward " \t")
-		 (and (= comment-column 0) (bolp)))
-	       ;; If comment-column is 0, and nothing but space
-	       ;; before the comment, align it at 0 rather than 1.
-	       0)
-	      (t
-	       (max (1+ (current-column))	;Else indent at comment column
-		    comment-column)))))))	; except leave at least one space.
-
-(defun c-fill-paragraph (&optional arg)
-  "Like \\[fill-paragraph] but handle C comments.
-If any of the current line is a comment or within a comment,
-fill the comment or the paragraph of it that point is in,
-preserving the comment indentation or line-starting decorations."
-  (interactive "P")
-  (let* (comment-start-place
-	 (first-line
-	  ;; Check for obvious entry to comment.
-	  (save-excursion
-	    (beginning-of-line)
-	    (skip-chars-forward " \t\n")
-	    (and (looking-at comment-start-skip)
-		 (setq comment-start-place (point))))))
-    (if (and (eq major-mode 'c++-mode)
-	     (save-excursion
-	       (beginning-of-line)
-	       (looking-at ".*//")))
-	(let (fill-prefix
-	      (paragraph-start
-	       ;; Lines containing just a comment start or just an end
-	       ;; should not be filled into paragraphs they are next to.
-	       (concat
-		paragraph-start
-		"\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"))
-	      (paragraph-separate
-	       (concat
-		paragraph-separate
-		"\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")))
-	  (save-excursion
-	    (beginning-of-line)
-	    ;; Move up to first line of this comment.
-	    (while (and (not (bobp)) (looking-at "[ \t]*//"))
-	      (forward-line -1))
-	    (if (not (looking-at ".*//"))
-		(forward-line 1))
-	    ;; Find the comment start in this line.
-	    (re-search-forward "[ \t]*//[ \t]*")
-	    ;; Set the fill-prefix to be what all lines except the first
-	    ;; should start with.
-	    (let ((endcol (current-column)))
-	      (skip-chars-backward " \t")
-	      (setq fill-prefix
-		    (concat (make-string (- (current-column) 2) ?\ )
-			    "//"
-			    (make-string (- endcol (current-column)) ?\ ))))
-	    (save-restriction
-	      ;; Narrow down to just the lines of this comment.
-	      (narrow-to-region (point)
-				(save-excursion
-				  (forward-line 1)
-				  (while (looking-at "[ \t]*//")
-				    (forward-line 1))
-				  (point)))
-	      (insert fill-prefix)
-	      (fill-paragraph arg)
-	      (delete-region (point-min)
-			     (+ (point-min) (length fill-prefix))))))
-      (if (or first-line
-	      ;; t if we enter a comment between start of function and this line.
-	      (eq (calculate-c-indent) t)
-	      ;; t if this line contains a comment starter.
-	      (setq first-line
-		    (save-excursion
-		      (beginning-of-line)
-		      (prog1
-			  (re-search-forward comment-start-skip
-					     (save-excursion (end-of-line)
-							     (point))
-					     t)
-			(setq comment-start-place (point))))))
-	  ;; Inside a comment: fill one comment paragraph.
-	  (let ((fill-prefix
-		 ;; The prefix for each line of this paragraph
-		 ;; is the appropriate part of the start of this line,
-		 ;; up to the column at which text should be indented.
-		 (save-excursion
-		   (beginning-of-line)
-		   (if (looking-at "[ \t]*/\\*.*\\*/")
-		       (progn (re-search-forward comment-start-skip)
-			      (make-string (current-column) ?\ ))
-		     (if first-line (forward-line 1))
-
-		     (let ((line-width (progn (end-of-line) (current-column))))
-		       (beginning-of-line)
-		       (prog1
-			   (buffer-substring
-			    (point)
-
-			    ;; How shall we decide where the end of the
-			    ;; fill-prefix is?
-			    ;; calculate-c-indent-within-comment bases its value
-			    ;; on the indentation of previous lines; if they're
-			    ;; indented specially, it could return a column
-			    ;; that's well into the current line's text.  So
-			    ;; we'll take at most that many space, tab, or *
-			    ;; characters, and use that as our fill prefix.
-			    (let ((max-prefix-end
-				   (progn
-				     (move-to-column
-				      (calculate-c-indent-within-comment t)
-				      t)
-				     (point))))
-			      (beginning-of-line)
-			      (skip-chars-forward " \t*" max-prefix-end)
-			      ;; Don't include part of comment terminator
-			      ;; in the fill-prefix.
-			      (and (eq (following-char) ?/)
-				   (eq (preceding-char) ?*)
-				   (backward-char 1))
-			      (point)))
-
-			 ;; If the comment is only one line followed by a blank
-			 ;; line, calling move-to-column above may have added
-			 ;; some spaces and tabs to the end of the line; the
-			 ;; fill-paragraph function will then delete it and the
-			 ;; newline following it, so we'll lose a blank line
-			 ;; when we shouldn't.  So delete anything
-			 ;; move-to-column added to the end of the line.  We
-			 ;; record the line width instead of the position of the
-			 ;; old line end because move-to-column might break a
-			 ;; tab into spaces, and the new characters introduced
-			 ;; there shouldn't be deleted.
-
-			 ;; If you can see a better way to do this, please make
-			 ;; the change.  This seems very messy to me.
-			 (delete-region (progn (move-to-column line-width)
-					       (point))
-					(progn (end-of-line) (point))))))))
-
-		(paragraph-start
-		 ;; Lines containing just a comment start or just an end
-		 ;; should not be filled into paragraphs they are next to.
-		 (concat
-		  paragraph-start
-		  "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"))
-		(paragraph-separate
-		 (concat
-		  paragraph-separate
-		  "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"))
-		(chars-to-delete 0))
-	    (save-restriction
-	      ;; Don't fill the comment together with the code following it.
-	      ;; So temporarily exclude everything before the comment start,
-	      ;; and everything after the line where the comment ends.
-	      ;; If comment-start-place is non-nil, the comment starter is there.
-	      ;; Otherwise, point is inside the comment.
-	      (narrow-to-region (save-excursion
-				  (if comment-start-place
-				      (goto-char comment-start-place)
-				    (search-backward "/*"))
-				  ;; Protect text before the comment start
-				  ;; by excluding it.  Add spaces to bring back
-				  ;; proper indentation of that point.
-				  (let ((column (current-column)))
-				    (prog1 (point)
-				      (setq chars-to-delete column)
-				      (insert-char ?\  column))))
-				(save-excursion
-				  (if comment-start-place
-				      (goto-char (+ comment-start-place 2)))
-				  (search-forward "*/" nil 'move)
-				  (forward-line 1)
-				  (point)))
-	      (save-excursion
-		(goto-char (point-max))
-		(forward-line -1)
-		;; And comment terminator was on a separate line before,
-		;; keep it that way.
-		;; This also avoids another problem:
-		;; if the fill-prefix ends in a *, it could eat up
-		;; the * of the comment terminator.
-		(if (looking-at "[ \t]*\\*/")
-		    (narrow-to-region (point-min) (point))))
-	      (fill-paragraph arg)
-	      (save-excursion
-		;; Delete the chars we inserted to avoid clobbering
-		;; the stuff before the comment start.
-		(goto-char (point-min))
-		(if (> chars-to-delete 0)
-		    (delete-region (point) (+ (point) chars-to-delete)))
-		;; Find the comment ender (should be on last line of buffer,
-		;; given the narrowing) and don't leave it on its own line.
-		;; Do this with a fill command, so as to preserve sentence
-		;; boundaries.
-		(goto-char (point-max))
-		(forward-line -1)
-		(search-forward "*/" nil 'move)
-		(beginning-of-line)
-		(if (looking-at "[ \t]*\\*/")
-		    (let ((fill-column (+ fill-column 9999)))
-		      (forward-line -1)
-		      (fill-region-as-paragraph (point) (point-max)))))))
-	;; Outside of comments: do ordinary filling.
-	(fill-paragraph arg)))
-    t))
-
-(defun electric-c-brace (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (let (insertpos)
-    (if (and (not arg)
-	     (eolp)
-	     (or (save-excursion
-		   (skip-chars-backward " \t")
-		   (bolp))
-		 (if c-auto-newline (progn (c-indent-line) (newline) t) nil)))
-	(progn
-	  (insert last-command-char)
-	  (c-indent-line)
-	  (if c-auto-newline
-	      (progn
-		(newline)
-		;; (newline) may have done auto-fill
-		(setq insertpos (- (point) 2))
-		(c-indent-line)))
-	  (save-excursion
-	    (if insertpos (goto-char (1+ insertpos)))
-	    (delete-char -1))))
-    (if insertpos
-	(save-excursion
-	  (goto-char insertpos)
-	  (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun electric-c-sharp-sign (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (if (save-excursion
-	(skip-chars-backward " \t")
-	(bolp))
-      (let ((c-auto-newline nil))
-	(electric-c-terminator arg))
-    (self-insert-command (prefix-numeric-value arg))))
-
-(defun electric-c-semi (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (if c-auto-newline
-      (electric-c-terminator arg)
-    (self-insert-command (prefix-numeric-value arg))))
-
-(defun electric-c-terminator (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (let (insertpos (end (point)))
-    (if (and (not arg) (eolp)
-	     (not (save-excursion
-		    (beginning-of-line)
-		    (skip-chars-forward " \t")
-		    (or (= (following-char) ?#)
-			;; Colon is special only after a label, or case ....
-			;; So quickly rule out most other uses of colon
-			;; and do no indentation for them.
-			(and (eq last-command-char ?:)
-			     (not (looking-at c-switch-label-regexp))
-			     (save-excursion
-			       (skip-chars-forward "a-zA-Z0-9_$")
-			       (skip-chars-forward " \t")
-			       (< (point) end)))
-			(progn
-			  (beginning-of-defun)
-			  (let ((pps (parse-partial-sexp (point) end)))
-			    (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))))
-	(progn
-	  (insert last-command-char)
-	  (c-indent-line)
-	  (and c-auto-newline
-	       (not (c-inside-parens-p))
-	       (progn
-		 (newline)
-		 ;; (newline) may have done auto-fill
-		 (setq insertpos (- (point) 2))
-		 (c-indent-line)))
-	  (save-excursion
-	    (if insertpos (goto-char (1+ insertpos)))
-	    (delete-char -1))))
-    (if insertpos
-	(save-excursion
-	  (goto-char insertpos)
-	  (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun c-inside-parens-p ()
-  (condition-case ()
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region (point)
-			    (progn (beginning-of-defun) (point)))
-	  (goto-char (point-max))
-	  (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
-    (error nil)))
-
-(defun c-indent-command (&optional whole-exp)
-  "Indent current line as C code, or in some cases insert a tab character.
-If `c-tab-always-indent' is non-nil (the default), always indent current line.
-Otherwise, indent the current line only if point is at the left margin or
-in the line's indentation; otherwise insert a tab.
-
-A numeric argument, regardless of its value, means indent rigidly all the
-lines of the expression starting after point so that this line becomes
-properly indented.  The relative indentation among the lines of the
-expression are preserved."
-  (interactive "P")
-  (if whole-exp
-      ;; If arg, always indent this line as C
-      ;; and shift remaining lines of expression the same amount.
-      (let ((shift-amt (c-indent-line))
-	    beg end)
-	(save-excursion
-	  (if c-tab-always-indent
-	      (beginning-of-line))
-	  ;; Find beginning of following line.
-	  (save-excursion
-	    (forward-line 1) (setq beg (point)))
-	  ;; Find first beginning-of-sexp for sexp extending past this line.
-	  (while (< (point) beg)
-	    (forward-sexp 1)
-	    (setq end (point))
-	    (skip-chars-forward " \t\n")))
-	(if (> end beg)
-	    (indent-code-rigidly beg end shift-amt "#")))
-    (if (and (not c-tab-always-indent)
-	     (save-excursion
-	       (skip-chars-backward " \t")
-	       (not (bolp))))
-	(insert-tab)
-      (c-indent-line))))
-
-(defun c-indent-line ()
-  "Indent current line as C code.
-Return the amount the indentation changed by."
-  (let ((indent (calculate-c-indent nil))
-	beg shift-amt
-	(case-fold-search nil)
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil)
-	   (setq indent (current-indentation)))
-	  ((eq indent t)
-	   (setq indent (calculate-c-indent-within-comment)))
-	  ((looking-at "[ \t]*#")
-	   (setq indent 0))
-	  (t
-	   (skip-chars-forward " \t")
-	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((or (looking-at c-switch-label-regexp)
-		      (and (looking-at "[A-Za-z]")
-			   (save-excursion
-			     (forward-sexp 1)
-			     (looking-at ":"))))
-		  (setq indent (max 1 (+ indent c-label-offset))))
-		 ((and (looking-at "else\\b")
-		       (not (looking-at "else\\s_")))
-		  (setq indent (save-excursion
-				 (c-backward-to-start-of-if)
-				 (current-indentation))))
-		 ((and (looking-at "}[ \t]*else\\b")
-		       (not (looking-at "}[ \t]*else\\s_")))
-		  (setq indent (save-excursion
-				 (forward-char)
-				 (backward-sexp)
-				 (c-backward-to-start-of-if)
-				 (current-indentation))))
-		 ((and (looking-at "while\\b")
-		       (not (looking-at "while\\s_"))
-		       (save-excursion
-			 (c-backward-to-start-of-do)))
-		  ;; This is a `while' that ends a do-while.
-		  (setq indent (save-excursion
-				 (c-backward-to-start-of-do)
-				 (current-indentation))))
-		 ((= (following-char) ?})
-		  (setq indent (- indent c-indent-level)))
-		 ((= (following-char) ?{)
-		  (setq indent (+ indent c-brace-offset))))))
-    (skip-chars-forward " \t")
-    (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))
-
-(defun calculate-c-indent (&optional parse-start)
-  "Return appropriate indentation for current line as C code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point))
-	  (case-fold-search nil)
-	  state
-	  containing-sexp)
-      (if parse-start
-	  (goto-char parse-start)
-	(beginning-of-defun))
-      (while (< (point) indent-point)
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-	(setq containing-sexp (car (cdr state))))
-      (cond ((or (nth 3 state) (nth 4 state))
-	     ;; return nil or t if should not change this line
-	     (nth 4 state))
-	    ((null containing-sexp)
-	     ;; Line is at top level.  May be data or function definition,
-	     ;; or may be function argument declaration.
-	     ;; Indent like the previous top level line
-	     ;; unless that ends in a closeparen without semicolon,
-	     ;; in which case this line is the first argument decl.
-	     (goto-char indent-point)
-	     (skip-chars-forward " \t")
-	     (if (= (following-char) ?{)
-		 0   ; Unless it starts a function body
-	       (c-backward-to-noncomment (or parse-start (point-min)))
-	       ;; Look at previous line that's at column 0
-	       ;; to determine whether we are in top-level decls
-	       ;; or function's arg decls.  Set basic-indent accordingly.
-	       (let ((basic-indent
-		      (save-excursion
-			(re-search-backward "^[^ \^L\t\n#]" nil 'move)
-			(let (comment lim)
-			  ;; Recognize the DEFUN macro in Emacs.
-			  (if (save-excursion
-				;; Move down to the (putative) argnames line.
-				(while (and (not (eobp))
-					    (not (looking-at " *[({}#/]")))
-				  (forward-line 1))
-				;; Go back to the DEFUN, if it is one.
-				(condition-case nil
-				    (backward-sexp 1)
-				  (error))
-				(beginning-of-line)
-				(looking-at "DEFUN\\b"))
-			      c-argdecl-indent
-			    (if (and (looking-at "\\sw\\|\\s_")
-				     ;; This is careful to stop at the first
-				     ;; paren if we have
-				     ;; int foo Proto ((int, int));
-				     (looking-at "[^\"\n=(]*(")
-				     (progn
-				       (goto-char (1- (match-end 0)))
-				       ;; Skip any number of paren-groups.
-				       ;; Consider typedef int (*fcn) (int);
-				       (while (= (following-char) ?\()
-					 (setq lim (point))
-					 (condition-case nil
-					     (forward-sexp 1)
-					   (error))
-					 (skip-chars-forward " \t\f"))
-				       ;; Have we reached something
-				       ;; that shows this isn't a function
-				       ;; definition?
-				       (and (< (point) indent-point)
-					    (not (memq (following-char)
-						       '(?\, ?\;)))))
-				     ;; Make sure the "function decl" we found
-				     ;; is not inside a comment.
-				     (progn
-				       ;; Move back to the `(' starting arglist
-				       (goto-char lim)
-				       (beginning-of-line)
-				       (while (and (not comment)
-						   (search-forward "/*" lim t))
-					 (setq comment
-					       (not (search-forward "*/" lim t))))
-				       (not comment)))
-				c-argdecl-indent 0))))))
-		 basic-indent)))
-
-;; 		 ;; Now add a little if this is a continuation line.
-;; 		 (+ basic-indent (if (or (bobp)
-;; 					 (memq (preceding-char) '(?\) ?\; ?\}))
-;; 					 ;; Line with zero indentation
-;; 					 ;; is probably the return-type
-;; 					 ;; of a function definition,
-;; 					 ;; so following line is function name.
-;; 					 (= (current-indentation) 0))
-;;				     0 c-continued-statement-offset))
-
-	    ((/= (char-after containing-sexp) ?{)
-	     ;; line is expression, not statement:
-	     ;; indent to just after the surrounding open.
-	     (goto-char (1+ containing-sexp))
-	     (current-column))
-	    (t
-	     ;; Statement level.  Is it a continuation or a new statement?
-	     ;; Find previous non-comment character.
-	     (goto-char indent-point)
-	     (c-backward-to-noncomment containing-sexp)
-	     ;; Back up over label lines, since they don't
-	     ;; affect whether our line is a continuation.
-	     (while (or (eq (preceding-char) ?\,)
-			(and (eq (preceding-char) ?:)
-			     (or (eq (char-after (- (point) 2)) ?\')
-				 (memq (char-syntax (char-after (- (point) 2)))
-				       '(?w ?_)))))
-	       (if (eq (preceding-char) ?\,)
-		   (progn (forward-char -1)
-			  (c-backward-to-start-of-continued-exp containing-sexp)))
-	       (beginning-of-line)
-	       (c-backward-to-noncomment containing-sexp))
-	     ;; Check for a preprocessor statement or its continuation lines.
-	     ;; Move back to end of previous non-preprocessor line,
-	     ;; or possibly beginning of buffer.
-	     (let ((found (point)) stop)
-	       (while (not stop)
-		 (beginning-of-line)
-		 (cond ((bobp)
-			(setq found (point)
-			      stop t))
-		       ((save-excursion (forward-char -1)
-					(= (preceding-char) ?\\))
-			(forward-char -1))
-		       ;; This line is not preceded by a backslash.
-		       ;; So either it starts a preprocessor command
-		       ;; or any following continuation lines
-		       ;; should not be skipped.
-		       ((= (following-char) ?#)
-			(forward-char -1)
-			(setq found (point)))
-		       (t (setq stop t))))
-	       (goto-char found))
-	     ;; Now we get the answer.
-	     (if (and (not (memq (preceding-char) '(0 ?\, ?\; ?\} ?\{)))
-		      ;; But don't treat a line with a close-brace
-		      ;; as a continuation.  It is probably the
-		      ;; end of an enum type declaration.
-		      (save-excursion
-			(goto-char indent-point)
-			(skip-chars-forward " \t")
-			(not (= (following-char) ?}))))
-		 ;; This line is continuation of preceding line's statement;
-		 ;; indent  c-continued-statement-offset  more than the
-		 ;; previous line of the statement.
-		 (progn
-		   (c-backward-to-start-of-continued-exp containing-sexp)
-		   (+ c-continued-statement-offset (current-column)
-		      (if (save-excursion (goto-char indent-point)
-					  (skip-chars-forward " \t")
-					  (eq (following-char) ?{))
-			  c-continued-brace-offset 0)))
-	       ;; This line starts a new statement.
-	       ;; Position following last unclosed open.
-	       (goto-char containing-sexp)
-	       ;; Is line first statement after an open-brace?
-	       (or
-		 ;; If no, find that first statement and indent like it.
-		 (save-excursion
-		   (forward-char 1)
-		   (let ((colon-line-end 0))
-		     (while (progn (skip-chars-forward " \t\n")
-				   (looking-at "#\\|/\\*\\|case[ \t\n'/(].*:\\|[a-zA-Z0-9_$]*:"))
-		       ;; Skip over comments and labels following openbrace.
-		       (cond ((= (following-char) ?\#)
-			      (forward-line 1))
-			     ((= (following-char) ?\/)
-			      (forward-char 2)
-			      (search-forward "*/" nil 'move))
-			     ;; case or label:
-			     (t
-			      (save-excursion (end-of-line)
-					      (setq colon-line-end (point)))
-			      (search-forward ":"))))
-		     ;; The first following code counts
-		     ;; if it is before the line we want to indent.
-		     (and (< (point) indent-point)
-			  (-
-			   (if (> colon-line-end (point))
-			       (- (current-indentation) c-label-offset)
-			     (current-column))
-			   ;; If prev stmt starts with open-brace, that
-			   ;; open brace was offset by c-brace-offset.
-			   ;; Compensate to get the column where
-			   ;; an ordinary statement would start.
-			   (if (= (following-char) ?\{) c-brace-offset 0)))))
-		 ;; If no previous statement,
-		 ;; indent it relative to line brace is on.
-		 (calculate-c-indent-after-brace))))))))
-
-(defun calculate-c-indent-after-brace ()
-  "Return the proper C indent for the first line after an open-brace.
-This function is called with point before the brace."
-  ;; For open brace in column zero, don't let statement
-  ;; start there too.  If c-indent-level is zero,
-  ;; use c-brace-offset + c-continued-statement-offset instead.
-  ;; For open-braces not the first thing in a line,
-  ;; add in c-brace-imaginary-offset.
-  (+ (if (and (bolp) (zerop c-indent-level))
-	 (+ c-brace-offset c-continued-statement-offset)
-       c-indent-level)
-     ;; Move back over whitespace before the openbrace.
-     ;; If openbrace is not first nonwhite thing on the line,
-     ;; add the c-brace-imaginary-offset.
-     (progn (skip-chars-backward " \t")
-	    (if (bolp) 0 c-brace-imaginary-offset))
-     ;; If the openbrace is preceded by a parenthesized exp,
-     ;; move to the beginning of that;
-     ;; possibly a different line
-     (progn
-       (if (eq (preceding-char) ?\))
-	   (forward-sexp -1))
-       ;; Get initial indentation of the line we are on.
-       (current-indentation))))
-
-(defun calculate-c-indent-within-comment (&optional after-star)
-  "Return the indentation amount for line inside a block comment.
-Optional arg AFTER-STAR means, if lines in the comment have a leading star,
-return the indentation of the text that would follow this star."
-  (let (end star-start)
-    (save-excursion
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (setq star-start (= (following-char) ?\*))
-      (skip-chars-backward " \t\n")
-      (setq end (point))
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (if after-star
-	  (and (looking-at "\\*")
-	       (re-search-forward "\\*[ \t]*")))
-      (and (re-search-forward "/\\*[ \t]*" end t)
-	   star-start
-	   (not after-star)
-	   (goto-char (1+ (match-beginning 0))))
-      (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\*))
-	  (1+ (current-column))
-	(current-column)))))
-
-
-(defun c-backward-to-noncomment (lim)
-  (let (opoint stop)
-    (while (not stop)
-      (skip-chars-backward " \t\n\f" lim)
-      (setq opoint (point))
-      (if (and (>= (point) (+ 2 lim))
-	       (save-excursion
-		 (forward-char -2)
-		 (looking-at "\\*/")))
-	  (search-backward "/*" lim 'move)
-	(setq stop (or (<= (point) lim)
-		       (save-excursion
-			 (beginning-of-line)
-			 (skip-chars-forward " \t")
-			 (not (looking-at "#")))))
-	(or stop (beginning-of-line))))))
-
-(defun c-backward-to-start-of-continued-exp (lim)
-  (if (memq (preceding-char) '(?\) ?\"))
-      (forward-sexp -1))
-  (beginning-of-line)
-  (if (<= (point) lim)
-      (goto-char (1+ lim)))
-  (skip-chars-forward " \t"))
-
-(defun c-backward-to-start-of-if (&optional limit)
-  "Move to the start of the last \"unbalanced\" `if'."
-  (or limit (setq limit (save-excursion (beginning-of-defun) (point))))
-  (let ((if-level 1)
-	(case-fold-search nil))
-    (while (and (not (bobp)) (not (zerop if-level)))
-      (backward-sexp 1)
-      (cond ((and (looking-at "else\\b")
-		  (not (looking-at "else\\s_")))
-	     (setq if-level (1+ if-level)))
-	    ((and (looking-at "if\\b")
-		  (not (looking-at "if\\s_")))
-	     (setq if-level (1- if-level)))
-	    ((< (point) limit)
-	     (setq if-level 0)
-	     (goto-char limit))))))
-
-(defun c-backward-to-start-of-do (&optional limit)
-  "If point follows a `do' statement, move to beginning of it and return t.
-Otherwise return nil and don't move point."
-  (or limit (setq limit (save-excursion (beginning-of-defun) (point))))
-  (let ((first t)
-	(startpos (point))
-	(done nil))
-    (while (not done)
-      (let ((next-start (point)))
-	(condition-case nil
-	    ;; Move back one token or one brace or paren group.
-	    (backward-sexp 1)
-	  ;; If we find an open-brace, we lose.
-	  (error (setq done 'fail)))
-	(if done
-	    nil
-	  ;; If we reached a `do', we win.
-	  (if (looking-at "do\\b")
-	      (setq done 'succeed)
-	    ;; Otherwise, if we skipped a semicolon, we lose.
-	    ;; (Exception: we can skip one semicolon before getting
-	    ;; to a the last token of the statement, unless that token
-	    ;; is a close brace.)
-	    (if (save-excursion
-		  (forward-sexp 1)
-		  (or (and (not first) (= (preceding-char) ?}))
-		      (search-forward ";" next-start t
-				      (if (and first
-					       (/= (preceding-char) ?}))
-					  2 1))))
-		(setq done 'fail)
-	      (setq first nil)
-	      ;; If we go too far back in the buffer, we lose.
-	      (if (< (point) limit)
-		  (setq done 'fail)))))))
-    (if (eq done 'succeed)
-	t
-      (goto-char startpos)
-      nil)))
-
-(defun c-beginning-of-statement (count)
-  "Go to the beginning of the innermost C statement.
-With prefix arg, go back N - 1 statements.  If already at the beginning of a
-statement then go to the beginning of the preceding one.
-If within a string or comment, or next to a comment (only whitespace between),
-move by sentences instead of statements."
-  (interactive "p")
-  (let ((here (point)) state)
-    (save-excursion
-      (beginning-of-defun)
-      (setq state (parse-partial-sexp (point) here nil nil)))
-    (if (or (nth 3 state) (nth 4 state)
-	    (looking-at (concat "[ \t]*" comment-start-skip))
-	    (save-excursion (skip-chars-backward " \t")
-			    (goto-char (- (point) 2))
-			    (looking-at "\\*/")))
-	(forward-sentence (- count))
-      (while (> count 0)
-	(c-beginning-of-statement-1)
-	(setq count (1- count)))
-      (while (< count 0)
-	(c-end-of-statement-1)
-	(setq count (1+ count))))))
-
-(defun c-end-of-statement (count)
-  "Go to the end of the innermost C statement.
-With prefix arg, go forward N - 1 statements.
-Move forward to end of the next statement if already at end.
-If within a string or comment, move by sentences instead of statements."
-  (interactive "p")
-  (c-beginning-of-statement (- count)))
-
-(defun c-beginning-of-statement-1 ()
-  (let ((last-begin (point))
-	(first t))
-    (condition-case ()
-	(progn
-	  (while (and (not (bobp))
-		      (progn
-			(backward-sexp 1)
-			(or first
-			    (not (re-search-forward "[;{}]" last-begin t)))))
-	    (setq last-begin (point) first nil))
-	  (goto-char last-begin))
-      (error (if first (backward-up-list 1) (goto-char last-begin))))))
-
-(defun c-end-of-statement-1 ()
-  (condition-case ()
-      (progn
-	(while (and (not (eobp))
-		    (let ((beg (point)))
-		      (forward-sexp 1)
-		      (let ((end (point)))
-			(save-excursion
-			  (goto-char beg)
-			  (not (re-search-forward "[;{}]" end t)))))))
-	(re-search-backward "[;}]")
-	(forward-char 1))
-    (error
-     (let ((beg (point)))
-       (backward-up-list -1)
-       (let ((end (point)))
-	 (goto-char beg)
-	 (search-forward ";" end 'move))))))
-
-(defun mark-c-function ()
-  "Put mark at end of C function, point at beginning."
-  (interactive)
-  (push-mark (point))
-  (end-of-defun)
-  (push-mark (point) nil t)
-  (beginning-of-defun)
-  (backward-paragraph))
-
-;; Idea of ENDPOS is, indent each line, stopping when
-;; ENDPOS is encountered.  But it's too much of a pain to make that work.
-(defun indent-c-exp (&optional endpos)
-  "Indent each line of the C grouping following point."
-  (interactive)
-  (let* ((indent-stack (list nil))
-	 (opoint (point))  ;; May be altered below.
-	 (contain-stack
-	  (list (if endpos
-		    (let (funbeg)
-		      ;; Find previous fcn-start.
-		      (save-excursion (forward-char 1)
-				      (beginning-of-defun)
-				      (setq funbeg (point)))
-		      (setq opoint funbeg)
-		      ;; Try to find containing open,
-		      ;; but don't scan past that fcn-start.
-		      (save-restriction
-			(narrow-to-region funbeg (point))
-			(condition-case nil
-			    (save-excursion
-			      (backward-up-list 1)
-			      (point))
-			  ;; We gave up: must be between fcns.
-			  ;; Set opoint to beg of prev fcn
-			  ;; since otherwise calculate-c-indent
-			  ;; will get wrong answers.
-			  (error (setq opoint funbeg)
-				 (point)))))
-		  (point))))
-	 (case-fold-search nil)
-	 restart outer-loop-done inner-loop-done state ostate
-	 this-indent last-sexp
-	 at-else at-brace at-while
-	 last-depth this-point
-	 (next-depth 0))
-    ;; If the braces don't match, get an error right away.
-    (save-excursion
-      (forward-sexp 1))
-    ;; Realign the comment on the first line, even though we don't reindent it.
-    (save-excursion
-      (let ((beg (point)))
-	(and (re-search-forward
-	      comment-start-skip
-	      (save-excursion (end-of-line) (point)) t)
-	     ;; Make sure this isn't a comment alone on a line
-	     ;; (which should be indented like code instead).
-	     (save-excursion
-	       (goto-char (match-beginning 0))
-	       (skip-chars-backward " \t")
-	       (not (bolp)))
-	     ;; Make sure the comment starter we found
-	     ;; is not actually in a string or quoted.
-	     (let ((new-state
-		    (parse-partial-sexp beg (point)
-					nil nil state)))
-	       (and (not (nth 3 new-state)) (not (nth 5 new-state))))
-	    (progn (indent-for-comment) (beginning-of-line)))))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (and (not (eobp))
-		  (if endpos (< (point) endpos)
-		    (not outer-loop-done)))
-	(setq last-depth next-depth)
-	;; Compute how depth changes over this line
-	;; plus enough other lines to get to one that
-	;; does not end inside a comment or string.
-	;; Meanwhile, do appropriate indentation on comment lines.
-	(setq inner-loop-done nil)
-	(while (and (not inner-loop-done)
-		    (not (and (eobp) (setq outer-loop-done t))))
-	  (setq ostate state)
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  (if (and (car (cdr (cdr state)))
-		   (>= (car (cdr (cdr state))) 0))
-	      (setq last-sexp (car (cdr (cdr state)))))
-	  ;; If this line started within a comment, indent it as such.
-	  (if (or (nth 4 ostate) (nth 7 ostate))
-	      (c-indent-line))
-	  ;; If it ends outside of comments or strings, exit the inner loop.
-	  ;; Otherwise move on to next line.
-	  (if (or (nth 3 state) (nth 4 state) (nth 7 state))
-	      (forward-line 1)
-	    (setq inner-loop-done t)))
-	(and endpos
-	     (while (< next-depth 0)
-	       (setq indent-stack (append indent-stack (list nil)))
-	       (setq contain-stack (append contain-stack (list nil)))
-	       (setq next-depth (1+ next-depth))
-	       (setq last-depth (1+ last-depth))
-	       (setcar (nthcdr 6 state) (1+ (nth 6 state)))))
-	(setq outer-loop-done (and (not endpos) (<= next-depth 0)))
-	(if outer-loop-done
-	    nil
-	  ;; If this line had ..))) (((.. in it, pop out of the levels
-	  ;; that ended anywhere in this line, even if the final depth
-	  ;; doesn't indicate that they ended.
-	  (while (> last-depth (nth 6 state))
-	    (setq indent-stack (cdr indent-stack)
-		  contain-stack (cdr contain-stack)
-		  last-depth (1- last-depth)))
-	  (if (/= last-depth next-depth)
-	      (setq last-sexp nil))
-	  ;; Add levels for any parens that were started in this line.
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  contain-stack (cons nil contain-stack)
-		  last-depth (1+ last-depth)))
-	  (if (null (car contain-stack))
-	      (setcar contain-stack (or (car (cdr state))
-					(save-excursion (forward-sexp -1)
-							(point)))))
-	  (forward-line 1)
-	  (skip-chars-forward " \t")
-	  ;; Don't really reindent if the line is just whitespace,
-	  ;; or if it is past the endpos.
-	  ;; (The exit test in the outer while
-	  ;; does not exit until we have passed the first line
-	  ;; past the region.)
-	  (if (or (eolp) (and endpos (>= (point) endpos)))
-	      nil
-	    ;; Is this line in a new nesting level?
-	    ;; In other words, is this the first line that
-	    ;; starts in the new level?
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		nil
-	      ;; Yes.
-	      ;; Compute the standard indent for this level.
-	      (let (val)
-		(if (= (char-after (car contain-stack)) ?{)
-		    (save-excursion
-		      (goto-char (car contain-stack))
-		      (setq val (calculate-c-indent-after-brace)))
-		  (setq val (calculate-c-indent
-			     (if (car indent-stack)
-				 (- (car indent-stack))
-			       opoint))))
-		;; t means we are in a block comment and should
-		;; calculate accordingly.
-		(if (eq val t)
-		    (setq val (calculate-c-indent-within-comment)))
-		(setcar indent-stack val)))
-	    ;; Adjust indent of this individual line
-	    ;; based on its predecessor.
-	    ;; Handle continuation lines, if, else, while, and so on.
-	    (if (/= (char-after (car contain-stack)) ?{)
-		(setq this-indent (car indent-stack))
-	      ;; Line is at statement level.
-	      ;; Is it a new statement?  Is it an else?
-	      ;; Find last non-comment character before this line
-	      (save-excursion
-		(setq this-point (point))
-		(setq at-else (and (looking-at "else\\b")
-				   (not (looking-at "else\\s_"))))
-		(setq at-brace (= (following-char) ?{))
-		(setq at-while (and (looking-at "while\\b")
-				    (not (looking-at "while\\s_"))))
-		(if (= (following-char) ?})
-		    (setq this-indent (car indent-stack))
-		  (c-backward-to-noncomment opoint)
-		  (if (not (memq (preceding-char) '(0 ?\, ?\; ?} ?: ?{)))
-		      ;; Preceding line did not end in comma or semi;
-		      ;; indent this line  c-continued-statement-offset
-		      ;; more than previous.
-		      (progn
-			(c-backward-to-start-of-continued-exp (car contain-stack))
-			(setq this-indent
-			      (+ c-continued-statement-offset (current-column)
-				 (if at-brace c-continued-brace-offset 0))))
-		    ;; Preceding line ended in comma or semi;
-		    ;; use the standard indent for this level.
-		    (cond (at-else (progn (c-backward-to-start-of-if opoint)
-					  (setq this-indent
-						(current-indentation))))
-			  ((and at-while (c-backward-to-start-of-do opoint))
-			   (setq this-indent (current-indentation)))
-			  ((eq (preceding-char) ?\,)
-			   (goto-char this-point)
-			   (setq this-indent (calculate-c-indent)))
-			  (t (setq this-indent (car indent-stack))))))))
-	    ;; Adjust line indentation according to its contents
-	    (if (or (looking-at c-switch-label-regexp)
-		    (and (looking-at "[A-Za-z]")
-			 (save-excursion
-			   (forward-sexp 1)
-			   (looking-at ":"))))
-		(setq this-indent (max 1 (+ this-indent c-label-offset))))
-	    (if (= (following-char) ?})
-		(setq this-indent (- this-indent c-indent-level)))
-	    (if (= (following-char) ?{)
-		;; Don't move an open-brace in column 0.
-		;; This is good when constructs such as
-		;; `extern "C" {' surround a function definition
-		;; that should be indented as usual.
-		;; It is also good for nested functions.
-		;; It is bad when an open-brace is indented at column 0
-		;; and you want to fix that, but we can't win 'em all.
-		(if (zerop (current-column))
-		    (setq this-indent 0)
-		  (setq this-indent (+ this-indent c-brace-offset))))
-	    ;; Don't leave indentation in empty lines.
-	    (if (eolp) (setq this-indent 0))
-	    ;; Put chosen indentation into effect.
-	    (or (= (current-column) this-indent)
-		(= (following-char) ?\#)
-		(progn
-		  (delete-region (point) (progn (beginning-of-line) (point)))
-		  (indent-to this-indent)))
-	    ;; Indent any comment following the text.
-	    (or (looking-at comment-start-skip)
-		(save-excursion
-		  (let ((beg (point)))
-		    (and (re-search-forward
-			  comment-start-skip
-			  (save-excursion (end-of-line) (point)) t)
-			 ;; Make sure the comment starter we found
-			 ;; is not actually in a string or quoted.
-			 (let ((new-state
-				(parse-partial-sexp beg (point)
-						    nil nil state)))
-			   (and (not (nth 3 new-state)) (not (nth 5 new-state))))
-			 (indent-for-comment)))))))))))
-
-;; Look at all comment-start strings in the current line after point.
-;; Return t if one of them starts a real comment.
-;; This is not used yet, because indent-for-comment
-;; isn't smart enough to handle the cases this can find.
-(defun indent-c-find-real-comment ()
-  (let (win)
-    (while (and (not win)
-		(re-search-forward comment-start-skip
-				   (save-excursion (end-of-line) (point))
-				   t))
-      ;; Make sure the comment start is not quoted.
-      (let ((state-1
-	     (parse-partial-sexp
-	      (save-excursion (beginning-of-line) (point))
-	      (point) nil nil state)))
-	(setq win (and (null (nth 3 state-1)) (null (nth 5 state-1))))))
-    win))
-
-;; Indent every line whose first char is between START and END inclusive.
-(defun c-indent-region (start end)
-  (save-excursion
-    (goto-char start)
-    ;; Advance to first nonblank line.
-    (skip-chars-forward " \t\n")
-    (beginning-of-line)
-    (let ((endmark (copy-marker end))
-	  (c-tab-always-indent t))
-      (while (and (bolp) (not (eobp)) (< (point) endmark))
-	;; Indent one line as with TAB.
-	(let ((shift-amt (c-indent-line))
-	      nextline sexpbeg sexpend)
-	  (if (save-excursion (beginning-of-line) (looking-at "[ \t]*#"))
-	      (forward-line 1)
-	    (save-excursion
-	      ;; Find beginning of following line.
-	      (save-excursion
-		(forward-line 1) (setq nextline (point)))
-	      ;; Find first beginning-of-sexp for sexp extending past this line.
-	      (beginning-of-line)
-	      (while (< (point) nextline)
-		(condition-case nil
-		    (progn
-		      (forward-sexp 1)
-		      (setq sexpend (point-marker)))
-		  (error (setq sexpend nil)
-			 (goto-char nextline)))
-		(skip-chars-forward " \t\n"))
-	      (if sexpend
-		  (progn
-		    ;; Make sure the sexp we found really starts on the
-		    ;; current line and extends past it.
-		    (goto-char sexpend)
-		    (backward-sexp 1)
-		    (setq sexpbeg (point)))))
-	    ;; If that sexp ends within the region,
-	    ;; indent it all at once, fast.
-	    (if (and sexpend (> sexpend nextline) (<= sexpend endmark)
-		     (< sexpbeg nextline))
-		(progn
-		  (indent-c-exp)
-		  (goto-char sexpend)))
-	    ;; Move to following line and try again.
-	    (and sexpend (set-marker sexpend nil))
-	    (forward-line 1))))
-      (set-marker endmark nil))))
-
-(defun set-c-style (style &optional global)
-  "Set C-mode variables to use one of several different indentation styles.
-The arguments are a string representing the desired style
-and a flag which, if non-nil, means to set the style globally.
-\(Interactively, the flag comes from the prefix argument.)
-Available styles are GNU, K&R, BSD and Whitesmith."
-  (interactive (list (let ((completion-ignore-case t))
-		       (completing-read "Use which C indentation style? "
-					c-style-alist nil t))
-		     current-prefix-arg))
-  (let ((vars (cdr (assoc style c-style-alist))))
-    (or vars
-	(error "Invalid C indentation style `%s'" style))
-    (while vars
-      (or global
-	  (make-local-variable (car (car vars))))
-      (set (car (car vars)) (cdr (car vars)))
-      (setq vars (cdr vars)))))
-
-;;; This page handles insertion and removal of backslashes for C macros.
-
-(defcustom c-backslash-column 48
-  "*Minimum column for end-of-line backslashes of macro definitions."
-  :type 'integer
-  :group 'old-c)
-
-(defun c-backslash-region (from to delete-flag)
-  "Insert, align, or delete end-of-line backslashes on the lines in the region.
-With no argument, inserts backslashes and aligns existing backslashes.
-With an argument, deletes the backslashes.
-
-This function does not modify the last line of the region if the region ends
-right at the start of the following line; it does not modify blank lines
-at the start of the region.  So you can put the region around an entire macro
-definition and conveniently use this command."
-  (interactive "r\nP")
-  (save-excursion
-    (goto-char from)
-    (let ((column c-backslash-column)
-	  (endmark (make-marker)))
-      (move-marker endmark to)
-      ;; Compute the smallest column number past the ends of all the lines.
-      (if (not delete-flag)
-	  (while (< (point) to)
-	    (end-of-line)
-	    (if (= (preceding-char) ?\\)
-		(progn (forward-char -1)
-		       (skip-chars-backward " \t")))
-	    (setq column (max column (1+ (current-column))))
-	    (forward-line 1)))
-      ;; Adjust upward to a tab column, if that doesn't push past the margin.
-      (if (> (% column tab-width) 0)
-	  (let ((adjusted (* (/ (+ column tab-width -1) tab-width) tab-width)))
-	    (if (< adjusted (window-width))
-		(setq column adjusted))))
-      ;; Don't modify blank lines at start of region.
-      (goto-char from)
-      (while (and (< (point) endmark) (eolp))
-	(forward-line 1))
-      ;; Add or remove backslashes on all the lines.
-      (while (and (< (point) endmark)
-		  ;; Don't backslashify the last line
-		  ;; if the region ends right at the start of the next line.
-		  (save-excursion
-		    (forward-line 1)
-		    (< (point) endmark)))
-	(if (not delete-flag)
-	    (c-append-backslash column)
-	  (c-delete-backslash))
-	(forward-line 1))
-      (move-marker endmark nil))))
-
-(defun c-append-backslash (column)
-  (end-of-line)
-  ;; Note that "\\\\" is needed to get one backslash.
-  (if (= (preceding-char) ?\\)
-      (progn (forward-char -1)
-	     (delete-horizontal-space)
-	     (indent-to column))
-    (indent-to column)
-    (insert "\\")))
-
-(defun c-delete-backslash ()
-  (end-of-line)
-  (or (bolp)
-      (progn
-	(forward-char -1)
-	(if (looking-at "\\\\")
-	    (delete-region (1+ (point))
-			   (progn (skip-chars-backward " \t") (point)))))))
-
-(defun c-up-conditional (count)
-  "Move back to the containing preprocessor conditional, leaving mark behind.
-A prefix argument acts as a repeat count.  With a negative argument,
-move forward to the end of the containing preprocessor conditional.
-When going backwards, `#elif' is treated like `#else' followed by `#if'.
-When going forwards, `#elif' is ignored."
-  (interactive "p")
-  (c-forward-conditional (- count) t))
-
-(defun c-backward-conditional (count &optional up-flag)
-  "Move back across a preprocessor conditional, leaving mark behind.
-A prefix argument acts as a repeat count.  With a negative argument,
-move forward across a preprocessor conditional."
-  (interactive "p")
-  (c-forward-conditional (- count) up-flag))
-
-(defun c-forward-conditional (count &optional up-flag)
-  "Move forward across a preprocessor conditional, leaving mark behind.
-A prefix argument acts as a repeat count.  With a negative argument,
-move backward across a preprocessor conditional."
-  (interactive "p")
-  (let* ((forward (> count 0))
-	 (increment (if forward -1 1))
-	 (search-function (if forward 're-search-forward 're-search-backward))
-	 (opoint (point))
-	 (new))
-    (save-excursion
-      (while (/= count 0)
-	(let ((depth (if up-flag 0 -1)) found)
-	  (save-excursion
-	    ;; Find the "next" significant line in the proper direction.
-	    (while (and (not found)
-			;; Rather than searching for a # sign that comes
-			;; at the beginning of a line aside from whitespace,
-			;; search first for a string starting with # sign.
-			;; Then verify what precedes it.
-			;; This is faster on account of the fastmap feature of
-			;; the regexp matcher.
-			(funcall search-function
-				 "#[ \t]*\\(if\\|elif\\|endif\\)"
-				 nil t))
-	      (beginning-of-line)
-	      ;; Now verify it is really a preproc line.
-	      (if (looking-at "^[ \t]*#[ \t]*\\(if\\|elif\\|endif\\)")
-		  (let ((prev depth))
-		    ;; Update depth according to what we found.
-		    (beginning-of-line)
-		    (cond ((looking-at "[ \t]*#[ \t]*endif")
-			   (setq depth (+ depth increment)))
-			  ((looking-at "[ \t]*#[ \t]*elif")
-			   (if (and forward (= depth 0))
-			       (setq found (point))))
-			  (t (setq depth (- depth increment))))
-		    ;; If we are trying to move across, and we find
-		    ;; an end before we find a beginning, get an error.
-		    (if (and (< prev 0) (< depth prev))
-			(error (if forward
-				   "No following conditional at this level"
-				 "No previous conditional at this level")))
-		    ;; When searching forward, start from next line
-		    ;; so that we don't find the same line again.
-		    (if forward (forward-line 1))
-		    ;; If this line exits a level of conditional, exit inner loop.
-		    (if (< depth 0)
-			(setq found (point))))
-		;; If the line is not really a conditional, skip past it.
-		(if forward (end-of-line)))))
-	  (or found
-	      (error "No containing preprocessor conditional"))
-	  (goto-char (setq new found)))
-	(setq count (+ count increment))))
-    (push-mark)
-    (goto-char new)))
-
-;;; begin stuff from cc-mode
-
-(defsubst c-region-is-active-p ()
-  ;; Return t when the region is active.  The determination of region
-  ;; activeness is different in both Emacs and XEmacs.
-  (cond
-   ;; XEmacs
-   ((and (fboundp 'region-active-p)
-	 (boundp 'zmacs-regions)
-	 zmacs-regions)
-    (region-active-p))
-   ;; Emacs
-   ((boundp 'mark-active) mark-active)
-   ;; fallback; shouldn't get here
-   (t (mark t))))
-
-(defun c-fn-region-is-active-p ()
-  ;; Function version of the macro for use in places that aren't
-  ;; compiled, e.g. in the menus.
-  (c-region-is-active-p))
-
-(defun c-indent-line-or-region ()
-  "When the region is active, indent it.  Otherwise indent the current line."
-  ;; Emacs has a variable called mark-active, XEmacs uses region-active-p
-  (interactive)
-  (if (c-region-is-active-p)
-      (c-indent-region (region-beginning) (region-end))
-    (indent-according-to-mode)))
-
-(defmacro c-point (position &optional point)
-  ;; Returns the value of certain commonly referenced POSITIONs
-  ;; relative to POINT.  The current point is used if POINT isn't
-  ;; specified.  POSITION can be one of the following symbols:
-  ;; 
-  ;; bol  -- beginning of line
-  ;; eol  -- end of line
-  ;; bod  -- beginning of defun
-  ;; eod  -- end of defun
-  ;; boi  -- back to indentation
-  ;; ionl -- indentation of next line
-  ;; iopl -- indentation of previous line
-  ;; bonl -- beginning of next line
-  ;; bopl -- beginning of previous line
-  ;; 
-  ;; This function does not modify point or mark.
-  `(save-excursion
-     ,(if point `(goto-char ,point))
-     ,(if (and (eq (car-safe position) 'quote)
-	       (symbolp (eval position)))
-	  (let ((position (eval position)))
-	    (cond
-	     ((eq position 'bol)  `(beginning-of-line))
-	     ((eq position 'eol)  `(end-of-line))
-	     ((eq position 'boi)  `(back-to-indentation))
-	     ((eq position 'bonl) `(forward-line 1))
-	     ((eq position 'bopl) `(forward-line -1))
-	     ((eq position 'bod)  `(c-beginning-of-defun-1))
-	     ((eq position 'eod)  `(c-end-of-defun-1))
-	     ((eq position 'iopl) `(progn
-				     (forward-line -1)
-				     (back-to-indentation)))
-	     ((eq position 'ionl) `(progn
-				     (forward-line 1)
-				     (back-to-indentation)))
-	     (t (error "unknown buffer position requested: %s" position))))
-	;;(message "c-point long expansion")
-	`(let ((position ,position))
-	   (cond
-	    ((eq position 'bol)  (beginning-of-line))
-	    ((eq position 'eol)  (end-of-line))
-	    ((eq position 'boi)  (back-to-indentation))
-	    ((eq position 'bonl) (forward-line 1))
-	    ((eq position 'bopl) (forward-line -1))
-	    ((eq position 'bod)  (c-beginning-of-defun-1))
-	    ((eq position 'eod)  (c-end-of-defun-1))
-	    ((eq position 'iopl) (progn
-				   (forward-line -1)
-				   (back-to-indentation)))
-	    ((eq position 'ionl) (progn
-				   (forward-line 1)
-				   (back-to-indentation)))
-	    (t (error "unknown buffer position requested: %s" position)))))
-     (point)))
-
-(defmacro c-safe (&rest body)
-  ;; safely execute BODY, return nil if an error occurred
-  `(condition-case nil
-       (progn ,@body)
-     (error nil)))
-
-(defmacro c-forward-sexp (&optional arg)
-  ;; like forward-sexp except
-  ;;   1. this is much stripped down from the XEmacs version
-  ;;   2. this cannot be used as a command, so we're insulated from
-  ;;      XEmacs' losing efforts to make forward-sexp more user
-  ;;      friendly
-  ;;   3. Preserves the semantics most of CC Mode is based on
-  (or arg (setq arg 1))
-  `(goto-char (or (scan-sexps (point) ,arg)
-		  ,(if (numberp arg)
-		       (if (> arg 0) `(point-max) `(point-min))
-		     `(if (> ,arg 0) (point-max) (point-min))))))
-
-(defmacro c-backward-sexp (&optional arg)
-  ;; See c-forward-sexp and reverse directions
-  (or arg (setq arg 1))
-  `(c-forward-sexp ,(if (numberp arg) (- arg) `(- ,arg))))
-
-(defun c-indent-exp (&optional shutup-p)
-  "Indent each line in the balanced expression following point syntactically.
-If optional SHUTUP-P is non-nil, no errors are signalled if no
-balanced expression is found."
-  (interactive "*P")
-  (let ((here (point-marker))
-	end)
-    (set-marker-insertion-type here t)
-    (unwind-protect
-	(let ((start (progn
-		       ;; try to be smarter about finding the range of
-		       ;; lines to indent. skip all following
-		       ;; whitespace, then try to find any
-		       ;; opening paren on the current line
-		       (skip-chars-forward " \t\n")
-		       (save-restriction
-			 (narrow-to-region (point-min) (c-point 'eol))
-			 (c-safe (1- (scan-lists (point) 1 -1)))))))
-	  ;; find balanced expression end
-	  (setq end (and (c-safe (progn (c-forward-sexp 1) t))
-			 (point)))
-	  ;; sanity check
-	  (if (not start)
-	     (unless shutup-p
-	       (error "Cannot find start of balanced expression to indent"))
-	    (if (not end)
-		(unless shutup-p
-		  (error "Cannot find end of balanced expression to indent"))
-	      (c-indent-region start end))))
-      (goto-char here)
-      (set-marker here nil))))
-
-(defun c-insert-matching-endif ()
-  "Insert a #endif expression matching the corresponding #if... statement.
-This skips across any number of intervening #if/#endif pairs to find the
-matching #if/#ifdef/#ifndef statement and inserts a #endif with a comment
-corresponding to the expression following the #if.  If the statement is
-a #ifndef, the word \"not\" appears in the comment.  If there are spaces
-between the '#' and the 'if', the same number of spaces appear in the
-#endif.  Comments following the #if statement are ignored and do not appear
-in the #endif comment."
-  (interactive)
-  (let (spaces expr notp)
-    (save-excursion
-      (c-up-conditional 1)
-      ;; we have to construct the regexps carefully to avoid running into
-      ;; problems due to the greedy operators.  XEmacs has non-greedy
-      ;; operators, which would simplify matters, but they're not present
-      ;; in GNU Emacs.
-      (or (looking-at "#\\( *\\)if\\(n?\\)[a-z]*\\(.*[^ \t\n]\\)[ \t]*/[*/].*")
-	  (looking-at "#\\( *\\)if\\(n?\\)[a-z]*\\(.*[^ \t\n]\\)")
-	  (error "Malformed #if... expression"))
-      (setq spaces (match-string 1))
-      (setq notp (> (match-end 2) (match-beginning 2)))
-      (setq expr (match-string 3)))
-    (insert "#" spaces "endif /*" (if notp " not" "") expr " */\n")))
-
-;;; end stuff from cc-mode
-
-
-
-(provide 'c-mode)
-
-;;; old-c-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/p4.el b/xemacs-packages/lisp/prog-modes/p4.el
deleted file mode 100644
index f92b2410..00000000
--- a/xemacs-packages/lisp/prog-modes/p4.el
+++ /dev/null
@@ -1,3694 +0,0 @@
-;;; p4.el --- Simple Perforce-Emacs Integration
-;;
-;; $Id: p4.el,v 1.37 2002/07/31 23:24:44 petero2 Exp $
-
-;;; Commentary:
-;;
-;;    Applied the GNU G.P.L. to this file - rv 3/27/1997
-
-;;    Programs for  Emacs <-> Perforce Integration.
-;;    Copyright (C) 1996, 1997	Eric Promislow
-;;    Copyright (C) 1997-2003	Rajesh Vaidheeswarran
-;;
-;;    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., 675 Mass Ave, Cambridge, MA 02139, USA.
-;;
-;;    If you have any problems to report, or suggestions, please send them
-;;    to p4el-bugs@lists.sourceforge.net
-
-;; LCD Archive Entry:
-;; p4|Rajesh Vaidheeswarran|rv@NoSpAm.lOsEtHiS.dsmit.com|
-;; P4 SCM Integration into Emacs/XEmacs|
-;; 2003/09/12|10.3|not_assigned_yet|
-
-;; WARNING:
-;; --------
-;;
-;;    % p4 edit foo.c
-;;    ... make changes to foo.c in emacs
-;;    % p4 submit
-;;     ... keep the writable copy of foo.c in emacs.  Start making changes
-;;     to it.  Discover that you can't save it.	 If you do M-x:p4-edit,
-;;     you'll lose your changes.  You need to do a 'p4 edit' at the
-;;     command-line.
-;;
-
-;; NOTES:
-;; ------
-;;
-;; It is best if you take this file and byte compile it. To do that, you
-;; need to do the following:
-;;
-;; % emacs -batch -f batch-byte-compile /full/path/to/file/p4.el
-;;
-;; This creates a binary file p4.elc in the path. Add the path to your
-;; load-path variable in .emacs like this:
-;;
-;; (setq load-path (cons "/full/path/to/file" load-path))
-;;
-;; Then add the library like this:
-;;
-;; (load-library "p4")
-;;
-
-;;; Code:
-
-(defvar p4-emacs-version "10.3" "The Current P4-Emacs Integration Revision.")
-
-;; Find out what type of emacs we are running in. We will be using this
-;; quite a few times in this program.
-(eval-and-compile
-  (defvar p4-running-emacs nil
-    "If the current Emacs is not XEmacs, then, this is non-nil.")
-  (defvar p4-running-xemacs nil
-    "If the current Emacs is XEmacs/Lucid, then, this is non-nil.")
-  (if (string-match "XEmacs\\|Lucid" emacs-version)
-      (setq p4-running-xemacs t)
-    (setq p4-running-emacs t)))
-
-;; Pick up a couple of missing function defs
-(if p4-running-xemacs
-    (eval-when-compile
-      (require 'timer)
-      (require 'dired)))
-
-(defvar p4-emacs-maintainer
-  "p4.el maintainers "
-  "The maintainer(s) of the emacs-p4 integration. Used for bug reports.")
-
-(defvar p4-web-page "http://p4el.sourceforge.net/" "The home of p4.el.")
-
-;; For flavors of Emacs which don't define `defgroup' and `defcustom'.
-(eval-when-compile
-  (if (not (fboundp 'defgroup))
-      (defmacro defgroup (sym memb doc &rest args)
-	"Null macro for defgroup in all versions of Emacs that don't define
-defgroup"
-	t))
-  (if (not (fboundp 'defcustom))
-      (defmacro defcustom (sym val doc &rest args)
-	"Macro to alias defcustom to defvar in all versions of Emacs that
-don't define defcustom"
-	`(defvar ,sym ,val ,doc))))
-
-(defgroup p4 nil "Perforce VC System." :group 'tools)
-
-;; This can be set to wherever 'p4' lies using p4-set-p4-executable
-(eval-and-compile
-  (defun p4-windows-os ()
-    (memq system-type '(ms-dos windows-nt)))
-
-  (defcustom p4-executable
-    (let ((lst (append
-		exec-path
-		(list "/usr/local/bin/p4"
-		      (concat (getenv "HOME") "/bin/p4")
-		      "p4")))
-	  (p4-progname (if (p4-windows-os) "p4.exe" "p4"))
-	  p4ex)
-      (while (and lst (not p4ex))
-	(let ((tmp (concat (file-name-as-directory (car lst))
-			   p4-progname)))
-	  (if (and (file-executable-p tmp)
-		   (not (file-directory-p tmp)))
-	      (setq p4ex tmp))
-	  (setq lst (cdr lst))))
-      p4ex)
-    "This is the p4 executable.
-To set this, use the function  `p4-set-p4-executable' or `customize'"
-    :type 'string
-    :group 'p4))
-
-;; This is a string with default arguments to pass to "p4 diff",
-;; "p4 diff2", "p4 describe", etc.
-(defcustom p4-default-diff-options "-du"
-  "Type of p4 diff output to be displayed. \(regular or context or
-unified.\)"
-  :type 'string
-  :group 'p4)
-
-(defcustom p4-default-depot-completion-prefix "//depot/"
-  "Prefix to be used for completion prompt when prompting user for a depot
-file."
-  :type 'string
-  :group 'p4)
-
-;; Set this variable to nil to turn off colorized diff buffers.
-(defcustom p4-colorized-diffs t
-  "Set this to nil to disable colorized diffs."
-  :type 'boolean
-  :group 'p4)
-
-;; Set whether P4CONFIG should be used exclusively for VC checking
-(defcustom p4-use-p4config-exclusively nil
-  "Whether P4 mode should use P4CONFIG exclusively to check whether a file
-is under P4 version control. If set to nil, `p4-check-mode' is always
-called; otherwise, it checks to see if the file named by P4CONFIG exists in
-this or a parent directory, and if so, only then runs p4-check-mode.
-
-This provides for a much faster `p4-find-file-hook'."
-  :type 'boolean
-  :group 'p4)
-
-;; Auto-refresh?
-(defcustom p4-auto-refresh t
-  "Set this to automatically refresh p4 submitted files in buffers."
-  :type 'boolean
-  :group 'p4)
-
-;; Check for empty diffs at submit time
-(defcustom p4-check-empty-diffs t
-  "Set this to check for files with empty diffs before submitting."
-  :type 'boolean
-  :group 'p4)
-
-(defcustom p4-verbose t
-  "When set, p4 will pop up the output buffer with the result of the
-command."
-  :type 'boolean
-  :group 'p4)
-
-;; Follow Symlinks?
-(defcustom p4-follow-symlinks nil
-  "When set, p4 will call `file-truename' on all opened files."
-  :type 'boolean
-  :group 'p4)
-
-(defcustom p4-mode-hook nil
-  "Hook run by `p4-mode'."
-  :type 'sexp
-  :group 'p4)
-
-(eval-and-compile
-  (defvar p4-output-buffer-name "*P4 Output*" "P4 Output Buffer."))
-
-;; Set this variable in .emacs if you want p4-set-client-name to complete
-;; your client name for you.
-(defvar p4-my-clients nil
-  "This variable holds the alist of p4 clients that the function
-`p4-set-client-name' can complete on.
-
-Set this variable *only* if you don't want P4 to complete on all the clients
-in the P4 server.
-
-This is a alist, and should be set using the function
-`p4-set-my-clients'. For example, in your .emacs:
-
-\(load-library \"p4\"\)
-\(p4-set-my-clients \'(client1 client2 client3)\)")
-
-;; Set this variable in .emacs if you want to alter the completion
-;; behavior of p4-set-client-name.
-
-(defcustom p4-strict-complete t
-  "Set this variable in .emacs \(or using `customize'\) if you want to alter
-the completion behavior of `p4-set-client-name'.
-"
-  :type 'boolean
-  :group 'p4)
-
-(if (not (getenv "P4PORT"))
-    (setenv "P4PORT" "perforce:1666"))
-
-(defvar p4-notify-list (getenv "P4NOTIFY") "The P4 Notify List.")
-
-(defcustom p4-sendmail-program (if (boundp 'sendmail-program)
-				   sendmail-program
-				 nil)
-  "The sendmail program. To set this use `customize'."
-  :type 'string
-  :group 'p4)
-
-(defcustom p4-user-email (if (boundp 'user-mail-address)
-			     user-mail-address nil)
-  "The e-mail address of the current user. This is used with the
-notification system, and must be set if notification should take place. To
-set this, use `customize'."
-  :type 'string
-  :group 'p4)
-
-(defcustom p4-notify nil
-  "If this is t then the users in the notification list set by
-`p4-set-notify-list' will get a notification of any P4 change submitted from
-within emacs."
-  :type 'boolean
-  :group 'p4)
-
-;; This can be set with p4-toggle-vc-mode
-(defcustom p4-do-find-file t
-  "If non-nil, the `p4-find-file-hook' will run when opening files."
-  :type 'boolean
-  :group 'p4)
-
-;; Now add a hook to find-file-hooks
-(add-hook 'find-file-hooks 'p4-find-file-hook)
-;; .. and one to kill-buffer-hook
-(add-hook 'kill-buffer-hook 'p4-kill-buffer-hook)
-
-;; Tell Emacs about this new kind of minor mode
-(defvar p4-mode nil "Is this file under p4?")
-(make-variable-buffer-local 'p4-mode)
-(put 'p4-mode 'permanent-local t)
-
-(defvar p4-offline-mode nil "Is this file under p4 but handled in offline mode?")
-(make-variable-buffer-local 'p4-offline-mode)
-(put 'p4-offline-mode 'permanent-local t)
-
-(defvar p4-minor-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-x\C-q" 'p4-toggle-read-only)
-    map)
-  "Keymap for p4 minor mode")
-(fset 'p4-minor-map p4-minor-map)
-(or (assoc 'p4-mode minor-mode-alist)
-    (setq minor-mode-alist (cons '(p4-mode p4-mode)
-				 minor-mode-alist)))
-(or (assoc 'p4-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons '(p4-mode . p4-minor-map) minor-mode-map-alist)))
-(or (assoc 'p4-offline-mode minor-mode-alist)
-    (setq minor-mode-alist (cons '(p4-offline-mode p4-offline-mode)
-				 minor-mode-alist)))
-(or (assoc 'p4-offline-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons '(p4-offline-mode . p4-minor-map) minor-mode-map-alist)))
-
-(defvar p4-async-minor-mode nil
-  "The minor mode for editing p4 asynchronous command buffers.")
-(make-variable-buffer-local 'p4-async-minor-mode)
-(defvar p4-async-minor-map (make-sparse-keymap) "Keymap for p4 async minor mode")
-(fset 'p4-async-minor-map p4-async-minor-map)
-
-(or (assoc 'p4-async-minor-mode minor-mode-alist)
-    (setq minor-mode-alist
-	  (cons '(p4-async-minor-mode " P4") minor-mode-alist)))
-
-(or (assoc 'p4-async-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons '(p4-async-minor-mode . p4-async-minor-map) minor-mode-map-alist)))
-
-(defvar p4-current-command nil)
-(make-variable-buffer-local 'p4-current-command)
-(put 'p4-current-command 'permanent-local t)
-(set-default 'p4-current-command nil)
-
-(defvar p4-current-args nil)
-(make-variable-buffer-local 'p4-current-args)
-(put 'p4-current-args 'permanent-local t)
-(set-default 'p4-current-args nil)
-
-;; To check if the current buffer's modeline and menu need to be altered
-(defvar p4-vc-check nil)
-(make-variable-buffer-local 'p4-vc-check)
-(put 'p4-vc-check 'permanent-local t)
-(set-default 'p4-vc-check nil)
-
-(defvar p4-set-client-hooks nil
-  "List of functions to be called after a p4 client is changed.
-The buffer's local variables (if any) will have been processed before the
-functions are called.")
-
-(if p4-running-emacs (require 'timer))
-
-(defvar p4-timer nil "Timer object that will be set to cleanup the caches
-periodically.")
-
-(defcustom p4-cleanup-time 600 "seconds after which `p4-cache-cleanup' will
-check for dirty caches."
-  :type 'integer
-  :group 'p4)
-
-(defcustom p4-cleanup-cache t "`p4-cache-cleanup' will cleanup the
-branches/clients/dirs/labels caches once in a while if this is non-nil."
-  :type 'boolean
-  :group 'p4)
-
-(defvar p4-all-buffer-files nil "An associated list of all buffers and
-their files under p4 version control. This is to enable autorefreshing of
-p4 submitted files being visited by the buffer.")
-
-(defvar p4-file-refresh-timer nil "Timer object that will be set to refresh
-the files in Emacs buffers that have been modified by a `p4-submit'.")
-
-(defcustom p4-file-refresh-timer-time 60 "seconds after which
-`p4-file-refresh' will check for modified files in Emacs buffers. Set this
-variable to 0 to disable periodic refreshing."
-  :type 'integer
-  :group 'p4)
-
-(defvar p4-async-command-hook nil
-  "This hook is run after an async buffer has been set up by
-`p4-async-process-command'")
-
-(defvar p4-window-config-stack nil
-  "Stack of saved window configurations.")
-
-(defcustom p4-window-config-stack-size 20 "Maximum stack size
-for saved window configurations."
-  :type 'integer
-  :group 'p4)
-
-(defcustom p4-exec-arg-len-max 20000 "Maximum total length of all
-arguments to p4 commands."
-  :type 'integer
-  :group 'p4)
-
-(defvar p4-basic-map
-  (let ((map (make-sparse-keymap)))
-    (cond (p4-running-xemacs
-	   (define-key map [button2] 'p4-buffer-mouse-clicked)
-	   (define-key map [button3] 'p4-buffer-mouse-clicked-3))
-	  (p4-running-emacs
-	   (define-key map [mouse-2] 'p4-buffer-mouse-clicked)
-	   (define-key map [mouse-3] 'p4-buffer-mouse-clicked-3)))
-    (define-key map [return] 'p4-buffer-commands)
-    (define-key map "\r" 'p4-buffer-commands)
-    (define-key map "q"	 'p4-quit-current-buffer)
-    (define-key map "k"	 'p4-scroll-down-1-line)
-    (define-key map "j"	 'p4-scroll-up-1-line)
-    (define-key map "b"	 'p4-scroll-down-1-window)
-    (define-key map [backspace] 'p4-scroll-down-1-window)
-    (define-key map " "	 'p4-scroll-up-1-window)
-    (define-key map "<"	 'p4-top-of-buffer)
-    (define-key map ">"	 'p4-bottom-of-buffer)
-    (define-key map "="	 'p4-delete-other-windows)
-    map))
-
-(defun p4-make-derived-map (base-map)
-  (let (map)
-    (cond (p4-running-xemacs
-	   (setq map (make-sparse-keymap))
-	   (set-keymap-parents map (list base-map)))
-	  (p4-running-emacs
-	   (setq map (cons 'keymap base-map))))
-    map))
-
-(defvar p4-filelog-map
-  (let ((map (p4-make-derived-map p4-basic-map)))
-    (define-key map "d"	 'p4-diff2)
-    (define-key map "f"	 'p4-find-file-other-window)
-    (define-key map "s"	 'p4-filelog-short-format)
-    (define-key map "l"	 'p4-filelog-long-format)
-    (define-key map "k"	 'p4-scroll-down-1-line-other-w)
-    (define-key map "j"	 'p4-scroll-up-1-line-other-w)
-    (define-key map "b"	 'p4-scroll-down-1-window-other-w)
-    (define-key map [backspace] 'p4-scroll-down-1-window-other-w)
-    (define-key map " "	 'p4-scroll-up-1-window-other-w)
-    (define-key map "<"	 'p4-top-of-buffer-other-w)
-    (define-key map ">"	 'p4-bottom-of-buffer-other-w)
-    (define-key map "="	 'p4-delete-other-windows)
-    (define-key map "n"	 'p4-goto-next-change)
-    (define-key map "p"	 'p4-goto-prev-change)
-    (define-key map "N" (lookup-key map "p"))
-    map)
-  "The key map to use for selecting filelog properties.")
-
-(defvar p4-opened-map
-  (let ((map (p4-make-derived-map p4-basic-map)))
-    (define-key map "n"	 'p4-next-depot-file)
-    (define-key map "p"	 'p4-prev-depot-file)
-    (define-key map "N" (lookup-key map "p"))
-    map)
-  "The key map to use for selecting opened files.")
-
-(defvar p4-diff-map
-  (let ((map (p4-make-derived-map p4-basic-map)))
-    (define-key map "n"	 'p4-goto-next-diff)
-    (define-key map "p"	 'p4-goto-prev-diff)
-    (define-key map "N" (lookup-key map "p"))
-    (define-key map "d"	 'p4-next-depot-diff)
-    (define-key map "u"	 'p4-prev-depot-diff)
-    map))
-
-(defvar p4-print-rev-map
-  (let ((map (p4-make-derived-map p4-basic-map)))
-    (define-key map "n"	 'p4-next-change-rev-line)
-    (define-key map "p"	 'p4-prev-change-rev-line)
-    (define-key map "N" (lookup-key map "p"))
-    (define-key map "l"	 'p4-toggle-line-wrap)
-    map)
-  "The key map to use for browsing print-revs buffers.")
-
-;;; All functions start here.
-
-;; A generic function that we use to execute p4 commands
-(eval-and-compile
-  (defun p4-exec-p4 (output-buffer args &optional clear-output-buffer)
-    "Internal function called by various p4 commands.
-Executes p4 in the current buffer's current directory
-with output to a dedicated output buffer.
-If successful, adds the P4 menu to the current buffer.
-Does auto re-highlight management (whatever that is)."
-    (save-excursion
-      (if (eq major-mode 'dired-mode)
-	  (let ((dir (dired-current-directory)))
-	    (set-buffer output-buffer)
-	    (setq default-directory dir)))
-      (if clear-output-buffer
-	  (progn
-	    (set-buffer output-buffer)
-	    (delete-region (point-min) (point-max))))
-      (let ((result
-	     (apply 'call-process (p4-check-p4-executable) nil
-		    output-buffer
-		    nil			; update display?
-		    "-d" default-directory  ;override "PWD" env var
-		    args)))
-	(p4-menu-add)
-	(if (and p4-running-emacs
-		 (boundp 'hilit-auto-rehighlight))
-	    (setq hilit-auto-rehighlight nil))
-	result)))
-  (defun p4-call-p4-here (&rest args)
-    "Internal function called by various p4 commands.
-Executes p4 in the current buffer (generally a temp)."
-    (apply 'call-process (p4-check-p4-executable) nil
-	   t
-	   nil			; update display?
-	   "-d" default-directory  ;override "PWD" env var
-	   args)))
-
-(defun p4-push-window-config ()
-  "Push the current window configuration on the `p4-window-config-stack'
-stack."
-  (interactive)
-  (setq p4-window-config-stack
-	(cons (current-window-configuration)
-	      p4-window-config-stack))
-  (while (> (length p4-window-config-stack) p4-window-config-stack-size)
-    (setq p4-window-config-stack
-	  (reverse (cdr (reverse p4-window-config-stack))))))
-
-(defun p4-pop-window-config (num)
-  "Pop `num' elements from the `p4-window-config-stack' stack and use
-the last popped element to restore the window configuration."
-  (interactive "p")
-  (while (> num 0)
-    (if (eq p4-window-config-stack nil)
-	(error "window config stack empty"))
-    (set-window-configuration (car p4-window-config-stack))
-    (setq p4-window-config-stack (cdr p4-window-config-stack))
-    (setq num (1- num)))
-  (message "window config popped (stack size %d)"
-	   (length p4-window-config-stack)))
-
-
-;; The menu definition is in the XEmacs format. Emacs parses and converts
-;; this definition to its own menu creation commands.
-
-(defalias 'p4-toggle-vc-mode-off 'p4-toggle-vc-mode)
-(defalias 'p4-toggle-vc-mode-on 'p4-toggle-vc-mode)
-
-(eval-and-compile
-  (defvar p4-menu-def
-    '(["Specify Arguments..." universal-argument t]
-      ["--" nil nil]
-      ["Add Current to P4" p4-add
-       (and (p4-buffer-file-name) (not p4-mode))]
-      ["Check out/Edit"    p4-edit
-       (and (p4-buffer-file-name-2) (or (not p4-mode) buffer-read-only))]
-      ["Re-open"	       p4-reopen
-       (and (p4-buffer-file-name-2) (or (not p4-mode) (not buffer-read-only)))]
-      ["Revert File"  p4-revert
-       (and (p4-buffer-file-name-2) (or (not p4-mode) (not buffer-read-only)))]
-      ["Delete File from Depot"  p4-delete
-       (and (p4-buffer-file-name-2) (or (not p4-mode) buffer-read-only))]
-      ["Rename Depot File" p4-rename
-       (and (p4-buffer-file-name-2) (or (not p4-mode) buffer-read-only))]
-      ["Submit Changes"  p4-submit t]
-      ["--" nil nil]
-      ["Sync/Get Files from Depot" p4-get t]
-      ["--" nil nil]
-      ["Show Opened Files"	p4-opened t]
-      ["Filelog" p4-filelog (p4-buffer-file-name-2)]
-      ["Changes" p4-changes t]
-      ["Describe Change" p4-describe t]
-      ["--" nil nil]
-      ["Diff 2 Versions" p4-diff2 (p4-buffer-file-name-2)]
-      ["Diff Current" p4-diff t]
-      ["Diff All Opened Files" p4-diff-all-opened t]
-      ["Diff Current with Ediff"   p4-ediff
-       (and (p4-buffer-file-name) (not buffer-read-only) p4-mode)]
-      ["Diff 2 Versions with Ediff"   p4-ediff2 (p4-buffer-file-name-2)]
-      ["--" nil nil]
-      ["Schedule Integrations" p4-integ t]
-      ["Resolve Conflicts" p4-resolve t]
-      ["--" nil nil]
-      ["Print" p4-print (p4-buffer-file-name-2)]
-      ["Print with Revision History" p4-blame
-       (p4-buffer-file-name-2)]
-      ["Find File using Depot Spec" p4-depot-find-file
-       p4-do-find-file]
-      ["--" nil nil]
-      ["Edit a Branch Specification" p4-branch t]
-      ["Edit a Label Specification" p4-label t]
-      ["Edit a Client Specification" p4-client t]
-      ["Edit a User Specification" p4-user t]
-      ["--" nil nil]
-      ["Show Version" p4-emacs-version t]
-      ["Disable P4 VC Check"  p4-toggle-vc-mode-off
-       p4-do-find-file]
-      ["Enable P4 VC Check"	 p4-toggle-vc-mode-on
-       (not p4-do-find-file)]
-      ["--" nil nil]
-      ["Set P4 Config"  p4-set-client-config p4-do-find-file]
-      ["Get Current P4 Config"  p4-get-client-config
-       p4-do-find-file]
-      ["--" nil nil]
-      ["Set P4 Client"  p4-set-client-name p4-do-find-file]
-      ["Get Current P4 Client"  p4-get-client-name
-       p4-do-find-file]
-      ["--" nil nil]
-      ["Set P4 Server/Port"	 p4-set-p4-port p4-do-find-file]
-      ["Get Current P4 Server/Port"	 p4-get-p4-port
-       p4-do-find-file]
-      ["--" nil nil]
-      ["Set P4 Notification List"  p4-set-notify-list
-       p4-mode]
-      ["Get P4 Notification List"  p4-get-notify-list p4-notify]
-      ["--" nil nil]
-      ["Describe Key Bindings"  p4-describe-bindings t]
-      ["Check for later versions of p4.el" p4-browse-web-page t]
-      ["--" nil nil]
-      ["Report Bug in p4.el"  p4-bug-report t])
-    "The P4 menu definition")
-
-  (cond (p4-running-xemacs
-	 ;; Menu Support for XEmacs
-	 (require 'easymenu)
-	 (defun p4-mode-menu (modestr)
-	   (cons modestr p4-menu-def)))
-
-	(p4-running-emacs
-	 ;; Menu support for Emacs
-	 (or (lookup-key global-map [menu-bar])
-	     (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
-	 (defvar menu-bar-p4-menu (make-sparse-keymap "P4"))
-	 (setq menu-bar-final-items (cons 'p4-menu menu-bar-final-items))
-	 (define-key global-map [menu-bar p4-menu]
-	   (cons "P4" menu-bar-p4-menu))
-	 (let ((m (reverse p4-menu-def))
-	       (separator-number 0))
-	   (while m
-	     (let ((menu-text (elt (car m) 0))
-		   (menu-action (elt (car m) 1))
-		   (menu-pred (elt (car m) 2)))
-	       (if menu-action
-		   (progn
-		     (define-key menu-bar-p4-menu (vector menu-action)
-		       (cons menu-text menu-action))
-		     (put menu-action 'menu-enable menu-pred))
-		 (define-key menu-bar-p4-menu
-		   (vector (make-symbol
-			    (concat "separator-"
-				    (int-to-string separator-number))))
-		   '("--"))
-		 (setq separator-number (1+ separator-number))))
-	     (setq m (cdr m))))))
-
-  (defun p4-depot-output (command &optional args)
-    "Executes p4 command inside a buffer.
-Returns the buffer."
-    (let ((buffer (generate-new-buffer p4-output-buffer-name)))
-      (p4-exec-p4 buffer (cons command args) t)
-      buffer))
-
-  (defun p4-check-p4-executable ()
-    "Check if the `p4-executable' is nil, and if so, prompt the user for a
-valid `p4-executable'."
-    (interactive)
-    (if (not p4-executable)
-	(call-interactively 'p4-set-p4-executable)
-      p4-executable))
-
-  (defun p4-menu-add ()
-    "To add the P4 menu bar button for files that are already not in
-the P4 depot or in the current client view.."
-    (interactive)
-    (cond (p4-running-xemacs
-	   (if (not (boundp 'p4-mode))
-	       (setq p4-mode nil))
-	   (easy-menu-add (p4-mode-menu "P4"))))
-    t)
-
-  (defun p4-help-text (cmd text)
-    (setq cmd nil)
-    (if cmd
-	(let ((buf (generate-new-buffer p4-output-buffer-name))
-	      (help-text ""))
-	  (if (= (p4-exec-p4 buf (list "help" cmd) t) 0)
-	      (setq help-text (save-excursion
-				(set-buffer buf)
-				(buffer-string))))
-	  (kill-buffer buf)
-	  (concat text help-text))
-      text))
-
-  ;; To set the path to the p4 executable
-  (defun p4-set-p4-executable (p4-exe-name)
-    "Set the path to the correct P4 Executable.
-
-To set this as a part of the .emacs, add the following to your .emacs:
-
-\(load-library \"p4\"\)
-\(p4-set-p4-executable \"/my/path/to/p4\"\)
-
-Argument P4-EXE-NAME The new value of the p4 executable, with full path."
-    (interactive "fFull path to your P4 executable: " )
-    (setq p4-executable p4-exe-name)
-    p4-executable))
-
-;; The kill-buffer hook for p4.
-(defun p4-kill-buffer-hook ()
-  "To Remove a file and its associated buffer from our global list of P4
-controlled files."
-  (if p4-vc-check
-      (p4-refresh-refresh-list (p4-buffer-file-name)
-			       (buffer-name))))
-
-(defmacro defp4cmd (fkn &rest all-args)
-  (let ((args (car all-args))
-	(help-cmd (cadr all-args))
-	(help-txt (eval (cadr (cdr all-args))))
-	(body (cdr (cddr all-args))))
-    `(defalias ',fkn
-       ,(append (list 'lambda args
-		      (p4-help-text help-cmd help-txt))
-		body))))
-
-(defun p4-noinput-buffer-action (cmd
-				 do-revert
-				 show-output
-				 &optional arguments preserve-buffer)
-  "Internal function called by various p4 commands."
-  (save-excursion
-    (save-excursion
-      (if (not preserve-buffer)
-	  (progn
-	    (get-buffer-create p4-output-buffer-name);; We do these two lines
-	    (kill-buffer p4-output-buffer-name)))    ;; to ensure no duplicates
-      (p4-exec-p4 (get-buffer-create p4-output-buffer-name)
-		  (append (list cmd) arguments)
-		  t))
-    (p4-partial-cache-cleanup cmd)
-    (if show-output
-	(if (and
-	     (eq show-output 's)
-	     (= (save-excursion
-		  (set-buffer p4-output-buffer-name)
-		  (count-lines (point-min) (point-max)))
-		1)
-	     (not (save-excursion
-		    (set-buffer p4-output-buffer-name)
-		    (goto-char (point-min))
-		    (looking-at "==== "))))
-	    (save-excursion
-	      (set-buffer p4-output-buffer-name)
-	      (message (buffer-substring (point-min)
-					 (save-excursion
-					   (goto-char (point-min))
-					   (end-of-line)
-					   (point)))))
-	  (p4-push-window-config)
-	  (if (not (one-window-p))
-	      (delete-other-windows))
-	  (display-buffer p4-output-buffer-name t))))
-  (if (and do-revert (p4-buffer-file-name))
-      (revert-buffer t t)))
-
-;; The p4 edit command
-(defp4cmd p4-edit (show-output)
-  "edit" "To open the current depot file for edit, type \\[p4-edit].\n"
-  (interactive (list p4-verbose))
-  (let ((args (p4-buffer-file-name))
-	refresh-after)
-    (if (or current-prefix-arg (not args))
-	(progn
-	  (setq args (if (p4-buffer-file-name-2)
-			 (p4-buffer-file-name-2)
-		       ""))
-	  (setq args (p4-make-list-from-string
-		      (p4-read-arg-string "p4 edit: " (cons args 0))))
-	  (setq refresh-after t))
-      (setq args (list args)))
-    (p4-noinput-buffer-action "edit" t (and show-output 's) args)
-    (if refresh-after
-	(p4-refresh-files-in-buffers)))
-  (p4-check-mode)
-  (p4-update-opened-list))
-
-;; The p4 reopen command
-(defp4cmd p4-reopen (show-output)
-  "reopen"
-  "To change the type or changelist number of an opened file, type \\[p4-reopen].
-
-Argument SHOW-OUTPUT displays the *P4 Output* buffer on executing the
-command if t.\n"
-
-  (interactive (list p4-verbose))
-  (let ((args (if (p4-buffer-file-name-2)
-		  (p4-buffer-file-name-2)
-		"")))
-    (setq args (p4-make-list-from-string
-		(p4-read-arg-string "p4 reopen: " (cons args 0))))
-    (p4-noinput-buffer-action "reopen" t (and show-output 's) args))
-  (p4-check-mode)
-  (p4-update-opened-list))
-
-;; The p4 revert command
-(defp4cmd p4-revert (show-output)
-  "revert" "To revert all change in the current file, type \\[p4-revert].\n"
-  (interactive (list p4-verbose))
-  (let ((args (p4-buffer-file-name))
-	refresh-after)
-    (if (or current-prefix-arg (not args))
-	(progn
-	  (setq args (if (p4-buffer-file-name-2)
-			 (p4-buffer-file-name-2)
-		       ""))
-	  (setq args (p4-make-list-from-string
-		      (p4-read-arg-string "p4 revert: " args)))
-	  (setq refresh-after t))
-      (setq args (list args)))
-    (if (yes-or-no-p "Really revert changes? ")
-	(progn
-	  (p4-noinput-buffer-action "revert" t (and show-output 's) args)
-	  (if refresh-after
-	      (progn
-		(p4-refresh-files-in-buffers)
-		(p4-check-mode-all-buffers))
-	    (p4-check-mode))
-	  (p4-update-opened-list)))))
-
-;; The p4 lock command
-(defp4cmd p4-lock ()
-  "lock" "To lock an opened file against changelist submission, type \\[p4-lock].\n"
-  (interactive)
-  (let ((args (list (p4-buffer-file-name-2))))
-    (if (or current-prefix-arg (not (p4-buffer-file-name-2)))
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 lock: "
-					(p4-buffer-file-name-2)))))
-    (p4-noinput-buffer-action "lock" t 's args)
-    (p4-update-opened-list)))
-
-;; The p4 unlock command
-(defp4cmd p4-unlock ()
-  "unlock" "To release a locked file but leave open, type \\[p4-unlock].\n"
-  (interactive)
-  (let ((args (list (p4-buffer-file-name-2))))
-    (if (or current-prefix-arg (not (p4-buffer-file-name-2)))
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 unlock: "
-					(p4-buffer-file-name-2)))))
-    (p4-noinput-buffer-action "unlock" t 's args)
-    (p4-update-opened-list)))
-
-;; The p4 diff command
-(defp4cmd p4-diff ()
-  "diff" "To diff the current file and topmost depot version, type \\[p4-diff].\n"
-  (interactive)
-  (let ((args (p4-make-list-from-string p4-default-diff-options)))
-    (if (p4-buffer-file-name-2)
-	(setq args (append args
-			   (list (p4-buffer-file-name-2)))))
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 diff: " p4-default-diff-options))))
-    (p4-noinput-buffer-action "diff" nil 's args)
-    (p4-activate-diff-buffer "*P4 diff*")))
-
-(defun p4-diff-all-opened ()
-  (interactive)
-  (p4-noinput-buffer-action "diff" nil 's
-			    (p4-make-list-from-string p4-default-diff-options))
-  (p4-activate-diff-buffer "*P4 diff*"))
-
-
-(defun p4-get-file-rev (default-name rev)
-  (if (string-match "^\\([0-9]+\\|none\\|head\\|have\\)$" rev)
-      (setq rev (concat "#" rev)))
-  (cond ((string-match "^[#@]" rev)
-	 (concat default-name rev))
-	((string= "" rev)
-	 default-name)
-	(t
-	 rev)))
-
-;; The p4 diff2 command
-(defp4cmd p4-diff2 (version1 version2)
-  "diff2" "Display diff of two depot files.
-
-When visiting a depot file, type \\[p4-diff2] and enter the versions.\n"
-  (interactive
-   (let ((rev (get-char-property (point) 'rev)))
-     (if (and (not rev) (p4-buffer-file-name-2))
-	 (let ((rev-num 0))
-	   (setq rev (p4-is-vc nil (p4-buffer-file-name-2)))
-	   (if rev
-	       (setq rev-num (string-to-number rev)))
-	   (if (> rev-num 1)
-	       (setq rev (number-to-string (1- rev-num)))
-	     (setq rev nil))))
-     (list (p4-read-arg-string "First Depot File or Version# to diff: " rev)
-	   (p4-read-arg-string "Second Depot File or Version# to diff: "))))
-  (let (diff-version1
-	diff-version2
-	(diff-options (p4-make-list-from-string p4-default-diff-options)))
-    (if current-prefix-arg
-	(setq diff-options (p4-make-list-from-string
-			    (p4-read-arg-string "Optional Args: "
-						p4-default-diff-options))))
-    ;; try to find out if this is a revision number, or a depot file
-    (setq diff-version1 (p4-get-file-rev (p4-buffer-file-name-2) version1))
-    (setq diff-version2 (p4-get-file-rev (p4-buffer-file-name-2) version2))
-
-    (p4-noinput-buffer-action "diff2" nil t
-			      (append diff-options
-				      (list diff-version1
-					    diff-version2)))
-    (p4-activate-diff-buffer "*P4 diff2*")))
-
-;; p4-ediff for all those who diff using ediff
-(defun p4-ediff ()
-  "Use ediff to compare file with its original client version."
-  (interactive)
-  (require 'ediff)
-  (if current-prefix-arg
-      (call-interactively 'p4-ediff2)
-    (progn
-      (p4-noinput-buffer-action "print" nil nil
-				(list "-q"
-				      (concat (p4-buffer-file-name) "#have")))
-      (let ((local (current-buffer))
-	    (depot (get-buffer-create p4-output-buffer-name)))
-	(ediff-buffers local
-		       depot
-		       `((lambda ()
-			   (make-local-variable 'ediff-cleanup-hook)
-			   (setq ediff-cleanup-hook
-				 (cons (lambda ()
-					 (kill-buffer ,depot)
-					 (p4-menu-add))
-				       ediff-cleanup-hook)))))))))
-
-(defp4cmd p4-ediff2 (version1 version2)
-  "ediff2" "Use ediff to display two versions of a depot file.
-
-When visiting a depot file, type \\[p4-ediff2] and enter the versions.\n"
-  (interactive
-   (let ((rev (get-char-property (point) 'rev)))
-     (if (and (not rev) (p4-buffer-file-name-2))
-	 (let ((rev-num 0))
-	   (setq rev (p4-is-vc nil (p4-buffer-file-name-2)))
-	   (if rev
-	       (setq rev-num (string-to-number rev)))
-	   (if (> rev-num 1)
-	       (setq rev (number-to-string (1- rev-num)))
-	     (setq rev nil))))
-     (list (p4-read-arg-string "First Depot File or Version# to diff: " rev)
-	   (p4-read-arg-string "Second Depot File or Version# to diff: "))))
-  (let* ((file-name (p4-buffer-file-name-2))
-         (basename (file-name-nondirectory file-name))
-         (bufname1 (concat "*P4 ediff " basename "#" version1  "*"))
-         (bufname2 (concat "*P4 ediff " basename "#" version2  "*"))
-         (diff-version1 (p4-get-file-rev file-name version1))
-         (diff-version2 (p4-get-file-rev file-name version2)))
-    (p4-noinput-buffer-action "print" nil nil (list "-q" diff-version1))
-    (set-buffer p4-output-buffer-name)
-    (rename-buffer bufname1 t)
-    (p4-noinput-buffer-action "print" nil nil (list "-q" diff-version2))
-    (set-buffer p4-output-buffer-name)
-    (rename-buffer bufname2 t)
-    (let ((buffer-version-1 (get-buffer-create bufname1))
-          (buffer-version-2 (get-buffer-create bufname2)))
-      (ediff-buffers buffer-version-1
-                     buffer-version-2
-                     `((lambda ()
-                         (make-local-variable 'ediff-cleanup-hook)
-                         (setq ediff-cleanup-hook
-                               (cons (lambda ()
-                                       (kill-buffer ,buffer-version-1)
-                                       (kill-buffer ,buffer-version-2)
-                                       (p4-menu-add))
-                                     ediff-cleanup-hook))))))))
-;; The p4 add command
-(defp4cmd p4-add ()
-  "add" "To add the current file to the depot, type \\[p4-add].\n"
-  (interactive)
-  (let ((args (p4-buffer-file-name))
-	refresh-after)
-    (if (or current-prefix-arg (not args))
-	(progn
-	  (setq args (if (p4-buffer-file-name-2)
-			 (p4-buffer-file-name-2)
-		       ""))
-	  (setq args (p4-make-list-from-string
-		      (p4-read-arg-string "p4 add: " (cons args 0))))
-	  (setq refresh-after t))
-      (setq args (list args)))
-    (p4-noinput-buffer-action "add" nil 's args)
-    (if refresh-after
-	(p4-check-mode-all-buffers)
-      (p4-check-mode)))
-  (p4-update-opened-list))
-
-
-;; The p4 delete command
-(defp4cmd p4-delete ()
-  "delete" "To delete the current file from the depot, type \\[p4-delete].\n"
-  (interactive)
-  (let ((args (p4-buffer-file-name)))
-    (if (or current-prefix-arg (not args))
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 delete: "
-					(p4-buffer-file-name-2))))
-      (setq args (list args)))
-    (if (yes-or-no-p "Really delete from depot? ")
-	(p4-noinput-buffer-action "delete" nil 's args)))
-  (p4-check-mode)
-  (p4-update-opened-list))
-
-;; The p4 filelog command
-(defp4cmd p4-filelog ()
-  "filelog"
-  "To view a history of the change made to the current file, type \\[p4-filelog].\n"
-  (interactive)
-  (let ((file-name (p4-buffer-file-name-2)))
-    (if (or current-prefix-arg (not file-name))
-	(setq file-name (p4-make-list-from-string
-			 (p4-read-arg-string "p4 filelog: " file-name)))
-      (setq file-name (list file-name)))
-    (p4-file-change-log "filelog" file-name)))
-
-(defun p4-set-extent-properties (start end prop-list)
-  (cond (p4-running-xemacs
-	 (let ((ext (make-extent start end)))
-	   (while prop-list
-	     (set-extent-property ext (caar prop-list) (cdar prop-list))
-	     (setq prop-list (cdr prop-list)))))
-	(p4-running-emacs
-	 (let ((ext (make-overlay start end)))
-	   (while prop-list
-	     (overlay-put ext (caar prop-list) (cdar prop-list))
-	     (setq prop-list (cdr prop-list)))))))
-
-(defun p4-create-active-link (start end prop-list)
-  (p4-set-extent-properties start end
-			    (append (list (cons 'face 'bold)
-					  (cons 'mouse-face 'highlight))
-				    prop-list)))
-
-(defun p4-move-buffer-point-to-top (buf-name)
-  (if (get-buffer-window buf-name)
-      (save-selected-window
-	(select-window (get-buffer-window buf-name))
-	(goto-char (point-min)))))
-
-(defun p4-file-change-log (cmd file-list-spec)
-  (let ((p4-filelog-buffer
-	 (concat "*P4 " cmd ": "
-		 (p4-list-to-string file-list-spec) "*")))
-    (p4-noinput-buffer-action cmd nil t (cons "-l" file-list-spec))
-    (p4-activate-file-change-log-buffer p4-filelog-buffer)))
-
-(defun p4-activate-file-change-log-buffer (bufname)
-  (let (p4-cur-rev p4-cur-change p4-cur-action
-	p4-cur-user p4-cur-client)
-    (p4-activate-print-buffer bufname nil)
-    (set-buffer bufname)
-    (setq buffer-read-only nil)
-    (goto-char (point-min))
-    (while (re-search-forward (concat
-			       "^\\(\\.\\.\\. #\\([0-9]+\\) \\)?[Cc]hange "
-			       "\\([0-9]+\\) \\([a-z]+\\)?.*on.*by "
-			       "\\([^ @]+\\)@\\([^ \n]+\\).*\n"
-			       "\\(\\(\\([ \t].*\\)?\n\\)*\\)") nil t)
-      (let ((rev-match 2)
-	    (ch-match 3)
-	    (act-match 4)
-	    (user-match 5)
-	    (cl-match 6)
-	    (desc-match 7))
-	(setq p4-cur-rev (match-string rev-match))
-	(setq p4-cur-change (match-string ch-match))
-	(setq p4-cur-action (match-string act-match))
-	(setq p4-cur-user (match-string user-match))
-	(setq p4-cur-client (match-string cl-match))
-
-	(if (match-beginning rev-match)
-	    (p4-create-active-link (match-beginning rev-match)
-				   (match-end rev-match)
-				   (list (cons 'rev p4-cur-rev))))
-	(p4-create-active-link (match-beginning ch-match)
-			       (match-end ch-match)
-			       (list (cons 'change p4-cur-change)))
-	(if (match-beginning act-match)
-	    (p4-create-active-link (match-beginning act-match)
-				   (match-end act-match)
-				   (list (cons 'action p4-cur-action)
-					 (cons 'rev p4-cur-rev))))
-	(p4-create-active-link (match-beginning user-match)
-			       (match-end user-match)
-			       (list (cons 'user p4-cur-user)))
-	(p4-create-active-link (match-beginning cl-match)
-			       (match-end cl-match)
-			       (list (cons 'client p4-cur-client)))
-	(p4-set-extent-properties (match-beginning desc-match)
-				  (match-end desc-match)
-				  (list (cons 'invisible t)
-					(cons 'isearch-open-invisible t)))))
-    (p4-find-change-numbers bufname (point-min) (point-max))
-    (use-local-map p4-filelog-map)
-    (setq buffer-invisibility-spec (list))
-    (setq buffer-read-only t)
-    (p4-move-buffer-point-to-top bufname)))
-
-;; Scan specified region for references to change numbers
-;; and make the change numbers clickable.
-(defun p4-find-change-numbers (buffer start end)
-  (save-excursion
-    (set-buffer buffer)
-    (goto-char start)
-    (while (re-search-forward "\\(changes?\\|submit\\|p4\\)[:#]?[ \t\n]+" end t)
-      (while (looking-at
-	      (concat "\\([#@]\\|number\\|no\\.\\|\\)[ \t\n]*"
-		      "\\([0-9]+\\)[-, \t\n]*"
-		      "\\(and/or\\|and\\|&\\|or\\|\\)[ \t\n]*"))
-	(let ((ch-start (match-beginning 2))
-	      (ch-end (match-end 2))
-	      (ch-str (match-string 2))
-	      (next (match-end 0)))
-	  (set-text-properties 0 (length ch-str) nil ch-str)
-	  (p4-create-active-link ch-start ch-end (list (cons 'change ch-str)))
-	  (goto-char next))))))
-
-;; The p4 files command
-(defp4cmd p4-files ()
-  "files" "List files in the depot. Type, \\[p4-files].\n"
-  (interactive)
-  (let ((args (p4-buffer-file-name-2)))
-    (if (or current-prefix-arg (not args))
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 files: " (p4-buffer-file-name-2))))
-      (setq args (list args)))
-    (p4-noinput-buffer-action "files" nil t args)
-    (save-excursion
-      (set-buffer p4-output-buffer-name)
-      (p4-find-change-numbers p4-output-buffer-name (point-min) (point-max)))
-    (p4-make-depot-list-buffer
-     (concat "*P4 Files: (" (p4-current-client) ") " (car args) "*"))))
-
-
-(defvar p4-server-version-cache nil)
-
-(defun p4-get-server-version ()
-  "To get the version number of the p4 server."
-  (let ((p4-port (p4-current-server-port))
-	ser-ver pmin)
-    (setq ser-ver (cdr (assoc p4-port p4-server-version-cache)))
-    (if (not ser-ver)
-	(save-excursion
-	  (get-buffer-create p4-output-buffer-name)
-	  (set-buffer p4-output-buffer-name)
-	  (goto-char (point-max))
-	  (setq pmin (point))
-	  (if (zerop (p4-call-p4-here "info"))
-	      (progn
-		(goto-char pmin)
-		(re-search-forward
-		 "^Server version: .*\/.*\/\\(\\([0-9]+\\)\.[0-9]+\\)\/.*(.*)$")
-		(setq ser-ver (string-to-number (match-string 2)))
-		(setq p4-server-version-cache (cons (cons p4-port ser-ver)
-						    p4-server-version-cache))
-		(delete-region pmin (point-max))))))
-    ser-ver))
-
-(defun p4-get-client-root (client-name)
-  "To get the current value of Client's root type \\[p4-get-client-root].
-   This can be used by any other macro that requires this value."
-  (let (p4-client-root pmin)
-    (save-excursion
-      (get-buffer-create p4-output-buffer-name)
-      (set-buffer p4-output-buffer-name)
-      (goto-char (point-max))
-      (setq pmin (point))
-      (if (zerop (p4-call-p4-here "client" "-o" client-name))
-	  (progn
-	    (goto-char pmin)
-	    (re-search-forward "^Root:[ \t]+\\(.*\\)$")
-	    (setq p4-client-root (p4-canonize-client-root (match-string 1)))
-	    (delete-region pmin (point-max)))))
-    p4-client-root))
-
-(defun p4-canonize-client-root (p4-client-root)
-  "Canonizes client root"
-  (let ((len (length p4-client-root)))
-    ;; For Windows, since the client root may be terminated with
-    ;; a \ as in c:\ or drive:\foo\bar\, we need to strip the
-    ;; trailing \ .
-    (if (and (p4-windows-os)
-	     (> len 1)
-	     (equal (substring p4-client-root (1- len) len) "\\"))
-	(setq p4-client-root (substring p4-client-root 0 (1- len))))
-    p4-client-root))
-
-(defun p4-map-depot-files (file-list)
-  "Map a list of files in the depot on the current client.
-Return a list of pairs, where each pair consists of a depot
-name and a client name."
-  (let (file-map)
-    (while file-list
-      (let (sub-list (arg-len 0) elt)
-	(while (and file-list (< arg-len p4-exec-arg-len-max))
-	  (setq elt (car file-list))
-	  (setq file-list (cdr file-list))
-	  (setq sub-list (cons elt sub-list))
-	  (setq arg-len (+ arg-len (length elt) 1)))
-	(setq file-map (append file-map
-			       (p4-map-depot-files-int sub-list)))))
-    file-map))
-
-(defun p4-map-depot-files-int (file-list)
-  (let* ((current-client (p4-current-client))
-	 (client-root (p4-get-client-root current-client))
-	 (re-current-client (regexp-quote current-client))
-	 (re-client-root (regexp-quote client-root))
-	 files pmin)
-    (save-excursion
-      (get-buffer-create p4-output-buffer-name)
-      (set-buffer p4-output-buffer-name)
-      (goto-char (point-max))
-      (setq pmin (point))
-      (insert "\n")
-      (apply 'p4-call-p4-here "where" file-list)
-      (goto-char pmin)
-      (if (< (p4-get-server-version) 98)
-	  (while (re-search-forward
-		  (concat "^\\([^\n]+\\) //" re-current-client
-			  "\\(.*\\)$") nil t)
-	    (setq files (cons
-			 (cons
-			  (match-string 1)
-			  (concat client-root (match-string 2)))
-			 files)))
-	(while (re-search-forward
-		(concat "^\\([^\n]+\\) //" re-current-client
-			"\\([^\n]+\\) \\(" re-client-root ".*\\)$") nil t)
-	  (setq files (cons
-		       (cons
-			(match-string 1) (match-string 3)) files))))
-      (delete-region pmin (point-max)))
-    files))
-
-(make-face 'p4-depot-unmapped-face)
-(set-face-foreground 'p4-depot-unmapped-face "grey30")
-
-(make-face 'p4-depot-deleted-face)
-(set-face-foreground 'p4-depot-deleted-face "red")
-
-(make-face 'p4-depot-added-face)
-(set-face-foreground 'p4-depot-added-face "blue")
-
-(make-face 'p4-depot-branch-op-face)
-(set-face-foreground 'p4-depot-branch-op-face "blue4")
-
-(defun p4-make-depot-list-buffer (bufname &optional print-buffer)
-  "Take the p4-output-buffer-name buffer, rename it to bufname, and
-make all depot file names active, so that clicking them opens
-the corresponding client file."
-  (let (args files depot-regexp)
-    (set-buffer p4-output-buffer-name)
-    (goto-char (point-min))
-    (setq depot-regexp
-	  (if print-buffer
-	      "\\(^\\)\\(//[^/@# ][^/@#]*/[^@#]+\\)#[0-9]+ - "
-	    "^\\(\\.\\.\\. [^/\n]*\\|==== \\)?\\(//[^/@# ][^/@#]*/[^#\n]*\\)"))
-    (while (re-search-forward depot-regexp nil t)
-      (setq args (cons (match-string 2) args)))
-    (setq files (p4-map-depot-files args))
-    (get-buffer-create bufname);; We do these two lines
-    (kill-buffer bufname);; to ensure no duplicates
-    (set-buffer p4-output-buffer-name)
-    (rename-buffer bufname t)
-    (goto-char (point-min))
-    (while (re-search-forward depot-regexp nil t)
-      (let ((p4-client-file (cdr (assoc (match-string 2) files)))
-	    (p4-depot-file (match-string 2))
-	    (start (match-beginning 2))
-	    (end (match-end 2))
-	    (branching-op-p (and (match-string 1)
-				 (string-match "\\.\\.\\. \\.\\.\\..*"
-					       (match-string 1))))
-	    prop-list)
-	(if (and p4-client-file
-		 (file-readable-p p4-client-file))
-	    (setq prop-list (list (cons 'link-client-name
-					p4-client-file)))
-	  (setq prop-list (list (cons 'link-depot-name
-				      p4-depot-file))))
-	;; some kind of operation related to branching/integration
-	(if branching-op-p
-	    (setq prop-list (append (list
-				     (cons 'history-for p4-depot-file)
-				     (cons 'face
-					   'p4-depot-branch-op-face))
-				    prop-list)))
-	(cond
-	 ((not p4-client-file)
-	  (p4-set-extent-properties
-	   start end
-	   (append (list (cons 'face 'p4-depot-unmapped-face))
-		   prop-list)))
-	 ((save-excursion
-	    (goto-char end)
-	    (looking-at ".* deleted?[ \n]"))
-	  (p4-set-extent-properties
-	   start end
-	   (append (list (cons 'face 'p4-depot-deleted-face))
-		   prop-list)))
-	 ((save-excursion
-	    (goto-char end)
-	    (looking-at ".* \\(add\\|branch\\)\\(ed\\)?[ \n]"))
-	  (p4-create-active-link
-	   start end
-	   (append (list (cons 'face 'p4-depot-added-face))
-		   prop-list)))
-	 (t
-	  (p4-create-active-link start end prop-list)))))
-    (use-local-map p4-opened-map)
-    (setq buffer-read-only t)
-    (p4-move-buffer-point-to-top bufname)))
-
-;; The p4 print command
-(defp4cmd p4-print ()
-  "print" "To print a depot file to a buffer, type \\[p4-print].\n"
-  (interactive)
-  (let ((arg-string (p4-buffer-file-name-2))
-	(rev (get-char-property (point) 'rev))
-	(change (get-char-property (point) 'change)))
-    (cond (rev
-	   (setq arg-string (concat arg-string "#" rev)))
-	  (change
-	   (setq arg-string (concat arg-string "@" change))))
-    (if (or current-prefix-arg (not arg-string))
-	(setq arg-string (p4-make-list-from-string
-			  (p4-read-arg-string "p4 print: " arg-string)))
-      (setq arg-string (list arg-string)))
-    (p4-noinput-buffer-action "print" nil t arg-string)
-    (p4-activate-print-buffer "*P4 print*" t)))
-
-;; Insert text in a buffer, but make sure that the inserted text doesn't
-;; inherit any properties from surrounding text. This is needed for xemacs
-;; because the insert function makes the inserted text inherit properties.
-(defun p4-insert-no-properties (str)
-  (let ((start (point))
-	end)
-    (insert str)
-    (setq end (point))
-    (set-text-properties start end nil)))
-
-(defun p4-font-lock-buffer (buf-name)
-  (save-excursion
-    (let (file-name (first-line ""))
-      (set-buffer buf-name)
-      (goto-char (point-min))
-      (if (looking-at "^//[^#@]+/\\([^/#@]+\\)")
-	  (progn
-	    (setq file-name (match-string 1))
-	    (forward-line 1)
-	    (setq first-line (buffer-substring (point-min) (point)))
-	    (delete-region (point-min) (point))))
-      (setq buffer-file-name file-name)
-      (set-auto-mode)
-      (setq buffer-file-name nil)
-      (condition-case nil
-	  (font-lock-fontify-buffer)
-	(error nil))
-      (fundamental-mode)
-      (if (and p4-running-emacs
-	       (boundp 'hilit-auto-rehighlight))
-	  (setq hilit-auto-rehighlight nil))
-      (goto-char (point-min))
-      (p4-insert-no-properties first-line))))
-
-(defun p4-activate-print-buffer (buffer-name print-buffer)
-  (if print-buffer
-      (p4-font-lock-buffer p4-output-buffer-name))
-  (p4-make-depot-list-buffer buffer-name print-buffer)
-  (let ((depot-regexp
-	 (if print-buffer
-	     "^\\(//[^/@# ][^/@#]*/\\)[^@#]+#[0-9]+ - "
-	   "^\\(//[^/@# ][^/@#]*/\\)")))
-    (save-excursion
-      (set-buffer buffer-name)
-      (setq buffer-read-only nil)
-      (goto-char (point-min))
-      (while (re-search-forward depot-regexp nil t)
-	(let ((link-client-name (get-char-property (match-end 1)
-						   'link-client-name))
-	      (link-depot-name (get-char-property (match-end 1)
-						  'link-depot-name))
-	      (start (match-beginning 1))
-	      (end (point-max)))
-	  (save-excursion
-	    (if (re-search-forward depot-regexp nil t)
-		(setq end (match-beginning 1))))
-	  (if link-client-name
-	      (p4-set-extent-properties start end
-					(list (cons 'block-client-name
-						    link-client-name))))
-	  (if link-depot-name
-	      (p4-set-extent-properties start end
-					(list (cons 'block-depot-name
-						    link-depot-name))))))
-      (setq buffer-read-only t))))
-
-(defconst p4-blame-change-regex
-  (concat "^\\.\\.\\. #"     "\\([0-9]+\\)"   ;; revision
-	  "\\s-+change\\s-+" "\\([0-9]+\\)"   ;; change
-	  "\\s-+"            "\\([^ \t]+\\)"  ;; type
-	  "\\s-+on\\s-+"     "\\([^ \t]+\\)"  ;; date	   
-	  "\\s-+by\\s-+"     "\\([^ \t]+\\)"  ;; author
-	  "@"))
-
-(defconst p4-blame-branch-regex
-  "^\\.\\.\\. \\.\\.\\. branch from \\(//[^#]*\\)#")
-
-(defconst p4-blame-revision-regex
-  (concat "^\\([0-9]+\\),?"
-	  "\\([0-9]*\\)"
-	  "\\([acd]\\)"
-	  "\\([0-9]+\\),?"
-	  "\\([0-9]*\\)"))
-
-(defconst p4-blame-index-regex
-  (concat " *\\([0-9]+\\)"               ;; change
-	  " *\\([0-9]+\\)"               ;; revision
-	  " *\\([0-9]+/[0-9]+/[0-9]+\\)" ;; date
-	  "\\s-+\\([^:]*\\)"             ;; author
-	  ":"))          
-
-(defconst P4-REV  0)
-(defconst P4-DATE 1)
-(defconst P4-AUTH 2)
-(defconst P4-FILE 3)
-
-(defun p4-blame ()
-  "To Print a depot file with revision history to a buffer,
-type \\[p4-blame]"
-  (interactive)
-  (let ((arg-string (p4-buffer-file-name-2))
-	(rev (get-char-property (point) 'rev))
-	(change (get-char-property (point) 'change)))
-    (cond (rev
-	   (setq arg-string (concat arg-string "#" rev)))
-	  (change
-	   (setq arg-string (concat arg-string "@" change))))
-    (if (or current-prefix-arg (not arg-string))
-	(setq arg-string (p4-read-arg-string "p4 print-revs: " arg-string)))
-    (p4-blame-int arg-string)))
-
-(defalias 'p4-print-with-rev-history 'p4-blame)
-
-(defun p4-blame-int (file-spec)
-  (get-buffer-create p4-output-buffer-name);; We do these two lines
-  (kill-buffer p4-output-buffer-name)      ;; to ensure no duplicates
-  (let ((file-name file-spec)
-	(buffer (get-buffer-create p4-output-buffer-name))
-	head-name  ;; file spec of the head revision for this blame assignment
-	branch-p   ;; have we tracked into a branch?
-	cur-file   ;; file name of the current branch during blame assignment
-	change ch-alist fullname head-rev headseen)
-
-    ;; we asked for blame constrained by a change number
-    (if (string-match "\\(.*\\)@\\([0-9]+\\)" file-spec)
-	(progn
-	  (setq file-name (match-string 1 file-spec))
-	  (setq change (string-to-int (match-string 2 file-spec)))))
-
-    ;; we asked for blame constrained by a revision
-    (if (string-match "\\(.*\\)#\\([0-9]+\\)" file-spec)
-	(progn
-	  (setq file-name (match-string 1 file-spec))
-	  (setq head-rev (string-to-int (match-string 2 file-spec)))))
-
-    ;; make sure the filespec is unambiguous
-    (p4-exec-p4 buffer (list "files" file-name) t)
-    (save-excursion
-      (set-buffer buffer)
-      (if (> (count-lines (point-min) (point-max)) 1)
-	  (error "File pattern maps to more than one file.")))
-
-    ;; get the file change history:
-    (p4-exec-p4 buffer (list "filelog" "-i" file-spec) t)
-    (setq fullname (p4-read-depot-output buffer)
-	  cur-file  fullname
-	  head-name fullname)
-
-    ;; parse the history:
-    (save-excursion
-      (set-buffer buffer)
-      (goto-char (point-min))
-      (while (< (point) (point-max))
-
-	;; record the current file name (and the head file name,
-	;; if we have not yet seen one):
-	(if (looking-at "^\\(//.*\\)$")
-	    (setq cur-file (match-string 1)))
-
-	;; a non-branch change:
-	(if (looking-at p4-blame-change-regex)
-	    (let ((rev (string-to-int (match-string 1)))
-		  (ch (string-to-int (match-string 2)))
-		  (op (match-string 3))
-		  (date (match-string 4))
-		  (author (match-string 5)))
-	      (cond
-	       ;; after the change constraint, OR
-	       ;; after the revision constraint _for this file_
-	       ;;   [remember, branches complicate this]:
-	       ((or (and change   (< change ch))
-		    (and head-rev (< head-rev rev)
-			 (string= head-name cur-file))) nil)
-	       
-	       ;; file has been deleted, can't assign blame:
-	       ((string= op "delete") 
-		(if (not headseen) (goto-char (point-max))))
-
-	       ;; OK, we actually want to look at this one:
-	       (t
-		(setq ch-alist
-		      (cons
-		       (cons ch (list rev date author cur-file)) ch-alist))
-		(if (not head-rev) (setq head-rev rev))
-		(setq headseen t)) ))
-
-	  ;; not if we have entered a branch (this used to be used, isn't
-	  ;; right now - maybe again later:
-	  (if (and headseen (looking-at p4-blame-branch-regex))
-	      (setq branch-p t)) )
-	(forward-line)))
-    
-    (if (< (length ch-alist) 1)
-	(error "Head revision not available"))
-  
-    (let ((base-ch (int-to-string (caar ch-alist)))
-	  (ch-buffer (get-buffer-create "p4-ch-buf"))
-	  (tmp-alst (copy-alist ch-alist)))
-      (p4-exec-p4 ch-buffer
-		  (list "print" "-q" (concat cur-file "@" base-ch)) t)
-      (save-excursion
-	(set-buffer ch-buffer)
-	(goto-char (point-min))
-	(while (re-search-forward ".*\n" nil t)
-	  (replace-match (concat base-ch "\n"))))
-      (while (> (length tmp-alst) 1)
-	(let ((ch-1 (car (car  tmp-alst)))
-	      (ch-2 (car (cadr tmp-alst)))
-	      (file1 (nth P4-FILE (cdr (car  tmp-alst))))
-	      (file2 (nth P4-FILE (cdr (cadr tmp-alst))))
-	      ins-string)
-	  (setq ins-string (format "%d\n" ch-2))
-	  (p4-exec-p4 buffer (list "diff2"
-				   (format "%s@%d" file1 ch-1)
-				   (format "%s@%d" file2 ch-2)) t)
-	  (save-excursion
-	    (set-buffer buffer)
-	    (goto-char (point-max))
-	    (while (re-search-backward p4-blame-revision-regex nil t)
-	      (let ((la (string-to-int (match-string 1)))
-		    (lb (string-to-int (match-string 2)))
-		    (op (match-string 3))
-		    (ra (string-to-int (match-string 4)))
-		    (rb (string-to-int (match-string 5))))
-		(if (= lb 0)
-		    (setq lb la))
-		(if (= rb 0)
-		    (setq rb ra))
-		(cond ((string= op "a")
-		       (setq la (1+ la)))
-		      ((string= op "d")
-		       (setq ra (1+ ra))))
-		(save-excursion
-		  (set-buffer ch-buffer)
-		  (goto-line la)
-		  (let ((beg (point)))
-		    (forward-line (1+ (- lb la)))
-		    (delete-region beg (point)))
-		  (while (<= ra rb)
-		    (insert ins-string)
-		    (setq ra (1+ ra)))))))
-	  (setq tmp-alst (cdr tmp-alst))))
-      (p4-noinput-buffer-action "print" nil t
-				(list (format "%s#%d" fullname head-rev))
-				t)
-      (p4-font-lock-buffer p4-output-buffer-name)
-      (let (line cnum (old-cnum 0) change-data
-	    xth-rev xth-date xth-auth xth-file)
-	(save-excursion
-	  (set-buffer buffer)
-	  (goto-line 2)
-	  (move-to-column 0)
-	  (p4-insert-no-properties "Change  Rev       Date  Author\n")
-	  (while (setq line (p4-read-depot-output ch-buffer))
-	    (setq cnum (string-to-int line))
-	    (if (= cnum old-cnum)
-		(p4-insert-no-properties (format "%29s : " ""))
-
-	      ;; extract the change data from our alist: remember,
-	      ;; `eq' works for integers so we can use assq here:
-	      (setq change-data (cdr (assq cnum ch-alist))
-		    xth-rev     (nth P4-REV  change-data)
-		    xth-date    (nth P4-DATE change-data)
-		    xth-auth    (nth P4-AUTH change-data)
-		    xth-file    (nth P4-FILE change-data))
-	      
-	      (p4-insert-no-properties
-	       (format "%6d %4d %10s %7s: " cnum xth-rev xth-date xth-auth))
-	      (move-to-column 0)
-	      (if (looking-at p4-blame-index-regex)
-		  (let ((nth-cnum (match-string 1))
-			(nth-revn (match-string 2))
-			(nth-user (match-string 4)))
-		    (p4-create-active-link (match-beginning 1)
-					   (match-end 1)
-					   (list (cons 'change nth-cnum)))
-		    ;; revision needs to be linked to a file now that we
-		    ;; follow integrations (branches):
-		    (p4-create-active-link (match-beginning 2)
-					   (match-end 2)
-					   (list (cons 'rev  nth-revn)
-						 (cons 'link-depot-name xth-file)))
-		    (p4-create-active-link (match-beginning 4)
-					   (match-end 4)
-					   (list (cons 'user nth-user)))
-		    ;; truncate the user name:
-		    (let ((start (+ (match-beginning 4) 7))
-			  (end (match-end 4)))
-		      (if (> end start)
-			  (delete-region start end))))))
-	    (setq old-cnum cnum)
-	    (forward-line))))
-
-      (kill-buffer ch-buffer))
-    (let ((buffer-name (concat "*P4 print-revs " file-name "*")))
-      (p4-activate-print-buffer buffer-name nil)
-      (save-excursion
-	(set-buffer buffer-name)
-	(setq truncate-lines t)
-	(use-local-map p4-print-rev-map)))))
-
-;; The p4 refresh command
-(defp4cmd p4-refresh ()
-  "sync" "Refresh the contents of an unopened file. \\[p4-refresh].
-
-This is equivalent to \"sync -f\"
-"
-  (interactive)
-  (let ((args (p4-buffer-file-name)))
-    (if (or current-prefix-arg (not args))
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 refresh: ")))
-      (setq args (list args)))
-    (p4-noinput-buffer-action "refresh" nil t args)
-    (p4-refresh-files-in-buffers)
-    (p4-make-depot-list-buffer
-     (concat "*P4 Refresh: (" (p4-current-client) ") " (car args) "*"))))
-
-;; The p4 get/sync command
-(defp4cmd p4-sync ()
-  "sync"
-  "To synchronise the local view with the depot, type \\[p4-get].\n"
-  (interactive)
-  (p4-get))
-
-(defp4cmd p4-get ()
-  "sync"
-  "To synchronise the local view with the depot, type \\[p4-get].\n"
-  (interactive)
-  (let (args)
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string (p4-read-arg-string "p4 get: "))))
-    (p4-noinput-buffer-action "get" nil t args)
-    (p4-refresh-files-in-buffers)
-    (p4-make-depot-list-buffer
-     (concat "*P4 Get: (" (p4-current-client) ") " (car args) "*"))))
-
-;; The p4 have command
-(defp4cmd p4-have ()
-  "have" "To list revisions last gotten, type \\[p4-have].\n"
-  (interactive)
-  (let ((args (list "...")))
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 have: " (p4-buffer-file-name-2)))))
-    (p4-noinput-buffer-action "have" nil t args)
-    (p4-make-depot-list-buffer
-     (concat "*P4 Have: (" (p4-current-client) ") " (car args) "*"))))
-
-;; The p4 changes command
-(defp4cmd p4-changes ()
-  "changes" "To list changes, type \\[p4-changes].\n"
-  (interactive)
-  (let ((arg-list (list "-m" "200" "...")))
-    (if current-prefix-arg
-	(setq arg-list (p4-make-list-from-string
-			(p4-read-arg-string "p4 changes: " "-m 200"))))
-    (p4-file-change-log "changes" arg-list)))
-
-;; The p4 help command
-(defp4cmd p4-help (arg)
-  "help" "To print help message, type \\[p4-help].
-
-Argument ARG command for which help is needed.
-"
-  (interactive (list (p4-make-list-from-string
-		      (p4-read-arg-string "Help on which command: "
-					  nil "help"))))
-  (p4-noinput-buffer-action "help" nil t arg)
-  (p4-make-basic-buffer "*P4 help*"))
-
-(defun p4-make-basic-buffer (buf-name &optional map)
-  "rename `p4-output-buffer-name' to buf-name \(which will be killed first if
-it already exists\), set its local map to map, if specified, or
-`p4-basic-map' otherwise. Makes the buffer read only."
-  (get-buffer-create buf-name)
-  (kill-buffer buf-name)
-  (set-buffer p4-output-buffer-name)
-  (goto-char (point-min))
-  (rename-buffer buf-name t)
-  (use-local-map (if (keymapp map) map p4-basic-map))
-  (setq buffer-read-only t)
-  (p4-move-buffer-point-to-top buf-name))
-
-;; The p4 info command
-(defp4cmd p4-info ()
-  "info" "To print out client/server information, type \\[p4-info].\n"
-  (interactive)
-  (p4-noinput-buffer-action "info" nil t)
-  (p4-make-basic-buffer "*P4 info*"))
-
-;; The p4 integrate command
-(defp4cmd p4-integ ()
-  "integ" "To schedule integrations between branches, type \\[p4-integ].\n"
-  (interactive)
-  (let ((args (p4-make-list-from-string
-	       (p4-read-arg-string "p4 integ: " "-b "))))
-    (p4-noinput-buffer-action "integ" nil t args)
-    (p4-make-depot-list-buffer "*P4 integ*")))
-
-(defp4cmd p4-resolve ()
-  "resolve"
-  "To merge open files with other revisions or files, type \\[p4-resolve].\n"
-  (interactive)
-  (let (buffer args (buf-name "*p4 resolve*"))
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 resolve: " nil))))
-    (setq buffer (get-buffer buf-name))
-    (if (and (buffer-live-p buffer)
-	     (not (comint-check-proc buffer)))
-	(save-excursion
-	  (let ((cur-dir default-directory))
-	    (set-buffer buffer)
-	    (cd cur-dir)
-	    (goto-char (point-max))
-	    (insert "\n--------\n\n"))))
-    (setq args (cons "resolve" args))
-    (setq buffer (apply 'make-comint "p4 resolve" p4-executable nil "-d" default-directory args))
-    (set-buffer buffer)
-    (comint-mode)
-    (display-buffer buffer)
-    (select-window (get-buffer-window buffer))
-    (goto-char (point-max))))
-
-(defp4cmd p4-rename ()
-  "rename" "To rename a file in the depot, type \\[p4-rename].
-
-This command will execute the integrate/delete commands automatically.
-"
-  (interactive)
-  (let (from-file to-file)
-    (setq from-file (p4-read-arg-string "rename from: " (p4-buffer-file-name-2)))
-    (setq to-file (p4-read-arg-string "rename to: " (p4-buffer-file-name-2)))
-    (p4-noinput-buffer-action "integ" nil t (list from-file to-file))
-    (p4-exec-p4 (get-buffer-create p4-output-buffer-name)
-		(list "delete" from-file)
-		nil)))
-
-(defun p4-scroll-down-1-line ()
-  "Scroll down one line"
-  (interactive)
-  (scroll-down 1))
-
-(defun p4-scroll-up-1-line ()
-  "Scroll up one line"
-  (interactive)
-  (scroll-up 1))
-
-(defun p4-scroll-down-1-window ()
-  "Scroll down one window"
-  (interactive)
-  (scroll-down
-   (- (window-height) next-screen-context-lines)))
-
-(defun p4-scroll-up-1-window ()
-  "Scroll up one window"
-  (interactive)
-  (scroll-up
-   (- (window-height) next-screen-context-lines)))
-
-(defun p4-top-of-buffer ()
-  "Top of buffer"
-  (interactive)
-  (goto-char (point-min)))
-
-(defun p4-bottom-of-buffer ()
-  "Bottom of buffer"
-  (interactive)
-  (goto-char (point-max)))
-
-(defun p4-delete-other-windows ()
-  "Make buffer full height"
-  (interactive)
-  (delete-other-windows))
-
-(defun p4-goto-next-diff ()
-  "Next diff"
-  (interactive)
-  (goto-char (window-start))
-  (if (= (point) (point-max))
-      (error "At bottom"))
-  (forward-line 1)
-  (re-search-forward "^====" nil "")
-  (beginning-of-line)
-  (set-window-start (selected-window) (point)))
-
-(defun p4-goto-prev-diff ()
-  "Previous diff"
-  (interactive)
-  (if (= (point) (point-min))
-      (error "At top"))
-  (goto-char (window-start))
-  (re-search-backward "^====" nil "")
-  (set-window-start (selected-window) (point)))
-
-(defun p4-next-depot-file ()
-  "Next file"
-  (interactive)
-  (goto-char (window-start))
-  (if (= (point) (point-max))
-      (error "At bottom"))
-  (forward-line 1)
-  (re-search-forward "^//[^/@# ][^/@#]*/[^@#]+#[0-9]+ - " nil "")
-  (beginning-of-line)
-  (set-window-start (selected-window) (point)))
-
-(defun p4-prev-depot-file ()
-  "Previous file"
-  (interactive)
-  (if (= (point) (point-min))
-      (error "At top"))
-  (goto-char (window-start))
-  (re-search-backward "^//[^/@# ][^/@#]*/[^@#]+#[0-9]+ - " nil "")
-  (set-window-start (selected-window) (point)))
-
-
-(defun p4-next-depot-diff ()
-  "Next diff"
-  (interactive)
-  (goto-char (window-start))
-  (if (= (point) (point-max))
-      (error "At bottom"))
-  (forward-line 1)
-  (re-search-forward "^\\(@@\\|\\*\\*\\* \\|[0-9]+[,acd]\\)" nil "")
-  (beginning-of-line)
-  (set-window-start (selected-window) (point)))
-
-(defun p4-prev-depot-diff ()
-  "Previous diff"
-  (interactive)
-  (if (= (point) (point-min))
-      (error "At top"))
-  (goto-char (window-start))
-  (re-search-backward "^\\(@@\\|\\*\\*\\* \\|[0-9]+[,acd]\\)" nil "")
-  (set-window-start (selected-window) (point)))
-
-(defun p4-moveto-print-rev-column (old-column)
-  (let ((colon (save-excursion
-		 (move-to-column 0)
-		 (if (looking-at "[^:\n]*:")
-		     (progn
-		       (goto-char (match-end 0))
-		       (current-column))
-		   0))))
-    (move-to-column old-column)
-    (if (and (< (current-column) colon)
-	     (re-search-forward "[^ ][ :]" nil t))
-	(goto-char (match-beginning 0)))))
-
-(defun p4-next-change-rev-line ()
-  "Next change/revision line"
-  (interactive)
-  (let ((c (current-column)))
-    (move-to-column 1)
-    (re-search-forward "^ *[0-9]+ +[0-9]+[^:]+:" nil "")
-    (p4-moveto-print-rev-column c)))
-
-(defun p4-prev-change-rev-line ()
-  "Previous change/revision line"
-  (interactive)
-  (let ((c (current-column)))
-    (forward-line -1)
-    (move-to-column 32)
-    (re-search-backward "^ *[0-9]+ +[0-9]+[^:]*:" nil "")
-    (p4-moveto-print-rev-column c)))
-
-(defun p4-toggle-line-wrap ()
-  "Toggle line wrap mode"
-  (interactive)
-  (setq truncate-lines (not truncate-lines))
-  (save-window-excursion
-    (recenter)))
-
-(defun p4-quit-current-buffer (pnt)
-  "Quit a buffer"
-  (interactive "d")
-  (if (not (one-window-p))
-      (delete-window)
-    (bury-buffer)))
-
-(defun p4-buffer-mouse-clicked (event)
-  "Function to translate the mouse clicks in a P4 filelog buffer to
-character events"
-  (interactive "e")
-  (let (win pnt)
-    (cond (p4-running-xemacs
-	   (setq win (event-window event))
-	   (setq pnt (event-point event)))
-	  (p4-running-emacs
-	   (setq win (posn-window (event-end event)))
-	   (setq pnt (posn-point (event-start event)))))
-    (select-window win)
-    (goto-char pnt)
-    (p4-buffer-commands pnt)))
-
-(defun p4-buffer-mouse-clicked-3 (event)
-  "Function to translate the mouse clicks in a P4 filelog buffer to
-character events"
-  (interactive "e")
-  (let (win pnt)
-    (cond (p4-running-xemacs
-	   (setq win (event-window event))
-	   (setq pnt (event-point event)))
-	  (p4-running-emacs
-	   (setq win (posn-window (event-end event)))
-	   (setq pnt (posn-point (event-start event)))))
-    (select-window win)
-    (goto-char pnt)
-    (let ((link-name (or (get-char-property pnt 'link-client-name)
-			 (get-char-property pnt 'link-depot-name)))
-	  (rev (get-char-property pnt 'rev)))
-      (cond (link-name
-	     (p4-diff))
-	    (rev
-	     (p4-diff2 rev "#head"))
-	    (t
-	     (error "No file to diff!"))))))
-
-(defun p4-buffer-commands (pnt)
-  "Function to get a given property and do the appropriate command on it"
-  (interactive "d")
-  (let ((rev (get-char-property pnt 'rev))
-	(change (get-char-property pnt 'change))
-	(action (get-char-property pnt 'action))
-	(user (get-char-property pnt 'user))
-	(client (get-char-property pnt 'client))
-	(label (get-char-property pnt 'label))
-	(branch (get-char-property pnt 'branch))
-	(filename (p4-buffer-file-name-2)))
-    (cond ((and (not action) rev)
-	   (let ((fn1 (concat filename "#" rev)))
-	     (p4-noinput-buffer-action "print" nil t (list fn1))
-	     (p4-activate-print-buffer "*P4 print*" t)))
-	  (action
-	   (let* ((rev2 (int-to-string (1- (string-to-int rev))))
-		  (fn1 (concat filename "#" rev))
-		  (fn2 (concat filename "#" rev2)))
-	     (if (> (string-to-int rev2) 0)
-		 (progn
-		   (p4-noinput-buffer-action
-		    "diff2" nil t
-		    (append (p4-make-list-from-string
-			     p4-default-diff-options)
-			    (list fn2 fn1)))
-		   (p4-activate-diff-buffer "*P4 diff*"))
-	       (error "There is no earlier revision to diff."))))
-	  (change (p4-describe-internal
-		   (append (p4-make-list-from-string p4-default-diff-options)
-			   (list change))))
-	  (user (p4-async-process-command "user" nil
-					  (concat
-					   "*P4 User: " user "*")
-					  "user" (list user)))
-	  (client (p4-async-process-command
-		   "client" "Description:\n\t"
-		   (concat "*P4 Client: " client "*") "client" (list client)))
-	  (label (p4-label (list label)))
-	  (branch (p4-branch (list branch)))
-
-	  ;; Check if a "filename link" or an active "diff buffer area" was
-	  ;; selected.
-	  (t
-	   (let ((link-client-name (get-char-property pnt 'link-client-name))
-		 (link-depot-name (get-char-property pnt 'link-depot-name))
-		 (block-client-name (get-char-property pnt 'block-client-name))
-		 (block-depot-name (get-char-property pnt 'block-depot-name))
-		 (p4-history-for (get-char-property pnt 'history-for))
-		 (first-line (get-char-property pnt 'first-line))
-		 (start (get-char-property pnt 'start)))
-	     (cond
-	      (p4-history-for
-	       (p4-file-change-log "filelog" (list p4-history-for)))
-	      ((or link-client-name link-depot-name)
-	       (p4-find-file-or-print-other-window
-		link-client-name link-depot-name))
-	      ((or block-client-name block-depot-name)
-	       (if first-line
-		   (let ((c (max 0 (- pnt
-				      (save-excursion
-					(goto-char pnt)
-					(beginning-of-line)
-					(point))
-				      1)))
-			 (r first-line))
-		     (save-excursion
-		       (goto-char start)
-		       (while (re-search-forward "^[ +>].*\n" pnt t)
-			 (setq r (1+ r))))
-		     (p4-find-file-or-print-other-window
-		      block-client-name block-depot-name)
-		     (goto-line r)
-		     (if (not block-client-name)
-			 (forward-line 1))
-		     (beginning-of-line)
-		     (goto-char (+ (point) c)))
-		 (p4-find-file-or-print-other-window
-		  block-client-name block-depot-name)))
-	      (t
-	       (error "There is no file at that cursor location!"))))))))
-
-(defun p4-find-file-or-print-other-window (client-name depot-name)
-  (if client-name
-      (find-file-other-window client-name)
-    (p4-noinput-buffer-action "print" nil t
-			      (list depot-name))
-    (p4-activate-print-buffer depot-name t)
-    (other-window 1)))
-
-(defun p4-find-file-other-window ()
-  "Open/print file"
-  (interactive)
-  (let ((link-client-name (get-char-property (point) 'link-client-name))
-	(link-depot-name (get-char-property (point) 'link-depot-name))
-	(block-client-name (get-char-property (point) 'block-client-name))
-	(block-depot-name (get-char-property (point) 'block-depot-name)))
-    (cond ((or link-client-name link-depot-name)
-	   (p4-find-file-or-print-other-window
-	    link-client-name link-depot-name)
-	   (other-window 1))
-	  ((or block-client-name block-depot-name)
-	   (p4-find-file-or-print-other-window
-	    block-client-name block-depot-name)
-	   (other-window 1)))))
-
-(defun p4-filelog-short-format ()
-  "Short format"
-  (interactive)
-  (setq buffer-invisibility-spec t)
-  (redraw-display))
-
-(defun p4-filelog-long-format ()
-  "Long format"
-  (interactive)
-  (setq buffer-invisibility-spec (list))
-  (redraw-display))
-
-(defun p4-scroll-down-1-line-other-w ()
-  "Scroll other window down one line"
-  (interactive)
-  (scroll-other-window -1))
-
-(defun p4-scroll-up-1-line-other-w ()
-  "Scroll other window up one line"
-  (interactive)
-  (scroll-other-window 1))
-
-(defun p4-scroll-down-1-window-other-w ()
-  "Scroll other window down one window"
-  (interactive)
-  (scroll-other-window
-   (- next-screen-context-lines (window-height))))
-
-(defun p4-scroll-up-1-window-other-w ()
-  "Scroll other window up one window"
-  (interactive)
-  (scroll-other-window
-   (- (window-height) next-screen-context-lines)))
-
-(defun p4-top-of-buffer-other-w ()
-  "Top of buffer, other window"
-  (interactive)
-  (other-window 1)
-  (goto-char (point-min))
-  (other-window -1))
-
-(defun p4-bottom-of-buffer-other-w ()
-  "Bottom of buffer, other window"
-  (interactive)
-  (other-window 1)
-  (goto-char (point-max))
-  (other-window -1))
-
-(defun p4-goto-next-change ()
-  "Next change"
-  (interactive)
-  (let ((c (current-column)))
-    (forward-line 1)
-    (while (get-char-property (point) 'invisible)
-      (forward-line 1))
-    (move-to-column c)))
-
-(defun p4-goto-prev-change ()
-  "Previous change"
-  (interactive)
-  (let ((c (current-column)))
-    (forward-line -1)
-    (while (get-char-property (point) 'invisible)
-      (forward-line -1))
-    (move-to-column c)))
-
-
-;; Activate special handling for a buffer generated with a diff-like command
-(make-face 'p4-diff-file-face)
-(set-face-background 'p4-diff-file-face "gray90")
-
-(make-face 'p4-diff-head-face)
-(set-face-background 'p4-diff-head-face "gray95")
-
-(make-face 'p4-diff-ins-face)
-(set-face-foreground 'p4-diff-ins-face "blue")
-
-(make-face 'p4-diff-del-face)
-(set-face-foreground 'p4-diff-del-face "red")
-
-(make-face 'p4-diff-change-face)
-(set-face-foreground 'p4-diff-change-face "dark green")
-
-(defun p4-buffer-set-face-property (regexp face-property)
-  (save-excursion
-    (goto-char (point-min))
-    (while (re-search-forward regexp nil t)
-      (let ((start (match-beginning 0))
-	    (end (match-end 0)))
-	(p4-set-extent-properties start end
-				  (list (cons 'face face-property)))))))
-
-(defun p4-activate-diff-buffer (buffer-name)
-  (p4-make-depot-list-buffer buffer-name)
-  (save-excursion
-    (set-buffer buffer-name)
-    (setq buffer-read-only nil)
-    (if p4-colorized-diffs
-	(progn
-	  (p4-buffer-set-face-property "^=.*\n" 'p4-diff-file-face)
-	  (p4-buffer-set-face-property "^[@*].*" 'p4-diff-head-face)
-	  (p4-buffer-set-face-property "^\\([+>].*\n\\)+" 'p4-diff-ins-face)
-	  (p4-buffer-set-face-property "^\\([-<].*\n\\)+" 'p4-diff-del-face)
-	  (p4-buffer-set-face-property "^\\(!.*\n\\)+" 'p4-diff-change-face)))
-
-    (goto-char (point-min))
-    (while (re-search-forward "^\\(==== //\\).*\n"
-			      nil t)
-      (let* ((link-client-name (get-char-property (match-end 1) 'link-client-name))
-	     (link-depot-name (get-char-property (match-end 1) 'link-depot-name))
-	     (start (match-beginning 0))
-	     (end (save-excursion
-		    (if (re-search-forward "^==== " nil t)
-			(match-beginning 0)
-		      (point-max)))))
-	(if link-client-name
-	    (p4-set-extent-properties start end
-				      (list (cons 'block-client-name
-						  link-client-name))))
-	(if link-depot-name
-	    (p4-set-extent-properties start end
-				      (list (cons 'block-depot-name
-						  link-depot-name))))))
-
-    (goto-char (point-min))
-    (while (re-search-forward
-	    (concat "^[@0-9].*\\([cad+]\\)\\([0-9]*\\).*\n"
-		    "\\(\\(\n\\|[^@0-9\n].*\n\\)*\\)") nil t)
-      (let ((first-line (string-to-int (match-string 2)))
-	    (start (match-beginning 3))
-	    (end (match-end 3)))
-	(p4-set-extent-properties start end
-				  (list (cons 'first-line first-line)
-					(cons 'start start)))))
-
-    (goto-char (point-min))
-    (let ((stop
-	   (if (re-search-forward "^\\(\\.\\.\\.\\|====\\)" nil t)
-	       (match-beginning 0)
-	     (point-max))))
-      (p4-find-change-numbers buffer-name (point-min) stop))
-
-    (goto-char (point-min))
-    (if (looking-at "^Change [0-9]+ by \\([^ @]+\\)@\\([^ \n]+\\)")
-	(let ((user-match 1)
-	      (cl-match 2)
-	      cur-user cur-client)
-	  (setq cur-user (match-string user-match))
-	  (setq cur-client (match-string cl-match))
-	  (p4-create-active-link (match-beginning user-match)
-				 (match-end user-match)
-				 (list (cons 'user cur-user)))
-	  (p4-create-active-link (match-beginning cl-match)
-				 (match-end cl-match)
-				 (list (cons 'client cur-client)))))
-
-    (use-local-map p4-diff-map)
-    (setq buffer-read-only t)))
-
-
-;; The p4 describe command
-(defp4cmd p4-describe ()
-  "describe" "To get a description for a change number, type \\[p4-describe].\n"
-  (interactive)
-  (let ((arg-string (p4-make-list-from-string
-		     (read-string "p4 describe: "
-				  (concat p4-default-diff-options " ")))))
-    (p4-describe-internal arg-string)))
-
-;; Internal version of the p4 describe command
-(defun p4-describe-internal (arg-string)
-  (p4-noinput-buffer-action
-   "describe" nil t arg-string)
-  (p4-activate-diff-buffer
-   (concat "*P4 describe: " (p4-list-to-string arg-string) "*")))
-
-;; The p4 opened command
-(defp4cmd p4-opened ()
-  "opened"
-  "To display list of files opened for pending change, type \\[p4-opened].\n"
-  (interactive)
-  (let (args)
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 opened: "
-					(p4-buffer-file-name-2)))))
-    (p4-opened-internal args)))
-
-(defun p4-opened-internal (args)
-  (let ((p4-client (p4-current-client)))
-    (p4-noinput-buffer-action "opened" nil t args)
-    (p4-make-depot-list-buffer (concat "*Opened Files: " p4-client "*"))))
-
-(defun p4-update-opened-list ()
-  (if (get-buffer-window (concat "*Opened Files: " (p4-current-client) "*"))
-      (progn
-	(setq current-prefix-arg nil)
-	(p4-opened-internal nil))))
-
-(defun p4-regexp-create-links (buffer-name regexp property)
-  (save-excursion
-    (set-buffer buffer-name)
-    (setq buffer-read-only nil)
-    (goto-char (point-min))
-    (while (re-search-forward regexp nil t)
-      (let ((start (match-beginning 1))
-	    (end (match-end 1))
-	    (str (match-string 1)))
-	(p4-create-active-link start end (list (cons property str)))))
-    (setq buffer-read-only t)))
-
-;; The p4 users command
-(defp4cmd p4-users ()
-  "users" "To display list of known users, type \\[p4-users].\n"
-  (interactive)
-  (let (args)
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 users: " nil "user"))))
-    (p4-noinput-buffer-action "users" nil t args))
-  (p4-make-basic-buffer "*P4 users*")
-  (p4-regexp-create-links "*P4 users*" "^\\([^ ]+\\).*\n" 'user))
-
-;; The p4 jobs command
-(defp4cmd p4-jobs ()
-  "jobs" "To display list of jobs, type \\[p4-jobs].\n"
-  (interactive)
-  (let (args)
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string (p4-read-arg-string "p4 jobs: "))))
-    (p4-noinput-buffer-action "jobs" nil t args))
-  (p4-make-basic-buffer "*P4 jobs*"))
-
-;; The p4 fix command
-(defp4cmd p4-fix ()
-  "fix" "To mark jobs as being fixed by a changelist number, type \\[p4-fix].\n"
-  (interactive)
-  (let ((args (p4-make-list-from-string (p4-read-arg-string "p4 fix: "
-							    nil "job"))))
-    (p4-noinput-buffer-action "fix" nil t args)))
-
-;; The p4 fixes command
-(defp4cmd p4-fixes ()
-  "fixes" "To list what changelists fix what jobs, type \\[p4-fixes].\n"
-  (interactive)
-  (let (args)
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string (p4-read-arg-string "p4 fixes: "))))
-    (p4-noinput-buffer-action "fixes" nil t args)
-    (p4-make-basic-buffer "*P4 fixes*")))
-
-;; The p4 where command
-(defp4cmd p4-where ()
-  "where"
-  "To show how local file names map into depot names, type \\[p4-where].\n"
-  (interactive)
-  (let (args)
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 where: "
-					(p4-buffer-file-name-2)))))
-    (p4-noinput-buffer-action "where" nil 's args)))
-
-
-(defun p4-async-process-command (p4-this-command &optional
-						 p4-regexp
-						 p4-this-buffer
-						 p4-out-command
-						 p4-in-args
-						 p4-out-args)
-  "Internal function to call an asynchronous process with a local buffer,
-instead of calling an external client editor to run within emacs.
-
-Arguments:
-P4-THIS-COMMAND is the command that called this internal function.
-
-P4-REGEXP is the optional regular expression to search for to set the cursor
-on.
-
-P4-THIS-BUFFER is the optional buffer to create. (Default is *P4 *).
-
-P4-OUT-COMMAND is the optional command that will be used as the command to
-be called when `p4-async-call-process' is called.
-
-P4-IN-ARGS is the optional argument passed that will be used as the list of
-arguments to the P4-THIS-COMMAND.
-
-P4-OUT-ARGS is the optional argument passed that will be used as the list of
-arguments to P4-OUT-COMMAND."
-  (let ((dir default-directory))
-    (if p4-this-buffer
-	(set-buffer (get-buffer-create p4-this-buffer))
-      (set-buffer (get-buffer-create (concat "*P4 " p4-this-command "*"))))
-    (setq p4-current-command p4-this-command)
-    (cd dir))
-  (if (zerop (apply 'call-process-region (point-min) (point-max)
-		    (p4-check-p4-executable) t t nil
-		    "-d" default-directory
-		    p4-current-command "-o"
-		    p4-in-args))
-      (progn
-	(goto-char (point-min))
-	(insert (concat "# Created using " (p4-emacs-version) ".\n"
-			"# Type C-c C-c to submit changes and exit buffer.\n"
-			"# Type C-x k to kill current changes.\n"
-			"#\n"))
-	(if p4-regexp (re-search-forward p4-regexp))
-	(indented-text-mode)
-	(setq p4-async-minor-mode t)
-	(setq fill-column 79)
-	(p4-push-window-config)
-	(switch-to-buffer-other-window (current-buffer))
-	(if p4-out-command
-	    (setq p4-current-command p4-out-command))
-	(setq p4-current-args p4-out-args)
-	(setq buffer-offer-save t)
-
-	(define-key p4-async-minor-map "\C-c\C-c" 'p4-async-call-process)
-	(run-hooks 'p4-async-command-hook)
-	(set-buffer-modified-p nil)
-	(message "C-c C-c to finish editing and exit buffer."))
-    (error "%s %s -o failed to complete successfully."
-	   (p4-check-p4-executable) p4-current-command)))
-
-(defun p4-async-call-process ()
-  "Internal function called by `p4-async-process-command' to process the
-buffer after editing is done using the minor mode key mapped to `C-c C-c'."
-  (interactive)
-  (message "p4 %s ..." p4-current-command)
-  (let ((max (point-max)) msg
-	(current-command p4-current-command)
-	(current-args p4-current-args))
-    (goto-char max)
-    (if (zerop (apply 'call-process-region (point-min)
-		      max (p4-check-p4-executable)
-		      nil '(t t) nil
-		      "-d" default-directory
-		      current-command "-i"
-		      current-args))
-	(progn
-	  (goto-char max)
-	  (setq msg (buffer-substring max (point-max)))
-	  (delete-region max (point-max))
-	  (save-excursion
-	    (set-buffer (get-buffer-create p4-output-buffer-name))
-	    (delete-region (point-min) (point-max))
-	    (insert msg))
-	  (kill-buffer nil)
-	  (display-buffer p4-output-buffer-name)
-	  (p4-partial-cache-cleanup current-command)
-	  (message "p4 %s done." current-command)
-	  (if (equal current-command "submit")
-	      (progn
-		(p4-refresh-files-in-buffers)
-		(p4-check-mode-all-buffers)
-		(if p4-notify
-		    (p4-notify p4-notify-list)))))
-      (error "%s %s -i failed to complete successfully."
-	     (p4-check-p4-executable)
-	     current-command))))
-
-(defun p4-cmd-line-flags (args)
-  (memq t (mapcar (lambda (x) (not (not (string-match "^-" x))))
-		  args)))
-
-;; The p4 change command
-(defp4cmd p4-change ()
-  "change" "To edit the change specification, type \\[p4-change].\n"
-  (interactive)
-  (let (args
-	(change-buf-name "*P4 New Change*"))
-    (if (buffer-live-p (get-buffer change-buf-name))
-	(switch-to-buffer-other-window (get-buffer change-buf-name))
-      (if current-prefix-arg
-	  (setq args (p4-make-list-from-string
-		      (p4-read-arg-string "p4 change: " nil))))
-      (if (p4-cmd-line-flags args)
-	  (p4-noinput-buffer-action "change" nil t args)
-	(p4-async-process-command "change" "Description:\n\t"
-				  change-buf-name nil args)))))
-
-;; The p4 client command
-(defp4cmd p4-client ()
-  "client" "To edit a client specification, type \\[p4-client].\n"
-  (interactive)
-  (let (args
-	(client-buf-name "*P4 client*"))
-    (if (buffer-live-p (get-buffer client-buf-name))
-	(switch-to-buffer-other-window (get-buffer client-buf-name))
-      (if current-prefix-arg
-	  (setq args (p4-make-list-from-string
-		      (p4-read-arg-string "p4 client: " nil "client"))))
-      (if (p4-cmd-line-flags args)
-	  (p4-noinput-buffer-action "client" nil t args)
-	(p4-async-process-command "client" "\\(Description\\|View\\):\n\t"
-				  client-buf-name nil args)))))
-
-(defp4cmd p4-clients ()
-  "clients" "To list all clients, type \\[p4-clients].\n"
-  (interactive)
-  (p4-noinput-buffer-action "clients" nil t nil)
-  (p4-make-basic-buffer "*P4 clients*")
-  (p4-regexp-create-links "*P4 clients*" "^Client \\([^ ]+\\).*\n" 'client))
-
-(defp4cmd p4-branch (args)
-  "branch" "Edit a P4-BRANCH specification using \\[p4-branch]."
-  (interactive (list
-		(p4-make-list-from-string
-		 (p4-read-arg-string "p4 branch: " nil "branch"))))
-  (if (or (null args) (equal args (list "")))
-      (error "Branch must be specified!")
-    (if (p4-cmd-line-flags args)
-	(p4-noinput-buffer-action "branch" nil t args)
-      (p4-async-process-command "branch" "Description:\n\t"
-				(concat "*P4 Branch: "
-					(car (reverse args)) "*")
-				"branch" args))))
-
-(defp4cmd p4-branches ()
-  "branches" "To list all branches, type \\[p4-branches].\n"
-  (interactive)
-  (p4-noinput-buffer-action "branches" nil t nil)
-  (p4-make-basic-buffer "*P4 branches*")
-  (p4-regexp-create-links "*P4 branches*" "^Branch \\([^ ]+\\).*\n" 'branch))
-
-(defp4cmd p4-label (args)
-  "label" "Edit a P4-label specification using \\[p4-label].\n"
-  (interactive (list
-		(p4-make-list-from-string
-		 (p4-read-arg-string "p4 label: " nil "label"))))
-  (if (or (null args) (equal args (list "")))
-      (error "label must be specified!")
-    (if (p4-cmd-line-flags args)
-	(p4-noinput-buffer-action "label" nil t args)
-      (p4-async-process-command "label" "Description:\n\t"
-				(concat "*P4 label: "
-					(car (reverse args)) "*")
-				"label" args))))
-
-(defp4cmd p4-labels ()
-  "labels" "To display list of defined labels, type \\[p4-labels].\n"
-  (interactive)
-  (p4-noinput-buffer-action "labels" nil t nil)
-  (p4-make-basic-buffer "*P4 labels*")
-  (p4-regexp-create-links "*P4 labels*" "^Label \\([^ ]+\\).*\n" 'label))
-
-;; The p4 labelsync command
-(defp4cmd p4-labelsync ()
-  "labelsync"
-  "To synchronize a label with the current client contents, type \\[p4-labelsync].\n"
-  (interactive)
-  (let ((args (p4-make-list-from-string
-	       (p4-read-arg-string "p4 labelsync: "))))
-    (p4-noinput-buffer-action "labelsync" nil t args))
-  (p4-make-depot-list-buffer "*P4 labelsync*"))
-
-(defun p4-filter-out (pred lst)
-  (let (res)
-    (while lst
-      (if (not (funcall pred (car lst)))
-	  (setq res (cons (car lst) res)))
-      (setq lst (cdr lst)))
-    (reverse res)))
-
-;; The p4 submit command
-(defp4cmd p4-submit (&optional arg)
-  "submit" "To submit a pending change to the depot, type \\[p4-submit].\n"
-  (interactive "P")
-  (let (args
-	(submit-buf-name "*P4 Submit*")
-	(change-list (if (integerp arg) arg)))
-    (if (buffer-live-p (get-buffer submit-buf-name))
-	(switch-to-buffer-other-window (get-buffer submit-buf-name))
-      (if change-list
-	  (setq args (list "-c" (int-to-string change-list)))
-	(if current-prefix-arg
-	    (setq args (p4-make-list-from-string
-			(p4-read-arg-string "p4 submit: " nil)))))
-      (setq args (p4-filter-out (lambda (x) (string= x "-c")) args))
-      (p4-save-opened-files)
-      (if (or (not (and p4-check-empty-diffs (p4-empty-diff-p)))
-	      (progn
-		(ding t)
-		(yes-or-no-p
-		 "File with empty diff opened for edit. Submit anyway? ")))
-	  (p4-async-process-command "change" "Description:\n\t"
-				    submit-buf-name "submit" args)))))
-
-;; The p4 user command
-(defp4cmd p4-user ()
-  "user" "To create or edit a user specification, type \\[p4-user].\n"
-  (interactive)
-  (let (args)
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 user: " nil "user"))))
-    (if (p4-cmd-line-flags args)
-	(p4-noinput-buffer-action "user" nil t args)
-      (p4-async-process-command "user" nil nil nil args))))
-
-;; The p4 job command
-(defp4cmd p4-job ()
-  "job" "To create or edit a job, type \\[p4-job].\n"
-  (interactive)
-  (let (args)
-    (if current-prefix-arg
-	(setq args (p4-make-list-from-string
-		    (p4-read-arg-string "p4 job: " nil "job"))))
-    (if (p4-cmd-line-flags args)
-	(p4-noinput-buffer-action "job" nil t args)
-      (p4-async-process-command "job" "Description:\n\t" nil nil args))))
-
-;; The p4 jobspec command
-(defp4cmd p4-jobspec ()
-  "jobspec" "To edit the job template, type \\[p4-jobspec].\n"
-  (interactive)
-  (p4-async-process-command "jobspec"))
-
-;; A function to set the current P4 client name
-(defun p4-set-client-name (p4-new-client-name)
-  "To set the current value of P4CLIENT, type \\[p4-set-client-name].
-
-This will change the current client from the previous client to the new
-given value.
-
-Setting this value to nil would disable P4 Version Checking.
-
-`p4-set-client-name' will complete any client names set using the function
-`p4-set-my-clients'. The strictness of completion will depend on the
-variable `p4-strict-complete' (default is t).
-
-Argument P4-NEW-CLIENT-NAME The new client to set to. The default value is
-the current client."
-  (interactive (list
-		(completing-read "Change Client to: "
-				 (if p4-my-clients
-				     p4-my-clients
-				   'p4-clients-completion)
-				 nil p4-strict-complete (p4-current-client))
-		))
-  (if (or (null p4-new-client-name) (equal p4-new-client-name "nil"))
-      (progn
-	(setenv "P4CLIENT" nil)
-	(if (not (getenv "P4CONFIG"))
-	    (message
-	     "P4 Version check disabled. Set a valid client name to enable."
-	     )))
-    (setenv "P4CLIENT" p4-new-client-name)
-    (message "P4CLIENT changed to %s" p4-new-client-name)
-    (run-hooks 'p4-set-client-hooks)))
-
-(defun p4-get-client-config ()
-  "To get the current value of the environment variable P4CONFIG,
-type \\[p4-get-client-config].
-
-This will be the current configuration that is in use for access through
-Emacs P4."
-
-  (interactive)
-  (message "P4CONFIG is %s" (getenv "P4CONFIG")))
-
-(defun p4-set-client-config (p4config)
-  "To set the P4CONFIG variable, for use with the current versions of the p4
-client.
-
-P4CONFIG is a more flexible mechanism wherein p4 will find the current
-client automatically by checking the config file found at the root of a
-directory \(recursing all the way to the top\).
-
-In this scenario, a P4CLIENT variable need not be explicitly set.
-"
-  (interactive "sP4 Config: ")
-  (if (or (null p4config) (equal p4config ""))
-      (message "P4CONFIG not changed.")
-    (setenv "P4CONFIG" p4config)
-    (message "P4CONFIG changed to %s" p4config)))
-
-(defun p4-set-my-clients (client-list)
-  "To set the client completion list used by `p4-set-client-name', use
-this function in your .emacs (or any lisp interaction buffer).
-
-This will change the current client list from the previous list to the new
-given value.
-
-Setting this value to nil would disable client completion by
-`p4-set-client-name'.
-
-The strictness of completion will depend on the variable
-`p4-strict-complete' (default is t).
-
-Argument CLIENT-LIST is the 'list' of clients.
-
-To set your clients using your .emacs, use the following:
-
-\(load-library \"p4\"\)
-\(p4-set-my-clients \'(client1 client2 client3)\)"
-  (setq p4-my-clients nil)
-  (let (p4-tmp-client-var)
-    (while client-list
-      (setq p4-tmp-client-var (format "%s" (car client-list)))
-      (setq client-list (cdr client-list))
-      (setq p4-my-clients (append p4-my-clients
-				  (list (list p4-tmp-client-var)))))))
-
-;; A function to get the current P4PORT
-(defun p4-get-p4-port ()
-  "To get the current value of the environment variable P4PORT, type \
-\\[p4-get-p4-port].
-
-This will be the current server/port that is in use for access through Emacs
-P4."
-  (interactive)
-  (let ((port (p4-current-server-port)))
-    (message "P4PORT is [local: %s], [global: %s]" port (getenv "P4PORT"))
-    port))
-
-;; A function to set the current P4PORT
-(defun p4-set-p4-port (p4-new-p4-port)
-  "To set the current value of P4PORT, type \\[p4-set-p4-port].
-
-This will change the current server from the previous server to the new
-given value.
-
-Argument P4-NEW-P4-PORT The new server:port to set to. The default value is
-the current value of P4PORT."
-  (interactive (list (let
-			 ((symbol (read-string "Change server:port to: "
-					       (getenv "P4PORT"))))
-		       (if (equal symbol "")
-			   (getenv "P4PORT")
-			 symbol))))
-  (if (or (null p4-new-p4-port) (equal p4-new-p4-port "nil"))
-      (progn
-	(setenv "P4PORT" nil)
-	(if (not (getenv "P4CONFIG"))
-	    (message
-	     "P4 Version check disabled. Set a valid server:port to enable.")))
-    (setenv "P4PORT" p4-new-p4-port)
-    (message "P4PORT changed to %s" p4-new-p4-port)))
-
-;; The find-file hook for p4.
-(defun p4-find-file-hook ()
-  "To check while loading the file, if it is a P4 version controlled file."
-  (if (or (getenv "P4CONFIG") (getenv "P4CLIENT"))
-      (p4-detect-p4)))
-
-(defun p4-refresh-refresh-list (buffile bufname)
-  "Refresh the list of files to be refreshed."
-  (setq p4-all-buffer-files (delete (list buffile bufname)
-				    p4-all-buffer-files))
-  (if (not p4-all-buffer-files)
-      (progn
-	(if (and p4-running-emacs (timerp p4-file-refresh-timer))
-	    (cancel-timer p4-file-refresh-timer))
-	(if (and p4-running-xemacs p4-file-refresh-timer)
-	    (disable-timeout p4-file-refresh-timer))
-	(setq p4-file-refresh-timer nil))))
-
-;; Set keymap. We use the C-x p Keymap for all perforce commands
-(defvar p4-prefix-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "a" 'p4-add)
-    (define-key map "b" 'p4-bug-report)
-    (define-key map "B" 'p4-branch)
-    (define-key map "c" 'p4-client)
-    (define-key map "C" 'p4-changes)
-    (define-key map "d" 'p4-diff2)
-    (define-key map "D" 'p4-describe)
-    (define-key map "e" 'p4-edit)
-    (define-key map "E" 'p4-reopen)
-    (define-key map "\C-f" 'p4-depot-find-file)
-    (define-key map "f" 'p4-filelog)
-    (define-key map "F" 'p4-files)
-    (define-key map "g" 'p4-get-client-name)
-    (define-key map "G" 'p4-get)
-    (define-key map "h" 'p4-help)
-    (define-key map "H" 'p4-have)
-    (define-key map "i" 'p4-info)
-    (define-key map "I" 'p4-integ)
-    (define-key map "j" 'p4-job)
-    (define-key map "J" 'p4-jobs)
-    (define-key map "l" 'p4-label)
-    (define-key map "L" 'p4-labels)
-    (define-key map "\C-l" 'p4-labelsync)
-    (define-key map "m" 'p4-rename)
-    (define-key map "n" 'p4-notify)
-    (define-key map "o" 'p4-opened)
-    (define-key map "p" 'p4-print)
-    (define-key map "P" 'p4-set-p4-port)
-    (define-key map "q" 'p4-pop-window-config)
-    (define-key map "r" 'p4-revert)
-    (define-key map "R" 'p4-refresh)
-    (define-key map "\C-r" 'p4-resolve)
-    (define-key map "s" 'p4-set-client-name)
-    (define-key map "S" 'p4-submit)
-    (define-key map "t" 'p4-toggle-vc-mode)
-    (define-key map "u" 'p4-user)
-    (define-key map "U" 'p4-users)
-    (define-key map "v" 'p4-emacs-version)
-    (define-key map "V" 'p4-blame)
-    (define-key map "w" 'p4-where)
-    (define-key map "x" 'p4-delete)
-    (define-key map "X" 'p4-fix)
-    (define-key map "=" 'p4-diff)
-    (define-key map "-" 'p4-ediff)
-    (define-key map "?" 'p4-describe-bindings)
-    map)
-  "The Prefix for P4 Library Commands.")
-
-(if (not (keymapp (lookup-key global-map "\C-xp")))
-    (define-key global-map "\C-xp" p4-prefix-map))
-
-;; For users interested in notifying a change, a notification list can be
-;; set up using this function.
-(defun p4-set-notify-list (p4-new-notify-list &optional p4-supress-stat)
-  "To set the current value of P4NOTIFY, type \\[p4-set-notify-list].
-
-This will change the current notify list from the existing list to the new
-given value.
-
-An empty string will disable notification.
-
-Argument P4-NEW-NOTIFY-LIST is new value of the notification list.
-Optional argument P4-SUPRESS-STAT when t will suppress display of the status
-message. "
-
-  (interactive (list (let
-			 ((symbol (read-string
-				   "Change Notification List to: "
-				   p4-notify-list)))
-		       (if (equal symbol "")
-			   nil
-			 symbol))))
-  (let ((p4-old-notify-list p4-notify-list))
-    (setenv "P4NOTIFY" p4-new-notify-list)
-    (setq p4-notify-list p4-new-notify-list)
-    (setq p4-notify (not (null p4-new-notify-list)))
-    (if (not p4-supress-stat)
-	(message "Notification list changed from '%s' to '%s'"
-		 p4-old-notify-list p4-notify-list))))
-
-;; To get the current notification list.
-(defun p4-get-notify-list ()
-  "To get the current value of the environment variable P4NOTIFY,
-type \\[p4-get-notify-list].
-
-   This will be the current notification list that is in use for mailing
-   change notifications through Emacs P4."
-
-  (interactive)
-  (message "P4NOTIFY is %s" p4-notify-list))
-
-(defun p4-notify (users)
-  "To notify a list of users of a change submission manually, type
-\\[p4-notify].
-
-To do auto-notification, set the notification list with `p4-set-notify-list'
-and on each submission, the users in the list will be notified of the
-change.
-
-Since this uses the sendmail program, it is mandatory to set the correct
-path to the sendmail program in the variable `p4-sendmail-program'.
-
-Also, it is mandatory to set the user's email address in the variable
-`p4-user-email'.
-
-Argument USERS The users to notify to. The default value is the notification
-list."
-  (interactive (list (let
-			 ((symbol (read-string "Notify whom? "
-					       p4-notify-list)))
-		       (if (equal symbol "")
-			   nil
-			 symbol))))
-  (p4-set-notify-list users t)
-  (if (and p4-sendmail-program p4-user-email)
-      (p4-do-notify)
-    (message "Please set p4-sendmail-program and p4-user-email variables.")))
-
-(defun p4-do-notify ()
-  "This is the internal notification function called by `p4-notify'."
-  (save-excursion
-    (if (and p4-notify-list (not (equal p4-notify-list "")))
-	(save-excursion
-	  (set-buffer (get-buffer-create p4-output-buffer-name))
-	  (goto-char (point-min))
-	  (if (re-search-forward "[0-9]+.*submitted" (point-max) t)
-	      (let (p4-matched-change)
-		(setq p4-matched-change (substring (match-string 0) 0 -10))
-		(set-buffer (get-buffer-create "*P4 Notify*"))
-		(delete-region (point-min) (point-max))
-		(call-process-region (point-min) (point-max)
-				     (p4-check-p4-executable)
-				     t t nil
-				     "-d" default-directory
-				     "describe" "-s"
-				     p4-matched-change)
-		(switch-to-buffer "*P4 Notify*")
-		(goto-char (point-min))
-		(let (p4-chg-desc)
-		  (if (re-search-forward "^Change.*$" (point-max) t)
-		      (setq p4-chg-desc (match-string 0))
-		    (setq p4-chg-desc (concat
-				       "Notification of Change "
-				       p4-matched-change)))
-		  (goto-char (point-min))
-		  (insert
-		   "From: " p4-user-email "\n"
-		   "To: P4 Notification Recipients:;\n"
-		   "Subject: " p4-chg-desc "\n")
-		  (call-process-region (point-min) (point-max)
-				       p4-sendmail-program t t nil
-				       "-odi" "-oi" p4-notify-list)
-
-		  (kill-buffer nil)))
-	    (save-excursion
-	      (set-buffer (get-buffer-create p4-output-buffer-name))
-	      (goto-char (point-max))
-	      (insert "\np4-do-notify: No Change Submissions found."))))
-      (save-excursion
-	(set-buffer (get-buffer-create p4-output-buffer-name))
-	(goto-char (point-max))
-	(insert "\np4-do-notify: Notification list not set.")))))
-
-;; Function to return the current version.
-(defun p4-emacs-version ()
-  "Return the current Emacs-P4 Integration version."
-  (interactive)
-  (message (concat (cond (p4-running-xemacs "X")) "Emacs-P4 Integration v%s")
-	   p4-emacs-version))
-
-(defun p4-find-p4-config-file ()
-  (let ((p4config (getenv "P4CONFIG"))
-	(p4-cfg-dir (cond ((p4-buffer-file-name)
-			   (file-name-directory
-			    (file-truename (p4-buffer-file-name))))
-			  (t (file-truename default-directory)))))
-    (if (not p4config)
-	nil
-      (let (found at-root)
-	(while (not (or found at-root))
-	  (let ((parent-dir (file-name-directory
-			     (directory-file-name
-			      p4-cfg-dir))))
-	    (if (file-exists-p (concat p4-cfg-dir p4config))
-		(setq found (concat p4-cfg-dir p4config)))
-	    (setq at-root (string-equal parent-dir p4-cfg-dir))
-	    (setq p4-cfg-dir parent-dir)))
-	found))))
-
-(defun p4-detect-p4 ()
-  (if (or (not p4-use-p4config-exclusively)
-	  (p4-find-p4-config-file))
-      (p4-check-mode)))
-
-(defun p4-get-add-branch-files (&optional name-list)
-  (let ((output-buffer (p4-depot-output "opened" name-list))
-	files depot-map)
-    (save-excursion
-      (set-buffer output-buffer)
-      (goto-char (point-min))
-      (while (re-search-forward "^\\(//[^/@#]+/[^#\n]*\\)#[0-9]+ - add " nil t)
-	(setq files (cons (cons (match-string 1) "Add")
-			  files)))
-      (goto-char (point-min))
-      (while (re-search-forward "^\\(//[^/@#]+/[^#\n]*\\)#[0-9]+ - branch " nil t)
-	(setq files (cons (cons (match-string 1) "Branch")
-			  files))))
-    (kill-buffer output-buffer)
-    (setq depot-map (p4-map-depot-files (mapcar 'car files)))
-    (mapcar (lambda (x) (cons (cdr (assoc (car x) depot-map))
-			      (cdr x))) files)))
-
-(defun p4-get-have-files (file-list)
-  (let ((output-buffer (p4-depot-output "have" file-list))
-	line files depot-map elt)
-    (while (setq line (p4-read-depot-output output-buffer))
-      (if (string-match "^\\(//[^/@#]+/[^#\n]*\\)#\\([0-9]+\\) - " line)
-	  (setq files (cons (cons (match-string 1 line)
-				  (match-string 2 line))
-			    files))))
-    (kill-buffer output-buffer)
-    (setq depot-map (p4-map-depot-files (mapcar 'car files)))
-    (setq files (mapcar (lambda (x) (cons (cdr (assoc (car x) depot-map))
-					  (cdr x))) files))
-    (while file-list
-      (setq elt (car file-list))
-      (setq file-list (cdr file-list))
-      (if (not (assoc elt files))
-	  (setq files (cons (cons elt nil) files))))
-    files))
-
-;; A function to check if the file being opened is version controlled by p4.
-(defun p4-is-vc (&optional file-mode-cache filename)
-  "If a file is controlled by P4 then return version else return nil."
-  (if (not filename)
-      (setq filename (p4-buffer-file-name)))
-  (let (version done)
-    (let ((el (assoc filename file-mode-cache)))
-      (setq done el)
-      (setq version (cdr el)))
-    (if (and (not done) filename)
-	(let ((output-buffer (p4-depot-output "have" (list filename)))
-	      line)
-	  (setq line (p4-read-depot-output output-buffer))
-	  (kill-buffer output-buffer)
-	  (if (string-match "^//[^/@#]+/[^#\n]*#\\([0-9]+\\) - " line)
-	      (setq version (match-string 1 line)))
-	  (setq done version)))
-    (if (and (not done) (not file-mode-cache))
-	(progn
-	  (setq file-mode-cache
-		(p4-get-add-branch-files (and filename (list filename))))
-	  (setq version (cdr (assoc filename file-mode-cache)))))
-    version))
-
-(defun p4-check-mode (&optional file-mode-cache)
-  "Check to see whether we should export the menu map to this buffer.
-
-Turning on P4 mode calls the hooks in the variable `p4-mode-hook' with
-no args."
-  (setq p4-mode nil)
-  (if p4-do-find-file
-      (progn
-	(setq p4-vc-check (p4-is-vc file-mode-cache))
-	(if p4-vc-check
-	    (progn
-	      (p4-menu-add)
-	      (setq p4-mode (concat " P4:" p4-vc-check))))
-	(p4-force-mode-line-update)
-	(let ((buffile (p4-buffer-file-name))
-	      (bufname (buffer-name)))
-	  (if (and p4-vc-check (not (member (list buffile bufname)
-					    p4-all-buffer-files)))
-	      (add-to-list 'p4-all-buffer-files (list buffile bufname))))
-	(if (and (not p4-file-refresh-timer) (not (= p4-file-refresh-timer-time 0)))
-	    (setq p4-file-refresh-timer
-		  (cond (p4-running-emacs
-			 (run-at-time nil p4-file-refresh-timer-time
-				      'p4-refresh-files-in-buffers))
-			(p4-running-xemacs
-			 (add-timeout p4-file-refresh-timer-time
-				      'p4-refresh-files-in-buffers nil
-				      p4-file-refresh-timer-time)))))
-	;; run hooks
-	(and p4-vc-check (run-hooks 'p4-mode-hook))
-	p4-vc-check)))
-
-(defun p4-refresh-files-in-buffers (&optional arg)
-  "Check to see if all the files that are under P4 version control are
-actually up-to-date, if in buffers, or need refreshing."
-  (interactive)
-  (let ((p4-all-my-files p4-all-buffer-files) buffile bufname thiselt)
-    (while p4-all-my-files
-      (setq thiselt (car p4-all-my-files))
-      (setq p4-all-my-files (cdr p4-all-my-files))
-      (setq buffile (car thiselt))
-      (setq bufname (cadr thiselt))
-      (if (buffer-live-p (get-buffer bufname))
-	  (save-excursion
-	    (let ((buf (get-buffer bufname)))
-	      (set-buffer buf)
-	      (if p4-auto-refresh
-		  (if (not (buffer-modified-p buf))
-		      (if (not (verify-visited-file-modtime buf))
-			  (if (file-readable-p buffile)
-			      (revert-buffer t t)
-			    (p4-check-mode))))
-		(if (file-readable-p buffile)
-		    (find-file-noselect buffile t)
-		  (p4-check-mode)))
-	      (setq buffer-read-only (not (file-writable-p
-					   (p4-buffer-file-name))))))
-	(p4-refresh-refresh-list buffile bufname)))))
-
-(defun p4-check-mode-all-buffers ()
-  "Call p4-check-mode for all buffers under P4 version control"
-  (let ((p4-all-my-files p4-all-buffer-files) buffile bufname thiselt
-	file-mode-cache)
-    (if (and p4-all-my-files p4-do-find-file)
-	(setq file-mode-cache
-	      (append (p4-get-add-branch-files)
-		      (p4-get-have-files (mapcar 'car p4-all-my-files)))))
-    (while p4-all-my-files
-      (setq thiselt (car p4-all-my-files))
-      (setq p4-all-my-files (cdr p4-all-my-files))
-      (setq buffile (car thiselt))
-      (setq bufname (cadr thiselt))
-      (if (buffer-live-p (get-buffer bufname))
-	  (save-excursion
-	    (set-buffer (get-buffer bufname))
-	    (p4-check-mode file-mode-cache))
-	(p4-refresh-refresh-list buffile bufname)))))
-
-;; Force mode line updation for different Emacs versions
-(defun p4-force-mode-line-update ()
-  "To Force the mode line update for different flavors of Emacs."
-  (cond (p4-running-xemacs
-	 (redraw-modeline))
-	(p4-running-emacs
-	 (force-mode-line-update))))
-
-;; In case, the P4 server is not available, or when operating off-line, the
-;; p4-find-file-hook becomes a pain... this functions toggles the use of the
-;; hook when opening files.
-
-(defun p4-toggle-vc-mode ()
-  "In case, the P4 server is not available, or when working off-line, toggle
-the VC check on/off when opening files."
-  (interactive)
-  (setq p4-do-find-file (not p4-do-find-file))
-  (message (concat "P4 mode check " (if p4-do-find-file
-					"enabled."
-				      "disabled."))))
-
-;; Wrap C-x C-q to allow p4-edit/revert and also to ensure that
-;; we don't stomp on vc-toggle-read-only.
-
-(defun p4-toggle-read-only (&optional arg)
-  "If p4-mode is non-nil, \\[p4-toggle-read-only] toggles between `p4-edit'
-and `p4-revert'. If ARG is non-nil, p4-offline-mode will be enabled for this
-buffer before the toggling takes place. In p4-offline-mode, toggle between
-making the file writable and write protected."
-  (interactive "P")
-  (if (and arg p4-mode)
-      (setq p4-mode nil
-	    p4-offline-mode t))
-  (cond
-   (p4-mode
-    (if buffer-read-only
-	(p4-edit p4-verbose)
-      (p4-revert p4-verbose)))
-   (p4-offline-mode
-    (toggle-read-only)
-    (if buffer-file-name
-	(let ((mode (file-modes buffer-file-name)))
-	  (if buffer-read-only
-	      (setq mode (logand mode (lognot 128)))
-	    (setq mode (logior mode 128)))
-	  (set-file-modes buffer-file-name mode))))))
-
-(defun p4-browse-web-page ()
-  "Browse the p4.el web page."
-  (interactive)
-  (require 'browse-url)
-  (browse-url p4-web-page))
-
-(defun p4-bug-report ()
-  (interactive)
-  (if (string-match " 19\\." (emacs-version))
-      ;; unfortunately GNU Emacs 19.x doesn't have compose-mail
-      (mail nil p4-emacs-maintainer (concat "BUG REPORT: "
-					    (p4-emacs-version)))
-    (compose-mail p4-emacs-maintainer (concat "BUG REPORT: "
-					      (p4-emacs-version))))
-  (goto-char (point-min))
-  (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
-  ;; Insert warnings for novice users.
-  (insert
-   "This bug report will be sent to the P4-Emacs Integration Maintainer,\n"
-   p4-emacs-maintainer "\n\n")
-  (insert (concat (emacs-version) "\n\n"))
-  (insert "A brief description of the problem and how to reproduce it:\n")
-  (save-excursion
-    (let ((message-buf (get-buffer
-			(cond (p4-running-xemacs " *Message-Log*")
-			      (p4-running-emacs "*Messages*")))))
-      (if message-buf
-	  (let (beg-pos
-		(end-pos (point-max)))
-	    (save-excursion
-	      (set-buffer message-buf)
-	      (goto-char end-pos)
-	      (forward-line -10)
-	      (setq beg-pos (point)))
-	    (insert "\n\nRecent messages:\n")
-	    (insert-buffer-substring message-buf beg-pos end-pos))))))
-
-(defun p4-describe-bindings ()
-  "A function to list the key bindings for the p4 prefix map"
-  (interactive)
-  (save-excursion
-    (p4-push-window-config)
-    (let ((map (make-sparse-keymap))
-	  (p4-bindings-buffer "*P4 key bindings*"))
-      (get-buffer-create p4-bindings-buffer)
-      (cond
-       (p4-running-xemacs
-	(set-buffer p4-bindings-buffer)
-	(delete-region (point-min) (point-max))
-	(insert "Key Bindings for P4 Mode\n------------------------\n")
-	(describe-bindings-internal p4-prefix-map))
-       (p4-running-emacs
-	(kill-buffer p4-bindings-buffer)
-	(describe-bindings "\C-xp")
-	(set-buffer "*Help*")
-	(rename-buffer p4-bindings-buffer)))
-      (define-key map "q" 'p4-quit-current-buffer)
-      (use-local-map map)
-      (display-buffer p4-bindings-buffer))))
-
-;; Break up a string into a list of words
-;; (p4-make-list-from-string "ab c de  f") -> ("ab" "c" "de" "f")
-(defun p4-make-list-from-string (str)
-  (let (lst)
-    (while (or (string-match "^ *\"\\([^\"]*\\)\"" str)
-	       (string-match "^ *\'\\([^\']*\\)\'" str)
-	       (string-match "^ *\\([^ ]+\\)" str))
-      (setq lst (append lst (list (match-string 1 str))))
-      (setq str (substring str (match-end 0))))
-    lst))
-
-(defun p4-list-to-string (lst)
-  (mapconcat (lambda (x) x) lst " "))
-
-;; Return the file name associated with a buffer. If the real buffer file
-;; name doesn't exist, try special filename tags set in some of the p4
-;; buffers.
-(defun p4-buffer-file-name-2 ()
-  (cond ((p4-buffer-file-name))
-	((get-char-property (point) 'link-client-name))
-	((get-char-property (point) 'link-depot-name))
-	((get-char-property (point) 'block-client-name))
-	((get-char-property (point) 'block-depot-name))
-	((if (and (fboundp 'dired-get-filename)
-		  (dired-get-filename nil t))
-	     (p4-follow-link-name (dired-get-filename nil t))))))
-
-(defun p4-buffer-file-name ()
-  (cond (buffer-file-name
-	 (p4-follow-link-name buffer-file-name))
-	(t nil)))
-
-(defun p4-follow-link-name (name)
-  (if p4-follow-symlinks
-      (file-truename name)
-    name))
-
-(defvar p4-depot-filespec-history nil
-  "History for p4-depot filespecs.")
-
-(defvar p4-depot-completion-cache nil
-  "Cache for `p4-depot-completion'.
-It is a list of lists whose car is a filespec and
-cdr is the list of anwers")
-
-(defvar p4-branches-history nil
-  "History for p4 clients.")
-
-(defvar p4-branches-completion-cache nil
-  "Cache for `p4-depot-completion'.
-It is a list of lists whose car is a client and
-cdr is the list of answers??")
-
-(defvar p4-clients-history nil
-  "History for p4 clients.")
-
-(defvar p4-clients-completion-cache nil
-  "Cache for `p4-depot-completion'.
-It is a list of lists whose car is a client and
-cdr is the list of answers??")
-
-(defvar p4-jobs-completion-cache nil
-  "Cache for `p4-depot-completion'.
-It is a list of lists whose car is a client and
-cdr is the list of answers??")
-
-(defvar p4-labels-history nil
-  "History for p4 clients.")
-
-(defvar p4-labels-completion-cache nil
-  "Cache for `p4-depot-completion'.
-It is a list of lists whose car is a client and
-cdr is the list of answers??")
-
-(defvar p4-users-completion-cache nil
-  "Cache for `p4-depot-completion'.
-It is a list of lists whose car is a client and
-cdr is the list of answers??")
-
-(defvar p4-arg-string-history nil
-  "History for p4 command arguments")
-
-(defun p4-depot-completion-search (filespec cmd)
-  "Look into `p4-depot-completion-cache' for filespec.
-Filespec is the candidate for completion, so the
-exact file specification is \"filespec*\".
-
-If found in cache, return a list whose car is FILESPEC and cdr is the list
-of matches.
-If not found in cache, return nil.
-So the 'no match' answer is different from 'not in cache'."
-  (let ((l (cond
-	    ((equal cmd "branches") p4-branches-completion-cache)
-	    ((equal cmd "clients") p4-clients-completion-cache)
-	    ((equal cmd "dirs") p4-depot-completion-cache)
-	    ((equal cmd "jobs") p4-jobs-completion-cache)
-	    ((equal cmd "labels") p4-labels-completion-cache)
-	    ((equal cmd "users") p4-users-completion-cache)))
-	dir list)
-
-    (if (and p4-cleanup-cache (not p4-timer))
-	(setq p4-timer (cond (p4-running-emacs
-			      (run-at-time p4-cleanup-time nil
-					   'p4-cache-cleanup))
-			     (p4-running-xemacs
-			      (add-timeout p4-cleanup-time 'p4-cache-cleanup
-					   nil nil)))))
-    (while l
-      (if (string-match (concat "^" (car (car l)) "[^/]*$") filespec)
-	  (progn
-	    ;; filespec is included in cache
-	    (if (string= (car (car l)) filespec)
-		(setq list (cdr (car l)))
-	      (setq dir (cdr (car l)))
-	      (while dir
-		(if (string-match (concat "^" filespec) (car dir))
-		    (setq list (cons (car dir) list)))
-		(setq dir (cdr dir))))
-	    (setq l nil
-		  list (cons filespec list))))
-      (setq l (cdr l)))
-    list))
-
-(defun p4-cache-cleanup (&optional arg)
-  "Cleanup all the completion caches."
-  (message "Cleaning up the p4 caches ...")
-  (setq p4-branches-completion-cache nil)
-  (setq p4-clients-completion-cache nil)
-  (setq p4-depot-completion-cache nil)
-  (setq p4-jobs-completion-cache nil)
-  (setq p4-labels-completion-cache nil)
-  (setq p4-users-completion-cache nil)
-  (if (and p4-running-emacs (timerp p4-timer)) (cancel-timer p4-timer))
-  (if (and p4-running-xemacs p4-timer) (disable-timeout p4-timer))
-  (setq p4-timer nil)
-  (message "Cleaning up the p4 caches ... done."))
-
-(defun p4-partial-cache-cleanup (type)
-  "Cleanup a specific completion cache."
-  (cond ((string= type "branch")
-	 (setq p4-branches-completion-cache nil))
-	((string= type "client")
-	 (setq p4-clients-completion-cache nil))
-	((or (string= type "submit") (string= type "change"))
-	 (setq p4-depot-completion-cache nil))
-	((string= type "job")
-	 (setq p4-jobs-completion-cache nil))
-	((string= type "label")
-	 (setq p4-labels-completion-cache nil))
-	((string= type "user")
-	 (setq p4-users-completion-cache nil))))
-
-(defun p4-read-depot-output (buffer &optional regexp)
-  "Reads first line of BUFFER and returns it.
-Read lines are deleted from buffer.
-
-If optional REGEXP is passed in, return the substring of the first line that
-matched the REGEXP."
-
-  (save-excursion
-    (set-buffer buffer)
-    (goto-char (point-min))
-    (forward-line)
-
-    (let ((line (buffer-substring (point-min) (point))))
-      (if (string= line "")
-	  nil
-	(delete-region (point-min) (point))
-	(if (and regexp (string-match regexp line))
-	    (setq line (substring line (match-beginning 1) (match-end 1))))
-
-	;; remove trailing newline
-	(if (equal (substring line (1- (length line)) (length line)) "\n")
-	    (substring line 0 (1- (length line)))
-	  line)))))
-
-(defun p4-completion-helper (filespec cmd var regexp)
-  (let (output-buffer line list)
-    (message "Making %s completion list..." cmd)
-    (setq output-buffer (p4-depot-output cmd))
-    (while (setq line (p4-read-depot-output
-		       output-buffer regexp))
-      (if line
-	  (setq list (cons line list))))
-    (kill-buffer output-buffer)
-    (set var
-	 (cons (cons filespec list) (eval var)))
-    list))
-
-(defun p4-depot-completion-build (filespec cmd)
-  "Ask Perforce for a list of files and directories beginning with FILESPEC."
-  (let (output-buffer line list)
-    (cond
-     ((equal cmd "branches")
-      (setq list (p4-completion-helper
-		  filespec cmd 'p4-branches-completion-cache
-		  "^Branch \\([^ \n]*\\) [0-9][0-9][0-9][0-9]/.*$")))
-     ((equal cmd "clients")
-      (setq list (p4-completion-helper
-		  filespec cmd 'p4-clients-completion-cache
-		  "^Client \\([^ \n]*\\) [0-9][0-9][0-9][0-9]/.*$")))
-
-     ((equal cmd "dirs")
-      (message "Making p4 completion list...")
-      (setq output-buffer (p4-depot-output cmd
-					   (list (concat filespec "*"))))
-      (while (setq line (p4-read-depot-output output-buffer))
-	(if (not (string-match "no such file" line))
-	    (setq list (cons (concat line "/") list))))
-      (kill-buffer output-buffer)
-      (setq output-buffer (p4-depot-output "files"
-					   (list (concat filespec "*"))))
-      (while (setq line (p4-read-depot-output output-buffer))
-	(if (string-match "^\\(.+\\)#[0-9]+ - " line)
-	    (setq list (cons (match-string 1 line) list))))
-      (kill-buffer output-buffer)
-      (setq p4-depot-completion-cache
-	    (cons (cons filespec list) p4-depot-completion-cache)))
-
-     ((equal cmd "jobs")
-      (setq list (p4-completion-helper
-		  filespec cmd 'p4-jobs-completion-cache
-		  "\\([^ \n]*\\) on [0-9][0-9][0-9][0-9]/.*$")))
-     ((equal cmd "labels")
-      (setq list (p4-completion-helper
-		  filespec cmd 'p4-labels-completion-cache
-		  "^Label \\([^ \n]*\\) [0-9][0-9][0-9][0-9]/.*$")))
-     ((equal cmd "users")
-      (setq list (p4-completion-helper
-		  filespec cmd 'p4-users-completion-cache
-		  "^\\([^ ]+\\).*$"))))
-    (message nil)
-    (cons filespec list)))
-
-(defun p4-completion-builder (type)
-  `(lambda (string predicate action)
-     ,(concat "Completion function for Perforce " type ".
-
-Using the mouse in completion buffer on a client will select it
-and exit, unlike standard selection. This is because
-`choose-completion-string' (in simple.el) has a special code for
-file name selection.")
-     (let (list)
-       ,(if (string= type "dirs")
-	    ;; when testing for an exact match, remove trailing /
-	    `(if (and (eq action 'lambda)
-		      (eq (aref string (1- (length string))) ?/))
-		 (setq string (substring string 0 (1- (length string))))))
-
-       ;; First, look in cache
-       (setq list (p4-depot-completion-search string ,type))
-
-       ;; If not found in cache, build list.
-       (if (not list)
-	   (setq list (p4-depot-completion-build string ,type)))
-
-       (cond
-	;; try completion
-	((null action)
-	 (try-completion string (mapcar 'list (cdr list)) predicate))
-	;; all completions
-	((eq action t)
-	 (let ((lst
-		(all-completions string (mapcar 'list (cdr list)) predicate)))
-	   ,(if (string= type "dirs")
-		`(setq lst (mapcar (lambda (s)
-				     (if (string-match ".*/\\(.+\\)" s)
-					 (match-string 1 s)
-				       s))
-				   lst)))
-	   lst))
-	;; Test for an exact match
-	(t
-	 (and (>= (length list) 2)
-	      (member (car list) (cdr list))))))))
-
-(defalias 'p4-branches-completion (p4-completion-builder "branches"))
-(defalias 'p4-clients-completion (p4-completion-builder "clients"))
-(defalias 'p4-depot-completion (p4-completion-builder "dirs"))
-(defalias 'p4-jobs-completion (p4-completion-builder "jobs"))
-(defalias 'p4-labels-completion (p4-completion-builder "labels"))
-(defalias 'p4-users-completion (p4-completion-builder "users"))
-
-
-(defun p4-read-arg-string (prompt &optional initial type)
-  (let ((minibuffer-local-completion-map
-	 (copy-keymap minibuffer-local-completion-map)))
-    (define-key minibuffer-local-completion-map " " 'self-insert-command)
-    (completing-read prompt
-		     (cond ((not type)
-			    'p4-arg-string-completion)
-			   ((string= type "branch")
-			    'p4-branch-string-completion)
-			   ((string= type "client")
-			    'p4-client-string-completion)
-			   ((string= type "label")
-			    'p4-label-string-completion)
-			   ((string= type "job")
-			    'p4-job-string-completion)
-			   ((string= type "user")
-			    'p4-user-string-completion))
-		     nil nil
-		     initial 'p4-arg-string-history)))
-
-(defun p4-arg-string-completion (string predicate action)
-  (let ((first-part "") completion)
-    (if (string-match "^\\(.* +\\)\\(.*\\)" string)
-	(progn
-	  (setq first-part (match-string 1 string))
-	  (setq string (match-string 2 string))))
-    (cond ((string-match "-b +$" first-part)
-	   (setq completion (p4-branches-completion string predicate action)))
-	  ((string-match "-t +$" first-part)
-	   (setq completion (p4-list-completion
-			     string (list "text " "xtext " "binary "
-					  "xbinary " "symlink ")
-			     predicate action)))
-	  ((string-match "-j +$" first-part)
-	   (setq completion (p4-jobs-completion string predicate action)))
-	  ((string-match "-l +$" first-part)
-	   (setq completion (p4-labels-completion string predicate action)))
-	  ((string-match "\\(.*status=\\)\\(.*\\)" string)
-	   (setq first-part (concat first-part (match-string 1 string)))
-	   (setq string (match-string 2 string))
-	   (setq completion (p4-list-completion
-			     string (list "open " "closed " "suspended ")
-			     predicate action)))
-	  ((or (string-match "\\(.*@.+,\\)\\(.*\\)" string)
-	       (string-match "\\(.*@\\)\\(.*\\)" string))
-	   (setq first-part (concat first-part (match-string 1 string)))
-	   (setq string (match-string 2 string))
-	   (setq completion (p4-labels-completion string predicate action)))
-	  ((string-match "\\(.*#\\)\\(.*\\)" string)
-	   (setq first-part (concat first-part (match-string 1 string)))
-	   (setq string (match-string 2 string))
-	   (setq completion (p4-list-completion
-			     string (list "none" "head" "have")
-			     predicate action)))
-	  ((string-match "^//" string)
-	   (setq completion (p4-depot-completion string predicate action)))
-	  ((string-match "\\(^-\\)\\(.*\\)" string)
-	   (setq first-part (concat first-part (match-string 1 string)))
-	   (setq string (match-string 2 string))
-	   (setq completion (p4-list-completion
-			     string (list "a " "af " "am " "as " "at " "ay "
-					  "b " "c " "d " "dc " "dn "
-					  "ds " "du " "e " "f " "i " "j "
-					  "l " "m " "n " "q " "r " "s " "sa "
-					  "sd " "se " "sr " "t " "v ")
-			     predicate action)))
-	  (t
-	   (setq completion (p4-file-name-completion string
-						     predicate action))))
-    (cond ((null action) ;; try-completion
-	   (if (stringp completion)
-	       (concat first-part completion)
-	     completion))
-	  ((eq action t) ;; all-completions
-	   completion)
-	  (t             ;; exact match
-	   completion))))
-
-(defun p4-list-completion (string lst predicate action)
-  (let ((collection (mapcar 'list lst)))
-    (cond ((not action)
-	   (try-completion string collection predicate))
-	  ((eq action t)
-	   (all-completions string collection predicate))
-	  (t
-	   (eq (try-completion string collection predicate) t)))))
-
-(defun p4-file-name-completion (string predicate action)
-  (if (string-match "//\\(.*\\)" string)
-      (setq string (concat "/" (match-string 1 string))))
-  (setq string (substitute-in-file-name string))
-  (setq string (p4-follow-link-name (expand-file-name string)))
-  (let ((dir-path "") completion)
-    (if (string-match "^\\(.*[/\\]\\)\\(.*\\)" string)
-	(progn
-	  (setq dir-path (match-string 1 string))
-	  (setq string (match-string 2 string))))
-    (cond ((not action)
-	   (setq completion (file-name-completion string dir-path))
-	   (if (stringp completion)
-	       (concat dir-path completion)
-	     completion))
-	  ((eq action t)
-	   (file-name-all-completions string dir-path))
-	  (t
-	   (eq (file-name-completion string dir-path) t)))))
-
-(defun p4-string-completion-builder (completion-function)
-  `(lambda (string predicate action)
-     (let ((first-part "") completion)
-       (if (string-match "^\\(.* +\\)\\(.*\\)" string)
-	   (progn
-	     (setq first-part (match-string 1 string))
-	     (setq string (match-string 2 string))))
-       (cond ((string-match "^-" string)
-	      (setq completion nil))
-	     (t
-	      (setq completion
-		    (,completion-function string predicate action))))
-       (cond ((null action);; try-completion
-	      (if (stringp completion)
-		  (concat first-part completion)
-		completion))
-	     ((eq action t);; all-completions
-	      completion)
-	     (t;; exact match
-	      completion)))))
-
-(defalias 'p4-branch-string-completion (p4-string-completion-builder
-					'p4-branches-completion))
-
-(defalias 'p4-client-string-completion (p4-string-completion-builder
-					'p4-clients-completion))
-
-(defalias 'p4-job-string-completion (p4-string-completion-builder
-				     'p4-jobs-completion))
-
-(defalias 'p4-label-string-completion (p4-string-completion-builder
-				       'p4-labels-completion))
-
-(defalias 'p4-user-string-completion (p4-string-completion-builder
-				      'p4-users-completion))
-
-(defun p4-depot-find-file (file)
-  (interactive (list (completing-read "Enter filespec: "
-				      'p4-depot-completion
-				      nil nil
-				      p4-default-depot-completion-prefix
-				      'p4-depot-filespec-history)))
-  (let ((lfile (cdar (p4-map-depot-files (list file)))))
-    (if lfile
-	(find-file lfile)
-      (if (get-file-buffer file)
-	  (switch-to-buffer-other-window file)
-	(get-buffer-create file)
-	(set-buffer file)
-	(p4-noinput-buffer-action "print" nil t (list file))
-	(p4-activate-print-buffer file t)))))
-
-
-;; A function to get the current P4 client name
-(defun p4-get-client-name ()
-  "To get the current value of the environment variable P4CLIENT,
-type \\[p4-get-client-name].
-
-This will be the current client that is in use for access through
-Emacs P4."
-  (interactive)
-  (let ((client (p4-current-client)))
-    (message "P4CLIENT [local: %s], [global: %s]" client (getenv "P4CLIENT"))
-    client))
-
-(defun p4-get-config-info (file-name token)
-  (let ((output-buffer (generate-new-buffer p4-output-buffer-name))
-	(data (getenv token)))
-    (save-excursion
-      (set-buffer output-buffer)
-      (goto-char (point-min))
-      (insert-file-contents file-name)
-      (goto-char (point-min))
-      (if (re-search-forward (concat "^" (regexp-quote token) "=\\(.*\\)")
-			     nil t)
-	  (setq data (match-string 1))))
-    (kill-buffer output-buffer)
-    data))
-
-(defun p4-current-client ()
-  "Get the current local client, or the global client, if that."
-  (let ((p4-config-file (p4-find-p4-config-file))
-	cur-client pmin)
-    (if (not p4-config-file)
-	(setq cur-client (getenv "P4CLIENT"))
-      (setq cur-client (p4-get-config-info p4-config-file "P4CLIENT")))
-    (if (not cur-client)
-	(save-excursion
-	  (get-buffer-create p4-output-buffer-name)
-	  (set-buffer p4-output-buffer-name)
-	  (goto-char (point-max))
-	  (setq pmin (point))
-	  (if (zerop (p4-call-p4-here "info"))
-	      (progn
-		(goto-char pmin)
-		(if (re-search-forward "^Client name:[ \t]+\\(.*\\)$" nil t)
-		    (setq cur-client (match-string 1)))
-		(delete-region pmin (point-max))))))
-    cur-client))
-
-(defun p4-current-server-port ()
-  "Get the current local server:port address, or the global server:port, if
-that."
-  (let ((p4-config-file (p4-find-p4-config-file)))
-    (if (not p4-config-file)
-	(getenv "P4PORT")
-      (p4-get-config-info p4-config-file "P4PORT"))))
-
-(defun p4-save-opened-files ()
-  (get-buffer-create p4-output-buffer-name);; We do these two lines
-  (kill-buffer p4-output-buffer-name)      ;; to ensure no duplicates
-  (let ((output-buffer (p4-depot-output "opened"))
-	opened)
-    (save-excursion
-      (set-buffer output-buffer)
-      (goto-char (point-min))
-      (while (re-search-forward "^\\(.*\\)#[0-9]+ - " nil t)
-	(setq opened (cons (match-string 1) opened))))
-    (kill-buffer output-buffer)
-    (setq opened (mapcar 'cdr (p4-map-depot-files opened)))
-    (save-window-excursion
-      (map-y-or-n-p
-       (function
-	(lambda (buffer)
-	  (and (buffer-modified-p buffer)
-	       (not (buffer-base-buffer buffer))
-	       (buffer-file-name buffer)
-	       (member (buffer-file-name buffer) opened)
-	       (format "Save file %s? "
-		       (buffer-file-name buffer)))))
-       (function
-	(lambda (buffer)
-	  (set-buffer buffer)
-	  (save-buffer)))
-       (buffer-list)
-       '("buffer" "buffers" "save")))))
-
-(defun p4-empty-diff-p ()
-  "Return t if there exists a file opened for edit with an empty diff"
-  (let ((buffer (get-buffer-create "p4-edp-buf"))
-	opened empty-diff)
-    (p4-exec-p4 buffer (list "opened") t)
-    (save-excursion
-      (set-buffer buffer)
-      (goto-char (point-min))
-      (while (re-search-forward "^\\(.*\\)#[0-9]* - edit.*" nil t)
-	(setq opened (cons (match-string 1) opened))))
-    (if opened
-	(progn
-	  (p4-exec-p4 buffer (list "diff") t)
-	  (save-excursion
-	    (set-buffer buffer)
-	    (goto-char (point-max))
-	    (insert "====\n")
-	    (goto-char (point-min))
-	    (while (re-search-forward "^==== \\([^#\n]+\\)#.*\n====" nil t)
-	      (if (member (match-string 1) opened)
-		  (progn
-		    (setq empty-diff t)
-		    (goto-char (point-max))))))))
-    (kill-buffer buffer)
-    empty-diff))
-
-(provide 'p4)
-
-;;; p4.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/pascal.el b/xemacs-packages/lisp/prog-modes/pascal.el
deleted file mode 100644
index 51059b2b..00000000
--- a/xemacs-packages/lisp/prog-modes/pascal.el
+++ /dev/null
@@ -1,1597 +0,0 @@
-;;; pascal.el --- major mode for editing pascal source in Emacs
-
-;; Copyright (C) 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
-
-;; Author: Espen Skoglund (espensk@stud.cs.uit.no)
-;; Keywords: languages
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34
-
-;;; Commentary:
-
-;; USAGE
-;; =====
-
-;; Emacs should enter Pascal mode when you find a Pascal source file.
-;; When you have entered Pascal mode, you may get more info by pressing
-;; C-h m. You may also get online help describing various functions by:
-;; C-h f 
-
-;; If you want to customize Pascal mode to fit you better, you may add
-;; these lines (the values of the variables presented here are the defaults):
-;;
-;; ;; User customization for Pascal mode
-;; (setq pascal-indent-level       3
-;;       pascal-case-indent        2
-;;       pascal-auto-newline       nil
-;;       pascal-tab-always-indent  t
-;;       pascal-auto-endcomments   t
-;;       pascal-auto-lineup        '(all)
-;;       pascal-toggle-completions nil
-;;       pascal-type-keywords      '("array" "file" "packed" "char" 
-;; 				     "integer" "real" "string" "record")
-;;       pascal-start-keywords     '("begin" "end" "function" "procedure"
-;; 				     "repeat" "until" "while" "read" "readln"
-;; 				     "reset" "rewrite" "write" "writeln")
-;;       pascal-separator-keywords '("downto" "else" "mod" "div" "then"))
-
-;; KNOWN BUGS / BUGREPORTS
-;; =======================
-;; As far as I know, there are no bugs in the current version of this
-;; package.  This may not be true however, since I never use this mode
-;; myself and therefore would never notice them anyway.   If you do
-;; find any bugs, you may submit them to: espensk@stud.cs.uit.no
-;; as well as to bug-gnu-emacs@prep.ai.mit.edu.
-
-;;; Code:
-
-(defconst pascal-mode-version "2.5"
-  "Version of `pascal.el'.")
-
-(defgroup pascal nil
-  "Major mode for editing Pascal source in Emacs"
-  :group 'languages)
-
-(defvar pascal-mode-abbrev-table nil
-  "Abbrev table in use in Pascal-mode buffers.")
-(define-abbrev-table 'pascal-mode-abbrev-table ())
-
-(defvar pascal-mode-map ()
-  "Keymap used in Pascal mode.")
-(if pascal-mode-map
-    ()
-  (setq pascal-mode-map (make-sparse-keymap))
-  (define-key pascal-mode-map ";"        'electric-pascal-semi-or-dot)
-  (define-key pascal-mode-map "."        'electric-pascal-semi-or-dot)
-  (define-key pascal-mode-map ":"        'electric-pascal-colon)
-  (define-key pascal-mode-map "="        'electric-pascal-equal)
-  (define-key pascal-mode-map "#"        'electric-pascal-hash)
-  (define-key pascal-mode-map "\r"       'electric-pascal-terminate-line)
-  (define-key pascal-mode-map "\t"       'electric-pascal-tab)
-  (define-key pascal-mode-map "\M-\t"    'pascal-complete-word)
-  (define-key pascal-mode-map "\M-?"     'pascal-show-completions)
-  (define-key pascal-mode-map "\M-\C-h"  'pascal-mark-defun)
-  (define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block)
-  (define-key pascal-mode-map "\M-*"     'pascal-star-comment)
-  (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
-  (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
-  (define-key pascal-mode-map "\M-\C-a"  'pascal-beg-of-defun)
-  (define-key pascal-mode-map "\M-\C-e"  'pascal-end-of-defun)
-  (define-key pascal-mode-map "\C-c\C-d" 'pascal-goto-defun)
-  (define-key pascal-mode-map "\C-c\C-o" 'pascal-outline)
-;;; A command to change the whole buffer won't be used terribly
-;;; often, so no need for a key binding.
-;  (define-key pascal-mode-map "\C-cd"    'pascal-downcase-keywords)
-;  (define-key pascal-mode-map "\C-cu"    'pascal-upcase-keywords)
-;  (define-key pascal-mode-map "\C-cc"    'pascal-capitalize-keywords)
-  )
-
-(defvar pascal-imenu-generic-expression
-  '("^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" . (2))
-  "Imenu expression for Pascal-mode.  See `imenu-generic-expression'.")
-
-(defvar pascal-keywords
-  '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end" 
-    "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of" 
-    "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to" 
-    "type" "until" "var" "while" "with"
-    ;; The following are not standard in pascal, but widely used.
-    "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
-    "writeln"))
-
-;;;
-;;; Regular expressions used to calculate indent, etc.
-;;;
-(defconst pascal-symbol-re      "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
-(defconst pascal-beg-block-re   "\\<\\(begin\\|case\\|record\\|repeat\\)\\>")
-(defconst pascal-end-block-re   "\\<\\(end\\|until\\)\\>")
-(defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>")
-(defconst pascal-defun-re       "\\<\\(function\\|procedure\\|program\\)\\>")
-(defconst pascal-sub-block-re   "\\<\\(if\\|else\\|for\\|while\\|with\\)\\>")
-(defconst pascal-noindent-re    "\\<\\(begin\\|end\\|until\\|else\\)\\>")
-(defconst pascal-nosemi-re      "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>")
-(defconst pascal-autoindent-lines-re
-  "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
-
-;;; Strings used to mark beginning and end of excluded text
-(defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----")
-(defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}")
-
-(defvar pascal-mode-syntax-table nil
-  "Syntax table in use in Pascal-mode buffers.")
-
-(if pascal-mode-syntax-table
-    ()
-  (setq pascal-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "."   pascal-mode-syntax-table)
-  (modify-syntax-entry ?( "()1"  pascal-mode-syntax-table)  
-  (modify-syntax-entry ?) ")(4"  pascal-mode-syntax-table)
-  (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table)
-  (modify-syntax-entry ?{ "<"    pascal-mode-syntax-table)
-  (modify-syntax-entry ?} ">"    pascal-mode-syntax-table)
-  (modify-syntax-entry ?+ "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?- "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?= "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?% "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?< "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?> "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?& "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?| "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?_ "_"    pascal-mode-syntax-table)
-  (modify-syntax-entry ?\' "\""  pascal-mode-syntax-table))
-
-(defvar pascal-font-lock-keywords (purecopy
-  (list
-   '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\(\\[a-z]\\)?"
-     1 font-lock-keyword-face)
-   '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\([a-z][a-z0-9_]*\\)"
-     3 font-lock-function-name-face t)
-;   ("type" "const" "real" "integer" "char" "boolean" "var"
-;    "record" "array" "file")
-   (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
-		 "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
-	 'font-lock-type-face)
-   '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-reference-face)
-   '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face)
-;   ("of" "to" "for" "if" "then" "else" "case" "while"
-;    "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end")
-   (concat "\\<\\("
-	   "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
-	   "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
-	   "\\)\\>")
-   '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
-     1 font-lock-keyword-face)
-   '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
-     2 font-lock-keyword-face nil t)))
-  "Additional expressions to highlight in Pascal mode.")
-(put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t))
-
-(defcustom pascal-indent-level 3
-  "*Indentation of Pascal statements with respect to containing block."
-  :type 'integer
-  :group 'pascal)
-
-(defcustom pascal-case-indent 2
-  "*Indentation for case statements."
-  :type 'integer
-  :group 'pascal)
-
-(defcustom pascal-auto-newline nil
-  "*Non-nil means automatically newline after semicolons and the punctuation
-mark after an end."
-  :type 'boolean
-  :group 'pascal)
-
-(defcustom pascal-tab-always-indent t
-  "*Non-nil means TAB in Pascal mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used."
-  :type 'boolean
-  :group 'pascal)
-
-(defcustom pascal-auto-endcomments t
-  "*Non-nil means a comment { ... } is set after the ends which ends cases and
-functions. The name of the function or case will be set between the braces."
-  :type 'boolean
-  :group 'pascal)
-
-(defcustom pascal-auto-lineup '(all)
-  "*List of contexts where auto lineup of :'s or ='s should be done.
-Elements can be of type: 'paramlist', 'declaration' or 'case', which will
-do auto lineup in parameterlist, declarations or case-statements
-respectively. The word 'all' will do all lineups. '(case paramlist) for
-instance will do lineup in case-statements and parameterlist, while '(all)
-will do all lineups."
-  :type '(repeat (choice (const all)
-			 (const paramlist)
-			 (const declaration)
-			 (const case)))
-  :group 'pascal)
-
-(defcustom pascal-toggle-completions nil
-  "*Non-nil means that repeated use of \
-\\\\[pascal-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 'pascal)
-
-(defcustom pascal-type-keywords
-  '("array" "file" "packed" "char" "integer" "real" "string" "record")
-  "*Keywords for types used when completing a word in a declaration or parmlist.
-\(eg. integer, real, char.)  The types defined within the Pascal program
-will be completed runtime, and should not be added to this list."
-  :type '(repeat (string :tag "Keyword"))
-  :group 'pascal)
-
-(defcustom pascal-start-keywords
-  '("begin" "end" "function" "procedure" "repeat" "until" "while"
-    "read" "readln" "reset" "rewrite" "write" "writeln")
-  "*Keywords to complete when standing at the first word of a statement.
-\(eg. begin, repeat, until, readln.)
-The procedures and variables defined within the Pascal program
-will be completed runtime and should not be added to this list."
-  :type '(repeat (string :tag "Keyword"))
-  :group 'pascal)
-
-(defcustom pascal-separator-keywords
-  '("downto" "else" "mod" "div" "then")
-  "*Keywords to complete when NOT standing at the first word of a statement.
-\(eg. downto, else, mod, then.) 
-Variables and function names defined within the
-Pascal program are completed runtime and should not be added to this list."
-  :type '(repeat (string :tag "Keyword"))
-  :group 'pascal)
-
-;;;
-;;;  Macros
-;;;
-
-(defsubst pascal-get-beg-of-line (&optional arg)
-  (save-excursion
-    (beginning-of-line arg)
-    (point)))
-
-(defsubst pascal-get-end-of-line (&optional arg)
-  (save-excursion
-    (end-of-line arg)
-    (point)))
-
-(defun pascal-declaration-end ()
-  (let ((nest 1))
-    (while (and (> nest 0)
-		(re-search-forward 
-		 "[:=]\\|\\(\\\\)\\|\\(\\\\)" 
-		 (save-excursion (end-of-line 2) (point)) t))
-      (cond ((match-beginning 1) (setq nest (1+ nest)))
-	    ((match-beginning 2) (setq nest (1- nest)))
-	    ((looking-at "[^(\n]+)") (setq nest 0))))))
-
-
-(defun pascal-declaration-beg ()
-  (let ((nest 1))
-    (while (and (> nest 0)
-		(re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\\\)\\|\\(\\\\)" (pascal-get-beg-of-line 0) t))
-      (cond ((match-beginning 1) (setq nest 0))
-	    ((match-beginning 2) (setq nest (1- nest)))
-	    ((match-beginning 3) (setq nest (1+ nest)))))
-    (= nest 0)))
-
-  
-(defsubst pascal-within-string ()
-  (save-excursion
-    (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point)))))
-
-
-;;;###autoload
-(defun pascal-mode ()
-  "Major mode for editing Pascal code. \\
-TAB indents for Pascal code.  Delete converts tabs to spaces as it moves back.
-
-\\[pascal-complete-word] completes the word around current point with respect \
-to position in code
-\\[pascal-show-completions] shows all possible completions at this point.
-
-Other useful functions are:
-
-\\[pascal-mark-defun]\t- Mark function.
-\\[pascal-insert-block]\t- insert begin ... end;
-\\[pascal-star-comment]\t- insert (* ... *)
-\\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments.
-\\[pascal-uncomment-area]\t- Uncomment an area commented with \
-\\[pascal-comment-area].
-\\[pascal-beg-of-defun]\t- Move to beginning of current function.
-\\[pascal-end-of-defun]\t- Move to end of current function.
-\\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer.
-\\[pascal-outline]\t- Enter pascal-outline-mode (see also pascal-outline).
-
-Variables controlling indentation/edit style:
-
- pascal-indent-level      (default 3)
-    Indentation of Pascal statements with respect to containing block.
- pascal-case-indent       (default 2)
-    Indentation for case statements.
- pascal-auto-newline      (default nil)
-    Non-nil means automatically newline after semicolons and the punctuation
-    mark after an end.
- pascal-tab-always-indent (default t)
-    Non-nil means TAB in Pascal mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- pascal-auto-endcomments  (default t)
-    Non-nil means a comment { ... } is set after the ends which ends cases and
-    functions. The name of the function or case will be set between the braces.
- pascal-auto-lineup       (default t)
-    List of contexts where auto lineup of :'s or ='s should be done.
-
-See also the user variables pascal-type-keywords, pascal-start-keywords and
-pascal-separator-keywords.
-
-Turning on Pascal mode calls the value of the variable pascal-mode-hook with
-no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map pascal-mode-map)
-  (setq major-mode 'pascal-mode)
-  (setq mode-name "Pascal")
-  (setq local-abbrev-table pascal-mode-abbrev-table)
-  (set-syntax-table pascal-mode-syntax-table)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'pascal-indent-line)
-  (setq comment-indent-function 'pascal-indent-comment)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments nil)
-  (make-local-variable 'case-fold-search)
-  (setq case-fold-search t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "{")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "(\\*+ *\\|{ *")
-  (make-local-variable 'comment-end)
-  (setq comment-end "}")
-  ;; Font lock support
-  ;(make-local-variable 'font-lock-defaults)
-  ;(setq font-lock-defaults '(pascal-font-lock-keywords nil t))
-  ;; Imenu support
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression pascal-imenu-generic-expression)
-  (run-hooks 'pascal-mode-hook))
-
-
-
-;;;
-;;;  Electric functions
-;;;
-(defun electric-pascal-terminate-line ()
-  "Terminate line and indent next line."
-  (interactive)
-  ;; First, check if current line should be indented
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (if (looking-at pascal-autoindent-lines-re)
-	(pascal-indent-line)))
-  (delete-horizontal-space) ; Removes trailing whitespaces
-  (newline)
-  ;; Indent next line
-  (pascal-indent-line)
-  ;; Maybe we should set some endcomments
-  (if pascal-auto-endcomments
-      (pascal-set-auto-comments))
-  ;; Check if we shall indent inside comment
-  (let ((setstar nil))
-    (save-excursion
-      (forward-line -1)
-      (skip-chars-forward " \t")
-      (cond ((looking-at "\\*[ \t]+)")
-	     ;; Delete region between `*' and `)' if there is only whitespaces.
-	     (forward-char 1)
-	     (delete-horizontal-space))
-	    ((and (looking-at "(\\*\\|\\*[^)]")
-		  (not (save-excursion
-			 (search-forward "*)" (pascal-get-end-of-line) t))))
-	     (setq setstar t))))
-    ;; If last line was a star comment line then this one shall be too.
-    (if (null setstar)	
-	(pascal-indent-line)
-      (insert "*  "))))
-
-
-(defun electric-pascal-semi-or-dot ()
-  "Insert `;' or `.' character and reindent the line."
-  (interactive)
-  (insert last-command-char)
-  (save-excursion
-    (beginning-of-line)
-    (pascal-indent-line))
-  (if pascal-auto-newline
-      (electric-pascal-terminate-line)))
-
-(defun electric-pascal-colon ()
-  "Insert `:' and do all indentions except line indent on this line."
-  (interactive)
-  (insert last-command-char)
-  ;; Do nothing if within string.
-  (if (pascal-within-string)
-      ()
-    (save-excursion
-      (beginning-of-line)
-      (pascal-indent-line))
-    (let ((pascal-tab-always-indent nil))
-      (pascal-indent-command))))
-
-(defun electric-pascal-equal ()
-  "Insert `=', and do indention if within type declaration."
-  (interactive)
-  (insert last-command-char)
-  (if (eq (car (pascal-calculate-indent)) 'declaration)
-      (let ((pascal-tab-always-indent nil))
-	(pascal-indent-command))))
-
-(defun electric-pascal-hash ()
-  "Insert `#', and indent to column 0 if this is a CPP directive."
-  (interactive)
-  (insert last-command-char)
-  (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#"))
-      (save-excursion (beginning-of-line)
-		      (delete-horizontal-space))))
-
-(defun electric-pascal-tab ()
-  "Function called when TAB is pressed in Pascal mode."
-  (interactive)
-  ;; Do nothing if within a string or in a CPP directive.
-  (if (or (pascal-within-string)
-	  (and (not (bolp))
-	       (save-excursion (beginning-of-line) (eq (following-char) ?#))))
-      (insert "\t")
-    ;; If pascal-tab-always-indent, indent the beginning of the line.
-    (if pascal-tab-always-indent
-	(save-excursion
-	  (beginning-of-line)
-	  (pascal-indent-line))
-      (if (save-excursion
-	    (skip-chars-backward " \t")
-	    (bolp))
-	  (pascal-indent-line)
-	(insert "\t")))
-    (pascal-indent-command)))
-
-
-
-;;;
-;;; Interactive functions
-;;;
-(defun pascal-insert-block ()
-  "Insert Pascal begin ... end; block in the code with right indentation."
-  (interactive)
-  (pascal-indent-line)
-  (insert "begin")
-  (electric-pascal-terminate-line)
-  (save-excursion
-    (electric-pascal-terminate-line)
-    (insert "end;")
-    (beginning-of-line)
-    (pascal-indent-line)))
-
-(defun pascal-star-comment ()
-  "Insert Pascal star comment at point."
-  (interactive)
-  (pascal-indent-line)
-  (insert "(*")
-  (electric-pascal-terminate-line)
-  (save-excursion
-    (electric-pascal-terminate-line)
-    (delete-horizontal-space)
-    (insert ")"))
-  (insert "  "))
-
-(defun pascal-mark-defun ()
-  "Mark the current pascal function (or procedure).
-This puts the mark at the end, and point at the beginning."
-  (interactive)
-  (push-mark (point))
-  (pascal-end-of-defun)
-  (push-mark (point))
-  (pascal-beg-of-defun)
-  (if (fboundp 'zmacs-activate-region)
-      (zmacs-activate-region)))
-
-(defun pascal-comment-area (start end)
-  "Put the region into a Pascal comment.
-The comments that are in this area are \"deformed\":
-`*)' becomes `!(*' and `}' becomes `!{'.
-These deformed comments are returned to normal if you use
-\\[pascal-uncomment-area] to undo the commenting.
-
-The commented area starts with `pascal-exclude-str-start', and ends with
-`pascal-include-str-end'.  But if you change these variables,
-\\[pascal-uncomment-area] won't recognize the comments."
-  (interactive "r")
-  (save-excursion
-    ;; Insert start and endcomments
-    (goto-char end)
-    (if (and (save-excursion (skip-chars-forward " \t") (eolp))
-	     (not (save-excursion (skip-chars-backward " \t") (bolp))))
-	(forward-line 1)
-      (beginning-of-line))
-    (insert pascal-exclude-str-end)
-    (setq end (point))
-    (newline)
-    (goto-char start)
-    (beginning-of-line)
-    (insert pascal-exclude-str-start)
-    (newline)
-    ;; Replace end-comments within commented area
-    (goto-char end)
-    (save-excursion
-      (while (re-search-backward "\\*)" start t)
-	(replace-match "!(*" t t)))
-    (save-excursion
-      (while (re-search-backward "}" start t)
-	(replace-match "!{" t t)))))
-
-(defun pascal-uncomment-area ()
-  "Uncomment a commented area; change deformed comments back to normal.
-This command does nothing if the pointer is not in a commented
-area.  See also `pascal-comment-area'."
-  (interactive)
-  (save-excursion
-    (let ((start (point))
-	  (end (point)))
-      ;; Find the boundaries of the comment
-      (save-excursion
-	(setq start (progn (search-backward pascal-exclude-str-start nil t)
-			   (point)))
-	(setq end (progn (search-forward pascal-exclude-str-end nil t)
-			 (point))))
-      ;; Check if we're really inside a comment
-      (if (or (equal start (point)) (<= end (point)))
-	  (message "Not standing within commented area.")
-	(progn
-	  ;; Remove endcomment
-	  (goto-char end)
-	  (beginning-of-line)
-	  (let ((pos (point)))
-	    (end-of-line)
-	    (delete-region pos (1+ (point))))
-	  ;; Change comments back to normal
-	  (save-excursion
-	    (while (re-search-backward "!{" start t)
-	      (replace-match "}" t t)))
-	  (save-excursion
-	    (while (re-search-backward "!(\\*" start t)
-	      (replace-match "*)" t t)))
-	  ;; Remove startcomment
-	  (goto-char start)
-	  (beginning-of-line)
-	  (let ((pos (point)))
-	    (end-of-line)
-	    (delete-region pos (1+ (point)))))))))
-
-(defun pascal-beg-of-defun ()
-  "Move backward to the beginning of the current function or procedure."
-  (interactive)
-  (catch 'found
-    (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re)))
-	(forward-sexp 1))
-    (let ((nest 0) (max -1) (func 0)
-	  (reg (concat pascal-beg-block-re "\\|" 
-		       pascal-end-block-re "\\|"
-		       pascal-defun-re)))
-      (while (re-search-backward reg nil 'move)
-	(cond ((let ((state (save-excursion
-			      (parse-partial-sexp (point-min) (point)))))
-		 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
-	       ())
-	      ((match-end 1)                       ; begin|case|record|repeat
-	       (if (and (looking-at "\\") (>= max 0))
-		   (setq func (1- func)))
-	       (setq nest (1+ nest)
-		     max (max nest max)))
-	      ((match-end 2)                       ; end|until
-	       (if (and (= nest max) (>= max 0))
-		   (setq func (1+ func)))
-	       (setq nest (1- nest)))
-	      ((match-end 3)                       ; function|procedure
-	       (if (= 0 func)
-		   (throw 'found t)
-		 (setq func (1- func)))))))
-    nil))
-
-(defun pascal-end-of-defun ()
-  "Move forward to the end of the current function or procedure."
-  (interactive)
-  (if (looking-at "\\s ")
-      (forward-sexp 1))
-  (if (not (looking-at pascal-defun-re))
-      (pascal-beg-of-defun))
-  (forward-char 1)
-  (let ((nest 0) (func 1)
-	(reg (concat pascal-beg-block-re "\\|" 
-		     pascal-end-block-re "\\|"
-		     pascal-defun-re)))
-    (while (and (/= func 0)
-		(re-search-forward reg nil 'move))
-      (cond ((let ((state (save-excursion
-			      (parse-partial-sexp (point-min) (point)))))
-		 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
-	       ())
-	    ((match-end 1)
-	     (setq nest (1+ nest))
-	     (if (save-excursion
-		   (goto-char (match-beginning 0))
-		   (looking-at "\\"))
-		 (setq func (1+ func))))
-	    ((match-end 2)
-	     (setq nest (1- nest))
-	     (if (= nest 0)
-		 (setq func (1- func))))
-	    ((match-end 3)
-	     (setq func (1+ func))))))
-  (forward-line 1))
-
-(defun pascal-end-of-statement ()
-  "Move forward to end of current statement."
-  (interactive)
-  (let ((parse-sexp-ignore-comments t)
-	(nest 0) pos
-	(regexp (concat "\\(" pascal-beg-block-re "\\)\\|\\("
-			pascal-end-block-re "\\)")))
-    (if (not (looking-at "[ \t\n]")) (forward-sexp -1))
-    (or (looking-at pascal-beg-block-re)
-	;; Skip to end of statement
-	(setq pos (catch 'found
-		    (while t
-		      (forward-sexp 1)
-		      (cond ((looking-at "[ \t]*;")
-			     (skip-chars-forward "^;")
-			     (forward-char 1)
-			     (throw 'found (point)))
-			    ((save-excursion
-			       (forward-sexp -1)
-			       (looking-at pascal-beg-block-re))
-			     (goto-char (match-beginning 0))
-			     (throw 'found nil))
-			    ((eobp)
-			     (throw 'found (point))))))))
-    (if (not pos)
-	;; Skip a whole block
-	(catch 'found
-	  (while t
-	    (re-search-forward regexp nil 'move)
-	    (setq nest (if (match-end 1) 
-			   (1+ nest)
-			 (1- nest)))
-	    (cond ((eobp)
-		   (throw 'found (point)))
-		  ((= 0 nest)
-		   (throw 'found (pascal-end-of-statement))))))
-      pos)))
-
-(defun pascal-downcase-keywords ()
-  "Downcase all Pascal keywords in the buffer."
-  (interactive)
-  (pascal-change-keywords 'downcase-word))
-
-(defun pascal-upcase-keywords ()
-  "Upcase all Pascal keywords in the buffer."
-  (interactive)
-  (pascal-change-keywords 'upcase-word))
-
-(defun pascal-capitalize-keywords ()
-  "Capitalize all Pascal keywords in the buffer."
-  (interactive)
-  (pascal-change-keywords 'capitalize-word))
-
-;; Change the keywords according to argument.
-(defun pascal-change-keywords (change-word)
-  (save-excursion
-    (let ((keyword-re (concat "\\<\\("
-			      (mapconcat 'identity pascal-keywords "\\|")
-			      "\\)\\>")))
-      (goto-char (point-min))
-      (while (re-search-forward keyword-re nil t)
-	(funcall change-word -1)))))
-
-
-
-;;;
-;;; Other functions
-;;;
-(defun pascal-set-auto-comments ()
-  "Insert `{ case }' or `{ NAME }' on this line if appropriate.
-Insert `{ case }' if there is an `end' on the line which
-ends a case block.  Insert `{ NAME }' if there is an `end'
-on the line which ends a function or procedure named NAME."
-  (save-excursion
-    (forward-line -1)
-    (skip-chars-forward " \t")
-    (if (and (looking-at "\\"))
-	   (elsed (looking-at "[ \t]*else\\>"))
-	   (type (catch 'nesting
-		   ;; Check if inside a string, comment or parenthesis
-		   (cond ((nth 3 state) (throw 'nesting 'string))
-			 ((nth 4 state) (throw 'nesting 'comment))
-			 ((> (car state) 0)
-			  (goto-char (scan-lists (point) -1 (car state)))
-			  (setq par (1+ (current-column))))
-			 ((save-excursion (beginning-of-line)
-					  (eq (following-char) ?#))
-			  (throw 'nesting 'cpp)))
-		   ;; Loop until correct indent is found
-		   (while t
-		     (backward-sexp 1)
-		     (cond (;--Escape from case statements
-			    (and (looking-at "[A-Za-z0-9]+[ \t]*:[^=]")
-				 (not complete)
-				 (save-excursion (skip-chars-backward " \t")
-						 (bolp))
-				 (= (save-excursion
-				      (end-of-line) (backward-sexp) (point))
-				    (point))
-				 (> (save-excursion (goto-char oldpos)
-						    (beginning-of-line)
-						    (point))
-				    (point)))
-			    (throw 'nesting 'caseblock))
-			   (;--Nest block outwards
-			    (looking-at pascal-beg-block-re)
-			    (if (= nest 0)
-				(cond ((looking-at "case\\>")
-				       (throw 'nesting 'case))
-				      ((looking-at "record\\>")
-				       (throw 'nesting 'declaration))
-				      (t (throw 'nesting 'block)))
-			      (setq nest (1- nest))))
-			   (;--Nest block inwards
-			    (looking-at pascal-end-block-re)
-			    (if (and (looking-at "end\\s ")
-				     elsed (not complete))
-				(throw 'nesting 'block))
-			    (setq complete t
-				  nest (1+ nest)))
-			   (;--Defun (or parameter list)
-			    (looking-at pascal-defun-re)
-			    (if (= 0 par)
-				(throw 'nesting 'defun)
-			      (setq par 0)
-			      (let ((n 0))
-				(while (re-search-forward
-					"\\(\\\\)\\|\\"
-					oldpos t)
-				  (if (match-end 1)
-				      (setq n (1+ n)) (setq n (1- n))))
-				(if (> n 0)
-				    (throw 'nesting 'declaration)
-				  (throw 'nesting 'paramlist)))))
-			   (;--Declaration part
-			    (looking-at pascal-declaration-re)
-			    (if (save-excursion
-				  (goto-char oldpos)
-				  (forward-line -1)
-				  (looking-at "^[ \t]*$"))
-				(throw 'nesting 'unknown)
-			      (throw 'nesting 'declaration)))
-			   (;--If, else or while statement
-			    (and (not complete)
-				 (looking-at pascal-sub-block-re))
-			    (throw 'nesting 'block))
-			   (;--Found complete statement
-			    (save-excursion (forward-sexp 1)
-					    (= (following-char) ?\;))
-			    (setq complete t))
-			   (;--No known statements
-			    (bobp)
-			    (throw 'nesting 'unknown))
-			   )))))
-
-      ;; Return type of block and indent level.
-      (if (> par 0)                               ; Unclosed Parenthesis 
-	  (list 'contexp par)
-	(list type (pascal-indent-level))))))
-
-(defun pascal-indent-level ()
-  "Return the indent-level the current statement has.
-Do not count labels, case-statements or records."
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]")
-	(search-forward ":" nil t)
-      (if (looking-at ".*=[ \t]*record\\>")
-	  (search-forward "=" nil t)))
-    (skip-chars-forward " \t")
-    (current-column)))
-
-(defun pascal-indent-comment (&optional arg)
-  "Indent current line as comment.
-If optional arg is non-nil, just return the
-column number the line should be indented to."
-  (let* ((stcol (save-excursion
-		  (re-search-backward "(\\*\\|{" nil t)
-		  (1+ (current-column)))))
-    (if arg stcol
-      (delete-horizontal-space)
-      (indent-to stcol))))
-
-(defun pascal-indent-case ()
-  "Indent within case statements."
-  (let ((savepos (point-marker))
-	(end (prog2
-		 (end-of-line)
-		 (point-marker)
-	       (re-search-backward "\\" nil t)))
-	(beg (point)) oldpos
-	(ind 0))
-    ;; Get right indent
-    (while (< (point) end)
-      (if (re-search-forward 
-	   "^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
-	   (marker-position end) 'move)
-	  (forward-char -1))
-      (if (< (point) end)
-	  (progn
-	    (delete-horizontal-space)
-	    (if (> (current-column) ind)
-		(setq ind (current-column)))
-	    (pascal-end-of-statement))))
-    (goto-char beg)
-    (setq oldpos (marker-position end))
-    ;; Indent all case statements
-    (while (< (point) end)
-      (if (re-search-forward
-	   "^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
-	   (marker-position end) 'move)
-	  (forward-char -1))
-      (indent-to (1+ ind))
-      (if (/= (following-char) ?:)
-	  ()
-	(forward-char 1)
-	(delete-horizontal-space)
-	(insert " "))
-      (setq oldpos (point))
-      (pascal-end-of-statement))
-    (goto-char savepos)))
-
-(defun pascal-indent-paramlist (&optional arg)
-  "Indent current line in parameterlist.
-If optional arg is non-nil, just return the
-indent of the current line in parameterlist."
-  (save-excursion
-    (let* ((oldpos (point))
-	   (stpos (progn (goto-char (scan-lists (point) -1 1)) (point)))
-	   (stcol (1+ (current-column)))
-	   (edpos (progn (pascal-declaration-end) 
-			 (search-backward ")" (pascal-get-beg-of-line) t)
-			 (point)))
-	   (usevar (re-search-backward "\\" stpos t)))
-      (if arg (progn
-		;; If arg, just return indent
-		(goto-char oldpos)
-		(beginning-of-line)
-		(if (or (not usevar) (looking-at "[ \t]*var\\>"))
-		    stcol (+ 4 stcol)))
-	(goto-char stpos)
-	(forward-char 1)
-	(delete-horizontal-space)
-	(if (and usevar (not (looking-at "var\\>")))
-	    (indent-to (+ 4 stcol)))
-	(pascal-indent-declaration nil stpos edpos)))))
-
-(defun pascal-indent-declaration (&optional arg start end)
-  "Indent current lines as declaration, lining up the `:'s or `='s."
-  (let ((pos (point-marker)))
-    (if (and (not (or arg start)) (not (pascal-declaration-beg)))
-	()
-      (let ((lineup (if (or (looking-at "\\\\|\\") arg start) 
-			":" "="))
-	    (stpos (if start start
-		       (forward-word 2) (backward-word 1) (point)))
-	    (edpos (set-marker (make-marker)
-			       (if end end
-				 (max (progn (pascal-declaration-end)
-					     (point))
-				      pos))))
-	    ind)
-
-	(goto-char stpos)
-	;; Indent lines in record block
-	(if arg
-	    (while (<= (point) edpos)
-	      (beginning-of-line)
-	      (delete-horizontal-space)
-	      (if (looking-at "end\\>")
-		  (indent-to arg)
-		(indent-to (+ arg pascal-indent-level)))
-	      (forward-line 1)))
-
-	;; Do lineup
-	(setq ind (pascal-get-lineup-indent stpos edpos lineup))
-	(goto-char stpos)
-	(while (and (<= (point) edpos) (not (eobp)))
-	  (if (search-forward lineup (pascal-get-end-of-line) 'move)
-	      (forward-char -1))
-	  (delete-horizontal-space)
-	  (indent-to ind)
-	  (if (not (looking-at lineup))
-	      (forward-line 1) ; No more indent if there is no : or =
-	    (forward-char 1)
-	    (delete-horizontal-space)
-	    (insert " ")
-	    ;; Indent record block
-	    (if (looking-at "record\\>")
-		(pascal-indent-declaration (current-column)))
-	    (forward-line 1)))))
-
-    ;; If arg - move point
-    (if arg (forward-line -1)
-      (goto-char pos))))
-
-;  "Return the indent level that will line up several lines within the region
-;from b to e nicely. The lineup string is str."
-(defun pascal-get-lineup-indent (b e str)
-  (save-excursion
-    (let ((ind 0)
-	  (reg (concat str "\\|\\(\\\\)")))
-      (goto-char b)
-      ;; Get rightmost position
-      (while (< (point) e)
-	(if (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move)
-	    (progn
-	      ;; Skip record blocks
-	      (if (match-beginning 1)
-		  (pascal-declaration-end)
-		(progn
-		  (goto-char (match-beginning 0))
-		  (skip-chars-backward " \t")
-		  (if (> (current-column) ind)
-		      (setq ind (current-column)))
-		  (goto-char (match-end 0))
-		  (end-of-line)
-		  )))))
-      ;; In case no lineup was found
-      (if (> ind 0)
-	  (1+ ind)
-	;; No lineup-string found
-	(goto-char b)
-	(end-of-line)
-	(skip-chars-backward " \t")
-	(1+ (current-column))))))
-    
-
-
-;;;
-;;; Completion
-;;;
-(defvar pascal-str nil)
-(defvar pascal-all nil)
-(defvar pascal-pred nil)
-(defvar pascal-buffer-to-use nil)
-(defvar pascal-flag nil)
-
-(defun pascal-string-diff (str1 str2)
-  "Return index of first letter where STR1 and STR2 differs."
-  (catch 'done
-    (let ((diff 0))
-      (while t
-	(if (or (> (1+ diff) (length str1))
-		(> (1+ diff) (length str2)))
-	    (throw 'done diff))
-	(or (equal (aref str1 diff) (aref str2 diff))
-	    (throw 'done diff))
-	(setq diff (1+ diff))))))
-
-;; Calculate all possible completions for functions if argument is `function',
-;; completions for procedures if argument is `procedure' or both functions and
-;; procedures otherwise.
-
-(defun pascal-func-completion (type)
-  ;; Build regular expression for function/procedure names
-  (if (string= pascal-str "")
-      (setq pascal-str "[a-zA-Z_]"))
-  (let ((pascal-str (concat (cond
-			     ((eq type 'procedure) "\\<\\(procedure\\)\\s +")
-			     ((eq type 'function) "\\<\\(function\\)\\s +")
-			     (t "\\<\\(function\\|procedure\\)\\s +"))
-			    "\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>"))
-	match)
-    
-    (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
-	(re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
-    (forward-char 1)
-
-    ;; Search through all reachable functions
-    (while (pascal-beg-of-defun)
-      (if (re-search-forward pascal-str (pascal-get-end-of-line) t)
-	  (progn (setq match (buffer-substring (match-beginning 2)
-					       (match-end 2)))
-		 (if (or (null pascal-pred)
-			 (funcall pascal-pred match))
-		     (setq pascal-all (cons match pascal-all)))))
-      (goto-char (match-beginning 0)))))
-
-(defun pascal-get-completion-decl ()
-  ;; Macro for searching through current declaration (var, type or const)
-  ;; for matches of `str' and adding the occurrence to `all'
-  (let ((end (save-excursion (pascal-declaration-end)
-			     (point)))
-	match)
-    ;; Traverse lines
-    (while (< (point) end)
-      (if (re-search-forward "[:=]" (pascal-get-end-of-line) t)
-	  ;; Traverse current line
-	  (while (and (re-search-backward 
-		       (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" 
-			       pascal-symbol-re)
-		       (pascal-get-beg-of-line) t)
-		      (not (match-end 1)))
-	    (setq match (buffer-substring (match-beginning 0) (match-end 0)))
-	    (if (string-match (concat "\\<" pascal-str) match)
-		(if (or (null pascal-pred)
-			(funcall pascal-pred match))
-		    (setq pascal-all (cons match pascal-all))))))
-      (if (re-search-forward "\\" (pascal-get-end-of-line) t)
-	  (pascal-declaration-end)
-	(forward-line 1)))))
-
-(defun pascal-type-completion ()
-  "Calculate all possible completions for types."
-  (let ((start (point))
-	goon)
-    ;; Search for all reachable type declarations
-    (while (or (pascal-beg-of-defun)
-	       (setq goon (not goon)))
-      (save-excursion
-	(if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
-						 (point))
-			    (forward-char 1)))
-		 (re-search-forward
-		  "\\\\|\\<\\(begin\\|function\\|procedure\\)\\>"
-		  start t)
-		 (not (match-end 1)))
-	    ;; Check current type declaration
-	    (pascal-get-completion-decl))))))
-
-(defun pascal-var-completion ()
-  "Calculate all possible completions for variables (or constants)."
-  (let ((start (point))
-	goon twice)
-    ;; Search for all reachable var declarations
-    (while (or (pascal-beg-of-defun)
-	       (setq goon (not goon)))
-      (save-excursion
-	(if (> start (prog1 (save-excursion (pascal-end-of-defun)
-					    (point))))
-	    () ; Declarations not reachable
-	  (if (search-forward "(" (pascal-get-end-of-line) t)
-	      ;; Check parameterlist
-		(pascal-get-completion-decl))
-	  (setq twice 2)
-	  (while (>= (setq twice (1- twice)) 0)
-	    (cond ((and (re-search-forward
-			 (concat "\\<\\(var\\|const\\)\\>\\|"
-				 "\\<\\(begin\\|function\\|procedure\\)\\>")
-			 start t)
-			(not (match-end 2)))
-		   ;; Check var/const declarations
-		   (pascal-get-completion-decl))
-		  ((match-end 2)
-		   (setq twice 0)))))))))
-
-
-(defun pascal-keyword-completion (keyword-list)
-  "Give list of all possible completions of keywords in KEYWORD-LIST."
-  (mapcar '(lambda (s) 
-	     (if (string-match (concat "\\<" pascal-str) s)
-		 (if (or (null pascal-pred)
-			 (funcall pascal-pred s))
-		     (setq pascal-all (cons s pascal-all)))))
-	  keyword-list))
-
-;; Function passed to completing-read, try-completion or
-;; all-completions to get completion on STR. If predicate is non-nil,
-;; it must be a function to be called for every match to check if this
-;; should really be a match. If flag is t, the function returns a list
-;; of all possible completions. If it is nil it returns a string, the
-;; longest possible completion, or t if STR is an exact match. If flag
-;; is 'lambda, the function returns t if STR is an exact match, nil
-;; otherwise.
-
-(defun pascal-completion (pascal-str pascal-pred pascal-flag)
-  (save-excursion
-    (let ((pascal-all nil))
-      ;; Set buffer to use for searching labels. This should be set
-      ;; within functions which use pascal-completions
-      (set-buffer pascal-buffer-to-use)
-
-      ;; Determine what should be completed
-      (let ((state (car (pascal-calculate-indent))))
-	(cond (;--Within a declaration or parameterlist
-	       (or (eq state 'declaration) (eq state 'paramlist)
-		   (and (eq state 'defun)
-			(save-excursion
-			  (re-search-backward ")[ \t]*:"
-					      (pascal-get-beg-of-line) t))))
-	       (if (or (eq state 'paramlist) (eq state 'defun))
-		   (pascal-beg-of-defun))
-	       (pascal-type-completion)
-	       (pascal-keyword-completion pascal-type-keywords))
-	      (;--Starting a new statement
-	       (and (not (eq state 'contexp))
-		    (save-excursion
-		      (skip-chars-backward "a-zA-Z0-9_.")
-		      (backward-sexp 1)
-		      (or (looking-at pascal-nosemi-re)
-			  (progn
-			    (forward-sexp 1)
-			    (looking-at "\\s *\\(;\\|:[^=]\\)")))))
-	       (save-excursion (pascal-var-completion))
-	       (pascal-func-completion 'procedure)
-	       (pascal-keyword-completion pascal-start-keywords))
-	      (t;--Anywhere else
-	       (save-excursion (pascal-var-completion))
-	       (pascal-func-completion 'function)
-	       (pascal-keyword-completion pascal-separator-keywords))))
-      
-      ;; Now we have built a list of all matches. Give response to caller
-      (pascal-completion-response))))
-
-(defun pascal-completion-response ()
-  (cond ((or (equal pascal-flag 'lambda) (null pascal-flag))
-	 ;; This was not called by all-completions
-	 (if (null pascal-all)
-	     ;; Return nil if there was no matching label
-	     nil
-	   ;; Get longest string common in the labels
-	   (let* ((elm (cdr pascal-all))
-		  (match (car pascal-all))
-		  (min (length match))
-		  tmp)
-	     (if (string= match pascal-str)
-		 ;; Return t if first match was an exact match
-		 (setq match t)
-	       (while (not (null elm))
-		 ;; Find longest common string
-		 (if (< (setq tmp (pascal-string-diff match (car elm))) min)
-		     (progn
-		       (setq min tmp)
-		       (setq match (substring match 0 min))))
-		 ;; Terminate with match=t if this is an exact match
-		 (if (string= (car elm) pascal-str)
-		     (progn
-		       (setq match t)
-		       (setq elm nil))
-		   (setq elm (cdr elm)))))
-	     ;; If this is a test just for exact match, return nil ot t
-	     (if (and (equal pascal-flag 'lambda) (not (equal match 't)))
-		 nil
-	       match))))
-	;; If flag is t, this was called by all-completions. Return
-	;; list of all possible completions
-	(pascal-flag
-	 pascal-all)))
-
-(defvar pascal-last-word-numb 0)
-(defvar pascal-last-word-shown nil)
-(defvar pascal-last-completions nil)
-
-(defun pascal-complete-word ()
-  "Complete word at current point.
-\(See also `pascal-toggle-completions', `pascal-type-keywords',
-`pascal-start-keywords' and `pascal-separator-keywords'.)"
-  (interactive)
-  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
-	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
-	 (pascal-str (buffer-substring b e))
-	 ;; The following variable is used in pascal-completion
-	 (pascal-buffer-to-use (current-buffer))
-	 (allcomp (if (and pascal-toggle-completions
-			   (string= pascal-last-word-shown pascal-str))
-		      pascal-last-completions
-		    (all-completions pascal-str 'pascal-completion)))
-	 (match (if pascal-toggle-completions
-		    "" (try-completion
-			pascal-str (mapcar '(lambda (elm)
-					      (cons elm 0)) allcomp)))))
-    ;; Delete old string
-    (delete-region b e)
-
-    ;; Toggle-completions inserts whole labels
-    (if pascal-toggle-completions
-	(progn
-	  ;; Update entry number in list
-	  (setq pascal-last-completions allcomp
-		pascal-last-word-numb 
-		(if (>= pascal-last-word-numb (1- (length allcomp)))
-		    0
-		  (1+ pascal-last-word-numb)))
-	  (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
-	  ;; Display next match or same string if no match was found
-	  (if (not (null allcomp))
-	      (insert "" pascal-last-word-shown)
-	    (insert "" pascal-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 "" pascal-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 pascal-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))
-	     (delete-window (get-buffer-window (get-buffer "*Completions*")))
-	     )))))
-
-(defun pascal-show-completions ()
-  "Show all possible completions at current point."
-  (interactive)
-  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
-	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
-	 (pascal-str (buffer-substring b e))
-	 ;; The following variable is used in pascal-completion
-	 (pascal-buffer-to-use (current-buffer))
-	 (allcomp (if (and pascal-toggle-completions
-			   (string= pascal-last-word-shown pascal-str))
-		      pascal-last-completions
-		    (all-completions pascal-str 'pascal-completion))))
-    ;; Show possible completions in a temporary buffer.
-    (with-output-to-temp-buffer "*Completions*"
-      (display-completion-list allcomp))
-    ;; Wait for a keypress. Then delete *Completion*  window
-    (momentary-string-display "" (point))
-    (delete-window (get-buffer-window (get-buffer "*Completions*")))))
-
-
-(defun pascal-get-default-symbol ()
-  "Return symbol around current point as a string."
-  (save-excursion
-    (buffer-substring (progn
-			(skip-chars-backward " \t")
-			(skip-chars-backward "a-zA-Z0-9_")
-			(point))
-		      (progn
-			(skip-chars-forward "a-zA-Z0-9_")
-			(point)))))
-
-(defun pascal-build-defun-re (str &optional arg)
-  "Return function/procedure starting with STR as regular expression.
-With optional second arg non-nil, STR is the complete name of the instruction."
-  (if arg
-      (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>")
-    (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>")))
-
-;; Function passed to completing-read, try-completion or
-;; all-completions to get completion on any function name. If
-;; predicate is non-nil, it must be a function to be called for every
-;; match to check if this should really be a match. If flag is t, the
-;; function returns a list of all possible completions. If it is nil
-;; it returns a string, the longest possible completion, or t if STR
-;; is an exact match. If flag is 'lambda, the function returns t if
-;; STR is an exact match, nil otherwise.
-
-(defun pascal-comp-defun (pascal-str pascal-pred pascal-flag)
-  (save-excursion
-    (let ((pascal-all nil)
-	  match)
-
-      ;; Set buffer to use for searching labels. This should be set
-      ;; within functions which use pascal-completions
-      (set-buffer pascal-buffer-to-use)
-
-      (let ((pascal-str pascal-str))
-	;; Build regular expression for functions
-	(if (string= pascal-str "")
-	    (setq pascal-str (pascal-build-defun-re "[a-zA-Z_]"))
-	  (setq pascal-str (pascal-build-defun-re pascal-str)))
-	(goto-char (point-min))
-      
-	;; Build a list of all possible completions
-	(while (re-search-forward pascal-str nil t)
-	  (setq match (buffer-substring (match-beginning 2) (match-end 2)))
-	  (if (or (null pascal-pred)
-		  (funcall pascal-pred match))
-	      (setq pascal-all (cons match pascal-all)))))
-
-      ;; Now we have built a list of all matches. Give response to caller
-      (pascal-completion-response))))
-
-(defun pascal-goto-defun ()
-  "Move to specified Pascal function/procedure.
-The default is a name found in the buffer around point."
-  (interactive)
-  (let* ((default (pascal-get-default-symbol))
-	 ;; The following variable is used in pascal-comp-function
-	 (pascal-buffer-to-use (current-buffer))
-	 (default (if (pascal-comp-defun default nil 'lambda)
-		      default ""))
-	 (label (if (not (string= default ""))
-		    ;; Do completion with default
-		    (completing-read (concat "Label: (default " default ") ")
-				     'pascal-comp-defun nil t "")
-		  ;; There is no default value. Complete without it
-		  (completing-read "Label: "
-				   'pascal-comp-defun nil t ""))))
-    ;; If there was no response on prompt, use default value
-    (if (string= label "")
-	(setq label default))
-    ;; Goto right place in buffer if label is not an empty string
-    (or (string= label "")
-	(progn
-	  (goto-char (point-min))
-	  (re-search-forward (pascal-build-defun-re label t))
-	  (beginning-of-line)))))
-
-
-
-;;;
-;;; Pascal-outline-mode
-;;;
-(defvar pascal-outline-map nil "Keymap used in Pascal Outline mode.")
-
-(if pascal-outline-map
-    nil
-  (if (boundp 'set-keymap-name)
-      (set-keymap-name pascal-outline-map 'pascal-outline-map))
-  (if (not (boundp 'set-keymap-parent))
-      (setq pascal-outline-map (copy-keymap pascal-mode-map))
-    (setq pascal-outline-map (make-sparse-keymap))
-    (set-keymap-parent pascal-outline-map pascal-mode-map))
-  (define-key pascal-outline-map "\M-\C-a"  'pascal-outline-prev-defun)
-  (define-key pascal-outline-map "\M-\C-e"  'pascal-outline-next-defun)
-  (define-key pascal-outline-map "\C-c\C-d" 'pascal-outline-goto-defun)
-  (define-key pascal-outline-map "\C-c\C-s" 'pascal-show-all)
-  (define-key pascal-outline-map "\C-c\C-h" 'pascal-hide-other-defuns))
-
-(defvar pascal-outline-mode nil "Non-nil while using Pascal Outline mode.")
-(make-variable-buffer-local 'pascal-outline-mode)
-(set-default 'pascal-outline-mode nil)
-(if (not (assoc 'pascal-outline-mode minor-mode-alist))
-    (setq minor-mode-alist (append minor-mode-alist
-				   (list '(pascal-outline-mode " Outl")))))
-
-(defun pascal-outline (&optional arg)
-  "Outline-line minor mode for Pascal mode.
-When in Pascal Outline mode, portions
-of the text being edited may be made invisible. \\
-
-Pascal Outline mode provides some additional commands.
-
-\\[pascal-outline-prev-defun]\
-\t- Move to previous function/procedure, hiding everything else.
-\\[pascal-outline-next-defun]\
-\t- Move to next function/procedure, hiding everything else.
-\\[pascal-outline-goto-defun]\
-\t- Goto function/procedure prompted for in minibuffer,
-\t  hide all other functions.
-\\[pascal-show-all]\t- Show the whole buffer.
-\\[pascal-hide-other-defuns]\
-\t- Hide everything but the current function (function under the cursor).
-\\[pascal-outline]\t- Leave pascal-outline-mode."
-  (interactive "P")
-  (setq pascal-outline-mode
-	(if (null arg) (not pascal-outline-mode) t))
-  (if (boundp 'redraw-mode-line)
-      (redraw-mode-line))
-  (if pascal-outline-mode
-      (progn
-	(setq selective-display t)
-	(use-local-map pascal-outline-map))
-    (progn
-      (setq selective-display nil)
-      (pascal-show-all)
-      (use-local-map pascal-mode-map))))
-
-(defun pascal-outline-change (b e pascal-flag)
-  (let ((modp (buffer-modified-p)))
-    (unwind-protect
-	(subst-char-in-region b e (if (= pascal-flag ?\n) 
-				      ?\^M ?\n) pascal-flag)
-      (set-buffer-modified-p modp))))
-
-(defun pascal-show-all ()
-  "Show all of the text in the buffer."
-  (interactive)
-  (pascal-outline-change (point-min) (point-max) ?\n))
-
-(defun pascal-hide-other-defuns ()
-  "Show only the current defun."
-  (interactive)
-  (save-excursion
-    (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>"))
-			  (pascal-beg-of-defun))
-		      (point)))
-	  (end (progn (pascal-end-of-defun)
-		      (backward-sexp 1)
-		      (search-forward "\n\\|\^M" nil t)
-		      (point)))
-	  (opoint (point-min)))
-      (goto-char (point-min))
-
-      ;; Hide all functions before current function
-      (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move)
-	(pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
-	(setq opoint (point))
-	;; Functions may be nested
-	(if (> (progn (pascal-end-of-defun) (point)) beg)
-	    (goto-char opoint)))
-      (if (> beg opoint)
-	  (pascal-outline-change opoint (1- beg) ?\^M))
-
-      ;; Show current function
-      (pascal-outline-change beg end ?\n)
-      ;; Hide nested functions
-      (forward-char 1)
-      (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move)
-	(setq opoint (point))
-	(pascal-end-of-defun)
-	(pascal-outline-change opoint (point) ?\^M))
-
-      (goto-char end)
-      (setq opoint end)
-
-      ;; Hide all function after current function
-      (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move)
-	(pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
-	(setq opoint (point))
-	(pascal-end-of-defun))
-      (pascal-outline-change opoint (point-max) ?\^M)
-
-      ;; Hide main program
-      (if (< (progn (forward-line -1) (point)) end)
-	  (progn
-	    (goto-char beg)
-	    (pascal-end-of-defun)
-	    (backward-sexp 1)
-	    (pascal-outline-change (point) (point-max) ?\^M))))))
-
-(defun pascal-outline-next-defun ()
-  "Move to next function/procedure, hiding all others."
-  (interactive)
-  (pascal-end-of-defun)
-  (pascal-hide-other-defuns))
-
-(defun pascal-outline-prev-defun ()
-  "Move to previous function/procedure, hiding all others."
-  (interactive)
-  (pascal-beg-of-defun)
-  (pascal-hide-other-defuns))
-
-(defun pascal-outline-goto-defun ()
-  "Move to specified function/procedure, hiding all others."
-  (interactive)
-  (pascal-goto-defun)
-  (pascal-hide-other-defuns))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.p\\(?:as\\)?\\'" . pascal-mode))
-
-;;; pascal.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/php-mode.el b/xemacs-packages/lisp/prog-modes/php-mode.el
deleted file mode 100644
index 6b285b8e..00000000
--- a/xemacs-packages/lisp/prog-modes/php-mode.el
+++ /dev/null
@@ -1,852 +0,0 @@
-;;; php-mode.el --- major mode for editing PHP code
-
-;; Copyright (C) 1999-2004 Turadg Aleahmad
-
-;; Maintainer: Turadg Aleahmad 
-;; Keywords: php languages oop
-;; Created: 1999-05-17
-;; Modified: 2004-01-24
-;; X-URL:   http://php-mode.sourceforge.net/
-
-(defconst php-version "1.1.0"
-  "PHP Mode version number.")
-
-;;; 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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
-
-;;; Usage
-
-;; Rename this file to php-mode.el if it isn't already then place it in
-;; your Emacs lisp path (eg. site-lisp) and add to your .emacs file:
-;;   (require 'php-mode)
-
-;; If you want colorization, turn on global-font-lock or
-;; add this to your .emacs:
-;;   (add-hook 'php-mode-user-hook 'turn-on-font-lock)
-
-;; To use abbrev-mode, add lines like this:
-;;   (add-hook 'php-mode-user-hook
-;;     '(lambda () (define-abbrev php-mode-abbrev-table "ex" "extends")))
-
-;; To make php-mode compatible with html-mode, see http://php-mode.sf.net
-
-;; Many options available under Help:Customize
-;; Options specific to php-mode are in
-;;  Programming/Languages/Php
-;; Since it inherits much functionality from c-mode, look there too
-;;  Programming/Languages/C
-
-;;; Commentary:
-
-;; PHP mode is a major mode for editing PHP 3 and 4 source code.  It's
-;; an extension of C mode; thus it inherits all C mode's navigation
-;; functionality.  But it colors according to the PHP grammar and indents
-;; according to the PEAR coding guidelines.  It also includes a couple
-;; handy IDE-type features such as documentation search and a source
-;; and class browser.
-
-
-;;; Contributors: (in chronological order)
-
-;; Juanjo, Torsten Martinsen, Vinai Kopp, Sean Champ, Doug Marcey,
-;; Kevin Blake, Rex McMaster, Mathias Meyer, Boris Folgmann, Roland
-;; Rosenfeld, Fred Yankowski, Craig Andrews, John Keller, Ryan
-;; Sammartino, ppercot, Valentin Funk, Stig Bakken, Gregory Stark,
-;; Chris Morris, Nils Rennebarth, Gerrit Riessen, Eric Mc Sween,
-;; Ville Skytta, Giacomo Tesio
-
-;;; Changelog:
-
-;; 1.1
-;;   Added PHP5 support (Giacomo Tesio)
-;;     known problem: doesn't highlight after first 'implements'
-;;   Better XEmacs compatibility (imenu, regexp, and comments!) (Ville Skytta)
-;;   Improvement to php-conditional-key regexp (Eric Mc Sween)
-
-;; 1.05
-;;   Incorporated speedbar defs by Gerrit Riessen
-;;   Add "foreach" to conditional introducing keywords (Nils Rennebarth)
-;;   Cleared the Changelog
-;;   Moved contribution credits into comments above
-
-
-;;; Code:
-
-(require 'speedbar)
-(require 'font-lock)
-(require 'cc-mode)
-(require 'custom)
-(eval-when-compile
-  (require 'regexp-opt))
-
-;; Local variables
-(defgroup php nil
-  "Major mode for editing PHP code."
-  :prefix "php-"
-  :group 'languages)
-
-(defcustom php-speedbar-config t
-  "*When set to true automatically configures Speedbar to observe PHP files.\
-Ignores php-file patterns option; fixed to expression \"\\.\\(inc\\|php[s34]?\\)\""
-  :type 'boolean
-  :group 'php)
-
-(defcustom php-mode-speedbar-open nil
-  "Normally php-mode starts with the speedbar closed.\
-Turning this on will open it whenever php-mode is loaded."
-  :type 'boolean
-  :group 'php)
-
-(defcustom php-manual-url "http://www.php.net/manual/en/manual.php"
-  "*URL at which to find PHP manual.\
-You can replace \"en\" with your ISO language code."
-  :type 'string
-  :group 'php)
-
-(defcustom php-search-url "http://www.php.net/"
-  "*URL at which to search for documentation on a word"
-  :type 'string
-  :group 'php)
-
-;;;###autoload
-(defcustom php-file-patterns (list "\\.php[s34]?\\'" "\\.phtml\\'" "\\.inc\\'")
-  "*List of file patterns for which to automatically invoke php-mode."
-  :type '(repeat (regexp :tag "Pattern"))
-  :group 'php)
-
-(defcustom php-mode-user-hook nil
-  "List of functions to be executed on entry to php-mode"
-  :type 'hook
-  :group 'php)
-
-(defcustom php-mode-force-pear nil
-  "Normally PEAR coding rules are enforced only when the filename contains \"PEAR\"\
-Turning this on will force PEAR rules on all PHP files."
-  :type 'boolean
-  :group 'php)
-
-;; Note whether we're in XEmacs
-(defconst xemacsp (string-match "Lucid\\|XEmacs" emacs-version)
-  "Non nil if using XEmacs.")
-
-;; XEmacs hack: autoload a dummy autoload instead of a derived mode.
-;;;###autoload(autoload 'php-mode "php-mode" nil t)
-(define-derived-mode php-mode c-mode "PHP"
-  "Major mode for editing PHP code.\n\n\\{php-mode-map}"
-  
-  (setq comment-start "// "
-	comment-end   ""
-	comment-start-skip "// *")
-  
-  (setq c-class-key php-class-key)
-  (setq c-conditional-key php-conditional-key)
-
-  (defvar php-mode-syntax-table php-mode-syntax-table)
-  ;; this line makes $ into punctuation instead of a word constituent
-  ;; it used to be active, but it killed indenting of case lines that
-  ;; begin with '$' (many do).  If anyone has a solution to this
-  ;; problem, please let me know.  Of course, you're welcome to
-  ;; uncomment this line in your installation.
-;  (modify-syntax-entry ?$ "." php-mode-syntax-table)
-  
-  ;; The above causes XEmacs to handle shell-style comments correctly,
-  ;; but fails to work in GNU Emacs which fails to interpret \n as the
-  ;; end of the comment.
-  (if xemacsp (progn
-		(modify-syntax-entry ?# "< b" php-mode-syntax-table)
-		(modify-syntax-entry ?\n "> b" php-mode-syntax-table)
-		))
-  
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults
- 	'((php-font-lock-keywords-1
- 	   php-font-lock-keywords-2
- 	   ;; Comment-out the next line if the font-coloring is too
- 	   ;; extreme/ugly for you.
- 	   php-font-lock-keywords-3
- 	   )
- 	  nil				; KEYWORDS-ONLY
- 	  T				; CASE-FOLD
- 	  nil				; SYNTAX-ALIST
- 	  nil				; SYNTAX-BEGIN
- 	  (font-lock-syntactic-keywords . php-font-lock-syntactic-keywords)))
-  
-  (setq font-lock-maximum-decoration t
-	case-fold-search t		; PHP vars are case-sensitive
-	imenu-generic-expression php-imenu-generic-expression)
-  
-  ;; Do not force newline at end of file.  Such newlines can cause
-  ;; trouble if the PHP file is included in another file before calls
-  ;; to header() or cookie().
-  (set (make-local-variable 'require-final-newline) nil)
-  (set (make-local-variable 'next-line-add-newlines) nil)
-  
-  ;; PEAR coding standards
-  (make-local-hook 'php-mode-pear-hook)
-  (add-hook 'php-mode-pear-hook
-	    (lambda nil (set (make-local-variable 'tab-width) 4)) nil t)
-  (add-hook 'php-mode-pear-hook
-	    (lambda nil (set (make-local-variable 'c-basic-offset) 4)) nil t)
-  (add-hook 'php-mode-pear-hook
-	    (lambda nil (set (make-local-variable 'c-hanging-comment-ender-p) nil)) nil t)
-  (add-hook 'php-mode-pear-hook
-	    (lambda nil (set (make-local-variable 'indent-tabs-mode) nil)) nil t)
-  (add-hook 'php-mode-pear-hook
-	    (lambda nil (c-set-offset 'block-open' - )) nil t)
-  (add-hook 'php-mode-pear-hook
-	    (lambda nil (c-set-offset 'block-close' 0 )) nil t)
-
-  (if (or php-mode-force-pear
-	  (and (stringp buffer-file-name)
-	       (string-match "PEAR\\|pear"
-			     (buffer-file-name))
-	       (string-match "\\.php$" (buffer-file-name))))
-      (run-hooks 'php-mode-pear-hook))
-  
-  (run-hooks 'php-mode-user-hook)
-  )
-
-;; Make php-mode the default mode for PHP source code buffers.
-;;;###autoload
-(let ((php-file-patterns-temp php-file-patterns))
-  (while php-file-patterns-temp
-    (add-to-list 'auto-mode-alist
-		  (cons (car php-file-patterns-temp) 'php-mode))
-    (setq php-file-patterns-temp (cdr php-file-patterns-temp))))
-
-;; Handle Speedbar
-(if php-mode-speedbar-open
-    (speedbar 1))
-(if (and php-speedbar-config (symbolp 'speedbar))
-    (speedbar-add-supported-extension "\\.\\(inc\\|php[s34]?\\)"))
-
-;; Make a menu keymap (with a prompt string)
-;; and make it the menu bar item's definition.
-(define-key php-mode-map [menu-bar] (make-sparse-keymap))
-(define-key php-mode-map [menu-bar php]
-  (cons "PHP" (make-sparse-keymap "PHP")))
-
-;; Define specific subcommands in this menu.
-(define-key php-mode-map [menu-bar php complete-function]
-  '("Complete function name" . php-complete-function))
-(define-key php-mode-map
-  [menu-bar php browse-manual]
-  '("Browse manual" . php-browse-manual))
-(define-key php-mode-map
-  [menu-bar php search-documentation]
-  '("Search documentation" . php-search-documentation))
-
-;; Define function name completion function
-(defun php-complete-function ()
-  "Complete the function name at the point from known PHP functions."
-  (interactive)
-  (message "php-complete-function not implemented yet")
-  ;; how to read the list of functions from a separate file?
-  )
-
-;; Define function documentation function
-(defun php-search-documentation ()
-  "Search PHP documentation for the word at the point."
-  (interactive)
-  (browse-url (concat php-search-url (current-word t)))
-  )
-
-;; Define function for browsing manual
-(defun php-browse-manual ()
-  "Bring up manual for PHP."
-  (interactive)
-  (browse-url php-manual-url)
-  )
-
-;; Define shortcut
-(define-key php-mode-map
-  "\C-c\C-f"
-  'php-search-documentation)
-
-;; Define shortcut
-(define-key php-mode-map
-  "\C-c\C-m"
-  'php-browse-manual)
-
-(defconst php-constants
-  (eval-when-compile
-    (regexp-opt
-     '(;; core constants
-       "__LINE__" "__FILE__"
-       "PHP_OS" "PHP_VERSION" 
-       "TRUE" "FALSE" "NULL"
-       "E_ERROR" "E_NOTICE" "E_PARSE" "E_WARNING" "E_ALL"
-       "E_USER_ERROR" "E_USER_WARNING" "E_USER_NOTICE"
-       "DEFAULT_INCLUDE_PATH" "PEAR_INSTALL_DIR" "PEAR_EXTENSION_DIR"
-       "PHP_BINDIR" "PHP_LIBDIR" "PHP_DATADIR" "PHP_SYSCONFDIR"
-       "PHP_LOCALSTATEDIR" "PHP_CONFIG_FILE_PATH"
-
-       ;; from ext/standard:
-       "EXTR_OVERWRITE" "EXTR_SKIP" "EXTR_PREFIX_SAME"
-       "EXTR_PREFIX_ALL" "EXTR_PREFIX_INVALID" "SORT_ASC" "SORT_DESC"
-       "SORT_REGULAR" "SORT_NUMERIC" "SORT_STRING" "ASSERT_ACTIVE"
-       "ASSERT_CALLBACK" "ASSERT_BAIL" "ASSERT_WARNING"
-       "ASSERT_QUIET_EVAL" "CONNECTION_ABORTED" "CONNECTION_NORMAL"
-       "CONNECTION_TIMEOUT" "M_E" "M_LOG2E" "M_LOG10E" "M_LN2"
-       "M_LN10" "M_PI" "M_PI_2" "M_PI_4" "M_1_PI" "M_2_PI"
-       "M_2_SQRTPI" "M_SQRT2" "M_SQRT1_2" "CRYPT_SALT_LENGTH"
-       "CRYPT_STD_DES" "CRYPT_EXT_DES" "CRYPT_MD5" "CRYPT_BLOWFISH"
-       "DIRECTORY_SEPARATOR" "SEEK_SET" "SEEK_CUR" "SEEK_END"
-       "LOCK_SH" "LOCK_EX" "LOCK_UN" "LOCK_NB" "HTML_SPECIALCHARS"
-       "HTML_ENTITIES" "ENT_COMPAT" "ENT_QUOTES" "ENT_NOQUOTES"
-       "INFO_GENERAL" "INFO_CREDITS" "INFO_CONFIGURATION"
-       "INFO_ENVIRONMENT" "INFO_VARIABLES" "INFO_LICENSE" "INFO_ALL"
-       "CREDITS_GROUP" "CREDITS_GENERAL" "CREDITS_SAPI"
-       "CREDITS_MODULES" "CREDITS_DOCS" "CREDITS_FULLPAGE"
-       "CREDITS_QA" "CREDITS_ALL" "PHP_OUTPUT_HANDLER_START"
-       "PHP_OUTPUT_HANDLER_CONT" "PHP_OUTPUT_HANDLER_END"
-       "STR_PAD_LEFT" "STR_PAD_RIGHT" "STR_PAD_BOTH"
-       "PATHINFO_DIRNAME" "PATHINFO_BASENAME" "PATHINFO_EXTENSION"
-       "CHAR_MAX" "LC_CTYPE" "LC_NUMERIC" "LC_TIME" "LC_COLLATE"
-       "LC_MONETARY" "LC_ALL" "LC_MESSAGES" "LOG_EMERG" "LOG_ALERT"
-       "LOG_CRIT" "LOG_ERR" "LOG_WARNING" "LOG_NOTICE" "LOG_INFO"
-       "LOG_DEBUG" "LOG_KERN" "LOG_USER" "LOG_MAIL" "LOG_DAEMON"
-       "LOG_AUTH" "LOG_SYSLOG" "LOG_LPR" "LOG_NEWS" "LOG_UUCP"
-       "LOG_CRON" "LOG_AUTHPRIV" "LOG_LOCAL0" "LOG_LOCAL1"
-       "LOG_LOCAL2" "LOG_LOCAL3" "LOG_LOCAL4" "LOG_LOCAL5"
-       "LOG_LOCAL6" "LOG_LOCAL7" "LOG_PID" "LOG_CONS" "LOG_ODELAY"
-       "LOG_NDELAY" "LOG_NOWAIT" "LOG_PERROR"
-       
-       ;; Disabled by default because they slow buffer loading
-       ;; If you have use for them, decomment the strings 
-       ;; that you want colored.
-       ;; To compile, you may have to increase 'max-specpdl-size'
-
-       ;; from other bundled extensions:
-;        "CAL_EASTER_TO_xxx" "VT_NULL" "VT_EMPTY" "VT_UI1" "VT_I2"
-;        "VT_I4" "VT_R4" "VT_R8" "VT_BOOL" "VT_ERROR" "VT_CY" "VT_DATE"
-;        "VT_BSTR" "VT_DECIMAL" "VT_UNKNOWN" "VT_DISPATCH" "VT_VARIANT"
-;        "VT_I1" "VT_UI2" "VT_UI4" "VT_INT" "VT_UINT" "VT_ARRAY"
-;        "VT_BYREF" "CP_ACP" "CP_MACCP" "CP_OEMCP" "CP_SYMBOL"
-;        "CP_THREAD_ACP" "CP_UTF7" "CP_UTF8" "CPDF_PM_NONE"
-;        "CPDF_PM_OUTLINES" "CPDF_PM_THUMBS" "CPDF_PM_FULLSCREEN"
-;        "CPDF_PL_SINGLE" "CPDF_PL_1COLUMN" "CPDF_PL_2LCOLUMN"
-;        "CPDF_PL_2RCOLUMN" "CURLOPT_PORT" "CURLOPT_FILE"
-;        "CURLOPT_INFILE" "CURLOPT_INFILESIZE" "CURLOPT_URL"
-;        "CURLOPT_PROXY" "CURLOPT_VERBOSE" "CURLOPT_HEADER"
-;        "CURLOPT_HTTPHEADER" "CURLOPT_NOPROGRESS" "CURLOPT_NOBODY"
-;        "CURLOPT_FAILONERROR" "CURLOPT_UPLOAD" "CURLOPT_POST"
-;        "CURLOPT_FTPLISTONLY" "CURLOPT_FTPAPPEND" "CURLOPT_NETRC"
-;        "CURLOPT_FOLLOWLOCATION" "CURLOPT_FTPASCII" "CURLOPT_PUT"
-;        "CURLOPT_MUTE" "CURLOPT_USERPWD" "CURLOPT_PROXYUSERPWD"
-;        "CURLOPT_RANGE" "CURLOPT_TIMEOUT" "CURLOPT_POSTFIELDS"
-;        "CURLOPT_REFERER" "CURLOPT_USERAGENT" "CURLOPT_FTPPORT"
-;        "CURLOPT_LOW_SPEED_LIMIT" "CURLOPT_LOW_SPEED_TIME"
-;        "CURLOPT_RESUME_FROM" "CURLOPT_COOKIE" "CURLOPT_SSLCERT"
-;        "CURLOPT_SSLCERTPASSWD" "CURLOPT_WRITEHEADER"
-;        "CURLOPT_COOKIEFILE" "CURLOPT_SSLVERSION"
-;        "CURLOPT_TIMECONDITION" "CURLOPT_TIMEVALUE"
-;        "CURLOPT_CUSTOMREQUEST" "CURLOPT_STDERR" "CURLOPT_TRANSFERTEXT"
-;        "CURLOPT_RETURNTRANSFER" "CURLOPT_QUOTE" "CURLOPT_POSTQUOTE"
-;        "CURLOPT_INTERFACE" "CURLOPT_KRB4LEVEL"
-;        "CURLOPT_HTTPPROXYTUNNEL" "CURLOPT_FILETIME"
-;        "CURLOPT_WRITEFUNCTION" "CURLOPT_READFUNCTION"
-;        "CURLOPT_PASSWDFUNCTION" "CURLOPT_HEADERFUNCTION"
-;        "CURLOPT_MAXREDIRS" "CURLOPT_MAXCONNECTS" "CURLOPT_CLOSEPOLICY"
-;        "CURLOPT_FRESH_CONNECT" "CURLOPT_FORBID_REUSE"
-;        "CURLOPT_RANDOM_FILE" "CURLOPT_EGDSOCKET"
-;        "CURLOPT_CONNECTTIMEOUT" "CURLOPT_SSL_VERIFYPEER"
-;        "CURLOPT_CAINFO" "CURLOPT_BINARYTRANSER"
-;        "CURLCLOSEPOLICY_LEAST_RECENTLY_USED" "CURLCLOSEPOLICY_OLDEST"
-;        "CURLINFO_EFFECTIVE_URL" "CURLINFO_HTTP_CODE"
-;        "CURLINFO_HEADER_SIZE" "CURLINFO_REQUEST_SIZE"
-;        "CURLINFO_TOTAL_TIME" "CURLINFO_NAMELOOKUP_TIME"
-;        "CURLINFO_CONNECT_TIME" "CURLINFO_PRETRANSFER_TIME"
-;        "CURLINFO_SIZE_UPLOAD" "CURLINFO_SIZE_DOWNLOAD"
-;        "CURLINFO_SPEED_DOWNLOAD" "CURLINFO_SPEED_UPLOAD"
-;        "CURLINFO_FILETIME" "CURLE_OK" "CURLE_UNSUPPORTED_PROTOCOL"
-;        "CURLE_FAILED_INIT" "CURLE_URL_MALFORMAT"
-;        "CURLE_URL_MALFORMAT_USER" "CURLE_COULDNT_RESOLVE_PROXY"
-;        "CURLE_COULDNT_RESOLVE_HOST" "CURLE_COULDNT_CONNECT"
-;        "CURLE_FTP_WEIRD_SERVER_REPLY" "CURLE_FTP_ACCESS_DENIED"
-;        "CURLE_FTP_USER_PASSWORD_INCORRECT"
-;        "CURLE_FTP_WEIRD_PASS_REPLY" "CURLE_FTP_WEIRD_USER_REPLY"
-;        "CURLE_FTP_WEIRD_PASV_REPLY" "CURLE_FTP_WEIRD_227_FORMAT"
-;        "CURLE_FTP_CANT_GET_HOST" "CURLE_FTP_CANT_RECONNECT"
-;        "CURLE_FTP_COULDNT_SET_BINARY" "CURLE_PARTIAL_FILE"
-;        "CURLE_FTP_COULDNT_RETR_FILE" "CURLE_FTP_WRITE_ERROR"
-;        "CURLE_FTP_QUOTE_ERROR" "CURLE_HTTP_NOT_FOUND"
-;        "CURLE_WRITE_ERROR" "CURLE_MALFORMAT_USER"
-;        "CURLE_FTP_COULDNT_STOR_FILE" "CURLE_READ_ERROR"
-;        "CURLE_OUT_OF_MEMORY" "CURLE_OPERATION_TIMEOUTED"
-;        "CURLE_FTP_COULDNT_SET_ASCII" "CURLE_FTP_PORT_FAILED"
-;        "CURLE_FTP_COULDNT_USE_REST" "CURLE_FTP_COULDNT_GET_SIZE"
-;        "CURLE_HTTP_RANGE_ERROR" "CURLE_HTTP_POST_ERROR"
-;        "CURLE_SSL_CONNECT_ERROR" "CURLE_FTP_BAD_DOWNLOAD_RESUME"
-;        "CURLE_FILE_COULDNT_READ_FILE" "CURLE_LDAP_CANNOT_BIND"
-;        "CURLE_LDAP_SEARCH_FAILED" "CURLE_LIBRARY_NOT_FOUND"
-;        "CURLE_FUNCTION_NOT_FOUND" "CURLE_ABORTED_BY_CALLBACK"
-;        "CURLE_BAD_FUNCTION_ARGUMENT" "CURLE_BAD_CALLING_ORDER"
-;        "CURLE_HTTP_PORT_FAILED" "CURLE_BAD_PASSWORD_ENTERED"
-;        "CURLE_TOO_MANY_REDIRECTS" "CURLE_UNKOWN_TELNET_OPTION"
-;        "CURLE_TELNET_OPTION_SYNTAX" "CURLE_ALREADY_COMPLETE"
-;        "DBX_MYSQL" "DBX_ODBC" "DBX_PGSQL" "DBX_MSSQL" "DBX_PERSISTENT"
-;        "DBX_RESULT_INFO" "DBX_RESULT_INDEX" "DBX_RESULT_ASSOC"
-;        "DBX_CMP_TEXT" "DBX_CMP_NUMBER" "XML_ELEMENT_NODE"
-;        "XML_ATTRIBUTE_NODE" "XML_TEXT_NODE" "XML_CDATA_SECTION_NODE"
-;        "XML_ENTITY_REF_NODE" "XML_ENTITY_NODE" "XML_PI_NODE"
-;        "XML_COMMENT_NODE" "XML_DOCUMENT_NODE" "XML_DOCUMENT_TYPE_NODE"
-;        "XML_DOCUMENT_FRAG_NODE" "XML_NOTATION_NODE"
-;        "XML_HTML_DOCUMENT_NODE" "XML_DTD_NODE" "XML_ELEMENT_DECL_NODE"
-;        "XML_ATTRIBUTE_DECL_NODE" "XML_ENTITY_DECL_NODE"
-;        "XML_NAMESPACE_DECL_NODE" "XML_GLOBAL_NAMESPACE"
-;        "XML_LOCAL_NAMESPACE" "XML_ATTRIBUTE_CDATA" "XML_ATTRIBUTE_ID"
-;        "XML_ATTRIBUTE_IDREF" "XML_ATTRIBUTE_IDREFS"
-;        "XML_ATTRIBUTE_ENTITY" "XML_ATTRIBUTE_NMTOKEN"
-;        "XML_ATTRIBUTE_NMTOKENS" "XML_ATTRIBUTE_ENUMERATION"
-;        "XML_ATTRIBUTE_NOTATION" "XPATH_UNDEFINED" "XPATH_NODESET"
-;        "XPATH_BOOLEAN" "XPATH_NUMBER" "XPATH_STRING" "XPATH_POINT"
-;        "XPATH_RANGE" "XPATH_LOCATIONSET" "XPATH_USERS" "FBSQL_ASSOC"
-;        "FBSQL_NUM" "FBSQL_BOTH" "FDFValue" "FDFStatus" "FDFFile"
-;        "FDFID" "FDFFf" "FDFSetFf" "FDFClearFf" "FDFFlags" "FDFSetF"
-;        "FDFClrF" "FDFAP" "FDFAS" "FDFAction" "FDFAA" "FDFAPRef"
-;        "FDFIF" "FDFEnter" "FDFExit" "FDFDown" "FDFUp" "FDFFormat"
-;        "FDFValidate" "FDFKeystroke" "FDFCalculate"
-;        "FRIBIDI_CHARSET_UTF8" "FRIBIDI_CHARSET_8859_6"
-;        "FRIBIDI_CHARSET_8859_8" "FRIBIDI_CHARSET_CP1255"
-;        "FRIBIDI_CHARSET_CP1256" "FRIBIDI_CHARSET_ISIRI_3342"
-;        "FTP_ASCII" "FTP_BINARY" "FTP_IMAGE" "FTP_TEXT" "IMG_GIF"
-;        "IMG_JPG" "IMG_JPEG" "IMG_PNG" "IMG_WBMP" "IMG_COLOR_TILED"
-;        "IMG_COLOR_STYLED" "IMG_COLOR_BRUSHED"
-;        "IMG_COLOR_STYLEDBRUSHED" "IMG_COLOR_TRANSPARENT"
-;        "IMG_ARC_ROUNDED" "IMG_ARC_PIE" "IMG_ARC_CHORD"
-;        "IMG_ARC_NOFILL" "IMG_ARC_EDGED" "GMP_ROUND_ZERO"
-;        "GMP_ROUND_PLUSINF" "GMP_ROUND_MINUSINF" "HW_ATTR_LANG"
-;        "HW_ATTR_NR" "HW_ATTR_NONE" "IIS_READ" "IIS_WRITE"
-;        "IIS_EXECUTE" "IIS_SCRIPT" "IIS_ANONYMOUS" "IIS_BASIC"
-;        "IIS_NTLM" "NIL" "OP_DEBUG" "OP_READONLY" "OP_ANONYMOUS"
-;        "OP_SHORTCACHE" "OP_SILENT" "OP_PROTOTYPE" "OP_HALFOPEN"
-;        "OP_EXPUNGE" "OP_SECURE" "CL_EXPUNGE" "FT_UID" "FT_PEEK"
-;        "FT_NOT" "FT_INTERNAL" "FT_PREFETCHTEXT" "ST_UID" "ST_SILENT"
-;        "ST_SET" "CP_UID" "CP_MOVE" "SE_UID" "SE_FREE" "SE_NOPREFETCH"
-;        "SO_FREE" "SO_NOSERVER" "SA_MESSAGES" "SA_RECENT" "SA_UNSEEN"
-;        "SA_UIDNEXT" "SA_UIDVALIDITY" "SA_ALL" "LATT_NOINFERIORS"
-;        "LATT_NOSELECT" "LATT_MARKED" "LATT_UNMARKED" "SORTDATE"
-;        "SORTARRIVAL" "SORTFROM" "SORTSUBJECT" "SORTTO" "SORTCC"
-;        "SORTSIZE" "TYPETEXT" "TYPEMULTIPART" "TYPEMESSAGE"
-;        "TYPEAPPLICATION" "TYPEAUDIO" "TYPEIMAGE" "TYPEVIDEO"
-;        "TYPEOTHER" "ENC7BIT" "ENC8BIT" "ENCBINARY" "ENCBASE64"
-;        "ENCQUOTEDPRINTABLE" "ENCOTHER" "INGRES_ASSOC" "INGRES_NUM"
-;        "INGRES_BOTH" "IBASE_DEFAULT" "IBASE_TEXT" "IBASE_UNIXTIME"
-;        "IBASE_READ" "IBASE_COMMITTED" "IBASE_CONSISTENCY"
-;        "IBASE_NOWAIT" "IBASE_TIMESTAMP" "IBASE_DATE" "IBASE_TIME"
-;        "LDAP_DEREF_NEVER" "LDAP_DEREF_SEARCHING" "LDAP_DEREF_FINDING"
-;        "LDAP_DEREF_ALWAYS" "LDAP_OPT_DEREF" "LDAP_OPT_SIZELIMIT"
-;        "LDAP_OPT_TIMELIMIT" "LDAP_OPT_PROTOCOL_VERSION"
-;        "LDAP_OPT_ERROR_NUMBER" "LDAP_OPT_REFERRALS" "LDAP_OPT_RESTART"
-;        "LDAP_OPT_HOST_NAME" "LDAP_OPT_ERROR_STRING"
-;        "LDAP_OPT_MATCHED_DN" "LDAP_OPT_SERVER_CONTROLS"
-;        "LDAP_OPT_CLIENT_CONTROLS" "GSLC_SSL_NO_AUTH"
-;        "GSLC_SSL_ONEWAY_AUTH" "GSLC_SSL_TWOWAY_AUTH" "MCAL_SUNDAY"
-;        "MCAL_MONDAY" "MCAL_TUESDAY" "MCAL_WEDNESDAY" "MCAL_THURSDAY"
-;        "MCAL_FRIDAY" "MCAL_SATURDAY" "MCAL_JANUARY" "MCAL_FEBRUARY"
-;        "MCAL_MARCH" "MCAL_APRIL" "MCAL_MAY" "MCAL_JUNE" "MCAL_JULY"
-;        "MCAL_AUGUST" "MCAL_SEPTEMBER" "MCAL_OCTOBER" "MCAL_NOVEMBER"
-;        "MCAL_RECUR_NONE" "MCAL_RECUR_DAILY" "MCAL_RECUR_WEEKLY"
-;        "MCAL_RECUR_MONTHLY_MDAY" "MCAL_RECUR_MONTHLY_WDAY"
-;        "MCAL_RECUR_YEARLY" "MCAL_M_SUNDAY" "MCAL_M_MONDAY"
-;        "MCAL_M_TUESDAY" "MCAL_M_WEDNESDAY" "MCAL_M_THURSDAY"
-;        "MCAL_M_FRIDAY" "MCAL_M_SATURDAY" "MCAL_M_WEEKDAYS"
-;        "MCAL_M_WEEKEND" "MCAL_M_ALLDAYS" "MCRYPT_" "MCRYPT_"
-;        "MCRYPT_ENCRYPT" "MCRYPT_DECRYPT" "MCRYPT_DEV_RANDOM"
-;        "MCRYPT_DEV_URANDOM" "MCRYPT_RAND" "SWFBUTTON_HIT"
-;        "SWFBUTTON_DOWN" "SWFBUTTON_OVER" "SWFBUTTON_UP"
-;        "SWFBUTTON_MOUSEUPOUTSIDE" "SWFBUTTON_DRAGOVER"
-;        "SWFBUTTON_DRAGOUT" "SWFBUTTON_MOUSEUP" "SWFBUTTON_MOUSEDOWN"
-;        "SWFBUTTON_MOUSEOUT" "SWFBUTTON_MOUSEOVER"
-;        "SWFFILL_RADIAL_GRADIENT" "SWFFILL_LINEAR_GRADIENT"
-;        "SWFFILL_TILED_BITMAP" "SWFFILL_CLIPPED_BITMAP"
-;        "SWFTEXTFIELD_HASLENGTH" "SWFTEXTFIELD_NOEDIT"
-;        "SWFTEXTFIELD_PASSWORD" "SWFTEXTFIELD_MULTILINE"
-;        "SWFTEXTFIELD_WORDWRAP" "SWFTEXTFIELD_DRAWBOX"
-;        "SWFTEXTFIELD_NOSELECT" "SWFTEXTFIELD_HTML"
-;        "SWFTEXTFIELD_ALIGN_LEFT" "SWFTEXTFIELD_ALIGN_RIGHT"
-;        "SWFTEXTFIELD_ALIGN_CENTER" "SWFTEXTFIELD_ALIGN_JUSTIFY"
-;        "UDM_FIELD_URLID" "UDM_FIELD_URL" "UDM_FIELD_CONTENT"
-;        "UDM_FIELD_TITLE" "UDM_FIELD_KEYWORDS" "UDM_FIELD_DESC"
-;        "UDM_FIELD_DESCRIPTION" "UDM_FIELD_TEXT" "UDM_FIELD_SIZE"
-;        "UDM_FIELD_RATING" "UDM_FIELD_SCORE" "UDM_FIELD_MODIFIED"
-;        "UDM_FIELD_ORDER" "UDM_FIELD_CRC" "UDM_FIELD_CATEGORY"
-;        "UDM_PARAM_PAGE_SIZE" "UDM_PARAM_PAGE_NUM"
-;        "UDM_PARAM_SEARCH_MODE" "UDM_PARAM_CACHE_MODE"
-;        "UDM_PARAM_TRACK_MODE" "UDM_PARAM_PHRASE_MODE"
-;        "UDM_PARAM_CHARSET" "UDM_PARAM_STOPTABLE"
-;        "UDM_PARAM_STOP_TABLE" "UDM_PARAM_STOPFILE"
-;        "UDM_PARAM_STOP_FILE" "UDM_PARAM_WEIGHT_FACTOR"
-;        "UDM_PARAM_WORD_MATCH" "UDM_PARAM_MAX_WORD_LEN"
-;        "UDM_PARAM_MAX_WORDLEN" "UDM_PARAM_MIN_WORD_LEN"
-;        "UDM_PARAM_MIN_WORDLEN" "UDM_PARAM_ISPELL_PREFIXES"
-;        "UDM_PARAM_ISPELL_PREFIX" "UDM_PARAM_PREFIXES"
-;        "UDM_PARAM_PREFIX" "UDM_PARAM_CROSS_WORDS"
-;        "UDM_PARAM_CROSSWORDS" "UDM_LIMIT_CAT" "UDM_LIMIT_URL"
-;        "UDM_LIMIT_TAG" "UDM_LIMIT_LANG" "UDM_LIMIT_DATE"
-;        "UDM_PARAM_FOUND" "UDM_PARAM_NUM_ROWS" "UDM_PARAM_WORDINFO"
-;        "UDM_PARAM_WORD_INFO" "UDM_PARAM_SEARCHTIME"
-;        "UDM_PARAM_SEARCH_TIME" "UDM_PARAM_FIRST_DOC"
-;        "UDM_PARAM_LAST_DOC" "UDM_MODE_ALL" "UDM_MODE_ANY"
-;        "UDM_MODE_BOOL" "UDM_MODE_PHRASE" "UDM_CACHE_ENABLED"
-;        "UDM_CACHE_DISABLED" "UDM_TRACK_ENABLED" "UDM_TRACK_DISABLED"
-;        "UDM_PHRASE_ENABLED" "UDM_PHRASE_DISABLED"
-;        "UDM_CROSS_WORDS_ENABLED" "UDM_CROSSWORDS_ENABLED"
-;        "UDM_CROSS_WORDS_DISABLED" "UDM_CROSSWORDS_DISABLED"
-;        "UDM_PREFIXES_ENABLED" "UDM_PREFIX_ENABLED"
-;        "UDM_ISPELL_PREFIXES_ENABLED" "UDM_ISPELL_PREFIX_ENABLED"
-;        "UDM_PREFIXES_DISABLED" "UDM_PREFIX_DISABLED"
-;        "UDM_ISPELL_PREFIXES_DISABLED" "UDM_ISPELL_PREFIX_DISABLED"
-;        "UDM_ISPELL_TYPE_AFFIX" "UDM_ISPELL_TYPE_SPELL"
-;        "UDM_ISPELL_TYPE_DB" "UDM_ISPELL_TYPE_SERVER" "UDM_MATCH_WORD"
-;        "UDM_MATCH_BEGIN" "UDM_MATCH_SUBSTR" "UDM_MATCH_END"
-;        "MSQL_ASSOC" "MSQL_NUM" "MSQL_BOTH" "MYSQL_ASSOC" "MYSQL_NUM"
-;        "MYSQL_BOTH" "MYSQL_USE_RESULT" "MYSQL_STORE_RESULT"
-;        "OCI_DEFAULT" "OCI_DESCRIBE_ONLY" "OCI_COMMIT_ON_SUCCESS"
-;        "OCI_EXACT_FETCH" "SQLT_BFILEE" "SQLT_CFILEE" "SQLT_CLOB"
-;        "SQLT_BLOB" "SQLT_RDD" "OCI_B_SQLT_NTY" "OCI_SYSDATE"
-;        "OCI_B_BFILE" "OCI_B_CFILEE" "OCI_B_CLOB" "OCI_B_BLOB"
-;        "OCI_B_ROWID" "OCI_B_CURSOR" "OCI_B_BIN" "OCI_ASSOC" "OCI_NUM"
-;        "OCI_BOTH" "OCI_RETURN_NULLS" "OCI_RETURN_LOBS"
-;        "OCI_DTYPE_FILE" "OCI_DTYPE_LOB" "OCI_DTYPE_ROWID" "OCI_D_FILE"
-;        "OCI_D_LOB" "OCI_D_ROWID" "ODBC_TYPE" "ODBC_BINMODE_PASSTHRU"
-;        "ODBC_BINMODE_RETURN" "ODBC_BINMODE_CONVERT" "SQL_ODBC_CURSORS"
-;        "SQL_CUR_USE_DRIVER" "SQL_CUR_USE_IF_NEEDED" "SQL_CUR_USE_ODBC"
-;        "SQL_CONCURRENCY" "SQL_CONCUR_READ_ONLY" "SQL_CONCUR_LOCK"
-;        "SQL_CONCUR_ROWVER" "SQL_CONCUR_VALUES" "SQL_CURSOR_TYPE"
-;        "SQL_CURSOR_FORWARD_ONLY" "SQL_CURSOR_KEYSET_DRIVEN"
-;        "SQL_CURSOR_DYNAMIC" "SQL_CURSOR_STATIC" "SQL_KEYSET_SIZE"
-;        "SQL_CHAR" "SQL_VARCHAR" "SQL_LONGVARCHAR" "SQL_DECIMAL"
-;        "SQL_NUMERIC" "SQL_BIT" "SQL_TINYINT" "SQL_SMALLINT"
-;        "SQL_INTEGER" "SQL_BIGINT" "SQL_REAL" "SQL_FLOAT" "SQL_DOUBLE"
-;        "SQL_BINARY" "SQL_VARBINARY" "SQL_LONGVARBINARY" "SQL_DATE"
-;        "SQL_TIME" "SQL_TIMESTAMP" "SQL_TYPE_DATE" "SQL_TYPE_TIME"
-;        "SQL_TYPE_TIMESTAMP" "SQL_BEST_ROWID" "SQL_ROWVER"
-;        "SQL_SCOPE_CURROW" "SQL_SCOPE_TRANSACTION" "SQL_SCOPE_SESSION"
-;        "SQL_NO_NULLS" "SQL_NULLABLE" "SQL_INDEX_UNIQUE"
-;        "SQL_INDEX_ALL" "SQL_ENSURE" "SQL_QUICK"
-;        "X509_PURPOSE_SSL_CLIENT" "X509_PURPOSE_SSL_SERVER"
-;        "X509_PURPOSE_NS_SSL_SERVER" "X509_PURPOSE_SMIME_SIGN"
-;        "X509_PURPOSE_SMIME_ENCRYPT" "X509_PURPOSE_CRL_SIGN"
-;        "X509_PURPOSE_ANY" "PKCS7_DETACHED" "PKCS7_TEXT"
-;        "PKCS7_NOINTERN" "PKCS7_NOVERIFY" "PKCS7_NOCHAIN"
-;        "PKCS7_NOCERTS" "PKCS7_NOATTR" "PKCS7_BINARY" "PKCS7_NOSIGS"
-;        "OPENSSL_PKCS1_PADDING" "OPENSSL_SSLV23_PADDING"
-;        "OPENSSL_NO_PADDING" "OPENSSL_PKCS1_OAEP_PADDING"
-;        "ORA_BIND_INOUT" "ORA_BIND_IN" "ORA_BIND_OUT"
-;        "ORA_FETCHINTO_ASSOC" "ORA_FETCHINTO_NULLS"
-;        "PREG_PATTERN_ORDER" "PREG_SET_ORDER" "PREG_SPLIT_NO_EMPTY"
-;        "PREG_SPLIT_DELIM_CAPTURE" "PGSQL_ASSOC" "PGSQL_NUM"
-;        "PGSQL_BOTH" "PRINTER_COPIES" "PRINTER_MODE" "PRINTER_TITLE"
-;        "PRINTER_DEVICENAME" "PRINTER_DRIVERVERSION"
-;        "PRINTER_RESOLUTION_Y" "PRINTER_RESOLUTION_X" "PRINTER_SCALE"
-;        "PRINTER_BACKGROUND_COLOR" "PRINTER_PAPER_LENGTH"
-;        "PRINTER_PAPER_WIDTH" "PRINTER_PAPER_FORMAT"
-;        "PRINTER_FORMAT_CUSTOM" "PRINTER_FORMAT_LETTER"
-;        "PRINTER_FORMAT_LEGAL" "PRINTER_FORMAT_A3" "PRINTER_FORMAT_A4"
-;        "PRINTER_FORMAT_A5" "PRINTER_FORMAT_B4" "PRINTER_FORMAT_B5"
-;        "PRINTER_FORMAT_FOLIO" "PRINTER_ORIENTATION"
-;        "PRINTER_ORIENTATION_PORTRAIT" "PRINTER_ORIENTATION_LANDSCAPE"
-;        "PRINTER_TEXT_COLOR" "PRINTER_TEXT_ALIGN" "PRINTER_TA_BASELINE"
-;        "PRINTER_TA_BOTTOM" "PRINTER_TA_TOP" "PRINTER_TA_CENTER"
-;        "PRINTER_TA_LEFT" "PRINTER_TA_RIGHT" "PRINTER_PEN_SOLID"
-;        "PRINTER_PEN_DASH" "PRINTER_PEN_DOT" "PRINTER_PEN_DASHDOT"
-;        "PRINTER_PEN_DASHDOTDOT" "PRINTER_PEN_INVISIBLE"
-;        "PRINTER_BRUSH_SOLID" "PRINTER_BRUSH_CUSTOM"
-;        "PRINTER_BRUSH_DIAGONAL" "PRINTER_BRUSH_CROSS"
-;        "PRINTER_BRUSH_DIAGCROSS" "PRINTER_BRUSH_FDIAGONAL"
-;        "PRINTER_BRUSH_HORIZONTAL" "PRINTER_BRUSH_VERTICAL"
-;        "PRINTER_FW_THIN" "PRINTER_FW_ULTRALIGHT" "PRINTER_FW_LIGHT"
-;        "PRINTER_FW_NORMAL" "PRINTER_FW_MEDIUM" "PRINTER_FW_BOLD"
-;        "PRINTER_FW_ULTRABOLD" "PRINTER_FW_HEAVY" "PRINTER_ENUM_LOCAL"
-;        "PRINTER_ENUM_NAME" "PRINTER_ENUM_SHARED"
-;        "PRINTER_ENUM_DEFAULT" "PRINTER_ENUM_CONNECTIONS"
-;        "PRINTER_ENUM_NETWORK" "PRINTER_ENUM_REMOTE" "PSPELL_FAST"
-;        "PSPELL_NORMAL" "PSPELL_BAD_SPELLERS" "PSPELL_RUN_TOGETHER"
-;        "SID" "SID" "AF_UNIX" "AF_INET" "SOCK_STREAM" "SOCK_DGRAM"
-;        "SOCK_RAW" "SOCK_SEQPACKET" "SOCK_RDM" "MSG_OOB" "MSG_WAITALL"
-;        "MSG_PEEK" "MSG_DONTROUTE" "SO_DEBUG" "SO_REUSEADDR"
-;        "SO_KEEPALIVE" "SO_DONTROUTE" "SO_LINGER" "SO_BROADCAST"
-;        "SO_OOBINLINE" "SO_SNDBUF" "SO_RCVBUF" "SO_SNDLOWAT"
-;        "SO_RCVLOWAT" "SO_SNDTIMEO" "SO_RCVTIMEO" "SO_TYPE" "SO_ERROR"
-;        "SOL_SOCKET" "PHP_NORMAL_READ" "PHP_BINARY_READ"
-;        "PHP_SYSTEM_READ" "SOL_TCP" "SOL_UDP" "MOD_COLOR" "MOD_MATRIX"
-;        "TYPE_PUSHBUTTON" "TYPE_MENUBUTTON" "BSHitTest" "BSDown"
-;        "BSOver" "BSUp" "OverDowntoIdle" "IdletoOverDown"
-;        "OutDowntoIdle" "OutDowntoOverDown" "OverDowntoOutDown"
-;        "OverUptoOverDown" "OverUptoIdle" "IdletoOverUp" "ButtonEnter"
-;        "ButtonExit" "MenuEnter" "MenuExit" "XML_ERROR_NONE"
-;        "XML_ERROR_NO_MEMORY" "XML_ERROR_SYNTAX"
-;        "XML_ERROR_NO_ELEMENTS" "XML_ERROR_INVALID_TOKEN"
-;        "XML_ERROR_UNCLOSED_TOKEN" "XML_ERROR_PARTIAL_CHAR"
-;        "XML_ERROR_TAG_MISMATCH" "XML_ERROR_DUPLICATE_ATTRIBUTE"
-;        "XML_ERROR_JUNK_AFTER_DOC_ELEMENT" "XML_ERROR_PARAM_ENTITY_REF"
-;        "XML_ERROR_UNDEFINED_ENTITY" "XML_ERROR_RECURSIVE_ENTITY_REF"
-;        "XML_ERROR_ASYNC_ENTITY" "XML_ERROR_BAD_CHAR_REF"
-;        "XML_ERROR_BINARY_ENTITY_REF"
-;        "XML_ERROR_ATTRIBUTE_EXTERNAL_ENTITY_REF"
-;        "XML_ERROR_MISPLACED_XML_PI" "XML_ERROR_UNKNOWN_ENCODING"
-;        "XML_ERROR_INCORRECT_ENCODING"
-;        "XML_ERROR_UNCLOSED_CDATA_SECTION"
-;        "XML_ERROR_EXTERNAL_ENTITY_HANDLING" "XML_OPTION_CASE_FOLDING"
-;        "XML_OPTION_TARGET_ENCODING" "XML_OPTION_SKIP_TAGSTART"
-;        "XML_OPTION_SKIP_WHITE" "YPERR_BADARGS" "YPERR_BADDB"
-;        "YPERR_BUSY" "YPERR_DOMAIN" "YPERR_KEY" "YPERR_MAP"
-;        "YPERR_NODOM" "YPERR_NOMORE" "YPERR_PMAP" "YPERR_RESRC"
-;        "YPERR_RPC" "YPERR_YPBIND" "YPERR_YPERR" "YPERR_YPSERV"
-;        "YPERR_VERS" "FORCE_GZIP" "FORCE_DEFLATE"
-
-       ;; PEAR constants
-;        "PEAR_ERROR_RETURN" "PEAR_ERROR_PRINT" "PEAR_ERROR_TRIGGER"
-;        "PEAR_ERROR_DIE" "PEAR_ERROR_CALLBACK" "OS_WINDOWS" "OS_UNIX"
-;        "PEAR_OS" "DB_OK" "DB_ERROR" "DB_ERROR_SYNTAX"
-;        "DB_ERROR_CONSTRAINT" "DB_ERROR_NOT_FOUND"
-;        "DB_ERROR_ALREADY_EXISTS" "DB_ERROR_UNSUPPORTED"
-;        "DB_ERROR_MISMATCH" "DB_ERROR_INVALID" "DB_ERROR_NOT_CAPABLE"
-;        "DB_ERROR_TRUNCATED" "DB_ERROR_INVALID_NUMBER"
-;        "DB_ERROR_INVALID_DATE" "DB_ERROR_DIVZERO"
-;        "DB_ERROR_NODBSELECTED" "DB_ERROR_CANNOT_CREATE"
-;        "DB_ERROR_CANNOT_DELETE" "DB_ERROR_CANNOT_DROP"
-;        "DB_ERROR_NOSUCHTABLE" "DB_ERROR_NOSUCHFIELD"
-;        "DB_ERROR_NEED_MORE_DATA" "DB_ERROR_NOT_LOCKED"
-;        "DB_ERROR_VALUE_COUNT_ON_ROW" "DB_ERROR_INVALID_DSN"
-;        "DB_ERROR_CONNECT_FAILED" "DB_WARNING" "DB_WARNING_READ_ONLY"
-;        "DB_PARAM_SCALAR" "DB_PARAM_OPAQUE" "DB_BINMODE_PASSTHRU"
-;        "DB_BINMODE_RETURN" "DB_BINMODE_CONVERT" "DB_FETCHMODE_DEFAULT"
-;        "DB_FETCHMODE_ORDERED" "DB_FETCHMODE_ASSOC"
-;        "DB_FETCHMODE_FLIPPED" "DB_GETMODE_ORDERED" "DB_GETMODE_ASSOC"
-;        "DB_GETMODE_FLIPPED" "DB_TABLEINFO_ORDER"
-;        "DB_TABLEINFO_ORDERTABLE" "DB_TABLEINFO_FULL"
-       
-       )))
-  "PHP constants.")
-
-(defconst php-keywords
-  (eval-when-compile
-    (regexp-opt
-     ;; "class", "new" and "extends" get special treatment
-     ;; "case" and  "default" get special treatment elsewhere
-     '("and" "as" "break" "continue" "declare" "do" "echo" "else" "elseif"
-       "endfor" "endforeach" "endif" "endswitch" "endwhile" "exit"
-       "extends" "for" "foreach" "global" "if" "include" "include_once"
-       "next" "or" "require" "require_once" "return" "static" "switch"
-       "then" "var" "while" "xor" "private" "throw" "catch" "try" 
-       "instanceof" "catch all" "finally")))
-  "PHP keywords.")
-
-(defconst php-identifier
-  (eval-when-compile
-    '"[a-zA-Z\_\x7f-\xff][a-zA-Z0-9\_\x7f-\xff]*")
-  "Characters in a PHP identifier.")
-
-(defconst php-types
-  (eval-when-compile
-    (regexp-opt '("array" "bool" "boolean" "char" "const" "double" "float"
-		  "int" "integer" "long" "mixed" "object" "real" 
-		  "string")))
-  "PHP types.")
-
-(defconst php-superglobals
-  (eval-when-compile
-    (regexp-opt '("_GET" "_POST" "_COOKIE" "_SESSION" "_ENV" "GLOBALS"
-		  "_SERVER" "_FILES" "_REQUEST")))
-  "PHP superglobal variables.")
-
-;; Set up font locking
-(defconst php-font-lock-keywords-1
-  (list
-   ;; Fontify constants
-   (cons
-    (concat "\\<\\(" php-constants "\\)\\>")
-    'font-lock-constant-face)
-   
-   ;; Fontify keywords
-   (cons
-    (concat "\\<\\(" php-keywords "\\)\\>")
-    'font-lock-keyword-face)
-   
-   ;; Fontify keywords and targets, and case default tags.
-   (list "\\<\\(break\\|case\\|continue\\)\\>[ \t]*\\(-?\\(?:\\sw\\|\\s_\\)+\\)?"
-	 '(1 font-lock-keyword-face) '(2 font-lock-constant-face t t))
-   ;; This must come after the one for keywords and targets.
-   '(":" ("^[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)[ \t]*:[ \t]*$"
-	  (beginning-of-line) (end-of-line)
-	  (1 font-lock-constant-face)))
-   
-   ;; treat 'print' as keyword only when not used like a function name
-   '("\\" . font-lock-keyword-face)
-   
-   ;; Fontify PHP tag
-   '("<\\?\\(php\\)?" . font-lock-constant-face)
-   '("\\?>" . font-lock-constant-face)
-   
-   ;; Fontify ASP-style tag
-   '("<\\%\\(=\\)?" . font-lock-constant-face)
-   '("\\%>" . font-lock-constant-face)
-
-   )
-  "Subdued level highlighting for PHP mode.")
-
-(defconst php-font-lock-keywords-2
-  (append
-   php-font-lock-keywords-1
-   (list
-    
-    ;; class declaration
-    '("\\<\\(class\\|interface\\)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?"
-      (1 font-lock-keyword-face) (2 font-lock-type-face nil t))
-    ;; handle several words specially, to include following word,
-    ;; thereby excluding it from unknown-symbol checks later
-    ;; FIX to handle implementing multiple
-    ;; currently breaks on "class Foo implements Bar, Baz"
-    '("\\<\\(new\\|extends\\|implements\\)\\s-+\\$?\\(\\(?:\\sw\\|\\s_\\)+\\)"
-      (1 font-lock-keyword-face) (2 font-lock-type-face))
-
-    ;; function declaration
-    '("\\<\\(function\\)\\s-+&?\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*("
-      (1 font-lock-keyword-face)
-      (2 font-lock-function-name-face nil t))
-    
-    ;; class hierarchy
-    '("\\(self\\|parent\\)\\W" (1 font-lock-constant-face nil nil))
-
-    ;; method and variable features
-    '("\\<\\(private\\|protected\\|public\\)\\s-+\\$?\\(?:\\sw\\|\\s_\\)+"
-      (1 font-lock-keyword-face))
-
-    ;; method features
-    '("^[ \t]*\\(abstract\\|static\\|final\\)\\s-+\\$?\\(?:\\sw\\|\\s_\\)+"
-      (1 font-lock-keyword-face))
-
-    ;; variable features
-    '("^[ \t]*\\(static\\|const\\)\\s-+\\$?\\(?:\\sw\\|\\s_\\)+"
-      (1 font-lock-keyword-face))
-    ))
-  "Medium level highlighting for PHP mode.")
-
-(defconst php-font-lock-keywords-3
-  (append
-   php-font-lock-keywords-2
-   (list
-    
-    ;;  or  for HTML
-    '("]*>" . font-lock-constant-face)
-
-    ;; HTML entities
-    '("&\\w+;" . font-lock-variable-name-face)
-
-    ;; warn about '$' immediately after ->
-    '("\\$\\(?:\\sw\\|\\s_\\)+->\\s-*\\(\\$\\)\\(\\(?:\\sw\\|\\s_\\)+\\)"
-      (1 font-lock-warning-face) (2 default))
-    
-    ;; warn about $word.word -- it could be a valid concatenation,
-    ;; but without any spaces we'll assume $word->word was meant.
-    '("\\$\\(?:\\sw\\|\\s_\\)+\\(\\.\\)\\sw"
-      1 font-lock-warning-face)
-    
-    ;; Warn about ==> instead of =>
-    '("==+>" . font-lock-warning-face)
-    
-    ;; exclude casts from bare-word treatment (may contain spaces)
-    `(,(concat "(\\s-*\\(" php-types "\\)\\s-*)")
-      1 font-lock-type-face)
-    
-    ;; PHP5: function declarations may contain classes as parameters type
-    `(,(concat "[(,]\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-+\\$\\(?:\\sw\\|\\s_\\)+\\>")
-      1 font-lock-type-face)
-    
-    ;; Fontify variables and function calls
-    '("\\$\\(this\\|that\\)\\W" (1 font-lock-constant-face nil nil))
-    `(,(concat "\\$\\(" php-superglobals "\\)\\W")
-      (1 font-lock-constant-face nil nil)) ; $_GET & co
-    '("\\$\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face)) ; $variable
-    '("->\\(\\(?:\\sw\\|\\s_\\)+\\)" (1 font-lock-variable-name-face t t)) ; ->variable
-    '("->\\(\\(?:\\sw\\|\\s_\\)+\\)\\s-*(" . (1 default t t)) ; ->function_call
-    '("\\(?:\\sw\\|\\s_\\)+::\\(?:\\sw\\|\\s_\\)+\\s-*(" . default) ; class::method call
-    '("\\<\\(?:\\sw\\|\\s_\\)+\\s-*[[(]" . default)	; word( or word[
-    '("\\<[0-9]+" . default)		; number (also matches word)
-
-    ;; Warn on any words not already fontified
-    '("\\<\\(?:\\sw\\|\\s_\\)+\\>" . font-lock-warning-face)
-    ))
-  "Gauchy level highlighting for PHP mode.")
-
-(defconst php-font-lock-syntactic-keywords
-  (if xemacsp nil
-    ;; Mark shell-style comments.  font-lock handles this in a
-    ;; separate pass from normal syntactic scanning (somehow), so we
-    ;; get a chance to mark these in addition to C and C++ style
-    ;; comments.  This only works in GNU Emacs, not XEmacs 21 which
-    ;; seems to ignore this same code if we try to use it.
-    (list
-     ;; Mark _all_ # chars as being comment-start.  That will be
-     ;; ignored when inside a quoted string.
-     '("\\(\#\\)"
-       (1 (11 . nil)))
-     ;; Mark all newlines ending a line with # as being comment-end.
-     ;; This causes a problem, premature end-of-comment, when '#'
-     ;; appears inside a multiline C-style comment.  Oh well.
-     '("#.*\\([\n]\\)"
-       (1 (12 . nil)))
-     )))
-
-;; Define the imenu-generic-expression for PHP mode.
-;; To use, execute M-x imenu, then click on Functions or Classes,
-;; then select given function/class name to go to its definition.
-;; [Contributed by Gerrit Riessen]
-(defvar php-imenu-generic-expression
- '(
-   ("Functions"
-    "^\\s-*function\\s-+\\([a-zA-Z0-9_]+\\)\\s-*(" 1)
-   ("Classes"
-    "^\\s-*class\\s-+\\([a-zA-Z0-9_]+\\)\\s-*" 1)
-   )
- "Imenu generic expression for PHP Mode. See `imenu-generic-expression'."
- )
-
-;; Add "foreach" to conditional introducing keywords
-(defconst php-conditional-key nil)
-(let ((all-kws "for\\|if\\|do\\|else\\|while\\|switch\\|foreach\\|elseif\\|try\\|finally\\|try\\|catch all")
-      (front   "\\<\\(")
-      (back    "\\)\\>[^_]"))
-  (setq php-conditional-key (concat front all-kws back)))
-
-(defconst php-class-kwds "class\\|interface")
-
-(defconst php-class-key
-  (concat
-   "\\(" php-class-kwds "\\)\\s +"
-   c-symbol-key				      ;name of the class
-   "\\(\\s *extends\\s *" c-symbol-key "\\)?" ;maybe followed by superclass
-   "\\(\\s *implements *[^{]+{\\)?"	      ;maybe the adopted protocols list
-   ))
-
-;; Create "default" symbol for GNU Emacs so that both XEmacs and GNU
-;; emacs can refer to the default face by a variable named "default".
-(unless (boundp 'default)
-  (defvar default 'default))
-
-;; Create faces for XEmacs
-(unless (boundp 'font-lock-keyword-face)
-  (copy-face 'bold 'font-lock-keyword-face))
-(unless (boundp 'font-lock-constant-face)
-  (copy-face 'font-lock-keyword-face 'font-lock-constant-face))
-
-(provide 'php-mode)
-
-;;; php-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/postscript.el b/xemacs-packages/lisp/prog-modes/postscript.el
deleted file mode 100644
index da5e35fd..00000000
--- a/xemacs-packages/lisp/prog-modes/postscript.el
+++ /dev/null
@@ -1,357 +0,0 @@
-;;; postscript.el --- major mode for editing PostScript programs
-
-;; Keywords: langauges
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;
-;; Author:	Chris Maio
-;; Last edit:	4 Sep 1988
-;; Includes patches from relph@presto.ig.com (John M. Relph) posted to
-;; gnu.emacs.sources on 22 Nov 90 04:53:43 GMT.
-;;
-;; The following two statements, placed in your .emacs file or site-init.el,
-;; will cause this file to be autoloaded, and postscript-mode invoked, when
-;; visiting .ps or .cps files:
-;;
-;;	(autoload 'postscript-mode "postscript.el" "" t)
-;;	(setq auto-mode-alist
-;;	      (cons '("\\.c?ps$".postscript-mode) auto-mode-alist))
-;;
-
-(provide 'postscript)
-
-(defconst ps-indent-level 2
-  "*Indentation to be used inside of PostScript blocks or arrays")
-
-(defconst ps-tab-width 8
-  "*Tab stop width for PostScript mode")
-
-(defun ps-make-tabs (stop)
-  (and (< stop 132) (cons stop (ps-make-tabs (+ stop ps-tab-width)))))
-
-(defconst ps-tab-stop-list (ps-make-tabs ps-tab-width)
-  "*Tab stop list for PostScript mode")
-
-(defconst ps-postscript-command '("gs" "-")
-  "*Command used to invoke with a printer spooler or NeWS server.")
-
-(defvar ps-mode-map nil
-  "Keymap used in PostScript mode buffers")
-
-(defvar ps-mode-syntax-table nil
-  "PostScript mode syntax table")
-
-(defvar ps-balanced-string-syntax-p
-  (let ((b (current-buffer))
-        (loser (generate-new-buffer "x")))
-    (unwind-protect
-         (progn
-           (set-buffer loser)
-           (set-syntax-table (copy-syntax-table))
-           (modify-syntax-entry ?\(  "\"\)")
-           (insert "((")
-           (let ((v (parse-partial-sexp (point-min) (point-max))))
-             (if (elt v 3)
-                 ;; New syntax code think's we're still inside a string
-                 t
-                 nil)))
-      (set-buffer b)
-      (kill-buffer loser))))
-
-(defconst postscript-font-lock-keywords (purecopy
-   (list
-    ;; Proper rule for Postscript strings
-    '("(\\([^)]*\\))" . font-lock-string-face)
-    ;; Make any line beginning with a / be a ``keyword''
-    '("^/[^\n%]*" . font-lock-keyword-face)
-    ;; Make brackets of all forms be keywords
-    '("[][<>{}]+" . font-lock-keyword-face)
-    ;; Keywords
-    (list (concat 
-	   "[][ \t\f\n\r()<>{}/%]"	;delimiter
-	   "\\("
-	   (mapconcat 'identity
-		      '("begin" "end" 
-			"save" "restore" "gsave" "grestore"
-			;; Any delimited name ending in 'def'
-			"[a-zA-Z0-9-._]*def"
-			"[Dd]efine[a-zA-Z0-9-._]*")
-		      "\\|")
-	   "\\)"
-	   "\\([][ \t\f\n\r()<>{}/%]\\|$\\)" ;delimiter
-	   )
-	  1 'font-lock-keyword-face)))
-   "Expressions to highlight in Postscript buffers.")
-(put 'postscript-mode 'font-lock-defaults '(postscript-font-lock-keywords))
-
-(if ps-mode-syntax-table
-    nil
-  (let ((i 0))
-    (setq ps-mode-syntax-table (copy-syntax-table nil))
-    (while (< i 256)
-      (or (= (char-syntax i ps-mode-syntax-table) ?w)
-          (modify-syntax-entry i  "_"     ps-mode-syntax-table))
-      (setq i (1+ i)))
-    (modify-syntax-entry ?\   " "     ps-mode-syntax-table)
-    (modify-syntax-entry ?\t  " "     ps-mode-syntax-table)
-    (modify-syntax-entry ?\f  " "     ps-mode-syntax-table)
-    (modify-syntax-entry ?\r  " "     ps-mode-syntax-table)
-    (modify-syntax-entry ?\%  "<"     ps-mode-syntax-table)
-    (modify-syntax-entry ?\n  ">"     ps-mode-syntax-table)
-    (modify-syntax-entry ?\\  "\\"    ps-mode-syntax-table)
-    (modify-syntax-entry ??   "_"     ps-mode-syntax-table)
-    (modify-syntax-entry ?_   "_"     ps-mode-syntax-table)
-    (modify-syntax-entry ?.   "_"     ps-mode-syntax-table)
-    (modify-syntax-entry ?/   "'"     ps-mode-syntax-table)
-    (if ps-balanced-string-syntax-p
-        (progn
-          (modify-syntax-entry ?\(  "\"\)"  ps-mode-syntax-table)
-          (modify-syntax-entry ?\)  "\"\(" ps-mode-syntax-table))
-        (progn
-          ;; This isn't correct, but Emacs syntax stuff
-          ;;  has no way to deal with string syntax which uses
-          ;;  different open and close characters.  Sigh.
-          (modify-syntax-entry ?\(  "("     ps-mode-syntax-table)
-          (modify-syntax-entry ?\)  ")"     ps-mode-syntax-table)))
-    (modify-syntax-entry ?\[  "(\]"   ps-mode-syntax-table)
-    (modify-syntax-entry ?\]  ")\["   ps-mode-syntax-table)
-    (modify-syntax-entry ?\{  "\(\}"  ps-mode-syntax-table)
-    (modify-syntax-entry ?\}  "\)\{"  ps-mode-syntax-table)
-    (modify-syntax-entry ?/   "' p"   ps-mode-syntax-table)
-    ))
-
-
-;;;###autoload
-(defun postscript-mode ()
-  "Major mode for editing PostScript files.
-
-\\[ps-execute-buffer] will send the contents of the buffer to the NeWS
-server using psh(1).  \\[ps-execute-region] sends the current region.
-\\[ps-shell] starts an interactive psh(1) window which will be used for
-subsequent \\[ps-execute-buffer] or \\[ps-execute-region] commands.
-
-In this mode, TAB and \\[indent-region] attempt to indent code
-based on the position of {}, [], and begin/end pairs.  The variable
-ps-indent-level controls the amount of indentation used inside
-arrays and begin/end pairs.  
-
-\\{ps-mode-map}
-
-\\[postscript-mode] calls the value of the variable postscript-mode-hook 
-with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map ps-mode-map)
-  (set-syntax-table ps-mode-syntax-table)
-  (make-local-variable 'comment-start)
-  (setq comment-start "% ")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "%+ *")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'ps-indent-line)
-  (make-local-variable 'tab-stop-list)
-  (setq tab-stop-list ps-tab-stop-list)
-  (make-local-variable 'page-delimiter)
-  (setq page-delimiter "^showpage")
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (setq mode-name "PostScript")
-  (setq major-mode 'postscript-mode)
-  (run-hooks 'ps-mode-hook) ; bad name!  Kept for compatibility.
-  (run-hooks 'postscript-mode-hook)
-  )
-
-(defun ps-tab ()
-  "Command assigned to the TAB key in PostScript mode."
-  (interactive)
-  (if (save-excursion (skip-chars-backward " \t") (bolp))
-      (ps-indent-line)
-    (save-excursion
-      (ps-indent-line))))
-
-(defun ps-indent-line ()
-  "Indents a line of PostScript code."
-  (interactive)
-  (beginning-of-line)
-  (delete-horizontal-space)
-  (if (not (or (looking-at "%%")	; "%%" comments stay at left margin
-	       (ps-top-level-p)))
-      (if (and (< (point) (point-max))
-	       (eq ?\) (char-syntax (char-after (point)))))
-	  (ps-indent-close)		; indent close-delimiter
-	(if (looking-at "\\(dict\\|class\\)?end\\|cdef\\|grestore\\|>>")
-	    (ps-indent-end)		; indent end token
-	  (ps-indent-in-block)))))	; indent line after open delimiter
-  
-;(defun ps-open ()
-;  (interactive)
-;  (insert last-command-char))
-
-(defun ps-insert-d-char (arg)
-  "Awful hack to make \"end\" and \"cdef\" keywords indent themselves."
-  (interactive "p")
-  (insert-char last-command-char arg)
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at "^[ \t]*\\(\\(dict\\|class\\)?end\\|cdef\\|grestore\\)")
-	(progn
-	  (delete-horizontal-space)
-	  (ps-indent-end)))))
-
-(defun ps-close ()
-  "Inserts and indents a close delimiter."
-  (interactive)
-  (insert last-command-char)
-  (backward-char 1)
-  (ps-indent-close)
-  (forward-char 1)
-  (blink-matching-open))
-
-(defun ps-indent-close ()
-  "Internal function to indent a line containing a an array close delimiter."
-  (if (save-excursion (skip-chars-backward " \t") (bolp))
-      (let (x (oldpoint (point)))
-	(forward-char) (backward-sexp)	;XXX
-	(if (and (eq 1 (count-lines (point) oldpoint))
-		 (> 1 (- oldpoint (point))))
-	    (goto-char oldpoint)
-	  (beginning-of-line)
-	  (skip-chars-forward " \t")
-	  (setq x (current-column))
-	  (goto-char oldpoint)
-	  (delete-horizontal-space)
-	  (indent-to x)))))
-
-(defun ps-indent-end ()
-  "Indent an \"end\" token or array close delimiter."
-  (let ((goal (ps-block-start)))
-    (if (not goal)
-	(indent-relative)
-      (setq goal (save-excursion
-		   (goto-char goal) (back-to-indentation) (current-column)))
-      (indent-to goal))))
-
-(defun ps-indent-in-block ()
-  "Indent a line which does not open or close a block."
-  (let ((goal (ps-block-start)))
-    (setq goal (save-excursion
-		 (goto-char goal)
-		 (back-to-indentation)
-		 (if (bolp)
-		     ps-indent-level
-		   (back-to-indentation)
-		   (+ (current-column) ps-indent-level))))
-    (indent-to goal)))
-
-;;; returns nil if at top-level, or char pos of beginning of current block
-(defun ps-block-start ()
-  "Returns the character position of the character following the nearest
-enclosing `[' `{' or `begin' keyword."
-  (save-excursion
-    (let ((open (condition-case nil
-                    (save-excursion
-                      (backward-up-list 1)
-                      (1+ (point)))
-                  (error nil))))
-      (ps-begin-end-hack open))))
-
-(defun ps-begin-end-hack (start)
-  "Search backwards from point to START for enclosing `begin' and returns the
-character number of the character following `begin' or START if not found."
-  (save-excursion
-    (let ((depth 1))
-      (while (and (> depth 0)
-		  (or (re-search-backward "^[ \t]*\\(dict\\|class\\)?\\(end\\|grestore\\|>>\\)\\|\\(begin\\|gsave\\|<<\\)[ \t]*\\(%.*\\)*$"
-                                          start t)
-		      (re-search-backward "^[ \t]*cdef.*$" start t)))
- 	(setq depth (if (looking-at "[ \t]*\\(dict\\|class\\)?\\(end\\|grestore\\|>>\\)")
-			(1+ depth) (1- depth))))
-      (if (not (eq 0 depth))
-	  start
-	(forward-word 1)
-	(point)))))
-
-(defun ps-top-level-p ()
-  "Awful test to see whether we are inside some sort of PostScript block."
-  (and (condition-case nil
-	   (not (scan-lists (point) -1 1))
-	 (error t))
-       (not (ps-begin-end-hack nil))))
-
-;;; initialize the keymap if it doesn't already exist
-(if (null ps-mode-map)
-    (progn
-      (setq ps-mode-map (make-sparse-keymap))
-      (set-keymap-name ps-mode-map 'ps-mode-map)
-      ;;(define-key ps-mode-map "d" 'ps-insert-d-char)
-      ;;(define-key ps-mode-map "f" 'ps-insert-d-char)
-      ;;(define-key ps-mode-map "{" 'ps-open)
-      ;;(define-key ps-mode-map "}" 'ps-close)
-      ;;(define-key ps-mode-map "[" 'ps-open)
-      ;;(define-key ps-mode-map "]" 'ps-close)
-      (define-key ps-mode-map "\t" 'ps-tab)
-      (define-key ps-mode-map "\C-c\C-c" 'ps-execute-buffer)
-      (define-key ps-mode-map "\C-c|" 'ps-execute-region)
-      ;; make up yout mind! -- the below or the above?
-      (define-key ps-mode-map "\C-c!" 'ps-shell)
-      ))
-
-(defun ps-execute-buffer ()
-  "Send the contents of the buffer to a printer or NeWS server."
-  (interactive)
-  (save-excursion
-    (mark-whole-buffer)
-    (ps-execute-region (point-min) (point-max))))
-
-(defun ps-execute-region (start end)
-  "Send the region between START and END to a printer or NeWS server.
-You should kill any existing *PostScript* buffer unless you want the
-PostScript text to be executed in that process."
-  (interactive "r")
-  (let ((start (min (point) (mark)))
-	(end (max (point) (mark))))
-    (condition-case nil
-	(process-send-string "PostScript" (buffer-substring start end))
-      (error (shell-command-on-region 
-              start end
-              (mapconcat 'identity ps-postscript-command " ")
-              nil)))))
-
-(defun ps-shell ()
-  "Start a shell communicating with a PostScript printer or NeWS server."
-  (interactive)
-  (require 'shell)
-  (switch-to-buffer-other-window
-    (apply 'make-comint
-           "PostScript"
-           (car ps-postscript-command)
-           nil
-           (cdr ps-postscript-command)))
-  (make-local-variable 'shell-prompt-pattern)
-; (setq shell-prompt-pattern "PS>")
-  (setq shell-prompt-pattern "GS>")
-; (process-send-string "PostScript" "executive\n")
-  )
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.c?ps\\'" . postscript-mode))
diff --git a/xemacs-packages/lisp/prog-modes/prolog.el b/xemacs-packages/lisp/prog-modes/prolog.el
deleted file mode 100644
index b02a2c61..00000000
--- a/xemacs-packages/lisp/prog-modes/prolog.el
+++ /dev/null
@@ -1,336 +0,0 @@
-;;; prolog.el --- major mode for editing and running Prolog under Emacs
-
-;; Copyright (C) 1986, 1987, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA 
-;; Keywords: languages
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not synched with FSF, we appear to have a newer version
-
-;;; Commentary:
-
-;; This package provides a major mode for editing Prolog.  It knows
-;; about Prolog syntax and comments, and can send regions to an inferior
-;; Prolog interpreter process.
-
-;;; Code:
-
-(defvar prolog-mode-syntax-table nil)
-(defvar prolog-mode-abbrev-table nil)
-(defvar prolog-mode-map nil)
-
-(defgroup prolog nil
-  "Major mode for editing and running Prolog under Emacs"
-  :group 'languages)
-
-  
-(defcustom prolog-program-name "prolog"
-  "*Program name for invoking an inferior Prolog with `run-prolog'."
-  :type 'string
-  :group 'prolog)
-
-(defcustom prolog-consult-string "reconsult(user).\n"
-  "*(Re)Consult mode (for C-Prolog and Quintus Prolog). "
-  :type 'string
-  :group 'prolog)
-
-(defcustom prolog-compile-string "compile(user).\n"
-  "*Compile mode (for Quintus Prolog)."
-  :type 'string
-  :group 'prolog)
-
-(defcustom prolog-eof-string "end_of_file.\n"
-  "*String that represents end of file for prolog.
-nil means send actual operating system end of file."
-  :type 'string
-  :group 'prolog)
-
-(defcustom prolog-indent-width 4
-  "Level of indentation in Prolog buffers."
-  :type 'integer
-  :group 'prolog)
-
-(defconst prolog-font-lock-keywords (purecopy
-  (list
-   (cons (concat
-	  "[( \t]\\("
-	  (mapconcat 'identity
-		     '("write" "writeq" "nl" "is" "call" "read" "get" "get0"
-		       "tell" "told" "open" "close" "format" "put"
-		       "assert" "asserta" "assertz"
-		       "retract" "retractall" "clause"
-		       "record" "recorda" "abolish"
-		       "setof" "bagof" "findall" "sort" "compare"
-		       "var" "nonvar" "integer" "float"  "number" "ground"
-		       "atom" "atomic" "simple" "callable" "compound"
-		       "functor" "arg" "copy_term" "numbervars"
-		       "atom_chars"  "number_chars" "atom_to_chars"
-		       "length" "unix" "halt"
-		       "op" "dynamic" "meta_predicate" "raise_exception"
-		       "module" "ensure_loaded" "use_module"
-		       "fail" "true"
-		       "module_interface" "begin_module" "define_struct"
-		       "import" "export" "global" "tool" "external"
-		       "define_macro" "local" "library" "from"
-		       )
-		     "\\|")
-	  "\\)[ .,\t\n()]")
-	 1)
-   '("^[a-z][a-zA-Z0-9_]+"   0 font-lock-function-name-face)
-;   '("[@!$#]"   0 font-lock-function-name-face)
-   '("!"   0 font-lock-function-name-face)
-   '("@"   0 font-lock-function-name-face)
-   '("<=>"   0 font-lock-function-name-face)
-   '("==>"   0 font-lock-function-name-face)
-   '(";"   0 font-lock-function-name-face)
-   '(":-" 0 font-lock-function-name-face)
-   '("\\[" 0 font-lock-keyword-face)
-   '("\\]" 0 font-lock-keyword-face)
-   '("|" 0 font-lock-keyword-face)
-   ))
-  "Additional expressions to highlight in Prolog mode.")
-
-(if prolog-mode-syntax-table
-    ()
-  (let ((table (make-syntax-table)))
-    (modify-syntax-entry ?/  ". 14" table)
-    (modify-syntax-entry ?*  ". 23" table)
-    (modify-syntax-entry ?%  "< b"  table)
-    (modify-syntax-entry ?\n "> b"  table)
-    (modify-syntax-entry ?_  "w"  table)
-    (modify-syntax-entry ?\\ "\\" table)
-    (modify-syntax-entry ?\' "\"" table)
-    (modify-syntax-entry ?+  "." table)
-    (modify-syntax-entry ?-  "." table)
-    (modify-syntax-entry ?=  "." table)
-    (modify-syntax-entry ?<  "." table)
-    (modify-syntax-entry ?>  "." table)
-    (setq prolog-mode-syntax-table table)))
-
-(define-abbrev-table 'prolog-mode-abbrev-table ())
-
-(defun prolog-mode-variables ()
-  (set-syntax-table prolog-mode-syntax-table)
-  (setq local-abbrev-table prolog-mode-abbrev-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "%%\\|$\\|" page-delimiter)) ;'%%..'
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'prolog-indent-line)
-  (make-local-variable 'comment-start)
-  (setq comment-start "%")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "%+ *")
-  (make-local-variable 'comment-column)
-  (setq comment-column 48)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'prolog-comment-indent))
-
-(defun prolog-mode-commands (map)
-  (define-key map "\t" 'prolog-indent-line)
-  (define-key map "\e\C-x" 'prolog-consult-region))
-
-(if prolog-mode-map
-    nil
-  (setq prolog-mode-map (make-sparse-keymap))
-  (prolog-mode-commands prolog-mode-map))
-
-;;;###autoload
-(defun prolog-mode ()
-  "Major mode for editing Prolog code for Prologs.
-Blank lines and `%%...' separate paragraphs.  `%'s start comments.
-Commands:
-\\{prolog-mode-map}
-Entry to this mode calls the value of `prolog-mode-hook'
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map prolog-mode-map)
-  (setq major-mode 'prolog-mode)
-  (setq mode-name "Prolog")
-  (prolog-mode-variables)
-  (run-hooks 'prolog-mode-hook))
-
-(defun prolog-indent-line (&optional whole-exp)
-  "Indent current line as Prolog code.
-With argument, indent any additional lines of the same clause
-rigidly along with this one (not yet)."
-  (interactive "p")
-  (let ((indent (prolog-indent-level))
-	(pos (- (point-max) (point))) beg)
-    (beginning-of-line)
-    (setq beg (point))
-    (skip-chars-forward " \t")
-    (if (zerop (- indent (current-column)))
-	nil
-      (delete-region beg (point))
-      (indent-to indent))
-    (if (> (- (point-max) pos) (point))
-	(goto-char (- (point-max) pos)))
-    ))
-
-(defun prolog-indent-level ()
-  "Compute prolog indentation level."
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (cond
-     ((looking-at "%%%") 0)		;Large comment starts
-     ((looking-at "%[^%]") comment-column) ;Small comment starts
-     ((bobp) 0)				;Beginning of buffer
-     (t
-      (let ((empty t) ind more less)
-	(if (looking-at ")")
-	    (setq less t)		;Find close
-	  (setq less nil))
-	;; See previous indentation
-	(while empty
-	  (forward-line -1)
-	  (beginning-of-line)
- 	  (if (bobp)
- 	      (setq empty nil)
- 	    (skip-chars-forward " \t")
- 	    (if (not (or (looking-at "%[^%]") (looking-at "\n")))
- 		(setq empty nil))))
- 	(if (bobp)
- 	    (setq ind 0)		;Beginning of buffer
-	  (setq ind (current-column)))	;Beginning of clause
-	;; See its beginning
-	(if (looking-at "%%[^%]")
-	    ind
-	  ;; Real prolog code
-	  (if (looking-at "(")
-	      (setq more t)		;Find open
-	    (setq more nil))
-	  ;; See its tail
-	  (end-of-prolog-clause)
-	  (or (bobp) (forward-char -1))
-	  (cond ((looking-at "[,(;>]")
-		 (if (and more (looking-at "[^,]"))
-		     (+ ind prolog-indent-width) ;More indentation
-		   (max tab-width ind))) ;Same indentation
-		((looking-at "-") tab-width) ;TAB
-		((or less (looking-at "[^.]"))
-		 (max (- ind prolog-indent-width) 0)) ;Less indentation
-		(t 0))			;No indentation
-	  )))
-     )))
-
-(defun end-of-prolog-clause ()
-  "Go to end of clause in this line."
-  (beginning-of-line 1)
-  (let* ((eolpos (save-excursion (end-of-line) (point))))
-    (if (re-search-forward comment-start-skip eolpos 'move)
-	(goto-char (match-beginning 0)))
-    (skip-chars-backward " \t")))
-
-(defun prolog-comment-indent ()
-  "Compute prolog comment indentation."
-  (cond ((looking-at "%%%") 0)
-	((looking-at "%%") (prolog-indent-level))
-	(t
-	 (save-excursion
-	       (skip-chars-backward " \t")
-	       ;; Insert one space at least, except at left margin.
-	       (max (+ (current-column) (if (bolp) 0 1))
-		    comment-column)))
-	))
-
-
-;;;
-;;; Inferior prolog mode
-;;;
-(defvar inferior-prolog-mode-map nil)
-
-;;;###autoload
-(defun inferior-prolog-mode ()
-  "Major mode for interacting with an inferior Prolog process.
-
-The following commands are available:
-\\{inferior-prolog-mode-map}
-
-Entry to this mode calls the value of `prolog-mode-hook' with no arguments,
-if that value is non-nil.  Likewise with the value of `comint-mode-hook'.
-`prolog-mode-hook' is called after `comint-mode-hook'.
-
-You can send text to the inferior Prolog from other buffers
-using the commands `process-send-region', `process-send-string' and
-\\[prolog-consult-region].
-
-Commands:
-Tab indents for Prolog; with argument, shifts rest
- of expression rigidly with the current line.
-Paragraphs are separated only by blank lines and '%%'.
-'%'s start comments.
-
-Return at end of buffer sends line as input.
-Return not at end copies rest of line to end and sends it.
-\\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
-\\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
-\\[comint-stop-subjob] stops. \\[comint-quit-subjob] sends quit signal."
-  (interactive)
-  (require 'comint)
-  (comint-mode)
-  (setq major-mode 'inferior-prolog-mode
-	mode-name "Inferior Prolog"
-	comint-prompt-regexp "^| [ ?][- ] *")
-  (prolog-mode-variables)
-  (if inferior-prolog-mode-map nil
-    (setq inferior-prolog-mode-map (copy-keymap comint-mode-map))
-    (prolog-mode-commands inferior-prolog-mode-map))
-  (use-local-map inferior-prolog-mode-map)
-  (run-hooks 'prolog-mode-hook))
-
-;;;###autoload
-(defun run-prolog ()
-  "Run an inferior Prolog process, input and output via buffer *prolog*."
-  (interactive)
-  (require 'comint)
-  (switch-to-buffer (make-comint "prolog" prolog-program-name))
-  (inferior-prolog-mode))
-
-(defun prolog-consult-region (compile beg end)
-  "Send the region to the Prolog process made by \"M-x run-prolog\".
-If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
-  (interactive "P\nr")
-  (save-excursion
-    (if compile
-	(process-send-string "prolog" prolog-compile-string)
-      (process-send-string "prolog" prolog-consult-string))
-    (process-send-region "prolog" beg end)
-    (process-send-string "prolog" "\n")		;May be unnecessary
-    (if prolog-eof-string
-	(process-send-string "prolog" prolog-eof-string)
-      (process-send-eof "prolog")))) ;Send eof to prolog process.
-
-(defun prolog-consult-region-and-go (compile beg end)
-  "Send the region to the inferior Prolog, and switch to *prolog* buffer.
-If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
-  (interactive "P\nr")
-  (prolog-consult-region compile beg end)
-  (switch-to-buffer "*prolog*"))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.prolog\\'" . prolog-mode))
-
-;;; prolog.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/rexx-mode.el b/xemacs-packages/lisp/prog-modes/rexx-mode.el
deleted file mode 100644
index 392a52ff..00000000
--- a/xemacs-packages/lisp/prog-modes/rexx-mode.el
+++ /dev/null
@@ -1,620 +0,0 @@
-;;; rexx-mode.el --- major mode for editing REXX program files
-;; Keywords: languages
-
-;; Copyright (C) 1993 by Anders Lindgren.
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; AUTHOR
-;;;	Anders Lindgren, d91ali@csd.uu.se
-;;;
-;;;         Abbreviation table due to:
-;;;	Johan Bergkvist, nv91-jbe@nada.kth.se
-;;;
-;;; USAGE
-;;;	This file contains code for a GNU Emacs major mode for
-;;;	editing REXX program files.
-;;;
-;;;     Type C-h m in Emacs for information on how to configurate
-;;;	the rexx-mode, or see rexx-mode.doc.
-;;;
-;;;	Put the following lines into your .emacs and rexx-mode
-;;;	will be automatically loaded when editing a REXX program.
-;;;	If rexx-mode shall be used for files with other extensions
-;;;	you can create more (cons ...) lines with these extensions.
-;;;
-;;;	(autoload 'rexx-mode "rexx-mode" "REXX mode" nil t)
-;;;	(setq auto-mode-alist
-;;;	      (append
-;;;	       (list (cons "\\.rexx$"  'rexx-mode)
-;;;		     (cons "\\.elx$"   'rexx-mode)
-;;;		     (cons "\\.ncomm$" 'rexx-mode)
-;;;		     (cons "\\.cpr$"   'rexx-mode)
-;;;	       	     )
-;;;	       auto-mode-alist))
-;;;
-;;; HISTORY
-;;;	93-01-07 V0.1 ALi	Works for the first time.
-;;;	92-01-11 V0.2 ALi	rexx-calc-indent totally rewritten.
-;;;     93-03-08 V0.3 JB        rexx-indent-and-newline-and-indent added.
-;;;                             Abbrev-table containing 173 entries created.
-;;;                             rexx-check-expansion added.
-;;;                             rexx-mode enables use of abbrev-table.
-;;;	93-03-15 V0.4 ALi	abbrev-mode removed, better to call
-;;;				 (abbrev-mode 1) from the hook.
-;;;				case-fold-search set to t to recognize capital
-;;;				 letters in keywords.
-;;;				Old (setq case-fold-search nil) removed which
-;;;				 prevented the recognition of END.
-;;;				rexx-indent-and-newline-and-indent renamed to
-;;;				 rexx-indent-newline-indent.
-;;;				rexx-i-n-i now only expands abbrevs when
-;;;				 buffer is in abbrev-mode.
-;;;				New rexx-newline-and-indent added.
-;;;	93-03-20      ALi	 A serious bug in the routine for checking
-;;;				strings and comments found and fixed.
-;;;			   V1.0 Relesed!	
-;;;
-
-
-(provide 'rexx-mode)
-
-(defgroup rexx nil
-  "Major mode for editing REXX program files"
-  :group 'languages)
-
-
-(defcustom rexx-indent 8
-  "*This variable contains the indentation in rexx-mode."
-  :type 'integer
-  :group 'rexx)
-
-(defcustom rexx-end-indent 0
-  "*This variable indicates the relative position of the \"end\" in REXX mode."
-  :type 'integer
-  :group 'rexx)
-
-(defcustom rexx-cont-indent 8
-  "*This variable indicates how far a continued line shall be intended."
-  :type 'integer
-  :group 'rexx)
-
-(defcustom rexx-comment-col 32
-  "*This variable gives the desired comment column 
-for comments to the right of text."
-  :type 'integer
-  :group 'rexx)
-
-(defcustom rexx-tab-always-indent t
-  "*Non-nil means TAB in REXX mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used."
-  :type 'boolean
-  :group 'rexx)
-
-(defcustom rexx-special-regexp 
-  ".*\\(,\\|then\\|else\\)[ \t]*\\(/\\*.*\\*/\\)?[ \t]*$"
-  "*Regular expression for parsing lines which shall be followed by
-a extra indention"
-  :type 'regexp
-  :group 'rexx)
-
-(defconst rexx-font-lock-keywords
-  (purecopy
-   (list
-    (cons (concat "\\<\\("
-     (mapconcat 'identity
-     '("address" "arg" "break" "call" "do" "drop" "echo" "else" "end"
-      "exit" "if" "interpret" "iterate" "leave" "nop" "numeric"
-      "options" "otherwise" "parse" "procedure" "pull" "push" "queue"
-      "return" "say" "select" "shell" "signal" "then" "trace" "upper"
-      "when" "value" "to" "by" "for" "forever" "while" "until" "form"
-      "digits" "fuzz" "scientific" "engineering" "failat" "prompt"
-      "results" "upper" "external" "source" "with" "command"
-      "function" "var" "version" "expose" "on" "off")
-     "\\|") "\\)\\>") 'font-lock-keyword-face)
-   '("\\(\\sw+\\):" 1 font-lock-function-name-face)))
-  "Additional expressions to highlight in Rexx mode.")
-(put 'rexx-mode 'font-lock-defaults '(rexx-font-lock-keywords))
-
-(defvar rexx-mode-map nil
-  "Keymap for rexx-mode.")
-(if rexx-mode-map
-    nil
-  (setq rexx-mode-map (make-sparse-keymap))
-  (define-key rexx-mode-map "\t"   'rexx-indent-command)
-  (define-key rexx-mode-map "\C-m"  'rexx-indent-and-newline)
-  (define-key rexx-mode-map 'backspace 'backward-delete-char-untabify)
-  (define-key rexx-mode-map "\C-c\C-p" 'rexx-find-matching-do)
-  (define-key rexx-mode-map "\C-c\C-c" 'rexx-debug)
-  )
-
-(defvar rexx-mode-syntax-table nil
-  "Syntax table in use in REXX-mode buffers.")
-
-(if rexx-mode-syntax-table
-    ()
-  (setq rexx-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" rexx-mode-syntax-table)
-  (modify-syntax-entry ?/ ". 14" rexx-mode-syntax-table)
-  (modify-syntax-entry ?* ". 23" rexx-mode-syntax-table)
-  (modify-syntax-entry ?+ "." rexx-mode-syntax-table)
-  (modify-syntax-entry ?- "." rexx-mode-syntax-table)
-  (modify-syntax-entry ?= "." rexx-mode-syntax-table)
-  (modify-syntax-entry ?% "." rexx-mode-syntax-table)
-  (modify-syntax-entry ?< "." rexx-mode-syntax-table)
-  (modify-syntax-entry ?> "." rexx-mode-syntax-table)
-  (modify-syntax-entry ?& "." rexx-mode-syntax-table)
-  (modify-syntax-entry ?| "." rexx-mode-syntax-table)
-  (modify-syntax-entry ?. "_" rexx-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" rexx-mode-syntax-table))
-
-(defvar rexx-mode-abbrev-table nil
-  "*Abbrev table in use in rexx-mode buffers.")
-
-(if rexx-mode-abbrev-table
-    nil
-  (define-abbrev-table 'rexx-mode-abbrev-table '(
-     ("address" "ADDRESS" rexx-check-expansion 0)
-     ("arg" "ARG" rexx-check-expansion 0)
-     ("break" "BREAK" rexx-check-expansion 0)
-     ("call" "CALL" rexx-check-expansion 0)
-     ("do" "DO" rexx-check-expansion 0)
-     ("drop" "DROP" rexx-check-expansion 0)
-     ("echo" "ECHO" rexx-check-expansion 0)
-     ("else" "ELSE" rexx-check-expansion 0)
-     ("end" "END" rexx-check-expansion 0)
-     ("exit" "EXIT" rexx-check-expansion 0)
-     ("if" "IF" rexx-check-expansion 0)
-     ("interpret" "INTERPRET" rexx-check-expansion 0)
-     ("iterate" "ITERATE" rexx-check-expansion 0)
-     ("leave" "LEAVE" rexx-check-expansion 0)
-     ("nop" "NOP" rexx-check-expansion 0)
-     ("numeric" "NUMERIC" rexx-check-expansion 0)
-     ("options" "OPTIONS" rexx-check-expansion 0)
-     ("otherwise" "OTHERWISE" rexx-check-expansion 0)
-     ("parse" "PARSE" rexx-check-expansion 0)
-     ("procedure" "PROCEDURE" rexx-check-expansion 0)
-     ("pull" "PULL" rexx-check-expansion 0)
-     ("push" "PUSH" rexx-check-expansion 0)
-     ("queue" "QUEUE" rexx-check-expansion 0)
-     ("return" "RETURN" rexx-check-expansion 0)
-     ("say" "SAY" rexx-check-expansion 0)
-     ("select" "SELECT" rexx-check-expansion 0)
-     ("shell" "SHELL" rexx-check-expansion 0)
-     ("signal" "SIGNAL" rexx-check-expansion 0)
-     ("then" "THEN" rexx-check-expansion 0)
-     ("trace" "TRACE" rexx-check-expansion 0)
-     ("upper" "UPPER" rexx-check-expansion 0)
-     ("when" "WHEN" rexx-check-expansion 0)
-     ("value" "VALUE" rexx-check-expansion 0)
-     ("to" "TO" rexx-check-expansion 0)
-     ("by" "BY" rexx-check-expansion 0)
-     ("for" "FOR" rexx-check-expansion 0)
-     ("forever" "FOREVER" rexx-check-expansion 0)
-     ("while" "WHILE" rexx-check-expansion 0)
-     ("until" "UNTIL" rexx-check-expansion 0)
-     ("form" "FORM" rexx-check-expansion 0)
-     ("digits" "DIGITS" rexx-check-expansion 0)
-     ("fuzz" "FUZZ" rexx-check-expansion 0)
-     ("scientific" "SCIENTIFIC" rexx-check-expansion 0)
-     ("engineering" "ENGINEERING" rexx-check-expansion 0)
-     ("failat" "FAILAT" rexx-check-expansion 0)
-     ("prompt" "PROMPT" rexx-check-expansion 0)
-     ("results" "RESULTS" rexx-check-expansion 0)
-     ("upper" "UPPER" rexx-check-expansion 0)
-     ("external" "EXTERNAL" rexx-check-expansion 0)
-     ("source" "SOURCE" rexx-check-expansion 0)
-     ("with" "WITH" rexx-check-expansion 0)
-     ("command" "COMMAND" rexx-check-expansion 0)
-     ("function" "FUNCTION" rexx-check-expansion 0)
-     ("var" "VAR" rexx-check-expansion 0)
-     ("version" "VERSION" rexx-check-expansion 0)
-     ("expose" "EXPOSE" rexx-check-expansion 0)
-     ("on" "ON" rexx-check-expansion 0)
-     ("off" "OFF" rexx-check-expansion 0)
-     ("abbrev" "ABBREV" rexx-check-expansion 0)
-     ("abs" "ABS" rexx-check-expansion 0)
-     ("addlib" "ADDLIB" rexx-check-expansion 0)
-     ("b2c" "B2C" rexx-check-expansion 0)
-     ("bitand" "BITAND" rexx-check-expansion 0)
-     ("bitchg" "BITCHG" rexx-check-expansion 0)
-     ("bitclr" "BITCLR" rexx-check-expansion 0)
-     ("bitcomp" "BITCOMP" rexx-check-expansion 0)
-     ("bitor" "BITOR" rexx-check-expansion 0)
-     ("bittst" "BITTST" rexx-check-expansion 0)
-     ("bitset" "BITSET" rexx-check-expansion 0)
-     ("c2b" "C2B" rexx-check-expansion 0)
-     ("c2d" "C2D" rexx-check-expansion 0)
-     ("c2x" "C2X" rexx-check-expansion 0)
-     ("center" "CENTER" rexx-check-expansion 0)
-     ("centre" "CENTRE" rexx-check-expansion 0)
-     ("close" "CLOSE" rexx-check-expansion 0)
-     ("compress" "COMPRESS" rexx-check-expansion 0)
-     ("compare" "COMPARE" rexx-check-expansion 0)
-     ("copies" "COPIES" rexx-check-expansion 0)
-     ("d2c" "D2C" rexx-check-expansion 0)
-     ("datatype" "DATATYPE" rexx-check-expansion 0)
-     ("delstr" "DELSTR" rexx-check-expansion 0)
-     ("delword" "DELWORD" rexx-check-expansion 0)
-     ("eof" "EOF" rexx-check-expansion 0)
-     ("errortext" "ERRORTEXT" rexx-check-expansion 0)
-     ("exists" "EXISTS" rexx-check-expansion 0)
-     ("export" "EXPORT" rexx-check-expansion 0)
-     ("freespace" "FREESPACE" rexx-check-expansion 0)
-     ("getclip" "GETCLIP" rexx-check-expansion 0)
-     ("getspace" "GETSPACE" rexx-check-expansion 0)
-     ("hash" "HASH" rexx-check-expansion 0)
-     ("import" "IMPORT" rexx-check-expansion 0)
-     ("index" "INDEX" rexx-check-expansion 0)
-     ("insert" "INSERT" rexx-check-expansion 0)
-     ("lastpos" "LASTPOS" rexx-check-expansion 0)
-     ("left" "LEFT" rexx-check-expansion 0)
-     ("length" "LENGTH" rexx-check-expansion 0)
-     ("max" "MAX" rexx-check-expansion 0)
-     ("min" "MIN" rexx-check-expansion 0)
-     ("open" "OPEN" rexx-check-expansion 0)
-     ("overlay" "OVERLAY" rexx-check-expansion 0)
-     ("pos" "POS" rexx-check-expansion 0)
-     ("pragma" "PRAGMA" rexx-check-expansion 0)
-     ("random" "RANDOM" rexx-check-expansion 0)
-     ("randu" "RANDU" rexx-check-expansion 0)
-     ("readch" "READCH" rexx-check-expansion 0)
-     ("readln" "READLN" rexx-check-expansion 0)
-     ("remlib" "REMLIB" rexx-check-expansion 0)
-     ("reverse" "REVERSE" rexx-check-expansion 0)
-     ("right" "RIGHT" rexx-check-expansion 0)
-     ("seek" "SEEK" rexx-check-expansion 0)
-     ("setclip" "SETCLIP" rexx-check-expansion 0)
-     ("show" "SHOW" rexx-check-expansion 0)
-     ("sign" "SIGN" rexx-check-expansion 0)
-     ("space" "SPACE" rexx-check-expansion 0)
-     ("storage" "STORAGE" rexx-check-expansion 0)
-     ("strip" "STRIP" rexx-check-expansion 0)
-     ("substr" "SUBSTR" rexx-check-expansion 0)
-     ("subword" "SUBWORD" rexx-check-expansion 0)
-     ("symbol" "SYMBOL" rexx-check-expansion 0)
-     ("time" "TIME" rexx-check-expansion 0)
-     ("trace" "TRACE" rexx-check-expansion 0)
-     ("translate" "TRANSLATE" rexx-check-expansion 0)
-     ("trim" "TRIM" rexx-check-expansion 0)
-     ("verify" "VERIFY" rexx-check-expansion 0)
-     ("word" "WORD" rexx-check-expansion 0)
-     ("wordindex" "WORDINDEX" rexx-check-expansion 0)
-     ("wordlength" "WORDLENGTH" rexx-check-expansion 0)
-     ("words" "WORDS" rexx-check-expansion 0)
-     ("writech" "WRITECH" rexx-check-expansion 0)
-     ("writeln" "WRITELN" rexx-check-expansion 0)
-     ("x2c" "X2C" rexx-check-expansion 0)
-     ("xrange" "XRANGE" rexx-check-expansion 0)
-     ("allocmem" "ALLOCMEM" rexx-check-expansion 0)
-     ("baddr" "BADDR" rexx-check-expansion 0)
-     ("bitxor" "BITXOR" rexx-check-expansion 0)
-     ("break_c" "BREAK_C" rexx-check-expansion 0)
-     ("break_d" "BREAK_D" rexx-check-expansion 0)
-     ("break_e" "BREAK_E" rexx-check-expansion 0)
-     ("break_f" "BREAK_F" rexx-check-expansion 0)
-     ("cache" "CACHE" rexx-check-expansion 0)
-     ("closeport" "CLOSEPORT" rexx-check-expansion 0)
-     ("d2x" "D2X" rexx-check-expansion 0)
-     ("date" "DATA" rexx-check-expansion 0)
-     ("delay" "DELAY" rexx-check-expansion 0)
-     ("delete" "DELETE" rexx-check-expansion 0)
-     ("error" "ERROR" rexx-check-expansion 0)
-     ("failure" "FAILURE" rexx-check-expansion 0)
-     ("find" "FIND" rexx-check-expansion 0)
-     ("forbid" "FORBID" rexx-check-expansion 0)
-     ("freemem" "FREEMEM" rexx-check-expansion 0)
-     ("getarg" "GETARG" rexx-check-expansion 0)
-     ("getpkt" "GETPKT" rexx-check-expansion 0)
-     ("halt" "HALT" rexx-check-expansion 0)
-     ("ioerr" "IOERR" rexx-check-expansion 0)
-     ("lines" "LINES" rexx-check-expansion 0)
-     ("makedir" "MAKEDIR" rexx-check-expansion 0)
-     ("next" "NEXT" rexx-check-expansion 0)
-     ("novalue" "NOVALUE" rexx-check-expansion 0)
-     ("null" "NULL" rexx-check-expansion 0)
-     ("offset" "OFFSET" rexx-check-expansion 0)
-     ("openport" "OPENPORT" rexx-check-expansion 0)
-     ("permit" "PERMIT" rexx-check-expansion 0)
-     ("rename" "RENAME" rexx-check-expansion 0)
-     ("reply" "REPLY" rexx-check-expansion 0)
-     ("showdir" "SHOWDIR" rexx-check-expansion 0)
-     ("showlist" "SHOWLIST" rexx-check-expansion 0)
-     ("sourceline" "SOURCELINE" rexx-check-expansion 0)
-     ("statef" "STATEF" rexx-check-expansion 0)
-     ("syntax" "SYNTAX" rexx-check-expansion 0)
-     ("trunc" "TRUNC" rexx-check-expansion 0)
-     ("typepkt" "TYPEPKT" rexx-check-expansion 0)
-     ("waitpkt" "WAITPKT" rexx-check-expansion 0)
-     ("x2d" "X2D" rexx-check-expansion 0))))
-
-;;;###autoload
-(defun rexx-mode ()
-"Major mode for editing REXX code.
-\\{rexx-mode-map}
-
-Variables controlling indentation style:
- rexx-indent
-	The basic indentation for do-blocks.
- rexx-end-indent
-	The relative offset of the \"end\" statement. 0 places it in the
-	same column as the statements of the block. Setting it to the same
-	value as rexx-indent places the \"end\" under the do-line.
- rexx-cont-indent
-	The indention for lines following \"then\", \"else\" and \",\"
-	(continued) lines.
- rexx-tab-always-indent
-	Non-nil means TAB in REXX mode should always reindent the current 
-	line, regardless of where in the line the point is when the TAB
-	command is used.
-
-If you have set rexx-end-indent to a nonzero value, you probably want to
-remap RETURN to rexx-indent-newline-indent. It makes sure that lines
-indents correctly when you press RETURN.
-
-An extensive abbreviation table consisting of all the keywords of REXX are
-supplied. Expanded keywords are converted into upper case making it
-easier to distinguish them. To use this feature the buffer must be in
-abbrev-mode. (See example below.)
-
-Turning on REXX mode calls the value of the variable rexx-mode-hook with
-no args, if that value is non-nil.
-
-For example:
-(setq rexx-mode-hook '(lambda ()
-			(setq rexx-indent 4)
-			(setq rexx-end-indent 4)
-			(setq rexx-cont-indent 4)
-			(local-set-key \"\\C-m\" 'rexx-indent-newline-indent)
-			(abbrev-mode 1)
-			))
-
-will make the END aligned with the DO/SELECT. It will indent blocks and
-IF-statements four steps and make sure that the END jumps into the
-correct position when RETURN is pressed. Finally it will use the abbrev
-table to convert all REXX keywords into upper case."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map rexx-mode-map)
-  (set-syntax-table rexx-mode-syntax-table)
-  (setq major-mode 'rexx-mode)
-  (setq mode-name "REXX")
-  (setq local-abbrev-table rexx-mode-abbrev-table)
-  (make-local-variable 'case-fold-search)
-  (setq case-fold-search t)
-  (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 'indent-line-function)
-  (setq indent-line-function 'rexx-indent-command)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "/* ")
-  (make-local-variable 'comment-end)
-  (setq comment-end " */")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "/\\*+ *")
-  (make-local-variable 'comment-indent-hook)
-  (setq comment-indent-hook 'rexx-comment-indent)
-  (run-hooks 'rexx-mode-hook))
-
-
-(defun rexx-indent-command (&optional whole-exp)
-  "Indent the current line as REXX code."
-  (interactive "P")
-  (if whole-exp
-      (let ((shift-amt (rexx-indent-line))
-	    beg
-	    end)
-	(save-excursion
-	  (if rexx-tab-always-indent
-	      (beginning-of-line))
-	  (setq beg (point))
-	  (forward-sexp 1)
-	  (setq end (point))
-	  (goto-char beg)
-	  (forward-line 1)
-	  (setq beg (point)))
-	(if (> end beg)
-	    (indent-code-rigidly beg end shift-amt)))
-    (if (and (not rexx-tab-always-indent)
-	     (save-excursion
-	      (skip-chars-backward " \t")
-	      (not (bolp))))
-	(insert-tab)
-      (rexx-indent-line))))
-
-(defun rexx-indent-line ()
-  "Indent the current line as REXX code.
-Return the amount the indentation changed by."
-  (let ((indent (rexx-calc-indent))
-	beg
-	shift-amt
-        (pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil) (setq indent (current-indentation)))
-	  ((eq indent t) (setq indent (rexx-calculate-indent-within-comment)))
-	  ((looking-at "[ \t]*#") (setq indent 0))
-	  (t (skip-chars-forward " \t")
-	     (if (listp indent) (setq indent (car indent)))
-	      ;; /* Sprekspecifik kod! */
-	     (if (looking-at "end") (setq indent (- indent rexx-end-indent)))))
-    (skip-chars-forward " \t")
-    (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 (> (- (point-max) pos) (point))
-	  (goto-char (- (point-max) pos))))
-    shift-amt))
-
-(defun rexx-calc-indent ()
-  "Return the appropriate indentation for this line as an int."
-  (save-excursion
-    (beginning-of-line)
-    (let ((block (rexx-find-environment))
-	  beg
-	  state
-	  indent)
-      (save-excursion (setq state (rexx-inside-comment-or-string)))
-      (cond ((or (nth 3 state) (nth 4 state))
-	     (nth 4 state))	;; Inside a comment or string
-	    (t	
-	     ;; Find line to indent current line after.
-	     (rexx-backup-to-noncomment 1)
-	     (beginning-of-line)
-	     (setq beg (rexx-find-environment))
-	     (while (> beg block)
-	       (goto-char beg)
-	       (beginning-of-line)
-	       (setq beg (rexx-find-environment)))
-
-	     (if (> (point) block)		 
-		 ;; Check to see if we shall make a special indention
-		 (if (looking-at rexx-special-regexp)
-		     (+ (current-indentation) rexx-cont-indent)
-		   ;; If not, find the basic indention by stepping
-		   ;; by all special indented lines.
-		   (progn
-		     (setq indent (current-indentation))
-		     (rexx-backup-to-noncomment 1)
-		     (beginning-of-line)
-		     (while (looking-at rexx-special-regexp)
-		       (setq indent (current-indentation))
-		       (rexx-backup-to-noncomment 1)
-		       (beginning-of-line))
-		     indent))
-	       (if (= 1 block)
-		   0
-		 ;; Indent after the do-line.
-		 (progn
-		   (goto-char block)
-		   (+ (current-indentation) rexx-indent)))))))))
-
-(defun rexx-backup-to-noncomment (lim)
-  "Backup the point to the previous noncomment REXX line."
-  (let (stop)
-    (while (not stop)
-      (skip-chars-backward " \t\n\f" lim)
-      (if (and (>= (point) (+ 2 lim))
-	       (save-excursion
-		 (forward-char -2)
-		 (looking-at "\\*/")))
-	  (search-backward "/*" lim 'move)
-	(setq stop t)))
-    (>= (point) lim)))
-
-(defun rexx-find-environment ()
-  "Return the position of the corresponding \"do\" or \"select\".
-If none found, return the beginning of buffer."
-  (save-excursion
-    (let ((do-level 1)
-	  (cont t)
-	  state)
-      (while (and cont (not (zerop do-level)))
-	(setq cont (re-search-backward "\\b\\(do\\|select\\|end\\)\\b" 1 t))
-	(save-excursion (setq state (rexx-inside-comment-or-string)))
-	(setq do-level (+ do-level
-			  (cond ((or (nth 3 state) (nth 4 state)) 0)
-				((looking-at "do") -1)
-				((looking-at "select") -1)
-				((looking-at "end") +1)
-				(t 0)))))
-
-      (if cont (point) 1))))
-
-(defun rexx-calculate-indent-within-comment ()
-  "Return the indentation amount for line, assuming that
-the current line is to be regarded as part of a block comment."
-  (let (end star-start)
-    (save-excursion
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (setq star-start (= (following-char) ?\*))
-      (skip-chars-backward " \t\n")
-      (setq end (point))
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (and (re-search-forward "/\\*[ \t]*" end t)
-	   star-start
-	   (goto-char (1+ (match-beginning 0))))
-      (current-column))))
-
-(defun rexx-comment-indent ()
-  (if (looking-at "^/\\*")
-      0				;Existing comment at bol stays there.
-    (save-excursion
-      (skip-chars-backward " \t")
-      (max (1+ (current-column))	;Else indent at comment column
-	   comment-column))))	; except leave at least one space.
-
-(defun rexx-find-matching-do ()
-  "Set mark, look for the \"do\" or \"select\" for the present block."
-  (interactive)
-  (set-mark-command nil)
-  (beginning-of-line)
-  (goto-char (rexx-find-environment)))
-
-(defun rexx-check-expansion ()
-  "If abbrev was made within a comment or a string, de-abbrev!"
-  (let ((state (rexx-inside-comment-or-string)))
-    (if (or (nth 3 state) (nth 4 state))
-	(unexpand-abbrev))))
-
-(defun rexx-inside-comment-or-string ()
-  "Check if the point is inside a comment or a string.
-It returns the state from parse-partial-sexp for the search that
-terminated on the points position"
-  (let ((origpoint (point))
-	state)
-    (save-excursion 
-      (goto-char 1)
-      (while (> origpoint (point))
-	(setq state (parse-partial-sexp (point) origpoint 0))))
-    state))
-
-(defun rexx-indent-and-newline ()
-  "New newline-and-indent which expands abbrevs before running
-a regular newline-and-indent."
-  (interactive)
-  (if abbrev-mode 
-      (expand-abbrev))
-  (newline-and-indent))
-
-(defun rexx-indent-newline-indent ()
-  "New newline-and-indent which expands abbrevs and indent the line
-before running a regular newline-and-indent."
-  (interactive)
-  (rexx-indent-command)
-  (if abbrev-mode 
-      (expand-abbrev))
-  (newline-and-indent))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'interpreter-mode-alist '("rexx" . rexx-mode))
diff --git a/xemacs-packages/lisp/prog-modes/rpm-spec-mode.el b/xemacs-packages/lisp/prog-modes/rpm-spec-mode.el
deleted file mode 100644
index a0dec2a0..00000000
--- a/xemacs-packages/lisp/prog-modes/rpm-spec-mode.el
+++ /dev/null
@@ -1,1353 +0,0 @@
-;;; rpm-spec-mode.el --- RPM spec file editing commands for Emacs/XEmacs
-
-;; Copyright (C) 1997-2002 Stig Bjørlykke, 
-
-;; Author:   Stig Bjørlykke, 
-;; Keywords: unix, languages, rpm
-;; Version:  0.12
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-;; MA 02111-1307, USA.
-
-;;; Synched up with: not in GNU Emacs.
-
-;;; Thanx to:
-
-;;     Tore Olsen  for some general fixes.
-;;     Steve Sanbeg  for navigation functions and
-;;          some Emacs fixes.
-;;     Tim Powers  and Trond Eivind Glomsrød
-;;           for Red Hat adaptions and some fixes.
-;;     Chmouel Boudjnah  for Mandrake fixes.
-;;     Ville Skyttä   for some fixes.
-
-;;; ToDo:
-
-;; - rewrite function names.
-;; - autofill changelog entries.
-;; - customize rpm-tags-list and rpm-group-tags-list.
-;; - get values from `rpm --showrc'.
-;; - ssh/rsh for compile.
-;; - finish integrating the new navigation functions in with existing stuff.
-;; - use a single prefix consistently (internal)
-
-;;; Commentary:
-
-;; This mode is used for editing spec files used for building RPM packages.
-;;
-;; Most recent version is available from:
-;;  
-;;
-;; Put this in your .emacs file to enable autoloading of rpm-spec-mode,
-;; and auto-recognition of ".spec" files:
-;;
-;;  (autoload 'rpm-spec-mode "rpm-spec-mode.el" "RPM spec mode." t)
-;;  (setq auto-mode-alist (append '(("\\.spec" . rpm-spec-mode))
-;;                                auto-mode-alist))
-;;------------------------------------------------------------
-;;
-
-;;; Code:
-
-(defconst rpm-spec-mode-version "0.12" "Version of `rpm-spec-mode'.")
-
-(defgroup rpm-spec nil
-  "RPM spec mode with Emacs/XEmacs enhancements."
-  :prefix "rpm-spec-"
-  :group 'languages)
-
-(defcustom rpm-spec-build-command "rpmbuild"
-  "Command for building an RPM package."
-  :type 'string
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-add-attr nil
-  "Add \"%attr\" entry for file listings or not."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-short-circuit nil
-  "Skip straight to specified stage.
-(ie, skip all stages leading up to the specified stage).  Only valid
-in \"%build\" and \"%install\" stage."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-timecheck "0"
-  "Set the \"timecheck\" age (0 to disable).
-The timecheck value expresses, in seconds, the maximum age of a file
-being packaged.  Warnings will be printed for all files beyond the
-timecheck age."
-  :type 'integer
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-buildroot ""
-  "When building, override the BuildRoot tag with directory ."
-  :type 'string
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-target ""
-  "Interpret given string as `arch-vendor-os'.
-Set the macros _target, _target_arch and _target_os accordingly"
-  :type 'string
-  :group 'rpm-spec)
-
-(define-obsolete-variable-alias
-  'rpm-completion-ignore-case 'rpm-spec-completion-ignore-case)
-
-(defcustom rpm-spec-completion-ignore-case t
-  "*Non-nil means that case differences are ignored during completion.
-A value of nil means that case is significant.
-This is used during Tempo template completion."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-clean nil
-  "Remove the build tree after the packages are made."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-rmsource nil
-  "Remove the source and spec file after the packages are made."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(define-obsolete-variable-alias
-  'rpm-spec-test 'rpm-spec-nobuild)
-
-(defcustom rpm-spec-nobuild nil
-  "Do not execute any build stages.  Useful for testing out spec files."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-quiet nil
-  "Print as little as possible.
-Normally only error messages will be displayed."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-sign-gpg nil
-  "Embed a GPG signature in the package.
-This signature can be used to verify the integrity and the origin of
-the package."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-nodeps nil
-  "Do not verify build dependencies."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(define-obsolete-variable-alias
-  'rpm-initialize-sections 'rpm-spec-initialize-sections)
-
-(defcustom rpm-spec-initialize-sections t
-  "Automatically add empty section headings to new spec files."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(define-obsolete-variable-alias
-  'rpm-insert-version 'rpm-spec-insert-changelog-version)
-
-(defcustom rpm-spec-insert-changelog-version t
-  "Automatically add version in a new change log entry."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-user-full-name nil
-  "*Full name of the user.
-This is used in the change log and the Packager tag.  It defaults to the
-value returned by function `user-full-name'."
-  :type '(choice (const :tag "Use `user-full-name'" nil)
-                 string)
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-user-mail-address nil
-  "*Email address of the user.
-This is used in the change log and the Packager tag.  It defaults to the
-value returned by function `user-mail-address'."
-  :type '(choice (const :tag "Use `user-mail-address'" nil)
-                 string)
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-indent-heading-values nil
-  "*Indent values for all tags in the \"heading\" of the spec file."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-use-compilation-mode t
-  "*If non-nil, build in `compilation-mode' if it's available."
-  :type 'boolean
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-default-release "1"
-  "*Default value for the Release tag in new spec files."
-  :type 'string
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-default-epoch nil
-  "*If non-nil, default value for the Epoch tag in new spec files."
-  :type '(choice (const :tag "No Epoch" nil) integer)
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-default-buildroot
-  "%{_tmppath}/%{name}-%{version}-%{release}-root"
-  "*Default value for the BuildRoot tag in new spec files."
-  :type 'integer
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-default-build-section ""
-  "*Default %build section in new spec files."
-  :type 'string
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-default-install-section "rm -rf $RPM_BUILD_ROOT\n"
-  "*Default %install section in new spec files."
-  :type 'string
-  :group 'rpm-spec)
-
-(defcustom rpm-spec-default-clean-section "rm -rf $RPM_BUILD_ROOT\n"
-  "*Default %clean section in new spec files."
-  :type 'string
-  :group 'rpm-spec)
-
-(defgroup rpm-spec-faces nil
-  "Font lock faces for `rpm-spec-mode'."
-  :prefix "rpm-spec-"
-  :group 'rpm-spec
-  :group 'faces)
-
-;;------------------------------------------------------------
-;; variables used by navigation functions.
-
-(defconst rpm-sections
-  '("preamble" "description" "prep" "setup" "build" "install" "check" "clean"
-    "changelog" "files")
-  "Partial list of section names.")
-(defvar rpm-section-list
-  '(("preamble") ("description") ("prep") ("setup") ("build") ("install")
-    ("check") ("clean") ("changelog") ("files"))
-  "Partial list of section names.")
-(defconst rpm-scripts
-  '("pre" "post" "preun" "postun"
-    "trigger" "triggerin" "triggerun" "triggerpostun")
-  "List of rpm scripts.")
-(defconst rpm-section-seperate "^%\\(\\w+\\)\\s-")
-(defconst rpm-section-regexp
-  (eval-when-compile
-    (concat "^%"
-            (regexp-opt
-             ;; From RPM 4.4.1 sources, file build/parseSpec.c: partList[].
-             '("build" "changelog" "check" "clean" "description" "files"
-               "install" "package" "post" "postun" "pretrans" "posttrans"
-               "pre" "prep" "preun" "trigger" "triggerin" "triggerpostun"
-               "triggerun" "verifyscript") t)
-            "\\b"))
-  "Regular expression to match beginning of a section.")
-
-;;------------------------------------------------------------
-
-(defface rpm-spec-tag-face
-  '(( ((class color) (background light)) (:foreground "blue3") )
-    ( ((class color) (background dark)) (:foreground "blue") ))
-  "*Face for tags."
-  :group 'rpm-spec-faces)
-
-(defface rpm-spec-macro-face
-  '(( ((class color) (background light)) (:foreground "purple") )
-    ( ((class color) (background dark)) (:foreground "yellow") ))
-  "*Face for RPM macros and variables."
-  :group 'rpm-spec-faces)
-
-(defface rpm-spec-var-face
-  '(( ((class color) (background light)) (:foreground "maroon") )
-    ( ((class color) (background dark)) (:foreground "maroon") ))
-  "*Face for environment variables."
-  :group 'rpm-spec-faces)
-
-(defface rpm-spec-doc-face
-  '(( ((class color) (background light)) (:foreground "magenta3") )
-    ( ((class color) (background dark)) (:foreground "magenta") ))
-  "*Face for %doc entries in %files."
-  :group 'rpm-spec-faces)
-
-(defface rpm-spec-dir-face
-  '(( ((class color) (background light)) (:foreground "green4") )
-    ( ((class color) (background dark)) (:foreground "green") ))
-  "*Face for %dir entries in %files."
-  :group 'rpm-spec-faces)
-
-(defface rpm-spec-package-face
-  '(( ((class color) (background light)) (:foreground "red3") )
-    ( ((class color) (background dark)) (:foreground "red") ))
-  "*Face for package tag."
-  :group 'rpm-spec-faces)
-
-(defface rpm-spec-ghost-face
-  '(( ((class color) (background light)) (:foreground "gray50") )
-    ( ((class color) (background dark)) (:foreground "red") ))
-  "*Face for %ghost and %config entries in %files."
-  :group 'rpm-spec-faces)
-
-(defface rpm-spec-section-face
-  '(( ((class color) (background light)) (:foreground "purple" :underline t) )
-    ( ((class color) (background dark)) (:foreground "yellow" :underline t) ))
-  "*Face for section markers."
-  :group 'rpm-spec-faces)
-
-;;; GNU emacs font-lock needs these...
-(defvar rpm-spec-macro-face
-  'rpm-spec-macro-face "*Face for RPM macros and variables.")
-(defvar rpm-spec-var-face
-  'rpm-spec-var-face "*Face for environment variables.")
-(defvar rpm-spec-tag-face
-  'rpm-spec-tag-face "*Face for tags.")
-(defvar rpm-spec-package-face
-  'rpm-spec-package-face "*Face for package tag.")
-(defvar rpm-spec-dir-face
-  'rpm-spec-dir-face "*Face for %dir entries in %files.")
-(defvar rpm-spec-doc-face
-  'rpm-spec-doc-face "*Face for %doc entries in %files.")
-(defvar rpm-spec-ghost-face
-  'rpm-spec-ghost-face "*Face for %ghost and %config entries in %files.")
-(defvar rpm-spec-section-face
-  'rpm-spec-section-face "*Face for section markers.")
-
-(defvar rpm-default-umask "-"
-  "*Default umask for files, specified with \"%attr\".")
-(defvar rpm-default-owner "root"
-  "*Default owner for files, specified with \"%attr\".")
-(defvar rpm-default-group "root"
-  "*Default group for files, specified with \"%attr\".")
-
-;;------------------------------------------------------------
-
-(defvar rpm-no-gpg nil "Tell rpm not to sign package.")
-(defvar rpm-spec-nobuild-option "--nobuild" "Option for no build.")
-
-(defvar rpm-tags-list
-  ;; From RPM 4.4.1 sources, file build/parsePreamble.c: preambleList[], and
-  ;; a few macros that aren't tags, but useful here.
-  '(("AutoProv")
-    ("AutoReq")
-    ("AutoReqProv")
-    ("BuildArch")
-    ("BuildArchitectures")
-    ("BuildConflicts")
-    ("BuildPreReq")
-    ("BuildRequires")
-    ("BuildRoot")
-    ("Conflicts")
-    ("Copyright")
-    ("%description")
-    ("Distribution")
-    ("DistTag")
-    ("DistURL")
-    ("DocDir")
-    ("Epoch")
-    ("ExcludeArch")
-    ("ExcludeOS")
-    ("ExclusiveArch")
-    ("ExclusiveOS")
-    ("%files")
-    ("Group")
-    ("Icon")
-    ("%ifarch")
-    ("License")
-    ("Name")
-    ("NoPatch")
-    ("NoSource")
-    ("Obsoletes")
-    ("%package")
-    ("Packager")
-    ("Patch")
-    ("Prefix")
-    ("Prefixes")
-    ("PreReq")
-    ("Provides")
-    ("Release")
-    ("Requires")
-    ("RHNPlatform")
-    ("Serial")
-    ("Source")
-    ("Summary")
-    ("URL")
-    ("Vendor")
-    ("Version"))
-  "List of elements that are valid tags.")
-
-(defvar rpm-group-tags-list
-  ;; From RPM 4.4.1 sources, file GROUPS.
-  '(("Amusements/Games")
-    ("Amusements/Graphics")
-    ("Applications/Archiving")
-    ("Applications/Communications")
-    ("Applications/Databases")
-    ("Applications/Editors")
-    ("Applications/Emulators")
-    ("Applications/Engineering")
-    ("Applications/File")
-    ("Applications/Internet")
-    ("Applications/Multimedia")
-    ("Applications/Productivity")
-    ("Applications/Publishing")
-    ("Applications/System")
-    ("Applications/Text")
-    ("Development/Debuggers")
-    ("Development/Languages")
-    ("Development/Libraries")
-    ("Development/System")
-    ("Development/Tools")
-    ("Documentation")
-    ("System Environment/Base")
-    ("System Environment/Daemons")
-    ("System Environment/Kernel")
-    ("System Environment/Libraries")
-    ("System Environment/Shells")
-    ("User Interface/Desktops")
-    ("User Interface/X")
-    ("User Interface/X Hardware Support")
-    )
-  "List of elements that are valid group tags.")
-
-(defvar rpm-spec-mode-syntax-table nil
-  "Syntax table in use in `rpm-spec-mode' buffers.")
-(unless rpm-spec-mode-syntax-table
-  (setq rpm-spec-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?\n ">   " rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?\f ">   " rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?\# "<   " rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?/ "." rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?* "." rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?+ "." rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?- "." rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?= "." rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?% "_" rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?< "." rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?> "." rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?& "." rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?| "." rpm-spec-mode-syntax-table)
-  (modify-syntax-entry ?\' "." rpm-spec-mode-syntax-table))
-
-(defvar rpm-spec-mode-map nil
-  "Keymap used in `rpm-spec-mode'.")
-(unless rpm-spec-mode-map
-  (setq rpm-spec-mode-map (make-sparse-keymap))
-  (and (functionp 'set-keymap-name)
-       (set-keymap-name rpm-spec-mode-map 'rpm-spec-mode-map))
-  (define-key rpm-spec-mode-map "\C-c\C-c"  'rpm-change-tag)
-  (define-key rpm-spec-mode-map "\C-c\C-e"  'rpm-add-change-log-entry)
-  (define-key rpm-spec-mode-map "\C-c\C-i"  'rpm-insert-tag)
-  (define-key rpm-spec-mode-map "\C-c\C-n"  'rpm-forward-section)
-  (define-key rpm-spec-mode-map "\C-c\C-o"  'rpm-goto-section)
-  (define-key rpm-spec-mode-map "\C-c\C-p"  'rpm-backward-section)
-  (define-key rpm-spec-mode-map "\C-c\C-r"  'rpm-increase-release-tag)
-  (define-key rpm-spec-mode-map "\C-c\C-u"  'rpm-insert-true-prefix)
-  (define-key rpm-spec-mode-map "\C-c\C-ba" 'rpm-build-all)
-  (define-key rpm-spec-mode-map "\C-c\C-bb" 'rpm-build-binary)
-  (define-key rpm-spec-mode-map "\C-c\C-bc" 'rpm-build-compile)
-  (define-key rpm-spec-mode-map "\C-c\C-bi" 'rpm-build-install)
-  (define-key rpm-spec-mode-map "\C-c\C-bl" 'rpm-list-check)
-  (define-key rpm-spec-mode-map "\C-c\C-bp" 'rpm-build-prepare)
-  (define-key rpm-spec-mode-map "\C-c\C-bs" 'rpm-build-source)
-  (define-key rpm-spec-mode-map "\C-c\C-dd" 'rpm-insert-dir)
-  (define-key rpm-spec-mode-map "\C-c\C-do" 'rpm-insert-docdir)
-  (define-key rpm-spec-mode-map "\C-c\C-fc" 'rpm-insert-config)
-  (define-key rpm-spec-mode-map "\C-c\C-fd" 'rpm-insert-doc)
-  (define-key rpm-spec-mode-map "\C-c\C-ff" 'rpm-insert-file)
-  (define-key rpm-spec-mode-map "\C-c\C-fg" 'rpm-insert-ghost)
-  (define-key rpm-spec-mode-map "\C-c\C-xa" 'rpm-toggle-add-attr)
-  (define-key rpm-spec-mode-map "\C-c\C-xb" 'rpm-change-buildroot-option)
-  (define-key rpm-spec-mode-map "\C-c\C-xc" 'rpm-toggle-clean)
-  (define-key rpm-spec-mode-map "\C-c\C-xd" 'rpm-toggle-nodeps)
-  (define-key rpm-spec-mode-map "\C-c\C-xf" 'rpm-files-group)
-  (define-key rpm-spec-mode-map "\C-c\C-xg" 'rpm-toggle-sign-gpg)
-  (define-key rpm-spec-mode-map "\C-c\C-xi" 'rpm-change-timecheck-option)
-  (define-key rpm-spec-mode-map "\C-c\C-xn" 'rpm-toggle-nobuild)
-  (define-key rpm-spec-mode-map "\C-c\C-xo" 'rpm-files-owner)
-  (define-key rpm-spec-mode-map "\C-c\C-xr" 'rpm-toggle-rmsource)
-  (define-key rpm-spec-mode-map "\C-c\C-xq" 'rpm-toggle-quiet)
-  (define-key rpm-spec-mode-map "\C-c\C-xs" 'rpm-toggle-short-circuit)
-  (define-key rpm-spec-mode-map "\C-c\C-xt" 'rpm-change-target-option)
-  (define-key rpm-spec-mode-map "\C-c\C-xu" 'rpm-files-umask)
-  ;;(define-key rpm-spec-mode-map "\C-q" 'indent-spec-exp)
-  ;;(define-key rpm-spec-mode-map "\t" 'sh-indent-line)
-  )
-
-(defconst rpm-spec-mode-menu
-  (purecopy '("RPM spec"
-              ["Insert Tag..."           rpm-insert-tag                t]
-              ["Change Tag..."           rpm-change-tag                t]
-              "---"
-              ["Go to section..."        rpm-mouse-goto-section  :keys "C-c C-o"]
-              ["Forward section"         rpm-forward-section           t]
-              ["Backward section"        rpm-backward-section          t]
-              "---"
-              ["Add change log entry..." rpm-add-change-log-entry      t]
-              ["Increase release tag"    rpm-increase-release-tag      t]
-              "---"
-              ("Add file entry"
-               ["Regular file..."        rpm-insert-file               t]
-               ["Config file..."         rpm-insert-config             t]
-               ["Document file..."       rpm-insert-doc                t]
-               ["Ghost file..."          rpm-insert-ghost              t]
-               "---"
-               ["Directory..."           rpm-insert-dir                t]
-               ["Document directory..."  rpm-insert-docdir             t]
-               "---"
-               ["Insert %{prefix}"       rpm-insert-true-prefix        t]
-               "---"
-               ["Default add \"%attr\" entry" rpm-toggle-add-attr
-                :style toggle :selected rpm-spec-add-attr]
-               ["Change default umask for files..."  rpm-files-umask   t]
-               ["Change default owner for files..."  rpm-files-owner   t]
-               ["Change default group for files..."  rpm-files-group   t])
-              ("Build Options"
-               ["Short circuit" rpm-toggle-short-circuit
-                :style toggle :selected rpm-spec-short-circuit]
-               ["Remove source" rpm-toggle-rmsource
-                :style toggle :selected rpm-spec-rmsource]
-               ["Clean"         rpm-toggle-clean
-                :style toggle :selected rpm-spec-clean]
-               ["No build"      rpm-toggle-nobuild
-                :style toggle :selected rpm-spec-nobuild]
-               ["Quiet"         rpm-toggle-quiet
-                :style toggle :selected rpm-spec-quiet]
-               ["GPG sign"      rpm-toggle-sign-gpg
-                :style toggle :selected rpm-spec-sign-gpg]
-               ["Ignore dependencies" rpm-toggle-nodeps
-                :style toggle :selected rpm-spec-nodeps]
-               "---"
-               ["Change timecheck value..."  rpm-change-timecheck-option   t]
-               ["Change buildroot value..."  rpm-change-buildroot-option   t]
-               ["Change target value..."     rpm-change-target-option      t])
-              ("RPM Build"
-               ["Execute \"%prep\" stage"    rpm-build-prepare             t]
-               ["Do a \"list check\""        rpm-list-check                t]
-               ["Do the \"%build\" stage"    rpm-build-compile             t]
-               ["Do the \"%install\" stage"  rpm-build-install             t]
-               "---"
-               ["Build binary package"       rpm-build-binary              t]
-               ["Build source package"       rpm-build-source              t]
-               ["Build binary and source"    rpm-build-all                 t])
-              "---"
-              ["About rpm-spec-mode"         rpm-about-rpm-spec-mode       t]
-              )))
-
-(defvar rpm-spec-font-lock-keywords
-  (list
-   (cons rpm-section-regexp rpm-spec-section-face)
-   '("%[a-zA-Z0-9_]+" 0 rpm-spec-macro-face)
-   '("^\\([a-zA-Z0-9]+\\)\\(\([a-zA-Z0-9,_]+\)\\):"
-     (1 rpm-spec-tag-face)
-     (2 rpm-spec-ghost-face))
-   '("^\\([a-zA-Z0-9]+\\):" 1 rpm-spec-tag-face)
-   '("%\\(de\\(fine\\|scription\\)\\|files\\|package\\)[ \t]+\\([^-][^ \t\n]*\\)"
-     (3 rpm-spec-package-face))
-   '("%p\\(ost\\|re\\)\\(un\\)?[ \t]+\\([^-][^ \t\n]*\\)"
-     (3 rpm-spec-package-face))
-   '("%configure " 0 rpm-spec-macro-face)
-   '("%dir[ \t]+\\([^ \t\n]+\\)[ \t]*" 1 rpm-spec-dir-face)
-   '("%doc\\(dir\\)?[ \t]+\\(.*\\)\n" 2 rpm-spec-doc-face)
-   '("%\\(ghost\\|config\\([ \t]*(.*)\\)?\\)[ \t]+\\(.*\\)\n"
-     3 rpm-spec-ghost-face)
-   '("^%.+-[a-zA-Z][ \t]+\\([a-zA-Z0-9\.-]+\\)" 1 rpm-spec-doc-face)
-   '("^\\(.+\\)(\\([a-zA-Z]\\{2,2\\}\\)):"
-     (1 rpm-spec-tag-face)
-     (2 rpm-spec-doc-face))
-   '("^\\*\\(.*[0-9] \\)\\(.*\\)<\\(.*\\)>\\(.*\\)\n"
-     (1 rpm-spec-dir-face)
-     (2 rpm-spec-package-face)
-     (3 rpm-spec-tag-face)
-     (4 rpm-spec-ghost-face))
-   '("%{[^{}]*}" 0 rpm-spec-macro-face)
-   '("$[a-zA-Z0-9_]+" 0 rpm-spec-var-face)
-   '("${[a-zA-Z0-9_]+}" 0 rpm-spec-var-face)
-   )
-  "Additional expressions to highlight in `rpm-spec-mode'.")
-
-;;Initialize font lock for xemacs
-(put 'rpm-spec-mode 'font-lock-defaults '(rpm-spec-font-lock-keywords))
-
-(defvar rpm-spec-mode-abbrev-table nil
-  "Abbrev table in use in `rpm-spec-mode' buffers.")
-(define-abbrev-table 'rpm-spec-mode-abbrev-table ())
-
-;;------------------------------------------------------------
-
-(add-hook 'rpm-spec-mode-new-file-hook 'rpm-spec-initialize)
-
-;;;###autoload
-(defun rpm-spec-mode ()
-  "Major mode for editing RPM spec files.
-This is much like C mode except for the syntax of comments.  It uses
-the same keymap as C mode and has the same variables for customizing
-indentation.  It has its own abbrev table and its own syntax table.
-
-Turning on RPM spec mode calls the value of the variable `rpm-spec-mode-hook'
-with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (condition-case nil
-      (require 'shindent)
-    (error
-     (require 'sh-script)))
-  (require 'cc-mode)
-  (use-local-map rpm-spec-mode-map)
-  (setq major-mode 'rpm-spec-mode)
-  (rpm-update-mode-name)
-  (setq local-abbrev-table rpm-spec-mode-abbrev-table)
-  (set-syntax-table rpm-spec-mode-syntax-table)
-
-  (require 'easymenu)
-  (easy-menu-define rpm-spec-call-menu rpm-spec-mode-map
-                    "Post menu for `rpm-spec-mode'." rpm-spec-mode-menu)
-  (easy-menu-add rpm-spec-mode-menu)
-
-  (if (and (= (buffer-size) 0) rpm-spec-initialize-sections)
-      (run-hooks 'rpm-spec-mode-new-file-hook))
-
-  (if (not (executable-find "rpmbuild"))
-      (progn
-	(setq rpm-spec-build-command "rpm")
-	(setq rpm-spec-nobuild-option "--test")))
-  
-  (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 'indent-line-function)
-;  (setq indent-line-function 'c-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+ *")
-;  (make-local-variable 'comment-indent-function)
-;  (setq comment-indent-function 'c-comment-indent)
-  ;;Initialize font lock for GNU emacs.
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(rpm-spec-font-lock-keywords nil t))
-  (run-hooks 'rpm-spec-mode-hook))
-
-(defun rpm-command-filter (process string)
-  "Filter to process normal output."
-  (save-excursion
-    (set-buffer (process-buffer process))
-    (save-excursion
-      (goto-char (process-mark process))
-      (insert-before-markers string)
-      (set-marker (process-mark process) (point)))))
-
-;;------------------------------------------------------------
-
-(defun rpm-add-change-log-entry (&optional change-log-entry)
-  "Find change log and add an entry for today."
-  (interactive "sChange log entry: ")
-  (save-excursion
-    (rpm-goto-section "changelog")
-    (let* ((address (or rpm-spec-user-mail-address (user-mail-address)))
-           (fullname (or rpm-spec-user-full-name (user-full-name)))
-           (string (concat "* " (substring (current-time-string) 0 11)
-                           (substring (current-time-string) -4) " "
-                           fullname " <" address ">"
-                           (and rpm-spec-insert-changelog-version
-                                (concat " - " (rpm-find-spec-version t))))))
-      (if (not (search-forward string nil t))
-          (insert "\n" string "\n")
-        (forward-line 2))
-      (insert "- " change-log-entry "\n"))))
-
-;;------------------------------------------------------------
-
-(defun rpm-insert-f (&optional filetype filename)
-  "Insert new \"%files\" entry."
-  (save-excursion
-    (and (rpm-goto-section "files") (rpm-end-of-section))
-    (if (or (eq filename 1) (not filename))
-        (insert (read-file-name
-                 (concat filetype "filename: ") "" "" nil) "\n")
-      (insert filename "\n"))
-    (forward-line -1)
-    (if rpm-spec-add-attr
-        (let ((rpm-default-mode rpm-default-umask))
-          (insert "%attr(" rpm-default-mode ", " rpm-default-owner ", "
-                  rpm-default-group ") ")))
-    (insert filetype)))
-
-(defun rpm-insert-file (&optional filename)
-  "Insert regular file."
-  (interactive "p")
-  (rpm-insert-f "" filename))
-
-(defun rpm-insert-config (&optional filename)
-  "Insert config file."
-  (interactive "p")
-  (rpm-insert-f "%config " filename))
-
-(defun rpm-insert-doc (&optional filename)
-  "Insert doc file."
-  (interactive "p")
-  (rpm-insert-f "%doc " filename))
-
-(defun rpm-insert-ghost (&optional filename)
-  "Insert ghost file."
-  (interactive "p")
-  (rpm-insert-f "%ghost " filename))
-
-(defun rpm-insert-dir (&optional dirname)
-  "Insert directory."
-  (interactive "p")
-  (rpm-insert-f "%dir " dirname))
-
-(defun rpm-insert-docdir (&optional dirname)
-  "Insert doc directory."
-  (interactive "p")
-  (rpm-insert-f "%docdir " dirname))
-
-;;------------------------------------------------------------
-(defun rpm-completing-read (prompt table &optional pred require init hist)
-  "Read from the minibuffer, with completion.
-Like `completing-read', but the variable `rpm-spec-completion-ignore-case'
-controls whether case is significant."
-  (let ((completion-ignore-case rpm-spec-completion-ignore-case))
-    (completing-read prompt table pred require init hist)))
-
-(defun rpm-insert (&optional what file-completion)
-  "Insert given tag.  Use file-completion if argument is t."
-  (beginning-of-line)
-  (if (not what)
-      (setq what (rpm-completing-read "Tag: " rpm-tags-list)))
-  (if (string-match "^%" what)
-      (setq read-text (concat "Packagename for " what ": ")
-            insert-text (concat what " "))
-    (setq read-text (concat what ": ")
-          insert-text (concat what ": ")))
-  (cond
-   ((string-equal what "Group")
-    (rpm-insert-group))
-   ((string-equal what "Source")
-    (rpm-insert-n "Source"))
-   ((string-equal what "Patch")
-    (rpm-insert-n "Patch"))
-   (t
-    (if file-completion
-        (insert insert-text (read-file-name (concat read-text) "" "" nil) "\n")
-      (insert insert-text (read-from-minibuffer (concat read-text)) "\n")))))
-
-(defun rpm-topdir ()
-  (or
-   (getenv "RPM")
-   (getenv "rpm")
-   (if (file-directory-p "~/rpm") "~/rpm/")
-   (if (file-directory-p "~/RPM") "~/RPM/")
-   (if (file-directory-p "/usr/src/redhat/") "/usr/src/redhat/")
-   "/usr/src/RPM"))
-
-(defun rpm-insert-n (what &optional arg)
-  "Insert given tag with possible number."
-  (save-excursion
-    (goto-char (point-max))
-    (if (search-backward-regexp (concat "^" what "\\([0-9]*\\):") nil t)
-        (let ((release (1+ (string-to-int (match-string 1)))))
-          (forward-line 1)
-          (let ((default-directory (concat (rpm-topdir) "/SOURCES/")))
-            (insert what (int-to-string release) ": "
-                    (read-file-name (concat what "file: ") "" "" nil) "\n")))
-      (goto-char (point-min))
-      (rpm-end-of-section)
-      (insert what ": " (read-from-minibuffer (concat what "file: ")) "\n"))))
-
-(defun rpm-change (&optional what arg)
-  "Update given tag."
-  (save-excursion
-    (if (not what)
-        (setq what (rpm-completing-read "Tag: " rpm-tags-list)))
-    (cond
-     ((string-equal what "Group")
-      (rpm-change-group))
-     ((string-equal what "Source")
-      (rpm-change-n "Source"))
-     ((string-equal what "Patch")
-      (rpm-change-n "Patch"))
-     (t
-      (goto-char (point-min))
-      (if (search-forward-regexp (concat "^" what ":\\s-*\\(.*\\)$") nil t)
-          (replace-match
-           (concat what ": " (read-from-minibuffer
-                              (concat "New " what ": ") (match-string 1))))
-        (message (concat what " tag not found...")))))))
-
-(defun rpm-change-n (what &optional arg)
-  "Change given tag with possible number."
-  (save-excursion
-    (goto-char (point-min))
-    (let ((number (read-from-minibuffer (concat what " number: "))))
-      (if (search-forward-regexp
-           (concat "^" what number ":\\s-*\\(.*\\)") nil t)
-          (let ((default-directory (concat (rpm-topdir) "/SOURCES/")))
-            (replace-match
-             (concat what number ": "
-                     (read-file-name (concat "New " what number " file: ")
-                                     "" "" nil (match-string 1)))))
-        (message (concat what " number \"" number "\" not found..."))))))
-
-(defun rpm-insert-group (group)
-  "Insert Group tag."
-  (interactive (list (rpm-completing-read "Group: " rpm-group-tags-list)))
-  (beginning-of-line)
-  (insert "Group: " group "\n"))
-
-(defun rpm-change-group (&optional arg)
-  "Update Group tag."
-  (interactive "p")
-  (save-excursion
-    (goto-char (point-min))
-    (if (search-forward-regexp "^Group: \\(.*\\)$" nil t)
-        (replace-match
-         (concat "Group: "
-                 (insert (rpm-completing-read "Group: " rpm-group-tags-list
-                                              nil nil (match-string 1)))))
-      (message "Group tag not found..."))))
-
-(defun rpm-insert-tag (&optional arg)
-  "Insert or change a tag."
-  (interactive "p")
-  (if current-prefix-arg
-      (rpm-change)
-    (rpm-insert)))
-
-(defun rpm-change-tag (&optional arg)
-  "Change a tag."
-  (interactive "p")
-  (rpm-change))
-
-(defun rpm-insert-packager (&optional arg)
-  "Insert Packager tag."
-  (interactive "p")
-  (beginning-of-line)
-  (insert "Packager: " (or rpm-spec-user-full-name (user-full-name))
-          " <" (or rpm-spec-user-mail-address (user-mail-address)) ">\n"))
-
-(defun rpm-change-packager (&optional arg)
-  "Update Packager tag."
-  (interactive "p")
-  (rpm-change "Packager"))
-
-;;------------------------------------------------------------
-
-(defun rpm-current-section nil
-  (interactive)
-  (save-excursion
-    (rpm-forward-section)
-    (rpm-backward-section)
-    (if (bobp) "preamble"
-      (buffer-substring (match-beginning 1) (match-end 1)))))
-
-(defun rpm-backward-section nil
-  "Move backward to the beginning of the previous section.
-Go to beginning of previous section."
-  (interactive)
-  (or (re-search-backward rpm-section-regexp nil t)
-      (goto-char (point-min))))
-
-(defun rpm-beginning-of-section nil
-  "Move backward to the beginning of the current section.
-Go to beginning of current section."
-  (interactive)
-  (or (and (looking-at rpm-section-regexp) (point))
-      (re-search-backward rpm-section-regexp nil t)
-      (goto-char (point-min))))
-
-(defun rpm-forward-section nil
-  "Move forward to the beginning of the next section."
-  (interactive)
-  (forward-char)
-  (if (re-search-forward rpm-section-regexp nil t)
-      (progn (forward-line 0) (point))
-    (goto-char (point-max))))
-
-(defun rpm-end-of-section nil
-  "Move forward to the end of this section."
-  (interactive)
-  (forward-char)
-  (if (re-search-forward rpm-section-regexp nil t)
-      (forward-line -1)
-    (goto-char (point-max)))
-;;  (while (or (looking-at paragraph-separate) (looking-at "^\\s-*#"))
-  (while (looking-at "^\\s-*\\($\\|#\\)")
-    (forward-line -1))
-  (forward-line 1)
-  (point))
-
-(defun rpm-goto-section (section)
-  "Move point to the beginning of the specified section;
-leave point at previous location."
-  (interactive (list (rpm-completing-read "Section: " rpm-section-list)))
-  (push-mark)
-  (goto-char (point-min))
-  (or
-   (equal section "preamble")
-   (re-search-forward (concat "^%" section "\\b") nil t)
-   (let ((s (cdr rpm-sections)))
-     (while (not (equal section (car s)))
-       (re-search-forward (concat "^%" (car s) "\\b") nil t)
-       (setq s (cdr s)))
-     (if (re-search-forward rpm-section-regexp nil t)
-         (forward-line -1) (goto-char (point-max)))
-     (insert "\n%" section "\n"))))
-
-(defun rpm-mouse-goto-section (&optional section)
-  (interactive
-   (x-popup-menu
-    nil
-    (list "sections"
-          (cons "Sections" (mapcar (lambda (e) (list e e)) rpm-sections))
-          (cons "Scripts" (mapcar (lambda (e) (list e e)) rpm-scripts))
-          )))
-  ;; If user doesn't pick a section, exit quietly.
-  (and section
-       (if (member section rpm-sections)
-           (rpm-goto-section section)
-         (goto-char (point-min))
-         (or (re-search-forward (concat "^%" section "\\b") nil t)
-             (and (re-search-forward "^%files\\b" nil t) (forward-line -1))
-             (goto-char (point-max))))))
-
-(defun rpm-insert-true-prefix ()
-  (interactive)
-  (insert "%{prefix}"))
-
-;;------------------------------------------------------------
-
-(defun rpm-build (buildoptions)
-  "Build this RPM package."
-  (if (and (buffer-modified-p)
-           (y-or-n-p (format "Buffer %s modified, save it? " (buffer-name))))
-      (save-buffer))
-  (setq rpm-buffer-name
-        (concat "*" rpm-spec-build-command " " buildoptions " "
-                (file-name-nondirectory buffer-file-name) "*"))
-  (rpm-process-check rpm-buffer-name)
-  (if (get-buffer rpm-buffer-name)
-      (kill-buffer rpm-buffer-name))
-  (create-file-buffer rpm-buffer-name)
-  (display-buffer rpm-buffer-name)
-  (setq buildoptions (list buildoptions buffer-file-name))
-  (if (or rpm-spec-short-circuit rpm-spec-nobuild)
-      (setq rpm-no-gpg t))
-  (if rpm-spec-rmsource
-      (setq buildoptions (cons "--rmsource" buildoptions)))
-  (if rpm-spec-clean
-      (setq buildoptions (cons "--clean" buildoptions)))
-  (if rpm-spec-short-circuit
-      (setq buildoptions (cons "--short-circuit" buildoptions)))
-  (if (and (not (equal rpm-spec-timecheck "0"))
-           (not (equal rpm-spec-timecheck "")))
-      (setq buildoptions (cons "--timecheck" (cons rpm-spec-timecheck
-                                                   buildoptions))))
-  (if (not (equal rpm-spec-buildroot ""))
-      (setq buildoptions (cons "--buildroot" (cons rpm-spec-buildroot
-                                                   buildoptions))))
-  (if (not (equal rpm-spec-target ""))
-      (setq buildoptions (cons "--target" (cons rpm-spec-target
-                                                buildoptions))))
-  (if rpm-spec-nobuild
-      (setq buildoptions (cons rpm-spec-nobuild-option buildoptions)))
-  (if rpm-spec-quiet
-      (setq buildoptions (cons "--quiet" buildoptions)))
-  (if rpm-spec-nodeps
-      (setq buildoptions (cons "--nodeps" buildoptions)))
-  (if (and rpm-spec-sign-gpg (not rpm-no-gpg))
-      (setq buildoptions (cons "--sign" buildoptions)))
-  (save-excursion
-    (set-buffer (get-buffer rpm-buffer-name))
-    (and rpm-spec-use-compilation-mode
-         (fboundp 'compilation-mode)
-         (compilation-mode))
-    (goto-char (point-max)))
-  (let* ((process-environment (cons "EMACS=t" process-environment))
-         (process
-          (apply 'start-process rpm-spec-build-command rpm-buffer-name
-                 rpm-spec-build-command buildoptions)))
-    (if (and rpm-spec-sign-gpg (not rpm-no-gpg))
-        (let ((rpm-passwd-cache (read-passwd "GPG passphrase: ")))
-          (process-send-string process (concat rpm-passwd-cache "\n"))))
-    (set-process-filter process 'rpm-command-filter)))
-
-(defun rpm-build-prepare (&optional arg)
-  "Run a `rpmbuild -bp'."
-  (interactive "p")
-  (if rpm-spec-short-circuit
-      (message (concat "Cannot run `" rpm-spec-build-command
-		       " -bp' with --short-circuit"))
-    (setq rpm-no-gpg t)
-    (rpm-build "-bp")))
-
-(defun rpm-list-check (&optional arg)
-  "Run a `rpmbuild -bl'."
-  (interactive "p")
-  (if rpm-spec-short-circuit
-      (message (concat "Cannot run `" rpm-spec-build-command
-		       " -bl' with --short-circuit"))
-    (setq rpm-no-gpg t)
-    (rpm-build "-bl")))
-
-(defun rpm-build-compile (&optional arg)
-  "Run a `rpmbuild -bc'."
-  (interactive "p")
-  (setq rpm-no-gpg t)
-  (rpm-build "-bc"))
-
-(defun rpm-build-install (&optional arg)
-  "Run a `rpmbuild -bi'."
-  (interactive "p")
-  (setq rpm-no-gpg t)
-  (rpm-build "-bi"))
-
-(defun rpm-build-binary (&optional arg)
-  "Run a `rpmbuild -bb'."
-  (interactive "p")
-  (if rpm-spec-short-circuit
-      (message (concat "Cannot run `" rpm-spec-build-command
-		       " -bb' with --short-circuit"))
-    (setq rpm-no-gpg nil)
-    (rpm-build "-bb")))
-
-(defun rpm-build-source (&optional arg)
-  "Run a `rpmbuild -bs'."
-  (interactive "p")
-  (if rpm-spec-short-circuit
-      (message (concat "Cannot run `" rpm-spec-build-command
-		       " -bs' with --short-circuit"))
-    (setq rpm-no-gpg nil)
-    (rpm-build "-bs")))
-
-(defun rpm-build-all (&optional arg)
-  "Run a `rpmbuild -ba'."
-  (interactive "p")
-  (if rpm-spec-short-circuit
-      (message (concat "Cannot run `" rpm-spec-build-command
-		       " -ba' with --short-circuit"))
-    (setq rpm-no-gpg nil)
-    (rpm-build "-ba")))
-
-(defun rpm-process-check (buffer)
-  "Check if BUFFER has a running process.
-If so, give the user the choice of aborting the process or the current
-command."
-  (let ((process (get-buffer-process (get-buffer buffer))))
-    (if (and process (eq (process-status process) 'run))
-        (if (yes-or-no-p (concat "Process `" (process-name process)
-                                 "' running.  Kill it? "))
-            (delete-process process)
-          (error "Cannot run two simultaneous processes ...")))))
-
-;;------------------------------------------------------------
-
-(defun rpm-toggle-short-circuit (&optional arg)
-  "Toggle `rpm-spec-short-circuit'."
-  (interactive "p")
-  (setq rpm-spec-short-circuit (not rpm-spec-short-circuit))
-  (rpm-update-mode-name)
-  (message (concat "Turned `--short-circuit' "
-                   (if rpm-spec-short-circuit "on" "off") ".")))
-
-(defun rpm-toggle-rmsource (&optional arg)
-  "Toggle `rpm-spec-rmsource'."
-  (interactive "p")
-  (setq rpm-spec-rmsource (not rpm-spec-rmsource))
-  (rpm-update-mode-name)
-  (message (concat "Turned `--rmsource' "
-                   (if rpm-spec-rmsource "on" "off") ".")))
-
-(defun rpm-toggle-clean (&optional arg)
-  "Toggle `rpm-spec-clean'."
-  (interactive "p")
-  (setq rpm-spec-clean (not rpm-spec-clean))
-  (rpm-update-mode-name)
-  (message (concat "Turned `--clean' "
-                   (if rpm-spec-clean "on" "off") ".")))
-
-(defun rpm-toggle-nobuild (&optional arg)
-  "Toggle `rpm-spec-nobuild'."
-  (interactive "p")
-  (setq rpm-spec-nobuild (not rpm-spec-nobuild))
-  (rpm-update-mode-name)
-  (message (concat "Turned `" rpm-spec-nobuild-option "' "
-                   (if rpm-spec-nobuild "on" "off") ".")))
-
-(defun rpm-toggle-quiet (&optional arg)
-  "Toggle `rpm-spec-quiet'."
-  (interactive "p")
-  (setq rpm-spec-quiet (not rpm-spec-quiet))
-  (rpm-update-mode-name)
-  (message (concat "Turned `--quiet' "
-                   (if rpm-spec-quiet "on" "off") ".")))
-
-(defun rpm-toggle-sign-gpg (&optional arg)
-  "Toggle `rpm-spec-sign-gpg'."
-  (interactive "p")
-  (setq rpm-spec-sign-gpg (not rpm-spec-sign-gpg))
-  (rpm-update-mode-name)
-  (message (concat "Turned `--sign' "
-                   (if rpm-spec-sign-gpg "on" "off") ".")))
-
-(defun rpm-toggle-add-attr (&optional arg)
-  "Toggle `rpm-spec-add-attr'."
-  (interactive "p")
-  (setq rpm-spec-add-attr (not rpm-spec-add-attr))
-  (rpm-update-mode-name)
-  (message (concat "Default add \"attr\" entry turned "
-                   (if rpm-spec-add-attr "on" "off") ".")))
-
-(defun rpm-toggle-nodeps (&optional arg)
-  "Toggle `rpm-spec-nodeps'."
-  (interactive "p")
-  (setq rpm-spec-nodeps (not rpm-spec-nodeps))
-  (rpm-update-mode-name)
-  (message (concat "Turned `--nodeps' "
-                   (if rpm-spec-nodeps "on" "off") ".")))
-
-(defun rpm-update-mode-name ()
-  "Update `mode-name' according to values set."
-  (setq mode-name "RPM-SPEC")
-  (setq modes (concat (if rpm-spec-add-attr      "A")
-                      (if rpm-spec-clean         "C")
-                      (if rpm-spec-nodeps        "D")
-                      (if rpm-spec-sign-gpg      "G")
-                      (if rpm-spec-nobuild       "N")
-                      (if rpm-spec-rmsource      "R")
-                      (if rpm-spec-short-circuit "S")
-		      (if rpm-spec-quiet         "Q")
-                      ))
-  (if (not (equal modes ""))
-      (setq mode-name (concat mode-name ":" modes))))
-
-;;------------------------------------------------------------
-
-(defun rpm-change-timecheck-option (&optional arg)
-  "Change the value for timecheck."
-  (interactive "p")
-  (setq rpm-spec-timecheck
-        (read-from-minibuffer "New timecheck: " rpm-spec-timecheck)))
-
-(defun rpm-change-buildroot-option (&optional arg)
-  "Change the value for buildroot."
-  (interactive "p")
-  (setq rpm-spec-buildroot
-        (read-from-minibuffer "New buildroot: " rpm-spec-buildroot)))
-
-(defun rpm-change-target-option (&optional arg)
-  "Change the value for target."
-  (interactive "p")
-  (setq rpm-spec-target
-        (read-from-minibuffer "New target: " rpm-spec-target)))
-
-(defun rpm-files-umask (&optional arg)
-  "Change the default umask for files."
-  (interactive "p")
-  (setq rpm-default-umask
-        (read-from-minibuffer "Default file umask: " rpm-default-umask)))
-
-(defun rpm-files-owner (&optional arg)
-  "Change the default owner for files."
-  (interactive "p")
-  (setq rpm-default-owner
-        (read-from-minibuffer "Default file owner: " rpm-default-owner)))
-
-(defun rpm-files-group (&optional arg)
-  "Change the source directory."
-  (interactive "p")
-  (setq rpm-default-group
-        (read-from-minibuffer "Default file group: " rpm-default-group)))
-
-(defun rpm-increase-release-tag (&optional arg)
-  "Increase the release tag by 1."
-  (interactive "p")
-  (save-excursion
-    (goto-char (point-min))
-    (if (search-forward-regexp "^Release:[ \t]*\\([0-9]+\\)\\(.*\\)" nil t)
-        (let ((release (1+ (string-to-int (match-string 1)))))
-          (setq release (concat (int-to-string release) (match-string 2)))
-          (replace-match (concat "Release: " release))
-          (message (concat "Release tag changed to " release ".")))
-      (if (search-forward-regexp "^Release:[ \t]*%{?\\([^}]*\\)}?$" nil t)
-          (rpm-increase-release-with-macros)
-        (message "No Release tag found...")))))
-
-;;------------------------------------------------------------
-
-(defun rpm-spec-field-value (field max)
-  "Get the value of FIELD, searching up to buffer position MAX.
-See `search-forward-regexp'."
-  (save-excursion
-    (ignore-errors
-      (let ((str
-             (progn
-               (goto-char (point-min))
-               (search-forward-regexp (concat
-                                       field ":[ \t]*\\(.*?\\)[ \t]*$") max)
-               (match-string 1))))
-        ;; Try to expand macros
-        (if (string-match "\\(%{?\\(\\?\\)?\\)\\([a-zA-Z0-9_]*\\)\\(}?\\)" str)
-            (let ((start-string (substring str 0 (match-beginning 1)))
-                  (end-string (substring str (match-end 4))))
-              (if (progn
-                    (goto-char (point-min))
-                    (search-forward-regexp
-                     (concat "%\\(define\\|global\\)[ \t]+"
-                             (match-string 3 str)
-                             "[ \t]+\\(.*\\)") nil t))
-                  ;; Got it - replace.
-                  (concat start-string (match-string 2) end-string)
-                (if (match-string 2 str)
-                    ;; Conditionally evaluated macro - remove it.
-                    (concat start-string end-string)
-                  ;; Leave as is.
-                  str)))
-          str)))))
-
-(defun rpm-find-spec-version (&optional with-epoch)
-  "Get the version string.
-If WITH-EPOCH is non-nil, the string contains the Epoch/Serial value,
-if one is present in the file."
-  (save-excursion
-    (goto-char (point-min))
-    (let* ((max (search-forward-regexp rpm-section-regexp))
-           (version (rpm-spec-field-value "Version" max))
-           (release (rpm-spec-field-value "Release" max))
-           (epoch   (rpm-spec-field-value "Epoch"   max)) )
-      (when (and version (< 0 (length version)))
-        (unless epoch (setq epoch (rpm-spec-field-value "Serial" max)))
-        (concat (and with-epoch epoch (concat epoch ":"))
-                version
-                (and release (concat "-" release)))))))
-
-(defun rpm-increase-release-with-macros ()
-  (save-excursion
-    (let ((str
-           (progn
-             (goto-char (point-min))
-             (search-forward-regexp (concat "Release:[ \t]*\\(.+\\).*$") nil)
-             (match-string 1))))
-      (let ((inrel
-             (if (string-match "%{?\\([^}]*\\)}?$" str)
-                 (progn
-                   (goto-char (point-min))
-                   (setq macros (substring str (match-beginning 1)
-                                           (match-end 1)))
-                   (search-forward-regexp
-                    (concat "%define[ \t]+" macros
-                            "[ \t]+\\(\\([0-9]\\|\\.\\)+\\)\\(.*\\)"))
-                   (concat macros " " (int-to-string (1+ (string-to-int
-                                                          (match-string 1))))
-                           (match-string 3)))
-               str)))
-        (setq dinrel inrel)
-        (replace-match (concat "%define " dinrel))
-        (message (concat "Release tag changed to " dinrel "."))))))
-
-;;------------------------------------------------------------
-
-(defun rpm-spec-initialize ()
-  "Create a default spec file if one does not exist or is empty."
-  (let (file name version (release rpm-spec-default-release))
-    (setq file (if (buffer-file-name)
-                   (file-name-nondirectory (buffer-file-name))
-                 (buffer-name)))
-    (cond
-     ((eq (string-match "\\(.*\\)-\\([^-]*\\)-\\([^-]*\\).spec" file) 0)
-      (setq name (match-string 1 file))
-      (setq version (match-string 2 file))
-      (setq release (match-string 3 file)))
-     ((eq (string-match "\\(.*\\)-\\([^-]*\\).spec" file) 0)
-      (setq name (match-string 1 file))
-      (setq version (match-string 2 file)))
-     ((eq (string-match "\\(.*\\).spec" file) 0)
-      (setq name (match-string 1 file))))
-
-    (if rpm-spec-indent-heading-values
-	(insert
-	 "Summary:        "
-	 "\nName:           " (or name "")
-	 "\nVersion:        " (or version "")
-	 "\nRelease:        " (or release "")
-	 (if rpm-spec-default-epoch
-	     (concat "\nEpoch:          "
-		     (int-to-string rpm-spec-default-epoch))
-	   "")
-	 "\nLicense:        "
-	 "\nGroup:          "
-	 "\nURL:            "
-	 "\nSource0:        %{name}-%{version}.tar.gz"
-	 "\nBuildRoot:      " rpm-spec-default-buildroot)
-      (insert
-       "Summary: "
-       "\nName: " (or name "")
-       "\nVersion: " (or version "")
-       "\nRelease: " (or release "")
-       (if rpm-spec-default-epoch
-	   (concat "\nEpoch: " (int-to-string rpm-spec-default-epoch))
-	 "")
-       "\nLicense: "
-       "\nGroup: "
-       "\nURL: "
-       "\nSource0: %{name}-%{version}.tar.gz"
-       "\nBuildRoot: " rpm-spec-default-buildroot))
-
-    (insert
-     "\n\n%description\n"
-     "\n%prep"
-     "\n%setup -q"
-     "\n\n%build\n"
-     (or rpm-spec-default-build-section "")
-     "\n%install\n"
-     (or rpm-spec-default-install-section "")
-     "\n%clean\n"
-     (or rpm-spec-default-clean-section "")
-     "\n\n%files"
-     "\n%defattr(-,root,root,-)"
-     "\n%doc\n"
-     "\n\n%changelog\n")
-
-    (end-of-line 1)
-    (rpm-add-change-log-entry "Initial build.")))
-
-;;------------------------------------------------------------
-
-(defun rpm-about-rpm-spec-mode (&optional arg)
-  "About `rpm-spec-mode'."
-  (interactive "p")
-  (message
-   (concat "rpm-spec-mode version "
-           rpm-spec-mode-version
-           " by Stig Bjørlykke, ")))
-
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.spec\\(\\.in\\)?$" . rpm-spec-mode))
-
-(provide 'rpm-spec-mode)
-
-;;; rpm-spec-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/simula.el b/xemacs-packages/lisp/prog-modes/simula.el
deleted file mode 100644
index 6380c158..00000000
--- a/xemacs-packages/lisp/prog-modes/simula.el
+++ /dev/null
@@ -1,1330 +0,0 @@
-;;; simula.el --- SIMULA 87 code editing commands for Emacs
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Hans Henrik Eriksen 
-;; Maintainer: simula-mode@ifi.uio.no
-;; Version: 0.992
-;; Adapted-By: ESR
-;; Keywords: languages
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.30.
-
-;;; Commentary:
-
-;; A major mode for editing the Simula language.  It knows about Simula
-;; syntax and standard indentation commands.  It also provides convenient
-;; abbrevs for Simula keywords.
-;;
-;; Hans Henrik Eriksen (the author) may be reached at:
-;;         Institutt for informatikk,
-;;         Universitetet i Oslo
-
-;;; Code:
-
-(provide 'simula-mode)
-
-(defgroup simula nil
-  "SIMULA 87 code editing commands for Emacs."
-  :group 'languages)
-
-
-(defcustom simula-tab-always-indent nil
-  "*Non-nil means TAB in SIMULA mode should always reindent the current line.
-Otherwise TAB indents only when point is within
-the run of whitespace at the beginning of the line."
-  :type 'boolean
-  :group 'simula)
-
-(defcustom simula-indent-level 3
-  "*Indentation of SIMULA statements with respect to containing block."
-  :type 'integer
-  :group 'simula)
-
-(defcustom simula-substatement-offset 3
-  "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE."
-  :type 'integer
-  :group 'simula)
-
-(defcustom simula-continued-statement-offset 3
-  "*Extra indentation for lines not starting a statement or substatement.
-If value is a list, each line in a multipleline continued statement
-will have the car of the list extra indentation with respect to
-the previous line of the statement."
-  :type 'integer
-  :group 'simula)
-
-(defcustom simula-label-offset -4711
-  "*Offset of SIMULA label lines relative to usual indentation."
-  :type 'integer
-  :group 'simula)
-
-(defcustom simula-if-indent '(0 . 0)
-  "*Extra indentation of THEN and ELSE with respect to the starting IF.
-Value is a cons cell, the car is extra THEN indentation and the cdr
-extra ELSE indentation.  IF after ELSE is indented as the starting IF."
-  :type '(cons (integer :tag "THEN")
-	       (integer :tag "ELSE"))
-  :group 'simula)
-
-(defcustom simula-inspect-indent '(0 . 0)
-  "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
-Value is a cons cell, the car is extra WHEN indentation
-and the cdr extra OTHERWISE indentation."
-  :type '(cons (integer :tag "WHEN")
-	       (integer :tag "OTHERWISE"))
-  :group 'simula)
-
-(defcustom simula-electric-indent nil
-  "*Non-nil means `simula-indent-line' function may reindent previous line."
-  :type 'boolean
-  :group 'simula)
-
-(defcustom simula-abbrev-keyword 'upcase
-  "*Specify how to convert case for SIMULA keywords.
-Value is one of the symbols `upcase', `downcase', `capitalize',
-\(as in) `abbrev-table' or nil if they should not be changed."
-  :type '(choice (const upcase) (const downcase) (const capitalize)
-		 (const abbrev-table) (const nil))
-  :group 'simula)
-
-(defcustom simula-abbrev-stdproc 'abbrev-table
-  "*Specify how to convert case for standard SIMULA procedure and class names.
-Value is one of the symbols `upcase', `downcase', `capitalize',
-\(as in) `abbrev-table', or nil if they should not be changed."
-  :type '(choice (const upcase) (const downcase) (const capitalize)
-		 (const abbrev-table) (const nil))
-  :group 'simula)
-
-(defcustom simula-abbrev-file nil
-  "*File with extra abbrev definitions for use in SIMULA mode.
-These are used together with the standard abbrev definitions for SIMULA.
-Please note that the standard definitions are required
-for SIMULA mode to function correctly."
-  :type '(choice (const :tag "None")
-		 file)
-  :group 'simula)
-
-(defvar simula-mode-syntax-table nil
-  "Syntax table in SIMULA mode buffers.")
-
-(if simula-mode-syntax-table
-    ()
-  (setq simula-mode-syntax-table  (copy-syntax-table nil))
-  (modify-syntax-entry ?!  "<"    simula-mode-syntax-table)
-  (modify-syntax-entry ?$  "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?%  "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?'  "\""   simula-mode-syntax-table)
-  (modify-syntax-entry ?\( "()"   simula-mode-syntax-table)
-  (modify-syntax-entry ?\) ")("   simula-mode-syntax-table)
-  (modify-syntax-entry ?\; ">"    simula-mode-syntax-table)
-  (modify-syntax-entry ?\[ "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?\\ "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?\] "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?_  "w"    simula-mode-syntax-table)
-  (modify-syntax-entry ?\| "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?\{ "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?\} "."    simula-mode-syntax-table))
-
-(defvar simula-mode-map ()
-  "Keymap used in SIMULA mode.")
-
-(if simula-mode-map
-    ()
-  (setq simula-mode-map (make-sparse-keymap))
-  (define-key simula-mode-map "\C-c\C-u"   'simula-backward-up-level)
-  (define-key simula-mode-map "\C-c\C-p"   'simula-previous-statement)
-  (define-key simula-mode-map "\C-c\C-d"   'simula-forward-down-level)
-  (define-key simula-mode-map "\C-c\C-n"   'simula-next-statement)
-  ;(define-key simula-mode-map "\C-c\C-g"   'simula-goto-definition)
-  ;(define-key simula-mode-map "\C-c\C-h"   'simula-standard-help)
-  (define-key simula-mode-map ":"          'simula-electric-label)
-  (define-key simula-mode-map "\t"         'simula-indent-command))
-
-(defvar simula-mode-abbrev-table nil
-  "Abbrev table in SIMULA mode buffers")
-
-;;;###autoload
-(defun simula-mode ()
-  "Major mode for editing SIMULA code.
-\\{simula-mode-map}
-Variables controlling indentation style:
- simula-tab-always-indent
-    Non-nil means TAB in SIMULA mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- simula-indent-level
-    Indentation of SIMULA statements with respect to containing block.
- simula-substatement-offset
-    Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.
- simula-continued-statement-offset 3
-    Extra indentation for lines not starting a statement or substatement,
-    e.g. a nested FOR-loop.  If value is a list, each line in a multiple-
-    line continued statement will have the car of the list extra indentation
-    with respect to the previous line of the statement.
- simula-label-offset -4711
-    Offset of SIMULA label lines relative to usual indentation.
- simula-if-indent '(0 . 0)
-    Extra indentation of THEN and ELSE with respect to the starting IF.
-    Value is a cons cell, the car is extra THEN indentation and the cdr
-    extra ELSE indentation.  IF after ELSE is indented as the starting IF.
- simula-inspect-indent '(0 . 0)
-    Extra indentation of WHEN and OTHERWISE with respect to the
-    corresponding INSPECT.  Value is a cons cell, the car is
-    extra WHEN indentation and the cdr extra OTHERWISE indentation.
- simula-electric-indent nil
-    If this variable is non-nil, `simula-indent-line'
-    will check the previous line to see if it has to be reindented.
- simula-abbrev-keyword 'upcase
-    Determine how SIMULA keywords will be expanded.  Value is one of
-    the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table',
-    or nil if they should not be changed.
- simula-abbrev-stdproc 'abbrev-table
-    Determine how standard SIMULA procedure and class names will be
-    expanded. Value is one of the symbols `upcase', `downcase', `capitalize',
-    (as in) `abbrev-table', or nil if they should not be changed.
-
-Turning on SIMULA mode calls the value of the variable simula-mode-hook
-with no arguments, if that value is non-nil
-
-Warning: simula-mode-hook should not read in an abbrev file without calling
-the function simula-install-standard-abbrevs afterwards, preferably not
-at all."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map simula-mode-map)
-  (setq major-mode 'simula-mode)
-  (setq mode-name "SIMULA")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-  (make-local-variable 'end-comment-column)
-  (setq end-comment-column 75)
-  (set-syntax-table simula-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start "[ \t]*$\\|\\f")
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'simula-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "! ")
-  (make-local-variable 'comment-end)
-  (setq comment-end " ;")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "!+ *")
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments nil)
-  (make-local-variable 'comment-multi-line)
-  (setq comment-multi-line t)
-  (if simula-mode-abbrev-table
-      ()
-    (if simula-abbrev-file
-	(read-abbrev-file simula-abbrev-file)
-      (define-abbrev-table 'simula-mode-abbrev-table ()))
-    (let (abbrevs-changed)
-      (simula-install-standard-abbrevs)))
-  (setq local-abbrev-table simula-mode-abbrev-table)
-  (abbrev-mode 1)
-  (run-hooks 'simula-mode-hook))
-
-
-
-(defun simula-indent-line ()
-  "Indent this line as SIMULA code.
-If `simula-electric-indent' is non-nil, indent previous line if necessary."
-  (let ((origin (- (point-max) (point)))
-	(indent (simula-calculate-indent))
-	(case-fold-search t))
-    (unwind-protect
-	(progn
-	  ;;
-	  ;; manually expand abbrev on last line, if any
-	  ;;
-	  (end-of-line 0)
-	  (expand-abbrev)
-	  ;; now maybe we should reindent that line
-	  (if simula-electric-indent
-	      (progn
-		(beginning-of-line)
-		(skip-chars-forward " \t\f")
-		(if (and
-		     (looking-at
-		      "\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>")
-		     (not (simula-context)))
-		    ;; yes - reindent
-		    (let ((post-indent (simula-calculate-indent)))
-		      (if (eq (current-indentation) post-indent)
-			  ()
-			(delete-horizontal-space)
-			(indent-to post-indent)))))))
-      (goto-char (- (point-max) origin))
-      (if (eq (current-indentation) indent)
-	  (back-to-indentation)
-	(delete-horizontal-space)
-	(indent-to indent)))))
-
-
-(defun simula-indent-command (&optional whole-exp)
-  "Indent current line as SIMULA code, or insert TAB character.
-If `simula-tab-always-indent' is non-nil, always indent current line.
-Otherwise, indent only if point is before any non-whitespace
-character on the line.
-
-A numeric argument, regardless of its value, means indent rigidly
-all the lines of the SIMULA statement after point so that this line
-becomes properly indented.
-The relative indentation among the lines of the statement are preserved."
-  (interactive "P")
-  (let ((case-fold-search t))
-    (if (or whole-exp simula-tab-always-indent
-	    (save-excursion
-	      (skip-chars-backward " \t\f")
-	      (bolp)))
-	;; reindent current line
-	(let ((indent (save-excursion
-			(beginning-of-line)
-			(simula-calculate-indent)))
-	      (current (current-indentation))
-	      (origin (- (point-max) (point)))
-	      (bol (save-excursion
-		     (skip-chars-backward " \t\f")
-		     (bolp)))
-	      beg end)
-	  (unwind-protect
-	      (if (eq current indent)
-		  (if (save-excursion
-			(skip-chars-backward " \t\f")
-			(bolp))
-		      (back-to-indentation))
-		(beginning-of-line)
-		(delete-horizontal-space)
-		(indent-to indent))
-	    (if (not bol)
-		(goto-char (- (point-max) origin))))
-	  (setq origin (point))
-	  (if whole-exp
-	      (save-excursion
-		(beginning-of-line 2)
-		(setq beg (point))
-		(goto-char origin)
-		(simula-next-statement 1)
-		(setq end (point))
-		(if (and (> end beg) (not (eq indent current)))
-		    (indent-code-rigidly beg end (- indent current) "%")))))
-      (insert-tab))))
-
-
-(defun simula-context ()
-  "Returns value according to syntactic SIMULA context of point.
-    0    point inside COMMENT comment
-    1    point on SIMULA-compiler directive line
-    2    point inside END comment
-    3    point inside string
-    4    point inside character constant
-  nil    otherwise."
-  ;; first, find out if this is a compiler directive line
-  (if (save-excursion
-	(beginning-of-line)
-	(eq (following-char) ?%))
-      ;; YES - return 1
-      1
-    (save-excursion
-      ;; The current line is NOT a compiler directive line.
-      ;; Now, the strategy is to search backward to find a semicolon
-      ;; that is NOT inside a string. The point after semicolon MUST be
-      ;; outside a comment, since semicolons are comment-ending and
-      ;; comments are non-recursive. We take advantage of the fact
-      ;; that strings MUST end on the same line as they started, so
-      ;; that we can easily decide whether we are inside a string or not.
-      (let (return-value (origin (point)))
-	(skip-chars-backward "^;" (point-min))
-	;; found semicolon or beginning of buffer
-	(let (loopvalue (saved-point origin))
-	  (while (and (not (bobp))
-		      (if (progn
-			    (beginning-of-line)
-			    ;; compiler directive line? If so, cont searching..
-			    (eq (following-char) ?%))
-			  t
-			(while (< (point) saved-point)
-			  (skip-chars-forward "^;\"'")
-			  (forward-char 1)
-			  (cond
-			   ((eq (preceding-char) ?\;)
-			    (setq saved-point (point)))
-			   ((eq (preceding-char) ?\")
-			    (skip-chars-forward "^\";")
-			    (if (eq (following-char) ?\;)
-				(setq saved-point (point) loopvalue t)
-			      (forward-char 1)))
-			   (t
-			    (if (eq (following-char) ?')
-				(forward-char 1))
-			    (skip-chars-forward "^';")
-			    (if (eq (following-char) ?\;)
-				(setq saved-point (point) loopvalue t)
-			      (forward-char 1)))))
-			loopvalue))
-	    (backward-char 1)
-	    (skip-chars-backward "^;")
-	    (setq saved-point (point) loopvalue nil)))
-	;; Now we are CERTAIN that we are outside comments and strings.
-	;; The job now is to search forward again towards the origin
-	;; skipping directives, comments and strings correctly,
-	;; so that we know what context we are in when we find the origin.
-	(while (and
-		(< (point) origin)
-		(re-search-forward
-		 "\\\\|!\\|\"\\|'\\|^%\\|\\" origin 'move))
-	  (cond
-	   ((memq (preceding-char) '(?d ?D))
-	    (setq return-value 2)
-	    (while (and (memq (preceding-char) '(?d ?D)) (not return-value))
-	      (while (and (re-search-forward
-			   ";\\|\\\\|\\\\|\\\\|\\\\|^%"
-			   origin 'move)
-			  (eq (preceding-char) ?%))
-		(beginning-of-line 2)))
-	    (if (looking-at "[ \t\n\f]*\\(;\\|\\\\|\\\\|\\\\|\\\\)")
-		(setq return-value nil)))
-	   ((memq (preceding-char) '(?! ?t ?T))
-	    ; skip comment
-	    (setq return-value 0)
-	    (skip-chars-forward "^%;" origin)
-	    (while (and return-value (< (point) origin))
-	      (if (eq (following-char) ?\;)
-		  (setq return-value nil)
-		(if (bolp)
-		    (beginning-of-line 2)	; skip directive inside comment
-		  (forward-char 1))		; or single '%'
-		(skip-chars-forward "^%;" origin))))
-	   ((eq (preceding-char) ?\")
-	    (if (not (search-forward "\"" origin 'move))
-		(setq return-value 3)))
-	   ((eq (preceding-char) ?\')
-	    (if (or (eq (point) origin) (eobp))
-		(setq return-value 4)
-	      (forward-char 1)
-	      (if (not (search-forward "'" origin 'move))
-		  (setq return-value 4))))
-	   ;; compiler directive line - skip
-	   (t (beginning-of-line 2))))
-	return-value)
-      )))
-
-
-(defun simula-electric-label ()
-  "If this is a label that starts the line, reindent the line."
-  (interactive)
-  (expand-abbrev)
-  (insert ?:)
-  (let ((origin (- (point-max) (point)))
-	(case-fold-search t)
-	;; don't mix a label with an assignment operator := :-
-	;; therefore look at next typed character...
-	(next-char (if (fboundp 'next-command-event)
-                       (event-to-character (setq unread-command-events
-                                                 (list (next-command-event))))
-                       ;; FSFmacs
-                       (setq unread-command-events (list (read-event)))))
-	;(com-char last-command-char) -- unused
-        )
-    (unwind-protect
-	;; Problem: find out if character just read is a command char
-	;; that would insert something after ':' making it a label.
-	;; At least \n, \r (and maybe \t) falls into this category.
-	;; This is a real crock, it depends on traditional keymap
-	;; bindings, that is, printing characters doing self-insert,
-	;; and no other command sequence inserting '-' or '='.
-	;; simula-electric-label can be easily fooled...
-	(if (and (not (memq next-char '(?= ?-)))
-		 (or (memq next-char '(?\n ?\r))
-		     (and (eq next-char ?\t)
-			  simula-tab-always-indent)
-		     (not (memq (following-char) '(?= ?-))))
-		 (not (simula-context))
-		 ;; label?
-		 (progn
-		   (backward-char 1)
-		   (skip-chars-backward " \t\f")
-		   (skip-chars-backward "a-zA-Z0-9_")
-		   (if (looking-at "virtual\\>")
-		       nil
-		     (skip-chars-backward " \t\f")
-		     (bolp))))
-	    (let ((amount (simula-calculate-indent)))
-	      (delete-horizontal-space)
-	      (indent-to amount)))
-      (goto-char (- (point-max) origin)))))
-	
-
-(defun simula-backward-up-level (count)
-  "Move backward up COUNT block levels.
-If COUNT is negative, move forward up block level instead."
-  (interactive "p")
-  (let ((origin (point))
-	(case-fold-search t))
-    (condition-case ()
-	(if (> count 0)
-	    (while (> count 0)
-	      (re-search-backward "\\\\|\\")
-	      (if (not (simula-context))
-		  (setq count (if (memq (following-char) '(?b ?B))
-				  (1- count)
-				(1+ count)))))
-	  (while (< count 0)
-	    (re-search-forward "\\\\|\\")
-	    (backward-word 1)
-	    (if (not (simula-context))
-		(setq count (if (memq (following-char) '(?e ?E))
-				(1+ count)
-			      (1- count))))
-	    (backward-word -1)))
-      ;; If block level not found, jump back to origin and signal an error
-      (error (progn
-	       (goto-char origin)
-	       (error "No higher block level")))
-      (quit (progn
-	      (goto-char origin)
-	      (signal 'quit nil))))))
-
-
-(defun simula-forward-down-level (count)
-  "Move forward down COUNT block levels.
-If COUNT is negative, move backward down block level instead."
-  (interactive "p")
-  ;; When we search for a deeper block level, we must never
-  ;; get out of the block where we started -> count >= start-count
-  (let ((start-count count)
-	(origin (point))
-	(case-fold-search t))
-    (condition-case ()
-	(if (< count 0)
-	    (while (< count 0)
-	      (re-search-backward "\\\\|\\")
-	      (if (not (simula-context))
-		  (setq count (if (memq (following-char) '(?e ?E))
-				  (1+ count)
-				(1- count))))
-	      (if (< count start-count) (signal 'error nil)))
-	  (while (> count 0)
-	    (re-search-forward "\\\\|\\")
-	    (backward-word 1)
-	    (if (not (simula-context))
-		(setq count (if (memq (following-char) '(?b ?B))
-				(1- count)
-			      (1+ count))))
-	    (backward-word -1)
-	    ;; deeper level has to be found within starting block
-	    (if (> count start-count) (signal 'error nil))))
-      ;; If block level not found, jump back to origin and signal an error
-      (error (progn
-	       (goto-char origin)
-	       (error "No containing block level")))
-      (quit (progn
-	      (goto-char origin)
-	      (signal 'quit nil))))))
-
-     
-(defun simula-previous-statement (count)
-  "Move backward COUNT statements.
-If COUNT is negative, move forward instead."
-  (interactive "p")
-  (if (< count 0)
-      (simula-next-statement (- count))
-    (let (status
-	  (case-fold-search t)
-	  (origin (point)))
-      (condition-case ()
-	  (progn
-	    (simula-skip-comment-backward)
-	    (if (memq (preceding-char) '(?n ?N))
-		(progn
-		  (backward-word 1)
-		  (if (not (looking-at "\\"))
-		      (backward-word -1)))
-	      (if (eq (preceding-char) ?\;)
-		  (backward-char 1)))
-	    (while (and (natnump (setq count (1- count)))
-			(setq status (simula-search-backward
-				      ";\\|\\" nil 'move))))
-	    (if status
-		(progn
-		  (if (eq (following-char) ?\;)
-		      (forward-char 1)
-		    (backward-word -1))))
-	    (simula-skip-comment-forward))
-	(error (progn (goto-char origin)
-		      (error "Incomplete statement (too many ENDs)")))
-	(quit (progn (goto-char origin) (signal 'quit nil)))))))
-
-
-(defun simula-next-statement (count)
-  "Move forward COUNT statements.
-If COUNT is negative, move backward instead."
-  (interactive "p")
-  (if (< count 0)
-      (simula-previous-statement (- count))
-    (let (status
-	  (case-fold-search t)
-	  (origin (point)))
-      (condition-case ()
-	  (progn
-	    (simula-skip-comment-forward)
-	    (if (looking-at "\\") (forward-word 1))
-	    (while (and (natnump (setq count (1- count)))
-			(setq status (simula-search-forward
-				      ";\\|\\" (point-max) 'move))))
-	    (if (and status (/= (preceding-char) ?\;))
-		(progn
-		  (backward-word 1)
-		  (simula-skip-comment-backward))))
-	(error (progn (goto-char origin)
-		      (error "Incomplete statement (too few ENDs)")))
- 	(quit (progn (goto-char origin) (signal 'quit nil)))))))
-
-
-(defun simula-skip-comment-backward ()
-  "Search towards bob to find first char that is outside a comment."
-  (interactive)
-  (catch 'simula-out
-    (let (context)
-      (while t
-	(skip-chars-backward " \t\n\f")
-	(if (eq (preceding-char) ?\;)
-	    (save-excursion
-	      (backward-char 1)
-	      (setq context (simula-context)))
-	  (setq context (simula-context)))
-	(cond
-	 ((memq context '(nil 3 4))
-	  ;; check to see if we found a label
-	  (if (and (eq (preceding-char) ?:)
-		   (not (memq (following-char) '(?- ?=)))
-		   (save-excursion
-		     (skip-chars-backward ": \t\fa-zA-Z0-9_")
-		     (not (looking-at "virtual\\>"))))
-	      (skip-chars-backward ": \t\fa-zA-Z0-9_")
-	    (throw 'simula-out nil)))
-	 ((eq context 0)
-	  ;; since we are inside a comment, it must start somewhere!
-	  (while (and (re-search-backward "!\\|\\")
-		      (memq (simula-context) '(0 1)))))
-	 ((eq context 1)
-	  (end-of-line 0)
-	  (if (bobp)
-	      (throw 'simula-out nil)))
-	 ((eq context 2)
-	  ;; an END-comment must belong to an END
-	  (re-search-backward "\\")
-	  (forward-word 1)
-	  (throw 'simula-out nil))
-	 ;; should be impossible to get here..
-	 )))))
-
-
-(defun simula-skip-comment-forward ()
-  "Search towards eob to find first char that is outside a comment."
-  ;; this function assumes we start with point .outside a comment
-  (interactive)
-  (catch 'simula-out
-    (while t
-      (skip-chars-forward " \t\n\f")
-      (cond
-       ((looking-at "!\\|\\")
-	(search-forward ";" nil 'move))
-       ((and (bolp) (eq (following-char) ?%))
-	(beginning-of-line 2))
-       ((and (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]")
-	     (not (looking-at "virtual\\>")))
-	(skip-chars-forward "a-zA-Z0-9_ \t\f:"))
-       (t
-	(throw 'simula-out t))))))
-
-
-(defun simula-forward-up-level ()
-  (let ((continue-loop t)
-	(origin (point))
-	(case-fold-search t)
-	return-value
-	temp)
-    (while continue-loop
-      (if (re-search-backward "\\\\|\\" (point-min) 'move)
-	  (setq temp (simula-context)
-	      return-value (and (memq (preceding-char) '(?d ?D))
-				(memq temp '(nil 2)))
-	      continue-loop (and (not return-value)
-				 (simula-forward-up-level)))
-	(setq continue-loop nil)))
-    (if return-value
-	t
-      (goto-char origin)
-      nil)))
-
-
-(defun simula-calculate-indent ()
-  (save-excursion
-    (let ((where (simula-context))
-	  (origin (point))
-	  (indent 0)
-	  continued
-	  start-line
-	  temp
-	  found-end
-	  prev-cont)
-      (cond
-       ((eq where 0)
-	;;
-	;; Comment.
-	;; If comment started on previous non-blank line, indent to the
-	;; column where the comment started, else indent as that line.
-	;;
-	(skip-chars-backward " \t\n\f")
-	(while (and (not (bolp)) (eq (simula-context) 0))
-	  (re-search-backward "^\\|!\\|\\"))
-	(skip-chars-forward " \t\n\f")
-	(prog1
-	    (current-column)
-	  (goto-char origin)))
-       ;;
-       ;; Detect missing string delimiters
-       ;;
-       ((eq where 3)
-	(error "Inside string"))
-       ((eq where 4)
-	(error "Inside character constant"))
-       ;;
-       ;; check to see if inside ()'s
-       ;;
-       ((setq temp (simula-inside-parens))
-	temp)
-       ;;
-       ;; Calculate non-comment indentation
-       (t
-	;; first, find out if this line starts with something that needs
-	;; special indentation (END/IF/THEN/ELSE/WHEN/OTHERWISE or label)
-	;;
-	(skip-chars-forward " \t\f")
-	(cond
-	 ;;
-	 ;; END
-	 ;;
-	 ((looking-at "end\\>")
-	  (setq indent (- simula-indent-level)
-		found-end t))
-	 ;;
-	 ;; IF/THEN/ELSE
-	 ;;
-	 ((looking-at "if\\>\\|then\\>\\|else\\>")
-	  ;; search for the *starting* IF
-	  (cond
-	   ((memq (following-char) '(?T ?t))
-	    (setq indent (car simula-if-indent)))
-	   ((memq (following-char) '(?E ?e))
-	    (setq indent (cdr simula-if-indent)))
-	   (t
-	    (forward-word 1)
-	    (setq indent 0)))
-	  (simula-find-if))
-	 ;;
-	 ;; WHEN/OTHERWISE
-	 ;;
-	 ((looking-at "when\\>\\|otherwise\\>")
-	  ;; search for corresponding INSPECT
-	  (if (memq (following-char) '(?W ?w))
-	      (setq indent (car simula-inspect-indent))
-	    (setq indent (cdr simula-inspect-indent)))
-	  (simula-find-inspect))
-	 ;;
-	 ;; label:
-	 ;;
-	 ((and (not (looking-at "virtual\\>"))
-	       (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]"))
-	  (setq indent simula-label-offset)))
-	;; find line with non-comment text
-	(simula-skip-comment-backward)
-	(if (and found-end
-		 (not (eq (preceding-char) ?\;))
-		 (if (memq (preceding-char) '(?N ?n))
-		     (save-excursion
-		       (backward-word 1)
-		       (not (looking-at "begin\\>")))
-		   t))
-	    (progn
-	      (simula-previous-statement 1)
-	      (simula-skip-comment-backward)))
-	(setq start-line
-	      (save-excursion (beginning-of-line) (point))
-	      ;; - perhaps this is a continued statement
-	      continued
-	      (save-excursion
-		(and (not (bobp))
-		     ;; (not found-end)
-		     (if (eq (char-syntax (preceding-char)) ?w)
-			 (progn
-			   (backward-word 1)
-			   (not (looking-at
-				 "begin\\|then\\|else\\|when\\|otherwise\\|do"
-				 )))
-		       (not (memq (preceding-char) '(?: ?\;)))))))
-	;;
-	;; MAIN calculation loop - count BEGIN/DO etc.
-	;;
-	(while (not (bolp))
-	  (if (re-search-backward
-	       ";\\|\\<\\(begin\\|end\\|if\\|else\\|then\\|when\\|otherwise\\|do\\)\\>"
-	       start-line 'move)
-	      (if (simula-context)
-		  ();; found something in a comment/string - ignore
-		(setq temp (following-char))
-		(cond
-		 ((eq temp ?\;)
-		  (simula-previous-statement 1))
-		 ((looking-at "begin\\>")
-		  (setq indent (+ indent simula-indent-level)))
-		 ((looking-at "end\\>")
-		  (forward-word 1)
-		  (simula-previous-statement 1))
-		 ((looking-at "do\\>")
-		  (setq indent (+ indent simula-substatement-offset))
-		  (simula-find-do-match))
-		 ((looking-at "\\(if\\|then\\|else\\)\\>")
-		  (if (memq temp '(?I ?i))
-		      (forward-word 1)
-		    (setq indent (+ indent
-				    simula-substatement-offset
-				    (if (memq temp '(?T ?t))
-					(car simula-if-indent)
-				      (cdr simula-if-indent)))))
-		  (simula-find-if))
-		 ((looking-at "\\\\|\\")
-		  (setq indent (+ indent
-				  simula-substatement-offset
-				  (if (memq temp '(?W ?w))
-				      (car simula-if-indent)
-				    (cdr simula-if-indent))))
-		  (simula-find-inspect)))
-		;; found the start of a [sub]statement
-		;; add indentation for continued statement
-		(if continued
-		    (setq indent
-			  (+ indent
-			     (if (listp simula-continued-statement-offset)
-				 (car simula-continued-statement-offset)
-			       simula-continued-statement-offset))))
-		(setq start-line
-		      (save-excursion (beginning-of-line) (point))
-		      continued nil))
-	    ;; search failed .. point is at beginning of line
-	    ;; determine if we should continue searching
-	    ;; (at or before comment or label)
-	    ;; temp = t means finished
-	    (setq temp
-		  (and (not (simula-context))			
-		       (save-excursion
-			 (skip-chars-forward " \t\f")
-			 (or (looking-at "virtual")
-			     (not
-			      (looking-at
-			       "!\\|comment\\>\\|[a-z0-9_]*[ \t\f]*:[^-=]")))))
-		  prev-cont continued)
-	    ;; if we are finished, find current line's indentation
-	    (if temp
-		(setq indent (+ indent (current-indentation))))
-	    ;; find next line with non-comment SIMULA text
-	    ;; maybe indent extra if statement continues
-	    (simula-skip-comment-backward)
-	    (setq continued
-		  (and (not (bobp))
-		       (if (eq (char-syntax (preceding-char)) ?w)
-			   (save-excursion
-			     (backward-word 1)
-			     (not (looking-at
-				   "begin\\|then\\|else\\|when\\|otherwise\\|do")))
-			 (not (memq (preceding-char) '(?: ?\;))))))
-	    ;; if we the state of the continued-variable
-	    ;; changed, add indentation for continued statement
-	    (if (or (and prev-cont (not continued))
-		    (and continued
-			 (listp simula-continued-statement-offset)))
-		(setq indent
-		      (+ indent
-			 (if (listp simula-continued-statement-offset)
-			     (car simula-continued-statement-offset)
-			   simula-continued-statement-offset))))
-	    ;; while ends if point is at beginning of line at loop test
-	    (if (not temp)
-		(setq start-line (save-excursion (beginning-of-line) (point)))
-	      (beginning-of-line))))
-        ;;
-	;; return indentation
-	;;
-	indent)))))
-
-
-(defun simula-find-if ()
-  "Find starting IF of a IF-THEN[-ELSE[-IF-THEN...]] statement."
-  (catch 'simula-out
-    (while t
-      (if (and (simula-search-backward "\\\\|;\\|\\"nil t)
-	       (memq (following-char) '(?I ?i)))
-	  (save-excursion
-	    ;;
-	    ;; find out if this IF was really the start of the IF statement
-	    ;;
-	    (simula-skip-comment-backward)
-	    (if (and (eq (char-syntax (preceding-char)) ?w)
-		     (progn
-		       (backward-word 1)
-		       (looking-at "else\\>")))
-		()
-	      (throw 'simula-out t)))
-	(if (not (looking-at "\\"))
-	    (error "Missing IF or misplaced BEGIN or ';' (can't find IF)")
-	  ;;
-	  ;; we were at the starting IF in the first place..
-	  ;;
-	  (throw 'simula-out t))))))
-
-
-(defun simula-find-inspect ()
-  "Find INSPECT matching WHEN or OTHERWISE."
-  (catch 'simula-out
-    (let ((level 0))
-      ;;
-      ;; INSPECTs can be nested, have to find the corresponding one
-      ;;
-      (while t
-	(if (and (simula-search-backward "\\\\|\\\\|;"
-					  nil t)
-		 (/= (following-char) ?\;))
-	    (if (memq (following-char) '(?O ?o))
-		(setq level (1+ level))
-	      (if (zerop level)
-		  (throw 'simula-out t)
-		(setq level (1- level))))
-	  (error "Missing INSPECT or misplaced ';' (can't find INSPECT)"))))))
-
-
-(defun simula-find-do-match ()
-  "Find keyword matching DO: FOR, WHILE, INSPECT or WHEN"
-  (while (and (re-search-backward
-	       "\\<\\(do\\|for\\|while\\|inspect\\|when\\|end\\|begin\\)\\>\\|;"
-	       nil 'move)
-	      (simula-context)))
-  (if (and (looking-at "\\<\\(for\\|while\\|inspect\\|when\\)\\>")
-	   (not (simula-context)))
-      () ;; found match
-    (error "No matching FOR, WHILE or INSPECT for DO, or misplaced ';'")))
-
-
-(defun simula-inside-parens ()
-  "Return position after `(' on line if inside parentheses, nil otherwise."
-  (save-excursion
-    (let ((parlevel 0))
-      (catch 'simula-out
-	(while t
-	  (if (re-search-backward "(\\|)\\|;" nil t)
-	      (if (eq (simula-context) nil)
-		  ;; found something - check it out
-		  (cond
-		   ((eq (following-char) ?\;)
-		    (if (zerop parlevel)
-			(throw 'simula-out nil)
-		      (error "Parenthesis mismatch or misplaced ';'")))
-		   ((eq (following-char) ?\()
-		    (if (zerop parlevel)
-			(throw 'simula-out (1+ (current-column)))
-		      (setq parlevel (1- parlevel))))
-		   (t (setq parlevel (1+ parlevel))))
-		);; nothing - inside comment or string
-	    ;; search failed
-	    (throw 'simula-out nil)))))))
-
-
-(defun simula-goto-definition ()
-  "Goto point of definition of variable, procedure or class."
-  (interactive))
-
-
-(defun simula-expand-stdproc ()
-  (if (or (not simula-abbrev-stdproc) (simula-context))
-      (unexpand-abbrev)
-    (cond
-     ((eq simula-abbrev-stdproc 'upcase) (upcase-word -1))
-     ((eq simula-abbrev-stdproc 'downcase) (downcase-word -1))
-     ((eq simula-abbrev-stdproc 'capitalize) (capitalize-word -1)))))
-
-
-(defun simula-expand-keyword ()
-  (if (or (not simula-abbrev-keyword) (simula-context))
-      (unexpand-abbrev)
-    (cond
-     ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
-     ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
-     ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1)))))
-
-
-(defun simula-electric-keyword ()
-  "Expand SIMULA keyword.  If it starts the line, reindent."
-  ;; redisplay
-  (let ((show-char (eq this-command 'self-insert-command)))
-    ;; If the abbrev expansion results in reindentation, the user may have
-    ;; to wait some time before the character he typed is displayed
-    ;; (the char causing the expansion is inserted AFTER the hook function
-    ;; is called). This is annoying in case of normal characters.
-    ;; However, if the user pressed a key bound to newline, it is better
-    ;; to have the line inserted after the begin-end match.
-    (if show-char
-	(progn
-	  (insert-char last-command-char 1)
-	  (sit-for 0)
-	  (backward-char 1)))
-    (if (let ((where (simula-context))
-	      (case-fold-search t))
-	  (if where
-	      (if (and (eq where 2) (eq (char-syntax (preceding-char)) ?w))
-		  (save-excursion
-		    (backward-word 1)
-		    (not (looking-at "end\\>"))))))
-	(unexpand-abbrev)
-      (cond
-       ((not simula-abbrev-keyword) (unexpand-abbrev))
-       ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
-       ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
-       ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1)))
-      (let ((pos (- (point-max) (point)))
-	    (case-fold-search t)
-	    )
-	(condition-case nil
-	    (progn
-	      ;; check if the expanded word is on the beginning of the line.
-	      (if (and (eq (char-syntax (preceding-char)) ?w)
-		       (progn
-			 (backward-word 1)
-			 (if (looking-at "end\\>")
-			     (save-excursion
-			       (simula-backward-up-level 1)
-			       (if (pos-visible-in-window-p)
-				   (sit-for 1)
-				 (message
-				  (concat "Matches "
-					  (buffer-substring
-					   (point)
-					   (+ (point) (window-width))))))))
-			 (skip-chars-backward " \t\f")
-			 (bolp)))
-		  (let ((indent (simula-calculate-indent)))
-		    (if (eq indent (current-indentation))
-			()
-		      (delete-horizontal-space)
-		      (indent-to indent)))
-		(skip-chars-forward " \t\f"))
-	      ;; check for END - blow whistles and ring bells
-
-	      (goto-char (- (point-max) pos))
-	      (if show-char
-		  (delete-char 1)))
-	  (quit (goto-char (- (point-max) pos))))))))
-
-
-(defun simula-search-backward (string &optional limit move)
-  (setq string (concat string "\\|\\"))
-  (let (level)
-    (catch 'simula-out
-      (while (re-search-backward string limit move)
-	(if (simula-context)
-	    ()
-	  (if (looking-at "\\")
-              (progn
-                (setq level 0)
-                (while (natnump level)
-                  (re-search-backward "\\\\|\\")
-                  (if (simula-context)
-                      ()
-                    (setq level (if (memq (following-char) '(?b ?B))
-                                    (1- level)
-                                  (1+ level))))))
-            (throw 'simula-out t)))))))
-
-
-(defun simula-search-forward (string &optional limit move)
-  (setq string (concat string "\\|\\"))
-  (let (level)
-    (catch 'exit
-      (while (re-search-forward string limit move)
-	(goto-char (match-beginning 0))
-	(if (simula-context)
-	    (goto-char (1- (match-end 0)))
-	  (if (looking-at "\\")
-	      (progn
-		(goto-char (1- (match-end 0)))
-		(setq level 0)
-		(while (natnump level)
-		  (re-search-forward "\\\\|\\")
-		  (backward-word 1)
-		  (if (not (simula-context))
-		      (setq level (if (memq (following-char) '(?e ?E))
-				      (1- level)
-				    (1+ level))))
-		  (backward-word -1)))
-	    (goto-char (1- (match-end 0)))
-	    (throw 'exit t)))))))
-
-  
-(defun simula-install-standard-abbrevs ()
-  "Define Simula keywords, procedures and classes in local abbrev table."
-  ;; procedure and class names are as of the SIMULA 87 standard.
-  (interactive)
-  (mapcar (function (lambda (args)
-		      (apply 'define-abbrev simula-mode-abbrev-table args)))
-	  '(("abs" "Abs" simula-expand-stdproc)
-	    ("accum" "Accum" simula-expand-stdproc)
-	    ("activate" "ACTIVATE" simula-expand-keyword)
-	    ("addepsilon" "AddEpsilon" simula-expand-stdproc)
-	    ("after" "AFTER" simula-expand-keyword)
-	    ("and" "AND" simula-expand-keyword)
-	    ("arccos" "ArcCos" simula-expand-stdproc)
-	    ("arcsin" "ArcSin" simula-expand-stdproc)
-	    ("arctan" "ArcTan" simula-expand-stdproc)
-	    ("arctan2" "ArcTan2" simula-expand-stdproc)
-	    ("array" "ARRAY" simula-expand-keyword)
-	    ("at" "AT" simula-expand-keyword)
-	    ("before" "BEFORE" simula-expand-keyword)
-	    ("begin" "BEGIN" simula-expand-keyword)
-	    ("blanks" "Blanks" simula-expand-stdproc)
-	    ("boolean" "BOOLEAN" simula-expand-keyword)
-	    ("breakoutimage" "BreakOutImage" simula-expand-stdproc)
-	    ("bytefile" "ByteFile" simula-expand-stdproc)
-	    ("call" "Call" simula-expand-stdproc)
-	    ("cancel" "Cancel" simula-expand-stdproc)
-	    ("cardinal" "Cardinal" simula-expand-stdproc)
-	    ("char" "Char" simula-expand-stdproc)
-	    ("character" "CHARACTER" simula-expand-keyword)
-	    ("checkpoint" "CheckPoint" simula-expand-stdproc)
-	    ("class" "CLASS" simula-expand-keyword)
-	    ("clear" "Clear" simula-expand-stdproc)
-	    ("clocktime" "ClockTime" simula-expand-stdproc)
-	    ("close" "Close" simula-expand-stdproc)
-	    ("comment" "COMMENT" simula-expand-keyword)
-	    ("constant" "Constant" simula-expand-stdproc)
-	    ("copy" "Copy" simula-expand-stdproc)
-	    ("cos" "Cos" simula-expand-stdproc)
-	    ("cosh" "CosH" simula-expand-stdproc)
-	    ("cotan" "CoTan" simula-expand-stdproc)
-	    ("cputime" "CpuTime" simula-expand-stdproc)
-	    ("current" "Current" simula-expand-stdproc)
-	    ("datetime" "DateTime" simula-expand-stdproc)
-	    ("decimalmark" "DecimalMark" simula-expand-stdproc)
-	    ("delay" "DELAY" simula-expand-keyword)
-	    ("deleteimage" "DeleteImage" simula-expand-stdproc)
-	    ("detach" "Detach" simula-expand-stdproc)
-	    ("digit" "Digit" simula-expand-stdproc)
-	    ("directbytefile" "DirectByteFile" simula-expand-stdproc)
-	    ("directfile" "DirectFile" simula-expand-stdproc)
-	    ("discrete" "Discrete" simula-expand-stdproc)
-	    ("do" "DO" simula-expand-keyword)
-	    ("downcase" "Downcase" simula-expand-stdproc)
-	    ("draw" "Draw" simula-expand-stdproc)
-	    ("eject" "Eject" simula-expand-stdproc)
-	    ("else" "ELSE" simula-electric-keyword)
-	    ("empty" "Empty" simula-expand-stdproc)
-	    ("end" "END" simula-electric-keyword)
-	    ("endfile" "Endfile" simula-expand-stdproc)
-	    ("entier" "Entier" simula-expand-stdproc)
-	    ("eq" "EQ" simula-expand-keyword)
-	    ("eqv" "EQV" simula-expand-keyword)
-	    ("erlang" "Erlang" simula-expand-stdproc)
-	    ("error" "Error" simula-expand-stdproc)
-	    ("evtime" "EvTime" simula-expand-stdproc)
-	    ("exp" "Exp" simula-expand-stdproc)
-	    ("external" "EXTERNAL" simula-expand-keyword)
-	    ("false" "FALSE" simula-expand-keyword)
-	    ("field" "Field" simula-expand-stdproc)
-	    ("file" "File" simula-expand-stdproc)
-	    ("first" "First" simula-expand-stdproc)
-	    ("follow" "Follow" simula-expand-stdproc)
-	    ("for" "FOR" simula-expand-keyword)
-	    ("ge" "GE" simula-expand-keyword)
-	    ("getchar" "GetChar" simula-expand-stdproc)
-	    ("getfrac" "GetFrac" simula-expand-stdproc)
-	    ("getint" "GetInt" simula-expand-stdproc)
-	    ("getreal" "GetReal" simula-expand-stdproc)
-	    ("go" "GO" simula-expand-keyword)
-	    ("goto" "GOTO" simula-expand-keyword)
-	    ("gt" "GT" simula-expand-keyword)
-	    ("head" "Head" simula-expand-stdproc)
-	    ("hidden" "HIDDEN" simula-expand-keyword)
-	    ("histd" "HistD" simula-expand-stdproc)
-	    ("histo" "Histo" simula-expand-stdproc)
-	    ("hold" "Hold" simula-expand-stdproc)
-	    ("idle" "Idle" simula-expand-stdproc)
-	    ("if" "IF" simula-expand-keyword)
-	    ("image" "Image" simula-expand-stdproc)
-	    ("imagefile" "ImageFile" simula-expand-stdproc)
-	    ("imp" "IMP" simula-expand-keyword)
-	    ("in" "IN" simula-expand-keyword)
-	    ("inbyte" "InByte" simula-expand-stdproc)
-	    ("inbytefile" "InByteFile" simula-expand-stdproc)
-	    ("inchar" "InChar" simula-expand-stdproc)
-	    ("infile" "InFile" simula-expand-stdproc)
-	    ("infrac" "InFrac" simula-expand-stdproc)
-	    ("inimage" "InImage" simula-expand-stdproc)
-	    ("inint" "InInt" simula-expand-stdproc)
-	    ("inner" "INNER" simula-expand-keyword)
-	    ("inreal" "InReal" simula-expand-stdproc)
-	    ("inrecord" "InRecord" simula-expand-stdproc)
-	    ("inspect" "INSPECT" simula-expand-keyword)
-	    ("integer" "INTEGER" simula-expand-keyword)
-	    ("intext" "InText" simula-expand-stdproc)
-	    ("into" "Into" simula-expand-stdproc)
-	    ("is" "IS" simula-expand-keyword)
-	    ("isochar" "ISOChar" simula-expand-stdproc)
-	    ("isopen" "IsOpen" simula-expand-stdproc)
-	    ("isorank" "ISORank" simula-expand-stdproc)
-	    ("label" "LABEL" simula-expand-keyword)
-	    ("last" "Last" simula-expand-stdproc)
-	    ("lastitem" "LastItem" simula-expand-stdproc)
-	    ("lastloc" "LastLoc" simula-expand-stdproc)
-	    ("le" "LE" simula-expand-keyword)
-	    ("length" "Length" simula-expand-stdproc)
-	    ("letter" "Letter" simula-expand-stdproc)
-	    ("line" "Line" simula-expand-stdproc)
-	    ("linear" "Linear" simula-expand-stdproc)
-	    ("linesperpage" "LinesPerPage" simula-expand-stdproc)
-	    ("link" "Link" simula-expand-stdproc)
-	    ("linkage" "Linkage" simula-expand-stdproc)
-	    ("ln" "Ln" simula-expand-stdproc)
-	    ("locate" "Locate" simula-expand-stdproc)
-	    ("location" "Location" simula-expand-stdproc)
-	    ("lock" "Lock" simula-expand-stdproc)
-	    ("locked" "Locked" simula-expand-stdproc)
-	    ("log10" "Log10" simula-expand-stdproc)
-	    ("long" "LONG" simula-expand-keyword)
-	    ("lowcase" "LowCase" simula-expand-stdproc)
-	    ("lowerbound" "LowerBound" simula-expand-stdproc)
-	    ("lowten" "LowTen" simula-expand-stdproc)
-	    ("lt" "LT" simula-expand-keyword)
-	    ("main" "Main" simula-expand-stdproc)
-	    ("max" "Max" simula-expand-stdproc)
-	    ("maxint" "MaxInt" simula-expand-stdproc)
-	    ("maxlongreal" "MaxLongReal" simula-expand-stdproc)
-	    ("maxloc" "MaxLoc" simula-expand-stdproc)
-	    ("maxrank" "MaxRank" simula-expand-stdproc)
-	    ("maxreal" "MaxReal" simula-expand-stdproc)
-	    ("min" "Min" simula-expand-stdproc)
-	    ("minint" "MinInt" simula-expand-stdproc)
-	    ("minlongreal" "MinLongReal" simula-expand-stdproc)
-	    ("minrank" "MinRank" simula-expand-stdproc)
-	    ("minreal" "MinReal" simula-expand-stdproc)
-	    ("mod" "Mod" simula-expand-stdproc)
-	    ("more" "More" simula-expand-stdproc)
-	    ("name" "NAME" simula-expand-keyword)
-	    ("ne" "NE" simula-expand-keyword)
-	    ("negexp" "NegExp" simula-expand-stdproc)
-	    ("new" "NEW" simula-expand-keyword)
-	    ("nextev" "NextEv" simula-expand-stdproc)
-	    ("none" "NONE" simula-expand-keyword)
-	    ("normal" "Normal" simula-expand-stdproc)
-	    ("not" "NOT" simula-expand-keyword)
-	    ("notext" "NOTEXT" simula-expand-keyword)
-	    ("open" "Open" simula-expand-stdproc)
-	    ("or" "OR" simula-expand-keyword)
-	    ("otherwise" "OTHERWISE" simula-electric-keyword)
-	    ("out" "Out" simula-expand-stdproc)
-	    ("outbyte" "OutByte" simula-expand-stdproc)
-	    ("outbytefile" "OutByteFile" simula-expand-stdproc)
-	    ("outchar" "OutChar" simula-expand-stdproc)
-	    ("outfile" "OutFile" simula-expand-stdproc)
-	    ("outfix" "OutFix" simula-expand-stdproc)
-	    ("outfrac" "OutFrac" simula-expand-stdproc)
-	    ("outimage" "OutImage" simula-expand-stdproc)
-	    ("outint" "OutInt" simula-expand-stdproc)
-	    ("outreal" "OutReal" simula-expand-stdproc)
-	    ("outrecord" "OutRecord" simula-expand-stdproc)
-	    ("outtext" "OutText" simula-expand-stdproc)
-	    ("page" "Page" simula-expand-stdproc)
-	    ("passivate" "Passivate" simula-expand-stdproc)
-	    ("poisson" "Poisson" simula-expand-stdproc)
-	    ("pos" "Pos" simula-expand-stdproc)
-	    ("precede" "Precede" simula-expand-stdproc)
-	    ("pred" "Pred" simula-expand-stdproc)
-	    ("prev" "Prev" simula-expand-stdproc)
-	    ("printfile" "PrintFile" simula-expand-stdproc)
-	    ("prior" "PRIOR" simula-expand-keyword)
-	    ("procedure" "PROCEDURE" simula-expand-keyword)
-	    ("process" "Process" simula-expand-stdproc)
-	    ("protected" "PROTECTED" simula-expand-keyword)
-	    ("putchar" "PutChar" simula-expand-stdproc)
-	    ("putfix" "PutFix" simula-expand-stdproc)
-	    ("putfrac" "PutFrac" simula-expand-stdproc)
-	    ("putint" "PutInt" simula-expand-stdproc)
-	    ("putreal" "PutReal" simula-expand-stdproc)
-	    ("qua" "QUA" simula-expand-keyword)
-	    ("randint" "RandInt" simula-expand-stdproc)
-	    ("rank" "Rank" simula-expand-stdproc)
-	    ("reactivate" "REACTIVATE" simula-expand-keyword)
-	    ("real" "REAL" simula-expand-keyword)
-	    ("ref" "REF" simula-expand-keyword)
-	    ("resume" "Resume" simula-expand-stdproc)
-	    ("setaccess" "SetAccess" simula-expand-stdproc)
-	    ("setpos" "SetPos" simula-expand-stdproc)
-	    ("short" "SHORT" simula-expand-keyword)
-	    ("sign" "Sign" simula-expand-stdproc)
-	    ("simset" "SimSet" simula-expand-stdproc)
-	    ("simulaid" "SimulaId" simula-expand-stdproc)
-	    ("simulation" "Simulation" simula-expand-stdproc)
-	    ("sin" "Sin" simula-expand-stdproc)
-	    ("sinh" "SinH" simula-expand-stdproc)
-	    ("sourceline" "SourceLine" simula-expand-stdproc)
-	    ("spacing" "Spacing" simula-expand-stdproc)
-	    ("sqrt" "Sqrt" simula-expand-stdproc)
-	    ("start" "Start" simula-expand-stdproc)
-	    ("step" "STEP" simula-expand-keyword)
-	    ("strip" "Strip" simula-expand-stdproc)
-	    ("sub" "Sub" simula-expand-stdproc)
-	    ("subepsilon" "SubEpsilon" simula-expand-stdproc)
-	    ("suc" "Suc" simula-expand-stdproc)
-	    ("switch" "SWITCH" simula-expand-keyword)
-	    ("sysin" "SysIn" simula-expand-stdproc)
-	    ("sysout" "SysOut" simula-expand-stdproc)
-	    ("tan" "Tan" simula-expand-stdproc)
-	    ("tanh" "TanH" simula-expand-stdproc)
-	    ("terminate_program" "Terminate_Program" simula-expand-stdproc)
-	    ("terminated" "Terminated" simula-expand-stdproc)
-	    ("text" "TEXT" simula-expand-keyword)
-	    ("then" "THEN" simula-electric-keyword)
-	    ("this" "THIS" simula-expand-keyword)
-	    ("time" "Time" simula-expand-stdproc)
-	    ("to" "TO" simula-expand-keyword)
-	    ("true" "TRUE" simula-expand-keyword)
-	    ("uniform" "Uniform" simula-expand-stdproc)
-	    ("unlock" "Unlock" simula-expand-stdproc)
-	    ("until" "UNTIL" simula-expand-keyword)
-	    ("upcase" "Upcase" simula-expand-stdproc)
-	    ("upperbound" "UpperBound" simula-expand-stdproc)
-	    ("value" "VALUE" simula-expand-keyword)
-	    ("virtual" "VIRTUAL" simula-expand-keyword)
-	    ("wait" "Wait" simula-expand-stdproc)
-	    ("when" "WHEN" simula-electric-keyword)
-	    ("while" "WHILE" simula-expand-keyword))))
-
-;;; simula.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/sql.el b/xemacs-packages/lisp/prog-modes/sql.el
deleted file mode 100644
index 1097b42d..00000000
--- a/xemacs-packages/lisp/prog-modes/sql.el
+++ /dev/null
@@ -1,2979 +0,0 @@
-;;; sql.el --- specialized comint.el for SQL interpreters
-
-;; Copyright (C) 1998,99,2000,01,02,03,04  Free Software Foundation, Inc.
-
-;; Author: Alex Schroeder 
-;; Maintainer: Michael Mauger 
-;; Version: 2.0.1
-;; Keywords: comm languages processes
-;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
-
-;; 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:
-
-;; Please send bug reports and bug fixes to the mailing list at
-;; sql.el@gnu.org.  If you want to subscribe to the mailing list, send
-;; mail to sql.el-request@gnu.org with `subscribe sql.el FIRSTNAME
-;; LASTNAME' in the mail body.
-
-;; This file provides a sql-mode and a sql-interactive-mode.  My goals
-;; were two simple modes providing syntactic hilighting.  The
-;; interactive mode had to provide a command-line history; the other
-;; mode had to provide "send region/buffer to SQL interpreter"
-;; functions.  "simple" in this context means easy to use, easy to
-;; maintain and little or no bells and whistles.
-
-;; If anybody feels like extending this sql mode, take a look at the
-;; above mentioned modes and write a sqlx-mode on top of this one.  If
-;; this proves to be difficult, please suggest changes that will
-;; facilitate your plans.
-
-;; sql-interactive-mode is used to interact with a SQL interpreter
-;; process in a SQLi buffer (usually called `*SQL*').  The SQLi buffer
-;; is created by calling a SQL interpreter-specific entry function.  Do
-;; *not* call sql-interactive-mode by itself.
-
-;; The list of currently supported interpreters and the corresponding
-;; entry function used to create the SQLi buffers is shown with
-;; `sql-help' (M-x sql-help).
-
-;; Since sql-interactive-mode is built on top of the general
-;; command-interpreter-in-a-buffer mode (comint mode), it shares a
-;; common base functionality, and a common set of bindings, with all
-;; modes derived from comint mode.  This makes these modes easier to
-;; use.
-
-;; sql-mode can be used to keep editing SQL statements.  The SQL
-;; statements can be sent to the SQL process in the SQLi buffer.
-
-;; For documentation on the functionality provided by comint mode, and
-;; the hooks available for customizing it, see the file `comint.el'.
-
-;; Hint for newbies: take a look at `dabbrev-expand', `abbrev-mode', and
-;; `imenu-add-menubar-index'.
-
-;;; Requirements for Emacs 19.34:
-
-;; If you are using Emacs 19.34, you will have to get and install
-;; the file regexp-opt.el
-;; 
-;; and the custom package
-;; .
-
-;;; Bugs:
-
-;; sql-ms now uses osql instead of isql.  Osql flushes its error
-;; stream more frequently than isql so that error messages are
-;; available.  There is no prompt and some output still is buffered.
-;; This improves the interaction under Emacs but it still is somewhat
-;; awkward.
-
-;; Quoted identifiers are not supported for hilighting.  Most
-;; databases support the use of double quoted strings in place of
-;; identifiers; ms (Microsoft SQLServer) also supports identifiers
-;; enclosed within brackets [].
-
-;; ChangeLog available on request.
-
-;;; Product Support:
-
-;; To add support for additional SQL products the following steps
-;; must be followed ("xyz" is the name of the product in the examples
-;; below):
-
-;; 1) Add the product to `sql-product' choice list.
-
-;;     (const :tag "XyzDB" xyz)
-
-;; 2) Add an entry to the `sql-product-alist' list.
-
-;;     (xyz
-;;      :font-lock sql-mode-xyz-font-lock-keywords
-;;      :sqli-login (user password server database)
-;;      :sqli-connect sql-connect-xyz
-;;      :sqli-prompt-regexp "^xyzdb> "
-;;      :sqli-prompt-length 7
-;;      :sqli-input-sender nil
-;;      :syntax-alist ((?# . "w")))
-
-;; 3) Add customizable values for the product interpreter and options.
-
-;;     ;; Customization for XyzDB
-;;
-;;     (defcustom sql-xyz-program "ixyz"
-;;       "*Command to start ixyz by XyzDB."
-;;       :type 'file
-;;       :group 'SQL)
-;;
-;;     (defcustom sql-xyz-options '("-X" "-Y" "-Z")
-;;       "*List of additional options for `sql-xyz-program'."
-;;       :type '(repeat string)
-;;       :group 'SQL)
-
-;; 4) Add an entry to SQL->Product submenu.
-
-;;     ["XyzDB" sql-highlight-xyz-keywords
-;;      :style radio
-;;      :selected (eq sql-product 'xyz)]
-
-;; 5) Add the font-lock specifications.  At a minimum, default to
-;;    using ANSI keywords.  See sql-mode-oracle-font-lock-keywords for
-;;    a more complex example.
-
-;;     (defvar sql-mode-xyz-font-lock-keywords nil
-;;       "XyzDB SQL keywords used by font-lock.")
-
-;; 6) Add a product highlighting function.
-
-;;     (defun sql-highlight-xyz-keywords ()
-;;       "Highlight XyzDB keywords."
-;;       (interactive)
-;;       (sql-set-product 'xyz))
-
-;; 7) Add an autoloaded SQLi function.
-
-;;     ;;;###autoload
-;;     (defun sql-xyz ()
-;;       "Run ixyz by XyzDB as an inferior process."
-;;       (interactive)
-;;       (sql-product-interactive 'xyz))
-
-;; 8) Add a connect function which formats the command line arguments
-;;    and starts the product interpreter in a comint buffer.  See the
-;;    existing connect functions for examples of the types of
-;;    processing available.
-
-;;     (defun sql-connect-xyz ()
-;;       "Create comint buffer and connect to XyzDB using the login
-;;     parameters and command options."
-;;
-;;         ;; Do something with `sql-user', `sql-password',
-;;         ;; `sql-database', and `sql-server'.
-;;         (let ((params sql-xyz-options))
-;;           (if (not (string= "" sql-server))
-;;              (setq params (append (list "-S" sql-server) params)))
-;;           (if (not (string= "" sql-database))
-;;               (setq params (append (list "-D" sql-database) params)))
-;;           (if (not (string= "" sql-password))
-;;               (setq params (append (list "-P" sql-password) params)))
-;;           (if (not (string= "" sql-user))
-;;               (setq params (append (list "-U" sql-user) params)))
-;;           (set-buffer (apply 'make-comint "SQL" sql-xyz-program
-;;                              nil params))))
-
-;; 9) Save and compile sql.el.
-
-;;; To Do:
-
-;; Add better hilight support for other brands; there is a bias towards
-;; Oracle because that's what I use at work.  Anybody else just send in
-;; your lists of reserved words, keywords and builtin functions!  As
-;; long as I don't receive any feedback, everything is hilighted with
-;; ANSI keywords only.  I received the list of ANSI keywords from a
-;; user; if you know of any changes, let me know.
-
-;; Add different hilighting levels.
-
-;;; Thanks to all the people who helped me out:
-
-;; Alex Schroeder 
-;; Kai Blauberg 
-;; 
-;; Yair Friedman 
-;; Gregor Zych 
-;; nino 
-;; Berend de Boer 
-;; Adam Jenkins 
-;; Michael Mauger  -- improved product support
-;; Drew Adams  -- Emacs 20 support
-;; Harald Maier  -- sql-send-string
-;; Stefan Monnier  -- font-lock corrections
-
-
-
-;;; Code:
-
-(require 'comint)
-;; Need the following to allow GNU Emacs 19 to compile the file.
-(eval-when-compile
-  (require 'regexp-opt))
-(require 'custom)
-
-;;; Allow customization
-
-(defgroup SQL nil
-  "Running a SQL interpreter from within Emacs buffers"
-  :version "20.4"
-  :group 'processes)
-
-;; These four variables will be used as defaults, if set.
-
-(defcustom sql-user ""
-  "*Default username."
-  :type 'string
-  :group 'SQL)
-
-(defcustom sql-password ""
-  "*Default password.
-
-Storing your password in a textfile such as ~/.emacs could be dangerous.
-Customizing your password will store it in your ~/.emacs file."
-  :type 'string
-  :group 'SQL)
-
-(defcustom sql-database ""
-  "*Default database."
-  :type 'string
-  :group 'SQL)
-
-(defcustom sql-server ""
-  "*Default server or host."
-  :type 'string
-  :group 'SQL)
-
-;; SQL Product support
-(defcustom sql-product 'ansi
-  "*Select the SQL database product used so that buffers can be
-highlighted properly when you open them."
-  :type '(choice (const :tag "ANSI" ansi)
-		 (const :tag "DB2" db2)
-		 (const :tag "Informix" informix)
-		 (const :tag "Ingres" ingres)
-		 (const :tag "Interbase" interbase)
-		 (const :tag "Linter" linter)
-		 (const :tag "Microsoft" ms)
-		 (const :tag "MySQL" mysql)
-		 (const :tag "Oracle" oracle)
-		 (const :tag "PostGres" postgres)
-		 (const :tag "Solid" solid)
-		 (const :tag "SQLite" sqlite)
-		 (const :tag "Sybase" sybase))
-  :group 'SQL)
-
-(defvar sql-interactive-product nil
-  "Product under `sql-interactive-mode'.")
-
-(defvar sql-product-alist
-  '((ansi
-     :font-lock sql-mode-ansi-font-lock-keywords)
-    (db2
-     :font-lock sql-mode-db2-font-lock-keywords
-     :sqli-login nil
-     :sqli-connect sql-connect-db2
-     :sqli-prompt-regexp "^db2 => "
-     :sqli-prompt-length 7)
-    (informix
-     :font-lock sql-mode-informix-font-lock-keywords
-     :sqli-login (database)
-     :sqli-connect sql-connect-informix
-     :sqli-prompt-regexp "^SQL> "
-     :sqli-prompt-length 5)
-    (ingres
-     :font-lock sql-mode-ingres-font-lock-keywords
-     :sqli-login (database)
-     :sqli-connect sql-connect-ingres
-     :sqli-prompt-regexp "^\* "
-     :sqli-prompt-length 2)
-    (interbase
-     :font-lock sql-mode-interbase-font-lock-keywords
-     :sqli-login (user password database)
-     :sqli-connect sql-connect-interbase
-     :sqli-prompt-regexp "^SQL> "
-     :sqli-prompt-length 5)
-    (linter
-     :font-lock sql-mode-linter-font-lock-keywords
-     :sqli-login (user password database server)
-     :sqli-connect sql-connect-linter
-     :sqli-prompt-regexp "^SQL>"
-     :sqli-prompt-length 4)
-    (ms
-     :font-lock sql-mode-ms-font-lock-keywords
-     :sqli-login (user password server database)
-     :sqli-connect sql-connect-ms
-     :sqli-prompt-regexp "^[0-9]*>"
-     :sqli-prompt-length 5
-     :syntax-alist ((?@ . "w")))
-    (mysql
-     :font-lock sql-mode-mysql-font-lock-keywords
-     :sqli-login (user password database server)
-     :sqli-connect sql-connect-mysql
-     :sqli-prompt-regexp "^mysql> "
-     :sqli-prompt-length 6)
-    (oracle
-     :font-lock sql-mode-oracle-font-lock-keywords
-     :sqli-login (user password database)
-     :sqli-connect sql-connect-oracle
-     :sqli-prompt-regexp "^SQL> "
-     :sqli-prompt-length 5
-     :syntax-alist ((?$ . "w") (?# . "w")))
-    (postgres
-     :font-lock sql-mode-postgres-font-lock-keywords
-     :sqli-login (user database server)
-     :sqli-connect sql-connect-postgres
-     :sqli-prompt-regexp "^.*[#>] *"
-     :sqli-prompt-length 5)
-    (solid
-     :font-lock sql-mode-solid-font-lock-keywords
-     :sqli-login (user password server)
-     :sqli-connect sql-connect-solid
-     :sqli-prompt-regexp "^"
-     :sqli-prompt-length 0)
-    (sqlite
-     :font-lock sql-mode-sqlite-font-lock-keywords
-     :sqli-login (user password server database)
-     :sqli-connect sql-connect-sqlite
-     :sqli-prompt-regexp "^sqlite> "
-     :sqli-prompt-length 8)
-    (sybase
-     :font-lock sql-mode-sybase-font-lock-keywords
-     :sqli-login (server user password database)
-     :sqli-connect sql-connect-sybase
-     :sqli-prompt-regexp "^SQL> "
-     :sqli-prompt-length 5
-     :syntax-alist ((?@ . "w")))
-    )
-  "This variable contains a list of product features for each of the
-SQL products handled by `sql-mode'.  Without an entry in this list a
-product will not be properly highlighted and will not support
-`sql-interactive-mode'.
-
-Each element in the list is in the following format:
-
- \(PRODUCT FEATURE VALUE ...)
-
-where PRODUCT is the appropriate value of `sql-product'.  The product
-name is then followed by FEATURE-VALUE pairs.  If a FEATURE is not
-specified, its VALUE is treated as nil.  FEATURE must be one of the
-following:
-
- :font-lock             name of the variable containing the product
-                        specific font lock highlighting patterns.
-
- :sqli-login            a list of login parameters (i.e., user,
-                        password, database and server) needed to
-                        connect to the database.
-
- :sqli-connect          the name of a function which accepts no
-                        parameters that will use the values of
-                        `sql-user', `sql-password',
-                        `sql-database' and `sql-server' to open a
-                        comint buffer and connect to the
-                        database.  Do product specific
-                        configuration of comint in this function.
-
- :sqli-prompt-regexp    a regular expression string that matches
-                        the prompt issued by the product
-                        interpreter.  (Not needed in 21.3+)
-
- :sqli-prompt-length    the length of the prompt on the line.(Not
-                        needed in 21.3+)
-
- :syntax-alist          an alist of syntax table entries to enable
-                        special character treatment by font-lock and
-                        imenu. ")
-
-;; misc customization of sql.el behaviour
-
-(defcustom sql-electric-stuff nil
-  "Treat some input as electric.
-If set to the symbol `semicolon', then hitting `;' will send current
-input in the SQLi buffer to the process.
-If set to the symbol `go', then hitting `go' on a line by itself will
-send current input in the SQLi buffer to the process.
-If set to nil, then you must use \\[comint-send-input] in order to send
-current input in the SQLi buffer to the process."
-  :type '(choice (const :tag "Nothing" nil)
-		 (const :tag "The semikolon `;'" semicolon)
-		 (const :tag "The string `go' by itself" go))
-  :version "20.8"
-  :group 'SQL)
-
-(defcustom sql-pop-to-buffer-after-send-region nil
-  "*If t, pop to the buffer SQL statements are sent to.
-
-After a call to `sql-send-region' or `sql-send-buffer',
-the window is split and the SQLi buffer is shown.  If this
-variable is not nil, that buffer's window will be selected
-by calling `pop-to-buffer'.  If this variable is nil, that
-buffer is shown using `display-buffer'."
-  :type 'boolean
-  :group 'SQL)
-
-;; imenu support for sql-mode.
-
-(defvar sql-imenu-generic-expression
-  ;; Items are in reverse order because they are rendered in reverse.
-  '(("Rules/Defaults" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(rule\\|default\\)\\s-+\\(\\w+\\)" 3)
-    ("Sequences" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*sequence\\s-+\\(\\w+\\)" 2)
-    ("Triggers" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*trigger\\s-+\\(\\w+\\)" 2)
-    ("Functions" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?function\\s-+\\(\\w+\\)" 3)
-    ("Procedures" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?proc\\(edure\\)?\\s-+\\(\\w+\\)" 4)
-    ("Packages" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*package\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3)
-    ("Indexes" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*index\\s-+\\(\\w+\\)" 2)
-    ("Tables/Views" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(table\\|view\\)\\s-+\\(\\w+\\)" 3))
-  "Define interesting points in the SQL buffer for `imenu'.
-
-This is used to set `imenu-generic-expression' when SQL mode is
-entered.  Subsequent changes to sql-imenu-generic-expression will not
-affect existing SQL buffers because imenu-generic-expression is a
-local variable.")
-
-;; history file
-
-(defcustom sql-input-ring-file-name nil
-  "*If non-nil, name of the file to read/write input history.
-
-You have to set this variable if you want the history of your commands
-saved from one Emacs session to the next.  If this variable is set,
-exiting the SQL interpreter in an SQLi buffer will write the input
-history to the specified file.  Starting a new process in a SQLi buffer
-will read the input history from the specified file.
-
-This is used to initialize `comint-input-ring-file-name'.
-
-Note that the size of the input history is determined by the variable
-`comint-input-ring-size'."
-  :type '(choice (const :tag "none" nil)
-		 (file))
-  :group 'SQL)
-
-(defcustom sql-input-ring-separator "\n--\n"
-  "*Separator between commands in the history file.
-
-If set to \"\\n\", each line in the history file will be interpreted as
-one command.  Multi-line commands are split into several commands when
-the input ring is initialized from a history file.
-
-This variable used to initialize `comint-input-ring-separator'.
-`comint-input-ring-separator' is part of Emacs 21; if your Emacs
-does not have it, setting `sql-input-ring-separator' will have no
-effect.  In that case multiline commands will be split into several
-commands when the input history is read, as if you had set
-`sql-input-ring-separator' to \"\\n\"."
-  :type 'string
-  :group 'SQL)
-
-;; The usual hooks
-
-(defcustom sql-interactive-mode-hook '()
-  "*Hook for customizing `sql-interactive-mode'."
-  :type 'hook
-  :group 'SQL)
-
-(defcustom sql-mode-hook '()
-  "*Hook for customizing `sql-mode'."
-  :type 'hook
-  :group 'SQL)
-
-(defcustom sql-set-sqli-hook '()
-  "*Hook for reacting to changes of `sql-buffer'.
-
-This is called by `sql-set-sqli-buffer' when the value of `sql-buffer'
-is changed."
-  :type 'hook
-  :group 'SQL)
-
-;; Customization for Oracle
-
-(defcustom sql-oracle-program "sqlplus"
-  "*Command to start sqlplus by Oracle.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-Under NT, \"sqlplus\" usually starts the sqlplus \"GUI\".  In order to
-start the sqlplus console, use \"plus33\" or something similar.  You
-will find the file in your Orant\\bin directory.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-(defcustom sql-oracle-options nil
-  "*List of additional options for `sql-oracle-program'."
-  :type '(repeat string)
-  :version "20.8"
-  :group 'SQL)
-
-;; Customization for SQLite
-
-(defcustom sql-sqlite-program "sqlite"
-  "*Command to start SQLite.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-(defcustom sql-sqlite-options nil
-  "*List of additional options for `sql-sqlite-program'.
-The following list of options is reported to make things work
-on Windows: \"-C\" \"-t\" \"-f\" \"-n\"."
-  :type '(repeat string)
-  :version "20.8"
-  :group 'SQL)
-
-;; Customization for MySql
-
-(defcustom sql-mysql-program "mysql"
-  "*Command to start mysql by TcX.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-(defcustom sql-mysql-options nil
-  "*List of additional options for `sql-mysql-program'.
-The following list of options is reported to make things work
-on Windows: \"-C\" \"-t\" \"-f\" \"-n\"."
-  :type '(repeat string)
-  :version "20.8"
-  :group 'SQL)
-
-;; Customization for Solid
-
-(defcustom sql-solid-program "solsql"
-  "*Command to start SOLID SQL Editor.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-;; Customization for SyBase
-
-(defcustom sql-sybase-program "isql"
-  "*Command to start isql by SyBase.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-(defcustom sql-sybase-options nil
-  "*List of additional options for `sql-sybase-program'.
-Some versions of isql might require the -n option in order to work."
-  :type '(repeat string)
-  :version "20.8"
-  :group 'SQL)
-
-;; Customization for Informix
-
-(defcustom sql-informix-program "dbaccess"
-  "*Command to start dbaccess by Informix.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-;; Customization for Ingres
-
-(defcustom sql-ingres-program "sql"
-  "*Command to start sql by Ingres.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-;; Customization for Microsoft
-
-(defcustom sql-ms-program "osql"
-  "*Command to start osql by Microsoft.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-(defcustom sql-ms-options '("-w" "300" "-n")
-  ;; -w is the linesize
-  "*List of additional options for `sql-ms-program'."
-  :type '(repeat string)
-  :version "22.1"
-  :group 'SQL)
-
-;; Customization for Postgres
-
-(defcustom sql-postgres-program "psql"
-  "Command to start psql by Postgres.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-(defcustom sql-postgres-options '("-P" "pager=off")
-  "*List of additional options for `sql-postgres-program'.
-The default setting includes the -P option which breaks older versions
-of the psql client (such as version 6.5.3).  The -P option is equivalent
-to the --pset option.  If you want the psql to prompt you for a user
-name, add the string \"-u\" to the list of options.  If you want to
-provide a user name on the command line (newer versions such as 7.1),
-add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
-  :type '(repeat string)
-  :version "20.8"
-  :group 'SQL)
-
-;; Customization for Interbase
-
-(defcustom sql-interbase-program "isql"
-  "*Command to start isql by Interbase.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-(defcustom sql-interbase-options nil
-  "*List of additional options for `sql-interbase-program'."
-  :type '(repeat string)
-  :version "20.8"
-  :group 'SQL)
-
-;; Customization for DB2
-
-(defcustom sql-db2-program "db2"
-  "*Command to start db2 by IBM.
-
-Starts `sql-interactive-mode' after doing some setup.
-
-The program can also specify a TCP connection.  See `make-comint'."
-  :type 'file
-  :group 'SQL)
-
-(defcustom sql-db2-options nil
-  "*List of additional options for `sql-db2-program'."
-  :type '(repeat string)
-  :version "20.8"
-  :group 'SQL)
-
-;; Customization for Linter
-
-(defcustom sql-linter-program "inl"
-  "*Command to start inl by RELEX.
-
-Starts `sql-interactive-mode' after doing some setup."
-  :type 'file
-  :group 'SQL)
-
-(defcustom sql-linter-options nil
-  "*List of additional options for `sql-linter-program'."
-  :type '(repeat string)
-  :version "21.3"
-  :group 'SQL)
-
-
-
-;;; Variables which do not need customization
-
-(defvar sql-user-history nil
-  "History of usernames used.")
-
-(defvar sql-database-history nil
-  "History of databases used.")
-
-(defvar sql-server-history nil
-  "History of servers used.")
-
-;; Passwords are not kept in a history.
-
-(defvar sql-buffer nil
-  "Current SQLi buffer.
-
-The global value of sql-buffer is the name of the latest SQLi buffer
-created.  Any SQL buffer created will make a local copy of this value.
-See `sql-interactive-mode' for more on multiple sessions.  If you want
-to change the SQLi buffer a SQL mode sends its SQL strings to, change
-the local value of `sql-buffer' using \\[sql-set-sqli-buffer].")
-
-(defvar sql-prompt-regexp nil
-  "Prompt used to initialize `comint-prompt-regexp'.
-
-You can change `sql-prompt-regexp' on `sql-interactive-mode-hook'.")
-
-(defvar sql-prompt-length 0
-  "Prompt used to set `left-margin' in `sql-interactive-mode'.
-
-You can change `sql-prompt-length' on `sql-interactive-mode-hook'.")
-
-(defvar sql-alternate-buffer-name nil
-  "Buffer-local string used to possibly rename the SQLi buffer.
-
-Used by `sql-rename-buffer'.")
-
-;; Keymap for sql-interactive-mode.
-
-(defvar sql-interactive-mode-map
-  (let ((map (make-sparse-keymap)))
-    (if (functionp 'set-keymap-parent)
-	(set-keymap-parent map comint-mode-map); Emacs
-      (set-keymap-parents map (list comint-mode-map))); XEmacs
-    (if (functionp 'set-keymap-name)
-	(set-keymap-name map 'sql-interactive-mode-map)); XEmacs
-    (define-key map (kbd "C-j") 'sql-accumulate-and-indent)
-    (define-key map (kbd "C-c C-w") 'sql-copy-column)
-    (define-key map (kbd "O") 'sql-magic-go)
-    (define-key map (kbd "o") 'sql-magic-go)
-    (define-key map (kbd ";") 'sql-magic-semicolon)
-    map)
-  "Mode map used for `sql-interactive-mode'.
-Based on `comint-mode-map'.")
-
-;; Keymap for sql-mode.
-
-(defvar sql-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map (kbd "C-c C-c") 'sql-send-paragraph)
-    (define-key map (kbd "C-c C-r") 'sql-send-region)
-    (define-key map (kbd "C-c C-s") 'sql-send-string)
-    (define-key map (kbd "C-c C-b") 'sql-send-buffer)
-    map)
-  "Mode map used for `sql-mode'.")
-
-;; easy menu for sql-mode.
-
-(easy-menu-define
- sql-mode-menu sql-mode-map
- "Menu for `sql-mode'."
- '("SQL"
-   ["Send Paragraph" sql-send-paragraph (and (buffer-live-p sql-buffer)
-					     (get-buffer-process sql-buffer))]
-   ["Send Region" sql-send-region (and (or (and (boundp 'mark-active); Emacs
-						mark-active)
-					   (mark t)); XEmacs
-				       (buffer-live-p sql-buffer)
-				       (get-buffer-process sql-buffer))]
-   ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer)
-				       (get-buffer-process sql-buffer))]
-   ["Send String" sql-send-string t]
-   "--"
-   ["Start SQLi session" sql-product-interactive (sql-product-feature :sqli-connect)]
-   ["Show SQLi buffer" sql-show-sqli-buffer t]
-   ["Set SQLi buffer" sql-set-sqli-buffer t]
-   ["Pop to SQLi buffer after send"
-    sql-toggle-pop-to-buffer-after-send-region
-    :style toggle
-    :selected sql-pop-to-buffer-after-send-region]
-   "--"
-   ("Product"
-    ["ANSI" sql-highlight-ansi-keywords
-     :style radio
-     :selected (eq sql-product 'ansi)]
-    ["DB2" sql-highlight-db2-keywords
-     :style radio
-     :selected (eq sql-product 'db2)]
-    ["Informix" sql-highlight-informix-keywords
-     :style radio
-     :selected (eq sql-product 'informix)]
-    ["Ingres" sql-highlight-ingres-keywords
-     :style radio
-     :selected (eq sql-product 'ingres)]
-    ["Interbase" sql-highlight-interbase-keywords
-     :style radio
-     :selected (eq sql-product 'interbase)]
-    ["Linter" sql-highlight-linter-keywords
-     :style radio
-     :selected (eq sql-product 'linter)]
-    ["MS SQLServer" sql-highlight-ms-keywords
-     :style radio
-     :selected (eq sql-product 'ms)]
-    ["MySQL" sql-highlight-mysql-keywords
-     :style radio
-     :selected (eq sql-product 'mysql)]
-    ["Oracle" sql-highlight-oracle-keywords
-     :style radio
-     :selected (eq sql-product 'oracle)]
-    ["Postgres" sql-highlight-postgres-keywords
-     :style radio
-     :selected (eq sql-product 'postgres)]
-    ["Solid" sql-highlight-solid-keywords
-     :style radio
-     :selected (eq sql-product 'solid)]
-    ["SQLite" sql-highlight-sqlite-keywords
-     :style radio
-     :selected (eq sql-product 'sqlite)]
-    ["Sybase" sql-highlight-sybase-keywords
-     :style radio
-     :selected (eq sql-product 'sybase)]
-    )))
-
-;; easy menu for sql-interactive-mode.
-
-(easy-menu-define
- sql-interactive-mode-menu sql-interactive-mode-map
- "Menu for `sql-interactive-mode'."
- '("SQL"
-   ["Rename Buffer" sql-rename-buffer t]))
-
-;; Abbreviations -- if you want more of them, define them in your
-;; ~/.emacs file.  Abbrevs have to be enabled in your ~/.emacs, too.
-
-(defvar sql-mode-abbrev-table nil
-  "Abbrev table used in `sql-mode' and `sql-interactive-mode'.")
-(unless sql-mode-abbrev-table
-  (define-abbrev-table 'sql-mode-abbrev-table nil)
-  (mapcar
-    ;; In Emacs 21.3+, provide SYSTEM-FLAG to define-abbrev.
-   '(lambda (abbrev)
-      (let ((name (car abbrev))
-	    (expansion (cadr abbrev)))
-	(condition-case nil
-	    (define-abbrev sql-mode-abbrev-table name expansion nil 0 t)
-	  (error
-	   (define-abbrev sql-mode-abbrev-table name expansion)))))
-   '(("ins" "insert")
-    ("upd" "update")
-    ("del" "delete")
-    ("sel" "select")
-    ("proc" "procedure")
-    ("func" "function")
-    ("cr" "create"))))
-
-;; Syntax Table
-
-(defvar sql-mode-syntax-table
-  (let ((table (make-syntax-table)))
-    ;; C-style comments /**/ (see elisp manual "Syntax Flags"))
-    (modify-syntax-entry ?/ ". 14" table)
-    (modify-syntax-entry ?* ". 23" table)
-    ;; double-dash starts comment
-    (if (string-match "XEmacs\\|Lucid" emacs-version)
-	(modify-syntax-entry ?- ". 56" table)
-      (modify-syntax-entry ?- ". 12b" table))
-    ;; newline and formfeed end coments
-    (modify-syntax-entry ?\n "> b" table)
-    (modify-syntax-entry ?\f "> b" table)
-    ;; single quotes (') quotes delimit strings
-    (modify-syntax-entry ?' "\"" table)
-    ;; backslash is no escape character
-    (modify-syntax-entry ?\\ "." table)
-    table)
-  "Syntax table used in `sql-mode' and `sql-interactive-mode'.")
-
-;; Font lock support
-
-(defvar sql-mode-font-lock-object-name
-  (list (concat "^\\s-*\\(create\\|drop\\|alter\\)\\s-+" ;; lead off with CREATE, DROP or ALTER
-		"\\(\\w+\\s-+\\)*"  ;; optional intervening keywords
-		"\\(table\\|view\\|package\\(\\s-+body\\)?\\|proc\\(edure\\)?"
-		"\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+"
-		"\\(\\w+\\)")
-	6 'font-lock-function-name-face)
-
-  "Pattern to match the names of top-level objects.
-
-The pattern matches the name in a CREATE, DROP or ALTER
-statement.  The format of variable should be a valid
-`font-lock-keywords' entry.")
-
-(defmacro sql-keywords-re (&rest keywords)
-  "Compile-time generation of regexp matching any one of KEYWORDS."
-  `(eval-when-compile
-     (concat "\\b"
-	     (regexp-opt ',keywords t)
-	     "\\b")))
-
-(defvar sql-mode-ansi-font-lock-keywords
-  (let ((ansi-funcs (sql-keywords-re
-"abs" "avg" "bit_length" "cardinality" "cast" "char_length"
-"character_length" "coalesce" "convert" "count" "current_date"
-"current_path" "current_role" "current_time" "current_timestamp"
-"current_user" "extract" "localtime" "localtimestamp" "lower" "max"
-"min" "mod" "nullif" "octet_length" "overlay" "placing" "session_user"
-"substring" "sum" "system_user" "translate" "treat" "trim" "upper"
-"user"
-))
-
-	(ansi-non-reserved (sql-keywords-re
-"ada" "asensitive" "assignment" "asymmetric" "atomic" "between"
-"bitvar" "called" "catalog_name" "chain" "character_set_catalog"
-"character_set_name" "character_set_schema" "checked" "class_origin"
-"cobol" "collation_catalog" "collation_name" "collation_schema"
-"column_name" "command_function" "command_function_code" "committed"
-"condition_number" "connection_name" "constraint_catalog"
-"constraint_name" "constraint_schema" "contains" "cursor_name"
-"datetime_interval_code" "datetime_interval_precision" "defined"
-"definer" "dispatch" "dynamic_function" "dynamic_function_code"
-"existing" "exists" "final" "fortran" "generated" "granted"
-"hierarchy" "hold" "implementation" "infix" "insensitive" "instance"
-"instantiable" "invoker" "key_member" "key_type" "length" "m"
-"message_length" "message_octet_length" "message_text" "method" "more"
-"mumps" "name" "nullable" "number" "options" "overlaps" "overriding"
-"parameter_mode" "parameter_name" "parameter_ordinal_position"
-"parameter_specific_catalog" "parameter_specific_name"
-"parameter_specific_schema" "pascal" "pli" "position" "repeatable"
-"returned_length" "returned_octet_length" "returned_sqlstate"
-"routine_catalog" "routine_name" "routine_schema" "row_count" "scale"
-"schema_name" "security" "self" "sensitive" "serializable"
-"server_name" "similar" "simple" "source" "specific_name" "style"
-"subclass_origin" "sublist" "symmetric" "system" "table_name"
-"transaction_active" "transactions_committed"
-"transactions_rolled_back" "transform" "transforms" "trigger_catalog"
-"trigger_name" "trigger_schema" "type" "uncommitted" "unnamed"
-"user_defined_type_catalog" "user_defined_type_name"
-"user_defined_type_schema"
-))
-
-	(ansi-reserved (sql-keywords-re
-"absolute" "action" "add" "admin" "after" "aggregate" "alias" "all"
-"allocate" "alter" "and" "any" "are" "as" "asc" "assertion" "at"
-"authorization" "before" "begin" "both" "breadth" "by" "call"
-"cascade" "cascaded" "case" "catalog" "check" "class" "close"
-"collate" "collation" "column" "commit" "completion" "connect"
-"connection" "constraint" "constraints" "constructor" "continue"
-"corresponding" "create" "cross" "cube" "current" "cursor" "cycle"
-"data" "day" "deallocate" "declare" "default" "deferrable" "deferred"
-"delete" "depth" "deref" "desc" "describe" "descriptor" "destroy"
-"destructor" "deterministic" "diagnostics" "dictionary" "disconnect"
-"distinct" "domain" "drop" "dynamic" "each" "else" "end" "equals"
-"escape" "every" "except" "exception" "exec" "execute" "external"
-"false" "fetch" "first" "for" "foreign" "found" "free" "from" "full"
-"function" "general" "get" "global" "go" "goto" "grant" "group"
-"grouping" "having" "host" "hour" "identity" "ignore" "immediate" "in"
-"indicator" "initialize" "initially" "inner" "inout" "input" "insert"
-"intersect" "into" "is" "isolation" "iterate" "join" "key" "language"
-"last" "lateral" "leading" "left" "less" "level" "like" "limit"
-"local" "locator" "map" "match" "minute" "modifies" "modify" "module"
-"month" "names" "natural" "new" "next" "no" "none" "not" "null" "of"
-"off" "old" "on" "only" "open" "operation" "option" "or" "order"
-"ordinality" "out" "outer" "output" "pad" "parameter" "parameters"
-"partial" "path" "postfix" "prefix" "preorder" "prepare" "preserve"
-"primary" "prior" "privileges" "procedure" "public" "read" "reads"
-"recursive" "references" "referencing" "relative" "restrict" "result"
-"return" "returns" "revoke" "right" "role" "rollback" "rollup"
-"routine" "rows" "savepoint" "schema" "scroll" "search" "second"
-"section" "select" "sequence" "session" "set" "sets" "size" "some"
-"space" "specific" "specifictype" "sql" "sqlexception" "sqlstate"
-"sqlwarning" "start" "state" "statement" "static" "structure" "table"
-"temporary" "terminate" "than" "then" "timezone_hour"
-"timezone_minute" "to" "trailing" "transaction" "translation"
-"trigger" "true" "under" "union" "unique" "unknown" "unnest" "update"
-"usage" "using" "value" "values" "variable" "view" "when" "whenever"
-"where" "with" "without" "work" "write" "year"
-))
-
-	(ansi-types (sql-keywords-re
-"array" "binary" "bit" "blob" "boolean" "char" "character" "clob"
-"date" "dec" "decimal" "double" "float" "int" "integer" "interval"
-"large" "national" "nchar" "nclob" "numeric" "object" "precision"
-"real" "ref" "row" "scope" "smallint" "time" "timestamp" "varchar"
-"varying" "zone"
-)))
-
-    `((,ansi-non-reserved . font-lock-keyword-face)
-      (,ansi-reserved     . font-lock-keyword-face)
-      (,ansi-funcs        . font-lock-builtin-face)
-      (,ansi-types        . font-lock-type-face)))
-
-  "ANSI SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-ansi-font-lock-keywords.  You may want to
-add functions and PL/SQL keywords.")
-
-(defvar sql-mode-oracle-font-lock-keywords
-  (let ((oracle-functions (sql-keywords-re
-"abs" "acos" "add_months" "ascii" "asciistr" "asin" "atan" "atan2"
-"avg" "bfilename" "bin_to_num" "bitand" "cast" "ceil" "chartorowid"
-"chr" "coalesce" "compose" "concat" "convert" "corr" "cos" "cosh"
-"count" "covar_pop" "covar_samp" "cume_dist" "current_date"
-"current_timestamp" "current_user" "dbtimezone" "decode" "decompose"
-"dense_rank" "depth" "deref" "dump" "empty_clob" "existsnode" "exp"
-"extract" "extractvalue" "first" "first_value" "floor" "following"
-"from_tz" "greatest" "group_id" "grouping_id" "hextoraw" "initcap"
-"instr" "lag" "last" "last_day" "last_value" "lead" "least" "length"
-"ln" "localtimestamp" "lower" "lpad" "ltrim" "make_ref" "max" "min"
-"mod" "months_between" "new_time" "next_day" "nls_charset_decl_len"
-"nls_charset_id" "nls_charset_name" "nls_initcap" "nls_lower"
-"nls_upper" "nlssort" "ntile" "nullif" "numtodsinterval"
-"numtoyminterval" "nvl" "nvl2" "over" "path" "percent_rank"
-"percentile_cont" "percentile_disc" "power" "preceding" "rank"
-"ratio_to_report" "rawtohex" "rawtonhex" "reftohex" "regr_"
-"regr_avgx" "regr_avgy" "regr_count" "regr_intercept" "regr_r2"
-"regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "replace" "round"
-"row_number" "rowidtochar" "rowidtonchar" "rpad" "rtrim"
-"sessiontimezone" "sign" "sin" "sinh" "soundex" "sqrt" "stddev"
-"stddev_pop" "stddev_samp" "substr" "sum" "sys_connect_by_path"
-"sys_context" "sys_dburigen" "sys_extract_utc" "sys_guid" "sys_typeid"
-"sys_xmlagg" "sys_xmlgen" "sysdate" "systimestamp" "tan" "tanh"
-"to_char" "to_clob" "to_date" "to_dsinterval" "to_lob" "to_multi_byte"
-"to_nchar" "to_nclob" "to_number" "to_single_byte" "to_timestamp"
-"to_timestamp_tz" "to_yminterval" "translate" "treat" "trim" "trunc"
-"tz_offset" "uid" "unbounded" "unistr" "updatexml" "upper" "user"
-"userenv" "var_pop" "var_samp" "variance" "vsize" "width_bucket" "xml"
-"xmlagg" "xmlattribute" "xmlcolattval" "xmlconcat" "xmlelement"
-"xmlforest" "xmlsequence" "xmltransform"
-))
-
-	(oracle-keywords (sql-keywords-re
-"abort" "access" "accessed" "account" "activate" "add" "admin"
-"advise" "after" "agent" "aggregate" "all" "allocate" "allow" "alter"
-"always" "analyze" "ancillary" "and" "any" "apply" "archive"
-"archivelog" "array" "as" "asc" "associate" "at" "attribute"
-"attributes" "audit" "authenticated" "authid" "authorization" "auto"
-"autoallocate" "automatic" "availability" "backup" "before" "begin"
-"behalf" "between" "binding" "bitmap" "block" "blocksize" "body"
-"both" "buffer_pool" "build" "by"  "cache" "call" "cancel"
-"cascade" "case" "category" "certificate" "chained" "change" "check"
-"checkpoint" "child" "chunk" "class" "clear" "clone" "close" "cluster"
-"column" "column_value" "columns" "comment" "commit" "committed"
-"compatibility" "compile" "complete" "composite_limit" "compress"
-"compute" "connect" "connect_time" "consider" "consistent"
-"constraint" "constraints" "constructor" "contents" "context"
-"continue" "controlfile" "corruption" "cost" "cpu_per_call"
-"cpu_per_session" "create" "cross" "cube" "current" "currval" "cycle"
-"dangling" "data" "database" "datafile" "datafiles" "day" "ddl"
-"deallocate" "debug" "default" "deferrable" "deferred" "definer"
-"delay" "delete" "demand" "desc" "determines" "deterministic"
-"dictionary" "dimension" "directory" "disable" "disassociate"
-"disconnect" "distinct" "distinguished" "distributed" "dml" "drop"
-"each" "element" "else" "enable" "end" "equals_path" "escape"
-"estimate" "except" "exceptions" "exchange" "excluding" "exists"
-"expire" "explain" "extent" "external" "externally"
-"failed_login_attempts" "fast" "file" "final" "finish" "flush" "for"
-"force" "foreign" "freelist" "freelists" "freepools" "fresh" "from"
-"full" "function" "functions" "generated" "global" "global_name"
-"globally" "grant" "group" "grouping" "groups" "guard" "hash"
-"hashkeys" "having" "heap" "hierarchy" "id" "identified" "identifier"
-"idle_time" "immediate" "in" "including" "increment" "index" "indexed"
-"indexes" "indextype" "indextypes" "indicator" "initial" "initialized"
-"initially" "initrans" "inner" "insert" "instance" "instantiable"
-"instead" "intersect" "into" "invalidate" "is" "isolation" "java"
-"join"  "keep" "key" "kill" "language" "left" "less" "level"
-"levels" "library" "like" "like2" "like4" "likec" "limit" "link"
-"list" "lob" "local" "location" "locator" "lock" "log" "logfile"
-"logging" "logical" "logical_reads_per_call"
-"logical_reads_per_session"  "managed" "management" "manual" "map"
-"mapping" "master" "matched" "materialized" "maxdatafiles"
-"maxextents" "maximize" "maxinstances" "maxlogfiles" "maxloghistory"
-"maxlogmembers" "maxsize" "maxtrans" "maxvalue" "member" "memory"
-"merge" "migrate" "minextents" "minimize" "minimum" "minus" "minvalue"
-"mode" "modify" "monitoring" "month" "mount" "move" "movement" "name"
-"named" "natural" "nested" "never" "new" "next" "nextval" "no"
-"noarchivelog" "noaudit" "nocache" "nocompress" "nocopy" "nocycle"
-"nodelay" "noforce" "nologging" "nomapping" "nomaxvalue" "nominimize"
-"nominvalue" "nomonitoring" "none" "noorder" "noparallel" "norely"
-"noresetlogs" "noreverse" "normal" "norowdependencies" "nosort"
-"noswitch" "not" "nothing" "notimeout" "novalidate" "nowait" "null"
-"nulls" "object" "of" "off" "offline" "oidindex" "old" "on" "online"
-"only" "open" "operator" "optimal" "option" "or" "order"
-"organization" "out" "outer" "outline" "overflow" "overriding"
-"package" "packages" "parallel" "parallel_enable" "parameters"
-"parent" "partition" "partitions" "password" "password_grace_time"
-"password_life_time" "password_lock_time" "password_reuse_max"
-"password_reuse_time" "password_verify_function" "pctfree"
-"pctincrease" "pctthreshold" "pctused" "pctversion" "percent"
-"performance" "permanent" "pfile" "physical" "pipelined" "plan"
-"post_transaction" "pragma" "prebuilt" "preserve" "primary" "private"
-"private_sga" "privileges" "procedure" "profile" "protection" "public"
-"purge" "query" "quiesce" "quota" "range" "read" "reads" "rebuild"
-"records_per_block" "recover" "recovery" "recycle" "reduced" "ref"
-"references" "referencing" "refresh" "register" "reject" "relational"
-"rely" "rename" "reset" "resetlogs" "resize" "resolve" "resolver"
-"resource" "restrict" "restrict_references" "restricted" "result"
-"resumable" "resume" "retention" "return" "returning" "reuse"
-"reverse" "revoke" "rewrite" "right" "rnds" "rnps" "role" "roles"
-"rollback" "rollup" "row" "rowdependencies" "rownum" "rows" "sample"
-"savepoint" "scan" "schema" "scn" "scope" "segment" "select"
-"selectivity" "self" "sequence" "serializable" "session"
-"sessions_per_user" "set" "sets" "settings" "shared" "shared_pool"
-"shrink" "shutdown" "siblings" "sid" "single" "size" "skip" "some"
-"sort" "source" "space" "specification" "spfile" "split" "standby"
-"start" "statement_id" "static" "statistics" "stop" "storage" "store"
-"structure" "subpartition" "subpartitions" "substitutable"
-"successful" "supplemental" "suspend" "switch" "switchover" "synonym"
-"sys" "system" "table" "tables" "tablespace" "tempfile" "template"
-"temporary" "test" "than" "then" "thread" "through" "time_zone"
-"timeout" "to" "trace" "transaction" "trigger" "triggers" "truncate"
-"trust" "type" "types" "unarchived" "under" "under_path" "undo"
-"uniform" "union" "unique" "unlimited" "unlock" "unquiesce"
-"unrecoverable" "until" "unusable" "unused" "update" "upgrade" "usage"
-"use" "using" "validate" "validation" "value" "values" "variable"
-"varray" "version" "view" "wait" "when" "whenever" "where" "with"
-"without" "wnds" "wnps" "work" "write" "xmldata" "xmlschema" "xmltype"
-))
-
-	(oracle-types (sql-keywords-re
-"bfile" "blob" "byte" "char" "character" "clob" "date" "dec" "decimal"
-"double" "float" "int" "integer" "interval" "long" "national" "nchar"
-"nclob" "number" "numeric" "nvarchar2" "precision" "raw" "real"
-"rowid" "second" "smallint" "time" "timestamp" "urowid" "varchar"
-"varchar2" "varying" "year" "zone"
-))
-
-	(plsql-functions (sql-keywords-re
-"%bulk_rowcount" "%found" "%isopen" "%notfound" "%rowcount" "%rowtype"
-"%type" "extend" "prior"
-))
-
-	(plsql-keywords (sql-keywords-re
-"autonomous_transaction" "bulk" "char_base" "collect" "constant"
-"cursor" "declare" "do" "elsif" "exception_init" "execute" "exit"
-"extends" "false" "fetch" "forall" "goto" "hour" "if" "interface"
-"loop" "minute" "number_base" "ocirowid" "opaque" "others" "rowtype"
-"separate" "serially_reusable" "sql" "sqlcode" "sqlerrm" "subtype"
-"the" "timezone_abbr" "timezone_hour" "timezone_minute"
-"timezone_region" "true" "varrying" "while"
-))
-
-	(plsql-type (sql-keywords-re
-"binary_integer" "boolean" "naturaln" "pls_integer" "positive"
-"positiven" "record" "signtype" "string"
-))
-
-	(plsql-warning (sql-keywords-re
-"access_into_null" "case_not_found" "collection_is_null"
-"cursor_already_open" "dup_val_on_index" "invalid_cursor"
-"invalid_number" "login_denied" "no_data_found" "not_logged_on"
-"program_error" "rowtype_mismatch" "self_is_null" "storage_error"
-"subscript_beyond_count" "subscript_outside_limit" "sys_invalid_rowid"
-"timeout_on_resource" "too_many_rows" "value_error" "zero_divide"
-"exception" "notfound"
-))
-
-	(sqlplus-commands
-	 (eval-when-compile (concat "^\\(\\("
-				    (regexp-opt '(
-"@" "@@" "accept" "append" "archive" "attribute" "break"
-"btitle" "change" "clear" "column" "connect" "copy" "define"
-"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help"
-"host" "input" "list" "password" "pause" "print" "prompt" "recover"
-"remark" "repfooter" "repheader" "run" "save" "show" "shutdown"
-"spool" "start" "startup" "store" "timing" "ttitle" "undefine"
-"variable" "whenever"
-
-) t)
-
-   "\\)\\|"
-   "\\(compute\\s-+\\(avg\\|cou\\|min\\|max\\|num\\|sum\\|std\\|var\\)\\)\\|"
-   "\\(set\\s-+\\(appi\\(nfo\\)?\\|array\\(size\\)?\\|"
-   "auto\\(commit\\)?\\|autop\\(rint\\)?\\|autorecovery\\|"
-   "autot\\(race\\)?\\|blo\\(ckterminator\\)?\\|cmds\\(ep\\)?\\|"
-   "colsep\\|com\\(patibility\\)?\\|con\\(cat\\)?\\|"
-   "copyc\\(ommit\\)?\\|copytypecheck\\|def\\(ine\\)?\\|"
-   "describe\\|echo\\|editf\\(ile\\)?\\|emb\\(edded\\)?\\|"
-   "esc\\(ape\\)?\\|feed\\(back\\)?\\|flagger\\|"
-   "flu\\(sh\\)?\\|hea\\(ding\\)?\\|heads\\(ep\\)?\\|"
-   "instance\\|lin\\(esize\\)?\\|lobof\\(fset\\)?\\|"
-   "logsource\\|long\\|longc\\(hunksize\\)?\\|mark\\(up\\)?\\|"
-   "newp\\(age\\)?\\|null\\|numf\\(ormat\\)?\\|"
-   "num\\(width\\)?\\|pages\\(ize\\)?\\|pau\\(se\\)?\\|"
-   "recsep\\|recsepchar\\|serverout\\(put\\)?\\|"
-   "shift\\(inout\\)?\\|show\\(mode\\)?\\|"
-   "sqlbl\\(anklines\\)?\\|sqlc\\(ase\\)?\\|"
-   "sqlco\\(ntinue\\)?\\|sqln\\(umber\\)?\\|"
-   "sqlpluscompat\\(ibility\\)?\\|sqlpre\\(fix\\)?\\|"
-   "sqlp\\(rompt\\)?\\|sqlt\\(erminator\\)?\\|"
-   "suf\\(fix\\)?\\|tab\\|term\\(out\\)?\\|ti\\(me\\)?\\|"
-   "timi\\(ng\\)?\\|trim\\(out\\)?\\|trims\\(pool\\)?\\|"
-   "und\\(erline\\)?\\|ver\\(ify\\)?\\|wra\\(p\\)?\\)\\)\\)"
-   "\\b.*$"
-   ))))
-
-    `((,sqlplus-commands . font-lock-doc-face)
-      (,oracle-functions . font-lock-builtin-face)
-      (,oracle-keywords  . font-lock-keyword-face)
-      (,oracle-types     . font-lock-type-face)
-      (,plsql-functions  . font-lock-builtin-face)
-      (,plsql-keywords   . font-lock-keyword-face)
-      (,plsql-type       . font-lock-type-face)
-      (,plsql-warning    . font-lock-warning-face)))
-
-  "Oracle SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-oracle-font-lock-keywords.  You may want
-to add functions and PL/SQL keywords.")
-
-(defvar sql-mode-postgres-font-lock-keywords
-  (let ((pg-funcs (sql-keywords-re
-"abbrev" "abs" "acos" "age" "area" "ascii" "asin" "atab2" "atan"
-"atan2" "avg" "bit_length" "both" "broadcast" "btrim" "cbrt" "ceil"
-"center" "char_length" "chr" "coalesce" "col_description" "convert"
-"cos" "cot" "count" "current_database" "current_date" "current_schema"
-"current_schemas" "current_setting" "current_time" "current_timestamp"
-"current_user" "currval" "date_part" "date_trunc" "decode" "degrees"
-"diameter" "encode" "exp" "extract" "floor" "get_bit" "get_byte"
-"has_database_privilege" "has_function_privilege"
-"has_language_privilege" "has_schema_privilege" "has_table_privilege"
-"height" "host" "initcap" "isclosed" "isfinite" "isopen" "leading"
-"length" "ln" "localtime" "localtimestamp" "log" "lower" "lpad"
-"ltrim" "masklen" "max" "min" "mod" "netmask" "network" "nextval"
-"now" "npoints" "nullif" "obj_description" "octet_length" "overlay"
-"pclose" "pg_client_encoding" "pg_function_is_visible"
-"pg_get_constraintdef" "pg_get_indexdef" "pg_get_ruledef"
-"pg_get_userbyid" "pg_get_viewdef" "pg_opclass_is_visible"
-"pg_operator_is_visible" "pg_table_is_visible" "pg_type_is_visible"
-"pi" "popen" "position" "pow" "quote_ident" "quote_literal" "radians"
-"radius" "random" "repeat" "replace" "round" "rpad" "rtrim"
-"session_user" "set_bit" "set_byte" "set_config" "set_masklen"
-"setval" "sign" "sin" "split_part" "sqrt" "stddev" "strpos" "substr"
-"substring" "sum" "tan" "timeofday" "to_ascii" "to_char" "to_date"
-"to_hex" "to_number" "to_timestamp" "trailing" "translate" "trim"
-"trunc" "upper" "variance" "version" "width"
-))
-
-	(pg-reserved (sql-keywords-re
-"abort" "access" "add" "after" "aggregate" "alignment" "all" "alter"
-"analyze" "and" "any" "as" "asc" "assignment" "authorization"
-"backward" "basetype" "before" "begin" "between" "binary" "by" "cache"
-"called" "cascade" "case" "cast" "characteristics" "check"
-"checkpoint" "class" "close" "cluster" "column" "comment" "commit"
-"committed" "commutator" "constraint" "constraints" "conversion"
-"copy" "create" "createdb" "createuser" "cursor" "cycle" "database"
-"deallocate" "declare" "default" "deferrable" "deferred" "definer"
-"delete" "delimiter" "desc" "distinct" "do" "domain" "drop" "each"
-"element" "else" "encoding" "encrypted" "end" "escape" "except"
-"exclusive" "execute" "exists" "explain" "extended" "external" "false"
-"fetch" "finalfunc" "for" "force" "foreign" "forward" "freeze" "from"
-"full" "function" "grant" "group" "gtcmp" "handler" "hashes" "having"
-"immediate" "immutable" "implicit" "in" "increment" "index" "inherits"
-"initcond" "initially" "input" "insensitive" "insert" "instead"
-"internallength" "intersect" "into" "invoker" "is" "isnull"
-"isolation" "join" "key" "language" "leftarg" "level" "like" "limit"
-"listen" "load" "local" "location" "lock" "ltcmp" "main" "match"
-"maxvalue" "merges" "minvalue" "mode" "move" "natural" "negator"
-"next" "nocreatedb" "nocreateuser" "none" "not" "nothing" "notify"
-"notnull" "null" "of" "offset" "oids" "on" "only" "operator" "or"
-"order" "output" "owner" "partial" "passedbyvalue" "password" "plain"
-"prepare" "primary" "prior" "privileges" "procedural" "procedure"
-"public" "read" "recheck" "references" "reindex" "relative" "rename"
-"reset" "restrict" "returns" "revoke" "rightarg" "rollback" "row"
-"rule" "schema" "scroll" "security" "select" "sequence" "serializable"
-"session" "set" "sfunc" "share" "show" "similar" "some" "sort1"
-"sort2" "stable" "start" "statement" "statistics" "storage" "strict"
-"stype" "sysid" "table" "temp" "template" "temporary" "then" "to"
-"transaction" "trigger" "true" "truncate" "trusted" "type"
-"unencrypted" "union" "unique" "unknown" "unlisten" "until" "update"
-"usage" "user" "using" "vacuum" "valid" "validator" "values"
-"variable" "verbose" "view" "volatile" "when" "where" "with" "without"
-"work"
-))
-
-	(pg-types (sql-keywords-re
-"anyarray" "bigint" "bigserial" "bit" "boolean" "box" "bytea" "char"
-"character" "cidr" "circle" "cstring" "date" "decimal" "double"
-"float4" "float8" "inet" "int2" "int4" "int8" "integer" "internal"
-"interval" "language_handler" "line" "lseg" "macaddr" "money"
-"numeric" "oid" "opaque" "path" "point" "polygon" "precision" "real"
-"record" "regclass" "regoper" "regoperator" "regproc" "regprocedure"
-"regtype" "serial" "serial4" "serial8" "smallint" "text" "time"
-"timestamp" "varchar" "varying" "void" "zone"
-)))
-
-  `((,pg-funcs    . font-lock-builtin-face)
-    (,pg-reserved . font-lock-keyword-face)
-    (,pg-types    . font-lock-type-face)))
-
-  "Postgres SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-postgres-font-lock-keywords.")
-
-(defvar sql-mode-linter-font-lock-keywords
-  (let ((linter-keywords (sql-keywords-re
-"autocommit" "autoinc" "autorowid" "cancel" "cascade" "channel"
-"committed" "count" "countblob" "cross" "current" "data" "database"
-"datafile" "datafiles" "datesplit" "dba" "dbname" "default" "deferred"
-"denied" "description" "device" "difference" "directory" "error"
-"escape" "euc" "exclusive" "external" "extfile" "false" "file"
-"filename" "filesize" "filetime" "filter" "findblob" "first" "foreign"
-"full" "fuzzy" "global" "granted" "ignore" "immediate" "increment"
-"indexes" "indexfile" "indexfiles" "indextime" "initial" "integrity"
-"internal" "key" "last_autoinc" "last_rowid" "limit" "linter"
-"linter_file_device" "linter_file_size" "linter_name_length" "ln"
-"local" "login" "maxisn" "maxrow" "maxrowid" "maxvalue" "message"
-"minvalue" "module" "names" "national" "natural" "new" "new_table"
-"no" "node" "noneuc" "nulliferror" "numbers" "off" "old" "old_table"
-"only" "operation" "optimistic" "option" "page" "partially" "password"
-"phrase" "plan" "precision" "primary" "priority" "privileges"
-"proc_info_size" "proc_par_name_len" "protocol" "quant" "range" "raw"
-"read" "record" "records" "references" "remote" "rename" "replication"
-"restart" "rewrite" "root" "row" "rule" "savepoint" "security"
-"sensitive" "sequence" "serializable" "server" "since" "size" "some"
-"startup" "statement" "station" "success" "sys_guid" "tables" "test"
-"timeout" "trace" "transaction" "translation" "trigger"
-"trigger_info_size" "true" "trunc" "uncommitted" "unicode" "unknown"
-"unlimited" "unlisted" "user" "utf8" "value" "varying" "volumes"
-"wait" "windows_code" "workspace" "write" "xml"
-))
-
-	(linter-reserved (sql-keywords-re
-"access" "action" "add" "address" "after" "all" "alter" "always" "and"
-"any" "append" "as" "asc" "ascic" "async" "at_begin" "at_end" "audit"
-"aud_obj_name_len" "backup" "base" "before" "between" "blobfile"
-"blobfiles" "blobpct" "brief" "browse" "by" "case" "cast" "check"
-"clear" "close" "column" "comment" "commit" "connect" "contains"
-"correct" "create" "delete" "desc" "disable" "disconnect" "distinct"
-"drop" "each" "ef" "else" "enable" "end" "event" "except" "exclude"
-"execute" "exists" "extract" "fetch" "finish" "for" "from" "get"
-"grant" "group" "having" "identified" "in" "index" "inner" "insert"
-"instead" "intersect" "into" "is" "isolation" "join" "left" "level"
-"like" "lock" "mode" "modify" "not" "nowait" "null" "of" "on" "open"
-"or" "order" "outer" "owner" "press" "prior" "procedure" "public"
-"purge" "rebuild" "resource" "restrict" "revoke" "right" "role"
-"rollback" "rownum" "select" "session" "set" "share" "shutdown"
-"start" "stop" "sync" "synchronize" "synonym" "sysdate" "table" "then"
-"to" "union" "unique" "unlock" "until" "update" "using" "values"
-"view" "when" "where" "with" "without"
-))
-
-	(linter-types (sql-keywords-re
-"bigint" "bitmap" "blob" "boolean" "char" "character" "date"
-"datetime" "dec" "decimal" "double" "float" "int" "integer" "nchar"
-"number" "numeric" "real" "smallint" "varbyte" "varchar" "byte"
-"cursor" "long"
-))
-
-	(linter-functions (sql-keywords-re
-"abs" "acos" "asin" "atan" "atan2" "avg" "ceil" "cos" "cosh" "divtime"
-"exp" "floor" "getbits" "getblob" "getbyte" "getlong" "getraw"
-"getstr" "gettext" "getword" "hextoraw" "lenblob" "length" "log"
-"lower" "lpad" "ltrim" "max" "min" "mod" "monthname" "nvl"
-"octet_length" "power" "rand" "rawtohex" "repeat_string"
-"right_substr" "round" "rpad" "rtrim" "sign" "sin" "sinh" "soundex"
-"sqrt" "sum" "tan" "tanh" "timeint_to_days" "to_char" "to_date"
-"to_gmtime" "to_localtime" "to_number" "trim" "upper" "decode"
-"substr" "substring" "chr" "dayname" "days" "greatest" "hex" "initcap"
-"instr" "least" "multime" "replace" "width"
-)))
-
-    `((,linter-keywords  . font-lock-keyword-face)
-      (,linter-reserved  . font-lock-keyword-face)
-      (,linter-functions . font-lock-builtin-face)
-      (,linter-types     . font-lock-type-face)))
-
-  "Linter SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.")
-
-(defvar sql-mode-ms-font-lock-keywords
-  (let ((ms-reserved (sql-keywords-re
-"absolute" "add" "all" "alter" "and" "any" "as" "asc" "authorization"
-"avg" "backup" "begin" "between" "break" "browse" "bulk" "by"
-"cascade" "case" "check" "checkpoint" "close" "clustered" "coalesce"
-"column" "commit" "committed" "compute" "confirm" "constraint"
-"contains" "containstable" "continue" "controlrow" "convert" "count"
-"create" "cross" "current" "current_date" "current_time"
-"current_timestamp" "current_user" "database" "deallocate" "declare"
-"default" "delete" "deny" "desc" "disk" "distinct" "distributed"
-"double" "drop" "dummy" "dump" "else" "end" "errlvl" "errorexit"
-"escape" "except" "exec" "execute" "exists" "exit" "fetch" "file"
-"fillfactor" "first" "floppy" "for" "foreign" "freetext"
-"freetexttable" "from" "full" "goto" "grant" "group" "having"
-"holdlock" "identity" "identity_insert" "identitycol" "if" "in"
-"index" "inner" "insert" "intersect" "into" "is" "isolation" "join"
-"key" "kill" "last" "left" "level" "like" "lineno" "load" "max" "min"
-"mirrorexit" "national" "next" "nocheck" "nolock" "nonclustered" "not"
-"null" "nullif" "of" "off" "offsets" "on" "once" "only" "open"
-"opendatasource" "openquery" "openrowset" "option" "or" "order"
-"outer" "output" "over" "paglock" "percent" "perm" "permanent" "pipe"
-"plan" "precision" "prepare" "primary" "print" "prior" "privileges"
-"proc" "procedure" "processexit" "public" "raiserror" "read"
-"readcommitted" "readpast" "readtext" "readuncommitted" "reconfigure"
-"references" "relative" "repeatable" "repeatableread" "replication"
-"restore" "restrict" "return" "revoke" "right" "rollback" "rowcount"
-"rowguidcol" "rowlock" "rule" "save" "schema" "select" "serializable"
-"session_user" "set" "shutdown" "some" "statistics" "sum"
-"system_user" "table" "tablock" "tablockx" "tape" "temp" "temporary"
-"textsize" "then" "to" "top" "tran" "transaction" "trigger" "truncate"
-"tsequal" "uncommitted" "union" "unique" "update" "updatetext"
-"updlock" "use" "user" "values" "view" "waitfor" "when" "where"
-"while" "with" "work" "writetext" "collate" "function" "openxml"
-"returns"
-))
-
-	(ms-types (sql-keywords-re
-"binary" "bit" "char" "character" "cursor" "datetime" "dec" "decimal"
-"double" "float" "image" "int" "integer" "money" "national" "nchar"
-"ntext" "numeric" "numeric" "nvarchar" "precision" "real"
-"smalldatetime" "smallint" "smallmoney" "text" "timestamp" "tinyint"
-"uniqueidentifier" "varbinary" "varchar" "varying"
-))
-
-	(ms-vars "\\b@[a-zA-Z0-9_]*\\b")
-
-	(ms-functions (sql-keywords-re
-"@@connections" "@@cpu_busy" "@@cursor_rows" "@@datefirst" "@@dbts"
-"@@error" "@@fetch_status" "@@identity" "@@idle" "@@io_busy"
-"@@langid" "@@language" "@@lock_timeout" "@@max_connections"
-"@@max_precision" "@@nestlevel" "@@options" "@@pack_received"
-"@@pack_sent" "@@packet_errors" "@@procid" "@@remserver" "@@rowcount"
-"@@servername" "@@servicename" "@@spid" "@@textsize" "@@timeticks"
-"@@total_errors" "@@total_read" "@@total_write" "@@trancount"
-"@@version" "abs" "acos" "and" "app_name" "ascii" "asin" "atan" "atn2"
-"avg" "case" "cast" "ceiling" "char" "charindex" "coalesce"
-"col_length" "col_name" "columnproperty" "containstable" "convert"
-"cos" "cot" "count" "current_timestamp" "current_user" "cursor_status"
-"databaseproperty" "datalength" "dateadd" "datediff" "datename"
-"datepart" "day" "db_id" "db_name" "degrees" "difference" "exp"
-"file_id" "file_name" "filegroup_id" "filegroup_name"
-"filegroupproperty" "fileproperty" "floor" "formatmessage"
-"freetexttable" "fulltextcatalogproperty" "fulltextserviceproperty"
-"getansinull" "getdate" "grouping" "host_id" "host_name" "ident_incr"
-"ident_seed" "identity" "index_col" "indexproperty" "is_member"
-"is_srvrolemember" "isdate" "isnull" "isnumeric" "left" "len" "log"
-"log10" "lower" "ltrim" "max" "min" "month" "nchar" "newid" "nullif"
-"object_id" "object_name" "objectproperty" "openquery" "openrowset"
-"parsename" "patindex" "patindex" "permissions" "pi" "power"
-"quotename" "radians" "rand" "replace" "replicate" "reverse" "right"
-"round" "rtrim" "session_user" "sign" "sin" "soundex" "space" "sqrt"
-"square" "stats_date" "stdev" "stdevp" "str" "stuff" "substring" "sum"
-"suser_id" "suser_name" "suser_sid" "suser_sname" "system_user" "tan"
-"textptr" "textvalid" "typeproperty" "unicode" "upper" "user"
-"user_id" "user_name" "var" "varp" "year"
-))
-
-	(ms-commands
-	 (eval-when-compile
-	   (concat "^\\(\\(set\\s-+\\("
-		   (regexp-opt '(
-"datefirst" "dateformat" "deadlock_priority" "lock_timeout"
-"concat_null_yields_null" "cursor_close_on_commit"
-"disable_def_cnst_chk" "fips_flagger" "identity_insert" "language"
-"offsets" "quoted_identifier" "arithabort" "arithignore" "fmtonly"
-"nocount" "noexec" "numeric_roundabort" "parseonly"
-"query_governor_cost_limit" "rowcount" "textsize" "ansi_defaults"
-"ansi_null_dflt_off" "ansi_null_dflt_on" "ansi_nulls" "ansi_padding"
-"ansi_warnings" "forceplan" "showplan_all" "showplan_text"
-"statistics" "implicit_transactions" "remote_proc_transactions"
-"transaction" "xact_abort"
-) t)
-		   "\\)\\)\\|go\\s-*\\|use\\s-+\\|setuser\\s-+\\|dbcc\\s-+\\).*$"))))
-
-    `((,ms-commands  . font-lock-doc-face)
-      (,ms-reserved  . font-lock-keyword-face)
-      (,ms-functions . font-lock-builtin-face)
-      (,ms-vars      . font-lock-variable-name-face)
-      (,ms-types     . font-lock-type-face)))
-
-  "Microsoft SQLServer SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-ms-font-lock-keywords.")
-
-(defvar sql-mode-sybase-font-lock-keywords nil
-  "Sybase SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-sybase-font-lock-keywords.")
-
-(defvar sql-mode-informix-font-lock-keywords nil
-  "Informix SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-informix-font-lock-keywords.")
-
-(defvar sql-mode-interbase-font-lock-keywords nil
-  "Interbase SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-interbase-font-lock-keywords.")
-
-(defvar sql-mode-ingres-font-lock-keywords nil
-  "Ingres SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-interbase-font-lock-keywords.")
-
-(defvar sql-mode-solid-font-lock-keywords nil
-  "Solid SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-solid-font-lock-keywords.")
-
-(defvar sql-mode-mysql-font-lock-keywords
-  (let ((mysql-funcs (sql-keywords-re
-"ascii" "avg" "bdmpolyfromtext" "bdmpolyfromwkb" "bdpolyfromtext"
-"bdpolyfromwkb" "benchmark" "bin" "bit_and" "bit_length" "bit_or"
-"bit_xor" "both" "cast" "char_length" "character_length" "coalesce"
-"concat" "concat_ws" "connection_id" "conv" "convert" "count"
-"curdate" "current_date" "current_time" "current_timestamp" "curtime"
-"elt" "encrypt" "export_set" "field" "find_in_set" "found_rows" "from"
-"geomcollfromtext" "geomcollfromwkb" "geometrycollectionfromtext"
-"geometrycollectionfromwkb" "geometryfromtext" "geometryfromwkb"
-"geomfromtext" "geomfromwkb" "get_lock" "group_concat" "hex" "ifnull"
-"instr" "interval" "isnull" "last_insert_id" "lcase" "leading"
-"length" "linefromtext" "linefromwkb" "linestringfromtext"
-"linestringfromwkb" "load_file" "locate" "lower" "lpad" "ltrim"
-"make_set" "master_pos_wait" "max" "mid" "min" "mlinefromtext"
-"mlinefromwkb" "mpointfromtext" "mpointfromwkb" "mpolyfromtext"
-"mpolyfromwkb" "multilinestringfromtext" "multilinestringfromwkb"
-"multipointfromtext" "multipointfromwkb" "multipolygonfromtext"
-"multipolygonfromwkb" "now" "nullif" "oct" "octet_length" "ord"
-"pointfromtext" "pointfromwkb" "polyfromtext" "polyfromwkb"
-"polygonfromtext" "polygonfromwkb" "position" "quote" "rand"
-"release_lock" "repeat" "replace" "reverse" "rpad" "rtrim" "soundex"
-"space" "std" "stddev" "substring" "substring_index" "sum" "sysdate"
-"trailing" "trim" "ucase" "unix_timestamp" "upper" "user" "variance"
-))
-
-	(mysql-keywords (sql-keywords-re
-"action" "add" "after" "against" "all" "alter" "and" "as" "asc"
-"auto_increment" "avg_row_length" "bdb" "between" "by" "cascade"
-"case" "change" "character" "check" "checksum" "close" "collate"
-"collation" "column" "columns" "comment" "committed" "concurrent"
-"constraint" "create" "cross" "data" "database" "default"
-"delay_key_write" "delayed" "delete" "desc" "directory" "disable"
-"distinct" "distinctrow" "do" "drop" "dumpfile" "duplicate" "else"
-"enable" "enclosed" "end" "escaped" "exists" "fields" "first" "for"
-"force" "foreign" "from" "full" "fulltext" "global" "group" "handler"
-"having" "heap" "high_priority" "if" "ignore" "in" "index" "infile"
-"inner" "insert" "insert_method" "into" "is" "isam" "isolation" "join"
-"key" "keys" "last" "left" "level" "like" "limit" "lines" "load"
-"local" "lock" "low_priority" "match" "max_rows" "merge" "min_rows"
-"mode" "modify" "mrg_myisam" "myisam" "natural" "next" "no" "not"
-"null" "offset" "oj" "on" "open" "optionally" "or" "order" "outer"
-"outfile" "pack_keys" "partial" "password" "prev" "primary"
-"procedure" "quick" "raid0" "raid_type" "read" "references" "rename"
-"repeatable" "restrict" "right" "rollback" "rollup" "row_format"
-"savepoint" "select" "separator" "serializable" "session" "set"
-"share" "show" "sql_big_result" "sql_buffer_result" "sql_cache"
-"sql_calc_found_rows" "sql_no_cache" "sql_small_result" "starting"
-"straight_join" "striped" "table" "tables" "temporary" "terminated"
-"then" "to" "transaction" "truncate" "type" "uncommitted" "union"
-"unique" "unlock" "update" "use" "using" "values" "when" "where"
-"with" "write" "xor"
-))
-
-	(mysql-types (sql-keywords-re
-"bigint" "binary" "bit" "blob" "bool" "boolean" "char" "curve" "date"
-"datetime" "dec" "decimal" "double" "enum" "fixed" "float" "geometry"
-"geometrycollection" "int" "integer" "line" "linearring" "linestring"
-"longblob" "longtext" "mediumblob" "mediumint" "mediumtext"
-"multicurve" "multilinestring" "multipoint" "multipolygon"
-"multisurface" "national" "numeric" "point" "polygon" "precision"
-"real" "smallint" "surface" "text" "time" "timestamp" "tinyblob"
-"tinyint" "tinytext" "unsigned" "varchar" "year" "year2" "year4"
-"zerofill"
-)))
-
-    `((,mysql-funcs    . font-lock-builtin-face)
-      (,mysql-keywords . font-lock-keyword-face)
-      (,mysql-types    . font-lock-type-face)))
-
-  "MySQL SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-mysql-font-lock-keywords.")
-
-(defvar sql-mode-sqlite-font-lock-keywords nil
-  "SQLite SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-sqlite-font-lock-keywords.")
-
-(defvar sql-mode-db2-font-lock-keywords nil
-  "DB2 SQL keywords used by font-lock.
-
-This variable is used by `sql-mode' and `sql-interactive-mode'.  The
-regular expressions are created during compilation by calling the
-function `regexp-opt'.  Therefore, take a look at the source before
-you define your own sql-mode-db2-font-lock-keywords.")
-
-(defvar sql-mode-font-lock-keywords nil
-  "SQL keywords used by font-lock.
-
-Setting this variable directly no longer has any affect.  Use
-`sql-product' and `sql-add-product-keywords' to control the
-highlighting rules in sql-mode.")
-
-
-
-;;; SQL Product support functions
-
-(defun sql-product-feature (feature &optional product)
-  "Lookup `feature' needed to support the current SQL product.
-
-See \[sql-product-alist] for a list of products and supported features."
-  (plist-get
-   (cdr (assoc (or product sql-product)
-	       sql-product-alist))
-   feature))
-
-(defun sql-product-font-lock (keywords-only imenu)
-  "Sets `font-lock-defaults' and `font-lock-keywords' based on
-the product-specific keywords and syntax-alists defined in
-`sql-product-alist'."
-  (let
-      ;; Get the product-specific syntax-alist.
-      ((syntax-alist
-	(append
-	 (sql-product-feature :syntax-alist)
-	 '((?_ . "w") (?. . "w")))))
-
-    ;; Get the product-specific keywords.
-    (setq sql-mode-font-lock-keywords
-	  (append
-	   (unless (eq sql-product 'ansi)
-	     (eval (sql-product-feature :font-lock)))
-	   ;; Always highlight ANSI keywords
-	   (eval (sql-product-feature :font-lock 'ansi))
-	   ;; Fontify object names in CREATE, DROP and ALTER DDL
-	   ;; statements
-	   (list sql-mode-font-lock-object-name)))
-
-    ;; Setup font-lock.  Force re-parsing of `font-lock-defaults'.
-    (set (make-local-variable 'font-lock-set-defaults) nil)
-    (setq font-lock-defaults (list 'sql-mode-font-lock-keywords
-				   keywords-only t syntax-alist))
-
-    ;; Force font lock to reinitialize if it is already on
-    ;; Otherwise, we can wait until it can be started.
-    (when (and (fboundp 'font-lock-mode)
-	       font-lock-mode)
-      (turn-off-font-lock)
-      (turn-on-font-lock))
-
-    (add-hook 'font-lock-mode-hook
-	      (lambda ()
-		;; Provide defaults for new font-lock faces.
-		(defvar font-lock-builtin-face
-		  (if (boundp 'font-lock-preprocessor-face)
-		      font-lock-preprocessor-face
-		    font-lock-keyword-face))
-		(defvar font-lock-doc-face font-lock-string-face))
-	      nil t)
-
-    ;; Setup imenu; it needs the same syntax-alist.
-    (when imenu
-	(setq imenu-syntax-alist syntax-alist))))
-
-;;;###autoload
-(defun sql-add-product-keywords (product keywords &optional append)
-  "Add highlighting KEYWORDS for SQL PRODUCT.
-
-PRODUCT should be a symbol, the name of a sql product, such as
-`oracle'.  KEYWORDS should be a list; see the variable
-`font-lock-keywords'.  By default they are added at the beginning
-of the current highlighting list.  If optional argument APPEND is
-`set', they are used to replace the current highlighting list.
-If APPEND is any other non-nil value, they are added at the end
-of the current highlighting list.
-
-For example:
-
- (sql-add-product-keywords 'ms
-  '((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
-
-adds a fontification pattern to fontify identifiers ending in
-`_t' as data types."
-
-  (let ((font-lock (sql-product-feature :font-lock product))
-	old)
-    (setq old (eval font-lock))
-    (set font-lock
-	 (if (eq append 'set)
-	     keywords
-	   (if append
-	       (append old keywords)
-	     (append keywords old))))))
-
-
-
-;;; Functions to switch highlighting
-
-(defun sql-highlight-product ()
-  "Turns on the appropriate font highlighting for the SQL product
-selected."
-
-  (when (eq major-mode 'sql-mode)
-    ;; Setup font-lock
-    (sql-product-font-lock nil t)
-
-    ;; Set the mode name to include the product.
-    (setq mode-name (concat "SQL[" (prin1-to-string sql-product) "]"))))
-
-(defun sql-set-product (product)
-  "Set `sql-product' to product and enable appropriate
-highlighting."
-  (interactive "SEnter SQL product: ")
-  (when (not (assoc product sql-product-alist))
-    (error "SQL product %s is not supported; treated as ANSI" product)
-    (setq product 'ansi))
-
-  ;; Save product setting and fontify.
-  (setq sql-product product)
-  (sql-highlight-product))
-
-(defun sql-highlight-oracle-keywords ()
-  "Highlight Oracle keywords."
-  (interactive)
-  (sql-set-product 'oracle))
-
-(defun sql-highlight-postgres-keywords ()
-  "Highlight Postgres keywords."
-  (interactive)
-  (sql-set-product 'postgres))
-
-(defun sql-highlight-linter-keywords ()
-  "Highlight LINTER keywords."
-  (interactive)
-  (sql-set-product 'linter))
-
-(defun sql-highlight-ms-keywords ()
-  "Highlight Microsoft SQLServer keywords."
-  (interactive)
-  (sql-set-product 'ms))
-
-(defun sql-highlight-ansi-keywords ()
-  "Highlight ANSI SQL keywords."
-  (interactive)
-  (sql-set-product 'ansi))
-
-(defun sql-highlight-sybase-keywords ()
-  "Highlight Sybase SQL keywords."
-  (interactive)
-  (sql-set-product 'sybase))
-
-(defun sql-highlight-informix-keywords ()
-  "Highlight Informix SQL keywords."
-  (interactive)
-  (sql-set-product 'informix))
-
-(defun sql-highlight-interbase-keywords ()
-  "Highlight Interbase SQL keywords."
-  (interactive)
-  (sql-set-product 'interbase))
-
-(defun sql-highlight-ingres-keywords ()
-  "Highlight Ingres SQL keywords."
-  (interactive)
-  (sql-set-product 'ingres))
-
-(defun sql-highlight-solid-keywords ()
-  "Highlight Solid SQL keywords."
-  (interactive)
-  (sql-set-product 'solid))
-
-(defun sql-highlight-mysql-keywords ()
-  "Highlight MySQL SQL keywords."
-  (interactive)
-  (sql-set-product 'mysql))
-
-(defun sql-highlight-sqlite-keywords ()
-  "Highlight SQLite SQL keywords."
-  (interactive)
-  (sql-set-product 'sqlite))
-
-(defun sql-highlight-db2-keywords ()
-  "Highlight DB2 SQL keywords."
-  (interactive)
-  (sql-set-product 'db2))
-
-
-
-;;; Compatibility functions
-
-(if (not (fboundp 'comint-line-beginning-position))
-    ;; comint-line-beginning-position is defined in Emacs 21
-    (defun comint-line-beginning-position ()
-      "Returns the buffer position of the beginning of the line, after any prompt.
-The prompt is assumed to be any text at the beginning of the line matching
-the regular expression `comint-prompt-regexp', a buffer local variable."
-      (save-excursion (comint-bol nil) (point))))
-
-
-
-;;; Small functions
-
-(defun sql-magic-go (arg)
-  "Insert \"o\" and call `comint-send-input'.
-`sql-electric-stuff' must be the symbol `go'."
-  (interactive "P")
-  (self-insert-command (prefix-numeric-value arg))
-  (if (and (equal sql-electric-stuff 'go)
-	   (save-excursion
-	     (comint-bol nil)
-	     (looking-at "go\\b")))
-      (comint-send-input)))
-
-(defun sql-magic-semicolon (arg)
-  "Insert semicolon and call `comint-send-input'.
-`sql-electric-stuff' must be the symbol `semicolon'."
-  (interactive "P")
-  (self-insert-command (prefix-numeric-value arg))
-  (if (equal sql-electric-stuff 'semicolon)
-       (comint-send-input)))
-
-(defun sql-accumulate-and-indent ()
-  "Continue SQL statement on the next line."
-  (interactive)
-  (if (fboundp 'comint-accumulate)
-      (comint-accumulate)
-    (newline))
-  (indent-according-to-mode))
-
-;;;###autoload
-(defun sql-help ()
-  "Show short help for the SQL modes.
-
-Use an entry function to open an interactive SQL buffer.  This buffer is
-usually named `*SQL*'.  The name of the major mode is SQLi.
-
-Use the following commands to start a specific SQL interpreter:
-
-    PostGres: \\[sql-postgres]
-    MySQL: \\[sql-mysql]
-    SQLite: \\[sql-sqlite]
-
-Other non-free SQL implementations are also supported:
-
-    Solid: \\[sql-solid]
-    Oracle: \\[sql-oracle]
-    Informix: \\[sql-informix]
-    Sybase: \\[sql-sybase]
-    Ingres: \\[sql-ingres]
-    Microsoft: \\[sql-ms]
-    DB2: \\[sql-db2]
-    Interbase: \\[sql-interbase]
-    Linter: \\[sql-linter]
-
-But we urge you to choose a free implementation instead of these.
-
-Once you have the SQLi buffer, you can enter SQL statements in the
-buffer.  The output generated is appended to the buffer and a new prompt
-is generated.  See the In/Out menu in the SQLi buffer for some functions
-that help you navigate through the buffer, the input history, etc.
-
-If you have a really complex SQL statement or if you are writing a
-procedure, you can do this in a separate buffer.  Put the new buffer in
-`sql-mode' by calling \\[sql-mode].  The name of this buffer can be
-anything.  The name of the major mode is SQL.
-
-In this SQL buffer (SQL mode), you can send the region or the entire
-buffer to the interactive SQL buffer (SQLi mode).  The results are
-appended to the SQLi buffer without disturbing your SQL buffer."
-  (interactive)
-  (describe-function 'sql-help))
-
-(defun sql-read-passwd (prompt &optional default)
-  "Read a password using PROMPT.
-Optional DEFAULT is password to start with.  This function calls
-`read-passwd' if it is available.  If not, function
-`ange-ftp-read-passwd' is called.  This should always be available,
-even in old versions of Emacs."
-  (if (fboundp 'read-passwd)
-      (read-passwd prompt nil default)
-    (unless (fboundp 'ange-ftp-read-passwd)
-      (autoload 'ange-ftp-read-passwd "ange-ftp"))
-    (ange-ftp-read-passwd prompt default)))
-
-(defun sql-get-login (&rest what)
-  "Get username, password and database from the user.
-
-The variables `sql-user', `sql-password', `sql-server', and
-`sql-database' can be customized.  They are used as the default values.
-Usernames, servers and databases are stored in `sql-user-history',
-`sql-server-history' and `database-history'.  Passwords are not stored
-in a history.
-
-Parameter WHAT is a list of the arguments passed to this function.
-The function asks for the username if WHAT contains symbol `user', for
-the password if it contains symbol `password', for the server if it
-contains symbol `server', and for the database if it contains symbol
-`database'.  The members of WHAT are processed in the order in which
-they are provided.
-
-In order to ask the user for username, password and database, call the
-function like this: (sql-get-login 'user 'password 'database)."
-  (interactive)
-  (while what
-    (cond
-     ((eq (car what) 'user)		; user
-      (setq sql-user
-	    (read-from-minibuffer "User: " sql-user nil nil
-				  sql-user-history)))
-     ((eq (car what) 'password)		; password
-      (setq sql-password
-	    (sql-read-passwd "Password: " sql-password)))
-     ((eq (car what) 'server)		; server
-      (setq sql-server
-	    (read-from-minibuffer "Server: " sql-server nil nil
-				  sql-server-history)))
-     ((eq (car what) 'database)		; database
-      (setq sql-database
-	    (read-from-minibuffer "Database: " sql-database nil nil
-				  sql-database-history))))
-    (setq what (cdr what))))
-
-(defun sql-find-sqli-buffer ()
-  "Return the current default SQLi buffer or nil.
-In order to qualify, the SQLi buffer must be alive,
-be in `sql-interactive-mode' and have a process."
-  (let ((default-buffer (default-value 'sql-buffer)))
-    (if (and (buffer-live-p default-buffer)
-	     (get-buffer-process default-buffer))
-	default-buffer
-      (save-excursion
-	(let ((buflist (buffer-list))
-	      (found))
-	  (while (not (or (null buflist)
-			  found))
-	    (let ((candidate (car buflist)))
-	      (set-buffer candidate)
-	      (if (and (equal major-mode 'sql-interactive-mode)
-		       (get-buffer-process candidate))
-		  (setq found candidate))
-	      (setq buflist (cdr buflist))))
-	  found)))))
-
-(defun sql-set-sqli-buffer-generally ()
-  "Set SQLi buffer for all SQL buffers that have none.
-This function checks all SQL buffers for their SQLi buffer.  If their
-SQLi buffer is nonexistent or has no process, it is set to the current
-default SQLi buffer.  The current default SQLi buffer is determined
-using `sql-find-sqli-buffer'.  If `sql-buffer' is set,
-`sql-set-sqli-hook' is run."
-  (interactive)
-  (save-excursion
-    (let ((buflist (buffer-list))
-	  (default-sqli-buffer (sql-find-sqli-buffer)))
-      (setq-default sql-buffer default-sqli-buffer)
-      (while (not (null buflist))
-	(let ((candidate (car buflist)))
-	  (set-buffer candidate)
-	  (if (and (equal major-mode 'sql-mode)
-		   (not (buffer-live-p sql-buffer)))
-	      (progn
-		(setq sql-buffer default-sqli-buffer)
-		(run-hooks 'sql-set-sqli-hook))))
-	(setq buflist (cdr buflist))))))
-
-(defun sql-set-sqli-buffer ()
-  "Set the SQLi buffer SQL strings are sent to.
-
-Call this function in a SQL buffer in order to set the SQLi buffer SQL
-strings are sent to.  Calling this function sets `sql-buffer' and runs
-`sql-set-sqli-hook'.
-
-If you call it from a SQL buffer, this sets the local copy of
-`sql-buffer'.
-
-If you call it from anywhere else, it sets the global copy of
-`sql-buffer'."
-  (interactive)
-  (let ((default-buffer (sql-find-sqli-buffer)))
-    (if (null default-buffer)
-	(error "There is no suitable SQLi buffer"))
-    (let ((new-buffer
-	   (get-buffer
-	    (read-buffer "New SQLi buffer: " default-buffer t))))
-      (if (null (get-buffer-process new-buffer))
-	  (error "Buffer %s has no process" (buffer-name new-buffer)))
-      (if (null (save-excursion
-		  (set-buffer new-buffer)
-		  (equal major-mode 'sql-interactive-mode)))
-	  (error "Buffer %s is no SQLi buffer" (buffer-name new-buffer)))
-      (if new-buffer
-	  (progn
-	    (setq sql-buffer new-buffer)
-	    (run-hooks 'sql-set-sqli-hook))))))
-
-(defun sql-show-sqli-buffer ()
-  "Show the name of current SQLi buffer.
-
-This is the buffer SQL strings are sent to.  It is stored in the
-variable `sql-buffer'.  See `sql-help' on how to create such a buffer."
-  (interactive)
-  (if (null (buffer-live-p sql-buffer))
-      (message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
-    (if (null (get-buffer-process sql-buffer))
-	(message "Buffer %s has no process." (buffer-name sql-buffer))
-      (message "Current SQLi buffer is %s." (buffer-name sql-buffer)))))
-
-(defun sql-make-alternate-buffer-name ()
-  "Return a string that can be used to rename a SQLi buffer.
-
-This is used to set `sql-alternate-buffer-name' within
-`sql-interactive-mode'."
-  (concat (if (string= "" sql-user)
-	      (if (string= "" (user-login-name))
-		  ()
-		(concat (user-login-name) "/"))
-	    (concat sql-user "/"))
-	  (if (string= "" sql-database)
-	      (if (string= "" sql-server)
-		  (system-name)
-		sql-server)
-	    sql-database)))
-
-(defun sql-rename-buffer ()
-  "Renames a SQLi buffer."
-  (interactive)
-  (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t))
-
-(defun sql-copy-column ()
-  "Copy current column to the end of buffer.
-Inserts SELECT or commas if appropriate."
-  (interactive)
-  (let ((column))
-    (save-excursion
-      (setq column (buffer-substring
-		  (progn (forward-char 1) (backward-sexp 1) (point))
-		  (progn (forward-sexp 1) (point))))
-      (goto-char (point-max))
-      (let ((bol (comint-line-beginning-position)))
-	(cond
-	 ;; if empty command line, insert SELECT
-	 ((= bol (point))
-	  (insert "SELECT "))
-	 ;; else if appending to INTO .* (, SELECT or ORDER BY, insert a comma
-	 ((save-excursion
-	    (re-search-backward "\\b\\(\\(into\\s-+\\S-+\\s-+(\\)\\|select\\|order by\\) .+"
-				bol t))
-	  (insert ", "))
-	 ;; else insert a space
-	 (t
-	  (if (eq (preceding-char) ? )
-	      nil
-	    (insert " ")))))
-      ;; in any case, insert the column
-      (insert column)
-      (message "%s" column))))
-
-;; On NT, SQL*Plus for Oracle turns on full buffering for stdout if it
-;; is not attached to a character device; therefore placeholder
-;; replacement by SQL*Plus is fully buffered.  The workaround lets
-;; Emacs query for the placeholders.
-
-(defvar sql-placeholder-history nil
-  "History of placeholder values used.")
-
-(defun sql-query-placeholders-and-send (proc string)
-  "Send to PROC input STRING, maybe replacing placeholders.
-Placeholders are words starting with and ampersand like &this.
-This function is used for `comint-input-sender' if using `sql-oracle' on NT."
-  (while (string-match "&\\(\\sw+\\)" string)
-    (setq string (replace-match
-		  (read-from-minibuffer
-		   (format "Enter value for %s: " (match-string 1 string))
-		   nil nil nil sql-placeholder-history)
-		  t t string)))
-  (comint-send-string proc string)
-  (if comint-input-sender-no-newline
-      (if (not (string-equal string ""))
-	  (process-send-eof))
-    (comint-send-string proc "\n")))
-
-;; Using DB2 interactively, newlines must be escaped with " \".
-;; The space before the backslash is relevant.
-(defun sql-escape-newlines-and-send (proc string)
-  "Send to PROC input STRING, escaping newlines if necessary.
-Every newline in STRING will be preceded with a space and a backslash."
-  (let ((result "") (start 0) mb me)
-    (while (string-match "\n" string start)
-      (setq mb (match-beginning 0)
-	    me (match-end 0))
-      (if (and (> mb 1)
-	       (string-equal " \\" (substring string (- mb 2) mb)))
-	  (setq result (concat result (substring string start me)))
-	(setq result (concat result (substring string start mb) " \\\n")))
-      (setq start me))
-    (setq result (concat result (substring string start)))
-    (comint-send-string proc result)
-    (if comint-input-sender-no-newline
-	(if (not (string-equal string ""))
-	    (process-send-eof))
-      (comint-send-string proc "\n"))))
-
-
-
-;;; Sending the region to the SQLi buffer.
-
-(defun sql-send-region (start end)
-  "Send a region to the SQL process."
-  (interactive "r")
-  (if (buffer-live-p sql-buffer)
-      (save-excursion
-	(comint-send-region sql-buffer start end)
-	(if (string-match "\n$" (buffer-substring start end))
-	    ()
-	  (comint-send-string sql-buffer "\n"))
-	(message "Sent string to buffer %s." (buffer-name sql-buffer))
-	(if sql-pop-to-buffer-after-send-region
-	    (pop-to-buffer sql-buffer)
-	  (display-buffer sql-buffer)))
-    (message "No SQL process started.")))
-
-(defun sql-send-paragraph ()
-  "Send the current paragraph to the SQL process."
-  (interactive)
-  (let ((start (save-excursion
-		 (backward-paragraph)
-		 (point)))
-	(end (save-excursion
-	       (forward-paragraph)
-	       (point))))
-    (sql-send-region start end)))
-
-(defun sql-send-buffer ()
-  "Send the buffer contents to the SQL process."
-  (interactive)
-  (sql-send-region (point-min) (point-max)))
-
-(defun sql-send-string (str)
-  "Send a string to the SQL process."
-  (interactive "sSQL Text: ")
-  (if (buffer-live-p sql-buffer)
-      (save-excursion
-        (comint-send-string sql-buffer str)
-        (comint-send-string sql-buffer "\n")
-        (message "Sent string to buffer %s." (buffer-name sql-buffer))
-        (if sql-pop-to-buffer-after-send-region
-            (pop-to-buffer sql-buffer)
-          (display-buffer sql-buffer)))
-    (message "No SQL process started.")))
-
-(defun sql-toggle-pop-to-buffer-after-send-region (&optional value)
-  "Toggle `sql-pop-to-buffer-after-send-region'.
-
-If given the optional parameter VALUE, sets
-sql-toggle-pop-to-buffer-after-send-region to VALUE."
-  (interactive "P")
-  (if value
-      (setq sql-pop-to-buffer-after-send-region value)
-    (setq sql-pop-to-buffer-after-send-region
-	  (null sql-pop-to-buffer-after-send-region ))))
-
-
-
-;;; SQL mode -- uses SQL interactive mode
-
-;;;###autoload
-(defun sql-mode ()
-  "Major mode to edit SQL.
-
-You can send SQL statements to the SQLi buffer using
-\\[sql-send-region].  Such a buffer must exist before you can do this.
-See `sql-help' on how to create SQLi buffers.
-
-\\{sql-mode-map}
-Customization: Entry to this mode runs the `sql-mode-hook'.
-
-When you put a buffer in SQL mode, the buffer stores the last SQLi
-buffer created as its destination in the variable `sql-buffer'.  This
-will be the buffer \\[sql-send-region] sends the region to.  If this
-SQLi buffer is killed, \\[sql-send-region] is no longer able to
-determine where the strings should be sent to.  You can set the
-value of `sql-buffer' using \\[sql-set-sqli-buffer].
-
-For information on how to create multiple SQLi buffers, see
-`sql-interactive-mode'.
-
-Note that SQL doesn't have an escape character unless you specify
-one.  If you specify backslash as escape character in SQL,
-you must tell Emacs.  Here's how to do that in your `~/.emacs' file:
-
-\(add-hook 'sql-mode-hook
-          (lambda ()
-	    (modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))"
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'sql-mode)
-  (setq mode-name "SQL")
-  (use-local-map sql-mode-map)
-  (if sql-mode-menu
-      (easy-menu-add sql-mode-menu)); XEmacs
-  (set-syntax-table sql-mode-syntax-table)
-  (make-local-variable 'font-lock-defaults)
-  (make-local-variable 'sql-mode-font-lock-keywords)
-  (make-local-variable 'comment-start)
-  (setq comment-start "--")
-  ;; Make each buffer in sql-mode remember the "current" SQLi buffer.
-  (make-local-variable 'sql-buffer)
-  ;; Add imenu support for sql-mode.  Note that imenu-generic-expression
-  ;; is buffer-local, so we don't need a local-variable for it.  SQL is
-  ;; case-insensitive, that's why we have to set imenu-case-fold-search.
-  (setq imenu-generic-expression sql-imenu-generic-expression
-	imenu-case-fold-search t)
-  ;; Make `sql-send-paragraph' work on paragraphs that contain indented
-  ;; lines.
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-separate "[\f]*$"
-	paragraph-start "[\n\f]")
-  ;; Abbrevs
-  (setq local-abbrev-table sql-mode-abbrev-table)
-  (setq abbrev-all-caps 1)
-  ;; Run hook
-  (run-hooks 'sql-mode-hook)
-  ;; Catch changes to sql-product and highlight accordingly
-  (sql-highlight-product)
-  (add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
-
-
-
-;;; SQL interactive mode
-
-(put 'sql-interactive-mode 'mode-class 'special)
-
-(defun sql-interactive-mode ()
-  "Major mode to use a SQL interpreter interactively.
-
-Do not call this function by yourself.  The environment must be
-initialized by an entry function specific for the SQL interpreter.  See
-`sql-help' for a list of available entry functions.
-
-\\[comint-send-input] after the end of the process' output sends the
-text from the end of process to the end of the current line.
-\\[comint-send-input] before end of process output copies the current
-line minus the prompt to the end of the buffer and sends it.
-\\[comint-copy-old-input] just copies the current line.
-Use \\[sql-accumulate-and-indent] to enter multi-line statements.
-
-If you want to make multiple SQL buffers, rename the `*SQL*' buffer
-using \\[rename-buffer] or \\[rename-uniquely] and start a new process.
-See `sql-help' for a list of available entry functions.  The last buffer
-created by such an entry function is the current SQLi buffer.  SQL
-buffers will send strings to the SQLi buffer current at the time of
-their creation.  See `sql-mode' for details.
-
-Sample session using two connections:
-
-1. Create first SQLi buffer by calling an entry function.
-2. Rename buffer \"*SQL*\" to \"*Connection 1*\".
-3. Create a SQL buffer \"test1.sql\".
-4. Create second SQLi buffer by calling an entry function.
-5. Rename buffer \"*SQL*\" to \"*Connection 2*\".
-6. Create a SQL buffer \"test2.sql\".
-
-Now \\[sql-send-region] in buffer \"test1.sql\" will send the region to
-buffer \"*Connection 1*\", \\[sql-send-region] in buffer \"test2.sql\"
-will send the region to buffer \"*Connection 2*\".
-
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it.  On some operating systems, this will not work because
-the signals are not supported.
-
-\\{sql-interactive-mode-map}
-Customization: Entry to this mode runs the hooks on `comint-mode-hook'
-and `sql-interactive-mode-hook' (in that order).  Before each input, the
-hooks on `comint-input-filter-functions' are run.  After each SQL
-interpreter output, the hooks on `comint-output-filter-functions' are
-run.
-
-Variable `sql-input-ring-file-name' controls the initialisation of the
-input ring history.
-
-Variables `comint-output-filter-functions', a hook, and
-`comint-scroll-to-bottom-on-input' and
-`comint-scroll-to-bottom-on-output' control whether input and output
-cause the window to scroll to the end of the buffer.
-
-If you want to make SQL buffers limited in length, add the function
-`comint-truncate-buffer' to `comint-output-filter-functions'.
-
-Here is an example for your .emacs file.  It keeps the SQLi buffer a
-certain length.
-
-\(add-hook 'sql-interactive-mode-hook
-    \(function (lambda ()
-        \(setq comint-output-filter-functions 'comint-truncate-buffer))))
-
-Here is another example.  It will always put point back to the statement
-you entered, right above the output it created.
-
-\(setq comint-output-filter-functions
-       \(function (lambda (STR) (comint-show-output))))"
-  (comint-mode)
-  ;; Get the `sql-product' for this interactive session.
-  (set (make-local-variable 'sql-product)
-       (or sql-interactive-product
-	   sql-product))
-  ;; Setup the mode.
-  (setq major-mode 'sql-interactive-mode)
-  (setq mode-name (concat "SQLi[" (prin1-to-string sql-product) "]"))
-  (use-local-map sql-interactive-mode-map)
-  (if sql-interactive-mode-menu
-      (easy-menu-add sql-interactive-mode-menu)) ; XEmacs
-  (set-syntax-table sql-mode-syntax-table)
-  (make-local-variable 'sql-mode-font-lock-keywords)
-  (make-local-variable 'font-lock-defaults)
-  ;; Note that making KEYWORDS-ONLY nil will cause havoc if you try
-  ;; SELECT 'x' FROM DUAL with SQL*Plus, because the title of the column
-  ;; will have just one quote.  Therefore syntactic hilighting is
-  ;; disabled for interactive buffers.  No imenu support.
-  (sql-product-font-lock t nil)
-  ;; Enable commenting and uncommenting of the region.
-  (make-local-variable 'comment-start)
-  (setq comment-start "--")
-  ;; Abbreviation table init and case-insensitive.  It is not activated
-  ;; by default.
-  (setq local-abbrev-table sql-mode-abbrev-table)
-  (setq abbrev-all-caps 1)
-  ;; Exiting the process will call sql-stop.
-  (set-process-sentinel (get-buffer-process sql-buffer) 'sql-stop)
-  ;; Create a usefull name for renaming this buffer later.
-  (make-local-variable 'sql-alternate-buffer-name)
-  (setq sql-alternate-buffer-name (sql-make-alternate-buffer-name))
-  ;; User stuff.  Initialize before the hook.
-  (set (make-local-variable 'sql-prompt-regexp)
-       (sql-product-feature :sqli-prompt-regexp))
-  (set (make-local-variable 'sql-prompt-length)
-       (sql-product-feature :sqli-prompt-length))
-  (make-local-variable 'sql-input-ring-separator)
-  (make-local-variable 'sql-input-ring-file-name)
-  ;; Run hook.
-  (run-hooks 'sql-interactive-mode-hook)
-  ;; Set comint based on user overrides.
-  (setq comint-prompt-regexp sql-prompt-regexp)
-  (setq left-margin sql-prompt-length)
-  ;; People wanting a different history file for each
-  ;; buffer/process/client/whatever can change separator and file-name
-  ;; on the sql-interactive-mode-hook.
-  (setq comint-input-ring-separator sql-input-ring-separator
-	comint-input-ring-file-name sql-input-ring-file-name)
-  ;; Calling the hook before calling comint-read-input-ring allows users
-  ;; to set comint-input-ring-file-name in sql-interactive-mode-hook.
-  (comint-read-input-ring t))
-
-(defun sql-stop (process event)
-  "Called when the SQL process is stopped.
-
-Writes the input history to a history file using
-`comint-write-input-ring' and inserts a short message in the SQL buffer.
-
-This function is a sentinel watching the SQL interpreter process.
-Sentinels will always get the two parameters PROCESS and EVENT."
-  (comint-write-input-ring)
-  (if (and (eq (current-buffer) sql-buffer)
-	   (not buffer-read-only))
-      (insert (format "\nProcess %s %s\n" process event))
-    (message "Process %s %s" process event)))
-
-
-
-;;; Entry functions for different SQL interpreters.
-
-;;;###autoload
-(defun sql-product-interactive (&optional product)
-  "Run product interpreter as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (setq product (or product sql-product))
-  (when (sql-product-feature :sqli-connect product)
-    (if (comint-check-proc "*SQL*")
-	(pop-to-buffer "*SQL*")
-      ;; Get credentials.
-      (apply 'sql-get-login (sql-product-feature :sqli-login product))
-      ;; Connect to database.
-      (message "Login...")
-      (funcall (sql-product-feature :sqli-connect product))
-      ;; Set SQLi mode.
-      (setq sql-interactive-product product)
-      (setq sql-buffer (current-buffer))
-      (sql-interactive-mode)
-      ;; All done.
-      (message "Login...done")
-      (pop-to-buffer sql-buffer))))
-
-;;;###autoload
-(defun sql-oracle ()
-  "Run sqlplus by Oracle as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-oracle-program'.  Login uses
-the variables `sql-user', `sql-password', and `sql-database' as
-defaults, if set.  Additional command line parameters can be stored in
-the list `sql-oracle-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-oracle].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'oracle))
-
-(defun sql-connect-oracle ()
-  "Create comint buffer and connect to Oracle using the login
-parameters and command options."
-  ;; Produce user/password@database construct.  Password without user
-  ;; is meaningless; database without user/password is meaningless,
-  ;; because "@param" will ask sqlplus to interpret the script
-  ;; "param".
-  (let ((parameter nil))
-    (if (not (string= "" sql-user))
-	(if (not (string= "" sql-password))
-	    (setq parameter (concat sql-user "/" sql-password))
-	  (setq parameter sql-user)))
-    (if (and parameter (not (string= "" sql-database)))
-	(setq parameter (concat parameter "@" sql-database)))
-    (if parameter
-	(setq parameter (nconc (list parameter) sql-oracle-options))
-      (setq parameter sql-oracle-options))
-    (if parameter
-	(set-buffer (apply 'make-comint "SQL" sql-oracle-program nil
-			   parameter))
-      (set-buffer (make-comint "SQL" sql-oracle-program nil)))
-    ;; SQL*Plus is buffered on WindowsNT; this handles &placeholders.
-    (if (eq window-system 'w32)
-	(setq comint-input-sender 'sql-query-placeholders-and-send))))
-
-
-
-;;;###autoload
-(defun sql-sybase ()
-  "Run isql by SyBase as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-sybase-program'.  Login uses
-the variables `sql-server', `sql-user', `sql-password', and
-`sql-database' as defaults, if set.  Additional command line parameters
-can be stored in the list `sql-sybase-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-sybase].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'sybase))
-
-(defun sql-connect-sybase ()
-  "Create comint buffer and connect to Sybase using the login
-parameters and command options."
-  ;; Put all parameters to the program (if defined) in a list and call
-  ;; make-comint.
-  (let ((params sql-sybase-options))
-    (if (not (string= "" sql-server))
-	(setq params (append (list "-S" sql-server) params)))
-    (if (not (string= "" sql-database))
-	(setq params (append (list "-D" sql-database) params)))
-    (if (not (string= "" sql-password))
-	(setq params (append (list "-P" sql-password) params)))
-    (if (not (string= "" sql-user))
-	(setq params (append (list "-U" sql-user) params)))
-    (set-buffer (apply 'make-comint "SQL" sql-sybase-program
-		       nil params))))
-
-
-
-;;;###autoload
-(defun sql-informix ()
-  "Run dbaccess by Informix as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-informix-program'.  Login uses
-the variable `sql-database' as default, if set.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-informix].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'informix))
-
-(defun sql-connect-informix ()
-  "Create comint buffer and connect to Informix using the login
-parameters and command options."
-  ;; username and password are ignored.
-  (if (string= "" sql-database)
-      (set-buffer (make-comint "SQL" sql-informix-program nil))
-    (set-buffer (make-comint "SQL" sql-informix-program nil sql-database "-"))))
-
-
-
-;;;###autoload
-(defun sql-sqlite ()
-  "Run sqlite as an inferior process.
-
-SQLite is free software.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-sqlite-program'.  Login uses
-the variables `sql-user', `sql-password', `sql-database', and
-`sql-server' as defaults, if set.  Additional command line parameters
-can be stored in the list `sql-sqlite-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-sqlite].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'sqlite))
-
-(defun sql-connect-sqlite ()
-  "Create comint buffer and connect to SQLite using the login
-parameters and command options."
-  ;; Put all parameters to the program (if defined) in a list and call
-  ;; make-comint.
-  (let ((params))
-    (if (not (string= "" sql-database))
-	(setq params (append (list sql-database) params)))
-    (if (not (string= "" sql-server))
-	(setq params (append (list (concat "--host=" sql-server)) params)))
-    (if (not (string= "" sql-password))
-	(setq params (append (list (concat "--password=" sql-password)) params)))
-    (if (not (string= "" sql-user))
-	(setq params (append (list (concat "--user=" sql-user)) params)))
-    (if (not (null sql-sqlite-options))
-	(setq params (append sql-sqlite-options params)))
-    (set-buffer (apply 'make-comint "SQL" sql-sqlite-program
-		       nil params))))
-
-
-
-;;;###autoload
-(defun sql-mysql ()
-  "Run mysql by TcX as an inferior process.
-
-Mysql versions 3.23 and up are free software.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-mysql-program'.  Login uses
-the variables `sql-user', `sql-password', `sql-database', and
-`sql-server' as defaults, if set.  Additional command line parameters
-can be stored in the list `sql-mysql-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-mysql].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'mysql))
-
-(defun sql-connect-mysql ()
-  "Create comint buffer and connect to MySQL using the login
-parameters and command options."
-  ;; Put all parameters to the program (if defined) in a list and call
-  ;; make-comint.
-  (let ((params))
-    (if (not (string= "" sql-database))
-	(setq params (append (list sql-database) params)))
-    (if (not (string= "" sql-server))
-	(setq params (append (list (concat "--host=" sql-server)) params)))
-    (if (not (string= "" sql-password))
-	(setq params (append (list (concat "--password=" sql-password)) params)))
-    (if (not (string= "" sql-user))
-	(setq params (append (list (concat "--user=" sql-user)) params)))
-    (if (not (null sql-mysql-options))
-	(setq params (append sql-mysql-options params)))
-    (set-buffer (apply 'make-comint "SQL" sql-mysql-program
-		       nil params))))
-
-
-
-;;;###autoload
-(defun sql-solid ()
-  "Run solsql by Solid as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-solid-program'.  Login uses
-the variables `sql-user', `sql-password', and `sql-server' as
-defaults, if set.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-solid].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'solid))
-
-(defun sql-connect-solid ()
-  "Create comint buffer and connect to Solid using the login
-parameters and command options."
-  ;; Put all parameters to the program (if defined) in a list and call
-  ;; make-comint.
-  (let ((params))
-    ;; It only makes sense if both username and password are there.
-    (if (not (or (string= "" sql-user)
-		 (string= "" sql-password)))
-	(setq params (append (list sql-user sql-password) params)))
-    (if (not (string= "" sql-server))
-	(setq params (append (list sql-server) params)))
-    (set-buffer (apply 'make-comint "SQL" sql-solid-program
-		       nil params))))
-
-
-
-;;;###autoload
-(defun sql-ingres ()
-  "Run sql by Ingres as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-ingres-program'.  Login uses
-the variable `sql-database' as default, if set.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-ingres].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'ingres))
-
-(defun sql-connect-ingres ()
-  "Create comint buffer and connect to Ingres using the login
-parameters and command options."
-  ;; username and password are ignored.
-  (if (string= "" sql-database)
-      (set-buffer (make-comint "SQL" sql-ingres-program nil))
-    (set-buffer (make-comint "SQL" sql-ingres-program nil sql-database))))
-
-
-
-;;;###autoload
-(defun sql-ms ()
-  "Run osql by Microsoft as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-ms-program'.  Login uses the
-variables `sql-user', `sql-password', `sql-database', and `sql-server'
-as defaults, if set.  Additional command line parameters can be stored
-in the list `sql-ms-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-ms].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'ms))
-
-(defun sql-connect-ms ()
-  "Create comint buffer and connect to Microsoft using the login
-parameters and command options."
-  ;; Put all parameters to the program (if defined) in a list and call
-  ;; make-comint.
-  (let ((params sql-ms-options))
-    (if (not (string= "" sql-server))
-        (setq params (append (list "-S" sql-server) params)))
-    (if (not (string= "" sql-database))
-        (setq params (append (list "-d" sql-database) params)))
-    (if (not (string= "" sql-user))
-	(setq params (append (list "-U" sql-user) params)))
-    (if (not (string= "" sql-password))
-	(setq params (append (list "-P" sql-password) params))
-      (if (string= "" sql-user)
-	  ;; if neither user nor password is provided, use system
-	  ;; credentials.
-	  (setq params (append (list "-E") params))
-	;; If -P is passed to ISQL as the last argument without a
-	;; password, it's considered null.
-	(setq params (append params (list "-P")))))
-    (set-buffer (apply 'make-comint "SQL" sql-ms-program
-		       nil params))))
-
-
-
-;;;###autoload
-(defun sql-postgres ()
-  "Run psql by Postgres as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-postgres-program'.  Login uses
-the variables `sql-database' and `sql-server' as default, if set.
-Additional command line parameters can be stored in the list
-`sql-postgres-options'.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-postgres].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.  If your output lines end with ^M,
-your might try undecided-dos as a coding system.  If this doesn't help,
-Try to set `comint-output-filter-functions' like this:
-
-\(setq comint-output-filter-functions (append comint-output-filter-functions
-					     '(comint-strip-ctrl-m)))
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'postgres))
-
-(defun sql-connect-postgres ()
-  "Create comint buffer and connect to Postgres using the login
-parameters and command options."
-  ;; username and password are ignored.  Mark Stosberg suggest to add
-  ;; the database at the end.  Jason Beegan suggest using --pset and
-  ;; pager=off instead of \\o|cat.  The later was the solution by
-  ;; Gregor Zych.  Jason's suggestion is the default value for
-  ;; sql-postgres-options.
-  (let ((params sql-postgres-options))
-    (if (not (string= "" sql-database))
-	(setq params (append params (list sql-database))))
-    (if (not (string= "" sql-server))
-	(setq params (append (list "-h" sql-server) params)))
-    (if (not (string= "" sql-user))
-	(setq params (append (list "-U" sql-user) params)))
-    (set-buffer (apply 'make-comint "SQL" sql-postgres-program
-		       nil params))))
-
-
-
-;;;###autoload
-(defun sql-interbase ()
-  "Run isql by Interbase as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-interbase-program'.  Login
-uses the variables `sql-user', `sql-password', and `sql-database' as
-defaults, if set.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-interbase].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'interbase))
-
-(defun sql-connect-interbase ()
-  "Create comint buffer and connect to Interbase using the login
-parameters and command options."
-  ;; Put all parameters to the program (if defined) in a list and call
-  ;; make-comint.
-  (let ((params sql-interbase-options))
-    (if (not (string= "" sql-user))
-	(setq params (append (list "-u" sql-user) params)))
-    (if (not (string= "" sql-password))
-	(setq params (append (list "-p" sql-password) params)))
-    (if (not (string= "" sql-database))
-        (setq params (cons sql-database params))) ; add to the front!
-    (set-buffer (apply 'make-comint "SQL" sql-interbase-program
-		       nil params))))
-
-
-
-;;;###autoload
-(defun sql-db2 ()
-  "Run db2 by IBM as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-db2-program'.  There is not
-automatic login.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-If you use \\[sql-accumulate-and-indent] to send multiline commands to
-db2, newlines will be escaped if necessary.  If you don't want that, set
-`comint-input-sender' back to `comint-simple-send' by writing an after
-advice.  See the elisp manual for more information.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the process, use \\[universal-coding-system-argument]
-before \\[sql-db2].  You can also specify this with \\[set-buffer-process-coding-system]
-in the SQL buffer, after you start the process.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'db2))
-
-(defun sql-connect-db2 ()
-  "Create comint buffer and connect to DB2 using the login
-parameters and command options."
-  ;; Put all parameters to the program (if defined) in a list and call
-  ;; make-comint.
-  (set-buffer (apply 'make-comint "SQL" sql-db2-program
-		     nil sql-db2-options))
-  ;; Properly escape newlines when DB2 is interactive.
-  (setq comint-input-sender 'sql-escape-newlines-and-send))
-
-;;;###autoload
-(defun sql-linter ()
-  "Run inl by RELEX as an inferior process.
-
-If buffer `*SQL*' exists but no process is running, make a new process.
-If buffer exists and a process is running, just switch to buffer
-`*SQL*'.
-
-Interpreter used comes from variable `sql-linter-program' - usually `inl'.
-Login uses the variables `sql-user', `sql-password', `sql-database' and
-`sql-server' as defaults, if set.  Additional command line parameters
-can be stored in the list `sql-linter-options'. Run inl -h to get help on
-parameters.
-
-`sql-database' is used to set the LINTER_MBX environment variable for
-local connections, `sql-server' refers to the server name from the
-`nodetab' file for the network connection (dbc_tcp or friends must run
-for this to work).  If `sql-password' is an empty string, inl will use
-an empty password.
-
-The buffer is put in sql-interactive-mode, giving commands for sending
-input.  See `sql-interactive-mode'.
-
-\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'linter))
-
-(defun sql-connect-linter ()
-  "Create comint buffer and connect to Linter using the login
-parameters and command options."
-  ;; Put all parameters to the program (if defined) in a list and call
-  ;; make-comint.
-  (let ((params sql-linter-options) (login nil) (old-mbx (getenv "LINTER_MBX")))
-    (if (not (string= "" sql-user))
-	(setq login (concat sql-user "/" sql-password)))
-    (setq params (append (list "-u" login) params))
-    (if (not (string= "" sql-server))
-	(setq params (append (list "-n" sql-server) params)))
-    (if (string= "" sql-database)
-	(setenv "LINTER_MBX" nil)
-      (setenv "LINTER_MBX" sql-database))
-    (set-buffer (apply 'make-comint "SQL" sql-linter-program nil
-		       params))
-    (setenv "LINTER_MBX" old-mbx)))
-
-
-
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.sql$" . sql-mode))
-(provide 'sql)
-
-;;; sql.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/tcl.el b/xemacs-packages/lisp/prog-modes/tcl.el
deleted file mode 100644
index f12031b4..00000000
--- a/xemacs-packages/lisp/prog-modes/tcl.el
+++ /dev/null
@@ -1,2020 +0,0 @@
-;;; tcl.el --- Tcl code editing commands for Emacs
-
-;; Copyright (C) 1994, 1998, 1999, 2000, 2001  Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Author: Tom Tromey 
-;;    Chris Lindblad 
-;; Keywords: languages tcl modes
-;; Version: Revision: 1.64.4.1
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Mostly with GNU Emacs 21.2.  The differences are a
-;;; couple of defcustom<->defvars, we use `tcl-imenu-generic-expression'
-;;; instead of `tcl-imenu-create-index-function' and some typo fixes.
-
-;; BEFORE USE:
-;;
-;; If you plan to use the interface to the TclX help files, you must
-;; set the variable tcl-help-directory-list to point to the topmost
-;; directories containing the TclX help files.  Eg:
-;;
-;;   (setq tcl-help-directory-list '("/usr/local/lib/tclx/help"))
-;;
-;;; Commentary:
-
-;; CUSTOMIZATION NOTES:
-;; * tcl-proc-list can be used to customize a list of things that
-;; "define" other things.  Eg in my project I put "defvar" in this
-;; list.
-;; * tcl-typeword-list is similar, but uses font-lock-type-face.
-;; * tcl-keyword-list is a list of keywords.  I've generally used this
-;; for flow-control words.  Eg I add "unwind_protect" to this list.
-;; * tcl-type-alist can be used to minimally customize indentation
-;; according to context.
-
-;; THANKS FOR CRITICISM AND SUGGESTIONS TO:
-;; Guido Bosch 
-;; pgs1002@esc.cam.ac.uk (Dr P.G. Sjoerdsma)
-;; Mike Scheidler 
-;; Matt Newman 
-;; rwhitby@research.canon.oz.au (Rod Whitby)
-;; h9118101@hkuxa.hku.hk (Yip Chi Lap [Beta])
-;; Pertti Tapio Kasanen 
-;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)
-;; warsaw@nlm.nih.gov (Barry A. Warsaw)
-;; Carl Witty 
-;; T. V. Raman 
-;; Jesper Pedersen 
-;; dfarmer@evolving.com (Doug Farmer)
-;; "Chris Alfeld" 
-;; Ben Wing 
-
-;; KNOWN BUGS:
-;; * In Tcl "#" is not always a comment character.  This can confuse
-;;   tcl.el in certain circumstances.  For now the only workaround is
-;;   to enclose offending hash characters in quotes or precede it with
-;;   a backslash.  Note that using braces won't work -- quotes change
-;;   the syntax class of characters between them, while braces do not.
-;;   The electric-# mode helps alleviate this problem somewhat.
-;; * indent-tcl-exp is untested.
-
-;; TODO:
-;; * make add-log-tcl-defun smarter.  should notice if we are in the
-;;   middle of a defun, or between defuns.  should notice if point is
-;;   on first line of defun (or maybe even in comments before defun).
-;; * Allow continuation lines to be indented under the first argument
-;;   of the preceding line, like this:
-;;      [list something \
-;;            something-else]
-;; * There is a request that indentation work like this:
-;;        button .fred -label Fred \
-;;                     -command {puts fred}
-;; * Should have tcl-complete-symbol that queries the inferior process.
-;; * Should have describe-symbol that works by sending the magic
-;;   command to a tclX process.
-;; * Need C-x C-e binding (tcl-eval-last-exp).
-;; * Write indent-region function that is faster than indenting each
-;;   line individually.
-;; * tcl-figure-type should stop at "beginning of line" (only ws
-;;   before point, and no "\" on previous line).  (see tcl-real-command-p).
-;; * overrides some comint keybindings; fix.
-;; * Trailing \ will eat blank lines.  Should deal with this.
-;;   (this would help catch some potential bugs).
-;; * Inferior should display in half the screen, not the whole screen.
-;; * Indentation should deal with "switch".
-;; * Consider writing code to find help files automatically (for
-;;   common cases).
-;; * `#' shouldn't insert `\#' when point is in string.
-
-
-
-;;; Code:
-
-(eval-when-compile
-  (require 'imenu)
-  (require 'outline)
-  (require 'dabbrev)
-  (require 'add-log))
-
-;; I sure wish Emacs had a package that made it easy to extract this
-;; sort of information.  Strange definition works with XEmacs 20.0.
-(defconst tcl-using-emacs-19 (not (string-match "18\\." emacs-version))
-  "Non-nil if using Emacs 19 or later.")
-
-(defconst tcl-using-emacs-19-23
-  (or (string-match "19\\.\\(2[3-9]\\|[3-9][0-9]\\)" emacs-version)
-      (string-match "^[2-9][0-9]\\." emacs-version))
-  "Non-nil if using Emacs 19-23 or later.")
-
-(defconst tcl-using-xemacs-19 (string-match "XEmacs" emacs-version)
-  "Non-nil if using XEmacs.")
-
-(require 'comint)
-
-;; When compiling under Emacs, load imenu during compilation.  If
-;; you have 19.22 or earlier, comment this out, or get imenu.
-(and (fboundp 'eval-when-compile)
-     (eval-when-compile
-       (if (and (not (string< emacs-version "19.23"))
-		(not (string-match "XEmacs" emacs-version)))
-	   (require 'imenu))
-       ()))
-
-(defconst tcl-version "Revision: 1.64.4.1 ")
-(defconst tcl-maintainer "Tom Tromey ")
-
-;;
-;; User variables.
-;;
-
-(defgroup tcl nil
-  "Major mode for editing Tcl source in Emacs"
-  :group 'languages)
-
-(defcustom tcl-indent-level 4
-  "*Indentation of Tcl statements with respect to containing block."
-  :group 'tcl
-  :type 'integer)
-
-(defcustom tcl-continued-indent-level 4
-  "*Indentation of continuation line relative to first line of command."
-  :group 'tcl
-  :type 'integer)
-
-(defcustom tcl-auto-newline nil
-  "*Non-nil means automatically newline before and after braces you insert."
-  :group 'tcl
-  :type 'boolean)
-
-(defcustom tcl-tab-always-indent t
-  "*Control effect of TAB key.
-If t (the default), always indent current line.
-If nil and point is not in the indentation area at the beginning of
-the line, a TAB is inserted.
-Other values cause the first possible action from the following list
-to take place:
-
-  1. Move from beginning of line to correct indentation.
-  2. Delete an empty comment.
-  3. Move forward to start of comment, indenting if necessary.
-  4. Move forward to end of line, indenting if necessary.
-  5. Create an empty comment.
-  6. Move backward to start of comment, indenting if necessary."
-  :group 'tcl
-  :type '(choice (const :tag "Always" t)
-		 (const :tag "Beginning only" nil)
-		 (const :tag "Maybe move or make or delete comment" 'tcl)))
-
-
-(defcustom tcl-use-hairy-comment-detector t
-  "*If not nil, use the more sophisticated, but slower, comment-delete method.
-This variable is not effective in Emacs 18;
-the fast function is always used in that version."
-  :group 'tcl
-  :type 'boolean)
-
-(defcustom tcl-electric-hash-style 'smart
-  "*Style of electric hash insertion to use.
-Possible values are `backslash', meaning that `\\' quoting should be
-done; `quote', meaning that `\"' quoting should be done; `smart',
-meaning that the choice between `backslash' and `quote' should be
-made depending on the number of hashes inserted; or nil, meaning that
-no quoting should be done.  Any other value for this variable is
-taken to mean `smart'.  The default is `smart'."
-  :group 'tcl
-  :type '(choice (const backslash) (const quote) (const smart) (const nil)))
-
-(defcustom tcl-help-directory-list nil
-  "*List of topmost directories containing TclX help files."
-  :group 'tcl
-  :type '(repeat directory))
-
-(defcustom tcl-use-smart-word-finder t
-  "*If not nil, use smart way to find current word, for Tcl help feature."
-  :group 'tcl
-  :type 'boolean)
-
-(defcustom tcl-application "wish"
-  "*Name of Tcl program to run in inferior Tcl mode."
-  :group 'tcl
-  :type 'string)
-
-(defcustom tcl-command-switches nil
-  "*List of switches to supply to the `tcl-application' program."
-  :group 'tcl
-  :type '(repeat string))
-
-(defcustom tcl-prompt-regexp "^\\(% \\|\\)"
-  "*If not nil, a regexp that will match the prompt in the inferior process.
-If nil, the prompt is the name of the application with \">\" appended.
-
-The default is \"^\\(% \\|\\)\", which will match the default primary
-and secondary prompts for tclsh and wish."
-  :group 'tcl
-  :type 'regexp)
-
-(defcustom inferior-tcl-source-command "source %s\n"
-  "*Format-string for building a Tcl command to load a file.
-This format string should use `%s' to substitute a file name
-and should result in a Tcl expression that will command the
-inferior Tcl to load that file.  The filename will be appropriately
-quoted for Tcl."
-  :group 'tcl
-  :type 'string)
-
-;;
-;; Keymaps, abbrevs, syntax tables.
-;;
-
-(defvar tcl-mode-abbrev-table nil
-  "Abbrev table in use in Tcl-mode buffers.")
-(if tcl-mode-abbrev-table
-    ()
-  (define-abbrev-table 'tcl-mode-abbrev-table ()))
-
-(defvar tcl-mode-map ()
-  "Keymap used in Tcl mode.")
-
-(defvar tcl-mode-syntax-table nil
-  "Syntax table in use in Tcl-mode buffers.")
-(if tcl-mode-syntax-table
-    ()
-  (setq tcl-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?%  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?@  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?&  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?*  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?+  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?-  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?.  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?:  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?!  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?$  "_" tcl-mode-syntax-table) ; FIXME use "'"?
-  (modify-syntax-entry ?/  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?~  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?<  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?=  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?>  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?|  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?\(  "()" tcl-mode-syntax-table)
-  (modify-syntax-entry ?\)  ")(" tcl-mode-syntax-table)
-  (modify-syntax-entry ?\;  "." tcl-mode-syntax-table)
-  (modify-syntax-entry ?\n ">   " tcl-mode-syntax-table)
-  (modify-syntax-entry ?\f ">   " tcl-mode-syntax-table)
-  (modify-syntax-entry ?# "<   " tcl-mode-syntax-table))
-
-(defvar inferior-tcl-mode-map nil
-  "Keymap used in Inferior Tcl mode.")
-
-;; XEmacs menu.
-(defvar tcl-xemacs-menu
-  '(["Beginning of function" tcl-beginning-of-defun t]
-    ["End of function" tcl-end-of-defun t]
-    ["Mark function" tcl-mark-defun t]
-    ["Indent region" indent-region (tcl-mark)]
-    ["Comment region" comment-region (tcl-mark)]
-    ["Uncomment region" tcl-uncomment-region (tcl-mark)]
-    "----"
-    ["Show Tcl process buffer" inferior-tcl t]
-    ["Send function to Tcl process" tcl-eval-defun
-     (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
-    ["Send region to Tcl process" tcl-eval-region
-     (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
-    ["Send file to Tcl process" tcl-load-file
-     (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
-    ["Restart Tcl process with file" tcl-restart-with-file t]
-    "----"
-    ["Tcl help" tcl-help-on-word tcl-help-directory-list]
-    ["Send bug report" tcl-submit-bug-report t])
-  "XEmacs menu for Tcl mode.")
-
-;; Emacs does menus via keymaps.  Do it in a function in case we
-;; later decide to add it to inferior Tcl mode as well.
-(defun tcl-add-emacs-menu (map)
-  (define-key map [menu-bar] (make-sparse-keymap "Tcl"))
-  ;; This fails in Emacs 19.22 and earlier.
-  (require 'lmenu)
-  (let ((menu (make-lucid-menu-keymap "Tcl" tcl-xemacs-menu)))
-    (define-key map [menu-bar tcl] (cons "Tcl" menu))
-    ;; The following is intended to compute the key sequence
-    ;; information for the menu.  It doesn't work.
-    (x-popup-menu nil menu)))
-
-(defun tcl-fill-mode-map ()
-  (define-key tcl-mode-map "{" 'tcl-electric-char)
-  (define-key tcl-mode-map "}" 'tcl-electric-brace)
-  (define-key tcl-mode-map "[" 'tcl-electric-char)
-  (define-key tcl-mode-map "]" 'tcl-electric-char)
-  (define-key tcl-mode-map ";" 'tcl-electric-char)
-  (define-key tcl-mode-map "#" 'tcl-electric-hash)
-  ;; FIXME.
-  (define-key tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
-  ;; FIXME.
-  (define-key tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
-  ;; FIXME.
-  (define-key tcl-mode-map "\e\C-h" 'tcl-mark-defun)
-  (define-key tcl-mode-map "\e\C-q" 'indent-tcl-exp)
-  (define-key tcl-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key tcl-mode-map "\t" 'tcl-indent-command)
-  (define-key tcl-mode-map "\M-;" 'tcl-indent-for-comment)
-  (define-key tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
-  (define-key tcl-mode-map "\C-c\C-b" 'tcl-submit-bug-report)
-  (and (fboundp 'comment-region)
-       (define-key tcl-mode-map "\C-c\C-c" 'comment-region))
-  (define-key tcl-mode-map "\C-c\C-i" 'tcl-help-on-word)
-  (define-key tcl-mode-map "\C-c\C-v" 'tcl-eval-defun)
-  (define-key tcl-mode-map "\C-c\C-f" 'tcl-load-file)
-  (define-key tcl-mode-map "\C-c\C-t" 'inferior-tcl)
-  (define-key tcl-mode-map "\C-c\C-x" 'tcl-eval-region)
-  (define-key tcl-mode-map "\C-c\C-s" 'switch-to-tcl)
-
-  ;; Make menus.
-  (if (and tcl-using-emacs-19 (not tcl-using-xemacs-19))
-      (progn
-	(tcl-add-emacs-menu tcl-mode-map))))
-
-(defun tcl-fill-inferior-map ()
-  (define-key inferior-tcl-mode-map "\t" 'comint-dynamic-complete)
-  (define-key inferior-tcl-mode-map "\M-?"
-    'comint-dynamic-list-filename-completions)
-  (define-key inferior-tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
-  (define-key inferior-tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
-  (define-key inferior-tcl-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key inferior-tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
-  (define-key inferior-tcl-mode-map "\C-c\C-b" 'tcl-submit-bug-report)
-  (define-key inferior-tcl-mode-map "\C-c\C-i" 'tcl-help-on-word)
-  (define-key inferior-tcl-mode-map "\C-c\C-v" 'tcl-eval-defun)
-  (define-key inferior-tcl-mode-map "\C-c\C-f" 'tcl-load-file)
-  (define-key inferior-tcl-mode-map "\C-c\C-t" 'inferior-tcl)
-  (define-key inferior-tcl-mode-map "\C-c\C-x" 'tcl-eval-region)
-  (define-key inferior-tcl-mode-map "\C-c\C-s" 'switch-to-tcl))
-
-(if tcl-mode-map
-    ()
-  (setq tcl-mode-map (make-sparse-keymap))
-  (tcl-fill-mode-map))
-
-(if inferior-tcl-mode-map
-    ()
-  ;; FIXME Use keymap inheritance here?  FIXME we override comint
-  ;; keybindings here.  Maybe someone has a better set?
-  (setq inferior-tcl-mode-map (copy-keymap comint-mode-map))
-  (tcl-fill-inferior-map))
-
-
-(defvar inferior-tcl-buffer nil
-  "*The current inferior-tcl process buffer.
-
-MULTIPLE PROCESS SUPPORT
-===========================================================================
-To run multiple Tcl processes, you start the first up with
-\\[inferior-tcl].  It will be in a buffer named `*inferior-tcl*'.
-Rename this buffer with \\[rename-buffer].  You may now start up a new
-process with another \\[inferior-tcl].  It will be in a new buffer,
-named `*inferior-tcl*'.  You can switch between the different process
-buffers with \\[switch-to-buffer].
-
-Commands that send text from source buffers to Tcl processes -- like
-`tcl-eval-defun' or `tcl-load-file' -- have to choose a process to
-send to, when you have more than one Tcl process around.  This is
-determined by the global variable `inferior-tcl-buffer'.  Suppose you
-have three inferior Lisps running:
-    Buffer              Process
-    foo                 inferior-tcl
-    bar                 inferior-tcl<2>
-    *inferior-tcl*      inferior-tcl<3>
-If you do a \\[tcl-eval-defun] command on some Lisp source code, what
-process do you send it to?
-
-- If you're in a process buffer (foo, bar, or *inferior-tcl*), 
-  you send it to that process.
-- If you're in some other buffer (e.g., a source file), you
-  send it to the process attached to buffer `inferior-tcl-buffer'.
-This process selection is performed by function `inferior-tcl-proc'.
-
-Whenever \\[inferior-tcl] fires up a new process, it resets
-`inferior-tcl-buffer' to be the new process's buffer.  If you only run
-one process, this does the right thing.  If you run multiple
-processes, you can change `inferior-tcl-buffer' to another process
-buffer with \\[set-variable].")
-
-;;
-;; Hooks and other customization.
-;;
-
-(defcustom tcl-mode-hook nil
-  "Hook run on entry to Tcl mode.
-
-Several functions exist which are useful to run from your
-`tcl-mode-hook' (see each function's documentation for more
-information):
-
-  `tcl-guess-application'
-    Guesses a default setting for `tcl-application' based on any
-    \"#!\" line at the top of the file.
-  `tcl-hashify-buffer'
-    Quotes all \"#\" characters that don't correspond to actual
-    Tcl comments.  (Useful when editing code not originally created
-    with this mode).
-  `tcl-auto-fill-mode'
-    Auto-filling of Tcl comments.
-
-Add functions to the hook with `add-hook':
-
-   (add-hook 'tcl-mode-hook 'tcl-guess-application)
-
-Emacs 18 users must use `setq' instead:
-
-   (setq tcl-mode-hook (cons 'tcl-guess-application tcl-mode-hook))"
-  :type 'hook
-  :group 'tcl)
-
-
-(defcustom inferior-tcl-mode-hook nil
-  "Hook for customizing Inferior Tcl mode."
-  :type 'hook
-  :group 'tcl)
-
-(defvar tcl-proc-list
-  '("proc" "method" "itcl_class" "body" "configbody" "class")
-  "List of commands whose first argument defines something.
-This exists because some people (eg, me) use `defvar' et al.
-Call `tcl-set-proc-regexp' and `tcl-set-font-lock-keywords'
-after changing this list.")
-
-(defvar tcl-proc-regexp nil
-  "Regexp to use when matching proc headers.")
-
-(defvar tcl-typeword-list
-  '("global" "upvar" "inherit" "public" "protected" "private"
-    "common" "itk_option" "variable")
-  "List of Tcl keywords denoting \"type\".  Used only for highlighting.
-Call `tcl-set-font-lock-keywords' after changing this list.")
-
-;; Generally I've picked control operators to be keywords.
-(defvar tcl-keyword-list
-  '("if" "then" "else" "elseif" "for" "foreach" "break" "continue" "while"
-    "eval" "case" "in" "switch" "default" "exit" "error" "proc" "return"
-    "uplevel" "constructor" "destructor" "itcl_class" "loop" "for_array_keys"
-    "for_recursive_glob" "for_file" "method" "body" "configbody" "class")
-  "List of Tcl keywords.  Used only for highlighting.
-Default list includes some TclX keywords.
-Call `tcl-set-font-lock-keywords' after changing this list.")
-
-(defvar tcl-font-lock-keywords nil
-  "Keywords to highlight for Tcl.  See variable `font-lock-keywords'.
-This variable is generally set from `tcl-proc-regexp',
-`tcl-typeword-list', and `tcl-keyword-list' by the function
-`tcl-set-font-lock-keywords'.")
-
-;; FIXME need some way to recognize variables because array refs look
-;; like 2 sexps.
-(defvar tcl-type-alist
-  '(
-    ("proc" nil tcl-expr tcl-commands)
-    ("method" nil tcl-expr tcl-commands)
-    ("destructor" tcl-commands)
-    ("constructor" tcl-commands)
-    ("expr" tcl-expr)
-    ("catch" tcl-commands)
-    ("if" tcl-expr "then" tcl-commands)
-    ("elseif" tcl-expr "then" tcl-commands)
-    ("elseif" tcl-expr tcl-commands)
-    ("if" tcl-expr tcl-commands)
-    ("while" tcl-expr tcl-commands)
-    ("for" tcl-commands tcl-expr tcl-commands tcl-commands)
-    ("foreach" nil nil tcl-commands)
-    ("for_file" nil nil tcl-commands)
-    ("for_array_keys" nil nil tcl-commands)
-    ("for_recursive_glob" nil nil nil tcl-commands)
-    ;; Loop handling is not perfect, because the third argument can be
-    ;; either a command or an expr, and there is no real way to look
-    ;; forward.
-    ("loop" nil tcl-expr tcl-expr tcl-commands)
-    ("loop" nil tcl-expr tcl-commands)
-    )
-  "Alist that controls indentation.
-\(Actually, this really only controls what happens on continuation lines).
-Each entry looks like `(KEYWORD TYPE ...)'.
-Each type entry describes a sexp after the keyword, and can be one of:
-* nil, meaning that this sexp has no particular type.
-* tcl-expr, meaning that this sexp is an arithmetic expression.
-* tcl-commands, meaning that this sexp holds Tcl commands.
-* a string, which must exactly match the string at the corresponding
-  position for a match to be made.
-
-For example, the entry for the \"loop\" command is:
-
-   (\"loop\" nil tcl-expr tcl-commands)
-
-This means that the \"loop\" command has three arguments.  The first
-argument is ignored (for indentation purposes).  The second argument
-is a Tcl expression, and the last argument is Tcl commands.")
-
-(defvar tcl-explain-indentation nil
-  "If not `nil', debugging message will be printed during indentation.")
-
-
-
-;;
-;; Work around differences between various versions of Emacs.
-;;
-
-(defconst tcl-pps-has-arg-6
-  (or tcl-using-emacs-19
-      (and tcl-using-xemacs-19
-	   (condition-case nil
-	       (progn
-		 (parse-partial-sexp (point) (point) nil nil nil t)
-		 t)
-	     (error nil))))
-  "t if Emacs supports COMMENTSTOP argument to `parse-partial-sexp'.")
-
-;; Its pretty bogus to have to do this, but there is no easier way to
-;; say "match not syntax-1 and not syntax-2".  Too bad you can't put
-;; \s in [...].  This sickness is used in Emacs 19 to match a defun
-;; starter.  (It is used for this in v18 as well).
-;;(defconst tcl-omit-ws-regexp
-;;  (concat "^\\(\\s"
-;;	  (mapconcat 'char-to-string "w_.()\"\\$'/" "\\|\\s")
-;;	  "\\)\\S(*")
-;;  "Regular expression that matches everything except space, comment
-;;starter, and comment ender syntax codes.")
-
-;; FIXME?  Instead of using the hairy regexp above, we just use a
-;; simple one.
-;;(defconst tcl-omit-ws-regexp "^[^] \t\n#}]\\S(*"
-;;  "Regular expression used in locating function definitions.")
-
-;; Here's another stab.  I think this one actually works.  Now the
-;; problem seems to be that there is a bug in Emacs 19.22 where
-;; end-of-defun doesn't really use the brace matching the one that
-;; trails defun-prompt-regexp.
-;; ?? Is there a bug now ??
-(defconst tcl-omit-ws-regexp "^[^ \t\n#}][^\n}]+}*[ \t]+")
-
-(defun tcl-internal-beginning-of-defun (&optional arg)
-  "Move backward to next beginning of defun.
-With argument, do this that many times.
-Returns t unless search stops due to end of buffer."
-  (interactive "p")
-  (if (or (null arg) (= arg 0))
-      (setq arg 1))
-  (let (success)
-    (while (progn
-	     (setq arg (1- arg))
-	     (and (>= arg 0)
-		  (setq success
-			(re-search-backward tcl-omit-ws-regexp nil 'move 1))))
-      (while (and (looking-at "[]#}]")
-		  (setq success
-			(re-search-backward tcl-omit-ws-regexp nil 'move 1)))))
-    (beginning-of-line)
-    (not (null success))))
-
-(defun tcl-internal-end-of-defun (&optional arg)
-  "Move forward to next end of defun.
-An end of a defun is found by moving forward from the beginning of one."
-  (interactive "p")
-  (if (or (null arg) (= arg 0)) (setq arg 1))
-  (let ((start (point)))
-    ;; Was forward-char.  I think this works a little better.
-    (forward-line)
-    (tcl-beginning-of-defun)
-    (while (> arg 0)
-      (while (and (re-search-forward tcl-omit-ws-regexp nil 'move 1)
-		  (progn (beginning-of-line) t)
-		  (looking-at "[]#}]")
-		  (progn (forward-line) t)))
-      (let ((next-line (save-excursion 
-			 (forward-line)
-			 (point))))
-	(while (< (point) next-line)
-	  (forward-sexp)))
-      (forward-line)
-      (if (> (point) start) (setq arg (1- arg))))))
-
-;; We can now use begining-of-defun as long as we set up a
-;; certain regexp.  In Emacs 18, we need our own function.
-(defalias 'tcl-beginning-of-defun
-  (if tcl-using-emacs-19
-      'beginning-of-defun
-    'tcl-internal-beginning-of-defun))
-
-;; Ditto end-of-defun.
-(defalias 'tcl-end-of-defun
-  (if (and tcl-using-emacs-19 (not tcl-using-xemacs-19))
-      'end-of-defun
-    'tcl-internal-end-of-defun))
-
-;; Internal mark-defun that is used for losing Emacsen.
-(defun tcl-internal-mark-defun ()
-  "Put mark at end of Tcl function, point at beginning."
-  (interactive)
-  (push-mark (point))
-  (tcl-end-of-defun)
-  (if tcl-using-emacs-19
-      (push-mark (point) nil t)
-    (push-mark (point)))
-  (tcl-beginning-of-defun)
-  (backward-paragraph))
-
-;; In Emacs 19.23 and later, mark-defun works as advertised.  I
-;; don't know about XEmacs, so for now it and Emacs 18 just lose.
-(fset 'tcl-mark-defun
-      (if tcl-using-emacs-19-23
-	  'mark-defun
-	'tcl-internal-mark-defun))
-
-;; In Emacs 19, mark takes an additional "force" argument.  I
-;; don't know about XEmacs, so I'm just assuming it is the same.
-;; Emacs 18 doesn't have this argument.
-(defun tcl-mark ()
-  "Return mark, or nil if none."
-  (if tcl-using-emacs-19
-      (mark t)
-    (mark)))
-
-
-
-;;
-;; Some helper functions.
-;;
-
-(defun tcl-set-proc-regexp ()
-  "Set `tcl-proc-regexp' from variable `tcl-proc-list'."
-  (setq tcl-proc-regexp (concat "^\\s-*\\("
-				(mapconcat 'identity tcl-proc-list "\\|")
-				"\\)[ \t]+")))
-
-(defun tcl-set-font-lock-keywords ()
-  "Set `tcl-font-lock-keywords'.
-Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
-  (setq tcl-font-lock-keywords
-	(list
-	 ;; Names of functions (and other "defining things").
-	 (list (concat tcl-proc-regexp "\\([^ \t\n]+\\)")
-	       2 'font-lock-function-name-face)
-
-	 ;; Names of type-defining things.
-	 (list (concat "\\(\\s-\\|^\\)\\("
-		       ;; FIXME Use 'regexp-quote?
-		       (mapconcat 'identity tcl-typeword-list "\\|")
-		       "\\)\\(\\s-\\|$\\)")
-	       2 'font-lock-type-face)
-
-	 ;; Keywords.  Only recognized if surrounded by whitespace.
-	 ;; FIXME consider using "not word or symbol", not
-	 ;; "whitespace".
-	 (cons (concat "\\(\\s-\\|^\\)\\("
-		       ;; FIXME Use regexp-quote? 
-		       (mapconcat 'identity tcl-keyword-list "\\|")
-		       "\\)\\(\\s-\\|$\\)")
-	       2)
-	 )))
-
-(if tcl-proc-regexp
-    ()
-  (tcl-set-proc-regexp))
-
-(if tcl-font-lock-keywords
-    ()
-  (tcl-set-font-lock-keywords))
-
-;; XEmacs change.
-(defvar tcl-imenu-generic-expression
-  '((nil "^proc[ \t]+\\([-A-Za-z0-9_:+*]+\\)" 1))
-  "Imenu generic expression for `tcl-mode'.  See `imenu-generic-expression'.")
-
-
-;;
-;; The mode itself.
-;;
-
-;;;###autoload
-(defun tcl-mode ()
-  "Major mode for editing Tcl code.
-Expression and list commands understand all Tcl brackets.
-Tab indents for Tcl code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-
-Variables controlling indentation style:
-  `tcl-indent-level'
-    Indentation of Tcl statements within surrounding block.
-  `tcl-continued-indent-level'
-    Indentation of continuation line relative to first line of command.
-
-Variables controlling user interaction with mode (see variable
-documentation for details):
-  `tcl-tab-always-indent'
-    Controls action of TAB key.
-  `tcl-auto-newline'
-    Non-nil means automatically newline before and after braces, brackets,
-    and semicolons inserted in Tcl code.
-  `tcl-electric-hash-style'
-    Controls action of `#' key.
-  `tcl-use-hairy-comment-detector'
-    If t, use more complicated, but slower, comment detector.
-    This variable is only used in Emacs 19.
-  `tcl-use-smart-word-finder'
-    If not nil, use a smarter, Tcl-specific way to find the current
-    word when looking up help on a Tcl command.
-
-Turning on Tcl mode calls the value of the variable `tcl-mode-hook'
-with no args, if that value is non-nil.  Read the documentation for
-`tcl-mode-hook' to see what kinds of interesting hook functions
-already exist.
-
-Commands:
-\\{tcl-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map tcl-mode-map)
-  (setq major-mode 'tcl-mode)
-  (setq mode-name "Tcl")
-  (setq local-abbrev-table tcl-mode-abbrev-table)
-  (set-syntax-table tcl-mode-syntax-table)
-
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'paragraph-separate)
-  (if (and tcl-using-emacs-19-23
-	   (>= emacs-minor-version 29))
-      (progn
-	;; In Emacs 19.29, you aren't supposed to start these with a ^.
-	(setq paragraph-start "$\\|")
-	(setq paragraph-separate paragraph-start))
-    (setq paragraph-start (concat "^$\\|" page-delimiter))
-    (setq paragraph-separate paragraph-start))
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-
-  ;; XEmacs change: check for filladapt-mode.
-  (if (not (and (boundp 'filladapt-mode)
-                filladapt-mode))
-      (progn
-        (make-local-variable 'fill-paragraph-function)
-        (setq fill-paragraph-function 'tcl-do-fill-paragraph)))
-
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'tcl-indent-line)
-
-  ;; Tcl doesn't require a final newline.
-  ;; (make-local-variable 'require-final-newline)
-  ;; (setq require-final-newline t)
-
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+ *")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp "[^\n\^M]")
-  (make-local-variable 'outline-level)
-  (setq outline-level 'tcl-outline-level)
-
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults
-	'(tcl-font-lock-keywords))
-
-  ;; XEmacs change.
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression tcl-imenu-generic-expression)
-  ;; (add-hook 'tcl-mode-hook 'imenu-add-menubar-index)
-
-  (make-local-variable 'parse-sexp-ignore-comments)
-
-  ;; Settings for new dabbrev code.
-  (make-local-variable 'dabbrev-case-fold-search)
-  (setq dabbrev-case-fold-search nil)
-  (make-local-variable 'dabbrev-case-replace)
-  (setq dabbrev-case-replace nil)
-  (make-local-variable 'dabbrev-abbrev-skip-leading-regexp)
-  (setq dabbrev-abbrev-skip-leading-regexp "[$!]")
-  (make-local-variable 'dabbrev-abbrev-char-regexp)
-  (setq dabbrev-abbrev-char-regexp "\\sw\\|\\s_")
-
-  (if tcl-using-emacs-19
-      (progn
-	;; This can only be set to t in Emacs 19 and XEmacs.
-	;; Emacs 18 and Epoch lose.
-	(setq parse-sexp-ignore-comments t)
-	;; XEmacs has defun-prompt-regexp, but I don't believe
-	;; that it works for end-of-defun -- only for
-	;; beginning-of-defun.
-	(make-local-variable 'defun-prompt-regexp)
-	(setq defun-prompt-regexp tcl-omit-ws-regexp)
-	;; The following doesn't work in Lucid Emacs 19.6, but maybe
-	;; it will appear in later versions.
-	(make-local-variable 'add-log-current-defun-function)
-	(setq add-log-current-defun-function 'add-log-tcl-defun))
-    (setq parse-sexp-ignore-comments nil))
-
-  ;; Put Tcl menu into menubar for XEmacs.  This happens
-  ;; automatically in Emacs.
-  (if (and tcl-using-xemacs-19
-	   current-menubar
-	   (not (assoc "Tcl" current-menubar)))
-      (progn
-	(set-buffer-menubar (copy-sequence current-menubar))
-	(add-menu nil "Tcl" tcl-xemacs-menu)))
-  ;; Append Tcl menu to popup menu for XEmacs.
-  (if (and tcl-using-xemacs-19 (boundp 'mode-popup-menu))
-      (setq mode-popup-menu
-	    (cons (concat mode-name " Mode Commands") tcl-xemacs-menu)))
-
-  ;; If hilit19 is loaded, add our stuff.
-  (if (featurep 'hilit19)
-      (tcl-hilit))
-
-  (run-hooks 'tcl-mode-hook))
-
-
-
-;; This is used for braces, brackets, and semi (except for closing
-;; braces, which are handled specially).
-(defun tcl-electric-char (arg)
-  "Insert character and correct line's indentation."
-  (interactive "p")
-  ;; Indent line first; this looks better if parens blink.
-  (tcl-indent-line)
-  (self-insert-command arg)
-  (if (and tcl-auto-newline (= last-command-char ?\;))
-      (progn
-	(newline)
-	(tcl-indent-line))))
-
-;; This is used for closing braces.  If tcl-auto-newline is set, can
-;; insert a newline both before and after the brace, depending on
-;; context.  FIXME should this be configurable?  Does anyone use this?
-(defun tcl-electric-brace (arg)
-  "Insert character and correct line's indentation."
-  (interactive "p")
-  ;; If auto-newlining and there is stuff on the same line, insert a
-  ;; newline first.
-  (if tcl-auto-newline
-      (progn
-	(if (save-excursion
-	      (skip-chars-backward " \t")
-	      (bolp))
-	    ()
-	  (tcl-indent-line)
-	  (newline))
-	;; In auto-newline case, must insert a newline after each
-	;; brace.  So an explicit loop is needed.
-	(while (> arg 0)
-	  (insert last-command-char)
-	  (tcl-indent-line)
-	  (newline)
-	  (setq arg (1- arg))))
-    (self-insert-command arg))
-  (tcl-indent-line))
-
-
-
-(defun tcl-indent-command (&optional arg)
-  "Indent current line as Tcl code, or in some cases insert a tab character.
-If `tcl-tab-always-indent' is t (the default), always indent current line.
-If `tcl-tab-always-indent' is nil and point is not in the indentation
-area at the beginning of the line, a TAB is inserted.
-Other values of `tcl-tab-always-indent' cause the first possible action
-from the following list to take place:
-
-  1. Move from beginning of line to correct indentation.
-  2. Delete an empty comment.
-  3. Move forward to start of comment, indenting if necessary.
-  4. Move forward to end of line, indenting if necessary.
-  5. Create an empty comment.
-  6. Move backward to start of comment, indenting if necessary."
-  (interactive "p")
-  (cond
-   ((not tcl-tab-always-indent)
-    ;; Indent if in indentation area, otherwise insert TAB.
-    (if (<= (current-column) (current-indentation))
-	(tcl-indent-line)
-      (insert-tab arg)))
-   ((eq tcl-tab-always-indent t)
-    ;; Always indent.
-    (tcl-indent-line))
-   (t
-    ;; "Perl-mode" style TAB command.
-    (let* ((ipoint (point))
-	   (eolpoint (progn
-		       (end-of-line)
-		       (point)))
-	   (comment-p (tcl-in-comment)))
-      (cond
-       ((= ipoint (save-excursion
-		    (beginning-of-line)
-		    (point)))
-	(beginning-of-line)
-	(tcl-indent-line)
-	;; If indenting didn't leave us in column 0, go to the
-	;; indentation.  Otherwise leave point at end of line.  This
-	;; is a hack.
-	(if (= (point) (save-excursion
-			 (beginning-of-line)
-			 (point)))
-	    (end-of-line)
-	  (back-to-indentation)))
-       ((and comment-p (looking-at "[ \t]*$"))
-	;; Empty comment, so delete it.  We also delete any ";"
-	;; characters at the end of the line.  I think this is
-	;; friendlier, but I don't know how other people will feel.
-	(backward-char)
-	(skip-chars-backward " \t;")
-	(delete-region (point) eolpoint))
-       ((and comment-p (< ipoint (point)))
-	;; Before comment, so skip to it.
-	(tcl-indent-line)
-	(indent-for-comment))
-       ((/= ipoint eolpoint)
-	;; Go to end of line (since we're not there yet).
-	(goto-char eolpoint)
-	(tcl-indent-line))
-       ((not comment-p)
-	(tcl-indent-line)
-	(tcl-indent-for-comment))
-       (t
-	;; Go to start of comment.  We don't leave point where it is
-	;; because we want to skip comment-start-skip.
-	(tcl-indent-line)
-	(indent-for-comment)))))))
-
-(defun tcl-indent-line ()
-  "Indent current line as Tcl code.
-Return the amount the indentation changed by."
-  (let ((indent (calculate-tcl-indent nil))
-	beg shift-amt
-	(case-fold-search nil)
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil)
-	   (setq indent (current-indentation)))
-	  (t
-	   (skip-chars-forward " \t")
-	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((= (following-char) ?})
-		  (setq indent (- indent tcl-indent-level)))
-		 ((= (following-char) ?\])
-		  (setq indent (- indent 1))))))
-    (skip-chars-forward " \t")
-    (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))
-
-(defun tcl-figure-type ()
-  "Determine type of sexp at point.
-This is either `tcl-expr', `tcl-commands', or nil.  Puts point at start
-of sexp that indicates types.
-
-See documentation for variable `tcl-type-alist' for more information."
-  (let ((count 0)
-	result
-	word-stack)
-    (while (and (< count 5)
-		(not result))
-      (condition-case nil
-	  (progn
-	    ;; FIXME should use "tcl-backward-sexp", which would skip
-	    ;; over entire variables, etc.
-	    (backward-sexp)
-	    (if (looking-at "[a-zA-Z_]+")
-		(let ((list tcl-type-alist)
-		      entry)
-		  (setq word-stack (cons (tcl-word-no-props) word-stack))
-		  (while (and list (not result))
-		    (setq entry (car list))
-		    (setq list (cdr list))
-		    (let ((index 0))
-		      (while (and entry (<= index count))
-			;; Abort loop if string does not match word on
-			;; stack.
-			(and (stringp (car entry))
-			     (not (string= (car entry)
-					   (nth index word-stack)))
-			     (setq entry nil))
-			(setq entry (cdr entry))
-			(setq index (1+ index)))
-		      (and (> index count)
-			   (not (stringp (car entry)))
-			   (setq result (car entry)))
-		      )))
-	      (setq word-stack (cons nil word-stack))))
-	(error nil))
-      (setq count (1+ count)))
-    (and tcl-explain-indentation
-	 (message "Indentation type %s" result))
-    result))
-
-(defun calculate-tcl-indent (&optional parse-start)
-  "Return appropriate indentation for current line as Tcl code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
-  (save-excursion
-    (beginning-of-line)
-    (let* ((indent-point (point))
-	   (case-fold-search nil)
-	   (continued-line 
-	    (save-excursion
-	      (if (bobp)
-		  nil
-		(backward-char)
-		(= ?\\ (preceding-char)))))
-	   (continued-indent-value (if continued-line
-				       tcl-continued-indent-level
-				     0))
-	   state
-	   containing-sexp
-	   found-next-line)
-      (if parse-start
-	  (goto-char parse-start)
-	(tcl-beginning-of-defun))
-      (while (< (point) indent-point)
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-	(setq containing-sexp (car (cdr state))))
-      (cond ((or (nth 3 state) (nth 4 state))
-	     ;; Inside comment or string.  Return nil or t if should
-	     ;; not change this line
-	     (nth 4 state))
-	    ((null containing-sexp)
-	     ;; Line is at top level.
-	     continued-indent-value)
-	    (t
-	     ;; Set expr-p if we are looking at the expression part of
-	     ;; an "if", "expr", etc statement.  Set commands-p if we
-	     ;; are looking at the body part of an if, while, etc
-	     ;; statement.  FIXME Should check for "for" loops here.
-	     (goto-char containing-sexp)
-	     (let* ((sexpr-type (tcl-figure-type))
-		    (expr-p (eq sexpr-type 'tcl-expr))
-		    (commands-p (eq sexpr-type 'tcl-commands))
-		    (expr-start (point)))
-	       ;; Find the first statement in the block and indent
-	       ;; like it.  The first statement in the block might be
-	       ;; on the same line, so what we do is skip all
-	       ;; "virtually blank" lines, looking for a non-blank
-	       ;; one.  A line is virtually blank if it only contains
-	       ;; a comment and whitespace.  FIXME continued comments
-	       ;; aren't supported.  They are a wart on Tcl anyway.
-	       ;; We do it this funky way because we want to know if
-	       ;; we've found a statement on some line _after_ the
-	       ;; line holding the sexp opener.
-	       (goto-char containing-sexp)
-	       (forward-char)
-	       (if (and (< (point) indent-point)
-			(looking-at "[ \t]*\\(#.*\\)?$"))
-		   (progn
-		     (forward-line)
-		     (while (and (< (point) indent-point)
-				 (looking-at "[ \t]*\\(#.*\\)?$"))
-		       (setq found-next-line t)
-		       (forward-line))))
-	       (if (or continued-line
-		       (/= (char-after containing-sexp) ?{)
-		       expr-p)
-		   (progn
-		     ;; Line is continuation line, or the sexp opener
-		     ;; is not a curly brace, or we are are looking at
-		     ;; an `expr' expression (which must be split
-		     ;; specially).  So indentation is column of first
-		     ;; good spot after sexp opener (with some added
-		     ;; in the continued-line case).  If there is no
-		     ;; nonempty line before the indentation point, we
-		     ;; use the column of the character after the sexp
-		     ;; opener.
-		     (if (>= (point) indent-point)
-			 (progn
-			   (goto-char containing-sexp)
-			   (forward-char))
-		       (skip-chars-forward " \t"))
-		     (+ (current-column) continued-indent-value))
-		 ;; After a curly brace, and not a continuation line.
-		 ;; So take indentation from first good line after
-		 ;; start of block, unless that line is on the same
-		 ;; line as the opening brace.  In this case use the
-		 ;; indentation of the opening brace's line, plus
-		 ;; another indent step.  If we are in the body part
-		 ;; of an "if" or "while" then the indentation is
-		 ;; taken from the line holding the start of the
-		 ;; statement.
-		 (if (and (< (point) indent-point)
-			  found-next-line)
-		     (current-indentation)
-		   (if commands-p
-		       (goto-char expr-start)
-		     (goto-char containing-sexp))
-		   (+ (current-indentation) tcl-indent-level)))))))))
-
-
-
-(defun indent-tcl-exp ()
-  "Indent each line of the Tcl grouping following point."
-  (interactive)
-  (let ((indent-stack (list nil))
-	(contain-stack (list (point)))
-	(case-fold-search nil)
-	outer-loop-done inner-loop-done state ostate
-	this-indent last-sexp continued-line
-	(next-depth 0)
-	last-depth)
-    (save-excursion
-      (forward-sexp 1))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (and (not (eobp)) (not outer-loop-done))
-	(setq last-depth next-depth)
-	;; Compute how depth changes over this line
-	;; plus enough other lines to get to one that
-	;; does not end inside a comment or string.
-	;; Meanwhile, do appropriate indentation on comment lines.
-	(setq inner-loop-done nil)
-	(while (and (not inner-loop-done)
-		    (not (and (eobp) (setq outer-loop-done t))))
-	  (setq ostate state)
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  (if (and (car (cdr (cdr state)))
-		   (>= (car (cdr (cdr state))) 0))
-	      (setq last-sexp (car (cdr (cdr state)))))
-	  (if (or (nth 4 ostate))
-	      (tcl-indent-line))
-	  (if (or (nth 3 state))
-	      (forward-line 1)
-	    (setq inner-loop-done t)))
-	(if (<= next-depth 0)
-	    (setq outer-loop-done t))
-	(if outer-loop-done
-	    nil
-	  ;; If this line had ..))) (((.. in it, pop out of the levels
-	  ;; that ended anywhere in this line, even if the final depth
-	  ;; doesn't indicate that they ended.
-	  (while (> last-depth (nth 6 state))
-	    (setq indent-stack (cdr indent-stack)
-		  contain-stack (cdr contain-stack)
-		  last-depth (1- last-depth)))
-	  (if (/= last-depth next-depth)
-	      (setq last-sexp nil))
-	  ;; Add levels for any parens that were started in this line.
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  contain-stack (cons nil contain-stack)
-		  last-depth (1+ last-depth)))
-	  (if (null (car contain-stack))
-	      (setcar contain-stack 
-		      (or (car (cdr state))
-			  (save-excursion
-			    (forward-sexp -1)
-			    (point)))))
-	  (forward-line 1)
-	  (setq continued-line 
-		(save-excursion
-		  (backward-char)
-		  (= (preceding-char) ?\\)))
-	  (skip-chars-forward " \t")
-	  (if (eolp)
-	      nil
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		;; Line is on an existing nesting level.
-		(setq this-indent (car indent-stack))
-	      ;; Just started a new nesting level.
-	      ;; Compute the standard indent for this level.
-	      (let ((val (calculate-tcl-indent
-			  (if (car indent-stack)
-			      (- (car indent-stack))))))
-		(setcar indent-stack
-			(setq this-indent val))
-		(setq continued-line nil)))
-	    (cond ((not (numberp this-indent)))
-		  ((= (following-char) ?})
-		   (setq this-indent (- this-indent tcl-indent-level)))
-		  ((= (following-char) ?\])
-		   (setq this-indent (- this-indent 1))))
-	    ;; Put chosen indentation into effect.
-	    (or (null this-indent)
-		(= (current-column) 
-		   (if continued-line 
-		       (+ this-indent tcl-indent-level)
-		     this-indent))
-		(progn
-		  (delete-region (point) (progn (beginning-of-line) (point)))
-		  (indent-to 
-		   (if continued-line 
-		       (+ this-indent tcl-indent-level)
-		     this-indent)))))))))
-  )
-
-
-
-;;
-;; Interfaces to other packages.
-;;
-
-;; FIXME Definition of function is very ad-hoc.  Should use
-;; tcl-beginning-of-defun.  Also has incestuous knowledge about the
-;; format of tcl-proc-regexp.
-(defun add-log-tcl-defun ()
-  "Return name of Tcl function point is in, or nil."
-  (save-excursion
-    (end-of-line)
-    (if (re-search-backward (concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t)
-	(buffer-substring (match-beginning 2)
-			  (match-end 2)))))
-
-(defun tcl-outline-level ()
-  (save-excursion
-    (skip-chars-forward " \t")
-    (current-column)))
-
-
-
-;;
-;; Helper functions for inferior Tcl mode.
-;;
-
-;; This exists to let us delete the prompt when commands are sent
-;; directly to the inferior Tcl.  See gud.el for an explanation of how
-;; it all works (I took it from there).  This stuff doesn't really
-;; work as well as I'd like it to.  But I don't believe there is
-;; anything useful that can be done.
-(defvar inferior-tcl-delete-prompt-marker nil)
-
-(defun tcl-filter (proc string)
-  (let ((inhibit-quit t))
-    (save-excursion
-      (set-buffer (process-buffer proc))
-      (goto-char (process-mark proc))
-      ;; Delete prompt if requested.
-      (if (marker-buffer inferior-tcl-delete-prompt-marker)
-	  (progn
-	    (delete-region (point) inferior-tcl-delete-prompt-marker)
-	    (set-marker inferior-tcl-delete-prompt-marker nil)))))
-  (if tcl-using-emacs-19
-      (comint-output-filter proc string)
-    (funcall comint-output-filter string)))
-
-(defun tcl-send-string (proc string)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (goto-char (process-mark proc))
-    (beginning-of-line)
-    (if (looking-at comint-prompt-regexp)
-	(set-marker inferior-tcl-delete-prompt-marker (point))))
-  (comint-send-string proc string))
-
-(defun tcl-send-region (proc start end)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (goto-char (process-mark proc))
-    (beginning-of-line)
-    (if (looking-at comint-prompt-regexp)
-	(set-marker inferior-tcl-delete-prompt-marker (point))))
-  (comint-send-region proc start end))
-
-(defun switch-to-tcl (eob-p)
-  "Switch to inferior Tcl process buffer.
-With argument, positions cursor at end of buffer."
-  (interactive "P")
-  (if (get-buffer inferior-tcl-buffer)
-      (pop-to-buffer inferior-tcl-buffer)
-    (error "No current inferior Tcl buffer"))
-  (cond (eob-p
-	 (push-mark)
-	 (goto-char (point-max)))))
-
-(defun inferior-tcl-proc ()
-  "Return current inferior Tcl process.
-See variable `inferior-tcl-buffer'."
-  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-tcl-mode)
-				      (current-buffer)
-				    inferior-tcl-buffer))))
-    (or proc
-	(error "No Tcl process; see variable `inferior-tcl-buffer'"))))
-
-(defun tcl-eval-region (start end &optional and-go)
-  "Send the current region to the inferior Tcl process.
-Prefix argument means switch to the Tcl buffer afterwards."
-  (interactive "r\nP")
-  (let ((proc (inferior-tcl-proc)))
-    (tcl-send-region proc start end)
-    (tcl-send-string proc "\n")
-    (if and-go (switch-to-tcl t))))
-
-(defun tcl-eval-defun (&optional and-go)
-  "Send the current defun to the inferior Tcl process.
-Prefix argument means switch to the Tcl buffer afterwards."
-  (interactive "P")
-  (save-excursion
-    (tcl-end-of-defun)
-    (let ((end (point)))
-      (tcl-beginning-of-defun)
-      (tcl-eval-region (point) end)))
-  (if and-go (switch-to-tcl t)))
-
-
-
-;;
-;; Inferior Tcl mode itself.
-;;
-
-(defun inferior-tcl-mode ()
-  "Major mode for interacting with Tcl interpreter.
-
-A Tcl process can be started with \\[inferior-tcl].
-
-Entry to this mode runs the normal hooks `comint-mode-hook' and
-`inferior-tcl-mode-hook', in that order.
-
-You can send text to the inferior Tcl process from other buffers
-containing Tcl source.
-
-Variables controlling Inferior Tcl mode:
-  `tcl-application'
-    Name of program to run.
-  `tcl-command-switches'
-    Command line arguments to `tcl-application'.
-  `tcl-prompt-regexp'
-    Matches prompt.
-  `inferior-tcl-source-command'
-    Command to use to read Tcl file in running application.
-  `inferior-tcl-buffer'
-    The current inferior Tcl process buffer.  See variable
-    documentation for details on multiple-process support.
-
-The following commands are available:
-\\{inferior-tcl-mode-map}"
-  (interactive)
-  (comint-mode)
-  (setq comint-prompt-regexp (or tcl-prompt-regexp
-				 (concat "^"
-					 (regexp-quote tcl-application)
-					 ">")))
-  (setq major-mode 'inferior-tcl-mode)
-  (setq mode-name "Inferior Tcl")
-  (if (boundp 'modeline-process)
-      (setq modeline-process '(": %s"))	; For XEmacs.
-    (setq mode-line-process '(": %s")))
-  (use-local-map inferior-tcl-mode-map)
-  (setq local-abbrev-table tcl-mode-abbrev-table)
-  (set-syntax-table tcl-mode-syntax-table)
-  (if tcl-using-emacs-19
-      (progn
-	(make-local-variable 'defun-prompt-regexp)
-	(setq defun-prompt-regexp tcl-omit-ws-regexp)))
-  (make-local-variable 'inferior-tcl-delete-prompt-marker)
-  (setq inferior-tcl-delete-prompt-marker (make-marker))
-  (set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter)
-  (run-hooks 'inferior-tcl-mode-hook))
-
-;;;###autoload
-(defun inferior-tcl (cmd)
-  "Run inferior Tcl process.
-Prefix arg means enter program name interactively.
-See documentation for function `inferior-tcl-mode' for more information."
-  (interactive
-   (list (if current-prefix-arg
-	     (read-string "Run Tcl: " tcl-application)
-	   tcl-application)))
-  (if (not (comint-check-proc "*inferior-tcl*"))
-      (progn
-	(set-buffer (apply (function make-comint) "inferior-tcl" cmd nil
-			   tcl-command-switches))
-	(inferior-tcl-mode)))
-  (make-local-variable 'tcl-application)
-  (setq tcl-application cmd)
-  (setq inferior-tcl-buffer "*inferior-tcl*")
-  (switch-to-buffer "*inferior-tcl*"))
-
-(and (fboundp 'defalias)
-     (defalias 'run-tcl 'inferior-tcl))
-
-
-
-;;
-;; Auto-fill support.
-;;
-
-(defun tcl-real-command-p ()
-  "Return nil if point is not at the beginning of a command.
-A command is the first word on an otherwise empty line, or the
-first word following a semicolon, opening brace, or opening bracket."
-  (save-excursion
-    (skip-chars-backward " \t")
-    (cond
-     ((bobp) t)
-     ((bolp)
-      (backward-char)
-      ;; Note -- continued comments are not supported here.  I
-      ;; consider those to be a wart on the language.
-      (not (eq ?\\ (preceding-char))))
-     (t
-      (memq (preceding-char) '(?\; ?{ ?\[))))))
-
-;; FIXME doesn't actually return t.  See last case.
-(defun tcl-real-comment-p ()
-  "Return t if point is just after the `#' beginning a real comment.
-Does not check to see if previous char is actually `#'.
-A real comment is either at the beginning of the buffer,
-preceded only by whitespace on the line, or has a preceding
-semicolon, opening brace, or opening bracket on the same line."
-  (save-excursion
-    (backward-char)
-    (tcl-real-command-p)))
-
-(defun tcl-hairy-scan-for-comment (state end always-stop)
-  "Determine if point is in a comment.
-Returns a list of the form `(FLAG . STATE)'.  STATE can be used
-as input to future invocations.  FLAG is nil if not in comment,
-t otherwise.  If in comment, leaves point at beginning of comment.
-
-This function does not work in Emacs 18.
-See also `tcl-simple-scan-for-comment', a
-simpler version that is often right, and works in Emacs 18."
-  (let ((bol (save-excursion
-	       (goto-char end)
-	       (beginning-of-line)
-	       (point)))
-	real-comment
-	last-cstart)
-    (while (and (not last-cstart) (< (point) end))
-      (setq real-comment nil)		;In case we've looped around and it is
-                                        ;set.
-      (setq state (parse-partial-sexp (point) end nil nil state t))
-      (if (nth 4 state)
-	  (progn
-	    ;; If ALWAYS-STOP is set, stop even if we don't have a
-	    ;; real comment, or if the comment isn't on the same line
-	    ;; as the end.
-	    (if always-stop (setq last-cstart (point)))
-	    ;; If we have a real comment, then set the comment
-	    ;; starting point if we are on the same line as the ending
-	    ;; location.
-	    (setq real-comment (tcl-real-comment-p))
-	    (if real-comment
-		(progn
-		  (and (> (point) bol) (setq last-cstart (point)))
-		  ;; NOTE Emacs 19 has a misfeature whereby calling
-		  ;; parse-partial-sexp with COMMENTSTOP set and with
-		  ;; an initial list that says point is in a comment
-		  ;; will cause an immediate return.  So we must skip
-		  ;; over the comment ourselves.
-		  (beginning-of-line 2)))
-	    ;; Frob the state to make it look like we aren't in a
-	    ;; comment.
-	    (setcar (nthcdr 4 state) nil))))
-    (and last-cstart
-	 (goto-char last-cstart))
-    (cons real-comment state)))
-
-(defun tcl-hairy-in-comment ()
-  "Return t if point is in a comment, and leave point at beginning of comment."
-  (let ((save (point)))
-    (tcl-beginning-of-defun)
-    (car (tcl-hairy-scan-for-comment nil save nil))))
-
-(defun tcl-simple-in-comment ()
-  "Return t if point is in comment, and leave point at beginning of comment.
-This is faster that `tcl-hairy-in-comment', but is correct less often."
-  (let ((save (point))
-	comment)
-    (beginning-of-line)
-    (while (and (< (point) save) (not comment))
-      (search-forward "#" save 'move)
-      (setq comment (tcl-real-comment-p)))
-    comment))
-
-(defun tcl-in-comment ()
-  "Return t if point is in comment, and leave point at beginning of comment."
-  (if (and tcl-pps-has-arg-6
-	   tcl-use-hairy-comment-detector)
-      (tcl-hairy-in-comment)
-    (tcl-simple-in-comment)))
-
-(defun tcl-do-fill-paragraph (ignore)
-  "`fill-paragraph' function for Tcl mode.  Only fills in a comment."
-  (let (in-comment col where)
-    (save-excursion
-      (end-of-line)
-      (setq in-comment (tcl-in-comment))
-      (if in-comment
-	  (progn
-	    (setq where (1+ (point)))
-	    (setq col (1- (current-column))))))
-    (and in-comment
-	 (save-excursion
-	   (back-to-indentation)
-	   (= col (current-column)))
-	 ;; In a comment.  Set the fill prefix, and find the paragraph
-	 ;; boundaries by searching for lines that look like
-	 ;; comment-only lines.
-	 (let ((fill-prefix (buffer-substring (progn
-						(beginning-of-line)
-						(point))
-					      where))
-	       p-start p-end)
-	   ;; Search backwards.
-	   (save-excursion
-	     (while (looking-at "^[ \t]*#")
-	       (forward-line -1))
-	     (forward-line)
-	     (setq p-start (point)))
-
-	   ;; Search forwards.
-	   (save-excursion
-	     (while (looking-at "^[ \t]*#")
-	       (forward-line))
-	     (setq p-end (point)))
-
-	   ;; Narrow and do the fill.
-	   (save-restriction
-	     (narrow-to-region p-start p-end)
-	     (fill-paragraph ignore)))))
-  t)
-
-(defun tcl-do-auto-fill ()
-  "Auto-fill function for Tcl mode.  Only auto-fills in a comment."
-  (if (> (current-column) fill-column)
-      (let ((fill-prefix "# ")
-	    in-comment col)
-	(save-excursion
-	  (setq in-comment (tcl-in-comment))
-	  (if in-comment
-	      (setq col (1- (current-column)))))
-	(if in-comment
-	    (progn
-	      (do-auto-fill)
-	      (save-excursion
-		(back-to-indentation)
-		(delete-region (point) (save-excursion
-					 (beginning-of-line)
-					 (point)))
-		(indent-to-column col)))))))
-
-
-
-;;
-;; Help-related code.
-;;
-
-(defvar tcl-help-saved-dirs nil
-  "Saved help directories.
-If `tcl-help-directory-list' changes, this allows `tcl-help-on-word'
-to update the alist.")
-
-(defvar tcl-help-alist nil
-  "Alist with command names as keys and filenames as values.")
-
-(defun tcl-help-snarf-commands (dirlist)
-  "Build alist of commands and filenames."
-  (while dirlist
-    (let ((files (directory-files (car dirlist) t)))
-      (while files
-	(if (and (file-directory-p (car files))
-		 (not
-		  (let ((fpart (file-name-nondirectory (car files))))
-		    (or (equal fpart ".")
-			(equal fpart "..")))))
-	    (let ((matches (directory-files (car files) t)))
-	      (while matches
-		(or (file-directory-p (car matches))
-		    (setq tcl-help-alist
-			  (cons
-			   (cons (file-name-nondirectory (car matches))
-				 (car matches))
-			   tcl-help-alist)))
-		(setq matches (cdr matches)))))
-	(setq files (cdr files))))
-    (setq dirlist (cdr dirlist))))
-
-(defun tcl-reread-help-files ()
-  "Set up to re-read files, and then do it."
-  (interactive)
-  (message "Building Tcl help file index...")
-  (setq tcl-help-saved-dirs tcl-help-directory-list)
-  (setq tcl-help-alist nil)
-  (tcl-help-snarf-commands tcl-help-directory-list)
-  (message "Building Tcl help file index...done"))
-
-(defun tcl-word-no-props ()
-  "Like `current-word', but strips properties."
-  (let ((word (current-word)))
-    (and (fboundp 'set-text-properties)
-	 (set-text-properties 0 (length word) nil word))
-    word))
-
-(defun tcl-current-word (flag)
-  "Return current command word, or nil.
-If FLAG is nil, just uses `current-word'.
-Otherwise scans backward for most likely Tcl command word."
-  (if (and flag
-	   (memq major-mode '(tcl-mode inferior-tcl-mode)))
-      (condition-case nil
-	  (save-excursion
-	    ;; Look backward for first word actually in alist.
-	    (if (bobp)
-		()
-	      (while (and (not (bobp))
-			  (not (tcl-real-command-p)))
-		(backward-sexp)))
-	    (if (assoc (tcl-word-no-props) tcl-help-alist)
-		(tcl-word-no-props)))
-	(error nil))
-    (tcl-word-no-props)))
-
-;;;###autoload
-(defun tcl-help-on-word (command &optional arg)
-  "Get help on Tcl command.  Default is word at point.
-Prefix argument means invert sense of `tcl-use-smart-word-finder'."
-  (interactive
-   (list
-    (progn
-      (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
-	  (tcl-reread-help-files))
-      (let ((word (tcl-current-word
-		   (if current-prefix-arg
-		       (not tcl-use-smart-word-finder)
-		     tcl-use-smart-word-finder))))
-	(completing-read
-	 (if (or (null word) (string= word ""))
-	     "Help on Tcl command: "
-	   (format "Help on Tcl command (default %s): " word))
-	 tcl-help-alist nil t)))
-    current-prefix-arg))
-  (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
-      (tcl-reread-help-files))
-  (if (string= command "")
-      (setq command (tcl-current-word
-		     (if arg
-			 (not tcl-use-smart-word-finder)
-		       tcl-use-smart-word-finder))))
-  (let* ((help (get-buffer-create "*Tcl help*"))
-	 (cell (assoc command tcl-help-alist))
-	 (file (and cell (cdr cell))))
-    (set-buffer help)
-    (delete-region (point-min) (point-max))
-    (if file
-	(progn
-	  (insert "*** " command "\n\n")
-	  (insert-file-contents file))
-      (if (string= command "")
-	  (insert "Magical Pig!")
-	(insert "Tcl command " command " not in help\n")))
-    (set-buffer-modified-p nil)
-    (goto-char (point-min))
-    (display-buffer help)))
-
-
-
-;;
-;; Other interactive stuff.
-;;
-
-(defvar tcl-previous-dir/file nil
-  "Record last directory and file used in loading.
-This holds a cons cell of the form `(DIRECTORY . FILE)'
-describing the last `tcl-load-file' command.")
-
-(defun tcl-load-file (file &optional and-go)
-  "Load a Tcl file into the inferior Tcl process.
-Prefix argument means switch to the Tcl buffer afterwards."
-  (interactive
-   (list
-    ;; car because comint-get-source returns a list holding the
-    ;; filename.
-    (car (comint-get-source "Load Tcl file: "
-			    (or (and
-				 (eq major-mode 'tcl-mode)
-				 (buffer-file-name))
-				tcl-previous-dir/file)
-			    '(tcl-mode) t))
-    current-prefix-arg))
-  (comint-check-source file)
-  (setq tcl-previous-dir/file (cons (file-name-directory file)
-				    (file-name-nondirectory file)))
-  (tcl-send-string (inferior-tcl-proc)
-		   (format inferior-tcl-source-command (tcl-quote file)))
-  (if and-go (switch-to-tcl t)))
-
-(defun tcl-restart-with-file (file &optional and-go)
-  "Restart inferior Tcl with file.
-If an inferior Tcl process exists, it is killed first.
-Prefix argument means switch to the Tcl buffer afterwards."
-  (interactive
-   (list
-    (car (comint-get-source "Restart with Tcl file: "
-			    (or (and
-				 (eq major-mode 'tcl-mode)
-				 (buffer-file-name))
-				tcl-previous-dir/file)
-			    '(tcl-mode) t))
-    current-prefix-arg))
-  (let* ((buf (if (eq major-mode 'inferior-tcl-mode)
-		  (current-buffer)
-		inferior-tcl-buffer))
-	 (proc (and buf (get-process buf))))
-    (cond
-     ((not (and buf (get-buffer buf)))
-      ;; I think this will be ok.
-      (inferior-tcl tcl-application)
-      (tcl-load-file file and-go))
-     ((or
-       (not (comint-check-proc buf))
-       (yes-or-no-p
-	"A Tcl process is running, are you sure you want to reset it? "))
-      (save-excursion
-	(comint-check-source file)
-	(setq tcl-previous-dir/file (cons (file-name-directory file)
-					  (file-name-nondirectory file)))
-	(comint-exec (get-buffer-create buf)
-		     (if proc
-			 (process-name proc)
-		       "inferior-tcl")
-		     tcl-application file tcl-command-switches)
-	(if and-go (switch-to-tcl t)))))))
-
-(defun tcl-auto-fill-mode (&optional arg)
-  "Like `auto-fill-mode', but controls filling of Tcl comments."
-  (interactive "P")
-  (and (not tcl-using-emacs-19)
-       (error "This feature is not supported in Emacs 18"))
-  ;; Following code taken from "auto-fill-mode" (simple.el).
-  (prog1
-      (setq auto-fill-function
-	    (if (if (null arg)
-		    (not auto-fill-function)
-		  (> (prefix-numeric-value arg) 0))
-		'tcl-do-auto-fill
-	      nil))
-    (force-mode-line-update)))
-
-;; hilit19 support from "Chris Alfeld" 
-(defun tcl-hilit ()
-  (hilit-set-mode-patterns
-   '(tcl-mode)
-   '(
-     ("\\(^ *\\|\; *\\)#.*$" nil comment)
-     ("[^\\]\\(\\$[A-Za-z0-9\\-\\_./\\(\\)]+\\)" 1 label)
-     ("[^_]\\<\\(append\\|array\\|auto_execok\\|auto_load\\|auto_mkindex\\|auto_reset\\|break\\|case\\|catch\\|cd\\|close\\|concat\\|continue\\|eof\\|error\\|eval\\|exec\\|exit\\|expr\\|file\\|flush\\|for\\|foreach\\|format\\|gets\\|glob\\|global\\|history\\|if\\|incr\\|info\\|join\\|lappend\\|lindex\\|linsert\\|list\\|llength\\|lrange\\|lreplace\\|lsearch\\|lsort\\|open\\|pid\\|proc\\|puts\\|pwd\\|read\\|regexp\\|regsub\\|rename\\|return\\|scan\\|seek\\|set\\|source\\|split\\|string\\|switch\\|tell\\|time\\|trace\\|unknown\\|unset\\|uplevel\\|upvar\\|while\\)\\>[^_]" 1 keyword) ; tcl keywords
-     ("[^_]\\<\\(after\\|bell\\|bind\\|bindtags\\|clipboard\\|destroy\\|fileevent\\|focus\\|grab\\|image\\|lower\\|option\\|pack\\|place\\|raise\\|scale\\|selection\\|send\\|subst\\|tk\\|tk_popup\\|tkwait\\|update\\|winfo\\|wm\\)\\>[^_]" 1 define) ; tk keywords
-     ("[^_]\\<\\(button\\|canvas\\|checkbutton\\|entry\\|frame\\|label\\|listbox\\|menu\\|menubutton\\|message\\|radiobutton\\|scrollbar\\|text\\|toplevel\\)\\>[^_]" 1 decl) ; tk widgets
-     ("[^_]\\<\\(tix\\((ButtonBox\\|Baloon\\|Control\\|DirList\\|ExFileSelectBox\\|ExFileSelectDialog\\|FileEntry\\|HList\\|LabelEntry\\|LabelFrame\\|NoteBook\\|OptionMenu\\|PanedWindow\\|PopupMenu\\|ScrolledHList\\|ScrolledText\\|ScrolledWindow\\|Select\\|StdButtonBox\\)\\)\\>[^_]" 1 defun) ; tix widgets
-     ("[{}\\\"\\(\\)]" nil include) ; misc punctuation
-     )))
-
-(defun tcl-electric-hash (&optional count)
-  "Insert a `#' and quote if it does not start a real comment.
-Prefix arg is number of `#'s to insert.
-See variable `tcl-electric-hash-style' for description of quoting
-styles."
-  (interactive "p")
-  (or count (setq count 1))
-  (if (> count 0)
-      (let ((type
-	     (if (eq tcl-electric-hash-style 'smart)
-		 (if (> count 3)	; FIXME what is "smart"?
-		     'quote
-		   'backslash)
-	       tcl-electric-hash-style))
-	    comment)
-	(if type
-	    (progn
-	      (save-excursion
-		(insert "#")
-		(setq comment (tcl-in-comment)))
-	      (delete-char 1)
-	      (and tcl-explain-indentation (message "comment: %s" comment))
-	      (cond
-	       ((eq type 'quote)
-		(if (not comment)
-		    (insert "\"")))
-	       ((eq type 'backslash)
-		;; The following will set count to 0, so the
-		;; insert-char can still be run.
-		(if (not comment)
-		    (while (> count 0)
-		      (insert "\\#")
-		      (setq count (1- count)))))
-	       (t nil))))
-	(insert-char ?# count))))
-
-(defun tcl-hashify-buffer ()
-  "Quote all `#'s in current buffer that aren't Tcl comments."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (if (and tcl-pps-has-arg-6 tcl-use-hairy-comment-detector)
-	(let (state
-	      result)
-	  (while (< (point) (point-max))
-	    (setq result (tcl-hairy-scan-for-comment state (point-max) t))
-	    (if (car result)
-		(beginning-of-line 2)
-	      (backward-char)
-	      (if (eq ?# (following-char))
-		  (insert "\\"))
-	      (forward-char))
-	    (setq state (cdr result))))
-      (while (and (< (point) (point-max))
-		  (search-forward "#" nil 'move))
-	(if (tcl-real-comment-p)
-	    (beginning-of-line 2)
-	  ;; There's really no good way for the simple converter to
-	  ;; work.  So we just quote # if it isn't already quoted.
-	  ;; Bogus, but it works.
-	  (backward-char)
-	  (if (not (eq ?\\ (preceding-char)))
-	      (insert "\\"))
-	  (forward-char))))))
-
-(defun tcl-indent-for-comment ()
-  "Indent this line's comment to comment column, or insert an empty comment.
-Is smart about syntax of Tcl comments.
-Parts of this were taken from `indent-for-comment'."
-  (interactive "*")
-  (end-of-line)
-  (or (tcl-in-comment)
-      (progn
-	;; Not in a comment, so we have to insert one.  Create an
-	;; empty comment (since there isn't one on this line).  If
-	;; line is not blank, make sure we insert a ";" first.
-	(skip-chars-backward " \t")
-	(let ((eolpoint (point)))
-	  (beginning-of-line)
-	  (if (/= (point) eolpoint)
-	      (progn
-		(goto-char eolpoint)
-		(insert
-		 (if (tcl-real-command-p) "" ";")
-		 "# ")
-		(backward-char))))))
-  ;; Point is just after the "#" starting a comment.  Move it as
-  ;; appropriate.
-  (let* ((indent (or (funcall comment-indent-function) comment-column))
-	 (begpos (progn
-		   (backward-char)
-		   (point))))
-    (if (/= begpos indent)
-	(progn
-	  (skip-chars-backward " \t" (save-excursion
-				       (beginning-of-line)
-				       (point)))
-	  (delete-region (point) begpos)
-	  (indent-to indent)))
-    (looking-at comment-start-skip)	; Always true.
-    (goto-char (match-end 0))
-    ;; I don't like the effect of the next two.
-    ;;(skip-chars-backward " \t" (match-beginning 0))
-    ;;(skip-chars-backward "^ \t" (match-beginning 0))
-    ))
-
-;; The following was inspired by the Tcl editing mode written by
-;; Gregor Schmid .  His version also
-;; attempts to snarf the command line options from the command line,
-;; but I didn't think that would really be that helpful (doesn't seem
-;; like it owould be right enough.  His version also looks for the
-;; "#!/bin/csh ... exec" hack, but that seemed even less useful.
-;; FIXME should make sure that the application mentioned actually
-;; exists.
-(defun tcl-guess-application ()
-  "Attempt to guess Tcl application by looking at first line.
-The first line is assumed to look like \"#!.../program ...\"."
-  (save-excursion
-    (goto-char (point-min))
-    (if (looking-at "#![^ \t]*/\\([^ \t\n/]+\\)\\([ \t]\\|$\\)")
-	(progn
-	  (make-local-variable 'tcl-application)
-	  (setq tcl-application (buffer-substring (match-beginning 1)
-						  (match-end 1)))))))
-
-;; This only exists to put on the menubar.  I couldn't figure out any
-;; other way to do it.  FIXME should take "number of #-marks"
-;; argument.
-(defun tcl-uncomment-region (beg end)
-  "Uncomment region."
-  (interactive "r")
-  (comment-region beg end -1))
-
-
-
-;;
-;; XEmacs menu support.
-;; Taken from schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid),
-;; who wrote a different Tcl mode.
-;; We also have support for menus in Emacs.  We do this by
-;; loading the XEmacs menu emulation code.
-;;
-
-(defun tcl-popup-menu (e)
-  (interactive "@e")
-  (and tcl-using-emacs-19
-       (not tcl-using-xemacs-19)
-       (if tcl-using-emacs-19-23
-	   (require 'lmenu)
-	 ;; CAVEATS:
-	 ;; * lmenu.el provides 'menubar, which is bogus.
-	 ;; * lmenu.el causes menubars to be turned on everywhere.
-	 ;;   Doubly bogus!
-	 ;; Both of these problems are fixed in Emacs 19.23.  People
-	 ;; using an Emacs before that just suffer.
-	 (require 'menubar "lmenu")))  ;; This is annoying
-  ;; IMHO popup-menu should be autoloaded.  Oh well.
-  (popup-menu tcl-xemacs-menu))
-
-
-
-;;
-;; Quoting and unquoting functions.
-;;
-
-;; This quoting is sufficient to protect eg a filename from any sort
-;; of expansion or splitting.  Tcl quoting sure sucks.
-(defun tcl-quote (string)
-  "Quote STRING according to Tcl rules."
-  (mapconcat (function (lambda (char)
-			 (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ?  ?\;))
-			     (concat "\\" (char-to-string char))
-			   (char-to-string char))))
-	     string ""))
-
-
-
-;;
-;; Bug reporting.
-;;
-
-(and (fboundp 'eval-when-compile)
-     (eval-when-compile
-       (require 'reporter)))
-
-(defun tcl-submit-bug-report ()
-  "Submit via mail a bug report on Tcl mode."
-  (interactive)
-  (require 'reporter)
-  (and
-   (y-or-n-p "Do you really want to submit a bug report on Tcl mode? ")
-   (reporter-submit-bug-report
-    tcl-maintainer
-    (concat "Tcl mode " tcl-version)
-    '(tcl-indent-level
-      tcl-continued-indent-level
-      tcl-auto-newline
-      tcl-tab-always-indent
-      tcl-use-hairy-comment-detector
-      tcl-electric-hash-style
-      tcl-help-directory-list
-      tcl-use-smart-word-finder
-      tcl-application
-      tcl-command-switches
-      tcl-prompt-regexp
-      inferior-tcl-source-command
-      tcl-using-emacs-19
-      tcl-using-emacs-19-23
-      tcl-using-xemacs-19
-      tcl-proc-list
-      tcl-proc-regexp
-      tcl-typeword-list
-      tcl-keyword-list
-      tcl-font-lock-keywords
-      tcl-pps-has-arg-6))))
-
-
-;; XEmacs additions
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\(?:tcl\\|exp\\)\\'" . tcl-mode))
-;;;###autoload(add-to-list 'interpreter-mode-alist '("^#!.*\\b\\(scope\\|wish\\|tcl\\|tclsh\\|expect\\)" . tcl-mode))
-
-(provide 'tcl)
-
-;;; tcl.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/teco.el b/xemacs-packages/lisp/prog-modes/teco.el
deleted file mode 100644
index 42c5f82f..00000000
--- a/xemacs-packages/lisp/prog-modes/teco.el
+++ /dev/null
@@ -1,1947 +0,0 @@
-;;; teco.el --- Teco interpreter for Gnu Emacs, version 1.
-
-;; Author: Dale R. Worley.
-;; Keywords: emulations
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; This code has been tested some, but no doubt contains a zillion bugs.
-;; You have been warned.
-
-;; Written by Dale R. Worley based on a C implementation by Matt Fichtenbaum.
-;; Please send comments, bug fixes, enhancements, etc. to drw@math.mit.edu.
-
-;; Emacs Lisp version copyright (C) 1991 by Dale R. Worley.
-;; Do what you will with it.
-
-;; Since much of this code is translated from the C version by 
-;; Matt Fichtenbaum, I include his copyright notice:
-;; TECO for Ultrix.   Copyright 1986 Matt Fichtenbaum.
-;; This program and its components belong to GenRad Inc, Concord MA 01742.
-;; They may be copied if this copyright notice is included.
-
-;; To invoke directly, do:
-;; (global-set-key ?\C-z 'teco-command)
-;; (autoload teco-command "teco"
-;;   "Read and execute a Teco command string."
-;;   t nil)
-
-;; Differences from other Tecos:
-;; Character positions in the buffer are numbered in the Emacs way:  The first
-;; character is numbered 1 (or (point-min) if narrowing is in effect).  The
-;; B command returns that number.
-;; Ends of lines are represented by a single character (newline), so C and R
-;; skip over them, rather than 2C and 2R.
-;; All file I/O is left to the underlying Emacs.  Thus, almost all Ex commands
-;; are omitted.
-
-;; Command set:
-;;	NUL	Not a command.
-;;	^A	Output message to terminal (argument ends with ^A)
-;;	^C	Exit macro
-;;	^C^C	Stop execution
-;;	^D	Set radix to decimal
-;;	^EA	(match char) Match alphabetics
-;;	^EC	(match char) Match symbol constituents
-;;	^ED	(match char) Match numerics
-;;	^EGq	(match char) Match any char in q-reg
-;;	^EL	(match char) Match line terminators
-;;	^EQq	(string char) Use contents of q-reg
-;;	^ER	(match char) Match alphanumerics
-;;	^ES	(match char) Match non-null space/tab
-;;	^EV	(match char) Match lower case alphabetic
-;;	^EW	(match char) Match upper case alphabetic
-;;	^EX	(match char) Match any char
-;;	^G^G	(type-in) Kill command string
-;;	^G	(type-in) Retype current command line
-;;	^G*	(type-in) Retype current command input
-;;	TAB	Insert tab and text
-;;	LF	Line terminator; Ignored in commands
-;;	VT	Ignored in commands
-;;	FF	Ignored in commands
-;;	CR	Ignored in commands
-;;	^Nx	(match char) Match all but x
-;;	^O	Set radix to octal
-;;	^P	Find matching parenthesis
-;;	^Q	Convert line argument into character argument
-;;	^Qx	(string char) Use x literally
-;;	n^R	Set radix to n
-;;	:^R	Enter recursive edit
-;;	^S	-(length of last referenced string)
-;;	^S	(match char) match separator char
-;;	^T	Ascii value of next character typed
-;;	n^T	Output Ascii character with value n
-;;	^U	(type-in) Kill command line
-;;	^Uq	Put text argument into q-reg
-;;	n^Uq	Put Ascii character 'n' into q-reg
-;;	:^Uq	Append text argument to q-reg
-;;	n:^Uq	Append character 'n' to q-reg
-;;	^X	Set/get search mode flag
-;;	^X	(match char) Match any character
-;;	^Y	Equivalent to '.+^S,.'
-;;	^Z	Not a Teco command
-;;	ESC	String terminator; absorbs arguments
-;;	ESC ESC	(type-in) End command
-;;	^\	Not a Teco command
-;;	^]	Not a Teco command
-;;	^^x	Ascii value of the character x
-;;	^_	One's complement (logical NOT)
-;;	!	Define label (argument ends with !)
-;;	"	Start conditional
-;;	n"<	Test for less than zero
-;;	n">	Test for greater than zero
-;;	n"=	Test for equal to zero
-;;	n"A	Test for alphabetic
-;;	n"C	Test for symbol constituent
-;;	n"D	Test for numeric
-;;	n"E	Test for equal to zero
-;;	n"F	Test for false
-;;	n"G	Test for greater than zero
-;;	n"L	Test for less than zero
-;;	n"N	Test for not equal to zero
-;;	n"R	Test for alphanumeric
-;;	n"S	Test for successful
-;;	n"T	Test for true
-;;	n"U	Test for unsuccessful
-;;	n"V	Test for lower case
-;;	n"W	Test for upper case
-;;	#	Logical OR
-;;	$	Not a Teco command
-;;	n%q	Add n to q-reg and return result
-;;	&	Logical AND
-;;	'	End conditional
-;;	(	Expression grouping
-;;	)	Expression grouping
-;;	*	Multiplication
-;;	+	Addition
-;;	,	Argument separator
-;;	-	Subtraction or negation
-;;	.	Current pointer position
-;;	/	Division
-;;	0-9	Digit
-;;	n<	Iterate n times
-;;	=	Type in decimal
-;;	:=	Type in decimal, no newline
-;;	=	Type in octal
-;;	:=	Type in octal, no newline
-;;	=	Type in hexadecimal
-;;	:=	Type in hexadecimal, no newline
-;;	::	Make next search a compare
-;;	>	End iteration
-;;	n:A	Get Ascii code of character at relative position n
-;;	B	Character position of beginning of buffer
-;;	nC	Advance n characters
-;;	nD	Delete n characters
-;;	n,mD	Delete characters between n and m
-;;	Gq	Get string from q-reg into buffer
-;;	:Gq	Type out q-reg
-;;	H	Equivalent to 'B,Z'
-;;	I	Insert text argument
-;;	nJ	Move pointer to character n
-;;	nK	Kill n lines
-;;	n,mK	Kill characters between n and m
-;;	nL	Advance n lines
-;;	Mq	Execute string in q-reg
-;;	O	Goto label
-;;	nO	Go to n-th label in list (0-origin)
-;;	Qq	Number in q-reg
-;;	nQq	Ascii value of n-th character in q-reg
-;;	:Qq	Size of text in q-reg
-;;	nR	Back up n characters
-;;	nS	Search
-;;	nT	Type n lines
-;;	n,mT	Type chars from n to m
-;;	nUq	Put number n into q-reg
-;;	nV	Type n lines around pointer
-;;	nXq	Put n lines into q-reg
-;;	n,mXq	Put characters from n to m into q-reg
-;;	n:Xq	Append n lines to q-reg q
-;;	n,m:Xq	Append characters from n to m into q-reg
-;;	Z 	Pointer position at end of buffer
-;;	[q	Put q-reg on stack
-;;	\	Value of digit string in buffer
-;;	n\	Convert n to digits and insert in buffer
-;;	]q	Pop q-reg from stack
-;;	:]q	Test whether stack is empty and return value
-;;	`	Not a Teco command
-;;	a-z	Treated the same as A-Z
-;;	{	Not a Teco command
-;;	|	Conditional 'else'
-;;	}	Not a Teco command
-;;	~	Not a Teco command
-;;	DEL	Delete last character typed in
-
-
-;;; Code:
-(require 'backquote)
-
-;; set a range of elements of an array to a value
-(defun teco-set-elements (array start end value)
-  (let ((i start))
-    (while (<= i end)
-      (aset array i value)
-      (setq i (1+ i)))))
-
-;; set a range of elements of an array to their indexes plus an offset
-(defun teco-set-elements-index (array start end offset)
-  (let ((i start))
-    (while (<= i end)
-      (aset array i (+ i offset))
-      (setq i (1+ i)))))
-
-(defvar teco-command-string ""
-  "The current command string being executed.")
-
-(defvar teco-command-pointer nil
-  "Pointer into teco-command-string showing next character to be executed.")
-
-(defvar teco-ctrl-r 10
-  "Current number radix.")
-
-(defvar teco-digit-switch nil
-  "Set if we have just executed a digit.")
-
-(defvar teco-exp-exp nil
-  "Expression value preceding operator.")
-
-(defvar teco-exp-val1 nil
-  "Current argument value.")
-
-(defvar teco-exp-val2 nil
-  "Argument before comma.")
-
-(defvar teco-exp-flag1 nil
-  "t if argument is present.")
-
-(defvar teco-exp-flag2 nil
-  "t if argument before comma is present.")
-
-(defvar teco-exp-op nil
-  "Pending arithmetic operation on argument.")
-
-(defvar teco-exp-stack nil
-  "Stack for parenthesized expressions.")
-
-(defvar teco-macro-stack nil
-  "Stack for macro invocations.")
-
-(defvar teco-mapch-l nil
-  "Translation table to lower-case letters.")
-
-    (setq teco-mapch-l (make-vector 256 0))
-    (teco-set-elements-index teco-mapch-l 0 255 0)
-    (teco-set-elements-index teco-mapch-l ?A ?Z (- ?a ?A))
-
-(defvar teco-trace nil
-  "t if tracing is on.")
-
-(defvar teco-at-flag nil
-  "t if an @ flag is pending.")
-
-(defvar teco-colon-flag nil
-  "1 if a : flag is pending, 2 if a :: flag is pending.")
-
-(defvar teco-qspec-valid nil
-  "Flags describing whether a character is a vaid q-register name.
-3 means yes, 2 means yes but only for file and search operations.")
-
-    (setq teco-qspec-valid (make-vector 256 0))
-    (teco-set-elements teco-qspec-valid ?a ?z 3)
-    (teco-set-elements teco-qspec-valid ?0 ?9 3)
-    (aset teco-qspec-valid ?_ 2)
-    (aset teco-qspec-valid ?* 2)
-    (aset teco-qspec-valid ?% 2)
-    (aset teco-qspec-valid ?# 2)
-
-(defvar teco-exec-flags 0
-  "Flags for iteration in process, ei macro, etc.")
-
-(defvar teco-iteration-stack nil
-  "Iteration list.")
-
-(defvar teco-cond-stack nil
-  "Conditional stack.")
-
-(defvar teco-qreg-text (make-vector 256 "")
-  "The text contents of the q-registers.")
-
-(defvar teco-qreg-number (make-vector 256 0)
-  "The number contents of the q-registers.")
-
-(defvar teco-qreg-stack nil
-  "The stack of saved q-registers.")
-
-(defconst teco-prompt "*"
-  "*Prompt to be used when inputting Teco command.")
-
-(defconst teco-exec-1 (make-vector 256 nil)
-  "Names of routines handling type 1 characters (characters that are
-part of expression processing).")
-
-(defconst teco-exec-2 (make-vector 256 nil)
-  "Names of routines handling type 2 characters (characters that are
-not part of expression processing).")
-
-(defvar teco-last-search-string ""
-  "Last string searched for.")
-
-(defvar teco-last-search-regexp ""
-  "Regexp version of teco-last-search-string.")
-
-(defmacro teco-define-type-1 (char &rest body)
-  "Define the code to process a type 1 character.
-Transforms
-	(teco-define-type-1 ?x
-	  code ...)
-into
-        (defun teco-type-1-x ()
-	  code ...)
-and does
-	(aset teco-exec-1 ?x 'teco-type-1-x)"
-  (let ((s (intern (concat "teco-type-1-" (char-to-string char)))))
-    (` (progn
-	 (defun (, s) ()
-	   (,@ body))
-	 (aset teco-exec-1 (, char) '(, s))))))
-
-(defmacro teco-define-type-2 (char &rest body)
-  "Define the code to process a type 2 character.
-Transforms
-	(teco-define-type-2 ?x
-	  code ...)
-into
-        (defun teco-type-2-x ()
-	  code ...)
-and does
-	(aset teco-exec-2 ?x 'teco-type-2-x)"
-  (let ((s (intern (concat "teco-type-2-" (char-to-string char)))))
-    (` (progn
-	 (defun (, s) ()
-	   (,@ body))
-	 (aset teco-exec-2 (, char) '(, s))))))
-
-(defconst teco-char-types (make-vector 256 0)
-  "Define the characteristics of characters, as tested by \":
-	1	alphabetic
-	2	alphabetic, $, or .
-	4	digit
-	8	alphabetic or digit
-	16	lower-case alphabetic
-	32	upper-case alphabetic")
-
-    (teco-set-elements teco-char-types ?0 ?9 (+ 4 8))
-    (teco-set-elements teco-char-types ?A ?Z (+ 1 2 8 32))
-    (teco-set-elements teco-char-types ?a ?z (+ 1 2 8 16))
-    (aset teco-char-types ?$ 2)
-    (aset teco-char-types ?. 2)
-
-(defconst teco-error-texts '(("BNI" . "> not in iteration")
-			     ("CPQ" . "Can't pop Q register")
-			     ("COF" . "Can't open output file ")
-			     ("FNF" . "File not found ")
-			     ("IEC" . "Invalid E character")
-			     ("IFC" . "Invalid F character")
-			     ("IIA" . "Invalid insert arg")
-			     ("ILL" . "Invalid command")
-			     ("ILN" . "Invalid number")
-			     ("IPA" . "Invalid P arg")
-			     ("IQC" . "Invalid \" character")
-			     ("IQN" . "Invalid Q-reg name")
-			     ("IRA" . "Invalid radix arg")
-			     ("ISA" . "Invalid search arg")
-			     ("ISS" . "Invalid search string")
-			     ("IUC" . "Invalid ^ character")
-			     ("LNF" . "Label not found")
-			     ("MEM" . "Insufficient memory available")
-			     ("MRP" . "Missing )")
-			     ("NAB" . "No arg before ^_")
-			     ("NAC" . "No arg before ,")
-			     ("NAE" . "No arg before =")
-			     ("NAP" . "No arg before )")
-			     ("NAQ" . "No arg before \"")
-			     ("NAS" . "No arg before ;")
-			     ("NAU" . "No arg before U")
-			     ("NFI" . "No file for input")
-			     ("NFO" . "No file for output")
-			     ("NYA" . "Numeric arg with Y")
-			     ("OFO" . "Output file already open")
-			     ("PDO" . "Pushdown list overflow")
-			     ("POP" . "Pointer off page")
-			     ("SNI" . "; not in iteration")
-			     ("SRH" . "Search failure ")
-			     ("STL" . "String too long")
-			     ("UTC" . "Unterminated command")
-			     ("UTM" . "Unterminated macro")
-			     ("XAB" . "Execution interrupted")
-			     ("YCA" . "Y command suppressed")
-			     ("IWA" . "Invalid W arg")
-			     ("NFR" . "Numeric arg with FR")
-			     ("INT" . "Internal error")
-			     ("EFI" . "EOF read from std input")
-			     ("IAA" . "Invalid A arg")
-			     ))
-
-(defconst teco-spec-chars 
-  [
-   0          1          0          0	; ^@ ^A ^B ^C
-   0          64         0          0	; ^D ^E ^F ^G
-   0          2          128        128	; ^H ^I ^J ^K
-   128        0          64         0	; ^L ^M ^N ^O
-   0          64         64         64	; ^P ^Q ^R ^S
-   0          34         0          0	; ^T ^U ^V ^W
-   64         0          0          0	; ^X ^Y ^Z ^\[
-   0          0          1          0	; ^\ ^\] ^^ ^_
-   0          1          16         0	;    !  \"  # 
-   0          0          0          16	; $  %  &  ' 
-   0          0          0          0	; \(  \)  *  + 
-   0          0          0          0	; ,  -  .  / 
-   0          0          0          0	; 0  1  2  3 
-   0          0          0          0	; 4  5  6  7 
-   0          0          0          0	; 8  9  :  ; 
-   16         0          16         0	; <  =  >  ? 
-   1          0          12         0	; @  A  B  C 
-   0          1          1          32	; D  E  F  G 
-   0          6          0          0	; H  I  J  K 
-   0          32         10         2	; L  M  N  O 
-   0          32         4          10	; P  Q  R  S 
-   0          32         0          4	; T  U  V  W 
-   32         0          0          32	; X  Y  Z  \[ 
-   0          32         1          6	; \  \]  ^  _ 
-   0          0          12         0	; `  a  b  c 
-   0          1          1          32	; d  e  f  g 
-   0          6          0          0	; h  i  j  k 
-   0          32         10         2	; l  m  n  o 
-   0          32         4          10	; p  q  r  s 
-   0          32         0          4	; t  u  v  w 
-   32         0          0          0	; x  y  z  { 
-   16         0          0          0	; |  }  ~  DEL
-   ]
-  "The special properties of characters:
-	1	skipto() special character
-	2	command with std text argument
-	4	E takes a text argument
-	8	F takes a text argument
-	16	char causes skipto() to exit
-	32	command with q-register argument
-	64	special char in search string
-	128	character is a line separator")
-
-
-(defun teco-execute-command (string)
-  "Execute teco command string."
-  ;; Initialize everything
-  (let ((teco-command-string string)
-	(teco-command-pointer 0)
-	(teco-digit-switch nil)
-	(teco-exp-exp nil)
-	(teco-exp-val1 nil)
-	(teco-exp-val2 nil)
-	(teco-exp-flag1 nil)
-	(teco-exp-flag2 nil)
-	(teco-exp-op 'start)
-	(teco-trace nil)
-	(teco-at-flag nil)
-	(teco-colon-flag nil)
-	(teco-exec-flags 0)
-	(teco-iteration-stack nil)
-	(teco-cond-stack nil)
-	(teco-exp-stack nil)
-	(teco-macro-stack nil)
-	(teco-qreg-stack nil))
-    ;; initialize output
-    (teco-out-init)
-    ;; execute commands
-    (catch 'teco-exit
-      (while t
-	;; get next command character
-	(let ((cmdc (teco-get-command0 teco-trace)))
-	  ;; if it's ^, interpret the next character as a control character
-	  (if (eq cmdc ?^)
-	      (setq cmdc (logand (teco-get-command teco-trace) 31)))
-	  (if (and (<= ?0 cmdc) (<= cmdc ?9))
-	      ;; process a number
-	      (progn
-		(setq cmdc (- cmdc ?0))
-		;; check for invalid digit
-		(if (>= cmdc teco-ctrl-r)
-		    (teco-error "ILN"))
-		(if teco-digit-switch
-		    ;; later digits
-		    (setq teco-exp-val1 (+ (* teco-exp-val1 teco-ctrl-r) cmdc))
-		  ;; first digit
-		  (setq teco-exp-val1 cmdc)
-		  (setq teco-digit-switch t))
-		;; indicate a value was read in
-		(setq teco-exp-flag1 t))
-	    ;; not a digit
-	    (setq teco-digit-switch nil)
-	    ;; cannonicalize the case
-	    (setq cmdc (aref teco-mapch-l cmdc))
-	    ;; dispatch on the character, if it is a type 1 character
-	    (let ((r (aref teco-exec-1 cmdc)))
-	      (if r
-		  (funcall r)
-		;; if a value has been entered, process any pending operation
-		(if teco-exp-flag1
-		    (cond ((eq teco-exp-op 'start)
-			   nil)
-			  ((eq teco-exp-op 'add)
-			   (setq teco-exp-val1 (+ teco-exp-exp teco-exp-val1))
-			   (setq teco-exp-op 'start))
-			  ((eq teco-exp-op 'sub)
-			   (setq teco-exp-val1 (- teco-exp-exp teco-exp-val1))
-			   (setq teco-exp-op 'start))
-			  ((eq teco-exp-op 'mult)
-			   (setq teco-exp-val1 (* teco-exp-exp teco-exp-val1))
-			   (setq teco-exp-op 'start))
-			  ((eq teco-exp-op 'div)
-			   (setq teco-exp-val1
-				 (if (/= teco-exp-val1 0)
-				     (/ teco-exp-exp teco-exp-val1)
-				   0))
-			   (setq teco-exp-op 'start))
-			  ((eq teco-exp-op 'and)
-			   (setq teco-exp-val1
-				 (logand teco-exp-exp teco-exp-val1))
-			   (setq teco-exp-op 'start))
-			  ((eq teco-exp-op 'or)
-			   (setq teco-exp-val1
-				 (logior teco-exp-exp teco-exp-val1))
-			   (setq teco-exp-op 'start))))
-		;; dispatch on a type 2 character
-		(let ((r (aref teco-exec-2 cmdc)))
-		  (if r
-		      (funcall r)
-		    (teco-error "ILL")))))))))))
-
-;; Type 1 commands
-
-(teco-define-type-1
- ?\m					; CR
- nil)
-
-(teco-define-type-1
- ?\n					; LF
- nil)
-
-(teco-define-type-1
- ?\^k					; VT
- nil)
-
-(teco-define-type-1
- ?\^l					; FF
- nil)
-
-(teco-define-type-1
- 32					; SPC
- nil)
-
-(teco-define-type-1
- ?\e					; ESC
- (if (teco-peek-command ?\e)
-     ;; ESC ESC terminates macro or command
-     (teco-pop-macro-stack)
-   ;; otherwise, consume argument
-   (setq teco-exp-flag1 nil)
-   (setq teco-exp-op 'start)))
-
-(teco-define-type-1
- ?!					; !
- (while (/= (teco-get-command teco-trace) ?!)
-   nil))
-
-(teco-define-type-1
- ?@					; @
- ;; set at-flag
- (setq teco-at-flag t))
-
-(teco-define-type-1
- ?:					; :
- ;; is it '::'?
- (if (teco-peek-command ?:)
-     (progn
-       ;; skip second colon
-       (teco-get-command teco-trace)
-       ;; set flag to show two colons
-       (setq teco-colon-flag 2))
-   ;; set flag to show one colon
-   (setq teco-colon-flag 1)))
-
-(teco-define-type-1
- ??					; ?
- ;; toggle trace
- (setq teco-trace (not teco-trace)))
-
-(teco-define-type-1
- ?.					; .
- ;; value is point
- (setq teco-exp-val1 (point)
-       teco-exp-flag1 t))
-
-(teco-define-type-1
- ?z					; z
- ;; value is point-max
- (setq teco-exp-val1 (point-max)
-       teco-exp-flag1 t))
-
-(teco-define-type-1
- ?b					; b
- ;; value is point-min
- (setq teco-exp-val1 (point-min)
-       teco-exp-flag1 t))
-
-(teco-define-type-1
- ?h					; h
- ;; value is b,z
- (setq teco-exp-val1 (point-max)
-       teco-exp-val2 (point-min)
-       teco-exp-flag1 t
-       teco-exp-flag2 t
-       teco-exp-op 'start))
-
-(teco-define-type-1
- ?\^s					; ^s
- ;; value is - length of last insert, etc.
- (setq teco-exp-val1 teco-ctrl-s
-       teco-exp-flag1 t))
-
-(teco-define-type-1
- ?\^y					; ^y
- ;; value is .+^S,.
- (setq teco-exp-val1 (+ (point) teco-ctrl-s)
-       teco-exp-val2 (point)
-       teco-exp-flag1 t
-       teco-exp-flag2 t
-       teco-exp-op 'start))
-
-(teco-define-type-1
- ?\(					; \(
- ;; push expression stack
- (teco-push-exp-stack)
- (setq teco-exp-flag1 nil
-       teco-exp-flag2 nil
-       teco-exp-op 'start))
-
-(teco-define-type-1
- ?\^p					; ^p
- (teco-do-ctrl-p))
-
-(teco-define-type-1
- ?\C-^					; ^^
- ;; get next command character
- (setq teco-exp-val1 (teco-get-command teco-trace)
-       teco-exp-flag1 t))
-
-
-;; Type 2 commands
-(teco-define-type-2
- ?+					; +
- (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
-       teco-exp-flag1 nil
-       teco-exp-op 'add))
-
-(teco-define-type-2
- ?-					; -
- (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
-       teco-exp-flag1 nil
-       teco-exp-op 'sub))
-
-(teco-define-type-2
- ?*					; *
- (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
-       teco-exp-flag1 nil
-       teco-exp-op 'mult))
-
-(teco-define-type-2
- ?/					; /
- (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
-       teco-exp-flag1 nil
-       teco-exp-op 'div))
-
-(teco-define-type-2
- ?&					; &
- (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
-       teco-exp-flag1 nil
-       teco-exp-op 'and))
-
-(teco-define-type-2
- ?#					; #
- (setq teco-exp-exp (if teco-exp-flag1 teco-exp-val1 0)
-       teco-exp-flag1 nil
-       teco-exp-op 'or))
-
-(teco-define-type-2
- ?\)					; \)
- (if (or (not teco-exp-flag1) (not teco-exp-stack))
-     (teco-error "NAP"))
- (let ((v teco-exp-val1))
-   (teco-pop-exp-stack)
-   (setq teco-exp-val1 v
-	 teco-exp-flag1 t)))
-
-(teco-define-type-2
- ?,					; ,
- (if (not teco-exp-flag1)
-     (teco-error "NAC"))
- (setq teco-exp-val2 teco-exp-val1
-       teco-exp-flag2 t
-       teco-exp-flag1 nil))
-
-(teco-define-type-2
- ?\^_					; ^_
- (if (not teco-exp-flag1)
-     (teco-error "NAB")
-   (setq teco-exp-val1 (lognot teco-exp-val1))))
-
-(teco-define-type-2
- ?\^d					; ^d
- (setq teco-ctrl-r 10
-       teco-exp-flag1 nil
-       teco-exp-op 'start))
-
-(teco-define-type-2
- ?\^o					; ^o
- (setq teco-ctrl-r 8
-       teco-exp-flag1 nil
-       teco-exp-op 'start))
-
-(teco-define-type-2
- ?\^r					; ^r
- (if teco-colon-flag
-     (progn
-       (recursive-edit)
-       (setq teco-colon-flag nil))
-   (if teco-exp-flag1
-       ;; set radix
-       (progn
-	 (if (and (/= teco-exp-val1 8)
-		  (/= teco-exp-val1 10)
-		  (/= teco-exp-val1 16))
-	     (teco-error "IRA"))
-	 (setq teco-ctrl-r teco-exp-val1
-	       teco-exp-flag1 nil
-	       teco-exp-op 'start))
-     ;; get radix
-     (setq teco-exp-val1 teco-ctrl-r
-	   teco-exp-flag1 t))))
-
-(teco-define-type-2
- ?\^c					; ^c
- (if (teco-peek-command ?\^c)
-     ;; ^C^C stops execution
-     (throw 'teco-exit nil)
-   (if teco-macro-stack
-       ;; ^C inside macro exits macro
-       (teco-pop-macro-stack)
-     ;; ^C in command stops execution
-     (throw 'teco-exit nil))))
-
-(teco-define-type-2
- ?\^x					; ^x
- ;; set/get search mode flag
- (teco-set-var 'teco-ctrl-x))
-
-(teco-define-type-2
- ?m					; m
- (let ((macro-name (teco-get-qspec nil
-				   (teco-get-command teco-trace))))
-   (teco-push-macro-stack)
-   (setq teco-command-string (aref teco-qreg-text macro-name)
-	 teco-command-pointer 0)))
-
-(teco-define-type-2
- ?<					; <
- ;; begin iteration
- (if (and teco-exp-flag1 (<= teco-exp-val1 0))
-     ;; if this is not to be executed, just skip the
-     ;; intervening stuff
-     (teco-find-enditer)
-   ;; push iteration stack
-   (teco-push-iter-stack teco-command-pointer
-			 teco-exp-flag1 teco-exp-val1)
-   ;; consume the argument
-   (setq teco-exp-flag1 nil)))
-
-(teco-define-type-2
- ?>					; >
- ;; end iteration
- (if (not teco-iteration-stack)
-     (teco-error "BNI"))
- ;; decrement count and pop conditionally
- (teco-pop-iter-stack nil)
- ;; consume arguments
- (setq teco-exp-flag1 nil
-       teco-exp-flag2 nil
-       teco-exp-op 'start))
-
-(teco-define-type-2
- 59					; ;
- ;; semicolon iteration exit
- (if (not teco-iteration-stack)
-     (teco-error "SNI"))
- ;; if exit
- (if (if (>= (if teco-exp-flag1
-		 teco-exp-val1
-	       teco-search-result) 0)
-	 (not teco-colon-flag)
-       teco-colon-flag)
-     (progn
-       (teco-find-enditer)
-       (teco-pop-iter-stack t)))
- ;; consume argument and colon
- (setq teco-exp-flag1 nil
-       teco-colon-flag nil
-       teco-exp-op 'start))
-
-(teco-define-type-2
- ?\"					; \"
- ;; must be an argument
- (if (not teco-exp-flag1)
-     (teco-error "NAQ"))
- ;; consume argument
- (setq teco-exp-flag1 nil
-       teco-exp-op 'start)
- (let* (;; get the test specification
-	(c (aref teco-mapch-l (teco-get-command teco-trace)))
-	;; determine whether the test is true
-	(test (cond ((eq c ?a)
-		     (/= (logand (aref teco-char-types teco-exp-val1)
-				 1) 0))
-		    ((eq c ?c)
-		     (/= (logand (aref teco-char-types teco-exp-val1)
-				 2) 0))
-		    ((eq c ?d)
-		     (/= (logand (aref teco-char-types teco-exp-val1)
-				 4) 0))
-		    ((or (eq c ?e) (eq c ?f) (eq c ?u) (eq c ?=))
-		     (= teco-exp-val1 0))
-		    ((or (eq c ?g) (eq c ?>))
-		     (> teco-exp-val1 0))
-		    ((or (eq c ?l) (eq c ?s) (eq c ?t) (eq c ?<))
-		     (< teco-exp-val1 0))
-		    ((eq c ?n)
-		     (/= teco-exp-val1 0))
-		    ((eq c ?r)
-		     (/= (logand (aref teco-char-types teco-exp-val1)
-				 8) 0))
-		    ((eq c ?v)
-		     (/= (logand (aref teco-char-types teco-exp-val1)
-				 16) 0))
-		    ((eq c ?w)
-		     (/= (logand (aref teco-char-types teco-exp-val1)
-				 32) 0))
-		    (t
-		     (teco-error "IQC")))))
-   (if (not test)
-       ;; if the conditional isn't satisfied, read
-       ;; to matching | or '
-       (let ((ll 1)
-	     c)
-	 (while (> ll 0)
-	   (while (progn (setq c (teco-skipto))
-			 (and (/= c ?\")
-			      (/= c ?|)
-			      (/= c ?\')))
-	     (if (= c ?\")
-		 (setq ll (1+ ll))
-	       (if (= c ?\')
-		   (setq ll (1- ll))
-		 (if (= ll 1)
-		     (break))))))))))
-
-(teco-define-type-2
- ?'					; '
- ;; ignore it if executing
- t)
-
-(teco-define-type-2
- ?|					; |
- (let ((ll 1)
-       c)
-   (while (> ll 0)
-     (while (progn (setq c (teco-skipto))
-		   (and (/= c ?\")
-			(/= c ?\')))
-       nil)
-     (if (= c ?\")
-	 (setq ll (1+ ll))
-       (setq ll (1- ll))))))
-
-(teco-define-type-2
- ?u					; u
- (if (not teco-exp-flag1)
-     (teco-error "NAU"))
- (aset teco-qreg-number
-       (teco-get-qspec 0 (teco-get-command teco-trace))
-       teco-exp-val1)
- (setq teco-exp-flag1 teco-exp-flag2	; command's value is second arg
-       teco-exp-val1 teco-exp-val2
-       teco-exp-flag2 nil
-       teco-exp-op 'start))
-
-(teco-define-type-2
- ?q					; q
- ;; Qn is numeric val, :Qn is # of chars, mQn is mth char
- (let ((mm (teco-get-qspec (or teco-colon-flag teco-exp-flag1)
-			   (teco-get-command teco-trace))))
-   (if (not teco-exp-flag1)
-       (setq teco-exp-val1 (if teco-colon-flag
-			       ;; :Qn
-			       (length (aref teco-qreg-text mm))
-			     ;; Qn
-			     (aref teco-qreg-number mm))
-	     teco-exp-flag1 t)
-     ;; mQn
-     (let ((v (aref teco-qreg-text mm)))
-       (setq teco-exp-val1 (condition-case nil
-			       (aref v teco-exp-val1)
-			     (error -1))
-	     teco-exp-op 'start)))
-   (setq teco-colon-flag nil)))
-
-(teco-define-type-2
- ?%					; %
- (let* ((mm (teco-get-qspec nil (teco-get-command teco-trace)))
-	(v (+ (aref teco-qreg-number mm) (teco-get-value 1))))
-   (aset teco-qreg-number mm v)
-   (setq teco-exp-val1 v
-	 teco-exp-flag1 t)))
-
-(teco-define-type-2
- ?c					; c
- (let ((p (+ (point) (teco-get-value 1))))
-   (if (or (< p (point-min)) (> p (point-max)))
-       (teco-error "POP")
-     (goto-char p)
-     (setq teco-exp-flag2 nil))))
-
-(teco-define-type-2
- ?r					; r
- (let ((p (- (point) (teco-get-value 1))))
-   (if (or (< p (point-min)) (> p (point-max)))
-       (teco-error "POP")
-     (goto-char p)
-     (setq teco-exp-flag2 nil))))
-
-(teco-define-type-2
- ?j					; j
- (let ((p (teco-get-value (point-min))))
-   (if (or (< p (point-min)) (> p (point-max)))
-       (teco-error "POP")
-     (goto-char p)
-     (setq teco-exp-flag2 nil))))
-
-(teco-define-type-2
- ?l					; l
- ;; move forward by lines
- (forward-char (teco-lines (teco-get-value 1))))
-
-(teco-define-type-2
- ?\C-q					; ^q
- ;; number of characters until the nth line feed
- (setq teco-exp-val1 (teco-lines (teco-get-value 1))
-       teco-exp-flag1 t))
-
-(teco-define-type-2
- ?=					; =
- ;; print numeric value
- (if (not teco-exp-flag1)
-     (teco-error "NAE"))
- (teco-output (format
-	       (if (teco-peek-command ?=)
-		   ;; at least one more =
-		   (progn
-		     ;; read past it
-		     (teco-get-command teco-trace)
-		     (if (teco-peek-command ?=)
-			 ;; another?
-			 (progn
-			   ;; read it too
-			   (teco-get-command teco-trace)
-			   ;; print in hex
-			   "%x")
-		       ;; print in octal
-		       "%o"))
-		 ;; print in decimal
-		 "%d")
-	       teco-exp-val1))
- ;; add newline if no colon
- (if (not teco-colon-flag)
-     (teco-output ?\n))
- ;; absorb argument, etc.
- (setq teco-exp-flag1 nil
-       teco-exp-flag2 nil
-       teco-colon-flag nil
-       teco-exp-op 'start))
-
-(teco-define-type-2
- ?\t					; TAB
- (if exp-flag1
-     (teco-error "IIA"))
- (let ((text (teco-get-text-arg)))
-   (insert ?\t text)
-   (setq teco-ctrl-s (1+ (length text))))
- ;; clear arguments
- (setq teco-colon-flag nil
-       teco-exp-flag1 nil
-       teco-exp-flag2 nil))
-
-(teco-define-type-2
- ?i					; i
- (let ((text (teco-get-text-arg)))
-   (if teco-exp-flag1
-       ;; if a nI$ command
-       (progn
-	 ;; text argument must be null
-	 (or (string-equal text "") (teco-error "IIA"))
-	 ;; insert the character
-	 (insert teco-exp-val1)
-	 (setq teco-ctrl-s 1)
-	 ;; consume argument
-	 (setq teco-exp-op 'start))
-     ;; otherwise, insert the text
-     (insert text)
-     (setq teco-ctrl-s (length text)))
-   ;; clear arguments
-   (setq teco-colon-flag nil
-	 teco-exp-flag1 nil
-	 teco-exp-flag2 nil)))
-
-(teco-define-type-2
- ?t					; t
- (let ((args (teco-line-args nil)))
-   (teco-output (buffer-substring (car args) (cdr args)))))
-
-(teco-define-type-2
- ?v					; v
- (let ((ll (teco-get-value 1)))
-   (teco-output (buffer-substring (+ (point) (teco-lines (- 1 ll)))
-				  (+ (point) (teco-lines ll))))))
-
-(teco-define-type-2
- ?\C-a					; ^a
- (teco-output (teco-get-text-arg nil ?\C-a))
- (setq teco-at-flag nil
-       teco-colon-flag nil
-       teco-exp-flag1 nil
-       teco-exp-flag2 nil
-       teco-exp-op 'start))
-
-(teco-define-type-2
- ?d					; d
- (if (not teco-exp-flag2)
-     ;; if only one argument
-     (delete-char (teco-get-value 1))
-   ;; if two arguments, treat as n,mK
-   (let ((ll (teco-line-args 1)))
-     (delete-region (car ll) (cdr ll)))))
-
-(teco-define-type-2
- ?k					; k
- (let ((ll (teco-line-args 1)))
-   (delete-region (car ll) (cdr ll))))
-
-(teco-define-type-2
- ?\C-u					; ^u
- (let* ((mm (teco-get-qspec nil (teco-get-command teco-trace)))
-	(text-arg (teco-get-text-arg))
-	(text (if (not teco-exp-flag1)
-		  text-arg
-		(if (string-equal text-arg "")
-		    (char-to-string teco-exp-val1)
-		  (teco-error "IIA")))))
-   ;; if :, append to the register
-   (aset teco-qreg-text mm (if teco-colon-flag
-			       (concat (aref teco-qreg-text mm) text)
-			     text))
-   ;; clear various flags
-   (setq teco-exp-flag1 nil
-	 teco-at-flag nil
-	 teco-colon-flag nil
-	 teco-exp-flag1 nil)))
-
-(teco-define-type-2
- ?x					; x
- (let* ((mm (teco-get-qspec nil (teco-get-command teco-trace)))
-	(args (teco-line-args 0))
-	(text (buffer-substring (car args) (cdr args))))
-   ;; if :, append to the register
-   (aset teco-qreg-text mm (if teco-colon-flag
-			       (concat (aref teco-qreg-text mm) text)
-			     text))
-   ;; clear various flags
-   (setq teco-exp-flag1 nil
-	 teco-at-flag nil
-	 teco-colon-flag nil
-	 teco-exp-flag1 nil)))
-
-(teco-define-type-2
- ?g					; g
- (let ((mm (teco-get-qspec t (teco-get-command teco-trace))))
-   (if teco-colon-flag
-       (teco-output (aref teco-qreg-text mm))
-     (insert (aref teco-qreg-text mm)))
-   (setq teco-colon-flag nil)))
-
-(teco-define-type-2
- ?\[					; \[
- (let ((mm (teco-get-qspec t (teco-get-command teco-trace))))
-   (setq teco-qreg-stack
-	 (cons (cons (aref teco-qreg-text mm)
-		     (aref teco-qreg-number mm))
-	       teco-qreg-stack))))
-
-(teco-define-type-2
- ?\]					; \]
- (let ((mm (teco-get-qspec t (teco-get-command teco-trace))))
-   (if teco-colon-flag
-       (setq teco-exp-flag1 t
-	     teco-exp-val1 (if teco-qreg-stack -1 0))
-     (if teco-qreg-stack
-	 (let ((pop (car teco-qreg-stack)))
-	   (aset teco-qreg-text mm (car pop))
-	   (aset teco-qreg-number mm (cdr pop))
-	   (setq teco-qreg-stack (cdr teco-qreg-stack)))
-       (teco-error "CPQ")))
-   (setq teco-colon-flag nil)))
-
-(teco-define-type-2
- ?\\					; \
- (if (not teco-exp-flag1)
-     ;; no argument; read number
-     (let ((p (point))
-	   (sign +1)
-	   (n 0)
-	   c)
-       (setq c (char-after p))
-       (if c
-	   (if (= c ?+)
-	       (setq p (1+ p))
-	     (if (= c ?-)
-		 (setq p (1+ p)
-		       sign -1))))
-       (cond
-	((= teco-ctrl-r 8) 
-	 (while (progn
-		  (setq c (char-after p))
-		  (and c (>= c ?0) (<= c ?7)))
-	   (setq p (1+ p)
-		 n (+ c -48 (* n 8)))))
-	((= teco-ctrl-r 10) 
-	 (while (progn
-		  (setq c (char-after p))
-		  (and c (>= c ?0) (<= c ?9)))
-	   (setq p (1+ p)
-		 n (+ c -48 (* n 10)))))
-	(t
-	 (while (progn
-		  (setq c (char-after p))
-		  (and c
-		       (or
-			(and (>= c ?0) (<= c ?9))
-			(and (>= c ?a) (<= c ?f))
-			(and (>= c ?A) (<= c ?F)))))
-	   (setq p (1+ p)
-		 n (+ c (if (> c ?F)
-			    ;; convert 'a' to 10
-			    -87 
-			  (if (> c ?9)
-			      ;; convert 'A' to 10
-			      -55
-			    ;; convert '0' to 0
-			    -48))
-		      (* n 16))))))
-       (setq teco-exp-val1 (* n sign)
-	     teco-exp-flag1 t
-	     teco-ctrl-s (- (point) p)))
-   ;; argument: insert it as a digit string
-   (insert (format (cond 
-		    ((= teco-ctrl-r 8) "%o")
-		    ((= teco-ctrl-r 10) "%d")
-		    (t "%x"))
-		   teco-exp-val1))
-   (setq teco-exp-flag1 nil
-	 teco-exp-op 'start)))
-
-(teco-define-type-2
- ?\C-t					; ^t
- (if teco-exp-flag1
-     ;; type a character
-     (progn
-       (teco-output teco-exp-val1)
-       (setq teco-exp-flag1 nil))
-   ;; input a character
-   (let* ((echo-keystrokes 0)
-	  (c (read-char)))
-     (teco-output c)
-     (setq teco-exp-val1 c
-	   teco-exp-flag1 t))))
-
-(teco-define-type-2
- ?s					; s
- (let ((arg (teco-get-text-arg))
-       (count (if teco-exp-flag1 teco-expr-val1 1))
-       regexp)
-   (if (not (string-equal arg ""))
-       (setq regexp (teco-parse-search-string arg)
-	     teco-last-search-string arg
-	     teco-last-search-regexp regexp)
-     (setq regexp (teco-last-search-regexp)
-	   arg teco-last-search-string))
-   (let ((p (point))
-	 (result (cond
-		  ((> count 0)
-		   (re-search-forward regexp nil t count))
-		  ((< count 0)
-		   (re-search-backward regexp nil t count))
-		  (t
-		   ;; 0s always is successful
-		   t))))
-     ;; if ::s, restore point
-     (if (eq teco-colon-flag 2)
-	 (goto-char p))
-     ;; if no real or implied colon, error if not found
-     (if (and (not result)
-	      (not teco-colon-flag)
-	      (/= (teco-peekcmdc) 34))
-	 (teco-error "SRH"))
-     ;; set return results
-     (setq teco-exp-flag2 nil
-	   teco-colon-flag nil
-	   teco-at-flag nil
-	   teco-exp-op 'start)
-     (if teco-colon-flag
-	 (setq teco-exp-flag1 t
-	       teco-exp-val1 (if result -1 0))
-       (setq teco-exp-flag1 nil)))))
-
-(defun teco-parse-search-string (s)
-  (let ((i 0)
-	(l (length s))
-	(r "")
-	c)
-    (while (< i l)
-      (setq r (concat r (teco-parse-search-string-1))))
-    r))
-
-(defun teco-parse-search-string-1 ()
-  (if (>= i l)
-      (teco-error "ISS"))
-  (setq c (aref s i))
-  (setq i (1+ i))
-  (cond
-   ((eq c ?\C-e)			; ^E - special match characters
-    (teco-parse-search-string-e))
-   ((eq c ?\C-n)			; ^Nx - match all but x
-    (teco-parse-search-string-n))
-   ((eq c ?\C-q)			; ^Qx - use x literally
-    (teco-parse-search-string-q))
-   ((eq c ?\C-s)			; ^S - match separator chars
-    "[^A-Za-z0-9]")
-   ((eq c ?\C-x)			; ^X - match any character
-    "[\000-\377]")
-   (t					; ordinary character
-    (teco-parse-search-string-char c))))
-
-(defun teco-parse-search-string-char (c)
-  (regexp-quote (char-to-string c)))
-
-(defun teco-parse-search-string-q ()
-  (if (>= i l)
-      (teco-error "ISS"))
-  (setq c (aref s i))
-  (setq i (1+ i))
-  (teco-parse-search-string-char c))
-
-(defun teco-parse-search-string-e ()
-  (if (>= i l)
-      (teco-error "ISS"))
-  (setq c (aref s i))
-  (setq i (1+ i))
-  (cond
-   ((or (eq c ?a) (eq c ?A))		; ^EA - match alphabetics
-    "[A-Za-z]")
-   ((or (eq c ?c) (eq c ?C))		; ^EC - match symbol constituents
-    "[A-Za-z.$]")
-   ((or (eq c ?d) (eq c ?D))		; ^ED - match numerics
-    "[0-9]")
-   ((eq c ?g)				; ^EGq - match any char in q-reg
-    (teco-parse-search-string-e-g))
-   ((or (eq c ?l) (eq c ?L))		; ^EL - match line terminators
-    "[\012\013\014]")
-   ((eq c ?q)				; ^EQq - use contents of q-reg
-    (teco-parse-search-string-e-q))
-   ((eq c ?r)				; ^ER - match alphanumerics
-    "[A-Za-z0-9]")
-   ((eq c ?s)				; ^ES - match non-null space/tab seq
-    "[ \t]+")
-   ((eq c ?v)				; ^EV - match lower case alphabetic
-    "[a-z]")
-   ((eq c ?w)				; ^EW - match upper case alphabetic
-    "[A-Z]")
-   ((eq c ?x)				; ^EX - match any character
-    "[\000-\377]")
-   (t
-    (teco-error "ISS"))))
-
-(defun teco-parse-search-string-e-q ()
-  (if (>= i l)
-      (teco-error "ISS"))
-  (setq c (aref s i))
-  (setq i (1+ i))
-  (regexp-quote (aref reco:q-reg-text c)))
-
-(defun teco-parse-search-string-e-g ()
-  (if (>= i l)
-      (teco-error "ISS"))
-  (setq c (aref s i))
-  (setq i (1+ i))
-  (let* ((q (aref teco-qreg-text c))
-	 (len (length q))
-	 (null (= len 0))
-	 (one-char (= len 1))
-	 (dash-present (string-match "-" q))
-	 (caret-present (string-match "\\^" q))
-	 (outbracket-present (string-match "]" q))
-	 p)
-    (cond
-     (null
-      "[^\000-\377]")
-     (one-char
-      (teco-parse-search-string-char c))
-     (t
-      (while (setq p (string-match "^]\\^"))
-	(setq q (concat (substring q 1 p) (substring q (1+ p)))))
-      (concat
-       "["
-       (if outbracket-present "]" "")
-       (if dash-present "---" "")
-       q
-       (if caret-present "^" ""))))))
-
-(defun teco-parse-search-string-n ()
-  (let ((p (teco-parse-search-string-1)))
-    (cond
-     ((= (aref p 0) ?\[)
-      (if (= (aref p 1) ?^)
-	  ;; complement character set
-	  (if (= (length p) 4)
-	      ;; complement of one character
-	      (teco-parse-search-string-char (aref p 2))
-	    ;; complement of more than one character
-	    (concat "[" (substring p 2)))
-	;; character set - invert it
-      (concat "[^" (substring p 1))))
-     ((= (aref p 0) ?\\)
-      ;; single quoted character
-      (concat "[^" (substring p 1) "]"))
-     (t
-      ;; single character
-      (if (string-equal p "-")
-	  "[^---]"
-	(concat "[^" p "]"))))))
-
-(teco-define-type-2
- ?o					; o
- (let ((label (teco-get-text-arg))
-       (index (and teco-exp-flag1 teco-exp-val1)))
-   (setq teco-exp-flag1 nil)
-   ;; handle computed goto by extracting the proper label
-   (if index
-       (if (< index 0)
-	   ;; argument < 0 is a noop
-	   (setq label "")
-	 ;; otherwise, find the n-th label (0-origin)
-	 (setq label (concat label ","))
-	 (let ((p 0))
-	   (while (and (> index 0)
-		       (setq p (string-match "," label p))
-		       (setq p (1+ p)))
-	     (setq index (1- index)))
-	   (setq q (string-match "," label p))
-	   (setq label (substring label p q)))))
-   ;; if the label is non-null, find the correct label
-   ;; start from beginning of iteration or macro, and look for tag
-   (setq teco-command-pointer
-	 (if teco-iteration-stack
-	     ;; if in iteration, start at beginning of iteration
-	     (aref (car teco-iteration-stack) 0)
-	   ;; if not in iteration, start at beginning of command or macro
-	   0))
-   ;; search for tag
-   (catch 'label
-     (let ((level 0)
-	   c p l)
-       ;; look for interesting things, including !
-       (while t
-	 (setq c (teco-skipto t))
-	 (cond
-	  ((= c ?<)			; start of iteration
-	   (setq level (1+ level)))
-	  ((= c ?>)			; end of iteration
-	   (if (= level 0)
-	       (teco-pop-iter-stack t)
-	     (setq level (1- level))))
-	  ((= c ?!)			; start of tag
-	   (setq p (string-match "!" teco-command-string teco-command-pointer))
-	   (if (and p
-		    (string-equal label (substring teco-command-string
-						   teco-command-pointer
-						   p)))
-	       (progn
-		 (setq teco-command-pointer (1+ p))
-		 (throw 'label nil))))))))))
-
-(teco-define-type-2
- ?a					; :a
- ;; 'a' must be used as ':a'
- (if (and teco-exp-flag1 teco-colon-flag)
-     (let ((char (+ (point) teco-exp-val1)))
-       (setq teco-exp-val1
-	     (if (and (>= char (point-min))
-		      (< char (point-max)))
-		 (char-after char)
-	       -1)
-	     teco-colon-flag nil))
-   (teco-error "ILL")))
-
-
-;; Routines to get next character from command buffer
-;; getcmdc0, when reading beyond command string, pops
-;; macro stack and continues.
-;; getcmdc, in similar circumstances, reports an error.
-;; If pushcmdc() has returned any chars, read them first
-;; routines type characters as read, if argument != 0.
-
-(defun teco-get-command0 (trace)
-  ;; get the next character
-  (let (char)
-    (while (not (condition-case nil
-		    (setq char (aref teco-command-string teco-command-pointer))
-		  ;; if we've exhausted the string, pop the macro stack
-		  ;; if we exhaust the macro stack, exit
-		  (error (teco-pop-macro-stack)
-			 nil))))
-    ;; bump the command pointer
-    (setq teco-command-pointer (1+ teco-command-pointer))
-    ;; trace, if requested
-    (and trace (teco-trace-type char))
-    ;; return the character
-    char))
-
-;; 	while (cptr.dot >= cptr.z)		/* if at end of this level, pop macro stack
-;; 		{
-;; 		if (--msp < &mstack[0])		/* pop stack; if top level
-;; 			{
-;; 			msp = &mstack[0];		/* restore stack pointer
-;; 			cmdc = ESC;				/* return an ESC (ignored)
-;; 			exitflag = 1;			/* set to terminate execution
-;; 			return(cmdc);			/* exit "while" and return
-;; 			}
-;; 		}
-;; 	cmdc = cptr.p->ch[cptr.c++];		/* get char
-;; 	++cptr.dot;							/* increment character count
-;; 	if (trace) type_char(cmdc);			/* trace
-;; 	if (cptr.c > CELLSIZE-1)			/* and chain if need be
-;; 		{
-;; 		cptr.p = cptr.p->f;
-;; 		cptr.c = 0;
-;; 		}
-;; 	return(cmdc);
-;; 	}
-
-
-(defun teco-get-command (trace)
-  ;; get the next character
-  (let ((char (condition-case nil
-		  (aref teco-command-string teco-command-pointer)
-		;; if we've exhausted the string, give error
-		(error
-		 (teco-error (if teco-macro-stack "UTM" "UTC"))))))
-    ;; bump the command pointer
-    (setq teco-command-pointer (1+ teco-command-pointer))
-    ;; trace, if requested
-    (and trace (teco-trace-type char))
-    ;; return the character
-    char))
-
-;; char getcmdc(trace)
-;; 	{
-;; 	if (cptr.dot++ >= cptr.z) ERROR((msp <= &mstack[0]) ? E_UTC : E_UTM);
-;; 	else
-;; 		{
-;; 		cmdc = cptr.p->ch[cptr.c++];	/* get char
-;; 		if (trace) type_char(cmdc);		/* trace
-;; 		if (cptr.c > CELLSIZE-1)		/* and chain if need be
-;; 			{
-;; 			cptr.p = cptr.p->f;
-;; 			cptr.c = 0;
-;; 			}
-;; 		}
-;; 	return(cmdc);
-;; 	}
-
-
-;; peek at next char in command string, return 1 if it is equal
-;; (case independent) to argument
-
-(defun teco-peek-command (arg)
-  (condition-case nil
-      (eq (aref teco-mapch-l (aref teco-command-string teco-command-pointer))
-	  (aref teco-mapch-l arg))
-    (error nil)))
-
-;; int peekcmdc(arg)
-;; 	char arg;
-;; 	{
-;; 	return(((cptr.dot < cptr.z) && (mapch_l[cptr.p->ch[cptr.c]] == mapch_l[arg])) ? 1 : 0);
-;; 	}
-
-(defun teco-get-text-arg (&optional term-char default-term-char)
-  ;; figure out what the terminating character is
-  (setq teco-term-char (or term-char
-			   (if teco-at-flag
-			       (teco-get-command teco-trace)
-			     (or default-term-char
-				 ?\e)))
-	teco-at_flag nil)
-  (let ((s "")
-	c)
-    (while (progn
-	     (setq c (teco-get-command teco-trace))
-	     (/= c teco-term-char))
-      (setq s (concat s (char-to-string c))))
-    s))
-
-
-;; Routines to manipulate the stacks
-
-;; Pop the macro stack.  Throw to 'teco-exit' if the stack is empty.
-(defun teco-pop-macro-stack ()
-  (if teco-macro-stack
-      (let ((frame (car teco-macro-stack)))
-	(setq teco-macro-stack (cdr teco-macro-stack)
-	      teco-command-string (aref frame 0)
-	      teco-command-pointer (aref frame 1)
-	      teco-exec-flags (aref frame 2)
-	      teco-iteration-stack (aref frame 3)
-	      teco-cond-stack (aref frame 4)))
-    (throw 'teco-exit nil)))
-
-;; Push the macro stack.
-(defun teco-push-macro-stack ()
-  (setq teco-macro-stack
-	(cons (vector teco-command-string
-		      teco-command-pointer
-		      teco-exec-flags
-		      teco-iteration-stack
-		      teco-cond-stack)
-	      teco-macro-stack)))
-
-;; Pop the expression stack.
-(defun teco-pop-exp-stack ()
-  (let ((frame (car teco-exp-stack)))
-    (setq teco-exp-stack (cdr teco-exp-stack)
-	  teco-exp-val1 (aref frame 0)
-	  teco-exp-flag1 (aref frame 1)
-	  teco-exp-val2 (aref frame 2)
-	  teco-exp-flag2 (aref frame 3)
-	  teco-exp-exp (aref frame 4)
-	  teco-exp-op (aref frame 5))))
-
-;; Push the expression stack.
-(defun teco-push-exp-stack ()
-  (setq teco-exp-stack
-	(cons (vector teco-exp-val1
-		      teco-exp-flag1
-		      teco-exp-val2
-		      teco-exp-flag2
-		      teco-exp-exp
-		      teco-exp-op)
-	      teco-exp-stack)))
-
-;; Pop the iteration stack
-;; if arg t, exit unconditionally
-;; else check exit conditions and exit or reiterate
-(defun teco-pop-iter-stack (arg)
-  (let ((frame (car teco-iteration-stack)))
-    (if (or arg
-	    (not (aref frame 1))
-	    ;; test against 1, since one iteration has already been done
-	    (<= (aref frame 2) 1))
-	;; exit iteration
-	(setq teco-iteration-stack (cdr teco-iteration-stack))
-      ;; continue with iteration
-      ;; decrement count
-      (aset frame 2 (1- (aref frame 2)))
-      ;; reset command pointer
-      (setq teco-command-pointer (aref frame 0)))))
-
-;; Push the iteration stack
-(defun teco-push-iter-stack (pointer flag count)
-  (setq teco-iteration-stack
-	(cons (vector pointer
-		      flag
-		      count)
-	      teco-iteration-stack)))	      
-
-(defun teco-find-enditer ()
-  (let ((icnt 1)
-	c)
-    (while (> icnt 0)
-      (while (progn (setq c (teco-skipto))
-		    (and (/= c ?<)
-			 (/= c ?>)))
-	(if (= c ?<)
-	    (setq icnt (1+ icnt))
-	  (setq icnt (1- icnt)))))))
-
-
-;; I/O routines
-
-(defvar teco-output-buffer (get-buffer-create "*Teco Output*")
-  "The buffer into which Teco output is written.")
-
-(defun teco-out-init ()
-  ;; Recreate the teco output buffer, if necessary
-  (setq teco-output-buffer (get-buffer-create "*Teco Output*"))
-  (save-excursion
-    (set-buffer teco-output-buffer)
-    ;; get a fresh line in output buffer
-    (goto-char (point-max))
-    (insert ?\n)
-    ;; remember where to start displaying
-    (setq teco-output-start (point))
-    ;; clear minibuffer, in case we have to display in it
-    (save-window-excursion
-      (select-window (minibuffer-window))
-      (erase-buffer))
-    ;; if output is visible, position it correctly
-    (let ((w (get-buffer-window teco-output-buffer)))
-      (if w
-	  (progn
-	    (set-window-start w teco-output-start)
-	    (set-window-point w teco-output-start))))))
-
-(defun teco-output (s)
-  (let ((w (get-buffer-window teco-output-buffer))
-	(b (current-buffer))
-	(sw (selected-window)))
-    ;; Put the text in the output buffer
-    (set-buffer teco-output-buffer)
-    (goto-char (point-max))
-    (insert s)
-    (let ((p (point)))
-      (set-buffer b)
-      (if w
-	  ;; if output is visible, move the window point to the end
-	  (set-window-point w p)
-	;; Otherwise, we have to figure out how to display the text
-	;; Has a newline followed by another character been added to the
-	;; output buffer?  If so, we have to make the output buffer visible.
-	(if (save-excursion
-	      (set-buffer teco-output-buffer)
-	      (backward-char 1)
-	      (search-backward "\n" teco-output-start t))
-	    ;; a newline has been seen, clear the minibuffer and make the
-	    ;; output buffer visible
-	    (progn
-	      (save-window-excursion
-		(select-window (minibuffer-window))
-		(erase-buffer))
-	      (let ((pop-up-windows t))
-		(pop-to-buffer teco-output-buffer)
-		(goto-char p)
-		(set-window-start w teco-output-start)
-		(set-window-point w p)
-		(select-window sw)))
-	  ;; a newline has not been seen, add output to minibuffer
-	  (save-window-excursion
-	    (select-window (minibuffer-window))
-	    (goto-char (point-max))
-	    (insert s)))))))
-
-;; Output a character of tracing information
-(defun teco-trace-type (c)
-  (teco-output (if (= c ?\e)
-		?$
-	      c)))
-
-;; Report an error
-(defun teco-error (code)
-  (let ((text (cdr (assoc code teco-error-texts))))
-    (teco-output (concat (if (save-excursion (set-buffer teco-output-buffer)
-					     (/= (point) teco-output-start))
-			     "\n"
-			   "")
-			 "? " code " " text))
-    (beep)
-    (if debug-on-error (debug nil code text))
-    (throw 'teco-exit nil)))
-
-
-;; Utility routines
-
-;; copy characters from command string to buffer
-(defun teco-moveuntil (string pointer terminate trace)
-  (let ((count 0))
-    (condition-case nil
-	(while (/= (aref string pointer) terminate)
-	  (and teco-trace (teco-trace-type (aref string pointer)))
-	  (insert (aref string pointer))
-	  (setq pointer (1+ pointer))
-	  (setq count (1+ count)))
-      (error (teco-error (if teco-macro-stack "UTM" "UTC"))))
-    count))
-
-;; Convert character to q-register name
-;; If file-or-search is t, allow _, *, %, #
-(defun teco-get-qspec (file-or-search char)
-  ;; lower-case char
-  (setq char (aref teco-mapch-l char))
-  ;; test that it's valid
-  (if (= (logand (aref teco-qspec-valid char) (if file-or-search 2 1)) 0)
-      (teco-error "IQN"))
-  char)
-
-;; Set or get value of a variable
-(defun teco-set-var (var)
-  (if teco-exp-flag1
-      (progn
-	(if teco-exp-flag2
-	    ;; if two arguments, they they are , 
-	    (set var (logior (logand (symbol-value var) (lognot teco-exp-val2))
-			     teco-exp-val1))
-	  ;; if one argument, it is the new value
-	  (set var teco-exp-val1))
-	;; consume argument(s)
-	(setq teco-exp-flag2 nil
-	      teco-exp-flag1 nil))
-    ;; if no arguments, fetch the value
-    (setq teco-exp-val1 (symbol-value var)
-	  teco-exp-flag1 t)))
-
-;; Get numeric argument
-(defun teco-get-value (default)
-  (prog1
-      (if teco-exp-flag1
-	  teco-exp-val1
-	(if (eq teco-exp-op 'sub)
-	    (- default)
-	  default))
-    ;; consume argument
-    (setq teco-exp-flag1 nil
-	  teco-exp-op 'start)))
-
-;; Get argument measuring in lines
-(defun teco-lines (r)
-  (- (save-excursion
-       (if (> r 0)
-	   (if (search-forward "\n" nil t r)
-	       (point)
-	     (point-max))
-	 (if (search-backward "\n" nil t (- 1 r))
-	     (1+ (point))
-	   (point-min))))
-     (point)))
-
-;; routine to handle args for K, T, X, etc.
-;; if two args, 'char x' to 'char y'
-;; if just one arg, then n lines (default 1)
-(defun teco-line-args (arg)
-  (if teco-exp-flag2
-      (cons teco-exp-val1 teco-exp-val2)
-    (cons (point) (+ (point) (teco-lines (if teco-exp-flag1
-					     teco-exp-val1
-					   1))))))
-
-;; routine to skip to next ", ', |, <, or >
-;; skips over these chars embedded in text strings
-;; stops in ! if argument is t
-;; returns character found
-(defun teco-skipto (&optional arg)
-  (catch 'teco-skip
-    (let (;; "at" prefix
-	  (atsw nil)
-	  ;; temp attributes
-	  ta
-	  ;; terminator
-	  term
-	  skipc)
-      (while t				; forever
-	(while (progn
-		 (setq skipc (teco-get-command nil)
-		       ta (aref teco-spec-chars skipc))
-		 ;; if char is ^, treat next char as control
-		 (if (eq skipc ?^)
-		     (setq skipc (logand 31 (teco-get-command nil))
-			   ta (aref teco-spec-chars skipc)))
-		 (= (logand ta 51) 0))	; read until something interesting
-					; found
-	  nil)
-	(if (/= (logand ta 32) 0)
-	    (teco-get-command nil))	; if command takes a Q spec,
-					; skip the spec
-	(if (/= (logand ta 16) 0)	; sought char found: quit 
-	    (progn
-	      (if (= skipc ?\")		; quote must skip next char
-		  (teco-get-command nil))
-	      (throw 'teco-skip skipc)))
-	(if (/= (logand ta 1) 0)	; other special char
-	    (cond
-	     ((eq skipc ?@)		; use alternative text terminator
-	      (setq atsw t))
-	     ((eq skipc ?\C-^)		; ^^ is value of next char
-					; skip that char
-	      (teco-get-command nil))
-	     ((eq skipc ?\C-a)		; type text
-	      (setq term (if atsw (teco-get-command nil) ?\C-a)
-		    atsw nil)
-	      (while (/= (teco-get-command nil) term)
-		nil))			; skip text
-	     ((eq skipc ?!)		; tag 
-	      (if arg
-		  (throw 'teco-skip skipc))
-	      (while (/= (teco-get-command nil) ?!)
-		nil))			; skip until next !
-	     ((or (eq skipc ?e)
-		  (eq skipc ?f))	; first char of two-letter E or F
-					; command
-	      nil)))			; not implemented
-	(if (/= (logand ta 2) 0)	; command with a text
-					; argument
-	    (progn
-	      (setq term (if atsw (teco-get-command nil) ?\e)
-		    atsw nil)
-	      (while (/= (teco-get-command nil) term)
-		nil)			; skip text
-	      ))))))
-
-
-(defvar teco-command-keymap
-  ;; This is what used to be (make-vector 128 'teco-command-self-insert)
-  ;; Oh well
-  (let ((map (make-keymap)) (n 127))
-    (while (>= n 0)
-      (define-key map (if (< n 32) (list 'control (+ n 32)) n)
-	'teco-command-self-insert)
-      (setq n (1- n)))
-    map)
-  "Keymap used while reading teco commands.")
-
-(define-key teco-command-keymap "\^g" 'teco-command-ctrl-g)
-(define-key teco-command-keymap "\^m" 'teco-command-return)
-(define-key teco-command-keymap "\^u" 'teco-command-ctrl-u)
-(define-key teco-command-keymap "\e" 'teco-command-escape)
-(define-key teco-command-keymap "\^?" 'teco-command-delete)
-
-(defvar teco-command-escapes nil
-  "Records where ESCs are, since they are represented in the command buffer
-by $.")
-
-;;;###autoload
-(defun teco-command ()
-  "Read and execute a Teco command string."
-  (interactive)
-  (let* ((teco-command-escapes nil)
-	 (command (catch 'teco-command-quit
-		    (read-from-minibuffer teco-prompt nil
-					  teco-command-keymap))))
-    (if command
-	(progn
-	  (while teco-command-escapes
-	    (aset command (car teco-command-escapes) ?\e)
-	    (setq teco-command-escapes (cdr teco-command-escapes)))
-	  (setq teco-output-buffer (get-buffer-create "*Teco Output*"))
-	  (save-excursion
-	    (set-buffer teco-output-buffer)
-	    (goto-char (point-max))
-	    (insert teco-prompt command))
-	  (teco-execute-command command)))))
-
-(defun teco-read-command ()
-  "Read a teco command string from the user."
-  (let ((command (catch 'teco-command-quit
-		   (read-from-minibuffer teco-prompt nil
-					 teco-command-keymap)))
-	teco-command-escapes)
-    (if command
-	(while teco-command-escapes
-	  (aset command (car teco-command-escapes) ?\e)
-	  (setq teco-command-escapes (cdr teco-command-escapes))))
-    command))
-
-(defun teco-command-self-insert ()
-  (interactive)
-  (insert last-command-char)
-  (if (not (pos-visible-in-window-p))
-      (enlarge-window 1)))
-
-(defun teco-command-ctrl-g ()
-  (interactive)
-  (beep)
-  (throw 'teco-command-quit nil))
-
-(defun teco-command-return ()
-  (interactive)
-  (setq last-command-char ?\n)
-  (teco-command-self-insert))
-
-(defun teco-command-escape ()
-  (interactive)
-  ;; Two ESCs in a row terminate the command string
-  (if (eq last-command 'teco-command-escape)
-      (throw 'teco-command-quit (buffer-string)))
-  (setq teco-command-escapes (cons (1- (point)) teco-command-escapes))
-  (setq last-command-char ?$)
-  (teco-command-self-insert))
-
-(defun teco-command-ctrl-u ()
-  (interactive)
-  ;; delete the characters
-  (kill-line 0)
-  ;; forget that they were ESCs
-  (while (and teco-command-escapes (<= (point) (car teco-command-escapes)))
-      (setq teco-command-escapes (cdr teco-command-escapes)))
-  ;; decide whether to shrink the window
-  (while (let ((a (insert ?\n))
-	       (b (pos-visible-in-window-p))
-	       (c (backward-delete-char 1)))
-	   b)
-    (shrink-window 1)))
-
-(defun teco-command-delete ()
-  (interactive)
-  ;; delete the character
-  (backward-delete-char 1)
-  ;; forget that it was an ESC
-  (if (and teco-command-escapes (= (point) (car teco-command-escapes)))
-      (setq teco-command-escapes (cdr teco-command-escapes)))
-  ;; decide whether to shrink the window
-  (insert ?\n)
-  (if (prog1 (pos-visible-in-window-p)
-	(backward-delete-char 1))
-      (shrink-window 1)))
-
-(provide 'teco)
-
-;;; teco.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/uil-mode.el b/xemacs-packages/lisp/prog-modes/uil-mode.el
deleted file mode 100644
index 2e62499e..00000000
--- a/xemacs-packages/lisp/prog-modes/uil-mode.el
+++ /dev/null
@@ -1,109 +0,0 @@
-;;; uil-mode.el --- UIL file editing mode for Emacs
-
-;;; Written by Brett Johnson 
-;;; Maintained for XEmacs by Jake Colman 
-
-;;; Commentary:
-;; Sets up cc-mode with support for UIL file #-comments , a lightly
-;; hacked syntax table, and some minimal font-lock regexps.
-
-;;; Code:
-
-(require 'cc-mode)
-
-(defvar uil-mode-syntax-table nil
-  "Syntax table in use in uil-mode buffers.")
-
-(if uil-mode-syntax-table
-    ()
-  (setq uil-mode-syntax-table (make-syntax-table))
-  (c-populate-syntax-table uil-mode-syntax-table)
-  ;; add extra comment syntax
-  (modify-syntax-entry ?/  ". 14" uil-mode-syntax-table)
-  (modify-syntax-entry ?*  ". 23" uil-mode-syntax-table)
-  (modify-syntax-entry ?!  "< b" uil-mode-syntax-table)
-  (modify-syntax-entry ?\n "> b" uil-mode-syntax-table)
-  (modify-syntax-entry ?\^m "> b" uil-mode-syntax-table)
-  )
-
-(defvar uil-mode-abbrev-table nil
-  "Abbrev table in use in uil-mode buffers.")
-(define-abbrev-table 'uil-mode-abbrev-table ())
-
-(defconst uil-font-lock-keywords
-  (list
-   ;; Make punctuation bold.
-   (cons "[-+*/{}():;=]" 'bold)
-   ;; Fontify procedure/identifier names.
-   '("\\(procedure\\)[ \t]+\\(\\sw+\\)"
-     (1 font-lock-keyword-face) (2 font-lock-function-name-face))
-   '("\\(identifier\\)[ \t]+\\(\\sw+\\)"
-     (1 font-lock-keyword-face) (2 font-lock-variable-name-face))
-   ;; Fontify UIL keywords.
-   (cons (concat "\\<\\(module\\|end\\|widget\\|gadget\\|"
-                 "arguments\\|callbacks\\|controls\\|identifiers\\|"
-                 "include\\|list\\|object\\|procedure[s]?\\|value\\|"
-                 "exported\\|private\\|on\\|off\\|true\\|false\\)\\>")
-         'font-lock-keyword-face)
-   ;; Pseudo-keyworks (not reserved).
-   (cons (concat "\\<\\(background\\|case_\\(in\\)?sensitive\\|file\\|"
-                 "foreground\\|imported\\|\\(un\\)?managed\\|names\\|"
-                 "objects\\|right_to_left\\|user_defined\\)\\>")
-         'font-lock-type-face)
-   ;; Built in types..
-   (cons (concat
-          "\\<\\(a\\(ny\\|rgument\\|sciz_\\(string_\\)?table\\)\\|"
-          "boolean\\|c\\(haracter_set\\|olor\\(_table\\)?\\)\\|"
-          "compound_string\\(_table\\)?\\|font\\(_table\\|set\\)?\\|"
-          "i\\(con\\|nteger\\(_table\\)?\\)\\|keysym\\|reason\\|rgb\\|"
-          "single_float\\|string\\(_table\\)?\\|translation_table\\|"
-          "wide_character\\|xbitmapfile\\|version\\)\\>") 'font-lock-type-face)
-   ;; Make a hack at motif constants & fields..
-   (cons "\\<\\(Xm[a-zA-Z_]+\\|iso_[a-z0-1A-Z]+\\)\\>" 'font-lock-variable-name-face)
-   ))
-
-(put 'uil-mode 'font-lock-keywords 'uil-font-lock-keywords)
-
-;;;###autoload
-(defun uil-mode ()
-  "Major mode for editing UIL files.
-This is much like C mode except for the syntax of comments.  It uses
-the same keymap as C mode and has the same variables for customizing
-indentation.  It has its own abbrev table and its own syntax table.
-
-Turning on uil mode calls the value of the variable `uil-mode-hook'
-with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (require 'cc-mode)
-  (c-initialize-cc-mode)
-  (use-local-map c-mode-map)
-  (c-common-init)
-  (setq major-mode 'uil-mode)
-  (setq mode-name "uil")
-  (setq local-abbrev-table uil-mode-abbrev-table)
-  (set-syntax-table uil-mode-syntax-table)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'c-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-;  (setq comment-start "!\\|/\*")
-;  (make-local-variable 'comment-end)
-;  (setq comment-end "\n\\|\*/")
-;  (make-local-variable 'comment-start-skip)
-  (setq comment-start "!")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "!+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'c-comment-indent)
-  (run-hooks 'uil-mode-hook))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.uil$" . uil-mode))
-
-(provide 'uil-mode)
-
-;;; uil-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/verilog-mode.el b/xemacs-packages/lisp/prog-modes/verilog-mode.el
deleted file mode 100644
index 4eae7337..00000000
--- a/xemacs-packages/lisp/prog-modes/verilog-mode.el
+++ /dev/null
@@ -1,8268 +0,0 @@
-;; verilog-mode.el --- major mode for editing verilog source in Emacs
-;;
-;; $Id: verilog-mode.el,v 4.2 2004/12/03 23:05:24 mac Exp $
-
-;; Copyright (C) 2003 Free Software Foundation, Inc.
-
-;; Author: Michael McNamara (mac@verilog.com)
-;; Senior Vice President of Technology, Verisity Design, Inc.
-;; IEEE 1364 Verilog standards committee Chairman
-;; (SureFire and Verisity merged October 1999)
-;;      http://www.verisity.com
-;; AUTO features, signal, modsig; by: Wilson Snyder
-;;	(wsnyder@wsnyder.org or wsnyder@world.std.com)
-;;	http://www.veripool.com
-;; Keywords: languages
-
-;; 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., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This mode borrows heavily from the Pascal-mode and the cc-mode of emacs
-
-;; USAGE
-;; =====
-
-;; A major mode for editing Verilog HDL source code. When you have
-;; entered Verilog mode, you may get more info by pressing C-h m. You
-;; may also get online help describing various functions by: C-h f
-;; 
-
-;; You can get step by step help in installing this file by going to
-;; 
-
-;; The short list of installation instructions are: To set up
-;; automatic verilog mode, put this file in your load path, and put
-;; the following in code (please un comment it first!) in your
-;; .emacs, or in your site's site-load.el
-
-; (autoload 'verilog-mode "verilog-mode" "Verilog mode" t )
-; (setq auto-mode-alist (cons  '("\\.v\\'" . verilog-mode) auto-mode-alist))
-; (setq auto-mode-alist (cons  '("\\.dv\\'" . verilog-mode) auto-mode-alist))
-
-;; If you want to customize Verilog mode to fit your needs better,
-;; you may add these lines (the values of the variables presented
-;; here are the defaults). Note also that if you use an emacs that
-;; supports custom, it's probably better to use the custom menu to
-;; edit these.
-;;
-;; Be sure to examine at the help for verilog-auto, and the other
-;; verilog-auto-* functions for some major coding time savers.
-;;
-; ;; User customization for Verilog mode
-; (setq verilog-indent-level             3
-;       verilog-indent-level-module      3
-;       verilog-indent-level-declaration 3
-;       verilog-indent-level-behavioral  3
-;       verilog-indent-level-directive   1
-;       verilog-case-indent              2
-;       verilog-auto-newline             t
-;       verilog-auto-indent-on-newline   t
-;       verilog-tab-always-indent        t
-;       verilog-auto-endcomments         t
-;       verilog-minimum-comment-distance 40
-;       verilog-indent-begin-after-if    t
-;       verilog-auto-lineup              '(all))
-
-;; KNOWN BUGS / BUG REPORTS
-;; =======================
-;; This is beta code, and likely has bugs. Please report any and all
-;; bugs to me at verilog-mode-bugs@surefirev.com.  Use
-;; verilog-submit-bug-report to submit a report.
-;; 
-
-;;; History:
-;;
-
-;; 
-;;; Code:
-
-;; XEmacs additions
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.vh?\\'" . verilog-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.dv\\'" . verilog-mode))
-;; APA: .f is probably controversial?
-;; ;;;###autoload(add-to-list 'auto-mode-alist '("\\.f\\'" . verilog-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.vlog\\'" . verilog-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.verilog\\'" . verilog-mode))
-
-(provide 'verilog-mode)
-
-;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "Revision: 4.2"
-  "Version of this verilog mode.")
-(defconst verilog-running-on-xemacs (string-match "XEmacs" emacs-version))
-
-;;;###autoload
-(defun verilog-version ()
-  "Inform caller of the version of this file."
-  (interactive)
-  (message (concat "Using verilog-mode version " (substring verilog-mode-version 12 -3 )) ))
-
-;; Insure we have certain packages, and deal with it if we don't
-(if (fboundp 'eval-when-compile)
-    (eval-when-compile
-      (condition-case nil
-          (require 'imenu)
-        (error nil))
-      (condition-case nil
-	  (require 'reporter)
-        (error nil))
-      (condition-case nil
-          (require 'easymenu)
-        (error nil))
-      (condition-case nil
-	  (load "skeleton") ;; bug in 19.28 through 19.30 skeleton.el, not provided.
-        (error nil))
-      (condition-case nil
-          (if (fboundp 'when)
-	      nil ;; fab
-	    (defmacro when (var &rest body)
-	      (` (cond ( (, var) (,@ body))))))
-        (error nil))
-      (condition-case nil
-          (if (fboundp 'unless)
-	      nil ;; fab
-	    (defmacro unless (var &rest body)
-	      (` (if (, var) nil (,@ body)))))
-        (error nil))
-      (condition-case nil
-          (if (fboundp 'store-match-data)
-	      nil ;; fab
-	    (defmacro store-match-data (&rest args) nil))
-        (error nil))
-      (condition-case nil
-	  (if (boundp 'current-menubar)
-	      nil ;; great
-	    (defmacro set-buffer-menubar (&rest args) nil)
-	    (defmacro add-submenu (&rest args) nil))
-	(error nil))
-      (condition-case nil
-	  (if (fboundp 'zmacs-activate-region)
-	      nil ;; great
-	    (defmacro zmacs-activate-region (&rest args) nil))
-	(error nil))
-      (condition-case nil
-	  (if (fboundp 'char-before)
-	      nil ;; great
-	    (defmacro char-before (&rest body)
-	      (` (char-after (1- (point))))))
-	(error nil))
-      ;; Requires to define variables that would be "free" warnings
-      (condition-case nil
-	  (require 'font-lock)
-	(error nil))
-      (condition-case nil
-	  (require 'compile)
-	(error nil))
-      (condition-case nil
-	  (require 'custom)
-	(error nil))
-      (condition-case nil
-	  (require 'dinotrace)
-	(error nil))
-      (condition-case nil
-	  (if (fboundp 'dinotrace-unannotate-all)
-	      nil ;; great
-	    (defun dinotrace-unannotate-all (&rest args) nil))
-	(error nil))
-      (condition-case nil
-	  (if (fboundp 'customize-apropos)
-	      nil ;; great
-	    (defun customize-apropos (&rest args) nil))
-	(error nil))
-      (condition-case nil
-	  (if (fboundp 'match-string-no-properties)
-	      nil ;; great
-	    (defsubst match-string-no-properties (match)
-	      (buffer-substring-no-properties (match-beginning match) (match-end match))))
-	(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 customize (&rest args)
-	  (message "Sorry, Customize is not available with this version of emacs"))
-	(defmacro defcustom (var value doc &rest args)
-	  (` (defvar (, var) (, value) (, doc))))
-	)
-      (if (fboundp 'defface)
-	  nil ; great!
-	(defmacro defface (var value doc &rest args)
-	  (` (make-face (, var))))
-	)
-
-      (if (and (featurep 'custom) (fboundp 'customize-group))
-	  nil ;; We've got what we needed
-	;; We have an intermediate custom-library, hack around it!
-	(defmacro customize-group (var &rest args)
-	  (`(customize (, var) )))
-	)
-
-      ))
-(eval-and-compile
-  (if (fboundp 'regexp-opt)
-      (defun verilog-regexp-opt (strings &optional paren shy)
-	(let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
-	  (concat open (mapconcat 'regexp-quote strings "\\|") close)))
-    (if (fboundp 'function-min-args)
-	(if (= 3 (function-min-args `regexp-opt))
-	    (defun verilog-regexp-opt (a b)
-	      "Deal with differing number of required arguments for  `regexp-opt'.
-         Call 'regexp-opt' on A and B."
-	      (regexp-opt a b 't))
-	  (defun verilog-regexp-opt (a b)
-	    "Call 'regexp-opt' on A and B."
-	    (regexp-opt a b))
-	  )
-      (defun verilog-regexp-opt (a b)
-	"Call 'regexp-opt' on A and B."
-	(regexp-opt a b))
-      )
-    ))
-
-;; XEmacs change: workarounds not needed with xemacs-base > 1.81
-(eval-when-compile
-  (defalias 'verilog-regexp-opt 'regexp-opt))
-(defalias 'verilog-regexp-opt 'regexp-opt)
-;(unless (fboundp 'regexp-opt)
-;  (defun regexp-opt (strings &optional paren)
-;    (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
-;      (concat open (mapconcat 'regexp-quote strings "\\|") close))))
-;(eval-when-compile
-;  (defun verilog-regexp-opt (a b)
-;    "Wrapper to deal with XEmacs and FSF emacs having similar functions with differing number of arguments."
-;    (if (string-match "XEmacs" emacs-version)
-;	(regexp-opt a b 't)
-;      (regexp-opt a b)))
-;  )
-;(defun verilog-regexp-opt (a b)
-;  "Deal with XEmacs & FSF both have `regexp-opt'; with different interface.
-;Call 'regexp-opt' on A and B."
-;  (if verilog-running-on-xemacs
-;      (unwind-protect (regexp-opt a b 't))
-;    (regexp-opt a b)))
-
-;;;###autoload
-(defun verilog-customize ()
-  "Link to customize screen for Verilog."
-  (interactive)
-  (customize-group 'verilog-mode))
-
-(defun verilog-font-customize ()
-  "Link to customize fonts used for Verilog."
-  (interactive)
-  (customize-apropos "font-lock-*" 'faces))
-
-(defgroup verilog-mode nil
-  "Facilitates easy editing of Verilog source text"
-  :group 'languages)
-
-; (defgroup verilog-mode-fonts nil
-;   "Facilitates easy customization fonts used in Verilog source text"
-;   :link '(customize-apropos "font-lock-*" 'faces)
-;  :group 'verilog-mode)
-
-(defgroup verilog-mode-indent nil
-  "Customize indentation and highlighting of verilog source text"
-  :group 'verilog-mode)
-
-(defgroup verilog-mode-actions nil
-  "Customize actions on verilog source text"
-  :group 'verilog-mode)
-
-(defgroup verilog-mode-auto nil
-  "Customize AUTO actions when expanding verilog source text"
-  :group 'verilog-mode)
-
-(defcustom verilog-linter "surelint --std --synth --style --sim --race --fsm --msglimit=none "
-  "*Unix program and arguments to call to run a lint checker on verilog source.
-Invoked when you type \\[compile].  \\[next-error] will take you to
-   the next lint error as expected."
-  :type 'string
-  :group 'verilog-mode-actions)
-
-(defcustom verilog-coverage "surecov --code --fsm --expr "
-  "*Program and arguments to use to annotate for coverage verilog source."
-  :type 'string
-  :group 'verilog-mode-actions)
-
-(defcustom verilog-simulator "verilog "
-  "*Program and arguments to use to interpret verilog source."
-  :type 'string
-  :group 'verilog-mode-actions)
-
-(defcustom verilog-compiler "vcs "
-  "*Program and arguments to use to compile verilog source."
-  :type 'string
-  :group 'verilog-mode-actions)
-
-(defvar verilog-tool 'verilog-linter)
-
-(defcustom verilog-highlight-translate-off nil
-  "*Non-nil means background-highlight code excluded from translation.
-That is, all code between \"// synopsys translate_off\" and
-\"// synopsys translate_on\" is highlighted using a different background color
-\(face `verilog-font-lock-translate-off-face').
-Note: this will slow down on-the-fly fontification (and thus editing).
-NOTE: Activate the new setting in a Verilog buffer by re-fontifying it (menu
-      entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."
-  :type 'boolean
-  :group 'verilog-mode-indent)
-
-(defcustom verilog-indent-level 3
-  "*Indentation of Verilog statements with respect to containing block."
-  :group 'verilog-mode-indent
-  :type 'integer)
-
-(defcustom verilog-indent-level-module 3
-  "* Indentation of Module level Verilog statements.  (eg always, initial)
-Set to 0 to get initial and always statements lined up
-    on the left side of your screen."
-  :group 'verilog-mode-indent
-  :type 'integer)
-
-(defcustom verilog-indent-level-declaration 3
-  "*Indentation of declarations with respect to containing block.
-Set to 0 to get them list right under containing block."
-  :group 'verilog-mode-indent
-  :type 'integer)
-
-(defcustom verilog-indent-declaration-macros nil
-  "*How to treat macro expansions in a declaration.
-If nil, indent as:
-  input [31:0] a;
-  input        `CP;
-  output       c;
-If non nil, treat as
-  input [31:0] a;
-  input `CP    ;
-  output       c;"
-  :group 'verilog-mode-indent
-  :type 'boolean)
-
-(defcustom verilog-indent-lists t
-  "*How to treat indenting items in a list.
-If t (the default), indent as:
-  always @( posedge a or
-            reset ) begin
-If nil, treat as
-  always @( posedge a or
-     reset ) begin"
-  :group 'verilog-mode-indent
-  :type 'boolean)
-
-(defcustom verilog-indent-level-behavioral 3
-  "*Absolute indentation of first begin in a task or function block.
-Set to 0 to get such code to start at the left side of the screen."
-  :group 'verilog-mode-indent
-  :type 'integer)
-
-(defcustom verilog-indent-level-directive 1
-  "*Indentation to add to each level of `ifdef declarations.
-Set to 0 to have all directives start at the left side of the screen."
-  :group 'verilog-mode-indent
-  :type 'integer)
-
-(defcustom verilog-cexp-indent 2
-  "*Indentation of Verilog statements split across lines."
-  :group 'verilog-mode-indent
-  :type 'integer)
-
-(defcustom verilog-case-indent 2
-  "*Indentation for case statements."
-  :group 'verilog-mode-indent
-  :type 'integer)
-
-(defcustom verilog-auto-newline t
-  "*True means automatically newline after semicolons."
-  :group 'verilog-mode-indent
-  :type 'boolean)
-
-(defcustom verilog-auto-indent-on-newline t
-  "*True means automatically indent line after newline."
-  :group 'verilog-mode-indent
-  :type 'boolean)
-
-(defcustom verilog-tab-always-indent t
-  "*True means TAB should always re-indent the current line.
-Nil means TAB will only reindent when at the beginning of the line."
-  :group 'verilog-mode-indent
-  :type 'boolean)
-
-(defcustom verilog-tab-to-comment nil
-  "*True means TAB moves to the right hand column in preparation for a comment."
-  :group 'verilog-mode-actions
-  :type 'boolean)
-
-(defcustom verilog-indent-begin-after-if t
-  "*If true, indent begin statements following if, else, while, for and repeat.
-Otherwise, line them up."
-  :group 'verilog-mode-indent
-  :type 'boolean )
-
-
-(defcustom verilog-align-ifelse nil
-  "*If true, align `else' under matching `if'.
-Otherwise else is lined up with first character on line holding matching if."
-  :group 'verilog-mode-indent
-  :type 'boolean )
-
-(defcustom verilog-minimum-comment-distance 10
-  "*Minimum distance (in lines) between begin and end required before a comment.
-Setting this variable to zero results in every end acquiring a comment; the
-default avoids too many redundant comments in tight quarters"
-  :group 'verilog-mode-indent
-  :type 'integer)
-
-(defcustom verilog-auto-endcomments t
-  "*True means insert a comment /* ... */ after 'end's.
-The name of the function or case will be set between the braces."
-  :group 'verilog-mode-actions
-  :type 'boolean )
-
-(defcustom verilog-auto-read-includes nil
-  "*True means do a `verilog-read-defines' and `verilog-read-includes'
-before each AUTO expansion.  This makes it easier to embed defines and
-includes, but can result in very slow reading times if there are many or
-large include files."
-  :group 'verilog-mode-actions
-  :type 'boolean )
-
-(defcustom verilog-auto-save-policy nil
-  "*Non-nil indicates action to take when saving a Verilog buffer with AUTOs.
-A value of `force' will always do a \\[verilog-auto] automatically if
-needed on every save.  A value of `detect' will do \\[verilog-auto]
-automatically when it thinks necessary.  A value of `ask' will query the
-user when it thinks updating is needed.
-
-You should not rely on the 'ask or 'detect policies, they are safeguards
-only.  They do not detect when AUTOINSTs need to be updated because a
-sub-module's port list has changed."
-  :group 'verilog-mode-actions
-  :type '(choice (const nil) (const ask) (const detect) (const force)))
-
-(defvar verilog-auto-update-tick nil
-  "Modification tick at which autos were last performed.")
-
-(defvar verilog-auto-last-file-locals nil
-  "Text from file-local-variables during last evaluation.")
-
-(defvar verilog-error-regexp-add-didit nil)
-(defvar verilog-error-regexp nil)
-(setq verilog-error-regexp-add-didit nil
- verilog-error-regexp
-  '(
-	; SureLint
-;;    ("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 1 2)
-	; Most SureFire tools
-    ("\\(WARNING\\|ERROR\\|INFO\\)[^:]*: \\([^,]+\\), \\(line \\|\\)\\([0-9]+\\):" 2 4 )
-    ("\
-\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
-:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5)
-        ; xsim
-	; Error! in file /homes/mac/Axis/Xsim/test.v at line 13 		[OBJ_NOT_DECLARED]
-    ("\\(Error\\|Warning\\).*in file (\\([^ \t]+\\) at line *\\([0-9]+\\))" 2 3)
-	; vcs
-    ("\\(Error\\|Warning\\):[^(]*(\\([^ \t]+\\) line *\\([0-9]+\\))" 2 3)
-    ("Warning:.*(port.*(\\([^ \t]+\\) line \\([0-9]+\\))" 1 2)
-    ("\\(Error\\|Warning\\):[\n.]*\\([^ \t]+\\) *\\([0-9]+\\):" 2 3)
-    ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 2)
-        ; Verilator
-    ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 4)
-    ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 4)
-       ; vxl
-    ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 3)
-    ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\([0-9]+\\):.*$" 1 2)	       ; vxl
-    ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+line[ \t]+\\([0-9]+\\):.*$" 1 2)
-       ; Leda
-    ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 2)
-    )
-;  "*List of regexps for verilog compilers, like verilint. See compilation-error-regexp-alist for the formatting."
-)
-
-(defvar verilog-error-font-lock-keywords
-  '(
-    ("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 1 bold t)
-    ("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 2 bold t)
-
-    ("\\(WARNING\\|ERROR\\|INFO\\): \\([^,]+\\), line \\([0-9]+\\):" 2 bold t)
-    ("\\(WARNING\\|ERROR\\|INFO\\): \\([^,]+\\), line \\([0-9]+\\):" 3 bold t)
-
-    ("\
-\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
-:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 bold t)
-    ("\
-\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
-:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 bold t)
-
-    ("\\(Error\\|Warning\\):[^(]*(\\([^ \t]+\\) line *\\([0-9]+\\))" 2 bold t)
-    ("\\(Error\\|Warning\\):[^(]*(\\([^ \t]+\\) line *\\([0-9]+\\))" 3 bold t)
-
-    ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t)
-    ("%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t)
-
-    ("Warning:.*(port.*(\\([^ \t]+\\) line \\([0-9]+\\))" 1 bold t)
-    ("Warning:.*(port.*(\\([^ \t]+\\) line \\([0-9]+\\))" 1 bold t)
-
-    ("\\(Error\\|Warning\\):[\n.]*\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t)
-    ("\\(Error\\|Warning\\):[\n.]*\\([^ \t]+\\) *\\([0-9]+\\):" 3 bold t)
-
-    ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 bold t)
-    ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t)
-       ; vxl
-    ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 bold t)
-    ("\\(Error\\|Warning\\)!.*\n?.*\"\\([^\"]+\\)\", \\([0-9]+\\)" 2 bold t)
-
-    ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\([0-9]+\\):.*$" 1 bold t)
-    ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\([0-9]+\\):.*$" 2 bold t)
-
-    ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+line[ \t]+\\([0-9]+\\):.*$" 1 bold t)
-    ("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+line[ \t]+\\([0-9]+\\):.*$" 2 bold t)
-       ; Leda
-    ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 1 bold t)
-    ("In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\[\\(Warning\\|Error\\|Failure\\)\\][^\n]*" 2 bold t)
-    )
-  "*Keywords to also highlight in Verilog *compilation* buffers."
-  )
-
-(defcustom verilog-library-directories '(".")
-  "*List of directories when looking for files for /*AUTOINST*/.
-The directory may be relative to the current file, or absolute.
-Environment variables are also expanded in the directory names.
-Having at least the current directory is a good idea.
-
-You might want these defined in each file; put at the *END* of your file
-something like:
-
-// Local Variables:
-// verilog-library-directories:(\".\" \"subdir\" \"subdir2\")
-// End:
-
-Verilog-mode attempts to detect changes to this local variable, but they
-are only insured to be correct when the file is first visited. Thus if you
-have problems, use \\[find-alternate-file] RET to have these take effect.
-
-See also verilog-library-files and verilog-library-extensions."
-  :group 'verilog-mode-auto
-  :type '(repeat file))
-
-(defcustom verilog-library-files '(".")
-  "*List of files to search for modules in when looking for files for
-/*AUTOINST*/.  This is a complete path, usually to a technology file with
-many standard cells defined in it.
-
-You might want these defined in each file; put at the *END* of your file
-something like:
-
-// Local Variables:
-// verilog-library-files:(\"/some/path/technology.v\" \"/some/path/tech2.v\")
-// End:
-
-Verilog-mode attempts to detect changes to this local variable, but they
-are only insured to be correct when the file is first visited. Thus if you
-have problems, use \\[find-alternate-file] RET to have these take effect.
-
-See also verilog-library-directories."
-  :group 'verilog-mode-auto
-  :type '(repeat directory))
-
-(defcustom verilog-library-extensions '(".v")
-  "*List of extensions to use when looking for files for /*AUTOINST*/.
-See also `verilog-library-directories'."
-  :type '(repeat string)
-  :group 'verilog-mode-auto)
-
-(defcustom verilog-auto-sense-include-inputs nil
-  "*If true, AUTOSENSE should include all inputs.
-If nil, only inputs that are NOT output signals in the same block are
-included."
-  :type 'boolean
-  :group 'verilog-mode-auto)
-
-(defcustom verilog-auto-sense-defines-constant nil
-  "*If true, AUTOSENSE should assume all defines represent constants.
-When true, the defines will not be included in sensitivity lists.  To
-maintain compatibility with other sites, this should be set at the bottom
-of each verilog file that requires it, rather then being set globally."
-  :type 'boolean
-  :group 'verilog-mode-auto)
-
-(defcustom verilog-auto-reset-widths nil
-  "*If true, AUTORESET should determine the width of signals and use it
-to widen the zero (32'h0 for example).  This is required by some lint
-tools that aren't smart enough to ignore widths of the constant zero.
-This is not on my default, as it results in ugly code when parameters
-determine the MSB or LSB of a signal inside a AUTORESET."
-  :type 'boolean
-  :group 'verilog-mode-auto)
-
-(defcustom verilog-assignment-delay ""
-  "*Text used for delayes in delayed assignments.  Add a trailing space if set."
-  :type 'string
-  :group 'verilog-mode-auto)
-
-(defcustom verilog-auto-inst-vector t
-  "*If true, when creating default ports with AUTOINST, use bus subscripts.
-If nil, skip the subscript when it matches the entire bus as declared in
-the module (AUTOWIRE signals always are subscripted, you must manually
-declare the wire to have the subscrips removed.)  Nil may speed up some
-simulators, but is less general and harder to read, so avoid."
-  :group 'verilog-mode-auto
-  :type 'boolean )
-
-(defcustom verilog-auto-inst-template-numbers nil
-  "*If true, when creating templated ports with AUTOINST, add a comment.
-The comment will add the line number of the template that was used for that
-port declaration.  Setting this aids in debugging, but nil is suggested for
-regular use to prevent large numbers of merge conflicts."
-  :group 'verilog-mode-auto
-  :type 'boolean )
-
-(defcustom verilog-mode-hook   'verilog-set-compile-command
-  "*Hook (List of functions) run after verilog mode is loaded."
-  :type 'hook
-  :group 'verilog-mode)
-
-(defcustom verilog-before-auto-hook nil
-  "*Hook run before `verilog-mode' updates AUTOs."
-  :type 'hook
-  :group 'verilog-mode-auto
-)
-
-(defcustom verilog-auto-hook nil
-  "*Hook run after `verilog-mode' updates AUTOs."
-  :type 'hook
-  :group 'verilog-mode-auto)
-
-(defvar verilog-auto-lineup '(all)
-  "*List of contexts where auto lineup of :'s or ='s should be done.
-Elements can be of type: 'declaration' or 'case', which will do auto
-lineup in declarations or case-statements respectively.  The word 'all'
-will do all lineups.  '(case declaration) for instance will do lineup
-in case-statements and parameter list, while '(all) will do all
-lineups.")
-
-(defvar verilog-mode-abbrev-table nil
-  "Abbrev table in use in Verilog-mode buffers.")
-
-(defvar verilog-imenu-generic-expression
-  '((nil "^\\s-*\\(\\(m\\(odule\\|acromodule\\)\\)\\|primitive\\)\\s-+\\([a-zA-Z0-9_.:]+\\)" 4)
-    ("*Vars*" "^\\s-*\\(reg\\|wire\\)\\s-+\\(\\|\\[[^]]+\\]\\s-+\\)\\([A-Za-z0-9_]+\\)" 3))
-  "Imenu expression for Verilog-mode.  See `imenu-generic-expression'.")
-
-(defvar verilog-mode-abbrev-table nil
-  "Abbrev table in use in Verilog-mode buffers.")
-
-;;
-;; provide a verilog-header function.
-;; Customization variables:
-;;
-(defvar verilog-date-scientific-format nil
-  "*If non-nil, dates are written in scientific format (e.g.  1997/09/17).
-If nil, in European format (e.g.  17.09.1997).  The brain-dead American
-format (e.g.  09/17/1997) is not supported.")
-
-(defvar verilog-company nil
-  "*Default name of Company for verilog header.
-If set will become buffer local.")
-
-(defvar verilog-project nil
-  "*Default name of Project for verilog header.
-If set will become buffer local.")
-
-(define-abbrev-table 'verilog-mode-abbrev-table ())
-
-(defvar verilog-mode-map ()
-  "Keymap used in Verilog mode.")
-(if verilog-mode-map
-    ()
-  (setq verilog-mode-map (make-sparse-keymap))
-  (define-key verilog-mode-map ";"        'electric-verilog-semi)
-  (define-key verilog-mode-map [(control 59)]    'electric-verilog-semi-with-comment)
-  (define-key verilog-mode-map ":"        'electric-verilog-colon)
-  (define-key verilog-mode-map "="        'electric-verilog-equal)
-  (define-key verilog-mode-map "\`"       'electric-verilog-tick)
-  (define-key verilog-mode-map "\t"       'electric-verilog-tab)
-  (define-key verilog-mode-map "\r"       'electric-verilog-terminate-line)
-  ;; backspace/delete key bindings
-  (define-key verilog-mode-map [backspace]    'backward-delete-char-untabify)
-  (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable
-    (define-key verilog-mode-map [delete]       'delete-char)
-    (define-key verilog-mode-map [(meta delete)] 'kill-word))
-  (define-key verilog-mode-map "\M-\C-b"  'electric-verilog-backward-sexp)
-  (define-key verilog-mode-map "\M-\C-f"  'electric-verilog-forward-sexp)
-  (define-key verilog-mode-map "\M-\r"    (function (lambda ()
-		      (interactive) (electric-verilog-terminate-line 1))))
-  (define-key verilog-mode-map "\M-\t"    'verilog-complete-word)
-  (define-key verilog-mode-map "\M-?"     'verilog-show-completions)
-  (define-key verilog-mode-map [(meta control h)] 'verilog-mark-defun)
-  (define-key verilog-mode-map "\C-c\`"   'verilog-lint-off)
-  (define-key verilog-mode-map "\C-c\C-r" 'verilog-label-be)
-  (define-key verilog-mode-map "\C-c\C-i" 'verilog-pretty-declarations)
-  (define-key verilog-mode-map "\C-c="    'verilog-pretty-expr)
-  (define-key verilog-mode-map "\C-c\C-b" 'verilog-submit-bug-report)
-  (define-key verilog-mode-map "\M-*"     'verilog-star-comment)
-  (define-key verilog-mode-map "\C-c\C-c" 'verilog-comment-region)
-  (define-key verilog-mode-map "\C-c\C-u" 'verilog-uncomment-region)
-  (define-key verilog-mode-map "\M-\C-a"  'verilog-beg-of-defun)
-  (define-key verilog-mode-map "\M-\C-e"  'verilog-end-of-defun)
-  (define-key verilog-mode-map "\C-c\C-d" 'verilog-goto-defun)
-  (define-key verilog-mode-map "\C-c\C-k" 'verilog-delete-auto)
-  (define-key verilog-mode-map "\C-c\C-a" 'verilog-auto)
-  (define-key verilog-mode-map "\C-c\C-s" 'verilog-auto-save-compile)
-  (define-key verilog-mode-map "\C-c\C-e" 'verilog-expand-vector)
-  (define-key verilog-mode-map "\C-c\C-h" 'verilog-header)
-  )
-
-;; menus
-(defvar verilog-which-tool 1)
-(defvar verilog-xemacs-menu
-  '("Verilog"
-    ("Choose Compilation Action"
-     ["Lint"
-      (progn
-	(setq verilog-tool 'verilog-linter)
-	(setq verilog-which-tool 1)
-	(verilog-set-compile-command))
-      :style radio
-      :selected (= verilog-which-tool 1)]
-     ["Coverage"
-      (progn
-	(setq verilog-tool 'verilog-coverage)
-	(setq verilog-which-tool 2)
-	(verilog-set-compile-command))
-      :style radio
-      :selected (= verilog-which-tool 2)]
-     ["Simulator"
-      (progn
-	(setq verilog-tool 'verilog-simulator)
-	(setq verilog-which-tool 3)
-	(verilog-set-compile-command))
-      :style radio
-      :selected (= verilog-which-tool 3)]
-     ["Compiler"
-      (progn
-	(setq verilog-tool 'verilog-compiler)
-	(setq verilog-which-tool 4)
-	(verilog-set-compile-command))
-      :style radio
-      :selected (= verilog-which-tool 4)]
-     )
-    ("Move"
-     ["Beginning of function"		verilog-beg-of-defun t]
-     ["End of function"			verilog-end-of-defun t]
-     ["Mark function"			verilog-mark-defun t]
-     ["Goto function"			verilog-goto-defun t]
-     ["Move to beginning of block"	electric-verilog-backward-sexp t]
-     ["Move to end of block"		electric-verilog-forward-sexp t]
-     )
-    ("Comments"
-     ["Comment Region"			verilog-comment-region t]
-     ["UnComment Region"			verilog-uncomment-region t]
-     ["Multi-line comment insert"	verilog-star-comment t]
-     ["Lint error to comment"		verilog-lint-off t]
-     )
-    "----"
-    ["Compile"				compile t]
-    ["AUTO, Save, Compile"		verilog-auto-save-compile t]
-    ["Next Compile Error"		next-error t]
-    ["Ignore Lint Warning at point"	verilog-lint-off t]
-    "----"
-    ["Line up declarations around point"	verilog-pretty-declarations t]
-    ["Line up equations around point"		verilog-pretty-expr t]
-    ["Redo/insert comments on every end"	verilog-label-be t]
-    ["Expand [x:y] vector line"		verilog-expand-vector t]
-    ["Insert begin-end block"		verilog-insert-block t]
-    ["Complete word"			verilog-complete-word t]
-    "----"
-    ["Recompute AUTOs"			verilog-auto t]
-    ["Kill AUTOs"			verilog-delete-auto t]
-    ("AUTO Help..."
-     ["AUTO General"			(describe-function 'verilog-auto) t]
-     ["AUTO Library Path"		(describe-variable 'verilog-library-directories) t]
-     ["AUTO Library Files"		(describe-variable 'verilog-library-files) t]
-     ["AUTO Library Extensions"		(describe-variable 'verilog-library-extensions) t]
-     ["AUTO `define Reading"		(describe-function 'verilog-read-defines) t]
-     ["AUTO `include Reading"		(describe-function 'verilog-read-includes) t]
-     ["AUTOARG"				(describe-function 'verilog-auto-arg) t]
-     ["AUTOASCIIENUM"			(describe-function 'verilog-auto-ascii-enum) t]
-     ["AUTOINOUTMODULE"			(describe-function 'verilog-auto-inout-module) t]
-     ["AUTOINOUT"			(describe-function 'verilog-auto-inout) t]
-     ["AUTOINPUT"			(describe-function 'verilog-auto-input) t]
-     ["AUTOINST"			(describe-function 'verilog-auto-inst) t]
-     ["AUTOOUTPUT"			(describe-function 'verilog-auto-output) t]
-     ["AUTOOUTPUTEVERY"			(describe-function 'verilog-auto-output-every) t]
-     ["AUTOREG"				(describe-function 'verilog-auto-reg) t]
-     ["AUTOREGINPUT"			(describe-function 'verilog-auto-reg-input) t]
-     ["AUTORESET"			(describe-function 'verilog-auto-reset) t]
-     ["AUTOSENSE"			(describe-function 'verilog-auto-sense) t]
-     ["AUTOWIRE"			(describe-function 'verilog-auto-wire) t]
-     )
-    "----"
-    ["Submit bug report"		verilog-submit-bug-report t]
-    ["Customize Verilog Mode..."	verilog-customize t]
-    ["Customize Verilog Fonts & Colors"	verilog-font-customize t]
-    )
-  "Emacs menu for VERILOG mode."
-  )
-(unless verilog-running-on-xemacs
-    (easy-menu-define verilog-menu verilog-mode-map "Menu for Verilog mode"
-		      verilog-xemacs-menu))
-
-(defvar verilog-mode-abbrev-table nil
-  "Abbrev table in use in Verilog-mode buffers.")
-
-(define-abbrev-table 'verilog-mode-abbrev-table ())
-
-;; compilation program
-(defun verilog-set-compile-command ()
-  "Function to compute shell command to compile verilog.
-Can be the path and arguments for your Verilog simulator:
-  \"vcs -p123 -O\"
-or a string like
-  \"(cd /tmp; surecov %s)\".
-In the former case, the path to the current buffer is concat'ed to the
-value of verilog-tool; in the later, the path to the current buffer is
-substituted for the %s.
-
-Where __FILE__ appears in the string, the buffer-file-name of the current
-buffer, without the directory portion, will be substituted."
-  (interactive)
-  (or (file-exists-p "makefile")	;If there is a makefile, use it
-      (file-exists-p "Makefile")
-      (progn (make-local-variable 'compile-command)
-	     (setq compile-command
-		   (if (string-match "%s" (eval verilog-tool))
-		       (format (eval verilog-tool) (or buffer-file-name ""))
-		     (concat (eval verilog-tool) " " (or buffer-file-name ""))))))
-  (verilog-modify-compile-command))
-
-(defun verilog-modify-compile-command ()
-  "Replace meta-information in compile-command.
-Where __FILE__ appears in the string, the buffer-file-name of the current
-buffer, without the directory portion, will be substituted."
-  (when (string-match "\\b__FILE__\\b" compile-command)
-    (make-local-variable 'compile-command)
-    (setq compile-command
-	  (verilog-string-replace-matches
-	   "\\b__FILE__\\b" (file-name-nondirectory (buffer-file-name))
-	   t t compile-command))))
-
-(defun verilog-error-regexp-add ()
-  "Add the messages to the `compilation-error-regexp-alist'.
-Called by `compilation-mode-hook'.  This allows \\[next-error] to find the errors."
-  (if (not verilog-error-regexp-add-didit)
-      (progn
-	(setq verilog-error-regexp-add-didit t)
-	(setq-default compilation-error-regexp-alist
-		      (append (default-value 'compilation-error-regexp-alist)
-			      verilog-error-regexp))
-	;; Could be buffer local at this point; maybe also in let; change all three
-	(setq compilation-error-regexp-alist (default-value 'compilation-error-regexp-alist))
-	(set (make-local-variable 'compilation-error-regexp-alist)
-	     (default-value 'compilation-error-regexp-alist))
-	)))
-
-(add-hook 'compilation-mode-hook 'verilog-error-regexp-add)
-
-(defconst verilog-directive-re
-  ;; "`case" "`default" "`define" "`define" "`else" "`endfor" "`endif"
-  ;; "`endprotect" "`endswitch" "`endwhile" "`for" "`format" "`if" "`ifdef"
-  ;; "`ifndef" "`include" "`let" "`protect" "`switch" "`timescale"
-  ;; "`time_scale" "`undef" "`while"
-  "\\<`\\(case\\|def\\(ault\\|ine\\(\\)?\\)\\|e\\(lse\\|nd\\(for\\|if\\|protect\\|switch\\|while\\)\\)\\|for\\(mat\\)?\\|i\\(f\\(def\\|ndef\\)?\\|nclude\\)\\|let\\|protect\\|switch\\|time\\(_scale\\|scale\\)\\|undef\\|while\\)\\>")
-
-(defconst verilog-directive-begin
-  "\\<`\\(for\\|i\\(f\\|fdef\\|fndef\\)\\|switch\\|while\\)\\>")
-
-(defconst verilog-directive-middle
-  "\\<`\\(else\\|default\\|case\\)\\>")
-
-(defconst verilog-directive-end
-  "`\\(endfor\\|endif\\|endswitch\\|endwhile\\)\\>")
-
-(defconst verilog-directive-re-1
-  (concat "[ \t]*"  verilog-directive-re))
-
-;;
-;; Regular expressions used to calculate indent, etc.
-;;
-(defconst verilog-symbol-re      "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
-(defconst verilog-case-re        "\\(\\\\)")
-;; Want to match
-;; aa :
-;; aa,bb :
-;; a[34:32] :
-;; a,
-;;   b :
-(defconst
-  verilog-no-indent-begin-re
-  "\\<\\(if\\|else\\|while\\|for\\|repeat\\|always\\|always_comb\\|always_ff\\|always_latch\\)\\>")
-(defconst verilog-ends-re
-  (concat
-   "\\(\\\\)\\|"		; 1
-   "\\(\\\\)\\|"			; 2
-   "\\(\\\\)\\|"			; 3
-   "\\(\\\\)\\|"		; 4
-   "\\(\\\\)\\|"		; 5
-   "\\(\\\\)\\|"		; 6
-   "\\(\\\\)\\|"		; 7
-   "\\(\\\\)\\|"		; 8
-   "\\(\\\\)\\|"         ; 9
-   "\\(\\\\)" ; 10
-   ))
-
-(defconst verilog-autoindent-lines-re
-  ;; Matches to names in this list cause auto-end-commentation
-  ;;
-  ;; "macromodule" "module" "primitive" "interface" "end" "endcase" "endfunction"
-  ;; "endtask" "endmodule" "endprimitive" "endinterface" "endspecify" "endtable" "join"
-  ;; "begin" "else" "`else" "`ifdef" "`endif" "`define" "`undef" "`include"
-  (concat "\\("
-	  verilog-directive-re
-	  "\\|\\(\\\\|"
-	  "e\\(lse\\>\\|nd\\(\\>\\|case\\>\\|function\\>\\|module\\>\\|primitive\\>\\|interface\\>\\|package\\>"
-	  "\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)\\)\\|"
-	  "join\\(_any\\|_none\\)?\\>\\|m\\(acromodule\\>\\|odule\\>\\)\\|primitive\\>\\|interface\\>\\|package\\>\\)\\)" ))
-
-(defconst verilog-enders-re
-  (concat "\\(\\\\)\\|" ; 1
-	  "\\(\\\\)\\|"     ; 2
-	  "\\(\\\\)"))
-(defconst verilog-endcomment-reason-re
-  (concat
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\.*\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\(\[ \t\]*@\\)?\\)\\|"
-   "\\(\\\\(\[ \t\]*@\\)?\\)\\|"
-   "\\(\\\\(\[ \t\]*@\\)?\\)\\|"
-   "\\(\\\\(\[ \t\]*@\\)?\\)\\|"
-   "\\(@\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|"
-   "\\(\\\\)\\|\\(\\\\)\\|"
-   "#"))
-
-(defconst verilog-named-block-re  "begin[ \t]*:")
-(defconst verilog-beg-block-re
-  ;; "begin" "case" "casex" "fork" "casez" "table" "specify" "function" "task"
-  "\\(\\<\\(begin\\>\\|case\\(\\>\\|x\\>\\|z\\>\\)\\|generate\\|f\\(ork\\>\\|unction\\>\\)\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)\\)")
-
-(defconst verilog-beg-block-re-1
-  "\\<\\(begin\\)\\|\\(case[xz]?\\)\\|\\(fork\\)\\|\\(table\\)\\|\\(specify\\)\\|\\(function\\)\\|\\(task\\)\\|\\(generate\\)\\>")
-(defconst verilog-end-block-re
-  ;; "end" "join" "endcase" "endtable" "endspecify" "endtask" "endfunction" "endgenerate"
-  "\\<\\(end\\(\\>\\|case\\>\\|function\\>\\|generate\\>\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)\\|join\\(_any\\|_none\\)?\\>\\)")
-
-(defconst verilog-end-block-re-1 "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)")
-(defconst verilog-declaration-re
-  (eval-when-compile
-    (concat "\\<"
-	    (verilog-regexp-opt
-	     (list
-	      "assign" "defparam" "event" "inout" "input" "integer" "localparam" "output"
-	      "parameter" "real" "realtime" "reg" "supply" "supply0" "supply1" "time"
-	      "tri" "tri0" "tri1" "triand" "trior" "trireg" "wand" "wire" "typedef"
-	      "struct" "logic" "bit" "genvar" "wor") t )
-	    "\\>")))
-(defconst verilog-range-re "\\[[^]]*\\]")
-(defconst verilog-macroexp-re "`\\sw+")
-(defconst verilog-delay-re "#\\s-*\\(\\([0-9_]+\\('s?[hdxbo][0-9a-fA-F_xz]+\\)?\\)\\|\\(([^)]*)\\)\\|\\(\\sw+\\)\\)")
-(defconst verilog-declaration-re-2-no-macro
-  (concat "\\s-*" verilog-declaration-re
-	  "\\s-*\\(\\(" verilog-range-re "\\)\\|\\(" verilog-delay-re "\\)"
-;	  "\\|\\(" verilog-macroexp-re "\\)"
-	  "\\)?"))
-(defconst verilog-declaration-re-2-macro
-  (concat "\\s-*" verilog-declaration-re
-	  "\\s-*\\(\\(" verilog-range-re "\\)\\|\\(" verilog-delay-re "\\)"
-	  "\\|\\(" verilog-macroexp-re "\\)"
-	  "\\)?"))
-(defconst verilog-declaration-re-1-macro (concat "^" verilog-declaration-re-2-macro))
-(defconst verilog-declaration-re-1-no-macro (concat "^" verilog-declaration-re-2-no-macro))
-(defconst verilog-defun-re
-  ;;"module" "macromodule" "primitive"
-  "\\(\\<\\(m\\(acromodule\\>\\|odule\\>\\)\\|interface\\>\\|package\\>\\|primitive\\>\\)\\)")
-(defconst verilog-end-defun-re
-  ;; "endmodule" "endprimitive"
-"\\(\\\\|primitive\\>\\|interface\\>\\|package\\>\\)\\)")
-(defconst verilog-zero-indent-re
-  (concat verilog-defun-re "\\|" verilog-end-defun-re))
-(defconst verilog-directive-re
-  ;; "`case" "`default" "`define" "`define" "`else" "`endfor" "`endif"
-  ;; "`endprotect" "`endswitch" "`endwhile" "`for" "`format" "`if" "`ifdef"
-  ;; "`ifndef" "`include" "`let" "`protect" "`switch" "`timescale"
-  ;; "`time_scale" "`undef" "`while"
-  "\\<`\\(case\\|def\\(ault\\|ine\\(\\)?\\)\\|e\\(lse\\|nd\\(for\\|if\\|protect\\|switch\\|while\\)\\)\\|for\\(mat\\)?\\|i\\(f\\(def\\|ndef\\)?\\|nclude\\)\\|let\\|protect\\|switch\\|time\\(_scale\\|scale\\)\\|undef\\|while\\)\\>")
-
-(defconst verilog-directive-begin
-  "\\<`\\(for\\|i\\(f\\|fdef\\|fndef\\)\\|switch\\|while\\)\\>")
-
-(defconst verilog-directive-middle
-  "\\<`\\(else\\|default\\|case\\)\\>")
-
-(defconst verilog-directive-end
-  "`\\(endfor\\|endif\\|endswitch\\|endwhile\\)\\>")
-
-(defconst verilog-directive-re-1
-  (concat "[ \t]*"  verilog-directive-re))
-
-(defconst verilog-autoindent-lines-re
-  ;; "macromodule" "module" "primitive" "end" "endcase" "endfunction"
-  ;; "endtask" "endmodule" "endprimitive" "endspecify" "endtable" "join"
-  ;; "begin" "else" "`else" "`ifdef" "`endif" "`define" "`undef" "`include"
-  (concat "\\("
-	  verilog-directive-re
-	  "\\|\\(\\\\|e\\(lse\\>\\|nd\\(\\>\\|case\\>\\|function\\>\\|module\\>\\|primitive\\>\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)\\)\\|join\\>\\|m\\(acromodule\\>\\|odule\\>\\)\\|primitive\\>\\)\\)" ))
-
-(defconst verilog-behavioral-block-beg-re
-  (concat "\\(\\\\|\\\\|\\\\|\\\\|\\\\|"
-	  "\\\\|\\\\|\\\\)"))
-(defconst verilog-indent-reg
-  (concat
-   "\\(\\\\|\\\\|\\\\|\\\\|\\\\)\\|"
-   "\\(\\\\|\\\\|\\\\|\\\\|\\\\)\\|"
-   "\\(\\\\|\\\\|\\\\|\\\\|\\\\|\\\\|\\\\|"
-   "\\\\|\\\\|\\\\|\\\\)\\|"
-   "\\(\\\\|\\\\|\\\\|\\\\)\\|"
-   "\\(\\\\|\\\\)\\|"
-   "\\(\\\\|\\\\)\\|"
-   "\\(\\\\|\\\\)"
-   ;;	  "\\|\\(\\\\|\\\\)"
-   ))
-(defconst verilog-indent-re
-  (concat
-   "\\(\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\>\\|begin\\>\\|case\\(\\>\\|x\\>\\|z\\>\\)\\|"
-   "end\\(\\>\\|case\\>\\|function\\>\\|generate\\>\\|module\\>\\|primitive\\>\\|interface\\>\\|package\\>\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)"
-   "\\|f\\(ork\\>\\|unction\\>\\)\\|generate\\|initial\\>\\|join\\(_any\\|_none\\)?\\>\\|m\\(acromodule\\>\\|odule\\>\\)"
-   "\\|primitive\\>\\|interface\\>\\|package\\>\\|specify\\>\\|ta\\(ble\\>\\|sk\\>\\)\\)"
-   "\\|" verilog-directive-re "\\)"))
-
-(defconst verilog-defun-level-re
-  ;; "module" "macromodule" "primitive" "initial" "final" "always" "always_comb" "always_ff" "always_latch" "endtask" "endfunction"
-  "\\(\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\>\\|end\\(function\\>\\|task\\>\\)\\|final\\|initial\\>\\|m\\(acromodule\\>\\|odule\\>\\)\\|primitive\\>\\|interface\\>\\|package\\>\\)\\)")
-(defconst verilog-cpp-level-re
- ;;"endmodule" "endprimitive"
-  "\\(\\\\|primitive\\>\\|interface\\>\\|package\\>\\)\\)")
-(defconst verilog-behavioral-level-re
-  ;; "function" "task"
-  "\\(\\<\\(function\\>\\|task\\>\\)\\)")
-(defconst verilog-complete-reg
-  ;; "always" "always_latch" "always_ff" "always_comb" "initial" "final" "repeat" "case" "casex" "casez" "while" "if" "for" "forever" "else" "parameter"
-  "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|case\\(\\|[xz]\\)\\|begin\\|else\\|generate\\|for\\(\\|ever\\)\\|final\\|i\\(f\\|nitial\\)\\|parameter\\|repeat\\|while\\)\\>")
-(defconst verilog-end-statement-re
-  (concat "\\(" verilog-beg-block-re "\\)\\|\\("
-	  verilog-end-block-re "\\)"))
-(defconst verilog-endcase-re
-  (concat verilog-case-re "\\|"
-	  "\\(endcase\\)\\|"
-	  verilog-defun-re
-	  ))
-;; Strings used to mark beginning and end of excluded text
-(defconst verilog-exclude-str-start "/* -----\\/----- EXCLUDED -----\\/-----")
-(defconst verilog-exclude-str-end " -----/\\----- EXCLUDED -----/\\----- */")
-
-(defconst verilog-keywords
-  '( "`define" "`else" "`endif" "`ifdef"
-     "`include" "`timescale" "`undef" 
-     "alias" "always" "always_comb" "always_ff" "always_latch" "and"
-     "assert" "assign" "assume" "automatic" "before" "begin" "bind"
-     "bins" "binsof" "bit" "break" "buf" "bufif0" "bufif1" "byte"
-     "case" "casex" "casez" "cell" "chandle" "class" "clocking" "cmos"
-     "config" "const" "constraint" "context" "continue" "cover"
-     "covergroup" "coverpoint" "cross" "deassign" "default" "defparam"
-     "design" "disable" "dist" "do" "edge" "else" "end" "endcase"
-     "endclass" "endclocking" "endconfig" "endfunction" "endgenerate"
-     "endgroup" "endinterface" "endmodule" "endpackage" "endprimitive"
-     "endprogram" "endproperty" "endspecify" "endsequence" "endtable"
-     "endtask" "enum" "event" "expect" "export" "extends" "extern"
-     "final" "first_match" "for" "force" "foreach" "forever" "fork"
-     "forkjoin" "function" "generate" "genvar" "highz0" "highz1" "if"
-     "iff" "ifnone" "ignore_bins" "illegal_bins" "import" "incdir"
-     "include" "initial" "inout" "input" "inside" "instance" "int"
-     "integer" "interface" "intersect" "join" "join_any" "join_none"
-     "large" "liblist" "library" "local" "localparam" "logic"
-     "longint" "macromodule" "matches" "medium" "modport" "module"
-     "nand" "negedge" "new" "nmos" "nor" "noshowcancelled" "not"
-     "notif0" "notif1" "null" "or" "output" "package" "packed"
-     "parameter" "pmos" "posedge" "primitive" "priority" "program"
-     "property" "protected" "pull0" "pull1" "pulldown" "pullup"
-     "pulsestyle_onevent" "pulsestyle_ondetect" "pure" "rand" "randc"
-     "randcase" "randsequence" "rcmos" "real" "realtime" "ref" "reg"
-     "release" "repeat" "return" "rnmos" "rpmos" "rtran" "rtranif0"
-     "rtranif1" "scalared" "sequence" "shortint" "shortreal"
-     "showcancelled" "signed" "small" "solve" "specify" "specparam"
-     "static" "string" "strong0" "strong1" "struct" "super" "supply0"
-     "supply1" "table" "tagged" "task" "this" "throughout" "time"
-     "timeprecision" "timeunit" "tran" "tranif0" "tranif1" "tri"
-     "tri0" "tri1" "triand" "trior" "trireg" "type" "typedef" "union"
-     "unique" "unsigned" "use" "var" "vectored" "virtual" "void"
-     "wait" "wait_order" "wand" "weak0" "weak1" "while" "wildcard"
-     "wire" "with" "within" "wor" "xnor" "xor"
- )
- "List of Verilog keywords.")
-
-
-(defconst verilog-emacs-features
-  (let ((major (and (boundp 'emacs-major-version)
-		    emacs-major-version))
-	(minor (and (boundp 'emacs-minor-version)
-		    emacs-minor-version))
-	flavor comments flock-syntax)
-    ;; figure out version numbers if not already discovered
-    (and (or (not major) (not minor))
-	 (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
-	 (setq major (string-to-int (substring emacs-version
-					       (match-beginning 1)
-					       (match-end 1)))
-	       minor (string-to-int (substring emacs-version
-					       (match-beginning 2)
-					       (match-end 2)))))
-    (if (not (and major minor))
-	(error "Cannot figure out the major and minor version numbers"))
-    ;; calculate the major version
-    (cond
-     ((= major 4)  (setq major 'v18))	;Epoch 4
-     ((= major 18) (setq major 'v18))	;Emacs 18
-     ((= major 19) (setq major 'v19	;Emacs 19
-			 flavor (if (or (string-match "Lucid" emacs-version)
-					(string-match "XEmacs" emacs-version))
-				    'XEmacs 'FSF)))
-     ((> major 19) (setq major 'v20
-			 flavor (if (or (string-match "Lucid" emacs-version)
-					(string-match "XEmacs" emacs-version))
-				    'XEmacs 'FSF)))
-     ;; I don't know
-     (t (error "Cannot recognize major version number: %s" major)))
-    ;; XEmacs 19 uses 8-bit modify-syntax-entry flags, as do all
-    ;; patched Emacs 19, Emacs 18, Epoch 4's.  Only Emacs 19 uses a
-    ;; 1-bit flag.  Let's be as smart as we can about figuring this
-    ;; out.
-    (if (or (eq major 'v20) (eq major 'v19))
-	(let ((table (copy-syntax-table)))
-	  (modify-syntax-entry ?a ". 12345678" table)
-	  (cond
-	   ;; XEmacs pre 20 and Emacs pre 19.30 use vectors for syntax tables.
-	   ((vectorp table)
-	    (if (= (logand (lsh (aref table ?a) -16) 255) 255)
-		(setq comments '8-bit)
-	      (setq comments '1-bit)))
-	   ;; XEmacs 20 is known to be 8-bit
-	   ((eq flavor 'XEmacs) (setq comments '8-bit))
-	   ;; Emacs 19.30 and beyond are known to be 1-bit
-	   ((eq flavor 'FSF) (setq comments '1-bit))
-	   ;; Don't know what this is
-	   (t (error "Couldn't figure out syntax table format"))
-	   ))
-      ;; Emacs 18 has no support for dual comments
-      (setq comments 'no-dual-comments))
-    ;; determine whether to use old or new font lock syntax
-    ;; We can assume 8-bit syntax table emacsen aupport new syntax, otherwise
-    ;; look for version > 19.30
-    (setq flock-syntax
-        (if (or (equal comments '8-bit)
-                (equal major 'v20)
-                (and (equal major 'v19) (> minor 30)))
-            'flock-syntax-after-1930
-          'flock-syntax-before-1930))
-    ;; lets do some minimal sanity checking.
-    (if (or
-	 ;; Lemacs before 19.6 had bugs
-	 (and (eq major 'v19) (eq flavor 'XEmacs) (< minor 6))
-	 ;; Emacs 19 before 19.21 has known bugs
-	 (and (eq major 'v19) (eq flavor 'FSF) (< minor 21))
-	 )
-	(with-output-to-temp-buffer "*verilog-mode warnings*"
-	  (print (format
-"The version of Emacs that you are running, %s,
-has known bugs in its syntax parsing routines which will affect the
-performance of verilog-mode. You should strongly consider upgrading to the
-latest available version.  verilog-mode may continue to work, after a
-fashion, but strange indentation errors could be encountered."
-		     emacs-version))))
-    ;; Emacs 18, with no patch is not too good
-    (if (and (eq major 'v18) (eq comments 'no-dual-comments))
-	(with-output-to-temp-buffer "*verilog-mode warnings*"
-	  (print (format
-"The version of Emacs 18 you are running, %s,
-has known deficiencies in its ability to handle the dual verilog
-(and C++) comments, (e.g. the // and /* */ comments). This will
-not be much of a problem for you if you only use the /* */ comments,
-but you really should strongly consider upgrading to one of the latest
-Emacs 19's.  In Emacs 18, you may also experience performance degradations.
-Emacs 19 has some new built-in routines which will speed things up for you.
-Because of these inherent problems, verilog-mode is not supported
-on emacs-18."
-			    emacs-version))))
-    ;; Emacs 18 with the syntax patches are no longer supported
-    (if (and (eq major 'v18) (not (eq comments 'no-dual-comments)))
-	(with-output-to-temp-buffer "*verilog-mode warnings*"
-	  (print (format
-"You are running a syntax patched Emacs 18 variant.  While this should
-work for you, you may want to consider upgrading to Emacs 19.
-The syntax patches are no longer supported either for verilog-mode."))))
-    (list major comments flock-syntax))
-  "A list of features extant in the Emacs you are using.
-There are many flavors of Emacs out there, each with different
-features supporting those needed by `verilog-mode'.  Here's the current
-supported list, along with the values for this variable:
-
- Vanilla Emacs 18/Epoch 4:   (v18 no-dual-comments flock-syntax-before-1930)
- Emacs 18/Epoch 4 (patch2):  (v18 8-bit flock-syntax-after-1930)
- XEmacs (formerly Lucid) 19: (v19 8-bit flock-syntax-after-1930)
- XEmacs 20:                  (v20 8-bit flock-syntax-after-1930)
- Emacs 19.1-19.30:           (v19 8-bit flock-syntax-before-1930)
- Emacs 19.31-19.xx:          (v19 8-bit flock-syntax-after-1930)
- Emacs20        :            (v20 1-bit flock-syntax-after-1930).")
-
-(defconst verilog-comment-start-regexp "//\\|/\\*"
-  "Dual comment value for `comment-start-regexp'.")
-
-(defun verilog-populate-syntax-table (table)
-  "Populate the 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 ?` "w" table)
-  (modify-syntax-entry ?_ "w" table)
-  (modify-syntax-entry ?\' "." table)
-)
-
-(defun verilog-setup-dual-comments (table)
-  "Set up TABLE to handle block and line style comments."
-  (cond
-   ((memq '8-bit verilog-emacs-features)
-    ;; XEmacs (formerly Lucid) has the best implementation
-    (modify-syntax-entry ?/  ". 1456" table)
-    (modify-syntax-entry ?*  ". 23"   table)
-    (modify-syntax-entry ?\n "> b"    table)
-    )
-   ((memq '1-bit verilog-emacs-features)
-    ;; Emacs 19 does things differently, but we can work with it
-    (modify-syntax-entry ?/  ". 124b" table)
-    (modify-syntax-entry ?*  ". 23"   table)
-    (modify-syntax-entry ?\n "> b"    table)
-    )
-   ))
-
-(defvar verilog-mode-syntax-table nil
-  "Syntax table used in `verilog-mode' buffers.")
-
-(defconst verilog-font-lock-keywords nil
-  "Default highlighting for Verilog mode.")
-
-(defconst verilog-font-lock-keywords-1 nil
-  "Subdued level highlighting for Verilog mode.")
-
-(defconst verilog-font-lock-keywords-2 nil
-  "Medium level highlighting for Verilog mode.
-See also `verilog-font-lock-extra-types'.")
-
-(defconst verilog-font-lock-keywords-3 nil
-  "Gaudy level highlighting for Verilog mode.
-See also `verilog-font-lock-extra-types'.")
-(defvar
-  verilog-font-lock-translate-off-face
-  'verilog-font-lock-translate-off-face
-  "Font to use for translated off regions")
-(defface verilog-font-lock-translate-off-face
-  '((((class color)
-      (background light))
-     (:background "gray90" :italic t ))
-    (((class color)
-      (background dark))
-     (:background "gray10" :italic t ))
-    (((class grayscale) (background light))
-     (:foreground "DimGray" :italic t))
-    (((class grayscale) (background dark))
-     (:foreground "LightGray" :italic t))
-    (t (:italis t)))
-  "Font lock mode face used to background highlight translate-off regions."
-  :group 'font-lock-highlighting-faces)
-
-(defvar
-  verilog-font-lock-p1800-face
-  'verilog-font-lock-p1800-face
-  "Font to use for p1800 keywords")
-(defface verilog-font-p1800-face
-  '((((class color)
-      (background light))
-     (:foreground "DarkOrange3" :bold t ))
-    (((class color)
-      (background dark))
-     (:foreground "gray10" :bold t ))
-    (t (:italic t)))
-  "Font lock mode face used to highlight P1800 keywords."
-  :group 'font-lock-highlighting-faces)
-
-(let* ((verilog-type-font-keywords
-	(eval-when-compile
-	  (verilog-regexp-opt
-	   '(
-	     "and" "bit" "buf" "bufif0" "bufif1" "cmos" "defparam"
-	     "event" "genvar" "inout" "input" "integer" "localparam"
-	     "logic" "nand" "nmos" "not" "notif0" "notif1" "or"
-	     "output" "parameter" "pmos" "pull0" "pull1" "pullup"
-	     "rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran"
-	     "rtranif0" "rtranif1" "signed" "struct" "supply"
-	     "supply0" "supply1" "time" "tran" "tranif0" "tranif1"
-	     "tri" "tri0" "tri1" "triand" "trior" "trireg" "typedef"
-	     "vectored" "wand" "wire" "wor" "xnor" "xor"
-	     ) nil  )))
-
-       (verilog-pragma-keywords
-	(eval-when-compile
-	  (verilog-regexp-opt
-	   '("surefire" "synopsys" "rtl_synthesis" "verilint" ) nil
-	    )))
-
-       (verilog-p1800-keywords
-	(eval-when-compile
-	  (verilog-regexp-opt
-	   '("alias" "assert" "assume" "automatic" "before" "bind"
-	     "bins" "binsof" "break" "byte" "cell" "chandle" "class"
-	     "clocking" "config" "const" "constraint" "context" "continue"
-	     "cover" "covergroup" "coverpoint" "cross" "deassign" "design"
-	     "dist" "do" "edge" "endclass" "endclocking" "endconfig"
-	     "endgroup" "endprogram" "endproperty" "endsequence" "enum"
-	     "expect" "export" "extends" "extern" "first_match" "foreach"
-	     "forkjoin" "genvar" "highz0" "highz1" "ifnone" "ignore_bins"
-	     "illegal_bins" "import" "incdir" "include" "inside" "instance"
-	     "int" "intersect" "large" "liblist" "library" "local" "longint"
-	     "matches" "medium" "modport" "new" "noshowcancelled" "null"
-	     "packed" "program" "property" "protected" "pull0" "pull1"
-	     "pulsestyle_onevent" "pulsestyle_ondetect" "pure" "rand" "randc"
-	     "randcase" "randsequence" "ref" "release" "return" "scalared"
-	     "sequence" "shortint" "shortreal" "showcancelled" "small" "solve"
-	     "specparam" "static" "string" "strong0" "strong1" "struct"
-	     "super" "tagged" "this" "throughout" "timeprecision" "timeunit"
-	     "type" "union" "unsigned" "use" "var" "virtual" "void"
-	     "wait_order" "weak0" "weak1" "wildcard" "with" "within"
-	     ) nil )))
-
-
-       (verilog-font-keywords
-	(eval-when-compile
-	  (verilog-regexp-opt
-	   '(
-	     "assign" "begin" "case" "casex" "casez" "deassign"
-	     "default" "disable" "else" "end" "endcase" "endfunction"
-	     "endgenerate" "endinterface" "endmodule" "endprimitive"
-	     "endspecify" "endtable" "endtask" "final" "for" "force" "return" "break" "continue"
-	     "forever" "fork" "function" "generate" "if" "iff" "initial"
-	     "interface" "join" "join_any" "join_none" "macromodule" "module" "negedge"
-	     "package" "endpackage" "always" "always_comb" "always_ff"
-	     "always_latch" "posedge" "primitive" "priority" "release"
-	     "repeat" "specify" "table" "task" "unique" "wait" "while"
-
-	     ) nil  ))))
-
-  (setq verilog-font-lock-keywords
-	(list
-	 ;; Fontify all builtin keywords
-	 (concat "\\<\\(" verilog-font-keywords "\\|"
-		       ;; And user/system tasks and functions
-		       "\\$[a-zA-Z][a-zA-Z0-9_\\$]*"
-		       "\\)\\>")
-	 ;; Fontify all types
-	 (cons (concat "\\<\\(" verilog-type-font-keywords "\\)\\>")
-	       'font-lock-type-face)
-	 ;; Fontify IEEE-P1800 keywords
-	 (cons (concat "\\<\\(" verilog-p1800-keywords "\\)\\>")
-	       'verilog-font-p1800-face)
-
-	 ))
-
-  (setq verilog-font-lock-keywords-1
-	(append verilog-font-lock-keywords
-		(list
-		 ;; Fontify module definitions
-		 (list
-		  "\\<\\(\\(macro\\)?module\\|primitive\\|interface\\|package\\|task\\)\\>\\s-*\\(\\sw+\\)"
-		  '(1 font-lock-keyword-face)
-		  '(3 font-lock-function-name-face 'prepend))
-		 ;; Fontify function definitions
-		 (list
-		  (concat "\\\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" )
-		       '(1 font-lock-keyword-face)
-		       '(3 font-lock-reference-face prepend)
-		       )
-		 '("\\\\s-+\\(\\[[^]]+\\]\\)\\s-+\\(\\sw+\\)"
-		   (1 font-lock-keyword-face)
-		   (2 font-lock-reference-face append)
-		   )
-		 '("\\\\s-+\\(\\sw+\\)"
-		   1 'font-lock-reference-face append)
-		 )))
-
-  (setq verilog-font-lock-keywords-2
-	(append verilog-font-lock-keywords-1
-		(list
-		 ;; Fontify pragmas
-		 (concat "\\(//\\s-*" verilog-pragma-keywords "\\s-.*\\)")
-		 ;; Fontify escaped names
-		 '("\\(\\\\\\S-*\\s-\\)"  0 font-lock-function-name-face)
-		 ;; Fontify macro definitions/ uses
-		 '("`\\s-*[A-Za-z][A-Za-z0-9_]*" 0 font-lock-function-name-face)
-		 ;; Fontify delays/numbers
-		 '("\\(@\\)\\|\\(#\\s-*\\(\\(\[0-9_.\]+\\('s?[hdxbo][0-9a-fA-F_xz]*\\)?\\)\\|\\(([^)]+)\\|\\sw+\\)\\)\\)"
-		   0 font-lock-type-face append)
-		 )))
-
-  (setq verilog-font-lock-keywords-3
-	(append verilog-font-lock-keywords-2
-		(when verilog-highlight-translate-off
-		  (list
-		   ;; Fontify things in translate off regions
-		   '(verilog-match-translate-off (0 'verilog-font-lock-translate-off-face prepend))
-		   )))
-  )
-  )
-
-
-;;
-;;  Macros
-;;
-
-(defsubst verilog-string-replace-matches (from-string to-string fixedcase literal string)
-  "Replace occurrences of FROM-STRING with TO-STRING.
-FIXEDCASE and LITERAL as in `replace-match`.  STRING is what to replace.
-The case (verilog-string-replace-matches \"o\" \"oo\" nil nil \"foobar\")
-will break, as the o's continuously replace.  xa -> x works ok though."
-  ;; Hopefully soon to a emacs built-in
-  (let ((start 0))
-    (while (string-match from-string string start)
-      (setq string (replace-match to-string fixedcase literal string)
-	    start (min (length string) (match-end 0))))
-    string))
-
-(defsubst verilog-string-remove-spaces (string)
-  "Remove spaces surrounding STRING."
-  (save-match-data
-    (setq string (verilog-string-replace-matches "^\\s-+" "" nil nil string))
-    (setq string (verilog-string-replace-matches "\\s-+$" "" nil nil string))
-    string))
-
-(defsubst verilog-re-search-forward (REGEXP BOUND NOERROR)
-  ; checkdoc-params: (REGEXP BOUND NOERROR)
-  "Like `re-search-forward', but skips over match in comments or strings."
-  (store-match-data '(nil nil))
-  (while (and
-	  (re-search-forward REGEXP BOUND NOERROR)
-	  (and (verilog-skip-forward-comment-or-string)
-	       (progn
-		 (store-match-data '(nil nil))
-		 (if BOUND
-		     (< (point) BOUND)
-		   t)
-		 ))))
-  (match-end 0))
-
-(defsubst verilog-re-search-backward (REGEXP BOUND NOERROR)
-  ; checkdoc-params: (REGEXP BOUND NOERROR)
-  "Like `re-search-backward', but skips over match in comments or strings."
-  (store-match-data '(nil nil))
-  (while (and
-	  (re-search-backward REGEXP BOUND NOERROR)
-	  (and (verilog-skip-backward-comment-or-string)
-	       (progn
-		 (store-match-data '(nil nil))
-		 (if BOUND
-		     (> (point) BOUND)
-		   t)
-		 ))))
-  (match-end 0))
-
-(defsubst verilog-re-search-forward-quick (regexp bound noerror)
-  "Like `verilog-re-search-forward', including use of REGEXP BOUND and NOERROR,
-but trashes match data and is faster for REGEXP that doesn't match often.
-This may at some point use text properties to ignore comments,
-so there may be a large up front penalty for the first search."
-  (let (pt)
-    (while (and (not pt)
-		(re-search-forward regexp bound noerror))
-      (if (not (verilog-inside-comment-p))
-	  (setq pt (match-end 0))))
-    pt))
-
-(defsubst verilog-re-search-backward-quick (regexp bound noerror)
-  ; checkdoc-params: (REGEXP BOUND NOERROR)
-  "Like `verilog-re-search-backward', including use of REGEXP BOUND and NOERROR,
-but trashes match data and is faster for REGEXP that doesn't match often.
-This may at some point use text properties to ignore comments,
-so there may be a large up front penalty for the first search."
-  (let (pt)
-    (while (and (not pt)
-		(re-search-backward regexp bound noerror))
-      (if (not (verilog-inside-comment-p))
-	  (setq pt (match-end 0))))
-    pt))
-
-(defsubst verilog-get-beg-of-line (&optional arg)
-  (save-excursion
-    (beginning-of-line arg)
-    (point)))
-
-(defsubst verilog-get-end-of-line (&optional arg)
-  (save-excursion
-    (end-of-line arg)
-    (point)))
-
-(defun verilog-inside-comment-p ()
-  "Check if point inside a nested comment."
-  (save-excursion
-    (let ((st-point (point)) hitbeg)
-      (or (search-backward "//" (verilog-get-beg-of-line) t)
-	  (if (progn
-		;; This is for tricky case //*, we keep searching if /* is proceeded by // on same line
-		(while (and (setq hitbeg (search-backward "/*" nil t))
-			    (progn (forward-char 1) (search-backward "//" (verilog-get-beg-of-line) t))))
-		hitbeg)
-	      (not (search-forward "*/" st-point t)))))))
-
-(defun verilog-declaration-end ()
-  (search-forward ";"))
-
-(defun verilog-point-text (&optional pointnum)
-  "Return text describing where POINTNUM or current point is (for errors).
-Use filename, if current buffer being edited shorten to just buffer name."
-  (concat (or (and (equal (window-buffer (selected-window)) (current-buffer))
-		   (buffer-name))
-	      buffer-file-name
-	      (buffer-name))
-	  ":" (int-to-string (count-lines (point-min) (or pointnum (point))))))
-
-(defun electric-verilog-backward-sexp ()
-  "Move backward over a sexp."
-  (interactive)
-  ;; before that see if we are in a comment
-  (verilog-backward-sexp)
-)
-(defun electric-verilog-forward-sexp ()
-  "Move backward over a sexp."
-  (interactive)
-  ;; before that see if we are in a comment
-  (verilog-forward-sexp)
-)
-
-(defun verilog-backward-sexp ()
-  (let ((reg)
-	(elsec 1)
-	(found nil)
-	(st (point))
-	)
-    (if (not (looking-at "\\<"))
-	(forward-word -1))
-    (cond
-     ((verilog-skip-backward-comment-or-string)
-      )
-     ((looking-at "\\")
-      (setq reg (concat
-		 verilog-end-block-re
-		 "\\|\\(\\\\)"
-		 "\\|\\(\\\\)"
-		 ))
-      (while (and (not found)
-		  (verilog-re-search-backward reg nil 'move))
-	(cond
-	 ((match-end 1) ; endblock
-	; try to leap back to matching outward block by striding across
-	; indent level changing tokens then immediately
-	; previous line governs indentation.
-	  (verilog-leap-to-head))
-	 ((match-end 2) ; else, we're in deep
-	  (setq elsec (1+ elsec)))
-	 ((match-end 3) ; found it
-	  (setq elsec (1- elsec))
-	  (if (= 0 elsec)
-	      ;; Now previous line describes syntax
-	      (setq found 't)
-	    ))
-	 )
-	)
-      )
-     ((looking-at verilog-end-block-re)
-      (verilog-leap-to-head))
-     ((looking-at "\\(endmodule\\>\\)\\|\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)")
-      (cond
-       ((match-end 1)
-	(verilog-re-search-backward "\\<\\(macro\\)?module\\>" nil 'move))
-       ((match-end 2)
-	(verilog-re-search-backward "\\" nil 'move))
-       ((match-end 3)
-	(verilog-re-search-backward "\\" nil 'move))
-       ((match-end 4)
-	(verilog-re-search-backward "\\" nil 'move))
-       (t
-	(goto-char st)
-	(backward-sexp 1))))
-     (t
-      (goto-char st)
-      (backward-sexp))
-     ) ;; cond
-    ))
-
-(defun verilog-forward-sexp ()
-  (let ((reg)
-	(st (point)))
-    (if (not (looking-at "\\<"))
-	(forward-word -1))
-    (cond
-     ((verilog-skip-forward-comment-or-string)
-      (verilog-forward-syntactic-ws)
-      )
-     ((looking-at verilog-beg-block-re-1);; begin|case|fork|table|specify|function|task|generate
-      (cond
-       ((match-end 1) ; end
-	;; Search forward for matching begin
-	(setq reg "\\(\\\\)\\|\\(\\\\)" ))
-       ((match-end 2) ; endcase
-	;; Search forward for matching case
-	(setq reg "\\(\\[^:]\\)\\|\\(\\\\)" ))
-       ((match-end 3) ; join
-	;; Search forward for matching fork
-	(setq reg "\\(\\\\)\\|\\(\\\\)" ))
-       ((match-end 4) ; endtable
-	;; Search forward for matching table
-	(setq reg "\\(\\\\)\\|\\(\\\\)" ))
-       ((match-end 5) ; endspecify
-	;; Search forward for matching specify
-	(setq reg "\\(\\\\)\\|\\(\\\\)" ))
-       ((match-end 6) ; endfunction
-	;; Search forward for matching function
-	(setq reg "\\(\\\\)\\|\\(\\\\)" ))
-       ((match-end 7) ; endspecify
-	;; Search forward for matching task
-	(setq reg "\\(\\\\)\\|\\(\\\\)" ))
-       ((match-end 8) ; endgenerate
-	;; Search forward for matching generate
-	(setq reg "\\(\\\\)\\|\\(\\\\)" ))
-       )
-      (if (forward-word 1)
-	  (catch 'skip
-	    (let ((nest 1))
-	      (while (verilog-re-search-forward reg nil 'move)
-		(cond
-		 ((match-end 2) ; end
-		  (setq nest (1- nest))
-		  (if (= 0 nest)
-		      (throw 'skip 1)))
-		 ((match-end 1) ; begin
-		  (setq nest (1+ nest)))))
-	      )))
-      )
-     ((looking-at "\\(\\<\\(macro\\)?module\\>\\)\\|\\(\\\\)\\|\\\\)\\|\\(\\\\)")
-      (cond
-       ((match-end 1)
-	(verilog-re-search-forward "\\" nil 'move))
-       ((match-end 2)
-	(verilog-re-search-forward "\\" nil 'move))
-       ((match-end 3)
-	(verilog-re-search-forward "\\" nil 'move))
-       ((match-end 4)
-	(verilog-re-search-forward "\\" nil 'move))
-       (t
-	(goto-char st)
-	(if (= (following-char) ?\) )
-	    (forward-char 1)
-	  (forward-sexp 1)))))
-     (t
-      (goto-char st)
-      (if (= (following-char) ?\) )
-	  (forward-char 1)
-	(forward-sexp 1)))
-     ) ;; cond
-    ))
-
-(defun verilog-declaration-beg ()
-  (verilog-re-search-backward verilog-declaration-re (bobp) t))
-
-(defsubst verilog-within-string ()
-  (save-excursion
-    (nth 3 (parse-partial-sexp (verilog-get-beg-of-line) (point)))))
-
-(require 'font-lock)
-(defvar verilog-need-fld 1)
-(defvar font-lock-defaults-alist nil)	;In case we are XEmacs
-
-(defun verilog-font-lock-init ()
-  "Initialize fontification."
-  ;; highlight keywords and standardized types, attributes, enumeration
-  ;; values, and subprograms
-  (setq verilog-font-lock-keywords-3
-	(append verilog-font-lock-keywords-2
-		(when verilog-highlight-translate-off
-		  (list
-		   ;; Fontify things in translate off regions
-		   '(verilog-match-translate-off (0 'verilog-font-lock-translate-off-face prepend))
-		   ))
-	)
-  )
-  (put 'verilog-mode 'font-lock-defaults
-       '((verilog-font-lock-keywords
-	  verilog-font-lock-keywords-1
-	  verilog-font-lock-keywords-2
-	  verilog-font-lock-keywords-3
-	  )
-	 nil ;; nil means highlight strings & comments as well as keywords
-	 nil ;; nil means keywords must match case
-	 nil ;; syntax table handled elsewhere
-	 verilog-beg-of-defun ;; function to move to beginning of reasonable region to highlight
-	 ))
-  (if verilog-need-fld
-      (let ((verilog-mode-defaults
-	     '((verilog-font-lock-keywords
-		verilog-font-lock-keywords-1
-		verilog-font-lock-keywords-2
-		verilog-font-lock-keywords-3
-		)
-	       nil ;; nil means highlight strings & comments as well as keywords
-	       nil ;; nil means keywords must match case
-	       nil ;; syntax table handled elsewhere
-	       verilog-beg-of-defun ;; function to move to beginning of reasonable region to highlight
-	       )))
-	(setq font-lock-defaults-alist
-	      (append
-	       font-lock-defaults-alist
-	       (list (cons 'verilog-mode  verilog-mode-defaults))))
-	(setq verilog-need-fld 0))))
-
-;; initialize fontification for Verilog Mode
-(verilog-font-lock-init)
-
-
-;;
-;;
-;;  Mode
-;;
-
-;;;###autoload
-(defun verilog-mode ()
-"Major mode for editing Verilog code.
-\\
-
-NEWLINE, TAB indents for Verilog code.
-Delete converts tabs to spaces as it moves back.
-Supports highlighting.
-
-Variables controlling indentation/edit style:
-
- variable `verilog-indent-level'      (default 3)
-    Indentation of Verilog statements with respect to containing block.
- `verilog-indent-level-module'        (default 3)
-    Absolute indentation of Module level Verilog statements.
-    Set to 0 to get initial and always statements lined up
-    on the left side of your screen.
- `verilog-indent-level-declaration'   (default 3)
-    Indentation of declarations with respect to containing block.
-    Set to 0 to get them list right under containing block.
- `verilog-indent-level-behavioral'    (default 3)
-    Indentation of first begin in a task or function block
-    Set to 0 to get such code to lined up underneath the task or function keyword
- `verilog-indent-level-directive'     (default 1)
-    Indentation of `ifdef/`endif blocks
- `verilog-cexp-indent'              (default 1)
-    Indentation of Verilog statements broken across lines i.e.:
-    if (a)
-     begin
- `verilog-case-indent'              (default 2)
-    Indentation for case statements.
- `verilog-auto-newline'             (default nil)
-    Non-nil means automatically newline after semicolons and the punctuation
-    mark after an end.
- `verilog-auto-indent-on-newline'   (default t)
-    Non-nil means automatically indent line after newline
- `verilog-tab-always-indent'        (default t)
-    Non-nil means TAB in Verilog mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- `verilog-indent-begin-after-if'    (default t)
-    Non-nil means to indent begin statements following a preceding
-    if, else, while, for and repeat statements, if any.  otherwise,
-    the begin is lined up with the preceding token.  If t, you get:
-      if (a)
-         begin // amount of indent based on `verilog-cexp-indent'
-    otherwise you get:
-      if (a)
-      begin
- `verilog-auto-endcomments'         (default t)
-    Non-nil means a comment /* ... */ is set after the ends which ends
-      cases, tasks, functions and modules.
-    The type and name of the object will be set between the braces.
- `verilog-minimum-comment-distance' (default 10)
-    Minimum distance (in lines) between begin and end required before a comment
-    will be inserted.  Setting this variable to zero results in every
-    end acquiring a comment; the default avoids too many redundant
-    comments in tight quarters.
- `verilog-auto-lineup'              (default `(all))
-    List of contexts where auto lineup of :'s or ='s should be done.
-
-Turning on Verilog mode calls the value of the variable `verilog-mode-hook' with
-no args, if that value is non-nil.
-Other useful functions are:
-\\[verilog-complete-word]\t-complete word with appropriate possibilities
-   (functions, verilog keywords...)
-\\[verilog-comment-region]\t- Put marked area in a comment, fixing
-   nested comments.
-\\[verilog-uncomment-region]\t- Uncomment an area commented with \
-\\[verilog-comment-region].
-\\[verilog-insert-block]\t- insert begin ... end;
-\\[verilog-star-comment]\t- insert /* ... */
-\\[verilog-mark-defun]\t- Mark function.
-\\[verilog-beg-of-defun]\t- Move to beginning of current function.
-\\[verilog-end-of-defun]\t- Move to end of current function.
-\\[verilog-label-be]\t- Label matching begin ... end, fork ... join
-  and case ... endcase statements;
-
-\\[verilog-sk-always]  Insert a always @(AS) begin .. end block
-\\[verilog-sk-begin]  Insert a begin .. end block
-\\[verilog-sk-case]  Insert a case block, prompting for details
-\\[verilog-sk-else]  Insert an else begin .. end block
-\\[verilog-sk-for]  Insert a for (...) begin .. end block, prompting for details
-\\[verilog-sk-generate]  Insert a generate .. endgenerate block
-\\[verilog-sk-header]  Insert a nice header block at the top of file
-\\[verilog-sk-initial]  Insert an initial begin .. end block
-\\[verilog-sk-fork]  Insert a fork begin .. end .. join block
-\\[verilog-sk-module]  Insert a module .. (/*AUTOARG*/);.. endmodule block
-\\[verilog-sk-primitive]  Insert a primitive .. (.. );.. endprimitive block
-\\[verilog-sk-interface]  Insert an interface .. (.. );.. endinterface block
-\\[verilog-sk-repeat]  Insert a repeat (..) begin .. end block
-\\[verilog-sk-specify]  Insert a specify .. endspecify block
-\\[verilog-sk-task]  Insert a task .. begin .. end endtask block
-\\[verilog-sk-while]  Insert a while (...) begin .. end block, prompting for details
-\\[verilog-sk-casex]  Insert a casex (...) item: begin.. end endcase block, prompting for details
-\\[verilog-sk-casez]  Insert a casez (...) item: begin.. end endcase block, prompting for details
-\\[verilog-sk-if]  Insert an if (..) begin .. end block
-\\[verilog-sk-else-if]  Insert an else if (..) begin .. end block
-\\[verilog-sk-comment]  Insert a comment block
-\\[verilog-sk-assign]  Insert an assign .. = ..; statement
-\\[verilog-sk-function]  Insert a function .. begin .. end endfunction block
-\\[verilog-sk-input]  Insert an input declaration, prompting for details
-\\[verilog-sk-output]  Insert an output declaration, prompting for details
-\\[verilog-sk-state-machine]  Insert a state machine definition, prompting for details!
-\\[verilog-sk-inout]  Insert an inout declaration, prompting for details
-\\[verilog-sk-wire]  Insert a wire declaration, prompting for details
-\\[verilog-sk-reg]  Insert a register declaration, prompting for details"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map verilog-mode-map)
-  (setq major-mode 'verilog-mode)
-  (setq mode-name "Verilog")
-  (setq local-abbrev-table verilog-mode-abbrev-table)
-  (setq verilog-mode-syntax-table (make-syntax-table))
-  (verilog-populate-syntax-table verilog-mode-syntax-table)
-  ;; add extra comment syntax
-  (verilog-setup-dual-comments verilog-mode-syntax-table)
-  (set-syntax-table verilog-mode-syntax-table)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'verilog-indent-line-relative)
-  (setq comment-indent-function 'verilog-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments nil)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-end)
-  (make-local-variable 'comment-multi-line)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start "// "
-	comment-end ""
-	comment-start-skip "/\\*+ *\\|// *"
-	comment-multi-line nil)
-  ;; Set up for compilation
-  (setq verilog-which-tool 1)
-  (setq verilog-tool 'verilog-linter)
-  (verilog-set-compile-command)
-  (when (boundp 'hack-local-variables-hook)  ;; Also modify any file-local-variables
-    (add-hook 'hack-local-variables-hook 'verilog-modify-compile-command t))
-
-  ;; Setting up things for font-lock
-  (if verilog-running-on-xemacs
-      (progn
-        (if (and current-menubar
-                 (not (assoc "Verilog" current-menubar)))
-            (progn
-             ;; (set-buffer-menubar (copy-sequence current-menubar))
-              (add-submenu nil verilog-xemacs-menu))) ))
-  ;; Stuff for GNU emacs
-  (make-local-variable 'font-lock-defaults)
-  ;;------------------------------------------------------------
-  ;; now hook in 'verilog-colorize-include-files (eldo-mode.el&spice-mode.el)
-  ;; all buffer local:
-  (make-local-hook 'font-lock-mode-hook)
-  (make-local-hook 'font-lock-after-fontify-buffer-hook); doesn't exist in emacs 20
-  (add-hook 'font-lock-mode-hook 'verilog-colorize-include-files-buffer t t)
-  (add-hook 'font-lock-after-fontify-buffer-hook 'verilog-colorize-include-files-buffer t t) ; not in emacs 20
-  (make-local-hook 'after-change-functions)
-  (add-hook 'after-change-functions 'verilog-colorize-include-files t t)
-
-  ;; Tell imenu how to handle verilog.
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression verilog-imenu-generic-expression)
-  ;; Stuff for autos
-  (add-hook 'write-contents-hooks 'verilog-auto-save-check) ; already local
-  (verilog-auto-reeval-locals t)   ; Save locals in case user changes them
-  (run-hooks 'verilog-mode-hook))
-
-
-;;
-;;  Electric functions
-;;
-(defun electric-verilog-terminate-line (&optional arg)
-  "Terminate line and indent next line.
-With optional ARG, remove existing end of line comments."
-  (interactive)
-  ;; before that see if we are in a comment
-  (let ((state
-	 (save-excursion
-	   (parse-partial-sexp (point-min) (point)))))
-    (cond
-     ((nth 7 state)			; Inside // comment
-      (if (eolp)
-	  (progn
-	    (delete-horizontal-space)
-	    (newline))
-	(progn
-	  (newline)
-	  (insert-string "// ")
-	  (beginning-of-line)))
-      (verilog-indent-line))
-     ((nth 4 state)			; Inside any comment (hence /**/)
-      (newline)
-      (verilog-more-comment))
-     ((eolp)
-       ;; First, check if current line should be indented
-       (if (save-excursion
-             (delete-horizontal-space)
-	     (beginning-of-line)
-	     (skip-chars-forward " \t")
-	     (if (looking-at verilog-autoindent-lines-re)
-		 (let ((indent-str (verilog-indent-line)))
-		   ;; Maybe we should set some endcomments
-		   (if verilog-auto-endcomments
-		       (verilog-set-auto-endcomments indent-str arg))
-		   (end-of-line)
-		   (delete-horizontal-space)
-		   (if arg
-		       ()
-		     (newline))
-		   nil)
-	       (progn
-		 (end-of-line)
-		 (delete-horizontal-space)
-		 't
-		 )))
-	   (newline)
-	 (forward-line 1)
-	 )
-       ;; Indent next line
-       (if verilog-auto-indent-on-newline
-	   (verilog-indent-line))
-       )
-     (t
-      (newline))
-     )))
-
-(defun electric-verilog-semi ()
-  "Insert `;' character and reindent the line."
-  (interactive)
-  (insert last-command-char)
-  (if (or (verilog-in-comment-or-string-p)
-	  (verilog-in-escaped-name-p))
-      ()
-    (save-excursion
-      (beginning-of-line)
-      (verilog-forward-ws&directives)
-      (verilog-indent-line))
-    (if (and verilog-auto-newline
-	     (not (verilog-parenthesis-depth)))
-	(electric-verilog-terminate-line))))
-
-(defun electric-verilog-semi-with-comment ()
-  "Insert `;' character, reindent the line and indent for comment."
-  (interactive)
-  (insert "\;")
-  (save-excursion
-    (beginning-of-line)
-    (verilog-indent-line))
-  (indent-for-comment))
-
-(defun electric-verilog-colon ()
-  "Insert `:' and do all indentations except line indent on this line."
-  (interactive)
-  (insert last-command-char)
-  ;; Do nothing if within string.
-  (if (or
-       (verilog-within-string)
-       (not (verilog-in-case-region-p)))
-      ()
-    (save-excursion
-      (let ((p (point))
-	    (lim (progn (verilog-beg-of-statement) (point))))
-	(goto-char p)
-	(verilog-backward-case-item lim)
-	(verilog-indent-line)))
-;;    (let ((verilog-tab-always-indent nil))
-;;      (verilog-indent-line))
-    ))
-
-(defun electric-verilog-equal ()
-  "Insert `=', and do indentation if within block."
-  (interactive)
-  (insert last-command-char)
-;; Could auto line up expressions, but not yet
-;;  (if (eq (car (verilog-calculate-indent)) 'block)
-;;      (let ((verilog-tab-always-indent nil))
-;;	(verilog-indent-command)))
-  )
-
-(defun electric-verilog-tick ()
-  "Insert back-tick, and indent to column 0 if this is a CPP directive."
-  (interactive)
-  (insert last-command-char)
-  (save-excursion
-    (if (progn
-	  (beginning-of-line)
-	  (looking-at verilog-directive-re-1))
-	(verilog-indent-line))))
-
-(defun electric-verilog-tab ()
-  "Function called when TAB is pressed in Verilog mode."
-  (interactive)
-  ;; If verilog-tab-always-indent, indent the beginning of the line.
-  (if (or verilog-tab-always-indent
-	  (save-excursion
-	    (skip-chars-backward " \t")
-	    (bolp)))
-      (let* ((oldpnt (point))
-	     (boi-point
-	      (save-excursion
-		(beginning-of-line)
-		(skip-chars-forward " \t")
-		(let (type state )
-		  (setq type (verilog-indent-line))
-		  (setq state (car type))
-		  (cond
-		   ((eq state 'block)
-		    (if (looking-at verilog-behavioral-block-beg-re )
-			(error
-			 (concat
-			  (verilog-point-text)
-			  ": The reserved word \""
-			  (buffer-substring (match-beginning 0) (match-end 0))
-			  "\" must be at the behavioral level!"))))
-		   ))
-		(back-to-indentation)
-		(point))))
-        (if (< (point) boi-point)
-            (back-to-indentation)
-	  (cond ((not verilog-tab-to-comment))
-		((not (eolp))
-		 (end-of-line))
-		(t
-		 (indent-for-comment)
-		 (when (and (eolp) (= oldpnt (point)))
-					; kill existing comment
-		   (beginning-of-line)
-		   (re-search-forward comment-start-skip oldpnt 'move)
-		   (goto-char (match-beginning 0))
-		   (skip-chars-backward " \t")
-		   (kill-region (point) oldpnt)
-		   ))))
-	)
-    (progn (insert "\t"))))
-
-
-
-;;
-;; Interactive functions
-;;
-
-(defun verilog-indent-buffer ()
-  "Indent-region the entire buffer as Verilog code."
-  (interactive)
-  (verilog-mode)
-  (indent-region (point-min) (point-max) nil))
-
-(defun verilog-insert-block ()
-  "Insert Verilog begin ... end; block in the code with right indentation."
-  (interactive)
-  (verilog-indent-line)
-  (insert "begin")
-  (electric-verilog-terminate-line)
-  (save-excursion
-    (electric-verilog-terminate-line)
-    (insert "end")
-    (beginning-of-line)
-    (verilog-indent-line)))
-
-(defun verilog-star-comment ()
-  "Insert Verilog star comment at point."
-  (interactive)
-  (verilog-indent-line)
-  (insert "/*")
-  (save-excursion
-    (newline)
-    (insert " */"))
-  (newline)
-  (insert " * "))
-
-(defun verilog-insert-indices (MAX)
-  "Insert a set of indices at into the rectangle.
-The upper left corner is defined by the current point.  Indices always
-begin with 0 and extend to the MAX - 1.  If no prefix arg is given, the
-user is prompted for a value.  The indices are surrounded by square brackets
-[].  For example, the following code with the point located after the first
-'a' gives:
-
-    a = b                           a[  0] = b
-    a = b                           a[  1] = b
-    a = b                           a[  2] = b
-    a = b                           a[  3] = b
-    a = b   ==> insert-indices ==>  a[  4] = b
-    a = b                           a[  5] = b
-    a = b                           a[  6] = b
-    a = b                           a[  7] = b
-    a = b                           a[  8] = b"
-
-  (interactive "NMAX?")
-  (save-excursion
-  (let ((n 0))
-    (while (< n MAX)
-      (save-excursion
-      (insert (format "[%3d]" n)))
-      (next-line 1)
-      (setq n (1+ n))))))
-
-
-(defun verilog-generate-numbers (MAX)
-  "Insert a set of generated numbers into a rectangle.
-The upper left corner is defined by point.  The numbers are padded to three
-digits, starting with 000 and extending to (MAX - 1).  If no prefix argument
-is supplied, then the user is prompted for the MAX number.  consider the
-following code fragment:
-
-    buf buf                           buf buf000
-    buf buf                           buf buf001
-    buf buf                           buf buf002
-    buf buf                           buf buf003
-    buf buf   ==> insert-indices ==>  buf buf004
-    buf buf                           buf buf005
-    buf buf                           buf buf006
-    buf buf                           buf buf007
-    buf buf                           buf buf008"
-
-  (interactive "NMAX?")
-  (save-excursion
-  (let ((n 0))
-    (while (< n MAX)
-      (save-excursion
-      (insert (format "%3.3d" n)))
-      (next-line 1)
-      (setq n (1+ n))))))
-
-(defun verilog-mark-defun ()
-  "Mark the current verilog function (or procedure).
-This puts the mark at the end, and point at the beginning."
-  (interactive)
-  (push-mark (point))
-  (verilog-end-of-defun)
-  (push-mark (point))
-  (verilog-beg-of-defun)
-  (zmacs-activate-region))
-
-(defun verilog-comment-region (start end)
-  ; checkdoc-params: (start end)
-  "Put the region into a Verilog comment.
-The comments that are in this area are \"deformed\":
-`*)' becomes `!(*' and `}' becomes `!{'.
-These deformed comments are returned to normal if you use
-\\[verilog-uncomment-region] to undo the commenting.
-
-The commented area starts with `verilog-exclude-str-start', and ends with
-`verilog-include-str-end'.  But if you change these variables,
-\\[verilog-uncomment-region] won't recognize the comments."
-  (interactive "r")
-  (save-excursion
-    ;; Insert start and endcomments
-    (goto-char end)
-    (if (and (save-excursion (skip-chars-forward " \t") (eolp))
-	     (not (save-excursion (skip-chars-backward " \t") (bolp))))
-	(forward-line 1)
-      (beginning-of-line))
-    (insert verilog-exclude-str-end)
-    (setq end (point))
-    (newline)
-    (goto-char start)
-    (beginning-of-line)
-    (insert verilog-exclude-str-start)
-    (newline)
-    ;; Replace end-comments within commented area
-    (goto-char end)
-    (save-excursion
-      (while (re-search-backward "\\*/" start t)
-	(replace-match "*-/" t t)))
-    (save-excursion
-      (let ((s+1 (1+ start)))
-	(while (re-search-backward "/\\*" s+1 t)
-	  (replace-match "/-*" t t))))
-    ))
-
-(defun verilog-uncomment-region ()
-  "Uncomment a commented area; change deformed comments back to normal.
-This command does nothing if the pointer is not in a commented
-area.  See also `verilog-comment-region'."
-  (interactive)
-  (save-excursion
-    (let ((start (point))
-	  (end (point)))
-      ;; Find the boundaries of the comment
-      (save-excursion
-	(setq start (progn (search-backward verilog-exclude-str-start nil t)
-			   (point)))
-	(setq end (progn (search-forward verilog-exclude-str-end nil t)
-			 (point))))
-      ;; Check if we're really inside a comment
-      (if (or (equal start (point)) (<= end (point)))
-	  (message "Not standing within commented area.")
-	(progn
-	  ;; Remove endcomment
-	  (goto-char end)
-	  (beginning-of-line)
-	  (let ((pos (point)))
-	    (end-of-line)
-	    (delete-region pos (1+ (point))))
-	  ;; Change comments back to normal
-	  (save-excursion
-	    (while (re-search-backward "\\*-/" start t)
-	      (replace-match "*/" t t)))
-	  (save-excursion
-	    (while (re-search-backward "/-\\*" start t)
-	      (replace-match "/*" t t)))
-	  ;; Remove start comment
-	  (goto-char start)
-	  (beginning-of-line)
-	  (let ((pos (point)))
-	    (end-of-line)
-	    (delete-region pos (1+ (point)))))))))
-
-(defun verilog-beg-of-defun ()
-  "Move backward to the beginning of the current function or procedure."
-  (interactive)
-  (verilog-re-search-backward verilog-defun-re nil 'move))
-
-(defun verilog-end-of-defun ()
-  "Move forward to the end of the current function or procedure."
-  (interactive)
-  (verilog-re-search-forward verilog-end-defun-re nil 'move))
-
-(defun verilog-get-beg-of-defun (&optional warn)
-  (save-excursion
-    (cond ((verilog-re-search-forward-quick verilog-defun-re nil t)
-	   (point))
-	  (t
-	   (error "%s: Can't find module beginning" (verilog-point-text))
-	   (point-max)))))
-(defun verilog-get-end-of-defun (&optional warn)
-  (save-excursion
-    (cond ((verilog-re-search-forward-quick verilog-end-defun-re nil t)
-	   (point))
-	  (t
-	   (error "%s: Can't find endmodule" (verilog-point-text))
-	   (point-max)))))
-
-(defun verilog-label-be (&optional arg)
-  "Label matching begin ... end, fork ... join and case ... endcase statements.
-With ARG, first kill any existing labels."
-  (interactive)
-  (let ((cnt 0)
-	(oldpos (point))
-	(b (progn
-	     (verilog-beg-of-defun)
-	     (point-marker)))
-	(e (progn
-	     (verilog-end-of-defun)
-	     (point-marker)))
-	)
-    (goto-char (marker-position b))
-    (if (> (- e b) 200)
-	(message  "Relabeling module..."))
-    (while (and
-	    (> (marker-position e) (point))
-	    (verilog-re-search-forward
-	     (concat
-	      "\\"
-	      "\\|\\(`endif\\)\\|\\(`else\\)")
-	     nil 'move))
-      (goto-char (match-beginning 0))
-      (let ((indent-str (verilog-indent-line)))
-	(verilog-set-auto-endcomments indent-str 't)
-	(end-of-line)
-	(delete-horizontal-space)
-	)
-      (setq cnt (1+ cnt))
-      (if (= 9 (% cnt 10))
-	  (message "%d..." cnt))
-      )
-    (goto-char oldpos)
-    (if (or
-	 (> (- e b) 200)
-	 (> cnt 20))
-	(message  "%d lines auto commented" cnt))
-    ))
-
-(defun verilog-beg-of-statement ()
-  "Move backward to beginning of statement."
-  (interactive)
-  (while (save-excursion
-	   (and
-	    (not (looking-at verilog-complete-reg))
-	    (verilog-backward-syntactic-ws)
-	    (not (or (bolp) (= (preceding-char) ?\;)))
-	    ))
-    (skip-chars-backward " \t")
-    (verilog-backward-token))
-  (let ((last (point)))
-    (while (progn
-	     (setq last (point))
-	     (and (not (looking-at verilog-complete-reg))
-		  (verilog-continued-line))))
-    (goto-char last)
-    (verilog-forward-syntactic-ws)))
-
-(defun verilog-beg-of-statement-1 ()
-  "Move backward to beginning of statement."
-  (interactive)
-  (let ((pt (point)))
-
-    (while (and (not (looking-at verilog-complete-reg))
-		(setq pt (point))
-		(verilog-backward-token)
-		(verilog-backward-syntactic-ws)
-		(setq pt (point))
-		(not (bolp))
-		(not (= (preceding-char) ?\;))))
-    (while (progn
-	     (setq pt (point))
-	     (and (not (looking-at verilog-complete-reg))
-		  (not (= (preceding-char) ?\;))
-		  (verilog-continued-line))))
-    (goto-char pt)
-    (verilog-forward-ws&directives)))
-
-(defun verilog-end-of-statement ()
-  "Move forward to end of current statement."
-  (interactive)
-  (let ((nest 0) pos)
-    (or (looking-at verilog-beg-block-re)
-	;; Skip to end of statement
-	(setq pos (catch 'found
-		    (while t
-		      (forward-sexp 1)
-		      (verilog-skip-forward-comment-or-string)
-		      (cond ((looking-at "[ \t]*;")
-			     (skip-chars-forward "^;")
-			     (forward-char 1)
-			     (throw 'found (point)))
-			    ((save-excursion
-			       (forward-sexp -1)
-			       (looking-at verilog-beg-block-re))
-			     (goto-char (match-beginning 0))
-			     (throw 'found nil))
-			    ((eobp)
-			     (throw 'found (point))))))))
-    (if (not pos)
-	;; Skip a whole block
-	(catch 'found
-	  (while t
-	    (verilog-re-search-forward verilog-end-statement-re nil 'move)
-	    (setq nest (if (match-end 1)
-			   (1+ nest)
-			 (1- nest)))
-	    (cond ((eobp)
-		   (throw 'found (point)))
-		  ((= 0 nest)
-		   (throw 'found (verilog-end-of-statement))))))
-      pos)))
-
-(defun verilog-in-case-region-p ()
-  "Return TRUE if in a case region;
-more specifically, point @ in the line foo : @ begin"
-  (interactive)
-  (save-excursion
-    (if (and
-	 (progn (verilog-forward-syntactic-ws)
-		(looking-at "\\"))
-	 (progn (verilog-backward-syntactic-ws)
-		(= (preceding-char) ?\:)))
-	(catch 'found
-	  (let ((nest 1))
-	    (while t
-	      (verilog-re-search-backward
-	       (concat "\\(\\\\)\\|\\(\\[^:]\\)\\|"
-		       "\\(\\\\)\\>")
-	       nil 'move)
-	      (cond
-	       ((match-end 3)
-		(setq nest (1+ nest)))
-	       ((match-end 2)
-		(if (= nest 1)
-		(throw 'found 1))
-		(setq nest (1- nest)))
-	       (t
-		(throw 'found (= nest 0)))
-	       ))))
-      nil)))
-
-(defun verilog-in-fork-region-p ()
-  "Return true if between a fork and join."
-  (interactive)
-  (let ((lim (save-excursion (verilog-beg-of-defun)  (point)))
-	(nest 1)
-	)
-    (save-excursion
-      (while (and
-	      (/= nest 0)
-	      (verilog-re-search-backward "\\<\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\>" lim 'move)
-	      (cond
-	       ((match-end 1) ; fork
-		(setq nest (1- nest)))
-	       ((match-end 2) ; join
-		(setq nest (1+ nest)))
-	       ))
-	))
-    (= nest 0) )) ; return nest
-
-(defun verilog-backward-case-item (lim)
-  "Skip backward to nearest enclosing case item.
-Limit search to point LIM."
-  (interactive)
-  (let ((str 'nil)
-	(lim1
-	 (progn
-	   (save-excursion
-	     (verilog-re-search-backward verilog-endcomment-reason-re
-					 lim 'move)
-	     (point)))))
-    ;; Try to find the real :
-    (if (save-excursion (search-backward ":" lim1 t))
-	(let ((colon 0)
-	      b e )
-	  (while
-	      (and
-	       (< colon 1)
-	       (verilog-re-search-backward "\\(\\[\\)\\|\\(\\]\\)\\|\\(:\\)"
-					   lim1 'move))
-	    (cond
-	     ((match-end 1) ;; [
-	      (setq colon (1+ colon))
-	      (if (>= colon 0)
-		  (error "%s: unbalanced [" (verilog-point-text))))
-	     ((match-end 2) ;; ]
-	      (setq colon (1- colon)))
-
-	     ((match-end 3) ;; :
-	      (setq colon (1+ colon)))
-	     ))
-	  ;; Skip back to beginning of case item
-	  (skip-chars-backward "\t ")
-	  (verilog-skip-backward-comment-or-string)
-	  (setq e (point))
-	  (setq b
-		(progn
-		  (if
-		      (verilog-re-search-backward
-		       "\\<\\(case[zx]?\\)\\>\\|;\\|\\" nil 'move)
-		      (progn
-			(cond
-			 ((match-end 1)
-			  (goto-char (match-end 1))
-			  (verilog-forward-ws&directives)
-			  (if (looking-at "(")
-			      (progn
-				(forward-sexp)
-				(verilog-forward-ws&directives)))
-			  (point))
-			 (t
-			  (goto-char (match-end 0))
-			  (verilog-forward-ws&directives)
-			  (point))
-			 ))
-		    (error "Malformed case item")
-		    )))
-	  (setq str (buffer-substring b e))
-	  (if
-	      (setq e
-		    (string-match
-		     "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str))
-	      (setq str (concat (substring str 0 e) "...")))
-	  str)
-      'nil)))
-
-
-;;
-;; Other functions
-;;
-
-(defun kill-existing-comment ()
-  "Kill auto comment on this line."
-  (save-excursion
-    (let* (
-	   (e (progn
-		(end-of-line)
-		(point)))
-	   (b (progn
-		(beginning-of-line)
-		(search-forward "//" e t))))
-      (if b
-	  (delete-region (- b 2) e)))))
-
-(defconst verilog-directive-nest-re
-  (concat "\\(`else\\>\\)\\|"
-	  "\\(`endif\\>\\)\\|"
-	  "\\(`if\\>\\)\\|"
-	  "\\(`ifdef\\>\\)\\|"
-	  "\\(`ifndef\\>\\)"))
-(defun verilog-set-auto-endcomments (indent-str kill-existing-comment)
-  "Add ending comment with given INDENT-STR.
-With KILL-EXISTING-COMMENT, remove what was there before.
-Insert `// case: 7 ' or `// NAME ' on this line if appropriate.
-Insert `// case expr ' if this line ends a case block.
-Insert `// ifdef FOO ' if this line ends code conditional on FOO.
-Insert `// NAME ' if this line ends a function, task, module, primitive or interface named NAME."
-  (save-excursion
-    (cond
-     (; Comment close preprocessor directives
-      (and
-       (looking-at "\\(`endif\\)\\|\\(`else\\)")
-       (or  kill-existing-comment
-	    (not (save-excursion
-		   (end-of-line)
-		   (search-backward "//" (verilog-get-beg-of-line) t)))))
-      (let ((nest 1) b e
-	    m
-	    (else (if (match-end 2) "!" " "))
-	    )
-	(end-of-line)
-	(if kill-existing-comment
-	    (kill-existing-comment))
-	(delete-horizontal-space)
-	(save-excursion
-	  (backward-sexp 1)
-	  (while (and (/= nest 0)
-		      (verilog-re-search-backward verilog-directive-nest-re nil 'move))
-	    (cond
-	     ((match-end 1) ; `else
-	      (if (= nest 1)
-		  (setq else "!")))
-	     ((match-end 2) ; `endif
-	      (setq nest (1+ nest)))
-	     ((match-end 3) ; `if
-	      (setq nest (1- nest)))
-	     ((match-end 4) ; `ifdef
-	      (setq nest (1- nest)))
-	     ((match-end 5) ; `ifndef
-	      (setq nest (1- nest)))
-	     ))
-	  (if (match-end 0)
-	      (setq
-	       m (buffer-substring
-		  (match-beginning 0)
-		  (match-end 0))
-	       b (progn
-		   (skip-chars-forward "^ \t")
-		   (verilog-forward-syntactic-ws)
-		   (point))
-	       e (progn
-		   (skip-chars-forward "a-zA-Z0-9_")
-		   (point)
-		   ))))
-	(if b
-	    (if (> (count-lines (point) b) verilog-minimum-comment-distance)
-		(insert (concat " // " else m " " (buffer-substring b e))))
-	  (progn
-	    (insert " // unmatched `else or `endif")
-	    (ding 't))
-	  )))
-
-     (; Comment close case/function/task/module and named block
-      (and (looking-at "\\\\|\\\\|\\"))
-				    (progn
-				      (goto-char (match-end 0))
-				      (setq there (point))
-				      (setq str
-					    (concat " // "
-						    (buffer-substring (match-beginning 0) (match-end 0)) " "
-						    (verilog-get-expr))))
-				  (setq str ""))))
-
-			     (;- else
-			      (match-end 4)
-			      (let ((nest 0)
-				    ( reg "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)")
-				    )
-				(catch 'skip
-				  (while (verilog-re-search-backward reg nil 'move)
-				    (cond
-				     ((match-end 1) ; begin
-				      (setq nest (1- nest)))
-				     ((match-end 2)                       ; end
-				      (setq nest (1+ nest)))
-				     ((match-end 3)
-				      (if (= 0 nest)
-					  (progn
-					    (goto-char (match-end 0))
-					    (setq there (point))
-					    (setq err nil)
-					    (setq str (verilog-get-expr))
-					    (setq str (concat " // else: !if" str ))
-					    (throw 'skip 1))
-					)))
-				    ))))
-
-			     (;- end else
-			      (match-end 5)
-			      (goto-char there)
-			      (let ((nest 0)
-				    ( reg "\\(\\\\)\\|\\(\\\\)\\|\\(\\\\)")
-				    )
-				(catch 'skip
-				  (while (verilog-re-search-backward reg nil 'move)
-				    (cond
-				     ((match-end 1) ; begin
-				      (setq nest (1- nest)))
-				     ((match-end 2)                       ; end
-				      (setq nest (1+ nest)))
-				     ((match-end 3)
-				      (if (= 0 nest)
-					  (progn
-					    (goto-char (match-end 0))
-					    (setq there (point))
-					    (setq err nil)
-					    (setq str (verilog-get-expr))
-					    (setq str (concat " // else: !if" str ))
-					    (throw 'skip 1))
-					)))
-				    ))))
-
-			     (;- task/function/initial et cetera
-			      t
-			      (match-end 0)
-			      (goto-char (match-end 0))
-			      (setq there (point))
-			      (setq err nil)
-			      (setq str (verilog-get-expr))
-			      (setq str (concat " // " cntx str )))
-
-			     (;-- otherwise...
-			      (setq str " // auto-endcomment confused "))
-			     ))
-
-			   ((and
-			     (verilog-in-case-region-p) ;-- handle case item differently
-			     (progn
-			       (setq there (point))
-			       (goto-char here)
-			       (setq str (verilog-backward-case-item lim))))
-			    (setq err nil)
-			    (setq str (concat " // case: " str )))
-
-			   ((verilog-in-fork-region-p)
-			    (setq err nil)
-			    (setq str " // fork branch" ))
-
-			   ((looking-at "\\")
-			    ;; HERE
-			    (forward-word 1)
-			    (verilog-forward-syntactic-ws)
-			    (setq err nil)
-			    (setq str (verilog-get-expr))
-			    (setq str (concat " // " cntx str )))
-
-			   ))))
-		      (goto-char here)
-		      (end-of-line)
-		      (if kill-existing-comment
-			  (kill-existing-comment))
-		      (delete-horizontal-space)
-		      (if (or err
-			      (> (count-lines here there) verilog-minimum-comment-distance))
-			  (insert str))
-		      (if err (ding 't))
-		      ))))
-
-	       (;- this is end{function,generate,task,module,primative,table,generate}
-		t
-		(let (string reg (width nil))
-		  (end-of-line)
-		  (if kill-existing-comment
-		      (save-match-data
-		       (kill-existing-comment)))
-		  (delete-horizontal-space)
-		  (backward-sexp)
-		  (cond
-		   ((match-end 5) ;; of verilog-enders-re
-		    (setq reg "\\(\\\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
-		    (setq width "\\(\\s-*\\(\\[[^]]*\\]\\)\\|\\(real\\(time\\)?\\)\\|\\(integer\\)\\|\\(time\\)\\)?")
-		    )
-		   ((match-end 6) ;; of verilog-enders-re
-		    (setq reg "\\(\\\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)"))
-		   ((match-end 7) ;; of verilog-enders-re
-		    (setq reg "\\(\\<\\(macro\\)?module\\>\\)\\|\\"))
-		   ((match-end 8) ;; of verilog-enders-re
-		    (setq reg "\\(\\\\)\\|\\(\\<\\(endprimitive\\|package\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
-		   ((match-end 9) ;; of verilog-enders-re
-		    (setq reg "\\(\\\\)\\|\\(\\<\\(endinterface\\|package\\|primitive\\|\\(macro\\)?module\\)\\>\\)"))
-		   ((match-end 10) ;; of verilog-enders-re
-		    (setq reg "\\(\\\\)\\|\\(\\<\\(endpackage\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
-		   )
-		  (let (b e)
-		    (save-excursion
-		      (verilog-re-search-backward reg nil 'move)
-		      (cond
-		       ((match-end 1)
-			(setq b (progn
-				  (skip-chars-forward "^ \t")
-				  (verilog-forward-ws&directives)
-				  (if (and width (looking-at width))
-				      (progn
-					(goto-char (match-end 0))
-					(verilog-forward-ws&directives)
-					))
-				  (point))
-			      e (progn
-				  (skip-chars-forward "a-zA-Z0-9_")
-				  (point)))
-			(setq string (buffer-substring b e)))
-		       (t
-			(ding 't)
-			(setq string "unmatched end(function|task|module|primitive|interface|package)")))))
-		  (end-of-line)
-		  (insert (concat " // " string )))
-		))))))))))
-
-(defun verilog-get-expr()
-  "Grab expression at point, e.g, case ( a | b & (c ^d))"
-  (let* ((b (progn
-	      (verilog-forward-syntactic-ws)
-	      (skip-chars-forward " \t")
-	      (point)))
-	 (e (let ((par 1))
-	      (cond
-	       ((looking-at "@")
-		(forward-char 1)
-		(verilog-forward-syntactic-ws)
-		(if (looking-at "(")
-		    (progn
-		      (forward-char 1)
-		      (while (and (/= par 0)
-				  (verilog-re-search-forward "\\((\\)\\|\\()\\)" nil 'move))
-			(cond
-			 ((match-end 1)
-			  (setq par (1+ par)))
-			 ((match-end 2)
-			  (setq par (1- par)))))))
-		(point))
-	       ((looking-at "(")
-		(forward-char 1)
-		(while (and (/= par 0)
-			    (verilog-re-search-forward "\\((\\)\\|\\()\\)" nil 'move))
-		  (cond
-		   ((match-end 1)
-		    (setq par (1+ par)))
-		   ((match-end 2)
-		    (setq par (1- par)))))
-		(point))
-	       ((looking-at "\\[")
-		(forward-char 1)
-		(while (and (/= par 0)
-			    (verilog-re-search-forward "\\(\\[\\)\\|\\(\\]\\)" nil 'move))
-		  (cond
-		   ((match-end 1)
-		    (setq par (1+ par)))
-		   ((match-end 2)
-		    (setq par (1- par)))))
-		(verilog-forward-syntactic-ws)
-		(skip-chars-forward "^ \t\n")
-		(point))
-	       ((looking-at "/[/\\*]")
-		b)
-	       ('t
-		(skip-chars-forward "^: \t\n")
-		(point)
-		))))
-	 (str (buffer-substring b e)))
-    (if (setq e (string-match "[ \t]*\\(\\(\n\\)\\|\\(//\\)\\|\\(/\\*\\)\\)" str))
-	(setq str (concat (substring str 0 e) "...")))
-    str))
-
-(defun verilog-expand-vector ()
-  "Take a signal vector on the current line and expand it to multiple lines.
-Useful for creating tri's and other expanded fields."
-  (interactive)
-  (verilog-expand-vector-internal "[" "]"))
-
-(defun verilog-expand-vector-internal (bra ket)
-  "Given BRA, the start brace and KET, the end brace, expand one line into many lines."
-  (save-excursion
-    (forward-line 0)
-    (let ((signal-string (buffer-substring (point)
-					   (progn
-					     (end-of-line) (point)))))
-      (if (string-match (concat "\\(.*\\)"
-				(regexp-quote bra)
-				"\\([0-9]*\\)\\(:[0-9]*\\|\\)\\(::[0-9---]*\\|\\)"
-				(regexp-quote ket)
-				"\\(.*\\)$") signal-string)
-	  (let* ((sig-head (match-string 1 signal-string))
-		 (vec-start (string-to-int (match-string 2 signal-string)))
-		 (vec-end (if (= (match-beginning 3) (match-end 3))
-			      vec-start
-			    (string-to-int (substring signal-string (1+ (match-beginning 3)) (match-end 3)))))
-		 (vec-range (if (= (match-beginning 4) (match-end 4))
-				1
-			      (string-to-int (substring signal-string (+ 2 (match-beginning 4)) (match-end 4)))))
-		 (sig-tail (match-string 5 signal-string))
-		 vec)
-	    ;; Decode vectors
-	    (setq vec nil)
-	    (if (< vec-range 0)
-		(let ((tmp vec-start))
-		  (setq vec-start vec-end
-			vec-end tmp
-			vec-range (- vec-range))))
-	    (if (< vec-end vec-start)
-		(while (<= vec-end vec-start)
-		  (setq vec (append vec (list vec-start)))
-		  (setq vec-start (- vec-start vec-range)))
-	      (while (<= vec-start vec-end)
-		(setq vec (append vec (list vec-start)))
-		(setq vec-start (+ vec-start vec-range))))
-	    ;;
-	    ;; Delete current line
-	    (delete-region (point) (progn (forward-line 0) (point)))
-	    ;;
-	    ;; Expand vector
-	    (while vec
-	      (insert (concat sig-head bra (int-to-string (car vec)) ket sig-tail "\n"))
-	      (setq vec (cdr vec)))
-	    (delete-char -1)
-	    ;;
-	    )))))
-
-(defun verilog-strip-comments ()
-  "Strip all comments from the verilog code."
-  (interactive)
-  (goto-char (point-min))
-  (while (re-search-forward "//" nil t)
-    (let ((bpt (- (point) 2)))
-      (end-of-line)
-      (delete-region bpt (point))))
-  ;;
-  (goto-char (point-min))
-  (while (re-search-forward "/\\*" nil t)
-    (let ((bpt (- (point) 2)))
-      (re-search-forward "\\*/")
-      (delete-region bpt (point)))))
-
-(defun verilog-one-line ()
-  "Converts structural verilog instances to occupy one line."
-  (interactive)
-  (goto-char (point-min))
-  (while (re-search-forward "\\([^;]\\)[ \t]*\n[ \t]*" nil t)
-	(replace-match "\\1 " nil nil)))
-
-(defun verilog-linter-name ()
-  "Return name of linter, either surelint or verilint."
-  (let ((compile-word1 (verilog-string-replace-matches "\\s .*$" "" nil nil
-						       compile-command))
-	(lint-word1    (verilog-string-replace-matches "\\s .*$" "" nil nil
-						       verilog-linter)))
-    (cond ((equal compile-word1 "surelint") `surelint)
-	  ((equal compile-word1 "verilint") `verilint)
-	  ((equal lint-word1 "surelint")    `surelint)
-	  ((equal lint-word1 "verilint")    `verilint)
-	  (t `surelint))))  ;; back compatibility
-
-(defun verilog-lint-off ()
-  "Convert a Verilog linter warning line into a disable statement.
-For example:
-	pci_bfm_null.v, line  46: Unused input: pci_rst_
-becomes a comment for the appropriate tool.
-
-The first word of the `compile-command' or `verilog-linter'
-variables are used to determine which product is being used.
-
-See \\[verilog-surelint-off] and \\[verilog-verilint-off]."
-  (interactive)
-  (let ((linter (verilog-linter-name)))
-    (cond ((equal linter `surelint)
-	   (verilog-surelint-off))
-	  ((equal linter `verilint)
-	   (verilog-verilint-off))
-	  (t (error "Linter name not set")))))
-
-(defun verilog-surelint-off ()
-  "Convert a SureLint warning line into a disable statement.
-Run from Verilog source window; assumes there is a *compile* buffer
-with point set appropriately.
-For example:
- WARNING [STD-UDDONX]: xx.v, line 8: output out is never assigned.
-becomes:
-	// surefire lint_line_off UDDONX"
-  (interactive)
-  (save-excursion
-    (switch-to-buffer compilation-last-buffer)
-    (beginning-of-line)
-    (when
-	(looking-at "\\(INFO\\|WARNING\\|ERROR\\) \\[[^-]+-\\([^]]+\\)\\]: \\([^,]+\\), line \\([0-9]+\\): \\(.*\\)$")
-      (let* ((code (match-string 2))
-	     (file (match-string 3))
-	     (line (match-string 4))
-	     (buffer (get-file-buffer file))
-	     dir filename)
-	(unless buffer
-	  (progn
-	    (setq buffer
-		  (and (file-exists-p file)
-		       (find-file-noselect file)))
-	    (or buffer
-		(let* ((pop-up-windows t))
-		  (let ((name (expand-file-name
-			       (read-file-name
-				(format "Find this error in: (default %s) "
-					file)
-				dir file t))))
-		    (if (file-directory-p name)
-			(setq name (expand-file-name filename name)))
-		    (setq buffer
-			  (and (file-exists-p name)
-			       (find-file-noselect name))))))))
-	(switch-to-buffer buffer)
-	(goto-line (string-to-number line))
-	(end-of-line)
-	(catch 'already
-	  (cond
-	   ((verilog-in-slash-comment-p)
-	    (re-search-backward "//")
-	    (cond
-	     ((looking-at "// surefire lint_off_line ")
-	      (goto-char (match-end 0))
-	      (let ((lim (save-excursion (end-of-line) (point))))
-		(if (re-search-forward code lim 'move)
-		    (throw 'already t)
-		  (insert-string (concat " " code)))))
-	     (t
-	      )))
-	   ((verilog-in-star-comment-p)
-	    (re-search-backward "/\*")
-	    (insert-string (format " // surefire lint_off_line %6s" code ))
-	    )
-	   (t
-	    (insert-string (format " // surefire lint_off_line %6s" code ))
-	    )))))))
-
-(defun verilog-verilint-off ()
-  "Convert a Verilint warning line into a disable statement.
-For example:
-	(W240)  pci_bfm_null.v, line  46: Unused input: pci_rst_
-becomes:
-	//Verilint 240 off // WARNING: Unused input"
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\):?.*$")
-      (replace-match (format
-		      ;; %3s makes numbers 1-999 line up nicely
-		      "\\1//Verilint %3s off // WARNING: \\3"
-		      (match-string 2)))
-      (beginning-of-line)
-      (verilog-indent-line))))
-
-(defun verilog-auto-save-compile ()
-  "Update automatics with \\[verilog-auto], save the buffer, and compile."
-  (interactive)
-  (verilog-auto)	; Always do it for safety
-  (save-buffer)
-  (compile compile-command))
-
-
-;;
-;; Indentation
-;;
-(defconst verilog-indent-alist
-  '((block       . (+ ind verilog-indent-level))
-    (case        . (+ ind verilog-case-indent))
-    (cparenexp   . (+ ind verilog-indent-level))
-    (cexp        . (+ ind verilog-cexp-indent))
-    (defun       . verilog-indent-level-module)
-    (declaration . verilog-indent-level-declaration)
-    (directive   . (verilog-calculate-indent-directive))
-    (tf          . verilog-indent-level)
-    (behavioral  . (+ verilog-indent-level-behavioral verilog-indent-level-module))
-    (statement   . ind)
-    (cpp         . 0)
-    (comment     . (verilog-comment-indent))
-    (unknown     . 3)
-    (string      . 0)))
-
-(defun verilog-continued-line-1 (lim)
-  "Return true if this is a continued line.
-Set point to where line starts.  Limit search to point LIM."
-  (let ((continued 't))
-    (if (eq 0 (forward-line -1))
-	(progn
-	  (end-of-line)
-	  (verilog-backward-ws&directives lim)
-	  (if (bobp)
-	      (setq continued nil)
-	    (setq continued (verilog-backward-token))))
-      (setq continued nil))
-    continued))
-
-(defun verilog-calculate-indent ()
-  "Calculate the indent of the current Verilog line.
-Examine previous lines.  Once a line is found that is definitive as to the
-type of the current line, return that lines' indent level and its
-type.  Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
-  (save-excursion
-    (let* ((starting_position (point))
-	   (par 0)
-	   (begin (looking-at "[ \t]*begin\\>"))
-	   (lim (save-excursion (verilog-re-search-backward "\\(\\\\)\\|\\(\\\\)" nil t)))
-	   (type (catch 'nesting
-		   ;; Keep working backwards until we can figure out
-		   ;; what type of statement this is.
-		   ;; Basically we need to figure out
-		   ;; 1) if this is a continuation of the previous line;
-		   ;; 2) are we in a block scope (begin..end)
-
-		   ;; if we are in a comment, done.
-		   (if (verilog-in-star-comment-p)   (throw 'nesting 'comment))
-
-		   ;; if we are in a parenthesized list, and the user likes to indent
-		   ;; these, return.
- 		   (if (and verilog-indent-lists
-			    (verilog-in-paren))
-		       (progn (setq par 1) (throw 'nesting 'block)))
-;		   (if (/= 0 (verilog-parenthesis-depth)) (progn (setq par 1) (throw 'nesting 'block)))
-
-		   ;; if we have a directive, done.
-		   (if (save-excursion
-			 (beginning-of-line)
-			 (looking-at verilog-directive-re-1))
-		       (throw 'nesting 'directive))
-
-		   ;; See if we are continuing a previous line
-		   (while t
-		     ;; trap out if we crawl off the top of the buffer
-		     (if (bobp) (throw 'nesting 'cpp))
-
-		     (if (verilog-continued-line-1 lim)
-			 (let ((sp (point)))
-			   (if (and
-				(not (looking-at verilog-complete-reg))
-				(verilog-continued-line-1 lim))
-			       (progn (goto-char sp)
-				      (throw 'nesting 'cexp))
-			     (goto-char sp))
-
-			   (if (and begin
-				    (not verilog-indent-begin-after-if)
-				    (looking-at verilog-no-indent-begin-re))
-			       (progn
-				 (beginning-of-line)
-				 (skip-chars-forward " \t")
-				 (throw 'nesting 'statement))
-			     (progn
-			       (throw 'nesting 'cexp))))
-		       ;; not a continued line
-		       (goto-char starting_position))
-
-		     (if (looking-at "\\")
-			 ;; search back for governing if, striding across begin..end pairs
-			 ;; appropriately
-			 (let ((elsec 1))
-			   (while (verilog-re-search-backward verilog-ends-re nil 'move)
-			     (cond
-			      ((match-end 1) ; else, we're in deep
-			       (setq elsec (1+ elsec)))
-			      ((match-end 2) ; if
-			       (setq elsec (1- elsec))
-			       (if (= 0 elsec)
-				   (if verilog-align-ifelse
-				       (throw 'nesting 'statement)
-				     (progn ;; back up to first word on this line
-				       (beginning-of-line)
-				       (verilog-forward-syntactic-ws)
-				       (throw 'nesting 'statement)))))
-			      (t ; endblock
-				; try to leap back to matching outward block by striding across
-				; indent level changing tokens then immediately
-				; previous line governs indentation.
-			       (let (( reg) (nest 1))
-;;	 verilog-ends =>  else|if|end|join(_any|_none|)|endcase|endtable|endspecify|endfunction|endtask|endgenerate
-				 (cond
-				  ((match-end 3) ; end
-				   ;; Search back for matching begin
-				   (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-				  ((match-end 4) ; endcase
-				   ;; Search back for matching case
-				   (setq reg "\\(\\[^:]\\)\\|\\(\\\\)" ))
-				  ((match-end 5) ; endfunction
-				   ;; Search back for matching function
-				   (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-				  ((match-end 6) ; endtask
-				   ;; Search back for matching task
-				   (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-				  ((match-end 7) ; endspecify
-				   ;; Search back for matching specify
-				   (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-				  ((match-end 8) ; endtable
-				   ;; Search back for matching table
-				   (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-				  ((match-end 9) ; endgenerate
-				   ;; Search back for matching generate
-				   (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-				  ((match-end 10) ; join
-				   ;; Search back for matching fork
-				   (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-				  )
-				 (catch 'skip
-				   (while (verilog-re-search-backward reg nil 'move)
-				     (cond
-				      ((match-end 1) ; begin
-				       (setq nest (1- nest))
-				       (if (= 0 nest)
-					   (throw 'skip 1)))
-				      ((match-end 2) ; end
-				       (setq nest (1+ nest)))))
-				   )
-				 ))
-			      ))))
-		     (throw 'nesting (verilog-calc-1))
-		     ))))
-      ;; Return type of block and indent level.
-      (if (not type)
-	  (setq type 'cpp))
-      (if (> par 0)			; Unclosed Parenthesis
-	  (list 'cparenexp par)
-	(cond
-	  ((eq type 'case)
-	   (list type (verilog-case-indent-level)))
-	  ((eq type 'statement)
-	   (list type (current-column)))
-	  ((eq type 'defun)
-	   (list type 0))
-	  (t
-	   (list type (verilog-indent-level)))))
-      )))
-
-(defun verilog-calc-1 ()
-  (catch 'nesting
-    (while (verilog-re-search-backward verilog-indent-re nil 'move)
-      (cond
-       ((looking-at verilog-behavioral-level-re)
-	(throw 'nesting 'behavioral))
-
-       ((looking-at verilog-beg-block-re-1)
-	(cond
-	 ((match-end 2)  (throw 'nesting 'case))
-	 (t              (throw 'nesting 'block))))
-
-       ((looking-at verilog-end-block-re)
-	(verilog-leap-to-head)
-	(if (verilog-in-case-region-p)
-	    (progn
-	      (verilog-leap-to-case-head)
-	      (if (looking-at verilog-case-re)
-		  (throw 'nesting 'case)))))
-
-       ((looking-at verilog-defun-level-re)
-	(throw 'nesting 'defun))
-
-       ((looking-at verilog-cpp-level-re)
-	(throw 'nesting 'cpp))
-
-       ((bobp)
-	(throw 'nesting 'cpp))
-       ))))
-
-(defun verilog-calculate-indent-directive ()
-  "Return indentation level for directive.
-For speed, the searcher looks at the last directive, not the indent
-of the appropriate enclosing block."
-  (let ((base -1)	;; Indent of the line that determines our indentation
-	(ind 0)	        ;; Relative offset caused by other directives (like `endif on same line as `else)
-	)
-    ;; Start at current location, scan back for another directive
-
-    (save-excursion
-      (beginning-of-line)
-      (while (and (< base 0)
-		  (verilog-re-search-backward verilog-directive-re nil t))
-	(cond ((save-excursion (skip-chars-backward " \t") (bolp))
-	       (setq base (current-indentation))
-	       ))
-	(cond ((and (looking-at verilog-directive-end) (< base 0))  ;; Only matters when not at BOL
-	       (setq ind (- ind verilog-indent-level-directive)))
-	      ((and (looking-at verilog-directive-middle) (>= base 0))  ;; Only matters when at BOL
-	       (setq ind (+ ind verilog-indent-level-directive)))
-	      ((looking-at verilog-directive-begin)
-	       (setq ind (+ ind verilog-indent-level-directive)))))
-      ;; Adjust indent to starting indent of critical line
-      (setq ind (max 0 (+ ind base))))
-
-    (save-excursion
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (cond ((or (looking-at verilog-directive-middle)
-		 (looking-at verilog-directive-end))
-	     (setq ind (max 0 (- ind verilog-indent-level-directive))))))
-   ind))
-
-(defun verilog-leap-to-case-head ()
-  (let ((nest 1))
-    (while (/= 0 nest)
-      (verilog-re-search-backward "\\(\\[^:]\\)\\|\\(\\\\)" nil 'move)
-      (cond
-       ((match-end 1)
-	(setq nest (1- nest)))
-       ((match-end 2)
-	(setq nest (1+ nest)))
-       ((bobp)
-	(ding 't)
-	(setq nest 0))))))
-
-(defun verilog-leap-to-head ()
-  "Move point to the head of this block; jump from end to matching begin,
-from endcase to matching case, and so on."
-  (let (reg
-	snest
-	(nest 1))
-    (cond
-     ((looking-at "\\")
-      ;; Search back for matching begin
-      (setq reg (concat "\\(\\\\)\\|\\(\\\\)\\|"
-			"\\(\\\\)\\|\\(\\\\)" )))
-
-     ((looking-at "\\")
-      ;; Search back for matching case
-      (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-     ((looking-at "\\")
-      ;; Search back for matching fork
-      (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-     ((looking-at "\\")
-      ;; Search back for matching table
-      (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-     ((looking-at "\\")
-      ;; Search back for matching specify
-      (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-     ((looking-at "\\")
-      ;; Search back for matching function
-      (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-     ((looking-at "\\")
-      ;; Search back for matching generate
-      (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-     ((looking-at "\\")
-      ;; Search back for matching task
-      (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-     )
-    (catch 'skip
-      (let (sreg)
-	(while (verilog-re-search-backward reg nil 'move)
-	  (cond
-	   ((match-end 1) ; begin
-	    (setq nest (1- nest))
-	    (if (= 0 nest)
-		;; Now previous line describes syntax
-		(throw 'skip 1))
-	    (if (and snest
-		     (= snest nest))
-		(setq reg sreg)))
-	   ((match-end 2) ; end
-	    (setq nest (1+ nest)))
-	   ((match-end 3)
-	    ;; endcase, jump to case
-	    (setq snest nest)
-	    (setq nest (1+ nest))
-	    (setq sreg reg)
-	    (setq reg "\\(\\[^:]\\)\\|\\(\\\\)" ))
-	   ((match-end 4)
-	    ;; join, jump to fork
-	    (setq snest nest)
-	    (setq nest (1+ nest))
-	    (setq sreg reg)
-	    (setq reg "\\(\\\\)\\|\\(\\\\)" ))
-	   ))))))
-
-(defun verilog-continued-line ()
-  "Return true if this is a continued line.
-Set point to where line starts"
-  (let ((continued 't))
-    (if (eq 0 (forward-line -1))
-	(progn
-	  (end-of-line)
-	  (verilog-backward-ws&directives)
-	  (if (bobp)
-	      (setq continued nil)
-	    (while (and continued
-			(save-excursion
-			  (skip-chars-backward " \t")
-			  (not (bolp))))
-	    (setq continued (verilog-backward-token))
-	    ) ;; while
-	    ))
-      (setq continued nil))
-    continued))
-
-(defun verilog-backward-token ()
-  "Step backward token, returning true if we are now at an end of line token."
-  (verilog-backward-syntactic-ws)
-  (cond
-   ((bolp)
-    nil)
-   (;-- Anything ending in a ; is complete
-    (= (preceding-char) ?\;)
-    nil)
-   (;-- Could be 'case (foo)' or 'always @(bar)' which is complete
-    ;   also could be simply '@(foo)'
-    ;   or foo u1 #(a=8)
-    ;            (b, ... which ISN'T complete
-    ;;;; Do we need this???
-    (= (preceding-char) ?\))
-    (progn
-      (backward-char)
-      (backward-up-list 1)
-      (verilog-backward-syntactic-ws)
-      (let ((back (point)))
-	(forward-word -1)
-	(cond
-	 ((looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|case\\(\\|[xz]\\)\\|for\\(\\|ever\\)\\|i\\(f\\|nitial\\)\\|repeat\\|while\\)\\>")
-	  (not (looking-at "\\[^:]")))
-	 (t
-	  (goto-char back)
-	  (cond
-	   ((= (preceding-char) ?\@)
-	    (backward-char)
-	    (save-excursion
-	      (verilog-backward-token)
-	      (not (looking-at "\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\|initial\\|while\\)\\>"))))
-	   ((= (preceding-char) ?\#)
-	    t)
-	   (t t))
-	  )))))
-
-   (;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete
-    t
-    (forward-word -1)
-    (cond
-     ((looking-at "\\(else\\)\\|\\(initial\\>\\)\\|\\(always\\(_latch\\|_ff\\|_comb\\)?\\>\\)")
-      t)
-     ((looking-at verilog-indent-reg)
-      nil)
-     (t
-      (let
-	  ((back (point)))
-	(verilog-backward-syntactic-ws)
-	(cond
-	 ((= (preceding-char) ?\:)
-	  (backward-char)
-	  (verilog-backward-syntactic-ws)
-	  (backward-sexp)
-	  (if (looking-at "begin")
-	      nil
-	    t)
-	  )
-	 ((= (preceding-char) ?\#)
-	  (backward-char)
-	  t)
-	 ((= (preceding-char) ?\`)
-	  (backward-char)
-	  t)
-
-	 (t
-	  (goto-char back)
-	  t)
-	 )))))))
-
-(defun verilog-backward-syntactic-ws (&optional bound)
-  "Backward skip over syntactic whitespace for Emacs 19.
-Optional BOUND limits search."
-  (save-restriction
-    (let* ((bound (or bound (point-min))) (here bound) )
-      (if (< bound (point))
-	  (progn
-	    (narrow-to-region bound (point))
-	    (while (/= here (point))
-	      (setq here (point))
-	      (forward-comment (-(buffer-size)))
-	      )))
-      ))
-  t)
-
-(defun verilog-forward-syntactic-ws (&optional bound)
-  "Forward skip over syntactic whitespace for Emacs 19.
-Optional BOUND limits search."
-  (save-restriction
-    (let* ((bound (or bound (point-max)))
-	   (here bound)
-	   )
-      (if (> bound (point))
-	  (progn
-	    (narrow-to-region (point) bound)
-	    (while (/= here (point))
-	      (setq here (point))
-	      (forward-comment (buffer-size))
-	      )))
-      )))
-
-(defun verilog-backward-ws&directives (&optional bound)
-  "Backward skip over syntactic whitespace and compiler directives for Emacs 19.
-Optional BOUND limits search."
-  (save-restriction
-    (let* ((bound (or bound (point-min)))
-	   (here bound)
-	   (p nil) )
-      (if (< bound (point))
-	  (progn
-	    (let ((state
-		   (save-excursion
-		     (parse-partial-sexp (point-min) (point)))))
-	      (cond
-	       ((nth 7 state) ;; in // comment
-		(verilog-re-search-backward "//" nil 'move)
-                (skip-chars-backward "/"))
-	       ((nth 4 state) ;; in /* */ comment
-		(verilog-re-search-backward "/\*" nil 'move))))
-	    (narrow-to-region bound (point))
-	    (while (/= here (point))
-	      (setq here (point))
-	      (forward-comment (-(buffer-size)))
-	      (setq p
-		    (save-excursion
-		      (beginning-of-line)
-		      (cond
-		       ((verilog-within-translate-off)
-			(verilog-back-to-start-translate-off (point-min)))
-		       ((looking-at verilog-directive-re-1)
-			(point))
-		       (t
-			nil))))
-	      (if p (goto-char p))
-	      )))
-      )))
-
-(defun verilog-forward-ws&directives (&optional bound)
-  "Forward skip over syntactic whitespace and compiler directives for Emacs 19.
-Optional BOUND limits search."
-  (save-restriction
-    (let* ((bound (or bound (point-max)))
-	   (here bound)
-	   jump
-	   )
-      (if (> bound (point))
-	  (progn
-	    (let ((state
-		   (save-excursion
-		     (parse-partial-sexp (point-min) (point)))))
-	      (cond
-	       ((nth 7 state) ;; in // comment
-		(verilog-re-search-forward "//" nil 'move))
-	       ((nth 4 state) ;; in /* */ comment
-		(verilog-re-search-forward "/\*" nil 'move))))
-	    (narrow-to-region (point) bound)
-	    (while (/= here (point))
-	      (setq here (point)
-		    jump nil)
-	      (forward-comment (buffer-size))
-	      (save-excursion
-		(beginning-of-line)
-		(if (looking-at verilog-directive-re-1)
-		    (setq jump t)))
-	      (if jump
-		  (beginning-of-line 2))
-	      )))
-      )))
-
-(defun verilog-in-comment-p ()
- "Return true if in a star or // comment."
- (let ((state
-	(save-excursion
-	  (parse-partial-sexp (point-min) (point)))))
-   (or (nth 4 state) (nth 7 state))))
-
-(defun verilog-in-star-comment-p ()
- "Return true if in a star comment."
- (let ((state
-	(save-excursion
-	  (parse-partial-sexp (point-min) (point)))))
-   (nth 4 state)))
-
-(defun verilog-in-slash-comment-p ()
- "Return true if in a slash comment."
- (let ((state
-	(save-excursion
-	  (parse-partial-sexp (point-min) (point)))))
-   (nth 7 state)))
-
-(defun verilog-in-comment-or-string-p ()
- "Return true if in a string or comment."
- (let ((state
-	(save-excursion
-	  (parse-partial-sexp (point-min) (point)))))
-   (or (nth 3 state) (nth 4 state) (nth 7 state)))) ; Inside string or comment)
-
-(defun verilog-in-escaped-name-p ()
- "Return true if in an escaped name."
- (save-excursion
-   (backward-char)
-   (skip-chars-backward "^ \t\n")
-   (if (= (char-after (point) ) ?\\ )
-       t
-     nil)))
-
-(defun verilog-in-paren ()
- "Return true if in a parenthetical expression."
- (let ((state
-	(save-excursion
-	  (parse-partial-sexp (point-min) (point)))))
-   (/= 0 (nth 0 state))))
-
-(defun verilog-parenthesis-depth ()
- "Return non zero if in parenthetical-expression."
- (save-excursion
-   (nth 1 (parse-partial-sexp (point-min) (point)))))
-
-(defun verilog-skip-forward-comment-or-string ()
- "Return true if in a string or comment."
- (let ((state
-	(save-excursion
-	  (parse-partial-sexp (point-min) (point)))))
-   (cond
-    ((nth 3 state)			;Inside string
-     (goto-char (nth 3 state))
-     t)
-    ((nth 7 state)			;Inside // comment
-     (forward-line 1)
-     t)
-    ((nth 4 state)			;Inside any comment (hence /**/)
-     (search-forward "*/"))
-    (t
-     nil))))
-
-(defun verilog-skip-backward-comment-or-string ()
- "Return true if in a string or comment."
- (let ((state
-	(save-excursion
-	  (parse-partial-sexp (point-min) (point)))))
-   (cond
-    ((nth 3 state)			;Inside string
-     (search-backward "\"")
-     t)
-    ((nth 7 state)			;Inside // comment
-     (search-backward "//")
-     (skip-chars-backward "/")
-     t)
-    ((nth 4 state)			;Inside /* */ comment
-     (search-backward "/*")
-     t)
-    (t
-     nil))))
-
-(defun verilog-skip-forward-comment-p ()
-  "If in comment, move to end and return true."
-  (let (state)
-    (progn
-      (setq state
-	    (save-excursion
-	      (parse-partial-sexp (point-min) (point))))
-      (cond
-       ((nth 3 state)
-	t)
-       ((nth 7 state)			;Inside // comment
-	(end-of-line)
-	(forward-char 1)
-	t)
-       ((nth 4 state)			;Inside any comment
-	t)
-       (t
-	nil)))))
-
-(defun verilog-indent-line-relative ()
-  "Cheap version of indent line.
-Only look at a few lines to determine indent level."
-  (interactive)
-  (let ((indent-str)
-	(sp (point)))
-    (if (looking-at "^[ \t]*$")
-	(cond  ;- A blank line; No need to be too smart.
-	 ((bobp)
-	  (setq indent-str (list 'cpp 0)))
-	 ((verilog-continued-line)
-	  (let ((sp1 (point)))
-	    (if (verilog-continued-line)
-		(progn (goto-char sp)
-		       (setq indent-str (list 'statement (verilog-indent-level))))
-	      (goto-char sp1)
-	      (setq indent-str (list 'block (verilog-indent-level)))))
-	  (goto-char sp))
-	 ((goto-char sp)
-	  (setq indent-str (verilog-calculate-indent))))
-      (progn (skip-chars-forward " \t")
-	     (setq indent-str (verilog-calculate-indent))))
-    (verilog-do-indent indent-str)))
-
-(defun verilog-indent-line ()
-  "Indent for special part of code."
-  (verilog-do-indent (verilog-calculate-indent)))
-
-(defun verilog-do-indent (indent-str)
-  (let ((type (car indent-str))
-	(ind (car (cdr indent-str))))
-    (cond
-     (; handle continued exp
-      (eq type 'cexp)
-      (let ((here (point)))
-	(verilog-backward-syntactic-ws)
-	(cond
-	 ((or
-	   (= (preceding-char) ?\,)
-	   (= (preceding-char) ?\])
-	   (save-excursion
-	     (verilog-beg-of-statement-1)
-	     (looking-at verilog-declaration-re)))
-	  (let* ( fst
-		  (val
-		   (save-excursion
-		     (backward-char 1)
-		     (verilog-beg-of-statement-1)
-		     (setq fst (point))
-		     (if (looking-at verilog-declaration-re)
-			 (progn ;; we have multiple words
-			   (goto-char (match-end 0))
-			   (skip-chars-forward " \t")
-			   (cond
-			    ((and verilog-indent-declaration-macros
-				  (= (following-char) ?\`))
-			     (progn
-			       (forward-char 1)
-			       (forward-word 1)
-			       (skip-chars-forward " \t")))
-			    ((= (following-char) ?\[)
-			     (progn
-			       (forward-char 1)
-			       (backward-up-list -1)
-			       (skip-chars-forward " \t")))
-			    )
-			   (current-column))
-		       (progn
-			 (goto-char fst)
-			 (+ (current-column) verilog-cexp-indent))
-		       ))))
-	    (goto-char here)
-	    (indent-line-to val))
-	  )
-	 ((= (preceding-char) ?\) )
-	  (goto-char here)
-	  (let ((val (eval (cdr (assoc type verilog-indent-alist)))))
-	    (indent-line-to val)))
-	 (t
-	  (goto-char here)
-	  (let ((val))
-	    (verilog-beg-of-statement-1)
-	    (if (verilog-re-search-forward "=[ \\t]*" here 'move)
-		(setq val (current-column))
-	      (setq val (eval (cdr (assoc type verilog-indent-alist)))))
-	    (goto-char here)
-	    (indent-line-to val)))
-	 )))
-
-     (; handle inside parenthetical expressions
-      (eq type 'cparenexp)
-      (let ((val (save-excursion
-		   (backward-up-list 1)
-		   (forward-char 1)
-		   (skip-chars-forward " \t")
-		   (current-column))))
-	(indent-line-to val)))
-
-     (;-- Handle the ends
-      (looking-at verilog-end-block-re )
-      (let ((val (if (eq type 'statement)
-		     (- ind verilog-indent-level)
-		   ind)))
-	(indent-line-to val)))
-
-     (;-- Case -- maybe line 'em up
-      (and (eq type 'case) (not (looking-at "^[ \t]*$")))
-      (progn
-	(cond
-	 ((looking-at "\\")
-	  (indent-line-to ind))
-	 (t
-	  (let ((val (eval (cdr (assoc type verilog-indent-alist)))))
-	    (indent-line-to val))))))
-
-     (;-- defun
-      (and (eq type 'defun)
- 	   (looking-at verilog-zero-indent-re))
-      (indent-line-to 0))
-
-     (;-- declaration
-      (and (or
-	    (eq type 'defun)
-	    (eq type 'block))
-	   (looking-at verilog-declaration-re))
-      (verilog-indent-declaration ind))
-
-     (;-- Everything else
-      t
-      (let ((val (eval (cdr (assoc type verilog-indent-alist)))))
-	(indent-line-to val)))
-     )
-    (if (looking-at "[ \t]+$")
-	(skip-chars-forward " \t"))
-    indent-str				; Return indent data
-    ))
-
-(defun verilog-indent-level ()
-  "Return the indent-level the current statement has."
-  (save-excursion
-    (let (par-pos)
-      (beginning-of-line)
-      (setq par-pos (verilog-parenthesis-depth))
-      (while par-pos
-	(goto-char par-pos)
-	(beginning-of-line)
-	(setq par-pos (verilog-parenthesis-depth)))
-      (skip-chars-forward " \t")
-      (current-column))))
-
-(defun verilog-case-indent-level ()
-  "Return the indent-level the current statement has.
-Do not count named blocks or case-statements."
-  (save-excursion
-    (skip-chars-forward " \t")
-    (cond
-     ((looking-at verilog-named-block-re)
-      (current-column))
-     ((and (not (looking-at verilog-case-re))
-	   (looking-at "^[^:;]+[ \t]*:"))
-      (verilog-re-search-forward ":" nil t)
-      (skip-chars-forward " \t")
-      (current-column))
-     (t
-      (current-column)))))
-
-(defun verilog-indent-comment ()
-  "Indent current line as comment."
-  (let* ((stcol
-	  (cond
-	   ((verilog-in-star-comment-p)
-	    (save-excursion
-	      (re-search-backward "/\\*" nil t)
-	      (1+(current-column))))
-	   (comment-column
-	     comment-column )
-	   (t
-	    (save-excursion
-	      (re-search-backward "//" nil t)
-	      (current-column)))
-	   )))
-    (indent-line-to stcol)
-    stcol))
-
-(defun verilog-more-comment ()
-  "Make more comment lines like the previous."
-  (let* ((star 0)
-	 (stcol
-	  (cond
-	   ((verilog-in-star-comment-p)
-	    (save-excursion
-	      (setq star 1)
-	      (re-search-backward "/\\*" nil t)
-	      (1+(current-column))))
-	   (comment-column
-	    comment-column )
-	   (t
-	    (save-excursion
-	      (re-search-backward "//" nil t)
-	      (current-column)))
-	   )))
-    (progn
-      (indent-to stcol)
-      (if (and star
-	       (save-excursion
-		 (forward-line -1)
-		 (skip-chars-forward " \t")
-		 (looking-at "\*")))
-	  (insert "* ")))))
-
-(defun verilog-comment-indent (&optional arg)
-  "Return the column number the line should be indented to.
-ARG is ignored, for `comment-indent-function' compatibility."
-  (cond
-   ((verilog-in-star-comment-p)
-    (save-excursion
-      (re-search-backward "/\\*" nil t)
-      (1+(current-column))))
-   ( comment-column
-     comment-column )
-   (t
-    (save-excursion
-      (re-search-backward "//" nil t)
-      (current-column)))))
-
-;;
-
-(defun verilog-pretty-declarations ()
-  "Line up declarations around point."
-  (interactive)
-  (save-excursion
-    (if (progn
-	  (verilog-beg-of-statement-1)
-	  (looking-at verilog-declaration-re))
-	(let* ((m1 (make-marker))
-	       (e) (r)
-	       (here (point))
-	       (start
-		(progn
-		  (verilog-beg-of-statement-1)
-		  (while (looking-at verilog-declaration-re)
-		    (beginning-of-line)
-		    (setq e (point))
-		    (verilog-backward-syntactic-ws)
-		    (backward-char)
-		    (verilog-beg-of-statement-1)) ;Ack, need to grok `define
-		  e))
-	       (end
-		(progn
-		  (goto-char here)
-		  (verilog-end-of-statement)
-		  (setq e (point))	;Might be on last line
-		  (verilog-forward-syntactic-ws)
-		  (while (looking-at verilog-declaration-re)
-		    (beginning-of-line)
-		    (verilog-end-of-statement)
-		    (setq e (point))
-		    (verilog-forward-syntactic-ws))
-		  e))
-	       (edpos (set-marker (make-marker) end))
-	       (ind)
-	       (base-ind
-		(progn
-		  (goto-char start)
-		  (verilog-do-indent (verilog-calculate-indent))
-		  (verilog-forward-ws&directives)
-		  (current-column)))
-	       )
-	  (goto-char end)
-	  (goto-char start)
-	  (if (> (- end start) 100)
-	      (message "Lining up declarations..(please stand by)"))
-	  ;; Get the beginning of line indent first
-	  (while (progn (setq e (marker-position edpos))
-			(< (point) e))
-	    (indent-line-to base-ind)
-	    (forward-line))
-	  ;; Now find biggest prefix
-	  (setq ind (verilog-get-lineup-indent start edpos))
-	  ;; Now indent each line.
-	  (goto-char start)
-	  (while (progn (setq e (marker-position edpos))
-			(setq r (- e (point)))
-			(> r 0))
-	    (setq e (point))
-	    (message "%d" r)
-	    (cond
-	     ((or (and verilog-indent-declaration-macros
-		       (looking-at verilog-declaration-re-1-macro))
-		  (looking-at verilog-declaration-re-1-no-macro))
-	      (let ((p (match-end 0)))
-		(set-marker m1 p)
-		(if (verilog-re-search-forward "[[#`]" p 'move)
-		    (progn
-		      (forward-char -1)
-		      (just-one-space)
-		      (goto-char (marker-position m1))
-		      (just-one-space)
-		      (indent-to ind))
-		  (progn
-		    (just-one-space)
-		    (indent-to ind))
-		  )))
-	     ((verilog-continued-line-1 start)
-	      (goto-char e)
-	      (indent-line-to ind))
-	     (t 	; Must be comment or white space
-	      (goto-char e)
-	      (verilog-forward-ws&directives)
-	      (forward-line -1))
-	     )
-	    (forward-line 1))
-	  (message "")))))
-
-(defun verilog-pretty-expr (&optional myre)
-  "Line up expressions around point"
-  (interactive)
-  (save-excursion
-    (if (not myre)
-	(setq myre (read-string "Regular Expression: (<=) ")))
-    (if (string-equal myre "") (setq myre "<="))
-    (setq myre (concat "\\(^.*\\)\\(" myre "\\)"))
-    (beginning-of-line)
-    (if (and (not(looking-at verilog-complete-reg))
-	     (looking-at myre))
-	(let* ((m1 (make-marker))
-	       (e) (r)
-	       (here (point))
-	       (start
-		(progn
-		  (beginning-of-line)
-		  (setq e (point))
-		  (verilog-backward-syntactic-ws)
-		  (beginning-of-line)
-		  (while (and (not(looking-at (concat "^\\s-*" verilog-complete-reg)))
-			      (looking-at myre))
-		    (setq e (point))
-		    (verilog-backward-syntactic-ws)
-		    (beginning-of-line)
-		    ) ;Ack, need to grok `define
-		  e))
-	       (end
-		(progn
-		  (goto-char here)
-		  (end-of-line)
-		  (setq e (point))	;Might be on last line
-		  (verilog-forward-syntactic-ws)
-		  (beginning-of-line)
-		  (while (and (not(looking-at (concat "^\\s-*" verilog-complete-reg)))
-			      (looking-at myre))
-		    (end-of-line)
-		    (setq e (point))
-		    (verilog-forward-syntactic-ws)
-		    (beginning-of-line)
-		    )
-		  e))
-	       (edpos (set-marker (make-marker) end))
-	       (ind)
-	       )
-	  (goto-char start)
-	  (verilog-do-indent (verilog-calculate-indent))
-	  (goto-char end)
-	  ;;(insert "/*end*/")
-	  (goto-char start)
-	  ;;(insert "/*start*/")
-	  (if (> (- end start) 100)
-	      (message "Lining up expressions..(please stand by)"))
-	  ;; Get the begining of line indent first
-	  (while (progn (setq e (marker-position edpos))
-			(< (point) e))
-	    (beginning-of-line)
-	    (verilog-just-one-space myre)
-	    (forward-line))
-	  ;; Now find biggest prefix
-	  (setq ind (verilog-get-lineup-indent-2 myre start edpos))
-	  ;; Now indent each line.
-	  (goto-char start)
-	  (while (progn (setq e (marker-position edpos))
-			(setq r (- e (point)))
-			(> r 0))
-	    (setq e (point))
-	    (message "%d" r)
-	    (cond
-	     ((looking-at myre)
-	      (let ((p1 (match-end 1)))
-		(set-marker m1 p1)
-		(progn
-		  (set-marker m1 p1)
-		  (goto-char (marker-position m1))
-		  (indent-to ind)
-		  )))
-	     ((verilog-continued-line-1 start)
-	      (goto-char e)
-	      (indent-line-to ind))
-	     (t 	; Must be comment or white space
-	      (goto-char e)
-	      (verilog-forward-ws&directives)
-	      (forward-line -1))
-	     )
-	    (forward-line 1))
-	  (message "")
-	  ))))
-
-(defun verilog-just-one-space (myre)
-  "Remove extra spaces around regular expression"
-  (interactive)
-  (save-excursion
-    (if (and (not(looking-at verilog-complete-reg))
-			      (looking-at myre))
-	(let ((m1 (make-marker))
-	      (p2 (match-end 2))
-	      (p1 (match-end 1)))
-	  (set-marker m1 p1)
-	  (progn
-	    (set-marker m1 p2)
-	    (goto-char (marker-position m1))
-	    (if (looking-at "\\s-")
-		(just-one-space) )
-	    (set-marker m1 p1)
-	    (goto-char (marker-position m1))
-	    (forward-char -1)
-	    (if (looking-at "\\s-")
-		(just-one-space))
-	    )
-	  ))
-    (message "")))
-
-(defun verilog-indent-declaration (baseind)
-  "Indent current lines as declaration.
-Line up the variable names based on previous declaration's indentation.
-BASEIND is the base indent to offset everything."
-  (interactive)
-  (let ((pos (point-marker))
-	(lim (save-excursion
-	       (verilog-re-search-backward "\\(\\\\)\\|\\(\\\\)" nil 'move)
-	       (point)))
-	(ind)
-	(val)
-	(m1 (make-marker))
-	)
-    ;; Use previous declaration (in this module) as template.
-    (if (verilog-re-search-backward (or (and verilog-indent-declaration-macros
-					     verilog-declaration-re-1-macro)
-					verilog-declaration-re-1-no-macro) lim t)
-	(progn
-	  (goto-char (match-end 0))
-	  (skip-chars-forward " \t")
-	  (setq ind (current-column))
-	  (goto-char pos)
-	  (setq val (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist)))))
-	  (indent-line-to val)
-	  (if (and verilog-indent-declaration-macros
-		   (looking-at verilog-declaration-re-2-macro))
-	      (let ((p (match-end 0)))
-		(set-marker m1 p)
-		(if (verilog-re-search-forward "[[#`]" p 'move)
-		    (progn
-		      (forward-char -1)
-		      (just-one-space)
-		      (goto-char (marker-position m1))
-		      (just-one-space)
-		      (indent-to ind)
-		      )
-		  (if (/= (current-column) ind)
-		      (progn
-			(just-one-space)
-			(indent-to ind))
-		    )))
-	    (if (looking-at verilog-declaration-re-2-no-macro)
-		(let ((p (match-end 0)))
-		  (set-marker m1 p)
-		  (if (verilog-re-search-forward "[[`#]" p 'move)
-		      (progn
-			(forward-char -1)
-			(just-one-space)
-			(goto-char (marker-position m1))
-			(just-one-space)
-			(indent-to ind))
-		    (if (/= (current-column) ind)
-			(progn
-			  (just-one-space)
-			  (indent-to ind))
-		      )))
-	      )))
-      (let ((val (+ baseind (eval (cdr (assoc 'declaration verilog-indent-alist))))))
-	(indent-line-to val))
-      )
-    (goto-char pos)))
-
-(defun verilog-get-lineup-indent (b edpos)
-  "Return the indent level that will line up several lines within the region.
-Region is defined by B and EDPOS."
-  (save-excursion
-    (let ((ind 0) e)
-      (goto-char b)
-      ;; Get rightmost position
-      (while (progn (setq e (marker-position edpos))
-		    (< (point) e))
-	(if (verilog-re-search-forward (or (and verilog-indent-declaration-macros
-						verilog-declaration-re-1-macro)
-					   verilog-declaration-re-1-no-macro) e 'move)
-	    (progn
-	      (goto-char (match-end 0))
-	      (verilog-backward-syntactic-ws)
-	      (if (> (current-column) ind)
-		  (setq ind (current-column)))
-	      (goto-char (match-end 0)))))
-      (if (> ind 0)
-	  (1+ ind)
-	;; No lineup-string found
-	(goto-char b)
-	(end-of-line)
-	(skip-chars-backward " \t")
-	(1+ (current-column))))))
-
-(defun verilog-get-lineup-indent-2 (myre b edpos)
-  "Return the indent level that will line up several lines within the region
-from b to e nicely. The lineup string is str."
-  (save-excursion
-    (let ((ind 0) e)
-      (goto-char b)
-      ;; Get rightmost position
-      (while (progn (setq e (marker-position edpos))
-		    (< (point) e))
-	(if (re-search-forward myre e 'move)
-	    (progn
-	      (goto-char (match-end 0))
-	      (verilog-backward-syntactic-ws)
-	      (if (> (current-column) ind)
-		  (setq ind (current-column)))
-	      (goto-char (match-end 0)))))
-      (if (> ind 0)
-	  (1+ ind)
-	;; No lineup-string found
-	(goto-char b)
-	(end-of-line)
-	(skip-chars-backward " \t")
-	(1+ (current-column))))))
-
-(defun verilog-comment-depth (type val)
-  "A useful mode debugging aide.  TYPE and VAL are comments for insertion."
-  (save-excursion
-    (let
-	((b (prog2
-		(beginning-of-line)
-		(point-marker)
-	      (end-of-line)))
-	 (e (point-marker)))
-      (if (re-search-backward " /\\* \[#-\]# \[a-zA-Z\]+ \[0-9\]+ ## \\*/" b t)
-	  (progn
-	    (replace-match " /* -#  ## */")
-	    (end-of-line))
-	(progn
-	  (end-of-line)
-	  (insert " /* ##  ## */"))))
-    (backward-char 6)
-    (insert
-     (format "%s %d" type val))))
-
-;; 
-;;
-;; Completion
-;;
-(defvar verilog-str nil)
-(defvar verilog-all nil)
-(defvar verilog-pred nil)
-(defvar verilog-buffer-to-use nil)
-(defvar verilog-flag nil)
-(defvar verilog-toggle-completions nil
-  "*True means \\\\[verilog-complete-word] should try all possible completions one by one.
-Repeated use of \\[verilog-complete-word] will show you all of them.
-Normally, when there is more than one possible completion,
-it displays a list of all possible completions.")
-
-
-(defvar verilog-type-keywords
-  '(
-    "and" "buf" "bufif0" "bufif1" "cmos" "defparam" "inout" "input"
-    "integer" "localparam" "logic" "nand" "nmos" "nor" "not" "notif0"
-    "notif1" "or" "output" "parameter" "pmos" "pull0" "pull1" "pullup"
-    "rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran" "rtranif0"
-    "rtranif1" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
-    "triand" "trior" "trireg" "wand" "wire" "wor" "xnor" "xor"
-    )
-  "*Keywords for types used when completing a word in a declaration or parmlist.
-\(eg.  integer, real, reg...)")
-
-(defvar verilog-cpp-keywords
-  '("module" "macromodule" "primitive" "timescale" "define" "ifdef" "ifndef" "else"
-    "endif")
-  "*Keywords to complete when at first word of a line in declarative scope.
-\(eg.  initial, always, begin, assign.)
-The procedures and variables defined within the Verilog program
-will be completed runtime and should not be added to this list.")
-
-(defvar verilog-defun-keywords
-  (append
-   '(
-     "always" "always_comb" "always_ff" "always_latch" "assign"
-     "begin" "end" "generate" "endgenerate" "module" "endmodule"
-     "specify" "endspecify" "function" "endfunction" "initial" "final"
-     "task" "endtask" "primitive" "endprimitive"
-     )
-   verilog-type-keywords)
-  "*Keywords to complete when at first word of a line in declarative scope.
-\(eg.  initial, always, begin, assign.)
-The procedures and variables defined within the Verilog program
-will be completed runtime and should not be added to this list.")
-
-(defvar verilog-block-keywords
-  '(
-    "begin" "break" "case" "continue" "else" "end" "endfunction"
-    "endgenerate" "endinterface" "endpackage" "endspecify" "endtask"
-    "for" "fork" "if" "join" "join_any" "join_none" "repeat" "return"
-    "while")
-  "*Keywords to complete when at first word of a line in behavioral scope.
-\(eg.  begin, if, then, else, for, fork.)
-The procedures and variables defined within the Verilog program
-will be completed runtime and should not be added to this list.")
-
-(defvar verilog-tf-keywords
-  '("begin" "break" "fork" "join" "join_any" "join_none" "case" "end" "endtask" "endfunction" "if" "else" "for" "while" "repeat")
-  "*Keywords to complete when at first word of a line in a task or function.
-\(eg.  begin, if, then, else, for, fork.)
-The procedures and variables defined within the Verilog program
-will be completed runtime and should not be added to this list.")
-
-(defvar verilog-case-keywords
-  '("begin" "fork" "join" "join_any" "join_none" "case" "end" "endcase" "if" "else" "for" "repeat")
-  "*Keywords to complete when at first word of a line in case scope.
-\(eg.  begin, if, then, else, for, fork.)
-The procedures and variables defined within the Verilog program
-will be completed runtime and should not be added to this list.")
-
-(defvar verilog-separator-keywords
-  '("else" "then" "begin")
-  "*Keywords to complete when NOT standing at the first word of a statement.
-\(eg.  else, then.)
-Variables and function names defined within the
-Verilog program are completed runtime and should not be added to this list.")
-
-(defun verilog-string-diff (str1 str2)
-  "Return index of first letter where STR1 and STR2 differs."
-  (catch 'done
-    (let ((diff 0))
-      (while t
-	(if (or (> (1+ diff) (length str1))
-		(> (1+ diff) (length str2)))
-	    (throw 'done diff))
-	(or (equal (aref str1 diff) (aref str2 diff))
-	    (throw 'done diff))
-	(setq diff (1+ diff))))))
-
-;; Calculate all possible completions for functions if argument is `function',
-;; completions for procedures if argument is `procedure' or both functions and
-;; procedures otherwise.
-
-(defun verilog-func-completion (type)
-  "Build regular expression for module/task/function names.
-TYPE is 'module, 'tf for task or function, or t if unknown."
-  (if (string= verilog-str "")
-      (setq verilog-str "[a-zA-Z_]"))
-  (let ((verilog-str (concat (cond
-			     ((eq type 'module) "\\<\\(module\\)\\s +")
-			     ((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
-			     (t "\\<\\(task\\|function\\|module\\)\\s +"))
-			    "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
-	match)
-
-    (if (not (looking-at verilog-defun-re))
-	(verilog-re-search-backward verilog-defun-re nil t))
-    (forward-char 1)
-
-    ;; Search through all reachable functions
-    (goto-char (point-min))
-    (while (verilog-re-search-forward verilog-str (point-max) t)
-      (progn (setq match (buffer-substring (match-beginning 2)
-					   (match-end 2)))
-	     (if (or (null verilog-pred)
-		     (funcall verilog-pred match))
-		 (setq verilog-all (cons match verilog-all)))))
-    (if (match-beginning 0)
-	(goto-char (match-beginning 0)))))
-
-(defun verilog-get-completion-decl (end)
-  "Macro for searching through current declaration (var, type or const)
-for matches of `str' and adding the occurence tp `all' through point END."
-  (let ((re (or (and verilog-indent-declaration-macros
-		     verilog-declaration-re-2-macro)
-		verilog-declaration-re-2-no-macro))
-	decl-end match)
-    ;; Traverse lines
-    (while (and (< (point) end)
-		(verilog-re-search-forward re end t))
-      ;; Traverse current line
-      (setq decl-end (save-excursion (verilog-declaration-end)))
-      (while (and (verilog-re-search-forward verilog-symbol-re decl-end t)
-		  (not (match-end 1)))
-	(setq match (buffer-substring (match-beginning 0) (match-end 0)))
-	(if (string-match (concat "\\<" verilog-str) match)
-	    (if (or (null verilog-pred)
-		    (funcall verilog-pred match))
-		(setq verilog-all (cons match verilog-all)))))
-      (forward-line 1)
-      )
-    )
-  verilog-all
-  )
-
-(defun verilog-type-completion ()
-  "Calculate all possible completions for types."
-  (let ((start (point))
-	goon)
-    ;; Search for all reachable type declarations
-    (while (or (verilog-beg-of-defun)
-	       (setq goon (not goon)))
-      (save-excursion
-	(if (and (< start (prog1 (save-excursion (verilog-end-of-defun)
-						 (point))
-			    (forward-char 1)))
-		 (verilog-re-search-forward
-		  "\\\\|\\<\\(begin\\|function\\|procedure\\)\\>"
-		  start t)
-		 (not (match-end 1)))
-	    ;; Check current type declaration
-	    (verilog-get-completion-decl start))))))
-
-(defun verilog-var-completion ()
-  "Calculate all possible completions for variables (or constants)."
-  (let ((start (point)))
-    ;; Search for all reachable var declarations
-    (verilog-beg-of-defun)
-    (save-excursion
-      ;; Check var declarations
-      (verilog-get-completion-decl start))))
-
-(defun verilog-keyword-completion (keyword-list)
-  "Give list of all possible completions of keywords in KEYWORD-LIST."
-  (mapcar '(lambda (s)
-	     (if (string-match (concat "\\<" verilog-str) s)
-		 (if (or (null verilog-pred)
-			 (funcall verilog-pred s))
-		     (setq verilog-all (cons s verilog-all)))))
-	  keyword-list))
-
-
-(defun verilog-completion (verilog-str verilog-pred verilog-flag)
-  "Function passed to `completing-read', `try-completion' or `all-completions'.
-Called to get completion on VERILOG-STR.  If VERILOG-PRED is non-nil, it
-must be a function to be called for every match to check if this should
-really be a match.  If VERILOG-FLAG is t, the function returns a list of all
-possible completions.  If VERILOG-FLAG is nil it returns a string, the
-longest possible completion, or t if STR is an exact match.  If VERILOG-FLAG
-is 'lambda, the function returns t if STR is an exact match, nil
-otherwise."
-  (save-excursion
-    (let ((verilog-all nil))
-      ;; Set buffer to use for searching labels. This should be set
-      ;; within functions which use verilog-completions
-      (set-buffer verilog-buffer-to-use)
-
-      ;; Determine what should be completed
-      (let ((state (car (verilog-calculate-indent))))
-	(cond ((eq state 'defun)
-	       (save-excursion (verilog-var-completion))
-	       (verilog-func-completion 'module)
-	       (verilog-keyword-completion verilog-defun-keywords))
-
-	      ((eq state 'behavioral)
-	       (save-excursion (verilog-var-completion))
-	       (verilog-func-completion 'module)
-	       (verilog-keyword-completion verilog-defun-keywords))
-
-	      ((eq state 'block)
-	       (save-excursion (verilog-var-completion))
-	       (verilog-func-completion 'tf)
-	       (verilog-keyword-completion verilog-block-keywords))
-
-	      ((eq state 'case)
-	       (save-excursion (verilog-var-completion))
-	       (verilog-func-completion 'tf)
-	       (verilog-keyword-completion verilog-case-keywords))
-
-	      ((eq state 'tf)
-	       (save-excursion (verilog-var-completion))
-	       (verilog-func-completion 'tf)
-	       (verilog-keyword-completion verilog-tf-keywords))
-
-	      ((eq state 'cpp)
-	       (save-excursion (verilog-var-completion))
-	       (verilog-keyword-completion verilog-cpp-keywords))
-
-	      ((eq state 'cparenexp)
-	       (save-excursion (verilog-var-completion)))
-
-	      (t;--Anywhere else
-	       (save-excursion (verilog-var-completion))
-	       (verilog-func-completion 'both)
-	       (verilog-keyword-completion verilog-separator-keywords))))
-
-      ;; Now we have built a list of all matches. Give response to caller
-      (verilog-completion-response))))
-
-(defun verilog-completion-response ()
-  (cond ((or (equal verilog-flag 'lambda) (null verilog-flag))
-	 ;; This was not called by all-completions
-	 (if (null verilog-all)
-	     ;; Return nil if there was no matching label
-	     nil
-	   ;; Get longest string common in the labels
-	   (let* ((elm (cdr verilog-all))
-		  (match (car verilog-all))
-		  (min (length match))
-		  tmp)
-	     (if (string= match verilog-str)
-		 ;; Return t if first match was an exact match
-		 (setq match t)
-	       (while (not (null elm))
-		 ;; Find longest common string
-		 (if (< (setq tmp (verilog-string-diff match (car elm))) min)
-		     (progn
-		       (setq min tmp)
-		       (setq match (substring match 0 min))))
-		 ;; Terminate with match=t if this is an exact match
-		 (if (string= (car elm) verilog-str)
-		     (progn
-		       (setq match t)
-		       (setq elm nil))
-		   (setq elm (cdr elm)))))
-	     ;; If this is a test just for exact match, return nil ot t
-	     (if (and (equal verilog-flag 'lambda) (not (equal match 't)))
-		 nil
-	       match))))
-	;; If flag is t, this was called by all-completions. Return
-	;; list of all possible completions
-	(verilog-flag
-	 verilog-all)))
-
-(defvar verilog-last-word-numb 0)
-(defvar verilog-last-word-shown nil)
-(defvar verilog-last-completions nil)
-
-(defun verilog-complete-word ()
-  "Complete word at current point.
-\(See also `verilog-toggle-completions', `verilog-type-keywords',
-`verilog-start-keywords' and `verilog-separator-keywords'.)"
-  (interactive)
-  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
-	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
-	 (verilog-str (buffer-substring b e))
-	 ;; The following variable is used in verilog-completion
-	 (verilog-buffer-to-use (current-buffer))
-	 (allcomp (if (and verilog-toggle-completions
-			   (string= verilog-last-word-shown verilog-str))
-		      verilog-last-completions
-		    (all-completions verilog-str 'verilog-completion)))
-	 (match (if verilog-toggle-completions
-		    "" (try-completion
-			verilog-str (mapcar '(lambda (elm)
-					      (cons elm 0)) allcomp)))))
-    ;; Delete old string
-    (delete-region b e)
-
-    ;; Toggle-completions inserts whole labels
-    (if verilog-toggle-completions
-	(progn
-	  ;; Update entry number in list
-	  (setq verilog-last-completions allcomp
-		verilog-last-word-numb
-		(if (>= verilog-last-word-numb (1- (length allcomp)))
-		    0
-		  (1+ verilog-last-word-numb)))
-	  (setq verilog-last-word-shown (elt allcomp verilog-last-word-numb))
-	  ;; Display next match or same string if no match was found
-	  (if (not (null allcomp))
-	      (insert "" verilog-last-word-shown)
-	    (insert "" verilog-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 "" verilog-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 verilog-str)
-						(length match)))
-	     (with-output-to-temp-buffer "*Completions*"
-	       (display-completion-list allcomp))
-	     ;; Wait for a key press. Then delete *Completion*  window
-	     (momentary-string-display "" (point))
-	     (delete-window (get-buffer-window (get-buffer "*Completions*")))
-	     )))))
-
-(defun verilog-show-completions ()
-  "Show all possible completions at current point."
-  (interactive)
-  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
-	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
-	 (verilog-str (buffer-substring b e))
-	 ;; The following variable is used in verilog-completion
-	 (verilog-buffer-to-use (current-buffer))
-	 (allcomp (if (and verilog-toggle-completions
-			   (string= verilog-last-word-shown verilog-str))
-		      verilog-last-completions
-		    (all-completions verilog-str 'verilog-completion))))
-    ;; Show possible completions in a temporary buffer.
-    (with-output-to-temp-buffer "*Completions*"
-      (display-completion-list allcomp))
-    ;; Wait for a key press. Then delete *Completion*  window
-    (momentary-string-display "" (point))
-    (delete-window (get-buffer-window (get-buffer "*Completions*")))))
-
-
-(defun verilog-get-default-symbol ()
-  "Return symbol around current point as a string."
-  (save-excursion
-    (buffer-substring (progn
-			(skip-chars-backward " \t")
-			(skip-chars-backward "a-zA-Z0-9_")
-			(point))
-		      (progn
-			(skip-chars-forward "a-zA-Z0-9_")
-			(point)))))
-
-(defun verilog-build-defun-re (str &optional arg)
-  "Return function/task/module starting with STR as regular expression.
-With optional second ARG non-nil, STR is the complete name of the instruction."
-  (if arg
-      (concat "^\\(function\\|task\\|module\\)[ \t]+\\(" str "\\)\\>")
-    (concat "^\\(function\\|task\\|module\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>")))
-
-(defun verilog-comp-defun (verilog-str verilog-pred verilog-flag)
-  "Function passed to `completing-read', `try-completion' or `all-completions'.
-Returns a completion on any function name based on VERILOG-STR prefix.  If
-VERILOG-PRED is non-nil, it must be a function to be called for every match
-to check if this should really be a match.  If VERILOG-FLAG is t, the
-function returns a list of all possible completions.  If it is nil it
-returns a string, the longest possible completion, or t if VERILOG-STR is
-an exact match.  If VERILOG-FLAG is 'lambda, the function returns t if
-VERILOG-STR is an exact match, nil otherwise."
-  (save-excursion
-    (let ((verilog-all nil)
-	  match)
-
-      ;; Set buffer to use for searching labels. This should be set
-      ;; within functions which use verilog-completions
-      (set-buffer verilog-buffer-to-use)
-
-      (let ((verilog-str verilog-str))
-	;; Build regular expression for functions
-	(if (string= verilog-str "")
-	    (setq verilog-str (verilog-build-defun-re "[a-zA-Z_]"))
-	  (setq verilog-str (verilog-build-defun-re verilog-str)))
-	(goto-char (point-min))
-
-	;; Build a list of all possible completions
-	(while (verilog-re-search-forward verilog-str nil t)
-	  (setq match (buffer-substring (match-beginning 2) (match-end 2)))
-	  (if (or (null verilog-pred)
-		  (funcall verilog-pred match))
-	      (setq verilog-all (cons match verilog-all)))))
-
-      ;; Now we have built a list of all matches. Give response to caller
-      (verilog-completion-response))))
-
-(defun verilog-goto-defun ()
-  "Move to specified Verilog module/task/function.
-The default is a name found in the buffer around point.
-If search fails, other files are checked based on
-`verilog-library-directories', `verilog-library-files',
-and `verilog-library-extensions'."
-  (interactive)
-  (let* ((default (verilog-get-default-symbol))
-	 ;; The following variable is used in verilog-comp-function
-	 (verilog-buffer-to-use (current-buffer))
-	 (label (if (not (string= default ""))
-		    ;; Do completion with default
-		    (completing-read (concat "Label: (default " default ") ")
-				     'verilog-comp-defun nil nil "")
-		  ;; There is no default value. Complete without it
-		  (completing-read "Label: "
-				   'verilog-comp-defun nil nil "")))
-	 pt)
-    ;; If there was no response on prompt, use default value
-    (if (string= label "")
-	(setq label default))
-    ;; Goto right place in buffer if label is not an empty string
-    (or (string= label "")
-	(progn
-	  (save-excursion
-	    (goto-char (point-min))
-	    (setq pt (re-search-forward (verilog-build-defun-re label t) nil t)))
-	  (when pt
-	    (goto-char pt)
-	    (beginning-of-line))
-	  pt)
-	(verilog-goto-defun-file label)
-	)))
-
-;; Eliminate compile warning
-(eval-when-compile
-  (if (not (boundp 'occur-pos-list))
-      (defvar occur-pos-list nil "Backward compatibility occur positions.")))
-
-(defun verilog-showscopes ()
-  "List all scopes in this module."
-  (interactive)
-  (let ((buffer (current-buffer))
-	(linenum 1)
-	(nlines 0)
-	(first 1)
-	(prevpos (point-min))
-        (final-context-start (make-marker))
-	(regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)")
-	)
-    (with-output-to-temp-buffer "*Occur*"
-      (save-excursion
-	(message (format "Searching for %s ..." regexp))
-	;; Find next match, but give up if prev match was at end of buffer.
-	(while (and (not (= prevpos (point-max)))
-		    (verilog-re-search-forward regexp nil t))
-	  (goto-char (match-beginning 0))
-	  (beginning-of-line)
-	  (save-match-data
-            (setq linenum (+ linenum (count-lines prevpos (point)))))
-	  (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)))
-		 (tag (format "%3d" linenum))
-		 (empty (make-string (length tag) ?\ ))
-		 tem)
-	    (save-excursion
-	      (setq tem (make-marker))
-	      (set-marker tem (point))
-	      (set-buffer standard-output)
-	      (setq occur-pos-list (cons tem occur-pos-list))
-	      (or first (zerop nlines)
-		  (insert "--------\n"))
-	      (setq first nil)
-	      (insert-buffer-substring buffer start end)
-	      (backward-char (- end start))
-	      (setq tem (if (< nlines 0) (- nlines) nlines))
-	      (while (> tem 0)
-		(insert empty ?:)
-		(forward-line 1)
-		(setq tem (1- tem)))
-	      (let ((this-linenum linenum))
-		(set-marker final-context-start
-			    (+ (point) (- (match-end 0) (match-beginning 0))))
-		(while (< (point) final-context-start)
-		  (if (null tag)
-		      (setq tag (format "%3d" this-linenum)))
-		  (insert tag ?:)))))))
-      (set-buffer-modified-p nil))))
-
-
-;; Highlight helper functions
-(defconst verilog-directive-regexp "\\(translate\\|coverage\\|lint\\)_")
-(defun verilog-within-translate-off ()
-  "Return point if within translate-off region, else nil."
-  (and (save-excursion
-	 (re-search-backward
-	  (concat "//\\s-*.*\\s-*" verilog-directive-regexp "\\(on\\|off\\)\\>")
-	  nil t))
-       (equal "off" (match-string 2))
-       (point)))
-
-(defun verilog-start-translate-off (limit)
-  "Return point before translate-off directive if before LIMIT, else nil."
-  (when (re-search-forward
-	  (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>")
-	  limit t)
-    (match-beginning 0)))
-
-(defun verilog-back-to-start-translate-off (limit)
-  "Return point before translate-off directive if before LIMIT, else nil."
-  (when (re-search-backward
-	  (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>")
-	  limit t)
-    (match-beginning 0)))
-
-(defun verilog-end-translate-off (limit)
-  "Return point after translate-on directive if before LIMIT, else nil."
-
-  (re-search-forward (concat
-		      "//\\s-*.*\\s-*" verilog-directive-regexp "on\\>") limit t))
-
-(defun verilog-match-translate-off (limit)
-  "Match a translate-off block, setting `match-data' and returning t, else nil.
-Bound search by LIMIT."
-  (when (< (point) limit)
-    (let ((start (or (verilog-within-translate-off)
-		     (verilog-start-translate-off limit)))
-	  (case-fold-search t))
-      (when start
-	(let ((end (or (verilog-end-translate-off limit) limit)))
-	  (set-match-data (list start end))
-	  (goto-char end))))))
-
-(defun verilog-font-lock-match-item (limit)
-  "Match, and move over, any declaration item after point.
-Bound search by LIMIT.  Adapted from
-`font-lock-match-c-style-declaration-item-and-skip-to-next'."
-  (condition-case nil
-      (save-restriction
-	(narrow-to-region (point-min) limit)
-	;; match item
-	(when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)")
-	  (save-match-data
-	    (goto-char (match-end 1))
-	    ;; move to next item
-	    (if (looking-at "\\(\\s-*,\\)")
-		(goto-char (match-end 1))
-	      (end-of-line) t))))
-    (error t)))
-
-
-;; Added by Subbu Meiyappan for Header
-
-(defun verilog-header ()
-  "Insert a standard Verilog file header."
-  (interactive)
-  (let ((start (point)))
-  (insert "\
-//-----------------------------------------------------------------------------
-// Title         : 
-// Project       : <project>
-//-----------------------------------------------------------------------------
-// File          : <filename>
-// Author        : <author>
-// Created       : <credate>
-// Last modified : <moddate>
-//-----------------------------------------------------------------------------
-// Description :
-// <description>
-//-----------------------------------------------------------------------------
-// Copyright (c) <copydate> by <company> This model is the confidential and
-// proprietary property of <company> and the possession or use of this
-// file requires a written license from <company>.
-//------------------------------------------------------------------------------
-// Modification history :
-// <modhist>
-//-----------------------------------------------------------------------------
-
-")
-    (goto-char start)
-    (search-forward "<filename>")
-    (replace-match (buffer-name) t t)
-    (search-forward "<author>") (replace-match "" t t)
-    (insert (user-full-name))
-    (insert "  <" (user-login-name) "@" (system-name) ">")
-    (search-forward "<credate>") (replace-match "" t t)
-    (insert-date)
-    (search-forward "<moddate>") (replace-match "" t t)
-    (insert-date)
-    (search-forward "<copydate>") (replace-match "" t t)
-    (insert-year)
-    (search-forward "<modhist>") (replace-match "" t t)
-    (insert-date)
-    (insert " : created")
-    (goto-char start)
-    (let (string)
-      (setq string (read-string "title: "))
-      (search-forward "<title>")
-      (replace-match string t t)
-      (setq string (read-string "project: " verilog-project))
-      (make-variable-buffer-local 'verilog-project)
-      (setq verilog-project string)
-      (search-forward "<project>")
-      (replace-match string t t)
-      (setq string (read-string "Company: " verilog-company))
-      (make-variable-buffer-local 'verilog-company)
-      (setq verilog-company string)
-      (search-forward "<company>")
-      (replace-match string t t)
-      (search-forward "<company>")
-      (replace-match string t t)
-      (search-forward "<company>")
-      (replace-match string t t)
-      (search-backward "<description>")
-      (replace-match "" t t)
-      )))
-
-;; verilog-header Uses the insert-date function
-
-(defun insert-date ()
-  "Insert date from the system."
-  (interactive)
-  (let ((timpos))
-    (setq timpos (point))
-    (if verilog-date-scientific-format
-	(shell-command  "date \"+@%Y/%m/%d\"" t)
-      (shell-command  "date \"+@%d.%m.%Y\"" t))
-    (search-forward "@")
-    (delete-region timpos (point))
-    (end-of-line))
-    (delete-char 1))
-
-(defun insert-year ()
-  "Insert year from the system."
-  (interactive)
-  (let ((timpos))
-    (setq timpos (point))
-    (shell-command  "date \"+@%Y\"" t)
-    (search-forward "@")
-    (delete-region timpos (point))
-    (end-of-line))
-  (delete-char 1))
-
-
-;;
-;; Signal list parsing
-;;
-
-(defsubst verilog-modi-get-decls (modi)
-  (verilog-modi-cache-results modi 'verilog-read-decls))
-
-(defsubst verilog-modi-get-sub-decls (modi)
-  (verilog-modi-cache-results modi 'verilog-read-sub-decls))
-
-;; Signal reading for given module
-;; Note these all take modi's - as returned from the verilog-modi-current function
-(defsubst verilog-modi-get-outputs (modi)
-  (aref (verilog-modi-get-decls modi) 0))
-(defsubst verilog-modi-get-inouts (modi)
-  (aref (verilog-modi-get-decls modi) 1))
-(defsubst verilog-modi-get-inputs (modi)
-  (aref (verilog-modi-get-decls modi) 2))
-(defsubst verilog-modi-get-wires (modi)
-  (aref (verilog-modi-get-decls modi) 3))
-(defsubst verilog-modi-get-regs (modi)
-  (aref (verilog-modi-get-decls modi) 4))
-(defsubst verilog-modi-get-assigns (modi)
-  (aref (verilog-modi-get-decls modi) 5))
-(defsubst verilog-modi-get-consts (modi)
-  (aref (verilog-modi-get-decls modi) 6))
-(defsubst verilog-modi-get-sub-outputs (modi)
-  (aref (verilog-modi-get-sub-decls modi) 0))
-(defsubst verilog-modi-get-sub-inouts (modi)
-  (aref (verilog-modi-get-sub-decls modi) 1))
-(defsubst verilog-modi-get-sub-inputs (modi)
-  (aref (verilog-modi-get-sub-decls modi) 2))
-
-;; Elements of a signal list
-(defsubst verilog-sig-name (sig)
-  (car sig))
-(defsubst verilog-sig-bits (sig)
-  (nth 1 sig))
-(defsubst verilog-sig-comment (sig)
-  (nth 2 sig))
-(defsubst verilog-sig-memory (sig)
-  (nth 3 sig))
-(defsubst verilog-sig-enum (sig)
-  (nth 4 sig))
-(defsubst verilog-sig-signed (sig)
-  (nth 5 sig))
-(defsubst verilog-sig-width (sig)
-  (verilog-make-width-expression (verilog-sig-bits sig)))
-
-(defsubst verilog-alw-get-inputs (sigs)
-  (nth 2 sigs))
-(defsubst verilog-alw-get-outputs (sigs)
-  (nth 0 sigs))
-(defsubst verilog-alw-get-uses-delayed (sigs)
-  (nth 3 sigs))
-
-
-(defun verilog-signals-not-in (in-list not-list)
-  "Return list of signals in IN-LIST that aren't also in NOT-LIST.
-Signals must be in standard (base vector) form."
-  (let (out-list)
-    (while in-list
-      (if (not (assoc (car (car in-list)) not-list))
-	  (setq out-list (cons (car in-list) out-list)))
-      (setq in-list (cdr in-list)))
-    (nreverse out-list)))
-;;(verilog-signals-not-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("EXT" "")))
-
-(defun verilog-signals-in (in-list other-list)
-  "Return list of signals in IN-LIST that are also in other-list.
-Signals must be in standard (base vector) form."
-  (let (out-list)
-    (while in-list
-      (if (assoc (car (car in-list)) other-list)
-	  (setq out-list (cons (car in-list) out-list)))
-      (setq in-list (cdr in-list)))
-    (nreverse out-list)))
-;;(verilog-signals-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("EXT" "")))
-
-(defun verilog-signals-memory (in-list)
-  "Return list of signals in IN-LIST that are memoried (multidimensional)."
-  (let (out-list)
-    (while in-list
-      (if (nth 3 (car in-list))
-	  (setq out-list (cons (car in-list) out-list)))
-      (setq in-list (cdr in-list)))
-    out-list))
-;;(verilog-signals-memory '(("A" nil nil "[3:0]")) '(("B" nil nil nil)))
-
-(defun verilog-signals-sort-compare (a b)
-  "Compare signal A and B for sorting."
-  (string< (car a) (car b)))
-
-(defun verilog-signals-not-params (in-list)
-  "Return list of signals in IN-LIST that aren't parameters or
-numeric constants."
-  (let (out-list)
-    (while in-list
-      (unless (boundp (intern (concat "vh-" (car (car in-list)))))
-	(setq out-list (cons (car in-list) out-list)))
-      (setq in-list (cdr in-list)))
-    (nreverse out-list)))
-
-(defun verilog-signals-combine-bus (in-list)
-  "Return a list of signals in IN-LIST, with busses combined.
-Duplicate signals are also removed.  For example A[2] and A[1] become A[2:1]."
-  (let (combo
-	out-list
-	sig highbit lowbit		; Temp information about current signal
-	sv-name sv-highbit sv-lowbit	; Details about signal we are forming
-	sv-comment sv-memory sv-enum sv-signed sv-busstring
-	bus)
-    ;; Shove signals so duplicated signals will be adjacent
-    (setq in-list (sort in-list `verilog-signals-sort-compare))
-    (while in-list
-      (setq sig (car in-list))
-      ;; No current signal; form from existing details
-      (unless sv-name
-	(setq sv-name    (verilog-sig-name sig)
-	      sv-highbit nil
-	      sv-busstring nil
-	      sv-comment (verilog-sig-comment sig)
-	      sv-memory  (verilog-sig-memory sig)
-	      sv-enum    (verilog-sig-enum sig)
-	      sv-signed  (verilog-sig-signed sig)
-	      combo ""
-	      ))
-      ;; Extract bus details
-      (setq bus (verilog-sig-bits sig))
-      (cond ((and bus
-		  (or (and (string-match "\\[\\([0-9]+\\):\\([0-9]+\\)\\]" bus)
-			   (setq highbit (string-to-int (match-string 1 bus))
-				 lowbit  (string-to-int (match-string 2 bus))))
-		      (and (string-match "\\[\\([0-9]+\\)\\]" bus)
-			   (setq highbit (string-to-int (match-string 1 bus))
-				 lowbit  highbit))))
-	     ;; Combine bits in bus
-	     (if sv-highbit
-		 (setq sv-highbit (max highbit sv-highbit)
-		       sv-lowbit  (min lowbit  sv-lowbit))
-	       (setq sv-highbit highbit
-		     sv-lowbit  lowbit)))
-	    (bus
-	     ;; String, probably something like `preproc:0
-	     (setq sv-busstring bus)))
-      ;; Peek ahead to next signal
-      (setq in-list (cdr in-list))
-      (setq sig (car in-list))
-      (cond ((and sig (equal sv-name (verilog-sig-name sig)))
-	     ;; Combine with this signal
-	     (if (and sv-busstring (not (equal sv-busstring (verilog-sig-bits sig))))
-		 (message (concat "Warning, can't merge into single bus "
-				  sv-name bus
-				  ", the AUTOs may be wrong")))
-	     (if (verilog-sig-comment sig) (setq combo ", ..."))
-	     (setq sv-memory (or sv-memory (verilog-sig-memory sig))
-		   sv-enum   (or sv-enum   (verilog-sig-enum sig))
-		   sv-signed (or sv-signed (verilog-sig-signed sig))))
-	    ;; Doesn't match next signal, add to que, zero in prep for next
-	    ;; Note sig may also be nil for the last signal in the list
-	    (t
-	     (setq out-list
-		   (cons (list sv-name
-			       (or sv-busstring
-				   (if sv-highbit
-				       (concat "[" (int-to-string sv-highbit) ":" (int-to-string sv-lowbit) "]")))
-			       (concat sv-comment combo)
-			       sv-memory sv-enum sv-signed)
-			 out-list)
-		   sv-name nil)))
-      )
-    ;;
-    out-list))
-
-;;
-;; Port/Wire/Etc Reading
-;;
-
-(defun verilog-read-inst-module ()
-  "Return module_name when point is inside instantiation."
-  (save-excursion
-    (verilog-backward-open-paren)
-    ;; Skip over instantiation name
-    (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil)
-    (skip-chars-backward "a-zA-Z0-9`_$")
-    (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_\$]\\|)\\)" nil nil)  ; ) isn't word boundary
-    ;; Check for parameterized instantiations
-    (when (looking-at ")")
-      (verilog-backward-open-paren)
-      (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil))
-    (skip-chars-backward "a-zA-Z0-9'_$")
-    (looking-at "[a-zA-Z0-9`_\$]+")
-    ;; Important: don't use match string, this must work with emacs 19 font-lock on
-    (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
-
-(defun verilog-read-inst-name ()
-  "Return instance_name when point is inside instantiation."
-  (save-excursion
-    (verilog-backward-open-paren)
-    (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil)
-    (skip-chars-backward "a-zA-Z0-9`_$")
-    (looking-at "[a-zA-Z0-9`_\$]+")
-    ;; Important: don't use match string, this must work with emacs 19 font-lock on
-    (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
-
-(defun verilog-read-module-name ()
-  "Return module name when after its ( or ;."
-  (save-excursion
-    (re-search-backward "[(;]")
-    (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil)
-    (skip-chars-backward "a-zA-Z0-9`_$")
-    (looking-at "[a-zA-Z0-9`_\$]+")
-    ;; Important: don't use match string, this must work with emacs 19 font-lock on
-    (buffer-substring-no-properties (match-beginning 0) (match-end 0))))
-
-(defun verilog-read-auto-params (num-param &optional max-param)
-  "Return parameter list inside auto.
-Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
-  (let ((olist))
-    (save-excursion
-      ;; /*AUTOPUNT("parameter", "parameter")*/
-      (search-backward "(")
-      (while (looking-at "(?\\s *\"\\([^\"]*\\)\"\\s *,?")
-	(setq olist (cons (match-string 1) olist))
-	(goto-char (match-end 0))))
-    (or (eq nil num-param)
-	(<= num-param (length olist))
-	(error "%s: Expected %d parameters" (verilog-point-text) num-param))
-    (if (eq max-param nil) (setq max-param num-param))
-    (or (eq nil max-param)
-	(>= max-param (length olist))
-	(error "%s: Expected <= %d parameters" (verilog-point-text) max-param))
-    (nreverse olist)))
-
-(defun verilog-read-decls ()
-  "Compute signal declaration information for the current module at point.
-Return a array of [outputs inouts inputs wire reg assign const]."
-  (let ((end-mod-point (or (verilog-get-end-of-defun t) (point-max)))
-	(functask 0) (paren 0)
-	sigs-in sigs-out sigs-inout sigs-wire sigs-reg sigs-assign sigs-const
-	vec expect-signal keywd newsig rvalue enum io signed)
-    (save-excursion
-      (verilog-beg-of-defun)
-      (setq sigs-const (verilog-read-auto-constants (point) end-mod-point))
-      (while (< (point) end-mod-point)
-	;;(if dbg (setq dbg (cons (format "Pt %s  Vec %s   Kwd'%s'\n" (point) vec keywd) dbg)))
-	(cond
-	 ((looking-at "//")
-	  (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
-	      (setq enum (match-string 1)))
-	  (search-forward "\n"))
-	 ((looking-at "/\\*")
-	  (forward-char 2)
-	  (if (looking-at "[^*]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
-	      (setq enum (match-string 1)))
-	  (or (search-forward "*/")
-	      (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
-	 ((eq ?\" (following-char))
-	  (or (re-search-forward "[^\\]\"" nil t)	;; don't forward-char first, since we look for a non backslash first
-	      (error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point))))
-	 ((eq ?\; (following-char))
-	  (setq vec nil  io nil  expect-signal nil  newsig nil  paren 0  rvalue nil)
-	  (forward-char 1))
-	 ((eq ?= (following-char))
-	  (setq rvalue t newsig nil)
-	  (forward-char 1))
-	 ((and rvalue
-	       (cond ((and (eq ?, (following-char))
-			   (eq paren 0))
-		      (setq rvalue nil)
-		      (forward-char 1)
-		      t)
-		     ;; ,'s can occur inside {} & funcs
-		     ((looking-at "[{(]")
-		      (setq paren (1+ paren))
-		      (forward-char 1)
-		      t)
-		     ((looking-at "[})]")
-		      (setq paren (1- paren))
-		      (forward-char 1)
-		      t)
-		     )))
-	 ((looking-at "\\s-*\\(\\[[^]]+\\]\\)")
-	  (goto-char (match-end 0))
-	  (cond (newsig	; Memory, not just width.  Patch last signal added's memory (nth 3)
-		 (setcar (cdr (cdr (cdr newsig))) (match-string 1)))
-		(t ;; Bit width
-		 (setq vec (verilog-string-replace-matches
-			    "\\s-+" "" nil nil (match-string 1))))))
-	 ;; Normal or escaped identifier -- note we remember the \ if escaped
-	 ((looking-at "\\s-*\\([a-zA-Z0-9`_$]+\\|\\\\[^ \t\n]+\\)")
-	  (goto-char (match-end 0))
-	  (setq keywd (match-string 1))
-	  (when (string-match "^\\\\" keywd)
-	    (setq keywd (concat keywd " ")))  ;; Escaped ID needs space at end
-	  (cond ((equal keywd "input")
-		 (setq vec nil enum nil  newsig nil  signed nil  io t  expect-signal 'sigs-in))
-		((equal keywd "output")
-		 (setq vec nil enum nil  newsig nil  signed nil  io t  expect-signal 'sigs-out))
-		((equal keywd "inout")
-		 (setq vec nil enum nil  newsig nil  signed nil  io t  expect-signal 'sigs-inout))
- 		((or (equal keywd "wire")
- 		     (equal keywd "tri"))
-		 (unless io (setq vec nil  enum nil  signed nil  expect-signal 'sigs-wire)))
- 		((or (equal keywd "reg")
- 		     (equal keywd "trireg"))
-		 (unless io (setq vec nil  enum nil  signed nil  expect-signal 'sigs-reg)))
-		((equal keywd "assign")
-		 (setq vec nil  enum nil  signed nil  expect-signal 'sigs-assign))
-		((or (equal keywd "supply0")
-		     (equal keywd "supply1")
-		     (equal keywd "supply")
-		     (equal keywd "parameter")
-		     (equal keywd "localparam"))
-		 (unless io (setq vec nil  enum nil  signed nil  expect-signal 'sigs-const)))
-		((equal keywd "signed")
-		 (setq signed "signed"))
-		((or (equal keywd "function")
-		     (equal keywd "task"))
-		 (setq functask (1+ functask)))
-		((or (equal keywd "endfunction")
-		     (equal keywd "endtask"))
-		 (setq functask (1- functask)))
-		((and expect-signal
-		      (eq functask 0)
-		      (not (member keywd verilog-keywords))
-		      (not rvalue))
-		 ;; Add new signal to expect-signal's variable
-		 (setq newsig (list keywd vec nil nil enum signed))
-		 (set expect-signal (cons newsig
-					  (symbol-value expect-signal))))))
-	 (t
-	  (forward-char 1)))
-	(skip-syntax-forward " "))
-      ;; Return arguments
-      (vector (nreverse sigs-out)
-	      (nreverse sigs-inout)
-	      (nreverse sigs-in)
-	      (nreverse sigs-wire)
-	      (nreverse sigs-reg)
-	      (nreverse sigs-assign)
-	      (nreverse sigs-const)
-	      ))))
-
-(defvar sigs-in nil) ; Prevent compile warning
-(defvar sigs-inout nil) ; Prevent compile warning
-(defvar sigs-out nil) ; Prevent compile warning
-
-(defun verilog-read-sub-decls-line (submodi comment)
-  "For read-sub-decl, read lines of port defs until none match anymore.
-Return the list of signals found, using submodi to look up each port."
-  (let (done port portdata sig vec)
-    (save-excursion
-      (forward-line 1)
-      (while (not done)
-	;; Get port name
-	(cond ((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*(\\s-*")
-	       (setq port (match-string 1))
-	       (goto-char (match-end 0)))
-	      ((looking-at "\\s-*\\.\\s-*\\(\\\\[^ \t\n]*\\)\\s-*(\\s-*")
-	       (setq port (concat (match-string 1) " ")) ;; escaped id's need trailing space
-	       (goto-char (match-end 0)))
-	      ((looking-at "\\s-*\\.[^(]*(")
-	       (setq port nil) ;; skip this line
-	       (goto-char (match-end 0)))
-	      (t
-	       (setq port nil  done t))) ;; Unknown, ignore rest of line
-	;; Get signal name
-	(when port
-	  (cond ((looking-at "\\(\\\\[^ \t\n]*\\)\\s-*)")
-		 (setq sig (concat (match-string 1) " ") ;; escaped id's need trailing space
-		       vec nil))
-		; We intentionally ignore (non-escaped) signals with .s in them
-		; this prevents AUTOWIRE etc from noticing hierarchical sigs.
-		((looking-at "\\([^[({).]*\\)\\s-*)")
-		 (setq sig (verilog-string-remove-spaces (match-string 1))
-		       vec nil))
-		((looking-at "\\([^[({).]*\\)\\s-*\\(\\[[^]]+\\]\\)\\s-*)")
-		 (setq sig (verilog-string-remove-spaces (match-string 1))
-		       vec (verilog-symbol-detick-denumber (match-string 2))))
-		(t
-		 (setq sig nil)))
-	  ;; Process signals
-	  (when sig
-	    (setq port (verilog-symbol-detick-denumber port))
-	    (setq sig  (verilog-symbol-detick-denumber sig))
-	    (unless (or (not sig)
-			(equal sig ""))  ;; Ignore .foo(1'b1) assignments
-	      (cond ((setq portdata (assoc port (verilog-modi-get-inouts submodi)))
-		     (setq sigs-inout (cons (list sig vec (concat "To/From " comment) nil nil
-		   				  (verilog-sig-signed portdata)) sigs-inout)))
-		    ((setq portdata (assoc port (verilog-modi-get-outputs submodi)))
-		     (setq sigs-out   (cons (list sig vec (concat "From " comment) nil nil
-						  (verilog-sig-signed portdata)) sigs-out)))
-		    ((setq portdata (assoc port (verilog-modi-get-inputs submodi)))
-		     (setq sigs-in    (cons (list sig vec (concat "To " comment) nil nil
-						  (verilog-sig-signed portdata)) sigs-in)))
-		    ;; (t  -- warning pin isn't defined.)   ; Leave for lint tool
-		    )
-	      )))
-	;;
-	(forward-line 1)))))
-
-(defun verilog-read-sub-decls ()
-  "Parse signals going to modules under this module.
-Return a array of [ outputs inouts inputs ] signals for modules that are
-instantiated in this module.  For example if declare A A (.B(SIG)) and SIG
-is a output, then SIG will be included in the list.
-
-This only works on instantiations created with /*AUTOINST*/ converted by
-\\[verilog-auto-instant].  Otherwise, it would have to read in the whole
-component library to determine connectivity of the design."
-  (save-excursion
-    (let ((end-mod-point (verilog-get-end-of-defun t))
-	  st-point end-inst-point
-	  ;; below 3 modified by verilog-read-sub-decls-line
-	  sigs-out sigs-inout sigs-in)
-      (verilog-beg-of-defun)
-      (while (search-forward "/*AUTOINST*/" end-mod-point t)
-	(save-excursion
-	  (goto-char (match-beginning 0))
-	  (unless (verilog-inside-comment-p)
-	    ;; Attempt to snarf a comment
-	    (let* ((submod (verilog-read-inst-module))
-		   (inst (verilog-read-inst-name))
-		   (comment (concat inst " of " submod ".v")) submodi)
-	      (when (setq submodi (verilog-modi-lookup submod t))
-		;; This could have used a list created by verilog-auto-instant
-		;; However I want it to be runnable even on user's manually added signals
-		(verilog-backward-open-paren)
-		(setq end-inst-point (save-excursion (forward-sexp 1) (point))
-		      st-point (point))
-		(while (re-search-forward "^\\s *// Outputs" end-inst-point t)
-		  (verilog-read-sub-decls-line submodi comment)) ;; Modifies sigs-out
-		(goto-char st-point)
-		(while (re-search-forward "\\s *// Inouts" end-inst-point t)
-		  (verilog-read-sub-decls-line submodi comment)) ;; Modifies sigs-inout
-		(goto-char st-point)
-		(while (re-search-forward "\\s *// Inputs" end-inst-point t)
-		  (verilog-read-sub-decls-line submodi comment)) ;; Modifies sigs-in
-		)))))
-      ;; Combine duplicate bits
-      ;;(setq rr (vector sigs-out sigs-inout sigs-in))
-      (vector (verilog-signals-combine-bus (nreverse sigs-out))
-	      (verilog-signals-combine-bus (nreverse sigs-inout))
-	      (verilog-signals-combine-bus (nreverse sigs-in))))))
-
-(defun verilog-read-inst-pins ()
-  "Return a array of [ pins ] for the current instantiation at point.
-For example if declare A A (.B(SIG)) then B will be included in the list."
-  (save-excursion
-    (let ((end-mod-point (point))	;; presume at /*AUTOINST*/ point
-	  pins pin)
-      (verilog-backward-open-paren)
-      (while (re-search-forward "\\.\\([^( \t\n]*\\)\\s-*(" end-mod-point t)
-	(setq pin (match-string 1))
-	(unless (verilog-inside-comment-p)
-	  (setq pins (cons (list pin) pins))))
-      (vector pins))))
-
-(defun verilog-read-arg-pins ()
-  "Return a array of [ pins ] for the current argument declaration at point."
-  (save-excursion
-    (let ((end-mod-point (point))	;; presume at /*AUTOARG*/ point
-	  pins pin)
-      (verilog-backward-open-paren)
-      (while (re-search-forward "\\([a-zA-Z0-9$_.%`]+\\)" end-mod-point t)
-	(setq pin (match-string 1))
-	(unless (verilog-inside-comment-p)
-	  (setq pins (cons (list pin) pins))))
-      (vector pins))))
-
-(defun verilog-read-auto-constants (beg end-mod-point)
-  "Return a list of AUTO_CONSTANTs used in the region from BEG to END-MOD-POINT."
-  ;; Insert new
-  (save-excursion
-    (let (sig-list tpl-end-pt)
-      (goto-char beg)
-      (while (re-search-forward "\\<AUTO_CONSTANT" end-mod-point t)
-	(if (not (looking-at "\\s *("))
-	    (error "%s: Missing () after AUTO_CONSTANT" (verilog-point-text)))
-	(search-forward "(" end-mod-point)
-	(setq tpl-end-pt (save-excursion
-			   (backward-char 1)
-			   (forward-sexp 1)   ;; Moves to paren that closes argdecl's
-			   (backward-char 1)
-			   (point)))
-	(while (re-search-forward "\\s-*\\([\"a-zA-Z0-9$_.%`]+\\)\\s-*,*" tpl-end-pt t)
-	  (setq sig-list (cons (list (match-string 1) nil nil) sig-list))))
-      sig-list)))
-
-(defun verilog-read-auto-lisp (start end)
-  "Look for and evaluate a AUTO_LISP between START and END."
-  (save-excursion
-    (goto-char start)
-    (while (re-search-forward "\\<AUTO_LISP(" end t)
-      (backward-char)
-      (let* ((beg-pt (prog1 (point)
-		       (forward-sexp 1)))	;; Closing paren
-	     (end-pt (point)))
-	(eval-region beg-pt end-pt nil)))))
-
-(eval-when-compile
-  ;; These are passed in a let, not global
-  (if (not (boundp 'sigs-in))
-      (defvar sigs-in nil) (defvar sigs-out nil)
-      (defvar got-sig nil) (defvar got-rvalue nil) (defvar uses-delayed nil)))
-
-(defun verilog-read-always-signals-recurse
-  (exit-keywd rvalue ignore-next)
-  "Recursive routine for parentheses/bracket matching.
-EXIT-KEYWD is expression to stop at, nil if top level.
-RVALUE is true if at right hand side of equal.
-IGNORE-NEXT is true to ignore next token, fake from inside case statement."
-  (let* ((semi-rvalue (equal "endcase" exit-keywd)) ;; true if after a ; we are looking for rvalue
-	 keywd last-keywd sig-tolk sig-last-tolk gotend end-else-check)
-    ;;(if dbg (setq dbg (concat dbg (format "Recursion %S %S %S\n" exit-keywd rvalue ignore-next))))
-    (while (not (or (eobp) gotend))
-      (cond
-       ((looking-at "//")
-	(search-forward "\n"))
-       ((looking-at "/\\*")
-	(or (search-forward "*/")
-	    (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
-       (t (setq keywd (buffer-substring-no-properties
-		       (point)
-		       (save-excursion (when (eq 0 (skip-chars-forward "a-zA-Z0-9$_.%`"))
-					 (forward-char 1))
-				       (point)))
-		sig-last-tolk sig-tolk
-		sig-tolk nil)
-	  ;;(if dbg (setq dbg (concat dbg (format "\tPt %S %S\t%S %S %S\n" (point) keywd rvalue ignore-next end-else-check))))
-	  (cond
-	   ((equal keywd "\"")
-	    (or (re-search-forward "[^\\]\"" nil t)
-		(error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point))))
-	   ;; else at top level loop, keep parsing
-	   ((and end-else-check (equal keywd "else"))
-	    ;;(if dbg (setq dbg (concat dbg (format "\tif-check-else %s\n" keywd))))
-	    ;; no forward movement, want to see else in lower loop
-	    (setq end-else-check nil))
-	   ;; End at top level loop
-	   ((and end-else-check (looking-at "[^ \t\n]"))
-	    ;;(if dbg (setq dbg (concat dbg (format "\tif-check-else-other %s\n" keywd))))
-	    (setq gotend t))
-	   ;; Final statement?
-	   ((and exit-keywd (equal keywd exit-keywd))
-	    (setq gotend t)
-	    (forward-char (length keywd)))
-	   ;; Standard tokens...
-	   ((equal keywd ";")
-	    (setq ignore-next nil rvalue semi-rvalue)
-	    ;; Final statement at top level loop?
-	    (when (not exit-keywd)
-	      ;;(if dbg (setq dbg (concat dbg (format "\ttop-end-check %s\n" keywd))))
-	      (setq end-else-check t))
-	    (forward-char 1))
-	   ((equal keywd "'")
-	    (if (looking-at "'s?[hdxbo][0-9a-fA-F_xz? \t]*")
-		(goto-char (match-end 0))
-	      (forward-char 1)))
-	   ((equal keywd ":")	;; Case statement, begin/end label, x?y:z
-	    (cond ((equal "endcase" exit-keywd)  ;; case x: y=z; statement next
-		   (setq ignore-next nil rvalue nil))
-		  ((not rvalue)	;; begin label
-		   (setq ignore-next t rvalue nil)))
-	    (forward-char 1))
-	   ((equal keywd "=")
-	    (if (eq (char-before) ?< )
-		(setq uses-delayed 1))
-	    (setq ignore-next nil rvalue t)
-	    (forward-char 1))
-	   ((equal keywd "?")
-	    (forward-char 1)
-	    (verilog-read-always-signals-recurse ":" rvalue nil))
-	   ((equal keywd "[")
-	    (forward-char 1)
-	    (verilog-read-always-signals-recurse "]" t nil))
-	   ((equal keywd "(")
-	    (forward-char 1)
-	    (cond (sig-last-tolk	;; Function call; zap last signal
-		   (setq got-sig nil)))
-	    (cond ((equal last-keywd "for")
-		   (verilog-read-always-signals-recurse ";" nil nil)
-		   (verilog-read-always-signals-recurse ";" t nil)
-		   (verilog-read-always-signals-recurse ")" nil nil))
-		  (t (verilog-read-always-signals-recurse ")" t nil))))
-	   ((equal keywd "begin")
-	    (skip-syntax-forward "w_")
-	    (verilog-read-always-signals-recurse "end" nil nil)
-	    ;;(if dbg (setq dbg (concat dbg (format "\tgot-end %s\n" exit-keywd))))
-	    (setq ignore-next nil rvalue semi-rvalue)
-	    (if (not exit-keywd) (setq end-else-check t)))
-	   ((or (equal keywd "case")
-		(equal keywd "casex")
-		(equal keywd "casez"))
-	    (skip-syntax-forward "w_")
-	    (verilog-read-always-signals-recurse "endcase" t nil)
-	    (setq ignore-next nil rvalue semi-rvalue)
-	    (if (not exit-keywd) (setq gotend t)))	;; top level begin/end
-	   ((string-match "^[$`a-zA-Z_]" keywd)	;; not exactly word constituent
-	    (cond ((equal keywd "`ifdef")
-		   (setq ignore-next t))
-		  ((or ignore-next
-		       (member keywd verilog-keywords)
-		       (string-match "^\\$" keywd))	;; PLI task
-		   (setq ignore-next nil))
-		  (t
-		   (setq keywd (verilog-symbol-detick-denumber keywd))
-		   (if got-sig (if got-rvalue
-				   (setq sigs-in (cons got-sig sigs-in))
-				 (setq sigs-out (cons got-sig sigs-out))))
-		   (setq got-rvalue rvalue
-			 got-sig (if (or (not keywd)
-					 (assoc keywd (if got-rvalue sigs-in sigs-out)))
-				     nil (list keywd nil nil))
-			 sig-tolk t)))
-	    (skip-chars-forward "a-zA-Z0-9$_.%`"))
-	   (t
-	    (forward-char 1)))
-	  ;; End of non-comment token
-	  (setq last-keywd keywd)
-	  ))
-      (skip-syntax-forward " "))
-    ;;(if dbg (setq dbg (concat dbg (format "ENDRecursion %s\n" exit-keywd))))
-    ))
-
-(defun verilog-read-always-signals ()
-  "Parse always block at point and return list of (outputs inout inputs)."
-  ;; Insert new
-  (save-excursion
-    (let* (;;(dbg "")
-	   sigs-in sigs-out
-	   got-sig got-rvalue
-	   uses-delayed)	;; Found signal/rvalue; push if not function
-      (search-forward ")")
-      (verilog-read-always-signals-recurse nil nil nil)
-      ;; Return what was found
-      (if got-sig (if got-rvalue
-		      (setq sigs-in (cons got-sig sigs-in))
-		    (setq sigs-out (cons got-sig sigs-out))))
-      ;;(if dbg (message dbg))
-      (list sigs-out nil sigs-in uses-delayed))))
-
-(defun verilog-read-instants ()
-  "Parse module at point and return list of ( ( file instance ) ... )."
-  (verilog-beg-of-defun)
-  (let* ((end-mod-point (verilog-get-end-of-defun t))
-	 (state nil)
-	 (instants-list nil))
-    (save-excursion
-      (while (< (point) end-mod-point)
-	;; Stay at level 0, no comments
-	(while (progn
-		 (setq state (parse-partial-sexp (point) end-mod-point 0 t nil))
-		 (or (> (car state) 0)	; in parens
-		     (nth 5 state)		; comment
-		     ))
-	  (forward-line 1))
-	(beginning-of-line)
-	(if (looking-at "^\\s-*\\([a-zA-Z0-9`_$]+\\)\\s-+\\([a-zA-Z0-9`_$]+\\)\\s-*(")
-	    ;;(if (looking-at "^\\(.+\\)$")
-	    (let ((module (match-string 1))
-		  (instant (match-string 2)))
-	      (if (not (member module verilog-keywords))
-		  (setq instants-list (cons (list module instant) instants-list)))))
-	(forward-line 1)
-	))
-    instants-list))
-
-
-(defun verilog-read-auto-template (module)
-  "Look for a auto_template for the instantiation of the given MODULE.
-If found returns the signal name connections.  Return nil or list of
- ( (signal_name connection_name)... )"
-  (save-excursion
-    ;; Find beginning
-    (let (tpl-sig-list tpl-wild-list tpl-end-pt rep (lineno 0) (templateno 0))
-      (cond ((or
-	       (re-search-backward (concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t)
-	       (progn
-		 (goto-char (point-min))
-		 (re-search-forward (concat "^\\s-*/?\\*?\\s-*" module "\\s-+AUTO_TEMPLATE") nil t)))
-	     (search-forward "(")
-	     (when verilog-auto-inst-template-numbers
-	       (save-excursion
-		 (goto-char (point-min))
-		 (while (search-forward "AUTO_TEMPLATE" nil t)
-		   (setq templateno (1+ templateno)))))
-	     (setq tpl-end-pt (save-excursion
-				(backward-char 1)
-				(forward-sexp 1)   ;; Moves to paren that closes argdecl's
-				(backward-char 1)
-				(point)))
-	     ;;
-	     (while (< (point) tpl-end-pt)
-	       (cond ((looking-at "\\s-*\\.\\([a-zA-Z0-9`_$]+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
-		      (setq tpl-sig-list (cons (list
-						(match-string-no-properties 1)
-						(match-string-no-properties 2)
-						templateno lineno)
-					       tpl-sig-list))
-		      (goto-char (match-end 0)))
-		     ;; Regexp form??
-		     ((looking-at
-		       ;; Regexp bug in xemacs disallows ][ inside [], and wants + last
-		       "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]+\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
-		      (setq rep (match-string-no-properties 3))
-		      (goto-char (match-end 0))
-		      (setq tpl-wild-list
-			    (cons (list
-				   (concat "^"
-					   (verilog-string-replace-matches "@" "\\\\([0-9]+\\\\)" nil nil
-									   (match-string 1))
-					   "$")
-				   rep
-				   templateno lineno)
-				  tpl-wild-list)))
-		     ((looking-at "[ \t\f]+")
-		      (goto-char (match-end 0)))
-		     ((looking-at "\n")
-		      (setq lineno (1+ lineno))
-		      (goto-char (match-end 0)))
-		     ((looking-at "//")
-		      (search-forward "\n"))
-		     ((looking-at "/\\*")
-		      (forward-char 2)
-		      (or (search-forward "*/")
-			  (error "%s: Unmatched /* */, at char %d" (verilog-point-text) (point))))
-		     (t
-		      (error "%s: AUTO_TEMPLATE parsing error: %s"
-			     (verilog-point-text)
-			     (progn (looking-at ".*$") (match-string 0))))
-		     ))
-	     ;;
-	     (list tpl-sig-list tpl-wild-list)
-	     )))))
-;;(progn (find-file "auto-template.v") (verilog-read-auto-template "ptl_entry"))
-
-(defun verilog-set-define (defname defvalue &optional buffer enumname)
-  "In BUFFER, set the definition DEFNAME to the DEFVALUE."
-  (save-excursion
-    (set-buffer (or buffer (current-buffer)))
-    (let ((mac (intern (concat "vh-" defname))))
-      ;;(message "Define %s=%s" defname defvalue) (sleep-for 1)
-      (set (make-variable-buffer-local mac) defvalue))
-    (if enumname
-	(let ((enumvar (intern (concat "venum-" enumname))))
-	  ;;(message "Define %s=%s" defname defvalue) (sleep-for 1)
-	  (make-variable-buffer-local enumvar)
-	  (add-to-list enumvar defname)))
-    ))
-
-(defun verilog-read-defines (&optional filename recurse)
-  "Read `defines and parameters for the current file, or optional FILENAME.
-If the filename is provided, `verilog-library-directories' and
-`verilog-library-extensions' will be used to resolve it.  If optional
-RECURSE is non-nil, recurse through `includes.
-
-Parameters must be simple assignments to constants, or have their own
-\"parameter\" label rather then a list of parameters.  Thus:
-
-    parameter X = 5, Y = 10;	// Ok
-    parameter X = {1'b1, 2'h2};	// Ok
-    parameter X = {1'b1, 2'h2}, Y = 10;	// Bad, make into 2 parameter lines
-
-Defines must be simple text substitutions, one on a line, starting
-at the beginning of the line.  Any ifdefs or multiline comments around the
-define are ignored.
-
-Defines are stored inside Emacs variables using the name vh-{definename}.
-
-This function is useful for setting vh-* variables.  The file variables
-feature can be used to set defines that `verilog-mode' can see; put at the
-*END* of your file something like:
-
-// Local Variables:
-// vh-macro:\"macro_definition\"
-// End:
-
-If macros are defined earlier in the same file and you want their values,
-you can read them automatically (provided `enable-local-eval' is on):
-
-// Local Variables:
-// eval:(verilog-read-defines)
-// eval:(verilog-read-defines \"group_standard_includes.v\")
-// End:
-
-Note these are only read when the file is first visited, you must use
-\\[find-alternate-file] RET  to have these take effect after editing them!
-
-If you want to disable the \"Process `eval' or hook local variables\"
-warning message, you need to add to your .emacs file:
-
-(setq enable-local-eval t)
-"
-  (let ((origbuf (current-buffer)))
-    (save-excursion
-      (when filename
-	(let ((fns (verilog-library-filenames filename (buffer-file-name))))
-	  (if fns
-	      (set-buffer (find-file-noselect (car fns)))
-	    (error (concat (verilog-point-text)
-			   ": Can't find verilog-read-defines file: " filename)))))
-      (when recurse
-	(goto-char (point-min))
-	(while (re-search-forward "^\\s-*`include\\s-+\\([^ \t\n]+\\)" nil t)
-	  (let ((inc (verilog-string-replace-matches "\"" "" nil nil (match-string-no-properties 1))))
-	    (unless (verilog-inside-comment-p)
-	      (verilog-read-defines inc recurse)))))
-      ;; Read `defines
-      ;; note we don't use verilog-re... it's faster this way, and that
-      ;; function has problems when comments are at the end of the define
-      (goto-char (point-min))
-      (while (re-search-forward "^\\s-*`define\\s-+\\([a-zA-Z0-9_$]+\\)\\s-+\\(.*\\)$" nil t)
-	(let ((defname (match-string-no-properties 1))
-	      (defvalue (match-string-no-properties 2)))
-	  (setq defvalue (verilog-string-replace-matches "\\s-*/[/*].*$" "" nil nil defvalue))
-	  (verilog-set-define defname defvalue origbuf)))
-      ;; Hack: Read parameters
-      (goto-char (point-min))
-      (while (re-search-forward
-	      "^\\s-*\\(parameter\\|localparam\\)\\(\\(\\s-*\\[[^]]*\\]\\|\\)\\s-+\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\|\\)\\s-*" nil t)
-	(let ((var (match-string-no-properties 4))
-	      (val (match-string-no-properties 5))
-	      enumname)
-	  ;; The primary way of getting defines is verilog-read-decls
-	  ;; However, that isn't called yet for included files, so we'll add another scheme
-	  (if (looking-at "[^\n]*synopsys\\s +enum\\s +\\([a-zA-Z0-9_]+\\)")
-	      (setq enumname (match-string-no-properties 1)))
-	  (if var
-	    (verilog-set-define var val origbuf enumname))
-	  (forward-comment 999)
-	  (while (looking-at "\\s-*,?\\s-*\\([a-zA-Z0-9_$]+\\)\\s-*=\\s-*\\([^;,]*\\),?\\s-*")
-	    (verilog-set-define (match-string-no-properties 1) (match-string-no-properties 2) origbuf enumname)
-	    (goto-char (match-end 0))
-	    (forward-comment 999))))
-      )))
-
-(defun verilog-read-includes ()
-  "Read `includes for the current file.
-This will find all of the `includes which are at the beginning of lines,
-ignoring any ifdefs or multiline comments around them.
-`verilog-read-defines' is then performed on the current and each included
-file.
-
-It is often useful put at the *END* of your file something like:
-
-// Local Variables:
-// eval:(verilog-read-includes)
-// End:
-
-Note includes are only read when the file is first visited, you must use
-\\[find-alternate-file] RET  to have these take effect after editing them!
-
-It is good to get in the habit of including all needed files in each .v
-file that needs it, rather then waiting for compile time.  This will aid
-this process, Verilint, and readability.  To prevent defining the same
-variable over and over when many modules are compiled together, put a test
-around the inside each include file:
-
-foo.v (a include):
-	`ifdef _FOO_V	// include if not already included
-	`else
-	`define _FOO_V
-	... contents of file
-	`endif // _FOO_V"
-;;slow:  (verilog-read-defines nil t))
-  (save-excursion
-    (goto-char (point-min))
-    (while (re-search-forward "^\\s-*`include\\s-+\\([^ \t\n]+\\)" nil t)
-      (let ((inc (verilog-string-replace-matches "\"" "" nil nil (match-string 1))))
-	(verilog-read-defines inc)))))
-
-(defun verilog-read-signals (&optional start end)
-  "Return a simple list of all possible signals in the file.
-Bounded by optional region from START to END.  Overly aggressive but fast.
-Some macros and such are also found and included.  For dinotrace.el"
-  (let (sigs-all keywd)
-    (progn;save-excursion
-      (goto-char (or start (point-min)))
-      (setq end (or end (point-max)))
-      (while (re-search-forward "[\"/a-zA-Z_.%`]" end t)
-	(forward-char -1)
-	(cond
-	 ((looking-at "//")
-	  (search-forward "\n"))
-	 ((looking-at "/\\*")
-	  (search-forward "*/"))
-	 ((eq ?\" (following-char))
-	  (re-search-forward "[^\\]\""))	;; don't forward-char first, since we look for a non backslash first
-	 ((looking-at "\\s-*\\([a-zA-Z0-9$_.%`]+\\)")
-	  (goto-char (match-end 0))
-	  (setq keywd (match-string-no-properties 1))
-	  (or (member keywd verilog-keywords)
-	      (member keywd sigs-all)
-	      (setq sigs-all (cons keywd sigs-all))))
-	 (t (forward-char 1)))
-	)
-      ;; Return list
-      sigs-all)))
-
-
-;;
-;; Module name lookup
-;;
-
-(defun verilog-module-inside-filename-p (module filename)
-  "Return point if MODULE is specified inside FILENAME, else nil.
-Allows version control to check out the file if need be."
-  (and (or (file-exists-p filename)
-	   (and
-	    (condition-case nil
-		(fboundp 'vc-backend)
-	      (error nil))
-	    (vc-backend filename)))
-       (let (pt)
-	 (save-excursion
-	   (set-buffer (find-file-noselect filename))
-	   (goto-char (point-min))
-	   (while (and
-		   ;; It may be tempting to look for verilog-defun-re, don't, it slows things down a lot!
-		   (verilog-re-search-forward-quick "module" nil t)
-		   (verilog-re-search-forward-quick "[(;]" nil t))
-	     (if (equal module (verilog-read-module-name))
-		 (setq pt (point))))
-	   pt))))
-
-(defun verilog-is-number (symbol)
-  "Return true if SYMBOL is number-like."
-  (or (string-match "^[0-9 \t:]+$" symbol)
-      (string-match "^[---]*[0-9]+$" symbol)
-      (string-match "^[0-9 \t]+'s?[hdxbo][0-9a-fA-F_xz? \t]*$" symbol)
-      ))
-
-(defun verilog-symbol-detick (symbol wing-it)
-  "Return a expanded SYMBOL name without any defines.
-If the variable vh-{symbol} is defined, return that value.
-If undefined, and WING-IT, return just SYMBOL without the tick, else nil."
-  (while (and symbol (string-match "^`" symbol))
-    (setq symbol (substring symbol 1))
-    (setq symbol
-	  (if (boundp (intern (concat "vh-" symbol)))
-	      ;; Emacs has a bug where boundp on a buffer-local variable in only one
-	      ;; buffer returns t in another.  This can confuse, so check for nil.
-	      (let ((val (eval (intern (concat "vh-" symbol)))))
-		(if (eq val nil)
-		    (if wing-it symbol nil)
-		  val))
-	    (if wing-it symbol nil))))
-  symbol)
-;;(verilog-symbol-detick "`mod" nil)
-
-(defun verilog-symbol-detick-denumber (symbol)
-  "Return symbol with defines converted and any numbers dropped to nil."
-  (when (string-match "^`" symbol)
-    ;; This only will work if the define is a simple signal, not
-    ;; something like a[b].  Sorry, it should be substituted into the parser
-    (setq symbol
-	  (verilog-string-replace-matches
-	   "\[[^0-9: \t]+\]" "" nil nil
-	   (or (verilog-symbol-detick symbol nil)
-	       (if verilog-auto-sense-defines-constant
-		   "0"
-		 symbol)))))
-  (if (verilog-is-number symbol)
-      nil
-    symbol))
-
-(defun verilog-expand-dirnames (&optional dirnames)
-  "Return a list of existing directories given a list of wildcarded dirnames
-or just the existing dirnames themselves if there are no wildcards."
-  (interactive)
-  (unless dirnames (error "verilog-library-directories should include at least '.'"))
-  (setq dirnames (reverse dirnames))	; not nreverse
-  (let ((dirlist nil)
-	pattern dirfile dirfiles dirname root filename rest)
-    (while dirnames
-      (setq dirname (substitute-in-file-name (car dirnames))
-	    dirnames (cdr dirnames))
-      (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)"  ;; root
-				   "\\([^/\\]*[*?][^/\\]*\\)"	  ;; filename with *?
-				   "\\(.*\\)")			  ;; rest
-			   dirname)
-	     (setq root (match-string 1 dirname)
-		   filename (match-string 2 dirname)
-		   rest (match-string 3 dirname)
-		   pattern filename)
-	     ;; now replace those * and ? with .+ and .
-	     ;; use ^ and /> to get only whole file names
-	     ;;verilog-string-replace-matches
-	     (setq pattern (verilog-string-replace-matches "[*]" ".+" nil nil pattern)
-		   pattern (verilog-string-replace-matches "[?]" "." nil nil pattern)
-
-		   ;; Unfortunately allows abc/*/rtl to match abc/rtl
-		   ;; because abc/.. shows up in dirfiles.  Solutions welcome.
-		   dirfiles (directory-files root t pattern nil))
-	     (while dirfiles
-	       (setq dirfile (expand-file-name (concat (car dirfiles) rest))
-		     dirfiles (cdr dirfiles))
-	       (if (file-directory-p dirfile)
-		   (setq dirlist (cons dirfile dirlist))))
-	     )
-	    ;; Defaults
-	    (t
-	     (if (file-directory-p dirname)
-		 (setq dirlist (cons dirname dirlist))))
-	    ))
-    dirlist))
-;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v"))
-
-(defun verilog-library-filenames (filename current)
-  "Return a search path to find the given FILENAME name.
-Uses the CURRENT filename, `verilog-library-directories' and
-`verilog-library-extensions' variables to build the path."
-  (let ((ckdir (verilog-expand-dirnames verilog-library-directories))
-	fn outlist)
-    (while ckdir
-      (setq fn (expand-file-name
-		filename
-		(expand-file-name (car ckdir) (file-name-directory current))))
-      (if (file-exists-p fn)
-	  (setq outlist (cons fn outlist)))
-      (setq ckdir (cdr ckdir)))
-    (nreverse outlist)))
-
-(defun verilog-module-filenames (module current)
-  "Return a search path to find the given MODULE name.
-Uses the CURRENT filename, `verilog-library-extensions',
-`verilog-library-directories' and `verilog-library-files'
-variables to build the path."
-  ;; Return search locations for it
-  (append (list current)	; first, current buffer
- 	  (let ((ext verilog-library-extensions) flist)
- 	    (while ext
- 	      (setq flist
- 		    (append (verilog-library-filenames
- 			     (concat module (car ext)) current) flist)
-		    ext (cdr ext)))
-	    flist)
-	  verilog-library-files	 ; finally, any libraries
-	  ))
-
-;;
-;; Module Information
-;;
-;; Many of these functions work on "modi" a module information structure
-;; A modi is:  [module-name-string file-name begin-point]
-
-(defvar verilog-cache-enabled t
-  "If true, enable caching of signals, etc.  Set to nil for debugging to make things SLOW!")
-
-(defvar verilog-modi-cache-list nil
-  "Cache of ((Module Function) Buf-Tick Buf-Modtime Func-Returns)...
-For speeding up verilog-modi-get-* commands.
-Buffer-local.")
-
-(defvar verilog-modi-cache-preserve-tick nil
-  "Modification tick after which the cache is still considered valid.
-Use verilog-preserve-cache's to set")
-(defvar verilog-modi-cache-preserve-buffer nil
-  "Modification tick after which the cache is still considered valid.
-Use verilog-preserve-cache's to set")
-
-(defun verilog-modi-current ()
-  "Return the modi structure for the module currently at point."
-  (let* (name pt)
-    ;; read current module's name
-    (save-excursion
-      (verilog-re-search-backward-quick verilog-defun-re nil nil)
-      (verilog-re-search-forward-quick "(" nil nil)
-      (setq name (verilog-read-module-name))
-      (setq pt (point)))
-    ;; return
-    (vector name (or (buffer-file-name) (current-buffer)) pt)))
-
-(defvar verilog-modi-lookup-last-mod nil "Cache of last module looked up.")
-(defvar verilog-modi-lookup-last-current nil "Cache of last current looked up.")
-(defvar verilog-modi-lookup-last-modi nil "Cache of last modi returned.")
-
-(defun verilog-modi-lookup (module allow-cache)
-  "Find the file and point at which MODULE is defined.
-If ALLOW-CACHE is set, check and remember cache of previous lookups.
-Return modi if successful, else print message."
-  (let* ((current (or (buffer-file-name) (current-buffer))))
-    (cond ((and (equal verilog-modi-lookup-last-mod module)
-		(equal verilog-modi-lookup-last-current current)
-		verilog-modi-lookup-last-modi
-		verilog-cache-enabled
-		allow-cache)
-	   ;; ok as is
-	   )
-	  (t (let* ((realmod (verilog-symbol-detick module t))
-		    (orig-filenames (verilog-module-filenames realmod current))
-		    (filenames orig-filenames)
-		    pt)
-	       (while (and filenames (not pt))
-		 (if (not (setq pt (verilog-module-inside-filename-p realmod (car filenames))))
-		     (setq filenames (cdr filenames))))
-	       (cond (pt (setq verilog-modi-lookup-last-modi
-			       (vector realmod (car filenames) pt)))
-		     (t (setq verilog-modi-lookup-last-modi nil)
-			(error (concat (verilog-point-text)
-				       ": Can't locate " module " module definition"
-				       (if (not (equal module realmod))
-					   (concat " (Expanded macro to " realmod ")")
-					 "")
-				       "\n    Check the verilog-library-directories variable."
-				       "\n    I looked in (if not listed, doesn't exist):\n\t" (mapconcat 'concat orig-filenames "\n\t"))))
-		     )
-	       (setq verilog-modi-lookup-last-mod module
-		     verilog-modi-lookup-last-current current))))
-    verilog-modi-lookup-last-modi
-    ))
-
-(defsubst verilog-modi-name (modi)
-  (aref modi 0))
-(defsubst verilog-modi-file-or-buffer (modi)
-  (aref modi 1))
-(defsubst verilog-modi-point (modi)
-  (aref modi 2))
-
-(defun verilog-modi-filename (modi)
-  "Filename of modi, or name of buffer if its never been saved"
-  (if (bufferp (verilog-modi-file-or-buffer modi))
-      (or (buffer-file-name (verilog-modi-file-or-buffer modi))
-	  (buffer-name (verilog-modi-file-or-buffer modi)))
-    (verilog-modi-file-or-buffer modi)))
-
-(defun verilog-modi-goto (modi)
-  "Move point/buffer to specified MODI."
-  (or modi (error "Passed unfound modi to goto, check earlier"))
-  (set-buffer (if (bufferp (verilog-modi-file-or-buffer modi))
-		  (verilog-modi-file-or-buffer modi)
-		(find-file-noselect (verilog-modi-file-or-buffer modi))))
-  (or (equal major-mode `verilog-mode)	;; Put into verilog mode to get syntax
-      (verilog-mode))
-  (goto-char (verilog-modi-point modi)))
-
-(defun verilog-goto-defun-file (module)
-  "Move point to the file at which a given MODULE is defined."
-  (interactive "sGoto File for Module: ")
-  (let* ((modi (verilog-modi-lookup module nil)))
-    (when modi
-      (verilog-modi-goto modi)
-      (switch-to-buffer (current-buffer)))))
-
-(defun verilog-modi-cache-results (modi function)
-  "Run on MODI the given FUNCTION.  Locate the module in a file.
-Cache the output of function so next call may have faster access."
-  (let (func-returns fass)
-    (save-excursion
-      (verilog-modi-goto modi)
-      (if (and (setq fass (assoc (list (verilog-modi-name modi) function)
-				 verilog-modi-cache-list))
-	       ;; Destroy caching when incorrect; Modified or file changed
-	       (not (and verilog-cache-enabled
-			 (or (equal (buffer-modified-tick) (nth 1 fass))
-			     (and verilog-modi-cache-preserve-tick
-				  (<= verilog-modi-cache-preserve-tick  (nth 1 fass))
-				  (equal  verilog-modi-cache-preserve-buffer (current-buffer))))
-			 (equal (visited-file-modtime) (nth 2 fass)))))
-	  (setq verilog-modi-cache-list nil
-		fass nil))
-      (cond (fass
-	     ;; Found
-	     (setq func-returns (nth 3 fass)))
-	    (t
-	     ;; Read from file
-	     ;; Clear then restore any hilighting to make emacs19 happy
-	     (let ((fontlocked (when (and (memq 'v19 verilog-emacs-features)
-					  (boundp 'font-lock-mode)
-					  font-lock-mode)
-				 (font-lock-mode nil)
-				 t)))
-	       (setq func-returns (funcall function))
-	       (when fontlocked (font-lock-mode t)))
-	     ;; Cache for next time
-	     (make-variable-buffer-local 'verilog-modi-cache-list)
-	     (setq verilog-modi-cache-list
-		   (cons (list (list (verilog-modi-name modi) function)
-			       (buffer-modified-tick)
-			       (visited-file-modtime)
-			       func-returns)
-			 verilog-modi-cache-list)))
-	    ))
-      ;;
-      func-returns))
-
-(defun verilog-modi-cache-add (modi function element sig-list)
-  "Add function return results to the module cache.
-Update MODI's cache for given FUNCTION so that the return ELEMENT of that
-function now contains the additional SIG-LIST parameters."
-  (let (fass)
-    (save-excursion
-      (verilog-modi-goto modi)
-      (if (setq fass (assoc (list (verilog-modi-name modi) function)
-			    verilog-modi-cache-list))
-	  (let ((func-returns (nth 3 fass)))
-	    (aset func-returns element
-		  (append sig-list (aref func-returns element))))))))
-
-(defmacro verilog-preserve-cache (&rest body)
-  "Execute the BODY forms, allowing cache preservation within BODY.
-This means that changes to the buffer will not result in the cache being
-flushed.  If the changes affect the modsig state, they must call the
-modsig-cache-add-* function, else the results of later calls may be
-incorrect.  Without this, changes are assumed to be adding/removing signals
-and invalidating the cache."
-  `(let ((verilog-modi-cache-preserve-tick (buffer-modified-tick))
-	 (verilog-modi-cache-preserve-buffer (current-buffer)))
-     (progn ,@body)))
-
-
-(defun verilog-signals-matching-enum (in-list enum)
-  "Return all signals in IN-LIST matching the given ENUM."
-  (let (out-list)
-    (while in-list
-      (if (equal (verilog-sig-enum (car in-list)) enum)
-	  (setq out-list (cons (car in-list) out-list)))
-      (setq in-list (cdr in-list)))
-    ;; New scheme
-    (let* ((enumvar (intern (concat "venum-" enum)))
-	   (enumlist (and (boundp enumvar) (eval enumvar))))
-      (while enumlist
-	(add-to-list 'out-list (list (car enumlist)))
-	(setq enumlist (cdr enumlist))))
-    (nreverse out-list)))
-
-;; Combined
-(defun verilog-modi-get-signals (modi)
-  (append
-   (verilog-modi-get-outputs modi)
-   (verilog-modi-get-inouts modi)
-   (verilog-modi-get-inputs modi)
-   (verilog-modi-get-wires modi)
-   (verilog-modi-get-regs modi)
-   (verilog-modi-get-assigns modi)
-   (verilog-modi-get-consts modi)))
-
-(defun verilog-modi-get-ports (modi)
-  (append
-   (verilog-modi-get-outputs modi)
-   (verilog-modi-get-inouts modi)
-   (verilog-modi-get-inputs modi)))
-
-(defsubst verilog-modi-cache-add-outputs (modi sig-list)
-  (verilog-modi-cache-add modi 'verilog-read-decls 0 sig-list))
-(defsubst verilog-modi-cache-add-inouts (modi sig-list)
-  (verilog-modi-cache-add modi 'verilog-read-decls 1 sig-list))
-(defsubst verilog-modi-cache-add-inputs (modi sig-list)
-  (verilog-modi-cache-add modi 'verilog-read-decls 2 sig-list))
-(defsubst verilog-modi-cache-add-wires (modi sig-list)
-  (verilog-modi-cache-add modi 'verilog-read-decls 3 sig-list))
-(defsubst verilog-modi-cache-add-regs (modi sig-list)
-  (verilog-modi-cache-add modi 'verilog-read-decls 4 sig-list))
-
-(defun verilog-signals-from-signame (signame-list)
-  "Return signals in standard form from SIGNAME-LIST, a simple list of signal names."
-  (mapcar (function (lambda (name) (list name nil nil)))
-	  signame-list))
-
-;;
-;; Auto creation utilities
-;;
-
-(defun verilog-auto-search-do (search-for func)
-  "Search for the given auto text SEARCH-FOR, and perform FUNC where it occurs."
-  (goto-char (point-min))
-  (while (search-forward search-for nil t)
-    (if (not (save-excursion
-	       (goto-char (match-beginning 0))
-	       (verilog-inside-comment-p)))
-	(funcall func))))
-
-(defun verilog-auto-re-search-do (search-for func)
-  "Search for the given auto text SEARCH-FOR, and perform FUNC where it occurs."
-  (goto-char (point-min))
-  (while (re-search-forward search-for nil t)
-    (if (not (save-excursion
-	       (goto-char (match-beginning 0))
-	       (verilog-inside-comment-p)))
-	(funcall func))))
-
-(defun verilog-insert-definition (sigs type indent-pt &optional dont-sort)
-  "Print out a definition for a list of SIGS of the given TYPE,
-with appropriate INDENT-PT indentation.  Sort unless DONT-SORT.
-TYPE is normally wire/reg/output."
-  (or dont-sort
-      (setq sigs (sort (copy-alist sigs) `verilog-signals-sort-compare)))
-  (while sigs
-    (let ((sig (car sigs)))
-      (indent-to indent-pt)
-      (insert type)
-      (when (verilog-sig-signed sig)
-	(insert " " (verilog-sig-signed sig)))
-      (when (verilog-sig-bits sig)
-	(insert " " (verilog-sig-bits sig)))
-      (indent-to (max 24 (+ indent-pt 16)))
-      (insert (concat (verilog-sig-name sig) ";"))
-      (if (or (not (verilog-sig-comment sig))
-	      (equal "" (verilog-sig-comment sig)))
-	  (insert "\n")
-	(indent-to (max 48 (+ indent-pt 40)))
-	(insert (concat "// " (verilog-sig-comment sig) "\n")))
-      (setq sigs (cdr sigs)))))
-
-(eval-when-compile
-  (if (not (boundp 'indent-pt))
-      (defvar indent-pt nil "Local used by insert-indent")))
-
-(defun verilog-insert-indent (&rest stuff)
-  "Indent to position stored in local `indent-pt' variable, then insert STUFF.
-Presumes that any newlines end a list element."
-  (let ((need-indent t))
-    (while stuff
-      (if need-indent (indent-to indent-pt))
-      (setq need-indent nil)
-      (insert (car stuff))
-      (setq need-indent (string-match "\n$" (car stuff))
-	    stuff (cdr stuff)))))
-;;(let ((indent-pt 10)) (verilog-insert-indent "hello\n" "addon" "there\n"))
-
-(defun verilog-get-list (start end)
-  "Return the elements of a comma separated list."
-  (interactive)
-  (let ((my-list (list))
-	my-string)
-    (save-excursion
-      (while (< (point) end)
-	(when (re-search-forward "\\([^,{]+\\)" end t)
-	  (setq my-string (verilog-string-remove-spaces (match-string 1)))
-	  (setq my-list (nconc my-list (list my-string) ))
-	  (goto-char (match-end 0))))
-      my-list)))
-
-(defun verilog-make-width-expression (range-exp)
-  "Return an expression calculating the length of a range [x:y]."
-  (interactive)
-  ;; strip off the []
-  (cond ((not range-exp)
-	 "1")
-	(t
-	 (if (string-match "^\\[\\(.*\\)\\]$" range-exp)
-	     (setq range-exp (match-string 1 range-exp)))
-	 (cond ((not range-exp)
-		"1")
-	       ((string-match "^\\s *\\([0-9]+\\)\\s *:\\s *\\([0-9]+\\)\\s *$" range-exp)
-		(int-to-string (1+ (abs (- (string-to-int (match-string 1 range-exp))
-					   (string-to-int (match-string 2 range-exp)))))))
-	       ((string-match "^\\(.*\\)\\s *:\\s *\\(.*\\)\\s *$" range-exp)
-		(concat "(1+(" (match-string 1 range-exp)
-			")-(" (match-string 2 range-exp) "))"))
-	       (t nil)))))
-;;(verilog-make-width-expression "`A:`B")
-
-
-;;
-;; Auto deletion
-;;
-
-(defun verilog-delete-autos-lined ()
-  "Delete autos that occupy multiple lines, between begin and end comments."
-  (let ((pt (point)))
-    (forward-line 1)
-    (when (and
-	   (looking-at "\\s-*// Beginning")
-	   (search-forward "// End of automatic" nil t))
-      ;; End exists
-      (end-of-line)
-      (delete-region pt (point))
-      (forward-line 1))
-  ))
-
-(defun verilog-backward-open-paren ()
-  "Find the open parenthesis that match the current point,
-ignore other open parenthesis with matching close parens"
-  (let ((parens 1))
-    (while (> parens 0)
-      (unless (verilog-re-search-backward-quick "[()]" nil t)
-	(error "%s: Mismatching ()" (verilog-point-text)))
-      (cond ((looking-at ")")
-	     (setq parens (1+ parens)))
-	    ((looking-at "(")
-	     (setq parens (1- parens)))))))
-
-(defun verilog-delete-to-paren ()
-  "Delete the automatic inst/sense/arg created by autos.
-Deletion stops at the matching end parenthesis."
-  (delete-region (point)
-		 (save-excursion
-		   (verilog-backward-open-paren)
-		   (forward-sexp 1)   ;; Moves to paren that closes argdecl's
-		   (backward-char 1)
-		   (point))))
-
-(defun verilog-delete-auto ()
-  "Delete the automatic outputs, regs, and wires created by \\[verilog-auto].
-Use \\[verilog-auto] to re-insert the updated AUTOs."
-  (interactive)
-  (save-excursion
-    (if (buffer-file-name)
-	(find-file-noselect (buffer-file-name)))	;; To check we have latest version
-    ;; Remove those that have multi-line insertions
-    (verilog-auto-re-search-do "/\\*AUTO\\(OUTPUTEVERY\\|CONCATCOMMENT\\|WIRE\\|REG\\|DEFINEVALUE\\|REGINPUT\\|INPUT\\|OUTPUT\\|INOUT\\|RESET\\)\\*/"
-			       'verilog-delete-autos-lined)
-    ;; Remove those that have multi-line insertions with parameters
-    (verilog-auto-re-search-do "/\\*AUTO\\(INOUTMODULE\\|ASCIIENUM\\)([^)]*)\\*/"
-			       'verilog-delete-autos-lined)
-    ;; Remove those that are in parenthesis
-    (verilog-auto-re-search-do "/\\*\\(AS\\|AUTO\\(ARG\\|CONCATWIDTH\\|INST\\|SENSE\\)\\)\\*/"
-			       'verilog-delete-to-paren)
-
-    ;; Remove template comments ... anywhere in case was pasted after AUTOINST removed
-    (goto-char (point-min))
-    (while (re-search-forward "\\s-*// Templated[ \tLT0-9]*$" nil t)
-      (replace-match ""))))
-
-;;
-;; Auto save
-;;
-
-(defun verilog-auto-save-check ()
-  "On saving see if we need auto update."
-  (cond ((not verilog-auto-save-policy)) ; disabled
-	((not (save-excursion
-		(save-match-data
-		  (let ((case-fold-search nil))
-		    (goto-char (point-min))
-		    (re-search-forward "AUTO" nil t))))))
-	((eq verilog-auto-save-policy 'force)
-	 (verilog-auto))
-	((not (buffer-modified-p)))
-	((eq verilog-auto-update-tick (buffer-modified-tick))) ; up-to-date
-	((eq verilog-auto-save-policy 'detect)
-	 (verilog-auto))
-	(t
-	 (when (yes-or-no-p "AUTO statements not recomputed, do it now? ")
-	   (verilog-auto))
-	 ;; Don't ask again if didn't update
-	 (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick))
-	 ))
-  nil)	;; Always return nil -- we don't write the file ourselves
-
-(defun verilog-auto-read-locals ()
-  "Return file local variable segment at bottom of file."
-  (save-excursion
-    (goto-char (point-max))
-    (if (re-search-backward "Local Variables:" nil t)
-	(buffer-substring-no-properties (point) (point-max))
-      "")))
-
-(defun verilog-auto-reeval-locals (&optional just-cache)
-  "Read file local variable segment at bottom of file if it's changed since last read."
-  (make-variable-buffer-local 'verilog-auto-last-file-locals)
-  (let ((curlocal (verilog-auto-read-locals)))
-    (when (not (equal verilog-auto-last-file-locals curlocal))
-      (unless just-cache (hack-local-variables))
-      (setq verilog-auto-last-file-locals curlocal)
-      t)))
-
-;;
-;; Auto creation
-;;
-
-(defun verilog-auto-arg-ports (sigs message indent-pt)
-  "Print a list of ports for a AUTOINST.
-Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT."
-  (when sigs
-    (insert "\n")
-    (indent-to indent-pt)
-    (insert message)
-    (insert "\n")
-    (indent-to indent-pt)
-    (while sigs
-      (cond ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column)
-	     (insert "\n")
-	     (indent-to indent-pt)))
-      (insert (verilog-sig-name (car sigs)) ", ")
-      (setq sigs (cdr sigs)))))
-
-(defun verilog-auto-arg ()
-  "Expand AUTOARG statements.
-Replace the argument declarations at the beginning of the
-module with ones automatically derived from input and output
-statements.  This can be dangerous if the module is instantiated
-using position-based connections, so use only name-based when
-instantiating the resulting module.  Long lines are split based
-on the `fill-column', see \\[set-fill-column].
-
-Limitations:
-   Concatenation and outputting partial busses is not supported.
-
-For example:
-
-	module ex_arg (/*AUTOARG*/);
-	  input i;
-	  output o;
-	endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_arg (/*AUTOARG*/
-	  // Outputs
-	  o,
-	  // Inputs
-	  i
-	);
-	  input i;
-	  output o;
-	endmodule
-
-Any ports declared between the ( and /*AUTOARG*/ are presumed to be
-predeclared and are not redeclared by AUTOARG.  You need to know whether to
-put a comma just before the AUTOARG or not, based upon whether there will be
-ports in the AUTOARG or not; this is not determined for you.  Avoid
-declaring ports manually, as it makes code harder to maintain."
-  (save-excursion
-    (let ((modi (verilog-modi-current))
-	  (skip-pins (aref (verilog-read-arg-pins) 0))
-	  (pt (point)))
-      (verilog-auto-arg-ports (verilog-signals-not-in
-			       (verilog-modi-get-outputs modi)
-			       skip-pins)
-			      "// Outputs"
-			      verilog-indent-level-declaration)
-      (verilog-auto-arg-ports (verilog-signals-not-in
-			       (verilog-modi-get-inouts modi)
-			       skip-pins)
-			      "// Inouts"
-			      verilog-indent-level-declaration)
-      (verilog-auto-arg-ports (verilog-signals-not-in
-			       (verilog-modi-get-inputs modi)
-			       skip-pins)
-			      "// Inputs"
-			      verilog-indent-level-declaration)
-      (save-excursion
-	(if (re-search-backward "," pt t)
-	    (delete-char 2)))
-      (unless (eq (char-before) ?/ )
-	(insert "\n"))
-      (indent-to verilog-indent-level-declaration)
-      )))
-
-(defun verilog-auto-inst-port-map (port-st)
-  nil)
-
-(defvar vector-skip-list nil) ; Prevent compile warning
-(defvar vl-cell-type nil "See verilog-auto-inst") ; Prevent compile warning
-(defvar vl-cell-name nil "See verilog-auto-inst") ; Prevent compile warning
-(defvar vl-width 0)
-(defvar vl-name 0)
-(defun verilog-auto-inst-port (port-st indent-pt tpl-list tpl-num)
-  "Print out a instantiation connection for this PORT-ST.
-Insert to INDENT-PT, use template TPL-LIST.
-@ are instantiation numbers, replaced with TPL-NUM.
-@\"(expression @)\" are evaluated, with @ as a variable."
-  (let* ((port (verilog-sig-name port-st))
-	 (tpl-ass (or (assoc port (car tpl-list))
-		      (verilog-auto-inst-port-map port-st)))
-	 ;; vl-* are documented for user use
-	 (vl-name (verilog-sig-name port-st))
-	 (vl-width (verilog-sig-width port-st))
-	 (vl-bits (if (or verilog-auto-inst-vector
-			  (not (assoc port vector-skip-list))
-			  (not (equal (verilog-sig-bits port-st)
-				      (verilog-sig-bits (assoc port vector-skip-list)))))
-		      (or (verilog-sig-bits port-st) "")
-		    ""))
-	 ;; Default if not found
-	 (tpl-net (concat port vl-bits)))
-    ;; Find template
-    (cond (tpl-ass	    ; Template of exact port name
-	   (setq tpl-net (nth 1 tpl-ass)))
-	  ((nth 1 tpl-list) ; Wildcards in template, search them
-	   (let ((wildcards (nth 1 tpl-list)))
-	     (while wildcards
-	       (when (string-match (nth 0 (car wildcards)) port)
-		 (setq tpl-ass (car wildcards)  ; so allow @ parsing
-		       tpl-net (replace-match (nth 1 (car wildcards))
-					      t nil port)))
-	       (setq wildcards (cdr wildcards))))))
-    ;; Parse Templated variable
-    (when tpl-ass
-      ;; Evaluate @"(lispcode)"
-      (when (string-match "@\".*[^\\]\"" tpl-net)
-	(while (string-match "@\"\\(\\([^\\\"]*\\(\\\\.\\)*\\)*\\)\"" tpl-net)
-	  (setq tpl-net
-		(concat
-		 (substring tpl-net 0 (match-beginning 0))
-		 (save-match-data
-		   (let* ((expr (match-string 1 tpl-net))
-			  (value
-			   (progn
-			     (setq expr (verilog-string-replace-matches "\\\\\"" "\"" nil nil expr))
-			     (setq expr (verilog-string-replace-matches "@" tpl-num nil nil expr))
-			     (prin1 (eval (car (read-from-string expr)))
-				    (lambda (ch) ())))))
-		     (if (numberp value) (setq value (number-to-string value)))
-		     value
-		     ))
-		 (substring tpl-net (match-end 0))))))
-      ;; Replace @ and [] magic variables in final output
-      (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net))
-      (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net))
-      )
-    (indent-to indent-pt)
-    (insert "." port)
-    (indent-to 40)
-    (insert "(" tpl-net "),")
-    (when tpl-ass
-      (indent-to 64)
-      (insert " // Templated")
-      (when verilog-auto-inst-template-numbers
-	(insert " T" (int-to-string (nth 2 tpl-ass))
-		" L" (int-to-string (nth 3 tpl-ass)))))
-    (insert "\n")))
-;;(verilog-auto-inst-port (list "foo" "[5:0]") 10 (list (list "foo" "a@\"(% (+ @ 1) 4)\"a")) "3")
-;;(x "incom[@\"(+ (* 8 @) 7)\":@\"(* 8 @)\"]")
-;;(x ".out (outgo[@\"(concat (+ (* 8 @) 7) \\\":\\\" ( * 8 @))\"]));")
-
-(defun verilog-auto-inst ()
-  "Expand AUTOINST statements, as part of \\[verilog-auto].
-Replace the argument calls inside an instantiation with ones
-automatically derived from the module header of the instantiated netlist.
-
-Limitations:
-  Module names must be resolvable to filenames by adding a
-  verilog-library-extension, and being found in the same directory, or
-  by changing the variable `verilog-library-directories' or
-  `verilog-library-files'.  Macros `modname are translated through the
-  vh-{name} Emacs variable, if that is not found, it just ignores the `.
-
-  In templates you must have one signal per line, ending in a ), or ));,
-  and have proper () nesting, including a final ); to end the template.
-
-For example, first take the submodule inst.v:
-
-	module inst (o,i)
-	   output [31:0] o;
-	   input i;
-	   wire [31:0] o = {32{i}};
-	endmodule
-
-This is then used in a upper level module:
-
-	module ex_inst (o,i)
-	   output o;
-	   input i;
-	   inst inst (/*AUTOINST*/);
-	endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_inst (o,i)
-	   output o;
-	   input i;
-	   inst inst (/*AUTOINST*/
-		      // Outputs
-		      .ov			(ov[31:0]),
-		      // Inputs
-		      .i			(i));
-	endmodule
-
-Where the list of inputs and outputs came from the inst module.
-
-Exceptions:
-
-Unless you are instantiating a module multiple times, or the module is
-something trivial like a adder, DO NOT CHANGE SIGNAL NAMES ACROSS HIERARCHY.
-It just makes for unmaintainable code.  To sanitize signal names, try
-vrename from http://www.veripool.com
-
-When you need to violate this suggestion there are several ways to list
-exceptions.
-
-Any ports defined before the /*AUTOINST*/ are not included in the list of
-automatics.  This is similar to making a template as described below, but
-is restricted to simple connections just like you normally make.  Also note
-that any signals before the AUTOINST will only be picked up by AUTOWIRE if
-you have the appropriate // Input or // Output comment, and exactly the
-same line formatting as AUTOINST itself uses.
-
-	   inst inst (// Inputs
-		      .i			(my_i_dont_mess_with_it),
-		      /*AUTOINST*/
-		      // Outputs
-		      .ov			(ov[31:0]));
-
-
-Auto Templates:
-
-For multiple instantiations based upon a single template, create a
-commented out template:
-	/* psm_mas AUTO_TEMPLATE (
-		.PTL_MAPVALIDX		(PTL_MAPVALID[@]),
-		.PTL_MAPVALIDP1X	(PTL_MAPVALID[@\"(% (+ 1 @) 4)\"]),
-		.PTL_BUS		(PTL_BUSNEW[]),
-		);
-	*/
-
-Templates go ABOVE the instantiation(s).  When a instantiation is expanded
-`verilog-mode' simply searches up for the closest template.  Thus you can have
-multiple templates for the same module, just alternate between the template
-for a instantiation and the instantiation itself.
-
-The @ character should be replaced by the instantiation number; the first
-digits found in the cell's instantiation name.  The module name must be the
-same as the name of the module in the instantiation name, and the code
-\"AUTO_TEMPLATE\" must be in these exact words and capitalized.  Only
-signals that must be different for each instantiation need to be listed.
-
-The above template will convert:
-
-	psm_mas ms2m (/*AUTOINST*/);
-
-Typing \\[verilog-auto] will make this into:
-
-	psm_mas ms2m (/*AUTOINST*/
-	    // Outputs
-	    .INSTDATAOUT		(INSTDATAOUT),
-	    .PTL_MAPVALIDX		(PTL_MAPVALID[2]),
-	    .PTL_MAPVALIDP1X		(PTL_MAPVALID[3]),
-  	    .PTL_BUS			(PTL_BUSNEW[3:0]),
-	    ....
-
-Note the @ character was replaced with the 2 from \"ms2m\".  Also, if a
-signal wasn't in the template, it is assumed to be a direct connection.
-
-A [] in a template (with nothing else inside the brackets) will be replaced
-by the same bus subscript as it is being connected to, or \"\" (nothing) if
-it is a single bit signal.  See PTL_BUS becoming PTL_BUSNEW above.
-
-Regexp templates:
-
-  A template entry of the form
-	    .pci_req\\([0-9]+\\)_l	(pci_req_jtag_[\\1]),
-
-  will apply a Emacs style regular expression search for any port beginning
-  in pci_req followed by numbers and ending in _l and connecting that to
-  the pci_req_jtag_[] net, with the bus subscript coming from what matches
-  inside the first set of \\( \\).  Thus pci_req2_l becomes pci_req_jtag_[2].
-
-  Since \\([0-9]+\\) is so common and ugly to read, a @ does the same thing
-  (Note a @ in replacement text is completely different -- still use \\1
-  there!)  Thus this is the same as the above template:
-
-	    .pci_req@_l		(pci_req_jtag_[\\1]),
-
-  Here's another example to remove the _l, if naming conventions specify _
-  alone to mean active low.  Note the use of [] to keep the bus subscript:
-	    .\\(.*\\)_l		(\\1_[]),
-
-  If you have a complicated template, set `verilog-auto-inst-template-numbers'
-  to see which regexps are matching.  Don't leave that mode set after
-  debugging is completed though, it will result in lots of extra differences
-  and merge conflicts.
-
-Lisp templates:
-
-  First any regular expression template is expanded.
-
-  If the syntax @\"( ... )\" is found, the expression in quotes will be
-  evaluated as a Lisp expression, with @ replaced by the instantiation
-  number.  The MAPVALIDP1X example above would put @+1 modulo 4 into the
-  brackets.  Quote all double-quotes inside the expression with a leading
-  backslash (\\\").  There are special variables defined that are useful
-  in these Lisp functions:
-	vl-name        Name portion of the input/output port
-	vl-bits        Bus bits portion of the input/output port ('[2:0]')
-	vl-width       Width of the input/output port ('3' for [2:0])
-                       May be a (...) expression if bits isn't a constant.
-	vl-cell-type   Module name/type of the cell ('psm_mas')
-	vl-cell-name   Instance name of the cell ('ms2m')
-
-  Normal Lisp variables may be used in expressions.  See
-  `verilog-read-defines' which can set vh-{definename} variables for use
-  here.  Also, any comments of the form:
-
-	/*AUTO_LISP(setq foo 1)*/
-
-  will evaluate any Lisp expression inside the parenthesis between the
-  beginning of the buffer and the point of the AUTOINST.  This allows
-  functions to be defined or variables to be changed between instantiations.
-
-  After the evaluation is completed, @ substitution and [] substitution
-  occur."
-  (save-excursion
-    ;; Find beginning
-    (let* ((pt (point))
-	   (indent-pt (save-excursion (verilog-backward-open-paren)
-				      (1+ (current-column))))
-	   (modi (verilog-modi-current))
-	   (vector-skip-list (unless verilog-auto-inst-vector
-			       (verilog-modi-get-signals modi)))
-	   submod submodi inst skip-pins tpl-list tpl-num)
-      ;; Find module name that is instantiated
-      (setq submod  (verilog-read-inst-module)
-	    inst (verilog-read-inst-name)
-	    vl-cell-type submod
-	    vl-cell-name inst
-	    skip-pins (aref (verilog-read-inst-pins) 0))
-
-      ;; Parse any AUTO_LISP() before here
-      (verilog-read-auto-lisp (point-min) pt)
-
-      ;; Lookup position, etc of submodule
-      ;; Note this may raise an error
-      (when (setq submodi (verilog-modi-lookup submod t))
-	;; If there's a number in the instantiation, it may be a argument to the
-	;; automatic variable instantiation program.
-	(setq tpl-num (if (string-match "\\([0-9]+\\)" inst)
-			  (substring inst (match-beginning 1) (match-end 1))
-			"")
-	      tpl-list (verilog-read-auto-template submod))
-	;; Find submodule's signals and dump
-	(insert "\n")
-	(let ((sig-list (verilog-signals-not-in
-			 (verilog-modi-get-outputs submodi)
-			 skip-pins)))
-	  (when sig-list
-	    (indent-to indent-pt)
-	    (insert "// Outputs\n")	;; Note these are searched for in verilog-read-sub-decl
-	    (mapcar (function (lambda (port)
-				(verilog-auto-inst-port port indent-pt tpl-list tpl-num)))
-		    sig-list)))
-	(let ((sig-list (verilog-signals-not-in
-			 (verilog-modi-get-inouts submodi)
-			 skip-pins)))
-	  (when sig-list
-	    (indent-to indent-pt)
-	    (insert "// Inouts\n")
-	    (mapcar (function (lambda (port)
-				(verilog-auto-inst-port port indent-pt tpl-list tpl-num)))
-		    sig-list)))
-	(let ((sig-list (verilog-signals-not-in
-			 (verilog-modi-get-inputs submodi)
-			 skip-pins)))
-	  (when sig-list
-	    (indent-to indent-pt)
-	    (insert "// Inputs\n")
-	    (mapcar (function (lambda (port)
-				(verilog-auto-inst-port port indent-pt tpl-list tpl-num)))
-		    sig-list)))
-	;; Kill extra semi
-	(save-excursion
-	  (cond ((re-search-backward "," pt t)
-		 (delete-char 1)
-		 (insert ");")
-		 (search-forward "\n")	;; Added by inst-port
-		 (delete-backward-char 1)
-		 (if (search-forward ")" nil t) ;; From user, moved up a line
-		     (delete-backward-char 1))
-		 (if (search-forward ";" nil t) ;; Don't error if user had syntax error and forgot it
-		     (delete-backward-char 1))
-		 )
-		(t
-		 (delete-backward-char 1)	;; Newline Inserted above
-		 )))
-	))))
-
-(defun verilog-auto-reg ()
-  "Expand AUTOREG statements, as part of \\[verilog-auto].
-Make reg statements for any output that isn't already declared,
-and isn't a wire output from a block.
-
-Limitations:
-  This ONLY detects outputs of AUTOINSTants (see verilog-read-sub-decl).
-  This does NOT work on memories, declare those yourself.
-
-A simple example:
-
-	module ex_reg (o,i)
-	   output o;
-	   input i;
-	   /*AUTOREG*/
-	   always o = i;
-	endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_reg (o,i)
-	   output o;
-	   input i;
-	   /*AUTOREG*/
-	   // Beginning of automatic regs (for this module's undeclared outputs)
-	   reg			o;
-	   // End of automatics
-	   always o = i;
-	endmodule"
-  (save-excursion
-    ;; Point must be at insertion point.
-    (let* ((indent-pt (current-indentation))
-	   (modi (verilog-modi-current))
-	   (sig-list (verilog-signals-not-in
-		      (verilog-modi-get-outputs modi)
-		      (append (verilog-modi-get-wires modi)
-			      (verilog-modi-get-regs modi)
-			      (verilog-modi-get-assigns modi)
-			      (verilog-modi-get-consts modi)
-			      (verilog-modi-get-sub-outputs modi)
-			      (verilog-modi-get-sub-inouts modi)
-			      ))))
-      (forward-line 1)
-      (verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n")
-      (verilog-insert-definition sig-list "reg" indent-pt)
-      (verilog-modi-cache-add-regs modi sig-list)
-      (verilog-insert-indent "// End of automatics\n")
-      )))
-
-(defun verilog-auto-reg-input ()
-  "Expand AUTOREGINPUT statements, as part of \\[verilog-auto].
-Make reg statements instantiation inputs that aren't already declared.
-This is useful for making a top level shell for testing the module that is
-to be instantiated.
-
-Limitations:
-  This ONLY detects inputs of AUTOINSTants (see verilog-read-sub-decl).
-  This does NOT work on memories, declare those yourself.
-
-A simple example (see `verilog-auto-inst' for what else is going on here):
-
-	module ex_reg_input (o,i)
-	   output o;
-	   input i;
-	   /*AUTOREGINPUT*/
-           inst inst (/*AUTOINST*/);
-	endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_reg_input (o,i)
-	   output o;
-	   input i;
-	   /*AUTOREGINPUT*/
-	   // Beginning of automatic reg inputs (for undeclared ...
-	   reg [31:0]		iv;		// From inst of inst.v
-	   // End of automatics
-	   inst inst (/*AUTOINST*/
-		      // Outputs
-		      .o			(o[31:0]),
-		      // Inputs
-		      .iv			(iv));
-	endmodule"
-  (save-excursion
-    ;; Point must be at insertion point.
-    (let* ((indent-pt (current-indentation))
-	   (modi (verilog-modi-current))
-	   (sig-list (verilog-signals-combine-bus
-		      (verilog-signals-not-in
-		       (append (verilog-modi-get-sub-inputs modi)
-			       (verilog-modi-get-sub-inouts modi))
-		       (verilog-modi-get-signals modi)
-		       ))))
-      (forward-line 1)
-      (verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n")
-      (verilog-insert-definition sig-list "reg" indent-pt)
-      (verilog-modi-cache-add-wires modi sig-list)
-      (verilog-insert-indent "// End of automatics\n")
-      )))
-
-(defun verilog-auto-wire ()
-  "Expand AUTOWIRE statements, as part of \\[verilog-auto].
-Make wire statements for instantiations outputs that aren't
-already declared.
-
-Limitations:
-  This ONLY detects outputs of AUTOINSTants (see verilog-read-sub-decl).
-  This does NOT work on memories, declare those yourself.
-
-A simple example (see `verilog-auto-inst' for what else is going on here):
-
-	module ex_wire (o,i)
-	   output o;
-	   input i;
-	   /*AUTOWIRE*/
-           inst inst (/*AUTOINST*/);
-	endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_wire (o,i)
-	   output o;
-	   input i;
-	   /*AUTOWIRE*/
-	   // Beginning of automatic wires
-	   wire [31:0]		ov;	// From inst of inst.v
-	   // End of automatics
-	   inst inst (/*AUTOINST*/
-		      // Outputs
-		      .ov	(ov[31:0]),
-		      // Inputs
-		      .i	(i));
-	   wire o = | ov;
-	endmodule"
-  (save-excursion
-    ;; Point must be at insertion point.
-    (let* ((indent-pt (current-indentation))
-	   (modi (verilog-modi-current))
-	   (sig-list (verilog-signals-combine-bus
-		      (verilog-signals-not-in
-		       (append (verilog-modi-get-sub-outputs modi)
-			       (verilog-modi-get-sub-inouts modi))
-		       (verilog-modi-get-signals modi)
-		       ))))
-      (forward-line 1)
-      (verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n")
-      (verilog-insert-definition sig-list "wire" indent-pt)
-      (verilog-modi-cache-add-wires modi sig-list)
-      (verilog-insert-indent "// End of automatics\n")
-      (when nil	;; Too slow on huge modules, plus makes everyone's module change
-	(beginning-of-line)
-	(setq pnt (point))
-	(verilog-pretty-declarations)
-	(goto-char pnt)
-	(verilog-pretty-expr "//"))
-      )))
-
-(defun verilog-auto-output ()
-  "Expand AUTOOUTPUT statements, as part of \\[verilog-auto].
-Make output statements for any output signal from an /*AUTOINST*/ that
-isn't used elsewhere inside the module.  This is useful for modules which
-only instantiate other modules.
-
-Limitations:
-  This ONLY detects outputs of AUTOINSTants (see verilog-read-sub-decl).
-
-  If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
-  instantiation, all bets are off.  (For example due to a AUTO_TEMPLATE).
-
-A simple example (see `verilog-auto-inst' for what else is going on here):
-
-	module ex_output (ov,i)
-	   input i;
-	   /*AUTOOUTPUT*/
-	   inst inst (/*AUTOINST*/);
-	endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_output (ov,i)
-	   input i;
-	   /*AUTOOUTPUT*/
-	   // Beginning of automatic outputs (from unused autoinst outputs)
-	   output [31:0]	ov;			// From inst of inst.v
-	   // End of automatics
-	   inst inst (/*AUTOINST*/
-		      // Outputs
-		      .ov			(ov[31:0]),
-		      // Inputs
-		      .i			(i));
-	endmodule"
-  (save-excursion
-    ;; Point must be at insertion point.
-    (let* ((indent-pt (current-indentation))
-	   (modi (verilog-modi-current))
-	   (sig-list (verilog-signals-not-in
-		      (verilog-modi-get-sub-outputs modi)
-		      (append (verilog-modi-get-outputs modi)
-			      (verilog-modi-get-inouts modi)
-			      (verilog-modi-get-sub-inputs modi)
-			      (verilog-modi-get-sub-inouts modi)
-			      ))))
-      (forward-line 1)
-      (verilog-insert-indent "// Beginning of automatic outputs (from unused autoinst outputs)\n")
-      (verilog-insert-definition sig-list "output" indent-pt)
-      (verilog-modi-cache-add-outputs modi sig-list)
-      (verilog-insert-indent "// End of automatics\n")
-      )))
-
-(defun verilog-auto-output-every ()
-  "Expand AUTOOUTPUTEVERY statements, as part of \\[verilog-auto].
-Make output statements for any signals that aren't primary inputs or
-outputs already.  This makes every signal in the design a output.  This is
-useful to get Synopsys to preserve every signal in the design, since it
-won't optimize away the outputs.
-
-A simple example:
-
-	module ex_output_every (o,i,tempa,tempb)
-	   output o;
-	   input i;
-	   /*AUTOOUTPUTEVERY*/
-	   wire tempa = i;
-	   wire tempb = tempa;
-	   wire o = tempb;
-	endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_output_every (o,i,tempa,tempb)
-	   output o;
-	   input i;
-	   /*AUTOOUTPUTEVERY*/
-	   // Beginning of automatic outputs (every signal)
-	   output		tempb;
-	   output		tempa;
-	   // End of automatics
-	   wire tempa = i;
-	   wire tempb = tempa;
-	   wire o = tempb;
-	endmodule"
-  (save-excursion
-    ;;Point must be at insertion point
-    (let* ((indent-pt (current-indentation))
-	   (modi (verilog-modi-current))
-	   (sig-list (verilog-signals-combine-bus
-		      (verilog-signals-not-in
-		       (verilog-modi-get-signals modi)
-		       (verilog-modi-get-ports modi)
-		       ))))
-      (forward-line 1)
-      (verilog-insert-indent "// Beginning of automatic outputs (every signal)\n")
-      (verilog-insert-definition sig-list "output" indent-pt)
-      (verilog-modi-cache-add-outputs modi sig-list)
-      (verilog-insert-indent "// End of automatics\n")
-      )))
-
-(defun verilog-auto-input ()
-  "Expand AUTOINPUT statements, as part of \\[verilog-auto].
-Make input statements for any input signal into an /*AUTOINST*/ that
-isn't declared elsewhere inside the module.  This is useful for modules which
-only instantiate other modules.
-
-Limitations:
-  This ONLY detects outputs of AUTOINSTants (see verilog-read-sub-decl).
-
-  If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
-  instantiation, all bets are off.  (For example due to a AUTO_TEMPLATE).
-
-A simple example (see `verilog-auto-inst' for what else is going on here):
-
-	module ex_input (ov,i)
-	   output [31:0] ov;
-	   /*AUTOINPUT*/
-	   inst inst (/*AUTOINST*/);
-	endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_input (ov,i)
-	   output [31:0] ov;
-	   /*AUTOINPUT*/
-	   // Beginning of automatic inputs (from unused autoinst inputs)
-	   input		i;			// From inst of inst.v
-	   // End of automatics
-	   inst inst (/*AUTOINST*/
-		      // Outputs
-		      .ov			(ov[31:0]),
-		      // Inputs
-		      .i			(i));
-	endmodule"
-  (save-excursion
-    (let* ((indent-pt (current-indentation))
-	   (modi (verilog-modi-current))
-	   (sig-list (verilog-signals-not-in
-		      (verilog-modi-get-sub-inputs modi)
-		      (append (verilog-modi-get-inputs modi)
-			      (verilog-modi-get-inouts modi)
-			      (verilog-modi-get-wires modi)
-			      (verilog-modi-get-regs modi)
-			      (verilog-modi-get-consts modi)
-			      (verilog-modi-get-sub-outputs modi)
-			      (verilog-modi-get-sub-inouts modi)
-			      ))))
-      (forward-line 1)
-      (verilog-insert-indent "// Beginning of automatic inputs (from unused autoinst inputs)\n")
-      (verilog-insert-definition sig-list "input" indent-pt)
-      (verilog-modi-cache-add-inputs modi sig-list)
-      (verilog-insert-indent "// End of automatics\n")
-      )))
-
-(defun verilog-auto-inout ()
-  "Expand AUTOINOUT statements, as part of \\[verilog-auto].
-Make inout statements for any inout signal in an /*AUTOINST*/ that
-isn't declared elsewhere inside the module.
-
-Limitations:
-  This ONLY detects outputs of AUTOINSTants (see verilog-read-sub-decl).
-
-  If any concatenation, or bit-subscripts are missing in the AUTOINSTant's
-  instantiation, all bets are off.  (For example due to a AUTO_TEMPLATE).
-
-A simple example (see `verilog-auto-inst' for what else is going on here):
-
-	module ex_inout (ov,i)
-	   input i;
-	   /*AUTOINOUT*/
-	   inst inst (/*AUTOINST*/);
-	endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_inout (ov,i)
-	   input i;
-	   /*AUTOINOUT*/
-	   // Beginning of automatic inouts (from unused autoinst inouts)
-	   inout [31:0]	ov;			// From inst of inst.v
-	   // End of automatics
-	   inst inst (/*AUTOINST*/
-		      // Inouts
-		      .ov			(ov[31:0]),
-		      // Inputs
-		      .i			(i));
-	endmodule"
-  (save-excursion
-    ;; Point must be at insertion point.
-    (let* ((indent-pt (current-indentation))
-	   (modi (verilog-modi-current))
-	   (sig-list (verilog-signals-not-in
-		      (verilog-modi-get-sub-inouts modi)
-		      (append (verilog-modi-get-outputs modi)
-			      (verilog-modi-get-inouts modi)
-			      (verilog-modi-get-inputs modi)
-			      (verilog-modi-get-sub-inputs modi)
-			      (verilog-modi-get-sub-outputs modi)
-			      ))))
-      (forward-line 1)
-      (verilog-insert-indent "// Beginning of automatic inouts (from unused autoinst inouts)\n")
-      (verilog-insert-definition sig-list "inout" indent-pt)
-      (verilog-modi-cache-add-inouts modi sig-list)
-      (verilog-insert-indent "// End of automatics\n")
-      )))
-
-(defun verilog-auto-inout-module ()
-  "Expand AUTOINOUTMODULE statements, as part of \\[verilog-auto].
-Take input/output/inout statements from the specified module and insert
-into the current module.  This is useful for making null templates and
-shell modules which need to have identical I/O with another module.  Any
-I/O which are already defined in this module will not be redefined.
-
-Limitations:
-  Concatenation and outputting partial busses is not supported.
-  Module names must be resolvable to filenames.  See \\[verilog-auto-inst].
-  Signals are not inserted in the same order as in the original module,
-  though they will appear to be in the same order to a AUTOINST
-  instantiating either module.
-
-A simple example:
-
-	module ex_shell (/*AUTOARG*/)
-	   /*AUTOINOUTMODULE(\"ex_main\")*/
-	endmodule
-
-	module ex_main (i,o,io)
-          input i;
-          output o;
-          inout io;
-        endmodule
-
-Typing \\[verilog-auto] will make this into:
-
-	module ex_shell (/*AUTOARG*/i,o,io)
-	   /*AUTOINOUTMODULE(\"ex_main\")*/
-           // Beginning of automatic in/out/inouts (from specific module)
-           input i;
-           output o;
-           inout io;
-	   // End of automatics
-	endmodule"
-  (save-excursion
-    (let* ((submod (car (verilog-read-auto-params 1))) submodi)
-      ;; Lookup position, etc of co-module
-      ;; Note this may raise an error
-      (when (setq submodi (verilog-modi-lookup submod t))
-	(let* ((indent-pt (current-indentation))
-	       (modi (verilog-modi-current))
-	       (sig-list-i  (verilog-signals-not-in
-			     (verilog-modi-get-inputs submodi)
-			     (append (verilog-modi-get-inputs modi))))
-	       (sig-list-o  (verilog-signals-not-in
-			     (verilog-modi-get-outputs submodi)
-			     (append (verilog-modi-get-outputs modi))))
-	       (sig-list-io (verilog-signals-not-in
-			     (verilog-modi-get-inouts submodi)
-			     (append (verilog-modi-get-inouts modi)))))
-	  (forward-line 1)
-	  (verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n")
-	  ;; Don't sort them so a upper AUTOINST will match the main module
-	  (verilog-insert-definition sig-list-o  "output" indent-pt t)
-	  (verilog-insert-definition sig-list-io "inout" indent-pt t)
-	  (verilog-insert-definition sig-list-i  "input" indent-pt t)
-	  (verilog-modi-cache-add-inputs modi sig-list-i)
-	  (verilog-modi-cache-add-outputs modi sig-list-o)
-	  (verilog-modi-cache-add-inouts modi sig-list-io)
-	  (verilog-insert-indent "// End of automatics\n")
-	  )))))
-
-(defun verilog-auto-sense ()
-  "Expand AUTOSENSE statements, as part of \\[verilog-auto].
-Replace the always (/*AUTOSENSE*/) sensitivity list (/*AS*/ for short)
-with one automatically derived from all inputs declared in the always
-statement.  Signals that are generated within the same always block are NOT
-placed into the sensitivity list (see `verilog-auto-sense-include-inputs').
-Long lines are split based on the `fill-column', see \\[set-fill-column].
-
-Limitations:
-  Verilog does not allow memories (multidimensional arrays) in sensitivity
-  lists.  AUTOSENSE will thus exclude them, and add a /*memory or*/ comment.
-
-Constant signals:
-  AUTOSENSE cannot always determine if a `define is a constant or a signal
-  (it could be in a include file for example).  If a `define or other signal
-  is put into the AUTOSENSE list and is not desired, use the AUTO_CONSTANT
-  declaration anywhere in the module (parenthesis are required):
-
-	/* AUTO_CONSTANT ( `this_is_really_constant_dont_autosense_it ) */
-
-  Better yet, use a parameter, which will be understood to be constant
-  automatically.
-
-OOps!
-  If AUTOSENSE makes a mistake, please report it.  (First try putting
-  a begin/end after your always!) As a workaround, if a signal that
-  shouldn't be in the sensitivity list was, use the AUTO_CONSTANT above.
-  If a signal should be in the sensitivity list wasn't, placing it before
-  the /*AUTOSENSE*/ comment will prevent it from being deleted when the
-  autos are updated (or added if it occurs there already).
-
-A simple example:
-
-	   always @ (/*AUTOSENSE*/) begin
-	      /* AUTO_CONSTANT (`constant) */
-	      outin = ina | inb | `constant;
-	      out = outin;
-	   end
-
-Typing \\[verilog-auto] will make this into:
-
-	   always @ (/*AUTOSENSE*/ina or inb) begin
-	      /* AUTO_CONSTANT (`constant) */
-	      outin = ina | inb | `constant;
-	      out = outin;
-	   end"
-  (save-excursion
-    ;; Find beginning
-    (let* ((start-pt (save-excursion
-		       (verilog-re-search-backward "(" nil t)
-		       (point)))
-	   (indent-pt (save-excursion
-			(or (and (goto-char start-pt) (1+ (current-column)))
-			    (current-indentation))))
-	   (modi (verilog-modi-current))
-	   (sig-memories (verilog-signals-memory (verilog-modi-get-regs modi)))
-	   sigss sig-list not-first presense-sigs)
-      ;; Read signals in always, eliminate outputs from sense list
-      (setq presense-sigs (verilog-signals-from-signame
-			   (save-excursion
-			     (verilog-read-signals start-pt (point)))))
-      (setq sigss (verilog-read-always-signals))
-      (setq sig-list (verilog-signals-not-params
-		      (verilog-signals-not-in (verilog-alw-get-inputs sigss)
-					      (append (and (not verilog-auto-sense-include-inputs)
-							   (verilog-alw-get-outputs sigss))
-						      (verilog-modi-get-consts modi)
-						      presense-sigs)
-					      )))
-      (when sig-memories
-	(let ((tlen (length sig-list)))
-	  (setq sig-list (verilog-signals-not-in sig-list sig-memories))
-	  (if (not (eq tlen (length sig-list))) (insert " /*memory or*/ "))))
-      (if (and presense-sigs  ;; Add a "or" if not "(.... or /*AUTOSENSE*/"
-	       (save-excursion (goto-char (point))
-			       (verilog-re-search-backward "[a-zA-Z0-9$_.%`]+" start-pt t)
-			       (verilog-re-search-backward "\\s-" start-pt t)
-			       (while (looking-at "\\s-`endif")
-				 (verilog-re-search-backward "[a-zA-Z0-9$_.%`]+" start-pt t)
-				 (verilog-re-search-backward "\\s-" start-pt t))
-			       (not (looking-at "\\s-or\\b"))))
-	  (setq not-first t))
-      (setq sig-list (sort sig-list `verilog-signals-sort-compare))
-      (while sig-list
-	(cond ((> (+ 4 (current-column) (length (verilog-sig-name (car sig-list)))) fill-column) ;+4 for width of or
-	       (insert "\n")
-	       (indent-to indent-pt)
-	       (if not-first (insert "or ")))
-	      (not-first (insert " or ")))
-	(insert (verilog-sig-name (car sig-list)))
-	(setq sig-list (cdr sig-list)
-	      not-first t))
-      )))
-
-(defun verilog-auto-reset ()
-  "Expand AUTORESET statements, as part of \\[verilog-auto].
-Replace the /*AUTORESET*/ comment with code to initialize all
-registers set elsewhere in the always block.
-
-Limitations:
-  AUTORESET will not clear memories.
-  AUTORESET uses <= if there are any <= in the block, else it uses =.
-
-/*AUTORESET*/ presumes that any signals mentioned between the previous
-begin/case/if statement and the AUTORESET comment are being reset manually
-and should not be automatically reset.  This includes ommitting any signals
-used on the right hand side of assignments.
-
-A simple example:
-
-    always @(posedge clk or negedge reset_l) begin
-        if (!reset_l) begin
-            c <= 1;
-            /*AUTORESET*/
-        end
-        else begin
-            a <= in_a;
-            b <= in_b;
-            c <= in_c;
-        end
-    end
-
-Typing \\[verilog-auto] will make this into:
-
-    always @(posedge core_clk or negedge reset_l) begin
-        if (!reset_l) begin
-            c <= 1;
-            /*AUTORESET*/
-            // Beginning of autoreset for uninitialized flops
-            a <= 0;
-            b <= 0;
-            // End of automatics
-        end
-        else begin
-            a <= in_a;
-            b <= in_b;
-            c <= in_c;
-        end
-    end"
-
-  (interactive)
-  (save-excursion
-    ;; Find beginning
-    (let* ((indent-pt (current-indentation))
-	   (modi (verilog-modi-current))
-	   (all-list (verilog-modi-get-signals modi))
-	   sigss sig-list prereset-sigs assignment-str)
-      ;; Read signals in always, eliminate outputs from reset list
-      (setq prereset-sigs (verilog-signals-from-signame
-			   (save-excursion
-			     (verilog-read-signals
-			      (save-excursion
-				(verilog-re-search-backward "\\(@\\|\\<begin\\>\\|\\<if\\>\\|\\<case\\>\\)" nil t)
-				(point))
-			      (point)))))
-      (save-excursion
-	(verilog-re-search-backward "@" nil t)
-        (setq sigss (verilog-read-always-signals)))
-      (setq assignment-str (if (verilog-alw-get-uses-delayed sigss)
-			       (concat " <= " verilog-assignment-delay)
-			     " = "))
-      (setq sig-list (verilog-signals-not-in (verilog-alw-get-outputs sigss)
-					     prereset-sigs))
-      (setq sig-list (sort sig-list `verilog-signals-sort-compare))
-      (insert "\n");
-      (indent-to indent-pt)
-      (insert "// Beginning of autoreset for uninitialized flops\n");
-      (indent-to indent-pt)
-      (while sig-list
-	(let* ((defn-sig (if verilog-auto-reset-widths
-			     (assoc (verilog-sig-name (car sig-list)) all-list)))
-	       (width (if defn-sig (verilog-sig-width defn-sig))))
-	  (insert (verilog-sig-name (car sig-list)))
-	  (cond ((not width)
-		 (insert assignment-str "0;\n"))
-		((string-match "^[0-9]+$" width)
-		 (insert assignment-str (verilog-sig-width defn-sig) "'h0;\n" ))
-		(t
-		 (insert assignment-str "{" (verilog-sig-width defn-sig) "{1'b0}};\n" )))
-	  (indent-to indent-pt)
-	  (setq sig-list (cdr sig-list))))
-      (insert "// End of automatics")
-      )))
-
-(defun verilog-enum-ascii (signm elim-regexp)
-  "Convert a enum name SIGNM to a ascii string for insertion.
-Remove user provided prefix ELIM-REGEXP."
-  (or elim-regexp (setq elim-regexp "_ DONT MATCH IT_"))
-  (let ((case-fold-search t))
-    ;; All upper becomes all lower for readability
-    (downcase (verilog-string-replace-matches elim-regexp "" nil nil signm))))
-
-(defun verilog-auto-ascii-enum ()
-  "Expand AUTOASCIIENUM statements, as part of \\[verilog-auto].
-Create a register to contain the ASCII decode of a enumerated signal type.
-This will allow trace viewers to show the ASCII name of states.
-
-First, parameters are built into a enumeration using the synopsys enum
-  comment.  The comment must be between the keyword and the symbol.
-  (Annoying, but that's what Synopsys's dc_shell FSM reader requires.)
-
-Next, registers which that enum applies to are also tagged with the same
-  enum.  Synopsys also suggests labeling state vectors, but `verilog-mode'
-  doesn't care.
-
-Finally, a AUTOASCIIENUM command is used.
-  The first parameter is the name of the signal to be decoded.
-
-  The second parameter is the name to store the ASCII code into.  For the
-  signal foo, I suggest the name _foo__ascii, where the leading _ indicates
-  a signal that is just for simulation, and the magic characters _ascii
-  tell viewers like Dinotrace to display in ASCII format.
-
-  The final optional parameter is a string which will be removed from the
-  state names.
-
-
-A simple example:
-
-   //== State enumeration
-   parameter [2:0] // synopsys enum state_info
-		   SM_IDLE =  3'b000,
-		   SM_SEND =  3'b001,
-		   SM_WAIT1 = 3'b010;
-   //== State variables
-   reg [2:0]	/* synopsys enum state_info */
-		state_r;		/* synopsys state_vector state_r */
-   reg [2:0]	/* synopsys enum state_info */
-		state_e1;
-
-   //== ASCII state decoding
-
-   /*AUTOASCIIENUM(\"state_r\", \"_stateascii_r\", \"sm_\")*/
-
-Typing \\[verilog-auto] will make this into:
-
-   ... same front matter ...
-
-   /*AUTOASCIIENUM(\"state_r\", \"_stateascii_r\", \"sm_\")*/
-   // Beginning of automatic ASCII enum decoding
-   reg [39:0]		_stateascii_r;		// Decode of state_r
-   always @(state_r) begin
-      case ({state_r})
-	SM_IDLE:  _stateascii_r = \"idle \";
-	SM_SEND:  _stateascii_r = \"send \";
-	SM_WAIT1: _stateascii_r = \"wait1\";
-	default:  _stateascii_r = \"%Erro\";
-      endcase
-   end
-   // End of automatics"
-  (save-excursion
-    (let* ((params (verilog-read-auto-params 2 3))
-	   (undecode-name (nth 0 params))
-	   (ascii-name (nth 1 params))
-	   (elim-regexp (nth 2 params))
-	   ;;
-	   (indent-pt (current-indentation))
-	   (modi (verilog-modi-current))
-	   ;;
-	   (sig-list-consts (verilog-modi-get-consts modi))
-	   (sig-list-all  (append (verilog-modi-get-regs modi)
-				  (verilog-modi-get-outputs modi)
-				  (verilog-modi-get-inouts modi)
-				  (verilog-modi-get-inputs modi)
-				  (verilog-modi-get-wires modi)))
-	   ;;
-	   (undecode-sig (or (assoc undecode-name sig-list-all)
-			     (error "%s: Signal %s not found in design" (verilog-point-text) undecode-name)))
-	   (undecode-enum (or (verilog-sig-enum undecode-sig)
-			      (error "%s: Signal %s does not have a enum tag" (verilog-point-text) undecode-name)))
-	   ;;
-	   (enum-sigs (or (verilog-signals-matching-enum sig-list-consts undecode-enum)
-			  (error "%s: No state definitions for %s" (verilog-point-text) undecode-enum)))
-	   ;;
-	   (enum-chars 0)
-	   (ascii-chars 0))
-      ;;
-      ;; Find number of ascii chars needed
-      (let ((tmp-sigs enum-sigs))
-	(while tmp-sigs
-	  (setq enum-chars (max enum-chars (length (verilog-sig-name (car tmp-sigs))))
-		ascii-chars (max ascii-chars (length (verilog-enum-ascii
-						      (verilog-sig-name (car tmp-sigs))
-						      elim-regexp)))
-		tmp-sigs (cdr tmp-sigs))))
-      ;;
-      (forward-line 1)
-      (verilog-insert-indent "// Beginning of automatic ASCII enum decoding\n")
-      (let ((decode-sig-list (list (list ascii-name (format "[%d:0]" (- (* ascii-chars 8) 1))
-					 (concat "Decode of " undecode-name) nil nil))))
-	(verilog-insert-definition decode-sig-list "reg" indent-pt)
-	(verilog-modi-cache-add-regs modi decode-sig-list))
-      ;;
-      (verilog-insert-indent "always @(" undecode-name ") begin\n")
-      (setq indent-pt (+ indent-pt verilog-indent-level))
-      (indent-to indent-pt)
-      (insert "case ({" undecode-name "})\n")
-      (setq indent-pt (+ indent-pt verilog-case-indent))
-      ;;
-      (let ((tmp-sigs enum-sigs)
-	    (chrfmt (format "%%-%ds %s = \"%%-%ds\";\n" (1+ (max 8 enum-chars))
-			    ascii-name ascii-chars))
-	    (errname (substring "%Error" 0 (min 6 ascii-chars))))
-	(while tmp-sigs
-	  (verilog-insert-indent
-	   (format chrfmt (concat (verilog-sig-name (car tmp-sigs)) ":")
-		   (verilog-enum-ascii (verilog-sig-name (car tmp-sigs))
-				       elim-regexp)))
-	  (setq tmp-sigs (cdr tmp-sigs)))
-	(verilog-insert-indent (format chrfmt "default:" errname)))
-      ;;
-      (setq indent-pt (- indent-pt verilog-case-indent))
-      (verilog-insert-indent "endcase\n")
-      (setq indent-pt (- indent-pt verilog-indent-level))
-      (verilog-insert-indent "end\n"
-			     "// End of automatics\n")
-      )))
-
-(defun verilog-auto-templated-rel ()
-  "Replace Templated relative line numbers with absolute line numbers.
-Internal use only. This hacks around the line numbers in AUTOINST Templates
-being different from the final output's line numbering."
-  (let ((templateno 0) (template-line (list 0)))
-    ;; Find line number each template is on
-    (goto-char (point-min))
-    (while (search-forward "AUTO_TEMPLATE" nil t)
-      (setq templateno (1+ templateno))
-      (setq template-line (cons (count-lines (point-min) (point)) template-line)))
-    (setq template-line (nreverse template-line))
-    ;; Replate T# L# with absolute line number
-    (goto-char (point-min))
-    (while (re-search-forward " Templated T\\([0-9]+\\) L\\([0-9]+\\)" nil t)
-      (replace-match (concat " Templated "
-			     (int-to-string (+ (nth (string-to-int (match-string 1))
-						    template-line)
-					       (string-to-int (match-string 2)))))
-		     t t))))
-
-
-;;
-;; Auto top level
-;;
-
-(defun verilog-auto ()
-  "Expand AUTO statements.
-Look for any /*AUTO...*/ commands in the code, as used in
-instantiations or argument headers.  Update the list of signals
-following the /*AUTO...*/ command.
-
-Use \\[verilog-delete-auto] to remove the AUTOs.
-
-The hooks `verilog-before-auto-hook' and `verilog-auto-hook' are
-called before and after this function, respectively.
-
-For example:
-	module (/*AUTOARG*/)
-	/*AUTOINPUT*/
-	/*AUTOOUTPUT*/
-	/*AUTOWIRE*/
-	/*AUTOREG*/
-	somesub sub (/*AUTOINST*/);
-
-You can also update the AUTOs from the shell using:
-	emacs --batch $FILENAME_V -f verilog-auto -f save-buffer
-
-Using \\[describe-function], see also:
-   `verilog-auto-arg'          for AUTOARG module instantiations
-   `verilog-auto-ascii-enum'   for AUTOASCIIENUM enumeration decoding
-   `verilog-auto-inout-module' for AUTOINOUTMODULE copying i/o from elsewhere
-   `verilog-auto-inout'        for AUTOINOUT making hierarchy inouts
-   `verilog-auto-input'        for AUTOINPUT making hierarchy inputs
-   `verilog-auto-inst'         for AUTOINST argument declarations
-   `verilog-auto-output'       for AUTOOUTPUT making hierarchy outputs
-   `verilog-auto-output-every' for AUTOOUTPUTEVERY making all outputs
-   `verilog-auto-reg'          for AUTOREG registers
-   `verilog-auto-reg-input'    for AUTOREGINPUT instantiation registers
-   `verilog-auto-reset'        for AUTORESET flop resets
-   `verilog-auto-sense'        for AUTOSENSE always sensitivity lists
-   `verilog-auto-wire'         for AUTOWIRE instantiation wires
-
-   `verilog-read-defines'      for reading `define values
-   `verilog-read-includes'     for reading `includes
-
-If you have bugs with these autos, try contacting the AUTOAUTHOR
-Wilson Snyder (wsnyder@wsnyder.org or wsnyder@world.std.com)"
-  (interactive)
-  (unless noninteractive (message "Updating AUTOs..."))
-  (if (featurep 'dinotrace)
-      (dinotrace-unannotate-all))
-  (let ((oldbuf (if (not (buffer-modified-p))
-		    (buffer-string)))
-	;; Before version 20, match-string with font-lock returns a
-	;; vector that is not equal to the string.  IE if on "input"
-	;; nil==(equal "input" (progn (looking-at "input") (match-string 0)))
-	(fontlocked (when (and ;(memq 'v19 verilog-emacs-features)
-			       (boundp 'font-lock-mode)
-			       font-lock-mode)
-		      (font-lock-mode nil)
-		      t)))
-    (save-excursion
-      (run-hooks 'verilog-before-auto-hook)
-      ;; Try to save the user from needing to revert-file to reread file local-variables
-      (verilog-auto-reeval-locals)
-      ;; These two may seem obvious to do always, but on large includes it can be way too slow
-      (when verilog-auto-read-includes
-	(verilog-read-includes)
-	(verilog-read-defines))
-      ;; This particular ordering is important
-      ;; INST: Lower modules correct, no internal dependencies, FIRST
-      (verilog-preserve-cache
-       ;; Clear existing autos else we'll be screwed by existing ones
-       (verilog-delete-auto)
-       ;;
-       (verilog-auto-search-do "/*AUTOINST*/" 'verilog-auto-inst)
-       ;; Doesn't matter when done, but combine it with a common changer
-       (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense)
-       (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset)
-       ;; Must be done before autoin/out as creates a reg
-       (verilog-auto-re-search-do "/\\*AUTOASCIIENUM([^)]*)\\*/" 'verilog-auto-ascii-enum)
-       ;;
-       ;; first in/outs from other files
-       (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE([^)]*)\\*/" 'verilog-auto-inout-module)
-       ;; next in/outs which need previous sucked inputs first
-       (verilog-auto-search-do "/*AUTOOUTPUT*/" 'verilog-auto-output)
-       (verilog-auto-search-do "/*AUTOINPUT*/" 'verilog-auto-input)
-       (verilog-auto-search-do "/*AUTOINOUT*/" 'verilog-auto-inout)
-       ;; Wires/regs must be after inputs/outputs
-       (verilog-auto-search-do "/*AUTOWIRE*/" 'verilog-auto-wire)
-       (verilog-auto-search-do "/*AUTOREG*/" 'verilog-auto-reg)
-       (verilog-auto-search-do "/*AUTOREGINPUT*/" 'verilog-auto-reg-input)
-       ;; outputevery needs autooutputs done first
-       (verilog-auto-search-do "/*AUTOOUTPUTEVERY*/" 'verilog-auto-output-every)
-       ;; Must be after all inputs outputs are generated
-       (verilog-auto-search-do "/*AUTOARG*/" 'verilog-auto-arg)
-       ;; Fix line numbers (comments only)
-       (verilog-auto-templated-rel)
-       )
-      ;;
-      (run-hooks 'verilog-auto-hook)
-      ;;
-      (set (make-local-variable 'verilog-auto-update-tick) (buffer-modified-tick))
-      ;;
-      ;; If end result is same as when started, clear modified flag
-      (cond ((and oldbuf (equal oldbuf (buffer-string)))
-	     (set-buffer-modified-p nil)
-	     (unless noninteractive (message "Updating AUTOs...done (no changes)")))
-	    (t (unless noninteractive (message "Updating AUTOs...done"))))
-      ;; Restore font-lock
-      (when fontlocked (font-lock-mode t))
-      )))
-
-
-;;
-;; Skeleton based code insertion
-;;
-(defvar verilog-template-map nil
-  "Keymap used in Verilog mode for smart template operations.")
-
-(let ((verilog-mp (make-sparse-keymap)))
-  (define-key verilog-mp "a" 'verilog-sk-always)
-  (define-key verilog-mp "b" 'verilog-sk-begin)
-  (define-key verilog-mp "c" 'verilog-sk-case)
-  (define-key verilog-mp "e" 'verilog-sk-else)
-  (define-key verilog-mp "f" 'verilog-sk-for)
-  (define-key verilog-mp "g" 'verilog-sk-generate)
-  (define-key verilog-mp "h" 'verilog-sk-header)
-  (define-key verilog-mp "i" 'verilog-sk-initial)
-  (define-key verilog-mp "j" 'verilog-sk-fork)
-  (define-key verilog-mp "m" 'verilog-sk-module)
-  (define-key verilog-mp "p" 'verilog-sk-primitive)
-  (define-key verilog-mp "r" 'verilog-sk-repeat)
-  (define-key verilog-mp "s" 'verilog-sk-specify)
-  (define-key verilog-mp "t" 'verilog-sk-task)
-  (define-key verilog-mp "w" 'verilog-sk-while)
-  (define-key verilog-mp "x" 'verilog-sk-casex)
-  (define-key verilog-mp "z" 'verilog-sk-casez)
-  (define-key verilog-mp "?" 'verilog-sk-if)
-  (define-key verilog-mp ":" 'verilog-sk-else-if)
-  (define-key verilog-mp "/" 'verilog-sk-comment)
-  (define-key verilog-mp "A" 'verilog-sk-assign)
-  (define-key verilog-mp "F" 'verilog-sk-function)
-  (define-key verilog-mp "I" 'verilog-sk-input)
-  (define-key verilog-mp "O" 'verilog-sk-output)
-  (define-key verilog-mp "S" 'verilog-sk-state-machine)
-  (define-key verilog-mp "=" 'verilog-sk-inout)
-  (define-key verilog-mp "W" 'verilog-sk-wire)
-  (define-key verilog-mp "R" 'verilog-sk-reg)
-  (setq verilog-template-map verilog-mp))
-
-;;
-;; Place the templates into Verilog Mode.  They may be inserted under any key.
-;; C-c C-t will be the default.  If you use templates a lot, you
-;; may want to consider moving the binding to another key in your .emacs
-;; file.
-;;
-;(define-key verilog-mode-map "\C-ct" verilog-template-map)
-(define-key verilog-mode-map "\C-c\C-t" verilog-template-map)
-
-;;; ---- statement skeletons ------------------------------------------
-
-(define-skeleton verilog-sk-prompt-condition
-  "Prompt for the loop condition."
-  "[condition]: " str )
-
-(define-skeleton verilog-sk-prompt-init
-  "Prompt for the loop init statement."
-  "[initial statement]: " str )
-
-(define-skeleton verilog-sk-prompt-inc
-  "Prompt for the loop increment statement."
-  "[increment statement]: " str )
-
-(define-skeleton verilog-sk-prompt-name
-  "Prompt for the name of something."
-  "[name]: " str)
-
-(define-skeleton verilog-sk-prompt-clock
-  "Prompt for the name of something."
-  "name and edge of clock(s): " str)
-
-(defvar verilog-sk-reset nil)
-(defun verilog-sk-prompt-reset ()
-  "Prompt for the name of a state machine reset."
-  (setq verilog-sk-reset (read-input "name of reset: " "rst")))
-
-
-(define-skeleton verilog-sk-prompt-state-selector
-  "Prompt for the name of a state machine selector."
-  "name of selector (eg {a,b,c,d}): " str )
-
-(define-skeleton verilog-sk-prompt-output
-  "Prompt for the name of something."
-  "output: " str)
-
-(define-skeleton verilog-sk-prompt-msb
-  "Prompt for least signifcant bit specification."
-  "msb:" str & ?: & (verilog-sk-prompt-lsb) | -1 )
-
-(define-skeleton verilog-sk-prompt-lsb
-  "Prompt for least signifcant bit specification."
-  "lsb:" str )
-
-(defvar verilog-sk-p nil)
-(define-skeleton verilog-sk-prompt-width
-  "Prompt for a width specification."
-  ()
-  (progn (setq verilog-sk-p (point)) nil)
-  (verilog-sk-prompt-msb)
-  (if (> (point) verilog-sk-p) "] " " "))
-
-(defun verilog-sk-header ()
-  "Insert a descriptive header at the top of the file."
-  (interactive "*")
-  (save-excursion
-    (goto-char (point-min))
-    (verilog-sk-header-tmpl)))
-
-(define-skeleton verilog-sk-header-tmpl
-  "Insert a comment block containing the module title, author, etc."
-  "[Description]: "
-  "//                              -*- Mode: Verilog -*-"
-  "\n// Filename        : " (buffer-name)
-  "\n// Description     : " str
-  "\n// Author          : " (user-full-name)
-  "\n// Created On      : " (current-time-string)
-  "\n// Last Modified By: ."
-  "\n// Last Modified On: ."
-  "\n// Update Count    : 0"
-  "\n// Status          : Unknown, Use with caution!"
-  "\n")
-
-(define-skeleton verilog-sk-module
-  "Insert a module definition."
-  ()
-  > "module " (verilog-sk-prompt-name) " (/*AUTOARG*/ ) ;" \n
-  > _ \n
-  > (- verilog-indent-level-behavioral) "endmodule" (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-primitive
-  "Insert a task definition."
-  ()
-  > "primitive " (verilog-sk-prompt-name) " ( " (verilog-sk-prompt-output) ("input:" ", " str ) " );"\n
-  > _ \n
-  > (- verilog-indent-level-behavioral) "endprimitive" (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-task
-  "Insert a task definition."
-  ()
-  > "task " (verilog-sk-prompt-name) & ?; \n
-  > _ \n
-  > "begin" \n
-  > \n
-  > (- verilog-indent-level-behavioral) "end" \n
-  > (- verilog-indent-level-behavioral) "endtask" (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-function
-  "Insert a function definition."
-  ()
-  > "function [" (verilog-sk-prompt-width) | -1 (verilog-sk-prompt-name) ?; \n
-  > _ \n
-  > "begin" \n
-  > \n
-  > (- verilog-indent-level-behavioral) "end" \n
-  > (- verilog-indent-level-behavioral) "endfunction" (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-always
-  "Insert always block.  Uses the minibuffer to prompt
-for sensitivity list."
-  ()
-  > "always @ ( /*AUTOSENSE*/ ) begin\n"
-  > _ \n
-  > (- verilog-indent-level-behavioral) "end" \n >
-  )
-
-(define-skeleton verilog-sk-initial
-  "Insert an initial block."
-  ()
-  > "initial begin\n"
-  > _ \n
-  > (- verilog-indent-level-behavioral) "end" \n > )
-
-(define-skeleton verilog-sk-specify
-  "Insert specify block.  "
-  ()
-  > "specify\n"
-  > _ \n
-  > (- verilog-indent-level-behavioral) "endspecify" \n > )
-
-(define-skeleton verilog-sk-generate
-  "Insert generate block.  "
-  ()
-  > "generate\n"
-  > _ \n
-  > (- verilog-indent-level-behavioral) "endgenerate" \n > )
-
-(define-skeleton verilog-sk-begin
-  "Insert begin end block.  Uses the minibuffer to prompt for name"
-  ()
-  > "begin" (verilog-sk-prompt-name) \n
-  > _ \n
-  > (- verilog-indent-level-behavioral) "end"
-)
-
-(define-skeleton verilog-sk-fork
-  "Insert an fork join block."
-  ()
-  > "fork\n"
-  > "begin" \n
-  > _ \n
-  > (- verilog-indent-level-behavioral) "end" \n
-  > "begin" \n
-  > \n
-  > (- verilog-indent-level-behavioral) "end" \n
-  > (- verilog-indent-level-behavioral) "join" \n
-  > )
-
-
-(define-skeleton verilog-sk-case
-  "Build skeleton case statement, prompting for the selector expression,
-and the case items."
-  "[selector expression]: "
-  > "case (" str ") " \n
-  > ("case selector: " str ": begin" \n > _ \n > (- verilog-indent-level-behavioral) "end" \n )
-  resume: >  (- verilog-case-indent) "endcase" (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-casex
-  "Build skeleton casex statement, prompting for the selector expression,
-and the case items."
-  "[selector expression]: "
-  > "casex (" str ") " \n
-  > ("case selector: " str ": begin" \n > _ \n > (- verilog-indent-level-behavioral) "end" \n )
-  resume: >  (- verilog-case-indent) "endcase" (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-casez
-  "Build skeleton casez statement, prompting for the selector expression,
-and the case items."
-  "[selector expression]: "
-  > "casez (" str ") " \n
-  > ("case selector: " str ": begin" \n > _ \n > (- verilog-indent-level-behavioral) "end" \n )
-  resume: >  (- verilog-case-indent) "endcase" (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-if
-  "Insert a skeleton if statement."
-  > "if (" (verilog-sk-prompt-condition) & ")" " begin" \n
-  > _ \n
-  > (- verilog-indent-level-behavioral) "end " \n )
-
-(define-skeleton verilog-sk-else-if
-  "Insert a skeleton else if statement."
-  > (verilog-indent-line) "else if ("
-  (progn (setq verilog-sk-p (point)) nil) (verilog-sk-prompt-condition) (if (> (point) verilog-sk-p) ") " -1 ) & " begin" \n
-  > _ \n
-  > "end" (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-datadef
-  "Common routine to get data definition"
-  ()
-  (verilog-sk-prompt-width) | -1 ("name (RET to end):" str ", ") -2 ";" \n)
-
-(define-skeleton verilog-sk-input
-  "Insert an input definition."
-  ()
-  > "input  [" (verilog-sk-datadef))
-
-(define-skeleton verilog-sk-output
-  "Insert an output definition."
-  ()
-  > "output [" (verilog-sk-datadef))
-
-(define-skeleton verilog-sk-inout
-  "Insert an inout definition."
-  ()
-  > "inout  [" (verilog-sk-datadef))
-
-(define-skeleton verilog-sk-reg
-  "Insert a reg definition."
-  ()
-  > "reg    [" (verilog-sk-datadef))
-
-(define-skeleton verilog-sk-wire
-  "Insert a wire definition."
-  ()
-  > "wire   [" (verilog-sk-datadef))
-
-(define-skeleton verilog-sk-assign
-  "Insert a skeleton assign statement."
-  ()
-  > "assign " (verilog-sk-prompt-name) " = " _ ";" \n)
-
-(define-skeleton verilog-sk-while
-  "Insert a skeleton while loop statement."
-  ()
-  > "while ("  (verilog-sk-prompt-condition)  ") begin" \n
-  > _ \n
-  > (- verilog-indent-level-behavioral) "end " (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-repeat
-  "Insert a skeleton repeat loop statement."
-  ()
-  > "repeat ("  (verilog-sk-prompt-condition)  ") begin" \n
-  > _ \n
-  > (- verilog-indent-level-behavioral) "end " (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-for
-  "Insert a skeleton while loop statement."
-  ()
-  > "for ("
-  (verilog-sk-prompt-init) "; "
-  (verilog-sk-prompt-condition) "; "
-  (verilog-sk-prompt-inc)
-  ") begin" \n
-  > _ \n
-  > (- verilog-indent-level-behavioral) "end " (progn (electric-verilog-terminate-line) nil))
-
-(define-skeleton verilog-sk-comment
-  "Inserts three comment lines, making a display comment."
-  ()
-  > "/*\n"
-  > "* " _ \n
-  > "*/")
-
-(define-skeleton verilog-sk-state-machine
-  "Insert a state machine definition."
-  "Name of state variable: "
-  '(setq input "state")
-  > "// State registers for " str | -23 \n
-  '(setq verilog-sk-state str)
-  > "reg [" (verilog-sk-prompt-width) | -1 verilog-sk-state ", next_" verilog-sk-state ?; \n
-  '(setq input nil)
-  > \n
-  > "// State FF for " verilog-sk-state \n
-  > "always @ ( " (read-string "clock:" "posedge clk") " or " (verilog-sk-prompt-reset) " ) begin" \n
-  > "if ( " verilog-sk-reset " ) " verilog-sk-state " = 0; else" \n
-  > verilog-sk-state " = next_" verilog-sk-state ?; \n
-  > (- verilog-indent-level-behavioral) "end" (progn (electric-verilog-terminate-line) nil)
-  > \n
-  > "// Next State Logic for " verilog-sk-state \n
-  > "always @ ( /*AUTOSENSE*/ ) begin\n"
-  > "case (" (verilog-sk-prompt-state-selector) ") " \n
-  > ("case selector: " str ": begin" \n > "next_" verilog-sk-state " = " _ ";" \n > (- verilog-indent-level-behavioral) "end" \n )
-  resume: >  (- verilog-case-indent) "endcase" (progn (electric-verilog-terminate-line) nil)
-  > (- verilog-indent-level-behavioral) "end" (progn (electric-verilog-terminate-line) nil))
-
-;; Eliminate compile warning
-(eval-when-compile
-  (if (not (boundp 'mode-popup-menu))
-      (defvar mode-popup-menu nil "Compatibility with XEmacs.")))
-
-;; ---- add menu 'Statements' in Verilog mode (MH)
-(defun verilog-add-statement-menu ()
-  "Add the menu 'Statements' to the menu bar in Verilog mode."
-  (easy-menu-define verilog-stmt-menu verilog-mode-map
-		    "Menu for statement templates in Verilog."
-		    '("Statements"
-		      ["Header"		verilog-sk-header  t]
-		      ["Comment"	verilog-sk-comment t]
-		      "----"
-		      ["Module"		verilog-sk-module t]
-		      ["Primitive"	verilog-sk-primitive t]
-		      "----"
-		      ["Input"		verilog-sk-input t]
-		      ["Output"		verilog-sk-output t]
-		      ["Inout"		verilog-sk-inout t]
-		      ["Wire"		verilog-sk-wire t]
-		      ["Reg"		verilog-sk-reg t]
-		      "----"
-		      ["Initial"	verilog-sk-initial t]
-		      ["Always" 	verilog-sk-always t]
-		      ["Function"	verilog-sk-function t]
-		      ["Task" 		verilog-sk-task t]
-		      ["Specify"	verilog-sk-specify t]
-		      ["Generate"	verilog-sk-generate t]
-		      "----"
-		      ["Begin"		verilog-sk-begin t]
-		      ["If" 		verilog-sk-if t]
-		      ["(if) else"	verilog-sk-else-if t]
-		      ["For" 		verilog-sk-for t]
-		      ["While" 		verilog-sk-while t]
-		      ["Fork" 		verilog-sk-fork t]
-		      ["Repeat" 	verilog-sk-repeat t]
-		      ["Case" 		verilog-sk-case t]
-		      ["Casex" 		verilog-sk-casex t]
-		      ["Casez" 		verilog-sk-casez t]
-		      ))
-  (if verilog-running-on-xemacs
-      (progn
-	(easy-menu-add verilog-stmt-menu)
-	(setq mode-popup-menu (cons "Verilog Mode" verilog-stmt-menu)))))
-
-(add-hook 'verilog-mode-hook 'verilog-add-statement-menu)
-
-
-
-;;
-;; Include file loading with mouse/return event
-;;
-;; idea & first impl.: M. Rouat (eldo-mode.el)
-;; second (emacs/xemacs) impl.: G. Van der Plas (spice-mode.el)
-
-(if verilog-running-on-xemacs
-    (require 'overlay)
-  (require 'lucid)) ;; what else can we do ??
-
-(defconst verilog-include-file-regexp
-  "^`include\\s-+\"\\([^\n\"]*\\)\""
-  "Regexp that matches the include file")
-
-(defvar verilog-mode-mouse-map nil
-  "Map containing mouse bindings for verilog-mode.")
-
-(if verilog-mode-mouse-map
-    ()
-  (let ((map (make-sparse-keymap))) ; as described in info pages, make a map
-    (set-keymap-parent map verilog-mode-map)
-    ;; mouse button bindings
-    (define-key map "\r"            'verilog-load-file-at-point)
-    (if verilog-running-on-xemacs
-	(define-key map 'button2    'verilog-load-file-at-mouse);ffap-at-mouse ?
-      (define-key map [mouse-2]     'verilog-load-file-at-mouse))
-    (if verilog-running-on-xemacs
-	(define-key map 'Sh-button2 'mouse-yank) ; you wanna paste don't you ?
-      (define-key map [S-mouse-2]   'mouse-yank-at-click))
-    (setq verilog-mode-mouse-map map))) ;; copy complete map now
-
-;; create set-extent-keymap procedure when it does not exist
-(eval-and-compile
-  (unless (fboundp 'set-extent-keymap)
-    (defun set-extent-keymap (extent keymap)
-      "fallback version of set-extent-keymap (for emacs 2[01])"
-      (set-extent-property extent 'local-map keymap))))
-
-(defun verilog-colorize-include-files (beg end old-len)
-  "This function colorises included files when the mouse passes over them.
-Clicking on the middle-mouse button loads them in a buffer (as in dired)."
-  (save-excursion
-    (save-match-data
-      (let (end-point)
-	(goto-char end)
-	(setq end-point (verilog-get-end-of-line))
-	(goto-char beg)
-	(beginning-of-line)  ; scan entire line !
-	;; delete overlays existing on this line
-	(let ((overlays (overlays-in (point) end-point)))
-	  (while overlays
-	    (if (and
-		 (overlay-get (car overlays) 'detachable)
-		 (overlay-get (car overlays) 'verilog-include-file))
-		(delete-overlay (car overlays)))
-	    (setq overlays (cdr overlays)))) ; let
-	;; make new ones, could reuse deleted one ?
-	(while (search-forward-regexp verilog-include-file-regexp end-point t)
-	  (let (extent)
-	    (goto-char (match-beginning 1))
-	    (or (extent-at (point) (buffer-name) 'mouse-face) ;; not yet extended
-		(progn
-		  (setq extent (make-extent (match-beginning 1) (match-end 1)))
-		  (set-extent-property extent 'start-closed 't)
-		  (set-extent-property extent 'end-closed 't)
-		  (set-extent-property extent 'detachable 't)
-		  (set-extent-property extent 'verilog-include-file 't)
-		  (set-extent-property extent 'mouse-face 'highlight)
-		  (set-extent-keymap extent verilog-mode-mouse-map)))))))))
-
-
-(defun verilog-colorize-include-files-buffer ()
-  (interactive)
-  ;; delete overlays
-  (let ((overlays (overlays-in (point-min) (point-max))))
-    (while overlays
-      (if (and
-	   (overlay-get (car overlays) 'detachable)
-	   (overlay-get (car overlays) 'verilog-include-file))
-	  (delete-overlay (car overlays)))
-      (setq overlays (cdr overlays)))) ; let
-  ;; remake overlays
-  (verilog-colorize-include-files (point-min) (point-max) nil))
-
-;; ffap-at-mouse isn't useful for verilog mode. It uses library paths.
-;; so define this function to do more or less the same as ffap-at-mouse
-;; but first resolve filename...
-(defun verilog-load-file-at-mouse (event)
-  "loads file under button 2 click. Files are checked based on
-`verilog-library-directories'."
-  (interactive "@e")
-  (save-excursion ;; implement a verilog specific ffap-at-mouse
-    (mouse-set-point event)
-    (beginning-of-line)
-    (if (looking-at verilog-include-file-regexp)
-	(if (and (car (verilog-library-filenames
-		       (match-string 1) (buffer-file-name)))
-		 (file-readable-p (car (verilog-library-filenames
-					(match-string 1) (buffer-file-name)))))
-	    (find-file (car (verilog-library-filenames
-			     (match-string 1) (buffer-file-name))))
-	  (progn
-	    (message
-	     "File '%s' isn't readable, use shift-mouse2 to paste in this field"
-	     (match-string 1))))
-      )))
-
-;; ffap isn't useable for verilog mode. It uses library paths.
-;; so define this function to do more or less the same as ffap
-;; but first resolve filename...
-(defun verilog-load-file-at-point ()
-  "loads file under point. Files are checked based on
-`verilog-library-directories'."
-  (interactive)
-  (save-excursion ;; implement a verilog specific ffap
-    (beginning-of-line)
-    (if (looking-at verilog-include-file-regexp)
-	(if (and
-	     (car (verilog-library-filenames
-		   (match-string 1) (buffer-file-name)))
-	     (file-readable-p (car (verilog-library-filenames
-				    (match-string 1) (buffer-file-name)))))
-	    (find-file (car (verilog-library-filenames
-			     (match-string 1) (buffer-file-name))))))
-      ))
-
-
-;;
-;; Bug reporting
-;;
-
-(defun verilog-submit-bug-report ()
-  "Submit via mail a bug report on lazy-lock.el."
-  (interactive)
-  (let ((reporter-prompt-for-summary-p t))
-    (reporter-submit-bug-report
-     "verilog-mode-bugs@surefirev.com"
-     (concat "verilog-mode v" (substring verilog-mode-version 12 -3))
-     '(
-       verilog-align-ifelse
-       verilog-auto-endcomments
-       verilog-auto-hook
-       verilog-auto-indent-on-newline
-       verilog-auto-inst-vector
-       verilog-auto-inst-template-numbers
-       verilog-auto-lineup
-       verilog-auto-newline
-       verilog-auto-save-policy
-       verilog-auto-sense-defines-constant
-       verilog-auto-sense-include-inputs
-       verilog-before-auto-hook
-       verilog-case-indent
-       verilog-cexp-indent
-       verilog-compiler
-       verilog-coverage
-       verilog-highlight-translate-off
-       verilog-indent-begin-after-if
-       verilog-indent-declaration-macros
-       verilog-indent-level
-       verilog-indent-level-behavioral
-       verilog-indent-level-declaration
-       verilog-indent-level-directive
-       verilog-indent-level-module
-       verilog-indent-lists
-       verilog-library-directories
-       verilog-library-extensions
-       verilog-library-files
-       verilog-linter
-       verilog-minimum-comment-distance
-       verilog-mode-hook
-       verilog-simulator
-       verilog-tab-always-indent
-       verilog-tab-to-comment
-       )
-     nil nil
-     (concat "Hi Mac,
-
-I want to report a bug.  I've read the `Bugs' section of `Info' on
-Emacs, so I know how to make a clear and unambiguous report.  To get
-to that Info section, I typed
-
-M-x info RET m " invocation-name " RET m bugs RET
-
-Before I go further, I want to say that Verilog mode has changed my life.
-I save so much time, my files are colored nicely, my co workers respect
-my coding ability... until now.  I'd really appreciate anything you
-could do to help me out with this minor deficiency in the product.
-
-To reproduce the bug, start a fresh Emacs via " invocation-name "
--no-init-file -no-site-file'.  In a new buffer, in verilog mode, type
-the code included below.
-
-If you have bugs with the AUTO functions, please CC the AUTOAUTHOR
-Wilson Snyder (wsnyder@wsnyder.org or wsnyder@world.std.com)
-
-Given those lines, I expected [[Fill in here]] to happen;
-but instead, [[Fill in here]] happens!.
-
-== The code: =="))))
-
-;; Local Variables:
-;; checkdoc-permit-comma-termination-flag:t
-;; checkdoc-force-docstrings-flag:nil
-;; End:
-
-;;; verilog-mode.el ends here
diff --git a/xemacs-packages/lisp/prog-modes/vrml-mode.el b/xemacs-packages/lisp/prog-modes/vrml-mode.el
deleted file mode 100644
index d0d3ee0d..00000000
--- a/xemacs-packages/lisp/prog-modes/vrml-mode.el
+++ /dev/null
@@ -1,787 +0,0 @@
-;;; vrml-mode.el --- major mode for editing VRML (.wrl) files
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-;; Copyright (C) 1996 Ben Wing.
-
-;; Author: Ben Wing <ben@xemacs.org>
-;; Keywords: languages vrml modes
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; Mostly bastardized from tcl.el.
-
-;; HOW TO INSTALL:
-;; Put the following forms in your .emacs to enable autoloading of VRML
-;; mode, and auto-recognition of ".wrl" files.
-;;
-;;   (autoload 'vrml-mode "vrml" "VRML mode." t)
-;;   (setq auto-mode-alist (append '(("\\.wrl\\'" . vrml-mode))
-;;				   auto-mode-alist))
-;;
-
-;;; Code:
-
-;;
-;; User variables.
-;;
-
-(defgroup vrml nil
-  "Major mode for editing VRML (.wrl) files."
-  :group 'languages)
-
-
-(defcustom vrml-indent-level 3
-  "*Indentation of VRML statements with respect to containing block."
-  :type 'integer
-  :group 'vrml)
-
-(defcustom vrml-auto-newline nil
-  "*Non-nil means automatically newline before and after braces
-inserted in VRML code."
-  :type 'boolean
-  :group 'vrml)
-
-(defcustom vrml-tab-always-indent t
-  "*Control effect of TAB key.
-If t (the default), always indent current line.
-If nil and point is not in the indentation area at the beginning of
-the line, a TAB is inserted.
-Other values cause the first possible action from the following list
-to take place:
-
-  1. Move from beginning of line to correct indentation.
-  2. Delete an empty comment.
-  3. Move forward to start of comment, indenting if necessary.
-  4. Move forward to end of line, indenting if necessary.
-  5. Create an empty comment.
-  6. Move backward to start of comment, indenting if necessary."
-  :type '(choice (const :tag "on" t)
-		 (const :tag "off" nil)
-		 (sexp :format "%t\n" :tag "The Works" other))
-  :group 'vrml)
-
-(defcustom vrml-use-hairy-comment-detector t
-  "*If not `nil', then the more complicated, but slower, comment
-detecting function is used."
-  :type 'boolean
-  :group 'vrml)
-
-(defvar vrml-mode-abbrev-table nil
-  "Abbrev table used while in VRML mode.")
-(define-abbrev-table 'vrml-mode-abbrev-table ())
-
-(defvar vrml-mode-map ()
-  "Keymap used in VRML mode.")
-(if (null vrml-mode-map)
-    (progn
-      (setq vrml-mode-map (make-sparse-keymap))
-      (set-keymap-name vrml-mode-map 'vrml-mode-map)
-      (define-key vrml-mode-map "{" 'vrml-electric-brace)
-      (define-key vrml-mode-map "}" 'vrml-electric-brace)
-      (define-key vrml-mode-map "\e\C-q" 'indent-vrml-exp)
-      (define-key vrml-mode-map "\t" 'vrml-indent-command)
-      (define-key vrml-mode-map "\M-;" 'vrml-indent-for-comment)
-      ))
-
-(defvar vrml-mode-syntax-table nil
-  "Syntax table in use in vrml-mode buffers.")
-
-(if vrml-mode-syntax-table
-    ()
-  (setq vrml-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\n ">" vrml-mode-syntax-table)
-  (modify-syntax-entry ?\f ">" vrml-mode-syntax-table)
-  (modify-syntax-entry ?\# "<" vrml-mode-syntax-table)
-  (modify-syntax-entry ?\\ "\\" vrml-mode-syntax-table)
-  (modify-syntax-entry ?%  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?@  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?&  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?*  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?-  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?:  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?!  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?$  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?/  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?~  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?<  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?=  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?>  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?|  "_" vrml-mode-syntax-table)
-  (modify-syntax-entry ?+ "." vrml-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" vrml-mode-syntax-table))
-
-(defcustom vrml-mode-hook nil
-  "Hook run on entry to VRML mode."
-  :type 'hook
-  :group 'vrml)
-
-(defvar vrml-keyword-list
-  '(
-    ; shape nodes:
-    "AsciiText" "Cone" "Cube" "Cylinder" "IndexedFaceSet" "IndexedLineSet"
-    "PointSet" "Sphere"
-    ; geometry and material nodes:
-    "Coordinate3" "FontStyle" "Info" "LOD" "Material" "MaterialBinding"
-    "Normal" "NormalBinding" "Texture2" "Texture2Transform"
-    "TextureCoordinate2" "ShapeHints"
-    ; transformation nodes:
-    "MatrixTransform" "Rotation" "Scale" "Transform" "Translation"
-    ;camera nodes:
-    "OrthographicCamera" "PerspectiveCamera"
-    ;lighting nodes:
-    "DirectionalLight" "PointLight" "SpotLight"
-    ;group nodes:
-    "Group" "Separator" "Switch" "TransformSeparator" "WWWAnchor"
-    ;other:
-    "WWWInline"
-    ;new VRML 2.0 nodes (#### not yet classified)
-    "Anchor" "Appearance" "AudioClip" "Background" "Billboard" "Box"
-    "Collision" "Color" "ColorInterpolator" "Coordinate"
-    "CoordinateInterpolator" "CylinderSensor" "DiskSensor" "ElevationGrid"
-    "Extrusion" "Fog" "FontStyle" "ImageTexture" "Inline" "MovieTexture"
-    "NavigationInfo" "NormalInterpolator" "OrientationInterpolator"
-    "PixelTexture" "PlaneSensor" "PositionInterpolator" "ProximitySensor"
-    "ScalarInterpolator" "Script" "Shape" "Sound" "SphereSensor" "Text"
-    "TextureTransform" "TextureCoordinate" "TimeSensor" "TouchSensor"
-    "Viewpoint" "VisibilitySensor" "WorldInfo"
-    ;VRML 2.0 node fields
-    "eventIn" "eventOut" "field" "exposedField"
-    ;misc. VRML 2.0 keywords (DEF, PROTO, EXTERNPROTO handled below)
-    "USE" "ROUTE" "TO" "IS" "TRUE" "FALSE" "NULL"
-))
-
-(defconst vrml-font-lock-keywords
-  (list
-   ;; Names of functions (and other "defining things").
-   (list "\\(DEF\\|PROTO\\|EXTERNPROTO\\)[ \t\n]+\\([^ \t\n]+\\)"
-	 2 'font-lock-function-name-face)
-
-   ;; Keywords.  Only recognized if surrounded by whitespace.
-   ;; FIXME consider using "not word or symbol", not
-   ;; "whitespace".
-   (cons (concat "\\(\\s-\\|^\\)\\("
-		 ;; FIXME Use regexp-quote? 
-		 (mapconcat 'identity vrml-keyword-list "\\|")
-		 "\\)\\(\\s-\\|$\\)")
-	 2)
-   )
-  "Keywords to highlight for VRML.  See variable `font-lock-keywords'.")
-
-;;;###autoload
-(defun vrml-mode ()
-  "Major mode for editing VRML code.
-Expression and list commands understand all VRML brackets.
-Tab indents for VRML code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-
-Variables controlling indentation style:
-  vrml-indent-level
-    Indentation of VRML statements within surrounding block.
-
-Variables controlling user interaction with mode (see variable
-documentation for details):
-  vrml-tab-always-indent
-    Controls action of TAB key.
-  vrml-auto-newline
-    Non-nil means automatically newline before and after braces
-    inserted in VRML code.
-
-Turning on VRML mode calls the value of the variable `vrml-mode-hook'
-with no args, if that value is non-nil.  Read the documentation for
-`vrml-mode-hook' to see what kinds of interesting hook functions
-already exist.
-
-Commands:
-\\{vrml-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map vrml-mode-map)
-  (setq major-mode 'vrml-mode)
-  (setq mode-name "VRML")
-  (setq local-abbrev-table vrml-mode-abbrev-table)
-  (set-syntax-table vrml-mode-syntax-table)
-
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'paragraph-separate)
-  (if (fboundp 'move-to-left-margin)
-      (progn
-	;; In FSF Emacs 19.29 / XEmacs 19.14, you aren't supposed to
-	;; start these with a ^.
-	(setq paragraph-start "$\\|")
-	(setq paragraph-separate paragraph-start))
-    (setq paragraph-start (concat "^$\\|" page-delimiter))
-    (setq paragraph-separate paragraph-start))
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'vrml-do-fill-paragraph)
-
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'vrml-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+ *")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp "[^\n\^M]")
-  (make-local-variable 'outline-level)
-  (setq outline-level 'vrml-outline-level)
-
-  (make-local-variable 'font-lock-keywords)
-  (setq font-lock-keywords vrml-font-lock-keywords)
-
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-
-  (make-local-variable 'defun-prompt-regexp)
-  (setq defun-prompt-regexp "^[^ \t\n#}][^\n}]+}*[ \t]+")
-
-  ;; Settings for new dabbrev code.
-  (make-local-variable 'dabbrev-case-fold-search)
-  (setq dabbrev-case-fold-search nil)
-  (make-local-variable 'dabbrev-case-replace)
-  (setq dabbrev-case-replace nil)
-  (make-local-variable 'dabbrev-abbrev-skip-leading-regexp)
-  (setq dabbrev-abbrev-skip-leading-regexp "[$!]")
-  (make-local-variable 'dabbrev-abbrev-char-regexp)
-  (setq dabbrev-abbrev-char-regexp "\\sw\\|\\s_")
-
-  (run-hooks 'vrml-mode-hook))
-
-;; This is used for closing braces.  If vrml-auto-newline is set, can
-;; insert a newline both before and after the brace, depending on
-;; context.  FIXME should this be configurable?  Does anyone use this?
-(defun vrml-electric-brace (arg)
-  "Insert character and correct line's indentation."
-  (interactive "p")
-  ;; If auto-newlining and there is stuff on the same line, insert a
-  ;; newline first.
-  (if vrml-auto-newline
-      (progn
-	(if (save-excursion
-	      (skip-chars-backward " \t")
-	      (bolp))
-	    ()
-	  (vrml-indent-line)
-	  (newline))
-	;; In auto-newline case, must insert a newline after each
-	;; brace.  So an explicit loop is needed.
-	(while (> arg 0)
-	  (insert last-command-char)
-	  (vrml-indent-line)
-	  (newline)
-	  (setq arg (1- arg))))
-    (self-insert-command arg))
-  (vrml-indent-line))
-
-
-
-(defun vrml-indent-command (&optional arg)
-  "Indent current line as VRML code, or in some cases insert a tab character.
-If vrml-tab-always-indent is t (the default), always indent current line.
-If vrml-tab-always-indent is nil and point is not in the indentation
-area at the beginning of the line, a TAB is inserted.
-Other values of vrml-tab-always-indent cause the first possible action
-from the following list to take place:
-
-  1. Move from beginning of line to correct indentation.
-  2. Delete an empty comment.
-  3. Move forward to start of comment, indenting if necessary.
-  4. Move forward to end of line, indenting if necessary.
-  5. Create an empty comment.
-  6. Move backward to start of comment, indenting if necessary."
-  (interactive "p")
-  (cond
-   ((not vrml-tab-always-indent)
-    ;; Indent if in indentation area, otherwise insert TAB.
-    (if (<= (current-column) (current-indentation))
-	(vrml-indent-line)
-      (self-insert-command arg)))
-   ((eq vrml-tab-always-indent t)
-    ;; Always indent.
-    (vrml-indent-line))
-   (t
-    ;; "Perl-mode" style TAB command.
-    (let* ((ipoint (point))
-	   (eolpoint (progn
-		       (end-of-line)
-		       (point)))
-	   (comment-p (vrml-in-comment)))
-      (cond
-       ((= ipoint (save-excursion
-		    (beginning-of-line)
-		    (point)))
-	(beginning-of-line)
-	(vrml-indent-line)
-	;; If indenting didn't leave us in column 0, go to the
-	;; indentation.  Otherwise leave point at end of line.  This
-	;; is a hack.
-	(if (= (point) (save-excursion
-			 (beginning-of-line)
-			 (point)))
-	    (end-of-line)
-	  (back-to-indentation)))
-       ((and comment-p (looking-at "[ \t]*$"))
-	;; Empty comment, so delete it.  We also delete any ";"
-	;; characters at the end of the line.  I think this is
-	;; friendlier, but I don't know how other people will feel.
-	(backward-char)
-	(skip-chars-backward " \t;")
-	(delete-region (point) eolpoint))
-       ((and comment-p (< ipoint (point)))
-	;; Before comment, so skip to it.
-	(vrml-indent-line)
-	(indent-for-comment))
-       ((/= ipoint eolpoint)
-	;; Go to end of line (since we're not there yet).
-	(goto-char eolpoint)
-	(vrml-indent-line))
-       ((not comment-p)
-	(vrml-indent-line)
-	(vrml-indent-for-comment))
-       (t
-	;; Go to start of comment.  We don't leave point where it is
-	;; because we want to skip comment-start-skip.
-	(vrml-indent-line)
-	(indent-for-comment)))))))
-
-(defun vrml-indent-line ()
-  "Indent current line as VRML code.
-Return the amount the indentation changed by."
-  (let ((indent (calculate-vrml-indent nil))
-	beg shift-amt
-	(case-fold-search nil)
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil)
-	   (setq indent (current-indentation)))
-	  (t
-	   (skip-chars-forward " \t")
-	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((= (following-char) ?})
-		  (setq indent (- indent vrml-indent-level)))
-		 ((= (following-char) ?\])
-		  (setq indent (- indent 1))))))
-    (skip-chars-forward " \t")
-    (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))
-
-(defun calculate-vrml-indent (&optional parse-start)
-  "Return appropriate indentation for current line as VRML code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
-  (save-excursion
-    (beginning-of-line)
-    (let* ((indent-point (point))
-	   (case-fold-search nil)
-	   state
-	   containing-sexp
-	   found-next-line)
-      (if parse-start
-	  (goto-char parse-start)
-	(beginning-of-defun))
-      (while (< (point) indent-point)
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-	(setq containing-sexp (car (cdr state))))
-      (cond ((or (nth 3 state) (nth 4 state))
-	     ;; Inside comment or string.  Return nil or t if should
-	     ;; not change this line
-	     (nth 4 state))
-	    ((null containing-sexp)
-	     ;; Line is at top level.
-	     0)
-	    (t
-	     (goto-char containing-sexp)
-	     (let* ((expr-start (point)))
-	       ;; Find the first statement in the block and indent
-	       ;; like it.  The first statement in the block might be
-	       ;; on the same line, so what we do is skip all
-	       ;; "virtually blank" lines, looking for a non-blank
-	       ;; one.  A line is virtually blank if it only contains
-	       ;; a comment and whitespace.  We do it this funky way
-	       ;; because we want to know if we've found a statement
-	       ;; on some line _after_ the line holding the sexp
-	       ;; opener.
-	       (goto-char containing-sexp)
-	       (forward-char)
-	       (if (and (< (point) indent-point)
-			(looking-at "[ \t]*\\(#.*\\)?$"))
-		   (progn
-		     (forward-line)
-		     (while (and (< (point) indent-point)
-				 (looking-at "[ \t]*\\(#.*\\)?$"))
-		       (setq found-next-line t)
-		       (forward-line))))
-	       (if (not (or (= (char-after containing-sexp) ?{)
-			    (and (= (char-after containing-sexp) ?\[)
-				 (save-excursion
-				   (goto-char containing-sexp)
-				   (skip-chars-backward " \t\n")
-				   (forward-char -8)
-				   (looking-at "children")))))
-		   (progn
-		     ;; Line is continuation line, or the sexp opener
-		     ;; is not a curly brace, or we are looking at
-		     ;; an `expr' expression (which must be split
-		     ;; specially).  So indentation is column of first
-		     ;; good spot after sexp opener.  If there is no
-		     ;; nonempty line before the indentation point, we
-		     ;; use the column of the character after the sexp
-		     ;; opener.
-		     (if (>= (point) indent-point)
-			 (progn
-			   (goto-char containing-sexp)
-			   (forward-char))
-		       (skip-chars-forward " \t"))
-		     (current-column))
-		 ;; After a curly brace, and not a continuation line.
-		 ;; So take indentation from first good line after
-		 ;; start of block, unless that line is on the same
-		 ;; line as the opening brace.  In this case use the
-		 ;; indentation of the opening brace's line, plus
-		 ;; another indent step.  If we are in the body part
-		 ;; of an "if" or "while" then the indentation is
-		 ;; taken from the line holding the start of the
-		 ;; statement.
-		 (if (and (< (point) indent-point)
-			  found-next-line)
-		     (current-indentation)
-		   (if t ; commands-p
-		       (goto-char expr-start)
-		     (goto-char containing-sexp))
-		   (+ (current-indentation) vrml-indent-level)))))))))
-
-
-
-(defun indent-vrml-exp ()
-  "Indent each line of the VRML grouping following point."
-  (interactive)
-  (let ((indent-stack (list nil))
-	(contain-stack (list (point)))
-	(case-fold-search nil)
-	outer-loop-done inner-loop-done state ostate
-	this-indent last-sexp
-	(next-depth 0)
-	last-depth)
-    (save-excursion
-      (forward-sexp 1))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (and (not (eobp)) (not outer-loop-done))
-	(setq last-depth next-depth)
-	;; Compute how depth changes over this line
-	;; plus enough other lines to get to one that
-	;; does not end inside a comment or string.
-	;; Meanwhile, do appropriate indentation on comment lines.
-	(setq inner-loop-done nil)
-	(while (and (not inner-loop-done)
-		    (not (and (eobp) (setq outer-loop-done t))))
-	  (setq ostate state)
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  (if (and (car (cdr (cdr state)))
-		   (>= (car (cdr (cdr state))) 0))
-	      (setq last-sexp (car (cdr (cdr state)))))
-	  (if (or (nth 4 ostate))
-	      (vrml-indent-line))
-	  (if (or (nth 3 state))
-	      (forward-line 1)
-	    (setq inner-loop-done t)))
-	(if (<= next-depth 0)
-	    (setq outer-loop-done t))
-	(if outer-loop-done
-	    nil
-	  ;; If this line had ..))) (((.. in it, pop out of the levels
-	  ;; that ended anywhere in this line, even if the final depth
-	  ;; doesn't indicate that they ended.
-	  (while (> last-depth (nth 6 state))
-	    (setq indent-stack (cdr indent-stack)
-		  contain-stack (cdr contain-stack)
-		  last-depth (1- last-depth)))
-	  (if (/= last-depth next-depth)
-	      (setq last-sexp nil))
-	  ;; Add levels for any parens that were started in this line.
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  contain-stack (cons nil contain-stack)
-		  last-depth (1+ last-depth)))
-	  (if (null (car contain-stack))
-	      (setcar contain-stack 
-		      (or (car (cdr state))
-			  (save-excursion
-			    (forward-sexp -1)
-			    (point)))))
-	  (forward-line 1)
-	  (skip-chars-forward " \t")
-	  (if (eolp)
-	      nil
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		;; Line is on an existing nesting level.
-		(setq this-indent (car indent-stack))
-	      ;; Just started a new nesting level.
-	      ;; Compute the standard indent for this level.
-	      (let ((val (calculate-vrml-indent
-			  (if (car indent-stack)
-			      (- (car indent-stack))))))
-		(setcar indent-stack
-			(setq this-indent val))
-		))
-	    (cond ((not (numberp this-indent)))
-		  ((= (following-char) ?})
-		   (setq this-indent (- this-indent vrml-indent-level)))
-		  ((= (following-char) ?\])
-		   (setq this-indent (- this-indent 1))))
-	    ;; Put chosen indentation into effect.
-	    (or (null this-indent)
-		(= (current-column) 
-		   this-indent)
-		(progn
-		  (delete-region (point) (progn (beginning-of-line) (point)))
-		  (indent-to 
-		   this-indent))))))))
-  )
-
-;;
-;; Auto-fill support.
-;;
-
-(defun vrml-real-command-p ()
-  "Return nil if point is not at the beginning of a command.
-A command is the first word on an otherwise empty line, or the
-first word following an opening brace."
-  (save-excursion
-    (skip-chars-backward " \t")
-    (cond
-     ((bobp) t)
-     ((bolp)
-      (backward-char)
-      ;; Note -- continued comments are not supported here.  I
-      ;; consider those to be a wart on the language.
-      (not (eq ?\\ (preceding-char))))
-     (t
-      (memq (preceding-char) '(?{))))))
-
-;; FIXME doesn't actually return t.  See last case.
-(defun vrml-real-comment-p ()
-  "Return t if point is just after the `#' beginning a real comment.
-Does not check to see if previous char is actually `#'.
-A real comment is either at the beginning of the buffer,
-preceded only by whitespace on the line, or has a preceding
-semicolon, opening brace, or opening bracket on the same line."
-  (save-excursion
-    (backward-char)
-    (vrml-real-command-p)))
-
-(defun vrml-hairy-scan-for-comment (state end always-stop)
-  "Determine if point is in a comment.
-Returns a list of the form `(FLAG . STATE)'.  STATE can be used
-as input to future invocations.  FLAG is nil if not in comment,
-t otherwise.  If in comment, leaves point at beginning of comment.
-See also `vrml-simple-scan-for-comment', a simpler version that is
-often right."
-  (let ((bol (save-excursion
-	       (goto-char end)
-	       (beginning-of-line)
-	       (point)))
-	real-comment
-	last-cstart)
-    (while (and (not last-cstart) (< (point) end))
-      (setq real-comment nil)		;In case we've looped around and it is
-                                        ;set.
-      (setq state (parse-partial-sexp (point) end nil nil state t))
-      (if (nth 4 state)
-	  (progn
-	    ;; If ALWAYS-STOP is set, stop even if we don't have a
-	    ;; real comment, or if the comment isn't on the same line
-	    ;; as the end.
-	    (if always-stop (setq last-cstart (point)))
-	    ;; If we have a real comment, then set the comment
-	    ;; starting point if we are on the same line as the ending
-	    ;; location.
-	    (setq real-comment (vrml-real-comment-p))
-	    (if real-comment
-		(progn
-		  (and (> (point) bol) (setq last-cstart (point)))
-		  ;; NOTE Emacs 19 has a misfeature whereby calling
-		  ;; parse-partial-sexp with COMMENTSTOP set and with
-		  ;; an initial list that says point is in a comment
-		  ;; will cause an immediate return.  So we must skip
-		  ;; over the comment ourselves.
-		  (beginning-of-line 2)))
-	    ;; Frob the state to make it look like we aren't in a
-	    ;; comment.
-	    (setcar (nthcdr 4 state) nil))))
-    (and last-cstart
-	 (goto-char last-cstart))
-    (cons real-comment state)))
-
-(defun vrml-hairy-in-comment ()
-  "Return t if point is in a comment, and leave point at beginning
-of comment."
-  (let ((save (point)))
-    (beginning-of-defun)
-    (car (vrml-hairy-scan-for-comment nil save nil))))
-
-(defun vrml-simple-in-comment ()
-  "Return t if point is in comment, and leave point at beginning
-of comment.  This is faster than `vrml-hairy-in-comment', but is
-correct less often."
-  (let ((save (point))
-	comment)
-    (beginning-of-line)
-    (while (and (< (point) save) (not comment))
-      (search-forward "#" save 'move)
-      (setq comment (vrml-real-comment-p)))
-    comment))
-
-(defun vrml-in-comment ()
-  "Return t if point is in comment, and leave point at beginning
-of comment."
-  (if vrml-use-hairy-comment-detector
-      (vrml-hairy-in-comment)
-    (vrml-simple-in-comment)))
-
-(defun vrml-do-fill-paragraph (ignore)
-  "fill-paragraph function for VRML mode.  Only fills in a comment."
-  (let (in-comment col where)
-    (save-excursion
-      (end-of-line)
-      (setq in-comment (vrml-in-comment))
-      (if in-comment
-	  (progn
-	    (setq where (1+ (point)))
-	    (setq col (1- (current-column))))))
-    (and in-comment
-	 (save-excursion
-	   (back-to-indentation)
-	   (= col (current-column)))
-	 ;; In a comment.  Set the fill prefix, and find the paragraph
-	 ;; boundaries by searching for lines that look like
-	 ;; comment-only lines.
-	 (let ((fill-prefix (buffer-substring (progn
-						(beginning-of-line)
-						(point))
-					      where))
-	       p-start p-end)
-	   ;; Search backwards.
-	   (save-excursion
-	     (while (looking-at "^[ \t]*#")
-	       (forward-line -1))
-	     (forward-line)
-	     (setq p-start (point)))
-
-	   ;; Search forwards.
-	   (save-excursion
-	     (while (looking-at "^[ \t]*#")
-	       (forward-line))
-	     (setq p-end (point)))
-
-	   ;; Narrow and do the fill.
-	   (save-restriction
-	     (narrow-to-region p-start p-end)
-	     (fill-paragraph ignore)))))
-  t)
-
-(defun vrml-do-auto-fill ()
-  "Auto-fill function for VRML mode.  Only auto-fills in a comment."
-  (if (> (current-column) fill-column)
-      (let ((fill-prefix "# ")
-	    in-comment col)
-	(save-excursion
-	  (setq in-comment (vrml-in-comment))
-	  (if in-comment
-	      (setq col (1- (current-column)))))
-	(if in-comment
-	    (progn
-	      (do-auto-fill)
-	      (save-excursion
-		(back-to-indentation)
-		(delete-region (point) (save-excursion
-					 (beginning-of-line)
-					 (point)))
-		(indent-to-column col)))))))
-
-(defun vrml-indent-for-comment ()
-  "Indent this line's comment to comment column, or insert an empty comment.
-Is smart about syntax of VRML comments.
-Parts of this were taken from indent-for-comment (simple.el)."
-  (interactive "*")
-  (end-of-line)
-  (or (vrml-in-comment)
-      (progn
-	;; Not in a comment, so we have to insert one.  Create an
-	;; empty comment (since there isn't one on this line).
-	(skip-chars-backward " \t")
-	(let ((eolpoint (point)))
-	  (beginning-of-line)
-	  (if (/= (point) eolpoint)
-	      (progn
-		(goto-char eolpoint)
-		(insert
-		 "# ")
-		(backward-char))))))
-  ;; Point is just after the "#" starting a comment.  Move it as
-  ;; appropriate.
-  (let* ((indent (funcall comment-indent-function))
-	 (begpos (progn
-		   (backward-char)
-		   (point))))
-    (if (/= begpos indent)
-	(progn
-	  (skip-chars-backward " \t" (save-excursion
-				       (beginning-of-line)
-				       (point)))
-	  (delete-region (point) begpos)
-	  (indent-to indent)))
-    (looking-at comment-start-skip)	; Always true.
-    (goto-char (match-end 0))
-    ;; I don't like the effect of the next two.
-    ;;(skip-chars-backward " \t" (match-beginning 0))
-    ;;(skip-chars-backward "^ \t" (match-beginning 0))
-    ))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.wrl\\'" . vrml-mode))
-
-;;; vrml-mode.el ends here
diff --git a/xemacs-packages/lisp/python-modes/ChangeLog b/xemacs-packages/lisp/python-modes/ChangeLog
deleted file mode 100644
index 0287d201..00000000
--- a/xemacs-packages/lisp/python-modes/ChangeLog
+++ /dev/null
@@ -1,75 +0,0 @@
-2005-12-19  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.07 released.
-
-2005-12-10  Ville Skyttä  <scop@xemacs.org>
-
-	* pydoc.el (pydoc-initialize): Make python search for
-	pydoc_lisp.py* from the package data dir.
-
-	* Makefile (DATA_FILES): New, add pydoc_lisp.py.
-	(DATA_DEST): New, set to $(PACKAGE).
-	(EXTRA_SOURCES): Remove pydoc_lisp.py.
-
-2004-04-13  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.06 released.
-
-2004-03-25  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.05 released.
-
-	* Makefile (REQUIRES): edit-utils and fsf-compat are necessary
-	to build the package after the update to the current version of
-	python-mode.el. 
-
-2004-02-16  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.04 released.
-
-2003-10-31  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.03 released.
-
-2003-03-09  Ben Wing  <ben@xemacs.org>
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-
-2003-01-13  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.02 released.
-
-2003-01-06  Ville Skyttä  <scop@xemacs.org>
-
-	* python-mode.el: Make auto-mode and interpreter-mode-alist
-	entries autoload-only.
-
-2002-11-29  Ben Wing  <ben@xemacs.org>
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15  Ville Skyttä  <scop@xemacs.org>
-
-	* Makefile (srckit): Remove.
-
-2002-10-07  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.01 released.
-
-2002-09-30  Ville Skyttä  <scop@xemacs.org>
-
-	* python-mode.el: Add autoloaded auto-mode-alist and
-	interpreter-mode-alist associations.
-
-2002-09-25  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.00 released.
-
-2002-09-18  Ville Skyttä  <scop@xemacs.org>
-
-	* Package created, moved pydoc and python-mode from the
-	prog-modes package here.
-
diff --git a/xemacs-packages/lisp/python-modes/_pkg.el b/xemacs-packages/lisp/python-modes/_pkg.el
deleted file mode 100644
index 6dc79bf4..00000000
--- a/xemacs-packages/lisp/python-modes/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'python-modes
-		 :version 1.07
-          :author-version "No-Upstream-Ver"
-		 :type 'single-file)
diff --git a/xemacs-packages/lisp/python-modes/auto-autoloads.el b/xemacs-packages/lisp/python-modes/auto-autoloads.el
deleted file mode 100644
index 1d81822f..00000000
--- a/xemacs-packages/lisp/python-modes/auto-autoloads.el
+++ /dev/null
@@ -1,117 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'python-modes-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "python-modes/_pkg.el")
-
-(package-provide 'python-modes :version 1.07 :author-version "No-Upstream-Ver" :type 'single-file)
-
-;;;***
-
-;;;### (autoloads (pydoc-xrefs pydoc-topics pydoc-packages pydoc-modules pydoc-keywords pydoc-help pydoc-apropos pydoc-commands) "pydoc" "python-modes/pydoc.el")
-
-(global-set-key "è" 'pydoc-commands)
-
-(autoload 'pydoc-commands "pydoc" "\
-Display a menu of commands for interacting with the pydoc Python documentation viewer library.
-With optional prefix arg INIT-FLAG, reinitializes the pydoc completion
-tables which includes the list of available Python modules.
-See the documentation for `pydoc-menu-help' for a description of the
-available commands." t nil)
-
-(autoload 'pydoc-apropos "pydoc" "\
-Call the Python module apropos function with optional ARGUMENT and display the output.
-ARGUMENT defaults to an identifier near point.
-The apropos function finds matches for ARGUMENT within the first line of
-module or package doc strings." t nil)
-
-(autoload 'pydoc-help "pydoc" "\
-Call the Python help function with optional ARGUMENT and display the output.
-ARGUMENT defaults to an identifier near point.
-ARGUMENT is resolved as a name in any present Python namespace; use
-single 'quotes' to send ARGUMENT as a Python literal string." t nil)
-
-(autoload 'pydoc-keywords "pydoc" "\
-Prompt with completion for a Python keyword ARGUMENT and display its documentation." t nil)
-
-(autoload 'pydoc-modules "pydoc" "\
-Prompt with completion for a Python module/package ARGUMENT and display its documentation." t nil)
-
-(autoload 'pydoc-packages "pydoc" "\
-Prompt with completion for a Python package ARGUMENT and display its documentation." t nil)
-
-(autoload 'pydoc-topics "pydoc" "\
-Prompt with completion for a Python topic ARGUMENT and display its documentation." t nil)
-
-(autoload 'pydoc-xrefs "pydoc" "\
-Display xref at point or prompt user with completion and display chosen xref.
-Xrefs are terms which follow the `pydoc-xrefs-prefix' regular expression." t nil)
-
-;;;***
-
-;;;### (autoloads (py-shell python-mode) "python-mode" "python-modes/python-mode.el")
-
-(autoload 'python-mode "python-mode" "\
-Major mode for editing Python files.
-To submit a problem report, enter `\\[py-submit-bug-report]' from a
-`python-mode' buffer.  Do `\\[py-describe-mode]' for detailed
-documentation.  To see what version of `python-mode' you are running,
-enter `\\[py-version]'.
-
-This mode knows about Python indentation, tokens, comments and
-continuation lines.  Paragraphs are separated by blank lines only.
-
-COMMANDS
-\\{py-mode-map}
-VARIABLES
-
-py-indent-offset		indentation increment
-py-block-comment-prefix		comment string used by `comment-region'
-py-python-command		shell command to invoke Python interpreter
-py-temp-directory		directory used for temp files (if needed)
-py-beep-if-tab-change		ring the bell if `tab-width' is changed" t nil)
-
-(let ((modes '(("jpython" . jpython-mode) ("jython" . jpython-mode) ("python" . python-mode)))) (while modes (when (not (assoc (car modes) interpreter-mode-alist)) (push (car modes) interpreter-mode-alist)) (setq modes (cdr modes))))
-
-(when (not (or (rassq 'python-mode auto-mode-alist) (rassq 'jpython-mode auto-mode-alist))) (push '("\\.py$" . python-mode) auto-mode-alist))
-
-(autoload 'py-shell "python-mode" "\
-Start an interactive Python interpreter in another window.
-This is like Shell mode, except that Python is running in the window
-instead of a shell.  See the `Interactive Shell' and `Shell Mode'
-sections of the Emacs manual for details, especially for the key
-bindings active in the `*Python*' buffer.
-
-With optional \\[universal-argument], the user is prompted for the
-flags to pass to the Python interpreter.  This has no effect when this
-command is used to switch to an existing process, only when a new
-process is started.  If you use this, you will probably want to ensure
-that the current arguments are retained (they will be included in the
-prompt).  This argument is ignored when this function is called
-programmatically, or when running in Emacs 19.34 or older.
-
-Note: You can toggle between using the CPython interpreter and the
-JPython interpreter by hitting \\[py-toggle-shells].  This toggles
-buffer local variables which control whether all your subshell
-interactions happen to the `*JPython*' or `*Python*' buffers (the
-latter is the name used for the CPython buffer).
-
-Warning: Don't use an interactive Python if you change sys.ps1 or
-sys.ps2 from their default values, or if you're running code that
-prints `>>> ' or `... ' at the start of a line.  `python-mode' can't
-distinguish your output from Python's output, and assumes that `>>> '
-at the start of a line is a prompt from Python.  Similarly, the Emacs
-Shell mode code assumes that both `>>> ' and `... ' at the start of a
-line are Python prompts.  Bad things can happen if you fool either
-mode.
-
-Warning:  If you do any editing *in* the process buffer *while* the
-buffer is accepting output from Python, do NOT attempt to `undo' the
-changes.  Some of the output (nowhere near the parts you changed!) may
-be lost if you do.  This appears to be an Emacs bug, an unfortunate
-interaction between undo and process filters; the same problem exists in
-non-Python process buffers using the default (Emacs-supplied) process
-filter." t nil)
-
-;;;***
-
-(provide 'python-modes-autoloads)
diff --git a/xemacs-packages/lisp/python-modes/custom-load.el b/xemacs-packages/lisp/python-modes/custom-load.el
deleted file mode 100644
index 08870f55..00000000
--- a/xemacs-packages/lisp/python-modes/custom-load.el
+++ /dev/null
@@ -1,10 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'languages '("python-mode"))
-(custom-add-loads 'python '("python-mode"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/python-modes/pydoc-el-README b/xemacs-packages/lisp/python-modes/pydoc-el-README
deleted file mode 100644
index 5196596f..00000000
--- a/xemacs-packages/lisp/python-modes/pydoc-el-README
+++ /dev/null
@@ -1,44 +0,0 @@
-# SUMMARY:      README for pydoc.el emacs interface to Python pydoc.
-#
-# AUTHOR:       Bob Weiner
-# ORG:          Deepware
-#
-# ORIG-DATE:    23-Apr-01 at 00:03:37
-# LAST-MOD:     23-Apr-01 at 00:16:15 by Bob Weiner
-#
-# Copyright (C) 2001  Bob Weiner
-# Licensed under the Python license version 2.0 or higher.
-#
-# DESCRIPTION:  
-
-pydoc.el is an Emacs/XEmacs/InfoDock interface to the Python pydoc system.
-It provides convenient integration with powerful programming editors,
-speeding both Python learning and day-to-day access of reference
-documentation while programming.
-
-For installation information, see the DESCRIPTION section in "pydoc.el".
-
-----
-
-pydoc.el adds one new global key binding, {C-c M-h} (pydoc-commands) which
-displays a menu of commands for interacting with pydoc.  It is global so
-you may examine Python documentation whenever needed, regardless of whether
-you have a Python code buffer on screen.
-
-The following commands are available, each invoked by typing the first
-character of the command name when prompted with the menu.
-
-A)propos <term>    - list modules/packages with <term> in their first line doc strings
-H)elp <term>       - display doc for name <term> or string literal '<term>'
-K)eyword <keyword> - with completion, display doc for a Python <keyword>
-M)odule <name>     - with completion, display doc for a Python module <name>
-P)ackage <name>    - with completion, display doc for a Python package <name>
-T)opic <topic>     - with completion, display Python reference doc for <topic>
-X)ref <term>       - with completion, display doc for a pydoc cross-reference
-                     within a Python reference manual section
-
-?   - show the above help
-C-g - abort from menu
-
-# DESCRIP-END.
-
diff --git a/xemacs-packages/lisp/python-modes/pydoc.el b/xemacs-packages/lisp/python-modes/pydoc.el
deleted file mode 100644
index ef3cbac7..00000000
--- a/xemacs-packages/lisp/python-modes/pydoc.el
+++ /dev/null
@@ -1,644 +0,0 @@
-;; LCD-ENTRY:    pydoc.el|Bob Weiner|bob@deepware.com|Interface to pydoc Python documentation viewer|Date|04/23/2001|01.02|www.deepware.com/pub/python
-;;
-;; FILE:         pydoc.el
-;; SUMMARY:      Interface to pydoc Python documentation viewer
-;; USAGE:        Autoloaded XEmacs Lisp Library, use {C-c M-h} to invoke
-;; KEYWORDS:     help, languages, oop, tools
-;;
-;; AUTHOR:       Bob Weiner
-;; ORG:          Deepware
-;; E-MAIL:       bob@deepware.com
-;;
-;; ORIG-DATE:    18-Apr-01 at 19:11:27
-;; LAST-MOD:     23-Apr-01 at 23:59:46 by Bob Weiner
-;;
-;; Copyright (C) 2001  Bob Weiner
-;; Licensed under the Python license version 2.0 or higher.
-;;
-;; This file is part of InfoDock, available from:
-;;   www.sourceforge.net/projects/infodock
-;;
-;; DESCRIPTION:
-;;
-;;   Globally adds key binding {C-c M-h} (pydoc-commands) which
-;;   displays a menu of commands for interacting with the pydoc Python
-;;   documentation viewer library.  See the documentation of
-;;   `pydoc-menu-help' for details on each available command.
-;;
-;;   NOTE: You *must* install the following for pydoc.el to work:
-;;
-;;     python-mode.el 4.1.1 or higher as your Python editing mode (included
-;;     in the pydoc.el distribution)
-;;
-;;     pydoc_lisp.py in your Python site-packages directory (unless
-;;       these functions are already integrated into pydoc.py)
-;;
-;;     set the environment variable PYTHONDOCS to the root directory
-;;       of your Python html documentation tree, for example:
-;;       export PYTHONDOCS=$HOME/Python-2.1/Doc/html/
-;;     and then startup your editor (otherwise, the environment variable
-;;     setting won't be inherited by the editor and some commands will not
-;;     work).
-;;
-;;   Install and byte-compile pydoc.el in one of your load-path directories
-;;   and then either set it to autoload or do a (require 'pydoc) in your
-;;   editor initialization file.  Then invoke it via the menu key binding.
-;;
-;; DESCRIP-END.
-
-;;; ************************************************************************
-;;; Other required Elisp libraries
-;;; ************************************************************************
-
-(require 'python-mode)
-
-;; Ensure that the user has a python-mode version which supports pydoc.el.
-(if (string-lessp py-version "$Revision: 1.1 $")
-    (error "(pydoc): you must upgrade from python-mode.el %s to 4.1.1 (or higher)"
-	   (if (string-match "[0-9.]+" py-version)
-	       (match-string 0 py-version) py-version)))
-
-(provide 'pydoc)
-
-;;; ************************************************************************
-;;; Public variables
-;;; ************************************************************************
-
-(defvar pydoc-version "01.01"
-  "Release version of the Emacs Lisp interface to pydoc.")
-
-;; Provide easy access to (pydoc-commands) everywhere since the user may want
-;; to reference Python doc when in a Python help buffer, a documentation file,
-;; etc.  Use {C-c M-h} instead of {C-c C-h} for this next binding since
-;; {C-c C-h} is an important key in InfoDock's outline-minor-mode which is
-;; often used under python-mode, so this avoids conflicts.
-
-;;;###autoload
-(global-set-key "\C-c\M-h" 'pydoc-commands)
-
-(defvar pydoc-buffer-prefix "Py: "
-  "Prefix string attached to all pydoc display buffers.")
-
-(defvar pydoc-xrefs-prefix "^Related help topics:"
-  "Prefix regexp output before comma separated pydoc help section names.")
-
-;;; ************************************************************************
-;;; Private variables
-;;; ************************************************************************
-
-(defvar pydoc-cmd-alist
-  '(("A)propos"         . pydoc-apropos)
-    ("H)elp"            . pydoc-help)
-    ("K)eyword"         . pydoc-keywords)
-    ("M)odule"          . pydoc-modules)
-    ("P)ackage"         . pydoc-packages)
-    ("T)opic"           . pydoc-topics)
-    ("X)ref"            . pydoc-xrefs))
-  "Association list of (HELP-CMD-PROMPT . CMD) elements for pydoc commands.")
-
-(defvar pydoc-alist nil
-  "Association list of (list-name . alist) elements used to build prompt completion tables.")
-
-(defvar pydoc-menu-mode-map nil
-  "Keymap containing pydoc-menu commands.")
-
-(defvar pydoc-menu-special-keys '(?\C-g ?? ?\C-i ?\C-j ?\C-m ?\ ))
-
-(if pydoc-menu-mode-map
-    nil
-  (setq pydoc-menu-mode-map (make-keymap))
-  (suppress-keymap pydoc-menu-mode-map)
-  (define-key pydoc-menu-mode-map
-    (car (where-is-internal 'keyboard-quit)) 'pydoc-menu-enter)
-  (mapcar #'(lambda (key)
-	      (define-key pydoc-menu-mode-map (char-to-string key) 'pydoc-menu-enter))
-	  pydoc-menu-special-keys)
-  (let ((i 33))
-    (while (<= i 127)
-      (define-key pydoc-menu-mode-map (char-to-string i) 'pydoc-menu-enter)
-      (setq i (1+ i)))))
-
-;;; ************************************************************************
-;;; Commands
-;;; ************************************************************************
-
-;;;###autoload
-(defun pydoc-commands (&optional init-flag)
-  "Display a menu of commands for interacting with the pydoc Python documentation viewer library.
-With optional prefix arg INIT-FLAG, reinitializes the pydoc completion
-tables which includes the list of available Python modules.
-See the documentation for `pydoc-menu-help' for a description of the
-available commands."
-  (interactive "P")
-  (if (or init-flag (null pydoc-alist))
-      (pydoc-initialize))
-  (call-interactively (pydoc-select-command)))
-
-;;;###autoload
-(defun pydoc-apropos (&optional argument)
-  "Call the Python module apropos function with optional ARGUMENT and display the output.
-ARGUMENT defaults to an identifier near point.
-The apropos function finds matches for ARGUMENT within the first line of
-module or package doc strings."
-  (interactive)
-  (if (not argument)
-      (setq argument (pydoc-read-argument "Python module/package apropos: ")))
-  (pydoc-call "apropos" (format "'%s'" argument) (concat "apropos " argument)))
-
-;;;###autoload
-(defun pydoc-help (&optional argument)
-  "Call the Python help function with optional ARGUMENT and display the output.
-ARGUMENT defaults to an identifier near point.
-ARGUMENT is resolved as a name in any present Python namespace; use
-single 'quotes' to send ARGUMENT as a Python literal string."
-  (interactive)
-  (if (not argument)
-      (setq argument (pydoc-read-argument "Python help (name or 'string'): ")))
-  (pydoc-call "help" argument argument))
-
-;;;###autoload
-(defun pydoc-keywords (argument)
-  "Prompt with completion for a Python keyword ARGUMENT and display its documentation."
-  (interactive
-   (list
-    (let ((completion-ignore-case t))
-      (completing-read "Python keyword help (RET for all): "
-		       (cdr (assoc "keywords" pydoc-alist))
-		       nil t))))
-  (if (member argument '(nil ""))
-      (setq argument "keywords"))
-  (pydoc-call "help" (format "'%s'" argument) argument))
-
-;;;###autoload
-(defun pydoc-modules (argument)
-  "Prompt with completion for a Python module/package ARGUMENT and display its documentation."
-  (interactive
-   (list
-    (let ((completion-ignore-case t))
-      (completing-read "Python module/package help (RET for all): "
-		       (cdr (assoc "modules" pydoc-alist))
-		       nil t))))
-  (if (member argument '(nil ""))
-      (setq argument "modules"))
-  (if (string-match "\\`Pkg-" argument)
-      (setq argument (substring argument (match-end 0))))
-  (pydoc-call "help" (format "'%s'" argument) argument))
-
-;;;###autoload
-(defun pydoc-packages (argument)
-  "Prompt with completion for a Python package ARGUMENT and display its documentation."
-  (interactive
-   (list
-    (let ((completion-ignore-case t))
-      (completing-read "Python package help (RET for all): "
-		       (delq nil
-			     (mapcar
-			      #'(lambda (entry)
-				  (if (string-match "\\`Pkg-" entry)
-				      (list (substring entry (match-end 0)))))
-			      (mapcar 'car (cdr (assoc "modules" pydoc-alist)))))
-		       nil t))))
-  (if (member argument '(nil ""))
-      (setq argument "modules"))
-  (if (string-match "\\`Pkg-" argument)
-      (setq argument (substring argument (match-end 0))))
-  (pydoc-call "help" (format "'%s'" argument) argument))
-
-;;;###autoload
-(defun pydoc-topics (argument)
-  "Prompt with completion for a Python topic ARGUMENT and display its documentation."
-  (interactive
-   (list
-    (let ((completion-ignore-case t))
-      (completing-read "Python topic help (RET for all): "
-		       (cdr (assoc "topics" pydoc-alist))
-		       nil t))))
-  (if (member argument '(nil ""))
-      (setq argument "topics")
-    (setq argument (upcase argument)))
-  (pydoc-call "help" (format "'%s'" argument) argument))
-
-;;;###autoload
-(defun pydoc-xrefs ()
-  "Display xref at point or prompt user with completion and display chosen xref.
-Xrefs are terms which follow the `pydoc-xrefs-prefix' regular expression."
-  (interactive)
-  (cond ((save-excursion
-	   (beginning-of-line)
-	   (looking-at pydoc-xrefs-prefix))
-	 ;; On an xref line
-	 (if (>= (point) (match-end 0))
-	     ;; After prefix, within an xref
-	     (pydoc-display-xref)
-	   ;; Prompt for with completion and display xref
-	   (pydoc-display-xref
-	    (save-excursion
-	      (goto-char (match-end 0))
-	      (pydoc-choose-xref "Display xref: ")))))
-
-	;; Move to last xref line if any in buffer
-	((pydoc-xrefs-p)
-	 ;; Prompt for with completion and display xref
-	 (pydoc-display-xref
-	  (save-excursion
-	    (goto-char (match-end 0))
-	    (pydoc-choose-xref "Display xref: "))))
-
-	(t (error "(pydoc): No cross-references in this buffer"))))
-
-;;; ************************************************************************
-;;; Public functions
-;;; ************************************************************************
-
-(defun pydoc-call (func-name argument buf-name-suffix)
-  "Call the pydoc function FUNC-NAME with ARGUMENT (a string) and display in Py: BUF-NAME-SUFFIX."
-  (let ((wind-config (current-window-configuration))
-	(output-buf-name
-	 (py-execute-string
-	  (format
-	   "if not vars().has_key('%s'):\n    from pydoc import %s\n\n%s(%s)\n"
-	   func-name func-name func-name argument)))
-	(async-process (pydoc-async-output-p))
-	input-buf-name)
-    (setq input-buf-name (if async-process
-			     (buffer-name (process-buffer async-process))
-			   " *Python Command*"))
-    (if (buffer-live-p (get-buffer input-buf-name))
-	(bury-buffer input-buf-name))
-
-    ;; current vintages of python-mode.el (4.6 at least)
-    ;; no longer return a buffer [name].  We get t from the
-    ;; final kill-buffer instead.  If we see t we use try to
-    ;; guess a good buffer name.
-    (if (eq output-buf-name t)
-	(setq output-buf-name (if async-process
-				  (buffer-name (process-buffer async-process))
-				"*Python Output*")))
-
-    (if (or (null output-buf-name)
-	    ;; In earlier versions of python-mode.el, py-execute-string does
-	    ;; not return a buffer name.
-	    (not (stringp output-buf-name))
-	    (not (buffer-live-p (get-buffer output-buf-name)))
-	    (and async-process (not (pydoc-wait-for-output input-buf-name 10.0))))
-	(message "(\"%s(%s)\" finished with no output)" func-name argument)
-      (set-window-configuration wind-config)
-      (bury-buffer output-buf-name)
-      (set-buffer output-buf-name)
-      (goto-char (point-max)) ;; User may have moved point elsewhere.
-      (let ((output-end 
-	     ;; Skip any trailing Python prompt
-	     (save-excursion (beginning-of-line) (point)))
-	    (output-start (pydoc-output-start))
-	    (display-buf))
-	(if (save-excursion
-	      (goto-char (point-max))
-	      (forward-line -1)
-	      (looking-at "^NameError:"))
-	    (progn (switch-to-buffer (car (buffer-list)))
-		   (error "(pydoc): %s(%s) failed to find any matching term"
-			  func-name argument))
-	  (setq display-buf (get-buffer-create
-			     (concat pydoc-buffer-prefix buf-name-suffix)))
-	  (set-buffer display-buf)
-	  (toggle-read-only 0)
-	  (erase-buffer)
-	  (insert-buffer-substring output-buf-name output-start output-end)
-	  (goto-char (point-min))
-	  (set-buffer-modified-p nil)
-	  (message "")
-	  (help-mode)
-	  (pydoc-kill-async-output output-buf-name async-process)
-	  (pop-to-buffer display-buf))))))
-
-(defun pydoc-display-apropos-entry ()
-  "Detect module/package names in pydoc apropos buffer entries and display their code.
-Each module/package name must be at the beginning of the line
-and must be followed by a space, dash and then another space."
-  (interactive)
-  (if (string-match (concat "\\`" (regexp-quote pydoc-buffer-prefix)
-			    "apropos ")
-		    (buffer-name))
-      (save-excursion
-	(beginning-of-line)
-	(if (looking-at "\\([^][-(){}<>'`\"/*+&^%$#@!=|?,~ \t\n\r]+\\) - ")
-	    (let* ((entry (buffer-substring
-			   (match-beginning 1) (match-end 1)))
-		   (path (pydoc-pathname entry)))
-	      (if (and path (file-exists-p path))
-		  (find-file-other-window path)))))))
-
-(defun pydoc-pathname (module-identifier)
-  "Return the filename or package directory where MODULE-IDENTIFIER is defined, else nil."
-  (setq module-identifier
-	(replace-in-string module-identifier "\\."
-			   (char-to-string directory-sep-char) t))
-  (or (locate-file module-identifier (pydoc-paths-list) ".py:.pyc:.pyo:.pyd")
-      ;; May be a package directory
-      (locate-data-directory module-identifier (pydoc-paths-list))))
-
-;;; ************************************************************************
-;;; Private functions
-;;; ************************************************************************
-
-(defun pydoc-commands-dialog-box (dialog-box)
-  "Prompt user with DIALOG-BOX and return selected value.
-Assumes caller has checked that `dialog-box' function exists."
-  (let ((echo-keystrokes 0)
-	event-obj
-	event)	 
-    ;; Add cmd-help and cancel buttons to dialog box.
-    (setq dialog-box (append dialog-box
-			     (list nil '["Cmd-Help" (pydoc-menu-help) t]
-				   '["Cancel" 'keyboard-quit t])))
-    (popup-dialog-box dialog-box)
-    (catch 'pydoc-done
-      (while t
-	(setq event (next-command-event event)
-	      event-obj (event-object event))
-	(cond ((and (menu-event-p event)
-		    (memq event-obj '(abort menu-no-selection-hook)))
-	       (signal 'quit nil))
-	      ((button-release-event-p event) ;; don't beep twice
-	       nil)
-	      ((menu-event-p event)
-	       (throw 'pydoc-done (eval event-obj)))
-	      (t
-	       (beep)
-	       (message "Please answer the dialog box.")))))))
-
-(defun pydoc-default-argument ()
-  "Return a default identifier argument near point."
-  (require 'etags)
-  ;; Include periods as symbol constituents but remove any trailing period.
-  (let* ((period-syntax (char-to-string (char-syntax ?\.)))
-	 (default (unwind-protect
-		      (progn
-			(modify-syntax-entry ?\. "_")
-			(find-tag-default))
-		    (modify-syntax-entry ?\. period-syntax))))
-    (if (and (stringp default) (string-match "\\.+\\'" default))
-	(setq default (substring default 0 (match-beginning 0))))
-    default))
-
-(defun pydoc-initialize()
-  (message "Please wait a moment while the Python help system is initialized...")
-  ;; XEmacs change: help python find pydoc_lisp.py OOTB.
-  (let ((output-buf)
-	(pydir (locate-data-directory "python-modes")))
-    (save-window-excursion
-      ;; Start a Python interpreter if not already running.
-      (py-shell)
-      (pydoc-wait-for-output (current-buffer) 3.0)
-      (setq output-buf
-	    (py-execute-string
-	     (format
-	      "if not vars().has_key('pydoc_lisp'):
-    import sys
-    if not '%s' in sys.path:
-        sys.path.append('%s')
-    import pydoc_lisp
-
-pydoc_lisp.pydoc_output_lisp()
-" pydir pydir)))
-      ;; current vintages of python-mode.el (4.6 at least)
-      ;; no longer return a buffer [name].  We get t from the
-      ;; final kill-buffer instead.  If we see t we use the
-      ;; python shell's buffer.
-      (if (eq output-buf t)
-	  (setq output-buf 
-		(buffer-name (process-buffer (pydoc-async-output-p)))))
-
-      (setq pydoc-alist (pydoc-lisp-read-result output-buf)))
-    (if (member pydoc-alist '(nil None Traceback))
-	(progn 
-	  (setq pydoc-alist nil)
-	  (pop-to-buffer output-buf)
-	  (error "(pydoc): Initialization failed, Python did not output Lisp lists"))
-      (pydoc-kill-async-output output-buf (pydoc-async-output-p))
-      ;; Normalize Python search paths and make a regular list, not an alist
-      (let ((paths (assoc "paths" pydoc-alist)))
-	(setcdr paths (mapcar 'file-name-as-directory
-			      (mapcar 'car (cdr paths)))))
-      (message ""))))
-
-(defun pydoc-lisp-read-result (result-buf)
-  "Read and return the most recent python output in RESULT-BUF as a Lisp expression.
-If a timeout occurs before the expression is read, then return nil."
-  (save-excursion
-    (if (pydoc-wait-for-output result-buf 5.0)
-	(progn (goto-char (pydoc-output-start))
-	       (read (current-buffer)))
-      nil)))
-
-(defun pydoc-output-start ()
-  "Return the character position start of the most recent Python output."
-  (save-excursion
-    ;; Skip any trailing Python prompt
-    (forward-line 0) ;; to bol
-    (if (re-search-backward "^>>> " nil t)
-	(if (not (zerop (forward-line 1)))
-	    (goto-char (point-max)))
-      (goto-char (point-min)))
-    (point)))
-
-(defun pydoc-read-argument (prompt)
-  "Read and return a string argument using PROMPT."
-  (let* ((default (pydoc-default-argument))
-	 (argument
-	  (read-string
-	   (if default
-	       (format "%s(default %s) " prompt default)
-	     prompt))))
-    (if (member argument '(nil ""))
-	default
-      argument)))
-
-(defun pydoc-select-command ()
-  "Interactively select and return a pydoc command to run."
-  (let ((cmd-prompt)
-	(cmd)
-	;; Use dialog box if last user event involved the mouse.
-	(use-dialog-box (and (fboundp 'popup-dialog-box)
-			     (fboundp 'button-press-event-p)
-			     (or (button-press-event-p last-command-event)
-				 (button-release-event-p last-command-event)
-				 (menu-event-p last-command-event)))))
-    ;; Create a prompt numbering each command available.
-    (setq cmd-prompt
-	  (if use-dialog-box
-	      (mapcar
-	       #'(lambda (name-and-cmd)
-		   (vector (car name-and-cmd)
-			   (list 'quote (cdr name-and-cmd))
-			   't))
-	       pydoc-cmd-alist)
-	    (concat
-	     "Pydoc>  "
-	     (mapconcat 'identity (mapcar 'car pydoc-cmd-alist) "  ")
-	     ": ")))
-    ;; Prompt user.
-    (if use-dialog-box
-	(setq cmd (pydoc-commands-dialog-box
-		   (cons "Choose pydoc command (or choose Cmd-Help for help on commands): " cmd-prompt)))
-      ;; Otherwise, prompt in the minibuffer.
-      (let ((item-keys (mapcar #'(lambda (item) (aref item 0))
-			       (mapcar 'car pydoc-cmd-alist)))
-	    key)
-	(while (and (not (memq (setq key (upcase
-					  (string-to-char
-					   (read-from-minibuffer
-					    "" cmd-prompt pydoc-menu-mode-map))))
-			       item-keys))
-		    (not (memq key pydoc-menu-special-keys)))
-	  (beep)
-	  (discard-input))
-	(if (eq key ?\C-g)
-	    ;; abort
-	    (keyboard-quit))
-	(if (memq key pydoc-menu-special-keys)
-	    (setq cmd (pydoc-menu-help))
-	  (setq cmd (cdr (nth (- (length pydoc-cmd-alist)
-				 (length (memq key item-keys)))
-			      pydoc-cmd-alist))))))
-    cmd))
-
-;;; Asynchronous handling
-(defun pydoc-async-output-p ()
-  "Return the running asynchronous process for Python code evaluation or nil if none."
-  (let ((proc (and (stringp py-which-bufname)
-		   (get-process py-which-bufname))))
-    (and proc (eq (process-status proc) 'run) proc)))
-
-(defun pydoc-kill-async-output (output-buf async-process)
-  (if async-process
-      (progn
-	(set-buffer output-buf)
-	;; Remove output so it doesn't clog up the interpreter buffer.
-	(comint-kill-output))))
-
-(defun pydoc-wait-for-output (buffer timeout)
-  "Move to BUFFER and wait a maximum of TIMEOUT seconds or until Python command execution ends.
-Python command execution ends when Python returns a top-level prompt.
-Return t if waited less than TIMEOUT time (and thus received full output)."
-  (set-buffer buffer)
-  (goto-char (point-max)) ;; User may have moved point elsewhere.
-  (let ((time-waited 0.0)
-	(wait-time 0.1))
-    (while (and (< time-waited timeout)
-		(not (save-excursion
-		       (forward-line 0) ;; to bol
-		       (looking-at ">>> \\'"))))
-      (sleep-for wait-time)
-      (setq time-waited (+ time-waited wait-time)))
-    (< time-waited timeout)))
-
-
-;;; Cmd menu handling
-(defun pydoc-menu-enter (&optional char-str)
-  "Uses CHAR-STR or last input character as minibuffer argument."
-  (interactive)
-  (let ((input (or char-str (aref (recent-keys) (1- (length (recent-keys))))))
-	(case-fold-search t))
-    (cond
-     ;; GNU Emacs 19 or above
-     ((and (not (string-match "XEmacs" emacs-version))
-	   ;; Version 19 and above.
-	   (string-lessp "19" emacs-version))
-      (and (not (integerp input))
-	   (eventp input)
-	   (setq input (event-basic-type input))))
-     ((string-match "XEmacs" emacs-version)
-      (if (eventp input)
-	  (setq input (event-to-character input)))))
-    (erase-buffer)
-    (insert input))
-  (exit-minibuffer))
-
-(defun pydoc-menu-help ()
-  "Type one of the following characters:
-
-a   - A)propos <term>    - list modules/packages with <term> in their first line doc strings
-h   - H)elp <term>       - display doc for name <term> or string literal '<term>'
-k   - K)eyword <keyword> - with completion, display doc for a Python <keyword>
-m   - M)odule <name>     - with completion, display doc for a Python module <name>
-p   - P)ackage <name>    - with completion, display doc for a Python package <name>
-t   - T)opic <topic>     - with completion, display Python reference doc for <topic>
-x   - X)ref <term>       - with completion, display doc for a pydoc cross-reference
-
-?   - show this help
-C-g - abort from menu"
-  (interactive)
-  (save-window-excursion
-    (switch-to-buffer "*Help*")
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (insert (documentation 'pydoc-menu-help))
-    (goto-char (point-min))
-    (pydoc-select-command)))
-
-;;; Pathname handling
-(defun pydoc-paths-list ()
-  (cdr (assoc "paths" pydoc-alist)))
-
-
-;;; Xref handling
-(defun pydoc-choose-xref (prompt &optional xrefs-alist)
-  (or xrefs-alist (setq xrefs-alist (pydoc-xrefs-alist)))
-  (if (null xrefs-alist)
-      (error "(pydoc): No cross-references in this buffer")
-    (let ((completion-ignore-case t)
-	  (default (pydoc-default-argument))
-	  (result))
-      (if (not (assoc default xrefs-alist))
-	  (setq default nil))
-      (while (not result)
-	(setq result (completing-read
-		      (if default
-			  (format "%s(default %s) " prompt default)
-			prompt)
-		      xrefs-alist nil t))
-	(if (string-equal result "")
-	    (if default
-		(setq result default)
-	      (beep)
-	      (setq result nil))))
-      result)))
-
-(defun pydoc-delete-space (string)
-  "Delete any leading and trailing space from STRING and return the STRING."
-  (if (string-match "\\`[ \t\n\r\f]+" string)
-      (setq string (substring string (match-end 0))))
-  (if (string-match "[ \t\n\r\f]+\\'" string)
-      (setq string (substring string 0 (match-beginning 0))))
-  string)
-
-(defun pydoc-display-xref (&optional xref)
-  "Displays optional XREF (or prompts for and then displays it).
-Signals an error when there are no xrefs within the current buffer."
-  (interactive)
-  (if (member xref '(nil ""))
-      ;; Triggers an error if there are no xrefs.
-      (setq xref (pydoc-choose-xref "Display xref: ")))
-  (let ((case-fold-search nil))
-    (if (string-match "\\`[0-9A-Z_]+\\'" xref)
-	;; all uppercase, so is a topic
-	(pydoc-topics xref)
-      ;; assume is a module
-      (pydoc-modules xref))))
-
-(defun pydoc-xrefs-alist ()
-  ;; Assumes all xrefs are on a single line following point.
-  (mapcar #'(lambda (str) (list (pydoc-delete-space str)))
-	  (split-string (buffer-substring
-			 (point) (save-excursion (end-of-line) (point)))
-			",")))
-
-(defun pydoc-xrefs-p ()
-  "Return t if current buffer contains xrefs or nil otherwise.
-A call to \(match-end 0) returns the end of the xrefs-prefix."
-  (save-excursion
-    (goto-char (point-max))
-    (re-search-backward pydoc-xrefs-prefix nil t)))
-
-
diff --git a/xemacs-packages/lisp/python-modes/python-mode.el b/xemacs-packages/lisp/python-modes/python-mode.el
deleted file mode 100644
index e0f35b8c..00000000
--- a/xemacs-packages/lisp/python-modes/python-mode.el
+++ /dev/null
@@ -1,3817 +0,0 @@
-;;; python-mode.el --- Major mode for editing Python programs
-
-;; Copyright (C) 1992,1993,1994  Tim Peters
-
-;; Author: 2003-2004 http://sf.net/projects/python-mode
-;;         1995-2002 Barry A. Warsaw
-;;         1992-1994 Tim Peters
-;; Maintainer: python-mode@python.org
-;; Created:    Feb 1992
-;; Keywords:   python languages oop
-
-(defconst py-version "$Revision: 4.52 $"
-  "`python-mode' version number.")
-
-;; This software is provided as-is, without express or implied
-;; warranty.  Permission to use, copy, modify, distribute or sell this
-;; software, without fee, for any purpose and by any individual or
-;; organization, is hereby granted, provided that the above copyright
-;; notice and this paragraph appear in all copies.
-
-;;; Commentary:
-
-;; This is a major mode for editing Python programs.  It was developed
-;; by Tim Peters after an original idea by Michael A. Guravage.  Tim
-;; subsequently left the net; in 1995, Barry Warsaw inherited the mode
-;; and is the current maintainer.  Tim's now back but disavows all
-;; responsibility for the mode.  Smart Tim :-)
-
-;; pdbtrack support contributed by Ken Manheimer, April 2001.
-
-;; Please use the SourceForge Python project to submit bugs or
-;; patches:
-;;
-;;     http://sourceforge.net/projects/python
-
-;; FOR MORE INFORMATION:
-
-;; There is some information on python-mode.el at
-
-;;     http://www.python.org/emacs/python-mode/
-;;
-;; It does contain links to other packages that you might find useful,
-;; such as pdb interfaces, OO-Browser links, etc.
-
-;; BUG REPORTING:
-
-;; As mentioned above, please use the SourceForge Python project for
-;; submitting bug reports or patches.  The old recommendation, to use
-;; C-c C-b will still work, but those reports have a higher chance of
-;; getting buried in my mailbox.  Please include a complete, but
-;; concise code sample and a recipe for reproducing the bug.  Send
-;; suggestions and other comments to python-mode@python.org.
-
-;; When in a Python mode buffer, do a C-h m for more help.  It's
-;; doubtful that a texinfo manual would be very useful, but if you
-;; want to contribute one, I'll certainly accept it!
-
-;;; Code:
-
-(require 'comint)
-(require 'custom)
-(require 'cl)
-(require 'compile)
-
-
-;; user definable variables
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-
-(defgroup python nil
-  "Support for the Python programming language, <http://www.python.org/>"
-  :group 'languages
-  :prefix "py-")
-
-(defcustom py-python-command "python"
-  "*Shell command used to start Python interpreter."
-  :type 'string
-  :group 'python)
-
-(defcustom py-jpython-command "jpython"
-  "*Shell command used to start the JPython interpreter."
-  :type 'string
-  :group 'python
-  :tag "JPython Command")
-
-(defcustom py-default-interpreter 'cpython
-  "*Which Python interpreter is used by default.
-The value for this variable can be either `cpython' or `jpython'.
-
-When the value is `cpython', the variables `py-python-command' and
-`py-python-command-args' are consulted to determine the interpreter
-and arguments to use.
-
-When the value is `jpython', the variables `py-jpython-command' and
-`py-jpython-command-args' are consulted to determine the interpreter
-and arguments to use.
-
-Note that this variable is consulted only the first time that a Python
-mode buffer is visited during an Emacs session.  After that, use
-\\[py-toggle-shells] to change the interpreter shell."
-  :type '(choice (const :tag "Python (a.k.a. CPython)" cpython)
-		 (const :tag "JPython" jpython))
-  :group 'python)
-
-(defcustom py-python-command-args '("-i")
-  "*List of string arguments to be used when starting a Python shell."
-  :type '(repeat string)
-  :group 'python)
-
-(defcustom py-jpython-command-args '("-i")
-  "*List of string arguments to be used when starting a JPython shell."
-  :type '(repeat string)
-  :group 'python
-  :tag "JPython Command Args")
-
-(defcustom py-indent-offset 4
-  "*Amount of offset per level of indentation.
-`\\[py-guess-indent-offset]' can usually guess a good value when
-you're editing someone else's Python code."
-  :type 'integer
-  :group 'python)
-
-(defcustom py-continuation-offset 4
-  "*Additional amount of offset to give for some continuation lines.
-Continuation lines are those that immediately follow a backslash
-terminated line.  Only those continuation lines for a block opening
-statement are given this extra offset."
-  :type 'integer
-  :group 'python)
-
-(defcustom py-smart-indentation t
-  "*Should `python-mode' try to automagically set some indentation variables?
-When this variable is non-nil, two things happen when a buffer is set
-to `python-mode':
-
-    1. `py-indent-offset' is guessed from existing code in the buffer.
-       Only guessed values between 2 and 8 are considered.  If a valid
-       guess can't be made (perhaps because you are visiting a new
-       file), then the value in `py-indent-offset' is used.
-
-    2. `indent-tabs-mode' is turned off if `py-indent-offset' does not
-       equal `tab-width' (`indent-tabs-mode' is never turned on by
-       Python mode).  This means that for newly written code, tabs are
-       only inserted in indentation if one tab is one indentation
-       level, otherwise only spaces are used.
-
-Note that both these settings occur *after* `python-mode-hook' is run,
-so if you want to defeat the automagic configuration, you must also
-set `py-smart-indentation' to nil in your `python-mode-hook'."
-  :type 'boolean
-  :group 'python)
-
-(defcustom py-align-multiline-strings-p t
-  "*Flag describing how multi-line triple quoted strings are aligned.
-When this flag is non-nil, continuation lines are lined up under the
-preceding line's indentation.  When this flag is nil, continuation
-lines are aligned to column zero."
-  :type '(choice (const :tag "Align under preceding line" t)
-		 (const :tag "Align to column zero" nil))
-  :group 'python)
-
-(defcustom py-block-comment-prefix "##"
-  "*String used by \\[comment-region] to comment out a block of code.
-This should follow the convention for non-indenting comment lines so
-that the indentation commands won't get confused (i.e., the string
-should be of the form `#x...' where `x' is not a blank or a tab, and
-`...' is arbitrary).  However, this string should not end in whitespace."
-  :type 'string
-  :group 'python)
-
-(defcustom py-honor-comment-indentation t
-  "*Controls how comment lines influence subsequent indentation.
-
-When nil, all comment lines are skipped for indentation purposes, and
-if possible, a faster algorithm is used (i.e. X/Emacs 19 and beyond).
-
-When t, lines that begin with a single `#' are a hint to subsequent
-line indentation.  If the previous line is such a comment line (as
-opposed to one that starts with `py-block-comment-prefix'), then its
-indentation is used as a hint for this line's indentation.  Lines that
-begin with `py-block-comment-prefix' are ignored for indentation
-purposes.
-
-When not nil or t, comment lines that begin with a single `#' are used
-as indentation hints, unless the comment character is in column zero."
-  :type '(choice
-	  (const :tag "Skip all comment lines (fast)" nil)
-	  (const :tag "Single # `sets' indentation for next line" t)
-	  (const :tag "Single # `sets' indentation except at column zero"
-		 other)
-	  )
-  :group 'python)
-
-(defcustom py-temp-directory
-  (let ((ok '(lambda (x)
-	       (and x
-		    (setq x (expand-file-name x)) ; always true
-		    (file-directory-p x)
-		    (file-writable-p x)
-		    x))))
-    (or (funcall ok (getenv "TMPDIR"))
-	(funcall ok "/usr/tmp")
-	(funcall ok "/tmp")
-	(funcall ok "/var/tmp")
-	(funcall ok  ".")
-	(error
-	 "Couldn't find a usable temp directory -- set `py-temp-directory'")))
-  "*Directory used for temporary files created by a *Python* process.
-By default, the first directory from this list that exists and that you
-can write into: the value (if any) of the environment variable TMPDIR,
-/usr/tmp, /tmp, /var/tmp, or the current directory."
-  :type 'string
-  :group 'python)
-
-(defcustom py-beep-if-tab-change t
-  "*Ring the bell if `tab-width' is changed.
-If a comment of the form
-
-  \t# vi:set tabsize=<number>:
-
-is found before the first code line when the file is entered, and the
-current value of (the general Emacs variable) `tab-width' does not
-equal <number>, `tab-width' is set to <number>, a message saying so is
-displayed in the echo area, and if `py-beep-if-tab-change' is non-nil
-the Emacs bell is also rung as a warning."
-  :type 'boolean
-  :group 'python)
-
-(defcustom py-jump-on-exception t
-  "*Jump to innermost exception frame in *Python Output* buffer.
-When this variable is non-nil and an exception occurs when running
-Python code synchronously in a subprocess, jump immediately to the
-source code of the innermost traceback frame."
-  :type 'boolean
-  :group 'python)
-
-(defcustom py-ask-about-save t
-  "If not nil, ask about which buffers to save before executing some code.
-Otherwise, all modified buffers are saved without asking."
-  :type 'boolean
-  :group 'python)
-
-(defcustom py-backspace-function 'backward-delete-char-untabify
-  "*Function called by `py-electric-backspace' when deleting backwards."
-  :type 'function
-  :group 'python)
-
-(defcustom py-delete-function 'delete-char
-  "*Function called by `py-electric-delete' when deleting forwards."
-  :type 'function
-  :group 'python)
-
-(defcustom py-imenu-show-method-args-p nil 
-  "*Controls echoing of arguments of functions & methods in the Imenu buffer.
-When non-nil, arguments are printed."
-  :type 'boolean
-  :group 'python)
-(make-variable-buffer-local 'py-indent-offset)
-
-(defcustom py-pdbtrack-do-tracking-p t
-  "*Controls whether the pdbtrack feature is enabled or not.
-When non-nil, pdbtrack is enabled in all comint-based buffers,
-e.g. shell buffers and the *Python* buffer.  When using pdb to debug a
-Python program, pdbtrack notices the pdb prompt and displays the
-source file and line that the program is stopped at, much the same way
-as gud-mode does for debugging C programs with gdb."
-  :type 'boolean
-  :group 'python)
-(make-variable-buffer-local 'py-pdbtrack-do-tracking-p)
-
-(defcustom py-pdbtrack-minor-mode-string " PDB"
-  "*String to use in the minor mode list when pdbtrack is enabled."
-  :type 'string
-  :group 'python)
-
-(defcustom py-import-check-point-max
-  20000
-  "Maximum number of characters to search for a Java-ish import statement.
-When `python-mode' tries to calculate the shell to use (either a
-CPython or a JPython shell), it looks at the so-called `shebang' line
--- i.e. #! line.  If that's not available, it looks at some of the
-file heading imports to see if they look Java-like."
-  :type 'integer
-  :group 'python
-  )
-
-(defcustom py-jpython-packages
-  '("java" "javax" "org" "com")
-  "Imported packages that imply `jpython-mode'."
-  :type '(repeat string)
-  :group 'python)
-  
-;; Not customizable
-(defvar py-master-file nil
-  "If non-nil, execute the named file instead of the buffer's file.
-The intent is to allow you to set this variable in the file's local
-variable section, e.g.:
-
-    # Local Variables:
-    # py-master-file: \"master.py\"
-    # End:
-
-so that typing \\[py-execute-buffer] in that buffer executes the named
-master file instead of the buffer's file.  If the file name has a
-relative path, the value of variable `default-directory' for the
-buffer is prepended to come up with a file name.")
-(make-variable-buffer-local 'py-master-file)
-
-(defcustom py-pychecker-command "pychecker"
-  "*Shell command used to run Pychecker."
-  :type 'string
-  :group 'python
-  :tag "Pychecker Command")
-
-(defcustom py-pychecker-command-args '("--stdlib")
-  "*List of string arguments to be passed to pychecker."
-  :type '(repeat string)
-  :group 'python
-  :tag "Pychecker Command Args")
-
-(defvar py-shell-alist
-  '(("jpython" . 'jpython)
-    ("jython" . 'jpython)
-    ("python" . 'cpython))
-  "*Alist of interpreters and python shells. Used by `py-choose-shell'
-to select the appropriate python interpreter mode for a file.")
-
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; NO USER DEFINABLE VARIABLES BEYOND THIS POINT
-
-(defconst py-emacs-features
-  (let (features)
-   features)
-  "A list of features extant in the Emacs you are using.
-There are many flavors of Emacs out there, with different levels of
-support for features needed by `python-mode'.")
-
-;; Face for None, True, False, self, and Ellipsis
-(defvar py-pseudo-keyword-face 'py-pseudo-keyword-face
-  "Face for pseudo keywords in Python mode, like self, True, False, Ellipsis.")
-(make-face 'py-pseudo-keyword-face)
-
-;; Face for builtins
-(defvar py-builtins-face 'py-builtins-face
-  "Face for builtins like TypeError, object, open, and exec.")
-(make-face 'py-builtins-face)
-
-(defun py-font-lock-mode-hook ()
-  (or (face-differs-from-default-p 'py-pseudo-keyword-face)
-      (copy-face 'font-lock-keyword-face 'py-pseudo-keyword-face))
-  (or (face-differs-from-default-p 'py-builtins-face)
-      (copy-face 'font-lock-keyword-face 'py-builtins-face))
-  )
-(add-hook 'font-lock-mode-hook 'py-font-lock-mode-hook)
-
-(defvar python-font-lock-keywords
-  (let ((kw1 (mapconcat 'identity
-			'("and"      "assert"   "break"   "class"
-			  "continue" "def"      "del"     "elif"
-			  "else"     "except"   "exec"    "for"
-			  "from"     "global"   "if"      "import"
-			  "in"       "is"       "lambda"  "not"
-			  "or"       "pass"     "print"   "raise"
-			  "return"   "while"    "yield"
-			  )
-			"\\|"))
-	(kw2 (mapconcat 'identity
-			'("else:" "except:" "finally:" "try:")
-			"\\|"))
-	(kw3 (mapconcat 'identity
-			;; Don't include True, False, None, or
-			;; Ellipsis in this list, since they are
-			;; already defined as pseudo keywords.
-			'("ArithmeticError" "AssertionError"
-			  "AttributeError" "DeprecationWarning" "EOFError"
-			  "EnvironmentError" "Exception"
-			  "FloatingPointError" "FutureWarning" "IOError"
-			  "ImportError" "IndentationError" "IndexError"
-			  "KeyError" "KeyboardInterrupt" "LookupError"
-			  "MemoryError" "NameError" "NotImplemented"
-			  "NotImplementedError" "OSError" "OverflowError"
-			  "OverflowWarning" "PendingDeprecationWarning"
-			  "ReferenceError" "RuntimeError" "RuntimeWarning"
-			  "StandardError" "StopIteration" "SyntaxError"
-			  "SyntaxWarning" "SystemError" "SystemExit"
-			  "TabError" "TypeError" "UnboundLocalError"
-			  "UnicodeDecodeError" "UnicodeEncodeError"
-			  "UnicodeError" "UnicodeTranslateError"
-			  "UserWarning" "ValueError" "Warning"
-			  "ZeroDivisionError" "__debug__"
-			  "__import__" "__name__" "abs" "apply" "basestring"
-			  "bool" "buffer" "callable" "chr" "classmethod"
-			  "cmp" "coerce" "compile" "complex" "copyright"
-			  "delattr" "dict" "dir" "divmod"
-			  "enumerate" "eval" "execfile" "exit" "file"
-			  "filter" "float" "getattr" "globals" "hasattr"
-			  "hash" "hex" "id" "input" "int" "intern"
-			  "isinstance" "issubclass" "iter" "len" "license"
-			  "list" "locals" "long" "map" "max" "min" "object"
-			  "oct" "open" "ord" "pow" "property" "range"
-			  "raw_input" "reduce" "reload" "repr" "round"
-			  "setattr" "slice" "staticmethod" "str" "sum"
-			  "super" "tuple" "type" "unichr" "unicode" "vars"
-			  "xrange" "zip")
-			"\\|"))
-	)
-    (list
-     ;; keywords
-     (cons (concat "\\b\\(" kw1 "\\)\\b[ \n\t(]") 1)
-     ;; builtins when they don't appear as object attributes
-     (list (concat "\\([^. \t]\\|^\\)[ \t]*\\b\\(" kw3 "\\)\\b[ \n\t(]") 2
-	   'py-builtins-face)
-     ;; block introducing keywords with immediately following colons.
-     ;; Yes "except" is in both lists.
-     (cons (concat "\\b\\(" kw2 "\\)[ \n\t(]") 1)
-     ;; `as' but only in "import foo as bar"
-     '("[ \t]*\\(\\bfrom\\b.*\\)?\\bimport\\b.*\\b\\(as\\)\\b" . 2)
-     ;; classes
-     '("\\bclass[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"
-       1 font-lock-type-face)
-     ;; functions
-     '("\\bdef[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"
-       1 font-lock-function-name-face)
-     ;; pseudo-keywords
-     '("\\b\\(self\\|None\\|True\\|False\\|Ellipsis\\)\\b"
-       1 py-pseudo-keyword-face)
-     ))
-  "Additional expressions to highlight in Python mode.")
-(put 'python-mode 'font-lock-defaults '(python-font-lock-keywords))
-
-;; have to bind py-file-queue before installing the kill-emacs-hook
-(defvar py-file-queue nil
-  "Queue of Python temp files awaiting execution.
-Currently-active file is at the head of the list.")
-
-(defvar py-pdbtrack-is-tracking-p nil)
-(defvar py-pdbtrack-last-grubbed-buffer nil
-  "Record of the last buffer used when the source path was invalid.
-
-This buffer is consulted before the buffer-list history for satisfying
-`py-pdbtrack-grub-for-buffer', since it's the most often the likely
-prospect as debugging continues.")
-(make-variable-buffer-local 'py-pdbtrack-last-grubbed-buffer)
-(defvar py-pychecker-history nil)
-
-
-
-;; Constants
-
-(defconst py-stringlit-re
-  (concat
-   ;; These fail if backslash-quote ends the string (not worth
-   ;; fixing?).  They precede the short versions so that the first two
-   ;; quotes don't look like an empty short string.
-   ;;
-   ;; (maybe raw), long single quoted triple quoted strings (SQTQ),
-   ;; with potential embedded single quotes
-   "[rR]?'''[^']*\\(\\('[^']\\|''[^']\\)[^']*\\)*'''"
-   "\\|"
-   ;; (maybe raw), long double quoted triple quoted strings (DQTQ),
-   ;; with potential embedded double quotes
-   "[rR]?\"\"\"[^\"]*\\(\\(\"[^\"]\\|\"\"[^\"]\\)[^\"]*\\)*\"\"\""
-   "\\|"
-   "[rR]?'\\([^'\n\\]\\|\\\\.\\)*'"	; single-quoted
-   "\\|"				; or
-   "[rR]?\"\\([^\"\n\\]\\|\\\\.\\)*\""	; double-quoted
-   )
-  "Regular expression matching a Python string literal.")
-
-(defconst py-continued-re
-  ;; This is tricky because a trailing backslash does not mean
-  ;; continuation if it's in a comment
-  (concat
-   "\\(" "[^#'\"\n\\]" "\\|" py-stringlit-re "\\)*"
-   "\\\\$")
-  "Regular expression matching Python backslash continuation lines.")
-  
-(defconst py-blank-or-comment-re "[ \t]*\\($\\|#\\)"
-  "Regular expression matching a blank or comment line.")
-
-(defconst py-outdent-re
-  (concat "\\(" (mapconcat 'identity
-			   '("else:"
-			     "except\\(\\s +.*\\)?:"
-			     "finally:"
-			     "elif\\s +.*:")
-			   "\\|")
-	  "\\)")
-  "Regular expression matching statements to be dedented one level.")
-  
-(defconst py-block-closing-keywords-re
-  "\\(return\\|raise\\|break\\|continue\\|pass\\)"
-  "Regular expression matching keywords which typically close a block.")
-
-(defconst py-no-outdent-re
-  (concat
-   "\\("
-   (mapconcat 'identity
-	      (list "try:"
-		    "except\\(\\s +.*\\)?:"
-		    "while\\s +.*:"
-		    "for\\s +.*:"
-		    "if\\s +.*:"
-		    "elif\\s +.*:"
-		    (concat py-block-closing-keywords-re "[ \t\n]")
-		    )
-	      "\\|")
-	  "\\)")
-  "Regular expression matching lines not to dedent after.")
-
-(defconst py-traceback-line-re
-  "[ \t]+File \"\\([^\"]+\\)\", line \\([0-9]+\\)"
-  "Regular expression that describes tracebacks.")
-
-;; pdbtrack contants
-(defconst py-pdbtrack-stack-entry-regexp
-;  "^> \\([^(]+\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_]+\\)()"
-  "^> \\(.*\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_]+\\)()"
-  "Regular expression pdbtrack uses to find a stack trace entry.")
-
-(defconst py-pdbtrack-input-prompt "\n[(<]*pdb[>)]+ "
-  "Regular expression pdbtrack uses to recognize a pdb prompt.")
-
-(defconst py-pdbtrack-track-range 10000
-  "Max number of characters from end of buffer to search for stack entry.")
-
-
-
-;; Major mode boilerplate
-
-;; define a mode-specific abbrev table for those who use such things
-(defvar python-mode-abbrev-table nil
-  "Abbrev table in use in `python-mode' buffers.")
-(define-abbrev-table 'python-mode-abbrev-table nil)
-
-(defvar python-mode-hook nil
-  "*Hook called by `python-mode'.")
-
-(defvar jpython-mode-hook nil
-  "*Hook called by `jpython-mode'. `jpython-mode' also calls
-`python-mode-hook'.")
-
-(defvar py-shell-hook nil
-  "*Hook called by `py-shell'.")
-
-;; In previous version of python-mode.el, the hook was incorrectly
-;; called py-mode-hook, and was not defvar'd.  Deprecate its use.
-(and (fboundp 'make-obsolete-variable)
-     (make-obsolete-variable 'py-mode-hook 'python-mode-hook))
-
-(defvar py-mode-map ()
-  "Keymap used in `python-mode' buffers.")
-(if py-mode-map
-    nil
-  (setq py-mode-map (make-sparse-keymap))
-  ;; electric keys
-  (define-key py-mode-map ":" 'py-electric-colon)
-  ;; indentation level modifiers
-  (define-key py-mode-map "\C-c\C-l"  'py-shift-region-left)
-  (define-key py-mode-map "\C-c\C-r"  'py-shift-region-right)
-  (define-key py-mode-map "\C-c<"     'py-shift-region-left)
-  (define-key py-mode-map "\C-c>"     'py-shift-region-right)
-  ;; subprocess commands
-  (define-key py-mode-map "\C-c\C-c"  'py-execute-buffer)
-  (define-key py-mode-map "\C-c\C-m"  'py-execute-import-or-reload)
-  (define-key py-mode-map "\C-c\C-s"  'py-execute-string)
-  (define-key py-mode-map "\C-c|"     'py-execute-region)
-  (define-key py-mode-map "\e\C-x"    'py-execute-def-or-class)
-  (define-key py-mode-map "\C-c!"     'py-shell)
-  (define-key py-mode-map "\C-c\C-t"  'py-toggle-shells)
-  ;; Caution!  Enter here at your own risk.  We are trying to support
-  ;; several behaviors and it gets disgusting. :-( This logic ripped
-  ;; largely from CC Mode.
-  ;;
-  ;; In XEmacs 19, Emacs 19, and Emacs 20, we use this to bind
-  ;; backwards deletion behavior to DEL, which both Delete and
-  ;; Backspace get translated to.  There's no way to separate this
-  ;; behavior in a clean way, so deal with it!  Besides, it's been
-  ;; this way since the dawn of time.
-  (if (not (boundp 'delete-key-deletes-forward))
-      (define-key py-mode-map "\177" 'py-electric-backspace)
-    ;; However, XEmacs 20 actually achieved enlightenment.  It is
-    ;; possible to sanely define both backward and forward deletion
-    ;; behavior under X separately (TTYs are forever beyond hope, but
-    ;; who cares?  XEmacs 20 does the right thing with these too).
-    (define-key py-mode-map [delete]    'py-electric-delete)
-    (define-key py-mode-map [backspace] 'py-electric-backspace))
-  ;; Separate M-BS from C-M-h.  The former should remain
-  ;; backward-kill-word.
-  (define-key py-mode-map [(control meta h)] 'py-mark-def-or-class)
-  (define-key py-mode-map "\C-c\C-k"  'py-mark-block)
-  ;; Miscellaneous
-  (define-key py-mode-map "\C-c:"     'py-guess-indent-offset)
-  (define-key py-mode-map "\C-c\t"    'py-indent-region)
-  (define-key py-mode-map "\C-c\C-d"  'py-pdbtrack-toggle-stack-tracking)
-  (define-key py-mode-map "\C-c\C-n"  'py-next-statement)
-  (define-key py-mode-map "\C-c\C-p"  'py-previous-statement)
-  (define-key py-mode-map "\C-c\C-u"  'py-goto-block-up)
-  (define-key py-mode-map "\C-c#"     'py-comment-region)
-  (define-key py-mode-map "\C-c?"     'py-describe-mode)
-  (define-key py-mode-map "\C-c\C-h"  'py-help-at-point)
-  (define-key py-mode-map "\e\C-a"    'py-beginning-of-def-or-class)
-  (define-key py-mode-map "\e\C-e"    'py-end-of-def-or-class)
-  (define-key py-mode-map "\C-c-"     'py-up-exception)
-  (define-key py-mode-map "\C-c="     'py-down-exception)
-  ;; stuff that is `standard' but doesn't interface well with
-  ;; python-mode, which forces us to rebind to special commands
-  (define-key py-mode-map "\C-xnd"    'py-narrow-to-defun)
-  ;; information
-  (define-key py-mode-map "\C-c\C-b" 'py-submit-bug-report)
-  (define-key py-mode-map "\C-c\C-v" 'py-version)
-  (define-key py-mode-map "\C-c\C-w" 'py-pychecker-run)
-  ;; shadow global bindings for newline-and-indent w/ the py- version.
-  ;; BAW - this is extremely bad form, but I'm not going to change it
-  ;; for now.
-  (mapcar #'(lambda (key)
-	      (define-key py-mode-map key 'py-newline-and-indent))
-	  (where-is-internal 'newline-and-indent))
-  ;; Force RET to be py-newline-and-indent even if it didn't get
-  ;; mapped by the above code.  motivation: Emacs' default binding for
-  ;; RET is `newline' and C-j is `newline-and-indent'.  Most Pythoneers
-  ;; expect RET to do a `py-newline-and-indent' and any Emacsers who
-  ;; dislike this are probably knowledgeable enough to do a rebind.
-  ;; However, we do *not* change C-j since many Emacsers have already
-  ;; swapped RET and C-j and they don't want C-j bound to `newline' to 
-  ;; change.
-  (define-key py-mode-map "\C-m" 'py-newline-and-indent)
-  )
-
-(defvar py-mode-output-map nil
-  "Keymap used in *Python Output* buffers.")
-(if py-mode-output-map
-    nil
-  (setq py-mode-output-map (make-sparse-keymap))
-  (define-key py-mode-output-map [button2]  'py-mouseto-exception)
-  (define-key py-mode-output-map "\C-c\C-c" 'py-goto-exception)
-  ;; TBD: Disable all self-inserting keys.  This is bogus, we should
-  ;; really implement this as *Python Output* buffer being read-only
-  (mapcar #' (lambda (key)
-	       (define-key py-mode-output-map key
-		 #'(lambda () (interactive) (beep))))
-	     (where-is-internal 'self-insert-command))
-  )
-
-(defvar py-shell-map nil
-  "Keymap used in *Python* shell buffers.")
-(if py-shell-map
-    nil
-  (setq py-shell-map (copy-keymap comint-mode-map))
-  (define-key py-shell-map [tab]   'tab-to-tab-stop)
-  (define-key py-shell-map "\C-c-" 'py-up-exception)
-  (define-key py-shell-map "\C-c=" 'py-down-exception)
-  )
-
-(defvar py-mode-syntax-table nil
-  "Syntax table used in `python-mode' buffers.")
-(when (not py-mode-syntax-table)
-  (setq py-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\( "()" py-mode-syntax-table)
-  (modify-syntax-entry ?\) ")(" py-mode-syntax-table)
-  (modify-syntax-entry ?\[ "(]" py-mode-syntax-table)
-  (modify-syntax-entry ?\] ")[" py-mode-syntax-table)
-  (modify-syntax-entry ?\{ "(}" py-mode-syntax-table)
-  (modify-syntax-entry ?\} "){" py-mode-syntax-table)
-  ;; Add operator symbols misassigned in the std table
-  (modify-syntax-entry ?\$ "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\% "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\& "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\* "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\+ "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\- "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\/ "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\< "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\= "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\> "."  py-mode-syntax-table)
-  (modify-syntax-entry ?\| "."  py-mode-syntax-table)
-  ;; For historical reasons, underscore is word class instead of
-  ;; symbol class.  GNU conventions say it should be symbol class, but
-  ;; there's a natural conflict between what major mode authors want
-  ;; and what users expect from `forward-word' and `backward-word'.
-  ;; Guido and I have hashed this out and have decided to keep
-  ;; underscore in word class.  If you're tempted to change it, try
-  ;; binding M-f and M-b to py-forward-into-nomenclature and
-  ;; py-backward-into-nomenclature instead.  This doesn't help in all
-  ;; situations where you'd want the different behavior
-  ;; (e.g. backward-kill-word).
-  (modify-syntax-entry ?\_ "w"  py-mode-syntax-table)
-  ;; Both single quote and double quote are string delimiters
-  (modify-syntax-entry ?\' "\"" py-mode-syntax-table)
-  (modify-syntax-entry ?\" "\"" py-mode-syntax-table)
-  ;; backquote is open and close paren
-  (modify-syntax-entry ?\` "$"  py-mode-syntax-table)
-  ;; comment delimiters
-  (modify-syntax-entry ?\# "<"  py-mode-syntax-table)
-  (modify-syntax-entry ?\n ">"  py-mode-syntax-table)
-  )
-
-;; An auxiliary syntax table which places underscore and dot in the
-;; symbol class for simplicity
-(defvar py-dotted-expression-syntax-table nil
-  "Syntax table used to identify Python dotted expressions.")
-(when (not py-dotted-expression-syntax-table)
-  (setq py-dotted-expression-syntax-table
-	(copy-syntax-table py-mode-syntax-table))
-  (modify-syntax-entry ?_ "_" py-dotted-expression-syntax-table)
-  (modify-syntax-entry ?. "_" py-dotted-expression-syntax-table))
-
-
-
-;; Utilities
-(defmacro py-safe (&rest body)
-  "Safely execute BODY, return nil if an error occurred."
-  (` (condition-case nil
-	 (progn (,@ body))
-       (error nil))))
-
-(defsubst py-keep-region-active ()
-  "Keep the region active in XEmacs."
-  ;; Ignore byte-compiler warnings you might see.  Also note that
-  ;; FSF's Emacs 19 does it differently; its policy doesn't require us
-  ;; to take explicit action.
-  (and (boundp 'zmacs-region-stays)
-       (setq zmacs-region-stays t)))
-
-(defsubst py-point (position)
-  "Returns the value of point at certain commonly referenced POSITIONs.
-POSITION can be one of the following symbols:
-
-  bol  -- beginning of line
-  eol  -- end of line
-  bod  -- beginning of def or class
-  eod  -- end of def or class
-  bob  -- beginning of buffer
-  eob  -- end of buffer
-  boi  -- back to indentation
-  bos  -- beginning of statement
-
-This function does not modify point or mark."
-  (let ((here (point)))
-    (cond
-     ((eq position 'bol) (beginning-of-line))
-     ((eq position 'eol) (end-of-line))
-     ((eq position 'bod) (py-beginning-of-def-or-class 'either))
-     ((eq position 'eod) (py-end-of-def-or-class 'either))
-     ;; Kind of funny, I know, but useful for py-up-exception.
-     ((eq position 'bob) (beginning-of-buffer))
-     ((eq position 'eob) (end-of-buffer))
-     ((eq position 'boi) (back-to-indentation))
-     ((eq position 'bos) (py-goto-initial-line))
-     (t (error "Unknown buffer position requested: %s" position))
-     )
-    (prog1
-	(point)
-      (goto-char here))))
-
-(defsubst py-highlight-line (from to file line)
-  (cond
-   ((fboundp 'make-extent)
-    ;; XEmacs
-    (let ((e (make-extent from to)))
-      (set-extent-property e 'mouse-face 'highlight)
-      (set-extent-property e 'py-exc-info (cons file line))
-      (set-extent-property e 'keymap py-mode-output-map)))
-   (t
-    ;; Emacs -- Please port this!
-    )
-   ))
-
-(defun py-in-literal (&optional lim)
-  "Return non-nil if point is in a Python literal (a comment or string).
-Optional argument LIM indicates the beginning of the containing form,
-i.e. the limit on how far back to scan."
-  ;; This is the version used for non-XEmacs, which has a nicer
-  ;; interface.
-  ;;
-  ;; WARNING: Watch out for infinite recursion.
-  (let* ((lim (or lim (py-point 'bod)))
-	 (state (parse-partial-sexp lim (point))))
-    (cond
-     ((nth 3 state) 'string)
-     ((nth 4 state) 'comment)
-     (t nil))))
-
-;; XEmacs has a built-in function that should make this much quicker.
-;; In this case, lim is ignored
-(defun py-fast-in-literal (&optional lim)
-  "Fast version of `py-in-literal', used only by XEmacs.
-Optional LIM is ignored."
-  ;; don't have to worry about context == 'block-comment
-  (buffer-syntactic-context))
-
-(if (fboundp 'buffer-syntactic-context)
-    (defalias 'py-in-literal 'py-fast-in-literal))
-
-
-
-;; Menu definitions, only relevent if you have the easymenu.el package
-;; (standard in the latest Emacs 19 and XEmacs 19 distributions).
-(defvar py-menu nil
-  "Menu for Python Mode.
-This menu will get created automatically if you have the `easymenu'
-package.  Note that the latest X/Emacs releases contain this package.")
-
-(and (py-safe (require 'easymenu) t)
-     (easy-menu-define
-      py-menu py-mode-map "Python Mode menu"
-      '("Python"
-	["Comment Out Region"   py-comment-region  (mark)]
-	["Uncomment Region"     (py-comment-region (point) (mark) '(4)) (mark)]
-	"-"
-	["Mark current block"   py-mark-block t]
-	["Mark current def"     py-mark-def-or-class t]
-	["Mark current class"   (py-mark-def-or-class t) t]
-	"-"
-	["Shift region left"    py-shift-region-left (mark)]
-	["Shift region right"   py-shift-region-right (mark)]
-	"-"
-	["Import/reload file"   py-execute-import-or-reload t]
-	["Execute buffer"       py-execute-buffer t]
-	["Execute region"       py-execute-region (mark)]
-	["Execute def or class" py-execute-def-or-class (mark)]
-	["Execute string"       py-execute-string t]
-	["Start interpreter..." py-shell t]
-	"-"
-	["Go to start of block" py-goto-block-up t]
-	["Go to start of class" (py-beginning-of-def-or-class t) t]
-	["Move to end of class" (py-end-of-def-or-class t) t]
-	["Move to start of def" py-beginning-of-def-or-class t]
-	["Move to end of def"   py-end-of-def-or-class t]
-	"-"
-	["Describe mode"        py-describe-mode t]
-	)))
-
-
-
-;; Imenu definitions
-(defvar py-imenu-class-regexp
-  (concat				; <<classes>>
-   "\\("				;
-   "^[ \t]*"				; newline and maybe whitespace
-   "\\(class[ \t]+[a-zA-Z0-9_]+\\)"	; class name
-					; possibly multiple superclasses
-   "\\([ \t]*\\((\\([a-zA-Z0-9_,. \t\n]\\)*)\\)?\\)"
-   "[ \t]*:"				; and the final :
-   "\\)"				; >>classes<<
-   )
-  "Regexp for Python classes for use with the Imenu package."
-  )
-
-(defvar py-imenu-method-regexp
-  (concat                               ; <<methods and functions>>
-   "\\("                                ; 
-   "^[ \t]*"                            ; new line and maybe whitespace
-   "\\(def[ \t]+"                       ; function definitions start with def
-   "\\([a-zA-Z0-9_]+\\)"                ;   name is here
-					;   function arguments...
-;;   "[ \t]*(\\([-+/a-zA-Z0-9_=,\* \t\n.()\"'#]*\\))"
-   "[ \t]*(\\([^:#]*\\))"
-   "\\)"                                ; end of def
-   "[ \t]*:"                            ; and then the :
-   "\\)"                                ; >>methods and functions<<
-   )
-  "Regexp for Python methods/functions for use with the Imenu package."
-  )
-
-(defvar py-imenu-method-no-arg-parens '(2 8)
-  "Indices into groups of the Python regexp for use with Imenu.
-
-Using these values will result in smaller Imenu lists, as arguments to
-functions are not listed.
-
-See the variable `py-imenu-show-method-args-p' for more
-information.")
-
-(defvar py-imenu-method-arg-parens '(2 7)
-  "Indices into groups of the Python regexp for use with imenu.
-Using these values will result in large Imenu lists, as arguments to
-functions are listed.
-
-See the variable `py-imenu-show-method-args-p' for more
-information.")
-
-;; Note that in this format, this variable can still be used with the
-;; imenu--generic-function. Otherwise, there is no real reason to have
-;; it.
-(defvar py-imenu-generic-expression
-  (cons
-   (concat 
-    py-imenu-class-regexp
-    "\\|"				; or...
-    py-imenu-method-regexp
-    )
-   py-imenu-method-no-arg-parens)
-  "Generic Python expression which may be used directly with Imenu.
-Used by setting the variable `imenu-generic-expression' to this value.
-Also, see the function \\[py-imenu-create-index] for a better
-alternative for finding the index.")
-
-;; These next two variables are used when searching for the Python
-;; class/definitions. Just saving some time in accessing the
-;; generic-python-expression, really.
-(defvar py-imenu-generic-regexp nil)
-(defvar py-imenu-generic-parens nil)
-
-
-(defun py-imenu-create-index-function ()
-  "Python interface function for the Imenu package.
-Finds all Python classes and functions/methods. Calls function
-\\[py-imenu-create-index-engine].  See that function for the details
-of how this works."
-  (setq py-imenu-generic-regexp (car py-imenu-generic-expression)
-	py-imenu-generic-parens (if py-imenu-show-method-args-p
-				    py-imenu-method-arg-parens
-				  py-imenu-method-no-arg-parens))
-  (goto-char (point-min))
-  ;; Warning: When the buffer has no classes or functions, this will
-  ;; return nil, which seems proper according to the Imenu API, but
-  ;; causes an error in the XEmacs port of Imenu.  Sigh.
-  (py-imenu-create-index-engine nil))
-
-(defun py-imenu-create-index-engine (&optional start-indent)
-  "Function for finding Imenu definitions in Python.
-
-Finds all definitions (classes, methods, or functions) in a Python
-file for the Imenu package.
-
-Returns a possibly nested alist of the form
-
-	(INDEX-NAME . INDEX-POSITION)
-
-The second element of the alist may be an alist, producing a nested
-list as in
-
-	(INDEX-NAME . INDEX-ALIST)
-
-This function should not be called directly, as it calls itself
-recursively and requires some setup.  Rather this is the engine for
-the function \\[py-imenu-create-index-function].
-
-It works recursively by looking for all definitions at the current
-indention level.  When it finds one, it adds it to the alist.  If it
-finds a definition at a greater indentation level, it removes the
-previous definition from the alist. In its place it adds all
-definitions found at the next indentation level.  When it finds a
-definition that is less indented then the current level, it returns
-the alist it has created thus far.
-
-The optional argument START-INDENT indicates the starting indentation
-at which to continue looking for Python classes, methods, or
-functions.  If this is not supplied, the function uses the indentation
-of the first definition found."
-  (let (index-alist
-	sub-method-alist
-	looking-p
-	def-name prev-name
-	cur-indent def-pos
-	(class-paren (first  py-imenu-generic-parens)) 
-	(def-paren   (second py-imenu-generic-parens)))
-    (setq looking-p
-	  (re-search-forward py-imenu-generic-regexp (point-max) t))
-    (while looking-p
-      (save-excursion
-	;; used to set def-name to this value but generic-extract-name
-	;; is new to imenu-1.14. this way it still works with
-	;; imenu-1.11
-	;;(imenu--generic-extract-name py-imenu-generic-parens))
-	(let ((cur-paren (if (match-beginning class-paren)
-			     class-paren def-paren)))
-	  (setq def-name
-		(buffer-substring-no-properties (match-beginning cur-paren)
-						(match-end cur-paren))))
-	(save-match-data
-	  (py-beginning-of-def-or-class 'either))
-	(beginning-of-line)
-	(setq cur-indent (current-indentation)))
-      ;; HACK: want to go to the next correct definition location.  We
-      ;; explicitly list them here but it would be better to have them
-      ;; in a list.
-      (setq def-pos
-	    (or (match-beginning class-paren)
-		(match-beginning def-paren)))
-      ;; if we don't have a starting indent level, take this one
-      (or start-indent
-	  (setq start-indent cur-indent))
-      ;; if we don't have class name yet, take this one
-      (or prev-name
-	  (setq prev-name def-name))
-      ;; what level is the next definition on?  must be same, deeper
-      ;; or shallower indentation
-      (cond
-       ;; Skip code in comments and strings
-       ((py-in-literal))
-       ;; at the same indent level, add it to the list...
-       ((= start-indent cur-indent)
-	(push (cons def-name def-pos) index-alist))
-       ;; deeper indented expression, recurse
-       ((< start-indent cur-indent)
-	;; the point is currently on the expression we're supposed to
-	;; start on, so go back to the last expression. The recursive
-	;; call will find this place again and add it to the correct
-	;; list
-	(re-search-backward py-imenu-generic-regexp (point-min) 'move)
-	(setq sub-method-alist (py-imenu-create-index-engine cur-indent))
-	(if sub-method-alist
-	    ;; we put the last element on the index-alist on the start
-	    ;; of the submethod alist so the user can still get to it.
-	    (let ((save-elmt (pop index-alist)))
-	      (push (cons prev-name
-			  (cons save-elmt sub-method-alist))
-		    index-alist))))
-       ;; found less indented expression, we're done.
-       (t 
-	(setq looking-p nil)
-	(re-search-backward py-imenu-generic-regexp (point-min) t)))
-      ;; end-cond
-      (setq prev-name def-name)
-      (and looking-p
-	   (setq looking-p
-		 (re-search-forward py-imenu-generic-regexp
-				    (point-max) 'move))))
-    (nreverse index-alist)))
-
-
-
-(defun py-choose-shell-by-shebang ()
-  "Choose CPython or JPython mode by looking at #! on the first line.
-Returns the appropriate mode function.
-Used by `py-choose-shell', and similar to but distinct from
-`set-auto-mode', though it uses `auto-mode-interpreter-regexp' (if available)."
-  ;; look for an interpreter specified in the first line
-  ;; similar to set-auto-mode (files.el)
-  (let* ((re (if (boundp 'auto-mode-interpreter-regexp)
-		 auto-mode-interpreter-regexp
-	       ;; stolen from Emacs 21.2
-	       "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)"))
-	 (interpreter (save-excursion
-			(goto-char (point-min))
-			(if (looking-at re)
-			    (match-string 2)
-			  "")))
-	 elt)
-    ;; Map interpreter name to a mode.
-    (setq elt (assoc (file-name-nondirectory interpreter)
-		     py-shell-alist))
-    (and elt (caddr elt))))
-
-
-
-(defun py-choose-shell-by-import ()
-  "Choose CPython or JPython mode based imports.
-If a file imports any packages in `py-jpython-packages', within
-`py-import-check-point-max' characters from the start of the file,
-return `jpython', otherwise return nil."
-  (let (mode)
-    (save-excursion
-      (goto-char (point-min))
-      (while (and (not mode)
-		  (search-forward-regexp
-		   "^\\(\\(from\\)\\|\\(import\\)\\) \\([^ \t\n.]+\\)"
-		   py-import-check-point-max t))
-	(setq mode (and (member (match-string 4) py-jpython-packages)
-			'jpython
-			))))
-    mode))
-
-
-(defun py-choose-shell ()
-  "Choose CPython or JPython mode. Returns the appropriate mode function.
-This does the following:
- - look for an interpreter with `py-choose-shell-by-shebang'
- - examine imports using `py-choose-shell-by-import'
- - default to the variable `py-default-interpreter'"
-  (interactive)
-  (or (py-choose-shell-by-shebang)
-      (py-choose-shell-by-import)
-      py-default-interpreter
-;      'cpython ;; don't use to py-default-interpreter, because default
-;               ;; is only way to choose CPython
-      ))
-
-
-;;;###autoload
-(defun python-mode ()
-  "Major mode for editing Python files.
-To submit a problem report, enter `\\[py-submit-bug-report]' from a
-`python-mode' buffer.  Do `\\[py-describe-mode]' for detailed
-documentation.  To see what version of `python-mode' you are running,
-enter `\\[py-version]'.
-
-This mode knows about Python indentation, tokens, comments and
-continuation lines.  Paragraphs are separated by blank lines only.
-
-COMMANDS
-\\{py-mode-map}
-VARIABLES
-
-py-indent-offset\t\tindentation increment
-py-block-comment-prefix\t\tcomment string used by `comment-region'
-py-python-command\t\tshell command to invoke Python interpreter
-py-temp-directory\t\tdirectory used for temp files (if needed)
-py-beep-if-tab-change\t\tring the bell if `tab-width' is changed"
-  (interactive)
-  ;; set up local variables
-  (kill-all-local-variables)
-  (make-local-variable 'font-lock-defaults)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'require-final-newline)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-end)
-  (make-local-variable 'comment-start-skip)
-  (make-local-variable 'comment-column)
-  (make-local-variable 'comment-indent-function)
-  (make-local-variable 'indent-region-function)
-  (make-local-variable 'indent-line-function)
-  (make-local-variable 'add-log-current-defun-function)
-  (make-local-variable 'fill-paragraph-function)
-  ;;
-  (set-syntax-table py-mode-syntax-table)
-  (setq major-mode              'python-mode
-	mode-name               "Python"
-	local-abbrev-table      python-mode-abbrev-table
-	font-lock-defaults      '(python-font-lock-keywords)
-	paragraph-separate      "^[ \t]*$"
-	paragraph-start         "^[ \t]*$"
-	require-final-newline   t
-	comment-start           "# "
-	comment-end             ""
-	comment-start-skip      "# *"
-	comment-column          40
-	comment-indent-function 'py-comment-indent-function
-	indent-region-function  'py-indent-region
-	indent-line-function    'py-indent-line
-	;; tell add-log.el how to find the current function/method/variable
-	add-log-current-defun-function 'py-current-defun
-
-	fill-paragraph-function 'py-fill-paragraph
-	)
-  (use-local-map py-mode-map)
-  ;; add the menu
-  (if py-menu
-      (easy-menu-add py-menu))
-  ;; Emacs 19 requires this
-  (if (boundp 'comment-multi-line)
-      (setq comment-multi-line nil))
-  ;; Install Imenu if available
-  (when (py-safe (require 'imenu))
-    (setq imenu-create-index-function #'py-imenu-create-index-function)
-    (setq imenu-generic-expression py-imenu-generic-expression)
-    (if (fboundp 'imenu-add-to-menubar)
-	(imenu-add-to-menubar (format "%s-%s" "IM" mode-name)))
-    )
-  ;; Run the mode hook.  Note that py-mode-hook is deprecated.
-  (if python-mode-hook
-      (run-hooks 'python-mode-hook)
-    (run-hooks 'py-mode-hook))
-  ;; Now do the automagical guessing
-  (if py-smart-indentation
-    (let ((offset py-indent-offset))
-      ;; It's okay if this fails to guess a good value
-      (if (and (py-safe (py-guess-indent-offset))
-	       (<= py-indent-offset 8)
-	       (>= py-indent-offset 2))
-	  (setq offset py-indent-offset))
-      (setq py-indent-offset offset)
-      ;; Only turn indent-tabs-mode off if tab-width !=
-      ;; py-indent-offset.  Never turn it on, because the user must
-      ;; have explicitly turned it off.
-      (if (/= tab-width py-indent-offset)
-	  (setq indent-tabs-mode nil))
-      ))
-  ;; Set the default shell if not already set
-  (when (null py-which-shell)
-    (py-toggle-shells (py-choose-shell))))
-
-
-(defun jpython-mode ()
-  "Major mode for editing JPython/Jython files.
-This is a simple wrapper around `python-mode'.
-It runs `jpython-mode-hook' then calls `python-mode.'
-It is added to `interpreter-mode-alist' and `py-choose-shell'.
-"
-  (interactive)
-  (python-mode)
-  (py-toggle-shells 'jpython)
-  (when jpython-mode-hook
-      (run-hooks 'jpython-mode-hook)))
-
-
-;; It's handy to add recognition of Python files to the
-;; interpreter-mode-alist and to auto-mode-alist.  With the former, we
-;; can specify different `derived-modes' based on the #! line, but
-;; with the latter, we can't.  So we just won't add them if they're
-;; already added.
-;;;###autoload
-(let ((modes '(("jpython" . jpython-mode)
-	       ("jython" . jpython-mode)
-	       ("python" . python-mode))))
-  (while modes
-    (when (not (assoc (car modes) interpreter-mode-alist))
-      (push (car modes) interpreter-mode-alist))
-    (setq modes (cdr modes))))
-;;;###autoload
-(when (not (or (rassq 'python-mode auto-mode-alist)
-	       (rassq 'jpython-mode auto-mode-alist)))
-  (push '("\\.py$" . python-mode) auto-mode-alist))
-
-
-
-;; electric characters
-(defun py-outdent-p ()
-  "Returns non-nil if the current line should dedent one level."
-  (save-excursion
-    (and (progn (back-to-indentation)
-		(looking-at py-outdent-re))
-	 ;; short circuit infloop on illegal construct
-	 (not (bobp))
-	 (progn (forward-line -1)
-		(py-goto-initial-line)
-		(back-to-indentation)
-		(while (or (looking-at py-blank-or-comment-re)
-			   (bobp))
-		  (backward-to-indentation 1))
-		(not (looking-at py-no-outdent-re)))
-	 )))
-
-(defun py-electric-colon (arg)
-  "Insert a colon.
-In certain cases the line is dedented appropriately.  If a numeric
-argument ARG is provided, that many colons are inserted
-non-electrically.  Electric behavior is inhibited inside a string or
-comment."
-  (interactive "*P")
-  (self-insert-command (prefix-numeric-value arg))
-  ;; are we in a string or comment?
-  (if (save-excursion
-	(let ((pps (parse-partial-sexp (save-excursion
-					 (py-beginning-of-def-or-class)
-					 (point))
-				       (point))))
-	  (not (or (nth 3 pps) (nth 4 pps)))))
-      (save-excursion
-	(let ((here (point))
-	      (outdent 0)
-	      (indent (py-compute-indentation t)))
-	  (if (and (not arg)
-		   (py-outdent-p)
-		   (= indent (save-excursion
-			       (py-next-statement -1)
-			       (py-compute-indentation t)))
-		   )
-	      (setq outdent py-indent-offset))
-	  ;; Don't indent, only dedent.  This assumes that any lines
-	  ;; that are already dedented relative to
-	  ;; py-compute-indentation were put there on purpose.  It's
-	  ;; highly annoying to have `:' indent for you.  Use TAB, C-c
-	  ;; C-l or C-c C-r to adjust.  TBD: Is there a better way to
-	  ;; determine this???
-	  (if (< (current-indentation) indent) nil
-	    (goto-char here)
-	    (beginning-of-line)
-	    (delete-horizontal-space)
-	    (indent-to (- indent outdent))
-	    )))))
-
-
-;; Python subprocess utilities and filters
-(defun py-execute-file (proc filename)
-  "Send to Python interpreter process PROC \"execfile('FILENAME')\".
-Make that process's buffer visible and force display.  Also make
-comint believe the user typed this string so that
-`kill-output-from-shell' does The Right Thing."
-  (let ((curbuf (current-buffer))
-	(procbuf (process-buffer proc))
-;	(comint-scroll-to-bottom-on-output t)
-	(msg (format "## working on region in file %s...\n" filename))
-	(cmd (format "execfile(r'%s')\n" filename)))
-    (unwind-protect
-	(save-excursion
-	  (set-buffer procbuf)
-	  (goto-char (point-max))
-	  (move-marker (process-mark proc) (point))
-	  (funcall (process-filter proc) proc msg))
-      (set-buffer curbuf))
-    (process-send-string proc cmd)))
-
-(defun py-comint-output-filter-function (string)
-  "Watch output for Python prompt and exec next file waiting in queue.
-This function is appropriate for `comint-output-filter-functions'."
-  ;; TBD: this should probably use split-string
-  (when (and (or (string-equal string ">>> ")
-		 (and (>= (length string) 5)
-		      (string-equal (substring string -5) "\n>>> ")))
-	     py-file-queue)
-    (pop-to-buffer (current-buffer))
-    (py-safe (delete-file (car py-file-queue)))
-    (setq py-file-queue (cdr py-file-queue))
-    (if py-file-queue
-	(let ((pyproc (get-buffer-process (current-buffer))))
-	  (py-execute-file pyproc (car py-file-queue))))
-    ))
-
-(defun py-pdbtrack-overlay-arrow (activation)
-  "Activate or de arrow at beginning-of-line in current buffer."
-  ;; This was derived/simplified from edebug-overlay-arrow
-  (cond (activation
-	 (setq overlay-arrow-position (make-marker))
-	 (setq overlay-arrow-string "=>")
-	 (set-marker overlay-arrow-position (py-point 'bol) (current-buffer))
-	 (setq py-pdbtrack-is-tracking-p t))
-	(overlay-arrow-position
-	 (setq overlay-arrow-position nil)
-	 (setq py-pdbtrack-is-tracking-p nil))
-	))
-
-(defun py-pdbtrack-track-stack-file (text)
-  "Show the file indicated by the pdb stack entry line, in a separate window.
-
-Activity is disabled if the buffer-local variable
-`py-pdbtrack-do-tracking-p' is nil.
-
-We depend on the pdb input prompt matching `py-pdbtrack-input-prompt'
-at the beginning of the line.
-
-If the traceback target file path is invalid, we look for the most
-recently visited python-mode buffer which either has the name of the
-current function \(or class) or which defines the function \(or
-class).  This is to provide for remote scripts, eg, Zope's 'Script
-(Python)' - put a _copy_ of the script in a buffer named for the
-script, and set to python-mode, and pdbtrack will find it.)"
-  ;; Instead of trying to piece things together from partial text
-  ;; (which can be almost useless depending on Emacs version), we
-  ;; monitor to the point where we have the next pdb prompt, and then
-  ;; check all text from comint-last-input-end to process-mark.
-  ;;
-  ;; Also, we're very conservative about clearing the overlay arrow,
-  ;; to minimize residue.  This means, for instance, that executing
-  ;; other pdb commands wipe out the highlight.  You can always do a
-  ;; 'where' (aka 'w') command to reveal the overlay arrow.
-  (let* ((origbuf (current-buffer))
-	 (currproc (get-buffer-process origbuf)))
-
-    (if (not (and currproc py-pdbtrack-do-tracking-p))
-        (py-pdbtrack-overlay-arrow nil)
-
-      (let* ((procmark (process-mark currproc))
-             (block (buffer-substring (max comint-last-input-end
-                                           (- procmark
-                                              py-pdbtrack-track-range))
-                                      procmark))
-             target target_fname target_lineno target_buffer)
-
-        (if (not (string-match (concat py-pdbtrack-input-prompt "$") block))
-            (py-pdbtrack-overlay-arrow nil)
-
-          (setq target (py-pdbtrack-get-source-buffer block))
-
-          (if (stringp target)
-              (message "pdbtrack: %s" target)
-
-            (setq target_lineno (car target))
-            (setq target_buffer (cadr target))
-            (setq target_fname (buffer-file-name target_buffer))
-            (switch-to-buffer-other-window target_buffer)
-            (goto-line target_lineno)
-            (message "pdbtrack: line %s, file %s" target_lineno target_fname)
-            (py-pdbtrack-overlay-arrow t)
-            (pop-to-buffer origbuf t)
-
-            )))))
-  )
-
-(defun py-pdbtrack-get-source-buffer (block)
-  "Return line number and buffer of code indicated by block's traceback text.
-
-We look first to visit the file indicated in the trace.
-
-Failing that, we look for the most recently visited python-mode buffer
-with the same name or having 
-having the named function.
-
-If we're unable find the source code we return a string describing the
-problem as best as we can determine."
-
-  (if (not (string-match py-pdbtrack-stack-entry-regexp block))
-
-      "Traceback cue not found"
-
-    (let* ((filename (match-string 1 block))
-           (lineno (string-to-int (match-string 2 block)))
-           (funcname (match-string 3 block))
-           funcbuffer)
-
-      (cond ((file-exists-p filename)
-             (list lineno (find-file-noselect filename)))
-
-            ((setq funcbuffer (py-pdbtrack-grub-for-buffer funcname lineno))
-             (if (string-match "/Script (Python)$" filename)
-                 ;; Add in number of lines for leading '##' comments:
-                 (setq lineno
-                       (+ lineno
-                          (save-excursion
-                            (set-buffer funcbuffer)
-                            (count-lines
-                             (point-min)
-                             (max (point-min)
-                                  (string-match "^\\([^#]\\|#[^#]\\|#$\\)"
-                                                (buffer-substring (point-min)
-                                                                  (point-max)))
-                                  ))))))
-             (list lineno funcbuffer))
-
-            ((= (elt filename 0) ?\<)
-             (format "(Non-file source: '%s')" filename))
-
-            (t (format "Not found: %s(), %s" funcname filename)))
-      )
-    )
-  )
-
-(defun py-pdbtrack-grub-for-buffer (funcname lineno)
-  "Find most recent buffer itself named or having function funcname.
-
-We first check the last buffer this function found, if any, then walk
-throught the buffer-list history for python-mode buffers that are
-named for funcname or define a function funcname."
-  (let ((buffers (buffer-list))
-        buf
-        got)
-    (while (and buffers (not got))
-      (setq buf (car buffers)
-            buffers (cdr buffers))
-      (if (and (save-excursion (set-buffer buf)
-                               (string= major-mode "python-mode"))
-               (or (string-match funcname (buffer-name buf))
-                   (string-match (concat "^\\s-*\\(def\\|class\\)\\s-+"
-                                         funcname "\\s-*(")
-                                 (save-excursion
-                                   (set-buffer buf)
-                                   (buffer-substring (point-min)
-                                                     (point-max))))))
-          (setq got buf)))
-    (setq py-pdbtrack-last-grubbed-buffer got)))
-
-(defun py-postprocess-output-buffer (buf)
-  "Highlight exceptions found in BUF.
-If an exception occurred return t, otherwise return nil.  BUF must exist."
-  (let (line file bol err-p)
-    (save-excursion
-      (set-buffer buf)
-      (beginning-of-buffer)
-      (while (re-search-forward py-traceback-line-re nil t)
-	(setq file (match-string 1)
-	      line (string-to-int (match-string 2))
-	      bol (py-point 'bol))
-	(py-highlight-line bol (py-point 'eol) file line)))
-    (when (and py-jump-on-exception line)
-      (beep)
-      (py-jump-to-exception file line)
-      (setq err-p t))
-    err-p))
-
-
-
-;;; Subprocess commands
-
-;; only used when (memq 'broken-temp-names py-emacs-features)
-(defvar py-serial-number 0)
-(defvar py-exception-buffer nil)
-(defconst py-output-buffer "*Python Output*")
-(make-variable-buffer-local 'py-output-buffer)
-
-;; for toggling between CPython and JPython
-(defvar py-which-shell nil)
-(defvar py-which-args  py-python-command-args)
-(defvar py-which-bufname "Python")
-(make-variable-buffer-local 'py-which-shell)
-(make-variable-buffer-local 'py-which-args)
-(make-variable-buffer-local 'py-which-bufname)
-
-(defun py-toggle-shells (arg)
-  "Toggles between the CPython and JPython shells.
-
-With positive argument ARG (interactively \\[universal-argument]),
-uses the CPython shell, with negative ARG uses the JPython shell, and
-with a zero argument, toggles the shell.
-
-Programmatically, ARG can also be one of the symbols `cpython' or
-`jpython', equivalent to positive arg and negative arg respectively."
-  (interactive "P")
-  ;; default is to toggle
-  (if (null arg)
-      (setq arg 0))
-  ;; preprocess arg
-  (cond
-   ((equal arg 0)
-    ;; toggle
-    (if (string-equal py-which-bufname "Python")
-	(setq arg -1)
-      (setq arg 1)))
-   ((equal arg 'cpython) (setq arg 1))
-   ((equal arg 'jpython) (setq arg -1)))
-  (let (msg)
-    (cond
-     ((< 0 arg)
-      ;; set to CPython
-      (setq py-which-shell py-python-command
-	    py-which-args py-python-command-args
-	    py-which-bufname "Python"
-	    msg "CPython"
-	    mode-name "Python"))
-     ((> 0 arg)
-      (setq py-which-shell py-jpython-command
-	    py-which-args py-jpython-command-args
-	    py-which-bufname "JPython"
-	    msg "JPython"
-	    mode-name "JPython"))
-     )
-    (message "Using the %s shell" msg)
-    (setq py-output-buffer (format "*%s Output*" py-which-bufname))))
-
-;;;###autoload
-(defun py-shell (&optional argprompt)
-  "Start an interactive Python interpreter in another window.
-This is like Shell mode, except that Python is running in the window
-instead of a shell.  See the `Interactive Shell' and `Shell Mode'
-sections of the Emacs manual for details, especially for the key
-bindings active in the `*Python*' buffer.
-
-With optional \\[universal-argument], the user is prompted for the
-flags to pass to the Python interpreter.  This has no effect when this
-command is used to switch to an existing process, only when a new
-process is started.  If you use this, you will probably want to ensure
-that the current arguments are retained (they will be included in the
-prompt).  This argument is ignored when this function is called
-programmatically, or when running in Emacs 19.34 or older.
-
-Note: You can toggle between using the CPython interpreter and the
-JPython interpreter by hitting \\[py-toggle-shells].  This toggles
-buffer local variables which control whether all your subshell
-interactions happen to the `*JPython*' or `*Python*' buffers (the
-latter is the name used for the CPython buffer).
-
-Warning: Don't use an interactive Python if you change sys.ps1 or
-sys.ps2 from their default values, or if you're running code that
-prints `>>> ' or `... ' at the start of a line.  `python-mode' can't
-distinguish your output from Python's output, and assumes that `>>> '
-at the start of a line is a prompt from Python.  Similarly, the Emacs
-Shell mode code assumes that both `>>> ' and `... ' at the start of a
-line are Python prompts.  Bad things can happen if you fool either
-mode.
-
-Warning:  If you do any editing *in* the process buffer *while* the
-buffer is accepting output from Python, do NOT attempt to `undo' the
-changes.  Some of the output (nowhere near the parts you changed!) may
-be lost if you do.  This appears to be an Emacs bug, an unfortunate
-interaction between undo and process filters; the same problem exists in
-non-Python process buffers using the default (Emacs-supplied) process
-filter."
-  (interactive "P")
-  ;; Set the default shell if not already set
-  (when (null py-which-shell)
-    (py-toggle-shells py-default-interpreter))
-  (let ((args py-which-args))
-    (when (and argprompt
-	       (interactive-p)
-	       (fboundp 'split-string))
-      ;; TBD: Perhaps force "-i" in the final list?
-      (setq args (split-string
-		  (read-string (concat py-which-bufname
-				       " arguments: ")
-			       (concat
-				(mapconcat 'identity py-which-args " ") " ")
-			       ))))
-    (switch-to-buffer-other-window
-     (apply 'make-comint py-which-bufname py-which-shell nil args))
-    (make-local-variable 'comint-prompt-regexp)
-    (setq comint-prompt-regexp "^>>> \\|^[.][.][.] \\|^(pdb) ")
-    (add-hook 'comint-output-filter-functions
-	      'py-comint-output-filter-function)
-    ;; pdbtrack
-    (add-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file)
-    (setq py-pdbtrack-do-tracking-p t)
-    (set-syntax-table py-mode-syntax-table)
-    (use-local-map py-shell-map)
-    (run-hooks 'py-shell-hook)
-    ))
-
-(defun py-clear-queue ()
-  "Clear the queue of temporary files waiting to execute."
-  (interactive)
-  (let ((n (length py-file-queue)))
-    (mapcar 'delete-file py-file-queue)
-    (setq py-file-queue nil)
-    (message "%d pending files de-queued." n)))
-
-
-(defun py-execute-region (start end &optional async)
-  "Execute the region in a Python interpreter.
-
-The region is first copied into a temporary file (in the directory
-`py-temp-directory').  If there is no Python interpreter shell
-running, this file is executed synchronously using
-`shell-command-on-region'.  If the program is long running, use
-\\[universal-argument] to run the command asynchronously in its own
-buffer.
-
-When this function is used programmatically, arguments START and END
-specify the region to execute, and optional third argument ASYNC, if
-non-nil, specifies to run the command asynchronously in its own
-buffer.
-
-If the Python interpreter shell is running, the region is execfile()'d
-in that shell.  If you try to execute regions too quickly,
-`python-mode' will queue them up and execute them one at a time when
-it sees a `>>> ' prompt from Python.  Each time this happens, the
-process buffer is popped into a window (if it's not already in some
-window) so you can see it, and a comment of the form
-
-    \t## working on region in file <name>...
-
-is inserted at the end.  See also the command `py-clear-queue'."
-  (interactive "r\nP")
-  ;; Skip ahead to the first non-blank line
-  (let* ((proc (get-process py-which-bufname))
-	 (temp (if (memq 'broken-temp-names py-emacs-features)
-		   (let
-		       ((sn py-serial-number)
-			(pid (and (fboundp 'emacs-pid) (emacs-pid))))
-		     (setq py-serial-number (1+ py-serial-number))
-		     (if pid
-			 (format "python-%d-%d" sn pid)
-		       (format "python-%d" sn)))
-		 (make-temp-name "python-")))
-	 (file (concat (expand-file-name temp py-temp-directory) ".py"))
-	 (cur (current-buffer))
-	 (buf (get-buffer-create file))
-	 shell)
-    ;; Write the contents of the buffer, watching out for indented regions.
-    (save-excursion
-      (goto-char start)
-      (beginning-of-line)
-      (while (and (looking-at "\\s *$")
-		  (< (point) end))
-	(forward-line 1))
-      (setq start (point))
-      (or (< start end)
-	  (error "Region is empty"))
-      (let ((needs-if (/= (py-point 'bol) (py-point 'boi))))
-	(set-buffer buf)
-	(python-mode)
-	(when needs-if
-	  (insert "if 1:\n"))
-	(insert-buffer-substring cur start end)
-	;; Set the shell either to the #! line command, or to the
-	;; py-which-shell buffer local variable.
-	(setq shell (or (py-choose-shell-by-shebang)
-			(py-choose-shell-by-import)
-			py-which-shell))))
-    (cond
-     ;; always run the code in its own asynchronous subprocess
-     (async
-      ;; User explicitly wants this to run in its own async subprocess
-      (save-excursion
-	(set-buffer buf)
-	(write-region (point-min) (point-max) file nil 'nomsg))
-      (let* ((buf (generate-new-buffer-name py-output-buffer))
-	     ;; TBD: a horrible hack, but why create new Custom variables?
-	     (arg (if (string-equal py-which-bufname "Python")
-		      "-u" "")))
-	(start-process py-which-bufname buf shell arg file)
-	(pop-to-buffer buf)
-	(py-postprocess-output-buffer buf)
-	;; TBD: clean up the temporary file!
-	))
-     ;; if the Python interpreter shell is running, queue it up for
-     ;; execution there.
-     (proc
-      ;; use the existing python shell
-      (save-excursion
-	(set-buffer buf)
-	(write-region (point-min) (point-max) file nil 'nomsg))
-      (if (not py-file-queue)
-	  (py-execute-file proc file)
-	(message "File %s queued for execution" file))
-      (setq py-file-queue (append py-file-queue (list file)))
-      (setq py-exception-buffer (cons file (current-buffer))))
-     (t
-      ;; TBD: a horrible hack, but why create new Custom variables?
-      (let ((cmd (concat shell (if (string-equal py-which-bufname "JPython")
-				   " -" ""))))
-	;; otherwise either run it synchronously in a subprocess
-	(save-excursion
-	  (set-buffer buf)
-	  (shell-command-on-region (point-min) (point-max)
-				   cmd py-output-buffer))
-	;; shell-command-on-region kills the output buffer if it never
-	;; existed and there's no output from the command
-	(if (not (get-buffer py-output-buffer))
-	    (message "No output.")
-	  (setq py-exception-buffer (current-buffer))
-	  (let ((err-p (py-postprocess-output-buffer py-output-buffer)))
-	    (pop-to-buffer py-output-buffer)
-	    (if err-p
-		(pop-to-buffer py-exception-buffer)))
-	  ))
-      ))
-    ;; Clean up after ourselves.
-    (kill-buffer buf)))
-
-
-;; Code execution commands
-(defun py-execute-buffer (&optional async)
-  "Send the contents of the buffer to a Python interpreter.
-If the file local variable `py-master-file' is non-nil, execute the
-named file instead of the buffer's file.
-
-If there is a *Python* process buffer it is used.  If a clipping
-restriction is in effect, only the accessible portion of the buffer is
-sent.  A trailing newline will be supplied if needed.
-
-See the `\\[py-execute-region]' docs for an account of some
-subtleties, including the use of the optional ASYNC argument."
-  (interactive "P")
-  (if py-master-file
-      (let* ((filename (expand-file-name py-master-file))
-	     (buffer (or (get-file-buffer filename)
-			 (find-file-noselect filename))))
-	(set-buffer buffer)))
-  (py-execute-region (point-min) (point-max) async))
-
-(defun py-execute-import-or-reload (&optional async)
-  "Import the current buffer's file in a Python interpreter.
-
-If the file has already been imported, then do reload instead to get
-the latest version.
-
-If the file's name does not end in \".py\", then do execfile instead.
-
-If the current buffer is not visiting a file, do `py-execute-buffer'
-instead.
-
-If the file local variable `py-master-file' is non-nil, import or
-reload the named file instead of the buffer's file.  The file may be
-saved based on the value of `py-execute-import-or-reload-save-p'.
-
-See the `\\[py-execute-region]' docs for an account of some
-subtleties, including the use of the optional ASYNC argument.
-
-This may be preferable to `\\[py-execute-buffer]' because:
-
- - Definitions stay in their module rather than appearing at top
-   level, where they would clutter the global namespace and not affect
-   uses of qualified names (MODULE.NAME).
-
- - The Python debugger gets line number information about the functions."
-  (interactive "P")
-  ;; Check file local variable py-master-file
-  (if py-master-file
-      (let* ((filename (expand-file-name py-master-file))
-             (buffer (or (get-file-buffer filename)
-                         (find-file-noselect filename))))
-        (set-buffer buffer)))
-  (let ((file (buffer-file-name (current-buffer))))
-    (if file
-        (progn
-	  ;; Maybe save some buffers
-	  (save-some-buffers (not py-ask-about-save) nil)
-          (py-execute-string
-           (if (string-match "\\.py$" file)
-               (let ((f (file-name-sans-extension
-			 (file-name-nondirectory file))))
-                 (format "if globals().has_key('%s'):\n    reload(%s)\nelse:\n    import %s\n"
-                         f f f))
-             (format "execfile(r'%s')\n" file))
-           async))
-      ;; else
-      (py-execute-buffer async))))
-
-
-(defun py-execute-def-or-class (&optional async)
-  "Send the current function or class definition to a Python interpreter.
-
-If there is a *Python* process buffer it is used.
-
-See the `\\[py-execute-region]' docs for an account of some
-subtleties, including the use of the optional ASYNC argument."
-  (interactive "P")
-  (save-excursion
-    (py-mark-def-or-class)
-    ;; mark is before point
-    (py-execute-region (mark) (point) async)))
-
-
-(defun py-execute-string (string &optional async)
-  "Send the argument STRING to a Python interpreter.
-
-If there is a *Python* process buffer it is used.
-
-See the `\\[py-execute-region]' docs for an account of some
-subtleties, including the use of the optional ASYNC argument."
-  (interactive "sExecute Python command: ")
-  (save-excursion
-    (set-buffer (get-buffer-create
-                 (generate-new-buffer-name " *Python Command*")))
-    (insert string)
-    (py-execute-region (point-min) (point-max) async)))
-
-
-
-(defun py-jump-to-exception (file line)
-  "Jump to the Python code in FILE at LINE."
-  (let ((buffer (cond ((string-equal file "<stdin>")
-		       (if (consp py-exception-buffer)
-			   (cdr py-exception-buffer)
-			 py-exception-buffer))
-		      ((and (consp py-exception-buffer)
-			    (string-equal file (car py-exception-buffer)))
-		       (cdr py-exception-buffer))
-		      ((py-safe (find-file-noselect file)))
-		      ;; could not figure out what file the exception
-		      ;; is pointing to, so prompt for it
-		      (t (find-file (read-file-name "Exception file: "
-						    nil
-						    file t))))))
-    (pop-to-buffer buffer)
-    ;; Force Python mode
-    (if (not (eq major-mode 'python-mode))
-	(python-mode))
-    (goto-line line)
-    (message "Jumping to exception in file %s on line %d" file line)))
-
-(defun py-mouseto-exception (event)
-  "Jump to the code which caused the Python exception at EVENT.
-EVENT is usually a mouse click."
-  (interactive "e")
-  (cond
-   ((fboundp 'event-point)
-    ;; XEmacs
-    (let* ((point (event-point event))
-	   (buffer (event-buffer event))
-	   (e (and point buffer (extent-at point buffer 'py-exc-info)))
-	   (info (and e (extent-property e 'py-exc-info))))
-      (message "Event point: %d, info: %s" point info)
-      (and info
-	   (py-jump-to-exception (car info) (cdr info)))
-      ))
-   ;; Emacs -- Please port this!
-   ))
-
-(defun py-goto-exception ()
-  "Go to the line indicated by the traceback."
-  (interactive)
-  (let (file line)
-    (save-excursion
-      (beginning-of-line)
-      (if (looking-at py-traceback-line-re)
-	  (setq file (match-string 1)
-		line (string-to-int (match-string 2)))))
-    (if (not file)
-	(error "Not on a traceback line"))
-    (py-jump-to-exception file line)))
-
-(defun py-find-next-exception (start buffer searchdir errwhere)
-  "Find the next Python exception and jump to the code that caused it.
-START is the buffer position in BUFFER from which to begin searching
-for an exception.  SEARCHDIR is a function, either
-`re-search-backward' or `re-search-forward' indicating the direction
-to search.  ERRWHERE is used in an error message if the limit (top or
-bottom) of the trackback stack is encountered."
-  (let (file line)
-    (save-excursion
-      (set-buffer buffer)
-      (goto-char (py-point start))
-      (if (funcall searchdir py-traceback-line-re nil t)
-	  (setq file (match-string 1)
-		line (string-to-int (match-string 2)))))
-    (if (and file line)
-	(py-jump-to-exception file line)
-      (error "%s of traceback" errwhere))))
-
-(defun py-down-exception (&optional bottom)
-  "Go to the next line down in the traceback.
-With \\[univeral-argument] (programmatically, optional argument
-BOTTOM), jump to the bottom (innermost) exception in the exception
-stack."
-  (interactive "P")
-  (let* ((proc (get-process "Python"))
-	 (buffer (if proc "*Python*" py-output-buffer)))
-    (if bottom
-	(py-find-next-exception 'eob buffer 're-search-backward "Bottom")
-      (py-find-next-exception 'eol buffer 're-search-forward "Bottom"))))
-
-(defun py-up-exception (&optional top)
-  "Go to the previous line up in the traceback.
-With \\[universal-argument] (programmatically, optional argument TOP)
-jump to the top (outermost) exception in the exception stack."
-  (interactive "P")
-  (let* ((proc (get-process "Python"))
-	 (buffer (if proc "*Python*" py-output-buffer)))
-    (if top
-	(py-find-next-exception 'bob buffer 're-search-forward "Top")
-      (py-find-next-exception 'bol buffer 're-search-backward "Top"))))
-
-
-;; Electric deletion
-(defun py-electric-backspace (arg)
-  "Delete preceding character or levels of indentation.
-Deletion is performed by calling the function in `py-backspace-function'
-with a single argument (the number of characters to delete).
-
-If point is at the leftmost column, delete the preceding newline.
-
-Otherwise, if point is at the leftmost non-whitespace character of a
-line that is neither a continuation line nor a non-indenting comment
-line, or if point is at the end of a blank line, this command reduces
-the indentation to match that of the line that opened the current
-block of code.  The line that opened the block is displayed in the
-echo area to help you keep track of where you are.  With
-\\[universal-argument] dedents that many blocks (but not past column
-zero).
-
-Otherwise the preceding character is deleted, converting a tab to
-spaces if needed so that only a single column position is deleted.
-\\[universal-argument] specifies how many characters to delete;
-default is 1.
-
-When used programmatically, argument ARG specifies the number of
-blocks to dedent, or the number of characters to delete, as indicated
-above."
-  (interactive "*p")
-  (if (or (/= (current-indentation) (current-column))
-	  (bolp)
-	  (py-continuation-line-p)
-;	  (not py-honor-comment-indentation)
-;	  (looking-at "#[^ \t\n]")	; non-indenting #
-	  )
-      (funcall py-backspace-function arg)
-    ;; else indent the same as the colon line that opened the block
-    ;; force non-blank so py-goto-block-up doesn't ignore it
-    (insert-char ?* 1)
-    (backward-char)
-    (let ((base-indent 0)		; indentation of base line
-	  (base-text "")		; and text of base line
-	  (base-found-p nil))
-      (save-excursion
-	(while (< 0 arg)
-	  (condition-case nil		; in case no enclosing block
-	      (progn
-		(py-goto-block-up 'no-mark)
-		(setq base-indent (current-indentation)
-		      base-text   (py-suck-up-leading-text)
-		      base-found-p t))
-	    (error nil))
-	  (setq arg (1- arg))))
-      (delete-char 1)			; toss the dummy character
-      (delete-horizontal-space)
-      (indent-to base-indent)
-      (if base-found-p
-	  (message "Closes block: %s" base-text)))))
-
-
-(defun py-electric-delete (arg)
-  "Delete preceding or following character or levels of whitespace.
-
-The behavior of this function depends on the variable
-`delete-key-deletes-forward'.  If this variable is nil (or does not
-exist, as in older Emacsen and non-XEmacs versions), then this
-function behaves identically to \\[c-electric-backspace].
-
-If `delete-key-deletes-forward' is non-nil and is supported in your
-Emacs, then deletion occurs in the forward direction, by calling the
-function in `py-delete-function'.
-
-\\[universal-argument] (programmatically, argument ARG) specifies the
-number of characters to delete (default is 1)."
-  (interactive "*p")
-  (if (or (and (fboundp 'delete-forward-p) ;XEmacs 21
-	       (delete-forward-p))
-	  (and (boundp 'delete-key-deletes-forward) ;XEmacs 20
-	       delete-key-deletes-forward))
-      (funcall py-delete-function arg)
-    (py-electric-backspace arg)))
-
-;; required for pending-del and delsel modes
-(put 'py-electric-colon 'delete-selection t) ;delsel
-(put 'py-electric-colon 'pending-delete   t) ;pending-del
-(put 'py-electric-backspace 'delete-selection 'supersede) ;delsel
-(put 'py-electric-backspace 'pending-delete   'supersede) ;pending-del
-(put 'py-electric-delete    'delete-selection 'supersede) ;delsel
-(put 'py-electric-delete    'pending-delete   'supersede) ;pending-del
-
-
-
-(defun py-indent-line (&optional arg)
-  "Fix the indentation of the current line according to Python rules.
-With \\[universal-argument] (programmatically, the optional argument
-ARG non-nil), ignore dedenting rules for block closing statements
-(e.g. return, raise, break, continue, pass)
-
-This function is normally bound to `indent-line-function' so
-\\[indent-for-tab-command] will call it."
-  (interactive "P")
-  (let* ((ci (current-indentation))
-	 (move-to-indentation-p (<= (current-column) ci))
-	 (need (py-compute-indentation (not arg))))
-    ;; see if we need to dedent
-    (if (py-outdent-p)
-	(setq need (- need py-indent-offset)))
-    (if (/= ci need)
-	(save-excursion
-	  (beginning-of-line)
-	  (delete-horizontal-space)
-	  (indent-to need)))
-    (if move-to-indentation-p (back-to-indentation))))
-
-(defun py-newline-and-indent ()
-  "Strives to act like the Emacs `newline-and-indent'.
-This is just `strives to' because correct indentation can't be computed
-from scratch for Python code.  In general, deletes the whitespace before
-point, inserts a newline, and takes an educated guess as to how you want
-the new line indented."
-  (interactive)
-  (let ((ci (current-indentation)))
-    (if (< ci (current-column))		; if point beyond indentation
-	(newline-and-indent)
-      ;; else try to act like newline-and-indent "normally" acts
-      (beginning-of-line)
-      (insert-char ?\n 1)
-      (move-to-column ci))))
-
-(defun py-compute-indentation (honor-block-close-p)
-  "Compute Python indentation.
-When HONOR-BLOCK-CLOSE-P is non-nil, statements such as `return',
-`raise', `break', `continue', and `pass' force one level of
-dedenting."
-  (save-excursion
-    (beginning-of-line)
-    (let* ((bod (py-point 'bod))
-	   (pps (parse-partial-sexp bod (point)))
-	   (boipps (parse-partial-sexp bod (py-point 'boi)))
-	   placeholder)
-      (cond
-       ;; are we inside a multi-line string or comment?
-       ((or (and (nth 3 pps) (nth 3 boipps))
-	    (and (nth 4 pps) (nth 4 boipps)))
-	(save-excursion
-	  (if (not py-align-multiline-strings-p) 0
-	    ;; skip back over blank & non-indenting comment lines
-	    ;; note: will skip a blank or non-indenting comment line
-	    ;; that happens to be a continuation line too
-	    (re-search-backward "^[ \t]*\\([^ \t\n#]\\|#[ \t\n]\\)" nil 'move)
-	    (back-to-indentation)
-	    (current-column))))
-       ;; are we on a continuation line?
-       ((py-continuation-line-p)
-	(let ((startpos (point))
-	      (open-bracket-pos (py-nesting-level))
-	      endpos searching found state)
-	  (if open-bracket-pos
-	      (progn
-		;; align with first item in list; else a normal
-		;; indent beyond the line with the open bracket
-		(goto-char (1+ open-bracket-pos)) ; just beyond bracket
-		;; is the first list item on the same line?
-		(skip-chars-forward " \t")
-		(if (null (memq (following-char) '(?\n ?# ?\\)))
-					; yes, so line up with it
-		    (current-column)
-		  ;; first list item on another line, or doesn't exist yet
-		  (forward-line 1)
-		  (while (and (< (point) startpos)
-			      (looking-at "[ \t]*[#\n\\\\]")) ; skip noise
-		    (forward-line 1))
-		  (if (and (< (point) startpos)
-			   (/= startpos
-			       (save-excursion
-				 (goto-char (1+ open-bracket-pos))
-				 (forward-comment (point-max))
-				 (point))))
-		      ;; again mimic the first list item
-		      (current-indentation)
-		    ;; else they're about to enter the first item
-		    (goto-char open-bracket-pos)
-		    (setq placeholder (point))
-		    (py-goto-initial-line)
-		    (py-goto-beginning-of-tqs
-		     (save-excursion (nth 3 (parse-partial-sexp
-					     placeholder (point)))))
-		    (+ (current-indentation) py-indent-offset))))
-
-	    ;; else on backslash continuation line
-	    (forward-line -1)
-	    (if (py-continuation-line-p) ; on at least 3rd line in block
-		(current-indentation)	; so just continue the pattern
-	      ;; else started on 2nd line in block, so indent more.
-	      ;; if base line is an assignment with a start on a RHS,
-	      ;; indent to 2 beyond the leftmost "="; else skip first
-	      ;; chunk of non-whitespace characters on base line, + 1 more
-	      ;; column
-	      (end-of-line)
-	      (setq endpos (point)
-		    searching t)
-	      (back-to-indentation)
-	      (setq startpos (point))
-	      ;; look at all "=" from left to right, stopping at first
-	      ;; one not nested in a list or string
-	      (while searching
-		(skip-chars-forward "^=" endpos)
-		(if (= (point) endpos)
-		    (setq searching nil)
-		  (forward-char 1)
-		  (setq state (parse-partial-sexp startpos (point)))
-		  (if (and (zerop (car state)) ; not in a bracket
-			   (null (nth 3 state))) ; & not in a string
-		      (progn
-			(setq searching nil) ; done searching in any case
-			(setq found
-			      (not (or
-				    (eq (following-char) ?=)
-				    (memq (char-after (- (point) 2))
-					  '(?< ?> ?!)))))))))
-	      (if (or (not found)	; not an assignment
-		      (looking-at "[ \t]*\\\\")) ; <=><spaces><backslash>
-		  (progn
-		    (goto-char startpos)
-		    (skip-chars-forward "^ \t\n")))
-	      ;; if this is a continuation for a block opening
-	      ;; statement, add some extra offset.
-	      (+ (current-column) (if (py-statement-opens-block-p)
-				      py-continuation-offset 0)
-		 1)
-	      ))))
-
-       ;; not on a continuation line
-       ((bobp) (current-indentation))
-
-       ;; Dfn: "Indenting comment line".  A line containing only a
-       ;; comment, but which is treated like a statement for
-       ;; indentation calculation purposes.  Such lines are only
-       ;; treated specially by the mode; they are not treated
-       ;; specially by the Python interpreter.
-
-       ;; The rules for indenting comment lines are a line where:
-       ;;   - the first non-whitespace character is `#', and
-       ;;   - the character following the `#' is whitespace, and
-       ;;   - the line is dedented with respect to (i.e. to the left
-       ;;     of) the indentation of the preceding non-blank line.
-
-       ;; The first non-blank line following an indenting comment
-       ;; line is given the same amount of indentation as the
-       ;; indenting comment line.
-
-       ;; All other comment-only lines are ignored for indentation
-       ;; purposes.
-
-       ;; Are we looking at a comment-only line which is *not* an
-       ;; indenting comment line?  If so, we assume that it's been
-       ;; placed at the desired indentation, so leave it alone.
-       ;; Indenting comment lines are aligned as statements down
-       ;; below.
-       ((and (looking-at "[ \t]*#[^ \t\n]")
-	     ;; NOTE: this test will not be performed in older Emacsen
-	     (fboundp 'forward-comment)
-	     (<= (current-indentation)
-		 (save-excursion
-		   (forward-comment (- (point-max)))
-		   (current-indentation))))
-	(current-indentation))
-
-       ;; else indentation based on that of the statement that
-       ;; precedes us; use the first line of that statement to
-       ;; establish the base, in case the user forced a non-std
-       ;; indentation for the continuation lines (if any)
-       (t
-	;; skip back over blank & non-indenting comment lines note:
-	;; will skip a blank or non-indenting comment line that
-	;; happens to be a continuation line too.  use fast Emacs 19
-	;; function if it's there.
-	(if (and (eq py-honor-comment-indentation nil)
-		 (fboundp 'forward-comment))
-	    (forward-comment (- (point-max)))
-	  (let ((prefix-re (concat py-block-comment-prefix "[ \t]*"))
-		done)
-	    (while (not done)
-	      (re-search-backward "^[ \t]*\\([^ \t\n#]\\|#\\)" nil 'move)
-	      (setq done (or (bobp)
-			     (and (eq py-honor-comment-indentation t)
-				  (save-excursion
-				    (back-to-indentation)
-				    (not (looking-at prefix-re))
-				    ))
-			     (and (not (eq py-honor-comment-indentation t))
-				  (save-excursion
-				    (back-to-indentation)
-				    (and (not (looking-at prefix-re))
-					 (or (looking-at "[^#]")
-					     (not (zerop (current-column)))
-					     ))
-				    ))
-			     ))
-	      )))
-	;; if we landed inside a string, go to the beginning of that
-	;; string. this handles triple quoted, multi-line spanning
-	;; strings.
-	(py-goto-beginning-of-tqs (nth 3 (parse-partial-sexp bod (point))))
-	;; now skip backward over continued lines
-	(setq placeholder (point))
-	(py-goto-initial-line)
-	;; we may *now* have landed in a TQS, so find the beginning of
-	;; this string.
-	(py-goto-beginning-of-tqs
-	 (save-excursion (nth 3 (parse-partial-sexp
-				 placeholder (point)))))
-	(+ (current-indentation)
-	   (if (py-statement-opens-block-p)
-	       py-indent-offset
-	     (if (and honor-block-close-p (py-statement-closes-block-p))
-		 (- py-indent-offset)
-	       0)))
-	)))))
-
-(defun py-guess-indent-offset (&optional global)
-  "Guess a good value for, and change, `py-indent-offset'.
-
-By default, make a buffer-local copy of `py-indent-offset' with the
-new value, so that other Python buffers are not affected.  With
-\\[universal-argument] (programmatically, optional argument GLOBAL),
-change the global value of `py-indent-offset'.  This affects all
-Python buffers (that don't have their own buffer-local copy), both
-those currently existing and those created later in the Emacs session.
-
-Some people use a different value for `py-indent-offset' than you use.
-There's no excuse for such foolishness, but sometimes you have to deal
-with their ugly code anyway.  This function examines the file and sets
-`py-indent-offset' to what it thinks it was when they created the
-mess.
-
-Specifically, it searches forward from the statement containing point,
-looking for a line that opens a block of code.  `py-indent-offset' is
-set to the difference in indentation between that line and the Python
-statement following it.  If the search doesn't succeed going forward,
-it's tried again going backward."
-  (interactive "P")			; raw prefix arg
-  (let (new-value
-	(start (point))
-	(restart (point))
-	(found nil)
-	colon-indent)
-    (py-goto-initial-line)
-    (while (not (or found (eobp)))
-      (when (and (re-search-forward ":[ \t]*\\($\\|[#\\]\\)" nil 'move)
-		 (not (py-in-literal restart)))
-	(setq restart (point))
-	(py-goto-initial-line)
-	(if (py-statement-opens-block-p)
-	    (setq found t)
-	  (goto-char restart))))
-    (unless found
-      (goto-char start)
-      (py-goto-initial-line)
-      (while (not (or found (bobp)))
-	(setq found (and
-		     (re-search-backward ":[ \t]*\\($\\|[#\\]\\)" nil 'move)
-		     (or (py-goto-initial-line) t) ; always true -- side effect
-		     (py-statement-opens-block-p)))))
-    (setq colon-indent (current-indentation)
-	  found (and found (zerop (py-next-statement 1)))
-	  new-value (- (current-indentation) colon-indent))
-    (goto-char start)
-    (if (not found)
-	(error "Sorry, couldn't guess a value for py-indent-offset")
-      (funcall (if global 'kill-local-variable 'make-local-variable)
-	       'py-indent-offset)
-      (setq py-indent-offset new-value)
-      (or noninteractive
-	  (message "%s value of py-indent-offset set to %d"
-		   (if global "Global" "Local")
-		   py-indent-offset)))
-    ))
-
-(defun py-comment-indent-function ()
-  "Python version of `comment-indent-function'."
-  ;; This is required when filladapt is turned off.  Without it, when
-  ;; filladapt is not used, comments which start in column zero
-  ;; cascade one character to the right
-  (save-excursion
-    (beginning-of-line)
-    (let ((eol (py-point 'eol)))
-      (and comment-start-skip
-	   (re-search-forward comment-start-skip eol t)
-	   (setq eol (match-beginning 0)))
-      (goto-char eol)
-      (skip-chars-backward " \t")
-      (max comment-column (+ (current-column) (if (bolp) 0 1)))
-      )))
-
-(defun py-narrow-to-defun (&optional class)
-  "Make text outside current defun invisible.
-The defun visible is the one that contains point or follows point.
-Optional CLASS is passed directly to `py-beginning-of-def-or-class'."
-  (interactive "P")
-  (save-excursion
-    (widen)
-    (py-end-of-def-or-class class)
-    (let ((end (point)))
-      (py-beginning-of-def-or-class class)
-      (narrow-to-region (point) end))))
-
-
-(defun py-shift-region (start end count)
-  "Indent lines from START to END by COUNT spaces."
-  (save-excursion
-    (goto-char end)
-    (beginning-of-line)
-    (setq end (point))
-    (goto-char start)
-    (beginning-of-line)
-    (setq start (point))
-    (indent-rigidly start end count)))
-
-(defun py-shift-region-left (start end &optional count)
-  "Shift region of Python code to the left.
-The lines from the line containing the start of the current region up
-to (but not including) the line containing the end of the region are
-shifted to the left, by `py-indent-offset' columns.
-
-If a prefix argument is given, the region is instead shifted by that
-many columns.  With no active region, dedent only the current line.
-You cannot dedent the region if any line is already at column zero."
-  (interactive
-   (let ((p (point))
-	 (m (mark))
-	 (arg current-prefix-arg))
-     (if m
-	 (list (min p m) (max p m) arg)
-       (list p (save-excursion (forward-line 1) (point)) arg))))
-  ;; if any line is at column zero, don't shift the region
-  (save-excursion
-    (goto-char start)
-    (while (< (point) end)
-      (back-to-indentation)
-      (if (and (zerop (current-column))
-	       (not (looking-at "\\s *$")))
-	  (error "Region is at left edge"))
-      (forward-line 1)))
-  (py-shift-region start end (- (prefix-numeric-value
-				 (or count py-indent-offset))))
-  (py-keep-region-active))
-
-(defun py-shift-region-right (start end &optional count)
-  "Shift region of Python code to the right.
-The lines from the line containing the start of the current region up
-to (but not including) the line containing the end of the region are
-shifted to the right, by `py-indent-offset' columns.
-
-If a prefix argument is given, the region is instead shifted by that
-many columns.  With no active region, indent only the current line."
-  (interactive
-   (let ((p (point))
-	 (m (mark))
-	 (arg current-prefix-arg))
-     (if m
-	 (list (min p m) (max p m) arg)
-       (list p (save-excursion (forward-line 1) (point)) arg))))
-  (py-shift-region start end (prefix-numeric-value
-			      (or count py-indent-offset)))
-  (py-keep-region-active))
-
-(defun py-indent-region (start end &optional indent-offset)
-  "Reindent a region of Python code.
-
-The lines from the line containing the start of the current region up
-to (but not including) the line containing the end of the region are
-reindented.  If the first line of the region has a non-whitespace
-character in the first column, the first line is left alone and the
-rest of the region is reindented with respect to it.  Else the entire
-region is reindented with respect to the (closest code or indenting
-comment) statement immediately preceding the region.
-
-This is useful when code blocks are moved or yanked, when enclosing
-control structures are introduced or removed, or to reformat code
-using a new value for the indentation offset.
-
-If a numeric prefix argument is given, it will be used as the value of
-the indentation offset.  Else the value of `py-indent-offset' will be
-used.
-
-Warning: The region must be consistently indented before this function
-is called!  This function does not compute proper indentation from
-scratch (that's impossible in Python), it merely adjusts the existing
-indentation to be correct in context.
-
-Warning: This function really has no idea what to do with
-non-indenting comment lines, and shifts them as if they were indenting
-comment lines.  Fixing this appears to require telepathy.
-
-Special cases: whitespace is deleted from blank lines; continuation
-lines are shifted by the same amount their initial line was shifted,
-in order to preserve their relative indentation with respect to their
-initial line; and comment lines beginning in column 1 are ignored."
-  (interactive "*r\nP")			; region; raw prefix arg
-  (save-excursion
-    (goto-char end)   (beginning-of-line) (setq end (point-marker))
-    (goto-char start) (beginning-of-line)
-    (let ((py-indent-offset (prefix-numeric-value
-			     (or indent-offset py-indent-offset)))
-	  (indents '(-1))		; stack of active indent levels
-	  (target-column 0)		; column to which to indent
-	  (base-shifted-by 0)		; amount last base line was shifted
-	  (indent-base (if (looking-at "[ \t\n]")
-			   (py-compute-indentation t)
-			 0))
-	  ci)
-      (while (< (point) end)
-	(setq ci (current-indentation))
-	;; figure out appropriate target column
-	(cond
-	 ((or (eq (following-char) ?#)	; comment in column 1
-	      (looking-at "[ \t]*$"))	; entirely blank
-	  (setq target-column 0))
-	 ((py-continuation-line-p)	; shift relative to base line
-	  (setq target-column (+ ci base-shifted-by)))
-	 (t				; new base line
-	  (if (> ci (car indents))	; going deeper; push it
-	      (setq indents (cons ci indents))
-	    ;; else we should have seen this indent before
-	    (setq indents (memq ci indents)) ; pop deeper indents
-	    (if (null indents)
-		(error "Bad indentation in region, at line %d"
-		       (save-restriction
-			 (widen)
-			 (1+ (count-lines 1 (point)))))))
-	  (setq target-column (+ indent-base
-				 (* py-indent-offset
-				    (- (length indents) 2))))
-	  (setq base-shifted-by (- target-column ci))))
-	;; shift as needed
-	(if (/= ci target-column)
-	    (progn
-	      (delete-horizontal-space)
-	      (indent-to target-column)))
-	(forward-line 1))))
-  (set-marker end nil))
-
-(defun py-comment-region (beg end &optional arg)
-  "Like `comment-region' but uses double hash (`#') comment starter."
-  (interactive "r\nP")
-  (let ((comment-start py-block-comment-prefix))
-    (comment-region beg end arg)))
-
-
-;; Functions for moving point
-(defun py-previous-statement (count)
-  "Go to the start of the COUNTth preceding Python statement.
-By default, goes to the previous statement.  If there is no such
-statement, goes to the first statement.  Return count of statements
-left to move.  `Statements' do not include blank, comment, or
-continuation lines."
-  (interactive "p")			; numeric prefix arg
-  (if (< count 0) (py-next-statement (- count))
-    (py-goto-initial-line)
-    (let (start)
-      (while (and
-	      (setq start (point))	; always true -- side effect
-	      (> count 0)
-	      (zerop (forward-line -1))
-	      (py-goto-statement-at-or-above))
-	(setq count (1- count)))
-      (if (> count 0) (goto-char start)))
-    count))
-
-(defun py-next-statement (count)
-  "Go to the start of next Python statement.
-If the statement at point is the i'th Python statement, goes to the
-start of statement i+COUNT.  If there is no such statement, goes to the
-last statement.  Returns count of statements left to move.  `Statements'
-do not include blank, comment, or continuation lines."
-  (interactive "p")			; numeric prefix arg
-  (if (< count 0) (py-previous-statement (- count))
-    (beginning-of-line)
-    (let (start)
-      (while (and
-	      (setq start (point))	; always true -- side effect
-	      (> count 0)
-	      (py-goto-statement-below))
-	(setq count (1- count)))
-      (if (> count 0) (goto-char start)))
-    count))
-
-(defun py-goto-block-up (&optional nomark)
-  "Move up to start of current block.
-Go to the statement that starts the smallest enclosing block; roughly
-speaking, this will be the closest preceding statement that ends with a
-colon and is indented less than the statement you started on.  If
-successful, also sets the mark to the starting point.
-
-`\\[py-mark-block]' can be used afterward to mark the whole code
-block, if desired.
-
-If called from a program, the mark will not be set if optional argument
-NOMARK is not nil."
-  (interactive)
-  (let ((start (point))
-	(found nil)
-	initial-indent)
-    (py-goto-initial-line)
-    ;; if on blank or non-indenting comment line, use the preceding stmt
-    (if (looking-at "[ \t]*\\($\\|#[^ \t\n]\\)")
-	(progn
-	  (py-goto-statement-at-or-above)
-	  (setq found (py-statement-opens-block-p))))
-    ;; search back for colon line indented less
-    (setq initial-indent (current-indentation))
-    (if (zerop initial-indent)
-	;; force fast exit
-	(goto-char (point-min)))
-    (while (not (or found (bobp)))
-      (setq found
-	    (and
-	     (re-search-backward ":[ \t]*\\($\\|[#\\]\\)" nil 'move)
-	     (or (py-goto-initial-line) t) ; always true -- side effect
-	     (< (current-indentation) initial-indent)
-	     (py-statement-opens-block-p))))
-    (if found
-	(progn
-	  (or nomark (push-mark start))
-	  (back-to-indentation))
-      (goto-char start)
-      (error "Enclosing block not found"))))
-
-(defun py-beginning-of-def-or-class (&optional class count)
-  "Move point to start of `def' or `class'.
-
-Searches back for the closest preceding `def'.  If you supply a prefix
-arg, looks for a `class' instead.  The docs below assume the `def'
-case; just substitute `class' for `def' for the other case.
-Programmatically, if CLASS is `either', then moves to either `class'
-or `def'.
-
-When second optional argument is given programmatically, move to the
-COUNTth start of `def'.
-
-If point is in a `def' statement already, and after the `d', simply
-moves point to the start of the statement.
-
-Otherwise (i.e. when point is not in a `def' statement, or at or
-before the `d' of a `def' statement), searches for the closest
-preceding `def' statement, and leaves point at its start.  If no such
-statement can be found, leaves point at the start of the buffer.
-
-Returns t iff a `def' statement is found by these rules.
-
-Note that doing this command repeatedly will take you closer to the
-start of the buffer each time.
-
-To mark the current `def', see `\\[py-mark-def-or-class]'."
-  (interactive "P")			; raw prefix arg
-  (setq count (or count 1))
-  (let ((at-or-before-p (<= (current-column) (current-indentation)))
-	(start-of-line (goto-char (py-point 'bol)))
-	(start-of-stmt (goto-char (py-point 'bos)))
-	(start-re (cond ((eq class 'either) "^[ \t]*\\(class\\|def\\)\\>")
-			(class "^[ \t]*class\\>")
-			(t "^[ \t]*def\\>")))
-	)
-    ;; searching backward
-    (if (and (< 0 count)
-	     (or (/= start-of-stmt start-of-line)
-		 (not at-or-before-p)))
-	(end-of-line))
-    ;; search forward
-    (if (and (> 0 count)
-	     (zerop (current-column))
-	     (looking-at start-re))
-	(end-of-line))
-    (if (re-search-backward start-re nil 'move count)
-	(goto-char (match-beginning 0)))))
-
-;; Backwards compatibility
-(defalias 'beginning-of-python-def-or-class 'py-beginning-of-def-or-class)
-
-(defun py-end-of-def-or-class (&optional class count)
-  "Move point beyond end of `def' or `class' body.
-
-By default, looks for an appropriate `def'.  If you supply a prefix
-arg, looks for a `class' instead.  The docs below assume the `def'
-case; just substitute `class' for `def' for the other case.
-Programmatically, if CLASS is `either', then moves to either `class'
-or `def'.
-
-When second optional argument is given programmatically, move to the
-COUNTth end of `def'.
-
-If point is in a `def' statement already, this is the `def' we use.
-
-Else, if the `def' found by `\\[py-beginning-of-def-or-class]'
-contains the statement you started on, that's the `def' we use.
-
-Otherwise, we search forward for the closest following `def', and use that.
-
-If a `def' can be found by these rules, point is moved to the start of
-the line immediately following the `def' block, and the position of the
-start of the `def' is returned.
-
-Else point is moved to the end of the buffer, and nil is returned.
-
-Note that doing this command repeatedly will take you closer to the
-end of the buffer each time.
-
-To mark the current `def', see `\\[py-mark-def-or-class]'."
-  (interactive "P")			; raw prefix arg
-  (if (and count (/= count 1))
-      (py-beginning-of-def-or-class (- 1 count)))
-  (let ((start (progn (py-goto-initial-line) (point)))
-	(which (cond ((eq class 'either) "\\(class\\|def\\)")
-		     (class "class")
-		     (t "def")))
-	(state 'not-found))
-    ;; move point to start of appropriate def/class
-    (if (looking-at (concat "[ \t]*" which "\\>")) ; already on one
-	(setq state 'at-beginning)
-      ;; else see if py-beginning-of-def-or-class hits container
-      (if (and (py-beginning-of-def-or-class class)
-	       (progn (py-goto-beyond-block)
-		      (> (point) start)))
-	  (setq state 'at-end)
-	;; else search forward
-	(goto-char start)
-	(if (re-search-forward (concat "^[ \t]*" which "\\>") nil 'move)
-	    (progn (setq state 'at-beginning)
-		   (beginning-of-line)))))
-    (cond
-     ((eq state 'at-beginning) (py-goto-beyond-block) t)
-     ((eq state 'at-end) t)
-     ((eq state 'not-found) nil)
-     (t (error "Internal error in `py-end-of-def-or-class'")))))
-
-;; Backwards compabitility
-(defalias 'end-of-python-def-or-class 'py-end-of-def-or-class)
-
-
-;; Functions for marking regions
-(defun py-mark-block (&optional extend just-move)
-  "Mark following block of lines.  With prefix arg, mark structure.
-Easier to use than explain.  It sets the region to an `interesting'
-block of succeeding lines.  If point is on a blank line, it goes down to
-the next non-blank line.  That will be the start of the region.  The end
-of the region depends on the kind of line at the start:
-
- - If a comment, the region will include all succeeding comment lines up
-   to (but not including) the next non-comment line (if any).
-
- - Else if a prefix arg is given, and the line begins one of these
-   structures:
-
-     if elif else try except finally for while def class
-
-   the region will be set to the body of the structure, including
-   following blocks that `belong' to it, but excluding trailing blank
-   and comment lines.  E.g., if on a `try' statement, the `try' block
-   and all (if any) of the following `except' and `finally' blocks
-   that belong to the `try' structure will be in the region.  Ditto
-   for if/elif/else, for/else and while/else structures, and (a bit
-   degenerate, since they're always one-block structures) def and
-   class blocks.
-
- - Else if no prefix argument is given, and the line begins a Python
-   block (see list above), and the block is not a `one-liner' (i.e.,
-   the statement ends with a colon, not with code), the region will
-   include all succeeding lines up to (but not including) the next
-   code statement (if any) that's indented no more than the starting
-   line, except that trailing blank and comment lines are excluded.
-   E.g., if the starting line begins a multi-statement `def'
-   structure, the region will be set to the full function definition,
-   but without any trailing `noise' lines.
-
- - Else the region will include all succeeding lines up to (but not
-   including) the next blank line, or code or indenting-comment line
-   indented strictly less than the starting line.  Trailing indenting
-   comment lines are included in this case, but not trailing blank
-   lines.
-
-A msg identifying the location of the mark is displayed in the echo
-area; or do `\\[exchange-point-and-mark]' to flip down to the end.
-
-If called from a program, optional argument EXTEND plays the role of
-the prefix arg, and if optional argument JUST-MOVE is not nil, just
-moves to the end of the block (& does not set mark or display a msg)."
-  (interactive "P")			; raw prefix arg
-  (py-goto-initial-line)
-  ;; skip over blank lines
-  (while (and
-	  (looking-at "[ \t]*$")	; while blank line
-	  (not (eobp)))			; & somewhere to go
-    (forward-line 1))
-  (if (eobp)
-      (error "Hit end of buffer without finding a non-blank stmt"))
-  (let ((initial-pos (point))
-	(initial-indent (current-indentation))
-	last-pos			; position of last stmt in region
-	(followers
-	 '((if elif else) (elif elif else) (else)
-	   (try except finally) (except except) (finally)
-	   (for else) (while else)
-	   (def) (class) ) )
-	first-symbol next-symbol)
-
-    (cond
-     ;; if comment line, suck up the following comment lines
-     ((looking-at "[ \t]*#")
-      (re-search-forward "^[ \t]*[^ \t#]" nil 'move) ; look for non-comment
-      (re-search-backward "^[ \t]*#")	; and back to last comment in block
-      (setq last-pos (point)))
-
-     ;; else if line is a block line and EXTEND given, suck up
-     ;; the whole structure
-     ((and extend
-	   (setq first-symbol (py-suck-up-first-keyword) )
-	   (assq first-symbol followers))
-      (while (and
-	      (or (py-goto-beyond-block) t) ; side effect
-	      (forward-line -1)		; side effect
-	      (setq last-pos (point))	; side effect
-	      (py-goto-statement-below)
-	      (= (current-indentation) initial-indent)
-	      (setq next-symbol (py-suck-up-first-keyword))
-	      (memq next-symbol (cdr (assq first-symbol followers))))
-	(setq first-symbol next-symbol)))
-
-     ;; else if line *opens* a block, search for next stmt indented <=
-     ((py-statement-opens-block-p)
-      (while (and
-	      (setq last-pos (point))	; always true -- side effect
-	      (py-goto-statement-below)
-	      (> (current-indentation) initial-indent)
-	      )))
-
-     ;; else plain code line; stop at next blank line, or stmt or
-     ;; indenting comment line indented <
-     (t
-      (while (and
-	      (setq last-pos (point))	; always true -- side effect
-	      (or (py-goto-beyond-final-line) t)
-	      (not (looking-at "[ \t]*$")) ; stop at blank line
-	      (or
-	       (>= (current-indentation) initial-indent)
-	       (looking-at "[ \t]*#[^ \t\n]"))) ; ignore non-indenting #
-	nil)))
-
-    ;; skip to end of last stmt
-    (goto-char last-pos)
-    (py-goto-beyond-final-line)
-
-    ;; set mark & display
-    (if just-move
-	()				; just return
-      (push-mark (point) 'no-msg)
-      (forward-line -1)
-      (message "Mark set after: %s" (py-suck-up-leading-text))
-      (goto-char initial-pos))))
-
-(defun py-mark-def-or-class (&optional class)
-  "Set region to body of def (or class, with prefix arg) enclosing point.
-Pushes the current mark, then point, on the mark ring (all language
-modes do this, but although it's handy it's never documented ...).
-
-In most Emacs language modes, this function bears at least a
-hallucinogenic resemblance to `\\[py-end-of-def-or-class]' and
-`\\[py-beginning-of-def-or-class]'.
-
-And in earlier versions of Python mode, all 3 were tightly connected.
-Turned out that was more confusing than useful: the `goto start' and
-`goto end' commands are usually used to search through a file, and
-people expect them to act a lot like `search backward' and `search
-forward' string-search commands.  But because Python `def' and `class'
-can nest to arbitrary levels, finding the smallest def containing
-point cannot be done via a simple backward search: the def containing
-point may not be the closest preceding def, or even the closest
-preceding def that's indented less.  The fancy algorithm required is
-appropriate for the usual uses of this `mark' command, but not for the
-`goto' variations.
-
-So the def marked by this command may not be the one either of the
-`goto' commands find: If point is on a blank or non-indenting comment
-line, moves back to start of the closest preceding code statement or
-indenting comment line.  If this is a `def' statement, that's the def
-we use.  Else searches for the smallest enclosing `def' block and uses
-that.  Else signals an error.
-
-When an enclosing def is found: The mark is left immediately beyond
-the last line of the def block.  Point is left at the start of the
-def, except that: if the def is preceded by a number of comment lines
-followed by (at most) one optional blank line, point is left at the
-start of the comments; else if the def is preceded by a blank line,
-point is left at its start.
-
-The intent is to mark the containing def/class and its associated
-documentation, to make moving and duplicating functions and classes
-pleasant."
-  (interactive "P")			; raw prefix arg
-  (let ((start (point))
-	(which (cond ((eq class 'either) "\\(class\\|def\\)")
-		     (class "class")
-		     (t "def"))))
-    (push-mark start)
-    (if (not (py-go-up-tree-to-keyword which))
-	(progn (goto-char start)
-	       (error "Enclosing %s not found"
-		      (if (eq class 'either)
-			  "def or class"
-			which)))
-      ;; else enclosing def/class found
-      (setq start (point))
-      (py-goto-beyond-block)
-      (push-mark (point))
-      (goto-char start)
-      (if (zerop (forward-line -1))	; if there is a preceding line
-	  (progn
-	    (if (looking-at "[ \t]*$")	; it's blank
-		(setq start (point))	; so reset start point
-	      (goto-char start))	; else try again
-	    (if (zerop (forward-line -1))
-		(if (looking-at "[ \t]*#") ; a comment
-		    ;; look back for non-comment line
-		    ;; tricky: note that the regexp matches a blank
-		    ;; line, cuz \n is in the 2nd character class
-		    (and
-		     (re-search-backward "^[ \t]*[^ \t#]" nil 'move)
-		     (forward-line 1))
-		  ;; no comment, so go back
-		  (goto-char start)))))))
-  (exchange-point-and-mark)
-  (py-keep-region-active))
-
-;; ripped from cc-mode
-(defun py-forward-into-nomenclature (&optional arg)
-  "Move forward to end of a nomenclature section or word.
-With \\[universal-argument] (programmatically, optional argument ARG), 
-do it that many times.
-
-A `nomenclature' is a fancy way of saying AWordWithMixedCaseNotUnderscores."
-  (interactive "p")
-  (let ((case-fold-search nil))
-    (if (> arg 0)
-	(re-search-forward
-	 "\\(\\W\\|[_]\\)*\\([A-Z]*[a-z0-9]*\\)"
-	 (point-max) t arg)
-      (while (and (< arg 0)
-		  (re-search-backward
-		   "\\(\\W\\|[a-z0-9]\\)[A-Z]+\\|\\(\\W\\|[_]\\)\\w+"
-		   (point-min) 0))
-	(forward-char 1)
-	(setq arg (1+ arg)))))
-  (py-keep-region-active))
-
-(defun py-backward-into-nomenclature (&optional arg)
-  "Move backward to beginning of a nomenclature section or word.
-With optional ARG, move that many times.  If ARG is negative, move
-forward.
-
-A `nomenclature' is a fancy way of saying AWordWithMixedCaseNotUnderscores."
-  (interactive "p")
-  (py-forward-into-nomenclature (- arg))
-  (py-keep-region-active))
-
-
-
-;; pdbtrack functions
-(defun py-pdbtrack-toggle-stack-tracking (arg)
-  (interactive "P")
-  (if (not (get-buffer-process (current-buffer)))
-      (error "No process associated with buffer '%s'" (current-buffer)))
-  ;; missing or 0 is toggle, >0 turn on, <0 turn off
-  (if (or (not arg)
-	  (zerop (setq arg (prefix-numeric-value arg))))
-      (setq py-pdbtrack-do-tracking-p (not py-pdbtrack-do-tracking-p))
-    (setq py-pdbtrack-do-tracking-p (> arg 0)))
-  (message "%sabled Python's pdbtrack"
-           (if py-pdbtrack-do-tracking-p "En" "Dis")))
-
-(defun turn-on-pdbtrack ()
-  (interactive)
-  (py-pdbtrack-toggle-stack-tracking 1))
-
-(defun turn-off-pdbtrack ()
-  (interactive)
-  (py-pdbtrack-toggle-stack-tracking 0))
-
-
-
-;; Pychecker
-(defun py-pychecker-run (command)
-  "*Run pychecker (default on the file currently visited)."
-  (interactive
-   (let ((default
-           (format "%s %s %s" py-pychecker-command
-		   (mapconcat 'identity py-pychecker-command-args " ")
-		   (buffer-file-name)))
-	 (last (when py-pychecker-history
-		 (let* ((lastcmd (car py-pychecker-history))
-			(cmd (cdr (reverse (split-string lastcmd))))
-			(newcmd (reverse (cons (buffer-file-name) cmd))))
-		   (mapconcat 'identity newcmd " ")))))
-
-     (list
-      (if (fboundp 'read-shell-command)
-	  (read-shell-command "Run pychecker like this: "
-			      (if last
-				  last
-				default)
-			      'py-pychecker-history)
-	(read-string "Run pychecker like this: "
-		     (if last
-			 last
-		       default)
-		     'py-pychecker-history))
-	)))
-  (save-some-buffers (not py-ask-about-save) nil)
-  (compile-internal command "No more errors"))
-
-
-
-;; pydoc commands. The guts of this function is stolen from XEmacs's
-;; symbol-near-point, but without the useless regexp-quote call on the
-;; results, nor the interactive bit.  Also, we've added the temporary
-;; syntax table setting, which Skip originally had broken out into a
-;; separate function.  Note that Emacs doesn't have the original
-;; function.
-(defun py-symbol-near-point ()
-  "Return the first textual item to the nearest point."
-  ;; alg stolen from etag.el
-  (save-excursion
-    (with-syntax-table py-dotted-expression-syntax-table
-      (if (or (bobp) (not (memq (char-syntax (char-before)) '(?w ?_))))
-	  (while (not (looking-at "\\sw\\|\\s_\\|\\'"))
-	    (forward-char 1)))
-      (while (looking-at "\\sw\\|\\s_")
-	(forward-char 1))
-      (if (re-search-backward "\\sw\\|\\s_" nil t)
-	  (progn (forward-char 1)
-		 (buffer-substring (point)
-				   (progn (forward-sexp -1)
-					  (while (looking-at "\\s'")
-					    (forward-char 1))
-					  (point))))
-	nil))))
-
-(defun py-help-at-point ()
-  "Get help from Python based on the symbol nearest point."
-  (interactive)
-  (let* ((sym (py-symbol-near-point))
-	 (base (substring sym 0 (or (search "." sym :from-end t) 0)))
-	 cmd)
-    (if (not (equal base ""))
-        (setq cmd (concat "import " base "\n")))
-    (setq cmd (concat "import pydoc\n"
-                      cmd
-		      "try: pydoc.help('" sym "')\n"
-		      "except: print 'No help available on:', \"" sym "\""))
-    (message cmd)
-    (py-execute-string cmd)
-    (set-buffer "*Python Output*")
-    ;; BAW: Should we really be leaving the output buffer in help-mode?
-    (help-mode)))
-
-
-
-;; Documentation functions
-
-;; dump the long form of the mode blurb; does the usual doc escapes,
-;; plus lines of the form ^[vc]:name$ to suck variable & command docs
-;; out of the right places, along with the keys they're on & current
-;; values
-(defun py-dump-help-string (str)
-  (with-output-to-temp-buffer "*Help*"
-    (let ((locals (buffer-local-variables))
-	  funckind funcname func funcdoc
-	  (start 0) mstart end
-	  keys )
-      (while (string-match "^%\\([vc]\\):\\(.+\\)\n" str start)
-	(setq mstart (match-beginning 0)  end (match-end 0)
-	      funckind (substring str (match-beginning 1) (match-end 1))
-	      funcname (substring str (match-beginning 2) (match-end 2))
-	      func (intern funcname))
-	(princ (substitute-command-keys (substring str start mstart)))
-	(cond
-	 ((equal funckind "c")		; command
-	  (setq funcdoc (documentation func)
-		keys (concat
-		      "Key(s): "
-		      (mapconcat 'key-description
-				 (where-is-internal func py-mode-map)
-				 ", "))))
-	 ((equal funckind "v")		; variable
-	  (setq funcdoc (documentation-property func 'variable-documentation)
-		keys (if (assq func locals)
-			 (concat
-			  "Local/Global values: "
-			  (prin1-to-string (symbol-value func))
-			  " / "
-			  (prin1-to-string (default-value func)))
-		       (concat
-			"Value: "
-			(prin1-to-string (symbol-value func))))))
-	 (t				; unexpected
-	  (error "Error in py-dump-help-string, tag `%s'" funckind)))
-	(princ (format "\n-> %s:\t%s\t%s\n\n"
-		       (if (equal funckind "c") "Command" "Variable")
-		       funcname keys))
-	(princ funcdoc)
-	(terpri)
-	(setq start end))
-      (princ (substitute-command-keys (substring str start))))
-    (print-help-return-message)))
-
-(defun py-describe-mode ()
-  "Dump long form of Python-mode docs."
-  (interactive)
-  (py-dump-help-string "Major mode for editing Python files.
-Knows about Python indentation, tokens, comments and continuation lines.
-Paragraphs are separated by blank lines only.
-
-Major sections below begin with the string `@'; specific function and
-variable docs begin with `->'.
-
-@EXECUTING PYTHON CODE
-
-\\[py-execute-import-or-reload]\timports or reloads the file in the Python interpreter
-\\[py-execute-buffer]\tsends the entire buffer to the Python interpreter
-\\[py-execute-region]\tsends the current region
-\\[py-execute-def-or-class]\tsends the current function or class definition
-\\[py-execute-string]\tsends an arbitrary string
-\\[py-shell]\tstarts a Python interpreter window; this will be used by
-\tsubsequent Python execution commands
-%c:py-execute-import-or-reload
-%c:py-execute-buffer
-%c:py-execute-region
-%c:py-execute-def-or-class
-%c:py-execute-string
-%c:py-shell
-
-@VARIABLES
-
-py-indent-offset\tindentation increment
-py-block-comment-prefix\tcomment string used by comment-region
-
-py-python-command\tshell command to invoke Python interpreter
-py-temp-directory\tdirectory used for temp files (if needed)
-
-py-beep-if-tab-change\tring the bell if tab-width is changed
-%v:py-indent-offset
-%v:py-block-comment-prefix
-%v:py-python-command
-%v:py-temp-directory
-%v:py-beep-if-tab-change
-
-@KINDS OF LINES
-
-Each physical line in the file is either a `continuation line' (the
-preceding line ends with a backslash that's not part of a comment, or
-the paren/bracket/brace nesting level at the start of the line is
-non-zero, or both) or an `initial line' (everything else).
-
-An initial line is in turn a `blank line' (contains nothing except
-possibly blanks or tabs), a `comment line' (leftmost non-blank
-character is `#'), or a `code line' (everything else).
-
-Comment Lines
-
-Although all comment lines are treated alike by Python, Python mode
-recognizes two kinds that act differently with respect to indentation.
-
-An `indenting comment line' is a comment line with a blank, tab or
-nothing after the initial `#'.  The indentation commands (see below)
-treat these exactly as if they were code lines: a line following an
-indenting comment line will be indented like the comment line.  All
-other comment lines (those with a non-whitespace character immediately
-following the initial `#') are `non-indenting comment lines', and
-their indentation is ignored by the indentation commands.
-
-Indenting comment lines are by far the usual case, and should be used
-whenever possible.  Non-indenting comment lines are useful in cases
-like these:
-
-\ta = b   # a very wordy single-line comment that ends up being
-\t        #... continued onto another line
-
-\tif a == b:
-##\t\tprint 'panic!' # old code we've `commented out'
-\t\treturn a
-
-Since the `#...' and `##' comment lines have a non-whitespace
-character following the initial `#', Python mode ignores them when
-computing the proper indentation for the next line.
-
-Continuation Lines and Statements
-
-The Python-mode commands generally work on statements instead of on
-individual lines, where a `statement' is a comment or blank line, or a
-code line and all of its following continuation lines (if any)
-considered as a single logical unit.  The commands in this mode
-generally (when it makes sense) automatically move to the start of the
-statement containing point, even if point happens to be in the middle
-of some continuation line.
-
-
-@INDENTATION
-
-Primarily for entering new code:
-\t\\[indent-for-tab-command]\t indent line appropriately
-\t\\[py-newline-and-indent]\t insert newline, then indent
-\t\\[py-electric-backspace]\t reduce indentation, or delete single character
-
-Primarily for reindenting existing code:
-\t\\[py-guess-indent-offset]\t guess py-indent-offset from file content; change locally
-\t\\[universal-argument] \\[py-guess-indent-offset]\t ditto, but change globally
-
-\t\\[py-indent-region]\t reindent region to match its context
-\t\\[py-shift-region-left]\t shift region left by py-indent-offset
-\t\\[py-shift-region-right]\t shift region right by py-indent-offset
-
-Unlike most programming languages, Python uses indentation, and only
-indentation, to specify block structure.  Hence the indentation supplied
-automatically by Python-mode is just an educated guess:  only you know
-the block structure you intend, so only you can supply correct
-indentation.
-
-The \\[indent-for-tab-command] and \\[py-newline-and-indent] keys try to suggest plausible indentation, based on
-the indentation of preceding statements.  E.g., assuming
-py-indent-offset is 4, after you enter
-\tif a > 0: \\[py-newline-and-indent]
-the cursor will be moved to the position of the `_' (_ is not a
-character in the file, it's just used here to indicate the location of
-the cursor):
-\tif a > 0:
-\t    _
-If you then enter `c = d' \\[py-newline-and-indent], the cursor will move
-to
-\tif a > 0:
-\t    c = d
-\t    _
-Python-mode cannot know whether that's what you intended, or whether
-\tif a > 0:
-\t    c = d
-\t_
-was your intent.  In general, Python-mode either reproduces the
-indentation of the (closest code or indenting-comment) preceding
-statement, or adds an extra py-indent-offset blanks if the preceding
-statement has `:' as its last significant (non-whitespace and non-
-comment) character.  If the suggested indentation is too much, use
-\\[py-electric-backspace] to reduce it.
-
-Continuation lines are given extra indentation.  If you don't like the
-suggested indentation, change it to something you do like, and Python-
-mode will strive to indent later lines of the statement in the same way.
-
-If a line is a continuation line by virtue of being in an unclosed
-paren/bracket/brace structure (`list', for short), the suggested
-indentation depends on whether the current line contains the first item
-in the list.  If it does, it's indented py-indent-offset columns beyond
-the indentation of the line containing the open bracket.  If you don't
-like that, change it by hand.  The remaining items in the list will mimic
-whatever indentation you give to the first item.
-
-If a line is a continuation line because the line preceding it ends with
-a backslash, the third and following lines of the statement inherit their
-indentation from the line preceding them.  The indentation of the second
-line in the statement depends on the form of the first (base) line:  if
-the base line is an assignment statement with anything more interesting
-than the backslash following the leftmost assigning `=', the second line
-is indented two columns beyond that `='.  Else it's indented to two
-columns beyond the leftmost solid chunk of non-whitespace characters on
-the base line.
-
-Warning:  indent-region should not normally be used!  It calls \\[indent-for-tab-command]
-repeatedly, and as explained above, \\[indent-for-tab-command] can't guess the block
-structure you intend.
-%c:indent-for-tab-command
-%c:py-newline-and-indent
-%c:py-electric-backspace
-
-
-The next function may be handy when editing code you didn't write:
-%c:py-guess-indent-offset
-
-
-The remaining `indent' functions apply to a region of Python code.  They
-assume the block structure (equals indentation, in Python) of the region
-is correct, and alter the indentation in various ways while preserving
-the block structure:
-%c:py-indent-region
-%c:py-shift-region-left
-%c:py-shift-region-right
-
-@MARKING & MANIPULATING REGIONS OF CODE
-
-\\[py-mark-block]\t mark block of lines
-\\[py-mark-def-or-class]\t mark smallest enclosing def
-\\[universal-argument] \\[py-mark-def-or-class]\t mark smallest enclosing class
-\\[comment-region]\t comment out region of code
-\\[universal-argument] \\[comment-region]\t uncomment region of code
-%c:py-mark-block
-%c:py-mark-def-or-class
-%c:comment-region
-
-@MOVING POINT
-
-\\[py-previous-statement]\t move to statement preceding point
-\\[py-next-statement]\t move to statement following point
-\\[py-goto-block-up]\t move up to start of current block
-\\[py-beginning-of-def-or-class]\t move to start of def
-\\[universal-argument] \\[py-beginning-of-def-or-class]\t move to start of class
-\\[py-end-of-def-or-class]\t move to end of def
-\\[universal-argument] \\[py-end-of-def-or-class]\t move to end of class
-
-The first two move to one statement beyond the statement that contains
-point.  A numeric prefix argument tells them to move that many
-statements instead.  Blank lines, comment lines, and continuation lines
-do not count as `statements' for these commands.  So, e.g., you can go
-to the first code statement in a file by entering
-\t\\[beginning-of-buffer]\t to move to the top of the file
-\t\\[py-next-statement]\t to skip over initial comments and blank lines
-Or do `\\[py-previous-statement]' with a huge prefix argument.
-%c:py-previous-statement
-%c:py-next-statement
-%c:py-goto-block-up
-%c:py-beginning-of-def-or-class
-%c:py-end-of-def-or-class
-
-@LITTLE-KNOWN EMACS COMMANDS PARTICULARLY USEFUL IN PYTHON MODE
-
-`\\[indent-new-comment-line]' is handy for entering a multi-line comment.
-
-`\\[set-selective-display]' with a `small' prefix arg is ideally suited for viewing the
-overall class and def structure of a module.
-
-`\\[back-to-indentation]' moves point to a line's first non-blank character.
-
-`\\[indent-relative]' is handy for creating odd indentation.
-
-@OTHER EMACS HINTS
-
-If you don't like the default value of a variable, change its value to
-whatever you do like by putting a `setq' line in your .emacs file.
-E.g., to set the indentation increment to 4, put this line in your
-.emacs:
-\t(setq  py-indent-offset  4)
-To see the value of a variable, do `\\[describe-variable]' and enter the variable
-name at the prompt.
-
-When entering a key sequence like `C-c C-n', it is not necessary to
-release the CONTROL key after doing the `C-c' part -- it suffices to
-press the CONTROL key, press and release `c' (while still holding down
-CONTROL), press and release `n' (while still holding down CONTROL), &
-then release CONTROL.
-
-Entering Python mode calls with no arguments the value of the variable
-`python-mode-hook', if that value exists and is not nil; for backward
-compatibility it also tries `py-mode-hook'; see the `Hooks' section of
-the Elisp manual for details.
-
-Obscure:  When python-mode is first loaded, it looks for all bindings
-to newline-and-indent in the global keymap, and shadows them with
-local bindings to py-newline-and-indent."))
-
-(require 'info-look)
-;; The info-look package does not always provide this function (it
-;; appears this is the case with XEmacs 21.1)
-(when (fboundp 'info-lookup-maybe-add-help)
-  (info-lookup-maybe-add-help
-   :mode 'python-mode
-   :regexp "[a-zA-Z0-9_]+"
-   :doc-spec '(("(python-lib)Module Index")
-	       ("(python-lib)Class-Exception-Object Index")
-	       ("(python-lib)Function-Method-Variable Index")
-	       ("(python-lib)Miscellaneous Index")))
-  )
-
-
-;; Helper functions
-(defvar py-parse-state-re
-  (concat
-   "^[ \t]*\\(elif\\|else\\|while\\|def\\|class\\)\\>"
-   "\\|"
-   "^[^ #\t\n]"))
-
-(defun py-parse-state ()
-  "Return the parse state at point (see `parse-partial-sexp' docs)."
-  (save-excursion
-    (let ((here (point))
-	  pps done)
-      (while (not done)
-	;; back up to the first preceding line (if any; else start of
-	;; buffer) that begins with a popular Python keyword, or a
-	;; non- whitespace and non-comment character.  These are good
-	;; places to start parsing to see whether where we started is
-	;; at a non-zero nesting level.  It may be slow for people who
-	;; write huge code blocks or huge lists ... tough beans.
-	(re-search-backward py-parse-state-re nil 'move)
-	(beginning-of-line)
-	;; In XEmacs, we have a much better way to test for whether
-	;; we're in a triple-quoted string or not.  Emacs does not
-	;; have this built-in function, which is its loss because
-	;; without scanning from the beginning of the buffer, there's
-	;; no accurate way to determine this otherwise.
-	(save-excursion (setq pps (parse-partial-sexp (point) here)))
-	;; make sure we don't land inside a triple-quoted string
-	(setq done (or (not (nth 3 pps))
-		       (bobp)))
-	;; Just go ahead and short circuit the test back to the
-	;; beginning of the buffer.  This will be slow, but not
-	;; nearly as slow as looping through many
-	;; re-search-backwards.
-	(if (not done)
-	    (goto-char (point-min))))
-      pps)))
-
-(defun py-nesting-level ()
-  "Return the buffer position of the last unclosed enclosing list.
-If nesting level is zero, return nil."
-  (let ((status (py-parse-state)))
-    (if (zerop (car status))
-	nil				; not in a nest
-      (car (cdr status)))))		; char# of open bracket
-
-(defun py-backslash-continuation-line-p ()
-  "Return t iff preceding line ends with backslash that is not in a comment."
-  (save-excursion
-    (beginning-of-line)
-    (and
-     ;; use a cheap test first to avoid the regexp if possible
-     ;; use 'eq' because char-after may return nil
-     (eq (char-after (- (point) 2)) ?\\ )
-     ;; make sure; since eq test passed, there is a preceding line
-     (forward-line -1)			; always true -- side effect
-     (looking-at py-continued-re))))
-
-(defun py-continuation-line-p ()
-  "Return t iff current line is a continuation line."
-  (save-excursion
-    (beginning-of-line)
-    (or (py-backslash-continuation-line-p)
-	(py-nesting-level))))
-
-(defun py-goto-beginning-of-tqs (delim)
-  "Go to the beginning of the triple quoted string we find ourselves in.
-DELIM is the TQS string delimiter character we're searching backwards
-for."
-  (let ((skip (and delim (make-string 1 delim)))
-	(continue t))
-    (when skip
-      (save-excursion
-	(while continue
-	  (py-safe (search-backward skip))
-	  (setq continue (and (not (bobp))
-			      (= (char-before) ?\\))))
-	(if (and (= (char-before) delim)
-		 (= (char-before (1- (point))) delim))
-	    (setq skip (make-string 3 delim))))
-      ;; we're looking at a triple-quoted string
-      (py-safe (search-backward skip)))))
-
-(defun py-goto-initial-line ()
-  "Go to the initial line of the current statement.
-Usually this is the line we're on, but if we're on the 2nd or
-following lines of a continuation block, we need to go up to the first
-line of the block."
-  ;; Tricky: We want to avoid quadratic-time behavior for long
-  ;; continued blocks, whether of the backslash or open-bracket
-  ;; varieties, or a mix of the two.  The following manages to do that
-  ;; in the usual cases.
-  ;;
-  ;; Also, if we're sitting inside a triple quoted string, this will
-  ;; drop us at the line that begins the string.
-  (let (open-bracket-pos)
-    (while (py-continuation-line-p)
-      (beginning-of-line)
-      (if (py-backslash-continuation-line-p)
-	  (while (py-backslash-continuation-line-p)
-	    (forward-line -1))
-	;; else zip out of nested brackets/braces/parens
-	(while (setq open-bracket-pos (py-nesting-level))
-	  (goto-char open-bracket-pos)))))
-  (beginning-of-line))
-
-(defun py-goto-beyond-final-line ()
-  "Go to the point just beyond the fine line of the current statement.
-Usually this is the start of the next line, but if this is a
-multi-line statement we need to skip over the continuation lines."
-  ;; Tricky: Again we need to be clever to avoid quadratic time
-  ;; behavior.
-  ;;
-  ;; XXX: Not quite the right solution, but deals with multi-line doc
-  ;; strings
-  (if (looking-at (concat "[ \t]*\\(" py-stringlit-re "\\)"))
-      (goto-char (match-end 0)))
-  ;;
-  (forward-line 1)
-  (let (state)
-    (while (and (py-continuation-line-p)
-		(not (eobp)))
-      ;; skip over the backslash flavor
-      (while (and (py-backslash-continuation-line-p)
-		  (not (eobp)))
-	(forward-line 1))
-      ;; if in nest, zip to the end of the nest
-      (setq state (py-parse-state))
-      (if (and (not (zerop (car state)))
-	       (not (eobp)))
-	  (progn
-	    (parse-partial-sexp (point) (point-max) 0 nil state)
-	    (forward-line 1))))))
-
-(defun py-statement-opens-block-p ()
-  "Return t iff the current statement opens a block.
-I.e., iff it ends with a colon that is not in a comment.  Point should 
-be at the start of a statement."
-  (save-excursion
-    (let ((start (point))
-	  (finish (progn (py-goto-beyond-final-line) (1- (point))))
-	  (searching t)
-	  (answer nil)
-	  state)
-      (goto-char start)
-      (while searching
-	;; look for a colon with nothing after it except whitespace, and
-	;; maybe a comment
-	(if (re-search-forward ":\\([ \t]\\|\\\\\n\\)*\\(#.*\\)?$"
-			       finish t)
-	    (if (eq (point) finish)	; note: no `else' clause; just
-					; keep searching if we're not at
-					; the end yet
-		;; sure looks like it opens a block -- but it might
-		;; be in a comment
-		(progn
-		  (setq searching nil)	; search is done either way
-		  (setq state (parse-partial-sexp start
-						  (match-beginning 0)))
-		  (setq answer (not (nth 4 state)))))
-	  ;; search failed: couldn't find another interesting colon
-	  (setq searching nil)))
-      answer)))
-
-(defun py-statement-closes-block-p ()
-  "Return t iff the current statement closes a block.
-I.e., if the line starts with `return', `raise', `break', `continue',
-and `pass'.  This doesn't catch embedded statements."
-  (let ((here (point)))
-    (py-goto-initial-line)
-    (back-to-indentation)
-    (prog1
-	(looking-at (concat py-block-closing-keywords-re "\\>"))
-      (goto-char here))))
-
-(defun py-goto-beyond-block ()
-  "Go to point just beyond the final line of block begun by the current line.
-This is the same as where `py-goto-beyond-final-line' goes unless
-we're on colon line, in which case we go to the end of the block.
-Assumes point is at the beginning of the line."
-  (if (py-statement-opens-block-p)
-      (py-mark-block nil 'just-move)
-    (py-goto-beyond-final-line)))
-
-(defun py-goto-statement-at-or-above ()
-  "Go to the start of the first statement at or preceding point.
-Return t if there is such a statement, otherwise nil.  `Statement'
-does not include blank lines, comments, or continuation lines."
-  (py-goto-initial-line)
-  (if (looking-at py-blank-or-comment-re)
-      ;; skip back over blank & comment lines
-      ;; note:  will skip a blank or comment line that happens to be
-      ;; a continuation line too
-      (if (re-search-backward "^[ \t]*[^ \t#\n]" nil t)
-	  (progn (py-goto-initial-line) t)
-	nil)
-    t))
-
-(defun py-goto-statement-below ()
-  "Go to start of the first statement following the statement containing point.
-Return t if there is such a statement, otherwise nil.  `Statement'
-does not include blank lines, comments, or continuation lines."
-  (beginning-of-line)
-  (let ((start (point)))
-    (py-goto-beyond-final-line)
-    (while (and
-	    (or (looking-at py-blank-or-comment-re)
-		(py-in-literal))
-	    (not (eobp)))
-      (forward-line 1))
-    (if (eobp)
-	(progn (goto-char start) nil)
-      t)))
-
-(defun py-go-up-tree-to-keyword (key)
-  "Go to begining of statement starting with KEY, at or preceding point.
-
-KEY is a regular expression describing a Python keyword.  Skip blank
-lines and non-indenting comments.  If the statement found starts with
-KEY, then stop, otherwise go back to first enclosing block starting
-with KEY.  If successful, leave point at the start of the KEY line and 
-return t.  Otherwise, leav point at an undefined place and return nil."
-  ;; skip blanks and non-indenting #
-  (py-goto-initial-line)
-  (while (and
-	  (looking-at "[ \t]*\\($\\|#[^ \t\n]\\)")
-	  (zerop (forward-line -1)))	; go back
-    nil)
-  (py-goto-initial-line)
-  (let* ((re (concat "[ \t]*" key "\\b"))
-	 (case-fold-search nil)		; let* so looking-at sees this
-	 (found (looking-at re))
-	 (dead nil))
-    (while (not (or found dead))
-      (condition-case nil		; in case no enclosing block
-	  (py-goto-block-up 'no-mark)
-	(error (setq dead t)))
-      (or dead (setq found (looking-at re))))
-    (beginning-of-line)
-    found))
-
-(defun py-suck-up-leading-text ()
-  "Return string in buffer from start of indentation to end of line.
-Prefix with \"...\" if leading whitespace was skipped."
-  (save-excursion
-    (back-to-indentation)
-    (concat
-     (if (bolp) "" "...")
-     (buffer-substring (point) (progn (end-of-line) (point))))))
-
-(defun py-suck-up-first-keyword ()
-  "Return first keyword on the line as a Lisp symbol.
-`Keyword' is defined (essentially) as the regular expression
-([a-z]+).  Returns nil if none was found."
-  (let ((case-fold-search nil))
-    (if (looking-at "[ \t]*\\([a-z]+\\)\\b")
-	(intern (buffer-substring (match-beginning 1) (match-end 1)))
-      nil)))
-
-(defun py-current-defun ()
-  "Python value for `add-log-current-defun-function'.
-This tells add-log.el how to find the current function/method/variable."
-  (save-excursion
-
-    ;; Move back to start of the current statement.
-
-    (py-goto-initial-line)
-    (back-to-indentation)
-    (while (and (or (looking-at py-blank-or-comment-re)
-		    (py-in-literal))
-		(not (bobp)))
-      (backward-to-indentation 1))
-    (py-goto-initial-line)
-
-    (let ((scopes "")
-	  (sep "")
-	  dead assignment)
-
-      ;; Check for an assignment.  If this assignment exists inside a
-      ;; def, it will be overwritten inside the while loop.  If it
-      ;; exists at top lever or inside a class, it will be preserved.
-
-      (when (looking-at "[ \t]*\\([a-zA-Z0-9_]+\\)[ \t]*=")
-	(setq scopes (buffer-substring (match-beginning 1) (match-end 1)))
-	(setq assignment t)
-	(setq sep "."))
-
-      ;; Prepend the name of each outer socpe (def or class).
-
-      (while (not dead)
-	(if (and (py-go-up-tree-to-keyword "\\(class\\|def\\)")
-		 (looking-at
-		  "[ \t]*\\(class\\|def\\)[ \t]*\\([a-zA-Z0-9_]+\\)[ \t]*"))
-	    (let ((name (buffer-substring (match-beginning 2) (match-end 2))))
-	      (if (and assignment (looking-at "[ \t]*def"))
-		  (setq scopes name)
-		(setq scopes (concat name sep scopes))
-		(setq sep "."))))
-	(setq assignment nil)
-	(condition-case nil		; Terminate nicely at top level.
-	    (py-goto-block-up 'no-mark)
-	  (error (setq dead t))))
-      (if (string= scopes "")
-	  nil
-	scopes))))
-
-
-
-(defconst py-help-address "python-mode@python.org"
-  "Address accepting submission of bug reports.")
-
-(defun py-version ()
-  "Echo the current version of `python-mode' in the minibuffer."
-  (interactive)
-  (message "Using `python-mode' version %s" py-version)
-  (py-keep-region-active))
-
-;; only works under Emacs 19
-;(eval-when-compile
-;  (require 'reporter))
-
-(defun py-submit-bug-report (enhancement-p)
-  "Submit via mail a bug report on `python-mode'.
-With \\[universal-argument] (programmatically, argument ENHANCEMENT-P
-non-nil) just submit an enhancement request."
-  (interactive
-   (list (not (y-or-n-p
-	       "Is this a bug report (hit `n' to send other comments)? "))))
-  (let ((reporter-prompt-for-summary-p (if enhancement-p
-					   "(Very) brief summary: "
-					 t)))
-    (require 'reporter)
-    (reporter-submit-bug-report
-     py-help-address			;address
-     (concat "python-mode " py-version)	;pkgname
-     ;; varlist
-     (if enhancement-p nil
-       '(py-python-command
-	 py-indent-offset
-	 py-block-comment-prefix
-	 py-temp-directory
-	 py-beep-if-tab-change))
-     nil				;pre-hooks
-     nil				;post-hooks
-     "Dear Barry,")			;salutation
-    (if enhancement-p nil
-      (set-mark (point))
-      (insert 
-"Please replace this text with a sufficiently large code sample\n\
-and an exact recipe so that I can reproduce your problem.  Failure\n\
-to do so may mean a greater delay in fixing your bug.\n\n")
-      (exchange-point-and-mark)
-      (py-keep-region-active))))
-
-
-(defun py-kill-emacs-hook ()
-  "Delete files in `py-file-queue'.
-These are Python temporary files awaiting execution."
-  (mapcar #'(lambda (filename)
-	      (py-safe (delete-file filename)))
-	  py-file-queue))
-
-;; arrange to kill temp files when Emacs exists
-(add-hook 'kill-emacs-hook 'py-kill-emacs-hook)
-(add-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file)
-
-;; Add a designator to the minor mode strings
-(or (assq 'py-pdbtrack-minor-mode-string minor-mode-alist)
-    (push '(py-pdbtrack-is-tracking-p py-pdbtrack-minor-mode-string)
-	  minor-mode-alist))
-
-
-
-;;; paragraph and string filling code from Bernhard Herzog
-;;; see http://mail.python.org/pipermail/python-list/2002-May/103189.html
-
-(defun py-fill-comment (&optional justify)
-  "Fill the comment paragraph around point"
-  (let (;; Non-nil if the current line contains a comment.
-	has-comment
-
-	;; If has-comment, the appropriate fill-prefix for the comment.
-	comment-fill-prefix)
-
-    ;; Figure out what kind of comment we are looking at.
-    (save-excursion
-      (beginning-of-line)
-      (cond
-       ;; A line with nothing but a comment on it?
-       ((looking-at "[ \t]*#[# \t]*")
-	(setq has-comment t
-	      comment-fill-prefix (buffer-substring (match-beginning 0)
-						    (match-end 0))))
-
-       ;; A line with some code, followed by a comment? Remember that the hash
-       ;; which starts the comment shouldn't be part of a string or character.
-       ((progn
-	  (while (not (looking-at "#\\|$"))
-	    (skip-chars-forward "^#\n\"'\\")
-	    (cond
-	     ((eq (char-after (point)) ?\\) (forward-char 2))
-	     ((memq (char-after (point)) '(?\" ?')) (forward-sexp 1))))
-	  (looking-at "#+[\t ]*"))
-	(setq has-comment t)
-	(setq comment-fill-prefix
-	      (concat (make-string (current-column) ? )
-		      (buffer-substring (match-beginning 0) (match-end 0)))))))
-
-    (if (not has-comment)
-	(fill-paragraph justify)
-
-      ;; Narrow to include only the comment, and then fill the region.
-      (save-restriction
-	(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 to far.  Go forward again.
-	   (or (looking-at "^[ \t]*#")
-	       (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 hashes on them can be paragraph boundaries.
-	(let ((paragraph-start (concat paragraph-start "\\|[ \t#]*$"))
-	      (paragraph-separate (concat paragraph-separate "\\|[ \t#]*$"))
-	      (fill-prefix comment-fill-prefix))
-	  ;;(message "paragraph-start %S paragraph-separate %S"
-	  ;;paragraph-start paragraph-separate)
-	  (fill-paragraph justify))))
-    t))
-
-
-(defun py-fill-string (start &optional justify)
-  "Fill the paragraph around (point) in the string starting at start"
-  ;; basic strategy: narrow to the string and call the default
-  ;; implementation
-  (let (;; the start of the string's contents
-	string-start
-	;; the end of the string's contents
-	string-end
-	;; length of the string's delimiter
-	delim-length
-	;; The string delimiter
-	delim
-	)
-
-    (save-excursion
-      (goto-char start)
-      (if (looking-at "\\('''\\|\"\"\"\\|'\\|\"\\)\\\\?\n?")
-	  (setq string-start (match-end 0)
-		delim-length (- (match-end 1) (match-beginning 1))
-		delim (buffer-substring-no-properties (match-beginning 1)
-						      (match-end 1)))
-	(error "The parameter start is not the beginning of a python string"))
-
-      ;; if the string is the first token on a line and doesn't start with
-      ;; a newline, fill as if the string starts at the beginning of the
-      ;; line. this helps with one line docstrings
-      (save-excursion
-	(beginning-of-line)
-	(and (/= (char-before string-start) ?\n)
-	     (looking-at (concat "[ \t]*" delim))
-	     (setq string-start (point))))
-
-      (forward-sexp (if (= delim-length 3) 2 1))
-
-      ;; with both triple quoted strings and single/double quoted strings
-      ;; we're now directly behind the first char of the end delimiter
-      ;; (this doesn't work correctly when the triple quoted string
-      ;; contains the quote mark itself). The end of the string's contents
-      ;; is one less than point
-      (setq string-end (1- (point))))
-
-    ;; Narrow to the string's contents and fill the current paragraph
-    (save-restriction
-      (narrow-to-region string-start string-end)
-      (let ((ends-with-newline (= (char-before (point-max)) ?\n)))
-	(fill-paragraph justify)
-	(if (and (not ends-with-newline)
-		 (= (char-before (point-max)) ?\n))
-	    ;; the default fill-paragraph implementation has inserted a
-	    ;; newline at the end. Remove it again.
-	    (save-excursion
-	      (goto-char (point-max))
-	      (delete-char -1)))))
-
-    ;; return t to indicate that we've done our work
-    t))
-
-(defun py-fill-paragraph (&optional justify)
-  "Like \\[fill-paragraph], but handle Python comments and strings.
-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 `#'s.
-If point is inside a string, narrow to that string and fill.
-"
-  (interactive "P")
-  (let* ((bod (py-point 'bod))
-	 (pps (parse-partial-sexp bod (point))))
-    (cond
-     ;; are we inside a comment or on a line with only whitespace before
-     ;; the comment start?
-     ((or (nth 4 pps)
-	  (save-excursion (beginning-of-line) (looking-at "[ \t]*#")))
-      (py-fill-comment justify))
-     ;; are we inside a string?
-     ((nth 3 pps)
-      (py-fill-string (nth 8 pps)))
-     ;; are we at the opening quote of a string, or in the indentation?
-     ((save-excursion
-	(forward-word 1)
-	(eq (py-in-literal) 'string))
-      (save-excursion
-	(py-fill-string (py-point 'boi))))
-     ;; are we at or after the closing quote of a string?
-     ((save-excursion
-	(backward-word 1)
-	(eq (py-in-literal) 'string))
-      (save-excursion
-	(py-fill-string (py-point 'boi))))
-     ;; otherwise use the default
-     (t
-      (fill-paragraph justify)))))
-
-
-
-(provide 'python-mode)
-;;; python-mode.el ends here
diff --git a/xemacs-packages/lisp/re-builder/ChangeLog b/xemacs-packages/lisp/re-builder/ChangeLog
deleted file mode 100644
index 4c4b501a..00000000
--- a/xemacs-packages/lisp/re-builder/ChangeLog
+++ /dev/null
@@ -1,100 +0,0 @@
-2005-09-12  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.05 released.
-
-2005-09-11  Adrian Aichner  <adrian@xemacs.org>
-
-	* re-builder.el (reb-match-0): Improve re-builder reb-match faces
-	for light background.
-	* re-builder.el (reb-match-1): Ditto.
-	* re-builder.el (reb-match-2): Ditto.
-	* re-builder.el (reb-match-3): Ditto.
-	* re-builder.el (reb-match-4): Ditto.
-	* re-builder.el (reb-match-5): Ditto.
-	* re-builder.el (reb-match-6): Ditto.
-	* re-builder.el (reb-match-7): Ditto.
-	* re-builder.el (reb-match-8): Ditto.
-	* re-builder.el (reb-match-9): Ditto.
-
-2005-08-31  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.04 released.
-
-2005-08-29  Adrian Aichner  <adrian@xemacs.org>
-
-	* re-builder.el: Add support for perl regexp via wrapping
-	functions reb-re-search-forward and reb-re-search-backward.
-	Define faces for all nine supported subexpressions.  Spread out
-	face colors for light background with roughly 36 degree hue
-	spread.
-	* re-builder.el (reb-re-syntax): Add perl suport.
-	* re-builder.el (reb-match-4): New.
-	* re-builder.el (reb-match-5): New.
-	* re-builder.el (reb-match-6): New.
-	* re-builder.el (reb-match-7): New.
-	* re-builder.el (reb-match-8): New.
-	* re-builder.el (reb-match-9): New.
-	* re-builder.el (reb-perl-match-vector): New.
-	* re-builder.el (reb-perl-match-index): New.
-	* re-builder.el (reb-perl-syntax-p): New.
-	* re-builder.el (reb-next-match): Use reb-re-search-forward.
-	* re-builder.el (reb-prev-match): Use reb-re-search-backward.
-	* re-builder.el (reb-enter-subexp-mode): Add comma to message.
-	* re-builder.el (reb-change-syntax): Add perl support.
-	* re-builder.el (reb-delete-overlays): Reset reb-perl-match-vector
-	and reb-perl-match-index.
-	* re-builder.el (reb-read-regexp): Add perl support.
-	* re-builder.el (reb-insert-regexp): Ditto.
-	* re-builder.el (reb-count-subexps): Avoid false subexp matches,
-	more important for perl, but applicable to lisp regexp too.
-	* re-builder.el (reb-update-overlays): Use reb-re-search-forward.
-	* re-builder.el (reb-perl-program): New.
-	* re-builder.el (reb-re-search-forward): New.
-	* re-builder.el (reb-re-search-backward): New.
-	* re-builder.texi: Update for perl support.
-
-2005-07-27  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.03 released.
-
-2005-07-23  Adrian Aichner  <adrian@xemacs.org>
-
-	* re-builder.texi (Usage): Document display of copied RE in echo
-	area.
-	* re-builder.texi (Regex Types): Document `reb-toggle-case' and
-	display of current syntax in modeline.
-	* re-builder.texi (Questions): Typo fix.
-
-2005-06-12  Adrian Aichner  <adrian@xemacs.org>
-
-	* re-builder.el: Typo fix.
-	* re-builder.el (reb-copy): Kill reb-re-syntax 'string without
-	quoting to make it directly usable in interactive search.  Print
-	message in echo area, indicating the syntax and text being killed.
-	* re-builder.el (reb-update-modestring): Show setting of
-	reb-re-syntax in modeline.
-
-2005-03-14  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.02 released.
-
-2005-03-10  Steve Youngs  <steve@sxemacs.org>
-
-	* Makefile (REQUIRES): Remove fsf-compat.  This package uses
-	extents natively now.
-
-	* re-builder.el: Set up better extent/overlay compatibility. 
-	(reb-delete-overlays): Use it here.
-	(reb-update-overlays): Ditto.
-
-	(reb-color-display-p): Call `device-class' in
-	XEmacs so this function will DTRT in XEmacs.
-
-2005-03-09  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.01 released.
-
-2005-02-27  Aidan Kehoe  <kehoea@parhasard.net>
-
-	* Makefile: Created.
-
diff --git a/xemacs-packages/lisp/re-builder/_pkg.el b/xemacs-packages/lisp/re-builder/_pkg.el
deleted file mode 100644
index b32dfa68..00000000
--- a/xemacs-packages/lisp/re-builder/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 're-builder
-		 :version 1.05
-          :author-version "1.20"
-		 :type 'regular)
diff --git a/xemacs-packages/lisp/re-builder/auto-autoloads.el b/xemacs-packages/lisp/re-builder/auto-autoloads.el
deleted file mode 100644
index e0c76db3..00000000
--- a/xemacs-packages/lisp/re-builder/auto-autoloads.el
+++ /dev/null
@@ -1,20 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 're-builder-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "re-builder/_pkg.el")
-
-(package-provide 're-builder :version 1.05 :author-version "1.20" :type 'regular)
-
-;;;***
-
-;;;### (autoloads (re-builder regexp-builder) "re-builder" "re-builder/re-builder.el")
-
-(autoload 'regexp-builder "re-builder" "\
-Alias for `re-builder': Construct a regexp interactively." t nil)
-
-(autoload 're-builder "re-builder" "\
-Construct a regexp interactively." t nil)
-
-;;;***
-
-(provide 're-builder-autoloads)
diff --git a/xemacs-packages/lisp/re-builder/custom-load.el b/xemacs-packages/lisp/re-builder/custom-load.el
deleted file mode 100644
index 45c3e66f..00000000
--- a/xemacs-packages/lisp/re-builder/custom-load.el
+++ /dev/null
@@ -1,10 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'lisp '("re-builder"))
-(custom-add-loads 're-builder '("re-builder"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/re-builder/re-builder.el b/xemacs-packages/lisp/re-builder/re-builder.el
deleted file mode 100644
index 74049fe0..00000000
--- a/xemacs-packages/lisp/re-builder/re-builder.el
+++ /dev/null
@@ -1,952 +0,0 @@
-;;; re-builder.el --- building Regexps with visual feedback
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2004 Free Software Foundation, Inc.
-
-;; Author: Detlev Zundel <dzu@gnu.org>
-;; Keywords: matching, lisp, 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:
-
-;; When I have to come up with regular expressions that are more
-;; complex than simple string matchers, especially if they contain sub
-;; expressions, I find myself spending quite some time in the
-;; `development cycle'.  `re-builder' aims to shorten this time span
-;; so I can get on with the more interesting bits.
-
-;; With it you can have immediate visual feedback about how well the
-;; regexp behaves to your expectations on the intended data.
-
-;; When called up `re-builder' attaches itself to the current buffer
-;; which becomes its target buffer, where all the matching is done.
-;; The active window is split so you have a view on the data while
-;; authoring the RE.  If the edited expression is valid the matches in
-;; the target buffer are marked automatically with colored overlays
-;; (for non-color displays see below) giving you feedback over the
-;; extents of the matched (sub) expressions.  The (non-)validity is
-;; shown only in the modeline without throwing the errors at you.  If
-;; you want to know the reason why RE Builder considers it as invalid
-;; call `reb-force-update' ("\C-c\C-u") which should reveal the error.
-
-;; The target buffer can be changed with `reb-change-target-buffer'
-;; ("\C-c\C-b").  Changing the target buffer automatically removes
-;; the overlays from the old buffer and displays the new one in the
-;; target window.
-
-;; The `re-builder' keeps the focus while updating the matches in the
-;; target buffer so corrections are easy to incorporate.  If you are
-;; satisfied with the result you can paste the RE to the kill-ring
-;; with `reb-copy' ("\C-c\C-w"), quit the `re-builder' ("\C-c\C-q")
-;; and use it wherever you need it.
-
-;; As the automatic updates can take some time on large buffers, they
-;; can be limited by `reb-auto-match-limit' so that they should not
-;; have a negative impact on the editing.  Setting it to nil disables
-;; the auto update limit.  Setting it to 0 disables auto updates.
-;; Forcing an update overrides this limit allowing an easy way to see
-;; all matches.
-
-;; Currently `re-builder' understands six different forms of input,
-;; namely `lisp-re', `perl', `read', `rx', `sregex', and `string'
-;; syntax.
-;; Read syntax and string syntax are both delimited by `"'s and behave
-;; according to their name.  With the `string' syntax there's no need
-;; to escape the backslashes and double quotes simplifying the editing
-;; somewhat.  The other three allow editing of symbolic regular
-;; expressions supported by the packages of the same name.  (`lisp-re'
-;; is a package by me and its support may go away as it is nearly the
-;; same as the `sregex' package in Emacs)
-
-;; Note that the `sregex,' `rx' and `lisp-re' syntaxes will only be
-;; available in XEmacs if you've installed them yourself.
-
-;; Editing symbolic expressions is done through a major mode derived
-;; from `emacs-lisp-mode' so you'll get all the good stuff like
-;; automatic indentation and font-locking etc.
-
-;; When editing a symbolic regular expression, only the first
-;; expression in the RE Builder buffer is considered, which helps
-;; limiting the extent of the expression like the `"'s do for the text
-;; modes.  For the `sregex' syntax the function `sregex' is applied to
-;; the evaluated expression read.  So you can use quoted arguments
-;; with something like '("findme") or you can construct arguments to
-;; your hearts delight with a valid ELisp expression.  (The compiled
-;; string form will be copied by `reb-copy')  If you want to take
-;; a glance at the corresponding string you can temporarily change the
-;; input syntax.
-
-;; Changing the input syntax is transparent (for the obvious exception
-;; non-symbolic -> symbolic) so you can change your mind as often as
-;; you like.
-
-;; There is also a shortcut function for toggling the
-;; `case-fold-search' variable in the target buffer with an immediate
-;; update.
-
-
-;; Q: But what if my display cannot show colored overlays?
-;; A: Then the cursor will flash around the matched text making it stand
-;;    out.
-
-;; Q: But how can I then make out the sub-expressions?
-;; A: That's where the `sub-expression mode' comes in.  In it only the
-;;    digit keys are assigned to perform an update that will flash the
-;;    corresponding subexp only.
-
-
-;;; Code:
-
-;; Extent/overlay compatibility
-(if (featurep 'xemacs)
-    ;; (S)XEmacs
-    (progn
-      (defalias 'reb-delete-overlay 'delete-extent)
-      (defalias 'reb-make-overlay 'make-extent)
-      (defalias 'reb-overlay-put 'set-extent-property))
-  ;; GNU/Emacs
-  (defalias 'reb-delete-overlay 'delete-overlay)
-  (defalias 'reb-make-overlay 'make-overlay)
-  (defalias 'reb-overlay-put 'overlay-put))
-
-;; User customizable variables
-(defgroup re-builder nil
-  "Options for the RE Builder."
-  :group 'lisp
-  :prefix "reb-")
-
-(defcustom reb-blink-delay 0.5
-  "*Seconds to blink cursor for next/previous match in RE Builder."
-  :group 're-builder
-  :type 'number)
-
-(defcustom reb-mode-hook nil
-  "*Hooks to run on entering RE Builder mode."
-  :group 're-builder
-  :type 'hook)
-
-(defcustom reb-re-syntax 'read
-  "*Syntax for the REs in the RE Builder.
-
-Can either be `lisp-re', `perl', `read', `rx', `sregex', or `string'."
-  :group 're-builder
-  :type '(choice (const :tag "Read syntax" read)
-		 (const :tag "String syntax" string)
-		 (const :tag "`sregex' syntax" sregex)
-		 (const :tag "`lisp-re' syntax" lisp-re)
-		 (const :tag "`rx' syntax" rx)
-		 (const :tag "`perl' syntax" perl)
-		 (value: string)))
-
-(defcustom reb-auto-match-limit 200
-  "*Positive integer limiting the matches for RE Builder auto updates.
-Set it to nil if you don't want limits here."
-  :group 're-builder
-  :type '(restricted-sexp :match-alternatives
-			  (integerp 'nil)))
-
-; Produced by
-; (Hsv2ColoredTextSpectrum 0 359 36 0.2155 0.3000 1.0000 1.0000 1.0000 1.0000)
-; from http://www.emacswiki.org/cgi-bin/emacs/hsv2rgb.el
-; Hue Satur Value RGB Sample
-;   0 0.216 1.000 #ffc8c8
-;  36 0.216 1.000 #ffe9c8
-;  72 0.216 1.000 #f4ffc8
-; 108 0.216 1.000 #d3ffc8
-; 144 0.216 1.000 #c8ffde
-; 180 0.216 1.000 #c8ffff
-; 216 0.216 1.000 #c8deff
-; 252 0.216 1.000 #d3c8ff
-; 288 0.216 1.000 #f4c8ff
-; 324 0.216 1.000 #ffc8e9
-(defface reb-match-0
-  '((((class color) (background light))
-     (:background "#ffc8c8"))
-    (((class color) (background dark))
-     (:background "steelblue4"))
-    (t
-     :inverse-video t))
-  "Used for displaying the whole match."
-  :group 're-builder)
-
-(defface reb-match-1
-  '((((class color) (background light))
-     (:background "#ffe9c8"))
-    (((class color) (background dark))
-     (:background "blue3"))
-    (t
-     :inverse-video t))
-  "Used for displaying the first matching subexpression."
-  :group 're-builder)
-
-(defface reb-match-2
-  '((((class color) (background light))
-     (:background "#f4ffc8"))
-    (((class color) (background dark))
-     (:background "chartreuse4"))
-    (t
-     :inverse-video t))
-  "Used for displaying the second matching subexpression."
-  :group 're-builder)
-
-(defface reb-match-3
-  '((((class color) (background light))
-     (:background "#d3ffc8"))
-    (((class color) (background dark))
-     (:background "sienna4"))
-    (t
-     :inverse-video t))
-  "Used for displaying the third matching subexpression."
-  :group 're-builder)
-
-(defface reb-match-4
-  '((((class color) (background light))
-     (:background "#c8ffde"))
-    (((class color) (background dark))
-     (:background "sienna4"))
-    (t
-     :inverse-video t))
-  "Used for displaying the third matching subexpression."
-  :group 're-builder)
-
-(defface reb-match-5
-  '((((class color) (background light))
-     (:background "#c8ffff"))
-    (((class color) (background dark))
-     (:background "sienna4"))
-    (t
-     :inverse-video t))
-  "Used for displaying the third matching subexpression."
-  :group 're-builder)
-
-(defface reb-match-6
-  '((((class color) (background light))
-     (:background "#c8deff"))
-    (((class color) (background dark))
-     (:background "sienna4"))
-    (t
-     :inverse-video t))
-  "Used for displaying the third matching subexpression."
-  :group 're-builder)
-
-(defface reb-match-7
-  '((((class color) (background light))
-     (:background "#d3c8ff"))
-    (((class color) (background dark))
-     (:background "sienna4"))
-    (t
-     :inverse-video t))
-  "Used for displaying the third matching subexpression."
-  :group 're-builder)
-
-(defface reb-match-8
-  '((((class color) (background light))
-     (:background "#f4c8ff"))
-    (((class color) (background dark))
-     (:background "sienna4"))
-    (t
-     :inverse-video t))
-  "Used for displaying the third matching subexpression."
-  :group 're-builder)
-
-(defface reb-match-9
-  '((((class color) (background light))
-     (:background "#ffc8e9"))
-    (((class color) (background dark))
-     (:background "sienna4"))
-    (t
-     :inverse-video t))
-  "Used for displaying the third matching subexpression."
-  :group 're-builder)
-
-;; Internal variables below
-(defvar reb-mode nil
-  "Enables the RE Builder minor mode.")
-
-(defvar reb-target-buffer nil
-  "Buffer to which the RE is applied to.")
-
-(defvar reb-target-window nil
-  "Window to which the RE is applied to.")
-
-(defvar reb-regexp nil
-  "Last regexp used by RE Builder.")
-
-(defvar reb-regexp-src nil
-  "Last regexp used by RE Builder before processing it.
-Except for Lisp syntax this is the same as `reb-regexp'.")
-
-(defvar reb-overlays nil
-  "List of overlays of the RE Builder.")
-
-(defvar reb-window-config nil
-  "Old window configuration.")
-
-(defvar reb-subexp-mode nil
-  "Indicates whether sub-exp mode is active.")
-
-(defvar reb-subexp-displayed nil
-  "Indicates which sub-exp is active.")
-
-(defvar reb-mode-string ""
-  "String in mode line for additional info.")
-
-(defvar reb-valid-string ""
-  "String in mode line showing validity of RE.")
-
-(defvar reb-perl-match-vector nil
-  "Last match data for perl syntax used by RE Builder.")
-
-(defvar reb-perl-match-index nil
-  "Last match data index for perl syntax used by RE Builder.")
-
-(make-variable-buffer-local 'reb-overlays)
-(make-variable-buffer-local 'reb-regexp)
-(make-variable-buffer-local 'reb-regexp-src)
-(make-variable-buffer-local 'reb-perl-match-vector)
-(make-variable-buffer-local 'reb-perl-match-index)
-
-(defconst reb-buffer "*RE-Builder*"
-  "Buffer to use for the RE Builder.")
-
-;; Define the local "\C-c" keymap
-(defvar reb-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-c\C-c" 'reb-toggle-case)
-    (define-key map "\C-c\C-q" 'reb-quit)
-    (define-key map "\C-c\C-w" 'reb-copy)
-    (define-key map "\C-c\C-s" 'reb-next-match)
-    (define-key map "\C-c\C-r" 'reb-prev-match)
-    (define-key map "\C-c\C-i" 'reb-change-syntax)
-    (define-key map "\C-c\C-e" 'reb-enter-subexp-mode)
-    (define-key map "\C-c\C-b" 'reb-change-target-buffer)
-    (define-key map "\C-c\C-u" 'reb-force-update)
-    map)
-  "Keymap used by the RE Builder.")
-
-(defun reb-mode ()
-  "Major mode for interactively building Regular Expressions.
-\\{reb-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'reb-mode
-        mode-name "RE Builder")
-  (use-local-map reb-mode-map)
-  (reb-mode-common)
-  (run-hooks 'reb-mode-hook))
-
-(define-derived-mode reb-lisp-mode
-  emacs-lisp-mode "RE Builder Lisp"
-  "Major mode for interactively building symbolic Regular Expressions."
-  (cond ((eq reb-re-syntax 'lisp-re)	; Pull in packages
-	 (require 'lisp-re))		; as needed
-	((eq reb-re-syntax 'sregex)	; sregex is not autoloaded
-	 (require 'sregex))		; right now..
-	((eq reb-re-syntax 'rx)		; rx-to-string is autoloaded
-	 (require 'rx)))		; require rx anyway
-  (reb-mode-common))
-
-;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from
-;; `emacs-lisp-mode'
-(define-key reb-lisp-mode-map "\C-c"
-  (lookup-key reb-mode-map "\C-c"))
-
-(defvar reb-subexp-mode-map
-  (let ((m (make-keymap)))
-    (suppress-keymap m)
-    ;; Again share the "\C-c" keymap for the commands
-    (define-key m "\C-c" (lookup-key reb-mode-map "\C-c"))
-    (define-key m "q" 'reb-quit-subexp-mode)
-    (dotimes (digit 10)
-      (define-key m (int-to-string digit) 'reb-display-subexp))
-    m)
-  "Keymap used by the RE Builder for the subexpression mode.")
-
-(defun reb-mode-common ()
-  "Setup functions common to functions `reb-mode' and `reb-mode-lisp'."
-
-  (setq	reb-mode-string  ""
-	reb-valid-string ""
-	mode-line-buffer-identification
-	                 '(25 . ("%b" reb-mode-string reb-valid-string)))
-  (reb-update-modestring)
-  (make-local-variable 'after-change-functions)
-  (add-hook 'after-change-functions
-	    'reb-auto-update)
-  ;; At least make the overlays go away if the buffer is killed
-  (make-local-variable 'reb-kill-buffer)
-  (add-hook 'kill-buffer-hook 'reb-kill-buffer)
-  (reb-auto-update nil nil nil))
-
-
-;; Handy macro for doing things in other windows
-(defmacro reb-with-current-window (window &rest body)
-  "With WINDOW selected evaluate BODY forms and reselect previous window."
-
-  (let ((oldwindow (make-symbol "*oldwindow*")))
-    `(let ((,oldwindow (selected-window)))
-       (select-window ,window)
-       (unwind-protect
-	   (progn
-	     ,@body)
-	 (select-window ,oldwindow)))))
-(put 'reb-with-current-window 'lisp-indent-function 0)
-
-(defun reb-color-display-p ()
-  "Return t if display is capable of displaying colors."
-  (eq 'color
-      ;; emacs/xemacs compatibility
-      (if (fboundp 'frame-parameter)
-	  (frame-parameter (selected-frame) 'display-type)
-	(device-class (frame-device (selected-frame))))))
-
-(defsubst reb-lisp-syntax-p ()
-  "Return non-nil if RE Builder uses a Lisp syntax."
-  (memq reb-re-syntax '(lisp-re sregex rx)))
-
-(defsubst reb-perl-syntax-p ()
-  "Return non-nil if RE Builder uses a Perl syntax."
-  (equal reb-re-syntax 'perl))
-
-(defmacro reb-target-binding (symbol)
-  "Return binding for SYMBOL in the RE Builder target buffer."
-  `(with-current-buffer reb-target-buffer ,symbol))
-
-;;; This is to help people find this in Apropos.
-;;;###autoload
-(defun regexp-builder ()
-  "Alias for `re-builder': Construct a regexp interactively."
-  (interactive)
-  (re-builder))
-
-;;;###autoload
-(defun re-builder ()
-  "Construct a regexp interactively."
-  (interactive)
-
-  (if (and (string= (buffer-name) reb-buffer)
-           (memq major-mode '(reb-mode reb-lisp-mode)))
-      (message "Already in the RE Builder")
-    (if reb-target-buffer
-        (reb-delete-overlays))
-    (setq reb-target-buffer (current-buffer)
-          reb-target-window (selected-window)
-          reb-window-config (current-window-configuration))
-    (select-window (split-window (selected-window) (- (window-height) 4)))
-    (switch-to-buffer (get-buffer-create reb-buffer))
-    (erase-buffer)
-    (reb-insert-regexp)
-    (goto-char (+ 2 (point-min)))
-    (cond
-     ((reb-lisp-syntax-p)
-      (reb-lisp-mode))
-     (t (reb-mode)))))
-
-(defun reb-change-target-buffer (buf)
-  "Change the target buffer and display it in the target window."
-  (interactive "bSet target buffer to: ")
-
-  (let ((buffer (get-buffer buf)))
-    (if (not buffer)
-        (error "No such buffer")
-      (reb-delete-overlays)
-      (setq reb-target-buffer buffer)
-      (reb-do-update
-       (if reb-subexp-mode reb-subexp-displayed nil))
-      (reb-update-modestring))))
-
-(defun reb-force-update ()
-  "Force an update in the RE Builder target window without a match limit."
-  (interactive)
-
-  (let ((reb-auto-match-limit nil))
-    (reb-update-overlays
-     (if reb-subexp-mode reb-subexp-displayed nil))))
-
-(defun reb-quit ()
-  "Quit the RE Builder mode."
-  (interactive)
-
-  (setq reb-subexp-mode nil
-	reb-subexp-displayed nil)
-  (reb-delete-overlays)
-  (bury-buffer)
-  (set-window-configuration reb-window-config))
-
-(defun reb-next-match ()
-  "Go to next match in the RE Builder target window."
-  (interactive)
-
-  (reb-assert-buffer-in-window)
-  (reb-with-current-window
-    reb-target-window
-    (if (not (reb-re-search-forward reb-regexp (point-max) t))
-	(message "No more matches.")
-      (reb-show-subexp
-       (or (and reb-subexp-mode reb-subexp-displayed) 0)
-       t))))
-
-(defun reb-prev-match ()
-  "Go to previous match in the RE Builder target window."
-  (interactive)
-
-  (reb-assert-buffer-in-window)
-  (reb-with-current-window reb-target-window
-    (goto-char (1- (point)))
-    (if (not (reb-re-search-backward reb-regexp (point-min) t))
-	(message "No more matches.")
-      (reb-show-subexp
-       (or (and reb-subexp-mode reb-subexp-displayed) 0)
-       t))))
-
-(defun reb-toggle-case ()
-  "Toggle case sensitivity of searches for RE Builder target buffer."
-  (interactive)
-
-  (with-current-buffer reb-target-buffer
-    (setq case-fold-search (not case-fold-search)))
-  (reb-update-modestring)
-  (reb-auto-update nil nil nil t))
-
-(defun reb-copy ()
-  "Copy current RE into the kill ring for later insertion."
-  (interactive)
-
-  (reb-update-regexp)
-  (let* ((kill (reb-target-binding reb-regexp)))
-    (unless (eq reb-re-syntax 'string)
-      (setq kill (with-output-to-string (prin1 kill))))
-    (kill-new kill)
-    (message "%s regexp %s copied to kill-ring"
-	     (symbol-name reb-re-syntax) kill)))
-
-;; The subexpression mode is not electric because the number of
-;; matches should be seen rather than a prompt.
-(defun reb-enter-subexp-mode ()
-  "Enter the subexpression mode in the RE Builder."
-  (interactive)
-  (setq reb-subexp-mode t)
-  (reb-update-modestring)
-  (use-local-map reb-subexp-mode-map)
-  (message "`0'-`9' to display subexpressions, `q' to quit subexp mode."))
-
-(defun reb-show-subexp (subexp &optional pause)
-  "Visually show limit of subexpression SUBEXP of recent search.
-On color displays this just puts point to the end of the expression as
-the match should already be marked by an overlay.
-On other displays jump to the beginning and the end of it.
-If the optional PAUSE is non-nil then pause at the end in any case."
-  (reb-with-current-window reb-target-window
-    (if (not (reb-color-display-p))
-	(progn (goto-char (match-beginning subexp))
-	       (sit-for reb-blink-delay)))
-    (goto-char (match-end subexp))
-    (if (or (not (reb-color-display-p)) pause)
-	(sit-for reb-blink-delay))))
-
-(defun reb-quit-subexp-mode ()
-  "Quit the subexpression mode in the RE Builder."
-  (interactive)
-  (setq reb-subexp-mode nil
-	reb-subexp-displayed nil)
-  (reb-update-modestring)
-  (use-local-map reb-mode-map)
-  (reb-do-update))
-
-(defun reb-change-syntax (&optional syntax)
-  "Change the syntax used by the RE Builder.
-Optional argument SYNTAX must be specified if called non-interactively."
-  (interactive
-   (list (intern
-	  (completing-read "Select syntax: "
-			   (mapcar (lambda (el) (cons (symbol-name el) 1))
-				   ;; APA TODO: Gotta be a way to
-				   ;; avoid duplication of choices
-				   ;; from `reb-re-syntax' here.
-				   '(read string lisp-re sregex rx perl))
-			   nil t (symbol-name reb-re-syntax)))))
-
-  (if (memq syntax '(read string lisp-re sregex rx perl))
-      (let ((buffer (get-buffer reb-buffer)))
-	(setq reb-re-syntax syntax)
-	(if buffer
-	    (with-current-buffer buffer
-	      (erase-buffer)
-	      (reb-insert-regexp)
-	      (goto-char (+ 2 (point-min)))
-	      (cond ((reb-lisp-syntax-p)
-		     (reb-lisp-mode))
-		    (t (reb-mode))))))
-    (error "Invalid syntax: %s" syntax)))
-
-
-;; Non-interactive functions below
-(defun reb-do-update (&optional subexp)
-  "Update matches in the RE Builder target window.
-If SUBEXP is non-nil mark only the corresponding sub-expressions."
-
-  (reb-assert-buffer-in-window)
-  (reb-update-regexp)
-  (reb-update-overlays subexp))
-
-(defun reb-auto-update (beg end lenold &optional force)
-  "Called from `after-update-functions' to update the display.
-BEG, END and LENOLD are passed in from the hook.
-An actual update is only done if the regexp has changed or if the
-optional fourth argument FORCE is non-nil."
-  (let ((prev-valid reb-valid-string)
-	(new-valid
-	 (condition-case nil
-	     (progn
-	       (if (or (reb-update-regexp) force)
-		   (progn
-		     (reb-assert-buffer-in-window)
-		     (reb-do-update)))
-	       "")
-	   (error " *invalid*"))))
-    (setq reb-valid-string new-valid)
-    (force-mode-line-update)
-
-    ;; Through the caching of the re a change invalidating the syntax
-    ;; for symbolic expressions will not delete the overlays so we
-    ;; catch it here
-    (if (and (reb-lisp-syntax-p)
-	     (not (string= prev-valid new-valid))
-	     (string= prev-valid ""))
-	(reb-delete-overlays))))
-
-(defun reb-delete-overlays ()
-  "Delete all RE Builder overlays in the `reb-target-buffer' buffer."
-  (if (buffer-live-p reb-target-buffer)
-      (with-current-buffer reb-target-buffer
-	(mapcar 'reb-delete-overlay reb-overlays)
-	(setq reb-overlays nil
-	      reb-perl-match-vector nil
-	      reb-perl-match-index nil))))
-
-(defun reb-assert-buffer-in-window ()
-  "Assert that `reb-target-buffer' is displayed in `reb-target-window'."
-
-  (if (not (eq reb-target-buffer (window-buffer reb-target-window)))
-      (set-window-buffer reb-target-window reb-target-buffer)))
-
-(defun reb-update-modestring ()
-  "Update the variable `reb-mode-string' displayed in the mode line."
-  (setq reb-mode-string
-	(concat
-	 (if reb-subexp-mode
-             (format " (subexp %s)" (or reb-subexp-displayed "-"))
-	   "")
-	 (if (not (reb-target-binding case-fold-search))
-	     " Case"
-	   "")
-	 " "
-	 (symbol-name reb-re-syntax)))
-  (force-mode-line-update))
-
-(defun reb-display-subexp (&optional subexp)
-  "Highlight only subexpression SUBEXP in the RE Builder."
-  (interactive)
-
-  (setq reb-subexp-displayed
-	(or subexp (string-to-int (format "%c" last-command-char))))
-  (reb-update-modestring)
-  (reb-do-update reb-subexp-displayed))
-
-(defun reb-kill-buffer ()
-  "When the RE Builder buffer is killed make sure no overlays stay around."
-
-  (if (member major-mode '(reb-mode reb-lisp-mode))
-      (reb-delete-overlays)))
-
-
-;; The next functions are the interface between the regexp and
-;; its textual representation in the RE Builder buffer.
-;; They are the only functions concerned with the actual syntax
-;; being used.
-(defun reb-read-regexp ()
-  "Read current RE."
-  (save-excursion
-    (cond ((eq reb-re-syntax 'read)
-	   (goto-char (point-min))
-	   (read (current-buffer)))
-	  ((member reb-re-syntax '(perl string))
-	   (goto-char (point-min))
-	   (re-search-forward "\"")
-	   (let ((beg (point)))
-	     (goto-char (point-max))
-	     (re-search-backward "\"")
-	     (buffer-substring-no-properties beg (point))))
-	  ((reb-lisp-syntax-p)
-	   (buffer-string)))))
-
-(defun reb-empty-regexp ()
-  "Return empty RE for current syntax."
-  (cond ((reb-lisp-syntax-p) "'()")
-	(t "")))
-
-(defun reb-insert-regexp ()
-  "Insert current RE."
-
-  (let ((re (or (reb-target-binding reb-regexp)
-		(reb-empty-regexp))))
-    (cond ((eq reb-re-syntax 'read)
-	   (print re (current-buffer)))
-	  ((member reb-re-syntax '(perl string))
-	   (insert "\n\"" re "\""))
-	  ;; For the Lisp syntax we need the "source" of the regexp
-	  ((reb-lisp-syntax-p)
-	   (insert (or (reb-target-binding reb-regexp-src)
-		       (reb-empty-regexp)))))))
-
-(defun reb-cook-regexp (re)
-  "Return RE after processing it according to `reb-re-syntax'."
-  (cond ((eq reb-re-syntax 'lisp-re)
-	 (lre-compile-string (eval (car (read-from-string re)))))
-	((eq reb-re-syntax 'sregex)
-	 (apply 'sregex (eval (car (read-from-string re)))))
-	((eq reb-re-syntax 'rx)
-	 (rx-to-string (eval (car (read-from-string re)))))
-	(t re)))
-
-(defun reb-update-regexp ()
-  "Update the regexp for the target buffer.
-Return t if the (cooked) expression changed."
-  (let* ((re-src (reb-read-regexp))
-	 (re (reb-cook-regexp re-src)))
-    (with-current-buffer reb-target-buffer
-      (let ((oldre reb-regexp))
-	(prog1
-	    (not (string= oldre re))
-	  (setq reb-regexp re)
-	  ;; Only update the source re for the lisp formats
-	  (if (reb-lisp-syntax-p)
-	      (setq reb-regexp-src re-src)))))))
-
-
-;; And now the real core of the whole thing
-(defun reb-count-subexps (re)
-  "Return number of sub-expressions in the regexp RE."
-
-  (let ((i 0) (beg 0))
-    ;; Remove character classes first, to avoid false subexp matches,
-    ;; then count beginnings of subexp grouping operators.
-    ;; Even before that remove escaped character class operators to
-    ;; simplify character class removal.
-    (let ((subexp-start-regexp (if (reb-perl-syntax-p) "(" "\\\\("))
-	  ;; escaped-char-class-regexp an char-class-regexp do not
-	  ;; differ between perl and lisp regexps.
-	  (escaped-char-class-regexp "\\\\[][]")
-	  (char-class-regexp "\\[^?.[^]]*\\]"))
-      (setq re (replace-regexp-in-string escaped-char-class-regexp "" re))
-      (setq re (replace-regexp-in-string char-class-regexp "" re))
-      (while (string-match subexp-start-regexp re beg)
-	(setq i (1+ i)
-	      beg (match-end 0)))
-      i)))
-
-
-(defun reb-update-overlays (&optional subexp)
-  "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
-If SUBEXP is non-nil mark only the corresponding sub-expressions."
-
-  (let* ((re (reb-target-binding reb-regexp))
-	 (subexps (reb-count-subexps re))
-	 (matches 0)
-	 (submatches 0)
-	 firstmatch)
-    (save-excursion
-      (set-buffer reb-target-buffer)
-      (reb-delete-overlays)
-      (goto-char (point-min))
-      (while (and (reb-re-search-forward re (point-max) t)
-		  (or (not reb-auto-match-limit)
-		      (< matches reb-auto-match-limit)))
-	(if (= 0 (length (match-string 0)))
-	    (error "Empty regular expression!"))
-	(let ((i 0))
-	  (setq matches (1+ matches))
-	  (while (<= i subexps)
-	    (if (and (or (not subexp) (= subexp i))
-		     (match-beginning i))
-		(let ((overlay (reb-make-overlay (match-beginning i)
-						 (match-end i)))
-		      (face-name (format "reb-match-%d" i)))
-		  (if (not firstmatch)
-		      ;; Use INTEGERS argument for reb-perl-syntax-p.
-		      (setq firstmatch (match-data (reb-perl-syntax-p))))
-		  (setq reb-overlays (cons overlay reb-overlays)
-			submatches (1+ submatches))
-		  (reb-overlay-put
-		   overlay 'face
-		   (or (intern-soft face-name)
-		       (error "Too many subexpressions - face `%s' not defined"
-			      face-name )))
-		  (reb-overlay-put overlay 'priority i)))
-	    (setq i (1+ i))))))
-    (let ((count (if subexp submatches matches)))
-      (message "%s %smatch%s%s"
-	       (if (= 0 count) "No" (int-to-string count))
-	       (if subexp "subexpression " "")
-	       (if (= 1 count) "" "es")
-	       (if (and reb-auto-match-limit
-			(= reb-auto-match-limit count))
-		   " (limit reached)" "")))
-    (if firstmatch
-	(progn (store-match-data firstmatch)
-	       (reb-show-subexp (or subexp 0))))))
-
-(defconst reb-perl-program
-  "
-use strict;
-
-# Adrian Aichner <adrian@xemacs.org>, The XEmacs Project, 2005-08-23.
-# Perl script returning match data to be used by re-builder.el
-
-my $re = qr{%s}%s;
-my @matches;
-
-# Read in whole data to count positions relative to begin of data
-# stream.
-# Shouldn't be a problem for typical use of re-builder.el.
-# re-builder.el should emit warning on huge target buffers.
-undef $/;
-
-sub main {
-    while (<DATA>) {
-        my $re_comment = $re;
-        $re_comment =~ s/\\n/\\n ;; /g;
-        printf \"[\\n ;; perl (v%%vd) one-based match-data for qr{$re_comment}\", $^V;
-        while (m{$re}g) {
-            print \"\\n [\";
-            for (my $i = 0; $i < scalar (@-); $i++) {
-                printf(\"(%%d %%d)\", pos() - $+[0] + $-[$i] + 1, pos() - $+[0] + $+[$i] + 1);
-            }
-            print \"]\";
-        }
-        print \"]\\n\";
-    }
-}
-
-main();
-
-__DATA__
-%s"
-  "Perl program control string to pass to `format'.
-
-The control-string contains three %s sequences to receive the regular
-expression string, the regular expression flags to pass on the perl's
-qr{RE}FLAGS; opeartor, and finally the buffer content to match
-against.
-")
-
-(defun reb-re-search-forward (regexp &optional limit noerror count buffer)
-  (cond
-   ((reb-perl-syntax-p)
-    (if (not (reb-target-binding reb-perl-match-vector))
-	(let ((program-buffer (get-buffer-create " *reb-perl-program*"))
-	      (match-buffer (get-buffer-create " *reb-perl-match-data*")))
-	  (unwind-protect
-	      (progn
-		(with-current-buffer
-		    program-buffer
-		  (erase-buffer)
-		  (insert
-		   (format reb-perl-program
-			   (reb-target-binding reb-regexp)
-			   (concat
-			    (if (reb-target-binding case-fold-search) "i" "")
-			    ;; use extended perl regexp syntax?
-			    "x")
-			   (buffer-string reb-target-buffer)))
-		  (call-process "perl"
-				(list (get-buffer " *reb-perl-program*"))
-				match-buffer))
-		(with-current-buffer reb-target-buffer
-		  (setq reb-perl-match-vector
-			(read (buffer-string match-buffer)))))
-	    (kill-buffer program-buffer)
-	    (kill-buffer match-buffer))))
-    (let* ((vector (reb-target-binding reb-perl-match-vector))
-	   (index (reb-target-binding reb-perl-match-index))
-	   (max-index (1- (length vector))))
-      ;; Make sure to preserve previous match data on failing search!
-      (if (not index)
-	  (setq index 0)
-	(incf index))
-      (when (<= index max-index)
-	(with-current-buffer reb-target-buffer
-	  (setq reb-perl-match-index index))
-	(store-match-data
-	 (apply 'append
-		(append
-		 (elt
-		  vector
-		  (reb-target-binding index))
-		 nil)))
-	(with-current-buffer reb-target-buffer
-	  (goto-char
-	   (elt
-	    (apply 'append
-		   (append
-		    (elt
-		     vector
-		     ;; match data for current match index:
-		     (reb-target-binding index))
-		    nil))
-	    ;; index to end of subexp 0 (end of whole match):
-	    1))))))
-   (t (re-search-forward regexp limit noerror count buffer))))
-
-(defun reb-re-search-backward (regexp &optional limit noerror count buffer)
-  (cond
-   ((reb-perl-syntax-p)
-    (let* ((vector (reb-target-binding reb-perl-match-vector))
-	   (index (reb-target-binding reb-perl-match-index))
-	   (max-index (1- (length vector))))
-      ;; Make sure to preserve previous match data on failing search!
-      (if (> index 0)
-	(decf index))
-      (when (>= index 0)
-	(with-current-buffer reb-target-buffer
-	  (setq reb-perl-match-index index))
-	(store-match-data
-	 (apply 'append
-		(append
-		 (elt
-		  vector
-		  (reb-target-binding index))
-		 nil)))
-	(with-current-buffer reb-target-buffer
-	  (goto-char
-	   (elt
-	    (apply 'append
-		   (append
-		    (elt
-		     vector
-		     ;; match data for current match index:
-		     (reb-target-binding index))
-		    nil))
-	    ;; index to end of subexp 0 (end of whole match):
-	    1))))))
-   (t (re-search-backward regexp limit noerror count buffer))))
-
-(provide 're-builder)
-
-;;; arch-tag: 5c5515ac-4085-4524-a421-033f44f032e7
-;;; re-builder.el ends here
diff --git a/xemacs-packages/lisp/sh-script/ChangeLog b/xemacs-packages/lisp/sh-script/ChangeLog
deleted file mode 100644
index 3e38755b..00000000
--- a/xemacs-packages/lisp/sh-script/ChangeLog
+++ /dev/null
@@ -1,127 +0,0 @@
-2005-10-18  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.21 released.
-
-2005-10-16  Ville Skyttä  <scop@xemacs.org>
-
-	* Makefile (AUTHOR_VERSION): Bring up to date (2.0f).
-
-2005-10-16  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.20 released.
-
-2005-10-15  Malcolm Purvis  <malcolmp@xemacs.org>
-
-	* executable.el: Sync with GNU Emacs 22.0.50.1 (CVS).  Update
-	FSF's address in GPL notices.
-
-2005-10-15  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.19 released.
-
-2005-10-12  Jérôme Marant  <jmarant@free.fr>
-
-	* sh-script.el: Sync with GNU Emacs 21.4
-        Update FSF's address in GPL notices.
-	(sh-mode-map): Move menu-related code to sh-mode-menu.
-	(sh-mode-menu): New menu definition.
-	(sh-mode): Install menu.
-
-2003-10-31  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.18 released.
-
-2003-03-09  Ben Wing  <ben@xemacs.org>
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-
-2003-01-13  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.17 released.
-
-2003-01-05  Ville Skyttä  <scop@xemacs.org>
-
-	* sh-script.el: Append .m?spec to auto-mode-alist instead of
-	adding to the front to restore order with this and rpm-spec-mode.
-	Make auto-mode and interpreter-mode-alist modifications
-	autoload-only.
-
-2002-11-29  Ben Wing  <ben@xemacs.org>
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15  Ville Skyttä  <scop@xemacs.org>
-
-	* Makefile (srckit): Remove.
-
-2002-10-07  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.16 released.
-
-2002-09-30  Ville Skyttä  <scop@xemacs.org>
-
-	* sh-script.el: Add autoloaded auto-mode-alist and
-	interpreter-mode-alist associations.
-
-2002-04-24  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.15 released.
-
-2002-04-03  Ville Skyttä  <scop@xemacs.org>
-
-	* executable.el: Sync with GNU Emacs 21.2.
-	(executable-binary-suffixes): New.
-	(executable-make-buffer-file-executable-if-script-p): New.
-	(executable-find): Use executable-binary-suffixes.
-
-2002-03-02  Jeff Miller <jmiller@cablespeed.com>
-
-	* executable.el:  missing autoload cookie.
-    
-2000-07-11  Jose Romildo Malaquias <romildo@urano.iceb.ufop.br>
-
-	* sh-script.el: Synch with FSF 20.7.
-
-1999-12-10  Gunnar Evermann  <ge204@eng.cam.ac.uk>
-
-	* sh-script.el (sh-ancestor-alist): Add bash2.
-	From Paul Cassella <fortytwo@cmu.edu>.
-
-1999-05-31  Andy Piper  <andyp@parallax.co.uk>
-
-	* sh-script.el (sh-set-shell): don't include the extension in
- 	sh-shell name.  This is almost never the right thing and breaks
- 	font-lock.
-
-1998-05-12  Andy Piper  <andyp@parallax.co.uk>
-
-	* sh-script.el (sh-shell): don't include the extension in the shell
-	name.  This is almost never the right thing and breaks font-lock.
-
-1998-01-24  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile (VERSION): Update to package standard 1.0.
-	* package-info.in: Ditto.
-
-1998-01-12  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile: Update to newer package interface.
-
-1998-01-03  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile: Update to newer package interface.
-
-1998-01-01  SL Baur  <steve@altair.xemacs.org>
-
-	* skeleton.el: removed.
-
-1997-12-24  SL Baur  <steve@altair.xemacs.org>
-
-	* sh-script.el: explicitly require 'skeleton to avoid bootstrap
-	problems.
-
-	* Makefile: Created.
-
diff --git a/xemacs-packages/lisp/sh-script/_pkg.el b/xemacs-packages/lisp/sh-script/_pkg.el
deleted file mode 100644
index 16d63f3a..00000000
--- a/xemacs-packages/lisp/sh-script/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'sh-script
-		 :version 1.21
-          :author-version "2.0f"
-		 :type 'regular)
diff --git a/xemacs-packages/lisp/sh-script/auto-autoloads.el b/xemacs-packages/lisp/sh-script/auto-autoloads.el
deleted file mode 100644
index dbb8af26..00000000
--- a/xemacs-packages/lisp/sh-script/auto-autoloads.el
+++ /dev/null
@@ -1,62 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'sh-script-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "sh-script/_pkg.el")
-
-(package-provide 'sh-script :version 1.21 :author-version "2.0f" :type 'regular)
-
-;;;***
-
-;;;### (autoloads (executable-make-buffer-file-executable-if-script-p executable-self-display executable-set-magic executable-interpret executable-find executable-command-find-posix-p) "executable" "sh-script/executable.el")
-
-(autoload 'executable-command-find-posix-p "executable" "\
-Check if PROGRAM handles arguments Posix-style.
-If PROGRAM is non-nil, use that instead of \"find\"." nil nil)
-
-(autoload 'executable-find "executable" "\
-Search for COMMAND in `exec-path' and return the absolute file name.
-Return nil if COMMAND is not found anywhere in `exec-path'." nil nil)
-
-(autoload 'executable-interpret "executable" "\
-Run script with user-specified args, and collect output in a buffer.
-While script runs asynchronously, you can use the \\[next-error]
-command to find the next error.  The buffer is also in `comint-mode' and
-`compilation-shell-minor-mode', so that you can answer any prompts." t nil)
-
-(autoload 'executable-set-magic "executable" "\
-Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
-The variables `executable-magicless-file-regexp', `executable-prefix',
-`executable-insert', `executable-query' and `executable-chmod' control
-when and how magic numbers are inserted or replaced and scripts made
-executable." t nil)
-
-(autoload 'executable-self-display "executable" "\
-Turn a text file into a self-displaying Un*x command.
-The magic number of such a command displays all lines but itself." t nil)
-
-(autoload 'executable-make-buffer-file-executable-if-script-p "executable" "\
-Make file executable according to umask if not already executable.
-If file already has any execute bits set at all, do not change existing
-file modes." nil nil)
-
-;;;***
-
-;;;### (autoloads (sh-mode) "sh-script" "sh-script/sh-script.el")
-
-(put 'sh-mode 'mode-class 'special)
-
-(autoload 'sh-mode "sh-script" "Major mode for editing shell scripts.\nThis mode works for many shells, since they all have roughly the same syntax,\nas far as commands, arguments, variables, pipes, comments etc. are concerned.\nUnless the file's magic number indicates the shell, your usual shell is\nassumed.  Since filenames rarely give a clue, they are not further analyzed.\n\nThis mode adapts to the variations between shells (see `sh-set-shell') by\nmeans of an inheritance based feature lookup (see `sh-feature').  This\nmechanism applies to all variables (including skeletons) that pertain to\nshell-specific features.\n\nThe default style of this mode is that of Rosenblatt's Korn shell book.\nThe syntax of the statements varies with the shell being used.  The\nfollowing commands are available, based on the current shell's syntax:\n\n\\[sh-case]	 case statement\n\\[sh-for]	 for loop\n\\[sh-function]	 function definition\n\\[sh-if]	 if statement\n\\[sh-indexed-loop]	 indexed loop from 1 to n\n\\[sh-while-getopts]	 while getopts loop\n\\[sh-repeat]	 repeat loop\n\\[sh-select]	 select loop\n\\[sh-until]	 until loop\n\\[sh-while]	 while loop\n\nFor sh and rc shells indentation commands are:\n\\[sh-show-indent]	Show the variable controlling this line's indentation.\n\\[sh-set-indent]	Set then variable controlling this line's indentation.\n\\[sh-learn-line-indent]	Change the indentation variable so this line\nwould indent to the way it currently is.\n\\[sh-learn-buffer-indent]  Set the indentation variables so the\nbuffer indents as it currently is indented.\n\n\n\\[backward-delete-char-untabify]	 Delete backward one position, even if it was a tab.\n\\[sh-newline-and-indent]	 Delete unquoted space and indent new line same as this one.\n\\[sh-end-of-command]	 Go to end of successive commands.\n\\[sh-beginning-of-command]	 Go to beginning of successive commands.\n\\[sh-set-shell]	 Set this buffer's shell, and maybe its magic number.\n\\[sh-execute-region]	 Have optional header and region be executed in a subshell.\n\n\\[sh-maybe-here-document]	 Without prefix, following an unquoted < inserts here document.\n{, (, [, ', \", `\n	Unless quoted with \\, insert the pairs {}, (), [], or '', \"\", ``.\n\nIf you generally program a shell different from your login shell you can\nset `sh-shell-file' accordingly.  If your shell's file name doesn't correctly\nindicate what shell it is use `sh-alias-alist' to translate.\n\nIf your shell gives error messages with line numbers, you can use \\[executable-interpret]\nwith your script for an edit-interpret-debug cycle." t nil)
-
-(defalias 'shell-script-mode 'sh-mode)
-(add-to-list 'auto-mode-alist '("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\\|logout\\)\\'" . sh-mode))
-(add-to-list 'auto-mode-alist '("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode))
-(add-to-list 'auto-mode-alist '("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode))
-(setq auto-mode-alist (append auto-mode-alist '(("\\.m?spec$" . sh-mode))))
-(add-to-list 'auto-mode-alist '("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode))
-(add-to-list 'interpreter-mode-alist '("^#!.*csh" . sh-mode))
-(add-to-list 'interpreter-mode-alist '("^#!.*sh\\b" . sh-mode))
-(add-to-list 'interpreter-mode-alist '("^:" . sh-mode))
-
-;;;***
-
-(provide 'sh-script-autoloads)
diff --git a/xemacs-packages/lisp/sh-script/custom-load.el b/xemacs-packages/lisp/sh-script/custom-load.el
deleted file mode 100644
index 25e9b9bb..00000000
--- a/xemacs-packages/lisp/sh-script/custom-load.el
+++ /dev/null
@@ -1,15 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'sh-script '("sh-script"))
-(custom-add-loads 'languages '("sh-script"))
-(custom-add-loads 'processes '("executable"))
-(custom-add-loads 'executable '("executable"))
-(custom-add-loads 'sh '("sh-script"))
-(custom-add-loads 'sh-indentation '("sh-script"))
-(custom-add-loads 'unix '("sh-script"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/sh-script/executable.el b/xemacs-packages/lisp/sh-script/executable.el
deleted file mode 100644
index a3b3dbbd..00000000
--- a/xemacs-packages/lisp/sh-script/executable.el
+++ /dev/null
@@ -1,315 +0,0 @@
-;;; executable.el --- base functionality for executable interpreter scripts -*- byte-compile-dynamic: t -*-
-
-;; Copyright (C) 1994, 1995, 1996, 2000, 2003, 2004 by Free Software Foundation, Inc.
-
-;; Author: Daniel Pfeiffer <occitan@esperanto.org>
-;; Keywords: languages, unix
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor
-;; Boston, MA 02110-1301, USA.
-
-;;; Synched up with: FSF 22.0.50.1 (CVS)
-
-;;; Commentary:
-
-;; executable.el is used by certain major modes to insert a suitable
-;; #! line at the beginning of the file, if the file does not already
-;; have one.
-
-;; Unless it has a magic number, a Unix file with executable mode is passed to
-;; a new instance of the running shell (or to a Bourne shell if a csh is
-;; running and the file starts with `:').  Only a shell can start such a file,
-;; exec() cannot, which is why it is important to have a magic number in every
-;; executable script.  Such a magic number is made up by the characters `#!'
-;; the filename of an interpreter (in COFF, ELF or somesuch format) and one
-;; optional argument.
-
-;; This library is for certain major modes like sh-, awk-, perl-, tcl- or
-;; makefile-mode to insert or update a suitable #! line at the beginning of
-;; the file, if the file does not already have one and the file is not a
-;; default file of that interpreter (like .profile or makefile).  It also
-;; makes the file executable if it wasn't, as soon as it's saved.
-
-;; It also allows debugging scripts, with an adaptation of compile, as far
-;; as interpreters give out meaningful error messages.
-
-;; Modes that use this should nconc `executable-map' to the end of their own
-;; keymap and `executable-font-lock-keywords' to the end of their own font
-;; lock keywords.  Their mode-setting commands should call
-;; `executable-set-magic'.
-
-;;; Code:
-
-;; XEmacs change
-(eval-when-compile
-  (require 'compile))
-
-(defgroup executable nil
-  "Base functionality for executable interpreter scripts"
-  :group 'processes)
-
-;; This used to default to `other', but that doesn't seem to have any
-;; significance.  fx 2000-02-11.
-(defcustom executable-insert t		; 'other
-  "*Non-nil means offer to add a magic number to a file.
-This takes effect when you switch to certain major modes,
-including Shell-script mode (`sh-mode').
-When you type \\[executable-set-magic], it always offers to add or
-update the magic number."
-;;;   :type '(choice (const :tag "off" nil)
-;;; 		 (const :tag "on" t)
-;;; 		 symbol)
-  :type 'boolean
-  :group 'executable)
-
-
-(defcustom executable-query 'function
-  "*If non-nil, ask user before changing an existing magic number.
-When this is `function', only ask when called non-interactively."
-  :type '(choice (const :tag "Don't Ask" nil)
-		 (const :tag "Ask when non-interactive" function)
-		 (other :tag "Ask" t))
-  :group 'executable)
-
-
-(defcustom executable-magicless-file-regexp "/[Mm]akefile$\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|.+shrc\\|esrc\\|rcrc\\|[kz]shenv\\)$"
-  "*On files with this kind of name no magic is inserted or changed."
-  :type 'regexp
-  :group 'executable)
-
-
-(defcustom executable-prefix "#! "
-  "*Interpreter magic number prefix inserted when there was no magic number."
-  :type 'string
-  :group 'executable)
-
-
-(defcustom executable-chmod 73
-  "*After saving, if the file is not executable, set this mode.
-This mode passed to `set-file-modes' is taken absolutely when negative, or
-relative to the files existing modes.  Do nothing if this is nil.
-Typical values are 73 (+x) or -493 (rwxr-xr-x)."
-  :type '(choice integer
-		 (const nil))
-  :group 'executable)
-
-
-(defvar executable-command nil)
-
-(defcustom executable-self-display "tail"
-  "*Command you use with argument `+2' to make text files self-display.
-Note that the like of `more' doesn't work too well under Emacs \\[shell]."
-  :type 'string
-  :group 'executable)
-
-
-(defvar executable-font-lock-keywords
-  '(("\\`#!.*/\\([^ \t\n]+\\)" 1 font-lock-keyword-face t))
-  "*Rules for highlighting executable scripts' magic number.
-This can be included in `font-lock-keywords' by modes that call `executable'.")
-
-
-(defvar executable-error-regexp-alist
-  '(;; /bin/xyz: syntax error at line 14: `(' unexpected
-    ;; /bin/xyz[5]: syntax error at line 8 : ``' unmatched
-    ("^\\(.*[^[/]\\)\\(\\[[0-9]+\\]\\)?: .* error .* line \\([0-9]+\\)" 1 3)
-    ;; /bin/xyz[27]: ehco:  not found
-    ("^\\(.*[^/]\\)\\[\\([0-9]+\\)\\]: .*: " 1 2)
-    ;; /bin/xyz: syntax error near unexpected token `)'
-    ;; /bin/xyz: /bin/xyz: line 2: `)'
-    ("^\\(.*[^/]\\): [^0-9\n]+\n\\1: \\1: line \\([0-9]+\\):" 1 2)
-    ;; /usr/bin/awk: syntax error at line 5 of file /bin/xyz
-    (" error .* line \\([0-9]+\\) of file \\(.+\\)$" 2 1)
-    ;; /usr/bin/awk: calling undefined function toto
-    ;;  input record number 3, file awktestdata
-    ;;  source line 4 of file /bin/xyz
-    ("^[^ ].+\n\\( .+\n\\)* line \\([0-9]+\\) of file \\(.+\\)$" 3 2)
-    ;; makefile:1: *** target pattern contains no `%'.  Stop.
-    ("^\\(.+\\):\\([0-9]+\\): " 1 2))
-  "Alist of regexps used to match script errors.
-See `compilation-error-regexp-alist'.")
-
-;; The C function openp slightly modified would do the trick fine
-(defvar executable-binary-suffixes
-  ;; XEmacs change: added cygwin32
-  (if (memq system-type '(ms-dos windows-nt cygwin32))
-      ;; .btm is for 4DOS and friends, <URL:http://www.jpsoft.com/>
-      '(".exe" ".com" ".bat" ".cmd" ".btm" "")
-    '("")))
-
-;;;###autoload
-(defun executable-command-find-posix-p (&optional program)
-  "Check if PROGRAM handles arguments Posix-style.
-If PROGRAM is non-nil, use that instead of \"find\"."
-  ;;  Pick file to search from location we know
-  (let* ((dir (file-truename data-directory))
-         (file (car (directory-files dir nil "^[^.]"))))
-    (with-temp-buffer
-      (call-process (or program "find")
-                    nil
-                    (current-buffer)
-                    nil
-                    dir
-                    "-name"
-                    file
-                    "-maxdepth"
-                    "1")
-        (goto-char (point-min))
-        (if (search-forward file nil t)
-            t))))
-
-;;;###autoload
-(defun executable-find (command)
-  "Search for COMMAND in `exec-path' and return the absolute file name.
-Return nil if COMMAND is not found anywhere in `exec-path'."
-  (let ((list exec-path)
-	file)
-    (while list
-      (setq list
-	    (if (and (setq file (expand-file-name command (car list)))
-		     (let ((suffixes executable-binary-suffixes)
-			   candidate)
-		       (while suffixes
-			 (setq candidate (concat file (car suffixes)))
-			 (if (and (file-executable-p candidate)
-				  (not (file-directory-p candidate)))
-			     (setq suffixes nil)
-			   (setq suffixes (cdr suffixes))
-			   (setq candidate nil)))
-		       (setq file candidate)))
-		nil
-	      (setq file nil)
-	      (cdr list))))
-    file))
-
-(defun executable-chmod ()
-  "This gets called after saving a file to assure that it be executable.
-You can set the absolute or relative mode in variable `executable-chmod' for
-non-executable files."
-  (and executable-chmod
-       buffer-file-name
-       (or (file-executable-p buffer-file-name)
-	   (set-file-modes buffer-file-name
-			   (if (< executable-chmod 0)
-			       (- executable-chmod)
-			     (logior executable-chmod
-				     (file-modes buffer-file-name)))))))
-
-
-;;;###autoload
-(defun executable-interpret (command)
-  "Run script with user-specified args, and collect output in a buffer.
-While script runs asynchronously, you can use the \\[next-error]
-command to find the next error.  The buffer is also in `comint-mode' and
-`compilation-shell-minor-mode', so that you can answer any prompts."
-  (interactive (list (read-string "Run script: "
-				  (or executable-command
-				      buffer-file-name))))
-  (require 'compile)
-  (save-some-buffers (not compilation-ask-about-save))
-  (set (make-local-variable 'executable-command) command)
-  (let ((compilation-error-regexp-alist executable-error-regexp-alist))
-    (compile-internal command t (lambda (x) "*interpretation*"))))
-
-
-
-;;;###autoload
-(defun executable-set-magic (interpreter &optional argument
-					 no-query-flag insert-flag)
-  "Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
-The variables `executable-magicless-file-regexp', `executable-prefix',
-`executable-insert', `executable-query' and `executable-chmod' control
-when and how magic numbers are inserted or replaced and scripts made
-executable."
-  (interactive
-   (let* ((name (read-string "Name or file name of interpreter: "))
-	  (arg (read-string (format "Argument for %s: " name))))
-     (list name arg (eq executable-query 'function) t)))
-
-  (setq interpreter (if (file-name-absolute-p interpreter)
-			interpreter
-		      (or (executable-find interpreter)
-			  (error "Interpreter %s not recognized"
-				 interpreter))))
-
-  (setq argument (concat (if (string-match "\\`/:" interpreter)
-			     (replace-match "" nil nil interpreter)
-			   interpreter)
-			 (and argument (string< "" argument) " ")
-			 argument))
-
-  (or buffer-read-only
-      (if buffer-file-name
-	  (string-match executable-magicless-file-regexp
-			buffer-file-name))
-      (not (or insert-flag executable-insert))
-      (> (point-min) 1)
-      (save-excursion
-	(goto-char (point-min))
-	(add-hook 'after-save-hook 'executable-chmod nil t)
-	(if (looking-at "#![ \t]*\\(.*\\)$")
-	    (and (goto-char (match-beginning 1))
-		 ;; If the line ends in a space,
-		 ;; don't offer to change it.
-		 (not (= (char-after (1- (match-end 1))) ?\ ))
-		 (not (string= argument
-			       (buffer-substring (point) (match-end 1))))
-		 (if (or (not executable-query) no-query-flag
-			 (save-window-excursion
-			   ;; Make buffer visible before question.
-			   (switch-to-buffer (current-buffer))
-			   (y-or-n-p (concat "Replace magic number by `"
-					     executable-prefix argument "'? "))))
-		     (progn
-		       (replace-match argument t t nil 1)
-		       (message "Magic number changed to `%s'"
-				(concat executable-prefix argument)))))
-	  (insert executable-prefix argument ?\n)
-	  (message "Magic number changed to `%s'"
-		   (concat executable-prefix argument)))))
-    interpreter)
-
-
-
-;;;###autoload
-(defun executable-self-display ()
-  "Turn a text file into a self-displaying Un*x command.
-The magic number of such a command displays all lines but itself."
-  (interactive)
-  (if (eq this-command 'executable-self-display)
-      (setq this-command 'executable-set-magic))
-  (executable-set-magic executable-self-display "+2"))
-
-;;;###autoload
-(defun executable-make-buffer-file-executable-if-script-p ()
-  "Make file executable according to umask if not already executable.
-If file already has any execute bits set at all, do not change existing
-file modes."
-  (and (>= (buffer-size) 2)
-       (save-restriction
-	 (widen)
-	 (string= "#!" (buffer-substring (point-min) (+ 2 (point-min)))))
-       (let* ((current-mode (file-modes (buffer-file-name)))
-              (add-mode (logand ?\111 (default-file-modes))))
-         (or (/= (logand ?\111 current-mode) 0)
-             (zerop add-mode)
-             (set-file-modes (buffer-file-name)
-                             (logior current-mode add-mode))))))
-
-(provide 'executable)
-
-;;; executable.el ends here
diff --git a/xemacs-packages/lisp/sh-script/sh-script.el b/xemacs-packages/lisp/sh-script/sh-script.el
deleted file mode 100644
index 03a3e718..00000000
--- a/xemacs-packages/lisp/sh-script/sh-script.el
+++ /dev/null
@@ -1,3589 +0,0 @@
-;;; sh-script.el --- shell-script editing commands for Emacs
-
-;; Copyright (C) 1993, 94, 95, 96, 97, 1999, 2001
-;;  Free Software Foundation, Inc.
-
-;; Author: Daniel Pfeiffer <occitan@esperanto.org>
-;; Version: 2.0f
-;; Maintainer: FSF
-;; Keywords: languages, unix
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
-;; 02110-1301, USA.
-
-;;; Synched up with: FSF 21.4.
-
-;;; Commentary:
-
-;; Major mode for editing shell scripts.  Bourne, C and rc shells as well
-;; as various derivatives are supported and easily derived from.  Structured
-;; statements can be inserted with one command or abbrev.  Completion is
-;; available for filenames, variables known from the script, the shell and
-;; the environment as well as commands.
-
-;;; Known Bugs:
-
-;; - In Bourne the keyword `in' is not anchored to case, for, select ...
-;; - Variables in `"' strings aren't fontified because there's no way of
-;;   syntactically distinguishing those from `'' strings.
-
-;;		Indentation
-;;	 	===========
-;; Indentation for rc and es modes is very limited, but for Bourne shells
-;; and its derivatives it is quite customizable.
-;;
-;; The following description applies to sh and derived shells (bash,
-;; zsh, ...).
-;;
-;; There are various customization variables which allow tailoring to
-;; a wide variety of styles.  Most of these variables are named
-;; sh-indent-for-XXX and sh-indent-after-XXX.  For example.
-;; sh-indent-after-if controls the indenting of a line following
-;; an if statement, and sh-indent-for-fi controls the indentation
-;; of the line containing the fi.
-;;
-;; You can set each to a numeric value, but it is often more convenient
-;; to a symbol such as `+' which uses the value of variable `sh-basic-offset'.
-;; By changing this one variable you can increase or decrease how much
-;; indentation there is.  Valid symbols:
-;;
-;; 	+   Indent right by sh-basic-offset
-;; 	-   Indent left  by sh-basic-offset
-;; 	++  Indent right twice sh-basic-offset
-;; 	--  Indent left  twice sh-basic-offset
-;; 	*   Indent right half sh-basic-offset
-;; 	/   Indent left  half sh-basic-offset.
-;;
-;; There are 4 commands to help set the indentation variables:
-;;
-;; `sh-show-indent'
-;;    This shows what variable controls the indentation of the current
-;;    line and its value.
-;;
-;; `sh-set-indent'
-;;    This allows you to set the value of the variable controlling the
-;;    current line's indentation.  You can enter a number or one of a
-;;    number of special symbols to denote the value of sh-basic-offset,
-;;    or its negative, or half it, or twice it, etc.  If you've used
-;;    cc-mode this should be familiar.  If you forget which symbols are
-;;    valid simply press C-h at the prompt.
-;;
-;; `sh-learn-line-indent'
-;;    Simply make the line look the way you want it, then invoke this
-;;    command.  It will set the variable to the value that makes the line
-;;    indent like that.  If called with a prefix argument then it will set
-;;    the value to one of the symbols if applicable.
-;;
-;; `sh-learn-buffer-indent'
-;;    This is the deluxe function!  It "learns" the whole buffer (use
-;;    narrowing if you want it to process only part).  It outputs to a
-;;    buffer *indent* any conflicts it finds, and all the variables it has
-;;    learned.  This buffer is a sort of Occur mode buffer, allowing you to
-;;    easily find where something was set.  It is popped to automatically
-;;    if there are any conflicts found or if `sh-popup-occur-buffer' is
-;;    non-nil.
-;;    `sh-indent-comment' will be set if all comments follow  the same
-;;    pattern;  if they don't it will be set to nil.
-;;    Whether `sh-basic-offset' is set is determined by variable
-;;    `sh-learn-basic-offset'.
-;;
-;;    Unfortunately, `sh-learn-buffer-indent' can take a long time to run
-;;    (e.g. if there are large case statements).  Perhaps it does not make
-;;    sense to run it on large buffers: if lots of lines have different
-;;    indentation styles it will produce a lot of diagnostics in the
-;;    *indent* buffer; if there is a consistent style then running
-;;    `sh-learn-buffer-indent' on a small region of the buffer should
-;;    suffice.
-;;
-;; 	Saving indentation values
-;; 	-------------------------
-;; After you've learned the values in a buffer, how to you remember
-;; them?   Originally I had hoped that `sh-learn-buffer-indent'
-;; would make this unnecessary;  simply learn the values when you visit
-;; the buffer.
-;; You can do this automatically like this:
-;;   (add-hook 'sh-set-shell-hook 'sh-learn-buffer-indent)
-;;
-;; However...  `sh-learn-buffer-indent' is extremely slow,
-;; especially on large-ish buffer.  Also, if there are conflicts the
-;; "last one wins" which may not produce the desired setting.
-;;
-;; So...There is a minimal way of being able to save indentation values and
-;; to reload them in another buffer or at another point in time.
-;;
-;; Use `sh-name-style' to give a name to the indentation settings of
-;; 	the current buffer.
-;; Use `sh-load-style' to load indentation settings for the current
-;; 	buffer from a specific style.
-;; Use `sh-save-styles-to-buffer' to write all the styles to a buffer
-;; 	in lisp code.  You can then store it in a file and later use
-;; 	`load-file' to load it.
-;;
-;; 	Indentation variables - buffer local or global?
-;; 	----------------------------------------------
-;; I think that often having them buffer-local makes sense,
-;; especially if one is using `sh-learn-buffer-indent'.  However, if
-;; a user sets values using customization, these changes won't appear
-;; to work if the variables are already local!
-;;
-;; To get round this, there is a variable `sh-make-vars-local' and 2
-;; functions: `sh-make-vars-local' and `sh-reset-indent-vars-to-global-values'.
-;;
-;; If `sh-make-vars-local' is non-nil, then these variables become
-;; buffer local when the mode is established.
-;; If this is nil, then the variables are global.  At any time you
-;; can make them local with the command `sh-make-vars-local'.
-;; Conversely, to update with the global values you can use the
-;; command `sh-reset-indent-vars-to-global-values'.
-;;
-;; This may be awkward, but the intent is to cover all cases.
-;;
-;; 	Awkward things, pitfalls
-;; 	------------------------
-;; Indentation for a sh script is complicated for a number of reasons:
-;;
-;; 1. You can't format by simply looking at symbols, you need to look
-;;    at keywords.  [This is not the case for rc and es shells.]
-;; 2. The character ")" is used both as a matched pair "(" ... ")" and
-;;    as a stand-alone symbol (in a case alternative).  This makes
-;;    things quite tricky!
-;; 3. Here-documents in a script should be treated "as is", and when
-;;    they terminate we want to revert to the indentation of the line
-;;    containing the "<<" symbol.
-;; 4. A line may be continued using the "\".
-;; 5. The character "#" (outside a string) normally starts a comment,
-;;    but it doesn't in the sequence "$#"!
-;;
-;; To try and address points 2 3 and 5 I used a feature that cperl mode
-;; uses, that of a text's syntax property.  This, however, has 2
-;; disadvantages:
-;; 1. We need to scan the buffer to find which ")" symbols belong to a
-;;    case alternative, to find any here documents, and handle "$#".
-;; 2. Setting the text property makes the buffer modified.  If the
-;;    buffer is read-only buffer we have to cheat and bypass the read-only
-;;    status.  This is for cases where the buffer started read-only buffer
-;;    but the user issued `toggle-read-only'.
-;;
-;; 	Bugs
-;; 	----
-;; - Indenting many lines is slow.  It currently does each line
-;;   independently, rather than saving state information.
-;;
-;; - `sh-learn-buffer-indent' is extremely slow.
-;;
-;; Richard Sharman <rsharman@pobox.com>  June 1999.
-
-;;; Code:
-
-;; page 1:	variables and settings
-;; page 2:	indentation stuff
-;; page 3:	mode-command and utility functions
-;; page 4:	statement syntax-commands for various shells
-;; page 5:	various other commands
-
-(eval-when-compile
-  (require 'skeleton)
-  (require 'comint))
-(require 'executable)
-
-
-
-(defgroup sh nil
-  "Shell programming utilities"
-  :group 'unix
-  :group 'languages)
-
-(defgroup sh-script nil
-  "Shell script mode"
-  :group 'sh
-  :prefix "sh-")
-
-;;; interpreter-mode-alist is not compatible between Emacs and XEmacs.
-;;; So fake it.
-
-(defvar sh-interpreter-mode-alist
-  '(("perl" . perl-mode)
-    ("perl5" . perl-mode)
-    ("wish" . tcl-mode)
-    ("wishx" . tcl-mode)
-    ("tcl" . tcl-mode)
-    ("tclsh" . tcl-mode)
-    ("awk" . awk-mode)
-    ("mawk" . awk-mode)
-    ("nawk" . awk-mode)
-    ("gawk" . awk-mode)
-    ("scm" . scheme-mode)
-    ("ash" . sh-mode)
-    ("bash" . sh-mode)
-    ("csh" . sh-mode)
-    ("dtksh" . sh-mode)
-    ("es" . sh-mode)
-    ("itcsh" . sh-mode)
-    ("jsh" . sh-mode)
-    ("ksh" . sh-mode)
-    ("oash" . sh-mode)
-    ("pdksh" . sh-mode)
-    ("rc" . sh-mode)
-    ("sh" . sh-mode)
-    ("sh5" . sh-mode)
-    ("cmd" . sh-mode)
-    ("tcsh" . sh-mode)
-    ("wksh" . sh-mode)
-    ("wsh" . sh-mode)
-    ("zsh" . sh-mode)
-    ("tail" . text-mode)
-    ("more" . text-mode)
-    ("less" . text-mode)
-    ("pg" . text-mode))
-  "Alist mapping interpreter names to major modes.
-This alist applies to files whose first line starts with `#!'.
-Each element looks like (INTERPRETER . MODE).
-The car of each element is compared with
-the name of the interpreter specified in the first line.
-If it matches, mode MODE is selected.")
-
-(defcustom sh-ancestor-alist
-  '((ash . sh)
-    (bash . jsh)
-    (bash2 . jsh)
-    (dtksh . ksh)
-    (es . rc)
-    (itcsh . tcsh)
-    (jcsh . csh)
-    (jsh . sh)
-    (ksh . ksh88)
-    (ksh88 . jsh)
-    (oash . sh)
-    (pdksh . ksh88)
-    (posix . sh)
-    (tcsh . csh)
-    (wksh . ksh88)
-    (wsh . sh)
-    (zsh . ksh88)
-    (rpm . sh))
-  "*Alist showing the direct ancestor of various shells.
-This is the basis for `sh-feature'.  See also `sh-alias-alist'.
-By default we have the following three hierarchies:
-
-csh		C Shell
-  jcsh		C Shell with Job Control
-  tcsh		Toronto C Shell
-    itcsh	? Toronto C Shell
-rc		Plan 9 Shell
-  es		Extensible Shell
-sh		Bourne Shell
-  ash		? Shell
-  jsh		Bourne Shell with Job Control
-    bash	GNU Bourne Again Shell
-    ksh88	Korn Shell '88
-      ksh	Korn Shell '93
-	dtksh	CDE Desktop Korn Shell
-      pdksh	Public Domain Korn Shell
-      wksh	Window Korn Shell
-      zsh	Z Shell
-  oash		SCO OA (curses) Shell
-  posix		IEEE 1003.2 Shell Standard
-  wsh		? Shell"
-  :type '(repeat (cons symbol symbol))
-  :group 'sh-script)
-
-
-(defcustom sh-alias-alist
-  ;; XEmacs change: Linux is spelled `linux'
-  (nconc (if (eq system-type 'linux)
-	     '((csh . tcsh)
-	       (ksh . pdksh)))
-	 ;; for the time being
-	 '((ksh . ksh88)
-           (bash2 . bash)
-	   (sh5 . sh)))
-  "*Alist for transforming shell names to what they really are.
-Use this where the name of the executable doesn't correspond to the type of
-shell it really is."
-  :type '(repeat (cons symbol symbol))
-  :group 'sh-script)
-
-
-(defcustom sh-shell-file
-  (or
-   ;; On MSDOS and Windows, collapse $SHELL to lower-case and remove
-   ;; the executable extension, so comparisons with the list of
-   ;; known shells work.
-   (and (memq system-type '(ms-dos windows-nt))
-	(let* ((shell (getenv "SHELL"))
-	       (shell-base
-		(and shell (file-name-nondirectory shell))))
-	  ;; shell-script mode doesn't support DOS/Windows shells,
-	  ;; so use the default instead.
-	  (if (or (null shell)
-		  (member (downcase shell-base)
-			  '("command.com" "cmd.exe" "4dos.com" "ndos.com"
-			    "cmdproxy.exe")))
-	      "/bin/sh"
-	    (file-name-sans-extension (downcase shell)))))
-   (getenv "SHELL")
-   "/bin/sh")
-  "*The executable file name for the shell being programmed."
-  :type 'string
-  :group 'sh-script)
-
-
-(defcustom sh-shell-arg
-  ;; bash does not need any options when run in a shell script,
-  '((bash)
-    (csh . "-f")
-    (pdksh)
-    ;; Bill_Mann@praxisint.com says -p with ksh can do harm.
-    (ksh88)
-    ;; -p means don't initialize functions from the environment.
-    (rc . "-p")
-    ;; Someone proposed -motif, but we don't want to encourage
-    ;; use of a non-free widget set.
-    (wksh)
-    ;; -f means don't run .zshrc.
-    (zsh . "-f"))
-  "*Single argument string for the magic number.  See `sh-feature'."
-  :type '(repeat (cons (symbol :tag "Shell")
-		       (choice (const :tag "No Arguments" nil)
-			       (string :tag "Arguments")
-			       (cons :format "Evaluate: %v"
-				     (const :format "" eval)
-				     sexp))))
-  :group 'sh-script)
-
-(defcustom sh-imenu-generic-expression
-  `((sh
-     . ((nil "^\\s-*\\(function\\s-+\\)?\\([A-Za-z_][A-Za-z_0-9]+\\)\\s-*()" 2))))
-  "*Alist of regular expressions for recognizing shell function definitions.
-See `sh-feature' and `imenu-generic-expression'."
-  :type '(alist :key-type (symbol :tag "Shell")
-		:value-type (alist :key-type (choice :tag "Title"
-						     string
-						     (const :tag "None" nil))
-				   :value-type
-				   (repeat :tag "Regexp, index..." sexp)))
-  :group 'sh-script
-  :version "20.4")
-
-(defvar sh-shell-variables nil
-  "Alist of shell variable names that should be included in completion.
-These are used for completion in addition to all the variables named
-in `process-environment'.  Each element looks like (VAR . VAR), where
-the car and cdr are the same symbol.")
-
-(defvar sh-shell-variables-initialized nil
-  "Non-nil if `sh-shell-variables' is initialized.")
-
-(defun sh-canonicalize-shell (shell)
-  "Convert a shell name SHELL to the one we should handle it as."
-  (if (string-match "\\.exe\\'" shell)
-      (setq shell (substring shell 0 (match-beginning 0))))
-  (or (symbolp shell)
-      (setq shell (intern shell)))
-  (or (cdr (assq shell sh-alias-alist))
-      shell))
-
-(defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file))
-  "The shell being programmed.  This is set by \\[sh-set-shell].")
-
-;;; I turned off this feature because it doesn't permit typing commands
-;;; in the usual way without help.
-;;;(defvar sh-abbrevs
-;;;  '((csh eval sh-abbrevs shell
-;;;	 "switch" 'sh-case
-;;;	 "getopts" 'sh-while-getopts)
-
-;;;    (es eval sh-abbrevs shell
-;;;	"function" 'sh-function)
-
-;;;    (ksh88 eval sh-abbrevs sh
-;;;	   "select" 'sh-select)
-
-;;;    (rc eval sh-abbrevs shell
-;;;	"case" 'sh-case
-;;;	"function" 'sh-function)
-
-;;;    (sh eval sh-abbrevs shell
-;;;	"case" 'sh-case
-;;;	"function" 'sh-function
-;;;	"until" 'sh-until
-;;;	"getopts" 'sh-while-getopts)
-
-;;;    ;; The next entry is only used for defining the others
-;;;    (shell "for" sh-for
-;;;	   "loop" sh-indexed-loop
-;;;	   "if" sh-if
-;;;	   "tmpfile" sh-tmp-file
-;;;	   "while" sh-while)
-
-;;;    (zsh eval sh-abbrevs ksh88
-;;;	 "repeat" 'sh-repeat))
-;;;  "Abbrev-table used in Shell-Script mode.  See `sh-feature'.
-;;;Due to the internal workings of abbrev tables, the shell name symbol is
-;;;actually defined as the table for the like of \\[edit-abbrevs].")
-
-
-
-(easy-mmode-defsyntax sh-mode-syntax-table
-  '((?\# . "<")
-   (?\^l . ">#")
-   (?\n . ">#")
-   (?\" . "\"\"")
-   (?\' . "\"'")
-   (?\` . "\"`")
-   (?! . "_")
-   (?% . "_")
-   (?: . "_")
-   (?. . "_")
-   (?^ . "_")
-   (?~ . "_")
-   (?< . ".")
-   (?> . "."))
-  "Syntax-table used in Shell-Script mode.")
-
-
-(defvar sh-mode-map
-  (let ((map (make-sparse-keymap))
-	(menu-map (make-sparse-keymap "Insert")))
-    (define-key map "\C-c(" 'sh-function)
-    (define-key map "\C-c\C-w" 'sh-while)
-    (define-key map "\C-c\C-u" 'sh-until)
-    (define-key map "\C-c\C-t" 'sh-tmp-file)
-    (define-key map "\C-c\C-s" 'sh-select)
-    (define-key map "\C-c\C-r" 'sh-repeat)
-    (define-key map "\C-c\C-o" 'sh-while-getopts)
-    (define-key map "\C-c\C-l" 'sh-indexed-loop)
-    (define-key map "\C-c\C-i" 'sh-if)
-    (define-key map "\C-c\C-f" 'sh-for)
-    (define-key map "\C-c\C-c" 'sh-case)
-    (define-key map "\C-c?" 'sh-show-indent)
-    (define-key map "\C-c=" 'sh-set-indent)
-    (define-key map "\C-c<" 'sh-learn-line-indent)
-    (define-key map "\C-c>" 'sh-learn-buffer-indent)
-
-    (define-key map "=" 'sh-assignment)
-    (define-key map "\C-c+" 'sh-add)
-    (define-key map "\C-\M-x" 'sh-execute-region)
-    (define-key map "\C-c\C-x" 'executable-interpret)
-    (define-key map "<" 'sh-maybe-here-document)
-    (define-key map "(" 'skeleton-pair-insert-maybe)
-    (define-key map "{" 'skeleton-pair-insert-maybe)
-    (define-key map "[" 'skeleton-pair-insert-maybe)
-    (define-key map "'" 'skeleton-pair-insert-maybe)
-    (define-key map "`" 'skeleton-pair-insert-maybe)
-    (define-key map "\"" 'skeleton-pair-insert-maybe)
-
-    (substitute-key-definition 'complete-tag 'comint-dynamic-complete
-			       map (current-global-map))
-    (substitute-key-definition 'newline-and-indent 'sh-newline-and-indent
-			       map (current-global-map))
-;; XEmacs change: Don't mess around with the DEL bindings
-;    (substitute-key-definition 'delete-backward-char
-;			       'backward-delete-char-untabify
-;			       map (current-global-map))
-    (define-key map "\C-c:" 'sh-set-shell)
-    (substitute-key-definition 'beginning-of-defun
-			       'sh-beginning-of-compound-command
-			       map (current-global-map))
-    (substitute-key-definition 'backward-sentence 'sh-beginning-of-command
-			       map (current-global-map))
-    (substitute-key-definition 'forward-sentence 'sh-end-of-command
-			       map (current-global-map))
-    map)
-  "Keymap used in Shell-Script mode.")
-
-;; XEmacs change
-(easy-menu-define
- sh-mode-menu sh-mode-map "Menu for sh-script mode"
-     '("Insert"
-       ["While Loop" sh-while t]
-       ["Until Loop" sh-until t]
-       ["Temporary File" sh-tmp-file t]
-       ["Select Statement" sh-select t]
-       ["Repeat Loop" sh-repeat t]
-       ["Options Loop" sh-while-getopts t]
-       ["Indexed Loop" sh-indexed-loop t]
-       ["If Statement" sh-if t]
-       ["For Loop" sh-for t]
-       ["Case Statement" sh-case t]))
-
-(defcustom sh-dynamic-complete-functions
-  '(shell-dynamic-complete-environment-variable
-    shell-dynamic-complete-command
-    comint-dynamic-complete-filename)
-  "*Functions for doing TAB dynamic completion."
-  :type '(repeat function)
-  :group 'sh-script)
-
-
-(defcustom sh-require-final-newline
-  '((csh . t)
-    (pdksh . t)
-    (rc eval . require-final-newline)
-    (sh eval . require-final-newline))
-  "*Value of `require-final-newline' in Shell-Script mode buffers.
-See `sh-feature'."
-  :type '(repeat (cons (symbol :tag "Shell")
-		       (choice (const :tag "require" t)
-			       (cons :format "Evaluate: %v"
-				     (const :format "" eval)
-				     sexp))))
-  :group 'sh-script)
-
-
-(defcustom sh-assignment-regexp
-  '((csh . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=")
-    ;; actually spaces are only supported in let/(( ... ))
-    (ksh88 . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=")
-    (rc . "\\<\\([a-zA-Z0-9_*]+\\)[ \t]*=")
-    (sh . "\\<\\([a-zA-Z0-9_]+\\)="))
-  "*Regexp for the variable name and what may follow in an assignment.
-First grouping matches the variable name.  This is upto and including the `='
-sign.  See `sh-feature'."
-  :type '(repeat (cons (symbol :tag "Shell")
-		       (choice regexp
-			       (cons :format "Evaluate: %v"
-				     (const :format "" eval)
-				     sexp))))
-  :group 'sh-script)
-
-
-(defcustom sh-indentation 4
-  "The width for further indentation in Shell-Script mode."
-  :type 'integer
-  :group 'sh-script)
-
-
-(defcustom sh-remember-variable-min 3
-  "*Don't remember variables less than this length for completing reads."
-  :type 'integer
-  :group 'sh-script)
-
-
-(defvar sh-header-marker nil
-  "When non-nil is the end of header for prepending by \\[sh-execute-region].
-That command is also used for setting this variable.")
-
-
-(defcustom sh-beginning-of-command
-  "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~a-zA-Z0-9:]\\)"
-  "*Regexp to determine the beginning of a shell command.
-The actual command starts at the beginning of the second \\(grouping\\)."
-  :type 'regexp
-  :group 'sh-script)
-
-
-(defcustom sh-end-of-command
-  "\\([/~a-zA-Z0-9:]\\)[ \t]*\\([;#)}`|&]\\|$\\)"
-  "*Regexp to determine the end of a shell command.
-The actual command ends at the end of the first \\(grouping\\)."
-  :type 'regexp
-  :group 'sh-script)
-
-
-
-(defvar sh-here-document-word "EOF"
-  "Word to delimit here documents.")
-
-(defvar sh-test
-  '((sh "[  ]" . 3)
-    (ksh88 "[[  ]]" . 4))
-  "Initial input in Bourne if, while and until skeletons.  See `sh-feature'.")
-
-
-;; customized this out of sheer bravado.  not for the faint of heart.
-;; but it *did* have an asterisk in the docstring!
-(defcustom sh-builtins
-  '((bash eval sh-append posix
-	  "alias" "bg" "bind" "builtin" "declare" "dirs" "enable" "fc" "fg"
-	  "help" "history" "jobs" "kill" "let" "local" "popd" "pushd" "source"
-	  "suspend" "typeset" "unalias")
-
-    ;; The next entry is only used for defining the others
-    (bourne eval sh-append shell
-	    "eval" "export" "getopts" "newgrp" "pwd" "read" "readonly"
-	    "times" "ulimit")
-
-    (csh eval sh-append shell
-	 "alias" "chdir" "glob" "history" "limit" "nice" "nohup" "rehash"
-	 "setenv" "source" "time" "unalias" "unhash")
-
-    (dtksh eval identity wksh)
-
-    (es "access" "apids" "cd" "echo" "eval" "false" "let" "limit" "local"
-	"newpgrp" "result" "time" "umask" "var" "vars" "wait" "whatis")
-
-    (jsh eval sh-append sh
-	 "bg" "fg" "jobs" "kill" "stop" "suspend")
-
-    (jcsh eval sh-append csh
-	  "bg" "fg" "jobs" "kill" "notify" "stop" "suspend")
-
-    (ksh88 eval sh-append bourne
-	   "alias" "bg" "false" "fc" "fg" "jobs" "kill" "let" "print" "time"
-	   "typeset" "unalias" "whence")
-
-    (oash eval sh-append sh
-	  "checkwin" "dateline" "error" "form" "menu" "newwin" "oadeinit"
-	  "oaed" "oahelp" "oainit" "pp" "ppfile" "scan" "scrollok" "wattr"
-	  "wclear" "werase" "win" "wmclose" "wmmessage" "wmopen" "wmove"
-	  "wmtitle" "wrefresh")
-
-    (pdksh eval sh-append ksh88
-	   "bind")
-
-    (posix eval sh-append sh
-	   "command")
-
-    (rc "builtin" "cd" "echo" "eval" "limit" "newpgrp" "shift" "umask" "wait"
-	"whatis")
-
-    (sh eval sh-append bourne
-	"hash" "test" "type")
-
-    ;; The next entry is only used for defining the others
-    (shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait")
-
-    (wksh eval sh-append ksh88
-	  "Xt[A-Z][A-Za-z]*")
-
-    (zsh eval sh-append ksh88
-	 "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs"
-	 "disable" "disown" "echotc" "enable" "functions" "getln" "hash"
-	 "history" "integer" "limit" "local" "log" "popd" "pushd" "r"
-	 "readonly" "rehash" "sched" "setopt" "source" "suspend" "true"
-	 "ttyctl" "type" "unfunction" "unhash" "unlimit" "unsetopt" "vared"
-	 "which"))
-  "*List of all shell builtins for completing read and fontification.
-Note that on some systems not all builtins are available or some are
-implemented as aliases.  See `sh-feature'."
-  :type '(repeat (cons (symbol :tag "Shell")
-		       (choice (repeat string)
-			       (cons :format "Evaluate: %v"
-				     (const :format "" eval)
-				     sexp))))
-  :group 'sh-script)
-
-
-
-(defcustom sh-leading-keywords
-  '((csh "else")
-
-    (es "true" "unwind-protect" "whatis")
-
-    (rc "else")
-
-    (sh "do" "elif" "else" "if" "then" "trap" "type" "until" "while"))
-  "*List of keywords that may be immediately followed by a builtin or keyword.
-Given some confusion between keywords and builtins depending on shell and
-system, the distinction here has been based on whether they influence the
-flow of control or syntax.  See `sh-feature'."
-  :type '(repeat (cons (symbol :tag "Shell")
-		       (choice (repeat string)
-			       (cons :format "Evaluate: %v"
-				     (const :format "" eval)
-				     sexp))))
-  :group 'sh-script)
-
-
-(defcustom sh-other-keywords
-  '((bash eval sh-append bourne
-	  "bye" "logout")
-
-    ;; The next entry is only used for defining the others
-    (bourne eval sh-append sh
-	    "function")
-
-    (csh eval sh-append shell
-	 "breaksw" "default" "end" "endif" "endsw" "foreach" "goto"
-	 "if" "logout" "onintr" "repeat" "switch" "then" "while")
-
-    (es "break" "catch" "exec" "exit" "fn" "for" "forever" "fork" "if"
-	"return" "throw" "while")
-
-    (ksh88 eval sh-append bourne
-	   "select")
-
-    (rc "break" "case" "exec" "exit" "fn" "for" "if" "in" "return" "switch"
-	"while")
-
-    (sh eval sh-append shell
-	"done" "esac" "fi" "for" "in" "return")
-
-    ;; The next entry is only used for defining the others
-    (shell "break" "case" "continue" "exec" "exit")
-
-    (zsh eval sh-append bash
-	 "select"))
-  "*List of keywords not in `sh-leading-keywords'.
-See `sh-feature'."
-  :type '(repeat (cons (symbol :tag "Shell")
-		       (choice (repeat string)
-			       (cons :format "Evaluate: %v"
-				     (const :format "" eval)
-				     sexp))))
-  :group 'sh-script)
-
-
-
-(defvar sh-variables
-  '((bash eval sh-append sh
-	  "allow_null_glob_expansion" "auto_resume" "BASH" "BASH_VERSION"
-	  "cdable_vars" "ENV" "EUID" "FCEDIT" "FIGNORE" "glob_dot_filenames"
-	  "histchars" "HISTFILE" "HISTFILESIZE" "history_control" "HISTSIZE"
-	  "hostname_completion_file" "HOSTTYPE" "IGNOREEOF" "ignoreeof"
-	  "LINENO" "MAIL_WARNING" "noclobber" "nolinks" "notify"
-	  "no_exit_on_failed_exec" "NO_PROMPT_VARS" "OLDPWD" "OPTERR" "PPID"
-	  "PROMPT_COMMAND" "PS4" "pushd_silent" "PWD" "RANDOM" "REPLY"
-	  "SECONDS" "SHLVL" "TMOUT" "UID")
-
-    (csh eval sh-append shell
-	 "argv" "cdpath" "child" "echo" "histchars" "history" "home"
-	 "ignoreeof" "mail" "noclobber" "noglob" "nonomatch" "path" "prompt"
-	 "shell" "status" "time" "verbose")
-
-    (es eval sh-append shell
-	"apid" "cdpath" "CDPATH" "history" "home" "ifs" "noexport" "path"
-	"pid" "prompt" "signals")
-
-    (jcsh eval sh-append csh
-	  "notify")
-
-    (ksh88 eval sh-append sh
-	   "ENV" "ERRNO" "FCEDIT" "FPATH" "HISTFILE" "HISTSIZE" "LINENO"
-	   "OLDPWD" "PPID" "PS3" "PS4" "PWD" "RANDOM" "REPLY" "SECONDS"
-	   "TMOUT")
-
-    (oash eval sh-append sh
-	  "FIELD" "FIELD_MAX" "LAST_KEY" "OALIB" "PP_ITEM" "PP_NUM")
-
-    (rc eval sh-append shell
-	"apid" "apids" "cdpath" "CDPATH" "history" "home" "ifs" "path" "pid"
-	"prompt" "status")
-
-    (sh eval sh-append shell
-	"CDPATH" "IFS" "OPTARG" "OPTIND" "PS1" "PS2")
-
-    ;; The next entry is only used for defining the others
-    (shell "COLUMNS" "EDITOR" "HOME" "HUSHLOGIN" "LANG" "LC_COLLATE"
-	   "LC_CTYPE" "LC_MESSAGES" "LC_MONETARY" "LC_NUMERIC" "LC_TIME"
-	   "LINES" "LOGNAME" "MAIL" "MAILCHECK" "MAILPATH" "PAGER" "PATH"
-	   "SHELL" "TERM" "TERMCAP" "TERMINFO" "VISUAL")
-
-    (tcsh eval sh-append csh
-	  "addsuffix" "ampm" "autocorrect" "autoexpand" "autolist"
-	  "autologout" "chase_symlinks" "correct" "dextract" "edit" "el"
-	  "fignore" "gid" "histlit" "HOST" "HOSTTYPE" "HPATH"
-	  "ignore_symlinks" "listjobs" "listlinks" "listmax" "matchbeep"
-	  "nobeep" "NOREBIND" "oid" "printexitvalue" "prompt2" "prompt3"
-	  "pushdsilent" "pushdtohome" "recexact" "recognize_only_executables"
-	  "rmstar" "savehist" "SHLVL" "showdots" "sl" "SYSTYPE" "tcsh" "term"
-	  "tperiod" "tty" "uid" "version" "visiblebell" "watch" "who"
-	  "wordchars")
-
-    (zsh eval sh-append ksh88
-	 "BAUD" "bindcmds" "cdpath" "DIRSTACKSIZE" "fignore" "FIGNORE" "fpath"
-	 "HISTCHARS" "hostcmds" "hosts" "HOSTS" "LISTMAX" "LITHISTSIZE"
-	 "LOGCHECK" "mailpath" "manpath" "NULLCMD" "optcmds" "path" "POSTEDIT"
-	 "prompt" "PROMPT" "PROMPT2" "PROMPT3" "PROMPT4" "psvar" "PSVAR"
-	 "READNULLCMD" "REPORTTIME" "RPROMPT" "RPS1" "SAVEHIST" "SPROMPT"
-	 "STTY" "TIMEFMT" "TMOUT" "TMPPREFIX" "varcmds" "watch" "WATCH"
-	 "WATCHFMT" "WORDCHARS" "ZDOTDIR"))
-  "List of all shell variables available for completing read.
-See `sh-feature'.")
-
-
-;;; Font-Lock support
-
-(defface sh-heredoc-face
-  '((((class color)
-      (background dark))
-     (:foreground "yellow" :bold t))
-    (((class color)
-      (background light))
-     (:foreground "tan" ))
-    (t
-     (:bold t)))
-  "Face to show a here-document"
-:group 'sh-indentation)
-(defvar sh-heredoc-face 'sh-heredoc-face)
-
-
-(defvar sh-font-lock-keywords
-  '((csh eval sh-append shell
-	 '("\\${?[#?]?\\([A-Za-z_][A-Za-z0-9_]*\\|0\\)" 1
-	   font-lock-variable-name-face))
-
-    (es eval sh-append executable-font-lock-keywords
-	'("\\$#?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\)" 1
-	  font-lock-variable-name-face))
-
-    (rc eval identity es)
-
-    (sh eval sh-append shell
-	;; Variable names.
-	'("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2
-	  font-lock-variable-name-face)
-	;; Function names.
-	'("^\\(\\sw+\\)[ \t]*(" 1 font-lock-function-name-face)
-	'("\\<\\(function\\)\\>[ \t]*\\(\\sw+\\)?"
-	  (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)))
-
-    ;; The next entry is only used for defining the others
-    (shell eval sh-append executable-font-lock-keywords
-	   '("\\\\[^A-Za-z0-9]" 0 font-lock-string-face)
-	   '("\\${?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\|[$*_]\\)" 1
-	     font-lock-variable-name-face))
-    (rpm eval sh-append rpm2
-	 '("%{?\\(\\sw+\\)"  1 font-lock-keyword-face))
-    (rpm2 eval sh-append shell
-	  '("^\\(\\sw+\\):"  1 font-lock-variable-name-face)))
-  "Default expressions to highlight in Shell Script modes.  See `sh-feature'.")
-
-(defvar sh-font-lock-keywords-1
-  '((sh "[ \t]in\\>"))
-  "Subdued level highlighting for Shell Script modes.")
-
-(defvar sh-font-lock-keywords-2 ()
-  "Gaudy level highlighting for Shell Script modes.")
-
-;; These are used for the syntax table stuff (derived from cperl-mode).
-;; Note: parse-sexp-lookup-properties must be set to t for it to work.
-
-;; XEmacs change: syntax-string-to-code replaces string-to-syntax
-(defconst sh-st-punc (syntax-string-to-code "."))
-(defconst sh-st-symbol (syntax-string-to-code "_"))
-(defconst sh-here-doc-syntax (syntax-string-to-code "|")) ;; generic string
-
-(defun sh-font-lock-heredoc (start string quoted)
-  "Determine the syntax of the \\n after a <<HEREDOC."
-  (unless (sh-in-comment-or-string start)
-    ;; We're looking at <<STRING, so we add "^STRING$" to the syntactic
-    ;; font-lock keywords to detect the end of this here document.
-    (let ((ere (concat
-		"^" (if quoted "[ \t]*")
-		(regexp-quote (replace-regexp-in-string "['\"]" "" string))
-		"\\(\n\\)")))
-      (unless (assoc ere font-lock-syntactic-keywords)
-	(let* (	;; A rough regexp that should find us back.
-	       (sre (concat "<<\\(-\\)?\\s-*\\\\?['\"]?"
-			    (regexp-quote string) "['\"]?[ \t\n]"))
-	       (code `(cond
-		       ((save-excursion (re-search-backward ,sre nil t))
-			;; This ^STRING$ is indeed following a <<STRING
-			sh-here-doc-syntax)
-		       ((not (save-excursion (re-search-forward ,sre nil t)))
-			;; There's no <<STRING either before or after us,
-			;; so we should remove this now obsolete entry.
-			(setq font-lock-syntactic-keywords
-			      (delq (assoc ,ere font-lock-syntactic-keywords)
-				    font-lock-syntactic-keywords))
-			nil))))
-	  ;; Use destructive update so the new keyword gets used right away.
-	  (setq font-lock-syntactic-keywords
-		(nconc font-lock-syntactic-keywords
-		       (list (font-lock-compile-keyword `(,ere 1 ,code))))))))
-    sh-here-doc-syntax))
-
-(defun sh-font-lock-paren (start)
-  (save-excursion
-    (goto-char start)
-    ;; Skip through all patterns
-    (while
-	(progn
-	  (forward-comment (- (point-max)))
-	  ;; Skip through one pattern
-	  (while
-	      (or (/= 0 (skip-syntax-backward "w_"))
-		  (/= 0 (skip-chars-backward "?*/"))
-		  (when (memq (char-before) '(?\" ?\'))
-		    (condition-case nil (progn (backward-sexp 1) t)
-		      (error nil)))))
-	  (forward-comment (- (point-max)))
-	  (when (eq (char-before) ?|)
-	    (backward-char 1) t)))
-    (when (save-excursion (backward-char 2) (looking-at ";;\\|in"))
-      sh-st-punc)))
-
-(defconst sh-font-lock-syntactic-keywords
-  ;; A `#' begins a comment when it is unquoted and at the beginning of a
-  ;; word.  In the shell, words are separated by metacharacters.
-  ;; The list of special chars is taken from the single-unix spec
-  ;; of the shell command language (under `quoting') but with `$' removed.
-  `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol)
-    ;; Find HEREDOC starters and add a corresponding rule for the ender.
-    ("[^<>]<<\\(-\\)?\\s-*\\\\?\\(\\(['\"][^'\"]+['\"]\\|\\sw\\|\\s_\\)+\\).*\\(\n\\)"
-     4 (sh-font-lock-heredoc
-	(match-beginning 0) (match-string 2) (match-end 1)))
-    ;; Distinguish the special close-paren in `case'.
-    (")" 0 (sh-font-lock-paren (match-beginning 0)))))
-
-(defun sh-font-lock-syntactic-face-function (state)
-  (if (nth 3 state)
-      (if (char-valid-p (nth 3 state))
-	  font-lock-string-face
-	sh-heredoc-face)
-    font-lock-comment-face))
-
-(defgroup sh-indentation nil
-  "Variables controlling indentation in shell scripts.
-
-Note: customizing these variables will not affect existing buffers if
-`sh-make-vars-local' is no-nil.  See the documentation for
-variable `sh-make-vars-local', command `sh-make-vars-local'
-and command `sh-reset-indent-vars-to-global-values'."
-:group 'sh-script)
-
-
-(defcustom sh-set-shell-hook nil
-  "*Hook run by `sh-set-shell'."
-:type 'hook
-:group 'sh-script)
-
-(defcustom sh-mode-hook nil
-  "*Hook run by `sh-mode'."
-:type 'hook
-:group 'sh-script)
-
-(defcustom sh-learn-basic-offset nil
-  "*When `sh-guess-basic-offset' should learn `sh-basic-offset'.
-
-nil mean:              never.
-t means:               only if there seems to be an obvious value.
-Anything else means:   whenever we have a \"good guess\" as to the value."
-:type '(choice
-	  (const :tag "Never" nil)
-	  (const :tag "Only if sure"  t)
-	  (const :tag "If have a good guess" usually))
-:group 'sh-indentation)
-
-(defcustom sh-popup-occur-buffer nil
-  "*Controls when  `sh-learn-buffer-indent' pops the *indent* buffer.
-If t it is always shown.  If nil, it is shown only when there
-are conflicts."
-:type '(choice
-	  (const :tag "Only when there are conflicts." nil)
-	  (const :tag "Always"  t))
-:group 'sh-indentation)
-
-(defcustom sh-blink t
-  "*If non-nil, `sh-show-indent' shows the line indentation is relative to.
-The position on the line is not necessarily meaningful.
-In some cases the line will be the matching keyword, but this is not
-always the case."
-:type 'boolean
-:group 'sh-indentation)
-
-(defcustom sh-first-lines-indent 0
-  "*The indentation of the first non-blank non-comment line.
-Usually 0 meaning first column.
-Can be set to a number, or to nil which means leave it as is."
-:type '(choice
-	  (const :tag "Leave as is"	nil)
-	  (integer :tag "Column number"
-		   :menu-tag "Indent to this col (0 means first col)" ))
-:group 'sh-indentation)
-
-
-(defcustom sh-basic-offset 4
-  "*The default indentation increment.
-This value is used for the + and - symbols in an indentation variable."
-:type 'integer
-:group 'sh-indentation)
-
-(defcustom sh-indent-comment nil
-  "*How a comment line is to be indented.
-nil means leave it as it is;
-t  means indent it as a normal line, aligning it to previous non-blank
-   non-comment line;
-a number means align to that column, e.g. 0 means fist column."
-:type '(choice
-	  (const :tag "Leave as is." nil)
-	  (const :tag "Indent as a normal line."  t)
-	  (integer :menu-tag "Indent to this col (0 means first col)."
-		   :tag "Indent to column number.") )
-:group 'sh-indentation)
-
-
-(defvar sh-debug nil
-  "Enable lots of debug messages - if function `sh-debug' is enabled.")
-
-
-;; Uncomment this defun and comment the defmacro for debugging.
-;; (defun sh-debug (&rest args)
-;;   "For debugging:  display message ARGS if variable SH-DEBUG is non-nil."
-;;   (if sh-debug
-;;       (apply 'message args)))
-(defmacro sh-debug (&rest args))
-
-(defconst sh-symbol-list
-  '((const :tag "+ "  :value +
-	   :menu-tag "+   Indent right by sh-basic-offset")
-    (const :tag "- "  :value -
-	   :menu-tag "-   Indent left  by sh-basic-offset")
-    (const :tag "++"  :value  ++
-	   :menu-tag "++  Indent right twice sh-basic-offset")
-    (const :tag "--"  :value --
-	   :menu-tag "--  Indent left  twice sh-basic-offset")
-    (const :tag "* " :value *
-	   :menu-tag "*   Indent right half sh-basic-offset")
-    (const :tag "/ " :value /
-	   :menu-tag "/   Indent left  half sh-basic-offset")))
-
-(defcustom sh-indent-for-else 0
-  "*How much to indent an else relative to an if.  Usually 0."
-:type `(choice
-	  (integer :menu-tag "A number (positive=>indent right)"
-		   :tag "A number")
-	  (const :tag "--") ;; separator!
-	  ,@ sh-symbol-list
-	  )
-:group 'sh-indentation)
-
-(defconst sh-number-or-symbol-list
-  (append '((integer :menu-tag "A number (positive=>indent right)"
-		     :tag "A number")
-	    (const :tag "--"))		; separator
-	  sh-symbol-list))
-
-(defcustom sh-indent-for-fi 0
-  "*How much to indent a fi relative to an if.  Usually 0."
-:type `(choice ,@ sh-number-or-symbol-list )
-:group 'sh-indentation)
-
-(defcustom sh-indent-for-done '0
-  "*How much to indent a done relative to its matching stmt.  Usually 0."
-:type `(choice ,@ sh-number-or-symbol-list )
-:group 'sh-indentation)
-
-(defcustom sh-indent-after-else '+
-  "*How much to indent a statement after an else statement."
-:type `(choice ,@ sh-number-or-symbol-list )
-:group 'sh-indentation)
-
-(defcustom sh-indent-after-if '+
-  "*How much to indent a statement after an if statement.
-This includes lines after else and elif statements, too, but
-does not affect then else elif or fi statements themselves."
-:type `(choice ,@ sh-number-or-symbol-list )
-:group 'sh-indentation)
-
-(defcustom sh-indent-for-then '+
-  "*How much to indent a then relative to an if."
-:type `(choice ,@ sh-number-or-symbol-list )
-:group 'sh-indentation)
-
-(defcustom sh-indent-for-do '*
-  "*How much to indent a do statement.
-This is relative to the statement before the do, i.e. the
-while until or for statement."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-(defcustom sh-indent-after-do '*
-  "*How much to indent a line after a do statement.
-This is used when the do is the first word of the line.
-This is relative to the statement before the do, e.g. a
-while for repeat or select statement."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-(defcustom sh-indent-after-loop-construct '+
-  "*How much to indent a statement after a loop construct.
-
-This variable is used when the keyword \"do\" is on the same line as the
-loop statement (e.g.  \"until\", \"while\" or \"for\").
-If the do is on a line by itself, then `sh-indent-after-do' is used instead."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-
-(defcustom sh-indent-after-done 0
-  "*How much to indent a statement after a \"done\" keyword.
-Normally this is 0, which aligns the \"done\" to the matching
-looping construct line.
-Setting it non-zero allows you to have the \"do\" statement on a line
-by itself and align the done under to do."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-(defcustom sh-indent-for-case-label '+
-  "*How much to indent a case label statement.
-This is relative to the line containing the case statement."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-(defcustom sh-indent-for-case-alt '++
-  "*How much to indent statements after the case label.
-This is relative to the line containing the case statement."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-
-(defcustom sh-indent-for-continuation '+
-  "*How much to indent for a continuation statement."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-(defcustom sh-indent-after-open '+
-  "*How much to indent after a line with an opening parenthesis or brace.
-For an open paren after a function `sh-indent-after-function' is used."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-(defcustom sh-indent-after-function '+
-  "*How much to indent after a function line."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-;; These 2 are for the rc shell:
-
-(defcustom sh-indent-after-switch '+
-  "*How much to indent a case statement relative to the switch statement.
-This is for the rc shell."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-(defcustom sh-indent-after-case '+
-  "*How much to indent a statement relative to the case statement.
-This is for the rc shell."
-:type `(choice ,@ sh-number-or-symbol-list)
-:group 'sh-indentation)
-
-;; Internal use - not designed to be changed by the user:
-
-(defun sh-mkword-regexpr (word)
-  "Make a regexp which matches WORD as a word.
-This specifically excludes an occurrence of WORD followed by
-punctuation characters like '-'."
-  (concat word "\\([^-a-z0-9_]\\|$\\)"))
-
-(defconst sh-re-done (sh-mkword-regexpr "done"))
-
-
-(defconst sh-kws-for-done
-  '((sh .  ( "while" "until" "for" ) )
-    (bash . ( "while" "until" "for" "select"  ) )
-    (ksh88 . ( "while" "until" "for" "select"  ) )
-    (zsh .  ( "while" "until" "for" "repeat" "select" ) ) )
-  "Which keywords can match the word `done' in this shell.")
-
-
-(defconst sh-indent-supported
-  '((sh . t)
-    (csh . nil)
-    (rc . t))
-  "Shell types that shell indenting can do something with.")
-
-(defvar sh-indent-supported-here nil
-  "Non-nil if we support indentation for the current buffer's shell type.")
-
-(defconst sh-electric-rparen-needed
-  '((sh . t))
-  "Non-nil if the shell type needs an electric handling of case alternatives.")
-
-(defconst sh-var-list
-  '(
-    sh-basic-offset sh-first-lines-indent sh-indent-after-case
-    sh-indent-after-do sh-indent-after-done
-    sh-indent-after-else
-    sh-indent-after-if
-    sh-indent-after-loop-construct
-    sh-indent-after-open
-    sh-indent-comment
-    sh-indent-for-case-alt
-    sh-indent-for-case-label
-    sh-indent-for-continuation
-    sh-indent-for-do
-    sh-indent-for-done
-    sh-indent-for-else
-    sh-indent-for-fi
-    sh-indent-for-then
-    )
-  "A list of variables used by script mode to control indentation.
-This list is used when switching between buffer-local and global
-values of variables, and for the commands using indentation styles.")
-
-(defvar sh-make-vars-local t
-  "*Controls whether indentation variables are local to the buffer.
-If non-nil, indentation variables are made local initially.
-If nil, you can later make the variables local by invoking
-command `sh-make-vars-local'.
-The default is t because I assume that in one Emacs session one is
-frequently editing existing scripts with different styles.")
-
-
-;; mode-command and utility functions
-
-;;;###autoload
-(put 'sh-mode 'mode-class 'special)
-
-;;;###autoload
-(define-derived-mode sh-mode nil "Shell-script"
-  "Major mode for editing shell scripts.
-This mode works for many shells, since they all have roughly the same syntax,
-as far as commands, arguments, variables, pipes, comments etc. are concerned.
-Unless the file's magic number indicates the shell, your usual shell is
-assumed.  Since filenames rarely give a clue, they are not further analyzed.
-
-This mode adapts to the variations between shells (see `sh-set-shell') by
-means of an inheritance based feature lookup (see `sh-feature').  This
-mechanism applies to all variables (including skeletons) that pertain to
-shell-specific features.
-
-The default style of this mode is that of Rosenblatt's Korn shell book.
-The syntax of the statements varies with the shell being used.  The
-following commands are available, based on the current shell's syntax:
-
-\\[sh-case]	 case statement
-\\[sh-for]	 for loop
-\\[sh-function]	 function definition
-\\[sh-if]	 if statement
-\\[sh-indexed-loop]	 indexed loop from 1 to n
-\\[sh-while-getopts]	 while getopts loop
-\\[sh-repeat]	 repeat loop
-\\[sh-select]	 select loop
-\\[sh-until]	 until loop
-\\[sh-while]	 while loop
-
-For sh and rc shells indentation commands are:
-\\[sh-show-indent]	Show the variable controlling this line's indentation.
-\\[sh-set-indent]	Set then variable controlling this line's indentation.
-\\[sh-learn-line-indent]	Change the indentation variable so this line
-would indent to the way it currently is.
-\\[sh-learn-buffer-indent]  Set the indentation variables so the
-buffer indents as it currently is indented.
-
-
-\\[backward-delete-char-untabify]	 Delete backward one position, even if it was a tab.
-\\[sh-newline-and-indent]	 Delete unquoted space and indent new line same as this one.
-\\[sh-end-of-command]	 Go to end of successive commands.
-\\[sh-beginning-of-command]	 Go to beginning of successive commands.
-\\[sh-set-shell]	 Set this buffer's shell, and maybe its magic number.
-\\[sh-execute-region]	 Have optional header and region be executed in a subshell.
-
-\\[sh-maybe-here-document]	 Without prefix, following an unquoted < inserts here document.
-{, (, [, ', \", `
-	Unless quoted with \\, insert the pairs {}, (), [], or '', \"\", ``.
-
-If you generally program a shell different from your login shell you can
-set `sh-shell-file' accordingly.  If your shell's file name doesn't correctly
-indicate what shell it is use `sh-alias-alist' to translate.
-
-If your shell gives error messages with line numbers, you can use \\[executable-interpret]
-with your script for an edit-interpret-debug cycle."
-  (make-local-variable 'skeleton-end-hook)
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-start-skip)
-  (make-local-variable 'require-final-newline)
-  (make-local-variable 'sh-header-marker)
-  (make-local-variable 'sh-shell-file)
-  (make-local-variable 'sh-shell)
-  (make-local-variable 'skeleton-pair-alist)
-  (make-local-variable 'skeleton-pair-filter)
-  (make-local-variable 'comint-dynamic-complete-functions)
-  (make-local-variable 'comint-prompt-regexp)
-  (make-local-variable 'font-lock-defaults)
-  (make-local-variable 'skeleton-filter)
-  (make-local-variable 'skeleton-newline-indent-rigidly)
-  (make-local-variable 'sh-shell-variables)
-  (make-local-variable 'sh-shell-variables-initialized)
-  (make-local-variable 'imenu-generic-expression)
-  (make-local-variable 'sh-indent-supported-here)
-  (setq skeleton-end-hook (lambda ()
-			    (or (eolp) (newline) (indent-relative)))
-	paragraph-start (concat page-delimiter "\\|$")
-	paragraph-separate paragraph-start
-	comment-start "# "
-	comint-dynamic-complete-functions sh-dynamic-complete-functions
-	;; we can't look if previous line ended with `\'
-	comint-prompt-regexp "^[ \t]*"
-	font-lock-defaults
-	`((sh-font-lock-keywords
-	   sh-font-lock-keywords-1 sh-font-lock-keywords-2)
-	  nil nil
-	  ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil
-	  (font-lock-syntactic-keywords
-	   ;; Copy so we can use destructive update in `sh-font-lock-heredoc'.
-	   . ,(copy-sequence sh-font-lock-syntactic-keywords))
-	  (font-lock-syntactic-face-function
-	   . sh-font-lock-syntactic-face-function))
-	skeleton-pair-alist '((?` _ ?`))
-	skeleton-pair-filter 'sh-quoted-p
-	skeleton-further-elements '((< '(- (min sh-indentation
-						(current-column)))))
-	skeleton-filter 'sh-feature
-	skeleton-newline-indent-rigidly t
-	sh-indent-supported-here nil)
-  (set (make-local-variable 'parse-sexp-ignore-comments) t)
-  ;; Parse or insert magic number for exec, and set all variables depending
-  ;; on the shell thus determined.
-  (let ((interpreter
-	 (save-excursion
-	   (goto-char (point-min))
-	   (cond ((looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
-		  (match-string 2))
-		 ((and buffer-file-name
-		       (string-match "\\.m?spec$" buffer-file-name))
-		  "rpm")))))
-    (sh-set-shell (or interpreter sh-shell-file) nil nil))
-  ;; XEmacs change
-  (if sh-mode-menu
-      (easy-menu-add sh-mode-menu)))
-
-;;;###autoload
-(defalias 'shell-script-mode 'sh-mode)
-
-;;; XEmacs change
-(put 'sh-mode 'font-lock-defaults
-     `((sh-font-lock-keywords
-	sh-font-lock-keywords-1
-	sh-font-lock-keywords-2)))
-;;       ,sh-font-lock-keywords-only
-;;       nil
-;;       ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w"))))
-
-
-(defun sh-font-lock-keywords (&optional keywords)
-  "Function to get simple fontification based on `sh-font-lock-keywords'.
-This adds rules for comments and assignments."
-  (sh-feature sh-font-lock-keywords
-	      (when (stringp (sh-feature sh-assignment-regexp))
-		(lambda (list)
-		  `((,(sh-feature sh-assignment-regexp)
-		     1 font-lock-variable-name-face)
-		    ,@keywords
-		    ,@list)))))
-
-(defun sh-font-lock-keywords-1 (&optional builtins)
-  "Function to get better fontification including keywords."
-  (let ((keywords (concat "\\([;(){}`|&]\\|^\\)[ \t]*\\(\\(\\("
-			  (mapconcat 'identity
-				     (sh-feature sh-leading-keywords)
-				     "\\|")
-			  "\\)[ \t]+\\)?\\("
-			  (mapconcat 'identity
-				     (append (sh-feature sh-leading-keywords)
-					     (sh-feature sh-other-keywords))
-				     "\\|")
-			  "\\)")))
-    (sh-font-lock-keywords
-     `(,@(if builtins
-	     `((,(concat keywords "[ \t]+\\)?\\("
-			 (mapconcat 'identity (sh-feature sh-builtins) "\\|")
-			 "\\)\\>")
-		(2 font-lock-keyword-face nil t)
-		(6 font-lock-builtin-face))
-	       ,@(sh-feature sh-font-lock-keywords-2)))
-	 (,(concat keywords "\\)\\>")
-	  2 font-lock-keyword-face)
-	 ,@(sh-feature sh-font-lock-keywords-1)))))
-
-(defun sh-font-lock-keywords-2 ()
-  "Function to get better fontification including keywords and builtins."
-  (sh-font-lock-keywords-1 t))
-
-
-(defvar sh-regexp-for-done nil
-  "A buffer-local regexp to match opening keyword for done.")
-
-(defvar sh-kw-alist nil
-  "A buffer-local, since it is shell-type dependent, list of keywords.")
-
-;; ( key-word  first-on-this  on-prev-line )
-;; This is used to set `sh-kw-alist' which is a list of sublists each
-;; having 3 elements:
-;;   a keyword
-;;   a rule to check when the keyword appears on "this" line
-;;   a rule to check when the keyword appears on "the previous" line
-;; The keyword is usually a string and is the first word on a line.
-;; If this keyword appears on the line whose indentation is to be
-;; calculated, the rule in element 2 is called.  If this returns
-;; non-zero, the resulting point (which may be changed by the rule)
-;; is used as the default indentation.
-;; If it returned false or the keyword was not found in the table,
-;; then the keyword from the previous line is looked up and the rule
-;; in element 3 is called.  In this case, however,
-;; `sh-get-indent-info' does not stop but may keep going and test
-;; other keywords against rules in element 3.  This is because the
-;; preceding line could have, for example, an opening "if" and an
-;; opening "while" keyword and we need to add the indentation offsets
-;; for both.
-;;
-(defconst sh-kw
-  '((sh
-     ("if" nil sh-handle-prev-if)
-     ("elif" sh-handle-this-else sh-handle-prev-else)
-     ("else" sh-handle-this-else sh-handle-prev-else)
-     ("fi" sh-handle-this-fi sh-handle-prev-fi)
-     ("then" sh-handle-this-then sh-handle-prev-then)
-     ("(" nil sh-handle-prev-open)
-     ("{" nil sh-handle-prev-open)
-     ("[" nil sh-handle-prev-open)
-     ("}" sh-handle-this-close nil)
-     (")" sh-handle-this-close nil)
-     ("]" sh-handle-this-close nil)
-     ("case" nil sh-handle-prev-case)
-     ("esac" sh-handle-this-esac sh-handle-prev-esac)
-     (case-label nil sh-handle-after-case-label) ;; ???
-     (";;" nil sh-handle-prev-case-alt-end) ;; ???
-     ("done" sh-handle-this-done sh-handle-prev-done)
-     ("do" sh-handle-this-do sh-handle-prev-do))
-
-    ;; Note: we don't need specific stuff for bash and zsh shells;
-    ;; the regexp `sh-regexp-for-done' handles the extra keywords
-    ;; these shells use.
-    (rc
-     ("{" nil sh-handle-prev-open)
-     ("}" sh-handle-this-close nil)
-     ("case" sh-handle-this-rc-case sh-handle-prev-rc-case))))
-
-
-(defun sh-set-shell (shell &optional no-query-flag insert-flag)
-  "Set this buffer's shell to SHELL (a string).
-Makes this script executable via `executable-set-magic', and sets up the
-proper starting #!-line, if INSERT-FLAG is non-nil.
-Calls the value of `sh-set-shell-hook' if set."
-  (interactive (list (completing-read "Name or path of shell: "
-				      ;; XEmacs change
-				      sh-interpreter-mode-alist
-				      (lambda (x) (eq (cdr x) 'sh-mode)))
-		     (eq executable-query 'function)
-		     t))
-  (if (string-match "\\.exe\\'" shell)
-      (setq shell (substring shell 0 (match-beginning 0))))
-  (setq sh-shell (intern (file-name-nondirectory shell))
-	sh-shell (or (cdr (assq sh-shell sh-alias-alist))
-		     sh-shell))
-  (if insert-flag
-      (setq sh-shell-file
-	    (executable-set-magic shell (sh-feature sh-shell-arg)
-				  no-query-flag insert-flag)))
-  (setq require-final-newline (sh-feature sh-require-final-newline)
-;;;	local-abbrev-table (sh-feature sh-abbrevs)
-	comment-start-skip "#+[\t ]*"
-	mode-line-process (format "[%s]" sh-shell)
-	sh-shell-variables nil
-	sh-shell-variables-initialized nil
-	imenu-generic-expression (sh-feature sh-imenu-generic-expression)
-	imenu-case-fold-search nil)
-  (dolist (var (sh-feature sh-variables))
-    (sh-remember-variable var))
-  (make-local-variable 'indent-line-function)
-  (if (setq sh-indent-supported-here (sh-feature sh-indent-supported))
-      (progn
-	(message "Setting up indent for shell type %s" sh-shell)
-	(set (make-local-variable 'parse-sexp-lookup-properties) t)
-	(set (make-local-variable 'sh-kw-alist) (sh-feature sh-kw))
-	(let ((regexp (sh-feature sh-kws-for-done)))
-	  (if regexp
-	      (set (make-local-variable 'sh-regexp-for-done)
-		   (sh-mkword-regexpr (regexp-opt regexp t)))))
-	(message "setting up indent stuff")
-	;; sh-mode has already made indent-line-function local
-	;; but do it in case this is called before that.
-	(setq indent-line-function 'sh-indent-line)
-	(if sh-make-vars-local
-	    (sh-make-vars-local))
-	(message "Indentation setup for shell type %s" sh-shell))
-    (message "No indentation for this shell type.")
-    (setq indent-line-function 'sh-basic-indent-line))
-  (run-hooks 'sh-set-shell-hook))
-
-
-
-(defun sh-feature (list &optional function)
-  "Index ALIST by the current shell.
-If ALIST isn't a list where every element is a cons, it is returned as is.
-Else indexing follows an inheritance logic which works in two ways:
-
-  - Fall back on successive ancestors (see `sh-ancestor-alist') as long as
-    the alist contains no value for the current shell.
-    The ultimate default is always `sh'.
-
-  - If the value thus looked up is a list starting with `eval' its `cdr' is
-    first evaluated.  If that is also a list and the first argument is a
-    symbol in ALIST it is not evaluated, but rather recursively looked up in
-    ALIST to allow the function called to define the value for one shell to be
-    derived from another shell.  While calling the function, is the car of the
-    alist element is the current shell.
-    The value thus determined is physically replaced into the alist.
-
-Optional FUNCTION is applied to the determined value and the result is cached
-in ALIST."
-  (or (if (consp list)
-	  (let ((l list))
-	    (while (and l (consp (car l)))
-	      (setq l (cdr l)))
-	    (if l list)))
-      (if function
-	  (cdr (assoc (setq function (cons sh-shell function)) list)))
-      (let ((sh-shell sh-shell)
-	    elt val)
-	(while (and sh-shell
-		    (not (setq elt (assq sh-shell list))))
-	  (setq sh-shell (cdr (assq sh-shell sh-ancestor-alist))))
-	;; If the shell is not known, treat it as sh.
-	(unless elt
-	  (setq elt (assq 'sh list)))
-	(if (and (consp (setq val (cdr elt)))
-		 (eq (car val) 'eval))
-	    (setcdr elt
-		    (setq val
-			  (eval (if (consp (setq val (cdr val)))
-				    (let ((sh-shell (car (cdr val)))
-					  function)
-				      (if (assq sh-shell list)
-					  (setcar (cdr val)
-						  (list 'quote
-							(sh-feature list))))
-				      val)
-				  val)))))
-	(if function
-	    (nconc list
-		   (list (cons function
-			       (setq sh-shell (car function)
-				     val (funcall (cdr function) val))))))
-	val)))
-
-
-
-;;; I commented this out because nobody calls it -- rms.
-;;;(defun sh-abbrevs (ancestor &rest list)
-;;;  "Iff it isn't, define the current shell as abbrev table and fill that.
-;;;Abbrev table will inherit all abbrevs from ANCESTOR, which is either an abbrev
-;;;table or a list of (NAME1 EXPANSION1 ...).  In addition it will define abbrevs
-;;;according to the remaining arguments NAMEi EXPANSIONi ...
-;;;EXPANSION may be either a string or a skeleton command."
-;;;  (or (if (boundp sh-shell)
-;;;	  (symbol-value sh-shell))
-;;;      (progn
-;;;	(if (listp ancestor)
-;;;	    (nconc list ancestor))
-;;;	(define-abbrev-table sh-shell ())
-;;;	(if (vectorp ancestor)
-;;;	    (mapatoms (lambda (atom)
-;;;			(or (eq atom 0)
-;;;			    (define-abbrev (symbol-value sh-shell)
-;;;			      (symbol-name atom)
-;;;			      (symbol-value atom)
-;;;			      (symbol-function atom))))
-;;;		      ancestor))
-;;;	(while list
-;;;	  (define-abbrev (symbol-value sh-shell)
-;;;	    (car list)
-;;;	    (if (stringp (car (cdr list)))
-;;;		(car (cdr list))
-;;;	      "")
-;;;	    (if (symbolp (car (cdr list)))
-;;;		(car (cdr list))))
-;;;	  (setq list (cdr (cdr list)))))
-;;;      (symbol-value sh-shell)))
-
-
-(defun sh-append (ancestor &rest list)
-  "Return list composed of first argument (a list) physically appended to rest."
-  (nconc list ancestor))
-
-
-(defun sh-modify (skeleton &rest list)
-  "Modify a copy of SKELETON by replacing I1 with REPL1, I2 with REPL2 ..."
-  (setq skeleton (copy-sequence skeleton))
-  (while list
-    (setcar (or (nthcdr (car list) skeleton)
-		(error "Index %d out of bounds" (car list)))
-	    (car (cdr list)))
-    (setq list (nthcdr 2 list)))
-  skeleton)
-
-
-(defun sh-basic-indent-line ()
-  "Indent a line for Sh mode (shell script mode).
-Indent as far as preceding non-empty line, then by steps of `sh-indentation'.
-Lines containing only comments are considered empty."
-  (interactive)
-  (let ((previous (save-excursion
-		    (while (and (progn (beginning-of-line)
-				       (not (bobp)))
-				(progn
-				  (forward-line -1)
-				  (back-to-indentation)
-				  (or (eolp)
-				      (eq (following-char) ?#)))))
-		    (current-column)))
-	current)
-    (save-excursion
-      (indent-to (if (eq this-command 'newline-and-indent)
-		     previous
-		   (if (< (current-column)
-			  (setq current (progn (back-to-indentation)
-					       (current-column))))
-		       (if (eolp) previous 0)
-		     (delete-region (point)
-				    (progn (beginning-of-line) (point)))
-		     (if (eolp)
-			 (max previous (* (1+ (/ current sh-indentation))
-					  sh-indentation))
-		       (* (1+ (/ current sh-indentation)) sh-indentation))))))
-    (if (< (current-column) (current-indentation))
-	(skip-chars-forward " \t"))))
-
-
-(defun sh-execute-region (start end &optional flag)
-  "Pass optional header and region to a subshell for noninteractive execution.
-The working directory is that of the buffer, and only environment variables
-are already set which is why you can mark a header within the script.
-
-With a positive prefix ARG, instead of sending region, define header from
-beginning of buffer to point.  With a negative prefix ARG, instead of sending
-region, clear header."
-  (interactive "r\nP")
-  (if flag
-      (setq sh-header-marker (if (> (prefix-numeric-value flag) 0)
-				 (point-marker)))
-    (if sh-header-marker
-	(save-excursion
-	  (let (buffer-undo-list)
-	    (goto-char sh-header-marker)
-	    (append-to-buffer (current-buffer) start end)
-	    (shell-command-on-region (point-min)
-				     (setq end (+ sh-header-marker
-						  (- end start)))
-				     sh-shell-file)
-	    (delete-region sh-header-marker end)))
-      (shell-command-on-region start end (concat sh-shell-file " -")))))
-
-
-(defun sh-remember-variable (var)
-  "Make VARIABLE available for future completing reads in this buffer."
-  (or (< (length var) sh-remember-variable-min)
-      (getenv var)
-      (assoc var sh-shell-variables)
-      (push (cons var var) sh-shell-variables))
-  var)
-
-
-
-(defun sh-quoted-p ()
-  "Is point preceded by an odd number of backslashes?"
-  (eq -1 (% (save-excursion (skip-chars-backward "\\\\")) 2)))
-
-;; Indentation stuff.
-(defun sh-must-be-shell-mode ()
-  "Signal an error if not in Shell-script mode."
-  (unless (eq major-mode 'sh-mode)
-    (error "This buffer is not in Shell-script mode")))
-
-(defun sh-must-support-indent ()
-  "*Signal an error if the shell type for this buffer is not supported.
-Also, the buffer must be in Shell-script mode."
-  (sh-must-be-shell-mode)
-  (unless sh-indent-supported-here
-    (error "This buffer's shell type is not supported for this command")))
-
-(defun sh-make-vars-local ()
-  "Make the indentation variables local to this buffer.
-Normally they already are local.  This command is provided in case
-variable `sh-make-vars-local' has been set to nil.
-
-To revert all these variables to the global values, use
-command `sh-reset-indent-vars-to-global-values'."
-  (interactive)
-  (sh-must-be-shell-mode)
-  (mapcar 'make-local-variable sh-var-list)
-  (message "Indentation variable are now local."))
-
-(defun sh-reset-indent-vars-to-global-values ()
-  "Reset local indentation variables to the global values.
-Then, if variable `sh-make-vars-local' is non-nil, make them local."
-  (interactive)
-  (sh-must-be-shell-mode)
-  (mapcar 'kill-local-variable sh-var-list)
-  (if sh-make-vars-local
-      (mapcar 'make-local-variable sh-var-list)))
-
-
-;; Theoretically these are only needed in shell and derived modes.
-;; However, the routines which use them are only called in those modes.
-(defconst sh-special-keywords "then\\|do")
-
-(defun sh-help-string-for-variable (var)
-  "Construct a string for `sh-read-variable' when changing variable VAR ."
-  (let ((msg (documentation-property var 'variable-documentation))
-	(msg2 ""))
-    (unless (memq var '(sh-first-lines-indent sh-indent-comment))
-      (setq msg2
-	    (format "\n
-You can enter a number (positive to increase indentation,
-negative to decrease indentation, zero for no change to indentation).
-
-Or, you can enter one of the following symbols which are relative to
-the value of variable `sh-basic-offset'
-which in this buffer is currently %s.
-
-\t%s."
-		    sh-basic-offset
-		    (mapconcat  (lambda (x)
-				  (nth (1- (length x)) x))
-				sh-symbol-list  "\n\t"))))
-    (concat
-     ;; The following shows the global not the local value!
-     ;; (format "Current value of %s is %s\n\n" var (symbol-value var))
-     msg msg2)))
-
-(defun sh-read-variable (var)
-  "Read a new value for indentation variable VAR."
-  (interactive "*variable? ") ;; to test
-  (let ((minibuffer-help-form `(sh-help-string-for-variable
-				(quote ,var)))
-	val)
-    (setq val (read-from-minibuffer
-	       (format "New value for %s (press %s for help): "
-		       var  (single-key-description help-char))
-	       (format "%s" (symbol-value var))
-	       nil t))
-    val))
-
-
-
-(defun sh-in-comment-or-string (start)
-  "Return non-nil if START is in a comment or string."
-  (save-excursion
-    (let (state)
-      (beginning-of-line)
-      (setq state (parse-partial-sexp (point) start nil nil nil t))
-      (or (nth 3 state)(nth 4 state)))))
-
-(defun sh-goto-matching-if ()
-  "Go to the matching if for a fi.
-This handles nested if..fi pairs."
-  (let ((found (sh-find-prev-matching "\\bif\\b" "\\bfi\\b" 1)))
-    (if found
-	(goto-char found))))
-
-
-;; Functions named sh-handle-this-XXX are called when the keyword on the
-;; line whose indentation is being handled contain XXX;
-;; those named sh-handle-prev-XXX are when XXX appears on the previous line.
-
-(defun sh-handle-prev-if ()
-  (list '(+ sh-indent-after-if)))
-
-(defun sh-handle-this-else ()
-  (if (sh-goto-matching-if)
-      ;; (list "aligned to if")
-      (list "aligned to if" '(+ sh-indent-for-else))
-    nil
-    ))
-
-(defun sh-handle-prev-else ()
-  (if (sh-goto-matching-if)
-      (list  '(+ sh-indent-after-if))
-    ))
-
-(defun sh-handle-this-fi ()
-  (if (sh-goto-matching-if)
-      (list "aligned to if" '(+ sh-indent-for-fi))
-    nil
-    ))
-
-(defun sh-handle-prev-fi ()
-  ;; Why do we have this rule?  Because we must go back to the if
-  ;; to get its indent.  We may continue back from there.
-  ;; We return nil because we don't have anything to add to result,
-  ;; the side affect of setting align-point is all that matters.
-  ;; we could return a comment (a string) but I can't think of a good one...
-  (sh-goto-matching-if)
-  nil)
-
-(defun sh-handle-this-then ()
-  (let ((p (sh-goto-matching-if)))
-    (if p
-	(list '(+ sh-indent-for-then))
-      )))
-
-(defun sh-handle-prev-then ()
-  (let ((p (sh-goto-matching-if)))
-    (if p
-	(list '(+ sh-indent-after-if))
-      )))
-
-(defun sh-handle-prev-open ()
-  (save-excursion
-    (let ((x (sh-prev-stmt)))
-      (if (and x
-	       (progn
-		 (goto-char x)
-		 (or
-		  (looking-at "function\\b")
-		  (looking-at "\\s-*\\S-+\\s-*()")
-		  )))
-	  (list '(+ sh-indent-after-function))
-	(list '(+ sh-indent-after-open)))
-      )))
-
-(defun sh-handle-this-close ()
-  (forward-char 1) ;; move over ")"
-  (if (sh-safe-forward-sexp -1)
-      (list "aligned to opening paren")))
-
-(defun sh-goto-matching-case ()
-  (let ((found (sh-find-prev-matching "\\bcase\\b" "\\besac\\b" 1)))
-    (if found (goto-char found))))
-
-(defun sh-handle-prev-case ()
-  ;; This is typically called when point is on same line as a case
-  ;; we shouldn't -- and can't find prev-case
-  (if (looking-at ".*\\<case\\>")
-      (list '(+ sh-indent-for-case-label))
-    (error "We don't seem to be on a line with a case"))) ;; debug
-
-(defun sh-handle-this-esac ()
-  (if (sh-goto-matching-case)
-      (list "aligned to matching case")))
-
-(defun sh-handle-prev-esac ()
-  (if (sh-goto-matching-case)
-      (list "matching case")))
-
-(defun sh-handle-after-case-label ()
-  (if (sh-goto-matching-case)
-      (list '(+ sh-indent-for-case-alt))))
-
-(defun sh-handle-prev-case-alt-end ()
-  (if (sh-goto-matching-case)
-      (list '(+ sh-indent-for-case-label))))
-
-(defun sh-safe-forward-sexp (&optional arg)
-  "Try and do a `forward-sexp', but do not error.
-Return new point if successful, nil if an error occurred."
-  (condition-case nil
-      (progn
-	(forward-sexp (or arg 1))
-	(point))	;; return point if successful
-    (error
-     (sh-debug "oops!(1) %d" (point))
-     nil))) ;; return nil if fail
-
-(defun sh-goto-match-for-done ()
-  (let ((found (sh-find-prev-matching sh-regexp-for-done sh-re-done 1)))
-    (if found
-	(goto-char found))))
-
-(defun sh-handle-this-done ()
-  (if (sh-goto-match-for-done)
-      (list  "aligned to do stmt"  '(+ sh-indent-for-done))))
-
-(defun sh-handle-prev-done ()
-  (if (sh-goto-match-for-done)
-      (list "previous done")))
-
-(defun sh-handle-this-do ()
-  (if (sh-goto-match-for-done)
-      (list '(+ sh-indent-for-do))))
-
-(defun sh-handle-prev-do ()
-  (cond
-   ((save-restriction
-      (narrow-to-region
-       (point)
-       (save-excursion
-	 (beginning-of-line)
-	 (point)))
-      (sh-goto-match-for-done))
-    (sh-debug "match for done found on THIS line")
-    (list '(+ sh-indent-after-loop-construct)))
-   ((sh-goto-match-for-done)
-    (sh-debug "match for done found on PREV line")
-    (list '(+ sh-indent-after-do)))
-   (t
-    (message "match for done NOT found")
-    nil)))
-
-;; for rc:
-(defun sh-find-prev-switch ()
-  "Find the line for the switch keyword matching this line's case keyword."
-  (re-search-backward "\\<switch\\>" nil t))
-
-(defun sh-handle-this-rc-case ()
-  (if (sh-find-prev-switch)
-      (list  '(+ sh-indent-after-switch))
-    ;; (list  '(+ sh-indent-for-case-label))
-    nil))
-
-(defun sh-handle-prev-rc-case ()
-  (list '(+ sh-indent-after-case)))
-
-(defun sh-check-rule (n thing)
-  (let ((rule (nth n (assoc thing sh-kw-alist)))
-	(val nil))
-    (if rule
-	(progn
-	  (setq val (funcall rule))
-	  (sh-debug "rule (%d) for %s at %d is %s\n-> returned %s"
-		    n thing (point) rule val)))
-    val))
-
-
-(defun sh-get-indent-info ()
-  "Return indent-info for this line.
-This is a list.  nil means the line is to be left as is.
-Otherwise it contains one or more of the following sublists:
-\(t NUMBER\)   NUMBER is the base location in the buffer that indentation is
-	     relative to.  If present, this is always the first of the
-	     sublists.  The indentation of the line in question is
-	     derived from the indentation of this point, possibly
-	     modified by subsequent sublists.
-\(+ VAR\)
-\(- VAR\)      Get the value of variable VAR and add to or subtract from
-	     the indentation calculated so far.
-\(= VAR\)	     Get the value of variable VAR and *replace* the
-	     indentation with its value.  This only occurs for
-	     special variables such as `sh-indent-comment'.
-STRING	     This is ignored for the purposes of calculating
-	     indentation, it is printed in certain cases to help show
-	     what the indentation is based on."
-  ;; See comments before `sh-kw'.
-  (save-excursion
-    (let ((prev-kw nil)
-	  (prev-stmt nil)
-	  (have-result nil)
-	  depth-bol depth-eol
-	  this-kw
-	  (state nil)
-	  state-bol
-	  (depth-prev-bol nil)
-	  start
-	  func val
-	  (result nil)
-	  prev-lines-indent
-	  (prev-list nil)
-	  (this-list nil)
-	  (align-point nil)
-	  prev-line-end x)
-      (beginning-of-line)
-      ;; Note: setting result to t means we are done and will return nil.
-      ;;(This function never returns just t.)
-      (cond
-       ((or (and (boundp 'font-lock-string-face)
-		 (eq (get-text-property (point) 'face) font-lock-string-face))
-	    (eq (get-text-property (point) 'face) sh-heredoc-face))
-	(setq result t)
-	(setq have-result t))
-       ((looking-at "\\s-*#")		; was (equal this-kw "#")
-	(if (bobp)
-	    (setq result t) ;; return nil if 1st line!
-	  (setq result (list '(= sh-indent-comment)))
-	  ;; we still need to get previous line in case
-	  ;; sh-indent-comment is t (indent as normal)
-	  (setq align-point (sh-prev-line nil))
-	  (setq have-result nil)
-	  ))
-       ) ;; cond
-
-      (unless have-result
-	;; Continuation lines are handled specially
-	(if (sh-this-is-a-continuation)
-	    (progn
-	      ;; We assume the line being continued is already
-	      ;; properly indented...
-	      ;; (setq prev-line-end (sh-prev-line))
-	      (setq align-point (sh-prev-line nil))
-	      (setq result (list '(+ sh-indent-for-continuation)))
-	      (setq have-result t))
-	  (beginning-of-line)
-	  (skip-chars-forward " \t")
-	  (setq this-kw (sh-get-kw)))
-
-        ;; Handle "this" keyword:  first word on the line we're
-	;; calculating indentation info for.
-	(if this-kw
-	    (if (setq val (sh-check-rule 1 this-kw))
-		(progn
-		  (setq align-point (point))
-		  (sh-debug
-		   "this - setting align-point to %d" align-point)
-		  (setq result (append result val))
-		  (setq have-result t)
-		  ;; set prev-line to continue processing remainder
-		  ;; of this line as a previous line
-		  (setq prev-line-end (point))
-		  ))))
-
-      (unless have-result
-	(setq prev-line-end (sh-prev-line 'end)))
-
-      (if prev-line-end
-	  (save-excursion
-	    ;; We start off at beginning of this line.
-	    ;; Scan previous statements while this is <=
-	    ;; start of previous line.
-	    (setq start (point)) ;; for debug only
-	    (goto-char prev-line-end)
-	    (setq x t)
-	    (while (and x (setq x  (sh-prev-thing)))
-	      (sh-debug "at %d x is: %s  result is: %s" (point) x result)
-	      (cond
-	       ((and (equal x ")")
-		     (equal (get-text-property (1- (point)) 'syntax-table)
-			    sh-st-punc))
-		(sh-debug "Case label) here")
-		(setq x 'case-label)
-		(if (setq val (sh-check-rule 2 x))
-		    (progn
-		      (setq result (append result val))
-		      (setq align-point (point))))
-		(forward-char -1)
-		(skip-chars-forward "[a-z0-9]*?")
-		)
-	       ((string-match "[])}]" x)
-		(setq x (sh-safe-forward-sexp -1))
-		(if x
-		    (progn
-		      (setq align-point (point))
-		      (setq result (append result
-					   (list "aligned to opening paren")))
-		      )))
-	       ((string-match "[[({]" x)
-		(sh-debug "Checking special thing: %s" x)
-		(if (setq val (sh-check-rule 2 x))
-		    (setq result (append result val)))
-		(forward-char -1)
-		(setq align-point (point)))
-	       ((string-match "[\"'`]" x)
-		(sh-debug "Skipping back for %s" x)
-		;; this was oops-2
-		(setq x (sh-safe-forward-sexp -1)))
-	       ((stringp x)
-		(sh-debug "Checking string %s at %s" x (point))
-		(if (setq val (sh-check-rule 2 x))
-		    ;; (or (eq t (car val))
-		    ;; (eq t (car (car val))))
-		    (setq result (append result val)))
-		;; not sure about this test Wed Jan 27 23:48:35 1999
-		(setq align-point (point))
-		(unless (bolp)
-		  (forward-char -1)))
-	       (t
-		(error "Don't know what to do with %s" x))
-	       )
-	      )	;; while
-	    (sh-debug "result is %s" result)
-	    )
-	(sh-debug "No prev line!")
-	(sh-debug "result: %s  align-point: %s" result align-point)
-	)
-
-      (if align-point
-	  ;; was: (setq result (append result (list (list t align-point))))
-	  (setq result (append  (list (list t align-point)) result))
-	)
-      (sh-debug "result is now: %s" result)
-
-      (or result
-	  (if prev-line-end
-	      (setq result (list (list t prev-line-end)))
-	    (setq result (list (list '= 'sh-first-lines-indent)))
-	    ))
-
-      (if (eq result t)
-	  (setq result nil))
-      (sh-debug  "result is: %s" result)
-      result
-      )	;; let
-    ))
-
-
-(defun sh-get-indent-var-for-line (&optional info)
-  "Return the variable controlling indentation for this line.
-If there is not [just] one such variable, return a string
-indicating the problem.
-If INFO is supplied it is used, else it is calculated."
-  (let ((var nil)
-	(result nil)
-	(reason nil)
-	sym elt)
-    (or info
-	(setq info (sh-get-indent-info)))
-    (if (null info)
-	(setq result "this line to be left as is")
-      (while (and info (null result))
-	(setq elt (car info))
-	(cond
-	 ((stringp elt)
-	  (setq reason elt)
-	  )
-	 ((not (listp elt))
-	  (error "sh-get-indent-var-for-line invalid elt: %s" elt))
-	 ;; so it is a list
-	 ((eq t (car elt))
-	  ) ;; nothing
-	 ((symbolp  (setq sym (nth 1 elt)))
-	  ;; A bit of a kludge - when we see the sh-indent-comment
-	  ;; ignore other variables.  Otherwise it is tricky to
-	  ;; "learn" the comment indentation.
-	  (if (eq var 'sh-indent-comment)
-	      (setq result var)
-	    (if var
-		(setq result
-		      "this line is controlled by more than 1 variable.")
-	      (setq var sym))))
-	 (t
-	  (error "sh-get-indent-var-for-line invalid list elt: %s" elt)))
-	(setq info (cdr info))
-	))
-    (or result
-	(setq result var))
-    (or result
-	(setq result reason))
-    (if (null result)
-	;; e.g. just had (t POS)
-	(setq result "line has default indentation"))
-    result))
-
-
-
-;; Finding the previous line isn't trivial.
-;; We must *always* go back one more and see if that is a continuation
-;; line -- it is the PREVIOUS line which is continued, not the one
-;; we are going to!
-;; Also, we want to treat a whole "here document" as one big line,
-;; because we may want to a align to the beginning of it.
-;;
-;; What we do:
-;; - go back to previous non-empty line
-;; - if this is in a here-document, go to the beginning of it
-;; - while previous line is continued, go back one line
-(defun sh-prev-line (&optional end)
-  "Back to end of previous non-comment non-empty line.
-Go to beginning of logical line unless END is non-nil, in which case
-we go to the end of the previous line and do not check for continuations."
-  (sh-must-be-shell-mode)
-  (save-excursion
-    (beginning-of-line)
-    (forward-comment (- (point-max)))
-    (unless end (beginning-of-line))
-    (when (and (not (bobp))
-	       (equal (get-text-property (1- (point)) 'face)
-		      sh-heredoc-face))
-      (let ((p1 (previous-single-property-change (1- (point)) 'face)))
-	(when p1
-	  (goto-char p1)
-	  (if end
-	      (end-of-line)
-	    (beginning-of-line)))))
-    (unless end
-      ;; we must check previous lines to see if they are continuation lines
-      ;; if so, we must return position of first of them
-      (while (and (sh-this-is-a-continuation)
-		  (>= 0 (forward-line -1))))
-      (beginning-of-line)
-      (skip-chars-forward " \t"))
-    (point)))
-
-
-(defun sh-prev-stmt ()
-  "Return the address of the previous stmt or nil."
-  ;; This is used when we are trying to find a matching keyword.
-  ;; Searching backward for the keyword would certainly be quicker, but
-  ;; it is hard to remove "false matches" -- such as if the keyword
-  ;; appears in a string or quote.  This way is slower, but (I think) safer.
-  (interactive)
-  (save-excursion
-    (let ((going t)
-	  (start (point))
-	  (found nil)
-	  (prev nil))
-      (skip-chars-backward " \t;|&({[")
-      (while (and (not found)
-		  (not (bobp))
-		  going)
-	;; Do a backward-sexp if possible, else backup bit by bit...
-	(if (sh-safe-forward-sexp -1)
-	    (progn
-	      (if (looking-at sh-special-keywords)
-		  (progn
-		    (setq found prev))
-		(setq prev (point))
-		))
-	  ;; backward-sexp failed
-	  (if (zerop (skip-chars-backward " \t()[\]{};`'"))
-	      (forward-char -1))
-	  (if (bolp)
-	      (let ((back (sh-prev-line nil)))
-		(if back
-		    (goto-char back)
-		  (setq going nil)))))
-	(unless found
-	  (skip-chars-backward " \t")
-	  (if (or (and (bolp) (not (sh-this-is-a-continuation)))
-		  (eq (char-before) ?\;)
-		  (looking-at "\\s-*[|&]"))
-	      (setq found (point)))))
-      (if found
-	  (goto-char found))
-      (if found
-	  (progn
-	    (skip-chars-forward " \t|&({[")
-	    (setq found (point))))
-      (if (>= (point) start)
-	  (progn
-	    (debug "We didn't move!")
-	    (setq found nil))
-	(or found
-	    (sh-debug "Did not find prev stmt.")))
-      found)))
-
-
-(defun sh-get-word ()
-  "Get a shell word skipping whitespace from point."
-  (interactive)
-  (skip-chars-forward "\t ")
-  (let ((start (point)))
-    (while
-	(if (looking-at "[\"'`]")
-	    (sh-safe-forward-sexp)
-	  ;; (> (skip-chars-forward "^ \t\n\"'`") 0)
-	  (> (skip-chars-forward "-_a-zA-Z\$0-9") 0)
-	  ))
-    (buffer-substring start (point))
-    ))
-
-(defun sh-prev-thing ()
-  "Return the previous thing this logical line."
-  ;; This is called when `sh-get-indent-info' is working backwards on
-  ;; the previous line(s) finding what keywords may be relevant for
-  ;; indenting.  It moves over sexps if possible, and will stop
-  ;; on a ; and at the beginning of a line if it is not a continuation
-  ;; line.
-  ;;
-  ;; Added a kludge for ";;"
-  ;; Possible return values:
-  ;;  nil  -  nothing
-  ;; a string - possibly a keyword
-  ;;
-  (if (bolp)
-      nil
-    (let ((going t)
-	  c n
-	  min-point
-	  (start (point))
-	  (found nil))
-      (save-restriction
-	(narrow-to-region
-	(if (sh-this-is-a-continuation)
-	    (setq min-point (sh-prev-line nil))
-	  (save-excursion
-	    (beginning-of-line)
-	    (setq min-point (point))))
-	(point))
-	(skip-chars-backward " \t;")
-	(unless (looking-at "\\s-*;;")
-	(skip-chars-backward "^)}];\"'`({[")
-	(setq c (char-before))))
-      (sh-debug "stopping at %d c is %s  start=%d min-point=%d"
-		(point) c start min-point)
-      (if (< (point) min-point)
-	  (error "point %d < min-point %d" (point) min-point))
-      (cond
-       ((looking-at "\\s-*;;")
-	;; (message "Found ;; !")
-       ";;")
-       ((or (eq c ?\n)
-	    (eq c nil)
-	    (eq c ?\;))
-       (save-excursion
-	 ;; skip forward over white space newline and \ at eol
-	 (skip-chars-forward " \t\n\\\\")
-	 (sh-debug "Now at %d   start=%d" (point) start)
-	 (if (>= (point) start)
-	     (progn
-	       (sh-debug "point: %d >= start: %d" (point) start)
-	       nil)
-	   (sh-get-word))
-	 ))
-       (t
-	;; c	-- return a string
-       (char-to-string c)
-       ))
-      )))
-
-
-(defun sh-this-is-a-continuation ()
-  "Return non-nil if current line is a continuation of previous line."
-  (save-excursion
-    (and (zerop (forward-line -1))
-	 (looking-at ".*\\\\$")
-	 (not (nth 4 (parse-partial-sexp (match-beginning 0) (match-end 0)
-					 nil nil nil t))))))
-
-(defun sh-get-kw (&optional where and-move)
-  "Return first word of line from WHERE.
-If AND-MOVE is non-nil then move to end of word."
-  (let ((start (point)))
-    (if where
-	(goto-char where))
-    (prog1
-	(buffer-substring (point)
-			  (progn (skip-chars-forward "^ \t\n;")(point)))
-      (unless and-move
-	(goto-char start)))))
-
-(defun sh-find-prev-matching (open close &optional depth)
-  "Find a matching token for a set of opening and closing keywords.
-This takes into account that there may be nested open..close pairings.
-OPEN and CLOSE are regexps denoting the tokens to be matched.
-Optional parameter DEPTH (usually 1) says how many to look for."
-  (let ((parse-sexp-ignore-comments t)
-	prev)
-    (setq depth (or depth 1))
-    (save-excursion
-      (condition-case nil
-	  (while (and
-		  (/= 0  depth)
-		  (not (bobp))
-		  (setq prev (sh-prev-stmt)))
-	    (goto-char prev)
-	    (save-excursion
-	      (if (looking-at "\\\\\n")
-		  (progn
-		    (forward-char 2)
-		    (skip-chars-forward " \t")))
-	      (cond
-	       ((looking-at open)
-		(setq depth (1- depth))
-		(sh-debug "found open at %d - depth = %d" (point) depth))
-	       ((looking-at close)
-		(setq depth (1+ depth))
-		(sh-debug "found close - depth = %d" depth))
-	       (t
-		))))
-	(error nil))
-      (if (eq depth 0)
-	  prev ;; (point)
-	nil)
-      )))
-
-
-(defun sh-var-value (var &optional ignore-error)
-  "Return the value of variable VAR, interpreting symbols.
-It can also return t or nil.
-If an illegal value is found, throw an error unless Optional argument
-IGNORE-ERROR is non-nil."
-  (let ((val (symbol-value var)))
-    (cond
-     ((numberp val)
-      val)
-     ((eq val t)
-      val)
-     ((null val)
-      val)
-     ((eq val '+)
-      sh-basic-offset)
-     ((eq val '-)
-      (- sh-basic-offset))
-     ((eq val '++)
-      (* 2 sh-basic-offset))
-     ((eq val '--)
-      (* 2 (- sh-basic-offset)))
-     ((eq val '*)
-      (/ sh-basic-offset 2))
-     ((eq val '/)
-      (/ (- sh-basic-offset) 2))
-     (t
-      (if ignore-error
-      (progn
-	(message "Don't know how to handle %s's value of %s" var val)
-	0)
-      (error "Don't know how to handle %s's value of %s" var val))
-      ))))
-
-(defun sh-set-var-value (var value &optional no-symbol)
-  "Set variable VAR to VALUE.
-Unless optional argument NO-SYMBOL is non-nil, then if VALUE is
-can be represented by a symbol then do so."
-  (cond
-   (no-symbol
-    (set var value))
-   ((= value sh-basic-offset)
-    (set var '+))
-   ((= value (- sh-basic-offset))
-    (set var '-))
-   ((eq value (* 2 sh-basic-offset))
-    (set var  '++))
-   ((eq value (* 2 (- sh-basic-offset)))
-    (set var  '--))
-   ((eq value (/ sh-basic-offset 2))
-    (set var  '*))
-   ((eq value (/ (- sh-basic-offset) 2))
-    (set var  '/))
-   (t
-    (set var value)))
-  )
-
-
-(defun sh-calculate-indent (&optional info)
-  "Return the indentation for the current line.
-If INFO is supplied it is used, else it is calculated from current line."
-  (let ((ofs 0)
-	(base-value 0)
-	elt a b var val)
-    (or info
-	(setq info (sh-get-indent-info)))
-    (when info
-      (while info
-	(sh-debug "info: %s  ofs=%s" info ofs)
-	(setq elt (car info))
-	(cond
-	 ((stringp elt)) ;; do nothing?
-	 ((listp elt)
-	  (setq a (car (car info)))
-	  (setq b (nth 1 (car info)))
-	  (cond
-	   ((eq a t)
-	    (save-excursion
-	      (goto-char b)
-	      (setq val (current-indentation)))
-	    (setq base-value val))
-	   ((symbolp b)
-	    (setq val (sh-var-value b))
-	    (cond
-	     ((eq a '=)
-	      (cond
-	       ((null val)
-		;; no indentation
-		;; set info to nil so  we stop immediately
-		(setq base-value nil  ofs nil  info nil))
-	       ((eq val t) (setq ofs 0)) ;; indent as normal line
-	       (t
-		;; The following assume the (t POS) come first!
-		(setq ofs val  base-value 0)
-		(setq info nil))))	;; ? stop now
-	     ((eq a '+) (setq ofs (+ ofs val)))
-	     ((eq a '-) (setq ofs (- ofs val)))
-	     (t
-	      (error "sh-calculate-indent invalid a a=%s b=%s" a b))))
-	   (t
-	    (error "sh-calculate-indent invalid elt: a=%s b=%s" a b))))
-	 (t
-	  (error "sh-calculate-indent invalid elt %s" elt)))
-	(sh-debug "a=%s b=%s val=%s base-value=%s ofs=%s"
-		  a b val base-value ofs)
-	(setq info (cdr info)))
-      ;; return value:
-      (sh-debug "at end:  base-value: %s    ofs: %s" base-value ofs)
-
-      (cond
-       ((or (null base-value)(null ofs))
-	nil)
-       ((and (numberp base-value)(numberp ofs))
-	(sh-debug "base (%d) + ofs (%d) = %d"
-		  base-value ofs (+ base-value ofs))
-	(+ base-value ofs)) ;; return value
-       (t
-	(error "sh-calculate-indent:  Help.  base-value=%s ofs=%s"
-	       base-value ofs)
-	nil)))))
-
-
-(defun sh-indent-line (&optional prefix-arg)
-  "Indent the current line."
-  (interactive)
-  (sh-must-be-shell-mode)
-  (let ((indent (sh-calculate-indent)) shift-amt beg end
-	(pos (- (point-max) (point))))
-    (when indent
-      (beginning-of-line)
-      (setq beg (point))
-      (skip-chars-forward " \t")
-      (setq shift-amt (- indent (current-column)))
-      (unless (zerop shift-amt)
-	(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))))))
-
-
-(defun sh-blink (blinkpos &optional msg)
-  "Move cursor momentarily to BLINKPOS and display MSG."
-  ;; We can get here without it being a number on first line
-  (if (numberp blinkpos)
-      (save-excursion
-	(goto-char blinkpos)
-	(message msg)
-	(sit-for blink-matching-delay))
-    (message msg)))
-
-(defun sh-show-indent (arg)
-  "Show the how the currently line would be indented.
-This tells you which variable, if any, controls the indentation of
-this line.
-If optional arg ARG is non-null (called interactively with a prefix),
-a pop up window describes this variable.
-If variable `sh-blink' is non-nil then momentarily go to the line
-we are indenting relative to, if applicable."
-  (interactive "P")
-  (sh-must-support-indent)
-  (let* ((info (sh-get-indent-info))
-	 (var (sh-get-indent-var-for-line info))
-	 (curr-indent (current-indentation))
-	 val msg)
-    (if (stringp var)
-	(message (setq msg var))
-      (setq val (sh-calculate-indent info))
-
-      (if (eq curr-indent val)
-	  (setq msg (format "%s is %s" var (symbol-value var)))
-	(setq msg
-	      (if val
-		  (format "%s (%s) would change indent from %d to: %d"
-			  var (symbol-value var) curr-indent val)
-		(format "%s (%s) would leave line as is"
-			var (symbol-value var)))
-	      ))
-      (if (and arg var)
-	  (describe-variable var)))
-    (if sh-blink
-	(let ((info (sh-get-indent-info)))
-	  (if (and info (listp (car info))
-		   (eq (car (car info)) t))
-	      (sh-blink (nth 1 (car info))  msg)
-	    (message msg)))
-      (message msg))
-    ))
-
-(defun sh-set-indent ()
-  "Set the indentation for the current line.
-If the current line is controlled by an indentation variable, prompt
-for a new value for it."
-  (interactive)
-  (sh-must-support-indent)
-  (let* ((info (sh-get-indent-info))
-	 (var (sh-get-indent-var-for-line info))
-	 val val0 new-val old-val indent-val)
-    (if (stringp var)
-	(message (format "Cannot set indent - %s" var))
-      (setq old-val (symbol-value var))
-      (setq val (sh-read-variable var))
-      (condition-case nil
-	  (progn
-	    (set var val)
-	    (setq indent-val (sh-calculate-indent info))
-	    (if indent-val
-		(message "Variable: %s  Value: %s  would indent to: %d"
-			 var (symbol-value var) indent-val)
-	      (message "Variable: %s  Value: %s  would leave line as is."
-		       var (symbol-value var)))
-	    ;; I'm not sure about this, indenting it now?
-	    ;; No.  Because it would give the impression that an undo would
-	    ;; restore thing, but the value has been altered.
-	    ;; (sh-indent-line)
-	    )
-	(error
-	 (set var old-val)
-	 (message "Bad value for %s, restoring to previous value %s"
-		  var old-val)
-	 (sit-for 1)
-	 nil))
-      )))
-
-
-(defun sh-learn-line-indent (arg)
-  "Learn how to indent a line as it currently is indented.
-
-If there is an indentation variable which controls this line's indentation,
-then set it to a value which would indent the line the way it
-presently is.
-
-If the value can be represented by one of the symbols then do so
-unless optional argument ARG (the prefix when interactive) is non-nil."
-  (interactive "*P")
-  (sh-must-support-indent)
-  ;; I'm not sure if we show allow learning on an empty line.
-  ;; Though it might occasionally be useful I think it usually
-  ;; would just be confusing.
-  (if (save-excursion
-	(beginning-of-line)
-	(looking-at "\\s-*$"))
-      (message "sh-learn-line-indent ignores empty lines.")
-    (let* ((info (sh-get-indent-info))
-	   (var (sh-get-indent-var-for-line info))
-	   ival sval diff new-val
-	   (no-symbol arg)
-	   (curr-indent (current-indentation)))
-      (cond
-       ((stringp var)
-	(message (format "Cannot learn line - %s" var)))
-       ((eq var 'sh-indent-comment)
-	;; This is arbitrary...
-	;; - if curr-indent is 0, set to curr-indent
-	;; - else if it has the indentation of a "normal" line,
-	;;   then set to t
-	;; - else set to curr-indent.
-	(setq sh-indent-comment
-	      (if (= curr-indent 0)
-		  0
-		(let* ((sh-indent-comment t)
-		       (val2 (sh-calculate-indent info)))
-		  (if (= val2 curr-indent)
-		      t
-		    curr-indent))))
-	(message "%s set to %s" var (symbol-value var))
-	)
-       ((numberp (setq sval (sh-var-value var)))
-	(setq ival (sh-calculate-indent info))
-	(setq diff (- curr-indent ival))
-
-	(sh-debug "curr-indent: %d   ival: %d  diff: %d  var:%s  sval %s"
-		  curr-indent ival diff  var sval)
-	(setq new-val (+ sval diff))
-;;;	  I commented out this because someone might want to replace
-;;;	  a value of `+' with the current value of sh-basic-offset
-;;;	  or vice-versa.
-;;;	  (if (= 0 diff)
-;;;	      (message "No change needed!")
-	(sh-set-var-value var new-val no-symbol)
-	(message "%s set to %s" var (symbol-value var))
-	)
-       (t
-	(debug)
-	(message "Cannot change %s" var))))))
-
-
-
-(defun sh-mark-init (buffer)
-  "Initialize a BUFFER to be used by `sh-mark-line'."
-  (let ((main-buffer (current-buffer)))
-    (save-excursion
-      (set-buffer (get-buffer-create buffer))
-      (erase-buffer)
-      (occur-mode)
-      (setq occur-buffer main-buffer)
-      )))
-
-
-(defun sh-mark-line (message point buffer &optional add-linenum occur-point)
-  "Insert MESSAGE referring to location POINT in current buffer into BUFFER.
-Buffer BUFFER is in `occur-mode'.
-If ADD-LINENUM is non-nil the message is preceded by the line number.
-If OCCUR-POINT is non-nil then the line is marked as a new occurrence
-so that `occur-next' and `occur-prev' will work."
-  (let ((m1 (make-marker))
-	(main-buffer (current-buffer))
-	start
-	(line ""))
-    (when point
-      (set-marker m1 point (current-buffer))
-      (if add-linenum
-	  (setq line (format "%d: " (1+ (count-lines 1 point))))))
-    (save-excursion
-      (if (get-buffer buffer)
-	  (set-buffer (get-buffer buffer))
-	(set-buffer (get-buffer-create buffer))
-	(occur-mode)
-	(setq occur-buffer main-buffer)
-	)
-      (goto-char (point-max))
-      (setq start (point))
-      (insert line)
-      (if occur-point
-	  (setq occur-point (point)))
-      (insert message)
-      (if point
-	  (add-text-properties
-	   start (point)
-	   '(mouse-face highlight
-	     help-echo "mouse-2: go to the line where I learned this")))
-      (insert "\n")
-      (if point
-	  (progn
-	    (put-text-property start (point) 'occur m1)
-	    (if occur-point
-		(put-text-property occur-point (1+ occur-point)
-				   'occur-point t))
-	    ))
-      )))
-
-
-
-;; Is this really worth having?
-(defvar sh-learned-buffer-hook nil
-  "*An abnormal hook, called with an alist of learned variables.")
-;;; Example of how to use sh-learned-buffer-hook
-;;
-;; (defun what-i-learned (list)
-;;   (let ((p list))
-;;     (save-excursion
-;;       (set-buffer "*scratch*")
-;;       (goto-char (point-max))
-;;       (insert "(setq\n")
-;;       (while p
-;; 	(insert (format "  %s %s \n"
-;; 			(nth 0 (car p)) (nth 1 (car p))))
-;; 	(setq p (cdr p)))
-;;       (insert ")\n")
-;;       )))
-;;
-;; (add-hook 'sh-learned-buffer-hook 'what-i-learned)
-
-
-;; Originally this was sh-learn-region-indent (beg end)
-;; However, in practice this was awkward so I changed it to
-;; use the whole buffer.  Use narrowing if needbe.
-(defun sh-learn-buffer-indent (&optional arg)
-  "Learn how to indent the buffer the way it currently is.
-
-Output in buffer \"*indent*\" shows any lines which have conflicting
-values of a variable, and the final value of all variables learned.
-This buffer is popped to automatically if there are any discrepancies.
-
-If no prefix ARG is given, then variables are set to numbers.
-If a prefix arg is given, then variables are set to symbols when
-applicable -- e.g. to symbol `+' if the value is that of the
-basic indent.
-If a positive numerical prefix is given, then  `sh-basic-offset'
-is set to the prefix's numerical value.
-Otherwise, sh-basic-offset may or may not be changed, according
-to the value of variable `sh-learn-basic-offset'.
-
-Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the
-function completes.  The function is abnormal because it is called
-with an alist of variables learned.  This feature may be changed or
-removed in the future.
-
-This command can often take a long time to run."
-  (interactive "P")
-  (sh-must-support-indent)
-  (save-excursion
-    (goto-char (point-min))
-    (let ((learned-var-list nil)
-	  (out-buffer "*indent*")
-	  (num-diffs 0)
-	  last-pos
-	  previous-set-info
-	  (max 17)
-	  vec
-	  msg
-	  (comment-col nil) ;; number if all same, t if seen diff values
-	  (comments-always-default t) ;; nil if we see one not default
-	  initial-msg
-	  (specified-basic-offset (and arg (numberp arg)
-				       (> arg 0)))
-	  (linenum 0)
-	  suggested)
-      (setq vec (make-vector max 0))
-      (sh-mark-init out-buffer)
-
-      (if specified-basic-offset
-	  (progn
-	    (setq sh-basic-offset arg)
-	    (setq initial-msg
-		  (format "Using specified sh-basic-offset of %d"
-			  sh-basic-offset)))
-	(setq initial-msg
-	      (format "Initial value of sh-basic-offset: %s"
-		      sh-basic-offset)))
-
-      (while (< (point) (point-max))
-	(setq linenum (1+ linenum))
-	;; (if (zerop (% linenum 10))
-	(message "line %d" linenum)
-	;; )
-	(unless (looking-at "\\s-*$") ;; ignore empty lines!
-	  (let* ((sh-indent-comment t) ;; info must return default indent
-		 (info (sh-get-indent-info))
-		 (var (sh-get-indent-var-for-line info))
-		 sval ival diff new-val
-		 (curr-indent (current-indentation)))
-	    (cond
-	     ((null var)
-	      nil)
-	     ((stringp var)
-	      nil)
-	     ((numberp (setq sval (sh-var-value var 'no-error)))
-	      ;; the numberp excludes comments since sval will be t.
-	      (setq ival (sh-calculate-indent))
-	      (setq diff (- curr-indent ival))
-	      (setq new-val (+ sval diff))
-	      (sh-set-var-value var new-val 'no-symbol)
-	      (unless (looking-at "\\s-*#") ;; don't learn from comments
-		(if (setq previous-set-info (assoc var learned-var-list))
-		    (progn
-		      ;; it was already there, is it same value ?
-		      (unless (eq (symbol-value var)
-				  (nth 1 previous-set-info))
-			(sh-mark-line
-			 (format "Variable %s was set to %s"
-				 var (symbol-value var))
-			 (point) out-buffer t t)
-			(sh-mark-line
-			 (format "  but was previously set to %s"
-				 (nth 1 previous-set-info))
-			 (nth 2 previous-set-info) out-buffer t)
-			(setq num-diffs (1+ num-diffs))
-			;; (delete previous-set-info  learned-var-list)
-			(setcdr previous-set-info
-				(list (symbol-value var) (point)))
-			)
-		      )
-		  (setq learned-var-list
-			(append (list (list var (symbol-value var)
-					    (point)))
-				learned-var-list)))
-		(if (numberp new-val)
-		    (progn
-		      (sh-debug
-		       "This line's indent value: %d"  new-val)
-		      (if (< new-val 0)
-			  (setq new-val (- new-val)))
-		      (if (< new-val max)
-			  (aset vec new-val (1+ (aref vec new-val))))))
-		))
-	     ((eq var 'sh-indent-comment)
-	      (unless (= curr-indent (sh-calculate-indent info))
-		;; this is not the default indentation
-		(setq comments-always-default nil)
-		(if comment-col	;; then we have see one before
-		    (or (eq comment-col curr-indent)
-			(setq comment-col t)) ;; seen a different one
-		  (setq comment-col curr-indent))
-		))
-	     (t
-	      (sh-debug "Cannot learn this line!!!")
-	      ))
-	    (sh-debug
-	     "at %s learned-var-list is %s" (point) learned-var-list)
-	    ))
-	(forward-line 1)
-	) ;; while
-      (if sh-debug
-	  (progn
-	    (setq msg (format
-		       "comment-col = %s  comments-always-default = %s"
-		       comment-col comments-always-default))
-	    ;; (message msg)
-	    (sh-mark-line  msg nil out-buffer)))
-      (cond
-       ((eq comment-col 0)
-	(setq msg  "\nComments are all in 1st column.\n"))
-       (comments-always-default
-	(setq msg  "\nComments follow default indentation.\n")
-	(setq comment-col t))
-       ((numberp comment-col)
-	(setq msg  (format "\nComments are in col %d." comment-col)))
-       (t
-	(setq msg  "\nComments seem to be mixed, leaving them as is.\n")
-	(setq comment-col nil)
-	))
-      (sh-debug msg)
-      (sh-mark-line  msg nil out-buffer)
-
-      (sh-mark-line initial-msg nil out-buffer t t)
-
-      (setq suggested (sh-guess-basic-offset vec))
-
-      (if (and suggested (not specified-basic-offset))
-	  (let ((new-value
-		 (cond
-		  ;; t => set it if we have a single value as a number
-		  ((and (eq sh-learn-basic-offset t) (numberp suggested))
-		   suggested)
-		  ;; other non-nil => set it if only one value was found
-		  (sh-learn-basic-offset
-		   (if (numberp suggested)
-		       suggested
-		     (if (= (length suggested) 1)
-			 (car suggested))))
-		  (t
-		   nil))))
-	    (if new-value
-		(progn
-		  (setq learned-var-list
-			(append (list (list 'sh-basic-offset
-					    (setq sh-basic-offset new-value)
-					    (point-max)))
-				learned-var-list))
-		  ;; Not sure if we need to put this line in, since
-		  ;; it will appear in the "Learned variable settings".
-		  (sh-mark-line
-		   (format "Changed sh-basic-offset to: %d" sh-basic-offset)
-		   nil out-buffer))
-	      (sh-mark-line
-	       (if (listp suggested)
-		   (format "Possible value(s) for sh-basic-offset:  %s"
-			   (mapconcat 'int-to-string suggested " "))
-		 (format "Suggested sh-basic-offset:  %d" suggested))
-	       nil out-buffer))))
-
-
-      (setq learned-var-list
-	    (append (list (list 'sh-indent-comment comment-col (point-max)))
-		    learned-var-list))
-      (setq sh-indent-comment comment-col)
-      (let ((name (buffer-name))
-	    (lines (if (and (eq (point-min) 1)
-			    (eq (point-max) (1+ (buffer-size))))
-		       ""
-		     (format "lines %d to %d of "
-			     (1+ (count-lines 1 (point-min)))
-			     (1+ (count-lines 1 (point-max))))))
-	    )
-	(sh-mark-line  "\nLearned variable settings:" nil out-buffer)
-	(if arg
-	    ;; Set learned variables to symbolic rather than numeric
-	    ;; values where possible.
-	    (dolist (learned-var (reverse learned-var-list))
-	      (let ((var (car learned-var))
-		    (val (nth 1 learned-var)))
-		(when (and (not (eq var 'sh-basic-offset))
-			   (numberp val))
-		  (sh-set-var-value var val)))))
-	(dolist (learned-var (reverse learned-var-list))
-	  (let ((var (car learned-var)))
-	    (sh-mark-line (format "  %s %s" var (symbol-value var))
-			  (nth 2 learned-var) out-buffer)))
-	(save-excursion
-	  (set-buffer out-buffer)
-	  (goto-char (point-min))
-	  (insert
-	   (format "Indentation values for buffer %s.\n" name)
-	   (format "%d indentation variable%s different values%s\n\n"
-		   num-diffs
-		   (if (= num-diffs 1)
-		       " has"   "s have")
-		   (if (zerop num-diffs)
-		       "." ":"))
-	   )))
-      ;; Are abnormal hooks considered bad form?
-      (run-hook-with-args 'sh-learned-buffer-hook learned-var-list)
-      (if (or sh-popup-occur-buffer (> num-diffs 0))
-	  (pop-to-buffer out-buffer))
-      )))
-
-(defun sh-guess-basic-offset (vec)
-  "See if we can determine a reasonable value for `sh-basic-offset'.
-This is experimental, heuristic and arbitrary!
-Argument VEC is a vector of information collected by
-`sh-learn-buffer-indent'.
-Return values:
-  number          - there appears to be a good single value
-  list of numbers - no obvious one, here is a list of one or more
-		    reasonable choices
-  nil		  - we couldn't find a reasonable one."
-  (let* ((max (1- (length vec)))
-	 (i 1)
-	 (totals (make-vector max 0))
-	 (return nil)
-	 j)
-    (while (< i max)
-      (aset totals i (+ (aref totals i) (* 4 (aref vec i))))
-      (setq j (/ i 2))
-      (if (zerop (% i 2))
-	  (aset totals i (+ (aref totals i) (aref vec (/ i 2)))))
-      (if (< (* i 2) max)
-	  (aset totals i (+ (aref totals i) (aref vec (* i 2)))))
-      (setq i (1+ i)))
-
-    (let ((x nil)
-	  (result nil)
-	  tot sum p)
-      (setq i 1)
-      (while (< i max)
-	(if (/= (aref totals i) 0)
-	    (setq x (append x (list (cons i (aref totals i))))))
-	(setq i (1+ i)))
-
-      (setq x (sort x (lambda (a b) (> (cdr a) (cdr b)))))
-      (setq tot (apply '+ (append totals nil)))
-      (sh-debug (format "vec: %s\ntotals: %s\ntot: %d"
-			vec totals tot))
-      (cond
-       ((zerop (length x))
-	(message "no values!"))	;; we return nil
-       ((= (length x) 1)
-	(message "only value is %d" (car (car x)))
-	(setq result (car (car x)))) ;; return single value
-       ((> (cdr (car x)) (/ tot 2))
-	;; 1st is > 50%
-	(message "basic-offset is probably %d" (car (car x)))
-	(setq result (car (car x)))) ;;   again, return a single value
-       ((>=  (cdr (car x)) (* 2 (cdr (car (cdr x)))))
-	;; 1st is >= 2 * 2nd
-	(message "basic-offset could be %d" (car (car x)))
-	(setq result (car (car x))))
-       ((>= (+ (cdr (car x))(cdr (car (cdr x)))) (/ tot 2))
-	;; 1st & 2nd together >= 50%  - return a list
-	(setq p x  sum 0 result nil)
-	(while  (and p
-		     (<= (setq sum (+ sum (cdr (car p)))) (/ tot 2)))
-	  (setq result (append result (list (car (car p)))))
-	  (setq p (cdr p)))
-	(message "Possible choices for sh-basic-offset: %s"
-		 (mapconcat 'int-to-string result " ")))
-       (t
-	(message "No obvious value for sh-basic-offset.  Perhaps %d"
-		 (car (car x)))
-	;; result is nil here
-	))
-      result)))
-
-;; ========================================================================
-
-;; Styles -- a quick and dirty way of saving the indentation settings.
-
-(defvar sh-styles-alist nil
-  "A list of all known shell indentation styles.")
-
-(defun sh-name-style (name &optional confirm-overwrite)
-  "Name the current indentation settings as a style called NAME.
-If this name exists, the command will prompt whether it should be
-overwritten if
-- - it was called interactively with a prefix argument, or
-- - called non-interactively with optional CONFIRM-OVERWRITE non-nil."
-  ;; (interactive "sName for this style: ")
-  (interactive
-   (list
-    (read-from-minibuffer "Name for this style? " )
-    (not current-prefix-arg)))
-  (let ((slist (cons name
-		     (mapcar (lambda (var) (cons var (symbol-value var)))
-			     sh-var-list)))
-	(style (assoc name sh-styles-alist)))
-    (if style
-	(if (and confirm-overwrite
-		 (not (y-or-n-p "This style exists.  Overwrite it? ")))
-	    (message "Not changing style %s" name)
-	  (message "Updating style %s" name)
-	  (setcdr style (cdr slist)))
-      (message "Creating new style %s" name)
-      (push slist sh-styles-alist))))
-
-(defun sh-load-style (name)
-  "Set shell indentation values for this buffer from those in style NAME."
-  (interactive (list (completing-read
-		      "Which style to use for this buffer? "
-		      sh-styles-alist nil t)))
-  (let ((sl (assoc name  sh-styles-alist)))
-    (if (null sl)
-	(error "sh-load-style - style %s not known" name)
-      (dolist (var (cdr sl))
-	(set (car var) (cdr var))))))
-
-(defun sh-save-styles-to-buffer (buff)
-  "Save all current styles in elisp to buffer BUFF.
-This is always added to the end of the buffer."
-  (interactive (list
-		(read-from-minibuffer "Buffer to save styles in? " "*scratch*")))
-  (with-current-buffer (get-buffer-create buff)
-    (goto-char (point-max))
-    (insert "\n")
-    (pp `(setq sh-styles-alist ',sh-styles-alist) (current-buffer))))
-
-
-
-;; statement syntax-commands for various shells
-
-;; You are welcome to add the syntax or even completely new statements as
-;; appropriate for your favorite shell.
-
-(define-skeleton sh-case
-  "Insert a case/switch statement.  See `sh-feature'."
-  (csh "expression: "
-       "switch( " str " )" \n
-       > "case " (read-string "pattern: ") ?: \n
-       > _ \n
-       "breaksw" \n
-       ( "other pattern, %s: "
-	 < "case " str ?: \n
-	 > _ \n
-	 "breaksw" \n)
-       < "default:" \n
-       > _ \n
-       resume:
-       < < "endsw")
-  (es)
-  (rc "expression: "
-      > "switch( " str " ) {" \n
-      > "case " (read-string "pattern: ") \n
-      > _ \n
-      ( "other pattern, %s: "
-	"case " str > \n
-	> _ \n)
-      "case *" > \n
-      > _ \n
-      resume:
-      ?} > )
-  (sh "expression: "
-      > "case " str " in" \n
-      > (read-string "pattern: ")
-      (propertize ")" 'syntax-table sh-st-punc)
-      \n
-      > _ \n
-      ";;" \n
-      ( "other pattern, %s: "
-	> str (propertize ")" 'syntax-table sh-st-punc) \n
-	> _ \n
-	";;" \n)
-      > "*" (propertize ")" 'syntax-table sh-st-punc) \n
-      > _ \n
-      resume:
-      "esac" > ))
-
-(define-skeleton sh-for
-  "Insert a for loop.  See `sh-feature'."
-  (csh eval sh-modify sh
-       1 ""
-       2 "foreach "
-       4 " ( "
-       6 " )"
-       15 '<
-       16 "end")
-  (es eval sh-modify rc
-      4 " = ")
-  (rc eval sh-modify sh
-      2 "for( "
-      6 " ) {"
-      15 ?} )
-  (sh "Index variable: "
-      > "for " str " in " _ "; do" \n
-      > _ | ?$ & (sh-remember-variable str) \n
-      "done" > ))
-
-
-
-(define-skeleton sh-indexed-loop
-  "Insert an indexed loop from 1 to n.  See `sh-feature'."
-  (bash eval identity posix)
-  (csh "Index variable: "
-       "@ " str " = 1" \n
-       "while( $" str " <= " (read-string "upper limit: ") " )" \n
-       > _ ?$ str \n
-       "@ " str "++" \n
-       < "end")
-  (es eval sh-modify rc
-      4 " =")
-  (ksh88 "Index variable: "
-	 > "integer " str "=0" \n
-	 > "while (( ( " str " += 1 ) <= "
-	 (read-string "upper limit: ")
-	 " )); do" \n
-	 > _ ?$ (sh-remember-variable str) > \n
-	 "done" > )
-  (posix "Index variable: "
-	 > str "=1" \n
-	 "while [ $" str " -le "
-	 (read-string "upper limit: ")
-	 " ]; do" \n
-	 > _ ?$ str \n
-	 str ?= (sh-add (sh-remember-variable str) 1) \n
-	 "done" > )
-  (rc "Index variable: "
-      > "for( " str " in" " `{awk 'BEGIN { for( i=1; i<="
-      (read-string "upper limit: ")
-      "; i++ ) print i }'`}) {" \n
-      > _ ?$ (sh-remember-variable str) \n
-      ?} >)
-  (sh "Index variable: "
-      > "for " str " in `awk 'BEGIN { for( i=1; i<="
-      (read-string "upper limit: ")
-      "; i++ ) print i }'`; do" \n
-      > _ ?$ (sh-remember-variable str) \n
-      "done" > ))
-
-
-(defun sh-shell-initialize-variables ()
-  "Scan the buffer for variable assignments.
-Add these variables to `sh-shell-variables'."
-  (message "Scanning buffer `%s' for variable assignments..." (buffer-name))
-  (save-excursion
-    (goto-char (point-min))
-    (setq sh-shell-variables-initialized t)
-    (while (search-forward "=" nil t)
-      (sh-assignment 0)))
-  (message "Scanning buffer `%s' for variable assignments...done"
-	   (buffer-name)))
-
-(defvar sh-add-buffer)
-
-(defun sh-add-completer (string predicate code)
-  "Do completion using `sh-shell-variables', but initialize it first.
-This function is designed for use as the \"completion table\",
-so it takes three arguments:
-  STRING, the current buffer contents;
-  PREDICATE, the predicate for filtering possible matches;
-  CODE, which says what kind of things to do.
-CODE can be nil, t or `lambda'.
-nil means to return the best completion of STRING, or nil if there is none.
-t means to return a list of all possible completions of STRING.
-`lambda' means to return t if STRING is a valid completion as it stands."
-  (let ((sh-shell-variables
-	 (save-excursion
-	   (set-buffer sh-add-buffer)
-	   (or sh-shell-variables-initialized
-	       (sh-shell-initialize-variables))
-	   (nconc (mapcar (lambda (var)
-			    (let ((name
-				   (substring var 0 (string-match "=" var))))
-			      (cons name name)))
-			  process-environment)
-		  sh-shell-variables))))
-    (cond ((null code)
-	   (try-completion string sh-shell-variables predicate))
-	  ((eq code t)
-	   (all-completions string sh-shell-variables predicate))
-	  ((eq code 'lambda)
-	   (assoc string sh-shell-variables)))))
-
-(defun sh-add (var delta)
-  "Insert an addition of VAR and prefix DELTA for Bourne (type) shell."
-  (interactive
-   (let ((sh-add-buffer (current-buffer)))
-     (list (completing-read "Variable: " 'sh-add-completer)
-	   (prefix-numeric-value current-prefix-arg))))
-  (insert (sh-feature '((bash . "$[ ")
-			(ksh88 . "$(( ")
-			(posix . "$(( ")
-			(rc . "`{expr $")
-			(sh . "`expr $")
-			(zsh . "$[ ")))
-	  (sh-remember-variable var)
-	  (if (< delta 0) " - " " + ")
-	  (number-to-string (abs delta))
-	  (sh-feature '((bash . " ]")
-			(ksh88 . " ))")
-			(posix . " ))")
-			(rc . "}")
-			(sh . "`")
-			(zsh . " ]")))))
-
-
-
-(define-skeleton sh-function
-  "Insert a function definition.  See `sh-feature'."
-  (bash eval sh-modify ksh88
-	3 "() {")
-  (ksh88 "name: "
-	 "function " str " {" \n
-	 > _ \n
-	 < "}")
-  (rc eval sh-modify ksh88
-      1 "fn ")
-  (sh ()
-      "() {" \n
-      > _ \n
-      < "}"))
-
-
-
-(define-skeleton sh-if
-  "Insert an if statement.  See `sh-feature'."
-  (csh "condition: "
-       "if( " str " ) then" \n
-       > _ \n
-       ( "other condition, %s: "
-	 < "else if( " str " ) then" \n
-	 > _ \n)
-       < "else" \n
-       > _ \n
-       resume:
-       < "endif")
-  (es "condition: "
-      > "if { " str " } {" \n
-      > _ \n
-      ( "other condition, %s: "
-	"} { " str " } {" > \n
-	> _ \n)
-      "} {" > \n
-      > _ \n
-      resume:
-      ?} > )
-  (rc "condition: "
-      > "if( " str " ) {" \n
-      > _ \n
-      ( "other condition, %s: "
-	"} else if( " str " ) {"  > \n
-	> _ \n)
-      "} else {" > \n
-      > _ \n
-      resume:
-      ?} >
-      )
-  (sh "condition: "
-      '(setq input (sh-feature sh-test))
-      > "if " str "; then" \n
-      > _ \n
-      ( "other condition, %s: "
-	>  "elif " str "; then" > \n
-	> \n)
-      "else" > \n
-      > \n
-      resume:
-      "fi" > ))
-
-
-
-(define-skeleton sh-repeat
-  "Insert a repeat loop definition.  See `sh-feature'."
-  (es nil
-      > "forever {" \n
-      > _ \n
-      ?} > )
-  (zsh "factor: "
-       > "repeat " str "; do" > \n
-       >  \n
-       "done" > ))
-
-;;;(put 'sh-repeat 'menu-enable '(sh-feature sh-repeat))
-
-
-
-(define-skeleton sh-select
-  "Insert a select statement.  See `sh-feature'."
-  (ksh88 "Index variable: "
-	 > "select " str " in " _ "; do" \n
-	 > ?$ str \n
-	 "done" > )
-  (bash eval sh-append ksh88))
-;;;(put 'sh-select 'menu-enable '(sh-feature sh-select))
-
-
-
-(define-skeleton sh-tmp-file
-  "Insert code to setup temporary file handling.  See `sh-feature'."
-  (bash eval identity ksh88)
-  (csh (file-name-nondirectory (buffer-file-name))
-       "set tmp = /tmp/" str ".$$" \n
-       "onintr exit" \n _
-       (and (goto-char (point-max))
-	    (not (bolp))
-	    ?\n)
-       "exit:\n"
-       "rm $tmp* >&/dev/null" >)
-  (es (file-name-nondirectory (buffer-file-name))
-      > "local( signals = $signals sighup sigint; tmp = /tmp/" str
-      ".$pid ) {" \n
-      > "catch @ e {" \n
-      > "rm $tmp^* >[2]/dev/null" \n
-      "throw $e" \n
-      "} {" > \n
-      _ \n
-      ?} > \n
-      ?} > )
-  (ksh88 eval sh-modify sh
-	 7 "EXIT")
-  (rc (file-name-nondirectory (buffer-file-name))
-      > "tmp = /tmp/" str ".$pid" \n
-      "fn sigexit { rm $tmp^* >[2]/dev/null }")
-  (sh (file-name-nondirectory (buffer-file-name))
-      > "TMP=${TMPDIR:-/tmp}/" str ".$$" \n
-      "trap \"rm $TMP* 2>/dev/null\" " ?0))
-
-
-
-(define-skeleton sh-until
-  "Insert an until loop.  See `sh-feature'."
-  (sh "condition: "
-      '(setq input (sh-feature sh-test))
-      > "until " str "; do" \n
-      > _ \n
-      "done" > ))
-;;;(put 'sh-until 'menu-enable '(sh-feature sh-until))
-
-
-
-(define-skeleton sh-while
-  "Insert a while loop.  See `sh-feature'."
-  (csh eval sh-modify sh
-       2 ""
-       3 "while( "
-       5 " )"
-       10 '<
-       11 "end")
-  (es eval sh-modify sh
-      3 "while { "
-      5 " } {"
-      10 ?} )
-  (rc eval sh-modify sh
-      3 "while( "
-      5 " ) {"
-      10 ?} )
-  (sh "condition: "
-      '(setq input (sh-feature sh-test))
-      > "while " str "; do" \n
-      > _ \n
-      "done" > ))
-
-
-
-(define-skeleton sh-while-getopts
-  "Insert a while getopts loop.  See `sh-feature'.
-Prompts for an options string which consists of letters for each recognized
-option followed by a colon `:' if the option accepts an argument."
-  (bash eval sh-modify sh
-	18 "${0##*/}")
-  (csh nil
-       "while( 1 )" \n
-       > "switch( \"$1\" )" \n
-       '(setq input '("- x" . 2))
-       > >
-       ( "option, %s: "
-	 < "case " '(eval str)
-	 '(if (string-match " +" str)
-	      (setq v1 (substring str (match-end 0))
-		    str (substring str 0 (match-beginning 0)))
-	    (setq v1 nil))
-	 str ?: \n
-	 > "set " v1 & " = $2" | -4 & _ \n
-	 (if v1 "shift") & \n
-	 "breaksw" \n)
-       < "case --:" \n
-       > "shift" \n
-       < "default:" \n
-       > "break" \n
-       resume:
-       < < "endsw" \n
-       "shift" \n
-       < "end")
-  (ksh88 eval sh-modify sh
-	 16 "print"
-	 18 "${0##*/}"
-	 36 "OPTIND-1")
-  (posix eval sh-modify sh
-	 18 "$(basename $0)")
-  (sh "optstring: "
-      > "while getopts :" str " OPT; do" \n
-      > "case $OPT in" \n
-      '(setq v1 (append (vconcat str) nil))
-      ( (prog1 (if v1 (char-to-string (car v1)))
-	  (if (eq (nth 1 v1) ?:)
-	      (setq v1 (nthcdr 2 v1)
-		    v2 "\"$OPTARG\"")
-	    (setq v1 (cdr v1)
-		  v2 nil)))
-	> str "|+" str (propertize ")" 'syntax-table sh-st-punc) \n
-	> _ v2 \n
-	> ";;" \n)
-      > "*" (propertize ")" 'syntax-table sh-st-punc) \n
-      > "echo" " \"usage: " "`basename $0`"
-      " [+-" '(setq v1 (point)) str
-      '(save-excursion
-	 (while (search-backward ":" v1 t)
-	   (replace-match " ARG] [+-" t t)))
-      (if (eq (preceding-char) ?-) -5)
-      (if (and (sequencep v1) (length v1)) "] " "} ")
-      "[--] ARGS...\"" \n
-      "exit 2"  > \n
-      "esac" >
-      \n "done"
-      > \n
-      "shift " (sh-add "OPTIND" -1)))
-
-
-
-(defun sh-assignment (arg)
-  "Remember preceding identifier for future completion and do self-insert."
-  (interactive "p")
-  (self-insert-command arg)
-  (if (<= arg 1)
-      (sh-remember-variable
-       (save-excursion
-	 (if (re-search-forward (sh-feature sh-assignment-regexp)
-				(prog1 (point)
-				  (beginning-of-line 1))
-				t)
-	     (match-string 1))))))
-
-
-
-(defun sh-maybe-here-document (arg)
-  "Insert self.  Without prefix, following unquoted `<' inserts here document.
-The document is bounded by `sh-here-document-word'."
-  (interactive "*P")
-  (self-insert-command (prefix-numeric-value arg))
-  (or arg
-      (not (eq (char-after (- (point) 2)) last-command-char))
-      (save-excursion
-	(backward-char 2)
-	(sh-quoted-p))
-      (progn
-	(insert sh-here-document-word)
-	(or (eolp) (looking-at "[ \t]") (insert ? ))
-	(end-of-line 1)
-	(while
-	    (sh-quoted-p)
-	  (end-of-line 2))
-	(newline)
-	(save-excursion (insert ?\n sh-here-document-word)))))
-
-
-;; various other commands
-
-(autoload 'comint-dynamic-complete "comint"
-  "Dynamically perform completion at point." t)
-
-(autoload 'shell-dynamic-complete-command "shell"
-  "Dynamically complete the command at point." t)
-
-(autoload 'comint-dynamic-complete-filename "comint"
-  "Dynamically complete the filename at point." t)
-
-(autoload 'shell-dynamic-complete-environment-variable "shell"
-  "Dynamically complete the environment variable at point." t)
-
-
-
-(defun sh-newline-and-indent ()
-  "Strip unquoted whitespace, insert newline, and indent like current line."
-  (interactive "*")
-  (indent-to (prog1 (current-indentation)
-	       (delete-region (point)
-			      (progn
-				(or (zerop (skip-chars-backward " \t"))
-				    (if (sh-quoted-p)
-					(forward-char)))
-				(point)))
-	       (newline))))
-
-(defun sh-beginning-of-command ()
-  "Move point to successive beginnings of commands."
-  (interactive)
-  (if (re-search-backward sh-beginning-of-command nil t)
-      (goto-char (match-beginning 2))))
-
-(defun sh-end-of-command ()
-  "Move point to successive ends of commands."
-  (interactive)
-  (if (re-search-forward sh-end-of-command nil t)
-      (goto-char (match-end 1))))
-
-;; XEmacs change
-;;;###autoload(add-to-list 'auto-mode-alist '("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\\|logout\\)\\'" . sh-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode))
-;;;###autoload(setq auto-mode-alist (append auto-mode-alist '(("\\.m?spec$" . sh-mode))))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode))
-;;;###autoload(add-to-list 'interpreter-mode-alist '("^#!.*csh" . sh-mode))
-;;;###autoload(add-to-list 'interpreter-mode-alist '("^#!.*sh\\b" . sh-mode))
-;;;###autoload(add-to-list 'interpreter-mode-alist '("^:" . sh-mode))
-
-(provide 'sh-script)
-
-;;; sh-script.el ends here
diff --git a/xemacs-packages/lisp/speedbar/ChangeLog b/xemacs-packages/lisp/speedbar/ChangeLog
deleted file mode 100644
index b66f7ec0..00000000
--- a/xemacs-packages/lisp/speedbar/ChangeLog
+++ /dev/null
@@ -1,1626 +0,0 @@
-2005-07-19  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.28 released.
-
-2003-10-31  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.27 released.
-
-2003-03-09  Ben Wing  <ben@xemacs.org>
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-	Use STANDARD_DOCS instead of explicitly giving the targets
-	and dependencies.
-
-2003-01-03  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.26 released.
-
-2002-12-17  Jerry James  <james@xemacs.org>
-
-	* sb-rmail.el: Require speedbar at compile time to define the
-	speedbar-message macro.
-
-2002-11-29  Ben Wing  <ben@xemacs.org>
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-12-06  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.25 released.
-
-2002-11-28  Ville Skyttä  <scop@xemacs.org>
-
-	* Makefile (REQUIRES): Add edebug.
-
-	* dframe.el (dframe-update-keymap): Get rid of keybindings to
-	nonexistent `dframe-mouse-item-info'.
-
-2002-11-25  Paul Krause  <paulkrause88@alum.mit.edu>
-
-	* dframe.el: Pass event to poup-mode-menu if accepted.
-	* dframe.el (dframe-pass-event-to-popup-mode-menu): New flag.
-	* dframe.el (dframe-xemacs-popup-kludge): Use it.
-	* speedbar.el (speedbar-center-buffer-smartly): Center other frame.
-
-2002-10-15  Ville Skyttä  <scop@xemacs.org>
-
-	* Makefile (srckit): Remove.
-
-2002-10-14  Ville Skyttä  <scop@xemacs.org>
-
-	* Makefile (MANUAL): Removed (unused).
-
-2002-08-12  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.24 released.
-
-2002-08-10  Steve Youngs  <youngs@xemacs.org>
-
-	* Sync to Upstream version 0.14beta4
-
-2002-08-08  Steve Youngs  <youngs@xemacs.org>
-
-	* package-info.in (provides): Update.
-
-	* Makefile (AUTHOR_VERSION): Update to 0.14beta4
-	(ELCS): Add missing .elc's.
-
-2002-03-17  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* Project.ede: Added box images.
-
-	* speedbar.el (speedbar-buffer-easymenu-definition):
-	Better enable for kill/revert
-	(speedbar-buffer-kill-buffer): Use `speedbar-get-line-text'.
-
-	* sb-image.el:
-	(speedbar-directory, speedbar-box-plus, speedbar-directory-box-minus):
-	New images.
-	(speedbar-expand-image-button-alist): Added boxes, and empty directory.
-
-	* sb-box-plus.xpm, sb-box.xpm, sb-box-minus.xpm: Box icon.
-
-	* sb-html.el (speedbar-fetch-dynamic-html): Support html-mode too.
-
-	* sb-html.el (speedbar-insert-html-list):
-	Always pass 0 to format-html-list.
-
-	* speedbar.el (speedbar-check-read-only):
-	Support directories, and hidden files.
-	(speedbar-check-vc): Support hidden files.
-
-	* sb-texinfo.el (speedbar-texinfo-section-regexp): Added doc string
-	(speedbar-format-texinfo-list-recursive): Doc string.
-	(speedbar-insert-texinfo-list): Always pass 0 into the list reorganizer.
-
-	* Project.ede: Version change.
-	Lots of new images.
-
-	* speedbar.el (speedbar-check-read-only):
-	Get the correct file name during test.
-
-2002-03-16  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* INSTALL: Add info about optional packages.
-
-	* sb-rmail.el (rmail-speedbar-buttons): Use new speedbar separator.
-
-	* sb-info.el (Info-speedbar-image-button-alist): New variable
-	(Info-speedbar-hierarchy-buttons): Use above variable for images
-	(Info-speedbar-expand-node): Use new variable for images.
-
-	* sb-info.xpm: Courier lowercase i in a blue circle
-
-	* sb-pg.xpm, sb-pg-plus.xpm, sb-pg-minus.xpm: Made the corner gray.
-
-	* sb-label.xpm: Made slightly larger.
-
-	* sb-image.el:
-	(speedbar-label, speedbar-read-only, speedbar-document-tag,
-	speedbar-document-plus, speedbar-document-minus, speedbar-info-tag):
-	New images.
-	(speedbar-expand-image-button-alist): Added above new images.
-	(speedbar-image-dump): New test command.
-
-	* sb-gud.el: Use the speedbar separator for labels.
-
-	* sb-doc.xpm: Book.
-
-	* sb-doc-plus.xpm: Book with plus.
-
-	* sb-doc-minus.xpm: Book with minus.
-
-	* sb-dir.xpm, sb-dir-plus.xpm, sb-dir-minus.xpm: added darker area.
-
-	* rpm.el: Added "=" binding for expand.
-
-	* speedbar.el (speedbar-version): New beta
-	(speedbar-separator-face): Added gray overline.
-
-2002-03-15  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-stealthy-function-list):
-	Added new "locked files" stealthy function
-	(speedbar-ro-to-do-point, speedbar-object-read-only-indicator): New variables
-	(speedbar-indicator-regex): Added new ro indicator
-	(speedbar-insert-separator): New function
-	(speedbar-reset-scanners): Reset ro indicator
-	(speedbar-check-read-only): New function
-	(speedbar-buffer-buttons-engine): Use new separator function
-	(speedbar-buffers-tail-notes): New function
-	(speedbar-separator-face): New face.
-
-	* sb-ro.xpm: Image to show a locked thing.
-
-	* sb-label.xpm: Bitmap prefixing labes to make them look cool.
-
-2002-03-02  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* Project.ede, speedbar.el: Update version number
-
-2002-03-01  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* Project.ede: Added ChangeLog to the project.
-
-2002-02-28  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.texi (Hidden Files):
-	Updated doc near `speedbar-supported-extension-expressions'.
-
-	* sb-w3.el: Require speedbar, and w3-menu if available.
-
-	* sb-info.el: Require speedbar.
-
-	* sb-image.el (speedbar-find-image-on-load-path):
-	Add support for XEmacs data directories.
-
-	* sb-gud.el: Require speedbar.
-
-	* speedbar.el (speedbar-use-tool-tips-flag): New flag.
-	(speedbar-track-mouse-flag): Use above to initialize.
-	(speedbar-supported-extension-expressions): Updated doc.
-	(speedbar-make-button): Do not add help echo if tool-tips are disabled.
-
-2002-02-26  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-frame-plist): Remove XEmacs gutter
-	(speedbar-supported-extension-expressions): Added .ma?k Makefiles
-	(speedbar-check-vc): Different thes of efs regexp.
-	(speedbar-buffer-buttons-engine): Ignore case search.
-
-	* speedbar.el (speedbar-reconfigure-keymaps):
-	Only add XEmacs menubar if menubar enabled.
-	(speedbar-make-button): Add `speedbar-text property to buttons.
-	(speedbar-update-contents): Add spaces for clarity
-	(speedbar-update-directory-contents): Wrap update in `save-excursion'
-	(speedbar-find-selected-file): Set current buffer to the speedbar buffer.
-	(speedbar-update-current-file): Do not center the buffer smartly.
-	(speedbar-line-text): Use new `speedbar-text -property instead of
-	using the match of a regular expression.  More robust to spaces.
-	(speedbar-center-buffer-smartly): Wrap in `save-selected-window',
-	make sure we are in speedbar's buffer.  Specify argument to
-	`window-height'.
-
-2002-02-06  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-w3.el (w3-speedbar-buttons): Added ###autoload tag.
-
-	* sb-rmail.el (rmail-speedbar-buttons): Added ###autoload tag.
-
-	* sb-info.el (Info-speedbar-buttons): Added ###autoload tag.
-
-	* sb-gud.el: Added autoload.
-
-	* rpm.el: Added autoload tag.
-
-	* INSTALL: Added property quoting for `eval-after-load' example.
-
-2001-12-17  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* dframe.el (dframe-frame-mode):
-	Select the speedar frame when using a terminal.
-
-2001-10-31  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* Project.ede: Update version.
-	Added sb-ant.el
-
-	* sb-ant.el: ANT support
-
-2001-10-28  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* rpm.el (rpm-speedbar, rpm-tag-expand):
-	Use proper sort hierarchy method.
-	(
-
-	* sb-info.el (Info-install-speedbar-variables):
-	Add space keybinding to toggle expand.
-
-	* dframe.el (dframe-frame-mode):
-	Disable setting the default minibuffer frame
-	(dframe-y-or-n-p): Don't compare against the default-minibuffer-frame
-
-2001-10-27  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-frame-mode):
-	Add function to `dframe-delete-frame-function
-	(speedbar-handle-delete-frame): New function
-	(speedbar-line-file, speedbar-line-path): Widen any current restrictions
-	(
-
-	* dframe.el: (dframe-version):
-	(dframe-make-frame-visible-function,
-	 dframe-iconify-frame-function,
-	 dframe-delete-frame-function): New functions
-	(dframe-handle-make-frame-visible,
-	 dframe-handle-iconify-frame,
-	 dframe-handle-delete-frame): New Commands bound to special events.
-
-2001-10-26  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-key-map):
-	Removed old SPC and DEL page up/down keys
-	(speedbar-file-key-map): Added SPC to toggle expansion of a node
-	(speedbar-toggle-line-expansion): New command.
-	(speedbar-buffers-key-map): Added SPC to toggle expansion of a node
-
-2001-10-22  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* dframe.el (dframe-click):
-	Do not call `dframe-mouse-click-function' if it has
-	no value.
-
-2001-10-18  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-try-completion): New function
-	(speedbar-prefix-group-tag-hierarchy, speedbar-trim-words-tag-hierarchy,
-	speedbar-center-buffer-smartly): Use `speedbar-try-completion' instead
-	of 'try-completion.
-
-	* speedbar.el (speedbar-obj-alist): Added cxx.
-	(speedbar-toggle-images, speedbar-toggle-sorting): Fix doc.
-	(speedbar-fetch-egags-parse-list): Add cxx.
-
-2001-08-17  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Update version
-	(speedbar-find-file-in-frame): fixed `other-frame' typo.
-
-2001-08-08  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-item-info-tag-helper):
-	Use two new features of `semantic-sb'.
-	speedbar.el will now require semantic beta9 or later, or no semantic
-	at all.
-
-2001-07-20  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-select-frame-method): New variable
-	(speedbar-find-file-in-frame): Use above.
-
-2001-05-31  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-find-selected-file):
-	Regexp quote the file before finding it.
-
-2001-05-09  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-objod.xpm, sb-obj.xpm, sb-chk.xpm: *** empty log message ***
-
-	* Project.ede: Version, sb-html, and more images.
-
-	* sb-image.el (speedbar-checkout, speedbar-object, speedbar-object-out-of-date):
-	New images.
-	(speedbar-expand-image-button-alist): Added above vars.
-
-	* speedbar.el (speedbar-version): Update to 0.14beta1
-	(speedbar-add-indicator): Call image display fcn when inserting indicators.
-
-2001-05-08  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-vc-check-dir-p):
-	Use vc-state if available for CVS.
-	(speedbar-this-file-in-vc): Use vc-state if available.
-
-	* dframe.el (dframe-switch-buffer-attached-frame):
-	Fix arg to `other-frame'.
-
-	* speedbar.el (speedbar-buffers-line-path):
-	Fixed to used `default-directory'
-	instead of buffer-file-name since some buffers do not have file names.
-
-2001-04-29  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-query-confirmation-method): new option.
-	(speedbar-visiting-file-hook, speedbar-visiting-tag-hook,
-	 speedbar-load-hook, speedbar-reconfigure-keymaps-hook): added * to doc.
-	(speedbar-ignored-modes): Added fundamental-mode.
-	(speedbar-directory-unshown-regexp): Added . directories.
-	(speedbar-y-or-n-p): Pay attention to `speedbar-query-confirmation-method'
-	and added a `deleting' parameter.
-	General: Use `summarize' instead of `summerize'
-	         Added true to deleting flag to speedbar-y-or-n-p where needed.
-
-2001-04-27  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* INSTALL: Added info about sb-html.
-
-	* sb-html.el: *** empty log message ***
-
-	* speedbar.el (speedbar-sort-tags): Added forward in obsolete variable.
-	(speedbar-tag-hierarchy-method): Swapped two items in custom list.
-	(speedbar-frame-reposition-smartly): Handle explicit setting of pos in
-	frame properties.
-	(speedbar-line-text): Fixed regexp to handle more first button cases.
-	(speedbar-dired): Do no flush last-selected-file at end.
-	(speedbar-center-buffer-smartly): Better line counting for variable
-	height lines.
-	(speedbar-buffers-line-path): Work better for buffers.
-	(end): Added section to remove speedbar from global font lock modes.
-
-	* sb-image.el:
-	Switched to check for the XEmacs feature, instead of the function presense.
-
-	* dframe.el (dframe-reposition-frame-emacs): More docs.
-	Handle top-bottom position case.
-	Handle CONS cell position case.
-	(dframe-set-timer-internal): For timeouts, XEmacs version change on itimer.
-	(dframe-track-mouse): Fixed for XEmacs.
-	(dframe-mouse-hscroll): Fixed to work better (submitted by someone I
-	 forgot, sorry.)
-
-2001-01-31  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-dir-minus.xpm, sb-dir-plus.xpm, sb-dir.xpm, sb-mail.xpm, sb-pg-minus.xpm, sb-pg-plus.xpm, sb-pg.xpm, sb-tag-gt.xpm, sb-tag-minus.xpm, sb-tag-plus.xpm, sb-tag-type.xpm, sb-tag-v.xpm, sb-tag.xpm:
-	*** empty log message ***
-
-	* Project.ede: Project file for Speedbar
-
-2001-01-08  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Hacked out many comments.
-	Tried to fix accidentaly reversal of tags when alpha binning.
-
-2000-12-13  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added `speedbar-create-directory', bound in keymap and menu for file mode.
-	Removed "SPEEDBAR" word from modeline.  Replaced with mode name.
-	Turn list of display modes to radio buttons.
-
-2000-12-11  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-texinfo.el:
-	Find the file before tagging due to changes in speedbar.
-
-	* speedbar.texi: Merged changes from Emacs made by Dave Love.
-	Added info about changes to dynamic tag finders.
-
-	* dframe.el: Fixed quoting problem.
-
-	* sb-image.el: Fixed comments.
-
-	* speedbar.el: Update version.
-	Added .g to list of extensions.
-	Removed some overlay commands not being used.
-	Updated help for make-tag-line.
-	Updated `speedbar-generic-list-group-p' based on internet msg.
-	Do not load a file to get it's tags.  Depend on the method.
-	Pass file down to method getting tags, do not use the buffer name.
-	Load a file for imenu support.
-
-2000-10-21  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Always call the speedbar timer during a get-focus to get things
-	updated right away.
-	Deleted extra `speedbar-current-frame' function. (XEmacs byte compiler)
-	In the vc and object checks, set the buffer to the speedbar buffer if
-	that variable has a value. (The no value is during a detatched speedbar.)
-
-	* dframe.el:
-	In `dframe-get-focus', call the hook after the frame is created and selected.
-
-	* speedbar.texi: Updated the copyright.
-	Vast changes by Eli.
-
-2000-10-15  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Overlay compatibility updated for xemacs fsf compatibility hack workaround.
-
-2000-10-09  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: 2000-10-07  Dave Love  <fx@gnu.org>
-
-		* speedbar.el (speedbar-mode): Set dframe-track-mouse-function
-		conditionally.
-		(speedbar-frame-mode): Set automatic-hscrolling locally.
-
-2000-10-06  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed `detatched' word.  Fixed `speedbar-detatch' but by protecting
-	the frame, and making local variables.  Removed `set-buffer...' calls
-	from all stealthy functions.  (The buffer should always be the speedbar
-	buffer at that point.)
-
-	* dframe.el: Fixed the one detatched frame case.
-
-	* speedbar.el: Fixed the version number.
-
-	* speedbar.texi:
-	Proof read the doc, and fixed many simple english things.
-
-2000-10-05  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Bring doc back to speedbar-power-click.
-	Make sure C-u + command sets speedbar-power-click.
-
-2000-10-01  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Do not display Emacs 21 toolbar in the speedbar frame.
-
-2000-09-30  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* dframe.el: Removed toggle-updates.
-
-	* speedbar.el: Moved toggle-updates into speedbar keymap.
-	Made check for generic list types more reliable.
-
-2000-09-22  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* dframe.el: Added xemacs frame repositioning function.
-	Pass event down on XEmacs for mouse click.
-
-	* speedbar.el:
-	Tweeked the event handling for XEmacs so we only need one function.
-
-	* sb-info.el:
-	Updated regexps for node finding based in info from Richard Kim <ryk@dspwiz.com>
-
-2000-09-09  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* dframe.el: Stop running through timeouts if there is user input.
-
-	* speedbar.el: Added backward compatible speed variables.
-
-2000-09-08  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* dframe.el: Fixed up timers to restart properly.
-
-	* dframe.el: Fixed typo
-
-	* INSTALL: Added details about programs that use speedbar.
-
-2000-09-07  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	re-enabled speedbar-power-click via let statement in speedbar-click.
-	Added `speedbar-current-frame'.
-
-2000-09-05  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* bigclock.el: Added in some function quotes.
-	Fixed comma typo.
-
-	* dframe.el: Fixed typo in comments.
-	Make the four application function variables buffer local.
-	Don't call help-echo function if there isn't one.
-
-	* speedbar.el: Removed some stuff from the header.
-	For `expandtag' button type, make sure it is three characters long,
-	otherwise the expand/contract code can get a little confused when
-	working with images.
-
-	* speedbar.texi: Reworked the intro a little.
-
-	* INSTALL: Updated for next version of speedbar.
-
-2000-09-04  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* dframe.el: Checkdoc updates.
-	Reindent dframe-help-echo
-
-	* bigclock.el: Checkdoc.
-
-2000-09-02  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Removed all the image handling code.
-
-	* sb-image.el: New file.
-
-2000-08-31  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* dframe.el: Added a version variable.
-	Fixed defgroup up.
-
-	* speedbar.el: Fixed up -message, and -y-or-n-p to be backquoted in.
-	Added aliases for `speedbar-select-attached-frame', and
-	-with-attached-buffer, and -maybe-jump-to-attached-frame
-	for compatibility.
-	Removed `speedbar-show-info-under-mouse' call from timer.
-
-2000-08-21  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* bigclock.el: New file.
-
-2000-08-17  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added a version variable, added it near top, removed version slot from lm.
-
-	* rpm.el, sb-info.el: Updates for speedbar's use of dframe.
-
-	* rpm.el: Use dframe-power-click, instead of speedbar-power-click.
-
-	* speedbar.el: speedbar-update-flag; set to dframe-have-timer-flag.
-
-	* dframe.el: Updated doc.
-	Added variable specifying if we should use timers.
-
-2000-08-14  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Stripped out all frame management stuff, including timer, and mouse
-	click specifics.
-	Use new dframe API for that same behaviors.
-
-	* dframe.el: New file.
-
-2000-08-09  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-texinfo.el: Added provide.
-
-2000-07-22  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added `speedbar-current-frame', and use this in place of
-	`speedbar-frame' variable.  This should help make detatched frames
-	more reliable.
-
-2000-07-19  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* INSTALL: New file.
-
-	* speedbar.el: Version update.
-
-	* sb-texinfo.el: Few comment updates.
-
-	* speedbar.el: Fixed auto update menu item to work with XEmacs.
-	Fixed detached frame mouse-3 menu popup.
-	Fixed up new code for specialized tag/group buttons.
-
-2000-07-13  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-texinfo.el:
-	speedbar-insert-texinfo-list no longer sets sthm to nil.
-	speedbar-format-texinfo-list uses new positioned group for
-	any chapter w/ sections (etc)  Also set new
-	speedbar-generic-list-{group-expand|tag}-button-list to
-	nice values.
-
-	* speedbar.texi:
-	Updated doc for `speedbar-make-tag-line', `speedbar-tag-hierarchy-method',
-	and `speedbar-insert-generic-list'.
-
-	* speedbar.el:
-	Added two new button types to `speedbar-make-tag-line' of `expandtag'
-	and `statictag'.  Make sure statictag doesn't get a face.
-	In `speedbar-change-expand-button-char', insert new char first, then
-	delete the old.  Good for two character buttons.
-	In `speedbar-create-tag-hierarchy', force a get of the file name
-	no matter what kind of line we are on.
-	New variables `speedbar-generic-list-group-expand-button-type' and
-	`speedbar-generic-list-tag-button-type'.
-	In `speedbar-insert-generic-list', use the above new variables to
-	determine the type of button to make.  Get the values from buffer
-	local values if possible.
-
-	* speedbar.el: Removed :visible from Auto Update menu item.
-	Added Generic List comment section, plus these functions:
-	  `speedbar-generic-list-group-p',
-	  `speedbar-generic-list-positioned-group-p'
-	  `speedbar-generic-list-tag-p'
-	Replaced old queries for these things with the new functions.
-	When inserting generic list buttons, added a new type which is a group
-	that also contains a position.
-	(Generic list stuff for new texinfo tagger.)
-
-2000-07-05  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-texinfo.el: 1.5 - speedbar-tag-hierarchy-method is set to nil by
-	      speedbar-insert-texinfo-list as well as
-	      speedbar-fetch-dynamic-texinfo.  This is needed in order to
-	      have the texinfo nodes displayed in correct order.
-
-2000-07-04  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-texinfo.el: From Richard Y. Kim on version 1.4
-	speedbar-tag-hierarchy-method is now set to nil by
-	speedbar-fetch-dynamic-texinfo after making it buffer local
-	first. I thought this was buffer-local variable already, but it is
-	not. Also added installation instruction.
-
-2000-06-30  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-texinfo.el: New file.
-
-2000-06-23  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed terminal mode loading of EDE which used to need a frame.
-	Changed order so SORT is last, which lets it work.
-
-2000-06-20  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-info.el: Fixed up let statements w/ searches.
-
-2000-06-11  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added `speedbar-detatch' so we can have multiple speedbars.
-	Fixed `speedbar-trim-words-tag-hierarchy' to work w/ semantic.
-
-2000-06-03  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.texi:
-	Added bit about universal argument for flushing tag caches.
-
-	* speedbar.el: Integrate changes from Eli about display-graphic-p.
-
-2000-05-17  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed list problem with splicing Enable Image in the menu.
-	Fixed XEmacs invisible text property problems.
-
-2000-05-15  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-recenter): Typo, and fix logic.
-	(speedbar-expand-line): Make arg optional.
-	(speedbar-mode): Avoid a compiler warning.
-
-2000-05-13  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Require 'defimage in a safe way.
-	Added menu item for toggling image use, and for flush & expand.
-	Added `speedbar-toggle-images' and `speedbar-flush-expand-line'.
-	`speedbar-expand-line' now takes a universal argument.
-	Use explicit call to bufer-file-name instead of a variable for accuracy.
-	Eval-when-compile defimage macro stuff.
-	Use :ascent center for all images.
-
-2000-04-25  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Do not use images on terminals.
-
-2000-04-22  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed up documentation with checkdoc.
-
-	* speedbar.el: Added in more images.
-
-2000-04-14  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Make our defimage safe in XEmacs.
-
-2000-04-12  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Hacked out problems with older emacs (19.34 and 20.5)
-
-	* speedbar.el: Added support for Images:
-	  Variable `speedbar-use-images'.
-	  `defimage' for XEmacs which doesn't define it.
-	  XEmacs image insertion.
-	  Copied Emacs21 image code from old speedbar21 file.
-	  XEmacs glyph event support.
-	  All `buttons' inserted are now compared.  Specialized packages can
-	  extend the image list.
-
-2000-04-09  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed up previous depthsize checkin.
-
-2000-03-21  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: update xemacs20p to handle versions > 20
-	Fix some documentation.
-	Turned "hide-button-brackets-flag' into a defcustom.
-	Added `speedbar-indentation-width' of 1.  Affects depth of indentation.
-	Added support to image button calls.
-	Catch search errors in expand/contract line.
-
-2000-02-17  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.texi: Fixed typo.
-
-2000-02-09  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	(speedbar-buffer-buttons-engine) Strip the directory name from the
-	buffer file name when putting a token onto the [+] button.
-
-2000-01-25  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed doc on speedbar-dynamic-tags-function-list.
-
-	* speedbar.texi:
-	Added a chapter on tagging extentions, and fixed some compile problems.
-
-	* speedbar.el (speedbar-use-bovinator-flag): Removed
-	(speedbar-dynamic-tags-function-list): New variable.
-	(speedbar-create-tag-hierarchy): Don't use copy-tree if it isn't
-	available.
-	(speedbar-insert-bovine-list): Removed
-	(speedbar-insert-imenu-list, speedbar-insert-etags-list): New.
-	(speedbar-fetch-dynamic-tags): New
-	(speedbar-tag-file): Use `speedbar-fetch-dynamic-tags' instead of
-	checking all known methods of tagging individually.
-	(speedbar-fetch-dynamic-imenu): Don't bother setting buffer anymore.
-
-1999-11-29  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	The tag highlighting face is now the speedbar-highlight-face.
-
-	* speedbar.el:
-	Converted all regexps to use [/\\] insead of just / when breaking up
-	directories.
-
-	* speedbar.el:
-	Added a hook to speedbar-visiting-tag-hook to force a recenter.
-	Added several new functions to choose from also.
-
-1999-10-20  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Converted hierarchy methods into a hook.
-	Added predefined hooks for visiting-tag-hook.
-	Fixed some documentation.
-
-1999-09-19  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added new keymap reconfigure hook.
-	Added perl .pm to known extensions.
-
-	* speedbar.texi:
-	Used many of RMS's comments such as passive-voice, and queue->cue.
-	Only modified user chapters, now programmer chapters.
-
-1999-09-15  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.texi: Fixed spelling, and title.
-
-	* speedbar.texi: Added giant copyright notice.
-
-	* speedbar.texi: Added concept and function indices.
-
-	* speedbar.texi:
-	Proofread, fixed random stuff, and made work with makinfo 3.12f.
-
-1999-08-20  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.texi: New file.
-
-1999-05-27  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Use the new semantic summerize feature.
-
-1999-05-23  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed center-smartly to not depend on the old formats quite so much.
-
-1999-05-22  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Enabled specialized detail display for bovinated items.
-
-1999-05-18  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added power-click support to bovinator.
-
-	* speedbar.el:
-	Added special case in the hierarcy function for being clear w/ lists.
-	Condition case when bovinating.
-
-1999-05-05  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-use-bovinator-flag): New flag.
-	(speedbar-use-imenu-flag): Change custom tag.
-	(speedbar-insert-bovine-list): New function.
-	(speedbar-syntax-table): Add { and } to table.
-	(speedbar-tag-file): If a bovine table is available, use it.
-	(speedbar-fetch-dynamic-bovine): New function
-
-1999-04-28  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: (speedbar-file-key-map, speedbar-buffers-key-map):
-	 Added keybinding "=" same as "+" so you don't have to hit shift.
-	 (speedbar-fetch-dynamic-etags): Set buffer to the tmp buffer when
-	 extracting expressions. (Newer XEmacs exposed this.)
-
-1999-03-10  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added speedbar-y-or-n-p.  Make use of it in all fns.
-
-1999-03-01  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: New function speedbar-message
-	changed message to speedbar-message where apropriate.
-
-	* rpm.el, sb-rmail.el: changed messge to speedbar-message
-
-1999-02-15  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed tag info function.
-
-1999-01-28  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added {} support in speedbar-line-text and speedbar-line-token.
-
-1999-01-25  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Updated commentary on specialized modes.
-
-1999-01-21  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-item-info-file-helper): Add optional arg
-	of the file whose info we want to display.
-	(speedbar-easymenu-definition-trailer) Fix list issue w/ customize.
-	(speedbar-add-mode-functions-list) Improve doc.
-	(speedbar-line-token) New function.
-	(speedbar-dired) Fix order of directories in -shown-directories.
-
-1999-01-11  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Version update
-
-	* speedbar.el (speedbar-line-path): Default return is default-directory
-	(speedbar-buffers-line-path): Return is dir name only.
-
-1999-01-06  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Updated Version & copyright
-	(speedbar-mode-functions-list): New variable.
-	(speedbar-mouse-item-info): Rewrote to be a replaceable fn.
-	(speedbar-item-info-file-helper, speedbar-item-info-tag-helper
-	speedbar-files-item-info speedbar-buffers-item-info): New functions.
-	(speedbar-fetch-replacement-function,speedbar-add-mode-functions-list):
-	New functions.
-	(speedbar-line-file): Broke out part that fetches file from a line.
-	(speedbar-line-text): New function extracted from speedbar-line-file.
-	(speedbar-line-path): Converted into a replaceable function.
-	(speedbar-files-line-path, speedbar-buffers-line-path): New functions.
-
-1998-12-19  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed up cfx divination to handle lists from originating frame correctly.
-	Brought over some changes from speedbar.el from emacs 20.3 sources.
-
-1998-12-12  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Rehash attempt for geometries with lists.
-
-1998-11-24  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Update SCCS checks from p. to s. since that is in the spirit of what
-	we want.
-
-1998-11-22  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: More sort/bin problem correction when organizing tags.
-
-1998-10-24  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Update version number
-	(speedbar-tag-group-name-minimum-length): New variable.
-	(speedbar-frame-parameter): New compatibility function.
-	(speedbar-frame-mode): Updated to use speedbar-frame-parameter.
-	(speedbar-apply-one-tag-hierarchy-method): Fixed up taging sub
-	groups to keep things in the right order, and to help with some
-	naming conventions.
-	(speedbar-create-tag-hierarchy): Enable buffer local version of
-	`speedbar-tag-hierarchy-method' in the buffer we are tagging.
-	(speedbar-line-path): Permit depth to be optional.  When this is
-	the case, derive it from the cursor location in speedbar.
-
-1998-10-04  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-initial-expansion-list-name):
-	Remove customization since it
-	is not useful in this case.
-	(speedbar-frame-mode): Check if cfx or cfy is a list, and make sure it
-	gets evalled to a number.  Also verify that set-frame-name fn exists
-	before calling it.
-
-1998-09-12  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Do not set frame pos on terminals
-
-1998-08-31  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Changed version number
-
-1998-08-24  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	When running stealthy functions, make sure the buffer is writeable.
-
-	* speedbar.el:
-	Fixed problem w/ newest emacs and the temp-buffer-show-hook.
-
-	* speedbar.el: Made the speedbar buffer read only.
-
-1998-08-20  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed a typo
-
-1998-08-19  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Hide lock files.
-	Position frame at startup.
-	Don't update when iconified, or from minibuffer.
-
-1998-08-16  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Removed scrollbar width from the frame params for emacs.
-
-1998-08-08  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el (speedbar-edit-line, speedbar-buffer-kill-buffer, speedbar-buffer-revert-buffer):
-	Updated buffer finding regex to
-	handle the [?] tag.
-	(speedbar-find-selected-file): New function.
-	(speedbar-clear-current-file): Uses `speedbar-find-selected-file'
-	(speedbar-update-current-file): Uses `speedbar-find-selected-file',
-	and now `speedbar-last-selected-file' is defined as the path name
-	to the file, not just the file itself.
-	(speedbar-center-buffer-smartly): Fixed center error to handle
-	the whole buffer.
-	(speedbar-delete-subblock): Rewrote to be more robust, less clever.
-	(speedbar-timer-fn): Removed short display time for messages.
-
-1998-08-04  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Removed extra code from speedbar-refresh dealing with messages.
-	Added said code to the timer so that minibuffer's aren't overwritten
-	for very long.
-
-1998-08-03  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Removed a paren.
-
-	* sb-gud.el:
-	Updated to new speedbar system loading.  Fixed a no stack error.
-
-	* speedbar.el:
-	Removed silly if statement stuff from around emacs/xemacs frame param
-	stuff.  This is irrelevant since the symbols are different.
-
-	* sb-rmail.el: Updated to new speedbar init file technique.
-
-	* speedbar.el:
-	Fixed a bug where ctrl-down-mouse1 could be used to change buffers,
-	but caused an error.  I now use a hack to get around it.
-	Also, fixed the current file selection to center smartly.
-
-	* sb-info.el: Fixed comment from when I copied from RPM mode.
-	Updated the completions that are retrieved to include more stuff.
-
-1998-07-15  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	When overriding defcustom things, make sure the various symbols do not
-	exist.
-	Fixed tag for setting the frame parameters.
-	Added various pc checks when setting up frames related to pointers.
-	Added new RCS valid pattern
-	Fixed the "root" pattern for finding a: on the pc.
-
-1998-06-20  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: XEmacs fixes, removal of history to ChangeLog
-
-1998-06-16  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Small fix for PC dir path.
-
-1998-06-14  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Version number
-
-1998-06-13  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-w3.el: Fixed keymap copy/paste error
-
-	* sb-w3.el: Version number
-
-	* rpm.el: Upgraded to use the new keymap stuff
-
-	* sb-gud.el: Added : to symbol names for c++ GDB
-
-	* sb-info.el: Added new type of menu item that is findable to fix bugs
-
-	* sb-rmail.el: Made the REGEX for finding folders configurable
-
-1998-06-12  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added a `speedbar-item-object-delete' to delete associated object
-	files.  This function will reset scanners.  The byte-compile item will
-	also reset the scanners.
-
-1998-06-11  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Made speedbar-stealthy-function-list have name tags to match those
-	found in speedbar-initial-expansion-mode-alist.  Thus, the buffers
-	menu won't get tagged by the file functions.
-
-1998-06-09  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Many checkdoc changes from new tests.
-	Track mouse is once again buffer local.
-	Added kill/revert buffer keys to buffer speedbar display.
-
-1998-05-17  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-w3.el: Added new keymap support.
-
-	* sb-rmail.el: Fixed doc.
-
-	* sb-rmail.el: Changed to handle new keymap feature
-
-	* sb-info.el: Changed to handle new keymap feature.
-	Updated to have new loading construct that will port to info.el
-	easier.
-
-	* sb-gud.el: Changed to handle keymap feature.
-
-	* speedbar.el: A bunch of XEmacs fixes.
-
-1998-05-16  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added mega-commentary on speedbar special modes
-
-	* speedbar.el: Fixed the set for track-mouse
-
-	* speedbar.el:
-	Added a generic info finder function so it should work ok for all
-	modes.
-
-1998-05-15  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-info.el: Whatever.
-
-	* speedbar.el, sb-info.el: Fixed compile bug.
-
-	* speedbar.el: Enabled mouse tracking for Emacs.
-	Fixed info to always print something, even if it's just the text under
-	the mouse.
-	Wrote a mouse motion handler that calls the speedbar info function.
-
-1998-05-13  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Completely revamped the speedbar keymap.  Each display mode can now
-	define their own keymap (inheriting from the default speedbar keymap
-	with a special function).  This turns off silly file specific keys in
-	non file modes.
-	Also, added some fixes from Bob Weiner.  Including
-	temp-buffer-show-function fix, tripple spell check, EFS support,
-	and infodoc support.
-
-1998-05-09  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Version
-
-	* speedbar.el:
-	Fixed bug where clicking on a dir name that was shown in an expanded
-	sub-directory caused an error. (caused by the smart-expand stuff)
-
-	* sb-info.el:
-	Completely re-wrote the display engine to support expandable nodes in a tree
-	hierarchy.  Turned that into a major mode.
-
-1998-05-07  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-info.el: Added an info major mode for speedbar.
-
-1998-05-06  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added html as a supported extension.
-
-	* speedbar.el: Version update.
-
-	* sb-w3.el: Added T.V.Raman's w3 stuff.
-
-1998-05-05  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Duh
-
-	* rpm.el: Made buffer read only.
-
-	* speedbar.el:
-	Added keymap to the list of things in a default expansion list.
-
-	* rpm.el: New file.
-
-1998-05-04  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	`speedbar-add-supported-extension' and `speedbar-add-ignored-path-regexp'
-	are now interactive
-
-1998-04-16  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	The path finder and speedbar tagging functions are now compatible with
-	arbitrary speedbar displays.  You can now tag-exand from the buffer
-	display.
-
-	* speedbar.el: Ok, really fixed the XEmacs 19.16 problem.  Phew..
-
-	* speedbar.el: Fixed compile problem, and some checkdoc fixes.
-
-1998-04-15  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Custom workaround for XEmacs changes.
-
-	* speedbar.el: Added a buffer dynamic as an optional display.
-	Added a menu item for all available speedbar displays.
-	Added python.
-	Added regrouping while splitting into groups to represent ranges of
-	symbols.
-	Updated comments.
-
-1998-03-18  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed up custom for tag-hierarchy-method
-
-	* speedbar.el: Junk tags are now appended after grouped tags.
-	Word trimming is not done to lists of length 1.
-
-	* speedbar.el:
-	Made the initial expansion list be a group of expansion "modes",
-	and the current mode is defined in a string for normal buffers.
-	Special modes are still special.
-	Added special tag list mutating code.  Only takes effect if the lists
-	are really long.
-
-1998-03-12  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed irritating bug in my regex from the fortran change.
-
-	* speedbar.el: Added case-fold-search stuff
-
-	* speedbar.el: Added fortran support.
-
-1998-03-10  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added override function for `switch-to-buffer' in speedbar.
-	Added `speedbar-directory-unshown-regexp' which will hide VC
-	  directories from the main list.
-	Added `speedbar-[forward|backward]-list' and bound them to
-	  C-M-[f|p].  This lets you quickly navigate over the directory
-	  list to the file list, and vice-versa.
-
-	* speedbar.el: Added Perl5 support (.pm)
-
-1998-03-09  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added hide-button-brackets-flag and fixed current file positioning
-	bug.
-
-1998-03-06  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed menu problem left over from the merger with speedbspec
-
-	* speedbar.el:
-	Fixed problem where the current file wasn't always highlighted, and fixed
-	problems with smart expander, and the cache stuff.  They were failing
-	searches because the indicator regex was not optional.
-
-	* speedbar.el:
-	Merged speedbspec in.  This simplifies the whole management of
-	speedbar extensions for special modes greatly.
-
-	* sb-w3.el, sb-info.el, sb-rmail.el: Added comment about the autoload
-
-	* sb-gud.el: Removed dependency on speedbspec
-	Added comment about the autoload
-
-	* sb-rmail.el, sb-info.el, sb-w3.el: Removed dependency on speedbspec
-
-	* speedbar.el: speedbar-update-flag defaults to off on terminals.
-	The update function is called w/ update flag on by speedbar-get-focus
-	when the update flag is off.
-
-	* speedbar.el: Enabled object tagging in depths > 0
-
-1998-03-05  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	It is now possible to update states of indicators and they correctly
-	remove themselves from the list of indicators.
-
-	* speedbar.el:
-	Will now work in a non-windowing environment (a terminal)
-	Added new restricted navigation functions (only jumps between items at
-	the same level.
-
-	* speedbar.el:
-	Updated indicator methods to provide multiple types of indicators.
-	Then added a new indicator to pring a # by each file that has an
-	associated binary file in that directory with it.  I'd like to also
-	indicate when a given object goes out of date, but that is a change
-	for later.
-
-1998-01-07  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el, sb-rmail.el, sb-info.el, sb-gud.el: Part of emacs
-
-	* speedbar.el: Moved speedbar-get-focus, and added autoload tag.
-
-1997-12-23  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: fixed button-3 menu for emacs 20.
-
-1997-12-14  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Simple documentation changes. XEmacs double click stuff.
-
-1997-12-12  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed up lots of XEmacs specific stuff surrounding frames.
-	Removed emacs menubar.  Added menu to button 3.
-	Now use repeating timer instead of restarting it myself.
-
-1997-11-21  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Few last hacks to make it work in XEmacs, and a checkdoc pass.
-
-	* speedbar.el:
-	Added some comments, and merged a patch from Hrvoje Niksic for XEmacs
-	fixes
-
-1997-11-12  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added comments.
-
-	* speedbar.el: Fixed so that there can be no ignored paths
-	Added .l & .lsp as lisp, suggested by: sshteingold@cctrading.com
-	You can now adjust height in `speedbar-frame-parameters'
-	XEmacs fix for use of `local-variable-p'
-
-1997-11-05  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed more problems for Emacs 20 so speedbar loads correctly.
-	Updated some documentation strings.
-	Added customization menu item, and customized some more variables.
-
-1997-11-03  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed bad problem w/ ignored paths
-	Removed condition-case from main timer fcn
-	Changed speedbar-edit-line so that if we are not on a file-line, we
-	"edit" the item the cursor is on.  This is more intuitive.
-
-	* sb-gud.el: Checkdoc passed
-
-	* sb-gud.el: New file.
-
-1997-11-01  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* sb-rmail.el, sb-info.el, sb-w3.el: New file.
-
-1997-10-10  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added custom support.  We loose the great face generator for older emacsen
-	though.  Still need to figure this one out without making speedbar too big.
-	Added double-click mouse-1 to do the same thing as middle click.
-	XEmacs pointershape cutout
-
-1997-09-12  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Emacs 20 char= support
-
-1997-08-15  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed problem when going going to a file in an open subdirectory
-	by using the text-cache.  The default directory was the subdirectlry,
-	resulting in bad file name extraction.
-
-	* speedbar.el:
-	Added -visiting- hooks for when a tag or file is visited.
-	Added a hook called just before the speedbar frame is "popped up"
-	Fixed if statement around imenu use to bebased on imenu, not xemacs.
-	Added extra levels of finding in etags/TeX
-
-1997-08-02  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added speedbar-smart-directory-expand-flag which lets the user control
-	if directories are intelligently added to an existing list or not.
-
-	* speedbar.el: Fixed ange-ftp require compile time problem.
-	Fixed XEmacs menu bar bug.
-	Added `speedbar-activity-change-focus-flag' to control if the focus changes
-	  w/ mouse events.
-	Added `speedbar-sort-tags' toggle to the menubar.
-
-1997-06-27  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: xemacs feature around ange-ftp
-
-1997-06-14  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added advice from ptype:
-	  post-command-idle-hook for old emacsen
-	  speedbar-sort-tags now sorts imenu listings
-	added hooks for VC types and scanner resetting
-	added revert hook to reset scanners which might affect VC displays
-
-1997-06-06  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Renamed speedbar-do-updates to speedbar-update-flag and fixed checkdoc stuff
-
-1997-06-04  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed a couple doc-strings
-
-1997-06-03  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added select-frame during quit.
-	Spell-checked all the doc-strings.
-
-1997-05-29  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added java to etags supported extensions
-
-1997-05-26  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added a few doc changes based on new checkdoc checks
-
-1997-05-14  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed use of easymenu w/ toggles
-
-	* speedbar.el: Added some comments.  Made menu creation more flexible.
-
-1997-05-01  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Made item info and edit more robust
-
-1997-04-29  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added new mode-specific contents control and convenience functions
-
-1997-04-26  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added todo item, and fixed more documentation strings
-
-1997-04-04  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Version update
-
-	* speedbar.el: checkdoc autofixes.
-	byte compiler warnings
-
-1997-04-01  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: fixed comments based on checkdoc.
-
-1997-03-30  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Updated all doc strings to conform to standards.  Checked with checkdoc.
-
-1997-03-27  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Gobs of doc-string fixes based on checkdoc.
-
-1997-03-20  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed for people who run MBFs (Minibuffer frames) where
-	default-minibuffer-frame was being set incorrectly.
-
-1997-03-19  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Comment & code management (Moving things around)
-
-	* speedbar.el: XEmacs bugfixes & new window title.
-
-1997-03-03  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Made one small xemacs change dealing with eval-when-compile.
-
-1997-03-01  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Updated comments & doc.  Added power-click to the file list generator.
-
-	* speedbar.el:
-	New fn `speedbar-find-file-in-frame' which will put clicked file in
-	attached frame or pop up an existing frame that has that file in it.
-	Using new `speedbar-power-click' the file will always be poped up in a
-	new frame.  When opening tags, the power click will force imenu to
-	rescan.
-
-	* speedbar.el: Fixed bad bugs in `speedbar-add-*-regexp' causing hangs.
-
-	* speedbar.el:
-	Quitting does not delete speedbar buffer.  Buffer name starts with a space.
-	Moved some stuff around.
-
-1997-02-27  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Removed leftover messages
-
-1997-02-26  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: List of directories never to enter now allowed.
-	Fixed cursor not moving to line with selected file bug.
-
-1997-02-12  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed text-cache.  It is now enable to handle switch-backs into open
-	subdirectories.   Added a new function to clear the current selected
-	file.
-
-1997-02-10  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Doc updates.  Stopped using wholenump (breaks xemacs)
-
-1997-02-08  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	New UP directory keybinding.  Rebound g to what was once r.  New doc
-	strings.  New focus following (frame raising stuff).  Fixed span and
-	trim on directory button for more diverse widths.  refresh now
-	refreshes all directories that were open before.  (Called when g is pressed)
-	Copy/rename/delete use new refresh, and position cursor in a good
-	spot.
-
-1997-02-07  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed line-number-mode check in mode-line creator
-	Fixed extention-list-to-regexp for when no non-extension files available
-
-	* speedbar.el: Fixed imenu load bug (only happened during compile)
-	Added XEmacs stuff, etag sorting fix, quit key
-	Modeline updates itself on timer
-	Frame is cached when closed to speed up re-creation
-	Speedbar window is marked dedicated (no splits or whatever)
-	Added bindings for n, p, SPC, DEL, and RET to be like dired
-	Fixed up speedbar-position-cursor-on-line to be more robust.
-	Added directory-button-trim-method for ways of trimming the directory button.
-
-1997-01-30  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Added smarts to byte-compile, and fixed background color guesser which
-	died on XEmacs.
-
-1997-01-25  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed the kill-buffer hook
-
-	* speedbar.el:
-	Added hook so if the user kills the speedbar buffer, the frame will be
-	removed.
-
-	* speedbar.el: Added new vc check function which can be overloaded
-	added `speedbar-line-file' to get file full path from the current line
-	Added gobs of new file manipulation routines for delete, copy, rename,
-	byte-compile, and load.  Also added new keystroke to get info about a
-	file in the speedbar buffer.
-
-1997-01-23  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed documentation strings to conform to standards
-	Added condition-case around the timer so it can reset itself.
-	Added save-match-data around the entire timer so that any calls from
-	within doesn't mutate any running applications.
-	Added Checks for ange-ftp directories to turn off the vc thingie.
-
-1997-01-19  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	The auto-refresher failed in info buffers in XEmacs.  Added smarts so
-	it would never fail in either emacsen.
-
-1997-01-18  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Fixed another vc error.  All places where update-current-file was once
-	called has been replaced with stealthy-updates
-
-	* speedbar.el:
-	Fixed vc stuff to work with the multi-layer stuff (Oops) and so that
-	it is easier to add new version control systems.
-
-	* speedbar.el:
-	Added `speedbar-stealthy-function-list' which is a list of visual
-	effects for the speedbar which we do not want to do every time.  (This
-	slows down editing.)  Updating the current file is not a member of
-	this list.  New function `speedbar-check-vc' is also a part of this
-	list.  This function marks with a `*' all files currently checked out
-	of RCS.  Other VC systems will follow in the future.
-
-	* speedbar.el: Fixed update bug when speedbar frame is selected.
-	Setup so temp buffers appear in the selected frame.
-	Setup so that if editing a file not in speedbar frame, speedbar will
-	refresh the cache (which is obviously out of date...)
-
-1997-01-08  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Added comment about AUC-TEX
-
-1997-01-04  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed compile trouble on XEmacs relating to imenu.
-	Tried to add special help in other frame but failed.
-
-	* speedbar.el:
-	Moved config dialog stuff to it's own file.  Fixed XEmacs frame
-	selecting bug.  Added list of extensions that speedbar can tag.  Fixed
-	list closing code.
-
-1996-10-30  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed up comment
-
-	* speedbar.el: Fixed a type in the color part
-
-	* speedbar.el:
-	Fixed some broken documentation, and improved other doc strings.
-	Added some mode hooks.  Fixed color selection improvements
-	Fixed speedbar-frame-mode so that no argument will toggle it's
-	existence.
-
-1996-10-26  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el:
-	Changed comments and doc strings, and several small bugs.
-
-1996-10-24  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Made major revisions listed under 0.3 in comments.
-
-1996-10-01  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Fixed some comments, and changed a color value.
-
-	* speedbar.el:
-	Fixed many bugs: x-pointer messing up new frames, speedbar-buffer
-	accidentally settings itself as default, taging problems.
-	Added new stuff: imenu use, directory stuff upgrade.
-	See docs in file.
-
-1996-09-27  Eric M. Ludlam  <eric@siege-engine.com>
-
-	* speedbar.el: Moved a definition
-
-	* speedbar.el: New file.
-
diff --git a/xemacs-packages/lisp/speedbar/_pkg.el b/xemacs-packages/lisp/speedbar/_pkg.el
deleted file mode 100644
index 76348ecd..00000000
--- a/xemacs-packages/lisp/speedbar/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'speedbar
-		 :version 1.28
-          :author-version "0.14beta4"
-		 :type 'regular)
diff --git a/xemacs-packages/lisp/speedbar/auto-autoloads.el b/xemacs-packages/lisp/speedbar/auto-autoloads.el
deleted file mode 100644
index 5cd4eb0c..00000000
--- a/xemacs-packages/lisp/speedbar/auto-autoloads.el
+++ /dev/null
@@ -1,74 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'speedbar-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "speedbar/_pkg.el")
-
-(package-provide 'speedbar :version 1.28 :author-version "0.14beta4" :type 'regular)
-
-;;;***
-
-;;;### (autoloads (rpm) "rpm" "speedbar/rpm.el")
-
-(autoload 'rpm "rpm" "\
-Red Hat Package Management in Emacs." t nil)
-
-;;;***
-
-;;;### (autoloads (gud-speedbar-buttons) "sb-gud" "speedbar/sb-gud.el")
-
-(autoload 'gud-speedbar-buttons "sb-gud" "\
-Create a speedbar display based on the current state of GUD.
-If the GUD BUFFER is not running a supported debugger, then turn
-off the specialized speedbar mode." nil nil)
-
-;;;***
-
-;;;### (autoloads (Info-speedbar-buttons Info-speedbar-browser) "sb-info" "speedbar/sb-info.el")
-
-(autoload 'Info-speedbar-browser "sb-info" "\
-Initialize speedbar to display an info node browser.
-This will add a speedbar major display mode." t nil)
-
-(autoload 'Info-speedbar-buttons "sb-info" "\
-Create a speedbar display to help navigation in an Info file.
-BUFFER is the buffer speedbar is requesting buttons for." nil nil)
-
-;;;***
-
-;;;### (autoloads (rmail-speedbar-buttons) "sb-rmail" "speedbar/sb-rmail.el")
-
-(autoload 'rmail-speedbar-buttons "sb-rmail" "\
-Create buttons for BUFFER containing rmail messages.
-Click on the address under Reply to: to reply to this person.
-Under Folders: Click a name to read it, or on the <M> to move the
-current message into that RMAIL folder." nil nil)
-
-;;;***
-
-;;;### (autoloads (w3-speedbar-buttons) "sb-w3" "speedbar/sb-w3.el")
-
-(autoload 'w3-speedbar-buttons "sb-w3" "\
-Create speedbar buttons for the current web BUFFER displayed in w3 mode." nil nil)
-
-;;;***
-
-;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar" "speedbar/speedbar.el")
-
-(defalias 'speedbar 'speedbar-frame-mode)
-
-(autoload 'speedbar-frame-mode "speedbar" "\
-Enable or disable speedbar.  Positive ARG means turn on, negative turn off.
-nil means toggle.  Once the speedbar frame is activated, a buffer in
-`speedbar-mode' will be displayed.  Currently, only one speedbar is
-supported at a time.
-`speedbar-before-popup-hook' is called before popping up the speedbar frame.
-`speedbar-before-delete-hook' is called before the frame is deleted." t nil)
-
-(autoload 'speedbar-get-focus "speedbar" "\
-Change frame focus to or from the speedbar frame.
-If the selected frame is not speedbar, then speedbar frame is
-selected.  If the speedbar frame is active, then select the attached frame." t nil)
-
-;;;***
-
-(provide 'speedbar-autoloads)
diff --git a/xemacs-packages/lisp/speedbar/bigclock.el b/xemacs-packages/lisp/speedbar/bigclock.el
deleted file mode 100644
index 9c144521..00000000
--- a/xemacs-packages/lisp/speedbar/bigclock.el
+++ /dev/null
@@ -1,164 +0,0 @@
-;;; bigclock --- A great big clock
-
-;;; Copyright (C) 2000 Free Software Foundation
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Keywords: amusement
-;; X-RCS: $Id: bigclock.el,v 1.3 2000/09/05 01:05:01 zappo Exp $
-
-;; 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:
-;;
-;; Display a big clock in a special frame.
-
-(require 'dframe)
-
-;;; Code:
-(defgroup bigclock nil
-  "Faces used in dframe."
-  :prefix "bigclock-"
-  :group 'bigclock)
-
-(defcustom bigclock-frame-parameters
-  '((minibuffer . nil)
-    (width . 9)
-    (height . 2)
-    (border-width . 0)
-    (menu-bar-lines . 0)
-    (unsplittable . t)
-    (font . "-*-courier-medium-r-normal-*-*-320-*-*-m-*-iso8859-1"))
-  "Frame parameters for the big clock."
-  :group 'bigclock
-  :type '(repeat (sexp :tag "Parameter:")))
-
-(defcustom bigclock-update-flag dframe-have-timer-flag
-  "Non-nil means the clock will be able to update."
-  :group 'bigclock
-  :type 'boolean)
-
-(defvar bigclock-key-map
-  (let ((km (make-sparse-keymap)))
-    (dframe-update-keymap km)
-    km)
-  "Keymap used in the big clock.")
-  
-(defvar bigclock-buffer nil
-  "Bigclocks buffer.")
-
-(defvar bigclock-frame nil
-  "Bigclock's frame.")
-
-(defvar bigclock-cached-frame nil
-  "Bigclock's cached frame.")
-
-(defcustom bigclock-before-delete-hook nil
-  "Hooks called before bigclock is deleted."
-  :group 'bigclock
-  :type 'hook)
-
-(defcustom bigclock-before-popup-hook nil
-  "Hooks called before poping up the bigclock frame."
-  :group 'bigclock
-  :type 'hook)
-
-(defcustom bigclock-after-create-hook nil
-  "Hooks called after creating the bigclock frame."
-  :group 'bigclock
-  :type 'hook)
-
-(defcustom bigclock-mode-hook nil
-  "Hook run when a bigclock buffer is created."
-  :group 'bigclock
-  :type 'hook)
-
-(defalias 'bigclock 'bigclock-frame-mode)
-(defun bigclock-frame-mode (&optional arg)
-  "Enable or disable bigclock.
-Optional argument ARG enables or disables the bigclock frame."
-  (interactive "P")
-  ;; Get the buffer to play with
-  (if (not (buffer-live-p bigclock-buffer))
-      (save-excursion
-	(setq bigclock-buffer (get-buffer-create " BIGCLOCK"))
-	(set-buffer bigclock-buffer)
-	(bigclock-mode)))
-  ;; Do the frame thing
-  (dframe-frame-mode arg
-		     'bigclock-frame
-		     'bigclock-cached-frame
-		     'bigclock-buffer
-		     "Bigclock"
-		     #'bigclock-frame-mode
-		     (if dframe-xemacsp
-			 bigclock-frame-plist
-		       bigclock-frame-parameters)
-		     bigclock-before-delete-hook
-		     bigclock-before-popup-hook
-		     bigclock-after-create-hook)
-  ;; Start up the timer
-  (if (not bigclock-frame)
-      (dframe-set-timer nil #'bigclock-timer-fn 'bigclock-update-flag)
-    (dframe-set-timer 60 #'bigclock-timer-fn 'bigclock-update-flag)
-    ))
-
-(defun bigclock-get-focus ()
-  "Change frame focus to or from the bigclock frame.
-If the selected frame is not bigclock, then bigclock frame is
-selected.  If the bigclock frame is active, then select the attached frame."
-  (interactive)
-  (dframe-get-focus 'bigclock-frame 'bigclock-frame-mode))
-
-(defun bigclock-mode ()
-  "Set the current buffer to be in BIGCLOCK mode.
-\\{bigclock-key-map}"
-  ;; NOT interactive
-  (save-excursion
-    (kill-all-local-variables)
-    (setq major-mode 'bigclock-mode)
-    (setq mode-name "BigClock")
-    (setq font-lock-keywords nil) ;; no font-locking please
-    (setq truncate-lines t)
-    (use-local-map bigclock-key-map)
-    (make-local-variable 'frame-title-format)
-    (setq frame-title-format "Bigclock "))
-    (toggle-read-only 1)
-    (setq mode-line-format "")
-    ;; Add in our dframe hooks.
-    (setq dframe-track-mouse-function nil
-	  dframe-help-echo-function nil
-	  dframe-mouse-click-function nil
-	  dframe-mouse-position-function nil)
-    ;;no auto-show for Emacs
-    (run-hooks 'bigclock-mode-hook))
-
-(defun bigclock-timer-fn ()
-  "Run whenever Emacs is idle to update bigclock."
-  (if (or (not bigclock-frame)
-	  (not (frame-live-p bigclock-frame)))
-      (dframe-set-timer nil 'bigclock-timer-fn 'bigclock-update-flag)
-    (save-excursion
-      (set-buffer bigclock-buffer)
-      (toggle-read-only -1)
-      (erase-buffer)
-      (insert (format-time-string "%2I:%M %p" (current-time))))))
-
-
-(provide 'bigclock)
-
-;;; bigclock.el ends here
diff --git a/xemacs-packages/lisp/speedbar/custom-load.el b/xemacs-packages/lisp/speedbar/custom-load.el
deleted file mode 100644
index 0af20248..00000000
--- a/xemacs-packages/lisp/speedbar/custom-load.el
+++ /dev/null
@@ -1,15 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'dframe '("dframe"))
-(custom-add-loads 'speedbar '("sb-image" "speedbar"))
-(custom-add-loads 'tags '("speedbar"))
-(custom-add-loads 'faces '("speedbar"))
-(custom-add-loads 'speedbar-faces '("speedbar"))
-(custom-add-loads 'bigclock '("bigclock"))
-(custom-add-loads 'speedbar-vc '("speedbar"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/speedbar/dframe.el b/xemacs-packages/lisp/speedbar/dframe.el
deleted file mode 100644
index 61ea7e4e..00000000
--- a/xemacs-packages/lisp/speedbar/dframe.el
+++ /dev/null
@@ -1,1026 +0,0 @@
-;;; dframe --- dedicate frame support modes
-
-;;; Copyright (C) 1996, 97, 98, 99, 2000, 01 Free Software Foundation
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Keywords: file, tags, tools
-;; X-RCS: $Id: dframe.el,v 1.3 2002/08/09 22:08:27 youngs Exp $
-
-(defvar dframe-version "1.2"
-  "The current version of the dedicated frame library.")
-
-;; 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:
-;;
-;; This code was developed and maintained as a part of speedbar since 1996.
-;; It became its own support utility in Aug 2000.
-;;
-;; Dedicated frame mode is an Emacs independent library for supporting
-;; a program/buffer combination that resides in a dedicated frame.
-;; Support of this nature requires several complex interactions with the
-;; user which this library will provide, including:
-;;
-;; * Creation of a frame.  Positioned relatively.
-;;   Includes a frame cache for User position caching.
-;; * Switching between frames.
-;; * Timed activities using idle-timers
-;; * Frame/buffer killing hooks
-;; * Mouse-3 position relative menu
-;; * Mouse motion, help-echo hacks
-;; * Mouse clicking, double clicking, & Xemacs image clicking hack
-;; * Mode line hacking
-;; * Utilities for use in a program covering:
-;;    o keymap massage for some actions
-;;    o working with an associated buffer
-;;    o shift-click
-;;    o detaching a frame
-;;    o focus-shifting & optional frame jumping
-;;    o currently active frame.
-;;    o message/y-or-n-p
-;;    o mouse set point
-;;
-;; To Use:
-;; 1) (require 'dframe)
-;; 2) Variable Setup:
-;;   -frame-parameters -- Frame parameters for Emacs.
-;;   -frame-plist -- Frame parameters for XEmacs.
-;;   -- Not on parameter lists: They can optionally include width
-;;      and height.  If width or height is not included, then it will
-;;      be provided to match the originating frame.  In general,
-;;      turning off the menu bar, mode line, and minibuffer can
-;;      provide a smaller window, or more display area.
-;;   -track-mouse-flag -- mouse tracking on/off specific to your tool.
-;;   -update-flag -- app toggle for timer use.  Init from
-;;     `dframe-have-timer-flag'.  This is nil for terminals, since
-;;     updating a frame in a terminal is not useful to the user.
-;;   -key-map -- Your keymap.  Call `dframe-update-keymap' on it.
-;;   -buffer, -frame, -cached-frame -- Variables used to track your
-;;     applications buffer, frame, or frame cache (when hidden).  See
-;;     `dframe-frame-mode' for details.
-;;   -before-delete-hook, -before-popup-hook, -after-create-hook --
-;;     Hooks to have called.  The `-after-create-hook' probably wants
-;;     to call a function which calls `dframe-reposition-frame' in an
-;;     appropriate manner.
-;; 3) Function Setup:
-;;   your-frame-mode -- function to toggle your app frame on and off.
-;;     its tasks are:
-;;       a) create a buffer
-;;       b) Call `dframe-frame-mode'.  (See its doc)
-;;       c) If successful (your -frame variable has a value), call
-;;          timer setup if applicable.
-;;   your-frame-reposition- -- Function to call from after-create-hook to
-;;     reposition your frame with `dframe-repsoition-frame'.
-;;   your-mode -- Set up the major mode of the buffer for your app.
-;;     Set these variables: dframe-track-mouse-function,
-;;                          dframe-help-echo-function,
-;;                          dframe-mouse-click-function,
-;;                          dframe-mouse-position-function.
-;;   See speedbar's implementation of these functions.
-;;    `speedbar-current-frame', `speedbar-get-focus', `speedbar-message',
-;;    `speedbar-y-or-n-p', `speedbar-set-timer', `speedbar-click',
-;;    `speedbar-position-cursor-on-line'
-;; 4) Handling mouse clicks, and help text:
-;;   dframe-track-mouse, dframe-help-echo-function --
-;;    These variables need to be set to functions that display info
-;;    based on the mouse's position.
-;;   Text propert 'help-echo, set to `dframe-help-echo', which will
-;;    call `dframe-help-echo-function'.
-;;   Have a `-click' function, it can call `dframe-quick-mouse' for
-;;    positioning.  If the variable `dframe-power-click' is non-nil,
-;;    then `shift' was held down during the click.
-
-;;; Bugs
-;;
-;;  * The timer managers doesn't handle multiple different timeouts.
-;;  * You can't specify continuous timouts (as opposed to just lidle timers.)
-
-;;; Code:
-(defvar dframe-xemacsp (string-match "XEmacs" emacs-version)
-  "Non-nil if we are running in the XEmacs environment.")
-(defvar dframe-xemacs20p (and dframe-xemacsp
-			      (>= emacs-major-version 20)))
-
-;; From custom web page for compatibility between versions of custom
-;; with help from ptype@dera.gov.uk (Proto Type)
-(eval-and-compile
-  (condition-case ()
-      (require 'custom)
-    (error nil))
-  (if (and (featurep 'custom) (fboundp 'custom-declare-variable)
-	   ;; Some XEmacsen w/ custom don't have :set keyword.
-	   ;; This protects them against custom.
-	   (fboundp 'custom-initialize-set))
-      nil ;; We've got what we needed
-    ;; We have the old custom-library, hack around it!
-    (if (boundp 'defgroup)
-	nil
-      (defmacro defgroup (&rest args)
-	nil))
-    (if (boundp 'defface)
-	nil
-      (defmacro defface (var values doc &rest args)
-	(` (progn
-	     (defvar (, var) (quote (, var)))
-	     ;; To make colors for your faces you need to set your .Xdefaults
-	     ;; or set them up ahead of time in your .emacs file.
-	     (make-face (, var))
-	     ))))
-    (if (boundp 'defcustom)
-	nil
-      (defmacro defcustom (var value doc &rest args)
-	(` (defvar (, var) (, value) (, doc)))))))
-
-
-;;; Compatibility functions
-;;
-(if (fboundp 'frame-parameter)
-
-    (defalias 'dframe-frame-parameter 'frame-parameter)
-  
-  (defun dframe-frame-parameter (frame parameter)
-    "Return FRAME's PARAMETER value."
-    (cdr (assoc parameter (frame-parameters frame)))))
-
-
-;;; Variables
-;;
-(defgroup dframe nil
-  "Faces used in dframe."
-  :prefix "dframe-"
-  :group 'dframe)
-
-(defvar dframe-have-timer-flag
-  (and (or (fboundp 'run-with-idle-timer)
-	   (fboundp 'start-itimer)
-	   (boundp 'post-command-idle-hook))
-       (if (fboundp 'display-graphic-p)
-	   (display-graphic-p)
-	 window-system))
-  "Non-nil means that timers are available for this Emacs.")
-
-(defcustom dframe-update-speed
-  (if dframe-xemacsp
-      (if dframe-xemacs20p
-	  2				; 1 is too obrusive in XEmacs
-	5)				; when no idleness, need long delay
-    1)
-  "*Idle time in seconds needed before dframe will update itself.
-Updates occur to allow dframe to display directory information
-relevant to the buffer you are currently editing."
-  :group 'dframe
-  :type 'integer)
-
-(defcustom dframe-activity-change-focus-flag nil
-  "*Non-nil means the selected frame will change based on activity.
-Thus, if a file is selected for edit, the buffer will appear in the
-selected frame and the focus will change to that frame."
-  :group 'dframe
-  :type 'boolean)
-
-(defvar dframe-track-mouse-function nil
-  "*A function to call when the mouse is moved in the given frame.
-Typically used to display info about the line under the mouse.")
-(make-variable-buffer-local 'dframe-track-mouse-function)
-
-(defvar dframe-help-echo-function nil
-  "*A function to call when help-echo is used in newer versions of Emacs.
-Typically used to display info about the line under the mouse.")
-(make-variable-buffer-local 'dframe-help-echo-function)
-
-(defvar dframe-mouse-click-function nil
-  "*A function to call when the mouse is clicked.
-Valid clicks are mouse 2, our double mouse 1.")
-(make-variable-buffer-local 'dframe-mouse-click-function)
-
-(defvar dframe-mouse-position-function nil
-  "*A function to called to position the cursor for a mouse click.")
-(make-variable-buffer-local 'dframe-mouse-position-function)
-
-(defvar dframe-power-click nil
-  "Never set this by hand.  Value is t when S-mouse activity occurs.")
-
-(defvar dframe-timer nil
-  "The dframe timer used for updating the buffer.")
-
-(defvar dframe-attached-frame nil
-  "The frame which started a frame mode.
-This is the frame from which all interesting activities will go
-for the mode using dframe.")
-
-(defvar dframe-controlled nil
-  "Is this buffer controlled by a dedicated frame.
-Local to those buffers, as a function called that created it.")
-(make-variable-buffer-local 'dframe-controlled)
-
-(defun dframe-update-keymap (map)
-  "Update the keymap MAP for dframe default bindings."
-  ;; Frame control
-  (define-key map "q" 'dframe-close-frame)
-  (define-key map "Q" 'delete-frame)
-
-  ;; Override switch to buffer to never hack our frame.
-  (substitute-key-definition 'switch-to-buffer
-			     'dframe-switch-buffer-attached-frame
-			     map global-map)
-
-  (if dframe-xemacsp
-      (progn
-	;; mouse bindings so we can manipulate the items on each line
-	(define-key map 'button2 'dframe-click)
-	(define-key map '(shift button2) 'dframe-power-click)
-	;; Info doc fix from Bob Weiner
-	(if (featurep 'infodoc)
-	    nil
-	  (define-key map 'button3 'dframe-xemacs-popup-kludge))
-	)
-
-    ;; mouse bindings so we can manipulate the items on each line
-    (define-key map [down-mouse-1] 'dframe-double-click)
-    (define-key map [mouse-2] 'dframe-click)
-    ;; This is the power click for new frames, or refreshing a cache
-    (define-key map [S-mouse-2] 'dframe-power-click)
-    ;; This adds a small unecessary visual effect
-    ;;(define-key map [down-mouse-2] 'dframe-quick-mouse)
-
-    (define-key map [down-mouse-3] 'dframe-emacs-popup-kludge)
-
-    ;; This lets the user scroll as if we had a scrollbar... well maybe not
-    (define-key map [mode-line mouse-2] 'dframe-mouse-hscroll)
-    ;; another handy place users might click to get our menu.
-    (define-key map [mode-line down-mouse-1]
-      'dframe-emacs-popup-kludge)
-
-    ;; We can't switch buffers with the buffer mouse menu.  Lets hack it.
-    (define-key map [C-down-mouse-1] 'dframe-hack-buffer-menu)
-
-    ;; Lastly, we want to track the mouse.  Play here
-    (define-key map [mouse-movement] 'dframe-track-mouse)
-    ))
-
-(defun dframe-live-p (frame)
-  "Return non-nil if FRAME is currently available."
-  (and frame (frame-live-p frame) (frame-visible-p frame)))
-
-(defun dframe-frame-mode (arg frame-var cache-var buffer-var frame-name
-			      local-mode-fn
-			      &optional
-			      parameters
-			      delete-hook popup-hook create-hook
-			      )
-  "Manage a frame for an application, enabling it when ARG is positive.
-FRAME-VAR is a variable used to cache the frame being used.
-This frame is either resurrected, hidden, killed, etc based on
-the value.
-CACHE-VAR is a variable used to cache a cached frame.
-BUFFER-VAR is a variable used to cache the buffer being used in dframe.
-This buffer will have `dframe-mode' run on it.
-FRAME-NAME is the name of the frame to create.
-LOCAL-MODE-FN is the function used to call this one.
-PARAMETERS are frame parameters to apply to this dframe.
-DELETE-HOOK are hooks to run when deleting a frame.
-POPUP-HOOK are hooks to run before showing a frame.
-CREATE-HOOK are hooks to run after creating a frame."
-  ;; toggle frame on and off.
-  (if (not arg) (if (dframe-live-p (symbol-value frame-var))
-		    (setq arg -1) (setq arg 1)))
-  ;; Make sure the current buffer is set.
-  (set-buffer (symbol-value buffer-var))
-  ;; turn the frame off on neg number
-  (if (and (numberp arg) (< arg 0))
-      (progn
-	(run-hooks 'delete-hook)
-	(if (and (symbol-value frame-var)
-		 (frame-live-p (symbol-value frame-var)))
-	    (progn
-	      (set cache-var (symbol-value frame-var))
-	      (make-frame-invisible (symbol-value frame-var))))
-	(set frame-var nil)
-	(make-variable-buffer-local 'dframe-timer)
-	)
-    ;; Set this as our currently attached frame
-    (make-variable-buffer-local 'dframe-attached-frame)
-    (setq dframe-attached-frame (selected-frame))
-    (run-hooks 'popup-hook)
-    ;; Updated the buffer passed in to contain all the hacks needed
-    ;; to make it work well in a dedicated window.
-    (save-excursion
-      (set-buffer (symbol-value buffer-var))
-      ;; Declare this buffer a dedicated frame
-      (setq dframe-controlled local-mode-fn)
-
-      (if dframe-xemacsp
-	  ;; Hack the XEmacs mouse-motion handler
-	  (set (make-local-variable 'mouse-motion-handler)
-	       'dframe-track-mouse-xemacs)
-	;; Enable mouse tracking in emacs
-	(if dframe-track-mouse-function
-	    (set (make-local-variable 'track-mouse) t))	;this could be messy.
-	;; disable auto-show-mode for Emacs
-	(setq auto-show-mode nil))
-;;;; DISABLED: This causes problems for users with multiple frames.
-;;;;       ;; Set this up special just for the passed in buffer
-;;;;       ;; Terminal minibuffer stuff does not require this.
-;;;;       (if (and (or (assoc 'minibuffer parameters)
-;;;; 		   ;; XEmacs plist is not an association list
-;;;; 		   (member 'minibuffer parameters))
-;;;; 	       window-system (not (eq window-system 'pc))
-;;;; 	       (null default-minibuffer-frame))
-;;;; 	  (progn
-;;;; 	    (make-local-variable 'default-minibuffer-frame)
-;;;; 	    (setq default-minibuffer-frame dframe-attached-frame))
-;;;; 	)
-      ;; Override `temp-buffer-show-hook' so that help and such
-      ;; put their stuff into a frame other than our own.
-      ;; Correct use of `temp-buffer-show-function': Bob Weiner
-      (if (and (boundp 'temp-buffer-show-hook)
-	       (boundp 'temp-buffer-show-function))
-	  (progn (make-local-variable 'temp-buffer-show-hook)
-		 (setq temp-buffer-show-hook temp-buffer-show-function)))
-      (make-local-variable 'temp-buffer-show-function)
-      (setq temp-buffer-show-function 'dframe-temp-buffer-show-function)
-      ;; If this buffer is killed, we must make sure that we destroy
-      ;; the frame the dedicated window is in.
-      (make-local-hook 'kill-buffer-hook)
-      (add-hook 'kill-buffer-hook `(lambda ()
-				     (let ((skilling (boundp 'skilling)))
-				       (if skilling
-					   nil
-					 (if dframe-controlled
-					     (progn
-					       (funcall dframe-controlled -1)
-					       (setq ,buffer-var nil)
-					       )))))
-		t t)
-      )
-    ;; Get the frame to work in
-    (if (frame-live-p (symbol-value cache-var))
-	(progn
-	  (set frame-var (symbol-value cache-var))
-	  (make-frame-visible (symbol-value frame-var))
-	  (select-frame (symbol-value frame-var))
-	  (set-window-dedicated-p (selected-window) nil)
-	  (if (not (eq (current-buffer) (symbol-value buffer-var)))
-	      (switch-to-buffer (symbol-value buffer-var)))
-	  (set-window-dedicated-p (selected-window) t)
-	  (raise-frame (symbol-value frame-var))
-	  )
-      (if (frame-live-p (symbol-value frame-var))
-	  (raise-frame (symbol-value frame-var))
-	(set frame-var
-	      (if dframe-xemacsp
-		  ;; Only guess height if it is not specified.
-		  (if (member 'height parameters)
-		      (make-frame parameters)
-		    (make-frame (nconc (list 'height
-					     (dframe-needed-height))
-				       parameters)))
-		(let* ((mh (dframe-frame-parameter dframe-attached-frame
-						   'menu-bar-lines))
-		       (paramsa
-			;; Only add a guessed height if one is not specified
-			;; in the input parameters.
-			(if (assoc 'height parameters)
-			    parameters
-			  (append
-			   parameters
-			   (list (cons 'height (+ mh (frame-height)))))))
-		       (params
-			;; Only add a guessed width if one is not specified
-			;; in the input parameters.
-			(if (assoc 'width parameters)
-			    paramsa
-			  (append
-			   paramsa
-			   (list (cons 'width (frame-width))))))
-		       (frame
-			(if (or (< emacs-major-version 20)
-				(not (eq window-system 'x)))
-			    (make-frame params)
-			  (let ((x-pointer-shape x-pointer-top-left-arrow)
-				(x-sensitive-text-pointer-shape
-				 x-pointer-hand2))
-			    (make-frame params)))))
-		  frame)))
-	;; Put the buffer into the frame
-	(save-excursion
-	  (select-frame (symbol-value frame-var))
-	  (switch-to-buffer (symbol-value buffer-var))
-	  (set-window-dedicated-p (selected-window) t))
-	;; Run hooks (like reposition)
-	(run-hooks 'create-hook)
-	;; Frame name
-	(if (and (or (null window-system) (eq window-system 'pc))
-		 (fboundp 'set-frame-name))
-	    (save-window-excursion
-	      (select-frame (symbol-value frame-var))
-	      (set-frame-name frame-name)))
-	;; On a terminal, raise the frame or the user will
-	;; be confused.
-	(if (not window-system)
-	    (select-frame (symbol-value frame-var)))
-	))) )
-
-(defun dframe-reposition-frame (new-frame parent-frame location)
-  "Move NEW-FRAME to be relative to PARENT-FRAME.
-LOCATION can be one of 'random, 'left-right, or 'top-bottom."
-  (if dframe-xemacsp
-      (dframe-reposition-frame-xemacs new-frame parent-frame location)
-    (dframe-reposition-frame-emacs new-frame parent-frame location)))
-
-(defun dframe-reposition-frame-emacs (new-frame parent-frame location)
-  "Move NEW-FRAME to be relative to PARENT-FRAME.
-LOCATION can be one of 'random, 'left-right, 'top-bottom, or
-a cons cell indicationg a position of the form (LEFT . TOP)."
-  (let* ((pfx (dframe-frame-parameter parent-frame 'left))
-	 (pfy (dframe-frame-parameter parent-frame 'top))
-	 (pfw (frame-pixel-width parent-frame))
-	 (pfh (frame-pixel-height parent-frame))
-	 (nfw (frame-pixel-width new-frame))
-	 (nfh (frame-pixel-height new-frame))
-	 newleft newtop
-	 )
-    ;; Position dframe.
-    (if (or (not window-system) (eq window-system 'pc))
-	;; Do no positioning if not on a windowing system,
-	nil
-      ;; Rebuild pfx,pfy to be absolute positions.
-      (setq pfx (if (not (consp pfx))
-		    pfx
-		  ;; If pfx is a list, that means we grow
-		  ;; from a specific edge of the display.
-		  ;; Convert that to the distance from the
-		  ;; left side of the display.
-		  (if (eq (car pfx) '-)
-		      ;; A - means distance from the right edge
-		      ;; of the display, or DW - pfx - framewidth
-		      (- (x-display-pixel-width) (car (cdr pfx)) pfw)
-		    (car (cdr pfx))))
-	    pfy (if (not (consp pfy))
-		    pfy
-		  ;; If pfy is a list, that means we grow
-		  ;; from a specific edge of the display.
-		  ;; Convert that to the distance from the
-		  ;; left side of the display.
-		  (if (eq (car pfy) '-)
-		      ;; A - means distance from the right edge
-		      ;; of the display, or DW - pfx - framewidth
-		      (- (x-display-pixel-height) (car (cdr pfy)) pfh)
-		    (car (cdr pfy))))
-	    )
-      (cond ((eq location 'left-right)
-	     (setq newleft
-		   ;; Decide which side to put it on.  200 is just a
-		   ;; buffer for the left edge of the screen.  The
-		   ;; extra 10 is just dressings for window
-		   ;; decorations.
-		   (let* ((left-guess (- pfx 10 nfw))
-			  (right-guess (+ pfx pfw 5))
-			  (left-margin left-guess)
-			  (right-margin (- (x-display-pixel-width)
-					   right-guess 5 nfw)))
-		     (cond ((>= left-margin 0) left-guess)
-			   ((>= right-margin 0) right-guess)
-			   ;; otherwise choose side we overlap less
-			   ((> left-margin right-margin) 0)
-			   (t (- (x-display-pixel-width) nfw 5))))
-		   newtop pfy
-		   ))
-	    ((eq location 'top-bottom)
-	     (setq newleft pfx
-		   newtop
-		   ;; Try and guess if we should be on the top or bottom.
-		   (let* ((top-guess (- pfy 15 nfh))
-			  (bottom-guess (+ pfy 5 pfh))
-			  (top-margin top-guess)
-			  (bottom-margin (- (x-display-pixel-height)
-					    bottom-guess 5 nfh)))
-		     (cond ((>= top-margin 0) top-guess)
-			   ((>= bottom-margin 0) bottom-guess)
-			   ;; Choose a side to overlap the least.
-			   ((> left-margin right-margin) 0)
-			   (t (- (x-display-height) nfh 5)))))
-	     )
-	    ((consp location)
-	     (setq newleft (or (car location) 0)
-		   newtop (or (cdr location) 0)))
-	    (t nil))
-      (modify-frame-parameters new-frame
-       (list (cons 'left newleft)
-	     (cons 'top newtop))))))
-
-(defun dframe-reposition-frame-xemacs (new-frame parent-frame location)
-  "Move NEW-FRAME to be relative to PARENT-FRAME.
-LOCATION can be one of 'random, 'left-right, or 'top-bottom."
-  ;; Not yet implemented
-  )
-
-;; XEmacs function only.
-(defun dframe-needed-height (&optional frame)
-  "The needed height for the tool bar FRAME (in characters)."
-  (or frame (setq frame (selected-frame)))
-  ;; The 1 is the missing modeline/minibuffer
-  (+ 1 (/ (frame-pixel-height frame)
-	  (face-height 'default frame))))
-
-(defun dframe-detach (frame-var cache-var buffer-var)
-  "Detatch the frame in symbol FRAME-VAR.
-CACHE-VAR and BUFFER-VAR are symbols as in `dframe-frame-mode'"
-  (save-excursion
-    (set-buffer (symbol-value buffer-var))
-    (rename-buffer (buffer-name) t)
-    (let ((oldframe (symbol-value frame-var)))
-      (set buffer-var nil)
-      (set frame-var nil)
-      (set cache-var nil)
-      (make-variable-buffer-local frame-var)
-      (set frame-var oldframe)
-      )))
-
-;;; Special frame event proxies
-;;
-(if (boundp 'special-event-map)
-    (progn
-      (define-key special-event-map [make-frame-visible]
-	'dframe-handle-make-frame-visible)
-      (define-key special-event-map [iconify-frame]
-	'dframe-handle-iconify-frame)
-      (define-key special-event-map [delete-frame]
-	'dframe-handle-delete-frame))
-  )
-
-(defvar dframe-make-frame-visible-function nil
-  "Function used when a dframe controlled frame is de-iconified.
-The function must take an EVENT.")
-(defvar dframe-iconify-frame-function nil
-  "Function used when a dframe controlled frame is iconified.
-The function must take an EVENT.")
-(defvar dframe-delete-frame-function nil
-  "Function used when a frame attached to a dframe frame is deleted.
-The function must take an EVENT.")
-
-(defun dframe-handle-make-frame-visible (e)
-  "Handle a `make-frame-visible' event.
-Should enables auto-updating if the last state was also enabled.
-Argument E is the event making the frame visible."
-  (interactive "e")
-  (message "%S" e)
-  (let ((f last-event-frame))
-    (if (and (dframe-attached-frame f)
-	     dframe-make-frame-visible-function)
-	(funcall dframe-make-frame-visible-function e)
-      )))
-
-(defun dframe-handle-iconify-frame (e)
-  "Handle a `iconify-frame' event.
-Should disables auto-updating if the last state was also enabled.
-Argument E is the event iconifying the frame."
-  (interactive "e")
-  (message "%S" e)
-  (let ((f last-event-frame))
-    (if (and (dframe-attached-frame f)
-	     dframe-iconify-frame-function e)
-	(funcall dframe-iconify-frame-function)
-      )))
-
-(defun dframe-handle-delete-frame (e)
-  "Handle `delete-frame' event.
-Argument E is the event deleting the frame."
-  (interactive "e")
-  (message "%S" e)
-  (let ((fl (frame-list))
-	(sf (selected-frame)))
-    ;; Loop over all frames.  If dframe-delete-frame-function is
-    ;; non-nil, call it.
-    (while fl
-      (select-frame (car fl))
-      (if dframe-delete-frame-function
-	  (funcall dframe-delete-frame-function e))
-      (setq fl (cdr fl)))
-    (if (frame-live-p sf)
-	(select-frame sf))
-    (handle-delete-frame e)))
-
-
-;;; Utilities
-;;
-(defun dframe-get-focus (frame-var activator &optional hook)
-  "Change frame focus to or from a dedicated frame.
-If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR
-frame is selected.  If the FRAME-VAR is active, then select the
-attached frame.  If FRAME-VAR is nil, ACTIVATOR is called to
-created it.  HOOK is an optional argument of hooks to run when
-selecting FRAME."
-  (interactive)
-  (if (eq (selected-frame) (symbol-value frame-var))
-      (if (frame-live-p dframe-attached-frame)
-	  (select-frame dframe-attached-frame))
-    ;; make sure we have a frame
-    (if (not (frame-live-p (symbol-value frame-var)))
-	(funcall activator 1))
-    ;; go there
-    (select-frame (symbol-value frame-var))
-    )
-  (other-frame 0)
-  ;; If updates are off, then refresh the frame (they want it now...)
-  (run-hooks 'hook))
-
-
-(defun dframe-close-frame ()
-  "Close the current frame if it is dedicated."
-  (interactive)
-  (if dframe-controlled
-      (let ((b (current-buffer)))
-	(funcall dframe-controlled -1)
-	(kill-buffer b))))
-
-(defun dframe-current-frame (frame-var desired-major-mode)
-  "Return the existing dedicated frame to use.
-FRAME-VAR is the variable storing the currently active dedicated frame.
-If the current frame's buffer uses DESIRED-MAJOR-MODE, then use that frame."
-  (if (not (eq (selected-frame) (symbol-value frame-var)))
-      (if (and (eq major-mode 'desired-major-mode)
-	       (get-buffer-window (current-buffer))
-	       (window-frame (get-buffer-window (current-buffer))))
-	  (window-frame (get-buffer-window (current-buffer)))
-	(symbol-value frame-var))
-    (symbol-value frame-var)))
-
-(defun dframe-attached-frame (frame)
-  "Return the attached frame belonging to the dframe controlled frame FRAME."
-  (save-excursion
-    (if frame (select-frame frame))
-    dframe-attached-frame))
-
-(defun dframe-select-attached-frame (frame)
-  "Switch to the frame the dframe controled frame FRAME was started from."
-  (let ((frame (dframe-attached-frame frame)))
-    (if frame (select-frame frame) nil)))
-
-(defmacro dframe-with-attached-buffer (&rest forms)
-  "Execute FORMS in the attached frame's special buffer.
-Optionally select that frame if necessary."
-  `(save-selected-window
-     ;;(speedbar-set-timer speedbar-update-speed)
-     (select-frame dframe-attached-frame)
-     ,@forms
-     (dframe-maybee-jump-to-attached-frame)))
-
-(defun dframe-maybee-jump-to-attached-frame ()
-  "Jump to the attached frame ONLY if this was not a mouse event."
-  (if (or (not (dframe-mouse-event-p last-input-event))
-	  dframe-activity-change-focus-flag)
-      (progn
-	;(select-frame dframe-attached-frame)
-	(other-frame 0))))
-
-(defvar dframe-suppress-message-flag nil
-  "Non-nil means that `dframe-message' should just return a string.")
-
-(defun dframe-message (fmt &rest args)
-  "Like message, but for use in a dedicated frame.
-Argument FMT is the format string, and ARGS are the arguments for message."
-  (save-selected-window
-    (if dframe-suppress-message-flag
-	(apply 'format fmt args)
-      (if dframe-attached-frame
-	  (select-frame dframe-attached-frame))
-      (apply 'message fmt args))))
-
-(defun dframe-y-or-n-p (prompt)
-  "Like `y-or-n-p', but for use in a dedicated frame.
-Argument PROMPT is the prompt to use."
-  (save-selected-window
-    (if (and ;;default-minibuffer-frame
-	     dframe-attached-frame
-	     ;;(not (eq default-minibuffer-frame dframe-attached-frame))
-	     )
-	(select-frame dframe-attached-frame))
-    (y-or-n-p prompt)))
-
-;;; timer management
-;;
-;; Unlike speedbar with a dedicated set of routines, dframe has one master
-;; timer, and all dframe users will use it.  At least until I figure out a way
-;; around that problem.
-;;
-;; Advantage 1: Two apps with timer/frames can munge the master list
-;;              to make sure they occur in order.
-;; Advantage 2: If a user hits a key between timer functions, we can
-;;	        interrupt them safely.
-(defvar dframe-client-functions nil
-  "List of client functions using the dframe timer.")
-
-(defun dframe-set-timer (timeout fn &optional null-on-error)
-  "Apply a timer TIMEOUT, to call FN, or remove a timer if TIMOUT is nil.
-TIMEOUT is the number of seconds until the dframe controled program
-timer is called again.  When TIMEOUT is nil, turn off all timeouts.
-This function must be called from the buffer belonging to the program
-who requested the timer.
-If NULL-ON-ERROR is a symbol, set it to nil if we cannot create a timer."
-  ;; First, fix up our list of client functions
-  (if timeout
-      (add-to-list 'dframe-client-functions fn)
-    (setq dframe-client-functions (delete fn dframe-client-functions)))
-  ;; Now decided what to do about the timout.
-  (if (or
-       ;; We have a timer, restart the timer with the new time.
-       timeout
-       ;; We have a timer, an off is requested, and no client
-       ;; functions are left, shut er down.
-       (and dframe-timer (not timeout) dframe-client-functions))
-      ;; Only call the low level function if we are changing the state.
-      (dframe-set-timer-internal timeout null-on-error)))
-
-(defun dframe-set-timer-internal (timeout &optional null-on-error)
-  "Apply a timer with TIMEOUT to call the dframe timer manager.
-If NULL-ON-ERROR is a symbol, set it to nil if we cannot create a timer."
-  (cond
-   ;; XEmacs
-   (dframe-xemacsp
-    (if dframe-timer
-	(progn (delete-itimer dframe-timer)
-	       (setq dframe-timer nil)))
-    (if timeout
-	(if (and dframe-xemacsp
-		 (or (>= emacs-major-version 21)
-		     (and (= emacs-major-version 20)
-			  (> emacs-minor-version 0))
-		     (and (= emacs-major-version 19)
-			  (>= emacs-minor-version 15))))
-	    (setq dframe-timer (start-itimer "dframe"
-					     'dframe-timer-fn
-					     timeout
-					     timeout
-					     t))
-	  (setq dframe-timer (start-itimer "dframe"
-					   'dframe-timer-fn
-					   timeout
-					   nil)))))
-   ;; Post 19.31 Emacs
-   ((fboundp 'run-with-idle-timer)
-    (if dframe-timer
-	(progn (cancel-timer dframe-timer)
-	       (setq dframe-timer nil)))
-    (if timeout
-	(setq dframe-timer
-	      (run-with-idle-timer timeout t 'dframe-timer-fn))))
-   ;; Emacs 19.30 (Thanks twice: ptype@dra.hmg.gb)
-   ((fboundp 'post-command-idle-hook)
-    (if timeout
-	(add-hook 'post-command-idle-hook 'dframe-timer-fn)
-      (remove-hook 'post-command-idle-hook 'dframe-timer-fn)))
-   ;; Older or other Emacsen with no timers.  Set up so that its
-   ;; obvious this emacs can't handle the updates
-   ((symbolp null-on-error)
-    (set null-on-error nil)))
-  )
-
-(defun dframe-timer-fn ()
-  "Called due to the dframe timer.
-Evaluates all cached timer functions in sequence."
-  (let ((l dframe-client-functions))
-    (while (and l (sit-for 0))
-      (condition-case er
-	  (funcall (car l))
-	(error (message "DFRAME TIMER ERROR: %S" er)))
-      (setq l (cdr l)))))
-
-;;; Menu hacking for mouse-3
-;;
-(defconst dframe-pass-event-to-popup-mode-menu
-  (let (max-args)
-    (and (fboundp 'popup-mode-menu)
-         (fboundp 'function-max-args)
-         (setq max-args (function-max-args 'popup-mode-menu))
-         (not (zerop max-args))))
-  "The EVENT arg to 'popup-mode-menu' was introduced in XEmacs 21.4.0.")
-
-;; In XEmacs, we make popup menus work on the item over mouse (as
-;; opposed to where the point happens to be.)  We attain this by
-;; temporarily moving the point to that place.
-;;    Hrvoje Niksic <hniksic@srce.hr>
-(defun dframe-xemacs-popup-kludge (event)
-  "Pop up a menu related to the clicked on item.
-Must be bound to EVENT."
-  (interactive "e")
-  (save-excursion
-    (if dframe-pass-event-to-popup-mode-menu
-        (popup-mode-menu event)
-      (goto-char (event-closest-point event))
-      (beginning-of-line)
-      (forward-char (min 5 (- (save-excursion (end-of-line) (point))
-                              (save-excursion (beginning-of-line) (point)))))
-      (popup-mode-menu))
-    ;; Wait for menu to bail out.  `popup-mode-menu' (and other popup
-    ;; menu functions) return immediately.
-    (let (new)
-      (while (not (misc-user-event-p (setq new (next-event))))
-        (dispatch-event new))
-      (dispatch-event new))))
-
-(defun dframe-emacs-popup-kludge (e)
-  "Pop up a menu related to the clicked on item.
-Must be bound to event E."
-  (interactive "e")
-  (save-excursion
-    (mouse-set-point e)
-    ;; This gets the cursor where the user can see it.
-    (if (not (bolp)) (forward-char -1))
-    (sit-for 0)
-    (if (< emacs-major-version 20)
-	(mouse-major-mode-menu e)
-      (mouse-major-mode-menu e nil))))
-
-;;; Interactive user functions for the mouse
-;;
-(if dframe-xemacsp
-    (defalias 'dframe-mouse-event-p 'button-press-event-p)
-  (defun dframe-mouse-event-p (event)
-    "Return t if the event is a mouse related event"
-    (if (and (listp event)
-	     (member (event-basic-type event)
-		     '(mouse-1 mouse-2 mouse-3)))
-	t
-      nil)))
-
-(defun dframe-track-mouse (event)
-  "For motion EVENT, display info about the current line."
-  (interactive "e")
-  (when (and dframe-track-mouse-function
-	     (or dframe-xemacsp ;; XEmacs always safe?
-		 (windowp (posn-window (event-end event))) ; Sometimes
-					; there is no window to jump into.
-		 ))
-	     
-    (funcall dframe-track-mouse-function event)))
-
-(defun dframe-track-mouse-xemacs (event)
-  "For motion EVENT, display info about the current line."
-  (if (functionp (default-value 'mouse-motion-handler))
-      (funcall (default-value 'mouse-motion-handler) event))
-  (if dframe-track-mouse-function
-      (funcall dframe-track-mouse-function event)))
-
-(defun dframe-help-echo (window &optional buffer position)
-  "Display help based context.
-The context is in WINDOW, viewing BUFFER, at POSITION.
-BUFFER and POSITION are optional because XEmacs doesn't use them."
-  (when (and (not dframe-track-mouse-function)
-	     (bufferp buffer)
-	     dframe-help-echo-function)
-    (let ((dframe-suppress-message-flag t))
-      (with-current-buffer buffer
-	(if position (goto-char position))
-	(funcall dframe-help-echo-function)))))
-
-(defun dframe-mouse-set-point (e)
-  "Set POINT based on event E.
-Handles clicking on images in XEmacs."
-  (if (and (fboundp 'event-over-glyph-p) (event-over-glyph-p e))
-      ;; We are in XEmacs, and clicked on a picture
-      (let ((ext (event-glyph-extent e)))
-	;; This position is back inside the extent where the
-	;; junk we pushed into the property list lives.
-	(if (extent-end-position ext)
-	    (goto-char (1- (extent-end-position ext)))
-	  (mouse-set-point e)))
-    ;; We are not in XEmacs, OR we didn't click on a picture.
-    (mouse-set-point e)))
-
-(defun dframe-quick-mouse (e)
-  "Since mouse events are strange, this will keep the mouse nicely positioned.
-This should be bound to mouse event E."
-  (interactive "e")
-  (dframe-mouse-set-point e)
-  (if dframe-mouse-position-function
-      (funcall dframe-mouse-position-function)))
-
-(defun dframe-power-click (e)
-  "Activate any `dframe' mouse click as a power click.
-A power click will dispose of cached data (if available) or bring a buffer
-up into a different window.
-This should be bound to mouse event E."
-  (interactive "e")
-  (let ((dframe-power-click t))
-    (dframe-click e)))
-
-(defun dframe-click (e)
-  "Call our clients click function on a user click.
-E is the event causing the click."
-  (interactive "e")
-  (dframe-mouse-set-point e)
-  (when dframe-mouse-click-function
-    ;; On the off chance of buffer switch, or something incorrectly
-    ;; configured.
-    (funcall dframe-mouse-click-function e)))
-
-(defun dframe-double-click (e)
-  "Activate the registered click function on a double click.
-This must be bound to a mouse event.
-This should be bound to mouse event E."
-  (interactive "e")
-  ;; Emacs only.  XEmacs handles this via `mouse-track-click-hook'.
-  (cond ((eq (car e) 'down-mouse-1)
-	 (dframe-mouse-set-point e))
-	((eq (car e) 'mouse-1)
-	 (dframe-quick-mouse e))
-	((or (eq (car e) 'double-down-mouse-1)
-	     (eq (car e) 'triple-down-mouse-1))
-	 (dframe-click e))))
-
-;;; Hacks of normal things.
-;;
-;; Some normal things that happen in one of these dedicated frames
-;; must be handled specially, so that our dedicated frame isn't
-;; messed up.
-(defun dframe-temp-buffer-show-function (buffer)
-  "Placed in the variable `temp-buffer-show-function' in dedicated frames.
-If a user requests help using \\[help-command] <Key> the temp BUFFER will be
-redirected into a window on the attached frame."
-  (if dframe-attached-frame (select-frame dframe-attached-frame))
-  (pop-to-buffer buffer nil)
-  (other-window -1)
-  ;; Fix for using this hook on some platforms: Bob Weiner
-  (cond ((not dframe-xemacsp)
-	 (run-hooks 'temp-buffer-show-hook))
-	((fboundp 'run-hook-with-args)
-	 (run-hook-with-args 'temp-buffer-show-hook buffer))
-	((and (boundp 'temp-buffer-show-hook)
-	      (listp temp-buffer-show-hook))
-	 (mapcar (function (lambda (hook) (funcall hook buffer)))
-		 temp-buffer-show-hook))))
-
-(defun dframe-hack-buffer-menu (e)
-  "Control mouse 1 is buffer menu.
-This hack overrides it so that the right thing happens in the main
-Emacs frame, not in the dedicated frame.
-Argument E is the event causing this activity."
-  (interactive "e")
-  (let ((fn (lookup-key global-map (if dframe-xemacsp
-				              '(control button1)
-				     [C-down-mouse-1])))
-	(oldbuff (current-buffer))
-	(newbuff nil))
-    (unwind-protect
-	(save-excursion
-	  (set-window-dedicated-p (selected-window) nil)
-	  (call-interactively fn)
-	  (setq newbuff (current-buffer)))
-      (switch-to-buffer oldbuff)
-      (set-window-dedicated-p (selected-window) t))
-    (if (not (eq newbuff oldbuff))
-	(dframe-with-attached-buffer
-	 (switch-to-buffer newbuff)))))
-
-(defun dframe-switch-buffer-attached-frame (&optional buffer)
-  "Switch to BUFFER in the attached frame, and raise that frame.
-This overrides the default behavior of `switch-to-buffer' which is
-broken because of the dedicated frame."
-  (interactive)
-  ;; Assume we are in the dedicated frame.
-  (other-frame 1)
-  ;; Now switch buffers
-  (if buffer
-      (switch-to-buffer buffer)
-    (call-interactively 'switch-to-buffer nil nil)))
-
-;; XEmacs: this can be implemented using modeline keymaps, but there
-;; is no use, as we have horizontal scrollbar (as the docstring
-;; hints.)
-(defun dframe-mouse-hscroll (e)
-  "Read a mouse event E from the mode line, and horizontally scroll.
-If the mouse is being clicked on the far left, or far right of the
-mode-line.  This is only useful for non-XEmacs"
-  (interactive "e")
-  (let* ((x-point (car (nth 2 (car (cdr e)))))
-	 (pixels-per-10-col (/ (* 10 (frame-pixel-width))
-			       (frame-width)))
-	 (click-col (1+ (/ (* 10 x-point) pixels-per-10-col)))
-	 )
-    (cond ((< click-col 3)
-	   (scroll-left 2))
-	  ((> click-col (- (window-width) 5))
-	   (scroll-right 2))
-	  (t (dframe-message
-	      "Click on the edge of the modeline to scroll left/right")))
-    ))
-
-(provide 'dframe)
-
-;;; dframe.el ends here
diff --git a/xemacs-packages/lisp/speedbar/rpm.el b/xemacs-packages/lisp/speedbar/rpm.el
deleted file mode 100644
index 81bab281..00000000
--- a/xemacs-packages/lisp/speedbar/rpm.el
+++ /dev/null
@@ -1,198 +0,0 @@
-;;; rpm.el --- Manage Red Hat packages in emacs
-
-;;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Eric M. Ludlam
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 1.0
-;; Keywords: speedbar, rpm
-;; X-RCS: $Id: rpm.el,v 1.9 2002/03/16 19:57:30 zappo Exp $
-
-;; 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:
-;;
-;; Manage Red Hat system packages in emacs.  Uses speedbar to display
-;; the package higherarchy, and defines an `rpm-mode' which is useful
-;; for managing and viewing a specific package.
-;;
-;;  This tool depends on speedbar version 0.7 or higher.
-;;
-
-;;; History:
-;;
-;; 1.0  Initial revision
-
-(require 'speedbar)
-;;; Code:
-
-(defvar rpm-system nil
-  "This represents the current system.")
-
-(defvar rpm-speedbar-key-map nil
-  "Keymap used when working with RPMs in speedbar.")
-
-(if rpm-speedbar-key-map
-    nil
-  (setq rpm-speedbar-key-map (speedbar-make-specialized-keymap))
-
-  ;; General viewing pleasure...
-  (define-key speedbar-buffers-key-map "\C-m" 'speedbar-edit-line)
-  (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line)
-  (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line)
-  (define-key speedbar-buffers-key-map "=" 'speedbar-contract-line)
-
-  )
-
-(defvar rpm-speedbar-menu
-  ()
-  "Menu part in easymenu format that is used in speedbar while in rpm mode.")
-
-(defvar rpm-font-lock-keywords
-  '(
-    ;; file names
-    ("^\\(/[^ \n]+\\)$" 1 font-lock-reference-face)
-    ;; Tags
-    ("\\(Name\\|Version\\|Release\\|Install date\\|Group\\|Size\\|Packager\\|\
-Summary\\|Description\\|Distribution\\|Vendor\\|Build Date\\|Build Host\\|\
-Source RPM\\|URL\\) *:" 0 font-lock-variable-name-face)
-    ("^Name +: \\([^ \t]+\\)" 1 font-lock-function-name-face)
-    ;; Everything else is from the description.
-    ;; This is a clever font lock hack since it wont double color items
-    ("^\\([^\n]+\\)$" 1 font-lock-comment-face)
-    )
-  "Keywords used to highlight an RPM info buffer.")
-
-(defun rpm-info (package)
-  "View RPM PACKAGE information in the current buffer."
-  (interactive "sPackage: ")
-  (toggle-read-only -1)
-  (call-process "rpm" nil t nil "-qil" package)
-  (goto-char (point-min))
-  (rpm-mode)
-  (set-buffer-modified-p nil)
-  (toggle-read-only 1))
-
-(defun rpm-mode ()
-  "Major mode for viewing package information."
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'rpm-mode
-	mode-name "RPM")
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '((rpm-font-lock-keywords)
-			     t t
-			     ((?_ . "w") (?/ . "w"))))
-  (run-hooks 'rpm-info-hook))
-
-;;;###autoload
-(defun rpm ()
-  "Red Hat Package Management in Emacs."
-  (interactive)
-  ;; Make sure that speedbar is active
-  (speedbar-frame-mode 1)
-  ;; Make sure our special speedbar major mode is loaded
-  (speedbar-add-expansion-list '("rpm" rpm-speedbar-menu rpm-speedbar-key-map
-				 rpm-speedbar))
-  ;; Now, throw us into RPM mode on speedbar.
-  (speedbar-change-initial-expansion-list "rpm")
-  )
-
-(defun rpm-speedbar (directory zero)
-  "Create buttons in speedbar that represents the current rpm system.
-Takes DIRECTORY and ZERO, which are both ignored."
-  (rpm-fetch-system)
-  (let ((speedbar-tag-hierarchy-method '(speedbar-sort-tag-hierarchy)))
-    (speedbar-insert-generic-list -1 rpm-system 'rpm-tag-expand 'rpm-tag-find)))
-
-(defun rpm-tag-expand (text token indent)
-  "Expand a tag sublist.  Imenu will return sub-lists of specialized tag types.
-Etags does not support this feature.  TEXT will be the button
-string.  TOKEN will be the list, and INDENT is the current indentation
-level."
-  (cond ((string-match "+" text)	;we have to expand this file
-	 (speedbar-change-expand-button-char ?-)
-	 (speedbar-with-writable
-	   (save-excursion
-	     (end-of-line) (forward-char 1)
-	     (let ((speedbar-tag-hierarchy-method '(speedbar-sort-tag-hierarchy)))
-	       (speedbar-insert-generic-list indent
-					     token
-					     'rpm-tag-expand
-					     'rpm-tag-find)))))
-	((string-match "-" text)	;we have to contract this node
-	 (speedbar-change-expand-button-char ?+)
-	 (speedbar-delete-subblock indent))
-	(t (error "Ooops... not sure what to do.")))
-  (speedbar-center-buffer-smartly))
-
-(defun rpm-tag-find (text token indent)
-  "When clicking on a found tag, open that RPM file up.
-TEXT is the name of the package.  TOKEN and INDENT are ignored."
-  (let* ((buff (get-buffer-create text))
-	 (bwin (get-buffer-window buff 0)))
-    (if bwin
-	(progn
-	  (select-window bwin)
-	  (raise-frame (window-frame bwin)))
-      (if dframe-power-click
-	  (let ((pop-up-frames t)) (select-window (display-buffer buff)))
-	(dframe-select-attached-frame speedbar-frame)
-	(switch-to-buffer buff)))
-    (erase-buffer)
-    (rpm-info text)))
-
-(defun rpm-fetch-system ()
-  "Fetch the system by executing rpm."
-  (if rpm-system
-      nil
-    (save-excursion
-      (set-buffer (get-buffer-create "*rpm output*"))
-      ;; Get the database information here
-      (if (= (point-min) (point-max))
-	  (progn
-	    (speedbar-message "Running rpm -qa")
-	    (call-process "rpm" nil t nil "-qa" "--queryformat"
-			  "%{name}-%{version}-%{release} %{group}\n")))
-      ;; Convert it into a giant list
-      (speedbar-message "Parsing output ... ")
-      (goto-char (point-min))
-      (while (re-search-forward "^\\([^ ]+\\) \\([^\n]+\\)$" nil t)
-	(let* ((n (match-string 1))
-	       (p (match-string 2))
-	       (sl nil))
-	  ;; Start the directory listing
-	  (string-match "^\\([^/]+\\)\\(/\\|$\\)" p)
-	  (setq sl (assoc (match-string 1 p) rpm-system))
-	  (if (not sl) (setq rpm-system
-			     (cons (setq sl (list (match-string 1 p)))
-				   rpm-system)))
-	  (setq p (substring p (match-end 0)))
-	  ;; Loop to the end of the directory listing
-	  (while (string-match "^\\([^/]+\\)\\(/\\|$\\)" p)
-	    (let ((ssl (assoc (match-string 1 p) sl)))
-	      (if (not ssl)
-		  (setcdr sl (cons (setq ssl (list (match-string 1 p)))
-				   (cdr sl))))
-	      (setq sl ssl))
-	    (setq p (substring p (match-end 0))))
-	  ;; We are at the end.  Append our new element to the end
-	  (while (cdr sl) (setq sl (cdr sl)))
-	  (setcdr sl (cons (cons n 1) nil)))))))
-
-(provide 'rpm)
-;;; rpm.el ends here
diff --git a/xemacs-packages/lisp/speedbar/sb-ant.el b/xemacs-packages/lisp/speedbar/sb-ant.el
deleted file mode 100644
index 3a9d984c..00000000
--- a/xemacs-packages/lisp/speedbar/sb-ant.el
+++ /dev/null
@@ -1,108 +0,0 @@
-;;; sb-ant.el --- provide speedbar menus for ANT Project files
-
-;; Copyright (c) 2001 Ole Arndt
-;; Author: Ole Arndt <arndt@tivano.com>
-;; based on sb-html.el by:
-;; Created: Tue Sep 09 09:45:00 2001
-
-;; Copyright (c) 2001 Richard Y. Kim
-;; Author: Richard Y. Kim, <ryk@dspwiz.com>
-;; Maintainer: Richard Y. Kim, <ryk@dspwiz.com>
-;; Created: Mon Apr 09 09:44:06 2001
-;; Version: $Id: sb-ant.el,v 1.1 2001/10/31 01:16:04 zappo Exp $
-;; Keywords: speedbar, 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 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
-
-;; This small add-on to speedbar provides an alternate way to view ANT
-;; project files. It simply lists all the available targets.
-;;
-;; This code is a simple modification of sb-html.el which comes
-;; with speedbar.
-
-;; Installation procedure:
-;;
-;;   Install speedbar 0.12 or later.
-;;   Add the following to your ~/.emacs file:
-;;   (eval-after-load "speedbar" '(load-library "sb-ant"))
-;;
-
-;;; Code:
-
-(require 'speedbar)
-(require 'sb-texinfo)	; for speedbar-format-texinfo-list
-
-;; Attach these new functions to handle texinfo-mode.
-(add-to-list 'speedbar-dynamic-tags-function-list
-	     '(speedbar-fetch-dynamic-ant-project . speedbar-insert-ant-project-list))
-
-;; This returns t if the major mode of the current buffer is not
-;; 'xml-mode. If it is 'xml-mode, then this returns a
-;; list where each element is (LEVEL TARGETNAME . MARKER). 
-;; LEVLE is always 0,  NAME is the name of the target. MARKER is
-;; emacs marker that points to the beginning of the section. The
-;; elements in the list returned are in ascending order of the
-;; MARKER. This function along with it's parter,
-;; speedbar-insert-ant-project-list, are designed to be added to the
-;; speedbar-dynamic-tags-function-list list.
-;;
-;; This function is based on `speedbar-fetch-dynamic-html'.
-(defun speedbar-fetch-dynamic-ant-project ( filename )
-  (set-buffer (find-file-noselect filename))
-  (if (not (eq major-mode 'xml-mode))
-      t
-    (condition-case nil
-	(save-excursion
-
-	  ;; Set speedbar-tag-hierarchy-method to nil so that
-	  ;; speedbar-create-tag-hierarchy won't reorder the list.
-	  ;; Make it buffer local so that the global value is not touched.
-	  (make-local-variable 'speedbar-tag-hierarchy-method)
-	  (setq speedbar-tag-hierarchy-method nil)
-
-	  (set (make-local-variable
-		'speedbar-generic-list-group-expand-button-type)
-	       'expandtag)
-	  (set (make-local-variable
-		'speedbar-generic-list-tag-button-type)
-	       'statictag)
-
-	  (let ((case-fold-search t)	; ant tags are case insensitive
-		pos-beg title level alist beg)
-	    (goto-char (point-min))
-	    ;; regexp below will not work if `>' appears within an attribute
-	    ;; value, e.g., <h1 foo="I'm a weird value >"> ... </h1>
-	    (while (re-search-forward "<target[^>]*name=\"\\([^\"]*\\)\"[^>]*>" nil t)
-	      (setq beg (match-end 0))
-	      (goto-char (match-beginning 0))
-	      (setq pos-beg (point-marker))
-	      (setq level 0)
-	      (setq title (match-string 1))
-	      (re-search-forward (concat "</target" ""))
-	      (setq alist (cons (cons level (cons title pos-beg)) alist)))
-	    (nreverse alist)))
-      (error t))))
-
-(fset 'speedbar-format-ant-project-list 'speedbar-format-texinfo-list)
-
-(defun speedbar-insert-ant-project-list (indent lst)
-  (speedbar-insert-generic-list indent (speedbar-format-ant-project-list lst indent)
-				'speedbar-tag-expand
-				'speedbar-tag-find))
-
-(provide 'sb-ant)
-
-;;; sb-ant.el ends here
diff --git a/xemacs-packages/lisp/speedbar/sb-box-minus.xpm b/xemacs-packages/lisp/speedbar/sb-box-minus.xpm
deleted file mode 100644
index a24583cd..00000000
--- a/xemacs-packages/lisp/speedbar/sb-box-minus.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_box_minus_xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #000000",
-"+	c #828282",
-"@	c #D19200",
-"...+           +..+ ",
-".@@.+          +.@.+",
-"+.@@.+        +.@@@.",
-"+.@@@.+++++++++.@@..",
-" +..@............@.+",
-" +.@..@@@@@@@@@@@..+",
-" +.@@..............+",
-" +.@@.@@@@@@@@@@@@.+",
-" +.@@.@@@@@@@@@@@@.+",
-" +.@@.@@@......@@@.+",
-" +.@@.@@@......@@@.+",
-"  +.@.@@@@@@@@@@@@.+",
-"   +..@@@@@@@@@@@@.+",
-"    +..............+",
-"     ++++++++++++++ "};
diff --git a/xemacs-packages/lisp/speedbar/sb-box-plus.xpm b/xemacs-packages/lisp/speedbar/sb-box-plus.xpm
deleted file mode 100644
index 5f70fef9..00000000
--- a/xemacs-packages/lisp/speedbar/sb-box-plus.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_box_plus_xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #D19200",
-"                    ",
-"  ..............    ",
-" .++++++++++++++.   ",
-" .++@@@@@@+@@@@@+.  ",
-" .+@+@@@@@@+@@@@@+. ",
-" .+@@++++++++++++++.",
-" .+@@+@@@@@@@@@@@@+.",
-" .+@@+@@@@@++@@@@@+.",
-" .+@@+@@@@@++@@@@@+.",
-" .+@@+@@@++++++@@@+.",
-" .+@@+@@@++++++@@@+.",
-"  .+@+@@@@@++@@@@@+.",
-"   .++@@@@@++@@@@@+.",
-"    .++++++++++++++.",
-"     .............. "};
diff --git a/xemacs-packages/lisp/speedbar/sb-box.xpm b/xemacs-packages/lisp/speedbar/sb-box.xpm
deleted file mode 100644
index f5697154..00000000
--- a/xemacs-packages/lisp/speedbar/sb-box.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_box_xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFF993",
-"                    ",
-" ...............    ",
-" .++++++++++++++.   ",
-" .++@@@@@@+@@@@@+.  ",
-" .+@+@@@@@@+@@@@@+. ",
-" .+@@++++++++++++++.",
-" .+@@+@@@@@@@@@@@@+.",
-" .+@@+@@@@@@@@@@@@+.",
-" .+@@+@@@@@@@@@@@@+.",
-" .+@@+@@@@@@@@@@@@+.",
-" .+@@+@@@@@@@@@@@@+.",
-"  .+@+@@@@@@@@@@@@+.",
-".  .++@@@@@@@@@@@@+.",
-"    .++++++++++++++.",
-"     .............. "};
diff --git a/xemacs-packages/lisp/speedbar/sb-chk.xpm b/xemacs-packages/lisp/speedbar/sb-chk.xpm
deleted file mode 100644
index ad4078b6..00000000
--- a/xemacs-packages/lisp/speedbar/sb-chk.xpm
+++ /dev/null
@@ -1,20 +0,0 @@
-/* XPM */
-static char * sb_chk_xpm[] = {
-"15 15 2 1",
-" 	c None",
-".	c #FF0000",
-"               ",
-" . .  ..       ",
-" . . .         ",
-" . . .       . ",
-"  .   ..    .  ",
-"           ..  ",
-"          ..   ",
-" ...     ..    ",
-" ...    ..     ",
-" ....  ..      ",
-"  ... ..       ",
-"   ....        ",
-"    ...        ",
-"     .         ",
-"               "};
diff --git a/xemacs-packages/lisp/speedbar/sb-dir-minus.xpm b/xemacs-packages/lisp/speedbar/sb-dir-minus.xpm
deleted file mode 100644
index 2edd33e6..00000000
--- a/xemacs-packages/lisp/speedbar/sb-dir-minus.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * sb_dir_minus_xpm[] = {
-"20 15 5 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #DBDB00",
-"#	c #FFF993",
-" .......            ",
-".+++++++.           ",
-".+@@@@@@+.........  ",
-".+@@@@@@@++++++++.  ",
-".+@@@@@@@@@@@@@@+...",
-".+@@++++++++++++++++",
-".+@@+##############+",
-".+@+##############+.",
-".+@+####++++++####+.",
-".+@+####++++++####+.",
-".+@+##############+.",
-".++##############+..",
-".++##############+. ",
-".+++++++++++++++++. ",
-" .................  "};
diff --git a/xemacs-packages/lisp/speedbar/sb-dir-plus.xpm b/xemacs-packages/lisp/speedbar/sb-dir-plus.xpm
deleted file mode 100644
index 93154af7..00000000
--- a/xemacs-packages/lisp/speedbar/sb-dir-plus.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * sb_dir_plus_xpm[] = {
-"20 15 5 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #DBDB00",
-"#	c #FFF993",
-" .......            ",
-".+++++++.           ",
-".+@@@@@@+.......... ",
-".+@@@@@@@++++++++++.",
-".+@@@@@@@@@@@@@@@@+.",
-".+#######++#####@@+.",
-".+#######++######@+.",
-".+#####++++++####@+.",
-".+#####++++++####@+.",
-".+#######++######@+.",
-".+#######++######@+.",
-".+###############@+.",
-".+###############@+.",
-".++++++++++++++++++.",
-" .................. "};
diff --git a/xemacs-packages/lisp/speedbar/sb-dir.xpm b/xemacs-packages/lisp/speedbar/sb-dir.xpm
deleted file mode 100644
index de1d3fd6..00000000
--- a/xemacs-packages/lisp/speedbar/sb-dir.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * sb_dir_xpm[] = {
-"20 15 5 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #DBDB00",
-"#	c #FFF993",
-" .......            ",
-".+++++++.           ",
-".+@@@@@@+.......... ",
-".+@@@@@@@++++++++++.",
-".+@@@@@@@@@@@@@@@@+.",
-".+##############@@+.",
-".+###############@+.",
-".+###############@+.",
-".+###############@+.",
-".+###############@+.",
-".+###############@+.",
-".+###############@+.",
-".+###############@+.",
-".++++++++++++++++++.",
-" .................. "};
diff --git a/xemacs-packages/lisp/speedbar/sb-doc-minus.xpm b/xemacs-packages/lisp/speedbar/sb-doc-minus.xpm
deleted file mode 100644
index 2480e4b9..00000000
--- a/xemacs-packages/lisp/speedbar/sb-doc-minus.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * sb_doc_minus_xpm[] = {
-"15 15 5 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #5A818B",
-"#	c #FFFFFF",
-"      .......  ",
-"     .+++++++. ",
-"    .+@@@@@@+. ",
-"   .+@@@@@@+#. ",
-"   .+@@@@@@+#+.",
-"  .+@####@+##+.",
-" .+@@@@@@@+#+. ",
-" .+@@@@@@+##+. ",
-".++++@@@@+#+.  ",
-".+###++++##+.  ",
-".+########+.   ",
-".++#######+.   ",
-" ..++++##+.    ",
-"   ....+++.    ",
-"       ...     "};
diff --git a/xemacs-packages/lisp/speedbar/sb-doc-plus.xpm b/xemacs-packages/lisp/speedbar/sb-doc-plus.xpm
deleted file mode 100644
index eb7ebe17..00000000
--- a/xemacs-packages/lisp/speedbar/sb-doc-plus.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * sb_doc_plus_xpm[] = {
-"15 15 5 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #5A818B",
-"#	c #FFFFFF",
-"      .......  ",
-"     .+++++++. ",
-"    .+@@@@@@+. ",
-"   .+@@#@@@+#. ",
-"   .+@@#@@@+#+.",
-"  .+@#####+##+.",
-" .+@@@@#@@+#+. ",
-" .+@@@@#@+##+. ",
-".++++@@@@+#+.  ",
-".+###++++##+.  ",
-".+########+.   ",
-".++#######+.   ",
-" ..++++##+.    ",
-"   ....+++.    ",
-"       ...     "};
diff --git a/xemacs-packages/lisp/speedbar/sb-doc.xpm b/xemacs-packages/lisp/speedbar/sb-doc.xpm
deleted file mode 100644
index 3ed8eee2..00000000
--- a/xemacs-packages/lisp/speedbar/sb-doc.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * sb_doc_xpm[] = {
-"15 15 5 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #5A818B",
-"#	c #FFFFFF",
-"      .......  ",
-"     .+++++++. ",
-"    .+@@@@@@+. ",
-"   .+@@@@@@+#. ",
-"   .+@@@@@@+#+.",
-"  .+@@@@@@+##+.",
-" .+@@@@@@@+#+. ",
-" .+@@@@@@+##+. ",
-".++++@@@@+#+.  ",
-".+###++++##+.  ",
-".+########+.   ",
-".+########+.   ",
-".++++++##+.    ",
-" ......+++.    ",
-"       ...     "};
diff --git a/xemacs-packages/lisp/speedbar/sb-gud.el b/xemacs-packages/lisp/speedbar/sb-gud.el
deleted file mode 100644
index 946db711..00000000
--- a/xemacs-packages/lisp/speedbar/sb-gud.el
+++ /dev/null
@@ -1,243 +0,0 @@
-;;; sb-gud --- Speedbar support for the Grand Unified Debugger
-
-;; Copyright (C) 1997, 1998, 2001, 2002 Free Software Foundation
-;;
-;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
-;; Version: 0.1
-;; Keywords: tools, gud
-;; X-RCS: $Id: sb-gud.el,v 1.10 2002/03/16 20:02:39 zappo Exp $
-;;
-;; 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 this program; if not, you can either send email to this
-;; program's author (see below) or write to:
-;;
-;;              The Free Software Foundation, Inc.
-;;              675 Mass Ave.
-;;              Cambridge, MA 02139, USA.
-;;
-;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
-;;
-
-;;; Commentary:
-;;
-;;   Speedbar provides a frame in which files, and locations in
-;; files are displayed.  These functions provide gud specific support,
-;; showing stacks, files, and the like in the side-bar.
-;;
-;;   To enable in emacs 20.2 or earlier, add this to your .emacs file.
-;;   (autoload 'gud-speedbar-buttons "sb-gud"
-;;             "GUD specific speedbar button generator.")
-;;
-;;   This file requires speedbar.
-
-;;; Change log:
-;; 0.1   - First revision
-;; 0.1.1 - Removed dependency on speedbspec.
-;; 0.1.2 - Changed to handle keymap feature.
-
-(require 'speedbar)
-
-;;; Code:
-(defvar gud-last-speedbar-buffer nil
-  "The last GUD buffer used.")
-
-(defvar gud-last-speedbar-stackframe nil
-  "Description of the currently displayed GUD stack.
-t means that there is no stack, and we are in display-file mode.")
-
-(defvar gud-speedbar-key-map nil
-  "Keymap used when in the buffers display mode.")
-
-(defun gud-install-speedbar-variables ()
-  "Install those variables used by speedbar to enhance gud/gdb."
-  (if gud-speedbar-key-map
-      nil
-    (setq gud-speedbar-key-map (speedbar-make-specialized-keymap))
-
-    (define-key gud-speedbar-key-map "j" 'speedbar-edit-line)
-    (define-key gud-speedbar-key-map "e" 'speedbar-edit-line)
-    (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line)))
-
-(defvar gud-speedbar-menu-items
-  ;; Note to self.  Add expand, and turn off items when not available.
-  '(["Jump to stack frame" speedbar-edit-line t])
-  "Additional menu items to add the the speedbar frame.")
-
-;; Make sure our special speedbar mode is loaded
-(if (featurep 'speedbar)
-    (gud-install-speedbar-variables)
-  (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables))
-
-;;;###autoload
-(defun gud-speedbar-buttons (buffer)
-  "Create a speedbar display based on the current state of GUD.
-If the GUD BUFFER is not running a supported debugger, then turn
-off the specialized speedbar mode."
-  (if (and (save-excursion (goto-char (point-min))
-			   (looking-at "\\(//\\)?Current Stack"))
-	   (equal gud-last-last-frame gud-last-speedbar-stackframe))
-      nil
-    (setq gud-last-speedbar-buffer buffer)
-    (let* ((ff (save-excursion (set-buffer buffer) gud-find-file))
-	   ;;(lf (save-excursion (set-buffer buffer) gud-last-last-frame))
-	   (frames
-	    (cond ((eq ff 'gud-gdb-find-file)
-		   (gud-gdb-get-stackframe buffer)
-		   )
-		  ;; Add more debuggers here!
-		  (t
-		   (speedbar-remove-localized-speedbar-support buffer)
-		   nil))))
-      (erase-buffer)
-      (if (not frames)
-	  (speedbar-insert-label "No Stack frames")
-	(speebar-insert-label "Current Stack:"))
-      (while frames
-	(insert (nth 1 (car frames)) ":\n")
-	(if (= (length (car frames)) 2)
-	    (progn
-;	      (speedbar-insert-button "[?]"
-;				      'speedbar-button-face
-;				      nil nil nil t)
-	      (speedbar-insert-button (car (car frames))
-				      'speedbar-directory-face
-				      nil nil nil t))
-;	  (speedbar-insert-button "[+]"
-;				  'speedbar-button-face
-;				  'speedbar-highlight-face
-;				  'gud-gdb-get-scope-data
-;				  (car frames) t)
-	  (speedbar-insert-button (car (car frames))
-				  'speedbar-file-face
-				  'speedbar-highlight-face
-				  (cond ((eq ff 'gud-gdb-find-file)
-					 'gud-gdb-goto-stackframe)
-					(t (error "Should never be here")))
-				  (car frames) t))
-	(setq frames (cdr frames)))
-      (let ((selected-frame
-	     (cond ((eq ff 'gud-gdb-find-file)
-		    (gud-gdb-selected-frame-info buffer))
-		   (t (error "Should never be here")))))))
-    (setq gud-last-speedbar-stackframe gud-last-last-frame)))
-
-(defun gud-gdb-goto-stackframe (text token indent)
-  "Goto the stackframe described by TEXT, TOKEN, and INDENT."
-  (speedbar-with-attached-buffer
-   (gud-basic-call (concat "frame " (nth 1 token)))
-   (sit-for 1)))
-
-(defvar gud-gdb-fetched-stack-frame nil
-  "Stack frames we are fetching from GDB.")
-
-(defvar gud-gdb-fetched-stack-frame-list nil
-  "List of stack frames we are fetching from GDB.")
-
-;(defun gud-gdb-get-scope-data (text token indent)
-;  ;; checkdoc-params: (indent)
-;  "Fetch data associated with a stack frame, and expand/contract it.
-;Data to do this is retrieved from TEXT and TOKEN."
-;  (let ((args nil) (scope nil))
-;    (gud-gdb-run-command-fetch-lines "info args")
-;
-;    (gud-gdb-run-command-fetch-lines "info local")
-;
-;    ))
-
-(defun gud-gdb-get-stackframe (buffer)
-  "Extract the current stack frame out of the GUD GDB BUFFER."
-  (let ((newlst nil)
-	(gud-gdb-fetched-stack-frame-list nil))
-    (gud-gdb-run-command-fetch-lines "backtrace" buffer)
-    (if (and (car gud-gdb-fetched-stack-frame-list)
-	     (string-match "No stack" (car gud-gdb-fetched-stack-frame-list)))
-	;; Go into some other mode???
-	nil
-      (while gud-gdb-fetched-stack-frame-list
-	(let ((e (car gud-gdb-fetched-stack-frame-list))
-	      (name nil) (num nil))
-	  (if (not (or
-		    (string-match "^#\\([0-9]+\\) +[0-9a-fx]+ in \\([:0-9a-zA-Z_]+\\) (" e)
-		    (string-match "^#\\([0-9]+\\) +\\([:0-9a-zA-Z_]+\\) (" e)))
-	      (if (not (string-match
-			"at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e))
-		  nil
-		(setcar newlst
-			(list (nth 0 (car newlst))
-			      (nth 1 (car newlst))
-			      (match-string 1 e)
-			      (match-string 2 e))))
-	    (setq num (match-string 1 e)
-		  name (match-string 2 e))
-	    (setq newlst
-		  (cons
-		   (if (string-match
-			"at \\([-0-9a-zA-Z_.]+\\):\\([0-9]+\\)$" e)
-		       (list name num (match-string 1 e)
-			     (match-string 2 e))
-		     (list name num))
-		   newlst))))
-	(setq gud-gdb-fetched-stack-frame-list
-	      (cdr gud-gdb-fetched-stack-frame-list)))
-      (nreverse newlst))))
-
-;(defun gud-gdb-selected-frame-info (buffer)
-;  "Learn GDB information for the currently selected stack frame in BUFFER."
-;  )
-
-(defun gud-gdb-run-command-fetch-lines (command buffer)
-  "Run COMMAND, and return when `gud-gdb-fetched-stack-frame-list' is full.
-BUFFER is the GUD buffer in which to run the command."
-  (save-excursion
-    (set-buffer buffer)
-    (if (save-excursion
-	  (goto-char (point-max))
-	  (beginning-of-line)
-	  (not (looking-at comint-prompt-regexp)))
-	nil
-      ;; Much of this copied from GDB complete, but I'm grabbing the stack
-      ;; frame instead.
-      (let ((gud-marker-filter 'gud-gdb-speedbar-stack-filter))
-	;; Issue the command to GDB.
-	(gud-basic-call command)
-	(setq gud-gdb-complete-in-progress t ;; use this flag for our purposes.
-	      gud-gdb-complete-string nil
-	      gud-gdb-complete-list nil)
-	;; Slurp the output.
-	(while gud-gdb-complete-in-progress
-	  (accept-process-output (get-buffer-process gud-comint-buffer)))
-	(setq gud-gdb-fetched-stack-frame nil
-	      gud-gdb-fetched-stack-frame-list
-	      (nreverse gud-gdb-fetched-stack-frame-list))))))
-  
-(defun gud-gdb-speedbar-stack-filter (string)
-  ;; checkdoc-params: (string)
-  "Filter used to read in the current GDB stack."
-  (setq string (concat gud-gdb-fetched-stack-frame string))
-  (while (string-match "\n" string)
-    (setq gud-gdb-fetched-stack-frame-list
-	  (cons (substring string 0 (match-beginning 0))
-		gud-gdb-fetched-stack-frame-list))
-    (setq string (substring string (match-end 0))))
-  (if (string-match comint-prompt-regexp string)
-      (progn
-	(setq gud-gdb-complete-in-progress nil)
-	string)
-    (progn
-      (setq gud-gdb-complete-string string)
-      "")))
-
-(provide 'sb-gud)
-;;; sb-gud.el ends here
diff --git a/xemacs-packages/lisp/speedbar/sb-html.el b/xemacs-packages/lisp/speedbar/sb-html.el
deleted file mode 100644
index d909ba32..00000000
--- a/xemacs-packages/lisp/speedbar/sb-html.el
+++ /dev/null
@@ -1,118 +0,0 @@
-;;; sb-html.el --- provide hierarchical speedbar menu's for HTML files
-
-;; Copyright (c) 2001, 2002 Richard Y. Kim
-
-;; Author: Richard Y. Kim, <ryk@dspwiz.com>
-;; Maintainer: Richard Y. Kim, <ryk@dspwiz.com>
-;; Created: Mon Apr 09 09:44:06 2001
-;; Version: $Id: sb-html.el,v 1.3 2002/03/17 02:52:32 zappo Exp $
-;; Keywords: speedbar, 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 of
-;; the License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be
-;; useful, but WITHOUT ANY WARRANTY; without even the implied
-;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
-;; PURPOSE.  See the GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public
-;; License along with this program; if not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
-;; MA 02111-1307 USA
-
-;;; Commentary:
-;;
-;; This small add-on to speedbar provides an alternate way to view HTML
-;; documents which shows the natural hierarchy of the document based
-;; on H1, H2, ... H6 tags.
-;;
-;; This code is a simple modification of sb-texinfo.el which comes
-;; with speedbar.
-
-;; Installation procedure:
-;;
-;;   Install speedbar 0.12 or later.
-;;   Add the following to your ~/.emacs file:
-;;   (eval-after-load "speedbar" '(load-library "sb-html"))
-;;
-;; Known Problems:
-;;
-;;   Perhaps <HEAD> and <BODY> should be treated as H0 tag?
-
-;;; Change Log:
-;;;
-;;; 1.1 - modified regexp based on Eric's suggestion.
-;;;
-;;; 1.0 - sent to Eric Ludlam.
-
-;;; Code:
-
-(require 'speedbar)
-(require 'sb-texinfo)	; for speedbar-format-texinfo-list
-
-;; Attach these new functions to handle texinfo-mode.
-(add-to-list 'speedbar-dynamic-tags-function-list
-	     '(speedbar-fetch-dynamic-html . speedbar-insert-html-list))
-
-;; This returns t if the major mode of the current buffer is not
-;; 'html-helper-mode. If it is 'html-helper-mode, then this returns a
-;; list where each element is (LEVEL NAME . MARKER). LEVEL is 0, 1, 2,
-;; 3, 4, or 5 corresponding to H1, H2, H3, H4, H5 an H6
-;; tags. respectively. NAME is the name of the section. MARKER is
-;; emacs marker that points to the beginning of the section. The
-;; elements in the list returned are in ascending order of the
-;; MARKER. This function along with it's parter,
-;; speedbar-insert-html-list, are designed to be added to the
-;; speedbar-dynamic-tags-function-list list.
-;;
-;; This function is based on `speedbar-fetch-dynamic-texinfo'.
-(defun speedbar-fetch-dynamic-html ( filename )
-  (set-buffer (find-file-noselect filename))
-  (if (not (or (eq major-mode 'html-helper-mode)
-	       (eq major-mode 'html-mode)))
-      t
-    (condition-case nil
-	(save-excursion
-
-	  ;; Set speedbar-tag-hierarchy-method to nil so that
-	  ;; speedbar-create-tag-hierarchy won't reorder the list.
-	  ;; Make it buffer local so that the global value is not touched.
-	  (make-local-variable 'speedbar-tag-hierarchy-method)
-	  (setq speedbar-tag-hierarchy-method nil)
-
-	  (set (make-local-variable
-		'speedbar-generic-list-group-expand-button-type)
-	       'expandtag)
-	  (set (make-local-variable
-		'speedbar-generic-list-tag-button-type)
-	       'statictag)
-
-	  (let ((case-fold-search t)	; HTML tags are case insensitive
-		pos-beg title level alist beg)
-	    (goto-char (point-min))
-	    ;; regexp below will not work if `>' appears within an attribute
-	    ;; value, e.g., <h1 foo="I'm a weird value >"> ... </h1>
-	    (while (re-search-forward "<h\\([1-6]\\)\\b[^>]*>\\s-*" nil t)
-	      (setq beg (match-end 0))
-	      (goto-char (match-beginning 0))
-	      (setq pos-beg (point-marker))
-	      (setq level (1- (read (match-string 1))))
-	      (re-search-forward (concat "\\s-*</h" (match-string 1) "\\b"))
-	      (setq title (buffer-substring beg (match-beginning 0)))
-	      (setq alist (cons (cons level (cons title pos-beg)) alist)))
-	    (nreverse alist)))
-      (error t))))
-
-(fset 'speedbar-format-html-list 'speedbar-format-texinfo-list)
-
-(defun speedbar-insert-html-list (indent lst)
-  (speedbar-insert-generic-list indent (speedbar-format-html-list lst 0)
-				'speedbar-tag-expand
-				'speedbar-tag-find))
-
-(provide 'sb-html)
-
-;;; sb-html.el ends here
diff --git a/xemacs-packages/lisp/speedbar/sb-image.el b/xemacs-packages/lisp/speedbar/sb-image.el
deleted file mode 100644
index 85f882d7..00000000
--- a/xemacs-packages/lisp/speedbar/sb-image.el
+++ /dev/null
@@ -1,284 +0,0 @@
-;;; sb-image --- Image management for speedbar
-
-;;; Copyright (C) 1999, 2000, 2001, 2002 Free Software Foundation
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Keywords: file, tags, tools
-;; X-RCS: $Id: sb-image.el,v 1.7 2002/03/17 11:44:13 zappo Exp $
-
-;; 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:
-;;
-;; Supporting Image display for Emacs 20 and less, Emacs 21, and XEmacs,
-;; is a challenging task, which doesn't take kindly to being byte compiled.
-;; When sharing speedbar.elc between these three applications, the Image
-;; support can get lost.
-;;
-;; By splitting out that hard part into this file, and avoiding byte
-;; compilation, one copy speedbar can support all these platforms together.
-;;
-;; This file requires the `image' package if it is available.
-
-(condition-case nil
-    (require 'image)
-  (error nil))
-
-;;; Code:
-(defcustom speedbar-use-images (and (or (fboundp 'defimage)
-					(fboundp 'make-image-specifier))
-				    (if (fboundp 'display-graphic-p)
-					(display-graphic-p)
-				      window-system))
-  "*Non nil if speedbar should display icons."
-  :group 'speedbar
-  :type 'boolean)
-
-;;; Some images if defimage is available:
-(eval-and-compile
-
-(if (fboundp 'defimage)
-    (defalias 'defimage-speedbar 'defimage)
-
-  (if (not (fboundp 'make-glyph))
-      
-(defmacro defimage-speedbar (variable imagespec docstring)
-  "Don't bother loading up an image...
-Argument VARIABLE is the varible to define.
-Argument IMAGESPEC is the list defining the image to create.
-Argument DOCSTRING is the documentation for VARIABLE."
-  `(defvar ,variable nil ,docstring))
-
-;; ELSE
-(defun speedbar-find-image-on-load-path (image)
-  "Find the image file IMAGE on the load path."
-  (let ((l (cons
-	    ;; In XEmacs, try the data directory first (for an
-	    ;; install in XEmacs property.  Then search the load
-	    ;; path (for user installs)
-	    (locate-data-directory "speedbar")
-	    load-path))
-	(r nil))
-    (while (and l (not r))
-      (if (file-exists-p (concat (car l) "/" image))
-	  (setq r (concat (car l) "/" image)))
-      (setq l (cdr l)))
-    r))
-
-(defun speedbar-convert-emacs21-imagespec-to-xemacs (spec)
-  "Convert the Emacs21 Image SPEC into an XEmacs image spec."
-  (let* ((sl (car spec))
-	 (itype (nth 1 sl))
-	 (ifile (nth 3 sl)))
-    (vector itype ':file (speedbar-find-image-on-load-path ifile))))
-
-(defmacro defimage-speedbar (variable imagespec docstring)
-  "Devine VARIABLE as an image if `defimage' is not available..
-IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
-  `(defvar ,variable
-     ;; The Emacs21 version of defimage looks just like the XEmacs image
-     ;; specifier, except that it needs a :type keyword.  If we line
-     ;; stuff up right, we can use this cheat to support XEmacs specifiers.
-     (condition-case nil
-	 (make-glyph
-	  (make-image-specifier
-	   (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
-	  'buffer)
-       (error nil))
-     ,docstring))
-
-)))
-
-(defimage-speedbar speedbar-directory
-  ((:type xpm :file "sb-dir.xpm" :ascent center))
-  "Image used for emptly closed directories.")
-
-(defimage-speedbar speedbar-directory-plus
-  ((:type xpm :file "sb-dir-plus.xpm" :ascent center))
-  "Image used for closed directories with stuff in them.")
-
-(defimage-speedbar speedbar-directory-minus
-  ((:type xpm :file "sb-dir-minus.xpm" :ascent center))
-  "Image used for open directories with stuff in them.")
-
-(defimage-speedbar speedbar-page-plus
-  ((:type xpm :file "sb-pg-plus.xpm" :ascent center))
-  "Image used for closed files with stuff in them.")
-
-(defimage-speedbar speedbar-page-minus
-  ((:type xpm :file "sb-pg-minus.xpm" :ascent center))
-  "Image used for open files with stuff in them.")
-
-(defimage-speedbar speedbar-page
-  ((:type xpm :file "sb-pg.xpm" :ascent center))
-  "Image used for files that can't be opened.")
-
-(defimage-speedbar speedbar-tag
-  ((:type xpm :file "sb-tag.xpm" :ascent center))
-  "Image used for tags.")
-
-(defimage-speedbar speedbar-tag-plus
-  ((:type xpm :file "sb-tag-plus.xpm" :ascent center))
-  "Image used for closed tag groups.")
-
-(defimage-speedbar speedbar-tag-minus
-  ((:type xpm :file "sb-tag-minus.xpm" :ascent center))
-  "Image used for open tag groups.")
-
-(defimage-speedbar speedbar-tag-gt
-  ((:type xpm :file "sb-tag-gt.xpm" :ascent center))
-  "Image used for open tag groups.")
-
-(defimage-speedbar speedbar-tag-v
-  ((:type xpm :file "sb-tag-v.xpm" :ascent center))
-  "Image used for open tag groups.")
-
-(defimage-speedbar speedbar-tag-type
-  ((:type xpm :file "sb-tag-type.xpm" :ascent center))
-  "Image used for open tag groups.")
-
-(defimage-speedbar speedbar-box-plus
-  ((:type xpm :file "sb-box-plus.xpm" :ascent center))
-  "Image used for closed groups of tags.")
-
-(defimage-speedbar speedbar-box-minus
-  ((:type xpm :file "sb-box-minus.xpm" :ascent center))
-  "Image used for open groups of tags.")
-
-(defimage-speedbar speedbar-mail
-  ((:type xpm :file "sb-mail.xpm" :ascent center))
-  "Image used for open tag groups.")
-
-(defimage-speedbar speedbar-checkout
-  ((:type xpm :file "sb-chk.xpm" :ascent center))
-  "Image used for open tag groups.")
-
-(defimage-speedbar speedbar-object
-  ((:type xpm :file "sb-obj.xpm" :ascent center))
-  "Image used for open tag groups.")
-
-(defimage-speedbar speedbar-object-out-of-date
-  ((:type xpm :file "sb-objod.xpm" :ascent center))
-  "Image used for open tag groups.")
-
-(defimage-speedbar speedbar-label
-  ((:type xpm :file "sb-label.xpm" :ascent center))
-  "Image used for label prefix.")
-
-(defimage-speedbar speedbar-read-only
-  ((:type xpm :file "sb-ro.xpm" :ascent center))
-  "Image used to mark an item Read Only, Locked, or some such.")
-
-(defimage-speedbar speedbar-document-tag
-  ((:type xpm :file "sb-doc.xpm" :ascent center))
-  "Image used to indicate documentation available.")
-
-(defimage-speedbar speedbar-document-plus
-  ((:type xpm :file "sb-doc-plus.xpm" :ascent center))
-  "Image used to indicate documentation available.")
-
-(defimage-speedbar speedbar-document-minus
-  ((:type xpm :file "sb-doc-minus.xpm" :ascent center))
-  "Image used to indicate documentation available.")
-
-(defimage-speedbar speedbar-info-tag
-  ((:type xpm :file "sb-info.xpm" :ascent center))
-  "Image used to indicate more information available.")
-
-(defvar speedbar-expand-image-button-alist
-  '(("<+>" . speedbar-directory-plus)
-    ("<->" . speedbar-directory-minus)
-    ("< >" . speedbar-directory)
-    ("[+]" . speedbar-page-plus)
-    ("[-]" . speedbar-page-minus)
-    ("[?]" . speedbar-page)
-    ("[ ]" . speedbar-page)
-    ("{+}" . speedbar-box-plus)
-    ("{-}" . speedbar-box-minus)
-    ("<M>" . speedbar-mail)
-    ("<d>" . speedbar-document-tag)
-    ("<i>" . speedbar-info-tag)
-    (" =>" . speedbar-tag)
-    (" +>" . speedbar-tag-gt)
-    (" ->" . speedbar-tag-v)
-    (">" . speedbar-tag)
-    ("@" . speedbar-tag-type)
-    ("  @" . speedbar-tag-type)
-    ("*" . speedbar-checkout)
-    ("#" . speedbar-object)
-    ("!" . speedbar-object-out-of-date)
-    ("//" . speedbar-label)
-    ("%" . speedbar-read-only)
-    ;; Not used in this form, but kept here so we don't forget
-    ("<d+>" . speedbar-document-plus)
-    ("<d->" . speedbar-document-minus)
-    )
-  "List of text and image associations.")
-
-(defun speedbar-insert-image-button-maybe (start length)
-  "Insert an image button based on text starting at START for LENGTH chars.
-If buttontext is unknown, just insert that text.
-If we have an image associated with it, use that image."
-  (if speedbar-use-images
-      (let* ((bt (buffer-substring start (+ length start)))
-	     (a (assoc bt speedbar-expand-image-button-alist)))
-	;; Regular images (created with `insert-image' are intangible
-	;; which (I suppose) make them more compatible with XEmacs 21.
-	;; Unfortunatly, there is a giant pile o code dependent on the
-	;; underlying text.  This means if we leave it tangible, then I
-	;; don't have to change said giant piles o code.
-	(if (and a (symbol-value (cdr a)))
-	    (if (featurep 'xemacs)
-		(add-text-properties (+ start (length bt)) start
-				     (list 'end-glyph (symbol-value (cdr a))
-					   'rear-nonsticky (list 'display)
-					   'invisible t
-					   'detachable t))
-	      (add-text-properties start (+ start (length bt))
-				   (list 'display (symbol-value (cdr a))
-					 'rear-nonsticky (list 'display))))
-	  ;(message "Bad text [%s]" (buffer-substring start (+ start length)))
-	  ))))
-
-(defun speedbar-image-dump ()
-  "Dump out the current state of the Speedbar image alist.
-See `speedbar-expand-image-button-alist' for details."
-  (interactive)
-  (with-output-to-temp-buffer "*Speedbar Images*"
-    (save-excursion
-      (set-buffer "*Speedbar Images*")
-      (goto-char (point-max))
-      (insert "Speedbar image cache.\n\n")
-      (let ((start (point)) (end nil))
-	(insert "Image\tText\tImage Name")
-	(setq end (point))
-	(insert "\n")
-	(put-text-property start end 'face 'underline))
-      (let ((ia speedbar-expand-image-button-alist))
-	(while ia
-	  (let ((start (point)))
-	    (insert (car (car ia)))
-	    (insert "\t")
-	    (speedbar-insert-image-button-maybe start
-						(length (car (car ia))))
-	    (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
-	  (setq ia (cdr ia)))))))
-
-(provide 'sb-image)
-
-;;; sb-image.el ends here
diff --git a/xemacs-packages/lisp/speedbar/sb-info.el b/xemacs-packages/lisp/speedbar/sb-info.el
deleted file mode 100644
index 9012cca0..00000000
--- a/xemacs-packages/lisp/speedbar/sb-info.el
+++ /dev/null
@@ -1,251 +0,0 @@
-;;; sb-info --- Speedbar support for Info
-
-;; Copyright (C) 1997, 1998, 2000, 2001, 2002 Free Software Foundation
-;;
-;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
-;; Version: 0.3
-;; Keywords: file, tags, tools
-;; X-RCS: $Id: sb-info.el,v 1.18 2002/03/16 20:07:19 zappo Exp $
-;;
-;; This file is patch 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; if not, you can either send email to this
-;; program's author (see below) or write to:
-;;
-;;              The Free Software Foundation, Inc.
-;;              675 Mass Ave.
-;;              Cambridge, MA 02139, USA.
-;;
-;; Please send bug reports, etc. to zappo@gnu.org
-;;
-
-;;; Commentary:
-;;
-;;   Speedbar provides a frame in which files, and locations in
-;; files are displayed.  These functions provide Info specific support,
-;; showing links and addresses in the side-bar.
-;;
-;;   To enable in Emacs 20.2 or earlier, add this to your .emacs file.
-;;   (autoload 'Info-speedbar-buttons "sb-info"
-;;             "Info specific speedbar button generator.")
-;;
-;;   This file requires speedbar and Info.
-
-;;; Change log:
-;; 0.1   - first revision copied from speedbspec.el V 0.1.1
-;; 0.1.1 - No longer require speedbspec
-;; 0.2   - Added a speedbar major mode for displaying Info nodes, and modeled
-;;         the minor mode after it.  Completely replaced the old info display
-;;         with the major mode, and mixed them to move nicely from major to
-;;         minor mode effortlessly.
-;; 0.2.1   Added section adding major display mode at load time.
-
-(require 'speedbar)
-(require 'info)
-
-;;; Code:
-(defvar Info-speedbar-key-map nil
-  "Keymap used when in the info display mode.")
-
-(defun Info-install-speedbar-variables ()
-  "Install those variables used by speedbar to enhance Info."
-  (if Info-speedbar-key-map
-      nil
-    (setq Info-speedbar-key-map (speedbar-make-specialized-keymap))
-
-    ;; Basic tree features
-    (define-key Info-speedbar-key-map "e" 'speedbar-edit-line)
-    (define-key Info-speedbar-key-map "\C-m" 'speedbar-edit-line)
-    (define-key Info-speedbar-key-map "+" 'speedbar-expand-line)
-    (define-key Info-speedbar-key-map "=" 'speedbar-expand-line)
-    (define-key Info-speedbar-key-map "-" 'speedbar-contract-line)
-    (define-key Info-speedbar-key-map " " 'speedbar-toggle-line-expansion)
-    )
-
-  (speedbar-add-expansion-list '("Info" Info-speedbar-menu-items
-				 Info-speedbar-key-map
-				 Info-speedbar-hierarchy-buttons)))
-
-(defvar Info-speedbar-menu-items
-  '(["Browse Node" speedbar-edit-line t]
-    ["Expand Node" speedbar-expand-line
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.\\+. "))]
-    ["Contract Node" speedbar-contract-line
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.-. "))]
-    )
-  "Additional menu-items to add to speedbar frame.")
-
-;; Make sure our special speedbar major mode is loaded
-(if (featurep 'speedbar)
-    (Info-install-speedbar-variables)
-  (add-hook 'speedbar-load-hook 'Info-install-speedbar-variables))
-
-;;; Info hierarchy display method
-;;;###autoload
-(defun Info-speedbar-browser ()
-  "Initialize speedbar to display an info node browser.
-This will add a speedbar major display mode."
-  (interactive)
-  (require 'speedbar)
-  ;; Make sure that speedbar is active
-  (speedbar-frame-mode 1)
-  ;; Now, throw us into Info mode on speedbar.
-  (speedbar-change-initial-expansion-list "Info")
-  )
-
-(defvar Info-speedbar-image-button-alist
-  '(("<+>" . speedbar-document-plus)
-    ("<->" . speedbar-document-minus)
-    ("[+]" . speedbar-page-plus)
-    ("[-]" . speedbar-page-minus)
-    ("[?]" . speedbar-page)
-    ("[ ]" . speedbar-page)
-    )
-  "Image buttons used for Info mode.")
-
-(defun Info-speedbar-hierarchy-buttons (directory depth &optional node)
-  "Display an Info directory hierarchy in speedbar.
-DIRECTORY is the current directory in the attached frame.
-DEPTH is the current indentation depth.
-NODE is an optional argument that is used to represent the
-specific node to expand."
-  (if (and (not node)
-	   (save-excursion (goto-char (point-min))
-			   (looking-at "Info Nodes:")))
-      ;; Update our "current node" maybe?
-      nil
-    ;; We cannot use the generic list code, that depends on all leaves
-    ;; being known at creation time.
-    (if (not node)
-	(speedbar-with-writable (insert "Info Nodes:\n")))
-    (let ((completions nil)
-	  (speedbar-expand-image-button-alist
-	   Info-speedbar-image-button-alist))
-      (dframe-select-attached-frame speedbar-frame)
-      (save-window-excursion
-	(setq completions
-	      (Info-speedbar-fetch-file-nodes (or node '"(dir)top"))))
-      (select-frame speedbar-frame)
-      (if completions
-	  (speedbar-with-writable
-	   (while completions
-	     (speedbar-make-tag-line (if (= depth 0)
-					 'angle
-				       'bracket)
-				     ?+ 'Info-speedbar-expand-node
-				     (cdr (car completions))
-				     (car (car completions))
-				     'Info-speedbar-goto-node
-				     (cdr (car completions))
-				     'info-xref depth)
-	     (setq completions (cdr completions)))
-	   t)
-	nil))))
-  
-(defun Info-speedbar-goto-node (text node indent)
-  "When user clicks on TEXT, goto an info NODE.
-The INDENT level is ignored."
-  (dframe-select-attached-frame speedbar-frame)
-  (let* ((buff (or (get-buffer "*info*")
-		   (progn (info) (get-buffer "*info*"))))
-	 (bwin (get-buffer-window buff 0)))
-    (if bwin
-	(progn
-	  (select-window bwin)
-	  (raise-frame (window-frame bwin)))
-      (if dframe-power-click
-	  (let ((pop-up-frames t)) (select-window (display-buffer buff)))
-	(dframe-select-attached-frame speedbar-frame)
-	(switch-to-buffer buff)))
-    (if (string-match "^(\\([^)]+\\))\\([^,:]+\\)$" node)
-	(let ((file (match-string 1 node))
-	      (node (match-string 2 node)))
-	  (Info-find-node file node)
-	  ;; If we do a find-node, and we were in info mode, restore
-	  ;; the old default method.  Once we are in info mode, it makes
-	  ;; sense to return to whatever method the user was using before.
-	  (if (string= speedbar-initial-expansion-list-name "Info")
-	      (speedbar-change-initial-expansion-list
-	       speedbar-previously-used-expansion-list-name))))))
-
-(defun Info-speedbar-expand-node (text token indent)
-  "Expand the node the user clicked on.
-TEXT is the text of the button we clicked on, a + or - item.
-TOKEN is data related to this node (NAME . FILE).
-INDENT is the current indentation depth."
-  (let ((speedbar-expand-image-button-alist Info-speedbar-image-button-alist))
-    (cond ((string-match "+" text)	;we have to expand this file
-	   (speedbar-change-expand-button-char ?-)
-	   (if (speedbar-with-writable
-		 (save-excursion
-		   (end-of-line) (forward-char 1)
-		   (Info-speedbar-hierarchy-buttons nil (1+ indent) token)))
-	       (speedbar-change-expand-button-char ?-)
-	     (speedbar-change-expand-button-char ??)))
-	  ((string-match "-" text)	;we have to contract this node
-	   (speedbar-change-expand-button-char ?+)
-	   (speedbar-delete-subblock indent))
-	  (t (error "Ooops... not sure what to do")))
-    (speedbar-center-buffer-smartly)))
-  
-(defun Info-speedbar-fetch-file-nodes (nodespec)
-  "Fetch the subnodes from the info NODESPEC.
-NODESPEC is a string of the form: (file)node.
-Optional THISFILE represends the filename of"
-  (save-excursion
-    ;; Set up a buffer we can use to fake-out Info.
-    (set-buffer (get-buffer-create "*info-browse-tmp*"))
-    (if (not (equal major-mode 'Info-mode))
-	(Info-mode))
-    ;; Get the node into this buffer
-    (if (string-match "^(\\([^)]+\\))\\([^,:]+\\)$" nodespec)
-	(let ((file (match-string 1 nodespec))
-	      (node (match-string 2 nodespec)))
-	  (Info-find-node file node))
-      (error "Node %s not found!" nodespec))
-    ;; Scan the created buffer
-    (goto-char (point-min))
-    (let ((completions nil)
-	  (thisfile (progn (string-match "^(\\([^)]+\\))" nodespec)
-			   (match-string 1 nodespec))))
-      ;; Always skip the first one...
-      (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
-      (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
-	(let ((name (match-string 1)))
-	  (if (looking-at " *\\(([^)]+)[^.\n]+\\)\\.")
-	      (setq name (cons name (match-string 1)))
-	    (if (looking-at "[ \t]*\\(([^)]+)\\)\\.")
-		(setq name (cons name (concat (match-string 1) "Top")))
-	      (if (looking-at " \\([^.]+\\).")
-		  (setq name
-			(cons name (concat "(" thisfile ")" (match-string 1))))
-		(setq name (cons name (concat "(" thisfile ")" name))))))
-	  (setq completions (cons name completions))))
-      (nreverse completions))))
-
-;;; Info mode node listing
-;;;###autoload
-(defun Info-speedbar-buttons (buffer)
-  "Create a speedbar display to help navigation in an Info file.
-BUFFER is the buffer speedbar is requesting buttons for."
-  (if (save-excursion (goto-char (point-min))
-		      (not (looking-at "Info Nodes:")))
-      (erase-buffer))
-  (Info-speedbar-hierarchy-buttons nil 0)
-  )
-
-(provide 'sb-info)
-;;; sb-info.el ends here
diff --git a/xemacs-packages/lisp/speedbar/sb-info.xpm b/xemacs-packages/lisp/speedbar/sb-info.xpm
deleted file mode 100644
index 0027252b..00000000
--- a/xemacs-packages/lisp/speedbar/sb-info.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_info_xpm[] = {
-"10 15 4 1",
-" 	c None",
-".	c #BEBEBE",
-"+	c #0000FF",
-"@	c #FFFFFF",
-"    ..    ",
-"  ..+++.  ",
-" .+++@++. ",
-" .+++++++ ",
-" .+++++++ ",
-".++@@@++++",
-".++++@++++",
-".++++@++++",
-".++++@++++",
-" .+++@++++",
-" .+++@+++ ",
-" .+@@@@@+ ",
-" .+++++++ ",
-"  .+++++  ",
-"    ++    "};
diff --git a/xemacs-packages/lisp/speedbar/sb-label.xpm b/xemacs-packages/lisp/speedbar/sb-label.xpm
deleted file mode 100644
index 715cc2c1..00000000
--- a/xemacs-packages/lisp/speedbar/sb-label.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_label_xpm[] = {
-"10 16 3 1",
-" 	c None",
-".	c gray",
-"+	c blue",
-"     .....",
-"   ..+++++",
-"  .+++++++",
-" .++++++++",
-" .++++++++",
-".+++++++++",
-".+++++++++",
-".+++++++++",
-".+++++++++",
-".+++++++++",
-".+++++++++",
-".+++++++++",
-".+++++++++",
-".+++++++++",
-".+++++++++",
-".+++++++++"};
diff --git a/xemacs-packages/lisp/speedbar/sb-mail.xpm b/xemacs-packages/lisp/speedbar/sb-mail.xpm
deleted file mode 100644
index 5716eeb9..00000000
--- a/xemacs-packages/lisp/speedbar/sb-mail.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_mail_xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFFFFF",
-"................... ",
-".++++++++++++++++++.",
-".++@@@@@@@@@@@@@@++.",
-".+@++@@@@@@@@@@++@+.",
-".+@@@++@@@@@@++@@@+.",
-".+@@@@@++@@++@@@@@+.",
-".+@@@@@@@++@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@@@+@@@@@@+@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@+@@@@@@@@@@+@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".++@@@@@@@@@@@@@@++.",
-".++++++++++++++++++.",
-" .................. "};
diff --git a/xemacs-packages/lisp/speedbar/sb-obj.xpm b/xemacs-packages/lisp/speedbar/sb-obj.xpm
deleted file mode 100644
index b291fcfb..00000000
--- a/xemacs-packages/lisp/speedbar/sb-obj.xpm
+++ /dev/null
@@ -1,20 +0,0 @@
-/* XPM */
-static char * sb_obj_xpm[] = {
-"15 15 2 1",
-" 	c None",
-".	c #000CFF",
-" ..  .  ..  .  ",
-".  . . .  . .  ",
-".  . . .  . .  ",
-".  . . .  . .  ",
-" ..  .  ..  .  ",
-"               ",
-".  ..  .  ..   ",
-". .  . . .  .  ",
-". .  . . .  .  ",
-". .  . . .  .  ",
-".  ..  .  ..   ",
-"               ",
-" ..  .  ..  .  ",
-".  . . .  . .  ",
-".  . . .  . .  "};
diff --git a/xemacs-packages/lisp/speedbar/sb-objod.xpm b/xemacs-packages/lisp/speedbar/sb-objod.xpm
deleted file mode 100644
index cd49e831..00000000
--- a/xemacs-packages/lisp/speedbar/sb-objod.xpm
+++ /dev/null
@@ -1,21 +0,0 @@
-/* XPM */
-static char * sb_objod_xpm[] = {
-"15 15 3 1",
-" 	c None",
-".	c #000CFF",
-"+	c #FFFA00",
-" ..  .  ..  .  ",
-".  .++ .  . .  ",
-".  .++ .  . .  ",
-".  . ++.  . .  ",
-" ..  ++ ..  .  ",
-"     ++        ",
-".  ..++.  ..   ",
-". .  .++ .  .  ",
-". .  .++ .  .  ",
-". .  .++ .  .  ",
-".  ..  .  ..   ",
-"       ++      ",
-" ..  . ++.  .  ",
-".  . . .  . .  ",
-".  . . .  . .  "};
diff --git a/xemacs-packages/lisp/speedbar/sb-pg-minus.xpm b/xemacs-packages/lisp/speedbar/sb-pg-minus.xpm
deleted file mode 100644
index 2e542436..00000000
--- a/xemacs-packages/lisp/speedbar/sb-pg-minus.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * sb_pg_minus_xpm[] = {
-"20 15 5 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFFFFF",
-"#	c #ADADAD",
-"       ............ ",
-"      .++++++++++++.",
-"     .++@@@@@@@@@@+.",
-"    .+#+@@@@@@@@@@+.",
-"   .+##+@@@@@@@@@@+.",
-"  .+###+@@@@@@@@@@+.",
-" .+####+@@@@@@@@@@+.",
-".+++++++@++++++@@@+.",
-".+@@@@@@@++++++@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".++++++++++++++++++.",
-" .................. "};
diff --git a/xemacs-packages/lisp/speedbar/sb-pg-plus.xpm b/xemacs-packages/lisp/speedbar/sb-pg-plus.xpm
deleted file mode 100644
index aa5d38fd..00000000
--- a/xemacs-packages/lisp/speedbar/sb-pg-plus.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * sb_pg_plus_xpm[] = {
-"20 15 5 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFFFFF",
-"#	c #ADADAD",
-"       ............ ",
-"      .++++++++++++.",
-"     .++@@@@@@@@@@+.",
-"    .+#+@@@@@@@@@@+.",
-"   .+##+@@@@@@@@@@+.",
-"  .+###+@@@++@@@@@+.",
-" .+####+@@@++@@@@@+.",
-".+++++++@++++++@@@+.",
-".+@@@@@@@++++++@@@+.",
-".+@@@@@@@@@++@@@@@+.",
-".+@@@@@@@@@++@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".++++++++++++++++++.",
-" .................. "};
diff --git a/xemacs-packages/lisp/speedbar/sb-pg.xpm b/xemacs-packages/lisp/speedbar/sb-pg.xpm
deleted file mode 100644
index 75c6a6e7..00000000
--- a/xemacs-packages/lisp/speedbar/sb-pg.xpm
+++ /dev/null
@@ -1,23 +0,0 @@
-/* XPM */
-static char * sb_pg_xpm[] = {
-"20 15 5 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFFFFF",
-"#	c #ADADAD",
-"       ............ ",
-"      .++++++++++++.",
-"     .++@@@@@@@@@@+.",
-"    .+#+@@@@@@@@@@+.",
-"   .+##+@@@@@@@@@@+.",
-"  .+###+@@@@@@@@@@+.",
-" .+####+@@@@@@@@@@+.",
-".+++++++@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".++++++++++++++++++.",
-" .................. "};
diff --git a/xemacs-packages/lisp/speedbar/sb-rmail.el b/xemacs-packages/lisp/speedbar/sb-rmail.el
deleted file mode 100644
index a5513681..00000000
--- a/xemacs-packages/lisp/speedbar/sb-rmail.el
+++ /dev/null
@@ -1,158 +0,0 @@
-;;; sb-rmail --- Speedbar support for rmail
-
-;; Copyright (C) 1997, 1998, 1999, 2001, 2002 Free Software Foundation
-;;
-;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
-;; Version: 0.1
-;; Keywords: file, tags, tools
-;; X-RCS: $Id: sb-rmail.el,v 1.5 2002/08/09 22:08:29 youngs Exp $
-;;
-;; 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 this program; if not, you can either send email to this
-;; program's author (see below) or write to:
-;;
-;;              The Free Software Foundation, Inc.
-;;              675 Mass Ave.
-;;              Cambridge, MA 02139, USA.
-;;
-;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
-;;
-
-;;; Commentary:
-;;
-;;   Speedbar provides a frame in which files, and locations in
-;; files are displayed.  These functions provide rmail specific support,
-;; showing links and addresses in the side-bar.
-;;
-;;   To enable in emacs 20.2 or earlier, add this to your .emacs file.
-;;   (autoload 'rmail-speedbar-buttons "sb-rmail"
-;;             "Rmail specific speedbar button generator.")
-;;
-;;   This file requires speedbar.
-(eval-when-compile (require 'speedbar))
-
-;;; Change log:
-;; 0.1   - first revision copied from speedbspec.el V 0.1.1
-;; 0.1.1 - removed require speedbspec.
-;; 0.1.2 - Changed to handle new keymap feature.
-
-;;; Code:
-(defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
-  "*This regex us used to match folder names to be displayed in speedbar.
-Enabling this will permit speedbar to display your folders for easy
-browsing, and moving of messages.")
-
-(defvar rmail-speedbar-last-user nil
-  "The last user to be displayed in the speedbar.")
-
-(defvar rmail-speedbar-key-map nil
-  "Keymap used when in rmail display mode.")
-
-(defun rmail-install-speedbar-variables ()
-  "Install those variables used by speedbar to enhance rmail."
-  (if rmail-speedbar-key-map
-      nil
-    (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap))
-
-    (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line)
-    (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line)
-    (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line)
-    (define-key rmail-speedbar-key-map "M"
-      'rmail-speedbar-move-message-to-folder-on-line)))
-
-(defvar rmail-speedbar-menu-items
-  '(["Read Folder" speedbar-edit-line t]
-    ["Move message to folder" rmail-speedbar-move-message-to-folder-on-line
-     (save-excursion (beginning-of-line)
-		     (looking-at "<M> "))])
-  "Additional menu-items to add to speedbar frame.")
-
-;; Make sure our special speedbar major mode is loaded
-(if (featurep 'speedbar)
-    (rmail-install-speedbar-variables)
-  (add-hook 'speedbar-load-hook 'rmail-install-speedbar-variables))
-
-;;;###autoload
-(defun rmail-speedbar-buttons (buffer)
-  "Create buttons for BUFFER containing rmail messages.
-Click on the address under Reply to: to reply to this person.
-Under Folders: Click a name to read it, or on the <M> to move the
-current message into that RMAIL folder."
-  (let ((from nil))
-    (save-excursion
-      (set-buffer buffer)
-      (goto-char (point-min))
-      (if (not (re-search-forward "^Reply-To: " nil t))
-	  (if (not (re-search-forward "^From:? " nil t))
-	      (setq from t)))
-      (if from
-	  nil
-	(setq from (buffer-substring (point) (save-excursion
-					       (end-of-line)
-					       (point))))))
-    (goto-char (point-min))
-    (if (and (looking-at "\\(//\\)?Reply to:")
-	     (equal from rmail-speedbar-last-user))
-	nil
-      (setq rmail-speedbar-last-user from)
-      (erase-buffer)
-      (speedbar-insert-separator "Reply To")
-      (if (stringp from)
-	  (speedbar-insert-button from 'speedbar-directory-face 'highlight
-				  'rmail-speedbar-button 'rmail-reply))
-      (speedbar-insert-separator "Folders")
-      (let* ((case-fold-search nil)
-	     (df (directory-files (save-excursion (set-buffer buffer)
-						  default-directory)
-				  nil rmail-speedbar-match-folder-regexp)))
-	(while df
-	  (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight
-				  'rmail-speedbar-move-message (car df))
-	  (speedbar-insert-button (car df) 'speedbar-file-face 'highlight
-				  'rmail-speedbar-find-file nil t)
-	  (setq df (cdr df)))))))
-
-(defun rmail-speedbar-button (text token indent)
-  "Execute an rmail command specified by TEXT.
-The command used is TOKEN.  INDENT is not used."
-  (speedbar-with-attached-buffer
-   (funcall token t)))
-
-(defun rmail-speedbar-find-file (text token indent)
-  "Load in the rmail file TEXT.
-TOKEN and INDENT are not used."
-  (speedbar-with-attached-buffer
-   (speedbar-message "Loading in RMAIL file %s..." text)
-   (find-file text)))
-
-(defun rmail-speedbar-move-message-to-folder-on-line ()
-  "If the current line is a folder, move current message to it."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t)
-	(progn
-	  (forward-char -2)
-	  (speedbar-do-function-pointer)))))
-
-(defun rmail-speedbar-move-message (text token indent)
-  "From button TEXT, copy current message to the rmail file specified by TOKEN.
-TEXT and INDENT are not used."
-  (speedbar-with-attached-buffer
-   (message "Moving message to %s" token)
-   (rmail-output-to-rmail-file token)))
-
-(provide 'sb-rmail)
-;;; sb-rmail.el ends here
diff --git a/xemacs-packages/lisp/speedbar/sb-ro.xpm b/xemacs-packages/lisp/speedbar/sb-ro.xpm
deleted file mode 100644
index 37032326..00000000
--- a/xemacs-packages/lisp/speedbar/sb-ro.xpm
+++ /dev/null
@@ -1,17 +0,0 @@
-/* XPM */
-static char * sb_ro_xpm[] = {
-"10 10 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFF993",
-"  .++++.  ",
-" .++..++. ",
-" .++..++. ",
-".++++++++.",
-".+@@@@@@+.",
-".+@@++@@+.",
-".+@@++@@+.",
-".+@@@@@@+.",
-".++++++++.",
-".........."};
diff --git a/xemacs-packages/lisp/speedbar/sb-tag-gt.xpm b/xemacs-packages/lisp/speedbar/sb-tag-gt.xpm
deleted file mode 100644
index 49b8b72a..00000000
--- a/xemacs-packages/lisp/speedbar/sb-tag-gt.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_tag_gt_xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFF993",
-"                    ",
-"                    ",
-"    ............... ",
-"   .+++++++++++++++.",
-"  .+@@@@@++@@@@@@@+.",
-" .+@@@@@@+++@@@@@@+.",
-".+@@@@@@@++++@@@@@+.",
-".+@++@@@@+++++@@@@+.",
-".+@++@@@@+++++.@@@+.",
-".+@@@@@@@++++.@@@@+.",
-" .+@@@@@@+++.@@@@@+.",
-"  .+@@@@@++.@@@@@@+.",
-".  .++++++.++++++++.",
-"    ............... ",
-"                    "};
diff --git a/xemacs-packages/lisp/speedbar/sb-tag-minus.xpm b/xemacs-packages/lisp/speedbar/sb-tag-minus.xpm
deleted file mode 100644
index f006c4ef..00000000
--- a/xemacs-packages/lisp/speedbar/sb-tag-minus.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_tag__xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFF993",
-"                    ",
-"                    ",
-"    ............... ",
-"   .+++++++++++++++.",
-"  .+@@@@@@@@@@@@@@+.",
-" .+@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@++@@++++++@@@@@+.",
-".+@++@@++++++@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-" .+@@@@@@@@@@@@@@@+.",
-"  .+@@@@@@@@@@@@@@+.",
-".  .+++++++++++++++.",
-"    ............... ",
-"                    "};
diff --git a/xemacs-packages/lisp/speedbar/sb-tag-plus.xpm b/xemacs-packages/lisp/speedbar/sb-tag-plus.xpm
deleted file mode 100644
index cf32fef5..00000000
--- a/xemacs-packages/lisp/speedbar/sb-tag-plus.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_tag+_xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFF993",
-"                    ",
-"                    ",
-"    ............... ",
-"   .+++++++++++++++.",
-"  .+@@@@@@@@@@@@@@+.",
-" .+@@@@@@++@@@@@@@+.",
-".+@@@@@@@++@@@@@@@+.",
-".+@++@@++++++@@@@@+.",
-".+@++@@++++++@@@@@+.",
-".+@@@@@@@++@@@@@@@+.",
-" .+@@@@@@++@@@@@@@+.",
-"  .+@@@@@@@@@@@@@@+.",
-".  .+++++++++++++++.",
-"    ............... ",
-"                    "};
diff --git a/xemacs-packages/lisp/speedbar/sb-tag-type.xpm b/xemacs-packages/lisp/speedbar/sb-tag-type.xpm
deleted file mode 100644
index 65886989..00000000
--- a/xemacs-packages/lisp/speedbar/sb-tag-type.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_tag_type_xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFF993",
-"                    ",
-"                    ",
-"    ............... ",
-"   .+++++++++++++++.",
-"  .+@@@@@@@@@@@@@@+.",
-" .+@@@@@@++++++@@@+.",
-".+@@@@@@@++++++@@@+.",
-".+@++@@@@@@++@@@@@+.",
-".+@++@@@@@@++@@@@@+.",
-".+@@@@@@@@@++@@@@@+.",
-" .+@@@@@@@@++@@@@@+.",
-"  .+@@@@@@@@@@@@@@+.",
-".  .+++++++++++++++.",
-"    ............... ",
-"                    "};
diff --git a/xemacs-packages/lisp/speedbar/sb-tag-v.xpm b/xemacs-packages/lisp/speedbar/sb-tag-v.xpm
deleted file mode 100644
index 7431e4c5..00000000
--- a/xemacs-packages/lisp/speedbar/sb-tag-v.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_tag_v_xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFF993",
-"                    ",
-"                    ",
-"    ............... ",
-"   .+++++++++++++++.",
-"  .+@@@@@@@@@@@@@@+.",
-" .+@@@++++++++++.@+.",
-".+@@@@@++++++++.@@+.",
-".+@++@@@++++++.@@@+.",
-".+@++@@@@++++.@@@@+.",
-".+@@@@@@@@++.@@@@@+.",
-" .+@@@@@@@@.@@@@@@+.",
-"  .+@@@@@@@@@@@@@@+.",
-".  .+++++++++++++++.",
-"    ............... ",
-"                    "};
diff --git a/xemacs-packages/lisp/speedbar/sb-tag.xpm b/xemacs-packages/lisp/speedbar/sb-tag.xpm
deleted file mode 100644
index 4c6f1c56..00000000
--- a/xemacs-packages/lisp/speedbar/sb-tag.xpm
+++ /dev/null
@@ -1,22 +0,0 @@
-/* XPM */
-static char * sb_tag_xpm[] = {
-"20 15 4 1",
-" 	c None",
-".	c #828282",
-"+	c #000000",
-"@	c #FFF993",
-"                    ",
-"                    ",
-"    ............... ",
-"   .+++++++++++++++.",
-"  .+@@@@@@@@@@@@@@+.",
-" .+@@@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-".+@++@@@@@@@@@@@@@+.",
-".+@++@@@@@@@@@@@@@+.",
-".+@@@@@@@@@@@@@@@@+.",
-" .+@@@@@@@@@@@@@@@+.",
-"  .+@@@@@@@@@@@@@@+.",
-".  .+++++++++++++++.",
-"    ............... ",
-"                    "};
diff --git a/xemacs-packages/lisp/speedbar/sb-texinfo.el b/xemacs-packages/lisp/speedbar/sb-texinfo.el
deleted file mode 100644
index 5597f163..00000000
--- a/xemacs-packages/lisp/speedbar/sb-texinfo.el
+++ /dev/null
@@ -1,219 +0,0 @@
-;;; sb-texinfo.el --- provide hierarchical speedbar menu's for texinfo files
-
-;; Copyright (c) 2000, 2002 Richard Y. Kim
-
-;; Author: Richard Y. Kim, <ryk@ap.com>
-;; Maintainer: Richard Y. Kim, <ryk@ap.com>
-;; Created: Fri Jun 16 17:23:11 2000
-;; Version: $Id: sb-texinfo.el,v 1.8 2002/03/17 02:40:42 zappo Exp $
-;; Keywords:
-
-;; 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 speedbar mode provides support for texinfo files by creating
-;; tags using imenu.  This presentation do not reflect the natural
-;; hierarchy of the texinfo document.
-;;
-;; This small add-on to speedbar provides an alternate way to view the
-;; document which shows the natural hierarchy of the document.  This
-;; shows the same information that `M-x texinfo-show-structure'
-;; displays, but in the speedbar frame with the speedbar user
-;; interface.
-
-;; Installtation procedure:
-;;   Install speedbar 0.12 or later.
-;;   Add the following to your ~/.emacs file:
-;;   (eval-after-load "speedbar" '(load-library "sb-texinfo"))
-
-;; Known Problems:
-;;   Does not look inside files included via @include directive.
-;;
-;;   The indentations of nodes with and without subnodes could be better.
-;;
-;;   Clicking on nodes with subnodes only shows subnodes rather than
-;;   displaying the node content on the target frame.  Instead the first
-;;   subnode on the speedbar has to be clicked.  I believe this can be
-;;   fixed if a custom speedbar button display routine is written rather
-;;   than using the built-in function speedbar-insert-generic-list.
-;;   If I learn to do this, I will, but I make no promises.
-;;
-;;   Potential problem with auctex 9.9p users.  Auctex provides it's
-;;   own texinfo mode which does not use texinfo-mode-hook.  Make sure
-;;   you do not use texinfo mode provided by auctex!
-
-;;; Change Log:
-;;;
-;;; 1.7 - By Eric Ludlam <zappo@gnu.org>
-;;;       In `speedbar-fetch-dynamic-texinfo', set the buffer to file
-;;;       to correspond to a speedbar change.
-;;;
-;;; 1.6 - By Eric Ludlam <zappo@gnu.org>
-;;;       speedbar-insert-texinfo-list no longer sets sthm to nil.
-;;;       speedbar-format-texinfo-list uses new positioned group for
-;;;       any chapter w/ sections (etc)  Also set new
-;;;       speedbar-generic-list-{group-expand|tag}-button-list to
-;;;       nice values.
-;;;
-;;; 1.5 - speedbar-tag-hierarchy-method is set to nil by
-;;;       speedbar-insert-texinfo-list as well as
-;;;       speedbar-fetch-dynamic-texinfo.  This is needed in order to
-;;;       have the texinfo nodes displayed in correct order.
-;;;
-;;; 1.4 - speedbar-tag-hierarchy-method is now set to nil by
-;;;       speedbar-fetch-dynamic-texinfo after making it buffer local
-;;;       first.  I thought this was buffer-local variable alread, but
-;;;       it is not.  Also added installation instruction.
-;;;
-;;; 1.3 - Added bunch of comments in the code as well as installation
-;;;       instruction.  speedbar-texinfo-mode-hook now turns on the
-;;;       speedbar mode.
-;;;
-;;; 1.2 - Use newly created variable speedbar-texinfo-section-regexp rather
-;;;       than texinfo-section-types-regexp, because the latter does not
-;;;       have "top" in it.
-;;;
-;;;       Also added a hook to texinfo-mode-hook which sets
-;;;       speedbar-tag-hierarchy-method to nil at Eric Ludlam's
-;;;       suggestion.
-;;;
-;;; 1.1 - first draft sent to Eric. on June 16, 2000.
-
-;;; Code:
-
-(require 'speedbar)
-
-;; GNU Emacs 20.7 comes with speedbar 0.8.1 bundled which does not work
-;; with sb-texinfo.  Lacking speedbar-version variable, check whether
-;; speedbar-dynamic-tags-function-list is bound which was introduced after
-;; 0.8.1.
-(or (boundp 'speedbar-dynamic-tags-function-list)
-    (error "Speedbar 0.11 or newer is required to use sb-texinfo."))
-
-;; Attach these new functions to handle texinfo-mode.
-(add-to-list 'speedbar-dynamic-tags-function-list
-	     '(speedbar-fetch-dynamic-texinfo . speedbar-insert-texinfo-list))
-
-;; speedbar-texinfo-section-regexp is same as texinfo-section-types-regexp
-;; except that it has "top" entry.
-(defconst speedbar-texinfo-section-regexp
-  "^@\\(top \\|chapter \\|sect\\|subs\\|subh\\|unnum\\|major\\|chapheading \\|heading \\|appendix\\)")
-
-(defun speedbar-fetch-dynamic-texinfo ( filename )
-  "This returns t if the major mode of the current buffer is not 'texinfo-mode.
-If it is 'texinfo-mode, then this returns a list where each element is
-(LEVEL NAME . MARKER).
-LEVEL is 0, 1, 2, or 3 corresponding to chapter section,
-subsection, and subsubsection respectively.
-NAME is the name of the node.
-MARKER is emacs marker that points to the beginning of the node.
-The elements in the the list returned are in ascending order of the MARKER.
-This function along with it's parter, speedbar-insert-texinfo-list, are
-designed to be added to the speedbar-dynamic-tags-function-list list."
-  (set-buffer (find-file-noselect filename))
-  (if (not (eq major-mode 'texinfo-mode))
-      t
-    (condition-case nil
-	(save-excursion
-
-	  ;; Set speedbar-tag-hierarchy-method to nil so that
-	  ;; speedbar-create-tag-hierarchy won't reorder the list.
-	  ;; Make it buffer local so that the global value is not touched.
-	  (make-local-variable 'speedbar-tag-hierarchy-method)
-	  (setq speedbar-tag-hierarchy-method nil)
-
-	  (set (make-local-variable
-		'speedbar-generic-list-group-expand-button-type)
-	       'expandtag)
-	  (set (make-local-variable
-		'speedbar-generic-list-tag-button-type)
-	       'statictag)
-
-	  (let ((heading-to-level
-		 '(("top" . 0)
-		   ("chapter" . 0) ("section" . 1)
-		   ("subsection" . 2) ("subsubsection" . 3)
-		   ("unnumbered" . 0) ("unnumberedsec" . 1)
-		   ("unnumberedsubsec" . 2) ("unnumberedsubsubsec" . 3)
-		   ("chapheading" . 0) ("heading" . 1)
-		   ("subheading" . 2) ("subsubheading" . 3)
-		   ("appendix" . 0) ("appendixsec" . 1)
-		   ("appendixsubsec" . 2) ("appendixsubsubsec" . 3)
-		   ("centerchap" . 0) ("majorheading" . 0)))
-		pos-beg title level section alist)
-	    ;; Create a list of all nodes
-	    (goto-char (point-min))
-	    (while (re-search-forward speedbar-texinfo-section-regexp nil t)
-	      (goto-char (1+ (match-beginning 0))) ;right after @
-	      (setq pos-beg (point-marker))
-	      (setq section (symbol-name (read (current-buffer))))
-	      (setq level (cdr (assoc section heading-to-level)))
-	      (setq title (buffer-substring
-			   (progn (skip-chars-forward " \t")
-				  (point))
-			   (progn (skip-chars-forward "^,\n")
-				  (skip-chars-backward " \t")
-				  (point))))
-	      (setq alist (cons (cons level (cons title pos-beg)) alist)))
-	    (nreverse alist)))
-      (error t))))
-
-(defun speedbar-format-texinfo-list ( lst level)
-  "See `speedbar-fetch-dynamic-texinfo' for description of LST.
-LEVEL should be 0 unless this is called recursively.
-This function converts LST from a flat list structure into
-a hierarchical list suitable to be passed on to `speedbar-insert-texinfo-list'.
-This function creates the hierarchical list recursively.
-On first pass all the nodes of each chapter are grouped into a list.
-Then each of these lists are recursively converted so that all nodes
-of each section are grouped together."
-  (let (new-list elem section-list)
-    (while lst
-      (setq section-list (list (cdr (car lst))))
-      (setq lst  (cdr lst))
-      (while (and lst (> (car (car lst)) level))
-	(setq section-list (cons (car lst) section-list))
-	(setq lst  (cdr lst)))
-      (setq new-list (cons (nreverse section-list) new-list)))
-    (setq new-list (nreverse new-list))
-    ;; Each member of new-list is a list of all chapters (on first pass), i.e.,
-    ;; ( ((chap1 marker) (1 sec1 marker) ...)  ((chap2 marker) ...) ... )
-
-    ;; Start recursion.
-    (setq level (1+ level))
-    (mapcar '(lambda (x)
-	       (if (eq (length x) 1)
-		   ;;(cons (car (car x)) x)
-		   (car x)
-		 (let ((head (car x)))
-		   (cons (car head)
-			 (cons (cdr head)
-			       (speedbar-format-texinfo-list
-				(cdr x) level))))))
-	    new-list)))
-
-(defun speedbar-insert-texinfo-list (indent lst)
-  "Insert a list of generic tokens reorganized into chapeters.
-INDENT is the current level of indentation, and LST is the list of tokens."
-  (speedbar-insert-generic-list indent
-				(speedbar-format-texinfo-list lst 0)
-				'speedbar-tag-expand
-				'speedbar-tag-find))
-
-(provide 'sb-texinfo)
-;;; sb-texinfo.el ends here
-
diff --git a/xemacs-packages/lisp/speedbar/sb-w3.el b/xemacs-packages/lisp/speedbar/sb-w3.el
deleted file mode 100644
index e5750918..00000000
--- a/xemacs-packages/lisp/speedbar/sb-w3.el
+++ /dev/null
@@ -1,151 +0,0 @@
-;;; sb-w3 --- Speedbar support for w3.
-
-;; Copyright (C) 1997, 1998, 2001, 2002 Free Software Foundation
-;;
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2.1
-;; Keywords: tags, tools, w3
-;; X-RCS: $Id: sb-w3.el,v 1.9 2002/02/28 16:32:19 zappo 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 author (see below) or write to:
-;;
-;;              The Free Software Foundation, Inc.
-;;              675 Mass Ave.
-;;              Cambridge, MA 02139, USA.
-;;
-;; Please send bug reports, etc. to zappo@gnu.org
-;;
-
-;;; Commentary:
-;;
-;;   Speedbar provides a frame in which files, and locations in
-;; files are displayed.  These functions provide w3 specific support,
-;; showing links and addresses in the side-bar.
-;;
-;;   To enable, add this to your .emacs file.
-;;   (autoload 'w3-speedbar-buttons "sb-w3"
-;;             "W3 specific speedbar button generator.")
-;;
-;;   Load w3-toc to get additional tags which represent the major
-;;   headers in a given web page.
-;;
-;;   This file requires speedbar.
-
-;;; Change log:
-;; 0.1   - first revision copied from speedbspec.el V 0.1.1
-;; 0.1.1 - Removed dependency on speedbspec
-;; 0.2   - T.V.Raman's addition using newer w3, and w3 imenu.
-;; 0.2.1 - Added new keymap support
-
-;;; Code:
-(eval-and-compile
-  (condition-case nil
-      (require 'w3-imenu)
-    (error nil)))
-(require 'cl)
-(require 'speedbar)
-
-(defvar w3-speedbar-last-buffer nil
-  "The last buffer shown by w3-speedbar.")
-
-(defvar w3-speedbar-key-map nil
-  "Keymap used when in the w3 display mode.")
-
-(if w3-speedbar-key-map
-    nil
-  (setq w3-speedbar-key-map (speedbar-make-specialized-keymap))
-
-  ;; Basic features.
-  (define-key w3-speedbar-key-map "e" 'speedbar-edit-line)
-  (define-key w3-speedbar-key-map "r" 'speedbar-edit-line)
-  (define-key w3-speedbar-key-map "\C-m" 'speedbar-edit-line)
-  )
-
-(defvar w3-speedbar-menu-items
-  '(["Jump to link" speedbar-edit-line t]
-    )
-  "Extra menu items for w3 mode.")
-
-;;;###autoload
-(defun w3-speedbar-buttons (buffer)
-  "Create speedbar buttons for the current web BUFFER displayed in w3 mode."
-  (save-excursion
-    (goto-char (point-min))
-    (if (and (looking-at "History:") (equal w3-speedbar-last-buffer buffer))
-	nil
-      (setq w3-speedbar-last-buffer buffer)
-      (erase-buffer)
-      (let ((links (save-excursion (set-buffer buffer)
-                                   (w3-only-links)))
-            (toc (save-excursion
-                   (set-buffer buffer) imenu--index-alist))
-	    (part nil))
-	(insert "History:\n")
-	;; This taken out of w3 which was used to create the history list,
-	;; and is here modified to create the speedbar buttons
-	(cl-maphash
-	 (function
-	  (lambda (url desc)
-	    (speedbar-insert-button (w3-speedbar-shorten-button url)
-				    'speedbar-directory-face 'highlight
-				    'w3-speedbar-link url)))
-	 url-history-list)
-	(insert "Links:\n")
-	(while links
-	  (setq part (car (cdr (member ':href (car links))))
-		links (cdr links))
-          (when part 
-            (speedbar-insert-button (w3-speedbar-shorten-button part)
-                                    'speedbar-file-face 'highlight
-                                    'w3-speedbar-link
-                                    part)))
-	(if (not (featurep 'w3-imenu))
-	    nil
-	  (insert (format "Contents: %d\n" (length toc)))
-	  (loop for e in toc do
-		(when (car e)
-		  (speedbar-insert-button  (car e)
-					   'bold 'highlight
-					   'w3-speedbar-goto-marker
-					   (cdr e)
-					   'prevline))))))))
-
-(defun w3-speedbar-goto-marker (txt marker indent)
-  "Speedbar callback function for jumping to a marker in a w3 buffer.
-TXT is unused.  MARKER is the location.  INDENT is unused."
-  (pop-to-buffer (marker-buffer marker))
-  (goto-char (marker-position marker)))
-    
-(defun w3-speedbar-shorten-button (button)
-  "Takes text BUTTON and shortens it as much as possible."
-  ;; I should make this more complex, but I'm not sure
-  ;; how...
-  (when button 
-    (let ((fnnd (file-name-nondirectory button)))
-      (if (< 0 (length fnnd))
-	  fnnd
-	(if (string-match "\\(ht\\|f\\)tp://" button)
-	    (setq button (substring button (match-end 0))))
-	(if (string-match "/$" button)
-	    (setq button (substring button 0 (match-beginning 0))))
-	button))))
-
-(defun w3-speedbar-link (text token indent)
-  "Follow link described by TEXT which has the URL TOKEN.
-INDENT is not used."
-  (speedbar-with-attached-buffer (w3-fetch token)))
-
-(provide 'sb-w3)
-;;; sb-w3.el ends here
diff --git a/xemacs-packages/lisp/speedbar/speedbar.el b/xemacs-packages/lisp/speedbar/speedbar.el
deleted file mode 100644
index 074fb7fd..00000000
--- a/xemacs-packages/lisp/speedbar/speedbar.el
+++ /dev/null
@@ -1,3952 +0,0 @@
-;;; speedbar --- quick access to files and tags in a frame
-
-;;; Copyright (C) 1996, 97, 98, 99, 00, 01, 02 Free Software Foundation
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Keywords: file, tags, tools
-;; X-RCS: $Id: speedbar.el,v 1.13 2002/08/09 22:08:30 youngs Exp $
-
-(defvar speedbar-version "0.14beta4"
-  "The current version of speedbar.")
-
-;; 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:
-;;
-;;   The speedbar provides a frame in which files, and locations in
-;; files are displayed.  These items can be clicked on with mouse-2
-;; in order to make the last active frame display that file location.
-;;
-;;; Customizing and Developing for speedbar
-;;
-;; Please see the speedbar manual for informaion.
-;;
-;;; Notes:
-;;
-;;    Users of really old emacsen without the need timer functions
-;; will not have speedbar updating automatically.  Use "g" to refresh
-;; the display after changing directories.  Remember, do not interrupt
-;; the stealthy updates or your display may not be completely
-;; refreshed.
-;;
-;;    AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
-;; well.  Use the imenu keywords from tex-mode.el for better results.
-;;
-;; This file requires the library package assoc (association lists)
-;;     assoc should be available in all modern versions of Emacs.
-;; The custom package is optional (for easy configuration of speedbar)
-;;     http://www.dina.kvl.dk/~abraham/custom/
-;;     custom is available in all versions of Emacs version 20 or better.
-;;
-
-;;; TODO:
-;; - More functions to create buttons and options
-;; - Timeout directories we haven't visited in a while.
-
-(require 'assoc)
-(require 'easymenu)
-(require 'dframe)
-(require 'sb-image)
-
-;; customization stuff
-(defgroup speedbar nil
-  "File and tag browser frame."
-  :group 'tags
-;  :group 'tools
-;  :group 'convenience
-;  :version "20.3"
-  )
-
-(defgroup speedbar-faces nil
-  "Faces used in speedbar."
-  :prefix "speedbar-"
-  :group 'speedbar
-  :group 'faces)
-
-(defgroup speedbar-vc nil
-  "Version control display in speedbar."
-  :prefix "speedbar-"
-  :group 'speedbar)
-
-;;; Code:
-(defvar speedbar-initial-expansion-mode-alist
-  '(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
-     speedbar-buffer-buttons)
-    ("quick buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
-     speedbar-buffer-buttons-temp)
-    ;; Files last, means first in the Displays menu
-    ("files" speedbar-easymenu-definition-special speedbar-file-key-map
-     speedbar-directory-buttons speedbar-default-directory-list)
-    )
-  "List of named expansion elements for filling the speedbar frame.
-These expansion lists are only valid for regular files.  Special modes
-still get to override this list on a mode-by-mode basis.  This list of
-lists is of the form (NAME MENU KEYMAP FN1 FN2 ...).  NAME is a string
-representing the types of things to be displayed.  MENU is an easymenu
-structure used when in this mode.  KEYMAP is a local keymap to install
-over the regular speedbar keymap.  FN1 ...  are functions that will be
-called in order.  These functions will always get the default
-directory to use passed in as the first parameter, and a 0 as the
-second parameter.  The 0 indicates the uppermost indentation level.
-They must assume that the cursor is at the position where they start
-inserting buttons.")
-
-(defvar speedbar-initial-expansion-list-name "files"
-  "A symbol name representing the expansion list to use.
-The expansion list `speedbar-initial-expansion-mode-alist' contains
-the names and associated functions to use for buttons in speedbar.")
-
-(defvar speedbar-previously-used-expansion-list-name "files"
-  "Save the last expansion list method.
-This is used for returning to a previous expansion list method when
-the user is done with the current expansion list.")
-
-(defvar speedbar-stealthy-function-list
-  '(("files"
-     speedbar-update-current-file
-     speedbar-check-read-only
-     speedbar-check-vc
-     speedbar-check-objects)
-    )
-  "List of functions to periodically call stealthily.
-This list is of the form:
- '( (\"NAME\" FUNCTION ...)
-    ...)
-where NAME is the name of the major display mode these functions are
-for, and the remaining elements FUNCTION are functions to call in order.
-Each function must return nil if interrupted, or t if completed.
-Stealthy functions which have a single operation should always return
-t.  Functions which take a long time should maintain a state (where
-they are in their speedbar related calculations) and permit
-interruption.  See `speedbar-check-vc' as a good example.")
-
-(defvar speedbar-mode-functions-list
-  '(("files" (speedbar-item-info . speedbar-files-item-info)
-     (speedbar-line-path . speedbar-files-line-path))
-    ("buffers" (speedbar-item-info . speedbar-buffers-item-info)
-     (speedbar-line-path . speedbar-buffers-line-path))
-    ("quick buffers" (speedbar-item-info . speedbar-buffers-item-info)
-     (speedbar-line-path . speedbar-buffers-line-path))
-    )
-  "List of function tables to use for different major display modes.
-It is not necessary to define any functions for a specialized mode.
-This just provides a simple way of adding lots of customizations.
-Each sublist is of the form:
-  (\"NAME\" (FUNCTIONSYMBOL . REPLACEMENTFUNCTION) ...)
-Where NAME is the name of the specialized mode.  The rest of the list
-is a set of dotted pairs of the form FUNCTIONSYMBOL, which is the name
-of a function you would like to replace, and REPLACEMENTFUNCTION,
-which is a function you can call instead.  Not all functions can be
-replaced this way.  Replaceable functions must provide that
-functionality individually.")
-
-(defcustom speedbar-mode-specific-contents-flag t
-  "*Non-nil means speedbar will show special mode contents.
-This permits some modes to create customized contents for the speedbar
-frame."
-  :group 'speedbar
-  :type 'boolean)
-
-(defcustom speedbar-query-confirmation-method 'all
-  "*Query control for file operations.
-The 'always flag means to always query before file operations.
-The 'none-but-delete flag means to not query before any file
-operations, except before a file deletion."
-  :group 'speedbar
-  :type '(radio (const :tag "Always Query before some file operations."
-		       all)
-		(const :tag "Never Query before file operations, except for deletions."
-		       none-but-delete)
-;;;;		(const :tag "Never Every Query."
-;;;;		       none)
-		))
-
-(defvar speedbar-special-mode-expansion-list nil
-  "Default function list for creating specialized button lists.
-This list is set by modes that wish to have special speedbar displays.
-The list is of function names.  Each function is called with one
-parameter BUFFER, the originating buffer.  The current buffer is the
-speedbar buffer.")
-
-(defvar speedbar-special-mode-key-map nil
-  "Default keymap used when identifying a specialized display mode.
-This keymap is local to each buffer that wants to define special keybindings
-effective when it's display is shown.")
-
-(defcustom speedbar-visiting-file-hook nil
-  "*Hooks run when speedbar visits a file in the selected frame."
-  :group 'speedbar
-  :type 'hook)
-
-(defcustom speedbar-visiting-tag-hook '(speedbar-highlight-one-tag-line)
-  "*Hooks run when speedbar visits a tag in the selected frame."
-  :group 'speedbar
-  :type 'hook
-  :options '(speedbar-highlight-one-tag-line
-	     speedbar-recenter-to-top
-	     speedbar-recenter
-	     ))
-
-(defcustom speedbar-load-hook nil
-  "*Hooks run when speedbar is loaded."
-  :group 'speedbar
-  :type 'hook)
-
-(defcustom speedbar-reconfigure-keymaps-hook nil
-  "*Hooks run when the keymaps are regenerated."
-  :group 'speedbar
-  :type 'hook)
-
-(defcustom speedbar-show-unknown-files nil
-  "*Non-nil show files we can't expand with a ? in the expand button.
-nil means don't show the file in the list."
-  :group 'speedbar
-  :type 'boolean)
-
-;;; EVENTUALLY REMOVE THESE
-
-;; When I moved to a repeating timer, I had the horrible missfortune
-;; of loosing the ability for adaptive speed choice.  This update
-;; speed currently causes long delays when it should have been turned off.
-(defvar speedbar-update-speed dframe-update-speed
-  "*Obsoleted variable.  Use `dframe-update-speed'.")
-
-(defvar speedbar-navigating-speed dframe-update-speed
-  "*Obsoleted variable.  Use `dframe-update-speed'.")
-;;; END REMOVE THESE
-
-(defcustom speedbar-frame-parameters '((minibuffer . nil)
-				       (width . 20)
-				       (border-width . 0)
-				       (menu-bar-lines . 0)
-				       (tool-bar-lines . 0)
-				       (unsplittable . t))
-  "*Parameters to use when creating the speedbar frame in Emacs.
-Any parameter supported by a frame may be added.  The parameter `height'
-will be initialized to the height of the frame speedbar is
-attached to and added to this list before the new frame is initialized."
-  :group 'speedbar
-  :type '(repeat (sexp :tag "Parameter:")))
-
-;; These values by Hrvoje Niksic <hniksic@srce.hr>
-(defcustom speedbar-frame-plist
-  '(minibuffer nil width 20 border-width 0
-	       internal-border-width 0 unsplittable t
-	       default-toolbar-visible-p nil has-modeline-p nil
-	       menubar-visible-p nil
-	       default-gutter-visible-p nil)
-  "*Parameters to use when creating the speedbar frame in XEmacs.
-Parameters not listed here which will be added automatically are
-`height' which will be initialized to the height of the frame speedbar
-is attached to."
-  :group 'speedbar
-  :type '(repeat (group :inline t
-			(symbol :tag "Property")
-			(sexp :tag "Value"))))
-
-(defcustom speedbar-use-imenu-flag (stringp (locate-library "imenu"))
-  "*Non-nil means use imenu for file parsing.  nil to use etags.
-XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
-use etags instead.  Etags support is not as robust as imenu support."
-  :tag "Use Imenu for tags"
-  :group 'speedbar
-  :type 'boolean)
-
-(defvar speedbar-dynamic-tags-function-list
-  '((speedbar-fetch-dynamic-imenu . speedbar-insert-imenu-list)
-    (speedbar-fetch-dynamic-etags . speedbar-insert-etags-list))
-  "Set to a functions which will return and insert a list of tags.
-Each element is of the form ( FETCH .  INSERT ) where FETCH
-is a funciotn which takes one parameter (the file to tag) and returns a
-list of tags.  The tag list can be of any form as long as the
-corresponding insert method can handle it.  If it returns t, then an
-error occured, and the next fetch routine is tried.
-INSERT is a function which takes an INDENTation level, and a LIST of
-tags to insert.  It will then create the speedbar buttons.")
-
-(defcustom speedbar-use-tool-tips-flag (and (not (featurep 'xemacs))
-				       (>= emacs-major-version 21))
-  "*Non-nil means to use tool tips if they are avaialble.
-When tooltips are not available, mouse-tracking and minibuffer
-display is used instead."
-  :group 'speedbar
-  :type 'boolean)
-
-(defcustom speedbar-track-mouse-flag (not speedbar-use-tool-tips-flag)
-  "*Non-nil means to display info about the line under the mouse."
-  :group 'speedbar
-  :type 'boolean)
-
-(defcustom speedbar-sort-tags nil
-  "*If Non-nil, sort tags in the speedbar display.  *Obsolete*.
-Use `semantic-tag-hierarchy-method' instead."
-  :group 'speedbar
-  :type 'boolean)
-
-(defcustom speedbar-tag-hierarchy-method
-  '(speedbar-prefix-group-tag-hierarchy
-    speedbar-trim-words-tag-hierarchy)
-  "*List of hooks which speedbar will use to organize tags into groups.
-Groups are defined as expandable meta-tags.  Imenu supports
-such things in some languages, such as separating variables from
-functions.  Each hook takes one argument LST, and may destructivly
-create a new list of the same form.  LST is a list of elements of the
-form:
-  (ELT1 ELT2 ... ELTn)
-where each ELT is of the form
-  (TAG-NAME-STRING . NUMBER-OR-MARKER)
-or
-  (GROUP-NAME-STRING ELT1 EL2... ELTn)"
-  :group 'speedbar
-  :type 'hook
-  :options '(speedbar-prefix-group-tag-hierarchy
-	     speedbar-trim-words-tag-hierarchy
-	     speedbar-simple-group-tag-hierarchy
-	     speedbar-sort-tag-hierarchy)
-  )
-
-(defcustom speedbar-tag-group-name-minimum-length 4
-  "*The minimum length of a prefix group name before expanding.
-Thus, if the `speedbar-tag-hierarchy-method' includes `prefix-group'
-and one such groups common characters is less than this number of
-characters, then the group name will be changed to the form of:
-  worda to wordb
-instead of just
-  word
-This way we won't get silly looking listings."
-  :group 'speedbar
-  :type 'integer)
-
-(defcustom speedbar-tag-split-minimum-length 20
-  "*Minimum length before we stop trying to create sub-lists in tags.
-This is used by all tag-hierarchy methods that break large lists into
-sub-lists."
-  :group 'speedbar
-  :type 'integer)
-
-(defcustom speedbar-tag-regroup-maximum-length 10
-  "*Maximum length of submenus that are regrouped.
-If the regrouping option is used, then if two or more short subgroups
-are next to each other, then they are combined until this number of
-items is reached."
-  :group 'speedbar
-  :type 'integer)
-
-(defcustom speedbar-directory-button-trim-method 'span
-  "*Indicates how the directory button will be displayed.
-Possible values are:
- 'span - span large directories over multiple lines.
- 'trim - trim large directories to only show the last few.
- nil   - no trimming."
-  :group 'speedbar
-  :type '(radio (const :tag "Span large directories over mutiple lines."
-		       span)
-		(const :tag "Trim large directories to only show the last few."
-		       trim)
-		(const :tag "No trimming." nil)))
-
-(defcustom speedbar-smart-directory-expand-flag t
-  "*Non-nil means speedbar should use smart expansion.
-Smart expansion only affects when speedbar wants to display a
-directory for a file in the attached frame.  When smart expansion is
-enabled, new directories which are children of a displayed directory
-are expanded in the current framework.  If nil, then the current
-hierarchy would be replaced with the new directory."
-  :group 'speedbar
-  :type 'boolean)
-
-(defcustom speedbar-indentation-width 1
-  "*When sub-nodes are expanded, the number of spaces used for indentation."
-  :group 'speedbar
-  :type 'integer)
-
-(defcustom speedbar-hide-button-brackets-flag nil
-  "*Non-nil means speedbar will hide the brackets around the + or -."
-  :group 'speedbar
-  :type 'boolean)
-
-(defcustom speedbar-before-popup-hook nil
-  "*Hooks called before popping up the speedbar frame."
-  :group 'speedbar
-  :type 'hook)
-
-(defcustom speedbar-after-create-hook '(speedbar-frame-reposition-smartly)
-  "*Hooks called before popping up the speedbar frame."
-  :group 'speedbar
-  :type 'hook)
-
-(defcustom speedbar-before-delete-hook nil
-  "*Hooks called before deleting the speedbar frame."
-  :group 'speedbar
-  :type 'hook)
-
-(defcustom speedbar-mode-hook nil
-  "*Hooks called after creating a speedbar buffer."
-  :group 'speedbar
-  :type 'hook)
-
-(defcustom speedbar-timer-hook nil
-  "*Hooks called after running the speedbar timer function."
-  :group 'speedbar
-  :type 'hook)
-
-(defcustom speedbar-verbosity-level 1
-  "*Verbosity level of the speedbar.  0 means say nothing.
-1 means medium level verbosity.  2 and higher are higher levels of
-verbosity."
-  :group 'speedbar
-  :type 'integer)
-
-(defvar speedbar-indicator-separator " "
-  "String separating file text from indicator characters.")
-
-(defcustom speedbar-vc-do-check t
-  "*Non-nil check all files in speedbar to see if they have been checked out.
-Any file checked out is marked with `speedbar-vc-indicator'"
-  :group 'speedbar-vc
-  :type 'boolean)
-
-(defvar speedbar-vc-indicator "*"
-  "Text used to mark files which are currently checked out.
-Other version control systems can be added by examining the function
-`speedbar-vc-path-enable-hook' and `speedbar-vc-in-control-hook'.")
-
-(defcustom speedbar-vc-path-enable-hook nil
-  "*Return non-nil if the current path should be checked for Version Control.
-Functions in this hook must accept one parameter which is the path
-being checked."
-  :group 'speedbar-vc
-  :type 'hook)
-
-(defcustom speedbar-vc-in-control-hook nil
-  "*Return non-nil if the specified file is under Version Control.
-Functions in this hook must accept two parameters.  The PATH of the
-current file, and the FILENAME of the file being checked."
-  :group 'speedbar-vc
-  :type 'hook)
-
-(defvar speedbar-vc-to-do-point nil
-  "Local variable maintaining the current version control check position.")
-
-(defcustom speedbar-obj-do-check t
-  "*Non-nil check all files in speedbar to see if they have an object file.
-Any file checked out is marked with `speedbar-obj-indicator', and the
-marking is based on  `speedbar-obj-alist'"
-  :group 'speedbar-vc
-  :type 'boolean)
-
-(defvar speedbar-obj-to-do-point nil
-  "Local variable maintaining the current version control check position.")
-
-(defvar speedbar-obj-indicator '("#" . "!")
-  "Text used to mark files that have a corresponding hidden object file.
-The car is for an up-to-date object.  The cdr is for an out of date object.
-The expression `speedbar-obj-alist' defines who gets tagged.")
-
-(defvar speedbar-obj-alist
-  '(("\\.\\([cpC]\\|cpp\\|cc\\|cxx\\)$" . ".o")
-    ("\\.el$" . ".elc")
-    ("\\.java$" . ".class")
-    ("\\.f\\(or\\|90\\|77\\)?$" . ".o")
-    ("\\.tex$" . ".dvi")
-    ("\\.texi$" . ".info"))
-  "Alist of file extensions, and their corresponding object file type.")
-
-(defvar speedbar-ro-to-do-point nil
-  "Local variable maintaining the current read only check position.")
-
-(defvar speedbar-object-read-only-indicator "%"
-  "Indicator to append onto a line if that item is Read Only.")
-
-(defvar speedbar-indicator-regex
-  (concat (regexp-quote speedbar-indicator-separator)
-	  "\\("
-	  (regexp-quote speedbar-vc-indicator)
-	  "\\|"
-	  (regexp-quote (car speedbar-obj-indicator))
-	  "\\|"
-	  (regexp-quote (cdr speedbar-obj-indicator))
-	  "\\|"
-	  (regexp-quote speedbar-object-read-only-indicator)
-	  "\\)*")
-  "Regular expression used when identifying files.
-Permits stripping of indicator characters from a line.")
-
-(defcustom speedbar-scanner-reset-hook nil
-  "*Hook called whenever generic scanners are reset.
-Set this to implement your own scanning / rescan safe functions with
-state data."
-  :group 'speedbar
-  :type 'hook)
-
-(defvar speedbar-ignored-modes '(fundamental-mode)
-  "*List of major modes which speedbar will not switch directories for.")
-
-(defun speedbar-extension-list-to-regex (extlist)
-  "Takes EXTLIST, a list of extensions and transforms it into regexp.
-All the preceding `.' are stripped for an optimized expression starting
-with `.' followed by extensions, followed by full-filenames."
-  (let ((regex1 nil) (regex2 nil))
-    (while extlist
-      (if (= (string-to-char (car extlist)) ?.)
-	  (setq regex1 (concat regex1 (if regex1 "\\|" "")
-			       (substring (car extlist) 1)))
-	(setq regex2 (concat regex2 (if regex2 "\\|" "") (car extlist))))
-      (setq extlist (cdr extlist)))
-    ;; concat all the sub-exressions together, making sure all types
-    ;; of parts exist during concatination.
-    (concat "\\("
-	    (if regex1 (concat "\\(\\.\\(" regex1 "\\)\\)") "")
-	    (if (and regex1 regex2) "\\|" "")
-	    (if regex2 (concat "\\(" regex2 "\\)") "")
-	    "\\)$")))
-
-(defvar speedbar-ignored-path-regexp nil
-  "Regular expression matching paths speedbar will not switch to.
-Created from `speedbar-ignored-path-expressions' with the function
-`speedbar-extension-list-to-regex' (A misnamed function in this case.)
-Use the function `speedbar-add-ignored-path-regexp', or customize the
-variable `speedbar-ignored-path-expressions' to modify this variable.")
-
-(defcustom speedbar-ignored-path-expressions
-  '("[/\\]logs?[/\\]\\'")
-  "*List of regular expressions matching directories speedbar will ignore.
-They should included paths to directories which are notoriously very
-large and take a long time to load in.  Use the function
-`speedbar-add-ignored-path-regexp' to add new items to this list after
-speedbar is loaded.  You may place anything you like in this list
-before speedbar has been loaded."
-  :group 'speedbar
-  :type '(repeat (regexp :tag "Path Regexp"))
-  :set (lambda (sym val)
-	 (setq speedbar-ignored-path-expressions val
-	       speedbar-ignored-path-regexp
-	       (speedbar-extension-list-to-regex val))))
-
-(defcustom speedbar-directory-unshown-regexp "^\\(CVS\\|RCS\\|SCCS\\|\\..*\\)\\'"
-  "*Regular expression matching directories not to show in speedbar.
-They should include commonly existing directories which are not
-useful, such as version control."
-  :group 'speedbar
-  :type 'string)
-
-(defvar speedbar-file-unshown-regexp
-  (let ((nstr "") (noext completion-ignored-extensions))
-    (while noext
-      (setq nstr (concat nstr (regexp-quote (car noext)) "\\'"
-			 (if (cdr noext) "\\|" ""))
-	    noext (cdr noext)))
-    ;;               backup      refdir      lockfile
-    (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'\\|\\.#"))
-  "*Regexp matching files we don't want displayed in a speedbar buffer.
-It is generated from the variable `completion-ignored-extensions'")
-
-;; this is dangerous to customize, because the defaults will probably
-;; change in the future.
-(defcustom speedbar-supported-extension-expressions
-  (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?"
-	    ".el" ".emacs" ".l" ".lsp" ".p" ".java" ".f\\(90\\|77\\|or\\)?")
-	  (if speedbar-use-imenu-flag
-	      '(".ada" ".p[lm]" ".tcl" ".m" ".scm" ".pm" ".py" ".g"
-		;; html is not supported by default, but an imenu tags package
-		;; is available.  Also, html files are nice to be able to see.
-		".s?html"
-		".ma?k" "[Mm]akefile\\(\\.in\\)?")))
-  "*List of regular expressions which will match files supported by tagging.
-Do not prefix the `.' char with a double \\ to quote it, as the period
-will be stripped by a simplified optimizer when compiled into a
-singular expression.  This variable will be turned into
-`speedbar-file-regexp' for use with speedbar.  You should use the
-function `speedbar-add-supported-extension' to add a new extension at
-runtime, or use the configuration dialog to set it in your .emacs
-file.
-If you add an extension to this list, and it does not appear, you may
-need to also modify `completion-ignored-extension' which will also help
-file completion."
-  :group 'speedbar
-  :type '(repeat (regexp :tag "Extension Regexp"))
-  :set (lambda (sym val)
-	 (setq speedbar-supported-extension-expressions val
-	       speedbar-file-regexp (speedbar-extension-list-to-regex val)))
-  )
-
-(defvar speedbar-file-regexp
-  (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
-  "Regular expression matching files we know how to expand.
-Created from `speedbar-supported-extension-expression' with the
-function `speedbar-extension-list-to-regex'")
-
-(defun speedbar-add-supported-extension (extension)
-  "Add EXTENSION as a new supported extension for speedbar tagging.
-This should start with a `.' if it is not a complete file name, and
-the dot should NOT be quoted in with \\.  Other regular expression
-matchers are allowed however.  EXTENSION may be a single string or a
-list of strings."
-  (interactive "sExtionsion: ")
-  (if (not (listp extension)) (setq extension (list extension)))
-  (while extension
-    (if (member (car extension) speedbar-supported-extension-expressions)
-	nil
-      (setq speedbar-supported-extension-expressions
-	    (cons (car extension) speedbar-supported-extension-expressions)))
-    (setq extension (cdr extension)))
-  (setq speedbar-file-regexp (speedbar-extension-list-to-regex
-			      speedbar-supported-extension-expressions)))
-
-(defun speedbar-add-ignored-path-regexp (path-expression)
-  "Add PATH-EXPRESSION as a new ignored path for speedbar tracking.
-This function will modify `speedbar-ignored-path-regexp' and add
-PATH-EXPRESSION to `speedbar-ignored-path-expressions'."
-  (interactive "sPath regex: ")
-  (if (not (listp path-expression))
-      (setq path-expression (list path-expression)))
-  (while path-expression
-    (if (member (car path-expression) speedbar-ignored-path-expressions)
-	nil
-      (setq speedbar-ignored-path-expressions
-	    (cons (car path-expression) speedbar-ignored-path-expressions)))
-    (setq path-expression (cdr path-expression)))
-  (setq speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
-				      speedbar-ignored-path-expressions)))
-
-;; If we don't have custom, then we set it here by hand.
-(if (not (fboundp 'custom-declare-variable))
-    (setq speedbar-file-regexp (speedbar-extension-list-to-regex
-				speedbar-supported-extension-expressions)
-	  speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
-					speedbar-ignored-path-expressions)))
-
-(defvar speedbar-update-flag dframe-have-timer-flag
-  "*Non-nil means to automatically update the display.
-When this is nil then speedbar will not follow the attached frame's path.
-When speedbar is active, use:
-
-\\<speedbar-key-map> `\\[speedbar-toggle-updates]'
-
-to toggle this value.")
-
-(defvar speedbar-update-flag-disable nil
-  "Permanently disable changing of the update flag.")
-
-(defvar speedbar-syntax-table nil
-  "Syntax-table used on the speedbar.")
-
-(if speedbar-syntax-table
-    nil
-  (setq speedbar-syntax-table (make-syntax-table))
-  ;; turn off paren matching around here.
-  (modify-syntax-entry ?\' " " speedbar-syntax-table)
-  (modify-syntax-entry ?\" " " speedbar-syntax-table)
-  (modify-syntax-entry ?( " " speedbar-syntax-table)
-  (modify-syntax-entry ?) " " speedbar-syntax-table)
-  (modify-syntax-entry ?{ " " speedbar-syntax-table)
-  (modify-syntax-entry ?} " " speedbar-syntax-table)
-  (modify-syntax-entry ?[ " " speedbar-syntax-table)
-  (modify-syntax-entry ?] " " speedbar-syntax-table))
-
-(defvar speedbar-key-map nil
-  "Keymap used in speedbar buffer.")
-
-(if speedbar-key-map
-    nil
-  (setq speedbar-key-map (make-keymap))
-  (suppress-keymap speedbar-key-map t)
-
-  ;; control
-  (define-key speedbar-key-map "t" 'speedbar-toggle-updates)
-  (define-key speedbar-key-map "g" 'speedbar-refresh)
-
-  ;; navigation
-  (define-key speedbar-key-map "n" 'speedbar-next)
-  (define-key speedbar-key-map "p" 'speedbar-prev)
-  (define-key speedbar-key-map "\M-n" 'speedbar-restricted-next)
-  (define-key speedbar-key-map "\M-p" 'speedbar-restricted-prev)
-  (define-key speedbar-key-map "\C-\M-n" 'speedbar-forward-list)
-  (define-key speedbar-key-map "\C-\M-p" 'speedbar-backward-list)
-;; These commands never seemed useful.
-;;  (define-key speedbar-key-map " " 'speedbar-scroll-up)
-;;  (define-key speedbar-key-map [delete] 'speedbar-scroll-down)
-
-  ;; Short cuts I happen to find useful
-  (define-key speedbar-key-map "r"
-    (lambda () (interactive)
-      (speedbar-change-initial-expansion-list
-       speedbar-previously-used-expansion-list-name)))
-  (define-key speedbar-key-map "b"
-    (lambda () (interactive)
-      (speedbar-change-initial-expansion-list "quick buffers")))
-  (define-key speedbar-key-map "f"
-    (lambda () (interactive)
-      (speedbar-change-initial-expansion-list "files")))
-
-  (dframe-update-keymap speedbar-key-map)
-)
-
-(defun speedbar-make-specialized-keymap ()
-  "Create a keymap for use w/ a speedbar major or minor display mode.
-This basically creates a sparse keymap, and makes it's parent be
-`speedbar-key-map'."
-  (let ((k (make-sparse-keymap)))
-    (set-keymap-parent k speedbar-key-map)
-    k))
-
-(defvar speedbar-file-key-map nil
-  "Keymap used in speedbar buffer while files are displayed.")
-
-(if speedbar-file-key-map
-    nil
-  (setq speedbar-file-key-map (speedbar-make-specialized-keymap))
-
-  ;; Basic tree features
-  (define-key speedbar-file-key-map "e" 'speedbar-edit-line)
-  (define-key speedbar-file-key-map "\C-m" 'speedbar-edit-line)
-  (define-key speedbar-file-key-map "+" 'speedbar-expand-line)
-  (define-key speedbar-file-key-map "=" 'speedbar-expand-line)
-  (define-key speedbar-file-key-map "-" 'speedbar-contract-line)
-
-  (define-key speedbar-file-key-map " " 'speedbar-toggle-line-expansion)
-
-  ;; file based commands
-  (define-key speedbar-file-key-map "U" 'speedbar-up-directory)
-  (define-key speedbar-file-key-map "I" 'speedbar-item-info)
-  (define-key speedbar-file-key-map "B" 'speedbar-item-byte-compile)
-  (define-key speedbar-file-key-map "L" 'speedbar-item-load)
-  (define-key speedbar-file-key-map "C" 'speedbar-item-copy)
-  (define-key speedbar-file-key-map "D" 'speedbar-item-delete)
-  (define-key speedbar-file-key-map "O" 'speedbar-item-object-delete)
-  (define-key speedbar-file-key-map "R" 'speedbar-item-rename)
-  (define-key speedbar-file-key-map "M" 'speedbar-create-directory)
-  )
-
-(defvar speedbar-easymenu-definition-base
-  (append
-   '("Speedbar"
-     ["Update" speedbar-refresh t]
-     ["Auto Update" speedbar-toggle-updates
-      :active (not speedbar-update-flag-disable)
-      :style toggle :selected speedbar-update-flag])
-   (if (and (or (fboundp 'defimage)
-		(fboundp 'make-image-specifier))
-	    (if (fboundp 'display-graphic-p)
-		(display-graphic-p)
-	      window-system))
-       (list
-	["Use Images" speedbar-toggle-images
-	 :style toggle :selected speedbar-use-images]))
-   )
-  "Base part of the speedbar menu.")
-
-(defvar speedbar-easymenu-definition-special
-  '(["Edit Item On Line" speedbar-edit-line t]
-    ["Show All Files" speedbar-toggle-show-all-files
-     :style toggle :selected speedbar-show-unknown-files]
-    ["Expand File Tags" speedbar-expand-line
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.\\+. "))]
-    ["Flush Cache & Expand" speedbar-flush-expand-line
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.\\+. "))]
-    ["Contract File Tags" speedbar-contract-line
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.-. "))]
-;    ["Sort Tags" speedbar-toggle-sorting
-;     :style toggle :selected speedbar-sort-tags]
-    "----"
-    ["File/Tag Information" speedbar-item-info t]
-    ["Load Lisp File" speedbar-item-load
-     (save-excursion
-       (beginning-of-line)
-       (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\|$\\)"))]
-    ["Byte Compile File" speedbar-item-byte-compile
-     (save-excursion
-       (beginning-of-line)
-       (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\|$\\)"))]
-    ["Copy File" speedbar-item-copy
-     (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]
-    ["Rename File" speedbar-item-rename
-     (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
-    ["Create Directory" speedbar-create-directory
-     (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
-    ["Delete File" speedbar-item-delete
-     (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
-    ["Delete Object" speedbar-item-object-delete
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))]
-    )
-  "Additional menu items while in file-mode.")
- 
-(defvar speedbar-easymenu-definition-trailer
-  (append
-   (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
-       (list ["Customize..." speedbar-customize t]))
-   (list
-    ["Detach" speedbar-detach (and speedbar-frame
-				    (eq (selected-frame) speedbar-frame)) ]
-    ["Close" dframe-close-frame t]
-    ["Quit" delete-frame t] ))
-  "Menu items appearing at the end of the speedbar menu.")
-
-(defvar speedbar-desired-buffer nil
-  "Non-nil when speedbar is showing buttons specific a special mode.
-In this case it is the originating buffer.")
-(defvar speedbar-buffer nil
-  "The buffer displaying the speedbar.")
-(defvar speedbar-frame nil
-  "The frame displaying speedbar.")
-(defvar speedbar-cached-frame nil
-  "The frame that was last created, then removed from the display.")
-(defvar speedbar-full-text-cache nil
-  "The last open directory is saved in its entirety for ultra-fast switching.")
-
-(defvar speedbar-last-selected-file nil
-  "The last file which was selected in speedbar buffer.")
-
-(defvar speedbar-shown-directories nil
-  "Maintain list of directories simultaneously open in the current speedbar.")
-
-(defvar speedbar-directory-contents-alist nil
-  "An association list of directories and their contents.
-Each sublist was returned by `speedbar-file-lists'.  This list is
-maintained to speed up the refresh rate when switching between
-directories.")
-
-(defvar speedbar-power-click nil
-  "Never set this by hand.  Value is t when S-mouse activity occurs.")
-
-
-;;; Compatibility
-;;
-(if (featurep 'xemacs)
-    (progn
-      (defalias 'speedbar-make-overlay 'make-extent)
-      (defalias 'speedbar-overlay-put 'set-extent-property)
-      (defalias 'speedbar-delete-overlay 'delete-extent)
-      (defalias 'speedbar-mode-line-update 'redraw-modeline))
-  (defalias 'speedbar-make-overlay 'make-overlay)
-  (defalias 'speedbar-overlay-put 'overlay-put)
-  (defalias 'speedbar-delete-overlay 'delete-overlay)
-  (defalias 'speedbar-mode-line-update 'force-mode-line-update))
-
-;;; Mode definitions/ user commands
-;;
-
-;;;###autoload
-(defalias 'speedbar 'speedbar-frame-mode)
-;;;###autoload
-(defun speedbar-frame-mode (&optional arg)
-  "Enable or disable speedbar.  Positive ARG means turn on, negative turn off.
-nil means toggle.  Once the speedbar frame is activated, a buffer in
-`speedbar-mode' will be displayed.  Currently, only one speedbar is
-supported at a time.
-`speedbar-before-popup-hook' is called before popping up the speedbar frame.
-`speedbar-before-delete-hook' is called before the frame is deleted."
-  (interactive "P")
-  ;; Get the buffer to play with
-  (if (not (buffer-live-p speedbar-buffer))
-      (save-excursion
-	(setq speedbar-buffer (get-buffer-create " SPEEDBAR"))
-	(set-buffer speedbar-buffer)
-	(speedbar-mode)))
-  ;; Do the frame thing
-  (dframe-frame-mode arg
-		     'speedbar-frame
-		     'speedbar-cached-frame
-		     'speedbar-buffer
-		     "Speedbar"
-		     #'speedbar-frame-mode
-		     (if dframe-xemacsp
-			 speedbar-frame-plist
-		       speedbar-frame-parameters)
-		     speedbar-before-delete-hook
-		     speedbar-before-popup-hook
-		     speedbar-after-create-hook)
-  ;; Start up the timer
-  (if (not speedbar-frame)
-      (speedbar-set-timer nil)
-    (speedbar-reconfigure-keymaps)
-    (speedbar-update-contents)
-    (speedbar-set-timer dframe-update-speed)
-    )
-  ;; Frame modifications
-  (set (make-local-variable 'dframe-delete-frame-function)
-       'speedbar-handle-delete-frame)
-  ;; hscroll
-  (set (make-local-variable 'automatic-hscrolling) nil) ; Emacs 21
-  ;; reset the selection variable
-  (setq speedbar-last-selected-file nil))
-
-(defun speedbar-frame-reposition-smartly ()
-  "Reposition the speedbar frame to be next to the attached frame."
-  (cond ((and dframe-xemacsp
-	      (or (member 'left speedbar-frame-plist)
-		  (member 'top speedbar-frame-plist)))
-	 (dframe-reposition-frame
-	  speedbar-frame
-	  (dframe-attached-frame speedbar-frame)
-	  (cons (car (cdr (member 'left speedbar-frame-plist)))
-		(car (cdr (member 'top speedbar-frame-plist)))))
-	 )
-	((and (not dframe-xemacsp)
-	      (or (assoc 'left speedbar-frame-parameters)
-		  (assoc 'top speedbar-frame-parameters)))
-	 ;; if left/top were specified in the parameters, pass them
-	 ;; down to the reposition function
-	 (dframe-reposition-frame
-	  speedbar-frame
-	  (dframe-attached-frame speedbar-frame)
-	  (cons (cdr (assoc 'left speedbar-frame-parameters))
-		(cdr (assoc 'top  speedbar-frame-parameters))))
-	 )
-	(t
-	 (dframe-reposition-frame speedbar-frame
-				  (dframe-attached-frame speedbar-frame)
-				  'left-right))))
-
-(defun speedbar-detach ()
-  "Detach the current Speedbar from auto-updating.
-Doing this allows the creation of a second speedbar."
-  (interactive)
-  (let ((buffer speedbar-buffer))
-    (dframe-detach 'speedbar-frame 'speedbar-cached-frame 'speedbar-buffer)
-    (save-excursion
-      (set-buffer buffer)
-      ;; Permanently disable auto-updating in this speedbar buffer.
-      (set (make-local-variable 'speedbar-update-flag) nil)
-      (set (make-local-variable 'speedbar-update-flag-disable) t)
-      ;; Make local copies of all the different variables to prevent
-      ;; funny stuff later...
-      )))
-
-(defsubst speedbar-current-frame ()
-  "Return the frame to use for speedbar based on current context."
-  (dframe-current-frame 'speedbar-frame 'speedbar-mode))
-
-(defun speedbar-handle-delete-frame (e)
-  "Handle a delete frame event E.
-If the deleted frame is the frame SPEEDBAR is attached to,
-we need to delete speedbar also."
-  (let ((frame-to-be-deleted (car (car (cdr e)))))
-    (if (eq frame-to-be-deleted dframe-attached-frame)
-	(delete-frame speedbar-frame)))
-  )
-
-;;;###autoload
-(defun speedbar-get-focus ()
-  "Change frame focus to or from the speedbar frame.
-If the selected frame is not speedbar, then speedbar frame is
-selected.  If the speedbar frame is active, then select the attached frame."
-  (interactive)
-  (speedbar-reset-scanners)
-  (dframe-get-focus 'speedbar-frame 'speedbar-frame-mode
-		    (lambda () (let ((speedbar-update-flag t))
-				 (speedbar-timer-fn)))))
-
-(defmacro speedbar-frame-width ()
-  "Return the width of the speedbar frame in characters.
-nil if it doesn't exist."
-  '(frame-width (speedbar-current-frame)))
-
-(defun speedbar-mode ()
-  "Major mode for managing a display of directories and tags.
-\\<speedbar-key-map>
-The first line represents the default path of the speedbar frame.
-Each directory segment is a button which jumps speedbar's default
-directory to that path.  Buttons are activated by clicking `\\[speedbar-click]'.
-In some situations using `\\[dframe-power-click]' is a `power click' which will
-rescan cached items, or pop up new frames.
-
-Each line starting with <+> represents a directory.  Click on the <+>
-to insert the directory listing into the current tree.  Click on the
-<-> to retract that list.  Click on the directory name to go to that
-directory as the default.
-
-Each line starting with [+] is a file.  If the variable
-`speedbar-show-unknown-files' is t, the lines starting with [?] are
-files which don't have imenu support, but are not expressly ignored.
-Files are completely ignored if they match `speedbar-file-unshown-regexp'
-which is generated from `completion-ignored-extensions'.
-
-Files with a `*' character after their name are files checked out of a
-version control system.  (currently only RCS is supported.)  New
-version control systems can be added by examining the documentation
-for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'
-
-Files with a `#' or `!' character after them are source files that
-have an object file associated with them.  The `!' indicates that the
-files is out of date.   You can control what source/object associations
-exist through the variable `speedbar-obj-alist'.
-
-Click on the [+] to display a list of tags from that file.  Click on
-the [-] to retract the list.  Click on the file name to edit the file
-in the attached frame.
-
-If you open tags, you might find a node starting with {+}, which is a
-category of tags.  Click the {+} to expand the category.  Jump-able
-tags start with >.  Click the name of the tag to go to that position
-in the selected file.
-
-\\{speedbar-key-map}"
-  ;; NOT interactive
-  (save-excursion
-    (kill-all-local-variables)
-    (setq major-mode 'speedbar-mode)
-    (setq mode-name "Speedbar")
-    (set-syntax-table speedbar-syntax-table)
-    (setq font-lock-keywords nil) ;; no font-locking please
-    (setq truncate-lines t)
-    (make-local-variable 'frame-title-format)
-    (setq frame-title-format (concat "Speedbar " speedbar-version))
-
-    (toggle-read-only 1)
-    (speedbar-set-mode-line-format)
-    ;; Add in our dframe hooks.
-    (if speedbar-track-mouse-flag
-	(setq dframe-track-mouse-function #'speedbar-track-mouse))
-    (setq dframe-help-echo-function #'speedbar-item-info
-	  dframe-mouse-click-function #'speedbar-click
-	  dframe-mouse-position-function #'speedbar-position-cursor-on-line)
-    (run-hooks 'speedbar-mode-hook))
-  speedbar-buffer)
-
-(defmacro speedbar-message (fmt &rest args)
-  "Like message, but for use in the speedbar frame.
-Argument FMT is the format string, and ARGS are the arguments for message."
-  `(dframe-message ,fmt ,@args))
-
-(defsubst speedbar-y-or-n-p (prompt &optional deleting)
-  "Like `y-or-n-p', but for use in the speedbar frame.
-Argument PROMPT is the prompt to use.
-Optional argument DELETING means this is a query that will delete something.
-The variable `speedbar-query-confirmation-method' can cause this to
-return true without a query."
-  (or (and (not deleting)
-	   (eq speedbar-query-confirmation-method 'none-but-delete))
-      (dframe-y-or-n-p prompt)))
-
-(defsubst speedbar-select-attached-frame ()
-  "Select the frame attached to this speedbar."
-  (dframe-select-attached-frame (speedbar-current-frame)))
-
-;; Backwards compatibility
-(defalias 'speedbar-with-attached-buffer 'dframe-with-attached-buffer)
-(defalias 'speedbar-maybee-jump-to-attached-frame 'dframe-maybee-jump-to-attached-frame)
- 
-(defun speedbar-set-mode-line-format ()
-  "Set the format of the mode line based on the current speedbar environment.
-This gives visual indications of what is up.  It EXPECTS the speedbar
-frame and window to be the currently active frame and window."
-  (if (and (frame-live-p (speedbar-current-frame))
-	   (or (not dframe-xemacsp)
-	       (specifier-instance has-modeline-p))
-	   speedbar-buffer)      (save-excursion
-	(set-buffer speedbar-buffer)
-	(let* ((w (or (speedbar-frame-width) 20))
-	       (p1 "<<")
-	       (p5 ">>")
-	       (p3 (if speedbar-update-flag "#" "!"))
-	       (p35 (capitalize speedbar-initial-expansion-list-name))
-	       (blank (- w (length p1) (length p3) (length p5) (length p35)
-			 (if line-number-mode 5 1)))
-	       (p2 (if (> blank 0)
-		       (make-string (/ blank 2) ? )
-		     ""))
-	       (p4 (if (> blank 0)
-		       (make-string (+ (/ blank 2) (% blank 2)) ? )
-		     ""))
-	       (tf
-		(if line-number-mode
-		    (list (concat p1 p2 p3 " " p35) '(line-number-mode " %3l")
-			  (concat p4 p5))
-		  (list (concat p1 p2 p3 p4 p5)))))
-	  (if (not (equal mode-line-format tf))
-	      (progn
-		(setq mode-line-format tf)
-		(speedbar-mode-line-update)))))))
-
-(defvar speedbar-previous-menu nil
-  "The menu before the last `speedbar-reconfigure-keymaps' was called.")
-
-(defun speedbar-reconfigure-keymaps ()
-  "Reconfigure the menu-bar in a speedbar frame.
-Different menu items are displayed depending on the current display mode
-and the existence of packages."
-  (let ((md (append
-	     speedbar-easymenu-definition-base
-	     (if speedbar-shown-directories
-		 ;; file display mode version
-		 (speedbar-initial-menu)
-	       (save-excursion
-		 (dframe-select-attached-frame speedbar-frame)
-		 (if (local-variable-p
-		      'speedbar-easymenu-definition-special
-		      (current-buffer))
-		     ;; If bound locally, we can use it
-		     speedbar-easymenu-definition-special)))
-	     ;; Dynamic menu stuff
-	     '("-")
-	    (list (cons "Displays"
-			(let ((displays nil)
-			      (alist speedbar-initial-expansion-mode-alist))
-			  (while alist
-			    (setq displays
-				  (cons
-				   (vector
-				    (capitalize (car (car alist)))
-				    (list
-				     'speedbar-change-initial-expansion-list
-				     (car (car alist)))
-				    :style 'radio
-				    :selected
-				    `(string= ,(car (car alist))
-					 speedbar-initial-expansion-list-name)
-				    )
-				   displays))
-			    (setq alist (cdr alist)))
-			  displays)))
-	    ;; The trailer
-	    speedbar-easymenu-definition-trailer))
-	(localmap (save-excursion
-		    (let ((cf (selected-frame)))
-		      (prog2
-			  (dframe-select-attached-frame speedbar-frame)
-			  (if (local-variable-p
-			       'speedbar-special-mode-key-map
-			       (current-buffer))
-			      speedbar-special-mode-key-map)
-			(select-frame cf))))))
-    (save-excursion
-      (set-buffer speedbar-buffer)
-      (use-local-map (or localmap
-			 (speedbar-initial-keymap)
-			 ;; This creates a small keymap we can glom the
-			 ;; menu adjustments into.
-			 (speedbar-make-specialized-keymap)))
-      ;; Delete the old menu if applicable.
-      (if speedbar-previous-menu (easy-menu-remove speedbar-previous-menu))
-      (setq speedbar-previous-menu md)
-      ;; Now add the new menu
-      (if (not dframe-xemacsp)
-	  (easy-menu-define speedbar-menu-map (current-local-map)
-			    "Speedbar menu" md)
-	(easy-menu-add md (current-local-map))
-	(if (featurep 'menubars) (set-buffer-menubar (list md)))))
-    (run-hooks 'speedbar-reconfigure-keymaps-hook)))
-
-
-;;; User Input stuff
-;;
-(defun speedbar-customize ()
-  "Customize speedbar using the Custom package."
-  (interactive)
-  (let ((sf (selected-frame)))
-    (dframe-select-attached-frame speedbar-frame)
-    (customize-group 'speedbar)
-    (select-frame sf))
-  (dframe-maybee-jump-to-attached-frame))
-
-(defun speedbar-track-mouse (event)
-  "For motion EVENT, display info about the current line."
-  (if (not speedbar-track-mouse-flag)
-      nil
-    (save-excursion
-      (save-window-excursion
-	(condition-case nil
-	    (progn
-	      (mouse-set-point event)
-	      (if (eq major-mode 'speedbar-mode)
-		  ;; XEmacs may let us get in here in other mode buffers.
-		  (speedbar-item-info)))
-	  (t (speedbar-message nil)))))))
-
-(defun speedbar-show-info-under-mouse ()
-  "Call the info function for the line under the mouse.
-Optional EVENT is currently not used."
-  (let ((pos (mouse-position)))	; we ignore event until I use it later.
-    (if (equal (car pos) speedbar-frame)
-	(save-excursion
-	  (save-window-excursion
-	    (apply 'set-mouse-position pos)
-	    (speedbar-item-info))))))
-
-(defun speedbar-next (arg)
-  "Move to the next ARGth line in a speedbar buffer."
-  (interactive "p")
-  (forward-line (or arg 1))
-  (speedbar-item-info)
-  (speedbar-position-cursor-on-line))
-
-(defun speedbar-prev (arg)
-  "Move to the previous ARGth line in a speedbar buffer."
-  (interactive "p")
-  (speedbar-next (if arg (- arg) -1)))
-
-(defun speedbar-restricted-move (arg)
-  "Move to the next ARGth line in a speedbar buffer at the same depth.
-This means that movement is restricted to a subnode, and that siblings
-of intermediate nodes are skipped."
-  (if (not (numberp arg)) (signal 'wrong-type-argument (list arg 'numberp)))
-  ;; First find the extent for which we are allowed to move.
-  (let ((depth (save-excursion (beginning-of-line)
-			       (if (looking-at "[0-9]+:")
-				   (string-to-int (match-string 0))
-				 0)))
-	(crement (if (< arg 0) 1 -1))	; decrement or increment
-	(lastmatch (point)))
-    (while (/= arg 0)
-      (forward-line (- crement))
-      (let ((subdepth (save-excursion (beginning-of-line)
-				      (if (looking-at "[0-9]+:")
-					  (string-to-int (match-string 0))
-					0))))
-	(cond ((or (< subdepth depth)
-		   (progn (end-of-line) (eobp))
-		   (progn (beginning-of-line) (bobp)))
-	       ;; We have reached the end of this block.
-	       (goto-char lastmatch)
-	       (setq arg 0)
-	       (error "End of sub-list"))
-	      ((= subdepth depth)
-	       (setq lastmatch (point)
-		     arg (+ arg crement))))))
-    (speedbar-position-cursor-on-line)))
-
-(defun speedbar-restricted-next (arg)
-  "Move to the next ARGth line in a speedbar buffer at the same depth.
-This means that movement is restricted to a subnode, and that siblings
-of intermediate nodes are skipped."
-  (interactive "p")
-  (speedbar-restricted-move (or arg 1))
-  (speedbar-item-info))
-
-(defun speedbar-restricted-prev (arg)
-  "Move to the previous ARGth line in a speedbar buffer at the same depth.
-This means that movement is restricted to a subnode, and that siblings
-of intermediate nodes are skipped."
-  (interactive "p")
-  (speedbar-restricted-move (if arg (- arg) -1))
-  (speedbar-item-info))
-
-(defun speedbar-navigate-list (arg)
-  "Move across ARG groups of similarly typed items in speedbar.
-Stop on the first line of the next type of item, or on the last or first item
-if we reach a buffer boundary."
-  (interactive "p")
-  (beginning-of-line)
-  (if (looking-at "[0-9]+: *[[<{][-+?][]>}] ")
-      (let ((str (regexp-quote (match-string 0))))
-	(while (looking-at str)
-	  (speedbar-restricted-move arg)
-	  (beginning-of-line))))
-  (speedbar-position-cursor-on-line))
-
-(defun speedbar-forward-list ()
-  "Move forward over the current list.
-A LIST in speedbar is a group of similarly typed items, such as directories,
-files, or the directory button."
-  (interactive)
-  (speedbar-navigate-list 1)
-  (speedbar-item-info))
-
-(defun speedbar-backward-list ()
-  "Move backward over the current list.
-A LIST in speedbar is a group of similarly typed items, such as directories,
-files, or the directory button."
-  (interactive)
-  (speedbar-navigate-list -1)
-  (speedbar-item-info))
-
-(defun speedbar-scroll-up (&optional arg)
-  "Page down one screen-full of the speedbar, or ARG lines."
-  (interactive "P")
-  (scroll-up arg)
-  (speedbar-position-cursor-on-line))
-
-(defun speedbar-scroll-down (&optional arg)
-  "Page up one screen-full of the speedbar, or ARG lines."
-  (interactive "P")
-  (scroll-down arg)
-  (speedbar-position-cursor-on-line))
-
-(defun speedbar-up-directory ()
-  "Keyboard accelerator for moving the default directory up one.
-Assumes that the current buffer is the speedbar buffer"
-  (interactive)
-  (setq default-directory (expand-file-name (concat default-directory "../")))
-  (speedbar-update-contents))
-
-;;; Speedbar file activity (aka creeping featurism)
-;;
-(defun speedbar-refresh ()
-  "Refresh the current speedbar display, disposing of any cached data."
-  (interactive)
-  (let ((dl speedbar-shown-directories)
-	(dm (and (boundp 'deactivate-mark) deactivate-mark)))
-    ;; We need to hack something so this works in detached frames.
-    (while dl
-      (adelete 'speedbar-directory-contents-alist (car dl))
-      (setq dl (cdr dl)))
-    (if (<= 1 speedbar-verbosity-level)
-	(speedbar-message "Refreshing speedbar..."))
-    (speedbar-update-contents)
-    (speedbar-stealthy-updates)
-    ;; Reset the timer in case it got really hosed for some reason...
-    (speedbar-set-timer dframe-update-speed)
-    (if (<= 1 speedbar-verbosity-level)
-	(speedbar-message "Refreshing speedbar...done"))
-    (if (boundp 'deactivate-mark) (setq deactivate-mark dm))))
-
-(defun speedbar-item-load ()
-  "Load the item under the cursor or mouse if it is a Lisp file."
-  (interactive)
-  (let ((f (speedbar-line-file)))
-    (if (and (file-exists-p f) (string-match "\\.el\\'" f))
-	(if (and (file-exists-p (concat f "c"))
-		 (speedbar-y-or-n-p (format "Load %sc? " f)))
-	    ;; If the compiled version exists, load that instead...
-	    (load-file (concat f "c"))
-	  (load-file f))
-      (error "Not a loadable file"))))
-
-(defun speedbar-item-byte-compile ()
-  "Byte compile the item under the cursor or mouse if it is a Lisp file."
-  (interactive)
-  (let ((f (speedbar-line-file))
-	(sf (selected-frame)))
-    (if (and (file-exists-p f) (string-match "\\.el\\'" f))
-	(progn
-	  (dframe-select-attached-frame speedbar-frame)
-	  (byte-compile-file f nil)
-	  (select-frame sf)
-	  (speedbar-reset-scanners)))
-    ))
-
-(defun speedbar-mouse-item-info (event)
-  "Provide information about what the user clicked on.
-This should be bound to a mouse EVENT."
-  (interactive "e")
-  (mouse-set-point event)
-  (speedbar-item-info))
-
-(defun speedbar-generic-item-info ()
-  "Attempt to derive, and then display information about thils line item.
-File style information is displayed with `speedbar-item-info'."
-  (save-excursion
-    (beginning-of-line)
-    ;; Skip invisible number info.
-    (if (looking-at "\\([0-9]+\\):") (goto-char (match-end 0)))
-    ;; Skip items in "folder" type text characters.
-    (if (looking-at "\\s-*[[<({].[]>)}] ") (goto-char (match-end 0)))
-    ;; Get the text
-    (speedbar-message "Text: %s" (buffer-substring-no-properties
-				  (point) (progn (end-of-line) (point))))))
-
-(defun speedbar-item-info ()
-  "Display info in the mini-buffer about the button the mouse is over.
-This function can be replaced in `speedbar-mode-functions-list' as
-`speedbar-item-info'"
-  (interactive)
-  (let (message-log-max)
-    (funcall (or (speedbar-fetch-replacement-function 'speedbar-item-info)
-		 'speedbar-generic-item-info))))
-
-(defun speedbar-item-info-file-helper (&optional filename)
-  "Display info about a file that is on the current line.
-nil if not applicable.  If FILENAME, then use that instead of reading
-it from the speedbar buffer."
-  (let* ((item (or filename (speedbar-line-file)))
-	 (attr (if item (file-attributes item) nil)))
-    (if (and item attr) (speedbar-message "%s %-6d %s" (nth 8 attr)
-					  (nth 7 attr) item)
-      nil)))
-
-(defun speedbar-item-info-tag-helper ()
-  "Display info about a tag that is on the current line.
-nil if not applicable."
-  (save-excursion
-    (beginning-of-line)
-    (if (re-search-forward " [-+=]?> \\([^\n]+\\)"
-			   (save-excursion(end-of-line)(point)) t)
-	(let ((tag (match-string 1))
-	      (attr (speedbar-line-token))
-	      (item nil))
-	  (if (and (featurep 'semantic) (semantic-token-p attr))
-	      (speedbar-message (funcall semantic-sb-info-token->text-function attr))
-	    (looking-at "\\([0-9]+\\):")
-	    (setq item (file-name-nondirectory (speedbar-line-path)))
-	    (speedbar-message "Tag: %s  in %s" tag item)))
-      (if (re-search-forward "{[+-]} \\([^\n]+\\)$"
-			     (save-excursion(end-of-line)(point)) t)
-	  (speedbar-message "Group of tags \"%s\"" (match-string 1))
-	(if (re-search-forward " [+-]?[()|@] \\([^\n]+\\)$" nil t)
-	    (let* ((detailtext (match-string 1))
-		   (detail (or (speedbar-line-token) detailtext))
-		   (parent (save-excursion
-			     (beginning-of-line)
-			     (let ((dep (if (looking-at "[0-9]+:")
-					    (1- (string-to-int (match-string 0)))
-					  0)))
-			       (re-search-backward (concat "^"
-			       (int-to-string dep)
-			       ":")
-						   nil t))
-			     (if (looking-at "[0-9]+: +[-+=>]> \\([^\n]+\\)$")
-				 (speedbar-line-token)
-			       nil))))
-	      (if (and (featurep 'semantic) (semantic-token-p detail))
-		  (speedbar-message
-		   (funcall semantic-sb-info-token->text-function detail parent))
-		(if parent
-		    (speedbar-message "Detail: %s of tag %s" detail
-				      (if (and (featurep 'semantic)
-					       (semantic-token-p parent))
-					  (semantic-token-name parent)
-					parent))
-		  (speedbar-message "Detail: %s" detail))))
-	  nil)))))
-
-(defun speedbar-files-item-info ()
-  "Display info in the mini-buffer about the button the mouse is over."
-  (if (not speedbar-shown-directories)
-      (speedbar-generic-item-info)
-    (or (speedbar-item-info-file-helper)
-	(speedbar-item-info-tag-helper)
-	(speedbar-generic-item-info))))
-
-(defun speedbar-item-copy ()
-  "Copy the item under the cursor.
-Files can be copied to new names or places."
-  (interactive)
-  (let ((f (speedbar-line-file)))
-    (if (not f)	(error "Not a file"))
-    (if (file-directory-p f)
-	(error "Cannot copy directory")
-      (let* ((rt (read-file-name (format "Copy %s to: "
-					 (file-name-nondirectory f))
-				 (file-name-directory f)))
-	     (refresh (member (expand-file-name (file-name-directory rt))
-			      speedbar-shown-directories)))
-	;; Create the right file name part
-	(if (file-directory-p rt)
-	    (setq rt
-		  (concat (expand-file-name rt)
-			  (if (string-match "[/\\]$" rt) "" "/")
-			  (file-name-nondirectory f))))
-	(if (or (not (file-exists-p rt))
-		(speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)
-				   t))
-	    (progn
-	      (copy-file f rt t t)
-	      ;; refresh display if the new place is currently displayed.
-	      (if refresh
-		  (progn
-		    (speedbar-refresh)
-		    (if (not (speedbar-goto-this-file rt))
-			(speedbar-goto-this-file f))))
-	      ))))))
-
-(defun speedbar-item-rename ()
-  "Rename the item under the cursor or mouse.
-Files can be renamed to new names or moved to new directories."
-  (interactive)
-  (let ((f (speedbar-line-file)))
-    (if f
-	(let* ((rt (read-file-name (format "Rename %s to: "
-					   (file-name-nondirectory f))
-				   (file-name-directory f)))
-	       (refresh (member (expand-file-name (file-name-directory rt))
-				speedbar-shown-directories)))
-	  ;; Create the right file name part
-	  (if (file-directory-p rt)
-	      (setq rt
-		    (concat (expand-file-name rt)
-			    (if (string-match "[/\\]\\'" rt) "" "/")
-			    (file-name-nondirectory f))))
-	  (if (or (not (file-exists-p rt))
-		  (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)
-				     t))
-	      (progn
-		(rename-file f rt t)
-		;; refresh display if the new place is currently displayed.
-		(if refresh
-		    (progn
-		      (speedbar-refresh)
-		      (speedbar-goto-this-file rt)
-		      )))))
-      (error "Not a file"))))
-
-(defun speedbar-create-directory ()
-  "Create a directory in speedbar."
-  (interactive)
-  (let ((f (speedbar-line-file)))
-    (if f
-	(let* ((basedir (file-name-directory f))
-	       (nd (read-file-name "Create directory: "
-				   basedir)))
-	  ;; Make the directory
-	  (make-directory nd t)
-	  (speedbar-refresh)
-	  (speedbar-goto-this-file nd)
-	  )
-      (error "Not a file"))))
-
-(defun speedbar-item-delete ()
-  "Delete the item under the cursor.  Files are removed from disk."
-  (interactive)
-  (let ((f (speedbar-line-file)))
-    (if (not f) (error "Not a file"))
-    (if (speedbar-y-or-n-p (format "Delete %s? " f) t)
-	(progn
-	  (if (file-directory-p f)
-	      (delete-directory f)
-	    (delete-file f))
-	  (speedbar-message "Okie dokie..")
-	  (let ((p (point)))
-	    (speedbar-refresh)
-	    (goto-char p))
-	  ))
-    ))
-
-(defun speedbar-item-object-delete ()
-  "Delete the object associated from the item under the cursor.
-The file is removed from disk.  The object is determined from the
-variable `speedbar-obj-alist'."
-  (interactive)
-  (let* ((f (speedbar-line-file))
-	 (obj nil)
-	 (oa speedbar-obj-alist))
-    (if (not f) (error "Not a file"))
-    (while (and oa (not (string-match (car (car oa)) f)))
-      (setq oa (cdr oa)))
-    (setq obj (concat (file-name-sans-extension f) (cdr (car oa))))
-    (if (and oa (file-exists-p obj)
-	     (speedbar-y-or-n-p (format "Delete %s? " obj) t))
-	(progn
-	  (delete-file obj)
-	  (speedbar-reset-scanners)))))
-
-(defun speedbar-enable-update ()
-  "Enable automatic updating in speedbar via timers."
-  (interactive)
-  (setq speedbar-update-flag t)
-  (speedbar-set-mode-line-format)
-  (speedbar-set-timer dframe-update-speed))
-
-(defun speedbar-disable-update ()
-  "Disable automatic updating and stop consuming resources."
-  (interactive)
-  (setq speedbar-update-flag nil)
-  (speedbar-set-mode-line-format)
-  (speedbar-set-timer nil))
-
-(defun speedbar-toggle-updates ()
-  "Toggle automatic update for the speedbar frame."
-  (interactive)
-  (if speedbar-update-flag
-      (speedbar-disable-update)
-    (speedbar-enable-update)))
-
-(defun speedbar-toggle-images ()
-  "Toggle use of images in the speedbar frame.
-Images are not available in Emacs 20 or earlier."
-  (interactive)
-  (setq speedbar-use-images (not speedbar-use-images))
-  (speedbar-refresh))
-
-(defun speedbar-toggle-sorting ()
-  "Toggle tag sorting."
-  (interactive)
-  (setq speedbar-sort-tags (not speedbar-sort-tags)))
-
-(defun speedbar-toggle-show-all-files ()
-  "Toggle display of files speedbar can not tag."
-  (interactive)
-  (setq speedbar-show-unknown-files (not speedbar-show-unknown-files))
-  (speedbar-refresh))
-
-(defmacro speedbar-with-writable (&rest forms)
-  "Allow the buffer to be writable and evaluate FORMS."
-  (list 'let '((inhibit-read-only t))
-	(cons 'progn forms)))
-(put 'speedbar-with-writable 'lisp-indent-function 0)
-
-(defun speedbar-insert-button (text face mouse function
-				    &optional token prevline)
-  "Insert TEXT as the next logical speedbar button.
-FACE is the face to put on the button, MOUSE is the highlight face to use.
-When the user clicks on TEXT, FUNCTION is called with the TOKEN parameter.
-This function assumes that the current buffer is the speedbar buffer.
-If PREVLINE, then put this button on the previous line.
-
-This is a convenience function for special mode that create their own
-specialized speedbar displays."
-  (goto-char (point-max))
-  (let ((start (point)))
-    (if (/= (current-column) 0) (insert "\n"))
-    (put-text-property start (point) 'invisible nil))
-  (if prevline (progn (delete-char -1)
-		      (insert " ") ;back up if desired...
-		      (put-text-property (1- (point)) (point) 'invisible nil)))
-  (let ((start (point)))
-    (insert text)
-    (speedbar-make-button start (point) face mouse function token))
-  (let ((start (point)))
-    (insert "\n")
-    (put-text-property start (point) 'face nil)
-    (put-text-property start (point) 'invisible nil)
-    (put-text-property start (point) 'mouse-face nil)))
-
-(defun speedbar-insert-separator (text)
-  "Insert a separation label of TEXT.
-Separators are not active, have no labels, depth, or actions."
-  (if speedbar-use-images
-      (let ((start (point)))
-	(insert "//")
-	(speedbar-insert-image-button-maybe start 2)))
-  (let ((start (point)))
-    (insert text "\n")
-    (speedbar-make-button start (point)
-			  'speedbar-separator-face
-			  nil nil nil)))
-
-(defun speedbar-make-button (start end face mouse function &optional token)
-  "Create a button from START to END, with FACE as the display face.
-MOUSE is the mouse face.  When this button is clicked on FUNCTION
-will be run with the TOKEN parameter (any Lisp object)"
-  (put-text-property start end 'face face)
-  (put-text-property start end 'mouse-face mouse)
-  (if speedbar-use-tool-tips-flag
-      (put-text-property start end 'help-echo #'dframe-help-echo))
-  (put-text-property start end 'invisible nil)
-  (put-text-property start end 'speedbar-text
-		     (buffer-substring-no-properties start end))
-  (if function (put-text-property start end 'speedbar-function function))
-  (if token (put-text-property start end 'speedbar-token token))
-  ;; So far the only text we have is less that 3 chars.
-  (if (<= (- end start) 3)
-      (speedbar-insert-image-button-maybe start (- end start)))
-  )
-
-;;; Initial Expansion list management
-;;
-(defun speedbar-initial-expansion-list ()
-  "Return the current default expansion list.
-This is based on `speedbar-initial-expansion-list-name' referencing
-`speedbar-initial-expansion-mode-alist'."
-  ;; cdr1 - name, cdr2 - menu
-  (cdr (cdr (cdr (assoc speedbar-initial-expansion-list-name
-			speedbar-initial-expansion-mode-alist)))))
-
-(defun speedbar-initial-menu ()
-  "Return the current default menu data.
-This is based on `speedbar-initial-expansion-list-name' referencing
-`speedbar-initial-expansion-mode-alist'."
-  (symbol-value
-   (car (cdr (assoc speedbar-initial-expansion-list-name
-		    speedbar-initial-expansion-mode-alist)))))
-
-(defun speedbar-initial-keymap ()
-  "Return the current default menu data.
-This is based on `speedbar-initial-expansion-list-name' referencing
-`speedbar-initial-expansion-mode-alist'."
-  (symbol-value
-   (car (cdr (cdr (assoc speedbar-initial-expansion-list-name
-			 speedbar-initial-expansion-mode-alist))))))
-
-(defun speedbar-initial-stealthy-functions ()
-  "Return a list of functions to call stealthily.
-This is based on `speedbar-initial-expansion-list-name' referencing
-`speedbar-stealthy-function-list'."
-  (cdr (assoc speedbar-initial-expansion-list-name
-	      speedbar-stealthy-function-list)))
-
-(defun speedbar-add-expansion-list (new-list)
-  "Add NEW-LIST to the list of expansion lists."
-  (add-to-list 'speedbar-initial-expansion-mode-alist new-list))
-
-(defun speedbar-change-initial-expansion-list (new-default)
-  "Change speedbar's default expansion list to NEW-DEFAULT."
-  (interactive
-   (list
-    (completing-read (format "Speedbar Mode (default %s): "
-			     speedbar-previously-used-expansion-list-name)
-		     speedbar-initial-expansion-mode-alist
-		     nil t "" nil
-		     speedbar-previously-used-expansion-list-name)))
-  (setq speedbar-previously-used-expansion-list-name
-	speedbar-initial-expansion-list-name
-	speedbar-initial-expansion-list-name new-default)
-  (if (and (speedbar-current-frame) (frame-live-p (speedbar-current-frame)))
-      (progn
-	(speedbar-refresh)
-	(speedbar-reconfigure-keymaps))))
-
-(defun speedbar-fetch-replacement-function (function)
-  "Return a current mode specific replacement for function, or nil.
-Scans `speedbar-mode-functions-list' first for the current mode, then
-for FUNCTION."
-  (cdr (assoc function
-	      (cdr (assoc speedbar-initial-expansion-list-name
-			  speedbar-mode-functions-list)))))
-
-(defun speedbar-add-mode-functions-list (new-list)
-  "Add NEW-LIST to the list of mode functions.
-See `speedbar-mode-functions-list' for details."
-  (add-to-list 'speedbar-mode-functions-list new-list))
-
-
-;;; Special speedbar display management
-;;
-(defun speedbar-maybe-add-localized-support (buffer)
-  "Quick check function called on BUFFERs by the speedbar timer function.
-Maintains the value of local variables which control speedbars use
-of the special mode functions."
-  (or speedbar-special-mode-expansion-list
-      (speedbar-add-localized-speedbar-support buffer)))
-
-(defun speedbar-add-localized-speedbar-support (buffer)
-  "Add localized speedbar support to BUFFER's mode if it is available."
-  (interactive "bBuffer: ")
-  (if (stringp buffer) (setq buffer (get-buffer buffer)))
-  (if (not (buffer-live-p buffer))
-      nil
-    (save-excursion
-      (set-buffer buffer)
-      (save-match-data
-	(let ((ms (symbol-name major-mode)) v)
-	  (if (not (string-match "-mode$" ms))
-	      nil ;; do nothing to broken mode
-	    (setq ms (substring ms 0 (match-beginning 0)))
-	    (setq v (intern-soft (concat ms "-speedbar-buttons")))
-	    (make-local-variable 'speedbar-special-mode-expansion-list)
-	    (if (not v)
-		(setq speedbar-special-mode-expansion-list t)
-	      ;; If it is autoloaded, we need to load it now so that
-	      ;; we have access to the varialbe -speedbar-menu-items.
-	      ;; Is this XEmacs safe?
-	      (let ((sf (symbol-function v)))
-		(if (and (listp sf) (eq (car sf) 'autoload))
-		    (load-library (car (cdr sf)))))
-	      (setq speedbar-special-mode-expansion-list (list v))
-	      (setq v (intern-soft (concat ms "-speedbar-key-map")))
-	      (if (not v)
-		  nil ;; don't add special keymap
-		(make-local-variable 'speedbar-special-mode-key-map)
-		(setq speedbar-special-mode-key-map
-		      (symbol-value v)))
-	      (setq v (intern-soft (concat ms "-speedbar-menu-items")))
-	      (if (not v)
-		  nil ;; don't add special menus
-		(make-local-variable 'speedbar-easymenu-definition-special)
-		(setq speedbar-easymenu-definition-special
-		      (symbol-value v)))
-	      )))))))
-
-(defun speedbar-remove-localized-speedbar-support (buffer)
-  "Remove any traces that BUFFER supports speedbar in a specialized way."
-  (save-excursion
-    (set-buffer buffer)
-    (kill-local-variable 'speedbar-special-mode-expansion-list)
-    (kill-local-variable 'speedbar-special-mode-key-map)
-    (kill-local-variable 'speedbar-easymenu-definition-special)))
-
-;;; File button management
-;;
-(defun speedbar-file-lists (directory)
-  "Create file lists for DIRECTORY.
-The car is the list of directories, the cdr is list of files not
-matching ignored headers.  Cache any directory files found in
-`speedbar-directory-contents-alist' and use that cache before scanning
-the file-system"
-  (setq directory (expand-file-name directory))
-  ;; If in powerclick mode, then the directory we are getting
-  ;; should be rescanned.
-  (if dframe-power-click
-      (adelete 'speedbar-directory-contents-alist directory))
-  ;; find the directory, either in the cache, or build it.
-  (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
-      (let ((default-directory directory)
-	    (dir (directory-files directory nil))
-	    (dirs nil)
-	    (files nil))
-	(while dir
-	  (if (not
-	       (or (string-match speedbar-file-unshown-regexp (car dir))
-		   (string-match speedbar-directory-unshown-regexp (car dir))))
-	      (if (file-directory-p (car dir))
-		  (setq dirs (cons (car dir) dirs))
-		(setq files (cons (car dir) files))))
-	  (setq dir (cdr dir)))
-	(let ((nl (cons (nreverse dirs) (list (nreverse files)))))
-	  (aput 'speedbar-directory-contents-alist directory nl)
-	  nl))
-      ))
-
-(defun speedbar-directory-buttons (directory index)
-  "Insert a single button group at point for DIRECTORY.
-Each directory path part is a different button.  If part of the path
-matches the user directory ~, then it is replaced with a ~.
-INDEX is not used, but is required by the caller."
-  (let* ((tilde (expand-file-name "~/"))
-	 (dd (expand-file-name directory))
-	 (junk (string-match (regexp-quote tilde) dd))
-	 (displayme (if junk
-			(concat "~/" (substring dd (match-end 0)))
-		      dd))
-	 (p (point)))
-    (if (string-match "^~[/\\]?\\'" displayme) (setq displayme tilde))
-    (insert displayme)
-    (save-excursion
-      (goto-char p)
-      (while (re-search-forward "\\([^/\\]+\\)[/\\]" nil t)
-	(speedbar-make-button (match-beginning 1) (match-end 1)
-			      'speedbar-directory-face
-			      'speedbar-highlight-face
-			      'speedbar-directory-buttons-follow
-			      (if (and (= (match-beginning 1) p)
-				       (not (char-equal (char-after (+ p 1)) ?:)))
-				  (expand-file-name "~/")  ;the tilde
-				(buffer-substring-no-properties
-				 p (match-end 0)))))
-      ;; Nuke the beginning of the directory if it's too long...
-      (cond ((eq speedbar-directory-button-trim-method 'span)
-	     (beginning-of-line)
-	     (let ((ww (or (speedbar-frame-width) 20)))
-	       (move-to-column ww nil)
-	       (while (>= (current-column) ww)
-		 (re-search-backward "[/\\]" nil t)
-		 (if (<= (current-column) 2)
-		     (progn
-		       (re-search-forward "[/\\]" nil t)
-		       (if (< (current-column) 4)
-			   (re-search-forward "[/\\]" nil t))
-		       (forward-char -1)))
-		 (if (looking-at "[/\\]?$")
-		     (beginning-of-line)
-		   (insert "/...\n ")
-		   (move-to-column ww nil)))))
-	    ((eq speedbar-directory-button-trim-method 'trim)
-	     (end-of-line)
-	     (let ((ww (or (speedbar-frame-width) 20))
-		   (tl (current-column)))
-	       (if (< ww tl)
-		   (progn
-		     (move-to-column (- tl ww))
-		     (if (re-search-backward "[/\\]" nil t)
-			 (progn
-			   (delete-region (point-min) (point))
-			   (insert "$")
-			   )))))))
-      )
-    (if (string-match "\\`[/\\][^/\\]+[/\\]\\'" displayme)
-	(progn
-	  (insert "  ")
-	  (let ((p (point)))
-	    (insert "<root>")
-	    (speedbar-make-button p (point)
-				  'speedbar-directory-face
-				  'speedbar-highlight-face
-				  'speedbar-directory-buttons-follow
-				  "/"))))
-    (end-of-line)
-    (insert-char ?\n 1 nil)))
-
-(defun speedbar-make-tag-line (exp-button-type
-			       exp-button-char exp-button-function
-			       exp-button-data
-			       tag-button tag-button-function tag-button-data
-			       tag-button-face depth)
-  "Create a tag line with EXP-BUTTON-TYPE for the small expansion button.
-This is the button that expands or contracts a node (if applicable),
-and EXP-BUTTON-CHAR the character in it (+, -, ?, etc).  EXP-BUTTON-FUNCTION
-is the function to call if it's clicked on.  Button types are
-'bracket, 'angle, 'curly, 'expandtag, 'statictag, t, or nil.
-EXP-BUTTON-DATA is extra data attached to the text forming the expansion
-button.
-
-Next, TAG-BUTTON is the text of the tag.  TAG-BUTTON-FUNCTION is the
-function to call if clicked on, and TAG-BUTTON-DATA is the data to
-attach to the text field (such a tag positioning, etc).
-TAG-BUTTON-FACE is a face used for this type of tag.
-
-Lastly, DEPTH shows the depth of expansion.
-
-This function assumes that the cursor is in the speedbar window at the
-position to insert a new item, and that the new item will end with a CR"
-  (let ((start (point))
-	(end (progn
-	       (insert (int-to-string depth) ":")
-	       (point)))
-	(depthspacesize (* depth speedbar-indentation-width)))
-    (put-text-property start end 'invisible t)
-    (insert-char ?  depthspacesize nil)
-    (put-text-property (- (point) depthspacesize) (point) 'invisible nil)
-    (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
-			     ((eq exp-button-type 'angle) "<%c>")
-			     ((eq exp-button-type 'curly) "{%c}")
-			     ((eq exp-button-type 'expandtag) " %c>")
-			     ((eq exp-button-type 'statictag) " =>")
-			     (t ">")))
-	   (buttxt (format exp-button exp-button-char))
-	   (start (point))
-	   (end (progn (insert buttxt) (point)))
-	   (bf (if (and exp-button-type (not (eq exp-button-type 'statictag)))
-		   'speedbar-button-face nil))
-	   (mf (if exp-button-function 'speedbar-highlight-face nil))
-	   )
-      (speedbar-make-button start end bf mf exp-button-function exp-button-data)
-      (if speedbar-hide-button-brackets-flag
-	  (progn
-	    (put-text-property start (1+ start) 'invisible t)
-	    (put-text-property end (1- end) 'invisible t)))
-      )
-    (insert-char ?  1 nil)
-    (put-text-property (1- (point)) (point) 'invisible nil)
-    (let ((start (point))
-	  (end (progn (insert tag-button) (point))))
-      (insert-char ?\n 1 nil)
-      (put-text-property (1- (point)) (point) 'invisible nil)
-      (speedbar-make-button start end tag-button-face
-			    (if tag-button-function 'speedbar-highlight-face nil)
-			    tag-button-function tag-button-data))
-    ))
-  
-(defun speedbar-change-expand-button-char (char)
-  "Change the expansion button character to CHAR for the current line."
-  (save-excursion
-    (beginning-of-line)
-    (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
-								(point)) t)
-	(speedbar-with-writable
-	  (goto-char (match-end 1))
-	  (insert-char char 1 t)
-	  (forward-char -1)
-	  (delete-char -1)
-	  ;;(put-text-property (point) (1- (point)) 'invisible nil)
-	  ;; make sure we fix the image on the text here.
-	  (speedbar-insert-image-button-maybe (- (point) 1) 3)))))
-
-
-;;; Build button lists
-;;
-(defun speedbar-insert-files-at-point (files level)
-  "Insert list of FILES starting at point, and indenting all files to LEVEL.
-Tag expandable items with a +, otherwise a ?.  Don't highlight ? as we
-don't know how to manage them.  The input parameter FILES is a cons
-cell of the form ( 'DIRLIST .  'FILELIST )"
-  ;; Start inserting all the directories
-  (let ((dirs (car files)))
-    (while dirs
-      (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
-			      (car dirs) 'speedbar-dir-follow nil
-			      'speedbar-directory-face level)
-      (setq dirs (cdr dirs))))
-  (let ((lst (car (cdr files)))
-	(case-fold-search t))
-    (while lst
-      (let* ((known (string-match speedbar-file-regexp (car lst)))
-	     (expchar (if known ?+ ??))
-	     (fn (if known 'speedbar-tag-file nil)))
-	(if (or speedbar-show-unknown-files (/= expchar ??))
-	    (speedbar-make-tag-line 'bracket expchar fn (car lst)
-				    (car lst) 'speedbar-find-file nil
-				    'speedbar-file-face level)))
-      (setq lst (cdr lst)))))
-
-(defun speedbar-default-directory-list (directory index)
-  "Insert files for DIRECTORY with level INDEX at point."
-  (speedbar-insert-files-at-point
-   (speedbar-file-lists directory) index)
-  (speedbar-reset-scanners)
-  (if (= index 0)
-      ;; If the shown files variable has extra directories, then
-      ;; it is our responsibility to redraw them all
-      ;; Luckilly, the nature of inserting items into this list means
-      ;; that by reversing it, we can easilly go in the right order
-      (let ((sf (cdr (reverse speedbar-shown-directories))))
-	(setq speedbar-shown-directories
-	      (list (expand-file-name default-directory)))
-	;; exand them all as we find them
-	(while sf
-	  (if (speedbar-goto-this-file (car sf))
-	      (progn
-		(beginning-of-line)
-		(if (looking-at "[0-9]+:[ ]*<")
-		    (progn
-		      (goto-char (match-end 0))
-		  (speedbar-do-function-pointer)))
-		(setq sf (cdr sf)))))
-	)))
-;;; Generic List support
-;;
-;;  Generic lists are hierarchies of tags which we may need to permute
-;;  in order to make it look nice.
-;;
-;;  A generic list is of the form:
-;;  ( ("name" . marker-or-number)              <-- one tag at this level
-;;    ("name" ("name" . mon) ("name" . mon) )  <-- one group of tags
-;;    ("name" mon ("name" . mon) )             <-- group w/ a position and tags
-(defun speedbar-generic-list-group-p (sublst)
-  "Non-nil if SUBLST is a group.
-Groups may optionally contain a position."
-  (and (stringp (car-safe sublst))
-       (or (and (listp (cdr-safe sublst))
-		(or (speedbar-generic-list-tag-p (car-safe (cdr-safe sublst)))
-		    (speedbar-generic-list-group-p (car-safe (cdr-safe sublst))
-						   )))
-	   (and (number-or-marker-p (car-safe (cdr-safe sublst)))
-		(listp (cdr-safe (cdr-safe sublst)))
-		(speedbar-generic-list-tag-p
-		 (car-safe (cdr-safe (cdr-safe sublst)))))
-	   )))
-
-(defun speedbar-generic-list-positioned-group-p (sublst)
-  "Non-nil of SUBLST is a group with a position."
-  (and (stringp (car-safe sublst))
-       (number-or-marker-p (car-safe (cdr-safe sublst)))
-       (listp (cdr-safe (cdr-safe sublst)))
-       (let ((rest (car-safe (cdr-safe (cdr-safe sublst)))))
-	 (or (speedbar-generic-list-tag-p rest)
-	     (speedbar-generic-list-group-p rest)
-	     (speedbar-generic-list-positioned-group-p rest)
-	     ))))
-
-(defun speedbar-generic-list-tag-p (sublst)
-  "Non nil if SUBLST is a tag."
-  (and (stringp (car-safe sublst))
-       (or (and (number-or-marker-p (cdr-safe sublst))
-		(not (cdr-safe (cdr-safe sublst))))
-	   ;; For semantic/bovine items, this is needed
-	   (symbolp (car-safe (cdr-safe sublst))))
-       ))
-
-(defun speedbar-sort-tag-hierarchy (lst)
-  "Sort all elements of tag hierarchy LST."
-  (sort (copy-alist lst)
-	(lambda (a b) (string< (car a) (car b)))))
-
-(defun speedbar-try-completion (string alist)
-  "A wrapper for `try-completion'.
-Passes STRING and ALIST to `try-completion' if ALIST
-passes some tests."
-  (if (and (listp alist) (not (null alist))
-	   (listp (car alist)) (stringp (car (car alist))))
-      (try-completion string alist)
-    nil))
-
-(defun speedbar-prefix-group-tag-hierarchy (lst)
-  "Prefix group names for tag hierarchy LST."
-  (let ((newlst nil)
-	(sublst nil)
-	(work-list nil)
-	(junk-list nil)
-	(short-group-list nil)
-	(short-start-name nil)
-	(short-end-name nil)
-	(num-shorts-grouped 0)
-	(bins (make-vector 256 nil))
-	(diff-idx 0))
-    (if (<= (length lst) speedbar-tag-regroup-maximum-length)
-	;; Do nothing.  Too short to bother with.
-	lst
-      ;; Break out sub-lists
-      (while lst
-	(if (speedbar-generic-list-group-p (car-safe lst))
-	    (setq newlst (cons (car lst) newlst))
-	  (setq sublst (cons (car lst) sublst)))
-	(setq lst (cdr lst)))
-      ;; Reverse newlst because it was made backwards.
-      ;; Sublist doesn't need reversing because the act
-      ;; of binning things will reverse it for us.
-      (setq newlst (nreverse newlst)
-	    sublst sublst)
-      ;; Now, first find out how long our list is.  Never let a
-      ;; list get-shorter than our minimum.
-      (if (<= (length sublst) speedbar-tag-split-minimum-length)
-	  (setq work-list sublst)
-	(setq diff-idx (length (speedbar-try-completion "" sublst)))
-	;; Sort the whole list into bins.
-	(while sublst
-	  (let ((e (car sublst))
-		(s (car (car sublst))))
-	    (cond ((<= (length s) diff-idx)
-		   ;; 0 storage bin for shorty.
-		   (aset bins 0 (cons e (aref bins 0))))
-		  (t
-		   ;; stuff into a bin based on ascii value at diff
-		   (aset bins (aref s diff-idx)
-			 (cons e (aref bins (aref s diff-idx)))))))
-	  (setq sublst (cdr sublst)))
-	;; Go through all our bins  Stick singles into our
-	;; junk-list, everything else as sublsts in work-list.
-	;; If two neighboring lists are both small, make a grouped
-	;; group combinding those two sub-lists.
-	(setq diff-idx 0)
-	(while (> 256 diff-idx)
-	  ;; The bins contents are currently in forward order.
-	  (let ((l (aref bins diff-idx)))
-	    (if l
-		(let ((tmp (cons (speedbar-try-completion "" l) l)))
-		  (if (or (> (length l) speedbar-tag-regroup-maximum-length)
-			  (> (+ (length l) (length short-group-list))
-			     speedbar-tag-split-minimum-length))
-		      (progn
-			;; We have reached a longer list, so we
-			;; must finish off a grouped group.
-			(cond
-			 ((and short-group-list
-			       (= (length short-group-list)
-				  num-shorts-grouped))
-			  ;; All singles?  Junk list
-			  (setq junk-list (append (nreverse short-group-list)
-						  junk-list)))
-			 ((= num-shorts-grouped 1)
-			  ;; Only one short group?  Just stick it in
-			  ;; there by itself.  Make a group, and find
-			  ;; a subexpression
-			  (let ((subexpression (speedbar-try-completion
-						"" short-group-list)))
-			    (if (< (length subexpression)
-				   speedbar-tag-group-name-minimum-length)
-				(setq subexpression
-				      (concat short-start-name
-					      " ("
-					      (substring
-					       (car (car short-group-list))
-					       (length short-start-name))
-					      ")")))
-			    (setq work-list
-				  (cons (cons subexpression
-					      short-group-list)
-					work-list ))))
-			 (short-group-list
-			  ;; Multiple groups to be named in a special
-			  ;; way by displaying the range over which we
-			  ;; have grouped them.
-			  (setq work-list
-				(cons (cons (concat short-start-name
-						    " to "
-						    short-end-name)
-					    short-group-list)
-				      work-list))))
-		     ;; Reset short group list information every time.
-			(setq short-group-list nil
-			      short-start-name nil
-			      short-end-name nil
-			      num-shorts-grouped 0)))
-		  ;; Ok, now that we cleaned up the short-group-list,
-		  ;; we can deal with this new list, to decide if it
-		  ;; should go on one of these sub-lists or not.
-		  (if (< (length l) speedbar-tag-regroup-maximum-length)
-		      (setq short-group-list (append l short-group-list)
-			    num-shorts-grouped (1+ num-shorts-grouped)
-			    short-end-name (car tmp)
-			    short-start-name (if short-start-name
-						 short-start-name
-					       (car tmp)))
-		    (setq work-list (cons tmp work-list))))))
-	  (setq diff-idx (1+ diff-idx))))
-      ;; Did we run out of things?  Drop our new list onto the end.
-      (cond
-       ((and short-group-list (= (length short-group-list) num-shorts-grouped))
-	;; All singles?  Junk list
-	(setq junk-list (append short-group-list junk-list)))
-       ((= num-shorts-grouped 1)
-	;; Only one short group?  Just stick it in
-	;; there by itself.
-	(setq work-list
-	      (cons (cons (speedbar-try-completion "" short-group-list)
-			  short-group-list)
-		    work-list)))
-       (short-group-list
-	;; Multiple groups to be named in a special
-	;; way by displaying the range over which we
-	;; have grouped them.
-	(setq work-list
-	      (cons (cons (concat short-start-name " to " short-end-name)
-			  short-group-list)
-		    work-list))))
-      ;; Reverse the work list nreversed when consing.
-      (setq work-list (nreverse work-list))
-      ;; Now, stick our new list onto the end of
-      (if work-list
-	  (if junk-list
-	      (append newlst work-list junk-list)
-	    (append newlst work-list))
-	(append  newlst junk-list)))))
-
-(defun speedbar-trim-words-tag-hierarchy (lst)
-  "Trim all words in a tag hierarchy.
-Base trimming information on word separators, and group names.
-Argument LST is the list of tags to trim."
-  (let ((newlst nil)
-	(sublst nil)
-	(trim-prefix nil)
-	(trim-chars 0)
-	(trimlst nil))
-    (while lst
-      (if (speedbar-generic-list-group-p (car-safe lst))
-	  (setq newlst (cons (car lst) newlst))
-	(setq sublst (cons (car lst) sublst)))
-      (setq lst (cdr lst)))
-    ;; Get the prefix to trim by.  Make sure that we don't trim
-    ;; off silly pieces, only complete understandable words.
-    (setq trim-prefix (speedbar-try-completion "" sublst)
-	  newlst (nreverse newlst))
-    (if (or (= (length sublst) 1)
-	    (not trim-prefix)
-	    (not (string-match "\\(\\w+\\W+\\)+" trim-prefix)))
-	(append newlst (nreverse sublst))
-      (setq trim-prefix (substring trim-prefix (match-beginning 0)
-				   (match-end 0)))
-      (setq trim-chars (length trim-prefix))
-      (while sublst
-	(setq trimlst (cons
-		       (cons (substring (car (car sublst)) trim-chars)
-			     (cdr (car sublst)))
-		       trimlst)
-	      sublst (cdr sublst)))
-      ;; Put the lists together
-      (append newlst trimlst))))
-
-(defun speedbar-simple-group-tag-hierarchy (lst)
-  "Create a simple 'Tags' group with orphaned tags.
-Argument LST is the list of tags to sort into groups."
-  (let ((newlst nil)
-	(sublst nil))
-    (while lst
-      (if (speedbar-generic-list-group-p (car-safe lst))
-	  (setq newlst (cons (car lst) newlst))
-	(setq sublst (cons (car lst) sublst)))
-      (setq lst (cdr lst)))
-    (if (not newlst)
-	(nreverse sublst)
-      (setq newlst (cons (cons "Tags" (nreverse sublst)) newlst))
-      (nreverse newlst))))
-
-(defun speedbar-create-tag-hierarchy (lst)
-  "Adjust the tag hierarchy in LST, and return it.
-This uses `speedbar-tag-hierarchy-method' to determine how to adjust
-the list."
-  (let* ((f (save-excursion
-	      (forward-line -1)
-	      (or (speedbar-line-file)
-		  (speedbar-line-path))))
-	 (methods (if (get-file-buffer f)
-		      (save-excursion (set-buffer (get-file-buffer f))
-				      speedbar-tag-hierarchy-method)
-		    speedbar-tag-hierarchy-method))
-	 (lst (if (fboundp 'copy-tree)
-		  (copy-tree lst)
-		lst)))
-    (while methods
-      (setq lst (funcall (car methods) lst)
-	    methods (cdr methods)))
-    lst))
-
-(defvar speedbar-generic-list-group-expand-button-type 'curly
-  "The type of button created for groups of tags.
-Good values for this are `curly' and `expandtag'.
-Make buffer local for your mode.")
-
-(defvar speedbar-generic-list-tag-button-type nil
-  "The type of button created for tags in generic lists.
-Good values for this are nil and `statictag'.
-Make buffer local for your mode.")
-
-(defun speedbar-insert-generic-list (level lst expand-fun find-fun)
-  "At LEVEL, insert a generic multi-level alist LST.
-Associations with lists get {+} tags (to expand into more nodes) and
-those with positions just get a > as the indicator.  {+} buttons will
-have the function EXPAND-FUN and the token is the CDR list.  The token
-name will have the function FIND-FUN and not token."
-  ;; Remove imenu rescan button
-  (if (string= (car (car lst)) "*Rescan*")
-      (setq lst (cdr lst)))
-  ;; Get, and set up variables that define how we treat these tags.
-   (let ((f (save-excursion (forward-line -1)
-			    (or (speedbar-line-file)
-				(speedbar-line-path))))
-	 expand-button tag-button)
-     (save-excursion
-       (if (get-file-buffer f)
-	   (set-buffer (get-file-buffer f)))
-       (setq expand-button speedbar-generic-list-group-expand-button-type
-	     tag-button speedbar-generic-list-tag-button-type))
-     ;; Adjust the list.
-     (setq lst (speedbar-create-tag-hierarchy lst))
-     ;; insert the parts
-     (while lst
-       (cond ((null (car-safe lst)) nil)	;this would be a separator
-	    ((speedbar-generic-list-tag-p (car lst))
-	     (speedbar-make-tag-line tag-button
-				     nil nil nil ;no expand button data
-				     (car (car lst)) ;button name
-				     find-fun ;function
-				     (cdr (car lst)) ;token is position
-				     'speedbar-tag-face
-				     (1+ level)))
-	    ((speedbar-generic-list-positioned-group-p (car lst))
-	     (speedbar-make-tag-line expand-button
-				     ?+ expand-fun (cdr (cdr (car lst)))
-				     (car (car lst)) ;button name
-				     find-fun ;function
-				     (car (cdr (car lst))) ;token is posn
-				     'speedbar-tag-face
-				     (1+ level)))
-	    ((speedbar-generic-list-group-p (car lst))
-	     (speedbar-make-tag-line expand-button
-				     ?+ expand-fun (cdr (car lst))
-				     (car (car lst)) ;button name
-				     nil nil 'speedbar-tag-face
-				     (1+ level)))
-	    (t (speedbar-message "speedbar-insert-generic-list: malformed list!")
-	       ))
-      (setq lst (cdr lst)))))
-
-(defun speedbar-insert-imenu-list (indent lst)
-  "At level INDENT, insert the imenu generated LST."
-  (speedbar-insert-generic-list indent lst
-				'speedbar-tag-expand
-				'speedbar-tag-find))
-				
-(defun speedbar-insert-etags-list (indent lst)
-  "At level INDENT, insert the etags generated LST."
-  (speedbar-insert-generic-list indent lst
-				'speedbar-tag-expand
-				'speedbar-tag-find))
-
-;;; Timed functions
-;;
-(defun speedbar-update-contents ()
-  "Generically update the contents of the speedbar buffer."
-  (interactive)
-  ;; Set the current special buffer
-  (setq speedbar-desired-buffer nil)
-
-  ;; Check for special modes
-  (speedbar-maybe-add-localized-support (current-buffer))
-
-  ;; Choose the correct method of doodling.
-  (if (and speedbar-mode-specific-contents-flag
-	   (listp speedbar-special-mode-expansion-list)
-	   speedbar-special-mode-expansion-list
-	   (local-variable-p
-	    'speedbar-special-mode-expansion-list
-	    (current-buffer)))
-      ;;(eq (get major-mode 'mode-class 'special)))
-      (speedbar-update-special-contents)
-    (speedbar-update-directory-contents)))
-
-(defun speedbar-update-directory-contents ()
-  "Update the contents of the speedbar buffer based on the current directory."
-
-  (save-excursion
-
-    (let ((cbd (expand-file-name default-directory))
-	  cbd-parent
-	  (funclst (speedbar-initial-expansion-list))
-	  (cache speedbar-full-text-cache)
-	  ;; disable stealth during update
-	  (speedbar-stealthy-function-list nil)
-	  (use-cache nil)
-	  (expand-local nil)
-	  ;; Because there is a bug I can't find just yet
-	  (inhibit-quit nil))
-      (set-buffer speedbar-buffer)
-      ;; If we are updating contents to where we are, then this is
-      ;; really a request to update existing contents, so we must be
-      ;; careful with our text cache!
-      (if (member cbd speedbar-shown-directories)
-	  (progn
-	    (setq cache nil)
-	    ;; If the current directory is not the last element in the dir
-	    ;; list, then we ALSO need to zap the list of expanded directories
-	    (if (/= (length (member cbd speedbar-shown-directories)) 1)
-		(setq speedbar-shown-directories (list cbd))))
-
-	;; Build cbd-parent, and see if THAT is in the current shown
-	;; directories.  First, go through pains to get the parent directory
-	(if (and speedbar-smart-directory-expand-flag
-		 (save-match-data
-		   (setq cbd-parent cbd)
-		   (if (string-match "[/\\]$" cbd-parent)
-		       (setq cbd-parent (substring cbd-parent 0
-						   (match-beginning 0))))
-		   (setq cbd-parent (file-name-directory cbd-parent)))
-		 (member cbd-parent speedbar-shown-directories))
-	    (setq expand-local t)
-
-	  ;; If this directory is NOT in the current list of available
-	  ;; paths, then use the cache, and set the cache to our new
-	  ;; value.  Make sure to unhighlight the current file, or if we
-	  ;; come back to this directory, it might be a different file
-	  ;; and then we get a mess!
-	  (if (> (point-max) 1)
-	      (progn
-		(speedbar-clear-current-file)
-		(setq speedbar-full-text-cache
-		      (cons speedbar-shown-directories (buffer-string)))))
-
-	  ;; Check if our new directory is in the list of directories
-	  ;; shown in the text-cache
-	  (if (member cbd (car cache))
-	      (setq speedbar-shown-directories (car cache)
-		    use-cache t)
-	    ;; default the shown directories to this list...
-	    (setq speedbar-shown-directories (list cbd)))
-	  ))
-      (if (not expand-local) (setq speedbar-last-selected-file nil))
-      (speedbar-with-writable
-	(if (and expand-local
-		 ;; Find this directory as a speedbar node.
-		 (speedbar-path-line cbd))
-	    ;; Open it.
-	    (speedbar-expand-line)
-	  (erase-buffer)
-	  (cond (use-cache
-		 (setq default-directory
-		       (nth (1- (length speedbar-shown-directories))
-			    speedbar-shown-directories))
-		 (insert (cdr cache)))
-		(t
-		 (while funclst
-		   (setq default-directory cbd)
-		   (funcall (car funclst) cbd 0)
-		   (setq funclst (cdr funclst))))))
-	(goto-char (point-min)))))
-  (speedbar-reconfigure-keymaps))
-
-(defun speedbar-update-special-contents ()
-  "Used the mode-specific variable to fill in the speedbar buffer.
-This should only be used by modes classified as special."
-  (let ((funclst speedbar-special-mode-expansion-list)
-	(specialbuff (current-buffer)))
-    (save-excursion
-      (setq speedbar-desired-buffer specialbuff)
-      (set-buffer speedbar-buffer)
-      ;; If we are leaving a directory, cache it.
-      (if (not speedbar-shown-directories)
-	  ;; Do nothing
-	  nil
-	;; Clean up directory maintenance stuff
-	(speedbar-clear-current-file)
-	(setq speedbar-full-text-cache
-	      (cons speedbar-shown-directories (buffer-string))
-	      speedbar-shown-directories nil))
-      ;; Now fill in the buffer with our newly found specialized list.
-      (speedbar-with-writable
-	(while funclst
-	  ;; We do not erase the buffer because these functions may
-	  ;; decide NOT to update themselves.
-	  (funcall (car funclst) specialbuff)
-	  (setq funclst (cdr funclst))))
-
-      (goto-char (point-min))))
-  (speedbar-reconfigure-keymaps))
-
-(defun speedbar-set-timer (timeout)
-  "Set up the speedbar timer with TIMEOUT.
-Uses `dframe-set-timer'."
-  (dframe-set-timer timeout 'speedbar-timer-fn 'speedbar-update-flag)
-  ;; Apply a revert hook that will reset the scanners.  We attach to revert
-  ;; because most reverts occur during VC state change, and this lets our
-  ;; VC scanner fix itself.
-  (if timeout
-      (add-hook 'after-revert-hook 'speedbar-reset-scanners)
-    (remove-hook 'after-revert-hook 'speedbar-reset-scanners))
-  ;; change this if it changed for some reason
-  (speedbar-set-mode-line-format))
-
-(defun speedbar-timer-fn ()
-  "Run whenever Emacs is idle to update the speedbar item."
-  (if (or (not (speedbar-current-frame))
-	  (not (frame-live-p (speedbar-current-frame))))
-      (speedbar-set-timer nil)
-    ;; Save all the match data so that we don't mess up executing fns
-    (save-match-data
-      ;; Only do stuff if the frame is visible, not an icon, and if
-      ;; it is currently flagged to do something.
-      (if (and speedbar-update-flag
-	       (speedbar-current-frame)
-	       (frame-visible-p (speedbar-current-frame))
-	       (not (eq (frame-visible-p (speedbar-current-frame)) 'icon)))
-	  (let ((af (selected-frame)))
-	    (save-window-excursion
-	      (dframe-select-attached-frame speedbar-frame)
-	      ;; make sure we at least choose a window to
-	      ;; get a good directory from
-	      (if (window-minibuffer-p (selected-window))
-		  nil
-		;; Check for special modes
-		(speedbar-maybe-add-localized-support (current-buffer))
-		;; Update for special mode all the time!
-		(if (and speedbar-mode-specific-contents-flag
-			 (listp speedbar-special-mode-expansion-list)
-			 speedbar-special-mode-expansion-list
-			 (local-variable-p
-			  'speedbar-special-mode-expansion-list
-			  (current-buffer)))
-		    ;;(eq (get major-mode 'mode-class 'special)))
-		    (progn
-		      (if (<= 2 speedbar-verbosity-level)
-			  (speedbar-message
-			   "Updating speedbar to special mode: %s..."
-			   major-mode))
-		      (speedbar-update-special-contents)
-		      (if (<= 2 speedbar-verbosity-level)
-			  (progn
-			    (speedbar-message
-			     "Updating speedbar to special mode: %s...done"
-			     major-mode)
-			    (speedbar-message nil))))
-		  ;; Update all the contents if directories change!
-		  (if (or (member (expand-file-name default-directory)
-				  speedbar-shown-directories)
-			  (and speedbar-ignored-path-regexp
-			       (string-match
-				speedbar-ignored-path-regexp
-				(expand-file-name default-directory)))
-			  (member major-mode speedbar-ignored-modes)
-			  (eq af (speedbar-current-frame))
-			  (not (buffer-file-name)))
-		      nil
-		    (if (<= 1 speedbar-verbosity-level)
-			(speedbar-message "Updating speedbar to: %s..."
-				 default-directory))
-		    (speedbar-update-directory-contents)
-		    (if (<= 1 speedbar-verbosity-level)
-			(progn
-			  (speedbar-message "Updating speedbar to: %s...done"
-				   default-directory)
-			  (speedbar-message nil)))))
-		(select-frame af)))
-	    ;; Now run stealthy updates of time-consuming items
-	    (speedbar-stealthy-updates)))))
-  (run-hooks 'speedbar-timer-hook))
-
-
-;;; Stealthy activities
-;;
-(defvar speedbar-stealthy-update-recurse nil
-  "Recursion avoidance variable for stealthy update.")
-
-(defun speedbar-stealthy-updates ()
-  "For a given speedbar, run all items in the stealthy function list.
-Each item returns t if it completes successfully, or nil if
-interrupted by the user."
-  (if (not speedbar-stealthy-update-recurse)
-      (let ((l (speedbar-initial-stealthy-functions))
-	    (speedbar-stealthy-update-recurse t))
-	(unwind-protect
-	    (speedbar-with-writable
-	      (while (and l (funcall (car l)))
-		;;(sit-for 0)
-		(setq l (cdr l))))
-	  ;;(speedbar-message "Exit with %S" (car l))
-	  ))))
-
-(defun speedbar-reset-scanners ()
-  "Reset any variables used by functions in the stealthy list as state.
-If new functions are added, their state needs to be updated here."
-  (setq speedbar-vc-to-do-point t
-	speedbar-obj-to-do-point t
-	speedbar-ro-to-do-point t)
-  (run-hooks 'speedbar-scanner-reset-hook)
-  )
-
-(defun speedbar-find-selected-file (file)
-  "Goto the line where FILE is."
-
-  (set-buffer speedbar-buffer)
-  
-  (goto-char (point-min))
-  (let ((m nil))
-    (while (and (setq m (re-search-forward
-			 (concat " \\(" (regexp-quote (file-name-nondirectory file))
-				 "\\)\\(" speedbar-indicator-regex "\\)?\n")
-			 nil t))
-		(not (string= file
-			      (concat
-			       (speedbar-line-path
-				(save-excursion
-				  (goto-char (match-beginning 0))
-				  (beginning-of-line)
-				  (save-match-data
-				    (looking-at "[0-9]+:")
-				    (string-to-number (match-string 0)))))
-			       (match-string 1))))))
-    (if m
-	(progn
-	  (goto-char (match-beginning 1))
-	  (match-string 1)))))
-
-(defun speedbar-clear-current-file ()
-  "Locate the file thought to be current, and remove its highlighting."
-  (save-excursion
-    ;;(set-buffer speedbar-buffer)
-    (if speedbar-last-selected-file
-	(speedbar-with-writable
-	  (if (speedbar-find-selected-file speedbar-last-selected-file)
-	      (put-text-property (match-beginning 1)
-				 (match-end 1)
-				 'face
-				 'speedbar-file-face))))))
-
-(defun speedbar-update-current-file ()
-  "Find the current file, and update our visuals to indicate its name.
-This is specific to file names.  If the file name doesn't show up, but
-it should be in the list, then the directory cache needs to be
-updated."
-  (let* ((lastf (selected-frame))
-	 (newcfd (save-excursion
-		   (dframe-select-attached-frame speedbar-frame)
-		   (let ((rf (if (buffer-file-name)
-				 (buffer-file-name)
-			       nil)))
-		     (select-frame lastf)
-		     rf)))
-	 (newcf (if newcfd newcfd))
-	 (lastb (current-buffer))
-	 (sucf-recursive (boundp 'sucf-recursive))
-	 (case-fold-search t))
-    (if (and newcf
-	     ;; check here, that way we won't refresh to newcf until
-	     ;; its been written, thus saving ourselves some time
-	     (file-exists-p newcf)
-	     (not (string= newcf speedbar-last-selected-file)))
-	(progn
-	  ;; It is important to select the frame, otherwise the window
-	  ;; we want the cursor to move in will not be updated by the
-	  ;; search-forward command.
-	  (select-frame (speedbar-current-frame))
-	  ;; Remove the old file...
-	  (speedbar-clear-current-file)
-	  ;; now highlight the new one.
-	  ;; (set-buffer speedbar-buffer)
-	  (speedbar-with-writable
-	    (if (speedbar-find-selected-file newcf)
-		;; put the property on it
-		(put-text-property (match-beginning 1)
-				   (match-end 1)
-				   'face
-				   'speedbar-selected-face)
-	      ;; Oops, it's not in the list.  Should it be?
-	      (if (and (string-match speedbar-file-regexp newcf)
-		       (string= (file-name-directory newcfd)
-				(expand-file-name default-directory)))
-		  ;; yes, it is (we will ignore unknowns for now...)
-		  (progn
-		    (speedbar-refresh)
-		    (if (speedbar-find-selected-file newcf)
-			;; put the property on it
-			(put-text-property (match-beginning 1)
-					   (match-end 1)
-					   'face
-					   'speedbar-selected-face)))
-		;; if it's not in there now, whatever...
-		))
-	    (setq speedbar-last-selected-file newcf))
-	  (if (not sucf-recursive)
-	      (progn
-
-                ;;Sat Dec 15 2001 12:40 AM (burton@openprivacy.org): this
-                ;;doesn't need to be in.  We don't want to recenter when we are
-                ;;updating files.
-
-                ;;(speedbar-center-buffer-smartly)
-
-		(speedbar-position-cursor-on-line)
-		))
-	  (set-buffer lastb)
-	  (select-frame lastf)
-	  )))
-  ;; return that we are done with this activity.
-  t)
-
-(defun speedbar-add-indicator (indicator-string &optional replace-this)
-  "Add INDICATOR-STRING to the end of this speedbar line.
-If INDICATOR-STRING is space, and REPLACE-THIS is a character, then
-an the existing indicator is removed.  If there is already an
-indicator, then do not add a space."
-  (beginning-of-line)
-  ;; The nature of the beast: Assume we are in "the right place"
-  (end-of-line)
-  (skip-chars-backward (concat " " speedbar-vc-indicator
-			       (car speedbar-obj-indicator)
-			       (cdr speedbar-obj-indicator)))
-  (if (and (not (looking-at speedbar-indicator-regex))
-	   (not (string= indicator-string " ")))
-      (insert speedbar-indicator-separator))
-  (speedbar-with-writable
-    (save-excursion
-      (if (and replace-this
-	       (re-search-forward replace-this (save-excursion (end-of-line)
-							       (point))
-				  t))
-	  (delete-region (match-beginning 0) (match-end 0))))
-    (end-of-line)
-    (if (not (string= " " indicator-string))
-	(let ((start (point)))
-	  (insert indicator-string)
-	  (speedbar-insert-image-button-maybe start (length indicator-string))
-	  ))))
-
-(defun speedbar-check-read-only ()
-  "Scan all the files in a directory, and for each see if it is read only."
-  ;; Check for to-do to be reset.  If reset but no RCS is available
-  ;; then set to nil (do nothing) otherwise, start at the beginning
-  (save-excursion
-    (if speedbar-buffer (set-buffer speedbar-buffer))
-    (if (eq speedbar-ro-to-do-point t)
-	(setq speedbar-ro-to-do-point 0))
-    (if (numberp speedbar-ro-to-do-point)
-	(progn
-	  (goto-char speedbar-ro-to-do-point)
-	  (while (and (not (input-pending-p))
-		      (re-search-forward "^\\([0-9]+\\):\\s-*[[<][+-\?][]>] "
-					 nil t))
-	    (setq speedbar-ro-to-do-point (point))
-	    (if (not (file-writable-p (speedbar-line-file)))
-		(speedbar-add-indicator
-		 speedbar-object-read-only-indicator
-		 (regexp-quote speedbar-object-read-only-indicator))
-	      (speedbar-add-indicator
-	       " " (regexp-quote speedbar-object-read-only-indicator))))
-	  (if (input-pending-p)
-	      ;; return that we are incomplete
-	      nil
-	    ;; we are done, set to-do to nil
-	    (setq speedbar-ro-to-do-point nil)
-	    ;; and return t
-	    t))
-      t)))
-
-;; Load efs/ange-ftp only if compiling to remove byte-compiler warnings.
-;; Steven L Baur <steve@xemacs.org> said this was important:
-(eval-when-compile (or (featurep 'xemacs)
-		       (condition-case () (require 'efs)
-			 (error (require 'ange-ftp)))))
-
-(defun speedbar-check-vc ()
-  "Scan all files in a directory, and for each see if it's checked out.
-See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how
-to add more types of version control systems."
-  ;; Check for to-do to be reset.  If reset but no RCS is available
-  ;; then set to nil (do nothing) otherwise, start at the beginning
-  (save-excursion
-    (if speedbar-buffer (set-buffer speedbar-buffer))
-    (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t)
-	     (speedbar-vc-check-dir-p default-directory)
-	     (not (or (and (featurep 'ange-ftp)
-			   (string-match
-			    (car (if dframe-xemacsp
-				     ange-ftp-path-format
-				   ange-ftp-name-format))
-			    (expand-file-name default-directory)))
-		      ;; efs support: Bob Weiner
-		      (and (featurep 'efs)
-			   (string-match
-			    (if (stringp efs-path-regexp)
-				efs-path-regexp
-			      (car efs-path-regexp))
-			    (expand-file-name default-directory))))))
-	(setq speedbar-vc-to-do-point 0))
-    (if (numberp speedbar-vc-to-do-point)
-	(progn
-	  (goto-char speedbar-vc-to-do-point)
-	  (while (and (not (input-pending-p))
-		      (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-?]\\] "
-					 nil t))
-	    (setq speedbar-vc-to-do-point (point))
-	    (if (speedbar-check-vc-this-line (match-string 1))
-		(speedbar-add-indicator speedbar-vc-indicator
-					(regexp-quote speedbar-vc-indicator))
-	      (speedbar-add-indicator " "
-				      (regexp-quote speedbar-vc-indicator))))
-	  (if (input-pending-p)
-	      ;; return that we are incomplete
-	      nil
-	    ;; we are done, set to-do to nil
-	    (setq speedbar-vc-to-do-point nil)
-	    ;; and return t
-	    t))
-      t)))
-
-(defun speedbar-check-vc-this-line (depth)
-  "Return t if the file on this line is check of of a version control system.
-Parameter DEPTH is a string with the current depth of indentation of
-the file being checked."
-  (let* ((d (string-to-int depth))
-	 (f (speedbar-line-path d))
-	 (fn (buffer-substring-no-properties
-	      ;; Skip-chars: thanks ptype@dra.hmg.gb
-	      (point) (progn
-			(skip-chars-forward "^ "
-					    (save-excursion (end-of-line)
-							    (point)))
-			(point))))
-	 (fulln (concat f fn)))
-    (if (<= 2 speedbar-verbosity-level)
-	(speedbar-message "Speedbar vc check...%s" fulln))
-    (and (file-writable-p fulln)
-	 (speedbar-this-file-in-vc f fn))))
-
-(defun speedbar-vc-check-dir-p (path)
-  "Return t if we should bother checking PATH for version control files.
-This can be overloaded to add new types of version control systems."
-  (or
-   ;; Local CVS available in Emacs 21
-   (and (fboundp 'vc-state)
-	(file-exists-p (concat path "CVS/")))
-   ;; Local RCS
-   (file-exists-p (concat path "RCS/"))
-   ;; Local SCCS
-   (file-exists-p (concat path "SCCS/"))
-   ;; Remote SCCS project
-   (let ((proj-dir (getenv "PROJECTDIR")))
-     (if proj-dir
-	 (file-exists-p (concat proj-dir "/SCCS"))
-       nil))
-   ;; User extension
-   (run-hook-with-args 'speedbar-vc-path-enable-hook path)
-   ))
-
-(defun speedbar-this-file-in-vc (path name)
-  "Check to see if the file in PATH with NAME is in a version control system.
-You can add new VC systems by overriding this function.  You can
-optimize this function by overriding it and only doing those checks
-that will occur on your system."
-  (or
-   (if (fboundp 'vc-state)
-       ;; Emacs 21 handles VC state in a nice way.
-       (condition-case nil
-	   (not (eq 'up-to-date (vc-state (concat path name))))
-	 ;; An error means not in a VC system
-	 (error nil))
-     (or
-      ;; RCS file name
-      (file-exists-p (concat path "RCS/" name ",v"))
-      (file-exists-p (concat path "RCS/" name))
-      ;; Local SCCS file name
-      (file-exists-p (concat path "SCCS/s." name))
-      ;; Remote SCCS file name
-      (let ((proj-dir (getenv "PROJECTDIR")))
-	(if proj-dir
-	    (file-exists-p (concat proj-dir "/SCCS/s." name))
-	  nil))))
-   ;; User extension
-   (run-hook-with-args 'speedbar-vc-in-control-hook path name)
-   ))
-
-;; Objet File scanning
-(defun speedbar-check-objects ()
-  "Scan all files in a directory, and for each see if there is an object.
-See `speedbar-check-obj-this-line' and `speedbar-obj-alist' for how
-to add more object types."
-  ;; Check for to-do to be reset.  If reset but no RCS is available
-  ;; then set to nil (do nothing) otherwise, start at the beginning
-  (save-excursion
-    (if speedbar-buffer (set-buffer speedbar-buffer))
-    (if (and speedbar-obj-do-check (eq speedbar-obj-to-do-point t))
-	(setq speedbar-obj-to-do-point 0))
-    (if (numberp speedbar-obj-to-do-point)
-	(progn
-	  (goto-char speedbar-obj-to-do-point)
-	  (while (and (not (input-pending-p))
-		      (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] "
-					 nil t))
-	    (setq speedbar-obj-to-do-point (point))
-	    (let ((ind (speedbar-check-obj-this-line (match-string 1))))
-	      (if (not ind) (setq ind " "))
-	      (speedbar-add-indicator ind (concat
-					   (car speedbar-obj-indicator)
-					   "\\|"
-					   (cdr speedbar-obj-indicator)))))
-	  (if (input-pending-p)
-	      ;; return that we are incomplete
-	      nil
-	    ;; we are done, set to-do to nil
-	    (setq speedbar-obj-to-do-point nil)
-	    ;; and return t
-	    t))
-      t)))
-
-(defun speedbar-check-obj-this-line (depth)
-  "Return t if the file on this line has an associated object.
-Parameter DEPTH is a string with the current depth of indentation of
-the file being checked."
-  (let* ((d (string-to-int depth))
-	 (f (speedbar-line-path d))
-	 (fn (buffer-substring-no-properties
-	      ;; Skip-chars: thanks ptype@dra.hmg.gb
-	      (point) (progn
-			(skip-chars-forward "^ "
-					    (save-excursion (end-of-line)
-							    (point)))
-			(point))))
-	 (fulln (concat f fn)))
-    (if (<= 2 speedbar-verbosity-level)
-	(speedbar-message "Speedbar obj check...%s" fulln))
-    (let ((oa speedbar-obj-alist))
-      (while (and oa (not (string-match (car (car oa)) fulln)))
-	(setq oa (cdr oa)))
-      (if (not (and oa (file-exists-p (concat (file-name-sans-extension fulln)
-					      (cdr (car oa))))))
-	  nil
-	;; Find out if the object is out of date or not.
-	(let ((date1 (nth 5 (file-attributes fulln)))
-	      (date2 (nth 5 (file-attributes (concat
-					      (file-name-sans-extension fulln)
-                                              (cdr (car oa)))))))
-	  (if (or (< (car date1) (car date2))
-		  (and (= (car date1) (car date2))
-		       (< (nth 1 date1) (nth 1 date2))))
-	      (car speedbar-obj-indicator)
-	    (cdr speedbar-obj-indicator)))))))
-
-;;; Clicking Activity
-;;
-(defun speedbar-position-cursor-on-line ()
-  "Position the cursor on a line."
-  (let ((oldpos (point)))
-    (beginning-of-line)
-    (if (looking-at "[0-9]+:\\s-*..?.? ")
-	(goto-char (1- (match-end 0)))
-      (goto-char oldpos))))
-
-(defun speedbar-click (e)
-  "Activate any speedbar buttons where the mouse is clicked.
-This must be bound to a mouse event.  A button is any location of text
-with a mouse face that has a text property called `speedbar-function'.
-Argument E is the click event."
-  ;; Backward compatibility let statement.
-  (let ((speedbar-power-click dframe-power-click))
-    (speedbar-do-function-pointer))
-  (dframe-quick-mouse e))
-
-(defun speedbar-do-function-pointer ()
-  "Look under the cursor and examine the text properties.
-From this extract the file/tag name, token, indentation level and call
-a function if appropriate"
-  (let* ((speedbar-frame (speedbar-current-frame))
-	 (fn (get-text-property (point) 'speedbar-function))
-	 (tok (get-text-property (point) 'speedbar-token))
-	 ;; The 1-,+ is safe because scaning starts AFTER the point
-	 ;; specified.  This lets the search include the character the
-	 ;; cursor is on.
-	 (tp (previous-single-property-change
-	      (1+ (point)) 'speedbar-function))
-	 (np (next-single-property-change
-	      (point) 'speedbar-function))
-	 (txt (buffer-substring-no-properties (or tp (point-min))
-					      (or np (point-max))))
-	 (dent (save-excursion (beginning-of-line)
-			       (string-to-number
-				(if (looking-at "[0-9]+")
-				    (buffer-substring-no-properties
-				    (match-beginning 0) (match-end 0))
-				  "0")))))
-    ;;(speedbar-message "%S:%S:%S:%s" fn tok txt dent)
-    (and fn (funcall fn txt tok dent)))
-  (speedbar-position-cursor-on-line))
-
-;;; Reading info from the speedbar buffer
-;;
-(defun speedbar-line-text (&optional p)
-  "Retrieve the text after prefix junk for the current line.
-Optional argument P is where to start the search from."
-  (save-excursion
-    (if p (goto-char p))
-    (beginning-of-line)
-    (if (looking-at (concat
-		     "\\([0-9]+\\): *[[<{]?[-+?=][]>}@()|] \\([^ \n]+\\)"))
-	(get-text-property (match-beginning 2) 'speedbar-text)
-      nil)))
-
-(defun speedbar-line-token (&optional p)
-  "Retrieve the token information after the prefix junk for the current line.
-Optional argument P is where to start the search from."
-  (save-excursion
-    (if p (goto-char p))
-    (beginning-of-line)
-    (if (looking-at (concat
-		     "\\([0-9]+\\): *[[<{]?[-+?=][]>}@()|] \\([^ \n]+\\)\\("
-		     speedbar-indicator-regex "\\)?"))
-	(progn
-	  (goto-char (match-beginning 2))
-	  (get-text-property (point) 'speedbar-token))
-      nil)))
-
-(defun speedbar-line-file (&optional p)
-  "Retrieve the file or whatever from the line at P point.
-The return value is a string representing the file.  If it is a
-directory, then it is the directory name."
-  (save-match-data
-    (save-restriction
-      (widen)
-      (let ((f (speedbar-line-text p)))
-	(if f
-	    (let* ((depth (string-to-int (match-string 1)))
-		   (path (speedbar-line-path depth)))
-	      (if (file-exists-p (concat path f))
-		  (concat path f)
-		nil))
-	  nil)))))
-
-(defun speedbar-goto-this-file (file)
-  "If FILE is displayed, goto this line and return t.
-Otherwise do not move and return nil."
-  (let ((path (substring (file-name-directory (expand-file-name file))
-			 (length (expand-file-name default-directory))))
-	(dest (point)))
-    (save-match-data
-      (goto-char (point-min))
-      ;; scan all the directories
-      (while (and path (not (eq path t)))
-	(if (string-match "^[/\\]?\\([^/\\]+\\)" path)
-	    (let ((pp (match-string 1 path)))
-	      (if (save-match-data
-		    (re-search-forward (concat "> " (regexp-quote pp) "$")
-				       nil t))
-		  (setq path (substring path (match-end 1)))
-		(setq path nil)))
-	  (setq path t)))
-      ;; find the file part
-      (if (or (not path) (string= (file-name-nondirectory file) ""))
-	  ;; only had a dir part
-	  (if path
-	      (progn
-		(speedbar-position-cursor-on-line)
-		t)
-	    (goto-char dest) nil)
-	;; find the file part
-	(let ((nd (file-name-nondirectory file)))
-	  (if (re-search-forward
-	       (concat "] \\(" (regexp-quote nd)
-		       "\\)\\(" speedbar-indicator-regex "\\)$")
-	       nil t)
-	      (progn
-		(speedbar-position-cursor-on-line)
-		t)
-	    (goto-char dest)
-	    nil))))))
-
-(defun speedbar-line-path (&optional depth)
-  "Retrieve the pathname associated with the current line.
-This may require traversing backwards from DEPTH and combining the default
-directory with these items.  This function is replaceable in
-`speedbar-mode-functions-list' as `speedbar-line-path'"
-  (save-restriction
-    (widen)
-    (let ((rf (speedbar-fetch-replacement-function 'speedbar-line-path)))
-      (if rf (funcall rf depth) default-directory))))
-      
-(defun speedbar-files-line-path (&optional depth)
-  "Retrieve the pathname associated with the current line.
-This may require traversing backwards from DEPTH and combining the default
-directory with these items."
-  (save-excursion
-    (save-match-data
-      (if (not depth)
-	  (progn
-	    (beginning-of-line)
-	    (looking-at "^\\([0-9]+\\):")
-	    (setq depth (string-to-int (match-string 1)))))
-      (let ((path nil))
-	(setq depth (1- depth))
-	(while (/= depth -1)
-	  (if (not (re-search-backward (format "^%d:" depth) nil t))
-	      (error "Error building path of tag")
-	    (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
-		   (setq path (concat (buffer-substring-no-properties
-				       (match-beginning 1) (match-end 1))
-				      "/"
-				      path)))
-		  ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
-		   ;; This is the start of our path.
-		   (setq path (buffer-substring-no-properties
-			       (match-beginning 1) (match-end 1))))))
-	  (setq depth (1- depth)))
-	(if (and path
-		 (string-match (concat speedbar-indicator-regex "$")
-			       path))
-	    (setq path (substring path 0 (match-beginning 0))))
-	(concat default-directory path)))))
-
-(defun speedbar-path-line (path)
-  "Position the cursor on the line specified by PATH."
-  (save-match-data
-    (if (string-match "[/\\]$" path)
-	(setq path (substring path 0 (match-beginning 0))))
-    (let ((nomatch t) (depth 0)
-	  (fname (file-name-nondirectory path))
-	  (pname (file-name-directory path)))
-      (if (not (member pname speedbar-shown-directories))
-	  (error "Internal Error: File %s not shown in speedbar" path))
-      (goto-char (point-min))
-      (while (and nomatch
-		  (re-search-forward
-		   (concat "[]>] \\(" (regexp-quote fname)
-			   "\\)\\(" speedbar-indicator-regex "\\)?$")
-		   nil t))
-	(beginning-of-line)
-	(looking-at "\\([0-9]+\\):")
-	(setq depth (string-to-int (match-string 0))
-	      nomatch (not (string= pname (speedbar-line-path depth))))
-	(end-of-line))
-      (beginning-of-line)
-      (not nomatch))))
-
-(defun speedbar-edit-line ()
-  "Edit whatever tag or file is on the current speedbar line."
-  (interactive)
-  (or (save-excursion
-	(beginning-of-line)
-	;; If this fails, then it is a non-standard click, and as such,
-	;; perfectly allowed.
-	(if (re-search-forward "[]>?}] [^ ]"
-			       (save-excursion (end-of-line) (point))
-			       t)
-	    (speedbar-do-function-pointer)
-	  nil))
-      (speedbar-do-function-pointer)))
-
-(defun speedbar-expand-line (&optional arg)
-  "Expand the line under the cursor.
-With universal argument ARG, flush cached data."
-  (interactive "P")
-  (beginning-of-line)
-  (let* ((dframe-power-click arg)
-	 (speedbar-power-click arg))
-    (condition-case nil
-	(progn
-	  (re-search-forward ":\\s-*.\\+. "
-			     (save-excursion (end-of-line) (point)))
-	  (forward-char -2)
-	  (speedbar-do-function-pointer))
-      (error (speedbar-position-cursor-on-line)))))
-  
-(defun speedbar-flush-expand-line ()
-  "Expand the line under the cursor and flush any cached information."
-  (interactive)
-  (speedbar-expand-line 1))
-  
-(defun speedbar-contract-line ()
-  "Contract the line under the cursor."
-  (interactive)
-  (beginning-of-line)
-  (condition-case nil
-      (progn
-	(re-search-forward ":\\s-*.-. "
-			   (save-excursion (end-of-line) (point)))
-	(forward-char -2)
-	(speedbar-do-function-pointer))
-    (error (speedbar-position-cursor-on-line))))
-
-(defun speedbar-toggle-line-expansion ()
-  "Contract or expand the line under the cursor."
-  (interactive)
-  (beginning-of-line)
-  (condition-case nil
-      (progn
-	(re-search-forward ":\\s-*.[-+]. "
-			   (save-excursion (end-of-line) (point)))
-	(forward-char -2)
-	(speedbar-do-function-pointer))
-    (error (speedbar-position-cursor-on-line))))
-
-(defun speedbar-find-file (text token indent)
-  "Speedbar click handler for filenames.
-TEXT, the file will be displayed in the attached frame.
-TOKEN is unused, but required by the click handler.  INDENT is the
-current indentation level."
-  (let ((cdd (speedbar-line-path indent)))
-    (speedbar-find-file-in-frame (concat cdd text))
-    (speedbar-stealthy-updates)
-    (run-hooks 'speedbar-visiting-file-hook)
-    ;; Reset the timer with a new timeout when cliking a file
-    ;; in case the user was navigating directories, we can cancel
-    ;; that other timer.
-    (speedbar-set-timer dframe-update-speed))
-  (dframe-maybee-jump-to-attached-frame))
-
-(defun speedbar-dir-follow (text token indent)
-  "Speedbar click handler for directory names.
-Clicking a directory will cause the speedbar to list files in the
-the subdirectory TEXT.  TOKEN is an unused requirement.  The
-subdirectory chosen will be at INDENT level."
-  (setq default-directory
-	(concat (expand-file-name (concat (speedbar-line-path indent) text))
-		"/"))
-  ;; Because we leave speedbar as the current buffer,
-  ;; update contents will change directory without
-  ;; having to touch the attached frame.  Turn off smart expand just
-  ;; in case.
-  (let ((speedbar-smart-directory-expand-flag nil))
-    (speedbar-update-contents))
-  (speedbar-set-timer speedbar-navigating-speed)
-  (setq speedbar-last-selected-file nil)
-  (speedbar-stealthy-updates))
-
-(defun speedbar-delete-subblock (indent)
-  "Delete text from point to indentation level INDENT or greater.
-Handles end-of-sublist smartly."
-  (speedbar-with-writable
-    (save-excursion
-      (end-of-line) (forward-char 1)
-      (let ((start (point)))
-	(while (and (looking-at "^\\([0-9]+\\):")
-		    (> (string-to-int (match-string 1)) indent)
-		    (not (eobp)))
-	  (forward-line 1)
-	  (beginning-of-line))
-	(delete-region start (point))))))
-
-(defun speedbar-dired (text token indent)
-  "Speedbar click handler for directory expand button.
-Clicking this button expands or contracts a directory.  TEXT is the
-button clicked which has either a + or -.  TOKEN is the directory to be
-expanded.  INDENT is the current indentation level."
-  (cond ((string-match "+" text)	;we have to expand this dir
-	 (setq speedbar-shown-directories
-	       (cons (expand-file-name
-		      (concat (speedbar-line-path indent) token "/"))
-		     speedbar-shown-directories))
-	 (speedbar-change-expand-button-char ?-)
-	 (speedbar-reset-scanners)
-	 (save-excursion
-	   (end-of-line) (forward-char 1)
-	   (speedbar-with-writable
-	     (speedbar-default-directory-list
-	      (concat (speedbar-line-path indent) token "/")
-	      (1+ indent)))))
-	((string-match "-" text)	;we have to contract this node
-	 (speedbar-reset-scanners)
-	 (let ((oldl speedbar-shown-directories)
-	       (newl nil)
-	       (td (expand-file-name
-		    (concat (speedbar-line-path indent) token))))
-	   (while oldl
-	     (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
-		 (setq newl (cons (car oldl) newl)))
-	     (setq oldl (cdr oldl)))
-	   (setq speedbar-shown-directories (nreverse newl)))
-	 (speedbar-change-expand-button-char ?+)
-	 (speedbar-delete-subblock indent)
-	 )
-	(t (error "Ooops...  not sure what to do")))
-  (speedbar-center-buffer-smartly)
-  (save-excursion (speedbar-stealthy-updates)))
-
-(defun speedbar-directory-buttons-follow (text token indent)
-  "Speedbar click handler for default directory buttons.
-TEXT is the button clicked on.  TOKEN is the directory to follow.
-INDENT is the current indentation level and is unused."
-  (if (string-match "^[A-z]:$" token)
-      (setq default-directory (concat token (char-to-string directory-sep-char)))
-    (setq default-directory token))
-  ;; Because we leave speedbar as the current buffer,
-  ;; update contents will change directory without
-  ;; having to touch the attached frame.
-  (speedbar-update-contents)
-  (speedbar-set-timer speedbar-navigating-speed))
-
-(defun speedbar-tag-file (text token indent)
-  "The cursor is on a selected line.  Expand the tags in the specified file.
-The parameter TEXT and TOKEN are required, where TEXT is the button
-clicked, and TOKEN is the file to expand.  INDENT is the current
-indentation level."
-  (cond ((string-match "+" text)	;we have to expand this file
-	 (let* ((fn (expand-file-name (concat (speedbar-line-path indent)
-					      token)))
-		(mode nil)
-		(lst (speedbar-fetch-dynamic-tags fn)))
-	   ;; if no list, then remove expando button
-	   (if (not lst)
-	       (speedbar-change-expand-button-char ??)
-	     (speedbar-change-expand-button-char ?-)
-	     (speedbar-with-writable
-	       (save-excursion
-		 (end-of-line) (forward-char 1)
-		 (funcall (car lst) indent (cdr lst)))))))
-	((string-match "-" text)	;we have to contract this node
-	 (speedbar-change-expand-button-char ?+)
-	 (speedbar-delete-subblock indent))
-	(t (error "Ooops...  not sure what to do")))
-  (speedbar-center-buffer-smartly))
-
-(defun speedbar-tag-find (text token indent)
-  "For the tag TEXT in a file TOKEN, goto that position.
-INDENT is the current indentation level."
-  (let ((file (speedbar-line-path indent)))
-    (speedbar-find-file-in-frame file)
-    (save-excursion (speedbar-stealthy-updates))
-    ;; Reset the timer with a new timeout when cliking a file
-    ;; in case the user was navigating directories, we can cancel
-    ;; that other timer.
-    (speedbar-set-timer dframe-update-speed)
-    (goto-char token)
-    (run-hooks 'speedbar-visiting-tag-hook)
-    (dframe-maybee-jump-to-attached-frame)
-    ))
-
-(defun speedbar-tag-expand (text token indent)
-  "Expand a tag sublist.  Imenu will return sub-lists of specialized tag types.
-Etags does not support this feature.  TEXT will be the button
-string.  TOKEN will be the list, and INDENT is the current indentation
-level."
-  (cond ((string-match "+" text)	;we have to expand this file
-	 (speedbar-change-expand-button-char ?-)
-	 (speedbar-with-writable
-	   (save-excursion
-	     (end-of-line) (forward-char 1)
-	     (speedbar-insert-generic-list indent token 'speedbar-tag-expand
-					   'speedbar-tag-find))))
-	((string-match "-" text)	;we have to contract this node
-	 (speedbar-change-expand-button-char ?+)
-	 (speedbar-delete-subblock indent))
-	(t (error "Ooops...  not sure what to do")))
-  (speedbar-center-buffer-smartly))
-
-;;; Loading files into the attached frame.
-;;
-(defcustom speedbar-select-frame-method 1
-  "*Specify how to select a frame for displaying a file.
-A value of 'attached means to use the attached frame (the frame
-that speedbar was started from.)  A number such as 1 or -1 means to
-pass that number to `other-frame' while selecting a frame from speedbar."
-  :group 'speedbar
-  :type 'sexp)
-
-(defun speedbar-find-file-in-frame (file)
-  "This will load FILE into the speedbar attached frame.
-If the file is being displayed in a different frame already, then raise that
-frame instead."
-  (let* ((buff (find-file-noselect file))
-	 (bwin (get-buffer-window buff 0)))
-    (if bwin
-	(progn
-	  (select-window bwin)
-	  (raise-frame (window-frame bwin)))
-      (if dframe-power-click
-	  (let ((pop-up-frames t)) (select-window (display-buffer buff)))
-	(if (numberp speedbar-select-frame-method)
-	    (other-frame speedbar-select-frame-method)
-	  (dframe-select-attached-frame speedbar-frame))
-	(switch-to-buffer buff))))
- )
-
-;;; Centering Utility
-;;
-(defun speedbar-center-buffer-smartly ()
-  "Recenter a speedbar buffer so the current indentation level is all visible.
-This assumes that the cursor is on a file, or tag of a file which the user is
-interested in."
-
-  (save-selected-window
-  
-    (select-window (get-buffer-window speedbar-buffer t))
-    
-    (set-buffer speedbar-buffer)
-    
-    (if (<= (count-lines (point-min) (point-max))
-	    (1- (window-height (selected-window))))
-	;; whole buffer fits
-	(let ((cp (point)))
-
-	  (goto-char (point-min))
-	  (recenter 0)
-	  (goto-char cp))
-      ;; too big
-      (let (depth start end exp p)
-	(save-excursion
-	  (beginning-of-line)
-	  (setq depth (if (looking-at "[0-9]+")
-			  (string-to-int (buffer-substring-no-properties
-					  (match-beginning 0) (match-end 0)))
-			0))
-	  (setq exp (format "^%d:" depth)))
-	(save-excursion
-	  (end-of-line)
-	  (if (re-search-backward exp nil t)
-	      (setq start (point))
-	    (setq start (point-min)))
-	  (save-excursion		;Not sure about this part.
-	    (end-of-line)
-	    (setq p (point))
-	    (while (and (not (re-search-forward exp nil t))
-			(>= depth 0))
-	      (setq depth (1- depth))
-	      (setq exp (format "^%d:" depth)))
-	    (if (/= (point) p)
-		(setq end (point))
-	      (setq end (point-max)))))
-	;; Now work out the details of centering
-	(let ((nl (count-lines start end))
-              (wl (1- (window-height (selected-window))))
-	      (cp (point)))
-	  (if (> nl wl)
-	      ;; We can't fit it all, so just center on cursor
-	      (progn (goto-char start)
-		     (recenter 1))
-	    ;; we can fit everything on the screen, but...
-	    (if (and (pos-visible-in-window-p start (selected-window))
-		     (pos-visible-in-window-p end (selected-window)))
-		;; we are all set!
-		nil
-	      ;; we need to do something...
-	      (goto-char start)
-	      (let ((newcent (/ (- (window-height (selected-window)) nl) 2))
-		    (lte (count-lines start (point-max))))
-		(if (and (< (+ newcent lte) (window-height (selected-window)))
-			 (> (- (window-height (selected-window)) lte 1)
-			    newcent))
-		    (setq newcent (- (window-height (selected-window))
-				     lte 1)))
-		(recenter newcent))))
-          (goto-char cp))))))
-
-;;; Tag Management -- List of expanders:
-;;
-(defun speedbar-fetch-dynamic-tags (file)
-  "Return a list of tags generated dynamically from FILE.
-This uses the entries in `speedbar-dynamic-tags-function-list'
-to find the proper tags.  It is up to each of those individual
-functions to do caching and flushing if appropriate."
-  (save-excursion
-    ;; If there is a buffer-local value of
-    ;; speedbar-dynamic-tags-function-list, it will now be available.
-    (let ((dtf speedbar-dynamic-tags-function-list)
-	  (ret t))
-      (while (and (eq ret t) dtf)
-	(setq ret
-	      (if (fboundp (car (car dtf)))
-		  (funcall (car (car dtf)) file)
-		t))
-	(if (eq ret t)
-	    (setq dtf (cdr dtf))))
-      (if (eq ret t)
-	  ;; No valid tag list, return nil
-	  nil
-	;; We have some tags.  Return the list with the insert fn
-	;; prepended
-	(cons (cdr (car dtf)) ret)))))
-
-;;; Tag Management -- Imenu
-;;
-(if (not speedbar-use-imenu-flag)
-
-    nil
-
-(eval-when-compile (if (locate-library "imenu") (require 'imenu)))
-
-(defun speedbar-fetch-dynamic-imenu (file)
-  "Load FILE into a buffer, and generate tags using Imenu.
-Returns the tag list, or t for an error."
-  ;; Load this AND compile it in
-  (require 'imenu)
-  (set-buffer (find-file-noselect file))
-  (if dframe-power-click (setq imenu--index-alist nil))
-  (condition-case nil
-      (let ((index-alist (imenu--make-index-alist t)))
-	(if speedbar-sort-tags
-	    (sort (copy-alist index-alist)
-		  (lambda (a b) (string< (car a) (car b))))
-	  index-alist))
-    (error t)))
-)
-
-;;; Tag Management -- etags  (old XEmacs compatibility part)
-;;
-(defvar speedbar-fetch-etags-parse-list
-  '(;; Note that java has the same parse-group as c
-    ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\|cxx\\|hxx\\)\\'" .
-     speedbar-parse-c-or-c++tag)
-    ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" .
-     "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
-;    ("\\.\\([fF]\\|for\\|FOR\\|77\\|90\\)\\'" .
-;      speedbar-parse-fortran77-tag)
-    ("\\.tex\\'" . speedbar-parse-tex-string)
-    ("\\.p\\'" .
-     "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?")
-    )
-  "Associations of file extensions and expressions for extracting tags.
-To add a new file type, you would want to add a new association to the
-list, where the car is the file match, and the cdr is the way to
-extract an element from the tags output.  If the output is complex,
-use a function symbol instead of regexp.  The function should expect
-to be at the beginning of a line in the etags buffer.
-
-This variable is ignored if `speedbar-use-imenu-flag' is non-nil.")
-
-(defvar speedbar-fetch-etags-command "etags"
-  "*Command used to create an etags file.
-
-This variable is ignored if `speedbar-use-imenu-flag' is t")
-
-(defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-")
-  "*List of arguments to use with `speedbar-fetch-etags-command'.
-This creates an etags output buffer.  Use `speedbar-toggle-etags' to
-modify this list conveniently.
-
-This variable is ignored if `speedbar-use-imenu-flag' is t")
-
-(defun speedbar-toggle-etags (flag)
-  "Toggle FLAG in `speedbar-fetch-etags-arguments'.
-FLAG then becomes a member of etags command line arguments.  If flag
-is \"sort\", then toggle the value of `speedbar-sort-tags'.  If its
-value is \"show\" then toggle the value of
-`speedbar-show-unknown-files'.
-
-  This function is a convenience function for XEmacs menu created by
-Farzin Guilak <farzin@protocol.com>"
-  (interactive)
-  (cond
-   ((equal flag "sort")
-    (setq speedbar-sort-tags (not speedbar-sort-tags)))
-   ((equal flag "show")
-    (setq speedbar-show-unknown-files (not speedbar-show-unknown-files)))
-   ((or (equal flag "-C")
-	(equal flag "-S")
-	(equal flag "-D"))
-    (if (member flag speedbar-fetch-etags-arguments)
-	(setq speedbar-fetch-etags-arguments
-	      (delete flag speedbar-fetch-etags-arguments))
-      (add-to-list 'speedbar-fetch-etags-arguments flag)))
-   (t nil)))
-
-(defun speedbar-fetch-dynamic-etags (file)
-  "For FILE, run etags and create a list of symbols extracted.
-Each symbol will be associated with its line position in FILE."
-  (let ((newlist nil))
-    (unwind-protect
-	(save-excursion
-	  (if (get-buffer "*etags tmp*")
-	      (kill-buffer "*etags tmp*"))	;kill to clean it up
-	  (if (<= 1 speedbar-verbosity-level)
-	      (speedbar-message "Fetching etags..."))
-	  (set-buffer (get-buffer-create "*etags tmp*"))
-	  (apply 'call-process speedbar-fetch-etags-command nil
-		 (current-buffer) nil
-		 (append speedbar-fetch-etags-arguments (list file)))
-	  (goto-char (point-min))
-	  (if (<= 1 speedbar-verbosity-level)
-	      (speedbar-message "Fetching etags..."))
-	  (let ((expr
-		 (let ((exprlst speedbar-fetch-etags-parse-list)
-		       (ans nil))
-		   (while (and (not ans) exprlst)
-		     (if (string-match (car (car exprlst)) file)
-			 (setq ans (car exprlst)))
-		     (setq exprlst (cdr exprlst)))
-		   (cdr ans))))
-	    (if expr
-		(let (tnl)
-		  (set-buffer (get-buffer-create "*etags tmp*"))
-		  (while (not (save-excursion (end-of-line) (eobp)))
-		    (save-excursion
-		      (setq tnl (speedbar-extract-one-symbol expr)))
-		    (if tnl (setq newlist (cons tnl newlist)))
-		    (forward-line 1)))
-	      (speedbar-message
-	       "Sorry, no support for a file of that extension"))))
-      )
-    (if speedbar-sort-tags
-	(sort newlist (lambda (a b) (string< (car a) (car b))))
-      (reverse newlist))))
-
-;; This bit donated by Farzin Guilak <farzin@protocol.com> but I'm not
-;; sure it's needed with the different sorting method.
-;;
-;(defun speedbar-clean-etags()
-;  "Removes spaces before the ^? character, and removes `#define',
-;return types, etc. preceding tags.  This ensures that the sort operation
-;works on the tags, not the return types."
-;  (save-excursion
-;    (goto-char (point-min))
-;    (while
-;	(re-search-forward "(?[ \t](?\C-?" nil t)
-;      (replace-match "\C-?" nil nil))
-;    (goto-char (point-min))
-;    (while
-;	(re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t)
-;      (delete-region (match-beginning 1) (match-end 1)))))
-
-(defun speedbar-extract-one-symbol (expr)
-  "At point, return nil, or one alist in the form: (SYMBOL .  POSITION)
-The line should contain output from etags.  Parse the output using the
-regular expression EXPR"
-  (let* ((sym (if (stringp expr)
-		  (if (save-excursion
-			(re-search-forward expr (save-excursion
-						  (end-of-line)
-						  (point)) t))
-		      (buffer-substring-no-properties (match-beginning 1)
-						      (match-end 1)))
-		(funcall expr)))
-	 (pos (let ((j (re-search-forward "[\C-?\C-a]\\([0-9]+\\),\\([0-9]+\\)"
-					  (save-excursion
-					    (end-of-line)
-					    (point))
-					  t)))
-		(if (and j sym)
-		    (1+ (string-to-int (buffer-substring-no-properties
-					(match-beginning 2)
-					(match-end 2))))
-		  0))))
-    (if (/= pos 0)
-	(cons sym pos)
-      nil)))
-
-(defun speedbar-parse-c-or-c++tag ()
-  "Parse a c or c++ tag, which tends to be a little complex."
-  (save-excursion
-    (let ((bound (save-excursion (end-of-line) (point))))
-      (cond ((re-search-forward "\C-?\\([^\C-a]+\\)\C-a" bound t)
-	     (buffer-substring-no-properties (match-beginning 1)
-					     (match-end 1)))
-	    ((re-search-forward "\\<\\([^ \t]+\\)\\s-+new(" bound t)
-	     (buffer-substring-no-properties (match-beginning 1)
-					     (match-end 1)))
-	    ((re-search-forward "\\<\\([^ \t(]+\\)\\s-*(\C-?" bound t)
-	     (buffer-substring-no-properties (match-beginning 1)
-					     (match-end 1)))
-	    (t nil))
-      )))
-
-(defun speedbar-parse-tex-string ()
-  "Parse a Tex string.  Only find data which is relevant."
-  (save-excursion
-    (let ((bound (save-excursion (end-of-line) (point))))
-      (cond ((re-search-forward "\\(\\(sub\\)*section\\|chapter\\|cite\\)\\s-*{[^\C-?}]*}?" bound t)
-	     (buffer-substring-no-properties (match-beginning 0)
-					     (match-end 0)))
-	    (t nil)))))
-
-
-;;; BUFFER DISPLAY mode.
-;;
-(defvar speedbar-buffers-key-map nil
-  "Keymap used when in the buffers display mode.")
-
-(if speedbar-buffers-key-map
-    nil
-  (setq speedbar-buffers-key-map (speedbar-make-specialized-keymap))
-
-  ;; Basic tree features
-  (define-key speedbar-buffers-key-map "e" 'speedbar-edit-line)
-  (define-key speedbar-buffers-key-map "\C-m" 'speedbar-edit-line)
-  (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line)
-  (define-key speedbar-buffers-key-map "=" 'speedbar-expand-line)
-  (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line)
-  (define-key speedbar-buffers-key-map " " 'speedbar-toggle-line-expansion)
-
-  ;; Buffer specific keybindings
-  (define-key speedbar-buffers-key-map "k" 'speedbar-buffer-kill-buffer)
-  (define-key speedbar-buffers-key-map "r" 'speedbar-buffer-revert-buffer)
-
-  )
-
-(defvar speedbar-buffer-easymenu-definition
-  '(["Jump to buffer" speedbar-edit-line t]
-    ["Expand File Tags" speedbar-expand-line
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.\\+. "))]
-    ["Flush Cache & Expand" speedbar-flush-expand-line
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.\\+. "))]
-    ["Contract File Tags" speedbar-contract-line
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.-. "))]
-    ["Kill Buffer" speedbar-buffer-kill-buffer
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.[-+?]. "))]
-    ["Revert Buffer" speedbar-buffer-revert-buffer
-     (save-excursion (beginning-of-line)
-		     (looking-at "[0-9]+: *.[-+?]. "))]
-    )
-  "Menu item elements shown when displaying a buffer list.")
-
-(defun speedbar-buffer-buttons (directory zero)
-  "Create speedbar buttons based on the buffers currently loaded.
-DIRECTORY is the path to the currently active buffer, and ZERO is 0."
-  (speedbar-buffer-buttons-engine nil))
-
-(defun speedbar-buffer-buttons-temp (directory zero)
-  "Create speedbar buttons based on the buffers currently loaded.
-DIRECTORY is the path to the currently active buffer, and ZERO is 0."
-  (speedbar-buffer-buttons-engine t))
-
-(defun speedbar-buffer-buttons-engine (temp)
-  "Create speedbar buffer buttons.
-If TEMP is non-nil, then clicking on a buffer restores the previous display."
-  (speedbar-insert-separator "Active Buffers:")
-  (let ((bl (buffer-list))
-	(case-fold-search t))
-    (while bl
-      (if (string-match "^[ *]" (buffer-name (car bl)))
-	  nil
-	(let* ((known (string-match speedbar-file-regexp
-				    (buffer-name (car bl))))
-	       (expchar (if known ?+ ??))
-	       (fn (if known 'speedbar-tag-file nil))
-	       (fname (save-excursion (set-buffer (car bl))
-				      (buffer-file-name))))
-	  (speedbar-make-tag-line 'bracket expchar fn
-				  (if fname (file-name-nondirectory fname))
-				  (buffer-name (car bl))
-				  'speedbar-buffer-click temp
-				  'speedbar-file-face 0)
-	  (speedbar-buffers-tail-notes (car bl))))
-      (setq bl (cdr bl)))
-    (setq bl (buffer-list))
-    (speedbar-insert-separator "Scratch Buffers:")
-    (while bl
-      (if (not (string-match "^\\*" (buffer-name (car bl))))
-	  nil
-	(if (eq (car bl) speedbar-buffer)
-	    nil
-	  (speedbar-make-tag-line 'bracket ?? nil nil
-				  (buffer-name (car bl))
-				  'speedbar-buffer-click temp
-				  'speedbar-file-face 0)
-	  (speedbar-buffers-tail-notes (car bl))))
-      (setq bl (cdr bl)))
-    (setq bl (buffer-list))
-    (speedbar-insert-separator "Hidden Buffers:")
-    (while bl
-      (if (not (string-match "^ " (buffer-name (car bl))))
-	  nil
-	(if (eq (car bl) speedbar-buffer)
-	    nil
-	  (speedbar-make-tag-line 'bracket ?? nil nil
-				  (buffer-name (car bl))
-				  'speedbar-buffer-click temp
-				  'speedbar-file-face 0)
-	  (speedbar-buffers-tail-notes (car bl))))
-      (setq bl (cdr bl)))))
-
-(defun speedbar-buffers-tail-notes (buffer)
-  "Add a note to the end of the last tag line.
-Argument BUFFER is the buffer being tested."
-  (let (mod ro)
-    (save-excursion
-      (set-buffer buffer)
-      (setq mod (buffer-modified-p)
-	    ro buffer-read-only))
-    (if ro (speedbar-insert-button "%" nil nil nil nil t))))
-
-(defun speedbar-buffers-item-info ()
-  "Display information about the current buffer on the current line."
-  (or (speedbar-item-info-tag-helper)
-      (let* ((item (speedbar-line-text))
-	     (buffer (if item (get-buffer item) nil)))
-	(and buffer
-	     (speedbar-message "%s%s %S %d %s"
-			       (if (buffer-modified-p buffer) "* " "")
-			       item
-			       (save-excursion (set-buffer buffer) major-mode)
-			       (save-excursion (set-buffer buffer)
-					       (buffer-size))
-			       (or (buffer-file-name buffer) "<No file>"))))))
-
-(defun speedbar-buffers-line-path (&optional depth)
-  "Fetch the full path to the file (buffer) specified on the current line.
-Optional argument DEPTH specifies the current depth of the back search."
-  (save-excursion
-    (end-of-line)
-    (let ((start (point)))
-      ;; Buffers are always at level 0
-      (if (not (re-search-backward "^0:" nil t))
-	  nil
-	(let* ((bn (speedbar-line-text))
-	       (buffer (if bn (get-buffer bn))))
-	  (if buffer
-	      (if (save-excursion
-		    (end-of-line)
-		    (eq start (point)))
-		  (or (save-excursion (set-buffer buffer)
-				      default-directory)
-		      "")
-		(buffer-file-name buffer))))))))
-
-(defun speedbar-buffer-click (text token indent)
-  "When the users clicks on a buffer-button in speedbar.
-TEXT is the buffer's name, TOKEN and INDENT are unused."
-  (if dframe-power-click
-      (let ((pop-up-frames t)) (select-window (display-buffer text)))
-    (dframe-select-attached-frame speedbar-frame)
-    (switch-to-buffer text)
-    (if token (speedbar-change-initial-expansion-list
-	       speedbar-previously-used-expansion-list-name))))
-
-(defun speedbar-buffer-kill-buffer ()
-  "Kill the buffer the cursor is on in the speedbar buffer."
-  (interactive)
-  (or (save-excursion
-	(let ((text (speedbar-line-text)))
-	  (if (and (get-buffer text)
-		   (speedbar-y-or-n-p (format "Kill buffer %s? " text)))
-	      (kill-buffer text))
-	  (speedbar-refresh)))))
-
-(defun speedbar-buffer-revert-buffer ()
-  "Revert the buffer the cursor is on in the speedbar buffer."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    ;; If this fails, then it is a non-standard click, and as such,
-    ;; perfectly allowed
-    (if (re-search-forward "[]>?}] [^ ]"
-			   (save-excursion (end-of-line) (point))
-			   t)
-	(let ((text (progn
-		      (forward-char -1)
-		      (buffer-substring (point) (save-excursion
-						  (end-of-line)
-						  (point))))))
-	  (if (get-buffer text)
-	      (progn
-		(set-buffer text)
-		(revert-buffer t)))))))
-
-
-;;; Useful hook values and such.
-;;
-(defvar speedbar-highlight-one-tag-line nil
-  "Overlay used for highlighting the most recently jumped to tag line.")
-
-(defun speedbar-highlight-one-tag-line ()
-  "Highlight the current line, unhighlighting a previously jumped to line."
-  (speedbar-unhighlight-one-tag-line)
-  (setq speedbar-highlight-one-tag-line
-	(speedbar-make-overlay (save-excursion (beginning-of-line) (point))
-			       (save-excursion (end-of-line)
-					       (forward-char 1)
-					       (point))))
-  (speedbar-overlay-put speedbar-highlight-one-tag-line 'face
-			'speedbar-highlight-face)
-  (add-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line)
-  )
-
-(defun speedbar-unhighlight-one-tag-line ()
-  "Unhighlight the currently highlight line."
-  (if speedbar-highlight-one-tag-line
-      (progn
-	(speedbar-delete-overlay speedbar-highlight-one-tag-line)
-	(setq speedbar-highlight-one-tag-line nil)))
-  (remove-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line))
-
-(defun speedbar-recenter-to-top ()
-  "Recenter the current buffer so POINT is on the top of the window."
-  (recenter 1))
-
-(defun speedbar-recenter ()
-  "Recenter the current buffer so POINT is in the center of the window."
-  (recenter (/ (window-height (selected-window)) 2)))
-
-
-;;; Color loading section.
-;;
-(defface speedbar-button-face '((((class color) (background light))
-				 (:foreground "green4"))
-				(((class color) (background dark))
-				 (:foreground "green3")))
-  "Face used for +/- buttons."
-  :group 'speedbar-faces)
-
-(defface speedbar-file-face '((((class color) (background light))
-			       (:foreground "cyan4"))
-			      (((class color) (background dark))
-			       (:foreground "cyan"))
-			      (t (:bold t)))
-  "Face used for file names."
-  :group 'speedbar-faces)
-
-(defface speedbar-directory-face '((((class color) (background light))
-				    (:foreground "blue4"))
-				   (((class color) (background dark))
-				    (:foreground "light blue")))
-  "Faced used for directory names."
-  :group 'speedbar-faces)
-(defface speedbar-tag-face '((((class color) (background light))
-			      (:foreground "brown"))
-			     (((class color) (background dark))
-			      (:foreground "yellow")))
-  "Face used for displaying tags."
-  :group 'speedbar-faces)
-
-(defface speedbar-selected-face '((((class color) (background light))
-				    (:foreground "red" :underline t))
-				  (((class color) (background dark))
-				   (:foreground "red" :underline t))
-				  (t (:underline t)))
-  "Face used to underline the file in the active window."
-  :group 'speedbar-faces)
-
-(defface speedbar-highlight-face '((((class color) (background light))
-				    (:background "green"))
-				   (((class color) (background dark))
-				    (:background "sea green"))
-				   (((class grayscale monochrome)
-				     (background light))
-				    (:background "black"))
-				   (((class grayscale monochrome)
-				     (background dark))
-				    (:background "white")))
-  "Face used for highlighting buttons with the mouse."
-  :group 'speedbar-faces)
-
-(defface speedbar-separator-face '((((class color) (background light))
-				    (:background "blue"
-				     :foreground "white"
-				     :overline "gray"))
-				   (((class color) (background dark))
-				    (:background "blue"
-				     :foreground "white"
-				     :overline "gray"))
-				   (((class grayscale monochrome)
-				     (background light))
-				    (:background "black"
-				     :foreground "white"
-				     :overline "white"))
-				   (((class grayscale monochrome)
-				     (background dark))
-				    (:background "white"
-				     :foreground "black"
-				     :overline "black")))
-  "Face used for separator labes in a display."
-  :group 'speedbar-faces)
-
-;; some edebug hooks
-(add-hook 'edebug-setup-hook
-	  (lambda ()
-	    (def-edebug-spec speedbar-with-writable def-body)))
-
-;; Fix a font lock problem for some versions of Emacs
-(if (boundp 'font-lock-global-modes)
-    (if (listp font-lock-global-modes)
-	(add-to-list 'font-lock-global-modes '(not speedbar-mode))
-      )
-  )
-
-(provide 'speedbar)
-;;; speedbar ends here
-
-;; run load-time hooks
-(run-hooks 'speedbar-load-hook)
diff --git a/xemacs-packages/lisp/template/ChangeLog b/xemacs-packages/lisp/template/ChangeLog
deleted file mode 100644
index 3643625a..00000000
--- a/xemacs-packages/lisp/template/ChangeLog
+++ /dev/null
@@ -1,619 +0,0 @@
-2003-08-21  Christoph Wedler  <wedler@users.sourceforge.net>
-
-	* template.el 3.1c.
-
-2003-08-09  Christoph Wedler  <wedler@users.sourceforge.net>
-
-	* template.el: Correct and improve header updating.
-	Reported by Ulf Klaperski <ulf.klaperski@web.de>.
-	(template-new-file): Remove `template-update-header' here.
-	(template-new-file-0): Call it here, i.e., after `normal-mode' has
-	been executed which sets `comment-start'.
-	(template-header-regexp-alist): Allow second %s in REGEXP.
-	(template-update-header): Provide substitution.
-
-	* template.el (template-single-comment): Allow to use in comments
-	not starting with default comment.
-	(template-new-file-interactive): New function.
-	(template-new-file): Use it.
-	(template-expand-template-interactive): New function.
-	(template-expand-template): Use it.
-
-2003-04-04  Christoph Wedler  <wedler@users.sourceforge.net>
-
-	* template.el: Allow messages to be displayed in a separate buffer
-	"*Template Messages*" instead at point.
-	(template-definition-start): Update docstring.
-	(template-message-buffer): New user option.
-	(template-message-prompt-intro): Ditto.
-	(template-message-prompt-format): Ditto.
-	(template-message-register-intro): Ditto.
-	(template-message-register-format): Ditto.
-	(template-point-messages): New internal var.
-	(template-before-messages): Ditto.
-	(template-after-messages): Ditto.
-	(template-messages): Deletia.
-	(template-display-messages): New function.
-	(template-new-file-0): Use them.  Don't add newline if there is
-	just one message at point.
-	(template-message-face): Define with background color pink.
-
-	* template.el (template-not-found-function): Disable package
-	session for the new file, with session v2.2a or higher.
-
-2003-03-14  Christoph Wedler  <wedler@users.sourceforge.net>
-
-	* template.el 3.1b.
-
-2003-03-06  Christoph Wedler  <wedler@users.sourceforge.net>
-
-	* template.el: Also allow to decorate comment in current line if
-	the line just contains a comment terminated by end-of-line.
-	Before, it must have been a comment-only line.
-	(template-single-comment): Change accordingly.
-	(template-comment-syntax): New value `boc' for NO-INDENT.
-	(template-comment-at-point): New return value `cont'.
-	(template-comment-menu): Use `cont' for :active test.
-
-	* template.el: Make sure that the buffer auto-update function
-	really comes first in `write-file-hooks'.  Other packages like
-	X-Symbol with crypt might add function as well.
-	(template-initialize): Execute `template-after-init' very late.
-	(template-after-init): Enable `template-auto-update' and
-	`template-auto-insert' here, not in `template-initialize'.
-
-	* template.el: Simplify Emacs/XEmacs compatiblity.
-	(cond-emacs-xemacs): New compile-time macro.
-	(defunx): New compile-time macro.
-	(template-point-at-bol): Use macro for definition.
-	(template-point-at-eol): Ditto.
-	(template-directory-files): Deletia:
-	(template-all-templates): Change accordingly.
-	(template-unique-file): Ditto.
-	(template-not-found-function): Use new macros.
- 	(template-characterp): Deletia.
-	(template-char-or-char-int-p): Define instead.
-	(template-int-to-char): Deletia.
-	(template-char-or-int-to-char): Define instead.
-	(template-register): Use new functions.
-	(template-new-file-0): Ditto.
-	(template-translate-definition): Ditto.
-	(template-add-submenu): Use new macros.  Change 2nd argument.
-	(template-initialize): Change accordingly.  Use macros.
-
-	* template.el: Miscellaneous improvements.
-	(template-expansion-regexp): Allow `-'.
-	(template-stop-derivation): Correct custom setting.
-
-2002-05-24  Christoph Wedler  <wedler@users.sourceforge.net>
-
-	* template.el 3.1a.
-
-2002-05-21  Christoph Wedler  <wedler@users.sourceforge.net>
-
-	* template.el: When adding submenus, always check for menu support
-	and parent menus, always change default menubar.
-	(template-add-submenu): Check for "Edit" menu.
-	(template-initialize): Check for "File" menu.
-
-2002-03-01  Christoph Wedler  <wedler@users.sourceforge.net>
-
-	* template 3.1 is released.
-	
-	* template.el (template): Moved to SourceForge.net.
-
-2002-02-23  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el: Menus work with Emacs-21, too.
-	(template-comment-menu): Rename header to "Comment", rename menu
-	entries.  Renamed variable from `template-menu'.  Don't specify
-	:included, change :active for all items instead.
-	(template-creation-menu): Rename menu entries.
-	(template-add-submenu): New function.
-	(template-initialize): Use it.  Also do menu setup for Emacs.
-	(template-comment-at-point): Be more specific when decoration can
-	be used.  Delete return value `t', add `none' and `delimited'.
-	(template-comment-menu): Change accordingly.
-
-	* template.el: Make date/time formats work as names suggest.
-	(template-date-format): Change format, customize, is not obsolete.
-	(template-time-format): Change format.
-	(template-insert-time): New option argument DEFAULT.
-	(template-default-expansion-alist): New expansion (>>>TIME<<<).
-	Use `template-insert-time' for all date/time expansions.
-	
-	* template.el: XEmacs can now read template files with register
-	definitions using numbers, not characters.  Only define functions
-	starting with `template-'.  Only require cl for compilation.
-	(template-characterp): Define alias instead `characterp'.
-	(template-translate-definition): Use it.
-	(template-int-to-char): New alias/function.
-	(template-register): Use it.
-	(template-new-file-0): Use both.  Use `integerp', not `numberp'.
-	(template-point-at-bol): Define alias instead `point-at-bol'.
-	(template-block-comment): Use it.
-	(template-point-at-eol): Define alias instead `point-at-eol'.
-	(template-single-comment): Use it.
-	(template-comment-at-point): Use it.
-	(cl):  Don't require package at runtime.
-	(template-initialize): Don't use `pushnew' from cl.
-	(template-default-expansion-alist): Don't use cl
-	functions or macros.
-
-2002-02-16  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el: Don't rely on command `ffap' to always add an entry
-	to `command-history' if the filename is read from terminal.
-	(template-ffap-file-finder): New variable.
-	(template-ffap-find-file): New function.
-	(template-after-init): New function.
-	(template-initialize): Use it, entry `ffap' in variable list.
-
-	* template.el: Don't search for remote templates.  Nuke this
-	home/base directory stuff, stop at root.
-	(template-stop-derivation): New user option.
-	(template-home-directory): Delete user option.
-	(template-base-directories): Ditto.
-	(template-derivation): Change accordingly.
-	(template-directory-regexp): Deletia.
-
-	* template.el: Installation for html-helper . Miscellaneous.
-	(template-initialize): Disable `html-helper's template and
-	timestamp updating.  Entry `de-html-helper' in variable list.
-	(template-update-buffer): Don't ask when called interactively.
-	(template-update-buffer): Include `ms-dos', not just `windows-nt'.
-	(template-derivation): Ditto.
-	(template-new-file-0): Don't call `template-update-header' when
-	called via `template-expand-template'.
-
-	* template.el. Delete unused commenting feature.  Miscellaneous.
-	(template-comment-end-decoration-length): Deletia.
-	(template-insert-separator): Delete optional arg NO-COMMENT-END.
-	(template-single-comment): Ditto.
-	(template-block-comment): Only works with EOL terminated comments.
-	(template-menu): Change accordingly.
-	(template-block-comment): Use marker for orig position.
-	(template-single-comment): Ditto.
-
-2001-06-16  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el 2.5b.
-
-2001-06-12  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el: Allow user to define a choice in the definition
-	section to be answered via `y-or-n-p'.
-	Suggested by Jean-Philippe Georget <jp.georget@free.fr>
-	(template-choice): Allow keys in table to be nil and t.
-
-	* template.el: Miscellaneous improvements.
-	(template-single-comment): Make it also work without defined
-	comment syntax.  Was already working before 2.5a.
-	(template-menu): Set :active accordingly.
-
-2000-11-01  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el 2.5a.
-
-2000-10-22  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el: Fix for bug introduced in 2.4d.  Would sometimes
-	indent the current line when using the menubar.
-	Reported by Stephan Helma <s.p.helma@gmx.net>.
-	(template-comment-syntax): New argument NO-INDENT.
-	(template-comment-at-point): Use it.
-	(template-indent-mode-disable-list): Include `makefile-mode'.
-
-	* template.el: Command to insert & expand a template file.
-	Suggested by Stephan Helma <s.p.helma@gmx.net>.
-	(template-expand-template): New command.
-	(template-new-file): Optional argument changed from CREATED to
-	WITH-UNDO.  Corresponding changes.
-	(template-not-found-function): Change accordingly.
-	(template-new-file-0): New argument WITH-UNDO.  Corresponding
-	changes.  Run `normal-mode' without restriction.
-	(template-find-template): Prevent infloop in XEmacs.  Don't use t
-	as 4th arg of `insert-file-contents' if the narrowed part is
-	empty.
-	
-	* template.el: Miscellaneous improvements.
-	(template-new-file-0): With (>>>MARK<<<), push -not set- mark.
-	Reported by Stephan Helma <s.p.helma@gmx.net>.
-	(template-menu): Remove `template-update-header' from menu.
-	(template-new-file): Improved error message if no file name is
-	given or the file name is a directory.
-	(template-comment-syntax): Improved error message if no comment
-	syntax has been defined.
-	(template-initialize): Add initialization for `antlr-mode'.
-
-2000-06-04  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.5 is released.
-
-1999-12-18  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el: Commenting support for languages with non-empty
-	`comment-end' and languages with "mixed" comments like C++/Java.
-	(template-menu): Additional/changed entries for commenting.
-	(template-max-column-with-end): New user option.
-	(template-comment-end-decoration-length): Ditto.
-	(template-alt-comment-syntax-alist): New user option.
-	(template-comment-at-point): New function for menu.
-
-	* template.el (template-single-comment): New optional arg
-	NO-COMMENT-END.  Allow non-empty `comment-end'.
-	(template-block-comment): If `comment-end' is non-empty, works
-	like `template-single-comment' without the final `comment-end'.
-	(template-comment-start): Deletia.
-	(template-comment-syntax): New function.
-	(template-comment-syntax-0): Ditto.
-	(template-comment-separator-regexp): New argument SYNTAX.  Use
-	non-empty `comment-end'.  Construct "fast" regexp.
-	(template-comment-specification): Use argument SYNTAX instead
-	COMMENT.  Be smarter if `comment-start' is longer than 1 char.
-	(template-insert-separator): Use optional arguments SYNTAX and
-	NO-COMMENT-END instead ESTRING.  Allow non-empty `comment-end'.
-	(template-match-modes-or-regexp): New function.
-	(template-update-buffer): Use it.
-
-	* template.el: Don't "fill" separators in C/C++/Java comments.
-	(template-c-fill-paragraph): New function.
-	(template-c-init-fill-function): New function.
-	(template-initialize): Add to `c-mode-common-hook'.
-
-	* template.el: Do not use template DEFAULT.tpl for [C-x C-f].
-	(template-derivation-alist): Delete entry for DEFAULT.
-	(template-default-directory): New function.
-	(template-derivation): Use it.  New optional argument NO-DEFAULT.
-	(template-not-found-function): Use it.
-
-	* template.el: Changed directories, new user options.
-	(template-default-directories): Changed default value from
-	"~/lib/templates/" to "~/.templates/" except if "~/lib/templates/"
-	exists but "~/.templates/" does not.
-	(template-base-directories): New user option.  Should be used
-	instead `template-home-directory'.
-	(template-derivation): Use it.  Always consider templates in
-	current directory.
-	(template-default-directory): Fallback is "~/.templates/".
-	(template-open-template): Consider `template-subdirectories' when
-	creating a new template file.
-
-	* template.el: Minor changes.
-	(template-new-file): If argument TEMPLATE is nil for empty input,
-	do not use templates.
-	(template-new-file-0): New function, was second part of
-	`template-new-file'.  Recenter at the end.
-	(template-make-directory): Changed error message.
-	(template-initialize): All keybindings for Emacs also.
-
-	* template.el: Emacs/XEmacs bug workaround.
-	(template-directory-regexp): New function.  Also considers the
-	file truename and its abbreviated form.
-	(template-derivation): Use it.  Otherwise, a bug in
-	`abbreviate-file-name' would cause some surprises.
-
-	* template.el: With Emacs on MS-NT/MS-DOS, files with extension
-	".tpl" are binary files.  Our template files are text files...  I
-	would suggest to change the value of `template-extension' or
-	`file-name-buffer-file-type-alist'.
-	(template-find-template): New function.
-	(template-new-file): Use it.
-	(template-open-template): Use it.
-
-	* template.el: A text with expansion forms which is inserted
-	should not be expanded together with the buffer contents.
-	Avoiding a rare situation...
-	(template-read): Insert "(>>>LITERAL<<<)(>>>/LITERAL<<<)" at the
-	end with AGAIN-P is `expand'.
-	(template-choice): Ditto, always.
-
-	* template.el: File names are case insensitive on MS-Windows.
-	(template-derivation): Change accordingly.
-	(template-update-buffer): Change accordingly.
-
-1999-06-12  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.4d.
-
-1999-06-12  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el (template-max-column): Give semantics for negative
- 	value as relative to `fill-column', change default value to -1.
-	(template-insert-separator): Change accordingly.
-
-	* template.el (template-comment-indent): New user option.
-	(template-indent-mode-disable-list): Ditto.
-	(template-indent-mode-enable-list): Ditto.
-	(template-indent-according-to-mode): New function.
-	(template-block-comment): Use it.
-	(template-comment-start): Ditto.
-	(template-insert-separator): Ditto.
-
-	* template.el (template-initialize): Would require to set variable
- 	`template-initialize' under XEmacs without menu support.  Reported
- 	by Mathias Trucks <trucks@physik.tu-berlin.de>.
-
-1999-03-13  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.4c.
-
-1999-02-20  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el (template-default-expansion-alist): New key
- 	"FILE_SANS" for file name without extension.
-
-1999-01-30  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.  Copyright transferred to the FSF.
-
-1999-01-30  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.4b.
-
-	* template.el (template-derivation): Would infloop under NT, DOSen
- 	etc.  Reported by Barney Dalton <barney@mech.uwa.edu.au>.
-
-1999-01-29  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.4a.
-
-1999-01-28  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el: Allow conditional and repetitive/recursive
- 	expansions.  Literal environments, i.e., without expansions.
-	(template-string-default): Is a format string now.
-	(template-literal-environment): New variable option.
-	(template-default-expansion-alist): New key "LITERAL".
-	(template-choice-history): New variable.
-	(template-read-again): Deletia.
- 	(template-read): New optional arguments.
-	(template-choice): New function.
-	(template-translate-definition): Change accordingly.
-	(template-define-prompt): Also insert additional arguments.
-	(template-define-start): Look from start for definition section.
-	(template-insert-form): Also insert closing literal tag.
-
-1999-01-25  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.4 is released.
-
-1999-01-22  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el: Easier info for package and test of package.
- 	(template): Provide `emacs-commentary-link'.
-	(template-use-package): New pseudo variable.
-	(template-initialize): Might be used as :action function.
-	(template-initialize): Put into group `template-miscellaneous'.
-	(template-menu-filter): Bind variable key in let.
-
-1999-01-21  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.3d.
-
-1999-01-20  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el: Support template creation.
-	(template-menu-filter): New function.
- 	(template-creation-menu): New variable.
-	(template-initialize): Use it.
-	(template-expansion-format): New variable.
-	(template-definition-start): Is a string, no regexp anymore.
-	(template-new-file): Changed accordingly.
-	(template-buffer-no-template-p): New function.
-	(template-open-template): New command.
-	(template-define-start): Ditto.
-	(template-define-prompt): Ditto.
-	(template-define-message): Ditto.
-	(template-define-register): Ditto.
-	(template-insert-form): New command.
-
-	* template.el: Key in expansion form can be longer than one
- 	character.  Suggested by Jesper Pedersen <blackie@ifad.dk>.
- 	(template-expansion-regexp): Key with more letters.
-	(template-default-expansion-alist): Use multi-letter keys.
-	(template-key-alias-alist): New variable.
-	(template-new-file): Use it.
-
-	* template.el: No special template derivation for 00readme.txt,
- 	additional entries for templates where all parts match, useful for
- 	Makefile, dotfiles, README files etc.  Miscellaneous.
-	(template-derivation-alist): Change entry.  Provide custom group.
-	(template-update-header): File name in header without version.
- 	(template-update-buffer-alist): Ditto.
-	(template-menu): Don't include if buffer is read-only.
-	(template-new-file): Under XEmacs, activate region if mark is set.
-	(template-initialize): Don't use hard-coded `template-extension'.
-
-1999-01-18  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.3c.
-
-1999-01-15  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el: Package has been customized (->Data->Template).
-	(template): New group.
-	(template-comments): New group.
-	(template-updating): New group.
-	(template-derivation): New group.
-	(template-expansion): New group.
-	(template-miscellaneous): New group.
- 	(template-version): New constant.
-	(template-initialize): Rename item `bindings' to keys'.
-	(template-message-face): Is a face, no variable anymore.
-	(template-new-file): Changed accordingly.
-
-	* template.el: Automatic templates work with package ff-paths.
-	(template-file-select-commands): New user option.
- 	(template-not-found-function): Use it.
-	(template-new-file): Check whether template is a directory.
-	(template-default-expansion-alist): New predefined expansion form
- 	(>>>B<<<) for Block = upcase(RAW)++NUM, useful for C header files.
-
-	* template.el: Stabilize auto updating.
- 	(template-update-buffer-alist): Different specification format.
-  	Changed value accordingly.
-	(template-default-comment): New function.
-	(template-comment-start): Use it.
-	(template-update-header): Ditto.  Consider different spec format.
-	(template-header-regexp-alist): Slight change.
-	(template-update-buffer-region): Delete variable.
-	(template-update-buffer-region): Use `save-excursion' and friends
- 	in `template-update-header', not here anymore.
-	(template-translate-definition): New function.
-	(template-new-file): Use it.
-
-1999-01-13  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.3b.
-
-	* template.el: Extend and improve auto-updating.
- 	(template-header-regexp-alist): Be stricter using %s in REGEXP.
-	(template-update-buffer-alist): Auto-update header.  PROMPT is a
- 	format string to show the buffer name.  Allow to delay user
- 	confirmation by specifying replacement as SAFE.
-	(template-auto-update-disable-regexp): New variable.
-	(template-update-buffer): Use it.  Show buffer with prompt.  Don't
- 	ask for confirmation if entry has no prompt.  No updating without
- 	change, delaying user confirmation in SAFE replacements.
-	(template-update-header): Use `comment-start' for %s in REGEXP of
- 	`template-header-regexp-alist'.  Be smarter for auto-updating.
-
-1999-01-13  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.3a.
-
-	* template.el: For a complete installation, you now have to call
- 	`template-initialize'.  According to the Emacs convention, there
- 	is no top-level initialization code in the package anymore.
-	(template-initialize): New variable.
-	(template-initialize): New function.  Includes all previously
- 	top-level hook additions and code from template-site.el
-	(template-check-header): Deletia.
- 	(template-menu): Include "Update Buffer".
-	(template-default-expansion-alist): Renamed.
-	(template-expansion-alist): New variable.
-	(template-new-file): Use it.
-
-	* template-site.el: Deletia.  Code moved to template.el
-
-1999-01-12  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.3.  Internal: last two-file version.
-
-1999-01-11  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.2g.
-
-	* template.el: Make it easier to insert the time in any format.
- 	(template-elisp-in-definition): If the commands symbol property
- 	`template-secure-command' is a function, it checks the arguments
- 	whether the command could be run safely directly.
-	(template-insert-time): New safe command.
-	(template-expansion-alist): Use it.
-
-1999-01-07  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.2f.
-
-	* template.el (template-derivation): Would infloop if
- 	`template-home-directory' is "/" or "".  Reported by Jesper
- 	Pedersen <blackie@ifad.dk>.
-
-1999-01-07  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.2e.
-
-	* template-site.el (template-find-file-commands): More entries.
-  	To make automatic templates work with package ffap, use ffap-1.10
- 	or higher.  Reported by Jesper Pedersen <blackie@ifad.dk>.
-
-	* template.el: The year alone is much more likely to be used,
- 	e.g., in copyright messages, than hour:min:sec.  (>>>T<<<) now
- 	inserts something like "06 Jan 1999", (>>>Y<<<) something like
- 	"1999".  Insert the two lines from the initial comment into your
- 	~/.emacs to get the old behavior.
- 	(template-date-format): Obsolete.  Thus, not safe to change.
-	(template-time-format): New value is old `template-date-format'.
-	(template-expansion-regexp): Safe to set to a string.
-	(template-string-default): Ditto.
-	(template-expansion-alist): Little change in older Emacsen, i.e.,
- 	if `format-time-string' does not exist.
-	(template-register-regexp): Change, not visible.
-	(template-update-header): Return region of header on success.
-
-	* template-site.el: New functionality similar to / generalizing
- 	time-stamp and psgml-html/html-helper-mode timestamps.
- 	(template-auto-update): New user option.
-	(template-update-buffer-alist): New variable.
-	(template-update-buffer-region): New internal variable.
-	(template-update-buffer-region): New function.
-	(template-update-buffer): New command.
-	(write-file-hooks): Use it.
-
-1999-01-04  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.2d.
-
-	* template-site.el (template-not-found-function): Make function
- 	work with Emacs.  Reported by Jesper Pedersen <blackie@ifad.dk>.
-
-1998-12-21  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.2c.
-
-	* template.el (template-set-template-part): New function
-	defining template part specification "inherit if non-empty".
-	(template-default-template): Use it.
-	(template-derivation-alist): Use new template part specification
-	for specifying a default extension.
- 	(template-unique-file): Another slight change with auto-numbering.
-
-1998-12-16  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.2b.
-
-	* template.el (template-unique-file): Very minor change in test
- 	whether auto-numbering is used.
-	(template-derivation-alist): Better docstring with examples.
-
-1998-12-15  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.2a.
-
-	* template.el (template-expansion-alist): New predefined expansion
- 	form (>>>I<<<) for ISO 8601 date, i.e., date format "%Y-%m-%d".
-
-1998-12-14  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.2 is released.
-
-1998-11-03  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el (template-expansion-alist): New predefined expansion 
-	form (>>>V<<<) for UTC date/time like RCS's $Date$.
-	(template-date-format): Defaults to "%d %b %Y".
-
-1998-10-19  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.1a.
-
-1998-10-07  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template-site.el (template-auto-insert): New user option.
-	(template-find-file-commands): New variable.
-	(template-not-found-function): New function.
-	(find-file-not-found-hooks): Add `template-not-found-function'.
-	(template-derivation): New autoload.
-
-	* template.el (template-new-file): New optional argument CREATED,
-	used by `template-not-found-function'.
-
-1998-08-20  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template.el (template-date-format): Defaults to "%Y-%m-%d".
-	(template-time-format): Safe to set it to a string.
-
-1998-03-03  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* template 2.1 is released.
diff --git a/xemacs-packages/lisp/template/template.el b/xemacs-packages/lisp/template/template.el
deleted file mode 100644
index ea36c4b5..00000000
--- a/xemacs-packages/lisp/template/template.el
+++ /dev/null
@@ -1,2609 +0,0 @@
-;;; template.el --- use templates, decorate comments, auto-update buffers
-
-;; Copyright (C) 1995-2003 Free Software Foundation, Inc.
-;;
-;; Author: Christoph Wedler <wedler@users.sourceforge.net>
-;; Version: (see `template-version' below)
-;; Keywords: template, comment decoration, auto-updating, data, tools
-;; X-URL: http://emacs-template.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 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.
-
-;;; Commentary:
-
-;; When you create a new file with Emacs, package Template supplies an initial
-;; buffer content via a template: a file with normal text and expansion
-;; forms. There is a menu to easily create such templates. You can also use new
-;; commands to decorate comments and update the buffer contents.
-
-;; The main difference between Template and other similar packages is that you
-;; can define very flexible templates without having to learn Lisp or changing
-;; your Emacs init file. This package does not help Lisp programmers to define
-;; complex macros.
-
-;; For details, check <http://emacs-template.sourceforge.net/> or, if you
-;; prefer the manual style, the documentation of the following commands and
-;; variables:
-;;
-;;  * for templates: \\[template-new-file], `template-auto-insert',
-;;    `template-derivation-alist', `template-default-expansion-alist' and
-;;    `template-definition-start',
-;;  * for comment decoration: \\[template-single-comment] and
-;;    \\[template-block-comment], `template-comment-specification-alist'
-;;  * for updating: \\[template-update-buffer], `template-auto-update',
-;;    `template-update-buffer-alist' and `template-header-regexp-alist'.
-
-;; Bug fixes, bug reports, improvements, and suggestions for the newest version
-;; are strongly appreciated.
-
-;;; Installation:
-
-;; This file requires Emacs-20.2, XEmacs-20.2 or higher.
-
-;; Put this file into your load-path and the following into your ~/.emacs:
-;;   (require 'template)
-;;   (template-initialize)
-
-;; You might want to add another item to the "File" menu by (in XEmacs):
-;;   (add-menu-button '("File")
-;;		      ["Insert and Expand Template..."
-;;                     template-expand-template
-;;                     :active (not buffer-read-only)]
-;;		      "Insert File...")
-
-;; To customize, use `M-x customize-group RET template RET' or the customize
-;; entry in menu Options.
-
-;;; Code:
-
-(provide 'template)
-(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
-  (require 'cl)
-  (defvar init-file-loaded)		; would be useful in Emacs, too...
-  (defvar file-name-buffer-file-type-alist))
-
-
-
-;;;;##########################################################################
-;;;;  User Options, Variables
-;;;;##########################################################################
-
-
-(defconst template-version "3.1c"
-  "Current version of package template.
-Check <http://emacs-template.sourceforge.net/> for the newest.")
-
-
-;;;===========================================================================
-;;;  Customization and initialization
-;;;===========================================================================
-
-(defgroup template nil
-  "Use templates, decorate comments, auto-update buffers."
-  :group 'data
-  :link '(emacs-commentary-link "template.el")
-  :link '(url-link "http://emacs-template.sourceforge.net/")
-  :prefix "template-")
-
-(defgroup template-comments nil
-  "Comment decorations in package template."
-  :group 'template
-  :prefix "template-")
-
-(defgroup template-updating nil
-  "Updating with package template."
-  :group 'template
-  :prefix "template-")
-
-(defgroup template-derivation nil
-  "Deriving templates for new files."
-  :group 'template
-  :prefix "template-")
-
-(defgroup template-expansion nil
-  "Expanding the expansion forms in templates."
-  :group 'template
-  :prefix "template-")
-
-(defgroup template-miscellaneous nil
-  "Miscellaneous configurations of package template."
-  :group 'template
-  :prefix "template-")
-
-;; I could imagine that a future version of package custom could make this
-;; `PACKAGE-initialize' stuff easier
-(defcustom template-use-package nil
-  "Pseudo variable.  Used to initialize template in custom buffer.
-Put `(template-initialize)' into your ~/.emacs to initialize package
-template in future sessions.  See variable `template-initialize'."
-  :group 'template
-  :type '(boolean :format "%{%t%}: %[(template-initialize)%], %v\n"
-		  :on "in use" :off "not yet initialized"
-		  :help-echo "Initialize package Template."
-		  :action template-initialize))
-
-(defcustom template-initialize t
-  "Whether/what to initialize with `template-initialize'.
-If t, do full initialization.  Otherwise, the value should be a list
-with elements.  To enable, include
-
- * `auto' to enable `template-auto-update' and `template-auto-insert',
- * `ffap' to make sure that `auto' works with `find-file-at-point',
- * `cc-mode' to enable correct C/C++/Java/Antlr comment filling, i.e.,
-   to add `template-c-init-fill-function' to `c-mode-common-hook',
- * `de-html-helper' to disable `html-helper's template and time-stamps,
- * `keys' to setup the default key bindings,
- * `menus' to setup the menus."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "All" t)
-		 (set :value (auto cc-mode keys menus)
-		      (const :tag "Auto Updating/Inserting" auto)
-		      (const :tag "Correct Auto Inserting with Ffap" ffap)
-		      (const :tag "Correct C Comment Filling" cc-mode)
-		      (const :tag "Deactivate html-helper" de-html-helper)
-		      (const :tag "Setup Key Bindings" keys)
-		      (const :tag "Setup Menus" menus))))
-
-
-;;;===========================================================================
-;;;  Menu
-;;;===========================================================================
-
-(defvar template-comment-menu
-  '("Comment"
-    ["Decorate Comment Line" template-single-comment
-     :active (and (not buffer-read-only)
-		  (memq (template-comment-at-point)
-			'(none delimited single cont)))]
-    ["Decorate Comment Block" template-block-comment
-     :active (and (not buffer-read-only)
-		  (memq (template-comment-at-point)
-			'(single block)))]
-    "---"
-    ["Indent for Comment" indent-for-comment
-     :active (and comment-start (not buffer-read-only))]
-    ["Continue Comment" indent-new-comment-line
-     :active (and  comment-start (not buffer-read-only))]
-    ["Comment Region" comment-region
-     :active (and comment-start (not buffer-read-only) (mark))]
-    ["Comment Region 2" (comment-region 2)
-     :active (and comment-start (not buffer-read-only) (mark))]
-    ["Comment Region 3" (comment-region 3)
-     :active (and comment-start (not buffer-read-only) (mark))]
-    "---"
-    ["Update Buffer" template-update-buffer
-     :active (and template-update-buffer-alist (not buffer-read-only))])
-  "Menu for comment functions.")
-
-(defvar template-creation-menu
-  '("Template Creation"
-    :filter template-menu-filter
-    ["Open Template" template-open-template
-     :active (null (template-buffer-template-p))]
-    "--"
-    ["Define User Input" template-define-prompt t]
-    ["Define Text Register" template-define-register t]
-    ["Define Message" template-define-message t]
-    "---"
-    ["Insert Expansion Form" template-insert-form t])
-  "Menu for template creation.")
-
-
-;;;===========================================================================
-;;;  Commenting
-;;;===========================================================================
-
-(defcustom template-max-column -1
-  "*Width of the separator line, to use with an empty `comment-end'.
-If the value is zero or negative, it is added to `fill-column'.  See
-also `template-max-column-with-end'."
-  :group 'template-comments
-  :type 'integer)
-
-(defcustom template-max-column-with-end 0
-  "*Width of the separator line including a non-empty `comment-end'.
-If the value is zero or negative, it is added to `fill-column'.  See
-also `template-max-column'."
-  :group 'template-comments
-  :type 'integer)
-
-(defcustom template-alt-comment-syntax-alist
-  '((t "/* " " */"))
-  "Alternative comment syntax for languages with \"mixed\" comments.
-Used by function `template-comment-syntax'.  Elements look like
-  (MODES-OR-REGEXP COMMENT-START COMMENT-END)
-
-If the current `major-mode' has a empty `comment-end' and a commenting
-command does not work at `point' with the usual `comment-start', we
-search for the first matching alternative comment syntax in this alist.
-
-Each element must \"pass\" MODES-OR-REGEXP.  If this is a list, it must
-include the current major-mode, if this is a regexp, it must match the
-`buffer-file-name' without version, otherwise it must be non-nil.
-
-Then, COMMENT-START and COMMENT-END is used as the alternative comment
-syntax if `comment-start-skip' matches COMMENT-START."
-  :group 'template-comments
-  :type '(repeat (group (choice (repeat :tag "In major modes" :value nil
-					function)
-				(regexp :tag "Buffer matching" :value "")
-				(sexp :tag "Always" :value t))
-			(string :tag "Alt comment start" :value "/* ")
-			(string :tag "Alt comment end" :value " */"))))
-
-(defcustom template-comment-indent t
-  "Non-nil means, indent single-line/block comments.
-Commands \\[template-single-comment] and \\[template-block-comment]
-indent the comment lines if this value is non-nil and the current major
-mode is not a member of `template-indent-mode-disable-list' or if this
-value is nil and the current major mode is a member of
-`template-indent-mode-enable-list'."
-  :group 'template-comments
-  :type 'boolean)
-
-(defcustom template-indent-mode-disable-list '(sh-mode makefile-mode)
-  "Major modes not having indented single-line/block comments.
-Used if `template-comment-indent' is non-nil.  Major modes in which
-pressing TAB twice is different from pressing TAB once are good
-candidates for this list."
-  :group 'template-comments
-  :type '(repeat (function :tag "Major mode")))
-
-(defcustom template-indent-mode-enable-list nil
-  "Major modes having indented single-line/block comments.
-Used if `template-comment-indent' is nil."
-  :group 'template-comments
-  :type '(repeat (function :tag "Major mode")))
-
-(defcustom template-comment-specification-alist
-  '(("-" "" "" 0)
-    ("-" "" "" 0)
-    ("=" "\n\n" "\n" 1)
-    ("#" "\n\n\f\n" "\n\n" 2))
-  "List of specifications for comment functions.
-Each specification at LEVEL, starting at 1, is a list
-  (SEPARATOR BEFORE-BLOCK AFTER-BLOCK DELETE-LINES)
-
-SEPARATOR is the string which is inserted repeatedly by commands
-\\[template-single-comment] and \\[template-block-comment] up to
-`template-max-column'.
-
-After that, \\[template-block-comment] deletes DELETE-LINES after the
-comment block and inserts string AFTER-BLOCK at the end of the block and
-BEFORE-BLOCK at the front of the block.
-
-The specification LEVEL to use is determined by:
- (1) If the prefix argument is non-nil and its numeric value is > 0,
-     this value is the LEVEL.
- (2) If the prefix argument is nil, and there is an old comment style,
-     use old comment style.
- (3) If `template-comment-specification-special' is a function or the
-     current major mode has a property with this name and its value is a
-     function, this function returns the specification.
- (4) If `comment-end' is empty and `comment-start' is a string of length
-     1: LEVEL is number of repetitions of `comment-start' at the
-     beginning of the line.  Otherwise, if the correctly indented line
-     starts at the beginning of the line, LEVEL=3, else LEVEL=2."
-  :group 'template-comments
-  :type '(repeat (group (string :tag "Separator" :value "-")
-			(string :tag "Before block" :value "")
-			(string :tag "After block" :value "")
-			(integer :tag "Delete lines" :value 0))))
-
-(defcustom template-comment-specification-special nil
-  "Function used for special commenting styles or nil.
-See `template-comment-specification-alist' for details."
-  :group 'template-comments
-  :type '(choice (const nil) function))
-
-
-;;;===========================================================================
-;;;  Auto updating
-;;;===========================================================================
-
-(defcustom template-auto-update 'query
-  "*Whether to update parts of the file when saving the buffer.
-When non-nil and `template-auto-update-disable-regexp' does not match
-the file name, automatically updates parts of the buffer, see
-`template-update-buffer-alist'.  With value t or if the entry in the
-alist has no prompt, do not ask for confirmation.
-
-You should have called `template-initialize' to enable this feature."
-  :group 'template-updating
-  :type '(radio (const :tag "No" nil)
-		(const :tag "Without confirmation" t)
-		(sexp :tag "With confirmation" :format "%t" :value query)))
-
-(defcustom template-auto-update-disable-regexp nil
-  "*Regexp matching files not to automatically update.
-Value nil matches no file.  See `template-auto-update'."
-  :group 'template-updating
-  :type '(choice (const :tag "none" nil) regexp))
-
-(defcustom template-update-buffer-alist
-  '((t "Update header in %s? "
-       (template-update-header t)
-       (file-name-sans-versions (file-name-nondirectory buffer-file-name)))
-    ((html-mode) "Update date inside <address> in %s? "
-     (-2000
-      "\\([0-9]+[ \t]+[A-Za-z][A-Za-z][A-Za-z][ \t]+[0-9]+\\)[ \t\n]*</address>"
-      1)
-     (format-time-string "%d %b %Y")))
-  "Alist used how to update parts of the buffer.
-Used by function `template-update-buffer'.  Elements look like
-  (MODES-OR-REGEXP PROMPT TEST NEW REPLACEMENT-FUN)
-
-Each element must \"pass\" MODES-OR-REGEXP.  If this is a list, it must
-include the current major-mode, if this is a regexp, it must match the
-`buffer-file-name' without version, otherwise it must be non-nil.
-
-Then, TEST is `eval'd and must return the region = (BEG . END) to be
-replaced or nil if nothing should be updated according to the current
-element.  If TEST is a list and the `car' of TEST is not a function,
-`template-update-buffer-region' is used as the default function, i.e.,
-REPLACEMENT-FUN looks like (LIMIT REGEXP GROUP).  Then, check first/last
-LIMIT characters in buffer and return region according to GROUP's regexp
-group in REGEXP.
-
-Then, NEW is `eval'd.  If it is a string, it is considered as
-replacement for the region, otherwise REPLACE-FUN must be non-nil.
-
-Then, ask user for confirmation with PROMPT where %s is substituted by
-the buffer name if PROMPT is a string and `template-auto-update' is not
-t.
-
-Finally, REPLACEMENT-FUN is called the `eval'd NEW and the beginning and
-the end of the region returned by TEST.  If REPLACEMENT-FUN is nil, just
-replace the region by the `eval'd NEW."
-  :group 'template-updating
-  :type '(repeat (group (choice (repeat :tag "In major modes" :value nil
-					function)
-				(regexp :tag "Buffer matching" :value "")
-				(sexp :tag "Always" :value t))
-			(string :tag "Prompt" :value "Update in %s? ")
-			(choice (list :tag "Default test"
-				      (choice (const :tag "No limit" nil)
-					      (integer :tag "Limit" -1000))
-				      regexp
-				      (integer :tag "Regexp group" :value 0))
-				(sexp :tag "Eval sexp"))
-			(sexp :tag "Eval New string")
-			(option (function :tag "Replacement function")))))
-
-(defcustom template-header-lines 3
-  "*Last line number which is checked by \\[template-update-header]."
-  :group 'template-updating
-  :type 'integer)
-
-(put 'template-header-lines 'template-secure-value #'integerp)
-
-(defcustom template-header-regexp-alist
-  '(("@(#)\\([^ \t\n]+\\)" . 1)
-    ("^%s[ \t]*\\([^ \t\n%s][^ \t\n]*\\)[ \t]+--" . 1))
-  "Alist of regexps matching the file name in the header.
-The `car' of each element is the REGEXP with %s, if present, substituted
-by the comment start.  A second %s, if present, is substitud by a single
-letter non-alpha comment start, or the empty string otherwise.
-
-The `cdr' is the regexp group to be replaced.  Used by
-\\[template-update-header].
-
-The comment start is evaluated from `comment-start', the first character
-in the buffer or \"#\".  It is assumed that a non-alpha single character
-comment start may be repeated.  For example, the substituted regexp in
-`emacs-lisp-mode' is \"\;+\", in `c++-mode' \"//\"."
-  :group 'template-updating
-  :type '(repeat (cons :format "%v"
-		       regexp
-		       (integer :tag "Regexp group" :value 0))))
-
-
-;;;===========================================================================
-;;;  Templates: finding templates
-;;;===========================================================================
-
-(defcustom template-auto-insert 'query
-  "*Whether to automatically use template files for new files.
-Used if the user gave a non-existent file as argument to a command in
-`template-find-file-commands'.  When non-nil and a matching template
-file can be found, use a template like in `template-new-file'.  File
-name refinement is never performed, see `template-derivation-alist'.
-
-With value t, do not ask for confirmation.
-
-You should have called `template-initialize' to enable this feature."
-  :group 'template-derivation
-  :type '(radio (const :tag "No" nil)
-		(const :tag "Without confirmation" t)
-		(sexp :tag "With confirmation" :format "%t" :value query)))
-
-(defcustom template-find-file-commands
-  '(find-file find-file-other-frame find-file-other-screen
-	      find-file-other-window find-file-at-point ffap nil)
-  "*Commands which use templates as last resort, see `template-auto-insert'.
-See also `template-file-select-commands'.
-
-Include nil if you want to use templates for non-existing files as
-command line arguments when starting Emacs."
-  :group 'template-derivation
-  :type '(repeat (function :tag "Command")))
-
-(defcustom template-file-select-commands
-  '(exit-minibuffer minibuffer-complete-and-exit
-		    list-mode-item-mouse-selected
-		    list-mode-item-keyboard-selected)
-  "*Commands which select the file name via minibuffer/completions.
-Checked with commands in `template-find-file-commands'."
-  :group 'template-derivation
-  :type '(repeat (function :tag "Command")))
-
-(defface template-message-face
-  '((((class color) (background light)) (:background "pink"))
-    (t (:bold t)))
-  "Face for temporary message at point.  This only works with XEmacs."
-  :group 'template-miscellaneous)
-
-(defcustom template-extension ".tpl"
-  "*Extension used for template files."
-  :group 'template-derivation
-  :type 'string)
-
-(defcustom template-subdirectories '("./" "Templates/")
-  "*List of subdirectories for template files.
-See `template-derivation-alist' for details."
-  :group 'template-derivation
-  :type '(repeat directory))
-
-(defcustom template-stop-derivation
-  (cond ((fboundp 'file-remote-p) 'file-remote-p)
-	((fboundp 'efs-ftp-path) 'efs-ftp-path)
-	((fboundp 'ange-ftp-ftp-path) 'ange-ftp-ftp-path))
-  "If non-nil, function used to determine whether to stop derivation.
-If non-nil, function is called with argument DIR.  If it returns t,
-`template-derivation' stops to search for more project specific
-templates, i\.e\., just searches in `template-default-directories'."
-  :group 'template-derivation
-  :type '(choice (const :tag "Never" nil)
-		 function))
-
-(defcustom template-default-directories
-  (cons (if (and (not (file-directory-p "~/.templates/"))
-		 (file-directory-p "~/lib/templates"))
-	    (expand-file-name "~/lib/templates/")
-	  (expand-file-name "~/.templates/"))
-	(and (fboundp 'locate-data-directory)
-	     (let ((dir (locate-data-directory "template")))
-	       (and dir (list dir)))))
-  "*List of default directories for template files.
-See `template-derivation-alist' for details."
-  :group 'template-derivation
-  :type '(repeat directory))
-
-(defcustom template-derivation-alist
-  '(;;(("00readme" "" ".txt" "\\`00") . ("00readme" "" ".txt"))
-    ((t "" t))
-    ((t nil null) . (nil nil t 1))
-    (("TEMPLATE" "" t)))
-  "Alist for template file name derivation and file name refinement.
-Template derivation searches for the most specific readable template
-file.  By default, files with the same RAW part as the name of the new
-file are considered to be more specific than files with just the same
-EXT part.  Also files in the same directory are considered to be more
-specific than files in their parent directory or any default template
-directory.  This behavior can be changed by this alist.
-
-Each FORM in this alist has the form (TEMPLATE . REFINEMENT).  If
-TEMPLATE matches, we have found a valid template file and the
-corresponding REFINEMENT is used for the file name refinement.
-
-Before the derivation, the given file name is split into the directory
-part DIR, the file name without directory FILE, and the raw part RAW of
-FILE, the numbering NUM and the extension EXT.  The result is stored in
-`template-file'.
-
-TEMPLATE can have the form (FUNCTION ARG...).  If TEMPLATE matches,
-FUNCTION, called with arguments ARGs, should return the split template
-file name, see `template-split-filename'.
-
-TEMPLATE can also have the form (T-RAW T-NUM T-EXT F-REGEXP) where all
-elements are optional, i.e., have value nil as default.  For TEMPLATE to
-match, all conditions T-RAW, T-NUM and T-EXT must be met and F-REGEXP,
-if non-nil, should match FILE, the non-directory part of the given file
-name.  If a condition is a string, the corresponding part of the
-template file must be equal to it.  If t, the part must be equal to
-RAW/NUM/EXT of the given file name.  If nil, any value will do it.  Any
-other value acts like t when the part of the given file name is
-non-empty, as nil otherwise.
-
-REFINEMENT can have the form (FUNCTION ARG...).  FUNCTION, called with
-the list of the split template filename and ARGs as arguments, should
-set `template-file' if the file name should be refined.
-
-REFINEMENT can also have the form (F-RAW F-NUM F-EXT AUTO-NUM) where all
-elements are optional, i.e., have value nil as default.  If F-RAW, F-NUM
-and F-EXT are non-nil, they change RAW/NUM/EXT of `template-file'.  A
-string will be used as the new part.  If t, the corresponding part of
-the template name will be used.
-
-We will use auto numbering in the following two cases: if NUM is
-non-empty and the file exists already, or if NUM is empty and AUTO-NUM
-is non-nil.  Auto numbering looks at the file names in DIR to generate
-the next unique number which is at least as high as NUM in the first
-case and AUTO-NUM in the second.
-
-Let us use parts of the default value as examples:
-
-Use a template with the same RAW part of the given file name and the
-same EXT part if provided, e.g., for \"exercise2\" use template
-\"exercise.tex.tpl\".  Refine file name to use the extension of the
-template file, also use auto numbering, e.g., if files \"exercise2.tex\"
-and \"exercise3.tex\" exist, refine name to \"exercise4.tex\":
-  ((t nil null) \. (nil nil t 1))
-
-For a file with extension EXT, use TEMPLATE.EXT:
-  ((\"TEMPLATE\" \"\" t))
-
-We could define: If the given file name starts with \"00\", use template
-\"00readme.txt.tpl\".  Refine file name to \"00readme.txt\":
-  ((\"00readme\" \"\" \".txt\" \"\\\\`00\") \. (\"00readme\" \"\" \".txt\"))
-
-Since more than one template file could meet this conditions, the
-template derivation searches for first readable file with extension
-`template-extension' which is found by the following algorithm:
-
-  forall FORMs in `template-derivation-alist' do
-    for directory BASE from DIR
-           while not stopped according to `template-stop-derivation' do
-      forall subdirectories DIRs in `template-subdirectories'
-             relative to BASE do
-        forall TEMPLATEs in DIR do
-          if check_form (FORM, FULL, TEMPLATE) return TEMPLATE
-    forall directories DIRs in `template-default-directories' do
-      forall TEMPLATEs in DIR do
-        if check_form (FORM, FULL, TEMPLATE) return TEMPLATE
-  if not used via `template-auto-insert'
-    forall TEMPLATEs in `template-default-directories'
-           where name_nondir (TEMPLATE) = \"DEFAULT.tpl\" do
-      if readable (TEMPLATE) return TEMPLATE
-    return TEMPLATE in first (`template-default-directories')
-           where name_nondir (TEMPLATE) = \"DEFAULT.tpl\""
-  :group 'template-derivation
-  :type '(repeat (cons :format "%v"
-		       (sexp :tag "Derivation" :value ("TEMPLATE" nil t))
-		       (sexp :tag "Refinement" :value nil))))
-
-
-;;;===========================================================================
-;;;  Templates: expanding templates
-;;;===========================================================================
-
-(defcustom template-confirm-insecure t
-  "*Non-nil means, ask whether to use insecure template expansions.
-Only set this to nil if you ALWAYS check template files before using
-it!"
-  :group 'template-expansion
-  :type 'boolean)
-
-(put 'template-confirm-insecure 'risky-local-variable t)
-
-(defcustom template-message-buffer "*Template Message*"
-  "If non-nil, name of buffer where messages are shown.
-The following messages will be displayed in definition sequence before
-the expansion has taken place:
- - :before messages, see `template-definition-start',
- - user defined prompts if `template-message-prompt-format' is non-nil,
- - user defined registers when there has been a :before message before,
-   see `template-message-register-format'.
-
-The following messages will be displayed in definition sequence after
-the expansion has taken place:
- - :after messages, see `template-definition-start',
- - user defined registers, display them at point if the value of this
-   variable is nil, see `template-message-register-format'."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "None" nil)
-		 (string :tag "Buffer Name")))
-
-(defcustom template-message-prompt-intro
-  "Template expansion will ask for input with the following prompts:"
-  "Default intro message used before listing user defined prompts.
-Used with :before messages, see `template-message-prompt-format'."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "None" nil)
-		 (string :tag "Intro text")))
-
-(defcustom template-message-prompt-format "   %s"
-  "If non-nil, format string for user defined prompts.
-If non-nil and `template-message-buffer' is non-nil, user defined
-prompts will be listed before starting the expansions.  Prompts can be
-defined as specified in the docstring of `template-definition-start'.
-For each PROMPT, this format string will be used with substitution
-PROMPT/%s.
-
-If no :before message has been defined before, use, if non-nil,
-`template-message-prompt-intro' as the first :before message."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "No prompt" nil)
-		 (string :tag "Format string")))
-
-(defcustom template-message-register-intro
-  "Template has defined the following registers:"
-  "Default intro message used before listing user defined prompts.
-Used with :after messages, see `template-message-register-format'."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "None" nil)
-		 (string :tag "Intro text")))
-
-(defcustom template-message-register-format "  %c:\t\"%s\"\t%s"
-  "If non-nil, format string for user defined registers.
-If non-nil, user defined text registers will be listed.  Registers can
-be defined as specified in the docstring of `template-definition-start'.
-For each register CHAR with contents CONTENTS and optional comment
-COMMENT, this format string will be used with substitution CHAR/%c,
-CONTENT/%s and \(COMMENT/%s or \"\"/%s).
-
-The list of register definitions will be displayed:
- - at point if `template-message-buffer' is nil,
- - with :before messages if there has been at least one :before message
-   defined before and if `template-message-buffer' is non-nil,
- - with :after messages if `template-message-buffer' is non-nil.
-   If no :after message has been defined before, use, if non-nil,
-   `template-message-register-intro' as the first :after message."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "No register content" nil)
-		 (string :tag "Format string")))
-
-(defcustom template-message-timeout 600
-  "*Maximum duration the temporary message will be displayed at point.
-Any user event will also make the temporary message disappear.  The
-temporary message uses face in `template-message-face'."
-  :group 'template-miscellaneous
-  :type 'integer)
-
-(put 'template-message-timeout 'template-secure-value #'integerp)
-
-(defcustom template-date-format "%d %b %Y"
-  "*Date/time format used with the expansion form (>>>DATE<<<).
-See `template-default-expansion-alist' and `format-time-string'.  See
-also `template-time-format'."
-  :group 'template-expansion
-  :type 'string)
-
-(put 'template-date-format 'template-secure-value #'stringp)
-
-(defcustom template-time-format "%T"
-  "*Date/time format used with the expansion form (>>>TIME<<<).
-See `template-default-expansion-alist' and `format-time-string'.  See
-also `template-date-format'."
-  :group 'template-expansion
-  :type 'string)
-
-(put 'template-time-format 'template-secure-value #'stringp)
-
-(defcustom template-string-default "%0.0S"
-  "*Format string used for non-string variable extensions.
-If SYMBOL in (\"KEY\" \. SYMBOL) is not a string, use string with
-substitution SYMBOL/%S.  Default value \"%0.0S\" causes to print
-nothing.  See `template-definition-start'."
-  :group 'template-expansion
-  :type 'string)
-
-(put 'template-string-default 'template-secure-value #'stringp)
-
-(defcustom template-expansion-format "(>>>%s<<<)"
-  "Format string for expansion forms.
-Is a expansion form with substitution KEY/%s.  The value should
-correspond with `template-expansion-regexp'.  Used by
-`template-insert-form'."
-  :group 'template-expansion
-  :type 'string)
-
-(put 'template-expansion-format 'template-secure-value #'stringp)
-
-(defcustom template-expansion-regexp "(>>>\\([-A-Za-z0-9_]+\\)<<<)"
-  "Regexp matching strings which are replaced by their expansions.
-The first regexp group contains the KEY used by the per-template
-expansion, see `template-definition-start' and the global expansions in
-`template-expansion-alist' and `template-default-expansion-alist'.  The
-value should correspond with `template-expansion-alist'.
-
-If there is no defined expansion for the key, ask the user for a
-replacement, see `template-read'.  If the key is matched by
-`template-register-regexp', store buffer position in register, see
-`template-register', .
-
-If you want to use a text literally which is matched by this regexp, use
-the zero expansion form (>>>ZERO_FORM<<<)."
-  :group 'template-expansion
-  :type 'regexp)
-
-(put 'template-expansion-regexp 'template-secure-value #'stringp)
-
-(defcustom template-literal-environment '("LITERAL" . "/LITERAL")
-  "Environment for literal text in template.
-Looks like (OPEN . CLOSE).  Text between expansion forms with keys OPEN
-and CLOSE is not expanded.  If you change OPEN, you should change key
-\"LITERAL\" in `template-default-expansion-alist' accordingly."
-  :group 'template-expansion
-  :type '(cons (string :tag "Open tag") (string :tag "Close tag")))
-
-(defcustom template-register-regexp "\\`[0-9]\\'"
-  "*Regexp matching keys for storing point positions in registers.
-These keys use `template-register' as the default expansion instead of
-`template-read'.  See `template-expansion-regexp'.  If a register is used
-twice, it is marked by a \"*\" in the echo area after the expansion."
-  :group 'template-expansion
-  :type 'regexp)
-
-(put 'template-register-regexp 'template-secure-value #'stringp)
-
-(defcustom template-expansion-alist nil
-  "User defined expansions forms.
-Predefined expansion forms for `template-expansion-regexp'.  Each entry
-has the form (KEY . SEXP).  These expansion forms shadow those in
-`template-default-expansion-alist' and are shadowed by those in the
-per-template definition section.  See `template-definition-start'."
-  :group 'template-expansion
-  :type '(repeat (cons :format "%v"
-		       (string :tag "Key" :value "")
-		       (repeat :tag "Evaluate all" sexp))))
-
-(put 'template-expansion-alist 'risky-local-variable t)
-
-(defvar template-default-expansion-alist
-  '(("POINT" (setq template-point (point-marker))) ; point
-    ("MARK" (setq template-mark (point-marker))) ; mark
-    ("DIR" (insert (car template-file))) ; directory
-    ("FILE" (insert (cadr template-file))) ; file name without directory
-    ("FILE_SANS" (insert (nth 2 template-file)
-			 (nth 3 template-file)))
-    ("FILE_RAW" (insert (nth 2 template-file))) ; raw file name without number
-    ("FILE_NUM" (insert (nth 3 template-file))) ; number
-    ("FILE_UPCASE" (insert (upcase (nth 2 template-file))
-			   (nth 3 template-file)))
-    ("FILE_EXT" (or (string= (nth 4 template-file) "")	; extension
-		    (insert (substring (nth 4 template-file) 1))))
-    ("DATE" (template-insert-time template-date-format))
-    ("TIME" (template-insert-time template-time-format))
-    ("VC_DATE" (set-time-zone-rule "UTC")
-     (template-insert-time "%Y/%m/%d %T" "0000/00/00 00:00:00")
-     ;; using saved `current-time-zone' doesn't work, but nil does
-     (set-time-zone-rule nil))
-    ("YEAR" (template-insert-time "%Y" "0000"))
-    ("ISO_DATE" (template-insert-time "%Y-%m-%d" "0000-00-00"))
-    ("COMMENT" (template-read "Initial comment: ")) ; comment
-    ("AUTHOR" (insert (or user-mail-address	; author
-			  (and (fboundp 'user-mail-address)
-			       (user-mail-address))
-			  (concat (user-login-name) "@" (system-name)))))
-    ("USER_NAME" (insert (or (and (boundp 'user-full-name) ; user name
-				  user-full-name)
-			     (user-full-name))))
-    ("LOGIN_NAME" (insert (user-login-name)))	; login name
-    ("HOST_ADDR" (insert (or (and (boundp 'mail-host-address) ; host address
-				  (stringp mail-host-address)
-				  mail-host-address)
-			     (system-name))))
-    ("LITERAL" (if (search-forward (format template-expansion-format
-					   (cdr template-literal-environment))
-				   nil 'limit)
-		   (delete-region (match-beginning 0) (match-end 0))))
-    ("ZERO_FORM"))			; zero form
-  "Predefined default expansions forms.
-Predefined expansion forms for `template-expansion-regexp'.  Each entry
-has the form (KEY . SEXP).  These expansion forms are shadowed by those
-in `template-expansion-alist' and by those in the per-template
-definition section.  See `template-definition-start'.
-
-The default predefined expansion forms are --default is inserting--:
-  (>>>POINT<<<)       set point
-  (>>>MARK<<<)        set mark, jump to it with \\[exchange-point-and-mark]
-  (>>>DIR<<<)         directory: /home/clstaff/wedler/lib/
-  (>>>FILE<<<)        file w/o directory: text1.txt
-  (>>>FILE_SANS<<<)   file name w/o extension: text1
-  (>>>FILE_RAW<<<)    raw file name: text
-  (>>>FILE_NUM<<<)    number in name: 1
-  (>>>FILE_EXT<<<)    extension: txt
-  (>>>FILE_UPCASE<<<) upcase file name w/o extension: TEXT1
-  (>>>DATE<<<)        date using `template-date-format': 11 Jan 1999
-  (>>>TIME<<<)        time using `template-time-format': 11:58:49
-  (>>>YEAR<<<)        the year: 1999
-  (>>>ISO_DATE<<<)    ISO 8601 date: 1999-01-11
-  (>>>VC_DATE<<<)     UTC date/time for vc: 1999/01/11 10:58:49
-  (>>>COMMENT<<<)     ask user for initial comment
-  (>>>AUTHOR<<<)      author, i.e., `user-mail-address'
-  (>>>USER_NAME<<<)   user name: Christoph Wedler
-  (>>>LOGIN_NAME<<<)  login name: wedler
-  (>>>HOST_ADDR<<<)   Host address: fmi.uni-passau.de
-  (>>>LITERAL<<<)     literal text up to (>>>/LITERAL<<<)
-  (>>>ZERO_FORM<<<)   zero form, i.e., insert nothing.  Useful to insert
-      a text part matched by `template-expansion-regexp' literally.
-
-There are aliases with one-letter keys, see `template-key-alias-alist'.
-
-It is useful to follow the following conventions: upper case keys for
-predefined extensions, lower case and digits for per-template and the
-following default expansions:
-  (>>>0<<<) to (>>>9<<<)  set registers 0 to 9, jump to it with
-      \\[jump-to-register] 0 etc., see `template-register-regexp'
-  (>>>x<<<) where x is any unused letter sequence: ask user.")
-
-(put 'template-default-expansion-alist 'risky-local-variable t)
-
-(defvar template-key-alias-alist
-  '(("P" . "POINT")
-    ("M" . "MARK")
-    ("D" . "DIR")
-    ("F" . "FILE")
-    ("R" . "FILE_RAW")
-    ("N" . "FILE_NUM")
-    ("B" . "FILE_UPCASE")
-    ("E" . "FILE_EXT")
-    ("T" . "DATE")
-    ("V" . "VC_DATE")
-    ("Y" . "YEAR")
-    ("I" . "ISO_DATE")
-    ("C" . "COMMENT")
-    ("A" . "AUTHOR")
-    ("U" . "USER_NAME")
-    ("L" . "LOGIN_NAME")
-    ("H" . "HOST_ADDR")
-    ("Z" . "ZERO_FORM"))
-  "Alist to support the old one-letter predefined expansion forms.
-Used for `template-expansion-alist' and
-`template-default-expansion-alist'.")
-
-(defcustom template-definition-start
-  ">>>TEMPLATE-DEFINITION-SECTION<<<"
-  "Header for the per-template definition section.
-The region following the the first match of this regexp defines the
-per-template definition section.  The region will be deleted before the
-actual expansion, see `template-new-file'.  If you use the \"Local
-Variables:\" section, define it before this region.
-
-The definition section defines expansion forms for strings KEYs matched
-by `template-expansion-regexp' which might shadow those in
-`template-expansion-alist' and `template-default-expansion-alist':
-
-  (\"KEY\"): zero form, same as (>>>ZERO_FORM<<<) in default value of
-`template-default-expansion-alist', useful for inserting text matched by
-`template-expansion-regexp' literally.
-
-  (\"KEY\". CHAR): CHAR is the register where the current buffer
-position is stored, see `template-register-regexp'.
-
-  (\"KEY\" \"PROMPT\" \"PREFIX\" \"SUFFIX\" \"DEFAULT\" AGAIN-P) where
-the last four arguments are optional: ask user with PROMPT for a STRING.
-If STRING is not \"\", insert PREFIX STRING SUFFIX, otherwise DEFAULT.
-For AGAIN-P, see `template-read'.  To define, use
-\\[template-define-prompt].
-
-  (\"KEY\" \"PROMPT\" (\"ANSWER\" \. \"TEXT\")...): ask user with PROMPT
-for an input with completion over all ANSWERs and insert corresponding
-TEXT.  Expansion forms in TEXT will be expanded.
-
-  (\"KEY\" \"PROMPT\" (t \. \"TEXT-y\")  (nil \. \"TEXT-n\")): ask user
-with PROMPT a \"y or n\" question with `y-or-n-p' and insert TEXT-y or
-TEXT-n, correspondingly.  Expansion forms in TEXT-X will be expanded.
-The y-case and the n-case are optional and can be exchanged.
-
-  (\"KEY\" \. SYMBOL): insert value of SYMBOL; if value is no string at
-the time of the replacement, use `template-string-default' as format
-string for SYMBOL.
-
-  (\"KEY\" COMMAND \. PREFIX): COMMAND is a symbol or a vector and is
-called with `command-execute' after setting `prefix-arg' to PREFIX, not
-evaluated.  If COMMANDs symbol property `template-secure-command' is
-nil, the form is insecure.  If that symbol property is a function, it is
-called with PREFIX to check whether COMMAND could be called directly
-with PREFIX as remaining arguments.
-
-  (\"KEY\" SEXPR...): evaluate SEXPR during the expansion, see
-`template-expansion-alist' for examples.  This form is insecure.
-
-There are other per-template definitions:
-
-  \"MESSAGE\": additional line displayed at point until first user event
-or after `template-message-timeout' seconds.  The lines are displayed
-with face in `template-message-face'.  With active form selector
-:before, define a message which is displayed in
-`template-message-buffer' before the exansion has started.  With active
-form selector :after, define a message which is displayed in
-`template-message-buffer' after the exansion has taken place.  To
-define interactively, use \\[template-define-message].
-
-  (CHAR \. \"CONTENTS\"): Set register CHAR to have contents CONTENTS.
-CONTENTS can then be inserted into a buffer with \\[insert-register] CHAR.
-
-  (CHAR \"CONTENTS\" COMMENT) where COMMENT is optional: Set register
-CHAR to have contents CONTENTS.  CONTENTS can then be inserted into a
-buffer with \\[insert-register] CHAR.  Also display an additional line
-at point to show the contents with COMMENT.  To define, use
-\\[template-define-register].
-
-The following forms depend on the active form selector which is the last
-of the following expansion forms:
- - :before: \"MESSAGE\" will be displayed before the expansion
- - :after: \"MESSAGE\" will be displayed after the expansion
- - :eval-before: execute COMMAND and SEXPR before expansion
- - :eval-after: execute COMMAND and SEXPR after expansion
- - nil, deprecated: with the first form, the active form selector is
-   :eval-before, with the second, it is :eval-after.
-
-  (VARIABLE . VALUE): set SYMBOL's local value to VALUE, not evaluated.
-This form is only secure if VARIABLE has a symbol property
-`template-secure-value' which returns non-nil when applied to VALUE, not
-evaluated.  This form is useful for variables which determine the
-expansion, like `template-time-format' and `template-date-format'.  For
-local variables in your new file, use the normal way via the \"Local
-Variables:\" section.  The active form selector must not be :eval-before
-or :eval-after.
-
-  COMMAND: COMMAND is a symbol or a vector and is called with
-`command-execute' before the expansion with form selector :eval-before,
-and after the expansion with form selector :eval-after.  If COMMANDs
-symbol property `template-secure-command' is nil, the form is insecure.
-You should use the safe command `normal-mode' in the pre-expansion forms
-if the expansion forms depend on the correct major mode.
-
-  SEXPR: evaluate SEXPR before the expansion with form selector
-:eval-before, and after the expansion with form selector :eval-after.
-This form is insecure.
-
-If any insecure forms have been used, the user of the template will be
-asked whether to use the template, see `template-confirm-insecure'."
-  :group 'template-expansion
-  :type 'string)
-
-
-
-;;;;##########################################################################
-;;;;  Commenting
-;;;;##########################################################################
-
-
-(defunx template-point-at-bol (&optional count)
-  :emacs-only line-beginning-position
-  :xemacs-only point-at-bol)
-
-(defunx template-point-at-eol (&optional count)
-  :emacs-only line-end-position
-  :xemacs-only point-at-eol)
-
-(defunx template-char-or-char-int-p (object)
-  :emacs-only integerp
-  :xemacs-only char-or-char-int-p)
-
-(defunx template-char-or-int-to-char (object)
-  :emacs-only identity
-  "Convert character or integer OBJECT into the equivalent character."
-  (if (characterp object) object (int-to-char object)))
-
-
-;;;===========================================================================
-;;;  Main functions
-;;;===========================================================================
-
-;;;###autoload
-(defun template-single-comment (&optional arg)
-  "Decorate the comment in the current line with dashes and alike.
-The line must be a comment-only line or must contain a comment ending by
-eol.  That is, jump to the end of the current line and insert the dashes
-and the final comment end-string up-to the fill position.  Prefix
-argument ARG and `template-comment-specification' determines the comment
-style to use.  The length of the resulting line is determined by
-`template-max-column' and `template-max-column-with-end'."
-  (interactive "*P")
-  (let* ((orig (point-marker))
-	 (syntax0 (and comment-start comment-start-skip
-		       (condition-case nil
-			   (template-comment-syntax orig 'boc)
-			 (error nil))))
-	 (syntax (cond ((cdr syntax0)
-			(template-comment-syntax orig))
-		       (syntax0
-			(condition-case nil
-			    (template-comment-syntax (point-marker))
-			  (error syntax0)))
-		       (t
-			(back-to-indentation)
-			nil)))
-	 (sep (template-comment-separator-regexp syntax))
-	 (end (template-point-at-eol))
-	 old)
-    (save-excursion
-      (cond ((re-search-forward sep end t)
-	     ;; with sep in current line
-	     (setq old (buffer-substring (match-beginning 1) (match-end 1)))
-	     (delete-region (match-beginning 0) (match-end 0)))
-	    ((cdr syntax)		; with start-end comment
-	     (if (looking-at (concat "[ \t]*\\(.+\\)?"
-				     (regexp-quote (cadr syntax))
-				     "[ \t]*\\(.+\\)?$"))
-		 (if (or (match-beginning 1) (match-beginning 2))
-		     (error "This line contains non-separator chars and %S"
-			    (cadr syntax))
-		   ;; Delete comment-end.  Don't delete its first char if it is
-		   ;; the same as the second of comment-start.
-		   (delete-region (if (and (= (length (car syntax)) 2)
-					   (= (length (cadr syntax)) 2)
-					   (eq (aref (car syntax) 1)
-					       (aref (cadr syntax) 0)))
-				      (1+ (match-beginning 0))
-				    (match-beginning 0))
-				  (match-end 0))))
-	     (goto-char (cddr syntax))
-	     (if (re-search-forward sep end t)
-		 ;; sep in line between comment-start and point-at-eol
-		 (setq old (buffer-substring (match-beginning 1)
-					     (match-end 1)))))))
-    (template-insert-separator
-     (car (template-comment-specification arg old syntax))
-     nil syntax)))
-(put 'template-single-comment 'template-secure-command t)
-
-;;;###autoload
-(defun template-block-comment (&optional arg)
-  "Decorate the current block of comment-only lines with dashes and alike.
-That is, surround the the contiguous comment-only lines around point
-with extra lines containing dashes and alike and to put the correct
-number of newlines around the block.
-
-Barf if the comment syntax at point has a non-empty `comment-end' or if
-point is not in a comment-only line.
-
-A block comment consists of all neighboring lines which start with
-spaces and `comment-start'.  If `comment-start' is a string of length 1,
-the number of repetitions of `comment-start' must be the same or larger
-than in the line where the command is invoked from, too.
-
-Prefix argument ARG and `template-comment-specification' determines the
-comment style to use.  The length of the separator line is determined by
-`template-max-column'.
-
-This command can also be used with point in an empty line after a block
-comment.  A second invocation of this command directly after a
-successful invocation deletes the remaining empty lines from the current
-line on."
-  (interactive "*P")
-  (let* ((orig (point-marker))
-	 (syntax (progn
-		   (end-of-line)
-		   (skip-chars-backward " \t\n\f")
-		   (template-comment-syntax orig))))
-    (when (cdr syntax)
-      (goto-char orig)
-      (error "Command only works with comments terminated by end-of-line"))
-    
-    (if (and (eq last-command 'template-block-comment-success)
-	     (looking-at "[ \t]*$"))
-	(template-insert-newline "" nil (1- (template-point-at-bol)))
-      (let* ((prefix (concat "[ \t]*" (regexp-quote (car syntax))))
-	     (sepline (concat prefix "[ \t]*"
-			      (template-comment-separator-regexp syntax)))
-	     old block-beg block-end def)
-	;; go to the first line with same comment prefix ---------------------
-	(beginning-of-line)
-	(while (and (not (bobp)) (looking-at prefix))
-	  (beginning-of-line 0))
-	(or (looking-at prefix) (beginning-of-line 2))
-	(while (looking-at sepline)
-	  (setq old (buffer-substring (1- (match-end 0)) (match-end 0)))
-	  (kill-line 1))
-	(setq block-beg (point-marker))
-	;; go to the last line with same comment prefix ----------------------
-	(while (looking-at prefix)
-	  (template-indent-according-to-mode)
-	  (beginning-of-line 2))
-	(if (eobp) (newline))
-	(setq block-end (copy-marker (point) t))
-	(while (progn (forward-line -1) (looking-at sepline))
-	  (setq old (buffer-substring (1- (match-end 0)) (match-end 0)))
-	  (kill-line 1))
-	;; insert separator lines --------------------------------------------
-	(goto-char block-beg)
-	(set-marker block-beg nil)
-	(back-to-indentation)
-	(setq def (template-comment-specification arg old syntax))
-	(beginning-of-line)
-	(template-insert-newline (cadr def))
-	(template-insert-separator (car def) (car syntax) syntax)
-	(goto-char block-end)
-	(set-marker block-end nil)
-	(template-insert-separator (car def) (car syntax) syntax)
-	(template-insert-newline (caddr def)
-				 (and (cadddr def)
-				      (save-excursion
-					(forward-line (cadddr def))
-					(point))))
-	(setq this-command 'template-block-comment-success)))
-    (template-indent-according-to-mode)
-    (back-to-indentation)))
-(put 'template-block-comment 'template-secure-command t)
-
-
-;;;===========================================================================
-;;;  Check comment start, return specification
-;;;===========================================================================
-
-(defun template-indent-according-to-mode ()
-  "Indent line according to `template-comment-indent'."
-  (if (if template-comment-indent
-	  (not (memq major-mode template-indent-mode-disable-list))
-	(memq major-mode template-indent-mode-enable-list))
-      (indent-according-to-mode)))
-
-(defun template-default-comment ()
-  "Return default comment according to current position."
-  (if comment-start
-      (substring comment-start 0 (string-match "[ \t]\\'" comment-start))
-    (if (eolp) "#"
-      (let ((default (buffer-substring (point) (1+ (point)))))
-	(if (string-match "[A-Za-z]" default) "#" default)))))
-
-(defun template-comment-at-point ()
-  "Return the comment syntax at the current position.
-Return nil, if no commenting command can be used, i.e., if point is not
-in a comment-only line.  Return `none' if the `major-mode' doesn't
-define a comment syntax.  Return `delimited' if point is between
-`comment-start' and a non-empty `comment-end'.  Return `single' if point
-is in a comment line where the comment syntax has a empty `comment-end',
-return `block' if point is in an empty line after such a comment line."
-  (if (and comment-start comment-start-skip)
-      (save-excursion
-	(let ((orig (point)))
-	  (condition-case nil
-	      (progn
-		(end-of-line)
-		(skip-chars-backward " \t\n\f")
-		(if (cdr (template-comment-syntax orig t)) 'delimited
-		  (if (< (template-point-at-eol) orig) 'block 'single)))
-	    (error
-	     (condition-case nil
-		 (progn
-		   (goto-char orig)
-		   (beginning-of-line)
-		   (when (re-search-forward comment-start-skip
-					    (template-point-at-eol) t)
-		     (goto-char (or (match-end 1) (match-beginning 0)))
-		     (unless (or (cdr (template-comment-syntax orig 'boc))
-				 (< (template-point-at-eol) orig))
-		       'cont)))
-	       (error nil))))))
-    'none))
-
-(defun template-comment-syntax (orig &optional no-indent)
-  "Return the comment syntax at ORIG.  Signal error if not in comment.
-Return (COMMENT-START) if the comment syntax has an empty `comment-end'.
-Return (COMMENT-START COMMENT-END . START-POS) if the comment syntax has
-a non-empty `comment-end' where START-POS is the position of the first
-character inside the comment.  Move point to first character after the
-comment start or the first non-whitespace character on this line.
-
-ORIG should be the same as `point' or in a empty line after `point'.
-
-If optional argument NO-INDENT is nil, indents the current line
-according to `template-comment-indent' and `indent-according-to-mode'.
-If NO-INDENT is `boc', move point to the beginning of the comment.
-
-COMMENT-START is stripped off its final spaces, COMMENT-END off its
-initial spaces."
-  (unless (and comment-start comment-start-skip)
-    (error "No comment syntax has been defined for %s" major-mode))
-  (if (eq no-indent 'boc)
-      (progn
-	(beginning-of-line)
-	(if (re-search-forward comment-start-skip (template-point-at-eol) t)
-	    (goto-char (or (match-end 1) (match-beginning 0)))))
-    (or no-indent (template-indent-according-to-mode))
-    (back-to-indentation))
-  (let* ((string (template-default-comment)))
-    (if (string= comment-end "")
-	(if (looking-at (concat (regexp-quote string)
-				(and (= (length string) 1)
-				     (not (eq no-indent 'boc))
-				     "+")))
-	    (progn
-	      (goto-char (match-end 0))
-	      (list (buffer-substring (match-beginning 0) (point))))
-	  (let ((alist template-alt-comment-syntax-alist)
-		elem c-start c-end)
-	    (while alist
-	      (setq elem (pop alist))
-	      (and (template-match-modes-or-regexp (car elem))
-		   (string-match comment-start-skip (cadr elem))
-		   (setq c-start (cadr elem)
-			 c-end   (caddr elem)
-			 alist   nil)))
-	    (template-comment-syntax-0 orig c-start c-end string)))
-      (template-comment-syntax-0 orig comment-start comment-end))))
-
-(defun template-comment-syntax-0 (orig c-start c-end &optional single)
-  ;; checkdoc-params: (orig c-start c-end single)
-  "Internal function for `template-comment-syntax'."
-  (unless (and (stringp c-start) (stringp c-end) (not (string= c-end "")))
-    (goto-char orig)
-    (error "Line does not start with %S"
-	   (or single (template-default-comment))))
-  (setq c-start (substring c-start 0 (string-match "[ \t]\\'" c-start))
-	c-end   (if (string-match "\\`[ \t]+" c-end)
-		    (substring c-end (match-end 0))
-		  c-end))
-  (cond ((looking-at (regexp-quote c-start))
-	 (goto-char (match-end 0))
-	 (cons c-start (cons c-end (point))))
-	((save-excursion
-	   (when (re-search-backward (concat "^[ \t]*" (regexp-quote c-start))
-				     nil t)
-	     (goto-char (match-end 0))
-	     (let ((match (point)))
-	       (unless (when (search-forward c-end orig t)
-			 (skip-chars-forward " \t")
-			 (< (point) orig))
-		 (cons c-start (cons c-end match)))))))
-	(t
-	 (goto-char orig)
-	 (if single
-	     (error "Not inside a comment (%S or %S-%S) starting in new line"
-		    single c-start c-end)
-	   (error "Not inside a comment (%S-%S) starting in new line"
-		  c-start c-end)))))
-
-
-;;;===========================================================================
-;;;  Comment specification
-;;;===========================================================================
-
-;; A simple `mapconcat' is likely to slow down Emacs' regexp search algorithm
-;; considerably (backtracking => near-infloop).
-(defun template-comment-separator-regexp (syntax)
-  "Return regexp matching separator comment lines.
-The regexp also matches if the lines ends with parts of COMMENT-END in
-argument SYNTAX, see `template-comment-syntax'."
-  (let ((estring (cadr syntax))
-	(alist template-comment-specification-alist)
-	(chars nil)
-	str i c)
-    (while alist
-      (setq str (car (pop alist)))
-      (when str
-	(setq i (length str))
-	(while (>= (decf i) 0)
-	  ;; (pushnew (aref str i) chars), but requires cl at runtime:
-	  (or (memq (setq c (aref str i)) chars) (push c chars)))))
-    (concat "\\("
-	    (mapconcat (lambda (c) (regexp-quote (char-to-string c)))
-		       (or chars "#")
-		       "\\|")
-	    (if estring
-		(concat "\\)+[ \t]*"
-			(mapconcat (lambda (c)
-				     (regexp-quote (char-to-string c)))
-				   estring
-				   "?")
-			"?[ \t]*$")
-	      "\\)+[ \t]*$"))))
-
-(defun template-comment-specification (arg old syntax)
-  "Return the comment specification to use.
-See `template-comment-specification-alist' for details.  ARG is the
-prefix argument, OLD the SEPARATOR of the old comment style and SYNTAX
-is the comment syntax returned by `template-comment-syntax'."
-  (and arg (setq arg (prefix-numeric-value arg)))
-  ;; assumes point-at-indentation
-  (or (and arg (> arg 0)
-	   (if (< (length template-comment-specification-alist) arg)
-	       (car (last template-comment-specification-alist))
-	     (nth (1- arg) template-comment-specification-alist)))
-      (and (null arg) old
-	   (assoc old template-comment-specification-alist))
-      (and (functionp template-comment-specification-special)
-	   (funcall template-comment-specification-special))
-      (and (functionp (get major-mode 'template-comment-specification-special))
-	   (funcall (get major-mode 'template-comment-specification-special)))
-      (and syntax
-	   (template-comment-specification
-	    (if (or (cdr syntax) (> (length comment-start) 1))
-		(save-excursion
-		  (if (cddr syntax) (goto-char (cddr syntax)))
-		  (beginning-of-line)
-		  (if (looking-at "[ \t]") 2 3))
-	      (length (car syntax)))
-	    nil nil))
-      '("-" "" "" 0)))
-
-
-;;;===========================================================================
-;;;  Inserting
-;;;===========================================================================
-
-(defun template-insert-newline (string &optional limit start-limit)
-  "Deletes blank lines around point and insert STRING.
-After optional LIMIT and before optional START-LIMIT, no character will
-be deleted."
-  (let ((start (save-excursion
-		 (skip-chars-backward " \t\n\f" start-limit)
-		 (or (bobp) (forward-line 1))
-		 (point)))
-	(end (save-excursion
-	       (skip-chars-forward " \t\n\f" limit)
-	       (beginning-of-line)
-	       (point))))
-    (if (> end start) (delete-region start end)))
-  (or (bobp) (insert string)))
-
-(defun template-insert-separator (separator &optional cstring syntax)
-  "Insert separator line at point.
-If CSTRING is not nil, insert in special line which starts with CSTRING.
-Insert SEPARATOR repeatedly.  End the line with COMMENT-END as specified
-in `template-comment-syntax'."
-  (when separator
-    (when cstring
-      (open-line 1)
-      (insert cstring)
-      (template-indent-according-to-mode))
-    (end-of-line)
-    (let* ((estring (cadr syntax))
-	   (max-column (if estring
-			   template-max-column-with-end
-			 template-max-column))
-	   (max (- (if (> max-column 0) max-column (+ fill-column max-column))
-		   (length separator)
-		   (length estring))))
-      (while (<= (current-column) max) (insert separator))
-      (if (>= (length separator) (- (current-column) max))
-	  (insert (substring separator 0 (- max (current-column)))))
-      (if estring (insert estring))
-      (if cstring (forward-line 1)))))
-
-
-;;;===========================================================================
-;;;  Adaptations: cc-mode
-;;;===========================================================================
-
-;; There isn't really anything I can do against the filling of "/**" in C, C++
-;; and Antlr mode (it is correct in Java), it should be done in the cc-mode
-;; package.  Similar for filling "*/" with the previous line...
-
-(defun template-c-fill-paragraph (&optional arg)
-  ;; checkdoc-params: (arg)
-  "Like \\[c-fill-paragraph] but handles comment separator lines."
-  (let* ((regexp (concat "\\|[ \t]*\\(/[*/]\\|\\*\\)[ \t]*"
-			 (template-comment-separator-regexp '("/*" "*/"))))
-	 (paragraph-start (concat paragraph-start regexp)) ;#dynamic
-	 (paragraph-separate (concat paragraph-separate regexp)))
-    (c-fill-paragraph arg)))
-
-(defun template-c-init-fill-function ()
-  "Set `fill-paragraph-function' to use `template-c-fill-paragraph'."
-  (when (boundp 'fill-paragraph-function)
-    (make-local-variable 'fill-paragraph-function)
-    (setq fill-paragraph-function 'template-c-fill-paragraph)))
-
-
-
-;;;;##########################################################################
-;;;;  Updating (File Name in Header)
-;;;;##########################################################################
-
-
-;;;===========================================================================
-;;;  General updating
-;;;===========================================================================
-
-(defun template-update-buffer-region (limit regexp group)
-  "Return region = (BEG . END) in buffer to be updated.
-If LIMIT is positive, check first LIMIT characters in buffer, otherwise
-check last -LIMIT characters in buffer for a text to be matched by
-REGEXP.  Return region according to GROUP's regexp group in REGEXP."
-  (let ((case-fold-search nil))
-    (goto-char (if limit
-		   (if (natnump limit) (point-min) (+ (point-max) limit))
-		 (point-min)))
-    (when (re-search-forward regexp
-			     (if (natnump limit)
-				 (+ (point-min) limit)
-			       (point-max))
-			     t)
-      (cons (match-beginning group) (match-end group)))))
-
-(defun template-match-modes-or-regexp (modes-or-regexp)
-  "Return non-nil, if the current buffer passes MODES-OR-REGEXP.
-If MODES-OR-REGEXP is a list, it must include the current `major-mode',
-if it is a regexp, it must match the `buffer-file-name' without version,
-otherwise it must be non-nil."
-  (if (stringp modes-or-regexp)
-      (and buffer-file-name
-	   (string-match modes-or-regexp
-			 (file-name-sans-versions buffer-file-name)))
-    (or (nlistp modes-or-regexp) (memq major-mode modes-or-regexp))))
-
-(defun template-update-buffer (&optional arg)
-  "Update buffer according to `template-update-buffer-alist'.
-Do not do anything if `template-auto-update-disable-regexp' matches the
-file name or if `template-auto-update' is nil.  When optional ARG is
-non-nil, i.e., if called interactively *without* prefix arg, always
-update."
-  (interactive (list (null current-prefix-arg)))
-  (when (or arg
-	    (and template-auto-update buffer-file-name
-		 (null (and template-auto-update-disable-regexp
-			    (string-match template-auto-update-disable-regexp
-					  buffer-file-name)))))
-    (save-excursion
-      (save-restriction
-	(widen)
-	(let ((alist template-update-buffer-alist)
-	      (case-fold-search (memq system-type '(vax-vms ms-dos windows-nt)))
-	      stamp prompt region new)
-	  (while alist
-	    (setq stamp (pop alist))
-	    (condition-case nil
-		(and (template-match-modes-or-regexp (pop stamp))
-		     ;; Run TEST ---------------------------------------------
-		     (setq prompt (pop stamp)
-			   region (pop stamp) ; TEST
-			   region (eval (if (or (atom region)
-						(functionp (car region)))
-					    region
-					  (cons 'template-update-buffer-region
-						region))))
-		     (if (stringp (setq new (eval (pop stamp))))
-			 (null (string= (buffer-substring (car region)
-							  (cdr region))
-					new))
-		       (car stamp))
-		     ;; user confirmation, replacement -----------------------
-		     (or (null prompt)
-			 arg
-			 (eq template-auto-update t)
-			 (y-or-n-p (format prompt (buffer-name))))
-		     (progn
-		       (goto-char (car region))
-		       (if (car stamp)
-			   (funcall (car stamp) new (car region) (cdr region))
-			 (delete-region (car region) (cdr region))
-			 (insert new))))
-	      (error nil))))))))
-
-
-;;;===========================================================================
-;;;  Update header
-;;;===========================================================================
-
-;;;###autoload
-(defun template-update-header (&optional show)
-  "Replace old file name in header with current file name.
-If SHOW is t, just return region of the filename or nil.  Otherwise,
-replace filename if possible and signal an error if SHOW is nil and
-there is no filename in the header.  See `template-header-lines' and
-`template-header-regexp-alist'."
-  (interactive "*P")
-  (if buffer-file-name
-      (save-excursion
-	(goto-char (point-min))
-	(let ((case-fold-search nil)
-	      (comment-regexp (template-default-comment)) ; at `point-min'!
-	      (end (progn (forward-line template-header-lines) (point)))
-	      (alist template-header-regexp-alist)
-	      (disallowed "")
-	      group)
-	  (if (string-match "[A-Za-z]\\|.." comment-regexp)
-	      (setq comment-regexp (regexp-quote comment-regexp)
-		    disallowed "")
-	    (or (eq comment-regexp '(?\]))
-		(setq disallowed comment-regexp))
-	    (setq comment-regexp (concat (regexp-quote comment-regexp) "+")))
-	  (while alist
-	    (goto-char (point-min))
-	    (if (re-search-forward (format (caar alist)
-					   comment-regexp disallowed)
-				   end t)
-		(setq group (cdar alist)
-		      alist nil)
-	      (setq alist (cdr alist))))
-	  (if (and group (match-beginning group))
-	      (if (eq show t)
-		  (cons (match-beginning group) (match-end group))
-		(goto-char (match-beginning group))
-		(delete-region (point) (match-end group))
-		(insert (file-name-sans-versions
-			 (file-name-nondirectory buffer-file-name)))
-		t)
-	    (if show nil (error "No file name in header")))))
-    (if show nil (error "Buffer is not visiting a file"))))
-
-
-
-;;;;##########################################################################
-;;;;  Templates
-;;;;##########################################################################
-
-
-(defvar template-history nil
-  "History, used by `template-read'.")
-
-(defvar template-choice-history nil
-  "History, used by `template-choice'.")
-
-(put 'normal-mode 'template-secure-command t)
-
-(defvar template-all-templates nil
-  "Internal variable.  Template files used for template derivation.")
-(defvar template-file nil
-  "Partitioned name of new file: (DIR FILE RAW NUMBER EXT).
-Internal variable.  DIR is the directory part, FILE the file name
-without directory part.  FILE consists of its extension EXT, RAW and a
-numbering NUMBER just in front of the extension.  It is used by the
-expansions DIR, FILE, FILE_SANS, FILE_EXT and others in
-`template-expansion-alist'.  Also useful for user defined functions in
-`template-derivation-alist' and the per-template definition section.")
-
-(defvar template-modified nil
-  "Internal variable.  Whether user is asked during the expansion process.")
-(defvar template-secure t
-  "Internal variable.  Whether all per-template definitions are secure.")
-(defvar template-point-messages nil
-  "Internal variable.  List of lines for temporary message at point.")
-(defvar template-before-messages nil
-  "Internal variable.  List of lines for temporary message before expansion.")
-(defvar template-after-messages nil
-  "Internal variable.  List of lines for temporary message after expansion.")
-
-(defvar template-point nil
-  "Internal variable.  Position of point.  Set with expansion form P.")
-(defvar template-mark nil
-  "Internal variable.  Position of mark.  Set with expansion form M.")
-
-(defvar template-current nil
-  "Internal variable.  Current key of expansion form.")
-(defvar template-string-alist nil
-  "Internal variable.  Alist of user inputs for `template-read'.")
-(defvar template-register-alist nil
-  "Internal variable.  Alist of used registers.")
-(defvar template-local-alist nil
-  "Internal variable.  Alist of per-template defined expansions.")
-
-(defvar template-ffap-file-finder nil
-  "Value used inside `template-ffap-find-file'.
-If nil, initialize it to the value of `ffap-file-finder', i.e., this
-variable holds the original value of that variable which will be set to
-`template-ffap-find-file' in `template-initialize'.")
-
-
-;;;===========================================================================
-;;;  Functions: `find-file'/`insert-file-contents', hooking into `find-file'
-;;;===========================================================================
-
-(defun template-find-template (filename &optional replace)
-  "Switch to a buffer visiting template file FILENAME.
-If optional REPLACE is non-nil, replace the current buffer contents with
-the contents of file FILENAME.
-
-This function always considers template files as text files."
-  (let ((file-name-buffer-file-type-alist nil))	; Emacs on DOS/NT
-    (if replace
-	(insert-file-contents filename nil nil nil
-			      ;; 5th arg not t with empty accessible part
-			      ;; (XEmacs bug workaround: would infloop)
-			      (> (point-max) (point-min)))
-      (let ((template-auto-insert nil))
-	(switch-to-buffer (find-file-noselect filename))))))
-
-(defun template-not-found-function ()
-  "Use a template when visiting a non-existent file.
-See `template-auto-insert' and `template-find-file-commands'.  Function
-in `find-file-not-found-hooks'."
-  (and template-auto-insert (not buffer-read-only) (bobp) (eobp)
-       (or (memq this-command template-find-file-commands)
-	   (and (memq this-command template-file-select-commands)
-		;; thanks to Dave Love <d.love@dl.ac.uk>:
-		(memq (car-safe (car command-history))
-		      ;; To always include `find-file-at-point', use ffap
-		      ;; initialization (see `template-ffap-find-file')
-		      template-find-file-commands)))
-       (let ((template (cdr (template-derivation buffer-file-name t t))))
-	 (and template
-	      (file-readable-p template)
-	      (or (eq template-auto-insert t)
-		  (y-or-n-p
-		   (format "Use template %s? "
-			   (cond-emacs-xemacs
-			    (abbreviate-file-name template :XEMACS t)))))
-	      (progn
-		(template-new-file nil template)
-		(setq this-command 'session-disable)
-		t)))))
-
-(defun template-ffap-find-file (filename)
-  "Function to use in `ffap-file-finder'.
-Add an entry to `command-history' if necessary and call function in
-`template-ffap-file-finder' with argument FILENAME."
-  (or (memq (car-safe (car command-history))
-	    '(ffap find-file-at-point))
-      (setq command-history
-	    (cons (list 'find-file-at-point filename) command-history)))
-  (if (eq template-ffap-file-finder 'template-ffap-find-file)
-      (find-file filename)
-    (funcall template-ffap-file-finder filename)))
-
-
-;;;===========================================================================
-;;;  Main function
-;;;===========================================================================
-
-(defun template-expand-template-interactive ()
-  (let* ((use (template-derivation (expand-file-name
-				    (or buffer-file-name "NONE"))
-				   t))
-	 (tpl (read-file-name "Insert and expand template: "
-			      (file-name-directory (cdr use))
-			      (file-name-nondirectory (cdr use))
-			      t
-			      (file-name-nondirectory (cdr use)))))
-    (if (string= tpl "")
-	(error "No template file provided"))
-    (list (expand-file-name tpl (file-name-directory (cdr use))))))
-
-;;;###autoload
-(defun template-expand-template (template)
-  "Expand template file TEMPLATE and insert result in current buffer.
-Using a template for inserting some text consists of:
-  1. Template derivation: suggest a reasonable template file to the user
-     according to `buffer-file-name', see `template-derivation-alist'.
-  2. Template insertion: insert the template file at point into the
-     current buffer.
-  3.. as steps 6.. of `template-new-file'."
-  (interactive (template-expand-template-interactive))
-  (save-restriction
-    (narrow-to-region (point) (point))
-    (template-new-file nil template t)))
-
-(defun template-new-file-interactive ()
-  "Interactive specification for `template-new-file'.
-Return \(FILE TEMPLATE)."
-  (let* ((inp (read-file-name (if current-prefix-arg
-				  "New file (+template, no name change): "
-				"New file (+template): ")
-			      nil ""))
-	 (use (cond ((equal inp "")
-		     (error "Empty/no input"))
-		    ((file-directory-p inp)
-		     (error "%S is a directory" inp))
-		    (t (template-derivation (expand-file-name inp)
-					    current-prefix-arg))))
-	 (tpl (read-file-name (format "File %s uses template: "
-				      (file-name-nondirectory (car use)))
-			      (file-name-directory (cdr use))
-			      (file-name-nondirectory (cdr use))
-			      t
-			      (file-name-nondirectory (cdr use)))))
-    (list (car use)
-	  (if (string= tpl "")
-	      nil
-	    (expand-file-name tpl (file-name-directory (cdr use)))))))
-
-;;;###autoload
-(defun template-new-file (file template &optional with-undo)
-  "Open a new file FILE by using a TEMPLATE.
-Using a template for creating a new file consists of, steps 1 to 3 are
-only executed when called interactively:
-  1. Prompt for the name of the new file.
-  2. Template derivation: suggest a reasonable template file to the user
-     see `template-derivation-alist'.
-  3. File name refinement: e.g., if the given file name is \"exercise\"
-     and there are two files \"exercise1.tex\" and \"exercise2.tex\" in
-     the same directory and if we have a template \"exercise.tex.tpl\",
-     the file name is refined to \"exercise3.tex\".  This is turned off
-     when \\[template-new-file] is called with a prefix argument.
-  4. Template insertion: insert the template file into the empty buffer.
-  5. Read per-template expansion definition section starting at
-     `template-definition-start' and delete it.
-  6. Display :before message in `template-message-buffer'.
-  7. Execute pre-expansion commands defined in the definition section.
-  8. Set local variables defined in the definition section.
-  9. Expansion: expand the expansion forms (text matched by
-     `template-expansion-regexp') They are defined in the definition
-     section, in `template-expansion-alist', or provided by default, see
-     `template-expansion-regexp' and `template-register-regexp'.
- 10. Execute post-expansion commands defined in the definition section.
- 11. Run `normal-mode' and functions in `find-file-hooks'.
- 12. Update header according to `template-update-header' with argument
-    `if-exists'.
- 13. Display :after message in `template-message-buffer'.
- 14. Report: display a temporary message at point defined in the
-     definition section and an automatically generated message in the
-     minibuffer area, see `template-message-timeout'.
-
-If optional WITH-UNDO is non-nil, store corresponding changes in
-`buffer-undo-list'.  If FILE is nil, the buffer for FILE has already
-been created and the accessible part will be replaced by the expanded
-template.  If TEMPLATE is nil (empty input when called interactively),
-do not use a template."
-  (interactive (template-new-file-interactive))
-  ;; check template and file name --------------------------------------------
-  (if template
-      (if (file-readable-p template)
-	  (if (file-directory-p template)
-	      (error "Template %s is a directory" template))
-	(if (null (yes-or-no-p (format "Template %s does not exist.  Create? "
-				       template)))
-	    (error "No template file to use")
-	  (template-make-directory (file-name-directory template))
-	  (template-find-template template)
-	  (error "You should create this template first"))))
-  (if (not file)
-      (switch-to-buffer (current-buffer))
-    (and (or (get-file-buffer file) (file-exists-p file))
-	 (null (yes-or-no-p (format "File %s exists.  Delete contents? " file)))
-	 (error "Cannot use templates for existing files"))
-    (let ((auto-mode-alist nil)
-	  (enable-local-variables nil)
-	  (find-file-not-found-hooks nil)
-	  (enable-local-eval nil))
-      (switch-to-buffer (find-file-noselect file))))
-  (when template
-    (or with-undo (setq buffer-undo-list t))
-    (template-find-template template t)
-    (template-new-file-0 with-undo)))
-
-(defun template-new-file-0 (with-undo)
-  "Perform template replacements in current buffer.
-If WITH-UNDO is non-nil, store corresponding changes in
-`buffer-undo-list'."
-  ;; start replacement -------------------------------------------------------
-  (or with-undo (set-buffer-modified-p nil))
-  (goto-char (point-min))
-  (setq template-secure t
-	template-point nil
-	template-mark nil
-	template-modified nil
-	template-point-messages nil
-	template-before-messages nil
-	template-after-messages nil
-	template-local-alist nil
-	template-register-alist nil
-	template-string-alist nil)
-  (let ((form-selector nil)
-	(pre-command-list nil)
-	(post-command-list nil)
-	(local-variable-list nil)
-	val)
-    ;; read per-template definition section ----------------------------------
-    (goto-char (point-min))
-    (when (re-search-forward
-	   (concat "^[ \t]*" template-definition-start "[ \t]*$") nil t)
-      (condition-case ()
-	  (while t
-	    (setq val (read (current-buffer)))
-	    (cond (;; ("KEY" . xxx): ask user --------------------------------
-		   (and (consp val) (stringp (car val)))
-		   (let* ((def (cdr val)) ; expansion forms
-			  (msg (cond ((null template-message-prompt-format)
-				      nil)
-				     ((stringp def) def)
-				     ((and (consp def) (stringp (car def)))
-				      (car def)))))
-		     (when msg		; list prompts in before-messages
-		       (or template-before-messages
-			   (null template-message-prompt-intro)
-			   (push template-message-prompt-intro
-				 template-before-messages))
-		       (push (format template-message-prompt-format msg)
-			     template-before-messages))
-		     (push (cons (car val) (template-translate-definition def))
-			   template-local-alist)))
-		  ;; :before, :after, :eval-before, :eval-after --------------
-		  ((null val)		; nil is deprecated
-		   (setq form-selector
-			 (cond ((null form-selector) :old-before)
-			       ((eq form-selector :old-before) :old-after)
-			       ((eq form-selector :old-after)
-				(error "More than two (obsolete) nil forms"))
-			       (t
-				(error "Used obsolete nil form with new form selectors")))))
-		  ((memq val '(:before :after :eval-before :eval-after))
-		   (setq form-selector val))
-		  ;; "MESSAGE" -----------------------------------------------
-		  ((stringp val)
-		   (cond ((eq form-selector :before)
-			  (push val template-before-messages))
-			 ((eq form-selector :after)
-			  (push val template-after-messages))
-			 (t
-			  (push val template-point-messages))))
-		  ;; (CHAR . xxx): set register ------------------------------
-		  ((and (consp val) (template-char-or-char-int-p (car val)))
-		   (let ((reg (template-char-or-int-to-char (car val))))
-		     (if (atom (cdr val))
-			 (set-register reg (cdr val))
-		       (set-register reg (cadr val))
-		       (when template-message-register-format
-			 (let ((msg (format template-message-register-format
-					    reg (cadr val)
-					    (or (caddr val) ""))))
-			   (if template-message-buffer
-			       (progn
-				 (if template-before-messages
-				     (push msg template-before-messages))
-				 (or template-after-messages
-				     (null template-message-register-intro)
-				     (push template-message-register-intro
-					   template-after-messages))
-				 (push msg template-after-messages))
-			     (push msg template-point-messages)))))))
-		  ;; set var, execute command and sexpr ----------------------
-		  ((and (memq form-selector '(nil :before :after))
-			(consp val)
-			(symbolp (car val)))
-		   (or (and (functionp (get (car val) 'template-secure-value))
-			    (funcall (get (car val) 'template-secure-value)
-				     (cdr val)))
-		       (setq template-secure nil))
-		   (push val local-variable-list))
-		  ((memq form-selector '(:eval-before :old-before))
-		   (push (template-elisp-in-definition val)
-			 pre-command-list))
-		  ((memq form-selector '(:eval-after :old-after))
-		   (push (template-elisp-in-definition val)
-			 post-command-list))
-		  (t
-		   (error "Illegal form"))))
-	(error nil))
-      (skip-chars-forward " \t\n\f")
-      (or (eobp)
-	  (error "Invalid definition in line %d (pos %d) of the template file"
-		 (count-lines 1 (point)) (point)))
-      (or template-secure
-	  (null (default-value template-confirm-insecure))
-	  (y-or-n-p "Have you checked the template functions? ")
-	  (error "Failed security check"))
-      (delete-region (match-beginning 0) (point-max)))
-    ;; expand ----------------------------------------------------------------
-    (template-display-messages template-before-messages)
-    (eval (cons 'progn (nreverse pre-command-list)))
-    (while local-variable-list
-      (make-local-variable (caar local-variable-list))
-      (set (caar local-variable-list) (cdar local-variable-list))
-      (setq local-variable-list (cdr local-variable-list)))
-    (goto-char (point-min))
-    (while (re-search-forward template-expansion-regexp nil t)
-      (setq template-current (buffer-substring (match-beginning 1)
-					       (match-end 1))
-	    val (assoc template-current template-local-alist))
-      (unless val
-	(if (setq val (assoc template-current template-key-alias-alist))
-	    (setq template-current (cdr val)))
-	(setq val (or (assoc template-current template-expansion-alist)
-		      (assoc template-current
-			     template-default-expansion-alist))))
-      (delete-region (match-beginning 0) (match-end 0))
-      (cond (val
-	     (eval (cons 'progn (cdr val))))
-	    ((string-match template-register-regexp template-current)
-	     (template-register))
-	    (t
-	     (template-read (format "Replacement for `%s': "
-				    template-current)))))
-    (eval (cons 'progn (nreverse post-command-list)))
-    (save-restriction
-      (widen)
-      (normal-mode t)
-      (or with-undo (template-update-header 'if-exists))
-      (run-hooks 'find-file-hooks))
-    ;; message ---------------------------------------------------------------
-    (template-display-messages template-after-messages)
-    (cond ((null template-register-alist)
-	   (message "%s, no buffer location in register"
-		    (if template-mark "Mark set" "No mark")))
-	  (t (message "%s, buffer location in register: %s"
-		      (if template-mark "Mark set" "No mark")
-		      (mapconcat (function
-				  (lambda (x)
-				    (if (cdr x)
-					(concat (char-to-string (car x)) "*")
-				      (char-to-string (car x)))))
-				 (nreverse template-register-alist)
-				 ", "))))
-    (or with-undo (set-buffer-modified-p template-modified))
-    (goto-char (point-min))
-    (when template-point
-      (goto-char template-point)
-      (set-marker template-point nil))
-    (when template-mark
-      (push-mark template-mark)
-      (set-marker template-mark nil)
-      (if (fboundp 'zmacs-activate-region) (zmacs-activate-region)))
-    (when (and template-point-messages
-	       (or (cdr template-point-messages)
-		   (not (string-equal (car template-point-messages) ""))))
-      (let ((beg (point))
-	    end)
-	(if (cdr template-point-messages)
-	    (insert (mapconcat 'identity
-			       (nreverse template-point-messages)
-			       "\n")
-		    "\n")
-	  (insert (car template-point-messages)))
-	(setq end (point))
-	(goto-char beg)
-	(and (fboundp 'make-extent) (fboundp 'set-extent-face)
-	     (set-extent-face (make-extent beg end) 'template-message-face))
-	(recenter)
-	(sit-for template-message-timeout)
-	(delete-region beg end))))
-  (recenter)
-  (unless with-undo
-    (setq buffer-undo-list nil)
-    (set-buffer-modified-p template-modified)))
-
-(defun template-display-messages (messages)
-  (when (and messages template-message-buffer)
-    (setq messages (nreverse messages))
-    (with-output-to-temp-buffer template-message-buffer
-      (while messages
-	(princ (pop messages))
-	(if messages (princ "\n"))))))
-
-
-;;;===========================================================================
-;;;  Determine name of the new file and the template
-;;;===========================================================================
-
-(defun template-derivation (full arg &optional no-default)
-  "Derive template file name and do file name refinement.
-Return (REFINED . TEMPLATE) where REFINED is the refined version of FULL
-and TEMPLATE and template file name, see `template-derivation-alist'.
-FULL is the initial file name given by the user.  File name refinement
-is turned off when ARG is non-nil.  If optional argument NO-DEFAULT is
-non-nil, return nil instead (FULL \. \"~/.templates/DEFAULT.tpl\") if no
-matching entry can be found in `template-derivation-alist'."
-  ;; Get all templates -------------------------------------------------------
-  (setq template-all-templates nil)
-  (let* ((dir (file-name-directory full))
-	 (len (length dir))
-	 (case-fold-search (memq system-type '(vax-vms ms-dos windows-nt))))
-    (while (and dir
-		(not (and template-stop-derivation
-			  (fboundp template-stop-derivation)
-			  (funcall template-stop-derivation dir))))
-      (template-all-templates template-subdirectories dir)
-      (setq dir (file-name-directory (directory-file-name dir)))
-      (or (> len (setq len (length dir)))
-	  (setq dir nil)))
-    (template-all-templates template-default-directories)
-    (setq template-all-templates (nreverse template-all-templates)))
-  ;; Get template file -------------------------------------------------------
-  (if (string= (file-name-nondirectory full) "")
-      (error "You cannot use templates for directories"))
-  (setq template-file (template-split-filename full))
-  (let ((tests template-derivation-alist)
-	test template file)
-    (while tests
-      (setq test (caar tests)
-	    file (cdar tests))
-      (if (setq template
-		(if (functionp (car test))
-		    (apply (car test) (cdr test))
-		  (apply 'template-default-template test)))
-	  (setq tests nil)
-	(setq tests (cdr tests))))
-    (if template
-	(or arg
-	    (if (functionp (car file))
-		(apply (car file) template (cdr file))
-	      (apply 'template-unique-file template file)))
-      (or no-default
-	  (setq template (template-split-filename
-			  "DEFAULT"
-			  (template-default-directory)))))
-    (if template
-	(cons (expand-file-name (cadr template-file) (car template-file))
-	      (expand-file-name (concat (cadr template) template-extension)
-				(car template))))))
-
-(defun template-default-directory ()
-  "Return directory of file \"DEFAULT.tpl\"."
-  (let ((dirs template-default-directories)
-	(name (concat "DEFAULT" template-extension))
-	dir)
-    (while dirs
-      (setq dir (pop dirs))
-      (if (file-readable-p (expand-file-name name dir))
-	  (setq dirs nil)
-	(setq dir nil)))
-    (or dir
-	(car template-default-directories)
-	(expand-file-name "~/.templates/"))))
-
-
-;;;===========================================================================
-;;;  Small functions
-;;;===========================================================================
-
-(defun template-make-directory (dir)
-  "Create DIR if it does not exists yet."
-  (cond ((file-exists-p dir))
-	((yes-or-no-p (format "The directory %s does not exist.  Create? " dir))
-	 (make-directory dir t))
-	(t (error "You should create a directory \"%s\"" dir)))
-  dir)
-
-(defun template-split-filename (file &optional dir)
-  "Split file name into its parts.
-If DIR is nil, FILE is a fully expanded file name, otherwise FILE is a
-file name without its directory part DIR.  See `template-file'."
-  (or dir (setq dir (template-make-directory (file-name-directory file))
-		file (file-name-nondirectory file)))
-  (let* ((ext (string-match "\\.[^.]*\\'" file))
-	 (raw (substring file 0 ext))
-	 (num (string-match "[^0-9][0-9]+\\'" raw)))
-    (if num
-	(list dir file
-	      (substring raw 0 (1+ num))
-	      (substring raw (1+ num))
-	      (if ext (substring file ext) ""))
-      (list dir file raw "" (if ext (substring file ext) "")))))
-
-(defun template-translate-definition (def)
-  "Translate DEF of expansion and set `template-secure' accordingly."
-  (cond ((null def) ; zero form
-	 nil)
-	((template-char-or-char-int-p def)
-	 `((template-register ,def)))
-	((stringp def)
-	 `((template-read ,def nil nil nil t)))
-	((symbolp def)
-	 `((insert (if (stringp ,def) ,def template-string-default))))
-	((and (consp def) (stringp (car def)))
-	 (if (consp (car-safe (cdr def)))
-	     `((template-choice ,(car def) (quote ,(cdr def))))
-	   `((apply (quote template-read) (quote ,def)))))
-	((consp (car-safe def))
-	 (setq template-secure nil)
-	 def)
-	(t
-	 (list (template-elisp-in-definition (car def) (cdr def))))))
-
-(defun template-elisp-in-definition (def &optional prefix)
-  "Return valid elisp definition and set `template-secure' accordingly.
-DEF is the elisp form, PREFIX would be the prefix argument if DEF is a
-command."
-  (cond ((consp def)
-	 (setq template-secure nil)
-	 def)
-	((or (symbolp def) (vectorp def))
-	 (or (and (symbolp def) (get def 'template-secure-command))
-	     (setq template-secure nil))
-	 (if (and (symbolp def)
-		  (functionp (get def 'template-secure-command))
-		  (listp prefix)
-		  (funcall (get def 'template-secure-command) prefix))
-	     `(apply (quote ,def) (quote ,prefix))
-	   `(progn (setq prefix-arg (quote ,prefix))
-		   (command-execute (quote ,def)))))
-	(t
-	 (error "Illegal form"))))
-
-
-;;;===========================================================================
-;;;  Compute template name
-;;;===========================================================================
-
-(defun template-all-templates (dirs &optional base)
-  "Read names of template files in DIRS relatively to BASE.
-Insert the names to internal variable `template-all-templates'."
-  (let ((regexp (concat (regexp-quote template-extension) "\\'"))
-	(endpos (- (length template-extension)))
-	dir templates)
-    (while dirs
-      (setq dir (expand-file-name (car dirs) base)
-	    dirs (cdr dirs))
-      (cond-emacs-xemacs
-       (and (file-accessible-directory-p dir)
-	    (file-readable-p dir)
-	    (setq templates (directory-files dir t regexp :XEMACS nil t))
-	    (while templates
-	      (and :EMACS
-		   (not (file-directory-p (car templates)))
-		   :BOTH
-		   (file-readable-p (car templates))
-		   (push (template-split-filename (substring (car templates)
-							     0
-							     endpos))
-			 template-all-templates))
-	      (setq templates (cdr templates))))))))
-
-(defun template-set-template-part (part file-part)
-  "Set template part according to definition PART and FILE-PART.
-See `template-derivation-alist' for details."
-  (when part
-    (cond ((stringp part) part)
-	  ((eq part t) file-part)
-	  ((null (string= file-part "")) file-part))))
-
-(defun template-default-template (&optional raw num ext regexp)
-  "Return template according to RAW, NUM, EXT and REGEXP.
-See `template-derivation-alist' for details."
-  (if (or (null regexp) (string-match regexp (cadr template-file)))
-      (let ((templates template-all-templates)
-	    (file-rne (cddr template-file))
-	    result template-rne)
-	(setq raw (template-set-template-part raw (car file-rne))
-	      num (template-set-template-part num (cadr file-rne))
-	      ext (template-set-template-part ext (caddr file-rne)))
-	(while templates
-	  (setq template-rne (cddar templates))
-	  (if (and (or (null raw) (string= (car template-rne) raw))
-		   (or (null num) (string= (cadr template-rne) num))
-		   (or (null ext) (string= (caddr template-rne) ext)))
-	      (setq result (car templates)
-		    templates nil)
-	    (setq templates (cdr templates))))
-	result)))
-
-
-;;;===========================================================================
-;;;  File name refinement
-;;;===========================================================================
-
-(defun template-default-file (template &optional raw num ext)
-  "Refine file name according to TEMPLATE, RAW, NUM and EXT.
-The result is in `template-file'.  See `template-derivation-alist'."
-  (let ((template-rne (cddr template))
-	(file-rne (cddr template-file)))
-    (if raw
-	(if (eq raw t) (setq raw (car template-rne)))
-      (setq raw (car file-rne)))
-    (if num
-	(if (eq num t) (setq num (cadr template-rne)))
-      (setq num (cadr file-rne)))
-    (if ext
-	(if (eq ext t) (setq ext (caddr template-rne)))
-      (setq ext (caddr file-rne)))
-    (setcdr template-file (list (concat raw num ext) raw num ext))))
-
-(defunx template-unique-file (template &optional raw num ext auto-num)
-  "Refine file name according to TEMPLATE, RAW, NUM, EXT and AUTO-NUM.
-Use auto numbering if NUM is not \"\" or AUTO-NUM is non-nil.  The
-result is in `template-file'.  See `template-derivation-alist'."
-  (template-default-file template raw num ext)
-  (let* ((dir (car template-file))
-	 (full (expand-file-name (cadr template-file) dir)))
-    (when (if (string= (fourth template-file) "")
-	      auto-num
-	    (setq auto-num
-		  (and (or (get-file-buffer full)
-			   (file-readable-p full))
-		       (string-to-int (fourth template-file)))))
-      (setq auto-num (1- auto-num)
-	    raw (third template-file)
-	    ext (fifth template-file))
-      (let ((list (buffer-list))
-	    file1 dir1)
-	(while list
-	  (and (setq file1 (buffer-file-name (car list)))
-	       (setq dir1 (file-name-directory file1))
-	       (string= dir1 dir)
-	       (setq auto-num
-		     (max (template-filename-number
-			   (cddr (template-split-filename
-				  (file-name-nondirectory file1)
-				  dir1))
-			   raw ext)
-			  auto-num)))
-	  (setq list (cdr list)))
-	(setq list (directory-files dir nil nil t :XEMACS t))
-	(while list
-	  (unless (:EMACS file-directory-p (car list))
-	    (setq auto-num
-		  (max (template-filename-number
-			(cddr (template-split-filename (car list) dir))
-			raw ext)
-		       auto-num)
-		  list (cdr list))))
-	(template-default-file template raw
-			       (int-to-string (1+ auto-num))
-			       ext)))))
-
-(defun template-filename-number (file-rne raw ext)
-  "Return numbering in FILE-RNE if the RAW and EXT parts are equal."
-  (or (and (string= (car file-rne) raw)
-	   (string= (caddr file-rne) ext)
-	   (string-to-int (cadr file-rne)))
-      0))
-
-
-;;;===========================================================================
-;;;  Safe commands for per-template expansions
-;;;===========================================================================
-
-(defun template-insert-time (&optional format default)
-  "Insert time into current buffer using time format FORMAT.
-If FORMAT is not a string, it uses DEFAULT or `current-time-string'."
-  (interactive)
-  (insert (if (and (stringp format) (fboundp 'format-time-string))
-	      (format-time-string format (current-time))
-	    (or default (current-time-string)))))
-(put 'template-insert-time 'template-secure-command
-     (lambda (args)
-       (or (null args) (and (stringp (car args)) (null (cdr args))))))
-
-
-;;;===========================================================================
-;;;  Functions for the predefined expansions
-;;;===========================================================================
-
-(defun template-register (&optional register)
-  "Set current location in register REGISTER.
-That is, \\[jump-to-register] REGISTER jumps to the current position.
-If REGISTER is nil, use register corresponding to the last character in
-`template-current'."
-  (let* ((char (if register
-		   (template-char-or-int-to-char register)
-		 (aref template-current (1- (length template-current)))))
-	 (elem (assoc char template-register-alist)))
-    (point-to-register char)
-    (if elem
-	(setcdr elem t)
-      (push (list char) template-register-alist))))
-
-(defun template-read (prompt &optional prefix suffix default again-p)
-  "Ask user with PROMPT for a STRING to be inserted.
-If STRING is not \"\", insert PREFIX STRING SUFFIX, otherwise DEFAULT.
-If AGAIN-P is nil, do not ask if `template-current' appears another time
-as key in a expansion form.  If AGAIN-P is `expand', the inserted region
-is searched for expansion forms where STRING is marked as a literal
-environment, see `template-literal-environment'."
-  (setq template-modified t)
-  (let ((pos (point))
-	(elem (and (null again-p)
-		   (assoc template-current template-string-alist))))
-    (if elem
-	(setq elem (cdr elem))
-      (setq elem (read-from-minibuffer prompt nil nil nil
-				       'template-history)
-	    elem (cond ((string= elem "") (or default ""))
-		       ((eq again-p 'expand)
-			(concat prefix
-				(format template-expansion-format
-					(car template-literal-environment))
-				elem
-				(format template-expansion-format
-					(cdr template-literal-environment))
-				suffix
-				(format template-expansion-format
-					(car template-literal-environment))
-				(format template-expansion-format
-					(cdr template-literal-environment))))
-		       (t
-			(concat prefix elem suffix))))
-      (or again-p (push (cons template-current elem) template-string-alist)))
-    (insert elem)
-    (if (eq again-p 'expand) (goto-char pos))))
-
-(defun template-choice (prompt table)
-  "Ask user with PROMPT for a choice and insert it.
-Each element in TABLE looks like (ANSWER . TEXT).  Ask for an input with
-completion over all ANSWERs and insert corresponding TEXT if ANSWER is a
-string, otherwise ask a \"y or n\" question and use the result of
-`y-or-n-p' as ANSWER.  Expansion forms in TEXT will be expanded."
-  (setq template-modified t)
-  (let ((pos (point)))
-    (insert (or (cdr (assoc (if (stringp (caar table))
-				(completing-read prompt table nil t nil
-						 'template-choice-history)
-			      (y-or-n-p prompt))
-			    table))
-		"")
-	    (format template-expansion-format
-		    (car template-literal-environment))
-	    (format template-expansion-format
-		    (cdr template-literal-environment)))
-    (goto-char pos)))
-
-
-;;;===========================================================================
-;;;  Menu filter
-;;;===========================================================================
-
-(defun template-menu-filter (menu-items)
-  ;; checkdoc-params: (menu-items)
-  "Menu filter for `template-creation-menu'."
-  (let ((alist (append template-expansion-alist
-		       template-default-expansion-alist))
-	menu used key)
-    (while alist
-      (unless (member (setq key (car (pop alist))) used)
-	(push key used)
-	(push (vector (concat "Insert " key)
-		      (list 'template-insert-form current-prefix-arg key)
-		      t)
-	      menu)))
-    (append menu-items (nreverse menu))))
-
-
-;;;===========================================================================
-;;;  Insert and define forms
-;;;===========================================================================
-
-(defun template-buffer-template-p ()
-  "Return non-nil, if current buffer is likely to be a template file."
-  (and buffer-file-name
-       (string-match (concat (regexp-quote template-extension) "\\'")
-		     (file-name-sans-versions buffer-file-name))))
-
-(defun template-open-template ()
-  "If current buffer is no template file, open a new one."
-  (interactive)
-  (if (template-buffer-template-p)
-      (barf-if-buffer-read-only)
-    (let (name
-	  (dir (and (car template-subdirectories)
-		    (expand-file-name (car template-subdirectories)))))
-      (if (null buffer-file-name)
-	  (setq name (concat "TEMPLATE" template-extension))
-	(setq name (file-name-sans-versions
-		    (file-name-nondirectory buffer-file-name)))
-	(if (string-match ".\\.[^.]*\\'" name)
-	    (setq name (concat "TEMPLATE"
-			       (substring name (1+ (match-beginning 0)))
-			       template-extension))
-	  (setq name (concat name template-extension)
-		;; dot file => template not specific for directory
-		dir (car template-default-directories))))
-      (setq name (read-file-name "Open template file (empty=none): "
-				 dir nil nil name))
-      (or (string= name "")
-	  (template-find-template name)))))
-
-(defun template-insert-form (arg key)
-  "Insert an expansion form according to KEY into template.
-When called interactively, allow completion over all keys in
-`template-expansion-alist' and `template-default-expansion-alist'.
-If prefix ARG is nil, run `template-open-template' first."
-  (interactive
-   (list current-prefix-arg
-	 (completing-read "Insert key (0-9 for register position): "
-			  (append template-expansion-alist
-				  template-default-expansion-alist))))
-  (or arg (template-open-template))
-  (insert (format template-expansion-format key))
-  (if (equal key (car template-literal-environment))
-      (let ((pos (point)))
-	(insert (format template-expansion-format
-			(cdr template-literal-environment)))
-	(goto-char pos))))
-
-(defun template-define-start (arg &rest args)
-  "Insert a definition section and definition into template.
-See `template-definition-start'.  If ARGS is non-nil, pass ARGS to
-`format' for a new definition.  If prefix ARG is nil, run
-`template-open-template' first."
-  (interactive "P")
-  (or arg (template-open-template))
-  (save-excursion
-    (goto-char (point-min))
-    (unless (re-search-forward (concat "^[ \t]*"
-				       template-definition-start
-				       "[ \t]*$") nil t)
-      (goto-char (point-max))
-      (or (bolp) (insert "\n"))
-      (insert template-definition-start))
-    (goto-char (point-max))
-    (or (bolp) (insert "\n"))
-    (if args (insert (apply 'format args) "\n")))
-  (message "Put definition at the end of the template"))
-
-(defun template-define-message (arg message)
-  "Insert a temporary message MESSAGE definition into template.
-For ARG, see `template-define-start'."
-  (interactive "P\nsTemporary message: ")
-  (template-define-start arg "%S" message))
-
-(defun template-define-prompt (arg key prompt &optional prefix suffix default)
-  "Insert a definition for KEY as PROMPT into template.
-For ARG, see `template-define-start'."
-  (interactive "P\nsExpansion key: \nsExpansion prompt: \nsPrefix for non-empty input: \nsSuffix for non-empty input: \nsDefault for empty input: ")
-  (template-define-start arg "(%S %S %S %S %S)"
-			 key prompt prefix suffix default))
-
-(defun template-define-register (arg register)
-  "Insert a setting of REGISTER into template.
-For ARG, see `template-define-start'."
-  (interactive "P\ncDefine register: ")
-  (let* ((old (get-register register))
-	 (contents (read-from-minibuffer "Register contents: "
-				    (and (stringp old)
-					 (not (string-match "\n" old))
-					 old)))
-	 (comment (read-from-minibuffer "Comment (empty=none): ")))
-    (if (string= comment "")
-	(template-define-start arg "(%S %S)" register contents)
-      (template-define-start arg "(%S %S %S)" register contents comment))))
-  
-
-;;;===========================================================================
-;;;  Initialization
-;;;===========================================================================
-
-;; easymenu.el is for top-level menus only...
-(defunx template-add-submenu (menu &optional where)
-  "Add the submenu MENU to the end of a menu in WHERE in the menubar.
-WHERE is a list of menus tried to add MENU to.  If no such menu exist,
-no menu is added.  When using Emacs, always add to the \"Edit\" menu.
-See `easy-menu-define' for the format of MENU."
-  (and menu
-       :EMACS
-       (>= emacs-major-version 21)
-       (boundp 'menu-bar-edit-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-after menu-bar-edit-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) path)
-	 (while where
-	   (setq path (list (pop where)))
-	   (if (find-menu-item default-menubar path)
-	       (setq where nil)
-	     (setq path nil)))
-	 (when path (add-submenu path menu)))))
-
-;;;###autoload
-(defunx template-initialize (&rest dummies)
-  ;; checkdoc-params: (dummies)
-  "Initialized package template.  See variable `template-initialize'."
-  (interactive)
-  (setq template-use-package t)
-  (let ((regexp (concat (regexp-quote template-extension) "\\'")))
-    (or (assoc regexp auto-mode-alist)
-	(push (list regexp nil 'template-new-file) auto-mode-alist)))
-  (when (or (eq template-initialize t)
-	    (memq 'cc-mode template-initialize))
-    (add-hook 'c-mode-common-hook 'template-c-init-fill-function)
-    (add-hook 'antlr-mode-hook 'template-c-init-fill-function))
-  (when (or (eq template-initialize t)
-	    (memq 'de-html-helper template-initialize))
-    (setq html-helper-build-new-buffer nil)
-    (setq html-helper-do-write-file-hooks nil))
-  (when (or (eq template-initialize t)
-	    (memq 'keys template-initialize))
-    (condition-case nil			; older Emacses don't understand all
-	(progn
-	  (define-key ctl-x-map "t" 'template-new-file)
-	  (define-key ctl-x-map [(control =)] 'template-single-comment)
-	  (define-key ctl-x-map [(control ?\;)] 'template-block-comment))
-      (error nil)))
-  (when (or (eq template-initialize t)
-	    (memq 'menus template-initialize))
-    (template-add-submenu template-comment-menu :XEMACS '("Edit"))
-    (template-add-submenu template-creation-menu :XEMACS '("Cmds" "Edit"))
-    :EMACS
-    (and (boundp 'menu-bar-files-menu)
-	 (define-key-after menu-bar-files-menu [template-new-file]
-	   '(menu-item "New File Using Template..." template-new-file
-		       :enable (not (window-minibuffer-p
-				     (frame-selected-window
-				      menu-updating-frame)))
-		       :help "Create a new file, using a template")
-	   'dired))
-    :XEMACS
-    (and (featurep 'menubar)
-	 (find-menu-item default-menubar '("File"))
-	 (let ((current-menubar default-menubar))
-	   ;; XEmacs-20.4 `add-submenu' does not have 4th arg IN-MENU
-	   (add-menu-button '("File")
-			    ["New File Using Template..." template-new-file
-			     :active t]
-			    "Insert File..."))))
-    (if (and (boundp 'init-file-loaded) init-file-loaded)
-      ;; doesn't exist in Emacs
-      (template-after-init)
-    (add-hook 'after-init-hook 'template-after-init t)))
-
-(defun template-after-init ()
-  "Late initialization for package template.
-See function and variable `template-initialize'."
-  (when (or (eq template-initialize t)
-	    (memq 'auto template-initialize))
-    (add-hook 'write-file-hooks 'template-update-buffer)
-    (add-hook 'find-file-not-found-hooks 'template-not-found-function t))
-  (when (or (eq template-initialize t)
-	    (memq 'ffap template-initialize))
-    (or template-ffap-file-finder
-	(setq template-ffap-file-finder
-	      (if (boundp 'ffap-file-finder)
-		  ffap-file-finder
-		(or (get 'ffap-file-finder 'saved-value) 'find-file))))
-    (setq ffap-file-finder 'template-ffap-find-file)))
-
-;;; Local IspellPersDict: .ispell_template
-;;; template.el ends here
diff --git a/xemacs-packages/lisp/texinfo/ChangeLog b/xemacs-packages/lisp/texinfo/ChangeLog
deleted file mode 100644
index bf902afc..00000000
--- a/xemacs-packages/lisp/texinfo/ChangeLog
+++ /dev/null
@@ -1,450 +0,0 @@
-2005-09-26  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.30 released.
-
-2005-09-25  Adrian Aichner  <adrian@xemacs.org>
-
-	* texinfmt.el: Minor sync with GNU Emacs texinfmt-version "2.41 of
-	1 Mar 2005".
-	* texinfmt.el (texinfmt-version): New.
-	* texinfmt.el (texinfo-format-buffer): Restore use of
-	coding-system-for-write (sync)
-	* texinfmt.el (texinfo-pre-format-hook): New.
-	* texinfmt.el (texinfo-format-region): Run texinfo-pre-format-hook
-	(sync).
-	* texinfmt.el (texinfo-format-buffer-1): Use buffer-disable-undo
-	(sync).
-	* texinfmt.el (texinfo-append-refill): Generalize refill regexp
-	(sync).
-	* texinfmt.el (texinfo-paragraphindent): Use string-to-number (sync).
-	* texinfmt.el (texinfo-format-printindex): My genuine fix for
-	Message-ID: <9ea6aaa80503091939552b5e23@mail.gmail.com>.
-	* texinfmt.el (texinfo-print-index): Adjust index entry format (sync).
-	* texinfo.el: Minor sync with GNU Emacs.
-	* texinfo.el (texinfo): Typo fix sync.
-	* texinfo.el (texinfo-mode-hook): New.  Not used yet.
-	* texinfo.el (texinfo-imenu-generic-expression): Typo fix sync.
-	* texinfo.el (texinfo-environments): Ditto.
-	* texinfo.el (texinfo-environment-regexp): Ditto.
-	* texinfo.el (texinfo-font-lock-keywords): Ditto.
-	* texinfo.el (texinfo-insert-quote): Ditto.
-	* texinfo.el (texinfo-show-structure): Ditto.
-
-2005-03-26  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.29 released.
-
-2005-02-23  Katsumi Yamaoka  <yamaoka@jpl.org>
-
-	* texinfmt.el (texinfo-format-scan):  Silence whitespace-cleanup.
-	* texnfo-upd.el (texinfo-copy-node-name): Use point-at-eol instead 
-        of line-end-position. 
-
-2004-12-22  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.28 released.
-
-2004-12-08  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.27 released.
-
-	* texinfmt.el (texinfo-format-region):
-	* texinfmt.el (texinfo-format-buffer-1):
-	* texinfmt.el (texinfo-sort-startkeyfun):
-	line-(beginning|end)-position -> point-at-(b|e)ol.  The former are
-	not known in 21.4.
-
-2004-12-07  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.26 released.
-
-2004-12-07  Ben Wing  <ben@xemacs.org>
-
-	* texinfmt.el:
-	* texinfmt.el (fboundp):
-	* texinfmt.el (match-string-no-properties): New.
-	Add defn of match-string-no-properties, not in 21.4.
-
-2004-12-06  Ben Wing  <ben@xemacs.org>
-
-	* Makefile:
-	Depends on text-modes.
-	
-	* texinfmt.el (whitespace):
-	Require 'whitespace to fix compilation.
-
-2004-11-07  Ben Wing  <ben@xemacs.org>
-
-	* Makefile (ELCS):
-	Compile texinfo earlier due to dependencies.
-	
-	* informat.el:
-	* informat.el (Info-tagify):
-	* informat.el (Info-validate):
-	* informat.el (batch-info-validate):
-	* texinfmt.el:
-	* texinfmt.el (texinfmt-version):
-	* texinfmt.el (texinfo-format-buffer):
-	* texinfmt.el (tex-start-of-header)): New.
-	* texinfmt.el (tex-end-of-header)): New.
-	* texinfmt.el (texinfo-format-region):
-	* texinfmt.el (texinfo-format-buffer-1):
-	* texinfmt.el (texinfo-format-convert):
-	* texinfmt.el (texinfo-no-refill-regexp):
-	* texinfmt.el (texinfo-append-refill):
-	* texinfmt.el (texinfo-raise-lower-sections):
-	* texinfmt.el (texinfo-raisesections-alist):
-	* texinfmt.el (texinfo-lowersections-alist):
-	* texinfmt.el (texinfo-format-scan):
-	* texinfmt.el (texinfo-copying-text): New.
-	* texinfmt.el (texinfo-copying): New.
-	* texinfmt.el (texinfo-insertcopying): New.
-	* texinfmt.el (texinfo-parse-line-arg):
-	* texinfmt.el (texinfo-parse-expanded-arg):
-	* texinfmt.el (texinfo-format-parse-line-args):
-	* texinfmt.el (texinfo-format-parse-args):
-	* texinfmt.el (texinfo-format-parse-defun-args):
-	* texinfmt.el (texinfo-discard-line):
-	* texinfmt.el (texinfo-anchor):
-	* texinfmt.el (texinfo-format-xref):
-	* texinfmt.el (texinfo-format-uref):
-	* texinfmt.el (texinfo-format-documentdescription): New.
-	* texinfmt.el (texinfo-footnote-style):
-	* texinfmt.el (texinfo-format-separate-node):
-	* texinfmt.el (texinfo-enumerate):
-	* texinfmt.el (texinfo-enumerate-item):
-	* texinfmt.el (texinfo-alphaenumerate-item):
-	* texinfmt.el (texinfo-capsenumerate-item):
-	* texinfmt.el (texinfo-table):
-	* texinfmt.el (texinfo-multitable-widths):
-	* texinfmt.el (texinfo-multitable-extract-row):
-	* texinfmt.el (texinfo-multitable-item):
-	* texinfmt.el (texinfo-format-iftex):
-	* texinfmt.el (texinfo-format-ifhtml):
-	* texinfmt.el (texinfo-format-image): New.
-	* texinfmt.el (texinfo-format-ifplaintext): New.
-	* texinfmt.el (texinfo-format-ifxml): New.
-	* texinfmt.el (texinfo-format-tex):
-	* texinfmt.el (texinfo-format-html):
-	* texinfmt.el (texinfo-format-xml): New.
-	* texinfmt.el (ifnotplaintext):
-	* texinfmt.el (texinfo-format-ifnotinfo): New.
-	* texinfmt.el (ifnothtml):
-	* texinfmt.el (texinfo-format-titlepage):
-	* texinfmt.el (texinfo-format-titlespec):
-	* texinfmt.el (texinfo-format-ignore):
-	* texinfmt.el (texinfo-alias):
-	* texinfmt.el (email):
-	* texinfmt.el (texinfo-format-email): New.
-	* texinfmt.el (texinfo-format-verb): New.
-	* texinfmt.el (texinfo-format-kbd-regexp):
-	* texinfmt.el (texinfo-format-kbd-end-regexp):
-	* texinfmt.el (texinfo-format-kbd):
-	* texinfmt.el (texinfo-format-dircategory):
-	* texinfmt.el (texinfo-do-flushright):
-	* texinfmt.el (texinfo-format-refill):
-	* texinfmt.el (texinfo-noindent):
-	* texinfmt.el (texinfo-format-defindex):
-	* texinfmt.el (texinfo-sort-region):
-	* texinfmt.el (texinfo-sort-startkeyfun):
-	* texinfmt.el (texinfo-format-deftypefn):
-	* texinfmt.el (texinfo-format-deftypefun):
-	* texinfmt.el (texinfo-format-defop):
-	* texinfmt.el (texinfo-format-defcv):
-	* texinfmt.el (texinfo-format-defmethod):
-	* texinfmt.el (texinfo-index-defun):
-	* texinfmt.el (texinfo-index-deffn):
-	* texinfmt.el (texinfo-index-deftypefn):
-	* texinfmt.el (texinfo-index-defmethod):
-	* texinfmt.el (texinfo-index-defop):
-	* texinfmt.el (texinfo-index-defivar):
-	* texinfmt.el (texinfo-index-defcv):
-	* texinfmt.el (texinfo-set):
-	* texinfmt.el (texinfo-value):
-	* texinfmt.el (texinfo-if-set):
-	* texinfmt.el (texinfo-if-clear):
-	* texinfmt.el (texinfo-format-ifeq):
-	* texinfmt.el (afourpaper):
-	* texinfmt.el (documentlanguage):
-	* texinfmt.el (texinfo-unsupported):
-	* texinfmt.el (batch-texinfo-format):
-	* texinfo.el:
-	* texinfo.el (require):
-	* texinfo.el (texinfo-open-quote): New.
-	* texinfo.el (texinfo-version): Removed.
-	* texinfo.el (texinfo-close-quote): New.
-	* texinfo.el (texinfo-update-node):
-	* texinfo.el (texinfo-section-list): New.
-	* texinfo.el (texinfo-mode-syntax-table):
-	* texinfo.el (texinfo-imenu-generic-expression):
-	* texinfo.el (texinfo-font-lock-syntactic-keywords): New.
-	* texinfo.el (texinfo-environments): New.
-	* texinfo.el (texinfo-environment-regexp): New.
-	* texinfo.el (texinfo-heading-face): New.
-	* texinfo.el (texinfo-clone-environment): New.
-	* texinfo.el (texinfo-mode-map):
-	* texinfo.el (texinfo-mode-menu):
-	* texinfo.el (texinfo-filter): New.
-	* texinfo.el (texinfo-chapter-level-regexp):
-	* texinfo.el (texinfo-mode):
-	* texinfo.el (texinfo-block-default): New.
-	* texinfo.el (texinfo-insert-block): New.
-	* texinfo.el (texinfo-inside-macro-p): New.
-	* texinfo.el (texinfo-inside-env-p): New.
-	* texinfo.el (texinfo-insert-quote): New.
-	* texinfo.el (texinfo-last-unended-begin): New.
-	* texinfo.el (texinfo-next-unmatched-end): New.
-	* texinfo.el (texinfo-insert-@email): New.
-	* texinfo.el (texinfo-insert-@emph): New.
-	* texinfo.el (texinfo-insert-@node):
-	* texinfo.el (texinfo-insert-@quotation): New.
-	* texinfo.el (texinfo-insert-@strong): New.
-	* texinfo.el (texinfo-insert-@uref): New.
-	* texinfo.el ('texinfo-insert-@url): New.
-	* texinfo.el (texinfo-show-structure):
-	* texinfo.el (texinfo-section-types-regexp)): Removed.
-	* texinfo.el (texinfo-section-level-regexp)): Removed.
-	* texinfo.el (texinfo-subsection-level-regexp)): Removed.
-	* texinfo.el (texinfo-subsubsection-level-regexp)): Removed.
-	* texnfo-upd.el:
-	* texnfo-upd.el (texinfo):
-	* texnfo-upd.el (texinfo-section-types-regexp): New.
-	* texnfo-upd.el (texinfo-section-level-regexp): New.
-	* texnfo-upd.el (texinfo-subsection-level-regexp): New.
-	* texnfo-upd.el (texinfo-subsubsection-level-regexp): New.
-	* texnfo-upd.el (texinfo-update-menu-same-level-regexps): New.
-	* texnfo-upd.el (texinfo-update-menu-higher-regexps): New.
-	* texnfo-upd.el (texinfo-update-menu-lower-regexps): New.
-	* texnfo-upd.el (texinfo-make-menu):
-	* texnfo-upd.el (texinfo-make-one-menu):
-	* texnfo-upd.el (texinfo-all-menus-update):
-	* texnfo-upd.el (texinfo-find-lower-level-node):
-	* texnfo-upd.el (texinfo-find-higher-level-node):
-	* texnfo-upd.el (texinfo-make-menu-list):
-	* texnfo-upd.el (texinfo-menu-locate-entry-p):
-	* texnfo-upd.el (texinfo-copy-node-name):
-	* texnfo-upd.el (texinfo-copy-section-title):
-	* texnfo-upd.el (texinfo-old-menu-p):
-	* texnfo-upd.el (texinfo-incorporate-descriptions):
-	* texnfo-upd.el (texinfo-incorporate-menu-entry-names):
-	* texnfo-upd.el (texinfo-menu-copy-old-description):
-	* texnfo-upd.el (texinfo-menu-end):
-	* texnfo-upd.el (texinfo-delete-old-menu):
-	* texnfo-upd.el (texinfo-insert-menu):
-	* texnfo-upd.el (texinfo-start-menu-description):
-	* texnfo-upd.el (texinfo-indent-menu-description):
-	* texnfo-upd.el (texinfo-menu-indent-description):
-	* texnfo-upd.el (texinfo-master-menu):
-	* texnfo-upd.el (texinfo-master-menu-list):
-	* texnfo-upd.el (texinfo-insert-master-menu-list):
-	* texnfo-upd.el (texinfo-copy-menu-title):
-	* texnfo-upd.el (texinfo-copy-menu):
-	* texnfo-upd.el (texinfo-specific-section-type):
-	* texnfo-upd.el (texinfo-hierarchic-level):
-	* texnfo-upd.el (texinfo-update-menu-region-beginning):
-	* texnfo-upd.el (texinfo-update-menu-region-end):
-	* texnfo-upd.el (texinfo-update-node):
-	* texnfo-upd.el (texinfo-section-to-generic-alist): Removed.
-	* texnfo-upd.el (texinfo-chapter-level-regexp): Removed.
-	* texnfo-upd.el (texinfo-every-node-update):
-	* texnfo-upd.el (texinfo-update-the-node):
-	* texnfo-upd.el (texinfo-top-pointer-case):
-	* texnfo-upd.el (texinfo-check-for-node-name):
-	* texnfo-upd.el (texinfo-delete-existing-pointers):
-	* texnfo-upd.el (texinfo-find-pointer):
-	* texnfo-upd.el (texinfo-pointer-name):
-	* texnfo-upd.el (texinfo-sequential-node-update):
-	* texnfo-upd.el (texinfo-sequentially-update-the-node):
-	* texnfo-upd.el (texinfo-sequentially-insert-pointer): New.
-	* texnfo-upd.el (texinfo-sequentially-find-pointer):
-	* texnfo-upd.el (texinfo-insert-node-lines):
-	* texnfo-upd.el (texinfo-multi-file-included-list):
-	* texnfo-upd.el (texinfo-copy-next-section-title):
-	* texnfo-upd.el (texinfo-multi-file-update):
-	* texnfo-upd.el (texinfo-multi-files-insert-main-menu):
-	* texnfo-upd.el (texinfo-multi-file-master-menu-list):
-	* texnfo-upd.el (texinfo-multiple-files-update):
-	Sync with FSF 21.3.
-
-	* texinfo.el (texinfo-insert-@-with-arg):
-	Act on region if active.
-
-2003-10-31  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.25 released.
-
-2003-04-26  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.24 released.
-
-2003-03-22  Vasily Korytov  <deskpot@myrealbox.com>
-
-	* tex-mode.el (tex-mode-hook, tex-shell-hook,
-	plain-tex-mode-hook, latex-mode-hook, slitex-mode-hook): Add
-	(defvar ...), so these variables are documented.
-
-2003-03-09  Ben Wing  <ben@xemacs.org>
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-
-2003-01-13  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.23 released.
-
-2003-01-06  Ville Skyttä  <scop@xemacs.org>
-
-	* texinfo.el: Make auto-mode-alist modifications autoload-only.
-	* tex-mode.el: Ditto.
-
-2002-11-29  Ben Wing  <ben@xemacs.org>
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-12-06  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.22 released.
-
-2002-11-22  TAKAHASHI Kaoru  <kaoru@kaisei.org>
-
-	* texinfmt.el (texinfo-format-separate-node): Use
-	`search-backward' instead of `re-search-backward', for footnote
-	node.
-
-2002-10-15  Ville Skyttä  <scop@xemacs.org>
-
-	* Makefile (srckit): Remove.
-
-2002-10-07  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.21 released.
-
-2002-09-30  Ville Skyttä  <scop@xemacs.org>
-
-	* tex-mode.el: Add autoloaded auto-mode-alist associations.
-	* texinfo.el: Ditto.
-
-2000-03-18  Yoshiki Hayashi  <yoshiki@xemacs.org>
-
-	* texinfmt.el (texinfo-format-refill): Use new paragraph-separate
-	and paragraph-start.
-
-2000-03-01  Yoshiki Hayashi  <yoshiki@xemacs.org>
-
-	* texnfo-upd.el: Synched with FSF 20.6.
-
-2000-01-28  Yoshiki Hayashi  <yoshiki@xemacs.org>
-
-	* texinfmt.el (texinfo-format-uref): Don't parse argument twice.
-
-2000-01-19  Yoshiki Hayashi  <yoshiki@xemacs.org>
-
-	* informat.el: (Info-validate-error-buffer): New variable.
-	Change buffer name.
-	(Info-validate-node-name): Fix Ebola.
-	(Info-file-data): Use non directory part of a file name.
-	(Info-validate): Add two lines of output to make parsing
-	function happy.
-
-1999-12-09  Yoshiki Hayashi  <t90553@mail.ecc.u-tokyo.ac.jp>
-
-	* texinfmt.el: Synched with FSF 20.5.
-	* informat.el: Synched with FSF 20.5.
-
-2000-01-13  Yoshiki Hayashi  <t90553@mail.ecc.u-tokyo.ac.jp>
-
- 	* texinfo.el (texinfo-environment-regexp): Add vtable.
-
-1999-12-24  Yoshiki Hayashi  <t90553@mail.ecc.u-tokyo.ac.jp>
-
-	* texinfo.el: Synch with FSF 20.5.
-	Change TexInfo to Texinfo.
-	(texinfo-environment-revexp): Add more regexp.
-
-1999-11-25  Yoshiki Hayashi  <t90553@mail.ecc.u-tokyo.ac.jp>
-
-	* texinfmt.el: Handle @ifnottex.
-
-1998-07-20  Christoph Wedler  <wedler@fmi.uni-passau.de>
-
-	* tex-mode.el (tex-common-initialization): Use syntax class
-	`escape' for \.  Syntax class `character quote' only works for
-	`forward-sexp' and friends.
-
-1998-07-14  SL Baur  <steve@altair.xemacs.org>
-
-	* texnfo-tex.el: Global search and replace send-string ->
-	process-send-string.
-
-1998-07-01  Adrian Aichner  <aichner@ecf.teradyne.com>
-
-	* texinfmt.el (texinfo-format-region): Removing trailing WS as
-	first step in Info file generation.  No support for makeinfo-like
-	"asis". 
-	(texinfo-format-buffer-1): Ditto.  
-	(texinfo-format-convert): Converting three hyphens to two at end
-	of line too.
-
-	* informat.el (Info-validate): RE-quoting search for "* Menu".
-	Match of "\n\\* Menu;$" ends previous menu and starts new one.
-	Improved matching for : and :: menu items.  Adding support for
-	xrefs crossing line boundaries by using multi-line argument in
-	(Info-extract-menu-node-name STR t).  Reversing lossages before
-	printing.  Adding info file name and line number to lossage
-	information.  Using compilation-minor-mode for lossages buffer.
-	(Info-validate-node-name): Canonicalizing WS in node names to
-	avoid unnecessary lossages.  Upgrading lossages list to provide
-	filename and line number information to support compilation minor
-	mode.  
-	(Info-file-data): New function returning string including file
-	name and line number.
-
-1998-06-10  Adrian Aichner  <aichner@ecf.teradyne.com>
-
-	* texinfmt.el: Added `texinfo-format-uref'.  Matching only files
-	registered for texinfo-mode in auto-mode-alist.  This also fixes
-	infinite recursion of this function when called on directories NB:
-	(directory-files ...) returns "." and ".." as well.  Using
-	(set-syntax-table texinfo-format-syntax-table) in
-	texinfo-multitable-buffer-name so that scan-lists will do that
-	according to the proper syntax.
-
-1998-04-07  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile (srckit): Use TAR/EXCLUDES variables from XEmacs.rules.
-
-1998-03-03  SL Baur  <steve@altair.xemacs.org>
-
-	* texinfmt.el: Synch with FSF Emacs 20.2.
-
-1998-01-24  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile (VERSION): Update to package standard 1.0.
-	* package-info.in: Ditto.
-
-1998-01-12  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile: Update to newer package interface.
-
-1998-01-03  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile: Update to newer package interface.
-
-1997-12-14  Hrvoje Niksic  <hniksic@srce.hr>
-
-	* texnfo-upd.el: Synched with FSF 20.2.
-
-	* texinfo.el: Synched with FSF 20.2.
-
-	* texinfo.el (texinfo-mode-syntax-table): `@' is a
-	symbol-constituent, not an escape.
-
-1997-12-30  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile (ELCS): Add informat.el.
-
-1997-12-24  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile: Created.
diff --git a/xemacs-packages/lisp/texinfo/_pkg.el b/xemacs-packages/lisp/texinfo/_pkg.el
deleted file mode 100644
index 1256c203..00000000
--- a/xemacs-packages/lisp/texinfo/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'texinfo
-		 :version 1.30
-          :author-version "No-Upstream-Ver"
-		 :type 'regular)
diff --git a/xemacs-packages/lisp/texinfo/auto-autoloads.el b/xemacs-packages/lisp/texinfo/auto-autoloads.el
deleted file mode 100644
index 196b2901..00000000
--- a/xemacs-packages/lisp/texinfo/auto-autoloads.el
+++ /dev/null
@@ -1,186 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'texinfo-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "texinfo/_pkg.el")
-
-(package-provide 'texinfo :version 1.3 :author-version "No-Upstream-Ver" :type 'regular)
-
-;;;***
-
-;;;### (autoloads (batch-info-validate Info-validate Info-split Info-tagify) "informat" "texinfo/informat.el")
-
-(autoload 'Info-tagify "informat" "\
-Create or update Info file tag table in current buffer or in a region." t nil)
-
-(autoload 'Info-split "informat" "\
-Split an info file into an indirect file plus bounded-size subfiles.
-Each subfile will be up to 50,000 characters plus one node.
-
-To use this command, first visit a large Info file that has a tag
-table.  The buffer is modified into a (small) indirect info file which
-should be saved in place of the original visited file.
-
-The subfiles are written in the same directory the original file is
-in, with names generated by appending `-' and a number to the original
-file name.  The indirect file still functions as an Info file, but it
-contains just the tag table and a directory of subfiles." t nil)
-
-(autoload 'Info-validate "informat" "\
-Check current buffer for validity as an Info file.
-Check that every node pointer points to an existing node." t nil)
-
-(autoload 'batch-info-validate "informat" "\
-Runs `Info-validate' on the files remaining on the command line.
-Must be used only with -batch, and kills Emacs on completion.
-Each file will be processed even if an error occurred previously.
-For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"" nil nil)
-
-;;;***
-
-;;;### (autoloads (latex-mode plain-tex-mode tex-mode) "tex-mode" "texinfo/tex-mode.el")
-
-(autoload 'tex-mode "tex-mode" "\
-Major mode for editing files of input for TeX, LaTeX, or SliTeX.
-Tries to determine (by looking at the beginning of the file) whether
-this file is for plain TeX, LaTeX, or SliTeX and calls plain-tex-mode,
-latex-mode, or slitex-mode, respectively.  If it cannot be determined,
-such as if there are no commands in the file, the value of tex-default-mode
-is used." t nil)
-
-(fset 'TeX-mode 'tex-mode)
-
-(fset 'LaTeX-mode 'latex-mode)
-
-(autoload 'plain-tex-mode "tex-mode" "\
-Major mode for editing files of input for plain TeX.
-Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
-
-Use \\[tex-region] to run TeX on the current region, plus a \"header\"
-copied from the top of the file (containing macro definitions, etc.),
-running TeX under a special subshell.  \\[tex-buffer] does the whole buffer.
-\\[tex-file] saves the buffer and then processes the file.
-\\[tex-print] prints the .dvi file made by any of these.
-\\[tex-view] previews the .dvi file made by any of these.
-\\[tex-bibtex-file] runs bibtex on the file of the current buffer.
-
-Use \\[validate-tex-buffer] to check buffer for paragraphs containing
-mismatched $'s or braces.
-
-Special commands:
-\\{tex-mode-map}
-
-Mode variables:
-tex-run-command
-	Command string used by \\[tex-region] or \\[tex-buffer].
-tex-directory
-	Directory in which to create temporary files for TeX jobs
-	run by \\[tex-region] or \\[tex-buffer].
-tex-dvi-print-command
-	Command string used by \\[tex-print] to print a .dvi file.
-tex-alt-dvi-print-command
-	Alternative command string used by \\[tex-print] (when given a prefix
-	argument) to print a .dvi file.
-tex-dvi-view-command
-	Command string used by \\[tex-view] to preview a .dvi file.
-tex-show-queue-command
-	Command string used by \\[tex-show-print-queue] to show the print
-	queue that \\[tex-print] put your job on.
-
-Entering Plain-tex mode calls the value of text-mode-hook, then the value of
-tex-mode-hook, and then the value of plain-tex-mode-hook.  When the special
-subshell is initiated, the value of tex-shell-hook is called." t nil)
-
-(fset 'plain-TeX-mode 'plain-tex-mode)
-
-(autoload 'latex-mode "tex-mode" "\
-Major mode for editing files of input for LaTeX.
-Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
-
-Use \\[tex-region] to run LaTeX on the current region, plus the preamble
-copied from the top of the file (containing \\documentstyle, etc.),
-running LaTeX under a special subshell.  \\[tex-buffer] does the whole buffer.
-\\[tex-file] saves the buffer and then processes the file.
-\\[tex-print] prints the .dvi file made by any of these.
-\\[tex-view] previews the .dvi file made by any of these.
-\\[tex-bibtex-file] runs bibtex on the file of the current buffer.
-
-Use \\[validate-tex-buffer] to check buffer for paragraphs containing
-mismatched $'s or braces.
-
-Special commands:
-\\{tex-mode-map}
-
-Mode variables:
-latex-run-command
-	Command string used by \\[tex-region] or \\[tex-buffer].
-tex-directory
-	Directory in which to create temporary files for LaTeX jobs
-	run by \\[tex-region] or \\[tex-buffer].
-tex-dvi-print-command
-	Command string used by \\[tex-print] to print a .dvi file.
-tex-alt-dvi-print-command
-	Alternative command string used by \\[tex-print] (when given a prefix
-	argument) to print a .dvi file.
-tex-dvi-view-command
-	Command string used by \\[tex-view] to preview a .dvi file.
-tex-show-queue-command
-	Command string used by \\[tex-show-print-queue] to show the print
-	queue that \\[tex-print] put your job on.
-
-Entering Latex mode calls the value of text-mode-hook, then the value of
-tex-mode-hook, and then the value of latex-mode-hook.  When the special
-subshell is initiated, the value of tex-shell-hook is called." t nil)
-(add-to-list 'auto-mode-alist '("\\.ltx\\'" . latex-mode))
-(add-to-list 'auto-mode-alist '("\\.[tT]e[xX]\\'" . tex-mode))
-(add-to-list 'auto-mode-alist '("\\.\\(?:sty\\|cls\\|bbl\\)\\'" . latex-mode))
-
-;;;***
-
-;;;### (autoloads (texi2info texinfo-format-region texinfo-format-buffer) "texinfmt" "texinfo/texinfmt.el")
-
-(autoload 'texinfo-format-buffer "texinfmt" "\
-Process the current buffer as texinfo code, into an Info file.
-The Info file output is generated in a buffer visiting the Info file
-name specified in the @setfilename command.
-
-Non-nil argument (prefix, if interactive) means don't make tag table
-and don't split the file if large.  You can use Info-tagify and
-Info-split to do these manually." t nil)
-
-(autoload 'texinfo-format-region "texinfmt" "\
-Convert the current region of the Texinfo file to Info format.
-This lets you see what that part of the file will look like in Info.
-The command is bound to \\[texinfo-format-region].  The text that is
-converted to Info is stored in a temporary buffer." t nil)
-
-(autoload 'texi2info "texinfmt" "\
-Convert the current buffer (written in Texinfo code) into an Info file.
-The Info file output is generated in a buffer visiting the Info file
-names specified in the @setfilename command.
-
-This function automatically updates all node pointers and menus, and
-creates a master menu.  This work is done on a temporary buffer that
-is automatically removed when the Info file is created.  The original
-Texinfo source buffer is not changed.
-
-Non-nil argument (prefix, if interactive) means don't split the file
-if large.  You can use Info-split to do this manually." t nil)
-
-;;;***
-
-;;;### (autoloads (texinfo-mode) "texinfo" "texinfo/texinfo.el")
-
-(defcustom texinfo-open-quote "``" "*String inserted by typing \\[texinfo-insert-quote] to open a quotation." :type 'string :group 'texinfo)
-
-(defcustom texinfo-close-quote "''" "*String inserted by typing \\[texinfo-insert-quote] to close a quotation." :type 'string :group 'texinfo)
-
-(autoload 'texinfo-mode "texinfo" "Major mode for editing Texinfo files.\n\n  It has these extra commands:\n\\{texinfo-mode-map}\n\n  These are files that are used as input for TeX to make printed manuals\nand also to be turned into Info files with \\[makeinfo-buffer] or\nthe `makeinfo' program.  These files must be written in a very restricted and\nmodified version of TeX input format.\n\n  Editing commands are like text-mode except that the syntax table is\nset up so expression commands skip Texinfo bracket groups.  To see\nwhat the Info version of a region of the Texinfo file will look like,\nuse \\[makeinfo-region], which runs `makeinfo' on the current region.\n\n  You can show the structure of a Texinfo file with \\[texinfo-show-structure].\nThis command shows the structure of a Texinfo file by listing the\nlines with the @-sign commands for @chapter, @section, and the like.\nThese lines are displayed in another window called the *Occur* window.\nIn that window, you can position the cursor over one of the lines and\nuse \\[occur-mode-goto-occurrence], to jump to the corresponding spot\nin the Texinfo file.\n\n  In addition, Texinfo mode provides commands that insert various\nfrequently used @-sign commands into the buffer.  You can use these\ncommands to save keystrokes.  And you can insert balanced braces with\n\\[texinfo-insert-braces] and later use the command \\[up-list] to\nmove forward past the closing brace.\n\nAlso, Texinfo mode provides functions for automatically creating or\nupdating menus and node pointers.  These functions\n\n  * insert the `Next', `Previous' and `Up' pointers of a node,\n  * insert or update the menu for a section, and\n  * create a master menu for a Texinfo source file.\n\nHere are the functions:\n\n    texinfo-update-node                \\[texinfo-update-node]\n    texinfo-every-node-update          \\[texinfo-every-node-update]\n    texinfo-sequential-node-update\n\n    texinfo-make-menu                  \\[texinfo-make-menu]\n    texinfo-all-menus-update           \\[texinfo-all-menus-update]\n    texinfo-master-menu\n\n    texinfo-indent-menu-description (column &optional region-p)\n\nThe `texinfo-column-for-description' variable specifies the column to\nwhich menu descriptions are indented.\n\nPassed an argument (a prefix argument, if interactive), the\n`texinfo-update-node' and `texinfo-make-menu' functions do their jobs\nin the region.\n\nTo use the updating commands, you must structure your Texinfo file\nhierarchically, such that each `@node' line, with the exception of the\nTop node, is accompanied by some kind of section line, such as an\n`@chapter' or `@section' line.\n\nIf the file has a `top' node, it must be called `top' or `Top' and\nbe the first node in the file.\n\nEntering Texinfo mode calls the value of `text-mode-hook', and then the\nvalue of `texinfo-mode-hook'." t nil)
-(add-to-list 'auto-mode-alist '("\\.texi\\(?:nfo\\)?\\'" . texinfo-mode))
-
-;;;***
-
-(provide 'texinfo-autoloads)
diff --git a/xemacs-packages/lisp/texinfo/custom-load.el b/xemacs-packages/lisp/texinfo/custom-load.el
deleted file mode 100644
index 249c40ad..00000000
--- a/xemacs-packages/lisp/texinfo/custom-load.el
+++ /dev/null
@@ -1,13 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'tex '("texnfo-tex"))
-(custom-add-loads 'texinfo '("texinfo" "texnfo-tex"))
-(custom-add-loads 'docs '("makeinfo" "texinfo"))
-(custom-add-loads 'makeinfo '("makeinfo"))
-(custom-add-loads 'texinfo-tex '("texnfo-tex"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/texinfo/detexinfo.el b/xemacs-packages/lisp/texinfo/detexinfo.el
deleted file mode 100644
index 22728366..00000000
--- a/xemacs-packages/lisp/texinfo/detexinfo.el
+++ /dev/null
@@ -1,275 +0,0 @@
-;;; detexinfo.el --- remove Texinfo commands from a Texinfo source file
- 
-;; Copyright (C) 1992-1993 Free Software Foundation, Inc.
-
-;; Keywords: tex, docs
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; Here is a handy keybinding: 
-
-(global-set-key "\C-x\\" 'detexinfo)
-
-;;;;;;;;;;;;;;;; detexinfo.el ;;;;;;;;;;;;;;;;
-;;;
-;;; Remove Texinfo commands from a Texinfo source file.
-;;;
-;;; Copyright (C) 1991, 1992 Free Software Foundation
-;;; Robert J. Chassell
-;;; bugs to bug-texinfo@prep.ai.mit.edu
-;;;
-;;; ==> test version <==
-;;; Fails if Texinfo source file contains formatting errors.
-;;; 
-;;; Version 0.05 -  3 Jun 1992
-;;; Add to list of removed commands.  Improve messages.
-;;;
-;;; Version 0.04 - 27 Jan 1992
-;;; Rewrite to insert detexinfo'd text into a temporary buffer.
-;;; 
-;;; Version 0.03 - 27 Dec 1991
-;;; Improved messages.
-;;;
-;;; Version 0.02 - 13 Nov 1991
-;;; detexinfo-remove-inline-cmd, detexinfo-syntax-table: Handle 
-;;;          nested commands.  
-;;; detexinfo: Handle nested @'s, eg @samp{@}} and @samp{@@};
-;;;          replace @TeX{} with TeX.
-;;; 
-;;; Version 0.01 - 13 Nov 1991
-;;;
-;;; Based on detex.el, by Bengt Martensson, 4 Oct 1987
-;;;
-;;;;;;;;;;;;;;;;
-
-(defvar detexinfo-buffer-name "*detexinfo*"
-  "*Name of the temporary buffer used by \\[detexinfo].")
-
-(defvar detexinfo-syntax-table nil)
-
-(if detexinfo-syntax-table
-    nil
-  (setq detexinfo-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\[ "." detexinfo-syntax-table)
-  (modify-syntax-entry ?\] "." detexinfo-syntax-table)
-  (modify-syntax-entry ?\" "." detexinfo-syntax-table)
-  (modify-syntax-entry ?\\ "." detexinfo-syntax-table)
-  (modify-syntax-entry ?\( "." detexinfo-syntax-table)
-  (modify-syntax-entry ?\) "." detexinfo-syntax-table)
-  (modify-syntax-entry ?{ "(}" detexinfo-syntax-table)
-  (modify-syntax-entry ?} "){" detexinfo-syntax-table))
-
-(defun detexinfo ()
-  "Remove Texinfo commands from current buffer, copying result to new buffer.
-BUG: Fails if Texinfo source file contains formatting errors."
-  (interactive)
-  (let ((input-buffer (current-buffer)))
-    ;; Find a buffer to use.
-    (switch-to-buffer (get-buffer-create detexinfo-buffer-name))
-    (setq major-mode 'detexinfo-mode)
-    (set-syntax-table detexinfo-syntax-table)
-    (erase-buffer)
-    (insert-buffer-substring input-buffer)
-    
-    ;; Replace @{ and @} with %#* and *#% temporarily, so @samp{@{} works.
-    ;; What is a better way of doing this??
-    (goto-char (point-min))
-    (while (search-forward "@{" nil t)  ; e.g., @samp{@{}
-      (replace-match "%#*"))
-    (goto-char (point-min))
-    (while (search-forward "@}" nil t)
-      (forward-char -3)                 ; e.g.,  @samp{@@}
-      (if (looking-at "@")              ; Two @@ in a row
-          (progn
-            (delete-char 2)
-            (insert "%&%#"))
-        (forward-char 1)
-        (delete-char 2)
-        (insert "*#%")))
-    
-    (goto-char (point-min))
-    ;; Remove @refill, the only inline command without braces.
-    (while (search-forward "@refill" nil t)
-      (replace-match ""))
-    ;; Replace @TeX{} with TeX
-    (goto-char (point-min))
-    (while (search-forward "@TeX{}" nil t) (replace-match "TeX" t t))
-    
-    (detexinfo-remove-line-cmds-without-arg)
-    (detexinfo-remove-inline-cmds-without-arg)
-    (detexinfo-remove-inline-cmds-keep-arg)
-    (detexinfo-remove-line-cmds-deletable-arg)
-    (detexinfo-remove-line-cmds-maybe-delete-arg)
-    (detexinfo-remove-line-cmds-keep-arg)
-    
-    ;; Now replace %#*, *#%, and %&%#  with {,  }, and @@.
-    (goto-char (point-min))
-    (while (search-forward "%#*" nil t)
-      (replace-match "{"))
-    (goto-char (point-min))
-    (while (search-forward "*#%" nil t)
-      (replace-match "}"))
-    (goto-char (point-min))
-    (while (search-forward "%&%#" nil t)
-      (replace-match "@@"))
-    
-    ;; Scan for remaining two character @-commands
-    (goto-char (point-min))
-    (while (search-forward "@" nil t)
-      (cond ((looking-at "[*:]")
-             (delete-region (1- (point)) (1+ (point))))
-            ((looking-at "[{}^@.'`]\"?!")
-             (delete-region (1- (point)) (point)))))
-    
-    (goto-char (point-min))
-    (message "Done...removed Texinfo commands from buffer. You may save it.")))
-
-(defun detexinfo-remove-whole-line (cmd)
-  "Delete Texinfo line command CMD at beginning of line and rest of line."
-  (goto-char (point-min))
-  (while
-      (re-search-forward
-       (concat "^@" cmd "[ \n]+") (point-max) t)
-    (goto-char (match-beginning 0))
-    (delete-region
-     (point) (save-excursion (end-of-line) (1+ (point))))))
-
-(defun detexinfo-remove-inline-cmd (cmd)
-  "Delete Texinfo inline command CMD, eg. @point, @code."
-  (goto-char (point-min))
-  (while
-      (re-search-forward (concat "@" cmd "{") (point-max) t)
-    (save-excursion
-      (forward-char -1)
-      (forward-sexp 1)
-      (delete-char -1))                 ; delete right brace
-    (delete-region (point) (match-beginning 0)))) 
-
-;;;;;;;;;;;;;;;; 
-
-;;; 1. @setfilename and other line commands with args to delete
-
-(defvar detexinfo-line-cmds-deletable-arg
-  '("enumerate" "ftable" "vtable" "itemize" "table"
-    "setfilename" "settitle" "setchapternewpage" 
-    "footnotestyle" "paragraphindent"
-    "include" "need" "sp" 
-    "clear" "ifclear" "ifset"  "set"
-    "defcodeindex" "defindex" "syncodeindex" "synindex")
-  "List of Texinfo commands whose arguments should be deleted.")
-
-(defun detexinfo-remove-line-cmds-deletable-arg ()
-  "Delete Texinfo line commands together with their args, eg @setfilename."
-  (message "Removing commands such as @enumerate...with their arguments...")
-  (mapcar 'detexinfo-remove-whole-line
-          detexinfo-line-cmds-deletable-arg))
-
-;;; 2. @cindex and other cmds with args that may be deleted
-;;;    This list is here just to make it easier to revise the
-;;;    categories.  In particular, you might want to keep the index entries.
-
-(defvar detexinfo-line-cmds-maybe-delete-arg
-   '("cindex" "findex" "kindex" "pindex" "tindex" "vindex" "node"
-     "c" "comment" "end" "headings"  "printindex" "vskip" 
-     "evenfooting"  "evenheading" "everyfooting" "everyheading" 
-     "oddfooting" "oddheading")
-  "List of Texinfo commands whose arguments may possibly be deleted.")
-
-(defun detexinfo-remove-line-cmds-maybe-delete-arg ()
-  "Delete Texinfo line commands together with their arguments, eg, @cindex."
-  (message "Removing commands such as @cindex...with their arguments...")
-  (mapcar 'detexinfo-remove-whole-line
-          detexinfo-line-cmds-maybe-delete-arg))
-
-;;; 3. @chapter and other line cmds with args to keep.
-
-(defvar detexinfo-line-cmds-keep-arg
-   '("top" "chapter" "section" "subsection" "subsubsection" 
-     "unnumbered" "unnumberedsec" "unnumberedsubsec" "unnumberedsubsubsec" 
-     "majorheading" "chapheading" "heading" "subheading" "subsubheading" 
-      "appendix" "appendixsec" "appendixsubsec" "appendixsubsubsec" 
-     "item" "itemx"
-     "title" "subtitle" "center" "author" "exdent"  
-     "defcv" "deffn" "defivar" "defmac" "defmethod" "defop" "defopt" 
-     "defspec" "deftp" "deftypefn" "deftypefun" "deftypvr"
-     "deftypevar" "defun" "defvar" "defvr")
-  "List of Texinfo line commands whose arguments should be kept.")
-
-(defun detexinfo-remove-line-cmds-keep-arg ()
-  "Delete Texinfo line commands but keep their arguments, eg @chapter."
-  (message "Removing commands such as @chapter...but not their arguments...")
-  (mapcar 'detexinfo-remove-line-cmd-keep-arg
-          detexinfo-line-cmds-keep-arg))
-
-(defun detexinfo-remove-line-cmd-keep-arg (cmd)
-  "Delete Texinfo line command CMD but keep its argument, eg @chapter."
-  (goto-char (point-min))
-  (while
-      (re-search-forward
-       (concat "^@" cmd "[ \n]+") (point-max) t)
-    (delete-region (match-beginning 0) (match-end 0))))
-
-;;; 4. @bye and other line commands without args.
-
-(defvar detexinfo-line-cmds-without-arg
-  '("bye" "contents" "display" "example" "finalout" 
-    "flushleft" "flushright" "format" "group" "ifhtml" "ifinfo" "iftex" 
-    "ignore" "lisp" "menu" "noindent" "page" "quotation"  
-    "shortcontents" "smallbook" "smallexample" "smalllisp" 
-    "summarycontents" "tex" "thischapter" "thischaptername" 
-    "thisfile" "thispage" "thissection" "thistitle" "titlepage")
-  "List of Texinfo commands without arguments that should be deleted.")
-
-(defun detexinfo-remove-line-cmds-without-arg ()
-  "Delete line Texinfo commands that lack args, eg. @example."
-  (message "Removing commands such as @example...that lack arguments...")
-  (mapcar 'detexinfo-remove-whole-line
-          detexinfo-line-cmds-without-arg))
-
-;;; 5. @equiv and other inline cmds without args.
-
-(defvar detexinfo-inline-cmds-without-arg
-  '("equiv" "error" "expansion" "point" "print" "result"
-    "asis"  "br" "bullet" "dots" "minus" "today")
-  "List of Texinfo inline commands without arguments that should be deleted.")
-
-(defun detexinfo-remove-inline-cmds-without-arg ()
-  "Delete Texinfo inline commands in that lack arguments."
-  (message "Removing within line commands such as @result...")
-  (mapcar 'detexinfo-remove-inline-cmd
-          detexinfo-inline-cmds-without-arg))
-
-;;; 6. @code and other inline cmds with args to keep
-
-(defvar detexinfo-inline-cmds-keep-arg
-  '("b" "cartouche" "cite" "code" "copyright" "ctrl" "dfn" "dmn"
-    "emph" "file" "footnote" "i" "inforef"
-    "kbd" "key" "pxref" "r" "ref" "samp" "sc" "titlefont" 
-    "strong" "t" "var" "w" "xref")
-  "List of Texinfo inline commands with arguments that should be kept.")
-
-(defun detexinfo-remove-inline-cmds-keep-arg ()
-  "Delete Texinfo inline commands but keep its arg, eg. @code."
-  (message
-   "Removing within line commands such as @code...but not their arguments...")
-  (mapcar 'detexinfo-remove-inline-cmd
-          detexinfo-inline-cmds-keep-arg))
-
-;;;;;;;;;;;;;;;; end detexinfo.el ;;;;;;;;;;;;;;;;
diff --git a/xemacs-packages/lisp/texinfo/informat.el b/xemacs-packages/lisp/texinfo/informat.el
deleted file mode 100644
index 84cd105a..00000000
--- a/xemacs-packages/lisp/texinfo/informat.el
+++ /dev/null
@@ -1,546 +0,0 @@
-;;; informat.el --- info support functions package for Emacs
-
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: help
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;; Nowadays, the Texinfo formatting commands always tagify a buffer
-;; (as does `makeinfo') since @anchor commands need tag tables.
-
-;;; Code:
-
-(require 'info)
-
-(defvar Info-validate-error-buffer "*Problems in Info file*"
-  "Buffer name used to report errors of Info file.")
-
-;;;###autoload
-(defun Info-tagify (&optional input-buffer-name)
-  "Create or update Info file tag table in current buffer or in a region."
-  (interactive)
-  ;; Save and restore point and restrictions.
-  ;; save-restrictions would not work
-  ;; because it records the old max relative to the end.
-  ;; We record it relative to the beginning.
-  (if input-buffer-name
-      (message "Tagifying region in %s ..." input-buffer-name)
-      (message
-       "Tagifying %s ..."  (file-name-nondirectory (buffer-file-name))))
-  (let ((omin (point-min))
-	(omax (point-max))
-	(nomax (= (point-max) (1+ (buffer-size))))
-	(opoint (point)))
-    (unwind-protect
-    (progn
-      (widen)
-      (goto-char (point-min))
-      (if (search-forward "\^_\nIndirect:\n" nil t)
-          (message
-           "Cannot tagify split info file.  Run this before splitting.")
-        (let (tag-list
-              refillp
-              (case-fold-search t)
-              (regexp
-               (concat
-                "\\("
-
-
-                "\\("
-                "@anchor"        ; match-string 2 matches @anchor
-                "\\)"
-                "\\(-no\\|-yes\\)"  ; match-string 3 matches -no or -yes
-                "\\("
-                "-refill"
-                "\\)"
-
-                "\\("
-                "{"
-                "\\)"
-                "\\("
-                "[^}]+"          ; match-string 6 matches arg to anchor
-                "\\)"
-                "\\("
-                "}"
-                "\\)"
-
-                "\\|"
-
-                "\\("
-                "\n\^_\\(\^L\\)?"
-                "\\)"
-
-                "\\("
-                "\n\\(File:[ \t]*\\([^,\n\t]*\\)[,\t\n]+[ \t\n]*\\)?"
-                "Node:[ \t]*"
-                "\\("
-                "[^,\n\t]*"      ; match-string 13 matches arg to node name
-                "\\)"
-                "[,\t\n]"
-                "\\)"
-
-                "\\)"
-                )))
-          (while (re-search-forward regexp nil t)
-            (if (string-equal "@anchor" (match-string 2))
-                (progn
-                  ;; kludge lest lose match-data
-                  (if (string-equal "-yes" (match-string 3))
-                      (setq refillp t))
-                  (setq tag-list
-                        (cons (list
-                               (concat "Ref: " (match-string 6))
-                               (match-beginning 0))
-                              tag-list))
-                  (if (eq refillp t)
-                      ;; set start and end so texinfo-format-refill works
-                      (let ((texinfo-command-start (match-beginning 0))
-                            (texinfo-command-end (match-end 0)))
-                        (texinfo-format-refill))
-                  (delete-region  (match-beginning 0) (match-end 0))))
-              ;; else this is a Node
-              (setq tag-list
-                    (cons (list
-                           (concat "Node: " (match-string-no-properties 13))
-                           (1+ (match-beginning 10)))
-                          tag-list))))
-
-	      (goto-char (point-max))
-	      (forward-line -8)
-	      (let ((buffer-read-only nil))
-		(if (search-forward "\^_\nEnd tag table\n" nil t)
-		    (let ((end (point)))
-		      (search-backward "\nTag table:\n")
-		      (beginning-of-line)
-		      (delete-region (point) end)))
-		(goto-char (point-max))
-		(or (bolp)
-		    (newline))
-		(insert "\^_\f\nTag table:\n")
-		(if (eq major-mode 'info-mode)
-		    (move-marker Info-tag-table-marker (point)))
-		(setq tag-list (nreverse tag-list))
-		(while tag-list
-		  (insert (car (car tag-list)) ?\177)
-		  (princ (car (cdr (car tag-list))) (current-buffer))
-		  (insert ?\n)
-		  (setq tag-list (cdr tag-list)))
-		(insert "\^_\nEnd tag table\n")))))
-      (goto-char opoint)
-      (narrow-to-region omin (if nomax (1+ (buffer-size))
-			       (min omax (point-max))))))
-  (if input-buffer-name
-      (message "Tagifying region in %s done" input-buffer-name)
-      (message
-       "Tagifying %s done"  (file-name-nondirectory (buffer-file-name)))))
-
-
-;;;###autoload
-(defun Info-split ()
-  "Split an info file into an indirect file plus bounded-size subfiles.
-Each subfile will be up to 50,000 characters plus one node.
-
-To use this command, first visit a large Info file that has a tag
-table.  The buffer is modified into a (small) indirect info file which
-should be saved in place of the original visited file.
-
-The subfiles are written in the same directory the original file is
-in, with names generated by appending `-' and a number to the original
-file name.  The indirect file still functions as an Info file, but it
-contains just the tag table and a directory of subfiles."
-
-  (interactive)
-  (if (< (buffer-size) 70000)
-      (error "This is too small to be worth splitting"))
-  (goto-char (point-min))
-  (search-forward "\^_")
-  (forward-char -1)
-  (let ((start (point))
-	(chars-deleted 0)
-	subfiles
-	(subfile-number 1)
-	(case-fold-search t)
-	(filename (file-name-sans-versions buffer-file-name)))
-    (goto-char (point-max))
-    (forward-line -8)
-    (setq buffer-read-only nil)
-    (or (search-forward "\^_\nEnd tag table\n" nil t)
-	(error "Tag table required; use M-x Info-tagify"))
-    (search-backward "\nTag table:\n")
-    (if (looking-at "\nTag table:\n\^_")
-	(error "Tag table is just a skeleton; use M-x Info-tagify"))
-    (beginning-of-line)
-    (forward-char 1)
-    (save-restriction
-      (narrow-to-region (point-min) (point))
-      (goto-char (point-min))
-      (while (< (1+ (point)) (point-max))
-	(goto-char (min (+ (point) 50000) (point-max)))
-	(search-forward "\^_" nil 'move)
-	(setq subfiles
-	      (cons (list (+ start chars-deleted)
-			  (concat (file-name-nondirectory filename)
-				  (format "-%d" subfile-number)))
-		    subfiles))
-	;; Put a newline at end of split file, to make Unix happier.
-	(insert "\n")
-	(write-region (point-min) (point)
-		      (concat filename (format "-%d" subfile-number)))
-	(delete-region (1- (point)) (point))
-	;; Back up over the final ^_.
-	(forward-char -1)
-	(setq chars-deleted (+ chars-deleted (- (point) start)))
-	(delete-region start (point))
-	(setq subfile-number (1+ subfile-number))))
-    (while subfiles
-      (goto-char start)
-      (insert (nth 1 (car subfiles))
-	      (format ": %d" (1- (car (car subfiles))))
-	      "\n")
-      (setq subfiles (cdr subfiles)))
-    (goto-char start)
-    (insert "\^_\nIndirect:\n")
-    (search-forward "\nTag Table:\n")
-    (insert "(Indirect)\n")))
-
-(defvar Info-validate-allnodes)
-(defvar Info-validate-thisnode)
-(defvar Info-validate-lossages)
-
-;;;###autoload
-(defun Info-validate ()
-  "Check current buffer for validity as an Info file.
-Check that every node pointer points to an existing node."
-  (interactive)
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (if (search-forward "\nTag table:\n(Indirect)\n" nil t)
-	  (error "Don't yet know how to validate indirect info files: \"%s\""
-		 (buffer-name (current-buffer))))
-      (goto-char (point-min))
-      (let ((Info-validate-allnodes '(("*")))
-	    (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]")
-	    (case-fold-search t)
-	    (tags-losing nil)
-	    (Info-validate-lossages ())
-	    (filename (file-name-nondirectory (buffer-file-name))))
-	(while (search-forward "\n\^_" nil t)
-	  (forward-line 1)
-	  (let ((beg (point)))
-	    (forward-line 1)
-	    (if (re-search-backward regexp beg t)
-		(let ((name (downcase
-			     (buffer-substring-no-properties
-			      (match-beginning 1)
-			      (progn
-				(goto-char (match-end 1))
-				(skip-chars-backward " \t")
-				(point))))))
-		  (if (assoc name Info-validate-allnodes)
-		      (setq Info-validate-lossages
-			    (cons (list name "Duplicate node-name" nil)
-				  Info-validate-lossages))
-		    (setq Info-validate-allnodes
-			  (cons (list name
-				      (progn
-					(end-of-line)
-					(and (re-search-backward
-					      "prev[ious]*:" beg t)
-					     (progn
-					       (goto-char (match-end 0))
-					       (downcase
-						(Info-following-node-name)))))
-				      beg)
-				Info-validate-allnodes)))))))
-	(goto-char (point-min))
-	(while (search-forward "\n\^_" nil t)
-	  (forward-line 1)
-	  (let ((beg (point))
-		Info-validate-thisnode next)
-	    (forward-line 1)
-	    (if (re-search-backward regexp beg t)
-		(save-restriction
-		  (let ((md (match-data)))
-		    (search-forward "\n\^_" nil 'move)
-		    (narrow-to-region beg (point))
-		    (set-match-data md))
-		  (setq Info-validate-thisnode (downcase
-						(buffer-substring-no-properties
-						 (match-beginning 1)
-						 (progn
-						   (goto-char (match-end 1))
-						   (skip-chars-backward " \t")
-						   (point)))))
-		  (end-of-line)
-		  (and (search-backward "next:" nil t)
-		       (setq next (Info-validate-node-name "invalid Next"))
-		       (assoc next Info-validate-allnodes)
-		       (if (equal (car (cdr (assoc next Info-validate-allnodes)))
-				  Info-validate-thisnode)
-			   ;; allow multiple `next' pointers to one node
-			   (let ((tem Info-validate-lossages))
-			     (while tem
-			       (if (and (equal (car (cdr (car tem)))
-					       "should have Previous")
-					(equal (car (car tem))
-					       next))
-				   (setq Info-validate-lossages
-					 (delq (car tem) Info-validate-lossages)))
-			       (setq tem (cdr tem))))
-			 (setq Info-validate-lossages
-			       (cons (list next
-					   "should have Previous"
-					   Info-validate-thisnode)
-				     Info-validate-lossages))))
-		  (end-of-line)
-		  (if (re-search-backward "prev[ious]*:" nil t)
-		      (Info-validate-node-name "invalid Previous"))
-		  (end-of-line)
-		  (if (search-backward "up:" nil t)
-		      (Info-validate-node-name "invalid Up"))
-		  ;; XEmacs change
-		  (if (re-search-forward "\n\\* Menu:" nil t)
-		      (catch 'next-menu
-			(while (re-search-forward "\n\\* " nil t)
-			  (save-excursion
-			    (if (looking-at "Menu:$")
-				(throw 'next-menu nil)))
-			  (Info-validate-node-name
-			   (concat "invalid menu item "
-				   (save-excursion
-				     (re-search-forward
-				      "\\(.+[^:]\\)::?[^:]*$" nil t)
-				     (match-string 1)))
-			   (Info-extract-menu-node-name)))))
-		  (goto-char (point-min))
-		  (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t)
-		    (goto-char (+ (match-beginning 0) 5))
-		    (skip-chars-forward " \n")
-		    (Info-validate-node-name
-		     (concat "invalid reference "
-			     (buffer-substring (point)
-					       (save-excursion
-						 (skip-chars-forward "^:")
-						 (point))))
-		     ;; XEmacs change
-		     (Info-extract-menu-node-name
-		      "Bad format cross-reference" t)))))))
-	(setq tags-losing (not (Info-validate-tags-table)))
-	(if (or Info-validate-lossages tags-losing)
-	    (with-output-to-temp-buffer Info-validate-error-buffer
-	      ;; XEmacs change
-	      ;; We need to add two non error lines since first two
-	      ;; lines are not parsed by compilation-parse-errors.
-	      (princ (format "Problems in Info file: %s\n\n"
-			     filename))
-	      (setq Info-validate-lossages (nreverse Info-validate-lossages))
-	      (while Info-validate-lossages
-		;; XEmacs change
-		;; more readable, compilation-minor-mode comformant output.
-		(princ (nth 0 (car Info-validate-lossages)))
-		(princ "In node \"")
-		(princ (nth 1 (car Info-validate-lossages)))
-		(princ "\", ")
-		(let ((tem (nth 2 (car Info-validate-lossages))))
-		  (cond ((string-match "\n" tem)
-			 (princ (substring tem 0 (match-beginning 0)))
-			 (princ "..."))
-			(t
-			 (princ tem))))
-		(if (nth 3 (car Info-validate-lossages))
-		    (progn
-		      (princ ": ")
-		      (let ((tem (nth 3 (car Info-validate-lossages))))
-			(cond ((string-match "\n" tem)
-			       (princ (substring tem 0 (match-beginning 0)))
-			       (princ "..."))
-			      (t
-			       (princ tem))))))
-		(terpri)
-		(setq Info-validate-lossages (cdr Info-validate-lossages)))
-	      ;; XEmacs change
-	      (save-excursion
-		(set-buffer Info-validate-error-buffer)
-		(compilation-minor-mode 1))
-	      (if tags-losing (princ "\nTags table must be recomputed\n")))
-	  ;; Here if info file is valid.
-	  ;; If we already made a list of problems, clear it out.
-	  (save-excursion
-	    (if (get-buffer Info-validate-error-buffer)
-		(progn
-		  (set-buffer Info-validate-error-buffer)
-		  (kill-buffer (current-buffer)))))
-	  (message "File appears valid"))))))
-
-(defun Info-validate-node-name (kind &optional name)
-  (if name
-      nil
-    (goto-char (match-end 0))
-    (skip-chars-forward " \t")
-    ;; XEmacs change
-    (if (eq (char-after) ?\()
-	nil
-      (setq name
-	    (buffer-substring-no-properties
-	     (point)
-	     (progn
-	       (skip-chars-forward "^,\t\n")
-	       (skip-chars-backward " ")
-	       (point))))))
-  (if (null name)
-      nil
-    ;; XEmacs change
-    (setq name (replace-in-string name "[ \t]+" " "))
-    (setq name (downcase name))
-    (or (and (> (length name) 0) (= (aref name 0) ?\())
-	(assoc name Info-validate-allnodes)
-	(setq Info-validate-lossages
-	      ;; XEmacs change
-	      (cons (list (Info-file-data) Info-validate-thisnode kind name)
-		    Info-validate-lossages))))
-  name)
-
-(defun Info-validate-tags-table ()
-  (goto-char (point-min))
-  (if (not (search-forward "\^_\nEnd tag table\n" nil t))
-      t
-    (not (catch 'losing
-	   (let* ((end (match-beginning 0))
-		  (start (progn (search-backward "\nTag table:\n")
-				(1- (match-end 0))))
-		  tem)
-	     (setq tem Info-validate-allnodes)
-	     (while tem
-	       (goto-char start)
-	       (or (equal (car (car tem)) "*")
-		   (search-forward (concat "Node: "
-					   (car (car tem))
-					   "\177")
-				   end t)
-		   (throw 'losing 'x))
-	       (setq tem (cdr tem)))
-	     (goto-char (1+ start))
-	     (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$")
-	       (setq tem (downcase (buffer-substring-no-properties
-				     (match-beginning 1)
-				     (match-end 1))))
-	       (setq tem (assoc tem Info-validate-allnodes))
-	       (if (or (not tem)
-		       (< 1000 (progn
-				 (goto-char (match-beginning 2))
-				 (setq tem (- (car (cdr (cdr tem)))
-					      (read (current-buffer))))
-				 (if (> tem 0) tem (- tem)))))
-		   (throw 'losing 'y))
-	       (forward-line 1)))
-	   (if (looking-at "\^_\n")
-	       (forward-line 1))
-	   (or (looking-at "End tag table\n")
-	       (throw 'losing 'z))
-	   nil))))
-
-;;;###autoload
-(defun batch-info-validate ()
-  "Runs `Info-validate' on the files remaining on the command line.
-Must be used only with -batch, and kills Emacs on completion.
-Each file will be processed even if an error occurred previously.
-For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\""
-  (if (not noninteractive)
-      (error "batch-info-validate may only be used -batch"))
-  (let ((version-control t)
-	(auto-save-default nil)
-	(find-file-run-dired nil)
-	(kept-old-versions 259259)
-	(kept-new-versions 259259))
-    (let ((error 0)
-	  file
-	  (files ()))
-      (while command-line-args-left
-	(setq file (expand-file-name (car command-line-args-left)))
-	(cond ((not (file-exists-p file))
-	       (message ">> %s does not exist!" file)
-	       (setq error 1
-		     command-line-args-left (cdr command-line-args-left)))
-	      ((file-directory-p file)
-	       (setq command-line-args-left (nconc (directory-files file)
-					      (cdr command-line-args-left))))
-	      (t
-	       (setq files (cons file files)
-		     command-line-args-left (cdr command-line-args-left)))))
-      (while files
-	(setq file (car files)
-	      files (cdr files))
-	(let ((lose nil))
-	  (condition-case err
-	      (progn
-		(if buffer-file-name (kill-buffer (current-buffer)))
-		(find-file file)
-		(buffer-disable-undo (current-buffer))
-		(set-buffer-modified-p nil)
-		(fundamental-mode)
-		(let ((case-fold-search nil))
-		  (goto-char (point-max))
-		  (cond ((search-backward "\n\^_\^L\nTag table:\n" nil t)
-			 (message "%s already tagified" file))
-			((< (point-max) 30000)
-			 (message "%s too small to bother tagifying" file))
-			(t
-			 (Info-tagify))))
-		(let ((loss-name Info-validate-error-buffer))
-		  (message "Checking validity of info file %s..." file)
-		  (if (get-buffer loss-name)
-		      (kill-buffer loss-name))
-		  (Info-validate)
-		  (if (not (get-buffer loss-name))
-		      nil ;(message "Checking validity of info file %s... OK" file)
-		    (message "----------------------------------------------------------------------")
-		    (message ">> PROBLEMS IN INFO FILE %s" file)
-		    (save-excursion
-		      (set-buffer loss-name)
-		      (princ (buffer-substring-no-properties
-			      (point-min) (point-max))))
-		    (message "----------------------------------------------------------------------")
-		    (setq error 1 lose t)))
-		(if (and (buffer-modified-p)
-			 (not lose))
-		    (progn (message "Saving modified %s" file)
-			   (save-buffer))))
-	    (error (message ">> Error: %s" (prin1-to-string err))))))
-      (kill-emacs error))))
-
-(defun Info-file-data ()
-  (save-excursion
-    (save-restriction
-      (widen)
-      (beginning-of-line)
-      (format "%s:%d:"
-	      ;; Since we can validate only one file, we don't need absolute file name.
-	      (file-name-nondirectory (buffer-file-name))
-	      (1+ (count-lines 1 (point)))))))
-
-(provide 'informat)
-
-;;; informat.el ends here
diff --git a/xemacs-packages/lisp/texinfo/makeinfo.el b/xemacs-packages/lisp/texinfo/makeinfo.el
deleted file mode 100644
index b9d2e387..00000000
--- a/xemacs-packages/lisp/texinfo/makeinfo.el
+++ /dev/null
@@ -1,258 +0,0 @@
-;;; makeinfo.el --- run makeinfo conveniently
-
-;; Copyright (C) 1991, 1993 Free Software Foundation, Inc.
-
-;; Author: Robert J. Chassell      
-;; Maintainer: FSF
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;;; The Texinfo mode `makeinfo' related commands are:
-
-;; makeinfo-region      to run makeinfo on the current region.
-;; makeinfo-buffer      to run makeinfo on the current buffer, or
-;;                        with optional prefix arg, on current region
-;; kill-compilation     to kill currently running makeinfo job
-;; makeinfo-recenter-makeinfo-buffer  to redisplay *compilation* buffer
-
-;;; Keybindings (defined in `texinfo.el')
-
-;; makeinfo bindings
-; (define-key texinfo-mode-map "\C-c\C-m\C-r" 'makeinfo-region)
-; (define-key texinfo-mode-map "\C-c\C-m\C-b" 'makeinfo-buffer)
-; (define-key texinfo-mode-map "\C-c\C-m\C-k" 'kill-compilation)
-; (define-key texinfo-mode-map "\C-c\C-m\C-l"
-;   'makeinfo-recenter-compilation-buffer)
-
-;;; Code:
-
-;;; Variables used by `makeinfo'
-
-(require 'compile)
-
-(defgroup makeinfo nil
-  "Run makeinfo conveniently."
-  :group 'docs)
-
-
-(defcustom makeinfo-run-command "makeinfo"
-  "*Command used to run `makeinfo' subjob.
-The name of the file is appended to this string, separated by a space."
-  :type 'string
-  :group 'makeinfo)
-
-(defcustom makeinfo-options "--fill-column=70"
-  "*String containing options for running `makeinfo'.  
-Do not include `--footnote-style' or `--paragraph-indent';
-the proper way to specify those is with the Texinfo commands
-`@footnotestyle` and `@paragraphindent'."
-  :type 'string
-  :group 'makeinfo)
-
-(require 'texinfo)
-
-(defvar makeinfo-compilation-process nil
-  "Process that runs `makeinfo'.  Should start out nil.")
-
-(defvar makeinfo-temp-file nil
-  "Temporary file name used for text being sent as input to `makeinfo'.")
-
-(defvar makeinfo-output-file-name nil
-  "Info file name used for text output by `makeinfo'.")
-
-
-;;; The `makeinfo' function definitions
-
-(defun makeinfo-region (region-beginning region-end)
-  "Make Info file from region of current Texinfo file, and switch to it.
-
-This command does not offer the `next-error' feature since it would
-apply to a temporary file, not the original; use the `makeinfo-buffer'
-command to gain use of `next-error'."
-  
-  (interactive "r")
-  (let (filename-or-header
-        filename-or-header-beginning
-        filename-or-header-end)
-    ;; Cannot use `let' for makeinfo-temp-file or
-    ;; makeinfo-output-file-name since `makeinfo-compilation-sentinel'
-    ;; needs them.
-
-    (setq makeinfo-temp-file
-          (concat
-           (make-temp-name
-            (substring (buffer-file-name)
-                       0 
-                       (or (string-match "\\.tex" (buffer-file-name)) 
-                           (length (buffer-file-name)))))
-           ".texinfo"))
-    
-    (save-excursion
-      (save-restriction
-        (widen)
-        (goto-char (point-min))
-        (let ((search-end (save-excursion (forward-line 100) (point))))
-          ;; Find and record the Info filename,
-          ;; or else explain that a filename is needed.
-          (if (re-search-forward 
-               "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
-               search-end t)
-              (setq makeinfo-output-file-name 
-                    (buffer-substring (match-beginning 1) (match-end 1)))
-            (error
-             "The texinfo file needs a line saying: @setfilename <name>"))
-
-          ;; Find header and specify its beginning and end.
-          (goto-char (point-min))
-          (if (and 
-               (prog1 
-                   (search-forward tex-start-of-header search-end t)
-                 (beginning-of-line)
-                 ;; Mark beginning of header.
-                 (setq filename-or-header-beginning (point)))
-               (prog1 
-                   (search-forward tex-end-of-header nil t)
-                 (beginning-of-line)
-                 ;; Mark end of header
-                 (setq filename-or-header-end (point))))
-              
-              ;; Insert the header into the temporary file.
-              (write-region
-               (min filename-or-header-beginning region-beginning)
-               filename-or-header-end
-               makeinfo-temp-file nil nil)
-            
-            ;; Else no header; insert @filename line into temporary file.
-            (goto-char (point-min))
-            (search-forward "@setfilename" search-end t)
-            (beginning-of-line)
-            (setq filename-or-header-beginning (point))
-            (forward-line 1)
-            (setq filename-or-header-end (point))
-            (write-region
-             (min filename-or-header-beginning region-beginning)
-             filename-or-header-end
-             makeinfo-temp-file nil nil))
-          
-          ;; Insert the region into the file.
-          (write-region
-           (max region-beginning filename-or-header-end)
-           region-end
-           makeinfo-temp-file t nil)
-
-          ;; Run the `makeinfo-compile' command in the *compilation* buffer
-          (save-excursion
-            (makeinfo-compile
-             (concat makeinfo-run-command
-                     " "
-                     makeinfo-options
-                     " " 
-                     makeinfo-temp-file)
-             "Use `makeinfo-buffer' to gain use of the `next-error' command"
-	     nil)))))))
-
-;;; Actually run makeinfo.  COMMAND is the command to run.
-;;; ERROR-MESSAGE is what to say when next-error can't find another error.
-;;; If PARSE-ERRORS is non-nil, do try to parse error messages.
-(defun makeinfo-compile (command error-message parse-errors)
-  (let ((buffer
-	 (compile-internal command error-message nil
-			   (and (not parse-errors)
-				;; If we do want to parse errors, pass nil.
-				;; Otherwise, use this function, which won't
-				;; ever find any errors.
-				'(lambda (&rest ignore)
-				   (setq compilation-error-list nil))))))
-    (set-process-sentinel (get-buffer-process buffer)
-			  'makeinfo-compilation-sentinel)))
-
-;; Delete makeinfo-temp-file after processing is finished,
-;; and visit Info file.
-;; This function is called when the compilation process changes state.
-;; Based on `compilation-sentinel' in compile.el
-(defun makeinfo-compilation-sentinel (proc msg)
-  (compilation-sentinel proc msg)
-  (if (and makeinfo-temp-file (file-exists-p makeinfo-temp-file))
-      (delete-file makeinfo-temp-file))
-  ;; Always use the version on disk.
-  (if (get-file-buffer makeinfo-output-file-name)
-      (progn (set-buffer makeinfo-output-file-name)
-	     (revert-buffer t t))
-    (find-file makeinfo-output-file-name))
-  (goto-char (point-min)))
-
-(defun makeinfo-buffer ()
-  "Make Info file from current buffer.
-
-Use the \\[next-error] command to move to the next error 
-\(if there are errors\)."
- 
-  (interactive)
-  (cond ((null buffer-file-name)
-         (error "Buffer not visiting any file"))
-        ((buffer-modified-p)
-         (if (y-or-n-p "Buffer modified; do you want to save it? ")
-             (save-buffer))))
-  
-  ;; Find and record the Info filename,
-  ;; or else explain that a filename is needed.
-  (save-excursion
-    (goto-char (point-min))
-    (let ((search-end (save-excursion (forward-line 100) (point))))
-      (if (re-search-forward 
-           "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
-           search-end t)
-          (setq makeinfo-output-file-name 
-                (buffer-substring (match-beginning 1) (match-end 1)))
-        (error
-         "The texinfo file needs a line saying: @setfilename <name>"))))
-  
-  (save-excursion
-    (makeinfo-compile
-     (concat makeinfo-run-command " " makeinfo-options
-             " " buffer-file-name)
-     "No more errors."
-     t)))
-
-(defun makeinfo-recenter-compilation-buffer (linenum)
-  "Redisplay `*compilation*' buffer so most recent output can be seen.
-The last line of the buffer is displayed on
-line LINE of the window, or centered if LINE is nil."
-  (interactive "P")
-  (let ((makeinfo-buffer (get-buffer "*compilation*"))
-	(old-buffer (current-buffer)))
-    (if (null makeinfo-buffer)
-	(message "No *compilation* buffer")
-      (pop-to-buffer makeinfo-buffer)
-      (bury-buffer makeinfo-buffer)
-      (goto-char (point-max))
-      (recenter (if linenum
-		    (prefix-numeric-value linenum)
-		  (/ (window-height) 2)))
-      (pop-to-buffer old-buffer)
-      )))
-
-;;; Place `provide' at end of file.
-(provide 'makeinfo)
-
-;;; makeinfo.el ends here
-
diff --git a/xemacs-packages/lisp/texinfo/tex-mode.el b/xemacs-packages/lisp/texinfo/tex-mode.el
deleted file mode 100644
index d028df45..00000000
--- a/xemacs-packages/lisp/texinfo/tex-mode.el
+++ /dev/null
@@ -1,892 +0,0 @@
-;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands.
-
-;; Copyright (C) 1985-1992 Free Software Foundation, Inc.
-;; Contributions over the years by William F. Schelter, Dick King,
-;; Stephen Gildea, Michael Prange, and Edward M. Reingold.
-
-;; Latest revision (1992) by Edward M. Reingold <reingold@cs.uiuc.edu>.
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(require 'comint)
-
-(defvar tex-shell-file-name nil
-  "*If non-nil, is file name to use for the subshell in which TeX is run.")
-
-(defvar tex-directory "."
-  "*Directory in which temporary files are left.
-You can make this /tmp if your TEXINPUTS has no relative directories in it
-and you don't try to apply \\[tex-region] or \\[tex-buffer] when there are
-\\input commands with relative directories.")
-
-(defvar tex-offer-save t
-  "*If non-nil, ask about saving modified buffers before \\[tex-file] is run.")
-
-(defvar tex-run-command "tex"
-  "*Command used to run TeX subjob.
-If this string contains an asterisk (*), it will be replaced by the
-filename; if not, the name of the file, preceded by blank, will be added to
-this string.")
-
-(defvar latex-run-command "latex"
-  "*Command used to run LaTeX subjob.
-If this string contains an asterisk (*), it will be replaced by the
-filename; if not, the name of the file, preceded by blank, will be added to
-this string.")
-
-(defvar standard-latex-block-names
-      '("abstract"         "array"            "center"       "description"
-        "displaymath"      "document"         "enumerate"    "eqnarray"
-        "eqnarray*"        "equation"         "figure"       "figure*"
-        "flushleft"        "flushright"       "itemize"      "letter"
-        "list"             "minipage"         "picture"      "quotation"
-        "quote"            "slide"            "sloppypar"     "tabbing"
-        "table"            "table*"           "tabular"       "tabular*"
-        "thebibliography"  "theindex*"        "titlepage"     "trivlist"
-        "verbatim"         "verbatim*"        "verse")
-  "Standard LaTeX block names.")
-
-(defvar latex-block-names nil
-  "*User defined LaTeX block names.
-Combined with `standard-latex-block-names' for minibuffer completion.")
-
-(defvar tex-latex-document-regex "documentstyle\\|documentclass"
-  "matches the first command of a LaTeX document")
-
-(defvar slitex-run-command "slitex"
-  "*Command used to run SliTeX subjob.
-If this string contains an asterisk (*), it will be replaced by the
-filename; if not, the name of the file, preceded by blank, will be added to
-this string.")
-
-(defvar tex-slitex-document-regex "documentstyle{slides}"
-  "Matches the first command of a slitex document")
-  
-(defvar tex-bibtex-command "bibtex"
-  "*Command used by `tex-bibtex-file' to gather bibliographic data.
-If this string contains an asterisk (*), it will be replaced by the
-filename; if not, the name of the file, preceded by blank, will be added to
-this string.")
-
-(defvar tex-dvi-print-command "lpr -d"
-  "*Command used by \\[tex-print] to print a .dvi file.
-If this string contains an asterisk (*), it will be replaced by the
-filename; if not, the name of the file, preceded by blank, will be added to
-this string.")
-
-(defvar tex-alt-dvi-print-command "lpr -d"
-  "*Command used by \\[tex-print] with a prefix arg to print a .dvi file.
-If this string contains an asterisk (*), it will be replaced by the
-filename; if not, the name of the file, preceded by blank, will be added to
-this string.
-
-If two printers are not enough of a choice, you can define the value
-of tex-alt-dvi-print-command to be an expression that asks what you want;
-for example,
-
-    (setq tex-alt-dvi-print-command
-         '(format \"lpr -P%s\" (read-string \"Use printer: \")))
-
-would tell \\[tex-print] with a prefix argument to ask you which printer to
-use.")
-
-(defvar tex-dvi-view-command nil
-  "*Command used by \\[tex-view] to display a .dvi file.
-If this string contains an asterisk (*), it will be replaced by the
-filename; if not, the name of the file, preceded by blank, will be added to
-this string.
-
-This can be set conditionally so that the previewer used is suitable for the
-window system being used.  For example,
-
-    (setq tex-dvi-view-command
-          (if (eq window-system 'x) \"xdvi\" \"dvi2tty * | cat -s\"))
-
-would tell \\[tex-view] use xdvi under X windows and to use dvi2tty
-otherwise.")
-
-(defvar tex-show-queue-command "lpq"
-  "*Command used by \\[tex-show-print-queue] to show the print queue.
-Should show the queue(s) that \\[tex-print] puts jobs on.")
-
-(defvar tex-default-mode 'plain-tex-mode
-  "*Mode to enter for a new file that might be either TeX or LaTeX.
-This variable is used when it can't be determined whether the file
-is plain TeX or LaTeX or what because the file contains no commands.
-Normally set to either 'plain-tex-mode or 'latex-mode.")
-
-(defvar tex-open-quote "``"
-  "*String inserted by typing \\[tex-insert-quote] to open a quotation.")
-
-(defvar tex-close-quote "''"
-  "*String inserted by typing \\[tex-insert-quote] to close a quotation.")
-
-(defvar tex-last-temp-file nil
-  "Latest temporary file generated by \\[tex-region] and \\[tex-buffer].
-Deleted when the \\[tex-region] or \\[tex-buffer] is next run, or when the
-tex-shell goes away.")
-
-(defvar tex-command nil
-  "Command to run TeX.
-The name of the file, preceded by a blank, will be added to this string.")
-
-(defvar tex-trailer nil
-  "String appended after the end of a region sent to TeX by \\[tex-region].")
-
-(defvar tex-start-of-header nil
-  "String used by \\[tex-region] to delimit the start of the file's header.")
-
-(defvar tex-end-of-header nil
-  "String used by \\[tex-region] to delimit the end of the file's header.")
-
-(defvar tex-shell-cd-command "cd"
-  "Command to give to shell running TeX to change directory.
-The value of tex-directory will be appended to this, separated by a space.")
-
-(defvar tex-zap-file nil
-  "Temporary file name used for text being sent as input to TeX.
-Should be a simple file name with no extension or directory specification.")
-
-(defvar tex-last-buffer-texed nil
-  "Buffer which was last TeXed.")
-
-(defvar tex-print-file nil
-  "File name that \\[tex-print] prints.
-Set by \\[tex-region], \\[tex-buffer], and \\[tex-file].")
-
-(defvar tex-mode-syntax-table nil
-  "Syntax table used while in TeX mode.")
-
-(defvar tex-mode-hook nil
-  "Hook to run in TeX modes (plain-tex-mode, latex-mode, slitex-mode).")
-
-(defvar tex-shell-hook nil
-  "Hook to run in TeX modes (plain-tex-mode, latex-mode, slitex-mode),
-when the special subshell is initiated.")
-
-(defvar plain-tex-mode-hook nil
-  "Hook to run when entering plain-tex-mode.")
-
-(defvar latex-mode-hook nil
-  "Hook to run when entering latex-mode.")
-
-(defvar slitex-mode-hook nil
-  "Hook to run when entering slitex-mode.")
-
-(defun tex-define-common-keys (keymap)
-  "Define the keys that we want defined both in TeX mode and in the tex-shell."
-  (define-key keymap "\C-c\C-k" 'tex-kill-job)
-  (define-key keymap "\C-c\C-l" 'tex-recenter-output-buffer)
-  (define-key keymap "\C-c\C-q" 'tex-show-print-queue)
-  (define-key keymap "\C-c\C-p" 'tex-print)
-  (define-key keymap "\C-c\C-v" 'tex-view)
-  )
-
-(defvar tex-mode-map nil "Keymap for TeX mode.")
-
-(if tex-mode-map 
-    nil
-  (setq tex-mode-map (make-sparse-keymap))
-  (tex-define-common-keys tex-mode-map)
-  (define-key tex-mode-map "\"" 'tex-insert-quote)
-  (define-key tex-mode-map "\n" 'tex-terminate-paragraph)
-  (define-key tex-mode-map "\C-c}" 'up-list)
-  (define-key tex-mode-map "\C-c{" 'tex-insert-braces)
-  (define-key tex-mode-map "\C-c\C-r" 'tex-region)
-  (define-key tex-mode-map "\C-c\C-b" 'tex-buffer)
-  (define-key tex-mode-map "\C-c\C-f" 'tex-file)
-  (define-key tex-mode-map "\C-c\C-i" 'tex-bibtex-file)
-  (define-key tex-mode-map "\C-c\C-o" 'tex-latex-block)
-  (define-key tex-mode-map "\C-c\C-e" 'tex-close-latex-block))
-
-(defvar tex-shell-map nil
-  "Keymap for the tex-shell.  A comint-mode-map with a few additions.")
-
-;;; This would be a lot simpler if we just used a regexp search,
-;;; but then it would be too slow.
-;;;###autoload
-(defun tex-mode ()
-  "Major mode for editing files of input for TeX, LaTeX, or SliTeX.
-Tries to determine (by looking at the beginning of the file) whether
-this file is for plain TeX, LaTeX, or SliTeX and calls plain-tex-mode,
-latex-mode, or slitex-mode, respectively.  If it cannot be determined,
-such as if there are no commands in the file, the value of tex-default-mode
-is used."
-  (interactive)
-  (let (mode slash comment)
-    (save-excursion
-      (goto-char (point-min))
-      (while (and (setq slash (search-forward "\\" nil t))
-		  (setq comment (let ((search-end (point)))
-				  (save-excursion
-				    (beginning-of-line)
-				    (search-forward "%" search-end t))))))
-      (if (and slash (not comment))
-	  (setq mode (if (looking-at tex-latex-document-regex)
-                         (if (looking-at tex-slitex-document-regex)
-                             'slitex-mode
-                           'latex-mode)
-		       'plain-tex-mode))))
-    (if mode (funcall mode)
-      (funcall tex-default-mode))))
-;;;###autoload
-(fset 'TeX-mode 'tex-mode)
-;;;###autoload
-(fset 'LaTeX-mode 'latex-mode)
-
-;;;###autoload
-(defun plain-tex-mode ()
-  "Major mode for editing files of input for plain TeX.
-Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
-
-Use \\[tex-region] to run TeX on the current region, plus a \"header\"
-copied from the top of the file (containing macro definitions, etc.),
-running TeX under a special subshell.  \\[tex-buffer] does the whole buffer.
-\\[tex-file] saves the buffer and then processes the file.
-\\[tex-print] prints the .dvi file made by any of these.
-\\[tex-view] previews the .dvi file made by any of these.
-\\[tex-bibtex-file] runs bibtex on the file of the current buffer.
-
-Use \\[validate-tex-buffer] to check buffer for paragraphs containing
-mismatched $'s or braces.
-
-Special commands:
-\\{tex-mode-map}
-
-Mode variables:
-tex-run-command
-	Command string used by \\[tex-region] or \\[tex-buffer].
-tex-directory
-	Directory in which to create temporary files for TeX jobs
-	run by \\[tex-region] or \\[tex-buffer].
-tex-dvi-print-command
-	Command string used by \\[tex-print] to print a .dvi file.
-tex-alt-dvi-print-command
-	Alternative command string used by \\[tex-print] (when given a prefix
-	argument) to print a .dvi file.
-tex-dvi-view-command
-	Command string used by \\[tex-view] to preview a .dvi file.
-tex-show-queue-command
-	Command string used by \\[tex-show-print-queue] to show the print
-	queue that \\[tex-print] put your job on.
-
-Entering Plain-tex mode calls the value of text-mode-hook, then the value of
-tex-mode-hook, and then the value of plain-tex-mode-hook.  When the special
-subshell is initiated, the value of tex-shell-hook is called."
-  (interactive)
-  (tex-common-initialization)
-  (setq mode-name "TeX")
-  (setq major-mode 'plain-tex-mode)
-  (setq tex-command tex-run-command)
-  (setq tex-start-of-header "%**start of header")
-  (setq tex-end-of-header "%**end of header")
-  (setq tex-trailer "\\bye\n")
-  (run-hooks 'text-mode-hook 'tex-mode-hook 'plain-tex-mode-hook))
-;;;###autoload
-(fset 'plain-TeX-mode 'plain-tex-mode)
-
-;;;###autoload
-(defun latex-mode ()
-  "Major mode for editing files of input for LaTeX.
-Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
-
-Use \\[tex-region] to run LaTeX on the current region, plus the preamble
-copied from the top of the file (containing \\documentstyle, etc.),
-running LaTeX under a special subshell.  \\[tex-buffer] does the whole buffer.
-\\[tex-file] saves the buffer and then processes the file.
-\\[tex-print] prints the .dvi file made by any of these.
-\\[tex-view] previews the .dvi file made by any of these.
-\\[tex-bibtex-file] runs bibtex on the file of the current buffer.
-
-Use \\[validate-tex-buffer] to check buffer for paragraphs containing
-mismatched $'s or braces.
-
-Special commands:
-\\{tex-mode-map}
-
-Mode variables:
-latex-run-command
-	Command string used by \\[tex-region] or \\[tex-buffer].
-tex-directory
-	Directory in which to create temporary files for LaTeX jobs
-	run by \\[tex-region] or \\[tex-buffer].
-tex-dvi-print-command
-	Command string used by \\[tex-print] to print a .dvi file.
-tex-alt-dvi-print-command
-	Alternative command string used by \\[tex-print] (when given a prefix
-	argument) to print a .dvi file.
-tex-dvi-view-command
-	Command string used by \\[tex-view] to preview a .dvi file.
-tex-show-queue-command
-	Command string used by \\[tex-show-print-queue] to show the print
-	queue that \\[tex-print] put your job on.
-
-Entering Latex mode calls the value of text-mode-hook, then the value of
-tex-mode-hook, and then the value of latex-mode-hook.  When the special
-subshell is initiated, the value of tex-shell-hook is called."
-  (interactive)
-  (tex-common-initialization)
-  (setq mode-name "LaTeX")
-  (setq major-mode 'latex-mode)
-  (setq tex-command latex-run-command)
-  (setq tex-start-of-header "\\documentstyle")
-  (setq tex-end-of-header "\\begin{document}")
-  (setq tex-trailer "\\end{document}\n")
-  (run-hooks 'text-mode-hook 'tex-mode-hook 'latex-mode-hook))
-
-(defun slitex-mode ()
-  "Major mode for editing files of input for SliTeX.
-Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
-
-Use \\[tex-region] to run SliTeX on the current region, plus the preamble
-copied from the top of the file (containing \\documentstyle, etc.),
-running SliTeX under a special subshell.  \\[tex-buffer] does the whole buffer.
-\\[tex-file] saves the buffer and then processes the file.
-\\[tex-print] prints the .dvi file made by any of these.
-\\[tex-view] previews the .dvi file made by any of these.
-\\[tex-bibtex-file] runs bibtex on the file of the current buffer.
-
-Use \\[validate-tex-buffer] to check buffer for paragraphs containing
-mismatched $'s or braces.
-
-Special commands:
-\\{tex-mode-map}
-
-Mode variables:
-slitex-run-command
-	Command string used by \\[tex-region] or \\[tex-buffer].
-tex-directory
-	Directory in which to create temporary files for SliTeX jobs
-	run by \\[tex-region] or \\[tex-buffer].
-tex-dvi-print-command
-	Command string used by \\[tex-print] to print a .dvi file.
-tex-alt-dvi-print-command
-	Alternative command string used by \\[tex-print] (when given a prefix
-	argument) to print a .dvi file.
-tex-dvi-view-command
-	Command string used by \\[tex-view] to preview a .dvi file.
-tex-show-queue-command
-	Command string used by \\[tex-show-print-queue] to show the print
-	queue that \\[tex-print] put your job on.
-
-Entering SliTeX mode calls the value of text-mode-hook, then the value of
-tex-mode-hook, then the value of latex-mode-hook, and then the value of
-slitex-mode-hook.  When the special subshell is initiated, the value of
-tex-shell-hook is called."
-  (interactive)
-  (tex-common-initialization)
-  (setq mode-name "SliTeX")
-  (setq major-mode 'slitex-mode)
-  (setq tex-command slitex-run-command)
-  (setq tex-start-of-header "\\documentstyle{slides}")
-  (setq tex-end-of-header "\\begin{document}")
-  (setq tex-trailer "\\end{document}\n")
-  (run-hooks
-   'text-mode-hook 'tex-mode-hook 'latex-mode-hook 'slitex-mode-hook))
-
-(defun tex-common-initialization ()
-  (kill-all-local-variables)
-  (use-local-map tex-mode-map)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (if (null tex-mode-syntax-table)
-      (let ((char 0))
-	(setq tex-mode-syntax-table (make-syntax-table))
-	(set-syntax-table tex-mode-syntax-table)
-	(while (< char ? )
-	  (modify-syntax-entry char ".")
-	  (setq char (1+ char)))
-	(modify-syntax-entry ?\C-@ "w")
-	(modify-syntax-entry ?\t " ")
-	(modify-syntax-entry ?\n ">")
-	(modify-syntax-entry ?\f ">")
-	(modify-syntax-entry ?$ "$$")
-	(modify-syntax-entry ?% "<")
-	(modify-syntax-entry ?\\ "\\")
-	(modify-syntax-entry ?\" ".")
-	(modify-syntax-entry ?& ".")
-	(modify-syntax-entry ?_ ".")
-	(modify-syntax-entry ?@ "_")
-	(modify-syntax-entry ?~ " ")
-	(modify-syntax-entry ?' "w"))
-    (set-syntax-table tex-mode-syntax-table))
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start "^[ \t]*$\\|^[\f\\\\%]")
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'comment-start)
-  (setq comment-start "%")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "\\(\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'tex-comment-indent)
-  (make-local-variable 'compare-windows-whitespace)
-  (setq compare-windows-whitespace 'tex-categorize-whitespace)
-  (make-local-variable 'tex-command)
-  (make-local-variable 'tex-start-of-header)
-  (make-local-variable 'tex-end-of-header)
-  (make-local-variable 'tex-trailer))
-
-(defun tex-comment-indent ()
-  (if (looking-at "%%%")
-      (current-column)
-    (skip-chars-backward " \t")
-    (max (if (bolp) 0 (1+ (current-column)))
-	 comment-column)))
-
-(defun tex-categorize-whitespace (backward-limit)
-  ;; compare-windows-whitespace is set to this.
-  ;; This is basically a finite-state machine.
-  ;; Returns a symbol telling how TeX would treat
-  ;; the whitespace we are looking at: null, space, or par.
-  (let ((category 'null)
-	(not-finished t))
-    (skip-chars-backward " \t\n\f" backward-limit)
-    (while not-finished
-      (cond ((looking-at "[ \t]+")
-	     (goto-char (match-end 0))
-	     (if (eql category 'null)
-		 (setq category 'space)))
-	    ((looking-at "\n")
-	     (cond ((eql category 'newline)
-		    (setq category 'par)
-		    (setq not-finished nil))
-		   (t
-		    (setq category 'newline) ;a strictly internal state
-		    (goto-char (match-end 0)))))
-	    ((looking-at "\f+")
-	     (setq category 'par)
-	     (setq not-finished nil))
-	    (t
-	     (setq not-finished nil))))
-    (skip-chars-forward " \t\n\f")
-    (if (eql category 'newline)
-	'space				;TeX doesn't distinguish
-      category)))
-
-(defun tex-insert-quote (arg)
-  "Insert the appropriate quote marks for TeX.
-Inserts the value of tex-open-quote (normally ``) or tex-close-quote
-(normally '') depending on the context.  With prefix argument, always
-inserts \" characters."
-  (interactive "*P")
-  (if arg
-      (self-insert-command (prefix-numeric-value arg))
-    (insert
-     (cond ((or (bobp)
-		(save-excursion
-		  (forward-char -1)
-		  (looking-at "\\s(\\|\\s \\|\\s>")))
-	    tex-open-quote)
-	   ((= (preceding-char) ?\\)
-	    ?\")
-	   (t
-	    tex-close-quote)))))
-
-(defun validate-tex-buffer ()
-  "Check current buffer for paragraphs containing mismatched $'s.
-As each such paragraph is found, a mark is pushed at its beginning,
-and the location is displayed for a few seconds."
-  (interactive)
-  (let ((opoint (point)))
-    (goto-char (point-max))
-    ;; Does not use save-excursion
-    ;; because we do not want to save the mark.
-    (unwind-protect
-	(while (and (not (input-pending-p)) (not (bobp)))
-	  (let ((end (point)))
-	    (search-backward "\n\n" nil 'move)
-	    (or (tex-validate-region (point) end)
-		(progn
-		  (push-mark (point))
-		  (message "Mismatch found in pararaph starting here")
-		  (sit-for 4)))))
-      (goto-char opoint))))
-
-(defun tex-validate-region (start end)
-  "Check for mismatched braces or $'s in region.
-Returns t if no mismatches.  Returns nil and moves point to suspect
-area if a mismatch is found."
-  (interactive "r")
-  (let ((failure-point nil) (max-possible-sexps (- end start)))
-    (save-excursion
-      (condition-case ()
-	  (save-restriction
-	    (narrow-to-region start end)
-	    (goto-char start)
-	    (while (< 0 (setq max-possible-sexps (1- max-possible-sexps)))
-	      (forward-sexp 1)))
-	(error
-	  (setq failure-point (point)))))
-    (if failure-point
-	(progn
-	  (goto-char failure-point)
-	  nil)
-      t)))
-
-(defun tex-terminate-paragraph (inhibit-validation)
-  "Insert two newlines, breaking a paragraph for TeX.
-Check for mismatched braces/$'s in paragraph being terminated.
-A prefix arg inhibits the checking."
-  (interactive "*P")
-  (or inhibit-validation
-      (save-excursion
-	(tex-validate-region
-	  (save-excursion
-	    (search-backward "\n\n" nil 'move)
-	    (point))
-	  (point)))
-      (message "Paragraph being closed appears to contain a mismatch"))
-  (insert "\n\n"))
-
-(defun tex-insert-braces ()
-  "Make a pair of braces and be poised to type inside of them."
-  (interactive "*")
-  (insert ?\{)
-  (save-excursion
-    (insert ?})))
-
-;;; Like tex-insert-braces, but for LaTeX.
-(defun tex-latex-block (name)
-  "Creates a matching pair of lines \\begin{NAME} and \\end{NAME} at point.
-Puts point on a blank line between them."
-  (interactive
-   (prog2
-      (barf-if-buffer-read-only)
-      (list
-       (completing-read "LaTeX block name: "
-			(mapcar 'list
-                                (append standard-latex-block-names
-                                        latex-block-names))))))
-  (let ((col (current-column)))
-    (insert (format "\\begin{%s}\n" name))
-    (indent-to col)
-    (save-excursion
-      (insert ?\n)
-      (indent-to col)
-      (insert (format "\\end{%s}" name))
-      (if (eobp) (insert ?\n)))))
-
-(defun tex-last-unended-begin ()
-  "Leave point at the beginning of the last \\begin{...} that is unended."
-  (while (and (re-search-backward "\\(\\\\begin\\s *{\\)\\|\\(\\\\end\\s *{\\)")
-              (looking-at "\\\\end{"))
-    (tex-last-unended-begin)))
-
-(defun tex-close-latex-block ()
-  "Creates an \\end{...} to match the last unclosed \\begin{...}."
-  (interactive "*")
-  (let ((new-line-needed (bolp))
-	text indentation)
-    (save-excursion
-      (condition-case nil
-          (tex-last-unended-begin)
-        (error (error "Couldn't find unended \\begin")))
-      (setq indentation (current-column))
-      (re-search-forward "\\\\begin\\(\\s *{[^}\n]*}\\)")
-      (setq text (buffer-substring (match-beginning 1) (match-end 1))))
-    (indent-to indentation)
-    (insert "\\end" text)
-    (if new-line-needed (insert ?\n))))
-
-;;; Invoking TeX in an inferior shell.
-
-;;; Why use a shell instead of running TeX directly?  Because if TeX
-;;; gets stuck, the user can switch to the shell window and type at it.
-
-;;; The utility functions:
-
-(defun tex-start-shell ()
-  (save-excursion
-    (set-buffer
-     (make-comint
-      "tex-shell"
-      (or tex-shell-file-name (getenv "ESHELL") (getenv "SHELL") "/bin/sh")
-      nil "-v"))
-    (let ((proc (get-process "tex-shell")))
-      (set-process-sentinel proc 'tex-shell-sentinel)
-      (process-kill-without-query proc)
-      (setq tex-shell-map (copy-keymap comint-mode-map))
-      (tex-define-common-keys tex-shell-map)
-      (use-local-map tex-shell-map)
-      (run-hooks 'tex-shell-hook)
-      (while (zerop (buffer-size))
-          (sleep-for 1)))))
-
-(defun tex-shell-sentinel (proc msg)
-  (cond ((null (buffer-name (process-buffer proc)))
-	 ;; buffer killed
-	 (set-process-buffer proc nil)
-         (tex-delete-last-temp-files))
-	((memq (process-status proc) '(signal exit))
-         (tex-delete-last-temp-files))))
-
-(defun tex-set-buffer-directory (buffer directory)
-  "Set BUFFER's default directory to be DIRECTORY."
-  (setq directory (file-name-as-directory (expand-file-name directory)))
-  (if (not (file-directory-p directory))
-      (error "%s is not a directory" directory)
-    (save-excursion
-      (set-buffer buffer)
-      (setq default-directory directory))))
-
-(defun tex-send-command (command &optional file background)
-  "Send COMMAND to tex-shell, substituting optional FILE for *; in background
-if optional BACKGROUND is t.   If COMMAND has no *, FILE will be appended,
-preceded by a blank, to COMMAND.  If FILE is nil, no substitution will be made
-in COMMAND.  COMMAND can be any expression that evaluates to a command string."
-  (save-excursion
-    (let* ((cmd (eval command))
-           (star (string-match "\\*" cmd)))
-      (comint-proc-query (get-process "tex-shell")
-                         (concat (substring cmd 0 star)
-                                 (if file (concat " " file) "")
-                                 (if star (substring cmd (1+ star) nil) "")
-                                 (if background "&\n" "\n"))))))
-
-(defun tex-delete-last-temp-files ()
-  "Delete any junk files from last temp file."
-  (if tex-last-temp-file
-      (let* ((dir (file-name-directory tex-last-temp-file))
-             (list (file-name-all-completions
-                    (file-name-nondirectory tex-last-temp-file) dir)))
-        (while list
-          (delete-file (concat dir (car list)))
-          (setq list (cdr list))))))
-
-(add-hook 'kill-emacs-hook 'tex-delete-last-temp-files)
-
-;;; The commands:
-
-(defun tex-region (beg end)
-  "Run TeX on the current region, via a temporary file.
-The file's name comes from the variable `tex-zap-file' and the
-variable `tex-directory' says where to put it.
-
-If the buffer has a header, the header is given to TeX before the
-region itself.  The buffer's header is all lines between the strings
-defined by `tex-start-of-header' and `tex-end-of-header' inclusive.
-The header must start in the first 100 lines of the buffer.
-
-The value of `tex-trailer' is given to TeX as input after the region.
-
-The value of `tex-command' specifies the command to use to run TeX."
-  (interactive "r")
-  (if (tex-shell-running)
-      (tex-kill-job)
-    (tex-start-shell))
-  (or tex-zap-file
-      (setq tex-zap-file (tex-generate-zap-file-name)))
-  (let* ((temp-buffer (get-buffer-create " TeX-Output-Buffer"))
-         ; Temp file will be written and TeX will be run in zap-directory.
-         ; If the TEXINPUTS file has relative directories or if the region has
-         ; \input of files, this must be the same directory as the file for
-         ; TeX to access the correct inputs.  That's why it's safest if
-         ; tex-directory is ".".
-         (zap-directory
-          (file-name-as-directory (expand-file-name tex-directory)))
-         (tex-out-file (concat zap-directory tex-zap-file)))
-    (tex-delete-last-temp-files)
-    ;; Write the new temp file.
-    (save-excursion
-      (save-restriction
-	(widen)
-	(goto-char (point-min))
-	(forward-line 100)
-	(let ((search-end (point))
-	      (hbeg (point-min)) (hend (point-min))
-	      (default-directory zap-directory))
-	  (goto-char (point-min))
-	  ;; Initialize the temp file with either the header or nothing
-	  (if (search-forward tex-start-of-header search-end t)
-	      (progn
-		(beginning-of-line)
-		(setq hbeg (point))	;mark beginning of header
-		(if (search-forward tex-end-of-header nil t)
-		    (progn (forward-line 1)
-			   (setq hend (point)))	;mark end of header
-		  (setq hbeg (point-min))))) ;no header
-	  (write-region (min hbeg beg) hend
-                        (concat tex-out-file ".tex") nil nil)
-	  (write-region (max beg hend) end (concat tex-out-file ".tex") t nil))
-	(let ((local-tex-trailer tex-trailer))
-	  (set-buffer temp-buffer)
-	  (erase-buffer)
-	  ;; make sure trailer isn't hidden by a comment
-	  (insert ?\n)
-	  (if local-tex-trailer (insert local-tex-trailer))
-	  (tex-set-buffer-directory temp-buffer zap-directory)
-	  (write-region (point-min) (point-max)
-                        (concat tex-out-file ".tex") t nil))))
-    ;; Record the file name to be deleted afterward.
-    (setq tex-last-temp-file tex-out-file)
-    (tex-send-command tex-shell-cd-command zap-directory)
-    (tex-send-command tex-command tex-out-file)
-    (setq tex-print-file tex-out-file)
-    (setq tex-last-buffer-texed (current-buffer))))
-
-(defun tex-buffer ()
-  "Run TeX on current buffer.  See \\[tex-region] for more information.
-Does not save the buffer, so it's useful for trying experimental versions.
-See \\[tex-file] for an alternative."
-  (interactive)
-  (tex-region (point-min) (point-max)))
-
-(defun tex-file ()
-  "Prompt to save all buffers and run TeX (or LaTeX) on current buffer's file.
-This function is more useful than \\[tex-buffer] when you need the
-`.aux' file of LaTeX to have the correct name."
-  (interactive)
-  (let ((tex-out-file
-         (if (buffer-file-name)
-             (file-name-nondirectory (buffer-file-name))
-           (error "Buffer does not seem to be associated with any file")))
-	(file-dir (file-name-directory (buffer-file-name))))
-    (save-some-buffers)
-    (if (tex-shell-running)
-        (tex-kill-job)
-      (tex-start-shell))
-    (tex-send-command tex-shell-cd-command file-dir)
-    (tex-send-command tex-command tex-out-file))
-  (setq tex-last-buffer-texed (current-buffer))
-  (setq tex-print-file (buffer-file-name)))
-
-(defun tex-generate-zap-file-name ()
-  "Generate a unique name suitable for use as a file name."
-  ;; Include the shell process number and host name
-  ;; in case there are multiple shells (for same or different user).
-  (format "#tz%d%s"
-          (process-id (get-buffer-process "*tex-shell*"))
-	  (tex-strip-dots (system-name))))
-
-(defun tex-strip-dots (s)
-  (setq s (copy-sequence s))
-  (while (string-match "\\." s)
-    (aset s (match-beginning 0) ?-))
-  s)
-
-;; This will perhaps be useful for modifying TEXINPUTS.
-;; Expand each file name, separated by colons, in the string S.
-(defun tex-expand-files (s)
-  (let (elts (start 0))
-    (while (string-match ":" s start)
-      (setq elts (cons (substring s start (match-beginning 0)) elts))
-      (setq start (match-end 0)))
-    (or (= start 0)
-	(setq elts (cons (substring s start) elts)))
-    (mapconcat 'expand-file-name (nreverse elts) ":")))
-
-(defun tex-shell-running ()
-  (and (get-process "tex-shell")
-       (eq (process-status (get-process "tex-shell")) 'run)))
-
-(defun tex-kill-job ()
-  "Kill the currently running TeX job."
-  (interactive)
-  (quit-process (get-process "tex-shell") t))
-
-(defun tex-recenter-output-buffer (linenum)
-  "Redisplay buffer of TeX job output so that most recent output can be seen.
-The last line of the buffer is displayed on
-line LINE of the window, or centered if LINE is nil."
-  (interactive "P")
-  (let ((tex-shell (get-buffer "*tex-shell*"))
-	(old-buffer (current-buffer)))
-    (if (null tex-shell)
-	(message "No TeX output buffer")
-      (pop-to-buffer tex-shell)
-      (bury-buffer tex-shell)
-      (goto-char (point-max))
-      (recenter (if linenum
-		    (prefix-numeric-value linenum)
-		  (/ (window-height) 2)))
-      (pop-to-buffer old-buffer))))
-
-(defun tex-print (&optional alt)
-  "Print the .dvi file made by \\[tex-region], \\[tex-buffer] or \\[tex-file].
-Runs the shell command defined by tex-dvi-print-command.  If prefix argument
-is provided, use the alternative command, tex-alt-dvi-print-command."
-  (interactive "P")
-  (let ((print-file-name-dvi (tex-append tex-print-file ".dvi"))
-	test-name)
-    (if (and (not (equal (current-buffer) tex-last-buffer-texed))
-	     (file-newer-than-file-p
-	      (setq test-name (tex-append (buffer-file-name) ".dvi"))
-	      print-file-name-dvi))
-	(setq print-file-name-dvi test-name))
-    (if (not (file-exists-p print-file-name-dvi))
-        (error "No appropriate `.dvi' file could be found")
-      (tex-send-command
-        (if alt tex-alt-dvi-print-command tex-dvi-print-command)
-        print-file-name-dvi t))))
-
-(defun tex-view ()
-  "Preview the last `.dvi' file made by running TeX under Emacs.
-This means, made using \\[tex-region], \\[tex-buffer] or \\[tex-file].
-The variable `tex-dvi-view-command' specifies the shell command for preview."
-  (interactive)
-  (let ((tex-dvi-print-command tex-dvi-view-command))
-    (tex-print)))
-
-(defun tex-append (file-name suffix)
-  "Append to FILENAME the suffix SUFFIX, using same algorithm TeX uses.
-Scans for the first (not last) period.
-No period is retained immediately before SUFFIX,
-so normally SUFFIX starts with one."
-  (if (stringp file-name)
-      (let ((file (file-name-nondirectory file-name)))
-	(concat (file-name-directory file-name)
-		(substring file 0
-			   (string-match "\\." file))
-		suffix))
-    " "))
-
-(defun tex-show-print-queue ()
-  "Show the print queue that \\[tex-print] put your job on.
-Runs the shell command defined by tex-show-queue-command."
-  (interactive)
-  (if (tex-shell-running)
-      (tex-kill-job)
-    (tex-start-shell))
-  (tex-send-command tex-show-queue-command))
-
-(defun tex-bibtex-file ()
-  "Run BibTeX on the current buffer's file."
-  (interactive)
-  (if (tex-shell-running)
-      (tex-kill-job)
-    (tex-start-shell))
-  (let ((tex-out-file
-         (tex-append (file-name-nondirectory (buffer-file-name)) ""))
-	(file-dir (file-name-directory (buffer-file-name))))
-    (tex-send-command tex-shell-cd-command file-dir)
-    (tex-send-command bibtex-command tex-out-file)))
-
-(run-hooks 'tex-mode-load-hook)
-
-;; XEmacs additions
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.ltx\\'" . latex-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.[tT]e[xX]\\'" . tex-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.\\(?:sty\\|cls\\|bbl\\)\\'" . latex-mode))
-
-(provide 'tex-mode)
diff --git a/xemacs-packages/lisp/texinfo/texinfmt.el b/xemacs-packages/lisp/texinfo/texinfmt.el
deleted file mode 100644
index 6841a74c..00000000
--- a/xemacs-packages/lisp/texinfo/texinfmt.el
+++ /dev/null
@@ -1,4426 +0,0 @@
-;;; texinfmt.el --- format Texinfo files into Info files
-
-;; Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993,
-;;               1994, 1995, 1996, 1997, 1998, 2000, 2001
-;;    Free Software Foundation, Inc.
-
-;; Maintainer: Robert J. Chassell <bug-texinfo@gnu.org>
-;; Keywords: maint, tex, docs
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;; XEmacs Maintainers note:
-;; This file is should be kept strictly in synch.  The only differences
-;; should be due to whitespace (the author doesn't believe in TABs)
-;; other than the VM manual fuckage.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'whitespace)
-
-;;; Emacs lisp functions to convert Texinfo files to Info files.
-
-(or (fboundp 'defgroup)
-    (defmacro defgroup (&rest ignore) nil))
-
-(or (fboundp 'defcustom)
-    (defmacro defcustom (var value doc &rest ignore)
-      `(defvar ,var ,value ,doc)))
-
-(defvar texinfmt-version "2.41 of  1 Mar 2005")
-
-(or (fboundp 'match-string-no-properties) ;; XEmacs: not in 21.4
-(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))))))
-
-(defvar texinfmt-version "2.40 of  6 Dec 2002")
-
-(defun texinfmt-version (&optional here)
-  "Show the version of texinfmt.el in the minibuffer.
-If optional argument HERE is non-nil, insert info at point."
-  (interactive "P")
-  (let ((version-string
-         (format "Version of \`texinfmt.el\': %s" texinfmt-version)))
-    (if here
-        (insert version-string)
-      (if (interactive-p)
-          (message "%s" version-string)
-        version-string))))
-
-;;; Variable definitions
-
-(require 'texinfo)          ; So `texinfo-footnote-style' is defined.
-(require 'texnfo-upd)       ; So `texinfo-section-types-regexp' is defined.
-
-(defvar texinfo-format-syntax-table nil)
-
-(defvar texinfo-vindex)
-(defvar texinfo-findex)
-(defvar texinfo-cindex)
-(defvar texinfo-pindex)
-(defvar texinfo-tindex)
-(defvar texinfo-kindex)
-(defvar texinfo-last-node)
-(defvar texinfo-node-names)
-(defvar texinfo-enclosure-list)
-(defvar texinfo-alias-list)
-(defvar texinfo-fold-nodename-case nil)
-
-(defvar texinfo-command-start)
-(defvar texinfo-command-end)
-(defvar texinfo-command-name)
-(defvar texinfo-defun-type)
-(defvar texinfo-last-node-pos)
-(defvar texinfo-stack)
-(defvar texinfo-short-index-cmds-alist)
-(defvar texinfo-short-index-format-cmds-alist)
-(defvar texinfo-format-filename)
-(defvar texinfo-footnote-number)
-(defvar texinfo-start-of-header)
-(defvar texinfo-end-of-header)
-(defvar texinfo-raisesections-alist)
-(defvar texinfo-lowersections-alist)
-
-;;; Syntax table
-
-(if texinfo-format-syntax-table
-    nil
-  (setq texinfo-format-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\" " " texinfo-format-syntax-table)
-  (modify-syntax-entry ?\\ " " texinfo-format-syntax-table)
-  (modify-syntax-entry ?@ "\\" texinfo-format-syntax-table)
-  (modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table)
-  (modify-syntax-entry ?\[ "." texinfo-format-syntax-table)
-  (modify-syntax-entry ?\] "." texinfo-format-syntax-table)
-  (modify-syntax-entry ?\( "." texinfo-format-syntax-table)
-  (modify-syntax-entry ?\) "." texinfo-format-syntax-table)
-  (modify-syntax-entry ?{ "(}" texinfo-format-syntax-table)
-  (modify-syntax-entry ?} "){" texinfo-format-syntax-table)
-  (modify-syntax-entry ?\' "." texinfo-format-syntax-table))
-
-
-;;; Top level buffer and region formatting functions
-
-;;;###autoload
-(defun texinfo-format-buffer (&optional nosplit)
-  "Process the current buffer as texinfo code, into an Info file.
-The Info file output is generated in a buffer visiting the Info file
-name specified in the @setfilename command.
-
-Non-nil argument (prefix, if interactive) means don't make tag table
-and don't split the file if large.  You can use Info-tagify and
-Info-split to do these manually."
-  (interactive "P")
-  (let ((lastmessage "Formatting Info file...")
-	;; XEmacs change removed here 2005-09-25.
-	(coding-system-for-write buffer-file-coding-system))
-    (message lastmessage)
-    (widen)
-    (texinfo-format-buffer-1)
-    (Info-tagify)
-    (if nosplit
-        nil
-      (if (> (buffer-size) 100000)
-          (progn
-            (message (setq lastmessage "Splitting Info file..."))
-            (Info-split))))
-    (message (concat lastmessage
-                     (if (interactive-p) "done.  Now save it." "done.")))))
-
-(defvar texinfo-region-buffer-name "*Info Region*"
-  "*Name of the temporary buffer used by \\[texinfo-format-region].")
-
-(defvar texinfo-pre-format-hook nil
-  "Hook called before the conversion of the Texinfo file to Info format.
-The functions on this hook are called with argument BUFFER, the buffer
-containing the Texinfo file.")
-
-;; These come from tex-mode.el.
-(defvar tex-start-of-header)
-(defvar tex-end-of-header)
-
-;;;###autoload
-(defun texinfo-format-region (region-beginning region-end)
-  "Convert the current region of the Texinfo file to Info format.
-This lets you see what that part of the file will look like in Info.
-The command is bound to \\[texinfo-format-region].  The text that is
-converted to Info is stored in a temporary buffer."
-  (interactive "r")
-  (message "Converting region to Info format...")
-  (let (texinfo-command-start
-        texinfo-command-end
-        texinfo-command-name
-        texinfo-vindex
-        texinfo-findex
-        texinfo-cindex
-        texinfo-pindex
-        texinfo-tindex
-        texinfo-kindex
-        texinfo-stack
-        (texinfo-format-filename "")
-        texinfo-example-start
-        texinfo-last-node-pos
-        texinfo-last-node
-        texinfo-node-names
-        (texinfo-footnote-number 0)
-        last-input-buffer
-        (fill-column-for-info fill-column)
-        (input-buffer (current-buffer))
-        (input-directory default-directory)
-        (header-text "")
-        (header-beginning 1)
-        (header-end 1))
-
-;;; Copy lines between beginning and end of header lines,
-;;;    if any, or else copy the `@setfilename' line, if any.
-    (save-excursion
-        (save-restriction
-          (widen)
-          (goto-char (point-min))
-          (let ((search-end (save-excursion (forward-line 100) (point))))
-            (if (or
-                 ;; Either copy header text.
-                 (and
-                  (prog1
-                      (search-forward tex-start-of-header search-end t)
-                    (forward-line 1)
-                    ;; Mark beginning of header.
-                    (setq header-beginning (point)))
-                  (prog1
-                      (search-forward tex-end-of-header nil t)
-                    (beginning-of-line)
-                    ;; Mark end of header
-                    (setq header-end (point))))
-                 ;; Or copy @filename line.
-                 (prog2
-                  (goto-char (point-min))
-                  (search-forward "@setfilename" search-end t)
-                  (beginning-of-line)
-                  (setq header-beginning (point))
-                  (forward-line 1)
-                  (setq header-end (point))))
-
-                ;; Copy header
-                (setq header-text
-                      (buffer-substring-no-properties
-                       (min header-beginning region-beginning)
-                       header-end))))))
-
-;;; Find a buffer to use.
-    (switch-to-buffer (get-buffer-create texinfo-region-buffer-name))
-    (erase-buffer)
-    ;; Insert the header into the buffer.
-    (insert header-text)
-    ;; Insert the region into the buffer.
-    (insert-buffer-substring
-     input-buffer
-     (max region-beginning header-end)
-     region-end)
-    (run-hook-with-args 'texinfo-pre-format-hook input-buffer)
-    ;; Make sure region ends in a newline.
-    (or (= (preceding-char) ?\n)
-        (insert "\n"))
-
-    (goto-char (point-min))
-    ;; XEmacs change
-    ;; Remove trailing WS like makeinfo does
-    ;; Adrian Aichner
-;;;    (unless (equal texinfo-paragraph-indent "asis")
-    (save-excursion
-      (message "Removing trailing whitespace from Info region...")
-      (while (re-search-forward "[ \t]+$" nil t)
-        (replace-match "" nil nil)))
-;;;      )
-    (texinfo-mode)
-    (message "Converting region to Info format...")
-    (setq fill-column fill-column-for-info)
-    ;; Install a syntax table useful for scanning command operands.
-    (set-syntax-table texinfo-format-syntax-table)
-
-    ;; Insert @include files so `texinfo-raise-lower-sections' can
-    ;; work on them without losing track of multiple
-    ;; @raise/@lowersections commands.
-    (while (re-search-forward "^@include" nil t)
-      (setq texinfo-command-end (point))
-      (let ((filename (concat input-directory
-                              (texinfo-parse-line-arg))))
-        (re-search-backward "^@include")
-        (delete-region (point) (save-excursion (forward-line 1) (point)))
-        (message "Reading included file: %s" filename)
-        (save-excursion
-          (save-restriction
-            (narrow-to-region
-             (point)
-             (+ (point) (car (cdr (insert-file-contents filename)))))
-            (goto-char (point-min))
-            ;; Remove `@setfilename' line from included file, if any,
-            ;; so @setfilename command not duplicated.
-            (if (re-search-forward "^@setfilename" (point-at-eol 100) t)
-		(delete-region (point-at-bol 1)
-			       (point-at-bol 2)))))))
-
-    ;; Raise or lower level of each section, if necessary.
-    (goto-char (point-min))
-    (texinfo-raise-lower-sections)
-    ;; Append @refill to appropriate paragraphs for filling.
-    (goto-char (point-min))
-    (texinfo-append-refill)
-    ;; If the region includes the effective end of the data,
-    ;; discard everything after that.
-    (goto-char (point-max))
-    (if (re-search-backward "^@bye" nil t)
-        (delete-region (point) (point-max)))
-    ;; Make sure buffer ends in a newline.
-    (or (= (preceding-char) ?\n)
-        (insert "\n"))
-    ;; Don't use a previous value of texinfo-enclosure-list.
-    (setq texinfo-enclosure-list nil)
-    (setq texinfo-alias-list nil)
-
-    (goto-char (point-min))
-    (if (looking-at "\\\\input[ \t]+texinfo")
-        (delete-region (point) (point-at-bol 2)))
-
-    ;; Insert Info region title text.
-    (goto-char (point-min))
-    (if (search-forward
-         "@setfilename" (save-excursion (forward-line 100) (point)) t)
-        (progn
-          (setq texinfo-command-end (point))
-          (beginning-of-line)
-          (setq texinfo-command-start (point))
-          (let ((arg (texinfo-parse-arg-discard)))
-            (insert " "
-              texinfo-region-buffer-name
-              " buffer for:  `")
-            (insert (file-name-nondirectory (expand-file-name arg)))
-            (insert "',        -*-Text-*-\n")))
-      ;; Else no `@setfilename' line
-      (insert " "
-              texinfo-region-buffer-name
-              " buffer                       -*-Text-*-\n"))
-    (insert "produced by `texinfo-format-region'\n"
-            "from a region in: "
-            (if (buffer-file-name input-buffer)
-                  (concat "`"
-                          (file-name-sans-versions
-                           (file-name-nondirectory
-                            (buffer-file-name input-buffer)))
-                          "'")
-                (concat "buffer `" (buffer-name input-buffer) "'"))
-              "\nusing `texinfmt.el' version "
-              texinfmt-version
-              ".\n\n")
-
-    ;; Now convert for real.
-    (goto-char (point-min))
-    (texinfo-format-scan)
-    (goto-char (point-min))
-    (Info-tagify input-buffer)
-    (goto-char (point-min))
-    (message "Done.")))
-
-;;;###autoload
-(defun texi2info (&optional nosplit)
-  "Convert the current buffer (written in Texinfo code) into an Info file.
-The Info file output is generated in a buffer visiting the Info file
-names specified in the @setfilename command.
-
-This function automatically updates all node pointers and menus, and
-creates a master menu.  This work is done on a temporary buffer that
-is automatically removed when the Info file is created.  The original
-Texinfo source buffer is not changed.
-
-Non-nil argument (prefix, if interactive) means don't split the file
-if large.  You can use Info-split to do this manually."
-  (interactive "P")
-  (let ((temp-buffer (concat  "*--" (buffer-name) "--temporary-buffer*" )))
-    (message "First updating nodes and menus, then creating Info file.")
-    ;;  (sit-for 2)
-    (copy-to-buffer temp-buffer (point-min) (point-max))
-    (switch-to-buffer temp-buffer)
-    (texinfo-master-menu t)
-    (message "Now creating Info file.")
-    (sit-for 2)
-    (texinfo-format-buffer nosplit)
-    (save-buffer)
-    (kill-buffer temp-buffer)))
-
-
-;;; Primary internal formatting function for the whole buffer.
-
-(defun texinfo-format-buffer-1 ()
-  (let (texinfo-format-filename
-        texinfo-example-start
-        texinfo-command-start
-        texinfo-command-end
-        texinfo-command-name
-        texinfo-last-node
-        texinfo-last-node-pos
-        texinfo-vindex
-        texinfo-findex
-        texinfo-cindex
-        texinfo-pindex
-        texinfo-tindex
-        texinfo-kindex
-        texinfo-stack
-        texinfo-node-names
-        (texinfo-footnote-number 0)
-        last-input-buffer
-        outfile
-        (fill-column-for-info fill-column)
-        (input-buffer (current-buffer))
-        (input-directory default-directory))
-    (setq texinfo-enclosure-list nil)
-    (setq texinfo-alias-list nil)
-    (save-excursion
-      (goto-char (point-min))
-      (or (search-forward "@setfilename" nil t)
-          (error "Texinfo file needs an `@setfilename FILENAME' line"))
-      (setq texinfo-command-end (point))
-      (setq outfile (texinfo-parse-line-arg)))
-
-    (find-file outfile)
-    (texinfo-mode)
-    (erase-buffer)
-    (buffer-disable-undo)
-
-    (message "Formatting Info file: %s" outfile)
-    (setq texinfo-format-filename
-          (file-name-nondirectory (expand-file-name outfile)))
-
-    (setq fill-column fill-column-for-info)
-    (set-syntax-table texinfo-format-syntax-table)
-
-    (insert-buffer-substring input-buffer)
-    (run-hook-with-args 'texinfo-pre-format-hook input-buffer)
-    (message "Converting %s to Info format..." (buffer-name input-buffer))
-
-    ;; Insert @include files so `texinfo-raise-lower-sections' can
-    ;; work on them without losing track of multiple
-    ;; @raise/@lowersections commands.
-    (goto-char (point-min))
-    ;; XEmacs change.
-    ;; Remove trailing WS like makeinfo does
-    ;; Adrian Aichner
-;;;    (unless (equal texinfo-paragraph-indent "asis")
-    (save-excursion
-      (message "Removing trailing whitespace from Info buffer...")
-      (while (re-search-forward "[ \t]+$" nil t)
-        (replace-match "" nil nil)))
-;;;      )
-    (while (re-search-forward "^@include" nil t)
-      (setq texinfo-command-end (point))
-      (let ((filename (concat input-directory
-                              (texinfo-parse-line-arg))))
-        (re-search-backward "^@include")
-        (delete-region (point) (point-at-bol 2))
-        (message "Reading included file: %s" filename)
-        (save-excursion
-          (save-restriction
-            (narrow-to-region
-             (point)
-             (+ (point) (car (cdr (insert-file-contents filename)))))
-            (goto-char (point-min))
-            ;; Remove `@setfilename' line from included file, if any,
-            ;; so @setfilename command not duplicated.
-            (if (re-search-forward "^@setfilename" (point-at-eol 100) t)
-		(delete-region (point-at-bol 1)
-			       (point-at-bol 2)))))))
-    ;; Raise or lower level of each section, if necessary.
-    (goto-char (point-min))
-    (texinfo-raise-lower-sections)
-    ;; Append @refill to appropriate paragraphs
-    (goto-char (point-min))
-    (texinfo-append-refill)
-    (goto-char (point-min))
-    (search-forward "@setfilename")
-    (beginning-of-line)
-    (delete-region (point-min) (point))
-    ;; Remove @bye at end of file, if it is there.
-    (goto-char (point-max))
-    (if (search-backward "@bye" nil t)
-        (delete-region (point) (point-max)))
-    ;; Make sure buffer ends in a newline.
-    (or (= (preceding-char) ?\n)
-        (insert "\n"))
-    ;; Scan the whole buffer, converting to Info format.
-    (texinfo-format-scan)
-    (goto-char (point-min))
-    ;; Insert info about how this file was made.
-    (insert "Info file: "
-            texinfo-format-filename ",    -*-Text-*-\n"
-            "produced by `texinfo-format-buffer'\n"
-            ;; Date string removed so that regression testing is easier.
-            ;; "on "
-            ;; (insert (format-time-string "%e %b %Y")) " "
-            "from file"
-            (if (buffer-file-name input-buffer)
-                (concat " `"
-                        (file-name-sans-versions
-                         (file-name-nondirectory
-                          (buffer-file-name input-buffer)))
-                        "'")
-              (concat "buffer `" (buffer-name input-buffer) "'"))
-            "\nusing `texinfmt.el' version "
-            texinfmt-version
-            ".\n\n")
-    ;; Return data for indices.
-    (list outfile
-          texinfo-vindex texinfo-findex texinfo-cindex
-          texinfo-pindex texinfo-tindex texinfo-kindex)))
-
-
-;;; Perform non-@-command file conversions: quotes and hyphens
-
-(defun texinfo-format-convert (min max)
-  ;; Convert left and right quotes to typewriter font quotes.
-  (goto-char min)
-  (while (search-forward "``" max t)
-    (replace-match "\""))
-  (goto-char min)
-  (while (search-forward "''" max t)
-    (replace-match "\""))
-  ;; Convert three hyphens in a row to two.
-  (goto-char min)
-  ;; XEmacs change.
-  (while (re-search-forward "\\( \\|\\w\\)\\(---\\)\\( \\|\\w\\|\n\\)" max t)
-    (delete-region (1+ (match-beginning 2)) (+ 2 (match-beginning 2)))))
-
-
-;;; Handle paragraph filling
-
-;; Keep as concatinated lists for ease of maintenance
-
-(defvar texinfo-no-refill-regexp
-  (concat
-   "^@"
-   "\\("
-   ;; add "itemize\\|"   (from experiment of 2001 Nov 28)
-   ;;     because of a problem with @end itemize@refill
-   ;;     I don't know if this causes other problems.
-   ;;     I suspect itemized lists don't get filled properly and a
-   ;;     more precise fix is required.  Bob
-   "itemize\\|"
-   "direntry\\|"
-   "lisp\\|"
-   "smalllisp\\|"
-   "example\\|"
-   "smallexample\\|"
-   "display\\|"
-   "smalldisplay\\|"
-   "format\\|"
-   "smallformat\\|"
-   "flushleft\\|"
-   "flushright\\|"
-   "menu\\|"
-   "multitable\\|"
-   "titlepage\\|"
-   "iftex\\|"
-   "ifhtml\\|"
-   "tex\\|"
-   "html"
-   "\\)")
-  "Regexp specifying environments in which paragraphs are not filled.")
-
-(defvar texinfo-accent-commands
-  (concat
-   "@^\\|"
-   "@`\\|"
-   "@'\\|"
-   "@\"\\|"
-   "@,\\|"
-   "@=\\|"
-   "@~\\|"
-   "@OE{\\|"
-   "@oe{\\|"
-   "@AA{\\|"
-   "@aa{\\|"
-   "@AE{\\|"
-   "@ae{\\|"
-   "@ss{\\|"
-   "@questiondown{\\|"
-   "@exclamdown{\\|"
-   "@L{\\|"
-   "@l{\\|"
-   "@O{\\|"
-   "@o{\\|"
-   "@dotaccent{\\|"
-   "@ubaraccent{\\|"
-   "@d{\\|"
-   "@H{\\|"
-   "@ringaccent{\\|"
-   "@tieaccent{\\|"
-   "@u{\\|"
-   "@v{\\|"
-   "@dotless{"
-   ))
-
-(defvar texinfo-part-of-para-regexp
-  (concat
-   "^@"
-   "\\("
-   "b{\\|"
-   "bullet{\\|"
-   "cite{\\|"
-   "code{\\|"
-   "email{\\|"
-   "emph{\\|"
-   "equiv{\\|"
-   "error{\\|"
-   "expansion{\\|"
-   "file{\\|"
-   "i{\\|"
-   "inforef{\\|"
-   "kbd{\\|"
-   "key{\\|"
-   "lisp{\\|"
-   "minus{\\|"
-   "point{\\|"
-   "print{\\|"
-   "pxref{\\|"
-   "r{\\|"
-   "ref{\\|"
-   "result{\\|"
-   "samp{\\|"
-   "sc{\\|"
-   "t{\\|"
-   "TeX{\\|"
-   "today{\\|"
-   ;; XEmacs change.
-   "uref{\\|"
-   "url{\\|"
-   "var{\\|"
-   "w{\\|"
-   "xref{\\|"
-   "@-\\|"    ; @- is a descretionary hyphen (not an accent) (a noop).
-   texinfo-accent-commands
-   "\\)"
-   )
-  "Regexp specifying @-commands found within paragraphs.")
-
-(defun texinfo-append-refill ()
-  "Append @refill at end of each paragraph that should be filled.
-Do not append @refill to paragraphs within @example and similar environments.
-Do not append @refill to paragraphs containing @w{TEXT} or @*."
-
-  ;; It is necessary to append @refill before other processing because
-  ;; the other processing removes information that tells Texinfo
-  ;; whether the text should or should not be filled.
-
-  (while (< (point) (point-max))
-    (let ((refill-blank-lines "^[ \t\n]*$")
-          (case-fold-search nil))       ; Don't confuse @TeX and @tex....
-      (beginning-of-line)
-      ;; 1. Skip over blank lines;
-      ;;    skip over lines beginning with @-commands,
-      ;;    but do not skip over lines
-      ;;      that are no-refill environments such as @example or
-      ;;      that begin with within-paragraph @-commands such as @code.
-      (while (and (looking-at (concat "^@\\|^\\\\\\|" refill-blank-lines))
-                  (not (looking-at
-                        (concat
-                         "\\("
-                         texinfo-no-refill-regexp
-                         "\\|"
-                         texinfo-part-of-para-regexp
-                         "\\)")))
-                  (< (point) (point-max)))
-        (forward-line 1))
-      ;; 2. Skip over @example and similar no-refill environments.
-      (if (looking-at texinfo-no-refill-regexp)
-          (let ((environment (match-string-no-properties 1)))
-            (progn (re-search-forward (concat "^@end " environment) nil t)
-                   (forward-line 1)))
-        ;; Else
-        ;; 3. Do not refill a paragraph containing @w or @*, or ending
-        ;;    with @<newline> followed by a newline.
-        (if  (or (>= (point) (point-max))
-		 (re-search-forward
-		  "@w{\\|@\\*\\|@\n\n"
-		  (save-excursion (forward-paragraph) (forward-line 1) (point))
-		  t))
-            ;; Go to end of paragraph and do nothing.
-            (forward-paragraph)
-          ;; 4. Else go to end of paragraph and insert @refill
-          (forward-paragraph)
-          (forward-line -1)
-	  (let ((line-beg (point)))
-	    (end-of-line)
-	    (delete-region
-	     (point)
-	     (save-excursion (skip-chars-backward " \t") (point)))
-	    (forward-char 1)
-	    (unless (re-search-backward "@c[ \t\n]\\|@comment[ \t\n]" line-beg t)
-	      (forward-char -1))
-	    (unless (re-search-backward "@refill\\|^[ \t]*@" line-beg t)
-	      (insert "@refill")))
-          (forward-line 1))))))
-
-
-;;; Handle `@raisesections' and `@lowersections' commands
-
-;; These commands change the hierarchical level of chapter structuring
-;; commands.
-;;
-;; @raisesections changes @subsection to @section,
-;;                        @section    to @chapter,
-;;                        etc.
-;;
-;; @lowersections changes @chapter    to @section
-;;                        @subsection to @subsubsection,
-;;                        etc.
-;;
-;; An @raisesections/@lowersections command changes only those
-;; structuring commands that follow the @raisesections/@lowersections
-;; command.
-;;
-;; Repeated @raisesections/@lowersections continue to raise or lower
-;; the heading level.
-;;
-;; An @lowersections command cancels an @raisesections command, and
-;; vice versa.
-;;
-;; You cannot raise or lower "beyond" chapters or subsubsections, but
-;; trying to do so does not elicit an error---you just get more
-;; headings that mean the same thing as you keep raising or lowering
-;; (for example, after a single @raisesections, both @chapter and
-;; @section produce chapter headings).
-
-(defun texinfo-raise-lower-sections ()
-  "Raise or lower the hierarchical level of chapters, sections, etc.
-
-This function acts according to `@raisesections' and `@lowersections'
-commands in the Texinfo file.
-
-For example, an `@lowersections' command is useful if you wish to
-include what is written as an outer or standalone Texinfo file in
-another Texinfo file as an inner, included file.  The `@lowersections'
-command changes chapters to sections, sections to subsections and so
-on.
-
-@raisesections changes @subsection to @section,
-                       @section    to @chapter,
-                       @heading    to @chapheading,
-                       etc.
-
-@lowersections changes @chapter    to @section,
-                       @subsection to @subsubsection,
-                       @heading    to @subheading,
-                       etc.
-
-An `@raisesections' or `@lowersections' command changes only those
-structuring commands that follow the `@raisesections' or
-`@lowersections' command.
-
-An `@lowersections' command cancels an `@raisesections' command, and
-vice versa.
-
-Repeated use of the commands continue to raise or lower the hierarchical
-level a step at a time.
-
-An attempt to raise above `chapters' reproduces chapter commands; an
-attempt to lower below subsubsections reproduces subsubsection
-commands."
-
-  ;; `texinfo-section-types-regexp' is defined in `texnfo-upd.el';
-  ;; it is a regexp matching chapter, section, other headings
-  ;; (but not the top node).
-
-  (let (type (level 0))
-    (while
-        (re-search-forward
-         (concat
-          "\\(\\(^@\\(raise\\|lower\\)sections\\)\\|\\("
-          texinfo-section-types-regexp
-          "\\)\\)")
-         nil t)
-      (beginning-of-line)
-      (save-excursion (setq type (read (current-buffer))))
-      (cond
-
-       ;; 1. Increment level
-       ((eq type '@raisesections)
-        (setq level (1+ level))
-        (delete-region
-         (point) (save-excursion (forward-line 1) (point))))
-
-       ;; 2. Decrement level
-       ((eq type '@lowersections)
-        (setq level (1- level))
-        (delete-region
-         (point) (save-excursion (forward-line 1) (point))))
-
-       ;; Now handle structuring commands
-       ((cond
-
-         ;; 3. Raise level when positive
-         ((> level 0)
-          (let ((count level)
-                (new-level type))
-            (while (> count 0)
-              (setq new-level
-                    (cdr (assq new-level texinfo-raisesections-alist)))
-              (setq count (1- count)))
-            (kill-word 1)
-            (insert (symbol-name new-level))))
-
-         ;; 4. Do nothing except move point when level is zero
-         ((= level 0) (forward-line 1))
-
-         ;; 5. Lower level when positive
-         ((< level 0)
-          (let ((count level)
-                (new-level type))
-            (while (< count 0)
-              (setq new-level
-                    (cdr (assq new-level texinfo-lowersections-alist)))
-              (setq count (1+ count)))
-            (kill-word 1)
-            (insert (symbol-name new-level))))))))))
-
-(defvar texinfo-raisesections-alist
-  '((@chapter . @chapter)             ; Cannot go higher
-    (@unnumbered . @unnumbered)
-    (@centerchap . @unnumbered)
-
-    (@majorheading . @majorheading)
-    (@chapheading . @chapheading)
-    (@appendix . @appendix)
-
-    (@section . @chapter)
-    (@unnumberedsec . @unnumbered)
-    (@heading . @chapheading)
-    (@appendixsec . @appendix)
-
-    (@subsection . @section)
-    (@unnumberedsubsec . @unnumberedsec)
-    (@subheading . @heading)
-    (@appendixsubsec . @appendixsec)
-
-    (@subsubsection . @subsection)
-    (@unnumberedsubsubsec . @unnumberedsubsec)
-    (@subsubheading . @subheading)
-    (@appendixsubsubsec . @appendixsubsec))
-  "*An alist of next higher levels for chapters, sections. etc.
-For example, section to chapter, subsection to section.
-Used by `texinfo-raise-lower-sections'.
-The keys specify types of section; the values correspond to the next
-higher types.")
-
-(defvar texinfo-lowersections-alist
-  '((@chapter . @section)
-    (@unnumbered . @unnumberedsec)
-    (@centerchap . @unnumberedsec)
-    (@majorheading . @heading)
-    (@chapheading . @heading)
-    (@appendix . @appendixsec)
-
-    (@section . @subsection)
-    (@unnumberedsec . @unnumberedsubsec)
-    (@heading . @subheading)
-    (@appendixsec . @appendixsubsec)
-
-    (@subsection . @subsubsection)
-    (@unnumberedsubsec . @unnumberedsubsubsec)
-    (@subheading . @subsubheading)
-    (@appendixsubsec . @appendixsubsubsec)
-
-    (@subsubsection . @subsubsection) ; Cannot go lower.
-    (@unnumberedsubsubsec . @unnumberedsubsubsec)
-    (@subsubheading . @subsubheading)
-    (@appendixsubsubsec . @appendixsubsubsec))
-  "*An alist of next lower levels for chapters, sections. etc.
-For example, chapter to section, section to subsection.
-Used by `texinfo-raise-lower-sections'.
-The keys specify types of section; the values correspond to the next
-lower types.")
-
-
-;;; Perform those texinfo-to-info conversions that apply to the whole input
-;;; uniformly.
-
-(defun texinfo-format-scan ()
-  (texinfo-format-convert (point-min) (point-max))
-  ;; Search for @copying, which has to be first since the
-  ;; @insertcopying command then inserts the text elsewhere.
-  (goto-char (point-min))
-  (when (search-forward "@copying" nil t)
-    (texinfo-copying))
-  (while (search-forward "@insertcopying" nil t)
-    (delete-region (match-beginning 0) (match-end 0))
-
-    (texinfo-insertcopying))
-  ;; Scan for other @-commands.
-  (goto-char (point-min))
-  (while (search-forward "@" nil t)
-    ;;
-    ;; These are the single-character accent commands: @^ @` @' @" @= @~
-    ;; In Info, they are simply quoted and the @ deleted.
-    ;; Other single-character commands:
-    ;; @* forces a line break,
-    ;; @- is a discretionary hyphenation point; does nothing in Info.
-    ;; @<space>, @<tab>, @<newline> each produce a single space,
-    ;;    unless followed by a newline.
-    ;;
-    ;; Old version 2.34 expression: (looking-at "[@{}^'` *\"?!]")
-    (if (looking-at "[@{}^'`\"=~ \t\n*?!-]")
-        ;; @*, causes a line break.
-        (cond
-         ;; @*, a line break
-         ((= (following-char) ?*)
-          ;; remove command
-          (delete-region (1- (point)) (1+ (point)))
-          ;; insert return if not at end of line;
-          ;; else line is already broken.
-          (if (not (= (following-char) ?\n))
-              (insert ?\n)))
-         ;; @-, deleted
-         ((= (following-char) ?-)
-          (delete-region (1- (point)) (1+ (point))))
-         ;; @<space>, @<tab>, @<newline>: produce a single space,
-         ;;    unless followed by a newline.
-         ((= (following-char) ? )
-          (delete-region (1- (point)) (1+ (point)))
-          ;; insert single space if not at end of line;
-          ;; else line is already broken.
-          (if (not (= (following-char) ?\n))
-              (insert ? )))
-         ((= (following-char) ?\t)
-          (delete-region (1- (point)) (1+ (point)))
-          ;; insert single space if not at end of line;
-          ;; else line is already broken.
-          (if (not (= (following-char) ?\n))
-              (insert ? )))
-         ;; following char is a carriage return
-         ((= (following-char) ?\n)
-          ;; remove command
-          (delete-region (1- (point)) (1+ (point)))
-          ;; insert single space if not at end of line;
-          ;; else line is already broken.
-          (if (not (= (following-char) ?\n))
-              (insert ? )))
-         ;; Otherwise: the other characters are simply quoted.  Delete the @.
-         (t
-         (delete-char -1)
-	 ;; Be compatible with makeinfo: if @' and its ilk are
-	 ;; followed by a @ without a brace, barf.
-	 (if (looking-at "[\"'^`~=]")
-	     (progn
-	       (if (= (char-after (1+ (point))) ?@)
-		   (error "Use braces to give a command as an argument to @%c"
-			  (following-char)))
-	       (forward-char 1)
-	       ;; @' etc. can optionally accept their argument in
-	       ;; braces (makeinfo supports that).
-	       (when (looking-at "{")
-		 (let ((start (point)))
-		   (forward-list 1)
-		   (delete-char -1)
-		   (goto-char start)
-		   (delete-char 1))))
-	   (forward-char 1))))
-      ;; @ is followed by a command-word; find the end of the word.
-      (setq texinfo-command-start (1- (point)))
-      (if (= (char-syntax (following-char)) ?w)
-          (forward-word 1)
-        (forward-char 1))
-      (setq texinfo-command-end (point))
-      ;; Detect the case of two @-commands in a row;
-      ;; process just the first one.
-      (goto-char (1+ texinfo-command-start))
-      (skip-chars-forward "^@" texinfo-command-end)
-      (setq texinfo-command-end (point))
-      ;; Handle let aliasing
-      (setq texinfo-command-name
-            (let (trial
-                  (cmdname
-                   (buffer-substring-no-properties
-                    (1+ texinfo-command-start) texinfo-command-end)))
-              (while (setq trial (assoc cmdname texinfo-alias-list))
-                (setq cmdname (cdr trial)))
-            (intern cmdname)))
-      ;; Call the handler for this command.
-      (let ((enclosure-type
-             (assoc
-              (symbol-name texinfo-command-name)
-              texinfo-enclosure-list)))
-        (if enclosure-type
-            (progn
-              (insert
-               (car (car (cdr enclosure-type)))
-               (texinfo-parse-arg-discard)
-               (car (cdr (car (cdr enclosure-type)))))
-              (goto-char texinfo-command-start))
-          (let ((cmd (get texinfo-command-name 'texinfo-format)))
-            (if cmd (funcall cmd) (texinfo-unsupported)))))))
-
-  (cond (texinfo-stack
-         (goto-char (nth 2 (car texinfo-stack)))
-         (error "Unterminated @%s" (car (car texinfo-stack)))))
-
-  ;; Remove excess whitespace
-  (let ((whitespace-silent t)) 
-    (whitespace-cleanup))) 
-
-(defvar texinfo-copying-text ""
-  "Text of the copyright notice and copying permissions.")
-
-(defun texinfo-copying ()
-  "Copy the copyright notice and copying permissions from the Texinfo file,
-as indicated by the @copying ... @end copying command;
-insert the text with the @insertcopying command."
-  (let ((beg (progn (beginning-of-line) (point)))
-        (end  (progn (re-search-forward "^@end copying[ \t]*\n") (point))))
-    (setq texinfo-copying-text
-          (buffer-substring-no-properties
-           (save-excursion (goto-char beg) (forward-line 1) (point))
-           (save-excursion (goto-char end) (forward-line -1) (point))))
-    (delete-region beg end)))
-
-(defun texinfo-insertcopying ()
-  "Insert the copyright notice and copying permissions from the Texinfo file,
-which are indicated by the @copying ... @end copying command."
-  (insert (concat "\n" texinfo-copying-text)))
-
-(put 'begin 'texinfo-format 'texinfo-format-begin)
-(defun texinfo-format-begin ()
-  (texinfo-format-begin-end 'texinfo-format))
-
-(put 'end 'texinfo-format 'texinfo-format-end)
-(defun texinfo-format-end ()
-  (texinfo-format-begin-end 'texinfo-end))
-
-(defun texinfo-format-begin-end (prop)
-  (setq texinfo-command-name (intern (texinfo-parse-line-arg)))
-  (let ((cmd (get texinfo-command-name prop)))
-    (if cmd (funcall cmd)
-      (texinfo-unsupported))))
-
-;;; Parsing functions
-
-(defun texinfo-parse-line-arg ()
-  "Return argument of @-command as string.
-Argument is separated from command either by a space or by a brace.
-If a space, return rest of line, with beginning and ending white
-space removed.  If a brace, return string between braces.
-Leave point after argument."
-  (goto-char texinfo-command-end)
-  (let ((start (point)))
-    (cond ((looking-at " ")
-           (skip-chars-forward " ")
-           (setq start (point))
-           (end-of-line)
-           (skip-chars-backward " ")
-           (delete-region (point) (progn (end-of-line) (point)))
-           (setq texinfo-command-end (1+ (point))))
-          ((looking-at "{")
-           (setq start (1+ (point)))
-           (forward-list 1)
-           (setq texinfo-command-end (point))
-           (forward-char -1))
-          (t
-           (error "Invalid texinfo command arg format")))
-    (prog1 (buffer-substring-no-properties start (point))
-           (if (eolp) (forward-char 1)))))
-
-(defun texinfo-parse-expanded-arg ()
-  (goto-char texinfo-command-end)
-  (let ((start (point))
-        marker)
-    (cond ((looking-at " ")
-           (skip-chars-forward " ")
-           (setq start (point))
-           (end-of-line)
-           (setq texinfo-command-end (1+ (point))))
-          ((looking-at "{")
-           (setq start (1+ (point)))
-           (forward-list 1)
-           (setq texinfo-command-end (point))
-           (forward-char -1))
-          (t
-           (error "Invalid texinfo command arg format")))
-    (setq marker (move-marker (make-marker) texinfo-command-end))
-    (texinfo-format-expand-region start (point))
-    (setq texinfo-command-end (marker-position marker))
-    (move-marker marker nil)
-    (prog1 (buffer-substring-no-properties start (point))
-           (if (eolp) (forward-char 1)))))
-
-(defun texinfo-format-expand-region (start end)
-  (save-restriction
-    (narrow-to-region start end)
-    (let (texinfo-command-start
-          texinfo-command-end
-          texinfo-command-name
-          texinfo-stack)
-      (texinfo-format-scan))
-    (goto-char (point-max))))
-
-(defun texinfo-parse-arg-discard ()
-  "Delete command and argument; return argument of command."
-  (prog1 (texinfo-parse-line-arg)
-         (texinfo-discard-command)))
-
-(defun texinfo-discard-command ()
-  (delete-region texinfo-command-start texinfo-command-end))
-
-(defun texinfo-optional-braces-discard ()
-  "Discard braces following command, if any."
-  (goto-char texinfo-command-end)
-  (let ((start (point)))
-    (cond ((looking-at "[ \t]*\n"))     ; do nothing
-          ((looking-at "{")             ; remove braces, if any
-           (forward-list 1)
-           (setq texinfo-command-end (point)))
-          (t
-           (error
-            "Invalid `texinfo-optional-braces-discard' format \(need braces?\)")))
-    (delete-region texinfo-command-start texinfo-command-end)))
-
-(defun texinfo-format-parse-line-args ()
-  (let ((start (1- (point)))
-        next beg end
-        args)
-    (skip-chars-forward " ")
-    (while (not (eolp))
-      (setq beg (point))
-      (re-search-forward "[\n,]")
-      (setq next (point))
-      (if (bolp) (setq next (1- next)))
-      (forward-char -1)
-      (skip-chars-backward " ")
-      (setq end (point))
-      (setq args (cons (if (> end beg) (buffer-substring-no-properties beg end))
-                       args))
-      (goto-char next)
-      (skip-chars-forward " "))
-    (if (eolp) (forward-char 1))
-    (setq texinfo-command-end (point))
-    (nreverse args)))
-
-(defun texinfo-format-parse-args ()
-  (let ((start (1- (point)))
-        next beg end
-        args)
-    (search-forward "{")
-    (save-excursion
-      (texinfo-format-expand-region
-       (point)
-       (save-excursion (up-list 1) (1- (point)))))
-    ;; The following does not handle cross references of the form:
-    ;; `@xref{bullet, , @code{@@bullet}@{@}}.' because the
-    ;; re-search-forward finds the first right brace after the second
-    ;; comma.
-    (while (/= (preceding-char) ?\})
-      (skip-chars-forward " \t\n")
-      (setq beg (point))
-      (re-search-forward "[},]")
-      (setq next (point))
-      (forward-char -1)
-      (skip-chars-backward " \t\n")
-      (setq end (point))
-      (cond ((< beg end)
-             (goto-char beg)
-             (while (search-forward "\n" end t)
-               (replace-match " "))))
-      (setq args (cons (if (> end beg) (buffer-substring-no-properties beg end))
-                       args))
-      (goto-char next))
-    ;;(if (eolp) (forward-char 1))
-    (setq texinfo-command-end (point))
-    (nreverse args)))
-
-(defun texinfo-format-parse-defun-args ()
-  (goto-char texinfo-command-end)
-  (let ((start (point)))
-    (end-of-line)
-    (setq texinfo-command-end (1+ (point)))
-    (let ((marker (move-marker (make-marker) texinfo-command-end)))
-      (texinfo-format-expand-region start (point))
-      (setq texinfo-command-end (marker-position marker))
-      (move-marker marker nil))
-    (goto-char start)
-    (let ((args '())
-          beg end)
-      (skip-chars-forward " ")
-      (while (not (eolp))
-        (cond ((looking-at "{")
-               (setq beg (1+ (point)))
-               (forward-list 1)
-               (setq end (1- (point))))
-              (t
-               (setq beg (point))
-               (re-search-forward "[\n ]")
-               (forward-char -1)
-               (setq end (point))))
-        (setq args (cons (buffer-substring-no-properties beg end) args))
-        (skip-chars-forward " "))
-      (forward-char 1)
-      (nreverse args))))
-
-(defun texinfo-discard-line ()
-  (goto-char texinfo-command-end)
-  (skip-chars-forward " \t")
-  (or (eolp)
-      (error "Extraneous text at end of command line"))
-  (goto-char texinfo-command-start)
-  (or (bolp)
-      (error "Extraneous text at beginning of command line"))
-  (delete-region (point) (progn (forward-line 1) (point))))
-
-(defun texinfo-discard-line-with-args ()
-  (goto-char texinfo-command-start)
-  (delete-region (point) (progn (forward-line 1) (point))))
-
-
-;;; @setfilename
-
-;; Only `texinfo-format-buffer' handles @setfilename with this
-;; definition; `texinfo-format-region' handles @setfilename, if any,
-;; specially.
-(put 'setfilename 'texinfo-format 'texinfo-format-setfilename)
-(defun texinfo-format-setfilename ()
-  (texinfo-parse-arg-discard))
-
-;;; @node, @menu, @detailmenu
-
-(put 'node 'texinfo-format 'texinfo-format-node)
-(put 'nwnode 'texinfo-format 'texinfo-format-node)
-(defun texinfo-format-node ()
-  (let* ((args (texinfo-format-parse-line-args))
-         (name (nth 0 args))
-         (next (nth 1 args))
-         (prev (nth 2 args))
-         (up (nth 3 args)))
-    (texinfo-discard-command)
-    (setq texinfo-last-node name)
-    (let ((tem (if texinfo-fold-nodename-case (downcase name) name)))
-      (if (assoc tem texinfo-node-names)
-          (error "Duplicate node name: %s" name)
-        (setq texinfo-node-names (cons (list tem) texinfo-node-names))))
-    (setq texinfo-footnote-number 0)
-    ;; insert "\n\^_" unconditionally since this is what info is looking for
-    (insert "\n\^_\nFile: " texinfo-format-filename
-            ", Node: " name)
-    (if next
-        (insert ", Next: " next))
-    (if prev
-        (insert ", Prev: " prev))
-    (if up
-        (insert ", Up: " up))
-    (insert ?\n)
-    (setq texinfo-last-node-pos (point))))
-
-(put 'anchor 'texinfo-format 'texinfo-anchor)
-(defun texinfo-anchor ()
-  (let (anchor-string
-        (here (- (point) 7))  ; save location of beginning of `@anchor'
-        (arg (texinfo-parse-arg-discard)))
-    (if (looking-at " ")      ; since a space may be left after -discard
-      (delete-char 1))
-    (forward-paragraph)
-    (let ((end (point)))
-      (if (save-excursion
-            (backward-word 1)
-            (search-forward "@refill" end t))
-          (setq anchor-string "@anchor-yes-refill")
-        (setq anchor-string "@anchor-no-refill")))
-      (goto-char here)
-      (insert anchor-string "{" arg "}")))
-
-(put 'menu 'texinfo-format 'texinfo-format-menu)
-(defun texinfo-format-menu ()
-  (texinfo-discard-line)
-  (insert "* Menu:\n\n"))
-
-(put 'menu 'texinfo-end 'texinfo-discard-command)
-
-;; The @detailmenu should be removed eventually.
-
-;; According to Karl Berry, 31 August 1996:
-;;
-;; You don't like, I don't like it.  I agree, it would be better just to
-;; fix the bug [in `makeinfo'].  ..  At this point, since inserting those
-;; two commands in the Elisp fn is trivial, I don't especially want to
-;; expend more effort...
-;;
-;; I added a couple sentences of documentation to the manual (putting the
-;; blame on makeinfo where it belongs :-().
-
-(put 'detailmenu 'texinfo-format 'texinfo-discard-line)
-(put 'detailmenu 'texinfo-end 'texinfo-discard-command)
-
-;; (Also see `texnfo-upd.el')
-
-
-;;; Cross references
-
-;; @xref {NODE, FNAME, NAME, FILE, DOCUMENT}
-;; -> *Note FNAME: (FILE)NODE
-;;   If FILE is missing,
-;;    *Note FNAME: NODE
-;;   If FNAME is empty and NAME is present
-;;    *Note NAME: Node
-;;   If both NAME and FNAME are missing
-;;    *Note NODE::
-;;   texinfo ignores the DOCUMENT argument.
-;; -> See section <xref to NODE> [NAME, else NODE], page <xref to NODE>
-;;   If FILE is specified, (FILE)NODE is used for xrefs.
-;;   If fifth argument DOCUMENT is specified, produces
-;;    See section <xref to NODE> [NAME, else NODE], page <xref to NODE>
-;;    of DOCUMENT
-
-;; @ref             a reference that does not put `See' or `see' in
-;;                  the hardcopy and is the same as @xref in Info
-(put 'ref 'texinfo-format 'texinfo-format-xref)
-
-(put 'xref 'texinfo-format 'texinfo-format-xref)
-(defun texinfo-format-xref ()
-  (let ((args (texinfo-format-parse-args)))
-    (texinfo-discard-command)
-    (insert "*Note ")
-    (let ((fname (or (nth 1 args) (nth 2 args))))
-      (if (null (or fname (nth 3 args)))
-          (insert (car args) "::")
-        (insert (or fname (car args)) ": ")
-        (if (nth 3 args)
-            (insert "(" (nth 3 args) ")"))
-        (and (car args) (insert (car args)))))))
-
-(put 'pxref 'texinfo-format 'texinfo-format-pxref)
-(defun texinfo-format-pxref ()
-  (texinfo-format-xref)
-  (or (save-excursion
-        (forward-char -2)
-        (looking-at "::"))
-      (insert ".")))
-
-;; @inforef{NODE, FNAME, FILE}
-;; Like @xref{NODE, FNAME,,FILE} in texinfo.
-;; In Tex, generates "See Info file FILE, node NODE"
-(put 'inforef 'texinfo-format 'texinfo-format-inforef)
-(defun texinfo-format-inforef ()
-  (let ((args (texinfo-format-parse-args)))
-    (texinfo-discard-command)
-    (if (nth 1 args)
-        (insert "*Note " (nth 1 args) ": (" (nth 2 args) ")" (car args))
-      (insert "*Note " "(" (nth 2 args) ")" (car args) "::"))))
-
-
-;;; URL Reference: @uref
-
-;; @uref produces a reference to a uniform resource locator (URL).
-;; It takes one mandatory argument, the URL, and one optional argument,
-;; the text to display (the default is the URL itself).
-
-(put 'uref 'texinfo-format 'texinfo-format-uref)
-(defun texinfo-format-uref ()
-  "Format URL and optional URL-TITLE.
-Insert ` ... ' around URL if no URL-TITLE argument;
-otherwise, insert URL-TITLE followed by URL in parentheses."
-  (let ((args (texinfo-format-parse-args)))
-    (texinfo-discard-command)
-    ;; if url-title
-    (if (nth 1 args)
-        (insert  (nth 1 args) " (" (nth 0 args) ")")
-      (insert "`" (nth 0 args) "'"))
-    ;; XEmacs change
-    ;; No need to parse argument.  It's already expanded by
-    ;; texinfo-format-parse-args.
-;;    (goto-char texinfo-command-start)
-    ))
-
-
-;;; Section headings
-
-(put 'majorheading 'texinfo-format 'texinfo-format-chapter)
-(put 'chapheading 'texinfo-format 'texinfo-format-chapter)
-(put 'ichapter 'texinfo-format 'texinfo-format-chapter)
-(put 'chapter 'texinfo-format 'texinfo-format-chapter)
-(put 'iappendix 'texinfo-format 'texinfo-format-chapter)
-(put 'appendix 'texinfo-format 'texinfo-format-chapter)
-(put 'iunnumbered 'texinfo-format 'texinfo-format-chapter)
-(put 'top 'texinfo-format 'texinfo-format-chapter)
-(put 'unnumbered 'texinfo-format 'texinfo-format-chapter)
-(put 'centerchap 'texinfo-format 'texinfo-format-chapter)
-(defun texinfo-format-chapter ()
-  (texinfo-format-chapter-1 ?*))
-
-(put 'heading 'texinfo-format 'texinfo-format-section)
-(put 'isection 'texinfo-format 'texinfo-format-section)
-(put 'section 'texinfo-format 'texinfo-format-section)
-(put 'iappendixsection 'texinfo-format 'texinfo-format-section)
-(put 'appendixsection 'texinfo-format 'texinfo-format-section)
-(put 'iappendixsec 'texinfo-format 'texinfo-format-section)
-(put 'appendixsec 'texinfo-format 'texinfo-format-section)
-(put 'iunnumberedsec 'texinfo-format 'texinfo-format-section)
-(put 'unnumberedsec 'texinfo-format 'texinfo-format-section)
-(defun texinfo-format-section ()
-  (texinfo-format-chapter-1 ?=))
-
-(put 'subheading 'texinfo-format 'texinfo-format-subsection)
-(put 'isubsection 'texinfo-format 'texinfo-format-subsection)
-(put 'subsection 'texinfo-format 'texinfo-format-subsection)
-(put 'iappendixsubsec 'texinfo-format 'texinfo-format-subsection)
-(put 'appendixsubsec 'texinfo-format 'texinfo-format-subsection)
-(put 'iunnumberedsubsec 'texinfo-format 'texinfo-format-subsection)
-(put 'unnumberedsubsec 'texinfo-format 'texinfo-format-subsection)
-(defun texinfo-format-subsection ()
-  (texinfo-format-chapter-1 ?-))
-
-(put 'subsubheading 'texinfo-format 'texinfo-format-subsubsection)
-(put 'isubsubsection 'texinfo-format 'texinfo-format-subsubsection)
-(put 'subsubsection 'texinfo-format 'texinfo-format-subsubsection)
-(put 'iappendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
-(put 'appendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
-(put 'iunnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
-(put 'unnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
-(defun texinfo-format-subsubsection ()
-  (texinfo-format-chapter-1 ?.))
-
-(defun texinfo-format-chapter-1 (belowchar)
-  (let ((arg (texinfo-parse-arg-discard)))
-    (message "Formatting: %s ... " arg)   ; So we can see where we are.
-    (insert ?\n arg ?\n "@SectionPAD " belowchar ?\n)
-    (forward-line -2)))
-
-(put 'SectionPAD 'texinfo-format 'texinfo-format-sectionpad)
-(defun texinfo-format-sectionpad ()
-  (let ((str (texinfo-parse-arg-discard)))
-    (forward-char -1)
-    (let ((column (current-column)))
-      (forward-char 1)
-      (while (> column 0)
-        (insert str)
-        (setq column (1- column))))
-    (insert ?\n)))
-
-
-;;; Space controlling commands:  @. and @:, and the soft hyphen.
-
-(put '\. 'texinfo-format 'texinfo-format-\.)
-(defun texinfo-format-\. ()
-  (texinfo-discard-command)
-  (insert "."))
-
-(put '\: 'texinfo-format 'texinfo-format-\:)
-(defun texinfo-format-\: ()
-  (texinfo-discard-command))
-
-(put '\- 'texinfo-format 'texinfo-format-soft-hyphen)
-(defun texinfo-format-soft-hyphen ()
-  (texinfo-discard-command))
-
-
-;;; @kbdinputstyle, @vskip, headings & footings
-;;  These commands for not for Info and should never
-;;  appear in an Info environment; but if they do,
-;;  this causes them to be discarded.
-
-;; @kbdinputstyle
-(put 'kbdinputstyle 'texinfo-format 'texinfo-discard-line-with-args)
-
-;; @vskip
-(put 'vskip 'texinfo-format 'texinfo-discard-line-with-args)
-
-;; headings & footings
-(put 'evenfooting 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'evenheading 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'oddfooting 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'oddheading 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'everyfooting 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'everyheading 'texinfo-format 'texinfo-discard-line-with-args)
-
-
-;;; @documentdescription ... @end documentdescription
-;;  This command is for HTML output and should  never
-;;  appear in an Info environment; but if it does,
-;;  this causes it to be discarded.
-
-(put 'documentdescription 'texinfo-format 'texinfo-format-documentdescription)
-(defun texinfo-format-documentdescription ()
-  (delete-region texinfo-command-start
-		 (progn (re-search-forward "^@end documentdescription[ \t]*\n")
-			(point))))
-
-
-
-;;; @center, @sp, and @br
-
-(put 'center 'texinfo-format 'texinfo-format-center)
-(defun texinfo-format-center ()
-  (let ((arg (texinfo-parse-expanded-arg)))
-    (texinfo-discard-command)
-    (insert arg)
-    (insert ?\n)
-    (save-restriction
-      (goto-char (1- (point)))
-      (let ((indent-tabs-mode nil))
-        (center-line)))))
-
-(put 'sp 'texinfo-format 'texinfo-format-sp)
-(defun texinfo-format-sp ()
-  (let* ((arg (texinfo-parse-arg-discard))
-         (num (read arg)))
-    (insert-char ?\n num)))
-
-(put 'br 'texinfo-format 'texinfo-format-paragraph-break)
-(defun texinfo-format-paragraph-break ()
-  "Force a paragraph break.
-If used within a line, follow `@br' with braces."
-  (texinfo-optional-braces-discard)
-  ;; insert one return if at end of line;
-  ;; else insert two returns, to generate a blank line.
-  (if (= (following-char) ?\n)
-      (insert ?\n)
-    (insert-char ?\n 2)))
-
-
-;;; @footnote  and  @footnotestyle
-
-;; In Texinfo, footnotes are created with the `@footnote' command.
-;; This command is followed immediately by a left brace, then by the text of
-;; the footnote, and then by a terminating right brace.  The
-;; template for a footnote is:
-;;
-;;      @footnote{TEXT}
-;;
-;; Info has two footnote styles:
-;;
-;;    * In the End of node style, all the footnotes for a single node
-;;      are placed at the end of that node.  The footnotes are
-;;      separated from the rest of the node by a line of dashes with
-;;      the word `Footnotes' within it.
-;;
-;;    * In the Separate node style, all the footnotes for a single node
-;;      are placed in an automatically constructed node of their own.
-
-;; Footnote style is specified by the @footnotestyle command, either
-;;    @footnotestyle separate
-;; or
-;;    @footnotestyle end
-;;
-;; The default is  separate
-
-(defvar texinfo-footnote-style "separate"
-  "Footnote style, either separate or end.")
-
-(put 'footnotestyle 'texinfo-format 'texinfo-footnotestyle)
-(defun texinfo-footnotestyle ()
-  "Specify whether footnotes are at end of node or in separate nodes.
-Argument is either end or separate."
-  (setq texinfo-footnote-style (texinfo-parse-arg-discard)))
-
-(defvar texinfo-footnote-number)
-
-(put 'footnote 'texinfo-format 'texinfo-format-footnote)
-(defun texinfo-format-footnote ()
-  "Format a footnote in either end of node or separate node style.
-The   texinfo-footnote-style  variable controls which style is used."
-  (setq texinfo-footnote-number (1+ texinfo-footnote-number))
-  (cond ((string= texinfo-footnote-style "end")
-         (texinfo-format-end-node))
-        ((string= texinfo-footnote-style "separate")
-         (texinfo-format-separate-node))))
-
-(defun texinfo-format-separate-node ()
-  "Format footnote in Separate node style, with notes in own node.
-The node is constructed automatically."
-  (let* (start
-         (arg (texinfo-parse-line-arg))
-         (node-name-beginning
-          (save-excursion
-            (re-search-backward
-             "^File: \\w+\\(\\w\\|\\s_\\|\\.\\|,\\)*[ \t]+Node:")
-            (match-end 0)))
-         (node-name
-          (save-excursion
-            (buffer-substring-no-properties
-             (progn (goto-char node-name-beginning) ; skip over node command
-                    (skip-chars-forward " \t")  ; and over spaces
-                    (point))
-             (if (search-forward
-                  ","
-                  (save-excursion (end-of-line) (point)) t) ; bound search
-                 (1- (point))
-               (end-of-line) (point))))))
-    (texinfo-discard-command)  ; remove or insert whitespace, as needed
-    (delete-region (save-excursion (skip-chars-backward " \t\n") (point))
-                   (point))
-    (insert (format " (%d) (*Note %s-Footnotes::)"
-                    texinfo-footnote-number node-name))
-    (fill-paragraph nil)
-    (save-excursion
-    (if (re-search-forward "^@node" nil 'move)
-        (forward-line -1))
-
-    ;; two cases: for the first footnote, we must insert a node header;
-    ;; for the second and subsequent footnotes, we need only insert
-    ;; the text of the  footnote.
-
-    (if (save-excursion
-         (search-backward
-          (concat node-name "-Footnotes, Up: ")
-          node-name-beginning
-          t))
-        (progn   ; already at least one footnote
-          (setq start (point))
-          (insert (format "\n(%d)  %s\n" texinfo-footnote-number arg))
-          (fill-region start (point)))
-      ;; else not yet a footnote
-      (insert "\n\^_\nFile: "  texinfo-format-filename
-              "  Node: " node-name "-Footnotes, Up: " node-name "\n")
-      (setq start (point))
-      (insert (format "\n(%d)  %s\n" texinfo-footnote-number arg))
-      (fill-region start (point))))))
-
-(defun texinfo-format-end-node ()
-  "Format footnote in the End of node style, with notes at end of node."
-  (let (start
-        (arg (texinfo-parse-line-arg)))
-    (texinfo-discard-command)  ; remove or insert whitespace, as needed
-    (delete-region (save-excursion (skip-chars-backward " \t\n") (point))
-                   (point))
-    (insert (format " (%d) " texinfo-footnote-number))
-    (fill-paragraph nil)
-    (save-excursion
-      (if (search-forward "\n--------- Footnotes ---------\n" nil t)
-          (progn ; already have footnote, put new one before end of node
-            (if (re-search-forward "^@node" nil 'move)
-                (forward-line -1))
-            (setq start (point))
-            (insert (format "\n(%d)  %s\n" texinfo-footnote-number arg))
-            (fill-region start (point)))
-        ;; else no prior footnote
-        (if (re-search-forward "^@node" nil 'move)
-            (forward-line -1))
-        (insert "\n--------- Footnotes ---------\n")
-        (setq start (point))
-        (insert (format "\n(%d)  %s\n" texinfo-footnote-number arg))))))
-
-
-;;; @itemize, @enumerate, and similar commands
-
-;; @itemize pushes (itemize "COMMANDS" STARTPOS) on texinfo-stack.
-;; @enumerate pushes (enumerate 0 STARTPOS).
-;; @item dispatches to the texinfo-item prop of the first elt of the list.
-;; For itemize, this puts in and rescans the COMMANDS.
-;; For enumerate, this increments the number and puts it in.
-;; In either case, it puts a Backspace at the front of the line
-;; which marks it not to be indented later.
-;; All other lines get indented by 5 when the @end is reached.
-
-(defvar texinfo-stack-depth 0
-  "Count of number of unpopped texinfo-push-stack calls.
-Used by @refill indenting command to avoid indenting within lists, etc.")
-
-(defun texinfo-push-stack (check arg)
-  (setq texinfo-stack-depth (1+ texinfo-stack-depth))
-  (setq texinfo-stack
-        (cons (list check arg texinfo-command-start)
-              texinfo-stack)))
-
-(defun texinfo-pop-stack (check)
-  (setq texinfo-stack-depth (1- texinfo-stack-depth))
-  (if (null texinfo-stack)
-      (error "Unmatched @end %s" check))
-  (if (not (eq (car (car texinfo-stack)) check))
-      (error "@end %s matches @%s"
-             check (car (car texinfo-stack))))
-  (prog1 (cdr (car texinfo-stack))
-         (setq texinfo-stack (cdr texinfo-stack))))
-
-(put 'itemize 'texinfo-format 'texinfo-itemize)
-(defun texinfo-itemize ()
-  (texinfo-push-stack
-   'itemize
-   (progn (skip-chars-forward " \t")
-          (if (eolp)
-              "@bullet"
-            (texinfo-parse-line-arg))))
-  (texinfo-discard-line-with-args)
-  (setq fill-column (- fill-column 5)))
-
-(put 'itemize 'texinfo-end 'texinfo-end-itemize)
-(defun texinfo-end-itemize ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'itemize)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-(put 'enumerate 'texinfo-format 'texinfo-enumerate)
-(defun texinfo-enumerate ()
-  (texinfo-push-stack
-   'enumerate
-   (progn (skip-chars-forward " \t")
-          (if (eolp)
-              1
-            (read (current-buffer)))))
-  (if (and (symbolp (car (cdr (car texinfo-stack))))
-           (> 1 (length (symbol-name (car (cdr (car texinfo-stack)))))))
-      (error
-       "@enumerate: Use a number or letter, eg: 1, A, a, 3, B, or d." ))
-  (texinfo-discard-line-with-args)
-  (setq fill-column (- fill-column 5)))
-
-(put 'enumerate 'texinfo-end 'texinfo-end-enumerate)
-(defun texinfo-end-enumerate ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'enumerate)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-;; @alphaenumerate never became a standard part of Texinfo
-(put 'alphaenumerate 'texinfo-format 'texinfo-alphaenumerate)
-(defun texinfo-alphaenumerate ()
-  (texinfo-push-stack 'alphaenumerate (1- ?a))
-  (setq fill-column (- fill-column 5))
-  (texinfo-discard-line))
-
-(put 'alphaenumerate 'texinfo-end 'texinfo-end-alphaenumerate)
-(defun texinfo-end-alphaenumerate ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'alphaenumerate)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-;; @capsenumerate never became a standard part of Texinfo
-(put 'capsenumerate 'texinfo-format 'texinfo-capsenumerate)
-(defun texinfo-capsenumerate ()
-  (texinfo-push-stack 'capsenumerate (1- ?A))
-  (setq fill-column (- fill-column 5))
-  (texinfo-discard-line))
-
-(put 'capsenumerate 'texinfo-end 'texinfo-end-capsenumerate)
-(defun texinfo-end-capsenumerate ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'capsenumerate)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-;; At the @end, indent all the lines within the construct
-;; except those marked with backspace.  FROM says where
-;; construct started.
-(defun texinfo-do-itemize (from)
-  (save-excursion
-   (while (progn (forward-line -1)
-                 (>= (point) from))
-     (if (= (following-char) ?\b)
-         (save-excursion
-           (delete-char 1)
-           (end-of-line)
-           (delete-char 6))
-       (if (not (looking-at "[ \t]*$"))
-           (save-excursion (insert "     ")))))))
-
-(put 'item 'texinfo-format 'texinfo-item)
-(put 'itemx 'texinfo-format 'texinfo-item)
-(defun texinfo-item ()
-  (funcall (get (car (car texinfo-stack)) 'texinfo-item)))
-
-(put 'itemize 'texinfo-item 'texinfo-itemize-item)
-(defun texinfo-itemize-item ()
-  ;; (texinfo-discard-line)   ; Did not handle text on same line as @item.
-  (delete-region (1+ (point)) (save-excursion (beginning-of-line) (point)))
-  (if (looking-at "[ \t]*[^ \t\n]+")
-      ;; Text on same line as @item command.
-      (insert "\b   " (nth 1 (car texinfo-stack)) " \n")
-    ;; Else text on next line.
-    (insert "\b   " (nth 1 (car texinfo-stack)) " "))
-  (forward-line -1))
-
-(put 'enumerate 'texinfo-item 'texinfo-enumerate-item)
-(defun texinfo-enumerate-item ()
-  (texinfo-discard-line)
-  (let (enumerating-symbol)
-    (cond ((integerp (car (cdr (car texinfo-stack))))
-           (setq enumerating-symbol (car (cdr (car texinfo-stack))))
-           (insert ?\b (format "%3d. " enumerating-symbol) ?\n)
-           (setcar (cdr (car texinfo-stack)) (1+ enumerating-symbol)))
-          ((symbolp (car (cdr (car texinfo-stack))))
-           (setq enumerating-symbol
-                 (symbol-name (car (cdr (car texinfo-stack)))))
-           (if (or (equal ?\[ (string-to-char enumerating-symbol))
-                   (equal ?\{ (string-to-char enumerating-symbol)))
-               (error
-                "Too many items in enumerated list; alphabet ends at Z."))
-           (insert ?\b (format "%3s. " enumerating-symbol) ?\n)
-           (setcar (cdr (car texinfo-stack))
-                   (make-symbol
-                    (char-to-string
-                     (1+
-                      (string-to-char enumerating-symbol))))))
-          (t
-          (error
-           "@enumerate: Use a number or letter, eg: 1, A, a, 3, B or d." )))
-    (forward-line -1)))
-
-(put 'alphaenumerate 'texinfo-item 'texinfo-alphaenumerate-item)
-(defun texinfo-alphaenumerate-item ()
-  (texinfo-discard-line)
-  (let ((next (1+ (car (cdr (car texinfo-stack))))))
-    (if (> next ?z)
-        (error "More than 26 items in @alphaenumerate; get a bigger alphabet"))
-    (setcar (cdr (car texinfo-stack)) next)
-    (insert "\b  " next ". \n"))
-  (forward-line -1))
-
-(put 'capsenumerate 'texinfo-item 'texinfo-capsenumerate-item)
-(defun texinfo-capsenumerate-item ()
-  (texinfo-discard-line)
-  (let ((next (1+ (car (cdr (car texinfo-stack))))))
-    (if (> next ?Z)
-        (error "More than 26 items in @capsenumerate; get a bigger alphabet"))
-    (setcar (cdr (car texinfo-stack)) next)
-    (insert "\b  " next ". \n"))
-  (forward-line -1))
-
-
-;;; @table
-
-;; The `@table' command produces two-column tables.
-
-(put 'table 'texinfo-format 'texinfo-table)
-(defun texinfo-table ()
-  (texinfo-push-stack
-   'table
-   (progn (skip-chars-forward " \t")
-          (if (eolp)
-              "@asis"
-            (texinfo-parse-line-arg))))
-  (texinfo-discard-line-with-args)
-  (setq fill-column (- fill-column 5)))
-
-(put 'table 'texinfo-item 'texinfo-table-item)
-(defun texinfo-table-item ()
-  (let ((arg (texinfo-parse-arg-discard))
-        (itemfont (car (cdr (car texinfo-stack)))))
-    (insert ?\b itemfont ?\{ arg "}\n     \n"))
-  (forward-line -2))
-
-(put 'table 'texinfo-end 'texinfo-end-table)
-(defun texinfo-end-table ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'table)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-;; @description appears to be an undocumented variant on @table that
-;; does not require an arg.  It fails in texinfo.tex 2.58 and is not
-;; part of makeinfo.c   The command appears to be a relic of the past.
-(put 'description 'texinfo-end 'texinfo-end-table)
-(put 'description 'texinfo-format 'texinfo-description)
-(defun texinfo-description ()
-  (texinfo-push-stack 'table "@asis")
-  (setq fill-column (- fill-column 5))
-  (texinfo-discard-line))
-
-
-;;; @ftable, @vtable
-
-;; The `@ftable' and `@vtable' commands are like the `@table' command
-;; but they also insert each entry in the first column of the table
-;; into the function or variable index.
-
-;; Handle the @ftable and @vtable commands:
-
-(put 'ftable 'texinfo-format 'texinfo-ftable)
-(put 'vtable 'texinfo-format 'texinfo-vtable)
-
-(defun texinfo-ftable () (texinfo-indextable 'ftable))
-(defun texinfo-vtable () (texinfo-indextable 'vtable))
-
-(defun texinfo-indextable (table-type)
-  (texinfo-push-stack table-type (texinfo-parse-arg-discard))
-  (setq fill-column (- fill-column 5)))
-
-;; Handle the @item commands within ftable and vtable:
-
-(put 'ftable 'texinfo-item 'texinfo-ftable-item)
-(put 'vtable 'texinfo-item 'texinfo-vtable-item)
-
-(defun texinfo-ftable-item () (texinfo-indextable-item 'texinfo-findex))
-(defun texinfo-vtable-item () (texinfo-indextable-item 'texinfo-vindex))
-
-(defun texinfo-indextable-item (index-type)
-  (let ((item (texinfo-parse-arg-discard))
-        (itemfont (car (cdr (car texinfo-stack))))
-        (indexvar index-type))
-    (insert ?\b itemfont ?\{ item "}\n     \n")
-    (set indexvar
-         (cons
-          (list item texinfo-last-node)
-          (symbol-value indexvar)))
-    (forward-line -2)))
-
-;; Handle @end ftable, @end vtable
-
-(put 'ftable 'texinfo-end 'texinfo-end-ftable)
-(put 'vtable 'texinfo-end 'texinfo-end-vtable)
-
-(defun texinfo-end-ftable () (texinfo-end-indextable 'ftable))
-(defun texinfo-end-vtable () (texinfo-end-indextable 'vtable))
-
-(defun texinfo-end-indextable (table-type)
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack table-type)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-
-;;; @multitable ... @end multitable
-
-;; Produce a multi-column table, with as many columns as desired.
-;;
-;; A multi-column table has this template:
-;;
-;;     @multitable {A1} {A2} {A3}
-;;     @item  A1  @tab  A2  @tab  A3
-;;     @item  B1  @tab  B2  @tab  B3
-;;     @item  C1  @tab  C2  @tab  C3
-;;     @end multitable
-;;
-;; where the width of the text in brackets specifies the width of the
-;; respective column.
-;;
-;; Or else:
-;;
-;;     @multitable @columnfractions .25 .3 .45
-;;     @item  A1  @tab  A2  @tab  A3
-;;     @item  B1  @tab  B2  @tab  B3
-;;     @end multitable
-;;
-;; where the fractions specify the width of each column as a percent
-;; of the current width of the text (i.e., of the fill-column).
-;;
-;; Long lines of text are filled within columns.
-;;
-;; Using the Emacs Lisp formatter, texinfmt.el,
-;; the whitespace between columns can be increased by setting
-;; `texinfo-extra-inter-column-width' to a value greater than 0.  By default,
-;; there is at least one blank space between columns.
-;;
-;; The Emacs Lisp formatter, texinfmt.el, ignores the following four
-;; commands that are defined in texinfo.tex for printed output.
-;;
-;;     @multitableparskip,
-;;     @multitableparindent,
-;;     @multitablecolmargin,
-;;     @multitablelinespace.
-
-;; How @multitable works.
-;; =====================
-;;
-;; `texinfo-multitable' reads the @multitable line and determines from it
-;; how wide each column should be.
-;;
-;; Also, it pushes this information, along with an identifying symbol,
-;; onto the `texinfo-stack'.  At the @end multitable command, the stack
-;; is checked for its matching @multitable command, and then popped, or
-;; else an error is signaled.  Also, this command pushes the location of
-;; the start of the table onto the stack.
-;;
-;; `texinfo-end-multitable' checks the `texinfo-stack' that the @end
-;; multitable truly is ending a corresponding beginning, and if it is,
-;; pops the stack.
-;;
-;; `texinfo-multitable-widths' is called by `texinfo-multitable'.
-;; The function returns a list of the widths of each column in a
-;; multi-column table, based on the information supplied by the arguments
-;; to the @multitable command (by arguments, I mean the text on the rest
-;; of the @multitable line, not the remainder of the multi-column table
-;; environment).
-;;
-;; `texinfo-multitable-item' formats a row within a multicolumn table.
-;; This command is executed when texinfmt sees @item inside @multitable.
-;; Cells in row are separated by `@tab's.  Widths of cells are specified
-;; by the arguments in the @multitable line.  Cells are filled.  All cells
-;; are made to be the same height by padding their bottoms, as needed,
-;; with blanks.
-;;
-;; `texinfo-multitable-extract-row' is called by `texinfo-multitable-item'.
-;; This function returns the text in a multitable row, as a string.
-;; The start of a row is marked by an @item and the end of row is the
-;; beginning of next @item or beginning of the @end multitable line.
-;; Cells within a row are separated by @tab.
-;;
-;; Note that @tab, the cell separators, are not treated as independent
-;; Texinfo commands.
-
-(defvar texinfo-extra-inter-column-width 0
-  "*Number of extra spaces between entries (columns) in @multitable.")
-
-(defvar texinfo-multitable-buffer-name "*multitable-temporary-buffer*")
-(defvar texinfo-multitable-rectangle-name "texinfo-multitable-temp-")
-
-;; These commands are defined in texinfo.tex for printed output.
-(put 'multitableparskip 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'multitableparindent 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'multitablecolmargin 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'multitablelinespace 'texinfo-format 'texinfo-discard-line-with-args)
-
-(put 'multitable 'texinfo-format 'texinfo-multitable)
-
-(defun texinfo-multitable ()
-  "Produce multi-column tables.
-
-A multi-column table has this template:
-
-    @multitable {A1} {A2} {A3}
-    @item  A1  @tab  A2  @tab  A3
-    @item  B1  @tab  B2  @tab  B3
-    @item  C1  @tab  C2  @tab  C3
-    @end multitable
-
-where the width of the text in brackets specifies the width of the
-respective column.
-
-Or else:
-
-    @multitable @columnfractions .25 .3 .45
-    @item  A1  @tab  A2  @tab  A3
-    @item  B1  @tab  B2  @tab  B3
-    @end multitable
-
-where the fractions specify the width of each column as a percent
-of the current width of the text (i.e., of the fill-column).
-
-Long lines of text are filled within columns.
-
-Using the Emacs Lisp formatter, texinfmt.el,
-the whitespace between columns can be increased by setting
-`texinfo-extra-inter-column-width' to a value greater than 0.  By default,
-there is at least one blank space between columns.
-
-The Emacs Lisp formatter, texinfmt.el, ignores the following four
-commands that are defined in texinfo.tex for printed output.
-
-    @multitableparskip,
-    @multitableparindent,
-    @multitablecolmargin,
-    @multitablelinespace."
-
-;; This function pushes information onto the `texinfo-stack'.
-;; A stack element consists of:
-;;   - type-of-command, i.e., multitable
-;;   - the information about column widths, and
-;;   - the position of texinfo-command-start.
-;; e.g., ('multitable (1 2 3 4) 123)
-;; The command line is then deleted.
-  (texinfo-push-stack
-   'multitable
-   ;; push width information on stack
-   (texinfo-multitable-widths))
-  (texinfo-discard-line-with-args))
-
-(put 'multitable 'texinfo-end 'texinfo-end-multitable)
-(defun texinfo-end-multitable ()
-  "Discard the @end multitable line and pop the stack of multitable."
-  (texinfo-discard-command)
-  (texinfo-pop-stack 'multitable))
-
-(defun texinfo-multitable-widths ()
-  "Return list of widths of each column in a multi-column table."
-  (let (texinfo-multitable-width-list)
-    ;; Fractions format:
-    ;;  @multitable @columnfractions .25 .3 .45
-    ;;
-    ;; Template format:
-    ;;  @multitable {Column 1 template} {Column 2} {Column 3 example}
-    ;; Place point before first argument
-    (skip-chars-forward " \t")
-    (cond
-     ;; Check for common misspelling
-     ((looking-at "@columnfraction ")
-      (error "In @multitable, @columnfractions misspelled"))
-     ;; Case 1: @columnfractions .25 .3 .45
-     ((looking-at "@columnfractions")
-      (forward-word 1)
-      (while (not (eolp))
-        (setq texinfo-multitable-width-list
-              (cons
-               (truncate
-                (1-
-                 (* fill-column (read (get-buffer (current-buffer))))))
-               texinfo-multitable-width-list))))
-     ;;
-     ;; Case 2: {Column 1 template} {Column 2} {Column 3 example}
-     ((looking-at "{")
-      (let ((start-of-templates (point)))
-        (while (not (eolp))
-          (skip-chars-forward " \t")
-          (let* ((start-of-template (1+ (point)))
-                 (end-of-template
-                  ;; forward-sexp works with braces in Texinfo mode
-                  (progn (forward-sexp 1) (1- (point)))))
-            (setq texinfo-multitable-width-list
-                  (cons (- end-of-template start-of-template)
-                        texinfo-multitable-width-list))
-            ;; Remove carriage return from within a template, if any.
-            ;; This helps those those who want to use more than
-            ;; one line's worth of words in @multitable line.
-            (narrow-to-region start-of-template end-of-template)
-            (goto-char (point-min))
-            (while (search-forward "
-" nil t)
-              (delete-char -1))
-            (goto-char (point-max))
-            (widen)
-            (forward-char 1)))))
-     ;;
-     ;; Case 3: Trouble
-     (t
-      (error
-       "You probably need to specify column widths for @multitable correctly.")))
-    ;; Check whether columns fit on page.
-    (let ((desired-columns
-           (+
-            ;; between column spaces
-            (length texinfo-multitable-width-list)
-            ;; additional between column spaces, if any
-            texinfo-extra-inter-column-width
-            ;; sum of spaces for each entry
-            (apply '+ texinfo-multitable-width-list))))
-      (if (> desired-columns fill-column)
-          (error
-           (format
-            "Multi-column table width, %d chars, is greater than page width, %d chars."
-            desired-columns fill-column))))
-    texinfo-multitable-width-list))
-
-;; @item  A1  @tab  A2  @tab  A3
-(defun texinfo-multitable-extract-row ()
-  "Return multitable row, as a string.
-End of row is beginning of next @item or beginning of @end.
-Cells within rows are separated by @tab."
-  (skip-chars-forward " \t")
-  (let* ((start (point))
-         (end (progn
-                (re-search-forward "@item\\|@end")
-                (match-beginning 0)))
-         (row (progn (goto-char end)
-                     (skip-chars-backward " ")
-                     ;; remove whitespace at end of argument
-                     (delete-region (point) end)
-                     (buffer-substring-no-properties start (point)))))
-    (delete-region texinfo-command-start end)
-    row))
-
-(put 'multitable 'texinfo-item 'texinfo-multitable-item)
-(defun texinfo-multitable-item ()
-  "Format a row within a multicolumn table.
-Cells in row are separated by @tab.
-Widths of cells are specified by the arguments in the @multitable line.
-All cells are made to be the same height.
-This command is executed when texinfmt sees @item inside @multitable."
-  (let ((original-buffer (current-buffer))
-        (table-widths (reverse (car (cdr (car texinfo-stack)))))
-        (existing-fill-column fill-column)
-        start
-        end
-        (table-column       0)
-        (table-entry-height 0)
-        ;; unformatted row looks like:  A1  @tab  A2  @tab  A3
-        ;; extract-row command deletes the source line in the table.
-        (unformated-row (texinfo-multitable-extract-row)))
-    ;; Use a temporary buffer
-    (set-buffer (get-buffer-create texinfo-multitable-buffer-name))
-    ;; XEmacs change
-    ;; Temporary buffer must use texinfo-format-syntax-table
-    ;; or it will fail when parsing other commands.
-    (set-syntax-table texinfo-format-syntax-table)
-    (delete-region (point-min) (point-max))
-    (insert unformated-row)
-    (goto-char (point-min))
-;; 1. Check for correct number of @tab in line.
-    (let ((tab-number 1))                       ; one @tab between two columns
-      (while (search-forward "@tab" nil t)
-        (setq tab-number (1+ tab-number)))
-      (if (/= tab-number (length table-widths))
-          (error "Wrong number of @tab's in a @multitable row")))
-    (goto-char (point-min))
-;; 2. Format each cell, and copy to a rectangle
-    ;; buffer looks like this:    A1  @tab  A2  @tab  A3
-    ;; Cell #1: format up to @tab
-    ;; Cell #2: format up to @tab
-    ;; Cell #3: format up to eob
-    (while (not (eobp))
-      (setq start (point))
-      (setq end (save-excursion
-                  (if (search-forward "@tab" nil 'move)
-                      ;; Delete the @tab command, including the @-sign
-                      (delete-region
-                       (point)
-                       (progn (forward-word -1) (1- (point)))))
-                  (point)))
-      ;; Set fill-column *wider* than needed to produce inter-column space
-      (setq fill-column (+ 1
-                           texinfo-extra-inter-column-width
-                           (nth table-column table-widths)))
-      (narrow-to-region start end)
-      ;; Remove whitespace before and after entry.
-      (skip-chars-forward " ")
-      (delete-region (point) (save-excursion (beginning-of-line) (point)))
-      (goto-char (point-max))
-      (skip-chars-backward " ")
-      (delete-region (point) (save-excursion (end-of-line) (point)))
-      ;; Temporarily set texinfo-stack to nil so texinfo-format-scan
-      ;; does not see an unterminated @multitable.
-      (let (texinfo-stack)                      ; nil
-        (texinfo-format-scan))
-      (let (fill-prefix)                        ; no fill prefix
-        (fill-region (point-min) (point-max)))
-      (setq table-entry-height
-            (max table-entry-height (count-lines (point-min) (point-max))))
-;; 3. Move point to end of bottom line, and pad that line to fill column.
-      (goto-char (point-min))
-      (forward-line (1- table-entry-height))
-      (let* ((beg (point))                      ; beginning of line
-             ;; add one more space for inter-column spacing
-             (needed-whitespace
-              (1+
-               (- fill-column
-                  (-
-                   (progn (end-of-line) (point)) ; end of existing line
-                   beg)))))
-        (insert (make-string
-                 (if (> needed-whitespace 0) needed-whitespace 1)
-                 ? )))
-      ;; now, put formatted cell into a rectangle
-      (set (intern (concat texinfo-multitable-rectangle-name
-                           (int-to-string table-column)))
-           (extract-rectangle (point-min) (point)))
-      (delete-region (point-min) (point))
-      (goto-char (point-max))
-      (setq table-column (1+ table-column))
-      (widen))
-;; 4. Add extra lines to rectangles so all are of same height
-    (let ((total-number-of-columns table-column)
-          (column-number 0)
-          here)
-      (while (> table-column 0)
-        (let ((this-rectangle (int-to-string table-column)))
-          (while (< (length this-rectangle) table-entry-height)
-            (setq this-rectangle (append this-rectangle '("")))))
-        (setq table-column (1- table-column)))
-;; 5. Insert formatted rectangles in original buffer
-      (switch-to-buffer original-buffer)
-      (open-line table-entry-height)
-      (while (< column-number total-number-of-columns)
-        (setq here (point))
-        (insert-rectangle
-         (eval (intern
-                (concat texinfo-multitable-rectangle-name
-                        (int-to-string column-number)))))
-        (goto-char here)
-        (end-of-line)
-        (setq column-number (1+ column-number))))
-    (kill-buffer texinfo-multitable-buffer-name)
-    (setq fill-column existing-fill-column)))
-
-
-;;; @image
-;;  Use only the FILENAME argument to the command.
-;;  In Info, ignore the other arguments.
-
-(put 'image 'texinfo-format 'texinfo-format-image)
-(defun texinfo-format-image ()
-  "Insert an image from an an file ending in .txt.
-Use only the FILENAME arg; for Info, ignore the other arguments to @image."
-  (let ((args (texinfo-format-parse-args))
-	filename)
-    (when (null (nth 0 args))
-      (error "Invalid image command"))
-    (texinfo-discard-command)
-    ;; makeinfo uses FILENAME.txt
-    (setq filename (format "%s.txt" (nth 0 args)))
-    (message "Reading included file: %s" filename)
-    ;; verbatim for Info output
-    (goto-char (+ (point) (cadr (insert-file-contents filename))))
-    (message "Reading included file: %s...done" filename)))
-
-
-;;; @ifinfo,  @iftex, @tex, @ifhtml, @html, @ifplaintext, @ifxml, @xml
-;;  @ifnottex, @ifnotinfo, @ifnothtml, @ifnotplaintext, @ifnotxml
-
-(put 'ifinfo 'texinfo-format 'texinfo-discard-line)
-(put 'ifinfo 'texinfo-end 'texinfo-discard-command)
-
-(put 'iftex 'texinfo-format 'texinfo-format-iftex)
-(defun texinfo-format-iftex ()
-  (delete-region texinfo-command-start
-                 (re-search-forward "@end iftex[ \t]*\n")))
-
-(put 'ifhtml 'texinfo-format 'texinfo-format-ifhtml)
-(defun texinfo-format-ifhtml ()
-  (delete-region texinfo-command-start
-                 (re-search-forward "@end ifhtml[ \t]*\n")))
-
-(put 'ifplaintext 'texinfo-format 'texinfo-format-ifplaintext)
-(defun texinfo-format-ifplaintext ()
-  (delete-region texinfo-command-start
-                 (re-search-forward "@end ifplaintext[ \t]*\n")))
-
-(put 'ifxml 'texinfo-format 'texinfo-format-ifxml)
-(defun texinfo-format-ifxml ()
-  (delete-region texinfo-command-start
-                 (progn (re-search-forward "^@end ifxml[ \t]*\n")
-                        (point))))
-
-(put 'tex 'texinfo-format 'texinfo-format-tex)
-(defun texinfo-format-tex ()
-  (delete-region texinfo-command-start
-                 (re-search-forward "@end tex[ \t]*\n")))
-
-(put 'html 'texinfo-format 'texinfo-format-html)
-(defun texinfo-format-html ()
-  (delete-region texinfo-command-start
-                 (re-search-forward "@end html[ \t]*\n")))
-
-(put 'xml 'texinfo-format 'texinfo-format-xml)
-(defun texinfo-format-xml ()
-  (delete-region texinfo-command-start
-                 (progn (re-search-forward "^@end xml[ \t]*\n")
-                        (point))))
-
-(put 'ifnotinfo 'texinfo-format 'texinfo-format-ifnotinfo)
-(defun texinfo-format-ifnotinfo ()
-  (delete-region texinfo-command-start
-                 (re-search-forward "@end ifnotinfo[ \t]*\n")))
-
-(put 'ifnotplaintext 'texinfo-format 'texinfo-discard-line)
-(put 'ifnotplaintext 'texinfo-end 'texinfo-discard-command)
-
-(put 'ifnottex 'texinfo-format 'texinfo-discard-line)
-(put 'ifnottex 'texinfo-end 'texinfo-discard-command)
-
-(put 'ifnothtml 'texinfo-format 'texinfo-discard-line)
-(put 'ifnothtml 'texinfo-end 'texinfo-discard-command)
-
-(put 'ifnotxml 'texinfo-format 'texinfo-discard-line)
-(put 'ifnotxml 'texinfo-end 'texinfo-discard-command)
-
-
-;;; @titlepage
-
-(put 'titlepage 'texinfo-format 'texinfo-format-titlepage)
-(defun texinfo-format-titlepage ()
-  (delete-region texinfo-command-start
-                 (re-search-forward "@end titlepage[ \t]*\n")))
-
-(put 'endtitlepage 'texinfo-format 'texinfo-discard-line)
-
-;; @titlespec         an alternative titling command; ignored by Info
-
-(put 'titlespec 'texinfo-format 'texinfo-format-titlespec)
-(defun texinfo-format-titlespec ()
-  (delete-region texinfo-command-start
-                 (re-search-forward "@end titlespec[ \t]*\n")))
-
-(put 'endtitlespec 'texinfo-format 'texinfo-discard-line)
-
-
-;;; @today
-
-(put 'today 'texinfo-format 'texinfo-format-today)
-
-;; Produces Day Month Year style of output.  eg `1 Jan 1900'
-;; The `@today{}' command requires a pair of braces, like `@dots{}'.
-(defun texinfo-format-today ()
-  (texinfo-parse-arg-discard)
-  (insert (format-time-string "%e %b %Y")))
-
-
-;;; @timestamp{}
-;; Produce `Day Month Year Hour:Min' style of output.
-;; eg `1 Jan 1900 13:52'
-
-(put 'timestamp 'texinfo-format 'texinfo-format-timestamp)
-
-;; The `@timestamp{}' command requires a pair of braces, like `@dots{}'.
-(defun texinfo-format-timestamp ()
-  "Insert the current local time and date."
-  (texinfo-parse-arg-discard)
-  ;; For seconds and time zone, replace format string with  "%e %b %Y %T %Z"
-  (insert (format-time-string "%e %b %Y %R")))
-
-
-;;; @ignore
-
-(put 'ignore 'texinfo-format 'texinfo-format-ignore)
-(defun texinfo-format-ignore ()
-  (delete-region texinfo-command-start
-                 (re-search-forward "@end ignore[ \t]*\n")))
-
-(put 'endignore 'texinfo-format 'texinfo-discard-line)
-
-
-;;; Define the Info enclosure command: @definfoenclose
-
-;; A `@definfoenclose' command may be used to define a highlighting
-;; command for Info, but not for TeX.  A command defined using
-;; `@definfoenclose' marks text by enclosing it in strings that precede
-;; and follow the text.
-;;
-;; Presumably, if you define a command with `@definfoenclose` for Info,
-;; you will also define the same command in the TeX definitions file,
-;; `texinfo.tex' in a manner appropriate for typesetting.
-;;
-;; Write a `@definfoenclose' command on a line and follow it with three
-;; arguments separated by commas (commas are used as separators in an
-;; `@node' line in the same way).  The first argument to
-;; `@definfoenclose' is the @-command name \(without the `@'\); the
-;; second argument is the Info start delimiter string; and the third
-;; argument is the Info end delimiter string.  The latter two arguments
-;; enclose the highlighted text in the Info file.  A delimiter string
-;; may contain spaces.  Neither the start nor end delimiter is
-;; required.  However, if you do not provide a start delimiter, you
-;; must follow the command name with two commas in a row; otherwise,
-;; the Info formatting commands will misinterpret the end delimiter
-;; string as a start delimiter string.
-;;
-;; If you do a @definfoenclose{} on the name of a pre-defined macro (such
-;; as @emph{}, @strong{}, @tt{}, or @i{}) the enclosure definition will
-;; override the built-in definition.
-;;
-;; An enclosure command defined this way takes one argument in braces.
-;;
-;; For example, you can write:
-;;
-;;     @ifinfo
-;;     @definfoenclose phoo, //, \\
-;;     @end ifinfo
-;;
-;; near the beginning of a Texinfo file at the beginning of the lines
-;; to define `@phoo' as an Info formatting command that inserts `//'
-;; before and `\\' after the argument to `@phoo'.  You can then write
-;; `@phoo{bar}' wherever you want `//bar\\' highlighted in Info.
-;;
-;; Also, for TeX formatting, you could write
-;;
-;;     @iftex
-;;     @global@let@phoo=@i
-;;     @end iftex
-;;
-;; to define `@phoo' as a command that causes TeX to typeset
-;; the argument to `@phoo' in italics.
-;;
-;; Note that each definition applies to its own formatter: one for TeX,
-;; the other for texinfo-format-buffer or texinfo-format-region.
-;;
-;; Here is another example: write
-;;
-;;     @definfoenclose headword, , :
-;;
-;; near the beginning of the file, to define `@headword' as an Info
-;; formatting command that inserts nothing before and a colon after the
-;; argument to `@headword'.
-
-(put 'definfoenclose 'texinfo-format 'texinfo-define-info-enclosure)
-(defun texinfo-define-info-enclosure ()
-  (let* ((args (texinfo-format-parse-line-args))
-         (command-name (nth 0 args))
-         (beginning-delimiter (or (nth 1 args) ""))
-         (end-delimiter (or (nth 2 args) "")))
-    (texinfo-discard-command)
-    (setq texinfo-enclosure-list
-        (cons
-         (list command-name
-               (list
-                beginning-delimiter
-                end-delimiter))
-         texinfo-enclosure-list))))
-
-
-;;; @alias
-
-(put 'alias 'texinfo-format 'texinfo-alias)
-(defun texinfo-alias ()
-  (let ((start (1- (point)))
-        args)
-    (skip-chars-forward " ")
-    (save-excursion (end-of-line) (setq texinfo-command-end (point)))
-    (if (not (looking-at "\\([^=]+\\)=\\(.*\\)"))
-        (error "Invalid alias command")
-      (setq texinfo-alias-list
-	    (cons
-	     (cons
-	      (match-string-no-properties 1)
-	      (match-string-no-properties 2))
-	     texinfo-alias-list))
-      (texinfo-discard-command))
-    )
-  )
-
-
-;;; @var, @code and the like
-
-(put 'var 'texinfo-format 'texinfo-format-var)
-;;  @sc  a small caps font for TeX; formatted as `var' in Info
-(put 'sc 'texinfo-format 'texinfo-format-var)
-;;  @acronym   for abbreviations in all caps, such as `NASA'.
-;;  Convert all letters to uppercase if they are not already.
-(put 'acronym 'texinfo-format 'texinfo-format-var)
-(defun texinfo-format-var ()
-  (let ((arg (texinfo-parse-expanded-arg)))
-    (texinfo-discard-command)
-    (insert (upcase arg))))
-
-(put 'cite 'texinfo-format 'texinfo-format-code)
-(put 'code 'texinfo-format 'texinfo-format-code)
-;; @command (for command names)
-(put 'command 'texinfo-format 'texinfo-format-code)
-;; @env (for environment variables)
-(put 'env 'texinfo-format 'texinfo-format-code)
-(put 'file 'texinfo-format 'texinfo-format-code)
-(put 'samp 'texinfo-format 'texinfo-format-code)
-(put 'url 'texinfo-format 'texinfo-format-code)
-(defun texinfo-format-code ()
-  (insert "`" (texinfo-parse-arg-discard) "'")
-  (goto-char texinfo-command-start))
-
-;; @option (for command-line options) must be different from @code
-;; because of its special formatting in @table; namely that it does
-;; not lead to inserted ` ... ' in a table, but does elsewhere.
-(put 'option 'texinfo-format 'texinfo-format-option)
-(defun texinfo-format-option ()
-  "Insert ` ... ' around arg unless inside a table; in that case, no quotes."
-  ;; `looking-at-backward' not available in v. 18.57, 20.2
-  (if (not (search-backward ""    ; searched-for character is a control-H
-                    (save-excursion (beginning-of-line) (point))
-                    t))
-      (insert "`" (texinfo-parse-arg-discard) "'")
-      (insert  (texinfo-parse-arg-discard)))
-  (goto-char texinfo-command-start))
-
-(put 'emph 'texinfo-format 'texinfo-format-emph)
-(put 'strong 'texinfo-format 'texinfo-format-emph)
-(defun texinfo-format-emph ()
-  (insert "*" (texinfo-parse-arg-discard) "*")
-  (goto-char texinfo-command-start))
-
-(put 'dfn 'texinfo-format 'texinfo-format-defn)
-(put 'defn 'texinfo-format 'texinfo-format-defn)
-(defun texinfo-format-defn ()
-  (insert "\"" (texinfo-parse-arg-discard) "\"")
-  (goto-char texinfo-command-start))
-
-(put 'email 'texinfo-format 'texinfo-format-email)
-(defun texinfo-format-email ()
-  "Format email address and optional following full name.
-Insert full name, if present, followed by email address
-surrounded by in angle brackets."
-  (let ((args (texinfo-format-parse-args)))
-    (texinfo-discard-command)
-    ;; if full-name
-    (if (nth 1 args)
-        (insert  (nth 1 args) " "))
-    (insert "<" (nth 0 args) ">")))
-
-(put 'key 'texinfo-format 'texinfo-format-key)
-;; I've decided not want to have angle brackets around these -- rms.
-(defun texinfo-format-key ()
-  (insert (texinfo-parse-arg-discard))
-  (goto-char texinfo-command-start))
-
-;; @verb{<char>TEXT<char>} (in `makeinfo' 4.1 and later)
-(put 'verb 'texinfo-format 'texinfo-format-verb)
-(defun texinfo-format-verb ()
-  "Format text between non-quoted unique delimiter characters verbatim.
-Enclose the verbatim text, including the delimiters, in braces.  Print
-text exactly as written (but not the delimiters) in a fixed-width.
-
-For example, @verb\{|@|\} results in @ and
-@verb\{+@'e?`!`+} results in @'e?`!`."
-
-  (let ((delimiter (buffer-substring-no-properties
-		    (1+ texinfo-command-end) (+ 2 texinfo-command-end))))
-    (unless (looking-at "{")
-      (error "Not found: @verb start brace"))
-    (delete-region texinfo-command-start (+ 2 texinfo-command-end))
-    (search-forward  delimiter))
-  (delete-backward-char 1)
-  (unless (looking-at "}")
-    (error "Not found: @verb end brace"))
-  (delete-char 1))
-
-;; as of 2002 Dec 10
-;; see (texinfo)Block Enclosing Commands
-;; need: @verbatim
-
-;; as of 2002 Dec 10
-;; see (texinfo)verbatiminclude
-;; need: @verbatiminclude FILENAME
-
-(put 'bullet 'texinfo-format 'texinfo-format-bullet)
-(defun texinfo-format-bullet ()
-  "Insert an asterisk.
-If used within a line, follow `@bullet' with braces."
-  (texinfo-optional-braces-discard)
-  (insert "*"))
-
-
-;;; @kbd
-
-;; Inside of @example ... @end example and similar environments,
-;; @kbd does nothing; but outside of such environments, it places
-;; single quotation marks around its argument.
-
-(defvar texinfo-format-kbd-regexp
-  (concat
-   "^@"
-   "\\("
-   "display\\|"
-   "example\\|"
-   "smallexample\\|"
-   "lisp\\|"
-   "smalllisp"
-   "\\)")
-  "Regexp specifying environments in which @kbd does not put `...'
-  around argument.")
-
-(defvar texinfo-format-kbd-end-regexp
-  (concat
-   "^@end "
-   "\\("
-   "display\\|"
-   "example\\|"
-   "smallexample\\|"
-   "lisp\\|"
-   "smalllisp"
-   "\\)")
-  "Regexp specifying end of environments in which @kbd does not put `...'
-  around argument. (See `texinfo-format-kbd-regexp')")
-
-(put 'kbd 'texinfo-format 'texinfo-format-kbd)
-(defun texinfo-format-kbd ()
-  "Place single quote marks around arg, except in @example and similar."
-  ;; Search forward for @end example closer than an @example.
-  ;; Can stop search at nearest @node or texinfo-section-types-regexp
-  (let* ((stop
-          (save-excursion
-            (re-search-forward
-             (concat "^@node\\|\\(" texinfo-section-types-regexp "\\)")
-             nil
-             'move-to-end)    ; if necessary, return point at end of buffer
-            (point)))
-         (example-location
-          (save-excursion
-            (re-search-forward texinfo-format-kbd-regexp stop 'move-to-end)
-            (point)))
-         (end-example-location
-          (save-excursion
-            (re-search-forward texinfo-format-kbd-end-regexp stop 'move-to-end)
-            (point))))
-    ;; If inside @example, @end example will be closer than @example
-    ;; or end of search i.e., end-example-location less than example-location
-    (if (>= end-example-location example-location)
-        ;; outside an @example or equivalent
-        (insert "`" (texinfo-parse-arg-discard) "'")
-      ;; else, in @example; do not surround with `...'
-      (insert (texinfo-parse-arg-discard)))
-    (goto-char texinfo-command-start)))
-
-
-;;; @example, @lisp, @quotation, @display, @smalllisp, @smallexample,
-;;  @smalldisplay
-
-(put 'display 'texinfo-format 'texinfo-format-example)
-(put 'smalldisplay 'texinfo-format 'texinfo-format-example)
-(put 'example 'texinfo-format 'texinfo-format-example)
-(put 'lisp 'texinfo-format 'texinfo-format-example)
-(put 'quotation 'texinfo-format 'texinfo-format-example)
-(put 'smallexample 'texinfo-format 'texinfo-format-example)
-(put 'smalllisp 'texinfo-format 'texinfo-format-example)
-(defun texinfo-format-example ()
-  (texinfo-push-stack 'example nil)
-  (setq fill-column (- fill-column 5))
-  (texinfo-discard-line))
-
-(put 'example 'texinfo-end 'texinfo-end-example)
-(put 'display 'texinfo-end 'texinfo-end-example)
-(put 'smalldisplay 'texinfo-end 'texinfo-end-example)
-(put 'lisp 'texinfo-end 'texinfo-end-example)
-(put 'quotation 'texinfo-end 'texinfo-end-example)
-(put 'smallexample 'texinfo-end 'texinfo-end-example)
-(put 'smalllisp 'texinfo-end 'texinfo-end-example)
-(defun texinfo-end-example ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'example)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-(put 'exdent 'texinfo-format 'texinfo-format-exdent)
-(defun texinfo-format-exdent ()
-  (texinfo-discard-command)
-  (delete-region (point)
-                 (progn
-                  (skip-chars-forward " ")
-                  (point)))
-  (insert ?\b)
-  ;; Cancel out the deletion that texinfo-do-itemize
-  ;; is going to do at the end of this line.
-  (save-excursion
-    (end-of-line)
-    (insert "\n     ")))
-
-
-;; @direntry and @dircategory
-
-(put 'direntry 'texinfo-format 'texinfo-format-direntry)
-(defun texinfo-format-direntry ()
-  (texinfo-push-stack 'direntry nil)
-  (texinfo-discard-line)
-  (insert "START-INFO-DIR-ENTRY\n"))
-
-(put 'direntry 'texinfo-end 'texinfo-end-direntry)
-(defun texinfo-end-direntry ()
-  (texinfo-discard-command)
-  (insert "END-INFO-DIR-ENTRY\n\n")
-  (texinfo-pop-stack 'direntry))
-
-(put 'dircategory 'texinfo-format 'texinfo-format-dircategory)
-(defun texinfo-format-dircategory ()
-  (let ((str (texinfo-parse-arg-discard)))
-    (delete-region (point)
-                   (progn
-                     (skip-chars-forward " ")
-                     (point)))
-    (insert "INFO-DIR-SECTION " str "\n")))
-
-;;; @cartouche
-
-;; The @cartouche command is a noop in Info; in a printed manual,
-;; it makes a box with rounded corners.
-
-(put 'cartouche 'texinfo-format 'texinfo-discard-line)
-(put 'cartouche 'texinfo-end 'texinfo-discard-command)
-
-
-;;; @flushleft and @format
-
-;; The @flushleft command left justifies every line but leaves the
-;; right end ragged.  As far as Info is concerned, @flushleft is a
-;; `do-nothing' command
-
-;; The @format command is similar to @example except that it does not
-;; indent; this means that in Info, @format is similar to @flushleft.
-
-(put 'format 'texinfo-format 'texinfo-format-flushleft)
-(put 'smallformat 'texinfo-format 'texinfo-format-flushleft)
-(put 'flushleft 'texinfo-format 'texinfo-format-flushleft)
-(defun texinfo-format-flushleft ()
-  (texinfo-discard-line))
-
-(put 'format 'texinfo-end 'texinfo-end-flushleft)
-(put 'smallformat 'texinfo-end 'texinfo-end-flushleft)
-(put 'flushleft 'texinfo-end 'texinfo-end-flushleft)
-(defun texinfo-end-flushleft ()
-  (texinfo-discard-command))
-
-
-;;; @flushright
-
-;; The @flushright command right justifies every line but leaves the
-;; left end ragged.  Spaces and tabs at the right ends of lines are
-;; removed so that visible text lines up on the right side.
-
-(put 'flushright 'texinfo-format 'texinfo-format-flushright)
-(defun texinfo-format-flushright ()
-  (texinfo-push-stack 'flushright nil)
-  (texinfo-discard-line))
-
-(put 'flushright 'texinfo-end 'texinfo-end-flushright)
-(defun texinfo-end-flushright ()
-  (texinfo-discard-command)
-
-  (let ((stacktop
-         (texinfo-pop-stack 'flushright)))
-
-    (texinfo-do-flushright (nth 1 stacktop))))
-
-(defun texinfo-do-flushright (from)
-  (save-excursion
-   (while (progn (forward-line -1)
-                 (>= (point) from))
-
-     (beginning-of-line)
-     (insert
-      (make-string
-       (- fill-column
-          (save-excursion
-            (end-of-line)
-            (skip-chars-backward " \t")
-            (delete-region (point) (progn (end-of-line) (point)))
-            (current-column)))
-       ? )))))
-
-
-;;; @ctrl, @TeX, @copyright, @minus, @dots, @enddots, @pounds
-
-(put 'ctrl 'texinfo-format 'texinfo-format-ctrl)
-(defun texinfo-format-ctrl ()
-  (let ((str (texinfo-parse-arg-discard)))
-    (insert (logand 31 (aref str 0)))))
-
-(put 'TeX 'texinfo-format 'texinfo-format-TeX)
-(defun texinfo-format-TeX ()
-  (texinfo-parse-arg-discard)
-  (insert "TeX"))
-
-(put 'copyright 'texinfo-format 'texinfo-format-copyright)
-(defun texinfo-format-copyright ()
-  (texinfo-parse-arg-discard)
-  (insert "(C)"))
-
-(put 'minus 'texinfo-format 'texinfo-format-minus)
-(defun texinfo-format-minus ()
-  "Insert a minus sign.
-If used within a line, follow `@minus' with braces."
-  (texinfo-optional-braces-discard)
-  (insert "-"))
-
-(put 'dots 'texinfo-format 'texinfo-format-dots)
-(defun texinfo-format-dots ()
-  (texinfo-parse-arg-discard)
-  (insert "..."))
-
-(put 'enddots 'texinfo-format 'texinfo-format-enddots)
-(defun texinfo-format-enddots ()
-  (texinfo-parse-arg-discard)
-  (insert "...."))
-
-(put 'pounds 'texinfo-format 'texinfo-format-pounds)
-(defun texinfo-format-pounds ()
-  (texinfo-parse-arg-discard)
-  (insert "#"))
-
-
-;;; Refilling and indenting:  @refill, @paragraphindent, @noindent
-
-;;; Indent only those paragraphs that are refilled as a result of an
-;;; @refill command.
-
-;;    * If the value is `asis', do not change the existing indentation at
-;;      the starts of paragraphs.
-
-;;    * If the value zero, delete any existing indentation.
-
-;;    * If the value is greater than zero, indent each paragraph by that
-;;      number of spaces.
-
-;;; But do not refill paragraphs with an @refill command that are
-;;; preceded by @noindent or are part of a table, list, or deffn.
-
-(defvar texinfo-paragraph-indent "asis"
-  "Number of spaces for @refill to indent a paragraph; else to leave as is.")
-
-(put 'paragraphindent 'texinfo-format 'texinfo-paragraphindent)
-
-(defun texinfo-paragraphindent ()
-  "Specify the number of spaces for @refill to indent a paragraph.
-Default is to leave the number of spaces as is."
-  (let ((arg  (texinfo-parse-arg-discard)))
-    (if (string= "asis" arg)
-        (setq texinfo-paragraph-indent "asis")
-      (setq texinfo-paragraph-indent (string-to-number arg)))))
-
-(put 'refill 'texinfo-format 'texinfo-format-refill)
-(defun texinfo-format-refill ()
-  "Refill paragraph. Also, indent first line as set by @paragraphindent.
-Default is to leave paragraph indentation as is."
-  (texinfo-discard-command)
-  (let ((position (point-marker)))
-    (forward-paragraph -1)
-    (if (looking-at "[ \t\n]*$") (forward-line 1))
-    ;; Do not indent if an entry in a list, table, or deffn,
-    ;; or if paragraph is preceded by @noindent.
-    ;; Otherwise, indent
-    (cond
-     ;; delete a @noindent line and do not indent paragraph
-     ((save-excursion (forward-line -1)
-		      (looking-at "^@noindent"))
-      (forward-line -1)
-      (delete-region (point) (progn (forward-line 1) (point))))
-     ;; do nothing if "asis"
-     ((equal texinfo-paragraph-indent "asis"))
-     ;; do no indenting in list, etc.
-     ((> texinfo-stack-depth 0))
-     ;; otherwise delete existing whitespace and indent
-     (t
-      (delete-region (point) (progn (skip-chars-forward " \t") (point)))
-      (insert (make-string texinfo-paragraph-indent ? ))))
-    (forward-paragraph 1)
-    (forward-line -1)
-    (end-of-line)
-    ;; Do not fill a section title line with asterisks, hyphens, etc. that
-    ;; are used to underline it.  This could occur if the line following
-    ;; the underlining is not an index entry and has text within it.
-    (let* ((previous-paragraph-separate paragraph-separate)
-	   (paragraph-separate
-	    (concat paragraph-separate "\\|[-=.]+\\|\\*\\*+"))
-	   (previous-paragraph-start paragraph-start)
-	   (paragraph-start
-	    (concat paragraph-start "\\|[-=.]+\\|\\*\\*+")))
-      (unwind-protect
-          (fill-paragraph nil)
-        (setq paragraph-separate previous-paragraph-separate)
-        (setq paragraph-start previous-paragraph-start)))
-    (goto-char position)))
-
-(put 'noindent 'texinfo-format 'texinfo-noindent)
-(defun texinfo-noindent ()
-  (save-excursion
-    (forward-paragraph 1)
-    (if (search-backward "@refill"
-                            (save-excursion (forward-line -1) (point)) t)
-        () ; leave @noindent command so @refill command knows not to indent
-      ;; else
-      (texinfo-discard-line))))
-
-
-;;; Index generation
-
-(put 'vindex 'texinfo-format 'texinfo-format-vindex)
-(defun texinfo-format-vindex ()
-  (texinfo-index 'texinfo-vindex))
-
-(put 'cindex 'texinfo-format 'texinfo-format-cindex)
-(defun texinfo-format-cindex ()
-  (texinfo-index 'texinfo-cindex))
-
-(put 'findex 'texinfo-format 'texinfo-format-findex)
-(defun texinfo-format-findex ()
-  (texinfo-index 'texinfo-findex))
-
-(put 'pindex 'texinfo-format 'texinfo-format-pindex)
-(defun texinfo-format-pindex ()
-  (texinfo-index 'texinfo-pindex))
-
-(put 'tindex 'texinfo-format 'texinfo-format-tindex)
-(defun texinfo-format-tindex ()
-  (texinfo-index 'texinfo-tindex))
-
-(put 'kindex 'texinfo-format 'texinfo-format-kindex)
-(defun texinfo-format-kindex ()
-  (texinfo-index 'texinfo-kindex))
-
-(defun texinfo-index (indexvar)
-  (let ((arg (texinfo-parse-expanded-arg)))
-    (texinfo-discard-command)
-    (set indexvar
-         (cons (list arg
-                     texinfo-last-node
-                     ;; Region formatting may not provide last node position.
-                     (if texinfo-last-node-pos
-                         (1+ (count-lines texinfo-last-node-pos (point)))
-                       1))
-               (symbol-value indexvar)))))
-
-(defconst texinfo-indexvar-alist
-  '(("cp" . texinfo-cindex)
-    ("fn" . texinfo-findex)
-    ("vr" . texinfo-vindex)
-    ("tp" . texinfo-tindex)
-    ("pg" . texinfo-pindex)
-    ("ky" . texinfo-kindex)))
-
-
-;;; @defindex   @defcodeindex
-(put 'defindex 'texinfo-format 'texinfo-format-defindex)
-(put 'defcodeindex 'texinfo-format 'texinfo-format-defindex)
-
-(defun texinfo-format-defindex ()
-  (let* ((index-name (texinfo-parse-arg-discard)) ; eg: `aa'
-         (indexing-command (intern (concat index-name "index")))
-         (index-formatting-command      ; eg: `texinfo-format-aaindex'
-          (intern (concat "texinfo-format-" index-name "index")))
-         (index-alist-name              ; eg: `texinfo-aaindex'
-          (intern (concat "texinfo-" index-name "index"))))
-
-    (set index-alist-name nil)
-
-    (put indexing-command               ; eg, aaindex
-         'texinfo-format
-         index-formatting-command)      ; eg, texinfo-format-aaindex
-
-    ;; eg: "aa" . texinfo-aaindex
-    (or (assoc index-name texinfo-indexvar-alist)
-        (setq texinfo-indexvar-alist
-              (cons
-               (cons index-name
-                     index-alist-name)
-               texinfo-indexvar-alist)))
-
-    (fset index-formatting-command
-          (list 'lambda 'nil
-                (list 'texinfo-index
-                      (list 'quote index-alist-name))))))
-
-
-;;; @synindex   @syncodeindex
-
-(put 'synindex 'texinfo-format 'texinfo-format-synindex)
-(put 'syncodeindex 'texinfo-format 'texinfo-format-synindex)
-
-(defun texinfo-format-synindex ()
-  (let* ((args (texinfo-parse-arg-discard))
-         (second (cdr (read-from-string args)))
-         (joiner (symbol-name (car (read-from-string args))))
-         (joined (symbol-name (car (read-from-string args second)))))
-
-    (if (assoc joiner texinfo-short-index-cmds-alist)
-        (put
-          (cdr (assoc joiner texinfo-short-index-cmds-alist))
-         'texinfo-format
-         (or (cdr (assoc joined texinfo-short-index-format-cmds-alist))
-             (intern (concat "texinfo-format-" joined "index"))))
-      (put
-       (intern (concat joiner "index"))
-       'texinfo-format
-       (or (cdr(assoc joined texinfo-short-index-format-cmds-alist))
-           (intern (concat "texinfo-format-" joined "index")))))))
-
-(defconst texinfo-short-index-cmds-alist
-  '(("cp" . cindex)
-    ("fn" . findex)
-    ("vr" . vindex)
-    ("tp" . tindex)
-    ("pg" . pindex)
-    ("ky" . kindex)))
-
-(defconst texinfo-short-index-format-cmds-alist
-  '(("cp" . texinfo-format-cindex)
-    ("fn" . texinfo-format-findex)
-    ("vr" . texinfo-format-vindex)
-    ("tp" . texinfo-format-tindex)
-    ("pg" . texinfo-format-pindex)
-    ("ky" . texinfo-format-kindex)))
-
-
-;;; Sort and index (for VMS)
-
-;; Sort an index which is in the current buffer between START and END.
-;; Used on VMS, where the `sort' utility is not available.
-(defun texinfo-sort-region (start end)
-  (require 'sort)
-  (save-restriction
-    (narrow-to-region start end)
-    (goto-char (point-min))
-    (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun)))
-
-;; Subroutine for sorting an index.
-;; At start of a line, return a string to sort the line under.
-(defun texinfo-sort-startkeyfun ()
-  (let ((line (buffer-substring-no-properties (point) (point-at-eol))))
-    ;; Canonicalize whitespace and eliminate funny chars.
-    (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line)
-      (setq line (concat (substring line 0 (match-beginning 0))
-                         " "
-                         (substring line (match-end 0)))))
-    line))
-
-
-;;; @printindex
-
-(put 'printindex 'texinfo-format 'texinfo-format-printindex)
-
-(defun texinfo-format-printindex ()
-  (let ((indexelts (symbol-value
-                    (cdr (assoc (texinfo-parse-arg-discard)
-                                texinfo-indexvar-alist))))
-        opoint npoint)
-    (insert "\n* Menu:\n\n")
-    (setq opoint (point))
-    (texinfo-print-index nil indexelts)
-    (setq npoint (point))
-    (if (memq system-type '(vax-vms windows-nt ms-dos))
-	(texinfo-sort-region opoint npoint)
-      (shell-command-on-region opoint npoint "sort -fd" 1))
-    (goto-char npoint)))
-
-(defun texinfo-print-index (file indexelts)
-  (while indexelts
-    (if (stringp (car (car indexelts)))
-        (progn
-          (insert "* " (car (car indexelts)) ": " )
-          (indent-to 32)
-          (insert
-           (if file (concat "(" file ")") "")
-           (nth 1 (car indexelts)) ".")
-          (indent-to 54)
-          (insert
-           (if (nth 2 (car indexelts))
-               (format "  (line %3d)" (1+ (nth 2 (car indexelts))))
-             "")
-           "\n"))
-      ;; index entries from @include'd file
-      (texinfo-print-index (nth 1 (car indexelts))
-                           (nth 2 (car indexelts))))
-    (setq indexelts (cdr indexelts))))
-
-
-;;; Glyphs: @equiv, @error, etc
-
-;; @equiv           to show that two expressions are equivalent
-;; @error           to show an error message
-;; @expansion       to show what a macro expands to
-;; @point           to show the location of point in an example
-;; @print           to show what an evaluated expression prints
-;; @result          to indicate the value returned by an expression
-
-(put 'equiv 'texinfo-format 'texinfo-format-equiv)
-(defun texinfo-format-equiv ()
-  (texinfo-parse-arg-discard)
-  (insert "=="))
-
-(put 'error 'texinfo-format 'texinfo-format-error)
-(defun texinfo-format-error ()
-  (texinfo-parse-arg-discard)
-  (insert "error-->"))
-
-(put 'expansion 'texinfo-format 'texinfo-format-expansion)
-(defun texinfo-format-expansion ()
-  (texinfo-parse-arg-discard)
-  (insert "==>"))
-
-(put 'point 'texinfo-format 'texinfo-format-point)
-(defun texinfo-format-point ()
-  (texinfo-parse-arg-discard)
-  (insert "-!-"))
-
-(put 'print 'texinfo-format 'texinfo-format-print)
-(defun texinfo-format-print ()
-  (texinfo-parse-arg-discard)
-  (insert "-|"))
-
-(put 'result 'texinfo-format 'texinfo-format-result)
-(defun texinfo-format-result ()
-  (texinfo-parse-arg-discard)
-  (insert "=>"))
-
-
-;;; Accent commands
-
-;; Info presumes a plain ASCII output, so the accented characters do
-;; not look as they would if typeset, or output with a different
-;; character set.
-
-;; See the `texinfo-accent-commands' variable
-;; in the section for `texinfo-append-refill'.
-;; Also, see the defun for `texinfo-format-scan'
-;; for single-character accent commands.
-
-;; Command           Info output         Name
-
-;;   These do not have braces:
-;; @^              ==>    ^         circumflex accent
-;; @`              ==>    `         grave accent
-;; @'              ==>    '         acute accent
-;; @"              ==>    "         umlaut accent
-;; @=              ==>    =         overbar accent
-;; @~              ==>    ~         tilde accent
-
-;;   These have braces, but take no argument:
-;; @OE{}           ==>    OE        French-OE-ligature
-;; @oe{}           ==>    oe
-;; @AA{}           ==>    AA        Scandinavian-A-with-circle
-;; @aa{}           ==>    aa
-;; @AE{}           ==>    AE        Latin-Scandinavian-AE
-;; @ae{}           ==>    ae
-;; @ss{}           ==>    ss        German-sharp-S
-
-;; @questiondown{} ==>    ?         upside-down-question-mark
-;; @exclamdown{}   ==>    !         upside-down-exclamation-mark
-;; @L{}            ==>    L/        Polish suppressed-L (Lslash)
-;; @l{}            ==>    l/        Polish suppressed-L (Lslash) (lower case)
-;; @O{}            ==>    O/        Scandinavian O-with-slash
-;; @o{}            ==>    o/        Scandinavian O-with-slash (lower case)
-
-;;   These have braces, and take an argument:
-;; @,{c}           ==>    c,        cedilla accent
-;; @dotaccent{o}   ==>    .o        overdot-accent
-;; @ubaraccent{o}  ==>    _o        underbar-accent
-;; @udotaccent{o}  ==>    o-.       underdot-accent
-;; @H{o}           ==>    ""o       long Hungarian umlaut
-;; @ringaccent{o}  ==>    *o        ring accent
-;; @tieaccent{oo}  ==>    [oo       tie after accent
-;; @u{o}           ==>    (o        breve accent
-;; @v{o}           ==>    <o        hacek accent
-;; @dotless{i}     ==>    i         dotless i and dotless j
-
-;; ==========
-
-;; Note: The  defun texinfo-format-scan
-;; looks at "[@{}^'`\",=~ *?!-]"
-;; In the case of @*, a line break is inserted;
-;; in the other cases, the characters are simply quoted and the @ is deleted.
-;; Thus, `texinfo-format-scan' handles the following
-;; single-character accent commands: @^ @` @' @" @, @- @= @~
-
-;; @^              ==>    ^         circumflex accent
-;; (put '^ 'texinfo-format 'texinfo-format-circumflex-accent)
-;; (defun texinfo-format-circumflex-accent ()
-;;   (texinfo-discard-command)
-;;   (insert "^"))
-;;
-;; @`              ==>    `         grave accent
-;; (put '\` 'texinfo-format 'texinfo-format-grave-accent)
-;; (defun texinfo-format-grave-accent ()
-;;   (texinfo-discard-command)
-;;   (insert "\`"))
-;;
-;; @'              ==>    '         acute accent
-;; (put '\' 'texinfo-format 'texinfo-format-acute-accent)
-;; (defun texinfo-format-acute-accent ()
-;;   (texinfo-discard-command)
-;;   (insert "'"))
-;;
-;; @"              ==>    "         umlaut accent
-;; (put '\" 'texinfo-format 'texinfo-format-umlaut-accent)
-;; (defun texinfo-format-umlaut-accent ()
-;;   (texinfo-discard-command)
-;;   (insert "\""))
-;;
-;; @=              ==>    =         overbar accent
-;; (put '= 'texinfo-format 'texinfo-format-overbar-accent)
-;; (defun texinfo-format-overbar-accent ()
-;;   (texinfo-discard-command)
-;;   (insert "="))
-;;
-;; @~              ==>    ~         tilde accent
-;; (put '~ 'texinfo-format 'texinfo-format-tilde-accent)
-;; (defun texinfo-format-tilde-accent ()
-;;   (texinfo-discard-command)
-;;   (insert "~"))
-
-;; @OE{}           ==>    OE        French-OE-ligature
-(put 'OE 'texinfo-format 'texinfo-format-French-OE-ligature)
-(defun texinfo-format-French-OE-ligature ()
-   (insert "OE" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @oe{}           ==>    oe
-(put 'oe 'texinfo-format 'texinfo-format-French-oe-ligature)
-(defun texinfo-format-French-oe-ligature ()  ; lower case
-   (insert "oe" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @AA{}           ==>    AA        Scandinavian-A-with-circle
-(put 'AA 'texinfo-format 'texinfo-format-Scandinavian-A-with-circle)
-(defun texinfo-format-Scandinavian-A-with-circle ()
-   (insert "AA" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @aa{}           ==>    aa
-(put 'aa 'texinfo-format 'texinfo-format-Scandinavian-a-with-circle)
-(defun texinfo-format-Scandinavian-a-with-circle ()  ; lower case
-   (insert "aa" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @AE{}           ==>    AE        Latin-Scandinavian-AE
-(put 'AE 'texinfo-format 'texinfo-format-Latin-Scandinavian-AE)
-(defun texinfo-format-Latin-Scandinavian-AE ()
-   (insert "AE" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @ae{}           ==>    ae
-(put 'ae 'texinfo-format 'texinfo-format-Latin-Scandinavian-ae)
-(defun texinfo-format-Latin-Scandinavian-ae ()   ; lower case
-   (insert "ae" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @ss{}           ==>    ss        German-sharp-S
-(put 'ss 'texinfo-format 'texinfo-format-German-sharp-S)
-(defun texinfo-format-German-sharp-S ()
-   (insert "ss" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @questiondown{} ==>    ?         upside-down-question-mark
-(put 'questiondown 'texinfo-format 'texinfo-format-upside-down-question-mark)
-(defun texinfo-format-upside-down-question-mark ()
-   (insert "?" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @exclamdown{}   ==>    !         upside-down-exclamation-mark
-(put 'exclamdown 'texinfo-format 'texinfo-format-upside-down-exclamation-mark)
-(defun texinfo-format-upside-down-exclamation-mark ()
-   (insert "!" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @L{}            ==>    L/        Polish suppressed-L (Lslash)
-(put 'L 'texinfo-format 'texinfo-format-Polish-suppressed-L)
-(defun texinfo-format-Polish-suppressed-L ()
-   (insert (texinfo-parse-arg-discard) "/L")
-   (goto-char texinfo-command-start))
-
-;; @l{}            ==>    l/        Polish suppressed-L (Lslash) (lower case)
-(put 'l 'texinfo-format 'texinfo-format-Polish-suppressed-l-lower-case)
-(defun texinfo-format-Polish-suppressed-l-lower-case ()
-   (insert (texinfo-parse-arg-discard) "/l")
-   (goto-char texinfo-command-start))
-
-
-;; @O{}            ==>    O/        Scandinavian O-with-slash
-(put 'O 'texinfo-format 'texinfo-format-Scandinavian-O-with-slash)
-(defun texinfo-format-Scandinavian-O-with-slash ()
-   (insert (texinfo-parse-arg-discard) "O/")
-   (goto-char texinfo-command-start))
-
-;; @o{}            ==>    o/        Scandinavian O-with-slash (lower case)
-(put 'o 'texinfo-format 'texinfo-format-Scandinavian-o-with-slash-lower-case)
-(defun texinfo-format-Scandinavian-o-with-slash-lower-case ()
-   (insert (texinfo-parse-arg-discard) "o/")
-   (goto-char texinfo-command-start))
-
-;; Take arguments
-
-;; @,{c}           ==>    c,        cedilla accent
-(put ', 'texinfo-format 'texinfo-format-cedilla-accent)
-(defun texinfo-format-cedilla-accent ()
-   (insert (texinfo-parse-arg-discard) ",")
-  (goto-char texinfo-command-start))
-
-
-;; @dotaccent{o}   ==>    .o        overdot-accent
-(put 'dotaccent 'texinfo-format 'texinfo-format-overdot-accent)
-(defun texinfo-format-overdot-accent ()
-   (insert "." (texinfo-parse-arg-discard))
-  (goto-char texinfo-command-start))
-
-;; @ubaraccent{o}  ==>    _o        underbar-accent
-(put 'ubaraccent 'texinfo-format 'texinfo-format-underbar-accent)
-(defun texinfo-format-underbar-accent ()
-   (insert "_" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @udotaccent{o}  ==>    o-.       underdot-accent
-(put 'udotaccent 'texinfo-format 'texinfo-format-underdot-accent)
-(defun texinfo-format-underdot-accent ()
-   (insert (texinfo-parse-arg-discard) "-.")
-   (goto-char texinfo-command-start))
-
-;; @H{o}           ==>    ""o       long Hungarian umlaut
-(put 'H 'texinfo-format 'texinfo-format-long-Hungarian-umlaut)
-(defun texinfo-format-long-Hungarian-umlaut ()
-   (insert "\"\"" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @ringaccent{o}  ==>    *o        ring accent
-(put 'ringaccent 'texinfo-format 'texinfo-format-ring-accent)
-(defun texinfo-format-ring-accent ()
-   (insert "*" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @tieaccent{oo}  ==>    [oo       tie after accent
-(put 'tieaccent 'texinfo-format 'texinfo-format-tie-after-accent)
-(defun texinfo-format-tie-after-accent ()
-   (insert "[" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-
-;; @u{o}           ==>    (o        breve accent
-(put 'u 'texinfo-format 'texinfo-format-breve-accent)
-(defun texinfo-format-breve-accent ()
-   (insert "(" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-;; @v{o}           ==>    <o        hacek accent
-(put 'v 'texinfo-format 'texinfo-format-hacek-accent)
-(defun texinfo-format-hacek-accent ()
-   (insert "<" (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-
-;; @dotless{i}     ==>    i         dotless i and dotless j
-(put 'dotless 'texinfo-format 'texinfo-format-dotless)
-(defun texinfo-format-dotless ()
-   (insert  (texinfo-parse-arg-discard))
-   (goto-char texinfo-command-start))
-
-
-;;; Definition formatting: @deffn, @defun, etc
-
-;; What definition formatting produces:
-;;
-;; @deffn category name args...
-;;     In Info, `Category: name ARGS'
-;;     In index: name:  node. line#.
-;;
-;; @defvr category name
-;;     In Info, `Category: name'
-;;     In index: name:  node. line#.
-;;
-;; @deftp category name attributes...
-;; `category name attributes...'       Note: @deftp args in lower case.
-;;     In index: name:  node. line#.
-;;
-;; Specialized function-like or variable-like entity:
-;;
-;; @defun, @defmac, @defspec, @defvar, @defopt
-;;
-;; @defun name args           In Info, `Function: name ARGS'
-;; @defmac name args          In Info, `Macro: name ARGS'
-;; @defvar name               In Info, `Variable: name'
-;; etc.
-;;     In index: name:  node. line#.
-;;
-;; Generalized typed-function-like or typed-variable-like entity:
-;; @deftypefn category data-type name args...
-;;     In Info, `Category:  data-type name args...'
-;; @deftypevr category data-type name
-;;     In Info, `Category:  data-type name'
-;;     In index: name:  node. line#.
-;;
-;; Specialized typed-function-like or typed-variable-like entity:
-;; @deftypefun data-type name args...
-;;     In Info, `Function:  data-type name ARGS'
-;;     In index: name:  node. line#.
-;;
-;; @deftypevar data-type name
-;;     In Info, `Variable:  data-type name'
-;;     In index: name:  node. line#.   but include args after name!?
-;;
-;; Generalized object oriented entity:
-;; @defop category class name args...
-;;     In Info, `Category on class: name ARG'
-;;     In index: name on class: node. line#.
-;;
-;; @defcv category class name
-;;     In Info, `Category of class: name'
-;;     In index: name of class: node. line#.
-;;
-;; Specialized object oriented entity:
-;; @defmethod class name args...
-;;     In Info, `Method on class: name ARGS'
-;;     In index: name on class: node. line#.
-;;
-;; @defivar class name
-;;     In Info, `Instance variable of class: name'
-;;     In index: name of class: node. line#.
-
-
-;;; The definition formatting functions
-
-(defun texinfo-format-defun ()
-  (texinfo-push-stack 'defun nil)
-  (setq fill-column (- fill-column 5))
-  (texinfo-format-defun-1 t))
-
-(defun texinfo-end-defun ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((start (nth 1 (texinfo-pop-stack 'defun))))
-    (texinfo-do-itemize start)
-    ;; Delete extra newline inserted after header.
-    (save-excursion
-      (goto-char start)
-      (delete-char -1))))
-
-(defun texinfo-format-defunx ()
-  (texinfo-format-defun-1 nil))
-
-(defun texinfo-format-defun-1 (first-p)
-  (let ((parse-args (texinfo-format-parse-defun-args))
-        (texinfo-defun-type (get texinfo-command-name 'texinfo-defun-type)))
-    (texinfo-discard-command)
-    ;; Delete extra newline inserted after previous header line.
-    (if (not first-p)
-        (delete-char -1))
-    (funcall
-     (get texinfo-command-name 'texinfo-deffn-formatting-property) parse-args)
-    ;; Insert extra newline so that paragraph filling does not mess
-    ;; with header line.
-    (insert "\n\n")
-    (rplaca (cdr (cdr (car texinfo-stack))) (point))
-    (funcall
-     (get texinfo-command-name 'texinfo-defun-indexing-property) parse-args)))
-
-;;; Formatting the first line of a definition
-
-;; @deffn, @defvr, @deftp
-(put 'deffn 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'deffnx 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'defvr 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'defvrx 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'deftp 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'deftpx 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(defun texinfo-format-deffn (parsed-args)
-  ;; Generalized function-like, variable-like, or generic data-type entity:
-  ;; @deffn category name args...
-  ;;     In Info, `Category: name ARGS'
-  ;; @deftp category name attributes...
-  ;; `category name attributes...'       Note: @deftp args in lower case.
-  (let ((category (car parsed-args))
-        (name (car (cdr parsed-args)))
-        (args (cdr (cdr parsed-args))))
-    (insert " -- " category ": " name)
-    (while args
-      (insert " "
-              (if (or (= ?& (aref (car args) 0))
-                      (eq (eval (car texinfo-defun-type)) 'deftp-type))
-                  (car args)
-                (upcase (car args))))
-      (setq args (cdr args)))))
-
-;; @defun, @defmac, @defspec, @defvar, @defopt: Specialized, simple
-(put 'defun 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defunx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defmac 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defmacx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defspec 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defspecx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defvar 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defvarx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defopt 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defoptx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(defun texinfo-format-specialized-defun (parsed-args)
-  ;; Specialized function-like or variable-like entity:
-  ;; @defun name args           In Info, `Function: Name ARGS'
-  ;; @defmac name args          In Info, `Macro: Name ARGS'
-  ;; @defvar name               In Info, `Variable: Name'
-  ;; Use cdr of texinfo-defun-type to determine category:
-  (let ((category (car (cdr texinfo-defun-type)))
-        (name (car parsed-args))
-        (args (cdr parsed-args)))
-    (insert " -- " category ": " name)
-    (while args
-      (insert " "
-              (if (= ?& (aref (car args) 0))
-                  (car args)
-                (upcase (car args))))
-      (setq args (cdr args)))))
-
-;; @deftypefn, @deftypevr: Generalized typed
-(put 'deftypefn 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
-(put 'deftypefnx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
-(put 'deftypevr 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
-(put 'deftypevrx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
-(defun texinfo-format-deftypefn (parsed-args)
-  ;; Generalized typed-function-like or typed-variable-like entity:
-  ;; @deftypefn category data-type name args...
-  ;;     In Info, `Category:  data-type name args...'
-  ;; @deftypevr category data-type name
-  ;;     In Info, `Category:  data-type name'
-  ;; Note: args in lower case, unless modified in command line.
-  (let ((category (car parsed-args))
-        (data-type (car (cdr parsed-args)))
-        (name (car (cdr (cdr parsed-args))))
-        (args (cdr (cdr (cdr parsed-args)))))
-    (insert " -- " category ": " data-type " " name)
-    (while args
-      (insert " " (car args))
-      (setq args (cdr args)))))
-
-;; @deftypefun, @deftypevar: Specialized typed
-(put 'deftypefun 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun)
-(put 'deftypefunx 'texinfo-deffn-formatting-property
-     'texinfo-format-deftypefun)
-(put 'deftypevar 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun)
-(put 'deftypevarx 'texinfo-deffn-formatting-property
-     'texinfo-format-deftypefun)
-(defun texinfo-format-deftypefun (parsed-args)
-  ;; Specialized typed-function-like or typed-variable-like entity:
-  ;; @deftypefun data-type name args...
-  ;;     In Info, `Function:  data-type name ARGS'
-  ;; @deftypevar data-type name
-  ;;     In Info, `Variable:  data-type name'
-  ;; Note: args in lower case, unless modified in command line.
-  ;; Use cdr of texinfo-defun-type to determine category:
-  (let ((category (car (cdr texinfo-defun-type)))
-        (data-type (car parsed-args))
-        (name (car (cdr  parsed-args)))
-        (args (cdr (cdr parsed-args))))
-    (insert " -- " category ": " data-type " " name)
-    (while args
-      (insert " " (car args))
-      (setq args (cdr args)))))
-
-;; @defop: Generalized object-oriented
-(put 'defop 'texinfo-deffn-formatting-property 'texinfo-format-defop)
-(put 'defopx 'texinfo-deffn-formatting-property 'texinfo-format-defop)
-(defun texinfo-format-defop (parsed-args)
-  ;; Generalized object oriented entity:
-  ;; @defop category class name args...
-  ;;     In Info, `Category on class: name ARG'
-  ;; Note: args in upper case; use of `on'
-  (let ((category (car parsed-args))
-        (class (car (cdr parsed-args)))
-        (name (car (cdr (cdr parsed-args))))
-        (args (cdr (cdr (cdr parsed-args)))))
-    (insert " -- " category " on " class ": " name)
-    (while args
-      (insert " " (upcase (car args)))
-      (setq args (cdr args)))))
-
-;; @defcv: Generalized object-oriented
-(put 'defcv 'texinfo-deffn-formatting-property 'texinfo-format-defcv)
-(put 'defcvx 'texinfo-deffn-formatting-property 'texinfo-format-defcv)
-(defun texinfo-format-defcv (parsed-args)
-  ;; Generalized object oriented entity:
-  ;; @defcv category class name
-  ;;     In Info, `Category of class: name'
-  ;; Note: args in upper case; use of `of'
-  (let ((category (car parsed-args))
-        (class (car (cdr parsed-args)))
-        (name (car (cdr (cdr parsed-args))))
-        (args (cdr (cdr (cdr parsed-args)))))
-    (insert " -- " category " of " class ": " name)
-    (while args
-      (insert " " (upcase (car args)))
-      (setq args (cdr args)))))
-
-;; @defmethod: Specialized object-oriented
-(put 'defmethod 'texinfo-deffn-formatting-property 'texinfo-format-defmethod)
-(put 'defmethodx 'texinfo-deffn-formatting-property 'texinfo-format-defmethod)
-(defun texinfo-format-defmethod (parsed-args)
-  ;; Specialized object oriented entity:
-  ;; @defmethod class name args...
-  ;;     In Info, `Method on class: name ARGS'
-  ;; Note: args in upper case; use of `on'
-  ;; Use cdr of texinfo-defun-type to determine category:
-  (let ((category (car (cdr texinfo-defun-type)))
-        (class (car parsed-args))
-        (name (car (cdr  parsed-args)))
-        (args (cdr  (cdr parsed-args))))
-    (insert " -- " category " on " class ": " name)
-    (while args
-      (insert " " (upcase (car args)))
-      (setq args (cdr args)))))
-
-;; @defivar: Specialized object-oriented
-(put 'defivar 'texinfo-deffn-formatting-property 'texinfo-format-defivar)
-(put 'defivarx 'texinfo-deffn-formatting-property 'texinfo-format-defivar)
-(defun texinfo-format-defivar (parsed-args)
-  ;; Specialized object oriented entity:
-  ;; @defivar class name
-  ;;     In Info, `Instance variable of class: name'
-  ;; Note: args in upper case; use of `of'
-  ;; Use cdr of texinfo-defun-type to determine category:
-  (let ((category (car (cdr texinfo-defun-type)))
-        (class (car parsed-args))
-        (name (car (cdr  parsed-args)))
-        (args (cdr  (cdr parsed-args))))
-    (insert " -- " category " of " class ": " name)
-    (while args
-      (insert " " (upcase (car args)))
-      (setq args (cdr args)))))
-
-
-;;; Indexing for definitions
-
-;; An index entry has three parts: the `entry proper', the node name, and the
-;; line number.  Depending on the which command is used, the entry is
-;; formatted differently:
-;;
-;; @defun,
-;; @defmac,
-;; @defspec,
-;; @defvar,
-;; @defopt          all use their 1st argument as the entry-proper
-;;
-;; @deffn,
-;; @defvr,
-;; @deftp
-;; @deftypefun
-;; @deftypevar      all use their 2nd argument as the entry-proper
-;;
-;; @deftypefn,
-;; @deftypevr       both use their 3rd argument as the entry-proper
-;;
-;; @defmethod       uses its 2nd and 1st arguments as an entry-proper
-;;                    formatted: NAME on CLASS
-
-;; @defop           uses its 3rd and 2nd arguments as an entry-proper
-;;                    formatted: NAME on CLASS
-;;
-;; @defivar         uses its 2nd and 1st arguments as an entry-proper
-;;                    formatted: NAME of CLASS
-;;
-;; @defcv           uses its 3rd and 2nd argument as an entry-proper
-;;                    formatted: NAME of CLASS
-
-(put 'defun 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defunx 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defmac 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defmacx 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defspec 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defspecx 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defvar 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defvarx 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defopt  'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defoptx  'texinfo-defun-indexing-property 'texinfo-index-defun)
-(defun texinfo-index-defun (parsed-args)
-  ;; use 1st parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (car parsed-args)
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'deffn 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deffnx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'defvr 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'defvrx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftp 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftpx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftypefun 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftypefunx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftypevar 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftypevarx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(defun texinfo-index-deffn (parsed-args)
- ;; use 2nd parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (car (cdr parsed-args))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'deftypefn 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
-(put 'deftypefnx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
-(put 'deftypevr 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
-(put 'deftypevrx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
-(defun texinfo-index-deftypefn (parsed-args)
-  ;; use 3rd parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (car (cdr (cdr parsed-args)))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'defmethod 'texinfo-defun-indexing-property 'texinfo-index-defmethod)
-(put 'defmethodx 'texinfo-defun-indexing-property 'texinfo-index-defmethod)
-(defun texinfo-index-defmethod (parsed-args)
-  ;; use 2nd on 1st parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (format "%s on %s"
-                   (car (cdr parsed-args))
-                   (car parsed-args))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'defop 'texinfo-defun-indexing-property 'texinfo-index-defop)
-(put 'defopx 'texinfo-defun-indexing-property 'texinfo-index-defop)
-(defun texinfo-index-defop (parsed-args)
-  ;; use 3rd on 2nd parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (format "%s on %s"
-                   (car (cdr (cdr parsed-args)))
-                   (car (cdr parsed-args)))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'defivar 'texinfo-defun-indexing-property 'texinfo-index-defivar)
-(put 'defivarx 'texinfo-defun-indexing-property 'texinfo-index-defivar)
-(defun texinfo-index-defivar (parsed-args)
-  ;; use 2nd of 1st parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (format "%s of %s"
-                   (car (cdr parsed-args))
-                   (car parsed-args))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'defcv 'texinfo-defun-indexing-property 'texinfo-index-defcv)
-(put 'defcvx 'texinfo-defun-indexing-property 'texinfo-index-defcv)
-(defun texinfo-index-defcv (parsed-args)
-  ;; use 3rd of 2nd parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (format "%s of %s"
-                   (car (cdr (cdr parsed-args)))
-                   (car (cdr parsed-args)))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-
-;;; Properties for definitions
-
-;; Each definition command has six properties:
-;;
-;; 1. texinfo-deffn-formatting-property      to format definition line
-;; 2. texinfo-defun-indexing-property        to create index entry
-;; 3. texinfo-format                         formatting command
-;; 4. texinfo-end                            end formatting command
-;; 5. texinfo-defun-type                     type of deffn to format
-;; 6. texinfo-defun-index                    type of index to use
-;;
-;; The `x' forms of each definition command are used for the second
-;; and subsequent header lines.
-
-;; The texinfo-deffn-formatting-property and texinfo-defun-indexing-property
-;; are listed just before the appropriate formatting and indexing commands.
-
-(put 'deffn 'texinfo-format 'texinfo-format-defun)
-(put 'deffnx 'texinfo-format 'texinfo-format-defunx)
-(put 'deffn 'texinfo-end 'texinfo-end-defun)
-(put 'deffn 'texinfo-defun-type '('deffn-type nil))
-(put 'deffnx 'texinfo-defun-type '('deffn-type nil))
-(put 'deffn 'texinfo-defun-index 'texinfo-findex)
-(put 'deffnx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defun 'texinfo-format 'texinfo-format-defun)
-(put 'defunx 'texinfo-format 'texinfo-format-defunx)
-(put 'defun 'texinfo-end 'texinfo-end-defun)
-(put 'defun 'texinfo-defun-type '('defun-type "Function"))
-(put 'defunx 'texinfo-defun-type '('defun-type "Function"))
-(put 'defun 'texinfo-defun-index 'texinfo-findex)
-(put 'defunx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defmac 'texinfo-format 'texinfo-format-defun)
-(put 'defmacx 'texinfo-format 'texinfo-format-defunx)
-(put 'defmac 'texinfo-end 'texinfo-end-defun)
-(put 'defmac 'texinfo-defun-type '('defun-type "Macro"))
-(put 'defmacx 'texinfo-defun-type '('defun-type "Macro"))
-(put 'defmac 'texinfo-defun-index 'texinfo-findex)
-(put 'defmacx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defspec 'texinfo-format 'texinfo-format-defun)
-(put 'defspecx 'texinfo-format 'texinfo-format-defunx)
-(put 'defspec 'texinfo-end 'texinfo-end-defun)
-(put 'defspec 'texinfo-defun-type '('defun-type "Special form"))
-(put 'defspecx 'texinfo-defun-type '('defun-type "Special form"))
-(put 'defspec 'texinfo-defun-index 'texinfo-findex)
-(put 'defspecx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defvr 'texinfo-format 'texinfo-format-defun)
-(put 'defvrx 'texinfo-format 'texinfo-format-defunx)
-(put 'defvr 'texinfo-end 'texinfo-end-defun)
-(put 'defvr 'texinfo-defun-type '('deffn-type nil))
-(put 'defvrx 'texinfo-defun-type '('deffn-type nil))
-(put 'defvr 'texinfo-defun-index 'texinfo-vindex)
-(put 'defvrx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'defvar 'texinfo-format 'texinfo-format-defun)
-(put 'defvarx 'texinfo-format 'texinfo-format-defunx)
-(put 'defvar 'texinfo-end 'texinfo-end-defun)
-(put 'defvar 'texinfo-defun-type '('defun-type "Variable"))
-(put 'defvarx 'texinfo-defun-type '('defun-type "Variable"))
-(put 'defvar 'texinfo-defun-index 'texinfo-vindex)
-(put 'defvarx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'defconst 'texinfo-format 'texinfo-format-defun)
-(put 'defconstx 'texinfo-format 'texinfo-format-defunx)
-(put 'defconst 'texinfo-end 'texinfo-end-defun)
-(put 'defconst 'texinfo-defun-type '('defun-type "Constant"))
-(put 'defconstx 'texinfo-defun-type '('defun-type "Constant"))
-(put 'defconst 'texinfo-defun-index 'texinfo-vindex)
-(put 'defconstx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'defcmd 'texinfo-format 'texinfo-format-defun)
-(put 'defcmdx 'texinfo-format 'texinfo-format-defunx)
-(put 'defcmd 'texinfo-end 'texinfo-end-defun)
-(put 'defcmd 'texinfo-defun-type '('defun-type "Command"))
-(put 'defcmdx 'texinfo-defun-type '('defun-type "Command"))
-(put 'defcmd 'texinfo-defun-index 'texinfo-findex)
-(put 'defcmdx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defopt 'texinfo-format 'texinfo-format-defun)
-(put 'defoptx 'texinfo-format 'texinfo-format-defunx)
-(put 'defopt 'texinfo-end 'texinfo-end-defun)
-(put 'defopt 'texinfo-defun-type '('defun-type "User Option"))
-(put 'defoptx 'texinfo-defun-type '('defun-type "User Option"))
-(put 'defopt 'texinfo-defun-index 'texinfo-vindex)
-(put 'defoptx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'deftp 'texinfo-format 'texinfo-format-defun)
-(put 'deftpx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftp 'texinfo-end 'texinfo-end-defun)
-(put 'deftp 'texinfo-defun-type '('deftp-type nil))
-(put 'deftpx 'texinfo-defun-type '('deftp-type nil))
-(put 'deftp 'texinfo-defun-index 'texinfo-tindex)
-(put 'deftpx 'texinfo-defun-index 'texinfo-tindex)
-
-;;; Object-oriented stuff is a little hairier.
-
-(put 'defop 'texinfo-format 'texinfo-format-defun)
-(put 'defopx 'texinfo-format 'texinfo-format-defunx)
-(put 'defop 'texinfo-end 'texinfo-end-defun)
-(put 'defop 'texinfo-defun-type '('defop-type nil))
-(put 'defopx 'texinfo-defun-type '('defop-type nil))
-(put 'defop 'texinfo-defun-index 'texinfo-findex)
-(put 'defopx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defmethod 'texinfo-format 'texinfo-format-defun)
-(put 'defmethodx 'texinfo-format 'texinfo-format-defunx)
-(put 'defmethod 'texinfo-end 'texinfo-end-defun)
-(put 'defmethod 'texinfo-defun-type '('defmethod-type "Method"))
-(put 'defmethodx 'texinfo-defun-type '('defmethod-type "Method"))
-(put 'defmethod 'texinfo-defun-index 'texinfo-findex)
-(put 'defmethodx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defcv 'texinfo-format 'texinfo-format-defun)
-(put 'defcvx 'texinfo-format 'texinfo-format-defunx)
-(put 'defcv 'texinfo-end 'texinfo-end-defun)
-(put 'defcv 'texinfo-defun-type '('defop-type nil))
-(put 'defcvx 'texinfo-defun-type '('defop-type nil))
-(put 'defcv 'texinfo-defun-index 'texinfo-vindex)
-(put 'defcvx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'defivar 'texinfo-format 'texinfo-format-defun)
-(put 'defivarx 'texinfo-format 'texinfo-format-defunx)
-(put 'defivar 'texinfo-end 'texinfo-end-defun)
-(put 'defivar 'texinfo-defun-type '('defmethod-type "Instance variable"))
-(put 'defivarx 'texinfo-defun-type '('defmethod-type "Instance variable"))
-(put 'defivar 'texinfo-defun-index 'texinfo-vindex)
-(put 'defivarx 'texinfo-defun-index 'texinfo-vindex)
-
-;;; Typed functions and variables
-
-(put 'deftypefn 'texinfo-format 'texinfo-format-defun)
-(put 'deftypefnx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftypefn 'texinfo-end 'texinfo-end-defun)
-(put 'deftypefn 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypefnx 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypefn 'texinfo-defun-index 'texinfo-findex)
-(put 'deftypefnx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'deftypefun 'texinfo-format 'texinfo-format-defun)
-(put 'deftypefunx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftypefun 'texinfo-end 'texinfo-end-defun)
-(put 'deftypefun 'texinfo-defun-type '('deftypefun-type "Function"))
-(put 'deftypefunx 'texinfo-defun-type '('deftypefun-type "Function"))
-(put 'deftypefun 'texinfo-defun-index 'texinfo-findex)
-(put 'deftypefunx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'deftypevr 'texinfo-format 'texinfo-format-defun)
-(put 'deftypevrx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftypevr 'texinfo-end 'texinfo-end-defun)
-(put 'deftypevr 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypevrx 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypevr 'texinfo-defun-index 'texinfo-vindex)
-(put 'deftypevrx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'deftypevar 'texinfo-format 'texinfo-format-defun)
-(put 'deftypevarx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftypevar 'texinfo-end 'texinfo-end-defun)
-(put 'deftypevar 'texinfo-defun-type '('deftypevar-type "Variable"))
-(put 'deftypevarx 'texinfo-defun-type '('deftypevar-type "Variable"))
-(put 'deftypevar 'texinfo-defun-index 'texinfo-vindex)
-(put 'deftypevarx 'texinfo-defun-index 'texinfo-vindex)
-
-
-;;; @set, @clear, @ifset, @ifclear
-
-;; If a flag is set with @set FLAG, then text between @ifset and @end
-;; ifset is formatted normally, but if the flag is cleared with
-;; @clear FLAG, then the text is not formatted; it is ignored.
-
-;; If a flag is cleared with @clear FLAG, then text between @ifclear
-;; and @end ifclear is formatted normally, but if the flag is set with
-;; @set FLAG, then the text is not formatted; it is ignored.  @ifclear
-;; is the opposite of @ifset.
-
-;; If a flag is set to a string with @set FLAG,
-;; replace  @value{FLAG} with the string.
-;; If a flag with a value is cleared,
-;; @value{FLAG} is invalid,
-;; as if there had never been any @set FLAG previously.
-
-(put 'clear 'texinfo-format 'texinfo-clear)
-(defun texinfo-clear ()
-  "Clear the value of the flag."
-  (let* ((arg (texinfo-parse-arg-discard))
-         (flag (car (read-from-string arg)))
-         (value (substring arg (cdr (read-from-string arg)))))
-    (put flag 'texinfo-whether-setp 'flag-cleared)
-    (put flag 'texinfo-set-value "")))
-
-(put 'set 'texinfo-format 'texinfo-set)
-(defun texinfo-set ()
-  "Set the value of the flag, optionally to a string.
-The command  `@set foo This is a string.'
-sets flag foo to the value: `This is a string.'
-The command  `@value{foo}'  expands to the value."
-  (let* ((arg (texinfo-parse-arg-discard))
-         (flag (car (read-from-string arg)))
-         (value (substring arg (cdr (read-from-string arg)))))
-    (if (string-match "^[ \t]+" value)
-	(setq value (substring value (match-end 0))))
-    (put flag 'texinfo-whether-setp 'flag-set)
-    (put flag 'texinfo-set-value value)))
-
-(put 'value 'texinfo-format 'texinfo-value)
-(defun texinfo-value ()
-  "Insert the string to which the flag is set.
-The command  `@set foo This is a string.'
-sets flag foo to the value: `This is a string.'
-The command  `@value{foo}'  expands to the value."
-  (let ((arg (texinfo-parse-arg-discard)))
-    (cond ((and
-            (eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-                'flag-set)
-            (get (car (read-from-string arg)) 'texinfo-set-value))
-           (insert (get (car (read-from-string arg)) 'texinfo-set-value)))
-          ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-               'flag-cleared)
-           (insert (format "{No value for \"%s\"}"  arg)))
-          ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) nil)
-           (insert (format "{No value for \"%s\"}"  arg))))))
-
-(put 'ifset 'texinfo-end 'texinfo-discard-command)
-(put 'ifset 'texinfo-format 'texinfo-if-set)
-(defun texinfo-if-set ()
-  "If set, continue formatting; else do not format region up to @end ifset"
-  (let ((arg (texinfo-parse-arg-discard)))
-    (cond
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          'flag-set)
-      ;; Format the text (i.e., do not remove it); do nothing here.
-      ())
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          'flag-cleared)
-      ;; Clear region (i.e., cause the text to be ignored).
-      (delete-region texinfo-command-start
-		     (re-search-forward "@end ifset[ \t]*\n")))
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          nil)
-      ;; In this case flag is neither set nor cleared.
-      ;; Act as if set, i.e. do nothing.
-      ()))))
-
-(put 'ifclear 'texinfo-end 'texinfo-discard-command)
-(put 'ifclear 'texinfo-format 'texinfo-if-clear)
-(defun texinfo-if-clear ()
-  "If clear, continue formatting; if set, do not format up to @end ifset"
-  (let ((arg (texinfo-parse-arg-discard)))
-    (cond
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          'flag-set)
-      ;; Clear region (i.e., cause the text to be ignored).
-      (delete-region texinfo-command-start
-		     (re-search-forward "@end ifclear[ \t]*\n")))
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          'flag-cleared)
-      ;; Format the text (i.e., do not remove it); do nothing here.
-      ())
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          nil)
-      ;; In this case flag is neither set nor cleared.
-      ;; Act as if clear, i.e. do nothing.
-      ()))))
-
-;;; @ifeq
-
-(put 'ifeq 'texinfo-format 'texinfo-format-ifeq)
-(defun texinfo-format-ifeq ()
-  "If ARG1 and ARG2 caselessly string compare to same string, perform COMMAND.
-Otherwise produces no output.
-
-Thus:
-        @ifeq{ arg1 , arg1 , @code{foo}} bar
-
-        ==> `foo' bar.
-but
-        @ifeq{ arg1 , arg2 , @code{foo}} bar
-
-        ==> bar
-
-Note that the Texinfo command and its arguments must be arguments to
-the @ifeq command."
-  ;; compare-buffer-substrings does not exist in version 18; don't use
-  (goto-char texinfo-command-end)
-  (let* ((case-fold-search t)
-         (stop (save-excursion (forward-sexp 1) (point)))
-        start end
-        ;; @ifeq{arg1, arg2, @command{optional-args}}
-        (arg1
-         (progn
-           (forward-char 1)
-           (skip-chars-forward " ")
-           (setq start (point))
-           (search-forward "," stop t)
-           (skip-chars-backward ", ")
-           (buffer-substring-no-properties start (point))))
-        (arg2
-         (progn
-           (search-forward "," stop t)
-           (skip-chars-forward " ")
-           (setq start (point))
-           (search-forward "," stop t)
-           (skip-chars-backward ", ")
-           (buffer-substring-no-properties start (point))))
-        (texinfo-command
-         (progn
-           (search-forward "," stop t)
-           (skip-chars-forward " ")
-           (setq start (point))
-           (goto-char (1- stop))
-           (skip-chars-backward " ")
-           (buffer-substring-no-properties start (point)))))
-    (delete-region texinfo-command-start stop)
-    (if (equal arg1 arg2)
-        (insert texinfo-command))
-    (goto-char texinfo-command-start)))
-
-
-;;; Process included files:  `@include' command
-
-;; Updated 19 October 1990
-;; In the original version, include files were ignored by Info but
-;; incorporated in to the printed manual.  To make references to the
-;; included file, the Texinfo source file has to refer to the included
-;; files using the `(filename)nodename' format for referring to other
-;; Info files.  Also, the included files had to be formatted on their
-;; own.  It was just like they were another file.
-
-;; Currently, include files are inserted into the buffer that is
-;; formatted for Info.  If large, the resulting info file is split and
-;; tagified.  For current include files to work, the master menu must
-;; refer to all the nodes, and the highest level nodes in the include
-;; files must have the correct next, prev, and up pointers.
-
-;; The included file may have an @setfilename and even an @settitle,
-;; but not an `\input texinfo' line.
-
-;; Updated 24 March 1993
-;; In order for @raisesections and @lowersections to work, included
-;; files must be inserted into the buffer holding the outer file
-;; before other Info formatting takes place.  So @include is no longer
-;; is treated like other @-commands.
-(put 'include 'texinfo-format  'texinfo-format-noop)
-
-;; Original definition:
-;; (defun texinfo-format-include ()
-;;   (let ((filename (texinfo-parse-arg-discard))
-;;       (default-directory input-directory)
-;;       subindex)
-;;     (setq subindex
-;;         (save-excursion
-;;           (progn (find-file
-;;                   (cond ((file-readable-p (concat filename ".texinfo"))
-;;                          (concat filename ".texinfo"))
-;;                         ((file-readable-p (concat filename ".texi"))
-;;                          (concat filename ".texi"))
-;;                         ((file-readable-p (concat filename ".tex"))
-;;                          (concat filename ".tex"))
-;;                         ((file-readable-p filename)
-;;                          filename)
-;;                         (t (error "@include'd file %s not found"
-;;                                   filename))))
-;;                  (texinfo-format-buffer-1))))
-;;     (texinfo-subindex 'texinfo-vindex (car subindex) (nth 1 subindex))
-;;     (texinfo-subindex 'texinfo-findex (car subindex) (nth 2 subindex))
-;;     (texinfo-subindex 'texinfo-cindex (car subindex) (nth 3 subindex))
-;;     (texinfo-subindex 'texinfo-pindex (car subindex) (nth 4 subindex))
-;;     (texinfo-subindex 'texinfo-tindex (car subindex) (nth 5 subindex))
-;;     (texinfo-subindex 'texinfo-kindex (car subindex) (nth 6 subindex))))
-;;
-;;(defun texinfo-subindex (indexvar file content)
-;;  (set indexvar (cons (list 'recurse file content)
-;;                      (symbol-value indexvar))))
-
-;; Second definition:
-;; (put 'include 'texinfo-format 'texinfo-format-include)
-;; (defun texinfo-format-include ()
-;;   (let ((filename (concat input-directory
-;;                           (texinfo-parse-arg-discard)))
-;;         (default-directory input-directory))
-;;     (message "Reading: %s" filename)
-;;     (save-excursion
-;;       (save-restriction
-;;         (narrow-to-region
-;;          (point)
-;;          (+ (point) (car (cdr (insert-file-contents filename)))))
-;;         (goto-char (point-min))
-;;         (texinfo-append-refill)
-;;         (texinfo-format-convert (point-min) (point-max))))
-;;     (setq last-input-buffer input-buffer)  ; to bypass setfilename
-;;     ))
-
-
-;;; Numerous commands do nothing in Info
-;; These commands are defined in texinfo.tex for printed output.
-
-
-;;; various noops, such as @b{foo}, that take arguments in braces
-
-(put 'b 'texinfo-format 'texinfo-format-noop)
-(put 'i 'texinfo-format 'texinfo-format-noop)
-(put 'r 'texinfo-format 'texinfo-format-noop)
-(put 't 'texinfo-format 'texinfo-format-noop)
-(put 'w 'texinfo-format 'texinfo-format-noop)
-(put 'asis 'texinfo-format 'texinfo-format-noop)
-(put 'dmn 'texinfo-format 'texinfo-format-noop)
-(put 'math 'texinfo-format 'texinfo-format-noop)
-(put 'titlefont 'texinfo-format 'texinfo-format-noop)
-(defun texinfo-format-noop ()
-  (insert (texinfo-parse-arg-discard))
-  (goto-char texinfo-command-start))
-
-;; @hyphenation command discards an argument within braces
-(put 'hyphenation 'texinfo-format 'texinfo-discard-command-and-arg)
-(defun texinfo-discard-command-and-arg ()
-  "Discard both @-command and its argument in braces."
-  (goto-char texinfo-command-end)
-  (forward-list 1)
-  (setq texinfo-command-end (point))
-  (delete-region texinfo-command-start texinfo-command-end))
-
-
-;;; Do nothing commands, such as @smallbook, that have no args and no braces
-;;  These must appear on a line of their own
-
-(put 'bye 'texinfo-format 'texinfo-discard-line)
-(put 'smallbook 'texinfo-format 'texinfo-discard-line)
-(put 'finalout 'texinfo-format 'texinfo-discard-line)
-(put 'overfullrule 'texinfo-format 'texinfo-discard-line)
-(put 'smallbreak 'texinfo-format 'texinfo-discard-line)
-(put 'medbreak 'texinfo-format 'texinfo-discard-line)
-(put 'bigbreak 'texinfo-format 'texinfo-discard-line)
-(put 'afourpaper 'texinfo-format 'texinfo-discard-line)
-(put 'afivepaper 'texinfo-format 'texinfo-discard-line)
-(put 'afourlatex 'texinfo-format 'texinfo-discard-line)
-(put 'afourwide  'texinfo-format 'texinfo-discard-line)
-
-
-;;; These noop commands discard the rest of the line.
-
-(put 'c 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'comment 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'contents 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'group 'texinfo-end 'texinfo-discard-line-with-args)
-(put 'group 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'headings 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'setchapterstyle 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'hsize 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'itemindent 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'lispnarrowing 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'need 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'nopara 'texinfo-format 'texinfo-discard-line-with-args)
-
-;; @novalidate suppresses cross-reference checking and auxiliary file
-;; creation with TeX.  The Info-validate command checks that every
-;; node pointer points to an existing node.  Since this Info command
-;; is not invoked automatically, the @novalidate command is irrelevant
-;; and not supported by texinfmt.el
-(put 'novalidate 'texinfo-format 'texinfo-discard-line-with-args)
-
-(put 'page 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'pagesizes 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'parindent 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'setq 'texinfo-format 'texinfo-discard-line-with-args)
-
-(put 'setcontentsaftertitlepage
-     'texinfo-format 'texinfo-discard-line-with-args)
-(put 'setshortcontentsaftertitlepage
-     'texinfo-format 'texinfo-discard-line-with-args)
-
-(put 'settitle 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'setx 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'shortcontents 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'shorttitlepage 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'summarycontents 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'input 'texinfo-format 'texinfo-discard-line-with-args)
-
-(put 'documentlanguage 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'documentencoding 'texinfo-format 'texinfo-discard-line-with-args)
-
-
-
-;;; Some commands cannot be handled
-
-(defun texinfo-unsupported ()
-  (error "%s is not handled by texinfo"
-         (buffer-substring-no-properties texinfo-command-start texinfo-command-end)))
-
-;;; Batch formatting
-
-(defun batch-texinfo-format ()
-  "Runs  texinfo-format-buffer  on the files remaining on the command line.
-Must be used only with -batch, and kills emacs on completion.
-Each file will be processed even if an error occurred previously.
-For example, invoke
-  \"emacs -batch -funcall batch-texinfo-format $docs/ ~/*.texinfo\"."
-  (if (not noninteractive)
-      (error "batch-texinfo-format may only be used -batch"))
-  (let ((version-control t)
-        (auto-save-default nil)
-        (find-file-run-dired nil)
-        (kept-old-versions 259259)
-        (kept-new-versions 259259))
-    (let ((error 0)
-          file
-          (files ()))
-      (while command-line-args-left
-        (setq file (expand-file-name (car command-line-args-left)))
-        (cond ((not (file-exists-p file))
-               (message ">> %s does not exist!" file)
-               (setq error 1
-                     command-line-args-left (cdr command-line-args-left)))
-              ((file-directory-p file)
-               ;; XEmacs change
-               (setq command-line-args-left
-                     (nconc (directory-files
-                             file
-                             nil
-                             ;; Match only files registered for
-                             ;; texinfo-mode in auto-mode-alist.
-                             ;; This also fixes infinite recursion of
-                             ;; this function when called on
-                             ;; directories
-                             ;; NB: (directory-files ...) returns
-                             ;; "." and ".." as well.
-                             (mapconcat
-                              (function
-                               (lambda (regexp)
-                                 regexp))
-                              (mapcan
-                               (function
-                                (lambda (a)
-                                  (if (equal (cdr a) 'texinfo-mode)
-                                      (list (car a))
-                                    nil)))
-                               auto-mode-alist)
-                              "\\|"))
-                            (cdr command-line-args-left))))
-              (t
-               (setq files (cons file files)
-                     command-line-args-left (cdr command-line-args-left)))))
-      (while files
-        (setq file (car files)
-              files (cdr files))
-        (condition-case err
-            (progn
-              (if buffer-file-name (kill-buffer (current-buffer)))
-              (find-file file)
-              (buffer-disable-undo (current-buffer))
-              (set-buffer-modified-p nil)
-              (texinfo-mode)
-              (message "texinfo formatting %s..." file)
-              (texinfo-format-buffer nil)
-              (if (buffer-modified-p)
-                  (progn (message "Saving modified %s" (buffer-file-name))
-                         (save-buffer))))
-          (error
-           (message ">> Error: %s" (prin1-to-string err))
-           (message ">>  point at")
-           (let ((s (buffer-substring-no-properties (point)
-						    (min (+ (point) 100)
-							 (point-max))))
-                 (tem 0))
-             (while (setq tem (string-match "\n+" s tem))
-               (setq s (concat (substring s 0 (match-beginning 0))
-                               "\n>>  "
-                               (substring s (match-end 0)))
-                     tem (1+ tem)))
-             (message ">>  %s" s))
-           (setq error 1))))
-      (kill-emacs error))))
-
-
-;;; Place `provide' at end of file.
-(provide 'texinfmt)
-
-;;; texinfmt.el ends here
diff --git a/xemacs-packages/lisp/texinfo/texinfo.el b/xemacs-packages/lisp/texinfo/texinfo.el
deleted file mode 100644
index 998046d6..00000000
--- a/xemacs-packages/lisp/texinfo/texinfo.el
+++ /dev/null
@@ -1,1062 +0,0 @@
-;;; texinfo.el --- major mode for editing Texinfo files
-
-;; Copyright (C) 1985, '88, '89, '90, '91, '01,
-;;                '92, '93, '96, '97, 2000 Free Software Foundation, Inc.
-;; Copyright (C) 2004 Ben Wing.
-
-;; Author: Robert J. Chassell
-;; Date:   [Set date below for texinfo-version]
-;; Maintainer: bug-texinfo@gnu.org
-;; Keywords: maint, tex, docs
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Todo:
-
-;; - facemenu support.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'tex-mode) (require 'cl) (require 'regexp-opt))
-
-(defgroup texinfo nil
-  "Texinfo Mode."
-  :group 'docs)
-
-;;;###autoload
-(defcustom texinfo-open-quote "``"
-  "*String inserted by typing \\[texinfo-insert-quote] to open a quotation."
-  :type 'string
-  :group 'texinfo)
-
-;;;###autoload
-(defcustom texinfo-close-quote "''"
-  "*String inserted by typing \\[texinfo-insert-quote] to close a quotation."
-  :type 'string
-  :group 'texinfo)
-
-(defcustom texinfo-mode-hook nil
-  "Normal hook run when entering Texinfo mode."
-  :type 'hook
-  :options '(turn-on-auto-fill flyspell-mode)
-  :group 'texinfo)
-
-
-;;; Autoloads:
-
-(autoload 'makeinfo-region
-  "makeinfo"
-  "Make Info file from region of current Texinfo file, and switch to it.
-
-This command does not offer the `next-error' feature since it would
-apply to a temporary file, not the original; use the `makeinfo-buffer'
-command to gain use of `next-error'."
-  t nil)
-
-(autoload 'makeinfo-buffer
-  "makeinfo"
-  "Make Info file from current buffer.
-
-Use the \\[next-error] command to move to the next error
-\(if there are errors\)."
-  t nil)
-
-(autoload 'kill-compilation
-  "compile"
-  "Kill the process made by the \\[compile] command."
-  t nil)
-
-(autoload 'makeinfo-recenter-compilation-buffer
-  "makeinfo"
-  "Redisplay `*compilation*' buffer so most recent output can be seen.
-The last line of the buffer is displayed on
-line LINE of the window, or centered if LINE is nil."
-  t nil)
-
-(autoload 'texinfo-update-node
-  "texnfo-upd"
-  "Without any prefix argument, update the node in which point is located.
-Non-nil argument (prefix, if interactive) means update the nodes in the
-marked region.
-
-The functions for creating or updating nodes and menus, and their
-keybindings, are:
-
-    `texinfo-update-node' (&optional region-p)    \\[texinfo-update-node]
-    `texinfo-every-node-update' ()                \\[texinfo-every-node-update]
-    `texinfo-sequential-node-update' (&optional region-p)
-
-    `texinfo-make-menu' (&optional region-p)      \\[texinfo-make-menu]
-    `texinfo-all-menus-update' ()                 \\[texinfo-all-menus-update]
-    `texinfo-master-menu' ()
-
-    `texinfo-indent-menu-description' (column &optional region-p)
-
-The `texinfo-column-for-description' variable specifies the column to
-which menu descriptions are indented. Its default value is 32."
-  t nil)
-
-(autoload 'texinfo-every-node-update
-  "texnfo-upd"
-  "Update every node in a Texinfo file."
-  t nil)
-
-(autoload 'texinfo-sequential-node-update
-  "texnfo-upd"
-  "Update one node (or many) in a Texinfo file with sequential pointers.
-
-This function causes the `Next' or `Previous' pointer to point to the
-immediately preceding or following node, even if it is at a higher or
-lower hierarchical level in the document.  Continually pressing `n' or
-`p' takes you straight through the file.
-
-Without any prefix argument, update the node in which point is located.
-Non-nil argument (prefix, if interactive) means update the nodes in the
-marked region.
-
-This command makes it awkward to navigate among sections and
-subsections; it should be used only for those documents that are meant
-to be read like a novel rather than a reference, and for which the
-Info `g*' command is inadequate."
-  t nil)
-
-(autoload 'texinfo-make-menu
-  "texnfo-upd"
-  "Without any prefix argument, make or update a menu.
-Make the menu for the section enclosing the node found following point.
-
-Non-nil argument (prefix, if interactive) means make or update menus
-for nodes within or part of the marked region.
-
-Whenever a menu exists, and is being updated, the descriptions that
-are associated with node names in the pre-existing menu are
-incorporated into the new menu.  Otherwise, the nodes' section titles
-are inserted as descriptions."
-  t nil)
-
-(autoload 'texinfo-all-menus-update
-  "texnfo-upd"
-  "Update every regular menu in a Texinfo file.
-Remove pre-existing master menu, if there is one.
-
-If called with a non-nil argument, this function first updates all the
-nodes in the buffer before updating the menus."
-  t nil)
-
-(autoload 'texinfo-master-menu
-  "texnfo-upd"
-  "Make a master menu for a whole Texinfo file.
-Non-nil argument (prefix, if interactive) means first update all
-existing nodes and menus.  Remove pre-existing master menu, if there is one.
-
-This function creates a master menu that follows the top node.  The
-master menu includes every entry from all the other menus.  It
-replaces any existing ordinary menu that follows the top node.
-
-If called with a non-nil argument, this function first updates all the
-menus in the buffer (incorporating descriptions from pre-existing
-menus) before it constructs the master menu.
-
-The function removes the detailed part of an already existing master
-menu.  This action depends on the pre-existing master menu using the
-standard `texinfo-master-menu-header'.
-
-The master menu has the following format, which is adapted from the
-recommendation in the Texinfo Manual:
-
-   * The first part contains the major nodes in the Texinfo file: the
-     nodes for the chapters, chapter-like sections, and the major
-     appendices.  This includes the indices, so long as they are in
-     chapter-like sections, such as unnumbered sections.
-
-   * The second and subsequent parts contain a listing of the other,
-     lower level menus, in order.  This way, an inquirer can go
-     directly to a particular node if he or she is searching for
-     specific information.
-
-Each of the menus in the detailed node listing is introduced by the
-title of the section containing the menu."
-  t nil)
-
-(autoload 'texinfo-indent-menu-description
-  "texnfo-upd"
-  "Indent every description in menu following point to COLUMN.
-Non-nil argument (prefix, if interactive) means indent every
-description in every menu in the region.  Does not indent second and
-subsequent lines of a multi-line description."
-  t nil)
-
-(autoload 'texinfo-insert-node-lines
-  "texnfo-upd"
-  "Insert missing `@node' lines in region of Texinfo file.
-Non-nil argument (prefix, if interactive) means also to insert the
-section titles as node names; and also to insert the section titles as
-node names in pre-existing @node lines that lack names."
-  t nil)
-
-(autoload 'texinfo-start-menu-description
-  "texnfo-upd"
-  "In this menu entry, insert the node's section title as a description.
-Position point at beginning of description ready for editing.
-Do not insert a title if the line contains an existing description.
-
-You will need to edit the inserted text since a useful description
-complements the node name rather than repeats it as a title does."
-  t nil)
-
-(autoload 'texinfo-multiple-files-update
-  "texnfo-upd"
-  "Update first node pointers in each file included in OUTER-FILE;
-create or update main menu in the outer file that refers to such nodes.
-This does not create or update menus or pointers within the included files.
-
-With optional MAKE-MASTER-MENU argument (prefix arg, if interactive),
-insert a master menu in OUTER-FILE.  This does not create or update
-menus or pointers within the included files.
-
-With optional UPDATE-EVERYTHING argument (numeric prefix arg, if
-interactive), update all the menus and all the `Next', `Previous', and
-`Up' pointers of all the files included in OUTER-FILE before inserting
-a master menu in OUTER-FILE.
-
-The command also updates the `Top' level node pointers of OUTER-FILE.
-
-Notes:
-
-  * this command does NOT save any files--you must save the
-    outer file and any modified, included files.
-
-  * except for the `Top' node, this command does NOT handle any
-    pre-existing nodes in the outer file; hence, indices must be
-    enclosed in an included file.
-
-Requirements:
-
-  * each of the included files must contain exactly one highest
-    hierarchical level node,
-  * this highest node must be the first node in the included file,
-  * each highest hierarchical level node must be of the same type.
-
-Thus, normally, each included file contains one, and only one,
-chapter."
-  t nil)
-
-
-;;; Code:
-
-;;; Don't you dare insert any `require' calls at top level in this file--rms.
-
-(defvar texinfo-section-list
-  '(("top" 1)
-    ("majorheading" 2)
-    ("chapter" 2)
-    ("unnumbered" 2)
-    ("appendix" 2)
-    ("chapheading" 2)
-    ("section" 3)
-    ("unnumberedsec" 3)
-    ("appendixsec" 3)
-    ("heading" 3)
-    ("subsection" 4)
-    ("unnumberedsubsec" 4)
-    ("appendixsubsec" 4)
-    ("subheading" 4)
-    ("subsubsection" 5)
-    ("unnumberedsubsubsec" 5)
-    ("appendixsubsubsec" 5)
-    ("subsubheading" 5))
-  "Alist of sectioning commands and their relative level.")
-
-;;; Syntax table
-
-(defvar texinfo-mode-syntax-table nil)
-
-(if texinfo-mode-syntax-table
-    nil
-  (setq texinfo-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\" "." texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\\ "." texinfo-mode-syntax-table)
-  (modify-syntax-entry ?@ "_" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\^q "\\" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\[ "(]" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\] ")[" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?{ "(}" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?} "){" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\n ">" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\' "w" texinfo-mode-syntax-table))
-
-;; Written by Wolfgang Bangerth <zcg51122@rpool1.rus.uni-stuttgart.de>
-;; To override this example, set either `imenu-generic-expression'
-;; or `imenu-create-index-function'.
-(defvar texinfo-imenu-generic-expression
-  '((nil "^@\\(node\\|anchor\\)[ \t]+\\([^,\n]*\\)" 2)
-    ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1))
-  "Imenu generic expression for Texinfo mode.  See `imenu-generic-expression'.")
-
-(defvar texinfo-font-lock-syntactic-keywords
-  '(("\\(@\\)c\\(omment\\)?\\>" (1 "<"))
-    ("^\\(@\\)ignore\\>" (1 "< b"))
-    ("^@end ignore\\(\n\\)" (1 "> b")))
-  "Syntactic keywords to catch comment delimiters in `texinfo-mode'.")
-
-(defconst texinfo-environments
-  '("cartouche" "copying" "defcv" "deffn" "defivar" "defmac"
-    "defmethod" "defop" "defopt" "defspec" "deftp" "deftypefn"
-    "deftypefun" "deftypevar" "deftypevr" "defun" "defvar"
-    "defvr" "description" "detailmenu" "direntry" "display"
-    "documentdescription" "enumerate" "example" "flushleft"
-    "flushright" "format" "ftable" "group" "ifclear" "ifset"
-    "ifhtml" "ifinfo" "ifnothtml" "ifnotinfo" "ifnotplaintext"
-    "ifnottex" "ifplaintext" "iftex" "ignore" "itemize" "lisp"
-    "macro" "menu" "multitable" "quotation" "smalldisplay"
-    "smallexample" "smallformat" "smalllisp" "table" "tex"
-    "titlepage" "verbatim" "vtable")
-  "List of Texinfo environments.")
-
-(defconst texinfo-environment-regexp
-  (concat "^@" (regexp-opt (cons "end" texinfo-environments) t) "\\>")
-  "Regexp for environment-like Texinfo list commands.
-Subexpression 1 is what goes into the corresponding `@end' statement.")
-
-(defface texinfo-heading-face
-  '((t (:inherit font-lock-function-name-face)))
-  "Face used for section headings in `texinfo-mode'.")
-(defvar texinfo-heading-face 'texinfo-heading-face)
-
-(defvar texinfo-font-lock-keywords
-  `(;; All but the first had an OVERRIDE of t.
-    ;; It didn't seem to be any better, and it's slower--simon.
-    ;; Robert J. Chassell <bob@gnu.org> says remove this line.
-    ;;("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t)
-    ("@\\([a-zA-Z]+\\|[^ \t\n]\\)" 1 font-lock-keyword-face) ;commands
-    ("^\\*\\([^\n:]*\\)" 1 font-lock-function-name-face t) ;menu items
-    ("@\\(emph\\|i\\|sc\\){\\([^}]+\\)" 2 'italic)
-    ("@\\(strong\\|b\\){\\([^}]+\\)" 2 'bold)
-    ("@\\(kbd\\|key\\|url\\|uref\\){\\([^}]+\\)" 2 font-lock-string-face)
-    ;; The following two groups have an OVERRIDE of `keep' because
-    ;; their arguments frequently include a @@, and we don't want that
-    ;; to overwrite the normal fontification of the argument.
-    ("@\\(file\\|email\\){\\([^}]+\\)" 2 font-lock-string-face keep)
-    ("@\\(samp\\|code\\|var\\|math\\|env\\|command\\|option\\){\\([^}]+\\)"
-     2 font-lock-variable-name-face keep)
-    ("@\\(cite\\|x?ref\\|pxref\\|dfn\\|inforef\\){\\([^}]+\\)"
-     2 font-lock-reference-face) ;; #### XEmacs change
-    ("@\\(anchor\\){\\([^}]+\\)" 2 font-lock-type-face)
-    ("@\\(dmn\\|acronym\\|value\\){\\([^}]+\\)" 2 font-lock-builtin-face)
-    ("@\\(end\\|itemx?\\) +\\(.+\\)" 2 font-lock-keyword-face keep)
-    ;; XEmacs change?? #### If so, we need to add text-clone-create from
-    ;; 21.3
-    ;; (,texinfo-environment-regexp
-    ;;  1 (texinfo-clone-environment (match-beginning 1) (match-end 1)) keep)
-    (,(concat "^@" (regexp-opt (mapcar 'car texinfo-section-list) t)
-	       ".*\n") 0 texinfo-heading-face t))
-  "Additional expressions to highlight in Texinfo mode.")
-
-(defun texinfo-clone-environment (start end)
-  (let ((endp nil))
-    (save-excursion
-      (ignore-errors
-	(goto-char start)
-	(when (looking-at "end\\Sw+\\(\\sw+\\)")
-	  (setq endp t start (match-beginning 1) end (match-end 1)))
-	(unless (get-char-property start 'text-clones)
-	  (if endp
-	      (texinfo-last-unended-begin)
-	    (forward-word 1)
-	    (texinfo-next-unmatched-end))
-	  (skip-syntax-forward "^w")
-	  (when (looking-at
-		 (concat (regexp-quote (buffer-substring start end)) "\\>"))
-	    (text-clone-create start end 'spread "\\w*")))))))
-
-(defun texinfo-outline-level ()
-  ;; Calculate level of current texinfo outline heading.
-  (save-excursion
-    (if (bobp)
-        0
-      (forward-char 1)
-      (let* ((word (buffer-substring-no-properties
-                    (point) (progn (forward-word 1) (point))))
-             (entry (assoc word texinfo-section-list)))
-        (if entry
-            (nth 1 entry)
-          5)))))
-
-
-;;; Keybindings
-(defvar texinfo-mode-map nil)
-
-;;; Keys common both to Texinfo mode and to TeX shell.
-
-(defun texinfo-define-common-keys (keymap)
-  "Define the keys both in Texinfo mode and in the texinfo-tex-shell."
-  (define-key keymap "\C-c\C-t\C-k"    'tex-kill-job)
-  (define-key keymap "\C-c\C-t\C-x"    'texinfo-quit-job)
-  (define-key keymap "\C-c\C-t\C-l"    'tex-recenter-output-buffer)
-  (define-key keymap "\C-c\C-t\C-d"    'texinfo-delete-from-print-queue)
-  (define-key keymap "\C-c\C-t\C-q"    'tex-show-print-queue)
-  (define-key keymap "\C-c\C-t\C-p"    'texinfo-tex-print)
-  (define-key keymap "\C-c\C-t\C-v"    'texinfo-tex-view)
-  (define-key keymap "\C-c\C-t\C-i"    'texinfo-texindex)
-
-  (define-key keymap "\C-c\C-t\C-r"    'texinfo-tex-region)
-  (define-key keymap "\C-c\C-t\C-b"    'texinfo-tex-buffer))
-
-;; Mode documentation displays commands in reverse order
-;; from how they are listed in the texinfo-mode-map.
-
-(if texinfo-mode-map
-    nil
-  (setq texinfo-mode-map (make-sparse-keymap))
-
-  ;; bindings for `texnfo-tex.el'
-  (texinfo-define-common-keys texinfo-mode-map)
-
-  (define-key texinfo-mode-map "\"" 'texinfo-insert-quote)
-
-  ;; bindings for `makeinfo.el'
-  (define-key texinfo-mode-map "\C-c\C-m\C-k" 'kill-compilation)
-  (define-key texinfo-mode-map "\C-c\C-m\C-l"
-    'makeinfo-recenter-compilation-buffer)
-  (define-key texinfo-mode-map "\C-c\C-m\C-r" 'makeinfo-region)
-  (define-key texinfo-mode-map "\C-c\C-m\C-b" 'makeinfo-buffer)
-
-  ;; bindings for `texinfmt.el'
-  (define-key texinfo-mode-map "\C-c\C-e\C-r"    'texinfo-format-region)
-  (define-key texinfo-mode-map "\C-c\C-e\C-b"    'texinfo-format-buffer)
-
-  ;; AUCTeX-like bindings
-  (define-key texinfo-mode-map "\e\r"		'texinfo-insert-@item)
-
-  ;; bindings for updating nodes and menus
-
-  (define-key texinfo-mode-map "\C-c\C-um"   'texinfo-master-menu)
-
-  (define-key texinfo-mode-map "\C-c\C-u\C-m"   'texinfo-make-menu)
-  (define-key texinfo-mode-map "\C-c\C-u\C-n"   'texinfo-update-node)
-  (define-key texinfo-mode-map "\C-c\C-u\C-e"   'texinfo-every-node-update)
-  (define-key texinfo-mode-map "\C-c\C-u\C-a"   'texinfo-all-menus-update)
-
-  (define-key texinfo-mode-map "\C-c\C-s"     'texinfo-show-structure)
-
-  (define-key texinfo-mode-map "\C-c}"          'up-list)
-  (define-key texinfo-mode-map "\C-c]"          'up-list)
-  (define-key texinfo-mode-map "\C-c{"		'texinfo-insert-braces)
-
-  ;; bindings for inserting strings
-  (define-key texinfo-mode-map "\C-c\C-o"     'texinfo-insert-block)
-  (define-key texinfo-mode-map "\C-c\C-c\C-d" 'texinfo-start-menu-description)
-  (define-key texinfo-mode-map "\C-c\C-c\C-s" 'texinfo-insert-@strong)
-  (define-key texinfo-mode-map "\C-c\C-c\C-e" 'texinfo-insert-@emph)
-
-  (define-key texinfo-mode-map "\C-c\C-cv"    'texinfo-insert-@var)
-  (define-key texinfo-mode-map "\C-c\C-cu"    'texinfo-insert-@uref)
-  (define-key texinfo-mode-map "\C-c\C-ct"    'texinfo-insert-@table)
-  (define-key texinfo-mode-map "\C-c\C-cs"    'texinfo-insert-@samp)
-  (define-key texinfo-mode-map "\C-c\C-cq"    'texinfo-insert-@quotation)
-  (define-key texinfo-mode-map "\C-c\C-co"    'texinfo-insert-@noindent)
-  (define-key texinfo-mode-map "\C-c\C-cn"    'texinfo-insert-@node)
-  (define-key texinfo-mode-map "\C-c\C-cm"    'texinfo-insert-@email)
-  (define-key texinfo-mode-map "\C-c\C-ck"    'texinfo-insert-@kbd)
-  (define-key texinfo-mode-map "\C-c\C-ci"    'texinfo-insert-@item)
-  (define-key texinfo-mode-map "\C-c\C-cf"    'texinfo-insert-@file)
-  (define-key texinfo-mode-map "\C-c\C-cx"    'texinfo-insert-@example)
-  (define-key texinfo-mode-map "\C-c\C-ce"    'texinfo-insert-@end)
-  (define-key texinfo-mode-map "\C-c\C-cd"    'texinfo-insert-@dfn)
-  (define-key texinfo-mode-map "\C-c\C-cc"    'texinfo-insert-@code))
-
-(easy-menu-define texinfo-mode-menu
-  texinfo-mode-map
-  "Menu used for `texinfo-mode'."
-  '("Texinfo"
-    ["Insert block"	texinfo-insert-block	t]
-    ;; ["Insert node"	texinfo-insert-@node	t]
-    "----"
-    ["Update All"	(lambda () (interactive) (texinfo-master-menu t))
-     :keys "\\[universal-argument] \\[texinfo-master-menu]"]
-    ["Update every node" texinfo-every-node-update t]
-    ["Update node"	texinfo-update-node	t]
-    ["Make Master menu"	texinfo-master-menu	t]
-    ["Make menu"	texinfo-make-menu	t]
-    ["Update all menus"	texinfo-all-menus-update t]
-    "----"
-    ["Show structure"	texinfo-show-structure	t]
-    ["Format region"	texinfo-format-region	t]
-    ["Format buffer"	texinfo-format-buffer	t]
-    ["Makeinfo region"	makeinfo-region		t]
-    ["Makeinfo buffer"	makeinfo-buffer		t]))
-
-
-(defun texinfo-filter (section list)
-  (let (res)
-    (dolist (x list) (if (eq section (cadr x)) (push (car x) res)))
-    res))
-
-(defvar texinfo-chapter-level-regexp
-  (regexp-opt (texinfo-filter 2 texinfo-section-list))
-  "Regular expression matching just the Texinfo chapter level headings.")
-
-;;; Texinfo mode
-
-;;;###autoload
-(define-derived-mode texinfo-mode text-mode "Texinfo"
-  "Major mode for editing Texinfo files.
-
-  It has these extra commands:
-\\{texinfo-mode-map}
-
-  These are files that are used as input for TeX to make printed manuals
-and also to be turned into Info files with \\[makeinfo-buffer] or
-the `makeinfo' program.  These files must be written in a very restricted and
-modified version of TeX input format.
-
-  Editing commands are like text-mode except that the syntax table is
-set up so expression commands skip Texinfo bracket groups.  To see
-what the Info version of a region of the Texinfo file will look like,
-use \\[makeinfo-region], which runs `makeinfo' on the current region.
-
-  You can show the structure of a Texinfo file with \\[texinfo-show-structure].
-This command shows the structure of a Texinfo file by listing the
-lines with the @-sign commands for @chapter, @section, and the like.
-These lines are displayed in another window called the *Occur* window.
-In that window, you can position the cursor over one of the lines and
-use \\[occur-mode-goto-occurrence], to jump to the corresponding spot
-in the Texinfo file.
-
-  In addition, Texinfo mode provides commands that insert various
-frequently used @-sign commands into the buffer.  You can use these
-commands to save keystrokes.  And you can insert balanced braces with
-\\[texinfo-insert-braces] and later use the command \\[up-list] to
-move forward past the closing brace.
-
-Also, Texinfo mode provides functions for automatically creating or
-updating menus and node pointers.  These functions
-
-  * insert the `Next', `Previous' and `Up' pointers of a node,
-  * insert or update the menu for a section, and
-  * create a master menu for a Texinfo source file.
-
-Here are the functions:
-
-    texinfo-update-node                \\[texinfo-update-node]
-    texinfo-every-node-update          \\[texinfo-every-node-update]
-    texinfo-sequential-node-update
-
-    texinfo-make-menu                  \\[texinfo-make-menu]
-    texinfo-all-menus-update           \\[texinfo-all-menus-update]
-    texinfo-master-menu
-
-    texinfo-indent-menu-description (column &optional region-p)
-
-The `texinfo-column-for-description' variable specifies the column to
-which menu descriptions are indented.
-
-Passed an argument (a prefix argument, if interactive), the
-`texinfo-update-node' and `texinfo-make-menu' functions do their jobs
-in the region.
-
-To use the updating commands, you must structure your Texinfo file
-hierarchically, such that each `@node' line, with the exception of the
-Top node, is accompanied by some kind of section line, such as an
-`@chapter' or `@section' line.
-
-If the file has a `top' node, it must be called `top' or `Top' and
-be the first node in the file.
-
-Entering Texinfo mode calls the value of `text-mode-hook', and then the
-value of `texinfo-mode-hook'."
-  (set (make-local-variable 'page-delimiter)
-       (concat
-	"^@node [ \t]*[Tt]op\\|^@\\("
-	texinfo-chapter-level-regexp
-	"\\)\\>"))
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'indent-tabs-mode)
-  (setq indent-tabs-mode nil)
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate
-	(concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-separate))
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-start))
-  (make-local-variable 'adaptive-fill-mode)
-  (setq adaptive-fill-mode nil)
-  (make-local-variable 'fill-column)
-  (setq fill-column 70)
-  (make-local-variable 'comment-start)
-  (setq comment-start "@c ")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "@c +\\|@comment +")
-  (make-local-variable 'words-include-escapes)
-  (setq words-include-escapes t)
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression texinfo-imenu-generic-expression)
-  ;; (setq imenu-case-fold-search nil) XEmacs deleted
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults
-	'(texinfo-font-lock-keywords nil nil nil backward-paragraph
-				     (font-lock-syntactic-keywords
-				      . texinfo-font-lock-syntactic-keywords)))
-  (set (make-local-variable 'parse-sexp-lookup-properties) t)
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp
-        (concat "@" (regexp-opt (mapcar 'car texinfo-section-list) t) "\\>"))
-  (make-local-variable 'outline-level)
-  (setq outline-level 'texinfo-outline-level)
-  (make-local-variable 'tex-start-of-header)
-  (setq tex-start-of-header "%\\*\\*start")
-  (make-local-variable 'tex-end-of-header)
-  (setq tex-end-of-header "%\\*\\*end")
-  (make-local-variable 'tex-first-line-header-regexp)
-  (setq tex-first-line-header-regexp "^\\\\input")
-  (make-local-variable 'tex-trailer)
-  (setq tex-trailer "@bye\n")
-
-  ;; Prevent filling certain lines, in addition to ones specified
-  ;; by the user.
-  (let ((prevent-filling "^@\\(def\\|multitable\\)"))
-    (set (make-local-variable 'auto-fill-inhibit-regexp)
-	 (if (null auto-fill-inhibit-regexp)
-	     prevent-filling
-	   (concat auto-fill-inhibit-regexp "\\|" prevent-filling)))))
-
-
-
-;;; Insert string commands
-
-(defvar texinfo-block-default "example")
-
-(define-skeleton texinfo-insert-block
-  "Create a matching pair @<cmd> .. @end <cmd> at point.
-Puts point on a blank line between them."
-  (setq texinfo-block-default
-	(completing-read (format "Block name [%s]: " texinfo-block-default)
-			 (mapcar 'list texinfo-environments)
-			 nil nil nil nil texinfo-block-default))
-  \n "@" str \n _ \n "@end " str \n)
-
-(defun texinfo-inside-macro-p (macro &optional bound)
-  "Non-nil if inside a macro matching the regexp MACRO."
-  (condition-case nil
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region bound (point))
-	  (while (progn
-		   (up-list -1)
-		   (not (condition-case nil
-			    (save-excursion
-			      (backward-sexp 1)
-			      (looking-at macro))
-			  (scan-error nil)))))
-	  t))
-    (scan-error nil)))
-
-(defun texinfo-inside-env-p (env &optional bound)
-  "Non-nil if inside an environment matching the regexp @ENV."
-  (save-excursion
-    (and (re-search-backward (concat "@\\(end\\s +\\)?" env) bound t)
-	 (not (match-end 1)))))
-
-(defun texinfo-insert-quote (&optional arg)
-  "Insert the appropriate quote mark for Texinfo.
-Usually inserts the value of `texinfo-open-quote' (normally ``) or
-`texinfo-close-quote' (normally ''), depending on the context.
-With prefix argument or inside @code or @example, inserts a plain \"."
-  (interactive "*P")
-  (let ((top (or (save-excursion (re-search-backward "@node\\>" nil t))
-		 (point-min))))
-    (if (or arg
-	    (= (preceding-char) ?\\)
-	    (save-excursion
-	      (backward-char (length texinfo-open-quote))
-	      (when (or (looking-at texinfo-open-quote)
-			(looking-at texinfo-close-quote))
-		(delete-char (length texinfo-open-quote))
-		t))
-	    (texinfo-inside-macro-p "@\\(code\\|samp\\|kbd\\)\\>" top)
-	    (texinfo-inside-env-p "example\\>" top)
-	    (texinfo-inside-env-p "lisp\\>" top))
-	(self-insert-command (prefix-numeric-value arg))
-      (insert
-       (if (memq (char-syntax (preceding-char)) '(?\( ?> ?\ ))
-	   texinfo-open-quote
-	 texinfo-close-quote)))))
-
-;; The following texinfo-insert-@end command not only inserts a SPC
-;; after the @end, but tries to find out what belongs there.  It is
-;; not very smart: it does not understand nested lists.
-
-(defun texinfo-last-unended-begin ()
-  (while (and (re-search-backward texinfo-environment-regexp)
-	      (looking-at "@end"))
-    (texinfo-last-unended-begin)))
-
-(defun texinfo-next-unmatched-end ()
-  (while (and (re-search-forward texinfo-environment-regexp)
-	      (save-excursion
-		(goto-char (match-beginning 0))
-		(not (looking-at "@end"))))
-    (texinfo-next-unmatched-end)))
-
-(defun texinfo-insert-@end ()
-  "Insert the matching `@end' for the last Texinfo command that needs one."
-  (interactive)
-  (let ((string
-	 (ignore-errors
-	   (save-excursion
-	     (texinfo-last-unended-begin)
-	     (match-string 1)))))
-    (insert "@end ")
-    (if string (insert string "\n"))))
-
-;; The following insert commands accept a prefix arg N, which is the
-;; number of words (actually s-exprs) that should be surrounded by
-;; braces.  Thus you can first paste a variable name into a .texinfo
-;; buffer, then say C-u 1 C-c C-c v at the beginning of the just
-;; pasted variable name to put @var{...} *around* the variable name.
-;; Operate on previous word or words with negative arg.
-
-;; These commands use texinfo-insert-@-with-arg
-(defun texinfo-insert-@-with-arg (string &optional arg)
-  (if arg
-      (progn
-        (setq arg (prefix-numeric-value arg))
-        (if (< arg 0)
-            (progn
-              (skip-chars-backward " \t\n\r\f")
-              (save-excursion
-                (forward-sexp arg)
-                (insert "@" string "{"))
-              (insert "}"))
-          (skip-chars-forward " \t\n\r\f")
-          (insert "@" string "{")
-          (forward-sexp arg)
-          (insert "}")))
-    ;; XEmacs change: operate over the active region if one is given
-    (if (region-active-p)
-	(let ((b (region-beginning)) (e (region-end)))
-	  (goto-char b)
-	  (insert "@" string "{")
-	  (forward-char (- e b))
-	  (insert "}"))
-      (insert "@" string "{}")
-      (backward-char))))
-
-(defun texinfo-insert-braces ()
-  "Make a pair of braces and be poised to type inside of them.
-Use \\[up-list] to move forward out of the braces."
-  (interactive)
-  (insert "{}")
-  (backward-char))
-
-(defun texinfo-insert-@code (&optional arg)
-  "Insert a `@code{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "code" arg))
-
-(defun texinfo-insert-@dfn (&optional arg)
-  "Insert a `@dfn{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "dfn" arg))
-
-(defun texinfo-insert-@email (&optional arg)
-  "Insert a `@email{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "email" arg))
-
-(defun texinfo-insert-@emph (&optional arg)
-  "Insert a `@emph{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "emph" arg))
-
-(defun texinfo-insert-@example ()
-  "Insert the string `@example' in a Texinfo buffer."
-  (interactive)
-  (insert "@example\n"))
-
-(defun texinfo-insert-@file (&optional arg)
-  "Insert a `@file{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "file" arg))
-
-(defun texinfo-insert-@item ()
-  "Insert the string `@item' in a Texinfo buffer."
-  (interactive)
-  (insert "@item")
-  (newline))
-
-(defun texinfo-insert-@kbd (&optional arg)
-  "Insert a `@kbd{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "kbd" arg))
-
-(defun texinfo-insert-@node ()
-  "Insert the string `@node' in a Texinfo buffer.
-Insert a comment on the following line indicating the order of
-arguments to @node.  Insert a carriage return after the comment line.
-Leave point after `@node'."
-  (interactive)
-  (insert "@node \n@comment  node-name,  next,  previous,  up\n")
-  (forward-line -2)
-  (forward-char 6))
-
-(defun texinfo-insert-@noindent ()
-  "Insert the string `@noindent' in a Texinfo buffer."
-  (interactive)
-  (insert "@noindent\n"))
-
-(defun texinfo-insert-@quotation ()
-  "Insert the string `@quotation' in a Texinfo buffer."
-  (interactive)
-  (insert "@quotation\n"))
-
-(defun texinfo-insert-@samp (&optional arg)
-  "Insert a `@samp{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "samp" arg))
-
-(defun texinfo-insert-@strong (&optional arg)
-  "Insert a `@strong{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "strong" arg))
-
-(defun texinfo-insert-@table (&optional arg)
-  "Insert the string `@table' in a Texinfo buffer."
-  (interactive "P")
-  (insert "@table "))
-
-(defun texinfo-insert-@var (&optional arg)
-  "Insert a `@var{}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "var" arg))
-
-(defun texinfo-insert-@uref (&optional arg)
-  "Insert a `@uref{}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "uref" arg))
-(defalias 'texinfo-insert-@url 'texinfo-insert-@uref)
-
-;;; Texinfo file structure
-
-(defun texinfo-show-structure (&optional nodes-too)
-  "Show the structure of a Texinfo file.
-List the lines in the file that begin with the @-sign commands for
-@chapter, @section, and the like.
-
-With optional argument (prefix if interactive), list both the lines
-with @-sign commands for @chapter, @section, and the like, and list
-@node lines.
-
-Lines with structuring commands beginning in them are displayed in
-another buffer named `*Occur*'.  In that buffer, you can move point to
-one of those lines and then use
-\\<occur-mode-map>\\[occur-mode-goto-occurrence],
-to jump to the corresponding spot in the Texinfo source file."
-
-  (interactive "P")
-  ;; First, remember current location
-  (let ((source-buffer (current-buffer))
-        current-location)
-    (save-excursion
-      (end-of-line)            ; so as to find section on current line
-      (if (re-search-backward
-           ;; do not require `texinfo-section-types-regexp' in texnfo-upd.el
-           "^@\\(chapter \\|sect\\|subs\\|subh\\|unnum\\|major\\|chapheading \\|heading \\|appendix\\)"
-           nil t)
-          (setq current-location
-                (progn
-                  (beginning-of-line)
-                  (buffer-substring (point) (progn (end-of-line) (point)))))
-        ;; else point is located before any section command.
-        (setq current-location "tex")))
-    ;; Second, create and format an *Occur* buffer
-    (save-excursion
-      (goto-char (point-min))
-      (if nodes-too
-          (occur (concat "^@node\\>\\|" outline-regexp))
-        (occur outline-regexp)))
-    (pop-to-buffer "*Occur*")
-    (goto-char (point-min))
-    ;; #### Note: XEmacs removed the following line.  No comment about
-    ;; this, nothing in the ChangeLog, so I'm leaving it as-is.  If
-    ;; removing it did have some positive effects, then consider doing
-    ;; this. --ben
-    (let ((inhibit-read-only t))
-      (flush-lines "-----")
-      ;; Now format the "*Occur*" buffer to show the structure.
-      ;; Thanks to ceder@signum.se (Per Cederqvist)
-      (goto-char (point-max))
-      (let (level)
-        (while (re-search-backward "^ *[0-9]*:@\\(\\sw+\\)" nil 0)
-          (goto-char (1- (match-beginning 1)))
-          (setq level
-                (or (cadr (assoc (match-string 1) texinfo-section-list)) 2))
-          (indent-to-column (+ (current-column) (* 4 (- level 2))))
-          (beginning-of-line))))
-    ;; Third, go to line corresponding to location in source file
-    ;; potential bug: two exactly similar `current-location' lines ...
-    (goto-char (point-min))
-    (re-search-forward current-location nil t)
-    (beginning-of-line)
-    ))
-
-
-;;; The  tex  and  print  function definitions:
-
-(defcustom texinfo-texi2dvi-command "texi2dvi"
-  "*Command used by `texinfo-tex-buffer' to run TeX and texindex on a buffer."
-  :type 'string
-  :group 'texinfo)
-
-(defcustom texinfo-tex-command "tex"
-  "*Command used by `texinfo-tex-region' to run TeX on a region."
-  :type 'string
-  :group 'texinfo)
-
-(defcustom texinfo-texindex-command "texindex"
-  "*Command used by `texinfo-texindex' to sort unsorted index files."
-  :type 'string
-  :group 'texinfo)
-
-(defcustom texinfo-delete-from-print-queue-command "lprm"
-  "*Command string used to delete a job from the line printer queue.
-Command is used by \\[texinfo-delete-from-print-queue] based on
-number provided by a previous \\[tex-show-print-queue]
-command."
-  :type 'string
-  :group 'texinfo)
-
-(defvar texinfo-tex-trailer "@bye"
-  "String appended after a region sent to TeX by `texinfo-tex-region'.")
-
-(defun texinfo-tex-region (beg end)
-  "Run TeX on the current region.
-This works by writing a temporary file (`tex-zap-file') in the directory
-that is the value of `tex-directory', then running TeX on that file.
-
-The first line of the buffer is copied to the
-temporary file; and if the buffer has a header, it is written to the
-temporary file before the region itself.  The buffer's header is all lines
-between the strings defined by `tex-start-of-header' and `tex-end-of-header'
-inclusive.  The header must start in the first 100 lines.
-
-The value of `texinfo-tex-trailer' is appended to the temporary file after the region."
-  (interactive "r")
-  (require 'tex-mode)
-  (let ((tex-command texinfo-tex-command)
-	(tex-trailer texinfo-tex-trailer))
-    (tex-region beg end)))
-
-(defun texinfo-tex-buffer ()
-  "Run TeX on visited file, once or twice, to make a correct `.dvi' file."
-  (interactive)
-  (require 'tex-mode)
-  (let ((tex-command texinfo-texi2dvi-command)
-	;; Disable tex-start-options-string.  texi2dvi would not
-	;; understand anything specified here.
-	(tex-start-options-string ""))
-    (tex-buffer)))
-
-(defun texinfo-texindex ()
-  "Run `texindex' on unsorted index files.
-The index files are made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
-This runs the shell command defined by `texinfo-texindex-command'."
-  (interactive)
-  (require 'tex-mode)
-  (tex-send-command texinfo-texindex-command (concat tex-zap-file ".??"))
-  ;; alternatively
-  ;; (send-string "tex-shell"
-  ;;              (concat texinfo-texindex-command
-  ;;                      " " tex-zap-file ".??" "\n"))
-  (tex-recenter-output-buffer nil))
-
-(defun texinfo-tex-print ()
-  "Print `.dvi' file made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
-This runs the shell command defined by `tex-dvi-print-command'."
-  (interactive)
-  (require 'tex-mode)
-  (tex-print))
-
-(defun texinfo-tex-view ()
-  "View `.dvi' file made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
-This runs the shell command defined by `tex-dvi-view-command'."
-  (interactive)
-  (require 'tex-mode)
-  (tex-view))
-
-(defun texinfo-quit-job ()
-  "Quit currently running TeX job, by sending an `x' to it."
-  (interactive)
-  (if (not (get-process "tex-shell"))
-      (error "No TeX shell running"))
-  (tex-send-command "x"))
-;; alternatively:
-;; save-excursion
-;;   (set-buffer (get-buffer "*tex-shell*"))
-;;   (goto-char (point-max))
-;;   (insert "x")
-;;   (comint-send-input)
-
-(defun texinfo-delete-from-print-queue (job-number)
-  "Delete job from the line printer spooling queue.
-You are prompted for the job number (use a number shown by a previous
-\\[tex-show-print-queue] command)."
-  (interactive "nPrinter job number for deletion: ")
-  (require 'tex-mode)
-  (if (tex-shell-running)
-      (tex-kill-job)
-    (tex-start-shell))
-  (tex-send-command texinfo-delete-from-print-queue-command job-number)
-  ;; alternatively
-  ;; (send-string "tex-shell"
-  ;;              (concat
-  ;;               texinfo-delete-from-print-queue-command
-  ;;               " "
-  ;;               job-number"\n"))
-  (tex-recenter-output-buffer nil))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.texi\\(?:nfo\\)?\\'" . texinfo-mode))
-
-(provide 'texinfo)
-
-;;; texinfo.el ends here
diff --git a/xemacs-packages/lisp/texinfo/texnfo-tex.el b/xemacs-packages/lisp/texinfo/texnfo-tex.el
deleted file mode 100644
index 2c3f7d2d..00000000
--- a/xemacs-packages/lisp/texinfo/texnfo-tex.el
+++ /dev/null
@@ -1,370 +0,0 @@
-;;;; texnfo-tex.el
-
-;;; Texinfo mode TeX and hardcopy printing commands.
-
-;; These commands are for running TeX on a region of a Texinfo file in
-;; GNU Emacs, or on the whole buffer, and for printing the resulting
-;; DVI file.
-
-;;; Version 2.07    22 October 1991
-;;; Robert J. Chassell      
-;;; Please send bug reports to:  bug-texinfo@prep.ai.mit.edu
-
-;;; Copyright (C) 1989, 1990, 1991 Free Software Foundation, Inc.
-
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-
-;;; The Texinfo mode TeX related commands are:
-
-; texinfo-tex-region        to run tex on the current region.
-; texinfo-tex-buffer        to run tex on the current buffer.
-; texinfo-texindex          to sort unsorted index files.
-; texinfo-tex-print         to print the .dvi file made by tex.
-; texinfo-kill-tex-job      to kill the currently running tex job.
-; texinfo-recenter-tex-output-buffer    to redisplay tex output buffer.
-; texinfo-show-tex-print-queue          to show the print queue.
-
-
-;;; Keys common both to Texinfo mode and to TeX shell.
-
-;; Defined in `texinfo.el'
-; (defun texinfo-define-common-keys (keymap)
-;   "Define the keys both in Texinfo mode and in the texinfo-tex-shell."
-;   (define-key keymap "\C-c\C-t\C-k"    'texinfo-kill-tex-job)
-;   (define-key keymap "\C-c\C-t\C-x"    'texinfo-quit-tex-job)
-;   (define-key keymap "\C-c\C-t\C-l"    'texinfo-recenter-tex-output-buffer)
-;   (define-key keymap "\C-c\C-t\C-d"    'texinfo-delete-from-tex-print-queue)
-;   (define-key keymap "\C-c\C-t\C-q"    'texinfo-show-tex-print-queue)
-;   (define-key keymap "\C-c\C-t\C-p"    'texinfo-tex-print)
-;   (define-key keymap "\C-c\C-t\C-i"    'texinfo-texindex)
-;   (define-key keymap "\C-c\C-t\C-r"    'texinfo-tex-region)
-;   (define-key keymap "\C-c\C-t\C-b"    'texinfo-tex-buffer))
-
-;; See also texinfo-tex-start-shell. 
-;; The following is executed in the `texinfo.el' file
-;(texinfo-define-common-keys texinfo-mode-map)
-
-
-;;; Variable definitions:
-
-(defgroup texinfo-tex nil
-  "TeX and hardcopy printing commands for Texinfo mode"
-  :prefix "texinfo-"
-  :group 'tex
-  :tag "Texinfo TeX"
-  :group 'texinfo)
-
-(require 'shell)
-
-(defcustom texinfo-tex-shell-cd-command "cd"
-  "Command to give to shell running TeX to change directory."
-  :type 'string
-  :group 'texinfo-tex)
-
-(defcustom texinfo-tex-command "tex"
-  "*Command used by  texinfo-tex-region  to run tex on a region."
-  :type 'string
-  :group 'texinfo-tex)
-
-(defcustom texinfo-texindex-command "texindex"
-  "*Command used by  texinfo-texindex  to sort unsorted index files."
-  :type 'string
-  :group 'texinfo-tex)
-
-(defcustom texinfo-tex-dvi-print-command "lpr -d"
-  "*Command string used by \\[tex-print] to print a .dvi file."
-  :type 'string
-  :group 'texinfo-tex)
-
-(defcustom texinfo-show-tex-queue-command "lpq"
-  "*Command string used to show the Texinfo TeX print queue.
-Command is used by \\[texinfo-show-tex-print-queue] and it
-should show the queue that \\[texinfo-tex-print] puts jobs on."
-  :type 'string
-  :group 'texinfo-tex)
-
-(defcustom texinfo-delete-from-print-queue-command "lprm"
-  "*Command string used to delete a job from the line printer queue.
-Command is used by \\[texinfo-delete-from-tex-print-queue] based on
-number provided by a previous \\[texinfo-show-tex-print-queue]
-command."
-  :type 'string
-  :group 'texinfo-tex)
-
-(defvar texinfo-tex-trailer "@bye"
-  "String appended after a region sent to TeX by texinfo-tex-region.")
-
-(defvar texinfo-tex-original-file ""
-  "Original name of file on which to run TeX.")
-
-(defvar texinfo-tex-temp-file nil
-  "Temporary file name used for text being sent as input to TeX.")
-
-(defvar texinfo-tex-root-temp-file nil
-  "Temporary file name used for text being sent as input to TeX.")
-
-
-;;; Texinfo TeX main functions
-
-(defun texinfo-tex-region (beginning end)
-  "Run tex on the current region. 
-
-A temporary file is written in the default directory, and tex is run
-in that directory.  The first line of the file is copied to the
-temporary file; and if the buffer has a header, it is written to the
-temporary file before the region itself.  The buffer's header is all
-lines between the strings defined by texinfo-start-of-header and
-texinfo-end-of-header inclusive.  The header must start in the first 100
-lines.  The value of texinfo-tex-trailer is appended to the temporary file
-after the region."
-  
-  (interactive "r")
-  (if (get-buffer "*texinfo-tex-shell*")
-      (quit-process (get-process "texinfo-tex-shell") t)
-    (texinfo-tex-start-shell))
-  
-  (setq texinfo-tex-root-temp-file
-        (expand-file-name 
-         (make-temp-name
-          (prin1-to-string (read (buffer-name))))))
-  
-  (let ((texinfo-tex-temp-file (concat texinfo-tex-root-temp-file ".tex")))
-    (save-excursion
-      (save-restriction
-        (widen)
-        (goto-char (point-min))
-        (forward-line 100)
-        (let ((search-end (point))
-              (header-beginning (point-min)) (header-end (point-min)))
-          (goto-char (point-min))
-          ;; Copy first line, the `\input texinfo' line, to temp file
-          (write-region (point) 
-                        (save-excursion (forward-line 1) (point))
-                        texinfo-tex-temp-file nil nil)
-          ;; Don't copy first line twice if region includes it.
-          (forward-line 1)
-          (if (< beginning  (point)) (setq beginning  (point)))
-          ;; Initialize the temp file with either the header or nothing
-          (if (search-forward texinfo-start-of-header search-end t)
-              (progn
-                (beginning-of-line)
-                (setq header-beginning (point)) ; Mark beginning of header.
-                (if (search-forward texinfo-end-of-header nil t)
-                    (progn (beginning-of-line)
-                           (setq header-end (point)))   ; Mark end of header.
-                  (setq header-beginning (point-min))))) ; Else no header.
-          ;; Copy  header  to temp file.
-          (write-region
-           (min header-beginning beginning )
-           header-end
-           texinfo-tex-temp-file t nil)
-          ;; Copy  region  to temp file.
-          (write-region
-           (max beginning  header-end)
-           end
-           texinfo-tex-temp-file t nil)
-          ;; This is a kludge to insert the texinfo-tex-trailer into the
-          ;; texinfo-tex-temp-file.  We have to create a special buffer
-          ;; in which to insert the texinfo-tex-trailer first because there is
-          ;; no function with which to append a literal string directly
-          ;; to a file.
-          (let ((local-tex-trailer texinfo-tex-trailer)
-                (temp-buffer (get-buffer-create " texinfo-trailer-buffer")))
-            (set-buffer temp-buffer)
-            (erase-buffer)
-            ;; make sure trailer isn't hidden by a comment
-            (insert-string "\n")
-            (if local-tex-trailer (insert local-tex-trailer))
-            (write-region (point-min) (point-max) 
-                          texinfo-tex-temp-file t nil)))
-        (set-process-sentinel (get-process "texinfo-tex-shell") 
-                              'texinfo-tex-shell-sentinel)
-        (process-send-string "texinfo-tex-shell"
-                     (concat texinfo-tex-shell-cd-command " "
-                             default-directory "\n"))
-        (process-send-string "texinfo-tex-shell"
-                     (concat texinfo-tex-command " "
-                             texinfo-tex-temp-file "\n  "))
-        (texinfo-recenter-tex-output-buffer 0)))))
-
-(defun texinfo-tex-buffer (buffer)
-  "Run TeX on current buffer.
-After running TeX the first time, you may have to run \\[texinfo-texindex]
-and then \\[texinfo-tex-buffer] again."
-  (interactive 
-   (list
-    ;; Sometimes you put point into *texinfo-tex-shell*; this prompts
-    ;; you for the correct file regardless.
-    (if (and 
-         (string= (buffer-name (current-buffer)) "*texinfo-tex-shell*")
-         texinfo-tex-root-temp-file)
-        (read-string (format "Run TeX on: ")
-                     texinfo-tex-original-file)
-      (read-string (format "Run TeX on: ") (buffer-name (current-buffer))))))
-  
-  ;; Set to original buffer if in *texinfo-tex-shell*; otherwise,
-  ;; record name of current buffer.
-  (if (string= (buffer-name (current-buffer)) "*texinfo-tex-shell*")
-      (set-buffer buffer)
-    (setq texinfo-tex-original-file
-           (buffer-name (current-buffer))))
-
-  (if (get-buffer "*texinfo-tex-shell*")
-      (quit-process (get-process "texinfo-tex-shell") t)
-    (texinfo-tex-start-shell))
-  (cond ((null buffer-file-name)
-         (error "Buffer not visiting any file!"))
-        ((buffer-modified-p)
-         (error "Buffer has been modified since last saved!"))
-        (t (set-process-sentinel (get-process "texinfo-tex-shell") 
-                                 'texinfo-tex-shell-sentinel)
-           (process-send-string "texinfo-tex-shell"
-                        (concat texinfo-tex-shell-cd-command 
-                                " "
-                                (file-name-directory
-                                 (buffer-file-name
-                                  (get-buffer buffer)))
-                                "\n"))
-           (process-send-string "texinfo-tex-shell"
-                        (concat texinfo-tex-command " " buffer "\n  "))
-           
-           ;; so the texinfo-tex-print command works
-           (setq texinfo-tex-root-temp-file
-                 (substring buffer 0
-                            (or (string-match "\\.tex" buffer)
-                                (length buffer))))
-           
-           (texinfo-recenter-tex-output-buffer 0))))
-
-(defun texinfo-texindex ()
-  "Run texindex on unsorted index files.
-The index files are made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
-Runs the shell command defined by texinfo-texindex-command."
-  (interactive)
-  (process-send-string "texinfo-tex-shell"
-               (concat texinfo-texindex-command
-                       " " texinfo-tex-root-temp-file ".??" "\n"))
-  (texinfo-recenter-tex-output-buffer nil))
-
-(defun texinfo-tex-print ()
-  "Print .dvi file made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
-Runs the shell command defined by texinfo-tex-dvi-print-command."
-  (interactive)
-  (process-send-string "texinfo-tex-shell"
-               (concat texinfo-tex-dvi-print-command
-                       " " texinfo-tex-root-temp-file ".dvi" "\n"))
-  (texinfo-recenter-tex-output-buffer nil))
-
-
-;;; Texinfo TeX utility functions
-
-(defun texinfo-tex-start-shell ()
-  (save-excursion
-    (require 'texinfo)
-    (set-buffer (if (fboundp 'make-shell)
-		    (make-shell "texinfo-tex-shell" "/bin/sh" nil "-v")
-		  (make-comint "texinfo-tex-shell" "/bin/sh" nil "-v")))
-    (setq texinfo-tex-shell-map (copy-keymap shell-mode-map))
-    (texinfo-define-common-keys texinfo-tex-shell-map)
-    (use-local-map texinfo-tex-shell-map)
-    (run-hooks 'texinfo-tex-shell-hook)
-    (if (zerop (buffer-size))
-        (sleep-for 1))))
-
-(defun texinfo-quit-tex-job ()
-  "Quit currently running TeX job, by sending an `x' to it."
-  (interactive)
-  (if (not (get-process "texinfo-tex-shell"))
-      (error "No TeX shell running."))
-  (save-excursion
-    (set-buffer (get-buffer "*texinfo-tex-shell*"))
-    (goto-char (point-max))
-    (insert "x")
-    (shell-send-input)))
-
-(defun texinfo-kill-tex-job ()
-  "Kill the currently running TeX job."
-  (interactive)
-  (if (get-process "texinfo-tex-shell")
-        ;; Use `texinfo-tex-shell-sentinel' to restart
-        ;; texinfo-tex-shell after it is killed.
-        (kill-process (get-process "texinfo-tex-shell"))))
-
-(defun texinfo-tex-shell-sentinel (process event)
-  "Restart texinfo-tex-shell after it is killed."
-  (if (equal event "killed\n")
-      (save-excursion
-        (set-buffer  "*texinfo-tex-shell*")
-        (insert "\n")
-        (texinfo-tex-start-shell))))
-
-(defun texinfo-recenter-tex-output-buffer (linenum)
-  "Redisplay buffer of TeX job output so that most recent output can be seen.
-The last line of the buffer is displayed on
-line LINE of the window, or centered if LINE is nil."
-  (interactive "P")
-  (let ((texinfo-tex-shell (get-buffer "*texinfo-tex-shell*"))
-        (old-buffer (current-buffer)))
-    (if (null texinfo-tex-shell)
-        (message "No TeX output buffer")
-      (pop-to-buffer texinfo-tex-shell)
-      (bury-buffer texinfo-tex-shell)
-      (goto-char (point-max))
-      (recenter (if linenum
-                    (prefix-numeric-value linenum)
-                  (/ (window-height) 2)))
-      (pop-to-buffer old-buffer)
-      )))
-
-(defun texinfo-show-tex-print-queue ()
-  "Show the print queue that \\[texinfo-tex-print] put your job on.
-Runs the shell command defined by texinfo-show-tex-queue-command."
-  (interactive)
-  (if (not (texinfo-tex-shell-running-p))
-      (texinfo-tex-start-shell))
-  (process-send-string "texinfo-tex-shell"
-               (concat texinfo-show-tex-queue-command "\n"))
-  (texinfo-recenter-tex-output-buffer nil))
-
-(defun texinfo-delete-from-tex-print-queue (job-number)
-  "Delete job from the line printer spooling queue.
-You are prompted for the job number (shown by a previous
-\\[texinfo-show-tex-print-queue] command."
-  (interactive "nPrinter job number for deletion: ")
-  (if (texinfo-tex-shell-running-p)
-      (texinfo-kill-tex-job)
-    (texinfo-tex-start-shell))
-  (process-send-string "texinfo-tex-shell"
-               (concat 
-                texinfo-delete-from-print-queue-command
-                " "
-                job-number"\n"))
-  (texinfo-recenter-tex-output-buffer nil))
-
-(defun texinfo-tex-shell-running-p ()
-  (and (get-process "texinfo-tex-shell")
-       (eq (process-status (get-process "texinfo-tex-shell")) 'run)))
-
-
-;;; Place `provide' at end of file.
-(provide 'texnfo-tex)
-;;;;;;;;;;;;;;;; end texnfo-tex.el ;;;;;;;;;;;;;;;;
diff --git a/xemacs-packages/lisp/texinfo/texnfo-upd.el b/xemacs-packages/lisp/texinfo/texnfo-upd.el
deleted file mode 100644
index d2a0fa3b..00000000
--- a/xemacs-packages/lisp/texinfo/texnfo-upd.el
+++ /dev/null
@@ -1,2043 +0,0 @@
-;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files
-
-;; Copyright (C) 1989, 1990, 1991, 1992, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: Robert J. Chassell
-;; Maintainer: bug-texinfo@gnu.org
-;; Keywords: maint, tex, docs
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;; Known bug: update commands fail to ignore @ignore.
-
-;; Summary: how to use the updating commands
-
-;; The node and menu updating functions automatically
-
-;;   * insert missing `@node' lines,
-;;   * insert the `Next', `Previous' and `Up' pointers of a node,
-;;   * insert or update the menu for a section,
-;;   * create a master menu for a Texinfo source file.
-;;
-;; With a prefix argument, the `texinfo-update-node' and
-;; `texinfo-make-menu' functions do their jobs in the region.
-;;
-;; In brief, the functions for creating or updating nodes and menus, are:
-;;
-;;     texinfo-update-node (&optional beginning end)
-;;     texinfo-every-node-update ()
-;;     texinfo-sequential-node-update (&optional region-p)
-;;
-;;     texinfo-make-menu (&optional beginning end)
-;;     texinfo-all-menus-update ()
-;;     texinfo-master-menu ()
-;;
-;;     texinfo-insert-node-lines  (&optional title-p)
-;;
-;;     texinfo-indent-menu-description (column &optional region-p)
-
-;; The `texinfo-column-for-description' variable specifies the column to
-;; which menu descriptions are indented.
-
-;; Texinfo file structure
-;; ----------------------
-
-;; To use the updating commands, you must structure your Texinfo file
-;; hierarchically.  Each `@node' line, with the exception of the top
-;; node, must be accompanied by some kind of section line, such as an
-;; `@chapter' or `@section' line.  Each node-line/section-line
-;; combination must look like this:
-
-;;      @node    Lists and Tables, Cross References, Structuring, Top
-;;      @comment node-name,        next,             previous,    up
-;;      @chapter Making Lists and Tables
-
-;; or like this (without the `@comment' line):
-
-;;      @node    Lists and Tables, Cross References, Structuring, Top
-;;      @chapter Making Lists and Tables
-
-;; If the file has a `top' node, it must be called `top' or `Top' and
-;; be the first node in the file.
-
-
-;;; The update node functions described in detail
-
-;; The `texinfo-update-node' command with no prefix argument inserts
-;; the correct next, previous and up pointers for the node in which
-;; point is located (i.e., for the node preceding point).
-
-;; With prefix argument, the `texinfo-update-node' function inserts the
-;; correct next, previous and up pointers for the nodes inside the
-;; region.
-
-;; It does not matter whether the  `@node' line has pre-existing
-;; `Next', `Previous', or `Up' pointers in it.  They are removed.
-
-;; The `texinfo-every-node-update' function runs `texinfo-update-node'
-;; on the whole buffer.
-
-;; The `texinfo-sequential-node-update' function inserts the
-;; immediately following and preceding node into the `Next' or
-;; `Previous' pointers regardless of their hierarchical level.  This is
-;; only useful for certain kinds of text, like a novel, which you go
-;; through sequentially.
-
-
-;;; The menu making functions described in detail
-
-;; The `texinfo-make-menu' function without an argument creates or
-;; updates a menu for the section encompassing the node that follows
-;; point.  With an argument, it makes or updates menus for the nodes
-;; within or part of the marked region.
-
-;; Whenever an existing menu is updated, the descriptions from
-;; that menu are incorporated into the new menu.  This is done by copying
-;; descriptions from the existing menu to the entries in the new menu
-;; that have the same node names.  If the node names are different, the
-;; descriptions are not copied to the new menu.
-
-;; Menu entries that refer to other Info files are removed since they
-;; are not a node within current buffer.  This is a deficiency.
-
-;; The `texinfo-all-menus-update' function runs `texinfo-make-menu'
-;; on the whole buffer.
-
-;; The `texinfo-master-menu' function creates an extended menu located
-;; after the top node.  (The file must have a top node.)  The function
-;; first updates all the regular menus in the buffer (incorporating the
-;; descriptions from pre-existing menus), and then constructs a master
-;; menu that includes every entry from every other menu.  (However, the
-;; function cannot update an already existing master menu; if one
-;; exists, it must be removed before calling the function.)
-
-;; The `texinfo-indent-menu-description' function indents every
-;; description in the menu following point, to the specified column.
-;; Non-nil argument (prefix, if interactive) means indent every
-;; description in every menu in the region.  This function does not
-;; indent second and subsequent lines of a multi-line description.
-
-;; The `texinfo-insert-node-lines' function inserts `@node' before the
-;; `@chapter', `@section', and such like lines of a region in a Texinfo
-;; file where the `@node' lines are missing.
-;;
-;; With a non-nil argument (prefix, if interactive), the function not
-;; only inserts `@node' lines but also inserts the chapter or section
-;; titles as the names of the corresponding nodes; and inserts titles
-;; as node names in pre-existing `@node' lines that lack names.
-;;
-;; Since node names should be more concise than section or chapter
-;; titles, node names so inserted will need to be edited manually.
-
-
-;;; Code:
-
-(require 'texinfo)
-(eval-when-compile (require 'regexp-opt))
-
-(defvar texinfo-master-menu-header
-  " --- The Detailed Node Listing ---\n"
-  "String inserted before lower level entries in Texinfo master menu.
-It comes after the chapter-level menu entries.")
-
-;; We used to look for just sub, but that found @subtitle.
-(defvar texinfo-section-types-regexp
-  "^@\\(chapter \\|sect\\|subs\\|subh\\|unnum\\|major\\|chapheading \\|heading \\|appendix\\)"
-  "Regexp matching chapter, section, other headings (but not the top node).")
-
-(defvar texinfo-section-level-regexp
-  (regexp-opt (texinfo-filter 3 texinfo-section-list))
-  "Regular expression matching just the Texinfo section level headings.")
-
-(defvar texinfo-subsection-level-regexp
-  (regexp-opt (texinfo-filter 4 texinfo-section-list))
-  "Regular expression matching just the Texinfo subsection level headings.")
-
-(defvar texinfo-subsubsection-level-regexp
-  (regexp-opt (texinfo-filter 5 texinfo-section-list))
-  "Regular expression matching just the Texinfo subsubsection level headings.")
-
-(defvar texinfo-update-menu-same-level-regexps
-  '((1 . "top[ \t]+")
-    (2 . (concat "\\(^@\\)\\(" texinfo-chapter-level-regexp "\\)\\>[ \t]*"))
-    (3 . (concat "\\(^@\\)\\(" texinfo-section-level-regexp "\\)\\>[ \t]*"))
-    (4 . (concat "\\(^@\\)\\(" texinfo-subsection-level-regexp "\\)\\>[ \t]+"))
-    (5 . (concat "\\(^@\\)\\(" texinfo-subsubsection-level-regexp "\\)\\>[ \t]+")))
-  "*Regexps for searching for same level sections in a Texinfo file.
-The keys are strings specifying the general hierarchical level in the
-document; the values are regular expressions.")
-
-(defvar texinfo-update-menu-higher-regexps
-  '((1 . "^@node [ \t]*DIR")
-    (2 . "^@node [ \t]*top[ \t]*\\(,\\|$\\)")
-    (3 .
-     (concat
-      "\\(^@\\("
-      texinfo-chapter-level-regexp
-      "\\)\\>[ \t]*\\)"))
-    (4 .
-     (concat
-      "\\(^@\\("
-      texinfo-section-level-regexp
-      "\\|"
-      texinfo-chapter-level-regexp
-      "\\)\\>[ \t]*\\)"))
-    (5 .
-     (concat
-      "\\(^@\\("
-      texinfo-subsection-level-regexp
-      "\\|"
-      texinfo-section-level-regexp
-      "\\|"
-      texinfo-chapter-level-regexp
-      "\\)\\>[ \t]*\\)")))
-  "*Regexps for searching for higher level sections in a Texinfo file.
-The keys are strings specifying the general hierarchical level in the
-document; the values are regular expressions.")
-
-(defvar texinfo-update-menu-lower-regexps
-  '((1 .
-     (concat
-      "\\(^@\\("
-      texinfo-chapter-level-regexp
-      "\\|"
-      texinfo-section-level-regexp
-      "\\|"
-      texinfo-subsection-level-regexp
-      "\\|"
-      texinfo-subsubsection-level-regexp
-      "\\)\\>[ \t]*\\)"))
-    (2 .
-     (concat
-      "\\(^@\\("
-      texinfo-section-level-regexp
-      "\\|"
-      texinfo-subsection-level-regexp
-      "\\|"
-      texinfo-subsubsection-level-regexp
-      "\\)\\>[ \t]*\\)"))
-    (3 .
-     (concat
-      "\\(^@\\("
-      texinfo-subsection-level-regexp
-      "\\|"
-      texinfo-subsubsection-level-regexp
-      "\\)\\>[ \t]+\\)"))
-    (4 .
-     (concat
-      "\\(^@\\("
-      texinfo-subsubsection-level-regexp
-      "\\)\\>[ \t]+\\)"))
-    ;; There's nothing below 5, use a bogus regexp that can't match.
-    (5 . "a\\(^\\)"))
-  "*Regexps for searching for lower level sections in a Texinfo file.
-The keys are strings specifying the general hierarchical level in the
-document; the values are regular expressions.")
-
-
-(defun texinfo-make-menu (&optional beginning end)
-  "Without any prefix argument, make or update a menu.
-Make the menu for the section enclosing the node found following point.
-
-A prefix argument means make or update menus
-for nodes within or part of the marked region.
-
-Whenever a menu exists, and is being updated, the descriptions that
-are associated with node names in the pre-existing menu are
-incorporated into the new menu.
-
-Leaves trailing whitespace in a menu that lacks descriptions, so
-descriptions will format well.  In general, a menu should contain
-descriptions, because node names and section titles are often too
-short to explain a node well."
-
-  (interactive
-   (if prefix-arg
-       (list (point) (mark))))
-  (if (null beginning)
-      (let ((level (texinfo-hierarchic-level)))
-	(texinfo-make-one-menu level)
-	(message "Menu updated"))
-    ;; else
-    (message "Making or updating menus in %s... " (buffer-name))
-    (save-excursion
-      (goto-char (min beginning end))
-      ;; find section type following point
-      (let ((level (texinfo-hierarchic-level))
-	    (region-end-marker (make-marker)))
-	(set-marker region-end-marker (max beginning end))
-	(save-restriction
-	  (widen)
-
-	  (while (texinfo-find-lower-level-node
-		  level (marker-position region-end-marker))
-	    (setq level (texinfo-hierarchic-level)) ; new, lower level
-	    (texinfo-make-one-menu level))
-
-	  (while (and (< (point) (marker-position region-end-marker))
-		      (texinfo-find-higher-level-node
-		       level (marker-position region-end-marker)))
-	    (setq level (texinfo-hierarchic-level))
-	    ;; Don't allow texinfo-find-higher-level-node
-	    ;; to find the same node again.
-	    (forward-line 1)
-	    (while (texinfo-find-lower-level-node
-		    level (marker-position region-end-marker))
-	      (setq level (texinfo-hierarchic-level)) ; new, lower level
-	      (texinfo-make-one-menu level))))))
-    (message "Making or updating menus in %s...done" (buffer-name))))
-
-(defun texinfo-make-one-menu (level)
-  "Make a menu of all the appropriate nodes in this section.
-`Appropriate nodes' are those associated with sections that are
-at the level specified by LEVEL.  Point is left at the end of menu."
-  (let*
-      ((case-fold-search t)
-       (beginning
-	(save-excursion
-	  (goto-char (texinfo-update-menu-region-beginning level))
-	  (end-of-line)
-	  (point)))
-       (end (texinfo-update-menu-region-end level))
-       (first (texinfo-menu-first-node beginning end))
-       (node-name (progn
-		    (goto-char beginning)
-		    (beginning-of-line)
-		    (texinfo-copy-node-name)))
-       (new-menu-list (texinfo-make-menu-list beginning end level)))
-    (when (texinfo-old-menu-p beginning first)
-      (texinfo-incorporate-descriptions new-menu-list)
-      (texinfo-incorporate-menu-entry-names new-menu-list)
-      (texinfo-delete-old-menu beginning first))
-    (texinfo-insert-menu new-menu-list node-name)))
-
-(defun texinfo-all-menus-update (&optional update-all-nodes-p)
-  "Update every regular menu in a Texinfo file.
-Update pre-existing master menu, if there is one.
-
-If called with a non-nil argument, this function first updates all the
-nodes in the buffer before updating the menus.
-
-Indents the first line of descriptions, and leaves trailing whitespace
-in a menu that lacks descriptions, so descriptions will format well.
-In general, a menu should contain descriptions, because node names and
-section titles are often too short to explain a node well."
-  (interactive "P")
-  (let ((case-fold-search t)
-	master-menu-p)
-    (save-excursion
-      (push-mark (point-max) t)
-      (goto-char (point-min))
-      (message "Checking for a master menu in %s ... "(buffer-name))
-      (save-excursion
-	(when (search-forward texinfo-master-menu-header nil t)
-	  ;; Check if @detailmenu kludge is used;
-	  ;; if so, leave point before @detailmenu.
-	  (search-backward "\n@detailmenu"
-			   (save-excursion (forward-line -3) (point))
-			   t)
-	  ;; Remove detailed master menu listing
-	  (setq master-menu-p t)
-	  (goto-char (match-beginning 0))
-	  (let ((end-of-detailed-menu-descriptions
-		 (save-excursion     ; beginning of end menu line
-		   (goto-char (texinfo-menu-end))
-		   (beginning-of-line) (forward-char -1)
-		   (point))))
-	    (delete-region (point) end-of-detailed-menu-descriptions))))
-
-      (when update-all-nodes-p
-	(message "Updating all nodes in %s ... " (buffer-name))
-	(texinfo-update-node (point-min) (point-max)))
-
-      (message "Updating all menus in %s ... " (buffer-name))
-      (texinfo-make-menu (point-max) (point-min))
-
-      (when master-menu-p
-	(message "Updating the master menu in %s... " (buffer-name))
-	(texinfo-master-menu nil)))
-
-    (message "Done...updated all the menus.  You may save the buffer.")))
-
-(defun texinfo-find-lower-level-node (level region-end)
-  "Search forward from point for node at any level lower than LEVEL.
-Search is limited to the end of the marked region, REGION-END,
-and to the end of the menu region for the level.
-
-Return t if the node is found, else nil.  Leave point at the beginning
-of the node if one is found; else do not move point."
-  (let ((case-fold-search t))
-    (if (and (< (point) region-end)
-	     (re-search-forward
-	      (concat
-	       "\\(^@node\\).*\n"         ; match node line
-	       "\\(\\(\\(^@c\\).*\n\\)"   ; match comment line, if any
-	       "\\|"                      ; or
-	       "\\(^@ifinfo[ ]*\n\\)"     ; ifinfo line, if any
-               "\\|"                      ; or
-               "\\(^@ifnottex[ ]*\n\\)"   ; ifnottex line, if any
-               "\\)?"                     ; end of expression
-	       (eval (cdr (assoc level texinfo-update-menu-lower-regexps))))
-	      ;; the next higher level node marks the end of this
-	      ;; section, and no lower level node will be found beyond
-	      ;; this position even if region-end is farther off
-	      (texinfo-update-menu-region-end level)
-	      t))
-	(goto-char (match-beginning 1)))))
-
-(defun texinfo-find-higher-level-node (level region-end)
-  "Search forward from point for node at any higher level than argument LEVEL.
-Search is limited to the end of the marked region, REGION-END.
-
-Return t if the node is found, else nil.  Leave point at the beginning
-of the node if one is found; else do not move point.
-
-A `@node' line starting at point does count as a match;
-if the match is found there, the value is t and point does not move."
-
-  (let ((case-fold-search t))
-    (cond
-     ((< level 3)
-      (if (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" region-end t)
-	  (progn (beginning-of-line) t)))
-     (t
-      (when (re-search-forward
-	     (concat
-	      "\\(^@node\\).*\n"              ; match node line
-	      "\\(\\(\\(^@c\\).*\n\\)"        ; match comment line, if any
-	      "\\|"                           ; or
-	      "\\(^@ifinfo[ ]*\n\\)"          ; ifinfo line, if any
-	      "\\|"                           ; or
-	      "\\(^@ifnottex[ ]*\n\\)"        ; ifnottex line, if any
-	      "\\)?"                          ; end of expression
-	      (eval (cdr (assoc level texinfo-update-menu-higher-regexps))))
-	     region-end t)
-	(beginning-of-line) t)))))
-
-
-;;; Making the list of new menu entries
-
-(defun texinfo-make-menu-list (beginning end level)
-  "Make a list of node names and their descriptions.
-Point is left at the end of the menu region, but the menu is not inserted.
-
-First argument is position from which to start making menu list;
-second argument is end of region in which to try to locate entries;
-third argument is the level of the nodes that are the entries.
-
-Node names and descriptions are dotted pairs of strings.  Each pair is
-an element of the list.  If the description does not exist, the
-element consists only of the node name."
-  (goto-char beginning)
-  (let (new-menu-list)
-    (while (texinfo-menu-locate-entry-p level end)
-      (push (cons
-	     (texinfo-copy-node-name)
-	     (prog1 "" (forward-line 1)))
-	    ;; Use following to insert section titles automatically.
-	    ;; (texinfo-copy-section-title))
-	    new-menu-list))
-    (nreverse new-menu-list)))
-
-(defun texinfo-menu-locate-entry-p (level search-end)
-  "Find a node that will be part of menu for this section.
-First argument is a string such as \"section\" specifying the general
-hierarchical level of the menu; second argument is a position
-specifying the end of the search.
-
-The function returns t if the node is found, else nil.  It searches
-forward from point, and leaves point at the beginning of the node.
-
-The function finds entries of the same type.  Thus `subsections' and
-`unnumberedsubsecs' will appear in the same menu."
-  (let ((case-fold-search t))
-    (if (re-search-forward
-	 (concat
-	  "\\(^@node\\).*\n"              ; match node line
-	  "\\(\\(\\(^@c\\).*\n\\)"        ; match comment line, if any
-	  "\\|"                           ; or
-	  "\\(^@ifinfo[ ]*\n\\)"          ; ifinfo line, if any
-	  "\\|"                           ; or
-	  "\\(^@ifnottex[ ]*\n\\)"        ; ifnottex line, if any
-          "\\)?"                          ; end of expression
-	  (eval
-	   (cdr (assoc level texinfo-update-menu-same-level-regexps))))
-	 search-end
-	 t)
-	(goto-char (match-beginning 1)))))
-
-(defun texinfo-copy-node-name ()
-  "Return the node name as a string.
-
-Start with point at the beginning of the node line; copy the text
-after the node command up to the first comma on the line, if any, and
-return the text as a string.  Leaves point at the beginning of the
-line.  If there is no node name, returns an empty string."
-  (save-excursion
-    (buffer-substring
-     (progn (forward-word 1)              ; skip over node command
-	    (skip-chars-forward " \t")    ; and over spaces
-	    (point))
-     (if (search-forward "," (point-at-eol) t) ; bound search 
-	 (1- (point))
-       (end-of-line) (point)))))
-
-(defun texinfo-copy-section-title ()
-  "Return the title of the section as a string.
-The title is used as a description line in the menu when one does not
-already exist.
-
-Move point to the beginning of the appropriate section line by going
-to the start of the text matched by last regexp searched for, which
-must have been done by `texinfo-menu-locate-entry-p'."
-
-  ;; could use the same re-search as in `texinfo-menu-locate-entry-p'
-  ;; instead of using `match-beginning'; such a variation would be
-  ;; more general, but would waste information already collected
-
-  (goto-char (match-beginning 7))       ; match section name
-
-  (buffer-substring
-   (progn (forward-word 1)              ; skip over section type
-	  (skip-chars-forward " \t")    ; and over spaces
-	  (point))
-   (progn (end-of-line) (point))))
-
-
-;;; Handling the old menu
-
-(defun texinfo-old-menu-p (beginning first)
-  "Move point to the beginning of the menu for this section, if any.
-Otherwise move point to the end of the first node of this section.
-Return t if a menu is found, nil otherwise.
-
-First argument is the position of the beginning of the section in which
-the menu will be located; second argument is the position of the first
-node within the section.
-
-If no menu is found, the function inserts two newlines just before the
-end of the section, and leaves point there where a menu ought to be."
-  (goto-char beginning)
-  (if (re-search-forward "^@menu" first 'goto-end)
-      t
-    (insert "\n\n") (forward-line -2) nil))
-
-(defun texinfo-incorporate-descriptions (new-menu-list)
-  "Copy the old menu line descriptions that exist to the new menu.
-
-Point must be at beginning of old menu.
-
-If the node-name of the new menu is found in the old menu, insert the
-old description into the new entry.
-
-For this function, the new menu is a list made up of lists of dotted
-pairs in which the first element of the pair is the node name and the
-second element the description.  The new menu is changed destructively.
-The old menu is the menu as it appears in the Texinfo file."
-
-  (let ((end-of-menu (texinfo-menu-end)))
-    (dolist (new-menu new-menu-list new-menu-list)
-      (save-excursion			; keep point at beginning of menu
-	(when (re-search-forward
-	       ;; Existing nodes can have the form
-	       ;;     * NODE NAME:: DESCRIPTION
-	       ;; or
-	       ;;     * MENU ITEM: NODE NAME.     DESCRIPTION.
-	       ;;
-	       ;; Recognize both when looking for the description.
-	       (concat "\\* \\("	; so only menu entries are found
-		       (regexp-quote (car new-menu)) "::"
-		       "\\|"
-		       ".*: " (regexp-quote (car new-menu)) "[.,\t\n]"
-		       "\\)"
-		       )		; so only complete entries are found
-	       end-of-menu
-	       t)
-	  (setcdr new-menu (texinfo-menu-copy-old-description end-of-menu)))))))
-
-(defun texinfo-incorporate-menu-entry-names (new-menu-list)
-  "Copy any old menu entry names to the new menu.
-
-Point must be at beginning of old menu.
-
-If the node-name of the new menu entry cannot be found in the old
-menu, do nothing.
-
-For this function, the new menu is a list made up of lists of dotted
-pairs in which the first element of the pair is the node name and the
-second element is the description (or nil).
-
-If we find an existing menu entry name, we change the first element of
-the pair to be another dotted pair in which the car is the menu entry
-name and the cdr is the node name.
-
-NEW-MENU-LIST is changed destructively.  The old menu is the menu as it
-appears in the texinfo file."
-
-  (let ((end-of-menu (texinfo-menu-end)))
-    (dolist (new-menu new-menu-list new-menu-list)
-      (save-excursion                   ; keep point at beginning of menu
-	(if (re-search-forward
-	     ;; Existing nodes can have the form
-	     ;;     * NODE NAME:: DESCRIPTION
-	     ;; or
-	     ;;     * MENU ITEM: NODE NAME.     DESCRIPTION.
-	     ;;
-	     ;; We're interested in the second case.
-	     (concat "\\* "              ; so only menu entries are found
-		     "\\(.*\\): " (regexp-quote (car new-menu))
-		     "[.,\t\n]")
-	     end-of-menu
-	     t)
-	    (setcar
-	      new-menu  ; replace the node name
-	      (cons (buffer-substring (match-beginning 1) (match-end 1))
-		    (car new-menu))))))))
-
-(defun texinfo-menu-copy-old-description (end-of-menu)
-  "Return description field of old menu line as string.
-Point must be located just after the node name.  Point left before description.
-Single argument, END-OF-MENU, is position limiting search."
-  (skip-chars-forward "[:.,\t\n ]+")
-  ;; don't copy a carriage return at line beginning with asterisk!
-  ;; do copy a description that begins with an `@'!
-  ;; !! Known bug: does not copy descriptions starting with ^|\{?* etc.
-  (if (and (looking-at "\\(\\w+\\|@\\)")
-	   (not (looking-at "\\(^\\* \\|^@end menu\\)")))
-      (buffer-substring
-       (point)
-       (save-excursion
-	 (re-search-forward "\\(^\\* \\|^@end menu\\)" end-of-menu t)
-	 (forward-line -1)
-	 (end-of-line)                  ; go to end of last description line
-	 (point)))
-    ""))
-
-(defun texinfo-menu-end ()
-  "Return position of end of menu, but don't move point.
-Signal an error if not end of menu."
-  (save-excursion
-    (if (re-search-forward "^@end menu" nil t)
-	(point)
-      (error "Menu does not have an end"))))
-
-(defun texinfo-delete-old-menu (beginning first)
-  "Delete the old menu.  Point must be in or after menu.
-First argument is position of the beginning of the section in which
-the menu will be located; second argument is the position of the first
-node within the section."
-  ;; No third arg to search, so error if search fails.
-  (re-search-backward "^@menu" beginning)
-  (delete-region (point)
-		 (save-excursion
-		   (re-search-forward "^@end menu" first)
-		   (point))))
-
-
-;;; Inserting new menu
-
-;; try 32, but perhaps 24 is better
-(defvar texinfo-column-for-description 32
-  "*Column at which descriptions start in a Texinfo menu.")
-
-(defun texinfo-insert-menu (menu-list node-name)
-  "Insert formatted menu at point.
-Indents the first line of descriptions, if any, to the value of
-texinfo-column-for-description.  Indenting leaves trailing whitespace
-in a menu that lacks descriptions, so descriptions will format well.
-In general, a menu should contain descriptions, because node names and
-section titles are often too short to explain a node well.
-
-MENU-LIST has form:
-
-    \(\(\"node-name1\" . \"description\"\)
-    \(\"node-name2\" . \"description\"\) ... \)
-
-However, the description field might be nil.
-
-Also, the node-name field might itself be a dotted pair (call it P) of
-strings instead of just a string.  In that case, the car of P
-is the menu entry name, and the cdr of P is the node name."
-
-  (insert "@menu\n")
-  (dolist (menu menu-list)
-    ;; Every menu entry starts with a star and a space.
-    (insert "* ")
-
-    ;; Insert the node name (and menu entry name, if present).
-    (let ((node-part (car menu)))
-      (if (stringp node-part)
-	  ;; "Double colon" entry line; menu entry and node name are the same,
-	  (insert (format "%s::" node-part))
-	;; "Single colon" entry line; menu entry and node name are different.
-	(insert (format "%s: %s." (car node-part) (cdr node-part)))))
-
-    ;; Insert the description, if present.
-    (when (cdr menu)
-      ;; Move to right place.
-      (indent-to texinfo-column-for-description 2)
-      ;; Insert description.
-      (insert (format "%s" (cdr menu))))
-
-    (insert "\n")) ; end this menu entry
-  (insert "@end menu")
-  (let ((level (texinfo-hierarchic-level)))
-    (message
-     "Updated level \"%s\" menu following node: %s ... " level node-name)))
-
-
-;;; Starting menu descriptions by inserting titles
-
-(defun texinfo-start-menu-description ()
-  "In this menu entry, insert the node's section title as a description.
-Position point at beginning of description ready for editing.
-Do not insert a title if the line contains an existing description.
-
-You will need to edit the inserted text since a useful description
-complements the node name rather than repeats it as a title does."
-
-  (interactive)
-  (let (beginning end node-name title)
-    (save-excursion
-      (beginning-of-line)
-      (if (search-forward "* " (save-excursion (end-of-line) (point)) t)
-	  (progn (skip-chars-forward " \t")
-		 (setq beginning (point)))
-	(error "This is not a line in a menu"))
-
-      (cond
-       ;; "Double colon" entry line; menu entry and node name are the same,
-       ((search-forward "::" (save-excursion (end-of-line) (point)) t)
-	(if (looking-at "[ \t]*[^ \t\n]+")
-	    (error "Descriptive text already exists"))
-	(skip-chars-backward ": \t")
-	(setq node-name (buffer-substring beginning (point))))
-
-       ;; "Single colon" entry line; menu entry and node name are different.
-       ((search-forward ":" (save-excursion (end-of-line) (point)) t)
-	(skip-chars-forward " \t")
-	(setq beginning (point))
-	;; Menu entry line ends in a period, comma, or tab.
-	(if (re-search-forward "[.,\t]"
-			       (save-excursion (forward-line 1) (point)) t)
-	    (progn
-	      (if (looking-at "[ \t]*[^ \t\n]+")
-		  (error "Descriptive text already exists"))
-	      (skip-chars-backward "., \t")
-	      (setq node-name (buffer-substring beginning (point))))
-	  ;; Menu entry line ends in a return.
-	  (re-search-forward ".*\n"
-			     (save-excursion (forward-line 1) (point)) t)
-	  (skip-chars-backward " \t\n")
-	  (setq node-name (buffer-substring beginning (point)))
-	  (if (= 0 (length node-name))
-	      (error "No node name on this line")
-	    (insert "."))))
-       (t (error "No node name on this line")))
-      ;; Search for node that matches node name, and copy the section title.
-      (if (re-search-forward
-	   (concat
-	    "^@node[ \t]+"
-	    (regexp-quote node-name)
-	    ".*\n"			; match node line
-	    "\\("
-	    "\\(\\(^@c \\|^@comment\\).*\n\\)" ; match comment line, if any
-	    "\\|"                              ; or
-	    "\\(^@ifinfo[ ]*\n\\)"             ; ifinfo line, if any
-            "\\|"                              ; or
-            "\\(^@ifnottex[ ]*\n\\)"           ; ifnottex line, if any
-            "\\)?"                             ; end of expression
-	    )
-	   nil t)
-          (setq title
-		(buffer-substring
-		 ;; skip over section type
-		 (progn (forward-word 1)
-			;; and over spaces
-			(skip-chars-forward " \t")
-			(point))
-		 (progn (end-of-line)
-			(skip-chars-backward " \t")
-			(point))))
-	(error "Cannot find node to match node name in menu entry")))
-    ;; Return point to the menu and insert the title.
-    (end-of-line)
-    (delete-region
-     (point)
-     (save-excursion (skip-chars-backward " \t") (point)))
-    (indent-to texinfo-column-for-description 2)
-    (save-excursion (insert title))))
-
-
-;;; Handling description indentation
-
-;; Since the make-menu functions indent descriptions, these functions
-;; are useful primarily for indenting a single menu specially.
-
-(defun texinfo-indent-menu-description (column &optional region-p)
-  "Indent every description in menu following point to COLUMN.
-Non-nil argument (prefix, if interactive) means indent every
-description in every menu in the region.  Does not indent second and
-subsequent lines of a multi-line description."
-
-  (interactive
-   "nIndent menu descriptions to (column number): \nP")
-  (save-excursion
-    (save-restriction
-      (widen)
-      (if (not region-p)
-	  (progn
-	    (re-search-forward "^@menu")
-	    (texinfo-menu-indent-description column)
-	    (message
-	     "Indented descriptions in menu.  You may save the buffer."))
-	;;else
-	(message "Indenting every menu description in region... ")
-	(goto-char (region-beginning))
-	(while (and (< (point) (region-end))
-		    (texinfo-locate-menu-p))
-	  (forward-line 1)
-	  (texinfo-menu-indent-description column))
-	(message "Indenting done.  You may save the buffer.")))))
-
-(defun texinfo-menu-indent-description (to-column-number)
-  "Indent the Texinfo file menu description to TO-COLUMN-NUMBER.
-Start with point just after the word `menu' in the `@menu' line and
-leave point on the line before the `@end menu' line.  Does not indent
-second and subsequent lines of a multi-line description."
-  (let* ((beginning-of-next-line (point)))
-    (while (< beginning-of-next-line
-	      (save-excursion		; beginning of end menu line
-		(goto-char (texinfo-menu-end))
-		(beginning-of-line)
-		(point)))
-
-      (when (re-search-forward "\\* \\(.*::\\|.*: [^.,\t\n]+[.,\t]\\)"
-			       (texinfo-menu-end)
-			       t)
-	(let ((beginning-white-space (point)))
-	  (skip-chars-forward " \t")	; skip over spaces
-	  (if (looking-at "\\(@\\|\\w\\)+") ; if there is text
-	      (progn
-		;; remove pre-existing indentation
-		(delete-region beginning-white-space (point))
-		(indent-to-column to-column-number)))))
-      ;; position point at beginning of next line
-      (forward-line 1)
-      (setq beginning-of-next-line (point)))))
-
-
-;;; Making the master menu
-
-(defun texinfo-master-menu (update-all-nodes-menus-p)
-  "Make a master menu for a whole Texinfo file.
-Non-nil argument (prefix, if interactive) means first update all
-existing nodes and menus.  Remove pre-existing master menu, if there is one.
-
-This function creates a master menu that follows the top node.  The
-master menu includes every entry from all the other menus.  It
-replaces any existing ordinary menu that follows the top node.
-
-If called with a non-nil argument, this function first updates all the
-menus in the buffer (incorporating descriptions from pre-existing
-menus) before it constructs the master menu.
-
-The function removes the detailed part of an already existing master
-menu.  This action depends on the pre-existing master menu using the
-standard `texinfo-master-menu-header'.
-
-The master menu has the following format, which is adapted from the
-recommendation in the Texinfo Manual:
-
-   * The first part contains the major nodes in the Texinfo file: the
-     nodes for the chapters, chapter-like sections, and the major
-     appendices.  This includes the indices, so long as they are in
-     chapter-like sections, such as unnumbered sections.
-
-   * The second and subsequent parts contain a listing of the other,
-     lower level menus, in order.  This way, an inquirer can go
-     directly to a particular node if he or she is searching for
-     specific information.
-
-Each of the menus in the detailed node listing is introduced by the
-title of the section containing the menu.
-
-Indents the first line of descriptions, and leaves trailing whitespace
-in a menu that lacks descriptions, so descriptions will format well.
-In general, a menu should contain descriptions, because node names and
-section titles are often too short to explain a node well."
-
-  (interactive "P")
-  (let ((case-fold-search t))
-    (widen)
-    (goto-char (point-min))
-
-    ;; Move point to location after `top'.
-    (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t))
-	(error "This buffer needs a Top node"))
-
-    (let ((first-chapter
-	   (save-excursion
-	     (or (re-search-forward "^@node" nil t)
-		 (error "Too few nodes for a master menu"))
-	     (point))))
-      (if (search-forward texinfo-master-menu-header first-chapter t)
-	  (progn
-	    ;; Check if @detailmenu kludge is used;
-	    ;; if so, leave point before @detailmenu.
-	    (search-backward "\n@detailmenu"
-			     (save-excursion (forward-line -3) (point))
-			     t)
-	    ;; Remove detailed master menu listing
-	    (goto-char (match-beginning 0))
-	    (let ((end-of-detailed-menu-descriptions
-		   (save-excursion     ; beginning of end menu line
-		     (goto-char (texinfo-menu-end))
-		     (beginning-of-line) (forward-char -1)
-		     (point))))
-	      (delete-region (point) end-of-detailed-menu-descriptions)))))
-
-    (if update-all-nodes-menus-p
-	(progn
-	  (message "Making a master menu in %s ...first updating all nodes... "
-		   (buffer-name))
-	  (texinfo-update-node (point-min) (point-max))
-
-	  (message "Updating all menus in %s ... " (buffer-name))
-	  (texinfo-make-menu (point-min) (point-max))))
-
-    (message "Now making the master menu in %s... " (buffer-name))
-    (goto-char (point-min))
-    (texinfo-insert-master-menu-list
-     (texinfo-master-menu-list))
-
-    ;; Remove extra newlines that texinfo-insert-master-menu-list
-    ;; may have inserted.
-
-    (save-excursion
-      (goto-char (point-min))
-
-      (if (search-forward texinfo-master-menu-header nil t)
-	  (progn
-	    (goto-char (match-beginning 0))
-	    ;; Check if @detailmenu kludge is used;
-	    ;; if so, leave point before @detailmenu.
-	    (search-backward "\n@detailmenu"
-			     (save-excursion (forward-line -3) (point))
-			     t)
-	    (insert "\n")
-	    (delete-blank-lines)
-	    (goto-char (point-min))))
-
-      (re-search-forward "^@menu")
-      (forward-line -1)
-      (delete-blank-lines)
-
-      (re-search-forward "^@end menu")
-      (forward-line 1)
-      (delete-blank-lines))
-
-    (message
-     "Done...completed making master menu.  You may save the buffer.")))
-
-(defun texinfo-master-menu-list ()
-  "Return a list of menu entries and header lines for the master menu.
-
-Start with the menu for chapters and indices and then find each
-following menu and the title of the node preceding that menu.
-
-The master menu list has this form:
-
-    \(\(\(... \"entry-1-2\"  \"entry-1\"\) \"title-1\"\)
-      \(\(... \"entry-2-2\"  \"entry-2-1\"\) \"title-2\"\)
-      ...\)
-
-However, there does not need to be a title field."
-
-  (let (master-menu-list)
-    (while (texinfo-locate-menu-p)
-      (push (list (texinfo-copy-menu) (texinfo-copy-menu-title))
-	    master-menu-list))
-    (nreverse master-menu-list)))
-
-(defun texinfo-insert-master-menu-list (master-menu-list)
-  "Format and insert the master menu in the current buffer."
-  (goto-char (point-min))
-  ;; Insert a master menu only after `Top' node and before next node
-  ;; \(or include file if there is no next node\).
-  (unless (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)
-    (error "This buffer needs a Top node"))
-  (let ((first-chapter
-	 (save-excursion (re-search-forward "^@node\\|^@include") (point))))
-    (unless (re-search-forward "^@menu" first-chapter t)
-      (error "Buffer lacks ordinary `Top' menu in which to insert master")))
-  (beginning-of-line)
-  (delete-region      ; buffer must have ordinary top menu
-   (point)
-   (save-excursion (re-search-forward "^@end menu") (point)))
-
-  (save-excursion
-    ;; `master-menu-inserted-p' is a kludge to tell
-    ;; whether to insert @end detailmenu (see bleow)
-    (let (master-menu-inserted-p)
-      ;; Handle top of menu
-      (insert "\n@menu\n")
-      ;; Insert chapter menu entries.  Tell user what is going on.
-      (message "Inserting chapter menu entry: %s ... "
-	       (car (car master-menu-list)))
-      (dolist (entry (reverse (car (car master-menu-list))))
-	(insert "* " entry "\n"))
-
-      (setq master-menu-list (cdr master-menu-list))
-
-      ;; Only insert detailed master menu if there is one....
-      (if (car (car master-menu-list))
-	  (progn (setq master-menu-inserted-p t)
-		 (insert (concat "\n@detailmenu\n"
-				 texinfo-master-menu-header))))
-
-      ;; @detailmenu added 5 Sept 1996 to `texinfo-master-menu-header'
-      ;; at Karl Berry's request to avert a bug in `makeinfo';
-      ;; all agree this is a bad kludge and should eventually be removed.
-      ;; @detailmenu ... @end detailmenu is a noop in `texinfmt.el'.
-      ;; See @end detailmenu below;
-      ;; also see `texinfo-all-menus-update' above, `texinfo-master-menu',
-      ;; `texinfo-multiple-files-update'.
-
-      ;; Now, insert all the other menus
-
-      ;; The menu master-menu-list has a form like this:
-      ;; ((("beta"  "alpha") "title-A")
-      ;;  (("delta" "gamma") "title-B"))
-
-      (dolist (menu master-menu-list)
-
-	(message "Inserting menu for %s .... " (cadr menu))
-	;; insert title of menu section
-	(insert "\n" (cadr menu) "\n\n")
-
-	;; insert each menu entry
-	(dolist (entry (reverse (car menu)))
-	  (insert "* " entry "\n")))
-
-      ;; Finish menu
-
-      ;; @detailmenu (see note above)
-      ;; Only insert @end detailmenu if a master menu was inserted.
-      (if master-menu-inserted-p
-	  (insert "\n@end detailmenu"))
-      (insert "\n@end menu\n\n"))))
-
-(defun texinfo-locate-menu-p ()
-  "Find the next menu in the texinfo file.
-If found, leave point after word `menu' on the `@menu' line, and return t.
-If a menu is not found, do not move point and return nil."
-  (re-search-forward "\\(^@menu\\)" nil t))
-
-(defun texinfo-copy-menu-title ()
-  "Return the title of the section preceding the menu as a string.
-If such a title cannot be found, return an empty string.  Do not move
-point."
-  (let ((case-fold-search t))
-    (save-excursion
-      (if (re-search-backward
-	   (concat
-	    "\\(^@top"
-	    "\\|"                         ; or
-	    texinfo-section-types-regexp  ; all other section types
-	    "\\)")
-	   nil
-	   t)
-	  (progn
-	    (beginning-of-line)
-	    (forward-word 1)              ; skip over section type
-	    (skip-chars-forward " \t")    ; and over spaces
-	    (buffer-substring
-	     (point)
-	     (progn (end-of-line) (point))))
-	""))))
-
-(defun texinfo-copy-menu ()
-  "Return the entries of an existing menu as a list.
-Start with point just after the word `menu' in the `@menu' line
-and leave point on the line before the `@end menu' line."
-  (let* (this-menu-list
-	 (end-of-menu (texinfo-menu-end)) ; position of end of `@end menu'
-	 (last-entry (save-excursion      ; position of beginning of
-					  ; last `* ' entry
-		      (goto-char end-of-menu)
-		      ;; handle multi-line description
-		      (if (not (re-search-backward "^\\* " nil t))
-			  (error "No entries in menu"))
-		      (point))))
-    (while (< (point) last-entry)
-      (if (re-search-forward  "^\\* " end-of-menu t)
-	  (push (buffer-substring
-		 (point)
-		 ;; copy multi-line descriptions
-		 (save-excursion
-		   (re-search-forward "\\(^\\* \\|^@e\\)" nil t)
-		   (- (point) 3)))
-		this-menu-list)))
-    this-menu-list))
-
-
-;;; Determining the hierarchical level in the texinfo file
-
-(defun texinfo-specific-section-type ()
-  "Return the specific type of next section, as a string.
-For example, \"unnumberedsubsec\".  Return \"top\" for top node.
-
-Searches forward for a section.  Hence, point must be before the
-section whose type will be found.  Does not move point.  Signal an
-error if the node is not the top node and a section is not found."
-  (let ((case-fold-search t))
-    (save-excursion
-      (cond
-       ((re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
-			   ;; Following search limit by cph but causes a bug
-			   ;;(line-end-position)
-			   nil
-			   t)
-	"top")
-       ((re-search-forward texinfo-section-types-regexp nil t)
-	(buffer-substring-no-properties
-	 (progn (beginning-of-line) ; copy its name
-		(1+ (point)))
-	 (progn (forward-word 1)
-		(point))))
-       (t
-	(error
-	 "texinfo-specific-section-type: Chapter or section not found"))))))
-
-(defun texinfo-hierarchic-level ()
-  "Return the general hierarchal level of the next node in a texinfo file.
-Thus, a subheading or appendixsubsec is of type subsection."
-  (let ((case-fold-search t))
-    (cadr (assoc
-	   (texinfo-specific-section-type)
-	   texinfo-section-list))))
-
-
-;;; Locating the major positions
-
-(defun texinfo-update-menu-region-beginning (level)
-  "Locate beginning of higher level section this section is within.
-Return position of the beginning of the node line; do not move point.
-Thus, if this level is subsection, searches backwards for section node.
-Only argument is a string of the general type of section."
-  (let ((case-fold-search t))
-    ;; !! Known bug: if section immediately follows top node, this
-    ;; returns the beginning of the buffer as the beginning of the
-    ;; higher level section.
-    (cond
-     ((< level 3)
-      (save-excursion
-	(goto-char (point-min))
-	(re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)
-	(beginning-of-line)
-	(point)))
-     (t
-      (save-excursion
-	(re-search-backward
-	 (concat
-	  "\\(^@node\\).*\n"              ; match node line
-	  "\\(\\(\\(^@c\\).*\n\\)"        ; match comment line, if any
-	  "\\|"                           ; or
-	  "\\(^@ifinfo[ ]*\n\\)"          ; ifinfo line, if any
-	  "\\|"                           ; or
-	  "\\(^@ifnottex[ ]*\n\\)"        ; ifnottex line, if any
-          "\\)?"                          ; end of expression
-	  (eval
-	   (cdr (assoc level texinfo-update-menu-higher-regexps))))
-	 nil
-	 'goto-beginning)
-	(point))))))
-
-(defun texinfo-update-menu-region-end (level)
-  "Locate end of higher level section this section is within.
-Return position; do not move point.  Thus, if this level is a
-subsection, find the node for the section this subsection is within.
-If level is top or chapter, returns end of file.  Only argument is a
-string of the general type of section."
-  (let ((case-fold-search t))
-    (save-excursion
-      (if (re-search-forward
-	   (concat
-	    "\\(^@node\\).*\n"            ; match node line
-	    "\\(\\(\\(^@c\\).*\n\\)"      ; match comment line, if any
-	    "\\|"                         ; or
-            "\\(^@ifinfo[ ]*\n\\)"        ; ifinfo line, if any
-            "\\|"                         ; or
-            "\\(^@ifnottex[ ]*\n\\)"      ; ifnottex line, if any
-            "\\)?"                        ; end of expression
-	    (eval
-	     ;; Never finds end of level above chapter so goes to end.
-	     (cdr (assoc level texinfo-update-menu-higher-regexps))))
-	   nil
-	   'goto-end)
-	  (match-beginning 1)
-	(point-max)))))
-
-(defun texinfo-menu-first-node (beginning end)
-  "Locate first node of the section the menu will be placed in.
-Return position; do not move point.
-The menu will be located just before this position.
-
-First argument is the position of the beginning of the section in
-which the menu will be located; second argument is the position of the
-end of that region; it limits the search."
-
-  (save-excursion
-    (goto-char beginning)
-    (forward-line 1)
-    (re-search-forward "^@node" end t)
-    (beginning-of-line)
-    (point)))
-
-
-;;; Updating a node
-
-(defun texinfo-update-node (&optional beginning end)
-  "Without any prefix argument, update the node in which point is located.
-Interactively, a prefix argument means to operate on the region.
-
-The functions for creating or updating nodes and menus, and their
-keybindings, are:
-
-    texinfo-update-node (&optional beginning end)    \\[texinfo-update-node]
-    texinfo-every-node-update ()                \\[texinfo-every-node-update]
-    texinfo-sequential-node-update (&optional region-p)
-
-    texinfo-make-menu (&optional region-p)      \\[texinfo-make-menu]
-    texinfo-all-menus-update ()                 \\[texinfo-all-menus-update]
-    texinfo-master-menu ()
-
-    texinfo-indent-menu-description (column &optional region-p)
-
-The `texinfo-column-for-description' variable specifies the column to
-which menu descriptions are indented. Its default value is 32."
-
-  (interactive
-   (if prefix-arg
-       (list (point) (mark))))
-  (if (null beginning)
-      ;; Update a single node.
-      (let ((auto-fill-function nil))
-	(if (not (re-search-backward "^@node" (point-min) t))
-	    (error "Node line not found before this position"))
-	(texinfo-update-the-node)
-	(message "Done...updated the node.  You may save the buffer."))
-    ;; else
-    (let ((auto-fill-function nil))
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region beginning end)
-	  (goto-char (point-min))
-	  (while (re-search-forward "^@node" (point-max) t)
-	    (beginning-of-line)
-	    (texinfo-update-the-node))
-	  (goto-char (point-max))
-	  (message "Done...nodes updated in region.  You may save the buffer."))))))
-
-(defun texinfo-every-node-update ()
-  "Update every node in a Texinfo file."
-  (interactive)
-  (save-excursion
-    (texinfo-update-node (point-min) (point-max))
-    (message "Done...updated every node.  You may save the buffer.")))
-
-(defun texinfo-update-the-node ()
-  "Update one node.  Point must be at the beginning of node line.
-Leave point at the end of the node line."
-  (texinfo-check-for-node-name)
-  (texinfo-delete-existing-pointers)
-  (message "Updating node: %s ... " (texinfo-copy-node-name))
-  (save-restriction
-    (widen)
-    (let*
-	((case-fold-search t)
-	 (level (texinfo-hierarchic-level))
-	 (beginning (texinfo-update-menu-region-beginning level))
-	 (end (texinfo-update-menu-region-end level)))
-      (if (eq level 1)
-	  (texinfo-top-pointer-case)
-	;; else
-	(texinfo-insert-pointer beginning end level 'next)
-	(texinfo-insert-pointer beginning end level 'previous)
-	(texinfo-insert-pointer beginning end level 'up)
-	(texinfo-clean-up-node-line)))))
-
-(defun texinfo-top-pointer-case ()
-  "Insert pointers in the Top node.  This is a special case.
-
-The `Next' pointer is a pointer to a chapter or section at a lower
-hierarchical level in the file.  The `Previous' and `Up' pointers are
-to `(dir)'.  Point must be at the beginning of the node line, and is
-left at the end of the node line."
-
-  (texinfo-clean-up-node-line)
-  (insert ", "
-	  (save-excursion
-	    ;; There may be an @chapter or other such command between
-	    ;; the top node line and the next node line, as a title
-	    ;; for an `ifinfo' section. This @chapter command must
-	    ;; must be skipped.  So the procedure is to search for
-	    ;; the next `@node' line, and then copy its name.
-	    (if (re-search-forward "^@node" nil t)
-		(progn
-		  (beginning-of-line)
-		  (texinfo-copy-node-name))
-	      " "))
-	  ", (dir), (dir)"))
-
-(defun texinfo-check-for-node-name ()
-  "Determine whether the node has a node name.  Prompt for one if not.
-Point must be at beginning of node line.  Does not move point."
-  (save-excursion
-    (let ((initial (texinfo-copy-next-section-title)))
-      ;; This is not clean.  Use `interactive' to read the arg.
-      (forward-word 1)                    ; skip over node command
-      (skip-chars-forward " \t")          ; and over spaces
-      (if (not (looking-at "[^,\t\n ]+")) ; regexp based on what Info looks for
-					  ; alternatively, use "[a-zA-Z]+"
-	(let ((node-name
-	       (read-from-minibuffer
-		"Node name (use no @, commas, colons, or apostrophes): "
-		initial)))
-	  (insert " " node-name))))))
-
-(defun texinfo-delete-existing-pointers ()
-  "Delete `Next', `Previous', and `Up' pointers.
-Starts from the current position of the cursor, and searches forward
-on the line for a comma and if one is found, deletes the rest of the
-line, including the comma.  Leaves point at beginning of line."
-  (let ((eol-point (save-excursion (end-of-line) (point))))
-    (if (search-forward "," eol-point t)
-	(delete-region (1- (point)) eol-point)))
-  (beginning-of-line))
-
-(defun texinfo-find-pointer (beginning end level direction)
-  "Move point to section associated with next, previous, or up pointer.
-Return type of pointer (either `normal' or `no-pointer').
-
-The first and second arguments bound the search for a pointer to the
-beginning and end, respectively, of the enclosing higher level
-section.  The third argument is a string specifying the general kind
-of section such as \"chapter\" or \"section\".  When looking for the
-`Next' pointer, the section found will be at the same hierarchical
-level in the Texinfo file; when looking for the `Previous' pointer,
-the section found will be at the same or higher hierarchical level in
-the Texinfo file; when looking for the `Up' pointer, the section found
-will be at some level higher in the Texinfo file.  The fourth argument
-\(one of 'next, 'previous, or 'up\) specifies whether to find the
-`Next', `Previous', or `Up' pointer."
-  (let ((case-fold-search t))
-    (cond ((eq direction 'next)
-	   (forward-line 3)             ; skip over current node
-	   ;; Search for section commands accompanied by node lines;
-	   ;; ignore section commands in the middle of nodes.
-	   (if (re-search-forward
-                ;; A `Top' node is never a next pointer, so won't find it.
-		(concat
-		 ;; Match node line.
-		 "\\(^@node\\).*\n"
-		 ;; Match comment, ifinfo, ifnottex line, if any
-		 (concat
-                  "\\(\\("
-                  "\\(^@c\\).*\n\\)"
-                  "\\|"
-                  "\\(^@ifinfo[ ]*\n\\)"
-                  "\\|"
-                  "\\(^@ifnottex[ ]*\n\\)"
-                  "\\)?")
-		 (eval
-		  (cdr (assoc level texinfo-update-menu-same-level-regexps))))
-		end
-		t)
-	       'normal
-	     'no-pointer))
-	  ((eq direction 'previous)
-	   (if (re-search-backward
-		(concat
-		 "\\("
-		 ;; Match node line.
-		 "\\(^@node\\).*\n"
-		 ;; Match comment, ifinfo, ifnottex line, if any
-		 (concat
-                  "\\(\\("
-                  "\\(^@c\\).*\n\\)"
-                  "\\|"
-                  "\\(^@ifinfo[ ]*\n\\)"
-                  "\\|"
-                  "\\(^@ifnottex[ ]*\n\\)"
-                  "\\)?")
-		 (eval
-		  (cdr (assoc level texinfo-update-menu-same-level-regexps)))
-		 "\\|"
-		 ;; Match node line.
-		 "\\(^@node\\).*\n"
-		 ;; Match comment, ifinfo, ifnottex line, if any
-		 (concat
-                  "\\(\\("
-                  "\\(^@c\\).*\n\\)"
-                  "\\|"
-                  "\\(^@ifinfo[ ]*\n\\)"
-                  "\\|"
-                  "\\(^@ifnottex[ ]*\n\\)"
-                  "\\)?")
-		 (eval
-		  (cdr (assoc level texinfo-update-menu-higher-regexps)))
-		 "\\|"
-		 ;; Handle `Top' node specially.
-		 "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
-		 "\\)")
-		beginning
-		t)
-	       'normal
-	     'no-pointer))
-	  ((eq direction 'up)
-	   (if (re-search-backward
-		(concat
-		 "\\("
-		 ;; Match node line.
-		 "\\(^@node\\).*\n"
-		 ;; Match comment, ifinfo, ifnottex line, if any
-		 (concat
-                  "\\(\\("
-                  "\\(^@c\\).*\n\\)"
-                  "\\|"
-                  "\\(^@ifinfo[ ]*\n\\)"
-                  "\\|"
-                  "\\(^@ifnottex[ ]*\n\\)"
-                  "\\)?")
-		 (eval (cdr (assoc level texinfo-update-menu-higher-regexps)))
-		 "\\|"
-		 ;; Handle `Top' node specially.
-		 "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
-		 "\\)")
-		(save-excursion
-		  (goto-char beginning)
-		  (beginning-of-line)
-		  (point))
-		t)
-	       'normal
-	     'no-pointer))
-	  (t
-	   (error "texinfo-find-pointer: lack proper arguments")))))
-
-(defun texinfo-pointer-name (kind)
-  "Return the node name preceding the section command.
-The argument is the kind of section, either `normal' or `no-pointer'."
-  (let (name)
-    (cond ((eq kind 'normal)
-	   (end-of-line)                ; this handles prev node top case
-	   (re-search-backward          ; when point is already
-	    "^@node"                    ; at the beginning of @node line
-	    (save-excursion (forward-line -3))
-	    t)
-	   (setq name (texinfo-copy-node-name)))
-	  ((eq kind 'no-pointer)
-	   ;; Don't need to put a blank in the pointer slot,
-	   ;; since insert "' " always has a space
-	   (setq name " ")))	; put a blank in the pointer slot
-    name))
-
-(defun texinfo-insert-pointer (beginning end level direction)
-  "Insert the `Next', `Previous' or `Up' node name at point.
-Move point forward.
-
-The first and second arguments bound the search for a pointer to the
-beginning and end, respectively, of the enclosing higher level
-section.  The third argument is the hierarchical level of the Texinfo
-file, a string such as \"section\".  The fourth argument is direction
-towards which the pointer is directed, one of `next', `previous', or `up'."
-
-  (end-of-line)
-  (insert
-   ", "
-   (save-excursion
-     (texinfo-pointer-name
-      (texinfo-find-pointer beginning end level direction)))))
-
-(defun texinfo-clean-up-node-line ()
-  "Remove extra commas, if any, at end of node line."
-  (end-of-line)
-  (skip-chars-backward ", ")
-  (delete-region (point) (save-excursion (end-of-line) (point))))
-
-
-;;; Updating nodes sequentially
-;; These sequential update functions insert `Next' or `Previous'
-;; pointers that point to the following or preceding nodes even if they
-;; are at higher or lower hierarchical levels.  This means that if a
-;; section contains one or more subsections, the section's `Next'
-;; pointer will point to the subsection and not the following section.
-;; (The subsection to which `Next' points will most likely be the first
-;; item on the section's menu.)
-
-(defun texinfo-sequential-node-update (&optional region-p)
-  "Update one node (or many) in a Texinfo file with sequential pointers.
-
-This function causes the `Next' or `Previous' pointer to point to the
-immediately preceding or following node, even if it is at a higher or
-lower hierarchical level in the document.  Continually pressing `n' or
-`p' takes you straight through the file.
-
-Without any prefix argument, update the node in which point is located.
-Non-nil argument (prefix, if interactive) means update the nodes in the
-marked region.
-
-This command makes it awkward to navigate among sections and
-subsections; it should be used only for those documents that are meant
-to be read like a novel rather than a reference, and for which the
-Info `g*' command is inadequate."
-
-  (interactive "P")
-  (if (not region-p)
-      ;; update a single node
-      (let ((auto-fill-function nil))
-	(if (not (re-search-backward "^@node" (point-min) t))
-	    (error "Node line not found before this position"))
-	(texinfo-sequentially-update-the-node)
-	(message
-	 "Done...sequentially updated the node .  You may save the buffer."))
-    ;; else
-    (let ((auto-fill-function nil)
-	  (beginning (region-beginning))
-	  (end (region-end)))
-      (if (= end beginning)
-	  (error "Please mark a region"))
-      (save-restriction
-	(narrow-to-region beginning end)
-	(goto-char beginning)
-	(push-mark (point) t)
-	(while (re-search-forward "^@node" (point-max) t)
-	  (beginning-of-line)
-	  (texinfo-sequentially-update-the-node))
-	(message
-	 "Done...updated the nodes in sequence.  You may save the buffer.")))))
-
-(defun texinfo-sequentially-update-the-node ()
-  "Update one node such that the pointers are sequential.
-A `Next' or `Previous' pointer points to any preceding or following node,
-regardless of its hierarchical level."
-
-  (texinfo-check-for-node-name)
-  (texinfo-delete-existing-pointers)
-  (message
-   "Sequentially updating node: %s ... " (texinfo-copy-node-name))
-  (save-restriction
-    (widen)
-    (let* ((case-fold-search t)
-	   (level (texinfo-hierarchic-level)))
-      (if (eq level 1)
-	  (texinfo-top-pointer-case)
-	;; else
-	(texinfo-sequentially-insert-pointer level 'next)
-	(texinfo-sequentially-insert-pointer level 'previous)
-	(texinfo-sequentially-insert-pointer level 'up)
-	(texinfo-clean-up-node-line)))))
-
-(defun texinfo-sequentially-insert-pointer (level direction)
-  "Insert the `Next', `Previous' or `Up' node name at point.
-Move point forward.
-
-The first argument is the hierarchical level of the Texinfo file, a
-string such as \"section\".  The second argument is direction, one of
-`next', `previous', or `up'."
-
-  (end-of-line)
-  (insert
-   ", "
-   (save-excursion
-     (texinfo-pointer-name
-      (texinfo-sequentially-find-pointer level direction)))))
-
-(defun texinfo-sequentially-find-pointer (level direction)
-  "Find next or previous pointer sequentially in Texinfo file, or up pointer.
-Move point to section associated with the pointer.  Find point even if
-it is in a different section.
-
-Return type of pointer (either `normal' or `no-pointer').
-
-The first argument is a string specifying the general kind of section
-such as \"chapter\" or \"section\".  The section found will be at the
-same hierarchical level in the Texinfo file, or, in the case of the up
-pointer, some level higher.  The second argument (one of `next',
-`previous', or `up') specifies whether to find the `Next', `Previous',
-or `Up' pointer."
-  (let ((case-fold-search t))
-    (cond ((eq direction 'next)
-	   (forward-line 3)             ; skip over current node
-	   (if (re-search-forward
-		texinfo-section-types-regexp
-		(point-max)
-		t)
-	       'normal
-	     'no-pointer))
-	  ((eq direction 'previous)
-	   (if (re-search-backward
-		texinfo-section-types-regexp
-		(point-min)
-		t)
-	       'normal
-	     'no-pointer))
-	  ((eq direction 'up)
-	   (if (re-search-backward
-		(eval (cdr (assoc level texinfo-update-menu-higher-regexps)))
-		(point-min)
-		t)
-	       'normal
-	     'no-pointer))
-	  (t
-	   (error "texinfo-sequential-find-pointer: lack proper arguments")))))
-
-
-;;; Inserting `@node' lines
-;; The `texinfo-insert-node-lines' function inserts `@node' lines as needed
-;; before the `@chapter', `@section', and such like lines of a region
-;; in a Texinfo file.
-
-(defun texinfo-insert-node-lines (beginning end &optional title-p)
-  "Insert missing `@node' lines in region of Texinfo file.
-Non-nil argument (prefix, if interactive) means also to insert the
-section titles as node names; and also to insert the section titles as
-node names in pre-existing `@node' lines that lack names."
-  (interactive "r\nP")
-
-  ;; Use marker; after inserting node lines, leave point at end of
-  ;; region and mark at beginning.
-
-  (let (beginning-marker end-marker title last-section-position)
-
-    ;; Save current position on mark ring and set mark to end.
-    (push-mark end t)
-    (setq end-marker (mark-marker))
-
-    (goto-char beginning)
-    (while (re-search-forward
-	    texinfo-section-types-regexp
-	    end-marker
-	    'end)
-      ;; Copy title if desired.
-      (if title-p
-	  (progn
-	    (beginning-of-line)
-	    (forward-word 1)
-	    (skip-chars-forward " \t")
-	    (setq title (buffer-substring
-			 (point)
-			 (save-excursion (end-of-line) (point))))))
-      ;; Insert node line if necessary.
-      (if (re-search-backward
-	   "^@node"
-	   ;; Avoid finding previous node line if node lines are close.
-	   (or last-section-position
-	       (save-excursion (forward-line -2) (point))) t)
-	  ;;  @node is present, and point at beginning of that line
-	  (forward-word 1)          ; Leave point just after @node.
-	;; Else @node missing; insert one.
-	(beginning-of-line)         ; Beginning of `@section' line.
-	(insert "@node\n")
-	(backward-char 1))          ; Leave point just after `@node'.
-      ;; Insert title if desired.
-      (if title-p
-	  (progn
-	    (skip-chars-forward " \t")
-	    ;; Use regexp based on what info looks for
-	    ;; (alternatively, use "[a-zA-Z]+");
-	    ;; this means we only insert a title if none exists.
-	    (if (not (looking-at "[^,\t\n ]+"))
-		(progn
-		  (beginning-of-line)
-		  (forward-word 1)
-		  (insert " " title)
-		  (message "Inserted title %s ... " title)))))
-      ;; Go forward beyond current section title.
-      (re-search-forward texinfo-section-types-regexp
-			 (save-excursion (forward-line 3) (point)) t)
-      (setq last-section-position (point))
-      (forward-line 1))
-
-    ;; Leave point at end of region, mark at beginning.
-    (set-mark beginning)
-
-    (if title-p
-      (message
-       "Done inserting node lines and titles.  You may save the buffer.")
-    (message "Done inserting node lines.  You may save the buffer."))))
-
-
-;;; Update and create menus for multi-file Texinfo sources
-
-;;  1. M-x texinfo-multiple-files-update
-;;
-;;     Read the include file list of an outer Texinfo file and
-;;     update all highest level nodes in the files listed and insert a
-;;     main menu in the outer file after its top node.
-
-;;  2. C-u M-x texinfo-multiple-files-update
-;;
-;;     Same as 1, but insert a master menu.  (Saves reupdating lower
-;;     level menus and nodes.)  This command simply reads every menu,
-;;     so if the menus are wrong, the master menu will be wrong.
-;;     Similarly, if the lower level node pointers are wrong, they
-;;     will stay wrong.
-
-;;  3. C-u 2 M-x texinfo-multiple-files-update
-;;
-;;     Read the include file list of an outer Texinfo file and
-;;     update all nodes and menus in the files listed and insert a
-;;     master menu in the outer file after its top node.
-
-;;; Note: these functions:
-;;;
-;;;   * Do not save or delete any buffers.  You may fill up your memory.
-;;;   * Do not handle any pre-existing nodes in outer file.
-;;;     Hence, you may need a file for indices.
-
-
-;;; Auxiliary functions for multiple file updating
-
-(defun texinfo-multi-file-included-list (outer-file)
-  "Return a list of the included files in OUTER-FILE."
-  (let ((included-file-list (list outer-file))
-	start)
-    (save-excursion
-      (set-buffer (find-file-noselect outer-file))
-      (widen)
-      (goto-char (point-min))
-      (while (re-search-forward "^@include" nil t)
-	(skip-chars-forward " \t")
-	(setq start (point))
-	(end-of-line)
-	(skip-chars-backward " \t")
-	(setq included-file-list
-	      (cons (buffer-substring start (point))
-		    included-file-list)))
-      (nreverse included-file-list))))
-
-(defun texinfo-copy-next-section-title ()
-  "Return the name of the immediately following section as a string.
-
-Start with point at the beginning of the node line.  Leave point at the
-same place.  If there is no title, returns an empty string."
-
-  (save-excursion
-    (end-of-line)
-    (let ((node-end (or
-			(save-excursion
-			  (if (re-search-forward "\\(^@node\\)" nil t)
-			      (match-beginning 0)))
-			(point-max))))
-      (if (re-search-forward texinfo-section-types-regexp node-end t)
-	  (progn
-	    (beginning-of-line)
-	    ;; copy title
-	    (let ((title
-		   (buffer-substring
-		    (progn (forward-word 1)           ; skip over section type
-			   (skip-chars-forward " \t") ; and over spaces
-			   (point))
-		    (progn (end-of-line) (point)))))
-	      title))
-	""))))
-
-(defun texinfo-multi-file-update (files &optional update-everything)
-  "Update first node pointers in each file in FILES.
-Return a list of the node names.
-
-The first file in the list is an outer file; the remaining are
-files included in the outer file with `@include' commands.
-
-If optional arg UPDATE-EVERYTHING non-nil, update every menu and
-pointer in each of the included files.
-
-Also update the `Top' level node pointers of the outer file.
-
-Requirements:
-
-  * the first file in the FILES list must be the outer file,
-  * each of the included files must contain exactly one highest
-    hierarchical level node,
-  * this node must be the first node in the included file,
-  * each highest hierarchical level node must be of the same type.
-
-Thus, normally, each included file contains one, and only one, chapter."
-
-;; The menu-list has the form:
-;;
-;;     \(\(\"node-name1\" . \"title1\"\)
-;;       \(\"node-name2\" . \"title2\"\) ... \)
-;;
-;; However, there does not need to be a title field and this function
-;; does not fill it; however a comment tells you how to do so.
-;; You would use the title field if you wanted to insert titles in the
-;; description slot of a menu as a description.
-
-  (let ((case-fold-search t)
-	menu-list next-node-name previous-node-name)
-
-    ;; Find the name of the first node of the first included file.
-    (set-buffer (find-file-noselect (car (cdr files))))
-    (widen)
-    (goto-char (point-min))
-    (if (not (re-search-forward "^@node" nil t))
-	(error "No `@node' line found in %s" (buffer-name)))
-    (beginning-of-line)
-    (texinfo-check-for-node-name)
-    (setq next-node-name (texinfo-copy-node-name))
-
-    (push (cons next-node-name (prog1 "" (forward-line 1)))
-	  ;; Use following to insert section titles automatically.
-	  ;; (texinfo-copy-next-section-title)
-	  menu-list)
-
-    ;; Go to outer file
-    (set-buffer (find-file-noselect (pop files)))
-    (goto-char (point-min))
-    (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t))
-	(error "This buffer needs a Top node"))
-    (beginning-of-line)
-    (texinfo-delete-existing-pointers)
-    (end-of-line)
-    (insert ", " next-node-name ", (dir), (dir)")
-    (beginning-of-line)
-    (setq previous-node-name "Top")
-
-    (while files
-
-      (if (not (cdr files))
-	  ;; No next file
-	  (setq next-node-name "")
-	;; Else,
-	;; find the name of the first node in the next file.
-	(set-buffer (find-file-noselect (car (cdr files))))
-	(widen)
-	(goto-char (point-min))
-	(if (not (re-search-forward "^@node" nil t))
-	    (error "No `@node' line found in %s" (buffer-name)))
-	(beginning-of-line)
-	(texinfo-check-for-node-name)
-	(setq next-node-name (texinfo-copy-node-name))
-	(push (cons next-node-name (prog1 "" (forward-line 1)))
-	      ;; Use following to insert section titles automatically.
-	      ;; (texinfo-copy-next-section-title)
-	      menu-list))
-
-      ;; Go to node to be updated.
-      (set-buffer (find-file-noselect (car files)))
-      (goto-char (point-min))
-      (if (not (re-search-forward "^@node" nil t))
-	  (error "No `@node' line found in %s" (buffer-name)))
-      (beginning-of-line)
-
-      ;; Update other menus and nodes if requested.
-      (if update-everything (texinfo-all-menus-update t))
-
-      (beginning-of-line)
-      (texinfo-delete-existing-pointers)
-      (end-of-line)
-      (insert ", " next-node-name ", " previous-node-name ", Top")
-
-      (beginning-of-line)
-      (setq previous-node-name (texinfo-copy-node-name))
-
-      (setq files (cdr files)))
-    (nreverse menu-list)))
-
-(defun texinfo-multi-files-insert-main-menu (menu-list)
-  "Insert formatted main menu at point.
-Indents the first line of the description, if any, to the value of
-`texinfo-column-for-description'."
-
-  (insert "@menu\n")
-  (dolist (entry menu-list)
-    ;; Every menu entry starts with a star and a space.
-    (insert "* ")
-
-    ;; Insert the node name (and menu entry name, if present).
-    (let ((node-part (car entry)))
-      (if (stringp node-part)
-	  ;; "Double colon" entry line; menu entry and node name are the same,
-	  (insert (format "%s::" node-part))
-	;; "Single colon" entry line; menu entry and node name are different.
-	(insert (format "%s: %s." (car node-part) (cdr node-part)))))
-
-    ;; Insert the description, if present.
-    (when (cdr entry)
-      ;; Move to right place.
-      (indent-to texinfo-column-for-description 2)
-      ;; Insert description.
-      (insert (format "%s" (cdr entry))))
-
-    (insert "\n")) ; end this menu entry
-  (insert "@end menu"))
-
-(defun texinfo-multi-file-master-menu-list (files-list)
-  "Return master menu list from files in FILES-LIST.
-Menu entries in each file collected using `texinfo-master-menu-list'.
-
-The first file in FILES-LIST must be the outer file; the others must
-be the files included within it.  A main menu must already exist."
-  (save-excursion
-    (let (master-menu-list)
-      (dolist (file files-list)
-	(set-buffer (find-file-noselect file))
-	(message "Working on: %s " (current-buffer))
-	(goto-char (point-min))
-	(setq master-menu-list
-	      (append master-menu-list (texinfo-master-menu-list))))
-      master-menu-list)))
-
-
-;;; The multiple-file update function
-
-(defun texinfo-multiple-files-update
-  (outer-file &optional update-everything make-master-menu)
-  "Update first node pointers in each file included in OUTER-FILE;
-create or update the `Top' level node pointers and the main menu in
-the outer file that refers to such nodes.  This does not create or
-update menus or pointers within the included files.
-
-With optional MAKE-MASTER-MENU argument (prefix arg, if interactive),
-insert a master menu in OUTER-FILE in addition to creating or updating
-pointers in the first @node line in each included file and creating or
-updating the `Top' level node pointers of the outer file.  This does
-not create or update other menus and pointers within the included
-files.
-
-With optional UPDATE-EVERYTHING argument (numeric prefix arg, if
-interactive), update all the menus and all the `Next', `Previous', and
-`Up' pointers of all the files included in OUTER-FILE before inserting
-a master menu in OUTER-FILE.  Also, update the `Top' level node
-pointers of OUTER-FILE.
-
-Notes:
-
-  * this command does NOT save any files--you must save the
-    outer file and any modified, included files.
-
-  * except for the `Top' node, this command does NOT handle any
-    pre-existing nodes in the outer file; hence, indices must be
-    enclosed in an included file.
-
-Requirements:
-
-  * each of the included files must contain exactly one highest
-    hierarchical level node,
-  * this highest node must be the first node in the included file,
-  * each highest hierarchical level node must be of the same type.
-
-Thus, normally, each included file contains one, and only one,
-chapter."
-
-  (interactive (cons
-		(read-string
-		 "Name of outer `include' file: "
-		 (buffer-file-name))
-		(cond
-		 ((not current-prefix-arg)	'(nil nil))
-		 ((listp current-prefix-arg)	'(t nil)) ; make-master-menu
-		 ((numberp current-prefix-arg)	'(t t))))) ; update-everything
-
-  (let* ((included-file-list (texinfo-multi-file-included-list outer-file))
-	 (files included-file-list)
-	 next-node-name
-	 previous-node-name
-	 ;; Update the pointers and collect the names of the nodes and titles
-	 (main-menu-list (texinfo-multi-file-update files update-everything)))
-
-    ;; Insert main menu
-
-    ;; Go to outer file
-    (set-buffer (find-file-noselect (car included-file-list)))
-    (if (texinfo-old-menu-p
-	 (point-min)
-	 (save-excursion
-	   (re-search-forward "^@include")
-	   (beginning-of-line)
-	   (point)))
-
-	;; If found, leave point after word `menu' on the `@menu' line.
-	(progn
-	  (texinfo-incorporate-descriptions main-menu-list)
-	  ;; Delete existing menu.
-	  (beginning-of-line)
-	  (delete-region
-	   (point)
-	   (save-excursion (re-search-forward "^@end menu") (point)))
-	  ;; Insert main menu
-	  (texinfo-multi-files-insert-main-menu main-menu-list))
-
-      ;; Else no current menu; insert it before `@include'
-      (texinfo-multi-files-insert-main-menu main-menu-list))
-
-    ;; Insert master menu
-
-    (if make-master-menu
-	(progn
-	  ;; First, removing detailed part of any pre-existing master menu
-	  (goto-char (point-min))
-	  (if (search-forward texinfo-master-menu-header nil t)
-	      (progn
-		(goto-char (match-beginning 0))
-		;; Check if @detailmenu kludge is used;
-		;; if so, leave point before @detailmenu.
-		(search-backward "\n@detailmenu"
-				 (save-excursion (forward-line -3) (point))
-				 t)
-		;; Remove detailed master menu listing
-		(let ((end-of-detailed-menu-descriptions
-		       (save-excursion	; beginning of end menu line
-			 (goto-char (texinfo-menu-end))
-			 (beginning-of-line) (forward-char -1)
-			 (point))))
-		  (delete-region (point) end-of-detailed-menu-descriptions))))
-
-	  ;; Create a master menu and insert it
-	  (texinfo-insert-master-menu-list
-	   (texinfo-multi-file-master-menu-list
-	    included-file-list)))))
-
-  ;; Remove unwanted extra lines.
-  (save-excursion
-    (goto-char (point-min))
-
-    (re-search-forward "^@menu")
-    (forward-line -1)
-    (insert  "\n")			; Ensure at least one blank line.
-    (delete-blank-lines)
-
-    (re-search-forward "^@end menu")
-    (forward-line 1)
-    (insert  "\n")			; Ensure at least one blank line.
-    (delete-blank-lines))
-
-  (message "Multiple files updated."))
-
-
-;; Place `provide' at end of file.
-(provide 'texnfo-upd)
-
-;;; texnfo-upd.el ends here
diff --git a/xemacs-packages/lisp/text-modes/ChangeLog b/xemacs-packages/lisp/text-modes/ChangeLog
deleted file mode 100644
index 28b3baaa..00000000
--- a/xemacs-packages/lisp/text-modes/ChangeLog
+++ /dev/null
@@ -1,947 +0,0 @@
-2005-11-02  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.90 released.
-
-	* htmlize.el: Sync with upstream version 1.28.
-
-2005-09-21  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.89 released.
-
-2005-09-14  Jari Aalto  <jari aalto A T cante net>
-
-	* folding.el 
-	(top level): Updated Copyright years and its information.
-	(folding-package-url-location): Updated URL
-	to point to XEmacs CVS server.
-
-2005-05-10  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.88 released.
-
-2005-04-04  Robert Widhopf  <hack@robf.de>
-
-	* hexl.el: Adds as-you-type hex-input, i.e. when in the ASCII
-	columns you will enter in ASCII and when in the HEX columns you
-	will enter hex.  You may easily switch between the two columns
-	by TAB.
-
-2005-04-17  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.87 released.
-
-2005-04-16  Adrian Aichner  <adrian@xemacs.org>
-
-	* Makefile (ELCS): Add whitespace-visual-mode.elc.
-
-2005-04-16  Zajcev Evgeny <zevlg@yandex.ru>
-
-	* tpum.el: Initial import of tpum.
-
-2005-04-13  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.86 released.
-
-2005-04-13  Steve Youngs  <steve@sxemacs.org>
-
-	* flyspell.el (flyspell-check-word-p): Test for XEmacs with
-	(featurep 'xemacs) instead of (fboundp 'about-xemacs).
-
-2005-03-26  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.85 released.
-
-2005-03-25  Aidan Kehoe  <kehoea@parhasard.net>
-
-	* whitespace.el (whitespace-cleanup): Integrate this change from
-	the FSF:
-
-	2003-06-10  Rajesh Vaidheeswarran  <rv@gnu.org>
-
-		* whitespace.el (whitespace-cleanup): Respect user
-		preference for silence.
-
-2005-02-14  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.84 released.
-
-	* whitespace-visual-mode.el: New mode, successor to
-	old-whitespace-mode.  Includes some bug fixes.
-
-2005-02-10  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.83 released.
-
-2005-02-10  Mike FABIAN <mfabian@suse.de>
-
-	* whitespace.el (whitespace-global-mode): Autoload a dummy autoload
-	instead of `define-minor-mode'.
-
-2005-01-13  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.82 released.
-
-2005-01-09  Steve Youngs  <steve@sxemacs.org>
-
-	* crontab.el (crontab-delete-blank-lines): New.  To make deleting
-	blank lines in crontab files optional.
-	(crontab-save): Use it.
-
-2004-11-26  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.81 released.
-
-2004-11-25  Jari Aalto <jari aalto A T cante dot net>
-
-	* folding.el: non-ascii character removed from bibtex-mode.
-	Changed bib-mode '@comment' => '%'. Closes Debian
-	Bug#282388
-
-2004-11-08  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.80 released.
-
-2004-11-07  Ben Wing  <ben@xemacs.org>
-
-	* Makefile (ELCS):
-	* whitespace.el: New.
-	Import whitespace.el from FSF 21.3.  Same idea as existing
-	whitespace-mode but does more: Corrects problems as well as just
-	highlighting them.
-
-	* whitespace-mode.el:
-	* whitespace-mode.el (whitespace): Removed.
-	* whitespace-mode.el (old-whitespace): New.
-	* whitespace-mode.el (whitespace-mode): Removed.
-	* whitespace-mode.el (old-whitespace-mode): New.
-	* whitespace-mode.el (whitespace-mode-line-string): Removed.
-	* whitespace-mode.el (old-whitespace-mode-line-string): New.
-	* whitespace-mode.el (whitespace-incremental-mode-line-string): Removed.
-	* whitespace-mode.el (old-whitespace-incremental-mode-line-string): New.
-	* whitespace-mode.el (whitespace-chars): Removed.
-	* whitespace-mode.el (old-whitespace-chars): New.
-	* whitespace-mode.el (whitespace-mode-hook): Removed.
-	* whitespace-mode.el (old-whitespace-mode-hook): New.
-	* whitespace-mode.el (whitespace-incremental-mode-hook): Removed.
-	* whitespace-mode.el (old-whitespace-incremental-mode-hook): New.
-	* whitespace-mode.el (whitespace-install-toolbar-icon): Removed.
-	* whitespace-mode.el (old-whitespace-install-toolbar-icon): New.
-	* whitespace-mode.el (whitespace-install-submenu): Removed.
-	* whitespace-mode.el (old-whitespace-install-submenu): New.
-	* whitespace-mode.el (whitespace-toolbar-function): Removed.
-	* whitespace-mode.el (old-whitespace-toolbar-function): New.
-	* whitespace-mode.el (whitespace-blank-and-tab-search-string): Removed.
-	* whitespace-mode.el (old-whitespace-blank-and-tab-search-string): New.
-	* whitespace-mode.el (whitespace-tab-search-string): Removed.
-	* whitespace-mode.el (old-whitespace-tab-search-string): New.
-	* whitespace-mode.el (whitespace-blank-search-string): Removed.
-	* whitespace-mode.el (old-whitespace-blank-search-string): New.
-	* whitespace-mode.el (whitespace-blank-face): Removed.
-	* whitespace-mode.el (old-whitespace-blank-face): New.
-	* whitespace-mode.el (whitespace-tab-face): Removed.
-	* whitespace-mode.el (old-whitespace-tab-face): New.
-	* whitespace-mode.el (whitespace-highlight-chars-in-region): Removed.
-	* whitespace-mode.el (old-whitespace-highlight-chars-in-region): New.
-	* whitespace-mode.el (whitespace-show-faces): Removed.
-	* whitespace-mode.el (old-whitespace-show-faces): New.
-	* whitespace-mode.el (whitespace-highlight-region): Removed.
-	* whitespace-mode.el (old-whitespace-highlight-region): New.
-	* whitespace-mode.el (whitespace-highlight-buffer): Removed.
-	* whitespace-mode.el (old-whitespace-highlight-buffer): New.
-	* whitespace-mode.el (whitespace-find-next-highlighted-region): Removed.
-	* whitespace-mode.el (old-whitespace-find-next-highlighted-region): New.
-	* whitespace-mode.el (whitespace-incremental-highlight): Removed.
-	* whitespace-mode.el (old-whitespace-incremental-highlight): New.
-	* whitespace-mode.el (whitespace-highlight-window): Removed.
-	* whitespace-mode.el (old-whitespace-highlight-window): New.
-	* whitespace-mode.el (whitespace-dehighlight-region): Removed.
-	* whitespace-mode.el (old-whitespace-dehighlight-region): New.
-	* whitespace-mode.el (whitespace-dehighlight-buffer): Removed.
-	* whitespace-mode.el (old-whitespace-dehighlight-buffer): New.
-	* whitespace-mode.el (whitespace-highlight-after-change-function): Removed.
-	* whitespace-mode.el (old-whitespace-highlight-after-change-function): New.
-	* whitespace-mode.el (whitespace-incremental-mode): Removed.
-	* whitespace-mode.el (old-whitespace-incremental-mode): New.
-	* whitespace-mode.el (fboundp):
-	* whitespace-mode.el (and):
-	* whitespace-mode.el (whitespace-set-whitespace-chars): Removed.
-	* whitespace-mode.el (old-whitespace-set-whitespace-chars): New.
-	* whitespace-mode.el (whitespace-menu): Removed.
-	* whitespace-mode.el (old-whitespace-menu): New.
-	whitespace->old-whitespace to avoid massive name clashes.
-
-2004-09-13  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.79 released.
-
-2004-09-10  Jari Aalto <jari aalto A T poboxes dot com>
-
-	* folding.el
-	(whole file): Extra empty newlines removed.
-	Protected all email addresses by removing AT-signs.
-	(Version): Changed version scheme to date based YYYY.MMDD, because
-	it is independent of upstream's version control software.
-	The old upstream version number was 2.117.
-	(Copyright): Removed unnecessary 'all rights reserved'.
-	The code is GPL.
-	(folding-fold-region): auctex:latex-mode's
-	`indent-according-to-mode' causes bottom fold to indent 50
-	characters forward. Added check to prevent that. Bug reported
-	by Uwe Brauer; oub A T mat dot ucm dot es.
-	(folding-check-folded): Added check for \r character, which
-	signifies collapsed folds. This fixes bug (C-x s) where buffer's folds
-	were forced to closed state if folding mode was active in some other
- 	buffer. Function `folding-mode-write-file' did that, but the
-	impulse came from `folding-check-folded'.
-
-2004-05-19  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.78 released.
-
-2004-04-18  Ville Skyttä  <scop@xemacs.org>
-
-	* desktop-entry-mode.el: GNU Emacs font-lock compatiblity tuning.
-
-2004-04-05  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.77 released.
-
-	* Makefile (VERSION): XEmacs package 1.76 released.
-
-2004-04-01  Jari Aalto <jari aalto A T poboxes dot com>
-
-	-- Use spam protective addresses
-	-- 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.
-
-2004-04-05  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.75 released.
-
-2004-04-01  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.74 released.
-
-2004-01-05  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.73 released.
-
-2004-01-04  Ville Skyttä  <scop@xemacs.org>
-
-	* desktop-entry-mode.el: Version 0.93, adding imenu support,
-	better support for X-* keys and group headers, keywords reserved
-	for use with KDE and miscellaneous cosmetic changes.
-
-2003-12-31  Ville Skyttä  <scop@xemacs.org>
-
-	* po-compat.el: Sync with gettext 0.13.1, po-mode.el already in sync.
-
-	* po-mode.el: Don't autoload auto-mode-alist association until
-	`po-mode' is autoloaded as well.
-
-2003-11-18  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.72 released.
-
-	* htmlize.el: Sync with upstream version 1.16.
-
-2003-11-13  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.71 released.
-
-2003-11-12  Adrian Aichner  <adrian@xemacs.org>
-
-	* folding.el: Typo fixes for docstrings and comments.
-
-2003-10-29  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.70 released.
-
-2003-10-19  Ville Skyttä  <scop@xemacs.org>
-
-	* desktop-entry-mode.el (desktop-entry-keywords):
-	Change according to new, synced regexp-opt interface.
-	(desktop-entry-mode-version): 0.92.
-
-2003-10-19  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.69 released.
-
-	* htmlize.el: Sync with upstream version 1.12.
-
-2003-10-16  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.68 released.
-
-	* htmlize.el: Sync with upstream version 1.4.
-
-2003-10-15  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.67 released.
-
-	* htmlize.el: Sync with upstream.
-
-2003-10-09  Ville Skyttä  <scop@xemacs.org>
-
-	* apache-mode.el (apache-font-lock-keywords):
-	Reorganize mod_perl keywords, add mod_perl 2 keywords.
-
-2003-10-13  Ville Skyttä  <scop@xemacs.org>
-
-	* desktop-entry-mode.el (desktop-entry-font-lock-keywords):
-	Highlight comments, fix keyword highlight.
-
-2003-10-01  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.66 released.
-
-2003-09-30  Ville Skyttä  <scop@xemacs.org>
-
-	* desktop-entry-mode.el: New.
-
-2003-09-30  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.65 released.
-
-2003-08-31  Ville Skyttä  <scop@xemacs.org>
-
-	* apache-mode.el (apache-font-lock-keywords):
-	Add handlers of various core modules.
-
-2003-09-15  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.64 released.
-
-2003-09-14  Jari Aalto  <jari aalto A T poboxes dot com>
-
-	* other/folding.el
-	(DOCUMENTATION): Added 'Uninstall' and 'To read the manual'
-	sections.
-	(folding-install): 2.109 Removed 'folding installed' message.
-	(folding-install): 2.109 Removed 'folding uninstalled' message.
-	(folding-add-to-marks-list): 2.109 Added support to `php-mode'.
-	(folding-add-to-marks-list): 2.109 Added support to
-	`change-log-mode'.
-	(folding-add-to-marks-list): 2.109 Added support to
-	`finder-mode'
-	(folding-add-to-marks-list): 2.109 Added support to
-	`javascript-mode'.
-	(folding-uninstall-keymaps): 2.109 New.
-	(folding-install-keymaps): 2.109 New.
-	(folding-install): 2.109 Cmpletely rewritten.
-	(folding-mode): 2.109 Added (assq 'folding-mode minor-mode-alist)
-	check if not there, call `folding-install'.
-	(folding-skip-folds): Removed variable `search' and
-	`funcall'. It's faster to call `search-backward' and
-	`search-forward' directly.
-
-2003-08-26  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.63 released.
-
-2003-08-25  Ville Skyttä  <scop@xemacs.org>
-
-	* apache-mode.el (apache-font-lock-keywords):
-	Add mod_python keywords.
-
-2003-07-14  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.62 released.
-
-2003-07-11  Rodney Sparapani <rsparapa@mcw.edu>
-
-	* rtf-support.el (rtf-map-chars): Added support for form-feeds.
-
-2003-06-08  Norbert Koch  <viteno@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.61 released.
-
-2003-06-06  Adrian Aichner  <adrian@xemacs.org>
-
-	* po-mode.el: auto-mode-alist cookie update.
-
-2003-03-09  Ben Wing  <ben@xemacs.org>
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-
-2003-03-02  Norbert Koch  <nk@viteno.net>
-
-	* Makefile (VERSION): XEmacs package 1.60 released.
-
-	* Makefile (VERSION): XEmacs package 1.59 released.
-
-2003-02-17  Vasily Korytov  <deskpot@myrealbox.com>
-
-	* apache-mode.el (apache-file-patterns): Updated to include
-	(httpd|srm|access).conf.default files.
-
-2003-02-11  Ville Skyttä  <scop@xemacs.org>
-
-	* hexl.el (hexl-find-file): Use 2nd arg for find-file
-	only if we have file-coding.
-
-2003-02-05  Jari Aalto  <jari aalto A T poboxes dot com>
-
-	* folding.el (folding-uninstall): Folding was removed
-	from all hooks, but the buffers stayed in folding mode. Now
-	calling uninstall will terminate folding-mode in every Emacs
-	buffer; calls `turn-off-folding-mode'.
-
-2003-01-26  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.58 released.
-
-2003-01-23  Jari Aalto  <jari aalto A T poboxes dot com>
-
-	* folding.el: Applied patch from plasma
-	<plasmaball@pchome.com.tw>. The folding markers
-	do no longer require starting name: '{{{ MARKER', but can be
-	started with plain '{{{'. Files generated this way are compatible
-	with `vim' editor setting `set fdm=marker'.
-
-2003-01-18  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.57 released.
-
-2003-01-13  Vasily Korytov  <deskpot@myrealbox.com>
-
-	* css-mode.el (cssm-indent-line): Use `indent-to' for indenting.
-
-2003-01-13  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.56 released.
-
-2003-01-06  Ville Skyttä  <scop@xemacs.org>
-
-	* xrdb-mode.el: Make auto-mode-alist modifications autoload-only.
-	* xpm-mode.el: Ditto.
-	* scribe.el: Ditto.
-	* nroff-mode.el: Ditto.
-	* winmgr-mode.el: Ditto.
-	* css-mode.el: Ditto.
-
-2003-01-02  Michael Shields  <shields@msrl.com>
-
-	* flyspell.el (mail-mode-flyspell-verify):  More robust handling
-	of `mail-header-separator'.  More efficient signature detection.
-	Allow for regexp metacharacters in message-header-separator.
-
-2002-11-29  Ben Wing  <ben@xemacs.org>
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-11-01  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.55 released.
-
-2002-09-13  Stephen J. Turnbull  <stephen@xemacs.org>
-
-	* filladapt.el (fill-region): Ensure beg <= end.
-	RFE from David Panariti <davep.xemacs@meduseld.net>.
-
-2002-10-29  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.54 released.
-
-2002-10-18  Glynn Clements  <glynn.clements@virgin.net>
-
-	* image-mode.el: Substantially re-written to avoid use of
-	format-alist.
-
-2002-10-15  Ville Skyttä  <scop@xemacs.org>
-
-	* Makefile (srckit): Remove.
-
-2002-10-07  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.53 released.
-
-2002-09-30  Ville Skyttä  <scop@xemacs.org>
-
-	* image-mode.el: Add autoloaded auto-mode-alist associations.
-	* nroff-mode.el: Ditto.
-	* scribe.el: Ditto.
-	* winmgr-mode.el: Ditto.
-	* xrdb-mode.el: Ditto, plus add .ad to extensions.
-
-2002-09-06  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.52 released.
-
-2002-08-29  Ville Skyttä  <scop@xemacs.org>
-
-	* flyspell.el: Sync with upstream.
-	(flyspell-auto-correct-binding): New.
-	(flyspell-mouse-map): Use flyspell-auto-correct-binding.
-
-2002-08-23  Jari Aalto  <jari aalto A T poboxes dot com>
-
-	* folding.el: 1.10 (folding-uninstall-hooks): 2.105
-	Removed `interactive' status.
-	(folding-install-hooks): 2.105
-	Removed `interactive' status.
-	(folding-uninstall): New user function.
-
-2002-08-05  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.51 released.
-
-2002-08-03  Ville Skyttä  <scop@xemacs.org>
-
-	* po-mode.el: Sync with gettext 0.11.4.  No autoloads
-	because of previously reported problems with keybindings.
-
-	* po-compat.el: New, from gettext 0.11.4.
-
-	* Makefile (ELCS): Add po-compat.elc.
-
-	* package-info.in (provides): Add po-compat.
-
-2002-08-03 Sat  Jari Aalto  <jari aalto A T poboxes dot com>
-
-	* folding.el:
-	New feature - added font-lock support.
-	Removed LCD entry, because OHIO archive hasn't
-	been functional in years. Documentation typos cleaned a bit.
-	(folding-mode): Added call to`folding-font-lock-support'
-	(folding-font-lock-keywords): New function.
-	(folding-font-lock-support-instantiate): New function.
-	(folding-font-lock-support): New function.
-	(folding-package-url-location): Added note that folding is
-	included in XEmacs.
-	(folding-font-lock-begin-mark): New user variable.
-	(folding-font-lock-end-mark): New user variable..
-
-2002-08-02  Ville Skyttä  <scop@xemacs.org>
-
-	* xrdb-mode.el: Sync with author version 2.27.
-
-2002-08-02  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.50 released.
-
-2002-08-01  Ville Skyttä  <scop@xemacs.org>
-
-	* flyspell.el: Sync with author version 1.6h, with a change:
-	(flyspell-mouse-map): Use C-; instead of C-/ for
-	flyspell-auto-correct-previous-word (C-/ is bound to undo).
-
-2002-07-31  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.49 released.
-
-2002-07-26  Jari Aalto  <jari aalto A T poboxes dot com>
-
-	* folding.el (folding-install): The unistall choice was
-	missing. Added.
-	(folding-uninstall-hooks): added
-	`turn-off-folding-mode'
-	(folding-mode): Moved `folding-keep-hooked' to the
-	point where folding is turned on. It should not be called
-	if folding is turned off.
-
-2002-07-15  Adrian Aichner  <adrian@xemacs.org>
-
-	* folding.el: It's XEmacs, not Xemacs.
-
-2002-06-27  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.48 released.
-
-2002-06-26  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.47 released.
-
-2002-06-13  Ville Skyttä  <scop@xemacs.org>
-
-	* Makefile (ELCS): Add css-mode.elc.
-	* package-info.in (provides): Add css-mode.
-	* css-mode.el, css-mode.el.upstream: New files.
-
-2002-06-13  Ville Skyttä  <scop@xemacs.org>
-
-	* package-info.in (provides): Add po-mode.
-
-2002-06-11  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (ELCS): Add po-mode.elc.
-
-	* po-mode.el: New file.
-
-2002-06-09  Stephen J. Turnbull  <stephen@xemacs.org>
-
-	* xpm-mode.el (xpm-init): Toolbar specs go with buffer, not frame.
-
-2002-06-04  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.46 released.
-
-2002-06-02  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.45 released.
-
-2002-05-31  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.44 released.
-
-2002-05-25  Ville Skyttä  <scop@xemacs.org>
-
-	* apache-mode.el (apache-font-lock-keywords):
-	Add some missing keywords and values for apache-ssl, mod_ssl
-	and mod_perl.
-
-2002-05-15  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* apache-mode.el (apache-font-lock-keywords): added new keywords
-	from apache-2.0.36
-
-2002-05-10  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.43 released.
-
-2002-05-09  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* apache-mode.el: separated apache directives into sections
-	for easier updating
-	* apache-mode.el (apache-font-lock-keywords):
-
-2002-04-24  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.42 released.
-
-2002-04-24  Ville Skyttä  <scop@xemacs.org>
-
-	* apache-mode.el (apache-font-lock-keywords):
-	Use string equality test in delete-duplicates.
-
-2002-04-24  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): XEmacs package 1.41 released.
-
-2002-04-24  Hrvoje Niksic  <hniksic@xemacs.org>
-
-	* htmlize.el: Sync to upstream version 0.67
-
-2002-04-23  Ville Skyttä  <scop@xemacs.org>
-
-	* apache-mode.el: Docstring updates.
-	(apache-font-lock-keywords):
-	Add keywords for mod_ssl, Apache-SSL and mod_perl.
-	Use delete-duplicates in regexp-opt lists.
-	Fix typo (ProxyReceiveBufferSize).
-
-2002-04-20  Rendhalver [Peter Brown]  <rendhalver@xemacs.org>
-
-	* apache-mode.el: New file.
-
-	* Makefile (ELCS): Added apache-mode.elc.
-
-	* package-info.in (provides): Add apache-mode.
-
-2002-04-07  Alastair J. Houghton  <ajhoughton@lineone.net>
-
-	* rtf-support.el (rtf-spool-region): Fixed extraction of font
-	  information [name, size etc...] on X11.
-
-2002-04-06  Hrvoje Niksic  <hniksic@xemacs.org>
-
-	* htmlize.el: Sync to upstream version 0.65
-
-2002-03-25  Steve Youngs  <youngs@xemacs.org>
-
-	* Makefile (VERSION): 1.40 released.
-
-2002-03-24  Hrvoje Niksic  <hniksic@xemacs.org>
-
-	* htmlize.el: Sync to upstream version 0.64
-
-2002-03-13  Adrian Aichner  <adrian@xemacs.org>
-
-	* package-info.in: Fix typo for rtf-support.
-
-2002-03-08  Volker Franz  <volker.franz@tuebingen.mpg.de>
-
-	* whitespace-mode.el (whitespace-incremental-mode): Autoload it.
-
-2002-03-02  Jeff Mincy  <mincy@rcn.com>
-
-	* xpm-mode.el: (xpm-init) fix infinite loop,
-	(xpm-toolbar-select-colour) null button
-
-2002-02-28  Volker Franz  <volker.franz@tuebingen.mpg.de>
-
-	* whitespace-mode.el: If add-minor-mode is bound, then uses
-	add-minor-mode instead of directly changing minor-mode-alist.
-	Added autoload-cookies for this.
-	(whitespace-mode-line-string): newly defined with
-	autoload-cookies.
-	(whitespace-incremental-mode-line-string): likewise.
-
-2002-02-13  Steve Youngs  <youngs@xemacs.org>
-
-	* flyspell.el: Sync to upstream version 1.6g
-
-2002-02-01  Jeff Mincy  <jeff@delphioutpost.com>
-
-	* xpm-mode.el:  Add xpm-mode to auto-mode-alist.
-
-2002-01-24 Thu  Jari Aalto  <jari aalto A T poboxes dot com>
-
-	* folding.el:
-	(folding-bind-default-keys): Added
-	C-x . to run `folding-context-next-action'. Code by
-	Scott Evans <gse@antisleep.com> during mail exchange.
-	(folding-easy-menu-define): Added
-	`folding-context-next-action'
-	(folding-mouse-call-original): Added `car-safe' to read
-	EVENT, which may be nil.
-	(folding-next-visible-heading): Better variable
-	name `bm' => `begin-mark'
-	(folding-bind-backward-compatible-keys):
-	Used `let' to locally set `folding-mode-prefix-key', but that
-	did not accept a thing, because `folding-install' instantiated
-	the keymap using `folding-mode-prefix-key', which retained the
-	original value. Now sets permanently `folding-mode-prefix-key'
-	to C-c.
-
-2002-01-10  John Paul Wallington  <jpw@shootybangbang.com>
-
-	* flyspell.el (flyspell-mode-line-string): fix custom type.
-
-2001-12-30  Gleb Arshinov  <gleb@barsook.com>
-
-	* folding.el: remove comment about (now fixed) XEmacs isearch
-	support bug
-	(folding-isearch-hook-function): for XEmacs use
-	overriding-local-map or to fiddle with minor-mode-map-alist as
-	appropriate.  This supports both 21.2+ and older XEmacs isearch
-	code.
-	(folding-isearch-general): execute isearch-abort and isearch-quit
-	like any other function for clarity and to make sure any
-	side-effects of underlying implementation take effect.  cond
-	clause is no longer necessary, but is left in place to make patch
-	more clear.
-	(folding-isearch-general): always goto position returned by
-	underlying isearch function.  This makes C-g work as expected
-	(go back to original position where isearch was started)
-	(folding-isearch-general): fully mimic exit signal of isearch
-
-2001-12-30 Sun  Jari Aalto  <jari aalto A T poboxes dot com>
-
-	* folding.el: Synched with the latest folding: 2.97.
-	All function now have uniforma naming `folding-' where the
-	previous version used both `fold-' and `folding-'.
-	Isearch support is still broken in XEmacs, works in Emacs.
-	See complete list of changes in folding itself (history
-	section)
-
-2001-12-29  Steve Youngs  <youngs@xemacs.org>
-
-	* package-info.in: (provides): Update to include all provides.
-
-2001-12-28  Steve Youngs  <youngs@xemacs.org>
-
-	* rtf-support.el: New file.
-
-	* Makefile (ELCS): Add rtf-support.elc
-
-2001-07-18  Charles G Waldman  <cgw@xemacs.org>
-
-	* hexl.el (hexlify-buffer):
-	* hexl.el (dehexlify-buffer): Check whether buffer-file-system
-	is bound.
-
-2001-06-18  Ben Wing  <ben@xemacs.org>
-
-	* hexl.el:
-	* hexl.el (hexl): New.
-	* hexl.el (hexl-iso):
-	* hexl.el (hexl-follow-ascii): New.
-	* hexl.el (hexl-ascii-extent): New.
-	* hexl.el (hexl-mode):
-	* hexl.el (hexl-after-revert-hook):
-	* hexl.el (hexl-save-buffer):
-	* hexl.el (hexl-mode-exit):
-	* hexl.el (hexl-current-address):
-	* hexl.el (hexl-address-to-marker):
-	* hexl.el (hexl-goto-address):
-	* hexl.el (hexl-scroll-up):
-	* hexl.el (hexlify-buffer):
-	* hexl.el (dehexlify-buffer):
-	* hexl.el (hexl-hex-char-to-integer):
-	* hexl.el (hexl-oct-char-to-integer):
-	* hexl.el (hexl-insert-hex-char):
-	* hexl.el (hexl-insert-hex-string): New.
-	* hexl.el (hexl-insert-octal-char):
-	* hexl.el (hexl-follow-ascii-find): New.
-	* hexl.el (hexl-mode-map):
-	Sync with FSF 21.0.103.  Now works on MS Windows.
-
-2001-04-02  Glynn Clements  <glynn.clements@virgin.net>
-
-	* hexl.el (hexl-find-file): force use of 'binary coding-system
-
-2001-01-25  Steve Youngs  <youngs@xemacs.org>
-
-	* ansi-color.el: Sync with author version 3.4.3.
-
-2001-01-19  Steve Youngs  <youngs@xemacs.org>
-
-	* ansi-color.el: New file.
-
-2000-11-16  Steve Youngs  <youngs@xemacs.org>
-
-	* filladapt.el: Sync with author version 2.12.
-
-2000-11-01  Hrvoje Niksic <hniksic@arsdigita.com>
-
-	* htmlize.el: Update to author version 0.55.
-
-2000-10-05  Martin Buchholz  <martin@xemacs.org>
-
-	* *: Mega typo fix.
-
-2000-07-27  Ben Wing  <ben@xemacs.org>
-
-	* flyspell.el (setq ispell-library-path nil): hack so that this
-	will still compile when ispell executable non-existent.
-	(later that same day): revert.  fixed ispell itself.
-
-2000-05-16  Andreas Jaeger  <aj@suse.de>
-
-	* htmlize.el: Version 0.50 from Hrvoje Niksic.
-
-2000-02-14  Stephen J. Turnbull  <stephen@xemacs.org>
-
-	* image-mode.el (image-external-viewer): Remove variable.
-	(image-external-viewer-list): New variable.
-	(image-start-external-viewer): Search `image-external-viewer-list'
-	at run-time, rather than set `image-external-viewer' at load-time.
-
-2000-01-15  Andreas Jaeger <aj@xemacs.org>
-
-	* flyspell.el (global-flyspell-mode): Reverted last patch for now
-	since it lead to some new unresolved problems.
-
-2000-01-11  Didier Verna  <didier@xemacs.org>
-
-	* flyspell.el (global-flyspell-mode): add missing autoload.
-
-1999-11-11  Andreas Jaeger  <aj@suse.de>
-
-	* htmlize.el: Version 0.49 from Hrvoje Niksic <hniksic@srce.hr>.
-
-1999-07-06  SL Baur  <steve@miho.m17n.org>
-
-	* filladapt.el (fill-paragraph): Quote leading parenthesis.
-	(lisp-fill-paragraph): Ditto.
-	(fill-region-as-paragraph): Ditto.
-	(fill-region): Ditto.
-	From Bob Weiner <weiner@altrasoft.com>
-
-1999-04-22  John H Palmieri  <palmieri@member.ams.org>
-
-	* xpm-mode.el (xpm-parse-color):
-	Handle s and m fields correctly if before the c field.
-	Read color correctly from c field if before s and/or m fields.
-
-1999-04-08  Sam Mikes  <smikes@alumni.hmc.edu>
-
-	* folding.el: (fold-mouse-call-original) use `int-to-string' in `concat'
-
-1999-02-15  SL Baur  <steve@xemacs.org>
-
-	* Makefile (ELCS): Add htmlize.elc.
-
-1998-12-30  Martin Buchholz  <martin@xemacs.org>
-
-	* xrdb-mode.el: Upgrade from version 2.11 -> 2.24
-	Snarfed from http://www.python.org/emacs/xrdb-mode.el
-
-1998-10-27  SL Baur  <steve@altair.xemacs.org>
-
-	* flyspell.el (flyspell-mode): Autoload.
-	Remove # in add-minor-mode call (it isn't needed).
-	Move add-minor-mode setup to end of file.
-
-1998-10-21  Greg Klanderman  <greg@alphatech.com>
-
-	* flyspell.el (flyspell-mode-map): add autoload cookie.
-	(top level): pass the function flyspell-mode as the fifth
-	argument to add-minor-mode, not the value of the variable.
-
-1998-10-21  Greg Klanderman  <greg@alphatech.com>
-
-	* flyspell.el: synch to author version 1.4d.
-
-1998-09-24  SL Baur  <steve@altair.xemacs.org>
-
-	* flyspell.el (flyspell-mode-line-string): New variable.
-	Use `add-minor-mode' to add the minor mode to XEmacs.
-	(flyspell-mode): Autoload.
-	(flyspell-mode-map): Autoload.
-	(flyspell-mode-line-string): Autoload.
-
-1998-08-29  Jeff Miller  <jmiller@smart.net>
-
-	* whitespace-mode.el:  added autoload cookie for whitespace-mode
-	updated toolbar icon to use foregroundToolBarColor.
-
-1998-07-03  Charles G Waldman  <cgw@pgt.com>
-
-	* image-mode.el: Fixed image-decode to handle start and end args.
-
-1998-03-25  SL Baur  <steve@altair.xemacs.org>
-
-	* folding.el: New file.
-
-1998-03-16  SL Baur  <steve@altair.xemacs.org>
-
-	* iso-acc.el: Update maintainer: field.
-
-1998-02-26  SL Baur  <steve@altair.xemacs.org>
-
-	* filladapt.el: Version 2.12 courtesy of Kyle Jones.
-
-1998-02-25  SL Baur  <steve@altair.xemacs.org>
-
-	* xrdb-mode.el (xrdb-submit-bug-report): Require reporter here
-	since we don't need it for bytecompiling.
-
-1998-01-25  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile (VERSION): Update to package standard 1.0.
-	* package-info.in: Ditto.
-
-1998-01-12  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile: Update to newer package interface.
-	(ELCS): Add nroff-mode, scribe and ws-mode.
-
-1998-01-03  SL Baur  <steve@altair.xemacs.org>
-
-	* Makefile: Update to newer package interface.
-
-1997-12-24  SL Baur  <steve@altair.xemacs.org>
-
-	* whitespace-mode.el: Strip usage of adapt.el.
-
-	* xrdb-mode.el: Don't require 'reporter at bytecompile time.
-
-	* Makefile: Created.
diff --git a/xemacs-packages/lisp/text-modes/_pkg.el b/xemacs-packages/lisp/text-modes/_pkg.el
deleted file mode 100644
index 9435c02f..00000000
--- a/xemacs-packages/lisp/text-modes/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'text-modes
-		 :version 1.90
-          :author-version "No-Upstream-Ver"
-		 :type 'single-file)
diff --git a/xemacs-packages/lisp/text-modes/ansi-color.el b/xemacs-packages/lisp/text-modes/ansi-color.el
deleted file mode 100644
index b94232d6..00000000
--- a/xemacs-packages/lisp/text-modes/ansi-color.el
+++ /dev/null
@@ -1,645 +0,0 @@
-;;; ansi-color.el --- translate ANSI escape sequences into faces
-
-;; Copyright (C) 1999, 2000, 2001  Free Software Foundation, Inc.
-
-;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Alex Schroeder <alex@gnu.org>
-;; Version: 3.4.3
-;; Keywords: comm processes terminals services
-
-;; 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:
-
-;; This file provides a function that takes a string or a region
-;; containing Select Graphic Rendition (SGR) control sequences (formerly
-;; known as ANSI escape sequences) and tries to translate these into
-;; faces.
-;;
-;; This allows you to run ls --color=yes in shell-mode.  In order to
-;; test this, proceed as follows:
-;;
-;; 1. start a shell: M-x shell
-;; 2. load this file: M-x load-library RET ansi-color RET
-;; 3. activate ansi-color: M-x ansi-color-for-comint-mode-on
-;; 4. test ls --color=yes in the *shell* buffer
-;;
-;; Note that starting your shell from within Emacs might set the TERM
-;; environment variable.  The new setting might disable the output of
-;; SGR control sequences.  Using ls --color=yes forces ls to produce
-;; these.
-;;
-;; If you decide you like this, add the following to your .emacs file:
-;;
-;; (autoload 'ansi-color-for-comint-mode-on "ansi-color" nil t)
-;; (add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)
-;;
-;; SGR control sequences are defined in section 3.8.117 of the ECMA-48
-;; standard (identical to ISO/IEC 6429), which is freely available as a
-;; PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>.  The
-;; "Graphic Rendition Combination Mode (GRCM)" implemented is
-;; "cumulative mode" as defined in section 7.2.8.  Cumulative mode means
-;; that whenever possible, SGR control sequences are combined (ie. blue
-;; and bold).
-
-;; The basic functions are:
-;;
-;; `ansi-color-apply' to colorize a string containing SGR control
-;; sequences.
-;;
-;; `ansi-color-filter-apply' to filter SGR control sequences from a
-;; string.
-;;
-;; `ansi-color-apply-on-region' to colorize a region containing SGR
-;; control sequences.
-;;
-;; `ansi-color-filter-region' to filter SGR control sequences from a
-;; region.
-
-;;; Thanks
-
-;; Georges Brun-Cottan <gbruncot@emc.com> for improving ansi-color.el
-;; substantially by adding the code needed to cope with arbitrary chunks
-;; of output and the filter functions.
-;;
-;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48.
-;;
-;; Stefan Monnier <foo@acm.com> explaing obscure font-lock stuff and
-;; code suggestions.
-
-
-
-;;; Code:
-
-;; Customization
-
-(defgroup ansi-colors nil
-  "Translating SGR control sequences to faces.
-This translation effectively colorizes strings and regions based upon
-SGR control sequences embedded in the text.  SGR (Select Graphic
-Rendition) control sequences are defined in section 3.8.117 of the
-ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available
-as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>."
-  :version "21.1"
-  :group 'processes)
-
-(defcustom ansi-color-faces-vector
-  [default bold default italic underline bold bold-italic modeline]
-  "Faces used for SGR control sequences determining a face.
-This vector holds the faces used for SGR control sequence parameters 0
-to 7.
-
-Parameter  Description        Face used by default
-  0        default            default
-  1        bold               bold
-  2        faint              default
-  3        italic             italic
-  4        underlined         underline
-  5        slowly blinking    bold
-  6        rapidly blinking   bold-italic
-  7        negative image     modeline
-
-Note that the symbol `default' is special: It will not be combined
-with the current face.
-
-This vector is used by `ansi-color-make-color-map' to create a color
-map.  This color map is stored in the variable `ansi-color-map'."
-  :type '(vector face face face face face face face face)
-  :set 'ansi-color-map-update
-  :initialize 'custom-initialize-default
-  :group 'ansi-colors)
-
-(defcustom ansi-color-names-vector
-  ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"]
-  "Colors used for SGR control sequences determining a color.
-This vector holds the colors used for SGR control sequences parameters
-30 to 37 \(foreground colors) and 40 to 47 (background colors).
-
-Parameter  Color
-  30  40   black
-  31  41   red
-  32  42   green
-  33  43   yellow
-  34  44   blue
-  35  45   magenta
-  36  46   cyan
-  37  47   white
-
-This vector is used by `ansi-color-make-color-map' to create a color
-map.  This color map is stored in the variable `ansi-color-map'."
-  :type '(vector string string string string string string string string)
-  :set 'ansi-color-map-update
-  :initialize 'custom-initialize-default
-  :group 'ansi-colors)
-
-(defconst ansi-color-regexp "\033\\[\\([0-9;]*\\)m"
-  "Regexp that matches SGR control sequences.")
-
-(defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
-  "Regexp that matches SGR control sequence parameters.")
-
-
-;; Convenience functions for comint modes (eg. shell-mode)
-
-
-(defcustom ansi-color-for-comint-mode nil
-  "Determines what to do with comint output.
-If nil, do nothing.
-If the symbol `filter', then filter all SGR control sequences.
-If anything else (such as t), then translate SGR control sequences
-into text-properties.
-
-In order for this to have any effect, `ansi-color-process-output' must
-be in `comint-output-filter-functions'.
-
-This can be used to enable colorized ls --color=yes output
-in shell buffers.  You set this variable by calling one of:
-\\[ansi-color-for-comint-mode-on]
-\\[ansi-color-for-comint-mode-off]
-\\[ansi-color-for-comint-mode-filter]"
-  :type '(choice (const :tag "Do nothing" nil)
-		 (const :tag "Filter" filter)
-		 (const :tag "Translate" t))
-  :group 'ansi-colors)
-
-;;;###autoload
-(defun ansi-color-for-comint-mode-on ()
-  "Set `ansi-color-for-comint-mode' to t."
-  (interactive)
-  (setq ansi-color-for-comint-mode t))
-
-(defun ansi-color-for-comint-mode-off ()
-  "Set `ansi-color-for-comint-mode' to nil."
-  (interactive)
-  (setq ansi-color-for-comint-mode nil))
-
-(defun ansi-color-for-comint-mode-filter ()
-  "Set `ansi-color-for-comint-mode' to symbol `filter'."
-  (interactive)
-  (setq ansi-color-for-comint-mode 'filter))
-
-;;;###autoload
-(defun ansi-color-process-output (string)
-  "Maybe translate SGR control sequences of comint output into text-properties.
-
-Depending on variable `ansi-color-for-comint-mode' the comint output is
-either not processed, SGR control sequences are filtered using
-`ansi-color-filter-region', or SGR control sequences are translated into
-text-properties using `ansi-color-apply-on-region'.
-
-The comint output is assumed to lie between the marker
-`comint-last-output-start' and the process-mark.
-
-This is a good function to put in `comint-output-filter-functions'."
-  (let ((start-marker (or comint-last-output-start
-			  (point-min-marker)))
-	(end-marker (process-mark (get-buffer-process (current-buffer)))))
-    (cond ((eq ansi-color-for-comint-mode nil))
-	  ((eq ansi-color-for-comint-mode 'filter)
-	   (ansi-color-filter-region start-marker end-marker))
-	  (t
-	   (ansi-color-apply-on-region start-marker end-marker)))))
-
-(add-hook 'comint-output-filter-functions
-	  'ansi-color-process-output)
-
-
-;; Alternative font-lock-unfontify-region-function for Emacs only
-
-
-(eval-when-compile
-  ;; We use this to preserve or protect things when modifying text
-  ;; properties.  Stolen from lazy-lock and font-lock.  Ugly!!!
-  ;; Probably most of this is not needed?
-  (defmacro save-buffer-state (varlist &rest body)
-    "Bind variables according to VARLIST and eval BODY restoring buffer state."
-    (` (let* ((,@ (append varlist
-		   '((modified (buffer-modified-p)) (buffer-undo-list t)
-		     (inhibit-read-only t) (inhibit-point-motion-hooks t)
-		     before-change-functions after-change-functions
-		     deactivate-mark buffer-file-name buffer-file-truename))))
-	 (,@ body)
-	 (when (and (not modified) (buffer-modified-p))
-	   (set-buffer-modified-p nil)))))
-  (put 'save-buffer-state 'lisp-indent-function 1))
-
-(defun ansi-color-unfontify-region (beg end &rest xemacs-stuff)
-  "Replacement function for `font-lock-default-unfontify-region'.
-
-As text-properties are implemented using extents in XEmacs, this
-function is probably not needed.  In Emacs, however, things are a bit
-different: When font-lock is active in a buffer, you cannot simply add
-face text-properties to the buffer.  Font-lock will remove the face
-text-property using `font-lock-unfontify-region-function'.  If you want
-to insert the strings returned by `ansi-color-apply' into such buffers,
-you must set `font-lock-unfontify-region-function' to
-`ansi-color-unfontify-region'.  This function will not remove all face
-text-properties unconditionally.  It will keep the face text-properties
-if the property `ansi-color' is set.
-
-The region from BEG to END is unfontified.  XEMACS-STUFF is ignored.
-
-A possible way to install this would be:
-
-\(add-hook 'font-lock-mode-hook
-	  \(function (lambda ()
-		      \(setq font-lock-unfontify-region-function
-			    'ansi-color-unfontify-region))))"
-  ;; save-buffer-state is a macro in font-lock.el!
-  (save-buffer-state nil
-    (when (boundp 'font-lock-syntactic-keywords)
-      (remove-text-properties beg end '(syntax-table nil)))
-    ;; instead of just using (remove-text-properties beg end '(face
-    ;; nil)), we find regions with a non-nil face test-property, skip
-    ;; positions with the ansi-color property set, and remove the
-    ;; remaining face test-properties.
-    (while (setq beg (text-property-not-all beg end 'face nil))
-      (setq beg (or (text-property-not-all beg end 'ansi-color t) end))
-      (when (get-text-property beg 'face)
-	(let ((end-face (or (text-property-any beg end 'face nil)
-			    end)))
-	  (remove-text-properties beg end-face '(face nil))
-	  (setq beg end-face))))))
-
-;; Working with strings
-
-(defvar ansi-color-context nil
-  "Context saved between two calls to `ansi-color-apply'.
-This is a list of the form (FACES FRAGMENT) or nil.  FACES is a list of
-faces the last call to `ansi-color-apply' ended with, and FRAGMENT is a
-string starting with an escape sequence, possibly the start of a new
-escape sequence.")
-(make-variable-buffer-local 'ansi-color-context)
-
-(defun ansi-color-filter-apply (string)
-  "Filter out all SGR control sequences from STRING.
-
-Every call to this function will set and use the buffer-local variable
-`ansi-color-context' to save partial escape sequences.  This information
-will be used for the next call to `ansi-color-apply'.  Set
-`ansi-color-context' to nil if you don't want this.
-
-This function can be added to `comint-preoutput-filter-functions'."
-  (let ((start 0) end result)
-    ;; if context was saved and is a string, prepend it
-    (if (cadr ansi-color-context)
-        (setq string (concat (cadr ansi-color-context) string)
-              ansi-color-context nil))
-    ;; find the next escape sequence
-    (while (setq end (string-match ansi-color-regexp string start))
-      (setq result (concat result (substring string start end))
-	    start (match-end 0)))
-    ;; save context, add the remainder of the string to the result
-    (let (fragment)
-      (if (string-match "\033" string start)
-	  (let ((pos (match-beginning 0)))
-	    (setq fragment (substring string pos)
-		  result (concat result (substring string start pos))))
-	(setq result (concat result (substring string start))))
-      (if fragment
-	  (setq ansi-color-context (list nil fragment))
-	(setq ansi-color-context nil)))
-    result))
-
-(defun ansi-color-apply (string)
-  "Translates SGR control sequences into text-properties.
-
-Applies SGR control sequences setting foreground and background colors
-to STRING using text-properties and returns the result.  The colors used
-are given in `ansi-color-faces-vector' and `ansi-color-names-vector'.
-See function `ansi-color-apply-sequence' for details.
-
-Every call to this function will set and use the buffer-local variable
-`ansi-color-context' to save partial escape sequences and current face.
-This information will be used for the next call to `ansi-color-apply'.
-Set `ansi-color-context' to nil if you don't want this.
-
-This function can be added to `comint-preoutput-filter-functions'.
-
-You cannot insert the strings returned into buffers using font-lock.
-See `ansi-color-unfontify-region' for a way around this."
-  (let ((face (car ansi-color-context))
-	(start 0) end escape-sequence result)
-    ;; if context was saved and is a string, prepend it
-    (if (cadr ansi-color-context)
-        (setq string (concat (cadr ansi-color-context) string)
-              ansi-color-context nil))
-    ;; find the next escape sequence
-    (while (setq end (string-match ansi-color-regexp string start))
-      ;; store escape sequence
-      (setq escape-sequence (match-string 1 string))
-      ;; colorize the old block from start to end using old face
-      (when face
-	(put-text-property start end 'ansi-color t string)
-	(put-text-property start end 'face face string))
-      (setq result (concat result (substring string start end))
-	    start (match-end 0))
-      ;; create new face by applying all the parameters in the escape
-      ;; sequence
-      (setq face (ansi-color-apply-sequence escape-sequence face)))
-    ;; if the rest of the string should have a face, put it there
-    (when face
-      (put-text-property start (length string) 'ansi-color t string)
-      (put-text-property start (length string) 'face face string))
-    ;; save context, add the remainder of the string to the result
-    (let (fragment)
-      (if (string-match "\033" string start)
-	  (let ((pos (match-beginning 0)))
-	    (setq fragment (substring string pos)
-		  result (concat result (substring string start pos))))
-	(setq result (concat result (substring string start))))
-      (if (or face fragment)
-	  (setq ansi-color-context (list face fragment))
-	(setq ansi-color-context nil)))
-    result))
-
-;; Working with regions
-
-(defvar ansi-color-context-region nil
-  "Context saved between two calls to `ansi-color-apply-on-region'.
-This is a list of the form (FACES MARKER) or nil.  FACES is a list of
-faces the last call to `ansi-color-apply-on-region' ended with, and
-MARKER is a buffer position within an escape sequence or the last
-position processed.")
-(make-variable-buffer-local 'ansi-color-context-region)
-
-(defun ansi-color-filter-region (begin end)
-  "Filter out all SGR control sequences from region BEGIN to END.
-
-Every call to this function will set and use the buffer-local variable
-`ansi-color-context-region' to save position.  This information will be
-used for the next call to `ansi-color-apply-on-region'.  Specifically,
-it will override BEGIN, the start of the region.  Set
-`ansi-color-context-region' to nil if you don't want this."
-  (let ((end-marker (copy-marker end))
-	(start (or (cadr ansi-color-context-region) begin)))
-    (save-excursion
-      (goto-char start)
-      ;; find the next escape sequence
-      (while (re-search-forward ansi-color-regexp end-marker t)
-	;; delete the escape sequence
-        (replace-match ""))
-    ;; save context, add the remainder of the string to the result
-    (if (re-search-forward "\033" end-marker t)
-	(setq ansi-color-context-region (list nil (match-beginning 0)))
-      (setq ansi-color-context-region nil)))))
-
-(defun ansi-color-apply-on-region (begin end)
-  "Translates SGR control sequences into overlays or extents.
-
-Applies SGR control sequences setting foreground and background colors
-to text in region between BEGIN and END using extents or overlays.
-Emacs will use overlays, XEmacs will use extents.  The colors used are
-given in `ansi-color-faces-vector' and `ansi-color-names-vector'.  See
-function `ansi-color-apply-sequence' for details.
-
-Every call to this function will set and use the buffer-local variable
-`ansi-color-context-region' to save position and current face.  This
-information will be used for the next call to
-`ansi-color-apply-on-region'.  Specifically, it will override BEGIN, the
-start of the region and set the face with which to start.  Set
-`ansi-color-context-region' to nil if you don't want this."
-  (let ((face (car ansi-color-context-region))
-	(start-marker (or (cadr ansi-color-context-region) 
-			  (copy-marker begin)))
-	(end-marker (copy-marker end))
-	escape-sequence)
-    (save-excursion
-      (goto-char start-marker)
-      ;; find the next escape sequence
-      (while (re-search-forward ansi-color-regexp end-marker t)
-	;; colorize the old block from start to end using old face
-	(when face
-	  (ansi-color-set-extent-face
-	   (ansi-color-make-extent start-marker (match-beginning 0))
-	   face))
-        ;; store escape sequence and new start position
-        (setq escape-sequence (match-string 1)
-	      start-marker (copy-marker (match-end 0)))
-	;; delete the escape sequence
-	(replace-match "")
-	;; create new face by applying all the parameters in the escape
-	;; sequence
-	(setq face (ansi-color-apply-sequence escape-sequence face)))
-      ;; search for the possible start of a new escape sequence
-      (if (re-search-forward "\033" end-marker t)
-	  (progn
-	    ;; if the rest of the region should have a face, put it there
-	    (when face
-	      (ansi-color-set-extent-face
-	       (ansi-color-make-extent start-marker (point))
-	       face))
-	    ;; save face and point
-	    (setq ansi-color-context-region
-		  (list face (copy-marker (match-beginning 0)))))
-	;; if the rest of the region should have a face, put it there
-	(if face
-	    (progn
-	      (ansi-color-set-extent-face
-	       (ansi-color-make-extent start-marker end-marker)
-	       face)
-	      (setq ansi-color-context-region (list face)))
-	  ;; reset context
-	  (setq ansi-color-context-region nil))))))
-
-;; This function helps you look for overlapping overlays.  This is
-;; usefull in comint-buffers.  Overlapping overlays should not happen!
-;; A possible cause for bugs are the markers.  If you create an overlay
-;; up to the end of the region, then that end might coincide with the
-;; process-mark.  As text is added BEFORE the process-mark, the overlay
-;; will keep growing.  Therefore, as more overlays are created later on,
-;; there will be TWO OR MORE overlays covering the buffer at that point.
-;; This function helps you check your buffer for these situations.
-; (defun ansi-color-debug-overlays ()
-;   (interactive)
-;   (let ((pos (point-min)))
-;     (while (< pos (point-max))
-;       (if (<= 2 (length (overlays-at pos)))
-; 	  (progn
-; 	    (goto-char pos)
-; 	    (error "%d overlays at %d" (length (overlays-at pos)) pos))
-; 	(let (message-log-max)
-; 	  (message  "Reached %d." pos)))
-;       (setq pos (next-overlay-change pos)))))
-
-;; Emacs/XEmacs compatibility layer
-
-(defun ansi-color-make-face (property color)
-  "Return a face with PROPERTY set to COLOR.
-PROPERTY can be either symbol `foreground' or symbol `background'.  
-
-For Emacs, we just return the cons cell \(PROPERTY . COLOR).
-For XEmacs, we create a temporary face and return it."
-  (if (featurep 'xemacs)
-      (let ((face (make-face (intern (concat color "-" (symbol-name property)))
-			     "Temporary face created by ansi-color."
-			     t)))
-	(set-face-property face property color)
-	face)
-    (cond ((eq property 'foreground)
-	   (cons 'foreground-color color))
-	  ((eq property 'background)
-	   (cons 'background-color color))
-	  (t
-	   (cons property color)))))
-
-(defun ansi-color-make-extent (from to &optional object)
-  "Make an extent for the range [FROM, TO) in OBJECT.
-
-OBJECT defaults to the current buffer.  XEmacs uses `make-extent', Emacs
-uses `make-overlay'.  XEmacs can use a buffer or a string for OBJECT,
-Emacs requires OBJECT to be a buffer."
-  (if (functionp 'make-extent)
-      (make-extent from to object)
-    ;; In Emacs, the overlay might end at the process-mark in comint
-    ;; buffers.  In that case, new text will be inserted before the
-    ;; process-mark, ie. inside the overlay (using insert-before-marks).
-    ;; In order to avoid this, we use the `insert-behind-hooks' overlay
-    ;; property to make sure it works.
-    (let ((overlay (make-overlay from to object)))
-      (overlay-put overlay 'modification-hooks '(ansi-color-freeze-overlay))
-      overlay)))
-
-(defun ansi-color-freeze-overlay (overlay is-after begin end &optional len)
-  "Prevent OVERLAY from being extended.
-This function can be used for the `modification-hooks' overlay
-property."
-  ;; if stuff was inserted at the end of the overlay
-  (when (and is-after
-	     (= 0 len)
-	     (= end (overlay-end overlay)))
-    ;; reset the end of the overlay
-    (move-overlay overlay (overlay-start overlay) begin)))
-
-(defun ansi-color-set-extent-face (extent face)
-  "Set the `face' property of EXTENT to FACE.
-XEmacs uses `set-extent-face', Emacs  uses `overlay-put'."
-  (if (functionp 'set-extent-face)
-      (set-extent-face extent face)
-    (overlay-put extent 'face face)))
-
-;; Helper functions
-
-(defun ansi-color-apply-sequence (escape-sequence faces)
-  "Apply ESCAPE-SEQ to FACES and return the new list of faces.
-
-ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'.
-
-If the new faces start with the symbol `default', then the new
-faces are returned.  If the faces start with something else,
-they are appended to the front of the FACES list, and the new
-list of faces is returned.
-
-If `ansi-color-get-face' returns nil, then we either got a
-null-sequence, or we stumbled upon some garbage.  In either
-case we return nil."
-  (let ((new-faces (ansi-color-get-face escape-sequence)))
-    (cond ((null new-faces)
-	   nil)
-	  ((eq (car new-faces) 'default)
-	   (cdr new-faces))
-	  (t
-	   (append new-faces faces)))))
-
-(defun ansi-color-make-color-map ()
-  "Creates a vector of face definitions and returns it.
-
-The index into the vector is an ANSI code.  See the documentation of
-`ansi-color-map' for an example.
-
-The face definitions are based upon the variables
-`ansi-color-faces-vector' and `ansi-color-names-vector'."
-  (let ((ansi-color-map (make-vector 50 nil))
-        (index 0))
-    ;; miscellaneous attributes
-    (mapcar
-     (function (lambda (e)
-                 (aset ansi-color-map index e)
-                 (setq index (1+ index)) ))
-     ansi-color-faces-vector)
-    ;; foreground attributes
-    (setq index 30)
-    (mapcar
-     (function (lambda (e)
-                 (aset ansi-color-map index
-		       (ansi-color-make-face 'foreground e))
-                 (setq index (1+ index)) ))
-     ansi-color-names-vector)
-    ;; background attributes
-    (setq index 40)
-    (mapcar
-     (function (lambda (e)
-                 (aset ansi-color-map index
-		       (ansi-color-make-face 'background e))
-                 (setq index (1+ index)) ))
-     ansi-color-names-vector)
-    ansi-color-map))
-
-(defvar ansi-color-map (ansi-color-make-color-map)
-  "A brand new color map suitable for `ansi-color-get-face'.
-
-The value of this variable is usually constructed by
-`ansi-color-make-color-map'.  The values in the array are such that the
-numbers included in an SGR control sequences point to the correct
-foreground or background colors.
-
-Example: The sequence \033[34m specifies a blue foreground.  Therefore:
-     (aref ansi-color-map 34)
-          => \(foreground-color . \"blue\")")
-
-(defun ansi-color-map-update (symbol value)
-  "Update `ansi-color-map'.
-
-Whenever the vectors used to construct `ansi-color-map' are changed,
-this function is called.  Therefore this function is listed as the :set
-property of `ansi-color-faces-vector' and `ansi-color-names-vector'."
-  (set-default symbol value)
-  (setq ansi-color-map (ansi-color-make-color-map)))
-
-(defun ansi-color-get-face-1 (ansi-code)
-  "Get face definition from `ansi-color-map'.
-ANSI-CODE is used as an index into the vector."
-  (condition-case nil
-      (aref ansi-color-map ansi-code)
-    ('args-out-of-range nil)))
-
-(defun ansi-color-get-face (escape-seq)
-  "Create a new face by applying all the parameters in ESCAPE-SEQ.
-
-Should any of the parameters result in the default face (usually this is
-the parameter 0), then the effect of all previous parameters is cancelled.
-
-ESCAPE-SEQ is a SGR control sequences such as \\033[34m.  The parameter
-34 is used by `ansi-color-get-face-1' to return a face definition."
-  (let ((ansi-color-r "[0-9][0-9]?")
-        (i 0)
-        f val)
-    (while (string-match ansi-color-r escape-seq i)
-      (setq i (match-end 0)
-	    val (ansi-color-get-face-1
-		 (string-to-int (match-string 0 escape-seq) 10)))
-      (cond ((not val))
-	    ((eq val 'default)
-	     (setq f (list val)))
-	    (t
-	     (add-to-list 'f val))))
-    f))
-
-(provide 'ansi-color)
-
-;;; ansi-color.el ends here
diff --git a/xemacs-packages/lisp/text-modes/apache-mode.el b/xemacs-packages/lisp/text-modes/apache-mode.el
deleted file mode 100644
index 06854f72..00000000
--- a/xemacs-packages/lisp/text-modes/apache-mode.el
+++ /dev/null
@@ -1,561 +0,0 @@
-;;; apache-mode.el --- major mode for editing Apache configuration files
-
-;; Keywords:	languages, faces
-;; Author:	Jonathan Marten  <jonathan.marten@uk.sun.com> or
-;; Last edit:	12-May-2002      <rendhalver@xemacs.org>
-
-;; This file is an add-on for XEmacs or GNU Emacs (not tested with the latter).
-;;
-;; It 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:
-;;
-;; There isn't really much to say.  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.
-;;
-
-;; PB: hopefully this will no longer be needed :)
-;;
-;; no longer need to hack auto-mode-alist :)
-
-;; To enable automatic selection of this mode when appropriate files are
-;; visited, add the following to your favourite site or personal Emacs
-;; configuration file:
-;;
-;;   (autoload 'apache-mode "apache-mode" "autoloaded" 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))
-;;
-
-;;; Change Log:
-;;
-;; Version 1.0, October 1999	First public release
-
-;; Version 1.1, April 2002      changed var's to use customise
-;;                              updated the keywords to apache 1.3.24
-;;                              added apache-file-patterns to save having to hack
-;;                              auto-mode-alist, added autoloaded function to add
-;;                              apache-file-patterns to auto-mode-alist on autoload
-;;
-;; Version 1.2, April 2002      Added mod_ssl 2.8.8, Apache-SSL 1.47 and
-;;                              mod_perl 1.26 keywords.
-
-;; Version 1.2.1, May 2002      separated apache directives into sections
-;;                              for easier updating
-
-;; Version 1.3, May 2002        updated keywords to include new directives in 
-;;                              apache 2
-
-;;; Code:
-
-;; Requires
-(require 'font-lock)
-(require 'regexp-opt)
-(require 'custom)
-
-;; Variables
-
-;;;###autoload
-(defgroup apache nil
-  "Major mode for editing Apache configuration files."
-  :prefix "apache-"
-  :group 'languages)
-
-(defcustom apache-manual-url "http://httpd.apache.org/"
-  "*URL at which to find the Apache manual."
-  :type 'string
-  :group 'apache)
-
-;;;###autoload
-(defcustom apache-file-patterns
-  (list "\\.htaccess\\(\\.default\\)?$" "httpd\\.conf\\(\\.default\\)?$"
-	"srm\\.conf\\(\\.default\\)?$" "access\\.conf\\(\\.default\\)?$")
-  "*List of file patterns for which to automatically invoke `apache-mode'."
-  :type '(repeat (regexp :tag "Pattern"))
-  :group 'apache)
-
-(defcustom apache-mode-hook nil
-  "*List of hook functions run by `apache-mode' (see `run-hooks')."
-  :type 'hook
-  :group 'apache)
-
-(defvar apache-mode-map nil
-  "Keymap used in `apache-mode' buffers.")
-
-(defvar apache-mode-syntax-table nil
-  "Syntax table for `apache-mode'.")
-
-;;; blatently pinched and hacked from php-mode
-;;; hey if it works use it
-;;
-;; Make apache-mode the default mode for apache config buffers.
-;;;###autoload
-(let ((apache-file-patterns-temp apache-file-patterns))
-  (while apache-file-patterns-temp
-    (add-to-list 'auto-mode-alist
-		  (cons (car apache-file-patterns-temp) 'apache-mode))
-    (setq apache-file-patterns-temp (cdr apache-file-patterns-temp))))
-
-
-;; Font lock
-(defconst apache-font-lock-keywords
-  (purecopy
-   (list
-    (list "^\\s-*#.*$" 0 'font-lock-comment-face t)
-
-    (list (concat                                       ; sections
-	   "^\\s-*</?\\("
-           (regexp-opt
-            '("Directory" "DirectoryMatch" "Files" "FilesMatch"
-              "IfDefine" "IfModule" "Limit" "LimitExcept" "Location"
-              "LocationMatch" "VirtualHost"
-              ;; mod_perl
-              "Perl"
-              ))
-           "\\)\\(>\\|\\s-\\)")
-	  1 'font-lock-function-name-face)
-
-    (list (concat                                       ; keywords
-	   "^\\s-*\\("
-           (regexp-opt
-            (delete-duplicates
-             '(
-	       ;; core directives
-	       "AcceptFilter" "AcceptMutex" "AccessConfig" "AccessFileName" "AddDefaultCharset"
-	       "AddModule" "AllowOverride" "AuthName" "AuthType" "BindAddress"
-	       "BS2000Account" "ClearModuleList" "ContentDigest" "CoreDumpDirectory"
-	       "DefaultType" "DocumentRoot" "EBCDICConvert" "EBCDICConvertByType"
-	       "EBCDICKludge" "ErrorDocument" "ErrorLog" "FileETag" "Group"
-	       "HostnameLookups" "IdentityCheck" "Include" "KeepAlive" "KeepAliveTimeout"
-	       "LimitRequestBody" "LimitRequestFields" "LimitRequestFieldsize"
-	       "LimitRequestLine" "Listen" "ListenBacklog" "LockFile" "LogLevel"
-	       "MaxClients" "MaxKeepAliveRequests" "MaxRequestsPerChild" "MaxSpareServers"
-	       "MinSpareServers" "NameVirtualHost" "Options" "PidFile" "Port" "Require"
-	       "ResourceConfig" "RLimitCPU" "RLimitMEM" "RLimitNPROC" "Satisfy"
-	       "ScoreBoardFile" "ScriptInterpreterSource" "SendBufferSize" "ServerAdmin"
-	       "ServerAlias" "ServerName" "ServerPath" "ServerRoot" "ServerSignature"
-	       "ServerTokens" "ServerType" "StartServers" "ThreadsPerChild"
-	       "ThreadStackSize" "TimeOut" "UseCanonicalName" "User"
-	       ;; apache2 core directives
-	       "AcceptPathInfo" "ForceType" "LimitXMLRequestBody" "Require"
-	       "SetHandler" "SetInputFilter" "SetOutputFilter"
-	       ;; apache2 mpm_common
-	       "CoreDumpDirectory" "Group" "Listen" "ListenBackLog" "LockFile"
-	       "MaxClients" "MaxRequestsPerChild" "MaxSpareThreads"
-	       "MaxThreadsPerChild" "MinSpareThreads" "NumServers" "PidFile"
-	       "ScoreBoardFile" "SendBufferSize" "ServerLimit" "StartServers"
-	       "StartThreads" "ThreadLimit" "ThreadsPerChild" "User"
-	       ;; mpm_netware
-	       "Listen" "ListenBacklog" "MaxRequestsPerChild" "MaxSpareThreads"
-	       "MaxThreads" "MinSpareThreads" "SendBufferSize" "StartThreads"
-	       "ThreadStackSize"
-	       ;; mpm_winnt
-	       "CoreDumpDirectory" "Listen" "ListenBacklog"
-	       "MaxRequestsPerChild" "PidFile" "SendBufferSize" "ThreadsPerChild"
-	       ;; mpm_perchild
-	       "AssignUserId" "ChildPerUserId" "CoreDumpDirectory" "Group"
-	       "Listen" "ListenBacklog" "LockFile" "MaxRequestsPerChild"
-	       "MaxSpareThreads" "MaxThreadsPerChild" "MinSpareThreads"
-	       "NumServers" "PidFile" "ScoreBoardFile" "SendBufferSize"
-	       "StartThreads" "User"
-	       ;; mpm_prefork
-	       "AcceptMutex" "CoreDumpDirectory" "Listen" "ListenBacklog"
-	       "LockFile" "MaxRequestsPerChild" "MaxSpareServers"
-	       "MaxSpareServers" "MinSpareServers" "MinSpareServers"
-	       "PidFile" "ScoreBoardFile" "SendBufferSize"
-	       "ServerLimit" "StartServers" "User"
-	       ;; mpm_worker
-	       "CoreDumpDirectory" "Group" "Listen" "ListenBacklog"
-	       "LockFile" "MaxClients" "MaxRequestsPerChild"
-	       "MaxSpareThreads" "MinSpareThreads" "PidFile"
-	       "ScoreBoardFile" "SendBufferSize" "ServerLimit"
-	       "StartServers" "ThreadLimit" "ThreadsPerChild" "User"
-	       ;; Environment Creation directives
-	       ;; mod_env 
-	       "PassEnv" "SetEnv" "UnsetEnv"
-	       ;; mod_setenvif
-	       "BrowserMatch" "BrowserMatchNoCase" "SetEnvIf" "SetEnvIfNoCase"
-	       ;; Content Type Decisions
-	       ;; mod_mime
-	       "AddCharset" "AddEncoding" "AddHandler" "AddLanguage" "AddType"
-	       "DefaultLanguage" "ForceType" "RemoveEncoding" "RemoveHandler"
-	       "RemoveType" "SetHandler" "TypesConfig"
-	       ;; apache2 mod_mime
-	       "AddInputFilter" "AddOutputFilter" "MultiviewsMatch"
-	       "RemoveCharset" "RemoveInputFilter" "RemoveLanguage"
-	       "RemoveOutputFilter"
-	       ;; mod_mime_magic
-	       "MimeMagicFile"
-	       ;; mod_negotiation
-	       "CacheNegotiatedDocs" "LanguagePriority"
-	       ;; apache2 mod_negotiation
-	       "ForceLangaugePriority"
-	       ;; URL Mapping
-	       ;; mod_alias
-	       "Alias" "AliasMatch" "Redirect" "RedirectMatch" "RedirectTemp"
-	       "RedirectPermanent" "ScriptAlias" "ScriptAliasMatch"
-	       ;; mod_rewrite
-	       "RewriteEngine" "RewriteOptions" "RewriteLog" "RewriteLogLevel"
-	       "RewriteLock" "RewriteMap" "RewriteBase" "RewriteCond" "RewriteRule"
-	       ;; mod_userdir
-	       "UserDir"
-	       ;; mod_speling
-	       "CheckSpelling"
-	       ;; mod_vhost_alias
-	       "VirtualDocumentRoot" "VirtualDocumentRootIP" "VirtualScriptAlias"
-	       "VirtualScriptAliasIP"
-	       ;; Directory Handling
-	       ;; mod_dir
-	       "DirectoryIndex"
-	       ;; mod_autoindex
-	       "AddAlt" "AddAltByEncoding" "AddAltByType" "AddDescription" "AddIcon"
-	       "AddIconByEncoding" "AddIconByType" "DefaultIcon" "FancyIndexing"
-	       "HeaderName" "IndexIgnore" "IndexOptions" "IndexOrderDefault" "ReadmeName"
-	       ;; Access Control
-	       ;; mod_access
-	       "Allow" "Deny" "Order"
-	       ;; mod_auth
-	       "AuthGroupFile" "AuthUserFile" "AuthAuthoritative"
-	       ;; mod_auth_dbm
-	       "AuthDBMGroupFile" "AuthDBMUserFile" "AuthDBMAuthoritative"
-	       ;; apache2 mod_auth_dbm
-	       "AuthDBMType"
-	       ;; mod_auth_db
-	       "AuthDBGroupFile" "AuthDBUserFile" "AuthDBAuthoritative"
-	       ;; mod_auth_anon
-	       "Anonymous" "Anonymous_Authoritative" "Anonymous_LogEmail"
-	       "Anonymous_MustGiveEmail" "Anonymous_NoUserID" "Anonymous_VerifyEmail"
-	       ;; mod_auth_digest
-	       "AuthDigestFile" "AuthDigestGroupFile" "AuthDigestQop"
-	       "AuthDigestNonceLifetime" "AuthDigestNonceFormat" "AuthDigestNcCheck"
-	       "AuthDigestAlgorithm" "AuthDigestDomain"
-	       ;; apache2 mod_auth_digest
-	       "AuthDigestAlgorithm" "AuthDigestNcCheck" "AuthDigestNonceFormat"
-	       "AuthDigestNonceLifetime"
-	       ;; mod_digest
-	       "AuthDigestFile"
-	       ;; HTTP Response
-	       ;; mod_headers
-	       "Header"
-	       ;; apache2 mod_headers
-	       "RequestHeader"
-	       ;; mod_cern_meta
-	       "MetaFiles" "MetaDir" "MetaSuffix"
-	       ;; mod_expires
-	       "ExpiresActive" "ExpiresByType" "ExpiresDefault"
-	       ;; Dynamic Content
-	       ;; mod_include
-	       "XBitHack"
-	       ;; apache2 mod_include
-	       "SSIEndTag" "SSIErrorMsg" "SSIStartTag" "SSITimeFormat"
-	       "SSIUndefinedEcho"
-	       ;; mod_cgi
-	       "ScriptLog" "ScriptLogLength" "ScriptLogBuffer"
-	       ;; mod_actions
-	       "Action" "Script" 
-	       ;; mod_isapi WIN32 only
-	       "ISAPIReadAheadBuffer" "ISAPILogNotSupported" "ISAPIAppendLogToErrors"
-	       "ISAPIAppendLogToQuery"
-	       ;; apache2 mod_isapi
-	       "ISAPIFileChache"
-	       ;; Internal Content Handlers
-	       ;; mod_status
-	       "ExtendedStatus" 
-	       ;; mod_info
-	       "AddModuleInfo"
-	       ;; Logging
-	       ;; mod_log_config
-	       "CookieLog" "CustomLog" "LogFormat" "TransferLog"
-	       ;; mod_log_agent
-	       "AgentLog"
-	       ;; mod_log_referer
-	       "RefererIgnore" "RefererLog"
-	       ;; mod_usertrack
-	       "CookieDomain" "CookieExpires" "CookieName" "CookieStyle" "CookieTracking"
-	       ;; Miscellaneous
-	       ;; mod_imap
-	       "ImapMenu" "ImapDefault" "ImapBase"
-	       ;; mod_proxy
-	       "ProxyRequests" "ProxyRemote" "ProxyPass" "ProxyPassReverse" "ProxyBlock"
-	       "AllowCONNECT" "ProxyReceiveBufferSize" "ProxyIOBufferSize" "NoProxy"
-	       "ProxyDomain" "ProxyVia" "CacheRoot" "CacheSize" "CacheMaxExpire"
-	       "CacheDefaultExpire" "CacheLastModifiedFactor" "CacheGcInterval"
-	       "CacheDirLevels" "CacheDirLength" "CacheForceCompletion" "NoCache"
-	       ;; apache2 mod_proxy
-	       "ProxyErrorOverride" "ProxyMaxForwards" "ProxyPreserveHost"
-	       "ProxyRemote" "ProxyTimeout"
-	       ;; mod_so
-	       "LoadFile" "LoadModule" 
-	       ;; mod_mmap_static
-	       "MMapFile"
-	       ;; Development
-	       ;; mod_example
-               "Example"
-	       ;; Obsolete directives
-	       ;; mod_browser
-	       "BrowserMatch" "BrowserMatchNoCase"
-	       ;; mod_cookies
-	       "CookieLog"
-	       ;; mod_dld
-	       "LoadFile" "LoadModule"
-	       ;; mod_log_common
-	       "TransferLog"
-	       ;; other stuff that i dont know which mod they belong in
-	       "DefaultMode" "HTTPLogFile" "HTMLDir" "PrivateDir"
-               "TopSites" "TopURLs" "LastURLs" "HeadPrefix" "HeadSuffix"
-               "DocTitle" "DocTrailer" "HideURL" "HideSys"
-	       ;;; apache2 extra builtin modules
-	       ;; mod_charset_lite
-	       "CharsetDefault" "CharsetOptions" "CharsetSourceEnc"
-	       ;; mod_auth_ldap
-	       "AuthLDAPAuthoritative" "AuthLDAPBindDN" "AuthLDAPBindPassword"
-	       "AuthLDAPCompareDNOnServer" "AuthLDAPDereferenceAliases"
-	       "AuthLDAPEnabled" "AuthLDAPFrontPageHack" "AuthLDAPGroupAttribute"
-	       "AuthLDAPGroupAttributeIsDN" "AuthLDAPRemoteUserIsDN"
-	       "AuthLDAPStartTLS" "AuthLDAPUrl"
-	       ;; mod_cgid
-	       "ScriptLog" "ScriptLogBuffer" "ScriptLogLength" "ScriptSock"
-	       ;; mod_ext_filter
-	       "ExtFilterDefine" "ExtFilterOptions"
-	       ;; mod_suexec
-	       "SuexecUserGroup"
-	       ;; mod_file_cache
-	       "CacheFile" "MMapFile"
-	       ;; mod_cache
-	       "CacheDefaultExpire" "CacheDisable" "CacheEnable"
-	       "CacheIgnoreCacheControl" "CacheIgnoreNoLastMod"
-	       "CacheLastModifiedFactor" "CacheMaxExpire" "CacheOn"
-	       ;; mod_dav
-	       "Dav" "DavDepthInfinity" "DavLockDB" "DavMinTimeout"
-	       ;; mod_deflate
-	       "DeflateFilterNote" "DeflateMemLevel" "DeflateWindowSize"
-	       ;; mod_ssl
-	       "SSLCACertificateFile" "SSLCACertificatePath" "SSLCARevocationFile"
-	       "SSLCARevocationPath" "SSLCertificateChainFile"
-	       "SSLCertificateFile" "SSLCertificateKeyFile" "SSLCipherSuite"
-	       "SSLEngine" "SSLLog" "SSLLogLevel" "SSLMutex" "SSLOptions"
-	       "SSLPassPhraseDialog" "SSLProtocol" "SSLRandomSeed"
-	       "SSLRequire" "SSLRequireSSL" "SSLSessionCache" 
-	       "SSLSessionCacheTimeout" "SSLVerifyClient" "SSLVerifyDepth"
-	       ;; mod_ldap
-	       "LDAPCacheEntries" "LDAPCacheTTL" "LDAPCertDBPath"
-	       "LDAPOpCacheEntries" "LDAPOpCacheTTL" "LDAPSharedCacheSize"
-
-               ;;; non builtin apache modules 
-               ;; mod_ssl
-               "SSLPassPhraseDialog" "SSLMutex" "SSLRandomSeed"
-               "SSLSessionCache" "SSLSessionCacheTimeout" "SSLEngine"
-               "SSLProtocol" "SSLCipherSuite" "SSLCertificateFile"
-               "SSLCertificateKeyFile" "SSLCertificateChainFile"
-               "SSLCACertificatePath" "SSLCACertificateFile"
-               "SSLCARevocationPath" "SSLCARevocationFile"
-               "SSLVerifyClient" "SSLVerifyDepth" "SSLLog"
-               "SSLLogLevel" "SSLOptions" "SSLRequireSSL"
-               "SSLRequire"
-
-               ;; Apache-SSL
-               "SSLBanCipher" "SSLCACertificateFile"
-               "SSLCACertificatePath" "SSLCacheServerPath"
-               "SSLCacheServerPort" "SSLCacheServerRunDir"
-               "SSLCertificateFile" "SSLCertificateKeyFile"
-               "SSLCheckClientDN" "SSLDenySSL" "SSLDisable"
-               "SSLEnable" "SSLEngineID" "SSLExportClientCertificates"
-               "SSLFakeBasicAuth" "SSLKeyNoteTrustedAssertion"
-               "SSLKeyNoteTrustedIssuerTemplate" "SSLNoCAList"
-               "SSLRandomFile" "SSLRandomFilePerConnection"
-               "SSLRequireCipher" "SSLRequireSSL" "SSLRequiredCiphers"
-               "SSLSessionCacheTimeout" "SSLVerifyClient"
-               "SSLVerifyDepth"
-
-               ;; mod_perl 1 and 2
-               "PerlAccessHandler" "PerlAddVar" "PerlAuthenHandler"
-               "PerlAuthzHandler" "PerlChildExitHandler"
-               "PerlChildInitHandler" "PerlCleanupHandler"
-               "PerlFixupHandler" "PerlHeaderParserHandler"
-               "PerlInitHandler" "PerlLogHandler" "PerlModule"
-               "PerlPassEnv" "PerlPostReadRequestHandler"
-               "PerlRequire" "PerlSetEnv" "PerlSetVar"
-               "PerlTypeHandler"
-
-               ;; mod_perl 1
-               "PerlDispatchHandler" "PerlFreshRestart"
-               "PerlHandler" "PerlOpmask" "PerlRestartHandler"
-               "PerlScript" "PerlSendHeader" "PerlSetupEnv"
-               "PerlTaintCheck" "PerlTransHandler" "PerlWarn"
-
-               ;; mod_perl 2
-               "PerlLoadModule" "PerlOptions" "PerlSwitches"
-               "PerlOpenLogsHandler" "PerlPostConfigHandler"
-               "PerlPreConnectionHandler" "PerlProcessConnectionHandler"
-               "PerlInputFilterHandler" "PerlOutputFilterHandler"
-               "PerlSetInputFilter" "PerlSetOutputFilter"
-               "PerlResponseHandler" "PerlInterpStart"
-               "PerlInterpMax" "PerlInterpMinSpare"
-               "PerlInterpMaxSpare" "PerlInterpMaxRequests"
-               "PerlInterpScope" "PerlTrace"
-
-               ;; mod_python
-               "PythonAccessHandler" "PythonAuthenHandler"
-               "PythonAuthzHandler" "PythonAutoReload"
-               "PythonCleanupHandler" "PythonConnectionHandler"
-               "PythonDebug" "PythonEnablePdb" "PythonFixupHandler"
-               "PythonHandler" "PythonHandlerModule"
-               "PythonHeaderParserHandler" "PythonImport"
-               "PythonInitHandler" "PythonInputFilter"
-               "PythonInterpPerDirective" "PythonInterpPerDirectory"
-               "PythonInterpreter" "PythonLogHandler" "PythonOptimize"
-               "PythonOption" "PythonOutputFilter" "PythonPath"
-               "PythonPostReadRequestHandler" "PythonTransHandler"
-               "PythonTypeHandler"
-
-               ) :test 'string=))
-           "\\)\\s-")
-	  1 'font-lock-keyword-face)
-
-    (list (concat                                       ; values
-	   "\\(?:^\\|\\W\\)\\("
-           (regexp-opt
-            (delete-duplicates
-             '("allow" "deny" "on" "valid-user" "inetd" "standalone"
-               "off" "user" "group" "any" "env" "mutual-failure" "full"
-               "email" "force-response-1.0" "downgrade-1.0" "nokeepalive"
-               "permanent" "temporary" "seeother" "gone" "All" "Options"
-               "FileInfo" "AuthConfig" "Limit" "from" "None" "Basic"
-               "Digest" "FancyIndexing" "IconsAreLinks" "ScanHTMLTitles"
-               "SuppressLastModified" "SuppressSize" "SuppressDescription"
-               "Minimal" "OS" "Full" "set" "append" "add" "unset" "none"
-               "formatted" "semi-formatted" "unformatted" "error" "nocontent"
-               "map" "referer" "URL" "inherit" "double" "GET" "PUT" "POST"
-               "DELETE" "CONNECT" "OPTIONS" "Options" "Indexes" "Includes"
-               "ExecCGI" "FollowSymLinks" "MultiViews" "IncludesNOEXEC"
-               "SymLinksIfOwnerMatch"
-               "uslock" "pthread" "sysvsem" "fcntl" "flock" "os2sem"
-               "tpfcore" "default" "INode" "MTime"
-
-               ;; mod_ssl
-               "builtin" "exec" "none" "file" "sem" "egd" "dbm" "on" "off"
-               "shm" "shmht" "shmcb"
-               "SSLv2" "SSLv3" "TLSv1" "All" "startup" "connect"
-               "optional" "require" "optional_no_ca" "ssl-unclean-shutdown"
-               "error" "warn" "info" "trace" "debug"
-               "StdEnvVars" "CompatEnvVars" "ExportCertData" "FakeBasicAuth"
-               "StrictRequire" "OptRenegotiate"
-               "ssl-accurate-shutdown" "ssl-unclean-shutdown"
-               ;; cipher stuff
-               "kRSA" "kDHr" "kDHd" "kEDH" "aNULL" "aRSA" "aDSS" "aDH" "eNULL"
-               "DES" "3DES" "RC4" "RC2" "IDEA" "MD5" "SHA1" "SHA" "EXP"
-               "EXPORT40" "EXPORT56" "LOW" "MEDIUM" "HIGH" "RSA" "DH" "EDH"
-               "ADH" "DSS" "NULL"
-               "DES-CBC3-SHA" "DES-CBC3-MD5" "IDEA-CBC-SHA" "RC4-SHA" "RC4-MD5"
-               "IDEA-CBC-MD5" "RC2-CBC-MD5" "RC4-MD5" "DES-CBC-SHA"
-               "RC4-64-MD5" "DES-CBC-MD5" "EXP-DES-CBC-SHA" "EXP-RC2-CBC-MD5"
-               "EXP-RC4-MD5" "EXP-RC2-CBC-MD5" "EXP-RC4-MD5" "NULL-SHA"
-               "NULL-MD5" "ADH-DES-CBC3-SHA" "ADH-DES-CBC-SHA" "ADH-RC4-MD5"
-               "EDH-RSA-DES-CBC3-SHA" "EDH-DSS-DES-CBC3-SHA"
-               "EDH-RSA-DES-CBC-SHA" "EDH-DSS-DES-CBC-SHA"
-               "EXP-EDH-RSA-DES-CBC-SHA" "EXP-EDH-DSS-DES-CBC-SHA"
-               "EXP-ADH-DES-CBC-SHA" "EXP-ADH-RC4-MD5"
-
-               ;; Apache-SSL
-               "file" "egd" "0" "1" "2" "3"
-               ;; cipher stuff
-               "IDEA-CBC-SHA" "NULL-MD5" "NULL-SHA" "EXP-RC4-MD5" "RC4-MD5"
-               "RC4-SHA" "EXP-RC2-CBC-MD5" "IDEA-CBC-MD5" "EXP-DES-CBC-SHA"
-               "DES-CBC-SHA" "DES-CBC3-SHA" "EXP-DH-DSS-DES-CBC-SHA"
-               "DH-DSS-DES-CBC-SHA" "DH-DSS-DES-CBC3-SHA"
-               "EXP-DH-RSA-DES-CBC-SHA" "DH-RSA-DES-CBC-SHA"
-               "DH-RSA-DES-CBC3-SHA" "EXP-EDH-DSS-DES-CBC-SHA"
-               "EDH-DSS-DES-CBC-SHA" "EDH-DSS-DES-CBC3-SHA"
-               "EXP-EDH-RSA-DES-CBC" "EDH-RSA-DES-CBC-SHA"
-               "EDH-RSA-DES-CBC3-SHA" "EXP-ADH-RC4-MD5" "ADH-RC4-MD"
-               "EXP-ADH-DES-CBC-SHA" "ADH-DES-CBC-SHA" "ADH-DES-CBC3-SHA"
-               "FZA-NULL-SHA" "FZA-FZA-CBC-SHA" "FZA-RC4-SHA" "DES-CFB-M1"
-               "RC2-CBC-MD5" "DES-CBC-MD5" "DES-CBC3-MD5" "RC4-64-MD5" "NULL"
-
-               ;; mod_asis
-               "send-as-is"
-               ;; mod_cgi
-               "cgi-script"
-               ;; mod_imap
-               "imap-file"
-               ;; mod_info
-               "server-info"
-               ;; mod_isapi
-               "isapi-isa"
-               ;; mod_ldap
-               "ldap-status"
-               ;; mod_status
-               "server-status"
-
-               ;; mod_perl
-               "On" "Off" "perl-script"
-
-               ;; mod_python
-               "On" "Off" "python-program"
-
-               ) :test 'string=))
-           "\\)\\W")
-	  1 'font-lock-type-face)))
-  "Expressions to highlight in `apache-mode' buffers.")
-
-(put 'apache-mode 'font-lock-defaults
-     '(apache-font-lock-keywords nil t
-                                 ((?_ . "w")
-                                  (?- . "w"))))
-;; Syntax table
-(if apache-mode-syntax-table
-    nil
-  (setq apache-mode-syntax-table (copy-syntax-table nil))
-  (modify-syntax-entry ?_   "_"     apache-mode-syntax-table)
-  (modify-syntax-entry ?-   "_"     apache-mode-syntax-table)
-  (modify-syntax-entry ?\(  "(\)"   apache-mode-syntax-table)
-  (modify-syntax-entry ?\)  ")\("   apache-mode-syntax-table)
-  (modify-syntax-entry ?\<  "(\>"   apache-mode-syntax-table)
-  (modify-syntax-entry ?\>  ")\<"   apache-mode-syntax-table)
-  (modify-syntax-entry ?\"   "\""   apache-mode-syntax-table))
-
-
-;;;###autoload
-(defun apache-mode ()
-  "Major mode for editing Apache configuration files.
-
-\\{apache-mode-map}
-
-\\[apache-mode] runs the hook `apache-mode-hook'."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map apache-mode-map)
-  (set-syntax-table apache-mode-syntax-table)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#\\W*")
-  (make-local-variable 'comment-column)
-  (setq comment-column 48)
-  (setq mode-name "Apache")
-  (setq major-mode 'apache-mode)
-  (run-hooks 'apache-mode-hook))
-
-
-;; Provides
-(provide 'apache-mode)
-
-;;; apache-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/auto-autoloads.el b/xemacs-packages/lisp/text-modes/auto-autoloads.el
deleted file mode 100644
index 462f2694..00000000
--- a/xemacs-packages/lisp/text-modes/auto-autoloads.el
+++ /dev/null
@@ -1,904 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'text-modes-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "text-modes/_pkg.el")
-
-(package-provide 'text-modes :version 1.9 :author-version "No-Upstream-Ver" :type 'single-file)
-
-;;;***
-
-;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on) "ansi-color" "text-modes/ansi-color.el")
-
-(autoload 'ansi-color-for-comint-mode-on "ansi-color" "\
-Set `ansi-color-for-comint-mode' to t." t nil)
-
-(autoload 'ansi-color-process-output "ansi-color" "\
-Maybe translate SGR control sequences of comint output into text-properties.
-
-Depending on variable `ansi-color-for-comint-mode' the comint output is
-either not processed, SGR control sequences are filtered using
-`ansi-color-filter-region', or SGR control sequences are translated into
-text-properties using `ansi-color-apply-on-region'.
-
-The comint output is assumed to lie between the marker
-`comint-last-output-start' and the process-mark.
-
-This is a good function to put in `comint-output-filter-functions'." nil nil)
-
-;;;***
-
-;;;### (autoloads (apache-mode) "apache-mode" "text-modes/apache-mode.el")
-
-(defgroup apache nil "Major mode for editing Apache configuration files." :prefix "apache-" :group 'languages)
-
-(defcustom apache-file-patterns (list "\\.htaccess\\(\\.default\\)?$" "httpd\\.conf\\(\\.default\\)?$" "srm\\.conf\\(\\.default\\)?$" "access\\.conf\\(\\.default\\)?$") "*List of file patterns for which to automatically invoke `apache-mode'." :type '(repeat (regexp :tag "Pattern")) :group 'apache)
-
-(let ((apache-file-patterns-temp apache-file-patterns)) (while apache-file-patterns-temp (add-to-list 'auto-mode-alist (cons (car apache-file-patterns-temp) 'apache-mode)) (setq apache-file-patterns-temp (cdr apache-file-patterns-temp))))
-
-(autoload 'apache-mode "apache-mode" "\
-Major mode for editing Apache configuration files.
-
-\\{apache-mode-map}
-
-\\[apache-mode] runs the hook `apache-mode-hook'." t nil)
-
-;;;***
-
-;;;### (autoloads (define-auto-insert auto-insert) "autoinsert" "text-modes/autoinsert.el")
-
-(autoload 'auto-insert "autoinsert" "\
-Insert default contents into a new file if `auto-insert' is non-nil.
-Matches the visited file name against the elements of `auto-insert-alist'." t nil)
-
-(autoload 'define-auto-insert "autoinsert" "\
-Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
-Optional AFTER means to insert action after all existing actions for CONDITION,
-or if CONDITION had no actions, after all other CONDITIONs." nil nil)
-
-;;;***
-
-;;;### (autoloads (css-mode) "css-mode" "text-modes/css-mode.el")
-
-(autoload 'css-mode "css-mode" "\
-Major mode for editing CSS style sheets.
-\\{cssm-mode-map}" t nil)
-(add-to-list 'auto-mode-alist '("\\.css$" . css-mode))
-
-;;;***
-
-;;;### (autoloads (desktop-entry-mode) "desktop-entry-mode" "text-modes/desktop-entry-mode.el")
-
-(autoload 'desktop-entry-mode "desktop-entry-mode" "\
-Major mode for editing freedesktop.org desktop entry files.
-See <http://www.freedesktop.org/Standards/desktop-entry-spec> for more
-information.  See `desktop-entry-mode-version' for information about which
-version of the specification this mode is up to date with.
-
-Turning on desktop entry mode calls the value of the variable
-`desktop-entry-mode-hook' with no args, if that value is non-nil." t nil)
-(add-to-list 'auto-mode-alist '("\\.desktop\\(\\.in\\)?$" . desktop-entry-mode))
-
-;;;***
-
-;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off flyspell-version flyspell-mode flyspell-prog-mode) "flyspell" "text-modes/flyspell.el")
-
-(defcustom flyspell-mode-line-string " Fly" "*String displayed on the modeline when flyspell is active.\nSet this to nil if you don't want a modeline indicator." :group 'flyspell :type '(choice string (const :tag "None" nil)))
-
-(autoload 'flyspell-prog-mode "flyspell" "\
-Turn on `flyspell-mode' for comments and strings." t nil)
-
-(defvar flyspell-mode nil)
-
-(defvar flyspell-mode-map (make-sparse-keymap))
-
-(autoload 'flyspell-mode "flyspell" "\
-Minor mode performing on-the-fly spelling checking.
-Ispell is automatically spawned on background for each entered words.
-The default flyspell behavior is to highlight incorrect words.
-With no argument, this command toggles Flyspell mode.
-With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive.
-  
-Bindings:
-\\[ispell-word]: correct words (using Ispell).
-\\[flyspell-auto-correct-word]: automatically correct word.
-\\[flyspell-auto-correct-previous-word]: automatically correct the last misspelled word.
-\\[flyspell-correct-word] (or down-mouse-2): popup correct words.
-
-Hooks:
-This runs `flyspell-mode-hook' after flyspell is entered.
-
-Remark:
-`flyspell-mode' uses `ispell-mode'.  Thus all Ispell options are
-valid.  For instance, a personal dictionary can be used by
-invoking `ispell-change-dictionary'.
-
-Consider using the `ispell-parser' to check your text.  For instance
-consider adding:
-\(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
-in your .emacs file.
-
-\\[flyspell-region] checks all words inside a region.
-\\[flyspell-buffer] checks the whole buffer." t nil)
-
-(if (fboundp 'add-minor-mode) (add-minor-mode 'flyspell-mode 'flyspell-mode-line-string flyspell-mode-map nil 'flyspell-mode) (or (assoc 'flyspell-mode minor-mode-alist) (setq minor-mode-alist (cons '(flyspell-mode flyspell-mode-line-string) minor-mode-alist))) (or (assoc 'flyspell-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'flyspell-mode flyspell-mode-map) minor-mode-map-alist))))
-
-(autoload 'flyspell-version "flyspell" "\
-The flyspell version" t nil)
-
-(autoload 'flyspell-mode-off "flyspell" "\
-Turn Flyspell mode off." nil nil)
-
-(autoload 'flyspell-region "flyspell" "\
-Flyspell text between BEG and END." t nil)
-
-(autoload 'flyspell-buffer "flyspell" "\
-Flyspell whole buffer." t nil)
-
-;;;***
-
-;;;### (autoloads (folding-mode turn-on-folding-mode turn-off-folding-mode folding-mode-add-find-file-hook folding-keep-hooked folding-install-hooks folding-uninstall-hooks) "folding" "text-modes/folding.el")
-
-(defvar folding-mode nil "\
-When Non nil, Folding mode is active in the current buffer.")
-
-(defcustom folding-default-keys-function 'folding-bind-default-keys "*Function or list of functions used to define keys for Folding mode.\nPossible values are:\n  folding-bind-default-key\n	The standard keymap.\n\n  `folding-bind-backward-compatible-keys'\n	Keys used by older versions of Folding mode. This function\n	does not conform to Emacs 19.29 style conversions concerning\n	key bindings. The prefix key is C - c\n\n  `folding-bind-outline-compatible-keys'\n	Define keys compatible with Outline mode.\n\n  `folding-bind-foldout-compatible-keys'\n	Define some extra keys compatible with Foldout.\n\nAll except `folding-bind-backward-compatible-keys' used the value of\nthe variable `folding-mode-prefix-key' as prefix the key.\nThe default is C - c @" :type 'function :group 'folding)
-
-(defcustom folding-default-mouse-keys-function 'folding-bind-default-mouse "*Function to bind default mouse keys to `folding-mode-map'." :type 'function :group 'folding)
-
-(defcustom folding-inside-mode-name "Fld" "*Mode line addition to show inside levels of 'fold' ." :type 'string :group 'folding)
-
-(defcustom folding-mode-string "Fld" "*The minor mode string displayed when mode is on." :type 'string :group 'folding)
-
-(defcustom folding-mode-hook-no-regexp "RMAIL" "*Regexp which disable automatic folding mode turn on for certain files." :type 'string :group 'folding)
-
-(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.")
-
-(autoload 'folding-uninstall-hooks "folding" "\
-Remove hooks set by folding." nil nil)
-
-(autoload 'folding-install-hooks "folding" "\
-Install folding hooks." nil nil)
-
-(autoload 'folding-keep-hooked "folding" "\
-Make sure hooks are in their places." nil nil)
-
-(autoload 'folding-mode-add-find-file-hook "folding" "\
-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." t nil)
-
-(autoload 'turn-off-folding-mode "folding" "\
-Turn off folding." nil nil)
-
-(autoload 'turn-on-folding-mode "folding" "\
-Turn on folding." nil nil)
-
-(autoload 'folding-mode "folding" "\
-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 (`(interactive-p)' 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 `<major-mode-name>-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'." t nil)
-
-;;;***
-
-;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl" "text-modes/hexl.el")
-
-(autoload 'hexl-mode "hexl" "\
-\\<hexl-mode-map>A mode for editing binary files in hex dump format.
-This is not an ordinary major mode; it alters some aspects
-if the current mode's behavior, but not all; also, you can exit
-Hexl mode and return to the previous mode using `hexl-mode-exit'.
-
-This function automatically converts a buffer into the hexl format
-using the function `hexlify-buffer'.
-
-Each line in the buffer has an \"address\" (displayed in hexadecimal)
-representing the offset into the file that the characters on this line
-are at and 16 characters from the file (displayed as hexadecimal
-values grouped every 16 bits) and as their ASCII values.
-
-If any of the characters (displayed as ASCII characters) are
-unprintable (control or meta characters) they will be replaced as
-periods.
-
-If `hexl-mode' is invoked with an argument the buffer is assumed to be
-in hexl format.
-
-A sample format:
-
-  HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f     ASCII-TEXT
-  --------  ---- ---- ---- ---- ---- ---- ---- ----  ----------------
-  00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64  This is hexl-mod
-  00000010: 652e 2020 4561 6368 206c 696e 6520 7265  e.  Each line re
-  00000020: 7072 6573 656e 7473 2031 3620 6279 7465  presents 16 byte
-  00000030: 7320 6173 2068 6578 6164 6563 696d 616c  s as hexadecimal
-  00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74   ASCII.and print
-  00000050: 6162 6c65 2041 5343 4949 2063 6861 7261  able ASCII chara
-  00000060: 6374 6572 732e 2020 416e 7920 636f 6e74  cters.  Any cont
-  00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949  rol or non-ASCII
-  00000080: 2063 6861 7261 6374 6572 730a 6172 6520   characters.are 
-  00000090: 6469 7370 6c61 7965 6420 6173 2070 6572  displayed as per
-  000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e  iods in the prin
-  000000b0: 7461 626c 6520 6368 6172 6163 7465 7220  table character 
-  000000c0: 7265 6769 6f6e 2e0a                      region..
-
-Movement is as simple as movement in a normal emacs text buffer.  Most
-cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
-to move the cursor left, right, down, and up).
-
-Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are
-also supported.
-
-There are several ways to change text in hexl mode:
-
-ASCII characters (character between space (0x20) and tilde (0x7E)) are
-bound to self-insert so you can simply type the character and it will
-insert itself (actually overstrike) into the buffer.
-
-\\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if
-it isn't bound to self-insert.  An octal number can be supplied in place
-of another key to insert the octal number's ASCII representation.
-
-\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF)
-into the buffer at the current point.
-
-\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377)
-into the buffer at the current point.
-
-\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
-into the buffer at the current point.
-
-\\[hexl-mode-exit] will exit hexl-mode.
-
-Note: saving the file with any of the usual Emacs commands
-will actually convert it back to binary format while saving.
-
-You can use \\[hexl-find-file] to visit a file in Hexl mode.
-
-\\[describe-bindings] for advanced commands." t nil)
-
-(autoload 'hexl-find-file "hexl" "\
-Edit file FILENAME in hexl-mode.
-Switch to a buffer visiting file FILENAME, creating one if none exists." t nil)
-
-(autoload 'hexlify-buffer "hexl" "\
-Convert a binary buffer to hexl format.
-This discards the buffer's undo information." t nil)
-
-;;;***
-
-;;;### (autoloads (htmlize-many-files-dired htmlize-many-files htmlize-file htmlize-region htmlize-buffer) "htmlize" "text-modes/htmlize.el")
-
-(autoload 'htmlize-buffer "htmlize" "\
-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." t nil)
-
-(autoload 'htmlize-region "htmlize" "\
-Convert the region to HTML, preserving colors and decorations.
-See `htmlize-buffer' for details." t nil)
-
-(autoload 'htmlize-file "htmlize" "\
-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." t nil)
-
-(autoload 'htmlize-many-files "htmlize" "\
-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." t nil)
-
-(autoload 'htmlize-many-files-dired "htmlize" "\
-HTMLize dired-marked files." t nil)
-
-;;;***
-
-;;;### (autoloads (image-mode) "image-mode" "text-modes/image-mode.el")
-
-(defvar image-formats-alist '(("png" . png) ("gif" . gif) ("jpe?g" . jpeg) ("tiff?" . tiff) ("xbm" . xbm) ("xpm" . xpm) ("bmp" . bmp)))
-
-(autoload 'image-mode "image-mode" "\
-\\{image-mode-map}" t nil)
-
-(progn (setq format-alist (remove-if (lambda (x) (eq (nth 6 x) 'image-mode)) format-alist)) (dolist (format image-formats-alist) (let* ((re (car format)) (type (cdr format)) (regexp (concat "\\.\\(" re "\\|" (upcase re) "\\)\\'")) (item (cons regexp 'image-mode))) (and (featurep type) (add-to-list 'auto-mode-alist item)))))
-
-;;;***
-
-;;;### (autoloads (iso-accents-mode) "iso-acc" "text-modes/iso-acc.el")
-
-(autoload 'iso-accents-mode "iso-acc" "\
-Toggle ISO Accents mode, in which accents modify the following letter.
-This permits easy insertion of accented characters according to ISO-8859-1.
-When Iso-accents mode is enabled, accent character keys
-\(`, ', \", ^, / and ~) do not self-insert; instead, they modify the following
-letter key so that it inserts an ISO accented letter.
-
-You can customize ISO Accents mode to a particular language
-with the command `iso-accents-customize'.
-
-Special combinations: ~c gives a c with cedilla,
-~d gives an Icelandic eth (d with dash).
-~t gives an Icelandic thorn.
-\"s gives German sharp s.
-/a gives a with ring.
-/e gives an a-e ligature.
-~< and ~> give guillemots.
-~! gives an inverted exclamation mark.
-~? gives an inverted question mark.
-
-With an argument, a positive argument enables ISO Accents mode, 
-and a negative argument disables it." t nil)
-
-;;;***
-
-;;;### (autoloads (electric-nroff-mode nroff-mode) "nroff-mode" "text-modes/nroff-mode.el")
-
-(autoload 'nroff-mode "nroff-mode" "\
-Major mode for editing text intended for nroff to format.
-\\{nroff-mode-map}
-Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'.
-Also, try `nroff-electric-mode', for automatically inserting
-closing requests for requests that are used in matched pairs." t nil)
-
-(autoload 'electric-nroff-mode "nroff-mode" "\
-Toggle `nroff-electric-newline' minor mode.
-`nroff-electric-newline' forces Emacs to check for an nroff request at the
-beginning of the line, and insert the matching closing request if necessary.
-This command toggles that mode (off->on, on->off), with an argument,
-turns it on iff arg is positive, otherwise off." t nil)
-
-(defvar nroff-electric-mode nil "\
-Non-nil if in electric-nroff minor mode.")
-
-(add-minor-mode 'nroff-electric-mode " Electric" nil nil 'electric-nroff-mode)
-(add-to-list 'auto-mode-alist '("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode))
-(setq auto-mode-alist (append auto-mode-alist '(("\\.[123456789]\\'" . nroff-mode))))
-
-;;;***
-
-;;;### (autoloads (rtf-clip-region rtf-clip-buffer rtf-export-region rtf-export rtf-spool-buffer rtf-spool-region) "rtf-support" "text-modes/rtf-support.el")
-
-(defgroup rtf nil "Support RTF selections and spooling of RTF to a buffer." :group 'wp :tag "RTF")
-
-(autoload 'rtf-spool-region "rtf-support" "\
-Spool a buffer as Microsoft Rich Text Format text.
-Like `ps-spool-region', although the rtf-support code doesn't keep
-track of spooled regions to despool (because RTF isn't useful for
-printing). Returns the buffer containing the RTF." t nil)
-
-(autoload 'rtf-spool-buffer "rtf-support" "\
-Spool the entire buffer." t nil)
-
-(autoload 'rtf-export "rtf-support" "\
-Export the current document as RTF, preserving faces." t nil)
-
-(autoload 'rtf-export-region "rtf-support" "\
-Export the selected region as RTF, preserving faces." t nil)
-
-(autoload 'rtf-clip-buffer "rtf-support" "\
-Send the entire buffer to the clipboard as Rich Text Format. The function
-also copies the buffer as ordinary text, just for consistency." t nil)
-
-(autoload 'rtf-clip-region "rtf-support" "\
-Send the specified region (the selection if called interactively) to the
-clipboard as Rich Text Format. The function also copies the region in ordinary
-text, just for consistency." t nil)
-
-;;;***
-
-;;;### (autoloads (scribe-mode) "scribe" "text-modes/scribe.el")
-
-(autoload 'scribe-mode "scribe" "\
-Major mode for editing files of Scribe (a text formatter) source.
-Scribe-mode is similar text-mode, with a few extra commands added.
-\\{scribe-mode-map}
-
-Interesting variables:
-
-scribe-fancy-paragraphs
-  Non-nil makes Scribe mode use a different style of paragraph separation.
-
-scribe-electric-quote
-  Non-nil makes insert of double quote use `` or '' depending on context.
-
-scribe-electric-parenthesis
-  Non-nil makes an open-parenthesis char (one of `([<{')
-  automatically insert its close if typed after an @Command form." t nil)
-(add-to-list 'auto-mode-alist '("\\.mss\\'" . scribe-mode))
-
-;;;***
-
-;;;### (autoloads (tabify untabify) "tabify" "text-modes/tabify.el")
-
-(autoload 'untabify "tabify" "\
-Convert all tabs in region to multiple spaces, preserving columns.
-Called non-interactively, the region is specified by arguments
-START and END, rather than by the position of point and mark.
-The variable `tab-width' controls the spacing of tab stops." t nil)
-
-(autoload 'tabify "tabify" "\
-Convert multiple spaces in region to tabs when possible.
-A group of spaces is partially replaced by tabs
-when this can be done without changing the column they end at.
-Called non-interactively, the region is specified by arguments
-START and END, rather than by the position of point and mark.
-The variable `tab-width' controls the spacing of tab stops." t nil)
-
-;;;***
-
-;;;### (autoloads (tpum-global-mode tpum-minor-mode tpum-frame-popup-menu tpum-popup-menu) "tpum" "text-modes/tpum.el")
-
-(autoload 'tpum-popup-menu "tpum" "\
-Popup MENU in text mode.
-EVENT is not used." nil nil)
-
-(autoload 'tpum-frame-popup-menu "tpum" "\
-Popup MENU in separate frame.
-EVENT is some mouse event." nil nil)
-
-(autoload 'tpum-minor-mode "tpum" "\
-Toggle tpum minor mode.
-With prefix ARG, turn on if positive, otherwise off." t nil)
-
-(autoload 'tpum-global-mode "tpum" "\
-Toggle tpum global mode.
-With prefix ARG, turn on if positive, otherwise off." t nil)
-
-;;;***
-
-;;;### (autoloads (ununderline-and-unoverstrike-region overstrike-region unoverstrike-region ununderline-region underline-region) "underline" "text-modes/underline.el")
-
-(autoload 'underline-region "underline" "\
-Underline all nonblank characters in the region.
-Works by overstriking underscores.
-Called from program, takes two arguments START and END
-which specify the range to operate on." t nil)
-
-(autoload 'ununderline-region "underline" "\
-Remove all underlining (overstruck underscores) in the region.
-Called from program, takes two arguments START and END
-which specify the range to operate on." t nil)
-
-(autoload 'unoverstrike-region "underline" "\
-Remove all overstriking (character-backspace-character) in the region.
-Called from program, takes two arguments START and END which specify the
-range to operate on." t nil)
-
-(autoload 'overstrike-region "underline" "\
-Overstrike (character-backspace-character) all nonblank characters in
-the region. Called from program, takes two arguments START and END which
-specify the range to operate on." t nil)
-
-(autoload 'ununderline-and-unoverstrike-region "underline" "\
-Remove underlining and overstriking in the region.  Called from a program,
-takes two arguments START and END which specify the range to operate on." t nil)
-
-;;;***
-
-;;;### (autoloads (old-whitespace-incremental-mode old-whitespace-mode) "whitespace-mode" "text-modes/whitespace-mode.el")
-
-(defcustom old-whitespace-mode-line-string " WSP" "*String displayed on the modeline when old-whitespace-mode is active.\nSet this to nil if you don't want a modeline indicator." :group 'old-whitespace :type 'string)
-
-(defcustom old-whitespace-incremental-mode-line-string " WSPI" "*String displayed on the modeline when old-whitespace-incremental-mode\nis active. Set this to nil if you don't want a modeline indicator." :group 'old-whitespace :type 'string)
-
-(autoload 'old-whitespace-mode "whitespace-mode" "\
-Toggle whitespace mode.
-With arg, turn whitespace mode on iff arg is positive.
-In whitespace mode the different whitespaces (tab and blank)
-are highlighted with different faces. The faces are:
-`old-whitespace-blank-face' and `old-whitespace-tab-face'.
-Use the command `old-whitespace-show-faces' to show their values." t nil)
-
-(autoload 'old-whitespace-incremental-mode "whitespace-mode" "\
-Toggle whitespace incremental mode.
-With arg, turn whitespace incremental mode on iff arg is positive.
-In whitespace incremental mode the different whitespaces (tab and blank)
-are highlighted with different faces. The faces are:
-`old-whitespace-blank-face' and `old-whitespace-tab-face'.
-Use the command `old-whitespace-show-faces' to show their values.
-In this mode only these tabs and blanks are highlighted, which are in 
-the region from (point) - (window-height) to (point) + (window-height)." t nil)
-
-(if (fboundp 'add-minor-mode) (progn (add-minor-mode 'old-whitespace-mode old-whitespace-mode-line-string) (add-minor-mode 'old-whitespace-incremental-mode old-whitespace-incremental-mode-line-string)) (or (assq 'old-whitespace-mode minor-mode-alist) (setq minor-mode-alist (cons '(old-whitespace-mode old-whitespace-mode-line-string) minor-mode-alist))) (or (assq 'old-whitespace-incremental-mode minor-mode-alist) (setq minor-mode-alist (cons '(old-whitespace-incremental-mode old-whitespace-incremental-mode-line-string) minor-mode-alist))))
-
-;;;***
-
-;;;### (autoloads (whitespace-visual-incremental-mode whitespace-visual-mode) "whitespace-visual-mode" "text-modes/whitespace-visual-mode.el")
-
-(defcustom whitespace-visual-mode-line-string " WSP" "*String displayed on the modeline when whitespace-visual-mode is active.\nSet this to nil if you don't want a modeline indicator." :group 'whitespace-visual :type 'string)
-
-(defcustom whitespace-visual-incremental-mode-line-string " WSPI" "*String displayed on the modeline when whitespace-visual-incremental-mode\nis active. Set this to nil if you don't want a modeline indicator." :group 'whitespace-visual :type 'string)
-
-(autoload 'whitespace-visual-mode "whitespace-visual-mode" "\
-Toggle whitespace visual mode.
-With arg, turn whitespace visual mode on iff arg is positive.
-In whitespace visual mode the different whitespaces (tab and blank)
-are highlighted with different faces. The faces are:
-`whitespace-visual-blank-face' and `whitespace-visual-tab-face'.
-Use the command `whitespace-visual-show-faces' to show their values." t nil)
-
-(autoload 'whitespace-visual-incremental-mode "whitespace-visual-mode" "\
-Toggle whitespace visual incremental mode.
-With arg, turn whitespace-visual incremental mode on iff arg is positive.
-In whitespace visual incremental mode the different whitespaces (tab and
-blank) are highlighted with different faces. The faces are:
-`whitespace-visual-blank-face' and `whitespace-visual-tab-face'.
-Use the command `whitespace-visual-show-faces' to show their values.
-In this mode only these tabs and blanks are highlighted, which are in 
-the region from (point) - (window-height) to (point) + (window-height)." t nil)
-
-(if (fboundp 'add-minor-mode) (progn (add-minor-mode 'whitespace-visual-mode whitespace-visual-mode-line-string) (add-minor-mode 'whitespace-visual-incremental-mode whitespace-visual-incremental-mode-line-string)) (or (assq 'whitespace-visual-mode minor-mode-alist) (setq minor-mode-alist (cons '(whitespace-visual-mode whitespace-visual-mode-line-string) minor-mode-alist))) (or (assq 'whitespace-visual-incremental-mode minor-mode-alist) (setq minor-mode-alist (cons '(whitespace-visual-incremental-mode whitespace-visual-incremental-mode-line-string) minor-mode-alist))))
-
-;;;***
-
-;;;### (autoloads (whitespace-write-file-hook whitespace-cleanup-region whitespace-cleanup whitespace-region whitespace-buffer whitespace-toggle-ateol-check whitespace-toggle-spacetab-check whitespace-toggle-indent-check whitespace-toggle-trailing-check whitespace-toggle-leading-check) "whitespace" "text-modes/whitespace.el")
-
-(autoload 'whitespace-toggle-leading-check "whitespace" "\
-Toggle the check for leading space in the local buffer." t nil)
-
-(autoload 'whitespace-toggle-trailing-check "whitespace" "\
-Toggle the check for trailing space in the local buffer." t nil)
-
-(autoload 'whitespace-toggle-indent-check "whitespace" "\
-Toggle the check for indentation space in the local buffer." t nil)
-
-(autoload 'whitespace-toggle-spacetab-check "whitespace" "\
-Toggle the check for space-followed-by-TABs in the local buffer." t nil)
-
-(autoload 'whitespace-toggle-ateol-check "whitespace" "\
-Toggle the check for end-of-line space in the local buffer." t nil)
-
-(autoload 'whitespace-buffer "whitespace" "\
-Find five different types of white spaces in buffer.
-These are:
-1. Leading space (empty lines at the top of a file).
-2. Trailing space (empty lines at the end of a file).
-3. Indentation space (8 or more spaces, that should be replaced with TABS).
-4. Spaces followed by a TAB. (Almost always, we never want that).
-5. Spaces or TABS at the end of a line.
-
-Check for whitespace only if this buffer really contains a non-empty file
-and:
-1. the major mode is one of the whitespace-modes, or
-2. `whitespace-buffer' was explicitly called with a prefix argument." t nil)
-
-(autoload 'whitespace-region "whitespace" "\
-Check the region for whitespace errors." t nil)
-
-(autoload 'whitespace-cleanup "whitespace" "\
-Cleanup the five different kinds of whitespace problems.
-
-Use \\[describe-function] whitespace-describe to read a summary of the
-whitespace problems." t nil)
-
-(autoload 'whitespace-cleanup-region "whitespace" "\
-Whitespace cleanup on the region." t nil)
-(autoload 'whitespace-global-mode "whitespace" nil t)
-
-(autoload 'whitespace-write-file-hook "whitespace" "\
-Hook function to be called on the buffer when whitespace check is enabled.
-This is meant to be added buffer-locally to `write-file-functions'." t nil)
-
-;;;***
-
-;;;### (autoloads (winmgr-mode) "winmgr-mode" "text-modes/winmgr-mode.el")
-
-(autoload 'winmgr-mode "winmgr-mode" "\
-Major mode for editing winmgr config files." t nil)
-(add-to-list 'auto-mode-alist '("\\.[^/]*wm2?\\(?:rc\\)?\\'" . winmgr-mode))
-
-;;;***
-
-;;;### (autoloads (wordstar-mode) "ws-mode" "text-modes/ws-mode.el")
-
-(autoload 'wordstar-mode "ws-mode" "\
-Major mode with WordStar-like key bindings.
-
-BUGS:
- - Help menus with WordStar commands (C-j just calls help-for-help)
-   are not implemented
- - Options for search and replace
- - Show markers (C-k h) is somewhat strange
- - Search and replace (C-q a) is only available in forward direction
-
-No key bindings beginning with ESC are installed, they will work
-Emacs-like.
-
-The key bindings are:
-
-  C-a		backward-word
-  C-b		fill-paragraph
-  C-c		scroll-up-line
-  C-d		forward-char
-  C-e		previous-line
-  C-f		forward-word
-  C-g		delete-char
-  C-h		backward-char
-  C-i		indent-for-tab-command
-  C-j		help-for-help
-  C-k		wordstar-C-k-map
-  C-l		ws-repeat-search
-  C-n		open-line
-  C-p		quoted-insert
-  C-r		scroll-down-line
-  C-s		backward-char
-  C-t		kill-word
-  C-u		keyboard-quit
-  C-v		overwrite-mode
-  C-w		scroll-down
-  C-x		next-line
-  C-y		kill-complete-line
-  C-z		scroll-up
-
-  C-k 0		ws-set-marker-0
-  C-k 1		ws-set-marker-1
-  C-k 2		ws-set-marker-2
-  C-k 3		ws-set-marker-3
-  C-k 4		ws-set-marker-4
-  C-k 5		ws-set-marker-5
-  C-k 6		ws-set-marker-6
-  C-k 7		ws-set-marker-7
-  C-k 8		ws-set-marker-8
-  C-k 9		ws-set-marker-9
-  C-k b		ws-begin-block
-  C-k c		ws-copy-block
-  C-k d		save-buffers-kill-emacs
-  C-k f		find-file
-  C-k h		ws-show-markers
-  C-k i		ws-indent-block
-  C-k k		ws-end-block
-  C-k p		ws-print-block
-  C-k q		kill-emacs
-  C-k r		insert-file
-  C-k s		save-some-buffers
-  C-k t		ws-mark-word
-  C-k u		ws-exdent-block
-  C-k C-u	keyboard-quit
-  C-k v		ws-move-block
-  C-k w		ws-write-block
-  C-k x		kill-emacs
-  C-k y		ws-delete-block
-
-  C-o c		wordstar-center-line
-  C-o b		switch-to-buffer
-  C-o j		justify-current-line
-  C-o k		kill-buffer
-  C-o l		list-buffers
-  C-o m		auto-fill-mode
-  C-o r		set-fill-column
-  C-o C-u	keyboard-quit
-  C-o wd	delete-other-windows
-  C-o wh	split-window-horizontally
-  C-o wo	other-window
-  C-o wv	split-window-vertically
-
-  C-q 0		ws-find-marker-0
-  C-q 1		ws-find-marker-1
-  C-q 2		ws-find-marker-2
-  C-q 3		ws-find-marker-3
-  C-q 4		ws-find-marker-4
-  C-q 5		ws-find-marker-5
-  C-q 6		ws-find-marker-6
-  C-q 7		ws-find-marker-7
-  C-q 8		ws-find-marker-8
-  C-q 9		ws-find-marker-9
-  C-q a		ws-query-replace
-  C-q b		ws-to-block-begin
-  C-q c		end-of-buffer
-  C-q d		end-of-line
-  C-q f		ws-search
-  C-q k		ws-to-block-end
-  C-q l		ws-undo
-  C-q p		ws-last-cursorp
-  C-q r		beginning-of-buffer
-  C-q C-u	keyboard-quit
-  C-q w		ws-last-error
-  C-q y		ws-kill-eol
-  C-q DEL	ws-kill-bol
-" t nil)
-
-;;;***
-
-;;;### (autoloads (xpm-mode) "xpm-mode" "text-modes/xpm-mode.el")
-(add-to-list 'auto-mode-alist '("\\.xpm$" . xpm-mode))
-
-(autoload 'xpm-mode "xpm-mode" "\
-Treat the current buffer as an xpm file and colorize it.
-
-  Shift-button-1 lets you paint by dragging the mouse.  Shift-button-1 on a
-color definition line will change the current painting color to that line's
-value.
-
-  Characters inserted from the keyboard will NOT be colored properly yet.
-Use the mouse, or do xpm-init (\\[xpm-init]) after making changes.
-
-\\[xpm-add-color] Add a new color, prompting for character and value
-\\[xpm-show-image] show the current image at the top of the buffer
-\\[xpm-parse-color] parse the current line's color definition and add
-   it to the color table.  Provided as a means of changing colors.
-XPM minor mode bindings:
-\\{xpm-mode-map}" t nil)
-
-;;;***
-
-;;;### (autoloads (xrdb-mode) "xrdb-mode" "text-modes/xrdb-mode.el")
-
-(autoload 'xrdb-mode "xrdb-mode" "\
-Major mode for editing xrdb config files" t nil)
-(add-to-list 'auto-mode-alist '("[./\\]X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode))
-(add-to-list 'auto-mode-alist '("\\.ad\\'" . xrdb-mode))
-(add-to-list 'auto-mode-alist '("/app-defaults/" . xrdb-mode))
-
-;;;***
-
-(provide 'text-modes-autoloads)
diff --git a/xemacs-packages/lisp/text-modes/autoinsert.el b/xemacs-packages/lisp/text-modes/autoinsert.el
deleted file mode 100644
index 184867cf..00000000
--- a/xemacs-packages/lisp/text-modes/autoinsert.el
+++ /dev/null
@@ -1,281 +0,0 @@
-;;; autoinsert.el --- automatic mode-dependent insertion of text into new files
-;; Copyright (C) 1985, 1986, 1987, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Charlie Martin <crm@cs.duke.edu>
-;; Adapted-By: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;;  The following defines an association list for text to be
-;;  automatically inserted when a new file is created, and a function
-;;  which automatically inserts these files; the idea is to insert
-;;  default text much as the mode is automatically set using
-;;  auto-mode-alist.
-;;
-;;  To use: 
-;;     (add-hook 'find-file-hooks 'auto-insert)
-;;     setq auto-insert-directory to an appropriate slash-terminated value
-;;
-;;  Author:  Charlie Martin
-;;           Department of Computer Science and
-;;           National Biomedical Simulation Resource
-;;           Box 3709
-;;           Duke University Medical Center
-;;           Durham, NC 27710
-;;	      (crm@cs.duke.edu,mcnc!duke!crm) 
-
-;;; Code:
-
-(defgroup auto-insert nil
-  "Automatic mode-dependent insertion of text into new files."
-  :group 'tools)
-
-
-(defcustom auto-insert 'not-modified
-  "*Controls automatic insertion into newly found empty files:
-	nil	do nothing
-	t	insert if possible
-	other	insert if possible, but mark as unmodified.
-Insertion is possible when something appropriate is found in
-`auto-insert-alist'.  When the insertion is marked as unmodified, you can
-save it with  \\[write-file] RET.
-This variable is used when `auto-insert' is called as a function, e.g.
-when you do (add-hook 'find-file-hooks 'auto-insert).
-With \\[auto-insert], this is always treated as if it were `t'."
-  :type '(radio (const :tag "Do nothing" nil)
-		(const :tag "Insert if possible" t)
-		(sexp :format "%t\n"
-		      :tag "Insert if possible, but mark as unmodified"
-		      other))
-  :require 'autoinsert
-  :group 'auto-insert)
-
-
-(defcustom auto-insert-query 'function
-  "*If non-`nil', ask user before auto-inserting.
-When this is `function', only ask when called non-interactively."
-  :type '(choice (const :tag "Don't ask" nil)
-		 (const :tag "Ask when non-interactive" function)
-		 (sexp :format "%t\n" :tag "Ask" other))
-  :group 'auto-insert)
-
-
-(defcustom auto-insert-prompt "Perform %s auto-insertion? "
-  "*Prompt to use when querying whether to auto-insert.
-If this contains a %s, that will be replaced by the matching rule."
-  :type 'string
-  :group 'auto-insert)
-
-
-(defvar auto-insert-alist
-  '((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header")
-     (upcase (concat (file-name-nondirectory
-		      (substring buffer-file-name 0 (match-beginning 0)))
-		     "_"
-		     (substring buffer-file-name (1+ (match-beginning 0)))))
-     "#ifndef " str \n
-     "#define " str "\n\n"
-     _ "\n\n#endif")
-
-    (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program")
-     nil
-     "#include \""
-     ;; nop without latest cc-mode
-     (and (fboundp 'c-companion-file)
-	  ;(file-readable-p (c-companion-file 'name))
-	  (file-name-nondirectory (c-companion-file 'name))) & ?\"
-     | -10)
-
-    ("[Mm]akefile\\'" . "makefile.inc")
-
-    (html-mode . (lambda () (sgml-tag "html")))
-
-    (plain-tex-mode . "tex-insert.tex")
-    (bibtex-mode . "tex-insert.tex")
-    (latex-mode
-     ;; should try to offer completing read for these
-     "options, RET: "
-     "\\documentstyle[" str & ?\] | -1
-     ?{ (read-string "class: ") "}\n"
-     ("package, %s: "
-      "\\usepackage[" (read-string "options, RET: ") & ?\] | -1 ?{ str "}\n")
-     _ "\n\\begin{document}\n" _
-     "\n\\end{document}")
-
-    (("/bin/.*[^/]\\'" . "Shell-Script mode magic number")
-     lambda ()
-       (if (eq major-mode default-major-mode)
-	 (sh-mode)))
-    
-    (ada-mode . ada-header)
-
-    (("\\.el\\'" . "Emacs Lisp header")
-     "Short description: "
-     ";;; " (file-name-nondirectory (buffer-file-name)) " --- " str "
-
-;; Copyright (C) " (substring (current-time-string) -4) " by "
- (getenv "ORGANIZATION") | "Free Software Foundation, Inc." "
-
-;; Author: " (user-full-name)
-'(if (search-backward "&" (save-excursion (beginning-of-line 1) (point)) t)
-     (replace-match (capitalize (user-login-name)) t t))
-'(end-of-line 1) " <" (user-login-name) ?@ (system-name) ">
-;; Keywords: "
- '(require 'finder)
- ;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords)))
- '(setq v1 (mapcar (lambda (x) (list (symbol-name (car x))))
-		   finder-known-keywords)
-	v2 (mapconcat (lambda (x) (format "%10.0s:  %s" (car x) (cdr x)))
-	   finder-known-keywords
-	   "\n"))
- ((let ((minibuffer-help-form v2))
-    (completing-read "Keyword, C-h: " v1 nil t))
-    str ", ") & -2 "
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; " _ "
-
-;;; Code:
-
-
-(provide '" (file-name-sans-extension (file-name-nondirectory
-(buffer-file-name))) ")
-
-;;; " (file-name-nondirectory (buffer-file-name)) " ends here
-"))
-  "A list specifying text to insert by default into a new file.
-Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION).
-CONDITION maybe a regexp that must match the new file's name, or it may be
-a symbol that must match the major mode for this element to apply.
-Only the first matching element is effective.
-Optional DESCRIPTION is a string for filling `auto-insert-prompt'.
-ACTION may be a skeleton to insert (see `skeleton-insert'), an absolute
-file-name or one relative to `auto-insert-directory' or a function to call.
-ACTION may also be a vector containing several successive single actions as
-described above, e.g. [\"header.insert\" date-and-author-update].")
-
-
-;; Establish a default value for auto-insert-directory
-(defvar auto-insert-directory "~/insert/"
-  "*Directory from which auto-inserted files are taken.")
-
-
-;;;###autoload
-(defun auto-insert ()
-  "Insert default contents into a new file if `auto-insert' is non-nil.
-Matches the visited file name against the elements of `auto-insert-alist'."
-  (interactive)
-  (and (not buffer-read-only)
-       (or (eq this-command 'auto-insert)
-	   (and auto-insert
-		(bobp) (eobp)))
-       (let ((alist auto-insert-alist)
-	     case-fold-search cond desc action)
-	 (goto-char 1)
-	 ;; find first matching alist entry
-	 (while alist
-	   (if (atom (setq cond (car (car alist))))
-	       (setq desc cond)
-	     (setq desc (cdr cond)
-		   cond (car cond)))
-	   (if (if (symbolp cond)
-		   (eq cond major-mode)
-		 (string-match cond buffer-file-name))
-	       (setq action (cdr (car alist))
-		     alist nil)
-	     (setq alist (cdr alist))))
-
-	 ;; Now, if we found something, do it
-	 (and action
-	      (if (stringp action)
-		  (file-readable-p (concat auto-insert-directory action))
-		t)
-	      (if auto-insert-query
-		  (or (if (eq auto-insert-query 'function)
-			  (eq this-command 'auto-insert))
-		      (y-or-n-p (format auto-insert-prompt desc)))
-		t)
-	      (mapcar
-	       (lambda (action)
-		 (if (stringp action)
-		     (if (file-readable-p
-			  (setq action (concat auto-insert-directory action)))
-			 (insert-file-contents action))
-		   (save-window-excursion
-		     ;; make buffer visible before skeleton or function
-		     ;; which might ask the user for something
-		     (switch-to-buffer (current-buffer))
-		     (if (and (consp action)
-			      (not (eq (car action) 'lambda)))
-			 (skeleton-insert action)
-		       (funcall action)))))
-	       (if (vectorp action)
-		   action
-		 (vector action))))
-	 (and (buffer-modified-p)
-	      (not (eq this-command 'auto-insert))
-	      (set-buffer-modified-p (eq auto-insert t))))))
-
-
-;;;###autoload
-(defun define-auto-insert (key action &optional after)
-  "Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
-Optional AFTER means to insert action after all existing actions for CONDITION,
-or if CONDITION had no actions, after all other CONDITIONs."
-  (let ((elt (assoc key auto-insert-alist)))
-    (if elt
-	(setcdr elt
-		(if (vectorp (cdr elt))
-		    (vconcat (if after (cdr elt))
-			     (if (vectorp action) action (vector action))
-			     (if after () (cdr elt)))
-		  (if after
-		      (vector (cdr elt) action)
-		    (vector action (cdr elt)))))
-      (if after
-	  (nconc auto-insert-alist (list (cons key action)))
-	(setq auto-insert-alist (cons (cons key action)
-				      auto-insert-alist))))))
-
-(provide 'autoinsert)
-
-;;; autoinsert.el ends here
diff --git a/xemacs-packages/lisp/text-modes/crontab.el b/xemacs-packages/lisp/text-modes/crontab.el
deleted file mode 100644
index 5c126f55..00000000
--- a/xemacs-packages/lisp/text-modes/crontab.el
+++ /dev/null
@@ -1,162 +0,0 @@
-;; #(@) crontab.el - An Emacs function to assist in editing crontab entries
-;; Last edited: Fri Aug 18 12:19:22 1989 by chris (Christopher D. Orr) on lxn
-;;
-;; Version: 1.00 - Initial Creation of mode
-;;          1.01 - Added crontab-use-local-file variable
-;;          1.02 - Reworked most of the library to be cleaner.
-;;          1.03 - Now deletes blank lines in crontab entry
-
-;; Copyright (C) 1989 Christopher D. Orr (chris@lxn.eds.com)
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;
-;; TODO:
-;;
-
-;; Place the following line in your ~/.emacs file:
-;;    (autoload 'crontab-edit "crontab"
-;;              "Function to allow the easy editing of crontab files." t)
-;;
-
-(provide 'crontab-edit)
-
-;;; Local Variables.  Define these to your liking.
-
-(defgroup crontab nil
-  "Assist in editing crontab files."
-  :group 'languages)
-
-
-(defcustom crontab-filename "~/.crontab"
-  "*The name of the file to store the User's Crontab."
-  :type 'file
-  :group 'crontab)
-
-(defcustom crontab-directory "/usr/spool/cron/crontabs"
-  "*The name of the directory in which crontab stores it's entries."
-  :type 'file
-  :group 'crontab)
-
-(defcustom crontab-use-local-file nil
-  "*Non-nil means use file stored in User's Home directory, if it exists.
-Otherwise, always ask crontab for the current entry (maybe)."
-  :type 'boolean
-  :group 'crontab)
-
-(defcustom crontab-delete-blank-lines t
-  "*Non-nil means to delete any blank lines in the crontab file on save."
-  :type 'boolean
-  :group 'crontab)
-
-;;; Interactive Function called to edit a Crontab Entry.  It is called
-;;; instead of crontab-edit to allow for future automatic entries.
-
-(defun crontab-edit ()
-  "Function to allow the easy editing of crontab files."
-
-  (interactive)
-  (crontab-get))
-
-
-;;; Function to retrieve the crontab entry.  The Function will
-;;; retrieve the file (crontab-filename) first.  If the file does not
-;;; exists, a crontab -l command will be executed. 
-
-(defun crontab-get ()
-   "Retrieve a crontab file either using crontab -l or from the variable
-crontab-filename"
-   (message "Retrieving Crontab ... ")
-   (switch-to-buffer (create-file-buffer crontab-filename))
-   (erase-buffer)
-
-   (if (file-exists-p crontab-filename)
-       (if (file-newer-than-file-p (concat crontab-directory "/" (user-login-name)) (expand-file-name crontab-filename))
-	   (if (yes-or-no-p "Cron has a more recent copy of your crontab.  Use it ? ")
-	       (call-process "crontab" nil t t "-l")
-	     (insert-file crontab-filename))
-	 (if crontab-use-local-file
-	     (insert-file crontab-filename)
-	   (call-process "crontab" nil t t "-l")))
-     (if crontab-use-local-file
-	 (insert-file crontab-filename)
-       (call-process "crontab" nil t t "-l")))
-
-;; What if crontab returns a fatal ??????  Can't we check the errorlevel ????
-   (goto-char (point-min))
-   (if (search-forward-regexp "crontab:\\|no crontab for" nil t nil)
-       (erase-buffer))
-   (if (eobp)
-       (crontab-initialize))
-   (goto-line 6)
-   (setq buffer-file-name crontab-filename)
-   (set-buffer-modified-p nil)
-   (make-variable-buffer-local 'write-file-hooks)
-   (or (memq 'crontab-save write-file-hooks)
-       (setq write-file-hooks 
-	     (reverse (cons 'crontab-save (reverse write-file-hooks)))))
-   (message "Save file normally when finished to update cron."))
-
-
-;;; This function is called whenever a save-file operation is
-;;; performed in the crontab buffer.  It saves the crontab to the file
-;;; name (crontab-filename) and then removes the crontab buffer.
-
-(defun crontab-save ()
-  "Submit the edited crontab to the cron daemon for processing."
-
-  (when crontab-delete-blank-lines
-    (goto-char (point-min))
-    (while (not (eobp))
-      (delete-blank-lines)
-      (forward-line 1))
-    (redraw-display))
-
-  (setq write-file-hooks nil)
-  (let ((crontab-buffer (buffer-name)))
-    (basic-save-buffer)
-
-;; What if the call-process to crontab fails ???  Can we check for a fatal ???
-;;  (call-process "crontab" nil nil nil (expand-file-name crontab-filename))
-    (shell-command (concat "crontab " (expand-file-name crontab-filename)))
-
-    (switch-to-buffer (other-buffer))
-    (kill-buffer crontab-buffer))
-  (message (concat "Crontab saved as " crontab-filename " and submitted to cron."))
-;; fixed by Lynn D. Newton - 03/17/95
-  "")
-;; OLD
-;; nil)
-
-(defun crontab-initialize ()
-  "Create a default Crontab file if one does not exist or is empty.
-If the function (time-stamp) is available, the last modification time will
-be stamped to the file."
-
-   (insert "# Cron Table Entry for ")
-   (insert (user-login-name))
-   (insert " (")
-   (insert (user-full-name))
-   (insert ")\n# Last Edited: \n")
-   (insert "#\n")
-   (insert "# min    hr     day   mon    wday(0=sun)  cmd\n")
-   (insert "#\n"))
-
-;;; Watch out for the signature  :-)
diff --git a/xemacs-packages/lisp/text-modes/css-mode.el b/xemacs-packages/lisp/text-modes/css-mode.el
deleted file mode 100644
index 37ed092e..00000000
--- a/xemacs-packages/lisp/text-modes/css-mode.el
+++ /dev/null
@@ -1,626 +0,0 @@
-;;;; A major mode for editing CSS.
-
-;;; Adds font locking, some rather primitive indentation handling and
-;;; some typing help.
-;;;
-
-(defvar cssm-version "0.11"
-  "The current version number of `css-mode'.")
-
-;;; copyright (c) 1998 Lars Marius Garshol, larsga@ifi.uio.no
-;;; $Id: css-mode.el,v 1.9 2000/01/05 21:21:56 larsga Exp $
-
-;;; css-mode is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU General Public License
-;;; as published by the Free Software Foundation; either version 2
-;;; of the License, or (at your option) any later version.
-;;;
-;;; css-mode is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with css-mode; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
-
-; Send me an email if you want new features (or if you add them yourself).
-; I will do my best to preserve the API to functions not explicitly marked
-; as internal and variables shown as customizable. I make no promises about
-; the rest.
-
-; Bug reports are very welcome. New versions of the package will appear at
-; http://www.garshol.priv.no/download/software/css-mode/
-; You can register at the same address if you want to be notified when a
-; new version appears.
-
-; Thanks to Philippe Le Hegaret, Kjetil Kjernsmo, Alf-Ivar Holm and
-; Alfred Correira for much useful feedback. Alf-Ivar Holm also contributed
-; patches.
-
-; This version should be up to date with the following:
-; CSS1: http://www.w3.org/TR/1999/REC-CSS1-19990111
-; CSS2: http://www.w3.org/TR/1998/REC-CSS2-19980512
-
-; To install, put this in your .emacs:
-;
-; (autoload 'css-mode "css-mode")
-; (setq auto-mode-alist       
-;      (cons '("\\.css\\'" . css-mode) auto-mode-alist))
-
-;; Todo:
-
-; - must not color URL file name extensions as class selectors (*.css)
-; - color [] and url() constructs correctly, even if quoted strings present
-; - disregard anything inside strings
-
-;; Possible later additions:
-;
-; - forward/backward style/@media rule commands
-; - more complete syntax table
-
-;; Required modules
-
-(require 'apropos)
-(require 'font-lock)
-(require 'cl)
-
-;;; The code itself
-
-; Customizable variables:
-
-(defgroup css nil
-  "Major mode for editing CSS files."
-  :group 'languages
-  :group 'hypermedia
-  :prefix "cssm-")
-
-(defcustom cssm-indent-level 2
-  "*The indentation level inside @media rules."
-  :type 'integer
-  :group 'css)
-
-(defcustom cssm-mirror-mode t
-  "*Whether brackets, quotes etc should be mirrored automatically on insertion."
-  :type 'boolean
-  :group 'css)
-
-(defcustom cssm-newline-before-closing-bracket nil
-  "*In `cssm-mirror-mode', controls whether a newline should be inserted
-before the closing bracket or not."
-  :type 'boolean
-  :group 'css)
-
-(defcustom cssm-indent-function #'cssm-c-style-indenter
-  "*Which function to use when deciding which column to indent to.
-Built-in choices are `cssm-old-style-indenter' and `cssm-c-style-indenter'."
-  :type 'function
-  :group 'css)
-  
-; The rest of the code:
-
-(defvar cssm-properties
-  '(
-    "ascent"                        ;   2
-    "azimuth"                       ;   2
-    "background"                    ; 1 2
-    "background-attachment"         ; 1 2
-    "background-color"              ; 1 2
-    "background-image"              ; 1 2
-    "background-position"           ; 1 2
-    "background-repeat"             ; 1 2
-    "baseline"                      ;   2
-    "bbox"                          ;   2
-    "border"                        ; 1 2
-    "border-bottom"                 ; 1 2
-    "border-bottom-color"           ;   2
-    "border-bottom-style"           ;   2
-    "border-bottom-width"           ; 1 2
-    "border-color"                  ; 1 2
-    "border-collapse"               ;   2
-    "border-left"                   ; 1 2
-    "border-left-color"             ;   2
-    "border-left-style"             ;   2
-    "border-left-width"             ; 1 2
-    "border-right"                  ; 1 2
-    "border-right-color"            ;   2
-    "border-right-style"            ;   2
-    "border-right-width"            ; 1 2
-    "border-spacing"                ;   2
-    "border-style"                  ; 1 2
-    "border-top"                    ; 1 2
-    "border-top-color"              ;   2
-    "border-top-style"              ;   2
-    "border-top-width"              ; 1 2
-    "border-width"                  ; 1 2
-    "bottom"                        ;   2
-    "cap-height"                    ;   2
-    "caption-size"                  ;   2
-    ;"cell-spacing"                 ;   2         removed in PR-CSS2-19980324
-    "centerline"                    ;   2
-    "clear"                         ; 1 2
-    "clip"                          ;   2
-    "color"                         ; 1 2
-    ;"column-span"                  ;   2         removed in REC-CSS2-19980512
-    "content"                       ;   2
-    "counter-increment"             ;   2
-    "counter-reset"                 ;   2
-    "cue"                           ;   2
-    "cue-after"                     ;   2
-    "cue-before"                    ;   2
-    "cursor"                        ;   2
-    "definition-src"                ;   2
-    "descent"                       ;   2
-    "direction"                     ;   2
-    "display"                       ; 1 2
-    "elevation"                     ;   2
-    "empty-cells"                   ;   2
-    "float"                         ; 1 2
-    "font"                          ; 1 2
-    "font-family"                   ; 1 2
-    "font-size"                     ; 1 2
-    "font-size-adjust"              ;   2
-    "font-stretch"                  ;   2
-    "font-style"                    ; 1 2
-    "font-variant"                  ; 1 2
-    "font-weight"                   ; 1 2
-    "height"                        ; 1 2
-    "left"                          ;   2
-    "letter-spacing"                ; 1 2
-    "line-height"                   ; 1 2
-    "list-style"                    ; 1 2
-    "list-style-image"              ; 1 2
-    "list-style-position"           ; 1 2
-    "list-style-type"               ; 1 2
-    "margin"                        ; 1 2
-    "margin-bottom"                 ; 1 2
-    "margin-left"                   ; 1 2
-    "margin-right"                  ; 1 2
-    "margin-top"                    ; 1 2
-    "marker-offset"                 ;   2
-    "marks"                         ;   2
-    "mathline"                      ;   2
-    "max-height"                    ;   2
-    "max-width"                     ;   2
-    "min-height"                    ;   2
-    "min-width"                     ;   2
-    "orphans"                       ;   2
-    "outline"                       ;   2
-    "outline-color"                 ;   2
-    "outline-style"                 ;   2
-    "outline-width"                 ;   2
-    "overflow"                      ;   2
-    "padding"                       ; 1 2
-    "padding-bottom"                ; 1 2
-    "padding-left"                  ; 1 2
-    "padding-right"                 ; 1 2
-    "padding-top"                   ; 1 2
-    "page"                          ;   2
-    "page-break-after"              ;   2
-    "page-break-before"             ;   2
-    "page-break-inside"             ;   2
-    "panose-1"                      ;   2
-    "pause"                         ;   2
-    "pause-after"                   ;   2
-    "pause-before"                  ;   2
-    "pitch"                         ;   2
-    "pitch-range"                   ;   2
-    "play-during"                   ;   2
-    "position"                      ;   2
-    "quotes"                        ;   2
-    "richness"                      ;   2
-    "right"                         ;   2
-    ;"row-span"                     ;   2         removed in REC-CSS2-19980512
-    "size"                          ;   2
-    "slope"                         ;   2
-    "speak"                         ;   2
-    ;"speak-date"                   ;   2         removed in PR-CSS2-19980324
-    "speak-header"                  ;   2
-    "speak-numeral"                 ;   2
-    "speak-punctuation"             ;   2
-    ;"speak-time"                   ;   2         removed in PR-CSS2-19980324
-    "speech-rate"                   ;   2
-    "src"                           ;   2
-    "stemh"                         ;   2
-    "stemv"                         ;   2
-    "stress"                        ;   2
-    "table-layout"                  ;   2
-    "text-align"                    ; 1 2
-    "text-decoration"               ; 1 2
-    "text-indent"                   ; 1 2
-    "text-shadow"                   ;   2
-    "text-transform"                ; 1 2
-    "top"                           ;   2
-    "topline"                       ;   2
-    "unicode-bidi"                  ;   2
-    "unicode-range"                 ;   2
-    "units-per-em"                  ;   2
-    "vertical-align"                ; 1 2
-    "visibility"                    ;   2
-    "voice-family"                  ;   2
-    "volume"                        ;   2
-    "white-space"                   ; 1 2
-    "widows"                        ;   2
-    "width"                         ; 1 2
-    "widths"                        ;   2
-    "word-spacing"                  ; 1 2
-    "x-height"                      ;   2
-    "z-index"                       ;   2
-    )
-  "A list of all CSS properties and descriptors.")
-
-(defvar cssm-properties-alist
-  (mapcar (lambda(prop)
-            (cons (concat prop ":") nil)) cssm-properties)
-  "An association list of the CSS properties for completion use.")
-
-(defvar cssm-keywords
-  (append '(
-            "@charset"              ;   2
-            "@font-face"            ;   2
-            "@import"               ;   2
-            "!\\s-*important"       ; 1 2
-            "@media"                ;   2
-            "@page"                 ;   2
-            )
-          (mapcar (lambda(property)
-                    (concat property "\\s-*:"))
-                  cssm-properties)
-          )
-  "A list of all CSS keywords.")
-
-(defvar cssm-pseudos '(
-    "active"                        ; 1 2
-    "after"                         ;   2
-    "before"                        ;   2
-    "first-child"                   ;   2
-    "first-letter"                  ; 1 2
-    "first-line"                    ; 1 2
-    "focus"                         ;   2
-    "hover"                         ;   2
-    "lang"                          ;   2
-    "link"                          ; 1 2
-    "visited"                       ; 1 2
-    )
-  "A list of all CSS pseudo-classes and elements.")
-
-; internal
-(defun cssm-list-2-regexp(altlist)
-  "Takes a list and returns the regexp \\(elem1\\|elem2\\|...\\)"
-  (let ((regexp "\\("))
-    (mapcar (lambda(elem)
-              (setq regexp (concat regexp elem "\\|")))
-            altlist)
-    (concat (substring regexp 0 -2) ; cutting the last "\\|"
-            "\\)")
-    ))
-
-(defvar cssm-font-lock-keywords
-  (list
-   (cons (cssm-list-2-regexp cssm-keywords) font-lock-keyword-face)
-   (cons "\\.[a-zA-Z][-a-zA-Z0-9.]+" font-lock-variable-name-face)
-   (cons (concat ":" (cssm-list-2-regexp cssm-pseudos))
-         font-lock-variable-name-face)
-   (cons "#[a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\([a-fA-F0-9][a-fA-F0-9][a-fA-F0-9]\\)?"
-         font-lock-reference-face)
-   (cons "\\[.*\\]" font-lock-variable-name-face)
-   (cons "#[-a-zA-Z0-9]*" font-lock-function-name-face)
-   (cons "rgb(\\s-*[0-9]+\\(\\.[0-9]+\\s-*%\\s-*\\)?\\s-*,\\s-*[0-9]+\\(\\.[0-9]+\\s-*%\\s-*\\)?\\s-*,\\s-*[0-9]+\\(\\.[0-9]+\\s-*%\\s-*\\)?\\s-*)"
-         font-lock-reference-face)
-   )
-  "Rules for highlighting CSS style sheets.")
-
-(defvar cssm-mode-map ()
-  "Keymap used in CSS mode.")
-(when (not cssm-mode-map)
-  (setq cssm-mode-map (make-sparse-keymap))
-  (define-key cssm-mode-map (read-kbd-macro "C-c C-c") 'cssm-insert-comment)
-  (define-key cssm-mode-map (read-kbd-macro "C-c C-u") 'cssm-insert-url)
-  (define-key cssm-mode-map (read-kbd-macro "}") 'cssm-insert-right-brace-and-indent)
-  (define-key cssm-mode-map (read-kbd-macro "M-TAB") 'cssm-complete-property))
-
-;;; Cross-version compatibility layer
-
-(when (not (or (apropos-macrop 'kbd)
-               (fboundp 'kbd)))
-  (defmacro kbd (keys)
-    "Convert KEYS to the internal Emacs key representation.
-KEYS should be a string constant in the format used for
-saving keyboard macros (see `insert-kbd-macro')."
-    (read-kbd-macro keys)))
-
-;;; Auto-indentation support
-
-; internal
-(defun cssm-insert-right-brace-and-indent()
-  (interactive)
-  (insert "}")
-  (cssm-indent-line))
-
-; internal
-(defun cssm-inside-atmedia-rule()
-  "Decides if point is currently inside an @media rule."
-  (let ((orig-pos (point))
-        (atmedia (re-search-backward "@media" 0 t))
-        (balance 1)   ; used to keep the {} balance, 1 because we start on a {
-        )
-    ; Going to the accompanying {
-    (re-search-forward "{" (point-max) t)
-    (if (null atmedia)
-        nil  ; no @media before this point => not inside
-      (while (and (< (point) orig-pos)
-                  (< 0 balance))
-        (if (null (re-search-forward "[{}]" (point-max) 0))
-            (goto-char (point-max)) ; break
-          (setq balance
-                (if (string= (match-string 0) "{")
-                    (+ balance 1)
-                  (- balance 1)))))
-      (= balance 1))
-    ))
-
-; internal
-(defun cssm-rule-is-atmedia()
-  "Decides if point is currently on the { of an @media or ordinary style rule."
-  (let ((result (re-search-backward "[@}{]" 0 t)))
-    (if (null result)
-        nil
-      (string= (match-string 0) "@"))))
-
-; internal
-(defun cssm-find-column(first-char)
-  "Find which column to indent to." 
-
-  ; Find out where to indent to by looking at previous lines
-  ; spinning backwards over comments
-  (let (pos)
-    (while (and (setq pos (re-search-backward (cssm-list-2-regexp
-                                               '("/\\*" "\\*/" "{" "}"))
-                                              (point-min) t))
-                (string= (match-string 0) "*/"))
-      (search-backward "/*" (point-min) t))
-
-    ; did the last search find anything?
-    (if pos
-        (save-excursion
-          (let ((construct      (match-string 0))
-                (column         (current-column)))
-            (apply cssm-indent-function
-                   (list (cond
-                          ((string= construct "{")
-                           (cond
-                            ((cssm-rule-is-atmedia)
-                             'inside-atmedia)
-                            ((cssm-inside-atmedia-rule)
-                             'inside-rule-and-atmedia)
-                            (t
-                             'inside-rule)))
-                          ((string= construct "/*")
-                           'inside-comment)
-                          ((string= construct "}")
-                           (if (cssm-inside-atmedia-rule)
-                               'inside-atmedia
-                             'outside))
-                          (t 'outside))
-                         column
-                         first-char))))
-      
-      (apply cssm-indent-function
-             (list 'outside
-                   (current-column)
-                   first-char)))))
-
-(defun cssm-indent-line()
-  "Indents the current line."
-  (interactive)
-  (beginning-of-line)
-  (let* ((beg-of-line (point))
-         (pos (re-search-forward "[]@#a-zA-Z0-9;,.\"{}/*\n:[]" (point-max) t))
-         (first (match-string 0))
-         (start (match-beginning 0)))
-
-    (goto-char beg-of-line)
-
-    (let ((indent-column (cssm-find-column first)))
-      (goto-char beg-of-line)
-
-      ; Remove all leading whitespace on this line (
-      (if (not (or (null pos)
-                   (= beg-of-line start)))
-          (kill-region beg-of-line start))
-
-      (goto-char beg-of-line)
-    
-      ; Indent
-      (indent-to indent-column))))
-
-;;; Indent-style functions
-
-(defun cssm-old-style-indenter(position column first-char-on-line)
-  "Old-style indentation for CSS buffers."
-  (cond
-   ((eq position 'inside-atmedia)
-    (if (string= "}" first-char-on-line)
-        0
-      cssm-indent-level))
-   
-   ((eq position 'inside-rule)
-    (+ column 2))
-
-   ((eq position 'inside-rule-and-atmedia)
-    (+ column 2))
-
-   ((eq position 'inside-comment)
-    (+ column 3))
-
-   ((eq position 'outside)
-    0)))
-
-(defun cssm-c-style-indenter(position column first-char-on-line)
-  "C-style indentation for CSS buffers."
-  (cond
-   ((or (eq position 'inside-atmedia)
-        (eq position 'inside-rule))
-    (if (string= "}" first-char-on-line)
-        0
-      cssm-indent-level))
-
-   ((eq position 'inside-rule-and-atmedia)
-    (if (string= "}" first-char-on-line)
-        cssm-indent-level
-      (* 2 cssm-indent-level)))
-
-   ((eq position 'inside-comment)
-    (+ column 3))
-
-   ((eq position 'outside)
-    0)))
-
-;;; Typing shortcuts
-
-(define-skeleton cssm-insert-curlies
-  "Inserts a pair of matching curly parenthesises." nil
-  "{ " _ (if cssm-newline-before-closing-bracket "\n" " ")
-  "}")
-
-(define-skeleton cssm-insert-quotes
-  "Inserts a pair of matching quotes." nil
-  "\"" _ "\"")
-
-(define-skeleton cssm-insert-parenthesises
-  "Inserts a pair of matching parenthesises." nil
-  "(" _ ")")
-
-(define-skeleton cssm-insert-comment
-  "Inserts a full comment." nil
-  "/* " _ " */")
-
-(define-skeleton cssm-insert-url
-  "Inserts a URL." nil
-  "url(" _ ")")
-
-(define-skeleton cssm-insert-brackets
-  "Inserts a pair of matching brackets." nil
-  "[" _ "]")
-
-(defun cssm-enter-mirror-mode()
-  "Turns on mirror mode, where quotes, brackets etc are mirrored automatically
-   on insertion."
-  (interactive)
-  (define-key cssm-mode-map (read-kbd-macro "{")  'cssm-insert-curlies)
-  (define-key cssm-mode-map (read-kbd-macro "\"") 'cssm-insert-quotes)
-  (define-key cssm-mode-map (read-kbd-macro "(")  'cssm-insert-parenthesises)
-  (define-key cssm-mode-map (read-kbd-macro "[")  'cssm-insert-brackets))
-
-(defun cssm-leave-mirror-mode()
-  "Turns off mirror mode."
-  (interactive)
-  (define-key cssm-mode-map (read-kbd-macro "{")  'self-insert-command)
-  (define-key cssm-mode-map (read-kbd-macro "\"") 'self-insert-command)
-  (define-key cssm-mode-map (read-kbd-macro "(")  'self-insert-command)
-  (define-key cssm-mode-map (read-kbd-macro "[")  'self-insert-command))
-
-;;; Property completion
-
-(defun cssm-property-at-point()
-  "If point is at the end of a property name: returns it."
-  (let ((end (point))
-        (start (+ (re-search-backward "[^-A-Za-z]") 1)))
-    (goto-char end)
-    (buffer-substring start end)))
-
-; internal
-(defun cssm-maximum-common(alt1 alt2)
-  "Returns the maximum common starting substring of alt1 and alt2."
-  (let* ((maxlen (min (length alt1) (length alt2)))
-         (alt1 (substring alt1 0 maxlen))
-         (alt2 (substring alt2 0 maxlen)))
-    (while (not (string= (substring alt1 0 maxlen)
-                         (substring alt2 0 maxlen)))
-      (setq maxlen (- maxlen 1)))
-    (substring alt1 0 maxlen)))
-
-; internal
-(defun cssm-common-beginning(alts)
-  "Returns the maximum common starting substring of all alts elements."
-  (let ((common (car alts)))
-    (dolist (alt (cdr alts) common)
-      (setq common (cssm-maximum-common alt common)))))
-
-(defun cssm-complete-property-frame(completions)
-  ; This code stolen from message.el. Kudos to larsi.
-  (let ((cur (current-buffer)))
-    (pop-to-buffer "*Completions*")
-    (buffer-disable-undo (current-buffer))
-    (let ((buffer-read-only nil))
-      (erase-buffer)
-      (let ((standard-output (current-buffer)))
-        (display-completion-list (sort completions 'string<)))
-      (goto-char (point-min))
-      (pop-to-buffer cur))))
-
-(defun cssm-complete-property()
-  "Completes the CSS property being typed at point."
-  (interactive)
-  (let* ((prop   (cssm-property-at-point))
-         (alts   (all-completions prop cssm-properties-alist))
-         (proplen (length prop)))
-    (if (= (length alts) 1)
-        (insert (substring (car alts) proplen))
-      (let ((beg (cssm-common-beginning alts)))
-        (if (not (string= beg prop))
-            (insert (substring beg proplen))
-          (insert (substring
-                   (completing-read "Property: " cssm-properties-alist nil
-                                    nil prop)
-                   proplen)))))))
-
-;;;###autoload
-(defun css-mode()
-  "Major mode for editing CSS style sheets.
-\\{cssm-mode-map}"
-  (interactive)
-
-  ; Initializing
-  (kill-all-local-variables)
-
-  ; Setting up indentation handling
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'cssm-indent-line)
-  
-  ; Setting up font-locking
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(cssm-font-lock-keywords nil t nil nil))
-
-  ; Setting up typing shortcuts
-  (make-local-variable 'skeleton-end-hook)
-  (setq skeleton-end-hook nil)
-  
-  (when cssm-mirror-mode
-    (cssm-enter-mirror-mode))
-  
-  (use-local-map cssm-mode-map)
-  
-  ; Setting up syntax recognition
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-end)
-  (make-local-variable 'comment-start-skip)
-
-  (setq comment-start "/* "
-        comment-end " */"
-        comment-start-skip "/\\*[ \n\t]+")
-
-  ; Setting up syntax table
-  (modify-syntax-entry ?* ". 23")
-  (modify-syntax-entry ?/ ". 14")
-  
-  ; Final stuff, then we're done
-  (setq mode-name "CSS"
-        major-mode 'css-mode)
-  (run-hooks 'css-mode-hook))
-
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.css$" . css-mode))
-
-(provide 'css-mode)
-
-;; CSS-mode ends here
diff --git a/xemacs-packages/lisp/text-modes/custom-load.el b/xemacs-packages/lisp/text-modes/custom-load.el
deleted file mode 100644
index fd654e1a..00000000
--- a/xemacs-packages/lisp/text-modes/custom-load.el
+++ /dev/null
@@ -1,47 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'filladapt '("filladapt"))
-(custom-add-loads 'apache '("apache-mode" "auto-autoloads"))
-(custom-add-loads 'rtf '("rtf-support"))
-(custom-add-loads 'convenience '("whitespace"))
-(custom-add-loads 'environment '("tpum"))
-(custom-add-loads 'xrdb '("xrdb-mode"))
-(custom-add-loads 'ispell '("flyspell"))
-(custom-add-loads 'tpum '("tpum"))
-(custom-add-loads 'tpum-faces '("tpum"))
-(custom-add-loads 'tools '("autoinsert" "folding"))
-(custom-add-loads 'whitespace-visual '("whitespace-visual-mode"))
-(custom-add-loads 'hypermedia '("css-mode" "htmlize"))
-(custom-add-loads 'tpum-face '("tpum"))
-(custom-add-loads 'desktop-entry '("desktop-entry-mode"))
-(custom-add-loads 'css '("css-mode"))
-(custom-add-loads 'outlines '("whitespace-mode" "whitespace-visual-mode"))
-(custom-add-loads 'hexl '("hexl"))
-(custom-add-loads 'old-whitespace '("whitespace-mode"))
-(custom-add-loads 'data '("hexl"))
-(custom-add-loads 'crontab '("crontab"))
-(custom-add-loads 'ansi-colors '("ansi-color"))
-(custom-add-loads 'scribe '("scribe"))
-(custom-add-loads 'auto-insert '("autoinsert"))
-(custom-add-loads 'htmlize '("htmlize"))
-(custom-add-loads 'desktop-entry-faces '("desktop-entry-mode"))
-(custom-add-loads 'flyspell '("flyspell"))
-(custom-add-loads 'languages '("auto-autoloads" "crontab" "css-mode" "desktop-entry-mode" "winmgr-mode" "xrdb-mode"))
-(custom-add-loads 'fill '("filladapt"))
-(custom-add-loads 'folding '("folding"))
-(custom-add-loads 'faces '("desktop-entry-mode" "tpum" "whitespace"))
-(custom-add-loads 'processes '("ansi-color" "flyspell"))
-(custom-add-loads 'wp '("rtf-support" "scribe"))
-(custom-add-loads 'po '("po-mode"))
-(custom-add-loads 'whitespace-faces '("whitespace"))
-(custom-add-loads 'whitespace '("whitespace"))
-(custom-add-loads 'editing '("whitespace"))
-(custom-add-loads 'matching '("whitespace-mode" "whitespace-visual-mode"))
-(custom-add-loads 'winmgr '("winmgr-mode"))
-(custom-add-loads 'i18n '("po-mode"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/text-modes/desktop-entry-mode.el b/xemacs-packages/lisp/text-modes/desktop-entry-mode.el
deleted file mode 100644
index d2cb3430..00000000
--- a/xemacs-packages/lisp/text-modes/desktop-entry-mode.el
+++ /dev/null
@@ -1,197 +0,0 @@
-;;; desktop-entry-mode.el --- freedesktop.org desktop entry editing
-
-;; Copyright (C) 2003-2004, Ville Skyttä, <scop at xemacs.org>
-
-;; Author:   Ville Skyttä, <scop at xemacs.org>
-;; Keywords: unix, desktop entry
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; 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 mode provides basic functionality, eg. syntax highlighting and
-;; validation for freedesktop.org desktop entry files.
-;;
-;; To install it:
-;;
-;;   In XEmacs:
-;;   Just install the XEmacs `text-modes' package, this mode is included.
-;;   See <http://www.xemacs.org/Documentation/packageGuide.html>.
-;;
-;;   In GNU Emacs:
-;;   Place this file in your load path somewhere (eg. site-lisp), and add
-;;   the following to your .emacs:
-;;
-;;   (autoload 'desktop-entry-mode "desktop-entry-mode" "Desktop Entry mode" t)
-;;   (add-to-list 'auto-mode-alist
-;;                '("\\.desktop\\(\\.in\\)?$" . desktop-entry-mode))
-;;   (add-hook 'desktop-entry-mode-hook 'turn-on-font-lock)
-;;
-;; For more information about desktop entry files, see
-;;   <http://www.freedesktop.org/Standards/desktop-entry-spec>
-;;
-;; This version is up to date with version 0.9.4 of the specification.
-
-;;; Code:
-
-(defconst desktop-entry-mode-version "0.94 (spec 0.9.4)"
-  "Version of `desktop-entry-mode'.")
-
-(defgroup desktop-entry nil
-  "Support for editing freedesktop.org desktop entry files."
-  :group 'languages)
-
-(defcustom desktop-entry-validate-command "desktop-file-validate"
-  "*Command for validating desktop entry files."
-  :type 'string
-  :group 'desktop-entry)
-
-(defgroup desktop-entry-faces nil
-  "Font lock faces for `desktop-entry-mode'."
-  :prefix "desktop-entry-"
-  :group 'desktop-entry
-  :group 'faces)
-
-(defface desktop-entry-group-header-face
-  '((((class color) (background light)) (:foreground "mediumblue" :bold t))
-    (((class color) (background dark)) (:foreground "lightblue" :bold t))
-    (t (:bold t)))
-  "*Face for highlighting desktop entry group headers."
-  :group 'desktop-entry-faces)
-
-(defface desktop-entry-value-face
-  '((((class color) (background light)) (:foreground "darkgreen"))
-    (((class color) (background dark)) (:foreground "lightgreen"))
-    )
-  "*Face for highlighting desktop entry values."
-  :group 'desktop-entry-faces)
-
-(defface desktop-entry-locale-face
-  '((((class color) (background light)) (:foreground "dimgray"))
-    (((class color) (background dark)) (:foreground "lightgray"))
-    )
-  "*Face for highlighting desktop entry locales."
-  :group 'desktop-entry-faces)
-
-(defconst desktop-entry-keywords
-  (eval-when-compile
-    (require 'regexp-opt)
-    (concat
-     "\\(?:"
-     (regexp-opt
-      '(
-        "Type"
-        "Version"
-        "Encoding"
-        "Name"
-        "GenericName"
-        "NoDisplay"
-        "Comment"
-        "Icon"
-        "Hidden"
-        "FilePattern"
-        "TryExec"
-        "Exec"
-        "Path"
-        "Terminal"
-        "SwallowTitle"
-        "SwallowExec"
-        "Actions"
-        "MimeType"
-        "SortOrder"
-        "Dev"
-        "FSType"
-        "MountPoint"
-        "ReadOnly"
-        "UnmountIcon"
-        "URL"
-        "Categories"
-        "OnlyShowIn"
-        "NotShowIn"
-        "StartupNotify"
-        "StartupWMClass"
-        ;; Reserved for use with KDE as of spec 0.9.4.
-        "ServiceTypes"
-        "DocPath"
-        "KeyWords"
-        "InitialPreference"
-        ) 'words)
-     "\\|X-[A-Za-z0-9-]+\\)"))
-  "Expression for matching desktop entry keys.")
-
-(defconst desktop-entry-group-header-re
-  "^\\[\\(X-[^\][]+\\|\\(?:Desktop \\(?:Entry\\|Action [a-zA-Z]+\\)\\)\\)\\]"
-  "Regular expression for matching desktop entry group headers.")
-
-(defconst desktop-entry-font-lock-keywords
-  (list
-   (cons "^\\s-*#.*$" '(0 'font-lock-comment-face))
-   (cons (concat "^" desktop-entry-keywords) '(0 'font-lock-keyword-face))
-   (cons desktop-entry-group-header-re '(1 'desktop-entry-group-header-face))
-   (cons "^[A-Za-z0-9-]+?\\s-*=\\s-*\\(.*\\)"
-         '(1 'desktop-entry-value-face))
-   (cons "^[A-Za-z0-9-]+?\\[\\([^\]]+\\)\\]\\s-*=\\s-*\\(.*\\)"
-         '((1 'desktop-entry-locale-face)
-           (2 'desktop-entry-value-face)))
-   )
-  "Highlighting rules for `desktop-entry-mode' buffers.")
-
-(defvar desktop-entry-imenu-generic-expression
-  `((nil ,desktop-entry-group-header-re 1))
-  "Imenu generic expression for `desktop-entry-mode'.
-See `imenu-generic-expression'.")
-
-;;;###autoload
-(defun desktop-entry-mode ()
-  "Major mode for editing freedesktop.org desktop entry files.
-See <http://www.freedesktop.org/Standards/desktop-entry-spec> for more
-information.  See `desktop-entry-mode-version' for information about which
-version of the specification this mode is up to date with.
-
-Turning on desktop entry mode calls the value of the variable
-`desktop-entry-mode-hook' with no args, if that value is non-nil."
-  (interactive)
-  (set (make-local-variable 'imenu-generic-expression)
-       '((nil "^\\s-*\\(.*\\)\\s-*=" 1)))
-  (set (make-local-variable 'compile-command)
-       (concat desktop-entry-validate-command " " buffer-file-name))
-  (set (make-local-variable 'compilation-buffer-name-function)
-       (lambda (x) (concat "*desktop-file-validate "
-                           (file-name-nondirectory buffer-file-name) "*")))
-  (set (make-local-variable 'comment-start) "# ")
-  (set (make-local-variable 'comment-end) "")
-  (set (make-local-variable 'comment-start-skip) "#+ *")
-  (setq major-mode 'desktop-entry-mode mode-name "Desktop Entry")
-  (set (make-local-variable 'imenu-generic-expression)
-       desktop-entry-imenu-generic-expression)
-  (unless (featurep 'xemacs) ;; font-lock support for GNU Emacs
-    (set (make-local-variable 'font-lock-defaults)
-         '(desktop-entry-font-lock-keywords)))
-  (run-hooks 'desktop-entry-mode-hook))
-
-(defun desktop-entry-validate ()
-  "Validate desktop entry in the current buffer."
-  (interactive)
-  (require 'compile)
-  (compile compile-command))
-
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.desktop\\(\\.in\\)?$" . desktop-entry-mode))
-
-(provide 'desktop-entry-mode)
-
-;;; desktop-entry-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/filladapt.el b/xemacs-packages/lisp/text-modes/filladapt.el
deleted file mode 100644
index 5555d540..00000000
--- a/xemacs-packages/lisp/text-modes/filladapt.el
+++ /dev/null
@@ -1,988 +0,0 @@
-;;; 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")
-
-  ;; ensure beg <= end as in core version of fill-region
-  (let ((newbeg (min beg end))
-        (newend (max beg end)))
-    (setq beg newbeg)
-    (setq end newend))
-
-  (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/xemacs-packages/lisp/text-modes/flyspell.el b/xemacs-packages/lisp/text-modes/flyspell.el
deleted file mode 100644
index de4959a3..00000000
--- a/xemacs-packages/lisp/text-modes/flyspell.el
+++ /dev/null
@@ -1,2198 +0,0 @@
-;;; <pre>
-;;; flyspell.el --- on-the-fly spell checker
-
-;; Copyright (C) 1998, 2000, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: Manuel Serrano <Manuel.Serrano@unice.fr>
-;; Keywords: convenience
-
-;; 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:
-;;
-;; Flyspell is a minor Emacs mode performing on-the-fly spelling
-;; checking.
-;;
-;; To enable Flyspell minor mode, type M-x flyspell-mode.
-;; This applies only to the current buffer.
-;;
-;; To enable Flyspell in text representing computer programs, type
-;; M-x flyspell-prog-mode.
-;; In that mode only text inside comments is checked.
-;;                                                                  
-;; Note: consider setting the variable ispell-parser to `tex' to
-;; avoid TeX command checking; use `(setq ispell-parser 'tex)'.
-;;                                                                  
-;; Some user variables control the behavior of flyspell.  They are
-;; those defined under the `User variables' comment.
-
-;;; Code:
-(require 'ispell)
-
-;*---------------------------------------------------------------------*/
-;*    Group ...                                                        */
-;*---------------------------------------------------------------------*/
-(defgroup flyspell nil
-  "Spell checking on the fly."
-  :tag "FlySpell"
-  :prefix "flyspell-"
-  :group 'ispell
-  :group 'processes)
-
-;*---------------------------------------------------------------------*/
-;*    Which emacs are we currently running                             */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-emacs
-  (cond
-   ((string-match "XEmacs" emacs-version)
-    'xemacs)
-   (t
-    'emacs))
-  "The type of Emacs we are currently running.")
-
-(defvar flyspell-use-local-map
-  (or (eq flyspell-emacs 'xemacs)
-      (not (string< emacs-version "20"))))
-
-;*---------------------------------------------------------------------*/
-;*    User configuration ...                                           */
-;*---------------------------------------------------------------------*/
-(defcustom flyspell-highlight-flag t
-  "*How Flyspell should indicate misspelled words.
-Non-nil means use highlight, nil means use minibuffer messages."
-  :group 'flyspell
-  :type 'boolean)
-
-(defcustom flyspell-mark-duplications-flag t
-  "*Non-nil means Flyspell reports a repeated word as an error."
-  :group 'flyspell
-  :type 'boolean)
-
-(defcustom flyspell-sort-corrections nil
-  "*Non-nil means, sort the corrections alphabetically before popping them."
-  :group 'flyspell
-  :version "21.1"
-  :type 'boolean)
-
-(defcustom flyspell-duplicate-distance -1
-  "*The maximum distance for finding duplicates of unrecognized words.
-This applies to the feature that when a word is not found in the dictionary,
-if the same spelling occurs elsewhere in the buffer,
-Flyspell uses a different face (`flyspell-duplicate-face') to highlight it.
-This variable specifies how far to search to find such a duplicate.
--1 means no limit (search the whole buffer).
-0 means do not search for duplicate unrecognized spellings."
-  :group 'flyspell
-  :version "21.1"
-  :type 'number)
-
-(defcustom flyspell-delay 3
-  "*The number of seconds to wait before checking, after a \"delayed\" command."
-  :group 'flyspell
-  :type 'number)
-
-(defcustom flyspell-persistent-highlight t
-  "*Non-nil means misspelled words remain highlighted until corrected.
-If this variable is nil, only the most recently detected misspelled word
-is highlighted."
-  :group 'flyspell
-  :type 'boolean)
-
-(defcustom flyspell-highlight-properties t
-  "*Non-nil means highlight incorrect words even if a property exists for this word."
-  :group 'flyspell
-  :type 'boolean)
-
-(defcustom flyspell-default-delayed-commands
-  '(self-insert-command
-    delete-backward-char
-    backward-or-forward-delete-char
-    delete-char
-    scrollbar-vertical-drag)
-  "The standard list of delayed commands for Flyspell.
-See `flyspell-delayed-commands'."
-  :group 'flyspell
-  :version "21.1"
-  :type '(repeat (symbol)))
-
-(defcustom flyspell-delayed-commands nil
-  "List of commands that are \"delayed\" for Flyspell mode.
-After these commands, Flyspell checking is delayed for a short time,
-whose length is specified by `flyspell-delay'."
-  :group 'flyspell
-  :type '(repeat (symbol)))
-
-(defcustom flyspell-default-deplacement-commands
-  '(next-line
-    previous-line
-    scroll-up
-    scroll-down)
-  "The standard list of deplacement commands for Flyspell.
-See `flyspell-deplacement-commands'."
-  :group 'flyspell
-  :version "21.1"
-  :type '(repeat (symbol)))
-
-(defcustom flyspell-deplacement-commands nil
-  "List of commands that are \"deplacement\" for Flyspell mode.
-After these commands, Flyspell checking is performed only if the previous
-command was not the very same command."
-  :group 'flyspell
-  :version "21.1"
-  :type '(repeat (symbol)))
-
-(defcustom flyspell-issue-welcome-flag t
-  "*Non-nil means that Flyspell should display a welcome message when started."
-  :group 'flyspell
-  :type 'boolean)
-
-(defcustom flyspell-issue-message-flag t
-  "*Non-nil means that Flyspell emits messages when checking words."
-  :group 'flyspell
-  :type 'boolean)
-
-(defcustom flyspell-incorrect-hook nil
-  "*List of functions to be called when incorrect words are encountered.
-Each function is given three arguments: the beginning and the end
-of the incorrect region.  The third is either the symbol 'doublon' or the list
-of possible corrections as returned by 'ispell-parse-output'.
-
-If any of the functions return non-Nil, the word is not highlighted as
-incorrect."
-  :group 'flyspell
-  :version "21.1"
-  :type 'hook)
-
-(defcustom flyspell-default-dictionary nil
-  "A string that is the name of the default dictionary.
-This is passed to the `ispell-change-dictionary' when flyspell is started.
-If the variable `ispell-local-dictionary' or `ispell-dictionary' is non-nil
-when flyspell is started, the value of that variable is used instead
-of `flyspell-default-dictionary' to select the default dictionary.
-Otherwise, if `flyspell-default-dictionary' is nil, it means to use
-Ispell's ultimate default dictionary."
-  :group 'flyspell
-  :version "21.1"
-  :type '(choice string (const :tag "Default" nil)))
-
-(defcustom flyspell-tex-command-regexp
-  "\\(\\(begin\\|end\\)[ \t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[ \t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)"
-  "A string that is the regular expression that matches TeX commands."
-  :group 'flyspell
-  :version "21.1"
-  :type 'string)
-
-(defcustom flyspell-check-tex-math-command nil
-  "*Non nil means check even inside TeX math environment.
-TeX math environments are discovered by the TEXMATHP that implemented
-inside the texmathp.el Emacs package.  That package may be found at:
-http://strw.leidenuniv.nl/~dominik/Tools"
-  :group 'flyspell
-  :type 'boolean)
-
-(defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter
-  '("francais" "deutsch8" "norsk")
-  "List of dictionary names that consider `-' as word delimiter."
-  :group 'flyspell
-  :version "21.1"
-  :type '(repeat (string)))
-
-(defcustom flyspell-abbrev-p
-  nil
-  "*If non-nil, add correction to abbreviation table."
-  :group 'flyspell
-  :version "21.1"
-  :type 'boolean)
-
-(defcustom flyspell-use-global-abbrev-table-p
-  nil
-  "*If non-nil, prefer global abbrev table to local abbrev table."
-  :group 'flyspell
-  :version "21.1"
-  :type 'boolean)
-  
-;;;###autoload
-(defcustom flyspell-mode-line-string " Fly"
-  "*String displayed on the modeline when flyspell is active.
-Set this to nil if you don't want a modeline indicator."
-  :group 'flyspell
-  :type '(choice string (const :tag "None" nil)))
-
-(defcustom flyspell-large-region 1000
-  "*The threshold that determines if a region is small.
-The `flyspell-region' function is invoked if the region is small, the
-word are checked one after the other using regular flyspell check
-means.  If the region is large, a new Ispell process is spawned to get
-speed."
-  :group 'flyspell
-  :version "21.1"
-  :type 'number)
-
-(defcustom flyspell-insert-function (function insert)
-  "*Function for inserting word by flyspell upon correction."
-  :group 'flyspell
-  :type 'function)
-
-(defcustom flyspell-before-incorrect-word-string nil
-  "String used to indicate an incorrect word starting."
-  :group 'flyspell
-  :type '(choice string (const nil)))
-
-(defcustom flyspell-after-incorrect-word-string nil
-  "String used to indicate an incorrect word ending."
-  :group 'flyspell
-  :type '(choice string (const nil)))
-
-(defcustom flyspell-use-meta-tab t
-  "*Non-nil means that flyspell uses META-TAB to correct word."
-  :group 'flyspell
-  :type 'boolean)
-
-(defcustom flyspell-auto-correct-binding
-  (cond
-   ((eq flyspell-emacs 'xemacs)
-    [(control \;)])
-   (t
-    [?\C-\;]))
-  "The key binding for flyspell auto correction."
-  :group 'flyspell)
-
-;*---------------------------------------------------------------------*/
-;*    Mode specific options                                            */
-;*    -------------------------------------------------------------    */
-;*    Mode specific options enable users to disable flyspell on        */
-;*    certain word depending of the emacs mode. For instance, when     */
-;*    using flyspell with mail-mode add the following expression       */
-;*    in your .emacs file:                                             */
-;*       (add-hook 'mail-mode                                          */
-;*    	     '(lambda () (setq flyspell-generic-check-word-p           */
-;*    			       'mail-mode-flyspell-verify)))           */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-generic-check-word-p nil
-  "Function providing per-mode customization over which words are flyspelled.
-Returns t to continue checking, nil otherwise.
-Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
-property of the major mode name.")
-(make-variable-buffer-local 'flyspell-generic-check-word-p)
-
-;*--- mail mode -------------------------------------------------------*/
-(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
-(put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
-(defun mail-mode-flyspell-verify ()
-  "This function is used for `flyspell-generic-check-word-p' in Mail mode."
-  (let ((header-end (save-excursion
-		      (goto-char (point-min))
-		      (re-search-forward (concat "^" (regexp-quote
-						      mail-header-separator)
-						 "$")
-					 nil t)
-		      (point)))
-	(signature-begin (save-excursion
-			   (goto-char (point-max))
-			   (re-search-backward message-signature-separator
-					       nil t)
-			   (point))))
-    (cond ((< (point) header-end)
-	   (and (save-excursion (beginning-of-line)
-				(looking-at "^Subject:"))
-		(> (point) (match-end 0))))
-	  ((> (point) signature-begin)
-	   nil)
-	  (t
-	   (save-excursion
-	     (beginning-of-line)
-	     (not (looking-at "[>}|]\\|To:")))))))
-
-;*--- texinfo mode ----------------------------------------------------*/
-(put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify)
-(defun texinfo-mode-flyspell-verify ()
-  "This function is used for `flyspell-generic-check-word-p' in Texinfo mode."
-  (save-excursion
-    (forward-word -1)
-    (not (looking-at "@"))))
-
-;*--- tex mode --------------------------------------------------------*/
-(put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify)
-(defun tex-mode-flyspell-verify ()
-  "This function is used for `flyspell-generic-check-word-p' in LaTeX mode."
-  (and
-   (not (save-excursion
-	  (re-search-backward "^[ \t]*%%%[ \t]+Local" (point-min) t)))
-   (not (save-excursion
-	  (let ((this (point-marker))
-		(e (progn (end-of-line) (point-marker))))
-	    (beginning-of-line)
-	    (if (re-search-forward "\\\\\\(cite\\|label\\|ref\\){[^}]*}" e t)
-		(and (>= this (match-beginning 0))
-		     (<= this (match-end 0)) )))))))
-
-;*--- sgml mode -------------------------------------------------------*/
-(put 'sgml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
-(put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify)
-
-(defun sgml-mode-flyspell-verify ()
-  "This function is used for `flyspell-generic-check-word-p' in SGML mode."
-  (not (save-excursion
-	 (let ((this (point-marker))
-	       (s (progn (beginning-of-line) (point-marker)))
-	       (e (progn (end-of-line) (point-marker))))
-	   (or (progn
-		 (goto-char this)
-		 (and (re-search-forward  "[^<]*>" e t)
-		      (= (match-beginning 0) this)))
-	       (progn
-		 (goto-char this)
-		 (and (re-search-backward "<[^>]*" s t)
-		      (= (match-end 0) this)))
-	       (and (progn
-		      (goto-char this)
-		      (and (re-search-forward  "[^&]*;" e t)
-			   (= (match-beginning 0) this)))
-		    (progn
-		      (goto-char this)
-		      (and (re-search-backward "&[^;]*" s t)
-			   (= (match-end 0) this)))))))))
-
-;*---------------------------------------------------------------------*/
-;*    Programming mode                                                 */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-prog-text-faces
-  '(font-lock-string-face font-lock-comment-face font-lock-doc-face)
-  "Faces corresponding to text in programming-mode buffers.")
-
-(defun flyspell-generic-progmode-verify ()
-  "Used for `flyspell-generic-check-word-p' in programming modes."
-  (let ((f (get-text-property (point) 'face)))
-    (memq f flyspell-prog-text-faces)))
-
-;;;###autoload
-(defun flyspell-prog-mode ()
-  "Turn on `flyspell-mode' for comments and strings."
-  (interactive)
-  (setq flyspell-generic-check-word-p 'flyspell-generic-progmode-verify)
-  (flyspell-mode 1))
-
-;*---------------------------------------------------------------------*/
-;*    Overlay compatibility                                            */
-;*---------------------------------------------------------------------*/
-(autoload 'make-overlay            "overlay" "Overlay compatibility kit." t)
-(autoload 'overlayp                "overlay" "Overlay compatibility kit." t)
-(autoload 'overlays-in             "overlay" "Overlay compatibility kit." t)
-(autoload 'delete-overlay          "overlay" "Overlay compatibility kit." t)
-(autoload 'overlays-at             "overlay" "Overlay compatibility kit." t)
-(autoload 'overlay-put             "overlay" "Overlay compatibility kit." t)
-(autoload 'overlay-get             "overlay" "Overlay compatibility kit." t)
-(autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t)
-
-;*---------------------------------------------------------------------*/
-;*    The minor mode declaration.                                      */
-;*---------------------------------------------------------------------*/
-(eval-when-compile (defvar flyspell-local-mouse-map))
-
-;;;###autoload
-(defvar flyspell-mode nil)
-(make-variable-buffer-local 'flyspell-mode)
-
-(defvar flyspell-mouse-map
-  (let ((map (make-sparse-keymap)))
-    (cond
-     ((eq flyspell-emacs 'xemacs)
-      (define-key map [(button2)] #'flyspell-correct-word)
-      (if flyspell-use-meta-tab
-	  (define-key map "\M-\t" #'flyspell-auto-correct-word))
-      (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
-      (define-key map [(control \,)] 'flyspell-goto-next-error)
-      (define-key map [(control \.)] 'flyspell-auto-correct-word))
-     (flyspell-use-local-map
-      (define-key map [(down-mouse-2)] #'flyspell-correct-word)
-      (if flyspell-use-meta-tab
-	  (define-key map "\M-\t" #'flyspell-auto-correct-word))
-      (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
-      (define-key map [?\C-\,] 'flyspell-goto-next-error)
-      (define-key map [?\C-\.] 'flyspell-auto-correct-word)))
-    map))
-
-;;;###autoload
-(defvar flyspell-mode-map (make-sparse-keymap))
-
-;; mouse, keyboard bindings and misc definition
-(when (or (assoc 'flyspell-mode minor-mode-map-alist)
-	  (setq minor-mode-map-alist
-		(cons (cons 'flyspell-mode flyspell-mode-map)
-		      minor-mode-map-alist)))
-  (if flyspell-use-meta-tab
-      (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word))
-  (cond
-   ((eq flyspell-emacs 'xemacs)
-    (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
-    (define-key flyspell-mode-map [(control \,)] 'flyspell-goto-next-error)
-    (define-key flyspell-mode-map [(control \.)] 'flyspell-auto-correct-word))
-   (flyspell-use-local-map
-    (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
-    (define-key flyspell-mode-map [?\C-\,] 'flyspell-goto-next-error)
-    (define-key flyspell-mode-map [?\C-\.] 'flyspell-auto-correct-word))))
-
-
-;; the name of the overlay property that defines the keymap
-(defvar flyspell-overlay-keymap-property-name 'keymap)
-
-;; dash character machinery
-(defvar flyspell-consider-dash-as-word-delimiter-flag nil
-   "*Non-nil means that the `-' char is considered as a word delimiter.")
-(make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag)
-(defvar flyspell-dash-dictionary nil)
-(make-variable-buffer-local 'flyspell-dash-dictionary)
-(defvar flyspell-dash-local-dictionary nil)
-(make-variable-buffer-local 'flyspell-dash-local-dictionary)
-
-;*---------------------------------------------------------------------*/
-;*    Highlighting                                                     */
-;*---------------------------------------------------------------------*/
-(defface flyspell-incorrect-face
-  (if (eq flyspell-emacs 'xemacs)
-      '((((class color)) (:foreground "OrangeRed" :bold t :underline t))
-	(t (:bold t)))
-    '((((class color)) (:foreground "OrangeRed" :weight bold :underline t))
-      (t (:weight bold))))
-  "Face used for marking a misspelled word in Flyspell."
-  :group 'flyspell)
-
-(defface flyspell-duplicate-face
-  (if (eq flyspell-emacs 'xemacs)
-      '((((class color)) (:foreground "Gold3" :bold t :underline t))
-	(t (:bold t)))
-    '((((class color)) (:foreground "Gold3" :weight bold :underline t))
-      (t (:weight bold))))
-  "Face used for marking a misspelled word that appears twice in the buffer.
-See also `flyspell-duplicate-distance'."
-  :group 'flyspell)
-
-(defvar flyspell-overlay nil)
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-mode ...                                                */
-;*---------------------------------------------------------------------*/
-;;;###autoload
-(defun flyspell-mode (&optional arg)
-  "Minor mode performing on-the-fly spelling checking.
-Ispell is automatically spawned on background for each entered words.
-The default flyspell behavior is to highlight incorrect words.
-With no argument, this command toggles Flyspell mode.
-With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive.
-  
-Bindings:
-\\[ispell-word]: correct words (using Ispell).
-\\[flyspell-auto-correct-word]: automatically correct word.
-\\[flyspell-auto-correct-previous-word]: automatically correct the last misspelled word.
-\\[flyspell-correct-word] (or down-mouse-2): popup correct words.
-
-Hooks:
-This runs `flyspell-mode-hook' after flyspell is entered.
-
-Remark:
-`flyspell-mode' uses `ispell-mode'.  Thus all Ispell options are
-valid.  For instance, a personal dictionary can be used by
-invoking `ispell-change-dictionary'.
-
-Consider using the `ispell-parser' to check your text.  For instance
-consider adding:
-\(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
-in your .emacs file.
-
-\\[flyspell-region] checks all words inside a region.
-\\[flyspell-buffer] checks the whole buffer."
-  (interactive "P")
-  (let ((old-flyspell-mode flyspell-mode))
-    ;; Mark the mode as on or off.
-    (setq flyspell-mode (not (or (and (null arg) flyspell-mode)
-				 (<= (prefix-numeric-value arg) 0))))
-    ;; Do the real work.
-    (unless (eq flyspell-mode old-flyspell-mode)
-      (if flyspell-mode
-	  (flyspell-mode-on)
-	(flyspell-mode-off))
-      ;; Force modeline redisplay.
-      (set-buffer-modified-p (buffer-modified-p)))))
-
-;*---------------------------------------------------------------------*/
-;*    Autoloading                                                      */
-;*---------------------------------------------------------------------*/
-;;;###autoload
-(if (fboundp 'add-minor-mode)
-    (add-minor-mode 'flyspell-mode
-		    'flyspell-mode-line-string
-		    flyspell-mode-map
-		    nil
-		    'flyspell-mode)
-  (or (assoc 'flyspell-mode minor-mode-alist)
-      (setq minor-mode-alist
-	    (cons '(flyspell-mode flyspell-mode-line-string)
-		  minor-mode-alist)))
-
-  (or (assoc 'flyspell-mode minor-mode-map-alist)
-      (setq minor-mode-map-alist
-	    (cons (cons 'flyspell-mode flyspell-mode-map)
-		  minor-mode-map-alist))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-buffers ...                                             */
-;*    -------------------------------------------------------------    */
-;*    For remembering buffers running flyspell                         */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-buffers nil)
- 
-;*---------------------------------------------------------------------*/
-;*    flyspell-minibuffer-p ...                                        */
-;*---------------------------------------------------------------------*/
-(defun flyspell-minibuffer-p (buffer)
-  "Is BUFFER a minibuffer?"
-  (let ((ws (get-buffer-window-list buffer t)))
-    (and (consp ws) (window-minibuffer-p (car ws)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-version ...                                             */
-;*---------------------------------------------------------------------*/
-;;;###autoload
-(defun flyspell-version ()
-  "The flyspell version"
-  (interactive)
-  "1.6h")
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-accept-buffer-local-defs ...                            */
-;*---------------------------------------------------------------------*/
-(defun flyspell-accept-buffer-local-defs ()
-  ;; strange problem.  If buffer in current window has font-lock turned on,
-  ;; but SET-BUFFER was called to point to an invisible buffer, this ispell
-  ;; call will reset the buffer to the buffer in the current window.  However,
-  ;; it only happens at startup (fix by Albert L. Ting).
-  (let ((buf (current-buffer)))
-    (ispell-accept-buffer-local-defs)
-    (set-buffer buf))
-  (if (not (and (eq flyspell-dash-dictionary ispell-dictionary)
-		(eq flyspell-dash-local-dictionary ispell-local-dictionary)))
-      ;; the dictionary has changed
-      (progn
-	(setq flyspell-dash-dictionary ispell-dictionary)
-	(setq flyspell-dash-local-dictionary ispell-local-dictionary)
-	(if (member (or ispell-local-dictionary ispell-dictionary)
-		    flyspell-dictionaries-that-consider-dash-as-word-delimiter)
-	    (setq flyspell-consider-dash-as-word-delimiter-flag t)
-	  (setq flyspell-consider-dash-as-word-delimiter-flag nil)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-mode-on ...                                             */
-;*---------------------------------------------------------------------*/
-(defun flyspell-mode-on ()
-  "Turn Flyspell mode on.  Do not use this; use `flyspell-mode' instead."
-  (setq ispell-highlight-face 'flyspell-incorrect-face)
-  ;; local dictionaries setup
-  (ispell-change-dictionary
-   (or ispell-local-dictionary ispell-dictionary flyspell-default-dictionary))
-  ;; we have to force ispell to accept the local definition or
-  ;; otherwise it could be too late, the local dictionary may
-  ;; be forgotten!
-  (flyspell-accept-buffer-local-defs)
-  ;; we put the `flyspell-delayed' property on some commands
-  (flyspell-delay-commands)
-  ;; we put the `flyspell-deplacement' property on some commands
-  (flyspell-deplacement-commands)
-  ;; we bound flyspell action to post-command hook
-  (if (eq flyspell-emacs 'xemacs)
-      (make-local-hook 'post-command-hook))
-  (add-hook 'post-command-hook (function flyspell-post-command-hook) t t)
-  ;; we bound flyspell action to pre-command hook
-  (if (eq flyspell-emacs 'xemacs)
-      (make-local-hook 'pre-command-hook))
-  (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
-  ;; we bound flyspell action to after-change hook
-  (make-local-variable 'after-change-functions)
-  (setq after-change-functions
-	(cons 'flyspell-after-change-function after-change-functions))
-  ;; set flyspell-generic-check-word-p based on the major mode
-  (let ((mode-predicate (get major-mode 'flyspell-mode-predicate)))
-    (if mode-predicate
-	(setq flyspell-generic-check-word-p mode-predicate)))
-  ;; work around the fact that the `local-map' text-property replaces the
-  ;; buffer's local map rather than shadowing it.
-  (set (make-local-variable 'flyspell-mouse-map)
-       (let ((map (copy-keymap flyspell-mouse-map)))
-	 (set-keymap-parent map (current-local-map))
-	 map))
-  (set (make-local-variable 'flyspell-mode-map)
-       (let ((map (copy-keymap flyspell-mode-map)))
- 	 (set-keymap-parent map (current-local-map))
- 	 map))
-  ;; the welcome message
-  (if (and flyspell-issue-message-flag
-	   flyspell-issue-welcome-flag
-	   (interactive-p))
-      (let ((binding (where-is-internal 'flyspell-auto-correct-word
-					nil 'non-ascii)))
-	(message
-	 (if binding
-	     (format "Welcome to flyspell. Use %s or Mouse-2 to correct words."
-		     (key-description binding))
-	   "Welcome to flyspell. Use Mouse-2 to correct words."))))
-  ;; we end with the flyspell hooks
-  (run-hooks 'flyspell-mode-hook))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-delay-commands ...                                      */
-;*---------------------------------------------------------------------*/
-(defun flyspell-delay-commands ()
-  "Install the standard set of Flyspell delayed commands."
-  (mapcar 'flyspell-delay-command flyspell-default-delayed-commands)
-  (mapcar 'flyspell-delay-command flyspell-delayed-commands))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-delay-command ...                                       */
-;*---------------------------------------------------------------------*/
-(defun flyspell-delay-command (command)
-  "Set COMMAND to be delayed, for Flyspell.
-When flyspell `post-command-hook' is invoked because a delayed command
-as been used the current word is not immediately checked.
-It will be checked only after `flyspell-delay' seconds."
-  (interactive "SDelay Flyspell after Command: ")
-  (put command 'flyspell-delayed t))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-deplacement-commands ...                                */
-;*---------------------------------------------------------------------*/
-(defun flyspell-deplacement-commands ()
-  "Install the standard set of Flyspell deplacement commands."
-  (mapcar 'flyspell-deplacement-command flyspell-default-deplacement-commands)
-  (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-deplacement-command ...                                 */
-;*---------------------------------------------------------------------*/
-(defun flyspell-deplacement-command (command)
-  "Set COMMAND that implement cursor movements, for Flyspell.
-When flyspell `post-command-hook' is invoked because of a deplacement command
-as been used the current word is checked only if the previous command was
-not the very same deplacement command."
-  (interactive "SDeplacement Flyspell after Command: ")
-  (put command 'flyspell-deplacement t))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-word-cache ...                                          */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-word-cache-start  nil)
-(defvar flyspell-word-cache-end    nil)
-(defvar flyspell-word-cache-word   nil)
-(make-variable-buffer-local 'flyspell-word-cache-start)
-(make-variable-buffer-local 'flyspell-word-cache-end)
-(make-variable-buffer-local 'flyspell-word-cache-word)
-
-;*---------------------------------------------------------------------*/
-;*    The flyspell pre-hook, store the current position. In the        */
-;*    post command hook, we will check, if the word at this position   */
-;*    has to be spell checked.                                         */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-pre-buffer     nil)
-(defvar flyspell-pre-point      nil)
-(defvar flyspell-pre-column     nil)
-(defvar flyspell-pre-pre-buffer nil)
-(defvar flyspell-pre-pre-point  nil)
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-previous-command ...                                    */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-previous-command nil
-  "The last interactive command checked by Flyspell.")
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-pre-command-hook ...                                    */
-;*---------------------------------------------------------------------*/
-(defun flyspell-pre-command-hook ()
-  "Save the current buffer and point for Flyspell's post-command hook."
-  (interactive)
-  (setq flyspell-pre-buffer (current-buffer))
-  (setq flyspell-pre-point  (point))
-  (setq flyspell-pre-column (current-column)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-mode-off ...                                            */
-;*---------------------------------------------------------------------*/
-;;;###autoload
-(defun flyspell-mode-off ()
-  "Turn Flyspell mode off."
-  ;; we remove the hooks
-  (remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
-  (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
-  (setq after-change-functions (delq 'flyspell-after-change-function
-				     after-change-functions))
-  ;; we remove all the flyspell hilightings
-  (flyspell-delete-all-overlays)
-  ;; we have to erase pre cache variables
-  (setq flyspell-pre-buffer nil)
-  (setq flyspell-pre-point  nil)
-  ;; we mark the mode as killed
-  (setq flyspell-mode nil))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-check-pre-word-p ...                                    */
-;*---------------------------------------------------------------------*/
-(defun flyspell-check-pre-word-p ()
-  "Return non-nil if we should to check the word before point.
-More precisely, it applies to the word that was before point
-before the current command."
-  (cond
-   ((or (not (numberp flyspell-pre-point))
-	(not (bufferp flyspell-pre-buffer))
-	(not (buffer-live-p flyspell-pre-buffer)))
-    nil)
-   ((and (eq flyspell-pre-pre-point flyspell-pre-point)
-	 (eq flyspell-pre-pre-buffer flyspell-pre-buffer))
-    nil)
-   ((or (and (= flyspell-pre-point (- (point) 1))
-	     (eq (char-syntax (char-after flyspell-pre-point)) ?w))
-	(= flyspell-pre-point (point))
-	(= flyspell-pre-point (+ (point) 1)))
-    nil)
-   ((and (symbolp this-command)
-	 (not executing-kbd-macro)
-	 (or (get this-command 'flyspell-delayed)
-	     (and (get this-command 'flyspell-deplacement)
-		  (eq flyspell-previous-command this-command)))
-	 (or (= (current-column) 0)
-	     (= (current-column) flyspell-pre-column)
-	     (eq (char-syntax (char-after flyspell-pre-point)) ?w)))
-    nil)
-   ((not (eq (current-buffer) flyspell-pre-buffer))
-    t)
-   ((not (and (numberp flyspell-word-cache-start)
-	      (numberp flyspell-word-cache-end)))
-    t)
-   (t
-    (or (< flyspell-pre-point flyspell-word-cache-start)
-	(> flyspell-pre-point flyspell-word-cache-end)))))
-
-;*---------------------------------------------------------------------*/
-;*    The flyspell after-change-hook, store the change position. In    */
-;*    the post command hook, we will check, if the word at this        */
-;*    position has to be spell checked.                                */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-changes nil)
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-after-change-function ...                               */
-;*---------------------------------------------------------------------*/
-(defun flyspell-after-change-function (start stop len)
-  "Save the current buffer and point for Flyspell's post-command hook."
-  (interactive)
-  (setq flyspell-changes (cons (cons start stop) flyspell-changes)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-check-changed-word-p ...                                */
-;*---------------------------------------------------------------------*/
-(defun flyspell-check-changed-word-p (start stop)
-  "Return t when the changed word has to be checked.
-The answer depends of several criteria.
-Mostly we check word delimiters."
-  (cond
-   ((and (memq (char-after start) '(?\n ? )) (> stop start))
-    t)
-   ((not (numberp flyspell-pre-point))
-    t)
-   ((and (>= flyspell-pre-point start) (<= flyspell-pre-point stop))
-    nil)
-   ((let ((pos (point)))
-      (or (>= pos start) (<= pos stop) (= pos (1+ stop))))
-    nil)
-   (t
-    t)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-check-word-p ...                                        */
-;*---------------------------------------------------------------------*/
-(defun flyspell-check-word-p ()
-  "Return t when the word at `point' has to be checked.
-The answer depends of several criteria.
-Mostly we check word delimiters."
-  (cond
-   ((<= (- (point-max) 1) (point-min))
-    ;; the buffer is not filled enough
-    nil)
-   ((and (and (> (current-column) 0)
-	      (not (eq (current-column) flyspell-pre-column)))
-	 (save-excursion
-	   (backward-char 1)
-	   (and (looking-at (flyspell-get-not-casechars))
-		(or flyspell-consider-dash-as-word-delimiter-flag
-		    (not (looking-at "\\-"))))))
-    ;; yes because we have reached or typed a word delimiter.
-    t)
-   ((symbolp this-command)
-    (cond
-     ((get this-command 'flyspell-deplacement)
-      (not (eq flyspell-previous-command this-command)))
-     ((get this-command 'flyspell-delayed)
-      ;; the current command is not delayed, that
-      ;; is that we must check the word now
-      (if (featurep 'xemacs)
-	  (sit-for flyspell-delay nil)
-	(sit-for flyspell-delay 0 nil)))
-     (t t)))
-   (t t)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-debug-signal-no-check ...                               */
-;*---------------------------------------------------------------------*/
-(defun flyspell-debug-signal-no-check (msg obj)
-  (setq debug-on-error t)
-  (save-excursion
-    (let ((buffer (get-buffer-create "*flyspell-debug*")))
-      (set-buffer buffer)
-      (erase-buffer)
-      (insert "NO-CHECK:\n")
-      (insert (format "    %S : %S\n" msg obj)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-debug-signal-pre-word-checked ...                       */ 
-;*---------------------------------------------------------------------*/
-(defun flyspell-debug-signal-pre-word-checked ()
-  (setq debug-on-error t)
-  (save-excursion
-    (let ((buffer (get-buffer-create "*flyspell-debug*")))
-      (set-buffer buffer)
-      (insert "PRE-WORD:\n")
-      (insert (format "  pre-point  : %S\n" flyspell-pre-point))
-      (insert (format "  pre-buffer : %S\n" flyspell-pre-buffer))
-      (insert (format "  cache-start: %S\n" flyspell-word-cache-start))
-      (insert (format "  cache-end  : %S\n" flyspell-word-cache-end))
-      (goto-char (point-max)))))
-    
-;*---------------------------------------------------------------------*/
-;*    flyspell-debug-signal-word-checked ...                           */ 
-;*---------------------------------------------------------------------*/
-(defun flyspell-debug-signal-word-checked ()
-  (setq debug-on-error t)
-  (save-excursion
-    (let ((oldbuf (current-buffer))
-	  (buffer (get-buffer-create "*flyspell-debug*"))
-	  (point  (point)))
-      (set-buffer buffer)
-      (insert "WORD:\n")
-      (insert (format "  this-cmd   : %S\n" this-command))
-      (insert (format "  delayed    : %S\n" (and (symbolp this-command)
-						 (get this-command 'flyspell-delayed))))
-      (insert (format "  point      : %S\n" point))
-      (insert (format "  prev-char  : [%c] %S\n"
-		      (progn
-			(set-buffer oldbuf)
-			(let ((c (if (> (point) (point-min))
-				     (save-excursion
-				       (backward-char 1)
-				       (char-after (point)))
-				   ? )))
-			  (set-buffer buffer)
-			  c))
-		      (progn
-			(set-buffer oldbuf)
-			(let ((c (if (> (point) (point-min))
-				     (save-excursion
-				       (backward-char 1)
-				       (and (and (looking-at (flyspell-get-not-casechars)) 1)
-					    (and (or flyspell-consider-dash-as-word-delimiter-flag
-						     (not (looking-at "\\-"))) 2))))))
-			  (set-buffer buffer)
-			  c))))
-      (insert (format "  because    : %S\n"
-		      (cond
-		       ((not (and (symbolp this-command)
-				  (get this-command 'flyspell-delayed)))
-			;; the current command is not delayed, that
-			;; is that we must check the word now
-			'not-delayed)
-		       ((progn
-			  (set-buffer oldbuf)
-			  (let ((c (if (> (point) (point-min))
-				       (save-excursion
-					 (backward-char 1)
-					 (and (looking-at (flyspell-get-not-casechars))
-					      (or flyspell-consider-dash-as-word-delimiter-flag
-						  (not (looking-at "\\-"))))))))
-			    (set-buffer buffer)
-			    c))
-			;; yes because we have reached or typed a word delimiter.
-			'separator)
-		       ((not (integerp flyspell-delay))
-			;; yes because the user had set up a no-delay configuration.
-			'no-delay)
-		       (t
-			'sit-for))))
-      (goto-char (point-max)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-debug-signal-changed-checked ...                        */ 
-;*---------------------------------------------------------------------*/
-(defun flyspell-debug-signal-changed-checked ()
-  (setq debug-on-error t)
-  (save-excursion
-    (let ((buffer (get-buffer-create "*flyspell-debug*"))
-	  (point  (point)))
-      (set-buffer buffer)
-      (insert "CHANGED WORD:\n")
-      (insert (format "  point   : %S\n" point))
-      (goto-char (point-max)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-post-command-hook ...                                   */
-;*    -------------------------------------------------------------    */
-;*    It is possible that we check several words:                      */
-;*    1- the current word is checked if the predicate                  */
-;*       FLYSPELL-CHECK-WORD-P is true                                 */
-;*    2- the word that used to be the current word before the          */
-;*       THIS-COMMAND is checked if:                                   */
-;*        a- the previous word is different from the current word      */
-;*        b- the previous word as not just been checked by the         */
-;*           previous FLYSPELL-POST-COMMAND-HOOK                       */
-;*    3- the words changed by the THIS-COMMAND that are neither the    */
-;*       previous word nor the current word                            */
-;*---------------------------------------------------------------------*/
-(defun flyspell-post-command-hook ()
-  "The `post-command-hook' used by flyspell to check a word in-the-fly."
-  (interactive)
-  (let ((command this-command))
-    (if (flyspell-check-pre-word-p)
-	(save-excursion
-	  '(flyspell-debug-signal-pre-word-checked)
-	  (set-buffer flyspell-pre-buffer)
-	  (save-excursion
-	    (goto-char flyspell-pre-point)
-	    (flyspell-word))))
-    (if (flyspell-check-word-p)
-	(progn
-	  '(flyspell-debug-signal-word-checked)
-	  (flyspell-word)
-	  ;; we remember which word we have just checked.
-	  ;; this will be used next time we will check a word
-	  ;; to compare the next current word with the word
-	  ;; that as been registered in the pre-command-hook
-	  ;; that is these variables are used within the predicate
-	  ;; FLYSPELL-CHECK-PRE-WORD-P
-	  (setq flyspell-pre-pre-buffer (current-buffer))
-	  (setq flyspell-pre-pre-point  (point)))
-      (progn
-	(setq flyspell-pre-pre-buffer nil)
-	(setq flyspell-pre-pre-point  nil)
-	;; when a word is not checked because of a delayed command
-	;; we do not disable the ispell cache.
-	(if (and (symbolp this-command) (get this-command 'flyspell-delayed))
-	    (setq flyspell-word-cache-end -1))))
-    (while (consp flyspell-changes)
-      (let ((start (car (car flyspell-changes)))
-	    (stop  (cdr (car flyspell-changes))))
-	(if (flyspell-check-changed-word-p start stop)
-	    (save-excursion
-	      '(flyspell-debug-signal-changed-checked)
-	      (goto-char start)
-	      (flyspell-word)))
-	(setq flyspell-changes (cdr flyspell-changes))))
-    (setq flyspell-previous-command command)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-notify-misspell ...                                     */
-;*---------------------------------------------------------------------*/
-(defun flyspell-notify-misspell (start end word poss)
-  (let ((replacements (if (stringp poss)
-			  poss
-			(if flyspell-sort-corrections
-			    (sort (car (cdr (cdr poss))) 'string<)
-			  (car (cdr (cdr poss)))))))
-    (if flyspell-issue-message-flag
-	(message (format "mispelling `%s'  %S" word replacements)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-word ...                                                */
-;*---------------------------------------------------------------------*/
-(defun flyspell-word (&optional following)
-  "Spell check a word."
-  (interactive (list current-prefix-arg))
-  (if (interactive-p)
-      (setq following ispell-following-word))
-  (save-excursion
-    ;; use the correct dictionary
-    (flyspell-accept-buffer-local-defs)	
-    (let* ((cursor-location (point))
-	  (flyspell-word (flyspell-get-word following))
-	  start end poss word)
-      (if (or (eq flyspell-word nil)
- 	      (and (fboundp flyspell-generic-check-word-p)
- 		   (not (funcall flyspell-generic-check-word-p))))
-	  '()
-	(progn
-	  ;; destructure return flyspell-word info list.
-	  (setq start (car (cdr flyspell-word))
-		end (car (cdr (cdr flyspell-word)))
-		word (car flyspell-word))
-	  ;; before checking in the directory, we check for doublons.
-	  (cond
-	   ((and (or (not (eq ispell-parser 'tex))
-		     (and (> start (point-min))
-			  (not (eq (char-after (1- start)) ?\\))))
-		 flyspell-mark-duplications-flag
-		 (save-excursion
-		   (goto-char start)
-		   (word-search-backward word
-					 (- start
-					    (+ 1 (- end start)))
-					 t)))
-	    ;; yes, this is a doublon
-	    (flyspell-highlight-incorrect-region start end 'doublon))
-	   ((and (eq flyspell-word-cache-start start)
-		 (eq flyspell-word-cache-end end)
-		 (string-equal flyspell-word-cache-word word))
-	    ;; this word had been already checked, we skip
-	    nil)
-	   ((and (eq ispell-parser 'tex)
-		 (flyspell-tex-command-p flyspell-word))
-	    ;; this is a correct word (because a tex command)
-	    (flyspell-unhighlight-at start)
-	    (if (> end start)
-		(flyspell-unhighlight-at (- end 1)))
-	    t)
-	   (t
-	    ;; we setup the cache
-	    (setq flyspell-word-cache-start start)
-	    (setq flyspell-word-cache-end end)
-	    (setq flyspell-word-cache-word word)
-	    ;; now check spelling of word.
-	    (process-send-string ispell-process "%\n")
-	    ;; put in verbose mode
-	    (process-send-string ispell-process
-				 (concat "^" word "\n"))
-	    ;; we mark the ispell process so it can be killed
-	    ;; when emacs is exited without query
-	    (if (fboundp 'process-kill-without-query)
-		(process-kill-without-query ispell-process))
-	    ;; wait until ispell has processed word
-	    (while (progn
-		     (accept-process-output ispell-process)
-		     (not (string= "" (car ispell-filter)))))
-	    ;; (process-send-string ispell-process "!\n")
-	    ;; back to terse mode.
-	    (setq ispell-filter (cdr ispell-filter))
-	    (if (consp ispell-filter)
-		(setq poss (ispell-parse-output (car ispell-filter))))
-	    (cond ((eq poss t)
-		   ;; correct
-		   (flyspell-unhighlight-at start)
-		   (if (> end start)
-		       (flyspell-unhighlight-at (- end 1)))
-		   t)
-		  ((and (stringp poss) flyspell-highlight-flag)
-		   ;; correct
-		   (flyspell-unhighlight-at start)
-		   (if (> end start)
-		       (flyspell-unhighlight-at (- end 1)))
-		   t)
-		  ((null poss)
-		   (flyspell-unhighlight-at start)
-		   (if (> end start)
-		       (flyspell-unhighlight-at (- end 1))))
-		  ((or (and (< flyspell-duplicate-distance 0)
-			    (or (save-excursion
-				  (goto-char start)
-				  (word-search-backward word
-							(point-min)
-							t))
-				(save-excursion
-				  (goto-char end)
-				  (word-search-forward word
-						       (point-max)
-						       t))))
-		       (and (> flyspell-duplicate-distance 0)
-			    (or (save-excursion
-				  (goto-char start)
-				  (word-search-backward
-				   word
-				   (- start
-				      flyspell-duplicate-distance)
-				   t))
-				(save-excursion
-				  (goto-char end)
-				  (word-search-forward
-				   word
-				   (+ end
-				      flyspell-duplicate-distance)
-				   t)))))
-		   (if flyspell-highlight-flag
-		       (flyspell-highlight-duplicate-region start end)
-		     (message (format "duplicate `%s'" word))))
-		  (t
-		   ;; incorrect highlight the location
-		   (if flyspell-highlight-flag
-		       (flyspell-highlight-incorrect-region start end poss)
-		     (flyspell-notify-misspell start end word poss))))
-	    ;; return to original location
-	    (goto-char cursor-location) 
-	    (if ispell-quit (setq ispell-quit nil)))))))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-tex-math-initialized ...                                */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-tex-math-initialized nil)
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-math-tex-command-p ...                                  */
-;*    -------------------------------------------------------------    */
-;*    This function uses the texmathp package to check if (point)      */
-;*    is within a tex command. In order to avoid using                 */
-;*    condition-case each time we use the variable                     */
-;*    flyspell-tex-math-initialized to make a special case the first   */
-;*    time that function is called.                                    */
-;*---------------------------------------------------------------------*/
-(defun flyspell-math-tex-command-p ()
-  (cond
-   (flyspell-check-tex-math-command
-    nil)
-   ((eq flyspell-tex-math-initialized t)
-    (texmathp))
-   ((eq flyspell-tex-math-initialized 'error)
-    nil)
-   (t
-    (setq flyspell-tex-math-initialized t)
-    (condition-case nil
-	(texmathp)
-      (error (progn
-	       (setq flyspell-tex-math-initialized 'error)
-	       nil))))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-tex-command-p ...                                       */
-;*---------------------------------------------------------------------*/
-(defun flyspell-tex-command-p (word)
-  "Return t if WORD is a TeX command."
-  (or (save-excursion
-	(let ((b  (car (cdr word))))
-	  (and (re-search-backward "\\\\" (- (point) 100) t)
-	       (or (= (match-end 0) b)
-		   (and (goto-char (match-end 0))
-			(looking-at flyspell-tex-command-regexp)
-			(>= (match-end 0) b))))))
-      (flyspell-math-tex-command-p)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-casechars-cache ...                                     */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-casechars-cache nil)
-(defvar flyspell-ispell-casechars-cache nil)
-(make-variable-buffer-local 'flyspell-casechars-cache)
-(make-variable-buffer-local 'flyspell-ispell-casechars-cache)
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-get-casechars ...                                       */
-;*---------------------------------------------------------------------*/
-(defun flyspell-get-casechars ()
-  "This function builds a string that is the regexp of word chars.
-In order to avoid one useless string construction,
-this function changes the last char of the `ispell-casechars' string."
-  (let ((ispell-casechars (ispell-get-casechars)))
-    (cond
-     ((eq ispell-parser 'tex)
-      (setq flyspell-ispell-casechars-cache ispell-casechars)
-      (setq flyspell-casechars-cache
-	    (concat (substring ispell-casechars
-			       0
-			       (- (length ispell-casechars) 1))
-		    "]"))
-      flyspell-casechars-cache)
-     (t
-      (setq flyspell-ispell-casechars-cache ispell-casechars)
-      (setq flyspell-casechars-cache ispell-casechars)
-      flyspell-casechars-cache))))
-	
-;*---------------------------------------------------------------------*/
-;*    flyspell-get-not-casechars-cache ...                             */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-not-casechars-cache nil)
-(defvar flyspell-ispell-not-casechars-cache nil)
-(make-variable-buffer-local 'flyspell-not-casechars-cache)
-(make-variable-buffer-local 'flyspell-ispell-not-casechars-cache)
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-get-not-casechars ...                                   */
-;*---------------------------------------------------------------------*/
-(defun flyspell-get-not-casechars ()
-  "This function builds a string that is the regexp of non-word chars."
-  (let ((ispell-not-casechars (ispell-get-not-casechars)))
-    (cond
-     ((eq ispell-parser 'tex)
-      (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
-      (setq flyspell-not-casechars-cache
-	    (concat (substring ispell-not-casechars
-			       0
-			       (- (length ispell-not-casechars) 1))
-		    "]"))
-      flyspell-not-casechars-cache)
-     (t
-      (setq flyspell-ispell-not-casechars-cache ispell-not-casechars)
-      (setq flyspell-not-casechars-cache ispell-not-casechars)
-      flyspell-not-casechars-cache))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-get-word ...                                            */
-;*---------------------------------------------------------------------*/
-(defun flyspell-get-word (following)
-  "Return the word for spell-checking according to Ispell syntax.
-If argument FOLLOWING is non-nil or if `ispell-following-word'
-is non-nil when called interactively, then the following word
-\(rather than preceding\) is checked when the cursor is not over a word.
-Optional second argument contains other chars that can be included in word
-many times.
-
-Word syntax described by `ispell-dictionary-alist' (which see)."
-  (let* ((flyspell-casechars (flyspell-get-casechars))
-	 (flyspell-not-casechars (flyspell-get-not-casechars))
-	 (ispell-otherchars (ispell-get-otherchars))
-	 (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
-	 (word-regexp (if (string< "" ispell-otherchars)
-			  (concat flyspell-casechars
-				  "+\\("
-				  ispell-otherchars
-				  (if (> (length ispell-otherchars) 0) "?")
-				  flyspell-casechars
-				  "+\\)"
-				  (if ispell-many-otherchars-p
-				      "*" "?"))
-			(concat flyspell-casechars "+")))
-	 did-it-once
-	 start end word)
-    ;; find the word
-    (if (not (looking-at flyspell-casechars))
-	(if following
-	    (re-search-forward flyspell-casechars (point-max) t)
-	  (re-search-backward flyspell-casechars (point-min) t)))
-    ;; move to front of word
-    (re-search-backward flyspell-not-casechars (point-min) 'start)
-    (let ((pos nil))
-      (if (string< "" ispell-otherchars)
-	  (while (and (looking-at ispell-otherchars)
-		      (not (bobp))
-		      (or (not did-it-once)
-			  ispell-many-otherchars-p)
-		      (not (eq pos (point))))
-	    (setq pos (point))
-	    (setq did-it-once t)
-	    (backward-char 1)
-	    (if (looking-at flyspell-casechars)
-		(re-search-backward flyspell-not-casechars (point-min) 'move)
-	      (backward-char -1)))))
-    ;; Now mark the word and save to string.
-    (if (eq (re-search-forward word-regexp (point-max) t) nil)
-	nil
-      (progn
-	(setq start (match-beginning 0)
-	      end (point)
-	      word (buffer-substring-no-properties start end))
-	(list word start end)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-small-region ...                                        */
-;*---------------------------------------------------------------------*/
-(defun flyspell-small-region (beg end)
-  "Flyspell text between BEG and END."
-  (save-excursion
-    (if (> beg end)
-	(let ((old beg))
-	  (setq beg end)
-	  (setq end old)))
-    (goto-char beg)
-    (let ((count 0))
-      (while (< (point) end)
-	(if (and flyspell-issue-message-flag (= count 100))
-	    (progn
-	      (message "Spell Checking...%d%%"
-		       (* 100 (/ (float (- (point) beg)) (- end beg))))
-	      (setq count 0))
-	  (setq count (+ 1 count)))
-	(flyspell-word)
-	(sit-for 0)
-	(let ((cur (point)))
-	  (forward-word 1)
-	  (if (and (< (point) end) (> (point) (+ cur 1)))
-	      (backward-char 1)))))
-    (backward-char 1)
-    (if flyspell-issue-message-flag (message "Spell Checking completed."))
-    (flyspell-word)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-external-ispell-process ...                             */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-external-ispell-process '()
-  "The external Flyspell Ispell process.")
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-external-ispell-buffer ...                              */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-external-ispell-buffer '())
-(defvar flyspell-large-region-buffer '())
-(defvar flyspell-large-region-beg (point-min))
-(defvar flyspell-large-region-end (point-max))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-external-point-words ...                                */
-;*---------------------------------------------------------------------*/
-(defun flyspell-external-point-words ()
-  (let ((buffer flyspell-external-ispell-buffer))
-    (set-buffer buffer)
-    (beginning-of-buffer)
-    (let ((size (- flyspell-large-region-end flyspell-large-region-beg))
-	  (start flyspell-large-region-beg))
-      ;; now we are done with ispell, we have to find the word in
-      ;; the initial buffer
-      (while (< (point) (- (point-max) 1))
-	;; we have to fetch the incorrect word
-	(if (re-search-forward "\\([^\n]+\\)\n" (point-max) t)
-	    (let ((word (match-string 1)))
-	      (goto-char (match-end 0))
-	      (set-buffer flyspell-large-region-buffer)
-	      (goto-char flyspell-large-region-beg)
-	      (if flyspell-issue-message-flag
-		  (message "Spell Checking...%d%% [%s]"
-			   (* 100 (/ (float (- (point) start)) size))
-			   word))
-	      (if (search-forward word flyspell-large-region-end t)
-		  (progn
-		    (setq flyspell-large-region-beg (point))
-		    (goto-char (- (point) 1))
-		    (flyspell-word)))
-	      (set-buffer buffer))
-	  (goto-char (point-max)))))
-    ;; we are done
-    (if flyspell-issue-message-flag (message "Spell Checking completed."))
-    ;; ok, we are done with pointing out incorrect words, we just
-    ;; have to kill the temporary buffer
-    (kill-buffer flyspell-external-ispell-buffer)
-    (setq flyspell-external-ispell-buffer nil)))
-  
-;*---------------------------------------------------------------------*/
-;*    flyspell-large-region ...                                        */
-;*---------------------------------------------------------------------*/
-(defun flyspell-large-region (beg end)
-  (let* ((curbuf  (current-buffer))
-	 (buffer  (get-buffer-create "*flyspell-region*")))
-    (setq flyspell-external-ispell-buffer buffer)
-    (setq flyspell-large-region-buffer curbuf)
-    (setq flyspell-large-region-beg beg)
-    (setq flyspell-large-region-end end)
-    (set-buffer buffer)
-    (erase-buffer)
-    ;; this is done, we can start checking...
-    (if flyspell-issue-message-flag (message "Checking region..."))
-    (set-buffer curbuf)
-    (let ((c (apply 'call-process-region beg
-		    end
-		    ispell-program-name
-		    nil
-		    buffer
-		    nil
-		    "-l"
-		    (let (args)
-		      ;; Local dictionary becomes the global dictionary in use.
-		      (if ispell-local-dictionary
-			  (setq ispell-dictionary ispell-local-dictionary))
-		      (setq args (ispell-get-ispell-args))
-		      (if ispell-dictionary ; use specified dictionary
-			  (setq args
-				(append (list "-d" ispell-dictionary) args)))
-		      (if ispell-personal-dictionary ; use specified pers dict
-			  (setq args
-				(append args
-					(list "-p"
-					      (expand-file-name
-					       ispell-personal-dictionary)))))
-		      (setq args (append args ispell-extra-args))
-		      args))))
-      (if (= c 0)
-	  (flyspell-external-point-words)
-	(error "Can't check region...")))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-region ...                                              */
-;*    -------------------------------------------------------------    */
-;*    Because `ispell -a' is too slow, it is not possible to use       */
-;*    it on large region. Then, when ispell is invoked on a large      */
-;*    text region, a new `ispell -l' process is spawned. The           */
-;*    pointed out words are then searched in the region a checked with */
-;*    regular flyspell means.                                          */
-;*---------------------------------------------------------------------*/
-;;;###autoload
-(defun flyspell-region (beg end)
-  "Flyspell text between BEG and END."
-  (interactive "r")
-  (if (= beg end)
-      ()
-    (save-excursion
-      (if (> beg end)
-	  (let ((old beg))
-	    (setq beg end)
-	    (setq end old)))
-      (if (> (- end beg) flyspell-large-region)
-	  (flyspell-large-region beg end)
-	(flyspell-small-region beg end)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-buffer ...                                              */
-;*---------------------------------------------------------------------*/
-;;;###autoload
-(defun flyspell-buffer ()
-  "Flyspell whole buffer."
-  (interactive)
-  (flyspell-region (point-min) (point-max)))
-
-;*---------------------------------------------------------------------*/
-;*    old next error position ...                                      */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-old-buffer-error nil)
-(defvar flyspell-old-pos-error nil)
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-goto-next-error ...                                     */
-;*---------------------------------------------------------------------*/
-(defun flyspell-goto-next-error ()
-  "Go to the next previously detected error.
-In general FLYSPELL-GOTO-NEXT-ERROR must be used after
-FLYSPELL-BUFFER."
-  (interactive)
-  (let ((pos (point))
-	(max (point-max)))
-    (if (and (eq (current-buffer) flyspell-old-buffer-error)
-	     (eq pos flyspell-old-pos-error))
-	(progn
-	  (if (= flyspell-old-pos-error max)
-	      ;; goto beginning of buffer
-	      (progn
-		(message "Restarting from beginning of buffer")
-		(goto-char (point-min)))
-	    (forward-word 1))
-	  (setq pos (point))))
-    ;; seek the next error
-    (while (and (< pos max)
-		(let ((ovs (overlays-at pos))
-		      (r '()))
-		  (while (and (not r) (consp ovs))
-		    (if (flyspell-overlay-p (car ovs))
-			(setq r t)
-		      (setq ovs (cdr ovs))))
-		  (not r)))
-      (setq pos (1+ pos)))
-    ;; save the current location for next invocation
-    (setq flyspell-old-pos-error pos)
-    (setq flyspell-old-buffer-error (current-buffer))
-    (goto-char pos)
-    (if (= pos max)
-	(message "No more miss-spelled word!"))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-overlay-p ...                                           */
-;*---------------------------------------------------------------------*/
-(defun flyspell-overlay-p (o)
-  "A predicate that return true iff O is an overlay used by flyspell."
-  (and (overlayp o) (overlay-get o 'flyspell-overlay)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-delete-all-overlays ...                                 */
-;*    -------------------------------------------------------------    */
-;*    Remove all the overlays introduced by flyspell.                  */
-;*---------------------------------------------------------------------*/
-(defun flyspell-delete-all-overlays ()
-  "Delete all the overlays used by flyspell."
-  (let ((l (overlays-in (point-min) (point-max))))
-    (while (consp l)
-      (progn
-	(if (flyspell-overlay-p (car l))
-	    (delete-overlay (car l)))
-	(setq l (cdr l))))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-unhighlight-at ...                                      */
-;*---------------------------------------------------------------------*/
-(defun flyspell-unhighlight-at (pos)
-  "Remove the flyspell overlay that are located at POS."
-  (if flyspell-persistent-highlight
-      (let ((overlays (overlays-at pos)))
-	(while (consp overlays)
-	  (if (flyspell-overlay-p (car overlays))
-	      (delete-overlay (car overlays)))
-	  (setq overlays (cdr overlays))))
-    (if (flyspell-overlay-p flyspell-overlay)
-	(delete-overlay flyspell-overlay))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-properties-at-p ...                                     */
-;*    -------------------------------------------------------------    */
-;*    Is there an highlight properties at position pos?                */
-;*---------------------------------------------------------------------*/
-(defun flyspell-properties-at-p (pos)
-  "Return t if there is a text property at POS, not counting `local-map'.
-If variable `flyspell-highlight-properties' is set to nil,
-text with properties are not checked.  This function is used to discover
-if the character at POS has any other property."
-  (let ((prop (text-properties-at pos))
-	(keep t))
-    (while (and keep (consp prop))
-      (if (and (eq (car prop) 'local-map) (consp (cdr prop)))
-	  (setq prop (cdr (cdr prop)))
-	(setq keep nil)))
-    (consp prop)))
-
-;*---------------------------------------------------------------------*/
-;*    make-flyspell-overlay ...                                        */
-;*---------------------------------------------------------------------*/
-(defun make-flyspell-overlay (beg end face mouse-face)
-  "Allocate an overlay to highlight an incorrect word.
-BEG and END specify the range in the buffer of that word.
-FACE and MOUSE-FACE specify the `face' and `mouse-face' properties
-for the overlay."
-  (let ((flyspell-overlay (make-overlay beg end nil t nil)))
-    (overlay-put flyspell-overlay 'face face)
-    (overlay-put flyspell-overlay 'mouse-face mouse-face)
-    (overlay-put flyspell-overlay 'flyspell-overlay t)
-    (overlay-put flyspell-overlay 'evaporate t)
-    (overlay-put flyspell-overlay 'help-echo "mouse-2: correct word at point")
-    (if flyspell-use-local-map
-        (overlay-put flyspell-overlay
-                     flyspell-overlay-keymap-property-name
-                     flyspell-mouse-map))
-    (when (eq face 'flyspell-incorrect-face)
-      (and (stringp flyspell-before-incorrect-word-string)
-           (overlay-put flyspell-overlay 'before-string
-                        flyspell-before-incorrect-word-string))
-      (and (stringp flyspell-after-incorrect-word-string)
-           (overlay-put flyspell-overlay 'after-string
-                        flyspell-after-incorrect-word-string)))
-    flyspell-overlay))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-highlight-incorrect-region ...                          */
-;*---------------------------------------------------------------------*/
-(defun flyspell-highlight-incorrect-region (beg end poss)
-  "Set up an overlay on a misspelled word, in the buffer from BEG to END."
-  (unless (run-hook-with-args-until-success
-           'flyspell-incorrect-hook beg end poss)
-    (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg)))
-        (progn
-	  ;; we cleanup all the overlay that are in the region, not
-	  ;; beginning at the word start position
-	  (if (< (1+ beg) end)
-	      (let ((os (overlays-in (1+ beg) end)))
-		(while (consp os)
-		  (if (flyspell-overlay-p (car os))
-		      (delete-overlay (car os)))
-		  (setq os (cdr os)))))
-          ;; we cleanup current overlay at the same position
-          (if (and (not flyspell-persistent-highlight)
-                   (overlayp flyspell-overlay))
-              (delete-overlay flyspell-overlay)
-            (let ((os (overlays-at beg)))
-              (while (consp os)
-                (if (flyspell-overlay-p (car os))
-                    (delete-overlay (car os)))
-                (setq os (cdr os)))))
-          ;; now we can use a new overlay
-          (setq flyspell-overlay
-                (make-flyspell-overlay beg end
-				       'flyspell-incorrect-face
-				       'highlight))))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-highlight-duplicate-region ...                          */
-;*---------------------------------------------------------------------*/
-(defun flyspell-highlight-duplicate-region (beg end)
-  "Set up an overlay on a duplicated word, in the buffer from BEG to END."
-  (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg)))
-      (progn
-	;; we cleanup current overlay at the same position
-	(if (and (not flyspell-persistent-highlight)
-		 (overlayp flyspell-overlay))
-	    (delete-overlay flyspell-overlay)
-	  (let ((overlays (overlays-at beg)))
-	    (while (consp overlays)
-	      (if (flyspell-overlay-p (car overlays))
-		  (delete-overlay (car overlays)))
-	      (setq overlays (cdr overlays)))))
-	;; now we can use a new overlay
-	(setq flyspell-overlay
-	      (make-flyspell-overlay beg end
-				     'flyspell-duplicate-face
-				     'highlight)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-auto-correct-cache ...                                  */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-auto-correct-pos nil)
-(defvar flyspell-auto-correct-region nil)
-(defvar flyspell-auto-correct-ring nil)
-(defvar flyspell-auto-correct-word nil)
-(make-variable-buffer-local 'flyspell-auto-correct-pos)
-(make-variable-buffer-local 'flyspell-auto-correct-region)
-(make-variable-buffer-local 'flyspell-auto-correct-ring)
-(make-variable-buffer-local 'flyspell-auto-correct-word)
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-check-previous-highlighted-word ...                     */
-;*---------------------------------------------------------------------*/
-(defun flyspell-check-previous-highlighted-word (&optional arg)
-  "Correct the closer misspelled word.
-This function scans a mis-spelled word before the cursor. If it finds one
-it proposes replacement for that word. With prefix arg, count that many
-misspelled words backwards."
-  (interactive)
-  (let ((pos1 (point))
-	(pos  (point))
-	(arg  (if (or (not (numberp arg)) (< arg 1)) 1 arg))
-	ov ovs)
-    (if (catch 'exit
-	  (while (and (setq pos (previous-overlay-change pos))
-		      (not (= pos pos1)))
-	    (setq pos1 pos)
-	    (if (> pos (point-min))
-		(progn
-		  (setq ovs (overlays-at (1- pos)))
-		  (while (consp ovs)
-		    (setq ov (car ovs))
-		    (setq ovs (cdr ovs))
-		    (if (and (overlay-get ov 'flyspell-overlay)
-			     (= 0 (setq arg (1- arg))))
-			(throw 'exit t)))))))
-	(save-excursion
-	  (goto-char pos)
-	  (ispell-word))
-      (error "No word to correct before point"))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-display-next-corrections ...                            */
-;*---------------------------------------------------------------------*/
-(defun flyspell-display-next-corrections (corrections)
-  (let ((string "Corrections:")
-	(l corrections)
-	(pos '()))
-    (while (< (length string) 80)
-      (if (equal (car l) flyspell-auto-correct-word)
-	  (setq pos (cons (+ 1 (length string)) pos)))
-      (setq string (concat string " " (car l)))
-      (setq l (cdr l)))
-    (while (consp pos)
-      (let ((num (car pos)))
-	(put-text-property num
-			   (+ num (length flyspell-auto-correct-word))
-			   'face
-			   'flyspell-incorrect-face
-			   string))
-      (setq pos (cdr pos)))
-    (if (fboundp 'display-message)
-	(display-message 'no-log string)
-      (message string))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-abbrev-table ...                                        */
-;*---------------------------------------------------------------------*/
-(defun flyspell-abbrev-table ()
-  (if flyspell-use-global-abbrev-table-p
-      global-abbrev-table
-    local-abbrev-table))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-define-abbrev ...                                       */
-;*---------------------------------------------------------------------*/
-(defun flyspell-define-abbrev (name expansion)
-  (let ((table (flyspell-abbrev-table)))
-    (when table
-      (define-abbrev table name expansion))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-auto-correct-word ...                                   */
-;*---------------------------------------------------------------------*/
-(defun flyspell-auto-correct-word ()
-  "Correct the current word.
-This command proposes various successive corrections for the current word."
-  (interactive)
-  (let ((pos     (point))
-	(old-max (point-max)))
-    ;; use the correct dictionary
-    (flyspell-accept-buffer-local-defs)
-    (if (and (eq flyspell-auto-correct-pos pos)
-	     (consp flyspell-auto-correct-region))
-	;; we have already been using the function at the same location
-	(let* ((start (car flyspell-auto-correct-region))
-	       (len   (cdr flyspell-auto-correct-region)))
-	  (flyspell-unhighlight-at start)
-	  (delete-region start (+ start len))
-	  (setq flyspell-auto-correct-ring (cdr flyspell-auto-correct-ring))
-	  (let* ((word (car flyspell-auto-correct-ring))
-		 (len  (length word)))
-	    (rplacd flyspell-auto-correct-region len)
-	    (goto-char start)
-	    (if flyspell-abbrev-p
-		(if (flyspell-already-abbrevp (flyspell-abbrev-table)
-					      flyspell-auto-correct-word)
-		    (flyspell-change-abbrev (flyspell-abbrev-table)
-					    flyspell-auto-correct-word
-					    word)
-		  (flyspell-define-abbrev flyspell-auto-correct-word word)))
-	    (funcall flyspell-insert-function word)
-	    (flyspell-word)
-	    (flyspell-display-next-corrections flyspell-auto-correct-ring))
-	  (flyspell-ajust-cursor-point pos (point) old-max)
-	  (setq flyspell-auto-correct-pos (point)))
-      ;; fetch the word to be checked
-      (let ((word (flyspell-get-word nil))
-	    start end poss)
-	;; destructure return word info list.
-	(setq start (car (cdr word))
-	      end (car (cdr (cdr word)))
-	      word (car word))
-	(setq flyspell-auto-correct-word word)
-	;; now check spelling of word.
-	(process-send-string ispell-process "%\n") ;put in verbose mode
-	(process-send-string ispell-process (concat "^" word "\n"))
-	;; wait until ispell has processed word
-	(while (progn
-		 (accept-process-output ispell-process)
-		 (not (string= "" (car ispell-filter)))))
-	(setq ispell-filter (cdr ispell-filter))
-	(if (consp ispell-filter)
-	    (setq poss (ispell-parse-output (car ispell-filter))))
-	(cond ((or (eq poss t) (stringp poss))
-	       ;; don't correct word
-	       t)
-	      ((null poss)
-	       ;; ispell error
-	       (error "Ispell: error in Ispell process"))
-	      (t
-	       ;; the word is incorrect, we have to propose a replacement
-	       (let ((replacements (if flyspell-sort-corrections
-				       (sort (car (cdr (cdr poss))) 'string<)
-				     (car (cdr (cdr poss))))))
-		 (setq flyspell-auto-correct-region nil)
-		 (if (consp replacements)
-		     (progn
-		       (let ((replace (car replacements)))
-			 (let ((new-word replace))
-			   (if (not (equal new-word (car poss)))
-			       (progn
-				 ;; the save the current replacements
-				 (setq flyspell-auto-correct-region
-				       (cons start (length new-word)))
-				 (let ((l replacements))
-				   (while (consp (cdr l))
-				     (setq l (cdr l)))
-				   (rplacd l (cons (car poss) replacements)))
-				 (setq flyspell-auto-correct-ring
-				       replacements)
-				 (flyspell-unhighlight-at start)
-				 (delete-region start end)
-				 (funcall flyspell-insert-function new-word)
-				 (if flyspell-abbrev-p
-				     (if (flyspell-already-abbrevp
-					  (flyspell-abbrev-table) word)
-					 (flyspell-change-abbrev
-					  (flyspell-abbrev-table)
-					  word
-					  new-word)
-				       (flyspell-define-abbrev word new-word)))
-				 (flyspell-word)
-				 (flyspell-display-next-corrections
-				  (cons new-word flyspell-auto-correct-ring))
-				 (flyspell-ajust-cursor-point pos
-							      (point)
-							      old-max))))))))))
-	(setq flyspell-auto-correct-pos (point))
-	(ispell-pdict-save t)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-auto-correct-previous-pos ...                           */
-;*---------------------------------------------------------------------*/
-(defvar flyspell-auto-correct-previous-pos nil
-  "Holds the start of the first incorrect word before point.")
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-auto-correct-previous-hook ...                          */
-;*---------------------------------------------------------------------*/
-(defun flyspell-auto-correct-previous-hook () 
-  "Hook to track successive calls to `flyspell-auto-correct-previous-word'.
-Sets flyspell-auto-correct-previous-pos to nil"
-  (interactive) 
-  (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t)
-  (unless (eq this-command (function flyspell-auto-correct-previous-word))
-    (setq flyspell-auto-correct-previous-pos nil)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-auto-correct-previous-word ...                          */
-;*---------------------------------------------------------------------*/
-(defun flyspell-auto-correct-previous-word (position) 
-  "*Auto correct the first mispelled word that occurs before point."
-  (interactive "d")
-
-  (add-hook 'pre-command-hook 
-	    (function flyspell-auto-correct-previous-hook) t t)
-
-  (save-excursion
-    (unless flyspell-auto-correct-previous-pos
-      ;; only reset if a new overlay exists
-      (setq flyspell-auto-correct-previous-pos nil)
-      
-      (let ((overlay-list (overlays-in (point-min) position))
-	    (new-overlay 'dummy-value))
-	
-	;; search for previous (new) flyspell overlay
-	(while (and new-overlay
-		    (or (not (flyspell-overlay-p new-overlay))
-			;; check if its face has changed
-			(not (eq (get-char-property 
-				  (overlay-start new-overlay) 'face) 
-				 'flyspell-incorrect-face))))
-	  (setq new-overlay (car-safe overlay-list))
-	  (setq overlay-list (cdr-safe overlay-list)))
-	
-	;; if nothing new exits new-overlay should be nil
-	(if new-overlay;; the length of the word may change so go to the start
-	    (setq flyspell-auto-correct-previous-pos 
-		  (overlay-start new-overlay)))))
-
-    (when flyspell-auto-correct-previous-pos
-      (save-excursion
-	(goto-char flyspell-auto-correct-previous-pos)
-	(let ((ispell-following-word t));; point is at start
-	  (if (numberp flyspell-auto-correct-previous-pos)
-	      (goto-char flyspell-auto-correct-previous-pos))
-	  (flyspell-auto-correct-word))
-	;; the point may have moved so reset this
-	(setq flyspell-auto-correct-previous-pos (point))))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-correct-word ...                                        */
-;*---------------------------------------------------------------------*/
-(defun flyspell-correct-word (event)
-  "Pop up a menu of possible corrections for a misspelled word.
-The word checked is the word at the mouse position."
-  (interactive "e")
-  ;; use the correct dictionary
-  (flyspell-accept-buffer-local-defs)
-  ;; retain cursor location (I don't know why but save-excursion here fails).
-  (let ((save (point)))
-    (mouse-set-point event)
-    (let ((cursor-location (point))
-	  (word (flyspell-get-word nil))
-	  start end poss replace)
-      ;; destructure return word info list.
-      (setq start (car (cdr word))
-	    end (car (cdr (cdr word)))
-	    word (car word))
-      ;; now check spelling of word.
-      (process-send-string ispell-process "%\n") ;put in verbose mode
-      (process-send-string ispell-process (concat "^" word "\n"))
-      ;; wait until ispell has processed word
-      (while (progn
-	       (accept-process-output ispell-process)
-	       (not (string= "" (car ispell-filter)))))
-      (setq ispell-filter (cdr ispell-filter))
-      (if (consp ispell-filter)
-	  (setq poss (ispell-parse-output (car ispell-filter))))
-      (cond ((or (eq poss t) (stringp poss))
-	     ;; don't correct word
-	     t)
-	    ((null poss)
-	     ;; ispell error
-	     (error "Ispell: error in Ispell process"))
-	    ((string-match "GNU" (emacs-version))
-	     ;; the word is incorrect, we have to propose a replacement
-	     (setq replace (flyspell-emacs-popup event poss word))
-	     (cond ((eq replace 'ignore)
-		    (goto-char save)
-		    nil)
-		   ((eq replace 'save)
-		    (goto-char save)
-		    (process-send-string ispell-process (concat "*" word "\n"))
-		    (flyspell-unhighlight-at cursor-location)
-		    (setq ispell-pdict-modified-p '(t)))
-		   ((or (eq replace 'buffer) (eq replace 'session))
-		    (process-send-string ispell-process (concat "@" word "\n"))
-		    (if (null ispell-pdict-modified-p)
-			(setq ispell-pdict-modified-p
-			      (list ispell-pdict-modified-p)))
-		    (flyspell-unhighlight-at cursor-location)
-		    (goto-char save)
-		    (if (eq replace 'buffer)
-			(ispell-add-per-file-word-list word)))
-		   (replace
-		    (flyspell-unhighlight-at cursor-location)
-		    (let ((new-word (if (atom replace)
-					replace
-				      (car replace)))
-			  (cursor-location (+ (- (length word) (- end start))
-					      cursor-location)))
-		      (if (not (equal new-word (car poss)))
-			  (let ((old-max (point-max)))
-			    (delete-region start end)
-			    (funcall flyspell-insert-function new-word)
-			    (if flyspell-abbrev-p
-				(flyspell-define-abbrev word new-word))
-			    (flyspell-ajust-cursor-point save
-							 cursor-location
-							 old-max)))))
-		   (t
-		    (goto-char save)
-		    nil)))
-	    ((eq flyspell-emacs 'xemacs)
-	     (flyspell-xemacs-popup
-	      event poss word cursor-location start end save)
-	     (goto-char save)))
-      (ispell-pdict-save t))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-xemacs-correct ...                                      */
-;*---------------------------------------------------------------------*/
-(defun flyspell-xemacs-correct (replace poss word cursor-location start end save)
-  "The xemacs popup menu callback."
-  (cond ((eq replace 'ignore)
-	 nil)
-	((eq replace 'save)
-	 (process-send-string ispell-process (concat "*" word "\n"))
-	 (process-send-string ispell-process "#\n")
-	 (flyspell-unhighlight-at cursor-location)
-	 (setq ispell-pdict-modified-p '(t)))
-	((or (eq replace 'buffer) (eq replace 'session))
-	 (process-send-string ispell-process (concat "@" word "\n"))
-	 (flyspell-unhighlight-at cursor-location)
-	 (if (null ispell-pdict-modified-p)
-	     (setq ispell-pdict-modified-p
-		   (list ispell-pdict-modified-p)))
-	 (if (eq replace 'buffer)
-	     (ispell-add-per-file-word-list word)))
-	(replace
-	 (let ((old-max (point-max))
-	       (new-word (if (atom replace)
-			     replace
-			   (car replace)))
-	       (cursor-location (+ (- (length word) (- end start))
-				   cursor-location)))
-	   (if (not (equal new-word (car poss)))
-	       (progn
-		 (delete-region start end)
-		 (goto-char start)
-		 (funcall flyspell-insert-function new-word)
-		 (if flyspell-abbrev-p
-		     (flyspell-define-abbrev word new-word))))
-	   (flyspell-ajust-cursor-point save cursor-location old-max)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-ajust-cursor-point ...                                  */
-;*---------------------------------------------------------------------*/
-(defun flyspell-ajust-cursor-point (save cursor-location old-max)
-  (if (>= save cursor-location)
-      (let ((new-pos (+ save (- (point-max) old-max))))
-	(goto-char (cond
-		    ((< new-pos (point-min))
-		     (point-min))
-		    ((> new-pos (point-max))
-		     (point-max))
-		    (t new-pos))))
-    (goto-char save)))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-emacs-popup ...                                         */
-;*---------------------------------------------------------------------*/
-(defun flyspell-emacs-popup (event poss word)
-  "The Emacs popup menu."
-  (if (not event)
-      (let* ((mouse-pos  (mouse-position))
-	     (mouse-pos  (if (nth 1 mouse-pos)
-			     mouse-pos
-			   (set-mouse-position (car mouse-pos)
-				 	       (/ (frame-width) 2) 2)
-			   (unfocus-frame)
-			   (mouse-position))))
-	(setq event (list (list (car (cdr mouse-pos))
-				(1+ (cdr (cdr mouse-pos))))
-			  (car mouse-pos)))))
-  (let* ((corrects   (if flyspell-sort-corrections
-			 (sort (car (cdr (cdr poss))) 'string<)
-		       (car (cdr (cdr poss)))))
-	 (cor-menu   (if (consp corrects)
-			 (mapcar (lambda (correct)
-				   (list correct correct))
-				 corrects)
-		       '()))
-	 (affix      (car (cdr (cdr (cdr poss)))))
-	 (base-menu  (let ((save (if (consp affix)
-				     (list
-				      (list (concat "Save affix: " (car affix))
-					    'save)
-				      '("Accept (session)" session)
-				      '("Accept (buffer)" buffer))
-				   '(("Save word" save)
-				     ("Accept (session)" session)
-				     ("Accept (buffer)" buffer)))))
-		       (if (consp cor-menu)
-			   (append cor-menu (cons "" save))
-			 save)))
-	 (menu       (cons "flyspell correction menu" base-menu)))
-    (car (x-popup-menu event
-		       (list (format "%s [%s]" word (or ispell-local-dictionary
-							ispell-dictionary))
-			     menu)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-xemacs-popup ...                                        */
-;*---------------------------------------------------------------------*/
-(defun flyspell-xemacs-popup (event poss word cursor-location start end save)
-  "The XEmacs popup menu."
-  (let* ((corrects   (if flyspell-sort-corrections
-			 (sort (car (cdr (cdr poss))) 'string<)
-		       (car (cdr (cdr poss)))))
-	 (cor-menu   (if (consp corrects)
-			 (mapcar (lambda (correct)
-				   (vector correct
-					   (list 'flyspell-xemacs-correct
-						 correct
-						 (list 'quote poss)
-						 word
-						 cursor-location
-						 start
-						 end
-						 save)
-					   t))
-				 corrects)
-		       '()))
-	 (affix      (car (cdr (cdr (cdr poss)))))
-	 (menu       (let ((save (if (consp affix)
-				     (vector
-				      (concat "Save affix: " (car affix))
-				      (list 'flyspell-xemacs-correct
-					    ''save
-					    (list 'quote poss)
-					    word
-					    cursor-location
-					    start
-					    end
-					    save)
-				      t)
-				   (vector
-				    "Save word"
-				    (list 'flyspell-xemacs-correct
-					  ''save
-					  (list 'quote poss)
-					  word
-					  cursor-location
-					  start
-					  end
-					  save)
-				    t)))
-			   (session (vector "Accept (session)"
-					    (list 'flyspell-xemacs-correct
-						  ''session
-						  (list 'quote poss)
-						  word
-						  cursor-location
-						  start
-						  end
-						  save)
-					    t))
-			   (buffer  (vector "Accept (buffer)"
-					    (list 'flyspell-xemacs-correct
-						  ''buffer
-						  (list 'quote poss)
-						  word
-						  cursor-location
-						  start
-						  end
-						  save)
-					    t)))
-		       (if (consp cor-menu)
-			   (append cor-menu (list "-" save session buffer))
-			 (list save session buffer)))))
-    (popup-menu (cons (format "%s [%s]" word (or ispell-local-dictionary
-						 ispell-dictionary))
-		      menu))))
-
-;*---------------------------------------------------------------------*/
-;*    Some example functions for real autocorrecting                   */
-;*---------------------------------------------------------------------*/
-(defun flyspell-maybe-correct-transposition (beg end poss)
-  "Check replacements for transposed characters.
-
-If the text between BEG and END is equal to a correction suggested by
-Ispell, after transposing two adjacent characters, correct the text,
-and return t.
-
-The third arg POSS is either the symbol 'doublon' or a list of
-possible corrections as returned by 'ispell-parse-output'.
-
-This function is meant to be added to 'flyspell-incorrect-hook'."
-  (when (consp poss)    
-    (catch 'done
-      (save-excursion
-        (goto-char (1+ beg))
-        (while (< (point) end)
-          (transpose-chars 1)
-          (when (member (buffer-substring beg end) (car (cdr (cdr poss))))
-            (throw 'done t))
-          (transpose-chars -1)
-          (forward-char))
-        nil))))
-
-(defun flyspell-maybe-correct-doubling (beg end poss)
-  "Check replacements for doubled characters.
-
-If the text between BEG and END is equal to a correction suggested by
-Ispell, after removing a pair of doubled characters, correct the text,
-and return t.
-
-The third arg POSS is either the symbol 'doublon' or a list of
-possible corrections as returned by 'ispell-parse-output'.
-
-This function is meant to be added to 'flyspell-incorrect-hook'."
-  (when (consp poss) 
-    (catch 'done
-      (save-excursion
-        (let ((last (char-after beg))
-              this)
-          (goto-char (1+ beg))          
-          (while (< (point) end)
-            (setq this (char-after))
-            (if (not (char-equal this last))
-                (forward-char)
-              (delete-char 1)
-              (when (member (buffer-substring beg (1- end)) (car (cdr (cdr poss))))
-                (throw 'done t))
-              ;; undo
-              (insert-char this 1))            
-            (setq last this))
-          nil)))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-already-abbrevp ...                                     */
-;*---------------------------------------------------------------------*/
-(defun flyspell-already-abbrevp (table word)
-  (let ((sym (abbrev-symbol word table)))
-    (and sym (symbolp sym))))
-
-;*---------------------------------------------------------------------*/
-;*    flyspell-change-abbrev ...                                       */
-;*---------------------------------------------------------------------*/
-(defun flyspell-change-abbrev (table old new)
-  (set (abbrev-symbol old table) new))
-  
-(provide 'flyspell)
-;;; flyspell.el ends here
-;;; </pre>
diff --git a/xemacs-packages/lisp/text-modes/folding.el b/xemacs-packages/lisp/text-modes/folding.el
deleted file mode 100644
index 30cb9eea..00000000
--- a/xemacs-packages/lisp/text-modes/folding.el
+++ /dev/null
@@ -1,5356 +0,0 @@
-;;; folding.el --- A folding-editor-like minor mode.
-
-;; Copyright (C) 2002-2006
-;;	     Jari Aalto
-;; Copyright (C) 1994-2001
-;;           Jari Aalto, Anders Lindgren.
-;; Copyright (C) 1992, 1993
-;;           Jamie Lokier, All rights reserved.
-;;
-;; Author:      Jamie Lokier    <jamie A T imbolc.ucc dt ie>
-;;              Jari Aalto
-;;              Anders Lindgren <andersl A T csd.uu dt se>
-;; Maintainer:  Jari Aalto <jari aalto A T cante dt net>
-;;              Anders Lindgren <andersl A T csd.uu dt se>
-;; Created:     1992
-;; Version:     2004.1125 (2.117+)
-;; RCS version: $Revision: 1.21 $
-;; Date:        $Date: 2005/09/14 05:43:36 $
-;; Keywords:    tools
-
-;;{{{ 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 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:
-
-;;{{{ 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 <trey A T cs berkeley edu>
-;;
-;;          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.
-;;
-;;  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.
-
-;;      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.
-
-;;}}}
-
-;;{{{ 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   `<major mode>-folding-hook'
-;;           Called when starting folding mode in a buffer with major
-;;           mode set to <major mode>. (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 <letter>    -- Reserved for the users private keymap.
-;;          C-c C-<letter>  -- Major mode. (Some other keys are
-;;                             reserved as well.)
-;;          C-c <Punctuation Char> <Whatever>
-;;                          -- 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'. Example:
-;;
-;;          (folding-add-to-marks-list
-;;           'c-mode "/* {{{ " "/* }}} */" " */" t)
-;;          (folding-add-to-marks-list
-;;           'java-mode "// {{{ " "// }}}" nil 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."
-;;            (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 <solofo A T mpi-sb mpg de>
-;;
-;;          % 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.
-;;
-;; Nov  25  2004  21.3             [jari 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
-;;   <Claude BOUCHER A T astrium-space com>
-;; - Removed LCD entry - unnecessary.
-;;
-;; Jan  24  2002  20.7             [jari 2.100]
-;; - (folding-context-next-action):New user function.
-;;   Code by Scott Evans <gse A T antisleep com>
-;; - (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  <gleb A T barsook com> 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 <dmasters A T rational com> 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 <thomas ruhnau A T intermetall de>
-;; - (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 <juhtolv A T st jyu fi>. 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 <juhtolv A T st jyu fi>
-;; - (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 <oub A T eucmos sim ucm es>. 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
-;;   <smikes A T alumni hmc edu> 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 <blackie A T imada ou dk> 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 <blackie A T  imada ou dk>
-;;   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 <blackie A T imada ou dk> 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 <gleb A T CS Stanford EDU> 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 <gleb A T CS Stanford EDU> 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 <oub A T sunma4 mat ucm es> 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 A T alphatech com> (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 <gleb A T cs stanford edu> 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 <steve A T fmrib ox ac uk> 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 <andrewm A T bristol st com> 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 <affi A T osc no> 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 <R Kubia A T ipipan gda pl>.
-;; - 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 <solofo A T mpi-sb mpg de>
-;; - 1998-05-04 Ryszard Kubiak <R Kubiak A T ipipan gda pl> 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"
-;;   <R Kubiak A T ipipan gda pl>
-;;
-;; 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
-;;   <wadams A T galaxy sps mot com>
-;; - 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
-;;   <Petteri Kettunen A T oulu fi>
-;; - 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 <oub A T sunma4 mat ucm es> 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 <rxmarsha A T bechtel com> 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 <rxmarsha A T bechtel com> 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 <Guido Van Hoecke A T bigfoot com> 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 <oub A T sunma4 mat ucm es> 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 <done A T ece arizona edu> sent patch that replaced
-;;   selective display code with overlays.
-;;
-;; Feb 10 1997  19.28             [jari 2.8]
-;; - Ricardo Marek <ricky A T ornet co il> 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 <stig A T hackvan com>
-;;
-;; 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 <davidm A T prism kla com> 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))
-(require 'easymenu)
-
-(defvar folding-package-url-location
-  "Latest folding is available at XEmacs CVS server
-  cvs -d :pserver:cvs@cvs.xemacs.org:/pack/xemacscvs \
-      co -d xemacs-text-modes \
-      XEmacs/packages/xemacs-packages/text-modes"
-  "Location where to get folding.
-  `folding-insert-advertise-folding-mode'.")
-
-;;}}}
-;;{{{ 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.21 $" 11 15)
-  "Version number of folding.el.")
-
-;;}}}
-;;{{{ setup: bind
-
-;;; .......................................................... &v-bind ...
-
-;; Custom hack for Emacs that does not have custom
-
-(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 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)
-
-(when folding-advice-instantiate
-  (eval-when-compile (require 'advice))
-  ;; By Robert Marshall <rxmarsha A T bechtel com>
-  (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 (eq folding-shift-in-on-goto 'show)
-				   (progn
-				     (folding-show-current-entry t t)
-				     (folding-point-folded-p goal))
-				 (folding-shift-in t))
-			     (goto-char goal)))
-		    (folding-narrow-to-region (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))
-
-;;; I write this function, just in case we ever would like to add
-;;; `hideif' support to folding mode. Currently, it is only used to
-;;; remind me which keys I shouldn't use.
-
-;;(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 `<major-mode>-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)
-      (mapcar '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 (interactive-p)
-	(message "Folding: Cursor not over fold. Can't removed fold marks.")
-	nil)
-    (multiple-value-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 (interactive-p)
-	  (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 (#<window 34 on *scratch*> 128 (20 . 104) -23723628))
-    ;; event-start : (#<window 34 on *scratch*> 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" 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" 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
-
-(defun folding-is-hooked ()
-  "Check if folding hooks are installed."
-  (and (memq 'folding-mode-write-file write-file-hooks)
-       (memq 'folding-mode-find-file  find-file-hooks)))
-
-;;;###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 write-file-hooks)
-      (add-hook 'write-file-hooks '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 find-file-hooks)
-      (add-hook 'find-file-hooks '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.
-  (multiple-value-bind (beg end)
-      (folding-get-mode-marks (or mode major-mode))
-    (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
-			 ;;  Hide variable from byte compiler.
-			 (let ((sym 'global-font-lock-mode))
-			   (and (boundp sym)
-				(symbol-value sym)))))
-	    ;; #todo: 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 (`(interactive-p)' 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 `<major-mode-name>-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 (interactive-p)
-		       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: \"<!-- [[[ \"
-      bot: \"<!-- ]]] -->\"
-      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 <gse A T antisleep com>
-(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)
-  (let ((goal (point)))
-    (if (folding-skip-ellipsis-backward)
-	(while (prog2 (beginning-of-line)
-		      (folding-shift-in t)
-		      (goto-char goal)))
-      (let ((data (folding-show-current-entry noerror t)))
-	(and data
-	     (progn
-	       (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))
-	       (nth 2 data)))))))
-
-;;}}}
-;;{{{ 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)
-		   (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 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-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 (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
-					 "<Replaced missing fold 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: <Original-name>*', 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 '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))))) ()
-	  "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)
-    (multiple-value-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
-
-;; Local variables:
-;; folded-file: t
-;; folding-internal-margins: nil
-;; end:
-
-(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/xemacs-packages/lisp/text-modes/hexl.el b/xemacs-packages/lisp/text-modes/hexl.el
deleted file mode 100644
index 33ef65ab..00000000
--- a/xemacs-packages/lisp/text-modes/hexl.el
+++ /dev/null
@@ -1,962 +0,0 @@
-;;; hexl.el --- edit a file in a hex dump format using the hexl filter.
-
-;; Copyright (C) 1989, 1994, 1998 Free Software Foundation, Inc.
-
-;; Author: Keith Gabryelski <ag@wheaties.ai.mit.edu>
-;; Maintainer: FSF
-;; Keywords: data
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 21.0.103.
-
-;;; Commentary:
-
-;; This package implements a major mode for editing binary files.  It uses
-;; a program called hexl, supplied with the GNU Emacs distribution, that
-;; can filter a binary into an editable format or from the format back into
-;; binary.  For full instructions, invoke `hexl-mode' on an empty buffer and
-;; do `M-x describe-mode'.
-;;
-;; This may be useful in your .emacs:
-;;
-;;	(autoload 'hexl-find-file "hexl"
-;;	  "Edit file FILENAME in hexl-mode." t)
-;;	
-;;	(define-key global-map "\C-c\C-h" 'hexl-find-file)
-;;
-;; NOTE: Remember to change HEXL-PROGRAM or HEXL-OPTIONS if needed.
-;;
-;; Currently hexl only supports big endian hex output with 16 bit
-;; grouping.
-;;
-;; -iso in `hexl-options' will allow iso characters to display in the
-;; ASCII region of the screen (if your emacs supports this) instead of
-;; changing them to dots.
-
-;;; Code:
-
-;;
-;; vars here
-;;
-
-(defgroup hexl nil
-  "Edit a file in a hex dump format using the hexl filter."
-  :group 'data)
-
-
-(defcustom hexl-program "hexl"
-  "The program that will hexlify and dehexlify its stdin.
-`hexl-program' will always be concatenated with `hexl-options'
-and \"-de\" when dehexlifying a buffer."
-  :type 'string
-  :group 'hexl)
-
-(defcustom hexl-iso ""
-  "If your emacs can handle ISO characters, this should be set to
-\"-iso\" otherwise it should be \"\"."
-  :type 'string
-  :group 'hexl)
-
-(defcustom hexl-options (format "-hex %s" hexl-iso)
-  "Options to hexl-program that suit your needs."
-  :type 'string
-  :group 'hexl)
-
-(defcustom hexlify-command
-  (format "%s %s"
-	  (shell-quote-argument
-	   (expand-file-name hexl-program exec-directory))
-	  hexl-options)
-  "The command to use to hexlify a buffer."
-  :type 'string
-  :group 'hexl)
-
-(defcustom dehexlify-command
-  (format "%s -de %s"
-	  (shell-quote-argument
-	   (expand-file-name hexl-program exec-directory))
-	  hexl-options)
-  "The command to use to unhexlify a buffer."
-  :type 'string
-  :group 'hexl)
-
-(defcustom hexl-follow-ascii t
-  "If non-nil then highlight the ASCII/HEX character corresponding to point."
-  :type 'boolean
-  :group 'hexl
-  :version "20.3")
-
-(defvar hexl-max-address 0
-  "Maximum offset into hexl buffer.")
-
-(defvar hexl-mode-map nil)
-(defvar hexl-mode-old-local-map)
-(defvar hexl-mode-old-mode-name)
-(defvar hexl-mode-old-major-mode)
-(defvar hexl-mode-old-write-contents-hooks)
-(defvar hexl-mode-old-require-final-newline)
-(defvar hexl-mode-old-syntax-table)
-
-(defvar hexl-ascii-extent nil
-  "Extent used to highlight ASCII element corresponding to current point.")
-(make-variable-buffer-local 'hexl-ascii-extent)
-(defvar hexl-current-address)
-(make-variable-buffer-local 'hexl-current-address)
-
-;; routines
-
-(put 'hexl-mode 'mode-class 'special)
-
-;;;###autoload
-(defun hexl-mode (&optional arg)
-  "\\<hexl-mode-map>A mode for editing binary files in hex dump format.
-This is not an ordinary major mode; it alters some aspects
-if the current mode's behavior, but not all; also, you can exit
-Hexl mode and return to the previous mode using `hexl-mode-exit'.
-
-This function automatically converts a buffer into the hexl format
-using the function `hexlify-buffer'.
-
-Each line in the buffer has an \"address\" (displayed in hexadecimal)
-representing the offset into the file that the characters on this line
-are at and 16 characters from the file (displayed as hexadecimal
-values grouped every 16 bits) and as their ASCII values.
-
-If any of the characters (displayed as ASCII characters) are
-unprintable (control or meta characters) they will be replaced as
-periods.
-
-If `hexl-mode' is invoked with an argument the buffer is assumed to be
-in hexl format.
-
-A sample format:
-
-  HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f     ASCII-TEXT
-  --------  ---- ---- ---- ---- ---- ---- ---- ----  ----------------
-  00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64  This is hexl-mod
-  00000010: 652e 2020 4561 6368 206c 696e 6520 7265  e.  Each line re
-  00000020: 7072 6573 656e 7473 2031 3620 6279 7465  presents 16 byte
-  00000030: 7320 6173 2068 6578 6164 6563 696d 616c  s as hexadecimal
-  00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74   ASCII.and print
-  00000050: 6162 6c65 2041 5343 4949 2063 6861 7261  able ASCII chara
-  00000060: 6374 6572 732e 2020 416e 7920 636f 6e74  cters.  Any cont
-  00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949  rol or non-ASCII
-  00000080: 2063 6861 7261 6374 6572 730a 6172 6520   characters.are 
-  00000090: 6469 7370 6c61 7965 6420 6173 2070 6572  displayed as per
-  000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e  iods in the prin
-  000000b0: 7461 626c 6520 6368 6172 6163 7465 7220  table character 
-  000000c0: 7265 6769 6f6e 2e0a                      region..
-
-Movement is as simple as movement in a normal emacs text buffer.  Most
-cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
-to move the cursor left, right, down, and up).
-
-Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are
-also supported.
-
-There are several ways to change text in hexl mode:
-
-ASCII characters (character between space (0x20) and tilde (0x7E)) are
-bound to self-insert so you can simply type the character and it will
-insert itself (actually overstrike) into the buffer.
-
-\\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if
-it isn't bound to self-insert.  An octal number can be supplied in place
-of another key to insert the octal number's ASCII representation.
-
-\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF)
-into the buffer at the current point.
-
-\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377)
-into the buffer at the current point.
-
-\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
-into the buffer at the current point.
-
-\\[hexl-mode-exit] will exit hexl-mode.
-
-Note: saving the file with any of the usual Emacs commands
-will actually convert it back to binary format while saving.
-
-You can use \\[hexl-find-file] to visit a file in Hexl mode.
-
-\\[describe-bindings] for advanced commands."
-  (interactive "p")
-  (unless (eq major-mode 'hexl-mode)
-    (let ((modified (buffer-modified-p))
-	  (inhibit-read-only t)
-	  (original-point (1- (point)))
-	  max-address)
-      (and (eobp) (not (bobp))
-	   (setq original-point (1- original-point)))
-      (if (not (or (eq arg 1) (not arg)))
-	  ;; if no argument then we guess at hexl-max-address
-	  (setq max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15))
-	(setq max-address (1- (buffer-size)))
-	(hexlify-buffer)
-	(set-buffer-modified-p modified))
-      (make-local-variable 'hexl-max-address)
-      (setq hexl-max-address max-address)
-      (hexl-goto-address original-point))
-
-    ;; We do not turn off the old major mode; instead we just
-    ;; override most of it.  That way, we can restore it perfectly.
-    (make-local-variable 'hexl-mode-old-local-map)
-    (setq hexl-mode-old-local-map (current-local-map))
-    (use-local-map hexl-mode-map)
-
-    (make-local-variable 'hexl-mode-old-mode-name)
-    (setq hexl-mode-old-mode-name mode-name)
-    (setq mode-name "Hexl")
-
-    (make-local-variable 'hexl-mode-old-major-mode)
-    (setq hexl-mode-old-major-mode major-mode)
-    (setq major-mode 'hexl-mode)
-
-    (make-local-variable 'hexl-mode-old-syntax-table)
-    (setq hexl-mode-old-syntax-table (syntax-table))
-    (set-syntax-table (standard-syntax-table))
-
-    (make-local-variable 'hexl-mode-old-write-contents-hooks)
-    (setq hexl-mode-old-write-contents-hooks write-contents-hooks)
-    (make-local-variable 'write-contents-hooks)
-    (add-hook 'write-contents-hooks 'hexl-save-buffer)
-
-    (make-local-variable 'hexl-mode-old-require-final-newline)
-    (setq hexl-mode-old-require-final-newline require-final-newline)
-    (make-local-variable 'require-final-newline)
-    (setq require-final-newline nil)
-
-    ;; Add hooks to rehexlify or dehexlify on various events.
-    (make-local-hook 'after-revert-hook)
-    (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t)
-
-    (make-local-hook 'change-major-mode-hook)
-    (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)
-
-    (make-local-variable 'modeline-format)
-    (setq modeline-format (append '("--" hexl-current-address "--")
-                                  (default-value 'modeline-format)))
-    
-    (if hexl-follow-ascii (hexl-follow-ascii 1)))
-  (run-hooks 'hexl-mode-hook))
-
-(defun hexl-after-revert-hook ()
-  (setq hexl-max-address (1- (buffer-size)))
-  (hexlify-buffer)
-  (set-buffer-modified-p nil))
-
-(defvar hexl-in-save-buffer nil)
-
-(defun hexl-save-buffer ()
-  "Save a hexl format buffer as binary in visited file if modified."
-  (interactive)
-  (if hexl-in-save-buffer nil
-    (set-buffer-modified-p (if (buffer-modified-p)
-			       (save-excursion
-				 (let ((buf (generate-new-buffer " hexl"))
-				       (name (buffer-name))
-				       ;(file-name (buffer-file-name))
-				       (start (point-min))
-				       (end (point-max))
-				       modified)
-				   (set-buffer buf)
-				   (insert-buffer-substring name start end)
-				   (set-buffer name)
-				   (dehexlify-buffer)
-				   ;; Prevent infinite recursion.
-				   (let ((hexl-in-save-buffer t))
-				     (save-buffer))
-				   (setq modified (buffer-modified-p))
-				   (delete-region (point-min) (point-max))
-				   (insert-buffer-substring buf start end)
-				   (kill-buffer buf)
-				   modified))
-			     (message "(No changes need to be saved)")
-			     nil))
-    ;; Return t to indicate we have saved t
-    t))
-
-;;;###autoload
-(defun hexl-find-file (filename)
-  "Edit file FILENAME in hexl-mode.
-Switch to a buffer visiting file FILENAME, creating one if none exists."
-  (interactive "fFilename: ")
-  (if (featurep 'file-coding)
-      (find-file filename 'binary)
-    (find-file filename))
-  (if (not (eq major-mode 'hexl-mode))
-      (hexl-mode)))
-
-(defun hexl-mode-exit (&optional arg)
-  "Exit Hexl mode, returning to previous mode.
-With arg, don't unhexlify buffer."
-  (interactive "p")
-  (if (or (eq arg 1) (not arg))
-      (let ((modified (buffer-modified-p))
-	    (inhibit-read-only t)
-	    (original-point (1+ (hexl-current-address))))
-	(dehexlify-buffer)
-	(remove-hook 'write-contents-hooks 'hexl-save-buffer)
-	(set-buffer-modified-p modified)
-	(goto-char original-point)))
-
-  (remove-hook 'after-revert-hook 'hexl-after-revert-hook t)
-  (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
-  (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
-  (setq hexl-ascii-extent nil)
-
-  (setq write-contents-hooks hexl-mode-old-write-contents-hooks)
-  (setq require-final-newline hexl-mode-old-require-final-newline)
-  (setq mode-name hexl-mode-old-mode-name)
-  (use-local-map hexl-mode-old-local-map)
-  (set-syntax-table hexl-mode-old-syntax-table)
-  (setq major-mode hexl-mode-old-major-mode)
-  (force-mode-line-update)
-  (run-hooks 'hexl-mode-exit-hook))
-
-(defun hexl-maybe-dehexlify-buffer ()
-  "Convert a hexl format buffer to binary.
-Ask the user for confirmation."
-  (if (y-or-n-p "Convert contents back to binary format? ")
-      (let ((modified (buffer-modified-p))
-	    (inhibit-read-only t)
-	    (original-point (1+ (hexl-current-address))))
-	(dehexlify-buffer)
-	(remove-hook 'write-contents-hooks 'hexl-save-buffer)
-	(set-buffer-modified-p modified)
-	(goto-char original-point))))
-
-(defun hexl-current-address (&optional validate)
-  "Return current hexl-address."
-  (interactive)
-  (let ((current-column (- (% (point) 68) 11))
-	(hexl-address 0))
-    (if (< current-column 0)
-	(if validate
-	    (error "Point is not on a character in the file")
-	  (setq current-column 0)))
-    (setq hexl-address
-	  (+ (* (/ (point) 68) 16)
-	     (if (>= current-column 41)
-		 (- current-column 41)
-	       (/ (- current-column  (/ current-column 5)) 2))))
-    (if (interactive-p)
-        (message "Current address 0x%010x = %10d" hexl-address hexl-address))
-    hexl-address))
-
-(defun hexl-hex-position (address)
-  "Return the ascii-position."
-  (+ (* (/ address 16) 68)
-     11
-     (* 2 (% address 16))
-     (/ (% address 16) 2)))
-
-(defun hexl-ascii-position (address)
-  "Return the ascii-position."
-  (+ (* (/ address 16) 68) 52 (% address 16)))
-
-(defun hexl-at-ascii-position (address)
-  "Return t if point is at ascii position."
-  (= (point) (hexl-ascii-position address)))
-
-(defun hexl-address-to-marker (address)
-  "Return buffer position for ADDRESS."
-  (interactive "nAddress: ")
-  (+ (* (/ address 16) 68) 11 (/ (* (% address 16) 5) 2)))
-
-(defun hexl-goto-address (address &optional nipple)
-  "Go to hexl-mode (decimal) address ADDRESS.
-Signal error if ADDRESS out of range."
-  (interactive "nAddress: ")
-  (if (or (< address 0) (> address hexl-max-address))
-      (error "Out of hexl region."))
-  (goto-char
-   (if (hexl-at-ascii-position (hexl-current-address))
-       (hexl-ascii-position address)
-     (+ (hexl-address-to-marker address) (or nipple 0)))))
-
-(defun hexl-goto-hex-address (hex-address)
-  "Go to hexl-mode address (hex string) HEX-ADDRESS.
-Signal error if HEX-ADDRESS is out of range."
-  (interactive "sHex Address: ")
-  (hexl-goto-address (hexl-hex-string-to-integer hex-address)))
-
-(defun hexl-hex-string-to-integer (hex-string)
-  "Return decimal integer for HEX-STRING."
-  (interactive "sHex number: ")
-  (let ((hex-num 0))
-    (while (not (equal hex-string ""))
-      (setq hex-num (+ (* hex-num 16)
-		       (hexl-hex-char-to-integer (string-to-char hex-string))))
-      (setq hex-string (substring hex-string 1)))
-    hex-num))
-
-(defun hexl-octal-string-to-integer (octal-string)
-  "Return decimal integer for OCTAL-STRING."
-  (interactive "sOctal number: ")
-  (let ((oct-num 0))
-    (while (not (equal octal-string ""))
-      (setq oct-num (+ (* oct-num 8)
-		       (hexl-oct-char-to-integer
-			(string-to-char octal-string))))
-      (setq octal-string (substring octal-string 1)))
-    oct-num))
-
-;; move point functions
-
-(defun hexl-backward-char (arg)
-  "Move to left ARG bytes (right if ARG negative) in hexl-mode."
-  (interactive "p")
-  (let ((col (current-column)))
-    (if (< col 50)
-        (if (member (% col 5) '(0 2))
-            (hexl-goto-address (- (hexl-current-address) arg) 1)
-          (hexl-goto-address (hexl-current-address) 0))
-      (hexl-goto-address (- (hexl-current-address) arg) col))))
-
-(defun hexl-forward-char (arg)
-  "Move right ARG bytes (left if ARG negative) in hexl-mode."
-  (interactive "p")
-  (let ((col (current-column)))
-    (if (< col 50)
-        (if (member (% col 5) '(0 2))
-            (hexl-goto-address (hexl-current-address) 1)
-          (hexl-goto-address (+ (hexl-current-address) arg) 0))
-      (hexl-goto-address (+ (hexl-current-address) arg) col))))
-
-(defun hexl-backward-short (arg)
-  "Move to left ARG shorts (right if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-goto-address (let ((address (hexl-current-address)))
-		       (if (< arg 0)
-			   (progn
-			     (setq arg (- arg))
-			     (while (> arg 0)
-			       (if (not (equal address (logior address 3)))
-				   (if (> address hexl-max-address)
-				       (progn
-					 (message "End of buffer.")
-					 (setq address hexl-max-address))
-				     (setq address (logior address 3)))
-				 (if (> address hexl-max-address)
-				     (progn
-				       (message "End of buffer.")
-				       (setq address hexl-max-address))
-				   (setq address (+ address 4))))
-			       (setq arg (1- arg)))
-			     (if (> address hexl-max-address)
-				 (progn
-				   (message "End of buffer.")
-				   (setq address hexl-max-address))
-			       (setq address (logior address 3))))
-			 (while (> arg 0)
-			   (if (not (equal address (logand address -4)))
-			       (setq address (logand address -4))
-			     (if (not (equal address 0))
-				 (setq address (- address 4))
-			       (message "Beginning of buffer.")))
-			   (setq arg (1- arg))))
-		       address)))
-
-(defun hexl-forward-short (arg)
-  "Move right ARG shorts (left if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-backward-short (- arg)))
-
-(defun hexl-backward-word (arg)
-  "Move to left ARG words (right if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-goto-address (let ((address (hexl-current-address)))
-		       (if (< arg 0)
-			   (progn
-			     (setq arg (- arg))
-			     (while (> arg 0)
-			       (if (not (equal address (logior address 7)))
-				   (if (> address hexl-max-address)
-				       (progn
-					 (message "End of buffer.")
-					 (setq address hexl-max-address))
-				     (setq address (logior address 7)))
-				 (if (> address hexl-max-address)
-				     (progn
-				       (message "End of buffer.")
-				       (setq address hexl-max-address))
-				   (setq address (+ address 8))))
-			       (setq arg (1- arg)))
-			     (if (> address hexl-max-address)
-				 (progn
-				   (message "End of buffer.")
-				   (setq address hexl-max-address))
-			       (setq address (logior address 7))))
-			 (while (> arg 0)
-			   (if (not (equal address (logand address -8)))
-			       (setq address (logand address -8))
-			     (if (not (equal address 0))
-				 (setq address (- address 8))
-			       (message "Beginning of buffer.")))
-			   (setq arg (1- arg))))
-		       address)))
-
-(defun hexl-forward-word (arg)
-  "Move right ARG words (left if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-backward-word (- arg)))
-
-(defun hexl-previous-line (arg)
-  "Move vertically up ARG lines [16 bytes] (down if ARG negative) in hexl-mode.
-If there is byte at the target address move to the last byte in that line."
-  (interactive "p")
-  (hexl-next-line (- arg)))
-
-(defun hexl-next-line (arg)
-  "Move vertically down ARG lines [16 bytes] (up if ARG negative) in hexl-mode.
-If there is no byte at the target address move to the last byte in that line."
-  (interactive "p")
-  (hexl-goto-address (let ((address (+ (hexl-current-address) (* arg 16))))
-		       (if (and (< arg 0) (< address 0))
-				(progn (message "Out of hexl region.")
-				       (setq address
-					     (% (hexl-current-address) 16)))
-			 (if (and (> address hexl-max-address)
-				  (< (% hexl-max-address 16) (% address 16)))
-			     (setq address hexl-max-address)
-			   (if (> address hexl-max-address)
-			       (progn (message "Out of hexl region.")
-				      (setq
-				       address
-				       (+ (logand hexl-max-address -16)
-					  (% (hexl-current-address) 16)))))))
-		       address)))
-
-(defun hexl-beginning-of-buffer (arg)
-  "Move to the beginning of the hexl buffer.
-Leaves `hexl-mark' at previous position.
-With prefix arg N, puts point N bytes of the way from the true beginning."
-  (interactive "p")
-  (push-mark (point))
-  (hexl-goto-address (+ 0 (1- arg))))
-
-(defun hexl-end-of-buffer (arg)
-  "Go to `hexl-max-address' minus ARG."
-  (interactive "p")
-  (push-mark (point))
-  (hexl-goto-address (- hexl-max-address (1- arg))))
-
-(defun hexl-beginning-of-line ()
-  "Goto beginning of line in hexl mode."
-  (interactive)
-  (let ((address (hexl-current-address)))
-    (hexl-goto-address (- address (% address 16)))))
-
-(defun hexl-end-of-line ()
-  "Goto end of line in hexl mode."
-  (interactive)
-  (hexl-goto-address (let ((address (logior (hexl-current-address) 15)))
-		       (if (> address hexl-max-address)
-			   (setq address hexl-max-address))
-		       address)))
-
-(defun hexl-switch-position ()
-  "Switch cursor from ASCII to HEX position or vice versa."
-  (interactive)
-  (goto-char
-   (let ((address (hexl-current-address)))
-     (if (hexl-at-ascii-position address)
-	 (hexl-address-to-marker address)
-       (hexl-ascii-position address)))))
-
-(defun hexl-scroll-down (arg)
-  "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
-  (interactive "P")
-  (if (null arg)
-      (setq arg (1- (window-height)))
-    (setq arg (prefix-numeric-value arg)))
-  (hexl-scroll-up (- arg)))
-
-(defun hexl-scroll-up (arg)
-  "Scroll hexl buffer window upward ARG lines; or near full window if no ARG.
-If there's no byte at the target address, move to the first or last line."
-  (interactive "P")
-  (if (null arg)
-      (setq arg (1- (window-height)))
-    (setq arg (prefix-numeric-value arg)))
-  (let* ((movement (* arg 16))
-	 (address (hexl-current-address))
-	 (dest (+ address movement)))
-    (cond
-     ;; If possible, try to stay at the same offset from the beginning
-     ;; of the 16-byte group, even if we move to the first or last
-     ;; group.
-     ((and (> dest hexl-max-address)
-	   (>= (% hexl-max-address 16) (% address 16)))
-      (setq dest (+ (logand hexl-max-address -16) (% address 16))))
-     ((> dest hexl-max-address)
-      (setq dest hexl-max-address))
-     ((< dest 0)
-      (setq dest (% address 16))))
-    (if (/= dest (+ address movement))
-	(message "Out of hexl region."))
-    (hexl-goto-address dest)
-    (recenter 0)))
-
-(defun hexl-beginning-of-1k-page ()
-  "Go to beginning of 1k boundary."
-  (interactive)
-  (hexl-goto-address (logand (hexl-current-address) -1024)))
-
-(defun hexl-end-of-1k-page ()
-  "Go to end of 1k boundary."
-  (interactive)
-  (hexl-goto-address (let ((address (logior (hexl-current-address) 1023)))
-		       (if (> address hexl-max-address)
-			   (setq address hexl-max-address))
-		       address)))
-
-(defun hexl-beginning-of-512b-page ()
-  "Go to beginning of 512 byte boundary."
-  (interactive)
-  (hexl-goto-address (logand (hexl-current-address) -512)))
-
-(defun hexl-end-of-512b-page ()
-  "Go to end of 512 byte boundary."
-  (interactive)
-  (hexl-goto-address (let ((address (logior (hexl-current-address) 511)))
-		       (if (> address hexl-max-address)
-			   (setq address hexl-max-address))
-		       address)))
-
-(defun hexl-quoted-insert (arg)
-  "Read next input character and insert it.
-Useful for inserting control characters.
-You may also type up to 3 octal digits, to insert a character with that code"
-  (interactive "p")
-  (hexl-insert-char (read-quoted-char) arg))
-
-;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789ABCDEF
-
-;;;###autoload
-(defun hexlify-buffer ()
-  "Convert a binary buffer to hexl format.
-This discards the buffer's undo information."
-  (interactive)
-  (and buffer-undo-list
-       (or (y-or-n-p "Converting to hexl format discards undo info; ok? ")
-	   (error "Aborted")))
-  (setq buffer-undo-list nil)
-  ;; Don't decode text in the ASCII part of `hexl' program output.
-  (let ((coding-system-for-read 'raw-text)
-	(coding-system-for-write 
-	 (or (and (boundp 'buffer-file-coding-system)
-		  buffer-file-coding-system)
-	     'raw-text))
-	(buffer-undo-list t))
-    (shell-command-on-region (point-min) (point-max) hexlify-command t)
-    (if (> (point) (hexl-address-to-marker hexl-max-address))
-	(hexl-goto-address hexl-max-address))))
-
-(defun dehexlify-buffer ()
-  "Convert a hexl format buffer to binary.
-This discards the buffer's undo information."
-  (interactive)
-  (and buffer-undo-list
-       (or (y-or-n-p "Converting from hexl format discards undo info; ok? ")
-	   (error "Aborted")))
-  (setq buffer-undo-list nil)
-  (let ((coding-system-for-write 'raw-text)
-	(coding-system-for-read 
-	 (or (and (boundp 'buffer-file-coding-system)
-		  buffer-file-coding-system)
-	     'raw-text))
-	(buffer-undo-list t))
-    (shell-command-on-region (point-min) (point-max) dehexlify-command t)))
-
-(defun hexl-char-after-point ()
-  "Return char for ASCII hex digits at point."
-  (hexl-htoi (char-after (point))
-	     (char-after (1+ (point)))))
-
-(defun hexl-htoi (lh rh)
-  "Hex (char) LH (char) RH to integer."
-    (+ (* (hexl-hex-char-to-integer lh) 16)
-       (hexl-hex-char-to-integer rh)))
-
-(defun hexl-hex-char-to-integer (character)
-  "Take a char and return its value as if it was a hex digit."
-  (if (and (>= character ?0) (<= character ?9))
-      (- character ?0)
-    (let ((ch (logior character 32)))
-      (if (and (>= ch ?a) (<= ch ?f))
-	  (- ch (- ?a 10))
-	(error "Invalid hex digit `%c'" ch)))))
-
-(defun hexl-oct-char-to-integer (character)
-  "Take a char and return its value as if it was a octal digit."
-  (if (and (>= character ?0) (<= character ?7))
-      (- character ?0)
-    (error "Invalid octal digit `%c'" character)))
-
-(defun hexl-printable-character (ch)
-  "Return a displayable string for character CH."
-  (format "%c" (if hexl-iso
-		   (if (or (< ch 32) (and (>= ch 127) (< ch 160)))
-		       46
-		     ch)
-		 (if (or (< ch 32) (>= ch 127))
-		     46
-		   ch))))
-
-(defun hexl-self-insert-command (arg)
-  "Insert this character."
-  (interactive "p")
-  (let ((col (current-column)))
-    (if (and (>= col 10) ( <= col 48))
-        (let ((point (point))
-              (pos (% col 5)))
-          (if (member pos '(1 3))
-              (hexl-insert-char
-               (hexl-hex-string-to-integer
-                (concat (buffer-substring (- point 1) point)
-                        (char-to-string last-command-char)))
-               arg)
-            (hexl-insert-char
-             (hexl-hex-string-to-integer
-              (concat (char-to-string last-command-char)
-                      (buffer-substring (+ point 1) (+ point 2))))
-             arg)
-            (goto-char (1+ point))))
-      (if (not last-command-char)
-	  (setq last-command-char
-		(event-to-character last-input-event t t t)))
-      (hexl-insert-char last-command-char arg))))
-
-(defun hexl-insert-char (ch num)
-  "Insert a character in a hexl buffer."
-  (let ((address (hexl-current-address t)))
-    (while (> num 0)
-      (let* ((hex-position (hexl-hex-position address))
-	     (ascii-position (hexl-ascii-position address)))
-	(save-excursion
-	  (goto-char hex-position)
-	  (delete-char 2)
-	  (insert (format "%02x" ch))
-	  (goto-char ascii-position)
-	  (delete-char 1)
-	  (insert (hexl-printable-character ch))
-	  (or (eq address hexl-max-address)
-	      (setq address (1+ address))))
-	(hexl-goto-address address))
-      (setq num (1- num)))))
-
-;; hex conversion
-
-(defun hexl-insert-hex-char (arg)
-  "Insert a ASCII char ARG times at point for a given hexadecimal number."
-  (interactive "p")
-  (let ((num (hexl-hex-string-to-integer (read-string "Hex number: "))))
-    (if (or (> num 255) (< num 0))
-	(error "Hex number out of range")
-      (hexl-insert-char num arg))))
-
-(defun hexl-insert-hex-string (str arg)
-  "Insert hexadecimal string STR at point ARG times.
-Embedded whitespace, dashes, and periods in the string are ignored."
-  (interactive "sHex string: \np")
-  (setq str (replace-in-string str "[- \t.]" ""))
-  (let ((chars '()))
-    (let ((len (length str))
-	  (idx 0))
-      (if (eq (logand len 1) 1)
-	  (let ((num (hexl-hex-string-to-integer (substring str 0 1))))
-	    (setq chars (cons num chars))
-	    (setq idx 1)))
-      (while (< idx len)
-	(let* ((nidx (+ idx 2))
-	       (num (hexl-hex-string-to-integer (substring str idx nidx))))
-	  (setq chars (cons num chars))
-	  (setq idx nidx))))
-    (setq chars (nreverse chars))
-    (while (> arg 0)
-      (let ((chars chars))
-	(while chars
-	  (hexl-insert-char (car chars) 1)
-	  (setq chars (cdr chars))))
-      (setq arg (- arg 1)))))
-
-(defun hexl-insert-decimal-char (arg)
-  "Insert a ASCII char ARG times at point for a given decimal number."
-  (interactive "p")
-  (let ((num (string-to-int (read-string "Decimal Number: "))))
-    (if (or (> num 255) (< num 0))
-	(error "Decimal number out of range")
-      (hexl-insert-char num arg))))
-
-(defun hexl-insert-octal-char (arg)
-  "Insert a ASCII char ARG times at point for a given octal number."
-  (interactive "p")
-  (let ((num (hexl-octal-string-to-integer (read-string "Octal Number: "))))
-    (if (or (> num 255) (< num 0))
-	(error "Decimal number out of range")
-      (hexl-insert-char num arg))))
-
-(defun hexl-follow-ascii (&optional arg)
-  "Toggle following ASCII in Hexl buffers.
-With prefix ARG, turn on following if and only if ARG is positive.
-When following is enabled, the ASCII character corresponding to the
-element under the point is highlighted.
-Customize the variable `hexl-follow-ascii' to disable this feature."
-  (interactive "P")
-  (let ((on-p (if arg 
-		  (> (prefix-numeric-value arg) 0)
-	       (not hexl-ascii-extent))))
-
-    (make-local-hook 'post-command-hook)
-		    
-    (if on-p
-      ;; turn it on
-      (if (not hexl-ascii-extent)
-	  (progn
-	    (setq hexl-ascii-extent (make-extent 1 1)
-		  hexl-follow-ascii t)
-	    (set-extent-property hexl-ascii-extent 'face 'highlight)
-	    (add-hook 'post-command-hook 'hexl-follow-ascii-find nil t)))
-      ;; turn it off
-      (if hexl-ascii-extent
-	  (progn
-	    (detach-extent hexl-ascii-extent)
-	    (setq hexl-ascii-extent nil
-		  hexl-follow-ascii nil)
-	    (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
-	    )))))
-
-(defun hexl-follow-ascii-find ()
-  "Find and highlight the ASCII/HEX element corresponding to current point."
-  (setq hexl-current-address (hexl-current-address))
-  (condition-case nil
-      (let ((col (current-column))
-	    (point (point))
-	    start end)
-	(if (> col 48)
-	    (setq start (+ 10 (- point col) (/ (- col 51) 2)
-			   (* 2 (mod (hexl-current-address) 16)))
-		  end (+ start 2))
-	  (setq start (+ 51 (- point col) (mod hexl-current-address 16))
-		end (+ start 1)))
-	(set-extent-endpoints hexl-ascii-extent start end))
-    (error nil))
-  (setq hexl-current-address
-        (format "0x%x=%d" hexl-current-address hexl-current-address)))
-
-;; startup stuff.
-
-(if hexl-mode-map
-    nil
-  (setq hexl-mode-map (make-sparse-keymap))
-
-  (define-key hexl-mode-map [left] 'hexl-backward-char)
-  (define-key hexl-mode-map [right] 'hexl-forward-char)
-  (define-key hexl-mode-map [up] 'hexl-previous-line)
-  (define-key hexl-mode-map [down] 'hexl-next-line)
-  (define-key hexl-mode-map [(meta left)] 'hexl-backward-short)
-  (define-key hexl-mode-map [(meta right)] 'hexl-forward-short)
-  (define-key hexl-mode-map [next] 'hexl-scroll-up)
-  (define-key hexl-mode-map [prior] 'hexl-scroll-down)
-  (define-key hexl-mode-map [home] 'hexl-beginning-of-line)
-  (define-key hexl-mode-map [end] 'hexl-end-of-line)
-  (define-key hexl-mode-map [(control home)] 'hexl-beginning-of-buffer)
-  (define-key hexl-mode-map [(control end)] 'hexl-end-of-buffer)
-  (define-key hexl-mode-map [deletechar] 'undefined)
-  (define-key hexl-mode-map [deleteline] 'undefined)
-  (define-key hexl-mode-map [insertline] 'undefined)
-  (define-key hexl-mode-map [(shift backspace)] 'undefined)
-  (define-key hexl-mode-map [(shift delete)] 'undefined)
-  (define-key hexl-mode-map 'backspace 'undefined)
-  (define-key hexl-mode-map 'delete 'undefined)
-
-  (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line)
-  (define-key hexl-mode-map "\C-b" 'hexl-backward-char)
-  (define-key hexl-mode-map "\C-d" 'undefined)
-  (define-key hexl-mode-map "\C-e" 'hexl-end-of-line)
-  (define-key hexl-mode-map "\C-f" 'hexl-forward-char)
-
-  (if (not (eq (key-binding (vector help-char)) 'help-command))
-      (define-key hexl-mode-map (vector help-char) 'undefined))
-
-  (define-key hexl-mode-map "\C-i" 'hexl-self-insert-command)
-  (define-key hexl-mode-map "\C-j" 'hexl-self-insert-command)
-  (define-key hexl-mode-map "\C-k" 'undefined)
-  (define-key hexl-mode-map "\C-m" 'hexl-self-insert-command)
-  (define-key hexl-mode-map "\C-n" 'hexl-next-line)
-  (define-key hexl-mode-map "\C-o" 'undefined)
-  (define-key hexl-mode-map "\C-p" 'hexl-previous-line)
-  (define-key hexl-mode-map "\C-q" 'hexl-quoted-insert)
-  (define-key hexl-mode-map "\C-t" 'undefined)
-  (define-key hexl-mode-map "\C-v" 'hexl-scroll-up)
-  (define-key hexl-mode-map "\C-w" 'undefined)
-  (define-key hexl-mode-map "\C-y" 'undefined)
-
-  (let ((ch 32))
-    (while (< ch 127)
-      (define-key hexl-mode-map (format "%c" ch) 'hexl-self-insert-command)
-      (setq ch (1+ ch))))
-
-  (define-key hexl-mode-map "\e\C-a" 'hexl-beginning-of-512b-page)
-  (define-key hexl-mode-map "\e\C-b" 'hexl-backward-short)
-  (define-key hexl-mode-map "\e\C-d" 'hexl-insert-decimal-char)
-  (define-key hexl-mode-map "\e\C-e" 'hexl-end-of-512b-page)
-  (define-key hexl-mode-map "\e\C-f" 'hexl-forward-short)
-  (define-key hexl-mode-map "\e\C-i" 'undefined)
-  (define-key hexl-mode-map "\e\C-j" 'undefined)
-  (define-key hexl-mode-map "\e\C-k" 'undefined)
-  (define-key hexl-mode-map "\e\C-o" 'hexl-insert-octal-char)
-  (define-key hexl-mode-map "\e\C-q" 'undefined)
-  (define-key hexl-mode-map "\e\C-t" 'undefined)
-  (define-key hexl-mode-map "\e\C-x" 'hexl-insert-hex-char)
-  (define-key hexl-mode-map "\eb" 'hexl-backward-word)
-  (define-key hexl-mode-map "\ec" 'undefined)
-  (define-key hexl-mode-map "\ed" 'undefined)
-  (define-key hexl-mode-map "\ef" 'hexl-forward-word)
-  (define-key hexl-mode-map "\eg" 'hexl-goto-hex-address)
-  (define-key hexl-mode-map "\ei" 'undefined)
-  (define-key hexl-mode-map "\ej" 'hexl-goto-address)
-  (define-key hexl-mode-map "\ek" 'undefined)
-  (define-key hexl-mode-map "\el" 'undefined)
-  (define-key hexl-mode-map "\eq" 'undefined)
-  (define-key hexl-mode-map "\es" 'undefined)
-  (define-key hexl-mode-map "\et" 'undefined)
-  (define-key hexl-mode-map "\eu" 'undefined)
-  (define-key hexl-mode-map "\ev" 'hexl-scroll-down)
-  (define-key hexl-mode-map "\ey" 'undefined)
-  (define-key hexl-mode-map "\ez" 'undefined)
-  (define-key hexl-mode-map "\e<" 'hexl-beginning-of-buffer)
-  (define-key hexl-mode-map "\e>" 'hexl-end-of-buffer)
-
-  (define-key hexl-mode-map "\C-c\C-c" 'hexl-mode-exit)
-
-  (define-key hexl-mode-map "\C-x[" 'hexl-beginning-of-1k-page)
-  (define-key hexl-mode-map "\C-x]" 'hexl-end-of-1k-page)
-  (define-key hexl-mode-map "\C-x\C-p" 'undefined)
-  (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer)
-  (define-key hexl-mode-map "\C-x\C-t" 'undefined)
-
-  (define-key hexl-mode-map [tab] 'hexl-switch-position))
-
-(provide 'hexl)
-
-;;; hexl.el ends here
diff --git a/xemacs-packages/lisp/text-modes/htmlize.el b/xemacs-packages/lisp/text-modes/htmlize.el
deleted file mode 100644
index 6fd61ebd..00000000
--- a/xemacs-packages/lisp/text-modes/htmlize.el
+++ /dev/null
@@ -1,1578 +0,0 @@
-;; htmlize.el -- Convert buffer text and decorations to HTML.
-
-;; Copyright (C) 1997,1998,1999,2000,2001,2002,2003,2005 Hrvoje Niksic
-
-;; Author: Hrvoje Niksic <hniksic@xemacs.org>
-;; 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 <hniksic@xemacs.org> 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 two types of HTML output, selected by setting
-;; `htmlize-output-type': `css' and `font'.  In `css' mode, htmlize
-;; uses cascading style sheets to specify colors; it generates classes
-;; that correspond to Emacs faces and uses <span class=FACE>...</span>
-;; 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
-;; `font' mode, htmlize uses <font color="...">...</font> 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 lots of warnings; just ignore them.
-
-;; The latest version should be available at:
-;;
-;;        <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el>
-;;
-;; 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, Juri
-;; Linkov, 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.28")
-
-;; 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.  Legal values are `css' and `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 <span class=\"FACE\">.
-
-When set to `font', the properties will be set using layout tags
-<font>, <b>, <i>, <u>, and <strike>.
-
-`css' output is normally preferred, but `font' is still useful for
-supporting old, pre-CSS browsers, or for easy embedding of colorized
-text in foreign HTML documents (no style sheet to carry around)."
-  :type '(choice (const 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 feed characters in source code with <hr />.
-If this is a string, it additionally specifies the replacement to use.
-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:
-
-  <meta http-equiv=\"Content-Type\" content=\"text/html; charset=CHARSET\">
-
-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-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.")
-
-;;; 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 "&#<code>;" or "<char>" (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 "<<a href=\"mailto:"
-	      (htmlize-despam-address address)
-	      "\">"
-	      (htmlize-despam-address link-text)
-	      "</a>>")))
-  (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 "<<a href=\"" url "\">" link-text "</a>>"))))
-
-;; Tests for htmlize-make-hyperlinks:
-
-;; <mailto:hniksic@xemacs.org>
-;; <http://fly.srk.fer.hr>
-;; <URL:http://www.xemacs.org>
-;; <http://www.mail-archive.com/bbdb-info@xemacs.org/>
-;; <hniksic@xemacs.org>
-;; <xalan-dev-sc.10148567319.hacuhiucknfgmpfnjcpg-john=doe.com@xml.apache.org>
-
-(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
-  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)))
-    (: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-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)
-			    (face-attribute face attr))))
-	       (when (and value (not (eq value 'unspecified)))
-		 (htmlize-face-emacs21-attr fstruct attr value)))))
-	  (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))
-
-;; 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)
-			  (union (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)
-			  (union (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 list face-prop)
-	   (while (setq extent (extent-at (point) nil 'face extent))
-	     (setq face-prop (extent-face extent))
-	     (setq list (if (listp face-prop)
-			    (nconc (reverse face-prop) list)
-			  (cons face-prop list))))
-	   ;; No need to reverse the list: PUSH has already
-	   ;; constructed it in the reverse display order.
-	   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)))))
-	     (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 <span> tags, and
-;; the other with the use of the old <font> 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 'ignore))))
-
-;;; CSS based output support.
-
-(defun htmlize-css-doctype ()
-  nil					; no doc-string
-  "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">")
-
-;; 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))
-    (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 "    <style type=\"text/css\">\n    <!--\n")
-  (insert "      body {\n        "
-	  (mapconcat #'identity
-		     (htmlize-css-specs (gethash 'default face-map))
-		     "\n        ")
-	  "\n      }\n")
-  (dolist (face (sort* (copy-list buffer-faces) #'string-lessp
-		       :key (lambda (f)
-			      (htmlize-fstruct-css-name (gethash f face-map)))))
-    (let* ((fstruct (gethash face face-map))
-	   (cleaned-up-face-name
-	    (let ((s
-		   ;; Use `prin1-to-string' rather than `symbol-name'
-		   ;; to get the face name because the "face" can also
-		   ;; be an attrlist, which is not a symbol.
-		   (prin1-to-string face)))
-	      ;; If the name contains `--' or `*/', remove them.
-	      (while (string-match "--" s)
-		(setq s (replace-match "-" t t s)))
-	      (while (string-match "\\*/" s)
-		(setq s (replace-match "XX" t t s)))
-	      s))
-	   (specs (htmlize-css-specs fstruct)))
-      (insert "      ." (htmlize-fstruct-css-name fstruct))
-      (if (null specs)
-	  (insert " {")
-	(insert " {\n        /* " cleaned-up-face-name " */\n        "
-		(mapconcat #'identity specs "\n        ")))
-      (insert "\n      }\n")))
-  (insert htmlize-hyperlink-style
-	  "    -->\n    </style>\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 <span class=...> tag for each
-  ;; face in FSTRUCT-LIST.
-  (dolist (fstruct fstruct-list)
-    (princ "<span class=\"" buffer)
-    (princ (htmlize-fstruct-css-name fstruct) buffer)
-    (princ "\">" buffer))
-  (princ text buffer)
-  (dolist (fstruct fstruct-list)
-    (ignore fstruct)			; shut up the byte-compiler
-    (princ "</span>" buffer)))
-
-;;; `font' tag based output support.
-
-(defun htmlize-font-doctype ()
-  nil					; no doc-string
-
-  ;; According to DTDs published by the W3C, it is illegal to embed
-  ;; <font> in <pre>.  This makes sense in general, but is bad for
-  ;; htmlize's intended usage of <font> to specify the document color.
-
-  ;; To make generated HTML legal, htmlize.el 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
-  ;; <http://imbolc.ucc.ie/~pflynn/articles/htmlpro.html>.
-
-  ;; Since by now (2005) 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' generation engine
-  ;; which I believe creates fully conforming HTML.
-
-  "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">"
-
-  ;; Now-abandoned HTML Pro declaration.
-  ;"<!DOCTYPE HTML PUBLIC \"+//Silmaril//DTD HTML Pro v0r11 19970101//EN\">"
-  )
-
-(defun htmlize-font-body-tag (face-map)
-  (let ((fstruct (gethash 'default face-map)))
-    (format "<body text=\"%s\" bgcolor=\"%s\">"
-	    (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: <font> tag for colors, <b> for bold, <u> for
-  ;; underline, and <strike> for strike-through.
-  (let (bold italic underline strike fg)
-    ;; Merge the face attributes.
-    (dolist (fstruct fstruct-list)
-      ;; A non-null boolean attribute in any face sets the attribute.
-      (and (htmlize-fstruct-boldp fstruct)      (setq bold t))
-      (and (htmlize-fstruct-italicp fstruct)    (setq italic t))
-      (and (htmlize-fstruct-underlinep fstruct) (setq underline t))
-      (and (htmlize-fstruct-strikep fstruct)    (setq strike t))
-      ;; The foreground/background of the last face in the list wins.
-      (and (htmlize-fstruct-foreground fstruct)
-	   (setq fg (htmlize-fstruct-foreground fstruct))))
-
-    ;; Generate the markup that reflects the merged attributes.
-    (princ (concat
-	    (and fg        (format "<font color=\"%s\">" fg))
-	    (and bold      "<b>")
-	    (and italic    "<i>")
-	    (and underline "<u>")
-	    (and strike    "<strike>"))
-	   buffer)
-    ;; Print the text.
-    (princ text buffer)
-    ;; Close the tags we've opened.
-    (princ (concat
-	    (and strike    "</strike>")
-	    (and underline "</u>")
-	    (and italic    "</i>")
-	    (and bold      "</b>")
-	    (and fg        "</font>"))
-	   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)
-    (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*")))
-	   (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 "<!-- Created by htmlize-%s in %s mode. -->\n"
-			htmlize-version htmlize-output-type)
-		"<html>\n  <head>\n"
-		"    <title>" (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 "  "
-		"\n  "
-		(or (htmlize-method body-tag face-map)
-		    "")
-		"\n    
\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 "
\n  \n\n")
-	(when htmlize-generate-hyperlinks
-	  (htmlize-make-hyperlinks))
-	(htmlize-defang-local-variables)
-	(when htmlize-replace-form-feeds
-	  ;; Change each "^L\n" to "\n
".
-	  (goto-char (point-min))
-	  (let ((source
-		 ;; ^L has already been escaped, so search for that.
-		 (htmlize-protect-string "\^L\n"))
-		(replacement
-		 (concat "\n" (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))
-	(run-hooks 'htmlize-after-hook)
-	(buffer-enable-undo))
-      htmlbuf)))
-
-;; Utility functions.
-
-(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))
-      (jit-lock-fontify-now (point-min) (point-max)))
-     ((and (boundp 'lazy-lock-mode)
-	   (symbol-value 'lazy-lock-mode))
-      (lazy-lock-fontify-region (point-min) (point-max)))
-     ((and (boundp 'lazy-shot-mode)
-	   (symbol-value 'lazy-shot-mode))
-      ;; 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-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/xemacs-packages/lisp/text-modes/image-mode.el b/xemacs-packages/lisp/text-modes/image-mode.el
deleted file mode 100644
index e9dd55a9..00000000
--- a/xemacs-packages/lisp/text-modes/image-mode.el
+++ /dev/null
@@ -1,201 +0,0 @@
-;;; image-mode.el --- Major mode for navigating images
-
-;; Copyright (C) 1997 MORIOKA Tomohiko
-
-;; Author: MORIOKA Tomohiko 
-;; Created: 1997/6/27
-;; Version: image-mode.el,v 20.3.1.2 1997/07/01 17:29:44 morioka Exp
-;; Keywords: image, graphics
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Commentary:
-
-;; Modified: 2001-07-10, Glynn Clements 
-;; 	Substantially re-written to avoid use of format-alist
-;; Modified: 2002-10-18, Glynn Clements 
-;; 	Autoload image-mode-install
-;; Modified: 2002-10-22, Glynn Clements 
-;; 	Remove format-alist entries
-
-;;; Code:
-
-(require 'cl)
-
-(defvar image-format nil)
-(make-variable-buffer-local 'image-format)
-
-(defvar image-decoded nil)
-(make-variable-buffer-local 'image-decoded)
-
-;;;###autoload
-(defvar image-formats-alist
-  '(("png"   . png )
-    ("gif"   . gif )
-    ("jpe?g" . jpeg)
-    ("tiff?" . tiff)
-    ("xbm"   . xbm )
-    ("xpm"   . xpm )
-    ("bmp"   . bmp )))
-
-(defun image-guess-type ()
-  (let (ext item)
-    (and buffer-file-name
-	 (setq ext (downcase (file-name-extension buffer-file-name)))
-	 (setq item (assoc* ext image-formats-alist
-			    :test (lambda (str re)
-				    (string-match (concat "^" re "\\'")
-						  str))))
-	 (setq image-format (cdr item)))))
-
-(defun image-decode-buffer ()
-  (image-decode (point-min) (point-max) image-format)
-  (setq image-decoded t)
-  (set-buffer-modified-p nil))
-
-(defun image-undecode-buffer ()
-  (setq buffer-read-only nil)
-  (map-extents (function
-		(lambda (extent maparg)
-		  (delete-extent extent)))
-	       nil (point-min) (point-max) nil 'end-closed)
-  (setq image-decoded nil))
-
-(defun image-decode (start end type)
-  "Decode the image between START and END which is encoded in TYPE."
-  (save-excursion
-    (let ((image (and type
-		      (make-image-instance
-		       (vector type :data (buffer-string start end))
-		       nil nil 'no-error))))
-      (unless image
-	(setq image (make-image-instance
-		     (vector 'string :data "format is not supported!\n")
-		     nil nil 'no-error)))
-      (set-extent-property (make-extent start end) 'invisible t)
-      (let ((glyph (make-glyph image)))
-	(set-extent-end-glyph (make-extent end end) glyph))
-      (setq buffer-read-only t))))
-
-(defvar image-mode-map (make-keymap))
-(suppress-keymap image-mode-map)
-(define-key image-mode-map "v" 'image-start-external-viewer)
-(define-key image-mode-map "t" 'image-toggle-decoding)
-(define-key image-mode-map "h" 'image-enter-hexl-mode)
-(define-key image-mode-map "e" 'image-enter-xpm-mode)
-(define-key image-mode-map "q" 'image-mode-quit)
-
-;; ### There must be a general way of doing this, using mimecap....
-(defvar image-external-viewer-list
-  '(
-    "xv"				; xv
-    "display"				; ImageMagic
-    )
-  "*List of external viewers for image-mode.
-
-Each viewer is a string, to be called via `start-process'.  If null,
-no external viewer will be used.")
-
-(defun image-start-external-viewer ()
-  "Start external image viewer for current-buffer.
-
-It tries each program name in `image-external-viewer-list' in order.
-If `image-external-viewer-list' is empty, or none of the viewers can
-be found, signals an error."
-
-  (interactive)
-  (let ((vl image-external-viewer-list))
-    (if vl
-	(catch 'done
-	  (while vl
-	    (condition-case nil
-		(progn
-		  (start-process "external image viewer" nil
-				 (car vl) buffer-file-name)
-		  (throw 'done nil))	; exit loop
-	      (file-error (setq vl (cdr vl)))))
-	  (error "image-start-external-viewer:  couldn't start any viewer in `image-external-viewer-list'"))
-      (error "image-start-external-viewer:  `image-external-viewer-list' is empty."))))
-
-(defun image-toggle-decoding ()
-  "Toggle image display mode in current buffer."
-  (interactive)
-  (if image-decoded
-      (image-undecode-buffer)
-    (image-decode-buffer)))
-
-(defun image-exit-hexl-mode-function ()
-  (image-decode-buffer)
-  (remove-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function))
-
-(defun image-enter-hexl-mode ()
-  "Enter hexl-mode."
-  (interactive)
-  (when image-decoded
-    (image-undecode-buffer)
-    (add-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function))
-  (hexl-mode))
-
-(defun image-enter-xpm-mode ()
-  "Enter xpm-mode."
-  (interactive)
-  (if (not (eq image-format 'xpm))
-      (error "Not an XPM image."))
-  (when image-decoded
-    (image-undecode-buffer))
-  (xpm-mode 1))
-
-(defun image-mode-quit ()
-  "Exit image-mode."
-  (interactive)
-  (kill-buffer (current-buffer)))
-
-(defun image-maybe-restore ()
-  "Restore buffer if it is decoded."
-  (when image-decoded
-    (image-undecode-buffer)))
-
-(add-hook 'change-major-mode-hook 'image-maybe-restore)
-
-;;;###autoload
-(defun image-mode (&optional arg)
-  "\\{image-mode-map}"
-  (interactive)
-  (setq major-mode 'image-mode)
-  (setq mode-name "Image")
-  (use-local-map image-mode-map)
-  (image-guess-type)
-  (image-decode-buffer))
-
-;;;###autoload
-(progn
-  (setq format-alist
-	(remove-if (lambda (x)
-		     (eq (nth 6 x) 'image-mode))
-		   format-alist))
-  (dolist (format image-formats-alist)
-    (let* ((re (car format))
-	   (type (cdr format))
-	   (regexp (concat "\\.\\(" re "\\|" (upcase re) "\\)\\'"))
-	   (item (cons regexp 'image-mode)))
-      (and (featurep type)
-	   (add-to-list 'auto-mode-alist item)))))
-
-(provide 'image-mode)
-
-;;; image-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/iso-acc.el b/xemacs-packages/lisp/text-modes/iso-acc.el
deleted file mode 100644
index cb20cc71..00000000
--- a/xemacs-packages/lisp/text-modes/iso-acc.el
+++ /dev/null
@@ -1,504 +0,0 @@
-;;; iso-acc.el --- minor mode providing electric accent keys
-
-;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
-
-;; Author: Johan Vromans
-;; Maintainer: None
-;; Adapted-By: Alexandre Oliva 
-;; Keywords: i18n
-;; $Revision: 1.2 $
-;; $Date: 1998/03/22 17:25:31 $
-
-;; 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:
-
-;; Function `iso-accents-mode' activates a minor mode in which
-;; typewriter "dead keys" are emulated.  The purpose of this emulation
-;; is to provide a simple means for inserting accented characters
-;; according to the ISO-8859-1 and other character sets.
-;;
-;; In `iso-accents-mode', pseudo accent characters are used to
-;; introduce accented keys.  The pseudo-accent characters are:
-;;
-;;   '  (minute)    -> grave accent
-;;   `  (backtick)  -> acute accent
-;;   "  (second)    -> diaeresis
-;;   ^  (caret)     -> circumflex
-;;   ~  (tilde)     -> tilde over the character
-;;   /  (slash)     -> slash through the character
-;;                     Also:  /A is A-with-ring and /E is AE ligature.
-;;   .  (dot)       -> dot over the character
-;;   ,  (cedilla)   -> cedilla under the character (some languages only)
-;;
-;; The action taken depends on the key that follows the pseudo accent.
-;; In general: 
-;;
-;;   pseudo-accent + appropriate letter -> accented letter
-;;   pseudo-accent + space -> pseudo-accent (except comma)
-;;   pseudo-accent + pseudo-accent -> accent (if available)
-;;   pseudo-accent + other -> pseudo-accent + other
-;;
-;; If the pseudo-accent is followed by anything else than a 
-;; self-insert-command, the dead-key code is terminated, the
-;; pseudo-accent inserted 'as is' and the bell is rung to signal this.
-;;
-;; Function `iso-accents-mode' can be used to enable the iso accents
-;; minor mode, or disable it.
-
-;; If you want only some of these characters to serve as accents,
-;; add a language to `iso-languages' which specifies the accent characters
-;; that you want, then select the language with `iso-accents-customize'.
-
-;;; Code:
-
-(provide 'iso-acc)
-
-;; multiple Emacs versions compatibility section
-
-(if (fboundp 'make-char)
-    (defun iso-make-char (charset char)
-      (cond
-       ((integerp char) (make-char charset char))
-       ((and (char-or-string-p char) (not (stringp char))) char)
-       (t (error "invalid character"))))
-  (defun iso-make-char (charset char) "Returns its second argument" char))
-
-(if (fboundp 'read-event)
-    (defalias 'iso-read-event 'read-event)
-  (defun iso-read-event ()
-    (event-key (next-command-event))))
-
-(if (fboundp 'character-to-event)
-    (progn
-      (defun iso-char-list-to-event (l)
-	"returns an event containing the given list of characters"
-	(character-to-event l))
-      (defun iso-char-to-event (ch)
-	"returns an event containing the given character"
-	(iso-char-list-to-event (list ch))))
-  (defalias 'iso-char-to-event 'identity)
-  (defalias 'iso-char-list-to-event 'identity))
-
-(if (fboundp 'this-single-command-keys) ()
-  (if (string-match "Lucid" (version))
-      (defun this-single-command-keys ()
-	(setq this-command (not (this-command-keys)))
-	(this-command-keys))
-    (defun this-single-command-keys () (this-command-keys))))
-
-;; end of compatibility section
-
-(defvar iso-languages
-  '(("catalan"
-     ;; Note this includes some extra characters used in Spanish,
-     ;; on the idea that someone who uses Catalan is likely to use Spanish
-     ;; as well.
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
-	 (?\  . ?'))
-     (?` (?A . ?\300) (?E . ?\310) (?O . ?\322)
-	 (?a . ?\340) (?e . ?\350) (?o . ?\362) (?\  . ?`))
-     (?\" (?I . ?\317) (?U . ?\334) (?i . ?\357) (?u . ?\374) (?\  . ?\"))
-     (?~ (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361)
-	 (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277)
-	 (?\  . ?~)))
-
-    ("esperanto"
-     (?^ (?H . ?\246) (?J . ?\254) (?h . ?\266) (?j . ?\274) (?C . ?\306)
-	 (?G . ?\330) (?S . ?\336) (?c . ?\346) (?g . ?\370) (?s . ?\376)
-	 (?^ . ?^) (?\  . ?^))
-     (?~ (?U . ?\335) (?u . ?\375) (?\  . ?~)))
-
-    ("french"
-     (?' (?E . ?\311) (?C . ?\307)
-	 (?e . ?\351) (?c . ?\347)
-	 (?\  . ?') (space . ?'))
-     (?` (?A . ?\300) (?E . ?\310) (?U . ?\331)
-	 (?a . ?\340) (?e . ?\350) (?u . ?\371)
-	 (?\  . ?`) (space . ?`))
-     (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
-	 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
-	 (?\  . ?^) (space . ?^))
-     (?\" (?E . ?\313) (?I . ?\317)  
-          (?e . ?\353) (?i . ?\357)
-	  (?\  . ?\") (space . ?\"))
-     (?~ (?< . ?\253) (?> . ?\273)
-	 (?C . ?\307) (?c . ?\347)
-	 (?\  . ?~) (space . ?~))
-     (?, (?c . ?\347) (?C . ?\307) (?, . ?,)))
-    
-    ("german"
-     (?\" (?A . ?\304) (?O . ?\326) (?U . ?\334)
-	  (?a . ?\344) (?o . ?\366) (?u . ?\374) (?s . ?\337) (?\  . ?\")))
-
-    ("irish"
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
-	 (?\  . ?') (space . ?')))
-
-    ("portuguese"
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
-	 (?u . ?\372) (?c . ?\347) (?\  . ?') (space . ?'))
-     (?` (?A . ?\300) (?a . ?\340) (?\  . ?`) (space . ?`))
-     (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) (?a . ?\342) (?e . ?\352)
-	 (?o . ?\364) (?\  . ?^) (space . ?^))
-     (?\" (?U . ?\334) (?u . ?\374) (?\  . ?\") (space . ?\"))
-     (?~ (?A . ?\303) (?O . ?\325)
-	 (?a . ?\343) (?o . ?\365)
-	 (?\  . ?~) (space . ?~))
-     (?, (?c . ?\347) (?C . ?\307) (?, . ?,)))
-
-    ("spanish"
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
-	 (?\  . ?'))
-     (?\" (?U . ?\334) (?u . ?\374) (?\  . ?\"))
-     (?~ (?N . ?\321) (?n . ?\361) (?> . ?\273) (?< . ?\253) (?! . ?\241)
-	 (?? . ?\277) (?\  . ?~)))
-    
-    ("latin-1"
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
-	 (?u . ?\372) (?y . ?\375) (?' . ?\264) (?\  . ?') (space . ?'))
-     (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
-	 (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
-	 (?` . ?`) (?\  . ?`) (space . ?`))
-     (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
-	 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
-	 (?^ . ?^) (?\  . ?^) (space . ?^))
-     (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
-	  (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337)
-	  (?u . ?\374) (?y . ?\377) (?\" . ?\250) (?\  . ?\") (space . ?\"))
-     (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325)
-	 (?T . ?\336) (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361)
-	 (?o . ?\365) (?t . ?\376) (?> . ?\273) (?< . ?\253) (?~ . ?\270)
-	 (?! . ?\241) (?? . ?\277)
-	 (?\  . ?~) (space . ?~))
-     (?/ (?A . ?\305) (?E . ?\306) (?O . ?\330) (?a . ?\345) (?e . ?\346)
-	 (?o . ?\370) (?/ . ?\260) (?\  . ?/) (space . ?/)))
-
-    ("latin-2" latin-iso8859-2
-     (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315)
-	 (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246)
-	 (?U . ?\332) (?Y . ?\335) (?Z . ?\254)
-	 (?a . ?\341) (?c . ?\346) (?d . ?\360) (?e . ?\351) (?i . ?\355)
-	 (?l . ?\345) (?n . ?\361) (?o . ?\363) (?r . ?\340) (?s . ?\266)
-	 (?u . ?\372) (?y . ?\375) (?z . ?\274)
-	 (?' . ?\264) (?\  . ?') (space . ?'))
-     (?` (?A . ?\241) (?C . ?\307) (?E . ?\312) (?L . ?\243) (?S . ?\252)
-	 (?T . ?\336) (?Z . ?\257)
-	 (?a . ?\261) (?l . ?\263) (?c . ?\347) (?e . ?\352) (?s . ?\272)
-	 (?t . ?\376) (?z . ?\277)
-	 (?` . ?\252)
-	 (?. . ?\377) (?\  . ?`) (space . ?`))
-     (?^ (?A . ?\302) (?I . ?\316) (?O . ?\324)
-	 (?a . ?\342) (?i . ?\356) (?o . ?\364)
-	 (?^ . ?^)			; no special code?
-	 (?\  . ?^) (space . ?^))
-     (?\" (?A . ?\304) (?E . ?\313) (?O . ?\326) (?U . ?\334)
-	  (?a . ?\344) (?e . ?\353) (?o . ?\366) (?s . ?\337) (?u . ?\374)
-	  (?\" . ?\250)
-	  (?\  . ?\") (space . ?\"))
-     (?~ (?A . ?\303) (?C . ?\310) (?D . ?\317) (?L . ?\245) (?N . ?\322)
-	 (?O . ?\325) (?R . ?\330) (?S . ?\251) (?T . ?\253) (?U . ?\333)
-	 (?Z . ?\256)
-	 (?a . ?\343) (?c . ?\350) (?d . ?\357) (?l . ?\265) (?n . ?\362)
-	 (?o . ?\365) (?r . ?\370) (?s . ?\271) (?t . ?\273) (?u . ?\373)
-	 (?z . ?\276)
-	 (?v . ?\242)			; v accent
-	 (?~ . ?\242)			; v accent
-	 (?. . ?\270)			; cedilla accent
-	 (?\  . ?~) (space . ?~)))
-
-    ("latin-3" latin-iso8859-3
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
-	 (?' . ?\264) (?\  . ?') (space . ?'))
-     (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
-	 (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
-	 (?` . ?`) (?\  . ?`) (space . ?`))
-     (?^ (?A . ?\302) (?C . ?\306) (?E . ?\312) (?G . ?\330)
-	 (?H . ?\246) (?I . ?\316) (?J . ?\254) (?O . ?\324)
-	 (?S . ?\336) (?U . ?\333)
-	 (?a . ?\342) (?c . ?\346) (?e . ?\352) (?g . ?\370) (?h . ?\266)
-	 (?i . ?\356) (?j . ?\274) (?o . ?\364) (?s . ?\376) (?u . ?\373)
-	 (?^ . ?^) (?\  . ?^) (space . \^))
-     (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
-	  (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?u . ?\374)
-	  (?s . ?\337)
-	  (?\" . ?\250) (?\  . ?\") (space . ?\"))
-     (?. (?C . ?\305) (?G . ?\325) (?I . ?\251) (?Z . ?\257)
-	 (?c . ?\345) (?g . ?\365) (?z . ?\277))
-     (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?G . ?\253) (?N . ?\321)
-	 (?O . ?\325) (?S . ?\252) (?U . ?\335)
-	 (?a . ?\343) (?c . ?\347) (?d . ?\360) (?g . ?\273) (?n . ?\361)
-	 (?o . ?\365) (?s . ?\252) (?u . ?\375)
-	 (?h . ?\261) (?$ . ?\245) (?` . ?\242)
-	 (?~ . ?\270) (?\  . ?~) (space . ?~))
-     (?/ (?C . ?\305) (?G . ?\325) (?H . ?\241) (?I . ?\251) (?Z . ?\257) 
-	 (?c . ?\345) (?g . ?\365) (?h . ?\261) (?i . ?\271) (?z . ?\277)
-	 (?r . ?\256) (?. . ?\377) (?# . ?\243) (?$ . ?\244)
-	 (?/ . ?\260) (?\  . ?/) (space . ?/)))
-    )
-  "List of language-specific customizations for the ISO Accents mode.
-
-Each element of the list is of the form
-
-    (LANGUAGE [CHARSET]
-     (PSEUDO-ACCENT MAPPINGS)
-     (PSEUDO-ACCENT MAPPINGS)
-     ...)
-
-LANGUAGE is a string naming the language.
-CHARSET (which may be omitted) is the symbol name
- of the character set used in this language.
- If CHARSET is omitted, latin-iso8859-1 is the default.
-PSEUDO-ACCENT is a char specifying an accent key.
-MAPPINGS are cons cells of the form (CHAR . ISO-CHAR).
-
-The net effect is that the key sequence PSEUDO-ACCENT CHAR is mapped
-to ISO-CHAR on input.")
-
-(defvar iso-language nil
-  "Language for which ISO Accents mode is currently customized.
-Change it with the `iso-accents-customize' function.")
-
-(defvar iso-accents-list nil
-  "Association list for ISO accent combinations, for the chosen language.")
-
-(defvar iso-accents-charset 'latin-iso8859-1
-  "Charset that will be used for generated characters.")
-
-(defvar iso-accents-mode nil
-  "*Non-nil enables ISO Accents mode.
-Setting this variable makes it local to the current buffer.
-See the function `iso-accents-mode'.")
-(make-variable-buffer-local 'iso-accents-mode)
-
-(defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/ ?, ?.)
-  "*List of accent keys that become prefixes in ISO Accents mode.
-The default is (?' ?` ?^ ?\" ?~ ?/ ?, ?.), which contains all the supported
-accent keys.  If you set this variable to a list in which some of those
-characters are missing, the missing ones do not act as accents.
-
-Note that if you specify a language with `iso-accents-customize',
-that can also turn off certain prefixes (whichever ones are not needed in
-the language you choose).")
-
-(defun iso-accents-accent-key (prompt)
-  "Modify the following character by adding an accent to it."
-  ;; Pick up the accent character.
-  (if (and iso-accents-mode
-	   (memq last-input-char iso-accents-enable))
-      (iso-accents-compose prompt)
-    (char-to-string last-input-char)))
-
-(defun iso-accents-compose (prompt)
-  (let* ((first-char last-input-char)
-	 (list (assq first-char iso-accents-list))
-	 (charset iso-accents-charset)
-	 ;; Wait for the second key and look up the combination.
-	 (second-char (if (or prompt
-			      (not (eq (key-binding "a")
-				       'self-insert-command))
-			      ;; Not at start of a key sequence.
-			      (> (length (this-single-command-keys)) 1)
-			      ;; Called from anything but the command loop.
-			      this-command)
-			  (progn
-			    (message "%s%c"
-				     (or prompt "Compose with ")
-				     first-char)
-			    (iso-read-event))
-			(insert first-char)
-			(prog1 (iso-read-event)
-			  (delete-region (1- (point)) (point)))))
-	 (entry (cdr (assq second-char list))))
-    (if entry
-	(progn
-	  (if (and (consp entry) (symbolp (car entry)))
-	      (setq charset (car entry)
-		    entry (cdr entry)))
-	;; Found it: return the mapped char
-	  (vector
-	   (iso-char-to-event (iso-make-char charset entry))))
-      ;; Otherwise, advance and schedule the second key for execution.
-      (setq unread-command-events (cons (iso-char-list-to-event
-					 (list second-char))
-					unread-command-events))
-      (vector (iso-char-to-event first-char)))))
-
-;; It is a matter of taste if you want the minor mode indicated
-;; in the mode line...
-;; If so, uncomment the next four lines.
-;; (or (assq 'iso-accents-mode minor-mode-alist)
-;;     (setq minor-mode-alist
-;;           (append minor-mode-alist
-;;                   '((iso-accents-mode " ISO-Acc")))))
-
-;;;###autoload
-(defun iso-accents-mode (&optional arg)
-  "Toggle ISO Accents mode, in which accents modify the following letter.
-This permits easy insertion of accented characters according to ISO-8859-1.
-When Iso-accents mode is enabled, accent character keys
-\(`, ', \", ^, / and ~) do not self-insert; instead, they modify the following
-letter key so that it inserts an ISO accented letter.
-
-You can customize ISO Accents mode to a particular language
-with the command `iso-accents-customize'.
-
-Special combinations: ~c gives a c with cedilla,
-~d gives an Icelandic eth (d with dash).
-~t gives an Icelandic thorn.
-\"s gives German sharp s.
-/a gives a with ring.
-/e gives an a-e ligature.
-~< and ~> give guillemots.
-~! gives an inverted exclamation mark.
-~? gives an inverted question mark.
-
-With an argument, a positive argument enables ISO Accents mode, 
-and a negative argument disables it."
-
-  (interactive "P")
-
-  (if (if arg
-	  ;; Negative arg means switch it off.
-	  (<= (prefix-numeric-value arg) 0)
-	;; No arg means toggle.
-	iso-accents-mode)
-      (setq iso-accents-mode nil)
-
-    ;; Enable electric accents.
-    (setq iso-accents-mode t)))
-
-(defun iso-accents-customize (language)
-  "Customize the ISO accents machinery for a particular language.
-It selects the customization based on the specifications in the
-`iso-languages' variable."
-  (interactive (list (completing-read "Language: " iso-languages nil t)))
-  (let ((table (cdr (assoc language iso-languages)))
-	tail)
-    (if (not table)
-	(error "Unknown language `%s'" language)
-      (setq iso-accents-charset (if (symbolp (car table))
-				    (car table)
-				  'latin-iso8859-1))
-      (if (symbolp (car table))
-	  (setq table (cdr table)))
-      (setq iso-language language
-	    iso-accents-list table)
-      (if key-translation-map
-	  (substitute-key-definition
-	   'iso-accents-accent-key nil key-translation-map)
-	(setq key-translation-map (make-sparse-keymap)))
-      ;; Set up translations for all the characters that are used as
-      ;; accent prefixes in this language.
-      (setq tail iso-accents-list)
-      (while tail
-	(define-key key-translation-map (vector (iso-char-to-event
-						 (car (car tail))))
-	  'iso-accents-accent-key)
-	(setq tail (cdr tail))))))
-
-(defun iso-accentuate (start end)
-  "Convert two-character sequences in region into accented characters.
-Noninteractively, this operates on text from START to END.
-This uses the same conversion that ISO Accents mode uses for type-in."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char start)
-      (forward-char 1)
-      (let (entry)
-	(while (< (point) end)
-	  (if (and (memq (preceding-char) iso-accents-enable)
-		   (setq entry (cdr (assq (following-char) (assq (preceding-char) iso-accents-list)))))
-	      (progn
-		(forward-char -1)
-		(delete-char 2)
-		(insert entry)
-		(setq end (1- end)))
-	    (forward-char 1)))))))
-
-(defun iso-accent-rassoc-unit (value alist)
-  (let (elt acc)
-    (while (and alist (not elt))
-      (setq acc (car (car alist))
-	    elt (car (rassq value (cdr (car alist))))
-	    alist (cdr alist)))
-    (if elt
-	(cons acc elt))))
-
-(defun iso-unaccentuate (start end)
-  "Convert accented characters in the region into two-character sequences.
-Noninteractively, this operates on text from START to END.
-This uses the opposite of the conversion done by ISO Accents mode for type-in."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char start)
-      (let (entry)
-	(while (< (point) end)
-	  (if (and (> (following-char) 127)
-		   (setq entry (iso-accent-rassoc-unit (following-char)
-						       iso-accents-list)))
-	      (progn
-		(delete-char 1)
-		(insert (car entry) (cdr entry))
-		(setq end (1+ end)))
-	    (forward-char 1)))))))
-
-(defun iso-deaccentuate (start end)
-  "Convert accented characters in the region into unaccented characters.
-Noninteractively, this operates on text from START to END."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char start)
-      (let (entry)
-	(while (< (point) end)
-	  (if (and (> (following-char) 127)
-		   (setq entry (iso-accent-rassoc-unit (following-char)
-						       iso-accents-list)))
-	      (progn
-		(delete-char 1)
-		(insert (cdr entry)))
-	    (forward-char 1)))))))
-
-;; Set up the default settings.
-(iso-accents-customize "latin-1")
-
-;; Use Iso-Accents mode in the minibuffer
-;; if it was in use in the previous buffer.
-(defun iso-acc-minibuf-setup ()
-  (setq iso-accents-mode
-	(save-excursion
-	  (set-buffer (window-buffer minibuffer-scroll-window))
-	  iso-accents-mode)))
-
-(if (boundp 'minibuffer-setup-hook)
-    (add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup)
-  (add-hook 'minibuf-setup-hook 'iso-acc-minibuf-setup))
-
-;;; iso-acc.el ends here
diff --git a/xemacs-packages/lisp/text-modes/iso-ascii.el b/xemacs-packages/lisp/text-modes/iso-ascii.el
deleted file mode 100644
index 47fa2ace..00000000
--- a/xemacs-packages/lisp/text-modes/iso-ascii.el
+++ /dev/null
@@ -1,148 +0,0 @@
-;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals.
-
-;; Copyright (C) 1987, 1995 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; Written by Howard Gayle.  See display-table.el for details.
-
-;; This code sets up to display ISO 8859/1 characters on plain
-;; ASCII terminals.  The display strings for the characters are
-;; more-or-less based on TeX.
-
-;;; Code:
-
-(require 'disp-table)
-
-(defvar iso-ascii-convenient nil
-  "*Non-nil means `iso-ascii' should aim for convenience, not precision.")
-
-(defun iso-ascii-display (code string &optional convenient-string)
-  (if iso-ascii-convenient
-      (setq string (or convenient-string string))
-    (setq string (concat "{" string "}")))
-  (standard-display-ascii code string))
-
-(iso-ascii-display 160 "_" " ")   ; NBSP (no-break space)
-(iso-ascii-display 161 "!")   ; inverted exclamation mark
-(iso-ascii-display 162 "c")   ; cent sign
-(iso-ascii-display 163 "GBP") ; pound sign
-(iso-ascii-display 164 "$")   ; general currency sign
-(iso-ascii-display 165 "JPY") ; yen sign
-(iso-ascii-display 166 "|")   ; broken vertical line
-(iso-ascii-display 167 "S" "(S)")   ; section sign
-(iso-ascii-display 168 "\"")  ; diaeresis
-(iso-ascii-display 169 "C" "(C)")   ; copyright sign
-(iso-ascii-display 170 "_a")  ; ordinal indicator, feminine
-(iso-ascii-display 171 "<<")  ; left angle quotation mark
-(iso-ascii-display 172 "~")   ; not sign
-(iso-ascii-display 173 "-")   ; soft hyphen
-(iso-ascii-display 174 "R" "(R)")   ; registered sign
-(iso-ascii-display 175 "=")   ; macron
-(iso-ascii-display 176 "o")   ; degree sign
-(iso-ascii-display 177 "+-")  ; plus or minus sign
-(iso-ascii-display 178 "2")   ; superscript two
-(iso-ascii-display 179 "3")   ; superscript three
-(iso-ascii-display 180 "'")   ; acute accent
-(iso-ascii-display 181 "u")   ; micro sign
-(iso-ascii-display 182 "P" "{P}")   ; pilcrow
-(iso-ascii-display 183 ".")   ; middle dot
-(iso-ascii-display 184 ",")   ; cedilla
-(iso-ascii-display 185 "1")   ; superscript one
-(iso-ascii-display 186 "_o")  ; ordinal indicator, masculine
-(iso-ascii-display 187 ">>")  ; right angle quotation mark
-(iso-ascii-display 188 "1/4") ; fraction one-quarter
-(iso-ascii-display 189 "1/2") ; fraction one-half
-(iso-ascii-display 190 "3/4") ; fraction three-quarters
-(iso-ascii-display 191 "?")   ; inverted question mark
-(iso-ascii-display 192 "`A")  ; A with grave accent
-(iso-ascii-display 193 "'A")  ; A with acute accent
-(iso-ascii-display 194 "^A")  ; A with circumflex accent
-(iso-ascii-display 195 "~A")  ; A with tilde
-(iso-ascii-display 196 "\"A") ; A with diaeresis or umlaut mark
-(iso-ascii-display 197 "AA")  ; A with ring
-(iso-ascii-display 198 "AE")  ; AE diphthong
-(iso-ascii-display 199 ",C")  ; C with cedilla
-(iso-ascii-display 200 "`E")  ; E with grave accent
-(iso-ascii-display 201 "'E")  ; E with acute accent
-(iso-ascii-display 202 "^E")  ; E with circumflex accent
-(iso-ascii-display 203 "\"E") ; E with diaeresis or umlaut mark
-(iso-ascii-display 204 "`I")  ; I with grave accent
-(iso-ascii-display 205 "'I")  ; I with acute accent
-(iso-ascii-display 206 "^I")  ; I with circumflex accent
-(iso-ascii-display 207 "\"I") ; I with diaeresis or umlaut mark
-(iso-ascii-display 208 "-D")  ; D with stroke, Icelandic eth
-(iso-ascii-display 209 "~N")  ; N with tilde
-(iso-ascii-display 210 "`O")  ; O with grave accent
-(iso-ascii-display 211 "'O")  ; O with acute accent
-(iso-ascii-display 212 "^O")  ; O with circumflex accent
-(iso-ascii-display 213 "~O")  ; O with tilde
-(iso-ascii-display 214 "\"O") ; O with diaeresis or umlaut mark
-(iso-ascii-display 215 "x")   ; multiplication sign
-(iso-ascii-display 216 "/O")  ; O with slash
-(iso-ascii-display 217 "`U")  ; U with grave accent
-(iso-ascii-display 218 "'U")  ; U with acute accent
-(iso-ascii-display 219 "^U")  ; U with circumflex accent
-(iso-ascii-display 220 "\"U") ; U with diaeresis or umlaut mark
-(iso-ascii-display 221 "'Y")  ; Y with acute accent
-(iso-ascii-display 222 "TH")  ; capital thorn, Icelandic
-(iso-ascii-display 223 "ss")  ; small sharp s, German
-(iso-ascii-display 224 "`a")  ; a with grave accent
-(iso-ascii-display 225 "'a")  ; a with acute accent
-(iso-ascii-display 226 "^a")  ; a with circumflex accent
-(iso-ascii-display 227 "~a")  ; a with tilde
-(iso-ascii-display 228 "\"a") ; a with diaeresis or umlaut mark
-(iso-ascii-display 229 "aa")  ; a with ring
-(iso-ascii-display 230 "ae")  ; ae diphthong
-(iso-ascii-display 231 ",c")  ; c with cedilla
-(iso-ascii-display 232 "`e")  ; e with grave accent
-(iso-ascii-display 233 "'e")  ; e with acute accent
-(iso-ascii-display 234 "^e")  ; e with circumflex accent
-(iso-ascii-display 235 "\"e") ; e with diaeresis or umlaut mark
-(iso-ascii-display 236 "`i")  ; i with grave accent
-(iso-ascii-display 237 "'i")  ; i with acute accent
-(iso-ascii-display 238 "^i")  ; i with circumflex accent
-(iso-ascii-display 239 "\"i") ; i with diaeresis or umlaut mark
-(iso-ascii-display 240 "-d")  ; d with stroke, Icelandic eth
-(iso-ascii-display 241 "~n")  ; n with tilde
-(iso-ascii-display 242 "`o")  ; o with grave accent
-(iso-ascii-display 243 "'o")  ; o with acute accent
-(iso-ascii-display 244 "^o")  ; o with circumflex accent
-(iso-ascii-display 245 "~o")  ; o with tilde
-(iso-ascii-display 246 "\"o") ; o with diaeresis or umlaut mark
-(iso-ascii-display 247 "/")   ; division sign
-(iso-ascii-display 248 "/o")  ; o with slash
-(iso-ascii-display 249 "`u")  ; u with grave accent
-(iso-ascii-display 250 "'u")  ; u with acute accent
-(iso-ascii-display 251 "^u")  ; u with circumflex accent
-(iso-ascii-display 252 "\"u") ; u with diaeresis or umlaut mark
-(iso-ascii-display 253 "'y")  ; y with acute accent
-(iso-ascii-display 254 "th")  ; small thorn, Icelandic
-(iso-ascii-display 255 "\"y") ; small y with diaeresis or umlaut mark
-
-(provide 'iso-ascii)
-
-;;; iso-ascii.el ends here
diff --git a/xemacs-packages/lisp/text-modes/iso-cvt.el b/xemacs-packages/lisp/text-modes/iso-cvt.el
deleted file mode 100644
index 06e4d02c..00000000
--- a/xemacs-packages/lisp/text-modes/iso-cvt.el
+++ /dev/null
@@ -1,719 +0,0 @@
-;;; iso-cvt.el --- translate to ISO 8859-1 from/to net/TeX conventions
-;; This file was formerly called gm-lingo.el.
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Michael Gschwind 
-;; Keywords: tex, iso, latin, i18n
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary: 
-
-;; This lisp code serves two purposes, both of which involve 
-;; the translation of various conventions for representing European 
-;; character sets to ISO 8859-1.
-
-;; Net support: 
-;; Various conventions exist in Newsgroups on how to represent national 
-;; characters. The functions provided here translate these net conventions 
-;; to ISO.
-;;
-;; Calling `iso-german' will turn the net convention for umlauts ("a etc.) 
-;; into ISO latin1 umlauts for easy reading.
-;; 'iso-spanish' will turn net conventions for representing spanish 
-;; to ISO latin1. (Note that accents are omitted in news posts most 
-;; of the time, only enye is escaped.)
-
-;; TeX support
-;; This mode installs hooks which change TeX files to ISO Latin-1 for 
-;; simplified editing. When the TeX file is saved, ISO latin1 characters are
-;; translated back to escape sequences.
-;;
-;; An alternative is a TeX style that handles 8 bit ISO files 
-;; (available on ftp.vlsivie.tuwien.ac.at in /pub/8bit)  
-;; - but these files are difficult to transmit ... so while the net is  
-;; still @ 7 bit this may be useful
-
-;;; TO DO:
-;; The net support should install hooks (like TeX support does) 
-;; which recognizes certain news groups and translates all articles from 
-;; those groups. 
-;;
-;; Cover more cases for translation (There is an infinite number of ways to 
-;; represent accented characters in TeX)
-
-;;; SEE ALSO:
-;; If you are interested in questions related to using the ISO 8859-1 
-;; characters set (configuring emacs, Unix, etc. to use ISO), then you
-;; can get the ISO 8859-1 FAQ via anonymous ftp from 
-;; ftp.vlsivie.tuwien.ac.at in /pub/bit/FAQ-ISO-8859-1
-
-;;; Code:
-
-(provide 'iso-cvt)
-
-(defvar iso-spanish-trans-tab
-  '(
-    ("~n" "ñ")
-    ("\([a-zA-Z]\)#" "\\1ñ")
-    ("~N" "Ñ")
-    ("\\([-a-zA-Z\"`]\\)\"u" "\\1ü")
-    ("\\([-a-zA-Z\"`]\\)\"U" "\\1Ü")
-    ("\\([-a-zA-Z]\\)'o" "\\1ó")
-    ("\\([-a-zA-Z]\\)'O" "\\Ó")
-    ("\\([-a-zA-Z]\\)'e" "\\1é")
-    ("\\([-a-zA-Z]\\)'E" "\\1É")
-    ("\\([-a-zA-Z]\\)'a" "\\1á")
-    ("\\([-a-zA-Z]\\)'A" "\\1A")
-    ("\\([-a-zA-Z]\\)'i" "\\1í")
-    ("\\([-a-zA-Z]\\)'I" "\\1Í")
-    )
-  "Spanish translation table.")
-
-(defun iso-translate-conventions (trans-tab)
-  "Use the translation table TRANS-TAB to translate the current buffer."
-  (save-excursion
-    (goto-char (point-min))
-    (let ((work-tab trans-tab)
-	  (buffer-read-only nil)
-	  (case-fold-search nil))
-      (while work-tab
-	(save-excursion
-	  (let ((trans-this (car work-tab)))
-	    (while (re-search-forward (car trans-this) nil t)
-	      (replace-match (car (cdr trans-this)) t nil)))
-	  (setq work-tab (cdr work-tab)))))))
-
-(defun iso-spanish ()
-  "Translate net conventions for Spanish to ISO 8859-1."
-  (interactive)
-  (iso-translate-conventions iso-spanish-trans-tab))
-
-(defvar iso-aggressive-german-trans-tab
-  '(
-    ("\"a" "ä")
-    ("\"A" "Ä")
-    ("\"o" "ö")
-    ("\"O" "Ö")
-    ("\"u" "ü")
-    ("\"U" "Ü")
-    ("\"s" "ß")
-    ("\\\\3" "ß")
-    )
-  "German translation table. 
-This table uses an aggressive translation approach and may erroneously
-translate too much.")
-
-(defvar iso-conservative-german-trans-tab
-  '(
-    ("\\([-a-zA-Z\"`]\\)\"a" "\\1ä")
-    ("\\([-a-zA-Z\"`]\\)\"A" "\\1Ä")
-    ("\\([-a-zA-Z\"`]\\)\"o" "\\1ö")
-    ("\\([-a-zA-Z\"`]\\)\"O" "\\1Ö")
-    ("\\([-a-zA-Z\"`]\\)\"u" "\\1ü")
-    ("\\([-a-zA-Z\"`]\\)\"U" "\\1Ü")
-    ("\\([-a-zA-Z\"`]\\)\"s" "\\1ß")
-    ("\\([-a-zA-Z\"`]\\)\\\\3" "\\1ß")
-    )
-  "German translation table.
-This table uses a conservative translation approach and may translate too 
-little.")
-
-
-(defvar iso-german-trans-tab iso-aggressive-german-trans-tab 
-  "Currently active translation table for German.")
-
-(defun iso-german ()
- "Translate net conventions for German to ISO 8859-1."
- (interactive)
- (iso-translate-conventions iso-german-trans-tab))
- 
-(defvar iso-iso2tex-trans-tab
-  '(
-    ("ä" "{\\\\\"a}")
-    ("à" "{\\\\`a}")
-    ("á" "{\\\\'a}")
-    ("ã" "{\\\\~a}")
-    ("â" "{\\\\^a}")
-    ("ë" "{\\\\\"e}")
-    ("è" "{\\\\`e}")
-    ("é" "{\\\\'e}")
-    ("ê" "{\\\\^e}")
-    ("ï" "{\\\\\"\\\\i}")
-    ("ì" "{\\\\`\\\\i}")
-    ("í" "{\\\\'\\\\i}")
-    ("î" "{\\\\^\\\\i}")
-    ("ö" "{\\\\\"o}")
-    ("ò" "{\\\\`o}")
-    ("ó" "{\\\\'o}")
-    ("õ" "{\\\\~o}")
-    ("ô" "{\\\\^o}")
-    ("ü" "{\\\\\"u}")
-    ("ù" "{\\\\`u}")
-    ("ú" "{\\\\'u}")
-    ("û" "{\\\\^u}")
-    ("Ä" "{\\\\\"A}")
-    ("À" "{\\\\`A}")
-    ("Á" "{\\\\'A}")
-    ("Ã" "{\\\\~A}")
-    ("Â" "{\\\\^A}")
-    ("Ë" "{\\\\\"E}")
-    ("È" "{\\\\`E}")
-    ("É" "{\\\\'E}")
-    ("Ê" "{\\\\^E}")
-    ("Ï" "{\\\\\"I}")
-    ("Ì" "{\\\\`I}")
-    ("Í" "{\\\\'I}")
-    ("Î" "{\\\\^I}")
-    ("Ö" "{\\\\\"O}")
-    ("Ò" "{\\\\`O}")
-    ("Ó" "{\\\\'O}")
-    ("Õ" "{\\\\~O}")
-    ("Ô" "{\\\\^O}")
-    ("Ü" "{\\\\\"U}")
-    ("Ù" "{\\\\`U}")
-    ("Ú" "{\\\\'U}")
-    ("Û" "{\\\\^U}")
-    ("ñ" "{\\\\~n}")
-    ("Ñ" "{\\\\~N}")
-    ("ç" "{\\\\c c}")
-    ("Ç" "{\\\\c C}")
-    ("ß" "{\\\\ss}")
-    ("\306" "{\\\\AE}")
-    ("\346" "{\\\\ae}")
-    ("\305" "{\\\\AA}")
-    ("\345" "{\\\\aa}")
-    ("\251" "{\\\\copyright}")
-    ("£" "{\\\\pounds}")
-    ("¶" "{\\\\P}")
-    ("§" "{\\\\S}")
-    ("¿" "{?`}")
-    ("¡" "{!`}")
-    )
-  "Translation table for translating ISO 8859-1 characters to TeX sequences.")
-
-
-
-
-(defun iso-iso2tex ()
- "Translate ISO 8859-1 characters to TeX sequences."
- (interactive)
- (iso-translate-conventions iso-iso2tex-trans-tab))
-
-
-(defvar iso-tex2iso-trans-tab
-  '(
-    ("{\\\\\"a}" "ä")
-    ("{\\\\`a}" "à")
-    ("{\\\\'a}" "á")
-    ("{\\\\~a}" "ã")
-    ("{\\\\^a}" "â")
-    ("{\\\\\"e}" "ë")
-    ("{\\\\`e}" "è")
-    ("{\\\\'e}" "é")
-    ("{\\\\^e}" "ê")
-    ("{\\\\\"\\\\i}" "ï")
-    ("{\\\\`\\\\i}" "ì")
-    ("{\\\\'\\\\i}" "í")
-    ("{\\\\^\\\\i}" "î")
-    ("{\\\\\"i}" "ï")
-    ("{\\\\`i}" "ì")
-    ("{\\\\'i}" "í")
-    ("{\\\\^i}" "î")
-    ("{\\\\\"o}" "ö")
-    ("{\\\\`o}" "ò")
-    ("{\\\\'o}" "ó")
-    ("{\\\\~o}" "õ")
-    ("{\\\\^o}" "ô")
-    ("{\\\\\"u}" "ü")
-    ("{\\\\`u}" "ù")
-    ("{\\\\'u}" "ú")
-    ("{\\\\^u}" "û")
-    ("{\\\\\"A}" "Ä")
-    ("{\\\\`A}" "À")
-    ("{\\\\'A}" "Á")
-    ("{\\\\~A}" "Ã")
-    ("{\\\\^A}" "Â")
-    ("{\\\\\"E}" "Ë")
-    ("{\\\\`E}" "È")
-    ("{\\\\'E}" "É")
-    ("{\\\\^E}" "Ê")
-    ("{\\\\\"I}" "Ï")
-    ("{\\\\`I}" "Ì")
-    ("{\\\\'I}" "Í")
-    ("{\\\\^I}" "Î")
-    ("{\\\\\"O}" "Ö")
-    ("{\\\\`O}" "Ò")
-    ("{\\\\'O}" "Ó")
-    ("{\\\\~O}" "Õ")
-    ("{\\\\^O}" "Ô")
-    ("{\\\\\"U}" "Ü")
-    ("{\\\\`U}" "Ù")
-    ("{\\\\'U}" "Ú")
-    ("{\\\\^U}" "Û")
-    ("{\\\\~n}" "ñ")
-    ("{\\\\~N}" "Ñ")
-    ("{\\\\c c}" "ç")
-    ("{\\\\c C}" "Ç")
-    ("\\\\\"a" "ä")
-    ("\\\\`a" "à")
-    ("\\\\'a" "á")
-    ("\\\\~a" "ã")
-    ("\\\\^a" "â")
-    ("\\\\\"e" "ë")
-    ("\\\\`e" "è")
-    ("\\\\'e" "é")
-    ("\\\\^e" "ê")
-    ("\\\\\"\\\\i" "ï")
-    ("\\\\`\\\\i" "ì")
-    ("\\\\'\\\\i" "í")
-    ("\\\\^\\\\i" "î")
-    ("\\\\\"i" "ï")
-    ("\\\\`i" "ì")
-    ("\\\\'i" "í")
-    ("\\\\^i" "î")
-    ("\\\\\"o" "ö")
-    ("\\\\`o" "ò")
-    ("\\\\'o" "ó")
-    ("\\\\~o" "õ")
-    ("\\\\^o" "ô")
-    ("\\\\\"u" "ü")
-    ("\\\\`u" "ù")
-    ("\\\\'u" "ú")
-    ("\\\\^u" "û")
-    ("\\\\\"A" "Ä")
-    ("\\\\`A" "À")
-    ("\\\\'A" "Á")
-    ("\\\\~A" "Ã")
-    ("\\\\^A" "Â")
-    ("\\\\\"E" "Ë")
-    ("\\\\`E" "È")
-    ("\\\\'E" "É")
-    ("\\\\^E" "Ê")
-    ("\\\\\"I" "Ï")
-    ("\\\\`I" "Ì")
-    ("\\\\'I" "Í")
-    ("\\\\^I" "Î")
-    ("\\\\\"O" "Ö")
-    ("\\\\`O" "Ò")
-    ("\\\\'O" "Ó")
-    ("\\\\~O" "Õ")
-    ("\\\\^O" "Ô")
-    ("\\\\\"U" "Ü")
-    ("\\\\`U" "Ù")
-    ("\\\\'U" "Ú")
-    ("\\\\^U" "Û")
-    ("\\\\~n" "ñ")
-    ("\\\\~N" "Ñ")
-    ("\\\\\"{a}" "ä")
-    ("\\\\`{a}" "à")
-    ("\\\\'{a}" "á")
-    ("\\\\~{a}" "ã")
-    ("\\\\^{a}" "â")
-    ("\\\\\"{e}" "ë")
-    ("\\\\`{e}" "è")
-    ("\\\\'{e}" "é")
-    ("\\\\^{e}" "ê")
-    ("\\\\\"{\\\\i}" "ï")
-    ("\\\\`{\\\\i}" "ì")
-    ("\\\\'{\\\\i}" "í")
-    ("\\\\^{\\\\i}" "î")
-    ("\\\\\"{i}" "ï")
-    ("\\\\`{i}" "ì")
-    ("\\\\'{i}" "í")
-    ("\\\\^{i}" "î")
-    ("\\\\\"{o}" "ö")
-    ("\\\\`{o}" "ò")
-    ("\\\\'{o}" "ó")
-    ("\\\\~{o}" "õ")
-    ("\\\\^{o}" "ô")
-    ("\\\\\"{u}" "ü")
-    ("\\\\`{u}" "ù")
-    ("\\\\'{u}" "ú")
-    ("\\\\^{u}" "û")
-    ("\\\\\"{A}" "Ä")
-    ("\\\\`{A}" "À")
-    ("\\\\'{A}" "Á")
-    ("\\\\~{A}" "Ã")
-    ("\\\\^{A}" "Â")
-    ("\\\\\"{E}" "Ë")
-    ("\\\\`{E}" "È")
-    ("\\\\'{E}" "É")
-    ("\\\\^{E}" "Ê")
-    ("\\\\\"{I}" "Ï")
-    ("\\\\`{I}" "Ì")
-    ("\\\\'{I}" "Í")
-    ("\\\\^{I}" "Î")
-    ("\\\\\"{O}" "Ö")
-    ("\\\\`{O}" "Ò")
-    ("\\\\'{O}" "Ó")
-    ("\\\\~{O}" "Õ")
-    ("\\\\^{O}" "Ô")
-    ("\\\\\"{U}" "Ü")
-    ("\\\\`{U}" "Ù")
-    ("\\\\'{U}" "Ú")
-    ("\\\\^{U}" "Û")
-    ("\\\\~{n}" "ñ")
-    ("\\\\~{N}" "Ñ")
-    ("\\\\c{c}" "ç")
-    ("\\\\c{C}" "Ç")
-    ("{\\\\ss}" "ß")
-    ("{\\\\AE}" "\306")
-    ("{\\\\ae}" "\346")
-    ("{\\\\AA}" "\305")
-    ("{\\\\aa}" "\345")
-    ("{\\\\copyright}" "\251")
-    ("\\\\copyright{}" "\251")
-    ("{\\\\pounds}" "£" )
-    ("{\\\\P}" "¶" )
-    ("{\\\\S}" "§" )
-    ("\\\\pounds{}" "£" )
-    ("\\\\P{}" "¶" )
-    ("\\\\S{}" "§" )
-    ("{\\?`}" "¿")
-    ("{!`}" "¡")
-    ("\\?`" "¿")
-    ("!`" "¡")
-    )
-  "Translation table for translating TeX sequences to ISO 8859-1 characters. 
-This table is not exhaustive (and due to TeX's power can never be). It only
-contains commonly used sequences.")
-
-(defun iso-tex2iso ()
- "Translate TeX sequences to ISO 8859-1 characters."
- (interactive)
- (iso-translate-conventions iso-tex2iso-trans-tab))
-
-(defvar iso-gtex2iso-trans-tab
-  '(
-    ("{\\\\\"a}" "ä")
-    ("{\\\\`a}" "à")
-    ("{\\\\'a}" "á")
-    ("{\\\\~a}" "ã")
-    ("{\\\\^a}" "â")
-    ("{\\\\\"e}" "ë")
-    ("{\\\\`e}" "è")
-    ("{\\\\'e}" "é")
-    ("{\\\\^e}" "ê")
-    ("{\\\\\"\\\\i}" "ï")
-    ("{\\\\`\\\\i}" "ì")
-    ("{\\\\'\\\\i}" "í")
-    ("{\\\\^\\\\i}" "î")
-    ("{\\\\\"i}" "ï")
-    ("{\\\\`i}" "ì")
-    ("{\\\\'i}" "í")
-    ("{\\\\^i}" "î")
-    ("{\\\\\"o}" "ö")
-    ("{\\\\`o}" "ò")
-    ("{\\\\'o}" "ó")
-    ("{\\\\~o}" "õ")
-    ("{\\\\^o}" "ô")
-    ("{\\\\\"u}" "ü")
-    ("{\\\\`u}" "ù")
-    ("{\\\\'u}" "ú")
-    ("{\\\\^u}" "û")
-    ("{\\\\\"A}" "Ä")
-    ("{\\\\`A}" "À")
-    ("{\\\\'A}" "Á")
-    ("{\\\\~A}" "Ã")
-    ("{\\\\^A}" "Â")
-    ("{\\\\\"E}" "Ë")
-    ("{\\\\`E}" "È")
-    ("{\\\\'E}" "É")
-    ("{\\\\^E}" "Ê")
-    ("{\\\\\"I}" "Ï")
-    ("{\\\\`I}" "Ì")
-    ("{\\\\'I}" "Í")
-    ("{\\\\^I}" "Î")
-    ("{\\\\\"O}" "Ö")
-    ("{\\\\`O}" "Ò")
-    ("{\\\\'O}" "Ó")
-    ("{\\\\~O}" "Õ")
-    ("{\\\\^O}" "Ô")
-    ("{\\\\\"U}" "Ü")
-    ("{\\\\`U}" "Ù")
-    ("{\\\\'U}" "Ú")
-    ("{\\\\^U}" "Û")
-    ("{\\\\~n}" "ñ")
-    ("{\\\\~N}" "Ñ")
-    ("{\\\\c c}" "ç")
-    ("{\\\\c C}" "Ç")
-    ("\\\\\"a" "ä")
-    ("\\\\`a" "à")
-    ("\\\\'a" "á")
-    ("\\\\~a" "ã")
-    ("\\\\^a" "â")
-    ("\\\\\"e" "ë")
-    ("\\\\`e" "è")
-    ("\\\\'e" "é")
-    ("\\\\^e" "ê")
-    ("\\\\\"\\\\i" "ï")
-    ("\\\\`\\\\i" "ì")
-    ("\\\\'\\\\i" "í")
-    ("\\\\^\\\\i" "î")
-    ("\\\\\"i" "ï")
-    ("\\\\`i" "ì")
-    ("\\\\'i" "í")
-    ("\\\\^i" "î")
-    ("\\\\\"o" "ö")
-    ("\\\\`o" "ò")
-    ("\\\\'o" "ó")
-    ("\\\\~o" "õ")
-    ("\\\\^o" "ô")
-    ("\\\\\"u" "ü")
-    ("\\\\`u" "ù")
-    ("\\\\'u" "ú")
-    ("\\\\^u" "û")
-    ("\\\\\"A" "Ä")
-    ("\\\\`A" "À")
-    ("\\\\'A" "Á")
-    ("\\\\~A" "Ã")
-    ("\\\\^A" "Â")
-    ("\\\\\"E" "Ë")
-    ("\\\\`E" "È")
-    ("\\\\'E" "É")
-    ("\\\\^E" "Ê")
-    ("\\\\\"I" "Ï")
-    ("\\\\`I" "Ì")
-    ("\\\\'I" "Í")
-    ("\\\\^I" "Î")
-    ("\\\\\"O" "Ö")
-    ("\\\\`O" "Ò")
-    ("\\\\'O" "Ó")
-    ("\\\\~O" "Õ")
-    ("\\\\^O" "Ô")
-    ("\\\\\"U" "Ü")
-    ("\\\\`U" "Ù")
-    ("\\\\'U" "Ú")
-    ("\\\\^U" "Û")
-    ("\\\\~n" "ñ")
-    ("\\\\~N" "Ñ")
-    ("\\\\\"{a}" "ä")
-    ("\\\\`{a}" "à")
-    ("\\\\'{a}" "á")
-    ("\\\\~{a}" "ã")
-    ("\\\\^{a}" "â")
-    ("\\\\\"{e}" "ë")
-    ("\\\\`{e}" "è")
-    ("\\\\'{e}" "é")
-    ("\\\\^{e}" "ê")
-    ("\\\\\"{\\\\i}" "ï")
-    ("\\\\`{\\\\i}" "ì")
-    ("\\\\'{\\\\i}" "í")
-    ("\\\\^{\\\\i}" "î")
-    ("\\\\\"{i}" "ï")
-    ("\\\\`{i}" "ì")
-    ("\\\\'{i}" "í")
-    ("\\\\^{i}" "î")
-    ("\\\\\"{o}" "ö")
-    ("\\\\`{o}" "ò")
-    ("\\\\'{o}" "ó")
-    ("\\\\~{o}" "õ")
-    ("\\\\^{o}" "ô")
-    ("\\\\\"{u}" "ü")
-    ("\\\\`{u}" "ù")
-    ("\\\\'{u}" "ú")
-    ("\\\\^{u}" "û")
-    ("\\\\\"{A}" "Ä")
-    ("\\\\`{A}" "À")
-    ("\\\\'{A}" "Á")
-    ("\\\\~{A}" "Ã")
-    ("\\\\^{A}" "Â")
-    ("\\\\\"{E}" "Ë")
-    ("\\\\`{E}" "È")
-    ("\\\\'{E}" "É")
-    ("\\\\^{E}" "Ê")
-    ("\\\\\"{I}" "Ï")
-    ("\\\\`{I}" "Ì")
-    ("\\\\'{I}" "Í")
-    ("\\\\^{I}" "Î")
-    ("\\\\\"{O}" "Ö")
-    ("\\\\`{O}" "Ò")
-    ("\\\\'{O}" "Ó")
-    ("\\\\~{O}" "Õ")
-    ("\\\\^{O}" "Ô")
-    ("\\\\\"{U}" "Ü")
-    ("\\\\`{U}" "Ù")
-    ("\\\\'{U}" "Ú")
-    ("\\\\^{U}" "Û")
-    ("\\\\~{n}" "ñ")
-    ("\\\\~{N}" "Ñ")
-    ("\\\\c{c}" "ç")
-    ("\\\\c{C}" "Ç")
-    ("{\\\\ss}" "ß")
-    ("{\\\\AE}" "\306")
-    ("{\\\\ae}" "\346")
-    ("{\\\\AA}" "\305")
-    ("{\\\\aa}" "\345")
-    ("{\\\\copyright}" "\251")
-    ("\\\\copyright{}" "\251")
-    ("{\\\\pounds}" "£" )
-    ("{\\\\P}" "¶" )
-    ("{\\\\S}" "§" )
-    ("\\\\pounds{}" "£" )
-    ("\\\\P{}" "¶" )
-    ("\\\\S{}" "§" )
-    ("?`" "¿")
-    ("!`" "¡")
-    ("{?`}" "¿")
-    ("{!`}" "¡")
-    ("\"a" "ä")
-    ("\"A" "Ä")
-    ("\"o" "ö")
-    ("\"O" "Ö")
-    ("\"u" "ü")
-    ("\"U" "Ü")
-    ("\"s" "ß")
-    ("\\\\3" "ß")
-    )
-  "Translation table for translating German TeX sequences to ISO 8859-1.
-This table is not exhaustive (and due to TeX's power can never be).  It only
-contains commonly used sequences.")
-
-(defvar iso-iso2gtex-trans-tab
-  '(
-    ("ä" "\"a")
-    ("à" "{\\\\`a}")
-    ("á" "{\\\\'a}")
-    ("ã" "{\\\\~a}")
-    ("â" "{\\\\^a}")
-    ("ë" "{\\\\\"e}")
-    ("è" "{\\\\`e}")
-    ("é" "{\\\\'e}")
-    ("ê" "{\\\\^e}")
-    ("ï" "{\\\\\"\\\\i}")
-    ("ì" "{\\\\`\\\\i}")
-    ("í" "{\\\\'\\\\i}")
-    ("î" "{\\\\^\\\\i}")
-    ("ö" "\"o")
-    ("ò" "{\\\\`o}")
-    ("ó" "{\\\\'o}")
-    ("õ" "{\\\\~o}")
-    ("ô" "{\\\\^o}")
-    ("ü" "\"u")
-    ("ù" "{\\\\`u}")
-    ("ú" "{\\\\'u}")
-    ("û" "{\\\\^u}")
-    ("Ä" "\"A")
-    ("À" "{\\\\`A}")
-    ("Á" "{\\\\'A}")
-    ("Ã" "{\\\\~A}")
-    ("Â" "{\\\\^A}")
-    ("Ë" "{\\\\\"E}")
-    ("È" "{\\\\`E}")
-    ("É" "{\\\\'E}")
-    ("Ê" "{\\\\^E}")
-    ("Ï" "{\\\\\"I}")
-    ("Ì" "{\\\\`I}")
-    ("Í" "{\\\\'I}")
-    ("Î" "{\\\\^I}")
-    ("Ö" "\"O")
-    ("Ò" "{\\\\`O}")
-    ("Ó" "{\\\\'O}")
-    ("Õ" "{\\\\~O}")
-    ("Ô" "{\\\\^O}")
-    ("Ü" "\"U")
-    ("Ù" "{\\\\`U}")
-    ("Ú" "{\\\\'U}")
-    ("Û" "{\\\\^U}")
-    ("ñ" "{\\\\~n}")
-    ("Ñ" "{\\\\~N}")
-    ("ç" "{\\\\c c}")
-    ("Ç" "{\\\\c C}")
-    ("ß" "\"s")
-    ("\306" "{\\\\AE}")
-    ("\346" "{\\\\ae}")
-    ("\305" "{\\\\AA}")
-    ("\345" "{\\\\aa}")
-    ("\251" "{\\\\copyright}")
-    ("£" "{\\\\pounds}")
-    ("¶" "{\\\\P}")
-    ("§" "{\\\\S}")
-    ("¿" "{?`}")
-    ("¡" "{!`}")
-    )
-  "Translation table for translating ISO 8859-1 characters to German TeX.")
-
-(defun iso-gtex2iso ()
- "Translate German TeX sequences to ISO 8859-1 characters."
- (interactive)
- (iso-translate-conventions iso-gtex2iso-trans-tab))
-
-
-(defun iso-iso2gtex ()
- "Translate ISO 8859-1 characters to German TeX sequences."
- (interactive)
- (iso-translate-conventions iso-iso2gtex-trans-tab))
-
-
-(defun iso-german-tex-p ()
- "Check if tex buffer is German LaTeX."
- (save-excursion
-   (save-restriction
-     (widen)
-     (goto-char (point-min))
-     (re-search-forward "\\\\documentstyle\\[.*german.*\\]" nil t))))
-
-(defun iso-fix-iso2tex ()
-  "Turn ISO 8859-1 (aka. ISO Latin-1) buffer into TeX sequences.
-If German TeX is used, German TeX sequences are generated."
-  (if (or (equal major-mode 'latex-mode)
-	  (equal major-mode 'LaTeX-mode)) ; AucTeX wants this
-      (if (iso-german-tex-p)
-	  (iso-iso2gtex)
-	(iso-iso2tex)))
-  (if (or (equal major-mode 'tex-mode)
-	  (equal major-mode 'TeX-mode) ; AucTeX wants this
-	  (equal major-mode 'plain-tex-mode))
-      (iso-iso2tex)))
-
-(defun iso-fix-tex2iso ()
-  "Turn TeX sequences into ISO 8859-1 (aka. ISO Latin-1) characters.
-This function recognizes German TeX buffers."
-  (if (or (equal major-mode 'latex-mode)
-	  (equal major-mode 'Latex-mode)) ; AucTeX wants this
-      (if (iso-german-tex-p)
-	  (iso-gtex2iso)
-	(iso-tex2iso)))
-  (if (or (equal major-mode 'tex-mode)
-	  (equal major-mode 'TeX-mode)  ; AucTeX wants this
-	  (equal major-mode 'plain-tex-mode))
-      (iso-tex2iso)))
-
-(defun iso-cvt-ffh ()
-  "find-file-hook for iso-cvt.el."
-  (iso-fix-tex2iso)
-  (set-buffer-modified-p nil))
-
-(defun iso-cvt-wfh ()
-  "write file hook for iso-cvt.el."
-  (iso-fix-iso2tex))
-
-(defun iso-cvt-ash ()
-  "after save hook for iso-cvt.el."
-  (iso-fix-tex2iso)
-  (set-buffer-modified-p nil))
-
-(add-hook 'find-file-hooks 'iso-cvt-ffh)
-(add-hook 'write-file-hooks 'iso-cvt-wfh)
-(add-hook 'after-save-hook 'iso-cvt-ash)
-
-;;; iso-cvt.el ends here
diff --git a/xemacs-packages/lisp/text-modes/iso-insert.el b/xemacs-packages/lisp/text-modes/iso-insert.el
deleted file mode 100644
index 472ee7d0..00000000
--- a/xemacs-packages/lisp/text-modes/iso-insert.el
+++ /dev/null
@@ -1,634 +0,0 @@
-;;; iso-insert.el --- insert functions for ISO 8859/1.
-
-;; Copyright (C) 1987, 1994 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; Written by Howard Gayle.  See case-table.el for details.
-
-;;; #### I think there may be some functionality overlap between this file
-;;; and x-compose.el.  Should think about integrating.
-
-;;; Code:
-
-(defun insert-no-break-space ()
-   (interactive "*")
-   (insert 160)
-)
-
-(defun insert-inverted-exclamation-mark ()
-   (interactive "*")
-   (insert 161)
-)
-
-(defun insert-cent-sign ()
-   (interactive "*")
-   (insert 162)
-)
-
-(defun insert-pound-sign ()
-   (interactive "*")
-   (insert 163)
-)
-
-(defun insert-general-currency-sign ()
-   (interactive "*")
-   (insert 164)
-)
-
-(defun insert-yen-sign ()
-   (interactive "*")
-   (insert 165)
-)
-
-(defun insert-broken-vertical-line ()
-   (interactive "*")
-   (insert 166)
-)
-
-(defun insert-section-sign ()
-   (interactive "*")
-   (insert 167)
-)
-
-(defun insert-diaeresis ()
-   (interactive "*")
-   (insert 168)
-)
-
-(defun insert-copyright-sign ()
-   (interactive "*")
-   (insert 169)
-)
-
-(defun insert-ordinal-indicator-feminine ()
-   (interactive "*")
-   (insert 170)
-)
-
-(defun insert-angle-quotation-mark-left ()
-   (interactive "*")
-   (insert 171)
-)
-
-(defun insert-not-sign ()
-   (interactive "*")
-   (insert 172)
-)
-
-(defun insert-soft-hyphen ()
-   (interactive "*")
-   (insert 173)
-)
-
-(defun insert-registered-sign ()
-   (interactive "*")
-   (insert 174)
-)
-
-(defun insert-macron ()
-   (interactive "*")
-   (insert 175)
-)
-
-(defun insert-degree-sign ()
-   (interactive "*")
-   (insert 176)
-)
-
-(defun insert-plus-or-minus-sign ()
-   (interactive "*")
-   (insert 177)
-)
-
-(defun insert-superscript-two ()
-   (interactive "*")
-   (insert 178)
-)
-
-(defun insert-superscript-three ()
-   (interactive "*")
-   (insert 179)
-)
-
-(defun insert-acute-accent ()
-   (interactive "*")
-   (insert 180)
-)
-
-(defun insert-micro-sign ()
-   (interactive "*")
-   (insert 181)
-)
-
-(defun insert-pilcrow ()
-   (interactive "*")
-   (insert 182)
-)
-
-(defun insert-middle-dot ()
-   (interactive "*")
-   (insert 183)
-)
-
-(defun insert-cedilla ()
-   (interactive "*")
-   (insert 184)
-)
-
-(defun insert-superscript-one ()
-   (interactive "*")
-   (insert 185)
-)
-
-(defun insert-ordinal-indicator-masculine ()
-   (interactive "*")
-   (insert 186)
-)
-
-(defun insert-angle-quotation-mark-right ()
-   (interactive "*")
-   (insert 187)
-)
-
-(defun insert-fraction-one-quarter ()
-   (interactive "*")
-   (insert 188)
-)
-
-(defun insert-fraction-one-half ()
-   (interactive "*")
-   (insert 189)
-)
-
-(defun insert-fraction-three-quarters ()
-   (interactive "*")
-   (insert 190)
-)
-
-(defun insert-inverted-question-mark ()
-   (interactive "*")
-   (insert 191)
-)
-
-(defun insert-A-grave ()
-   (interactive "*")
-   (insert 192)
-)
-
-(defun insert-A-acute ()
-   (interactive "*")
-   (insert 193)
-)
-
-(defun insert-A-circumflex ()
-   (interactive "*")
-   (insert 194)
-)
-
-(defun insert-A-tilde ()
-   (interactive "*")
-   (insert 195)
-)
-
-(defun insert-A-umlaut ()
-   (interactive "*")
-   (insert 196)
-)
-
-(defun insert-A-ring ()
-   (interactive "*")
-   (insert 197)
-)
-
-(defun insert-AE ()
-   (interactive "*")
-   (insert 198)
-)
-
-(defun insert-C-cedilla ()
-   (interactive "*")
-   (insert 199)
-)
-
-(defun insert-E-grave ()
-   (interactive "*")
-   (insert 200)
-)
-
-(defun insert-E-acute ()
-   (interactive "*")
-   (insert 201)
-)
-
-(defun insert-E-circumflex ()
-   (interactive "*")
-   (insert 202)
-)
-
-(defun insert-E-umlaut ()
-   (interactive "*")
-   (insert 203)
-)
-
-(defun insert-I-grave ()
-   (interactive "*")
-   (insert 204)
-)
-
-(defun insert-I-acute ()
-   (interactive "*")
-   (insert 205)
-)
-
-(defun insert-I-circumflex ()
-   (interactive "*")
-   (insert 206)
-)
-
-(defun insert-I-umlaut ()
-   (interactive "*")
-   (insert 207)
-)
-
-(defun insert-D-stroke ()
-   (interactive "*")
-   (insert 208)
-)
-
-(defun insert-N-tilde ()
-   (interactive "*")
-   (insert 209)
-)
-
-(defun insert-O-grave ()
-   (interactive "*")
-   (insert 210)
-)
-
-(defun insert-O-acute ()
-   (interactive "*")
-   (insert 211)
-)
-
-(defun insert-O-circumflex ()
-   (interactive "*")
-   (insert 212)
-)
-
-(defun insert-O-tilde ()
-   (interactive "*")
-   (insert 213)
-)
-
-(defun insert-O-umlaut ()
-   (interactive "*")
-   (insert 214)
-)
-
-(defun insert-multiplication-sign ()
-   (interactive "*")
-   (insert 215)
-)
-
-(defun insert-O-slash ()
-   (interactive "*")
-   (insert 216)
-)
-
-(defun insert-U-grave ()
-   (interactive "*")
-   (insert 217)
-)
-
-(defun insert-U-acute ()
-   (interactive "*")
-   (insert 218)
-)
-
-(defun insert-U-circumflex ()
-   (interactive "*")
-   (insert 219)
-)
-
-(defun insert-U-umlaut ()
-   (interactive "*")
-   (insert 220)
-)
-
-(defun insert-Y-acute ()
-   (interactive "*")
-   (insert 221)
-)
-
-(defun insert-THORN ()
-   (interactive "*")
-   (insert 222)
-)
-
-(defun insert-ss ()
-   (interactive "*")
-   (insert 223)
-)
-
-(defun insert-a-grave ()
-   (interactive "*")
-   (insert 224)
-)
-
-(defun insert-a-acute ()
-   (interactive "*")
-   (insert 225)
-)
-
-(defun insert-a-circumflex ()
-   (interactive "*")
-   (insert 226)
-)
-
-(defun insert-a-tilde ()
-   (interactive "*")
-   (insert 227)
-)
-
-(defun insert-a-umlaut ()
-   (interactive "*")
-   (insert 228)
-)
-
-(defun insert-a-ring ()
-   (interactive "*")
-   (insert 229)
-)
-
-(defun insert-ae ()
-   (interactive "*")
-   (insert 230)
-)
-
-(defun insert-c-cedilla ()
-   (interactive "*")
-   (insert 231)
-)
-
-(defun insert-e-grave ()
-   (interactive "*")
-   (insert 232)
-)
-
-(defun insert-e-acute ()
-   (interactive "*")
-   (insert 233)
-)
-
-(defun insert-e-circumflex ()
-   (interactive "*")
-   (insert 234)
-)
-
-(defun insert-e-umlaut ()
-   (interactive "*")
-   (insert 235)
-)
-
-(defun insert-i-grave ()
-   (interactive "*")
-   (insert 236)
-)
-
-(defun insert-i-acute ()
-   (interactive "*")
-   (insert 237)
-)
-
-(defun insert-i-circumflex ()
-   (interactive "*")
-   (insert 238)
-)
-
-(defun insert-i-umlaut ()
-   (interactive "*")
-   (insert 239)
-)
-
-(defun insert-d-stroke ()
-   (interactive "*")
-   (insert 240)
-)
-
-(defun insert-n-tilde ()
-   (interactive "*")
-   (insert 241)
-)
-
-(defun insert-o-grave ()
-   (interactive "*")
-   (insert 242)
-)
-
-(defun insert-o-acute ()
-   (interactive "*")
-   (insert 243)
-)
-
-(defun insert-o-circumflex ()
-   (interactive "*")
-   (insert 244)
-)
-
-(defun insert-o-tilde ()
-   (interactive "*")
-   (insert 245)
-)
-
-(defun insert-o-umlaut ()
-   (interactive "*")
-   (insert 246)
-)
-
-(defun insert-division-sign ()
-   (interactive "*")
-   (insert 247)
-)
-
-(defun insert-o-slash ()
-   (interactive "*")
-   (insert 248)
-)
-
-(defun insert-u-grave ()
-   (interactive "*")
-   (insert 249)
-)
-
-(defun insert-u-acute ()
-   (interactive "*")
-   (insert 250)
-)
-
-(defun insert-u-circumflex ()
-   (interactive "*")
-   (insert 251)
-)
-
-(defun insert-u-umlaut ()
-   (interactive "*")
-   (insert 252)
-)
-
-(defun insert-y-acute ()
-   (interactive "*")
-   (insert 253)
-)
-
-(defun insert-thorn ()
-   (interactive "*")
-   (insert 254)
-)
-
-(defun insert-y-umlaut ()
-   (interactive "*")
-   (insert 255)
-)
-
-(defvar 8859-1-map nil "Keymap for ISO 8859/1 character insertion.")
-(if 8859-1-map nil
-   (setq 8859-1-map (make-keymap))
-   (define-key 8859-1-map " "    'insert-no-break-space)
-   (define-key 8859-1-map "!"    'insert-inverted-exclamation-mark)
-   (define-key 8859-1-map "\""   (make-sparse-keymap))
-   (define-key 8859-1-map "\"\"" 'insert-diaeresis)
-   (define-key 8859-1-map "\"A"  'insert-A-umlaut)
-   (define-key 8859-1-map "\"E"  'insert-E-umlaut)
-   (define-key 8859-1-map "\"I"  'insert-I-umlaut)
-   (define-key 8859-1-map "\"O"  'insert-O-umlaut)
-   (define-key 8859-1-map "\"U"  'insert-U-umlaut)
-   (define-key 8859-1-map "\"a"  'insert-a-umlaut)
-   (define-key 8859-1-map "\"e"  'insert-e-umlaut)
-   (define-key 8859-1-map "\"i"  'insert-i-umlaut)
-   (define-key 8859-1-map "\"o"  'insert-o-umlaut)
-   (define-key 8859-1-map "\"u"  'insert-u-umlaut)
-   (define-key 8859-1-map "\"y"  'insert-y-umlaut)
-   (define-key 8859-1-map "'"    (make-sparse-keymap))
-   (define-key 8859-1-map "''"   'insert-acute-accent)
-   (define-key 8859-1-map "'A"   'insert-A-acute)
-   (define-key 8859-1-map "'E"   'insert-E-acute)
-   (define-key 8859-1-map "'I"   'insert-I-acute)
-   (define-key 8859-1-map "'O"   'insert-O-acute)
-   (define-key 8859-1-map "'U"   'insert-U-acute)
-   (define-key 8859-1-map "'Y"   'insert-Y-acute)
-   (define-key 8859-1-map "'a"   'insert-a-acute)
-   (define-key 8859-1-map "'e"   'insert-e-acute)
-   (define-key 8859-1-map "'i"   'insert-i-acute)
-   (define-key 8859-1-map "'o"   'insert-o-acute)
-   (define-key 8859-1-map "'u"   'insert-u-acute)
-   (define-key 8859-1-map "'y"   'insert-y-acute)
-   (define-key 8859-1-map "$"    'insert-general-currency-sign)
-   (define-key 8859-1-map "+"    'insert-plus-or-minus-sign)
-   (define-key 8859-1-map ","    (make-sparse-keymap))
-   (define-key 8859-1-map ",,"   'insert-cedilla)
-   (define-key 8859-1-map ",C"   'insert-C-cedilla)
-   (define-key 8859-1-map ",c"   'insert-c-cedilla)
-   (define-key 8859-1-map "-"    'insert-soft-hyphen)
-   (define-key 8859-1-map "."    'insert-middle-dot)
-   (define-key 8859-1-map "/"    (make-sparse-keymap))
-   (define-key 8859-1-map "//"   'insert-division-sign)
-   (define-key 8859-1-map "/O"   'insert-O-slash)
-   (define-key 8859-1-map "/o"   'insert-o-slash)
-   (define-key 8859-1-map "1"    (make-sparse-keymap))
-   (define-key 8859-1-map "1/"   (make-sparse-keymap))
-   (define-key 8859-1-map "1/2"  'insert-fraction-one-half)
-   (define-key 8859-1-map "1/4"  'insert-fraction-one-quarter)
-   (define-key 8859-1-map "3"    (make-sparse-keymap))
-   (define-key 8859-1-map "3/"   (make-sparse-keymap))
-   (define-key 8859-1-map "3/4"  'insert-fraction-three-quarters)
-   (define-key 8859-1-map "<"    'insert-angle-quotation-mark-left)
-   (define-key 8859-1-map "="    'insert-macron)
-   (define-key 8859-1-map ">"    'insert-angle-quotation-mark-right)
-   (define-key 8859-1-map "?"    'insert-inverted-question-mark)
-   (define-key 8859-1-map "A"    'insert-A-ring)
-   (define-key 8859-1-map "E"    'insert-AE)
-   (define-key 8859-1-map "C"    'insert-copyright-sign)
-   (define-key 8859-1-map "D"    'insert-D-stroke)
-   (define-key 8859-1-map "L"    'insert-pound-sign)
-   (define-key 8859-1-map "P"    'insert-pilcrow)
-   (define-key 8859-1-map "R"    'insert-registered-sign)
-   (define-key 8859-1-map "S"    'insert-section-sign)
-   (define-key 8859-1-map "T"    'insert-THORN)
-   (define-key 8859-1-map "Y"    'insert-yen-sign)
-   (define-key 8859-1-map "^"    (make-sparse-keymap))
-   (define-key 8859-1-map "^1"   'insert-superscript-one)
-   (define-key 8859-1-map "^2"   'insert-superscript-two)
-   (define-key 8859-1-map "^3"   'insert-superscript-three)
-   (define-key 8859-1-map "^A"   'insert-A-circumflex)
-   (define-key 8859-1-map "^E"   'insert-E-circumflex)
-   (define-key 8859-1-map "^I"   'insert-I-circumflex)
-   (define-key 8859-1-map "^O"   'insert-O-circumflex)
-   (define-key 8859-1-map "^U"   'insert-U-circumflex)
-   (define-key 8859-1-map "^a"   'insert-a-circumflex)
-   (define-key 8859-1-map "^e"   'insert-e-circumflex)
-   (define-key 8859-1-map "^i"   'insert-i-circumflex)
-   (define-key 8859-1-map "^o"   'insert-o-circumflex)
-   (define-key 8859-1-map "^u"   'insert-u-circumflex)
-   (define-key 8859-1-map "_"    (make-sparse-keymap))
-   (define-key 8859-1-map "_a"   'insert-ordinal-indicator-feminine)
-   (define-key 8859-1-map "_o"   'insert-ordinal-indicator-masculine)
-   (define-key 8859-1-map "`"    (make-sparse-keymap))
-   (define-key 8859-1-map "`A"   'insert-A-grave)
-   (define-key 8859-1-map "`E"   'insert-E-grave)
-   (define-key 8859-1-map "`I"   'insert-I-grave)
-   (define-key 8859-1-map "`O"   'insert-O-grave)
-   (define-key 8859-1-map "`U"   'insert-U-grave)
-   (define-key 8859-1-map "`a"   'insert-a-grave)
-   (define-key 8859-1-map "`e"   'insert-e-grave)
-   (define-key 8859-1-map "`i"   'insert-i-grave)
-   (define-key 8859-1-map "`o"   'insert-o-grave)
-   (define-key 8859-1-map "`u"   'insert-u-grave)
-   (define-key 8859-1-map "a"    'insert-a-ring)
-   (define-key 8859-1-map "e"    'insert-ae)
-   (define-key 8859-1-map "c"    'insert-cent-sign)
-   (define-key 8859-1-map "d"    'insert-d-stroke)
-   (define-key 8859-1-map "o"    'insert-degree-sign)
-   (define-key 8859-1-map "s"    'insert-ss)
-   (define-key 8859-1-map "t"    'insert-thorn)
-   (define-key 8859-1-map "u"    'insert-micro-sign)
-   (define-key 8859-1-map "x"    'insert-multiplication-sign)
-   (define-key 8859-1-map "|"    'insert-broken-vertical-line)
-   (define-key 8859-1-map "~"    (make-sparse-keymap))
-   (define-key 8859-1-map "~A"   'insert-A-tilde)
-   (define-key 8859-1-map "~N"   'insert-N-tilde)
-   (define-key 8859-1-map "~O"   'insert-O-tilde)
-   (define-key 8859-1-map "~a"   'insert-a-tilde)
-   (define-key 8859-1-map "~n"   'insert-n-tilde)
-   (define-key 8859-1-map "~o"   'insert-o-tilde)
-   (define-key 8859-1-map "~~"   'insert-not-sign)
-   (if (not (lookup-key global-map "\C-x8"))
-      (define-key global-map "\C-x8" 8859-1-map))
-)
-
-(provide 'iso-insert)
-
-;;; iso-insert.el ends here
diff --git a/xemacs-packages/lisp/text-modes/iso-swed.el b/xemacs-packages/lisp/text-modes/iso-swed.el
deleted file mode 100644
index b068bbd4..00000000
--- a/xemacs-packages/lisp/text-modes/iso-swed.el
+++ /dev/null
@@ -1,153 +0,0 @@
-;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; Written by Howard Gayle.  See case-table.el for details.
-
-;;; Code:
-
-;; This code sets up to display ISO 8859/1 characters on
-;; terminals that have ASCII in the G0 set and a Swedish/Finnish
-;; version of ISO 646 in the G1 set.  The G1 set differs from
-;; ASCII as follows:
-;; 
-;; ASCII G1
-;;     $ general currency sign
-;;     @ capital E with acute accent
-;;     [ capital A with diaeresis or umlaut mark
-;;     \ capital O with diaeresis or umlaut mark
-;;     ] capital A with ring
-;;     ^ capital U with diaeresis or umlaut mark
-;;     ` small e with acute accent
-;;     { small a with diaeresis or umlaut mark
-;;     | small o with diaeresis or umlaut mark
-;;     } small a with ring
-;;     ~ small u with diaeresis or umlaut mark
-
-(require 'disp-table)
-
-(standard-display-ascii 160 "{_}")   ; NBSP (no-break space)
-(standard-display-ascii 161 "{!}")   ; inverted exclamation mark
-(standard-display-ascii 162 "{c}")   ; cent sign
-(standard-display-ascii 163 "{GBP}") ; pound sign
-(standard-display-g1    164 ?$)      ; general currency sign
-(standard-display-ascii 165 "{JPY}") ; yen sign
-(standard-display-ascii 166 "{|}")   ; broken vertical line
-(standard-display-ascii 167 "{S}")   ; section sign
-(standard-display-ascii 168 "{\"}")  ; diaeresis
-(standard-display-ascii 169 "{C}")   ; copyright sign
-(standard-display-ascii 170 "{_a}")  ; ordinal indicator, feminine
-(standard-display-ascii 171 "{<<}")  ; left angle quotation mark
-(standard-display-ascii 172 "{~}")   ; not sign
-(standard-display-ascii 173 "{-}")   ; soft hyphen
-(standard-display-ascii 174 "{R}")   ; registered sign
-(standard-display-ascii 175 "{=}")   ; macron
-(standard-display-ascii 176 "{o}")   ; degree sign
-(standard-display-ascii 177 "{+-}")  ; plus or minus sign
-(standard-display-ascii 178 "{2}")   ; superscript two
-(standard-display-ascii 179 "{3}")   ; superscript three
-(standard-display-ascii 180 "{'}")   ; acute accent
-(standard-display-ascii 181 "{u}")   ; micro sign
-(standard-display-ascii 182 "{P}")   ; pilcrow
-(standard-display-ascii 183 "{.}")   ; middle dot
-(standard-display-ascii 184 "{,}")   ; cedilla
-(standard-display-ascii 185 "{1}")   ; superscript one
-(standard-display-ascii 186 "{_o}")  ; ordinal indicator, masculine
-(standard-display-ascii 187 "{>>}")  ; right angle quotation mark
-(standard-display-ascii 188 "{1/4}") ; fraction one-quarter
-(standard-display-ascii 189 "{1/2}") ; fraction one-half
-(standard-display-ascii 190 "{3/4}") ; fraction three-quarters
-(standard-display-ascii 191 "{?}")   ; inverted question mark
-(standard-display-ascii 192 "{`A}")  ; A with grave accent
-(standard-display-ascii 193 "{'A}")  ; A with acute accent
-(standard-display-ascii 194 "{^A}")  ; A with circumflex accent
-(standard-display-ascii 195 "{~A}")  ; A with tilde
-(standard-display-g1    196 ?[)      ; A with diaeresis or umlaut mark
-(standard-display-g1    197 ?])      ; A with ring
-(standard-display-ascii 198 "{AE}")  ; AE diphthong
-(standard-display-ascii 199 "{,C}")  ; C with cedilla
-(standard-display-ascii 200 "{`E}")  ; E with grave accent
-(standard-display-g1    201 ?@)      ; E with acute accent
-(standard-display-ascii 202 "{^E}")  ; E with circumflex accent
-(standard-display-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark
-(standard-display-ascii 204 "{`I}")  ; I with grave accent
-(standard-display-ascii 205 "{'I}")  ; I with acute accent
-(standard-display-ascii 206 "{^I}")  ; I with circumflex accent
-(standard-display-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark
-(standard-display-ascii 208 "{-D}")  ; D with stroke, Icelandic eth
-(standard-display-ascii 209 "{~N}")  ; N with tilde
-(standard-display-ascii 210 "{`O}")  ; O with grave accent
-(standard-display-ascii 211 "{'O}")  ; O with acute accent
-(standard-display-ascii 212 "{^O}")  ; O with circumflex accent
-(standard-display-ascii 213 "{~O}")  ; O with tilde
-(standard-display-g1    214 ?\\)     ; O with diaeresis or umlaut mark
-(standard-display-ascii 215 "{x}")   ; multiplication sign
-(standard-display-ascii 216 "{/O}")  ; O with slash
-(standard-display-ascii 217 "{`U}")  ; U with grave accent
-(standard-display-ascii 218 "{'U}")  ; U with acute accent
-(standard-display-ascii 219 "{^U}")  ; U with circumflex accent
-(standard-display-g1    220 ?^)      ; U with diaeresis or umlaut mark
-(standard-display-ascii 221 "{'Y}")  ; Y with acute accent
-(standard-display-ascii 222 "{TH}")  ; capital thorn, Icelandic
-(standard-display-ascii 223 "{ss}")  ; small sharp s, German
-(standard-display-ascii 224 "{`a}")  ; a with grave accent
-(standard-display-ascii 225 "{'a}")  ; a with acute accent
-(standard-display-ascii 226 "{^a}")  ; a with circumflex accent
-(standard-display-ascii 227 "{~a}")  ; a with tilde
-(standard-display-g1    228 ?{)      ; a with diaeresis or umlaut mark
-(standard-display-g1    229 ?})      ; a with ring
-(standard-display-ascii 230 "{ae}")  ; ae diphthong
-(standard-display-ascii 231 "{,c}")  ; c with cedilla
-(standard-display-ascii 232 "{`e}")  ; e with grave accent
-(standard-display-g1    233 ?`)      ; e with acute accent
-(standard-display-ascii 234 "{^e}")  ; e with circumflex accent
-(standard-display-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark
-(standard-display-ascii 236 "{`i}")  ; i with grave accent
-(standard-display-ascii 237 "{'i}")  ; i with acute accent
-(standard-display-ascii 238 "{^i}")  ; i with circumflex accent
-(standard-display-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark
-(standard-display-ascii 240 "{-d}")  ; d with stroke, Icelandic eth
-(standard-display-ascii 241 "{~n}")  ; n with tilde
-(standard-display-ascii 242 "{`o}")  ; o with grave accent
-(standard-display-ascii 243 "{'o}")  ; o with acute accent
-(standard-display-ascii 244 "{^o}")  ; o with circumflex accent
-(standard-display-ascii 245 "{~o}")  ; o with tilde
-(standard-display-g1    246 ?|)      ; o with diaeresis or umlaut mark
-(standard-display-ascii 247 "{/}")   ; division sign
-(standard-display-ascii 248 "{/o}")  ; o with slash
-(standard-display-ascii 249 "{`u}")  ; u with grave accent
-(standard-display-ascii 250 "{'u}")  ; u with acute accent
-(standard-display-ascii 251 "{^u}")  ; u with circumflex accent
-(standard-display-g1    252 ?~)      ; u with diaeresis or umlaut mark
-(standard-display-ascii 253 "{'y}")  ; y with acute accent
-(standard-display-ascii 254 "{th}")  ; small thorn, Icelandic
-(standard-display-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark
-
-(provide 'iso-swed)
-
-;;; iso-swed.el ends here
diff --git a/xemacs-packages/lisp/text-modes/nroff-mode.el b/xemacs-packages/lisp/text-modes/nroff-mode.el
deleted file mode 100644
index 2006432e..00000000
--- a/xemacs-packages/lisp/text-modes/nroff-mode.el
+++ /dev/null
@@ -1,289 +0,0 @@
-;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
-
-;; Copyright (C) 1985, 1986, 1994, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: wp
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This package is a major mode for editing nroff source code.  It knows
-;; about various nroff constructs, ms, mm, and me macros, and will fill
-;; and indent paragraphs properly in their presence.  It also includes
-;; a command to count text lines (excluding nroff constructs), a command
-;; to center a line, and movement commands that know how to skip macros.
-
-;; Paragraph filling and line-counting currently don't respect comments,
-;; as they should.
-
-;;; Code:
-
-(defvar nroff-mode-abbrev-table nil
-  "Abbrev table used while in nroff mode.")
-(define-abbrev-table 'nroff-mode-abbrev-table ())
-
-(defvar nroff-mode-map nil
-     "Major mode keymap for nroff mode.")
-(if (not nroff-mode-map)
-    (progn
-      (setq nroff-mode-map (make-sparse-keymap))
-      (define-key nroff-mode-map "\t"  'tab-to-tab-stop)
-      (define-key nroff-mode-map "\es" 'center-line)
-      (define-key nroff-mode-map "\e?" 'count-text-lines)
-      (define-key nroff-mode-map "\n"  'electric-nroff-newline)
-      (define-key nroff-mode-map "\en" 'forward-text-line)
-      (define-key nroff-mode-map "\ep" 'backward-text-line)))
-
-(defvar nroff-mode-syntax-table nil
-  "Syntax table used while in nroff mode.")
-
-(defvar nroff-font-lock-keywords
-  (list
-   ;; Directives are . or ' at start of line, followed by
-   ;; optional whitespace, then command (which my be longer than
-   ;; 2 characters in groff).  Perhaps the arguments should be
-   ;; fontified as well.
-   "^[.']\\s-*\\sw+"
-   ;; There are numerous groff escapes; the following get things
-   ;; like \-, \(em (standard troff) and \f[bar] (groff
-   ;; variants).  This won't currently do groff's \A'foo' and
-   ;; the like properly.  One might expect it to highlight an escape's
-   ;; arguments in common cases, like \f.
-   (concat "\\\\"			; backslash
-	   "\\("			; followed by various possibilities
-         (mapconcat 'identity
-                    '("[f*n]*\\[.+]"	; some groff extensions
-                      "(.."		; two chars after (
-                      "[^(\"]"		; single char escape
-                      ) "\\|")
-         "\\)")
-   )
-  "Font-lock highlighting control in nroff-mode.")
-
-;;;###autoload
-(defun nroff-mode ()
-  "Major mode for editing text intended for nroff to format.
-\\{nroff-mode-map}
-Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'.
-Also, try `nroff-electric-mode', for automatically inserting
-closing requests for requests that are used in matched pairs."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map nroff-mode-map)
-  (setq mode-name "Nroff")
-  (setq major-mode 'nroff-mode)
-  (if nroff-mode-syntax-table
-      ()
-    (setq nroff-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
-    ;; " isn't given string quote syntax in text-mode but it
-    ;; (arguably) should be for use round nroff arguments (with ` and
-    ;; ' used otherwise).
-    (modify-syntax-entry ?\" "\"  2" nroff-mode-syntax-table)
-    ;; Comments are delimited by \" and newline.
-    (modify-syntax-entry ?\\ "\\  1" nroff-mode-syntax-table)
-    (modify-syntax-entry ?\n ">  1" nroff-mode-syntax-table))
-  (set-syntax-table nroff-mode-syntax-table)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(nroff-font-lock-keywords nil t))
-  (setq local-abbrev-table nroff-mode-abbrev-table)
-  (make-local-variable 'nroff-electric-mode)
-  (setq nroff-electric-mode nil)
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp "\\.H[ ]+[1-7]+ ")
-  (make-local-variable 'outline-level)
-  (setq outline-level 'nroff-outline-level)
-  ;; now define a bunch of variables for use by commands in this mode
-  (make-local-variable 'page-delimiter)
-  (setq page-delimiter "^\\.\\(bp\\|SK\\|OP\\)")
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "[.']\\|" paragraph-start))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate (concat "[.']\\|" paragraph-separate))
-  ;; comment syntax added by mit-erl!gildea 18 Apr 86
-  (make-local-variable 'comment-start)
-  (setq comment-start "\\\" ")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "\\\\\"[ \t]*")
-  (make-local-variable 'comment-column)
-  (setq comment-column 24)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'nroff-comment-indent)
-  (run-hooks 'text-mode-hook 'nroff-mode-hook))
-
-(defun nroff-outline-level ()
-  (save-excursion
-    (looking-at outline-regexp)
-    (skip-chars-forward ".H ")
-    (string-to-int (buffer-substring (point) (+ 1 (point))))))
-
-;;; Compute how much to indent a comment in nroff/troff source.
-;;; By mit-erl!gildea April 86
-(defun nroff-comment-indent ()
-  "Compute indent for an nroff/troff comment.
-Puts a full-stop before comments on a line by themselves."
-  (let ((pt (point)))
-    (unwind-protect
-	(progn
-	  (skip-chars-backward " \t")
-	  (if (bolp)
-	      (progn
-		(setq pt (1+ pt))
-		(insert ?.)
-		1)
-	    (if (save-excursion
-		  (backward-char 1)
-		  (looking-at "^[.']"))
-		1
-	      (max comment-column
-		   (* 8 (/ (+ (current-column)
-			      9) 8)))))) ; add 9 to ensure at least two blanks
-      (goto-char pt))))
-
-(defun count-text-lines (start end &optional print)
-  "Count lines in region, except for nroff request lines.
-All lines not starting with a period are counted up.
-Interactively, print result in echo area.
-Noninteractively, return number of non-request lines from START to END."
-  (interactive "r\np")
-  (if print
-      (message "Region has %d text lines" (count-text-lines start end))
-    (save-excursion
-      (save-restriction
-	(narrow-to-region start end)
-	(goto-char (point-min))
-	(- (buffer-size) (forward-text-line (buffer-size)))))))
-
-(defun forward-text-line (&optional cnt)
-  "Go forward one nroff text line, skipping lines of nroff requests.
-An argument is a repeat count; if negative, move backward."
-  (interactive "p")
-  (if (not cnt) (setq cnt 1))
-  (while (and (> cnt 0) (not (eobp)))
-    (forward-line 1)
-    (while (and (not (eobp)) (looking-at "[.']."))
-      (forward-line 1))
-    (setq cnt (- cnt 1)))
-  (while (and (< cnt 0) (not (bobp)))
-    (forward-line -1)
-    (while (and (not (bobp))
-		(looking-at "[.']."))
-      (forward-line -1))
-    (setq cnt (+ cnt 1)))
-  cnt)
-
-(defun backward-text-line (&optional cnt)
-  "Go backward one nroff text line, skipping lines of nroff requests.
-An argument is a repeat count; negative means move forward."
-  (interactive "p")
-  (forward-text-line (- cnt)))
-
-(defconst nroff-brace-table
-  '((".(b" . ".)b")
-    (".(l" . ".)l")
-    (".(q" . ".)q")
-    (".(c" . ".)c")
-    (".(x" . ".)x")
-    (".(z" . ".)z")
-    (".(d" . ".)d")
-    (".(f" . ".)f")
-    (".LG" . ".NL")
-    (".SM" . ".NL")
-    (".LD" . ".DE")
-    (".CD" . ".DE")
-    (".BD" . ".DE")
-    (".DS" . ".DE")
-    (".DF" . ".DE")
-    (".FS" . ".FE")
-    (".KS" . ".KE")
-    (".KF" . ".KE")
-    (".LB" . ".LE")
-    (".AL" . ".LE")
-    (".BL" . ".LE")
-    (".DL" . ".LE")
-    (".ML" . ".LE")
-    (".RL" . ".LE")
-    (".VL" . ".LE")
-    (".RS" . ".RE")
-    (".TS" . ".TE")
-    (".EQ" . ".EN")
-    (".PS" . ".PE")
-    (".BS" . ".BE")
-    (".G1" . ".G2")			; grap
-    (".na" . ".ad b")
-    (".nf" . ".fi")
-    (".de" . "..")))
-
-(defun electric-nroff-newline (arg)
-  "Insert newline for nroff mode; special if electric-nroff mode.
-In `electric-nroff-mode', if ending a line containing an nroff opening request,
-automatically inserts the matching closing request after point."
-  (interactive "P")
-  (let ((completion (save-excursion
-		      (beginning-of-line)
-		      (and (null arg)
-			   nroff-electric-mode
-			   (<= (point) (- (point-max) 3))
-			   (cdr (assoc (buffer-substring (point)
-							 (+ 3 (point)))
-				       nroff-brace-table)))))
-	(needs-nl (not (looking-at "[ \t]*$"))))
-    (if (null completion)
-	(newline (prefix-numeric-value arg))
-      (save-excursion
-	(insert "\n\n" completion)
-	(if needs-nl (insert "\n")))
-      (forward-char 1))))
-
-;;;###autoload
-(defun electric-nroff-mode (&optional arg)
-  "Toggle `nroff-electric-newline' minor mode.
-`nroff-electric-newline' forces Emacs to check for an nroff request at the
-beginning of the line, and insert the matching closing request if necessary.
-This command toggles that mode (off->on, on->off), with an argument,
-turns it on iff arg is positive, otherwise off."
-  (interactive "P")
-  (or (eq major-mode 'nroff-mode) (error "Must be in nroff mode"))
-  ;; XEmacs: see below.
-;  (or (assq 'nroff-electric-mode minor-mode-alist)
-;      (setq minor-mode-alist (append minor-mode-alist
-;				     (list '(nroff-electric-mode
-;					     " Electric")))))
-  (setq nroff-electric-mode
-	(cond ((null arg) (null nroff-electric-mode))
-	      (t (> (prefix-numeric-value arg) 0)))))
-
-;;;###autoload
-(defvar nroff-electric-mode nil
-  "Non-nil if in electric-nroff minor mode.")
-;; XEmacs: do it right.  This must come after the defun of
-;; electric-nroff-mode so that add-minor-mode will recognize it as a
-;; command.
-;; perverse variable name.
-;;;###autoload
-(add-minor-mode 'nroff-electric-mode " Electric" nil nil 'electric-nroff-mode)
-
-;; XEmacs additions
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode))
-;; Need to append this so it won't screw eg. ChangeLog.1 and .scm.[0-9]...
-;;;###autoload(setq auto-mode-alist (append auto-mode-alist '(("\\.[123456789]\\'" . nroff-mode))))
-
-;;; nroff-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/po-compat.el b/xemacs-packages/lisp/text-modes/po-compat.el
deleted file mode 100644
index e5dde5cf..00000000
--- a/xemacs-packages/lisp/text-modes/po-compat.el
+++ /dev/null
@@ -1,263 +0,0 @@
-;;; po-compat.el --- basic support of PO translation files -*- coding: latin-1; -*-
-
-;; Copyright (C) 1995-1999, 2000-2002 Free Software Foundation, Inc.
-
-;; Authors: François Pinard ,
-;;          Greg McGary ,
-;;          Bruno Haible .
-;; Keywords: i18n, files
-
-;; This file is part of GNU gettext.
-
-;; GNU gettext 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 gettext 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:
-
-;; Emacs 21.2 and newer already contain this file, under the name po.el,
-;; and without portability hassles.
-
-;; This package makes sure visiting PO files decodes them correctly,
-;; according to the Charset= header in the PO file.  For more support
-;; for editing PO files, see po-mode.el.
-
-;;; Code:
-
-;;; Emacs portability matters.
-
-;; Identify which Emacs variety is being used.
-;; This file supports:
-;;   - XEmacs (version 19 and above) -> po-XEMACS = t,
-;;   - GNU Emacs (version 20 and above) -> po-EMACS20 = t,
-;;   - GNU Emacs (version 19) -> no flag.
-(eval-and-compile
-  (cond ((string-match "XEmacs\\|Lucid" emacs-version)
-	 (setq po-EMACS20 nil po-XEMACS t))
-	((and (string-lessp "19" emacs-version) (featurep 'faces))
-	 (setq po-EMACS20 t po-XEMACS nil))
-	(t (setq po-EMACS20 nil po-XEMACS nil))))
-
-;; Handle missing 'with-temp-buffer' function.
-(eval-and-compile
-  (if (fboundp 'with-temp-buffer)
-      (fset 'po-with-temp-buffer (symbol-function 'with-temp-buffer))
-
-    (defmacro po-with-temp-buffer (&rest forms)
-      "Create a temporary buffer, and evaluate FORMS there like 'progn'."
-      (let ((curr-buffer (make-symbol "curr-buffer"))
-	    (temp-buffer (make-symbol "temp-buffer")))
-	`(let ((,curr-buffer (current-buffer))
-	       (,temp-buffer (get-buffer-create
-			      (generate-new-buffer-name " *po-temp*"))))
-	   (unwind-protect
-	       (progn
-		 (set-buffer ,temp-buffer)
-		 ,@forms)
-	     (set-buffer ,curr-buffer)
-	     (and (buffer-name ,temp-buffer)
-		  (kill-buffer ,temp-buffer))))))))
-
-(defconst po-content-type-charset-alist
-  '(; Note: Emacs 21 doesn't support all encodings, thus the missing entries.
-    ("ASCII" . undecided)
-    ("ANSI_X3.4-1968" . undecided)
-    ("US-ASCII" . undecided)
-    ("ISO-8859-1" . iso-8859-1)
-    ("ISO_8859-1" . iso-8859-1)
-    ("ISO-8859-2" . iso-8859-2)
-    ("ISO_8859-2" . iso-8859-2)
-    ("ISO-8859-3" . iso-8859-3)
-    ("ISO_8859-3" . iso-8859-3)
-    ("ISO-8859-4" . iso-8859-4)
-    ("ISO_8859-4" . iso-8859-4)
-    ("ISO-8859-5" . iso-8859-5)
-    ("ISO_8859-5" . iso-8859-5)
-    ;("ISO-8859-6" . ??)
-    ;("ISO_8859-6" . ??)
-    ("ISO-8859-7" . iso-8859-7)
-    ("ISO_8859-7" . iso-8859-7)
-    ("ISO-8859-8" . iso-8859-8)
-    ("ISO_8859-8" . iso-8859-8)
-    ("ISO-8859-9" . iso-8859-9)
-    ("ISO_8859-9" . iso-8859-9)
-    ;("ISO-8859-13" . ??)
-    ;("ISO_8859-13" . ??)
-    ;("ISO-8859-14" . ??)
-    ;("ISO_8859-14" . ??)
-    ("ISO-8859-15" . iso-8859-15) ; requires Emacs 21
-    ("ISO_8859-15" . iso-8859-15) ; requires Emacs 21
-    ("KOI8-R" . koi8-r)
-    ;("KOI8-U" . ??)
-    ;("KOI8-T" . ??)
-    ("CP437" . cp437) ; requires Emacs 20
-    ("CP775" . cp775) ; requires Emacs 20
-    ("CP850" . cp850) ; requires Emacs 20
-    ("CP852" . cp852) ; requires Emacs 20
-    ("CP855" . cp855) ; requires Emacs 20
-    ;("CP856" . ??)
-    ("CP857" . cp857) ; requires Emacs 20
-    ("CP861" . cp861) ; requires Emacs 20
-    ("CP862" . cp862) ; requires Emacs 20
-    ("CP864" . cp864) ; requires Emacs 20
-    ("CP865" . cp865) ; requires Emacs 20
-    ("CP866" . cp866) ; requires Emacs 21
-    ("CP869" . cp869) ; requires Emacs 20
-    ;("CP874" . ??)
-    ;("CP922" . ??)
-    ;("CP932" . ??)
-    ;("CP943" . ??)
-    ;("CP949" . ??)
-    ;("CP950" . ??)
-    ;("CP1046" . ??)
-    ;("CP1124" . ??)
-    ;("CP1129" . ??)
-    ("CP1250" . cp1250) ; requires Emacs 20
-    ("CP1251" . cp1251) ; requires Emacs 20
-    ("CP1252" . iso-8859-1) ; approximation
-    ("CP1253" . cp1253) ; requires Emacs 20
-    ("CP1254" . iso-8859-9) ; approximation
-    ("CP1255" . iso-8859-8) ; approximation
-    ;("CP1256" . ??)
-    ("CP1257" . cp1257) ; requires Emacs 20
-    ("GB2312" . cn-gb-2312)  ; also named 'gb2312' in XEmacs 21 or Emacs 21
-                             ; also named 'euc-cn' in Emacs 20 or Emacs 21
-    ("EUC-JP" . euc-jp)
-    ("EUC-KR" . euc-kr)
-    ;("EUC-TW" . ??)
-    ("BIG5" . big5)
-    ;("BIG5-HKSCS" . ??)
-    ;("GBK" . ??)
-    ;("GB18030" . ??)
-    ("SHIFT_JIS" . shift_jis)
-    ;("JOHAB" . ??)
-    ("TIS-620" . tis-620)    ; requires Emacs 20 or Emacs 21
-    ("VISCII" . viscii)      ; requires Emacs 20 or Emacs 21
-    ;("GEORGIAN-PS" . ??)
-    ("UTF-8" . utf-8)        ; requires Mule-UCS in Emacs 20, or Emacs 21
-    )
-  "How to convert a GNU libc/libiconv canonical charset name as seen in
-Content-Type into a Mule coding system.")
-
-(defun po-find-charset (filename)
-  "Return PO file charset value."
-  (interactive)
-  (let ((charset-regexp
-	 "^\"Content-Type: text/plain;[ \t]*charset=\\(.*\\)\\\\n\"")
-	(short-read nil))
-    ;; Try the first 4096 bytes.  In case we cannot find the charset value
-    ;; within the first 4096 bytes (the PO file might start with a long
-    ;; comment) try the next 4096 bytes repeatedly until we'll know for sure
-    ;; we've checked the empty header entry entirely.
-    (while (not (or short-read (re-search-forward "^msgid" nil t)))
-      (save-excursion
-        (goto-char (point-max))
-	(let ((pair (insert-file-contents-literally filename nil
-						    (1- (point))
-						    (1- (+ (point) 4096)))))
-	  (setq short-read (< (nth 1 pair) 4096)))))
-    (cond ((re-search-forward charset-regexp nil t) (match-string 1))
-	  (short-read nil)
-	  ;; We've found the first msgid; maybe, only a part of the msgstr
-	  ;; value was loaded.  Load the next 1024 bytes; if charset still
-	  ;; isn't available, give up.
-	  (t (save-excursion
-	       (goto-char (point-max))
-	       (insert-file-contents-literally filename nil
-					       (1- (point))
-					       (1- (+ (point) 1024))))
-	     (if (re-search-forward charset-regexp nil t)
-		 (match-string 1))))))
-
-(eval-and-compile
-  (if po-EMACS20
-      (defun po-find-file-coding-system-guts (operation filename)
-	"\
-Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
-Called through file-coding-system-alist, before the file is visited for real."
-	(and (eq operation 'insert-file-contents)
-	     (file-exists-p filename)
-	     (po-with-temp-buffer
-	      (let* ((coding-system-for-read 'no-conversion)
-		     (charset (or (po-find-charset filename) "ascii"))
-		     (charset-upper (upcase charset))
-		     (charset-lower (downcase charset))
-		     (candidate
-		      (cdr (assoc charset-upper po-content-type-charset-alist)))
-		     (try-symbol (or candidate (intern-soft charset-lower)))
-		     (try-string
-		      (if try-symbol (symbol-name try-symbol) charset-lower)))
-		(list (cond ((and try-symbol (coding-system-p try-symbol))
-			     try-symbol)
-			    ((and po-EMACS20
-				  (string-match "\\`cp[1-9][0-9][0-9]?\\'"
-						try-string)
-				  (assoc (substring try-string 2)
-					 (cp-supported-codepages)))
-			     (codepage-setup (substring try-string 2))
-			     (intern try-string))
-			    (t
-			     'no-conversion))))))))
-
-  (if po-XEMACS
-      (defun po-find-file-coding-system-guts (operation filename)
-	"\
-Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
-Called through file-coding-system-alist, before the file is visited for real."
-	(and (eq operation 'insert-file-contents)
-	     (file-exists-p filename)
-	     (po-with-temp-buffer
-	       (let ((coding-system-for-read 'no-conversion))
-                 (let* ((charset (or (po-find-charset filename)
-				     "ascii"))
-                        (charset-upper (upcase charset))
-                        (charset-lower (intern (downcase charset))))
-                   (list (or (cdr (assoc charset-upper
-                                         po-content-type-charset-alist))
-                             (if (memq charset-lower (coding-system-list))
-                                 charset-lower
-                               'no-conversion)))))))))
-
-  (if po-EMACS20
-      (defun po-find-file-coding-system (arg-list)
-	"\
-Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
-Called through file-coding-system-alist, before the file is visited for real."
-	(po-find-file-coding-system-guts (car arg-list) (car (cdr arg-list)))))
-
-  (if po-XEMACS
-      (defun po-find-file-coding-system (operation filename)
-	"\
-Return a Mule (DECODING . ENCODING) pair, according to PO file charset.
-Called through file-coding-system-alist, before the file is visited for real."
-	(po-find-file-coding-system-guts operation filename)))
-
-  )
-
-(provide 'po-compat)
-
-;;; Testing this file:
-
-;; For each emacsimpl in { emacs, xemacs } do
-;;   For each pofile in {
-;;     cs.po           ; gettext/po/cs.el, charset=ISO-8859-2
-;;     cs-modified.po  ; gettext/po/cs.el, charset=ISO_8859-2
-;;     de.po           ; gettext/po/de.el, charset=UTF-8, if $emacsimpl = emacs
-;;   } do
-;;     Start $emacsimpl
-;;     M-x load-file  po-compat.el RET
-;;     C-x C-f  $pofile RET
-;;     Verify charset marker in status line ('2' = ISO-8859-2, 'u' = UTF-8).
-
-;;; po-compat.el ends here
diff --git a/xemacs-packages/lisp/text-modes/po-mode.el b/xemacs-packages/lisp/text-modes/po-mode.el
deleted file mode 100644
index a41d8cee..00000000
--- a/xemacs-packages/lisp/text-modes/po-mode.el
+++ /dev/null
@@ -1,3321 +0,0 @@
-;;; po-mode.el -- major mode for GNU gettext PO files
-
-;; Copyright (C) 1995-1999, 2000-2002 Free Software Foundation, Inc.
-
-;; Authors: François Pinard 
-;;          Greg McGary 
-;; Keywords: i18n gettext
-;; Created: 1995
-
-;; This file is part of GNU gettext.
-
-;; GNU gettext 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 gettext 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, 59 Temple Place - Suite 330, Boston,
-;; MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package provides the tools meant to help editing PO files,
-;; as documented in the GNU gettext user's manual.  See this manual
-;; for user documentation, which is not repeated here.
-
-;; To install, merely put this file somewhere GNU Emacs will find it,
-;; then add the following lines to your .emacs file:
-;;
-;;   (autoload 'po-mode "po-mode"
-;;             "Major mode for translators to edit PO files" t)
-;;   (setq auto-mode-alist (cons '("\\.po\\'\\|\\.po\\." . po-mode)
-;;				  auto-mode-alist))
-;;
-;; To use the right coding system automatically under Emacs 20 or newer,
-;; also add:
-;;
-;;   (autoload 'po-find-file-coding-system "po-compat")
-;;   (modify-coding-system-alist 'file "\\.po\\'\\|\\.po\\."
-;;				  'po-find-file-coding-system)
-;;
-;; You may also adjust some variables, below, by defining them in your
-;; '.emacs' file, either directly or through command 'M-x customize'.
-
-;;; Code:
-
-(defconst po-mode-version-string "2.01" "\
-Version number of this version of po-mode.el.")
-
-;;; Emacs portability matters - part I.
-;;; Here is the minimum for customization to work.  See part II.
-
-;; Identify which Emacs variety is being used.
-;; This file supports:
-;;   - XEmacs (version 19 and above) -> po-XEMACS = t,
-;;   - GNU Emacs (version 20 and above) -> po-EMACS20 = t,
-;;   - GNU Emacs (version 19) -> no flag.
-(eval-and-compile
-  (cond ((string-match "XEmacs\\|Lucid" emacs-version)
-	 (setq po-EMACS20 nil po-XEMACS t))
-	((and (string-lessp "19" emacs-version) (featurep 'faces))
-	 (setq po-EMACS20 t po-XEMACS nil))
-	(t (setq po-EMACS20 nil po-XEMACS nil))))
-
-;; Experiment with Emacs LISP message internationalisation.
-(eval-and-compile
-  (or (fboundp 'set-translation-domain)
-      (defsubst set-translation-domain (string) nil))
-  (or (fboundp 'translate-string)
-      (defsubst translate-string (string) string)))
-(defsubst _ (string) (translate-string string))
-(defsubst N_ (string) string)
-
-;; Handle missing 'customs' package.
-(eval-and-compile
-  (condition-case ()
-      (require 'custom)
-    (error nil))
-  (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
-      nil
-    (defmacro defgroup (&rest args)
-      nil)
-    (defmacro defcustom (var value doc &rest args)
-      (` (defvar (, var) (, value) (, doc))))))
-
-;;; Customisation.
-
-(defgroup po nil
-  "Major mode for editing PO files"
-  :group 'i18n)
-
-(defcustom po-auto-edit-with-msgid nil
-  "*Automatically use msgid when editing untranslated entries."
-  :type 'boolean
-  :group 'po)
-
-(defcustom po-auto-fuzzy-on-edit nil
-  "*Automatically mark entries fuzzy when being edited."
-  :type 'boolean
-  :group 'po)
-
-(defcustom po-auto-select-on-unfuzzy nil
-  "*Automatically select some new entry while making an entry not fuzzy."
-  :type 'boolean
-  :group 'po)
-
-(defcustom po-auto-replace-revision-date t
-  "*Automatically revise date in headers.  Value is nil, t, or ask."
-  :type '(choice (const nil)
-		 (const t)
-		 (const ask))
-  :group 'po)
-
-(defcustom po-default-file-header "\
-# SOME DESCRIPTIVE TITLE.
-# Copyright (C) YEAR Free Software Foundation, Inc.
-# FIRST AUTHOR , YEAR.
-#
-#, fuzzy
-msgid \"\"
-msgstr \"\"
-\"Project-Id-Version: PACKAGE VERSION\\n\"
-\"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n\"
-\"Last-Translator: FULL NAME \\n\"
-\"Language-Team: LANGUAGE \\n\"
-\"MIME-Version: 1.0\\n\"
-\"Content-Type: text/plain; charset=CHARSET\\n\"
-\"Content-Transfer-Encoding: 8bit\\n\"
-"
-  "*Default PO file header."
-  :type 'string
-  :group 'po)
-
-(defcustom po-translation-project-address
-  "translation@iro.umontreal.ca"
-  "*Electronic mail address of the Translation Project.
-Typing \\[po-send-mail] (normally bound to `M') the user will send the PO file
-to this email address."
-  :type 'string
-  :group 'po)
-
-(defcustom po-translation-project-mail-label "TP-Robot"
-  "*Subject label when sending the PO file to `po-translation-project-address'.
-Don't change it when you send PO files to \"translation@iro.umontreal.ca\", the
-Translation Project Robot at http://www.iro.umontreal.ca/contrib/po/HTML/.  If
-the label is different, your submission will be consiedered as a regular mail
-and not stored at the TP site and also not forwarded to the package maintainer."
-  :type 'string
-  :group 'po)
-
-(defcustom po-highlighting (or po-EMACS20 po-XEMACS)
-  "*Highlight text whenever appropriate, when non-nil.
-However, on older Emacses, a yet unexplained highlighting bug causes files
-to get mangled."
-  :type 'boolean
-  :group 'po)
-
-(defcustom po-highlight-face 'highlight
-  "*The face used for PO mode highlighting.  For Emacses with overlays.
-Possible values are 'highlight', 'modeline', 'secondary-selection',
-'region', and 'underline'.
-This variable can be set by the user to whatever face they desire.
-It's most convenient if the cursor color and highlight color are
-slightly different."
-  :type 'face
-  :group 'po)
-
-(defcustom po-team-name-to-code
-  ;; All possible languages, a complete ISO 639 list and a little more.
-  '(("LANGUAGE" . "LL")
-    ("(Afan) Oromo" . "om")
-    ("Abkhazian" . "ab")
-    ("Afar" . "aa")
-    ("Afrikaans" . "af")
-    ("Albanian" . "sq")
-    ("Amharic" . "am")
-    ("Arabic" . "ar")
-    ("Argentinian" . "es_AR")
-    ("Armenian" . "hy")
-    ("Assamese" . "as")
-    ("Avestan" . "ae")
-    ("Aymara" . "ay")
-    ("Azerbaijani" . "az")
-    ("Bashkir" . "ba")
-    ("Basque" . "eu")
-    ("Belarusian" . "be")
-    ("Bengali" . "bn")
-    ("Bihari" . "bh")
-    ("Bislama" . "bi")
-    ("Bosnian" . "bs")
-    ("Brazilian Portuguese" . "pt_BR")
-    ("Breton" . "br")
-    ("Bulgarian" . "bg")
-    ("Burmese" . "my")
-    ("Catalan" . "ca")
-    ("Chamorro" . "ch")
-    ("Chechen" . "ce")
-    ("Chinese" . "zh")
-    ("Chinese (simplified)" . "zh_CN")
-    ("Chinese (traditional)" . "zh_TW")
-    ("Church Slavic" . "cu")
-    ("Chuvash" . "cv")
-    ("Cornish" . "kw")
-    ("Corsican" . "co")
-    ("Croatian" . "hr")
-    ("Czech" . "cs")
-    ("Danish" . "da")
-    ("Dutch" . "nl")
-    ("Dzongkha" . "dz")
-    ("English" . "en")
-    ("Esperanto" . "eo")
-    ("Estonian" . "et")
-    ("Faroese" . "fo")
-    ("Fijian" . "fj")
-    ("Finnish" . "fi")
-    ("French" . "fr")
-    ("Frisian" . "fy")
-    ("Galician" . "gl")
-    ("Georgian" . "ka")
-    ("German" . "de")
-    ("Greek" . "el")
-    ("Guarani" . "gn")
-    ("Gujarati" . "gu")
-    ("Hausa" . "ha")
-    ("Hebrew" . "he")
-    ("Herero" . "hz")
-    ("Hindi" . "hi")
-    ("Hiri Motu" . "ho")
-    ("Hungarian" . "hu")
-    ("Icelandic" . "is")
-    ("Ido" . "io")
-    ("Indonesian" . "id")
-    ("Interlingua" . "ia")
-    ("Interlingue" . "ie")
-    ("Inuktitut" . "iu")
-    ("Inupiak" . "ik")
-    ("Irish" . "ga")
-    ("Italian" . "it")
-    ("Japanese" . "ja")
-    ("Javanese" . "jv")
-    ("Kalaallisut" . "kl")
-    ("Kannada" . "kn")
-    ("Kashmiri" . "ks")
-    ("Kazakh" . "kk")
-    ("Khmer" . "km")
-    ("Kikuyu" . "ki")
-    ("Kinyarwanda" . "rw")
-    ("Kirghiz" . "ky")
-    ("Kirundi" . "rn")
-    ("Komi" . "kv")
-    ("Konkani" . "kok")
-    ("Korean" . "ko")
-    ("Kuanyama" . "kj")
-    ("Kurdish" . "ku")
-    ("Laotian" . "lo")
-    ("Latin" . "la")
-    ("Latvian" . "lv")
-    ("Letzeburgesch" . "lb")
-    ("Lingala" . "ln")
-    ("Lithuanian" . "lt")
-    ("Macedonian" . "mk")
-    ("Malagasy" . "mg")
-    ("Malay" . "ms")
-    ("Malayalam" . "ml")
-    ("Maltese" . "mt")
-    ("Manipuri" . "mni")
-    ("Manx" . "gv")
-    ("Maori" . "mi")
-    ("Marathi" . "mr")
-    ("Marshall" . "mh")
-    ("Moldavian" . "mo")
-    ("Mongolian" . "mn")
-    ("Nauru" . "na")
-    ("Navajo" . "nv")
-    ("Ndonga" . "ng")
-    ("Nepali" . "ne")
-    ("North Ndebele" . "nd")
-    ("Northern Sami" . "se")
-    ("Norwegian Bokmal" . "nb")
-    ("Norwegian Nynorsk" . "nn")
-    ("Norwegian" . "no")
-    ("Nyanja" . "ny")
-    ("Occitan" . "oc")
-    ("Oriya" . "or")
-    ("Ossetian" . "os")
-    ("Pali" . "pi")
-    ("Pashto" . "ps")
-    ("Persian" . "fa")
-    ("Polish" . "pl")
-    ("Portuguese" . "pt")
-    ("Punjabi" . "pa")
-    ("Quechua" . "qu")
-    ("Rhaeto-Roman" . "rm")
-    ("Romanian" . "ro")
-    ("Russian" . "ru")
-    ("Samoan" . "sm")
-    ("Sango" . "sg")
-    ("Sanskrit" . "sa")
-    ("Sardinian" . "sc")
-    ("Scots" . "gd")
-    ("Serbian" . "sr")
-    ("Sesotho" . "st")
-    ("Setswana" . "tn")
-    ("Shona" . "sn")
-    ("Sindhi" . "sd")
-    ("Sinhalese" . "si")
-    ("Siswati" . "ss")
-    ("Slovak" . "sk")
-    ("Slovenian" . "sl")
-    ("Somali" . "so")
-    ("Sorbian" . "wen")
-    ("South Ndebele" . "nr")
-    ("Spanish" . "es")
-    ("Sundanese" . "su")
-    ("Swahili" . "sw")
-    ("Swedish" . "sv")
-    ("Tagalog" . "tl")
-    ("Tahitian" . "ty")
-    ("Tajik" . "tg")
-    ("Tamil" . "ta")
-    ("Tatar" . "tt")
-    ("Telugu" . "te")
-    ("Thai" . "th")
-    ("Tibetan" . "bo")
-    ("Tigrinya" . "ti")
-    ("Tonga" . "to")
-    ("Tsonga" . "ts")
-    ("Turkish" . "tr")
-    ("Turkmen" . "tk")
-    ("Twi" . "tw")
-    ("Uighur" . "ug")
-    ("Ukrainian" . "uk")
-    ("Urdu" . "ur")
-    ("Uzbek" . "uz")
-    ("Vietnamese" . "vi")
-    ("Volapuk" . "vo")
-    ("Walloon" . "wa")
-    ("Welsh" . "cy")
-    ("Wolof" . "wo")
-    ("Xhosa" . "xh")
-    ("Yiddish" . "yi")
-    ("Yoruba" . "yo")
-    ("Zhuang" . "za")
-    ("Zulu" . "zu")
-    )
-  "*Association list giving team codes from team names.
-This is used for generating a submission file name for the 'M' command.
-If a string instead of an alist, it is a team code to use unconditionnally."
-  :type 'sexp
-  :group 'po)
-
-(defcustom po-gzip-uuencode-command "gzip -9 | uuencode -m"
-  "*The filter to use for preparing a mail invoice of the PO file.
-Normally \"gzip -9 | uuencode -m\", remove the -9 for lesser compression,
-or remove the -m if you are not using the GNU version of 'uuencode'."
-  :type 'string
-  :group 'po)
-
-(defvar po-subedit-mode-syntax-table
-  (copy-syntax-table text-mode-syntax-table)
-  "Syntax table used while in PO mode.")
-
-;;; Emacs portability matters - part II.
-
-;;; Many portability matters are addressed in this page.  The few remaining
-;;; cases, elsewhere, all involve  'eval-and-compile', 'boundp' or 'fboundp'.
-
-;; Protect string comparisons from text properties if possible.
-(eval-and-compile
-  (fset 'po-buffer-substring
-	(symbol-function (if (fboundp 'buffer-substring-no-properties)
-			     'buffer-substring-no-properties
-			   'buffer-substring)))
-
-  (if (fboundp 'match-string-no-properties)
-      (fset 'po-match-string (symbol-function 'match-string-no-properties))
-    (defun po-match-string (number)
-      "Return string of text matched by last search."
-      (po-buffer-substring (match-beginning number) (match-end number)))))
-
-;; Handle missing 'with-temp-buffer' function.
-(eval-and-compile
-  (if (fboundp 'with-temp-buffer)
-      (fset 'po-with-temp-buffer (symbol-function 'with-temp-buffer))
-
-    (defmacro po-with-temp-buffer (&rest forms)
-      "Create a temporary buffer, and evaluate FORMS there like 'progn'."
-      (let ((curr-buffer (make-symbol "curr-buffer"))
-	    (temp-buffer (make-symbol "temp-buffer")))
-	`(let ((,curr-buffer (current-buffer))
-	       (,temp-buffer (get-buffer-create
-			      (generate-new-buffer-name " *po-temp*"))))
-	   (unwind-protect
-	       (progn
-		 (set-buffer ,temp-buffer)
-		 ,@forms)
-	     (set-buffer ,curr-buffer)
-	     (and (buffer-name ,temp-buffer)
-		  (kill-buffer ,temp-buffer))))))))
-
-;; Handle missing 'kill-new' function.
-(eval-and-compile
-  (if (fboundp 'kill-new)
-      (fset 'po-kill-new (symbol-function 'kill-new))
-
-    (defun po-kill-new (string)
-      "Push STRING onto the kill ring, for Emacs 18 where kill-new is missing."
-      (po-with-temp-buffer
-	(insert string)
-	(kill-region (point-min) (point-max))))))
-
-;; Handle missing 'read-event' function.
-(eval-and-compile
-  (fset 'po-read-event
-	(cond ((fboundp 'read-event)
-	       ;; GNU Emacs.
-	       'read-event)
-	      ((fboundp 'next-command-event)
-	       ;; XEmacs.
-	       'next-command-event)
-	      (t
-	       ;; Older Emacses.
-	       'read-char))))
-
-;; Handle missing 'force-mode-line-update' function.
-(eval-and-compile
-  (if (fboundp 'force-mode-line-update)
-      (fset 'po-force-mode-line-update
-	    (symbol-function 'force-mode-line-update))
-
-    (defun po-force-mode-line-update ()
-      "Force the mode-line of the current buffer to be redisplayed."
-      (set-buffer-modified-p (buffer-modified-p)))))
-
-;; Handle portable highlighting.  Code has been adapted (OK... stolen! :-)
-;; from 'ispell.el'.
-(eval-and-compile
-  (cond
-   (po-EMACS20
-
-    (defun po-create-overlay ()
-      "Create and return a deleted overlay structure.
-The variable 'po-highlight-face' selects the face to use for highlighting."
-      (let ((overlay (make-overlay (point) (point))))
-	(overlay-put overlay 'face po-highlight-face)
-	;; The fun thing is that a deleted overlay retains its face, and is
-	;; movable.
-	(delete-overlay overlay)
-	overlay))
-
-    (defun po-highlight (overlay start end &optional buffer)
-      "Use OVERLAY to highlight the string from START to END.
-If limits are not relative to the current buffer, use optional BUFFER."
-      (move-overlay overlay start end (or buffer (current-buffer))))
-
-    (defun po-rehighlight (overlay)
-      "Ensure OVERLAY is highlighted."
-      ;; There is nothing to do, as GNU Emacs allows multiple highlights.
-      nil)
-
-    (defun po-dehighlight (overlay)
-      "Display normally the last string which OVERLAY highlighted.
-The current buffer should be in PO mode, when this function is called."
-      (delete-overlay overlay)))
-
-   (po-XEMACS
-
-    (defun po-create-overlay ()
-      "Create and return a deleted overlay structure."
-      ;; The same as for GNU Emacs above, except the created extent is
-      ;; already detached, so there's no need to "delete" it
-      ;; explicitly.
-      (let ((extent (make-extent nil nil)))
-	(set-extent-face extent po-highlight-face)
-	extent))
-
-    (defun po-highlight (extent start end &optional buffer)
-      "Use EXTENT to highlight the string from START to END.
-If limits are not relative to the current buffer, use optional BUFFER."
-      (set-extent-endpoints extent start end (or buffer (current-buffer))))
-
-    (defun po-rehighlight (extent)
-      "Ensure EXTENT is highlighted."
-      ;; Nothing to do here.
-      nil)
-
-    (defun po-dehighlight (extent)
-      "Display normally the last string which EXTENT highlighted."
-      (detach-extent extent)))
-
-   (t
-
-    (defun po-create-overlay ()
-      "Create and return a deleted overlay structure."
-      (cons (make-marker) (make-marker)))
-
-    (defun po-highlight (overlay start end &optional buffer)
-      "Use OVERLAY to highlight the string from START to END.
-If limits are not relative to the current buffer, use optional BUFFER.
-No doubt that highlighting, when Emacs does not allow it, is a kludge."
-      (save-excursion
-	(and buffer (set-buffer buffer))
-	(let ((modified (buffer-modified-p))
-	      (buffer-read-only nil)
-	      (inhibit-quit t)
-	      (buffer-undo-list t)
-	      (text (buffer-substring start end)))
-	  (goto-char start)
-	  (delete-region start end)
-	  (insert-char ?  (- end start))
-	  (sit-for 0)
-	  (setq inverse-video (not inverse-video))
-	  (delete-region start end)
-	  (insert text)
-	  (sit-for 0)
-	  (setq inverse-video (not inverse-video))
-	  (set-buffer-modified-p modified)))
-      (set-marker (car overlay) start (or buffer (current-buffer)))
-      (set-marker (cdr overlay) end (or buffer (current-buffer))))
-
-    (defun po-rehighlight (overlay)
-      "Ensure OVERLAY is highlighted."
-      (let ((buffer (marker-buffer (car overlay)))
-	    (start (marker-position (car overlay)))
-	    (end (marker-position (cdr overlay))))
-	(and buffer
-	     (buffer-name buffer)
-	     (po-highlight overlay start end buffer))))
-
-    (defun po-dehighlight (overlay)
-      "Display normally the last string which OVERLAY highlighted."
-      (let ((buffer (marker-buffer (car overlay)))
-	    (start (marker-position (car overlay)))
-	    (end (marker-position (cdr overlay))))
-	(if buffer
-	    (save-excursion
-	      (set-buffer buffer)
-	      (let ((modified (buffer-modified-p))
-		    (buffer-read-only nil)
-		    (inhibit-quit t)
-		    (buffer-undo-list t))
-		(let ((text (buffer-substring start end)))
-		  (goto-char start)
-		  (delete-region start end)
-		  (insert-char ?  (- end start))
-		  (sit-for 0)
-		  (delete-region start end)
-		  (insert text)
-		  (sit-for 0)
-		  (set-buffer-modified-p modified)))))
-	(setcar overlay (make-marker))
-	(setcdr overlay (make-marker))))
-
-    )))
-
-;;; Buffer local variables.
-
-;; The following block of declarations has the main purpose of avoiding
-;; byte compiler warnings.  It also introduces some documentation for
-;; each of these variables, all meant to be local to PO mode buffers.
-
-;; Flag telling that MODE-LINE-STRING should be displayed.  See 'Window'
-;; page below.  Exceptionally, this variable is local to *all* buffers.
-(defvar po-mode-flag)
-
-;; PO buffers are kept read-only to prevent random modifications.  READ-ONLY
-;; holds the value of the read-only flag before PO mode was entered.
-(defvar po-read-only)
-
-;; The current entry extends from START-OF-ENTRY to END-OF-ENTRY, it
-;; includes preceding whitespace and excludes following whitespace.  The
-;; start of keyword lines are START-OF-MSGID and START-OF-MSGSTR.
-;; ENTRY-TYPE classifies the entry.
-(defvar po-start-of-entry)
-(defvar po-start-of-msgid)
-(defvar po-start-of-msgstr)
-(defvar po-end-of-entry)
-(defvar po-entry-type)
-
-;; A few counters are usefully shown in the Emacs mode line.
-(defvar po-translated-counter)
-(defvar po-fuzzy-counter)
-(defvar po-untranslated-counter)
-(defvar po-obsolete-counter)
-(defvar po-mode-line-string)
-
-;; PO mode keeps track of fields being edited, for one given field should
-;; have one editing buffer at most, and for exiting a PO buffer properly
-;; should offer to close all pending edits.  Variable EDITED-FIELDS holds an
-;; an list of "slots" of the form: (ENTRY-MARKER EDIT-BUFFER OVERLAY-INFO).
-;; To allow simultaneous edition of the comment and the msgstr of an entry,
-;; ENTRY-MARKER points to the msgid line if a comment is being edited, or to
-;; the msgstr line if the msgstr is being edited.  EDIT-BUFFER is the
-;; temporary Emacs buffer used to edit the string.  OVERLAY-INFO, when not
-;; nil, holds an overlay (or if overlays are not supported, a cons of two
-;; markers) for this msgid string which became highlighted for the edit.
-(defvar po-edited-fields)
-
-;; We maintain a set of movable pointers for returning to entries.
-(defvar po-marker-stack)
-
-;; SEARCH path contains a list of directories where files may be found,
-;; in a format suitable for read completion.  Each directory includes
-;; its trailing slash.  PO mode starts with "./" and "../".
-(defvar po-search-path)
-
-;; The following variables are meaningful only when REFERENCE-CHECK
-;; is identical to START-OF-ENTRY, else they should be recomputed.
-;; REFERENCE-ALIST contains all known references for the current
-;; entry, each list element is (PROMPT FILE LINE), where PROMPT may
-;; be used for completing read, FILE is a string and LINE is a number.
-;; REFERENCE-CURSOR is a cycling cursor into REFERENCE-ALIST.
-(defvar po-reference-alist)
-(defvar po-reference-cursor)
-(defvar po-reference-check)
-
-;; The following variables are for marking translatable strings in program
-;; sources.  KEYWORDS is the list of keywords for marking translatable
-;; strings, kept in a format suitable for reading with completion.
-;; STRING-CONTENTS holds the value of the most recent string found in sources,
-;; and when it is not nil, then STRING-BUFFER, STRING-START and STRING-END
-;; describe where it is.  MARKING-OVERLAY, if not 'nil', holds the overlay
-;; which highlight the last found string; for older Emacses, it holds the cons
-;; of two markers around the highlighted region.
-(defvar po-keywords)
-(defvar po-string-contents)
-(defvar po-string-buffer)
-(defvar po-string-start)
-(defvar po-string-end)
-(defvar po-marking-overlay)
-
-;;; PO mode variables and constants (usually not to customize).
-
-;; The textdomain should really be "gettext", only trying it for now.
-;; All this requires more thinking, we cannot just do this like that.
-(set-translation-domain "po-mode")
-
-(defun po-mode-version ()
-  "Show Emacs PO mode version."
-  (interactive)
-  (message (_"Emacs PO mode, version %s") po-mode-version-string))
-
-(defconst po-help-display-string
-  (_"\
-PO Mode Summary           Next Previous            Miscellaneous
-*: Later, /: Docum        n    p    Any type       .     Redisplay
-                          t    T    Translated     /v    Version info
-Moving around             f    F    Fuzzy          ?, h  This help
-<    First if any         o    O    Obsolete       =     Current index
->    Last if any          u    U    Untranslated   0     Other window
-/SPC Auto select                                   V     Validate
-                        Msgstr Comments            M     Mail officially
-Modifying entries         RET  #    Call editor    _     Undo
-TAB   Remove fuzzy mark   k    K    Kill to        E     Edit out full
-DEL   Fuzzy or fade out   w    W    Copy to        Q     Forceful quit
-LFD   Init with msgid     y    Y    Yank from      q     Confirm and quit
-
-gettext Keyword Marking                            Position Stack
-,    Find next string     Compendiums              m  Mark and push current
-M-,  Mark translatable    *c    To compendium      r  Pop and return
-M-.  Change mark, mark    *M-C  Select, save       x  Exchange current/top
-
-Program Sources           Auxiliary Files          Lexicography
-s    Cycle reference      a    Cycle file          *l    Lookup translation
-M-s  Select reference     C-c C-a  Select file     *M-l  Add/edit translation
-S    Consider path        A    Consider PO file    *L    Consider lexicon
-M-S  Ignore path          M-A  Ignore PO file      *M-L  Ignore lexicon
-")
-  "Help page for PO mode.")
-
-(defconst po-mode-menu-layout
-  `("PO"
-    ("Moving around"
-     ["Auto select" po-auto-select-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to next interesting entry"))]
-     "---"
-     "Forward"
-     ["Any next" po-next-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to next entry"))]
-     ["Next translated" po-next-translated-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to next translated entry"))]
-     ["Next fuzzy" po-next-fuzzy-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to next fuzzy entry"))]
-     ["Next obsolete" po-next-obsolete-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to next obsolete entry"))]
-     ["Next untranslated" po-next-untranslated-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to next untranslated entry"))]
-     ["Last file entry" po-last-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to last entry"))]
-     "---"
-     "Backward"
-     ["Any previous" po-previous-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to previous entry"))]
-     ["Previous translated" po-previous-translated-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to previous translated entry"))]
-     ["Previous fuzzy" po-previous-fuzzy-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to previous fuzzy entry"))]
-     ["Previous obsolete" po-previous-obsolete-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to previous obsolete entry"))]
-     ["Previous untranslated" po-previous-untranslated-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to previous untranslated entry"))]
-     ["First file entry" po-first-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to first entry"))]
-     "---"
-     "Position stack"
-     ["Mark and push current" po-push-location
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Remember current location"))]
-     ["Pop and return" po-pop-location
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to last remembered location and forget about it"))]
-     ["Exchange current/top" po-exchange-location
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Jump to last remembered location and remember current location"))]
-     "---"
-     ["Redisplay" po-current-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Make current entry properly visible"))]
-     ["Current index" po-statistics
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Statistical info on current translation file"))])
-    ("Modifying entries"
-     ["Undo" po-undo
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Revoke last changed entry"))]
-     "---"
-     "Msgstr"
-     ["Edit msgstr" po-edit-msgstr
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Edit current translation"))]
-     ["Ediff and merge msgstr" po-edit-msgstr-and-ediff
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Call `ediff' on current translation for merging"))]
-     ["Cut msgstr" po-kill-msgstr
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Cut (kill) current translation"))]
-     ["Copy msgstr" po-kill-ring-save-msgstr
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Copy current translation"))]
-     ["Paste msgstr" po-yank-msgstr
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Paste (yank) text most recently cut/copied translation"))]
-     "---"
-     "Comments"
-     ["Edit comment" po-edit-comment
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Edit current comment"))]
-     ["Ediff and merge comment" po-edit-comment-and-ediff
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Call `ediff' on current comment for merging"))]
-     ["Cut comment" po-kill-comment
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Cut (kill) current comment"))]
-     ["Copy comment" po-kill-ring-save-comment
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Copy current translation"))]
-     ["Paste comment" po-yank-comment
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Paste (yank) text most recently cut/copied"))]
-     "---"
-     ["Remove fuzzy mark" po-unfuzzy
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Remove \"#, fuzzy\""))]
-     ["Fuzzy or fade out" po-fade-out-entry
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Set current entry fuzzy, or if already fuzzy delete it"))]
-     ["Init with msgid" po-msgid-to-msgstr
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "\
-Initialize or replace current translation with the original message"))])
-    ("Other files"
-     ["Other window" po-other-window
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Select other window; if necessay split current frame"))]
-     "---"
-     "Program sources"
-     ["Cycle reference" po-cycle-source-reference t]
-     ["Select reference" po-select-source-reference t]
-     ["Consider path" po-consider-source-path t]
-     ["Ignore path" po-ignore-source-path t]
-     "---"
-     "Compendiums"
-     ["To compendium" po-save-entry nil]
-     ["Select, save" po-select-and-save-entry nil]
-     "---"
-     "Auxiliary files"
-     ["Cycle file" po-cycle-auxiliary t]
-     ["Select file" po-select-auxiliary t]
-     ["Consider file" po-consider-as-auxiliary t]
-     ["Ignore file" po-ignore-as-auxiliary t]
-     "---"
-     "Lexicography"
-     ["Lookup translation" po-lookup-lexicons nil]
-     ["Add/edit translation" po-edit-lexicon-entry nil]
-     ["Consider lexicon" po-consider-lexicon-file nil]
-     ["Ignore lexicon" po-ignore-lexicon-file nil])
-    "---"
-    "Source marking"
-    ["Find first string" (po-tags-search '(nil)) t]
-    ["Prefer keyword" (po-select-mark-and-mark '(nil)) t]
-    ["Find next string" po-tags-search t]
-    ["Mark preferred" po-mark-translatable t]
-    ["Mark with keyword" po-select-mark-and-mark t]
-    "---"
-    ["Version info" po-mode-version
-     ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Display version number of PO mode"))]
-    ["Help page" po-help
-     ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Show the PO mode help screen"))]
-    ["Validate" po-validate
-     ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Check validity of current translation file using `msgfmt'"))]
-    ["Mail officially" po-send-mail
-     ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Send current translation file to the Translation Robot by mail"))]
-    ["Edit out full" po-edit-out-full
-     ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Leave PO mode to edit translation file using fundamental mode"))]
-    "---"
-    ["Forceful quit" po-quit
-     ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Close (kill) current translation file without saving"))]
-    ["Soft quit" po-confirm-and-quit
-     ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Save current translation file, than close (kill) it"))])
-  "Menu layout for PO mode.")
-
-(defconst po-subedit-mode-menu-layout
-  `("PO-Edit"
-    ["Ediff and merge translation variants" po-subedit-ediff
-      ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Call `ediff' for merging variants"))]
-    ["Cycle through auxiliary files" po-subedit-cycle-auxiliary t]
-    "---"
-    ["Abort edit" po-subedit-abort
-     ,@(if (featurep 'xemacs) '(t)
-	  '(:help "Don't change the translation"))]
-    ["Exit edit" po-subedit-exit
-     ,@(if (featurep 'xemacs) '(t)
-	 '(:help "Use this text as the translation and close current edit buffer"))])
-  "Menu layout for PO subedit mode.")
-
-(defconst po-subedit-message
-  (_"Type 'C-c C-c' once done, or 'C-c C-k' to abort edit")
-  "Message to post in the minibuffer when an edit buffer is displayed.")
-
-(defvar po-auxiliary-list nil
-  "List of auxiliary PO files, in completing read format.")
-
-(defvar po-auxiliary-cursor nil
-  "Cursor into the 'po-auxiliary-list'.")
-
-(defvar po-compose-mail-function
-  (let ((functions '(compose-mail-other-window
-		     message-mail-other-window
-		     compose-mail
-		     message-mail))
-	result)
-    (while (and (not result) functions)
-      (if (fboundp (car functions))
-	  (setq result (car functions))
-	(setq functions (cdr functions))))
-    (cond (result)
-	  ((fboundp 'mail-other-window)
-	   (function (lambda (to subject)
-		       (mail-other-window nil to subject))))
-	  ((fboundp 'mail)
-	   (function (lambda (to subject)
-		       (mail nil to subject))))
-	  (t (function (lambda (to subject)
-			 (error (_"I do not know how to mail to '%s'") to))))))
-  "Function to start composing an electronic message.")
-
-(defvar po-any-msgid-regexp
-  "^\\(#~[ \t]*\\)?msgid.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*"
-  "Regexp matching a whole msgid field, whether obsolete or not.")
-
-(defvar po-any-msgstr-regexp
-  ;; "^\\(#~[ \t]*\\)?msgstr.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*"
-  "^\\(#~[ \t]*\\)?msgstr\\(\\[[0-9]\\]\\)?.*\n\\(\\(#~[ \t]*\\)?\".*\n\\)*"
-  "Regexp matching a whole msgstr or msgstr[] field, whether obsolete or not.")
-
-(defvar po-msgstr-idx-keyword-regexp
-  "^\\(#~[ \t]*\\)?msgstr\\[[0-9]\\]"
-  "Regexp matching an indexed msgstr keyword, whether obsolete or not.")
-
-(defvar po-msgfmt-program "msgfmt"
-  "Path to msgfmt program from GNU gettext package.")
-
-;; Font lock based highlighting code.
-(defconst po-font-lock-keywords
-  '(
-    ;; ("^\\(msgid \\|msgstr \\)?\"\\|\"$" . font-lock-keyword-face)
-    ;; (regexp-opt
-    ;;  '("msgid " "msgid_plural " "msgstr " "msgstr[0] " "msgstr[1] "))
-    ("\
-^\\(\\(msg\\(id\\(_plural\\)?\\|str\\(\\[[0-9]\\]\\)?\\)?\\) \\)?\"\\|\"$"
-     . font-lock-keyword-face)
-    ("\\\\.\\|%\\*?[-.0-9ul]*[a-zA-Z]" . font-lock-variable-name-face)
-    ("^# .*\\|^#[:,]?" . font-lock-comment-face)
-    ("^#:\\(.*\\)" 1 font-lock-reference-face)
-    ;; The following line does not work, and I wonder why.
-    ;;("^#,\\(.*\\)" 1 font-function-name-reference-face)
-    )
-  "Additional expressions to highlight in PO mode.")
-
-;; Old activator for 'font lock'.  Is it still useful?  I don't think so.
-;;(if (boundp 'font-lock-keywords)
-;;    (put 'po-mode 'font-lock-keywords 'po-font-lock-keywords))
-
-;; 'hilit19' based highlighting code has been disabled, as most probably
-;; nobody really needs it (it also generates ugly byte-compiler warnings).
-;;
-;;(if (fboundp 'hilit-set-mode-patterns)
-;;    (hilit-set-mode-patterns 'po-mode
-;;			     '(("^# .*\\|^#$" nil comment)
-;;			       ("^#[.,:].*" nil include)
-;;			       ("^\\(msgid\\|msgstr\\) *\"" nil keyword)
-;;			       ("^\"\\|\"$" nil keyword))))
-
-;;; Mode activation.
-
-;; Emacs 21.2 comes with po-find-file-coding-system. We give preference
-;; to the version shipped with Emacs.
-(if (not (fboundp 'po-find-file-coding-system))
-  (require 'po-compat))
-
-(defvar po-mode-abbrev-table nil
-  "Abbrev table used while in PO mode.")
-(define-abbrev-table 'po-mode-abbrev-table ())
-
-(defvar po-mode-map
-  ;; Use (make-keymap) because (make-sparse-keymap) does not work on Demacs.
-  (let ((po-mode-map (make-keymap)))
-    (suppress-keymap po-mode-map)
-    (define-key po-mode-map "\C-i" 'po-unfuzzy)
-    (define-key po-mode-map "\C-j" 'po-msgid-to-msgstr)
-    (define-key po-mode-map "\C-m" 'po-edit-msgstr)
-    (define-key po-mode-map " " 'po-auto-select-entry)
-    (define-key po-mode-map "?" 'po-help)
-    (define-key po-mode-map "#" 'po-edit-comment)
-    (define-key po-mode-map "," 'po-tags-search)
-    (define-key po-mode-map "." 'po-current-entry)
-    (define-key po-mode-map "<" 'po-first-entry)
-    (define-key po-mode-map "=" 'po-statistics)
-    (define-key po-mode-map ">" 'po-last-entry)
-    (define-key po-mode-map "a" 'po-cycle-auxiliary)
-;;;;  (define-key po-mode-map "c" 'po-save-entry)
-    (define-key po-mode-map "f" 'po-next-fuzzy-entry)
-    (define-key po-mode-map "h" 'po-help)
-    (define-key po-mode-map "k" 'po-kill-msgstr)
-;;;;  (define-key po-mode-map "l" 'po-lookup-lexicons)
-    (define-key po-mode-map "m" 'po-push-location)
-    (define-key po-mode-map "n" 'po-next-entry)
-    (define-key po-mode-map "o" 'po-next-obsolete-entry)
-    (define-key po-mode-map "p" 'po-previous-entry)
-    (define-key po-mode-map "q" 'po-confirm-and-quit)
-    (define-key po-mode-map "r" 'po-pop-location)
-    (define-key po-mode-map "s" 'po-cycle-source-reference)
-    (define-key po-mode-map "t" 'po-next-translated-entry)
-    (define-key po-mode-map "u" 'po-next-untranslated-entry)
-    (define-key po-mode-map "v" 'po-mode-version)
-    (define-key po-mode-map "w" 'po-kill-ring-save-msgstr)
-    (define-key po-mode-map "x" 'po-exchange-location)
-    (define-key po-mode-map "y" 'po-yank-msgstr)
-    (define-key po-mode-map "A" 'po-consider-as-auxiliary)
-    (define-key po-mode-map "E" 'po-edit-out-full)
-    (define-key po-mode-map "F" 'po-previous-fuzzy-entry)
-    (define-key po-mode-map "K" 'po-kill-comment)
-;;;;  (define-key po-mode-map "L" 'po-consider-lexicon-file)
-    (define-key po-mode-map "M" 'po-send-mail)
-    (define-key po-mode-map "O" 'po-previous-obsolete-entry)
-    (define-key po-mode-map "T" 'po-previous-translated-entry)
-    (define-key po-mode-map "U" 'po-previous-untranslated-entry)
-    (define-key po-mode-map "Q" 'po-quit)
-    (define-key po-mode-map "S" 'po-consider-source-path)
-    (define-key po-mode-map "V" 'po-validate)
-    (define-key po-mode-map "W" 'po-kill-ring-save-comment)
-    (define-key po-mode-map "Y" 'po-yank-comment)
-    (define-key po-mode-map "_" 'po-undo)
-    (define-key po-mode-map "0" 'po-other-window)
-    (define-key po-mode-map "\177" 'po-fade-out-entry)
-    (define-key po-mode-map "\C-c\C-a" 'po-select-auxiliary)
-    (define-key po-mode-map "\C-c\C-e" 'po-edit-msgstr-and-ediff)
-    (define-key po-mode-map [?\C-c?\C-#] 'po-edit-comment-and-ediff)
-    (define-key po-mode-map "\C-c\C-C" 'po-edit-comment-and-ediff)
-    (define-key po-mode-map "\M-," 'po-mark-translatable)
-    (define-key po-mode-map "\M-." 'po-select-mark-and-mark)
-;;;;  (define-key po-mode-map "\M-c" 'po-select-and-save-entry)
-;;;;  (define-key po-mode-map "\M-l" 'po-edit-lexicon-entry)
-    (define-key po-mode-map "\M-s" 'po-select-source-reference)
-    (define-key po-mode-map "\M-A" 'po-ignore-as-auxiliary)
-;;;;  (define-key po-mode-map "\M-L" 'po-ignore-lexicon-file)
-    (define-key po-mode-map "\M-S" 'po-ignore-source-path)
-    po-mode-map)
-  "Keymap for PO mode.")
-
-;; XEmacs note: this should really be autoloaded, but is currently not due
-;; to reportedly intrusive keybindings (not autoloaded upstream either as of
-;; gettext 0.13.1).  See also end of file for auto-mode-alist comments.
-(defun po-mode ()
-  "Major mode for translators when they edit PO files.
-
-Special commands:
-\\{po-mode-map}
-Turning on PO mode calls the value of the variable 'po-mode-hook',
-if that value is non-nil.  Behaviour may be adjusted through some variables,
-all reachable through 'M-x customize', in group 'Emacs.Editing.I18n.Po'."
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'po-mode
-	mode-name "PO")
-  (use-local-map po-mode-map)
-  (if (fboundp 'easy-menu-define)
-      (progn
-	(easy-menu-define po-mode-menu po-mode-map "" po-mode-menu-layout)
-	(and po-XEMACS (easy-menu-add po-mode-menu))))
-  (set (make-local-variable 'font-lock-defaults) '(po-font-lock-keywords t))
-
-  (set (make-local-variable 'po-read-only) buffer-read-only)
-  (setq buffer-read-only t)
-
-  (make-local-variable 'po-start-of-entry)
-  (make-local-variable 'po-start-of-msgid)
-  (make-local-variable 'po-start-of-msgstr)
-  (make-local-variable 'po-end-of-entry)
-  (make-local-variable 'po-entry-type)
-
-  (make-local-variable 'po-translated-counter)
-  (make-local-variable 'po-fuzzy-counter)
-  (make-local-variable 'po-untranslated-counter)
-  (make-local-variable 'po-obsolete-counter)
-  (make-local-variable 'po-mode-line-string)
-
-  (setq po-mode-flag t)
-
-  (po-check-file-header)
-  (po-compute-counters nil)
-
-  (set (make-local-variable 'po-edited-fields) nil)
-  (set (make-local-variable 'po-marker-stack) nil)
-  (set (make-local-variable 'po-search-path) '(("./") ("../")))
-
-  (set (make-local-variable 'po-reference-alist) nil)
-  (set (make-local-variable 'po-reference-cursor) nil)
-  (set (make-local-variable 'po-reference-check) 0)
-
-  (set (make-local-variable 'po-keywords)
-       '(("gettext") ("gettext_noop") ("_") ("N_")))
-  (set (make-local-variable 'po-string-contents) nil)
-  (set (make-local-variable 'po-string-buffer) nil)
-  (set (make-local-variable 'po-string-start) nil)
-  (set (make-local-variable 'po-string-end) nil)
-  (set (make-local-variable 'po-marking-overlay) (po-create-overlay))
-
-  (add-hook 'write-contents-hooks 'po-replace-revision-date)
-
-  (run-hooks 'po-mode-hook)
-  (message (_"You may type 'h' or '?' for a short PO mode reminder.")))
-
-(defvar po-subedit-mode-map
-  ;; Use (make-keymap) because (make-sparse-keymap) does not work on Demacs.
-  (let ((po-subedit-mode-map (make-keymap)))
-    (define-key po-subedit-mode-map "\C-c\C-a" 'po-subedit-cycle-auxiliary)
-    (define-key po-subedit-mode-map "\C-c\C-c" 'po-subedit-exit)
-    (define-key po-subedit-mode-map "\C-c\C-e" 'po-subedit-ediff)
-    (define-key po-subedit-mode-map "\C-c\C-k" 'po-subedit-abort)
-    po-subedit-mode-map)
-  "Keymap while editing a PO mode entry (or the full PO file).")
-
-;;; Window management.
-
-(make-variable-buffer-local 'po-mode-flag)
-
-(defvar po-mode-line-entry '(po-mode-flag ("  " po-mode-line-string))
-  "Mode line format entry displaying MODE-LINE-STRING.")
-
-;; Insert MODE-LINE-ENTRY in mode line, but on first load only.
-(or (member po-mode-line-entry mode-line-format)
-    ;; mode-line-format usually contains global-mode-string, but some
-    ;; people customize this variable. As a last resort, append at the end.
-    (let ((prev-entry (or (member 'global-mode-string mode-line-format)
-                          (member "   " mode-line-format)
-                          (last mode-line-format))))
-      (setcdr prev-entry (cons po-mode-line-entry (cdr prev-entry)))))
-
-(defun po-update-mode-line-string ()
-  "Compute a new statistics string to display in mode line."
-  (setq po-mode-line-string
-	(concat (format "%dt" po-translated-counter)
-		(if (> po-fuzzy-counter 0)
-		    (format "+%df" po-fuzzy-counter))
-		(if (> po-untranslated-counter 0)
-		    (format "+%du" po-untranslated-counter))
-		(if (> po-obsolete-counter 0)
-		    (format "+%do" po-obsolete-counter))))
-  (po-force-mode-line-update))
-
-(defun po-type-counter ()
-  "Return the symbol name of the counter appropriate for the current entry."
-  (cond ((eq po-entry-type 'obsolete) 'po-obsolete-counter)
-	((eq po-entry-type 'fuzzy) 'po-fuzzy-counter)
-	((eq po-entry-type 'translated) 'po-translated-counter)
-	((eq po-entry-type 'untranslated) 'po-untranslated-counter)
-	(t (error (_"Unknown entry type")))))
-
-(defun po-decrease-type-counter ()
-  "Decrease the counter corresponding to the nature of the current entry."
-  (let ((counter (po-type-counter)))
-    (set counter (1- (eval counter)))))
-
-(defun po-increase-type-counter ()
-  "Increase the counter corresponding to the nature of the current entry.
-Then, update the mode line counters."
-  (let ((counter (po-type-counter)))
-    (set counter (1+ (eval counter))))
-  (po-update-mode-line-string))
-
-;; Avoid byte compiler warnings.
-(defvar po-fuzzy-regexp)
-(defvar po-untranslated-regexp)
-
-(defun po-compute-counters (flag)
-  "Prepare counters for mode line display.  If FLAG, also echo entry position."
-  (and flag (po-find-span-of-entry))
-  (setq po-translated-counter 0
-	po-fuzzy-counter 0
-	po-untranslated-counter 0
-	po-obsolete-counter 0)
-  (let ((position 0) (total 0) current here)
-    ;; FIXME 'here' looks obsolete / 2001-08-23 03:54:26 CEST -ke-
-    (save-excursion
-      (po-find-span-of-entry)
-      (setq current po-start-of-msgstr)
-      (goto-char (point-min))
-      ;; While counting, skip the header entry, for consistency with msgfmt.
-      (po-find-span-of-entry)
-      (if (string-equal (po-get-msgid nil) "")
-	  (goto-char po-end-of-entry))
-      (if (re-search-forward "^msgid" (point-max) t)
-	  (progn
-	    ;; Start counting
-	    (while (re-search-forward po-any-msgstr-regexp nil t)
-	      (and (= (% total 20) 0)
-		   (if flag
-		       (message (_"Position %d/%d") position total)
-		     (message (_"Position %d") total)))
-	      (setq here (point))
-	      (goto-char (match-beginning 0))
-	      (setq total (1+ total))
-	      (and flag (eq (point) current) (setq position total))
-	      (cond ((eq (following-char) ?#)
-		     (setq po-obsolete-counter (1+ po-obsolete-counter)))
-		    ((looking-at po-untranslated-regexp)
-		     (setq po-untranslated-counter (1+ po-untranslated-counter)))
-		    (t (setq po-translated-counter (1+ po-translated-counter))))
-	      (goto-char here))
-
-	    ;; Make another pass just for the fuzzy entries, kind of kludgey.
-	    ;; FIXME: Counts will be wrong if untranslated entries are fuzzy, yet
-	    ;; this should not normally happen.
-	    (goto-char (point-min))
-	    (while (re-search-forward po-fuzzy-regexp nil t)
-	      (setq po-fuzzy-counter (1+ po-fuzzy-counter)))
-	    (setq po-translated-counter (- po-translated-counter po-fuzzy-counter)))
-	'()))
-
-    ;; Push the results out.
-    (if flag
-	(message (_"\
-Position %d/%d; %d translated, %d fuzzy, %d untranslated, %d obsolete")
-		 position total po-translated-counter po-fuzzy-counter
-		 po-untranslated-counter po-obsolete-counter)
-      (message "")))
-  (po-update-mode-line-string))
-
-(defun po-redisplay ()
-  "Redisplay the current entry."
-  ;; FIXME: Should try to fit the whole entry on the window.  If this is not
-  ;; possible, should try to fit the comment and the msgid.  Otherwise,
-  ;; should try to fit the msgid.  Else, the first line of the msgid should
-  ;; be at the top of the window.
-  (goto-char po-start-of-msgid))
-
-(defun po-other-window ()
-  "Get the cursor into another window, out of PO mode."
-  (interactive)
-  (if (one-window-p t)
-      (progn
-	(split-window)
-	(switch-to-buffer (other-buffer)))
-    (other-window 1)))
-
-;;; Processing the PO file header entry.
-
-(defun po-check-file-header ()
-  "Create a missing PO mode file header, or replace an oldish one."
-  (save-excursion
-    (let ((buffer-read-only po-read-only)
-	  insert-flag end-of-header)
-      (goto-char (point-min))
-      (if (re-search-forward po-any-msgstr-regexp nil t)
-	  (progn
-	    ;; There is at least one entry.
-	    (goto-char (match-beginning 0))
-	    (previous-line 1)
-	    (setq end-of-header (match-end 0))
-	    (if (looking-at "msgid \"\"\n")
-		;; There is indeed a PO file header.
-		(if (re-search-forward "\n\"PO-Revision-Date: "
-				       end-of-header t)
-		    nil
-		  ;; This is an oldish header.  Replace it all.
-		  (goto-char end-of-header)
-		  (while (> (point) (point-min))
-		    (previous-line 1)
-		    (insert "#~ ")
-		    (beginning-of-line))
-		  (beginning-of-line)
-		  (setq insert-flag t))
-	      ;; The first entry is not a PO file header, insert one.
-	      (setq insert-flag t)))
-	;; Not a single entry found.
-	(setq insert-flag t))
-      (goto-char (point-min))
-      (if insert-flag
-	  (progn
-	    (insert po-default-file-header)
-	    (if (not (eobp))
-		(insert "\n")))))))
-
-(defun po-replace-revision-date ()
-  "Replace the revision date by current time in the PO file header."
-  (if (fboundp 'format-time-string)
-      (if (or (eq po-auto-replace-revision-date t)
-	      (and (eq po-auto-replace-revision-date 'ask)
-		   (y-or-n-p (_"May I set PO-Revision-Date? "))))
-	  (save-excursion
-	    (goto-char (point-min))
-	    (if (re-search-forward "^\"PO-Revision-Date:.*" nil t)
-		(let* ((buffer-read-only po-read-only)
-		       (time (current-time))
-		       (seconds (or (car (current-time-zone time)) 0))
-		       (minutes (/ (abs seconds) 60))
-		       (zone (format "%c%02d%02d"
-				     (if (< seconds 0) ?- ?+)
-				     (/ minutes 60)
-				     (% minutes 60))))
-		  (replace-match
-		       (concat "\"PO-Revision-Date: "
-			       (format-time-string "%Y-%m-%d %H:%M" time)
-			       zone "\\n\"")
-		       t t))))
-	(message ""))
-    (message (_"PO-Revision-Date should be adjusted..."))))
-
-;;; Handling span of entry, entry type and entry attributes.
-
-(defun po-find-span-of-entry ()
-  "Find the extent of the PO file entry where the cursor is.
-Set variables PO-START-OF-ENTRY, PO-START-OF-MSGID, PO-START-OF-MSGSTR,
-PO-END-OF-ENTRY and PO-ENTRY-TYPE to meaningful values.  Decreasing priority
-of type interpretation is: obsolete, fuzzy, untranslated or translated."
-  (let ((here (point)))
-    (if (re-search-backward po-any-msgstr-regexp nil t)
-	(progn
-	  ;; After a backward match, (match-end 0) will not extend
-	  ;; beyond point, in case point was *inside* the regexp.  We
-	  ;; need a dependable (match-end 0), so we redo the match in
-	  ;; the forward direction.
-	  (re-search-forward po-any-msgstr-regexp)
-	  (if (<= (match-end 0) here)
-	      (progn
-		;; We most probably found the msgstr of the previous
-		;; entry.  The current entry then starts just after
-		;; its end, save this information just in case.
-		(setq po-start-of-entry (match-end 0))
-		;; However, it is also possible that we are located in
-		;; the crumb after the last entry in the file.  If
-		;; yes, we know the middle and end of last PO entry.
-		(setq po-start-of-msgstr (match-beginning 0)
-		      po-end-of-entry (match-end 0))
-		(if (re-search-forward po-any-msgstr-regexp nil t)
-		    (progn
-		      ;; We definitely were not in the crumb.
-		      (setq po-start-of-msgstr (match-beginning 0)
-			    po-end-of-entry (match-end 0)))
-		  ;; We were in the crumb.  The start of the last PO
-		  ;; file entry is the end of the previous msgstr if
-		  ;; any, or else, the beginning of the file.
-		  (goto-char po-start-of-msgstr)
-		  (setq po-start-of-entry
-			(if (re-search-backward po-any-msgstr-regexp nil t)
-			    (match-end 0)
-			  (point-min)))))
-	    ;; The cursor was inside msgstr of the current entry.
-	    (setq po-start-of-msgstr (match-beginning 0)
-		  po-end-of-entry (match-end 0))
-	    ;; The start of this entry is the end of the previous
-	    ;; msgstr if any, or else, the beginning of the file.
-	    (goto-char po-start-of-msgstr)
-	    (setq po-start-of-entry
-		  (if (re-search-backward po-any-msgstr-regexp nil t)
-		      (match-end 0)
-		    (point-min)))))
-      ;; The cursor was before msgstr in the first entry in the file.
-      (setq po-start-of-entry (point-min))
-      (goto-char po-start-of-entry)
-      ;; There is at least the PO file header, so this should match.
-      (re-search-forward po-any-msgstr-regexp)
-      (setq po-start-of-msgstr (match-beginning 0)
-	    po-end-of-entry (match-end 0)))
-    ;; Find start of msgid.
-    (goto-char po-start-of-entry)
-    (re-search-forward po-any-msgid-regexp)
-    (setq po-start-of-msgid (match-beginning 0))
-    ;; Classify the entry.
-    (setq po-entry-type
-	  (if (eq (following-char) ?#)
-	      'obsolete
-	    (goto-char po-start-of-entry)
-	    (if (re-search-forward po-fuzzy-regexp po-start-of-msgid t)
-		'fuzzy
-	      (goto-char po-start-of-msgstr)
-	      (if (looking-at po-untranslated-regexp)
-		  'untranslated
-		'translated))))
-    ;; Put the cursor back where it was.
-    (goto-char here)))
-
-(defun po-add-attribute (name)
-  "Add attribute NAME to the current entry, unless it is already there."
-  (save-excursion
-    (let ((buffer-read-only po-read-only))
-      (goto-char po-start-of-entry)
-      (if (re-search-forward "\n#[,!] .*" po-start-of-msgid t)
-	  (save-restriction
-	    (narrow-to-region (match-beginning 0) (match-end 0))
-	    (goto-char (point-min))
-	    (if (re-search-forward (concat "\\b" name "\\b") nil t)
-		nil
-	      (goto-char (point-max))
-	      (insert ", " name)))
-	(skip-chars-forward "\n")
-	(while (eq (following-char) ?#)
-	  (next-line 1))
-	(insert "#, " name "\n")))))
-
-(defun po-delete-attribute (name)
-  "Delete attribute NAME from the current entry, if any."
-  (save-excursion
-    (let ((buffer-read-only po-read-only))
-      (goto-char po-start-of-entry)
-      (if (re-search-forward "\n#[,!] .*" po-start-of-msgid t)
-	  (save-restriction
-	    (narrow-to-region (match-beginning 0) (match-end 0))
-	    (goto-char (point-min))
-	    (if (re-search-forward
-		 (concat "\\(\n#[,!] " name "$\\|, " name "$\\| " name ",\\)")
-		 nil t)
-		(replace-match "" t t)))))))
-
-;;; Entry positionning.
-
-(defun po-say-location-depth ()
-  "Tell how many entries in the entry location stack."
-  (let ((depth (length po-marker-stack)))
-    (cond ((= depth 0) (message (_"Empty location stack")))
-	  ((= depth 1) (message (_"One entry in location stack")))
-	  (t (message (_"%d entries in location stack") depth)))))
-
-(defun po-push-location ()
-  "Stack the location of the current entry, for later return."
-  (interactive)
-  (po-find-span-of-entry)
-  (save-excursion
-    (goto-char po-start-of-msgid)
-    (setq po-marker-stack (cons (point-marker) po-marker-stack)))
-  (po-say-location-depth))
-
-(defun po-pop-location ()
-  "Unstack a saved location, and return to the corresponding entry."
-  (interactive)
-  (if po-marker-stack
-      (progn
-	(goto-char (car po-marker-stack))
-	(setq po-marker-stack (cdr po-marker-stack))
-	(po-current-entry)
-	(po-say-location-depth))
-    (error (_"The entry location stack is empty"))))
-
-(defun po-exchange-location ()
-  "Exchange the location of the current entry with the top of stack."
-  (interactive)
-  (if po-marker-stack
-      (progn
-	(po-find-span-of-entry)
-	(goto-char po-start-of-msgid)
-	(let ((location (point-marker)))
-	  (goto-char (car po-marker-stack))
-	  (setq po-marker-stack (cons location (cdr po-marker-stack))))
-	(po-current-entry)
-	(po-say-location-depth))
-    (error (_"The entry location stack is empty"))))
-
-(defun po-current-entry ()
-  "Display the current entry."
-  (interactive)
-  (po-find-span-of-entry)
-  (po-redisplay))
-
-(defun po-first-entry-with-regexp (regexp)
-  "Display the first entry in the file which msgstr matches REGEXP."
-  (let ((here (point)))
-    (goto-char (point-min))
-    (if (re-search-forward regexp nil t)
-	(progn
-	  (goto-char (match-beginning 0))
-	  (po-current-entry))
-      (goto-char here)
-      (error (_"There is no such entry")))))
-
-(defun po-last-entry-with-regexp (regexp)
-  "Display the last entry in the file which msgstr matches REGEXP."
-  (let ((here (point)))
-    (goto-char (point-max))
-    (if (re-search-backward regexp nil t)
-	(po-current-entry)
-      (goto-char here)
-      (error (_"There is no such entry")))))
-
-(defun po-next-entry-with-regexp (regexp wrap)
-  "Display the entry following the current entry which msgstr matches REGEXP.
-If WRAP is not nil, the search may wrap around the buffer."
-  (po-find-span-of-entry)
-  (let ((here (point)))
-    (goto-char po-end-of-entry)
-    (if (re-search-forward regexp nil t)
-	(progn
-	  (goto-char (match-beginning 0))
-	  (po-current-entry))
-      (if (and wrap
-	       (progn
-		 (goto-char (point-min))
-		 (re-search-forward regexp po-start-of-entry t)))
-	  (progn
-	    (goto-char (match-beginning 0))
-	    (po-current-entry)
-	    (message (_"Wrapping around the buffer")))
-	(goto-char here)
-	(error (_"There is no such entry"))))))
-
-(defun po-previous-entry-with-regexp (regexp wrap)
-  "Redisplay the entry preceding the current entry which msgstr matches REGEXP.
-If WRAP is not nil, the search may wrap around the buffer."
-  (po-find-span-of-entry)
-  (let ((here (point)))
-    (goto-char po-start-of-entry)
-    (if (re-search-backward regexp nil t)
-	(po-current-entry)
-      (if (and wrap
-	       (progn
-		 (goto-char (point-max))
-		 (re-search-backward regexp po-end-of-entry t)))
-	  (progn
-	    (po-current-entry)
-	    (message (_"Wrapping around the buffer")))
-	(goto-char here)
-	(error (_"There is no such entry"))))))
-
-;; Any entries.
-
-(defun po-first-entry ()
-  "Display the first entry."
-  (interactive)
-  (po-first-entry-with-regexp po-any-msgstr-regexp))
-
-(defun po-last-entry ()
-  "Display the last entry."
-  (interactive)
-  (po-last-entry-with-regexp po-any-msgstr-regexp))
-
-(defun po-next-entry ()
-  "Display the entry following the current entry."
-  (interactive)
-  (po-next-entry-with-regexp po-any-msgstr-regexp nil))
-
-(defun po-previous-entry ()
-  "Display the entry preceding the current entry."
-  (interactive)
-  (po-previous-entry-with-regexp po-any-msgstr-regexp nil))
-
-;; Untranslated entries.
-
-(defvar po-after-entry-regexp
-  "\\(\\'\\|\\(#[ \t]*\\)?$\\)"
-  "Regexp which should be true after a full msgstr string matched.")
-
-(defvar po-untranslated-regexp
-  (concat "^msgstr[ \t]*\"\"\n" po-after-entry-regexp)
-  "Regexp matching a whole msgstr field, but only if active and empty.")
-
-(defun po-next-untranslated-entry ()
-  "Find the next untranslated entry, wrapping around if necessary."
-  (interactive)
-  (po-next-entry-with-regexp po-untranslated-regexp t))
-
-(defun po-previous-untranslated-entry ()
-  "Find the previous untranslated entry, wrapping around if necessary."
-  (interactive)
-  (po-previous-entry-with-regexp po-untranslated-regexp t))
-
-(defun po-msgid-to-msgstr ()
-  "Use another window to edit msgstr reinitialized with msgid."
-  (interactive)
-  (po-find-span-of-entry)
-  (if (or (eq po-entry-type 'untranslated)
-	  (eq po-entry-type 'obsolete)
-	  (y-or-n-p (_"Really loose previous translation? ")))
-      (po-set-msgstr (po-get-msgid nil)))
-  (message ""))
-
-;; Obsolete entries.
-
-(defvar po-obsolete-msgstr-regexp
-  "^#~[ \t]*msgstr.*\n\\(#~[ \t]*\".*\n\\)*"
-  "Regexp matching a whole msgstr field of an obsolete entry.")
-
-(defun po-next-obsolete-entry ()
-  "Find the next obsolete entry, wrapping around if necessary."
-  (interactive)
-  (po-next-entry-with-regexp po-obsolete-msgstr-regexp t))
-
-(defun po-previous-obsolete-entry ()
-  "Find the previous obsolete entry, wrapping around if necessary."
-  (interactive)
-  (po-previous-entry-with-regexp po-obsolete-msgstr-regexp t))
-
-;; Fuzzy entries.
-
-(defvar po-fuzzy-regexp "^#[,!] .*fuzzy"
-  "Regexp matching the string inserted by msgmerge for translations
-which does not match exactly.")
-
-(defun po-next-fuzzy-entry ()
-  "Find the next fuzzy entry, wrapping around if necessary."
-  (interactive)
-  (po-next-entry-with-regexp po-fuzzy-regexp t))
-
-(defun po-previous-fuzzy-entry ()
-  "Find the next fuzzy entry, wrapping around if necessary."
-  (interactive)
-  (po-previous-entry-with-regexp po-fuzzy-regexp t))
-
-(defun po-unfuzzy ()
-  "Remove the fuzzy attribute for the current entry."
-  (interactive)
-  (po-find-span-of-entry)
-  (cond ((eq po-entry-type 'fuzzy)
-	 (po-decrease-type-counter)
-	 (po-delete-attribute "fuzzy")
-	 (po-current-entry)
-	 (po-increase-type-counter)))
-  (if po-auto-select-on-unfuzzy
-      (po-auto-select-entry))
-  (po-update-mode-line-string))
-
-;; Translated entries.
-
-(defun po-next-translated-entry ()
-  "Find the next translated entry, wrapping around if necessary."
-  (interactive)
-  (if (= po-translated-counter 0)
-      (error (_"There is no such entry"))
-    (po-next-entry-with-regexp po-any-msgstr-regexp t)
-    (po-find-span-of-entry)
-    (while (not (eq po-entry-type 'translated))
-      (po-next-entry-with-regexp po-any-msgstr-regexp t)
-      (po-find-span-of-entry))))
-
-(defun po-previous-translated-entry ()
-  "Find the previous translated entry, wrapping around if necessary."
-  (interactive)
-  (if (= po-translated-counter 0)
-      (error (_"There is no such entry"))
-    (po-previous-entry-with-regexp po-any-msgstr-regexp t)
-    (po-find-span-of-entry)
-    (while (not (eq po-entry-type 'translated))
-      (po-previous-entry-with-regexp po-untranslated-regexp t)
-      (po-find-span-of-entry))))
-
-;; Auto-selection feature.
-
-(defun po-auto-select-entry ()
-  "Select the next entry having the same type as the current one.
-If none, wrap from the beginning of the buffer with another type,
-going from untranslated to fuzzy, and from fuzzy to obsolete.
-Plain translated entries are always disregarded unless there are
-no entries of the other types."
-  (interactive)
-  (po-find-span-of-entry)
-  (goto-char po-end-of-entry)
-  (if (and (= po-untranslated-counter 0)
-	   (= po-fuzzy-counter 0)
-	   (= po-obsolete-counter 0))
-      ;; All entries are plain translated.  Next entry will do, or
-      ;; wrap around if there is none.
-      (if (re-search-forward po-any-msgstr-regexp nil t)
-	  (goto-char (match-beginning 0))
-	(goto-char (point-min)))
-    ;; If over a translated entry, look for an untranslated one first.
-    ;; Else, look for an entry of the same type first.
-    (let ((goal (if (eq po-entry-type 'translated)
-		    'untranslated
-		  po-entry-type)))
-      (while goal
-	;; Find an untranslated entry, or wrap up for a fuzzy entry.
-	(if (eq goal 'untranslated)
-	    (if (and (> po-untranslated-counter 0)
-		     (re-search-forward po-untranslated-regexp nil t))
-		(progn
-		  (goto-char (match-beginning 0))
-		  (setq goal nil))
-	      (goto-char (point-min))
-	      (setq goal 'fuzzy)))
-	;; Find a fuzzy entry, or wrap up for an obsolete entry.
-	(if (eq goal 'fuzzy)
-	    (if (and (> po-fuzzy-counter 0)
-		     (re-search-forward po-fuzzy-regexp nil t))
-		(progn
-		  (goto-char (match-beginning 0))
-		  (setq goal nil))
-	      (goto-char (point-min))
-	      (setq goal 'obsolete)))
-	;; Find an obsolete entry, or wrap up for an untranslated entry.
-	(if (eq goal 'obsolete)
-	    (if (and (> po-obsolete-counter 0)
-		     (re-search-forward po-obsolete-msgstr-regexp nil t))
-		(progn
-		  (goto-char (match-beginning 0))
-		  (setq goal nil))
-	      (goto-char (point-min))
-	      (setq goal 'untranslated))))))
-  ;; Display this entry nicely.
-  (po-current-entry))
-
-;;; Killing and yanking fields.
-
-(defun po-extract-unquoted (buffer start end)
-  "Extract and return the unquoted string in BUFFER going from START to END.
-Crumb preceding or following the quoted string is ignored."
-  (save-excursion
-    (goto-char start)
-    (search-forward "\"")
-    (setq start (point))
-    (goto-char end)
-    (search-backward "\"")
-    (setq end (point)))
-  (po-extract-part-unquoted buffer start end))
-
-(defun po-extract-part-unquoted (buffer start end)
-  "Extract and return the unquoted string in BUFFER going from START to END.
-Surrounding quotes are already excluded by the position of START and END."
-  (po-with-temp-buffer
-   (insert-buffer-substring buffer start end)
-   ;; Glue concatenated strings.
-   (goto-char (point-min))
-   (while (re-search-forward "\"[ \t]*\\\\?\n\\(#~\\)?[ \t]*\"" nil t)
-     (replace-match "" t t))
-   ;; Remove escaped newlines.
-   (goto-char (point-min))
-   (while (re-search-forward "\\\\[ \t]*\n" nil t)
-     (replace-match "" t t))
-   ;; Unquote individual characters.
-   (goto-char (point-min))
-   (while (re-search-forward "\\\\[\"abfnt\\0-7]" nil t)
-     (cond ((eq (preceding-char) ?\") (replace-match "\"" t t))
-	   ((eq (preceding-char) ?a) (replace-match "\a" t t))
-	   ((eq (preceding-char) ?b) (replace-match "\b" t t))
-	   ((eq (preceding-char) ?f) (replace-match "\f" t t))
-	   ((eq (preceding-char) ?n) (replace-match "\n" t t))
-	   ((eq (preceding-char) ?t) (replace-match "\t" t t))
-	   ((eq (preceding-char) ?\\) (replace-match "\\" t t))
-	   (t (let ((value (- (preceding-char) ?0)))
-		(replace-match "" t t)
-		(while (looking-at "[0-7]")
-		  (setq value (+ (* 8 value) (- (following-char) ?0)))
-		  (replace-match "" t t))
-		(insert value)))))
-   (buffer-string)))
-
-(defun po-eval-requoted (form prefix obsolete)
-  "Eval FORM, which inserts a string, and return the string fully requoted.
-If PREFIX, precede the result with its contents.  If OBSOLETE, comment all
-generated lines in the returned string.  Evaluating FORM should insert the
-wanted string in the buffer which is current at the time of evaluation.
-If FORM is itself a string, then this string is used for insertion."
-  (po-with-temp-buffer
-    (if (stringp form)
-	(insert form)
-      (push-mark)
-      (eval form))
-    (goto-char (point-min))
-    (let ((multi-line (re-search-forward "[^\n]\n+[^\n]" nil t)))
-      (goto-char (point-min))
-      (while (re-search-forward "[\"\a\b\f\n\r\t\\]" nil t)
-	(cond ((eq (preceding-char) ?\") (replace-match "\\\"" t t))
-	      ((eq (preceding-char) ?\a) (replace-match "\\a" t t))
-	      ((eq (preceding-char) ?\b) (replace-match "\\b" t t))
-	      ((eq (preceding-char) ?\f) (replace-match "\\f" t t))
-	      ((eq (preceding-char) ?\n)
-	       (replace-match (if (or (not multi-line) (eobp))
-				  "\\n"
-				"\\n\"\n\"")
-			      t t))
-	      ((eq (preceding-char) ?\r) (replace-match "\\r" t t))
-	      ((eq (preceding-char) ?\t) (replace-match "\\t" t t))
-	      ((eq (preceding-char) ?\\) (replace-match "\\\\" t t))))
-      (goto-char (point-min))
-      (if prefix (insert prefix " "))
-      (insert (if multi-line "\"\"\n\"" "\""))
-      (goto-char (point-max))
-      (insert "\"")
-      (if prefix (insert "\n"))
-      (if obsolete
-	  (progn
-	    (goto-char (point-min))
-	    (while (not (eobp))
-	      (or (eq (following-char) ?\n) (insert "#~ "))
-	      (search-forward "\n"))))
-      (buffer-string))))
-
-(defun po-get-msgid (kill)
-  "Extract and return the unquoted msgid string.
-If KILL, then add the unquoted string to the kill ring."
-  (let ((string (po-extract-unquoted (current-buffer)
-				     po-start-of-msgid po-start-of-msgstr)))
-    (if kill (po-kill-new string))
-    string))
-
-(defun po-get-msgstr (kill)
-  "Extract and return the unquoted msgstr string.
-If KILL, then add the unquoted string to the kill ring."
-  (let ((string (po-extract-unquoted (current-buffer)
-				     po-start-of-msgstr po-end-of-entry)))
-    (if kill (po-kill-new string))
-    string))
-
-(defun po-set-msgid (form)
-  "Replace the current msgid, using FORM to get a string.
-Evaluating FORM should insert the wanted string in the current buffer.  If
-FORM is itself a string, then this string is used for insertion.  The string
-is properly requoted before the replacement occurs.
-
-Returns 'nil' if the buffer has not been modified, for if the new msgid
-described by FORM is merely identical to the msgid already in place."
-  (let ((string (po-eval-requoted form "msgid" (eq po-entry-type 'obsolete))))
-    (save-excursion
-      (goto-char po-start-of-entry)
-      (re-search-forward po-any-msgid-regexp po-start-of-msgstr)
-      (and (not (string-equal (po-match-string 0) string))
-	   (let ((buffer-read-only po-read-only))
-	     (replace-match string t t)
-	     (goto-char po-start-of-msgid)
-	     (po-find-span-of-entry)
-	     t)))))
-
-(defun po-set-msgstr (form)
-  "Replace the current msgstr or msgstr[], using FORM to get a string.
-Evaluating FORM should insert the wanted string in the current buffer.  If
-FORM is itself a string, then this string is used for insertion.  The string
-is properly requoted before the replacement occurs.
-
-Returns 'nil' if the buffer has not been modified, for if the new msgstr
-described by FORM is merely identical to the msgstr already in place."
-  (let ((string (po-eval-requoted form "msgstr" (eq po-entry-type 'obsolete)))
-        (msgstr-idx nil))
-    (save-excursion
-      (goto-char po-start-of-entry)
-      (save-excursion                   ; check for an indexed msgstr
-        (if (re-search-forward po-msgstr-idx-keyword-regexp
-			       po-end-of-entry t)
-	    (setq msgstr-idx (buffer-substring-no-properties
-			      (match-beginning 0) (match-end 0)))))
-      (re-search-forward po-any-msgstr-regexp po-end-of-entry)
-      (and (not (string-equal (po-match-string 0) string))
-	   (let ((buffer-read-only po-read-only))
-	     (po-decrease-type-counter)
-	     (replace-match string t t)
-             (goto-char (match-beginning 0))
-             (if (eq msgstr-idx nil) ; hack: replace msgstr with msgstr[d]
-		 nil
-	       (insert msgstr-idx)
-	       (looking-at "\\(#~[ \t]*\\)?msgstr")
-	       (replace-match ""))
-	     (goto-char po-start-of-msgid)
-	     (po-find-span-of-entry)
-	     (po-increase-type-counter)
-	     t)))))
-
-(defun po-kill-ring-save-msgstr ()
-  "Push the msgstr string from current entry on the kill ring."
-  (interactive)
-  (po-find-span-of-entry)
-  (po-get-msgstr t))
-
-(defun po-kill-msgstr ()
-  "Empty the msgstr string from current entry, pushing it on the kill ring."
-  (interactive)
-  (po-kill-ring-save-msgstr)
-  (po-set-msgstr ""))
-
-(defun po-yank-msgstr ()
-  "Replace the current msgstr string by the top of the kill ring."
-  (interactive)
-  (po-find-span-of-entry)
-  (po-set-msgstr (if (eq last-command 'yank) '(yank-pop 1) '(yank)))
-  (setq this-command 'yank))
-
-(defun po-fade-out-entry ()
-  "Mark an active entry as fuzzy; obsolete a fuzzy or untranslated entry;
-or completely delete an obsolete entry, saving its msgstr on the kill ring."
-  (interactive)
-  (po-find-span-of-entry)
-
-  (cond ((eq po-entry-type 'translated)
-	 (po-decrease-type-counter)
-	 (po-add-attribute "fuzzy")
-	 (po-current-entry)
-	 (po-increase-type-counter))
-
-	((or (eq po-entry-type 'fuzzy)
-	     (eq po-entry-type 'untranslated))
-	 (if (y-or-n-p (_"Should I really obsolete this entry? "))
-	     (progn
-	       (po-decrease-type-counter)
-	       (save-excursion
-		 (save-restriction
-		   (narrow-to-region po-start-of-entry po-end-of-entry)
-		   (let ((buffer-read-only po-read-only))
-		     (goto-char (point-min))
-		     (skip-chars-forward "\n")
-		     (while (not (eobp))
-		       (insert "#~ ")
-		       (search-forward "\n")))))
-	       (po-current-entry)
-	       (po-increase-type-counter)))
-	 (message ""))
-
-	((and (eq po-entry-type 'obsolete)
-	      (po-check-for-pending-edit po-start-of-msgid)
-	      (po-check-for-pending-edit po-start-of-msgstr))
-	 (po-decrease-type-counter)
-	 (po-update-mode-line-string)
-	 (po-get-msgstr t)
-	 (let ((buffer-read-only po-read-only))
-	   (delete-region po-start-of-entry po-end-of-entry))
-	 (goto-char po-start-of-entry)
-	 (if (re-search-forward po-any-msgstr-regexp nil t)
-	     (goto-char (match-beginning 0))
-	   (re-search-backward po-any-msgstr-regexp nil t))
-	 (po-current-entry)
-	 (message ""))))
-
-;;; Killing and yanking comments.
-
-(defvar po-active-comment-regexp
-  "^\\(#\n\\|# .*\n\\)+"
-  "Regexp matching the whole editable comment part of an active entry.")
-
-(defvar po-obsolete-comment-regexp
-  "^\\(#~ #\n\\|#~ # .*\n\\)+"
-  "Regexp matching the whole editable comment part of an obsolete entry.")
-
-(defun po-get-comment (kill-flag)
-  "Extract and return the editable comment string, uncommented.
-If KILL-FLAG, then add the unquoted comment to the kill ring."
-  (let ((buffer (current-buffer))
-	(obsolete (eq po-entry-type 'obsolete)))
-    (save-excursion
-      (goto-char po-start-of-entry)
-      (if (re-search-forward (if obsolete po-obsolete-comment-regexp
-			         po-active-comment-regexp)
-			     po-end-of-entry t)
-	  (po-with-temp-buffer
-	    (insert-buffer-substring buffer (match-beginning 0) (match-end 0))
-	    (goto-char (point-min))
-	    (while (not (eobp))
-	      (if (looking-at (if obsolete "#~ # ?" "# ?"))
-		  (replace-match "" t t))
-	      (forward-line 1))
-	    (and kill-flag (copy-region-as-kill (point-min) (point-max)))
-	    (buffer-string))
-	""))))
-
-(defun po-set-comment (form)
-  "Using FORM to get a string, replace the current editable comment.
-Evaluating FORM should insert the wanted string in the current buffer.
-If FORM is itself a string, then this string is used for insertion.
-The string is properly recommented before the replacement occurs."
-  (let ((obsolete (eq po-entry-type 'obsolete))
-	string)
-    (po-with-temp-buffer
-      (if (stringp form)
-	  (insert form)
-	(push-mark)
-	(eval form))
-      (if (not (or (bobp) (= (preceding-char) ?\n)))
-	  (insert "\n"))
-      (goto-char (point-min))
-      (while (not (eobp))
-	(insert (if (= (following-char) ?\n)
-		    (if obsolete "#~ #" "#")
-		  (if obsolete "#~ # " "# ")))
-	(search-forward "\n"))
-      (setq string (buffer-string)))
-    (goto-char po-start-of-entry)
-    (if (re-search-forward
-	 (if obsolete po-obsolete-comment-regexp po-active-comment-regexp)
-	 po-end-of-entry t)
-	(if (not (string-equal (po-match-string 0) string))
-	    (let ((buffer-read-only po-read-only))
-	      (replace-match string t t)))
-      (skip-chars-forward " \t\n")
-      (let ((buffer-read-only po-read-only))
-	(insert string))))
-  (po-current-entry))
-
-(defun po-kill-ring-save-comment ()
-  "Push the msgstr string from current entry on the kill ring."
-  (interactive)
-  (po-find-span-of-entry)
-  (po-get-comment t))
-
-(defun po-kill-comment ()
-  "Empty the msgstr string from current entry, pushing it on the kill ring."
-  (interactive)
-  (po-kill-ring-save-comment)
-  (po-set-comment "")
-  (po-redisplay))
-
-(defun po-yank-comment ()
-  "Replace the current comment string by the top of the kill ring."
-  (interactive)
-  (po-find-span-of-entry)
-  (po-set-comment (if (eq last-command 'yank) '(yank-pop 1) '(yank)))
-  (setq this-command 'yank)
-  (po-redisplay))
-
-;;; Editing management and submode.
-
-;; In a string edit buffer, BACK-POINTER points to one of the slots of the
-;; list EDITED-FIELDS kept in the PO buffer.  See its description elsewhere.
-;; Reminder: slots have the form (ENTRY-MARKER EDIT-BUFFER OVERLAY-INFO).
-
-(defvar po-subedit-back-pointer)
-
-(defun po-clean-out-killed-edits ()
-  "From EDITED-FIELDS, clean out any edit having a killed edit buffer."
-  (let ((cursor po-edited-fields))
-    (while cursor
-      (let ((slot (car cursor)))
-	(setq cursor (cdr cursor))
-	(if (buffer-name (nth 1 slot))
-	    nil
-	  (let ((overlay (nth 2 slot)))
-	    (and overlay (po-dehighlight overlay)))
-	  (setq po-edited-fields (delete slot po-edited-fields)))))))
-
-(defun po-check-all-pending-edits ()
-  "Resume any pending edit.  Return nil if some remains."
-  (po-clean-out-killed-edits)
-  (or (null po-edited-fields)
-      (let ((slot (car po-edited-fields)))
-	(goto-char (nth 0 slot))
-	(pop-to-buffer (nth 1 slot))
-	(let ((overlay (nth 2 slot)))
-	  (and overlay (po-rehighlight overlay)))
-	(message po-subedit-message)
-	nil)))
-
-(defun po-check-for-pending-edit (position)
-  "Resume any pending edit at POSITION.  Return nil if such edit exists."
-  (po-clean-out-killed-edits)
-  (let ((marker (make-marker)))
-    (set-marker marker position)
-    (let ((slot (assoc marker po-edited-fields)))
-      (if slot
-	  (progn
-	    (goto-char marker)
-	    (pop-to-buffer (nth 1 slot))
-	    (let ((overlay (nth 2 slot)))
-	      (and overlay (po-rehighlight overlay)))
-	    (message po-subedit-message)))
-      (not slot))))
-
-(defun po-edit-out-full ()
-  "Get out of PO mode, leaving PO file buffer in fundamental mode."
-  (interactive)
-  (if (and (po-check-all-pending-edits)
-	   (yes-or-no-p (_"Should I let you edit the whole PO file? ")))
-      (progn
-	(setq buffer-read-only po-read-only)
-	(fundamental-mode)
-	(message (_"Type 'M-x po-mode RET' once done")))))
-
-(defun po-ediff-quit ()
-  "Quit ediff and exit `recursive-edit'."
-  (interactive)
-  (ediff-quit t)
-  (exit-recursive-edit))
-
-(add-hook 'ediff-keymap-setup-hook
-	  '(lambda ()
-	     (define-key ediff-mode-map "Q" 'po-ediff-quit)))
-
-(defun po-ediff-buffers-exit-recursive (b1 b2 oldbuf end)
-  "Ediff buffer B1 and B2, pop back to OLDBUF and replace the old variants.
-This function will delete the first two variants in OLDBUF, call
-`ediff-buffers' to compare both strings and replace the two variants in
-OLDBUF with the contents of B2.
-Once done kill B1 and B2.
-
-For more info cf. `po-subedit-ediff'."
-  (ediff-buffers b1 b2)
-  (recursive-edit)
-  (pop-to-buffer oldbuf)
-  (delete-region (point-min) end)
-  (insert-buffer b2)
-  (mapc 'kill-buffer `(,b1 ,b2))
-  (display-buffer entry-buffer t))
-
-(defun po-subedit-ediff ()
-  "Edit the subedit buffer using `ediff'.
-`po-subedit-ediff' calls `po-ediff-buffers-exit-recursive' to edit translation
-variants side by side if they are actually different; if variants are equal just
-delete the first one.
-
-`msgcat' is able to produce those variants; every variant is marked with:
-
-#-#-#-#-#  file name reference  #-#-#-#-#
-
-Put changes in second buffer.
-
-When done with the `ediff' session press \\[exit-recursive-edit] exit to
-`recursive-edit', or call \\[po-ediff-quit] (`Q') in the ediff control panel."
-  (interactive)
-  (let* ((marker-regex "^#-#-#-#-#  \\(.*\\)  #-#-#-#-#\n")
-	 (buf1 " *po-msgstr-1") ; default if first marker is missing
-	 buf2 start-1 end-1 start-2 end-2
-	 (back-pointer po-subedit-back-pointer)
-	 (entry-marker (nth 0 back-pointer))
-	 (entry-buffer (marker-buffer entry-marker)))
-    (goto-char (point-min))
-    (if (looking-at marker-regex)
-	(and (setq buf1 (match-string-no-properties 1))
-	     (forward-line 1)))
-    (setq start-1 (point))
-    (if (not (re-search-forward marker-regex (point-max) t))
-	(error "Only 1 msgstr found")
-      (setq buf2 (match-string-no-properties 1)
-	    end-1 (match-beginning 0))
-      (let ((oldbuf (current-buffer)))
-	(save-current-buffer
-	  (set-buffer (get-buffer-create
-		       (generate-new-buffer-name buf1)))
-	  (setq buffer-read-only nil)
-	  (erase-buffer)
-	  (insert-buffer-substring oldbuf start-1 end-1)
-	  (setq buffer-read-only t))
-	
-	(setq start-2 (point))
-	(save-excursion
-	  ;; check for a third variant; if found ignore it
-	  (if (re-search-forward marker-regex (point-max) t)
-	      (setq end-2 (match-beginning 0))
-	    (setq end-2 (goto-char (1- (point-max))))))
-	(save-current-buffer
-	  (set-buffer (get-buffer-create
-		       (generate-new-buffer-name buf2)))
-	  (erase-buffer)
-	  (insert-buffer-substring oldbuf start-2 end-2))
-
-	(if (not (string-equal (buffer-substring-no-properties start-1 end-1)
-			       (buffer-substring-no-properties start-2 end-2)))
-	    (po-ediff-buffers-exit-recursive buf1 buf2 oldbuf end-2)
-	  (message "Variants are equal; delete %s" buf1)
-	  (forward-line -1)
-	  (delete-region (point-min) (point)))))))
-
-(defun po-subedit-abort ()
-  "Exit the subedit buffer, merely discarding its contents."
-  (interactive)
-  (let* ((edit-buffer (current-buffer))
-	 (back-pointer po-subedit-back-pointer)
-	 (entry-marker (nth 0 back-pointer))
-	 (overlay-info (nth 2 back-pointer))
-	 (entry-buffer (marker-buffer entry-marker)))
-    (if (null entry-buffer)
-	(error (_"Corresponding PO buffer does not exist anymore"))
-      (or (one-window-p) (delete-window))
-      (switch-to-buffer entry-buffer)
-      (goto-char entry-marker)
-      (and overlay-info (po-dehighlight overlay-info))
-      (kill-buffer edit-buffer)
-      (setq po-edited-fields (delete back-pointer po-edited-fields)))))
-
-(defun po-subedit-exit ()
-  "Exit the subedit buffer, replacing the string in the PO buffer."
-  (interactive)
-  (goto-char (point-max))
-  (skip-chars-backward " \t\n")
-  (if (eq (preceding-char) ?<)
-      (delete-region (1- (point)) (point-max)))
-  (run-hooks 'po-subedit-exit-hook)
-  (let ((string (buffer-string)))
-    (po-subedit-abort)
-    (po-find-span-of-entry)
-    (cond ((= (point) po-start-of-msgid)
-	   (po-set-comment string)
-	   (po-redisplay))
-	  ((= (point) po-start-of-msgstr)
-	   (let ((replaced (po-set-msgstr string)))
-	     (if (and replaced
-		      po-auto-fuzzy-on-edit
-		      (eq po-entry-type 'translated))
-		 (progn
-		   (po-decrease-type-counter)
-		   (po-add-attribute "fuzzy")
-		   (po-current-entry)
-		   (po-increase-type-counter)))))
-	  (t (debug)))))
-
-(defun po-edit-string (string type expand-tabs)
-  "Prepare a pop up buffer for editing STRING, which is of a given TYPE.
-TYPE may be 'comment or 'msgstr.  If EXPAND-TABS, expand tabs to spaces.
-Run functions on po-subedit-mode-hook."
-  (let ((marker (make-marker)))
-    (set-marker marker (cond ((eq type 'comment) po-start-of-msgid)
-			     ((eq type 'msgstr) po-start-of-msgstr)))
-    (if (po-check-for-pending-edit marker)
-	(let ((edit-buffer (generate-new-buffer
-			    (concat "*" (buffer-name) "*")))
-	      (edit-coding buffer-file-coding-system)
-	      (buffer (current-buffer))
-	      overlay slot)
-	  (if (and (eq type 'msgstr) po-highlighting)
-	      ;; ;; Try showing all of msgid in the upper window while editing.
-	      ;; (goto-char (1- po-start-of-msgstr))
-	      ;; (recenter -1)
-	      (save-excursion
-		(goto-char po-start-of-entry)
-		(re-search-forward po-any-msgid-regexp nil t)
-		(let ((end (1- (match-end 0))))
-		  (goto-char (match-beginning 0))
-		  (re-search-forward "msgid +" nil t)
-		  (setq overlay (po-create-overlay))
-		  (po-highlight overlay (point) end buffer))))
-	  (setq slot (list marker edit-buffer overlay)
-		po-edited-fields (cons slot po-edited-fields))
-	  (pop-to-buffer edit-buffer)
-	  (set (make-local-variable 'po-subedit-back-pointer) slot)
-	  (set (make-local-variable 'indent-line-function)
-	       'indent-relative)
-	  (setq buffer-file-coding-system edit-coding)
-	  (setq local-abbrev-table po-mode-abbrev-table)
-	  (erase-buffer)
-	  (insert string "<")
-	  (goto-char (point-min))
-	  (and expand-tabs (setq indent-tabs-mode nil))
-	  (use-local-map po-subedit-mode-map)
-	  (if (fboundp 'easy-menu-define)
-	      (progn
-		(easy-menu-define po-subedit-mode-menu po-subedit-mode-map ""
-		  po-subedit-mode-menu-layout)
-		(and po-XEMACS (easy-menu-add po-subedit-mode-menu))))
-	  (set-syntax-table po-subedit-mode-syntax-table)
-	  (run-hooks 'po-subedit-mode-hook)
-	  (message po-subedit-message)))))
-
-(defun po-edit-comment ()
-  "Use another window to edit the current translator comment."
-  (interactive)
-  (po-find-span-of-entry)
-  (po-edit-string (po-get-comment nil) 'comment nil))
-  
-(defun po-edit-comment-and-ediff ()
-  "Use `ediff' to edit the current translator comment.
-This function calls `po-edit-msgstr' and `po-subedit-ediff'; for more info
-read `po-subedit-ediff' documentation."
-  (interactive)
-  (po-edit-comment)
-  (po-subedit-ediff))
-
-(defun po-edit-msgstr ()
-  "Use another window to edit the current msgstr."
-  (interactive)
-  (po-find-span-of-entry)
-  (po-edit-string (if (and po-auto-edit-with-msgid
-			   (eq po-entry-type 'untranslated))
-		      (po-get-msgid nil)
-		    (po-get-msgstr nil))
-		  'msgstr
-		  t))
-
-(defun po-edit-msgstr-and-ediff ()
-  "Use `ediff' to edit the current msgstr.
-This function calls `po-edit-msgstr' and `po-subedit-ediff'; for more info
-read `po-subedit-ediff' documentation."
-  (interactive)
-  (po-edit-msgstr)
-  (po-subedit-ediff))
-
-;;; String normalization and searching.
-
-(defun po-normalize-old-style (explain)
-  "Normalize old gettext style fields using K&R C multiline string syntax.
-To minibuffer messages sent while normalizing, add the EXPLAIN string."
-  (let ((here (point-marker))
-	(counter 0)
-	(buffer-read-only po-read-only))
-    (goto-char (point-min))
-    (message (_"Normalizing %d, %s") counter explain)
-    (while (re-search-forward
-	    "\\(^#?[ \t]*msg\\(id\\|str\\)[ \t]*\"\\|[^\" \t][ \t]*\\)\\\\\n"
-	    nil t)
-      (if (= (% counter 10) 0)
-	  (message (_"Normalizing %d, %s") counter explain))
-      (replace-match "\\1\"\n\"" t nil)
-      (setq counter (1+ counter)))
-    (goto-char here)
-    (message (_"Normalizing %d...done") counter)))
-
-(defun po-normalize-field (field explain)
-  "Normalize FIELD of all entries.  FIELD is either the symbol msgid or msgstr.
-To minibuffer messages sent while normalizing, add the EXPLAIN string."
-  (let ((here (point-marker))
-	(counter 0))
-    (goto-char (point-min))
-    (while (re-search-forward po-any-msgstr-regexp nil t)
-      (if (= (% counter 10) 0)
-	  (message (_"Normalizing %d, %s") counter explain))
-      (goto-char (match-beginning 0))
-      (po-find-span-of-entry)
-      (cond ((eq field 'msgid) (po-set-msgid (po-get-msgid nil)))
-	    ((eq field 'msgstr) (po-set-msgstr (po-get-msgstr nil))))
-      (goto-char po-end-of-entry)
-      (setq counter (1+ counter)))
-    (goto-char here)
-    (message (_"Normalizing %d...done") counter)))
-
-;; Normalize, but the British way! :-)
-(defsubst po-normalise () (po-normalize))
-
-(defun po-normalize ()
-  "Normalize all entries in the PO file."
-  (interactive)
-  (po-normalize-old-style (_"pass 1/3"))
-  (po-normalize-field t (_"pass 2/3"))
-  (po-normalize-field nil (_"pass 3/3"))
-  ;; The last PO file entry has just been processed.
-  (if (not (= po-end-of-entry (point-max)))
-      (let ((buffer-read-only po-read-only))
-	(kill-region po-end-of-entry (point-max))))
-  ;; A bizarre format might have fooled the counters, so recompute
-  ;; them to make sure their value is dependable.
-  (po-compute-counters nil))
-
-;;; Multiple PO files.
-
-(defun po-show-auxiliary-list ()
-  "Echo the current auxiliary list in the message area."
-  (if po-auxiliary-list
-      (let ((cursor po-auxiliary-cursor)
-	    string)
-	(while cursor
-	  (setq string (concat string (if string " ") (car (car cursor)))
-		cursor (cdr cursor)))
-	(setq cursor po-auxiliary-list)
-	(while (not (eq cursor po-auxiliary-cursor))
-	  (setq string (concat string (if string " ") (car (car cursor)))
-		cursor (cdr cursor)))
-	(message string))
-    (message (_"No auxiliary files."))))
-
-(defun po-consider-as-auxiliary ()
-  "Add the current PO file to the list of auxiliary files."
-  (interactive)
-  (if (member (list buffer-file-name) po-auxiliary-list)
-      nil
-    (setq po-auxiliary-list
-	  (nconc po-auxiliary-list (list (list buffer-file-name))))
-    (or po-auxiliary-cursor
-	(setq po-auxiliary-cursor po-auxiliary-list)))
-  (po-show-auxiliary-list))
-
-(defun po-ignore-as-auxiliary ()
-  "Delete the current PO file from the list of auxiliary files."
-  (interactive)
-  (setq po-auxiliary-list (delete (list buffer-file-name) po-auxiliary-list)
-	po-auxiliary-cursor po-auxiliary-list)
-  (po-show-auxiliary-list))
-
-(defun po-seek-equivalent-translation (name string)
-  "Search a PO file NAME for a 'msgid' STRING having a non-empty 'msgstr'.
-STRING is the full quoted msgid field, including the 'msgid' keyword.  When
-found, display the file over the current window, with the 'msgstr' field
-possibly highlighted, the cursor at start of msgid, then return 't'.
-Otherwise, move nothing, and just return 'nil'."
-  (let ((current (current-buffer))
-	(buffer (find-file-noselect name)))
-    (set-buffer buffer)
-    (let ((start (point))
-	  found)
-      (goto-char (point-min))
-      (while (and (not found) (search-forward string nil t))
-	;; Screen out longer 'msgid's.
-	(if (looking-at "^msgstr ")
-	    (progn
-	      (po-find-span-of-entry)
-	      ;; Ignore an untranslated entry.
-	      (or (string-equal
-		   (buffer-substring po-start-of-msgstr po-end-of-entry)
-		   "msgstr \"\"\n")
-		  (setq found t)))))
-      (if found
-	  (progn
-	    (switch-to-buffer buffer)
-	    (po-find-span-of-entry)
-	    (if po-highlighting
-		(progn
-		  (goto-char po-start-of-entry)
-		  (re-search-forward po-any-msgstr-regexp nil t)
-		  (let ((end (1- (match-end 0))))
-		    (goto-char (match-beginning 0))
-		    (re-search-forward "msgstr +" nil t)
-		    ;; Just "borrow" the marking overlay.
-		    (po-highlight po-marking-overlay (point) end))))
-	    (goto-char po-start-of-msgid))
-	(goto-char start)
-	(po-find-span-of-entry)
-	(set-buffer current))
-      found)))
-
-(defun po-cycle-auxiliary ()
-  "Select the next auxiliary file having an entry with same 'msgid'."
-  (interactive)
-  (po-find-span-of-entry)
-  (if po-auxiliary-list
-      (let ((string (buffer-substring po-start-of-msgid po-start-of-msgstr))
-	    (cursor po-auxiliary-cursor)
-	    found name)
-	(while (and (not found) cursor)
-	  (setq name (car (car cursor)))
-	  (if (and (not (string-equal buffer-file-name name))
-		   (po-seek-equivalent-translation name string))
-	      (setq found t
-		    po-auxiliary-cursor cursor))
-	  (setq cursor (cdr cursor)))
-	(setq cursor po-auxiliary-list)
-	(while (and (not found) cursor)
-	  (setq name (car (car cursor)))
-	  (if (and (not (string-equal buffer-file-name name))
-		   (po-seek-equivalent-translation name string))
-	      (setq found t
-		    po-auxiliary-cursor cursor))
-	  (setq cursor (cdr cursor)))
-	(or found (message (_"No other translation found")))
-        found)))
-
-(defun po-subedit-cycle-auxiliary ()
-  "Cycle auxiliary file, but from the translation edit buffer."
-  (interactive)
-  (let* ((entry-marker (nth 0 po-subedit-back-pointer))
-	 (entry-buffer (marker-buffer entry-marker))
-	 (buffer (current-buffer)))
-    (pop-to-buffer entry-buffer)
-    (po-cycle-auxiliary)
-    (pop-to-buffer buffer)))
-
-(defun po-select-auxiliary ()
-  "Select one of the available auxiliary files and locate an equivalent entry.
-If an entry having the same 'msgid' cannot be found, merely select the file
-without moving its cursor."
-  (interactive)
-  (po-find-span-of-entry)
-  (if po-auxiliary-list
-      (let ((string (buffer-substring po-start-of-msgid po-start-of-msgstr))
-	    (name (car (assoc (completing-read (_"Which auxiliary file? ")
-					       po-auxiliary-list nil t)
-			      po-auxiliary-list))))
-	(po-consider-as-auxiliary)
-	(or (po-seek-equivalent-translation name string)
-	    (find-file name)))))
-
-;;; Original program sources as context.
-
-(defun po-show-source-path ()
-  "Echo the current source search path in the message area."
-  (if po-search-path
-      (let ((cursor po-search-path)
-	    string)
-	(while cursor
-	  (setq string (concat string (if string " ") (car (car cursor)))
-		cursor (cdr cursor)))
-	(message string))
-    (message (_"Empty source path."))))
-
-(defun po-consider-source-path (directory)
-  "Add a given DIRECTORY, requested interactively, to the source search path."
-  (interactive "DDirectory for search path: ")
-  (setq po-search-path (cons (list (if (string-match "/$" directory)
-					 directory
-				       (concat directory "/")))
-			     po-search-path))
-  (setq po-reference-check 0)
-  (po-show-source-path))
-
-(defun po-ignore-source-path ()
-  "Delete a directory, selected with completion, from the source search path."
-  (interactive)
-  (setq po-search-path
-	(delete (list (completing-read (_"Directory to remove? ")
-				       po-search-path nil t))
-		po-search-path))
-  (setq po-reference-check 0)
-  (po-show-source-path))
-
-(defun po-ensure-source-references ()
-  "Extract all references into a list, with paths resolved, if necessary."
-  (po-find-span-of-entry)
-  (if (= po-start-of-entry po-reference-check)
-      nil
-    (setq po-reference-alist nil)
-    (save-excursion
-      (goto-char po-start-of-entry)
-      (if (re-search-forward "^#:" po-start-of-msgid t)
-	  (let (current name line path file)
-	    (while (looking-at "\\(\n#:\\)? *\\([^: ]*\\):\\([0-9]+\\)")
-	      (goto-char (match-end 0))
-	      (setq name (po-match-string 2)
-		    line (po-match-string 3)
-		    path po-search-path)
-	      (if (string-equal name "")
-		  nil
-		(while (and (not (file-exists-p
-				  (setq file (concat (car (car path)) name))))
-			    path)
-		  (setq path (cdr path)))
-		(setq current (and path file)))
-	      (if current
-		  (setq po-reference-alist
-			(cons (list (concat current ":" line)
-				    current
-				    (string-to-number line))
-			      po-reference-alist)))))))
-    (setq po-reference-alist (nreverse po-reference-alist)
-	  po-reference-cursor po-reference-alist
-	  po-reference-check po-start-of-entry)))
-
-(defun po-show-source-context (triplet)
-  "Show the source context given a TRIPLET which is (PROMPT FILE LINE)."
-  (find-file-other-window (car (cdr triplet)))
-  (goto-line (car (cdr (cdr triplet))))
-  (other-window 1)
-  (let ((maximum 0)
-	position
-	(cursor po-reference-alist))
-    (while (not (eq triplet (car cursor)))
-      (setq maximum (1+ maximum)
-	    cursor (cdr cursor)))
-    (setq position (1+ maximum)
-	  po-reference-cursor cursor)
-    (while cursor
-      (setq maximum (1+ maximum)
-	    cursor (cdr cursor)))
-    (message (_"Displaying %d/%d: \"%s\"") position maximum (car triplet))))
-
-(defun po-cycle-source-reference ()
-  "Display some source context for the current entry.
-If the command is repeated many times in a row, cycle through contexts."
-  (interactive)
-  (po-ensure-source-references)
-  (if po-reference-cursor
-      (po-show-source-context
-       (car (if (eq last-command 'po-cycle-source-reference)
-		(or (cdr po-reference-cursor) po-reference-alist)
-	      po-reference-cursor)))
-    (error (_"No resolved source references"))))
-
-(defun po-select-source-reference ()
-  "Select one of the available source contexts for the current entry."
-  (interactive)
-  (po-ensure-source-references)
-  (if po-reference-alist
-      (po-show-source-context
-       (assoc
-	(completing-read (_"Which source context? ") po-reference-alist nil t)
-	po-reference-alist))
-    (error (_"No resolved source references"))))
-
-;;; String marking in program sources, through TAGS table.
-
-;; Globally defined within tags.el.
-(defvar tags-loop-operate)
-(defvar tags-loop-scan)
-
-;; Locally set in each program source buffer.
-(defvar po-find-string-function)
-(defvar po-mark-string-function)
-
-;; Dynamically set within po-tags-search for po-tags-loop-operate.
-(defvar po-current-po-buffer)
-(defvar po-current-po-keywords)
-
-(defun po-tags-search (restart)
-  "Find an unmarked translatable string through all files in tags table.
-Disregard some simple strings which are most probably non-translatable.
-With prefix argument, restart search at first file."
-  (interactive "P")
-  (require 'etags)
-  ;; Ensure there is no highlighting, in case the search fails.
-  (if po-highlighting
-      (po-dehighlight po-marking-overlay))
-  (setq po-string-contents nil)
-  ;; Search for a string which might later be marked for translation.
-  (let ((po-current-po-buffer (current-buffer))
-	(po-current-po-keywords po-keywords))
-    (pop-to-buffer po-string-buffer)
-    (if (and (not restart)
-	     (eq (car tags-loop-operate) 'po-tags-loop-operate))
-	;; Continue last po-tags-search.
-	(tags-loop-continue nil)
-      ;; Start or restart po-tags-search all over.
-      (setq tags-loop-scan '(po-tags-loop-scan)
-	    tags-loop-operate '(po-tags-loop-operate))
-      (tags-loop-continue t))
-    (select-window (get-buffer-window po-current-po-buffer)))
-  (if po-string-contents
-      (let ((window (selected-window))
-	    (buffer po-string-buffer)
-	    (start po-string-start)
-	    (end po-string-end))
-	;; Try to fit the string in the displayed part of its window.
-	(select-window (get-buffer-window buffer))
-	(goto-char start)
-	(or (pos-visible-in-window-p start)
-	    (recenter '(nil)))
-	(if (pos-visible-in-window-p end)
-	    (goto-char end)
-	  (goto-char end)
-	  (recenter -1))
-	(select-window window)
-	;; Highlight the string as found.
-	(and po-highlighting
-	     (po-highlight po-marking-overlay start end buffer)))))
-
-(defun po-tags-loop-scan ()
-  "Decide if the current buffer is still interesting for PO mode strings."
-  ;; We have little choice, here.  The major mode is needed to dispatch to the
-  ;; proper scanner, so we declare all files as interesting, to force Emacs
-  ;; tags module to revisit files fully.  po-tags-loop-operate sets point at
-  ;; end of buffer when it is done with a file.
-  (not (eobp)))
-
-(defun po-tags-loop-operate ()
-  "Find an acceptable tag in the current buffer, according to mode.
-Disregard some simple strings which are most probably non-translatable."
-  (po-preset-string-functions)
-  (let ((continue t)
-	data)
-    (while continue
-      (setq data (apply po-find-string-function po-current-po-keywords nil))
-      (if data
-	  ;; Push the string just found into a work buffer for study.
-	  (po-with-temp-buffer
-	   (insert (nth 0 data))
-	   (goto-char (point-min))
-	   ;; Accept if at least three letters in a row.
-	   (if (re-search-forward "[A-Za-z][A-Za-z][A-Za-z]" nil t)
-	       (setq continue nil)
-	     ;; Disregard if single letters or no letters at all.
-	     (if (re-search-forward "[A-Za-z][A-Za-z]" nil t)
-		 ;; Here, we have two letters in a row, but never more.
-		 ;; Accept only if more letters than punctuations.
-		 (let ((total (buffer-size)))
-		   (goto-char (point-min))
-		   (while (re-search-forward "[A-Za-z]+" nil t)
-		     (replace-match "" t t))
-		   (if (< (* 2 (buffer-size)) total)
-		       (setq continue nil))))))
-	;; No string left in this buffer.
-	(setq continue nil)))
-    (if data
-	;; Save information for marking functions.
-	(let ((buffer (current-buffer)))
-	  (save-excursion
-	    (set-buffer po-current-po-buffer)
-	    (setq po-string-contents (nth 0 data)
-		  po-string-buffer buffer
-		  po-string-start (nth 1 data)
-		  po-string-end (nth 2 data))))
-      (goto-char (point-max)))
-    ;; If nothing was found, trigger scanning of next file.
-    (not data)))
-
-(defun po-mark-found-string (keyword)
-  "Mark last found string in program sources as translatable, using KEYWORD."
-  (if (not po-string-contents)
-    (error (_"No such string")))
-  (and po-highlighting (po-dehighlight po-marking-overlay))
-  (let ((contents po-string-contents)
-	(buffer po-string-buffer)
-	(start po-string-start)
-	(end po-string-end)
-	line string)
-    ;; Mark string in program sources.
-    (save-excursion
-      (set-buffer buffer)
-      (setq line (count-lines (point-min) start))
-      (apply po-mark-string-function start end keyword nil))
-    ;; Add PO file entry.
-    (let ((buffer-read-only po-read-only))
-      (goto-char (point-max))
-      (insert "\n" (format "#: %s:%d\n"
-			   (buffer-file-name po-string-buffer)
-			   line))
-      (save-excursion
-	(insert (po-eval-requoted contents "msgid" nil) "msgstr \"\"\n"))
-      (setq po-untranslated-counter (1+ po-untranslated-counter))
-      (po-update-mode-line-string))
-    (setq po-string-contents nil)))
-
-(defun po-mark-translatable ()
-  "Mark last found string in program sources as translatable, using '_'."
-  (interactive)
-  (po-mark-found-string "_"))
-
-(defun po-select-mark-and-mark (arg)
-  "Mark last found string in program sources as translatable, ask for keywoard,
-using completion.  With prefix argument, just ask the name of a preferred
-keyword for subsequent commands, also added to possible completions."
-  (interactive "P")
-  (if arg
-      (let ((keyword (list (read-from-minibuffer (_"Keyword: ")))))
-	(setq po-keywords (cons keyword (delete keyword po-keywords))))
-    (or po-string-contents (error (_"No such string")))
-    (let* ((default (car (car po-keywords)))
-	   (keyword (completing-read (format (_"Mark with keywoard? [%s] ")
-					     default)
-				     po-keywords nil t )))
-      (if (string-equal keyword "") (setq keyword default))
-      (po-mark-found-string keyword))))
-
-;;; Unknown mode specifics.
-
-(defun po-preset-string-functions ()
-  "Preset FIND-STRING-FUNCTION and MARK-STRING-FUNCTION according to mode.
-These variables are locally set in source buffer only when not already bound."
-  (let ((pair (cond ((string-equal mode-name "AWK")
-		     '(po-find-awk-string . po-mark-awk-string))
-		    ((member mode-name '("C" "C++"))
-		     '(po-find-c-string . po-mark-c-string))
-		    ((string-equal mode-name "Emacs-Lisp")
-		     '(po-find-emacs-lisp-string . po-mark-emacs-lisp-string))
-		    ((string-equal mode-name "Python")
-		     '(po-find-python-string . po-mark-python-string))
-		    ((and (string-equal mode-name "Shell-script")
-			  (string-equal mode-line-process "[bash]"))
-		     '(po-find-bash-string . po-mark-bash-string))
-		    (t '(po-find-unknown-string . po-mark-unknown-string)))))
-    (or (boundp 'po-find-string-function)
-	(set (make-local-variable 'po-find-string-function) (car pair)))
-    (or (boundp 'po-mark-string-function)
-	(set (make-local-variable 'po-mark-string-function) (cdr pair)))))
-
-(defun po-find-unknown-string (keywords)
-  "Dummy function to skip over a file, finding no string in it."
-  nil)
-
-(defun po-mark-unknown-string (start end keyword)
-  "Dummy function to mark a given string.  May not be called."
-  (error (_"Dummy function called")))
-
-;;; Awk mode specifics.
-
-(defun po-find-awk-string (keywords)
-  "Find the next Awk string, excluding those marked by any of KEYWORDS.
-Return (CONTENTS START END) for the found string, or nil if none found."
-  (let (start end)
-    (while (and (not start)
-		(re-search-forward "[#/\"]" nil t))
-      (cond ((= (preceding-char) ?#)
-	     ;; Disregard comments.
-	     (or (search-forward "\n" nil t)
-		 (goto-char (point-max))))
-	    ((= (preceding-char) ?/)
-	     ;; Skip regular expressions.
-	     (while (not (= (following-char) ?/))
-	       (skip-chars-forward "^/\\\\")
-	       (if (= (following-char) ?\\) (forward-char 2)))
-	     (forward-char 1))
-	    ;; Else find the end of the string.
-	    (t (setq start (1- (point)))
-	       (while (not (= (following-char) ?\"))
-		 (skip-chars-forward "^\"\\\\")
-		 (if (= (following-char) ?\\) (forward-char 2)))
-	       (forward-char 1)
-	       (setq end (point))
-	       ;; Check before string either for underline, or for keyword
-	       ;; and opening parenthesis.
-	       (save-excursion
-		 (goto-char start)
-		 (cond ((= (preceding-char) ?_)
-			;; Disregard already marked strings.
-			(setq start nil
-			      end nil))
-		       ((= (preceding-char) ?\()
-			(backward-char 1)
-			(let ((end-keyword (point)))
-			  (skip-chars-backward "_A-Za-z0-9")
-			  (if (member (list (po-buffer-substring
-					     (point) end-keyword))
-				      keywords)
-			      ;; Disregard already marked strings.
-			      (setq start nil
-				    end nil)))))))))
-    (and start end
-	 (list (po-extract-unquoted (current-buffer) start end) start end))))
-
-(defun po-mark-awk-string (start end keyword)
-  "Mark the Awk string, from START to END, with KEYWORD.
-Leave point after marked string."
-  (if (string-equal keyword "_")
-      (progn
-	(goto-char start)
-	(insert "_")
-	(goto-char (1+ end)))
-    (goto-char end)
-    (insert ")")
-    (save-excursion
-      (goto-char start)
-      (insert keyword "("))))
-
-;;; Bash mode specifics.
-
-(defun po-find-bash-string (keywords)
-  "Find the next unmarked Bash string.  KEYWORDS are merely ignored.
-Return (CONTENTS START END) for the found string, or nil if none found."
-  (let (start end)
-    (while (and (not start)
-		(re-search-forward "[#'\"]" nil t))
-      (cond ((= (preceding-char) ?#)
-	     ;; Disregard comments.
-	     (or (search-forward "\n" nil t)
-		 (goto-char (point-max))))
-	    ((= (preceding-char) ?')
-	     ;; Skip single quoted strings.
-	     (while (not (= (following-char) ?'))
-	       (skip-chars-forward "^'\\\\")
-	       (if (= (following-char) ?\\) (forward-char 2)))
-	     (forward-char 1))
-	    ;; Else find the end of the double quoted string.
-	    (t (setq start (1- (point)))
-	       (while (not (= (following-char) ?\"))
-		 (skip-chars-forward "^\"\\\\")
-		 (if (= (following-char) ?\\) (forward-char 2)))
-	       (forward-char 1)
-	       (setq end (point))
-	       ;; Check before string for dollar sign.
-	       (save-excursion
-		 (goto-char start)
-		 (if (= (preceding-char) ?$)
-		     ;; Disregard already marked strings.
-		     (setq start nil
-			   end nil))))))
-    (and start end
-	 (list (po-extract-unquoted (current-buffer) start end) start end))))
-
-(defun po-mark-bash-string (start end keyword)
-  "Mark the Bash string, from START to END, with '$'.  KEYWORD is ignored.
-Leave point after marked string."
-  (goto-char start)
-  (insert "$")
-  (goto-char (1+ end)))
-
-;;; C or C++ mode specifics.
-
-;;; A few long string cases (submitted by Ben Pfaff).
-
-;; #define string "This is a long string " \
-;; "that is continued across several lines " \
-;; "in a macro in order to test \\ quoting\\" \
-;; "\\ with goofy strings.\\"
-
-;; char *x = "This is just an ordinary string "
-;; "continued across several lines without needing "
-;; "to use \\ characters at end-of-line.";
-
-;; char *y = "Here is a string continued across \
-;; several lines in the manner that was sanctioned \
-;; in K&R C compilers and still works today, \
-;; even though the method used above is more esthetic.";
-
-;;; End of long string cases.
-
-(defun po-find-c-string (keywords)
-  "Find the next C string, excluding those marked by any of KEYWORDS.
-Returns (CONTENTS START END) for the found string, or nil if none found."
-  (let (start end)
-    (while (and (not start)
-		(re-search-forward "\\([\"']\\|/\\*\\|//\\)" nil t))
-      (cond ((= (preceding-char) ?*)
-	     ;; Disregard comments.
-	     (search-forward "*/"))
-	    ((= (preceding-char) ?/)
-	     ;; Disregard C++ comments.
-	     (end-of-line)
-	     (forward-char 1))
-	    ((= (preceding-char) ?\')
-	     ;; Disregard character constants.
-	     (forward-char (if (= (following-char) ?\\) 3 2)))
-	    ((save-excursion
-	       (beginning-of-line)
-	       (looking-at "^# *\\(include\\|line\\)"))
-	     ;; Disregard lines being #include or #line directives.
-	     (end-of-line))
-	    ;; Else, find the end of the (possibly concatenated) string.
-	    (t (setq start (1- (point))
-		     end nil)
-	       (while (not end)
-		 (cond ((= (following-char) ?\")
-			(if (looking-at "\"[ \t\n\\\\]*\"")
-			    (goto-char (match-end 0))
-			  (forward-char 1)
-			  (setq end (point))))
-		       ((= (following-char) ?\\) (forward-char 2))
-		       (t (skip-chars-forward "^\"\\\\"))))
-	       ;; Check before string for keyword and opening parenthesis.
-	       (goto-char start)
-	       (skip-chars-backward " \n\t")
-	       (if (= (preceding-char) ?\()
-		   (progn
-		     (backward-char 1)
-		     (skip-chars-backward " \n\t")
-		     (let ((end-keyword (point)))
-		       (skip-chars-backward "_A-Za-z0-9")
-		       (if (member (list (po-buffer-substring (point)
-							      end-keyword))
-				   keywords)
-			   ;; Disregard already marked strings.
-			   (progn
-			     (goto-char end)
-			     (setq start nil
-				   end nil))
-			 ;; String found.  Prepare to resume search.
-			 (goto-char end))))
-		 ;; String found.  Prepare to resume search.
-		 (goto-char end)))))
-    ;; Return the found string, if any.
-    (and start end
-	 (list (po-extract-unquoted (current-buffer) start end) start end))))
-
-(defun po-mark-c-string (start end keyword)
-  "Mark the C string, from START to END, with KEYWORD.
-Leave point after marked string."
-  (goto-char end)
-  (insert ")")
-  (save-excursion
-    (goto-char start)
-    (insert keyword)
-    (or (string-equal keyword "_") (insert " "))
-    (insert "(")))
-
-;;; Emacs LISP mode specifics.
-
-(defun po-find-emacs-lisp-string (keywords)
-  "Find the next Emacs LISP string, excluding those marked by any of KEYWORDS.
-Returns (CONTENTS START END) for the found string, or nil if none found."
-  (let (start end)
-    (while (and (not start)
-		(re-search-forward "[;\"?]" nil t))
-      (cond ((= (preceding-char) ?\;)
-	     ;; Disregard comments.
-	     (search-forward "\n"))
-	    ((= (preceding-char) ?\?)
-	     ;; Disregard character constants.
-	     (forward-char (if (= (following-char) ?\\) 2 1)))
-	    ;; Else, find the end of the string.
-	    (t (setq start (1- (point)))
-	       (while (not (= (following-char) ?\"))
-		 (skip-chars-forward "^\"\\\\")
-		 (if (= (following-char) ?\\) (forward-char 2)))
-	       (forward-char 1)
-	       (setq end (point))
-	       ;; Check before string for keyword and opening parenthesis.
-	       (goto-char start)
-	       (skip-chars-backward " \n\t")
-	       (let ((end-keyword (point)))
-		 (skip-chars-backward "-_A-Za-z0-9")
-		 (if (and (= (preceding-char) ?\()
-			  (member (list (po-buffer-substring (point)
-							     end-keyword))
-				  keywords))
-		     ;; Disregard already marked strings.
-		     (progn
-		       (goto-char end)
-		       (setq start nil
-			     end nil)))))))
-    ;; Return the found string, if any.
-    (and start end
-	 (list (po-extract-unquoted (current-buffer) start end) start end))))
-
-(defun po-mark-emacs-lisp-string (start end keyword)
-  "Mark the Emacs LISP string, from START to END, with KEYWORD.
-Leave point after marked string."
-  (goto-char end)
-  (insert ")")
-  (save-excursion
-    (goto-char start)
-    (insert "(" keyword)
-    (or (string-equal keyword "_") (insert " "))))
-
-;;; Python mode specifics.
-
-(defun po-find-python-string (keywords)
-  "Find the next Python string, excluding those marked by any of KEYWORDS.
-Also disregard strings when preceded by an empty string of the other type.
-Returns (CONTENTS START END) for the found string, or nil if none found."
-  (let (contents start end)
-    (while (and (not contents)
-		(re-search-forward "[#\"']" nil t))
-      (forward-char -1)
-      (cond ((= (following-char) ?\#)
-	     ;; Disregard comments.
-	     (search-forward "\n"))
-	    ((looking-at "\"\"'")
-	     ;; Quintuple-quoted string
-	     (po-skip-over-python-string))
-	    ((looking-at "''\"")
-	     ;; Quadruple-quoted string
-	     (po-skip-over-python-string))
-	    (t
-	     ;; Simple-, double-, triple- or sextuple-quoted string.
-	     (if (memq (preceding-char) '(?r ?R))
-		 (forward-char -1))
-	     (setq start (point)
-		   contents (po-skip-over-python-string)
-		   end (point))
-	     (goto-char start)
-	     (skip-chars-backward " \n\t")
-	     (cond ((= (preceding-char) ?\[)
-		    ;; Disregard a string used as a dictionary index.
-		    (setq contents nil))
-		   ((= (preceding-char) ?\()
-		    ;; Isolate the keyword which precedes string.
-		    (backward-char 1)
-		    (skip-chars-backward " \n\t")
-		    (let ((end-keyword (point)))
-		      (skip-chars-backward "_A-Za-z0-9")
-		      (if (member (list (po-buffer-substring (point)
-							     end-keyword))
-				  keywords)
-			  ;; Disregard already marked strings.
-			  (setq contents nil)))))
-	     (goto-char end))))
-    ;; Return the found string, if any.
-    (and contents (list contents start end))))
-
-(defun po-skip-over-python-string ()
-  "Skip over a Python string, possibly made up of many concatenated parts.
-Leave point after string.  Return unquoted overall string contents."
-  (let ((continue t)
-	(contents "")
-	raw start end resume)
-    (while continue
-      (skip-chars-forward " \t\n")	; whitespace
-      (cond ((= (following-char) ?#)	; comment
-	     (setq start nil)
-	     (search-forward "\n"))
-	    ((looking-at "\\\n")	; escaped newline
-	     (setq start nil)
-	     (forward-char 2))
-	    ((looking-at "[rR]?\"\"\"")	; sextuple-quoted string
-	     (setq raw (memq (following-char) '(?r ?R))
-		   start (match-end 0))
-	     (goto-char start)
-	     (search-forward "\"\"\"")
-	     (setq resume (point)
-		   end (- resume 3)))
-	    ((looking-at "[rr]?'''")	; triple-quoted string
-	     (setq raw (memq (following-char) '(?r ?R))
-		   start (match-end 0))
-	     (goto-char start)
-	     (search-forward "'''")
-	     (setq resume (point)
-		   end (- resume 3)))
-	    ((looking-at "[rR]?\"")	; double-quoted string
-	     (setq raw (memq (following-char) '(?r ?R))
-		   start (match-end 0))
-	     (goto-char start)
-	     (while (not (memq (following-char) '(0 ?\")))
-	       (skip-chars-forward "^\"\\\\")
-	       (if (= (following-char) ?\\) (forward-char 2)))
-	     (if (eobp)
-		 (setq contents nil
-		       start nil)
-	       (setq end (point))
-	       (forward-char 1))
-	     (setq resume (point)))
-	    ((looking-at "[rR]?'")	; single-quoted string
-	     (setq raw (memq (following-char) '(?r ?R))
-		   start (match-end 0))
-	     (goto-char start)
-	     (while (not (memq (following-char) '(0 ?\')))
-	       (skip-chars-forward "^'\\\\")
-	       (if (= (following-char) ?\\) (forward-char 2)))
-	     (if (eobp)
-		 (setq contents nil
-		       start nil)
-	       (setq end (point))
-	       (forward-char 1))
-	     (setq resume (point)))
-	    (t				; no string anymore
-	     (setq start nil
-		   continue nil)))
-      (if start
-	  (setq contents (concat contents
-				 (if raw
-				     (buffer-substring start end)
-				   (po-extract-part-unquoted (current-buffer)
-							     start end))))))
-    (goto-char resume)
-    contents))
-
-(defun po-mark-python-string (start end keyword)
-  "Mark the Python string, from START to END, with KEYWORD.
-If KEYWORD is '.', prefix the string with an empty string of the other type.
-Leave point after marked string."
-  (cond ((string-equal keyword ".")
-	 (goto-char end)
-	 (save-excursion
-	   (goto-char start)
-	   (insert (cond ((= (following-char) ?\') "\"\"")
-			 ((= (following-char) ?\") "''")
-			 (t "??")))))
-	(t (goto-char end)
-	   (insert ")")
-	   (save-excursion
-	     (goto-char start)
-	     (insert keyword "(")))))
-
-;;; Miscellaneous features.
-
-(defun po-help ()
-  "Provide an help window for PO mode."
-  (interactive)
-  (po-with-temp-buffer
-   (insert po-help-display-string)
-   (goto-char (point-min))
-   (save-window-excursion
-     (switch-to-buffer (current-buffer))
-     (delete-other-windows)
-     (message (_"Type any character to continue"))
-     (po-read-event))))
-
-(defun po-undo ()
-  "Undo the last change to the PO file."
-  (interactive)
-  (let ((buffer-read-only po-read-only))
-    (undo))
-  (po-compute-counters nil))
-
-(defun po-statistics ()
-  "Say how many entries in each category, and the current position."
-  (interactive)
-  (po-compute-counters t))
-
-(defun po-validate ()
-  "Use 'msgfmt' for validating the current PO file contents."
-  (interactive)
-  (let* ((dev-null
-	  (cond ((boundp 'null-device) null-device) ; since Emacs 20.3
-		((memq system-type '(windows-nt windows-95)) "NUL")
-		(t "/dev/null")))
-	 (compilation-buffer-name-function
-	  (function (lambda (mode-name)
-		      (concat "*" mode-name " validation*"))))
-	 (compile-command (concat po-msgfmt-program
-                                 " --statistics -c -v -o " dev-null " "
-                                 buffer-file-name)))
-    (po-msgfmt-version-check)
-    (compile compile-command)))
-
-(defvar po-msgfmt-version-checked nil)
-(defun po-msgfmt-version-check ()
-  "'msgfmt' from GNU gettext 0.10.36 or greater is required."
-  (po-with-temp-buffer
-    (or
-     ;; Don't bother checking again.
-     po-msgfmt-version-checked
-
-     (and
-      ;; Make sure 'msgfmt' is available.
-      (condition-case nil
-          (call-process po-msgfmt-program
-			nil t nil "--verbose" "--version")
-	(file-error nil))
-
-      ;; Make sure there's a version number in the output:
-      ;; 0.11 or 0.10.36 or 0.11-pre1
-      (progn (goto-char (point-min))
-             (or (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)$")
-                 (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$")
-		 (looking-at ".* \\([0-9]+\\)\\.\\([0-9]+\\)[-_A-Za-z0-9]+$")))
-
-      ;; Make sure the version is recent enough.
-      (>= (string-to-number
-	   (format "%d%03d%03d"
-		   (string-to-number (match-string 1))
-		   (string-to-number (match-string 2))
-		   (string-to-number (or (match-string 3) "0"))))
-	  010036)
-
-      ;; Remember the outcome.
-      (setq po-msgfmt-version-checked t))
-
-     (error (_"'msgfmt' from GNU gettext 0.10.36 or greater is required")))))
-
-(defun po-guess-archive-name ()
-  "Return the ideal file name for this PO file in the central archives."
-  (let ((filename (file-name-nondirectory buffer-file-name))
-	start-of-header end-of-header package version team)
-    (save-excursion
-      ;; Find the PO file header entry.
-      (goto-char (point-min))
-      (re-search-forward po-any-msgstr-regexp)
-      (setq start-of-header (match-beginning 0)
-	    end-of-header (match-end 0))
-      ;; Get the package and version.
-      (goto-char start-of-header)
-      (if (re-search-forward "\n\
-\"Project-Id-Version: \\(GNU \\|Free \\)?\\([^\n ]+\\) \\([^\n ]+\\)\\\\n\"$"
-	   end-of-header t)
-	  (setq package (po-match-string 2)
-		version (po-match-string 3)))
-      (if (or (not package) (string-equal package "PACKAGE")
-	      (not version) (string-equal version "VERSION"))
-	  (error (_"Project-Id-Version field does not have a proper value")))
-      ;; File name version and Project-Id-Version must match
-      (cond (;; A `filename' w/o package and version info at all
-	     (string-match "^[^\\.]*\\.po\\'" filename))
-	    (;; TP Robot compatible `filename': PACKAGE-VERSION.LL.po
-	     (string-match (concat (regexp-quote package)
-				   "-\\(.*\\)\\.[^\\.]*\\.po\\'") filename)
-	     (if (not (equal version (po-match-string 1 filename)))
-		 (error (_"\
-Version mismatch: file name: %s; header: %s.\n\
-Adjust Project-Id-Version field to match file name and try again")
-			(po-match-string 1 filename) version))))
-      ;; Get the team.
-      (if (stringp po-team-name-to-code)
-	  (setq team po-team-name-to-code)
-	(goto-char start-of-header)
-	(if (re-search-forward "\n\
-\"Language-Team: \\([^ ].*[^ ]\\) <.+@.+>\\\\n\"$"
-			       end-of-header t)
-	    (let ((name (po-match-string 1)))
-	      (if name
-		  (let ((pair (assoc name po-team-name-to-code)))
-		    (if pair
-			(setq team (cdr pair))
-		      (setq team (read-string (format "\
-Team name '%s' unknown.  What is the team code? "
-						      name)))))))))
-      (if (or (not team) (string-equal team "LL"))
-	  (error (_"Language-Team field does not have a proper value")))
-      ;; Compose the name.
-      (concat package "-" version "." team ".po"))))
-
-(defun po-guess-team-address ()
-  "Return the team address related to this PO file."
-  (let (team)
-    (save-excursion
-      (goto-char (point-min))
-      (re-search-forward po-any-msgstr-regexp)
-      (goto-char (match-beginning 0))
-      (if (re-search-forward
-	   "\n\"Language-Team: +\\(.*<\\(.*\\)@.*>\\)\\\\n\"$"
-	   (match-end 0) t)
-	  (setq team (po-match-string 2)))
-      (if (or (not team) (string-equal team "LL"))
-	  (error (_"Language-Team field does not have a proper value")))
-      (po-match-string 1))))
-
-(defun po-send-mail ()
-  "Start composing a letter, possibly including the current PO file."
-  (interactive)
-  (let* ((team-flag (y-or-n-p
-		     (_"\
-Write to your team?  ('n' if writing to the Translation Project robot) ")))
-	 (address (if team-flag
-		      (po-guess-team-address)
-		    po-translation-project-address)))
-    (if (not (y-or-n-p (_"Include current PO file in mail? ")))
-	(apply po-compose-mail-function address
-	       (read-string (_"Subject? ")) nil)
-      (if (buffer-modified-p)
-	  (error (_"The file is not even saved, you did not validate it.")))
-      (if (and (y-or-n-p (_"You validated ('V') this file, didn't you? "))
-	       (or (zerop po-untranslated-counter)
-		   (y-or-n-p
-		    (format (_"%d entries are untranslated, include anyway? ")
-			    po-untranslated-counter)))
-	       (or (zerop po-fuzzy-counter)
-		   (y-or-n-p
-		    (format (_"%d entries are still fuzzy, include anyway? ")
-			    po-fuzzy-counter)))
-	       (or (zerop po-obsolete-counter)
-		   (y-or-n-p
-		    (format (_"%d entries are obsolete, include anyway? ")
-			    po-obsolete-counter))))
-	  (let ((buffer (current-buffer))
-		(name (po-guess-archive-name))
-		(transient-mark-mode nil)
-		(coding-system-for-read buffer-file-coding-system)
-		(coding-system-for-write buffer-file-coding-system))
-	    (apply po-compose-mail-function address
-		   (if team-flag
-		       (read-string (_"Subject? "))
-		     (format "%s %s" po-translation-project-mail-label name))
-		   nil)
-	    (goto-char (point-min))
-	    (re-search-forward
-	     (concat "^" (regexp-quote mail-header-separator) "\n"))
-	    (save-excursion
-	      (insert-buffer buffer)
-	      (shell-command-on-region
-	       (region-beginning) (region-end)
-	       (concat po-gzip-uuencode-command " " name ".gz") t))))))
-  (message ""))
-
-(defun po-confirm-and-quit ()
-  "Confirm if quit should be attempted and then, do it.
-This is a failsafe.  Confirmation is asked if only the real quit would not."
-  (interactive)
-  (if (po-check-all-pending-edits)
-      (progn
-	(if (or (buffer-modified-p)
-		(> po-untranslated-counter 0)
-		(> po-fuzzy-counter 0)
-		(> po-obsolete-counter 0)
-		(y-or-n-p (_"Really quit editing this PO file? ")))
-	    (po-quit))
-	(message ""))))
-
-(defun po-quit ()
-  "Save the PO file and kill buffer.
-However, offer validation if appropriate and ask confirmation if untranslated
-strings remain."
-  (interactive)
-  (if (po-check-all-pending-edits)
-      (let ((quit t))
-	;; Offer validation of newly modified entries.
-	(if (and (buffer-modified-p)
-		 (not (y-or-n-p
-		       (_"File was modified; skip validation step? "))))
-	    (progn
-	      (message "")
-	      (po-validate)
-	      ;; If we knew that the validation was all successful, we should
-	      ;; just quit.  But since we do not know yet, as the validation
-	      ;; might be asynchronous with PO mode commands, the safest is to
-	      ;; stay within PO mode, even if this implies that another
-	      ;; 'po-quit' command will be later required to exit for true.
-	      (setq quit nil)))
-	;; Offer to work on untranslated entries.
-	(if (and quit
-		 (or (> po-untranslated-counter 0)
-		     (> po-fuzzy-counter 0)
-		     (> po-obsolete-counter 0))
-		 (not (y-or-n-p
-		       (_"Unprocessed entries remain; quit anyway? "))))
-	    (progn
-	      (setq quit nil)
-	      (po-auto-select-entry)))
-	;; Clear message area.
-	(message "")
-	;; Or else, kill buffers and quit for true.
-	(if quit
-	    (progn
-	      (save-buffer)
-	      (kill-buffer (current-buffer)))))))
-
-;; XEmacs addition
-;; When `po-mode' sometime is autoloaded, change this to autoload-only.
-(add-to-list 'auto-mode-alist '("\\.po\\'\\|\\.po\\." . po-mode))
-
-(provide 'po-mode)
-
-;;; po-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/rtf-support.el b/xemacs-packages/lisp/text-modes/rtf-support.el
deleted file mode 100644
index a642d42c..00000000
--- a/xemacs-packages/lisp/text-modes/rtf-support.el
+++ /dev/null
@@ -1,744 +0,0 @@
-;;; rtf-support.el --- MS Rich Text Format support functions
-
-;; Copyright (C) 2000 Alastair J. Houghton
-
-;; Authors:    1999-2001 Alastair J. Houghton 
-;; Keywords:   RTF Microsoft Windows NT
-;; Version:    1.4
-
-;; This file is part of XEmacs
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;; If you want to actually *use* RTF, you probably want to take a look
-;; at the functions `rtf-clip-region', `rtf-clip-buffer',
-;; `rtf-export-region' and `rtf-export-buffer' or if you're more interested
-;; in how it all works, `rtf-spool-region' and `rtf-spool-buffer'.
-
-;; Some people like to rebind their global keymap so that they can do
-;; rtf-clip-region directly from the keyboard.  An example follows:
-;;
-;;   (require 'rtf-support)
-;;
-;;   (define-key global-map '(control meta insert) 'rtf-clip-region)
-;;
-;; Note that the rtf-clip functions do *not* place things into the
-;; XEmacs kill ring, just onto the clipboard.  XEmacs makes it appear as
-;; if things on the clipboard are at the top of the kill ring via the
-;; `interprogram-paste-function'.  
-;;
-;; It's probably best to treat all of these functions the way you'd
-;; treat `htmlize' or `ps-spool-*'; whilst they probably are quick enough
-;; to replace kill/yank/copy for day-to-day use, they do perform a fair bit
-;; of processing and could theoretically take a long time or use up a lot
-;; of memory executing...
-
-;; Requires
-(require 'cl)
-
-(defconst rtf-version "1.4"
-  "RTF-support version number.")
-
-;;; Customisation support     
-
-;;;###autoload
-(defgroup rtf nil
-  "Support RTF selections and spooling of RTF to a buffer."
-  :group 'wp
-  :tag "RTF")
-
-;; This says whether to untabify the text before changing it to RTF
-(defcustom rtf-untabify-p t
-  "Set this to t to untabify the text before changing it to RTF."
-  :type 'boolean
-  :group 'rtf)
-
-(defcustom rtf-gen-ruler-p nil
-  "Set this to t to generate a set of RTF tabstops.
-This is intended for RTF readers that cannot handle character-based tabs
-properly (e.g. Microsoft Word). Note that this feature uses on-screen
-character metrics, so tabstops generated like this tend to be somewhat
-inaccurate.  It is usually better to untabify the text by setting
-`rtf-untabify-p' rather than using this feature."
-  :type 'boolean
-  :group 'rtf)
-
-(defcustom rtf-create-colours nil
-  "Non-nil causes RTF output to contain new colours.
-This is for compatibility with RTF readers that do not expect anything
-but the standard set of colours (e.g. Microsoft Word prior to Word 2000).
-If new colours are not being created, face colours are best-matched with
-those in the default colour table `rtf-default-colour-table' using a
-Euclidean distance metric."
-  :type 'boolean
-  :group 'rtf)
-
-;; This is the default colour table for the RTF output.  It is set-up the
-;; same way as Microsoft Word's default colour table, which means that
-;; the colours won't cause too much bother.
-(defcustom rtf-default-colour-table '((nil           . 0);; Auto
-				      ((0 0 0)       . 1);; Black
-				      ((0 0 255)     . 2);; Blue
-				      ((0 255 255)   . 3);; Cyan
-				      ((0 255 0)     . 4);; Green
-				      ((255 0 255)   . 5);; Magenta
-				      ((255 0 0)     . 6);; Red
-				      ((255 255 0)   . 7);; Yellow
-				      ((255 255 255) . 8);; White
-				      ((0 0 128)     . 9);; Dark Blue
-				      ((0 128 128)   . 10);; Dark Cyan
-				      ((0 128 0)     . 11);; Dark Green
-				      ((128 0 128)   . 12);; Dark Magenta
-				      ((128 0 0)     . 13);; Dark Red
-				      ((128 128 0)   . 14);; Dark Yellow
-				      ((128 128 128) . 15);; Grey
-				      ((192 192 192) . 16));; Light Grey
-  "The default colour table to use in RTF output.
-This is the palette of colours that is used when rtf-create-colours is nil;
-by default it matches the standard set used in Microsoft Word.
-
-It is only used when `rtf-create-colours' is nil, in which case Emacs face
-colours are matched with available palette colours by minimising the
-Euclidean distance between the selected palette colour and the face colour.
-
-Ideally, the indices should be unique, although that isn't enforced here
-because it's possible that someone might find a use for non-unique indices
-(in conjunction with the various broken programs that are about)."
-  :type '(repeat rtf-color-table-entry)
-  :group 'rtf)
-
-(define-widget 'rtf-color-table-entry 'default
-  "Edit an RTF colour table entry."
-  :format "%v"
-  :value '(nil . 0)
-  :value-create 'rtf-color-table-value-create
-  :value-delete 'widget-children-value-delete
-  :value-get 'rtf-color-table-value-get
-  :value-set 'rtf-color-table-value-set
-  :match '(lambda (widget value) t)
-  :validate 'widget-children-validate
-  :convert-widget 'widget-value-convert-widget)
-
-(defun rtf-color-table-value-create (widget)
-  "Create the components of an rtf-color-table-entry widget."
-  (let ((value (widget-get widget :value))
-	index color)
-    (setq index (widget-create-child-value widget
-					   '(integer
-					     :tag "Index"
-					     :size 6)
-					   (cdr value)))
-    (insert ?\ )
-    (setq color (widget-create-child-value widget
-					   '(rtf-color
-					     :tag "Color")
-					   (car value)))
-    (insert ?\n)
-    (widget-put widget :children (list index color))
-    ))
-
-(defun rtf-color-table-value-get (widget)
-  "Retrieve the value of an rtf-color-table-entry widget."
-  (let ((children (widget-get widget :children)))
-    (if children
-	(cons (widget-value (cadr children))
-	      (widget-value (car children)))
-      (widget-get widget :value))))
-
-(defun rtf-color-table-value-set (widget value)
-  "Set the value of an rtf-color-table-entry widget."
-  (let ((children (widget-get widget :children)))
-    (if children
-	(progn
-	  (widget-value-set (car children) (cdr value))
-	  (widget-value-set (cadr children) (car value))))))
-
-(define-widget 'rtf-color 'editable-field
-  "Choose a color, either (R G B) or auto (with sample)."
-  :format "%{%t%}: (%{  %}) %v"
-  :size 15
-  :tag "Color"
-  :value nil
-  :sample-face-get 'rtf-color-sample-face-get
-  :notify 'rtf-color-notify
-  :action 'rtf-color-action
-  :error "Must be an RGB triple (R G B), or auto."
-  :validate 'rtf-color-validate
-  :match 'rtf-color-match
-  :value-to-internal 'rtf-color-value-to-internal
-  :value-to-external 'rtf-color-value-to-external)
-
-(defun rtf-color-as-string (color)
-  "Get a color as a string."
-  (if (and color
-	   (not (eq color 'rtf-invalid-color)))
-      (format "#%2.2X%2.2X%2.2X" (car color) (cadr color) (caddr color))
-    "#000000"))
-
-(defun rtf-color-sample-face-get (widget)
-  "Retrieve the sample face."
-  (or (widget-get widget :sample-face)
-      (let ((color (widget-value widget))
-	    (face (make-face (gensym "sample-face-") nil t)))
-	(widget-put widget :sample-face face)
-	(if (rtf-color-match widget color)
-	    (set-face-background face (rtf-color-as-string color))
-	  (set-face-background face "#000000"))
-	face)))
-
-(defun rtf-color-action (widget &optional event)
-  "Prompt for a colour."
-  (let* ((tag (widget-apply widget :menu-tag-get))
-	 (answer (read-string (concat tag ": ")
-			      (rtf-color-value-to-internal
-			       widget
-			       (widget-value widget)))))
-    (unless (zerop (length answer))
-      (widget-value-set widget (rtf-color-value-to-external widget answer))
-      (widget-setup)
-      (widget-apply widget :notify widget event))))
-
-(defun rtf-color-notify (widget child &optional event)
-  "Update the sample, and notify the parent."
-  (let* ((face (widget-apply widget :sample-face-get))
-	 (color (widget-value widget)))
-    (if (rtf-color-match widget color)
-	(set-face-background face (rtf-color-as-string color))
-      (set-face-background face "#000000"))
-    (widget-default-notify widget child event)))
-
-(defun rtf-color-validate (widget)
-  "Validate this widget's value."
-  (let ((color (widget-value widget)))
-    (unless (rtf-color-match widget color)
-      widget)))
-
-(defun rtf-color-match (widget value)
-  "Validate this value."
-  (and (not (eq value 'rtf-invalid-color))
-       (or (not value)
-	   (and (listp value)
-		(eq (length value) 3)))))
-
-(defun rtf-color-value-to-internal (widget value)
-  "Convert to internal representation (string)."
-  (cond
-   ((eq value 'rtf-invalid-color)
-    "auto")
-   (value
-    (format "(%d %d %d)" (car value) (cadr value) (caddr value)))
-   (t
-    "auto")))
-
-(defun rtf-color-value-to-external (widget value)
-  "Convert to external representation."
-  (unless (equal value "auto")
-    (let ((val (condition-case nil
-		   (read value)
-		 (error nil))))
-      (if (and (listp val)
-	       (every '(lambda (x)
-			 (and (integerp x)
-			      (<= x 255)
-			      (>= x 0)))
-		      val))
-	  val
-	'rtf-invalid-color))
-    ))
-
-;;; Code proper:
-
-;; This is the clipboard format ID
-(defvar rtf-data-type nil
-  "Contains the window-system data type for RTF.")
-
-(unless rtf-data-type
-  (setq rtf-data-type (register-selection-data-type "Rich Text Format")))
-
-;; This function makes a string safe for inclusion in an RTF file
-(defun rtf-safe (string)
-  "Return a valid RTF string with the textual meaning of `string'.
-This function makes various special characters safe by escaping them."
-  (replace-in-string string "[{}\\\\]" "\\\\\\&" nil))
-
-(defun rtf-map-chars (string)
-  "Map some characters in an RTF string."
-;; RAS:  07/11/03
-;; adding support for form feed
-  (replace-in-string (replace-in-string (replace-in-string (rtf-safe string) 
-                                                           "" "\\page " t) 
-                                        "\t" "\\tab" t)
-		     "\n" "\\par\n" t)) 
-
-(defun rtf-map-colour (emacs-colour)
-  "Convert an Emacs colour triple to a more suitable form for RTF."
-  (list
-   (max (min (/ (nth 0 emacs-colour) 256) 255) 0)
-   (max (min (/ (nth 1 emacs-colour) 256) 255) 0)
-   (max (min (/ (nth 2 emacs-colour) 256) 255) 0)))
-
-(defun rtf-match-colour (colour colours best-match)
-  "Find a colour in the colours list.
-If `best-match' is non-nil, it matches the closest colour, otherwise
-it performs an exact match."
-  (if best-match
-      (let (current
-	    curcol
-	    (bestcol nil)
-	    (bestdist nil)
-	    dist)
-	;; Remember to skip the "auto" colour
-	(setq current (cdr colours))
-	(while current
-	  (setq curcol (car current))
-	  (setq current (cdr current))
-	  (let ((rd (- (nth 0 colour) (nth 0 (car curcol))))
-		(gd (- (nth 1 colour) (nth 1 (car curcol))))
-		(bd (- (nth 2 colour) (nth 2 (car curcol)))))
-	    (setq dist (sqrt (+ (* rd rd) (* gd gd) (* bd bd)))))
-	  (if (or (not bestdist) (< dist bestdist))
-	      (progn
-		(setq bestdist dist)
-		(setq bestcol (cdr curcol)))))
-	bestcol)
-    (cdr (assoc colour colours))))
-
-;; This function generates a ruler
-(defun rtf-ruler (tab-twips nstops)
-  "Generate the RTF for a set of tab-stops, starting at the left margin,
-separated by `tab-twips' twips, with `nstops' stops."
-  (let ((result nil)
-	(stops nstops)
-	(pos 0))
-    (while (> stops 0)
-      (setq stops (- stops 1))
-      (setq pos (truncate (+ pos tab-twips)))
-      (setq result (concat result "\\tx" (number-to-string pos))))
-    result)
-  )
-
-;; This function shamelessly based upon Hrvoje's htmlize-faces-in-buffer
-;; from htmlize.el
-(defun rtf-faces-in-buffer ()
-  "Return a list of the faces actually used by extents in the current buffer."
-  (let (faces)
-    (map-extents (lambda (extent ignored)
-		   (let ((face (extent-face extent)))
-		     (when (consp face)
-		       (setq face (car face)))
-		     (when (find-face face)
-		       (pushnew face faces)))
-		   nil)
-		 nil nil nil nil nil 'face)
-    (pushnew 'default faces)))
-
-
-;; This function takes a region and generates RTF in the specified buffer
-
-;;;###autoload
-(defun rtf-spool-region (start end &optional dont-fontify)
-  "Spool a buffer as Microsoft Rich Text Format text.
-Like `ps-spool-region', although the rtf-support code doesn't keep
-track of spooled regions to despool (because RTF isn't useful for
-printing). Returns the buffer containing the RTF."
-  (interactive "r")
-  (when (and font-lock-mode (not dont-fontify))
-    (font-lock-fontify-buffer))
-  
-  ;; Swap if necessary
-  (if (< end start)
-      (let ((tmp start))
-	(setq start end)
-	(setq end tmp)))
-  
-  ;; Create the new buffer
-  (let ((rtf-buf (generate-new-buffer "*rtf*"))
-	(tmp-buf nil)
-	old-buf)
-    (save-excursion
-      (message "rtf-spool-region: building header...")
-      
-      ;; Build the RTF header first
-      (insert-string "{\\rtf1\\ansi" rtf-buf)
-      
-      ;; Build the font table, colour table and stylesheet
-      (let ((fonts nil)
-	    (colours rtf-default-colour-table)
-	    (styles nil)
-	    (fnum 0) (cnum 16) (snum 0)
-	    (font nil) (forecolour nil) (backcolour nil)
-	    (style nil) (extstyle nil)
-	    (faces-list (rtf-faces-in-buffer))
-	    (style-map (make-hash-table :test 'equal))
-	    (tab-twips 720)
-	    (style-start nil))
-	
-	;; Enumerate the faces, breaking out lists
-	(mapc '(lambda (cur-face)
-		 ;; Extract font information
-		 (setq font (font-name (face-property cur-face 'font)))
-		 (let ((type (console-type)))
-		   (cond
-		    ((eq type 'x)
-		     (setq font (split-string font "-"))
-		     (setq font (list (nth 2 font)
-				      (nth 3 font)
-				      (nth 4 font)
-				      (cond
-				       ((eq (nth 8 font) "*") 10)
-				       ((> (length (nth 8 font)) 0)
-					(/ (string-to-number (nth 8 font)) 10))
-				       (t 10)))))
-		    (t
-		     (setq font (split-string font ":"))
-		     (setq font (list (nth 0 font)
-				      (nth 1 font)
-				      (nth 3 font)
-				      (if (> (length (nth 2 font)) 0)
-					  (string-to-number (nth 2 font))
-					10))))))
-		   
-		 ;; Make a new font if necessary
-		 (unless (assoc (nth 0 font) fonts)
-		   (setq fnum (+ fnum 1))
-		   (setq fonts (append fonts (list (cons
-						    (nth 0 font) fnum)))))
-
-		 ;; Make new colours if necessary
-		 (setq forecolour (rtf-map-colour
-				   (color-rgb-components
-				    (face-property cur-face 'foreground))))
-		 (setq backcolour (rtf-map-colour
-				   (color-rgb-components
-				    (face-property cur-face 'background))))
-
-		 (if rtf-create-colours
-		     (progn
-		       (unless (assoc forecolour colours)
-			 (setq cnum (+ cnum 1))
-			 (setq colours (append colours
-					       (list
-						(cons forecolour cnum)))))
-		
-		       (unless (assoc backcolour colours)
-			 (setq cnum (+ cnum 1))
-			 (setq colours (append colours
-					       (list
-						(cons backcolour cnum)))))
-		       ))
-	  
-		 ;; Sort-out bold, underlined, etc...
-		 (setq extstyle nil)
-		 (let ((font-type (nth 1 font)))
-		   (if (string-match "Bold" font-type)
-		       (setq extstyle (concat "\\b" extstyle)))
-		   (if (string-match "Italic" font-type)
-		       (setq extstyle (concat "\\i" extstyle)))
-		   (if (face-underline-p cur-face)
-		       (setq extstyle (concat "\\ul" extstyle)))
-		   )
-	     
-		 ;; Make a new style for this face
-		 (setq style (list (format "(Emacs) %s" cur-face)
-				   (cdr (assoc (nth 0 font) fonts))
-				   (nth 3 font)
-				   (rtf-match-colour forecolour colours
-						     (not rtf-create-colours))
-				   (rtf-match-colour backcolour colours
-						     (not rtf-create-colours))
-				   extstyle
-				   cur-face))
-
-		 ;; If this was the default face, work-out how big a tab is
-		 (unless rtf-untabify-p
-		   (if (equal (nth 0 style) "(Emacs) default")
-		       (let ((fwidth (font-instance-width
-				      (specifier-instance
-				       (face-property cur-face 'font)))))
-			 (setq tab-twips (* (* fwidth 15) tab-width))
-			 )))
-
-		 (setq snum (+ snum 1))
-		 (setq styles (append styles (list (cons style snum)))))
-	      faces-list)
-
-	;; OK - emit the font table
-	(insert-string "{\\fonttbl" rtf-buf)
-
-	(mapc '(lambda (font)
-		 (insert-string (concat "\\f" (number-to-string (cdr font))
-					"\\fmodern " (car font) ";") rtf-buf))
-	      fonts)
-
-	;; Now emit the colour table
-	(insert-string "}\n{\\colortbl;" rtf-buf)
-
-	(mapc '(lambda (colour)
-		 (if (car colour)
-		     (insert-string (concat
-				     "\\red" (number-to-string
-					      (first (car colour)))
-				     "\\green" (number-to-string
-						(second (car colour)))
-				     "\\blue" (number-to-string
-					       (third (car colour)))
-				     ";") rtf-buf)))
-	      colours)
-			   
-	;; Finally do the stylesheet
-	(insert-string "}\n{\\stylesheet" rtf-buf)
-	(setq style-start (point rtf-buf))
-	
-	(mapc
-	 '(lambda (style)
-	    (if (equal (first (car style)) "(Emacs) default")
-		(let ((cur-pos (point rtf-buf)))
-		  (goto-char style-start rtf-buf)
-		  (insert-string (concat
-				  "{\\s15"
-				  "\\plain\\f" (number-to-string
-						(second (car style)))
-				  "\\fs" (number-to-string
-					  (* (third (car style)) 2))
-				  "\\cf" (number-to-string (fourth (car style)))
-				  "\\cb" (number-to-string (fifth (car style)))
-				  "\\lang1024"
-				  (sixth (car style))
-				  (when rtf-gen-ruler-p
-				    (rtf-ruler tab-twips 30))
-				  " Emacs Text;}"
-				  "{\\*\\cs16"
-				  " \\additive"
-				  "\\f" (number-to-string
-					 (second (car style)))
-				  "\\fs" (number-to-string
-					  (* (third (car style)) 2))
-				  "\\cf" (number-to-string (fourth (car style)))
-				  "\\cb" (number-to-string (fifth (car style)))
-				  "\\lang1024"
-				  (sixth (car style))
-				  " Emacs Base Style;}") rtf-buf)
-		  (goto-char (+ cur-pos (- (point rtf-buf) style-start)) rtf-buf)
-		  (puthash nil (concat
-				"\\cs16"
-				"\\f" (number-to-string (second (car style)))
-				"\\fs" (number-to-string (* (third
-							     (car style)) 2))
-				"\\cf" (number-to-string (fourth (car style)))
-				"\\cb" (number-to-string (fifth (car style)))
-				"\\lang1024" (sixth (car style)))
-			   style-map))
-	      (insert-string (concat
-			      "{\\*\\cs" (number-to-string (+ 16 (cdr style)))
-			      " \\additive"
-			      "\\f" (number-to-string (second (car style)))
-			      "\\fs" (number-to-string (* (third (car style)) 2))
-			      "\\cf" (number-to-string (fourth (car style)))
-			      "\\cb" (number-to-string (fifth (car style)))
-			      "\\lang1024"
-			      (sixth (car style))
-			      " \\sbasedon16 "
-			      (first (car style))
-			      ";}") rtf-buf)
-	      (puthash (nth 6 (car style))
-		       (concat
-			"\\cs" (number-to-string (+ 16 (cdr style)))
-			"\\f" (number-to-string (second (car style)))
-			"\\fs" (number-to-string (* (third (car style)) 2))
-			"\\cf" (number-to-string (fourth (car style)))
-			"\\cb" (number-to-string (fifth (car style)))
-			"\\lang1024"
-			(sixth (car style)))
-		       style-map)))
-	 styles)
-	
-	;; End the header
-	(insert-string (concat "}\n{\\plain\\s15"
-			       (when rtf-gen-ruler-p
-				 (rtf-ruler tab-twips 30))
-			       "{\\cs16"
-			       (gethash nil style-map)) rtf-buf)
-
-	;; Go through all the extents writing out the text and the style changes
-	(setq old-buf (current-buffer))
-	
-	(if rtf-untabify-p
-	    (progn
-	      (setq tmp-buf (generate-new-buffer "*rtf-tmp*"))
-	      (let ((old-tab-width tab-width))
-		(set-buffer tmp-buf)
-		(setq tab-width old-tab-width)
-		(insert-buffer old-buf)
-		(map-extents '(lambda (extent arg)
-				(let ((new-extent (copy-extent extent)))
-				  (set-extent-property new-extent 'read-only nil)
-				  (insert-extent new-extent
-						 (extent-start-position extent)
-						 (extent-end-position extent)))
-				nil)
-			     old-buf)
-		(let ((start-mark (make-marker))
-		      (end-mark (make-marker)))
-		  (set-marker start-mark start)
-		  (set-marker end-mark end)
-		  (untabify (point-min) (point-max))
-		  (setq start (marker-position start-mark))
-		  (setq end (marker-position end-mark))
-		  ))))
-
-	(let ((pos start)
-	      (percent 5))
-	  (while (< pos end)
-	    (let ((next-change
-		   (or (next-single-property-change pos 'face)
-		       end))
-		  (formatting (gethash (get-text-property pos 'face)
-				       style-map)))
-	      (if formatting
-		  (insert-string (concat
-				  "{" formatting
-				  " "
-				  (rtf-map-chars (buffer-substring-no-properties
-						  pos next-change))
-				  "}")
-				 rtf-buf)
-		(insert-string (rtf-map-chars (buffer-substring-no-properties
-					       pos next-change))
-			       rtf-buf))
-	      
-	      (setq pos next-change)
-	      
-	      (let ((real-percent (/ (* 100 (- pos start)) (- end start))))
-		(when (> real-percent percent)
-		  (progn
-		    (message "rtf-spool-region: %d%% ..." percent)
-		    (setq percent (- (+ 5 real-percent) (mod real-percent 5))))))
-	      )))
-
-	(set-buffer old-buf)
-	
-	;; Delete temporary buffer
-	(if rtf-untabify-p
-	    (kill-buffer tmp-buf))
-	
-	;; End the file
-	(insert-string "\\par\n}}}" rtf-buf)
-
-	(message "rtf-spool-region: done")
-	))
-    rtf-buf
-    ))
-
-;;;###autoload
-(defun rtf-spool-buffer ()
-  "Spool the entire buffer."
-  (interactive)
-  (rtf-spool-region 1 (buffer-size)))
-
-;;; Functions users are most likely to use
-
-;;;###autoload
-(defun rtf-export (filename)
-  "Export the current document as RTF, preserving faces."
-  (interactive "FExport RTF: ")
-  (let ((rtf-buf (rtf-spool-buffer)))
-    (save-excursion
-      (set-buffer rtf-buf)
-      (write-file filename t))
-    (kill-buffer rtf-buf)))
-
-;;;###autoload
-(defun rtf-export-region (filename start end)
-  "Export the selected region as RTF, preserving faces."
-  (interactive "FExport RTF: \nr")
-  (let ((rtf-buf (rtf-spool-region start end)))
-    (save-excursion
-      (set-buffer rtf-buf)
-      (write-file filename t))
-    (kill-buffer rtf-buf)))
-
-;; The selection converter function (we only support *output* for now)
-(defun rtf-convert-to-rtf (selection type value)
-  "Convert VALUE to RTF, where VALUE is one of:
-
-* A string. The string is converted to RTF. Non-duplicable extents will
-  not be converted to RTF style changes.
-
-* A buffer. The buffer's contents are converted to RTF.
-
-* A list of the form (BUFFER START END), where BUFFER is the buffer from
-  which to convert, START and END define a region within the buffer to
-  be converted."
-  (cond ((stringp value)
-	 (let ((tmp-buf (generate-new-buffer "*rtf-tmp*")))
-	   (insert-string value tmp-buf)
-	   (rtf-convert-to-rtf selection type tmp-buf)))
-	((bufferp value)
-	 (let* ((rtf-buf (rtf-spool-buffer))
-		(text (buffer-substring-no-properties
-		       (point-min rtf-buf)
-		       (point-max rtf-buf)
-		       rtf-buf)))
-	   (kill-buffer rtf-buf)
-	   text))
-	((and (listp value)
-	      (bufferp (first value))
-	      (integer-or-marker-p (second value))
-	      (integer-or-marker-p (third value)))
-	 (let* ((start (if (integerp (second value))
-			   (second value)
-			 (marker-position (second value))))
-		(end (if (integerp (third value))
-			 (third value)
-		       (marker-position (third value))))
-		(rtf-buf (rtf-spool-region start end t))
-		(text (buffer-substring-no-properties
-		       (point-min rtf-buf) (point-max rtf-buf) rtf-buf)))
-	   (kill-buffer rtf-buf)
-	   text))
-	(t nil)
-	))
-
-;; Install the converter
-(unless (assq rtf-data-type selection-converter-out-alist)
-  (setq selection-converter-out-alist
-	(cons (cons rtf-data-type 'rtf-convert-to-rtf)
-	      selection-converter-out-alist)))
-  
-;;;###autoload
-(defun rtf-clip-buffer ()
-  "Send the entire buffer to the clipboard as Rich Text Format. The function
-also copies the buffer as ordinary text, just for consistency."
-  (interactive)
-  (let ((text (buffer-substring-no-properties)))
-    (own-selection text 'CLIPBOARD)
-    (own-selection (current-buffer) 'CLIPBOARD 'replace-existing
-		   rtf-data-type)))
-
-;;;###autoload
-(defun rtf-clip-region (start end)
-  "Send the specified region (the selection if called interactively) to the
-clipboard as Rich Text Format. The function also copies the region in ordinary
-text, just for consistency."
-  (interactive "r")
-  (let ((text (buffer-substring-no-properties start end)))
-    (own-selection text 'CLIPBOARD)
-    (own-selection (list (current-buffer) start end) 'CLIPBOARD
-		   'replace-existing rtf-data-type)))
-
-;;; Provides RTF support
-
-(provide 'rtf-support)
diff --git a/xemacs-packages/lisp/text-modes/scribe.el b/xemacs-packages/lisp/text-modes/scribe.el
deleted file mode 100644
index a9fe50d4..00000000
--- a/xemacs-packages/lisp/text-modes/scribe.el
+++ /dev/null
@@ -1,323 +0,0 @@
-;;; scribe.el --- scribe mode, and its idiosyncratic commands.
-;; Keywords: wp
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; This file is part of XEmacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but without any warranty.  No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; document "GNU Emacs copying permission notice".   An exact copy
-;; of the document is supposed to have been given to you along with
-;; GNU Emacs so that you can know how you may redistribute it all.
-;; It should be in a file named COPYING.  Among other things, the
-;; copyright notice and this notice must be preserved on all copies.
-
-(defgroup scribe nil
-  "Scribe mode, and its idiosyncratic commands."
-  :group 'wp)
-
-
-(defvar scribe-mode-syntax-table nil
-  "Syntax table used while in scribe mode.")
-
-(defvar scribe-mode-abbrev-table nil
-  "Abbrev table used while in scribe mode.")
-
-(defcustom scribe-fancy-paragraphs nil
-  "*Non-NIL makes Scribe mode use a different style of paragraph separation."
-  :type 'boolean
-  :group 'scribe)
-
-(defcustom scribe-electric-quote nil
-  "*Non-NIL makes insert of double quote use `` or '' depending on context."
-  :type 'boolean
-  :group 'scribe)
-
-(defcustom scribe-electric-parenthesis nil
-  "*Non-NIL makes parenthesis char ( (]}> ) automatically insert its close
-if typed after an @Command form."
-  :type 'boolean
-  :group 'scribe)
-
-(defconst scribe-open-parentheses "[({<"
-  "Open parenthesis characters for Scribe.")
-
-(defconst scribe-close-parentheses "])}>"
-  "Close parenthesis characters for Scribe.  These should match up with
-scribe-open-parenthesis.")
-
-(if (null scribe-mode-syntax-table)
-    (let ((st (syntax-table)))
-      (unwind-protect
-       (progn
-	(setq scribe-mode-syntax-table (copy-syntax-table
-					text-mode-syntax-table))
-	(set-syntax-table scribe-mode-syntax-table)
-	(modify-syntax-entry ?\" "    ")
-	(modify-syntax-entry ?\\ "    ")
-	(modify-syntax-entry ?@ "w   ")
-	(modify-syntax-entry ?< "(>  ")
-	(modify-syntax-entry ?> ")<  ")
-	(modify-syntax-entry ?[ "(]  ")
-	(modify-syntax-entry ?] ")[  ")
-	(modify-syntax-entry ?{ "(}  ")
-	(modify-syntax-entry ?} "){  ")
-	(modify-syntax-entry ?' "w   "))
-       (set-syntax-table st))))
-
-(defvar scribe-mode-map nil)
-
-(if scribe-mode-map
-    nil
-  (setq scribe-mode-map (make-sparse-keymap))
-  (define-key scribe-mode-map "\t" 'scribe-tab)
-  (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop)
-  (define-key scribe-mode-map "\es" 'center-line)
-  (define-key scribe-mode-map "\e}" 'up-list)
-  (define-key scribe-mode-map "\eS" 'center-paragraph)
-  (define-key scribe-mode-map "\"" 'scribe-insert-quote)
-  (define-key scribe-mode-map "(" 'scribe-parenthesis)
-  (define-key scribe-mode-map "[" 'scribe-parenthesis)
-  (define-key scribe-mode-map "{" 'scribe-parenthesis)
-  (define-key scribe-mode-map "<" 'scribe-parenthesis)
-  (define-key scribe-mode-map "\^cc" 'scribe-chapter)
-  (define-key scribe-mode-map "\^cS" 'scribe-section)
-  (define-key scribe-mode-map "\^cs" 'scribe-subsection)
-  (define-key scribe-mode-map "\^ce" 'scribe-insert-environment)
-  (define-key scribe-mode-map "\^c\^e" 'scribe-bracket-region-be)
-  (define-key scribe-mode-map "\^c[" 'scribe-begin)
-  (define-key scribe-mode-map "\^c]" 'scribe-end)
-  (define-key scribe-mode-map "\^ci" 'scribe-italicize-word)
-  (define-key scribe-mode-map "\^cb" 'scribe-bold-word)
-  (define-key scribe-mode-map "\^cu" 'scribe-underline-word))
-
-;;;###autoload
-(defun scribe-mode ()
-  "Major mode for editing files of Scribe (a text formatter) source.
-Scribe-mode is similar text-mode, with a few extra commands added.
-\\{scribe-mode-map}
-
-Interesting variables:
-
-scribe-fancy-paragraphs
-  Non-nil makes Scribe mode use a different style of paragraph separation.
-
-scribe-electric-quote
-  Non-nil makes insert of double quote use `` or '' depending on context.
-
-scribe-electric-parenthesis
-  Non-nil makes an open-parenthesis char (one of `([<{')
-  automatically insert its close if typed after an @Command form."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map scribe-mode-map)
-  (setq mode-name "Scribe")
-  (setq major-mode 'scribe-mode)
-  (define-abbrev-table 'scribe-mode-abbrev-table ())
-  (setq local-abbrev-table scribe-mode-abbrev-table)
-  (make-local-variable 'comment-start)
-  (setq comment-start "@Comment[")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip (concat "@Comment[" scribe-open-parentheses "]"))
-  (make-local-variable 'comment-column)
-  (setq comment-column 0)
-  (make-local-variable 'comment-end)
-  (setq comment-end "]")
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "\\(^[\n\f]\\)\\|\\(^@\\w+["
-				 scribe-open-parentheses
-				"].*["
-				 scribe-close-parentheses
-				"]$\\)"))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate (if scribe-fancy-paragraphs
-			       paragraph-start "^$"))
-  (make-local-variable 'compile-command)
-  (setq compile-command (concat "scribe " (buffer-file-name)))
-  (set-syntax-table scribe-mode-syntax-table)
-  (run-hooks 'text-mode-hook 'scribe-mode-hook))
-
-(defun scribe-tab ()
-  (interactive)
-  (insert "@\\"))
-
-;; This algorithm could probably be improved somewhat.
-;;  Right now, it loses seriously...
-
-(defun scribe ()
-  "Run Scribe on the current buffer."
-  (interactive)
-  (call-interactively 'compile))
-
-(defun scribe-envelop-word (string count)
-  "Surround current word with Scribe construct @STRING[...].  COUNT
-specifies how many words to surround.  A negative count means to skip 
-backward."
-  (let ((spos (point)) (epos (point)) (ccoun 0))
-    (if (not (zerop count))
-	(progn (if (= (char-syntax (preceding-char)) ?w)
-		   (forward-sexp (min -1 count)))
-	       (setq spos (point))
-	       (if (looking-at (concat "@\\w[" scribe-open-parentheses "]"))
-		   (forward-char 2)
-		 (goto-char epos)
-		 (skip-chars-backward "\\W")
-		 (forward-char -1))
-	       (forward-sexp (max count 1))
-	       (setq epos (point))))
-    (goto-char spos)
-    (while (and (< ccoun (length scribe-open-parentheses))
-		(save-excursion
-		  (or (search-forward (char-to-string
-				       (aref scribe-open-parentheses ccoun))
-				      epos t)
-		      (search-forward (char-to-string
-				       (aref scribe-close-parentheses ccoun))
-				      epos t)))
-		(setq ccoun (1+ ccoun))))
-    (if (>= ccoun (length scribe-open-parentheses))
-	(progn (goto-char epos)
-	       (insert "@end(" string ")")
-	       (goto-char spos)
-	       (insert "@begin(" string ")"))
-      (goto-char epos)
-      (insert (aref scribe-close-parentheses ccoun))
-      (goto-char spos)
-      (insert "@" string (aref scribe-open-parentheses ccoun))
-      (goto-char epos)
-      (forward-char 3)
-      (skip-chars-forward scribe-close-parentheses))))
-
-(defun scribe-underline-word (count)
-  "Underline COUNT words around point by means of Scribe constructs."
-  (interactive "p")
-  (scribe-envelop-word "u" count))
-
-(defun scribe-bold-word (count)
-  "Boldface COUNT words around point by means of Scribe constructs."
-  (interactive "p")
-  (scribe-envelop-word "b" count))
-
-(defun scribe-italicize-word (count)
-  "Italicize COUNT words around point by means of Scribe constructs."
-  (interactive "p")
-  (scribe-envelop-word "i" count))
-
-(defun scribe-begin ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "Begin" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-end ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "End" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-chapter ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "Chapter" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-section ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "Section" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-subsection ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "SubSection" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-bracket-region-be (env min max)
-  (interactive "sEnvironment: \nr")
-  (save-excursion
-    (goto-char max)
-    (insert "@end(" env ")\n")
-    (goto-char min)
-    (insert "@begin(" env ")\n")))
-
-(defun scribe-insert-environment (env)
-  (interactive "sEnvironment: ")
-  (scribe-bracket-region-be env (point) (point))
-  (forward-line 1)
-  (insert ?\n)
-  (forward-char -1))
-
-(defun scribe-insert-quote (count)
-  "If scribe-electric-quote is non-NIL, insert ``, '' or \" according
-to preceding character.  With numeric arg N, always insert N \" characters.
-Else just insert \"."
-  (interactive "P")
-  (if (or count (not scribe-electric-quote))
-      (self-insert-command (prefix-numeric-value count))
-    (let (lastfore lastback lastquote)
-      (insert
-       (cond
-	((= (preceding-char) ?\\) ?\")
-	((bobp) "``")
-	(t
-	 (setq lastfore (save-excursion (and (search-backward
-					      "``" (- (point) 1000) t)
-					     (point)))
-	       lastback (save-excursion (and (search-backward
-					      "''" (- (point) 1000) t)
-					     (point)))
-	       lastquote (save-excursion (and (search-backward
-					       "\"" (- (point) 100) t)
-					      (point))))
-	 (if (not lastquote)
-	     (cond ((not lastfore) "``")
-		   ((not lastback) "''")
-		   ((> lastfore lastback) "''")
-		   (t "``"))
-	   (cond ((and (not lastback) (not lastfore)) "\"")
-		 ((and lastback (not lastfore) (> lastquote lastback)) "\"")
-		 ((and lastback (not lastfore) (> lastback lastquote)) "``")
-		 ((and lastfore (not lastback) (> lastquote lastfore)) "\"")
-		 ((and lastfore (not lastback) (> lastfore lastquote)) "''")
-		 ((and (> lastquote lastfore) (> lastquote lastback)) "\"")
-		 ((> lastfore lastback) "''")
-		 (t "``")))))))))
-
-(defun scribe-parenthesis (count)
-  "If scribe-electric-parenthesis is non-NIL, insertion of an open-parenthesis
-character inserts the following close parenthesis character if the
-preceding text is of the form @Command."
-  (interactive "P")
-  (self-insert-command (prefix-numeric-value count))
-  (let (at-command paren-char point-save)
-    (if (or count (not scribe-electric-parenthesis))
-	nil
-      (save-excursion
-	(forward-char -1)
-	(setq point-save (point))
-	(skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses))
-	(setq at-command (and (equal (following-char) ?@)
-			      (/= (point) (1- point-save)))))
-      (if (and at-command
-	       (setq paren-char
-		     (string-match (regexp-quote
-				    (char-to-string (preceding-char)))
-				   scribe-open-parentheses)))
-	  (save-excursion
-	    (insert (aref scribe-close-parentheses paren-char)))))))
-
-;; XEmacs addition
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.mss\\'" . scribe-mode))
diff --git a/xemacs-packages/lisp/text-modes/swedish.el b/xemacs-packages/lisp/text-modes/swedish.el
deleted file mode 100644
index 5438dcc3..00000000
--- a/xemacs-packages/lisp/text-modes/swedish.el
+++ /dev/null
@@ -1,156 +0,0 @@
-;;; swedish.el --- miscellaneous functions for dealing with Swedish.
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Code:
-
-;; Written by Howard Gayle.  See case-table.el for details.
-
-;; See iso-swed.el for a description of the character set.
-
-(require 'iso-syntax)
-
-(defvar swedish-re
-  "[ \t\n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \t\n.,?!:;'\")}]"
-  "Regular expression for common Swedish words.")
-
-(defvar swascii-to-8859-trans
-  (let ((string (make-string 256 ? ))
-	(i 0))
-    (while (< i 256)
-      (aset string i i)
-      (setq i (1+ i)))
-    (aset string ?\[ 196)
-    (aset string ?\] 197)
-    (aset string ?\\ 214)
-    (aset string ?^ 220)
-    (aset string ?\{ 228)
-    (aset string ?\} 229)
-    (aset string ?\` 233)
-    (aset string ?\| 246)
-    (aset string ?~ 252)
-    string)
-  "Trans table from SWASCII to 8859.")
-
-; $ is not converted because it almost always means US
-; dollars, not general currency sign.  @ is not converted
-; because it is more likely to be an at sign in a mail address
-; than an E with acute accent.
-
-(defun swascii-to-8859-buffer ()
-  "Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1.
-Works even on read-only buffers.  `$' and `@' are not converted."
-  (interactive)
-  (let  ((buffer-read-only nil))
-    (translate-region (point-min) (point-max) swascii-to-8859-trans)))
-
-(defun swascii-to-8859-buffer-maybe ()
-  "Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii.
-Leaves point just after the word that looks Swedish."
-  (interactive)
-  (let ((case-fold-search t))
-    (if (re-search-forward swedish-re nil t)
-	(swascii-to-8859-buffer))))
-
-(setq rmail-show-message-hook 'swascii-to-8859-buffer-maybe)
-
-(or (boundp 'news-group-hook-alist) (setq news-group-hook-alist nil))
-(setq news-group-hook-alist
-      (append '(("^swnet." . swascii-to-8859-buffer-maybe))
-	      news-group-hook-alist))
-
-(defvar 8859-to-swascii-trans
-  (let ((string (make-string 256 ? ))
-	(i 0))
-    (while (< i 256)
-      (aset string i i)
-      (setq i (1+ i)))
-    (aset string 164 ?$)
-    (aset string 196 ?\[)
-    (aset string 197 ?\])
-    (aset string 201 ?@)
-    (aset string 214 ?\\)
-    (aset string 220 ?^)
-    (aset string 228 ?\{)
-    (aset string 229 ?\})
-    (aset string 233 ?\`)
-    (aset string 246 ?\|)
-    (aset string 252 ?~)
-    string)
-  "8859 to SWASCII trans table.")
-
-(defun 8859-to-swascii-buffer ()
-   "Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii."
-   (interactive "*")
-   (translate-region (point-min) (point-max) 8859-to-swascii-trans))
-
-(setq mail-send-hook  '8859-to-swascii-buffer)
-(setq news-inews-hook '8859-to-swascii-buffer)
-
-;; It's not clear what purpose is served by a separate
-;; Swedish mode that differs from Text mode only in having
-;; a separate abbrev table.  Nothing says that the abbrevs you
-;; define in Text mode have to be English!
-
-;(defvar swedish-mode-abbrev-table nil
-;   "Abbrev table used while in swedish mode.")
-;(define-abbrev-table 'swedish-mode-abbrev-table ())
-
-;(defun swedish-mode ()
-;   "Major mode for editing Swedish text intended for humans to
-;read.  Special commands:\\{text-mode-map}
-;Turning on swedish-mode calls the value of the variable
-;text-mode-hook, if that value is non-nil."
-;   (interactive)
-;   (kill-all-local-variables)
-;   (use-local-map text-mode-map)
-;   (setq mode-name "Swedish")
-;   (setq major-mode 'swedish-mode)
-;   (setq local-abbrev-table swedish-mode-abbrev-table)
-;   (set-syntax-table text-mode-syntax-table)
-;   (run-hooks 'text-mode-hook))
-
-;(defun indented-swedish-mode ()
-;   "Major mode for editing indented Swedish text intended for
-;humans to read.\\{indented-text-mode-map}
-;Turning on indented-swedish-mode calls the value of the
-;variable text-mode-hook, if that value is non-nil."
-;   (interactive)
-;   (kill-all-local-variables)
-;   (use-local-map text-mode-map)
-;   (define-abbrev-table 'swedish-mode-abbrev-table ())
-;   (setq local-abbrev-table swedish-mode-abbrev-table)
-;   (set-syntax-table text-mode-syntax-table)
-;   (make-local-variable 'indent-line-function)
-;   (setq indent-line-function 'indent-relative-maybe)
-;   (use-local-map indented-text-mode-map)
-;   (setq mode-name "Indented Swedish")
-;   (setq major-mode 'indented-swedish-mode)
-;   (run-hooks 'text-mode-hook))
-
-(provide 'swedish)
-
-;;; swedish.el ends here
diff --git a/xemacs-packages/lisp/text-modes/tabify.el b/xemacs-packages/lisp/text-modes/tabify.el
deleted file mode 100644
index 506f464d..00000000
--- a/xemacs-packages/lisp/text-modes/tabify.el
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; tabify.el --- tab conversion commands for XEmacs
-
-;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; Commands to optimize spaces to tabs or expand tabs to spaces in a region
-;; (`tabify' and `untabify').  The variable tab-width does the obvious.
-
-;;; Code:
-
-;;;###autoload
-(defun untabify (start end)
-  "Convert all tabs in region to multiple spaces, preserving columns.
-Called non-interactively, the region is specified by arguments
-START and END, rather than by the position of point and mark.
-The variable `tab-width' controls the spacing of tab stops."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region (point-min) end)
-      (goto-char start)
-      (let ((percent 5))
-	(while (search-forward "\t" nil t)	; faster than re-search
-	  (let ((tab-beg (point))
-		(column (current-column))
-		(indent-tabs-mode nil))
-	    (skip-chars-backward "\t" start)
-	    (delete-region tab-beg (point))
-	    ;; XEmacs change -- show progress
-	    (indent-to column)
-	    (if (> (/ (* 100 (- (point) start)) (- (point-max) start)) percent)
-		(progn
-		  (message "untabify: %d%% ..." percent)
-		  (setq percent (+ 5 percent)))))))
-      (message "untabify: done")))
-  nil)
-
-;;;###autoload
-(defun tabify (start end)
-  "Convert multiple spaces in region to tabs when possible.
-A group of spaces is partially replaced by tabs
-when this can be done without changing the column they end at.
-Called non-interactively, the region is specified by arguments
-START and END, rather than by the position of point and mark.
-The variable `tab-width' controls the spacing of tab stops."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      ;; Include the beginning of the line in the narrowing
-      ;; since otherwise it will throw off current-column.
-      (goto-char start)
-      (beginning-of-line)
-      (narrow-to-region (point) end)
-      (goto-char start)
-      (let ((percent 5))
-	(while (re-search-forward "[ \t][ \t][ \t]*" nil t)
-	  (let ((column (current-column))
-		(indent-tabs-mode t))
-	    (delete-region (match-beginning 0) (point))
-	    ;; XEmacs change -- show progress
-	    (indent-to column)
-	    (if (> (/ (* 100 (- (point) start)) (- (point-max) start)) percent)
-		(progn
-		  (message "tabify: %d%% ..." percent)
-		  (setq percent (+ 5 percent)))))))
-      (message "tabify: done"))))
-
-(provide 'tabify)
-
-;;; tabify.el ends here
diff --git a/xemacs-packages/lisp/text-modes/tpum.el b/xemacs-packages/lisp/text-modes/tpum.el
deleted file mode 100644
index 4a9ee223..00000000
--- a/xemacs-packages/lisp/text-modes/tpum.el
+++ /dev/null
@@ -1,1590 +0,0 @@
-;;; tpum.el --- Popup menus in text mode.
-
-;; Copyright (C) 2003,2004,2005 by Zajcev Evgeny.
-
-;; Author: Zajcev Evgeny 
-;; Maintainer: none, if you want be a maintainer please e-mail me.
-;;             Temporary maintainer is Zajcev Evgeny.
-;; Created: 2003/10/21
-;; Keywords: tools, menus
-;; X-CVS: $Id: tpum.el,v 1.1 2005/04/15 21:10:48 lg Exp $
-
-;; This file is NOT part of XEmacs.
-
-;; tpum.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.
-
-;; tpum.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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-;; 
-;; This package aimed to bring popup menus to be more usable for
-;; keyboard friendly and mouse unfriendly people like me.  On the one
-;; hand I like popup menus, because they just perfect and easy
-;; interface for selective task, but on the other hand I hate them,
-;; because I need to find my trackball, click ugly buttons, twiddle
-;; ball to access menu item.  This pretty annoys.  Also popup menus
-;; are not available in console.  tpum.el package makes popup menu
-;; inlined in buffer, or creates transient XEmacs frame with temporary
-;; buffer, where menu will be inlined.  So this makes possible to
-;; control popup menus using keyboard and makes possible to popup
-;; menus in console.  To start using tpum.el just include in your
-;; ~/.emacs next:
-
-;; To enable tpum globally:
- 
-;;    (require 'tpum)
-;;    (tpum-global-mode 1)
-
-;; Or if you don't want tpum to be enable globally (default) do
-;; something like:
-
-;;    (autoload 'tpum-minor-mode "Toggle tpum minor mode." t)
-;; 
-;;  And then enable tpum minor mode by `M-x tpum-minor-mode RET'.
-
-;; To define new keys in order to emulate mouse events use something
-;; like:
- 
-;;    (define-tpum-key global-map (kbd "s-3") (kbd ""))
-;;    (define-tpum-key global-map (kbd "C-s-3") (kbd "C-"))
-;;    (define-tpum-key global-map (kbd "C-s-1") (kbd "C-"))
-;;    (define-tpum-key global-map (kbd "s-!") (kbd "Sh-"))
-;;    (define-tpum-key global-map (kbd "s-#") (kbd "Sh-"))
-
-;;; Customization:
-;; 
-;; To change tpum styles use:
- 
-;;    (setq tpum-cstyle 'tpum-style-pseudo)
-;;    (setq tpum-menu-type 'inline)
- 
-;; Best menu redering done if you are using fixed width fonts with
-;; pseudo-graphic characters and 'tpum-style-pseudo as tpum style.
-
-;;; Bugs:
-;; 
-;;  * With setnu-mode if poping up menu while point at the beginning
-;;    of line, setnu's numbers gets invisible.
- 
-;;  * If some menu uses broken :suffix keyword, tpum may render menu
-;;    incorrectly.
- 
-;;  * Control characters may temporaly change their displying type.
-
-;;; TODO:
-;;
-;; - Document code more carefuly
-;; - Improve docstrings
-;; - If it is possible to avoid overriding local map - avoid it
-
-;;; Code:
-;;
-
-(eval-when-compile
-  (require 'cl))
-
-(defgroup tpum nil
-  "Popup menus in text mode."
-  :prefix "tpum-"
-  :group 'environment)
-
-(defcustom tpum-global-mode nil
-  "*Non-nil mean tpum is enabled globally."
-  :type 'boolean
-  :group 'tpum)
-
-(defgroup tpum-faces nil
-  "Faces used in tpum."
-  :prefix "tpum-"
-  :group 'tpum
-  :group 'faces)
-
-(defface tpum-active-face
-  '((((background light))
-     (:foreground "black"))
-    (((background dark))
-     (:foreground "brightwhite")))
-  "*Face for displaying activated menu items."
-  :group 'tpum-faces)
-
-(defface tpum-deactive-face
-  '((((background dark))
-     (:foreground "darkgrey"))
-    (((background light))
-     (:foreground "darkgrey")))
-  "*Face for displaying deactivated menu items."
-  :group 'tpum-faces)
-
-(defface tpum-title-face
-  '((((type tty) (class color))
-     (:foreground "red" :bold t))
-    (((type tty))
-     (:bold t))
-
-    (((type x) (class color))
-     (:foreground "red4" :bold t))
-    (((type x))
-     (:bold t)))
-  "*Face to display title of menu."
-  :group 'tpum-faces)
-
-(defface tpum-toggled-face
-  '((t (:bold t)))
-  "*Face for toggle items, whos state is on."
-  :group 'tpum-faces)
-
-(defcustom tpum-menu-type 'inline
-  "Type of `popup-menu' behaviour.
-'inline - To inline in current buffer.
-'frame  - To pop Emacs frame."
-  :type '(choice (const :tag "Inline" inline)
-                 (const :tag "Frame" frame))
-  :group 'tpum)
-
-(defcustom tpum-auto-submenu-mode nil
-  "*Non-nil mean auto opening submenus at point."
-  :type 'boolean
-  :group 'tpum)
-
-(defcustom tpum-isearch-global-scope t
-  "*Non-nil mean that isearch will be performed in any shown tpums."
-  :type 'boolean
-  :group 'tpum)
-
-(defcustom tpum-truncate-lines nil
-  "*Value of `truncate-lines' while in `tpum-mode'."
-  :type 'boolean
-  :group 'tpum)
-
-(defcustom tpum-cstyle 'tpum-style-plain
-  "*Style to be used."
-  :type 'symbol
-  :group 'tpum)
-
-(unless (fboundp 'get-face)
-  (defalias 'get-face 'identity))
-
-(defface tpum-plain-face1
-  `((((class color))
-     (:foreground "blue" :bold t)))
-  "Border face for plain style."
-  :group 'tpum-faces)
-
-(defvar tpum-plain-face (get-face 'tpum-plain-face1))
-
-(defface tpum-pseudo-face1
-  `((((class color))
-     (:foreground "blue" :bold t))
-    (t (:bold t)))
-  "Border face for pseudo style."
-  :group 'tpum-face)
-
-(defvar tpum-pseudo-face (get-face 'tpum-pseudo-face1))
-
-(defvar tpum-frame-face (get-face 'blue))
-
-(defcustom tpum-max-height 80
-  "*Maximum height of popup menu."
-  :type 'number
-  :group 'tpum)
-
-(defcustom tpum-search-ahead-mode t
-  "*Non-nil mean to use type ahead search mode."
-  :type 'boolean
-  :group 'tpum)
-
-(defcustom tpum-load-hook nil
-  "*Hooks to run after tpum loaded."
-  :type 'hook
-  :group 'tpum)
-
-;; FSFmacs
-(unless (fboundp 'set-keymap-default-binding)
-  (defun set-keymap-default-binding (map cmd)
-    (define-key map [t] cmd)))
-
-(defvar tpum-mode-map
-  (let ((map (make-sparse-keymap)))
-    (set-keymap-default-binding map 'tpum-default-command)
-    (define-key map (kbd "C-u") 'universal-argument)
-    (define-key map (kbd "C-1") 'digit-argument)
-    (define-key map (kbd "C-2") 'digit-argument)
-    (define-key map (kbd "C-3") 'digit-argument)
-    (define-key map (kbd "C-4") 'digit-argument)
-    (define-key map (kbd "C-5") 'digit-argument)
-    (define-key map (kbd "C-6") 'digit-argument)
-    (define-key map (kbd "C-7") 'digit-argument)
-    (define-key map (kbd "C-8") 'digit-argument)
-    (define-key map (kbd "C-9") 'digit-argument)
-    (define-key map (kbd "C-0") 'digit-argument)
-    (define-key map (kbd "M-1") 'digit-argument)
-    (define-key map (kbd "M-2") 'digit-argument)
-    (define-key map (kbd "M-3") 'digit-argument)
-    (define-key map (kbd "M-4") 'digit-argument)
-    (define-key map (kbd "M-5") 'digit-argument)
-    (define-key map (kbd "M-6") 'digit-argument)
-    (define-key map (kbd "M-7") 'digit-argument)
-    (define-key map (kbd "M-8") 'digit-argument)
-    (define-key map (kbd "M-9") 'digit-argument)
-    (define-key map (kbd "M-0") 'digit-argument)
-
-    (define-key map (kbd "C-g") 'tpum-quit)
-    (define-key map (kbd "C-G") 'tpum-global-quit)
-    ;; Motion
-    (define-key map (kbd "C-l") 'recenter)
-    (define-key map (kbd "C-n") 'tpum-next)
-    (define-key map (kbd "") 'tpum-prev)
-    (define-key map (kbd "C-p") 'tpum-prev)
-    (define-key map (kbd "") 'tpum-next)
-    (define-key map (kbd "M->") 'tpum-goto-last)
-    (define-key map (kbd "M-<") 'tpum-goto-first)
-
-    (define-key map (kbd "M-RET") 'tpum-submenu-toggle)
-    (define-key map (kbd "C-RET") 'tpum-submenu-toggle)
-    (define-key map (kbd "M-t") 'tpum-auto-submenu-toggle)
-    (define-key map (kbd "RET") 'tpum-select)
-;    (define-key map (kbd "M-s") 'tpum-submenu-show)
-;    (define-key map (kbd "M-c") 'tpum-submenu-hide)
-
-    ;; Searching
-    (define-key map (kbd "C-t") 'tpum-isearch-global-toggle)
-    (define-key map (kbd "C-s") 'isearch-forward)
-    (define-key map (kbd "C-r") 'isearch-backward)
-
-    ;; Misc
-    (define-key map (kbd "") 'tpum-help)
-    (define-key map (kbd "C-h") 'tpum-help)
-    (define-key map (kbd "M-h") 'tpum-describe-bindings)
-    (define-key map (kbd "M-x") 'execute-extended-command)
-    (define-key map (kbd "M-:") 'eval-expression)
-    (define-key map (kbd "C-x 1") 'delete-other-windows)
-    map)
-  "Keymap used while in tpum.")
-
-
-(defun tpum-da-face (isactive)
-  "Return face according to ISACTIVE."
-  (if isactive 'tpum-active-face 'tpum-deactive-face))
-
-(defstruct tpum-style
-  border-face                           ; face used to draw borders
-  toggle-dis toggle-act radio-dis radio-act submenu
-  title-sep title-sl title-sr
-  left right top bottom
-  left-top left-bottom
-  right-top right-bottom
-  right-bot2 left-bot2 line-bot2 center-bot2 ;when menu is not fully displayed
-
-  ;; delimiters
-  single-line double-line
-  single-dashed-line double-dashed-line
-  no-line
-  right-sl right-dl right-sdl right-ddl right-nl
-  left-sl left-dl left-sdl left-ddl left-nl)
-
-(defvar tpum-style-plain
-  (make-tpum-style
-   :border-face tpum-plain-face
-   :toggle-dis "[ ] " :toggle-act "[x] " :radio-dis "( ) " :radio-act "(*) "
-   :submenu " >>"
-   :title-sep "=" :title-sl "|" :title-sr "|"
-   :left "|" :right "|" :top "-" :bottom "-"
-   :left-top "." :left-bottom "`" :right-top "." :right-bottom "'"
-   :right-bot2 "|" :left-bot2 "|" :line-bot2 "." :center-bot2 "vvv"
-
-   :single-line "-" :double-line "=" :single-dashed-line "- -"
-   :double-dashed-line "= =" :no-line " "
-   :right-sl "|" :right-dl "|" :right-sdl "|" :right-ddl "|" :right-nl "|"
-   :left-sl "|" :left-dl "|" :left-sdl "|" :left-ddl "|" :left-nl "|")
-  "Plain text style.")
-
-(defvar tpum-style-pseudo
-  (make-tpum-style
-   :border-face  tpum-pseudo-face
-   :toggle-dis "[ ] " :toggle-act "[x] " :radio-dis "( ) " :radio-act "(*) "
-   :submenu " >>"
-   :title-sep "=" :title-sl "\x15" :title-sr "\x16"
-   :left "\x19" :right "\x19" :top "\x12" :bottom "\x12"
-   :left-top "\x0d" :left-bottom "\x0e" :right-top "\x0c" :right-bottom "\x0b"
-   :right-bot2 "|" :left-bot2 "|" :line-bot2 "." :center-bot2 "vvv"
-
-   :single-line "\x12" :double-line "=" :single-dashed-line "- -"
-   :double-dashed-line "= =" :no-line " "
-   :right-sl "\x16" :right-dl "\x16" :right-sdl "|" :right-ddl "|" :right-nl "|"
-   :left-sl "\x15" :left-dl "\x15" :left-sdl "|" :left-ddl "|" :left-nl "|")
-  "Pseudo graphics style.")
-
-(defvar tpum-style-frame
-  (make-tpum-style
-   :border-face tpum-frame-face
-   :toggle-dis "[ ] " :toggle-act "[x] " :radio-dis "( ) " :radio-act "(*) "
-   :submenu " >>"
-   :title-sep "=" :title-sl "" :title-sr ""
-   :left "" :right "" :top "-" :bottom "-"
-   :left-top "" :left-bottom "" :right-top "" :right-bottom ""
-   :right-bot2 "" :left-bot2 "" :line-bot2 "" :center-bot2 "vvv"
-
-   :single-line "-" :double-line "=" :single-dashed-line "- -"
-   :double-dashed-line "= =" :no-line " "
-   :right-sl "" :right-dl "" :right-sdl "" :right-ddl "" :right-nl ""
-   :left-sl "" :left-dl "" :left-sdl "" :left-ddl "" :left-nl "")
-  "Separate frame style.")
-
-(defun tpum-style-toggle (&optional act)
-  "Return toggle button, if ACT non-nil toggle button is on."
-  (if act
-      (tpum-style-toggle-act (eval tpum-cstyle))
-    (tpum-style-toggle-dis (eval tpum-cstyle))))
-
-(defun tpum-style-radio (&optional act)
-  "Return radio button, if ACT is non-nil - radio button is on."
-  (if act
-      (tpum-style-radio-act (eval tpum-cstyle))
-    (tpum-style-radio-dis (eval tpum-cstyle))))
-
-(defmacro tpum-defmacro (new old)
-  "Define NEW accesor using OLD accessor."
-  `(defun ,new ()
-     (,old (eval tpum-cstyle))))
-
-(tpum-defmacro tpum-st-bface tpum-style-border-face)
-(tpum-defmacro tpum-st-td tpum-style-toggle-dis)
-(tpum-defmacro tpum-st-ta tpum-style-toggle-act)
-(tpum-defmacro tpum-st-rd tpum-style-radio-dis)
-(tpum-defmacro tpum-st-ra tpum-style-radio-act)
-(tpum-defmacro tpum-st-sub tpum-style-submenu)
-(tpum-defmacro tpum-st-ts tpum-style-title-sep)
-(tpum-defmacro tpum-st-tsl tpum-style-title-sl)
-(tpum-defmacro tpum-st-tsr tpum-style-title-sr)
-(tpum-defmacro tpum-st-l tpum-style-left)
-(tpum-defmacro tpum-st-r tpum-style-right)
-(tpum-defmacro tpum-st-t tpum-style-top)
-(tpum-defmacro tpum-st-b tpum-style-bottom)
-(tpum-defmacro tpum-st-lt tpum-style-left-top)
-(tpum-defmacro tpum-st-lb tpum-style-left-bottom)
-(tpum-defmacro tpum-st-lb2 tpum-style-left-bot2)
-(tpum-defmacro tpum-st-rt tpum-style-right-top)
-(tpum-defmacro tpum-st-rb tpum-style-right-bottom)
-(tpum-defmacro tpum-st-rb2 tpum-style-right-bot2)
-(tpum-defmacro tpum-st-lbot2 tpum-style-line-bot2)
-(tpum-defmacro tpum-st-cbot2 tpum-style-center-bot2)
-(tpum-defmacro tpum-st-sl tpum-style-single-line)
-(tpum-defmacro tpum-st-dl tpum-style-double-line)
-(tpum-defmacro tpum-st-sdl tpum-style-single-dashed-line)
-(tpum-defmacro tpum-st-ddl tpum-style-double-dashed-line)
-(tpum-defmacro tpum-st-noline tpum-style-no-line)
-(tpum-defmacro tpum-st-rsl tpum-style-right-sl)
-(tpum-defmacro tpum-st-rdl tpum-style-right-dl)
-(tpum-defmacro tpum-st-rsdl tpum-style-right-sdl)
-(tpum-defmacro tpum-st-rddl tpum-style-right-ddl)
-(tpum-defmacro tpum-st-rnl tpum-style-right-nl)
-(tpum-defmacro tpum-st-lsl tpum-style-left-sl)
-(tpum-defmacro tpum-st-ldl tpum-style-left-dl)
-(tpum-defmacro tpum-st-lsdl tpum-style-left-sdl)
-(tpum-defmacro tpum-st-lddl tpum-style-left-ddl)
-(tpum-defmacro tpum-st-lnl tpum-style-left-nl)
-
-(defstruct tpum-ctx
-  local-mode-map local-mode-name
-  overriding-local-map
-  recursive-p post-command-hooks truncate-lines
-  after-change-functions before-change-functions
-  undo-list selective-display
-  buffer point tmpoint column width offset height atomics-list todel-list
-  frame child-ctx parent-ctx
-
-  plist)                                ; user defined plist
-
-;;; Functions
-(defun tpum-plist-put (ctx prop val)
-  "In CTX put property PROP with value VAL."
-  (setf (tpum-ctx-plist ctx) (plist-put (tpum-ctx-plist ctx) prop val)))
-
-(defun tpum-plist-get (ctx prop)
-  "In CTX get value of property PROP."
-  (plist-get (tpum-ctx-plist ctx) prop))
-
-(defun tpum-plist-rem (ctx prop)
-  "In CTX remove property PROP."
-  (setf (tpum-ctx-plist ctx) (plist-remprop (tpum-ctx-plist ctx) prop)))
-
-(defun tpum-delete-region (tpum-ctx start end)
-  "In TPUM-CTX delete region from START to END.
-Check for overlaps inside todel-list in TPUM-CTX."
-  (push (cons start end) (tpum-ctx-todel-list tpum-ctx)))
-
-(defun tpum-get-context (&optional point)
-  "Return tpum context at POINT."
-  (get-text-property (or point (point)) 'tpum-ctx))
-
-(defun tpum-get-global-context (&optional tpum-ctx)
-  "Return global tpum context.
-Optionally local tpum context TPUM-CTX can be specified."
-  (let ((ctx (or tpum-ctx (tpum-get-context))))
-    (while (tpum-get-context (tpum-ctx-point ctx))
-      (setq ctx (tpum-get-context (tpum-ctx-point ctx))))
-    ctx))
-
-(defun tpum-line-num (&optional pnt)
-  "Get number of line at PNT.
-PNT default to `(point)'."
-  (let ((p (or pnt (point))))
-    (count-lines (point-min) p)))
-
-(defun tpum-current-column ()
-  "Return current column skiping invisible chars."
-  (let ((spnt (point))
-        (col 0))
-    (save-excursion
-      (beginning-of-line)
-      (while (< (point) spnt)
-        (unless (and (get-text-property (point) 'invisible)
-                     (not (get-text-property (point) 'tpum-invisible)))
-          (setq col (1+ col)))
-        (forward-char 1)))
-    col))
-
-(defun tpum-forward-char (num)
-  "Forward NUM chars skiping invisible chars."
-  (let ((fcfun (if (>= num 0) 'forward-char 'backward-char)))
-    (when (< num 0)
-      (setq num (- num)))
-
-    ;; First skip any invisible characters at point
-    (while (get-text-property (point) 'invisible)
-      (funcall fcfun 1))
-
-    (while (> num 0)
-      (funcall fcfun 1)
-      (unless (and (get-text-property (point) 'invisible)
-                   (not (get-text-property (point) 'tpum-invisible)))
-        (setq num (1- num))))))
-
-(defun tpum-next-line (num)
-  "Move NUM next lines in tpum's CTX."
-  (let ((ccol (tpum-current-column)))
-    (forward-line num)
-    (tpum-forward-char ccol)))
-
-(defun tpum-move-to-offset (&optional tpum-context)
-  "In TPUM-CONTEXT move point to offset column."
-  (let ((ctx (or tpum-context (tpum-get-context))))
-    (when (tpum-ctx-p ctx)
-      (beginning-of-line)
-      (tpum-forward-char (+ (tpum-ctx-column ctx) (tpum-ctx-offset ctx) -1)))))
-
-(defun tpum-get-mi (&optional point)
-  "Get menu item at POINT."
-  (get-text-property (or point (point)) 'tpum-menu-item))
-
-(defun tpum-mi-help (mi)
-  "Display menu item MI help string in minibuffer."
-  (let ((help (tpum-get-keyword mi :help)))
-    (when help
-      (message help))))
-
-(defun tpum-move-point (arg &optional ctx)
-  "Move point ARG times down.
-If CTX is ommited `tpum-get-context' will be used."
-  (let ((tpum-ctx (or ctx (tpum-get-context)))
-        (sarg arg)
-        (lines-to-go 0)
-        (not-break t))
-    (save-excursion
-      (catch 'lout
-        (while not-break
-          (condition-case nil
-              (tpum-next-line (if (> sarg 0) 1 -1))
-            (t (throw 'lout (setq lines-to-go 0))))
-
-          (when (not (eq (tpum-get-context) tpum-ctx))
-            (throw 'lout (setq lines-to-go 0)))
-
-          (let ((mi (tpum-get-mi)))
-            (when (and mi (tpum-mi-active-p tpum-ctx mi))
-              (setq arg (if (> arg 0) (1- arg) (1+ arg)))
-              (when (= arg 0)
-                (setq not-break nil))))
-          (setq lines-to-go (1+ lines-to-go)))
-        ))
-
-    (if (= lines-to-go 0)
-        (error "TPUM: can't move")
-      (tpum-next-line (if (> sarg 0) lines-to-go (- lines-to-go))))
-    ))
-
-;;; Interactive commands
-(defun tpum-help ()
-  "Show tpum help in minibuffer."
-  (interactive)
-  (message
-   (substitute-command-keys
-    (concat
-     "`\\[tpum-describe-bindings]':bindings `\\[tpum-help]':help "
-     "`\\[tpum-next]':next `\\[tpum-prev]':prev `\\[tpum-quit]':quit"))))
-
-(defun tpum-describe-bindings ()
-  "Describe TPUM bindings."
-  (interactive)
-
-  (with-displaying-help-buffer
-   (lambda ()
-     (let ((local (current-local-map)))
-       (set-buffer standard-output)
-       (insert "Key Bindings for TPUM:\n")
-       (describe-bindings-internal local)))
-   "bindings for TPUM mode"))
-
-(defun tpum-next (arg)
-  "Goto ARG next visible items."
-  (interactive "p")
-
-  (tpum-submenu-hide)
-  (condition-case nil
-      (tpum-move-point arg)
-    (t (call-interactively 'tpum-goto-first)))
-  (tpum-mi-help (tpum-get-mi))
-  (when tpum-auto-submenu-mode
-    (tpum-submenu-show)))
-
-(defun tpum-prev (arg)
-  "Goto ARG previous visible items."
-  (interactive "p")
-
-  (tpum-submenu-hide)
-  (condition-case nil
-      (tpum-move-point (- arg))
-    (t (call-interactively 'tpum-goto-last)))
-  (tpum-mi-help (tpum-get-mi))
-  (when tpum-auto-submenu-mode
-    (tpum-submenu-show)))
-
-(defun tpum-goto-first ()
-  "Go to the first menu item."
-  (interactive)
-  
-  (tpum-submenu-hide)
-  (while (condition-case nil
-             (progn (tpum-move-point -1) t)
-           (t nil)))
-  (when tpum-auto-submenu-mode
-    (tpum-submenu-show))
-  (tpum-mi-help (tpum-get-mi)))
-
-(defun tpum-goto-last ()
-  "Go to the last menu item."
-  (interactive)
-
-  (tpum-submenu-hide)
-  (while (condition-case nil
-             (progn (tpum-move-point 1) t)
-           (t nil)))
-
-  (when tpum-auto-submenu-mode
-    (tpum-submenu-show))
-  (tpum-mi-help (tpum-get-mi)))
-
-(defun tpum-auto-submenu-toggle ()
-  "Toggle `tpum-auto-submenu-mode'."
-  (interactive)
-  (setq tpum-auto-submenu-mode (not tpum-auto-submenu-mode))
-
-  (if tpum-auto-submenu-mode
-      (message "tpum: Auto submenus mode on.")
-    (message "tpum: Auto submenus mode off."))
-
-  (when (interactive-p)
-    (if tpum-auto-submenu-mode
-        (tpum-submenu-show)
-      (tpum-submenu-hide))))
-
-(defun tpum-isearch-global-toggle ()
-  "Toggle `tpum-isearch-global-scope'."
-  (interactive)
-  (setq tpum-isearch-global-scope (not tpum-isearch-global-scope))
-  (if tpum-isearch-global-scope
-      (message "tpum: Global isearch mode on.")
-    (message "tpum: Global isearch mode off.")))
-
-(defvar tpum-isearch-mode nil
-  "Non nil mean that isearch uses tpum's searcher.")
-
-(defun tpum-search-data (searcher what &optional bound noerror count)
-  "Use SEARCHER to search WHAT in tpum menu after or before point.
-If SEARCHER contain 'backward' search performed before point.
-BOUND, NOERROR and COUNT are described in `search-forward'."
-  (let* ((cctx (tpum-get-context))
-         (origin (point))
-         (cnt (or count 1))
-         (step (cond ((= cnt 0) 0)
-                     ((> cnt 0) 1)
-                     (t (setq cnt (- cnt)) -1)))
-         found next sstart send mi)
-    (unless (zerop step)
-      (while (and (not found)
-                  (setq next (funcall searcher what bound t step)))
-        (setq sstart (match-beginning 0)
-              send (match-end 0)
-              mi (tpum-get-mi))
-
-        (if (= sstart send)
-            (setq found t)
-          (goto-char next)
-          (when (and (if tpum-isearch-global-scope
-                         t
-                       (eq (tpum-get-context) cctx))
-                     mi (tpum-mi-active-p cctx mi))
-            (setq found t)))))
-
-    (cond ((null found)
-           (setq next origin
-                 send origin))
-          ((= step (if (string-match "backward" (symbol-name searcher)) 1 -1))
-           (setq next send
-                 send sstart))
-          (t
-           (setq next sstart)))
-    (goto-char next)
-    ;; Setup the returned value and the `match-data' or maybe fail!
-    (funcall searcher what send noerror step)))
-
-(defun tpum-search-forward (what &optional bound noerror count)
-  "Search tpum menu item forward from point for string WHAT.
-For optional BOUND, NOERROR and COUNT see description for `search-forward'."
-  (tpum-search-data #'search-forward what bound noerror count))
-
-(defun tpum-search-backward (what &optional bound noerror count)
-  "Search tpum menu item backward from point for string WHAT.
-For optional BOUND, NOERROR and COUNT see description for `search-backward'."
-  (tpum-search-data #'search-backward what bound noerror count))
-
-(defmacro tpum-define-search-advice (searcher)
-  "Advice the built-in SEARCHER function to do tpum search.
-That is to call the tpum searcher when variables
-`isearch-mode' and `tpum-isearch-mode' are non-nil."
-  (let ((tpum-searcher (intern (format "tpum-%s" searcher))))
-    `(defadvice ,searcher (around unused activate)
-       (if (and isearch-mode tpum-isearch-mode
-                ;; The following condition ensure to do a tpum
-                ;; search on the `isearch-string' only!
-                (string-equal (ad-get-arg 0) isearch-string))
-           (let ((old-isearch-mode tpum-isearch-mode))
-             (unwind-protect
-                 ;; Temporarily set `tpum-isearch-mode' to
-                 ;; nil to avoid an infinite recursive call of the
-                 ;; tpum search function!
-                 (setq tpum-isearch-mode nil
-                       ad-return-value
-                       (funcall #',tpum-searcher
-                                (ad-get-arg 0) ; string
-                                (ad-get-arg 1) ; bound
-                                (ad-get-arg 2) ; no-error
-                                (ad-get-arg 3))) ; count
-               (setq tpum-isearch-mode old-isearch-mode)))
-         ad-do-it))))
-
-(tpum-define-search-advice search-forward)
-(tpum-define-search-advice search-backward)
-
-(defun tpum-isearch-end-hook ()
-  "To be used in `isearch-mode-end-hook'."
-  (when tpum-isearch-mode
-    ;; Hide submenu if needed
-    (when (eq (tpum-get-context)
-              (save-excursion
-                (goto-char isearch-opoint)
-                (tpum-get-context)))
-      (save-excursion
-        (goto-char isearch-opoint)
-        (tpum-submenu-hide)))
-
-    (tpum-move-to-offset)
-    (when tpum-auto-submenu-mode
-      (tpum-submenu-show))
-    (tpum-mi-help (tpum-get-mi))))
-
-(defun tpum-search-symbol (chr)
-  "Begin to search for CHR."
-  (let ((executing-kbd-macro t))        ; do not make isearch to be modal
-    (isearch-mode t nil nil (not (interactive-p)))
-    (isearch-process-search-string
-     (char-to-string chr)
-     (isearch-text-char-description chr))))
-
-(defun tpum-default-command (keys)
-  "Search ahead after KEYS presses."
-  (interactive (list (this-command-keys)))
-  (let* ((evk (and (= (length keys) 1)
-                   (key-press-event-p (aref keys 0))
-                   (null (event-modifiers (aref keys 0)))
-                   (event-key (aref keys 0))))
-         (kchr evk))
-    (if (and tpum-search-ahead-mode (characterp kchr))
-        (tpum-search-symbol kchr)
-
-      (if (eq (event-type (aref keys 0)) 'button-release)
-          ;; Button release event are ok
-          nil
-        (signal 'undefined-keystroke-sequence (list keys))))))
-
-(defun tpum-quit (&optional ctx)
-  "Exit tpum mode, using tpum CTX."
-  (interactive)
-  (let ((tpum-ctx (or ctx (tpum-get-context)))
-        (buffer-read-only nil))
-
-    (unless (tpum-ctx-p ctx)
-      (tpum-submenu-hide))
-    (if (null tpum-ctx)
-        (error "No tpum context at point")
-
-      (if (tpum-ctx-frame tpum-ctx)
-          (select-frame (tpum-ctx-frame tpum-ctx))
-
-        ;; Restore things
-        (tpum-restore-todel-atomics tpum-ctx))
-        
-      (setq tpum-isearch-mode (cdr tpum-isearch-mode))
-
-      (setq post-command-hook (tpum-ctx-post-command-hooks tpum-ctx))
-      (setq truncate-lines (tpum-ctx-truncate-lines tpum-ctx))
-      (setq after-change-functions (tpum-ctx-after-change-functions tpum-ctx))
-      (setq before-change-functions (tpum-ctx-before-change-functions tpum-ctx))
-      (setq buffer-undo-list (tpum-ctx-undo-list tpum-ctx))
-      (setq selective-display (tpum-ctx-selective-display tpum-ctx))
-
-      (setq overriding-local-map
-            (tpum-ctx-overriding-local-map tpum-ctx))
-      (use-local-map (tpum-ctx-local-mode-map tpum-ctx))
-      (setq mode-name (tpum-ctx-local-mode-name tpum-ctx))
-
-      (goto-char (tpum-ctx-point tpum-ctx))
-      (set-buffer-modified-p nil)
-
-      ;; ctl-arrow used by pseudo style
-      (when (tpum-plist-get tpum-ctx 'ctl-arrow)
-        (setq ctl-arrow (tpum-plist-get tpum-ctx 'ctl-arrow)))
-
-      (when (tpum-ctx-recursive-p tpum-ctx)
-        (exit-recursive-edit))
-
-      ;; Generate fake misc-user event, to make imenu work
-      (setq unread-command-event
-            (make-event 'misc-user '(x 0 y 0 button 1 function ignore)))
-
-      (when (tpum-ctx-frame tpum-ctx)
-        (delete-frame (tpum-ctx-frame tpum-ctx)))
-
-      ;; Select parent frame if any
-      (let ((pctx (tpum-ctx-parent-ctx tpum-ctx)))
-        (when (tpum-ctx-p pctx)
-          ;; Unset child ctx and select parent's frame
-          (setf (tpum-ctx-child-ctx pctx) nil)
-          (when (tpum-ctx-frame pctx)
-            (focus-frame (tpum-ctx-frame pctx)))))
-
-      (when (interactive-p)
-        (message "TPUM exit.")))))
-
-(defun tpum-global-quit ()
-  "Globally quit tpum."
-  (interactive)
-  (while (tpum-get-context)
-    (tpum-quit)))
-
-(defun tpum-submenu-show ()
-  "Show submenu if any."
-  (interactive)
-  (let ((tmi (tpum-get-mi))
-        (tpum-auto-submenu-mode nil)
-        nctx pctx)
-    (when (and tmi (consp tmi))
-      (save-excursion
-        (tpum-select)
-        (setq nctx (tpum-get-context)))
-      (setq pctx (tpum-ctx-parent-ctx nctx))
-      (when (and (tpum-ctx-p pctx) (tpum-ctx-frame pctx))
-        (focus-frame (tpum-ctx-frame pctx))))))
-
-(defun tpum-submenu-hide ()
-  "Hide submenu if any."
-  (interactive)
-  (let* ((cctx (tpum-get-context))
-         (smctx (tpum-ctx-child-ctx cctx)))
-    (when (tpum-ctx-p smctx)
-      (save-excursion
-        (tpum-quit smctx)))))
-
-(defun tpum-submenu-toggle ()
-  "Show or hide submenu."
-  (interactive)
-  (if (tpum-ctx-child-ctx (tpum-get-context))
-      (tpum-submenu-hide)
-    (tpum-submenu-show)))
-
-(defun tpum-submenu-select ()
-  "Select submenu."
-  (interactive)
-  (let ((smctx (tpum-ctx-child-ctx (tpum-get-context))))
-    (when (tpum-ctx-p smctx)
-      (if (tpum-ctx-frame smctx)
-          (focus-frame (tpum-ctx-frame smctx))
-
-        (goto-char (tpum-ctx-tmpoint smctx))
-        (tpum-move-point 1 smctx)
-        (tpum-move-to-offset smctx))
-
-      (when tpum-auto-submenu-mode
-        (tpum-submenu-show)))))
-
-(defun tpum-apply-callback (cbfun)
-  "Apply menuitem's call back function CBFUN."
-  (cond ((listp cbfun) (eval cbfun))
-        ((commandp cbfun) (command-execute cbfun))
-        ((symbolp cbfun) (funcall cbfun))
-        (t nil)))
-
-(defvar tpum-frame-y-offset 42 "Hack")
-(defvar tpum-frame-x-offset 6 "Hack")
-
-(defun tpum-select ()
-  "Select current menu item."
-  (interactive)
-  (let ((tpum-ctx (tpum-get-context))
-        (mi (tpum-get-mi))
-        nctx)
-    (if (not mi)
-        (progn
-          (beep)
-          (message "TPUM: No menu item under cursor."))
-
-      (cond ((listp mi)                 ;submenu
-             (if (tpum-ctx-child-ctx tpum-ctx)
-                 (call-interactively 'tpum-submenu-select)
-
-               (setq nctx
-                     (if (tpum-ctx-frame tpum-ctx)
-                         (let* ((tfr (tpum-ctx-frame tpum-ctx))
-                                (tpum-frame-y-offset 0) ; hack
-                                (tpum-frame-x-offset 2)) ; hack
-                           (tpum-frame-do-menu
-                            mi
-                            (cons (+ (frame-property tfr 'left)
-                                     (frame-pixel-width tfr)
-                                     tpum-frame-x-offset)
-                                  (+ (frame-property tfr 'top)
-                                     (cdr (tpum-frame-get-coord))))))
-
-                       (tpum-do-menu mi (save-excursion
-                                          (tpum-next-line -1)
-                                          (tpum-forward-char
-                                           (- (tpum-ctx-width tpum-ctx)
-                                              (tpum-ctx-offset tpum-ctx) -1))
-                                          (point)))))
-               (setf (tpum-ctx-child-ctx tpum-ctx) nctx)
-               (setf (tpum-ctx-parent-ctx nctx) tpum-ctx)))
-
-            ((vectorp mi)               ; Normal menu-item
-             (tpum-global-quit)
-             (tpum-apply-callback (cadr (append mi nil))))
-
-            (t (message "Unknown menu item type."))))))
-
-(defun tpum-mode (tpum-ctx)
-  "Enter tpum mode, using TPUM-CTX."
-  (setf (tpum-ctx-local-mode-map tpum-ctx) (current-local-map))
-  (setf (tpum-ctx-local-mode-name tpum-ctx) mode-name)
-  (setf (tpum-ctx-overriding-local-map tpum-ctx)
-        overriding-local-map)
-
-  (setq overriding-local-map tpum-mode-map)
-  (use-local-map tpum-mode-map)
-  (setq tpum-isearch-mode (cons t tpum-isearch-mode))
-
-  (set-buffer-modified-p nil)
-
-  (add-hook 'isearch-mode-end-hook 'tpum-isearch-end-hook))
-
-(defun tpum-safe-delrec (tpum-ctx width height &optional startpoint)
-  "In TPUM-CTX safe delete rectangle with sizes WIDTH HEIGHT.
-Starting from STARTPOINT, if ommited `point' will be used."
-  (let (ccol ep)
-    (save-excursion
-      (and startpoint (goto-char startpoint))
-      (setq ccol (tpum-current-column))
-      (while (> height 0)
-        ;; XXX Untabify line
-        (funcall #'(lambda (beg end)
-                     (save-excursion
-                       (narrow-to-region beg end)
-                       (goto-char beg)
-                       (while (re-search-forward "\t" nil t)
-                         (let ((indent-tabs-mode nil))
-                           (replace-match (make-string tab-width ?\x20))))
-                       (widen)))
-                 (progn (beginning-of-line) (point))
-                 (progn (end-of-line) (point)))
-
-        ;; Now we are at the end of line
-        (setq ep (tpum-current-column))
-        (when (< (- ep ccol) width)
-          (end-of-line)
-          (tpum-delete-region
-           tpum-ctx
-           (point-marker)
-           (progn (insert (make-string (- width (- ep ccol)) ?\x20))
-                  (point-marker))))
-
-        (beginning-of-line)
-        (tpum-forward-char ccol)
-        (push (cons (point-marker)
-                    (save-excursion
-                      (forward-char width)
-                      (point-marker)))
-              (tpum-ctx-atomics-list tpum-ctx))
-
-        (add-text-properties (point) (+ (point) width) '(invisible t))
-
-        (end-of-line)
-        (when (eobp)
-          (tpum-delete-region
-           tpum-ctx
-           (point-marker) (progn (insert "\n") (point-marker))))
-        (forward-line)
-        (setq height (1- height))))
-    (goto-char (+ (point) width))))
-
-(defun tpum-restore-todel-atomics (ctx)
-  "Restore some stuff of tpum CTX."
-  (mapc #'(lambda (el)
-            (delete-region (marker-position (car el))
-                           (marker-position (cdr el))))
-        (tpum-ctx-todel-list ctx))
-  (mapc #'(lambda (el)
-            (add-text-properties (marker-position (car el))
-                                 (marker-position (cdr el))
-                                 '(invisible nil)))
-        (tpum-ctx-atomics-list ctx)))
-
-(defun tpum-insert-face (str faces)
-  "Insert STR with FACES."
-  (declare (special tpum-ctx))
-  (cond ((stringp str)
-         (set-text-properties (point) (progn (insert str) (point))
-                              (list 'face faces)))
-        ((glyphp str)
-         ;; Insert glyph
-         (let ((width (/ (glyph-width str) (font-width (face-font 'default)))))
-           (tpum-delete-region tpum-ctx (point-marker)
-                               (progn (insert (make-string width ?X))
-                                      (point-marker)))
-           (add-text-properties (- (point) width) (point)
-                                '(tpum-invisible t invisible t))
-           (set-extent-begin-glyph (make-extent (point) (point)) str)))))
-
-(defun tpum-insert-string (tpum-ctx tpum-string)
-  "Using TPUM-CTX insert TPUM-STRING.
-TPUM-STRING is list of cons cells where car is string and cdr is face
-for string."
-  (mapc #'(lambda (el)
-            (let ((str (if (consp el) (car el) el))
-                  (face (if (consp el) (cdr el) 'default)))
-              (tpum-delete-region
-               tpum-ctx (point-marker)
-               (progn (tpum-insert-face str face)
-                      (point-marker)))))
-        tpum-string))
-
-(defun tpum-insert-menu (tpum-menu tpum-ctx &optional startpoint)
-  "Insert TPUM-MENU using TPUM-CTX at STARTPOINT.
-TPUM-MENU is list of conses which car is menu-item and cdr is tpum string."
-  (let ((lines tpum-menu))
-    (when startpoint
-      (goto-char startpoint))
-
-    (while lines
-      (save-excursion
-        (add-text-properties (point)
-                             (progn (tpum-insert-string tpum-ctx (cdar lines))
-                                    (point))
-                             (list 'tpum-ctx tpum-ctx 'tpum-menu-item
-                                   (caar lines))))
-      (setq lines (cdr lines))
-      (when lines
-        (tpum-next-line 1)))))
-
-(defun tpum-get-keyword (menu-item keyword &optional defret)
-  "From MENU-ITEM get KEYWORD value.
-If KEYWORD not found DEFRET returned."
-  (let* ((mi-list (if (listp menu-item) menu-item (append menu-item nil)))
-         (ckword (car mi-list))
-         (kw-retval defret))
-    (while mi-list
-      (if (eq ckword keyword)
-          (progn
-            (setq kw-retval (cadr mi-list))
-            (setq mi-list nil)))        ; break
-      (setq mi-list (cdr mi-list))
-      (setq ckword (car mi-list)))
-    kw-retval))
-
-;; FSFmacs
-(unless (fboundp 'keywordp)
-  (defun keywordp (sym)
-    (eq (aref (symbol-name sym) 0) ?:)))
-
-(defun tpum-get-suffix (menu-item)
-  "Get suffix of MENU-ITEM."
-  (if (vectorp menu-item)
-      (let* ((mit (append menu-item nil))
-             (sf1 (and (> (length mit) 3)
-                       (not (keywordp (nth 2 mit)))
-                       (not (keywordp (nth 3 mit)))
-                       (nth 3 mit)))
-             (sf2 (tpum-get-keyword menu-item :suffix)))
-        (or sf2 sf1))
-    nil))
-        
-(defun tpum-mi-active-p (tpum-ctx menu-item)
-  "Return non-nil if in TPUM-CTX, MENU-ITEM is active."
-  ;; Note that if :active uses current point position, strange things
-  ;; will happen, so there a little work around to redefine `point' to
-  ;; return saved point position.
-  (save-excursion
-    (set-buffer (tpum-ctx-buffer (tpum-get-global-context tpum-ctx)))
-    (goto-char (tpum-ctx-point (tpum-get-global-context tpum-ctx)))
-    (cond ((stringp menu-item) nil)     ; title or separator
-          ((consp menu-item) t)         ; submenu
-          ((vectorp menu-item)
-           (let ((mit (append menu-item nil))
-                 (at2 (tpum-get-keyword menu-item :active t)))
-             
-             (cond ((and (> (length mit) 2) (not (keywordp (nth 2 mit))))
-                    (nth 2 mit))
-                   (at2 (eval at2))
-                   (t t)))))))
-
-(defun tpum-setup-ctx (menuspec tpum-ctx)
-  "According to MENUSPEC setup TPUM-CTX."
-  (let ((fel (car menuspec))
-        (ret-wid 0)
-        (ret-hei 0)
-        (ret-off 1))                    ; XXX see tpum-move-to-offset
-    (while fel
-      (let* ((mistyle (cond ((vectorp fel) (tpum-get-keyword fel :style))
-                            ((consp fel) nil)
-                            (t nil)))
-             (xpm-data (tpum-get-keyword fel :xpm-data))
-             (glyph (and xpm-data (make-glyph xpm-data)))
-             (offset (cond ((eq mistyle 'toggle)
-                            (length (tpum-st-td)))
-                           ((eq mistyle 'radio)
-                            (length (tpum-st-rd)))
-                           (glyph
-                            (1+ (/ (glyph-width glyph)
-                                   (font-width (face-font 'default)))))
-                           (t 0)))
-             (width (length
-                     (cond ((vectorp fel) (car (append fel nil)))
-                           ((consp fel) (concat (car fel) (tpum-st-sub)))
-                           ((stringp fel) fel)
-                           (t ""))))
-             (suffix (tpum-get-suffix fel))
-             (suflen (if suffix (1+ (length (eval suffix))) 0)))
-
-        (when (> (+ width suflen) ret-wid)
-          (setq ret-wid (+ width suflen)))
-        (setq ret-hei (1+ ret-hei))
-        (when (> offset ret-off)
-          (setq ret-off offset))
-
-        (setq menuspec (cdr menuspec))
-        (setq fel (car menuspec))))
-
-    (setf (tpum-ctx-offset tpum-ctx) ret-off)
-    (setf (tpum-ctx-width tpum-ctx) (+ ret-wid ret-off)) ; XXX
-    (setf (tpum-ctx-height tpum-ctx) ret-hei)))
-
-(defun tpum-make-delim (menu-item width)
-  "Make delimiter string using MENU-ITEM.
-Delimeter shold be WIDTH chars length."
-  (let (lb rb lin)
-    (cond ((string= menu-item "--:singleLine")
-           (setq lb (tpum-st-lsl))
-           (setq rb (tpum-st-rsl))
-           (setq lin (tpum-st-sl)))
-          ((string= menu-item "--:doubleLine")
-           (setq lb (tpum-st-ldl))
-           (setq rb (tpum-st-rdl))
-           (setq lin (tpum-st-dl)))
-          ((string= menu-item "--:singleDashedLine")
-           (setq lb (tpum-st-lsdl))
-           (setq rb (tpum-st-rsdl))
-           (setq lin (tpum-st-sdl)))
-          ((string= menu-item "--:doubleDashedLine")
-           (setq lb (tpum-st-lddl))
-           (setq rb (tpum-st-rddl))
-           (setq lin (tpum-st-ddl)))
-
-          ;; Default separator as is "--:singleLine"
-          (t
-           (setq lb (tpum-st-lsl))
-           (setq rb (tpum-st-rsl))
-           (setq lin (tpum-st-sl))))
-
-    (list
-     (cons lb (tpum-st-bface))
-     (substring
-      (mapconcat 'identity
-                 (make-list width lin) "")
-      0 width)
-     (cons rb (tpum-st-bface)))))
-
-(defun tpum-fixate-name (name)
-  "Remove accell stuff from NAME."
-  (or (and (stringp name)
-           (replace-in-string name "%_" ""))
-      name))
-
-(defun tpum-mitotmi (menu-item tpum-ctx)
-  "Convert MENU-ITEM to tpum menu item using TPUM-CTX."
-  (let ((width (tpum-ctx-width tpum-ctx))
-;       (height (tpum-ctx-height tpum-ctx))
-        (offset (tpum-ctx-offset tpum-ctx)))
-
-    (cond ((listp menu-item)            ;submenu
-           (let ((iname (tpum-fixate-name (car menu-item))))
-             (list (cons (tpum-st-l) (tpum-st-bface))
-                   (concat (make-string offset ?\ ) iname)
-                   (concat (make-string
-                            (- width (length iname) offset
-                               (length (tpum-st-sub))) ?\ ))
-                   (tpum-st-sub)
-                   (cons (tpum-st-r) (tpum-st-bface)))))
-
-          ((vectorp menu-item)
-           (let* ((mi-list (append menu-item nil))
-                  (iname (car mi-list))
-                  (accel (tpum-get-keyword menu-item :accelerator))
-                  (style (tpum-get-keyword menu-item :style))
-                  (active (tpum-mi-active-p tpum-ctx menu-item))
-                  (selected (eval (tpum-get-keyword menu-item :selected)))
-                  (xpm-img (eval (tpum-get-keyword menu-item :xpm-data)))
-                  (suffix (eval (tpum-get-suffix menu-item))))
-
-             (when suffix
-               (setq iname (if (> (length iname) 0)
-                               (concat iname " " suffix)
-                             suffix)))
-             (when xpm-img
-               (setq xpm-img (make-glyph xpm-img))
-               (when (or (not (= (glyph-height xpm-img)
-                                 (font-height (face-font 'default))))
-                         (not (member (glyph-width xpm-img)
-                                      (list (font-width (face-font 'default))
-                                            (* 2 (font-width
-                                                  (face-font 'default)))))))
-                 (error (format "Invalid xpm-img sizes %S"
-                                (cons (glyph-width xpm-img)
-                                      (glyph-height xpm-img))))))
-
-             ;; Deal with accel key stuff
-             (when (string-match "%_\\(.\\)" iname)
-               (setq accel (string-to-char (match-string 1 iname))))
-             (setq iname (tpum-fixate-name iname))
-
-             (cond ((eq style 'toggle)
-                    (list
-                     (cons (tpum-st-l) (tpum-st-bface))
-                     (cons (tpum-style-toggle selected) (tpum-da-face active))
-                     (cons iname (if selected
-                                     (list (tpum-da-face active)
-                                           'tpum-toggled-face)
-                                   (tpum-da-face active)))
-                     (make-string (- width (length iname) offset) ?\x20)
-                     (cons (tpum-st-r) (tpum-st-bface))))
-
-                   ((eq style 'radio)
-                    (list
-                     (cons (tpum-st-l) (tpum-st-bface))
-                     (cons (tpum-style-radio selected) (tpum-da-face active))
-                     (cons iname (if selected
-                                     (list (tpum-da-face active)
-                                           'tpum-toggled-face)
-                                   (tpum-da-face active)))
-                     (make-string (- width (length iname) offset) ?\ )
-                     (cons (tpum-st-r) (tpum-st-bface))))
-                   ;; TODO: radio, normal, etc
-                   (t
-                    (list
-                     (cons (tpum-st-l) (tpum-st-bface))
-                     (when xpm-img
-                       (cons xpm-img nil))
-                     (make-string
-                      (if xpm-img
-                          (- offset (/ (glyph-width xpm-img)
-                                       (font-width (face-font 'default))))
-                        offset)
-                      ?\x20)
-                     (cons iname (tpum-da-face active))
-                     (make-string (- width (length iname) offset) ?\ )
-                     (cons (tpum-st-r) (tpum-st-bface)))))
-             ))
-
-          ((stringp menu-item)
-           (cond ((and (> (length menu-item) 1)
-                       (string= "--" (substring menu-item 0 2)))
-                  (tpum-make-delim menu-item width))
-
-                 (t (list
-                     (cons (tpum-st-l) (tpum-st-bface))
-                     (make-string offset ?\ )
-                     (cons menu-item 'tpum-deactive-face)
-                     (make-string (- width (length menu-item) offset) ?\x20)
-                     (cons (tpum-st-r) (tpum-st-bface))))))
-
-          ((symbolp menu-item)
-           (cond ((eq menu-item 'menu-begin)
-                  (list
-                   (cons (tpum-st-lt) (tpum-st-bface))
-                   (cons (substring
-                          (mapconcat 'identity
-                                     (make-list width (tpum-st-t)) "")
-                          0 width) (tpum-st-bface))
-                   (cons (tpum-st-rt) (tpum-st-bface))))
-                 ((eq menu-item 'menu-title)
-                  (list
-                   (cons (tpum-st-l) (tpum-st-bface))
-                   (cons (eval menu-item) 'tpum-title-face)
-                   (make-string (- width (length (eval menu-item))) ?\x20)
-                   (cons (tpum-st-r) (tpum-st-bface))))
-
-                 ((eq menu-item 'menu-separator)
-                  (list
-                   (cons (tpum-st-tsl) (tpum-st-bface))
-                   (cons (substring
-                          (mapconcat 'identity
-                                     (make-list width (tpum-st-ts)) "")
-                          0 width) (tpum-st-bface))
-                   (cons (tpum-st-tsr) (tpum-st-bface))))
-
-                 ((eq menu-item 'menu-end)
-                  (list
-                   (cons (tpum-st-lb) (tpum-st-bface))
-                   (cons (substring
-                          (mapconcat 'identity
-                                     (make-list width (tpum-st-b)) "")
-                          0 width) (tpum-st-bface))
-                   (cons (tpum-st-rb) (tpum-st-bface))))
-                 (t nil)))
-
-          (t (list
-              (cons (tpum-st-l) (tpum-st-bface))
-              "defstring"
-              (cons (tpum-st-r) (tpum-st-bface)))))))
-
-(defun tpum-menu-title (menuspec)
-  "Return title of MENUSPEC or nil, if there no title."
-  (let ((postit (car menuspec)))
-    (if (and (not (keywordp postit))
-             (not (listp postit)))
-        (tpum-fixate-name postit)
-      nil)))
-
-(defun tpum-menu-process-keywords (menuspec)
-  "Cut off all keywords in MENUSPEC."
-  (while (keywordp (car menuspec))
-    (setq menuspec (cddr menuspec)))
-  menuspec)
-
-(defun tpum-apply-filter (menuspec)
-  "Apply filter function to MENUSPEC and return new MENU."
-  (let* ((filter (tpum-get-keyword menuspec :filter))
-         (nm (if filter (funcall filter menuspec) menuspec)))
-    nm))
-
-(defun tpum-do-modal (ctx)
-  "Do modal mode using CTX."
-
-  (setf (tpum-ctx-recursive-p ctx) t)
-  (recursive-edit))
-
-(defun tpum-do-menu (menuspec &optional spoint frame-coords)
-  "Insert menu specified by MENUSPEC at the SPOINT.
-If FRAME-COORDS is given, then popup Emacs frame at FRAME-COORDS.
-Return tpum context."
-  ;; XXX TPUM-CTX-FRAME will hold frame coords temporary.
-  (let* ((tpum-ctx (make-tpum-ctx :frame frame-coords))
-         (filter (tpum-get-keyword menuspec :filter))
-         (menu-title (tpum-menu-title menuspec))
-         (desc (tpum-menu-process-keywords
-                (if menu-title (cdr menuspec) menuspec)))
-         (inrec nil)
-         (buffer-read-only nil))
-
-    (setf (tpum-ctx-buffer tpum-ctx) (current-buffer))
-    (setf (tpum-ctx-post-command-hooks tpum-ctx) post-command-hook)
-    (setq post-command-hook nil)
-    (setf (tpum-ctx-truncate-lines tpum-ctx) truncate-lines)
-    (setq truncate-lines tpum-truncate-lines)
-    (setf (tpum-ctx-after-change-functions tpum-ctx) after-change-functions)
-    (setq after-change-functions nil)
-    (setf (tpum-ctx-before-change-functions tpum-ctx) before-change-functions)
-    (setq before-change-functions nil)
-    (setf (tpum-ctx-undo-list tpum-ctx) buffer-undo-list)
-
-    (setf (tpum-ctx-selective-display tpum-ctx) selective-display)
-    (setq selective-display nil)
-
-    ;; pseudo stlye uses ctl-arrow
-    (when (eq tpum-cstyle 'tpum-style-pseudo)
-      (tpum-plist-put tpum-ctx 'ctl-arrow ctl-arrow)
-      (setq ctl-arrow 11))
-
-    ;; Apply filter function
-    (when filter
-      (setq desc (funcall filter desc)))
-
-    (tpum-setup-ctx (cons menu-title desc) tpum-ctx)
-
-    ;; Save position before moving point
-    (setf (tpum-ctx-point tpum-ctx) (point-marker))
-
-    ;; Construct list of strings to insert
-    (unless (tpum-ctx-frame tpum-ctx)
-      (setq inrec (cons (cons nil (tpum-mitotmi 'menu-begin tpum-ctx)) inrec))
-      (setf (tpum-ctx-height tpum-ctx) (+ 1 (tpum-ctx-height tpum-ctx))))
-
-    (when popup-menu-titles
-      (setq inrec (cons (cons nil (tpum-mitotmi 'menu-title tpum-ctx)) inrec)
-            inrec (cons (cons nil
-                              (tpum-mitotmi 'menu-separator tpum-ctx)) inrec))
-      (setf (tpum-ctx-height tpum-ctx) (+ 2 (tpum-ctx-height tpum-ctx))))
-
-    ;; Construct tpum-menu
-    (while desc
-      (let ((inc (tpum-get-keyword (car desc) :included))
-            (conf (tpum-get-keyword (car desc) :config)))
-        (setq inc (if inc (eval inc) t))
-        (setq inc (if conf (memq conf menubar-configuration) inc))
-
-        (when inc
-          (setq inrec (cons (cons (car desc)
-                                  (tpum-mitotmi (car desc) tpum-ctx))
-                            inrec))))
-      (setq desc (cdr desc)))
-
-    (unless (tpum-ctx-frame tpum-ctx)
-      (setq inrec (cons (cons nil (tpum-mitotmi 'menu-end tpum-ctx)) inrec)))
-    (setq inrec (nreverse inrec))
-
-    ;; Configure frame if needed
-    (when (tpum-ctx-frame tpum-ctx)
-      (let ((coord (tpum-ctx-frame tpum-ctx))
-            (blv (buffer-local-variables))
-            buf tcf)
-        (setf (tpum-ctx-frame tpum-ctx)
-              (tpum-frame-make (car coord) (cdr coord)
-                               (+ 2 (tpum-ctx-width tpum-ctx))
-                               (tpum-ctx-height tpum-ctx)))
-        (setq tcf (tpum-ctx-frame tpum-ctx))
-        (set-frame-size tcf (+ 2 (tpum-ctx-width tpum-ctx))
-                        (tpum-ctx-height tpum-ctx))
-        (setq buf (generate-new-buffer
-                   (concat "*tpum*" (if menu-title menu-title "empty*"))))
-        (set-window-buffer (frame-selected-window tcf) buf)
-        ;; Make it dedicated?
-        (set-buffer-dedicated-frame buf tcf)
-        (make-frame-visible tcf)
-        (focus-frame tcf)
-        (switch-to-buffer buf)
-        ;; Setup buffer local variables
-        (mapc #'(lambda (vv)
-                  (ignore-errors
-                    (set (car vv) (cdr vv))))
-              blv)))
-
-    ;; Save position before moving point
-    (setf (tpum-ctx-point tpum-ctx) (point-marker))
-
-    ;; Move point to start location
-    (when spoint
-      (goto-char spoint))
-
-    ;; XXX Delete rectangle
-    (tpum-safe-delrec tpum-ctx (+ (length (concat (tpum-st-l) (tpum-st-r)))
-                                  (tpum-ctx-width tpum-ctx))
-                      (length inrec))
-
-    (save-excursion
-      (tpum-insert-menu inrec tpum-ctx))
-
-    ;; Save column and point
-    (setf (tpum-ctx-tmpoint tpum-ctx) (point))
-    (setf (tpum-ctx-column tpum-ctx)
-          (+ (tpum-current-column) (length (tpum-st-l))))
-
-    (condition-case nil
-        (progn
-          (tpum-move-point 1)
-          (tpum-move-to-offset tpum-ctx))
-      (t nil))
-
-    (tpum-mode tpum-ctx)
-
-    (when tpum-auto-submenu-mode
-      (tpum-submenu-show))
-
-    tpum-ctx))
-
-;;;###autoload
-(defun tpum-popup-menu (menu &optional event)
-  "Popup MENU in text mode.
-EVENT is not used."
-  (tpum-do-menu menu))
-
-;;; Ballooning support
-(defun tpum-frame-make (x y width height &optional buffer)
-  "At X Y using WIDTH HEIGHT size make balloon frame to be used by tpum.
-Optionally you may specify BUFFER to select in newly created frame.
-Return Emacs frame."
-  (let ((frame (make-frame `((top-toolbar-visible-p . nil)
-                             (left-toolbar-visible-p . nil)
-                             (right-toolbar-visible-p . nil)
-                             (bottom-toolbar-visible-p . nil)
-                             (has-modeline-p . nil)
-                             (modeline-shadow-thickness . 0)
-                             (vertical-scrollbar-visible-p . nil)
-                             (horizontal-scrollbar-visible-p . nil)
-                             (menubar-visible-p . nil)
-                             (text-cursor-visible-p . t)
-                             (left-margin-width . 1)
-                             (initially-unmapped . t)
-                             (internal-border-width . 1)
-                             (name . "*tpum frame*")
-                             (border-width . 2)
-                             (border-color . ,(face-foreground-name
-                                               (tpum-st-bface)))
-                             (top . ,y)
-                             (left . ,x)
-                             (popup . ,(selected-frame))
-                             (minibuffer . nil)
-                             (width . ,width)
-                             (height . ,height)))))
-    (when buffer
-      (set-window-buffer (frame-selected-window frame) buffer)
-      (set-buffer-dedicated-frame buffer frame))
-
-    frame))
-
-(defun tpum-frame-get-coord ()
-  "Get coordinates of point."
-  (let ((edgs (window-pixel-edges))
-        (lw (/ (window-text-area-pixel-width) (window-width)))
-        (lh (/ (window-text-area-pixel-height) (window-height))))
-    (cons (+ tpum-frame-x-offset (* lw (current-column)) (car edgs))
-          (+ tpum-frame-y-offset
-             (* lh (count-lines (window-start) (window-point)))
-             (cadr edgs)))))
-
-(defun tpum-frame-do-menu (menu coor)
-  "Popup MENU in separate frame at COOR.
-COOR is cons cell where car is X and cdr is Y."
-;  (let ((tfr (tpum-frame-make (car coor) (cdr coor) 3 1)))
-;    (tpum-do-menu menu nil tfr)))
-  (tpum-do-menu menu nil coor))
-
-;;;###autoload
-(defun tpum-frame-popup-menu (menu &optional event)
-  "Popup MENU in separate frame.
-EVENT is some mouse event."
-  (tpum-frame-do-menu
-   menu
-   (if event
-       (cons (event-x-pixel event) (event-y-pixel event))
-     (tpum-frame-get-coord))))
-
-;;; TPUM minor mode
-;; Suggested by Uwe Brauer 
-
-(defvar tpum-minor-mode nil
-  "Non-nil if tpum minor mode enabled.")
-(make-variable-buffer-local 'tpum-minor-mode)
-
-;; Save old `popup-menu' function
-(defun old-popup-menu (menu &optional event))
-(fset 'old-popup-menu (symbol-function 'popup-menu))
-
-;; Redefine standart `popup-menu'
-(defun popup-menu-redefined-by-tpum (menu &optional event)
-  "Text mode `popup-menu' replacement.
-Poup MENU at point.
-Optionally mouse EVENT can be specified."
-  (if (or tpum-minor-mode tpum-global-mode)
-      (if (eq tpum-menu-type 'inline)
-          (tpum-popup-menu menu event)
-
-        ;; TODO:
-        ;;   - Maybe change `tpum-cstyle' to `tpum-style-frame'?
-        (tpum-frame-popup-menu menu event))
-    
-    ;; Use old popup menu function
-    (funcall #'old-popup-menu menu event)))
-
-(fset 'popup-menu (symbol-function 'popup-menu-redefined-by-tpum))
-
-;;;###autoload
-(defun tpum-minor-mode (&optional arg)
-  "Toggle tpum minor mode.
-With prefix ARG, turn on if positive, otherwise off."
-  (interactive (list (or (and current-prefix-arg
-                              (prefix-numeric-value current-prefix-arg))
-                         (if tpum-minor-mode 0 1))))
-  (setq tpum-minor-mode (> arg 0)))
-
-;;;###autoload
-(defun tpum-global-mode (&optional arg)
-  "Toggle tpum global mode.
-With prefix ARG, turn on if positive, otherwise off."
-  (interactive (list (or (and current-prefix-arg
-                              (prefix-numeric-value current-prefix-arg))
-                         (if tpum-global-mode 0 1))))
-  (setq tpum-global-mode (> arg 0)))
-
-(add-minor-mode 'tpum-minor-mode " Tpum")
-
-(defun define-tpum-key (map tkeys rkeys)
-  "In keymap MAP define keys TKEYS that emulates press of RKEYS."
-  (define-key map tkeys
-    `(lambda ()
-       (interactive "_")
-       (let* ((nevents (aref (key-sequence-list-description ,rkeys) 0))
-              (mods (and (> (length nevents) 0) (butlast nevents)))
-              (buname (symbol-name (car (last nevents))))
-              (button (- (char-to-int (aref buname (1- (length buname)))) 48)))
-         (setq unread-command-events
-               (append (list (make-event
-                              'button-press
-                              (list 'modifiers mods 'button button)))
-                       unread-command-events))))))
-
-
-(provide 'tpum)
-
-;; Finally run load hooks
-(run-hooks 'tpum-load-hook)
-
-;;; tpum.el ends here
diff --git a/xemacs-packages/lisp/text-modes/underline.el b/xemacs-packages/lisp/text-modes/underline.el
deleted file mode 100644
index 21133503..00000000
--- a/xemacs-packages/lisp/text-modes/underline.el
+++ /dev/null
@@ -1,118 +0,0 @@
-;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs.
-
-;; Copyright (C) 1985, 1993 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: wp
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This package deals with the primitive form of underlining
-;; consisting of prefixing each character with "_\^h".  The entry
-;; point `underline-region' performs such underlining on a region.
-;; The entry point `ununderline-region' removes it.
-
-;;; Code:
-
-;;;###autoload
-(defun underline-region (start end)
-  "Underline all nonblank characters in the region.
-Works by overstriking underscores.
-Called from program, takes two arguments START and END
-which specify the range to operate on."
-  ;; XEmacs: FSF doesn't use a '*', a bug?  -sb
-  (interactive "*r")
-  (save-excursion
-    (let ((end1 (make-marker)))
-      (move-marker end1 (max start end))
-      (goto-char (min start end))
-      (while (< (point) end1)
-	(or (looking-at "[_\^@- ]")
-	    (insert "_\b"))
-	(forward-char 1)))))
-
-;;;###autoload
-(defun ununderline-region (start end)
-  "Remove all underlining (overstruck underscores) in the region.
-Called from program, takes two arguments START and END
-which specify the range to operate on."
-  (interactive "*r")
-  (save-excursion
-    (let ((end1 (make-marker)))
-      (move-marker end1 (max start end))
-      (goto-char (min start end))
-      (while (re-search-forward "_\b\\|\b_" end1 t)
-	(delete-char -2)))))
-
-;; XEmacs:  The rest of these functions are not in FSF.  I don't see any
-;; point in removing them.  -sb
-
-;;;###autoload
-(defun unoverstrike-region (start end)
-  "Remove all overstriking (character-backspace-character) in the region.
-Called from program, takes two arguments START and END which specify the
-range to operate on."
-  (interactive "*r")
-  (save-excursion
-    (let ((end1 (make-marker)))
-      (move-marker end1 (max start end))
-      (goto-char (min start end))
-      (while (re-search-forward "\\(.\\)\b\\1" end1 t)
-	(delete-char -2)))))
-
-;;;###autoload
-(defun overstrike-region (start end)
-  "Overstrike (character-backspace-character) all nonblank characters in
-the region. Called from program, takes two arguments START and END which
-specify the range to operate on."
-  (interactive "*r")
-  (save-excursion
-    (let ((end1 (make-marker)))
-      (move-marker end1 (max start end))
-      (goto-char (min start end))
-      (while (< (point) end1)
-	(or (looking-at "[_\^@- ]")
-	    (insert (char-after (point)) 8))
-	(forward-char 1)))))
-
-;;;###autoload
-(defun ununderline-and-unoverstrike-region (start end)
-  "Remove underlining and overstriking in the region.  Called from a program,
-takes two arguments START and END which specify the range to operate on."
-  (interactive "*r")
-  (save-excursion
-    ;; This is a piece of nuke-nroff-bs from standard `man.el'.
-    (goto-char (point-min))
-    (while (search-forward "\b" (max start end) t)
-      (let* ((preceding (char-after (- (point) 2)))
-	     (following (following-char)))
-	(cond ((= preceding following)
-	       ;; x\bx
-	       (delete-char -2))
-	      ((= preceding ?\_)
-	       ;; _\b
-	       (delete-char -2))
-	      ((= following ?\_)
-	       ;; \b_
-	       (delete-region (1- (point)) (1+ (point)))))))))
-
-;;; underline.el ends here
diff --git a/xemacs-packages/lisp/text-modes/whitespace-mode.el b/xemacs-packages/lisp/text-modes/whitespace-mode.el
deleted file mode 100644
index 85f65e2b..00000000
--- a/xemacs-packages/lisp/text-modes/whitespace-mode.el
+++ /dev/null
@@ -1,606 +0,0 @@
-;;; whitespace-mode.el -- minor mode for making whitespace visible
-
-;; Copyright (C) 1994, 1995, 1996 Heiko Muenkel
-
-;; Author: Heiko Muenkel 
-;; Keywords: modes, extensions
-
-;; This file is part of XEmacs.
-
-;;  XEmacs 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.
-
-;;  XEmacs 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 XEmacs; if not, write to the Free Software
-;;  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: [[ FSF 19.34. ]] Not in FSF.
- 
-;;; Commentary:
-
-;; $Id: whitespace-mode.el,v 1.6 2004/11/08 02:21:00 ben Exp $
-;; Description:
-;;
-;;	This is a minor mode, which highlights whitespaces (blanks and
-;;	tabs) with different faces, so that it is easier to
-;;	distinguish between them.  
-;;	Toggle the mode with: M-x old-whitespace-mode 
-;;     or with: M-x old-whitespace-incremental-mode
-;;	The second one should be used in big files.
-;;
-;;	If you want to know how the whitespaces are highlighted then
-;;	type: M-x old-whitespace-show-faces
-;;
-;;	There are 2 hook variables `old-whitespace-incremental-mode-hook'
-;;	and `old-whitespace-mode-hook' to customize the mode.
-;;
-;;	Look at the variable `old-whitespace-chars', if you only want to
-;;	highlight tabs or blanks and not both.
-;;
-;;	Set `old-whitespace-install-toolbar-icon' to t, if you want a
-;;	toolbar icon for this mode.
-;;
-;;	Set `old-whitespace-install-submenu' to t, if you want a submenu
-;;     for this mode. Sorry, at the moment there is no menu for the
-;;	Emacs 19. 
-;;
-;;	Thanks to Mike Scheidler for the toolbar icon code.
-;; 
-;; Installation:
-;;   
-;;     Put the files whitespace-mode.el and adapt.el in one of your
-;; 	load-path directories and the following lines (without the
-;; 	comment signs) in your .emacs (adapt.el is already in the
-;;	XEmacs 19.12).
-;;
-;;     (autoload 'old-whitespace-mode "whitespace-mode" 
-;;       "Toggle whitespace mode.
-;;	With arg, turn whitespace mode on iff arg is positive.
-;;	In whitespace mode the different whitespaces (tab, blank return)
-;;	are highlighted with different faces. The faces are:
-;;	`old-whitespace-blank-face', `old-whitespace-tab-face' and 
-;;	`old-whitespace-return-face'."
-;;	t)
-;;
-;;     (autoload 'old-whitespace-incremental-mode "whitespace-mode" 
-;;	  "Toggle whitespace incremental mode.
-;;     With arg, turn whitespace incremental mode on iff arg is positive.
-;;	In whitespace incremental mode the different whitespaces (tab and 
-;;	blank) are highlighted with different faces. The faces are:
-;;	`old-whitespace-blank-face' and `old-whitespace-tab-face'.
-;;	Use the command `old-whitespace-show-faces' to show their values.
-;;	In this mode only these tabs and blanks are highlighted, which are in 
-;;	the region from (point) - (window-height) to (point) + (window-height)."
-
-;;; Code:
-
-(provide 'whitespace-mode)
-;; We don't need adapt
-;; (require 'adapt)
-
-;;; variables:
-
-(defgroup old-whitespace nil
-  "Minor mode for making whitespace visible"
-  :group 'outlines
-  :group 'matching)
-
-
-(defcustom old-whitespace-mode nil
-  "Non-nil, if the `old-whitespace-mode' is active."
-  :type 'boolean
-  :set (lambda (symbol value)
-	 (old-whitespace-mode (or value 0)))
-  :require 'whitespace-mode
-  :initialize 'custom-initialize-default
-  :group 'old-whitespace)
-
-(make-variable-buffer-local 'old-whitespace-mode)
-
-;;;###autoload
-(defcustom old-whitespace-mode-line-string " WSP"
-  "*String displayed on the modeline when old-whitespace-mode is active.
-Set this to nil if you don't want a modeline indicator."
-  :group 'old-whitespace
-  :type 'string)
-
-;;;###autoload
-(defcustom old-whitespace-incremental-mode-line-string " WSPI"
-  "*String displayed on the modeline when old-whitespace-incremental-mode
-is active. Set this to nil if you don't want a modeline indicator."
-  :group 'old-whitespace
-  :type 'string)
-
-(defcustom old-whitespace-chars 'tabs-and-blanks
-  "*Determines, which whitespaces are highlighted.
-Valid values are:
-'tabs-and-blanks => tabs and blanks are highlighted;
-'tabs            => only tabs are highlighted;
-'blanks          => only blanks are highlighted;.
-
-Changing this variable during the old-whitespace-*-mode is active could lead
-to wrong highlighted whitespaces."
-  :type '(radio (const tabs-and-blanks)
-		(const tabs)
-		(const blanks))
-  :group 'old-whitespace)
-
-(make-variable-buffer-local 'old-whitespace-chars)
-
-(defcustom old-whitespace-mode-hook nil
-  "*Run after the `old-whitespace-mode' is switched on."
-  :type 'hook
-  :group 'old-whitespace)
-
-(defcustom old-whitespace-incremental-mode-hook nil
-  "*Run after the `old-whitespace-incremental-mode' is switched on."
-  :type 'hook
-  :group 'old-whitespace)
-
-;; We don't need adapt.
-;; (if (adapt-xemacsp)
-;; (progn
-
-(defcustom old-whitespace-install-toolbar-icon nil
-  "Set it to t, if a toolbar icon should be installed during loading this file.
-The icon calls the function 'old-whitespace-toolbar-function'."
-  :type 'boolean
-  :group 'old-whitespace)
-
-(defcustom old-whitespace-install-submenu nil
-  "Set it to t, if a submenu should be installed during loading this file."
-  :type 'boolean
-  :group 'old-whitespace)
-
-;; ))
-
-
-(defcustom old-whitespace-toolbar-function 'old-whitespace-incremental-mode
-  "*The toolbar icon for the whitespace mode calls this function.
-Valid values are: 'old-whitespace--mode and 'old-whitespace-incremental-mode."
-  :type 'function
-  :group 'old-whitespace)
-
-(defcustom old-whitespace-blank-and-tab-search-string "\\( \\)\\|\\(\t\\)"
-  "The regexp used to search for tabs and blanks."
-  :type 'regexp
-  :group 'old-whitespace)
-
-(defcustom old-whitespace-tab-search-string "\t"
-  "The search string used to find tabs."
-  :type 'string
-  :group 'old-whitespace)
-
-(defcustom old-whitespace-blank-search-string " "
-  "The search string used to find blanks."
-  :type 'string
-  :group 'old-whitespace)
-
-(defface old-whitespace-blank-face
-  '((t
-     (:background "LightBlue1")))
-  "Face to show blanks with"
-  :group 'old-whitespace)
-
-(defface old-whitespace-tab-face
-  '((t
-     (:background "yellow" :underline t)))
-  "Face to show TABs with"
-  :group 'old-whitespace)
-
-(defun old-whitespace-show-faces ()
-  "Shows the faces used by the `old-whitespace-mode'."
-  (interactive)
-  (save-excursion
-    (let ((actual-buffer-name (buffer-name (current-buffer)))
-	  (actual-whitespace-chars old-whitespace-chars)
-	  (old-whitespace-mode-active (or old-whitespace-mode 
-				      old-whitespace-incremental-mode))
-	  (buffer (get-buffer-create "*Help*")))
-      (set-buffer buffer)
-      (setq old-whitespace-chars actual-whitespace-chars)
-      (delete-region (point-min) (point-max))
-      (insert "In the whitespace minor mode\n"
-	      " this \" ")
-      (old-whitespace-highlight-region (1- (point)) (point))
-      (insert "\" is a blank, highlighted with `old-whitespace-blank-face' and\n"
-	      " this \"\t")
-      (old-whitespace-highlight-region (1- (point)) (point))
-      (insert "\" is a tab,  highlighted with `old-whitespace-tab-face'.")
-      
-      (newline 2)
-      (if (eq old-whitespace-chars 'blanks)
-	  (insert 
-	   "The highlighting of tabs is switched off.\n")
-	(if (eq old-whitespace-chars 'tabs)
-	    (insert
-	     "The highlighting of blanks is switched off.\n")))
-      (newline)
-      (if old-whitespace-mode-active
-	  (insert "A whitespace minor mode is active in the buffer\n  "
-		  actual-buffer-name
-		  ".\n")
-	(insert "No whitespace minor mode is active in the buffer\n  "
-		actual-buffer-name
-		".\n"))
-      (show-temp-buffer-in-current-frame buffer)
-      )))
-
-;;;
-(defun old-whitespace-highlight-chars-in-region (char-string from to face)
-  "Highlights the CHAR-STRING in the region from FROM to TO with the FACE."
-  (while (search-forward char-string end t)
-    (let ((extent))
-      (cond ((match-beginning 0)
-	     (setq extent (make-extent (match-beginning 0) (match-end 0)))
-	     (set-extent-face extent face)
-	     ))
-      (set-extent-property extent 'start-open t)
-      (set-extent-property extent 'end-open t)
-      )))
-
-(defun old-whitespace-highlight-region (from to)
-  "Highlights the whitespaces in the region from FROM to TO."
-  (let ((start (min from to))
-	(end (max from to)))
-    (save-excursion
-      ;;    (message "Highlighting tabs and blanks...")
-      (goto-char start)
-      (cond ((eq old-whitespace-chars 'tabs-and-blanks)
-	     (while (search-forward-regexp 
-		     old-whitespace-blank-and-tab-search-string end t)
-	       (let ((extent))
-		 (cond ((match-beginning 1) ; blanks ?
-			(setq extent (make-extent (match-beginning 1) 
-						  (match-end 1)))
-			(set-extent-face extent 'old-whitespace-blank-face)
-			)
-		       ((match-beginning 2) ; tabs ?
-			(setq extent (make-extent (match-beginning 2) 
-						  (match-end 2)))
-			(set-extent-face extent 'old-whitespace-tab-face)
-			)
-		       )
-		 (set-extent-property extent 'start-open t)
-		 (set-extent-property extent 'end-open t)
-		 )))
-	    ((eq old-whitespace-chars 'tabs)
-	     (old-whitespace-highlight-chars-in-region old-whitespace-tab-search-string 
-						   from 
-						   to
-						   'old-whitespace-tab-face))
-	    ((eq old-whitespace-chars 'blanks)
-	     (old-whitespace-highlight-chars-in-region 
-	      old-whitespace-blank-search-string 
-	      from 
-	      to
-	      'old-whitespace-blank-face))
-	    (t (error "ERROR: Bad value of old-whitespace-highlight-char")))
-      ;;    (message "")
-      )))
-
-(defun old-whitespace-highlight-buffer ()
-  "Highlights the whitespaces in the current buffer."
-  (old-whitespace-highlight-region (point-min) (point-max))
-)
-
-(defsubst old-whitespace-find-next-highlighted-region (from to)
-  "Returns nil or the next highlighted region."
-  (map-extents '(lambda (extent dummy)
-		 (if (extent-property extent 'old-whitespace-highlighted-region)
-		     extent))
-	       nil
-	       from
-	       to))
-
-(defun old-whitespace-incremental-highlight (from to)
-  "Highlights the region from FROM to TO incremental."
-  (save-excursion
-    (goto-char from)
-    (let ((extent (extent-at (point) nil 'old-whitespace-highlighted-region))
-	  (next-extent nil)
-	  (start nil))
-      (while (< (point) to)
-	(if extent
-	    (goto-char (extent-end-position extent)))
-	(if (< (point) to)
-	    (progn
-	      (setq start (point))
-	      
-	      (setq next-extent (old-whitespace-find-next-highlighted-region 
-				 start
-				 to))
-	      (if extent
-		  (if next-extent
-		      (progn
-			(set-extent-endpoints extent 
-					      (extent-start-position extent)
-					      (extent-end-position next-extent)
-					      )
-			(old-whitespace-highlight-region start
-						     (1-
-						      (extent-start-position
-						       next-extent)))
-			(delete-extent next-extent))
-		    (set-extent-endpoints extent
-					  (extent-start-position extent)
-					  to)
-		    (old-whitespace-highlight-region start to))
-		(if next-extent
-		    (progn
-		      (setq extent next-extent)
-		      (old-whitespace-highlight-region start 
-						   (1- (extent-start-position
-							next-extent)))
-		      (set-extent-endpoints extent
-					    start
-					    (extent-end-position next-extent)))
-		  (setq extent (make-extent start to))
-		  (set-extent-property extent 'old-whitespace-highlighted-region t)
-		  (old-whitespace-highlight-region start to)))
-	      ))))))
-
-
-(defun old-whitespace-highlight-window ()
-  "Highlights the whitespaces in the current window."
-  (old-whitespace-incremental-highlight (save-excursion
-				      (forward-line (- (window-height)))
-				      (point))
-				    (save-excursion
-				      (forward-line (window-height))
-				      (point))))
-
-(defun old-whitespace-dehighlight-region (start end)
-  "Dehighlights the whitespaces in the region from START to END."
-  (map-extents '(lambda (extent dummy)
-		  (if (or (eq (extent-face extent) 'old-whitespace-blank-face)
-			  (eq (extent-face extent) 'old-whitespace-tab-face)
-			  (extent-property extent 
-					   'old-whitespace-highlighted-region))
-		      (progn
-			(delete-extent extent)
-			nil)))
-	       nil
-	       start
-	       end
-	       )
-  )
-
-(defun old-whitespace-dehighlight-buffer ()
-  "Dehighlights the whitespaces in the current buffer."
-  (old-whitespace-dehighlight-region (point-min) (point-max))
-  )
-
-(defun old-whitespace-highlight-after-change-function (beg end old-len)
-  "Called, when any modification is made to buffer text.  Highlights
-the whitespaces (blanks and tabs) in the region from BEG to
-END. OLD-LEN isn't used, but provided from the after-change hook."
-  (if (or (eq beg end)
-	  (null old-whitespace-mode))
-      nil
-    (old-whitespace-dehighlight-region beg end)
-    (old-whitespace-highlight-region beg end)))
-
-;;;###autoload
-(defun old-whitespace-mode (&optional arg)
-  "Toggle whitespace mode.
-With arg, turn whitespace mode on iff arg is positive.
-In whitespace mode the different whitespaces (tab and blank)
-are highlighted with different faces. The faces are:
-`old-whitespace-blank-face' and `old-whitespace-tab-face'.
-Use the command `old-whitespace-show-faces' to show their values."
-  (interactive "P")
-  (setq old-whitespace-mode
-	(if (null arg) (not old-whitespace-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (if (and old-whitespace-mode old-whitespace-incremental-mode)
-      (progn
-	(old-whitespace-incremental-highlight (point-min) (point-max))
-	(setq old-whitespace-incremental-mode nil)
-	(remove-hook 'post-command-hook 'old-whitespace-highlight-window)
-	(run-hooks 'old-whitespace-mode-hook)
-	)
-    (setq old-whitespace-incremental-mode nil)
-    (remove-hook 'post-command-hook 'old-whitespace-highlight-window)
-    (redraw-modeline) ;(force-mode-line-update)
-    (if old-whitespace-mode
-	(progn
-	  (old-whitespace-highlight-buffer)
-	  (make-local-variable 'after-change-functions)
-	  (add-hook 'after-change-functions 
-		    'old-whitespace-highlight-after-change-function)
-	  (run-hooks 'old-whitespace-mode-hook))
-      (old-whitespace-dehighlight-buffer)
-      (remove-hook 'after-change-functions 
-		   'old-whitespace-highlight-after-change-function)
-      (remove-hook 'post-command-hook 'old-whitespace-highlight-window)
-      )))
-
-(defvar old-whitespace-incremental-mode nil
-  "Non-nil, if the `old-whitespace-incremental-mode' is active.")
-
-(make-variable-buffer-local 'old-whitespace-incremental-mode)
-
-;;;###autoload
-(defun old-whitespace-incremental-mode (&optional arg)
-  "Toggle whitespace incremental mode.
-With arg, turn whitespace incremental mode on iff arg is positive.
-In whitespace incremental mode the different whitespaces (tab and blank)
-are highlighted with different faces. The faces are:
-`old-whitespace-blank-face' and `old-whitespace-tab-face'.
-Use the command `old-whitespace-show-faces' to show their values.
-In this mode only these tabs and blanks are highlighted, which are in 
-the region from (point) - (window-height) to (point) + (window-height)."
-  (interactive "P")
-  (setq old-whitespace-incremental-mode
-	(if (null arg) (not old-whitespace-incremental-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (if (and old-whitespace-mode old-whitespace-incremental-mode)
-	(set-extent-property (make-extent (point-min) (point-max))
-			     'old-whitespace-highlighted-region
-			     t))
-  (setq old-whitespace-mode nil)
-  (redraw-modeline) ;(force-mode-line-update)
-  ;(set-buffer-modified-p (buffer-modified-p)) ;No-op, but updates mode line.
-  (if old-whitespace-incremental-mode
-      (progn
-	(old-whitespace-highlight-window)
-	(make-local-variable 'post-command-hook)
-	(add-hook 'post-command-hook 'old-whitespace-highlight-window)
-	(make-local-variable 'after-change-functions)
-	(add-hook 'after-change-functions 
-		  'old-whitespace-highlight-after-change-function)
-	(run-hooks 'old-whitespace-incremental-mode-hook))
-    (old-whitespace-dehighlight-buffer)
-    (remove-hook 'after-change-functions 
-		 'old-whitespace-highlight-after-change-function)
-    (remove-hook 'post-command-hook 'old-whitespace-highlight-window)
-    ))
-
-
-;;; Add whitespace-mode and old-whitespace-incremental-mode to the minor-mode-alist
-
-;;;###autoload 
-(if (fboundp 'add-minor-mode)
-    (progn
-      (add-minor-mode 'old-whitespace-mode old-whitespace-mode-line-string)
-      (add-minor-mode 'old-whitespace-incremental-mode old-whitespace-incremental-mode-line-string))
-  (or (assq 'old-whitespace-mode minor-mode-alist)
-      (setq minor-mode-alist
-            (cons '(old-whitespace-mode old-whitespace-mode-line-string) minor-mode-alist)))
-  (or (assq 'old-whitespace-incremental-mode minor-mode-alist)
-      (setq minor-mode-alist
-            (cons '(old-whitespace-incremental-mode old-whitespace-incremental-mode-line-string) minor-mode-alist))))
-
-;;; Menu for the whitespace mode
-
-(defun old-whitespace-set-whitespace-chars (new-whitespace-chars)
-  "Sets the variable `old-whitespace-chars' and activates the change."
-  (interactive (list (read (completing-read "Whitespaces to highlight: "
-					    '(("tabs-and-blanks")
-					      ("tabs")
-					      ("blanks"))
-					    nil
-					    t
-					    (symbol-name 'old-whitespace-chars)))))
-  (if (eq old-whitespace-chars new-whitespace-chars)
-      nil ; nothing to do
-    (setq old-whitespace-chars new-whitespace-chars)
-    (setq-default old-whitespace-chars new-whitespace-chars)
-    (cond (old-whitespace-mode (old-whitespace-mode) 
-			   (old-whitespace-mode))
-	  (old-whitespace-incremental-mode (old-whitespace-incremental-mode)
-				       (old-whitespace-incremental-mode))
-	  )))
-
-(defvar old-whitespace-menu nil
-  "A menu for the whitespace minor mode.")
-  
-(setq old-whitespace-menu
-      '("Whitespace Menu"
-	["Highlight Whitespaces" 
-	 old-whitespace-mode 
-	 :style toggle 
-	 :selected old-whitespace-mode]
-	["Incremental Highlighting"
-	 old-whitespace-incremental-mode
-	 :style toggle
-	 :selected old-whitespace-incremental-mode
-	 ]
-	"---"
-	["Show Whitespace Faces" old-whitespace-show-faces t]
-	"---"
-	["Highlight Tabs & Blanks" 
-	 (old-whitespace-set-whitespace-chars 'tabs-and-blanks)
-	 :style radio
-	 :selected (eq old-whitespace-chars 'tabs-and-blanks)]
-	["Highlight Only Tabs"
-	 (old-whitespace-set-whitespace-chars 'tabs)
-	 :style radio
-	 :selected (eq old-whitespace-chars 'tabs)]
-	["Highlight Only Blanks"
-	 (old-whitespace-set-whitespace-chars 'blanks)
-	 :style radio
-	 :selected (eq old-whitespace-chars 'blanks)]
-	))
-
-(if (and (boundp 'old-whitespace-install-submenu) old-whitespace-install-submenu)
-    (add-submenu '("Apps") old-whitespace-menu))
-
-;;; Toolbar icon for the XEmacs
-
-(if (featurep 'toolbar)
-
-(defvar toolbar-wspace-icon
-  (toolbar-make-button-list
-   "/* XPM */
-static char * whitespace[] = {
-\"28 28 4 1\",
-\" 	c Gray75 s backgroundToolBarColor\",
-\".	c black s foregroundToolBarColor\",
-\"X	c Gray60\",
-\"o	c white\",
-\"                            \",
-\"                            \",
-\"                            \",
-\"                            \",
-\"         ..      .          \",
-\"       XXX.XXXXXX   .       \",
-\"       Xoo.oooooXX  .       \",
-\" .. .. ..o.o..oo..X...  ..  \",
-\"  .  . X.o..o.ooX. X.  .  . \",
-\"  .  . .oo.oo.ooX.XX.  .... \",
-\"   ... .oo.oo.ooo.oo.  .    \",
-\"   .  .Xoo.oo.ooo.oo.  .  . \",
-\"   .  .Xo...o..o...o..  ..  \",
-\"       XooooooooooooX       \",
-\"       XooooooooooooX       \",
-\" .... ....ooo...ooo...  ..  \",
-\" .  .  .oo.o.oo.oo.oX. .  . \",
-\"  .    .oo.ooo..oo.oX  .... \",
-\"   ..  .oo.o..o.oo.oX  .    \",
-\" .  .  .oo.o.oo.oo.oX. .  . \",
-\" ....  ...oo.....oo..   ..  \",
-\"       .ooooooooooooX       \",
-\"       .XXXXXXXXXXXXX       \",
-\"       .                    \",
-\"      ...                   \",
-\"                            \",
-\"                            \",
-\"                            \"
-};")
-  "A whitespace icon.")
-)
-
-(defun old-whitespace-toolbar-function ()
-  "Calls the function determined by `old-whitespace-toolbar-function'."
-  (interactive)
-  (call-interactively old-whitespace-toolbar-function))
-
-(if (and (featurep 'xemacs) ;; (adapt-xemacsp)
-	 old-whitespace-install-toolbar-icon
-	 (featurep 'toolbar)
-	 (eq (device-type (selected-device)) 'x))
-    (let ((tb (mapcar #'(lambda (e)
-			  (elt e 1)) (specifier-instance default-toolbar))))
-      (and (not (member 'old-whitespace-toolbar-function tb))
-	   (toolbar-add-item
-	    [toolbar-wspace-icon old-whitespace-toolbar-function
-				 t "Toggle whitespace mode"]
-	    (let ((n (or
-		      (position 'toolbar-replace tb)
-		      (position 'toolbar-undo tb)
-		      (position 'toolbar-paste tb)
-		      (position 'toolbar-copy tb)
-		      (position 'toolbar-cut tb))))
-	      (if n (1+ n) (length tb)))))))
-
-;;; whitespace-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/whitespace-visual-mode.el b/xemacs-packages/lisp/text-modes/whitespace-visual-mode.el
deleted file mode 100644
index d9d3df9c..00000000
--- a/xemacs-packages/lisp/text-modes/whitespace-visual-mode.el
+++ /dev/null
@@ -1,645 +0,0 @@
-;;; whitespace-visual-mode.el -- minor mode for making whitespace visible
-
-;; Copyright (C) 1994 - 2005 Dr. Heiko Muenkel
-
-;; Author: Dr. Heiko Muenkel 
-;; Keywords: modes, extensions
-
-;; This file is part of XEmacs.
-
-;;  XEmacs 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.
-
-;;  XEmacs 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 XEmacs; if not, write to the Free Software
-;;  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;  02111-1307, USA.
-
-;;; Synched up with: [[ FSF 19.34. ]] Not in FSF.
- 
-;;; Commentary:
-
-;; $Id: whitespace-visual-mode.el,v 1.1 2005/02/14 21:28:06 viteno Exp $
-;; Description:
-;;
-;;	This is a minor mode, which highlights whitespaces (blanks and
-;;	tabs) with different faces, so that it is easier to
-;;	distinguish between them.  
-;;	Toggle the mode with: M-x whitespace-visual-mode 
-;;	or with: M-x whitespace-visual-incremental-mode
-;;	The second one should be used in big files.
-;;
-;;	If you want to know how the whitespaces are highlighted then
-;;	type: M-x whitespace-visual-show-faces
-;;
-;;	There are 2 hook variables `whitespace-visual-incremental-mode-hook'
-;;	and `whitespace-visual-mode-hook' to customize the mode.
-;;
-;;	Look at the variable `whitespace-visual-chars', if you only want to
-;;	highlight tabs or blanks and not both.
-;;
-;;	Set `whitespace-visual-install-toolbar-icon' to t, if you want a
-;;	toolbar icon for this mode.
-;;
-;;	Set `whitespace-visual-install-submenu' to t, if you want a submenu
-;;	for this mode. Sorry, at the moment there is no menu for the
-;;	GNU Emacs. 
-;;
-;;	Thanks to Mike Scheidler for the toolbar icon code.
-;; 
-;; Changes:
-;;	2005-02-10:
-;;	The prefix of the package is now whitespace-visual
-;;	instead of only whitespace. The new prefix whitespace-visual
-;;	was choosen to avoid conflicts with another package called
-;;	whitespace. Adding a whitespace toolbar icon should now work
-;;	again. The whitespace submenu is now in the "Tools" menu
-;;	instead of the old Apps menu.
-;;
-;; Installation:
-;;   
-;;	This file is part of the XEmacs package system. The following
-;;	instructions belong to older versions of this mode. 
-;;
-;;      Put the files whitespace-visual-mode.el and adapt.el in one of your
-;; 	load-path directories and the following lines (without the
-;; 	comment signs) in your .emacs (adapt.el is already in the
-;;	XEmacs 19.12).
-;;
-;;     (autoload 'whitespace-visual-mode "whitespace-visual-mode" 
-;;       "Toggle whitespace visual mode.
-;;	With arg, turn whitespace visual mode on iff arg is positive.
-;;	In whitespace visual mode the different whitespaces (tab, blank return)
-;;	are highlighted with different faces. The faces are:
-;;	`whitespace-visual-blank-face', `whitespace-visual-tab-face' and 
-;;	`whitespace-visual-return-face'."
-;;	t)
-;;
-;;     (autoload 'whitespace-visual-incremental-mode "whitespace-visual-mode" 
-;;	  "Toggle whitespace visual incremental mode.
-;;      With arg, turn whitespace visual incremental mode on iff 
-;;      arg is positive. In whitespace visual incremental mode 
-;;	the different whitespaces (tab and blank) are highlighted with 
-;;	different faces. The faces are: `whitespace-blank-face' and 
-;;      `whitespace-visual-tab-face'. Use the command 
-;;	`whitespace-visual-show-faces' to show their values.
-;;	In this mode only these tabs and blanks are highlighted, which are in 
-;;	the region from (point) - (window-height) to (point) + 
-;;	(window-height)."
-
-;;; Code:
-
-(provide 'whitespace-visual-mode)
-;; We don't need adapt
-;; (require 'adapt)
-
-;;; variables:
-
-(defgroup whitespace-visual nil
-  "Minor mode for making whitespaces visible"
-  :group 'outlines
-  :group 'matching)
-
-
-(defcustom whitespace-visual-mode nil
-  "Non-nil, if the `whitespace-visual-mode' is active."
-  :type 'boolean
-  :set (lambda (symbol value)
-	 (whitespace-visual-mode (or value 0)))
-  :require 'whitespace-visual-mode
-  :initialize 'custom-initialize-default
-  :group 'whitespace-visual)
-
-(make-variable-buffer-local 'whitespace-visual-mode)
-
-;;;###autoload
-(defcustom whitespace-visual-mode-line-string " WSP"
-  "*String displayed on the modeline when whitespace-visual-mode is active.
-Set this to nil if you don't want a modeline indicator."
-  :group 'whitespace-visual
-  :type 'string)
-
-;;;###autoload
-(defcustom whitespace-visual-incremental-mode-line-string " WSPI"
-  "*String displayed on the modeline when whitespace-visual-incremental-mode
-is active. Set this to nil if you don't want a modeline indicator."
-  :group 'whitespace-visual
-  :type 'string)
-
-(defcustom whitespace-visual-chars 'tabs-and-blanks
-  "*Determines, which whitespaces are highlighted.
-Valid values are:
-'tabs-and-blanks => tabs and blanks are highlighted;
-'tabs            => only tabs are highlighted;
-'blanks          => only blanks are highlighted;.
-
-Changing this variable during the whitespace-visual-*-mode is active could lead
-to wrong highlighted whitespaces."
-  :type '(radio (const tabs-and-blanks)
-		(const tabs)
-		(const blanks))
-  :group 'whitespace-visual)
-
-(make-variable-buffer-local 'whitespace-visual-chars)
-
-(defcustom whitespace-visual-mode-hook nil
-  "*Run after the `whitespace-visual-mode' is switched on."
-  :type 'hook
-  :group 'whitespace-visual)
-
-(defcustom whitespace-visual-incremental-mode-hook nil
-  "*Run after the `whitespace-visual-incremental-mode' is switched on."
-  :type 'hook
-  :group 'whitespace-visual)
-
-;; We don't need adapt.
-;; (if (adapt-xemacsp)
-;; (progn
-
-(defcustom whitespace-visual-install-toolbar-icon nil
-  "Set it to t, if a toolbar icon should be installed during loading this file.
-The icon calls the function 'whitespace-visual-toolbar-function'."
-  :type 'boolean
-  :group 'whitespace-visual)
-
-(defcustom whitespace-visual-install-submenu nil
-  "Set it to t, if a submenu should be installed during loading this file."
-  :type 'boolean
-  :group 'whitespace-visual)
-
-;; ))
-
-
-(defcustom whitespace-visual-toolbar-function 
-  'whitespace-visual-incremental-mode
-  "*The toolbar icon for the whitespace visual mode calls this function.
-Valid values are: 
- 'whitespace-visual--mode and 'whitespace-visual-incremental-mode."
-  :type 'function
-  :group 'whitespace-visual)
-
-(defcustom whitespace-visual-blank-and-tab-search-string "\\( \\)\\|\\(\t\\)"
-  "The regexp used to search for tabs and blanks."
-  :type 'regexp
-  :group 'whitespace-visual)
-
-(defcustom whitespace-visual-tab-search-string "\t"
-  "The search string used to find tabs."
-  :type 'string
-  :group 'whitespace-visual)
-
-(defcustom whitespace-visual-blank-search-string " "
-  "The search string used to find blanks."
-  :type 'string
-  :group 'whitespace-visual)
-
-(defface whitespace-visual-blank-face
-  '((t
-     (:background "LightBlue1")))
-  "Face to show blanks with"
-  :group 'whitespace-visual)
-
-(defface whitespace-visual-tab-face
-  '((t
-     (:background "yellow" :underline t)))
-  "Face to show TABs with"
-  :group 'whitespace-visual)
-
-(defun whitespace-visual-show-faces ()
-  "Shows the faces used by the `whitespace-visual-mode'."
-  (interactive)
-  (save-excursion
-    (let ((actual-buffer-name (buffer-name (current-buffer)))
-	  (actual-whitespace-chars whitespace-visual-chars)
-	  (whitespace-visual-mode-active
-	   (or whitespace-visual-mode 
-	       whitespace-visual-incremental-mode))
-	  (buffer (get-buffer-create "*Help*")))
-      (set-buffer buffer)
-      (setq whitespace-visual-chars actual-whitespace-chars)
-      (delete-region (point-min) (point-max))
-      (insert "In the whitespace visual minor mode\n"
-	      " this \" ")
-      (whitespace-visual-highlight-region (1- (point)) (point))
-      (insert "\" is a blank, highlighted with "
-	      "`whitespace-visual-blank-face' and\n"
-	      " this \"\t")
-      (whitespace-visual-highlight-region (1- (point)) (point))
-      (insert "\" is a tab,  highlighted with `whitespace-visual-tab-face'.")
-      
-      (newline 2)
-      (if (eq whitespace-visual-chars 'blanks)
-	  (insert 
-	   "The highlighting of tabs is switched off.\n")
-	(if (eq whitespace-visual-chars 'tabs)
-	    (insert
-	     "The highlighting of blanks is switched off.\n")))
-      (newline)
-      (if whitespace-visual-mode-active
-	  (insert "A whitespace-visual minor mode is active in the buffer\n  "
-		  actual-buffer-name
-		  ".\n")
-	(insert "No whitespace-visual minor mode is active in the buffer\n  "
-		actual-buffer-name
-		".\n"))
-      (show-temp-buffer-in-current-frame buffer)
-      )))
-
-;;;
-(defun whitespace-visual-highlight-chars-in-region (char-string from to face)
-  "Highlights the CHAR-STRING in the region from FROM to TO with the FACE."
-  (while (search-forward char-string end t)
-    (let ((extent))
-      (cond ((match-beginning 0)
-	     (setq extent (make-extent (match-beginning 0) (match-end 0)))
-	     (set-extent-face extent face)
-	     ))
-      (set-extent-property extent 'start-open t)
-      (set-extent-property extent 'end-open t)
-      )))
-
-(defun whitespace-visual-highlight-region (from to)
-  "Highlights the whitespaces in the region from FROM to TO."
-  (let ((start (min from to))
-	(end (max from to)))
-    (save-excursion
-      ;;    (message "Highlighting tabs and blanks...")
-      (goto-char start)
-      (cond ((eq whitespace-visual-chars 'tabs-and-blanks)
-	     (while (search-forward-regexp 
-		     whitespace-visual-blank-and-tab-search-string end t)
-	       (let ((extent))
-		 (cond ((match-beginning 1) ; blanks ?
-			(setq extent (make-extent (match-beginning 1) 
-						  (match-end 1)))
-			(set-extent-face extent 'whitespace-visual-blank-face)
-			)
-		       ((match-beginning 2) ; tabs ?
-			(setq extent (make-extent (match-beginning 2) 
-						  (match-end 2)))
-			(set-extent-face extent 'whitespace-visual-tab-face)
-			)
-		       )
-		 (set-extent-property extent 'start-open t)
-		 (set-extent-property extent 'end-open t)
-		 )))
-	    ((eq whitespace-visual-chars 'tabs)
-	     (whitespace-visual-highlight-chars-in-region
-	      whitespace-visual-tab-search-string 
-	      from 
-	      to
-	      'whitespace-visual-tab-face))
-	    ((eq whitespace-visual-chars 'blanks)
-	     (whitespace-visual-highlight-chars-in-region 
-	      whitespace-visual-blank-search-string 
-	      from 
-	      to
-	      'whitespace-visual-blank-face))
-	    (t (error "ERROR: Bad value of whitespace-visual-highlight-char")))
-      )))
-
-(defun whitespace-visual-highlight-buffer ()
-  "Highlights the whitespaces in the current buffer."
-  (whitespace-visual-highlight-region (point-min) (point-max))
-)
-
-(defsubst whitespace-visual-find-next-highlighted-region (from to)
-  "Returns nil or the next highlighted region."
-  (map-extents '(lambda (extent dummy)
-		 (if (extent-property extent
-				      'whitespace-visual-highlighted-region)
-		     extent))
-	       nil
-	       from
-	       to))
-
-(defun whitespace-visual-incremental-highlight (from to)
-  "Highlights the region from FROM to TO incremental."
-  (save-excursion
-    (goto-char from)
-    (let ((extent (extent-at (point) nil 'whitespace-visual-highlighted-region))
-	  (next-extent nil)
-	  (start nil))
-      (while (< (point) to)
-	(if extent
-	    (goto-char (extent-end-position extent)))
-	(if (< (point) to)
-	    (progn
-	      (setq start (point))
-	      
-	      (setq next-extent (whitespace-visual-find-next-highlighted-region 
-				 start
-				 to))
-	      (if extent
-		  (if next-extent
-		      (progn
-			(set-extent-endpoints extent 
-					      (extent-start-position extent)
-					      (extent-end-position next-extent)
-					      )
-			(whitespace-visual-highlight-region start
-						     (1-
-						      (extent-start-position
-						       next-extent)))
-			(delete-extent next-extent))
-		    (set-extent-endpoints extent
-					  (extent-start-position extent)
-					  to)
-		    (whitespace-visual-highlight-region start to))
-		(if next-extent
-		    (progn
-		      (setq extent next-extent)
-		      (whitespace-visual-highlight-region 
-		       start 
-		       (1- (extent-start-position
-			    next-extent)))
-		      (set-extent-endpoints extent
-					    start
-					    (extent-end-position next-extent)))
-		  (setq extent (make-extent start to))
-		  (set-extent-property extent
-				       'whitespace-visual-highlighted-region t)
-		  (whitespace-visual-highlight-region start to)))
-	      ))))))
-
-
-(defun whitespace-visual-highlight-window ()
-  "Highlights the whitespaces in the current window."
-  (whitespace-visual-incremental-highlight
-   (save-excursion
-     (forward-line (- (window-height)))
-     (point))
-   (save-excursion
-     (forward-line (window-height))
-     (point))))
-
-(defun whitespace-visual-dehighlight-region (start end)
-  "Dehighlights the whitespaces in the region from START to END."
-  (map-extents '(lambda (extent dummy)
-		  (if (or (eq (extent-face extent)
-			      'whitespace-visual-blank-face)
-			  (eq (extent-face extent)
-			      'whitespace-visual-tab-face)
-			  (extent-property
-			   extent 
-			   'whitespace-visual-highlighted-region))
-		      (progn
-			(delete-extent extent)
-			nil)))
-	       nil
-	       start
-	       end
-	       )
-  )
-
-(defun whitespace-visual-dehighlight-buffer ()
-  "Dehighlights the whitespaces in the current buffer."
-  (whitespace-visual-dehighlight-region (point-min) (point-max))
-  )
-
-(defun whitespace-visual-highlight-after-change-function (beg end len)
-  "Called, when any modification is made to buffer text.  Highlights
-the whitespaces (blanks and tabs) in the region from BEG to
-END. LEN isn't used, but provided from the after-change hook."
-  (if (or (eq beg end)
-	  (null whitespace-visual-mode))
-      nil
-    (whitespace-visual-dehighlight-region beg end)
-    (whitespace-visual-highlight-region beg end)))
-
-;;;###autoload
-(defun whitespace-visual-mode (&optional arg)
-  "Toggle whitespace visual mode.
-With arg, turn whitespace visual mode on iff arg is positive.
-In whitespace visual mode the different whitespaces (tab and blank)
-are highlighted with different faces. The faces are:
-`whitespace-visual-blank-face' and `whitespace-visual-tab-face'.
-Use the command `whitespace-visual-show-faces' to show their values."
-  (interactive "P")
-  (setq whitespace-visual-mode
-	(if (null arg) (not whitespace-visual-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (if (and whitespace-visual-mode whitespace-visual-incremental-mode)
-      (progn
-	(whitespace-visual-incremental-highlight (point-min) (point-max))
-	(setq whitespace-visual-incremental-mode nil)
-	(remove-hook 'post-command-hook 'whitespace-visual-highlight-window)
-	(run-hooks 'whitespace-visual-mode-hook)
-	)
-    (setq whitespace-visual-incremental-mode nil)
-    (remove-hook 'post-command-hook 'whitespace-visual-highlight-window)
-    (redraw-modeline) ;(force-mode-line-update)
-    (if whitespace-visual-mode
-	(progn
-	  (whitespace-visual-highlight-buffer)
-	  (make-local-variable 'after-change-functions)
-	  (add-hook 'after-change-functions 
-		    'whitespace-visual-highlight-after-change-function)
-	  (run-hooks 'whitespace-visual-mode-hook))
-      (whitespace-visual-dehighlight-buffer)
-      (remove-hook 'after-change-functions 
-		   'whitespace-visual-highlight-after-change-function)
-      (remove-hook 'post-command-hook 'whitespace-visual-highlight-window)
-      )))
-
-(defvar whitespace-visual-incremental-mode nil
-  "Non-nil, if the `whitespace-visual-incremental-mode' is active.")
-
-(make-variable-buffer-local 'whitespace-visual-incremental-mode)
-
-;;;###autoload
-(defun whitespace-visual-incremental-mode (&optional arg)
-  "Toggle whitespace visual incremental mode.
-With arg, turn whitespace-visual incremental mode on iff arg is positive.
-In whitespace visual incremental mode the different whitespaces (tab and
-blank) are highlighted with different faces. The faces are:
-`whitespace-visual-blank-face' and `whitespace-visual-tab-face'.
-Use the command `whitespace-visual-show-faces' to show their values.
-In this mode only these tabs and blanks are highlighted, which are in 
-the region from (point) - (window-height) to (point) + (window-height)."
-  (interactive "P")
-  (setq whitespace-visual-incremental-mode
-	(if (null arg) (not whitespace-visual-incremental-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (if (and whitespace-visual-mode whitespace-visual-incremental-mode)
-	(set-extent-property (make-extent (point-min) (point-max))
-			     'whitespace-visual-highlighted-region
-			     t))
-  (setq whitespace-visual-mode nil)
-  (redraw-modeline) ;(force-mode-line-update)
-  ;(set-buffer-modified-p (buffer-modified-p)) ;No-op, but updates mode line.
-  (if whitespace-visual-incremental-mode
-      (progn
-	(whitespace-visual-highlight-window)
-	(make-local-variable 'post-command-hook)
-	(add-hook 'post-command-hook 'whitespace-visual-highlight-window)
-	(make-local-variable 'after-change-functions)
-	(add-hook 'after-change-functions 
-		  'whitespace-visual-highlight-after-change-function)
-	(run-hooks 'whitespace-visual-incremental-mode-hook))
-    (whitespace-visual-dehighlight-buffer)
-    (remove-hook 'after-change-functions 
-		 'whitespace-visual-highlight-after-change-function)
-    (remove-hook 'post-command-hook 'whitespace-visual-highlight-window)
-    ))
-
-
-;;; Add whitespace-visual-mode and whitespace-visual-incremental-mode
-;;; to the minor-mode-alist
-
-;;;###autoload 
-(if (fboundp 'add-minor-mode)
-    (progn
-      (add-minor-mode 'whitespace-visual-mode
-		      whitespace-visual-mode-line-string)
-      (add-minor-mode 'whitespace-visual-incremental-mode
-		      whitespace-visual-incremental-mode-line-string))
-  (or (assq 'whitespace-visual-mode minor-mode-alist)
-      (setq minor-mode-alist
-            (cons '(whitespace-visual-mode whitespace-visual-mode-line-string)
-		  minor-mode-alist)))
-  (or (assq 'whitespace-visual-incremental-mode minor-mode-alist)
-      (setq minor-mode-alist
-            (cons '(whitespace-visual-incremental-mode
-		    whitespace-visual-incremental-mode-line-string)
-		  minor-mode-alist))))
-
-;;; Menu for the whitespace-visual mode
-
-(defun whitespace-visual-set-whitespace-chars (new-whitespace-chars)
-  "Sets the variable `whitespace-visual-chars' and activates the change."
-  (interactive 
-   (list
-    (read
-     (completing-read "Whitespaces to highlight: "
-		      '(("tabs-and-blanks")
-			("tabs")
-			("blanks"))
-		      nil
-		      t
-		      (symbol-name 'whitespace-visual-chars)))))
-  (if (eq whitespace-visual-chars new-whitespace-chars)
-      nil ; nothing to do
-    (setq whitespace-visual-chars new-whitespace-chars)
-    (setq-default whitespace-visual-chars new-whitespace-chars)
-    (cond (whitespace-visual-mode (whitespace-visual-mode) 
-				  (whitespace-visual-mode))
-	  (whitespace-visual-incremental-mode
-	   (whitespace-visual-incremental-mode)
-	   (whitespace-visual-incremental-mode))
-	  )))
-
-(defvar whitespace-visual-menu nil
-  "A menu for the whitespace visual minor mode.")
-  
-(setq whitespace-visual-menu
-      '("Whitespace Menu"
-	["Highlight Whitespaces" 
-	 whitespace-visual-mode 
-	 :style toggle 
-	 :selected whitespace-visual-mode]
-	["Incremental Highlighting"
-	 whitespace-visual-incremental-mode
-	 :style toggle
-	 :selected whitespace-visual-incremental-mode
-	 ]
-	"---"
-	["Show Whitespace Faces" whitespace-visual-show-faces t]
-	"---"
-	["Highlight Tabs & Blanks" 
-	 (whitespace-visual-set-whitespace-chars 'tabs-and-blanks)
-	 :style radio
-	 :selected (eq whitespace-visual-chars 'tabs-and-blanks)]
-	["Highlight Only Tabs"
-	 (whitespace-visual-set-whitespace-chars 'tabs)
-	 :style radio
-	 :selected (eq whitespace-visual-chars 'tabs)]
-	["Highlight Only Blanks"
-	 (whitespace-visual-set-whitespace-chars 'blanks)
-	 :style radio
-	 :selected (eq whitespace-visual-chars 'blanks)]
-	))
-
-(if (and (boundp 'whitespace-visual-install-submenu)
-	 whitespace-visual-install-submenu)
-    (add-submenu '("Tools") whitespace-visual-menu))
-
-;;; Toolbar icon for the XEmacs
-
-(if (featurep 'toolbar)
-
-(defvar toolbar-wspace-icon
-  (toolbar-make-button-list
-   "/* XPM */
-static char * whitespace[] = {
-\"28 28 4 1\",
-\" 	c Gray75 s backgroundToolBarColor\",
-\".	c black s foregroundToolBarColor\",
-\"X	c Gray60\",
-\"o	c white\",
-\"                            \",
-\"                            \",
-\"                            \",
-\"                            \",
-\"         ..      .          \",
-\"       XXX.XXXXXX   .       \",
-\"       Xoo.oooooXX  .       \",
-\" .. .. ..o.o..oo..X...  ..  \",
-\"  .  . X.o..o.ooX. X.  .  . \",
-\"  .  . .oo.oo.ooX.XX.  .... \",
-\"   ... .oo.oo.ooo.oo.  .    \",
-\"   .  .Xoo.oo.ooo.oo.  .  . \",
-\"   .  .Xo...o..o...o..  ..  \",
-\"       XooooooooooooX       \",
-\"       XooooooooooooX       \",
-\" .... ....ooo...ooo...  ..  \",
-\" .  .  .oo.o.oo.oo.oX. .  . \",
-\"  .    .oo.ooo..oo.oX  .... \",
-\"   ..  .oo.o..o.oo.oX  .    \",
-\" .  .  .oo.o.oo.oo.oX. .  . \",
-\" ....  ...oo.....oo..   ..  \",
-\"       .ooooooooooooX       \",
-\"       .XXXXXXXXXXXXX       \",
-\"       .                    \",
-\"      ...                   \",
-\"                            \",
-\"                            \",
-\"                            \"
-};")
-  "A whitespace icon.")
-)
-
-(defun whitespace-visual-toolbar-function ()
-  "Calls the function determined by `whitespace-visual-toolbar-function'."
-  (interactive)
-  (call-interactively whitespace-visual-toolbar-function))
-
-(if (and (featurep 'xemacs) ;; (adapt-xemacsp)
-	 whitespace-visual-install-toolbar-icon
-	 (featurep 'toolbar)
-	 (eq (device-type (selected-device)) 'x))
-    (let ((tb (mapcar #'(lambda (e)
-			  (elt e 1)) (specifier-instance default-toolbar))))
-      (and (not (member 'whitespace-visual-toolbar-function tb))
-	   (set-specifier 
-	    default-toolbar
-	    (toolbar-add-item
-	     (make-toolbar-instantiator default-toolbar)
-	     [toolbar-wspace-icon whitespace-visual-toolbar-function
-				  t "Toggle whitespace visual mode"]
-	     (let ((n (or
-		       (position 'toolbar-replace tb)
-		       (position 'toolbar-undo tb)
-		       (position 'toolbar-paste tb)
-		       (position 'toolbar-copy tb)
-		       (position 'toolbar-cut tb))))
-	       (if n (1+ n) (length tb))))))))
-
-;;; whitespace-visual-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/whitespace.el b/xemacs-packages/lisp/text-modes/whitespace.el
deleted file mode 100644
index e528427e..00000000
--- a/xemacs-packages/lisp/text-modes/whitespace.el
+++ /dev/null
@@ -1,856 +0,0 @@
-;;; whitespace.el --- warn about and clean bogus whitespaces in the file
-
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-;; Author: Rajesh Vaidheeswarran 
-;; Keywords: convenience
-
-;; $Id: whitespace.el,v 1.3 2005/03/25 17:09:08 aidan Exp $
-;; 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.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;; Whitespace.el URL: http://www.dsmit.com/lisp/
-
-;; The whitespace library is intended to find and help fix five different types
-;; of whitespace problems that commonly exist in source code.
-
-;; 1. Leading space (empty lines at the top of a file).
-;; 2. Trailing space (empty lines at the end of a file).
-;; 3. Indentation space (8 or more spaces at beginning of line, that should be
-;; 		      replaced with TABS).
-;; 4. Spaces followed by a TAB.  (Almost always, we never want that).
-;; 5. Spaces or TABS at the end of a line.
-
-;; Whitespace errors are reported in a buffer, and on the modeline.
-
-;; Modeline will show a W:! to denote a particular type of whitespace,
-;; where `x' and `y' can be one (or more) of:
-
-;; e - End-of-Line whitespace.
-;; i - Indentation whitespace.
-;; l - Leading whitespace.
-;; s - Space followed by Tab.
-;; t - Trailing whitespace.
-
-;; If any of the whitespace checks is turned off, the modeline will display a
-;; !.
-
-;;     (since (3) is the most controversial one, here is the rationale: Most
-;;     terminal drivers and printer drivers have TAB configured or even
-;;     hardcoded to be 8 spaces.  (Some of them allow configuration, but almost
-;;     always they default to 8.)
-
-;;     Changing `tab-width' to other than 8 and editing will cause your code to
-;;     look different from within Emacs, and say, if you cat it or more it, or
-;;     even print it.
-
-;;     Almost all the popular programming modes let you define an offset (like
-;;     c-basic-offset or perl-indent-level) to configure the offset, so you
-;;     should never have to set your `tab-width' to be other than 8 in all
-;;     these modes.  In fact, with an indent level of say, 4, 2 TABS will cause
-;;     Emacs to replace your 8 spaces with one \t (try it).  If vi users in
-;;     your office complain, tell them to use vim, which distinguishes between
-;;     tabstop and shiftwidth (vi equivalent of our offsets), and also ask them
-;;     to set smarttab.)
-
-;; All the above have caused (and will cause) unwanted codeline integration and
-;; merge problems.
-
-;; whitespace.el will complain if it detects whitespaces on opening a file, and
-;; warn you on closing a file also (in case you had inserted any
-;; whitespaces during the process of your editing).
-
-;; Exported functions:
-
-;; `whitespace-buffer' - To check the current buffer for whitespace problems.
-;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer.
-;; `whitespace-region' - To check between point and mark for whitespace
-;;                       problems.
-;; `whitespace-cleanup-region' - To cleanup all whitespaces between point
-;;                               and mark in the current buffer.
-
-;;; Code:
-
-(eval-when-compile (require 'easy-mmode))
-
-(defvar whitespace-version "3.2" "Version of the whitespace library.")
-
-(defvar whitespace-all-buffer-files nil
-  "An associated list of buffers and files checked for whitespace cleanliness.
-
-This is to enable periodic checking of whitespace cleanliness in the files
-visited by the buffers.")
-
-(defvar whitespace-rescan-timer nil
-  "Timer object used to rescan the files in buffers that have been modified.")
-
-;; Tell Emacs about this new kind of minor mode
-(defvar whitespace-mode nil
-  "Non-nil when Whitespace mode (a minor mode) is enabled.")
-(make-variable-buffer-local 'whitespace-mode)
-(put 'whitespace-mode 'permanent-local nil)
-
-(defvar whitespace-mode-line nil
-  "String to display in the mode line for Whitespace mode.")
-(make-variable-buffer-local 'whitespace-mode-line)
-(put 'whitespace-mode-line 'permanent-local nil)
-
-(defvar whitespace-check-buffer-leading nil
-  "Test leading whitespace for file in current buffer if t")
-(make-variable-buffer-local 'whitespace-check-buffer-leading)
-(put 'whitespace-check-buffer-leading 'permanent-local nil)
-
-(defvar whitespace-check-buffer-trailing nil
-  "Test trailing whitespace for file in current buffer if t")
-(make-variable-buffer-local 'whitespace-check-buffer-trailing)
-(put 'whitespace-check-buffer-trailing 'permanent-local nil)
-
-(defvar whitespace-check-buffer-indent nil
-  "Test indentation whitespace for file in current buffer if t")
-(make-variable-buffer-local 'whitespace-check-buffer-indent)
-(put 'whitespace-check-buffer-indent 'permanent-local nil)
-
-(defvar whitespace-check-buffer-spacetab nil
-  "Test Space-followed-by-TABS whitespace for file in current buffer if t")
-(make-variable-buffer-local 'whitespace-check-buffer-spacetab)
-(put 'whitespace-check-buffer-spacetab 'permanent-local nil)
-
-(defvar whitespace-check-buffer-ateol nil
-  "Test end-of-line whitespace for file in current buffer if t")
-(make-variable-buffer-local 'whitespace-check-buffer-ateol)
-(put 'whitespace-check-buffer-ateol 'permanent-local nil)
-
-(defvar whitespace-highlighted-space nil
-  "The variable to store the extent to highlight")
-(make-variable-buffer-local 'whitespace-highlighted-space)
-(put 'whitespace-highlighted-space 'permanent-local nil)
-
-;; For flavors of Emacs which don't define `defgroup' and `defcustom'.
-(eval-when-compile
-  (if (not (fboundp 'defgroup))
-      (defmacro defgroup (sym memb doc &rest args)
-	"Null macro for defgroup in all versions of Emacs that don't define
-defgroup"
-	t))
-  (if (not (fboundp 'defcustom))
-      (defmacro defcustom (sym val doc &rest args)
-	"Macro to alias defcustom to defvar in all versions of Emacs that
-don't define defcustom"
-	`(defvar ,sym ,val ,doc))))
-
-(if (fboundp 'make-overlay)
-    (progn
-      (defalias 'whitespace-make-overlay 'make-overlay)
-      (defalias 'whitespace-overlay-put 'overlay-put)
-      (defalias 'whitespace-delete-overlay 'delete-overlay)
-      (defalias 'whitespace-overlay-start 'overlay-start)
-      (defalias 'whitespace-overlay-end 'overlay-end)
-      (defalias 'whitespace-mode-line-update 'force-mode-line-update))
-  (defalias 'whitespace-make-overlay 'make-extent)
-  (defalias 'whitespace-overlay-put 'set-extent-property)
-  (defalias 'whitespace-delete-overlay 'delete-extent)
-  (defalias 'whitespace-overlay-start 'extent-start)
-  (defalias 'whitespace-overlay-end 'extent-end)
-  (defalias 'whitespace-mode-line-update 'redraw-modeline))
-
-(if (featurep 'xemacs)
-(defgroup whitespace nil
-  "Check for and fix five different types of whitespaces in source code."
-  ;; Since XEmacs doesn't have a 'convenience group, use the next best group
-  ;; which is 'editing?
-  :group 'editing)
-(defgroup whitespace nil
-  "Check for and fix five different types of whitespaces in source code."
-  :version "21.1"
-  :group 'convenience))
-
-(defcustom whitespace-check-leading-whitespace t
-  "Flag to check leading whitespace. This is the global for the system.
-It can be overriden by setting a buffer local variable
-`whitespace-check-buffer-leading'"
-  :type 'boolean
-  :group 'whitespace)
-
-(defcustom whitespace-check-trailing-whitespace t
-  "Flag to check trailing whitespace. This is the global for the system.
-It can be overriden by setting a buffer local variable
-`whitespace-check-buffer-trailing'"
-  :type 'boolean
-  :group 'whitespace)
-
-(defcustom whitespace-check-spacetab-whitespace t
-  "Flag to check space followed by a TAB. This is the global for the system.
-It can be overriden by setting a buffer local variable
-`whitespace-check-buffer-spacetab'"
-  :type 'boolean
-  :group 'whitespace)
-
-(defcustom whitespace-spacetab-regexp "[ ]+\t"
-  "Regexp to match a space followed by a TAB."
-  :type 'regexp
-  :group 'whitespace)
-
-(defcustom whitespace-check-indent-whitespace indent-tabs-mode
-  "Flag to check indentation whitespace. This is the global for the system.
-It can be overriden by setting a buffer local variable
-`whitespace-check-buffer-indent'"
-  :type 'boolean
-  :group 'whitespace)
-
-(defcustom whitespace-indent-regexp (concat "^\\(\t*\\)    " "    ")
-  "Regexp to match (any TABS followed by) 8/more whitespaces at start of line."
-  :type 'regexp
-  :group 'whitespace)
-
-(defcustom whitespace-check-ateol-whitespace t
-  "Flag to check end-of-line whitespace. This is the global for the system.
-It can be overriden by setting a buffer local variable
-`whitespace-check-buffer-ateol'"
-  :type 'boolean
-  :group 'whitespace)
-
-;; (defcustom whitespace-ateol-regexp "[ \t]$"
-(defcustom whitespace-ateol-regexp "[ \t]+$"
-  "Regexp to match a TAB or a space at the EOL."
-  :type 'regexp
-  :group 'whitespace)
-
-(defcustom whitespace-errbuf "*Whitespace Errors*"
-  "The name of the buffer where whitespace related messages will be logged."
-  :type 'string
-  :group 'whitespace)
-
-(defcustom whitespace-abort-on-error nil
-  "While writing a file, abort if the file is unclean. If
-`whitespace-auto-cleanup' is set, that takes precedence over this
-variable."
-  :type  'boolean
-  :group 'whitespace)
-
-(defcustom whitespace-auto-cleanup nil
-  "Cleanup a buffer automatically on finding it whitespace unclean."
-  :type  'boolean
-  :group 'whitespace)
-
-(defcustom whitespace-silent nil
-  "All whitespace errors will be shown only in the modeline when t.
-
-Note that setting this may cause all whitespaces introduced in a file to go
-unnoticed when the buffer is killed, unless the user visits the `*Whitespace
-Errors*' buffer before opening (or closing) another file."
-  :type 'boolean
-  :group 'whitespace)
-
-(defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode
-				       c-mode c++-mode cc-mode
-				       change-log-mode cperl-mode
-				       electric-nroff-mode emacs-lisp-mode
-				       f90-mode fortran-mode html-mode
-				       html3-mode java-mode jde-mode
-				       ksh-mode latex-mode LaTeX-mode
-				       lisp-mode m4-mode makefile-mode
-				       modula-2-mode nroff-mode objc-mode
-				       pascal-mode perl-mode prolog-mode
-				       python-mode scheme-mode sgml-mode
-				       sh-mode shell-script-mode simula-mode
-				       tcl-mode tex-mode texinfo-mode
-				       vrml-mode xml-mode)
-
-  "Major Modes in which we turn on whitespace checking.
-
-These are mostly programming and documentation modes.  But you may add other
-modes that you want whitespaces checked in by adding something like the
-following to your `.emacs':
-
-\(setq whitespace-modes (cons 'my-mode (cons 'my-other-mode
-					    whitespace-modes))\)
-
-Or, alternately, you can use the Emacs `customize' command to set this."
-  :type '(repeat symbol)
-  :group 'whitespace)
-
-(defcustom whitespace-rescan-timer-time 600
-  "Period in seconds to rescan modified buffers for whitespace creep.
-
-This is the period after which the timer will fire causing
-`whitespace-rescan-files-in-buffers' to check for whitespace creep in
-modified buffers.
-
-To disable timer scans, set this to zero."
-  :type 'integer
-  :group 'whitespace)
-
-(defcustom whitespace-display-in-modeline t
-  "Display whitespace errors on the modeline."
-  :type 'boolean
-  :group 'whitespace)
-
-(defcustom whitespace-display-spaces-in-color t
-  "Display the bogus whitespaces by coloring them with
-`whitespace-highlight-face'."
-  :type 'boolean
-  :group 'whitespace)
-
-(defgroup whitespace-faces nil
-  "Faces used in whitespace."
-  :prefix "whitespace-"
-  :group 'whitespace
-  :group 'faces)
-
-(defface whitespace-highlight-face '((((class color) (background light))
-				      (:background "green"))
-				     (((class color) (background dark))
-				      (:background "sea green"))
-				     (((class grayscale mono)
-				       (background light))
-				      (:background "black"))
-				     (((class grayscale mono)
-				       (background dark))
-				      (:background "white")))
-  "Face used for highlighting the bogus whitespaces that exist in the buffer."
-  :group 'whitespace-faces)
-
-(if (not (assoc 'whitespace-mode minor-mode-alist))
-    (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
-				 minor-mode-alist)))
-
-(set-default 'whitespace-check-buffer-leading
-	     whitespace-check-leading-whitespace)
-(set-default 'whitespace-check-buffer-trailing
-	     whitespace-check-trailing-whitespace)
-(set-default 'whitespace-check-buffer-indent
-	     whitespace-check-indent-whitespace)
-(set-default 'whitespace-check-buffer-spacetab
-	     whitespace-check-spacetab-whitespace)
-(set-default 'whitespace-check-buffer-ateol
-	     whitespace-check-ateol-whitespace)
-
-(defun whitespace-check-whitespace-mode (&optional arg)
-  "Test and set the whitespace-mode in qualifying buffers."
-  (if (null whitespace-mode)
-      (setq whitespace-mode
-	    (if (or arg (member major-mode whitespace-modes))
-		t
-	      nil))))
-
-;;;###autoload
-(defun whitespace-toggle-leading-check ()
-  "Toggle the check for leading space in the local buffer."
-  (interactive)
-  (let ((current-val whitespace-check-buffer-leading))
-    (setq whitespace-check-buffer-leading (not current-val))
-    (message "Will%s check for leading space in buffer."
-	     (if whitespace-check-buffer-leading "" " not"))
-    (if whitespace-check-buffer-leading (whitespace-buffer-leading))))
-
-;;;###autoload
-(defun whitespace-toggle-trailing-check ()
-  "Toggle the check for trailing space in the local buffer."
-  (interactive)
-  (let ((current-val whitespace-check-buffer-trailing))
-    (setq whitespace-check-buffer-trailing (not current-val))
-    (message "Will%s check for trailing space in buffer."
-	     (if whitespace-check-buffer-trailing "" " not"))
-    (if whitespace-check-buffer-trailing (whitespace-buffer-trailing))))
-
-;;;###autoload
-(defun whitespace-toggle-indent-check ()
-  "Toggle the check for indentation space in the local buffer."
-  (interactive)
-  (let ((current-val whitespace-check-buffer-indent))
-    (setq whitespace-check-buffer-indent (not current-val))
-    (message "Will%s check for indentation space in buffer."
-	     (if whitespace-check-buffer-indent "" " not"))
-    (if whitespace-check-buffer-indent
-	(whitespace-buffer-search whitespace-indent-regexp))))
-
-;;;###autoload
-(defun whitespace-toggle-spacetab-check ()
-  "Toggle the check for space-followed-by-TABs in the local buffer."
-  (interactive)
-  (let ((current-val whitespace-check-buffer-spacetab))
-    (setq whitespace-check-buffer-spacetab (not current-val))
-    (message "Will%s check for space-followed-by-TABs in buffer."
-	     (if whitespace-check-buffer-spacetab "" " not"))
-    (if whitespace-check-buffer-spacetab
-	(whitespace-buffer-search whitespace-spacetab-regexp))))
-
-
-;;;###autoload
-(defun whitespace-toggle-ateol-check ()
-  "Toggle the check for end-of-line space in the local buffer."
-  (interactive)
-  (let ((current-val whitespace-check-buffer-ateol))
-    (setq whitespace-check-buffer-ateol (not current-val))
-    (message "Will%s check for end-of-line space in buffer."
-	     (if whitespace-check-buffer-ateol "" " not"))
-    (if whitespace-check-buffer-ateol
-	(whitespace-buffer-search whitespace-ateol-regexp))))
-
-
-;;;###autoload
-(defun whitespace-buffer (&optional quiet)
-  "Find five different types of white spaces in buffer.
-These are:
-1. Leading space \(empty lines at the top of a file\).
-2. Trailing space \(empty lines at the end of a file\).
-3. Indentation space \(8 or more spaces, that should be replaced with TABS\).
-4. Spaces followed by a TAB. \(Almost always, we never want that\).
-5. Spaces or TABS at the end of a line.
-
-Check for whitespace only if this buffer really contains a non-empty file
-and:
-1. the major mode is one of the whitespace-modes, or
-2. `whitespace-buffer' was explicitly called with a prefix argument."
-  (interactive)
-  (let ((whitespace-error nil))
-    (whitespace-check-whitespace-mode current-prefix-arg)
-    (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode)
-	(progn
-	  (whitespace-check-buffer-list (buffer-name) buffer-file-name)
-	  (whitespace-tickle-timer)
-	  (whitespace-unhighlight-the-space)
-	  (if whitespace-auto-cleanup
-	      (if buffer-read-only
-		  (if (not quiet)
-		      (message "Can't cleanup: %s is read-only" (buffer-name)))
-		(whitespace-cleanup))
-	    (let ((whitespace-leading (if whitespace-check-buffer-leading
-					  (whitespace-buffer-leading)
-					nil))
-		  (whitespace-trailing (if whitespace-check-buffer-trailing
-					   (whitespace-buffer-trailing)
-					 nil))
-		  (whitespace-indent (if whitespace-check-buffer-indent
-					 (whitespace-buffer-search
-					  whitespace-indent-regexp)
-				       nil))
-		  (whitespace-spacetab (if whitespace-check-buffer-spacetab
-					   (whitespace-buffer-search
-					    whitespace-spacetab-regexp)
-					 nil))
-		  (whitespace-ateol (if whitespace-check-buffer-ateol
-					(whitespace-buffer-search
-					 whitespace-ateol-regexp)
-				      nil))
-		  (whitespace-errmsg nil)
-		  (whitespace-filename buffer-file-name)
-		  (whitespace-this-modeline ""))
-
-	      ;; Now let's complain if we found any of the above.
-	      (setq whitespace-error (or whitespace-leading whitespace-indent
-					 whitespace-spacetab whitespace-ateol
-					 whitespace-trailing))
-
-	      (if whitespace-error
-		  (progn
-		    (setq whitespace-errmsg
-			  (concat whitespace-filename " contains:\n"
-				  (if whitespace-leading
-				      "Leading whitespace\n")
-				  (if whitespace-indent
-				      (concat "Indentation whitespace"
-					      whitespace-indent "\n"))
-				  (if whitespace-spacetab
-				      (concat "Space followed by Tab"
-					      whitespace-spacetab "\n"))
-				  (if whitespace-ateol
-				      (concat "End-of-line whitespace"
-					      whitespace-ateol "\n"))
-				  (if whitespace-trailing
-				      "Trailing whitespace\n")
-				  "\ntype `M-x whitespace-cleanup' to "
-				  "cleanup the file."))
-		    (setq whitespace-this-modeline
-			  (concat (if whitespace-ateol "e")
-				  (if whitespace-indent "i")
-				  (if whitespace-leading "l")
-				  (if whitespace-spacetab "s")
-				  (if whitespace-trailing "t")))))
-	      (whitespace-update-modeline whitespace-this-modeline)
-	      (save-excursion
-		(get-buffer-create whitespace-errbuf)
-		(kill-buffer whitespace-errbuf)
-		(get-buffer-create whitespace-errbuf)
-		(set-buffer whitespace-errbuf)
-		(if whitespace-errmsg
-		    (progn
-		      (insert whitespace-errmsg)
-		      (if (not (or quiet whitespace-silent))
-			  (display-buffer whitespace-errbuf t))
-		      (if (not quiet)
-			  (message "Whitespaces: [%s%s] in %s"
-				   whitespace-this-modeline
-				   (let ((whitespace-unchecked
-					  (whitespace-unchecked-whitespaces)))
-				     (if whitespace-unchecked
-					 (concat "!" whitespace-unchecked)
-				       ""))
-				   whitespace-filename)))
-		  (if (not quiet)
-		      (message "%s clean" whitespace-filename))))))))
-    (if whitespace-error
-	t
-      nil)))
-
-;;;###autoload
-(defun whitespace-region (s e)
-  "Check the region for whitespace errors."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region s e)
-      (whitespace-buffer))))
-
-;;;###autoload
-(defun whitespace-cleanup ()
-  "Cleanup the five different kinds of whitespace problems.
-
-Use \\[describe-function] whitespace-describe to read a summary of the
-whitespace problems."
-  (interactive)
-  ;; If this buffer really contains a file, then run, else quit.
-  (whitespace-check-whitespace-mode current-prefix-arg)
-  (if (and buffer-file-name whitespace-mode)
-      (let ((whitespace-any nil)
-	    (whitespace-tabwith 8)
-	    (whitespace-tabwith-saved tab-width))
-
-	;; since all printable TABS should be 8, irrespective of how
-	;; they are displayed.
-	(setq tab-width whitespace-tabwith)
-
-	(if (and whitespace-check-buffer-leading
-		 (whitespace-buffer-leading))
-	    (progn
-	      (whitespace-buffer-leading-cleanup)
-	      (setq whitespace-any t)))
-
-	(if (and whitespace-check-buffer-trailing
-		 (whitespace-buffer-trailing))
-	    (progn
-	      (whitespace-buffer-trailing-cleanup)
-	      (setq whitespace-any t)))
-
-	(if (and whitespace-check-buffer-indent
-		 (whitespace-buffer-search whitespace-indent-regexp))
-	    (progn
-	      (whitespace-indent-cleanup)
-	      (setq whitespace-any t)))
-
-	(if (and whitespace-check-buffer-spacetab
-		 (whitespace-buffer-search whitespace-spacetab-regexp))
-	    (progn
-	      (whitespace-buffer-cleanup whitespace-spacetab-regexp "\t")
-	      (setq whitespace-any t)))
-
-	(if (and whitespace-check-buffer-ateol
-		 (whitespace-buffer-search whitespace-ateol-regexp))
-	    (progn
-	      (whitespace-buffer-cleanup whitespace-ateol-regexp "")
-	      (setq whitespace-any t)))
-
-	;; Call this recursively till everything is taken care of
-	(if whitespace-any
-	    (whitespace-cleanup)
-	  (progn
-           (if (not whitespace-silent) 
-               (message "%s clean" buffer-file-name)) 
-	    (whitespace-update-modeline)))
-	(setq tab-width whitespace-tabwith-saved))))
-
-;;;###autoload
-(defun whitespace-cleanup-region (s e)
-  "Whitespace cleanup on the region."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region s e)
-      (whitespace-cleanup))
-    (whitespace-buffer t)))
-
-(defun whitespace-buffer-leading ()
-  "Check to see if there are any empty lines at the top of the file."
-  (save-excursion
-    (let ((pmin nil)
-	  (pmax nil))
-      (goto-char (point-min))
-      (beginning-of-line)
-      (setq pmin (point))
-      (end-of-line)
-      (setq pmax (point))
-      (if (equal pmin pmax)
-	  (progn
-	    (whitespace-highlight-the-space pmin pmax)
-	    t)
-	nil))))
-
-(defun whitespace-buffer-leading-cleanup ()
-  "Remove any empty lines at the top of the file."
-  (save-excursion
-    (let ((pmin nil)
-	  (pmax nil))
-      (goto-char (point-min))
-      (beginning-of-line)
-      (setq pmin (point))
-      (end-of-line)
-      (setq pmax (point))
-      (if (equal pmin pmax)
-	  (progn
-	    (kill-line)
-	    (whitespace-buffer-leading-cleanup))))))
-
-(defun whitespace-buffer-trailing ()
-  "Check to see if are is more than one empty line at the bottom."
-  (save-excursion
-    (let ((pmin nil)
-	  (pmax nil))
-      (goto-char (point-max))
-      (beginning-of-line)
-      (setq pmin (point))
-      (end-of-line)
-      (setq pmax (point))
-      (if (equal pmin pmax)
-	  (progn
-	    (goto-char (- (point) 1))
-	    (beginning-of-line)
-	    (setq pmin (point))
-	    (end-of-line)
-	    (setq pmax (point))
-	    (if (equal pmin pmax)
-		(progn
-		  (whitespace-highlight-the-space pmin pmax)
-		  t)
-	      nil))
-	nil))))
-
-(defun whitespace-buffer-trailing-cleanup ()
-  "Delete all the empty lines at the bottom."
-  (save-excursion
-    (let ((pmin nil)
-	  (pmax nil))
-      (goto-char (point-max))
-      (beginning-of-line)
-      (setq pmin (point))
-      (end-of-line)
-      (setq pmax (point))
-      (if (equal pmin pmax)
-	  (progn
-	    (goto-char (1- pmin))
-	    (beginning-of-line)
-	    (setq pmin (point))
-	    (end-of-line)
-	    (setq pmax (point))
-	    (if (equal pmin pmax)
-		(progn
-		  (goto-char (1- (point-max)))
-		  (beginning-of-line)
-		  (kill-line)
-		  (whitespace-buffer-trailing-cleanup))))))))
-
-(defun whitespace-buffer-search (regexp)
-  "Search for any given whitespace REGEXP."
-  (let ((whitespace-retval ""))
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward regexp nil t)
-	(progn
-	  (setq whitespace-retval (format "%s %s" whitespace-retval
-					(match-beginning 0)))
-	(whitespace-highlight-the-space (match-beginning 0) (match-end 0))))
-      (if (equal "" whitespace-retval)
-	  nil
-	whitespace-retval))))
-
-(defun whitespace-buffer-cleanup (regexp newregexp)
-  "Search for any given whitespace REGEXP and replace it with the NEWREGEXP."
-  (save-excursion
-    (goto-char (point-min))
-    (while (re-search-forward regexp nil t)
-      (replace-match newregexp))))
-
-(defun whitespace-indent-cleanup ()
-  "Search for 8/more spaces at the start of a line and replace it with tabs."
-  (save-excursion
-    (goto-char (point-min))
-    (while (re-search-forward whitespace-indent-regexp nil t)
-      (let ((column (current-column))
-	    (indent-tabs-mode t))
-	(delete-region (match-beginning 0) (point))
-	(indent-to column)))))
-
-(defun whitespace-unchecked-whitespaces ()
-  "Return the list of whitespaces whose testing has been suppressed."
-  (let ((unchecked-spaces
-	 (concat (if (not whitespace-check-buffer-ateol) "e")
-		 (if (not whitespace-check-buffer-indent) "i")
-		 (if (not whitespace-check-buffer-leading) "l")
-		 (if (not whitespace-check-buffer-spacetab) "s")
-		 (if (not whitespace-check-buffer-trailing) "t"))))
-    (if (not (equal unchecked-spaces ""))
-	unchecked-spaces
-      nil)))
-
-(defun whitespace-update-modeline (&optional whitespace-err)
-  "Update modeline with whitespace errors.
-Also with whitespaces whose testing has been turned off."
-  (if whitespace-display-in-modeline
-      (progn
-	(setq whitespace-mode-line nil)
-	;; Whitespace errors
-	(if (and whitespace-err (not (equal whitespace-err "")))
-	    (setq whitespace-mode-line whitespace-err))
-	;; Whitespace suppressed errors
-	(let ((whitespace-unchecked (whitespace-unchecked-whitespaces)))
-	  (if whitespace-unchecked
-	      (setq whitespace-mode-line
-		    (concat whitespace-mode-line "!" whitespace-unchecked))))
-	;; Add the whitespace modeline prefix
-	(setq whitespace-mode-line (if whitespace-mode-line
-				       (concat " W:" whitespace-mode-line)
-				     nil))
-	(whitespace-mode-line-update))))
-
-(defun whitespace-highlight-the-space (b e)
-  "Highlight the current line, unhighlighting a previously jumped to line."
-  (if whitespace-display-spaces-in-color
-      (progn
-	(whitespace-unhighlight-the-space)
-	(add-to-list 'whitespace-highlighted-space
-		     (whitespace-make-overlay b e))
-	(whitespace-overlay-put (whitespace-make-overlay b e) 'face
-				'whitespace-highlight-face))))
-;;  (add-hook 'pre-command-hook 'whitespace-unhighlight-the-space))
-
-(defun whitespace-unhighlight-the-space ()
-  "Unhighlight the currently highlight line."
-  (if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
-      (let ((whitespace-this-space nil))
-	(while whitespace-highlighted-space
-	  (setq whitespace-this-space (car whitespace-highlighted-space))
-	  (setq whitespace-highlighted-space
-		(cdr whitespace-highlighted-space))
-	  (whitespace-delete-overlay whitespace-this-space))
-	(setq whitespace-highlighted-space nil))
-    (remove-hook 'pre-command-hook 'whitespace-unhighlight-the-space)))
-
-(defun whitespace-check-buffer-list (buf-name buf-file)
-  "Add a buffer and its file to the whitespace monitor list.
-
-The buffer named BUF-NAME and its associated file BUF-FILE are now monitored
-periodically for whitespace."
-  (if (and whitespace-mode (not (member (list buf-file buf-name)
-					whitespace-all-buffer-files)))
-      (add-to-list 'whitespace-all-buffer-files (list buf-file buf-name))))
-
-(defun whitespace-tickle-timer ()
-  "Tickle timer to periodically to scan qualifying files for whitespace creep.
-
-If timer is not set, then set it to scan the files in
-`whitespace-all-buffer-files' periodically (defined by
-`whitespace-rescan-timer-time') for whitespace creep."
-  (if (and whitespace-rescan-timer-time (not whitespace-rescan-timer))
-      (setq whitespace-rescan-timer
-	    (add-timeout whitespace-rescan-timer-time
-			 'whitespace-rescan-files-in-buffers nil
-			 whitespace-rescan-timer-time))))
-
-(defun whitespace-rescan-files-in-buffers (&optional arg)
-  "Check monitored files for whitespace creep since last scan."
-  (let ((whitespace-all-my-files whitespace-all-buffer-files)
-	buffile bufname thiselt buf)
-    (if (not whitespace-all-my-files)
-	(progn
-	  (disable-timeout whitespace-rescan-timer)
-	  (setq whitespace-rescan-timer nil))
-      (while whitespace-all-my-files
-	(setq thiselt (car whitespace-all-my-files))
-	(setq whitespace-all-my-files (cdr whitespace-all-my-files))
-	(setq buffile (car thiselt))
-	(setq bufname (cadr thiselt))
-	(setq buf (get-buffer bufname))
-	(if (buffer-live-p buf)
-	    (save-excursion
-	      ;;(message "buffer %s live" bufname)
-	      (set-buffer bufname)
-	      (if whitespace-mode
-		  (progn
-		    ;;(message "checking for whitespace in %s" bufname)
-		    (if whitespace-auto-cleanup
-			(progn
-			  ;;(message "cleaning up whitespace in %s" bufname)
-			  (whitespace-cleanup))
-		      (progn
-			;;(message "whitespace-buffer %s." (buffer-name))
-			(whitespace-buffer t))))
-		;;(message "Removing %s from refresh list" bufname)
-		(whitespace-refresh-rescan-list buffile bufname)))
-	  ;;(message "Removing %s from refresh list" bufname)
-	  (whitespace-refresh-rescan-list buffile bufname))))))
-
-(defun whitespace-refresh-rescan-list (buffile bufname)
-  "Refresh the list of files to be rescaned for whitespace creep."
-  (if whitespace-all-buffer-files
-      (setq whitespace-all-buffer-files
-	    (delete (list buffile bufname) whitespace-all-buffer-files))
-    (when whitespace-rescan-timer
-      (disable-timeout whitespace-rescan-timer)
-      (setq whitespace-rescan-timer nil))))
-
-;; XEmacs hack: autoload a dummy autoload instead of a minor mode
-;;;###autoload(autoload 'whitespace-global-mode "whitespace" nil t)
-(define-minor-mode whitespace-global-mode
-  "Toggle using Whitespace mode in new buffers.
-With ARG, turn the mode on if and only iff ARG is positive.
-
-When this mode is active, `whitespace-buffer' is added to
-`find-file-hook' and `kill-buffer-hook'."
-  :global t :group 'whitespace
-  (if whitespace-global-mode
-      (progn
-	(add-hook 'find-file-hook 'whitespace-buffer)
-	(add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
-	(add-hook 'kill-buffer-hook 'whitespace-buffer))
-    (remove-hook 'find-file-hook 'whitespace-buffer)
-    (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
-    (remove-hook 'kill-buffer-hook 'whitespace-buffer)))
-
-;;;###autoload
-(defun whitespace-write-file-hook ()
-  "Hook function to be called on the buffer when whitespace check is enabled.
-This is meant to be added buffer-locally to `write-file-functions'."
-  (interactive)
-  (let ((werr nil))
-    (if whitespace-auto-cleanup
-	(whitespace-cleanup)
-      (setq werr (whitespace-buffer)))
-    (if (and whitespace-abort-on-error werr)
-	(error (concat "Abort write due to whitespaces in "
-		       buffer-file-name))))
-  nil)
-
-(defun whitespace-unload-hook ()
-  (remove-hook 'find-file-hook 'whitespace-buffer)
-  (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
-  (remove-hook 'kill-buffer-hook 'whitespace-buffer))
-
-(provide 'whitespace)
-;;; whitespace.el ends here
diff --git a/xemacs-packages/lisp/text-modes/winmgr-mode.el b/xemacs-packages/lisp/text-modes/winmgr-mode.el
deleted file mode 100644
index e7676d8e..00000000
--- a/xemacs-packages/lisp/text-modes/winmgr-mode.el
+++ /dev/null
@@ -1,173 +0,0 @@
-;;; winmgr-mode.el --- generic window manager mode
-
-;; Author: ???
-;; Maintainer: David Konerding (rafael@cse.ucsc.edu)
-;; Modifications by: Stefan Strobel 
-;;                   Barry A. Warsaw 
-;; Created: ???
-;; Keywords: languages
-
-;; Copyright (C) 199? Someone Claim It
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; This package is a major mode for editing window configuration files and
-;; also defines font-lock keywords for such files.
-
-;; winmgr-mode mode will automatically get turned on if you visit a
-;; a file whose name looks like that of a configuration file
-;; (IE, .fvwmrc, .mwmrc, .tvtwmrc, etc)
-
-;; The current font-lock keywords are:
-
-;; any word of upper or lower case letters at the start of a line
-;; followed by whitespace gets colored using
-;; font-lock-function-name-face.
-
-;; any word of upper or lower case letters at the start of a line
-;; followed by a "(" (IE, an m4 macro) gets colored using
-;; font-lock-comment-face
-
-;; Put this in your .emacs :
-;;
-;;(setq auto-mode-alist
-;;      (append '(("\\.[A-Za-z]*wm$" . winmgr-mode)
-;;              ("\\.[A-Za-z]*wmrc" . winmgr-mode) 
-;;	      auto-mode-alist))
-;;
-;;(autoload 'winmgr-mode "winmgr-mode"
-;;  "Mode for editing window manager config files")
-;;
-;;(add-hook 'winmgr-mode-hook
-;;	  '(lambda ()
-;;	     (font-lock-mode t)
-;;	     (setq font-lock-keywords winmgr-font-lock-keywords)
-;;           (font-lock-fontify-buffer)))
-;;
-
-
-;;; Code:
-
-(defgroup winmgr nil
-  "Generic window manager mode."
-  :tag "Window Managers"
-  :group 'languages)
-
-
-(defcustom winmgr-basic-offset 4
-  "*Number of spaces per indentation level."
-  :type 'integer
-  :group 'winmgr)
-
-(defcustom winmgr-mode-hook nil
-  "Hook to be run when `winmgr-mode' is entered."
-  :type 'hook
-  :group 'winmgr)
-
-
-(defface font-lock-m4-face
-  '((((class color))
-     (:foreground "blue"))
-    (t
-     (:underline t)))
-  "Font-lock face for M4 macros."
-  :group 'winmgr)
-
-(defvar winmgr-font-lock-keywords 
-  '(("^[A-Za-z]+[ \n\t]" . font-lock-function-name-face)
-    ;;("^#.*" . font-lock-comment-face)
-    ("^[A-Za-z]+(.*)" . font-lock-m4-face))
-  "Default font-lock keywords.")
-
-
-;; major-mode stuff
-(defvar winmgr-mode-abbrev-table nil
-  "Abbrev table used in `winmgr-mode' buffers.")
-(define-abbrev-table 'winmgr-mode-abbrev-table ())
-
-
-(defvar winmgr-mode-syntax-table nil
-  "Syntax table used in `winmgr-mode' buffers.")
-(if winmgr-mode-syntax-table
-    ()
-  (setq winmgr-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\#  "<" winmgr-mode-syntax-table)
-  (modify-syntax-entry ?\n ">" winmgr-mode-syntax-table))
-
-
-(defvar winmgr-mode-map ()
-  "Keymap used in `winmgr-mode' buffers.")
-(if winmgr-mode-map
-    ()
-  (setq winmgr-mode-map (make-sparse-keymap))
-  ;; So far there aren't any winmgr-mode specific functions
-  )
-
-
-;;;###autoload
-(defun winmgr-mode ()
-  "Major mode for editing winmgr config files."
-  (interactive)
-  (kill-all-local-variables)
-  (set-syntax-table winmgr-mode-syntax-table)
-  (setq major-mode 'winmgr-mode
-	mode-name "Winmgr"
-	local-abbrev-table winmgr-mode-abbrev-table)
-  (use-local-map winmgr-mode-map)
-  ;; local variables
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-end)
-  (make-local-variable 'indent-line-function)
-  ;; now set their values
-  (setq parse-sexp-ignore-comments t
-	comment-start "# "
-	comment-end ""
-	indent-line-function 'winmgr-indent-line-function)
-  (run-hooks 'winmgr-mode-hook))
-
-
-;; indentation commands
-
-(defun winmgr-indent-line-function ()
-  "Indent line based on depth in parentheses.
-See the variable `winmgr-basic-offset.'"
-  ;; find the beginning of this construct
-  (let ((depth 0)
-	(here (point)))
-    (condition-case nil
-	(while t
-	  (backward-up-list 1)
-	  (setq depth (1+ depth)))
-      (error nil))
-    (goto-char here)
-    (beginning-of-line)
-    (delete-horizontal-space)
-    (insert-char ?\040 (* depth winmgr-basic-offset))))
-
-
-;; XEmacs addition, Unix-specific
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.[^/]*wm2?\\(?:rc\\)?\\'" . winmgr-mode))
-
-(provide 'winmgr-mode)
-
-;;; winmgr-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/ws-mode.el b/xemacs-packages/lisp/text-modes/ws-mode.el
deleted file mode 100644
index 977b621a..00000000
--- a/xemacs-packages/lisp/text-modes/ws-mode.el
+++ /dev/null
@@ -1,756 +0,0 @@
-;;; ws-mode.el --- WordStar emulation mode for GNU Emacs
-
-;; Copyright (C) 1991 Free Software Foundation, Inc.
-
-;; Author: Juergen Nickelsen 
-;; Version: 0.7
-;; Keywords: emulations
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34
-
-;;; Commentary:
-
-;; This emulates WordStar, with a major mode.
-
-;;; Code:
-
-(defvar wordstar-mode-map nil "")
-(defvar wordstar-C-j-map nil "")
-(defvar wordstar-C-k-map nil "")
-(defvar wordstar-C-o-map nil "")
-(defvar wordstar-C-q-map nil "")
-
-(if wordstar-mode-map
-    ()
-  (setq wordstar-mode-map (make-keymap))
-  ;;  (setq wordstar-C-j-map (make-keymap)) ; later, perhaps
-  (setq wordstar-C-k-map (make-keymap))
-  (setq wordstar-C-o-map (make-keymap))
-  (setq wordstar-C-q-map (make-keymap))
-  
-  (define-key wordstar-mode-map "\C-a" 'backward-word)
-  (define-key wordstar-mode-map "\C-b" 'fill-paragraph)
-  (define-key wordstar-mode-map "\C-c" 'scroll-up)
-  (define-key wordstar-mode-map "\C-d" 'forward-char)
-  (define-key wordstar-mode-map "\C-e" 'previous-line)
-  (define-key wordstar-mode-map "\C-f" 'forward-word)
-  (define-key wordstar-mode-map "\C-g" 'delete-char)
-  (define-key wordstar-mode-map "\C-h" 'backward-char)
-  (define-key wordstar-mode-map "\C-i" 'indent-for-tab-command)
-  (define-key wordstar-mode-map "\C-j" 'help-for-help)
-  (define-key wordstar-mode-map "\C-k" wordstar-C-k-map)
-  (define-key wordstar-mode-map "\C-l" 'ws-repeat-search)
-  (define-key wordstar-mode-map "\C-n" 'open-line)
-  (define-key wordstar-mode-map "\C-o" wordstar-C-o-map)
-  (define-key wordstar-mode-map "\C-p" 'quoted-insert)
-  (define-key wordstar-mode-map "\C-q" wordstar-C-q-map)
-  (define-key wordstar-mode-map "\C-r" 'scroll-down)
-  (define-key wordstar-mode-map "\C-s" 'backward-char)
-  (define-key wordstar-mode-map "\C-t" 'kill-word)
-  (define-key wordstar-mode-map "\C-u" 'keyboard-quit)
-  (define-key wordstar-mode-map "\C-v" 'overwrite-mode)
-  (define-key wordstar-mode-map "\C-w" 'scroll-down-line)
-  (define-key wordstar-mode-map "\C-x" 'next-line)
-  (define-key wordstar-mode-map "\C-y" 'kill-complete-line)
-  (define-key wordstar-mode-map "\C-z" 'scroll-up-line)
-  
-  ;; wordstar-C-k-map
-  
-  (define-key wordstar-C-k-map " " ())
-  (define-key wordstar-C-k-map "0" 'ws-set-marker-0)
-  (define-key wordstar-C-k-map "1" 'ws-set-marker-1)
-  (define-key wordstar-C-k-map "2" 'ws-set-marker-2)
-  (define-key wordstar-C-k-map "3" 'ws-set-marker-3)
-  (define-key wordstar-C-k-map "4" 'ws-set-marker-4)
-  (define-key wordstar-C-k-map "5" 'ws-set-marker-5)
-  (define-key wordstar-C-k-map "6" 'ws-set-marker-6)
-  (define-key wordstar-C-k-map "7" 'ws-set-marker-7)
-  (define-key wordstar-C-k-map "8" 'ws-set-marker-8)
-  (define-key wordstar-C-k-map "9" 'ws-set-marker-9)
-  (define-key wordstar-C-k-map "b" 'ws-begin-block)
-  (define-key wordstar-C-k-map "\C-b" 'ws-begin-block)
-  (define-key wordstar-C-k-map "c" 'ws-copy-block)
-  (define-key wordstar-C-k-map "\C-c" 'ws-copy-block)
-  (define-key wordstar-C-k-map "d" 'save-buffers-kill-emacs)
-  (define-key wordstar-C-k-map "\C-d" 'save-buffers-kill-emacs)
-  (define-key wordstar-C-k-map "f" 'find-file)
-  (define-key wordstar-C-k-map "\C-f" 'find-file)
-  (define-key wordstar-C-k-map "h" 'ws-show-markers)
-  (define-key wordstar-C-k-map "\C-h" 'ws-show-markers)
-  (define-key wordstar-C-k-map "i" 'ws-indent-block)
-  (define-key wordstar-C-k-map "\C-i" 'ws-indent-block)
-  (define-key wordstar-C-k-map "k" 'ws-end-block)
-  (define-key wordstar-C-k-map "\C-k" 'ws-end-block)
-  (define-key wordstar-C-k-map "p" 'ws-print-block)
-  (define-key wordstar-C-k-map "\C-p" 'ws-print-block)
-  (define-key wordstar-C-k-map "q" 'kill-emacs)
-  (define-key wordstar-C-k-map "\C-q" 'kill-emacs)
-  (define-key wordstar-C-k-map "r" 'insert-file)
-  (define-key wordstar-C-k-map "\C-r" 'insert-file)
-  (define-key wordstar-C-k-map "s" 'save-some-buffers)
-  (define-key wordstar-C-k-map "\C-s" 'save-some-buffers)
-  (define-key wordstar-C-k-map "t" 'ws-mark-word)
-  (define-key wordstar-C-k-map "\C-t" 'ws-mark-word)
-  (define-key wordstar-C-k-map "u" 'ws-exdent-block)
-  (define-key wordstar-C-k-map "\C-u" 'keyboard-quit)
-  (define-key wordstar-C-k-map "v" 'ws-move-block)
-  (define-key wordstar-C-k-map "\C-v" 'ws-move-block)
-  (define-key wordstar-C-k-map "w" 'ws-write-block)
-  (define-key wordstar-C-k-map "\C-w" 'ws-write-block)
-  (define-key wordstar-C-k-map "x" 'save-buffers-kill-emacs)
-  (define-key wordstar-C-k-map "\C-x" 'save-buffers-kill-emacs)
-  (define-key wordstar-C-k-map "y" 'ws-delete-block)
-  (define-key wordstar-C-k-map "\C-y" 'ws-delete-block)
-  
-  ;; wordstar-C-j-map not yet implemented
-  
-  ;; wordstar-C-o-map
-  
-  (define-key wordstar-C-o-map " " ())
-  (define-key wordstar-C-o-map "c" 'wordstar-center-line)
-  (define-key wordstar-C-o-map "\C-c" 'wordstar-center-line)
-  (define-key wordstar-C-o-map "b" 'switch-to-buffer)
-  (define-key wordstar-C-o-map "\C-b" 'switch-to-buffer)
-  (define-key wordstar-C-o-map "j" 'justify-current-line)
-  (define-key wordstar-C-o-map "\C-j" 'justify-current-line)
-  (define-key wordstar-C-o-map "k" 'kill-buffer)
-  (define-key wordstar-C-o-map "\C-k" 'kill-buffer)
-  (define-key wordstar-C-o-map "l" 'list-buffers)
-  (define-key wordstar-C-o-map "\C-l" 'list-buffers)
-  (define-key wordstar-C-o-map "m" 'auto-fill-mode)
-  (define-key wordstar-C-o-map "\C-m" 'auto-fill-mode)
-  (define-key wordstar-C-o-map "r" 'set-fill-column)
-  (define-key wordstar-C-o-map "\C-r" 'set-fill-column)
-  (define-key wordstar-C-o-map "\C-u" 'keyboard-quit)
-  (define-key wordstar-C-o-map "wd" 'delete-other-windows)
-  (define-key wordstar-C-o-map "wh" 'split-window-horizontally)
-  (define-key wordstar-C-o-map "wo" 'other-window)
-  (define-key wordstar-C-o-map "wv" 'split-window-vertically)
-  
-  ;; wordstar-C-q-map
-  (define-key wordstar-C-q-map " " ())
-  (define-key wordstar-C-q-map "0" 'ws-find-marker-0)
-  (define-key wordstar-C-q-map "1" 'ws-find-marker-1)
-  (define-key wordstar-C-q-map "2" 'ws-find-marker-2)
-  (define-key wordstar-C-q-map "3" 'ws-find-marker-3)
-  (define-key wordstar-C-q-map "4" 'ws-find-marker-4)
-  (define-key wordstar-C-q-map "5" 'ws-find-marker-5)
-  (define-key wordstar-C-q-map "6" 'ws-find-marker-6)
-  (define-key wordstar-C-q-map "7" 'ws-find-marker-7)
-  (define-key wordstar-C-q-map "8" 'ws-find-marker-8)
-  (define-key wordstar-C-q-map "9" 'ws-find-marker-9)
-  (define-key wordstar-C-q-map "a" 'ws-query-replace)
-  (define-key wordstar-C-q-map "\C-a" 'ws-query-replace)
-  (define-key wordstar-C-q-map "b" 'ws-goto-block-begin)
-  (define-key wordstar-C-q-map "\C-b" 'ws-goto-block-begin)
-  (define-key wordstar-C-q-map "c" 'end-of-buffer)
-  (define-key wordstar-C-q-map "\C-c" 'end-of-buffer)
-  (define-key wordstar-C-q-map "d" 'end-of-line)
-  (define-key wordstar-C-q-map "\C-d" 'end-of-line)
-  (define-key wordstar-C-q-map "f" 'ws-search)
-  (define-key wordstar-C-q-map "\C-f" 'ws-search)
-  (define-key wordstar-C-q-map "k" 'ws-goto-block-end)
-  (define-key wordstar-C-q-map "\C-k" 'ws-goto-block-end)
-  (define-key wordstar-C-q-map "l" 'ws-undo)
-  (define-key wordstar-C-q-map "\C-l" 'ws-undo)
-  (define-key wordstar-C-q-map "p" 'ws-last-cursorp)
-  (define-key wordstar-C-q-map "\C-p" 'ws-last-cursorp)
-  (define-key wordstar-C-q-map "r" 'beginning-of-buffer)
-  (define-key wordstar-C-q-map "\C-r" 'beginning-of-buffer)
-  (define-key wordstar-C-q-map "s" 'beginning-of-line)
-  (define-key wordstar-C-q-map "\C-s" 'beginning-of-line)
-  (define-key wordstar-C-q-map "\C-u" 'keyboard-quit)
-  (define-key wordstar-C-q-map "w" 'ws-last-error)
-  (define-key wordstar-C-q-map "\C-w" 'ws-last-error)
-  (define-key wordstar-C-q-map "y" 'ws-kill-eol)
-  (define-key wordstar-C-q-map "\C-y" 'ws-kill-eol)
-  (define-key wordstar-C-q-map "\177" 'ws-kill-bol))
-
-;;;###autoload
-(defun wordstar-mode ()
-  "Major mode with WordStar-like key bindings.
-
-BUGS:
- - Help menus with WordStar commands (C-j just calls help-for-help)
-   are not implemented
- - Options for search and replace
- - Show markers (C-k h) is somewhat strange
- - Search and replace (C-q a) is only available in forward direction
-
-No key bindings beginning with ESC are installed, they will work
-Emacs-like.
-
-The key bindings are:
-
-  C-a		backward-word
-  C-b		fill-paragraph
-  C-c		scroll-up-line
-  C-d		forward-char
-  C-e		previous-line
-  C-f		forward-word
-  C-g		delete-char
-  C-h		backward-char
-  C-i		indent-for-tab-command
-  C-j		help-for-help
-  C-k		wordstar-C-k-map
-  C-l		ws-repeat-search
-  C-n		open-line
-  C-p		quoted-insert
-  C-r		scroll-down-line
-  C-s		backward-char
-  C-t		kill-word
-  C-u		keyboard-quit
-  C-v		overwrite-mode
-  C-w		scroll-down
-  C-x		next-line
-  C-y		kill-complete-line
-  C-z		scroll-up
-
-  C-k 0		ws-set-marker-0
-  C-k 1		ws-set-marker-1
-  C-k 2		ws-set-marker-2
-  C-k 3		ws-set-marker-3
-  C-k 4		ws-set-marker-4
-  C-k 5		ws-set-marker-5
-  C-k 6		ws-set-marker-6
-  C-k 7		ws-set-marker-7
-  C-k 8		ws-set-marker-8
-  C-k 9		ws-set-marker-9
-  C-k b		ws-begin-block
-  C-k c		ws-copy-block
-  C-k d		save-buffers-kill-emacs
-  C-k f		find-file
-  C-k h		ws-show-markers
-  C-k i		ws-indent-block
-  C-k k		ws-end-block
-  C-k p		ws-print-block
-  C-k q		kill-emacs
-  C-k r		insert-file
-  C-k s		save-some-buffers
-  C-k t		ws-mark-word
-  C-k u		ws-exdent-block
-  C-k C-u	keyboard-quit
-  C-k v		ws-move-block
-  C-k w		ws-write-block
-  C-k x		kill-emacs
-  C-k y		ws-delete-block
-
-  C-o c		wordstar-center-line
-  C-o b		switch-to-buffer
-  C-o j		justify-current-line
-  C-o k		kill-buffer
-  C-o l		list-buffers
-  C-o m		auto-fill-mode
-  C-o r		set-fill-column
-  C-o C-u	keyboard-quit
-  C-o wd	delete-other-windows
-  C-o wh	split-window-horizontally
-  C-o wo	other-window
-  C-o wv	split-window-vertically
-
-  C-q 0		ws-find-marker-0
-  C-q 1		ws-find-marker-1
-  C-q 2		ws-find-marker-2
-  C-q 3		ws-find-marker-3
-  C-q 4		ws-find-marker-4
-  C-q 5		ws-find-marker-5
-  C-q 6		ws-find-marker-6
-  C-q 7		ws-find-marker-7
-  C-q 8		ws-find-marker-8
-  C-q 9		ws-find-marker-9
-  C-q a		ws-query-replace
-  C-q b		ws-to-block-begin
-  C-q c		end-of-buffer
-  C-q d		end-of-line
-  C-q f		ws-search
-  C-q k		ws-to-block-end
-  C-q l		ws-undo
-  C-q p		ws-last-cursorp
-  C-q r		beginning-of-buffer
-  C-q C-u	keyboard-quit
-  C-q w		ws-last-error
-  C-q y		ws-kill-eol
-  C-q DEL	ws-kill-bol
-"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map wordstar-mode-map)
-  (setq mode-name "WordStar")
-  (setq major-mode 'wordstar-mode))
-
-
-(defun wordstar-center-paragraph ()
-  "Center each line in the paragraph at or after point.
-See `wordstar-center-line' for more info."
-  (interactive)
-  (save-excursion
-    (forward-paragraph)
-    (or (bolp) (newline 1))
-    (let ((end (point)))
-      (backward-paragraph)
-      (wordstar-center-region (point) end))))
-
-(defun wordstar-center-region (from to)
-  "Center each line starting in the region.
-See `wordstar-center-line' for more info."
-  (interactive "r")
-  (if (> from to)
-      (let ((tem to))
-	(setq to from from tem)))
-  (save-excursion
-    (save-restriction
-      (narrow-to-region from to)
-      (goto-char from)
-      (while (not (eobp))
-	(wordstar-center-line)
-	(forward-line 1)))))
-
-(defun wordstar-center-line ()
-  "Center the line point is on, within the width specified by `fill-column'.
-This means adjusting the indentation to match
-the distance between the end of the text and `fill-column'."
-  (interactive)
-  (save-excursion
-    (let (line-length)
-      (beginning-of-line)
-      (delete-horizontal-space)
-      (end-of-line)
-      (delete-horizontal-space)
-      (setq line-length (current-column))
-      (beginning-of-line)
-      (indent-to 
-       (+ left-margin 
-	  (/ (- fill-column left-margin line-length) 2))))))
-
-(defun scroll-down-line ()
-  "Scroll one line down."
-  (interactive)
-  (scroll-down 1))
-
-(defun scroll-up-line ()
-  "Scroll one line up."
-  (interactive)
-  (scroll-up 1))
-
-;;;;;;;;;;;
-;; wordstar special variables:
-
-(defvar ws-marker-0 nil "Position marker 0 in WordStar mode.")
-(defvar ws-marker-1 nil "Position marker 1 in WordStar mode.")
-(defvar ws-marker-2 nil "Position marker 2 in WordStar mode.")
-(defvar ws-marker-3 nil "Position marker 3 in WordStar mode.")
-(defvar ws-marker-4 nil "Position marker 4 in WordStar mode.")
-(defvar ws-marker-5 nil "Position marker 5 in WordStar mode.")
-(defvar ws-marker-6 nil "Position marker 6 in WordStar mode.")
-(defvar ws-marker-7 nil "Position marker 7 in WordStar mode.")
-(defvar ws-marker-8 nil "Position marker 8 in WordStar mode.")
-(defvar ws-marker-9 nil "Position marker 9 in WordStar mode.")
-
-(defvar ws-block-begin-marker nil "Beginning of \"Block\" in WordStar mode.")
-(defvar ws-block-end-marker nil "End of \"Block\" in WordStar mode.")
-
-(defvar ws-search-string nil "String of last search in WordStar mode.")
-(defvar ws-search-direction t 
-  "Direction of last search in WordStar mode. T if forward, NIL if backward.")
-
-(defvar ws-last-cursorposition nil 
-  "Position before last search etc. in WordStar mode.")
-
-(defvar ws-last-errormessage nil 
-  "Last error message issued by a WordStar mode function.")
-
-;;;;;;;;;;;
-;; wordstar special functions:
-
-(defun ws-error (string)
-  "Report error of a WordStar special function. Error message is saved
-in ws-last-errormessage for recovery with C-q w."
-  (setq ws-last-errormessage string)
-  (error string))
-
-(defun ws-set-marker-0 ()
-  "In WordStar mode: Set marker 0 to current cursor position."
-  (interactive)
-  (setq ws-marker-0 (point-marker))
-  (message "Marker 0 set"))
-
-(defun ws-set-marker-1 ()
-  "In WordStar mode: Set marker 1 to current cursor position."
-  (interactive)
-  (setq ws-marker-1 (point-marker))
-  (message "Marker 1 set"))
-
-(defun ws-set-marker-2 ()
-  "In WordStar mode: Set marker 2 to current cursor position."
-  (interactive)
-  (setq ws-marker-2 (point-marker))
-  (message "Marker 2 set"))
-
-(defun ws-set-marker-3 ()
-  "In WordStar mode: Set marker 3 to current cursor position."
-  (interactive)
-  (setq ws-marker-3 (point-marker))
-  (message "Marker 3 set"))
-
-(defun ws-set-marker-4 ()
-  "In WordStar mode: Set marker 4 to current cursor position."
-  (interactive)
-  (setq ws-marker-4 (point-marker))
-  (message "Marker 4 set"))
-
-(defun ws-set-marker-5 ()
-  "In WordStar mode: Set marker 5 to current cursor position."
-  (interactive)
-  (setq ws-marker-5 (point-marker))
-  (message "Marker 5 set"))
-
-(defun ws-set-marker-6 ()
-  "In WordStar mode: Set marker 6 to current cursor position."
-  (interactive)
-  (setq ws-marker-6 (point-marker))
-  (message "Marker 6 set"))
-
-(defun ws-set-marker-7 ()
-  "In WordStar mode: Set marker 7 to current cursor position."
-  (interactive)
-  (setq ws-marker-7 (point-marker))
-  (message "Marker 7 set"))
-
-(defun ws-set-marker-8 ()
-  "In WordStar mode: Set marker 8 to current cursor position."
-  (interactive)
-  (setq ws-marker-8 (point-marker))
-  (message "Marker 8 set"))
-
-(defun ws-set-marker-9 ()
-  "In WordStar mode: Set marker 9 to current cursor position."
-  (interactive)
-  (setq ws-marker-9 (point-marker))
-  (message "Marker 9 set"))
-
-(defun ws-begin-block ()
-  "In WordStar mode: Set block begin marker to current cursor position."
-  (interactive)
-  (setq ws-block-begin-marker (point-marker))
-  (message "Block begin marker set"))
-
-(defun ws-show-markers ()
-  "In WordStar mode: Show block markers."
-  (interactive)
-  (if (or ws-block-begin-marker ws-block-end-marker)
-      (save-excursion
-	(if ws-block-begin-marker
-	    (let ()
-	      (goto-char ws-block-begin-marker)
-	      (message "Block begin marker")
-	      (sit-for 2))
-	  (message "Block begin marker not set")
-	  (sit-for 2))
-	(if ws-block-end-marker
-	    (let ()
-	      (goto-char ws-block-end-marker)
-	      (message "Block end marker")
-	      (sit-for 2))
-	  (message "Block end marker not set"))
-	(message ""))
-    (message "Block markers not set")))
-
-
-(defun ws-indent-block ()
-  "In WordStar mode: Indent block (not yet implemented)."
-  (interactive)
-  (ws-error "Indent block not yet implemented"))
-
-(defun ws-end-block ()
-  "In WordStar mode: Set block end marker to current cursor position."
-  (interactive)
-  (setq ws-block-end-marker (point-marker))
-  (message "Block end marker set"))
-
-(defun ws-print-block ()
-  "In WordStar mode: Print block."
-  (interactive)
-  (message "Don't do this. Write block to a file (C-k w) and print this file."))
-
-(defun ws-mark-word ()
-  "In WordStar mode: Mark current word as block."
-  (interactive)
-  (save-excursion
-    (forward-word 1)
-    (sit-for 1)
-    (ws-end-block)
-    (forward-word -1)
-    (sit-for 1)
-    (ws-begin-block)))
-
-(defun ws-exdent-block ()
-  "I don't know what this (C-k u) should do."
-  (interactive)
-  (ws-error "This won't be done -- not yet implemented."))
-
-(defun ws-move-block ()
-  "In WordStar mode: Move block to current cursor position."
-  (interactive)
-  (if (and ws-block-begin-marker ws-block-end-marker)
-      (let ()
-	;; XEmacs
-	(kill-region ws-block-begin-marker ws-block-end-marker 'silent)
-	(yank)
-	(save-excursion
-	  (goto-char (region-beginning))
-	  (setq ws-block-begin-marker (point-marker))
-	  (goto-char (region-end))
-	  (setq ws-block-end-marker (point-marker))))
-    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
-		    (ws-block-end-marker "Block begin marker not set")
-		    (t "Block markers not set")))))
-
-(defun ws-write-block ()
-  "In WordStar mode: Write block to file."
-  (interactive)
-  (if (and ws-block-begin-marker ws-block-end-marker)
-      (let ((filename (read-file-name "Write block to file: ")))
-	(write-region ws-block-begin-marker ws-block-end-marker filename))
-    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
-		    (ws-block-end-marker "Block begin marker not set")
-		    (t "Block markers not set")))))
-
-
-(defun ws-delete-block ()
-  "In WordStar mode: Delete block."
-  (interactive)
-  (if (and ws-block-begin-marker ws-block-end-marker)
-      (let ()
-	(kill-region ws-block-begin-marker ws-block-end-marker)
-	(setq ws-block-end-marker nil)
-	(setq ws-block-begin-marker nil))
-    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
-		    (ws-block-end-marker "Block begin marker not set")
-		    (t "Block markers not set")))))
-
-(defun ws-find-marker-0 ()
-  "In WordStar mode: Go to marker 0."
-  (interactive)
-  (if ws-marker-0
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-0))
-    (ws-error "Marker 0 not set")))
-
-(defun ws-find-marker-1 ()
-  "In WordStar mode: Go to marker 1."
-  (interactive)
-  (if ws-marker-1
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-1))
-    (ws-error "Marker 1 not set")))
-
-(defun ws-find-marker-2 ()
-  "In WordStar mode: Go to marker 2."
-  (interactive)
-  (if ws-marker-2
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-2))
-    (ws-error "Marker 2 not set")))
-
-(defun ws-find-marker-3 ()
-  "In WordStar mode: Go to marker 3."
-  (interactive)
-  (if ws-marker-3
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-3))
-    (ws-error "Marker 3 not set")))
-
-(defun ws-find-marker-4 ()
-  "In WordStar mode: Go to marker 4."
-  (interactive)
-  (if ws-marker-4
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-4))
-    (ws-error "Marker 4 not set")))
-
-(defun ws-find-marker-5 ()
-  "In WordStar mode: Go to marker 5."
-  (interactive)
-  (if ws-marker-5
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-5))
-    (ws-error "Marker 5 not set")))
-
-(defun ws-find-marker-6 ()
-  "In WordStar mode: Go to marker 6."
-  (interactive)
-  (if ws-marker-6
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-6))
-    (ws-error "Marker 6 not set")))
-
-(defun ws-find-marker-7 ()
-  "In WordStar mode: Go to marker 7."
-  (interactive)
-  (if ws-marker-7
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-7))
-    (ws-error "Marker 7 not set")))
-
-(defun ws-find-marker-8 ()
-  "In WordStar mode: Go to marker 8."
-  (interactive)
-  (if ws-marker-8
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-8))
-    (ws-error "Marker 8 not set")))
-
-(defun ws-find-marker-9 ()
-  "In WordStar mode: Go to marker 9."
-  (interactive)
-  (if ws-marker-9
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-9))
-    (ws-error "Marker 9 not set")))
-
-(defun ws-goto-block-begin ()
-  "In WordStar mode: Go to block begin marker."
-  (interactive)
-  (if ws-block-begin-marker
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-block-begin-marker))
-    (ws-error "Block begin marker not set")))
-
-(defun ws-search (string)
-  "In WordStar mode: Search string, remember string for repetition."
-  (interactive "sSearch for: ")
-  (message "Forward (f) or backward (b)")
-  (let ((direction
-	 (read-char)))
-    (cond ((equal (upcase direction) ?\F)
-	   (setq ws-search-string string)
-	   (setq ws-search-direction t)
-	   (setq ws-last-cursorposition (point-marker))
-	   (search-forward string))
-	  ((equal (upcase direction) ?\B)
-	   (setq ws-search-string string)
-	   (setq ws-search-direction nil)
-	   (setq ws-last-cursorposition (point-marker))
-	   (search-backward string))
-	  (t (keyboard-quit)))))
-
-(defun ws-goto-block-end ()
-  "In WordStar mode: Go to block end marker."
-  (interactive)
-  (if ws-block-end-marker
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-block-end-marker))
-    (ws-error "Block end marker not set")))
-
-(defun ws-undo ()
-  "In WordStar mode: Undo and give message about undoing more changes."
-  (interactive)
-  (undo)
-  (message "Repeat C-q l to undo more changes."))
-
-(defun ws-goto-last-cursorposition ()
-  "In WordStar mode: "
-  (interactive)
-  (if ws-last-cursorposition
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-last-cursorposition))
-    (ws-error "No last cursor position available.")))
-
-(defun ws-last-error ()
-  "In WordStar mode: repeat last error message.
-This will only work for errors raised by WordStar mode functions."
-  (interactive)
-  (if ws-last-errormessage
-      (message ws-last-errormessage)
-    (message "No WordStar error yet.")))
-
-(defun ws-kill-eol ()
-  "In WordStar mode: Kill to end of line (like WordStar, not like Emacs)."
-  (interactive)
-  (let ((p (point)))
-    (end-of-line)
-    (kill-region p (point))))
-
-(defun ws-kill-bol ()
-  "In WordStar mode: Kill to beginning of line 
-\(like WordStar, not like Emacs)."
-  (interactive)
-  (let ((p (point)))
-    (beginning-of-line)
-    (kill-region (point) p)))
-
-(defun kill-complete-line ()
-  "Kill the complete line."
-  (interactive)
-  (beginning-of-line)
-  (if (eobp) (error "End of buffer"))
-  (let ((beg (point)))
-    (forward-line 1)
-    (kill-region beg (point))))
-
-(defun ws-repeat-search ()
-  "In WordStar mode: Repeat last search."
-  (interactive)
-  (setq ws-last-cursorposition (point-marker))
-  (if ws-search-string
-      (if ws-search-direction
-	  (search-forward ws-search-string)
-	(search-backward ws-search-string))
-    (ws-error "No search to repeat")))
-
-(defun ws-query-replace (from to)
-  "In WordStar mode: Search string, remember string for repetition."
-  (interactive "sReplace: 
-sWith: " )
-  (setq ws-search-string from)
-  (setq ws-search-direction t)
-  (setq ws-last-cursorposition (point-marker))
-  (query-replace from to))
-
-(defun ws-copy-block ()
-  "In WordStar mode: Copy block to current cursor position."
-  (interactive)
-  (if (and ws-block-begin-marker ws-block-end-marker)
-      (let ()
-	(copy-region-as-kill ws-block-begin-marker ws-block-end-marker)
-	(yank)
-	(save-excursion
-	  (goto-char (region-beginning))
-	  (setq ws-block-begin-marker (point-marker))
-	  (goto-char (region-end))
-	  (setq ws-block-end-marker (point-marker))))
-    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
-		    (ws-block-end-marker "Block begin marker not set")
-		    (t "Block markers not set")))))
-
-;;; ws-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/xpm-mode.el b/xemacs-packages/lisp/text-modes/xpm-mode.el
deleted file mode 100644
index 8a027c3a..00000000
--- a/xemacs-packages/lisp/text-modes/xpm-mode.el
+++ /dev/null
@@ -1,464 +0,0 @@
-;;; xpm-mode.el	--- minor mode for editing XPM files
-
-;; Copyright (C) 1995 Joe Rumsey 
-;; Copyright (C) 1995 Rich Williams 
-
-;; Authors: Joe Rumsey 
-;;	    Rich Williams 
-;; Cleanup: Chuck Thompson 
-
-;; Version:  1.5
-;; Last Modified: Rich Williams , 13 July 1995
-;; Keywords: data tools
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;
-;; xpm mode:  Display xpm files in color
-;;
-;; thanks to Rich Williams for mods to do this without font-lock-mode,
-;; resulting in much improved performance and a better display
-;; (headers don't get colored strangely). Also for the palette toolbar.
-;;
-;; Non-standard minor mode in that it starts picture-mode automatically.
-;;
-;; To get this turned on automatically for .xpms, add an entry
-;;       ("\\.xpm" . xpm-mode)
-;; to your auto-mode-alist.  For example, my .emacs has this: (abbreviated)
-;; (setq auto-mode-alist (mapcar 'purecopy
-;;                               '(("\\.c$" . c-mode)
-;;                                ("\\.h$" . c-mode)
-;;                                ("\\.el$" . emacs-lisp-mode)
-;;				  ("\\.emacs$" . emacs-lisp-mode)
-;;                                ("\\.a$" . c-mode)
-;;				  ("\\.xpm" . xpm-mode))))
-;; (autoload 'xpm-mode "xpm-mode")
-;;
-;; I am a lisp newbie, practically everything in here I had to look up
-;; in the manual.  It probably shows, suggestions for coding
-;; improvements are welcomed.
-;;
-;; May fail on some xpm's.  Seems to be fine with files generated by
-;; xpaint and ppmtoxpm anyway.  Will definitely fail on xpm's with
-;; more than one character per pixel.  Not that hard to fix, but I've
-;; never seen one like that.
-;;
-;; If your default font is proportional, this will not be very useful.
-;;
-
-(require 'annotations)
-
-(defvar xpm-pixel-values nil)
-(defvar xpm-glyph nil)
-(defvar xpm-anno nil)
-(defvar xpm-paint-string nil)
-(defvar xpm-chars-per-pixel 1)
-(defvar xpm-palette nil)
-(defvar xpm-always-update-image nil
-  "If non-nil, update actual-size image after every click or drag movement.
-Otherwise, only update on button releases or when asked to.  This is slow.")
-
-(make-variable-buffer-local 'xpm-palette)
-(make-variable-buffer-local 'xpm-chars-per-pixel)
-(make-variable-buffer-local 'xpm-paint-string)
-(make-variable-buffer-local 'xpm-glyph)
-(make-variable-buffer-local 'xpm-anno)
-(make-variable-buffer-local 'xpm-pixel-values)
-;(make-variable-buffer-local 'xpm-faces-used)
-
-(defun xpm-make-face (name)
-  "Makes a face with name xpm-NAME, and colour NAME."
-  (let ((face (make-face (intern (concat "xpm-" name))
-			 "Temporary xpm-mode face" t)))
-    (set-face-background face name)
-    (set-face-foreground face "black")
-    face))
-
-(defun xpm-init ()
-  "Treat the current buffer as an xpm file and colorize it."
-  (interactive)
-  (require 'picture)
-
-  (setq xpm-pixel-values nil)
-  (xpm-clear-extents)
-  (setq xpm-palette nil)
-
-  (message "Finding number of colors...")
-  (save-excursion
-    (goto-char (point-min))
-    (beginning-of-line)
-    (next-line 1)
-    (while (and (not (eobp)) (not (looking-at "\\s-*\"")))
-      (next-line 1))
-    (next-line 1)
-    (while (and (not (eobp)) (not (looking-at "\\s-*\"")))
-      (next-line 1))
-
-    (save-excursion
-      (goto-char (point-min))
-      (if (re-search-forward 
-	   "\"\\s-*\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-*"
-	   (point-max) t)
-	  (setq xpm-chars-per-pixel (string-to-int (match-string 4)))))
-
-    (let ((co 0))
-      (while (< co (xpm-num-colors))
-	(progn
-	  (xpm-parse-color)
-	  (setq co (1+ co))
-	  (next-line 1)
-	  (beginning-of-line)))))
-  (if (not (eq major-mode 'picture-mode))
-      (picture-mode))
-  (if (featurep 'toolbar)
-      (progn
-	;; Use `current-buffer', not `selected-frame', here.
-	;; Fixes bug where switching to another buffer causes its
-	;; full-width left toolbar to be truncated to the xpm-mode
-	;; palette (16 pixels).  Causes "window bounce" if sharing a
-	;; frame with a window displaying a buffer with a full-width
-	;; toolbar (suggested workaround: don't reset toolbar width
-	;; for palette).
-	(set-specifier left-toolbar-width (cons (current-buffer) 16))
-	(set-specifier left-toolbar (cons (current-buffer) xpm-palette))))
-  (message "Parsing body...")
-  (xpm-color-data)
-  (message "Parsing body...done")
-  (xpm-show-image))
-
-(defun xpm-clear-extents ()
-  (let (cur-extent
-	next-extent)
-    (setq cur-extent (next-extent (current-buffer)))
-    (setq next-extent (next-extent cur-extent))
-    (while cur-extent
-      (delete-extent cur-extent)
-      (setq cur-extent next-extent)
-      (setq next-extent (next-extent cur-extent)))))
-
-(defun xpm-color-data ()
-  (interactive)
-  (save-excursion
-    (xpm-goto-body-line 0)
-    (let (ext
-	  pixel-chars
-	  pixel-color)
-      (while (and (< (point) (point-max))
-		  (< (+ (point) xpm-chars-per-pixel) (point-max)))
-	(setq pixel-chars
-	      (buffer-substring (point) (+ (point) xpm-chars-per-pixel))
-	      pixel-color (assoc pixel-chars xpm-pixel-values)
-	      ext (make-extent (point) (+ (point) xpm-chars-per-pixel)))
-	(if pixel-color
-	    (progn
-	      (set-extent-face ext (cdr pixel-color)))
-	  (set-extent-face ext 'default))
-	(forward-char xpm-chars-per-pixel)))))
-
-(defun xpm-num-colors ()
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward 
-	 "\"\\s-*\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-*"
-	 (point-max) t)
-	(string-to-int (match-string 3))
-      (error "Unable to parse xpm information"))))
-
-(defun xpm-make-solid-pixmap (colour width height)
-  (let ((x 0)
-	(y 0)
-	(line nil)
-	(total nil))
-    (setq line ",\n\"")
-    (while (< x width)
-      (setq line (concat line ".")
-	    x (+ x 1)))
-    (setq line (concat line "\"")
-	  total (format "/* XPM */\nstatic char * %s[] = {\n\"%d %d 1 1\",\n\". c %s\""
-			colour width height colour))
-    (while (< y height)
-      (setq total (concat total line)
-	    y (+ y 1)))
-    (make-glyph (concat total "};\n"))))
-
-(defun xpm-store-color (str color)
-  "Add STR to xpm-pixel-values with a new face set to background COLOR
-if STR already has an entry, the existing face will be used, with the
-new color replacing the old (on the display only, not in the xpm color
-defs!)"
-  (let (new-face)
-    (setq new-face (xpm-make-face color))
-    (set-face-background new-face color)
-    (let ((ccc (color-rgb-components (make-color-specifier color))))
-      (if (> (length ccc) 0)
-	  (if (or (or (> (elt ccc 0) 32767)
-		      (> (elt ccc 1) 32767))
-		  (> (elt ccc 2) 32767))
-	      (set-face-foreground new-face "black")
-	    (set-face-foreground new-face "white"))))
-    (setq xpm-pixel-values (cons (cons str new-face) xpm-pixel-values))
-    (if (featurep 'toolbar)
-	(setq xpm-palette
-	      (cons (vector 
-		     (list (xpm-make-solid-pixmap color 12 12))
-		     ;; Major cool things with quotes.....
-		     (` 
-		      (lambda (event)
-			(interactive "e")
-			(xpm-toolbar-select-colour event (, str))))
-		     t
-		     color) xpm-palette)))
-    ))
-
-(defun xpm-parse-color ()
-  "Parse xpm color string from current line and set the color"
-  (interactive)
-  (let (end)
-    (save-excursion
-      (end-of-line)
-      (setq end (point))
-      (beginning-of-line)
-      (if (re-search-forward
-	   ;; Generate a regexp on the fly
-	   (concat "\"\\(" (make-string xpm-chars-per-pixel ?.) "\\)" ; chars
-		   "\\(\\s-+[sm]\\s-+\\S-*\\)*"   ; s and m classes
-		   "\\s-+\\([c]\\)"	          ; c class
-		   "\\s-+\\([^ \t\"]+\\)")
-	   end t)
-	  (progn 
-	    (xpm-store-color (match-string 1) (match-string 4))
-	    (list (match-string 1) (match-string 4)))
-	(error "Unable to parse color")))))
-
-(defun xpm-add-color (str color)
-  "add a color to an xpm's list of color defs"
-  (interactive "sPixel character: 
-sPixel color (any valid X color string):")
-  (save-excursion
-    (goto-char (point-min))
-    (while (not (looking-at "\\s-*\""))
-      (next-line 1))
-    (next-line 1)
-    (while (not (looking-at "\\s-*\""))
-      (next-line 1))
-    (let ((co 0))
-      (while (< co (xpm-num-colors))
-	(next-line 1)
-	(setq co (1+ co))))
-    (insert (format "\"%s\tc %s\",\n" str color))
-    (previous-line 1)
-    (xpm-parse-color)
-
-    (goto-char (point-min))
-    (while (not (looking-at "\\s-*\""))
-      (next-line 1))
-    (let ((entry 0))
-      (while (or (= (char-after (point)) ? ) (= (char-after (point)) ?\"))
-	(forward-char 1))
-      (while (< entry 2)
-	(progn
-	  (if (eq (char-after (point)) ? )
-	      (progn
-		(setq entry (1+ entry))
-		(while (eq (char-after (point)) ? )
-		  (forward-char 1)))
-	    (forward-char 1))))
-      (let ((old-colors (xpm-num-colors)))
-	(while (and (>= (char-after (point)) ?0) (<= (char-after (point)) ?9))
-	  (delete-char 1))
-      (insert (int-to-string (1+ old-colors)))))))
-
-
-(defun xpm-goto-color-def (def)
-  "move to color DEF in the xpm header"
-  (interactive "nColor number:")
-  (goto-char (point-min))
-  (while (not (looking-at "\\s-*\""))
-    (next-line 1))
-  (next-line 1)
-  (while (not (looking-at "\\s-*\""))
-    (next-line 1))
-  (next-line def))
-
-(defun xpm-goto-body-line (line)
-  "move to LINE lines down from the start of the body of an xpm"
-  (interactive "nBody line:")
-  (goto-char (point-min))
-  (xpm-goto-color-def (xpm-num-colors))
-  (next-line line))
-
-(defun xpm-show-image ()
-  "Display the xpm in the current buffer at the end of the topmost line"
-  (interactive)
-  (save-excursion
-    (if (annotationp xpm-anno)
-	(delete-annotation xpm-anno))
-    (setq xpm-glyph (make-glyph 
-		     (vector 'xpm :data 
-			     (buffer-substring (point-min) (point-max)))))
-    (goto-char (point-min))
-    (end-of-line)
-    (setq xpm-anno (make-annotation xpm-glyph (point) 'text))))
-
-(defun xpm-hide-image ()
-  "Remove the image of the xpm from the buffer"
-  (interactive)
-  (if (annotationp xpm-anno)
-      (delete-annotation xpm-anno)))
-
-(defun xpm-in-body ()
-  (let ((p (point)))
-    (save-excursion
-      (xpm-goto-body-line 0)
-      (> p (point)))))
-
-(defvar xpm-mode nil)
-(make-variable-buffer-local 'xpm-mode)
-(add-minor-mode 'xpm-mode " XPM" nil)
-(defvar xpm-mode-map (make-keymap))
-
-(defun xpm-toolbar-select-colour (event chars)
-  "Toolbar button"
-  (let* ((button (event-toolbar-button event))
-	 (help (and button (toolbar-button-help-string button))))
-    (message "Toolbar selected %s (%s)"  help chars)
-    (setq xpm-palette
-	  (mapcar #'(lambda (but)
-		      (aset but 2 (not (eq help (aref but 3))))
-		      but)
-		  xpm-palette)
-	  xpm-paint-string chars)
-    (set-specifier left-toolbar (cons (current-buffer) xpm-palette))))
-
-(defun xpm-mouse-paint (event)
-  (interactive "e")
-  (mouse-set-point event)
-  (if (xpm-in-body)
-      ;; in body, overwrite the paint string where the mouse is clicked
-      (progn
-	(insert xpm-paint-string)
-	(delete-char (length xpm-paint-string)))
-    ;; otherwise, select the color defined by the line where the mouse
-    ;; was clicked
-    (save-excursion
-      (beginning-of-line)
-      (forward-char 1)
-      (setq xpm-paint-string (buffer-substring (point) (1+ (point)))))))
-
-(defun xpm-mouse-down (event n)
-;  (interactive "ep")
-  (mouse-set-point event)
-  (if (xpm-in-body)
-      ;; in body, overwrite the paint string where the mouse is clicked
-      (progn
-	(insert xpm-paint-string)
-	(delete-char (length xpm-paint-string))
-	(if xpm-always-update-image
-	    (xpm-show-image))
-	(let ((ext (make-extent (1- (point))
-				(+ (1- (point)) xpm-chars-per-pixel)))
-	      (pixel-color (assoc xpm-paint-string xpm-pixel-values)))
-	  (if pixel-color
-	      (set-extent-face ext (cdr pixel-color))
-	    (set-extent-face ext 'default))))
-    ;; otherwise, select the color defined by the line where the mouse
-    ;; was clicked
-    (save-excursion
-      (beginning-of-line)
-      (forward-char 1)
-      (setq xpm-paint-string (buffer-substring (point) (1+ (point)))))))
-
-(defun xpm-mouse-drag (event n timeout)
-  (or timeout
-      (progn
-	(mouse-set-point event)
-	(if (xpm-in-body)
-	    ;; Much improved by not using font-lock-mode
-	    (or (string= xpm-paint-string
-			 (buffer-substring (point)
-					   (+ (length xpm-paint-string)
-					      (point))))
-		(progn
-		  (insert-char (string-to-char xpm-paint-string) 1)
-					;	  (insert xpm-paint-string)
-		  (delete-char (length xpm-paint-string))
-		  (if xpm-always-update-image
-		      (xpm-show-image))
-		  (let ((ext (make-extent
-			      (1- (point))
-			      (+ (1- (point)) xpm-chars-per-pixel)))
-			(pixel-color
-			 (assoc xpm-paint-string xpm-pixel-values)))
-		    (if pixel-color
-			(set-extent-face ext (cdr pixel-color))
-		      (set-extent-face ext 'default)))))))))
-
-(defun xpm-mouse-up (event n)
-  (xpm-show-image))
-
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.xpm$" . xpm-mode))
-
-;;;###autoload
-(defun xpm-mode (&optional arg)
-  "Treat the current buffer as an xpm file and colorize it.
-
-  Shift-button-1 lets you paint by dragging the mouse.  Shift-button-1 on a
-color definition line will change the current painting color to that line's
-value.
-
-  Characters inserted from the keyboard will NOT be colored properly yet.
-Use the mouse, or do xpm-init (\\[xpm-init]) after making changes.
-
-\\[xpm-add-color] Add a new color, prompting for character and value
-\\[xpm-show-image] show the current image at the top of the buffer
-\\[xpm-parse-color] parse the current line's color definition and add
-   it to the color table.  Provided as a means of changing colors.
-XPM minor mode bindings:
-\\{xpm-mode-map}"
-
-  (interactive "P")
-  (setq xpm-mode
-	(if (null arg) (not xpm-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (if xpm-mode
-      (progn
-	(xpm-init)
-	(make-local-variable 'mouse-track-down-hook)
-	(make-local-variable 'mouse-track-drag-hook)
-	(make-local-variable 'mouse-track-up-hook)
-	(make-local-variable 'mouse-track-drag-up-hook)
-	(make-local-variable 'mouse-track-click-hook)
-	(setq mouse-track-down-hook 'xpm-mouse-down)
-	(setq mouse-track-drag-hook 'xpm-mouse-drag)
-	(setq mouse-track-up-hook 'xpm-mouse-up)
-	(setq mouse-track-drag-up-hook 'xpm-mouse-up)
-	(setq mouse-track-click-hook nil)
-	(or (assq 'xpm-mode minor-mode-map-alist)
-	    (progn
-	      (define-key xpm-mode-map [(control c) r] 'xpm-show-image)
-	      (define-key xpm-mode-map [(shift button1)] 'mouse-track)
-	      (define-key xpm-mode-map [button1] 'mouse-track-default)
-	      (define-key xpm-mode-map [(control c) c] 'xpm-add-color)
-	      (define-key xpm-mode-map [(control c) p] 'xpm-parse-color)
-	      (setq minor-mode-map-alist (cons (cons 'xpm-mode xpm-mode-map)
-					       minor-mode-map-alist)))))))
-
-(provide 'xpm-mode)
-;;; xpm-mode.el ends here
diff --git a/xemacs-packages/lisp/text-modes/xrdb-mode.el b/xemacs-packages/lisp/text-modes/xrdb-mode.el
deleted file mode 100644
index 045745c8..00000000
--- a/xemacs-packages/lisp/text-modes/xrdb-mode.el
+++ /dev/null
@@ -1,583 +0,0 @@
-;;; xrdb-mode.el --- mode for editing X resource database files
-
-;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
-
-;; Author:        1994-2000 Barry A. Warsaw
-;; Maintainer:    tools-help@python.org
-;; Created:       May 1994
-;; Keywords:      data languages
-
-(defconst xrdb-version "2.27"
-  "`xrdb-mode' version number.")
-
-;; 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:
-;;
-;; This file provides a major mode for editing X resource database
-;; files.  It includes font-lock definitions and commands for
-;; controlling indentation, re-indenting by subdivisions, and loading
-;; and merging into the the resource database.
-;;
-;; To use, put the following in your .emacs:
-;;
-;; (autoload 'xrdb-mode "xrdb-mode" "Mode for editing X resource files" t)
-;;
-;; You may also want something like:
-;;
-;; (setq auto-mode-alist
-;;       (append '(("\\.Xdefaults$"    . xrdb-mode)
-;;                 ("\\.Xenvironment$" . xrdb-mode)
-;;                 ("\\.Xresources$"   . xrdb-mode)
-;;                 ("*.\\.ad$"         . xrdb-mode)
-;;                 )
-;;               auto-mode-alist))
-;;
-;; Emacs 19 users will probably have to add the following to their
-;; .emacs file:
-;;
-;;(defadvice char-after (before c-char-after-advice
-;;			      (&optional pos)
-;;			      activate preactivate)
-;;  "POS is optional and defaults to the position of point."
-;;  (if (not pos)
-;;      (setq pos (point))))
-
-;;; History:
-;;
-;; In 1994 I wrote:
-;;
-;; "I used to be like you.  I used to hack on X resource database files
-;;  all the time, and when I did, I found this mode to be fairly
-;;  useful.  It's by no means perfect.  At one time I had a collection
-;;  of hacks that did some nice indentation of resource lines, but
-;;  they were not organized in any way.  This mode was my attempt to
-;;  congeal this mess into a proper major mode.  I release it now, not
-;;  because it will change your life, but because I don't plan to do
-;;  anything more with it.
-;;
-;;  I have since been enlightened and no longer have to cavort with
-;;  mere mortal X hackers anymore.  I like my brain cells, so now I
-;;  use NEXTSTEP where all is glory.  Or would you say I traded one
-;;  vice for another?  Hmm...  Anyway, if you are still down in the
-;;  trenches and would like to inherit this file, let me know.  I
-;;  don't intend to do any work on it any more... unless I lose my
-;;  place in paradise.  I promise to be good, Steve.  :-) :-)"
-;;
-;; I have fallen from grace and have been kicked out of paradise.  So
-;; has Steve Jobs apparently :-)
-;;
-;; The database merge feature was inspired by Joel N. Weber II.
-;;
-;; The canonical Web site for xrdb-mode is
-;; 
-
-;; Code:
-
-(require 'custom)
-
-
-
-(defgroup xrdb nil
-  "Support for editing X resource database files"
-  :group 'languages)
-
-(defcustom xrdb-mode-hook nil
-  "*Hook to be run when `xrdb-mode' is entered."
-  :type 'hook
-  :group 'xrdb)
-
-(defcustom xrdb-subdivide-by 'paragraph
-  "*Default alignment subdivision when re-indenting a region or buffer.
-This variable controls how much of the buffer is searched to find a
-goal column on which to align.  Every non-comment line in the region
-defined by this variable is scanned for the first `:' character on the 
-line, and this character's column is the line's goal column.  The
-rightmost line goal column in the region is taken as the region's goal 
-column.
-
-This variable can take one of the following symbol values:
-
- `buffer'    - All lines in the buffer are scanned.  This is the
-               slowest option. 
-
- `paragraph' - All lines in the paragraph are scanned.  Paragraphs
-               are delimited by blank lines, comment lines, and page
-               delimiters.
-
- `page'      - All lines in the page are scanned.  Pages are delimited 
-               with `page-delimiter', usually ^L (control-L).
-
- `line'      - Only the previous non-comment line is scanned.  This is
-               the fastest method.
-
-This variable is used by the various indentation commands, and can be
-overridden in those commands by using \\[universal-argument]."
-  :type '(radio (const :tag "Do not subdivide buffer" buffer)
-		(const :tag "Subdivide by paragraphs" paragraph)
-		(const :tag "Subdivide by pages" page)
-		(const :tag "Each line is independent" line))
-  :group 'xrdb)
-
-(defcustom xrdb-compress-whitespace nil
-  "*Collapse all whitespace to a single space after insertion of `:'."
-  :type 'boolean
-  :group 'xrdb)
-
-(defcustom xrdb-program "xrdb"
-  "*Program to run to load or merge resources in the X resource database."
-  :type 'string
-  :group 'xrdb)
-
-(defcustom xrdb-program-args '("-merge")
-  "*List of string arguments to pass to `xrdb-program'."
-  :type '(repeat string)
-  :group 'xrdb)
-
-(defvar xrdb-master-file nil
-  "If non-nil, merge in the named file instead of the buffer's file.
-The intent is to allow you to set this variable in the file's local
-variable section, e.g.:
-
-    ! Local Variables:
-    ! xrdb-master-file: \"Xdefaults\"
-    ! End:
-
-so that typing \\[xrdb-database-merge-buffer-or-region] in that buffer
-merges the named master file instead of the buffer's file.  Note that
-if the file name has a relative path, the `default-directory' for the
-buffer is prepended to come up with a file name.
-
-You may also want to set `xrdb-program-args' in the local variables
-section as well.")
-(make-variable-buffer-local 'xrdb-master-file)
-
-
-;; Non-user customizable
-(defconst xrdb-comment-re "^[ \t]*[!]"
-  "Regular expression describing the beginning of a comment line.")
-
-
-
-;; utilities
-(defun xrdb-point (position)
-  ;; Returns the value of point at certain commonly referenced POSITIONs.
-  ;; POSITION can be one of the following symbols:
-  ;; 
-  ;; bol  -- beginning of line
-  ;; eol  -- end of line
-  ;; bod  -- beginning of defun
-  ;; boi  -- back to indentation
-  ;; ionl -- indentation of next line
-  ;; iopl -- indentation of previous line
-  ;; bonl -- beginning of next line
-  ;; bopl -- beginning of previous line
-  ;; bop  -- beginning of paragraph
-  ;; eop  -- end of paragraph
-  ;; bopg -- beginning of page
-  ;; eopg -- end of page
-  ;; 
-  ;; This function does not modify point or mark.
-  (let ((here (point)))
-    (cond
-     ((eq position 'bod)  (beginning-of-defun))
-     ((eq position 'bol)  (beginning-of-line))
-     ((eq position 'eol)  (end-of-line))
-     ((eq position 'boi)  (back-to-indentation))
-     ((eq position 'bonl) (forward-line 1))
-     ((eq position 'bopl) (forward-line -1))
-     ((eq position 'bop)  (forward-paragraph -1))
-     ((eq position 'eop)  (forward-paragraph 1))
-     ((eq position 'bopg)  (forward-page -1))
-     ((eq position 'eopg)  (forward-page 1))
-     (t
-      (error "unknown buffer position requested: %s" position)))
-    (prog1
-	(point)
-      (goto-char here))
-    ))
-
-(defmacro xrdb-safe (&rest body)
-  ;; safely execute BODY, return nil if an error occurred
-  (` (condition-case nil
-	 (progn (,@ body))
-       (error nil))))
-
-(defsubst xrdb-skip-to-separator ()
-  ;; skip forward from the beginning of the line to the separator
-  ;; character as given by xrdb-separator-char. Returns t if the
-  ;; char was found, otherwise, nil.
-  (beginning-of-line)
-  (skip-chars-forward "^:" (xrdb-point 'eol))
-  (and (eq (char-after) ?:)
-       (current-column)))
-
-(defsubst xrdb-in-comment-p (&optional lim)
-  (let* ((lim (or lim (xrdb-point 'bod)))
-	 (state (parse-partial-sexp lim (point))))
-    (nth 4 state)))
-
-(defsubst xrdb-boi-col ()
-  (let ((here (point)))
-    (goto-char (xrdb-point 'boi))
-    (prog1
-	(current-column)
-      (goto-char here))))
-
-(defvar xrdb-prompt-history nil)
-
-(defun xrdb-prompt-for-subdivision ()
-  (let ((options '(("buffer" . buffer)
-		   ("paragraphs" . paragraph)
-		   ("pages" . page)
-		   ("lines" . line)))
-	(completion-ignore-case t))
-    (cdr (assoc
-	  (completing-read "Subdivide alignment by? " options nil t
-			   (cons (format "%s" xrdb-subdivide-by) 0)
-			   'xrdb-prompt-history)
-	  options))))
-
-
-;; commands
-(defun xrdb-electric-separator (arg)
-  "Insert a colon, and possibly indent line.
-Numeric argument inserts that many separators.  If the numeric
-argument is not given, or is 1, and the separator is not inserted in a
-comment, then the line is indented according to `xrdb-subdivide-by'."
-  (interactive "P")
-  (self-insert-command (prefix-numeric-value arg))
-  ;; only do electric behavior if arg is not given
-  (or arg
-      (xrdb-in-comment-p)
-      (xrdb-indent-line))
-  ;; compress whitespace
-  (and xrdb-compress-whitespace
-       (just-one-space)))
-
-(defun xrdb-electric-bang (arg)
-  "Insert an exclamation point to start a comment.
-Numeric argument inserts that many exclamation characters.  If the
-numeric argument is not given, or is 1, and the bang character is the
-first character on a line, the line is indented to column zero."
-  (interactive "P")
-  (let ((how-many (prefix-numeric-value arg)))
-    (self-insert-command how-many)
-    (save-excursion
-      (if (and (= how-many 1)
-	       (xrdb-in-comment-p)
-	       (memq (char-before (xrdb-point 'boi)) '(?\n nil)))
-	  (indent-line-to 0)))
-    ))
-
-
-(defun xrdb-indent-line (&optional arg)
-  "Align the current line according to `xrdb-subdivide-by'.
-With optional \\[universal-argument], prompt for subdivision."
-  (interactive "P")
-  (xrdb-align-to-column
-   (xrdb-guess-goal-column (if arg
-			       (xrdb-prompt-for-subdivision)
-			     xrdb-subdivide-by))
-   (xrdb-point 'bol)
-   (xrdb-point 'bonl)))
-
-(defun xrdb-indent-region (start end &optional arg)
-  "Indent all lines in the region according to `xrdb-subdivide-by'.
-With optional \\[universal-argument], prompt for subdivision."
-  (interactive "r\nP")
-  (xrdb-align-to-column
-   (xrdb-guess-goal-column (if arg
-			       (xrdb-prompt-for-subdivision)
-			     xrdb-subdivide-by))
-   start end))
-
-(defun xrdb-indent-page (&optional arg)
-  "Indent all lines in the page according to `xrdb-subdivide-by'.
-With optional \\[universal-argument], prompt for subdivision."
-  (interactive "P")
-  (xrdb-align-to-column
-   (xrdb-guess-goal-column (if arg
-			       (xrdb-prompt-for-subdivision)
-			     xrdb-subdivide-by))
-   (xrdb-point 'bopg)
-   (xrdb-point 'eopg)))
-
-(defun xrdb-indent-paragraph (&optional arg)
-  "Indent all lines in the paragraph according to `xrdb-subdivide-by'.
-With optional \\[universal-argument], prompt for subdivision."
-  (interactive "P")
-  (xrdb-align-to-column
-   (xrdb-guess-goal-column (if arg
-			       (xrdb-prompt-for-subdivision)
-			     xrdb-subdivide-by))
-   (xrdb-point 'bop)
-   (xrdb-point 'eop)))
-
-(defun xrdb-indent-buffer (&optional arg)
-  "Indent all lines in the buffer according to `xrdb-subdivide-by'.
-With optional \\[universal-argument], prompt for subdivision."
-  (interactive "P")
-  (let ((subdivide-by (if arg
-			  (xrdb-prompt-for-subdivision)
-			xrdb-subdivide-by)))
-    (save-excursion
-      (beginning-of-buffer)
-      (if (eq subdivide-by 'buffer)
-	  (xrdb-align-to-column (xrdb-guess-goal-column 'buffer)
-				(point-min) (point-max))
-	(let (mvfwdfunc indentfunc)
-	  (cond
-	   ((eq subdivide-by 'paragraph)
-	    (setq mvfwdfunc 'forward-paragraph
-		  indentfunc 'xrdb-indent-paragraph))
-	   ((eq subdivide-by 'page)
-	    (setq mvfwdfunc 'forward-page
-		  indentfunc 'xrdb-indent-page))
-	   ((eq subdivide-by 'line)
-	    (setq mvfwdfunc 'forward-line
-		  indentfunc 'xrdb-indent-page))
-	   (t (error "Illegal alignment subdivision: %s" subdivide-by))
-	   )
-	  (while (< (point) (point-max))
-	    (funcall indentfunc)
-	    (funcall mvfwdfunc 1))
-	  )))))
-
-
-;; internal alignment functions
-(defun xrdb-align-to-column (goalcol &optional start end)
-  (let ((start (or start (xrdb-point 'bol)))
-	(end (or end (xrdb-point 'bonl))))
-    (save-excursion
-      (save-restriction
-	(narrow-to-region start end)
-	(beginning-of-buffer)
-	(while (< (point) (point-max))
-	  (if (and (not (looking-at xrdb-comment-re))
-		   (xrdb-skip-to-separator))
-	      (indent-line-to (max 0 (+ goalcol
-					(- (current-column))
-					(xrdb-boi-col))
-				   )))
-	  (forward-line 1))
-	))))
-
-(defun xrdb-guess-goal-column (subdivide-by)
-  ;; Returns the goal column of the current line based on SUBDIVIDE-BY,
-  ;; which can be any value allowed by `xrdb-subdivide-by'.
-  (let ((here (point))
-	(goalcol 0))
-    (save-restriction
-      (cond
-       ((eq subdivide-by 'line)
-	(while (and (zerop (forward-line -1))
-		    (or (looking-at xrdb-comment-re)
-			(not (xrdb-skip-to-separator)))))
-	;; maybe we didn't find one
-	(if (not (xrdb-skip-to-separator))
-	    (goto-char here))
-	(narrow-to-region (xrdb-point 'bol) (xrdb-point 'bonl)))
-       ((eq subdivide-by 'page)
-	(narrow-to-page))
-       ((eq subdivide-by 'paragraph)
-	(narrow-to-region (xrdb-point 'bop) (xrdb-point 'eop)))
-       ((eq subdivide-by 'buffer))
-       (t (error "Illegal alignment subdivision: %s" subdivide-by)))
-      (goto-char (point-min))
-      (while (< (point) (point-max))
-	(if (and (not (looking-at xrdb-comment-re))
-		 (xrdb-skip-to-separator))
-	    (setq goalcol (max goalcol (- (current-column) (xrdb-boi-col)))))
-	(forward-line 1)))
-    (goto-char here)
-    goalcol))
-
-
-
-;; major-mode stuff
-(defvar xrdb-mode-abbrev-table nil
-  "Abbreviation table used in `xrdb-mode' buffers.")
-(define-abbrev-table 'xrdb-mode-abbrev-table ())
-
-
-(defvar xrdb-mode-syntax-table nil
-  "Syntax table used in `xrdb-mode' buffers.")
-(if xrdb-mode-syntax-table
-    nil
-  (setq xrdb-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?!  "<"    xrdb-mode-syntax-table)
-  (modify-syntax-entry ?\\ "\\"   xrdb-mode-syntax-table)
-  (modify-syntax-entry ?\n ">"    xrdb-mode-syntax-table)
-  (modify-syntax-entry ?/  ". 14" xrdb-mode-syntax-table)
-  (modify-syntax-entry ?*  "_ 23" xrdb-mode-syntax-table)
-  (modify-syntax-entry ?.  "_"    xrdb-mode-syntax-table)
-  (modify-syntax-entry ?#  "_"    xrdb-mode-syntax-table)
-  (modify-syntax-entry ??  "_"    xrdb-mode-syntax-table)
-  (modify-syntax-entry ?<  "("    xrdb-mode-syntax-table)
-  (modify-syntax-entry ?>  ")"    xrdb-mode-syntax-table)
-  )
-
-
-(defvar xrdb-mode-map ()
-  "Keymap used in `xrdb-mode' buffers.")
-(if xrdb-mode-map
-    ()
-  (setq xrdb-mode-map (make-sparse-keymap))
-  ;; make the separator key electric
-  (define-key xrdb-mode-map ":"        'xrdb-electric-separator)
-  (define-key xrdb-mode-map "!"        'xrdb-electric-bang)
-  (define-key xrdb-mode-map "\t"       'xrdb-indent-line)
-  (define-key xrdb-mode-map "\C-c\C-a" 'xrdb-indent-buffer)
-  (define-key xrdb-mode-map "\C-c\C-b" 'xrdb-submit-bug-report)
-  (define-key xrdb-mode-map "\C-c\C-c" 'xrdb-database-merge-buffer-or-region)
-  (define-key xrdb-mode-map "\C-c\C-p" 'xrdb-indent-paragraph)
-  (define-key xrdb-mode-map "\C-c\["   'xrdb-indent-page)
-  (define-key xrdb-mode-map "\C-c\C-r" 'xrdb-indent-region)
-  )
-
-;;;###autoload
-(defun xrdb-mode ()
-  "Major mode for editing xrdb config files"
-  (interactive)
-  (kill-all-local-variables)
-  (set-syntax-table xrdb-mode-syntax-table)
-  (setq major-mode 'xrdb-mode
-	mode-name "xrdb"
-	local-abbrev-table xrdb-mode-abbrev-table)
-  (use-local-map xrdb-mode-map)
-  ;; local variables
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (make-local-variable 'comment-start-skip)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-end)
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  ;; now set their values
-  (setq parse-sexp-ignore-comments t
-	comment-start-skip "![ \t]*"
-	comment-start "! "
-	comment-end "")
-  (setq indent-region-function 'xrdb-indent-region
-	paragraph-ignore-fill-prefix t
-	paragraph-start (concat "^[ \t]*$\\|^[ \t]*[!]\\|" page-delimiter)
-	paragraph-separate paragraph-start)
-  (run-hooks 'xrdb-mode-hook))
-
-
-
-;; faces and font-locking
-(defvar xrdb-option-name-face 'xrdb-option-name-face
-  "Face for option name on a line in an X resource db file")
-
-(defvar xrdb-option-value-face 'xrdb-option-value-face
-  "Face for option value on a line in an X resource db file")
-
-(make-face 'xrdb-option-name-face)
-(make-face 'xrdb-option-value-face)
-
-(defun xrdb-font-lock-mode-hook ()
-  (or (face-differs-from-default-p 'xrdb-option-name-face)
-      (copy-face 'font-lock-keyword-face 'xrdb-option-name-face))
-  (or (face-differs-from-default-p 'xrdb-option-value-face)
-      (copy-face 'font-lock-string-face 'xrdb-option-value-face))
-  (remove-hook 'font-lock-mode-hook 'xrdb-font-lock-mode-hook))
-(add-hook 'font-lock-mode-hook 'xrdb-font-lock-mode-hook)
-
-(defvar xrdb-font-lock-keywords
-  (list '("^[ \t]*\\([^\n:]*:\\)[ \t]*\\(.*\\)$"
-	  (1 xrdb-option-name-face)
-	  (2 xrdb-option-value-face)))
-  "Additional expressions to highlight in X resource db mode.")
-(put 'xrdb-mode 'font-lock-defaults '(xrdb-font-lock-keywords))
-
-
-
-;; merging and manipulating the X resource database
-(defun xrdb-database-merge-buffer-or-region (start end)
-  "Merge the current buffer's resources into the X resource database.
-
-`xrdb-program' is the program to actually call, with the arguments
-specified in `xrdb-program-args'.  This latter can be set to do either
-a merge or a load, etc.  Also, if the file local variable
-`xrdb-master-file' is non-nil, then it is merged instead of the
-buffer's file.
-
-If the current region is active, it is merged instead of the buffer,
-and this overrides any use of `xrdb-master-file'."
-  (interactive
-   ;; the idea here is that if the region is inactive, start and end
-   ;; will be nil, if not passed in programmatically
-   (list (xrdb-safe (and (mark) (region-beginning)))
-	 (xrdb-safe (and (mark) (region-end)))))
-  (message "Merging with args: %s..." xrdb-program-args)
-  (let ((outbuf (get-buffer-create "*Shell Command Output*")))
-    ;; I prefer the XEmacs way of doing this, but this is the easiest
-    ;; way to work in both XEmacs and Emacs.
-    (with-current-buffer outbuf (erase-buffer))
-    (cond
-     ((and start end)
-      (apply 'call-process-region start end xrdb-program nil outbuf t
-	     xrdb-program-args))
-     (xrdb-master-file
-      (apply 'call-process xrdb-program xrdb-master-file outbuf t
-	     xrdb-program-args))
-     (t
-      (apply 'call-process-region (point-min) (point-max) xrdb-program
-	     nil outbuf t xrdb-program-args)))
-    (if (not (zerop (with-current-buffer outbuf (buffer-size))))
-	(pop-to-buffer outbuf)))
-  (message "Merging... done"))
-
-
-
-;; submitting bug reports
-
-(defconst xrdb-mode-help-address "tools-help@python.org"
-  "Address for xrdb-mode bug reports.")
-
-(defun xrdb-submit-bug-report ()
-  "Submit via mail a bug report on xrdb-mode."
-  (interactive)
-  ;; load in reporter
-  (require 'reporter)
-  (let ((reporter-prompt-for-summary-p t)
-	(varlist '(xrdb-subdivide-by
-		   xrdb-mode-hook
-		   xrdb-compress-whitespace
-		   )))
-    (and (if (y-or-n-p "Do you want to submit a report on xrdb-mode? ")
-	     t
-	   (message "")
-	   nil)
-	 (require 'reporter)
-	 (reporter-submit-bug-report
-	  xrdb-mode-help-address
-	  (format "xrdb-mode %s" xrdb-version)
-	  varlist nil nil "Dear Barry,")
-	 )))
-
-
-;; XEmacs additions
-;;;###autoload(add-to-list 'auto-mode-alist '("[./\\]X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\.ad\\'" . xrdb-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("/app-defaults/" . xrdb-mode))
-
-(provide 'xrdb-mode)
-;;; xrdb-mode.el ends here
diff --git a/xemacs-packages/lisp/tramp/ChangeLog b/xemacs-packages/lisp/tramp/ChangeLog
deleted file mode 100644
index a6119f20..00000000
--- a/xemacs-packages/lisp/tramp/ChangeLog
+++ /dev/null
@@ -1,283 +0,0 @@
-2006-05-01  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.32 released.
-
-2006-04-18  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.31 released.
-
-2006-04-17  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.53.
-
-2006-02-13  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.30 released.
-
-2006-01-23  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.29 released.
-
-2006-01-22  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.52.
-
-2005-10-12  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.28 released.
-
-2005-10-11  Steve Youngs  
-
-	* Makefile (REQUIRES): Remove fsf-compat, add sh-script (for
-	executable-find).
-
-2005-10-09  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.27 released.
-
-2005-10-08  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.51.
-
-2005-08-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.26 released.
-
-2005-08-07  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.50.
-
-2005-06-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.25 released.
-
-2005-05-18  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.24 released.
-
-2005-05-14  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.49.
-
-2005-03-21  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.23 released.
-
-2005-03-20  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.48.
-
-2005-01-17  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.22 released.
-
-2005-01-16  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.47.
-
-2004-12-24  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.21 released.
-
-2004-12-23  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.46.
-
-2004-10-18  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.20 released.
-
-2004-10-17  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.45.
-
-2004-10-01  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.19 released.
-
-2004-09-29  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.18 released.
-
-2004-09-22  Michael Albinus  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.44.
-
-2003-12-02  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.17 released.
-
-2003-11-25  Jeff Miller 
-
-	* Makefile (MAKEINFO_FLAGS):
-	Add -D xemacs so that XEmacs specific tramp syntax is used
-	in the info files, not the Emacs syntax.
-
-2003-07-21  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.16 released.
-
-2003-06-20  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.15 released.
-
-2003-06-17  Kai Großjohann  
-
-	* Makefile (AUTHOR_VERSION): Bump to 2.0.35.
-
-2003-06-17  Kai Großjohann  
-
-	* Makefile (EXTRA_SOURCES): ChangeLog.upstream
-	(MAINTAINER): New email address.
-
-2003-06-15  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.14 released.
-
-2003-06-15  Kai Großjohann  
-
-	* Makefile (ELCS): Add new files.
-
-	* package-info.in: Add new provides.
-
-2003-05-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.13 released.
-
-2003-04-02  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.12 released.
-
-2003-04-02  Steve Youngs  
-
-	* package-info.in (provides): Add tramp-uu.
-
-	* Makefile (ELCS): Add tramp-uu.elc.
-
-2003-03-09  Ben Wing  
-
-	* Makefile (.texi.info): Removed.
-	* Makefile (texinfo): Removed.
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-	Include Local.rules.inc at the beginning for access to
-	BUILD_WITHOUT_MULE, and put the include of XEmacs.rules at the
-	end.
-	Use EXPLICIT_DOCS instead of explicitly giving the targets
-	and dependencies.
-	Move the include of XEmacs.rules to the end of the file.
-	Eliminate recursive doc building.  Move MAKEINFO_FLAGS into
-	this file from texi/Makefile.
-
-2003-01-03  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.11 released.
-
-2002-11-29  Ben Wing  
-
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15  Ville Skyttä  
-
-	* Makefile (srckit): Remove.
-
-2002-10-14  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.10 released.
-
-2002-10-13  Ville Skyttä  
-
-	* Makefile (INFO_DEP): New.
-	(texinfo): Use INFO_DEP.
-	(AUTHOR_VERSION): Bring up to date, 2.0.22.
-	(MANUAL): Remove, unused.
-
-2002-10-12  Ville Skyttä  
-
-	* Makefile (INFO_FILES): Change to .info* (for make clean).
-
-2002-10-07  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.09 released.
-
-2002-08-26  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.08 released.
-
-2002-08-17  Adrian Aichner  
-
-	* Makefile (TEXI_FILES): Add Japanese files.
-
-2002-08-12  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.07 released.
-
-	* Makefile (VERSION): XEmacs package 1.06 released.
-
-2002-08-07  Kai Großjohann  
-
-	Sync with upstram version 2.0.12.
-	Bug fixes.
-
-2002-08-07  Kai Großjohann  
-
-	Sync with upstram version 2.0.11.
-
-2002-08-04  Ville Skyttä  
-
-	* Makefile (REQUIRES): Add ediff.
-	(AUTHOR_VERSION): Set to 2.0.10.
-
-2002-08-04  Kai Großjohann  
-
-	* Sync with upstream version 2.0.10.
-
-2002-04-24  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.05 released.
-
-2002-03-25  Steve Youngs  
-
-	* Makefile (VERSION): 1.04 released.
-
-2002-03-17  Adrian Aichner  
-
-	* Makefile: Add html rule to invoke texi/Makefile.
-
-2002-01-27  Steve Youngs  
-
-	* Makefile (MAINTAINER): Change to Kai.
-
-2002-01-07  Adrian Aichner  
-
-	* Makefile (HTML_FILES): New.
-	* Makefile (HTML_DEP): New.
-
-2001-12-08  Steve Youngs  
-
-	* README: Update to reflect XEmacs package branch, add section
-	about getting Tramp2 code.
-
-	* Makefile: Re-write.
-	* Makefile.XEmacs: Remove.
-
-2001-12-06  Stephen J. Turnbull  
-
-	* Makefile: Conditionally include Makefile.XEmacs.
-	* Makefile.XEmacs:
-	* package-info.in:
-	New files.  Packagize TRAMP.
-
-2001-11-07  Kai Großjohann  
-
-	* Makefile (sourceforge): Submit tarballs via FTP automatically.
-
-2001-10-08  Kai Großjohann  
-
-	* Makefile (tar): Add rules for more tarballs.
-
-2001-09-07  Kai Großjohann  
-
-	* Makefile (Module): Rule for submitting to SourceForge.
-
diff --git a/xemacs-packages/lisp/tramp/ChangeLog.upstream b/xemacs-packages/lisp/tramp/ChangeLog.upstream
deleted file mode 100644
index 912eec15..00000000
--- a/xemacs-packages/lisp/tramp/ChangeLog.upstream
+++ /dev/null
@@ -1,798 +0,0 @@
-2006-04-17  Michael Albinus  
-
-	Version 2.0.53 released.
-
-	* configure.ac: Bump version.
-
-2006-03-14  Michael Albinus  
-
-	* Makefile.in: Implement DESTDIR support.
-
-	* INSTALL: Mention DESTDIR support.
-
-2006-01-27  Michael Albinus  
-
-	* configure.ac: Bump version (to 2.0.53-pre).  Update merge
-	version to 2.0.52.
-
-2006-01-22  Michael Albinus  
-
-	Version 2.0.52 released.
-
-	* configure.ac: Bump version.
-
-2005-12-02  Michael Albinus  
-
-	* configure.ac: Remove creation of info directory.
-
-	* Makefile.in (MANIFEST): Call ./config.status in order to
-	regenerate $(CONFIG_FILES).
-
-2005-10-23  Michael Albinus  
-
-	* Makefile.in (clean): Cleanup also subdirectory test.
-	(MANIFEST): Exclude tramp2 and .cvsignore.
-
-2005-10-11  Michael Albinus  
-
-	* configure.ac: Bump version (to 2.0.52-pre).  Update merge
-	version to 2.0.51.
-
-2005-10-11  Steve Youngs  
-
-	* Makefile.XEmacs (REQUIRES): Remove fsf-compat, add
-	sh-script (for executable-find).
-
-2005-10-08  Michael Albinus  
-
-	Version 2.0.51 released.
-
-	* configure.ac: Bump version.
-
-2005-08-28  Michael Albinus  
-
-	* configure.ac: Bump version (to 2.0.51-pre).  Update merge
-	version to 2.0.50.
-
-2005-08-07  Michael Albinus  
-
-	Version 2.0.50 released.
-
-	* configure.ac: Bump version.
-
-2005-07-10  Michael Albinus  
-
-	Update FSF's address in GPL notices.
-
-	* configure.ac: Bump version (to 2.0.50-pre).  Update merge
-	version to 2.0.49.
-
-2005-05-14  Michael Albinus  
-
-	Version 2.0.49 released.
-
-	* configure.ac: Bump version.
-
-2005-04-03  Michael Albinus  
-
-	* configure.ac: Bump version (to 2.0.49-pre).  Update merge
-	version to 2.0.48.
-
-2005-03-20  Michael Albinus  
-
-	Version 2.0.48 released.
-
-	* configure.ac: Bump version.
-
-	* Makefile.in (FTP_UPLOAD): Change upload address to
-	"ftp://ftp-upload.gnu.org/incoming/ftp".
-	(tar): Handle "$(TARNAME).tar.gz.directive".
-
-2005-02-09  Kim F. Storm  
-
-	Change release version from 21.4 to 22.1 throughout.
-
-2005-02-05  Michael Albinus  
-
-	* INSTALL: Change bug report address to [tramp-devel@gnu.org].
-
-2005-02-02  Michael Albinus  
-
-	* configure.ac: Bump version (to 2.0.48-pre).  Update merge
-	version to 2.0.47.  Change bug report address to
-	[tramp-devel@gnu.org].
-
-2005-01-16  Michael Albinus  
-
-	Version 2.0.47 released.
-
-	* configure.ac: Bump version.
-
-2004-12-30  Michael Albinus  
-
-	* aclocal.m4, configure.ac: grep(1) on OpenBSD 3.6 does not
-	understand the '-' option.  Small change.  From Ryan Yeske
-	.
-
-2004-12-22  Michael Albinus  
-
-	* configure.ac: Bump version (to 2.0.47-pre).  Update merge
-	version to 2.0.46.
-
-2004-12-16  Michael Albinus  
-
-	Version 2.0.46 released.
-
-	* configure.ac: Bump version.
-
-2004-10-17  Michael Albinus  
-
-	* Makefile.XEmacs, package-info.in: Synchronize with XEmacs CVS
-	repository.
-
-2004-10-14  Michael Albinus  
-
-	* configure.ac: Bump version (to 2.0.46-pre).  Update merge
-	version to 2.0.45.
-
-2004-10-12  Michael Albinus  
-
-	Version 2.0.45 released.
-
-	* configure.ac: Bump version.
-
-2004-10-10  Michael Albinus  
-
-	* Makefile.in (savannah): Don't call make for texi.  Only the
-	trunk should place its files there.
-
-2004-09-19  Michael Albinus  
-
-	* Makefile.in (AUTOCONF, XEMACS_FILES): New variables.
-	(emacs): Use "cvs -f diff" in order to suppress "~/.cvsrc".  There
-	might be conflicting options else.
-	(xemacs): Reworked.  Same philosophy as `emacs' now.
-	(configure): Apply $(AUTOCONF).  Reported by Norbert Koch
-	 in order to have a simple possibility applying
-	autoconf under another name.
-
-2004-09-11  Michael Albinus  
-
-	* configure.ac: Bump version (to 2.0.45-pre).  Update merge
-	version to 2.0.44.
-
-2004-08-10  Michael Albinus  
-
-	* Makefile.in (EMACS_EL_FILES): Remove lisp/trampver.el, it is a
-	generated file.
-	(emacs): Copy trampver.el.
-
-	Version 2.0.44 released.
-
-	* configure.ac: Bump version.
-
-2004-07-17  Kai Grossjohann  
-
-	* configure.ac: Bump version (to 2.0.44-pre).  Update merge
-	version to 2.0.43.
-
-	Version 2.0.43 released.
-
-2004-07-13  Michael Albinus  
-
-	Sync with trunk.
-
-	* .cvsignore: Add *.diff.
-
-	* configure.ac: Bump version (to 2.0.43-pre) and set
-	TRAMP_EMACS_MERGE_VERSION (to 2.0.42).
-	(FTP_UPLOAD): New variable, indicating which ftp upload program to
-	savannah has to be used.  Kai and Michael differ in their
-	preferences ...
-	(TRAMP_CLEAN_FILES): Add .*~ and *.diff.
-
-	* README-CVS: Explaining stable releases and pre-releases in CVS.
-
-	* Makefile.in (FTP_UPLOAD): New variable.  Value depending on
-	@FTP_UPLOAD@.
-	(savannah): Use it.
-
-2004-07-13  Kai Grossjohann  
-
-	Sync with trunk.
-
-	* Makefile.in: Remove special-casing for building as an XEmacs
-	package.  They have their own repository with their own Makefile.
-	(cl-release): New target, makes "Version X released." ChangeLog
-	entries.
-
-2004-06-26  Kai Grossjohann  
-
-	* configure.ac: Bump version (to 2.0.43-pre) and set
-	TRAMP_EMACS_MERGE_VERSION (to 2.0.42).
-
-2004-06-26  Kai Grossjohann  
-
-	Version 2.0.42 released.
-
-	* configure.ac: Release 2.0.42.
-
-2004-05-30  Michael Albinus  
-
-	* configure.ac: Bump version (to 2.0.42-pre) and set
-	TRAMP_EMACS_MERGE_VERSION (to 2.0.41).
-
-2004-05-29  Michael Albinus  
-
-	Version 2.0.41 released.
-
-	* configure.ac: Bump version.
-
-	Sync with trunk.
-
-	* Makefile.in (.SILENT): Add lisp target.
-	(info): Depends on $(CONFIG_FILES).
-
-2004-05-29  Kai Grossjohann  
-
-	Sync with trunk.
-
-	* Makefile.in (lisp): New target: byte-compile the lisp/*.el files.
-
-2004-05-29  Kai Grossjohann  
-
-	* configure.ac: Use "-pre" suffix on CVS versions.
-
-2004-05-07  Kai Grossjohann  
-
-	* configure.ac: Bump version (to 2.0.41) and set the
-	last-merged-with-Emacs version (to 2.0.40).  Hm.  The version bump
-	to 2.0.41 is probably bogus, we want to create a stable
-	branch...  Argh.
-
-	* Makefile.in (emacs): Don't patch man/trampver.texi in the Emacs
-	repository, just copy texi/trampver.texi there.  We can't run
-	"cvs diff" on texi/trampver.texi since it is a generated file, so
-	our patching trick won't work for this file.
-
-	* configure.ac (TRAMP_EMACS_MERGE_VERSION): New variable,
-	indicating which was the last revision of Tramp that was merged
-	into Emacs.  Don't forget to update this after running "make
-	emacs" (or "gmake emacs")!
-
-	* Makefile.in (EMACS_EL_FILES): Mention files explicitly to make
-	sure that tramp-efs.el is not included.
-	(EMACS_TEXI_FILES): New variable, lists manual files that need to
-	be merged with the Emacs repository.
-	(TRAMP_EMACS_MERGE_VERSION, TRAMP_EMACS_MERGE_TAG): New
-	variables, indicating which was the last revision of Tramp that
-	was merged into Emacs.  Automatically set by configure, original
-	is in configure.ac.
-	(emacs): Reword to use patches instead of copying the files.
-	This helps to make sure that changes to Tramp files in the Emacs
-	repository aren't overwritten.
-
-2004-05-02  Kai Grossjohann  
-
-	* Makefile.in (savannah): Use FreeBSD syntax for FTP upload.
-
-	Version 2.0.40 released.
-
-	* aclocal.m4 (AC_CONTRIB_FILES): Load the library in question
-	before invoking fboundp on the function searched.
-
-	* configure.ac: Bump version.
-
-2004-04-09  Michael Albinus  
-
-	* aclocal.m4 (AC_EMACS_INSTALL): Rewrite function.  Apply a
-	variable substitution rather then a file substitution
-
-	* configure.ac: Adapt comment for AC_EMACS_INSTALL call.
-
-2004-03-29  Michael Albinus  
-
-	* configure.ac: Beautify check for "install-info".
-
-	* INSTALL (Installation Names): Describe what to do in case of
-	errors and warnings.
-	(Load Path): Add XEmacs example.
-
-2004-03-28  Michael Albinus  
-
-	* configure.ac: Check existence of "install-info".  Taken from
-	Emacs configure.in.
-
-2004-03-14  Michael Albinus  
-
-	* INSTALL: Explain new option `--with-contrib'.  Remove
-	description for explicit use of "contrib" directory.  Remove
-	examples where EMACS environment variable is set explicitely; this
-	can cause confusion.
-
-	* Makefile.in: Don't check for $(USE_CONTRIB) any longer.
-	(distclean) Recurse to subdirectories.
-	(xemacs): Use ""$(MAKE)" instead of "make".
-	(emacs): Use "--with-emacs" configure option.
-	(savannah): Use "ftp-upload" instead of "scp".  Hope it works for
-	Kai.
-
-	* aclocal.m4 (AC_EMACS_LISP): Use "-vanilla" in case of XEmacs.
-	(AC_CONTRIB_FILES): New function.  Checks for the need of
-	provisioning of a contributed package.
-
-	* configure.ac: Apply `AC_CONTRIB_FILES' for all Lisp files of
-	contrib directory.
-
-2004-03-05  Michael Albinus  
-
-	* configure.ac: Write "${MAKE}" if appropriate (but "make").
-
-	* Makefile.in: (.PHONY): Remove unused targets.
-	(distclean): Remove also *.tar.gz*
-	(tar): Call gpg.
-
-2004-03-02  Kai Grossjohann  
-
-	* configure.ac: Look for "gmake", first.
-
-2004-02-29  Kai Grossjohann  
-
-	* Makefile.in (dist, install-html): Remove unused targets.
-
-	Version 2.0.39 released.
-
-	* configure.ac: Bump version.
-
-2004-01-09  Michael Albinus  
-
-	* aclocal.m4 (AC_EMACS_INFO): If an (X)Emacs binary is given,
-	check also for absolute paths.  Reported by Eli Tziperman.
-
-2004-01-02  Michael Albinus  
-
-	* configure.ac: *.elc files must be removed always.  Otherwise,
-	there could be problems if they are created with the wrong Emacs
-	flavor.
-
-2003-11-30  Kai Grossjohann  
-	Version 2.0.38 released.
-
-	* configure.ac: Bump version number.
-
-2003-11-29  Kai Grossjohann  
-
-	* Makefile.in (tar): Avoid --mode arg to tar, it seems to be too
-	recent.  Instead, call "chmod -R" to frob the permissions on the
-	directory before tarring it up.
-
-	* configure.ac: Bump version to 2.0.37.
-
-2003-10-01  Michael Albinus  
-
-	* INSTALL (Japanese Manual): New section.
-
-	* Makefile.in (distclean): Remove directory "info".
-	(savannah): Call "configure --with-japanese-manual".
-
-	* aclocal.m4 (AC_JA_MANUAL): New function.
-
-	* configure.ac: Move AC_EMACS_INSTALL.  Call AC_JA_MANUAL.
-
-2003-10-01  Michael Albinus  
-
-	* aclocal.m4 (AC_PATH_INFODIR): Fix path to xemacs site-packages.
-	From Norbert Koch .
-
-2003-08-23  Kai Großjohann  
-
-	* Makefile.in (tar): Make sure that files in tarball are readable
-	by world.
-
-2003-07-26  Michael Albinus  
-
-	* configure.ac: Add "-s" option for make version check.  Kai's
-	kludge not needed anymore.
-
-2003-07-26  Kai Großjohann  
-
-	* Makefile.in (xemacs): Use new `xemacs' target in lisp subdir,
-	instead of copying *.el files manually.
-
-2003-07-20  Kai Großjohann  
-	Version 2.0.36 released.
-
-	* configure.ac: Bump version.
-	Kludge suitable version test to pass for Kai doing "make
-	savannah".  For some reason, make prints "Entering directory
-	foo" and "Leaving directory foo" messages in that case.
-
-2003-07-15  Michael Albinus  
-
-	* INSTALL: List required GNU software for installation.
-
-2003-07-14  Michael Albinus  
-
-	* aclocal.m4 (AC_EMACS_INFO): Fix typo.
-
-	* configure.ac: Add a check for suitable make version.
-	Reported by Sven Utcke .
-
-	* test.makefile: New file.  Used for checking proper "make"
-	version.
-
-2003-06-24  Kai Großjohann  
-
-	* Makefile.in (xemacs): Make sure to configure for XEmacs.
-
-2003-06-17  Kai Großjohann  
-
-	* configure.ac: Bump version.
-
-2003-05-24  Michael Albinus  
-
-	* aclocal.m4 (AC_EMACS_LISP): Use `--no-site-file' option for
-	Emacs call, in order to avoid loading of Tramp in site specific
-	init files.  Reported by Harry Putnam .
-
-	* Makefile.in (configure): It depends on "aclocal.m4", too.
-
-2003-05-24  Kai Großjohann  
-
-	* configure.ac: Bump version.
-
-	* Makefile.in (cvstag): "cvs tag", not "cvs cvstag".
-
-2003-04-24  Michael Albinus  
-
-	* Makefile.in (.PHONY): Add `tags'.
-	(distclean) Remove also "autom4te.cache".
-
-2003-04-18  Kai Großjohann  
-
-	* Makefile.in (tags): New target.
-	(cvstag): Renamed from `tag' to avoid confusion with `tags'.
-
-2003-04-17  Michael Albinus  
-
-	* Makefile.in (.SILENT): New target.  Remove noise entering
-	subdirectories.
-	(.PHONY): Add missing targets.
-	(all, install): Merge them into one rule.
-	($(CONFIG_FILES)): Depend on $(CONFIG_FILES:=.in), too.
-	(configure): Remove "--trace" option from autoconf call.  It
-	prevented generation of configure.
-
-2003-04-14  Michael Albinus  
-
-	* aclocal.m4 (AC_EMACS_INFO): Make "emacs" as default if $EMACS
-	isn't set.  Be more robust this case.
-
-2003-04-08  Kai Großjohann  
-
-	* Makefile.in (savannah): Invoke configure after creating the
-	distribution tarball, because that deletes texi/Makefile which is
-	needed for the rest of the target.
-
-2003-04-08  Kai Großjohann  
-
-	Version 2.0.33 released.
-
-	* configure.ac: Bump version.
-
-2003-04-08  Kai Großjohann  
-
-	Version 2.0.32 released.
-
-	* configure.ac: Bump version.
-
-2003-04-06  Michael Albinus  
-
-	* aclocal.m4 (AC_EMACS_INSTALL): New macro.  Depending on
-	configure option `--with-packaging', Tramp installation chapter
-	will be part of the manual, or not.
-
-	* configure.ac (top-level): Apply `AC_EMACS_INSTALL'.
-
-	* Makefile.in (xemacs, emacs): Call `./configure --with-packaging'
-	in order to generate `trampver.texi' without installation chapter.
-
-2003-03-30  Kai Großjohann  
-
-	* Makefile.in (xemacs, emacs): Copy trampver.texi, too.
-
-2003-03-29  Kai Großjohann  
-
-	Version 2.0.31 released.
-
-	* configure.ac: Bump version.
-
-2003-03-24  Michael Albinus  
-
-	* INSTALL: Add a first step calling `autoconf' in case Tramp is
-	taken from CVS sources.
-
-2003-03-22  Michael Albinus  
-
-	* .cvsignore (Makefile, config.*, configure): Added.
-
-	* INSTALL: New file.
-
-	* Makefile.in: New file.  Derived from Makefile, which will be
-	generated now.
-	(EMACS, EMACS_INFO, MAKEINFO, CONFIG_FILES, CLEAN_FILES)
-	(VERSION, TARNAME): Generated by configure.
-	(RM, XEMACS_TARGET, EMACS_TARGET): New variables.
-	(DIRS): Add contrib if USE_CONTRIB is set.
-	(EMACS_EL_FILES): Wildcard used.
-	(all): Depends on $(CONFIG_FILES).
-	(install, distclean, maintainer-clean, $(CONFIG_FILES), config.status)
-	(configure): New targets.
-	(prepversion, realclean): Removed.
-	(clean): Cleanup top directory as well.
-	(tag): $(VERSION) has the correct format already.
-	(MANIFEST): Depends on configure and distclean.  Most of the
-	discarded file types could be removed.
-	(tar, dist, savannah): Use $(TARNAME).
-	(xemacs): Use $(XEMACS_TARGET).
-	(emacs): Use $(EMACS_TARGET).
-
-	* Makefile: Removed from CVS.
-
-	* README: Update file list and maintainer address.
-
-	* README-CVS: Primary source of version number resides in
-	`configure.ac' now.
-
-	* aclocal.m4: New file.
-
-	* configure.ac: New file.
-
-2003-02-28  Kai Großjohann  
-
-	* Makefile (VERSION): Bump.
-
-2003-02-05  Kai Großjohann  
-
-	Version 2.0.29 released.
-
-	* Makefile (VERSION): Bump.
-
-2003-01-02  Kai Großjohann  
-
-	* Makefile (EMACS_EL_FILES): List of files for Emacs repository.
-	(emacs): New target.  Copy data into Emacs CVS repository.
-	(xemacs): Copy more files to XEmacs repository.
-
-2002-12-23  Kai Großjohann  
-
-	Version 2.0.28 released.
-
-2002-12-05  Kai Großjohann  
-
-	* Makefile (VERSION): Bump.
-
-2002-11-28  Kai Großjohann  
-
-	* Makefile (VERSION): Bump.
-
-2002-10-19  Kai Großjohann  
-
-	* Makefile (xemacs): Add reminder for Kai.
-
-2002-10-06  Kai Großjohann  
-
-	* Makefile (VERSION): Bump.
-
-2002-10-03  Kai Großjohann  
-
-	* Makefile (realclean): New target, delete info file and tarball
-	here.
-
-2002-09-29  Kai Großjohann  
-
-	* Makefile (VERSION): Bump.
-
-2002-09-28  Kai Großjohann  
-
-	* Makefile (cvs-update): New convenience target.
-	(clean): Remove info subdir, too.
-
-2002-09-27  Kai Großjohann  
-
-	Version 2.0.23 released.
-
-2002-09-22  Kai Großjohann  
-
-	Version 2.0.22 released.
-
-	* Makefile (VERSION): Bump.
-
-	Version 2.0.20 released.
-
-2002-09-16  Kai Großjohann  
-
-	* contrib/README: Explain uudecode.el.
-
-	* contrib/uudecode.el: New file.
-
-2002-09-13  Kai Großjohann  
-
-	Version 2.0.19 released.
-
-	* Makefile (VERSION): Bump.
-
-2002-09-13  Kai Großjohann  
-
-	Version 2.0.18 released.
-
-	* Makefile (VERSION): Bump
-	(MANIFEST): Ignore .#* files.
-
-2002-09-12  Kai Großjohann  
-
-	Version 2.0.17 released.
-
-	* Makefile (tar): Depend on prepversion, not tag.
-	(dist): Depend on tag.
-	(VERSION): Bump.
-
-2002-09-11  Kai Großjohann  
-
-	* Makefile (VERSION): Bump.
-
-2002-09-01  Kai Großjohann  
-
-	Version 2.0.15 released.
-
-	* Makefile (VERSION): Bump.
-	(dist): Don't try to install on local ftp server unless at
-	university account.
-
-2002-08-22  Kai Großjohann  
-
-	Version 2.0.14 released.
-
-	* Makefile (VERSION): Bump.
-
-2002-08-21  Kai Großjohann  
-
-	Version 2.0.13 released.
-
-	* Makefile (VERSION): Bump.
-
-2002-08-07  Kai Großjohann  
-
-	Version 2.0.12 released.
-
-	* Makefile (VERSION): Bump.
-
-2002-08-05  Kai Großjohann  
-
-	Version 2.0.11 released.
-
-	* Makefile (xemacs): Adjust to new directory names after moving
-	from SourceForge to Savannah.
-	(VERSION): Bump.
-
-2002-08-04  Kai Großjohann  
-
-	Version 2.0.10 released.
-
-	* Makefile (VERSION): Bump.
-
-2002-08-04  Kai Großjohann  
-
-	Version 2.0.9 released.
-
-	* Makefile (VERSION): Bump.
-
-2002-08-03  Kai Großjohann  
-
-	Version 2.0.8 released.
-
-2002-08-03  Kai Großjohann  
-
-	Version 2.0.7 released.
-
-2002-08-03  Kai Großjohann  
-
-	Version 2.0.6 released.
-
-2002-07-30  Kai Großjohann  
-
-	Version 2.0.5 released.
-
-2002-07-29  Kai Großjohann  
-
-	Version 2.0.4 released.
-
-2002-07-29  Kai Großjohann  
-
-	* Makefile (prepversion): New target, invokes itself in lisp and
-	texi subdirs.
-	(tag): New target, adds a CVS tag for the current version.
-	(dist): Invoke it.
-
-2002-07-26  Kai Großjohann  
-
-	* Makefile: Bump version, preparing for next release.  (But that
-	release is not soon.)
-
-2002-07-24  Steve Youngs  
-
-	* Makefile (all): Export $VERSION to the subdirectories.
-
-2002-07-23  Kai Großjohann  
-
-	* Makefile (VERSION): New version 2.0.3.
-
-2002-07-19  Kai Großjohann  
-
-	Version 2.0.2 released.
-
-	* Makefile (VERSION): New version 2.0.2.
-
-2002-06-25  Kai Großjohann  
-
-	Version 2.0.1 released.
-
-	* Makefile (VERSION): New version 2.0.1.
-
-2002-06-19  Kai Großjohann  
-
-	* tramp.texi: New todo item.
-
-2002-06-17  Kai Großjohann  
-
-	Version 2.0.0 released.
-
-	* Makefile: Include version number.
-	(MANIFEST): Don't include directory name "tramp/" in the entries.
-	(tar): Create a tramp-$(VERSION).tar.gz file.
-	(dist, savannah): tramp.tar.gz renamed to tramp-$(VERSION).tar.gz.
-
-2002-06-16  Kai Großjohann  
-
-	* Makefile (tar): Make sure tarball is world-readable.
-
-2002-06-14  Kai Großjohann  
-
-	* Makefile (MANIFEST): Write it in the source dir, not in "..".
-	(tar): Create only one tarball, don't distinguish between
-	developer release and stable release.
-	(sourceforge): Remove target.  The project has moved to Savannah.
-	(savannah): New target for uploading tarball to Savannah.
-	Also make home page.
-
-2002-01-22  Kai Großjohann  
-
-	* Makefile (xemacs): New target: copy stuff to the XEmacs package
-	source directory.
-
-2002-01-02  Kai Großjohann  
-
-	* contrib/Makefile (clean): Add target.
-	(all): Ditto.
-
-2001-12-06  Kai Großjohann  
-
-	* Makefile.XEmacs (upstream-cvs-update): Remove target.
-	Suggested by Stephen Turnbull.
-
-	* Makefile: Make it work inside XEmacs, too.  From Stephen
-	J. Turnbull .
-	(MANIFEST): New directory layout.
-
-2001-11-07  Kai Großjohann  
-
-	* Makefile (sourceforge): Submit tarballs via FTP automatically.
-
-2001-10-08  Kai Großjohann  
-
-	* Makefile (tar): Add rules for more tarballs.
-
-2001-09-07  Kai Großjohann  
-
-	* Makefile (Module): Rule for submitting to SourceForge.
-
diff --git a/xemacs-packages/lisp/tramp/_pkg.el b/xemacs-packages/lisp/tramp/_pkg.el
deleted file mode 100644
index 29b53603..00000000
--- a/xemacs-packages/lisp/tramp/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'tramp
-		 :version 1.32
-          :author-version "2.0.53"
-		 :type 'regular)
diff --git a/xemacs-packages/lisp/tramp/auto-autoloads.el b/xemacs-packages/lisp/tramp/auto-autoloads.el
deleted file mode 100644
index 6b40522f..00000000
--- a/xemacs-packages/lisp/tramp/auto-autoloads.el
+++ /dev/null
@@ -1,58 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'tramp-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "lisp/_pkg.el")
-
-(package-provide 'tramp :version 1.32 :author-version "2.0.53" :type 'regular)
-
-;;;***
-
-;;;### (autoloads (tramp-unload-tramp tramp-unload-file-name-handler-alist tramp-completion-file-name-handler tramp-file-name-handler) "tramp" "lisp/tramp.el")
-
-(defvar tramp-unified-filenames (not (featurep 'xemacs)) "\
-Non-nil means to use unified Ange-FTP/Tramp filename syntax.
-Nil means to use a separate filename syntax for Tramp.")
-
-(defconst tramp-file-name-regexp-unified "\\`/[^/:]+:" "\
-Value for `tramp-file-name-regexp' for unified remoting.
-Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
-Tramp.  See `tramp-file-name-structure-unified' for more explanations.")
-
-(defconst tramp-file-name-regexp-separate "\\`/\\[.*\\]" "\
-Value for `tramp-file-name-regexp' for separate remoting.
-XEmacs uses a separate filename syntax for Tramp and EFS.
-See `tramp-file-name-structure-separate' for more explanations.")
-
-(defcustom tramp-file-name-regexp (if tramp-unified-filenames tramp-file-name-regexp-unified tramp-file-name-regexp-separate) "*Regular expression matching file names handled by tramp.\nThis regexp should match tramp file names but no other file names.\n(When tramp.el is loaded, this regular expression is prepended to\n`file-name-handler-alist', and that is searched sequentially.  Thus,\nif the tramp entry appears rather early in the `file-name-handler-alist'\nand is a bit too general, then some files might be considered tramp\nfiles which are not really tramp files.\n\nPlease note that the entry in `file-name-handler-alist' is made when\nthis file (tramp.el) is loaded.  This means that this variable must be set\nbefore loading tramp.el.  Alternatively, `file-name-handler-alist' can be\nupdated after changing this variable.\n\nAlso see `tramp-file-name-structure'." :group 'tramp :type 'regexp)
-
-(defconst tramp-completion-file-name-regexp-unified "^/$\\|^/[^/:][^/]*$" "\
-Value for `tramp-completion-file-name-regexp' for unified remoting.
-Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
-Tramp.  See `tramp-file-name-structure-unified' for more explanations.")
-
-(defconst tramp-completion-file-name-regexp-separate "^/\\([[][^]]*\\)?$" "\
-Value for `tramp-completion-file-name-regexp' for separate remoting.
-XEmacs uses a separate filename syntax for Tramp and EFS.
-See `tramp-file-name-structure-separate' for more explanations.")
-
-(defcustom tramp-completion-file-name-regexp (if tramp-unified-filenames tramp-completion-file-name-regexp-unified tramp-completion-file-name-regexp-separate) "*Regular expression matching file names handled by tramp completion.\nThis regexp should match partial tramp file names only.\n\nPlease note that the entry in `file-name-handler-alist' is made when\nthis file (tramp.el) is loaded.  This means that this variable must be set\nbefore loading tramp.el.  Alternatively, `file-name-handler-alist' can be\nupdated after changing this variable.\n\nAlso see `tramp-file-name-structure'." :group 'tramp :type 'regexp)
-
-(autoload 'tramp-file-name-handler "tramp" "\
-Invoke Tramp file name handler.
-Falls back to normal file name handler if no tramp file name handler exists." nil nil)
-
-(autoload 'tramp-completion-file-name-handler "tramp" "\
-Invoke tramp file name completion handler.
-Falls back to normal file name handler if no tramp file name handler exists." nil nil)
-
-(put 'tramp-completion-file-name-handler 'safe-magic t)
-
-(add-to-list 'file-name-handler-alist (cons tramp-file-name-regexp 'tramp-file-name-handler))
-
-(autoload 'tramp-unload-file-name-handler-alist "tramp" nil nil nil)
-
-(autoload 'tramp-unload-tramp "tramp" nil t nil)
-
-;;;***
-
-(provide 'tramp-autoloads)
diff --git a/xemacs-packages/lisp/tramp/custom-load.el b/xemacs-packages/lisp/tramp/custom-load.el
deleted file mode 100644
index e64b9da3..00000000
--- a/xemacs-packages/lisp/tramp/custom-load.el
+++ /dev/null
@@ -1,10 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'files '("tramp"))
-(custom-add-loads 'tramp '("tramp" "tramp-ftp" "tramp-smb"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/tramp/tramp-efs.el b/xemacs-packages/lisp/tramp/tramp-efs.el
deleted file mode 100644
index f16122f7..00000000
--- a/xemacs-packages/lisp/tramp/tramp-efs.el
+++ /dev/null
@@ -1,237 +0,0 @@
-;;; -*- coding: iso-2022-7bit; -*-
-;;; tramp-efs.el --- Make EFS a foreign method in Tramp
-
-;; Copyright (C) 2003, 2004  Free Software Foundation, Inc.
-
-;; Author: Kai Gro,A_(Bjohann 
-;; Keywords: comm, processes
-
-;; 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
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This file provides glue between Tramp and EFS.  EFS is hooked into
-;; Tramp as a foreign method.  Most of this file has been snarfed from
-;; tramp-ftp.el, which does the same for Tramp and Ange-FTP.
-
-;;; Code:
-
-(require 'tramp)
-
-;; Avoid byte-compiler warnings.
-(eval-when-compile
-  (byte-compiler-options (warnings (- unused-vars))))
-
-(defvar tramp-efs-method "ftp"
-  "Name of the method invoking EFS.")
-
-;; The EFS name format is somewhat restricted.  EFS assumes that the
-;; first pair of parentheses is the user and the second is the host.
-;; It assumes that there is one character after the host name, and
-;; then the localname part follows.  See function `efs-ftp-path' for
-;; the code.  If the first pair of parentheses doesn't match anything,
-;; then it assumes that the user is not given.  Therefore, we need to
-;; be quite careful with the \(...\) constructs we use in our regexes.
-
-(defvar tramp-efs-method-given nil
-  "Method tag is given in filename.
-To be set in `tramp-efs-file-name-handler'.")
-
-(defvar tramp-efs-method-regexp
-  (concat tramp-prefix-regexp
-	  (regexp-quote tramp-efs-method)
-	  tramp-postfix-single-method-regexp)
-  "Regexp indicating method tag.")
-
-(defun tramp-efs-path-regexp ()
-  "Tramp uses this value for `efs-path-regexp'."
-  (concat tramp-prefix-regexp
-	  (when tramp-efs-method-given
-	    (concat
-	     (regexp-quote tramp-efs-method)
-	     tramp-postfix-single-method-regexp))
-	  "\\(" tramp-user-regexp tramp-postfix-user-regexp "\\)?"
-	  "\\(" tramp-host-with-port-regexp "\\)"
-	  tramp-postfix-host-regexp
-	  "\\(" tramp-localname-regexp "\\)"))
-
-(defun tramp-efs-path-format-string ()
-  "Tramp uses this value for `efs-path-format-string'."
-  (concat tramp-prefix-format
-	  (when tramp-efs-method-given
-	    (concat tramp-efs-method tramp-postfix-single-method-format))
-	  "%s" tramp-postfix-user-format
-	  "%s" tramp-postfix-host-format
-	  "%s"))
-
-(defun tramp-efs-path-format-without-user ()
-  "Tramp uses this value for `efs-path-format-without-user'."
-  (concat tramp-prefix-format
-	  (when tramp-efs-method-given
-	    (concat tramp-efs-method tramp-postfix-single-method-format))
-	  "%s" tramp-postfix-host-format
-	  "%s"))
-
-(defun tramp-efs-path-user-at-host-format ()
-  "Tramp uses this value for `efs-path-user-at-host-format'."
-  (concat "%s" tramp-postfix-user-format
-	  "%s" tramp-postfix-host-format))
-
-(defun tramp-efs-path-host-format ()
-  "Tramp uses this value for `efs-path-host-format'."
-  (concat "%s" tramp-postfix-host-format))
-
-(defun tramp-efs-path-root-regexp ()
-  "Tramp uses this value for `efs-path-root-regexp'."
-  (concat tramp-prefix-regexp
-	  (when tramp-efs-method-given
-	    (concat
-	     (regexp-quote tramp-efs-method)
-	     tramp-postfix-single-method-regexp))
-	  "\\(" tramp-user-regexp tramp-postfix-user-regexp "\\)?"
-	  "\\(" tramp-host-with-port-regexp "\\)"
-	  tramp-postfix-host-regexp))
-
-;; Still need to do efs-path-root-short-circuit-regexp.
-
-;; Disable EFS from file-name-handler-alist.
-
-;; There is still an entry for efs-sifn-handler-function
-;; in file-name-handler-alist that I don't know how to deal with.
-
-(defun tramp-disable-efs ()
-  "Turn EFS off.
-This is useful for unified remoting.  See
-`tramp-file-name-structure-unified' and
-`tramp-file-name-structure-separate' for details.  Requests
-suitable for EFS will be forwarded to EFS.  Also see the
-variables `tramp-efs-method', `tramp-default-method', and
-`tramp-default-method-alist'.
-
-This function is not needed in Emacsen which include Tramp, but is
-present for backward compatibility."
-  (let ((a1 (rassq 'efs-file-handler-function
-		   file-name-handler-alist))
-	(a2 (rassq 'efs-root-handler-function
-		   file-name-handler-alist))
-	(a3 (rassq 'remote-path-file-handler-function
-		   file-name-handler-alist)))
-    (setq file-name-handler-alist
-	  (delete a1 (delete a2 (delete a3 file-name-handler-alist))))))
-
-(tramp-disable-efs)
-
-(eval-after-load "efs" '(tramp-disable-efs))
-(eval-after-load "efs-fnh" '(tramp-disable-efs))
-
-;; Add EFS method to the method list.
-(add-to-list 'tramp-methods (cons tramp-efs-method nil))
-
-;; Add some defaults for `tramp-default-method-alist'
-(add-to-list 'tramp-default-method-alist
-	     (list "\\`ftp\\." "" tramp-efs-method))
-(add-to-list 'tramp-default-method-alist
-	     (list "" "\\`\\(anonymous\\|ftp\\)\\'" tramp-efs-method))
-
-;; Add all XEmacs download sites to `tramp-default-method-alist'.  The settings
-;; above should be sufficient, but it's better to make it explicitely.
-(when (listp package-get-download-sites)
-  (mapcar (lambda (x)
-	    (when (listp x)
-	      (add-to-list
-	       'tramp-default-method-alist
-	       (list (concat "\\`" (nth 1 x) "\\'")
-		     "\\`anonymous\\'" tramp-efs-method))))
-	  package-get-download-sites))
-
-;; Add completion function for FTP method.
-(unless (memq system-type '(windows-nt))
-  (tramp-set-completion-function
-   tramp-efs-method
-   '((tramp-parse-netrc "~/.netrc"))))
-
-(defun tramp-efs-file-name-handler (operation &rest args)
-  "Invoke the EFS handler for OPERATION	.
-First arg specifies the OPERATION, second args is a list of arguments to
-pass to the OPERATION			.	"
-  (save-match-data
-    (or (boundp 'efs-path-regexp)
-	(require 'efs-cu))
-
-    ;; Check whether the method is given in a filename.
-    (setq tramp-efs-method-given nil)
-    (mapcar (lambda (x)
-	      (and (stringp x)
-		   (string-match tramp-efs-method-regexp x)
-		   (setq tramp-efs-method-given t)))
-	    args)
-
-    (let ((efs-path-regexp              (tramp-efs-path-regexp))
-	  (efs-path-format-string       (tramp-efs-path-format-string))
-	  (efs-path-format-without-user (tramp-efs-path-format-without-user))
-	  (efs-path-user-at-host-format (tramp-efs-path-user-at-host-format))
-	  (efs-path-host-format         (tramp-efs-path-host-format))
-	  (efs-path-root-regexp         (tramp-efs-path-root-regexp)))
-      (cond
-       ;; If argument is a symlink, `file-directory-p' and
-       ;; `file-exists-p' call the traversed file recursively.  So we
-       ;; cannot disable the file-name-handler this case.
-       ((memq operation '(file-directory-p file-exists-p))
-	(apply 'efs-file-handler-function operation args))
-	;; Normally, the handlers must be discarded
-	(t (let* ((inhibit-file-name-handlers
-		   (list 'tramp-file-name-handler
-			 'tramp-completion-file-name-handler
-			 (and (eq inhibit-file-name-operation operation)
-			      inhibit-file-name-handlers)))
-		  (inhibit-file-name-operation operation))
-	     (apply 'efs-file-handler-function operation args)))))))
-
-;; This function is called even in case the filename doesn't fit Tramp
-;; syntax (see defadvice of `efs-dired-before-readin' and
-;; `efs-set-buffer-mode').  So a syntax check must be performed first;
-;; otherwise `tramp-dissect-file-name' returns with an error.
-(defun tramp-efs-file-name-p (filename)
-  "Check if it's a filename that should be forwarded to EFS."
-  (when (string-match (nth 0 tramp-file-name-structure) filename)
-    (let ((v (tramp-dissect-file-name filename)))
-      (string=
-       (tramp-find-method
-	(tramp-file-name-multi-method v)
-	(tramp-file-name-method v)
-	(tramp-file-name-user v)
-	(tramp-file-name-host v))
-       tramp-efs-method))))
-
-(add-to-list 'tramp-foreign-file-name-handler-alist
-	     (cons 'tramp-efs-file-name-p 'tramp-efs-file-name-handler))
-
-;; Deal with other EFS hooks.
-;; * dired-before-readin-hook contains efs-dired-before-readin
-;; * find-file-hooks contains efs-set-buffer-mode
-
-(defadvice efs-dired-before-readin (around tramp-efs activate)
-  "Do nothing for non-EFS names."
-  (when (tramp-efs-file-name-p default-directory)
-    ad-do-it))
-
-(defadvice efs-set-buffer-mode (around tramp-efs activate)
-  "Do nothing for non-EFS names."
-  (when (tramp-efs-file-name-p buffer-file-name)
-    ad-do-it))
-
-(provide 'tramp-efs)
-;;; tramp-efs.el ends here
diff --git a/xemacs-packages/lisp/tramp/tramp-ftp.el b/xemacs-packages/lisp/tramp/tramp-ftp.el
deleted file mode 100644
index 07a756c3..00000000
--- a/xemacs-packages/lisp/tramp/tramp-ftp.el
+++ /dev/null
@@ -1,141 +0,0 @@
-;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP and EFS -*- coding: iso-8859-1; -*-
-
-;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus 
-;; Keywords: comm, processes
-
-;; 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:
-
-;; Convenience functions for calling Ange-FTP (and maybe EFS, later on)
-;; from Tramp.  Most of them are displaced from tramp.el.
-
-;;; Code:
-
-(require 'tramp)
-
-(eval-when-compile
-  (require 'cl)
-  (require 'custom)
-  ;; Emacs 19.34 compatibility hack -- is this needed?
-  (or (>= emacs-major-version 20)
-      (load "cl-seq")))
-
-;; Disable Ange-FTP from file-name-handler-alist.
-;; To handle EFS, the following functions need to be dealt with:
-;;
-;; * dired-before-readin-hook contains efs-dired-before-readin
-;; * file-name-handler-alist contains efs-file-handler-function
-;;   and efs-root-handler-function and efs-sifn-handler-function
-;; * find-file-hooks contains efs-set-buffer-mode
-;;
-;; But it won't happen for EFS since the XEmacs maintainers
-;; don't want to use a unified filename syntax.
-(defun tramp-disable-ange-ftp ()
-  "Turn Ange-FTP off.
-This is useful for unified remoting.  See
-`tramp-file-name-structure-unified' and
-`tramp-file-name-structure-separate' for details.  Requests suitable
-for Ange-FTP will be forwarded to Ange-FTP.  Also see the variables
-`tramp-ftp-method', `tramp-default-method', and
-`tramp-default-method-alist'.
-
-This function is not needed in Emacsen which include Tramp, but is
-present for backward compatibility."
-  (let ((a1 (rassq 'ange-ftp-hook-function file-name-handler-alist))
-	(a2 (rassq 'ange-ftp-completion-hook-function file-name-handler-alist)))
-    (setq file-name-handler-alist
-	  (delete a1 (delete a2 file-name-handler-alist)))))
-(tramp-disable-ange-ftp)
-(eval-after-load "ange-ftp" '(tramp-disable-ange-ftp))
-
-;; Define FTP method ...
-(defcustom tramp-ftp-method "ftp"
-  "*When this method name is used, forward all calls to Ange-FTP."
-  :group 'tramp
-  :type 'string)
-
-;; ... and add it to the method list.
-(add-to-list 'tramp-methods (cons tramp-ftp-method nil))
-
-;; Add some defaults for `tramp-default-method-alist'
-(add-to-list 'tramp-default-method-alist
-	     (list "\\`ftp\\." "" tramp-ftp-method))
-(add-to-list 'tramp-default-method-alist
-	     (list "" "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
-
-;; Add completion function for FTP method.
-(unless (memq system-type '(windows-nt))
-  (tramp-set-completion-function
-   tramp-ftp-method
-   '((tramp-parse-netrc "~/.netrc"))))
-
-(defun tramp-ftp-file-name-handler (operation &rest args)
-  "Invoke the Ange-FTP handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
-  (save-match-data
-    (or (boundp 'ange-ftp-name-format)
-	(require 'ange-ftp))
-    (let ((ange-ftp-name-format
-	   (list (nth 0 tramp-file-name-structure)
-		 (nth 3 tramp-file-name-structure)
-		 (nth 2 tramp-file-name-structure)
-		 (nth 4 tramp-file-name-structure))))
-      (cond
-       ;; If argument is a symlink, 'file-directory-p` and 'file-exists-p`
-       ;; call the traversed file recursively. So we cannot disable the
-       ;; file-name-handler this case.
-       ((memq operation '(file-directory-p file-exists-p))
-	(apply 'ange-ftp-hook-function operation args))
-	;; Normally, the handlers must be discarded
-	(t (let* ((inhibit-file-name-handlers
-		   (list 'tramp-file-name-handler
-			 'tramp-completion-file-name-handler
-			 (and (eq inhibit-file-name-operation operation)
-			      inhibit-file-name-handlers)))
-		  (inhibit-file-name-operation operation))
-	     (apply 'ange-ftp-hook-function operation args)))))))
-
-(defun tramp-ftp-file-name-p (filename)
-  "Check if it's a filename that should be forwarded to Ange-FTP."
-  (let ((v (tramp-dissect-file-name filename)))
-    (string=
-     (tramp-find-method
-      (tramp-file-name-multi-method v)
-      (tramp-file-name-method v)
-      (tramp-file-name-user v)
-      (tramp-file-name-host v))
-     tramp-ftp-method)))
-
-(add-to-list 'tramp-foreign-file-name-handler-alist
-	     (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))
-
-(provide 'tramp-ftp)
-
-;;; TODO:
-
-;; * In case of "/ftp:host:file" this works only for functions which
-;;   are defined in `tramp-file-name-handler-alist'.  Call has to be
-;;   pretended in `tramp-file-name-handler' otherwise.
-;;   Furthermore, there are no backup files on FTP hosts.
-;;   Worth further investigations.
-
-;;; tramp-ftp.el ends here
diff --git a/xemacs-packages/lisp/tramp/tramp-smb.el b/xemacs-packages/lisp/tramp/tramp-smb.el
deleted file mode 100644
index 34bb388f..00000000
--- a/xemacs-packages/lisp/tramp/tramp-smb.el
+++ /dev/null
@@ -1,1056 +0,0 @@
-;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*-
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
-
-;; Author: Michael Albinus 
-;; Keywords: comm, processes
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Access functions for SMB servers like SAMBA or M$ Windows from Tramp.
-
-;;; Code:
-
-(require 'tramp)
-
-;; Pacify byte-compiler
-(eval-when-compile
-  (require 'cl)
-  (require 'custom)
-  ;; Emacs 19.34 compatibility hack -- is this needed?
-  (or (>= emacs-major-version 20)
-      (load "cl-seq")))
-
-;; Avoid byte-compiler warnings if the byte-compiler supports this.
-;; Currently, XEmacs supports this.
-(eval-when-compile
-  (when (fboundp 'byte-compiler-options)
-    (let (unused-vars) ; Pacify Emacs byte-compiler
-      (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
-      (byte-compiler-options (warnings (- unused-vars))))))
-
-;; Define SMB method ...
-(defcustom tramp-smb-method "smb"
-  "*Method to connect SAMBA and M$ SMB servers."
-  :group 'tramp
-  :type 'string)
-
-;; ... and add it to the method list.
-(add-to-list 'tramp-methods (cons tramp-smb-method nil))
-
-;; Add a default for `tramp-default-method-alist'. Rule: If there is
-;; a domain in USER, it must be the SMB method.
-(add-to-list 'tramp-default-method-alist
-	     (list "" "%" tramp-smb-method))
-
-;; Add completion function for SMB method.
-(tramp-set-completion-function
- tramp-smb-method
- '((tramp-parse-netrc "~/.netrc")))
-
-(defcustom tramp-smb-program "smbclient"
-  "*Name of SMB client to run."
-  :group 'tramp
-  :type 'string)
-
-(defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
-  "Regexp used as prompt in smbclient.")
-
-(defconst tramp-smb-errors
-  (mapconcat
-   'identity
-   '(; Connection error
-     "Connection to \\S-+ failed"
-     ; Samba
-     "ERRDOS"
-     "ERRSRV"
-     "ERRbadfile"
-     "ERRbadpw"
-     "ERRfilexists"
-     "ERRnoaccess"
-     "ERRnomem"
-     "ERRnosuchshare"
-     ; Windows NT 4.0, Windows 5.0 (Windows 2000), Windows 5.1 (Windows XP)
-     "NT_STATUS_ACCESS_DENIED"
-     "NT_STATUS_ACCOUNT_LOCKED_OUT"
-     "NT_STATUS_BAD_NETWORK_NAME"
-     "NT_STATUS_CANNOT_DELETE"
-     "NT_STATUS_LOGON_FAILURE"
-     "NT_STATUS_NETWORK_ACCESS_DENIED"
-     "NT_STATUS_NO_SUCH_FILE"
-     "NT_STATUS_OBJECT_NAME_INVALID"
-     "NT_STATUS_OBJECT_NAME_NOT_FOUND"
-     "NT_STATUS_SHARING_VIOLATION"
-     "NT_STATUS_WRONG_PASSWORD")
-   "\\|")
-  "Regexp for possible error strings of SMB servers.
-Used instead of analyzing error codes of commands.")
-
-(defvar tramp-smb-share nil
-  "Holds the share name for the current buffer.
-This variable is local to each buffer.")
-(make-variable-buffer-local 'tramp-smb-share)
-
-(defvar tramp-smb-share-cache nil
-  "Caches the share names accessible to host related to the current buffer.
-This variable is local to each buffer.")
-(make-variable-buffer-local 'tramp-smb-share-cache)
-
-(defvar tramp-smb-inodes nil
-  "Keeps virtual inodes numbers for SMB files.")
-
-;; New handlers should be added here.
-(defconst tramp-smb-file-name-handler-alist
-  '(
-    ;; `access-file' performed by default handler
-    (add-name-to-file . tramp-smb-handle-copy-file) ;; we're on Windows, honey.
-    ;; `byte-compiler-base-file-name' performed by default handler
-    (copy-file . tramp-smb-handle-copy-file)
-    (delete-directory . tramp-smb-handle-delete-directory)
-    (delete-file . tramp-smb-handle-delete-file)
-    ;; `diff-latest-backup-file' performed by default handler
-    (directory-file-name . tramp-handle-directory-file-name)
-    (directory-files . tramp-smb-handle-directory-files)
-    (directory-files-and-attributes . tramp-smb-handle-directory-files-and-attributes)
-    (dired-call-process . tramp-smb-not-handled)
-    (dired-compress-file . tramp-smb-not-handled)
-    ;; `dired-uncache' performed by default handler
-    ;; `expand-file-name' not necessary because we cannot expand "~/"
-    (file-accessible-directory-p . tramp-smb-handle-file-directory-p)
-    (file-attributes . tramp-smb-handle-file-attributes)
-    (file-directory-p .  tramp-smb-handle-file-directory-p)
-    (file-executable-p . tramp-smb-handle-file-exists-p)
-    (file-exists-p . tramp-smb-handle-file-exists-p)
-    (file-local-copy . tramp-smb-handle-file-local-copy)
-    (file-remote-p . tramp-handle-file-remote-p)
-    (file-modes . tramp-handle-file-modes)
-    (file-name-all-completions . tramp-smb-handle-file-name-all-completions)
-    ;; `file-name-as-directory' performed by default handler
-    (file-name-completion . tramp-handle-file-name-completion)
-    (file-name-directory . tramp-handle-file-name-directory)
-    (file-name-nondirectory . tramp-handle-file-name-nondirectory)
-    ;; `file-name-sans-versions' performed by default handler
-    (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p)
-    (file-ownership-preserved-p . tramp-smb-not-handled)
-    (file-readable-p . tramp-smb-handle-file-exists-p)
-    (file-regular-p . tramp-handle-file-regular-p)
-    (file-symlink-p . tramp-smb-not-handled)
-    ;; `file-truename' performed by default handler
-    (file-writable-p . tramp-smb-handle-file-writable-p)
-    (find-backup-file-name . tramp-handle-find-backup-file-name)
-    ;; `find-file-noselect' performed by default handler
-    ;; `get-file-buffer' performed by default handler
-    (insert-directory . tramp-smb-handle-insert-directory)
-    (insert-file-contents . tramp-handle-insert-file-contents)
-    (load . tramp-handle-load)
-    (make-directory . tramp-smb-handle-make-directory)
-    (make-directory-internal . tramp-smb-handle-make-directory-internal)
-    (make-symbolic-link . tramp-smb-not-handled)
-    (rename-file . tramp-smb-handle-rename-file)
-    (set-file-modes . tramp-smb-not-handled)
-    (set-visited-file-modtime . tramp-smb-not-handled)
-    (shell-command . tramp-smb-not-handled)
-    (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
-    (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
-    (vc-registered . tramp-smb-not-handled)
-    (verify-visited-file-modtime . tramp-smb-not-handled)
-    (write-region . tramp-smb-handle-write-region)
-)
-  "Alist of handler functions for Tramp SMB method.
-Operations not mentioned here will be handled by the default Emacs primitives.")
-
-(defun tramp-smb-file-name-p (filename)
-  "Check if it's a filename for SMB servers."
-  (let ((v (tramp-dissect-file-name filename)))
-    (string=
-     (tramp-find-method
-      (tramp-file-name-multi-method v)
-      (tramp-file-name-method v)
-      (tramp-file-name-user v)
-      (tramp-file-name-host v))
-     tramp-smb-method)))
-
-(defun tramp-smb-file-name-handler (operation &rest args)
-  "Invoke the SMB related OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
-  (let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
-    (if fn
-	(if (eq (cdr fn) 'tramp-smb-not-handled)
-	    (apply (cdr fn) operation args)
-	  (save-match-data (apply (cdr fn) args)))
-      (tramp-run-real-handler operation args))))
-
-(add-to-list 'tramp-foreign-file-name-handler-alist
-	     (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))
-
-
-;; File name primitives
-
-(defun tramp-smb-not-handled (operation &rest args)
-  "Default handler for all functions which are disrecarded."
-  (tramp-message 10 "Won't be handled: %s %s" operation args)
-  nil)
-
-(defun tramp-smb-handle-copy-file
-  (filename newname &optional ok-if-already-exists keep-date)
-  "Like `copy-file' for tramp files.
-KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
-  (setq filename (expand-file-name filename)
-	newname (expand-file-name newname))
-
-  (let ((tmpfile (file-local-copy filename)))
-
-    (if tmpfile
-	;; remote filename
-	(rename-file tmpfile newname ok-if-already-exists)
-
-      ;; remote newname
-      (when (file-directory-p newname)
-	(setq newname (expand-file-name
-		       (file-name-nondirectory filename) newname)))
-      (when (and (not ok-if-already-exists)
-		 (file-exists-p newname))
-	(error "copy-file: file %s already exists" newname))
-
-      (with-parsed-tramp-file-name newname nil
-	(save-excursion
-	  (let ((share (tramp-smb-get-share localname))
-		(file (tramp-smb-get-localname localname t)))
-	    (unless share
-	      (error "Target `%s' must contain a share name" filename))
-	    (tramp-smb-maybe-open-connection user host share)
-	    (tramp-message-for-buffer
-	     nil tramp-smb-method user host
-	     5 "Copying file %s to file %s..." filename newname)
-	    (if (tramp-smb-send-command
-		 user host (format "put %s \"%s\"" filename file))
-		(tramp-message-for-buffer
-		 nil tramp-smb-method user host
-		 5 "Copying file %s to file %s...done" filename newname)
-	      (error "Cannot copy `%s'" filename))))))))
-
-(defun tramp-smb-handle-delete-directory (directory)
-  "Like `delete-directory' for tramp files."
-  (setq directory (directory-file-name (expand-file-name directory)))
-  (when (file-exists-p directory)
-    (with-parsed-tramp-file-name directory nil
-      (save-excursion
-	(let ((share (tramp-smb-get-share localname))
-	      (dir (tramp-smb-get-localname (file-name-directory localname) t))
-	      (file (file-name-nondirectory localname)))
-	  (tramp-smb-maybe-open-connection user host share)
-	  (if (and
-	       (tramp-smb-send-command user host (format "cd \"%s\"" dir))
-	       (tramp-smb-send-command user host (format "rmdir \"%s\"" file)))
-	      ;; Go Home
-	      (tramp-smb-send-command user host (format "cd \\"))
-	    ;; Error
-	    (tramp-smb-send-command user host (format "cd \\"))
-	    (error "Cannot delete directory `%s'" directory)))))))
-
-(defun tramp-smb-handle-delete-file (filename)
-  "Like `delete-file' for tramp files."
-  (setq filename (expand-file-name filename))
-  (when (file-exists-p filename)
-    (with-parsed-tramp-file-name filename nil
-      (save-excursion
-	(let ((share (tramp-smb-get-share localname))
-	      (dir (tramp-smb-get-localname (file-name-directory localname) t))
-	      (file (file-name-nondirectory localname)))
-	  (tramp-smb-maybe-open-connection user host share)
-	  (if (and
-	       (tramp-smb-send-command user host (format "cd \"%s\"" dir))
-	       (tramp-smb-send-command user host (format "rm \"%s\"" file)))
-	      ;; Go Home
-	      (tramp-smb-send-command user host (format "cd \\"))
-	    ;; Error
-	    (tramp-smb-send-command user host (format "cd \\"))
-	    (error "Cannot delete file `%s'" filename)))))))
-
-(defun tramp-smb-handle-directory-files
-  (directory &optional full match nosort)
-  "Like `directory-files' for tramp files."
-  (setq directory (directory-file-name (expand-file-name directory)))
-  (with-parsed-tramp-file-name directory nil
-    (save-excursion
-      (let* ((share (tramp-smb-get-share localname))
-	     (file (tramp-smb-get-localname localname nil))
-	     (entries (tramp-smb-get-file-entries user host share file)))
-	;; Just the file names are needed
-	(setq entries (mapcar 'car entries))
-	;; Discriminate with regexp
-	(when match
-	  (setq entries
-		(delete nil
-			(mapcar (lambda (x) (when (string-match match x) x))
-				entries))))
-	;; Make absolute localnames if necessary
-	(when full
-	  (setq entries
-		(mapcar (lambda (x)
-			  (concat (file-name-as-directory directory) x))
-			entries)))
-	;; Sort them if necessary
-	(unless nosort (setq entries (sort entries 'string-lessp)))
-	;; That's it
-	entries))))
-
-(defun tramp-smb-handle-directory-files-and-attributes
-  (directory &optional full match nosort id-format)
-  "Like `directory-files-and-attributes' for tramp files."
-  (mapcar
-   (lambda (x)
-     ;; We cannot call `file-attributes' for backward compatibility reasons.
-     ;; Its optional parameter ID-FORMAT is introduced with Emacs 22.
-     (cons x (tramp-smb-handle-file-attributes
-	(if full x (concat (file-name-as-directory directory) x)) id-format)))
-   (directory-files directory full match nosort)))
-
-(defun tramp-smb-handle-file-attributes (filename &optional id-format)
-  "Like `file-attributes' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (save-excursion
-      (let* ((share (tramp-smb-get-share localname))
-	     (file (tramp-smb-get-localname localname nil))
-	     (entries (tramp-smb-get-file-entries user host share file))
-	     (entry (and entries
-			 (assoc (file-name-nondirectory file) entries)))
-	     (uid (if (and id-format (equal id-format 'string)) "nobody" -1))
-	     (gid (if (and id-format (equal id-format 'string)) "nogroup" -1))
-	     (inode (tramp-smb-get-inode share file))
-	     (device (tramp-get-device nil tramp-smb-method user host)))
-
-	; check result
-	(when entry
-	  (list (and (string-match "d" (nth 1 entry))
-		     t)         ;0 file type
-		-1		;1 link count
-		uid		;2 uid
-		gid		;3 gid
-		'(0 0)		;4 atime
-		(nth 3 entry)	;5 mtime
-		'(0 0)		;6 ctime
-		(nth 2 entry)   ;7 size
-		(nth 1 entry)   ;8 mode
-		nil		;9 gid weird
-		inode		;10 inode number
-		device))))))	;11 file system number
-
-(defun tramp-smb-handle-file-directory-p (filename)
-  "Like `file-directory-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (save-excursion
-      (let* ((share (tramp-smb-get-share localname))
-	     (file (tramp-smb-get-localname localname nil))
-	     (entries (tramp-smb-get-file-entries user host share file))
-	     (entry (and entries
-			 (assoc (file-name-nondirectory file) entries))))
-	(and entry
-	     (string-match "d" (nth 1 entry))
-	     t)))))
-
-(defun tramp-smb-handle-file-exists-p (filename)
-  "Like `file-exists-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (save-excursion
-      (let* ((share (tramp-smb-get-share localname))
-	     (file (tramp-smb-get-localname localname nil))
-	     (entries (tramp-smb-get-file-entries user host share file)))
-	(and entries
-	     (member (file-name-nondirectory file) (mapcar 'car entries))
-	     t)))))
-
-(defun tramp-smb-handle-file-local-copy (filename)
-  "Like `file-local-copy' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (save-excursion
-      (let ((share (tramp-smb-get-share localname))
-	    (file (tramp-smb-get-localname localname t))
-	    (tmpfil (tramp-make-temp-file)))
-	(unless (file-exists-p filename)
-	  (error "Cannot make local copy of non-existing file `%s'" filename))
-	(tramp-message-for-buffer
-	 nil tramp-smb-method user host
-	 5 "Fetching %s to tmp file %s..." filename tmpfil)
-	(tramp-smb-maybe-open-connection user host share)
-	(if (tramp-smb-send-command
-	     user host (format "get \"%s\" %s" file tmpfil))
-	    (tramp-message-for-buffer
-	     nil tramp-smb-method user host
-	     5 "Fetching %s to tmp file %s...done" filename tmpfil)
-	  (error "Cannot make local copy of file `%s'" filename))
-	tmpfil))))
-
-;; This function should return "foo/" for directories and "bar" for
-;; files.
-(defun tramp-smb-handle-file-name-all-completions (filename directory)
-  "Like `file-name-all-completions' for tramp files."
-  (with-parsed-tramp-file-name directory nil
-    (save-match-data
-      (save-excursion
-	(let* ((share (tramp-smb-get-share localname))
-	       (file (tramp-smb-get-localname localname nil))
-	       (entries (tramp-smb-get-file-entries user host share file)))
-
-	  (all-completions
-	   filename
-	   (mapcar
-	    (lambda (x)
-	      (list
-	       (if (string-match "d" (nth 1 x))
-		   (file-name-as-directory (nth 0 x))
-		 (nth 0 x))))
-	    entries)))))))
-
-(defun tramp-smb-handle-file-newer-than-file-p (file1 file2)
-  "Like `file-newer-than-file-p' for tramp files."
-  (cond
-   ((not (file-exists-p file1)) nil)
-   ((not (file-exists-p file2)) t)
-   (t (tramp-smb-time-less-p (file-attributes file2)
-			     (file-attributes file1)))))
-
-(defun tramp-smb-handle-file-writable-p (filename)
-  "Like `file-writable-p' for tramp files."
-  (if (not (file-exists-p filename))
-      (let ((dir (file-name-directory filename)))
-	(and (file-exists-p dir)
-	     (file-writable-p dir)))
-    (with-parsed-tramp-file-name filename nil
-      (save-excursion
-	(let* ((share (tramp-smb-get-share localname))
-	       (file (tramp-smb-get-localname localname nil))
-	       (entries (tramp-smb-get-file-entries user host share file))
-	       (entry (and entries
-			   (assoc (file-name-nondirectory file) entries))))
-	  (and share entry
-	       (string-match "w" (nth 1 entry))
-	       t))))))
-
-(defun tramp-smb-handle-insert-directory
-  (filename switches &optional wildcard full-directory-p)
-  "Like `insert-directory' for tramp files.
-WILDCARD and FULL-DIRECTORY-P are not handled."
-  (setq filename (expand-file-name filename))
-  (when (file-directory-p filename)
-    ;; This check is a little bit strange, but in `dired-add-entry'
-    ;; this function is called with a non-directory ...
-    (setq filename (file-name-as-directory filename)))
-  (with-parsed-tramp-file-name filename nil
-    (save-match-data
-      (let* ((share (tramp-smb-get-share localname))
-	     (file (tramp-smb-get-localname localname nil))
-	     (entries (tramp-smb-get-file-entries user host share file)))
-
-	;; Delete dummy "" entry, useless entries
-	(setq entries
-	      (if (file-directory-p filename)
-		  (delq (assoc "" entries) entries)
-		;; We just need the only and only entry FILENAME.
-		(list (assoc (file-name-nondirectory filename) entries))))
-
-	;; Sort entries
-	(setq entries
-	      (sort
-	       entries
-	       (lambda (x y)
-		 (if (string-match "t" switches)
-		     ; sort by date
-		     (tramp-smb-time-less-p (nth 3 y) (nth 3 x))
-		   ; sort by name
-		   (string-lessp (nth 0 x) (nth 0 y))))))
-
-	;; Print entries
-	(mapcar
-	 (lambda (x)
-	   (insert
-	    (format
-	     "%10s %3d %-8s %-8s %8s %s %s\n"
-	     (nth 1 x) ; mode
-	     1 "nobody" "nogroup"
-	     (nth 2 x) ; size
-	     (format-time-string
-	      (if (tramp-smb-time-less-p
-		   (tramp-smb-time-subtract (current-time) (nth 3 x))
-		   tramp-smb-half-a-year)
-		  "%b %e %R"
-		"%b %e  %Y")
-	      (nth 3 x)) ; date
-	     (nth 0 x))) ; file name
-	   (forward-line)
-	   (beginning-of-line))
-	 entries)))))
-
-(defun tramp-smb-handle-make-directory (dir &optional parents)
-  "Like `make-directory' for tramp files."
-  (setq dir (directory-file-name (expand-file-name dir)))
-  (unless (file-name-absolute-p dir)
-    (setq dir (concat default-directory dir)))
-  (with-parsed-tramp-file-name dir nil
-    (save-match-data
-      (let* ((share (tramp-smb-get-share localname))
-	     (ldir (file-name-directory dir)))
-	;; Make missing directory parts
-	(when (and parents share (not (file-directory-p ldir)))
-	  (make-directory ldir parents))
-	;; Just do it
-	(when (file-directory-p ldir)
-	  (make-directory-internal dir))
-	(unless (file-directory-p dir)
-	  (error "Couldn't make directory %s" dir))))))
-
-(defun tramp-smb-handle-make-directory-internal (directory)
-  "Like `make-directory-internal' for tramp files."
-  (setq directory (directory-file-name (expand-file-name directory)))
-  (unless (file-name-absolute-p directory)
-    (setq directory (concat default-directory directory)))
-  (with-parsed-tramp-file-name directory nil
-    (save-match-data
-      (let* ((share (tramp-smb-get-share localname))
-	     (file (tramp-smb-get-localname localname nil)))
-	(when (file-directory-p (file-name-directory directory))
-	  (tramp-smb-maybe-open-connection user host share)
-	  (tramp-smb-send-command user host (format "mkdir \"%s\"" file)))
-	(unless (file-directory-p directory)
-	  (error "Couldn't make directory %s" directory))))))
-
-(defun tramp-smb-handle-rename-file
-  (filename newname &optional ok-if-already-exists)
-  "Like `rename-file' for tramp files."
-  (setq filename (expand-file-name filename)
-	newname (expand-file-name newname))
-
-  (let ((tmpfile (file-local-copy filename)))
-
-    (if tmpfile
-	;; remote filename
-	(rename-file tmpfile newname ok-if-already-exists)
-
-      ;; remote newname
-      (when (file-directory-p newname)
-	(setq newname (expand-file-name
-		      (file-name-nondirectory filename) newname)))
-      (when (and (not ok-if-already-exists)
-		 (file-exists-p newname))
-	  (error "rename-file: file %s already exists" newname))
-
-      (with-parsed-tramp-file-name newname nil
-	(save-excursion
-	  (let ((share (tramp-smb-get-share localname))
-		(file (tramp-smb-get-localname localname t)))
-	    (tramp-smb-maybe-open-connection user host share)
-	    (tramp-message-for-buffer
-	     nil tramp-smb-method user host
-	     5 "Copying file %s to file %s..." filename newname)
-	    (if (tramp-smb-send-command
-		 user host (format "put %s \"%s\"" filename file))
-		(tramp-message-for-buffer
-		 nil tramp-smb-method user host
-		 5 "Copying file %s to file %s...done" filename newname)
-	      (error "Cannot rename `%s'" filename)))))))
-
-  (delete-file filename))
-
-(defun tramp-smb-handle-substitute-in-file-name (filename)
-  "Like `handle-substitute-in-file-name' for tramp files.
-Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
-  (condition-case nil
-      (tramp-run-real-handler 'substitute-in-file-name (list filename))
-    (error filename)))
-
-(defun tramp-smb-handle-write-region
-  (start end filename &optional append visit lockname confirm)
-  "Like `write-region' for tramp files."
-  (unless (eq append nil)
-    (error "Cannot append to file using tramp (`%s')" filename))
-  (setq filename (expand-file-name filename))
-  ;; XEmacs takes a coding system as the seventh argument, not `confirm'
-  (when (and (not (featurep 'xemacs))
-	     confirm (file-exists-p filename))
-    (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
-                              filename))
-      (error "File not overwritten")))
-  (with-parsed-tramp-file-name filename nil
-    (save-excursion
-      (let ((share (tramp-smb-get-share localname))
-	    (file (tramp-smb-get-localname localname t))
-	    (curbuf (current-buffer))
-	    tmpfil)
-	;; Write region into a tmp file.
-	(setq tmpfil (tramp-make-temp-file))
-	;; We say `no-message' here because we don't want the visited file
-	;; modtime data to be clobbered from the temp file.  We call
-	;; `set-visited-file-modtime' ourselves later on.
-	(tramp-run-real-handler
-	 'write-region
-	 (if confirm ; don't pass this arg unless defined for backward compat.
-	     (list start end tmpfil append 'no-message lockname confirm)
-	   (list start end tmpfil append 'no-message lockname)))
-
-	(tramp-smb-maybe-open-connection user host share)
-	(tramp-message-for-buffer
-	 nil tramp-smb-method user host
-	 5 "Writing tmp file %s to file %s..." tmpfil filename)
-	(if (tramp-smb-send-command
-	     user host (format "put %s \"%s\"" tmpfil file))
-	    (tramp-message-for-buffer
-	     nil tramp-smb-method user host
-	     5 "Writing tmp file %s to file %s...done" tmpfil filename)
-	  (error "Cannot write `%s'" filename))
-
-	(delete-file tmpfil)
-	(unless (equal curbuf (current-buffer))
-	  (error "Buffer has changed from `%s' to `%s'"
-		 curbuf (current-buffer)))
-	(when (eq visit t)
-	  (set-visited-file-modtime))))))
-
-
-;; Internal file name functions
-
-(defun tramp-smb-get-share (localname)
-  "Returns the share name of LOCALNAME."
-  (save-match-data
-    (when (string-match "^/?\\([^/]+\\)/" localname)
-      (match-string 1 localname))))
-
-(defun tramp-smb-get-localname (localname convert)
-  "Returns the file name of LOCALNAME.
-If CONVERT is non-nil exchange \"/\" by \"\\\\\"."
-  (save-match-data
-    (let ((res localname))
-
-      (setq
-       res (if (string-match "^/?[^/]+/\\(.*\\)" res)
-	       (if convert
-		   (mapconcat
-		    (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
-		    (match-string 1 res) "")
-		 (match-string 1 res))
-	     (if (string-match "^/?\\([^/]+\\)$" res)
-		 (match-string 1 res)
-	       "")))
-
-      ;; Sometimes we have discarded `substitute-in-file-name'
-      (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res)
-	(setq res (replace-match "$" nil nil res 1)))
-
-      res)))
-
-;; Share names of a host are cached. It is very unlikely that the
-;; shares do change during connection.
-(defun tramp-smb-get-file-entries (user host share localname)
-  "Read entries which match LOCALNAME.
-Either the shares are listed, or the `dir' command is executed.
-Only entries matching the localname are returned.
-Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
-  (save-excursion
-    (save-match-data
-      (let ((base (or (and (> (length localname) 0)
-			   (string-match "\\([^/]+\\)$" localname)
-			   (regexp-quote (match-string 1 localname)))
-		      ""))
-	    res entry)
-	(set-buffer (tramp-get-buffer nil tramp-smb-method user host))
-	(if (and (not share) tramp-smb-share-cache)
-	    ;; Return cached shares
-	    (setq res tramp-smb-share-cache)
-	  ;; Read entries
-	  (tramp-smb-maybe-open-connection user host share)
-	  (when share
-	    (tramp-smb-send-command
-	     user host
-	     (format "dir %s"
-		     (if (zerop (length localname)) "" (concat "\"" localname "*\"")))))
-	  (goto-char (point-min))
-	  ;; Loop the listing
-	  (unless (re-search-forward tramp-smb-errors nil t)
-	    (while (not (eobp))
-	      (setq entry (tramp-smb-read-file-entry share))
-	      (forward-line)
-	      (when entry (add-to-list 'res entry))))
-	  (unless share
-	    ;; Cache share entries
-	    (setq tramp-smb-share-cache res)))
-
-	;; Add directory itself
-	(add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
-
-	;; There's a very strange error (debugged with XEmacs 21.4.14)
-	;; If there's no short delay, it returns nil.  No idea about
-	(when (featurep 'xemacs) (sleep-for 0.01))
-
-	;; Check for matching entries
-	(delq nil (mapcar
-		   (lambda (x) (and (string-match base (nth 0 x)) x))
-		   res))))))
-
-;; Return either a share name (if SHARE is nil), or a file name
-;;
-;; If shares are listed, the following format is expected
-;;
-;; \s-\{8,8}                              - leading spaces
-;; \S-\(.*\S-\)\s-*                       - share name, 14 char
-;; \s-                                    - space delimeter
-;; \S-+\s-*                               - type, 8 char, "Disk    " expected
-;; \(\s-\{2,2\}.*\)?                      - space delimeter, comment
-;;
-;; Entries provided by smbclient DIR aren't fully regular.
-;; They should have the format
-;;
-;; \s-\{2,2}                              - leading spaces
-;; \S-\(.*\S-\)\s-*                       - file name, 30 chars, left bound
-;; \s-+[ADHRSV]*                          - permissions, 7 chars, right bound
-;; \s-                                    - space delimeter
-;; \s-+[0-9]+                             - size, 8 chars, right bound
-;; \s-\{2,2\}                             - space delimeter
-;; \w\{3,3\}                              - weekday
-;; \s-                                    - space delimeter
-;; \w\{3,3\}                              - month
-;; \s-                                    - space delimeter
-;; [ 19][0-9]                             - day
-;; \s-                                    - space delimeter
-;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time
-;; \s-                                    - space delimeter
-;; [0-9]\{4,4\}                           - year
-;;
-;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html)
-;; has function display_finfo:
-;;
-;;   d_printf("  %-30s%7.7s %8.0f  %s",
-;;            finfo->name,
-;;            attrib_string(finfo->mode),
-;;            (double)finfo->size,
-;;            asctime(LocalTime(&t)));
-;;
-;; in Samba 1.9, there's the following code:
-;;
-;;   DEBUG(0,("  %-30s%7.7s%10d  %s",
-;;  	   CNV_LANG(finfo->name),
-;;	   attrib_string(finfo->mode),
-;;	   finfo->size,
-;;	   asctime(LocalTime(&t))));
-;;
-;; Problems:
-;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
-;;   available in older Emacsen.
-;; * The length of constructs (file name, size) might exceed the default.
-;; * File names might contain spaces.
-;; * Permissions might be empty.
-;;
-;; So we try to analyze backwards.
-(defun tramp-smb-read-file-entry (share)
-  "Parse entry in SMB output buffer.
-If SHARE is result, entries are of type dir. Otherwise, shares are listed.
-Result is the list (LOCALNAME MODE SIZE MTIME)."
-  (let ((line (buffer-substring (point) (tramp-point-at-eol)))
-	localname mode size month day hour min sec year mtime)
-
-    (if (not share)
-
-	; Read share entries
-	(when (string-match "^\\s-+\\(\\S-+\\)\\s-+Disk" line)
-	  (setq localname (match-string 1 line)
-		mode "dr-xr-xr-x"
-		size 0))
-
-      ; Real listing
-      (block nil
-
-	;; year
-	(if (string-match "\\([0-9]+\\)$" line)
-	    (setq year (string-to-number (match-string 1 line))
-		  line (substring line 0 -5))
-	  (return))
-
-	;; time
-	(if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line)
-	    (setq hour (string-to-number (match-string 1 line))
-		  min  (string-to-number (match-string 2 line))
-		  sec  (string-to-number (match-string 3 line))
-		  line (substring line 0 -9))
-	  (return))
-
-	;; day
-	(if (string-match "\\([0-9]+\\)$" line)
-	    (setq day  (string-to-number (match-string 1 line))
-		  line (substring line 0 -3))
-	  (return))
-
-	;; month
-	(if (string-match "\\(\\w+\\)$" line)
-	    (setq month (match-string 1 line)
-		  line  (substring line 0 -4))
-	  (return))
-
-	;; weekday
-	(if (string-match "\\(\\w+\\)$" line)
-	    (setq line (substring line 0 -5))
-	  (return))
-
-	;; size
-	(if (string-match "\\([0-9]+\\)$" line)
-	    (let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
-	      (setq size (string-to-number (match-string 1 line)))
-	      (when (string-match "\\([ADHRSV]+\\)" (substring line length))
-		(setq length (+ length (match-end 0))))
-	      (setq line (substring line 0 length)))
-	  (return))
-
-	;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID
-	(if (string-match "\\([ADHRSV]+\\)?$" line)
-	    (setq
-	     mode (or (match-string 1 line) "")
-	     mode (save-match-data (format
-		    "%s%s"
-		    (if (string-match "D" mode) "d" "-")
-		    (mapconcat
-		     (lambda (x) "") "    "
-		     (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
-	     line (substring line 0 -7))
-	  (return))
-
-	;; localname
-	(if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
-	    (setq localname (match-string 1 line))
-	  (return))))
-
-    (when (and localname mode size)
-      (setq mtime
-	    (if (and sec min hour day month year)
-		(encode-time
-		 sec min hour day
-		 (cdr (assoc (downcase month) tramp-smb-parse-time-months))
-		 year)
-	      '(0 0)))
-      (list localname mode size mtime))))
-
-;; Inodes don't exist for SMB files.  Therefore we must generate virtual ones.
-;; Used in `find-buffer-visiting'.
-;; The method applied might be not so efficient (Ange-FTP uses hashes). But
-;; performance isn't the major issue given that file transfer will take time.
-
-(defun tramp-smb-get-inode (share file)
-  "Returns the virtual inode number.
-If it doesn't exist, generate a new one."
-  (let ((string (concat share "/" (directory-file-name file))))
-    (unless (assoc string tramp-smb-inodes)
-      (add-to-list 'tramp-smb-inodes
-		   (list string (length tramp-smb-inodes))))
-    (nth 1 (assoc string tramp-smb-inodes))))
-
-
-;; Connection functions
-
-(defun tramp-smb-send-command (user host command)
-  "Send the COMMAND to USER at HOST (logged into an SMB session).
-Erases temporary buffer before sending the command.  Returns nil if
-there has been an error message from smbclient."
-  (save-excursion
-    (set-buffer (tramp-get-buffer nil tramp-smb-method user host))
-    (erase-buffer)
-    (tramp-send-command nil tramp-smb-method user host command nil t)
-    (tramp-smb-wait-for-output user host)))
-
-(defun tramp-smb-maybe-open-connection (user host share)
-  "Maybe open a connection to HOST, logging in as USER, using `tramp-smb-program'.
-Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
-  (let ((process-connection-type tramp-process-connection-type)
-	(p (get-buffer-process
-	    (tramp-get-buffer nil tramp-smb-method user host))))
-    (save-excursion
-      (set-buffer (tramp-get-buffer nil tramp-smb-method user host))
-      ;; Check whether it is still the same share
-      (unless (and p (processp p) (string-equal tramp-smb-share share))
-	(when (and p (processp p))
-	  (delete-process p)
-	  (setq p nil)))
-      ;; If too much time has passed since last command was sent, look
-      ;; whether process is still alive.  If it isn't, kill it.
-      (when (and tramp-last-cmd-time
-		 (> (tramp-time-diff (current-time) tramp-last-cmd-time) 60)
-		 p (processp p) (memq (process-status p) '(run open)))
-	(unless (and p (processp p) (memq (process-status p) '(run open)))
-	  (delete-process p)
-	  (setq p nil))))
-    (unless (and p (processp p) (memq (process-status p) '(run open)))
-      (when (and p (processp p))
-        (delete-process p))
-      (tramp-smb-open-connection user host share))))
-
-(defun tramp-smb-open-connection (user host share)
-  "Open a connection using `tramp-smb-program'.
-This starts the command `smbclient //HOST/SHARE -U USER', then waits
-for a remote password prompt.  It queries the user for the password,
-then sends the password to the remote host.
-
-Domain names in USER and port numbers in HOST are acknowledged."
-
-  (when (and (fboundp 'executable-find)
-	     (not (funcall 'executable-find tramp-smb-program)))
-    (error "Cannot find command %s in %s" tramp-smb-program exec-path))
-
-  (save-match-data
-    (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host))
-	   (real-user user)
-	   (real-host host)
-	   domain port args)
-
-      ; Check for domain ("user%domain") and port ("host#port")
-      (when (and user (string-match "\\(.+\\)%\\(.+\\)" user))
-	(setq real-user (or (match-string 1 user) user)
-	      domain (match-string 2 user)))
-
-      (when (and host (string-match "\\(.+\\)#\\(.+\\)" host))
-	(setq real-host (or (match-string 1 host) host)
-	      port (match-string 2 host)))
-
-      (if share
-	  (setq args (list (concat "//" real-host "/" share)))
-	(setq args (list "-L" real-host )))
-
-      (if real-user
-	  (setq args (append args (list "-U" real-user)))
-	(setq args (append args (list "-N"))))
-
-      (when domain (setq args (append args (list "-W" domain))))
-      (when port   (setq args (append args (list "-p" port))))
-
-      ; OK, let's go
-      (tramp-pre-connection nil tramp-smb-method user host tramp-chunksize)
-      (tramp-message 7 "Opening connection for //%s@%s/%s..."
-		     user host (or share ""))
-
-      (let* ((default-directory (tramp-temporary-file-directory))
-	     ;; If we omit the conditional here, then we would use
-	     ;; `undecided-dos' in some cases.  With the conditional,
-	     ;; we use nil in these cases.  Which one is right?
-	     (coding-system-for-read (unless (and (not (featurep 'xemacs))
-						  (> emacs-major-version 20))
-				       tramp-dos-coding-system))
-	     (p (apply #'start-process (buffer-name buffer) buffer
-		       tramp-smb-program args)))
-
-	(tramp-message 9 "Started process %s" (process-command p))
-	(tramp-set-process-query-on-exit-flag p nil)
-	(set-buffer buffer)
-	(setq tramp-smb-share share)
-
-        ; send password
-	(when real-user
-	  (let ((pw-prompt "Password:"))
-	    (tramp-message 9 "Sending password")
-	    (tramp-enter-password p pw-prompt user host)))
-
-	(unless (tramp-smb-wait-for-output user host)
-	  (tramp-clear-passwd user host)
-	  (error "Cannot open connection //%s@%s/%s"
-		 user host (or share "")))))))
-
-;; We don't use timeouts.  If needed, the caller shall wrap around.
-(defun tramp-smb-wait-for-output (user host)
-  "Wait for output from smbclient command.
-Returns nil if an error message has appeared."
-  (let ((proc (get-buffer-process (current-buffer)))
-	(found (progn (goto-char (point-min))
-		      (re-search-forward tramp-smb-prompt nil t)))
-	(err   (progn (goto-char (point-min))
-		      (re-search-forward tramp-smb-errors nil t))))
-
-    ;; Algorithm: get waiting output.  See if last line contains
-    ;; tramp-smb-prompt sentinel or tramp-smb-errors strings.
-    ;; If not, wait a bit and again get waiting output.
-    (while (not found)
-
-      ;; Accept pending output.
-      (tramp-accept-process-output proc)
-
-      ;; Search for prompt.
-      (goto-char (point-min))
-      (setq found (re-search-forward tramp-smb-prompt nil t))
-
-      ;; Search for errors.
-      (goto-char (point-min))
-      (setq err (re-search-forward tramp-smb-errors nil t)))
-
-    ;; Add output to debug buffer if appropriate.
-    (when tramp-debug-buffer
-      (append-to-buffer
-       (tramp-get-debug-buffer nil tramp-smb-method user host)
-       (point-min) (point-max)))
-
-    ;; Return value is whether no error message has appeared.
-    (not err)))
-
-
-;; Snarfed code from time-date.el and parse-time.el
-
-(defconst tramp-smb-half-a-year '(241 17024)
-"Evaluated by \"(days-to-time 183)\".")
-
-(defconst tramp-smb-parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3)
-			    ("apr" . 4) ("may" . 5) ("jun" . 6)
-			    ("jul" . 7) ("aug" . 8) ("sep" . 9)
-			    ("oct" . 10) ("nov" . 11) ("dec" . 12))
-"Alist mapping month names to integers.")
-
-(defun tramp-smb-time-less-p (t1 t2)
-  "Say whether time value T1 is less than time value T2."
-  (unless t1 (setq t1 '(0 0)))
-  (unless t2 (setq t2 '(0 0)))
-  (or (< (car t1) (car t2))
-      (and (= (car t1) (car t2))
-	   (< (nth 1 t1) (nth 1 t2)))))
-
-(defun tramp-smb-time-subtract (t1 t2)
-  "Subtract two time values.
-Return the difference in the format of a time value."
-  (unless t1 (setq t1 '(0 0)))
-  (unless t2 (setq t2 '(0 0)))
-  (let ((borrow (< (cadr t1) (cadr t2))))
-    (list (- (car t1) (car t2) (if borrow 1 0))
-	  (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
-
-(provide 'tramp-smb)
-
-;;; TODO:
-
-;; * Provide a local smb.conf. The default one might not be readable.
-;; * Error handling in case password is wrong.
-;; * Read password from "~/.netrc".
-;; * Return more comprehensive file permission string.  Think whether it is
-;;   possible to implement `set-file-modes'.
-;; * Handle WILDCARD and FULL-DIRECTORY-P in
-;;   `tramp-smb-handle-insert-directory'.
-;; * Handle links (FILENAME.LNK).
-;; * Maybe local tmp files should have the same extension like the original
-;;   files.  Strange behaviour with jka-compr otherwise?
-;; * Copy files in dired from SMB to another method doesn't work.
-;; * Try to remove the inclusion of dummy "" directory.  Seems to be at
-;;   several places, especially in `tramp-smb-handle-insert-directory'.
-;; * Provide variables for debug.
-;; * (RMS) Use unwind-protect to clean up the state so as to make the state
-;;   regular again.
-
-;;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5
-;;; tramp-smb.el ends here
diff --git a/xemacs-packages/lisp/tramp/tramp-util.el b/xemacs-packages/lisp/tramp/tramp-util.el
deleted file mode 100644
index 666471d6..00000000
--- a/xemacs-packages/lisp/tramp/tramp-util.el
+++ /dev/null
@@ -1,139 +0,0 @@
-;;; -*- coding: iso-2022-7bit; -*-
-;;; tramp-util.el --- Misc utility functions to use with Tramp
-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
-;;   2006 Free Software Foundation, Inc.
-
-;; Author: kai.grossjohann@gmx.net
-;; Keywords: comm, extensions, processes
-
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Some misc. utility functions that might go nicely with Tramp.
-;; Mostly, these are kluges awaiting real solutions later on.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'compile)
-(require 'tramp)
-(add-hook 'tramp-util-unload-hook
-	  '(lambda ()
-	     (when (featurep 'tramp)
-	       (unload-feature 'tramp 'force))))
-
-;; Define a Tramp minor mode. It's intention is to redefine some keys for Tramp
-;; specific functions, like compilation.
-;; The key remapping works since Emacs 22 only. Unknown for XEmacs.
-
-;; Pacify byte-compiler
-(eval-when-compile
-  (unless (fboundp 'define-minor-mode)
-      (defalias 'define-minor-mode 'identity)
-      (defvar tramp-minor-mode))
-  (unless (featurep 'xemacs)
-    (defalias 'add-menu-button 'ignore)))
-
-(defvar tramp-minor-mode-map (make-sparse-keymap)
-  "Keymap for Tramp minor mode.")
-
-(define-minor-mode tramp-minor-mode "Tramp minor mode for utility functions."
-  :group 'tramp
-  :global nil
-  :init-value nil
-  :lighter " Tramp"
-  :keymap tramp-minor-mode-map
-  (setq tramp-minor-mode
-	(and tramp-minor-mode (tramp-tramp-file-p default-directory))))
-
-(add-hook 'find-file-hooks 'tramp-minor-mode t)
-(add-hook 'tramp-util-unload-hook
-	  '(lambda ()
-	     (remove-hook 'find-file-hooks 'tramp-minor-mode)))
-
-(add-hook 'dired-mode-hook 'tramp-minor-mode t)
-(add-hook 'tramp-util-unload-hook
-	  '(lambda ()
-	     (remove-hook 'dired-mode-hook 'tramp-minor-mode)))
-
-(defun tramp-remap-command (old-command new-command)
-  "Replaces bindings of OLD-COMMAND by NEW-COMMAND.
-If remapping functionality for keymaps is defined, this happens for all
-bindings.  Otherwise, only bindings active during invocation are taken
-into account.  XEmacs menubar bindings are not changed by this."
-  (if (functionp 'command-remapping)
-      ;; Emacs 22
-      (eval
-       `(define-key tramp-minor-mode-map [remap ,old-command] new-command))
-    ;; previous Emacs versions.
-    (mapcar
-     '(lambda (x)
-	(define-key tramp-minor-mode-map x new-command))
-     (where-is-internal old-command))))
-
-(tramp-remap-command 'compile 'tramp-compile)
-(tramp-remap-command 'recompile 'tramp-recompile)
-
-;; XEmacs has an own mimic for menu entries
-(when (fboundp 'add-menu-button)
-  (funcall 'add-menu-button
-   '("Tools" "Compile")
-   ["Compile..."
-    (command-execute (if tramp-minor-mode 'tramp-compile 'compile))
-    :active (fboundp 'compile)])
-  (funcall 'add-menu-button
-   '("Tools" "Compile")
-   ["Repeat Compilation"
-    (command-execute (if tramp-minor-mode 'tramp-recompile 'recompile))
-    :active (fboundp 'compile)]))
-
-;; Utility functions.
-
-(defun tramp-compile (command)
-  "Compile on remote host."
-  (interactive
-   (if (or compilation-read-command current-prefix-arg)
-       (list (read-from-minibuffer "Compile command: "
-                                   compile-command nil nil
-                                   '(compile-history . 1)))
-     (list compile-command)))
-  (setq compile-command command)
-  (save-some-buffers (not compilation-ask-about-save) nil)
-  (let ((d default-directory))
-    (save-excursion
-      (pop-to-buffer (get-buffer-create "*Compilation*") t)
-      (erase-buffer)
-      (setq default-directory d)))
-  (tramp-handle-shell-command command (get-buffer "*Compilation*"))
-  (pop-to-buffer (get-buffer "*Compilation*"))
-  (tramp-minor-mode 1)
-  (compilation-minor-mode 1))
-
-(defun tramp-recompile ()
-  "Re-compile on remote host."
-  (interactive)
-  (save-some-buffers (not compilation-ask-about-save) nil)
-  (tramp-handle-shell-command compile-command (get-buffer "*Compilation*"))
-  (pop-to-buffer (get-buffer "*Compilation*"))
-  (tramp-minor-mode 1)
-  (compilation-minor-mode 1))
-
-(provide 'tramp-util)
-
-;;; arch-tag: 500f9992-a44e-46d0-83a7-980799251808
-;;; tramp-util.el ends here
diff --git a/xemacs-packages/lisp/tramp/tramp-uu.el b/xemacs-packages/lisp/tramp/tramp-uu.el
deleted file mode 100644
index c33e8175..00000000
--- a/xemacs-packages/lisp/tramp/tramp-uu.el
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; -*- coding: iso-2022-7bit; -*-
-;;; tramp-uu.el --- uuencode in Lisp
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
-
-;; Author: Kai Gro,A_(Bjohann 
-;; Keywords: comm, terminals
-
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; An implementation of "uuencode" in Lisp.  Uses the function
-;; base64-encode-region which is built-in to modern Emacsen.
-
-;;; Code:
-
-(defvar tramp-uu-b64-alphabet
-  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
-  "Mapping from base64-encoded character to the byte it represents.")
-
-(defvar tramp-uu-b64-char-to-byte
-  (let ((i 0))
-    (mapcar (lambda (c)
-	      (prog1
-		  (cons c i)
-		(setq i (1+ i))))
-	    tramp-uu-b64-alphabet))
-  "Alist of mapping from base64 character to its byte.")
-
-(defun tramp-uu-byte-to-uu-char (byte)
-  "Return the character encoding BYTE."
-  (if (zerop byte) ?` (+ byte 32)))
-
-(defun tramp-uu-b64-char-to-byte (char)
-  "Return the byte that is encoded as CHAR."
-  (cdr (assq char tramp-uu-b64-char-to-byte)))
-
-(defun tramp-uuencode-region (beg end)
-  "UU-encode the region between BEG and END."
-  ;; First we base64 encode the region, then we transmogrify that into
-  ;; uu encoding.
-  (let ((len (base64-encode-region beg end t))
-	(padding 0)
-	i c)
-    (save-excursion
-      (goto-char beg)
-      (setq i 0)
-      (while (< i len)
-	(setq c (char-after (point)))
-	(delete-char 1)
-	(if (equal c ?=)
-	    ;; "=" means padding.  Insert "`" instead.  Not counted for length.
-	    (progn (insert "`") (setq len (1- len)))
-	  (insert (tramp-uu-byte-to-uu-char (tramp-uu-b64-char-to-byte c)))
-	  (setq i (1+ i)))
-	;; Every 60 characters, add "M" at beginning of line (as
-	;; length byte) and insert a newline.
-	(when (zerop (% i 60))
-	  (save-excursion
-	    (beginning-of-line)
-	    (insert (char-to-string (+ 32 (/ (* 3 60) 4)))))
-	  (insert "\n")))
-      ;; If there is something leftover, we compute the length byte
-      ;; for that stuff and insert it and a trailing newline.
-      (unless (zerop (% i 60))
-	(save-excursion
-	  (beginning-of-line)
-	  (insert (char-to-string (+ 32 (% (- end beg) 45)))))
-	(insert "\n"))
-      ;; Why is there always a "`" line at the end?
-      (insert "`\nend\n")
-      (goto-char beg)
-      (insert "begin 600 xxx\n"))))
-
-(provide 'tramp-uu)
-
-;;; arch-tag: 7153f2c6-8be5-4cd2-8c06-0fbcf5190ef6
-;;; tramp-uu.el ends here
diff --git a/xemacs-packages/lisp/tramp/tramp-vc.el b/xemacs-packages/lisp/tramp/tramp-vc.el
deleted file mode 100644
index 1ecbc806..00000000
--- a/xemacs-packages/lisp/tramp/tramp-vc.el
+++ /dev/null
@@ -1,538 +0,0 @@
-;;; tramp-vc.el --- Version control integration for TRAMP.el
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
-
-;; Author: Daniel Pittman 
-;; Keywords: comm, processes
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; See the main module, 'tramp.el' for discussion of the purpose of TRAMP.
-;; This module provides integration between remote files accessed by TRAMP and
-;; the Emacs version control system.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl))
-(require 'vc)
-;; Old VC defines vc-rcs-release in vc.el, new VC requires extra module.
-(unless (boundp 'vc-rcs-release)
-  (require 'vc-rcs))
-(require 'tramp)
-
-;; Avoid byte-compiler warnings if the byte-compiler supports this.
-;; Currently, XEmacs supports this.
-(eval-when-compile
-  (when (fboundp 'byte-compiler-options)
-    (let (unused-vars) ; Pacify Emacs byte-compiler
-      (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
-      (byte-compiler-options (warnings (- unused-vars))))))
-
-;; -- vc --
-
-;; This used to blow away the file-name-handler-alist and reinstall
-;; TRAMP into it. This was intended to let VC work remotely. It didn't,
-;; at least not in my XEmacs 21.2 install.
-;;
-;; In any case, tramp-run-real-handler now deals correctly with disabling
-;; the things that should be, making this a no-op.
-;;
-;; I have removed it from the tramp-file-name-handler-alist because the
-;; shortened version does nothing. This is for reference only now.
-;;
-;; Daniel Pittman 
-;;
-;; (defun tramp-handle-vc-registered (file)
-;;   "Like `vc-registered' for tramp files."
-;;   (tramp-run-real-handler 'vc-registered (list file)))
-
-;; `vc-do-command'
-;; This function does not deal well with remote files, so we define
-;; our own version and make a backup of the original function and
-;; call our version for tramp files and the original version for
-;; normal files.
-
-;; The following function is pretty much copied from vc.el, but
-;; the part that actually executes a command is changed.
-;; CCC: this probably works for Emacs 21, too.
-(defun tramp-vc-do-command (buffer okstatus command file last &rest flags)
-  "Like `vc-do-command' but invoked for tramp files.
-See `vc-do-command' for more information."
-  (save-match-data
-    (and file (setq file (expand-file-name file)))
-    (if (not buffer) (setq buffer "*vc*"))
-    (if vc-command-messages
-	(message "Running `%s' on `%s'..." command file))
-    (let ((obuf (current-buffer)) (camefrom (current-buffer))
-	  (squeezed nil)
-	  (olddir default-directory)
-	  vc-file status)
-      (let* ((v (tramp-dissect-file-name (expand-file-name file)))
-	     (multi-method (tramp-file-name-multi-method v))
-	     (method (tramp-file-name-method v))
-	     (user (tramp-file-name-user v))
-	     (host (tramp-file-name-host v))
-	     (localname (tramp-file-name-localname v)))
-	(set-buffer (get-buffer-create buffer))
-	(set (make-local-variable 'vc-parent-buffer) camefrom)
-	(set (make-local-variable 'vc-parent-buffer-name)
-	     (concat " from " (buffer-name camefrom)))
-	(setq default-directory olddir)
-
-	(erase-buffer)
-
-	(mapcar
-	 (function
-	  (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
-	 flags)
-	(if (and (eq last 'MASTER) file
-		 (setq vc-file (vc-name file)))
-	    (setq squeezed
-		  (append squeezed
-			  (list (tramp-file-name-localname
-				 (tramp-dissect-file-name vc-file))))))
-	(if (and file (eq last 'WORKFILE))
-	    (progn
-	      (let* ((pwd (expand-file-name default-directory))
-		     (preflen (length pwd)))
-		(if (string= (substring file 0 preflen) pwd)
-		    (setq file (substring file preflen))))
-	      (setq squeezed (append squeezed (list file)))))
-	;; Unless we (save-window-excursion) the layout of windows in
-	;; the current frame changes. This is painful, at best.
-	;;
-	;; As a point of note, (save-excursion) is still here only because
-	;; it preserves (point) in the current buffer. (save-window-excursion)
-	;; does not, at least under XEmacs 21.2.
-	;;
-	;; I trust that the FSF support this as well. I can't find useful
-	;; documentation to check :(
-	;;
-	;; Daniel Pittman 
-	(save-excursion
-	  (save-window-excursion
-	    ;; Actually execute remote command
-	    ;; `shell-command' cannot be used; it isn't magic in XEmacs.
-	    (tramp-handle-shell-command
-	     (mapconcat 'tramp-shell-quote-argument
-			(cons command squeezed) " ") t)
-	    ;;(tramp-wait-for-output)
-	    ;; Get status from command
-	    (tramp-send-command multi-method method user host "echo $?")
-	    (tramp-wait-for-output)
-	    ;; Make sure to get status from last line of output.
-	    (goto-char (point-max)) (forward-line -1)
-	    (setq status (read (current-buffer)))
-	    (message "Command %s returned status %d." command status)))
-	(goto-char (point-max))
-	(set-buffer-modified-p nil)
-	(forward-line -1)
-	(if (or (not (integerp status))
-		(and (integerp okstatus) (< okstatus status)))
-	    (progn
-	      (pop-to-buffer buffer)
-	      (goto-char (point-min))
-	      (shrink-window-if-larger-than-buffer)
-	      (error "Running `%s'...FAILED (%s)" command
-		     (if (integerp status)
-			 (format "status %d" status)
-		       status))
-	      )
-	  (if vc-command-messages
-	      (message "Running %s...OK" command))
-	  )
-	(set-buffer obuf)
-	status))
-    ))
-
-;; Following code snarfed from Emacs 21 vc.el and slightly tweaked.
-(defun tramp-vc-do-command-new (buffer okstatus command file &rest flags)
-  "Like `vc-do-command' but for TRAMP files.
-This function is for the new VC which comes with Emacs 21.
-Since TRAMP doesn't do async commands yet, this function doesn't, either."
-  (and file (setq file (expand-file-name file)))
-  (if vc-command-messages
-      (message "Running %s on %s..." command file))
-  (save-current-buffer
-    (unless (eq buffer t)
-      ; Pacify byte-compiler
-      (funcall (symbol-function 'vc-setup-buffer) buffer))
-    (let ((squeezed nil)
-	  (inhibit-read-only t)
-	  (status 0))
-      (let* ((v (when file (tramp-dissect-file-name file)))
-             (multi-method (when file (tramp-file-name-multi-method v)))
-             (method (when file (tramp-file-name-method v)))
-             (user (when file (tramp-file-name-user v)))
-             (host (when file (tramp-file-name-host v)))
-             (localname (when file (tramp-file-name-localname v))))
-      (setq squeezed (delq nil (copy-sequence flags)))
-      (when file
-	(setq squeezed (append squeezed (list (file-relative-name
-					       file default-directory)))))
-      (let ((w32-quote-process-args t))
-        (when (eq okstatus 'async)
-          (message "Tramp doesn't do async commands, running synchronously."))
-	;; `shell-command' cannot be used; it isn't magic in XEmacs.
-        (setq status (tramp-handle-shell-command
-                      (mapconcat 'tramp-shell-quote-argument
-                                 (cons command squeezed) " ") t))
-        (when (or (not (integerp status))
-		  (and (integerp okstatus) (< okstatus status)))
-          (pop-to-buffer (current-buffer))
-          (goto-char (point-min))
-          (shrink-window-if-larger-than-buffer)
-          (error "Running %s...FAILED (%s)" command
-                 (if (integerp status) (format "status %d" status) status))))
-      (if vc-command-messages
-          (message "Running %s...OK" command))
-      ; Pacify byte-compiler
-      (funcall (symbol-function 'vc-exec-after)
-	       `(run-hook-with-args
-		 'vc-post-command-functions ',command ',localname ',flags))
-      status))))
-
-
-;; The context for a VC command is the current buffer.
-;; That makes a test on the buffers file more reliable than a test on the
-;; arguments.
-;; This is needed to handle remote VC correctly - else we test against the
-;; local VC system and get things wrong...
-;; Daniel Pittman 
-;;-(if (fboundp 'vc-call-backend)
-;;-    () ;; This is the new VC for which we don't have an appropriate advice yet
-;;-)
-(unless (fboundp 'process-file)
-  (if (fboundp 'vc-call-backend)
-      (defadvice vc-do-command
-	(around tramp-advice-vc-do-command
-		(buffer okstatus command file &rest flags)
-		activate)
-	"Invoke tramp-vc-do-command for tramp files."
-	(let ((file (symbol-value 'file)))    ;pacify byte-compiler
-	  (if (or (and (stringp file)     (tramp-tramp-file-p file))
-		  (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
-	      (setq ad-return-value
-		    (apply 'tramp-vc-do-command-new buffer okstatus command
-			   file ;(or file (buffer-file-name))
-			   flags))
-	    ad-do-it)))
-    (defadvice vc-do-command
-      (around tramp-advice-vc-do-command
-	      (buffer okstatus command file last &rest flags)
-	      activate)
-      "Invoke tramp-vc-do-command for tramp files."
-      (let ((file (symbol-value 'file)))  ;pacify byte-compiler
-	(if (or (and (stringp file)     (tramp-tramp-file-p file))
-		(and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
-	    (setq ad-return-value
-		  (apply 'tramp-vc-do-command buffer okstatus command
-			 (or file (buffer-file-name)) last flags))
-	  ad-do-it))))
-
-  (add-hook 'tramp-unload-hook
-	    '(lambda () (ad-unadvise 'vc-do-command))))
-
-
-;; XEmacs uses this to do some of its work. Like vc-do-command, we
-;; need to enhance it to make VC work via TRAMP-mode.
-;;
-;; Like the previous function, this is a cut-and-paste job from the VC
-;; file. It's based on the vc-do-command code.
-;; CCC: this isn't used in Emacs 21, so do as before.
-(defun tramp-vc-simple-command (okstatus command file &rest args)
-  ;; Simple version of vc-do-command, for use in vc-hooks only.
-  ;; Don't switch to the *vc-info* buffer before running the
-  ;; command, because that would change its default directory
-  (save-match-data
-    (let* ((v (tramp-dissect-file-name (expand-file-name file)))
-	   (multi-method (tramp-file-name-multi-method v))
-	   (method (tramp-file-name-method v))
-	   (user (tramp-file-name-user v))
-	   (host (tramp-file-name-host v))
-	   (localname (tramp-file-name-localname v)))
-      (save-excursion (set-buffer (get-buffer-create "*vc-info*"))
-		      (erase-buffer))
-      (let ((exec-path (append vc-path exec-path)) exec-status
-	    ;; Add vc-path to PATH for the execution of this command.
-	    (process-environment
-	     (cons (concat "PATH=" (getenv "PATH")
-			   path-separator
-			   (mapconcat 'identity vc-path path-separator))
-		   process-environment)))
-	;; Call the actual process. See tramp-vc-do-command for discussion of
-	;; why this does both (save-window-excursion) and (save-excursion).
-	;;
-	;; As a note, I don't think that the process-environment stuff above
-	;; has any effect on the remote system. This is a hard one though as
-	;; there is no real reason to expect local and remote paths to be
-	;; identical...
-	;;
-	;; Daniel Pittman 
-	(save-excursion
-	  (save-window-excursion
-	    ;; Actually execute remote command
-	    ;; `shell-command' cannot be used; it isn't magic in XEmacs.
-	    (tramp-handle-shell-command
-	     (mapconcat 'tramp-shell-quote-argument
-			(append (list command) args (list localname)) " ")
-	     (get-buffer-create"*vc-info*"))
-					;(tramp-wait-for-output)
-	    ;; Get status from command
-	    (tramp-send-command multi-method method user host "echo $?")
-	    (tramp-wait-for-output)
-	    (setq exec-status (read (current-buffer)))
-	    (message "Command %s returned status %d." command exec-status)))
-
-	;; Maybe okstatus can be `async' here.  But then, maybe the
-	;; async thing is new in Emacs 21, but this function is only
-	;; used in Emacs 20.
-	(cond ((> exec-status okstatus)
-	       (switch-to-buffer (get-file-buffer file))
-	       (shrink-window-if-larger-than-buffer
-		(display-buffer "*vc-info*"))
-	       (error "Couldn't find version control information")))
-	exec-status))))
-
-;; This function does not exist any more in Emacs-21's VC
-(defadvice vc-simple-command
-  (around tramp-advice-vc-simple-command
-	  (okstatus command file &rest args)
-	  activate)
-  "Invoke tramp-vc-simple-command for tramp files."
-  (let ((file (symbol-value 'file)))    ;pacify byte-compiler
-    (if (or (and (stringp file)     (tramp-tramp-file-p file))
-            (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))))
-        (setq ad-return-value
-              (apply 'tramp-vc-simple-command okstatus command
-                     (or file (buffer-file-name)) args))
-      ad-do-it)))
-
-(add-hook 'tramp-unload-hook
-	  '(lambda () (ad-unadvise 'vc-simple-command)))
-
-
-;; `vc-workfile-unchanged-p'
-;; This function does not deal well with remote files, so we do the
-;; same as for `vc-do-command'.
-
-;; `vc-workfile-unchanged-p' checks the modification time, we cannot
-;; do that for remote files, so here's a version which relies on diff.
-;; CCC: this one probably works for Emacs 21, too.
-(defun tramp-vc-workfile-unchanged-p
-  (filename &optional want-differences-if-changed)
-  (if (fboundp 'vc-backend-diff)
-      ;; Old VC.  Call `vc-backend-diff'.
-      (let ((status (funcall (symbol-function 'vc-backend-diff)
-                             filename nil nil
-                             (not want-differences-if-changed))))
-        (zerop status))
-    ;; New VC.  Call `vc-default-workfile-unchanged-p'.
-      (funcall (symbol-function 'vc-default-workfile-unchanged-p)
-	       (vc-backend filename) filename)))
-
-(defadvice vc-workfile-unchanged-p
-  (around tramp-advice-vc-workfile-unchanged-p
-          (filename &optional want-differences-if-changed)
-          activate)
-  "Invoke tramp-vc-workfile-unchanged-p for tramp files."
-  (if (and (stringp filename)
-	   (tramp-tramp-file-p filename)
-	   (not
-	    (let ((v	(tramp-dissect-file-name filename)))
-	      ;; The following check is probably to test whether
-	      ;; file-attributes returns correct last modification
-	      ;; times.  This check needs to be changed.
-	      (tramp-get-remote-perl (tramp-file-name-multi-method v)
-				   (tramp-file-name-method v)
-				   (tramp-file-name-user v)
-				   (tramp-file-name-host v)))))
-      (setq ad-return-value
-            (tramp-vc-workfile-unchanged-p filename want-differences-if-changed))
-    ad-do-it))
-
-(add-hook 'tramp-unload-hook
-	  '(lambda () (ad-unadvise 'vc-workfile-unchanged-p)))
-
-
-;; Redefine a function from vc.el -- allow tramp files.
-;; `save-match-data' seems not to be required -- it isn't in
-;; the original version, either.
-;; CCC: this might need some work -- how does the Emacs 21 version
-;; work, anyway?  Does it work over ange-ftp?  Hm.
-(if (not (fboundp 'vc-backend-checkout))
-    () ;; our replacement won't work and is unnecessary anyway
-(defun vc-checkout (filename &optional writable rev)
-  "Retrieve a copy of the latest version of the given file."
-  ;; If ftp is on this system and the name matches the ange-ftp format
-  ;; for a remote file, the user is trying something that won't work.
-  (funcall (symbol-function 'vc-backend-checkout) filename writable rev)
-  (vc-resynch-buffer filename t t))
-)
-
-
-;; Do we need to advise the vc-user-login-name function anyway?
-;; This will return the correct login name for the owner of a
-;; file. It does not deal with the default remote user name...
-;;
-;; That is, when vc calls (vc-user-login-name), we return the
-;; local login name, something that may be different to the remote
-;; default.
-;;
-;; The remote VC operations will occur as the user that we logged
-;; in with however - not always the same as the local user.
-;;
-;; In the end, I did advise the function. This is because, well,
-;; the thing didn't work right otherwise ;)
-;;
-;; Daniel Pittman 
-
-(defun tramp-handle-vc-user-login-name (&optional uid)
-  "Return the default user name on the remote machine.
-Whenever VC calls this function, `file' is bound to the file name
-in question.  If no uid is provided or the uid is equal to the uid
-owning the file, then we return the user name given in the file name.
-
-This should only be called when `file' is bound to the
-filename we are thinking about..."
-  ;; Pacify byte-compiler; this symbol is bound in the calling
-  ;; function.  CCC: Maybe it would be better to move the
-  ;; boundness-checking into this function?
-  (let* ((file (symbol-value 'file))
-	 (remote-uid
-	  ;; With Emacs 22, `file-attributes' has got an optional parameter
-	  ;; ID-FORMAT. Handle this case backwards compatible.
-	  (if (and (functionp 'subr-arity)
-		   (= 2 (cdr (funcall (symbol-function 'subr-arity)
-				      (symbol-function 'file-attributes)))))
-	      (nth 2 (file-attributes file 'integer))
-	    (nth 2 (file-attributes file)))))
-    (if (and uid (/= uid remote-uid))
-	(error "tramp-handle-vc-user-login-name cannot map a uid to a name")
-      (let* ((v (tramp-dissect-file-name (expand-file-name file)))
-	     (u (tramp-file-name-user v)))
-	(cond ((stringp u) u)
-	      ((vectorp u) (elt u (1- (length u))))
-	      ((null    u) (user-login-name))
-	      (t	   (error "tramp-handle-vc-user-login-name cannot cope!")))))))
-
-
-;; The following defadvice is no longer necessary after changes in VC
-;; on 2006-01-25, Andre.
-
-(unless (fboundp 'process-file)
-  (defadvice vc-user-login-name
-    (around tramp-vc-user-login-name activate)
-    "Support for files on remote machines accessed by TRAMP."
-    ;; We rely on the fact that `file' is bound when this is called.
-    ;; This appears to be the case everywhere in vc.el and vc-hooks.el
-    ;; as of Emacs 20.5.
-    ;;
-    ;; With Emacs 22, the definition of `vc-user-login-name' has been
-    ;; changed.  It doesn't need to be adviced any longer.
-    (let ((file (when (boundp 'file)
-		  (symbol-value 'file))))    ;pacify byte-compiler
-      (or (and (stringp file)
-	       (tramp-tramp-file-p file)	; tramp file
-	       (setq ad-return-value
-		     (save-match-data
-		       (tramp-handle-vc-user-login-name uid)))) ; get the owner name
-	  ad-do-it)))                     ; else call the original
-
-  (add-hook 'tramp-unload-hook
-	    '(lambda () (ad-unadvise 'vc-user-login-name))))
-
-
-;; Determine the name of the user owning a file.
-(defun tramp-file-owner (filename)
-  "Return who owns FILE (user name, as a string)."
-  (let ((v (tramp-dissect-file-name
-	    (expand-file-name filename))))
-    (if (not (file-exists-p filename))
-        nil                             ; file cannot be opened
-      ;; file exists, find out stuff
-      (save-excursion
-        (tramp-send-command
-         (tramp-file-name-multi-method v) (tramp-file-name-method v)
-         (tramp-file-name-user v) (tramp-file-name-host v)
-         (format "%s -Lld %s"
-                 (tramp-get-ls-command (tramp-file-name-multi-method v)
-                                     (tramp-file-name-method v)
-                                     (tramp-file-name-user v)
-                                     (tramp-file-name-host v))
-                 (tramp-shell-quote-argument (tramp-file-name-localname v))))
-        (tramp-wait-for-output)
-        ;; parse `ls -l' output ...
-        ;; ... file mode flags
-        (read (current-buffer))
-        ;; ... number links
-        (read (current-buffer))
-        ;; ... uid (as a string)
-        (symbol-name (read (current-buffer)))))))
-
-;; Wire ourselves into the VC infrastructure...
-;; This function does not exist any more in Emacs-21's VC
-;; CCC: it appears that no substitute is needed for Emacs 21.
-(defadvice vc-file-owner
-  (around tramp-vc-file-owner activate)
-  "Support for files on remote machines accessed by TRAMP."
-  (let ((filename (ad-get-arg 0)))
-    (or (and (tramp-file-name-p filename) ; tramp file
-             (setq ad-return-value
-		   (save-match-data
-		     (tramp-file-owner filename)))) ; get the owner name
-        ad-do-it)))                     ; else call the original
-
-(add-hook 'tramp-unload-hook
-	  '(lambda () (ad-unadvise 'vc-file-owner)))
-
-
-;; We need to make the version control software backend version
-;; information local to the current buffer. This is because each TRAMP
-;; buffer can (theoretically) have a different VC version and I am
-;; *way* too lazy to try and push the correct value into each new
-;; buffer.
-;;
-;; Remote VC costs will just have to be paid, at least for the moment.
-;; Well, at least, they will right until I feel guilty about doing a
-;; botch job here and fix it. :/
-;;
-;; Daniel Pittman 
-;; CCC: this is probably still needed for Emacs 21.
-(defun tramp-vc-setup-for-remote ()
-  "Make the backend release variables buffer local.
-This makes remote VC work correctly at the cost of some processing time."
-  (when (and (buffer-file-name)
-             (tramp-tramp-file-p (buffer-file-name)))
-    (make-local-variable 'vc-rcs-release)
-    (setq vc-rcs-release nil)))
-
-(add-hook 'find-file-hooks 'tramp-vc-setup-for-remote t)
-(add-hook 'tramp-unload-hook
-	  '(lambda ()
-	     (remove-hook 'find-file-hooks 'tramp-vc-setup-for-remote)))
-
-;; No need to load this again if anyone asks.
-(provide 'tramp-vc)
-
-;;; arch-tag: 27cc42ce-da19-468d-ad5c-a2690558db60
-;;; tramp-vc.el ends here
diff --git a/xemacs-packages/lisp/tramp/tramp.el b/xemacs-packages/lisp/tramp/tramp.el
deleted file mode 100644
index 617e21eb..00000000
--- a/xemacs-packages/lisp/tramp/tramp.el
+++ /dev/null
@@ -1,7772 +0,0 @@
-;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*-
-;;; tramp.el --- Transparent Remote Access, Multiple Protocol
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
-
-;; Author: Kai Gro,A_(Bjohann 
-;;         Michael Albinus 
-;; Keywords: comm, processes
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This package provides remote file editing, similar to ange-ftp.
-;; The difference is that ange-ftp uses FTP to transfer files between
-;; the local and the remote host, whereas tramp.el uses a combination
-;; of rsh and rcp or other work-alike programs, such as ssh/scp.
-;;
-;; For more detailed instructions, please see the info file.
-;;
-;; Notes:
-;; -----
-;;
-;; This package only works for Emacs 20 and higher, and for XEmacs 21
-;; and higher.  (XEmacs 20 is missing the `with-timeout' macro.  Emacs
-;; 19 is reported to have other problems.  For XEmacs 21, you need the
-;; package `fsf-compat' for the `with-timeout' macro.)
-;;
-;; This version might not work with pre-Emacs 21 VC unless VC is
-;; loaded before tramp.el.  Could you please test this and tell me about
-;; the result?  Thanks.
-;;
-;; Also see the todo list at the bottom of this file.
-;;
-;; The current version of Tramp can be retrieved from the following URL:
-;;            http://ftp.gnu.org/gnu/tramp/
-;;
-;; There's a mailing list for this, as well.  Its name is:
-;;            tramp-devel@gnu.org
-;; You can use the Web to subscribe, under the following URL:
-;;            http://lists.gnu.org/mailman/listinfo/tramp-devel
-;;
-;; For the adventurous, the current development sources are available
-;; via CVS.  You can find instructions about this at the following URL:
-;;            http://savannah.gnu.org/projects/tramp/
-;; Click on "CVS" in the navigation bar near the top.
-;;
-;; Don't forget to put on your asbestos longjohns, first!
-
-;;; Code:
-
-;; The Tramp version number and bug report address, as prepared by configure.
-(require 'trampver)
-(add-hook 'tramp-unload-hook
-	  '(lambda ()
-	     (when (featurep 'trampver)
-	       (unload-feature 'trampver 'force))))
-
-(if (featurep 'xemacs)
-    (require 'timer-funcs)
-  (require 'timer))
-
-(require 'format-spec)                  ;from Gnus 5.8, also in tar ball
-;; As long as password.el is not part of (X)Emacs, it shouldn't
-;; be mandatory
-(if (featurep 'xemacs)
-    (load "password" 'noerror)
-  (require 'password nil 'noerror))     ;from No Gnus, also in tar ball
-
-;; The explicit check is not necessary in Emacs, which provides the
-;; feature even if implemented in C, but it appears to be necessary
-;; in XEmacs.
-(unless (and (fboundp 'base64-encode-region)
-	     (fboundp 'base64-decode-region))
-  (require 'base64))                       ;for the mimencode methods
-(require 'shell)
-(require 'advice)
-
-(autoload 'tramp-uuencode-region "tramp-uu"
-  "Implementation of `uuencode' in Lisp.")
-(add-hook 'tramp-unload-hook
-	  '(lambda ()
-	     (when (featurep 'tramp-uu)
-	       (unload-feature 'tramp-uu 'force))))
-
-(unless (fboundp 'uudecode-decode-region)
-  (autoload 'uudecode-decode-region "uudecode"))
-
-;; XEmacs is distributed with few Lisp packages.  Further packages are
-;; installed using EFS.  If we use a unified filename format, then
-;; Tramp is required in addition to EFS.  (But why can't Tramp just
-;; disable EFS when Tramp is loaded?  Then XEmacs can ship with EFS
-;; just like before.)  Another reason for using a separate filename
-;; syntax on XEmacs is that EFS hooks into XEmacs in many places, but
-;; Tramp only knows how to deal with `file-name-handler-alist', not
-;; the other places.
-;;;###autoload
-(defvar tramp-unified-filenames (not (featurep 'xemacs))
-  "Non-nil means to use unified Ange-FTP/Tramp filename syntax.
-Nil means to use a separate filename syntax for Tramp.")
-
-;; Load foreign methods.  Because they do require Tramp internally, this
-;; must be done with the `eval-after-load' trick.
-
-;; tramp-ftp supports Ange-FTP only.  Not suited for XEmacs therefore.
-(unless (featurep 'xemacs)
-  (eval-after-load "tramp"
-    '(progn
-       (require 'tramp-ftp)
-       (add-hook 'tramp-unload-hook
-		 '(lambda ()
-		    (when (featurep 'tramp-ftp)
-		      (unload-feature 'tramp-ftp 'force)))))))
-(when (and tramp-unified-filenames (featurep 'xemacs))
-  (eval-after-load "tramp"
-    '(progn
-       (require 'tramp-efs)
-       (add-hook 'tramp-unload-hook
-		 '(lambda ()
-		    (when (featurep 'tramp-efs)
-		      (unload-feature 'tramp-efs 'force)))))))
-
-;; tramp-smb uses "smbclient" from Samba.
-;; Not available under Cygwin and Windows, because they don't offer
-;; "smbclient".  And even not necessary there, because Emacs supports
-;; UNC file names like "//host/share/localname".
-(unless (memq system-type '(cygwin windows-nt))
-  (eval-after-load "tramp"
-    '(progn
-       (require 'tramp-smb)
-       (add-hook 'tramp-unload-hook
-		 '(lambda ()
-		    (when (featurep 'tramp-smb)
-		      (unload-feature 'tramp-smb 'force)))))))
-
-(eval-when-compile
-  (require 'cl)
-  (require 'custom)
-  ;; Emacs 19.34 compatibility hack -- is this needed?
-  (or (>= emacs-major-version 20)
-      (load "cl-seq")))
-
-(unless (boundp 'custom-print-functions)
-  (defvar custom-print-functions nil))	; not autoloaded before Emacs 20.4
-
-;; Avoid byte-compiler warnings if the byte-compiler supports this.
-;; Currently, XEmacs supports this.
-(eval-when-compile
-  (when (featurep 'xemacs)
-    (let (unused-vars) ; Pacify Emacs byte-compiler
-      (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
-      (byte-compiler-options (warnings (- unused-vars))))))
-
-;; `directory-sep-char' is an obsolete variable in Emacs.  But it is
-;; used in XEmacs, so we set it here and there.  The following is needed
-;; to pacify Emacs byte-compiler.
-(eval-when-compile
-  (when (boundp 'byte-compile-not-obsolete-var)
-    (setq byte-compile-not-obsolete-var 'directory-sep-char)))
-
-;;; User Customizable Internal Variables:
-
-(defgroup tramp nil
-  "Edit remote files with a combination of rsh and rcp or similar programs."
-  :group 'files
-  :version "22.1")
-
-(defcustom tramp-verbose 9
-  "*Verbosity level for tramp.el.  0 means be silent, 10 is most verbose."
-  :group 'tramp
-  :type 'integer)
-
-(defcustom tramp-debug-buffer nil
-  "*Whether to send all commands and responses to a debug buffer."
-  :group 'tramp
-  :type 'boolean)
-
-;; Emacs case
-(eval-and-compile
-  (when (boundp 'backup-directory-alist)
-    (defcustom tramp-backup-directory-alist nil
-      "Alist of filename patterns and backup directory names.
-Each element looks like (REGEXP . DIRECTORY), with the same meaning like
-in `backup-directory-alist'.  If a Tramp file is backed up, and DIRECTORY
-is a local file name, the backup directory is prepended with Tramp file
-name prefix \(multi-method, method, user, host\) of file.
-
-\(setq tramp-backup-directory-alist backup-directory-alist\)
-
-gives the same backup policy for Tramp files on their hosts like the
-policy for local files."
-      :group 'tramp
-      :type '(repeat (cons (regexp :tag "Regexp matching filename")
-			   (directory :tag "Backup directory name"))))))
-
-;; XEmacs case.  We cannot check for `bkup-backup-directory-info', because
-;; the package "backup-dir" might not be loaded yet.
-(eval-and-compile
-  (when (featurep 'xemacs)
-    (defcustom tramp-bkup-backup-directory-info nil
-      "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
-It has the same meaning like `bkup-backup-directory-info' from package
-`backup-dir'.  If a Tramp file is backed up, and BACKUP-DIR is a local
-file name, the backup directory is prepended with Tramp file name prefix
-\(multi-method, method, user, host\) of file.
-
-\(setq tramp-bkup-backup-directory-info bkup-backup-directory-info\)
-
-gives the same backup policy for Tramp files on their hosts like the
-policy for local files."
-      :type '(repeat
-	      (list (regexp :tag "File regexp")
-		    (string :tag "Backup Dir")
-		    (set :inline t
-			 (const ok-create)
-			 (const full-path)
-			 (const prepend-name)
-			 (const search-upward))))
-      :group 'tramp)))
-
-(defcustom tramp-auto-save-directory nil
-  "*Put auto-save files in this directory, if set.
-The idea is to use a local directory so that auto-saving is faster."
-  :group 'tramp
-  :type '(choice (const nil)
-                 string))
-
-(defcustom tramp-encoding-shell
-  (if (memq system-type '(windows-nt))
-      (getenv "COMSPEC")
-    "/bin/sh")
-  "*Use this program for encoding and decoding commands on the local host.
-This shell is used to execute the encoding and decoding command on the
-local host, so if you want to use `~' in those commands, you should
-choose a shell here which groks tilde expansion.  `/bin/sh' normally
-does not understand tilde expansion.
-
-For encoding and deocding, commands like the following are executed:
-
-    /bin/sh -c COMMAND < INPUT > OUTPUT
-
-This variable can be used to change the \"/bin/sh\" part.  See the
-variable `tramp-encoding-command-switch' for the \"-c\" part.  Also, see the
-variable `tramp-encoding-reads-stdin' to specify whether the commands read
-standard input or a file.
-
-Note that this variable is not used for remote commands.  There are
-mechanisms in tramp.el which automatically determine the right shell to
-use for the remote host."
-  :group 'tramp
-  :type '(file :must-match t))
-
-(defcustom tramp-encoding-command-switch
-  (if (string-match "cmd\\.exe" tramp-encoding-shell)
-      "/c"
-    "-c")
-  "*Use this switch together with `tramp-encoding-shell' for local commands.
-See the variable `tramp-encoding-shell' for more information."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-encoding-reads-stdin t
-  "*If non-nil, encoding commands read from standard input.
-If nil, the filename is the last argument.
-
-Note that the commands always must write to standard output."
-  :group 'tramp
-  :type 'boolean)
-
-(defcustom tramp-multi-sh-program
-  tramp-encoding-shell
-  "*Use this program for bootstrapping multi-hop connections.
-This variable is similar to `tramp-encoding-shell', but it is only used
-when initializing a multi-hop connection.  Therefore, the set of
-commands sent to this shell is quite restricted, and if you are
-careful it works to use CMD.EXE under Windows (instead of a Bourne-ish
-shell which does not normally exist on Windows anyway).
-
-To use multi-hop methods from Windows, you also need suitable entries
-in `tramp-multi-connection-function-alist' for the first hop.
-
-This variable defaults to the value of `tramp-encoding-shell'."
-  :group 'tramp
-  :type '(file :must-match t))
-
-;; CCC I have changed all occurrences of comint-quote-filename with
-;; tramp-shell-quote-argument, except in tramp-handle-expand-many-files.
-;; There, comint-quote-filename was removed altogether.  If it turns
-;; out to be necessary there, something will need to be done.
-;;-(defcustom tramp-file-name-quote-list
-;;-  '(?] ?[ ?\| ?& ?< ?> ?\( ?\) ?\; ?\  ?\* ?\? ?\! ?\" ?\' ?\` ?# ?\@ ?\+ )
-;;-  "*Protect these characters from the remote shell.
-;;-Any character in this list is quoted (preceded with a backslash)
-;;-because it means something special to the shell.  This takes effect
-;;-when sending file and directory names to the remote shell.
-;;-
-;;-See `comint-file-name-quote-list' for details."
-;;-  :group 'tramp
-;;-  :type '(repeat character))
-
-(defcustom tramp-methods
-  '( ("rcp"   (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "rsh")
-              (tramp-copy-program         "rcp")
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           nil)
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line nil))
-     ("scp"   (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh")
-              (tramp-copy-program         "scp")
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-e" "none"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line nil))
-     ("scp1"  (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh")
-              (tramp-copy-program         "scp")
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-1" "-e" "none"))
-              (tramp-copy-args            ("-1"))
-              (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line nil))
-     ("scp2"  (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh")
-              (tramp-copy-program         "scp")
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-2" "-e" "none"))
-              (tramp-copy-args            ("-2"))
-              (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line nil))
-     ("scp1_old"
-              (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh1")
-              (tramp-copy-program         "scp1")
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-e" "none"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line nil))
-     ("scp2_old"
-              (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh2")
-              (tramp-copy-program         "scp2")
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-e" "none"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line nil))
-     ("rsync" (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh")
-              (tramp-copy-program         "rsync")
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-e" "none"))
-              (tramp-copy-args            ("-e" "ssh"))
-              (tramp-copy-keep-date-arg   "-t")
-	      (tramp-password-end-of-line nil))
-     ("remcp" (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "remsh")
-              (tramp-copy-program         "rcp")
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           nil)
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line nil))
-     ("rsh"   (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "rsh")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           nil)
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("ssh"   (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-e" "none"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("ssh1"  (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-1" "-e" "none"))
-              (tramp-copy-args            ("-1"))
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("ssh2"  (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-2" "-e" "none"))
-              (tramp-copy-args            ("-2"))
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("ssh1_old"
-              (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh1")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-e" "none"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("ssh2_old"
-              (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh2")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-e" "none"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("remsh" (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "remsh")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           nil)
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("telnet"
-              (tramp-connection-function  tramp-open-connection-telnet)
-              (tramp-login-program        "telnet")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           nil)
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("su"    (tramp-connection-function  tramp-open-connection-su)
-              (tramp-login-program        "su")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-" "%u"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("sudo"  (tramp-connection-function  tramp-open-connection-su)
-              (tramp-login-program        "sudo")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-u" "%u" "-s"
-					   "-p" "Password:"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("multi" (tramp-connection-function  tramp-open-connection-multi)
-              (tramp-login-program        nil)
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           nil)
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("scpx"  (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh")
-              (tramp-copy-program         "scp")
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-e" "none" "-t" "-t" "/bin/sh"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line nil))
-     ("sshx"  (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "ssh")
-              (tramp-copy-program         nil)
-              (tramp-remote-sh            "/bin/sh")
-              (tramp-login-args           ("-e" "none" "-t" "-t" "/bin/sh"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("krlogin"
-              (tramp-connection-function  tramp-open-connection-rsh)
-	      (tramp-login-program        "krlogin")
-	      (tramp-copy-program         nil)
-	      (tramp-remote-sh            "/bin/sh")
-	      (tramp-login-args           ("-x"))
-	      (tramp-copy-args            nil)
-	      (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line nil))
-     ("plink"
-              (tramp-connection-function  tramp-open-connection-rsh)
-	      (tramp-login-program        "plink")
-	      (tramp-copy-program         nil)
-	      (tramp-remote-sh            "/bin/sh")
-	      (tramp-login-args           ("-ssh")) ;optionally add "-v"
-	      (tramp-copy-args            nil)
-	      (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line "xy")) ;see docstring for "xy"
-     ("plink1"
-              (tramp-connection-function  tramp-open-connection-rsh)
-	      (tramp-login-program        "plink")
-	      (tramp-copy-program         nil)
-	      (tramp-remote-sh            "/bin/sh")
-	      (tramp-login-args           ("-1" "-ssh")) ;optionally add "-v"
-	      (tramp-copy-args            nil)
-	      (tramp-copy-keep-date-arg   nil)
-	      (tramp-password-end-of-line "xy")) ;see docstring for "xy"
-     ("pscp"
-              (tramp-connection-function  tramp-open-connection-rsh)
-	      (tramp-login-program        "plink")
-	      (tramp-copy-program         "pscp")
-	      (tramp-remote-sh            "/bin/sh")
-	      (tramp-login-args           ("-ssh"))
-	      (tramp-copy-args            nil)
-	      (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line "xy")) ;see docstring for "xy"
-     ("fcp"
-	      (tramp-connection-function  tramp-open-connection-rsh)
-              (tramp-login-program        "fsh")
-              (tramp-copy-program         "fcp")
-              (tramp-remote-sh            "/bin/sh -i")
-              (tramp-login-args           ("sh" "-i"))
-              (tramp-copy-args            nil)
-              (tramp-copy-keep-date-arg   "-p")
-	      (tramp-password-end-of-line nil))
-     )
-  "*Alist of methods for remote files.
-This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
-Each NAME stands for a remote access method.  Each PARAM is a
-pair of the form (KEY VALUE).  The following KEYs are defined:
- * `tramp-connection-function'
-    This specifies the function to use to connect to the remote host.
-    Currently, `tramp-open-connection-rsh', `tramp-open-connection-telnet'
-    and `tramp-open-connection-su' are defined.  See the documentation
-    of these functions for more details.
-  * `tramp-remote-sh'
-    This specifies the Bourne shell to use on the remote host.  This
-    MUST be a Bourne-like shell.  It is normally not necessary to set
-    this to any value other than \"/bin/sh\": tramp wants to use a shell
-    which groks tilde expansion, but it can search for it.  Also note
-    that \"/bin/sh\" exists on all Unixen, this might not be true for
-    the value that you decide to use.  You Have Been Warned.
-  * `tramp-login-program'
-    This specifies the name of the program to use for logging in to the
-    remote host.  Depending on `tramp-connection-function', this may be
-    the name of rsh or a workalike program (when
-    `tramp-connection-function' is `tramp-open-connection-rsh'), or the
-    name of telnet or a workalike (for `tramp-open-connection-telnet'),
-    or the name of su or a workalike (for `tramp-open-connection-su').
-  * `tramp-login-args'
-    This specifies the list of arguments to pass to the above
-    mentioned program.  Please note that this is a list of arguments,
-    that is, normally you don't want to put \"-a -b\" or \"-f foo\"
-    here.  Instead, you want two list elements, one for \"-a\" and one
-    for \"-b\", or one for \"-f\" and one for \"foo\".
-    If `tramp-connection-function' is `tramp-open-connection-su', then
-    \"%u\" in this list is replaced by the user name, and \"%%\" can
-    be used to obtain a literal percent character.
-  * `tramp-copy-program'
-    This specifies the name of the program to use for remotely copying
-    the file; this might be the absolute filename of rcp or the name of
-    a workalike program.
-  * `tramp-copy-args'
-    This specifies the list of parameters to pass to the above mentioned
-    program, the hints for `tramp-login-args' also apply here.
-  * `tramp-copy-keep-date-arg'
-    This specifies the parameter to use for the copying program when the
-    timestamp of the original file should be kept.  For `rcp', use `-p', for
-    `rsync', use `-t'.
-  * `tramp-password-end-of-line'
-    This specifies the string to use for terminating the line after
-    submitting the password.  If this method parameter is nil, then the
-    value of the normal variable `tramp-default-password-end-of-line'
-    is used.  This parameter is necessary because the \"plink\" program
-    requires any two characters after sending the password.  These do
-    not have to be newline or carriage return characters.  Other login
-    programs are happy with just one character, the newline character.
-    We use \"xy\" as the value for methods using \"plink\".
-
-What does all this mean?  Well, you should specify `tramp-login-program'
-for all methods; this program is used to log in to the remote site.  Then,
-there are two ways to actually transfer the files between the local and the
-remote side.  One way is using an additional rcp-like program.  If you want
-to do this, set `tramp-copy-program' in the method.
-
-Another possibility for file transfer is inline transfer, i.e. the
-file is passed through the same buffer used by `tramp-login-program'.  In
-this case, the file contents need to be protected since the
-`tramp-login-program' might use escape codes or the connection might not
-be eight-bit clean.  Therefore, file contents are encoded for transit.
-See the variable `tramp-coding-commands' for details.
-
-So, to summarize: if the method is an out-of-band method, then you
-must specify `tramp-copy-program' and `tramp-copy-args'.  If it is an
-inline method, then these two parameters should be nil.  Every method,
-inline or out of band, must specify `tramp-connection-function' plus
-the associated arguments (for example, the login program if you chose
-`tramp-open-connection-telnet').
-
-Notes:
-
-When using `tramp-open-connection-su' the phrase `open connection to a
-remote host' sounds strange, but it is used nevertheless, for
-consistency.  No connection is opened to a remote host, but `su' is
-started on the local host.  You are not allowed to specify a remote
-host other than `localhost' or the name of the local host."
-  :group 'tramp
-  :type '(repeat
-          (cons string
-                (set (list (const tramp-connection-function) function)
-                     (list (const tramp-login-program)
-			   (choice (const nil) string))
-                     (list (const tramp-copy-program)
-			   (choice (const nil) string))
-                     (list (const tramp-remote-sh)
-			   (choice (const nil) string))
-                     (list (const tramp-login-args) (repeat string))
-                     (list (const tramp-copy-args) (repeat string))
-                     (list (const tramp-copy-keep-date-arg)
-			   (choice (const nil) string))
-                     (list (const tramp-encoding-command)
-			   (choice (const nil) string))
-                     (list (const tramp-decoding-command)
-			   (choice (const nil) string))
-                     (list (const tramp-encoding-function)
-			   (choice (const nil) function))
-                     (list (const tramp-decoding-function)
-			   (choice (const nil) function))
-		     (list (const tramp-password-end-of-line)
-			   (choice (const nil) string))))))
-
-(defcustom tramp-multi-methods '("multi" "multiu")
-  "*List of multi-hop methods.
-Each entry in this list should be a method name as mentioned in the
-variable `tramp-methods'."
-  :group 'tramp
-  :type '(repeat string))
-
-(defcustom tramp-multi-connection-function-alist
-  '(("telnet" tramp-multi-connect-telnet "telnet %h%n")
-    ("rsh"    tramp-multi-connect-rlogin "rsh %h -l %u%n")
-    ("remsh"  tramp-multi-connect-rlogin "remsh %h -l %u%n")
-    ("ssh"    tramp-multi-connect-rlogin "ssh %h -l %u%n")
-    ("ssht"   tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n")
-    ("su"     tramp-multi-connect-su     "su - %u%n")
-    ("sudo"   tramp-multi-connect-su     "sudo -u %u -s -p Password:%n"))
-  "*List of connection functions for multi-hop methods.
-Each list item is a list of three items (METHOD FUNCTION COMMAND),
-where METHOD is the name as used in the file name, FUNCTION is the
-function to be executed, and COMMAND is the shell command used for
-connecting.
-
-COMMAND may contain percent escapes.  `%u' will be replaced with the
-user name, `%h' will be replaced with the host name, and `%n' will be
-replaced with an end-of-line character, as specified in the variable
-`tramp-rsh-end-of-line'.  Use `%%' for a literal percent character.
-Note that the interpretation of the percent escapes also depends on
-the FUNCTION.  For example, the `%u' escape is forbidden with the
-function `tramp-multi-connect-telnet'.  See the documentation of the
-various functions for details."
-  :group 'tramp
-  :type '(repeat (list string function string)))
-
-(defcustom tramp-default-method
-  (if (and (fboundp 'executable-find)
-	   (executable-find "plink"))
-      "plink"
-    "ssh")
-  "*Default method to use for transferring files.
-See `tramp-methods' for possibilities.
-Also see `tramp-default-method-alist'."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-default-method-alist
-  '(("\\`localhost\\'" "\\`root\\'" "su"))
-  "*Default method to use for specific user/host pairs.
-This is an alist of items (HOST USER METHOD).  The first matching item
-specifies the method to use for a file name which does not specify a
-method.  HOST and USER are regular expressions or nil, which is
-interpreted as a regular expression which always matches.  If no entry
-matches, the variable `tramp-default-method' takes effect.
-
-If the file name does not specify the user, lookup is done using the
-empty string for the user name.
-
-See `tramp-methods' for a list of possibilities for METHOD."
-  :group 'tramp
-  :type '(repeat (list (regexp :tag "Host regexp")
-		       (regexp :tag "User regexp")
-		       (string :tag "Method"))))
-
-;; Default values for non-Unices seeked
-(defconst tramp-completion-function-alist-rsh
-  (unless (memq system-type '(windows-nt))
-    '((tramp-parse-rhosts "/etc/hosts.equiv")
-      (tramp-parse-rhosts "~/.rhosts")))
-  "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.")
-
-;; Default values for non-Unices seeked
-(defconst tramp-completion-function-alist-ssh
-  (unless (memq system-type '(windows-nt))
-    '((tramp-parse-rhosts      "/etc/hosts.equiv")
-      (tramp-parse-rhosts      "/etc/shosts.equiv")
-      (tramp-parse-shosts      "/etc/ssh_known_hosts")
-      (tramp-parse-sconfig     "/etc/ssh_config")
-      (tramp-parse-shostkeys   "/etc/ssh2/hostkeys")
-      (tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
-      (tramp-parse-rhosts      "~/.rhosts")
-      (tramp-parse-rhosts      "~/.shosts")
-      (tramp-parse-shosts      "~/.ssh/known_hosts")
-      (tramp-parse-sconfig     "~/.ssh/config")
-      (tramp-parse-shostkeys   "~/.ssh2/hostkeys")
-      (tramp-parse-sknownhosts "~/.ssh2/knownhosts")))
-  "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
-
-;; Default values for non-Unices seeked
-(defconst tramp-completion-function-alist-telnet
-  (unless (memq system-type '(windows-nt))
-    '((tramp-parse-hosts "/etc/hosts")))
-  "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.")
-
-;; Default values for non-Unices seeked
-(defconst tramp-completion-function-alist-su
-  (unless (memq system-type '(windows-nt))
-    '((tramp-parse-passwd "/etc/passwd")))
-  "Default list of (FUNCTION FILE) pairs to be examined for su methods.")
-
-(defvar tramp-completion-function-alist nil
-  "*Alist of methods for remote files.
-This is a list of entries of the form (NAME PAIR1 PAIR2 ...).
-Each NAME stands for a remote access method.  Each PAIR is of the form
-\(FUNCTION FILE).  FUNCTION is responsible to extract user names and host
-names from FILE for completion.  The following predefined FUNCTIONs exists:
-
- * `tramp-parse-rhosts'      for \"~/.rhosts\" like files,
- * `tramp-parse-shosts'      for \"~/.ssh/known_hosts\" like files,
- * `tramp-parse-sconfig'     for \"~/.ssh/config\" like files,
- * `tramp-parse-shostkeys'   for \"~/.ssh2/hostkeys/*\" like files,
- * `tramp-parse-sknownhosts' for \"~/.ssh2/knownhosts/*\" like files,
- * `tramp-parse-hosts'       for \"/etc/hosts\" like files,
- * `tramp-parse-passwd'      for \"/etc/passwd\" like files.
- * `tramp-parse-netrc'       for \"~/.netrc\" like files.
-
-FUNCTION can also be a customer defined function.  For more details see
-the info pages.")
-
-(eval-after-load "tramp"
-  '(progn
-     (tramp-set-completion-function
-      "rcp" tramp-completion-function-alist-rsh)
-     (tramp-set-completion-function
-      "scp" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "scp1" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "scp2" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "scp1_old" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "scp2_old" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "rsync" tramp-completion-function-alist-rsh)
-     (tramp-set-completion-function
-      "remcp" tramp-completion-function-alist-rsh)
-     (tramp-set-completion-function
-      "rsh" tramp-completion-function-alist-rsh)
-     (tramp-set-completion-function
-      "ssh" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "ssh1" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "ssh2" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "ssh1_old" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "ssh2_old" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "remsh" tramp-completion-function-alist-rsh)
-     (tramp-set-completion-function
-      "telnet" tramp-completion-function-alist-telnet)
-     (tramp-set-completion-function
-      "su" tramp-completion-function-alist-su)
-     (tramp-set-completion-function
-      "sudo" tramp-completion-function-alist-su)
-     (tramp-set-completion-function
-      "multi" nil)
-     (tramp-set-completion-function
-      "scpx" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "sshx" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "krlogin" tramp-completion-function-alist-rsh)
-     (tramp-set-completion-function
-      "plink" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "plink1" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "pscp" tramp-completion-function-alist-ssh)
-     (tramp-set-completion-function
-      "fcp" tramp-completion-function-alist-ssh)))
-
-(defcustom tramp-rsh-end-of-line "\n"
-  "*String used for end of line in rsh connections.
-I don't think this ever needs to be changed, so please tell me about it
-if you need to change this.
-Also see the method parameter `tramp-password-end-of-line' and the normal
-variable `tramp-default-password-end-of-line'."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-default-password-end-of-line
-  tramp-rsh-end-of-line
-  "*String used for end of line after sending a password.
-This variable provides the default value for the method parameter
-`tramp-password-end-of-line', see `tramp-methods' for more details.
-
-It seems that people using plink under Windows need to send
-\"\\r\\n\" (carriage-return, then newline) after a password, but just
-\"\\n\" after all other lines.  This variable can be used for the
-password, see `tramp-rsh-end-of-line' for the other cases.
-
-The default value is to use the same value as `tramp-rsh-end-of-line'."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-remote-path
-  ;; "/usr/xpg4/bin" has been placed first, because on Solaris a POSIX
-  ;; compatible "id" is needed.
-  '("/usr/xpg4/bin" "/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin"
-    "/usr/ccs/bin" "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
-    "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
-  "*List of directories to search for executables on remote host.
-Please notify me about other semi-standard directories to include here.
-
-You can use `~' in this list, but when searching for a shell which groks
-tilde expansion, all directory names starting with `~' will be ignored."
-  :group 'tramp
-  :type '(repeat string))
-
-(defcustom tramp-login-prompt-regexp
-  ".*ogin\\( .*\\)?: *"
-  "*Regexp matching login-like prompts.
-The regexp should match at end of buffer.
-
-Sometimes the prompt is reported to look like \"login as:\"."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-shell-prompt-pattern
-  "^[^#$%>\n]*[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*"
-  "Regexp to match prompts from remote shell.
-Normally, Tramp expects you to configure `shell-prompt-pattern'
-correctly, but sometimes it happens that you are connecting to a
-remote host which sends a different kind of shell prompt.  Therefore,
-Tramp recognizes things matched by `shell-prompt-pattern' as prompt,
-and also things matched by this variable.  The default value of this
-variable is similar to the default value of `shell-prompt-pattern',
-which should work well in many cases."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-password-prompt-regexp
-  "^.*\\([pP]assword\\|passphrase\\).*:\^@? *"
-  "*Regexp matching password-like prompts.
-The regexp should match at end of buffer.
-
-The `sudo' program appears to insert a `^@' character into the prompt."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-wrong-passwd-regexp
-  (concat "^.*"
-	  ;; These strings should be on the last line
-	  (regexp-opt '("Permission denied."
-			"Login incorrect"
-			"Login Incorrect"
-			"Connection refused"
-			"Connection closed"
-			"Sorry, try again."
-			"Name or service not known"
-			"Host key verification failed.") t)
-	  ".*"
-	  "\\|"
-	  "^.*\\("
-	  ;; Here comes a list of regexes, separated by \\|
-	  "Received signal [0-9]+"
-	  "\\).*")
-  "*Regexp matching a `login failed' message.
-The regexp should match at end of buffer."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-yesno-prompt-regexp
-  (concat
-   (regexp-opt '("Are you sure you want to continue connecting (yes/no)?") t)
-   "\\s-*")
-  "Regular expression matching all yes/no queries which need to be confirmed.
-The confirmation should be done with yes or no.
-The regexp should match at end of buffer.
-See also `tramp-yn-prompt-regexp'."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-yn-prompt-regexp
-  (concat (regexp-opt '("Store key in cache? (y/n)") t)
-	  "\\s-*")
-  "Regular expression matching all y/n queries which need to be confirmed.
-The confirmation should be done with y or n.
-The regexp should match at end of buffer.
-See also `tramp-yesno-prompt-regexp'."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-terminal-prompt-regexp
-  (concat "\\("
-	  "TERM = (.*)"
-	  "\\|"
-	  "Terminal type\\? \\[.*\\]"
-	  "\\)\\s-*")
-  "Regular expression matching all terminal setting prompts.
-The regexp should match at end of buffer.
-The answer will be provided by `tramp-action-terminal', which see."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-operation-not-permitted-regexp
-  (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
-	  (regexp-opt '("Operation not permitted") t))
-  "Regular expression matching keep-date problems in (s)cp operations.
-Copying has been performed successfully already, so this message can
-be ignored safely."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-process-alive-regexp
-  ""
-  "Regular expression indicating a process has finished.
-In fact this expression is empty by intention, it will be used only to
-check regularly the status of the associated process.
-The answer will be provided by `tramp-action-process-alive',
-`tramp-multi-action-process-alive' and`tramp-action-out-of-band', which see."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-temp-name-prefix "tramp."
-  "*Prefix to use for temporary files.
-If this is a relative file name (such as \"tramp.\"), it is considered
-relative to the directory name returned by the function
-`tramp-temporary-file-directory' (which see).  It may also be an
-absolute file name; don't forget to include a prefix for the filename
-part, though."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-discard-garbage nil
-  "*If non-nil, try to discard garbage sent by remote shell.
-Some shells send such garbage upon connection setup."
-  :group 'tramp
-  :type 'boolean)
-
-(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
-  "*Alist specifying extra arguments to pass to the remote shell.
-Entries are (REGEXP . ARGS) where REGEXP is a regular expression
-matching the shell file name and ARGS is a string specifying the
-arguments.
-
-This variable is only used when Tramp needs to start up another shell
-for tilde expansion.  The extra arguments should typically prevent the
-shell from reading its init file."
-  :group 'tramp
-  ;; This might be the wrong way to test whether the widget type
-  ;; `alist' is available.  Who knows the right way to test it?
-  :type (if (get 'alist 'widget-type)
-	    '(alist :key-type string :value-type string)
-	  '(repeat (cons string string))))
-
-(defcustom tramp-prefix-format
-  (if tramp-unified-filenames "/" "/[")
-  "*String matching the very beginning of tramp file names.
-Used in `tramp-make-tramp-file-name' and `tramp-make-tramp-multi-file-name'."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-prefix-regexp
-  (concat "^" (regexp-quote tramp-prefix-format))
-  "*Regexp matching the very beginning of tramp file names.
-Should always start with \"^\". Derived from `tramp-prefix-format'."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-method-regexp
-  "[a-zA-Z_0-9-]+"
-  "*Regexp matching methods identifiers."
-  :group 'tramp
-  :type 'regexp)
-
-;; It is a little bit annoying that in XEmacs case this delimeter is different
-;; for single-hop and multi-hop cases.
-(defcustom tramp-postfix-single-method-format
-  (if tramp-unified-filenames ":" "/")
-  "*String matching delimeter between method and user or host names.
-Applicable for single-hop methods.
-Used in `tramp-make-tramp-file-name'."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-postfix-single-method-regexp
-  (regexp-quote tramp-postfix-single-method-format)
-  "*Regexp matching delimeter between method and user or host names.
-Applicable for single-hop methods.
-Derived from `tramp-postfix-single-method-format'."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-postfix-multi-method-format
-  ":"
-  "*String matching delimeter between method and user or host names.
-Applicable for multi-hop methods.
-Used in `tramp-make-tramp-multi-file-name'."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-postfix-multi-method-regexp
-  (regexp-quote tramp-postfix-multi-method-format)
-  "*Regexp matching delimeter between method and user or host names.
-Applicable for multi-hop methods.
-Derived from `tramp-postfix-multi-method-format'."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-postfix-multi-hop-format
-  (if tramp-unified-filenames ":" "/")
-  "*String matching delimeter between host and next method.
-Applicable for multi-hop methods.
-Used in `tramp-make-tramp-multi-file-name'."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-postfix-multi-hop-regexp
-  (regexp-quote tramp-postfix-multi-hop-format)
-  "*Regexp matching delimeter between host and next method.
-Applicable for multi-hop methods.
-Derived from `tramp-postfix-multi-hop-format'."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-user-regexp
-  "[^:/ \t]*"
-  "*Regexp matching user names."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-postfix-user-format
-  "@"
-  "*String matching delimeter between user and host names.
-Used in `tramp-make-tramp-file-name' and `tramp-make-tramp-multi-file-name'."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-postfix-user-regexp
-  (regexp-quote tramp-postfix-user-format)
-  "*Regexp matching delimeter between user and host names.
-Derived from `tramp-postfix-user-format'."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-host-regexp
-  "[a-zA-Z0-9_.-]*"
-  "*Regexp matching host names."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-host-with-port-regexp
-  "[a-zA-Z0-9_.#-]*"
-  "*Regexp matching host names."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-postfix-host-format
-  (if tramp-unified-filenames ":" "]")
-  "*String matching delimeter between host names and localnames.
-Used in `tramp-make-tramp-file-name' and `tramp-make-tramp-multi-file-name'."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-postfix-host-regexp
-  (regexp-quote tramp-postfix-host-format)
-  "*Regexp matching delimeter between host names and localnames.
-Derived from `tramp-postfix-host-format'."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-localname-regexp
-  ".*$"
-  "*Regexp matching localnames."
-  :group 'tramp
-  :type 'regexp)
-
-;; File name format.
-
-(defcustom tramp-file-name-structure
-  (list
-   (concat
-    tramp-prefix-regexp
-    "\\(" "\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp "\\)?"
-    "\\(" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp   "\\)?"
-          "\\(" tramp-host-with-port-regexp "\\)" tramp-postfix-host-regexp
-	  "\\(" tramp-localname-regexp "\\)")
-   2 4 5 6)
-
-  "*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
-the tramp file name structure.
-
-The first element REGEXP is a regular expression matching a tramp file
-name.  The regex should contain parentheses around the method name,
-the user name, the host name, and the file name parts.
-
-The second element METHOD is a number, saying which pair of
-parentheses matches the method name.  The third element USER is
-similar, but for the user name.  The fourth element HOST is similar,
-but for the host name.  The fifth element FILE is for the file name.
-These numbers are passed directly to `match-string', which see.  That
-means the opening parentheses are counted to identify the pair.
-
-See also `tramp-file-name-regexp'."
-  :group 'tramp
-  :type '(list (regexp :tag "File name regexp")
-               (integer :tag "Paren pair for method name")
-               (integer :tag "Paren pair for user name  ")
-               (integer :tag "Paren pair for host name  ")
-               (integer :tag "Paren pair for file name  ")))
-
-;;;###autoload
-(defconst tramp-file-name-regexp-unified
-  "\\`/[^/:]+:"
-  "Value for `tramp-file-name-regexp' for unified remoting.
-Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
-Tramp.  See `tramp-file-name-structure-unified' for more explanations.")
-
-;;;###autoload
-(defconst tramp-file-name-regexp-separate
-  "\\`/\\[.*\\]"
-  "Value for `tramp-file-name-regexp' for separate remoting.
-XEmacs uses a separate filename syntax for Tramp and EFS.
-See `tramp-file-name-structure-separate' for more explanations.")
-
-;;;###autoload
-(defcustom tramp-file-name-regexp
-  (if tramp-unified-filenames
-      tramp-file-name-regexp-unified
-    tramp-file-name-regexp-separate)
-  "*Regular expression matching file names handled by tramp.
-This regexp should match tramp file names but no other file names.
-\(When tramp.el is loaded, this regular expression is prepended to
-`file-name-handler-alist', and that is searched sequentially.  Thus,
-if the tramp entry appears rather early in the `file-name-handler-alist'
-and is a bit too general, then some files might be considered tramp
-files which are not really tramp files.
-
-Please note that the entry in `file-name-handler-alist' is made when
-this file (tramp.el) is loaded.  This means that this variable must be set
-before loading tramp.el.  Alternatively, `file-name-handler-alist' can be
-updated after changing this variable.
-
-Also see `tramp-file-name-structure'."
-  :group 'tramp
-  :type 'regexp)
-
-;;;###autoload
-(defconst tramp-completion-file-name-regexp-unified
-  "^/$\\|^/[^/:][^/]*$"
-  "Value for `tramp-completion-file-name-regexp' for unified remoting.
-Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
-Tramp.  See `tramp-file-name-structure-unified' for more explanations.")
-
-;;;###autoload
-(defconst tramp-completion-file-name-regexp-separate
-  "^/\\([[][^]]*\\)?$"
-  "Value for `tramp-completion-file-name-regexp' for separate remoting.
-XEmacs uses a separate filename syntax for Tramp and EFS.
-See `tramp-file-name-structure-separate' for more explanations.")
-
-;;;###autoload
-(defcustom tramp-completion-file-name-regexp
-  (if tramp-unified-filenames
-      tramp-completion-file-name-regexp-unified
-    tramp-completion-file-name-regexp-separate)
-  "*Regular expression matching file names handled by tramp completion.
-This regexp should match partial tramp file names only.
-
-Please note that the entry in `file-name-handler-alist' is made when
-this file (tramp.el) is loaded.  This means that this variable must be set
-before loading tramp.el.  Alternatively, `file-name-handler-alist' can be
-updated after changing this variable.
-
-Also see `tramp-file-name-structure'."
-  :group 'tramp
-  :type 'regexp)
-
-(defcustom tramp-multi-file-name-structure
-  (list
-   (concat
-    tramp-prefix-regexp
-    "\\(" "\\(" tramp-method-regexp "\\)" "\\)?"
-    "\\(" "\\(" tramp-postfix-multi-hop-regexp "%s" "\\)+" "\\)?"
-    tramp-postfix-host-regexp "\\(" tramp-localname-regexp "\\)")
-   2 3 -1)
-  "*Describes the file name structure of `multi' files.
-Multi files allow you to contact a remote host in several hops.
-This is a list of four elements (REGEXP METHOD HOP LOCALNAME).
-
-The first element, REGEXP, gives a regular expression to match against
-the file name.  In this regular expression, `%s' is replaced with the
-value of `tramp-multi-file-name-hop-structure'.  (Note: in order to
-allow multiple hops, you normally want to use something like
-\"\\\\(\\\\(%s\\\\)+\\\\)\" in the regular expression.  The outer pair
-of parentheses is used for the HOP element, see below.)
-
-All remaining elements are numbers.  METHOD gives the number of the
-paren pair which matches the method name.  HOP gives the number of the
-paren pair which matches the hop sequence.  LOCALNAME gives the number of
-the paren pair which matches the localname (pathname) on the remote host.
-
-LOCALNAME can also be negative, which means to count from the end.  Ie, a
-value of -1 means the last paren pair.
-
-I think it would be good if the regexp matches the whole of the
-string, but I haven't actually tried what happens if it doesn't..."
-  :group 'tramp
-  :type '(list (regexp :tag "File name regexp")
-               (integer :tag "Paren pair for method name")
-               (integer :tag "Paren pair for hops")
-               (integer :tag "Paren pair to match localname")))
-
-(defcustom tramp-multi-file-name-hop-structure
-  (list
-   (concat
-    "\\(" tramp-method-regexp "\\)" tramp-postfix-multi-method-regexp
-    "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
-    "\\(" tramp-host-with-port-regexp "\\)")
-   1 2 3)
-  "*Describes the structure of a hop in multi files.
-This is a list of four elements (REGEXP METHOD USER HOST).  First
-element REGEXP is used to match against the hop.  Pair number METHOD
-matches the method of one hop, pair number USER matches the user of
-one hop, pair number HOST matches the host of one hop.
-
-This regular expression should match exactly all of one hop."
-  :group 'tramp
-  :type '(list (regexp :tag "Hop regexp")
-               (integer :tag "Paren pair for method name")
-               (integer :tag "Paren pair for user name")
-               (integer :tag "Paren pair for host name")))
-
-(defcustom tramp-make-multi-tramp-file-format
-  (list
-   (concat tramp-prefix-format "%m")
-   (concat tramp-postfix-multi-hop-format
-    "%m" tramp-postfix-multi-method-format
-    "%u" tramp-postfix-user-format
-    "%h")
-   (concat tramp-postfix-host-format "%p"))
-  "*Describes how to construct a `multi' file name.
-This is a list of three elements PREFIX, HOP and LOCALNAME.
-
-The first element PREFIX says how to construct the prefix, the second
-element HOP specifies what each hop looks like, and the final element
-LOCALNAME says how to construct the localname (pathname).
-
-In PREFIX, `%%' means `%' and `%m' means the method name.
-
-In HOP, `%%' means `%' and `%m', `%u', `%h' mean the hop method, hop
-user and hop host, respectively.
-
-In LOCALNAME, `%%' means `%' and `%p' means the localname.
-
-The resulting file name always contains one copy of PREFIX and one
-copy of LOCALNAME, but there is one copy of HOP for each hop in the file
-name.
-
-Note: the current implementation requires the prefix to contain the
-method name, followed by all the hops, and the localname must come
-last."
-  :group 'tramp
-  :type '(list string string string))
-
-(defcustom tramp-terminal-type "dumb"
-  "*Value of TERM environment variable for logging in to remote host.
-Because Tramp wants to parse the output of the remote shell, it is easily
-confused by ANSI color escape sequences and suchlike.  Often, shell init
-files conditionalize this setup based on the TERM environment variable."
-  :group 'tramp
-  :type 'string)
-
-(defcustom tramp-completion-without-shell-p nil
-  "*If nil, use shell wildcards for completion, else rely on Lisp only.
-Using shell wildcards for completions has the advantage that it can be
-fast even in large directories, but completion is always
-case-sensitive.  Relying on Lisp only means that case-insensitive
-completion is possible (subject to the variable `completion-ignore-case'),
-but it might be slow on large directories."
-  :group 'tramp
-  :type 'boolean)
-
-(defcustom tramp-actions-before-shell
-  '((tramp-password-prompt-regexp tramp-action-password)
-    (tramp-login-prompt-regexp tramp-action-login)
-    (shell-prompt-pattern tramp-action-succeed)
-    (tramp-shell-prompt-pattern tramp-action-succeed)
-    (tramp-wrong-passwd-regexp tramp-action-permission-denied)
-    (tramp-yesno-prompt-regexp tramp-action-yesno)
-    (tramp-yn-prompt-regexp tramp-action-yn)
-    (tramp-terminal-prompt-regexp tramp-action-terminal)
-    (tramp-process-alive-regexp tramp-action-process-alive))
-  "List of pattern/action pairs.
-Whenever a pattern matches, the corresponding action is performed.
-Each item looks like (PATTERN ACTION).
-
-The PATTERN should be a symbol, a variable.  The value of this
-variable gives the regular expression to search for.  Note that the
-regexp must match at the end of the buffer, \"\\'\" is implicitly
-appended to it.
-
-The ACTION should also be a symbol, but a function.  When the
-corresponding PATTERN matches, the ACTION function is called."
-  :group 'tramp
-  :type '(repeat (list variable function)))
-
-(defcustom tramp-actions-copy-out-of-band
-  '((tramp-password-prompt-regexp tramp-action-password)
-    (tramp-wrong-passwd-regexp tramp-action-permission-denied)
-    (tramp-process-alive-regexp tramp-action-out-of-band))
-  "List of pattern/action pairs.
-This list is used for copying/renaming with out-of-band methods.
-See `tramp-actions-before-shell' for more info."
-  :group 'tramp
-  :type '(repeat (list variable function)))
-
-(defcustom tramp-multi-actions
-  '((tramp-password-prompt-regexp tramp-multi-action-password)
-    (tramp-login-prompt-regexp tramp-multi-action-login)
-    (shell-prompt-pattern tramp-multi-action-succeed)
-    (tramp-shell-prompt-pattern tramp-multi-action-succeed)
-    (tramp-wrong-passwd-regexp tramp-multi-action-permission-denied)
-    (tramp-process-alive-regexp tramp-multi-action-process-alive))
-  "List of pattern/action pairs.
-This list is used for each hop in multi-hop connections.
-See `tramp-actions-before-shell' for more info."
-  :group 'tramp
-  :type '(repeat (list variable function)))
-
-(defcustom tramp-initial-commands
-  '("unset HISTORY"
-    "unset correct"
-    "unset autocorrect")
-  "List of commands to send to the first remote shell that we see.
-These commands will be sent to any shell, and thus they should be
-designed to work in such circumstances.  Also, restrict the commands
-to the bare necessity for getting the remote shell into a state
-where it is possible to execute the Bourne-ish shell.
-
-At the moment, the command to execute the Bourne-ish shell uses strange
-quoting which `tcsh' tries to correct, so we send the command \"unset
-autocorrect\" to the remote host."
-  :group 'tramp
-  :type '(repeat string))
-
-;; Chunked sending kluge.  We set this to 500 for black-listed constellations
-;; known to have a bug in `process-send-string'; some ssh connections appear
-;; to drop bytes when data is sent too quickly.  There is also a connection
-;; buffer local variable, which is computed depending on remote host properties
-;; when `tramp-chunksize' is zero or nil.
-(defcustom tramp-chunksize
-  (when (and (not (featurep 'xemacs))
-	     (memq system-type '(hpux)))
-    500)
-;; Parentheses in docstring starting at beginning of line are escaped.
-;; Fontification is messed up when
-;; `open-paren-in-column-0-is-defun-start' set to t.
-  "*If non-nil, chunksize for sending input to local process.
-It is necessary only on systems which have a buggy `process-send-string'
-implementation.  The necessity, whether this variable must be set, can be
-checked via the following code:
-
-  (with-temp-buffer
-    (let* ((user \"xxx\") (host \"yyy\")
-           (init 0) (step 50)
-           (sent init) (received init))
-      (while (= sent received)
-        (setq sent (+ sent step))
-        (erase-buffer)
-        (let ((proc (start-process (buffer-name) (current-buffer)
-                                   \"ssh\" \"-l\" user host \"wc\" \"-c\")))
-          (when (memq (process-status proc) '(run open))
-            (process-send-string proc (make-string sent ?\\ ))
-            (process-send-eof proc)
-            (process-send-eof proc))
-          (while (not (progn (goto-char (point-min))
-                             (re-search-forward \"\\\\w+\" (point-max) t)))
-            (accept-process-output proc 1))
-          (when (memq (process-status proc) '(run open))
-            (setq received (string-to-number (match-string 0)))
-            (delete-process proc)
-            (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
-            (sit-for 0))))
-      (if (> sent (+ init step))
-          (message \"You should set `tramp-chunksize' to a maximum of %s\"
-                   (- sent step))
-        (message \"Test does not work\")
-        (display-buffer (current-buffer))
-        (sit-for 30))))
-
-In the Emacs normally running Tramp, evaluate the above code
-\(replace \"xxx\" and \"yyy\" by the remote user and host name,
-respectively).  You can do this, for example, by pasting it into
-the `*scratch*' buffer and then hitting C-j with the cursor after the
-last closing parenthesis.  Note that it works only if you have configured
-\"ssh\" to run without password query, see ssh-agent(1).
-
-You will see the number of bytes sent successfully to the remote host.
-If that number exceeds 1000, you can stop the execution by hitting
-C-g, because your Emacs is likely clean.
-
-If your Emacs is buggy, the code stops and gives you an indication
-about the value `tramp-chunksize' should be set.  Maybe you could just
-experiment a bit, e.g. changing the values of `init' and `step'
-in the third line of the code.
-
-When it is necessary to set `tramp-chunksize', you might consider to
-use an out-of-the-band method (like \"scp\") instead of an internal one
-\(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases
-performance.
-
-Please raise a bug report via \"M-x tramp-bug\" if your system needs
-this variable to be set as well."
-  :group 'tramp
-  :type '(choice (const nil) integer))
-
-;; Logging in to a remote host normally requires obtaining a pty.  But
-;; Emacs on MacOS X has process-connection-type set to nil by default,
-;; so on those systems Tramp doesn't obtain a pty.  Here, we allow
-;; for an override of the system default.
-(defcustom tramp-process-connection-type t
-  "Overrides `process-connection-type' for connections from Tramp.
-Tramp binds process-connection-type to the value given here before
-opening a connection to a remote host."
-  :group 'tramp
-  :type '(choice (const nil) (const t) (const pty)))
-
-;;; Internal Variables:
-
-(defvar tramp-buffer-file-attributes nil
-  "Holds the `ls -ild' output for the current buffer.
-This variable is local to each buffer.  It is not used if the remote
-machine groks Perl.  If it is used, it's used as an emulation for
-the visited file modtime.")
-(make-variable-buffer-local 'tramp-buffer-file-attributes)
-
-(defvar tramp-md5-function
-  (cond ((and (require 'md5) (fboundp 'md5)) 'md5)
-	((fboundp 'md5-encode)
-	 (lambda (x) (base64-encode-string
-		      (funcall (symbol-function 'md5-encode) x))))
-	(t (error "Couldn't find an `md5' function")))
-  "Function to call for running the MD5 algorithm.")
-
-(defvar tramp-end-of-output
-  (concat "///"
-	  (funcall tramp-md5-function
-		   (concat
-		    (prin1-to-string process-environment)
-		    (current-time-string)
-;; 		    (prin1-to-string
-;; 		     (if (fboundp 'directory-files-and-attributes)
-;; 			 (funcall 'directory-files-and-attributes
-;; 				  (or (getenv "HOME")
-;; 				      (tramp-temporary-file-directory)))
-;; 		       (mapcar
-;; 			(lambda (x)
-;; 			  (cons x (file-attributes x)))
-;; 			(directory-files (or (getenv "HOME")
-;; 					     (tramp-temporary-file-directory))
-;; 					 t))))
-		    )))
-  "String used to recognize end of output.")
-
-(defvar tramp-connection-function nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-remote-sh nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-login-program nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-login-args nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-copy-program nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-copy-args nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-copy-keep-date-arg nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-encoding-command nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-decoding-command nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-encoding-function nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-decoding-function nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-(defvar tramp-password-end-of-line nil
-  "This internal variable holds a parameter for `tramp-methods'.
-In the connection buffer, this variable has the value of the like-named
-method parameter, as specified in `tramp-methods' (which see).")
-
-;; CCC `local in each buffer'?
-(defvar tramp-ls-command nil
-  "This command is used to get a long listing with numeric user and group ids.
-This variable is automatically made buffer-local to each rsh process buffer
-upon opening the connection.")
-
-(defvar tramp-current-multi-method nil
-  "Name of `multi' connection method for this *tramp* buffer, or nil if not multi.
-This variable is automatically made buffer-local to each rsh process buffer
-upon opening the connection.")
-
-(defvar tramp-current-method nil
-  "Connection method for this *tramp* buffer.
-This variable is automatically made buffer-local to each rsh process buffer
-upon opening the connection.")
-
-(defvar tramp-current-user nil
-  "Remote login name for this *tramp* buffer.
-This variable is automatically made buffer-local to each rsh process buffer
-upon opening the connection.")
-
-(defvar tramp-current-host nil
-  "Remote host for this *tramp* buffer.
-This variable is automatically made buffer-local to each rsh process buffer
-upon opening the connection.")
-
-(defvar tramp-test-groks-nt nil
-  "Whether the `test' command groks the `-nt' switch.
-\(`test A -nt B' tests if file A is newer than file B.)
-This variable is automatically made buffer-local to each rsh process buffer
-upon opening the connection.")
-
-(defvar tramp-file-exists-command nil
-  "Command to use for checking if a file exists.
-This variable is automatically made buffer-local to each rsh process buffer
-upon opening the connection.")
-
-(defconst tramp-uudecode "\
-tramp_uudecode () {
-\(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
-cat /tmp/tramp.$$
-rm -f /tmp/tramp.$$
-}"
-  "Shell function to implement `uudecode' to standard output.
-Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
-for this or `uudecode -p', but some systems don't, and for them
-we have this shell function.")
-
-;; Perl script to implement `file-attributes' in a Lisp `read'able
-;; output.  If you are hacking on this, note that you get *no* output
-;; unless this spits out a complete line, including the '\n' at the
-;; end.
-;; The device number is returned as "-1", because there will be a virtual
-;; device number set in `tramp-handle-file-attributes'
-(defconst tramp-perl-file-attributes "\
-@stat = lstat($ARGV[0]);
-if (($stat[2] & 0170000) == 0120000)
-{
-    $type = readlink($ARGV[0]);
-    $type = \"\\\"$type\\\"\";
-}
-elsif (($stat[2] & 0170000) == 040000)
-{
-    $type = \"t\";
-}
-else
-{
-    $type = \"nil\"
-};
-$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
-$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
-printf(
-    \"(%s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) -1)\\n\",
-    $type,
-    $stat[3],
-    $uid,
-    $gid,
-    $stat[8] >> 16 & 0xffff,
-    $stat[8] & 0xffff,
-    $stat[9] >> 16 & 0xffff,
-    $stat[9] & 0xffff,
-    $stat[10] >> 16 & 0xffff,
-    $stat[10] & 0xffff,
-    $stat[7],
-    $stat[2],
-    $stat[1] >> 16 & 0xffff,
-    $stat[1] & 0xffff
-);"
-  "Perl script to produce output suitable for use with `file-attributes'
-on the remote file system.")
-
-(defconst tramp-perl-directory-files-and-attributes "\
-chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
-opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
-@list = readdir(DIR);
-closedir(DIR);
-$n = scalar(@list);
-printf(\"(\\n\");
-for($i = 0; $i < $n; $i++)
-{
-    $filename = $list[$i];
-    @stat = lstat($filename);
-    if (($stat[2] & 0170000) == 0120000)
-    {
-        $type = readlink($filename);
-        $type = \"\\\"$type\\\"\";
-    }
-    elsif (($stat[2] & 0170000) == 040000)
-    {
-        $type = \"t\";
-    }
-    else
-    {
-        $type = \"nil\"
-    };
-    $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
-    $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
-    printf(
-        \"(\\\"%s\\\" %s %u %s %s (%u %u) (%u %u) (%u %u) %u %u t (%u . %u) (%u %u))\\n\",
-        $filename,
-        $type,
-        $stat[3],
-        $uid,
-        $gid,
-        $stat[8] >> 16 & 0xffff,
-        $stat[8] & 0xffff,
-        $stat[9] >> 16 & 0xffff,
-        $stat[9] & 0xffff,
-        $stat[10] >> 16 & 0xffff,
-        $stat[10] & 0xffff,
-        $stat[7],
-        $stat[2],
-        $stat[1] >> 16 & 0xffff,
-        $stat[1] & 0xffff,
-        $stat[0] >> 16 & 0xffff,
-        $stat[0] & 0xffff);
-}
-printf(\")\\n\");"
-  "Perl script implementing `directory-files-attributes' as Lisp `read'able
-output.")
-
-;; ;; These two use uu encoding.
-;; (defvar tramp-perl-encode "%s -e'\
-;; print qq(begin 644 xxx\n);
-;; my $s = q();
-;; my $res = q();
-;; while (read(STDIN, $s, 45)) {
-;;     print pack(q(u), $s);
-;; }
-;; print qq(`\n);
-;; print qq(end\n);
-;; '"
-;;   "Perl program to use for encoding a file.
-;; Escape sequence %s is replaced with name of Perl binary.")
-
-;; (defvar tramp-perl-decode "%s -ne '
-;; print unpack q(u), $_;
-;; '"
-;;   "Perl program to use for decoding a file.
-;; Escape sequence %s is replaced with name of Perl binary.")
-
-;; These two use base64 encoding.
-(defvar tramp-perl-encode-with-module
-  "perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)'"
-  "Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.
-This implementation requires the MIME::Base64 Perl module to be installed
-on the remote host.")
-
-(defvar tramp-perl-decode-with-module
-  "perl -MMIME::Base64 -0777 -ne 'print decode_base64($_)'"
-  "Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.
-This implementation requires the MIME::Base64 Perl module to be installed
-on the remote host.")
-
-(defvar tramp-perl-encode
-  "%s -e '
-# This script contributed by Juanma Barranquero .
-# Copyright (C) 2002, 2006 Free Software Foundation, Inc.
-use strict;
-
-my %%trans = do {
-    my $i = 0;
-    map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
-      split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
-};
-
-binmode(\\*STDIN);
-
-# We read in chunks of 54 bytes, to generate output lines
-# of 72 chars (plus end of line)
-$/ = \\54;
-
-while (my $data = ) {
-    my $pad = q();
-
-    # Only for the last chunk, and only if did not fill the last three-byte packet
-    if (eof) {
-        my $mod = length($data) %% 3;
-        $pad = q(=) x (3 - $mod) if $mod;
-    }
-
-    # Not the fastest method, but it is simple: unpack to binary string, split
-    # by groups of 6 bits and convert back from binary to byte; then map into
-    # the translation table
-    print
-      join q(),
-        map($trans{$_},
-            (substr(unpack(q(B*), $data) . q(00000), 0, 432) =~ /....../g)),
-              $pad,
-                qq(\\n);
-}
-'"
-  "Perl program to use for encoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
-
-(defvar tramp-perl-decode
-  "%s -e '
-# This script contributed by Juanma Barranquero .
-# Copyright (C) 2002, 2006 Free Software Foundation, Inc.
-use strict;
-
-my %%trans = do {
-    my $i = 0;
-    map {($_, substr(unpack(q(B8), chr $i++), 2, 6))}
-      split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/)
-};
-
-my %%bytes = map {(unpack(q(B8), chr $_), chr $_)} 0 .. 255;
-
-binmode(\\*STDOUT);
-
-# We are going to accumulate into $pending to accept any line length
-# (we do not check they are <= 76 chars as the RFC says)
-my $pending = q();
-
-while (my $data = ) {
-    chomp $data;
-
-    # If we find one or two =, we have reached the end and
-    # any following data is to be discarded
-    my $finished = $data =~ s/(==?).*/$1/;
-    $pending .= $data;
-
-    my $len = length($pending);
-    my $chunk = substr($pending, 0, $len & ~3);
-    $pending = substr($pending, $len & ~3 + 1);
-
-    # Easy method: translate from chars to (pregenerated) six-bit packets, join,
-    # split in 8-bit chunks and convert back to char.
-    print join q(),
-      map $bytes{$_},
-        ((join q(), map {$trans{$_} || q()} split //, $chunk) =~ /......../g);
-
-    last if $finished;
-}
-'"
-  "Perl program to use for decoding a file.
-Escape sequence %s is replaced with name of Perl binary.
-This string is passed to `format', so percent characters need to be doubled.")
-
-; These values conform to `file-attributes' from XEmacs 21.2.
-; GNU Emacs and other tools not checked.
-(defconst tramp-file-mode-type-map '((0  . "-")  ; Normal file (SVID-v2 and XPG2)
-				     (1  . "p")  ; fifo
-				     (2  . "c")  ; character device
-				     (3  . "m")  ; multiplexed character device (v7)
-				     (4  . "d")  ; directory
-				     (5  . "?")  ; Named special file (XENIX)
-				     (6  . "b")  ; block device
-				     (7  . "?")  ; multiplexed block device (v7)
-				     (8  . "-")  ; regular file
-				     (9  . "n")  ; network special file (HP-UX)
-				     (10 . "l")  ; symlink
-				     (11 . "?")  ; ACL shadow inode (Solaris, not userspace)
-				     (12 . "s")  ; socket
-				     (13 . "D")  ; door special (Solaris)
-				     (14 . "w")) ; whiteout (BSD)
-  "A list of file types returned from the `stat' system call.
-This is used to map a mode number to a permission string.")
-
-(defvar tramp-dos-coding-system
-  (if (and (fboundp 'coding-system-p)
-           (funcall 'coding-system-p '(dos)))
-      'dos
-    'undecided-dos)
-  "Some Emacsen know the `dos' coding system, others need `undecided-dos'.")
-
-(defvar tramp-last-cmd nil
-  "Internal Tramp variable recording the last command sent.
-This variable is buffer-local in every buffer.")
-(make-variable-buffer-local 'tramp-last-cmd)
-
-(defvar tramp-process-echoes nil
-  "Whether to process echoes from the remote shell.")
-
-(defvar tramp-last-cmd-time nil
-  "Internal Tramp variable recording the time when the last cmd was sent.
-This variable is buffer-local in every buffer.")
-(make-variable-buffer-local 'tramp-last-cmd-time)
-
-;; This variable does not have the right value in XEmacs.  What should
-;; I use instead of find-operation-coding-system in XEmacs?
-(defvar tramp-feature-write-region-fix
-  (when (fboundp 'find-operation-coding-system)
-    (let ((file-coding-system-alist '(("test" emacs-mule))))
-      (funcall (symbol-function 'find-operation-coding-system)
-	       'write-region 0 0 "" nil "test")))
-    "Internal variable to say if `write-region' chooses the right coding.
-Older versions of Emacs chose the coding system for `write-region' based
-on the FILENAME argument, even if VISIT was a string.")
-
-;; New handlers should be added here.  The following operations can be
-;; handled using the normal primitives: file-name-as-directory,
-;; file-name-directory, file-name-nondirectory,
-;; file-name-sans-versions, get-file-buffer.
-(defconst tramp-file-name-handler-alist
-  '(
-    (load . tramp-handle-load)
-    (make-symbolic-link . tramp-handle-make-symbolic-link)
-    (file-name-directory . tramp-handle-file-name-directory)
-    (file-name-nondirectory . tramp-handle-file-name-nondirectory)
-    (file-truename . tramp-handle-file-truename)
-    (file-exists-p . tramp-handle-file-exists-p)
-    (file-directory-p . tramp-handle-file-directory-p)
-    (file-executable-p . tramp-handle-file-executable-p)
-    (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
-    (file-readable-p . tramp-handle-file-readable-p)
-    (file-regular-p . tramp-handle-file-regular-p)
-    (file-symlink-p . tramp-handle-file-symlink-p)
-    (file-writable-p . tramp-handle-file-writable-p)
-    (file-ownership-preserved-p . tramp-handle-file-ownership-preserved-p)
-    (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
-    (file-attributes . tramp-handle-file-attributes)
-    (file-modes . tramp-handle-file-modes)
-    (directory-files . tramp-handle-directory-files)
-    (directory-files-and-attributes . tramp-handle-directory-files-and-attributes)
-    (file-name-all-completions . tramp-handle-file-name-all-completions)
-    (file-name-completion . tramp-handle-file-name-completion)
-    (add-name-to-file . tramp-handle-add-name-to-file)
-    (copy-file . tramp-handle-copy-file)
-    (rename-file . tramp-handle-rename-file)
-    (set-file-modes . tramp-handle-set-file-modes)
-    (make-directory . tramp-handle-make-directory)
-    (delete-directory . tramp-handle-delete-directory)
-    (delete-file . tramp-handle-delete-file)
-    (directory-file-name . tramp-handle-directory-file-name)
-    (shell-command . tramp-handle-shell-command)
-    (process-file . tramp-handle-process-file)
-    (insert-directory . tramp-handle-insert-directory)
-    (expand-file-name . tramp-handle-expand-file-name)
-    (file-local-copy . tramp-handle-file-local-copy)
-    (file-remote-p . tramp-handle-file-remote-p)
-    (insert-file-contents . tramp-handle-insert-file-contents)
-    (write-region . tramp-handle-write-region)
-    (find-backup-file-name . tramp-handle-find-backup-file-name)
-    (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
-    (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
-    (dired-compress-file . tramp-handle-dired-compress-file)
-    (dired-call-process . tramp-handle-dired-call-process)
-    (dired-recursive-delete-directory
-     . tramp-handle-dired-recursive-delete-directory)
-    (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
-    (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime))
-  "Alist of handler functions.
-Operations not mentioned here will be handled by the normal Emacs functions.")
-
-;; Handlers for partial tramp file names. For GNU Emacs just
-;; `file-name-all-completions' is needed. The other ones are necessary
-;; for XEmacs.
-(defconst tramp-completion-file-name-handler-alist
-  '(
-    (file-name-directory . tramp-completion-handle-file-name-directory)
-    (file-name-nondirectory . tramp-completion-handle-file-name-nondirectory)
-    (file-exists-p . tramp-completion-handle-file-exists-p)
-    (file-name-all-completions . tramp-completion-handle-file-name-all-completions)
-    (file-name-completion . tramp-completion-handle-file-name-completion)
-    (expand-file-name . tramp-completion-handle-expand-file-name))
-  "Alist of completion handler functions.
-Used for file names matching `tramp-file-name-regexp'. Operations not
-mentioned here will be handled by `tramp-file-name-handler-alist' or the
-normal Emacs functions.")
-
-;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
-(defvar tramp-foreign-file-name-handler-alist
-  ;; (identity . tramp-sh-file-name-handler) should always be the last
-  ;; entry, since `identity' always matches.
-  '((identity . tramp-sh-file-name-handler))
-  "Alist of elements (FUNCTION . HANDLER) for foreign methods handled specially.
-If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
-calling HANDLER.")
-
-;;; Internal functions which must come first.
-
-(defsubst tramp-message (level fmt-string &rest args)
-  "Emit a message depending on verbosity level.
-First arg LEVEL says to be quiet if `tramp-verbose' is less than LEVEL.  The
-message is emitted only if `tramp-verbose' is greater than or equal to LEVEL.
-Calls function `message' with FMT-STRING as control string and the remaining
-ARGS to actually emit the message (if applicable).
-
-This function expects to be called from the tramp buffer only!"
-  (when (<= level tramp-verbose)
-    (apply #'message (concat "tramp: " fmt-string) args)
-    (when tramp-debug-buffer
-      (save-excursion
-        (set-buffer
-         (tramp-get-debug-buffer
-	  tramp-current-multi-method tramp-current-method
-	  tramp-current-user tramp-current-host))
-        (goto-char (point-max))
-	(unless (bolp)
-	  (insert "\n"))
-	(tramp-insert-with-face
-         'italic
-         (concat "# " (apply #'format fmt-string args) "\n"))))))
-
-(defun tramp-message-for-buffer
-  (multi-method method user host level fmt-string &rest args)
-  "Like `tramp-message' but temporarily switches to the tramp buffer.
-First three args METHOD, USER, and HOST identify the tramp buffer to use,
-remaining args passed to `tramp-message'."
-  (save-excursion
-    (set-buffer (tramp-get-buffer multi-method method user host))
-    (apply 'tramp-message level fmt-string args)))
-
-(defsubst tramp-line-end-position nil
-  "Return point at end of line.
-Calls `line-end-position' or `point-at-eol' if defined, else
-own implementation."
-  (cond
-   ((fboundp 'line-end-position) (funcall (symbol-function 'line-end-position)))
-   ((fboundp 'point-at-eol) 	 (funcall (symbol-function 'point-at-eol)))
-   (t (save-excursion (end-of-line) (point)))))
-
-(defmacro with-parsed-tramp-file-name (filename var &rest body)
-  "Parse a Tramp filename and make components available in the body.
-
-First arg FILENAME is evaluated and dissected into its components.
-Second arg VAR is a symbol.  It is used as a variable name to hold
-the filename structure.  It is also used as a prefix for the variables
-holding the components.  For example, if VAR is the symbol `foo', then
-`foo' will be bound to the whole structure, `foo-multi-method' will
-be bound to the multi-method component, and so on for `foo-method',
-`foo-user', `foo-host', `foo-localname'.
-
-Remaining args are Lisp expressions to be evaluated (inside an implicit
-`progn').
-
-If VAR is nil, then we bind `v' to the structure and `multi-method',
-`method', `user', `host', `localname' to the components."
-  `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
-	  (,(if var (intern (concat (symbol-name var) "-multi-method")) 'multi-method)
-	   (tramp-file-name-multi-method ,(or var 'v)))
-	  (,(if var (intern (concat (symbol-name var) "-method")) 'method)
-	   (tramp-file-name-method ,(or var 'v)))
-	  (,(if var (intern (concat (symbol-name var) "-user")) 'user)
-	   (tramp-file-name-user ,(or var 'v)))
-	  (,(if var (intern (concat (symbol-name var) "-host")) 'host)
-	   (tramp-file-name-host ,(or var 'v)))
-	  (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
-	   (tramp-file-name-localname ,(or var 'v))))
-     ,@body))
-
-(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
-;; To be activated for debugging containing this macro
-;; It works only when VAR is nil.  Otherwise, it can be deactivated by
-;; (put 'with-parsed-tramp-file-name 'edebug-form-spec 0)
-;; I'm too stupid to write a precise SPEC for it.
-(put 'with-parsed-tramp-file-name 'edebug-form-spec t)
-
-(defmacro tramp-let-maybe (variable value &rest body)
-  "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
-BODY is executed whether or not the variable is obsolete.
-The intent is to protect against `obsolete variable' warnings."
-  `(if (get ',variable 'byte-obsolete-variable)
-       (progn ,@body)
-     (let ((,variable ,value))
-       ,@body)))
-(put 'tramp-let-maybe 'lisp-indent-function 2)
-(put 'tramp-let-maybe 'edebug-form-spec t)
-
-;;; Config Manipulation Functions:
-
-(defun tramp-set-completion-function (method function-list)
-  "Sets the list of completion functions for METHOD.
-FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
-The FUNCTION is intended to parse FILE according its syntax.
-It might be a predefined FUNCTION, or a user defined FUNCTION.
-Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
-`tramp-parse-sconfig',`tramp-parse-hosts', `tramp-parse-passwd',
-and `tramp-parse-netrc'.
-
-Example:
-
-    (tramp-set-completion-function
-     \"ssh\"
-     '((tramp-parse-sconfig \"/etc/ssh_config\")
-       (tramp-parse-sconfig \"~/.ssh/config\")))"
-
-  (let ((r function-list)
-	(v function-list))
-    (setq tramp-completion-function-alist
-	  (delete (assoc method tramp-completion-function-alist)
-		  tramp-completion-function-alist))
-
-    (while v
-      ;; Remove double entries
-      (when (member (car v) (cdr v))
-	(setcdr v (delete (car v) (cdr v))))
-      ;; Check for function and file
-      (unless (and (functionp (nth 0 (car v)))
-		   (file-exists-p (nth 1 (car v))))
-	(setq r (delete (car v) r)))
-      (setq v (cdr v)))
-
-    (when r
-      (add-to-list 'tramp-completion-function-alist
-		   (cons method r)))))
-
-(defun tramp-get-completion-function (method)
-  "Returns list of completion functions for METHOD.
-For definition of that list see `tramp-set-completion-function'."
-  (cdr (assoc method tramp-completion-function-alist)))
-
-;;; File Name Handler Functions:
-
-(defun tramp-handle-make-symbolic-link
-  (filename linkname &optional ok-if-already-exists)
-  "Like `make-symbolic-link' for tramp files.
-If LINKNAME is a non-Tramp file, it is used verbatim as the target of
-the symlink.  If LINKNAME is a Tramp file, only the localname component is
-used as the target of the symlink.
-
-If LINKNAME is a Tramp file and the localname component is relative, then
-it is expanded first, before the localname component is taken.  Note that
-this can give surprising results if the user/host for the source and
-target of the symlink differ."
-  (with-parsed-tramp-file-name linkname l
-    (let ((ln (tramp-get-remote-ln l-multi-method l-method l-user l-host))
-	  (cwd (file-name-directory l-localname)))
-      (unless ln
-	(signal 'file-error
-		(list "Making a symbolic link."
-		      "ln(1) does not exist on the remote host.")))
-
-      ;; Do the 'confirm if exists' thing.
-      (when (file-exists-p linkname)
-	;; What to do?
-	(if (or (null ok-if-already-exists) ; not allowed to exist
-		(and (numberp ok-if-already-exists)
-		     (not (yes-or-no-p
-			   (format
-			    "File %s already exists; make it a link anyway? "
-			    l-localname)))))
-	    (signal 'file-already-exists (list "File already exists" l-localname))
-	  (delete-file linkname)))
-
-      ;; If FILENAME is a Tramp name, use just the localname component.
-      (when (tramp-tramp-file-p filename)
-	(setq filename (tramp-file-name-localname
-			(tramp-dissect-file-name
-			 (expand-file-name filename)))))
-
-      ;; Right, they are on the same host, regardless of user, method, etc.
-      ;; We now make the link on the remote machine. This will occur as the user
-      ;; that FILENAME belongs to.
-      (zerop
-       (tramp-send-command-and-check
-	l-multi-method l-method l-user l-host
-	(format "cd %s && %s -sf %s %s"
-		cwd ln
-		filename
-		l-localname)
-	t)))))
-
-
-(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
-  "Like `load' for tramp files.  Not implemented!"
-  (unless (file-name-absolute-p file)
-    (error "Tramp cannot `load' files without absolute file name"))
-  (with-parsed-tramp-file-name file nil
-    (unless nosuffix
-      (cond ((file-exists-p (concat file ".elc"))
-	     (setq file (concat file ".elc")))
-	    ((file-exists-p (concat file ".el"))
-	     (setq file (concat file ".el")))))
-    (when must-suffix
-      ;; The first condition is always true for absolute file names.
-      ;; Included for safety's sake.
-      (unless (or (file-name-directory file)
-		  (string-match "\\.elc?\\'" file))
-	(error "File `%s' does not include a `.el' or `.elc' suffix"
-	       file)))
-    (unless noerror
-      (when (not (file-exists-p file))
-	(error "Cannot load nonexistent file `%s'" file)))
-    (if (not (file-exists-p file))
-	nil
-      (unless nomessage
-	(message "Loading %s..." file))
-      (let ((local-copy (file-local-copy file)))
-	;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
-	(load local-copy noerror t t)
-	(delete-file local-copy))
-      (unless nomessage
-	(message "Loading %s...done" file))
-      t)))
-
-;; Localname manipulation functions that grok TRAMP localnames...
-(defun tramp-handle-file-name-directory (file)
-  "Like `file-name-directory' but aware of TRAMP files."
-  ;; everything except the last filename thing is the directory
-  (with-parsed-tramp-file-name file nil
-    ;; For the following condition, two possibilities should be tried:
-    ;; (1) (string= localname "")
-    ;; (2) (or (string= localname "") (string= localname "/"))
-    ;; The second variant fails when completing a "/" directory on
-    ;; the remote host, that is a filename which looks like
-    ;; "/user@host:/".  But maybe wildcards fail with the first variant.
-    ;; We should do some investigation.
-    (if (string= localname "")
-	;; For a filename like "/[foo]", we return "/".  The `else'
-	;; case would return "/[foo]" unchanged.  But if we do that,
-	;; then `file-expand-wildcards' ceases to work.  It's not
-	;; quite clear to me what's the intuition that tells that this
-	;; behavior is the right behavior, but oh, well.
-	"/"
-      ;; run the command on the localname portion only
-      ;; CCC: This should take into account the remote machine type, no?
-      ;;  --daniel 
-      (tramp-make-tramp-file-name multi-method method user host
-				  ;; This will not recurse...
-				  (or (file-name-directory localname) "")))))
-
-(defun tramp-handle-file-name-nondirectory (file)
-  "Like `file-name-nondirectory' but aware of TRAMP files."
-  (with-parsed-tramp-file-name file nil
-    (file-name-nondirectory localname)))
-
-(defun tramp-handle-file-truename (filename &optional counter prev-dirs)
-  "Like `file-truename' for tramp files."
-  (with-parsed-tramp-file-name (expand-file-name filename) nil
-    (let* ((steps        (tramp-split-string localname "/"))
-	   (localnamedir (tramp-let-maybe directory-sep-char ?/	;for XEmacs
-			   (file-name-as-directory localname)))
-	   (is-dir (string= localname localnamedir))
-	   (thisstep nil)
-	   (numchase 0)
-	   ;; Don't make the following value larger than necessary.
-	   ;; People expect an error message in a timely fashion when
-	   ;; something is wrong; otherwise they might think that Emacs
-	   ;; is hung.  Of course, correctness has to come first.
-	   (numchase-limit 20)
-	   (result nil)			;result steps in reverse order
-	   symlink-target)
-      (tramp-message-for-buffer
-       multi-method method user host
-       10 "Finding true name for `%s'" filename)
-      (while (and steps (< numchase numchase-limit))
-	(setq thisstep (pop steps))
-	(tramp-message-for-buffer
-	 multi-method method user host
-	 10 "Check %s"
-	 (mapconcat 'identity
-		    (append '("") (reverse result) (list thisstep))
-		    "/"))
-	(setq symlink-target
-	      (nth 0 (file-attributes
-		      (tramp-make-tramp-file-name
-		       multi-method method user host
-		       (mapconcat 'identity
-				  (append '("")
-					  (reverse result)
-					  (list thisstep))
-				  "/")))))
-	(cond ((string= "." thisstep)
-	       (tramp-message-for-buffer multi-method method user host
-					 10 "Ignoring step `.'"))
-	      ((string= ".." thisstep)
-	       (tramp-message-for-buffer multi-method method user host
-					 10 "Processing step `..'")
-	       (pop result))
-	      ((stringp symlink-target)
-	       ;; It's a symlink, follow it.
-	       (tramp-message-for-buffer
-		multi-method method user host
-		10 "Follow symlink to %s" symlink-target)
-	       (setq numchase (1+ numchase))
-	       (when (file-name-absolute-p symlink-target)
-		 (setq result nil))
-	       ;; If the symlink was absolute, we'll get a string like
-	       ;; "/user@host:/some/target"; extract the
-	       ;; "/some/target" part from it.
-	       (when (tramp-tramp-file-p symlink-target)
-		 (with-parsed-tramp-file-name symlink-target sym
-		   (unless (equal (list multi-method method user host)
-				  (list sym-multi-method sym-method
-					sym-user sym-host))
-		     (error "Symlink target `%s' on wrong host"
-			    symlink-target))
-		   (setq symlink-target localname)))
-	       (setq steps
-		     (append (tramp-split-string symlink-target "/") steps)))
-	      (t
-	       ;; It's a file.
-	       (setq result (cons thisstep result)))))
-      (when (>= numchase numchase-limit)
-	(error "Maximum number (%d) of symlinks exceeded" numchase-limit))
-      (setq result (reverse result))
-      ;; Combine list to form string.
-      (setq result
-	    (if result
-		(mapconcat 'identity (cons "" result) "/")
-	      "/"))
-      (when (and is-dir (or (string= "" result)
-			    (not (string= (substring result -1) "/"))))
-	(setq result (concat result "/")))
-      (tramp-message-for-buffer
-       multi-method method user host
-       10 "True name of `%s' is `%s'" filename result)
-      (tramp-make-tramp-file-name
-       multi-method method user host result))))
-
-;; Basic functions.
-
-(defun tramp-handle-file-exists-p (filename)
-  "Like `file-exists-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (save-excursion
-      (zerop (tramp-send-command-and-check
-	      multi-method method user host
-	      (format
-	       (tramp-get-file-exists-command multi-method method user host)
-	       (tramp-shell-quote-argument localname)))))))
-
-;; Devices must distinguish physical file systems.  The device numbers
-;; provided by "lstat" aren't unique, because we operate on different hosts.
-;; So we use virtual device numbers, generated by Tramp.  Both Ange-FTP and
-;; EFS use device number "-1".  In order to be different, we use device number
-;; (-1 x), whereby "x" is unique for a given (multi-method method user host).
-(defvar tramp-devices nil
-  "Keeps virtual device numbers.")
-
-;; CCC: This should check for an error condition and signal failure
-;;      when something goes wrong.
-;; Daniel Pittman 
-(defun tramp-handle-file-attributes (filename &optional id-format)
-  "Like `file-attributes' for tramp files."
-  (when (file-exists-p filename)
-    ;; file exists, find out stuff
-    (unless id-format (setq id-format 'integer))
-    (with-parsed-tramp-file-name filename nil
-      (save-excursion
-        (tramp-convert-file-attributes
-         multi-method method user host
-         (if (tramp-get-remote-perl multi-method method user host)
-             (tramp-handle-file-attributes-with-perl multi-method method user host
-                                                     localname id-format)
-           (tramp-handle-file-attributes-with-ls multi-method method user host
-                                                 localname id-format)))))))
-
-(defun tramp-handle-file-attributes-with-ls
-  (multi-method method user host localname &optional id-format)
-  "Implement `file-attributes' for tramp files using the ls(1) command."
-  (let (symlinkp dirp
-		 res-inode res-filemodes res-numlinks
-		 res-uid res-gid res-size res-symlink-target)
-    (tramp-message-for-buffer multi-method method user host 10
-			      "file attributes with ls: %s"
-			      (tramp-make-tramp-file-name
-			       multi-method method user host localname))
-    (tramp-send-command
-     multi-method method user host
-     (format "%s %s %s"
-	     (tramp-get-ls-command multi-method method user host)
-	     (if (eq id-format 'integer) "-ildn" "-ild")
-	     (tramp-shell-quote-argument localname)))
-    (tramp-wait-for-output)
-    ;; parse `ls -l' output ...
-    ;; ... inode
-    (setq res-inode
-	  (condition-case err
-	      (read (current-buffer))
-	    (invalid-read-syntax
-	     (when (and (equal (cadr err)
-			       "Integer constant overflow in reader")
-			(string-match
-			 "^[0-9]+\\([0-9][0-9][0-9][0-9][0-9]\\)\\'"
-			 (caddr err)))
-	       (let* ((big (read (substring (caddr err) 0
-					    (match-beginning 1))))
-		      (small (read (match-string 1 (caddr err))))
-		      (twiddle (/ small 65536)))
-		 (cons (+ big twiddle)
-		       (- small (* twiddle 65536))))))))
-    ;; ... file mode flags
-    (setq res-filemodes (symbol-name (read (current-buffer))))
-    ;; ... number links
-    (setq res-numlinks (read (current-buffer)))
-    ;; ... uid and gid
-    (setq res-uid (read (current-buffer)))
-    (setq res-gid (read (current-buffer)))
-    (when (eq id-format 'integer)
-      (unless (numberp res-uid) (setq res-uid -1))
-      (unless (numberp res-gid) (setq res-gid -1)))
-    ;; ... size
-    (setq res-size (read (current-buffer)))
-    ;; From the file modes, figure out other stuff.
-    (setq symlinkp (eq ?l (aref res-filemodes 0)))
-    (setq dirp (eq ?d (aref res-filemodes 0)))
-    ;; if symlink, find out file name pointed to
-    (when symlinkp
-      (search-forward "-> ")
-      (setq res-symlink-target
-	    (buffer-substring (point)
-			      (tramp-line-end-position))))
-    ;; return data gathered
-    (list
-     ;; 0. t for directory, string (name linked to) for symbolic
-     ;; link, or nil.
-     (or dirp res-symlink-target nil)
-     ;; 1. Number of links to file.
-     res-numlinks
-     ;; 2. File uid.
-     res-uid
-     ;; 3. File gid.
-     res-gid
-     ;; 4. Last access time, as a list of two integers. First
-     ;; integer has high-order 16 bits of time, second has low 16
-     ;; bits.
-     ;; 5. Last modification time, likewise.
-     ;; 6. Last status change time, likewise.
-     '(0 0) '(0 0) '(0 0)		;CCC how to find out?
-     ;; 7. Size in bytes (-1, if number is out of range).
-     res-size
-     ;; 8. File modes, as a string of ten letters or dashes as in ls -l.
-     res-filemodes
-     ;; 9. t iff file's gid would change if file were deleted and
-     ;; recreated.  Will be set in `tramp-convert-file-attributes'
-     t
-     ;; 10. inode number.
-     res-inode
-     ;; 11. Device number.  Will be replaced by a virtual device number.
-     -1
-     )))
-
-(defun tramp-handle-file-attributes-with-perl
-  (multi-method method user host localname &optional id-format)
-  "Implement `file-attributes' for tramp files using a Perl script."
-  (tramp-message-for-buffer multi-method method user host 10
-			    "file attributes with perl: %s"
-			    (tramp-make-tramp-file-name
-			     multi-method method user host localname))
-  (tramp-maybe-send-perl-script multi-method method user host
-				tramp-perl-file-attributes
-                                "tramp_file_attributes")
-  (tramp-send-command multi-method method user host
-                      (format "tramp_file_attributes %s %s"
-                              (tramp-shell-quote-argument localname) id-format))
-  (tramp-wait-for-output)
-  (read (current-buffer)))
-
-(defun tramp-handle-set-visited-file-modtime (&optional time-list)
-  "Like `set-visited-file-modtime' for tramp files."
-  (unless (buffer-file-name)
-    (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file"
-	   (buffer-name)))
-  (if time-list
-      (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
-    (let ((f (buffer-file-name))
-	  coding-system-used)
-      (with-parsed-tramp-file-name f nil
-	(let* ((attr (file-attributes f))
-	       ;; '(-1 65535) means file doesn't exists yet.
-	       (modtime (or (nth 5 attr) '(-1 65535))))
-	  (when (boundp 'last-coding-system-used)
-	    (setq coding-system-used (symbol-value 'last-coding-system-used)))
-	  ;; We use '(0 0) as a don't-know value.  See also
-	  ;; `tramp-handle-file-attributes-with-ls'.
-	  (if (not (equal modtime '(0 0)))
-	      (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
-	    (save-excursion
-	      (tramp-send-command
-	       multi-method method user host
-	       (format "%s -ild %s"
-		       (tramp-get-ls-command multi-method method user host)
-		       (tramp-shell-quote-argument localname)))
-	      (tramp-wait-for-output)
-	      (setq attr (buffer-substring (point)
-					   (progn (end-of-line) (point)))))
-	    (setq tramp-buffer-file-attributes attr))
-	  (when (boundp 'last-coding-system-used)
-	    (set 'last-coding-system-used coding-system-used))
-	  nil)))))
-
-;; CCC continue here
-
-;; This function makes the same assumption as
-;; `tramp-handle-set-visited-file-modtime'.
-(defun tramp-handle-verify-visited-file-modtime (buf)
-  "Like `verify-visited-file-modtime' for tramp files.
-At the time `verify-visited-file-modtime' calls this function, we
-already know that the buffer is visiting a file and that
-`visited-file-modtime' does not return 0.  Do not call this
-function directly, unless those two cases are already taken care
-of."
-  (with-current-buffer buf
-    ;; There is no file visiting the buffer, or the buffer has no
-    ;; recorded last modification time.
-    (if (or (not (buffer-file-name))
-	    (eq (visited-file-modtime) 0))
-	t
-      (let ((f (buffer-file-name)))
-	(with-parsed-tramp-file-name f nil
-	  (let* ((attr (file-attributes f))
-		 (modtime (nth 5 attr))
-		 (mt (visited-file-modtime)))
-
- 	    (cond
-	     ;; file exists, and has a known modtime.
-	     ((and attr (not (equal modtime '(0 0))))
-	      (< (abs (tramp-time-diff
-		       modtime
-		       ;; For compatibility, deal with both the old
-		       ;; (HIGH . LOW) and the new (HIGH LOW)
-		       ;; return values of `visited-file-modtime'.
-		       (if (atom (cdr mt))
-			   (list (car mt) (cdr mt))
-			 mt)))
-		 2))
-	     ;; modtime has the don't know value.
-	     (attr
-	      (save-excursion
-		(tramp-send-command
-		 multi-method method user host
-		 (format "%s -ild %s"
-			 (tramp-get-ls-command multi-method method user host)
-			 (tramp-shell-quote-argument localname)))
-		(tramp-wait-for-output)
-		(setq attr (buffer-substring
-			    (point) (progn (end-of-line) (point)))))
-	      (equal tramp-buffer-file-attributes attr))
-	     ;; If file does not exist, say it is not modified
-	     ;; if and only if that agrees with the buffer's record.
-	     (t (equal mt '(-1 65535))))))))))
-
-(defun tramp-handle-set-file-modes (filename mode)
-  "Like `set-file-modes' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (save-excursion
-      (unless (zerop (tramp-send-command-and-check
-		      multi-method method user host
-		      (format "chmod %s %s"
-			      (tramp-decimal-to-octal mode)
-			      (tramp-shell-quote-argument localname))))
-	(signal 'file-error
-		(list "Doing chmod"
-		      ;; FIXME: extract the proper text from chmod's stderr.
-		      "error while changing file's mode"
-		      filename))))))
-
-;; Simple functions using the `test' command.
-
-(defun tramp-handle-file-executable-p (filename)
-  "Like `file-executable-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (zerop (tramp-run-test "-x" filename))))
-
-(defun tramp-handle-file-readable-p (filename)
-  "Like `file-readable-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (zerop (tramp-run-test "-r" filename))))
-
-(defun tramp-handle-file-accessible-directory-p (filename)
-  "Like `file-accessible-directory-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (and (zerop (tramp-run-test "-d" filename))
-	 (zerop (tramp-run-test "-r" filename))
-	 (zerop (tramp-run-test "-x" filename)))))
-
-;; When the remote shell is started, it looks for a shell which groks
-;; tilde expansion.  Here, we assume that all shells which grok tilde
-;; expansion will also provide a `test' command which groks `-nt' (for
-;; newer than).  If this breaks, tell me about it and I'll try to do
-;; something smarter about it.
-(defun tramp-handle-file-newer-than-file-p (file1 file2)
-  "Like `file-newer-than-file-p' for tramp files."
-  (cond ((not (file-exists-p file1))
-         nil)
-        ((not (file-exists-p file2))
-         t)
-        ;; We are sure both files exist at this point.
-        (t
-         (save-excursion
-	   ;; We try to get the mtime of both files.  If they are not
-	   ;; equal to the "dont-know" value, then we subtract the times
-	   ;; and obtain the result.
-	   (let ((fa1 (file-attributes file1))
-		 (fa2 (file-attributes file2)))
-	     (if (and (not (equal (nth 5 fa1) '(0 0)))
-		      (not (equal (nth 5 fa2) '(0 0))))
-		 (> 0 (tramp-time-diff (nth 5 fa2) (nth 5 fa1)))
-	       ;; If one of them is the dont-know value, then we can
-	       ;; still try to run a shell command on the remote host.
-	       ;; However, this only works if both files are Tramp
-	       ;; files and both have the same method, same user, same
-	       ;; host.
-	       (unless (and (tramp-tramp-file-p file1)
-			    (tramp-tramp-file-p file2))
-		 (signal
-		  'file-error
-		  (list
-		   "Cannot check if Tramp file is newer than non-Tramp file"
-		   file1 file2)))
-	       (with-parsed-tramp-file-name file1 v1
-		 (with-parsed-tramp-file-name file2 v2
-		   (unless (and (equal v1-multi-method v2-multi-method)
-				(equal v1-method v2-method)
-				(equal v1-user v2-user)
-				(equal v1-host v2-host))
-		     (signal 'file-error
-			     (list "Files must have same method, user, host"
-				   file1 file2)))
-		   (unless (and (tramp-tramp-file-p file1)
-				(tramp-tramp-file-p file2))
-		     (signal 'file-error
-			     (list "Files must be tramp files on same host"
-				   file1 file2)))
-		   (if (tramp-get-test-groks-nt
-			v1-multi-method v1-method v1-user v1-host)
-		       (zerop (tramp-run-test2 "test" file1 file2 "-nt"))
-		     (zerop (tramp-run-test2
-			     "tramp_test_nt" file1 file2)))))))))))
-
-;; Functions implemented using the basic functions above.
-
-(defun tramp-handle-file-modes (filename)
-  "Like `file-modes' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (when (file-exists-p filename)
-      (tramp-mode-string-to-int
-       (nth 8 (file-attributes filename))))))
-
-(defun tramp-handle-file-directory-p (filename)
-  "Like `file-directory-p' for tramp files."
-  ;; Care must be taken that this function returns `t' for symlinks
-  ;; pointing to directories.  Surely the most obvious implementation
-  ;; would be `test -d', but that returns false for such symlinks.
-  ;; CCC: Stefan Monnier says that `test -d' follows symlinks.  And
-  ;; I now think he's right.  So we could be using `test -d', couldn't
-  ;; we?
-  ;;
-  ;; Alternatives: `cd %s', `test -d %s'
-  (with-parsed-tramp-file-name filename nil
-    (save-excursion
-      (zerop
-       (tramp-send-command-and-check
-	multi-method method user host
-	(format "test -d %s"
-		(tramp-shell-quote-argument localname))
-	t)))))				;run command in subshell
-
-(defun tramp-handle-file-regular-p (filename)
-  "Like `file-regular-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (and (file-exists-p filename)
-	 (eq ?- (aref (nth 8 (file-attributes filename)) 0)))))
-
-(defun tramp-handle-file-symlink-p (filename)
-  "Like `file-symlink-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (let ((x (car (file-attributes filename))))
-      (when (stringp x)
-	;; When Tramp is running on VMS, then `file-name-absolute-p'
-	;; might do weird things.
-	(if (file-name-absolute-p x)
-	    (tramp-make-tramp-file-name
-	     multi-method method user host x)
-	  x)))))
-
-(defun tramp-handle-file-writable-p (filename)
-  "Like `file-writable-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (if (file-exists-p filename)
-	;; Existing files must be writable.
-	(zerop (tramp-run-test "-w" filename))
-      ;; If file doesn't exist, check if directory is writable.
-      (and (zerop (tramp-run-test
-		   "-d" (file-name-directory filename)))
-	   (zerop (tramp-run-test
-		   "-w" (file-name-directory filename)))))))
-
-(defun tramp-handle-file-ownership-preserved-p (filename)
-  "Like `file-ownership-preserved-p' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (let ((attributes (file-attributes filename)))
-      ;; Return t if the file doesn't exist, since it's true that no
-      ;; information would be lost by an (attempted) delete and create.
-      (or (null attributes)
-	  (= (nth 2 attributes)
-	     (tramp-get-remote-uid multi-method method user host))))))
-
-;; Other file name ops.
-
-;; ;; Matthias K,Av(Bppe 
-;; (defun tramp-handle-directory-file-name (directory)
-;;   "Like `directory-file-name' for tramp files."
-;;   (if (and (eq (aref directory (- (length directory) 1)) ?/)
-;; 	   (not (eq (aref directory (- (length directory) 2)) ?:)))
-;;       (substring directory 0 (- (length directory) 1))
-;;     directory))
-
-;; ;; Philippe Troin 
-;; (defun tramp-handle-directory-file-name (directory)
-;;   "Like `directory-file-name' for tramp files."
-;;   (with-parsed-tramp-file-name directory nil
-;;     (let ((directory-length-1 (1- (length directory))))
-;;       (save-match-data
-;; 	(if (and (eq (aref directory directory-length-1) ?/)
-;; 		 (eq (string-match tramp-file-name-regexp directory) 0)
-;; 		 (/= (match-end 0) directory-length-1))
-;; 	    (substring directory 0 directory-length-1)
-;; 	  directory)))))
-
-(defun tramp-handle-directory-file-name (directory)
-  "Like `directory-file-name' for tramp files."
-  ;; If localname component of filename is "/", leave it unchanged.
-  ;; Otherwise, remove any trailing slash from localname component.
-  ;; Method, host, etc, are unchanged.  Does it make sense to try
-  ;; to avoid parsing the filename?
-  (with-parsed-tramp-file-name directory nil
-    (if (and (not (zerop (length localname)))
-	     (eq (aref localname (1- (length localname))) ?/)
-	     (not (string= localname "/")))
-	(substring directory 0 -1)
-      directory)))
-
-;; Directory listings.
-
-(defun tramp-handle-directory-files (directory
-				     &optional full match nosort files-only)
-  "Like `directory-files' for tramp files."
-  (with-parsed-tramp-file-name directory nil
-    (let (result x)
-      (save-excursion
-	(tramp-barf-unless-okay
-	 multi-method method user host
-	 (concat "cd " (tramp-shell-quote-argument localname))
-	 nil
-	 'file-error
-	 "tramp-handle-directory-files: couldn't `cd %s'"
-	 (tramp-shell-quote-argument localname))
-	(tramp-send-command
-	 multi-method method user host
-	 (concat (tramp-get-ls-command multi-method method user host)
-		 " -a | cat"))
-	(tramp-wait-for-output)
-	(goto-char (point-max))
-	(while (zerop (forward-line -1))
-	  (setq x (buffer-substring (point)
-				    (tramp-line-end-position)))
-	  (when (or (not match) (string-match match x))
-	    (if full
-		(push (concat (file-name-as-directory directory)
-			      x)
-		      result)
-	      (push x result))))
-	(tramp-send-command multi-method method user host "cd")
-	(tramp-wait-for-output)
-	;; Remove non-files or non-directories if necessary.  Using
-	;; the remote shell for this would probably be way faster.
-	;; Maybe something could be adapted from
-	;; tramp-handle-file-name-all-completions.
-	(when files-only
-	  (let ((temp (nreverse result))
-		item)
-	    (setq result nil)
-	    (if (equal files-only t)
-		;; files only
-		(while temp
-		  (setq item (pop temp))
-		  (when (file-regular-p item)
-		    (push item result)))
-	      ;; directories only
-	      (while temp
-		(setq item (pop temp))
-		(when (file-directory-p item)
-		  (push item result)))))))
-      result)))
-
-(defun tramp-handle-directory-files-and-attributes
-  (directory &optional full match nosort id-format)
-  "Like `directory-files-and-attributes' for tramp files."
-  (when (tramp-handle-file-exists-p directory)
-    (save-excursion
-      (setq directory (tramp-handle-expand-file-name directory))
-      (with-parsed-tramp-file-name directory nil
-        (tramp-maybe-send-perl-script multi-method method user host
-				      tramp-perl-directory-files-and-attributes
-                                      "tramp_directory_files_and_attributes")
-        (tramp-send-command multi-method method user host
-                            (format "tramp_directory_files_and_attributes %s %s"
-                                    (tramp-shell-quote-argument localname)
-                                    (or id-format 'integer)))
-        (tramp-wait-for-output)
-        (let* ((root (cons nil (let ((object (read (current-buffer))))
-                                 (when (stringp object)
-                                   (error object))
-                                 object)))
-               (cell root))
-          (while (cdr cell)
-            (if (and match (not (string-match match (caadr cell))))
-                ;; Remove from list
-                (setcdr cell (cddr cell))
-              ;; Include in list
-              (setq cell (cdr cell))
-              (let ((l (car cell)))
-                (tramp-convert-file-attributes multi-method method user host
-                                               (cdr l))
-                ;; If FULL, make file name absolute
-                (when full (setcar l (concat directory "/" (car l)))))))
-          (if nosort
-              (cdr root)
-            (sort (cdr root) (lambda (x y) (string< (car x) (car y))))))))))
-
-;; This function should return "foo/" for directories and "bar" for
-;; files.  We use `ls -ad' to get a list of files (including
-;; directories), and `find . -type d \! -name . -prune' to get a list
-;; of directories.
-(defun tramp-handle-file-name-all-completions (filename directory)
-  "Like `file-name-all-completions' for tramp files."
-  (with-parsed-tramp-file-name directory nil
-    (unless (save-match-data (string-match "/" filename))
-      (let* ((nowild tramp-completion-without-shell-p)
-	     result)
-	(save-excursion
-	  (tramp-barf-unless-okay
-	   multi-method method user host
-	   (format "cd %s" (tramp-shell-quote-argument localname))
-	   nil 'file-error
-	   "tramp-handle-file-name-all-completions: Couldn't `cd %s'"
-	   (tramp-shell-quote-argument localname))
-
-	  ;; Get a list of directories and files, including reliably
-	  ;; tagging the directories with a trailing '/'.  Because I
-	  ;; rock.  --daniel@danann.net
-	  (tramp-send-command
-	   multi-method method user host
-	   (format (concat "%s -a %s 2>/dev/null | while read f; do "
-			   "if test -d \"$f\" 2>/dev/null; "
-			   "then echo \"$f/\"; else echo \"$f\"; fi; done")
-		   (tramp-get-ls-command multi-method method user host)
-		   (if (or nowild (zerop (length filename)))
-		       ""
-		     (format "-d %s*"
-			     (tramp-shell-quote-argument filename)))))
-
-	  ;; Now grab the output.
-	  (tramp-wait-for-output)
-	  (goto-char (point-max))
-	  (while (zerop (forward-line -1))
-	    (push (buffer-substring (point)
-				    (tramp-line-end-position))
-		  result))
-
-	  (tramp-send-command multi-method method user host "cd")
-	  (tramp-wait-for-output)
-
-	  ;; Return the list.
-	  (if nowild
-	      (all-completions filename (mapcar 'list result))
-	    result))))))
-
-
-;; The following isn't needed for Emacs 20 but for 19.34?
-(defun tramp-handle-file-name-completion (filename directory)
-  "Like `file-name-completion' for tramp files."
-  (unless (tramp-tramp-file-p directory)
-    (error
-     "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
-     directory))
-  (with-parsed-tramp-file-name directory nil
-    (try-completion
-     filename
-     (mapcar (lambda (x) (cons x nil))
-	     (file-name-all-completions filename directory)))))
-
-;; cp, mv and ln
-
-(defun tramp-handle-add-name-to-file
-  (filename newname &optional ok-if-already-exists)
-  "Like `add-name-to-file' for tramp files."
-  (with-parsed-tramp-file-name filename v1
-    (with-parsed-tramp-file-name newname v2
-      (let ((ln (when v1 (tramp-get-remote-ln
-			  v1-multi-method v1-method v1-user v1-host))))
-	(unless (and v1-method v2-method v1-user v2-user v1-host v2-host
-		     (equal v1-multi-method v2-multi-method)
-		     (equal v1-method v2-method)
-		     (equal v1-user v2-user)
-		     (equal v1-host v2-host))
-	  (error "add-name-to-file: %s"
-		 "only implemented for same method, same user, same host"))
-	(when (and (not ok-if-already-exists)
-		   (file-exists-p newname)
-		   (not (numberp ok-if-already-exists))
-		   (y-or-n-p
-		    (format
-		     "File %s already exists; make it a new name anyway? "
-		     newname)))
-	  (error "add-name-to-file: file %s already exists" newname))
-	(tramp-barf-unless-okay
-	 v1-multi-method v1-method v1-user v1-host
-	 (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
-		 (tramp-shell-quote-argument v2-localname))
-	 nil 'file-error
-	 "error with add-name-to-file, see buffer `%s' for details"
-	 (buffer-name))))))
-
-(defun tramp-handle-copy-file
-  (filename newname &optional ok-if-already-exists keep-date)
-  "Like `copy-file' for tramp files."
-  ;; Check if both files are local -- invoke normal copy-file.
-  ;; Otherwise, use tramp from local system.
-  (setq filename (expand-file-name filename))
-  (setq newname (expand-file-name newname))
-  ;; At least one file a tramp file?
-  (if (or (tramp-tramp-file-p filename)
-          (tramp-tramp-file-p newname))
-      (tramp-do-copy-or-rename-file
-       'copy filename newname ok-if-already-exists keep-date)
-    (tramp-run-real-handler
-     'copy-file
-     (list filename newname ok-if-already-exists keep-date))))
-
-(defun tramp-handle-rename-file
-  (filename newname &optional ok-if-already-exists)
-  "Like `rename-file' for tramp files."
-  ;; Check if both files are local -- invoke normal rename-file.
-  ;; Otherwise, use tramp from local system.
-  (setq filename (expand-file-name filename))
-  (setq newname (expand-file-name newname))
-  ;; At least one file a tramp file?
-  (if (or (tramp-tramp-file-p filename)
-          (tramp-tramp-file-p newname))
-      (tramp-do-copy-or-rename-file
-       'rename filename newname ok-if-already-exists)
-    (tramp-run-real-handler 'rename-file
-                          (list filename newname ok-if-already-exists))))
-
-(defun tramp-do-copy-or-rename-file
-  (op filename newname &optional ok-if-already-exists keep-date)
-  "Copy or rename a remote file.
-OP must be `copy' or `rename' and indicates the operation to perform.
-FILENAME specifies the file to copy or rename, NEWNAME is the name of
-the new file (for copy) or the new name of the file (for rename).
-OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
-KEEP-DATE means to make sure that NEWNAME has the same timestamp
-as FILENAME.
-
-This function is invoked by `tramp-handle-copy-file' and
-`tramp-handle-rename-file'.  It is an error if OP is neither of `copy'
-and `rename'.  FILENAME and NEWNAME must be absolute file names."
-  (unless (memq op '(copy rename))
-    (error "Unknown operation `%s', must be `copy' or `rename'" op))
-  (unless ok-if-already-exists
-    (when (file-exists-p newname)
-      (signal 'file-already-exists
-              (list newname))))
-  (let ((t1 (tramp-tramp-file-p filename))
-	(t2 (tramp-tramp-file-p newname))
-	v1-multi-method v1-method v1-user v1-host v1-localname
-	v2-multi-method v2-method v2-user v2-host v2-localname)
-
-    ;; Check which ones of source and target are Tramp files.
-    ;; We cannot invoke `with-parsed-tramp-file-name';
-    ;; it fails if the file isn't a Tramp file name.
-    (if t1
-	(with-parsed-tramp-file-name filename l
-	  (setq v1-multi-method l-multi-method
-		v1-method l-method
-		v1-user l-user
-		v1-host l-host
-		v1-localname l-localname))
-      (setq v1-localname filename))
-    (if t2
-	(with-parsed-tramp-file-name newname l
-	  (setq v2-multi-method l-multi-method
-		v2-method l-method
-		v2-user l-user
-		v2-host l-host
-		v2-localname l-localname))
-      (setq v2-localname newname))
-
-    (cond
-     ;; Both are Tramp files.
-     ((and t1 t2)
-      (cond
-       ;; Shortcut: if method, host, user are the same for both
-       ;; files, we invoke `cp' or `mv' on the remote host
-       ;; directly.
-       ((and (equal v1-multi-method v2-multi-method)
-	     (equal v1-method v2-method)
-	     (equal v1-user v2-user)
-	     (equal v1-host v2-host))
-	(tramp-do-copy-or-rename-file-directly
-	 op v1-multi-method v1-method v1-user v1-host
-	 v1-localname v2-localname keep-date))
-       ;; If both source and target are Tramp files,
-       ;; both are using the same copy-program, then we
-       ;; can invoke rcp directly.  Note that
-       ;; default-directory should point to a local
-       ;; directory if we want to invoke rcp.
-       ((and (not v1-multi-method)
-	     (not v2-multi-method)
-	     (equal v1-method v2-method)
-	     (tramp-method-out-of-band-p
-	      v1-multi-method v1-method v1-user v1-host)
-	     (not (string-match "\\([^#]*\\)#\\(.*\\)" v1-host))
-	     (not (string-match "\\([^#]*\\)#\\(.*\\)" v2-host)))
-	(tramp-do-copy-or-rename-file-out-of-band
-	 op filename newname keep-date))
-       ;; No shortcut was possible.  So we copy the
-       ;; file first.  If the operation was `rename', we go
-       ;; back and delete the original file (if the copy was
-       ;; successful).  The approach is simple-minded: we
-       ;; create a new buffer, insert the contents of the
-       ;; source file into it, then write out the buffer to
-       ;; the target file.  The advantage is that it doesn't
-       ;; matter which filename handlers are used for the
-       ;; source and target file.
-       (t
-	(tramp-do-copy-or-rename-file-via-buffer
-	 op filename newname keep-date))))
-
-     ;; One file is a Tramp file, the other one is local.
-     ((or t1 t2)
-      ;; If the Tramp file has an out-of-band method, the corresponding
-      ;; copy-program can be invoked.
-      (if (and (not v1-multi-method)
-	       (not v2-multi-method)
-	       (or (tramp-method-out-of-band-p
-		    v1-multi-method v1-method v1-user v1-host)
-		   (tramp-method-out-of-band-p
-		    v2-multi-method v2-method v2-user v2-host)))
-	  (tramp-do-copy-or-rename-file-out-of-band
-	   op filename newname keep-date)
-	;; Use the generic method via a Tramp buffer.
-	(tramp-do-copy-or-rename-file-via-buffer
-	 op filename newname keep-date)))
-
-     (t
-      ;; One of them must be a Tramp file.
-      (error "Tramp implementation says this cannot happen")))))
-
-(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
-  "Use an Emacs buffer to copy or rename a file.
-First arg OP is either `copy' or `rename' and indicates the operation.
-FILENAME is the source file, NEWNAME the target file.
-KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
-  (let ((trampbuf (get-buffer-create "*tramp output*"))
-	(modtime (nth 5 (file-attributes filename))))
-    (when (and keep-date (or (null modtime) (equal modtime '(0 0))))
-      (tramp-message
-       1 (concat "Warning: cannot preserve file time stamp"
-		 " with inline copying across machines")))
-    (save-excursion
-      (set-buffer trampbuf) (erase-buffer)
-      (insert-file-contents-literally filename)
-      ;; We don't want the target file to be compressed, so we let-bind
-      ;; `jka-compr-inhibit' to t.
-      (let ((coding-system-for-write 'binary)
-	    (jka-compr-inhibit t))
-	(write-region (point-min) (point-max) newname))
-      ;; KEEP-DATE handling.
-      (when keep-date
-	(when (and (not (null modtime))
-		   (not (equal modtime '(0 0))))
-	  (tramp-touch newname modtime)))
-      ;; Set the mode.
-      (set-file-modes newname (file-modes filename)))
-    ;; If the operation was `rename', delete the original file.
-    (unless (eq op 'copy)
-      (delete-file filename))))
-
-(defun tramp-do-copy-or-rename-file-directly
-  (op multi-method method user host localname1 localname2 keep-date)
-  "Invokes `cp' or `mv' on the remote system.
-OP must be one of `copy' or `rename', indicating `cp' or `mv',
-respectively.  METHOD, USER, and HOST specify the connection.
-LOCALNAME1 and LOCALNAME2 specify the two arguments of `cp' or `mv'.
-If KEEP-DATE is non-nil, preserve the time stamp when copying."
-  ;; CCC: What happens to the timestamp when renaming?
-  (let ((cmd (cond ((and (eq op 'copy) keep-date) "cp -f -p")
-                   ((eq op 'copy) "cp -f")
-                   ((eq op 'rename) "mv -f")
-                   (t (error
-                       "Unknown operation `%s', must be `copy' or `rename'"
-                       op)))))
-    (save-excursion
-      (tramp-send-command
-       multi-method method user host
-       (format "%s %s %s"
-               cmd
-               (tramp-shell-quote-argument localname1)
-               (tramp-shell-quote-argument localname2)))
-      (tramp-wait-for-output)
-      (goto-char (point-min))
-      (unless
-	  (or
-	   (and (eq op 'copy) keep-date
-		;; Mask cp -f error.
-		(re-search-forward tramp-operation-not-permitted-regexp nil t))
-	   (zerop (tramp-send-command-and-check
-		   multi-method method user host nil nil)))
-	(pop-to-buffer (current-buffer))
-	(signal 'file-error
-		(format "Copying directly failed, see buffer `%s' for details."
-			(buffer-name)))))
-    ;; Set the mode.
-    ;; CCC: Maybe `chmod --reference=localname1 localname2' could be used
-    ;;      where available?
-    (unless (or (eq op 'rename) keep-date)
-      (set-file-modes
-       (tramp-make-tramp-file-name multi-method method user host localname2)
-       (file-modes
-	(tramp-make-tramp-file-name
-	 multi-method method user host localname1))))))
-
-(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
-  "Invoke rcp program to copy.
-One of FILENAME and NEWNAME must be a Tramp name, the other must
-be a local filename.  The method used must be an out-of-band method."
-  (let ((t1 (tramp-tramp-file-p filename))
-	(t2 (tramp-tramp-file-p newname))
-	v1-multi-method v1-method v1-user v1-host v1-localname
-	v2-multi-method v2-method v2-user v2-host v2-localname
-	multi-method method user host copy-program copy-args
-	source target trampbuf)
-
-    ;; Check which ones of source and target are Tramp files.
-    ;; We cannot invoke `with-parsed-tramp-file-name';
-    ;; it fails if the file isn't a Tramp file name.
-    (if t1
-	(with-parsed-tramp-file-name filename l
-	  (setq v1-multi-method l-multi-method
-		v1-method l-method
-		v1-user l-user
-		v1-host l-host
-		v1-localname l-localname
-		multi-method l-multi-method
-		method (tramp-find-method
-			v1-multi-method v1-method v1-user v1-host)
-		user l-user
-		host l-host
-		copy-program (tramp-get-method-parameter
-			      v1-multi-method method
-			      v1-user v1-host 'tramp-copy-program)
-		copy-args (tramp-get-method-parameter
-				 v1-multi-method method
-				 v1-user v1-host 'tramp-copy-args)))
-      (setq v1-localname filename))
-
-    (if t2
-	(with-parsed-tramp-file-name newname l
-	  (setq v2-multi-method l-multi-method
-		v2-method l-method
-		v2-user l-user
-		v2-host l-host
-		v2-localname l-localname
-		multi-method l-multi-method
-		method (tramp-find-method
-			v2-multi-method v2-method v2-user v2-host)
-		user l-user
-		host l-host
-		copy-program (tramp-get-method-parameter
-			      v2-multi-method method
-			      v2-user v2-host 'tramp-copy-program)
-		copy-args (tramp-get-method-parameter
-				 v2-multi-method method
-				 v2-user v2-host 'tramp-copy-args)))
-      (setq v2-localname newname))
-
-    ;; The following should be changed.  We need a more general
-    ;; mechanism to parse extra host args.
-    (if (not t1)
-	(setq source v1-localname)
-      (when (string-match "\\([^#]*\\)#\\(.*\\)" v1-host)
-	(setq copy-args (cons "-P" (cons (match-string 2 v1-host) copy-args)))
-	(setq v1-host (match-string 1 v1-host)))
-      (setq source
-	     (tramp-make-copy-program-file-name
-	      v1-user v1-host
-	      (tramp-shell-quote-argument v1-localname))))
-
-    (if (not t2)
-	(setq target v2-localname)
-      (when (string-match "\\([^#]*\\)#\\(.*\\)" v2-host)
-	(setq copy-args (cons "-P" (cons (match-string 2 v2-host) copy-args)))
-	(setq v2-host (match-string 1 v2-host)))
-      (setq target
-	     (tramp-make-copy-program-file-name
-	      v2-user v2-host
-	      (tramp-shell-quote-argument v2-localname))))
-
-    ;; Handle keep-date argument
-    (when keep-date
-      (if t1
-	  (setq copy-args
-		(cons (tramp-get-method-parameter
-		       v1-multi-method method
-		       v1-user v1-host 'tramp-copy-keep-date-arg)
-		      copy-args))
-	(setq copy-args
-	      (cons (tramp-get-method-parameter
-		     v2-multi-method method
-		     v2-user v2-host 'tramp-copy-keep-date-arg)
-		    copy-args))))
-
-    (setq copy-args (append copy-args (list source target))
-	  trampbuf (generate-new-buffer
-		    (tramp-buffer-name multi-method method user host)))
-
-    ;; Use an asynchronous process.  By this, password can be handled.
-    (save-excursion
-
-      ;; Check for program.
-      (when (and (fboundp 'executable-find)
-		 (not (executable-find copy-program)))
-	(error "Cannot find copy program: %s" copy-program))
-
-      (set-buffer trampbuf)
-      (setq tramp-current-multi-method multi-method
-	    tramp-current-method method
-	    tramp-current-user user
-	    tramp-current-host host)
-      (message "Transferring %s to %s..." filename newname)
-
-      ;; Use rcp-like program for file transfer.
-      (let ((p (apply 'start-process (buffer-name trampbuf) trampbuf
-		      copy-program copy-args)))
-	(tramp-set-process-query-on-exit-flag p nil)
-	(tramp-process-actions p multi-method method user host
-			       tramp-actions-copy-out-of-band))
-      (kill-buffer trampbuf)
-      (message "Transferring %s to %s...done" filename newname)
-
-      ;; Set the mode.
-      (unless keep-date
-	(set-file-modes newname (file-modes filename))))
-
-    ;; If the operation was `rename', delete the original file.
-    (unless (eq op 'copy)
-      (delete-file filename))))
-
-;; mkdir
-(defun tramp-handle-make-directory (dir &optional parents)
-  "Like `make-directory' for tramp files."
-  (setq dir (expand-file-name dir))
-  (with-parsed-tramp-file-name dir nil
-    (save-excursion
-      (tramp-barf-unless-okay
-       multi-method method user host
-       (format " %s %s"
-	       (if parents "mkdir -p" "mkdir")
-	       (tramp-shell-quote-argument localname))
-       nil 'file-error
-       "Couldn't make directory %s" dir))))
-
-;; CCC error checking?
-(defun tramp-handle-delete-directory (directory)
-  "Like `delete-directory' for tramp files."
-  (setq directory (expand-file-name directory))
-  (with-parsed-tramp-file-name directory nil
-    (save-excursion
-      (tramp-send-command
-       multi-method method user host
-       (format "rmdir %s ; echo ok"
-	       (tramp-shell-quote-argument localname)))
-      (tramp-wait-for-output))))
-
-(defun tramp-handle-delete-file (filename)
-  "Like `delete-file' for tramp files."
-  (setq filename (expand-file-name filename))
-  (with-parsed-tramp-file-name filename nil
-    (save-excursion
-      (unless (zerop (tramp-send-command-and-check
-		      multi-method method user host
-		      (format "rm -f %s"
-			      (tramp-shell-quote-argument localname))))
-	(signal 'file-error "Couldn't delete Tramp file")))))
-
-;; Dired.
-
-;; CCC: This does not seem to be enough. Something dies when
-;;      we try and delete two directories under TRAMP :/
-(defun tramp-handle-dired-recursive-delete-directory (filename)
-  "Recursively delete the directory given.
-This is like `dired-recursive-delete-directory' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    ;; run a shell command 'rm -r '
-    ;; Code shamelessly stolen for the dired implementation and, um, hacked :)
-    (or (file-exists-p filename)
-	(signal
-	 'file-error
-	 (list "Removing old file name" "no such directory" filename)))
-    ;; Which is better, -r or -R? (-r works for me )
-    (tramp-send-command multi-method method user host
-			(format "rm -r %s" (tramp-shell-quote-argument localname)))
-    ;; Wait for the remote system to return to us...
-    ;; This might take a while, allow it plenty of time.
-    (tramp-wait-for-output 120)
-    ;; Make sure that it worked...
-    (and (file-exists-p filename)
-	 (error "Failed to recursively delete %s" filename))))
-
-(defun tramp-handle-dired-call-process (program discard &rest arguments)
-  "Like `dired-call-process' for tramp files."
-  (with-parsed-tramp-file-name default-directory nil
-    (save-excursion
-      (tramp-barf-unless-okay
-       multi-method method user host
-       (format "cd %s" (tramp-shell-quote-argument localname))
-       nil 'file-error
-       "tramp-handle-dired-call-process: Couldn't `cd %s'"
-       (tramp-shell-quote-argument localname))
-      (tramp-send-command
-       multi-method method user host
-       (mapconcat #'tramp-shell-quote-argument (cons program arguments) " "))
-      (tramp-wait-for-output))
-    (unless discard
-      ;; We cannot use `insert-buffer' because the tramp buffer
-      ;; changes its contents before insertion due to calling
-      ;; `expand-file' and alike.
-      (insert
-       (with-current-buffer
-	   (tramp-get-buffer multi-method method user host)
-	 (buffer-string))))
-    (save-excursion
-      (prog1
-	  (tramp-send-command-and-check multi-method method user host nil)
-	(tramp-send-command multi-method method user host "cd")
-	(tramp-wait-for-output)))))
-
-(defun tramp-handle-dired-compress-file (file &rest ok-flag)
-  "Like `dired-compress-file' for tramp files."
-  ;; OK-FLAG is valid for XEmacs only, but not implemented.
-  ;; Code stolen mainly from dired-aux.el.
-  (with-parsed-tramp-file-name file nil
-    (save-excursion
-      (let ((suffixes
-	     (if (not (featurep 'xemacs))
-		 ;; Emacs case
-		 (symbol-value 'dired-compress-file-suffixes)
-	       ;; XEmacs has `dired-compression-method-alist', which is
-	       ;; transformed into `dired-compress-file-suffixes' structure.
-	       (mapcar
-		'(lambda (x)
-		   (list (concat (regexp-quote (nth 1 x)) "\\'")
-			 nil
-			 (mapconcat 'identity (nth 3 x) " ")))
-		(symbol-value 'dired-compression-method-alist))))
-	    suffix)
-	;; See if any suffix rule matches this file name.
-	(while suffixes
-	  (let (case-fold-search)
-	    (if (string-match (car (car suffixes)) localname)
-		(setq suffix (car suffixes) suffixes nil))
-	    (setq suffixes (cdr suffixes))))
-
-	(cond ((file-symlink-p file)
-	       nil)
-	      ((and suffix (nth 2 suffix))
-	       ;; We found an uncompression rule.
-	       (message "Uncompressing %s..." file)
-	       (when (zerop (tramp-send-command-and-check
-			     multi-method method user host
-			     (concat (nth 2 suffix) " " localname)))
-		 (message "Uncompressing %s...done" file)
-		 ;; `dired-remove-file' is not defined in XEmacs
-		 (funcall (symbol-function 'dired-remove-file) file)
-		 (string-match (car suffix) file)
-		 (concat (substring file 0 (match-beginning 0)))))
-	      (t
-	       ;; We don't recognize the file as compressed, so compress it.
-	       ;; Try gzip.
-	       (message "Compressing %s..." file)
-	       (when (zerop (tramp-send-command-and-check
-			     multi-method method user host
-			     (concat "gzip -f " localname)))
-		 (message "Compressing %s...done" file)
-		 ;; `dired-remove-file' is not defined in XEmacs
-		 (funcall (symbol-function 'dired-remove-file) file)
-		 (cond ((file-exists-p (concat file ".gz"))
-			(concat file ".gz"))
-		       ((file-exists-p (concat file ".z"))
-			(concat file ".z"))
-		       (t nil)))))))))
-
-;; Pacify byte-compiler.  The function is needed on XEmacs only.  I'm
-;; not sure at all that this is the right way to do it, but let's hope
-;; it works for now, and wait for a guru to point out the Right Way to
-;; achieve this.
-;;(eval-when-compile
-;;  (unless (fboundp 'dired-insert-set-properties)
-;;    (fset 'dired-insert-set-properties 'ignore)))
-;; Gerd suggests this:
-(eval-when-compile (require 'dired))
-;; Note that dired is required at run-time, too, when it is needed.
-;; It is only needed on XEmacs for the function
-;; `dired-insert-set-properties'.
-
-(defun tramp-handle-insert-directory
-  (filename switches &optional wildcard full-directory-p)
-  "Like `insert-directory' for tramp files."
-  (if (and (boundp 'ls-lisp-use-insert-directory-program)
-           (not (symbol-value 'ls-lisp-use-insert-directory-program)))
-      (tramp-run-real-handler 'insert-directory
-                              (list filename switches wildcard full-directory-p))
-    ;; For the moment, we assume that the remote "ls" program does not
-    ;; grok "--dired".  In the future, we should detect this on
-    ;; connection setup.
-    (when (string-match "^--dired\\s-+" switches)
-      (setq switches (replace-match "" nil t switches)))
-    (setq filename (expand-file-name filename))
-    (with-parsed-tramp-file-name filename nil
-      (tramp-message-for-buffer
-       multi-method method user host 10
-       "Inserting directory `ls %s %s', wildcard %s, fulldir %s"
-       switches filename (if wildcard "yes" "no")
-       (if full-directory-p "yes" "no"))
-      (when wildcard
-        (setq wildcard (file-name-nondirectory localname))
-        (setq localname (file-name-directory localname)))
-      (when (listp switches)
-        (setq switches (mapconcat 'identity switches " ")))
-      (unless full-directory-p
-        (setq switches (concat "-d " switches)))
-      (when wildcard
-        (setq switches (concat switches " " wildcard)))
-      (save-excursion
-        ;; If `full-directory-p', we just say `ls -l FILENAME'.
-        ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
-        (if full-directory-p
-            (tramp-send-command
-             multi-method method user host
-             (format "%s %s %s"
-                     (tramp-get-ls-command multi-method method user host)
-                     switches
-                     (if wildcard
-                         localname
-                       (tramp-shell-quote-argument (concat localname ".")))))
-          (tramp-barf-unless-okay
-           multi-method method user host
-           (format "cd %s" (tramp-shell-quote-argument
-                            (file-name-directory localname)))
-           nil 'file-error
-           "Couldn't `cd %s'"
-           (tramp-shell-quote-argument (file-name-directory localname)))
-          (tramp-send-command
-           multi-method method user host
-           (format "%s %s %s"
-                   (tramp-get-ls-command multi-method method user host)
-                   switches
-                   (if wildcard
-                       localname
-		     (if (zerop (length (file-name-nondirectory localname)))
-			 ""
-		       (tramp-shell-quote-argument
-			(file-name-nondirectory localname)))))))
-        (sit-for 1)			;needed for rsh but not ssh?
-        (tramp-wait-for-output))
-      ;; The following let-binding is used by code that's commented
-      ;; out.  Let's leave the let-binding in for a while to see
-      ;; that the commented-out code is really not needed.  Commenting-out
-      ;; happened on 2003-03-13.
-      (let ((old-pos (point)))
-	;; We cannot use `insert-buffer' because the tramp buffer
-	;; changes its contents before insertion due to calling
-	;; `expand-file' and alike.
-	(insert
-	 (with-current-buffer
-	     (tramp-get-buffer multi-method method user host)
-	   (buffer-string)))
-        ;; On XEmacs, we want to call (exchange-point-and-mark t), but
-        ;; that doesn't exist on Emacs, so we use this workaround instead.
-        ;; Since zmacs-region-stays doesn't exist in Emacs, this ought to
-        ;; be safe.  Thanks to Daniel Pittman .
-        ;;     (let ((zmacs-region-stays t))
-        ;;       (exchange-point-and-mark))
-        (save-excursion
-          (tramp-send-command multi-method method user host "cd")
-          (tramp-wait-for-output))
-        ;; For the time being, the XEmacs kludge is commented out.
-        ;; Please test it on various XEmacs versions to see if it works.
-        ;;       ;; Another XEmacs specialty follows.  What's the right way to do
-        ;;       ;; it?
-        ;;       (when (and (featurep 'xemacs)
-        ;; 		 (eq major-mode 'dired-mode))
-        ;; 	(save-excursion
-        ;; 	  (require 'dired)
-        ;; 	  (dired-insert-set-properties old-pos (point))))
-        ))))
-
-;; Continuation of kluge to pacify byte-compiler.
-;;(eval-when-compile
-;;  (when (eq (symbol-function 'dired-insert-set-properties) 'ignore)
-;;    (fmakunbound 'dired-insert-set-properties)))
-
-;; CCC is this the right thing to do?
-(defun tramp-handle-unhandled-file-name-directory (filename)
-  "Like `unhandled-file-name-directory' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (expand-file-name "~/")))
-
-;; Canonicalization of file names.
-
-(defun tramp-drop-volume-letter (name)
-  "Cut off unnecessary drive letter from file NAME.
-The function `tramp-handle-expand-file-name' calls `expand-file-name'
-locally on a remote file name.  When the local system is a W32 system
-but the remote system is Unix, this introduces a superfluous drive
-letter into the file name.  This function removes it.
-
-Doesn't do anything if the NAME does not start with a drive letter."
-  (if (and (> (length name) 1)
-           (char-equal (aref name 1) ?:)
-           (let ((c1 (aref name 0)))
-             (or (and (>= c1 ?A) (<= c1 ?Z))
-                 (and (>= c1 ?a) (<= c1 ?z)))))
-      (substring name 2)
-    name))
-
-(defun tramp-handle-expand-file-name (name &optional dir)
-  "Like `expand-file-name' for tramp files.
-If the localname part of the given filename starts with \"/../\" then
-the result will be a local, non-Tramp, filename."
-  ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
-  (setq dir (or dir default-directory "/"))
-  ;; Unless NAME is absolute, concat DIR and NAME.
-  (unless (file-name-absolute-p name)
-    (setq name (concat (file-name-as-directory dir) name)))
-  ;; If NAME is not a tramp file, run the real handler
-  (if (not (tramp-tramp-file-p name))
-      (tramp-run-real-handler 'expand-file-name
-                              (list name nil))
-    ;; Dissect NAME.
-    (with-parsed-tramp-file-name name nil
-      (unless (file-name-absolute-p localname)
-	(setq localname (concat "~/" localname)))
-      (save-excursion
-	;; Tilde expansion if necessary.  This needs a shell which
-	;; groks tilde expansion!  The function `tramp-find-shell' is
-	;; supposed to find such a shell on the remote host.  Please
-	;; tell me about it when this doesn't work on your system.
-	(when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
-	  (let ((uname (match-string 1 localname))
-		(fname (match-string 2 localname)))
-	    ;; We cannot simply apply "~/", because under sudo "~/" is
-	    ;; expanded to the local user home directory but to the
-	    ;; root home directory.  On the other hand, using always
-	    ;; the default user name for tilde expansion is not
-	    ;; appropriate either, because ssh and companions might
-	    ;; use a user name from the config file.
-	    (when (and (string-equal uname "~")
-		       (string-match
-			"\\`su\\(do\\)?\\'"
-			(tramp-find-method multi-method method user host)))
-	      (setq uname (concat uname (or user "root"))))
-	    ;; CCC fanatic error checking?
-	    (set-buffer (tramp-get-buffer multi-method method user host))
-	    (erase-buffer)
-	    (tramp-send-command
-	     multi-method method user host
-	     (format "cd %s; pwd" uname)
-	     t)
-	    (tramp-wait-for-output)
-	    (goto-char (point-min))
-	    (setq uname (buffer-substring (point) (tramp-line-end-position)))
-	    (setq localname (concat uname fname))
-	    (erase-buffer)))
-	;; There might be a double slash, for example when "~/"
-	;; expands to "/". Remove this.
-	(while (string-match "//" localname)
-	  (setq localname (replace-match "/" t t localname)))
-	;; No tilde characters in file name, do normal
-	;; expand-file-name (this does "/./" and "/../").  We bind
-	;; directory-sep-char here for XEmacs on Windows, which would
-	;; otherwise use backslash.  `default-directory' is bound to
-	;; "/", because on Windows there would be problems with UNC
-	;; shares or Cygwin mounts.
-	(tramp-let-maybe directory-sep-char ?/
-	  (let ((default-directory "/"))
-	    (tramp-make-tramp-file-name
-	     multi-method (or method (tramp-find-default-method user host))
-	     user host
-	     (tramp-drop-volume-letter
-	      (tramp-run-real-handler 'expand-file-name
-				      (list localname))))))))))
-
-;; old version follows.  it uses ".." to cross file handler
-;; boundaries.
-;; 	;; Look if localname starts with "/../" construct.  If this is
-;; 	;; the case, then we return a local name instead of a remote name.
-;; 	(if (string-match "^/\\.\\./" localname)
-;; 	    (expand-file-name (substring localname 3))
-;; 	  ;; No tilde characters in file name, do normal
-;; 	  ;; expand-file-name (this does "/./" and "/../").  We bind
-;; 	  ;; directory-sep-char here for XEmacs on Windows, which
-;; 	  ;; would otherwise use backslash.
-;; 	  (let ((directory-sep-char ?/))
-;; 	    (tramp-make-tramp-file-name
-;; 	     multi-method method user host
-;; 	     (tramp-drop-volume-letter
-;; 	      (tramp-run-real-handler 'expand-file-name
-;; 				      (list localname))))))))))
-
-;; Remote commands.
-
-(defvar tramp-async-proc nil
-  "Global variable keeping asynchronous process object.
-Used in `tramp-handle-shell-command'")
-
-(defvar tramp-display-shell-command-buffer t
-  "Whether to display output buffer of `shell-command'.
-This is necessary for handling DISPLAY of `process-file'.")
-
-(defun tramp-handle-shell-command (command &optional output-buffer error-buffer)
-  "Like `shell-command' for tramp files.
-This will break if COMMAND prints a newline, followed by the value of
-`tramp-end-of-output', followed by another newline."
-  ;; Asynchronous processes are far from being perfect.  But it works at least
-  ;; for `find-grep-dired' and `find-name-dired' in Emacs 22.
-  (if (tramp-tramp-file-p default-directory)
-      (with-parsed-tramp-file-name default-directory nil
-	(let ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
-	      status)
-	  (unless output-buffer
-	    (setq output-buffer
-		  (get-buffer-create
-		   (if asynchronous
-		       "*Async Shell Command*"
-		     "*Shell Command Output*")))
-	    (set-buffer output-buffer)
-	    (erase-buffer))
-	  (unless (bufferp output-buffer)
-	    (setq output-buffer (current-buffer)))
-	  (set-buffer output-buffer)
-	  ;; Tramp doesn't handle the asynchronous case by an asynchronous
-	  ;; process.  Instead of, another asynchronous process is opened
-	  ;; which gets the output of the (synchronous) Tramp process
-	  ;; via process-filter.  ERROR-BUFFER is disabled.
-	  (when asynchronous
-	    (setq command (substring command 0 (match-beginning 0))
-		  error-buffer nil
-		  tramp-async-proc (start-process (buffer-name output-buffer)
-						  output-buffer "cat")))
-	  (save-excursion
-	    (tramp-barf-unless-okay
-	     multi-method method user host
-	     (format "cd %s" (tramp-shell-quote-argument localname))
-	     nil 'file-error
-	     "tramp-handle-shell-command: Couldn't `cd %s'"
-	     (tramp-shell-quote-argument localname))
-	    ;; Define the process filter
-	    (when asynchronous
-	      (set-process-filter
-	       (get-buffer-process
-		(tramp-get-buffer multi-method method user host))
-	       '(lambda (process string)
-		  ;; Write the output into the Tramp Process
-		  (save-current-buffer
-		    (set-buffer (process-buffer process))
-		    (goto-char (point-max))
-		    (insert string))
-		  ;; Hand-over output to asynchronous process.
-		  (let ((end
-			 (string-match
-			  (regexp-quote tramp-end-of-output) string)))
-		    (when end
-		      (setq string
-			    (substring string 0 (1- (match-beginning 0)))))
-		    (process-send-string tramp-async-proc string)
-		    (when end
-		      (set-process-filter process nil)
-		      (process-send-eof tramp-async-proc))))))
-	    ;; Send the command
-	    (tramp-send-command
-	     multi-method method user host
-	     (if error-buffer
-		 (format "( %s ) 2>/tmp/tramp.$$.err; tramp_old_status=$?"
-			 command)
-	       (format "%s; tramp_old_status=$?" command)))
-	    (unless asynchronous
-	      (tramp-wait-for-output)))
-	  (unless asynchronous
-	    ;; We cannot use `insert-buffer' because the tramp buffer
-	    ;; changes its contents before insertion due to calling
-	    ;; `expand-file' and alike.
-	    (insert
-	     (with-current-buffer
-		 (tramp-get-buffer multi-method method user host)
-	       (buffer-string))))
-	  (when error-buffer
-	    (save-excursion
-	      (unless (bufferp error-buffer)
-		(setq error-buffer (get-buffer-create error-buffer)))
-	      (tramp-send-command
-	       multi-method method user host
-	       "cat /tmp/tramp.$$.err")
-	      (tramp-wait-for-output)
-	      (set-buffer error-buffer)
-	      ;; Same comment as above
-	      (insert
-	       (with-current-buffer
-		   (tramp-get-buffer multi-method method user host)
-		 (buffer-string)))
-	      (tramp-send-command-and-check
-	       multi-method method user host "rm -f /tmp/tramp.$$.err")))
-	  (save-excursion
-	    (tramp-send-command multi-method method user host "cd")
-	    (unless asynchronous
-	      (tramp-wait-for-output))
-	    (tramp-send-command
-	     multi-method method user host
-	     (concat "tramp_set_exit_status $tramp_old_status;"
-		     " echo tramp_exit_status $?"))
-	    (unless asynchronous
-	      (tramp-wait-for-output)
-	      (goto-char (point-max))
-	      (unless (search-backward "tramp_exit_status " nil t)
-		(error "Couldn't find exit status of `%s'" command))
-	      (skip-chars-forward "^ ")
-	      (setq status (read (current-buffer)))))
-	  (unless (zerop (buffer-size))
-	    (when tramp-display-shell-command-buffer
-	      (display-buffer output-buffer)))
-	  status))
-    ;; The following is only executed if something strange was
-    ;; happening.  Emit a helpful message and do it anyway.
-    (message "tramp-handle-shell-command called with non-tramp directory: `%s'"
-	     default-directory)
-    (tramp-run-real-handler 'shell-command
-			    (list command output-buffer error-buffer))))
-
-(defun tramp-handle-process-file (program &optional infile buffer display &rest args)
-  "Like `process-file' for Tramp files."
-  (when infile (error "Implementation does not handle input from file"))
-  (when (and (numberp buffer) (zerop buffer))
-    (error "Implementation does not handle immediate return"))
-  (when (consp buffer) (error "Implementation does not handle error files"))
-  (let ((tramp-display-shell-command-buffer display))
-    (shell-command
-     (mapconcat 'tramp-shell-quote-argument (cons program args) " ")
-     buffer)))
-
-;; File Editing.
-
-(defsubst tramp-make-temp-file ()
-  (funcall (if (fboundp 'make-temp-file) 'make-temp-file 'make-temp-name)
-	   (expand-file-name tramp-temp-name-prefix
-			     (tramp-temporary-file-directory))))
-
-(defun tramp-handle-file-local-copy (filename)
-  "Like `file-local-copy' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (let ((tramp-buf (tramp-get-buffer multi-method method user host))
-	  ;; We used to bind the following as late as possible.
-	  ;; loc-enc and loc-dec were bound directly before the if
-	  ;; statement that checks them.  But the functions
-	  ;; tramp-get-* might invoke the "are you awake" check in
-	  ;; tramp-maybe-open-connection, which is an unfortunate time
-	  ;; since we rely on the buffer contents at that spot.
-	  (rem-enc (tramp-get-remote-encoding multi-method method user host))
-	  (rem-dec (tramp-get-remote-decoding multi-method method user host))
-	  (loc-enc (tramp-get-local-encoding multi-method method user host))
-	  (loc-dec (tramp-get-local-decoding multi-method method user host))
-	  tmpfil)
-      (unless (file-exists-p filename)
-	(error "Cannot make local copy of non-existing file `%s'"
-	       filename))
-      (setq tmpfil (tramp-make-temp-file))
-
-      (cond ((tramp-method-out-of-band-p multi-method method user host)
-	     ;; `copy-file' handles out-of-band methods
-	     (copy-file filename tmpfil t t))
-
-	    ((and rem-enc rem-dec)
-	     ;; Use inline encoding for file transfer.
-	     (save-excursion
-	       ;; Following line for setting tramp-current-method,
-	       ;; tramp-current-user, tramp-current-host.
-	       (set-buffer tramp-buf)
-	       (tramp-message 5 "Encoding remote file %s..." filename)
-	       (tramp-barf-unless-okay
-		multi-method method user host
-		(concat rem-enc " < " (tramp-shell-quote-argument localname))
-		nil 'file-error
-		"Encoding remote file failed, see buffer `%s' for details"
-		tramp-buf)
-	       ;; Remove trailing status code
-	       (goto-char (point-max))
-	       (delete-region (point) (progn (forward-line -1) (point)))
-
-	       (tramp-message 5 "Decoding remote file %s..." filename)
-
-	       ;; Here is where loc-enc and loc-dec used to be let-bound.
-	       (if (and (symbolp loc-dec) (fboundp loc-dec))
-		   ;; If local decoding is a function, we call it.
-		   (let ((tmpbuf (get-buffer-create " *tramp tmp*")))
-		     (set-buffer tmpbuf)
-		     (erase-buffer)
-		     (insert-buffer-substring tramp-buf)
-		     (tramp-message-for-buffer
-		      multi-method method user host
-		      6 "Decoding remote file %s with function %s..."
-		      filename loc-dec)
-		     (set-buffer tmpbuf)
-		     ;; Douglas Gray Stephens 
-		     ;; says that we need to strip tramp_exit_status
-		     ;; line from the output here.  Go to point-max,
-		     ;; search backward for tramp_exit_status, delete
-		     ;; between point and point-max if found.
-		     (let ((coding-system-for-write 'binary))
-		       (funcall loc-dec (point-min) (point-max))
-		       (write-region (point-min) (point-max) tmpfil))
-		     (kill-buffer tmpbuf))
-		 ;; If tramp-decoding-function is not defined for this
-		 ;; method, we invoke tramp-decoding-command instead.
-		 (let ((tmpfil2 (tramp-make-temp-file)))
-		   (write-region (point-min) (point-max) tmpfil2)
-		   (tramp-message
-		    6 "Decoding remote file %s with command %s..."
-		    filename loc-dec)
-		   (tramp-call-local-coding-command
-		    loc-dec tmpfil2 tmpfil)
-		   (delete-file tmpfil2)))
-	       (tramp-message-for-buffer
-		multi-method method user host
-		5 "Decoding remote file %s...done" filename)
-	       ;; Set proper permissions.
-	       (set-file-modes tmpfil (file-modes filename))))
-
-	    (t (error "Wrong method specification for `%s'" method)))
-      tmpfil)))
-
-(defun tramp-handle-file-remote-p (filename)
-  "Like `file-remote-p' for tramp files."
-  (when (tramp-tramp-file-p filename)
-    (with-parsed-tramp-file-name filename nil
-      (make-tramp-file-name
-       :multi-method multi-method
-       :method method
-       :user user
-       :host host
-       :localname ""))))
-
-(defun tramp-handle-insert-file-contents
-  (filename &optional visit beg end replace)
-  "Like `insert-file-contents' for tramp files."
-  (barf-if-buffer-read-only)
-  (setq filename (expand-file-name filename))
-  (with-parsed-tramp-file-name filename nil
-    (if (not (file-exists-p filename))
-	(progn
-	  (when visit
-	    (setq buffer-file-name filename)
-	    (set-visited-file-modtime)
-	    (set-buffer-modified-p nil))
-	  (signal 'file-error
-		  (format "File `%s' not found on remote host" filename))
-	  (list (expand-file-name filename) 0))
-      ;; `insert-file-contents-literally' takes care to avoid calling
-      ;; jka-compr.  By let-binding inhibit-file-name-operation, we
-      ;; propagate that care to the file-local-copy operation.
-      (let ((local-copy
-	     (let ((inhibit-file-name-operation
-		    (when (eq inhibit-file-name-operation
-			      'insert-file-contents)
-		      'file-local-copy)))
-	       (file-local-copy filename)))
-	    coding-system-used result)
-	(when visit
-	  (setq buffer-file-name filename)
-	  (set-visited-file-modtime)
-	  (set-buffer-modified-p nil))
-	(tramp-message-for-buffer
-	 multi-method method user host
-	 9 "Inserting local temp file `%s'..." local-copy)
-	(setq result (insert-file-contents local-copy nil beg end replace))
-	;; Now `last-coding-system-used' has right value.  Remember it.
-	(when (boundp 'last-coding-system-used)
-	  (setq coding-system-used (symbol-value 'last-coding-system-used)))
-	(tramp-message-for-buffer
-	 multi-method method user host
-	 9 "Inserting local temp file `%s'...done" local-copy)
-	(delete-file local-copy)
-	(when (boundp 'last-coding-system-used)
-	  (set 'last-coding-system-used coding-system-used))
-	(list (expand-file-name filename)
-	      (second result))))))
-
-
-(defun tramp-handle-find-backup-file-name (filename)
-  "Like `find-backup-file-name' for tramp files."
-  (with-parsed-tramp-file-name filename nil
-    ;; We set both variables. It doesn't matter whether it is
-    ;; Emacs or XEmacs
-    (let ((backup-directory-alist
-	   ;; Emacs case
-	   (when (boundp 'backup-directory-alist)
-	     (if (boundp 'tramp-backup-directory-alist)
-		 (mapcar
-		  '(lambda (x)
-		     (cons
-		      (car x)
-		      (if (and (stringp (cdr x))
-			       (file-name-absolute-p (cdr x))
-			       (not (tramp-file-name-p (cdr x))))
-			  (tramp-make-tramp-file-name
-			   multi-method method user host (cdr x))
-			(cdr x))))
-		  (symbol-value 'tramp-backup-directory-alist))
-	       (symbol-value 'backup-directory-alist))))
-
-	  (bkup-backup-directory-info
-	   ;; XEmacs case
-	   (when (boundp 'bkup-backup-directory-info)
-	     (if (boundp 'tramp-bkup-backup-directory-info)
-		 (mapcar
-		  '(lambda (x)
-		     (nconc
-		      (list (car x))
-		      (list
-		       (if (and (stringp (car (cdr x)))
-				(file-name-absolute-p (car (cdr x)))
-				(not (tramp-file-name-p (car (cdr x)))))
-			   (tramp-make-tramp-file-name
-			    multi-method method user host (car (cdr x)))
-			 (car (cdr x))))
-		      (cdr (cdr x))))
-		  (symbol-value 'tramp-bkup-backup-directory-info))
-	       (symbol-value 'bkup-backup-directory-info)))))
-
-      (tramp-run-real-handler 'find-backup-file-name (list filename)))))
-
-(defun tramp-handle-make-auto-save-file-name ()
-  "Like `make-auto-save-file-name' for tramp files.
-Returns a file name in `tramp-auto-save-directory' for autosaving this file."
-  (when tramp-auto-save-directory
-    (unless (file-exists-p tramp-auto-save-directory)
-      (make-directory tramp-auto-save-directory t)))
-  ;; jka-compr doesn't like auto-saving, so by appending "~" to the
-  ;; file name we make sure that jka-compr isn't used for the
-  ;; auto-save file.
-  (let ((buffer-file-name
-	 (if tramp-auto-save-directory
-	     (expand-file-name
-	      (tramp-subst-strs-in-string
-	       '(("_" . "|")
-		 ("/" . "_a")
-		 (":" . "_b")
-		 ("|" . "__")
-		 ("[" . "_l")
-		 ("]" . "_r"))
-	       (buffer-file-name))
-	      tramp-auto-save-directory)
-	   (buffer-file-name))))
-    ;; Run plain `make-auto-save-file-name'.  There might be an advice when
-    ;; it is not a magic file name operation (since Emacs 22).
-    ;; We must deactivate it temporarily.
-    (if (not (ad-is-active 'make-auto-save-file-name))
-	(tramp-run-real-handler
-	 'make-auto-save-file-name nil)
-      ;; else
-      (ad-deactivate 'make-auto-save-file-name)
-      (prog1
-       (tramp-run-real-handler
-	'make-auto-save-file-name nil)
-       (ad-activate 'make-auto-save-file-name)))))
-
-
-;; CCC grok APPEND, LOCKNAME, CONFIRM
-(defun tramp-handle-write-region
-  (start end filename &optional append visit lockname confirm)
-  "Like `write-region' for tramp files."
-  (unless (eq append nil)
-    (error "Cannot append to file using tramp (`%s')" filename))
-  (setq filename (expand-file-name filename))
-  ;; Following part commented out because we don't know what to do about
-  ;; file locking, and it does not appear to be a problem to ignore it.
-  ;; Ange-ftp ignores it, too.
-  ;;  (when (and lockname (stringp lockname))
-  ;;    (setq lockname (expand-file-name lockname)))
-  ;;  (unless (or (eq lockname nil)
-  ;;              (string= lockname filename))
-  ;;    (error
-  ;;     "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
-  ;; XEmacs takes a coding system as the seventh argument, not `confirm'
-  (when (and (not (featurep 'xemacs))
-	     confirm (file-exists-p filename))
-    (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
-                              filename))
-      (error "File not overwritten")))
-  (with-parsed-tramp-file-name filename nil
-    (let ((curbuf (current-buffer))
-	  (rem-enc (tramp-get-remote-encoding multi-method method user host))
-	  (rem-dec (tramp-get-remote-decoding multi-method method user host))
-	  (loc-enc (tramp-get-local-encoding multi-method method user host))
-	  (loc-dec (tramp-get-local-decoding multi-method method user host))
-	  (trampbuf (get-buffer-create "*tramp output*"))
-	  (modes (file-modes filename))
-	  ;; We use this to save the value of `last-coding-system-used'
-	  ;; after writing the tmp file.  At the end of the function,
-	  ;; we set `last-coding-system-used' to this saved value.
-	  ;; This way, any intermediary coding systems used while
-	  ;; talking to the remote shell or suchlike won't hose this
-	  ;; variable.  This approach was snarfed from ange-ftp.el.
-	  coding-system-used
-	  tmpfil)
-      ;; Write region into a tmp file.  This isn't really needed if we
-      ;; use an encoding function, but currently we use it always
-      ;; because this makes the logic simpler.
-      (setq tmpfil (tramp-make-temp-file))
-      ;; Set current buffer.  If connection wasn't open, `file-modes' has
-      ;; changed it accidently.
-      (set-buffer curbuf)
-      ;; We say `no-message' here because we don't want the visited file
-      ;; modtime data to be clobbered from the temp file.  We call
-      ;; `set-visited-file-modtime' ourselves later on.
-      (tramp-run-real-handler
-       'write-region
-       (if confirm ; don't pass this arg unless defined for backward compat.
-	   (list start end tmpfil append 'no-message lockname confirm)
-	 (list start end tmpfil append 'no-message lockname)))
-      ;; Now, `last-coding-system-used' has the right value.  Remember it.
-      (when (boundp 'last-coding-system-used)
-	(setq coding-system-used (symbol-value 'last-coding-system-used)))
-      ;; The permissions of the temporary file should be set.  If
-      ;; filename does not exist (eq modes nil) it has been renamed to
-      ;; the backup file.  This case `save-buffer' handles
-      ;; permissions.
-      (when modes (set-file-modes tmpfil modes))
-      ;; This is a bit lengthy due to the different methods possible for
-      ;; file transfer.  First, we check whether the method uses an rcp
-      ;; program.  If so, we call it.  Otherwise, both encoding and
-      ;; decoding command must be specified.  However, if the method
-      ;; _also_ specifies an encoding function, then that is used for
-      ;; encoding the contents of the tmp file.
-      (cond ((tramp-method-out-of-band-p multi-method method user host)
-	     ;; `copy-file' handles out-of-band methods
-	     (copy-file tmpfil filename t t))
-
-	    ((and rem-enc rem-dec)
-	     ;; Use inline file transfer
-	     (let ((tmpbuf (get-buffer-create " *tramp file transfer*")))
-	       (save-excursion
-		 ;; Encode tmpfil into tmpbuf
-		 (tramp-message-for-buffer multi-method method user host
-					   5 "Encoding region...")
-		 (set-buffer tmpbuf)
-		 (erase-buffer)
-		 ;; Use encoding function or command.
-		 (if (and (symbolp loc-enc) (fboundp loc-enc))
-		     (progn
-		       (tramp-message-for-buffer
-			multi-method method user host
-			6 "Encoding region using function `%s'..."
-			(symbol-name loc-enc))
-		       (insert-file-contents-literally tmpfil)
-		       ;; CCC.  The following `let' is a workaround for
-		       ;; the base64.el that comes with pgnus-0.84.  If
-		       ;; both of the following conditions are
-		       ;; satisfied, it tries to write to a local file
-		       ;; in default-directory, but at this point,
-		       ;; default-directory is remote.
-		       ;; (CALL-PROCESS-REGION can't write to remote
-		       ;; files, it seems.)  The file in question is a
-		       ;; tmp file anyway.
-		       (let ((default-directory
-			       (tramp-temporary-file-directory)))
-			 (funcall loc-enc (point-min) (point-max)))
-		       (goto-char (point-max))
-		       (unless (bolp)
-			 (newline)))
-		   (tramp-message-for-buffer
-		    multi-method method user host
-		    6 "Encoding region using command `%s'..." loc-enc)
-		   (unless (equal 0 (tramp-call-local-coding-command
-				     loc-enc tmpfil t))
-		     (pop-to-buffer trampbuf)
-		     (error (concat "Cannot write to `%s', local encoding"
-				    " command `%s' failed")
-			    filename loc-enc)))
-		 ;; Send tmpbuf into remote decoding command which
-		 ;; writes to remote file.  Because this happens on the
-		 ;; remote host, we cannot use the function.
-		 (tramp-message-for-buffer
-		  multi-method method user host
-		  5 "Decoding region into remote file %s..." filename)
-		 (tramp-send-command
-		  multi-method method user host
-		  (format "%s >%s <<'EOF'"
-			  rem-dec
-			  (tramp-shell-quote-argument localname)))
-		 (set-buffer tmpbuf)
-		 (tramp-message-for-buffer
-		  multi-method method user host
-		  6 "Sending data to remote host...")
-		 (tramp-send-string multi-method method user host
-				    (buffer-string))
-		 ;; wait for remote decoding to complete
-		 (tramp-message-for-buffer
-		  multi-method method user host
-		  6 "Sending end of data token...")
-		 (tramp-send-command
-		  multi-method method user host "EOF" nil t)
-		 (tramp-message-for-buffer
-		  multi-method method user host 6
-		  "Waiting for remote host to process data...")
-		 (set-buffer (tramp-get-buffer multi-method method user host))
-		 (tramp-wait-for-output)
-		 (tramp-barf-unless-okay
-		  multi-method method user host nil nil 'file-error
-		  (concat "Couldn't write region to `%s',"
-			  " decode using `%s' failed")
-		  filename rem-dec)
-		 (tramp-message 5 "Decoding region into remote file %s...done"
-				filename)
-		 (kill-buffer tmpbuf))))
-	    (t
-	     (error
-	      (concat "Method `%s' should specify both encoding and "
-		      "decoding command or an rcp program")
-	      method)))
-      (delete-file tmpfil)
-      (unless (equal curbuf (current-buffer))
-	(error "Buffer has changed from `%s' to `%s'"
-	       curbuf (current-buffer)))
-      (when (or (eq visit t) (stringp visit))
-	(set-visited-file-modtime
-	 ;; We must pass modtime explicitely, because filename can be different
-	 ;; from (buffer-file-name), f.e. if `file-precious-flag' is set.
-	 (nth 5 (file-attributes filename))))
-      ;; Make `last-coding-system-used' have the right value.
-      (when (boundp 'last-coding-system-used)
-	(set 'last-coding-system-used coding-system-used))
-      (when (or (eq visit t)
-		(eq visit nil)
-		(stringp visit))
-	(message "Wrote %s" filename)))))
-
-;; Call down to the real handler.
-;; Because EFS does not play nicely with TRAMP (both systems match a
-;; TRAMP file name) it is needed to disable efs as well as tramp for the
-;; operation.
-;;
-;; Other than that, this is the canon file-handler code that the doco
-;; says should be used here. Which is nice.
-;;
-;; Under XEmacs current, EFS also hooks in as
-;; efs-sifn-handler-function to handle any filename with environment
-;; variables. This has two implications:
-;; 1) That EFS may not be completely dead (yet) for TRAMP filenames
-;; 2) That TRAMP might want to do the same thing.
-;; Details as they come in.
-;;
-;; Daniel Pittman 
-
-;; (defun tramp-run-real-handler (operation args)
-;;   "Invoke normal file name handler for OPERATION.
-;; This inhibits EFS and Ange-FTP, too, because they conflict with tramp.
-;; First arg specifies the OPERATION, remaining ARGS are passed to the
-;; OPERATION."
-;;   (let ((inhibit-file-name-handlers
-;;          (list 'tramp-file-name-handler
-;; 	       'efs-file-handler-function
-;;                'ange-ftp-hook-function
-;;                (and (eq inhibit-file-name-operation operation)
-;;                     inhibit-file-name-handlers)))
-;;         (inhibit-file-name-operation operation))
-;;     (apply operation args)))
-
-(defun tramp-run-real-handler (operation args)
-  "Invoke normal file name handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
-  (let* ((inhibit-file-name-handlers
-	  `(tramp-file-name-handler
-	    tramp-completion-file-name-handler
-	    cygwin-mount-name-hook-function
-	    cygwin-mount-map-drive-hook-function
-	    .
-	    ,(and (eq inhibit-file-name-operation operation)
-		  inhibit-file-name-handlers)))
-	 (inhibit-file-name-operation operation))
-    (apply operation args)))
-
-;; This function is used from `tramp-completion-file-name-handler' functions
-;; only, if `tramp-completion-mode' is true. But this cannot be checked here
-;; because the check is based on a full filename, not available for all
-;; basic I/O operations.
-(defun tramp-completion-run-real-handler (operation args)
-  "Invoke `tramp-file-name-handler' for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION."
-  (let* ((inhibit-file-name-handlers
-	  `(tramp-completion-file-name-handler
-	    cygwin-mount-name-hook-function
-	    cygwin-mount-map-drive-hook-function
-	    .
-	    ,(and (eq inhibit-file-name-operation operation)
-		  inhibit-file-name-handlers)))
-	 (inhibit-file-name-operation operation))
-    (apply operation args)))
-
-;; We handle here all file primitives.  Most of them have the file
-;; name as first parameter; nevertheless we check for them explicitly
-;; in order to be signalled if a new primitive appears.  This
-;; scenario is needed because there isn't a way to decide by
-;; syntactical means whether a foreign method must be called.  It would
-;; ease the life if `file-name-handler-alist' would support a decision
-;; function as well but regexp only.
-(defun tramp-file-name-for-operation (operation &rest args)
-  "Return file name related to OPERATION file primitive.
-ARGS are the arguments OPERATION has been called with."
-  (cond
-   ; FILE resp DIRECTORY
-   ((member operation
-	    (list 'access-file 'byte-compiler-base-file-name 'delete-directory
-		  'delete-file 'diff-latest-backup-file 'directory-file-name
-		  'directory-files 'directory-files-and-attributes
-		  'dired-compress-file 'dired-uncache
-		  'file-accessible-directory-p 'file-attributes
-		  'file-directory-p 'file-executable-p 'file-exists-p
-		  'file-local-copy 'file-remote-p 'file-modes
-		  'file-name-as-directory 'file-name-directory
-		  'file-name-nondirectory 'file-name-sans-versions
-		  'file-ownership-preserved-p 'file-readable-p
-		  'file-regular-p 'file-symlink-p 'file-truename
-		  'file-writable-p 'find-backup-file-name 'find-file-noselect
-		  'get-file-buffer 'insert-directory 'insert-file-contents
-		  'load 'make-directory 'make-directory-internal
-		  'set-file-modes 'substitute-in-file-name
-		  'unhandled-file-name-directory 'vc-registered
-		  ; XEmacs only
-		  'abbreviate-file-name 'create-file-buffer
-		  'dired-file-modtime 'dired-make-compressed-filename
-		  'dired-recursive-delete-directory 'dired-set-file-modtime
-		  'dired-shell-unhandle-file-name 'dired-uucode-file
-		  'insert-file-contents-literally 'recover-file
-		  'vm-imap-check-mail 'vm-pop-check-mail 'vm-spool-check-mail))
-    (if (file-name-absolute-p (nth 0 args))
-	(nth 0 args)
-      (expand-file-name (nth 0 args))))
-   ; FILE DIRECTORY resp FILE1 FILE2
-   ((member operation
-	    (list 'add-name-to-file 'copy-file 'expand-file-name
-		  'file-name-all-completions 'file-name-completion
-		  'file-newer-than-file-p 'make-symbolic-link 'rename-file
-		  ; XEmacs only
-		  'dired-make-relative-symlink
-		  'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
-    (save-match-data
-      (cond
-       ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args))
-       ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args))
-       (t (buffer-file-name (current-buffer))))))
-   ; START END FILE
-   ((eq operation 'write-region)
-    (nth 2 args))
-   ; BUF
-   ((member operation
-	    (list 'make-auto-save-file-name
-	          'set-visited-file-modtime 'verify-visited-file-modtime
-		  ; XEmacs only
-		  'backup-buffer))
-    (buffer-file-name
-     (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
-   ; COMMAND
-   ((member operation
-	    (list 'dired-call-process
-                  ; Emacs only
-		  'shell-command
-                  ; Emacs 22 only
-                  'process-file
-	          ; XEmacs only
-		  'dired-print-file 'dired-shell-call-process))
-    default-directory)
-   ; unknown file primitive
-   (t (error "unknown file I/O primitive: %s" operation))))
-
-(defun tramp-find-foreign-file-name-handler (filename)
-  "Return foreign file name handler if exists."
-  (when (tramp-tramp-file-p filename)
-    (let (elt
-	  res
-	  (handler-alist tramp-foreign-file-name-handler-alist))
-      (while handler-alist
-	(setq elt (car handler-alist)
-	      handler-alist (cdr handler-alist))
-	(when (funcall (car elt) filename)
-	  (setq handler-alist nil)
-	  (setq res (cdr elt))))
-      res)))
-
-;; Main function.
-;;;###autoload
-(defun tramp-file-name-handler (operation &rest args)
-  "Invoke Tramp file name handler.
-Falls back to normal file name handler if no tramp file name handler exists."
-  (save-match-data
-    (let* ((filename (apply 'tramp-file-name-for-operation operation args))
-	   (foreign (tramp-find-foreign-file-name-handler filename)))
-      (cond
-       (foreign (apply foreign operation args))
-       (t (tramp-run-real-handler operation args))))))
-
-
-;; In Emacs, there is some concurrency due to timers.  If a timer
-;; interrupts Tramp and wishes to use the same connection buffer as
-;; the "main" Emacs, then garbage might occur in the connection
-;; buffer.  Therefore, we need to make sure that a timer does not use
-;; the same connection buffer as the "main" Emacs.  We implement a
-;; cheap global lock, instead of locking each connection buffer
-;; separately.  The global lock is based on two variables,
-;; `tramp-locked' and `tramp-locker'.  `tramp-locked' is set to true
-;; (with setq) to indicate a lock.  But Tramp also calls itself during
-;; processing of a single file operation, so we need to allow
-;; recursive calls.  That's where the `tramp-locker' variable comes in
-;; -- it is let-bound to t during the execution of the current
-;; handler.  So if `tramp-locked' is t and `tramp-locker' is also t,
-;; then we should just proceed because we have been called
-;; recursively.  But if `tramp-locker' is nil, then we are a timer
-;; interrupting the "main" Emacs, and then we signal an error.
-
-(defvar tramp-locked nil
-  "If non-nil, then Tramp is currently busy.
-Together with `tramp-locker', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
-(defvar tramp-locker nil
-  "If non-nil, then a caller has locked Tramp.
-Together with `tramp-locked', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
-(defun tramp-sh-file-name-handler (operation &rest args)
-  "Invoke remote-shell Tramp file name handler.
-Fall back to normal file name handler if no Tramp handler exists."
-  (when (and tramp-locked (not tramp-locker))
-    (signal 'file-error "Forbidden reentrant call of Tramp"))
-  (let ((tl tramp-locked))
-    (unwind-protect
-	(progn
-	  (setq tramp-locked t)
-	  (let ((tramp-locker t))
-	    (save-match-data
-	      (let ((fn (assoc operation tramp-file-name-handler-alist)))
-		(if fn
-		    (apply (cdr fn) args)
-		  (tramp-run-real-handler operation args))))))
-      (setq tramp-locked tl))))
-
-;;;###autoload
-(defun tramp-completion-file-name-handler (operation &rest args)
-  "Invoke tramp file name completion handler.
-Falls back to normal file name handler if no tramp file name handler exists."
-;;   (setq tramp-debug-buffer t)
-;;   (tramp-message 1 "%s %s" operation args)
-;;   (tramp-message 1 "%s %s\n%s"
-;; 		 operation args (with-output-to-string (backtrace)))
-  (let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
-    (if fn
-	(save-match-data (apply (cdr fn) args))
-      (tramp-completion-run-real-handler operation args))))
-
-;;;###autoload
-(put 'tramp-completion-file-name-handler 'safe-magic t)
-
-;; Register in file name handler alist
-;;;###autoload
-(add-to-list 'file-name-handler-alist
-	     (cons tramp-file-name-regexp 'tramp-file-name-handler))
-(add-to-list 'file-name-handler-alist
-	     (cons tramp-completion-file-name-regexp
-		   'tramp-completion-file-name-handler))
-
-;;;###autoload
-(defun tramp-unload-file-name-handler-alist ()
-  (setq file-name-handler-alist
-	(delete (rassoc 'tramp-file-name-handler
-			file-name-handler-alist)
-		(delete (rassoc 'tramp-completion-file-name-handler
-				file-name-handler-alist)
-			file-name-handler-alist))))
-
-(add-hook 'tramp-unload-hook 'tramp-unload-file-name-handler-alist)
-
-(defun tramp-repair-jka-compr ()
-  "If jka-compr is already loaded, move it to the front of
-`file-name-handler-alist'.  On Emacs 22 or so this will not be
-necessary anymore."
-  (let ((jka (rassoc 'jka-compr-handler file-name-handler-alist)))
-    (when jka
-      (setq file-name-handler-alist
-	    (cons jka (delete jka file-name-handler-alist))))))
-(tramp-repair-jka-compr)
-
-
-;;; Interactions with other packages:
-
-;; -- complete.el --
-
-;; This function contributed by Ed Sabol
-(defun tramp-handle-expand-many-files (name)
-  "Like `PC-expand-many-files' for tramp files."
-  (with-parsed-tramp-file-name name nil
-    (save-match-data
-      (if (or (string-match "\\*" name)
-	      (string-match "\\?" name)
-	      (string-match "\\[.*\\]" name))
-	  (save-excursion
-	    (let (bufstr)
-	      ;; CCC: To do it right, we should quote certain characters
-	      ;; in the file name, but since the echo command is going to
-	      ;; break anyway when there are spaces in the file names, we
-	      ;; don't bother.
-	      ;;-(let ((comint-file-name-quote-list
-	      ;;-       (set-difference tramp-file-name-quote-list
-	      ;;-                       '(?\* ?\? ?[ ?]))))
-	      ;;-  (tramp-send-command
-	      ;;-   multi-method method user host
-	      ;;-   (format "echo %s" (comint-quote-filename localname)))
-	      ;;-  (tramp-wait-for-output))
-	      (tramp-send-command multi-method method user host
-				  (format "echo %s" localname))
-	      (tramp-wait-for-output)
-	      (setq bufstr (buffer-substring (point-min)
-					     (tramp-line-end-position)))
-	      (goto-char (point-min))
-	      (if (string-equal localname bufstr)
-		  nil
-		(insert "(\"")
-		(while (search-forward " " nil t)
-		  (delete-backward-char 1)
-		  (insert "\" \""))
-		(goto-char (point-max))
-		(delete-backward-char 1)
-		(insert "\")")
-		(goto-char (point-min))
-		(mapcar
-		 (function (lambda (x)
-			     (tramp-make-tramp-file-name multi-method method
-							 user host x)))
-		 (read (current-buffer))))))
-	(list (expand-file-name name))))))
-
-(eval-after-load "complete"
-  '(progn
-     (defadvice PC-expand-many-files
-       (around tramp-advice-PC-expand-many-files (name) activate)
-       "Invoke `tramp-handle-expand-many-files' for tramp files."
-       (if (tramp-tramp-file-p name)
-	   (setq ad-return-value (tramp-handle-expand-many-files name))
-	 ad-do-it))
-     (add-hook 'tramp-unload-hook
-	       '(lambda () (ad-unadvise 'PC-expand-many-files)))))
-
-;;; File name handler functions for completion mode
-
-(defvar tramp-completion-mode nil
-  "If non-nil, we are in file name completion mode.")
-
-;; Necessary because `tramp-file-name-regexp-unified' and
-;; `tramp-completion-file-name-regexp-unified' aren't different.
-;; If nil, `tramp-completion-run-real-handler' is called (i.e. forwarding to
-;; `tramp-file-name-handler'). Otherwise, it takes `tramp-run-real-handler'.
-;; Using `last-input-event' is a little bit risky, because completing a file
-;; might require loading other files, like "~/.netrc", and for them it
-;; shouldn't be decided based on that variable. On the other hand, those files
-;; shouldn't have partial tramp file name syntax. Maybe another variable should
-;; be introduced overwriting this check in such cases. Or we change tramp
-;; file name syntax in order to avoid ambiguities, like in XEmacs ...
-;; In case of non unified file names it can be always true (and wouldn't be
-;; necessary, because there are different regexp).
-(defun tramp-completion-mode (file)
-  "Checks whether method / user name / host name completion is active."
-  (cond
-   (tramp-completion-mode t)
-   ((not tramp-unified-filenames) t)
-   ((string-match "^/.*:.*:$" file) nil)
-   ((string-match
-     (concat tramp-prefix-regexp
-      "\\(" tramp-method-regexp  "\\)" tramp-postfix-single-method-regexp "$")
-     file)
-    (member (match-string 1 file) (mapcar 'car tramp-methods)))
-   ((or (equal last-input-event 'tab)
-  	;; Emacs
-  	(and (integerp last-input-event)
-	     (or
-	      ;; ?\t has event-modifier 'control
-	      (char-equal last-input-event ?\t)
-	      (and (not (event-modifiers last-input-event))
-		   (or (char-equal last-input-event ?\?)
-		       (char-equal last-input-event ?\ )))))
-	;; XEmacs
-	(and (featurep 'xemacs)
-	     (or
-	      ;; ?\t has event-modifier 'control
-	      (char-equal
-	       (funcall (symbol-function 'event-to-character)
-			last-input-event) ?\t)
-	      (and (not (event-modifiers last-input-event))
-		   (or (char-equal
-			(funcall (symbol-function 'event-to-character)
-				 last-input-event) ?\?)
-		       (char-equal
-			(funcall (symbol-function 'event-to-character)
-				 last-input-event) ?\ ))))))
-    t)))
-
-(defun tramp-completion-handle-file-exists-p (filename)
-  "Like `file-exists-p' for tramp files."
-  (if (tramp-completion-mode filename)
-      (tramp-run-real-handler
-       'file-exists-p (list filename))
-    (tramp-completion-run-real-handler
-     'file-exists-p (list filename))))
-
-;; Localname manipulation in case of partial TRAMP file names.
-(defun tramp-completion-handle-file-name-directory (file)
-  "Like `file-name-directory' but aware of TRAMP files."
-  (if (tramp-completion-mode file)
-      "/"
-    (tramp-completion-run-real-handler
-     'file-name-directory (list file))))
-
-;; Localname manipulation in case of partial TRAMP file names.
-(defun tramp-completion-handle-file-name-nondirectory (file)
-  "Like `file-name-nondirectory' but aware of TRAMP files."
-  (substring
-   file (length (tramp-completion-handle-file-name-directory file))))
-
-;; Method, host name and user name completion.
-;; `tramp-completion-dissect-file-name' returns a list of
-;; tramp-file-name structures. For all of them we return possible completions.
-(defun tramp-completion-handle-file-name-all-completions (filename directory)
-  "Like `file-name-all-completions' for partial tramp files."
-
-  (unwind-protect
-      ;; We need to reset `tramp-completion-mode'.
-      (progn
-	(setq tramp-completion-mode t)
-	(let*
-	    ((fullname (concat directory filename))
-	     ;; possible completion structures
-	     (v (tramp-completion-dissect-file-name fullname))
-	     result result1)
-
-	  (while v
-	    (let* ((car (car v))
-		   (multi-method (tramp-file-name-multi-method car))
-		   (method (tramp-file-name-method car))
-		   (user (tramp-file-name-user car))
-		   (host (tramp-file-name-host car))
-		   (localname (tramp-file-name-localname car))
-		   (m (tramp-find-method multi-method method user host))
-		   (tramp-current-user user) ; see `tramp-parse-passwd'
-		   all-user-hosts)
-
-	      (unless (or multi-method ;; Not handled (yet).
-			  localname)   ;; Nothing to complete
-
-		(if (or user host)
-
-		    ;; Method dependent user / host combinations
-		    (progn
-		      (mapcar
-		       (lambda (x)
-			 (setq all-user-hosts
-			       (append all-user-hosts
-				       (funcall (nth 0 x) (nth 1 x)))))
-		       (tramp-get-completion-function m))
-
-		      (setq result (append result
-	                (mapcar
-			 (lambda (x)
-			   (tramp-get-completion-user-host
-			    method user host (nth 0 x) (nth 1 x)))
-			 (delq nil all-user-hosts)))))
-
-		  ;; Possible methods
-		  (setq result
-			(append result (tramp-get-completion-methods m)))))
-
-	      (setq v (cdr v))))
-
-	  ;; unify list, remove nil elements
-	  (while result
-	    (let ((car (car result)))
-	      (when car (add-to-list 'result1 car))
-	      (setq result (cdr result))))
-
-	  ;; Complete local parts
-	  (append
-	   result1
-	   (condition-case nil
-	       (if result1
-		   ;; "/ssh:" does not need to be expanded as hostname.
-		   (tramp-run-real-handler
-		    'file-name-all-completions (list filename directory))
-		 ;; No method/user/host found to be expanded.
-		 (tramp-completion-run-real-handler
-		  'file-name-all-completions (list filename directory)))
-	     (error nil)))))
-    ;; unwindform
-    (setq tramp-completion-mode nil)))
-
-;; Method, host name and user name completion for a file.
-(defun tramp-completion-handle-file-name-completion (filename directory)
-  "Like `file-name-completion' for tramp files."
-  (try-completion filename
-   (mapcar 'list (file-name-all-completions filename directory))))
-
-;; I misuse a little bit the tramp-file-name structure in order to handle
-;; completion possibilities for partial methods / user names / host names.
-;; Return value is a list of tramp-file-name structures according to possible
-;; completions. If "multi-method" or "localname" is non-nil it means there
-;; shouldn't be a completion anymore.
-
-;; Expected results:
-
-;; "/x" "/[x"               "/x@" "/[x@"             "/x@y" "/[x@y"
-;; [nil nil nil "x" nil]    [nil nil "x" nil nil]    [nil nil "x" "y" nil]
-;; [nil nil "x" nil nil]
-;; [nil "x" nil nil nil]
-
-;; "/x:"                    "/x:y"                   "/x:y:"
-;; [nil nil nil "x" ""]     [nil nil nil "x" "y"]    [nil "x" nil "y" ""]
-;;       "/[x/"                   "/[x/y"
-;; [nil "x" nil "" nil]     [nil "x" nil "y" nil]
-;; [nil "x" "" nil nil]     [nil "x" "y" nil nil]
-
-;; "/x:y@"                  "/x:y@z"                 "/x:y@z:"
-;; [nil nil nil "x" "y@"]   [nil nil nil "x" "y@z"]  [nil "x" "y" "z" ""]
-;;       "/[x/y@"                 "/[x/y@z"
-;; [nil "x" nil "y" nil]    [nil "x" "y" "z" nil]
-(defun tramp-completion-dissect-file-name (name)
-  "Returns a list of `tramp-file-name' structures.
-They are collected by `tramp-completion-dissect-file-name1'."
-
-  (let* ((result)
-	 (x-nil "\\|\\(\\)")
-	 ;; "/method" "/[method"
-	 (tramp-completion-file-name-structure1
-	  (list (concat tramp-prefix-regexp "\\(" tramp-method-regexp x-nil "\\)$")
-		1 nil nil nil))
-	 ;; "/user" "/[user"
-	 (tramp-completion-file-name-structure2
-	  (list (concat tramp-prefix-regexp "\\(" tramp-user-regexp x-nil   "\\)$")
-		nil 1 nil nil))
-	 ;; "/host" "/[host"
-	 (tramp-completion-file-name-structure3
-	  (list (concat tramp-prefix-regexp "\\(" tramp-host-regexp x-nil   "\\)$")
-		nil nil 1 nil))
-	 ;; "/user@host" "/[user@host"
-	 (tramp-completion-file-name-structure4
-	  (list (concat tramp-prefix-regexp
-			"\\(" tramp-user-regexp "\\)"   tramp-postfix-user-regexp
-			"\\(" tramp-host-regexp x-nil   "\\)$")
-		nil 1 2 nil))
-	 ;; "/method:user" "/[method/user"
-	 (tramp-completion-file-name-structure5
-	  (list (concat tramp-prefix-regexp
-			"\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp
-			"\\(" tramp-user-regexp x-nil   "\\)$")
-		1 2 nil nil))
-	 ;; "/method:host" "/[method/host"
-	 (tramp-completion-file-name-structure6
-	  (list (concat tramp-prefix-regexp
-			"\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp
-			"\\(" tramp-host-regexp x-nil   "\\)$")
-		1 nil 2 nil))
-	 ;; "/method:user@host" "/[method/user@host"
-	 (tramp-completion-file-name-structure7
-	  (list (concat tramp-prefix-regexp
-			"\\(" tramp-method-regexp "\\)" tramp-postfix-single-method-regexp
-			"\\(" tramp-user-regexp "\\)"   tramp-postfix-user-regexp
-			"\\(" tramp-host-regexp x-nil   "\\)$")
-		1 2 3 nil)))
-
-    (mapcar (lambda (regexp)
-      (add-to-list 'result
-	(tramp-completion-dissect-file-name1 regexp name)))
-      (list
-       tramp-completion-file-name-structure1
-       tramp-completion-file-name-structure2
-       tramp-completion-file-name-structure3
-       tramp-completion-file-name-structure4
-       tramp-completion-file-name-structure5
-       tramp-completion-file-name-structure6
-       tramp-completion-file-name-structure7
-       tramp-file-name-structure))
-
-    (delq nil result)))
-
-(defun tramp-completion-dissect-file-name1 (structure name)
-  "Returns a `tramp-file-name' structure matching STRUCTURE.
-The structure consists of multi-method, remote method, remote user,
-remote host and localname (filename on remote host)."
-
-  (let (method)
-    (save-match-data
-      (when (string-match (nth 0 structure) name)
-	(setq method (and (nth 1 structure)
-			  (match-string (nth 1 structure) name)))
-	(if (and method (member method tramp-multi-methods))
-	    ;; Not handled (yet).
-	    (make-tramp-file-name
-	     :multi-method method
-	     :method nil
-	     :user nil
-	     :host nil
-	     :localname nil)
-	  (let ((user   (and (nth 2 structure)
-			     (match-string (nth 2 structure) name)))
-		(host   (and (nth 3 structure)
-			     (match-string (nth 3 structure) name)))
-		(localname   (and (nth 4 structure)
-			     (match-string (nth 4 structure) name))))
-	    (make-tramp-file-name
-	     :multi-method nil
-	     :method method
-	     :user user
-	     :host host
-	     :localname localname)))))))
-
-;; This function returns all possible method completions, adding the
-;; trailing method delimeter.
-(defun tramp-get-completion-methods (partial-method)
-  "Returns all method completions for PARTIAL-METHOD."
-  (mapcar
-   (lambda (method)
-     (and method
-	  (string-match (concat "^" (regexp-quote partial-method)) method)
-	  ;; we must remove leading "/".
-	  (substring (tramp-make-tramp-file-name nil method nil nil nil) 1)))
-   (delete "multi" (mapcar 'car tramp-methods))))
-
-;; Compares partial user and host names with possible completions.
-(defun tramp-get-completion-user-host (method partial-user partial-host user host)
-  "Returns the most expanded string for user and host name completion.
-PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
-  (cond
-
-   ((and partial-user partial-host)
-    (if	(and host
-	     (string-match (concat "^" (regexp-quote partial-host)) host)
-	     (string-equal partial-user (or user partial-user)))
-	(setq user partial-user)
-      (setq user nil
-	    host nil)))
-
-   (partial-user
-    (setq host nil)
-    (unless
-	(and user (string-match (concat "^" (regexp-quote partial-user)) user))
-      (setq user nil)))
-
-   (partial-host
-    (setq user nil)
-    (unless
-	(and host (string-match (concat "^" (regexp-quote partial-host)) host))
-      (setq host nil)))
-
-   (t (setq user nil
-	    host nil)))
-
-  (unless (zerop (+ (length user) (length host)))
-    ;; we must remove leading "/".
-    (substring (tramp-make-tramp-file-name nil method user host nil) 1)))
-
-(defun tramp-parse-rhosts (filename)
-  "Return a list of (user host) tuples allowed to access.
-Either user or host may be nil."
-
-  (let (res)
-    (when (file-readable-p filename)
-      (with-temp-buffer
-	(insert-file-contents filename)
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (push (tramp-parse-rhosts-group) res))))
-    res))
-
-;; Taken from gnus/netrc.el
-(eval-and-compile
-  (defalias 'tramp-point-at-eol
-    (if (fboundp 'point-at-eol)
-	'point-at-eol
-      'line-end-position)))
-
-(defun tramp-parse-rhosts-group ()
-   "Return a (user host) tuple allowed to access.
-Either user or host may be nil."
-
-   (let ((result)
-	 (regexp
-	  (concat
-	   "^\\(" tramp-host-regexp "\\)"
-	   "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
-
-     (narrow-to-region (point) (tramp-point-at-eol))
-     (when (re-search-forward regexp nil t)
-       (setq result (append (list (match-string 3) (match-string 1)))))
-     (widen)
-     (forward-line 1)
-     result))
-
-(defun tramp-parse-shosts (filename)
-  "Return a list of (user host) tuples allowed to access.
-User is always nil."
-
-  (let (res)
-    (when (file-readable-p filename)
-      (with-temp-buffer
-	(insert-file-contents filename)
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (push (tramp-parse-shosts-group) res))))
-    res))
-
-(defun tramp-parse-shosts-group ()
-   "Return a (user host) tuple allowed to access.
-User is always nil."
-
-   (let ((result)
-	 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
-
-     (narrow-to-region (point) (tramp-point-at-eol))
-     (when (re-search-forward regexp nil t)
-       (setq result (list nil (match-string 1))))
-     (widen)
-     (or
-      (> (skip-chars-forward ",") 0)
-      (forward-line 1))
-     result))
-
-(defun tramp-parse-sconfig (filename)
-  "Return a list of (user host) tuples allowed to access.
-User is always nil."
-
-  (let (res)
-    (when (file-readable-p filename)
-      (with-temp-buffer
-	(insert-file-contents filename)
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (push (tramp-parse-sconfig-group) res))))
-    res))
-
-(defun tramp-parse-sconfig-group ()
-   "Return a (user host) tuple allowed to access.
-User is always nil."
-
-   (let ((result)
-	 (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)")))
-
-     (narrow-to-region (point) (tramp-point-at-eol))
-     (when (re-search-forward regexp nil t)
-       (setq result (list nil (match-string 1))))
-     (widen)
-     (or
-      (> (skip-chars-forward ",") 0)
-      (forward-line 1))
-     result))
-
-(defun tramp-parse-shostkeys (dirname)
-  "Return a list of (user host) tuples allowed to access.
-User is always nil."
-
-  (let ((regexp (concat "^key_[0-9]+_\\(" tramp-host-regexp "\\)\\.pub$"))
-	(files (when (file-directory-p dirname) (directory-files dirname)))
-	result)
-
-    (while files
-      (when (string-match regexp (car files))
-	(push (list nil (match-string 1 (car files))) result))
-      (setq files (cdr files)))
-    result))
-
-(defun tramp-parse-sknownhosts (dirname)
-  "Return a list of (user host) tuples allowed to access.
-User is always nil."
-
-  (let ((regexp (concat "^\\(" tramp-host-regexp
-			"\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))
-	(files (when (file-directory-p dirname) (directory-files dirname)))
-	result)
-
-    (while files
-      (when (string-match regexp (car files))
-	(push (list nil (match-string 1 (car files))) result))
-      (setq files (cdr files)))
-    result))
-
-(defun tramp-parse-hosts (filename)
-  "Return a list of (user host) tuples allowed to access.
-User is always nil."
-
-  (let (res)
-    (when (file-readable-p filename)
-      (with-temp-buffer
-	(insert-file-contents filename)
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (push (tramp-parse-hosts-group) res))))
-    res))
-
-(defun tramp-parse-hosts-group ()
-   "Return a (user host) tuple allowed to access.
-User is always nil."
-
-   (let ((result)
-	 (regexp (concat "^\\(" tramp-host-regexp "\\)")))
-
-     (narrow-to-region (point) (tramp-point-at-eol))
-     (when (re-search-forward regexp nil t)
-       (unless (char-equal (or (char-after) ?\n) ?:) ; no IPv6
-	 (setq result (list nil (match-string 1)))))
-     (widen)
-     (or
-      (> (skip-chars-forward " \t") 0)
-      (forward-line 1))
-     result))
-
-;; For su-alike methods it would be desirable to return "root@localhost"
-;; as default.  Unfortunately, we have no information whether any user name
-;; has been typed already.  So we (mis-)use tramp-current-user as indication,
-;; assuming it is set in `tramp-completion-handle-file-name-all-completions'.
-(defun tramp-parse-passwd (filename)
-  "Return a list of (user host) tuples allowed to access.
-Host is always \"localhost\"."
-
-  (let (res)
-    (if (zerop (length tramp-current-user))
-	'(("root" nil))
-      (when (file-readable-p filename)
-	(with-temp-buffer
-	  (insert-file-contents filename)
-	  (goto-char (point-min))
-	  (while (not (eobp))
-	    (push (tramp-parse-passwd-group) res))))
-      res)))
-
-(defun tramp-parse-passwd-group ()
-   "Return a (user host) tuple allowed to access.
-Host is always \"localhost\"."
-
-   (let ((result)
-	 (regexp (concat "^\\(" tramp-user-regexp "\\):")))
-
-     (narrow-to-region (point) (tramp-point-at-eol))
-     (when (re-search-forward regexp nil t)
-       (setq result (list (match-string 1) "localhost")))
-     (widen)
-     (forward-line 1)
-     result))
-
-(defun tramp-parse-netrc (filename)
-  "Return a list of (user host) tuples allowed to access.
-User may be nil."
-
-  (let (res)
-    (when (file-readable-p filename)
-      (with-temp-buffer
-	(insert-file-contents filename)
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (push (tramp-parse-netrc-group) res))))
-    res))
-
-(defun tramp-parse-netrc-group ()
-   "Return a (user host) tuple allowed to access.
-User may be nil."
-
-   (let ((result)
-	 (regexp
-	  (concat
-	   "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)"
-	   "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
-
-     (narrow-to-region (point) (tramp-point-at-eol))
-     (when (re-search-forward regexp nil t)
-       (setq result (list (match-string 3) (match-string 1))))
-     (widen)
-     (forward-line 1)
-     result))
-
-(defun tramp-completion-handle-expand-file-name (name &optional dir)
-  "Like `expand-file-name' for tramp files."
-  (let ((fullname (concat (or dir default-directory) name)))
-    (if (tramp-completion-mode fullname)
-	(tramp-run-real-handler
-	 'expand-file-name (list name dir))
-      (tramp-completion-run-real-handler
-       'expand-file-name (list name dir)))))
-
-;;; Internal Functions:
-
-(defun tramp-maybe-send-perl-script (multi-method method user host script name)
-  "Define in remote shell function NAME implemented as perl SCRIPT.
-Only send the definition if it has not already been done.
-Function may have 0-3 parameters."
-  (let ((remote-perl (tramp-get-remote-perl multi-method method user host)))
-    (unless remote-perl (error "No remote perl"))
-    (let ((perl-scripts (tramp-get-connection-property "perl-scripts" nil
-                                                       multi-method method user host)))
-      (unless (memq name perl-scripts)
-        (with-current-buffer (tramp-get-buffer multi-method method user host)
-          (tramp-message 5 (concat "Sending the Perl script `" name "'..."))
-          (tramp-send-string multi-method method user host
-                             (concat name
-                                     " () {\n"
-                                     remote-perl
-                                     " -e '"
-                                     script
-                                     "' \"$1\" \"$2\" \"$3\" 2>/dev/null\n}"))
-          (tramp-wait-for-output)
-          (tramp-set-connection-property "perl-scripts" (cons name perl-scripts)
-                                         multi-method method user host)
-          (tramp-message 5 (concat "Sending the Perl script `" name "'...done.")))))))
-
-(defun tramp-set-auto-save ()
-  (when (and (buffer-file-name)
-             (tramp-tramp-file-p (buffer-file-name))
-	     ;; ange-ftp has its own auto-save mechanism
-	     (eq (tramp-find-foreign-file-name-handler (buffer-file-name))
-		 'tramp-sh-file-name-handler)
-             auto-save-default)
-    (auto-save-mode 1)))
-(add-hook 'find-file-hooks 'tramp-set-auto-save t)
-(add-hook 'tramp-unload-hook
-	  '(lambda ()
-	     (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
-
-(defun tramp-run-test (switch filename)
-  "Run `test' on the remote system, given a SWITCH and a FILENAME.
-Returns the exit code of the `test' program."
-  (let ((v (tramp-dissect-file-name filename)))
-    (save-excursion
-      (tramp-send-command-and-check
-       (tramp-file-name-multi-method v) (tramp-file-name-method v)
-       (tramp-file-name-user v) (tramp-file-name-host v)
-       (format "test %s %s" switch
-               (tramp-shell-quote-argument (tramp-file-name-localname v)))))))
-
-(defun tramp-run-test2 (program file1 file2 &optional switch)
-  "Run `test'-like PROGRAM on the remote system, given FILE1, FILE2.
-The optional SWITCH is inserted between the two files.
-Returns the exit code of the `test' PROGRAM.  Barfs if the methods,
-hosts, or files, disagree."
-  (let* ((v1 (tramp-dissect-file-name file1))
-         (v2 (tramp-dissect-file-name file2))
-         (mmethod1 (tramp-file-name-multi-method v1))
-         (mmethod2 (tramp-file-name-multi-method v2))
-         (method1 (tramp-file-name-method v1))
-         (method2 (tramp-file-name-method v2))
-         (user1 (tramp-file-name-user v1))
-         (user2 (tramp-file-name-user v2))
-         (host1 (tramp-file-name-host v1))
-         (host2 (tramp-file-name-host v2))
-         (localname1 (tramp-file-name-localname v1))
-         (localname2 (tramp-file-name-localname v2)))
-    (unless (and method1 method2 host1 host2
-                 (equal mmethod1 mmethod2)
-                 (equal method1 method2)
-                 (equal user1 user2)
-                 (equal host1 host2))
-      (error "tramp-run-test2: %s"
-             "only implemented for same method, same user, same host"))
-    (save-excursion
-      (tramp-send-command-and-check
-       mmethod1 method1 user1 host1
-       (format "%s %s %s %s"
-               program
-               (tramp-shell-quote-argument localname1)
-               (or switch "")
-               (tramp-shell-quote-argument localname2))))))
-
-(defun tramp-touch (file time)
-  "Set the last-modified timestamp of the given file.
-TIME is an Emacs internal time value as returned by `current-time'."
-  (let ((touch-time (format-time-string "%Y%m%d%H%M.%S" time)))
-    (if (tramp-tramp-file-p file)
-	(with-parsed-tramp-file-name file nil
-	  (let ((buf (tramp-get-buffer multi-method method user host)))
-	    (unless (zerop (tramp-send-command-and-check
-			    multi-method method user host
-			    (format "touch -t %s %s"
-				    touch-time
-				    localname)))
-	      (pop-to-buffer buf)
-	      (error "tramp-touch: touch failed, see buffer `%s' for details"
-		     buf))))
-      ;; It's a local file
-      (with-temp-buffer
-	(unless (zerop (call-process
-			"touch" nil (current-buffer) nil "-t" touch-time file))
-	      (pop-to-buffer (current-buffer))
-	      (error "tramp-touch: touch failed"))))))
-
-(defun tramp-buffer-name (multi-method method user host)
-  "A name for the connection buffer for USER at HOST using METHOD."
-  (if multi-method
-      (tramp-buffer-name-multi-method "tramp" multi-method method user host)
-    (let ((method (tramp-find-method multi-method method user host)))
-      (if user
-	  (format "*tramp/%s %s@%s*" method user host)
-	(format "*tramp/%s %s*" method host)))))
-
-(defun tramp-buffer-name-multi-method (prefix multi-method method user host)
-  "A name for the multi method connection buffer.
-MULTI-METHOD gives the multi method, METHOD the array of methods,
-USER the array of user names, HOST the array of host names."
-  (unless (and (= (length method) (length user))
-               (= (length method) (length host)))
-    (error "Syntax error in multi method (implementation error)"))
-  (let ((len (length method))
-        (i 0)
-        string-list)
-    (while (< i len)
-      (setq string-list
-            (cons (if (aref user i)
-                      (format "%s#%s@%s:" (aref method i)
-                              (aref user i) (aref host i))
-                    (format "%s@%s:" (aref method i) (aref host i)))
-                  string-list))
-      (incf i))
-    (format "*%s/%s %s*"
-            prefix multi-method
-            (apply 'concat (reverse string-list)))))
-
-(defun tramp-get-buffer (multi-method method user host)
-  "Get the connection buffer to be used for USER at HOST using METHOD."
-  (with-current-buffer
-      (get-buffer-create (tramp-buffer-name multi-method method user host))
-    (setq buffer-undo-list t)
-    (current-buffer)))
-
-(defun tramp-debug-buffer-name (multi-method method user host)
-  "A name for the debug buffer for USER at HOST using METHOD."
-  (if multi-method
-      (tramp-buffer-name-multi-method "debug tramp"
-				      multi-method method user host)
-    (let ((method (tramp-find-method multi-method method user host)))
-      (if user
-	  (format "*debug tramp/%s %s@%s*" method user host)
-	(format "*debug tramp/%s %s*" method host)))))
-
-(defun tramp-get-debug-buffer (multi-method method user host)
-  "Get the debug buffer for USER at HOST using METHOD."
-  (with-current-buffer
-      (get-buffer-create
-       (tramp-debug-buffer-name multi-method method user host))
-    (setq buffer-undo-list t)
-    (current-buffer)))
-
-(defun tramp-find-executable (multi-method method user host
-                                         progname dirlist ignore-tilde)
-  "Searches for PROGNAME in all directories mentioned in DIRLIST.
-First args METHOD, USER and HOST specify the connection, PROGNAME
-is the program to search for, and DIRLIST gives the list of directories
-to search.  If IGNORE-TILDE is non-nil, directory names starting
-with `~' will be ignored.
-
-Returns the absolute file name of PROGNAME, if found, and nil otherwise.
-
-This function expects to be in the right *tramp* buffer."
-  (let (result)
-    (when ignore-tilde
-      ;; Remove all ~/foo directories from dirlist.  In Emacs 20,
-      ;; `remove' is in CL, and we want to avoid CL dependencies.
-      (let (newdl d)
-        (while dirlist
-          (setq d (car dirlist))
-          (setq dirlist (cdr dirlist))
-          (unless (char-equal ?~ (aref d 0))
-            (setq newdl (cons d newdl))))
-        (setq dirlist (nreverse newdl))))
-    (tramp-send-command
-     multi-method method user host
-     (format (concat "while read d; "
-                     "do if test -x $d/%s -a -f $d/%s; "
-                     "then echo tramp_executable $d/%s; "
-                     "break; fi; done <<'EOF'")
-             progname progname progname))
-    (mapcar (lambda (d)
-              (tramp-send-command multi-method method user host d))
-            dirlist)
-    (tramp-send-command multi-method method user host "EOF")
-    (tramp-wait-for-output)
-    (goto-char (point-max))
-    (when (search-backward "tramp_executable " nil t)
-      (skip-chars-forward "^ ")
-      (skip-chars-forward " ")
-      (buffer-substring (point) (tramp-line-end-position)))))
-
-(defun tramp-set-remote-path (multi-method method user host var dirlist)
-  "Sets the remote environment VAR to existing directories from DIRLIST.
-I.e., for each directory in DIRLIST, it is tested whether it exists and if
-so, it is added to the environment variable VAR."
-  (let ((existing-dirs
-         (mapcar
-          (lambda (x)
-            (when (and
-                   (file-exists-p
-                    (tramp-make-tramp-file-name multi-method method user host x))
-                   (file-directory-p
-                    (tramp-make-tramp-file-name multi-method method user host x)))
-              x))
-          dirlist)))
-    (tramp-send-command
-     multi-method method user host
-     (concat var "="
-             (mapconcat 'identity (delq nil existing-dirs) ":")
-             "; export " var))
-  (tramp-wait-for-output)))
-
-;; -- communication with external shell --
-
-(defun tramp-find-file-exists-command (multi-method method user host)
-  "Find a command on the remote host for checking if a file exists.
-Here, we are looking for a command which has zero exit status if the
-file exists and nonzero exit status otherwise."
-  (make-local-variable 'tramp-file-exists-command)
-  (tramp-message 9 "Finding command to check if file exists")
-  (let ((existing
-         (tramp-make-tramp-file-name
-          multi-method method user host
-          "/"))                         ;assume this file always exists
-        (nonexisting
-         (tramp-make-tramp-file-name
-          multi-method method user host
-          "/ this file does not exist "))) ;assume this never exists
-    ;; The algorithm is as follows: we try a list of several commands.
-    ;; For each command, we first run `$cmd /' -- this should return
-    ;; true, as the root directory always exists.  And then we run
-    ;; `$cmd /this\ file\ does\ not\ exist', hoping that the file indeed
-    ;; does not exist.  This should return false.  We use the first
-    ;; command we find that seems to work.
-    ;; The list of commands to try is as follows:
-    ;; `ls -d'          This works on most systems, but NetBSD 1.4
-    ;;                  has a bug: `ls' always returns zero exit
-    ;;                  status, even for files which don't exist.
-    ;; `test -e'        Some Bourne shells have a `test' builtin
-    ;;                  which does not know the `-e' option.
-    ;; `/bin/test -e'   For those, the `test' binary on disk normally
-    ;;                  provides the option.  Alas, the binary
-    ;;                  is sometimes `/bin/test' and sometimes it's
-    ;;                  `/usr/bin/test'.
-    ;; `/usr/bin/test -e'       In case `/bin/test' does not exist.
-    (unless (or
-             (and (setq tramp-file-exists-command "test -e %s")
-                  (file-exists-p existing)
-                  (not (file-exists-p nonexisting)))
-             (and (setq tramp-file-exists-command "/bin/test -e %s")
-                  (file-exists-p existing)
-                  (not (file-exists-p nonexisting)))
-             (and (setq tramp-file-exists-command "/usr/bin/test -e %s")
-                  (file-exists-p existing)
-                  (not (file-exists-p nonexisting)))
-             (and (setq tramp-file-exists-command "ls -d %s")
-                  (file-exists-p existing)
-                  (not (file-exists-p nonexisting))))
-      (error "Couldn't find command to check if file exists"))))
-
-
-;; CCC test ksh or bash found for tilde expansion?
-(defun tramp-find-shell (multi-method method user host)
-  "Find a shell on the remote host which groks tilde expansion."
-  (let ((shell nil))
-    (tramp-send-command multi-method method user host "echo ~root")
-    (tramp-wait-for-output)
-    (cond
-     ((string-match "^~root$" (buffer-string))
-      (setq shell
-            (or (tramp-find-executable multi-method method user host
-				       "bash"  tramp-remote-path t)
-                (tramp-find-executable multi-method method user host
-				       "ksh" tramp-remote-path t)))
-      (unless shell
-        (error "Couldn't find a shell which groks tilde expansion"))
-      ;; Find arguments for this shell.
-      (let ((alist tramp-sh-extra-args)
-	    item extra-args)
-	(while (and alist (null extra-args))
-	  (setq item (pop alist))
-	  (when (string-match (car item) shell)
-	    (setq extra-args (cdr item))))
-	(when extra-args (setq shell (concat shell " " extra-args))))
-      (tramp-message
-       5 "Starting remote shell `%s' for tilde expansion..." shell)
-      (tramp-send-command
-       multi-method method user host
-       (concat "PS1='$ ' exec " shell)) ;
-      (tramp-barf-if-no-shell-prompt
-       (get-buffer-process (current-buffer))
-       60 "Couldn't find remote `%s' prompt" shell)
-      (tramp-message
-       9 "Setting remote shell prompt...")
-      ;; Douglas Gray Stephens  says that we
-      ;; must use "\n" here, not tramp-rsh-end-of-line.  Kai left the
-      ;; last tramp-rsh-end-of-line, Douglas wanted to replace that,
-      ;; as well.
-      (process-send-string nil (format "PS1='%s%s%s'; PS2=''; PS3=''%s"
-				       tramp-rsh-end-of-line
-                                       tramp-end-of-output
-				       tramp-rsh-end-of-line
-                                       tramp-rsh-end-of-line))
-      (tramp-wait-for-output)
-      (tramp-message
-       9 "Setting remote shell prompt...done")
-      )
-     (t (tramp-message 5 "Remote `%s' groks tilde expansion, good"
-		       (tramp-get-method-parameter
-			multi-method method user host 'tramp-remote-sh))))))
-
-(defun tramp-check-ls-command (multi-method method user host cmd)
-  "Checks whether the given `ls' executable groks `-n'.
-METHOD, USER and HOST specify the connection, CMD (the absolute file name of)
-the `ls' executable.  Returns t if CMD supports the `-n' option, nil
-otherwise."
-  (tramp-message 9 "Checking remote `%s' command for `-n' option" cmd)
-  (when (file-executable-p
-         (tramp-make-tramp-file-name multi-method method user host cmd))
-    (let ((result nil))
-      (tramp-message 7 "Testing remote command `%s' for -n..." cmd)
-      (setq result
-            (tramp-send-command-and-check
-             multi-method method user host
-             (format "%s -lnd / >/dev/null"
-                     cmd)))
-      (tramp-message 7 "Testing remote command `%s' for -n...%s"
-                   cmd
-                   (if (zerop result) "okay" "failed"))
-      (zerop result))))
-
-(defun tramp-check-ls-commands (multi-method method user host cmd dirlist)
-  "Checks whether the given `ls' executable in one of the dirs groks `-n'.
-Returns nil if none was found, else the command is returned."
-  (let ((dl dirlist)
-        (result nil))
-    (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
-      ;; It would be better to use the CL function `find', but
-      ;; we don't want run-time dependencies on CL.
-      (while (and dl (not result))
-	(let ((x (concat (file-name-as-directory (car dl)) cmd)))
-	  (when (tramp-check-ls-command multi-method method user host x)
-	    (setq result x)))
-	(setq dl (cdr dl)))
-      result)))
-
-(defun tramp-find-ls-command (multi-method method user host)
-  "Finds an `ls' command which groks the `-n' option, returning nil if failed.
-\(This option prints numeric user and group ids in a long listing.)"
-  (tramp-message 9 "Finding a suitable `ls' command")
-  (or
-   (tramp-check-ls-commands multi-method method user host "ls" tramp-remote-path)
-   (tramp-check-ls-commands multi-method method user host "gnuls" tramp-remote-path)
-   (tramp-check-ls-commands multi-method method user host "gls" tramp-remote-path)))
-
-;; ------------------------------------------------------------
-;; -- Functions for establishing connection --
-;; ------------------------------------------------------------
-
-;; The following functions are actions to be taken when seeing certain
-;; prompts from the remote host.  See the variable
-;; `tramp-actions-before-shell' for usage of these functions.
-
-(defun tramp-action-login (p multi-method method user host)
-  "Send the login name."
-  (tramp-message 9 "Sending login name `%s'"
-		 (or user (user-login-name)))
-  (erase-buffer)
-  (process-send-string nil (concat (or user (user-login-name))
-				   tramp-rsh-end-of-line)))
-
-(defun tramp-action-password (p multi-method method user host)
-  "Query the user for a password."
-  (let ((pw-prompt
-	 (format "Password for %s "
-		 (tramp-make-tramp-file-name
-		  nil method user host ""))))
-    (tramp-message 9 "Sending password")
-    (tramp-enter-password p pw-prompt user host)))
-
-(defun tramp-action-succeed (p multi-method method user host)
-  "Signal success in finding shell prompt."
-  (tramp-message 9 "Found remote shell prompt.")
-  (erase-buffer)
-  (throw 'tramp-action 'ok))
-
-(defun tramp-action-permission-denied (p multi-method method user host)
-  "Signal permission denied."
-  (pop-to-buffer (tramp-get-buffer multi-method method user host))
-  (tramp-message 9 "Permission denied by remote host.")
-  (kill-process p)
-  (throw 'tramp-action 'permission-denied))
-
-(defun tramp-action-yesno (p multi-method method user host)
-  "Ask the user for confirmation using `yes-or-no-p'.
-Send \"yes\" to remote process on confirmation, abort otherwise.
-See also `tramp-action-yn'."
-  (save-window-excursion
-    (pop-to-buffer (tramp-get-buffer multi-method method user host))
-    (unless (yes-or-no-p (match-string 0))
-      (kill-process p)
-      (erase-buffer)
-      (throw 'tramp-action 'permission-denied))
-    (process-send-string p (concat "yes" tramp-rsh-end-of-line))
-    (erase-buffer)))
-
-(defun tramp-action-yn (p multi-method method user host)
-  "Ask the user for confirmation using `y-or-n-p'.
-Send \"y\" to remote process on confirmation, abort otherwise.
-See also `tramp-action-yesno'."
-  (save-window-excursion
-    (pop-to-buffer (tramp-get-buffer multi-method method user host))
-    (unless (y-or-n-p (match-string 0))
-      (kill-process p)
-      (throw 'tramp-action 'permission-denied))
-    (erase-buffer)
-    (process-send-string p (concat "y" tramp-rsh-end-of-line))))
-
-(defun tramp-action-terminal (p multi-method method user host)
-  "Tell the remote host which terminal type to use.
-The terminal type can be configured with `tramp-terminal-type'."
-  (tramp-message 9 "Setting `%s' as terminal type."
-		 tramp-terminal-type)
-  (erase-buffer)
-  (process-send-string nil (concat tramp-terminal-type
-				   tramp-rsh-end-of-line)))
-
-(defun tramp-action-process-alive (p multi-method method user host)
-  "Check whether a process has finished."
-  (unless (memq (process-status p) '(run open))
-    (throw 'tramp-action 'process-died)))
-
-(defun tramp-action-out-of-band (p multi-method method user host)
-  "Check whether an out-of-band copy has finished."
-  (cond ((and (memq (process-status p) '(stop exit))
-	      (zerop (process-exit-status p)))
-	 (tramp-message 9 "Process has finished.")
-	 (throw 'tramp-action 'ok))
-	((or (and (memq (process-status p) '(stop exit))
-		  (not (zerop (process-exit-status p))))
-	     (memq (process-status p) '(signal)))
-	 ;; `scp' could have copied correctly, but set modes could have failed.
-	 ;; This can be ignored.
-	 (goto-char (point-min))
-	 (if (re-search-forward tramp-operation-not-permitted-regexp nil t)
-	     (progn
-	       (tramp-message 10 "'set mode' error ignored.")
-	       (tramp-message 9 "Process has finished.")
-	       (throw 'tramp-action 'ok))
-	   (goto-char (point-min))
-	   (when (re-search-forward "^.cp.?: \\(.+: Permission denied.?\\)$" nil t)
-	     (error "Remote host: %s" (match-string 1)))
-	   (tramp-message 9 "Process has died.")
-	   (throw 'tramp-action 'process-died)))
-	(t nil)))
-
-;; The following functions are specifically for multi connections.
-
-(defun tramp-multi-action-login (p method user host)
-  "Send the login name."
-  (tramp-message 9 "Sending login name `%s'" user)
-  (erase-buffer)
-  (process-send-string p (concat user tramp-rsh-end-of-line)))
-
-(defun tramp-multi-action-password (p method user host)
-  "Query the user for a password."
-  (let ((pw-prompt
-	 (format "Password for %s "
-		 (tramp-make-tramp-file-name
-		  nil method user host ""))))
-    (tramp-message 9 "Sending password")
-    (tramp-enter-password p pw-prompt user host)))
-
-(defun tramp-multi-action-succeed (p method user host)
-  "Signal success in finding shell prompt."
-  (tramp-message 9 "Found shell prompt on `%s'" host)
-  (erase-buffer)
-  (throw 'tramp-action 'ok))
-
-(defun tramp-multi-action-permission-denied (p method user host)
-  "Signal permission denied."
-  (tramp-message 9 "Permission denied by remote host `%s'" host)
-  (kill-process p)
-  (erase-buffer)
-  (throw 'tramp-action 'permission-denied))
-
-(defun tramp-multi-action-process-alive (p method user host)
-  "Check whether a process has finished."
-  (unless (memq (process-status p) '(run open))
-    (throw 'tramp-action 'process-died)))
-
-;; Functions for processing the actions.
-
-(defun tramp-process-one-action (p multi-method method user host actions)
-  "Wait for output from the shell and perform one action."
-  (let (found item pattern action todo)
-    (erase-buffer)
-    (tramp-message 9 "Waiting 60s for prompt from remote shell")
-    (with-timeout (60 (throw 'tramp-action 'timeout))
-      (while (not found)
-	(tramp-accept-process-output p 1)
-	(goto-char (point-min))
-	(setq todo actions)
-	(while todo
-	  (goto-char (point-min))
-	  (setq item (pop todo))
-	  (setq pattern (symbol-value (nth 0 item)))
-	  (setq action (nth 1 item))
-	  (tramp-message 10 "Looking for regexp \"%s\" from remote shell"
-			 pattern)
-	  (when (re-search-forward (concat pattern "\\'") nil t)
-	    (setq found (funcall action p multi-method method user host)))))
-      found)))
-
-(defun tramp-process-actions (p multi-method method user host actions)
-  "Perform actions until success."
-  (let (exit)
-    (while (not exit)
-      (tramp-message 9 "Waiting for prompts from remote shell")
-      (setq exit
-	    (catch 'tramp-action
-	      (tramp-process-one-action
-	       p multi-method method user host actions)
-	      nil)))
-    (unless (eq exit 'ok)
-      (tramp-clear-passwd user host)
-      (error "Login failed"))))
-
-;; For multi-actions.
-
-(defun tramp-process-one-multi-action (p method user host actions)
-  "Wait for output from the shell and perform one action."
-  (let (found item pattern action todo)
-    (erase-buffer)
-    (tramp-message 9 "Waiting 60s for prompt from remote shell")
-    (with-timeout (60 (throw 'tramp-action 'timeout))
-      (while (not found)
-	(tramp-accept-process-output p 1)
-	(setq todo actions)
-	(goto-char (point-min))
-	(while todo
-	  (goto-char (point-min))
-	  (setq item (pop todo))
-	  (setq pattern (symbol-value (nth 0 item)))
-	  (setq action (nth 1 item))
-	  (tramp-message 10 "Looking for regexp \"%s\" from remote shell"
-			 pattern)
-	  (when (re-search-forward (concat pattern "\\'") nil t)
-	    (setq found (funcall action p method user host)))))
-      found)))
-
-(defun tramp-process-multi-actions (p method user host actions)
-  "Perform actions until success."
-  (let (exit)
-    (while (not exit)
-      (tramp-message 9 "Waiting for prompts from remote shell")
-      (setq exit
-	    (catch 'tramp-action
-	      (tramp-process-one-multi-action p method user host actions)
-	      nil)))
-    (unless (eq exit 'ok)
-      (tramp-clear-passwd user host)
-      (error "Login failed"))))
-
-;; Functions to execute when we have seen the remote shell prompt but
-;; before we exec the Bourne-ish shell.  Note that these commands
-;; might be sent to any shell, not just a Bourne-ish shell.  This
-;; means that the commands need to work in all shells.  (It is also
-;; okay for some commands to just fail with an error message, but
-;; please make sure that they at least don't crash the odd shell people
-;; might be running...)
-(defun tramp-process-initial-commands (p
-				       multi-method method user host
-				       commands)
-  "Send list of commands to remote host, in order."
-  (let (cmd)
-    (while commands
-      (setq cmd (pop commands))
-      (erase-buffer)
-      (tramp-message 10 "Sending command to remote shell: %s"
-		     cmd)
-      (tramp-send-command multi-method method user host cmd nil t)
-      (tramp-barf-if-no-shell-prompt
-       p 60 "Remote shell command failed: %s" cmd))
-    (erase-buffer)))
-
-;; The actual functions for opening connections.
-
-(defun tramp-open-connection-telnet (multi-method method user host)
-  "Open a connection using a telnet METHOD.
-This starts the command `telnet HOST ARGS'[*], then waits for a remote
-login prompt, then sends the user name USER, then waits for a remote
-password prompt.  It queries the user for the password, then sends the
-password to the remote host.
-
-If USER is nil, uses value returned by `(user-login-name)' instead.
-
-Recognition of the remote shell prompt is based on the variables
-`shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
-set up correctly.
-
-Please note that it is NOT possible to use this connection method
-together with an out-of-band transfer method!  You must use an inline
-transfer method.
-
-Maybe the different regular expressions need to be tuned.
-
-* Actually, the telnet program as well as the args to be used can be
-  specified in the method parameters, see the variable `tramp-methods'."
-  (save-match-data
-    (when (tramp-method-out-of-band-p multi-method method user host)
-      (error "Cannot use out-of-band method `%s' with telnet connection method"
-             method))
-    (when multi-method
-      (error "Cannot multi-connect using telnet connection method"))
-    (tramp-pre-connection multi-method method user host tramp-chunksize)
-    (tramp-message 7 "Opening connection for %s@%s using %s..."
-		   (or user (user-login-name)) host method)
-    (let ((process-environment (copy-sequence process-environment)))
-      (setenv "TERM" tramp-terminal-type)
-      (setenv "PS1" "$ ")
-      (let* ((default-directory (tramp-temporary-file-directory))
-	     ;; If we omit the conditional here, then we would use
-	     ;; `undecided-dos' in some cases.  With the conditional,
-	     ;; we use nil in these cases.  Which one is right?
-             (coding-system-for-read (unless (and (not (featurep 'xemacs))
-                                                  (> emacs-major-version 20))
-                                       tramp-dos-coding-system))
-             (p (apply 'start-process
-                       (tramp-buffer-name multi-method method user host)
-                       (tramp-get-buffer multi-method method user host)
-		       (tramp-get-method-parameter
-			multi-method
-			(tramp-find-method multi-method method user host)
-			user host 'tramp-login-program)
-                       host
-		       (tramp-get-method-parameter
-			multi-method
-			(tramp-find-method multi-method method user host)
-			user host 'tramp-login-args)))
-             (found nil)
-             (pw nil))
-        (tramp-set-process-query-on-exit-flag p nil)
-	(set-buffer (tramp-get-buffer multi-method method user host))
-	(erase-buffer)
-	(tramp-process-actions p multi-method method user host
-			       tramp-actions-before-shell)
-        (tramp-open-connection-setup-interactive-shell
-         p multi-method method user host)
-        (tramp-post-connection multi-method method user host)))))
-
-
-(defun tramp-open-connection-rsh (multi-method method user host)
-  "Open a connection using an rsh METHOD.
-This starts the command `rsh HOST -l USER'[*], then waits for a remote
-password or shell prompt.  If a password prompt is seen, the user is
-queried for a password, this function sends the password to the remote
-host and waits for a shell prompt.
-
-If USER is nil, start the command `rsh HOST'[*] instead
-
-Recognition of the remote shell prompt is based on the variables
-`shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
-set up correctly.
-
-Kludgy feature: if HOST has the form \"xx#yy\", then yy is assumed to
-be a port number for ssh, and \"-p yy\" will be added to the list of
-arguments, and xx will be used as the host name to connect to.
-
-* Actually, the rsh program to be used can be specified in the
-  method parameters, see the variable `tramp-methods'."
-  (save-match-data
-    (when multi-method
-      (error "Cannot multi-connect using rsh connection method"))
-    (tramp-pre-connection multi-method method user host tramp-chunksize)
-    (if (and user (not (string= user "")))
-	(tramp-message 7 "Opening connection for %s@%s using %s..."
-		       user host method)
-      (tramp-message 7 "Opening connection at %s using %s..." host method))
-    (let ((process-environment (copy-sequence process-environment))
-	  (bufnam (tramp-buffer-name multi-method method user host))
-	  (buf (tramp-get-buffer multi-method method user host))
-	  (login-program (tramp-get-method-parameter
-			multi-method
-			(tramp-find-method multi-method method user host)
-			user host 'tramp-login-program))
-	  (login-args (tramp-get-method-parameter
-		     multi-method
-		     (tramp-find-method multi-method method user host)
-		     user host 'tramp-login-args))
-	  (real-host host))
-      ;; The following should be changed.  We need a more general
-      ;; mechanism to parse extra host args.
-      (when (string-match "\\([^#]*\\)#\\(.*\\)" host)
-	(setq login-args (cons "-p" (cons (match-string 2 host) login-args)))
-	(setq real-host (match-string 1 host)))
-      (setenv "TERM" tramp-terminal-type)
-      (setenv "PS1" "$ ")
-      (let* ((default-directory (tramp-temporary-file-directory))
-	     ;; If we omit the conditional, we would use
-	     ;; `undecided-dos' in some cases.  With the conditional,
-	     ;; we use nil in these cases.  Which one is right?
-             (coding-system-for-read (unless (and (not (featurep 'xemacs))
-                                                  (> emacs-major-version 20))
-                                       tramp-dos-coding-system))
-             (p (if (and user (not (string= user "")))
-                    (apply #'start-process bufnam buf login-program
-                           real-host "-l" user login-args)
-                  (apply #'start-process bufnam buf login-program
-                         real-host login-args)))
-             (found nil))
-        (tramp-set-process-query-on-exit-flag p nil)
-
-	(set-buffer buf)
-	(tramp-process-actions p multi-method method user host
-			       tramp-actions-before-shell)
-        (tramp-message 7 "Initializing remote shell")
-        (tramp-open-connection-setup-interactive-shell
-         p multi-method method user host)
-        (tramp-post-connection multi-method method user host)))))
-
-(defun tramp-open-connection-su (multi-method method user host)
-  "Open a connection using the `su' program with METHOD.
-This starts `su - USER', then waits for a password prompt.  The HOST
-name must be equal to the local host name or to `localhost'.
-
-If USER is nil, uses value returned by user-login-name instead.
-
-Recognition of the remote shell prompt is based on the variables
-`shell-prompt-pattern' and `tramp-shell-prompt-pattern' which must be
-set up correctly.  Note that the other user may have a different shell
-prompt than you do, so it is not at all unlikely that the variable
-`shell-prompt-pattern' is set up wrongly!"
-  (save-match-data
-    (when (tramp-method-out-of-band-p multi-method method user host)
-      (error "Cannot use out-of-band method `%s' with `su' connection method"
-             method))
-    (unless (or (string-match (concat "^" (regexp-quote host))
-                              (system-name))
-                (string= "localhost" host)
-		(string= "" host))
-      (error
-       "Cannot connect to different host `%s' with `su' connection method"
-       host))
-    (tramp-pre-connection multi-method method user host tramp-chunksize)
-    (tramp-message 7 "Opening connection for `%s' using `%s'..."
-		   (or user "") method)
-    (let ((process-environment (copy-sequence process-environment)))
-      (setenv "TERM" tramp-terminal-type)
-      (setenv "PS1" "$ ")
-      (let* ((default-directory (tramp-temporary-file-directory))
-	     ;; If we omit the conditional, we use `undecided-dos' in
-	     ;; some cases.  With the conditional, we use nil in these
-	     ;; cases.  What's the difference?  Which one is right?
-             (coding-system-for-read (unless (and (not (featurep 'xemacs))
-                                                  (> emacs-major-version 20))
-                                       tramp-dos-coding-system))
-             (p (apply 'start-process
-                       (tramp-buffer-name multi-method method user host)
-                       (tramp-get-buffer multi-method method user host)
-		       (tramp-get-method-parameter
-			multi-method
-			(tramp-find-method multi-method method user host)
-			user host 'tramp-login-program)
-                       (mapcar
-                        (lambda (x)
-			  (format-spec x `((?u . ,(or user "root")))))
-                        (tramp-get-method-parameter
-			 multi-method
-			 (tramp-find-method multi-method method user host)
-			 user host 'tramp-login-args))))
-             (found nil)
-             (pw nil))
-        (tramp-set-process-query-on-exit-flag p nil)
-	(set-buffer (tramp-get-buffer multi-method method user host))
-	(tramp-process-actions p multi-method method user host
-			       tramp-actions-before-shell)
-        (tramp-open-connection-setup-interactive-shell
-         p multi-method method user host)
-        (tramp-post-connection multi-method method
-                               user host)))))
-
-;; HHH: Not Changed.  Multi method.  It is not clear to me how this can
-;;      handle not giving a user name in the "file name".
-;;
-;;      This is more difficult than for the single-hop method.  In the
-;;      multi-hop-method, the desired behaviour should be that the
-;;      user must specify names for the telnet hops of which the user
-;;      name is different than the "original" name (or different from
-;;      the previous hop.
-(defun tramp-open-connection-multi (multi-method method user host)
-  "Open a multi-hop connection using METHOD.
-This uses a slightly changed file name syntax.  The idea is to say
-    [multi/telnet:u1@h1/rsh:u2@h2]/path/to/file
-This will use telnet to log in as u1 to h1, then use rsh from there to
-log in as u2 to h2."
-  (save-match-data
-    (unless multi-method
-      (error "Multi-hop open connection function called on non-multi method"))
-    (when (tramp-method-out-of-band-p multi-method method user host)
-      (error "No out of band multi-hop connections"))
-    (unless (and (arrayp method) (not (stringp method)))
-      (error "METHOD must be an array of strings for multi methods"))
-    (unless (and (arrayp user) (not (stringp user)))
-      (error "USER must be an array of strings for multi methods"))
-    (unless (and (arrayp host) (not (stringp host)))
-      (error "HOST must be an array of strings for multi methods"))
-    (unless (and (= (length method) (length user))
-                 (= (length method) (length host)))
-      (error "Arrays METHOD, USER, HOST must have equal length"))
-    (tramp-pre-connection multi-method method user host tramp-chunksize)
-    (tramp-message 7 "Opening `%s' connection..." multi-method)
-    (let ((process-environment (copy-sequence process-environment)))
-      (setenv "TERM" tramp-terminal-type)
-      (setenv "PS1" "$ ")
-      (let* ((default-directory (tramp-temporary-file-directory))
-	     ;; If we omit the conditional, we use `undecided-dos' in
-	     ;; some cases.  With the conditional, we use nil in these
-	     ;; cases.  What's the difference?  Which one is right?
-             (coding-system-for-read (unless (and (not (featurep 'xemacs))
-                                                  (> emacs-major-version 20))
-                                       tramp-dos-coding-system))
-             (p (start-process (tramp-buffer-name multi-method method user host)
-                               (tramp-get-buffer multi-method method user host)
-                               tramp-multi-sh-program))
-             (num-hops (length method))
-             (i 0))
-        (tramp-set-process-query-on-exit-flag p nil)
-        (tramp-message 9 "Waiting 60s for local shell to come up...")
-        (unless (tramp-wait-for-regexp
-		 p 60 (format "\\(%s\\)\\'\\|\\(%s\\)\\'"
-			      shell-prompt-pattern tramp-shell-prompt-pattern))
-          (pop-to-buffer (buffer-name))
-          (kill-process p)
-          (error "Couldn't find local shell prompt"))
-        ;; Now do all the connections as specified.
-        (while (< i num-hops)
-          (let* ((m (aref method i))
-                 (u (aref user i))
-                 (h (aref host i))
-                 (entry (assoc m tramp-multi-connection-function-alist))
-                 (multi-func (nth 1 entry))
-                 (command (nth 2 entry)))
-	    ;; The multi-funcs don't need to do save-match-data, as that
-            ;; is done here.
-            (funcall multi-func p m u h command)
-            (erase-buffer)
-            (incf i)))
-        (tramp-open-connection-setup-interactive-shell
-         p multi-method method user host)
-        (tramp-post-connection multi-method method user host)))))
-
-;; HHH: Changed.  Multi method.  Don't know how to handle this in the case
-;;      of no user name provided.  Hack to make it work as it did before:
-;;      changed `user' to `(or user (user-login-name))' in the places where
-;;      the value is actually used.
-(defun tramp-multi-connect-telnet (p method user host command)
-  "Issue `telnet' command.
-Uses shell COMMAND to issue a `telnet' command to log in as USER to
-HOST.  You can use percent escapes in COMMAND: `%h' is replaced with
-the host name, and `%n' is replaced with an end of line character, as
-set in `tramp-rsh-end-of-line'.  Use `%%' if you want a literal percent
-character.
-
-If USER is nil, uses the return value of (user-login-name) instead."
-  (let ((cmd (format-spec command
-			  `((?h . ,host) (?n . ,tramp-rsh-end-of-line))))
-        (cmd1 (format-spec command `((?h . ,host) (?n . ""))))
-        found pw)
-    (erase-buffer)
-    (tramp-message 9 "Sending telnet command `%s'" cmd1)
-    (process-send-string p cmd)
-    (tramp-process-multi-actions p method user host
-				 tramp-multi-actions)))
-
-;; HHH: Changed.  Multi method.  Don't know how to handle this in the case
-;;      of no user name provided.  Hack to make it work as it did before:
-;;      changed `user' to `(or user (user-login-name))' in the places where
-;;      the value is actually used.
-(defun tramp-multi-connect-rlogin (p method user host command)
-  "Issue `rlogin' command.
-Uses shell COMMAND to issue an `rlogin' command to log in as USER to
-HOST.  You can use percent escapes in COMMAND.  `%u' will be replaced
-with the user name, `%h' will be replaced with the host name, and `%n'
-will be replaced with the value of `tramp-rsh-end-of-line'.  You can use
-`%%' if you want to use a literal percent character.
-
-If USER is nil, uses the return value of (user-login-name) instead."
-  (let ((cmd (format-spec command `((?h . ,host)
-				    (?u . ,(or user (user-login-name)))
-				    (?n . ,tramp-rsh-end-of-line))))
-        (cmd1 (format-spec command `((?h . ,host)
-				     (?u . ,(or user (user-login-name)))
-				     (?n . ""))))
-        found)
-    (erase-buffer)
-    (tramp-message 9 "Sending rlogin command `%s'" cmd1)
-    (process-send-string p cmd)
-    (tramp-process-multi-actions p method user host
-				 tramp-multi-actions)))
-
-;; HHH: Changed.  Multi method.  Don't know how to handle this in the case
-;;      of no user name provided.  Hack to make it work as it did before:
-;;      changed `user' to `(or user (user-login-name))' in the places where
-;;      the value is actually used.
-(defun tramp-multi-connect-su (p method user host command)
-  "Issue `su' command.
-Uses shell COMMAND to issue a `su' command to log in as USER on
-HOST.  The HOST name is ignored, this just changes the user id on the
-host currently logged in to.
-
-If USER is nil, uses the return value of (user-login-name) instead.
-
-You can use percent escapes in the COMMAND.  `%u' is replaced with the
-user name, and `%n' is replaced with the value of
-`tramp-rsh-end-of-line'.  Use `%%' if you want a literal percent
-character."
-  (let ((cmd (format-spec command `((?u . ,(or user (user-login-name)))
-				    (?n . ,tramp-rsh-end-of-line))))
-        (cmd1 (format-spec command `((?u . ,(or user (user-login-name)))
-				     (?n . ""))))
-        found)
-    (erase-buffer)
-    (tramp-message 9 "Sending su command `%s'" cmd1)
-    (process-send-string p cmd)
-    (tramp-process-multi-actions p method user host
-				 tramp-multi-actions)))
-
-;; Utility functions.
-
-(defun tramp-accept-process-output
-  (&optional process timeout timeout-msecs)
-  "Like `accept-process-output' for Tramp processes.
-This is needed in order to hide `last-coding-system-used', which is set
-for process communication also."
-  (let (last-coding-system-used)
-    (accept-process-output process timeout timeout-msecs)))
-
-(defun tramp-wait-for-regexp (proc timeout regexp)
-  "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
-Expects the output of PROC to be sent to the current buffer.  Returns
-the string that matched, or nil.  Waits indefinitely if TIMEOUT is
-nil."
-  (let ((found nil)
-        (start-time (current-time)))
-    (cond (timeout
-           ;; Work around a bug in XEmacs 21, where the timeout
-           ;; expires faster than it should.  This degenerates
-           ;; to polling for buggy XEmacsen, but oh, well.
-           (while (and (not found)
-                       (< (tramp-time-diff (current-time) start-time)
-                          timeout))
-             (with-timeout (timeout)
-               (while (not found)
-                 (tramp-accept-process-output proc 1)
-		 (unless (memq (process-status proc) '(run open))
-		   (error "Process has died"))
-                 (goto-char (point-min))
-                 (setq found (re-search-forward regexp nil t))))))
-          (t
-           (while (not found)
-             (tramp-accept-process-output proc 1)
-	     (unless (memq (process-status proc) '(run open))
-	       (error "Process has died"))
-             (goto-char (point-min))
-             (setq found (re-search-forward regexp nil t)))))
-    (when tramp-debug-buffer
-      (append-to-buffer
-       (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
-                             tramp-current-user tramp-current-host)
-       (point-min) (point-max))
-      (when (not found)
-        (save-excursion
-          (set-buffer
-           (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
-                             tramp-current-user tramp-current-host))
-          (goto-char (point-max))
-          (insert "[[Regexp `" regexp "' not found"
-                  (if timeout (format " in %d secs" timeout) "")
-                  "]]"))))
-    found))
-
-(defun tramp-wait-for-shell-prompt (proc timeout)
-  "Wait for the shell prompt to appear from process PROC within TIMEOUT seconds.
-See `tramp-wait-for-regexp' for more details.
-Shell prompt pattern is determined by variables `shell-prompt-pattern'
-and `tramp-shell-prompt-pattern'."
-  (tramp-wait-for-regexp
-   proc timeout
-   (format "\\(%s\\|%s\\)\\'"
-	   shell-prompt-pattern tramp-shell-prompt-pattern)))
-
-(defun tramp-barf-if-no-shell-prompt (proc timeout &rest error-args)
-  "Wait for shell prompt and barf if none appears.
-Looks at process PROC to see if a shell prompt appears in TIMEOUT
-seconds.  If not, it produces an error message with the given ERROR-ARGS."
-  (unless (tramp-wait-for-shell-prompt proc timeout)
-    (pop-to-buffer (buffer-name))
-    (apply 'error error-args)))
-
-(defun tramp-enter-password (p prompt user host)
-  "Prompt for a password and send it to the remote end.
-Uses PROMPT as a prompt and sends the password to process P."
-  (let ((pw (tramp-read-passwd user host prompt)))
-    (erase-buffer)
-    (process-send-string
-     p (concat pw
-	       (or (tramp-get-method-parameter
-		    tramp-current-multi-method
-		    tramp-current-method
-		    tramp-current-user
-		    tramp-current-host
-		    'tramp-password-end-of-line)
-		   tramp-default-password-end-of-line)))))
-
-;; HHH: Not Changed.  This might handle the case where USER is not
-;;      given in the "File name" very poorly.  Then, the local
-;;      variable tramp-current-user will be set to nil.
-(defun tramp-pre-connection (multi-method method user host chunksize)
-  "Do some setup before actually logging in.
-METHOD, USER and HOST specify the connection."
-  (set-buffer (tramp-get-buffer multi-method method user host))
-  (set (make-local-variable 'tramp-current-multi-method) multi-method)
-  (set (make-local-variable 'tramp-current-method) method)
-  (set (make-local-variable 'tramp-current-user)   user)
-  (set (make-local-variable 'tramp-current-host)   host)
-  (set (make-local-variable 'tramp-chunksize)      chunksize)
-  (set (make-local-variable 'inhibit-eol-conversion) nil)
-  (erase-buffer))
-
-(defun tramp-open-connection-setup-interactive-shell
-  (p multi-method method user host)
-  "Set up an interactive shell.
-Mainly sets the prompt and the echo correctly.  P is the shell process
-to set up.  METHOD, USER and HOST specify the connection."
-  ;; Wait a bit in case the remote end feels like sending a little
-  ;; junk first.  It seems that fencepost.gnu.org does this when doing
-  ;; a Kerberos login.
-  (sit-for 1)
-  (tramp-discard-garbage-erase-buffer p multi-method method user host)
-  (tramp-process-initial-commands p multi-method method user host
-				  tramp-initial-commands)
-  ;; It is useful to set the prompt in the following command because
-  ;; some people have a setting for $PS1 which /bin/sh doesn't know
-  ;; about and thus /bin/sh will display a strange prompt.  For
-  ;; example, if $PS1 has "${CWD}" in the value, then ksh will display
-  ;; the current working directory but /bin/sh will display a dollar
-  ;; sign.  The following command line sets $PS1 to a sane value, and
-  ;; works under Bourne-ish shells as well as csh-like shells.  Daniel
-  ;; Pittman reports that the unusual positioning of the single quotes
-  ;; makes it work under `rc', too.  We also unset the variable $ENV
-  ;; because that is read by some sh implementations (eg, bash when
-  ;; called as sh) on startup; this way, we avoid the startup file
-  ;; clobbering $PS1.
-  (tramp-send-command-internal
-   multi-method method user host
-   (format "exec env 'ENV=' 'PS1=$ ' %s"
-	   (tramp-get-method-parameter
-	    multi-method method user host 'tramp-remote-sh))
-   (format "remote `%s' to come up"
-	   (tramp-get-method-parameter
-	    multi-method method user host 'tramp-remote-sh)))
-  (tramp-barf-if-no-shell-prompt
-   p 30
-   "Remote `%s' didn't come up.  See buffer `%s' for details"
-   (tramp-get-method-parameter multi-method method user host 'tramp-remote-sh)
-   (buffer-name))
-  (tramp-message 8 "Setting up remote shell environment")
-  (tramp-discard-garbage-erase-buffer p multi-method method user host)
-  (tramp-send-command-internal multi-method method user host
-			       "stty -inlcr -echo kill '^U'")
-  (erase-buffer)
-  ;; Ignore garbage after stty command.
-  (tramp-send-command-internal multi-method method user host
-			       "echo foo")
-  (erase-buffer)
-  (tramp-send-command-internal multi-method method user host
-			       "TERM=dumb; export TERM")
-  (erase-buffer)
-  ;; Check whether the remote host suffers from buggy `send-process-string'.
-  ;; This is known for FreeBSD (see comment in `send_process', file process.c).
-  ;; I've tested sending 624 bytes successfully, sending 625 bytes failed.
-  ;; Emacs makes a hack when this host type is detected locally.  It cannot
-  ;; handle remote hosts, though.
-  (when (or (not tramp-chunksize) (zerop tramp-chunksize))
-    (tramp-message 9 "Checking remote host type for `send-process-string' bug")
-    (tramp-send-command-internal multi-method method user host
-				 "(uname -sr) 2>/dev/null")
-    (goto-char (point-min))
-    (when (looking-at "FreeBSD")
-      (setq tramp-chunksize 500)))
-
-  ;; Try to set up the coding system correctly.
-  ;; CCC this can't be the right way to do it.  Hm.
-  (save-excursion
-    (erase-buffer)
-    (tramp-message 9 "Determining coding system")
-    (tramp-send-command-internal multi-method method user host
-				 "echo foo ; echo bar")
-    (goto-char (point-min))
-    (if (featurep 'mule)
-        ;; Use MULE to select the right EOL convention for communicating
-        ;; with the process.
-        (let* ((cs (or (process-coding-system p) (cons 'undecided 'undecided)))
-               cs-decode cs-encode)
-          (when (symbolp cs) (setq cs (cons cs cs)))
-          (setq cs-decode (car cs))
-          (setq cs-encode (cdr cs))
-          (unless cs-decode (setq cs-decode 'undecided))
-          (unless cs-encode (setq cs-encode 'undecided))
-          (setq cs-encode (tramp-coding-system-change-eol-conversion
-                           cs-encode 'unix))
-          (when (search-forward "\r" nil t)
-            (setq cs-decode (tramp-coding-system-change-eol-conversion
-                             cs-decode 'dos)))
-          (set-buffer-process-coding-system cs-decode cs-encode))
-      ;; Look for ^M and do something useful if found.
-      (when (search-forward "\r" nil t)
-        ;; We have found a ^M but cannot frob the process coding system
-        ;; because we're running on a non-MULE Emacs.  Let's try
-        ;; stty, instead.
-	(erase-buffer)
-        (tramp-message 9 "Trying `stty -onlcr'")
-	(tramp-send-command-internal multi-method method user host
-				     "stty -onlcr"))))
-  (erase-buffer)
-  (tramp-message
-   9 "Waiting 30s for `HISTFILE=$HOME/.tramp_history; HISTSIZE=1; export HISTFILE; export HISTSIZE'")
-  (tramp-send-command-internal
-   multi-method method user host
-   "HISTFILE=$HOME/.tramp_history; HISTSIZE=1; export HISTFILE; export HISTSIZE")
-  (erase-buffer)
-  (tramp-message 9 "Waiting 30s for `set +o vi +o emacs'")
-  (tramp-send-command-internal multi-method method user host
-			       "set +o vi +o emacs")
-  (erase-buffer)
-  (tramp-message 9 "Waiting 30s for `unset MAIL MAILCHECK MAILPATH'")
-  (tramp-send-command-internal
-   multi-method method user host
-   "unset MAIL MAILCHECK MAILPATH 1>/dev/null 2>/dev/null")
-  (erase-buffer)
-  (tramp-message 9 "Waiting 30s for `unset CDPATH'")
-  (tramp-send-command-internal multi-method method user host
-			       "unset CDPATH")
-  (erase-buffer)
-  (tramp-message 9 "Setting shell prompt")
-  ;; Douglas Gray Stephens  says that we must
-  ;; use "\n" here, not tramp-rsh-end-of-line.  We also manually frob
-  ;; the last time we sent a command, to avoid tramp-send-command to send
-  ;; "echo are you awake".
-  (setq tramp-last-cmd-time (current-time))
-  (tramp-send-command
-   multi-method method user host
-   (format "PS1='%s%s%s'; PS2=''; PS3=''"
-	   tramp-rsh-end-of-line
-           tramp-end-of-output
-	   tramp-rsh-end-of-line))
-  (tramp-wait-for-output))
-
-(defun tramp-post-connection (multi-method method user host)
-  "Prepare a remote shell before being able to work on it.
-METHOD, USER and HOST specify the connection.
-Among other things, this finds a shell which groks tilde expansion,
-tries to find an `ls' command which groks the `-n' option, sets the
-locale to C and sets up the remote shell search path."
-  ;; Search for a good shell before searching for a command which
-  ;; checks if a file exists. This is done because Tramp wants to use
-  ;; "test foo; echo $?" to check if various conditions hold, and
-  ;; there are buggy /bin/sh implementations which don't execute the
-  ;; "echo $?"  part if the "test" part has an error.  In particular,
-  ;; the Solaris /bin/sh is a problem.  I'm betting that all systems
-  ;; with buggy /bin/sh implementations will have a working bash or
-  ;; ksh.  Whee...
-  (tramp-find-shell multi-method method user host)
-  ;; Without (sit-for 0.1) at least, my machine will almost always blow
-  ;; up on 'not numberp /root' - a race that causes the 'echo ~root'
-  ;; output of (tramp-find-shell) to show up along with the output of
-  ;; (tramp-find-ls-command) testing.
-  ;;
-  ;; I can't work out why this is a problem though. The (tramp-wait-for-output)
-  ;; call in (tramp-find-shell) *should* make this not happen, I thought.
-  ;;
-  ;; After much debugging I couldn't find any problem with the implementation
-  ;; of that function though. The workaround stays for me at least. :/
-  ;;
-  ;; Daniel Pittman 
-  (sleep-for 1)
-  (erase-buffer)
-  (tramp-find-file-exists-command multi-method method user host)
-  (make-local-variable 'tramp-ls-command)
-  (setq tramp-ls-command (tramp-find-ls-command multi-method method user host))
-  (unless tramp-ls-command
-    (tramp-message
-     1
-     "Danger!  Couldn't find ls which groks -n.  Muddling through anyway")
-    (setq tramp-ls-command
-          (tramp-find-executable multi-method method user host
-                               "ls" tramp-remote-path nil)))
-  (unless tramp-ls-command
-    (error "Fatal error: Couldn't find remote executable `ls'"))
-  (tramp-message 5 "Using remote command `%s' for getting directory listings"
-               tramp-ls-command)
-  (tramp-send-command multi-method method user host
-                    (concat "tramp_set_exit_status () {" tramp-rsh-end-of-line
-                            "return $1" tramp-rsh-end-of-line
-                            "}"))
-  (tramp-wait-for-output)
-  ;; Set remote PATH variable.
-  (tramp-set-remote-path multi-method method user host "PATH" tramp-remote-path)
-  ;; Tell remote shell to use standard time format, needed for
-  ;; parsing `ls -l' output.
-  (tramp-send-command multi-method method user host
-                    "LC_TIME=C; export LC_TIME; echo huhu")
-  (tramp-wait-for-output)
-  (tramp-send-command multi-method method user host
-                    "mesg n; echo huhu")
-  (tramp-wait-for-output)
-  (tramp-send-command multi-method method user host
-                    "biff n ; echo huhu")
-  (tramp-wait-for-output)
-  ;; Unalias ls(1) to work around issues with those silly people who make it
-  ;; spit out ANSI escapes or whatever.
-  (tramp-send-command multi-method method user host
-                    "unalias ls; echo huhu")
-  (tramp-wait-for-output)
-  ;; Does `test A -nt B' work?  Use abominable `find' construct if it
-  ;; doesn't.  BSD/OS 4.0 wants the parentheses around the command,
-  ;; for otherwise the shell crashes.
-  (erase-buffer)
-  (make-local-variable 'tramp-test-groks-nt)
-  (tramp-send-command multi-method method user host
-                    "( test / -nt / )")
-  (tramp-wait-for-output)
-  (goto-char (point-min))
-  (setq tramp-test-groks-nt
-        (looking-at (format "\n%s\r?\n" (regexp-quote tramp-end-of-output))))
-  (unless tramp-test-groks-nt
-    (tramp-send-command
-     multi-method method user host
-     (concat "tramp_test_nt () {" tramp-rsh-end-of-line
-             "test -n \"`find $1 -prune -newer $2 -print`\"" tramp-rsh-end-of-line
-             "}")))
-  (tramp-wait-for-output)
-  ;; Send the fallback `uudecode' script.
-  (erase-buffer)
-  (tramp-send-string multi-method method user host tramp-uudecode)
-  (tramp-wait-for-output)
-  ;; Find a `perl'.
-  (erase-buffer)
-  (tramp-set-connection-property "perl-scripts" nil multi-method method user host)
-  (let ((tramp-remote-perl
-	 (or (tramp-find-executable multi-method method user host
-				    "perl5" tramp-remote-path nil)
-	     (tramp-find-executable multi-method method user host
-				    "perl" tramp-remote-path nil))))
-    (when tramp-remote-perl
-      (tramp-set-connection-property "perl" tramp-remote-perl
-				     multi-method method user host)
-      (unless (tramp-method-out-of-band-p multi-method method user host)
-        (tramp-message 5 "Sending the Perl `mime-encode' implementations.")
-        (tramp-send-string
-         multi-method method user host
-         (concat "tramp_encode () {\n"
-                 (format tramp-perl-encode tramp-remote-perl)
-                 " 2>/dev/null"
-                 "\n}"))
-        (tramp-wait-for-output)
-        (tramp-send-string
-         multi-method method user host
-         (concat "tramp_encode_with_module () {\n"
-                 (format tramp-perl-encode-with-module tramp-remote-perl)
-                 " 2>/dev/null"
-                 "\n}"))
-        (tramp-wait-for-output)
-        (tramp-message 5 "Sending the Perl `mime-decode' implementations.")
-        (tramp-send-string
-         multi-method method user host
-         (concat "tramp_decode () {\n"
-                 (format tramp-perl-decode tramp-remote-perl)
-                 " 2>/dev/null"
-                 "\n}"))
-        (tramp-wait-for-output)
-        (tramp-send-string
-         multi-method method user host
-         (concat "tramp_decode_with_module () {\n"
-                 (format tramp-perl-decode-with-module tramp-remote-perl)
-                 " 2>/dev/null"
-                 "\n}"))
-        (tramp-wait-for-output))))
-  ;; Find ln(1)
-  (erase-buffer)
-  (let ((ln (tramp-find-executable multi-method method user host
-				   "ln" tramp-remote-path nil)))
-    (when ln
-      (tramp-set-connection-property "ln" ln multi-method method user host)))
-  ;; Set uid and gid.
-  (erase-buffer)
-  (tramp-send-command multi-method method user host "id -u; id -g")
-  (tramp-wait-for-output)
-  (goto-char (point-min))
-  (tramp-set-connection-property
-   "uid" (read (current-buffer)) multi-method method user host)
-  (tramp-set-connection-property
-   "gid" (read (current-buffer)) multi-method method user host)
-  ;; Find the right encoding/decoding commands to use.
-  (erase-buffer)
-  (unless (tramp-method-out-of-band-p multi-method method user host)
-    (tramp-find-inline-encoding multi-method method user host))
-  ;; If encoding/decoding command are given, test to see if they work.
-  ;; CCC: Maybe it would be useful to run the encoder both locally and
-  ;; remotely to see if they produce the same result.
-  (let ((rem-enc (tramp-get-remote-encoding multi-method method user host))
-	(rem-dec (tramp-get-remote-decoding multi-method method user host))
-	(magic-string "xyzzy"))
-    (when (and (or rem-dec rem-enc) (not (and rem-dec rem-enc)))
-      (tramp-kill-process multi-method method user host)
-      ;; Improve error message and/or error check.
-      (error
-       "Must give both decoding and encoding command in method definition"))
-    (when (and rem-enc rem-dec)
-      (tramp-message
-       5
-       "Checking to see if encoding/decoding commands work on remote host...")
-      (tramp-send-command
-       multi-method method user host
-       (format "echo %s | %s | %s"
-	       (tramp-shell-quote-argument magic-string) rem-enc rem-dec))
-      (tramp-wait-for-output)
-      (unless (looking-at (regexp-quote magic-string))
-	(tramp-kill-process multi-method method user host)
-	(error "Remote host cannot execute de/encoding commands.  See buffer `%s' for details"
-	       (buffer-name)))
-      (erase-buffer)
-      (tramp-message
-       5 "Checking to see if encoding/decoding commands work on remote host...done"))))
-
-;; CCC: We should either implement a Perl version of base64 encoding
-;; and decoding.  Then we just use that in the last item.  The other
-;; alternative is to use the Perl version of UU encoding.  But then
-;; we need a Lisp version of uuencode.
-;;
-;; Old text from documentation of tramp-methods:
-;; Using a uuencode/uudecode inline method is discouraged, please use one
-;; of the base64 methods instead since base64 encoding is much more
-;; reliable and the commands are more standardized between the different
-;; Unix versions.  But if you can't use base64 for some reason, please
-;; note that the default uudecode command does not work well for some
-;; Unices, in particular AIX and Irix.  For AIX, you might want to use
-;; the following command for uudecode:
-;;
-;;     sed '/^begin/d;/^[` ]$/d;/^end/d' | iconv -f uucode -t ISO8859-1
-;;
-;; For Irix, no solution is known yet.
-
-(defvar tramp-coding-commands
-  '(("mimencode -b" "mimencode -u -b"
-     base64-encode-region base64-decode-region)
-    ("mmencode -b" "mmencode -u -b"
-     base64-encode-region base64-decode-region)
-    ("recode data..base64" "recode base64..data"
-     base64-encode-region base64-decode-region)
-    ("uuencode xxx" "uudecode -o /dev/stdout"
-     tramp-uuencode-region uudecode-decode-region)
-    ("uuencode xxx" "uudecode -o -"
-     tramp-uuencode-region uudecode-decode-region)
-    ("uuencode xxx" "uudecode -p"
-     tramp-uuencode-region uudecode-decode-region)
-    ("uuencode xxx" "tramp_uudecode"
-     tramp-uuencode-region uudecode-decode-region)
-    ("tramp_encode_with_module" "tramp_decode_with_module"
-     base64-encode-region base64-decode-region)
-    ("tramp_encode" "tramp_decode"
-     base64-encode-region base64-decode-region))
-  "List of coding commands for inline transfer.
-Each item is a list that looks like this:
-
-\(REMOTE-ENCODING REMOTE-DECODING LOCAL-ENCODING LOCAL-DECODING)
-
-The REMOTE-ENCODING should be a string, giving a command accepting a
-plain file on standard input and writing the encoded file to standard
-output.  The REMOTE-DECODING should also be a string, giving a command
-accepting an encoded file on standard input and writing the decoded
-file to standard output.
-
-LOCAL-ENCODING and LOCAL-DECODING can be strings, giving commands, or
-symbols, giving functions.  If they are strings, then they can contain
-the \"%s\" format specifier.  If that specifier is present, the input
-filename will be put into the command line at that spot.  If the
-specifier is not present, the input should be read from standard
-input.
-
-If they are functions, they will be called with two arguments, start
-and end of region, and are expected to replace the region contents
-with the encoded or decoded results, respectively.")
-
-(defun tramp-find-inline-encoding (multi-method method user host)
-  "Find an inline transfer encoding that works.
-Goes through the list `tramp-coding-commands'."
-  (let ((commands tramp-coding-commands)
-	(magic "xyzzy")
-	item found)
-    (while (and commands (null found))
-      (setq item (pop commands))
-      (catch 'wont-work
-	(let ((rem-enc (nth 0 item))
-	      (rem-dec (nth 1 item))
-	      (loc-enc (nth 2 item))
-	      (loc-dec (nth 3 item)))
-	  ;; Check if remote encoding and decoding commands can be
-	  ;; called remotely with null input and output.  This makes
-	  ;; sure there are no syntax errors and the command is really
-	  ;; found.  Note that we do not redirect stdout to /dev/null,
-	  ;; for two reaons: when checking the decoding command, we
-	  ;; actually check the output it gives.  And also, when
-	  ;; redirecting "mimencode" output to /dev/null, then as root
-	  ;; it might change the permissions of /dev/null!
-	  (tramp-message-for-buffer
-	   multi-method method user host 9
-	   "Checking remote encoding command `%s' for sanity" rem-enc)
-	  (unless (zerop (tramp-send-command-and-check
-			  multi-method method user host
-			  (format "%s  " output) ""))))
-
-(defun tramp-maybe-open-connection (multi-method method user host)
-  "Maybe open a connection to HOST, logging in as USER, using METHOD.
-Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
-  (let ((p (get-buffer-process
-	    (tramp-get-buffer multi-method method user host)))
-	last-cmd-time)
-    ;; If too much time has passed since last command was sent, look
-    ;; whether process is still alive.  If it isn't, kill it.  When
-    ;; using ssh, it can sometimes happen that the remote end has hung
-    ;; up but the local ssh client doesn't recognize this until it
-    ;; tries to send some data to the remote end.  So that's why we
-    ;; try to send a command from time to time, then look again
-    ;; whether the process is really alive.
-    (save-excursion
-      (set-buffer (tramp-get-buffer multi-method method user host))
-      (when (and tramp-last-cmd-time
-		 (> (tramp-time-diff (current-time) tramp-last-cmd-time) 60)
-		 p (processp p) (memq (process-status p) '(run open)))
-	(tramp-send-command
-	 multi-method method user host "echo are you awake" nil t)
-	(unless (and (memq (process-status p) '(run open))
-                     (tramp-wait-for-output 10))
-	  (delete-process p)
-	  (setq p nil))
-	(erase-buffer)))
-    (unless (and p (processp p) (memq (process-status p) '(run open)))
-      (when (and p (processp p))
-        (delete-process p))
-      (let ((process-connection-type tramp-process-connection-type))
-	(funcall (tramp-get-method-parameter
-		  multi-method
-		  (tramp-find-method multi-method method user host)
-		  user host 'tramp-connection-function)
-		 multi-method method user host)))))
-
-(defun tramp-send-command
-  (multi-method method user host command &optional noerase neveropen)
-  "Send the COMMAND to USER at HOST (logged in using METHOD).
-Erases temporary buffer before sending the command (unless NOERASE
-is true).
-If optional seventh arg NEVEROPEN is non-nil, never try to open the
-connection.  This is meant to be used from
-`tramp-maybe-open-connection' only."
-  (or neveropen
-      (tramp-maybe-open-connection multi-method method user host))
-  (setq tramp-last-cmd-time (current-time))
-  (setq tramp-last-cmd command)
-  (when tramp-debug-buffer
-    (save-excursion
-      (set-buffer (tramp-get-debug-buffer multi-method method user host))
-      (goto-char (point-max))
-      (tramp-insert-with-face 'bold (format "$ %s\n" command))))
-  (let ((proc nil))
-    (set-buffer (tramp-get-buffer multi-method method user host))
-    (unless noerase (erase-buffer))
-    (setq proc (get-buffer-process (current-buffer)))
-    (process-send-string proc
-                         (concat command tramp-rsh-end-of-line))))
-
-(defun tramp-send-command-internal
-  (multi-method method user host command &optional msg)
-  "Send command to remote host and wait for success.
-Sends COMMAND, then waits 30 seconds for shell prompt."
-  (tramp-send-command multi-method method user host command t t)
-  (when msg
-    (tramp-message 9 "Waiting 30s for %s..." msg))
-  (tramp-barf-if-no-shell-prompt
-   nil 30
-   "Couldn't `%s', see buffer `%s'" command (buffer-name)))
-
-(defun tramp-wait-for-output (&optional timeout)
-  "Wait for output from remote rsh command."
-  (let ((proc (get-buffer-process (current-buffer)))
-        (found nil)
-        (start-time (current-time))
-	(start-point (point))
-        (end-of-output (concat "^"
-                               (regexp-quote tramp-end-of-output)
-                               "\r?$")))
-    ;; Algorithm: get waiting output.  See if last line contains
-    ;; end-of-output sentinel.  If not, wait a bit and again get
-    ;; waiting output.  Repeat until timeout expires or end-of-output
-    ;; sentinel is seen.  Will hang if timeout is nil and
-    ;; end-of-output sentinel never appears.
-    (save-match-data
-      (cond (timeout
-             ;; Work around an XEmacs bug, where the timeout expires
-             ;; faster than it should.  This degenerates into polling
-             ;; for buggy XEmacsen, but oh, well.
-             (while (and (not found)
-                         (< (tramp-time-diff (current-time) start-time)
-                            timeout))
-               (with-timeout (timeout)
-                 (while (not found)
-                   (tramp-accept-process-output proc 1)
-		   (unless (memq (process-status proc) '(run open))
-		     (error "Process has died"))
-                   (goto-char (point-max))
-                   (forward-line -1)
-                   (setq found (looking-at end-of-output))))))
-            (t
-             (while (not found)
-               (tramp-accept-process-output proc 1)
-	       (unless (memq (process-status proc) '(run open))
-		 (error "Process has died"))
-               (goto-char (point-max))
-               (forward-line -1)
-               (setq found (looking-at end-of-output))))))
-    ;; At this point, either the timeout has expired or we have found
-    ;; the end-of-output sentinel.
-    (when found
-      (goto-char (point-max))
-      (forward-line -2)
-      (delete-region (point) (point-max)))
-    ;; If processing echoes, look for it in the first line and delete.
-    (when tramp-process-echoes
-      (save-excursion
-	(goto-char start-point)
-	(when (looking-at (regexp-quote tramp-last-cmd))
-	  (delete-region (point) (progn (forward-line 1) (point))))))
-    ;; Add output to debug buffer if appropriate.
-    (when tramp-debug-buffer
-      (append-to-buffer
-       (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
-                             tramp-current-user tramp-current-host)
-       (point-min) (point-max))
-      (when (not found)
-        (save-excursion
-          (set-buffer
-           (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
-                                 tramp-current-user tramp-current-host))
-          (goto-char (point-max))
-          (insert "[[Remote prompt `" end-of-output "' not found"
-                  (if timeout (format " in %d secs" timeout) "")
-                  "]]"))))
-    (goto-char (point-min))
-    ;; Return value is whether end-of-output sentinel was found.
-    found))
-
-(defun tramp-send-command-and-check (multi-method method user host command
-                                                  &optional subshell)
-  "Run COMMAND and check its exit status.
-MULTI-METHOD and METHOD specify how to log in (as USER) to the remote HOST.
-Sends `echo $?' along with the COMMAND for checking the exit status.  If
-COMMAND is nil, just sends `echo $?'.  Returns the exit status found.
-
-If the optional argument SUBSHELL is non-nil, the command is executed in
-a subshell, ie surrounded by parentheses."
-  (tramp-send-command multi-method method user host
-                      (concat (if subshell "( " "")
-                              command
-                              (if command " 2>/dev/null; " "")
-                              "echo tramp_exit_status $?"
-                              (if subshell " )" " ")))
-  (tramp-wait-for-output)
-  (goto-char (point-max))
-  (unless (search-backward "tramp_exit_status " nil t)
-    (error "Couldn't find exit status of `%s'" command))
-  (skip-chars-forward "^ ")
-  (read (current-buffer)))
-
-(defun tramp-barf-unless-okay (multi-method method user host command subshell
-                                            signal fmt &rest args)
-  "Run COMMAND, check exit status, throw error if exit status not okay.
-Similar to `tramp-send-command-and-check' but accepts two more arguments
-FMT and ARGS which are passed to `error'."
-  (unless (zerop (tramp-send-command-and-check
-                  multi-method method user host command subshell))
-    ;; CCC: really pop-to-buffer?  Maybe it's appropriate to be more
-    ;; silent.
-    (pop-to-buffer (current-buffer))
-    (funcall 'signal signal (apply 'format fmt args))))
-
-;; It seems that Tru64 Unix does not like it if long strings are sent
-;; to it in one go.  (This happens when sending the Perl
-;; `file-attributes' implementation, for instance.)  Therefore, we
-;; have this function which waits a bit at each line.
-(defun tramp-send-string
-  (multi-method method user host string)
-  "Send the STRING to USER at HOST using METHOD.
-
-The STRING is expected to use Unix line-endings, but the lines sent to
-the remote host use line-endings as defined in the variable
-`tramp-rsh-end-of-line'."
-  (let ((proc (get-buffer-process
-               (tramp-get-buffer multi-method method user host))))
-    (unless proc
-      (error "Can't send string to remote host -- not logged in"))
-    ;; debug message
-    (when tramp-debug-buffer
-      (save-excursion
-	(set-buffer (tramp-get-debug-buffer multi-method method user host))
-	(goto-char (point-max))
-	(tramp-insert-with-face 'bold (format "$ %s\n" string))))
-    ;; replace "\n" by `tramp-rsh-end-of-line'
-    (setq string
-	  (mapconcat 'identity
-		     (split-string string "\n")
-		     tramp-rsh-end-of-line))
-    (unless (or (string= string "")
-		(string-equal (substring string -1) tramp-rsh-end-of-line))
-      (setq string (concat string tramp-rsh-end-of-line)))
-    ;; send the string
-    (if (and tramp-chunksize (not (zerop tramp-chunksize)))
-	(let ((pos 0)
-	      (end (length string)))
-	  (while (< pos end)
-	    (tramp-message-for-buffer
-	     multi-method method user host 10
-	     "Sending chunk from %s to %s"
-	     pos (min (+ pos tramp-chunksize) end))
-	    (process-send-string
-	     proc (substring string pos (min (+ pos tramp-chunksize) end)))
-	    (setq pos (+ pos tramp-chunksize))
-	    (sleep-for 0.1)))
-      (process-send-string proc string))))
-
-(defun tramp-send-eof (multi-method method user host)
-  "Send EOF to the remote end.
-METHOD, HOST and USER specify the connection."
-  (let ((proc (get-buffer-process
-               (tramp-get-buffer multi-method method user host))))
-    (unless proc
-      (error "Can't send EOF to remote host -- not logged in"))
-    (process-send-eof proc)))
-;    (process-send-string proc "\^D")))
-
-(defun tramp-kill-process (multi-method method user host)
-  "Kill the connection process used by Tramp.
-MULTI-METHOD, METHOD, USER, and HOST specify the connection."
-  (let ((proc (get-buffer-process
-	       (tramp-get-buffer multi-method method user host))))
-    (kill-process proc)))
-
-(defun tramp-discard-garbage-erase-buffer (p multi-method method user host)
-  "Erase buffer, then discard subsequent garbage.
-If `tramp-discard-garbage' is nil, just erase buffer."
-  (if (not tramp-discard-garbage)
-      (erase-buffer)
-    (while (prog1 (erase-buffer) (tramp-accept-process-output p 0.25))
-      (when tramp-debug-buffer
-        (save-excursion
-          (set-buffer (tramp-get-debug-buffer multi-method method user host))
-          (goto-char (point-max))
-          (tramp-insert-with-face
-           'bold (format "Additional characters detected\n")))))))
-
-(defun tramp-mode-string-to-int (mode-string)
-  "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
-  (let* ((mode-chars (string-to-vector mode-string))
-         (owner-read (aref mode-chars 1))
-         (owner-write (aref mode-chars 2))
-         (owner-execute-or-setid (aref mode-chars 3))
-         (group-read (aref mode-chars 4))
-         (group-write (aref mode-chars 5))
-         (group-execute-or-setid (aref mode-chars 6))
-         (other-read (aref mode-chars 7))
-         (other-write (aref mode-chars 8))
-         (other-execute-or-sticky (aref mode-chars 9)))
-    (save-match-data
-      (logior
-       (case owner-read
-         (?r (tramp-octal-to-decimal "00400")) (?- 0)
-         (t (error "Second char `%c' must be one of `r-'" owner-read)))
-       (case owner-write
-         (?w (tramp-octal-to-decimal "00200")) (?- 0)
-         (t (error "Third char `%c' must be one of `w-'" owner-write)))
-       (case owner-execute-or-setid
-         (?x (tramp-octal-to-decimal "00100"))
-         (?S (tramp-octal-to-decimal "04000"))
-         (?s (tramp-octal-to-decimal "04100"))
-         (?- 0)
-         (t (error "Fourth char `%c' must be one of `xsS-'"
-                   owner-execute-or-setid)))
-       (case group-read
-         (?r (tramp-octal-to-decimal "00040")) (?- 0)
-         (t (error "Fifth char `%c' must be one of `r-'" group-read)))
-       (case group-write
-         (?w (tramp-octal-to-decimal "00020")) (?- 0)
-         (t (error "Sixth char `%c' must be one of `w-'" group-write)))
-       (case group-execute-or-setid
-         (?x (tramp-octal-to-decimal "00010"))
-         (?S (tramp-octal-to-decimal "02000"))
-         (?s (tramp-octal-to-decimal "02010"))
-         (?- 0)
-         (t (error "Seventh char `%c' must be one of `xsS-'"
-                   group-execute-or-setid)))
-       (case other-read
-         (?r (tramp-octal-to-decimal "00004")) (?- 0)
-         (t (error "Eighth char `%c' must be one of `r-'" other-read)))
-       (case other-write
-         (?w (tramp-octal-to-decimal "00002")) (?- 0)
-         (t (error "Nineth char `%c' must be one of `w-'" other-write)))
-       (case other-execute-or-sticky
-         (?x (tramp-octal-to-decimal "00001"))
-         (?T (tramp-octal-to-decimal "01000"))
-         (?t (tramp-octal-to-decimal "01001"))
-         (?- 0)
-         (t (error "Tenth char `%c' must be one of `xtT-'"
-                   other-execute-or-sticky)))))))
-
-(defun tramp-convert-file-attributes (multi-method method user host attr)
-  "Convert file-attributes ATTR generated by perl script or ls.
-Convert file mode bits to string and set virtual device number.
-Return ATTR."
-  ;; Convert file mode bits to string.
-  (unless (stringp (nth 8 attr))
-    (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))))
-  ;; Set file's gid change bit.  Possible only when id-format is 'integer.
-  (when (numberp (nth 3 attr))
-    (setcar (nthcdr 9 attr)
-	    (not (= (nth 3 attr)
-		    (tramp-get-remote-gid multi-method method user host)))))
-  ;; Set virtual device number.
-  (setcar (nthcdr 11 attr)
-          (tramp-get-device multi-method method user host))
-  attr)
-
-(defun tramp-get-device (multi-method method user host)
-  "Returns the virtual device number.
-If it doesn't exist, generate a new one."
-  (let ((string (tramp-make-tramp-file-name multi-method method user host "")))
-    (unless (assoc string tramp-devices)
-      (add-to-list 'tramp-devices
-		   (list string (length tramp-devices))))
-    (list -1 (nth 1 (assoc string tramp-devices)))))
-
-(defun tramp-file-mode-from-int (mode)
-  "Turn an integer representing a file mode into an ls(1)-like string."
-  (let ((type	(cdr (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
-	(user	(logand (lsh mode -6) 7))
-	(group	(logand (lsh mode -3) 7))
-	(other	(logand (lsh mode -0) 7))
-	(suid	(> (logand (lsh mode -9) 4) 0))
-	(sgid	(> (logand (lsh mode -9) 2) 0))
-	(sticky	(> (logand (lsh mode -9) 1) 0)))
-    (setq user  (tramp-file-mode-permissions user  suid "s"))
-    (setq group (tramp-file-mode-permissions group sgid "s"))
-    (setq other (tramp-file-mode-permissions other sticky "t"))
-    (concat type user group other)))
-
-
-(defun tramp-file-mode-permissions (perm suid suid-text)
-  "Convert a permission bitset into a string.
-This is used internally by `tramp-file-mode-from-int'."
-  (let ((r (> (logand perm 4) 0))
-	(w (> (logand perm 2) 0))
-	(x (> (logand perm 1) 0)))
-    (concat (or (and r "r") "-")
-	    (or (and w "w") "-")
-	    (or (and suid x suid-text)	; suid, execute
-		(and suid (upcase suid-text)) ; suid, !execute
-		(and x "x") "-"))))	; !suid
-
-
-(defun tramp-decimal-to-octal (i)
-  "Return a string consisting of the octal digits of I.
-Not actually used.  Use `(format \"%o\" i)' instead?"
-  (cond ((< i 0) (error "Cannot convert negative number to octal"))
-        ((not (integerp i)) (error "Cannot convert non-integer to octal"))
-        ((zerop i) "0")
-        (t (concat (tramp-decimal-to-octal (/ i 8))
-                   (number-to-string (% i 8))))))
-
-
-;;(defun tramp-octal-to-decimal (ostr)
-;;  "Given a string of octal digits, return a decimal number."
-;;  (cond ((null ostr) 0)
-;;        ((string= "" ostr) 0)
-;;        (t (let ((last (aref ostr (1- (length ostr))))
-;;                 (rest (substring ostr 0 (1- (length ostr)))))
-;;             (unless (and (>= last ?0)
-;;                          (<= last ?7))
-;;               (error "Not an octal digit: %c" last))
-;;             (+ (- last ?0) (* 8 (tramp-octal-to-decimal rest)))))))
-;; Kudos to Gerd Moellmann for this suggestion.
-(defun tramp-octal-to-decimal (ostr)
-  "Given a string of octal digits, return a decimal number."
-  (let ((x (or ostr "")))
-    ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
-    (unless (string-match "\\`[0-7]*\\'" x)
-      (error "Non-octal junk in string `%s'" x))
-    (string-to-number ostr 8)))
-
-(defun tramp-shell-case-fold (string)
-  "Converts STRING to shell glob pattern which ignores case."
-  (mapconcat
-   (lambda (c)
-     (if (equal (downcase c) (upcase c))
-         (vector c)
-       (format "[%c%c]" (downcase c) (upcase c))))
-   string
-   ""))
-
-
-;; ------------------------------------------------------------
-;; -- TRAMP file names --
-;; ------------------------------------------------------------
-;; Conversion functions between external representation and
-;; internal data structure.  Convenience functions for internal
-;; data structure.
-
-(defstruct tramp-file-name multi-method method user host localname)
-
-(defun tramp-tramp-file-p (name)
-  "Return t iff NAME is a tramp file."
-  (save-match-data
-    (string-match tramp-file-name-regexp name)))
-
-;; HHH: Changed.  Used to assign the return value of (user-login-name)
-;;      to the `user' part of the structure if a user name was not
-;;      provided, now it assigns nil.
-(defun tramp-dissect-file-name (name)
-  "Return an `tramp-file-name' structure.
-The structure consists of remote method, remote user, remote host and
-localname (file name on remote host)."
-  (save-match-data
-    (let* ((match (string-match (nth 0 tramp-file-name-structure) name))
-	   (method
-	    ; single-hop
-	    (if match (match-string (nth 1 tramp-file-name-structure) name)
-	      ; maybe multi-hop
-	      (string-match
-	       (format (nth 0 tramp-multi-file-name-structure)
-		       (nth 0 tramp-multi-file-name-hop-structure)) name)
-	      (match-string (nth 1 tramp-multi-file-name-structure) name))))
-      (if (and method (member method tramp-multi-methods))
-          ;; If it's a multi method, the file name structure contains
-          ;; arrays of method, user and host.
-          (tramp-dissect-multi-file-name name)
-        ;; Normal method.  First, find out default method.
-	(unless match (error "Not a tramp file name: %s" name))
-	(let ((user (match-string (nth 2 tramp-file-name-structure) name))
-	      (host (match-string (nth 3 tramp-file-name-structure) name))
-	      (localname (match-string (nth 4 tramp-file-name-structure) name)))
-	  (make-tramp-file-name
-	   :multi-method nil
-	   :method method
-	   :user (or user nil)
-	   :host host
-	   :localname localname))))))
-
-(defun tramp-find-default-method (user host)
-  "Look up the right method to use in `tramp-default-method-alist'."
-  (let ((choices tramp-default-method-alist)
-	(method tramp-default-method)
-	item)
-    (while choices
-      (setq item (pop choices))
-      (when (and (string-match (nth 0 item) (or host ""))
-		 (string-match (nth 1 item) (or user "")))
-	(setq method (nth 2 item))
-	(setq choices nil)))
-    method))
-
-(defun tramp-find-method (multi-method method user host)
-  "Return the right method string to use.
-This is MULTI-METHOD, if non-nil.  Otherwise, it is METHOD, if non-nil.
-If both MULTI-METHOD and METHOD are nil, do a lookup in
-`tramp-default-method-alist'."
-  (or multi-method method (tramp-find-default-method user host)))
-
-;; HHH: Not Changed.  Multi method.  Will probably not handle the case where
-;;      a user name is not provided in the "file name" very well.
-(defun tramp-dissect-multi-file-name (name)
-  "Not implemented yet."
-  (let ((regexp           (nth 0 tramp-multi-file-name-structure))
-        (method-index     (nth 1 tramp-multi-file-name-structure))
-        (hops-index       (nth 2 tramp-multi-file-name-structure))
-        (localname-index       (nth 3 tramp-multi-file-name-structure))
-        (hop-regexp       (nth 0 tramp-multi-file-name-hop-structure))
-        (hop-method-index (nth 1 tramp-multi-file-name-hop-structure))
-        (hop-user-index   (nth 2 tramp-multi-file-name-hop-structure))
-        (hop-host-index   (nth 3 tramp-multi-file-name-hop-structure))
-        method hops len hop-methods hop-users hop-hosts localname)
-    (unless (string-match (format regexp hop-regexp) name)
-      (error "Not a multi tramp file name: %s" name))
-    (setq method (match-string method-index name))
-    (setq hops (match-string hops-index name))
-    (setq len (/ (length (match-data t)) 2))
-    (when (< localname-index 0) (incf localname-index len))
-    (setq localname (match-string localname-index name))
-    (let ((index 0))
-      (while (string-match hop-regexp hops index)
-        (setq index (match-end 0))
-        (setq hop-methods
-              (cons (match-string hop-method-index hops) hop-methods))
-        (setq hop-users
-              (cons (match-string hop-user-index hops) hop-users))
-        (setq hop-hosts
-              (cons (match-string hop-host-index hops) hop-hosts))))
-    (make-tramp-file-name
-     :multi-method method
-     :method       (apply 'vector (reverse hop-methods))
-     :user         (apply 'vector (reverse hop-users))
-     :host         (apply 'vector (reverse hop-hosts))
-     :localname         localname)))
-
-(defun tramp-make-tramp-file-name (multi-method method user host localname)
-  "Constructs a tramp file name from METHOD, USER, HOST and LOCALNAME."
-  (if multi-method
-      (tramp-make-tramp-multi-file-name multi-method method user host localname)
-    (format-spec
-     (concat tramp-prefix-format
-      (when method (concat "%m" tramp-postfix-single-method-format))
-      (when user   (concat "%u" tramp-postfix-user-format))
-      (when host   (concat "%h" tramp-postfix-host-format))
-      (when localname   (concat "%p")))
-    `((?m . ,method) (?u . ,user) (?h . ,host) (?p . ,localname)))))
-
-;; CCC: Henrik Holm: Not Changed.  Multi Method.  What should be done
-;; with this when USER is nil?
-(defun tramp-make-tramp-multi-file-name (multi-method method user host localname)
-  "Constructs a tramp file name for a multi-hop method."
-  (unless tramp-make-multi-tramp-file-format
-    (error "`tramp-make-multi-tramp-file-format' is nil"))
-  (let* ((prefix-format (nth 0 tramp-make-multi-tramp-file-format))
-         (hop-format    (nth 1 tramp-make-multi-tramp-file-format))
-         (localname-format   (nth 2 tramp-make-multi-tramp-file-format))
-         (prefix (format-spec prefix-format `((?m . ,multi-method))))
-         (hops "")
-         (localname (format-spec localname-format `((?p . ,localname))))
-         (i 0)
-         (len (length method)))
-    (while (< i len)
-      (let ((m (aref method i)) (u (aref user i)) (h (aref host i)))
-        (setq hops (concat hops (format-spec hop-format
-					     `((?m . ,m) (?u . ,u) (?h . ,h)))))
-        (incf i)))
-    (concat prefix hops localname)))
-
-(defun tramp-make-copy-program-file-name (user host localname)
-  "Create a file name suitable to be passed to `rcp' and workalikes."
-  (if user
-      (format "%s@%s:%s" user host localname)
-    (format "%s:%s" host localname)))
-
-(defun tramp-method-out-of-band-p (multi-method method user host)
-  "Return t if this is an out-of-band method, nil otherwise."
-  (tramp-get-method-parameter
-   multi-method
-   (tramp-find-method multi-method method user host)
-   user host 'tramp-copy-program))
-
-;; Variables local to connection.
-
-(defun tramp-get-ls-command (multi-method method user host)
-  (save-excursion
-    (tramp-maybe-open-connection multi-method method user host)
-    (set-buffer (tramp-get-buffer multi-method method user host))
-    tramp-ls-command))
-
-(defun tramp-get-test-groks-nt (multi-method method user host)
-  (save-excursion
-    (tramp-maybe-open-connection multi-method method user host)
-    (set-buffer (tramp-get-buffer multi-method method user host))
-    tramp-test-groks-nt))
-
-(defun tramp-get-file-exists-command (multi-method method user host)
-  (save-excursion
-    (tramp-maybe-open-connection multi-method method user host)
-    (set-buffer (tramp-get-buffer multi-method method user host))
-    tramp-file-exists-command))
-
-(defun tramp-get-remote-perl (multi-method method user host)
-  (tramp-get-connection-property "perl" nil multi-method method user host))
-
-(defun tramp-get-remote-ln (multi-method method user host)
-  (tramp-get-connection-property "ln" nil multi-method method user host))
-
-(defun tramp-get-remote-uid (multi-method method user host)
-  (tramp-get-connection-property "uid" nil multi-method method user host))
-
-(defun tramp-get-remote-gid (multi-method method user host)
-  (tramp-get-connection-property "gid" nil multi-method method user host))
-
-;; Get a property of a TRAMP connection.
-(defun tramp-get-connection-property
-  (property default multi-method method user host)
-  "Get the named property for the connection.
-If the value is not set for the connection, return `default'"
-  (tramp-maybe-open-connection multi-method method user host)
-  (with-current-buffer (tramp-get-buffer multi-method method user host)
-    (let (error)
-      (condition-case nil
-	  (symbol-value (intern (concat "tramp-connection-property-" property)))
-	(error default)))))
-
-;; Set a property of a TRAMP connection.
-(defun tramp-set-connection-property
-  (property value multi-method method user host)
-  "Set the named property of a TRAMP connection."
-  (tramp-maybe-open-connection multi-method method user host)
-  (with-current-buffer (tramp-get-buffer multi-method method user host)
-    (set (make-local-variable
-	  (intern (concat "tramp-connection-property-" property)))
-	  value)))
-
-;; Some predefined connection properties.
-(defun tramp-set-remote-encoding (multi-method method user host rem-enc)
-  (tramp-set-connection-property "remote-encoding" rem-enc
-				 multi-method method user host))
-(defun tramp-get-remote-encoding (multi-method method user host)
-  (tramp-get-connection-property "remote-encoding" nil
-				 multi-method method user host))
-
-(defun tramp-set-remote-decoding (multi-method method user host rem-dec)
-  (tramp-set-connection-property "remote-decoding" rem-dec
-				 multi-method method user host))
-(defun tramp-get-remote-decoding (multi-method method user host)
-  (tramp-get-connection-property "remote-decoding" nil
-				 multi-method method user host))
-
-(defun tramp-set-local-encoding (multi-method method user host loc-enc)
-  (tramp-set-connection-property "local-encoding" loc-enc
-				 multi-method method user host))
-(defun tramp-get-local-encoding (multi-method method user host)
-  (tramp-get-connection-property "local-encoding" nil
-				 multi-method method user host))
-
-(defun tramp-set-local-decoding (multi-method method user host loc-dec)
-  (tramp-set-connection-property "local-decoding" loc-dec
-				 multi-method method user host))
-(defun tramp-get-local-decoding (multi-method method user host)
-  (tramp-get-connection-property "local-decoding" nil
-				 multi-method method user host))
-
-(defun tramp-get-method-parameter (multi-method method user host param)
-  "Return the method parameter PARAM.
-If the `tramp-methods' entry does not exist, use the variable PARAM
-as default."
-  (unless (boundp param)
-    (error "Non-existing method parameter `%s'" param))
-  (let ((entry (assoc param
-		      (assoc (tramp-find-method multi-method method user host)
-			     tramp-methods))))
-    (if entry
-	(second entry)
-      (symbol-value param))))
-
-
-;; Auto saving to a special directory.
-
-(defun tramp-exists-file-name-handler (operation &rest args)
-  (let ((buffer-file-name "/")
-	(fnha file-name-handler-alist)
-	(check-file-name-operation operation)
-	(file-name-handler-alist
-	 (list
-	  (cons "/"
-		'(lambda (operation &rest args)
-		   "Returns OPERATION if it is the one to be checked"
-		   (if (equal check-file-name-operation operation)
-		       operation
-		     (let ((file-name-handler-alist fnha))
-		       (apply operation args))))))))
-    (eq (apply operation args) operation)))
-
-(unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
-  (defadvice make-auto-save-file-name
-    (around tramp-advice-make-auto-save-file-name () activate)
-    "Invoke `tramp-handle-make-auto-save-file-name' for tramp files."
-    (if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)))
-	(setq ad-return-value (tramp-handle-make-auto-save-file-name))
-      ad-do-it))
-  (add-hook 'tramp-unload-hook
-	    '(lambda () (ad-unadvise 'make-auto-save-file-name))))
-
-;; In Emacs < 22 and XEmacs < 21.5 autosaved remote files have
-;; permission 0666 minus umask. This is a security threat.
-
-(defun tramp-set-auto-save-file-modes ()
-  "Set permissions of autosaved remote files to the original permissions."
-  (let ((bfn (buffer-file-name)))
-    (when (and (stringp bfn)
-	       (tramp-tramp-file-p bfn)
-	       (stringp buffer-auto-save-file-name)
-	       (not (equal bfn buffer-auto-save-file-name)))
-      (unless (file-exists-p buffer-auto-save-file-name)
-	(write-region "" nil buffer-auto-save-file-name))
-      ;; Permissions should be set always, because there might be an old
-      ;; auto-saved file belonging to another original file.  This could
-      ;; be a security threat.
-      (set-file-modes buffer-auto-save-file-name
-		      (or (file-modes bfn) (tramp-octal-to-decimal "0600"))))))
-
-(unless (or (> emacs-major-version 21)
-	    (and (featurep 'xemacs)
-		 (= emacs-major-version 21)
-		 (> emacs-minor-version 4)))
-  (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)
-  (add-hook 'tramp-unload-hook
-	    '(lambda ()
-	       (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))))
-
-(defun tramp-subst-strs-in-string (alist string)
-  "Replace all occurrences of the string FROM with TO in STRING.
-ALIST is of the form ((FROM . TO) ...)."
-  (save-match-data
-    (while alist
-      (let* ((pr (car alist))
-             (from (car pr))
-             (to (cdr pr)))
-        (while (string-match (regexp-quote from) string)
-          (setq string (replace-match to t t string)))
-        (setq alist (cdr alist))))
-    string))
-
-(defun tramp-insert-with-face (face string)
-  "Insert text with a specific face."
-  (let ((start (point)))
-    (insert string)
-    (add-text-properties start (point) (list 'face face))))
-
-;; ------------------------------------------------------------
-;; -- Compatibility functions section --
-;; ------------------------------------------------------------
-
-(defun tramp-temporary-file-directory ()
-  "Return name of directory for temporary files (compat function).
-For Emacs, this is the variable `temporary-file-directory', for XEmacs
-this is the function `temp-directory'."
-  (cond ((boundp 'temporary-file-directory)
-         (symbol-value 'temporary-file-directory))
-        ((fboundp 'temp-directory)
-         (funcall (symbol-function 'temp-directory))) ;pacify byte-compiler
-        ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
-         (file-name-as-directory (getenv "TEMP")))
-        ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
-         (file-name-as-directory (getenv "TMP")))
-        ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
-         (file-name-as-directory (getenv "TMPDIR")))
-        ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
-        (t (message (concat "Neither `temporary-file-directory' nor "
-                            "`temp-directory' is defined -- using /tmp."))
-           (file-name-as-directory "/tmp"))))
-
-(defun tramp-read-passwd (user host prompt)
-  "Read a password from user (compat function).
-Invokes `password-read' if available, `read-passwd' else."
-  (if (functionp 'password-read)
-      (let* ((key (concat (or user (user-login-name)) "@" host))
-	     (password (apply #'password-read (list prompt key))))
-	(apply #'password-cache-add (list key password))
-	password)
-    (read-passwd prompt)))
-
-(defun tramp-clear-passwd (&optional user host)
-  "Clear password cache for connection related to current-buffer."
-  (interactive)
-  (let ((filename (or buffer-file-name list-buffers-directory "")))
-    (when (and (functionp 'password-cache-remove)
-	       (or (and user host) (tramp-tramp-file-p filename)))
-      (let* ((v (when (tramp-tramp-file-p filename)
-		  (tramp-dissect-file-name filename)))
-	     (luser (or user (tramp-file-name-user v) (user-login-name)))
-	     (lhost (or host (tramp-file-name-host v) (system-name)))
-	     (key (concat luser "@" lhost)))
-	(apply #'password-cache-remove (list key))))))
-
-(defun tramp-time-diff (t1 t2)
-  "Return the difference between the two times, in seconds.
-T1 and T2 are time values (as returned by `current-time' for example).
-
-NOTE: This function will fail if the time difference is too large to
-fit in an integer."
-  ;; Pacify byte-compiler with `symbol-function'.
-  (cond ((and (fboundp 'subtract-time)
-	      (fboundp 'float-time))
-         (funcall (symbol-function 'float-time)
-		  (funcall (symbol-function 'subtract-time) t1 t2)))
-	((and (fboundp 'subtract-time)
-	      (fboundp 'time-to-seconds))
-         (funcall (symbol-function 'time-to-seconds)
-		  (funcall (symbol-function 'subtract-time) t1 t2)))
-        ((fboundp 'itimer-time-difference)
-         (floor (funcall
-		 (symbol-function 'itimer-time-difference)
-		 (if (< (length t1) 3) (append t1 '(0)) t1)
-		 (if (< (length t2) 3) (append t2 '(0)) t2))))
-        (t
-         ;; snarfed from Emacs 21 time-date.el; combining
-	 ;; time-to-seconds and subtract-time
-	 (let ((time  (let ((borrow (< (cadr t1) (cadr t2))))
-                 (list (- (car t1) (car t2) (if borrow 1 0))
-                       (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))))
-	   (+ (* (car time) 65536.0)
-	      (cadr time)
-	      (/ (or (nth 2 time) 0) 1000000.0))))))
-
-(defun tramp-coding-system-change-eol-conversion (coding-system eol-type)
-  "Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
-EOL-TYPE can be one of `dos', `unix', or `mac'."
-  (cond ((fboundp 'coding-system-change-eol-conversion)
-         (apply #'coding-system-change-eol-conversion
-                (list coding-system eol-type)))
-        ((fboundp 'subsidiary-coding-system)
-         (apply
-          #'subsidiary-coding-system
-          (list coding-system
-                (cond ((eq eol-type 'dos) 'crlf)
-                      ((eq eol-type 'unix) 'lf)
-                      ((eq eol-type 'mac) 'cr)
-                      (t
-                       (error "Unknown EOL-TYPE `%s', must be %s"
-                              eol-type
-                              "`dos', `unix', or `mac'"))))))
-        (t (error "Can't change EOL conversion -- is MULE missing?"))))
-
-(defun tramp-split-string (string pattern)
-  "Like `split-string' but omit empty strings.
-In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
-This is, the first, empty, element is omitted.  In XEmacs, the first
-element is not omitted.
-
-Note: this function has been written for `tramp-handle-file-truename'.
-If you want to use it for something else, you'll have to check whether
-it does the right thing."
-  (delete "" (split-string string pattern)))
-
-(defun tramp-set-process-query-on-exit-flag (process flag)
-  "Specify if query is needed for process when Emacs is exited.
-If the second argument flag is non-nil, Emacs will query the user before
-exiting if process is running."
- (funcall
-  (if (fboundp 'set-process-query-on-exit-flag)
-      (symbol-function 'set-process-query-on-exit-flag)
-    (symbol-function 'process-kill-without-query))
-  process flag))
-
-
-;; ------------------------------------------------------------
-;; -- Kludges section --
-;; ------------------------------------------------------------
-
-;; Currently (as of Emacs 20.5), the function `shell-quote-argument'
-;; does not deal well with newline characters.  Newline is replaced by
-;; backslash newline.  But if, say, the string `a backslash newline b'
-;; is passed to a shell, the shell will expand this into "ab",
-;; completely omitting the newline.  This is not what was intended.
-;; It does not appear to be possible to make the function
-;; `shell-quote-argument' work with newlines without making it
-;; dependent on the shell used.  But within this package, we know that
-;; we will always use a Bourne-like shell, so we use an approach which
-;; groks newlines.
-;;
-;; The approach is simple: we call `shell-quote-argument', then
-;; massage the newline part of the result.
-;;
-;; This function should produce a string which is grokked by a Unix
-;; shell, even if the Emacs is running on Windows.  Since this is the
-;; kludges section, we bind `system-type' in such a way that
-;; `shell-quote-arguments'  behaves as if on Unix.
-;;
-;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
-;; function to work with Bourne-like shells.
-;;
-;; CCC: This function should be rewritten so that
-;; `shell-quote-argument' is not used.  This way, we are safe from
-;; changes in `shell-quote-argument'.
-(defun tramp-shell-quote-argument (s)
-  "Similar to `shell-quote-argument', but groks newlines.
-Only works for Bourne-like shells."
-  (let ((system-type 'not-windows))
-    (save-match-data
-      (let ((result (shell-quote-argument s))
-	    (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
-	(when (and (>= (length result) 2)
-		   (string= (substring result 0 2) "\\~"))
-	  (setq result (substring result 1)))
-	(while (string-match nl result)
-	  (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
-				      t t result)))
-	result))))
-
-;; ;; EFS hooks itself into the file name handling stuff in more places
-;; ;; than just `file-name-handler-alist'. The following tells EFS to stay
-;; ;; away from tramp.el file names.
-;; ;;
-;; ;; This is needed because EFS installs (efs-dired-before-readin) into
-;; ;; 'dired-before-readin-hook'. This prevents EFS from opening an FTP
-;; ;; connection to help it's dired process. Not that I have any real
-;; ;; idea *why* this is helpful to dired.
-;; ;;
-;; ;; Anyway, this advice fixes the problem (with a sledgehammer :)
-;; ;;
-;; ;; Daniel Pittman 
-;; ;;
-;; ;; CCC: when the other defadvice calls have disappeared, make sure
-;; ;; not to call defadvice unless it's necessary.  How do we find out whether
-;; ;; it is necessary?  (featurep 'efs) is surely the wrong way --
-;; ;; EFS might nicht be loaded yet.
-;; (defadvice efs-ftp-path (around dont-match-tramp-localname activate protect)
-;;   "Cause efs-ftp-path to fail when the path is a TRAMP localname."
-;;   (if (tramp-tramp-file-p (ad-get-arg 0))
-;;       nil
-;;     ad-do-it))
-
-;; We currently (sometimes) use "[" and "]" in the filename format.
-;; This means that Emacs wants to expand wildcards if
-;; `find-file-wildcards' is non-nil, and then barfs because no
-;; expansion could be found.  We detect this situation and do
-;; something really awful: we have `file-expand-wildcards' return the
-;; original filename if it can't expand anything.  Let's just hope
-;; that this doesn't break anything else.
-;; CCC: This check is now also really awful; we should search all
-;; of the filename format, not just the prefix.
-(when (string-match "\\[" tramp-prefix-format)
-  (defadvice file-expand-wildcards (around tramp-fix activate)
-    (let ((name (ad-get-arg 0)))
-      (if (tramp-tramp-file-p name)
-	  ;; If it's a Tramp file, dissect it and look if wildcards
-	  ;; need to be expanded at all.
-	  (let ((v (tramp-dissect-file-name name)))
-	    (if (string-match "[[*?]" (tramp-file-name-localname v))
-		(let ((res ad-do-it))
-		  (setq ad-return-value (or res (list name))))
-	      (setq ad-return-value (list name))))
-	;; If it is not a Tramp file, just run the original function.
-	(let ((res ad-do-it))
-	  (setq ad-return-value (or res (list name)))))))
-  (add-hook 'tramp-unload-hook
-	    '(lambda () (ad-unadvise 'file-expand-wildcards))))
-
-;; Tramp version is useful in a number of situations.
-
-(defun tramp-version (arg)
-  "Print version number of tramp.el in minibuffer or current buffer."
-  (interactive "P")
-  (if arg (insert tramp-version) (message tramp-version)))
-
-;; Make the `reporter` functionality available for making bug reports about
-;; the package. A most useful piece of code.
-
-(unless (fboundp 'reporter-submit-bug-report)
-  (autoload 'reporter-submit-bug-report "reporter"))
-
-(defun tramp-bug ()
-  "Submit a bug report to the TRAMP developers."
-  (interactive)
-  (require 'reporter)
-  (catch 'dont-send
-    (let ((reporter-prompt-for-summary-p t))
-      (reporter-submit-bug-report
-       tramp-bug-report-address		; to-address
-       (format "tramp (%s)" tramp-version) ; package name and version
-       (delq nil
-	     `(;; Current state
-	       tramp-ls-command
-	       tramp-test-groks-nt
-	       tramp-file-exists-command
-	       tramp-current-multi-method
-	       tramp-current-method
-	       tramp-current-user
-	       tramp-current-host
-
-	       ;; System defaults
-	       tramp-auto-save-directory        ; vars to dump
-	       tramp-default-method
-	       tramp-rsh-end-of-line
-	       tramp-default-password-end-of-line
-	       tramp-remote-path
-	       tramp-login-prompt-regexp
-	       ;; Mask non-7bit characters
-	       (tramp-password-prompt-regexp . tramp-reporter-dump-variable)
-	       tramp-wrong-passwd-regexp
-	       tramp-yesno-prompt-regexp
-	       tramp-yn-prompt-regexp
-	       tramp-terminal-prompt-regexp
-	       tramp-temp-name-prefix
-	       tramp-file-name-structure
-	       tramp-file-name-regexp
-	       tramp-multi-file-name-structure
-	       tramp-multi-file-name-hop-structure
-	       tramp-multi-methods
-	       tramp-multi-connection-function-alist
-	       tramp-methods
-	       tramp-end-of-output
-	       tramp-coding-commands
-	       tramp-actions-before-shell
-	       tramp-actions-copy-out-of-band
-	       tramp-multi-actions
-	       tramp-terminal-type
-	       ;; Mask non-7bit characters
-	       (tramp-shell-prompt-pattern . tramp-reporter-dump-variable)
-	       tramp-chunksize
-	       ,(when (boundp 'tramp-backup-directory-alist)
-		  'tramp-backup-directory-alist)
-	       ,(when (boundp 'tramp-bkup-backup-directory-info)
-		  'tramp-bkup-backup-directory-info)
-
-	       ;; Non-tramp variables of interest
-	       ;; Mask non-7bit characters
-	       (shell-prompt-pattern . tramp-reporter-dump-variable)
-	       backup-by-copying
-	       backup-by-copying-when-linked
-	       backup-by-copying-when-mismatch
-	       ,(when (boundp 'backup-by-copying-when-privileged-mismatch)
-		  'backup-by-copying-when-privileged-mismatch)
-	       ,(when (boundp 'password-cache)
-		  'password-cache)
-	       ,(when (boundp 'password-cache-expiry)
-		  'password-cache-expiry)
-	       ,(when (boundp 'backup-directory-alist)
-		  'backup-directory-alist)
-	       ,(when (boundp 'bkup-backup-directory-info)
-		  'bkup-backup-directory-info)
-	       file-name-handler-alist))
-
-       'tramp-load-report-modules	; pre-hook
-       'tramp-append-tramp-buffers	; post-hook
-       "\
-Enter your bug report in this message, including as much detail as you
-possibly can about the problem, what you did to cause it and what the
-local and remote machines are.
-
-If you can give a simple set of instructions to make this bug happen
-reliably, please include those.  Thank you for helping kill bugs in
-TRAMP.
-
-Another useful thing to do is to put (setq tramp-debug-buffer t) in
-the ~/.emacs file and to repeat the bug.  Then, include the contents
-of the *tramp/foo* buffer and the *debug tramp/foo* buffer in your bug
-report.
-
---bug report follows this line--
-"))))
-
-(defun tramp-reporter-dump-variable (varsym mailbuf)
-  "Pretty-print the value of the variable in symbol VARSYM.
-Used for non-7bit chars in strings."
-  (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
-	 (val (with-current-buffer reporter-eval-buffer
-		(symbol-value varsym))))
-
-    ;; There are characters to be masked.
-    (when (and (boundp 'mm-7bit-chars)
-	       (string-match
-		(concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
-      (with-current-buffer reporter-eval-buffer
-	(set varsym (concat "(base64-decode-string \""
-			    (base64-encode-string val)
-			    "\")"))))
-
-    ;; Dump variable.
-    (funcall (symbol-function 'reporter-dump-variable) varsym mailbuf)
-
-    ;; Remove string quotation.
-    (forward-line -1)
-    (when (looking-at
-	   (concat "\\(^.*\\)" "\""                       ;; \1 "
-		   "\\((base64-decode-string \\)" "\\\\"  ;; \2 \
-		   "\\(\".*\\)" "\\\\"                    ;; \3 \
-		   "\\(\")\\)" "\"$"))                    ;; \4 "
-      (replace-match "\\1\\2\\3\\4")
-      (beginning-of-line)
-      (insert " ;; variable encoded due to non-printable characters\n"))
-    (forward-line 1)
-
-    ;; Reset VARSYM to old value.
-    (with-current-buffer reporter-eval-buffer
-      (set varsym val))))
-
-(defun tramp-load-report-modules ()
-  "Load needed modules for reporting."
-
-  ;; We load message.el and mml.el from Gnus.
-  (if (featurep 'xemacs)
-      (progn
-	(load "message" 'noerror)
-	(load "mml" 'noerror))
-    (require 'message nil 'noerror)
-    (require 'mml nil 'noerror))
-  (when (functionp 'message-mode)
-    (funcall (symbol-function 'message-mode)))
-  (when (functionp 'mml-mode)
-    (funcall (symbol-function 'mml-mode) t)))
-
-(defun tramp-append-tramp-buffers ()
-  "Append Tramp buffers into the bug report."
-
-  (when (and
-	 (eq major-mode 'message-mode)
-	 (boundp 'mml-mode)
-	 (symbol-value 'mml-mode))
-
-    (let* ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
-	   (buffer-list
-	    (delq nil
-		  (mapcar '(lambda (b)
-		     (when (string-match tramp-buf-regexp (buffer-name b)) b))
-			  (buffer-list))))
-	   (curbuf (current-buffer)))
-
-      ;; There is at least one Tramp buffer.
-      (when buffer-list
-	(switch-to-buffer (list-buffers-noselect nil))
-	(delete-other-windows)
-	(setq buffer-read-only nil)
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (if (re-search-forward tramp-buf-regexp (tramp-point-at-eol) t)
-	      (forward-line 1)
-	    (forward-line 0)
-	    (let ((start (point)))
-	      (forward-line 1)
-	      (kill-region start (point)))))
-	(insert "
-The buffer(s) above will be appended to this message.  If you don't want
-to append a buffer because it contains sensible data, or because the buffer
-is too large, you should delete the respective buffer.  The buffer(s) will
-contain user and host names.  Passwords will never be included there.")
-
-	(when (and tramp-debug-buffer (> tramp-verbose 9))
-	  (insert "\n\n")
-	  (let ((start (point)))
-	    (insert "\
-Please note that you have set `tramp-verbose' to a value greater than 9.
-Therefore, the contents of files might be included in the debug buffer(s).")
-	    (add-text-properties start (point) (list 'face 'italic))))
-
-	(set-buffer-modified-p nil)
-	(setq buffer-read-only t)
-	(goto-char (point-min))
-
-	(if (y-or-n-p "Do you want to append the buffer(s)? ")
-	    ;; OK, let's send.  First we delete the buffer list.
-	    (progn
-	      (kill-buffer nil)
-	      (switch-to-buffer curbuf)
-	      (goto-char (point-max))
-	      (insert "\n\n")
-	      (dolist (buffer buffer-list)
-		(funcall (symbol-function 'mml-insert-empty-tag)
-			 'part 'type "text/plain" 'encoding "base64"
-			 'disposition "attachment" 'buffer (buffer-name buffer)
-			 'description (buffer-name buffer)))
-	      (set-buffer-modified-p nil))
-
-	  ;; Don't send.  Delete the message buffer.
-	  (set-buffer curbuf)
-	  (set-buffer-modified-p nil)
-	  (kill-buffer nil)
-	  (throw 'dont-send nil))))))
-
-(defalias 'tramp-submit-bug 'tramp-bug)
-
-;; Checklist for `tramp-unload-hook'
-;; - Unload all `tramp-*' packages
-;; - Reset `file-name-handler-alist'
-;; - Cleanup hooks where Tramp functions are in
-;; - Cleanup advised functions
-;; - Cleanup autoloads
-;;;###autoload
-(defun tramp-unload-tramp ()
-  (interactive)
-  ;; When Tramp is not loaded yet, its autoloads are still active.
-  (tramp-unload-file-name-handler-alist)
-  ;; ange-ftp settings must be enabled.
-  (when (functionp 'tramp-ftp-enable-ange-ftp)
-    (funcall (symbol-function 'tramp-ftp-enable-ange-ftp)))
-  ;; `tramp-util' unloads also `tramp'.
-  (condition-case nil ;; maybe its not loaded yet.
-      (unload-feature (if (featurep 'tramp-util) 'tramp-util 'tramp) 'force)
-    (error nil)))
-
-(provide 'tramp)
-
-;; Make sure that we get integration with the VC package.
-;; When it is loaded, we need to pull in the integration module.
-;; This must come after (provide 'tramp) because tramp-vc.el
-;; requires tramp.
-(eval-after-load "vc"
-  '(progn
-     (require 'tramp-vc)
-     (add-hook 'tramp-unload-hook
-	       '(lambda ()
-		  (when (featurep 'tramp-vc)
-		    (unload-feature 'tramp-vc 'force))))))
-
-;;; TODO:
-
-;; * Allow putting passwords in the filename.
-;;   This should be implemented via a general mechanism to add
-;;   parameters in filenames.  There is currently a kludge for
-;;   putting the port number into the filename for ssh and ftp
-;;   files.  This could be subsumed by the new mechanism as well.
-;;   Another approach is to read a netrc file like ~/.authinfo
-;;   from Gnus.
-;; * Handle nonlocal exits such as C-g.
-;; * Autodetect if remote `ls' groks the "--dired" switch.
-;; * Add fallback for inline encodings.  This should be used
-;;   if the remote end doesn't support mimencode or a similar program.
-;;   For reading files from the remote host, we can just parse the output
-;;   of `od -b'.  For writing files to the remote host, we construct
-;;   a shell program which contains only "safe" ascii characters
-;;   and which writes the right bytes to the file.  We can use printf(1)
-;;   or "echo -e" or the printf function in awk and use octal escapes
-;;   for the "dangerous" characters.  The null byte might be a problem.
-;;   On some systems, the octal escape doesn't work.  So we try the following
-;;   two commands to write a null byte:
-;;   dd if=/dev/zero bs=1 count=1
-;;   echo | tr '\n' '\000'
-;; * Separate local `tramp-coding-commands' from remote ones.  Connect
-;;   the two via a format which can be `uu' or `b64'.  Then we can search
-;;   for the right local commands and the right remote commands separately.
-;; * Cooperate with PCL-CVS.  It uses start-process, which doesn't
-;;   work for remote files.
-;; * Rewrite `tramp-shell-quote-argument' to abstain from using
-;;   `shell-quote-argument'.
-;; * Completion gets confused when you leave out the method name.
-;; * In Emacs 21, `insert-directory' shows total number of bytes used
-;;   by the files in that directory.  Add this here.
-;; * Avoid screen blanking when hitting `g' in dired.  (Eli Tziperman)
-;; * Make ffap.el grok Tramp filenames.  (Eli Tziperman)
-;; * When logging in, keep looking for questions according to an alist
-;;   and then invoke the right function.
-;; * Case-insensitive filename completion.  (Norbert Goevert.)
-;; * Running CVS remotely doesn't appear to work right.  It thinks
-;;   files are locked by somebody else even if I'm the locking user.
-;;   Sometimes, one gets `No CVSROOT specified' errors from CVS.
-;;   (Skip Montanaro)
-;; * Don't use globbing for directories with many files, as this is
-;;   likely to produce long command lines, and some shells choke on
-;;   long command lines.
-;; * Find out about the new auto-save mechanism in Emacs 21 and
-;;   do the right thing.
-;; * `vc-directory' does not work.  It never displays any files, even
-;;   if it does show files when run locally.
-;; * Allow correction of passwords, if the remote end allows this.
-;;   (Mark Hershberger)
-;; * How to deal with MULE in `insert-file-contents' and `write-region'?
-;; * Do asynchronous `shell-command's.
-;; * Grok `append' parameter for `write-region'.
-;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
-;; * abbreviate-file-name
-;; * grok ~ in tramp-remote-path  (Henrik Holm )
-;; * Also allow to omit user names when doing multi-hop.  Not sure yet
-;;   what the user names should default to, though.
-;; * better error checking.  At least whenever we see something
-;;   strange when doing zerop, we should kill the process and start
-;;   again.  (Greg Stark)
-;; * Add caching for filename completion.  (Greg Stark)
-;;   Of course, this has issues with usability (stale cache bites)
-;;      -- 
-;; * Provide a local cache of old versions of remote files for the rsync
-;;   transfer method to use.  (Greg Stark)
-;; * Remove unneeded parameters from methods.
-;; * Invoke rsync once for copying a whole directory hierarchy.
-;;   (Francesco Potort,Al(B)
-;; * Should we set PATH ourselves or should we rely on the remote end
-;;   to do it?
-;; * Make it work for XEmacs 20, which is missing `with-timeout'.
-;; * Make it work for different encodings, and for different file name
-;;   encodings, too.  (Daniel Pittman)
-;; * Change applicable functions to pass a struct tramp-file-name rather
-;;   than the individual items MULTI-METHOD, METHOD, USER, HOST, LOCALNAME.
-;; * Implement asynchronous shell commands.
-;; * Clean up unused *tramp/foo* buffers after a while.  (Pete Forman)
-;; * Progress reports while copying files.  (Michael Kifer)
-;; * `Smart' connection method that uses inline for small and out of
-;;   band for large files.  (Michael Kifer)
-;; * Don't search for perl5 and perl.  Instead, only search for perl and
-;;   then look if it's the right version (with `perl -v').
-;; * When editing a remote CVS controlled file as a different user, VC
-;;   gets confused about the file locking status.  Try to find out why
-;;   the workaround doesn't work.
-;; * Change `copy-file' to grok the case where the filename handler
-;;   for the source and the target file are different.  Right now,
-;;   it looks at the source file and then calls that handler, if
-;;   there is one.  But since ange-ftp, for instance, does not know
-;;   about Tramp, it does not do the right thing if the target file
-;;   name is a Tramp name.
-;; * Username and hostname completion.
-;; ** If `partial-completion-mode' isn't loaded, "/foo:bla" tries to
-;;    connect to host "blabla" already if that host is unique. No idea
-;;    how to suppress. Maybe not an essential problem.
-;; ** Try to avoid usage of `last-input-event' in `tramp-completion-mode'.
-;; ** Extend `tramp-get-completion-su' for NIS and shadow passwords.
-;; ** Unify `tramp-parse-{rhosts,shosts,sconfig,hosts,passwd,netrc}'.
-;;    Code is nearly identical.
-;; ** Decide whiche files to take for searching user/host names depending on
-;;    operating system (windows-nt) in `tramp-completion-function-alist'.
-;; ** Enhance variables for debug.
-;; ** Implement "/multi:" completion.
-;; ** Add a learning mode for completion. Make results persistent.
-;; * Allow out-of-band methods as _last_ multi-hop.
-
-;; Functions for file-name-handler-alist:
-;; diff-latest-backup-file -- in diff.el
-;; dired-uncache -- this will be needed when we do insert-directory caching
-;; file-name-as-directory -- use primitive?
-;; file-name-sans-versions -- use primitive?
-;; get-file-buffer -- use primitive
-;; vc-registered
-
-;;; arch-tag: 3a21a994-182b-48fa-b0cd-c1d9fede424a
-;;; tramp.el ends here
diff --git a/xemacs-packages/lisp/tramp/trampcache.el b/xemacs-packages/lisp/tramp/trampcache.el
deleted file mode 100644
index c636e578..00000000
--- a/xemacs-packages/lisp/tramp/trampcache.el
+++ /dev/null
@@ -1,98 +0,0 @@
-;;; trampcache.el --- file information caching for tramp
-
-;; Copyright (C) 2000 by Free Software Foundation, Inc.
-
-;; Author: Daniel Pittman 
-;; Keywords: comm, processes
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; An implementation of file information caching for remote files.
-
-;; Each connection (host, user) has a unique cache.
-;; Each file has a unique set of properties associated with it.
-
-;;; Code:
-
-;; The internal interface to the cache system.
-(defun tramp-cache-set (file key value)
-  "Within the current tramp cache, set the property KEY to VALUE,
-for FILE.
-
-This must be run with the current cache context set."
-  ;; do we have an entry for the file?
-  (let* ((info (or (assoc file tramp-cache-data)
-		   (assoc file (setq tramp-cache-data
-				     (cons (list file (cons nil nil)) tramp-cache-data)))))
-	 (prop (or (assoc key (cdr info))
-		   (assoc key (setcdr info
-				      (cons (cons key nil) (cdr info)))))))
-	 (setcdr prop value)))
-
-(defun tramp-cache-get (file key)
-  "Within the current tramp cache, return the property KEY of FILE."
-  (cdr-safe (assoc key (cdr-safe (assoc file tramp-cache-data)))))
-
-
-
-
-
-
-;; The public interface to the cache system.
-(defun tramp-cache-setup (multi method user host)
-  "Initialise the cache system for a new tramp connection."
-  (with-current-buffer (tramp-get-buffer multi method user host)
-    (set (make-local-variable 'tramp-cached-data) nil)))
-
-
-;; REVISIT: These should only key on (user . host), not the method.
-;;  --daniel@danann.net, 2000-06-01
-(defun tramp-cache-get-file-property (file key multi method user host)
-  "Get the property KEY of FILE from the cache context of the
-user USER on the remote machine HOST."
-  (with-current-buffer (tramp-get-buffer multi method user host)
-    (tramp-cache-get file key)))
-
-
-(defun tramp-cache-set-file-property (file key value multi method user host)
-  "Set the property KEY of FILE to VALUE, in the cache context of the
-user USER on the remote machine HOST."
-  (with-current-buffer (tramp-get-buffer multi method user host)
-    (tramp-cache-set file key value)))
-
-
-(defun tramp-cache-flush-file (file multi method user host)
-  "Remove all properties of FILE in the cache context of USER on HOST."
-  (with-current-buffer (tramp-get-buffer multi method user host)
-    ;; REVISIT: Implement me. --daniel@danann.net, 2000-06-01
-    ))
-
-
-(defun tramp-cache-flush (multi method user host)
-  "Remove all information from the cache context of USER on HOST."
-  (with-current-buffer (tramp-get-buffer multi method user host)
-    ;; REVISIT: Implement me. --daniel@danann.net, 2000-06-01
-    ))
-
-
-
-(provide 'trampcache)
-
-;;; trampcache.el ends here
diff --git a/xemacs-packages/lisp/tramp/trampver.el b/xemacs-packages/lisp/tramp/trampver.el
deleted file mode 100644
index c7edf9a4..00000000
--- a/xemacs-packages/lisp/tramp/trampver.el
+++ /dev/null
@@ -1,42 +0,0 @@
-;;; -*- mode: Emacs-Lisp; coding: iso-8859-1; -*-
-;;; trampver.el --- Transparent Remote Access, Multiple Protocol
-;;; lisp/trampver.el.  Generated from trampver.el.in by configure.
-
-;; Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
-
-;; Author: Kai Gro,A_(Bjohann 
-;; Keywords: comm, processes
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-;; In the Tramp CVS repository, the version numer and the bug report address
-;; are auto-frobbed from configure.ac, so you should edit that file and run
-;; "autoconf && ./configure" to change them.
-
-(defconst tramp-version "2.0.53"
-  "This version of Tramp.")
-
-(defconst tramp-bug-report-address "tramp-devel@gnu.org"
-  "Email address to send bug reports to.")
-
-(provide 'trampver)
-
-;;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1
-;;; trampver.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/ChangeLog b/xemacs-packages/lisp/xemacs-base/ChangeLog
deleted file mode 100644
index 2ab78bb4..00000000
--- a/xemacs-packages/lisp/xemacs-base/ChangeLog
+++ /dev/null
@@ -1,1277 +0,0 @@
-2006-05-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.03 released.
-
-2006-05-08  Tero Saarni  
-
-	* shell.el: Unbreak telnet, autoload shell-prompt-pattern.
-
-2006-03-16  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.02 released.
-
-2006-03-16  Nelson Ferreira  
-
-	* debug.el (cancel-debug-on-entry): Fixed alist generation for
-	completing-read, thus allowing interactive use of
-	cancel-debug-on-entry to cancel debug of an individual function.
-
-2005-12-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.01 released.
-
-2005-12-27  Ville Skyttä  
-
-	* compile.el (grep-find-use-xargs): Don't error out if xargs
-	is not available.
-
-2005-10-28  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 2.00 released.
-
-2005-10-23  Ville Skyttä  
-
-	* compile.el (grep-find-use-xargs): Test "GNU" compatibility of
-	xargs in addition to find, and fall back to using generic
-	find+xargs if the latter is available.  Thanks to Karl Janmar for
-	the initial implementation.
-
-2005-10-12  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.99 released.
-
-2005-10-11  Steve Youngs  
-
-	* timer-funcs.el (with-timeout): Use `unwind-protect' to ensure
-	the timer is always deleted.
-	From: tbennett@nvidia.com
-
-2005-07-24  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.98 released.
-
-2005-07-02  Adrian Aichner  
-
-	* compile.el (grep): Report correct number of multi-line matches
-	(e.g. grep -P can do multi-line matches) by counting matches based
-	on grep-regexp-alist.
-
-2005-04-05  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.97 released.
-
-2005-04-04  Adrian Aichner  
-
-	* tq.el (tq-create): Sync tq.el with GNU Emacs tq.el<1.18>.
-
-2005-03-05  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.96 released.
-
-2005-03-04  Vin Shelton  
-
-	* compile.el (find-grep): Aliases need to be quoted, apparently.
-
-2005-03-04  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.95 released.
-
-2005-02-26  Aidan Kehoe  
-
-	* compile.el (find-grep): Alias it to grep-find--if you're used to
-	the shell, find and _then_ grep is the word order that springs to
-	mind.
-
-2004-12-22  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.94 released.
-
-2004-12-18  Ilya N. Golubev  
-
-	* add-log.el (add-change-log-entry): Use `point-at-eol',
-	`point-at-bol' instead of `line-end-position',
-	`line-beginning-position', which are not defined in current 21.4.
-	(add-log-current-defun): Ditto.
-	(match-string-no-properties): Copy from 21.5 `subr.el', for use in
-	current 21.4.
-
-2004-12-07  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.93 released.
-
-2004-12-06  Ben Wing  
-
-	* Makefile (PACKAGE_SUPPRESS):
-	Conditionalize package-suppress forms on existence of
-	`package-suppress', not any particular version.
-
-	* add-log.el (font-lock):
-	Require font-lock, since we make use of font-lock faces in
-	calls to set-face-parent upon loading, and faces are not
-	automatically autoloaded if we do it this way.
-
-2004-11-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.92 released.
-
-2004-11-26  Steve Youngs  
-
-	* add-log.el (change-log-date-face): XEmacs doesn't have the
-	`:inherit' keyword for faces so use `make-face' and
-	`set-face-parent'. 
-	(change-log-name-face): Ditto.
-	(change-log-email-face): Ditto.
-	(change-log-file-face): Ditto.
-	(change-log-list-face): Ditto.
-	(change-log-conditionals-face): Ditto.
-	(change-log-function-face): Ditto.
-	(change-log-acknowledgement-face): Ditto.
-
-2004-11-23  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.91 released.
-
-2004-11-22  Ben Wing  
-
-	* comint.el:
-	* comint.el (make-comint-1): New.
-	* comint.el (make-comint):
-	Break out make-comint functionality into make-comint-1 so we can
-	pass in a buffer directly. #### This should go away when FSF
-	comint.el is integrated.
-	
-	* shell.el (shell):
-	Fix up when shell-multiple-shells is true.  Generate the buffer
-	first and pass to comint; avoid weird tricks with the buffer name.
-
-2004-11-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.90 released.
-
-2004-11-07  Ben Wing  
-
-	* add-log.el:
-	* add-log.el (require):
-	* add-log.el (change-log-mode-hook): New.
-	* add-log.el (add-log-full-name):
-	* add-log.el (add-log-mailing-address):
-	* add-log.el (add-log-keep-changes-together): New.
-	* add-log.el (add-log-always-start-new-record): New.
-	* add-log.el (add-log-buffer-file-name-function): New.
-	* add-log.el (add-log-file-name-function): New.
-	* add-log.el (change-log-version-info-enabled): New.
-	* add-log.el (change-log-version-number-regexp-list): New.
-	* add-log.el (change-log-date-face): New.
-	* add-log.el (change-log-name-face): New.
-	* add-log.el (change-log-email-face): New.
-	* add-log.el (change-log-file-face): New.
-	* add-log.el (change-log-list-face): New.
-	* add-log.el (change-log-conditionals-face): New.
-	* add-log.el (change-log-function-face): New.
-	* add-log.el (change-log-acknowledgement-face): New.
-	* add-log.el (change-log-font-lock-keywords):
-	* add-log.el (change-log-mode-map):
-	* add-log.el (iso8601-time-string):
-	* add-log.el (change-log-name):
-	* add-log.el (change-log-version-number-search): New.
-	* add-log.el (find-change-log):
-	* add-log.el (add-log-file-name): New.
-	* add-log.el (add-change-log-entry):
-	* add-log.el (add-change-log-entry-other-window):
-	* add-log.el (change-log-mode):
-	* add-log.el (add-log-current-defun-header-regexp):
-	* add-log.el (add-log-lisp-like-modes):
-	* add-log.el (add-log-current-defun):
-	* add-log.el (change-log-get-method-definition-md):
-	* add-log.el (get-method-definition-md)): Removed.
-	* add-log.el (change-log-get-method-definition-md)): New.
-	* add-log.el (get-method-definition-1): Removed.
-	* add-log.el (change-log-get-method-definition-1): New.
-	* add-log.el (get-method-definition): Removed.
-	* add-log.el (patch-to-change-log):
-	* add-log.el (change-log-get-method-definition): New.
-	* add-log.el (change-log-sortable-date-at): New.
-	* add-log.el (change-log-resolve-conflict): New.
-	* add-log.el (change-log-merge): New.
-	* add-log.el (change-log-redate): New.
-	* assoc.el:
-	* debug.el:
-	* debug.el (debugger): New.
-	* debug.el (debugger-mode-hook): New.
-	* debug.el (debugger-batch-max-lines): New.
-	* debug.el (debugger-previous-backtrace): New.
-	* debug.el (debugger-outer-overriding-terminal-local-map)): New.
-	* debug.el (debug):
-	* debug.el (debugger-setup-buffer): New.
-	* debug.el (debugger-make-xrefs): New.
-	* debug.el (debugger-continue):
-	* debug.el (debugger-jump):
-	* debug.el (debugger-frame-number):
-	* debug.el (debugger-frame):
-	* debug.el (debugger-frame-clear):
-	* debug.el (debugger-env-macro): New.
-	* debug.el (debugger-mode-map):
-	* debug.el (debugger-record-buffer): New.
-	* debug.el (debugger-record-expression): New.
-	* debug.el (debugger-mode):
-	* debug.el (debug-on-entry):
-	* debug.el (cancel-debug-on-entry):
-	* debug.el (debug-on-entry-1):
-	* easy-mmode.el:
-	* easy-mmode.el (define-minor-mode):
-	* easy-mmode.el (easy-mmode-define-global-mode):
-	* easy-mmode.el (easy-mmode-define-keymap):
-	* macros.el:
-	* macros.el (name-last-kbd-macro):
-	* macros.el (insert-kbd-macro):
-	* macros.el (apply-macro-to-region-lines):
-	* ring.el:
-	* ring.el (ring-insert-at-beginning):
-	* ring.el (ring-plus1):
-	* ring.el (ring-minus1):
-	* ring.el (ring-length):
-	* ring.el (ring-index):
-	* ring.el (ring-empty-p):
-	* ring.el (ring-size): New.
-	* ring.el (ring-copy): New.
-	* ring.el (ring-remove):
-	* ring.el (ring-ref):
-	* ring.el (ring-elements): New.
-	* shell.el:
-	* shell.el (shell-dumb-shell-regexp): New.
-	* shell.el (shell-prompt-pattern):
-	* shell.el (shell-file-name-chars):
-	* shell.el (shell-file-name-quote-list):
-	* shell.el (shell-chdrive-regexp):
-	* shell.el (shell-dirtrack-verbose): New.
-	* shell.el (explicit-bash-args):
-	* shell.el (shell-input-autoexpand):
-	* shell.el (shell-mode):
-	* shell.el (shell-write-history-on-exit): New.
-	* shell.el (shell):
-	* shell.el (shell-directory-tracker):
-	* shell.el (shell-cd-1):
-	* shell.el (shell-unquote-argument): New.
-	* shell.el (shell-process-pushd):
-	* shell.el (shell-resync-dirs):
-	* shell.el (shell-backward-command):
-	* shell.el (shell-dynamic-complete-command):
-	* shell.el (shell-replace-by-expanded-directory):
-	* sort.el:
-	* sort.el (sort-subr):
-	* sort.el (sort-reorder-buffer):
-	* sort.el (sort-lines):
-	* sort.el (sort-numeric-base): New.
-	* sort.el (sort-numeric-fields):
-	* sort.el (sort-regexp-fields):
-	* sort.el (sort-columns):
-	* timezone.el:
-	* timezone.el (timezone-world-timezones):
-	* timezone.el (timezone-parse-date):
-	* timezone.el (timezone-parse-time):
-	* timezone.el (timezone-time-from-absolute):
-	* timezone.el (timezone-fix-time):
-	* tq.el:
-	* tq.el (tq-create):
-	* tq.el (tq-filter):
-	* tq.el (tq-process-buffer):
-	Sync add-log, assoc, debug, macros, ring, shell, sort,
-	timezone, tq to 21.3.
-	Really sync easy-mmode with 21.3.
-
-2004-11-06  Ben Wing  
-
-	* field.el (field-beginning):
-	* field.el (field-end):
-	skip-start and skip-end values were switched.
-
-2004-10-28  Ben Wing  
-
-	* add-log.el (patch-to-change-log): Make hunk regexp a bit
-	more permissive to allow for --show-c-function and
-	--show-function-line options of `cvs-diff'.
-
-2004-10-22  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.89 released.
-
-2004-09-07  Jerry James  
-
-	* Makefile (ELCS): Add timer-funcs.el and realphabetize.
-
-2004-10-04  Adrian Aichner  
-
-	* ffap.el (ffap-alist): Single typo fix.
-
-2004-09-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.88 released.
-
-2004-08-30  Jerry James  
-
-	* field.el: New file.
-	* Makefile (ELCS): Add field.elc.
-
-2004-06-28  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.87 released.
-
-2004-06-28  Zoltan Filyo  
-
-	* compile.el (compilation-error-regexp-alist-alist): Enhance
-	regexp to grasp Borland C++ Builder 6.0 syntax.
-
-2004-06-18  Jerry James  
-
-	* easy-mmode.el (easy-mmode-define-syntax): Replace call to
-	set-char-table-parent with derived-mode-merge-syntax-tables.
-
-2004-03-29  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.86 released.
-
-2004-03-26  Ville Skyttä  
-
-	* easy-mmode.el (easy-mmode-define-navigation): Call only the
-	version of pos-visible-in-window-p with the correct number of args.
-
-2004-02-16  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.85 released.
-
-2004-02-14  Jerry James  
-
-	* easy-mmode.el: Don't conditionally define pos-visible-in-window-p.
-	* easy-mmode.el (easy-mmode-define-navigation): Check whether the
-	2 arg or 3 arg version of pos-visible-in-window-p is available and
-	call the right one.
-
-2004-01-27  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.84 released.
-
-2004-01-27  Jerry James  
-
-	* easy-mmode.el: Synch with Emacs 21.3.
-
-2003-12-04  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.83 released.
-
-2003-11-28  Robert Widhopf 
-
-	* compile.el (compilation-ask-about-kill): Added new variable
-	allowing to kill a running compilation without being bothered by a
-	question if you really want to kill it.
-	
-	* compile.el (compile-internal): honor `compilation-ask-about-kill'
-
-2003-10-29  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.82 released.
-
-2003-10-20  Ville Skyttä  
-
-	* regexp-opt.el: API + returned regexp compatibility sync with
-	GNU Emacs 21.3.  The major backwards-incompatible change is that
-	the shy/non-shy argument has been dropped from `regexp-opt',
-	`regexp-opt-depth' and `regexp-opt-group'.
-
-2003-09-20  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.81 released.
-
-2003-09-20  Steve Youngs  
-
-	* compile.el (grep-null-device): Add missing quote.
-
-2003-09-13  Adrian Aichner  
-
-	* compile.el: Partial sync with GNU Emacs compile.el revision
-	1.279.
-	* compile.el (compilation-parse-errors-function): Whitespace
-	cleanup.
-	* compile.el (compilation-error-regexp-alist-alist): Sync up,
-	adding new and simplifying some old expressions.
-	* compile.el (compilation-error-regexp-systems-list): Extend and
-	sort systems alphabetically.
-	* compile.el (compilation-error-screen-columns): Indentation sync.
-	* compile.el (compilation-read-command): Docstring sync.
-	* compile.el (compilation-ask-about-save): Ditto.
-	* compile.el (grep-regexp-alist): Support file names with blanks.
-	* compile.el (grep-find-use-xargs): Docstring fix.
-	* compile.el (compile): Whitespace cleanup.
-	* compile.el (grep-find): Docstring sync.
-	* compile.el (compile-internal): Whitespace cleanup.
-	* compile.el (compilation-setup): Docstring sync.
-	* compile.el (compilation-handle-exit): Docstring sync.
-	* compile.el (compile-error-at-point): Ditto.
-	* compile.el (compilation-next-error): Ditto.
-	* compile.el (compilation-previous-error): Ditto.
-	* compile.el (compilation-next-file): Error message sync (dropping
-	period).
-	* compile.el (kill-compilation): Ditto.
-	* compile.el (compile-goto-error): Ditto.
-	* compile.el (next-error): Docstring sync.
-	* compile.el (previous-error): Ditto.
-	* compile.el (first-error): Ditto.
-	* compile.el (compilation-next-error-locus): Whitespace cleanup.
-
-2003-09-19  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.80 released.
-
-	* Makefile (VERSION): XEmacs package 1.79 released.
-
-2003-09-19  Stephen J. Turnbull  
-
-	* compile.el (grep-null-device): Use null-device if bound.
-
-2003-06-11  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.78 released.
-
-2003-06-07  Ilya N. Golubev  
-
-	* shell.el (shell-directory-tracker): Make regexp used for
-	skipping to next command correspond to one used for command
-	itself.
-	(shell-command-separator-regexp): New variable.
-
-2003-04-29  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.77 released.
-
-2003-04-15  Jerry James  
-
-	* comint.el: Remove references to comint-extract-current-pathname
-	and comint-match-partial-pathname, which do not exist.
-	* comint.el (comint-find-source-code): Use ffap-next-guess instead
-	of comint-extract-current-pathname.
-	* ffap.el: Autoload ffap-next-guess.
-
-2003-04-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.76 released.
-
-2003-03-24  Andy Piper  
-
-	* compile.el (compilation-error-regexp-alist-alist): add regexp
-	suitable for ant errors.
-
-2003-03-22  Vasily Korytov  
-
-	* outline.el (outline-mode-hook): Add a (defvar ...), so this
-	variable is documented.
-
-2003-03-09  Ben Wing  
-
-	* Makefile (PACKAGE_SUPPRESS): New.
-	Add a PACKAGE_SUPPRESS value for use with new package-suppress
-	support, since _pkg.el is auto-generated.
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-	Delete blank HTML_FILES, HTML_DEP.
-
-2003-01-18  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.75 released.
-
-2003-01-12  Robert Bihlmeyer 
-
-	* add-log.el (add-log-current-defun): add ( to ender for perl
-        functions.
-
-2003-01-13  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.74 released.
-
-2003-01-06  Ville Skyttä  
-
-	* add-log.el: Make auto-mode-alist modifications autoload-only.
-
-2003-01-03  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.73 released.
-
-2002-12-17  Jerry James  
-
-	* ffap.el: Require advice at compile time, not load time.
-
-2002-12-06  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.72 released.
-
-2002-11-29  Ben Wing  
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-	* compile.el:
-	* compile.el (grep-all-files-history): New.
-	* compile.el (grep-all-files-omitted-expressions): New.
-	* compile.el (grep-all-files-omitted-directories): New.
-	* compile.el (construct-grep-all-files-command): New.
-	* compile.el (grep-all-files-in-current-directory): New.
-	* compile.el (grep-all-files-in-current-directory-and-below): New.
-	* compile.el (compile-internal):
-
-	New commands for conveniently grepping all useful files in the
-	current directory, or recursively.  Sort of like grep-find, but
-
-	(a) the find command is determined for you, to cover this
-	directory only, or all subdirs
-
-	(b) uninteresting files/dirs are automatically skipped by
-	`grep-all-files-omitted-expressions' and
-	`grep-all-files-omitted-directories' -- e.g. binary files (.o,
-	.obj, .exe), diff droppings (.orig, .rej), backup files (~),
-	autosave files (#....), CVS droppings (.#...), etc. plus
-	directories CVS/RCS/SCCS.
-
-	(c) unlike grep-find, the interface shows only the grep command,
-	minus files, so it's manageable.
-
-2002-11-25  Mike Sperber 
-
-	* compile.el (compile-internal): Re-set `outwin' because it may
-	have changed after `save-window-excursion'.
-
-2002-11-24  David A. Panariti  
-
-	* shell.el (shell-directory-tracker): Added check for a
-	`shell-dirtrack-other-regexp' which when matched calls
-	`shell-dirtrack-process-other-func'.  This allows for arbitrary
-	user processing of directory changing commands.
-
-        (shell-dirtrack-other-regexp): Added defcustom for the regexp.
-
-        (shell-dirtrack-process-other-func): Added defcustom for the
-        function to call.
-
-2002-10-29  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.71 released.
-
-2002-10-19  Ville Skyttä  
-
-	* ffap.el (ffap): Remove dummy defun for ffap, autoload alias.
-
-2002-10-15  Ville Skyttä  
-
-	* Makefile (srckit): Remove.
-
-2002-10-07  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.70 released.
-
-2002-09-30  Ville Skyttä  
-
-	* add-log.el: Add autoloaded auto-mode-alist associations.
-
-2002-09-25  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.69 released.
-
-2002-09-11  Evgeny Roubinchtein 
-
-	* easy-mmode.el (define-minor-mode): Use add-minor-mode to add
-	the keymap to minor-mode-alist and add the modeline indicator.
-
-2002-09-11  Simon Josefsson  
-
-	* time-stamp.el (time-stamp-hhmmss): New function.
-
-2002-09-06  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.68 released.
-
-2002-08-29  Norbert Koch  
-
-	* comint.el (comint-dynamic-complete-as-filename): Make the
-	directory suffix dependent on the system-type.
-	(comint-dynamic-complete-filename): Remove unnecessary
-	binding.
-
-2002-08-05  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.67 released.
-
-2002-08-04  Simon Josefsson  
-
-	* passwd.el (read-passwd): Redisplay.
-
-2002-07-14  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.66 released.
-
-2002-07-09  Hrvoje Niksic  
-
-	* ffap.el (ffap-read-file-or-url): Return the current directory
-	if the user's input equals the current directory.
-
-2002-06-27  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.65 released.
-
-2002-06-26  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.64 released.
-
-2002-06-22  Ville Skyttä  
-
-	* compile.el: Partial sync with GNU Emacs 21.2.
-	(compilation-error-screen-columns): New.
-	(compile-buffer-substring): New.
-	(compilation-setup):
-	Buffer-localize compilation-error-screen-columns.
-	(compilation-next-error-locus):
-	Use compilation-error-screen-columns.
-
-2002-05-07  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.63 released.
-
-2002-05-02  Ville Skyttä  
-
-	* easy-mmode.el: Partial sync with GNU Emacs 21.2.
-	(define-minor-mode): New.
-	(easy-mmode-define-navigation): Ditto.
-	(easy-mmode-defmap): Ditto.
-	(easy-mmode-set-keymap-parents): Ditto.
-
-2002-05-02  Steve Youngs  
-
-	* Makefile (ELCS): Add easy-mmode.elc.
-
-	* easy-mmode.el: Moved here from pcl-cvs.
-
-2002-04-24  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.62 released.
-
-2002-04-01  John Paul Wallington  
-
-	* pp.el (pp-to-string): add autoload cookie.
-
-2002-03-27  Steve Youngs  
-
-	* Makefile (VERSION): 1.61 released.
-
-2002-03-25  Ville Skyttä  
-
-	* regexp-opt.el: Partial synch with GNU Emacs 21.2.
-	(regexp-opt): Handle PAREN with value 'words.
-	(regexp-opt-group): Return empty string if STRINGS is empty.
-
-2002-03-26  Steve Youngs  
-
-	* Makefile (VERSION): 1.60 released.
-
-2002-03-14  David A. Panariti  
-
-	* comint.el (comint-strip-ctrl-m):
-	Added a check to make sure whichever of comint-last-input-end or
-	comint-last-input-start that is used has a valid position.  This
-	allows comint-strip-ctrl-m to be used with gdb-mode.
-
-2002-01-28  David A. Panariti  
-
-	* ffap.el (ffap-url-regexp):
-	Changed http to https? to allow https urls to be recognized.
-
-2002-01-23  John Paul Wallington  
-
-	* env.el: synched with FSF 21.1.50:
-	(substitute-env-vars): new function.
-	(setenv): add optional argument SUBSTITUTE-ENV-VARS.
-
-2002-01-17  John Paul Wallington  
-
-	* shell.el (shell-input-autoexpand): fix custom type, add group.
-
-2002-01-14  Adrian Aichner  
-
-	* add-log.el (add-log-current-defun-header-regexp): Add . and [0-9].
-	* add-log.el (patch-to-change-log): Correct file-re1, file-re2,
-	and new-defun-re.  Apply heuristics for unsupported language, as
-	implemented in `add-log-current-defun', to New and Removed symbols
-	as well.
-
-2002-01-13  Steve Youngs  
-
-	* package-info.in (provides): Update to include all provides.
-
-2002-01-07  Adrian Aichner  
-
-	* Makefile (HTML_FILES): New.
-	* Makefile (HTML_DEP): New.
-
-2002-01-02  Adrian Aichner  
-
-	* add-log.el (patch-to-change-log): Standardize on / in ChangeLog
-	entry paths.
-
-2002-01-02  Didier Verna  
-
-	* add-log.el (patch-to-change-log): new keyword :dry-run.
-
-2001-12-10  Steve Youngs  
-
-	* Makefile (ELCS): Add tq.elc, moved from vc-cc.
-
-2001-05-20  Adrian Aichner  
-
-	* compile.el (compilation-setup): Properly make
-	`mouse-track-click-hook' local in compile.el.
-
-2001-05-13  Adrian Aichner  
-
-	* compile.el (compilation-setup): Add
-	`compile-mouse-maybe-goto-error' to global value of
-	`mouse-track-click-hook' to fix mouse-track-insert between
-	buffers.
-
-2001-05-11  Ben Wing  
-
-	* compile.el (compilation-find-file): warning fix.
-	
-	* sort.el:
-	* sort.el (sort-regexp-history): New.
-	* sort.el (sort-regexp-fields):
-	* sort.el (sort-regexp-fields-numerically):
-	* sort.el (sort-columns-subprocess): snarf the region before asking questions.
-
-2001-04-23  Ben Wing  
-
-	* compile.el (compilation-shell-minor-mode):
-	Remember to localize the menubar before adding to it.
-
-2001-04-21  Ben Wing  
-
-	* sort.el: need autoload for sort-regexp-fields-numerically.
-
-2001-04-21  Ben Wing  
-
-	* add-log.el (change-log-mode):
-	Fix paragraph filling to correctly handle descriptor lines
-	(those beginning with e.g. * add-log.el (change-log-mode):).
-	* add-log.el (patch-to-change-log):
-	Don't error if patch blank.
-
-2001-04-20  Ben Wing  
-
-	* sort.el:
-	* sort.el (sort): New.
-	* sort.el (sort-subr):
-	* sort.el (sort-fields):
-	* sort.el (sort-regexp-fields):
-	* sort.el (sort-regexp-fields-numerically): New.
-	* sort.el (sort-columns):
-	Synch with FSF 20.7.
-	Add new arg for compare fun to `sort-subr', `sort-regexp-fields'.
-	New command `sort-regexp-fields-numerically'.
-	
-2001-04-10  Ben Wing  
-
-	* add-log.el (patch-to-change-log):
-	Fix warnings.  Make sure font-lock-auto-fontify is not
-	turned off when visiting ChangeLogs, so that they end up
-	font-locked when all is done.  Anchor file-re1 at begline
-	to avoid problems when the diff itself contains `Index:'.
-
-2001-03-31  Mike Sperber 
-
-	* compile.el (compilation-shell-minor-mode): Added.
-
-2001-03-14  Dr. Volker Zell  
-
-	* ffap.el (ffap-menu-ask): Add test for ffap-xemacs to fix a
-	'Wrong type argument: eventp t' error.
-
-2001-03-12  Adrian Aichner  
-
-	* add-log.el (patch-to-change-log): Avoid second empty line after
-	ChangeLog addition, which is against current ChangeLog editing
-	practice.
-
-2001-02-05  Steve Youngs  
-
-	* passwd.el (passwd-erase-buffer): Back out Matt's patch.
-
-2001-01-24  Matt Tucker  
-
-	* passwd.el (passwd-erase-buffer): Temporarily disable font-lock
-	for performance reasons.
-
-2000-12-06  Karl M. Hegbloom  
-
-	* shell.el (shell): Return the buffer so callers may use it.
-
-2000-12-04  Yoshiki Hayashi  
-
-	* case-table.el: Use new API when available.
-
-2000-12-04  Yoshiki Hayashi  
-
-	* case-table.el: Use new API when available.
-
-2000-11-09  Volker Franz 
-
-	* comint.el (comint-send-input): Extracted function
-	comint-add-to-input-history from comint-send-input.
-	(comint-add-to-input-history): New function.
-
-2000-11-07  Martin Buchholz 
-
-	* env.el: Doc fix.
-
-2000-11-06  Martin Buchholz  
-
-	* add-log.el (patch-to-change-log):
-	- Patch doesn't have to be in the same directory as source.
-	- Use make-hash-table, not make-hashtable
-	- Don't confusingly overload name `add-change-log-entry'.
-
-2000-10-15  Björn Torkelsson  
-
-	* debug.el (toggle-debug-on-error): New
-	(toggle-debug-on-signal): New
-	(toggle-debug-on-quit): New
-
-2000-10-24  Didier Verna  
-
-	* add-log.el (patch-to-change-log): new cl keywords
-	:keep-source-files, :extent-property and :extent-property-value,
-	documented in the docstring.
-	Returns a list of modified ChangeLog buffers.
-
-2000-10-11  Fraser Young 
-
-	* compile.el (compilation-find-file): Reset buffer
-	when its wrong.
-
-2000-10-03  Yoshiki Hayashi  
-
-	* macros.el (kbd-macro-query): Use next-command-event
-	instead of read-char-exclusive.
-
-2000-10-08  Adrian Aichner  
-
-	* add-log.el (patch-to-change-log): Honor variables
-	`add-log-full-name' and `add-log-mailing-address', like
-	`add-change-log-entry' does.
-
-2000-10-05  Martin Buchholz  
-
-	* *: Mega typo fix.
-
-2000-10-03  Barry Wilkes  
-
-	* compile.el: Added ;;;###autoload for grep-find
-
-2000-08-15  Adrian Aichner  
-
-	* add-log.el (patch-to-change-log): Re-word docstring.  Fix hangup
-	on non-existent ChangeLog files, by using `find-change-log', as
-	suggested by Ben.
-
-2000-05-22  Karl M. Hegbloom  
-
-	* compile.el (compilation-find-file): push newly visited file
-	names on file-name-history
-
-2000-04-05  Karl M. Hegbloom  
-
-	* comint.el (comint-password-prompt-regexp): Make the space in
-	"pass phrase" optional so that it catches the `gpg' passphrase
-	prompt by default.
-
-2000-07-08  Adrian Aichner  
-
-	* add-log.el (change-log-name): Remove outta-space port.
-	* add-log.el (patch-to-change-log): Use (user-full-name) instead
-	of (user-login-name) following the standard established by
-	`add-change-log-entry'.
-
-2000-06-12  Ben Wing  
-
-	* add-log.el (patch-to-change-log): New function.
-
-2000-06-04  Mike Sperber 
-
-	* case-table.el (describe-buffer-case-table): Fix to use case
-	tables of actual buffer in question.
-
-2000-06-05  Ben Wing  
-
-	* macros.el (assign-last-kbd-macro-to-key): new function;
-	used by menubar.
-
-2000-02-28  Martin Buchholz  
-
-	* add-log.el (change-log-name): Remove VMS support.
-
-2000-02-28  Akim Demaille  
-
-	* add-log.el (add-log-current-defun): Add support for Autoconf
-	mode.
-
-2000-02-21  Andreas Jaeger  
-
-	* compile.el (grep-find-use-xargs): Move defvar before usage.
-
-2000-02-14  Barry Wilkes  
-
-	* compile.el : Added grep-find command (+ associated variables)
-	from FSF Emacs. Only one change to FSF code required, namely to
-	use read-shell-command rather than read-from-minibuffer in
-	grep-find.
-
-2000-02-16  Yoshiki Hayashi  
-
-	* compile.el: Delete garbage.
-
-2000-02-12  Andreas Jaeger  
-
-	* compile.el (compilation-set-window-height): Did not take into
-	account left/right toolbars when checking that window was not
-	split horizontally.
-	Patch by Sean MacLennan .
-	(compilation-find-file): Check if there's an existing buffer first.
-	(compare-file-to-buffer): New.
-	Patch by Jason Kim .
-
-2000-01-19  Yoshiki Hayashi  
-
-	* passwd.el (passwd-insecure-display): Remove face
-	property set by passwd-secure-display.
-
-2000-01-18  Martin Buchholz  
-
-	* comint.el (comint-mode): Add autoload cookie.
-
-2000-01-13  Andreas Jaeger  
-
-	* regexp-opt.el: Moved from package xemacs-devel to here since
-	other packages depend on it.
-
-	* Makefile (ELCS): Added regexp-opt.elc
-
-2000-01-12  Kirill 'Big K' Katsnelson  
-
-	* add-log.el (add-log-current-defun-function): Changed :type of
-	this defcustom to the correct one, 'function.
-
-2000-01-10  Didier Verna  
-
-	* annotations.el (set-annotation-glyph): preserve layout and side
-	when not specified, remove old glyph from the extent when chaging
-	the side of the annotation.
-
-1999-12-11  Andreas Jaeger  
-
-	* timezone.el (timezone-parse-date): Years < 69 are 20YY.
-
-1999-12-27  Yoshiki Hayashi  
-
-	* passwd.el (read-passwd): Document how to disable recording
-	key strokes.
-
-1999-12-04  Jan Vroonhof  
-
-	* passwd.el (passwd-secure-display): Fix missing (lambda line. Don't
-	use single condition cond for clarity.
-	(passwd-insecure-display): ditto.
-
-1999-12-05  Andreas Jaeger  
-
-	* debug.el (debug): Replace obsolete allocate-event with
-	make-event.
-	Patch by Martin Buchholz .
-
-1999-10-11   Daiki Ueno  
-
-	* passwd.el (passwd-secure-display): Preserve fallback values.
-
-1999-11-03    Robert Fenk 
-
-	* shell.el (shell-dirstack-message): `getenv "HOME"' replaced by
-	`user-home-directory', because usually HOME is not defined on WinNT.
-
-1999-09-01  Gabriel Foster  
-
-	* compile.el: Added support for the SGI MipsPro 7.3 compilers to
-	compilation-error-regexp-alist-alist.
-
-1999-08-19  Christoph Wedler  
-
-	* imenu.el: Synced up with FSF 20.4, except menu/menubar
- 	differences, some autoload cookies and:
-	(imenu--generic-function): Use `match-string' instead
- 	`match-string-no-properties'.
-	(imenu--completion-buffer): Don't set `minibuffer-setup-hook'.  In
- 	XEmacs, `completing-read' has only 6 args, provide workaround.
-
-	* imenu.el: Bugfix in XEmacs specific part.
- 	(imenu--last-menubar-filter-menu): New buffer-local variable.
-	(imenu-menu-filter): Use it.  Split/sort submenus.
-
-1999-07-22  SL Baur  
-
-	* comint.el (comint-password-prompt-regexp): add extra blank.
-	From Bob Weiner  
-
-1999-07-22  SL Baur  
-
-	* compile.el (compilation-set-window-height): Did not take into
-	account left/right toolbars when checking that window was
-	not split horizontally.
-	From Sean MacLennan 
-
-1999-03-26  Adrian Aichner  
-
-	* compile.el (compile-internal): Use `shell-command-switch'
-	instead of a hard-coded "-c" switch.
-
-1998-11-30  Hrvoje Niksic  
-
-	* imenu.el (imenu--create-menu-1): Handle empty menu.
-
-1998-12-05  SL Baur  
-
-	* timezone.el (timezone-zone-to-minute): Make function match
-	documentation.
-	From torin@perv.daft.com via James LewisMoss .
-
-1998-10-08  Didier Verna  
-
-	* time-stamp.el (time-stamp-strftime): fixed usage of `concat'
-	(which now accepts only strings) when `field-result' is a number.
-
-1998-08-21  Greg Klanderman  
-
-	* comint.el (comint-dynamic-complete-filename): do user name
-	completion too (~user).
-	(comint-dynamic-complete-as-username): new function.
-	(comint-dynamic-list-filename-completions): handle user name
-	completions too.
-
-1998-08-06  Michael Sperber [Mr. Preprocessor]  
-
-	* etc/enriched.doc: Put doc changes for XEmacs version back in.
-
-1998-07-31  Barry A. Warsaw  
-
-	* comint.el (comint-postoutput-scroll-to-bottom):
-	Added (sit-for 0) to work around
-	basic XEmacs recenter bug.
-
-1998-07-12  SL Baur  
-
-	* facemenu.el (facemenu-update-facemenu-menu): Kill
-	list-faces-display.
-
-	* annotations.el (set-annotation-glyph): Kill extent-layout.
-
-1998-07-02  Hrvoje Niksic  
-
-	* compile.el (compile-command): Docstring fix: use `add-hook' to
-	modify hook value.
-
-1998-07-01  Carsten Leonhardt  
-
-	* passwd.el (passwd-secure-display): Invert colors only in current
-	frame. This avoids messing up the colors in tty frames while
-	working in X frames.
-	(passwd-insecure-display): Ditto.
-
-1998-05-15  SL Baur  
-
-	* thing.el (thing-symbol): Fix for boundary condition.
-	From Michael Ernst 
-
-1998-05-14  Hrvoje Niksic  
-
-	* edmacro.el (kbd): Removed.
-
-1998-04-29  SL Baur  
-
-	* compile.el (compile-internal): Comment out (process-send-eof).
-	From Hrvoje Niksic 
-
-1998-04-28  SL Baur  
-
-	* shell.el ((not shell-mode-map)): Don't use reader macro.
-
-1998-04-06  Martin Buchholz  
-
-	* comint.el: Restore function comint-find-source-code and
-	friends removed earlier in 21.0 development cycle.
-
-1998-04-15  Martin Buchholz  
-
-	* comint-delim-arg: Obsoleted by improvements to comint-arguments
-	* comint.el (comint-arguments): Use a single regexp for each arg.
-	Use only a third of the code to do the same thing.  Remove
-	dependency on (nthcdr -1 x) working.
-
-1998-04-11  Kirill M. Katsnelson  
-
-	* shell.el (shell): When selecting shell file name, consult
-	`shell-file-name' before falling back to "/bin/sh".
-	Fix docstring accordingly.
-
-1998-04-11  Kirill M. Katsnelson  
-
-	* compile.el (compile-internal): Close stdin of an inferior grep
-	or make process.
-
-1998-04-04  SL Baur  
-
-	* overlay.el: moved to fsf-compat.
-
-1998-03-23  Hrvoje Niksic  
-
-	* facemenu.el: Don't define keys at top-level; use an autoload
-	cookie instead.
-
-1998-03-22  SL Baur  
-
-	* ffap.el: added.
-
-1998-03-04  SL Baur  
-
-	* compile.el (compile-internal): Back out previous change.
-
-1998-02-24  Greg Klanderman  
-
-	* compile.el (compile-internal): save and restore the selected
-	window in addition to the current buffer as display-buffer may
-	create a new frame if the buffer is a special-display buffer.
-
-1998-02-21  Karl M. Hegbloom  
-
-	* shell.el (explicit-bash-args): Bash 1.14 doesn't support
-	`--login', so use the equivalent and more standard `-i' instead.
-
-1998-02-16  SL Baur  
-
-	* compile.el (compilation-mode): Autoload.
-
-1998-02-14  SL Baur  
-
-	* compile.el (grep): Print # of matches.
-	From Hrvoje Niksic 
-
-1998-01-31  Karl M. Hegbloom  
-
-	* shell.el (shell-cd-1): Fixed remote directory tracking.
-
-1998-01-23  Karl M. Hegbloom  
-
-	* shell.el (explicit-*-args): Add args defcustoms for several
-	other popular shells.
-
-1997-12-18  Hrvoje Niksic  
-
-	* add-log.el (add-log-convert): New function.
-
-1998-01-22  Karl M. Hegbloom  
-
-	* compile.el (compilation-minor-mode): Use `add-minor-mode' for
-	`compilation-minor-mode', and put an autoload cookie there.
-	(compilation-minor-mode-map): Also need to autoload the
- 	minor-mode-map.
-	(compilation-minor-mode): ... and the variable.
-
-1998-01-24  SL Baur  
-
-	* Makefile (VERSION): Update to package standards 1.0.
-	* package-info.in: Ditto.
-
-1998-01-16  Greg Klanderman  
-
-	* add-log.el (prompt-for-change-log-name): use find-change-log to
-	find the default by searching upwards from the current directory
-	for a ChangeLog file.  Change the read-file-name prompt to present
-	user with the default, with point at the end of the directory
-	component.
-
-1998-01-17  SL Baur  
-
-	* Makefile (ELCS): Add overlay.elc.
-
-	* package-info.in: Update provides tag.
-
-	* ebuff-menu.el: Provide 'ebuff-menu as a feature.
-
-	* echistory.el: Provide 'echistory as a feature.
-
-	* macros.el: Provide 'macros as a feature.
-
-	* novice.el: Provide 'novice as a feature.
-
-	* debug.el: Provide 'debug as a feature.
-
-1998-01-11  SL Baur  
-
-	* Makefile (VERSION): Updated package build procedure.
-
-1998-01-09  Karl M. Hegbloom  
-
-	* annotations.el (annotations-in-region): Rewrote the
-	`map-extents' call to use the newer interface.
-
-1998-01-05  Karl M. Hegbloom  
-
-	* ring.el (ring-remove): Optimize by moveing duplicated function
-	call out of the loop into a let.  Varref is faster than a function
-	call, thus the codepath is reduced and the loop will execute more
-	quickly.
-
-1998-01-01  SL Baur  
-
-	* Makefile: Added skeleton.el.
-
-1997-12-24  SL Baur  
-
-	* Makefile: Add comint-xemacs.el and shell.el.
-
-1997-12-23  SL Baur  
-
-	* Makefile: Added ebuff-menu.el, echistory.el, ehelp.el,
-	electrict.el and helper.el.
-	Also added chistory.el, iso-syntax.el and time-stamp.el.
-
-	* xemacs-base 1.01 is released.
-
-	* add-log.el (change-log): Remove `(require 'fortran)'.
-
-	* imenu.el: New file.
-
-	* annotations.el: Commentary changes.
-	* assoc.el: Ditto.
-	* comint.el: Ditto.
-	* compile.el: Ditto.
-	* debug.el: Ditto.
-	* enriched.el: Ditto.
-	* env.el: Ditto.
-	* facemenu.el: Ditto.
-	* macros.el: Ditto.
-	* novice.el: Ditto.
-	* outline.el: Ditto.
-	* passwd.el: Ditto.
-	* pp.el: Ditto.
-	* regi.el: Ditto.
-	* ring.el: Ditto.
-	* sort.el: Ditto.
-	* thing.el: Ditto.
-	* timezone.el: Ditto.
-	* xbm-button.el: Ditto.
-
-	* Makefile: Add in:  add-log.el, compile.el, imenu.el, outline.el
-
-1997-12-20  SL Baur  
-
-	* Makefile: Created.
diff --git a/xemacs-packages/lisp/xemacs-base/_pkg.el b/xemacs-packages/lisp/xemacs-base/_pkg.el
deleted file mode 100644
index 9693cb9c..00000000
--- a/xemacs-packages/lisp/xemacs-base/_pkg.el
+++ /dev/null
@@ -1,10 +0,0 @@
-;;;###autoload
-(package-provide 'xemacs-base
-		 :version 2.03
-          :author-version "No-Upstream-Ver"
-		 :type 'regular)
-
-;;;###autoload
-(when (fboundp 'package-suppress)
-      (package-suppress 'xemacs-base "regexp-opt" '(fboundp 'package-suppress)) (package-suppress 'xemacs-base "easy-mmode" '(fboundp 'package-suppress))
-)
diff --git a/xemacs-packages/lisp/xemacs-base/add-log.el b/xemacs-packages/lisp/xemacs-base/add-log.el
deleted file mode 100644
index d146bb70..00000000
--- a/xemacs-packages/lisp/xemacs-base/add-log.el
+++ /dev/null
@@ -1,1381 +0,0 @@
-;;; add-log.el --- change log maintenance commands for Emacs
-
-;; Copyright (C) 1985, 86, 88, 93, 94, 97, 98, 2000 Free Software Foundation, Inc.
-;; Copyright (C) 2000 Ben Wing.
-
-;; Maintainer: FSF
-;; Keywords: maint
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Emacs 21.3.
-
-;;; Commentary:
-
-;; This facility is documented in the Emacs Manual.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'timezone))
-
-(require 'font-lock)
-
-(defgroup change-log nil
-  "Change log maintenance"
-  :group 'tools
-  :group 'maint
-  :link '(custom-manual "(emacs)Change Log")
-  :prefix "change-log-"
-  :prefix "add-log-")
-
-
-(defcustom change-log-default-name nil
-  "*Name of a change log file for \\[add-change-log-entry]."
-  :type '(choice (const :tag "default" nil)
-		 string)
-  :group 'change-log)
-
-(defcustom change-log-mode-hook nil
-  "Normal hook run by `change-log-mode'."
-  :type 'hook
-  :group 'change-log)
-
-(defcustom add-log-current-defun-function nil
-  "*If non-nil, function to guess name of surrounding function.
-It is used by `add-log-current-defun' in preference to built-in rules.
-Returns function's name as a string, or nil if outside a function."
-  :type '(choice (const nil) function)
-  :group 'change-log)
-
-(defcustom add-log-full-name nil
-  "*Full name of user, for inclusion in ChangeLog daily headers.
-This defaults to the value returned by the function `user-full-name'."
-  :type '(choice (const :tag "Default" nil)
-		 string)
-  :group 'change-log)
-
-(defcustom add-log-mailing-address nil
-  "*Electronic mail addresses of user, for inclusion in ChangeLog headers.
-This defaults to the value of `user-mail-address'.  In addition to
-being a simple string, this value can also be a list.  All elements
-will be recognized as referring to the same user; when creating a new
-ChangeLog entry, one element will be chosen at random."
-  :type '(choice (const :tag "Default" nil)
-		 (string :tag "String")
-		 (repeat :tag "List of Strings" string))
-  :group 'change-log)
-
-(defcustom add-log-time-format 'iso8601-time-string
-  "*Function that defines the time format.
-For example, `iso8601-time-string' (time in international ISO 8601 format)
-and `current-time-string' are valid values."
-  :type '(radio (const :tag "International ISO 8601 format" iso8601-time-string)
-		(const :tag "Old format, as returned by `current-time-string'"
-		       current-time-string)
-		(function :tag "Other"))
-  :group 'change-log)
-
-(defcustom add-log-keep-changes-together nil
-  "*If non-nil, normally keep day's log entries for one file together.
-
-Log entries for a given file made with \\[add-change-log-entry] or
-\\[add-change-log-entry-other-window] will only be added to others \
-for that file made
-today if this variable is non-nil or that file comes first in today's
-entries.  Otherwise another entry for that file will be started.  An
-original log:
-
-	* foo (...): ...
-	* bar (...): change 1
-
-in the latter case, \\[add-change-log-entry-other-window] in a \
-buffer visiting `bar', yields:
-
-	* bar (...): -!-
-	* foo (...): ...
-	* bar (...): change 1
-
-and in the former:
-
-	* foo (...): ...
-	* bar (...): change 1
-	(...): -!-
-
-The NEW-ENTRY arg to `add-change-log-entry' can override the effect of
-this variable."
-  :version "20.3"
-  :type 'boolean
-  :group 'change-log)
-
-(defcustom add-log-always-start-new-record nil
-  "*If non-nil, `add-change-log-entry' will always start a new record."
-  :version "21.4"
-  :type 'boolean
-  :group 'change-log)
-
-(defcustom add-log-buffer-file-name-function nil
-  "*If non-nil, function to call to identify the full filename of a buffer.
-This function is called with no argument.  If this is nil, the default is to
-use `buffer-file-name'."
-  :type '(choice (const nil) function)
-  :group 'change-log)
-
-(defcustom add-log-file-name-function nil
-  "*If non-nil, function to call to identify the filename for a ChangeLog entry.
-This function is called with one argument, the value of variable
-`buffer-file-name' in that buffer.  If this is nil, the default is to
-use the file's name relative to the directory of the change log file."
-  :type '(choice (const nil) function)
-  :group 'change-log)
-
-
-(defcustom change-log-version-info-enabled nil
-  "*If non-nil, enable recording version numbers with the changes."
-  :version "21.1"
-  :type 'boolean
-  :group 'change-log)
-
-(defcustom change-log-version-number-regexp-list
-  (let ((re    "\\([0-9]+\.[0-9.]+\\)"))
-    (list
-     ;;  (defconst ad-version "2.15"
-     (concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re)
-     ;; Revision: pcl-cvs.el,v 1.72 1999/09/05 20:21:54 monnier Exp
-     (concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re)))
-  "*List of regexps to search for version number.
-The version number must be in group 1.
-Note: The search is conducted only within 10%, at the beginning of the file."
-  :version "21.1"
-  :type '(repeat regexp)
-  :group 'change-log)
-
-;; XEmacs change: In the GNU/Emacs version these are all `defface's,
-;; but they use the `:inherit' keyword which doesn't exist in XEmacs.
-(make-face 'change-log-date-face
-	   "Face used to highlight dates in date lines.")
-(set-face-parent 'change-log-date-face 'font-lock-string-face)
-
-(make-face 'change-log-name-face
-	   "Face for highlighting author names.")
-(set-face-parent 'change-log-name-face 'font-lock-constant-face)
-
-(make-face 'change-log-email-face
-	   "Face for highlighting author email addresses.")
-(set-face-parent 'change-log-email-face 'font-lock-variable-name-face)
-
-(make-face 'change-log-file-face
-	   "Face for highlighting file names.")
-(set-face-parent 'change-log-file-face 'font-lock-function-name-face)
-
-(make-face 'change-log-list-face
-	   "Face for highlighting parenthesized lists of functions or variables.")
-(set-face-parent 'change-log-list-face 'font-lock-keyword-face)
-
-(make-face 'change-log-conditionals-face
-	   "Face for highlighting conditionals of the form `[...]'.")
-(set-face-parent 'change-log-conditionals-face 'font-lock-variable-name-face)
-
-(make-face 'change-log-function-face
-	   "Face for highlighting items of the form `<....>'.")
-(set-face-parent 'change-log-function-face 'font-lock-variable-name-face)
-
-(make-face 'change-log-acknowledgement-face
-	   "Face for highlighting acknowledgments.")
-(set-face-parent 'change-log-acknowledgement-face 'font-lock-comment-face)
-
-(defvar change-log-font-lock-keywords
-  '(;;
-    ;; Date lines, new and old styles.
-    ("^\\sw.........[0-9:+ ]*"
-     (0 'change-log-date-face)
-     ;; Name and e-mail; some people put e-mail in parens, not angles.
-     ("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil
-      (1 'change-log-name-face)
-      (2 'change-log-email-face)))
-    ;;
-    ;; File names.
-    ("^\t\\* \\([^ ,:([\n]+\\)"
-     (1 'change-log-file-face)
-     ;; Possibly further names in a list:
-     ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file-face))
-     ;; Possibly a parenthesized list of names:
-     ("\\= (\\([^) ,:\n]+\\)" nil nil (1 'change-log-list-face))
-     ("\\=, *\\([^) ,:\n]+\\)" nil nil (1 'change-log-list-face)))
-    ;;
-    ;; Function or variable names.
-    ("^\t(\\([^) ,:\n]+\\)"
-     (1 'change-log-list-face)
-     ("\\=, *\\([^) ,:\n]+\\)" nil nil (1 'change-log-list-face)))
-    ;;
-    ;; Conditionals.
-    ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals-face))
-    ;;
-    ;; Function of change.
-    ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function-face))
-    ;;
-    ;; Acknowledgements.
-    ("\\(^\t\\|  \\)\\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
-     2 'change-log-acknowledgement-face))
-  "Additional expressions to highlight in Change Log mode.")
-(put 'change-log-mode 'font-lock-defaults
-     '(change-log-font-lock-keywords t))
-
-(defvar change-log-mode-map (make-sparse-keymap)
-  "Keymap for Change Log major mode.")
-(define-key change-log-mode-map "\C-c\C-c" 'change-log-exit)
-(define-key change-log-mode-map "\C-c\C-k" 'change-log-cancel)
-
-(defvar change-log-time-zone-rule nil
-  "Time zone used for calculating change log time stamps.
-It takes the same format as the TZ argument of `set-time-zone-rule'.
-If nil, use local time.")
-
-(defun iso8601-time-zone (time)
-  (let* ((utc-offset (or (car (current-time-zone time)) 0))
-	 (sign (if (< utc-offset 0) ?- ?+))
-	 (sec (abs utc-offset))
-	 (ss (% sec 60))
-	 (min (/ sec 60))
-	 (mm (% min 60))
-	 (hh (/ min 60)))
-    (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
-		  ((not (zerop mm)) "%c%02d:%02d")
-		  (t "%c%02d"))
-	    sign hh mm ss)))
-
-;; Autoload this, because it can be generally useful.  It should
-;; probably be moved to another file, though.
-;;;###autoload
-(defun iso8601-time-string ()
-  (if change-log-time-zone-rule
-      (let ((tz (getenv "TZ"))
-	    (now (current-time)))
-	(unwind-protect
-	    (progn
-	      (set-time-zone-rule change-log-time-zone-rule)
-	      (concat
-	       (format-time-string "%Y-%m-%d " now)
-	       (iso8601-time-zone now)))
-	  (set-time-zone-rule tz)))
-    (format-time-string "%Y-%m-%d")))
-
-;;;###autoload
-(defun add-log-convert ()
-  "Convert the current buffer from the old ChangeLog format to new.
-The old ChangeLogs (before XEmacs 20.2) were created with attribution
-lines looking like this:
-
-Mon Feb 10 22:20:16 1997  Hrvoje Niksic  
-
-The same line in new format looks like this:
-
-1997-02-10  Hrvoje Niksic  "
-  (interactive)
-  (while (re-search-forward "^[^\t\n]+[0-9]+  " nil t)
-    (beginning-of-line)
-    ;; Some ChangeLogs contain interspersed old and new format.  If
-    ;; this is old format, just skip it.
-    (unless (save-match-data
-	      (looking-at "[0-9-]+ "))
-      (let* ((date (cdr (split-string (buffer-substring
-				       (point)
-				       (progn
-					 (re-search-forward "  [^0-9]")
-					 (goto-char (match-beginning 0)))))))
-	     (month (1+ (position (car date)
-				  '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
-				    "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
-				  :test 'equal)))
-	     (day (string-to-number (cadr date)))
-	     (year (string-to-number (cadddr date))))
-	(delete-region (point-at-bol) (- (search-forward "  ") 2))
-	(beginning-of-line)
-	(insert (format "%d-%02d-%02d" year month day))))
-    (forward-line 1)))
-
-(defun change-log-name ()
-  "Return default name for a change log file."
-  ;; XEmacs: remove VMS
-  (or change-log-default-name "ChangeLog"))
-
-;;;###autoload
-(defun prompt-for-change-log-name ()
-  "Prompt for a change log name."
-  (let* ((default (find-change-log))
-	 (name (expand-file-name
-		(read-file-name "Log file: "
-                                (file-name-directory default)
-                                default nil
-                                (file-name-nondirectory default)))))
-    ;; Handle something that is syntactically a directory name.
-    ;; Look for ChangeLog or whatever in that directory.
-    (if (string= (file-name-nondirectory name) "")
-	(expand-file-name (file-name-nondirectory default)
-			  name)
-      ;; Handle specifying a file that is a directory.
-      (if (file-directory-p name)
-	  (expand-file-name (file-name-nondirectory default)
-			    (file-name-as-directory name))
-	name))))
-
-(defun change-log-version-number-search ()
-  "Return version number of current buffer's file.
-This is the value returned by `vc-workfile-version' or, if that is
-nil, by matching `change-log-version-number-regexp-list'."
-  (let* ((size (buffer-size))
-	 (end
-	  ;; The version number can be anywhere in the file, but
-	  ;; restrict search to the file beginning: 10% should be
-	  ;; enough to prevent some mishits.
-	  ;;
-	  ;; Apply percentage only if buffer size is bigger than
-	  ;; approx 100 lines.
-	  (if (> size (* 100 80))
-	      (/ size 10)
-	    size))
-	 version)
-    (or (and buffer-file-name (vc-workfile-version buffer-file-name))
-	(save-restriction
-	  (widen)
-	  (let ((regexps change-log-version-number-regexp-list))
-	    (while regexps
-	      (save-excursion
-		(goto-char (point-min))
-		(when (re-search-forward (pop regexps) end t)
-		  (setq version (match-string 1)
-			regexps nil)))))))))
-
-
-;;;###autoload
-(defun find-change-log (&optional file-name buffer-file)
-  "Find a change log file for \\[add-change-log-entry] and return the name.
-
-Optional arg FILE-NAME specifies the file to use.
-If FILE-NAME is nil, use the value of `change-log-default-name'.
-If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
-\(or whatever we use on this operating system).
-
-If 'change-log-default-name' contains a leading directory component, then
-simply find it in the current directory.  Otherwise, search in the current
-directory and its successive parents for a file so named.
-
-Once a file is found, `change-log-default-name' is set locally in the
-current buffer to the complete file name.
-Optional arg BUFFER-FILE overrides `buffer-file-name'."
-  ;; If user specified a file name or if this buffer knows which one to use,
-  ;; just use that.
-  (or file-name
-      (setq file-name (and change-log-default-name
-			   (file-name-directory change-log-default-name)
-			   change-log-default-name))
-      (progn
-	;; Chase links in the source file
-	;; and use the change log in the dir where it points.
-	(setq file-name (or (and (or buffer-file buffer-file-name)
-				 (file-name-directory
-				  (file-chase-links
-				   (or buffer-file buffer-file-name))))
-			    default-directory))
-	(if (file-directory-p file-name)
-	    (setq file-name (expand-file-name (change-log-name) file-name)))
-	;; Chase links before visiting the file.
-	;; This makes it easier to use a single change log file
-	;; for several related directories.
-	(setq file-name (file-chase-links file-name))
-	(setq file-name (expand-file-name file-name))
-	;; Move up in the dir hierarchy till we find a change log file.
-	(let ((file1 file-name)
-	      parent-dir)
-	  (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
-		      (progn (setq parent-dir
-				   (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)
-					   parent-dir))))
-	    ;; Move up to the parent dir and try again.
-	    (setq file1 (expand-file-name
-			 (file-name-nondirectory (change-log-name))
-			 parent-dir)))
-	  ;; If we found a change log in a parent, use that.
-	  (if (or (get-file-buffer file1) (file-exists-p file1))
-	      (setq file-name file1)))))
-  ;; Make a local variable in this buffer so we needn't search again.
-  (set (make-local-variable 'change-log-default-name) file-name)
-  file-name)
-
-(defun add-log-file-name (buffer-file log-file)
-  ;; Never want to add a change log entry for the ChangeLog file itself.
-  (unless (or (null buffer-file) (string= buffer-file log-file))
-    (if add-log-file-name-function
-	(funcall add-log-file-name-function buffer-file)
-      (setq buffer-file
-	    (if (string-match
-		 (concat "^" (regexp-quote (file-name-directory log-file)))
-		 buffer-file)
-		(substring buffer-file (match-end 0))
-	      (file-name-nondirectory buffer-file)))
-      ;; If we have a backup file, it's presumably because we're
-      ;; comparing old and new versions (e.g. for deleted
-      ;; functions) and we'll want to use the original name.
-      (if (backup-file-name-p buffer-file)
-	  (file-name-sans-versions buffer-file)
-	buffer-file))))
-
-;;;###autoload
-(defun add-change-log-entry (&optional whoami file-name other-window new-entry)
-  "Find change log file, and add an entry for today and an item for this file.
-Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
-name and site.
-
-Second arg FILE-NAME is file name of the change log.
-If nil, use the value of `change-log-default-name'.
-
-Third arg OTHER-WINDOW non-nil means visit in other window.
-
-Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
-never append to an existing entry.  Option `add-log-keep-changes-together'
-otherwise affects whether a new entry is created.
-
-Option `add-log-always-start-new-record' non-nil means always create a
-new record, even when the last record was made on the same date and by
-the same person.
-
-The change log file can start with a copyright notice and a copying
-permission notice.  The first blank line indicates the end of these
-notices.
-
-Today's date is calculated according to `change-log-time-zone-rule' if
-non-nil, otherwise in local time."
-  (interactive (list current-prefix-arg
-		     (prompt-for-change-log-name)))
-  (or add-log-full-name
-      (setq add-log-full-name (user-full-name)))
-  (or add-log-mailing-address
-      (setq add-log-mailing-address (user-mail-address)))
-  (if whoami
-      (progn
-        (setq add-log-full-name (read-string "Full name: " add-log-full-name))
-	;; Note that some sites have room and phone number fields in
-	;; full name which look silly when inserted.  Rather than do
-	;; anything about that here, let user give prefix argument so that
-	;; s/he can edit the full name field in prompter if s/he wants.
-	(setq add-log-mailing-address
-	      (read-string "Mailing address: " add-log-mailing-address))))
-
-  (let* ((defun (add-log-current-defun))
-	 (version (and change-log-version-info-enabled
-		       (change-log-version-number-search)))
-	 (buf-file-name (if add-log-buffer-file-name-function
-			    (funcall add-log-buffer-file-name-function)
-			  buffer-file-name))
-	 (buffer-file (if buf-file-name (expand-file-name buf-file-name)))
-	 (file-name (expand-file-name
-		     (or file-name (find-change-log file-name buffer-file))))
-	 ;; Set ITEM to the file name to use in the new item.
-	 (item (add-log-file-name buffer-file file-name))
-	 bound)
-
-;; XEmacs:
-    (push-window-configuration)
-
-    (unless (equal file-name buffer-file-name)
-      (if (or other-window (window-dedicated-p (selected-window)))
-	  (find-file-other-window file-name)
-	(find-file file-name)))
-    (or (eq major-mode 'change-log-mode)
-	(change-log-mode))
-    (undo-boundary)
-    (goto-char (point-min))
-
-    ;; If file starts with a copyright and permission notice, skip them.
-    ;; Assume they end at first blank line.
-    (when (looking-at "Copyright")
-      (search-forward "\n\n")
-      (skip-chars-forward "\n"))
-
-    ;; Advance into first entry if it is usable; else make new one.
-    (let ((new-entries (mapcar (lambda (addr)
-				 (concat (funcall add-log-time-format)
-					 "  " add-log-full-name
-					 "  <" addr ">"))
-			       (if (consp add-log-mailing-address)
-				   add-log-mailing-address
-				 (list add-log-mailing-address)))))
-      (if (and (not add-log-always-start-new-record)
-               (let ((hit nil))
-		 (dolist (entry new-entries hit)
-		   (when (looking-at (regexp-quote entry))
-		     (setq hit t)))))
-	  (forward-line 1)
-	(insert (nth (random (length new-entries))
-		     new-entries)
-		"\n\n")
-	(forward-line -1)))
-
-    ;; Determine where we should stop searching for a usable
-    ;; item to add to, within this entry.
-    (setq bound
-	  (save-excursion
-            (if (looking-at "\n*[^\n* \t]")
-                (skip-chars-forward "\n")
-	      (if add-log-keep-changes-together
-		  (forward-page)	; page delimits entries for date
-		(forward-paragraph)))	; paragraph delimits entries for file
-	    (point)))
-
-    ;; Now insert the new line for this item.
-    (cond ((re-search-forward "^\\s *\\*\\s *$" bound t)
-	   ;; Put this file name into the existing empty item.
-	   (if item
-	       (insert item)))
-	  ((and (not new-entry)
-		(let (case-fold-search)
-		  (re-search-forward
-		   (concat (regexp-quote (concat "* " item))
-			   ;; Don't accept `foo.bar' when
-			   ;; looking for `foo':
-			   "\\(\\s \\|[(),:]\\)")
-		   bound t)))
-	   ;; Add to the existing item for the same file.
-	   (re-search-forward "^\\s *$\\|^\\s \\*")
-	   (goto-char (match-beginning 0))
-	   ;; Delete excess empty lines; make just 2.
-	   (while (and (not (eobp)) (looking-at "^\\s *$"))
-	     (delete-region (point) (point-at-bol 2)))
-	   (insert-char ?\n 2)
-	   (forward-line -2)
-	   (indent-relative-maybe))
-	  (t
-	   ;; Make a new item.
-	   (while (looking-at "\\sW")
-	     (forward-line 1))
-	   (while (and (not (eobp)) (looking-at "^\\s *$"))
-	     (delete-region (point) (point-at-bol 2)))
-	   (insert-char ?\n 3)
-	   (forward-line -2)
-	   (indent-to left-margin)
-	   (insert "* ")
-	   (if item (insert item))))
-    ;; Now insert the function name, if we have one.
-    ;; Point is at the item for this file,
-    ;; either at the end of the line or at the first blank line.
-    (if (not defun)
-	;; No function name, so put in a colon unless we have just a star.
-	(unless (save-excursion
-		  (beginning-of-line 1)
-		  (looking-at "\\s *\\(\\*\\s *\\)?$"))
-	  (insert ": ")
-	  (if version (insert version ?\ )))
-      ;; Make it easy to get rid of the function name.
-      (undo-boundary)
-      (unless (save-excursion
-		(beginning-of-line 1)
-		(looking-at "\\s *$"))
-	(insert ?\ ))
-      ;; See if the prev function name has a message yet or not.
-      ;; If not, merge the two items.
-      (let ((pos (point-marker)))
-	(skip-syntax-backward " ")
-	(skip-chars-backward "):")
-	(if (and (looking-at "):")
-		 (> fill-column (+ (current-column) (length defun) 4)))
-	    (progn (delete-region (point) pos) (insert ", "))
-	  (if (looking-at "):")
-	      (delete-region (+ 1 (point)) (point-at-eol)))
-	  (goto-char pos)
-	  (insert "("))
-	(set-marker pos nil))
-      (insert defun "): ")
-      (if version (insert version ?\ )))))
-
-;;;###autoload
-(defun add-change-log-entry-other-window (&optional whoami file-name)
-  "Find change log file in other window and add entry and item.
-This is just like `add-change-log-entry' except that it displays
-the change log file in another window."
-  (interactive (if current-prefix-arg
-		   (list current-prefix-arg
-			 (prompt-for-change-log-name))))
-  (add-change-log-entry whoami file-name t))
-;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
-
-;;;###autoload
-(define-derived-mode change-log-mode text-mode "Change Log"
-  "Major mode for editing change logs; like Indented Text Mode.
-Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
-New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
-Each entry behaves as a paragraph, and the entries for one day as a page.
-Runs `change-log-mode-hook'."
-  (setq left-margin 8
-	fill-column 74
-	indent-tabs-mode t
-	tab-width 8)
-  (set (make-local-variable 'fill-paragraph-function)
-       'change-log-fill-paragraph)
-  (set (make-local-variable 'indent-line-function) 'indent-to-left-margin)
-  ;; XEmacs change:
-  ;; Lines containing only a change descriptor:
-  ;;
-  ;; * add-log.el (change-log-mode):
-  ;;
-  ;; separate paragraphs and are not part of them.  Lines containing a
-  ;; change descriptor followed by text are the start of a paragraph,
-  ;; and filled with the text following.  This caters to both styles
-  ;; of annotations, e.g.
-
-; 	* func-menu.el (fume-function-name-regexp-make): Use `\s_' symbol
-; 	class instead of hardcoded `_' and `/' characters.
-
-  ;; and
-
-; 	* func-menu.el (fume-function-name-regexp-make):
-; 	Use `\s_' symbol class instead of hardcoded `_' and `/'
-; 	characters.
-
-  ;; We really do want "^" in paragraph-start below: it is only the
-  ;; lines that begin at column 0 (despite the left-margin of 8) that
-  ;; we are looking for.  Adding `* ' allows eliding the blank line
-  ;; between entries for different files.
-  (let ((change-descriptor "\\*\\s +\\S +\\(\\s +(\\S +)\\)?:"))
-    (set (make-local-variable 'paragraph-start)
-	 (concat "\\s *$\\|\f\\|^\\<\\|" change-descriptor))
-    ;; FSF comment: (?)
-    ;; Let all entries for one day behave as one page.
-    (set (make-local-variable 'paragraph-separate)
-	 (concat "\\s *$\\|\f\\|^\\<\\|" change-descriptor "\\s *$")))
-  ;; Match null string on the date-line so that the date-line
-  ;; is grouped with what follows.
-  (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
-  (set (make-local-variable 'version-control) 'never)
-  (set (make-local-variable 'smerge-resolve-function)
-       'change-log-resolve-conflict)
-  (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
-  ;; XEmacs change:
-;   (set (make-local-variable 'font-lock-defaults)
-;        '(change-log-font-lock-keywords t nil nil backward-paragraph)))
-  ;; XEmacs:
-  (when (boundp 'filladapt-mode)
-    ;; Filladapt works badly with ChangeLogs.  Still, we disable it
-    ;; before change-log-mode-hook, so the users can override this
-    ;; choice. #### Maybe not true anymore now that we are a derived mode.
-    (setq filladapt-mode nil)))
-
-(defun change-log-exit ()
-  "Save the change-log buffer, and restores the old window configuration.
-Buries the buffer."
-  (interactive)
-  (save-buffer)
-  (let ((buf (current-buffer)))
-    (pop-window-configuration)
-    (bury-buffer buf)))
-
-(defun change-log-cancel ()
-  "Cancel the changes to change-log buffer.
-This kills the buffer without saving, and restores the old window
- configuration."
-  (interactive)
-  (kill-buffer (current-buffer))
-  (pop-window-configuration))
-
-;; It might be nice to have a general feature to replace this.  The idea I
-;; have is a variable giving a regexp matching text which should not be
-;; moved from bol by filling.  change-log-mode would set this to "^\\s *\\s(".
-;; But I don't feel up to implementing that today.
-(defun change-log-fill-paragraph (&optional justify)
-  "Fill the paragraph, but preserve open parentheses at beginning of lines.
-Prefix arg means justify as well."
-  (interactive "P")
-  (let ((end (progn (forward-paragraph) (point)))
-	(beg (progn (backward-paragraph) (point)))
-	(paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
-    (fill-region beg end justify)
-    t))
-
-(defcustom add-log-current-defun-header-regexp
-  ;; XEmacs change
-  "^\\([[:upper:]][[:upper:]_0-9 ]*[[:upper:]_0-9]\\|[-_.[:alpha:]0-9]+\\)[ \t]*[:=]"
-  "*Heuristic regexp used by `add-log-current-defun' for unknown major modes."
-  :type 'regexp
-  :group 'change-log)
-
-;;;###autoload
-(defvar add-log-lisp-like-modes
-    '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode)
-  "*Modes that look like Lisp to `add-log-current-defun'.")
-
-;;;###autoload
-(defvar add-log-c-like-modes
-    '(c-mode c++-mode c++-c-mode objc-mode java-mode)
-  "*Modes that look like C to `add-log-current-defun'.")
-
-;;;###autoload
-(defvar add-log-tex-like-modes
-    '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode)
-  "*Modes that look like TeX to `add-log-current-defun'.")
-
-(defun-when-void 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)))))
-
-;;;###autoload
-(defun add-log-current-defun ()
-  "Return name of function definition point is in, or nil.
-
-Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
-Texinfo (@node titles) and Perl.
-
-Other modes are handled by a heuristic that looks in the 10K before
-point for uppercase headings starting in the first column or
-identifiers followed by `:' or `='.  See variables
-`add-log-current-defun-header-regexp' and
-`add-log-current-defun-function'.
-
-Has a preference of looking backwards."
-  (condition-case nil
-      (save-excursion
-	(let ((location (point)))
-	  (cond (add-log-current-defun-function
-		 (funcall add-log-current-defun-function))
-		((memq major-mode add-log-lisp-like-modes)
-		 ;; If we are now precisely at the beginning of a defun,
-		 ;; make sure beginning-of-defun finds that one
-		 ;; rather than the previous one.
-		 (or (eobp) (forward-char 1))
-		 (beginning-of-defun)
-		 ;; Make sure we are really inside the defun found,
-		 ;; not after it.
-		 (when (and (looking-at "\\s(")
-			    (progn (end-of-defun)
-				   (< location (point)))
-			    (progn (forward-sexp -1)
-				   (>= location (point))))
-		   (if (looking-at "\\s(")
-		       (forward-char 1))
-		   ;; Skip the defining construct name, typically "defun"
-		   ;; or "defvar".
-		   (forward-sexp 1)
-		   ;; The second element is usually a symbol being defined.
-		   ;; If it is not, use the first symbol in it.
-		   (skip-chars-forward " \t\n'(")
-		   (buffer-substring-no-properties (point)
-						   (progn (forward-sexp 1)
-							  (point)))))
-		((and (memq major-mode add-log-c-like-modes)
-		      (save-excursion
-			(beginning-of-line)
-			;; Use eq instead of = here to avoid
-			;; error when at bob and char-after
-			;; returns nil.
-			(while (eq (char-after (- (point) 2)) ?\\)
-			  (forward-line -1))
-			(looking-at "[ \t]*#[ \t]*define[ \t]")))
-		 ;; Handle a C macro definition.
-		 (beginning-of-line)
-		 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
-		   (forward-line -1))
-		 (search-forward "define")
-		 (skip-chars-forward " \t")
-		 (buffer-substring-no-properties (point)
-						 (progn (forward-sexp 1)
-							(point))))
-		((memq major-mode add-log-c-like-modes)
-		 (beginning-of-line)
-		 ;; See if we are in the beginning part of a function,
-		 ;; before the open brace.  If so, advance forward.
-		 (while (not (looking-at "{\\|\\(\\s *$\\)"))
-		   (forward-line 1))
-		 (or (eobp)
-		     (forward-char 1))
-		 (beginning-of-defun)
-		 (when (progn (end-of-defun)
-			      (< location (point)))
-		   (backward-sexp 1)
-		   (let (beg tem)
-
-		     (forward-line -1)
-		     ;; Skip back over typedefs of arglist.
-		     (while (and (not (bobp))
-				 (looking-at "[ \t\n]"))
-		       (forward-line -1))
-		     ;; See if this is using the DEFUN macro used in Emacs,
-		     ;; or the DEFUN macro used by the C library.
-		     (if (condition-case nil
-			     (and (save-excursion
-				    (end-of-line)
-				    (while (= (preceding-char) ?\\)
-				      (end-of-line 2))
-				    (backward-sexp 1)
-				    (beginning-of-line)
-				    (setq tem (point))
-				    (looking-at "DEFUN\\b"))
-				  (>= location tem))
-			   (error nil))
-			 (progn
-			   (goto-char tem)
-			   (down-list 1)
-			   (if (= (char-after (point)) ?\")
-			       (progn
-				 (forward-sexp 1)
-				 (skip-chars-forward " ,")))
-			   (buffer-substring-no-properties
-			    (point)
-			    (progn (forward-sexp 1)
-				   (point))))
-		       (if (looking-at "^[+-]")
-			   (change-log-get-method-definition)
-			 ;; Ordinary C function syntax.
-			 (setq beg (point))
-			 (if (and
-			      ;; Protect against "Unbalanced parens" error.
-			      (condition-case nil
-				  (progn
-				    (down-list 1) ; into arglist
-				    (backward-up-list 1)
-				    (skip-chars-backward " \t")
-				    t)
-				(error nil))
-			      ;; Verify initial pos was after
-			      ;; real start of function.
-			      (save-excursion
-				(goto-char beg)
-				;; For this purpose, include the line
-				;; that has the decl keywords.  This
-				;; may also include some of the
-				;; comments before the function.
-				(while (and (not (bobp))
-					    (save-excursion
-					      (forward-line -1)
-					      (looking-at "[^\n\f]")))
-				  (forward-line -1))
-				(>= location (point)))
-			      ;; Consistency check: going down and up
-			      ;; shouldn't take us back before BEG.
-			      (> (point) beg))
-			     (let (end middle)
-			       ;; Don't include any final whitespace
-			       ;; in the name we use.
-			       (skip-chars-backward " \t\n")
-			       (setq end (point))
-			       (backward-sexp 1)
-			       ;; Now find the right beginning of the name.
-			       ;; Include certain keywords if they
-			       ;; precede the name.
-			       (setq middle (point))
-			       (forward-word -1)
-			       ;; Ignore these subparts of a class decl
-			       ;; and move back to the class name itself.
-			       (while (looking-at "public \\|private ")
-				 (skip-chars-backward " \t:")
-				 (setq end (point))
-				 (backward-sexp 1)
-				 (setq middle (point))
-				 (forward-word -1))
-			       (and (bolp)
-				    (looking-at
-				     "enum \\|struct \\|union \\|class ")
-				    (setq middle (point)))
-			       (goto-char end)
-			       (when (eq (preceding-char) ?=)
-				 (forward-char -1)
-				 (skip-chars-backward " \t")
-				 (setq end (point)))
-			       (buffer-substring-no-properties
-				middle end))))))))
-		((memq major-mode add-log-tex-like-modes)
-		 (if (re-search-backward
-		      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
-		      nil t)
-		     (progn
-		       (goto-char (match-beginning 0))
-		       (buffer-substring-no-properties
-			(1+ (point))	; without initial backslash
-			(point-at-eol)))))
-		((eq major-mode 'texinfo-mode)
-		 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
-		     (match-string-no-properties 1)))
-		((memq major-mode '(perl-mode cperl-mode))
-		 (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
-		     (match-string-no-properties 1)))
-		;; Emacs's autoconf-mode installs its own
-		;; `add-log-current-defun-function'.  This applies to
-		;; a different mode apparently for editing .m4
-		;; autoconf source.
-                ((eq major-mode 'autoconf-mode)
-                 (if (re-search-backward
-		      "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t)
-                     (match-string-no-properties 3)))
-		(t
-		 ;; If all else fails, try heuristics
-		 (let (case-fold-search
-		       result)
-		   (end-of-line)
-		   (when (re-search-backward
-			  add-log-current-defun-header-regexp
-			  (- (point) 10000)
-			  t)
-		     (setq result (or (match-string-no-properties 1)
-				      (match-string-no-properties 0)))
-		     ;; Strip whitespace away
-		     (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)"
-					 result)
-		       (setq result (match-string-no-properties 1 result)))
-		     result))))))
-    (error nil)))
-
-(defvar change-log-get-method-definition-md)
-
-;; Subroutine used within change-log-get-method-definition.
-;; Add the last match in the buffer to the end of `md',
-;; followed by the string END; move to the end of that match.
-(defun change-log-get-method-definition-1 (end)
-  (setq change-log-get-method-definition-md
-	(concat change-log-get-method-definition-md
-		(match-string 1)
-		end))
-  (goto-char (match-end 0)))
-
-(defun change-log-get-method-definition ()
-"For objective C, return the method name if we are in a method."
-  (let ((change-log-get-method-definition-md "["))
-    (save-excursion
-      (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
-	  (change-log-get-method-definition-1 " ")))
-    (save-excursion
-      (cond
-       ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
-	(change-log-get-method-definition-1 "")
-	(while (not (looking-at "[{;]"))
-	  (looking-at
-	   "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
-	  (change-log-get-method-definition-1 ""))
-	(concat change-log-get-method-definition-md "]"))))))
-
-(defun change-log-sortable-date-at ()
-  "Return date of log entry in a consistent form for sorting.
-Point is assumed to be at the start of the entry."
-  (require 'timezone)
-  (if (looking-at "^\\sw.........[0-9:+ ]*")
-      (let ((date (match-string-no-properties 0)))
-	(if date
-	    (if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date)
-		(concat (match-string 1 date) (match-string 2 date)
-			(match-string 3 date))
-	      (condition-case nil
-		  (timezone-make-date-sortable date)
-		(error nil)))))
-    (error "Bad date")))
-
-(defun change-log-resolve-conflict ()
-  "Function to be used in `smerge-resolve-function'."
-  (let ((buf (current-buffer)))
-    (with-temp-buffer
-      (insert-buffer-substring buf (match-beginning 1) (match-end 1))
-      (save-match-data (change-log-mode))
-      (let ((other-buf (current-buffer)))
-	(with-current-buffer buf
-	  (save-excursion
-	    (save-restriction
-	      (narrow-to-region (match-beginning 0) (match-end 0))
-	      (replace-match (match-string 3) t t)
-	      (change-log-merge other-buf))))))))
-
-;;;###autoload
-(defun change-log-merge (other-log)
-  "Merge the contents of ChangeLog file OTHER-LOG with this buffer.
-Both must be found in Change Log mode (since the merging depends on
-the appropriate motion commands).  OTHER-LOG can be either a file name
-or a buffer.
-
-Entries are inserted in chronological order.  Both the current and
-old-style time formats for entries are supported."
-  (interactive "*fLog file name to merge: ")
-  (if (not (eq major-mode 'change-log-mode))
-      (error "Not in Change Log mode"))
-  (let ((other-buf (if (bufferp other-log) other-log
-		     (find-file-noselect other-log)))
-	(buf (current-buffer))
-	date1 start end)
-    (save-excursion
-      (goto-char (point-min))
-      (set-buffer other-buf)
-      (goto-char (point-min))
-      (if (not (eq major-mode 'change-log-mode))
-	  (error "%s not found in Change Log mode" other-log))
-      ;; Loop through all the entries in OTHER-LOG.
-      (while (not (eobp))
-	(setq date1 (change-log-sortable-date-at))
-	(setq start (point)
-	      end (progn (forward-page) (point)))
-	;; Look for an entry in original buffer that isn't later.
-	(with-current-buffer buf
-	  (while (and (not (eobp))
-		      (string< date1 (change-log-sortable-date-at)))
-	    (forward-page))
-	  (if (not (eobp))
-	      (insert-buffer-substring other-buf start end)
-	    ;; At the end of the original buffer, insert a newline to
-	    ;; separate entries and then the rest of the file being
-	    ;; merged.
-	    (unless (or (bobp)
-			(and (= ?\n (char-before))
-			     (or (<= (1- (point)) (point-min))
-				 (= ?\n (char-before (1- (point)))))))
-	      (insert "\n"))
-	    ;; Move to the end of it to terminate outer loop.
-	    (with-current-buffer other-buf
-	      (goto-char (point-max)))
-	    (insert-buffer-substring other-buf start)))))))
-
-;;;###autoload
-(defun patch-to-change-log (devdir &rest cl-keys)
-  "Convert the unified diff in the current buffer into a ChangeLog.
-DEVDIR (queried interactively) specifies the directory the diff was
-made relative to.  The ChangeLog entries are added to the appropriate
-ChangeLog files (generally in the same directory as the diffed file but
-possibly in a parent directory), which are left as modified Emacs buffers
-but not saved out to disk.  After running this, you should go to the various
-buffers and annotate the entries appropriately.
-
-To work on a region on the current buffer, narrow to that region first.
-
-NOTE: This function handles diff output both from `cvs diff' and just
-running `diff' directly, but *ONLY* unified-format (-u) diffs. #### Someone
-should fix this to handle context diffs as well.
-
-The following keys are allowed:
-- :my-name defines the name to use in ChangeLog entries
-  (defaults to `(or add-log-full-name (user-full-name))'),
-- :my-email defines the email address to use in ChangeLog entries
-  (defaults to `(or add-log-mailing-address (user-mail-address))'),
-- :dry-run prevents `patch-to-changelog' from generating the ChangeLog
-   entries: ChangeLog files are only loaded (defaults to nil),
-- :keep-source-files prevents `patch-to-changelog' from killing the source
-  file buffers after the ChangeLog skeleton is created
-  (defaults to nil),
-- :extent-property instructs `patch-to-changelog' to create extents
-  containing the newly created ChangeLog entries, with that property set
-  (defaults to nil),
-- :extent-property-value is used in conjunction with :extent-property to
-  specify a value for the extent property
-  (defaults to nil)."
-  (interactive "DBase directory of patch: ")
-  (cl-parsing-keywords
-      ((:my-name (or add-log-full-name (user-full-name)))
-       (:my-email (or add-log-mailing-address (user-mail-address)))
-       :dry-run :keep-source-files :extent-property :extent-property-value)
-      ()
-    (let* ((old-font-lock-auto-fontify font-lock-auto-fontify)
-	   (font-lock-auto-fontify nil)
-	   (file-re1 "^Index: \\([^\n]*\\)")
-	   (file-re2 "^\\+\\+\\+ \\([^\t]*\\)")
-	   (hunk-re "^@@ -[0-9]+,[0-9]+ \\+\\([0-9]+\\),\\([0-9]+\\) @@")
-	   (basename-re "\\`\\(.*\\)/\\(.*\\)\\'")
-	   (lisp-defun-re "(def[a-z-]* \\([^ \n]+\\)")
-; 	   (c-token-re "[][_a-zA-Z0-9]+")
-; 	   (ws-re "\\(\\s-\\|\n\\+\\)*")
-; 	   (c-multi-token-re (concat c-token-re "\\(" ws-re c-token-re "\\)*"))
-; 	   (c-defun-re (concat "^+\\(" c-token-re ws-re "\\)*"
-; 			       "\\(" c-token-re "\\)" ws-re "(" ws-re
-; 			       "\\("
-; 			       c-multi-token-re ws-re
-; 			       "\\(," ws-re c-multi-token-re ws-re "\\)*"
-; 			       "\\)?" ws-re ")" ws-re "{" ws-re "$"))
-	   (new-defun-re (concat "^\\+" lisp-defun-re))
-	   (nomore-defun-re (concat "^-" lisp-defun-re))
-           (new-heuristic-fun-re
-            (concat "^\\+" (substring add-log-current-defun-header-regexp 1)))
-           (nomore-heuristic-fun-re
-            (concat "^-" (substring add-log-current-defun-header-regexp 1)))
-	   (done-hash       (make-hash-table :size 20 :test 'equal))
-	   (new-fun-hash    (make-hash-table :size 20 :test 'equal))
-	   (nomore-fun-hash (make-hash-table :size 20 :test 'equal))
-	   (new-heuristic-fun-hash    (make-hash-table :size 20 :test 'equal))
-	   (nomore-heuristic-fun-hash (make-hash-table :size 20 :test 'equal))
-	   change-log-buffer change-log-buffers change-log-directory
-	   file absfile limit current-defun
-	   dirname basename previous-dirname
-	   all-entries first-file-re-p
-	   insertion-marker
-	   )
-
-      (flet
-	  ((add-change-log-string
-	    (str)
-	    (with-current-buffer change-log-buffer
-	      (goto-char insertion-marker)
-	      (insert-before-markers str)))
-
-	   (add-entry
-	    (filename line fun str)
-	    (let ((entry (cons filename fun)))
-	      (unless (or (gethash entry done-hash)
-			  (string-match "\n." str))
-		;; (message "%s %S" str (gethash entry done-hash))
-		(puthash entry t done-hash)
-		(push (cons str line) all-entries))))
-
-	   (flush-change-log-entries
-	    ()
-	    (setq all-entries (sort all-entries #'cdr-less-than-cdr))
-	    (mapc #'(lambda (entry)
-		      (add-change-log-string (car entry)))
-		  all-entries)
-	    (setq all-entries nil))
-
-	   (line-num () (1+ (count-lines (point-min) (point-at-bol))))
-
-	   (finish-up-change-log-buffer
-	    ()
-	    (push change-log-buffer change-log-buffers)
-	    (unless cl-dry-run
-	      (add-change-log-string "\n"))
-	    (with-current-buffer change-log-buffer
-	      (goto-char (point-min)))))
-
-	(save-excursion
-	  (goto-char (point-min))
-	  (while (or (prog1 (re-search-forward file-re1 nil t)
-		       (setq first-file-re-p t))
-		     (prog1 (re-search-forward file-re2 nil t)
-		       (setq first-file-re-p nil)))
-	    (setq file (match-string 1))
-	    (if (string-match basename-re file)
-		(setq dirname  (match-string 1 file)
-		      basename (match-string 2 file))
-	      (setq dirname "" basename file))
-	    (setq absfile (expand-file-name file devdir))
-	    (setq limit
-		  (save-excursion (or (re-search-forward
-				       (if first-file-re-p file-re1 file-re2)
-				       nil t)
-				      (point-max))))
-	    (when (not (equal dirname previous-dirname))
-	      (if previous-dirname
-		  (finish-up-change-log-buffer))
-	      (setq previous-dirname dirname)
-	      (setq change-log-buffer
-		    (let ((font-lock-auto-fontify
-			   old-font-lock-auto-fontify))
-		      (find-file-noselect
-		       ;; APA: find a change-log relative to current directory.
-		       (with-temp-buffer
-			 (cd (expand-file-name dirname devdir))
-			 (find-change-log)))))
-	      (setq change-log-directory
-		    (with-current-buffer change-log-buffer default-directory))
-	      (unless cl-dry-run
-		(when cl-extent-property
-		  (with-current-buffer change-log-buffer
-		    (set-extent-properties
-			(make-extent (point-min) (point-min))
-		      (list 'end-open nil
-			    cl-extent-property cl-extent-property-value))))
-		(setq insertion-marker (point-min-marker change-log-buffer))
-		(add-change-log-string
-		 (format (concat "%s  " cl-my-name "  <" cl-my-email
-				 ">\n\n")
-			 (iso8601-time-string)))))
-            ;; APA: Standardize on / in ChangeLog entry paths.
-            (let ((directory-sep-char ?/))
-              (setq basename
-                    (file-relative-name absfile change-log-directory)))
-	    ;; now do each hunk in turn.
-	    (unless cl-dry-run
-	      (while (re-search-forward hunk-re limit t)
-		(let* ((hunk-start-line (line-num))
-		       (first-file-line (string-to-int (match-string 1)))
-		       (hunk-limit
-			(save-excursion (or (and
-					     (re-search-forward hunk-re limit
-								t)
-					     (match-beginning 0))
-					    limit)))
-		       ;; numlines is the number of lines in the hunk, not
-		       ;; the number of file lines affected by the hunk, i.e.
-		       ;; (match-string 2), which is generally less
-		       (numlines (1- (- (save-excursion
-					  (goto-char hunk-limit)
-					  (line-num))
-					hunk-start-line))))
-
-		  ;; do added and/or removed functions.
-		  (clrhash new-fun-hash)
-		  (clrhash nomore-fun-hash)
-		  (save-excursion
-		    (while (re-search-forward new-defun-re hunk-limit t)
-		      (puthash (match-string 1)
-			       (1- (- (line-num) hunk-start-line))
-			       new-fun-hash)))
-		  (save-excursion
-		    (while (re-search-forward nomore-defun-re hunk-limit t)
-		      (let ((fun (match-string 1)))
-			(if (gethash fun new-fun-hash)
-			    (remhash fun new-fun-hash)
-			  (puthash fun
-				   (1- (- (line-num) hunk-start-line))
-				   nomore-fun-hash)))))
-		  ;; do added and/or removed variable heuristics.
-		  (clrhash new-heuristic-fun-hash)
-		  (clrhash nomore-heuristic-fun-hash)
-		  (save-excursion
-		    (while (re-search-forward
-                            new-heuristic-fun-re hunk-limit t)
-		      (let ((fun (match-string 1)))
-                        (unless (gethash fun new-fun-hash)
-                          (puthash (match-string 1)
-                                   (1- (- (line-num) hunk-start-line))
-                                   new-heuristic-fun-hash)))))
-		  (save-excursion
-		    (while (re-search-forward
-                            nomore-heuristic-fun-re hunk-limit t)
-		      (let ((fun (match-string 1)))
-			(if (gethash fun new-heuristic-fun-hash)
-			    (remhash fun new-heuristic-fun-hash)
-                          (unless (gethash fun nomore-fun-hash)
-                            (puthash fun
-                                     (1- (- (line-num) hunk-start-line))
-                                     nomore-heuristic-fun-hash))))))
-		  (maphash
-		   #'(lambda (fun val)
-		       (add-entry
-			basename
-			;; this is not a perfect measure of the actual
-			;; file line, but good enough for sorting.
-			(+ first-file-line val)
-			fun
-			(format "\t* %s (%s): New.\n" basename fun)))
-		   new-fun-hash)
-		  (maphash
-		   #'(lambda (fun val)
-		       (add-entry
-			basename
-			(+ first-file-line val)
-			fun
-			(format "\t* %s (%s): Removed.\n" basename fun)))
-		   nomore-fun-hash)
-                  (maphash
-                   #'(lambda (fun val)
-                       (add-entry
-                        basename
-                        ;; this is not a perfect measure of the actual
-                        ;; file line, but good enough for sorting.
-                        (+ first-file-line val)
-                        fun
-                        (format "\t* %s (%s): New.\n" basename fun)))
-                   new-heuristic-fun-hash)
-                  (maphash
-                   #'(lambda (fun val)
-                       (add-entry
-                        basename
-                        (+ first-file-line val)
-                        fun
-                        (format "\t* %s (%s): Removed.\n" basename fun)))
-                   nomore-heuristic-fun-hash)
-
-		  ;; now try to handle what changed.
-		  (let (trylines
-			(trystart t)
-			(line-in-file first-file-line))
-
-		    ;; accumulate a list of lines to check.  we check
-		    ;; only changed lines, and only the first such line
-		    ;; per blank-line-delimited block (we assume all
-		    ;; functions are preceded by a blank line).
-		    (save-excursion
-		      (dotimes (n numlines)
-			(forward-line 1)
-			(if (looking-at ".\n")
-			    (setq trystart t))
-			(when (not (eq ?  (char-after)))
-			  (when trystart
-			    (setq trylines (cons line-in-file trylines))
-			    (setq trystart nil)))
-			;; N is not an accurate gauge of the file line,
-			;; because of the presence of deleted lines in the
-			;; hunk.
-			(when (not (eq ?- (char-after)))
-			  (incf line-in-file))))
-		    (setq trylines (nreverse trylines))
-		    (save-excursion
-		      (let ((already-visiting-p (get-file-buffer absfile)))
-			(set-buffer (find-file-noselect absfile))
-			(mapc #'(lambda (n)
-				  (goto-line n)
-				  (setq current-defun (add-log-current-defun))
-				  (add-entry
-				   basename
-				   (if current-defun n 0)
-				   current-defun
-				   (format (if current-defun
-					       "\t* %s (%s):\n" "\t* %s:\n")
-					   basename current-defun)))
-			      trylines)
-			(unless (or already-visiting-p cl-keep-source-files)
-			  (kill-buffer (current-buffer))))))))
-	      (flush-change-log-entries))
-	    ))
-        ;; the patch might be totally blank.
-	(if change-log-buffer
-	    (finish-up-change-log-buffer))
-	;; return the list of ChangeLog buffers
-	change-log-buffers))))
-
-;;;###autoload
-(defun change-log-redate ()
-  "Fix any old-style date entries in the current log file to default format."
-  (interactive)
-  (require 'timezone)
-  (save-excursion
-    (goto-char (point-min))
-    (while (re-search-forward "^\\sw.........[0-9:+ ]*" nil t)
-      (unless (= 12 (- (match-end 0) (match-beginning 0)))
-	(let* ((date (save-match-data
-		       (timezone-fix-time (match-string 0) nil nil)))
-	       (zone (if (consp (aref date 6))
-			 (nth 1 (aref date 6)))))
-	  (replace-match (format-time-string
-			  "%Y-%m-%d  "
-			  (encode-time (aref date 5)
-				       (aref date 4)
-				       (aref date 3)
-				       (aref date 2)
-				       (aref date 1)
-				       (aref date 0)
-				       zone))))))))
-
-;; XEmacs additions
-;;;###autoload(add-to-list 'auto-mode-alist '("[Cc]hange.?[Ll]og?\\(?:.[0-9]+\\)?\\'" . change-log-mode))
-;;;###autoload(add-to-list 'auto-mode-alist '("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode))
-
-(provide 'add-log)
-
-;;; add-log.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/advice.el b/xemacs-packages/lisp/xemacs-base/advice.el
deleted file mode 100644
index 13367589..00000000
--- a/xemacs-packages/lisp/xemacs-base/advice.el
+++ /dev/null
@@ -1,3971 +0,0 @@
-;;; advice.el --- an overloading mechanism for Emacs Lisp functions
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Hans Chalupsky 
-;; Created: 12 Dec 1992
-;; Version: advice.el,v 2.14 1994/08/05 03:42:04 hans Exp
-;; Keywords: extensions, lisp, tools
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;; LCD Archive Entry:
-;; advice|Hans Chalupsky|hans@cs.buffalo.edu|
-;; Overloading mechanism for Emacs Lisp functions|
-;; 1994/08/05 03:42:04|2.14|~/packages/advice.el.Z|
-
-;;; Synched up with: FSF 19.34 (In a fashion.  Many comments are dated).
-
-;;; Commentary:
-
-;; NOTE: This documentation is slightly out of date. In particular, all the
-;; references to Emacs-18 are obsolete now, because it is not any longer
-;; supported by this version of Advice. An up-to-date version will soon be
-;; available as an info file (thanks to the kind help of Jack Vinson and
-;; David M. Smith).
-
-;; @ Introduction:
-;; ===============
-;; This package implements a full-fledged Lisp-style advice mechanism
-;; for Emacs Lisp. Advice is a clean and efficient way to modify the 
-;; behavior of Emacs Lisp functions without having to keep  personal
-;; modified copies of such functions around. A great number of such 
-;; modifications can be achieved by treating the original function as a 
-;; black box and specifying a different execution environment for it 
-;; with a piece of advice. Think of a piece of advice as a kind of fancy
-;; hook that you can attach to any function/macro/subr.
-
-;; @ Highlights:
-;; =============
-;; - Clean definition of multiple, named before/around/after advices
-;;   for functions, macros, subrs and special forms
-;; - Full control over the arguments an advised function will receive,
-;;   the binding environment in which it will be executed, as well as the
-;;   value it will return.
-;; - Allows re/definition of interactive behavior for functions and subrs
-;; - Every piece of advice can have its documentation string which will be 
-;;   combined with the original documentation of the advised function at
-;;   call-time of `documentation' for proper command-key substitution.
-;; - The execution of every piece of advice can be protected against error
-;;   and non-local exits in preceding code or advices.
-;; - Simple argument access either by name, or, more portable but as
-;;   efficient, via access macros
-;; - Allows the specification of a different argument list for the advised
-;;   version of a function.
-;; - Advised functions can be byte-compiled either at file-compile time
-;;   (see preactivation) or activation time.
-;; - Separation of advice definition and activation
-;; - Forward advice is possible, that is
-;;   as yet undefined or autoload functions can be advised without having to
-;;   preload the file in which they are defined. 
-;; - Forward redefinition is possible because around advice can be used to
-;;   completely redefine a function.
-;; - A caching mechanism for advised definition provides for cheap deactivation
-;;   and reactivation of advised functions.
-;; - Preactivation allows efficient construction and compilation of advised
-;;   definitions at file compile time without giving up the flexibility of
-;;   the advice mechanism.
-;; - En/disablement mechanism allows the use of  different "views" of advised
-;;   functions depending on what pieces of advice are currently en/disabled
-;; - Provides manipulation mechanisms for sets of advised functions via 
-;;   regular expressions that match advice names
-
-;; @ How to get Advice for Emacs-18:
-;; =================================
-;; `advice18.el', a version of Advice that also works in Emacs-18 is available
-;; either via anonymous ftp from `ftp.cs.buffalo.edu (128.205.32.9)' with 
-;; pathname `/pub/Emacs/advice18.el', or from one of the Emacs Lisp archive
-;; sites, or send email to  and I'll mail it to you.
-
-;; @ Overview, or how to read this file:
-;; =====================================
-;; NOTE: This documentation is slightly out of date. In particular, all the
-;; references to Emacs-18 are obsolete now, because it is not any longer
-;; supported by this version of Advice. An up-to-date version will soon be
-;; available as an info file (thanks to the kind help of Jack Vinson and
-;; David M. Smith). Until then you can use `outline-mode' to help you read
-;; this documentation (set `outline-regexp' to `";; @+"').
-;;
-;; The four major sections of this file are:
-;;
-;;   @ This initial information       ...installation, customization etc.
-;;   @ Advice documentation:          ...general documentation
-;;   @ Foo games: An advice tutorial  ...teaches about Advice by example
-;;   @ Advice implementation:         ...actual code, yeah!!
-;;
-;; The latter three are actual headings which you can search for
-;; directly in case `outline-mode' doesn't work for you.
-
-;; @ Restrictions:
-;; ===============
-;; - Only works with Emacs 19.26 or later and XEmacs 19.12 or later.
-;; - Advised functions/macros/subrs will only exhibit their advised behavior
-;;   when they are invoked via their function cell. This means that advice will
-;;   not work for the following:
-;;   + advised subrs that are called directly from other subrs or C-code 
-;;   + advised subrs that got replaced with their byte-code during 
-;;     byte-compilation (e.g., car)
-;;   + advised macros which were expanded during byte-compilation before
-;;     their advice was activated.
-
-;; @ Credits:
-;; ==========
-;; This package is an extension and generalization of packages such as
-;; insert-hooks.el written by Noah S. Friedman, and advise.el written by
-;; Raul J. Acevedo. Some ideas used in here come from these packages,
-;; others come from the various Lisp advice mechanisms I've come across
-;; so far, and a few are simply mine.
-
-;; @ Comments, suggestions, bug reports:
-;; =====================================
-;; If you find any bugs, have suggestions for new advice features, find the
-;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory,
-;; have any questions about Advice, or have otherwise enlightening
-;; comments feel free to send me email at .
-
-;; @ Safety Rules and Emergency Exits:
-;; ===================================
-;; Before we begin: CAUTION!!
-;; Advice provides you with a lot of rope to hang yourself on very
-;; easily accessible trees, so, here are a few important things you
-;; should know: Once Advice has been started with `ad-start-advice'
-;; (which happens automatically when you load this file), it
-;; generates an advised definition of the `documentation' function, and
-;; it will enable automatic advice activation when functions get defined.
-;; All of this can be undone at any time with `M-x ad-stop-advice'.
-;; 
-;; If you experience any strange behavior/errors etc. that you attribute to
-;; Advice or to some ill-advised function do one of the following:
-
-;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what
-;;                               function gives you problems)
-;; - M-x ad-deactivate-all      (if you don't have a clue what's going wrong)
-;; - M-x ad-stop-advice         (if you think the problem is related to the
-;;                               advised functions used by Advice itself)
-;; - M-x ad-recover-normality   (for real emergencies)
-;; - If none of the above solves your Advice-related problem go to another
-;;   terminal, kill your Emacs process and send me some hate mail.
-
-;; The first three measures have restarts, i.e., once you've figured out
-;; the problem you can reactivate advised functions with either `ad-activate',
-;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises
-;; everything so you won't be able to reactivate any advised functions, you'll
-;; have to stick with their standard incarnations for the rest of the session.
-
-;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before
-;; you byte-compile a file, because advised special forms and macros can lead
-;; to unwanted compilation results. When you are done compiling use
-;; `M-x ad-activate-all' to go back to the advised state of all your 
-;; advised functions.
-
-;; RELAX: Advice is pretty safe even if you are oblivious to the above.
-;; I use it extensively and haven't run into any serious trouble in a long
-;; time. Just wanted you to be warned.
-
-;; @ Customization:
-;; ================
-
-;; Look at the documentation of `ad-redefinition-action' for possible values
-;; of this variable. Its default value is `warn' which will print a warning
-;; message when an already defined advised function gets redefined with a
-;; new original definition and de/activated.
-
-;; Look at the documentation of `ad-default-compilation-action' for possible
-;; values of this variable. Its default value is `maybe' which will compile
-;; advised definitions during activation in case the byte-compiler is already
-;; loaded. Otherwise, it will leave them uncompiled.
-
-;; @ Motivation:
-;; =============
-;; Before I go on explaining how advice works, here are four simple examples
-;; how this package can be used. The first three are very useful, the last one
-;; is just a joke:
-
-;;(defadvice switch-to-buffer (before existing-buffers-only activate)
-;;  "When called interactively switch to existing buffers only, unless 
-;;when called with a prefix argument."
-;;  (interactive 
-;;   (list (read-buffer "Switch to buffer: " (other-buffer) 
-;;                      (null current-prefix-arg)))))
-;;
-;;(defadvice switch-to-buffer (around confirm-non-existing-buffers activate)
-;;  "Switch to non-existing buffers only upon confirmation."
-;;  (interactive "BSwitch to buffer: ")
-;;  (if (or (get-buffer (ad-get-arg 0))
-;;          (y-or-n-p (format "`%s' does not exist, create? " (ad-get-arg 0))))
-;;      ad-do-it))
-;;
-;;(defadvice find-file (before existing-files-only activate)
-;;  "Find existing files only"
-;;  (interactive "fFind file: "))
-;;
-;;(defadvice car (around interactive activate)
-;;  "Make `car' an interactive function."
-;;   (interactive "xCar of list: ")
-;;   ad-do-it
-;;   (if (interactive-p)
-;;       (message "%s" ad-return-value)))
-
-
-;; @ Advice documentation:
-;; =======================
-;; Below is general documentation of the various features of advice. For more
-;; concrete examples check the corresponding sections in the tutorial part.
-
-;; @@ Terminology:
-;; ===============
-;; - Emacs, Emacs-19: FSF's version of Emacs with major version 19
-;; - Lemacs: Lucid's version of Emacs with major version 19
-;; - XEmacs: New name of Lucid Emacs starting with 19.11
-;; - v18: Any Emacs with major version 18 or built as an extension to that
-;;        (such as Epoch)
-;; - v19: Any Emacs with major version 19
-;; - jwz: Jamie Zawinski - former keeper of Lemacs and creator of the
-;;        optimizing byte-compiler used in v19s.
-;; - Advice: The name of this package.
-;; - advices: Short for "pieces of advice".
-
-;; @@ Defining a piece of advice with `defadvice':
-;; ===============================================
-;; The main means of defining a piece of advice is the macro `defadvice',
-;; there is no interactive way of specifying a piece of advice.  A call to
-;; `defadvice' has the following syntax which is similar to the syntax of
-;; `defun/defmacro':
-;;
-;; (defadvice  (  [] [] {}*)
-;;   [ [] [] ]
-;;   {}* )
-
-;;  is the name of the function/macro/subr to be advised.
-
-;;  is the class of the advice which has to be one of `before',
-;; `around', `after', `activation' or `deactivation' (the last two allow
-;; definition of special act/deactivation hooks).
-
-;;  is the name of the advice which has to be a non-nil symbol.
-;; Names uniquely identify a piece of advice in a certain advice class,
-;; hence, advices can be redefined by defining an advice with the same class
-;; and name. Advice names are global symbols, hence, the same name space
-;; conventions used for function names should be applied.
-
-;; An optional  specifies where in the current list of advices of
-;; the specified  this new advice will be placed.  has to
-;; be either `first', `last' or a number that specifies a zero-based
-;; position (`first' is equivalent to 0). If no position is specified
-;; `first' will be used as a default. If this call to `defadvice' redefines
-;; an already existing advice (see above) then the position argument will
-;; be ignored and the position of the already existing advice will be used.
-
-;; An optional  which has to be a list can be used to define the
-;; argument list of the advised function. This argument list should of
-;; course be compatible with the argument list of the original function,
-;; otherwise functions that call the advised function with the original
-;; argument list in mind will break. If more than one advice specify an
-;; argument list then the first one (the one with the smallest position)
-;; found in the list of before/around/after advices will be used.
-
-;;  is a list of symbols that specify further information about the
-;; advice. All flags can be specified with unambiguous initial substrings.
-;;   `activate': Specifies that the advice information of the advised
-;;              function should be activated right after this advice has been
-;;              defined. In forward advices `activate' will be ignored. 
-;;   `protect': Specifies that this advice should be protected against
-;;              non-local exits and errors in preceding code/advices.
-;;   `compile': Specifies that the advised function should be byte-compiled.
-;;              This flag will be ignored unless `activate' is also specified.
-;;   `disable': Specifies that the defined advice should be disabled, hence,
-;;              it will not be used in an activation until somebody enables it.
-;;   `preactivate': Specifies that the advised function should get preactivated
-;;              at macro-expansion/compile time of this `defadvice'. This
-;;              generates a compiled advised definition according to the
-;;              current advice state which will be used during activation
-;;              if appropriate. Only use this if the `defadvice' gets
-;;              actually compiled (with a v18 byte-compiler put the `defadvice'
-;;              into the body of a `defun' to accomplish proper compilation).
-
-;; An optional  can be supplied to document the advice.
-;; On call of the `documentation' function it will be combined with the
-;; documentation strings of the original function and other advices.
-
-;; An optional  form can be supplied to change/add
-;; interactive behavior of the original function. If more than one advice
-;; has an `(interactive ...)' specification then the first one (the one
-;; with the smallest position) found in the list of before/around/after
-;; advices will be used.
-
-;; A possibly empty list of  specifies the body of the advice in
-;; an implicit progn. The body of an advice can access/change arguments,
-;; the return value, the binding environment, and can have all sorts of 
-;; other side effects.
-
-;; @@ Assembling advised definitions:
-;; ==================================
-;; Suppose a function/macro/subr/special-form has N pieces of before advice,
-;; M pieces of around advice and K pieces of after advice. Assuming none of
-;; the advices is protected, its advised definition will look like this
-;; (body-form indices correspond to the position of the respective advice in
-;; that advice class):
-
-;;    ([macro] lambda 
-;;       [ [] [(interactive ...)] ]
-;;       (let (ad-return-value)
-;;         {}*
-;;               ....
-;;         {}*
-;;         {}*
-;;            {}*
-;;                  ....
-;;               {}*
-;;                  (setq ad-return-value
-;;                        >)
-;;               {}*
-;;                  ....
-;;            {}*
-;;         {}*
-;;         {}*
-;;               ....
-;;         {}*
-;;         ad-return-value))
-
-;; Macros and special forms will be redefined as macros, hence the optional
-;; [macro] in the beginning of the definition.
-
-;;  is either the argument list of the original function or the
-;; first argument list defined in the list of before/around/after advices.
-;; The values of  variables can be accessed/changed in the body of
-;; an advice by simply referring to them by their original name, however,
-;; more portable argument access macros are also provided (see below).  For
-;; subrs/special-forms for which neither explicit argument list definitions
-;; are available, nor their documentation strings contain such definitions
-;; (as they do v19s), `(&rest ad-subr-args)' will be used.
-
-;;  is an optional, special documentation string which will
-;; be expanded into a proper documentation string upon call of `documentation'.
-
-;; (interactive ...) is an optional interactive form either taken from the
-;; original function or from a before/around/after advice. For advised
-;; interactive subrs that do not have an interactive form specified in any
-;; advice we have to use (interactive) and then call the subr interactively
-;; if the advised function was called interactively, because the
-;; interactive specification of subrs is not accessible. This is the only
-;; case where changing the values of arguments will not have an affect
-;; because they will be reset by the interactive specification of the subr.
-;; If this is a problem one can always specify an interactive form in a
-;; before/around/after advice to gain control over argument values that
-;; were supplied interactively.
-;; 
-;; Then the body forms of the various advices in the various classes of advice
-;; are assembled in order.  The forms of around advice L are normally part of
-;; one of the forms of around advice L-1. An around advice can specify where
-;; the forms of the wrapped or surrounded forms should go with the special
-;; keyword `ad-do-it', which will be substituted with a `progn' containing the
-;; forms of the surrounded code.
-
-;; The innermost part of the around advice onion is 
-;;      >
-;; whose form depends on the type of the original function. The variable
-;; `ad-return-value' will be set to its result. This variable is visible to
-;; all pieces of advice which can access and modify it before it gets returned.
-;; 
-;; The semantic structure of advised functions that contain protected pieces
-;; of advice is the same. The only difference is that `unwind-protect' forms
-;; make sure that the protected advice gets executed even if some previous
-;; piece of advice had an error or a non-local exit. If any around advice is
-;; protected then the whole around advice onion will be protected.
-
-;; @@ Argument access in advised functions:
-;; ========================================
-;; As already mentioned, the simplest way to access the arguments of an
-;; advised function in the body of an advice is to refer to them by name. To
-;; do that, the advice programmer needs to know either the names of the
-;; argument variables of the original function, or the names used in the
-;; argument list redefinition given in a piece of advice. While this simple
-;; method might be sufficient in many cases, it has the disadvantage that it
-;; is not very portable because it hardcodes the argument names into the
-;; advice. If the definition of the original function changes the advice
-;; might break even though the code might still be correct. Situations like
-;; that arise, for example, if one advises a subr like `eval-region' which
-;; gets redefined in a non-advice style into a function by the edebug
-;; package. If the advice assumes `eval-region' to be a subr it might break
-;; once edebug is loaded. Similar situations arise when one wants to use the
-;; same piece of advice across different versions of Emacs. Some subrs in a
-;; v18 Emacs are functions in v19 and vice versa, but for the most part the
-;; semantics remain the same, hence, the same piece of advice might be usable
-;; in both Emacs versions.
-
-;; As a solution to that advice provides argument list access macros that get
-;; translated into the proper access forms at activation time, i.e., when the
-;; advised definition gets constructed. Access macros access actual arguments
-;; by position regardless of how these actual argument get distributed onto
-;; the argument variables of a function. The rational behind this is that in
-;; Emacs Lisp the semantics of an argument is strictly determined by its
-;; position (there are no keyword arguments).
-
-;; Suppose the function `foo' is defined as
-;;
-;;    (defun foo (x y &optional z &rest r) ....)
-;;
-;; and is then called with
-;;
-;;    (foo 0 1 2 3 4 5 6)
-
-;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that
-;; the semantics of an actual argument is determined by its position. It is
-;; this semantics that has to be known by the advice programmer. Then s/he
-;; can access these arguments in a piece of advice with some of the
-;; following macros (the arrows indicate what value they will return):
-
-;;    (ad-get-arg 0) -> 0
-;;    (ad-get-arg 1) -> 1
-;;    (ad-get-arg 2) -> 2
-;;    (ad-get-arg 3) -> 3
-;;    (ad-get-args 2) -> (2 3 4 5 6)
-;;    (ad-get-args 4) -> (4 5 6)
-
-;; `(ad-get-arg )' will return the actual argument that was supplied
-;; at , `(ad-get-args )' will return the list of actual
-;; arguments supplied starting at . Note that these macros can be
-;; used without any knowledge about the form of the actual argument list of
-;; the original function.
-
-;; Similarly, `(ad-set-arg  )' can be used to set the
-;; value of the actual argument at  to . For example,
-;;
-;;   (ad-set-arg 5 "five")
-;;
-;; will have the effect that R=(3 4 "five" 6) once the original function is
-;; called. `(ad-set-args  )' can be used to set
-;; the list of actual arguments starting at  to .
-;; For example,
-;;
-;;   (ad-set-args 0 '(5 4 3 2 1 0))
-;;
-;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original
-;; function is called.
-
-;; All these access macros are text macros rather than real Lisp macros. When
-;; the advised definition gets constructed they get replaced with actual access
-;; forms depending on the argument list of the advised function, i.e., after
-;; that argument access is in most cases as efficient as using the argument
-;; variable names directly.
-
-;; @@@ Accessing argument bindings of arbitrary functions:
-;; =======================================================
-;; Some functions (such as `trace-function' defined in trace.el) need a
-;; method of accessing the names and bindings of the arguments of an
-;; arbitrary advised function. To do that within an advice one can use the
-;; special keyword `ad-arg-bindings' which is a text macro that will be
-;; substituted with a form that will evaluate to a list of binding
-;; specifications, one for every argument variable.  These binding
-;; specifications can then be examined in the body of the advice.  For
-;; example, somewhere in an advice we could do this:
-;;
-;;   (let* ((bindings ad-arg-bindings)
-;;          (firstarg (car bindings))
-;;          (secondarg (car (cdr bindings))))
-;;     ;; Print info about first argument
-;;     (print (format "%s=%s (%s)"
-;;                    (ad-arg-binding-field firstarg 'name)
-;;                    (ad-arg-binding-field firstarg 'value)
-;;                    (ad-arg-binding-field firstarg 'type)))
-;;     ....)
-;;
-;; The `type' of an argument is either `required', `optional' or `rest'.
-;; Wherever `ad-arg-bindings' appears a form will be inserted that evaluates
-;; to the list of bindings, hence, in order to avoid multiple unnecessary
-;; evaluations one should always bind it to some variable.
-
-;; @@@ Argument list mapping:
-;; ==========================
-;; Because `defadvice' allows the specification of the argument list of the
-;; advised function we need a mapping mechanism that maps this argument list
-;; onto that of the original function. For example, somebody might specify
-;; `(sym newdef)' as the argument list of `fset', while advice might use
-;; `(&rest ad-subr-args)' as the argument list of the original function
-;; (depending on what Emacs version is used). Hence SYM and NEWDEF have to
-;; be properly mapped onto the &rest variable when the original definition is
-;; called. Advice automatically takes care of that mapping, hence, the advice 
-;; programmer can specify an argument list without having to know about the
-;; exact structure of the original argument list as long as the new argument
-;; list takes a compatible number/magnitude of actual arguments.
-
-;; @@@ Definition of subr argument lists:
-;; ======================================
-;; When advice constructs the advised definition of a function it has to
-;; know the argument list of the original function. For functions and macros
-;; the argument list can be determined from the actual definition, however,
-;; for subrs there is no such direct access available. In XEmacs and for some
-;; subrs in Emacs-19 the argument list of a subr can be determined from
-;; its documentation string, in a v18 Emacs even that is not possible. If
-;; advice cannot at all determine the argument list of a subr it uses
-;; `(&rest ad-subr-args)' which will always work but is inefficient because
-;; it conses up arguments. The macro `ad-define-subr-args' can be used by
-;; the advice programmer to explicitly tell advice about the argument list
-;; of a certain subr, for example,
-;;
-;;    (ad-define-subr-args 'fset '(sym newdef))
-;;
-;; is used by advice itself to tell a v18 Emacs about the arguments of `fset'.
-;; The following can be used to undo such a definition:
-;;
-;;    (ad-undefine-subr-args 'fset)
-;;
-;; The argument list definition is stored on the property list of the subr
-;; name symbol. When an argument list could be determined from the
-;; documentation string it will be cached under that property. The general
-;; mechanism for looking up the argument list of a subr is the following:
-;; 1) look for a definition stored on the property list
-;; 2) if that failed try to infer it from the documentation string and
-;;    if successful cache it on the property list
-;; 3) otherwise use `(&rest ad-subr-args)'
-
-;; @@ Activation and deactivation:
-;; ===============================
-;; The definition of an advised function does not change until all its advice
-;; gets actually activated. Activation can either happen with the `activate'
-;; flag specified in the `defadvice', with an explicit call or interactive
-;; invocation of `ad-activate', or if forward advice is enabled (i.e., the
-;; value of `ad-activate-on-definition' is t) at the time an already advised
-;; function gets defined.
-
-;; When a function gets first activated its original definition gets saved,
-;; all defined and enabled pieces of advice will get combined with the
-;; original definition, the resulting definition might get compiled depending
-;; on some conditions described below, and then the function will get
-;; redefined with the advised definition.  This also means that undefined
-;; functions cannot get activated even though they might be already advised.
-
-;; The advised definition will get compiled either if `ad-activate' was called
-;; interactively with a prefix argument, or called explicitly with its second
-;; argument as t, or, if `ad-default-compilation-action' justifies it according
-;; to the current system state. If the advised definition was
-;; constructed during "preactivation" (see below) then that definition will
-;; be already compiled because it was constructed during byte-compilation of
-;; the file that contained the `defadvice' with the `preactivate' flag.
-
-;; `ad-deactivate' can be used to back-define an advised function to its
-;; original definition. It can be called interactively or directly. Because
-;; `ad-activate' caches the advised definition the function can be
-;; reactivated via `ad-activate' with only minor overhead (it is checked
-;; whether the current advice state is consistent with the cached
-;; definition, see the section on caching below).
-
-;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate
-;; all currently advised function that have a piece of advice with a name that
-;; contains a match for a regular expression. These functions can be used to
-;; de/activate sets of functions depending on certain advice naming
-;; conventions.
-
-;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to
-;; de/activate all currently advised functions. These are useful to
-;; (temporarily) return to an un/advised state.
-
-;; @@@ Reasons for the separation of advice definition and activation:
-;; ===================================================================
-;; As already mentioned, advising happens in two stages:
-
-;;   1) definition of various pieces of advice
-;;   2) activation of all advice currently defined and enabled
-
-;; The advantage of this is that various pieces of advice can be defined
-;; before they get combined into an advised definition which avoids
-;; unnecessary constructions of intermediate advised definitions. The more
-;; important advantage is that it allows the implementation of forward advice.
-;; Advice information for a certain function accumulates as the value of the
-;; `advice-info' property of the function symbol. This accumulation is
-;; completely independent of the fact that that function might not yet be
-;; defined. The special forms `defun' and `defmacro' have been advised to
-;; check whether the function/macro they defined had advice information
-;; associated with it. If so and forward advice is enabled, the original
-;; definition will be saved, and then the advice will be activated. When a
-;; file is loaded in a v18 Emacs the functions/macros it defines are also
-;; defined with calls to `defun/defmacro'.  Hence, we can forward advise
-;; functions/macros which will be defined later during a load/autoload of some
-;; file (for compiled files generated by jwz's byte-compiler in a v19 Emacs
-;; this is slightly more complicated but the basic idea is the same).
-
-;; @@ Enabling/disabling pieces or sets of advice:
-;; ===============================================
-;; A major motivation for the development of this advice package was to bring
-;; a little bit more structure into the function overloading chaos in Emacs
-;; Lisp. Many packages achieve some of their functionality by adding a little
-;; bit (or a lot) to the standard functionality of some Emacs Lisp function.
-;; ange-ftp is a very popular package that achieves its magic by overloading
-;; most Emacs Lisp functions that deal with files. A popular function that's
-;; overloaded by many packages is `expand-file-name'. The situation that one
-;; function is multiply overloaded can arise easily.
-
-;; Once in a while it would be desirable to be able to disable some/all
-;; overloads of a particular package while keeping all the rest.  Ideally -
-;; at least in my opinion - these overloads would all be done with advice,
-;; I know I am dreaming right now... In that ideal case the enable/disable
-;; mechanism of advice could be used to achieve just that.
-
-;; Every piece of advice is associated with an enablement flag. When the
-;; advised definition of a particular function gets constructed (e.g., during
-;; activation) only the currently enabled pieces of advice will be considered.
-;; This mechanism allows one to have different "views" of an advised function
-;; dependent on what pieces of advice are currently enabled.
-
-;; Another motivation for this mechanism is that it allows one to define a
-;; piece of advice for some function yet keep it dormant until a certain
-;; condition is met. Until then activation of the function will not make use
-;; of that piece of advice. Once the condition is met the advice can be
-;; enabled and a reactivation of the function will add its functionality as
-;; part of the new advised definition. For example, the advices of `defun'
-;; etc. used by advice itself will stay disabled until `ad-start-advice' is
-;; called and some variables have the proper values.  Hence, if somebody
-;; else advised these functions too and activates them the advices defined
-;; by advice will get used only if they are intended to be used.
-
-;; The main interface to this mechanism are the interactive functions
-;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
-;; would disable a particular advice of the function `foo':
-;;
-;;    (ad-disable-advice 'foo 'before 'my-advice)
-;;
-;; This call by itself only changes the flag, to get the proper effect in
-;; the advised definition too one has to activate `foo' with
-;;
-;;    (ad-activate 'foo)
-;;
-;; or interactively. To disable whole sets of advices one can use a regular
-;; expression mechanism. For example, let us assume that ange-ftp actually
-;; used advice to overload all its functions, and that it used the
-;; "ange-ftp-" prefix for all its advice names, then we could temporarily
-;; disable all its advices with
-;;
-;;    (ad-disable-regexp "^ange-ftp-")
-;;
-;; and the following call would put that actually into effect:
-;;
-;;    (ad-activate-regexp "^ange-ftp-")
-;;
-;; A saver way would have been to use
-;;
-;;    (ad-update-regexp "^ange-ftp-")
-;;
-;; instead which would have only reactivated currently actively advised
-;; functions, but not functions that were currently deactivated. All these
-;; functions can also be called interactively.
-
-;; A certain piece of advice is considered a match if its name contains a
-;; match for the regular expression. To enable ange-ftp again we would use
-;; `ad-enable-regexp' and then activate or update again.
-
-;; @@ Forward advice, automatic advice activation:
-;; ===============================================
-;; Because most Emacs Lisp packages are loaded on demand via an autoload
-;; mechanism it is essential to be able to "forward advise" functions.
-;; Otherwise, proper advice definition and activation would make it necessary
-;; to preload every file that defines a certain function before it can be
-;; advised, which would partly defeat the purpose of the advice mechanism.
-
-;; In the following, "forward advice" always implies its automatic activation
-;; once a function gets defined, and not just the accumulation of advice
-;; information for a possibly undefined function.
-
-;; Advice implements forward advice mainly via the following: 1) Separation
-;; of advice definition and activation that makes it possible to accumulate
-;; advice information without having the original function already defined,
-;; 2) special versions of the built-in functions `fset/defalias' which check
-;; for advice information whenever they define a function. If advice
-;; information was found then the advice will immediately get activated when
-;; the function gets defined.
-
-;; Automatic advice activation means, that whenever a function gets defined
-;; with either `defun', `defmacro', `fset' or by loading a byte-compiled
-;; file, and the function has some advice-info stored with it then that
-;; advice will get activated right away.
-
-;; @@@ Enabling automatic advice activation:
-;; =========================================
-;; Automatic advice activation is enabled by default. It can be disabled by
-;; doint `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'.
-
-;; @@ Caching of advised definitions:
-;; ==================================
-;; After an advised definition got constructed it gets cached as part of the
-;; advised function's advice-info so it can be reused, for example, after an
-;; intermediate deactivation. Because the advice-info of a function might
-;; change between the time of caching and reuse a cached definition gets
-;; a cache-id associated with it so it can be verified whether the cached
-;; definition is still valid (the main application of this is preactivation
-;; - see below).
-
-;; When an advised function gets activated and a verifiable cached definition
-;; is available, then that definition will be used instead of creating a new
-;; advised definition from scratch. If you want to make sure that a new
-;; definition gets constructed then you should use `ad-clear-cache' before you
-;; activate the advised function.
-
-;; @@ Preactivation:
-;; =================
-;; Constructing an advised definition is moderately expensive. In a situation
-;; where one package defines a lot of advised functions it might be
-;; prohibitively expensive to do all the advised definition construction at
-;; runtime. Preactivation is a mechanism that allows compile-time construction
-;; of compiled advised definitions that can be activated cheaply during
-;; runtime. Preactivation uses the caching mechanism to do that. Here's how it
-;; works:
-
-;; When the byte-compiler compiles a `defadvice' that has the `preactivate'
-;; flag specified, it uses the current original definition of the advised
-;; function plus the advice specified in this `defadvice' (even if it is
-;; specified as disabled) and all other currently enabled pieces of advice to
-;; construct an advised definition and an identifying cache-id and makes them
-;; part of the `defadvice' expansion which will then be compiled by the
-;; byte-compiler (to ensure that in a v18 emacs you have to put the
-;; `defadvice' inside a `defun' to get it compiled and then you have to call
-;; that compiled `defun' in order to actually execute the `defadvice'). When
-;; the file with the compiled, preactivating `defadvice' gets loaded the
-;; precompiled advised definition will be cached on the advised function's
-;; advice-info. When it gets activated (can be immediately on execution of the
-;; `defadvice' or any time later) the cache-id gets checked against the
-;; current state of advice and if it is verified the precompiled definition
-;; will be used directly (the verification is pretty cheap). If it couldn't get
-;; verified a new advised definition for that function will be built from
-;; scratch, hence, the efficiency added by the preactivation mechanism does
-;; not at all impair the flexibility of the advice mechanism.
-
-;; MORAL: In order get all the efficiency out of preactivation the advice
-;;        state of an advised function at the time the file with the
-;;        preactivating `defadvice' gets byte-compiled should be exactly
-;;        the same as it will be when the advice of that function gets
-;;        actually activated. If it is not there is a high chance that the
-;;        cache-id will not match and hence a new advised definition will
-;;        have to be constructed at runtime.
-
-;; Preactivation and forward advice do not contradict each other. It is
-;; perfectly ok to load a file with a preactivating `defadvice' before the
-;; original definition of the advised function is available. The constructed
-;; advised definition will be used once the original function gets defined and
-;; its advice gets activated. The only constraint is that at the time the
-;; file with the preactivating `defadvice' got compiled the original function
-;; definition was available.
-
-;; TIPS: Here are some indications that a preactivation did not work the way
-;;       you intended it to work:
-;;       - Activation of the advised function takes longer than usual/expected
-;;       - The byte-compiler gets loaded while an advised function gets
-;;         activated
-;;       - `byte-compile' is part of the `features' variable even though you
-;;         did not use the byte-compiler
-;;       Right now advice does not provide an elegant way to find out whether
-;;       and why a preactivation failed. What you can do is to trace the
-;;       function `ad-cache-id-verification-code' (with the function
-;;       `trace-function-background' defined in my trace.el package) before
-;;       any of your advised functions get activated. After they got
-;;       activated check whether all calls to `ad-cache-id-verification-code'
-;;       returned `verified' as a result. Other values indicate why the
-;;       verification failed which should give you enough information to
-;;       fix your preactivation/compile/load/activation sequence.
-
-;; IMPORTANT: There is one case (that I am aware of) that can make 
-;; preactivation fail, i.e., a preconstructed advised definition that does
-;; NOT match the current state of advice gets used nevertheless. That case
-;; arises if one package defines a certain piece of advice which gets used
-;; during preactivation, and another package incompatibly redefines that 
-;; very advice (i.e., same function/class/name), and it is the second advice
-;; that is available when the preconstructed definition gets activated, and
-;; that was the only definition of that advice so far (`ad-add-advice' 
-;; catches advice redefinitions and clears the cache in such a case). 
-;; Catching that would make the cache verification too expensive.
-
-;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with
-;; George Walker Bush), and why would you redefine your own advice anyway?
-;; Advice is a mechanism to facilitate function redefinition, not advice
-;; redefinition (wait until I write Meta-Advice :-). If you really have
-;; to undo somebody else's advice try to write a "neutralizing" advice.
-
-;; @@ Advising macros and special forms and other dangerous things:
-;; ================================================================
-;; Look at the corresponding tutorial sections for more information on
-;; these topics. Here it suffices to point out that the special treatment
-;; of macros and special forms by the byte-compiler can lead to problems
-;; when they get advised. Macros can create problems because they get
-;; expanded at compile time, hence, they might not have all the necessary
-;; runtime support and such advice cannot be de/activated or changed as
-;; it is possible for functions. Special forms create problems because they
-;; have to be advised "into" macros, i.e., an advised special form is a
-;; implemented as a macro, hence, in most cases the byte-compiler will
-;; not recognize it as a special form anymore which can lead to very strange
-;; results.
-;;
-;; MORAL: - Only advise macros or special forms when you are absolutely sure
-;;          what you are doing.
-;;        - As a safety measure, always do `ad-deactivate-all' before you
-;;          byte-compile a file to make sure that even if some inconsiderate
-;;          person advised some special forms you'll get proper compilation
-;;          results. After compilation do `ad-activate-all' to get back to
-;;          the previous state.
-
-;; @@ Adding a piece of advice with `ad-add-advice':
-;; =================================================
-;; The non-interactive function `ad-add-advice' can be used to add a piece of
-;; advice to some function without using `defadvice'. This is useful if advice
-;; has to be added somewhere by a function (also look at `ad-make-advice').
-
-;; @@ Activation/deactivation advices, file load hooks:
-;; ====================================================
-;; There are two special classes of advice called `activation' and
-;; `deactivation'. The body forms of these advices are not included into the
-;; advised definition of a function, rather they are assembled into a hook
-;; form which will be evaluated whenever the advice-info of the advised
-;; function gets activated or deactivated. One application of this mechanism
-;; is to define file load hooks for files that do not provide such hooks
-;; (v19s already come with a general file-load-hook mechanism, v18s don't).
-;; For example, suppose you want to print a message whenever `file-x' gets
-;; loaded, and suppose the last function defined in `file-x' is
-;; `file-x-last-fn'.  Then we can define the following advice:
-;;
-;;   (defadvice file-x-last-fn (activation file-x-load-hook)
-;;      "Executed whenever file-x is loaded"
-;;      (if load-in-progress (message "Loaded file-x")))
-;;
-;; This will constitute a forward advice for function `file-x-last-fn' which
-;; will get activated when `file-x' is loaded (only if forward advice is
-;; enabled of course). Because there are no "real" pieces of advice
-;; available for it, its definition will not be changed, but the activation
-;; advice will be run during its activation which is equivalent to having a
-;; file load hook for `file-x'.
-
-;; @@ Summary of main advice concepts:
-;; ===================================
-;; - Definition:
-;;     A piece of advice gets defined with `defadvice' and added to the
-;;     `advice-info' property of a function.
-;; - Enablement:
-;;     Every piece of advice has an enablement flag associated with it. Only
-;;     enabled advices are considered during construction of an advised
-;;     definition.
-;; - Activation:
-;;     Redefine an advised function with its advised definition. Constructs
-;;     an advised definition from scratch if no verifiable cached advised
-;;     definition is available and caches it.
-;; - Deactivation:
-;;     Back-define an advised function to its original definition.
-;; - Update:
-;;     Reactivate an advised function but only if its advice is currently 
-;;     active. This can be used to bring all currently advised function up
-;;     to date with the current state of advice without also activating
-;;     currently deactivated functions.
-;; - Caching:
-;;     Is the saving of an advised definition and an identifying cache-id so
-;;     it can be reused, for example, for activation after deactivation.
-;; - Preactivation:
-;;     Is the construction of an advised definition according to the current
-;;     state of advice during byte-compilation of a file with a preactivating
-;;     `defadvice'. That advised definition can then rather cheaply be used
-;;     during activation without having to construct an advised definition
-;;     from scratch at runtime.
-
-;; @@ Summary of interactive advice manipulation functions:
-;; ========================================================
-;; The following interactive functions can be used to manipulate the state
-;; of advised functions (all of them support completion on function names,
-;; advice classes and advice names):
-
-;; - ad-activate to activate the advice of a FUNCTION
-;; - ad-deactivate to deactivate the advice of a FUNCTION
-;; - ad-update   to activate the advice of a FUNCTION unless it was not
-;;               yet activated or is currently deactivated.
-;; - ad-unadvise deactivates a FUNCTION and removes all of its advice 
-;;               information, hence, it cannot be activated again
-;; - ad-recover  tries to redefine a FUNCTION to its original definition and
-;;               discards all advice information (a low-level `ad-unadvise').
-;;               Use only in emergencies.
-
-;; - ad-remove-advice removes a particular piece of advice of a FUNCTION.
-;;               You still have to do call `ad-activate' or `ad-update' to
-;;               activate the new state of advice.
-;; - ad-enable-advice enables a particular piece of advice of a FUNCTION.
-;; - ad-disable-advice disables a particular piece of advice of a FUNCTION.
-;; - ad-enable-regexp maps over all currently advised functions and enables
-;;               every advice whose name contains a match for a regular
-;;               expression.
-;; - ad-disable-regexp disables matching advices.
-
-;; - ad-activate-regexp   activates all advised function with a matching advice
-;; - ad-deactivate-regexp deactivates all advised function with matching advice
-;; - ad-update-regexp     updates all advised function with a matching advice
-;; - ad-activate-all      activates all advised functions
-;; - ad-deactivate-all    deactivates all advised functions
-;; - ad-update-all        updates all advised functions
-;; - ad-unadvise-all      unadvises all advised functions
-;; - ad-recover-all       recovers all advised functions
-
-;; - ad-compile byte-compiles a function/macro if it is compilable.
-
-;; @@ Summary of forms with special meanings when used within an advice:
-;; =====================================================================
-;;   ad-return-value   name of the return value variable (get/settable)
-;;   ad-subr-args      name of &rest argument variable used for advised
-;;                     subrs whose actual argument list cannot be
-;;                     determined (get/settable)
-;;   (ad-get-arg ), (ad-get-args ),
-;;   (ad-set-arg  ), (ad-set-args  )
-;;                     argument access text macros to get/set the values of
-;;                     actual arguments at a certain position
-;;   ad-arg-bindings   text macro that returns the actual names, values
-;;                     and types of the arguments as a list of bindings. The
-;;                     order of the bindings corresponds to the order of the
-;;                     arguments. The individual fields of every binding (name,
-;;                     value and type) can be accessed with the function
-;;                     `ad-arg-binding-field' (see example above).
-;;   ad-do-it          text macro that identifies the place where the original
-;;                     or wrapped definition should go in an around advice
-
-
-;; @ Foo games: An advice tutorial
-;; ===============================
-;; The following tutorial was created in Emacs 18.59. Left-justified
-;; s-expressions are input forms followed by one or more result forms.
-;; First we have to start the advice magic:
-;;
-;; (ad-start-advice)
-;; nil
-;;
-;; We start by defining an innocent looking function `foo' that simply
-;; adds 1 to its argument X:
-;;  
-;; (defun foo (x)
-;;   "Add 1 to X."
-;;   (1+ x))
-;; foo
-;;
-;; (foo 3)
-;; 4
-;;
-;; @@ Defining a simple piece of advice:
-;; =====================================
-;; Now let's define the first piece of advice for `foo'.  To do that we
-;; use the macro `defadvice' which takes a function name, a list of advice
-;; specifiers and a list of body forms as arguments.  The first element of
-;; the advice specifiers is the class of the advice, the second is its name,
-;; the third its position and the rest are some flags. The class of our
-;; first advice is `before', its name is `fg-add2', its position among the
-;; currently defined before advices (none so far) is `first', and the advice
-;; will be `activate'ed immediately. Advice names are global symbols, hence,
-;; the name space conventions used for function names should be applied. All
-;; advice names in this tutorial will be prefixed with `fg' for `Foo Games'
-;; (because everybody has the right to be inconsistent all the function names
-;; used in this tutorial do NOT follow this convention).
-;;
-;; In the body of an advice we can refer to the argument variables of the
-;; original function by name. Here we add 1 to X so the effect of calling
-;; `foo' will be to actually add 2. All of the advice definitions below only
-;; have one body form for simplicity, but there is no restriction to that
-;; extent. Every piece of advice can have a documentation string which will
-;; be combined with the documentation of the original function.
-;;
-;; (defadvice foo (before fg-add2 first activate)
-;;   "Add 2 to X."
-;;   (setq x (1+ x)))
-;; foo
-;;
-;; (foo 3)
-;; 5
-;;
-;; @@ Specifying the position of an advice:
-;; ========================================
-;; Now we define the second before advice which will cancel the effect of
-;; the previous advice. This time we specify the position as 0 which is
-;; equivalent to `first'. A number can be used to specify the zero-based
-;; position of an advice among the list of advices in the same class. This
-;; time we already have one before advice hence the position specification
-;; actually has an effect. So, after the following definition the position
-;; of the previous advice will be 1 even though we specified it with `first'
-;; above, the reason for this is that the position argument is relative to
-;; the currently defined pieces of advice which by now has changed.
-;;
-;; (defadvice foo (before fg-cancel-add2 0 activate)
-;;   "Again only add 1 to X."
-;;   (setq x (1- x)))
-;; foo
-;;
-;; (foo 3)
-;; 4
-;;
-;; @@ Redefining a piece of advice:
-;; ================================
-;; Now we define an advice with the same class and same name but with a
-;; different position. Defining an advice in a class in which an advice with
-;; that name already exists is interpreted as a redefinition of that
-;; particular advice, in which case the position argument will be ignored
-;; and the previous position of the redefined piece of advice is used.
-;; Advice flags can be specified with non-ambiguous initial substrings, hence,
-;; from now on we'll use `act' instead of the verbose `activate'.
-;;
-;; (defadvice foo (before fg-cancel-add2 last act)
-;;   "Again only add 1 to X."
-;;   (setq x (1- x)))
-;; foo
-;;
-;; @@ Assembly of advised documentation:
-;; =====================================
-;; The documentation strings of the various pieces of advice are assembled
-;; in order which shows that advice `fg-cancel-add2' is still the first
-;; `before' advice even though we specified position `last' above:
-;;
-;; (documentation 'foo)
-;; "Add 1 to X.
-;;
-;; This function is advised with the following advice(s):
-;;
-;; fg-cancel-add2 (before):
-;; Again only add 1 to X.
-;;
-;; fg-add2 (before):
-;; Add 2 to X."
-;;
-;; @@ Advising interactive behavior:
-;; =================================
-;; We can make a function interactive (or change its interactive behavior)
-;; by specifying an interactive form in one of the before or around
-;; advices (there could also be body forms in this advice). The particular
-;; definition always assigns 5 as an argument to X which gives us 6 as a
-;; result when we call foo interactively:
-;;
-;; (defadvice foo (before fg-inter last act)
-;;   "Use 5 as argument when called interactively."
-;;   (interactive (list 5)))
-;; foo
-;;
-;; (call-interactively 'foo)
-;; 6
-;;
-;; If more than one advice have an interactive declaration, then the one of
-;; the advice with the smallest position will be used (before advices go
-;; before around and after advices), hence, the declaration below does
-;; not have any effect:
-;;
-;; (defadvice foo (before fg-inter2 last act)
-;;   (interactive (list 6)))
-;; foo
-;;
-;; (call-interactively 'foo)
-;; 6
-;;
-;; Let's have a look at what the definition of `foo' looks like now 
-;; (indentation added by hand for legibility):
-;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;;   "$ad-doc: foo$"
-;;   (interactive (list 5))
-;;   (let (ad-return-value) 
-;;     (setq x (1- x)) 
-;;     (setq x (1+ x)) 
-;;     (setq ad-return-value (ad-Orig-foo x)) 
-;;     ad-return-value))
-;;
-;; @@ Around advices:
-;; ==================
-;; Now we'll try some `around' advices. An around advice is a wrapper around
-;; the original definition. It can shadow or establish bindings for the
-;; original definition, and it can look at and manipulate the value returned
-;; by the original function. The position of the special keyword `ad-do-it'
-;; specifies where the code of the original function will be executed. The
-;; keyword can appear multiple times which will result in multiple calls of
-;; the original function in the resulting advised code. Note, that if we don't
-;; specify a position argument (i.e., `first', `last' or a number), then 
-;; `first' (or 0) is the default):
-;;
-;; (defadvice foo (around fg-times-2 act)
-;;   "First double X."
-;;   (let ((x (* x 2)))
-;;     ad-do-it))
-;; foo
-;;
-;; (foo 3)
-;; 7
-;;
-;; Around advices are assembled like onion skins where the around advice
-;; with position 0 is the outermost skin and the advice at the last position
-;; is the innermost skin which is directly wrapped around the call of the
-;; original definition of the function. Hence, after the next `defadvice' we
-;; will first multiply X by 2 then add 1 and then call the original
-;; definition (i.e., add 1 again):
-;;
-;; (defadvice foo (around fg-add-1 last act)
-;;   "Add 1 to X."
-;;   (let ((x (1+ x)))
-;;     ad-do-it))
-;; foo
-;;
-;; (foo 3)
-;; 8
-;;
-;; Again, let's see what the definition of `foo' looks like so far:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x) 
-;;   "$ad-doc: foo$"
-;;   (interactive (list 5)) 
-;;   (let (ad-return-value) 
-;;     (setq x (1- x)) 
-;;     (setq x (1+ x)) 
-;;     (let ((x (* x 2))) 
-;;       (let ((x (1+ x))) 
-;;         (setq ad-return-value (ad-Orig-foo x)))) 
-;;     ad-return-value))
-;;
-;; @@ Controlling advice activation:
-;; =================================
-;; In every `defadvice' so far we have used the flag `activate' to activate
-;; the advice immediately after its definition, and that's what we want in
-;; most cases. However, if we define multiple pieces of advice for a single
-;; function then activating every advice immediately is inefficient. A
-;; better way to do this is to only activate the last defined advice.
-;; For example:
-;;
-;; (defadvice foo (after fg-times-x)
-;;   "Multiply the result with X."
-;;   (setq ad-return-value (* ad-return-value x)))
-;; foo
-;;
-;; This still yields the same result as before:
-;; (foo 3)
-;; 8
-;;
-;; Now we define another advice and activate which will also activate the
-;; previous advice `fg-times-x'. Note the use of the special variable
-;; `ad-return-value' in the body of the advice which is set to the result of
-;; the original function. If we change its value then the value returned by
-;; the advised function will be changed accordingly:
-;;
-;; (defadvice foo (after fg-times-x-again act)
-;;   "Again multiply the result with X."
-;;   (setq ad-return-value (* ad-return-value x)))
-;; foo
-;;
-;; Now the advices have an effect:
-;;
-;; (foo 3)
-;; 72
-;;
-;; @@ Protecting advice execution:
-;; ===============================
-;; Once in a while we define an advice to perform some cleanup action, 
-;; for example:
-;;
-;; (defadvice foo (after fg-cleanup last act)
-;;   "Do some cleanup."
-;;   (print "Let's clean up now!"))
-;; foo
-;;
-;; However, in case of an error the cleanup won't be performed:
-;;
-;; (condition-case error
-;;     (foo t)
-;;   (error 'error-in-foo))
-;; error-in-foo
-;;
-;; To make sure a certain piece of advice gets executed even if some error or
-;; non-local exit occurred in any preceding code, we can protect it by using
-;; the `protect' keyword. (if any of the around advices is protected then the
-;; whole around advice onion will be protected):
-;;
-;; (defadvice foo (after fg-cleanup prot act)
-;;   "Do some protected cleanup."
-;;   (print "Let's clean up now!"))
-;; foo
-;;
-;; Now the cleanup form will be executed even in case of an error:
-;;
-;; (condition-case error
-;;     (foo t)
-;;   (error 'error-in-foo))
-;; "Let's clean up now!"
-;; error-in-foo
-;;
-;; Again, let's see what `foo' looks like:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x) 
-;;   "$ad-doc: foo$"
-;;   (interactive (list 5)) 
-;;   (let (ad-return-value) 
-;;     (unwind-protect 
-;;         (progn (setq x (1- x)) 
-;;                (setq x (1+ x)) 
-;;                (let ((x (* x 2))) 
-;;                  (let ((x (1+ x))) 
-;;                    (setq ad-return-value (ad-Orig-foo x)))) 
-;;                (setq ad-return-value (* ad-return-value x)) 
-;;                (setq ad-return-value (* ad-return-value x))) 
-;;       (print "Let's clean up now!")) 
-;;     ad-return-value))
-;;
-;; @@ Compilation of advised definitions:
-;; ======================================
-;; Finally, we can specify the `compile' keyword in a `defadvice' to say
-;; that we want the resulting advised function to be byte-compiled
-;; (`compile' will be ignored unless we also specified `activate'):
-;;
-;; (defadvice foo (after fg-cleanup prot act comp)
-;;   "Do some protected cleanup."
-;;   (print "Let's clean up now!"))
-;; foo
-;;
-;; Now `foo' is byte-compiled:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x) 
-;;   "$ad-doc: foo$"
-;;   (interactive (byte-code "....." [5] 1)) 
-;;   (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6))
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 72
-;;
-;; @@ Enabling and disabling pieces of advice:
-;; ===========================================
-;; Once in a while it is desirable to temporarily disable a piece of advice
-;; so that it won't be considered during activation, for example, if two
-;; different packages advise the same function and one wants to temporarily
-;; neutralize the effect of the advice of one of the packages.
-;;
-;; The following disables the after advice `fg-times-x' in the function `foo'.
-;; All that does is to change a flag for this particular advice. All the
-;; other information defining it will be left unchanged (e.g., its relative
-;; position in this advice class, etc.).
-;;
-;; (ad-disable-advice 'foo 'after 'fg-times-x)
-;; nil
-;;
-;; For this to have an effect we have to activate `foo':
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 24
-;;
-;; If we want to disable all multiplication advices in `foo' we can use a
-;; regular expression that matches the names of such advices. Actually, any
-;; advice name that contains a match for the regular expression will be
-;; called a match. A special advice class `any' can be used to consider
-;; all advice classes:
-;;
-;; (ad-disable-advice 'foo 'any "^fg-.*times")
-;; nil
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 5
-;;
-;; To enable the disabled advice we could use either `ad-enable-advice'
-;; similar to `ad-disable-advice', or as an alternative `ad-enable-regexp'
-;; which will enable matching advices in ALL currently advised functions.
-;; Hence, this can be used to dis/enable advices made by a particular
-;; package to a set of functions as long as that package obeys standard
-;; advice name conventions.  We prefixed all advice names with `fg-', hence
-;; the following will do the trick (`ad-enable-regexp' returns the number
-;; of matched advices):
-;;
-;; (ad-enable-regexp "^fg-")
-;; 9
-;;
-;; The following will activate all currently active advised functions that
-;; contain some advice matched by the regular expression. This is a save
-;; way to update the activation of advised functions whose advice changed
-;; in some way or other without accidentally also activating currently
-;; deactivated functions:
-;;
-;; (ad-update-regexp "^fg-")
-;; nil
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 72
-;;
-;; Another use for the dis/enablement mechanism is to define a piece of advice
-;; and keep it "dormant" until a particular condition is satisfied, i.e., until
-;; then the advice will not be used during activation. The `disable' flag lets
-;; one do that with `defadvice':
-;;
-;; (defadvice foo (before fg-1-more dis)
-;;   "Add yet 1 more."
-;;   (setq x (1+ x)))
-;; foo
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 72
-;;
-;; (ad-enable-advice 'foo 'before 'fg-1-more)
-;; nil
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 160
-;;
-;; @@ Caching:
-;; ===========
-;; Advised definitions get cached to allow efficient activation/deactivation
-;; without having to reconstruct them if nothing in the advice-info of a
-;; function has changed. The following idiom can be used to temporarily
-;; deactivate functions that have a piece of advice defined by a certain
-;; package (we save the old definition to check out caching):
-;;
-;; (setq old-definition (symbol-function 'foo))
-;; (lambda (x) ....)
-;;
-;; (ad-deactivate-regexp "^fg-")
-;; nil
-;;
-;; (foo 3)
-;; 4
-;;
-;; (ad-activate-regexp "^fg-")
-;; nil
-;;
-;; (eq old-definition (symbol-function 'foo))
-;; t
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 160
-;;
-;; @@ Forward advice:
-;; ==================
-;; To enable automatic activation of forward advice we first have to set
-;; `ad-activate-on-definition' to t and restart advice:
-;;
-;; (setq ad-activate-on-definition t)
-;; t
-;;
-;; (ad-start-advice)
-;; (ad-activate-defined-function)
-;;
-;; Let's define a piece of advice for an undefined function:
-;;
-;; (defadvice bar (before fg-sub-1-more act)
-;;   "Subtract one more from X."
-;;   (setq x (1- x)))
-;; bar
-;;
-;; `bar' is not yet defined:
-;; (fboundp 'bar)
-;; nil
-;;
-;; Now we define it and the forward advice will get activated (only because
-;; `ad-activate-on-definition' was t when we started advice above with
-;; `ad-start-advice'):
-;;
-;; (defun bar (x)
-;;   "Subtract 1 from X."
-;;   (1- x))
-;; bar
-;;
-;; (bar 4)
-;; 2
-;;
-;; Redefinition will activate any available advice if the value of
-;; `ad-redefinition-action' is either `warn', `accept' or `discard':
-;;
-;; (defun bar (x)
-;;   "Subtract 2 from X."
-;;   (- x 2))
-;; bar
-;;
-;; (bar 4)
-;; 1
-;;
-;; @@ Preactivation:
-;; =================
-;; Constructing advised definitions is moderately expensive, hence, it is
-;; desirable to have a way to construct them at byte-compile time.
-;; Preactivation is a mechanism that allows one to do that.
-;;
-;; (defun fie (x)
-;;   "Multiply X by 2."
-;;   (* x 2))
-;; fie
-;;
-;; (defadvice fie (before fg-times-4 preact)
-;;   "Multiply X by 4."
-;;   (setq x (* x 2)))
-;; fie
-;;
-;; This advice did not affect `fie'...
-;;
-;; (fie 2)
-;; 4
-;;
-;; ...but it constructed a cached definition that will be used once `fie' gets
-;; activated as long as its current advice state is the same as it was during
-;; preactivation:
-;;
-;; (setq cached-definition (ad-get-cache-definition 'fie))
-;; (lambda (x) ....)
-;;
-;; (ad-activate 'fie)
-;; fie
-;;
-;; (eq cached-definition (symbol-function 'fie))
-;; t
-;;
-;; (fie 2)
-;; 8
-;;
-;; If you put a preactivating `defadvice' into a Lisp file that gets byte-
-;; compiled then the constructed advised definition will get compiled by
-;; the byte-compiler. For that to occur in a v18 emacs you have to put the
-;; `defadvice' inside a `defun' because the v18 compiler does not compile
-;; top-level forms other than `defun' or `defmacro', for example,
-;;
-;; (defun fg-defadvice-fum ()
-;;   (defadvice fum (before fg-times-4 preact act)
-;;     "Multiply X by 4."
-;;     (setq x (* x 2))))
-;; fg-defadvice-fum
-;;
-;; So far, no `defadvice' for `fum' got executed, but when we compile
-;; `fg-defadvice-fum' the `defadvice' will be expanded by the byte compiler.
-;; In order for preactivation to be effective we have to have a proper
-;; definition of `fum' around at preactivation time, hence, we define it now:
-;;
-;; (defun fum (x)
-;;   "Multiply X by 2."
-;;   (* x 2))
-;; fum
-;;
-;; Now we compile the defining function which will construct an advised
-;; definition during expansion of the `defadvice', compile it and store it
-;; as part of the compiled `fg-defadvice-fum':
-;;
-;; (ad-compile-function 'fg-defadvice-fum)
-;; (lambda nil (byte-code ...))
-;;
-;; `fum' is still completely unaffected:
-;;
-;; (fum 2)
-;; 4
-;;
-;; (ad-get-advice-info 'fum)
-;; nil
-;;
-;; (fg-defadvice-fum)
-;; fum
-;;
-;; Now the advised version of `fum' is compiled because the compiled definition
-;; constructed during preactivation was used, even though we did not specify
-;; the `compile' flag:
-;;
-;; (symbol-function 'fum)
-;; (lambda (x) 
-;;   "$ad-doc: fum$"
-;;   (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4))
-;;
-;; (fum 2)
-;; 8
-;;
-;; A preactivated definition will only be used if it matches the current
-;; function definition and advice information. If it does not match it
-;; will simply be discarded and a new advised definition will be constructed
-;; from scratch. For example, let's first remove all advice-info for `fum':
-;;
-;; (ad-unadvise 'fum)
-;; (("fie") ("bar") ("foo") ...)
-;;
-;; And now define a new piece of advice:
-;;
-;; (defadvice fum (before fg-interactive act)
-;;   "Make fum interactive."
-;;   (interactive "nEnter x: "))
-;; fum
-;;
-;; When we now try to use a preactivation it will not be used because the
-;; current advice state is different from the one at preactivation time. This
-;; is no tragedy, everything will work as expected just not as efficient,
-;; because a new advised definition has to be constructed from scratch:
-;;
-;; (fg-defadvice-fum)
-;; fum
-;;
-;; A new uncompiled advised definition got constructed:
-;;
-;; (ad-compiled-p (symbol-function 'fum))
-;; nil
-;;
-;; (fum 2)
-;; 8
-;;
-;; MORAL: To get all the efficiency out of preactivation the function
-;; definition and advice state at preactivation time must be the same as the
-;; state at activation time. Preactivation does work with forward advice, all
-;; that's necessary is that the definition of the forward advised function is
-;; available when the `defadvice' with the preactivation gets compiled.
-;;
-;; @@ Portable argument access:
-;; ============================
-;; So far, we always used the actual argument variable names to access an
-;; argument in a piece of advice. For many advice applications this is
-;; perfectly ok and keeps advices simple. However, it decreases portability
-;; of advices because it assumes specific argument variable names. For example,
-;; if one advises a subr such as `eval-region' which then gets redefined by
-;; some package (e.g., edebug) into a function with different argument names,
-;; then a piece of advice written for `eval-region' that was written with
-;; the subr arguments in mind will break. Similar situations arise when one
-;; switches between major Emacs versions, e.g., certain subrs in v18 are
-;; functions in v19 and vice versa. Also, in v19s subr argument lists
-;; are available and will be used, while they are not available in v18.
-;;
-;; Argument access text macros allow one to access arguments of an advised
-;; function in a portable way without having to worry about all these
-;; possibilities. These macros will be translated into the proper access forms
-;; at activation time, hence, argument access will be as efficient as if
-;; the arguments had been used directly in the definition of the advice.
-;;
-;; (defun fuu (x y z)
-;;   "Add 3 numbers."
-;;   (+ x y z))
-;; fuu
-;;
-;; (fuu 1 1 1)
-;; 3
-;;
-;; Argument access macros specify actual arguments at a certain position.
-;; Position 0 access the first actual argument, position 1 the second etc.
-;; For example, the following advice adds 1 to each of the 3 arguments:
-;;
-;; (defadvice fuu (before fg-add-1-to-all act)
-;;   "Adds 1 to all arguments."
-;;   (ad-set-arg 0 (1+ (ad-get-arg 0)))
-;;   (ad-set-arg 1 (1+ (ad-get-arg 1)))
-;;   (ad-set-arg 2 (1+ (ad-get-arg 2))))
-;; fuu
-;;
-;; (fuu 1 1 1)
-;; 6
-;;
-;; Now suppose somebody redefines `fuu' with a rest argument. Our advice
-;; will still work because we used access macros (note, that automatic
-;; advice activation is still in effect, hence, the redefinition of `fuu'
-;; will automatically activate all its advice):
-;;
-;; (defun fuu (&rest numbers)
-;;   "Add NUMBERS."
-;;   (apply '+ numbers))
-;; fuu
-;;
-;; (fuu 1 1 1)
-;; 6
-;;
-;; (fuu 1 1 1 1 1 1)
-;; 9
-;;
-;; What's important to notice is that argument access macros access actual
-;; arguments regardless of how they got distributed onto argument variables.
-;; In Emacs Lisp the semantics of an actual argument is determined purely
-;; by position, hence, as long as nobody changes the semantics of what a
-;; certain actual argument at a certain position means the access macros
-;; will do the right thing.
-;;
-;; Because of &rest arguments we need a second kind of access macro that
-;; can access all actual arguments starting from a certain position:
-;;
-;; (defadvice fuu (before fg-print-args act)
-;;   "Print all arguments."
-;;   (print (ad-get-args 0)))
-;; fuu
-;;
-;; (fuu 1 2 3 4 5)
-;; (1 2 3 4 5)
-;; 18
-;;
-;; (defadvice fuu (before fg-set-args act)
-;;   "Swaps 2nd and 3rd arg and discards all the rest."
-;;   (ad-set-args 1 (list (ad-get-arg 2) (ad-get-arg 1))))
-;; fuu
-;;
-;; (fuu 1 2 3 4 4 4 4 4 4)
-;; (1 3 2)
-;; 9
-;;
-;; (defun fuu (x y z)
-;;   "Add 3 numbers."
-;;   (+ x y z))
-;;
-;; (fuu 1 2 3)
-;; (1 3 2)
-;; 9
-;;
-;; @@ Defining the argument list of an advised function:
-;; =====================================================
-;; Once in a while it might be desirable to advise a function and additionally
-;; give it an extra argument that controls the advised code, for example, one
-;; might want to make an interactive function sensitive to a prefix argument.
-;; For such cases `defadvice' allows the specification of an argument list
-;; for the advised function. Similar to the redefinition of interactive 
-;; behavior, the first argument list specification found in the list of before/
-;; around/after advices will be used. Of course, the specified argument list
-;; should be downward compatible with the original argument list, otherwise
-;; functions that call the advised function with the original argument list
-;; in mind will break.
-;;
-;; (defun fii (x)
-;;   "Add 1 to X."
-;;   (1+ x))
-;; fii
-;;
-;; Now we advise `fii' to use an optional second argument that controls the
-;; amount of incrementation. A list following the (optional) position
-;; argument of the advice will be interpreted as an argument list
-;; specification. This means you cannot specify an empty argument list, and
-;; why would you want to anyway?
-;;
-;; (defadvice fii (before fg-inc-x (x &optional incr) act)
-;;   "Increment X by INCR (default is 1)."
-;;   (setq x (+ x (1- (or incr 1)))))
-;; fii
-;;
-;; (fii 3)
-;; 4
-;;
-;; (fii 3 2)
-;; 5
-;;
-;; @@ Specifying argument lists of subrs:
-;; ======================================
-;; The argument lists of subrs cannot be determined directly from Lisp.
-;; This means that Advice has to use `(&rest ad-subr-args)' as the
-;; argument list of the advised subr which is not very efficient. In XEmacs
-;; subr argument lists can be determined from their documentation string, in
-;; Emacs-19 this is the case for some but not all subrs. To accommodate
-;; for the cases where the argument lists cannot be determined (e.g., in a
-;; v18 Emacs) Advice comes with a specification mechanism that allows the
-;; advice programmer to tell advice what the argument list of a certain subr
-;; really is.
-;;
-;; In a v18 Emacs the following will return the &rest idiom:
-;;
-;; (ad-arglist (symbol-function 'car))
-;; (&rest ad-subr-args)
-;;
-;; To tell advice what the argument list of `car' really is we
-;; can do the following:
-;;
-;; (ad-define-subr-args 'car '(list))
-;; ((list))
-;;
-;; Now `ad-arglist' will return the proper argument list (this method is
-;; actually used by advice itself for the advised definition of `fset'):
-;;
-;; (ad-arglist (symbol-function 'car))
-;; (list)
-;;
-;; The defined argument list will be stored on the property list of the
-;; subr name symbol. When advice looks for a subr argument list it first
-;; checks for a definition on the property list, if that fails it tries
-;; to infer it from the documentation string and caches it on the property
-;; list if it was successful, otherwise `(&rest ad-subr-args)' will be used.
-;;
-;; @@ Advising interactive subrs:
-;; ==============================
-;; For the most part there is no difference between advising functions and
-;; advising subrs. There is one situation though where one might have to write
-;; slightly different advice code for subrs than for functions. This case
-;; arises when one wants to access subr arguments in a before/around advice
-;; when the arguments were determined by an interactive call to the subr.
-;; Advice cannot determine what `interactive' form determines the interactive
-;; behavior of the subr, hence, when it calls the original definition in an
-;; interactive subr invocation it has to use `call-interactively' to generate
-;; the proper interactive behavior. Thus up to that call the arguments of the
-;; interactive subr will be nil. For example, the following advice for
-;; `kill-buffer' will not work in an interactive invocation...
-;;
-;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp)
-;;   (my-before-kill-buffer-hook (ad-get-arg 0)))
-;; kill-buffer
-;;
-;; ...because the buffer argument will be nil in that case. The way out of
-;; this dilemma is to provide an `interactive' specification that mirrors
-;; the interactive behavior of the unadvised subr, for example, the following
-;; will do the right thing even when `kill-buffer' is called interactively:
-;;
-;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp)
-;;   (interactive "bKill buffer: ")
-;;   (my-before-kill-buffer-hook (ad-get-arg 0)))
-;; kill-buffer
-;;
-;; @@ Advising macros:
-;; ===================
-;; Advising macros is slightly different because there are two significant
-;; time points in the invocation of a macro: Expansion and evaluation time.
-;; For an advised macro instead of evaluating the original definition we
-;; use `macroexpand', that is, changing argument values and binding
-;; environments by pieces of advice has an affect during macro expansion
-;; but not necessarily during evaluation. In particular, any side effects
-;; of pieces of advice will occur during macro expansion.  To also affect
-;; the behavior during evaluation time one has to change the value of
-;; `ad-return-value' in a piece of after advice. For example:
-;;
-;; (defmacro foom (x)
-;;   (` (list (, x))))
-;; foom
-;;
-;; (foom '(a))
-;; ((a))
-;;
-;; (defadvice foom (before fg-print-x act)
-;;   "Print the value of X."
-;;   (print x))
-;; foom
-;;
-;; The following works as expected because evaluation immediately follows
-;; macro expansion:
-;;
-;; (foom '(a))
-;; (quote (a))
-;; ((a))
-;;
-;; However, the printing happens during expansion (or byte-compile) time:
-;;
-;; (macroexpand '(foom '(a)))
-;; (quote (a))
-;; (list (quote (a)))
-;;
-;; If we want it to happen during evaluation time we have to do the 
-;; following (first remove the old advice):
-;;
-;; (ad-remove-advice 'foom 'before 'fg-print-x)
-;; nil
-;;
-;; (defadvice foom (after fg-print-x act)
-;;   "Print the value of X."
-;;   (setq ad-return-value
-;;         (` (progn (print (, x))
-;;                   (, ad-return-value)))))
-;; foom
-;;
-;; (macroexpand '(foom '(a)))
-;; (progn (print (quote (a))) (list (quote (a))))
-;;
-;; (foom '(a))
-;; (a)
-;; ((a))
-;;
-;; While this method might seem somewhat cumbersome, it is very general
-;; because it allows one to influence macro expansion as well as evaluation.
-;; In general, advising macros should be a rather rare activity anyway, in
-;; particular, because compile-time macro expansion takes away a lot of the
-;; flexibility and effectiveness of the advice mechanism. Macros that were
-;; compile-time expanded before the advice was activated will of course never
-;; exhibit the advised behavior.
-;;
-;; @@ Advising special forms:
-;; ==========================
-;; Now for something that should be even more rare than advising macros:
-;; Advising special forms. Because special forms are irregular in their
-;; argument evaluation behavior (e.g., `setq' evaluates the second but not
-;; the first argument) they have to be advised into macros. A dangerous
-;; consequence of this is that the byte-compiler will not recognize them
-;; as special forms anymore (well, in most cases) and use their expansion
-;; rather than the proper byte-code. Also, because the original definition
-;; of a special form cannot be `funcall'ed, `eval' has to be used instead
-;; which is less efficient.
-;;
-;; MORAL: Do not advise special forms unless you are completely sure about
-;;        what you are doing (some of the forward advice behavior is
-;;        implemented via advice of the special forms `defun' and `defmacro').
-;;        As a safety measure one should always do `ad-deactivate-all' before
-;;        one byte-compiles a file to avoid any interference of advised
-;;        special forms.
-;;
-;; Apart from the safety concerns advising special forms is not any different
-;; from advising plain functions or subrs.
-
-
-;;; Code:
-
-;; @ Advice implementation:
-;; ========================
-
-;; @@ Compilation idiosyncrasies:
-;; ==============================
-
-;; `defadvice' expansion needs quite a few advice functions and variables,
-;; hence, I need to preload the file before it can be compiled.  To avoid
-;; interference of bogus compiled files I always preload the source file:
-(provide 'advice-preload)
-;; During a normal load this is a noop:
-(require 'advice-preload "advice.el")
-
-
-(defmacro ad-xemacs-p ()
-  ;;Expands into Non-nil constant if we run XEmacs.
-  ;;Unselected conditional code will be optimized away during compilation.
-  (string-match "XEmacs" emacs-version))
-
-
-;; @@ Variable definitions:
-;; ========================
-
-(defconst ad-version "2.14")
-
-;;;###autoload
-(defvar ad-redefinition-action 'warn
-  "*Defines what to do with redefinitions during Advice de/activation.
-Redefinition occurs if a previously activated function that already has an
-original definition associated with it gets redefined and then de/activated.
-In such a case we can either accept the current definition as the new
-original definition, discard the current definition and replace it with the
-old original, or keep it and raise an error.  The values `accept', `discard',
-`error' or `warn' govern what will be done.  `warn' is just like `accept' but
-it additionally prints a warning message.  All other values will be
-interpreted as `error'.")
-
-;;;###autoload
-(defvar ad-default-compilation-action 'maybe
-  "*Defines whether to compile advised definitions during activation.
-A value of `always' will result in unconditional compilation, `never' will
-always avoid compilation, `maybe' will compile if the byte-compiler is already
-loaded, and `like-original' will compile if the original definition of the
-advised function is compiled or a built-in function. Every other value will
-be interpreted as `maybe'. This variable will only be considered if the 
-COMPILE argument of `ad-activate' was supplied as nil.")
-
-
-;; @@ Some utilities:
-;; ==================
-
-;; We don't want the local arguments to interfere with anything
-;; referenced in the supplied functions => the cryptic casing:
-(defun ad-substitute-tree (sUbTrEe-TeSt fUnCtIoN tReE)
-  ;;"Substitutes qualifying subTREEs with result of FUNCTION(subTREE).
-  ;;Only proper subtrees are considered, for example, if TREE is (1 (2 (3)) 4)
-  ;;then the subtrees will be 1 (2 (3)) 2 (3) 3 4, dotted structures are
-  ;;allowed too.  Once a qualifying subtree has been found its subtrees will
-  ;;not be considered anymore.  (ad-substitute-tree 'atom 'identity tree)
-  ;;generates a copy of TREE."
-  (cond ((consp tReE)
-         (cons (if (funcall sUbTrEe-TeSt (car tReE))
-                   (funcall fUnCtIoN (car tReE))
-                 (if (consp (car tReE))
-                     (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (car tReE))
-                   (car tReE)))
-               (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (cdr tReE))))
-        ((funcall sUbTrEe-TeSt tReE)
-         (funcall fUnCtIoN tReE))
-        (t tReE)))
-
-;; this is just faster than `ad-substitute-tree':
-(defun ad-copy-tree (tree)
-  ;;"Returns a copy of the list structure of TREE."
-  (cond ((consp tree)
-	 (cons (ad-copy-tree (car tree))
-	       (ad-copy-tree (cdr tree))))
-	(t tree)))
-
-(defmacro ad-dolist (varform &rest body)
-  "A Common-Lisp-style dolist iterator with the following syntax:
-
-    (ad-dolist (VAR INIT-FORM [RESULT-FORM])
-       BODY-FORM...)
-
-which will iterate over the list yielded by INIT-FORM binding VAR to the
-current head at every iteration.  If RESULT-FORM is supplied its value will
-be returned at the end of the iteration, nil otherwise.  The iteration can be
-exited prematurely with `(ad-do-return [VALUE])'."
-  (let ((expansion
-         (` (let ((ad-dO-vAr (, (car (cdr varform))))
-		  (, (car varform)))
-	      (while ad-dO-vAr
-		(setq (, (car varform)) (car ad-dO-vAr))
-		(,@ body)
-		;;work around a backquote bug:
-		;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
-		;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
-		(, '(setq ad-dO-vAr (cdr ad-dO-vAr))))
-	      (, (car (cdr (cdr varform))))))))
-    ;;ok, this wastes some cons cells but only during compilation:
-    (if (catch 'contains-return
-	  (ad-substitute-tree
-	   (function (lambda (subtree)
-		       (cond ((eq (car-safe subtree) 'ad-dolist))
-			     ((eq (car-safe subtree) 'ad-do-return)
-			      (throw 'contains-return t)))))
-	   'identity body)
-	  nil)
-	(` (catch 'ad-dO-eXiT (, expansion)))
-      expansion)))
-
-(defmacro ad-do-return (value)
-  (` (throw 'ad-dO-eXiT (, value))))
-
-(if (not (get 'ad-dolist 'lisp-indent-hook))
-    (put 'ad-dolist 'lisp-indent-hook 1))
-
-
-;; @@ Save real definitions of subrs used by Advice:
-;; =================================================
-;; Advice depends on the real, unmodified functionality of various subrs, 
-;; we save them here so advised versions will not interfere (eventually,
-;; we will save all subrs used in code generated by Advice):
-
-(defmacro ad-save-real-definition (function)
-  (let ((saved-function (intern (format "ad-real-%s" function))))
-    ;; Make sure the compiler is loaded during macro expansion:
-    (require 'byte-compile "bytecomp")
-    (` (if (not (fboundp '(, saved-function)))
-	   (progn (fset '(, saved-function) (symbol-function '(, function)))
-		  ;; Copy byte-compiler properties:
-		  (,@ (if (get function 'byte-compile)
-			  (` ((put '(, saved-function) 'byte-compile
-				   '(, (get function 'byte-compile)))))))
-		  (,@ (if (get function 'byte-opcode)
-			  (` ((put '(, saved-function) 'byte-opcode
-				   '(, (get function 'byte-opcode))))))))))))
-
-(defun ad-save-real-definitions ()
-  ;; Macro expansion will hardcode the values of the various byte-compiler
-  ;; properties into the compiled version of this function such that the
-  ;; proper values will be available at runtime without loading the compiler:
-  (ad-save-real-definition fset)
-  (ad-save-real-definition documentation))
-
-(ad-save-real-definitions)
-
-
-;; @@ Advice info access fns:
-;; ==========================
-
-;; Advice information for a particular function is stored on the
-;; advice-info property of the function symbol.  It is stored as an
-;; alist of the following format:
-;;
-;;      ((active . t/nil)
-;;       (before adv1 adv2 ...)
-;;       (around adv1 adv2 ...)
-;;       (after  adv1 adv2 ...)
-;;       (activation  adv1 adv2 ...)
-;;       (deactivation  adv1 adv2 ...)
-;;       (origname . )
-;;       (cache . ( . )))
-
-;; List of currently advised though not necessarily activated functions
-;; (this list is maintained as a completion table):
-(defvar ad-advised-functions nil)
-
-(defmacro ad-pushnew-advised-function (function)
-  ;;"Add FUNCTION to `ad-advised-functions' unless its already there."
-  (` (if (not (assoc (symbol-name (, function)) ad-advised-functions))
-	 (setq ad-advised-functions
-	       (cons (list (symbol-name (, function)))
-		     ad-advised-functions)))))
-
-(defmacro ad-pop-advised-function (function)
-  ;;"Remove FUNCTION from `ad-advised-functions'."
-  (` (setq ad-advised-functions
-	   (delq (assoc (symbol-name (, function)) ad-advised-functions)
-		 ad-advised-functions))))
-
-(defmacro ad-do-advised-functions (varform &rest body)
-  ;;"`ad-dolist'-style iterator that maps over `ad-advised-functions'.
-  ;;     (ad-do-advised-functions (VAR [RESULT-FORM])
-  ;;         BODY-FORM...)
-  ;;Also see `ad-dolist'.  On each iteration VAR will be bound to the
-  ;;name of an advised function (a symbol)."
-  (` (ad-dolist ((, (car varform))
-		 ad-advised-functions
-		 (, (car (cdr varform))))
-       (setq (, (car varform)) (intern (car (, (car varform)))))
-       (,@ body))))
-
-(if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
-    (put 'ad-do-advised-functions 'lisp-indent-hook 1))
-
-(defmacro ad-get-advice-info (function)
-  (` (get (, function) 'ad-advice-info)))
-
-(defmacro ad-set-advice-info (function advice-info)
-  (` (put (, function) 'ad-advice-info (, advice-info))))
-
-(defmacro ad-copy-advice-info (function)
-  (` (ad-copy-tree (get (, function) 'ad-advice-info))))
-
-(defmacro ad-is-advised (function)
-  ;;"Returns non-nil if FUNCTION has any advice info associated with it.
-  ;;This does not mean that the advice is also active."
-  (list 'ad-get-advice-info function))
-
-(defun ad-initialize-advice-info (function)
-  ;;"Initializes the advice info for FUNCTION.
-  ;;Assumes that FUNCTION has not yet been advised."
-  (ad-pushnew-advised-function function)
-  (ad-set-advice-info function (list (cons 'active nil))))
-
-(defmacro ad-get-advice-info-field (function field)
-  ;;"Retrieves the value of the advice info FIELD of FUNCTION."
-  (` (cdr (assq (, field) (ad-get-advice-info (, function))))))
-
-(defun ad-set-advice-info-field (function field value)
-  ;;"Destructively modifies VALUE of the advice info FIELD of FUNCTION."
-  (and (ad-is-advised function)
-       (cond ((assq field (ad-get-advice-info function))
-	      ;; A field with that name is already present:
-              (rplacd (assq field (ad-get-advice-info function)) value))
-	     (t;; otherwise, create a new field with that name:
-	      (nconc (ad-get-advice-info function)
-		     (list (cons field value)))))))
-
-;; Don't make this a macro so we can use it as a predicate:
-(defun ad-is-active (function)
-  ;;"non-nil if FUNCTION is advised and activated."
-  (ad-get-advice-info-field function 'active))
-
-
-;; @@ Access fns for single pieces of advice and related predicates:
-;; =================================================================
-
-(defun ad-make-advice (name protect enable definition)
-  "Constructs single piece of advice to be stored in some advice-info.
-NAME should be a non-nil symbol, PROTECT and ENABLE should each be
-either t or nil, and DEFINITION should be a list of the form
-`(advice lambda ARGLIST [DOCSTRING] [INTERACTIVE-FORM] BODY...)'."
-  (list name protect enable definition))
-
-;; ad-find-advice uses the alist structure directly ->
-;; change if this data structure changes!!
-(defmacro ad-advice-name (advice)
-  (list 'car advice))
-(defmacro ad-advice-protected (advice)
-  (list 'nth 1 advice))
-(defmacro ad-advice-enabled (advice)
-  (list 'nth 2 advice))
-(defmacro ad-advice-definition (advice)
-  (list 'nth 3 advice))
-
-(defun ad-advice-set-enabled (advice flag)
-  (rplaca (cdr (cdr advice)) flag))
-
-(defun ad-class-p (thing)
-  (memq thing ad-advice-classes))
-(defun ad-name-p (thing)
-  (and thing (symbolp thing)))
-(defun ad-position-p (thing)
-  (or (natnump thing)
-      (memq thing '(first last))))
-
-
-;; @@ Advice access functions:
-;; ===========================
-
-;; List of defined advice classes:
-(defvar ad-advice-classes '(before around after activation deactivation))
-
-(defun ad-has-enabled-advice (function class)
-  ;;"True if at least one of FUNCTION's advices in CLASS is enabled."
-  (ad-dolist (advice (ad-get-advice-info-field function class))
-    (if (ad-advice-enabled advice) (ad-do-return t))))
-
-(defun ad-has-redefining-advice (function)
-  ;;"True if FUNCTION's advice info defines at least 1 redefining advice.
-  ;;Redefining advices affect the construction of an advised definition."
-  (and (ad-is-advised function)
-       (or (ad-has-enabled-advice function 'before)
-	   (ad-has-enabled-advice function 'around)
-	   (ad-has-enabled-advice function 'after))))
-
-(defun ad-has-any-advice (function)
-  ;;"True if the advice info of FUNCTION defines at least one advice."
-  (and (ad-is-advised function)
-       (ad-dolist (class ad-advice-classes nil)
-	 (if (ad-get-advice-info-field function class)
-	     (ad-do-return t)))))
-
-(defun ad-get-enabled-advices (function class)
-  ;;"Returns the list of enabled advices of FUNCTION in CLASS."
-  (let (enabled-advices)
-    (ad-dolist (advice (ad-get-advice-info-field function class))
-      (if (ad-advice-enabled advice)
-	  (setq enabled-advices (cons advice enabled-advices))))
-    (reverse enabled-advices)))
-
-
-;; @@ Dealing with automatic advice activation via `fset/defalias':
-;; ================================================================
-
-;; Since Emacs 19.26 the built-in versions of `fset' and `defalias'
-;; take care of automatic advice activation, hence, we don't have to
-;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'.
-
-;; The functionality of the new `fset' is as follows:
-;;
-;;     fset(sym,newdef)
-;;       assign NEWDEF to SYM
-;;       if (get SYM 'ad-advice-info)
-;;          ad-activate(SYM, nil)
-;;       return (symbol-function SYM)
-;;
-;; Whether advised definitions created by automatic activations will be
-;; compiled depends on the value of `ad-default-compilation-action'.
-
-;; Since calling `ad-activate' in the built-in definition of `fset' can
-;; create major disasters we have to be a bit careful. One precaution is
-;; to provide a dummy definition for `ad-activate' which can be used to
-;; turn off automatic advice activation (e.g., when `ad-stop-advice' or
-;; `ad-recover-normality' are called). Another is to avoid recursive calls
-;; to `ad-activate-on' by using `ad-with-auto-activation-disabled' where
-;; appropriate, especially in a safe version of `fset'.
-
-;; For now define `ad-activate' to the dummy definition:
-(defun ad-activate (function &optional compile)
-  "Automatic advice activation is disabled. `ad-start-advice' enables it."
-  nil)
-
-;; This is just a copy of the above:
-(defun ad-activate-off (function &optional compile)
-  "Automatic advice activation is disabled. `ad-start-advice' enables it."
-  nil)
-
-;; This will be t for top-level calls to `ad-activate-on':
-(defvar ad-activate-on-top-level t)
-
-(defmacro ad-with-auto-activation-disabled (&rest body)
-  (` (let ((ad-activate-on-top-level nil))
-       (,@ body))))
-
-(defun ad-safe-fset (symbol definition)
-  ;; A safe `fset' which will never call `ad-activate' recursively.
-  (ad-with-auto-activation-disabled
-   (ad-real-fset symbol definition)))
-
-
-;; @@ Access functions for original definitions:
-;; ============================================
-;; The advice-info of an advised function contains its `origname' which is
-;; a symbol that is fbound to the original definition available at the first
-;; proper activation of the function after a legal re/definition.  If the
-;; original was defined via fcell indirection then `origname' will be defined
-;; just so.  Hence, to get hold of the actual original definition of a function
-;; we need to use `ad-real-orig-definition'.
-
-(defun ad-make-origname (function)
-  ;;"Makes name to be used to call the original FUNCTION."
-  (intern (format "ad-Orig-%s" function)))
-
-(defmacro ad-get-orig-definition (function)
-  (` (let ((origname (ad-get-advice-info-field (, function) 'origname)))
-       (if (fboundp origname)
-	   (symbol-function origname)))))
-
-(defmacro ad-set-orig-definition (function definition)
-  (` (ad-safe-fset
-      (ad-get-advice-info-field function 'origname) (, definition))))
-
-(defmacro ad-clear-orig-definition (function)
-  (` (fmakunbound (ad-get-advice-info-field (, function) 'origname))))
-
-
-;; @@ Interactive input functions:
-;; ===============================
-
-(defun ad-read-advised-function (&optional prompt predicate default)
-  ;;"Reads name of advised function with completion from the minibuffer.
-  ;;An optional PROMPT will be used to prompt for the function.  PREDICATE
-  ;;plays the same role as for `try-completion' (which see).  DEFAULT will
-  ;;be returned on empty input (defaults to the first advised function for
-  ;;which PREDICATE returns non-nil)."
-  (if (null ad-advised-functions)
-      (error "ad-read-advised-function: There are no advised functions"))
-  (setq default
-	(or default
-	    (ad-do-advised-functions (function)
-	      (if (or (null predicate)
-		      (funcall predicate function))
-		  (ad-do-return function)))
-	    (error "ad-read-advised-function: %s"
-		   "There are no qualifying advised functions")))
-  (let* ((ad-pReDiCaTe predicate)
-	 (function
-	  (completing-read
-	   (format "%s(default %s) " (or prompt "Function: ") default)
-	   ad-advised-functions
-	   (if predicate
-	       (function
-		(lambda (function)
-		  ;; Oops, no closures - the joys of dynamic scoping:
-		  ;; `predicate' clashed with the `predicate' argument
-		  ;; of XEmacs' `completing-read'.....
-		  (funcall ad-pReDiCaTe (intern (car function))))))
-	   t)))
-    (if (equal function "")
-	(if (ad-is-advised default)
-	    default
-	  (error "ad-read-advised-function: `%s' is not advised" default))
-      (intern function))))
-
-(defvar ad-advice-class-completion-table
-  (mapcar '(lambda (class) (list (symbol-name class)))
-	  ad-advice-classes))
-
-(defun ad-read-advice-class (function &optional prompt default)
-  ;;"Reads a legal advice class with completion from the minibuffer.
-  ;;An optional PROMPT will be used to prompt for the class.  DEFAULT will
-  ;;be returned on empty input (defaults to the first non-empty advice
-  ;;class of FUNCTION)."
-  (setq default
-	(or default
-	    (ad-dolist (class ad-advice-classes)
-	      (if (ad-get-advice-info-field function class)
-		  (ad-do-return class)))
-	    (error "ad-read-advice-class: `%s' has no advices" function)))
-  (let ((class (completing-read
-		(format "%s(default %s) " (or prompt "Class: ") default)
-		ad-advice-class-completion-table nil t)))
-    (if (equal class "")
-	default
-      (intern class))))
-
-(defun ad-read-advice-name (function class &optional prompt)
-  ;;"Reads name of existing advice of CLASS for FUNCTION with completion.
-  ;;An optional PROMPT is used to prompt for the name."
-  (let* ((name-completion-table
-          (mapcar (function (lambda (advice)
-			      (list (symbol-name (ad-advice-name advice)))))
-		  (ad-get-advice-info-field function class)))
-	 (default
-	   (if (null name-completion-table)
-	       (error "ad-read-advice-name: `%s' has no %s advice"
-		      function class)
-	     (car (car name-completion-table))))
-	 (prompt (format "%s(default %s) " (or prompt "Name: ") default))
-	 (name (completing-read prompt name-completion-table nil t)))
-    (if (equal name "")
-	(intern default)
-      (intern name))))
-
-(defun ad-read-advice-specification (&optional prompt)
-  ;;"Reads a complete function/class/name specification from minibuffer.
-  ;;The list of read symbols will be returned.  The optional PROMPT will
-  ;;be used to prompt for the function."
-  (let* ((function (ad-read-advised-function prompt))
-	 (class (ad-read-advice-class function))
-	 (name (ad-read-advice-name function class)))
-    (list function class name)))
-
-;; Use previous regexp as a default:
-(defvar ad-last-regexp "")
-
-(defun ad-read-regexp (&optional prompt)
-  ;;"Reads a regular expression from the minibuffer."
-  (let ((regexp (read-from-minibuffer
-		 (concat (or prompt "Regular expression: ")
-			 (if (equal ad-last-regexp "") ""
-			   (format "(default \"%s\") " ad-last-regexp))))))
-    (setq ad-last-regexp
-	  (if (equal regexp "") ad-last-regexp regexp))))
-
-
-;; @@ Finding, enabling, adding and removing pieces of advice:
-;; ===========================================================
-
-(defmacro ad-find-advice (function class name)
-  ;;"Finds the first advice of FUNCTION in CLASS with NAME."
-  (` (assq (, name) (ad-get-advice-info-field (, function) (, class)))))
-
-(defun ad-advice-position (function class name)
-  ;;"Returns position of first advice of FUNCTION in CLASS with NAME."
-  (let* ((found-advice (ad-find-advice function class name))
-	 (advices (ad-get-advice-info-field function class)))
-    (if found-advice
-	(- (length advices) (length (memq found-advice advices))))))
-
-(defun ad-find-some-advice (function class name)
-  "Finds the first of FUNCTION's advices in CLASS matching NAME.
-NAME can be a symbol or a regular expression matching part of an advice name.
-If CLASS is `any' all legal advice classes will be checked."
-  (if (ad-is-advised function)
-      (let (found-advice)
-	(ad-dolist (advice-class ad-advice-classes)
-	  (if (or (eq class 'any) (eq advice-class class))
-	      (setq found-advice
-		    (ad-dolist (advice (ad-get-advice-info-field
-					function advice-class))
-		      (if (or (and (stringp name)
-				   (string-match
-				    name (symbol-name
-					  (ad-advice-name advice))))
-			      (eq name (ad-advice-name advice)))
-			  (ad-do-return advice)))))
-	  (if found-advice (ad-do-return found-advice))))))
-
-(defun ad-enable-advice-internal (function class name flag)
-  ;;"Sets enable FLAG of FUNCTION's advices in CLASS matching NAME.
-  ;;If NAME is a string rather than a symbol then it's interpreted as a regular
-  ;;expression and all advices whose name contain a match for it will be 
-  ;;affected.  If CLASS is `any' advices in all legal advice classes will be 
-  ;;considered.  The number of changed advices will be returned (or nil if 
-  ;;FUNCTION was not advised)."
-  (if (ad-is-advised function)
-      (let ((matched-advices 0))
-	(ad-dolist (advice-class ad-advice-classes)
-	  (if (or (eq class 'any) (eq advice-class class))
-	      (ad-dolist (advice (ad-get-advice-info-field
-				  function advice-class))
-		(cond ((or (and (stringp name)
-				(string-match
-				 name (symbol-name (ad-advice-name advice))))
-			   (eq name (ad-advice-name advice)))
-		       (setq matched-advices (1+ matched-advices))
-		       (ad-advice-set-enabled advice flag))))))
-	matched-advices)))
-
-(defun ad-enable-advice (function class name)
-  "Enables the advice of FUNCTION with CLASS and NAME."
-  (interactive (ad-read-advice-specification "Enable advice of: "))
-  (if (ad-is-advised function)
-      (if (eq (ad-enable-advice-internal function class name t) 0)
-	  (error "ad-enable-advice: `%s' has no %s advice matching `%s'"
-		 function class name))
-    (error "ad-enable-advice: `%s' is not advised" function)))
-
-(defun ad-disable-advice (function class name)
-  "Disables the advice of FUNCTION with CLASS and NAME."
-  (interactive (ad-read-advice-specification "Disable advice of: "))
-  (if (ad-is-advised function)
-      (if (eq (ad-enable-advice-internal function class name nil) 0)
-	  (error "ad-disable-advice: `%s' has no %s advice matching `%s'"
-		 function class name))
-    (error "ad-disable-advice: `%s' is not advised" function)))
-
-(defun ad-enable-regexp-internal (regexp class flag)
-  ;;"Sets enable FLAGs of all CLASS advices whose name contains a REGEXP match.
-  ;;If CLASS is `any' all legal advice classes are considered.  The number of
-  ;;affected advices will be returned."
-  (let ((matched-advices 0))
-    (ad-do-advised-functions (advised-function)
-      (setq matched-advices
-	    (+ matched-advices
-	       (or (ad-enable-advice-internal
-		    advised-function class regexp flag)
-		   0))))
-    matched-advices))
-
-(defun ad-enable-regexp (regexp)
-  "Enables all advices with names that contain a match for REGEXP.
-All currently advised functions will be considered."
-  (interactive
-   (list (ad-read-regexp "Enable advices via regexp: ")))
-  (let ((matched-advices (ad-enable-regexp-internal regexp 'any t)))
-    (if (interactive-p)
-	(message "%d matching advices enabled" matched-advices))
-    matched-advices))
-
-(defun ad-disable-regexp (regexp)
-  "Disables all advices with names that contain a match for REGEXP.
-All currently advised functions will be considered."
-  (interactive
-   (list (ad-read-regexp "Disable advices via regexp: ")))
-  (let ((matched-advices (ad-enable-regexp-internal regexp 'any nil)))
-    (if (interactive-p)
-	(message "%d matching advices disabled" matched-advices))
-    matched-advices))
-
-(defun ad-remove-advice (function class name)
-  "Removes FUNCTION's advice with NAME from its advices in CLASS.
-If such an advice was found it will be removed from the list of advices
-in that CLASS."
-  (interactive (ad-read-advice-specification "Remove advice of: "))
-  (if (ad-is-advised function)
-      (let* ((advice-to-remove (ad-find-advice function class name)))
-	(if advice-to-remove
-	    (ad-set-advice-info-field
-	     function class
-	     (delq advice-to-remove (ad-get-advice-info-field function class)))
-	  (error "ad-remove-advice: `%s' has no %s advice `%s'"
-		 function class name)))
-    (error "ad-remove-advice: `%s' is not advised" function)))
-
-;;;###autoload
-(defun ad-add-advice (function advice class position)
-  "Adds a piece of ADVICE to FUNCTION's list of advices in CLASS.
-If FUNCTION already has one or more pieces of advice of the specified
-CLASS then POSITION determines where the new piece will go.  The value
-of POSITION can either be `first', `last' or a number where 0 corresponds
-to `first'.  Numbers outside the range will be mapped to the closest
-extreme position.  If there was already a piece of ADVICE with the same
-name, then the position argument will be ignored and the old advice
-will be overwritten with the new one.
-    If the FUNCTION was not advised already, then its advice info will be 
-initialized.  Redefining a piece of advice whose name is part of the cache-id
-will clear the cache."
-  (cond ((not (ad-is-advised function))
-         (ad-initialize-advice-info function)
-	 (ad-set-advice-info-field
-	  function 'origname (ad-make-origname function))))
-  (let* ((previous-position
-	  (ad-advice-position function class (ad-advice-name advice)))
-	 (advices (ad-get-advice-info-field function class))
-	 ;; Determine a numerical position for the new advice:
-	 (position (cond (previous-position)
-			 ((eq position 'first) 0)
-			 ((eq position 'last) (length advices))
-			 ((numberp position)
-			  (max 0 (min position (length advices))))
-			 (t 0))))
-    ;; Check whether we have to clear the cache:
-    (if (memq (ad-advice-name advice) (ad-get-cache-class-id function class))
-        (ad-clear-cache function))
-    (if previous-position
-	(setcar (nthcdr position advices) advice)
-      (if (= position 0)
-	  (ad-set-advice-info-field function class (cons advice advices))
-	(setcdr (nthcdr (1- position) advices)
-		(cons advice (nthcdr position advices)))))))
-
-
-;; @@ Accessing and manipulating function definitions:
-;; ===================================================
-
-(defmacro ad-macrofy (definition)
-  ;;"Takes a lambda function DEFINITION and makes a macro out of it."
-  (` (cons 'macro (, definition))))
-
-(defmacro ad-lambdafy (definition)
-  ;;"Takes a macro function DEFINITION and makes a lambda out of it."
-  (` (cdr (, definition))))
-
-;; There is no way to determine whether some subr is a special form or not,
-;; hence we need this list (which is probably out of date):
-(defvar ad-special-forms
-  (mapcar 'symbol-function
-	  '(and catch cond condition-case defconst defmacro
-			       defun defvar function if interactive let let*
-			       or prog1 prog2 progn quote save-excursion
-                               save-restriction save-window-excursion setq
-			       setq-default unwind-protect while
-			       with-output-to-temp-buffer)))
-
-(defmacro ad-special-form-p (definition)
-  ;;"non-nil if DEFINITION is a special form."
-  (list 'memq definition 'ad-special-forms))
-
-(defmacro ad-interactive-p (definition)
-  ;;"non-nil if DEFINITION can be called interactively."
-  (list 'commandp definition))
-
-(defmacro ad-subr-p (definition)
-  ;;"non-nil if DEFINITION is a subr."
-  (list 'subrp definition))
-
-(defmacro ad-macro-p (definition)
-  ;;"non-nil if DEFINITION is a macro."
-  (` (eq (car-safe (, definition)) 'macro)))
-
-(defmacro ad-lambda-p (definition)
-  ;;"non-nil if DEFINITION is a lambda expression."
-  (` (eq (car-safe (, definition)) 'lambda)))
-
-;; see ad-make-advice for the format of advice definitions:
-(defmacro ad-advice-p (definition)
-  ;;"non-nil if DEFINITION is a piece of advice."
-  (` (eq (car-safe (, definition)) 'advice)))
-
-;; Emacs/XEmacs cross-compatibility
-;; (compiled-function-p is an obsolete function in Emacs):
-(if (and (not (fboundp 'byte-code-function-p))
-	 (fboundp 'compiled-function-p))
-    (ad-safe-fset 'byte-code-function-p 'compiled-function-p))
-
-(defmacro ad-compiled-p (definition)
-  ;;"non-nil if DEFINITION is a compiled byte-code object."
-  (` (or (byte-code-function-p (, definition))
-	 (and (ad-macro-p (, definition))
-	      (byte-code-function-p (ad-lambdafy (, definition)))))))
-
-(defmacro ad-compiled-code (compiled-definition)
-  ;;"Returns the byte-code object of a COMPILED-DEFINITION."
-  (` (if (ad-macro-p (, compiled-definition))
-	 (ad-lambdafy (, compiled-definition))
-       (, compiled-definition))))
-
-(defun ad-lambda-expression (definition)
-  ;;"Returns the lambda expression of a function/macro/advice DEFINITION."
-  (cond ((ad-lambda-p definition)
-	 definition)
-	((ad-macro-p definition)
-	 (ad-lambdafy definition))
-	((ad-advice-p definition)
-	 (cdr definition))
-	(t nil)))
-
-(defun ad-arglist (definition &optional name)
-  ;;"Returns the argument list of DEFINITION.
-  ;;If DEFINITION could be from a subr then its NAME should be
-  ;;supplied to make subr arglist lookup more efficient."
-  (cond ((ad-compiled-p definition)
-	 ;; XEmacs fix:
-	 (if (fboundp 'compiled-function-arglist)
-	     (compiled-function-arglist (ad-compiled-code definition))
-	   (aref (ad-compiled-code definition) 0)))
-	((consp definition)
-	 (car (cdr (ad-lambda-expression definition))))
-	((ad-subr-p definition)
-	 (if name
-	     (ad-subr-arglist name)
-	   ;; otherwise get it from its printed representation:
-	   (setq name (format "%s" definition))
-	   (string-match "^#]+\\)>$" name)
-	   (ad-subr-arglist
-	    (intern (substring name (match-beginning 1) (match-end 1))))))))
-
-;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish
-;; a defined empty arglist `(nil)' from an undefined arglist:
-(defmacro ad-define-subr-args (subr arglist)
-  (` (put (, subr) 'ad-subr-arglist (list (, arglist)))))
-(defmacro ad-undefine-subr-args (subr)
-  (` (put (, subr) 'ad-subr-arglist nil)))
-(defmacro ad-subr-args-defined-p (subr)
-  (` (get (, subr) 'ad-subr-arglist)))
-(defmacro ad-get-subr-args (subr)
-  (` (car (get (, subr) 'ad-subr-arglist))))
-
-(defun ad-subr-arglist (subr-name)
-  ;;"Retrieve arglist of the subr with SUBR-NAME.
-  ;;Either use the one stored under the `ad-subr-arglist' property,
-  ;;or try to retrieve it from the docstring and cache it under
-  ;;that property, or otherwise use `(&rest ad-subr-args)'."
-  (cond ((ad-subr-args-defined-p subr-name)
-	 (ad-get-subr-args subr-name))
-	;; says jwz: Should use this for Lemacs 19.8 and above:
-	;;((fboundp 'subr-min-args)
-	;;  ...)
-	;; says hans: I guess what Jamie means is that I should use the values
-	;; of `subr-min-args' and `subr-max-args' to construct the subr arglist
-	;; without having to look it up via parsing the docstring, e.g.,
-	;; values 1 and 2 would suggest `(arg1 &optional arg2)' as an
-	;; argument list.  However, that won't work because there is no
-	;; way to distinguish a subr with args `(a &optional b &rest c)' from
-	;; one with args `(a &rest c)' using that mechanism. Also, the argument
-	;; names from the docstring are more meaningful. Hence, I'll stick with
-	;; the old way of doing things.
-	(t (let ((doc (or (ad-real-documentation subr-name t) "")))
-	     (cond ((string-match
-		     "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'" doc)
-		    ;; this is the format used in XEmacs and in FSFmacs pre-19.24:
-		    ;; XEmacs 19.12+ uppercases the args like FSF...
-		    (ad-define-subr-args
-		     subr-name
-		     (car (read-from-string
-			   (downcase (substring doc
-						(match-beginning 1)
-						(match-end 1))))))
-		    (ad-get-subr-args subr-name))
-		   ((string-match "^\\(([^\)]+)\\)\n?\\'" doc)
-		    (ad-define-subr-args
-		     subr-name
-		     (cdr (car (read-from-string
-				(downcase
-				 (substring doc
-					    (match-beginning 1)
-					    (match-end 1)))))))
-		    (ad-get-subr-args subr-name))
-		   (t '(&rest ad-subr-args)))))))
-
-(defun ad-docstring (definition)
-  ;;"Returns the unexpanded docstring of DEFINITION."
-  (let ((docstring
-	 (if (ad-compiled-p definition)
-	     (ad-real-documentation definition t)
-	   (car (cdr (cdr (ad-lambda-expression definition)))))))
-    (if (or (stringp docstring)
-	    (natnump docstring))
-	docstring)))
-
-(defun ad-interactive-form (definition)
-  ;;"Returns the interactive form of DEFINITION."
-  (cond ((ad-compiled-p definition)
-	 (and (commandp definition)
-	      ;; XEmacs: we have an accessor function so don't use aref.
-	      (if (fboundp 'compiled-function-interactive)
-		  (compiled-function-interactive (ad-compiled-code definition))
-	      (list 'interactive (aref (ad-compiled-code definition) 5)))))
-	((or (ad-advice-p definition)
-	     (ad-lambda-p definition))
-	 (commandp (ad-lambda-expression definition)))))
-
-(defun ad-body-forms (definition)
-  ;;"Returns the list of body forms of DEFINITION."
-  (cond ((ad-compiled-p definition)
-	 nil)
-	((consp definition)
-	 (nthcdr (+ (if (ad-docstring definition) 1 0)
-		    (if (ad-interactive-form definition) 1 0))
-		 (cdr (cdr (ad-lambda-expression definition)))))))
-
-;; Matches the docstring of an advised definition.
-;; The first group of the regexp matches the function name:
-(defvar ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$")
-
-(defun ad-make-advised-definition-docstring (function)
-  ;; Makes an identifying docstring for the advised definition of FUNCTION.
-  ;; Put function name into the documentation string so we can infer
-  ;; the name of the advised function from the docstring.  This is needed
-  ;; to generate a proper advised docstring even if we are just given a
-  ;; definition (also see the defadvice for `documentation'):
-  (format "$ad-doc: %s$" (prin1-to-string function)))
-
-(defun ad-advised-definition-p (definition)
-  ;;"non-nil if DEFINITION was generated from advice information."
-  (if (or (ad-lambda-p definition)
-	  (ad-macro-p definition)
-	  (ad-compiled-p definition))
-      (let ((docstring (ad-docstring definition)))
-	(and (stringp docstring)
-	     (string-match
-	      ad-advised-definition-docstring-regexp docstring)))))
-
-(defun ad-definition-type (definition)
-  ;;"Returns symbol that describes the type of DEFINITION."
-  (if (ad-macro-p definition)
-      'macro
-    (if (ad-subr-p definition)
-	(if (ad-special-form-p definition)
-	    'special-form
-	  'subr)
-      (if (or (ad-lambda-p definition)
-	      (ad-compiled-p definition))
-	  'function
-	(if (ad-advice-p definition)
-	    'advice)))))
-
-(defun ad-has-proper-definition (function)
-  ;;"True if FUNCTION is a symbol with a proper definition.
-  ;;For that it has to be fbound with a non-autoload definition."
-  (and (symbolp function)
-       (fboundp function)
-       (not (eq (car-safe (symbol-function function)) 'autoload))))
-
-;; The following two are necessary for the sake of packages such as
-;; ange-ftp which redefine functions via fcell indirection:
-(defun ad-real-definition (function)
-  ;;"Finds FUNCTION's definition at the end of function cell indirection."
-  (if (ad-has-proper-definition function)
-      (let ((definition (symbol-function function)))
-	(if (symbolp definition)
-	    (ad-real-definition definition)
-	  definition))))
-
-(defun ad-real-orig-definition (function)
-  ;;"Finds FUNCTION's real original definition starting from its `origname'."
-  (if (ad-is-advised function)
-      (ad-real-definition (ad-get-advice-info-field function 'origname))))
-
-(defun ad-is-compilable (function)
-  ;;"True if FUNCTION has an interpreted definition that can be compiled."
-  (and (ad-has-proper-definition function)
-       (or (ad-lambda-p (symbol-function function))
-	   (ad-macro-p (symbol-function function)))
-       (not (ad-compiled-p (symbol-function function)))))
-
-(defun ad-compile-function (function)
-  "Byte-compiles FUNCTION (or macro) if it is not yet compiled."
-  (interactive "aByte-compile function: ")
-  (if (ad-is-compilable function)
-      ;; Need to turn off auto-activation
-      ;; because `byte-compile' uses `fset':
-      (ad-with-auto-activation-disabled
-       (byte-compile function))))
-
-
-;; @@ Constructing advised definitions:
-;; ====================================
-;;
-;; Main design decisions about the form of advised definitions:
-;;
-;; A) How will original definitions be called?
-;; B) What will argument lists of advised functions look like?
-;;
-;; Ad A)
-;;    I chose to use function indirection for all four types of original
-;;    definitions (functions, macros, subrs and special forms), i.e., create
-;;    a unique symbol `ad-Orig-' which is fbound to the original
-;;    definition and call it according to type and arguments.  Functions and
-;;    subrs that don't have any &rest arguments can be called directly in a
-;;    `(ad-Orig- ....)' form.  If they have a &rest argument we have to
-;;    use `apply'.  Macros will be called with 
-;;    `(macroexpand '(ad-Orig- ....))', and special forms also need a
-;;    form like that with `eval' instead of `macroexpand'.
-;;
-;; Ad B)
-;;    Use original arguments where possible and `(&rest ad-subr-args)'
-;;    otherwise, even though this seems to be more complicated and less
-;;    uniform than a general `(&rest args)' approach.  My reason to still
-;;    do it that way is that in most cases my approach leads to the more
-;;    efficient form for the advised function, and portability (e.g., to
-;;    make the same advice work regardless of whether something is a
-;;    function or a subr) can still be achieved with argument access macros.
-
-
-(defun ad-prognify (forms)
-  (cond ((<= (length forms) 1)
-	 (car forms))
-	(t (cons 'progn forms))))
-
-;; @@@ Accessing argument lists:
-;; =============================
-
-(defun ad-parse-arglist (arglist)
-  ;;"Parses ARGLIST into its required, optional and rest parameters.
-  ;;A three-element list is returned, where the 1st element is the list of
-  ;;required arguments, the 2nd is the list of optional arguments, and the 3rd
-  ;;is the name of an optional rest parameter (or nil)."
-  (let* (required optional rest)
-    (setq rest (car (cdr (memq '&rest arglist))))
-    (if rest (setq arglist (reverse (cdr (memq '&rest (reverse arglist))))))
-    (setq optional (cdr (memq '&optional arglist)))
-    (if optional
-	(setq required (reverse (cdr (memq '&optional (reverse arglist)))))
-      (setq required arglist))
-    (list required optional rest)))
-
-(defun ad-retrieve-args-form (arglist)
-  ;;"Generates a form which evaluates into names/values/types of ARGLIST.
-  ;;When the form gets evaluated within a function with that argument list
-  ;;it will result in a list with one entry for each argument, where the
-  ;;first element of each entry is the name of the argument, the second
-  ;;element is its actual current value, and the third element is either
-  ;;`required', `optional' or `rest' depending on the type of the argument."
-  (let* ((parsed-arglist (ad-parse-arglist arglist))
-	 (rest (nth 2 parsed-arglist)))
-    (` (list
-	(,@ (mapcar (function
-		     (lambda (req)
-		       (` (list '(, req) (, req) 'required))))
-		    (nth 0 parsed-arglist)))
-	(,@ (mapcar (function
-		     (lambda (opt)
-		       (` (list '(, opt) (, opt) 'optional))))
-		    (nth 1 parsed-arglist)))
-	(,@ (if rest (list (` (list '(, rest) (, rest) 'rest)))))
-	))))
-
-(defun ad-arg-binding-field (binding field)
-  (cond ((eq field 'name) (car binding))
-	((eq field 'value) (car (cdr binding)))
-	((eq field 'type) (car (cdr (cdr binding))))))
-
-(defun ad-list-access (position list)
-  (cond ((= position 0) list)
-	((= position 1) (list 'cdr list))
-	(t (list 'nthcdr position list))))
-
-(defun ad-element-access (position list)
-  (cond ((= position 0) (list 'car list))
-	((= position 1) (` (car (cdr (, list)))))
-	(t (list 'nth position list))))
-
-(defun ad-access-argument (arglist index)
-  ;;"Tells how to access ARGLIST's actual argument at position INDEX.
-  ;;For a required/optional arg it simply returns it, if a rest argument has
-  ;;to be accessed, it returns a list with the index and name."
-  (let* ((parsed-arglist (ad-parse-arglist arglist))
-	 (reqopt-args (append (nth 0 parsed-arglist)
-			      (nth 1 parsed-arglist)))
-	 (rest-arg (nth 2 parsed-arglist)))
-    (cond ((< index (length reqopt-args))
-	   (nth index reqopt-args))
-	  (rest-arg
-	   (list (- index (length reqopt-args)) rest-arg)))))
-
-(defun ad-get-argument (arglist index)
-  ;;"Returns form to access ARGLIST's actual argument at position INDEX."
-  (let ((argument-access (ad-access-argument arglist index)))
-    (cond ((consp argument-access)
-	   (ad-element-access
-	    (car argument-access) (car (cdr argument-access))))
-	  (argument-access))))
-
-(defun ad-set-argument (arglist index value-form)
-  ;;"Returns form to set ARGLIST's actual arg at INDEX to VALUE-FORM."
-  (let ((argument-access (ad-access-argument arglist index)))
-    (cond ((consp argument-access)
-	   ;; should this check whether there actually is something to set?
-	   (` (setcar (, (ad-list-access
-			  (car argument-access) (car (cdr argument-access))))
-		      (, value-form))))
-	  (argument-access
-	   (` (setq (, argument-access) (, value-form))))
-	  (t (error "ad-set-argument: No argument at position %d of `%s'"
-		    index arglist)))))
-
-(defun ad-get-arguments (arglist index)
-  ;;"Returns form to access all actual arguments starting at position INDEX."
-  (let* ((parsed-arglist (ad-parse-arglist arglist))
-	 (reqopt-args (append (nth 0 parsed-arglist)
-			      (nth 1 parsed-arglist)))
-	 (rest-arg (nth 2 parsed-arglist))
-	 args-form)
-    (if (< index (length reqopt-args))
-	(setq args-form (` (list (,@ (nthcdr index reqopt-args))))))
-    (if rest-arg
-	(if args-form
-	    (setq args-form (` (nconc (, args-form) (, rest-arg))))
-	  (setq args-form (ad-list-access (- index (length reqopt-args))
-					  rest-arg))))
-    args-form))
-
-(defun ad-set-arguments (arglist index values-form)
-  ;;"Makes form to assign elements of VALUES-FORM as actual ARGLIST args.
-  ;;The assignment starts at position INDEX."
-  (let ((values-index 0)
-	argument-access set-forms)
-    (while (setq argument-access (ad-access-argument arglist index))
-      (if (symbolp argument-access)
-	  (setq set-forms
-		(cons (ad-set-argument
-		       arglist index
-		       (ad-element-access values-index 'ad-vAlUeS))
-		      set-forms))
-	(setq set-forms
-	      (cons (if (= (car argument-access) 0)
-			(list 'setq
-			      (car (cdr argument-access))
-			      (ad-list-access values-index 'ad-vAlUeS))
-		      (list 'setcdr
-			    (ad-list-access (1- (car argument-access))
-					    (car (cdr argument-access)))
-			    (ad-list-access values-index 'ad-vAlUeS)))
-		    set-forms))
-	;; terminate loop
-	(setq arglist nil))
-      (setq index (1+ index))
-      (setq values-index (1+ values-index)))
-    (if (null set-forms)
-	(error "ad-set-arguments: No argument at position %d of `%s'"
-	       index arglist)
-      (if (= (length set-forms) 1)
-	  ;; For exactly one set-form we can use values-form directly,...
-	  (ad-substitute-tree
-	   (function (lambda (form) (eq form 'ad-vAlUeS)))
-	   (function (lambda (form) values-form))
-	   (car set-forms))
-	;; ...if we have more we have to bind it to a variable:
-	(` (let ((ad-vAlUeS (, values-form)))
-	     (,@ (reverse set-forms))
-	     ;; work around the old backquote bug:
-	     (, 'ad-vAlUeS)))))))
-
-(defun ad-insert-argument-access-forms (definition arglist)
-  ;;"Expands arg-access text macros in DEFINITION according to ARGLIST."
-  (ad-substitute-tree
-   (function
-    (lambda (form)
-      (or (eq form 'ad-arg-bindings)
-	  (and (memq (car-safe form)
-		     '(ad-get-arg ad-get-args ad-set-arg ad-set-args))
-	       (integerp (car-safe (cdr form)))))))
-   (function
-    (lambda (form)
-      (if (eq form 'ad-arg-bindings)
-	  (ad-retrieve-args-form arglist)
-	(let ((accessor (car form))
-	      (index (car (cdr form)))
-	      (val (car (cdr (ad-insert-argument-access-forms
-			      (cdr form) arglist)))))
-	  (cond ((eq accessor 'ad-get-arg)
-		 (ad-get-argument arglist index))
-		((eq accessor 'ad-set-arg)
-		 (ad-set-argument arglist index val))
-		((eq accessor 'ad-get-args)
-		 (ad-get-arguments arglist index))
-		((eq accessor 'ad-set-args)
-		 (ad-set-arguments arglist index val)))))))
-		   definition))
-
-;; @@@ Mapping argument lists:
-;; ===========================
-;; Here is the problem:
-;; Suppose function foo was called with (foo 1 2 3 4 5), and foo has the
-;; argument list (x y &rest z), and we want to call the function bar which
-;; has argument list (a &rest b) with a combination of x, y and z so that
-;; the effect is just as if we had called (bar 1 2 3 4 5) directly. 
-;; The mapping should work for any two argument lists.
-
-(defun ad-map-arglists (source-arglist target-arglist)
-  "Makes `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST.
-The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just
-as if they had been supplied to a function with TARGET-ARGLIST directly. 
-Excess source arguments will be neglected, missing source arguments will be 
-supplied as nil.  Returns a `funcall' or `apply' form with the second element
-being `function' which has to be replaced by an actual function argument.
-Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
-         `(funcall function a (car args) (car (cdr args)) (nth 2 args))'."
-  (let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
-	 (source-reqopt-args (append (nth 0 parsed-source-arglist)
-				     (nth 1 parsed-source-arglist)))
-	 (source-rest-arg (nth 2 parsed-source-arglist))
-	 (parsed-target-arglist (ad-parse-arglist target-arglist))
-	 (target-reqopt-args (append (nth 0 parsed-target-arglist)
-				     (nth 1 parsed-target-arglist)))
-	 (target-rest-arg (nth 2 parsed-target-arglist))
-	 (need-apply (and source-rest-arg target-rest-arg))
-	 (target-arg-index -1))
-    ;; This produces ``error-proof'' target function calls with the exception
-    ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args
-    ;; supplied to A might not be enough to supply the required target arg X
-    (append (list (if need-apply 'apply 'funcall) 'function)
-	    (cond (need-apply
-		   ;; `apply' can take care of that directly:
-		   (append source-reqopt-args (list source-rest-arg)))
-		  (t (mapcar (function
-			      (lambda (arg)
-				(setq target-arg-index (1+ target-arg-index))
-				(ad-get-argument
-				 source-arglist target-arg-index)))
-			     (append target-reqopt-args
-				     (and target-rest-arg
-					  ;; If we have a rest arg gobble up
-					  ;; remaining source args:
-					  (nthcdr (length target-reqopt-args)
-						  source-reqopt-args)))))))))
-
-(defun ad-make-mapped-call (source-arglist target-arglist target-function)
-  ;;"Makes form to call TARGET-FUNCTION with args from SOURCE-ARGLIST."
-  (let* ((mapped-form (ad-map-arglists source-arglist target-arglist)))
-    (if (eq (car mapped-form) 'funcall)
-	(cons target-function (cdr (cdr mapped-form)))
-      (prog1 mapped-form
-	(setcar (cdr mapped-form) (list 'quote target-function))))))
-
-;; @@@ Making an advised documentation string:
-;; ===========================================
-;; New policy: The documentation string for an advised function will be built
-;; at the time the advised `documentation' function is called.  This has the
-;; following advantages:
-;;   1) command-key substitutions will automatically be correct
-;;   2) No wasted string space due to big advised docstrings in caches or
-;;      compiled files that contain preactivations
-;; The overall overhead for this should be negligible because people normally
-;; don't lookup documentation for the same function over and over again.
-
-(defun ad-make-single-advice-docstring (advice class &optional style)
-  (let ((advice-docstring (ad-docstring (ad-advice-definition advice))))
-    (cond ((eq style 'plain)
-	   advice-docstring)
-	  ((eq style 'freeze)
-	   (format "Permanent %s-advice `%s':%s%s"
-		   class (ad-advice-name advice)
-		   (if advice-docstring "\n" "")
-		   (or advice-docstring "")))
-	  (t (format "%s-advice `%s':%s%s"
-		     (capitalize (symbol-name class)) (ad-advice-name advice)
-		     (if advice-docstring "\n" "")
-		     (or advice-docstring ""))))))
-
-(defun ad-make-advised-docstring (function &optional style)
-  ;;"Constructs a documentation string for the advised FUNCTION.
-  ;;It concatenates the original documentation with the documentation
-  ;;strings of the individual pieces of advice which will be formatted
-  ;;according to STYLE.  STYLE can be `plain' or `freeze', everything else
-  ;;will be interpreted as `default'.  The order of the advice documentation
-  ;;strings corresponds to before/around/after and the individual ordering
-  ;;in any of these classes."
-  (let* ((origdef (ad-real-orig-definition function))
-	 (origtype (symbol-name (ad-definition-type origdef)))
-	 (origdoc
-	  ;; Retrieve raw doc, key substitution will be taken care of later:
-	  (ad-real-documentation origdef t))
-	 paragraphs advice-docstring)
-    (if origdoc (setq paragraphs (list origdoc)))
-    (if (not (eq style 'plain))
-	(setq paragraphs (cons (concat "This " origtype " is advised.")
-			       paragraphs)))
-    (ad-dolist (class ad-advice-classes)
-      (ad-dolist (advice (ad-get-enabled-advices function class))
-	(setq advice-docstring
-	      (ad-make-single-advice-docstring advice class style))
-	(if advice-docstring
-	    (setq paragraphs (cons advice-docstring paragraphs)))))
-    (if paragraphs
-	;; separate paragraphs with blank lines:
-	(mapconcat 'identity (nreverse paragraphs) "\n\n"))))
-
-(defun ad-make-plain-docstring (function)
-  (ad-make-advised-docstring function 'plain))
-(defun ad-make-freeze-docstring (function)
-  (ad-make-advised-docstring function 'freeze))
-
-;; @@@ Accessing overriding arglists and interactive forms:
-;; ========================================================
-
-(defun ad-advised-arglist (function)
-  ;;"Finds first defined arglist in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
-			     (ad-get-enabled-advices function 'around)
-			     (ad-get-enabled-advices function 'after)))
-    (let ((arglist (ad-arglist (ad-advice-definition advice))))
-      (if arglist
-	  ;; We found the first one, use it:
-	  (ad-do-return arglist)))))
-
-(defun ad-advised-interactive-form (function)
-  ;;"Finds first interactive form in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
-			     (ad-get-enabled-advices function 'around)
-			     (ad-get-enabled-advices function 'after)))
-    (let ((interactive-form
-	   (ad-interactive-form (ad-advice-definition advice))))
-      (if interactive-form
-	  ;; We found the first one, use it:
-	  (ad-do-return interactive-form)))))
-
-;; @@@ Putting it all together:
-;; ============================
-
-(defun ad-make-advised-definition (function)
-  ;;"Generates an advised definition of FUNCTION from its advice info."
-  (if (and (ad-is-advised function)
-	   (ad-has-redefining-advice function))
-      (let* ((origdef (ad-real-orig-definition function))
-	     (origname (ad-get-advice-info-field function 'origname))
-	     (orig-interactive-p (ad-interactive-p origdef))
-	     (orig-subr-p (ad-subr-p origdef))
-	     (orig-special-form-p (ad-special-form-p origdef))
-	     (orig-macro-p (ad-macro-p origdef))
-	     ;; Construct the individual pieces that we need for assembly:
-	     (orig-arglist (ad-arglist origdef function))
-	     (advised-arglist (or (ad-advised-arglist function)
-				  orig-arglist))
-	     (advised-interactive-form (ad-advised-interactive-form function))
-	     (interactive-form
-	      (cond (orig-macro-p nil)
-		    (advised-interactive-form)
-		    ((ad-interactive-form origdef))
-		    ;; Otherwise we must have a subr: make it interactive if
-		    ;; we have to and initialize required arguments in case
-		    ;; it is called interactively:
-		    (orig-interactive-p
-		     (let ((reqargs (car (ad-parse-arglist advised-arglist))))
-		       (if reqargs
-			   (` (interactive
-			       '(, (make-list (length reqargs) nil))))
-			   '(interactive))))))
-	     (orig-form
-	      (cond ((or orig-special-form-p orig-macro-p)
-		     ;; Special forms and macros will be advised into macros.
-                     ;; The trick is to construct an expansion for the advised
-		     ;; macro that does the correct thing when it gets eval'ed.
-		     ;; For macros we'll just use the expansion of the original
-		     ;; macro and return that. This way compiled advised macros
-		     ;; will be expanded into something useful. Note that after
-		     ;; advices have full control over whether they want to
-		     ;; evaluate the expansion (the value of `ad-return-value')
-		     ;; at macro expansion time or not. For special forms there
-		     ;; is no solution that interacts reasonably with the
-		     ;; compiler, hence we just evaluate the original at macro
-		     ;; expansion time and return the result. The moral of that
-		     ;; is that one should always deactivate advised special
-		     ;; forms before one byte-compiles a file.
-		     (` ((, (if orig-macro-p
-				'macroexpand
-			      'eval))
-			 (cons '(, origname)
-			       (, (ad-get-arguments advised-arglist 0))))))
-		    ((and orig-subr-p
-			  orig-interactive-p
-			  (not advised-interactive-form))
-		     ;; Check whether we were called interactively
-		     ;; in order to do proper prompting:
-		     (` (if (interactive-p)
-			    (call-interactively '(, origname))
-			  (, (ad-make-mapped-call
-			      orig-arglist advised-arglist origname)))))
-		    ;; And now for normal functions and non-interactive subrs
-	            ;; (or subrs whose interactive behavior was advised):
-		    (t (ad-make-mapped-call
-			advised-arglist orig-arglist origname)))))
-
-	;; Finally, build the sucker:
-	(ad-assemble-advised-definition
-	 (cond (orig-macro-p 'macro)
-	       (orig-special-form-p 'special-form)
-	       (t 'function))
-	 advised-arglist
-         (ad-make-advised-definition-docstring function)
-	 interactive-form
-	 orig-form
-	 (ad-get-enabled-advices function 'before)
-	 (ad-get-enabled-advices function 'around)
-	 (ad-get-enabled-advices function 'after)))))
-
-(defun ad-assemble-advised-definition
-  (type args docstring interactive orig &optional befores arounds afters)
-
-  ;;"Assembles an original and its advices into an advised function.
-  ;;It constructs a function or macro definition according to TYPE which has to
-  ;;be either `macro', `function' or `special-form'.  ARGS is the argument list
-  ;;that has to be used, DOCSTRING if non-nil defines the documentation of the
-  ;;definition, INTERACTIVE if non-nil is the interactive form to be used,
-  ;;ORIG is a form that calls the body of the original unadvised function,
-  ;;and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
-  ;;should be modified.  The assembled function will be returned."
-
-  (let (before-forms around-form around-form-protected after-forms definition)
-    (ad-dolist (advice befores)
-      (cond ((and (ad-advice-protected advice)
-		  before-forms)
-	     (setq before-forms
-		   (` ((unwind-protect
-			   (, (ad-prognify before-forms))
-			 (,@ (ad-body-forms
-			      (ad-advice-definition advice))))))))
-	    (t (setq before-forms
-		     (append before-forms
-			     (ad-body-forms (ad-advice-definition advice)))))))
-
-    (setq around-form (` (setq ad-return-value (, orig))))
-    (ad-dolist (advice (reverse arounds))
-      ;; If any of the around advices is protected then we
-      ;; protect the complete around advice onion:
-      (if (ad-advice-protected advice)
-	  (setq around-form-protected t))
-      (setq around-form
-	    (ad-substitute-tree
-	     (function (lambda (form) (eq form 'ad-do-it)))
-	     (function (lambda (form) around-form))
-	     (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
-
-    (setq after-forms
-	  (if (and around-form-protected before-forms)
-	      (` ((unwind-protect
-		      (, (ad-prognify before-forms))
-		    (, around-form))))
-	    (append before-forms (list around-form))))
-    (ad-dolist (advice afters)
-      (cond ((and (ad-advice-protected advice)
-		  after-forms)
-	     (setq after-forms
-		   (` ((unwind-protect
-			   (, (ad-prognify after-forms))
-			 (,@ (ad-body-forms
-			      (ad-advice-definition advice))))))))
-	    (t (setq after-forms
-		     (append after-forms
-			     (ad-body-forms (ad-advice-definition advice)))))))
-
-    (setq definition
-	  (` ((,@ (if (memq type '(macro special-form)) '(macro)))
-	      lambda
-	      (, args)
-	      (,@ (if docstring (list docstring)))
-	      (,@ (if interactive (list interactive)))
-	      (let (ad-return-value)
-		(,@ after-forms)
-		(, (if (eq type 'special-form)
-		       '(list 'quote ad-return-value)
-		     'ad-return-value))))))
-
-    (ad-insert-argument-access-forms definition args)))
-
-;; This is needed for activation/deactivation hooks:
-(defun ad-make-hook-form (function hook-name)
-  ;;"Makes hook-form from FUNCTION's advice bodies in class HOOK-NAME."
-  (let ((hook-forms
-	 (mapcar (function (lambda (advice)
-			     (ad-body-forms (ad-advice-definition advice))))
-		 (ad-get-enabled-advices function hook-name))))
-    (if hook-forms
-	(ad-prognify (apply 'append hook-forms)))))
-
-
-;; @@ Caching:
-;; ===========
-;; Generating an advised definition of a function is moderately expensive,
-;; hence, it makes sense to cache it so we can reuse it in appropriate
-;; circumstances.  Of course, it only makes sense to reuse a cached
-;; definition if the current advice and function definition state is the
-;; same as it was at the time when the cached definition was generated.
-;; For that purpose we associate every cache with an id so we can verify
-;; if it is still valid at a certain point in time.  This id mechanism
-;; makes it possible to preactivate advised functions, write the compiled
-;; advised definitions to a file and reuse them during the actual
-;; activation without having to risk that the resulting definition will be
-;; incorrect, well, almost.
-;;
-;; A cache id is a list with six elements:
-;; 1) the list of names of enabled before advices
-;; 2) the list of names of enabled around advices
-;; 3) the list of names of enabled after advices
-;; 4) the type of the original function (macro, subr, etc.)
-;; 5) the arglist of the original definition (or t if it was equal to the
-;;    arglist of the cached definition)
-;; 6) t if the interactive form of the original definition was equal to the
-;;    interactive form of the cached definition
-;;
-;; Here's how a cache can get invalidated or be incorrect:
-;; A) a piece of advice used in the cache gets redefined
-;; B) the current list of enabled advices is different from the ones used
-;;    for the cache
-;; C) the type of the original function changed, e.g., a function became a
-;;    macro, or a subr became a function
-;; D) the arglist of the original function changed
-;; E) the interactive form of the original function changed
-;; F) a piece of advice used in the cache got redefined before the
-;;    defadvice with the cached definition got loaded: This is a PROBLEM!
-;;
-;; Cases A and B are the normal ones.  A is taken care of by `ad-add-advice'
-;; which clears the cache in such a case, B is easily checked during
-;; verification at activation time.
-;;
-;; Cases C, D and E have to be considered if one is slightly paranoid, i.e.,
-;; if one considers the case that the original function could be different
-;; from the one available at caching time (e.g., for forward advice of
-;; functions that get redefined by some packages - such as `eval-region' gets
-;; redefined by edebug).  All these cases can be easily checked during
-;; verification.  Element 4 of the id lets one check case C, element 5 takes
-;; care of case D (using t in the equality case saves some space, because the
-;; arglist can be recovered at validation time from the cached definition),
-;; and element 6 takes care of case E which is only a problem if the original
-;; was actually a function whose interactive form was not overridden by a
-;; piece of advice.
-;;
-;; Case F is the only one which will lead to an incorrect advised function.
-;; There is no way to avoid this without storing the complete advice definition
-;; in the cache-id which is not feasible.
-;;
-;; The cache-id of a typical advised function with one piece of advice and
-;; no arglist redefinition takes 7 conses which is a small price to pay for
-;; the added efficiency.  The validation itself is also pretty cheap, certainly
-;; a lot cheaper than reconstructing an advised definition.
-
-(defmacro ad-get-cache-definition (function)
-  (` (car (ad-get-advice-info-field (, function) 'cache))))
-
-(defmacro ad-get-cache-id (function)
-  (` (cdr (ad-get-advice-info-field (, function) 'cache))))
-
-(defmacro ad-set-cache (function definition id)
-  (` (ad-set-advice-info-field
-      (, function) 'cache (cons (, definition) (, id)))))
-
-(defun ad-clear-cache (function)
-  "Clears a previously cached advised definition of FUNCTION.
-Clear the cache if you want to force `ad-activate' to construct a new
-advised definition from scratch."
-  (interactive
-   (list (ad-read-advised-function "Clear cached definition of: ")))
-  (ad-set-advice-info-field function 'cache nil))
-
-(defun ad-make-cache-id (function)
-  ;;"Generates an identifying image of the current advices of FUNCTION."
-  (let ((original-definition (ad-real-orig-definition function))
-	(cached-definition (ad-get-cache-definition function)))
-    (list (mapcar (function (lambda (advice) (ad-advice-name advice)))
-		  (ad-get-enabled-advices function 'before))
-	  (mapcar (function (lambda (advice) (ad-advice-name advice)))
-		  (ad-get-enabled-advices function 'around))
-	  (mapcar (function (lambda (advice) (ad-advice-name advice)))
-		  (ad-get-enabled-advices function 'after))
-	  (ad-definition-type original-definition)
-	  (if (equal (ad-arglist original-definition function)
-		     (ad-arglist cached-definition))
-	      t
-	    (ad-arglist original-definition function))
-	  (if (eq (ad-definition-type original-definition) 'function)
-	      (equal (ad-interactive-form original-definition)
-		     (ad-interactive-form cached-definition))))))
-
-(defun ad-get-cache-class-id (function class)
-  ;;"Returns the part of FUNCTION's cache id that identifies CLASS."
-  (let ((cache-id (ad-get-cache-id function)))
-    (if (eq class 'before)
-	(car cache-id)
-      (if (eq class 'around)
-	  (nth 1 cache-id)
-	(nth 2 cache-id)))))
-
-(defun ad-verify-cache-class-id (cache-class-id advices)
-  (ad-dolist (advice advices (null cache-class-id))
-    (if (ad-advice-enabled advice)
-	(if (eq (car cache-class-id) (ad-advice-name advice))
-	    (setq cache-class-id (cdr cache-class-id))
-	  (ad-do-return nil)))))
-
-;; There should be a way to monitor if and why a cache verification failed
-;; in order to determine whether a certain preactivation could be used or
-;; not.  Right now the only way to find out is to trace 
-;; `ad-cache-id-verification-code'.  The code it returns indicates where the
-;; verification failed.  Tracing `ad-verify-cache-class-id' might provide
-;; some additional useful information.
-
-(defun ad-cache-id-verification-code (function)
-  (let ((cache-id (ad-get-cache-id function))
-	(code 'before-advice-mismatch))
-    (and (ad-verify-cache-class-id
-	  (car cache-id) (ad-get-advice-info-field function 'before))
-	 (setq code 'around-advice-mismatch)
-	 (ad-verify-cache-class-id
-	  (nth 1 cache-id) (ad-get-advice-info-field function 'around))
-	 (setq code 'after-advice-mismatch)
-	 (ad-verify-cache-class-id
-	  (nth 2 cache-id) (ad-get-advice-info-field function 'after))
-	 (setq code 'definition-type-mismatch)
-	 (let ((original-definition (ad-real-orig-definition function))
-	       (cached-definition (ad-get-cache-definition function)))
-	   (and (eq (nth 3 cache-id) (ad-definition-type original-definition))
-		(setq code 'arglist-mismatch)
-		(equal (if (eq (nth 4 cache-id) t)
-			   (ad-arglist original-definition function)
-			 (nth 4 cache-id) )
-		       (ad-arglist cached-definition))
-		(setq code 'interactive-form-mismatch)
-		(or (null (nth 5 cache-id))
-		    (equal (ad-interactive-form original-definition)
-			   (ad-interactive-form cached-definition)))
-		(setq code 'verified))))
-    code))
-
-(defun ad-verify-cache-id (function)
-  ;;"True if FUNCTION's cache-id is compatible with its current advices."
-  (eq (ad-cache-id-verification-code function) 'verified))
-
-
-;; @@ Preactivation:
-;; =================
-;; Preactivation can be used to generate compiled advised definitions
-;; at compile time without having to give up the dynamic runtime flexibility
-;; of the advice mechanism.  Preactivation is a special feature of `defadvice',
-;; it involves the following steps:
-;;  - remembering the function's current state (definition and advice-info)
-;;  - advising it with the defined piece of advice
-;;  - clearing its cache
-;;  - generating an interpreted advised definition by activating it, this will
-;;    make use of all its current active advice and its current definition
-;;  - saving the so generated cached definition and id
-;;  - resetting the function's advice and definition state to what it was
-;;    before the preactivation
-;;  - Returning the saved definition and its id to be used in the expansion of
-;;    `defadvice' to assign it as an initial cache, hence it will be compiled
-;;    at time the `defadvice' gets compiled.
-;; Naturally, for preactivation to be effective it has to be applied/compiled
-;; at the right time, i.e., when the current state of advices and function
-;; definition exactly reflects the state at activation time.  Should that not
-;; be the case, the precompiled definition will just be discarded and a new
-;; advised definition will be generated.
-
-(defun ad-preactivate-advice (function advice class position)
-  ;;"Preactivates FUNCTION and returns the constructed cache."
-  (let* ((function-defined-p (fboundp function))
-	 (old-definition
-	  (if function-defined-p
-	      (symbol-function function)))
-	 (old-advice-info (ad-copy-advice-info function))
-	 (ad-advised-functions ad-advised-functions))
-    (unwind-protect
-	(progn
-	  (ad-add-advice function advice class position)
-	  (ad-enable-advice function class (ad-advice-name advice))
-	  (ad-clear-cache function)
-	  (ad-activate-on function -1)
-	  (if (and (ad-is-active function)
-	           (ad-get-cache-definition function))
-	      (list (ad-get-cache-definition function)
-		    (ad-get-cache-id function))))
-      (ad-set-advice-info function old-advice-info)
-      ;; Don't `fset' function to nil if it was previously unbound:
-      (if function-defined-p
-	  (ad-safe-fset function old-definition)
-	(fmakunbound function)))))
-
-
-;; @@ Freezing:
-;; ============
-;; Freezing transforms a `defadvice' into a redefining `defun/defmacro'
-;; for the advised function without keeping any advice information. This
-;; feature was jwz's idea: It generates a dumpable function definition
-;; whose documentation can be written to the DOC file, and the generated
-;; code does not need any Advice runtime support. Of course, frozen advices
-;; cannot be undone.
-
-;; Freezing only considers the advice of the particular `defadvice', other
-;; already existing advices for the same function will be ignored. To ensure
-;; proper interaction when an already advised function gets redefined with
-;; a frozen advice, frozen advices always use the actual original definition
-;; of the function, i.e., they are always at the core of the onion. E.g., if
-;; an already advised function gets redefined with a frozen advice and then
-;; unadvised, the frozen advice remains as the new definition of the function.
-
-;; While multiple freeze advices for a single function or freeze-advising
-;; of an already advised function are possible, they are better avoided,
-;; because definition/compile/load ordering is relevant, and it becomes
-;; incomprehensible pretty quickly.
-
-(defun ad-make-freeze-definition (function advice class position)
-  (if (not (ad-has-proper-definition function))
-      (error
-       "ad-make-freeze-definition: `%s' is not yet defined"
-       function))
-  (let* ((name (ad-advice-name advice))
-	 ;; With a unique origname we can have multiple freeze advices
-	 ;; for the same function, each overloading the previous one:
-	 (unique-origname
-	  (intern (format "%s-%s-%s" (ad-make-origname function) class name)))
-	 (orig-definition
-	  ;; If FUNCTION is already advised, we'll use its current origdef
-	  ;; as the original definition of the frozen advice:
-	  (or (ad-get-orig-definition function)
-	      (symbol-function function)))
-	 (old-advice-info
-	  (if (ad-is-advised function)
-	      (ad-copy-advice-info function)))
-	 (real-docstring-fn
-	  (symbol-function 'ad-make-advised-definition-docstring))
-	 (real-origname-fn
-	  (symbol-function 'ad-make-origname))
-	 (frozen-definition
-	  (unwind-protect
-	      (progn
-		;; Make sure we construct a proper docstring:
-		(ad-safe-fset 'ad-make-advised-definition-docstring
-			      'ad-make-freeze-docstring)
-		;; Make sure `unique-origname' is used as the origname:
-		(ad-safe-fset 'ad-make-origname '(lambda (x) unique-origname))
-		;; No we reset all current advice information to nil and
-		;; generate an advised definition that's solely determined
-		;; by ADVICE and the current origdef of FUNCTION:
-		(ad-set-advice-info function nil)
-		(ad-add-advice function advice class position)
-		;; The following will provide proper real docstrings as
-		;; well as a definition that will make the compiler happy:
-		(ad-set-orig-definition function orig-definition)
-		(ad-make-advised-definition function))
-	    ;; Restore the old advice state:
-	    (ad-set-advice-info function old-advice-info)
-	    ;; Restore functions:
-	    (ad-safe-fset
-	     'ad-make-advised-definition-docstring real-docstring-fn)
-	    (ad-safe-fset 'ad-make-origname real-origname-fn))))
-    (if frozen-definition
-	(let* ((macro-p (ad-macro-p frozen-definition))
-	       (body (cdr (if macro-p
-			      (ad-lambdafy frozen-definition)
-			    frozen-definition))))
-	  (` (progn
-	       (if (not (fboundp '(, unique-origname)))
-		   (fset '(, unique-origname)
-			 ;; avoid infinite recursion in case the function
-			 ;; we want to freeze is already advised:
-			 (or (ad-get-orig-definition '(, function))
-			     (symbol-function '(, function)))))
-	       ((, (if macro-p 'defmacro 'defun))
-		(, function)
-		(,@ body))))))))
-
-
-;; @@ Activation and definition handling:
-;; ======================================
-
-(defun ad-should-compile (function compile)
-  ;;"Returns non-nil if the advised FUNCTION should be compiled.
-  ;;If COMPILE is non-nil and not a negative number then it returns t.
-  ;;If COMPILE is a negative number then it returns nil.
-  ;;If COMPILE is nil then the result depends on the value of
-  ;;`ad-default-compilation-action' (which see)."
-  (if (integerp compile)
-      (>= compile 0)
-    (if compile
-	compile
-      (cond ((eq ad-default-compilation-action 'never)
-	     nil)
-	    ((eq ad-default-compilation-action 'always)
-	     t)
-	    ((eq ad-default-compilation-action 'like-original)
-	     (or (ad-subr-p (ad-get-orig-definition function))
-		 (ad-compiled-p (ad-get-orig-definition function))))
-	    ;; everything else means `maybe':
-	    (t (featurep 'byte-compile))))))
-
-(defun ad-activate-advised-definition (function compile)
-  ;;"Redefines FUNCTION with its advised definition from cache or scratch.
-  ;;The resulting FUNCTION will be compiled if `ad-should-compile' returns t.
-  ;;The current definition and its cache-id will be put into the cache."
-  (let ((verified-cached-definition
-	 (if (ad-verify-cache-id function)
-	     (ad-get-cache-definition function))))
-    (ad-safe-fset function
-		  (or verified-cached-definition
-		      (ad-make-advised-definition function)))
-    (if (ad-should-compile function compile)
-	(ad-compile-function function))
-    (if verified-cached-definition
-	(if (not (eq verified-cached-definition (symbol-function function)))
-	    ;; we must have compiled, cache the compiled definition:
-	    (ad-set-cache
-	     function (symbol-function function) (ad-get-cache-id function)))
-      ;; We created a new advised definition, cache it with a proper id:
-      (ad-clear-cache function)
-      ;; ad-make-cache-id needs the new cached definition:
-      (ad-set-cache function (symbol-function function) nil)
-      (ad-set-cache
-       function (symbol-function function) (ad-make-cache-id function)))))
-
-(defun ad-handle-definition (function)
-  "Handles re/definition of an advised FUNCTION during de/activation.
-If FUNCTION does not have an original definition associated with it and
-the current definition is usable, then it will be stored as FUNCTION's
-original definition.  If no current definition is available (even in the
-case of undefinition) nothing will be done.  In the case of redefinition
-the action taken depends on the value of `ad-redefinition-action' (which
-see).  Redefinition occurs when FUNCTION already has an original definition
-associated with it but got redefined with a new definition and then
-de/activated.  If you do not like the current redefinition action change
-the value of `ad-redefinition-action' and de/activate again."
-  (let ((original-definition (ad-get-orig-definition function))
-	(current-definition (if (ad-real-definition function)
-				(symbol-function function))))
-    (if original-definition
-	(if current-definition
-	    (if (and (not (eq current-definition original-definition))
-		     ;; Redefinition with an advised definition from a
-		     ;; different function won't count as such:
-		     (not (ad-advised-definition-p current-definition)))
-		;; we have a redefinition:
-		(if (not (memq ad-redefinition-action '(accept discard warn)))
-		    (error "ad-handle-definition (see its doc): `%s' %s"
-			   function "illegally redefined")
-		  (if (eq ad-redefinition-action 'discard)
-		      (ad-safe-fset function original-definition)
-		    (ad-set-orig-definition function current-definition)
-		    (if (eq ad-redefinition-action 'warn)
-			(message "ad-handle-definition: `%s' got redefined"
-				 function))))
-	      ;; either advised def or correct original is in place:
-	      nil)
-	  ;; we have an undefinition, ignore it:
-	  nil)
-      (if current-definition
-	  ;; we have a first definition, save it as original:
-	  (ad-set-orig-definition function current-definition)
-	;; we don't have anything noteworthy:
-	nil))))
-
-
-;; @@ The top-level advice interface:
-;; ==================================
-
-(defun ad-activate-on (function &optional compile)
-  "Activates all the advice information of an advised FUNCTION.
-If FUNCTION has a proper original definition then an advised
-definition will be generated from FUNCTION's advice info and the
-definition of FUNCTION will be replaced with it.  If a previously
-cached advised definition was available, it will be used.
-The optional COMPILE argument determines whether the resulting function
-or a compilable cached definition will be compiled.  If it is negative
-no compilation will be performed, if it is positive or otherwise non-nil
-the resulting function will be compiled, if it is nil the behavior depends
-on the value of `ad-default-compilation-action' (which see).
-Activation of an advised function that has an advice info but no actual
-pieces of advice is equivalent to a call to `ad-unadvise'.  Activation of
-an advised function that has actual pieces of advice but none of them are
-enabled is equivalent to a call to `ad-deactivate'.  The current advised
-definition will always be cached for later usage."
-  (interactive
-   (list (ad-read-advised-function "Activate advice of: ")
-	 current-prefix-arg))
-  (if ad-activate-on-top-level
-      ;; avoid recursive calls to `ad-activate-on':
-      (ad-with-auto-activation-disabled
-	(if (not (ad-is-advised function))
-	    (error "ad-activate: `%s' is not advised" function)
-	  (ad-handle-definition function)
-	  ;; Just return for forward advised and not yet defined functions:
-	  (if (ad-get-orig-definition function)
-	      (if (not (ad-has-any-advice function))
-		  (ad-unadvise function)
-		;; Otherwise activate the advice:
-		(cond ((ad-has-redefining-advice function)
-		       (ad-activate-advised-definition function compile)
-		       (ad-set-advice-info-field function 'active t)
-		       (eval (ad-make-hook-form function 'activation))
-		       function)
-		      ;; Here we are if we have all disabled advices:
-		      (t (ad-deactivate function)))))))))
-
-(defun ad-deactivate (function)
-  "Deactivates the advice of an actively advised FUNCTION.
-If FUNCTION has a proper original definition, then the current
-definition of FUNCTION will be replaced with it.  All the advice
-information will still be available so it can be activated again with
-a call to `ad-activate'."
-  (interactive
-   (list (ad-read-advised-function "Deactivate advice of: " 'ad-is-active)))
-  (if (not (ad-is-advised function))
-      (error "ad-deactivate: `%s' is not advised" function)
-    (cond ((ad-is-active function)
-	   (ad-handle-definition function)
-	   (if (not (ad-get-orig-definition function))
-	       (error "ad-deactivate: `%s' has no original definition"
-		      function)
-	     (ad-safe-fset function (ad-get-orig-definition function))
-	     (ad-set-advice-info-field function 'active nil)
-	     (eval (ad-make-hook-form function 'deactivation))
-	     function)))))
-
-(defun ad-update (function &optional compile)
-  "Update the advised definition of FUNCTION if its advice is active.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive
-   (list (ad-read-advised-function
-	  "Update advised definition of: " 'ad-is-active)))
-  (if (ad-is-active function)
-      (ad-activate-on function compile)))
-
-(defun ad-unadvise (function)
-  "Deactivates FUNCTION and then removes all its advice information. 
-If FUNCTION was not advised this will be a noop."
-  (interactive
-   (list (ad-read-advised-function "Unadvise function: ")))
-  (cond ((ad-is-advised function)
-	 (if (ad-is-active function)
-	     (ad-deactivate function))
-	 (ad-clear-orig-definition function)
-	 (ad-set-advice-info function nil)
-	 (ad-pop-advised-function function))))
-
-(defun ad-recover (function)
-  "Tries to recover FUNCTION's original definition and unadvises it.
-This is more low-level than `ad-unadvise' because it does not do any
-deactivation which might run hooks and get into other trouble.
-Use in emergencies."
-  ;; Use more primitive interactive behavior here: Accept any symbol that's
-  ;; currently defined in obarray, not necessarily with a function definition:
-  (interactive
-   (list (intern
-	  (completing-read "Recover advised function: " obarray nil t))))
-  (cond ((ad-is-advised function)
-	 (cond ((ad-get-orig-definition function)
-	        (ad-safe-fset function (ad-get-orig-definition function))
-		(ad-clear-orig-definition function)))
-	 (ad-set-advice-info function nil)
-	 (ad-pop-advised-function function))))
-
-(defun ad-activate-regexp (regexp &optional compile)
-  "Activates functions with an advice name containing a REGEXP match.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive
-   (list (ad-read-regexp "Activate via advice regexp: ")
-	 current-prefix-arg))
-  (ad-do-advised-functions (function)
-    (if (ad-find-some-advice function 'any regexp)
-	(ad-activate-on function compile))))
-
-(defun ad-deactivate-regexp (regexp)
-  "Deactivates functions with an advice name containing REGEXP match."
-  (interactive
-   (list (ad-read-regexp "Deactivate via advice regexp: ")))
-  (ad-do-advised-functions (function)
-    (if (ad-find-some-advice function 'any regexp)
-	(ad-deactivate function))))
-
-(defun ad-update-regexp (regexp &optional compile)
-  "Updates functions with an advice name containing a REGEXP match.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive
-   (list (ad-read-regexp "Update via advice regexp: ")
-	 current-prefix-arg))
-  (ad-do-advised-functions (function)
-    (if (ad-find-some-advice function 'any regexp)
-	(ad-update function compile))))
-
-(defun ad-activate-all (&optional compile)
-  "Activates all currently advised functions.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive "P")
-  (ad-do-advised-functions (function)
-    (ad-activate-on function compile)))
-
-(defun ad-deactivate-all ()
-  "Deactivates all currently advised functions."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (ad-deactivate function)))
-
-(defun ad-update-all (&optional compile)
-  "Updates all currently advised functions.
-With prefix argument compiles resulting advised definitions."
-  (interactive "P")
-  (ad-do-advised-functions (function)
-    (ad-update function compile)))
-
-(defun ad-unadvise-all ()
-  "Unadvises all currently advised functions."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (ad-unadvise function)))
-
-(defun ad-recover-all ()
-  "Recovers all currently advised functions.  Use in emergencies."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (condition-case nil
-	(ad-recover function)
-      (error nil))))
-
-
-;; Completion alist of legal `defadvice' flags
-(defvar ad-defadvice-flags
-  '(("protect") ("disable") ("activate")
-    ("compile") ("preactivate") ("freeze")))
-
-;;;###autoload
-(defmacro defadvice (function args &rest body)
-  "Defines a piece of advice for FUNCTION (a symbol).
-The syntax of `defadvice' is as follows:
-
-  (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
-    [DOCSTRING] [INTERACTIVE-FORM]
-    BODY... )
-
-FUNCTION ::= Name of the function to be advised.
-CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'.
-NAME ::= Non-nil symbol that names this piece of advice.
-POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first',
-    see also `ad-add-advice'.
-ARGLIST ::= An optional argument list to be used for the advised function
-    instead of the argument list of the original.  The first one found in
-    before/around/after-advices will be used.
-FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'.
-    All flags can be specified with unambiguous initial substrings.
-DOCSTRING ::= Optional documentation for this piece of advice.
-INTERACTIVE-FORM ::= Optional interactive form to be used for the advised
-    function.  The first one found in before/around/after-advices will be used.
-BODY ::= Any s-expression.
-
-Semantics of the various flags:
-`protect': The piece of advice will be protected against non-local exits in
-any code that precedes it.  If any around-advice of a function is protected
-then automatically all around-advices will be protected (the complete onion).
-
-`activate': All advice of FUNCTION will be activated immediately if
-FUNCTION has been properly defined prior to this application of `defadvice'.
-
-`compile': In conjunction with `activate' specifies that the resulting
-advised function should be compiled.
-
-`disable': The defined advice will be disabled, hence, it will not be used 
-during activation until somebody enables it.
-
-`preactivate': Preactivates the advised FUNCTION at macro-expansion/compile
-time.  This generates a compiled advised definition according to the current
-advice state that will be used during activation if appropriate.  Only use
-this if the `defadvice' gets actually compiled.
-
-`freeze': Expands the `defadvice' into a redefining `defun/defmacro' according
-to this particular single advice.  No other advice information will be saved.
-Frozen advices cannot be undone, they behave like a hard redefinition of
-the advised function.  `freeze' implies `activate' and `preactivate'.  The
-documentation of the advised function can be dumped onto the `DOC' file
-during preloading.
-
-Look at the file `advice.el' for comprehensive documentation."
-  (if (not (ad-name-p function))
-      (error "defadvice: Illegal function name: %s" function))
-  (let* ((class (car args))
-	 (name (if (not (ad-class-p class))
-		   (error "defadvice: Illegal advice class: %s" class)
-		 (nth 1 args)))
-	 (position (if (not (ad-name-p name))
-		       (error "defadvice: Illegal advice name: %s" name)
-		     (setq args (nthcdr 2 args))
-		     (if (ad-position-p (car args))
-			 (prog1 (car args)
-			   (setq args (cdr args))))))
-	 (arglist (if (listp (car args))
-		      (prog1 (car args)
-			(setq args (cdr args)))))
-	 (flags
-	  (mapcar
-	   (function
-	    (lambda (flag)
-	      (let ((completion
-		     (try-completion (symbol-name flag) ad-defadvice-flags)))
-		(cond ((eq completion t) flag)
-		      ((assoc completion ad-defadvice-flags)
-		       (intern completion))
-		      (t (error "defadvice: Illegal or ambiguous flag: %s"
-				flag))))))
-	   args))
-	 (advice (ad-make-advice
-		  name (memq 'protect flags)
-		  (not (memq 'disable flags))
-		  (` (advice lambda (, arglist) (,@ body)))))
-	 (preactivation (if (memq 'preactivate flags)
-			    (ad-preactivate-advice
-			     function advice class position))))
-    ;; Now for the things to be done at evaluation time:
-    (if (memq 'freeze flags)
-	;; jwz's idea: Freeze the advised definition into a dumpable
-	;; defun/defmacro whose docs can be written to the DOC file:
-	(ad-make-freeze-definition function advice class position)
-      ;; the normal case:	 
-      (` (progn
-	   (ad-add-advice '(, function) '(, advice) '(, class) '(, position))
-	   (,@ (if preactivation
-		   (` ((ad-set-cache
-			'(, function)
-			;; the function will get compiled:
-			(, (cond ((ad-macro-p (car preactivation))
-				  (` (ad-macrofy
-				      (function
-				       (, (ad-lambdafy
-					   (car preactivation)))))))
-				 (t (` (function
-					(, (car preactivation)))))))
-			'(, (car (cdr preactivation))))))))
-	   (,@ (if (memq 'activate flags)
-		   (` ((ad-activate-on '(, function)
-				       (, (if (memq 'compile flags) t)))))))
-	   '(, function))))))
-
-
-;; @@ Tools:
-;; =========
-
-(defmacro ad-with-originals (functions &rest body)
-  "Binds FUNCTIONS to their original definitions and executes BODY.
-For any members of FUNCTIONS that are not currently advised the rebinding will
-be a noop.  Any modifications done to the definitions of FUNCTIONS will be
-undone on exit of this macro."
-  (let* ((index -1)
-	 ;; Make let-variables to store current definitions:
-	 (current-bindings
-	  (mapcar (function
-		   (lambda (function)
-		     (setq index (1+ index))
-		     (list (intern (format "ad-oRiGdEf-%d" index))
-			   (` (symbol-function '(, function))))))
-		  functions)))
-    (` (let (, current-bindings)
-	 (unwind-protect
-	     (progn
-	       (,@ (progn
-		     ;; Make forms to redefine functions to their
-		     ;; original definitions if they are advised:
-		     (setq index -1)
-		     (mapcar
-		      (function
-		       (lambda (function)
-			 (setq index (1+ index))
-			 (` (ad-safe-fset
-			     '(, function)
-			     (or (ad-get-orig-definition '(, function))
-				 (, (car (nth index current-bindings))))))))
-		      functions)))
-	       (,@ body))
-	   (,@ (progn
-		 ;; Make forms to back-define functions to the definitions
-		 ;; they had outside this macro call:
-		 (setq index -1)
-		 (mapcar
-		  (function
-		   (lambda (function)
-		     (setq index (1+ index))
-		     (` (ad-safe-fset
-			 '(, function)
-			 (, (car (nth index current-bindings)))))))
-		  functions))))))))
-
-(if (not (get 'ad-with-originals 'lisp-indent-hook))
-    (put 'ad-with-originals 'lisp-indent-hook 1))
-
-
-;; @@ Advising `documentation':
-;; ============================
-;; Use the advice mechanism to advise `documentation' to make it
-;; generate proper documentation strings for advised definitions:
-
-(defadvice documentation (after ad-advised-docstring first disable preact)
-  "Builds an advised docstring if FUNCTION is advised."
-  ;; Because we get the function name from the advised docstring
-  ;; this will work for function names as well as for definitions:
-  (if (and (stringp ad-return-value)
-	   (string-match
-	    ad-advised-definition-docstring-regexp ad-return-value))
-      (let ((function
-	     (car (read-from-string
-		   ad-return-value (match-beginning 1) (match-end 1)))))
-	(cond ((ad-is-advised function)
-	       (setq ad-return-value (ad-make-advised-docstring function))
-	       ;; Handle optional `raw' argument: 
-	       (if (not (ad-get-arg 1))
-		   (setq ad-return-value
-			 (substitute-command-keys ad-return-value))))))))
-
-
-;; @@ Starting, stopping and recovering from the advice package magic:
-;; ===================================================================
-
-(defun ad-start-advice ()
-  "Starts the automatic advice handling magic."
-  (interactive)
-  ;; Advising `ad-activate' means death!!
-  (ad-set-advice-info 'ad-activate nil)
-  (ad-safe-fset 'ad-activate 'ad-activate-on)
-  (ad-enable-advice 'documentation 'after 'ad-advised-docstring)
-  (ad-activate-on 'documentation 'compile))
-
-(defun ad-stop-advice ()
-  "Stops the automatic advice handling magic.
-You should only need this in case of Advice-related emergencies."
-  (interactive)
-  ;; Advising `ad-activate' means death!!
-  (ad-set-advice-info 'ad-activate nil)
-  (ad-disable-advice 'documentation 'after 'ad-advised-docstring)
-  (ad-update 'documentation)
-  (ad-safe-fset 'ad-activate 'ad-activate-off))
-
-(defun ad-recover-normality ()
-  "Undoes all advice related redefinitions and unadvises everything. 
-Use only in REAL emergencies."
-  (interactive)
-  ;; Advising `ad-activate' means death!!
-  (ad-set-advice-info 'ad-activate nil)
-  (ad-safe-fset 'ad-activate 'ad-activate-off)
-  (ad-recover-all)
-  (setq ad-advised-functions nil))
-
-;; Until the Advice-related changes to `data.c' are part of Lemacs we
-;; have to load the old implementation of advice activation hooks:
-;; XEmacs:  Not sure what this is supposed to accomplish.  There is no
-;;  ad-hooks.el. -sb
-;(if (ad-lemacs-p)
-;    (require 'ad-hooks))
-
-(ad-start-advice)
-
-(provide 'advice)
-
-;;; advice.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/annotations.el b/xemacs-packages/lisp/xemacs-base/annotations.el
deleted file mode 100644
index 5bfa949e..00000000
--- a/xemacs-packages/lisp/xemacs-base/annotations.el
+++ /dev/null
@@ -1,451 +0,0 @@
-;;; annotations.el --- interface to marginal annotations
-
-;; Copyright (C) 1992-1994 Free Software Foundation, Inc.
-
-;; Author: Chuck Thompson 
-;; Maintainer: XEmacs Development Team
-;; Created: 10-Oct-93
-;; Keywords: extensions, hypermedia, outlines
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; Enhanced by Andy Piper : 6-may-94
-
-;; Last modified:  12-May-95 by Chuck Thompson.
-
-;; The annotations are implemented on top of extents.  The extent property
-;; 'annotation of an extent being used as an annotation is vector of size 6:
-;;	[     ]
-;;
-
-;;; Code:
-
-;;;###autoload
-(defvar make-annotation-hook nil
-  "*Function or functions to run immediately after creating an annotation.")
-
-;;;###autoload
-(defvar before-delete-annotation-hook nil
-  "*Function or functions to run immediately before deleting an annotation.")
-
-;;;###autoload
-(defvar after-delete-annotation-hook nil
-  "*Function or functions to run immediately after deleting an annotation.")
-
-(defvar annotation-local-map-default
-  (let ((map (make-sparse-keymap)))
-    (set-keymap-name map 'annotation-local-map)
-    (define-key map 'button1 'annotation-activate-function-default)
-    (define-key map 'button3 'annotation-popup-menu)
-    map)
-  "Keymap used to activate annotations with only annotation data passed.")
-
-(defvar annotation-local-map-with-event
-  (let ((map (make-sparse-keymap)))
-    (set-keymap-name map 'annotation-local-map)
-    (define-key map 'button1 'annotation-activate-function-with-event)
-    (define-key map 'button3 'annotation-popup-menu)
-    map)
-  "Keymap used to activate annotations with annotation data and event passed.")
-
-;;
-;; When the mouse is pressed and released over an annotation glyph
-;; this will run the annotation action passing a single arg, the value
-;; of the annotation data field.
-;;
-(defun annotation-activate-function-default (event)
-  (interactive "e")
-  (let ((extent (event-glyph-extent event))
-	(mouse-down t)
-	(up-glyph nil))
-    ;; make the glyph look pressed
-    (cond ((annotation-down-glyph extent)
-	   (setq up-glyph (annotation-glyph extent))
-	   (set-annotation-glyph extent (annotation-down-glyph extent))))
-    (while mouse-down
-      (setq event (next-event event))
-      (if (button-release-event-p event)
-	  (setq mouse-down nil)))
-    ;; make the glyph look released
-    (cond ((annotation-down-glyph extent)
-	   (set-annotation-glyph extent up-glyph)))
-    (if (eq extent (event-glyph-extent event))
-	(if (annotation-action extent)
-	    (funcall (annotation-action extent) (annotation-data extent))))))
-
-;;
-;; When the mouse is pressed and released over an annotation glyph
-;; this will run the annotation action passing two args, the value
-;; of the annotation data field and the event which triggered the
-;; annotation.
-;;
-(defun annotation-activate-function-with-event (event)
-  (interactive "e")
-  (let ((extent (event-glyph-extent event))
-	(mouse-down t)
-	(up-glyph nil))
-    ;; make the glyph look pressed
-    (cond ((annotation-down-glyph extent)
-	   (setq up-glyph (annotation-glyph extent))
-	   (set-annotation-glyph extent (annotation-down-glyph extent))))
-    (while mouse-down
-      (setq event (next-event event))
-      (if (button-release-event-p event)
-	  (setq mouse-down nil)))
-    ;; make the glyph look released
-    (cond ((annotation-down-glyph extent)
-	   (set-annotation-glyph extent up-glyph)))
-    (if (eq extent (event-glyph-extent event))
-	(if (annotation-action extent)
-	    (funcall (annotation-action extent) (annotation-data extent)
-		     event)))))
-
-;; #### Glyphs should be glyphs should be glyphs
-;;;###autoload
-(defun make-annotation (glyph &optional pos layout buffer with-event d-glyph rightp)
-  "Create a marginal annotation, displayed using GLYPH, at position POS.
-GLYPH may be either a glyph object or a string.  Use layout policy
-LAYOUT and place the annotation in buffer BUFFER.  If POS is nil, point is
-used.  If LAYOUT is nil, `whitespace' is used.  If BUFFER is nil, the
-current buffer is used.  If WITH-EVENT is non-nil, then when an annotation
-is activated, the triggering event is passed as the second arg to the
-annotation function.  If D-GLYPH is non-nil then it is used as the glyph 
-that will be displayed when button1 is down.  If RIGHTP is non-nil then
-the glyph will be displayed on the right side of the buffer instead of the
-left."
-  (let ((new-annotation))
-    ;; get the buffer to add the annotation at
-    (if (not buffer)
-	(setq buffer (current-buffer))
-      (setq buffer (get-buffer buffer)))
-    ;; get the position to put it at
-    (if (not pos)
-	(save-excursion
-	  (set-buffer buffer)
-	  (setq pos (point))))
-    ;; make sure it gets some layout policy
-    (if (not layout)
-	(setq layout 'whitespace))
-
-    ;; make sure the glyph arguments are actually glyphs
-    (if (and glyph (not (glyphp glyph)))
-	(setq glyph (make-glyph glyph)))
-    (if (and d-glyph (not (glyphp d-glyph)))
-	(setq d-glyph (make-glyph d-glyph)))
-
-    ;; create the actual annotation
-    (setq new-annotation (make-extent pos pos buffer))
-    (detach-extent new-annotation)
-    (set-extent-endpoints new-annotation pos pos)
-    (if rightp
-	(set-extent-end-glyph new-annotation glyph layout)
-      (set-extent-begin-glyph new-annotation glyph layout))
-    (set-extent-property new-annotation 'annotation 
-			 (vector nil nil nil glyph d-glyph rightp))
-    (set-extent-property new-annotation 'end-closed t)
-    (set-extent-property new-annotation 'start-open t)
-    (set-extent-property new-annotation 'duplicable t)
-    (if with-event
-	(set-extent-property new-annotation 'keymap
-			     annotation-local-map-with-event)
-      (set-extent-property new-annotation 'keymap
-			   annotation-local-map-default))
-    (run-hook-with-args 'make-annotation-hook new-annotation)
-    new-annotation))
-
-(fset 'make-graphic-annotation 'make-annotation)
-(make-obsolete 'make-graphic-annotation 'make-annotation)
-
-;;;###autoload
-(defun delete-annotation (annotation)
-  "Remove ANNOTATION from its buffer.  This does not modify the buffer text."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (progn
-      (run-hook-with-args 'before-delete-annotation-hook annotation)
-      (delete-extent annotation)
-      (run-hooks 'after-delete-annotation-hook))))
-
-;;;###autoload
-(defun annotationp (annotation)
-  "T if OBJECT is an annotation."
-  (and (extent-live-p annotation)
-       (not (null (extent-property annotation 'annotation)))))
-
-(defun annotation-visible (annotation)
-  "T if there is enough available space to display ANNOTATION."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (not (extent-property annotation 'glyph-invisible))))
-
-;;;###autoload
-(defun annotation-at (&optional pos buffer)
-  "Return the first annotation at POS in BUFFER.
-BUFFER defaults to the current buffer.  POS defaults to point in BUFFER."
-  (car (annotations-at pos buffer)))
-(make-obsolete 'annotation-at 'annotations-at)
-
-(defun annotation-layout (annotation)
-  "Return the layout policy of annotation ANNOTATION.  The layout policy
-is set using `set-annotation-layout'."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (if (eq 'right (annotation-side annotation))
-	(extent-end-glyph-layout annotation)
-      (extent-begin-glyph-layout annotation))))
-
-
-(defun annotation-side (annotation)
-  "Return the side of the buffer the annotation is displayed on.
-Return value is either 'left or 'right."
-  (if (aref (extent-property annotation 'annotation) 5)
-      'right
-    'left))
-
-(defun set-annotation-layout (annotation layout)
-  "Set the layout policy of ANNOTATION to LAYOUT.  The function
-`annotation-layout' returns the current layout policy."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (if (eq 'right (annotation-side annotation))
-	(set-extent-end-glyph-layout annotation layout)
-      (set-extent-begin-glyph-layout annotation layout))))
-
-;; Now that annotations use glyphs this function has little value and
-;; will actually not work as is.
-;(defun annotation-type (annotation)
-;  "Return the display type of the annotation ANNOTATION.  The type will
-;be one of the following symbols:
-;
-;	pixmap
-;	bitmap
-;	string
-;	nil	(the object is not an annotation)"
-;  (if (not (annotationp annotation))
-;      nil
-;    (let ((glyph (annotation-glyph annotation)))
-;      (if (stringp glyph)
-;	  'stringp
-;	(if (not (pixmapp glyph))
-;	    (error "%s is a corrupt annotation" annotation)
-;	  (if (> (pixmap-depth glyph) 0)
-;	      'pixmap
-;	    'bitmap))))))
-(make-obsolete 'annotation-type "This function no longer has any meaning.")
-
-(defun annotation-width (annotation)
-  "Return the width of the annotation ANNOTATION in pixels."  
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (glyph-width (annotation-glyph annotation))))
-
-(defun annotation-glyph (annotation)
-  "If ANNOTATION is of type `string' return the string.  Otherwise, return
-the glyph object used to display ANNOTATION.  The glyph is set using
-`set-annotation-glyph'."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (aref (extent-property annotation 'annotation) 3)))
-
-(defun set-annotation-glyph (annotation glyph &optional layout side)
-  "Set the representation of ANNOTATION to GLYPH.
-GLYPH should be a glyph object.  If LAYOUT is non-nil, set the layout
-policy of the annotation to LAYOUT.  If SIDE is equal to 'left or 'right
-change the side of the annotation to that value.
-The function `annotation-glyph' returns the current glyph."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    ;; else
-    (or layout (setq layout (annotation-layout annotation)))
-    (or side   (setq side   (annotation-side   annotation)))
-    (cond ((eq side 'left)
-	   (set-extent-begin-glyph annotation glyph layout)
-	   (set-extent-end-glyph annotation nil)
-	   (aset (extent-property annotation 'annotation) 5 nil))
-	  ((eq side 'right)
-	   (set-extent-end-glyph annotation glyph layout)
-	   (set-extent-begin-glyph annotation nil)
-	   (aset (extent-property annotation 'annotation) 5 nil)))
-    (aset (extent-property annotation 'annotation) 3 glyph)
-    (annotation-glyph annotation)))
-
-(defun annotation-down-glyph (annotation)
-  "If ANNOTATION is of type `string' return the down string.  Otherwise,
-return the glyph object of the down-glyph representing ANNOTATION.
-The down-glyph is set using `set-annotation-down-glyph'."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (aref (extent-property annotation 'annotation) 4)))
-
-(defun set-annotation-down-glyph (annotation glyph)
-  "Set the depressed representation of ANNOTATION to GLYPH.  
-GLYPH should be a glyph object. 
-The function `annotation-down-glyph' returns the current down-glyph."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (aset (extent-property annotation 'annotation) 4 glyph)))
-
-(define-obsolete-function-alias 'annotation-graphic 'annotation-glyph)
-(define-obsolete-function-alias 'set-annotation-graphic 'set-annotation-glyph)
-  
-(defun annotation-data (annotation)
-  "Return the data associated with annotation ANNOTATION.  The data is
-set using `set-annotation-data'."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (aref (extent-property annotation 'annotation) 0)))
-
-(defun set-annotation-data (annotation data)
-  "Set the data field of ANNOTATION to DATA.
-The function `annotation-data' returns the current data."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (aset (extent-property annotation 'annotation) 0 data)))
-
-(defun annotation-action (annotation)
-  "Return the action associated with annotation ANNOTATION.  The action
-is set using `set-annotation-action'."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (aref (extent-property annotation 'annotation) 1)))
-
-(defun set-annotation-action (annotation action)
-  "Set the action field of ANNOTATION to ACTION.
-The function `annotation-action' returns the current action."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (aset (extent-property annotation 'annotation) 1 action)))
-
-(defun annotation-face (annotation)
-  "Return the face associated with annotation ANNOTATION.
-The face is set using `set-annotation-face'."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (extent-face annotation)))
-
-(defun set-annotation-face (annotation face)
-  "Set the face associated with annotation ANNOTATION to FACE.
-The function `annotation-face' returns the current face."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (set-extent-face annotation face)))
-
-(defun hide-annotation (annotation)
-  "Remove ANNOTATION's glyph so that it is invisible."
-  (if (eq (annotation-side annotation) 'left)
-      (set-extent-begin-glyph annotation nil)
-    (set-extent-end-glyph annotation nil)))
-(define-obsolete-function-alias 'annotation-hide 'hide-annotation)
-
-(defun reveal-annotation (annotation)
-  "Add ANNOTATION's glyph so that it is visible."
-  (if (eq (annotation-side annotation) 'left)
-      (set-extent-begin-glyph annotation (annotation-glyph annotation))
-    (set-extent-end-glyph annotation (annotation-glyph annotation))))
-(define-obsolete-function-alias 'annotation-reveal 'reveal-annotation)
-
-;;;###autoload
-(defun annotations-in-region (start end buffer)
-  "Return all annotations in BUFFER between START and END inclusively."
-  (save-excursion
-    (set-buffer buffer)
-
-    (if (< start (point-min))
-      (error " not in range of buffer"))
-    (if (> end (point-max))
-      (error " not in range of buffer"))
-
-    (let (note-list)
-      (map-extents #'(lambda (extent dummy)
-		       (progn
-			 (setq note-list (cons extent note-list))
-			 nil))
-		   buffer start end nil 'end-closed 'annotation)
-      note-list)))
-
-;;;###autoload
-(defun annotations-at (&optional pos buffer)
-  "Return a list of all annotations at POS in BUFFER.
-If BUFFER is nil, the current buffer is used.  If POS is nil, point is used."
-  (if (not buffer)
-      (setq buffer (current-buffer)))
-  (if (not pos)
-      (save-excursion
-	(set-buffer buffer)
-	(setq pos (point))))
-
-  (annotations-in-region pos pos buffer)
-)
-
-;;;###autoload
-(defun annotation-list (&optional buffer)
-  "Return a list of all annotations in BUFFER.
-If BUFFER is nil, the current buffer is used."
-  (if (not buffer)
-    (setq buffer (current-buffer)))
-
-  (save-excursion
-    (set-buffer buffer)
-    (annotations-in-region (point-min) (point-max) buffer)))
-
-;;;###autoload
-(defun all-annotations ()
-  "Return a list of all annotations in existence."
-  (let ((b (buffer-list))
-	result)
-    (while b
-      (setq result (nconc result (annotation-list (car b))))
-      (setq b (cdr b)))
-    result))
-
-;;; #### really this menus junk should append to the prevailing menu
-;;;      in the same way `popup-mode-menu' does.  --jwz
-
-;; annotations menu stuff
-(defun annotation-popup-menu (event)
-  "Pop up a menu of annotations commands.
-Point is temporarily moved to the click position."
-  (interactive "e")
-  (let ((extent (event-glyph-extent event)))
-    (save-excursion
-      (goto-char (extent-end-position extent))
-      (if (annotation-menu extent)
-	  (popup-menu (annotation-menu extent))
-	(popup-mode-menu)))))
-
-(defun set-annotation-menu (annotation menu)
-  "Set the menu field of ANNOTATION to MENU.  The function
-`annotation-menu' returns the current menu."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (aset (extent-property annotation 'annotation) 2 menu)))
-
-(defun annotation-menu (annotation)
-  "Return the menu associated with annotation ANNOTATION.  The menu
-is set using `set-annotation-menu'."
-  (if (not (annotationp annotation))
-      (error "%s is not an annotation" annotation)
-    (aref (extent-property annotation 'annotation) 2)))
-
-(provide 'annotations)
-
-;;; annotations.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/assoc.el b/xemacs-packages/lisp/xemacs-base/assoc.el
deleted file mode 100644
index 83403896..00000000
--- a/xemacs-packages/lisp/xemacs-base/assoc.el
+++ /dev/null
@@ -1,143 +0,0 @@
-;;; assoc.el --- insert/delete/sort functions on association lists
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Barry A. Warsaw 
-;; Maintainer: XEmacs Development Team
-;; Keywords: extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;; Association list utilities providing insertion, deletion, sorting
-;; fetching off key-value pairs in association lists.
-
-;;; Code:
-
-(defun asort (alist-symbol key)
-  "Move a specified key-value pair to the head of an alist.
-The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
-head is one matching KEY.  Returns the sorted list and doesn't affect
-the order of any other key-value pair.  Side effect sets alist to new
-sorted list."
-  (set alist-symbol
-       (sort (copy-alist (eval alist-symbol))
-	     (function (lambda (a b) (equal (car a) key))))))
-
-
-(defun aelement (key value)
-  "Makes a list of a cons cell containing car of KEY and cdr of VALUE.
-The returned list is suitable as an element of an alist."
-  (list (cons key value)))
-
-
-(defun aheadsym (alist)
-  "Return the key symbol at the head of ALIST."
-  (car (car alist)))
-
-
-(defun anot-head-p (alist key)
-  "Find out if a specified key-value pair is not at the head of an alist.
-The alist to check is specified by ALIST and the key-value pair is the
-one matching the supplied KEY.  Returns nil if ALIST is nil, or if
-key-value pair is at the head of the alist.  Returns t if key-value
-pair is not at the head of alist.  ALIST is not altered."
-  (not (equal (aheadsym alist) key)))
-
-
-(defun aput (alist-symbol key &optional value)
-  "Inserts a key-value pair into an alist.
-The alist is referenced by ALIST-SYMBOL. The key-value pair is made
-from KEY and optionally, VALUE. Returns the altered alist or nil if
-ALIST is nil.
-
-If the key-value pair referenced by KEY can be found in the alist, and
-VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
-If VALUE is not supplied, or is nil, the key-value pair will not be
-modified, but will be moved to the head of the alist. If the key-value
-pair cannot be found in the alist, it will be inserted into the head
-of the alist (with value nil if VALUE is nil or not supplied)."
-  (let ((elem (aelement key value))
-	alist)
-    (asort alist-symbol key)
-    (setq alist (eval alist-symbol))
-    (cond ((null alist) (set alist-symbol elem))
-	  ((anot-head-p alist key) (set alist-symbol (nconc elem alist)))
-	  (value (setcar alist (car elem)))
-	  (t alist))))
-
-
-(defun adelete (alist-symbol key)
-  "Delete a key-value pair from the alist.
-Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
-is pair matching KEY.  Returns the altered alist."
-  (asort alist-symbol key)
-  (let ((alist (eval alist-symbol)))
-    (cond ((null alist) nil)
-	  ((anot-head-p alist key) alist)
-	  (t (set alist-symbol (cdr alist))))))
-
-
-(defun aget (alist key &optional keynil-p)
-  "Returns the value in ALIST that is associated with KEY.
-Optional KEYNIL-P describes what to do if the value associated with
-KEY is nil.  If KEYNIL-P is not supplied or is nil, and the value is
-nil, then KEY is returned.  If KEYNIL-P is non-nil, then nil would be
-returned.
-
-If no key-value pair matching KEY could be found in ALIST, or ALIST is
-nil then nil is returned. ALIST is not altered."
-  (let ((copy (copy-alist alist)))
-    (cond ((null alist) nil)
-	  ((progn (asort 'copy key)
-		  (anot-head-p copy key)) nil)
-	  ((cdr (car copy)))
-	  (keynil-p nil)
-	  ((car (car copy)))
-	  (t nil))))
-
-
-(defun amake (alist-symbol keylist &optional valuelist)
-  "Make an association list.
-The association list is attached to the alist referenced by
-ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is
-associated with the value in VALUELIST with the same index. If
-VALUELIST is not supplied or is nil, then each key in KEYLIST is
-associated with nil.
-
-KEYLIST and VALUELIST should have the same number of elements, but
-this isn't enforced.  If VALUELIST is smaller than KEYLIST, remaining
-keys are associated with nil.  If VALUELIST is larger than KEYLIST,
-extra values are ignored.  Returns the created alist."
-  (let ((keycar (car keylist))
-	(keycdr (cdr keylist))
-	(valcar (car valuelist))
-	(valcdr (cdr valuelist)))
-    (cond ((null keycdr)
-	   (aput alist-symbol keycar valcar))
-	  (t
-	   (amake alist-symbol keycdr valcdr)
-	   (aput alist-symbol keycar valcar))))
-  (eval alist-symbol))
-
-(provide 'assoc)
-
-;;; assoc.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/auto-autoloads.el b/xemacs-packages/lisp/xemacs-base/auto-autoloads.el
deleted file mode 100644
index 9c455c31..00000000
--- a/xemacs-packages/lisp/xemacs-base/auto-autoloads.el
+++ /dev/null
@@ -1,1827 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'xemacs-base-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "xemacs-base/_pkg.el")
-
-(package-provide 'xemacs-base :version 2.03 :author-version "No-Upstream-Ver" :type 'regular)
-
-(when (fboundp 'package-suppress) (package-suppress 'xemacs-base "regexp-opt" '(fboundp 'package-suppress)) (package-suppress 'xemacs-base "easy-mmode" '(fboundp 'package-suppress)))
-
-;;;***
-
-;;;### (autoloads (change-log-redate patch-to-change-log change-log-merge add-log-current-defun change-log-mode add-change-log-entry-other-window add-change-log-entry find-change-log prompt-for-change-log-name add-log-convert iso8601-time-string) "add-log" "xemacs-base/add-log.el")
-
-(autoload 'iso8601-time-string "add-log" nil nil nil)
-
-(autoload 'add-log-convert "add-log" "\
-Convert the current buffer from the old ChangeLog format to new.
-The old ChangeLogs (before XEmacs 20.2) were created with attribution
-lines looking like this:
-
-Mon Feb 10 22:20:16 1997  Hrvoje Niksic  
-
-The same line in new format looks like this:
-
-1997-02-10  Hrvoje Niksic  " t nil)
-
-(autoload 'prompt-for-change-log-name "add-log" "\
-Prompt for a change log name." nil nil)
-
-(autoload 'find-change-log "add-log" "\
-Find a change log file for \\[add-change-log-entry] and return the name.
-
-Optional arg FILE-NAME specifies the file to use.
-If FILE-NAME is nil, use the value of `change-log-default-name'.
-If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
-\(or whatever we use on this operating system).
-
-If 'change-log-default-name' contains a leading directory component, then
-simply find it in the current directory.  Otherwise, search in the current
-directory and its successive parents for a file so named.
-
-Once a file is found, `change-log-default-name' is set locally in the
-current buffer to the complete file name.
-Optional arg BUFFER-FILE overrides `buffer-file-name'." nil nil)
-
-(autoload 'add-change-log-entry "add-log" "\
-Find change log file, and add an entry for today and an item for this file.
-Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
-name and site.
-
-Second arg FILE-NAME is file name of the change log.
-If nil, use the value of `change-log-default-name'.
-
-Third arg OTHER-WINDOW non-nil means visit in other window.
-
-Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
-never append to an existing entry.  Option `add-log-keep-changes-together'
-otherwise affects whether a new entry is created.
-
-Option `add-log-always-start-new-record' non-nil means always create a
-new record, even when the last record was made on the same date and by
-the same person.
-
-The change log file can start with a copyright notice and a copying
-permission notice.  The first blank line indicates the end of these
-notices.
-
-Today's date is calculated according to `change-log-time-zone-rule' if
-non-nil, otherwise in local time." t nil)
-
-(autoload 'add-change-log-entry-other-window "add-log" "\
-Find change log file in other window and add entry and item.
-This is just like `add-change-log-entry' except that it displays
-the change log file in another window." t nil)
-(define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
-
-(autoload 'change-log-mode "add-log" "Major mode for editing change logs; like Indented Text Mode.\nPrevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.\nNew log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].\nEach entry behaves as a paragraph, and the entries for one day as a page.\nRuns `change-log-mode-hook'." t nil)
-
-(defvar add-log-lisp-like-modes '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode) "\
-*Modes that look like Lisp to `add-log-current-defun'.")
-
-(defvar add-log-c-like-modes '(c-mode c++-mode c++-c-mode objc-mode java-mode) "\
-*Modes that look like C to `add-log-current-defun'.")
-
-(defvar add-log-tex-like-modes '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode) "\
-*Modes that look like TeX to `add-log-current-defun'.")
-
-(autoload 'add-log-current-defun "add-log" "\
-Return name of function definition point is in, or nil.
-
-Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
-Texinfo (@node titles) and Perl.
-
-Other modes are handled by a heuristic that looks in the 10K before
-point for uppercase headings starting in the first column or
-identifiers followed by `:' or `='.  See variables
-`add-log-current-defun-header-regexp' and
-`add-log-current-defun-function'.
-
-Has a preference of looking backwards." nil nil)
-
-(autoload 'change-log-merge "add-log" "\
-Merge the contents of ChangeLog file OTHER-LOG with this buffer.
-Both must be found in Change Log mode (since the merging depends on
-the appropriate motion commands).  OTHER-LOG can be either a file name
-or a buffer.
-
-Entries are inserted in chronological order.  Both the current and
-old-style time formats for entries are supported." t nil)
-
-(autoload 'patch-to-change-log "add-log" "\
-Convert the unified diff in the current buffer into a ChangeLog.
-DEVDIR (queried interactively) specifies the directory the diff was
-made relative to.  The ChangeLog entries are added to the appropriate
-ChangeLog files (generally in the same directory as the diffed file but
-possibly in a parent directory), which are left as modified Emacs buffers
-but not saved out to disk.  After running this, you should go to the various
-buffers and annotate the entries appropriately.
-
-To work on a region on the current buffer, narrow to that region first.
-
-NOTE: This function handles diff output both from `cvs diff' and just
-running `diff' directly, but *ONLY* unified-format (-u) diffs. #### Someone
-should fix this to handle context diffs as well.
-
-The following keys are allowed:
-- :my-name defines the name to use in ChangeLog entries
-  (defaults to `(or add-log-full-name (user-full-name))'),
-- :my-email defines the email address to use in ChangeLog entries
-  (defaults to `(or add-log-mailing-address (user-mail-address))'),
-- :dry-run prevents `patch-to-changelog' from generating the ChangeLog
-   entries: ChangeLog files are only loaded (defaults to nil),
-- :keep-source-files prevents `patch-to-changelog' from killing the source
-  file buffers after the ChangeLog skeleton is created
-  (defaults to nil),
-- :extent-property instructs `patch-to-changelog' to create extents
-  containing the newly created ChangeLog entries, with that property set
-  (defaults to nil),
-- :extent-property-value is used in conjunction with :extent-property to
-  specify a value for the extent property
-  (defaults to nil)." t nil)
-
-(autoload 'change-log-redate "add-log" "\
-Fix any old-style date entries in the current log file to default format." t nil)
-(add-to-list 'auto-mode-alist '("[Cc]hange.?[Ll]og?\\(?:.[0-9]+\\)?\\'" . change-log-mode))
-(add-to-list 'auto-mode-alist '("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode))
-
-;;;***
-
-;;;### (autoloads (defadvice ad-add-advice) "advice" "xemacs-base/advice.el")
-
-(defvar ad-redefinition-action 'warn "\
-*Defines what to do with redefinitions during Advice de/activation.
-Redefinition occurs if a previously activated function that already has an
-original definition associated with it gets redefined and then de/activated.
-In such a case we can either accept the current definition as the new
-original definition, discard the current definition and replace it with the
-old original, or keep it and raise an error.  The values `accept', `discard',
-`error' or `warn' govern what will be done.  `warn' is just like `accept' but
-it additionally prints a warning message.  All other values will be
-interpreted as `error'.")
-
-(defvar ad-default-compilation-action 'maybe "\
-*Defines whether to compile advised definitions during activation.
-A value of `always' will result in unconditional compilation, `never' will
-always avoid compilation, `maybe' will compile if the byte-compiler is already
-loaded, and `like-original' will compile if the original definition of the
-advised function is compiled or a built-in function. Every other value will
-be interpreted as `maybe'. This variable will only be considered if the 
-COMPILE argument of `ad-activate' was supplied as nil.")
-
-(autoload 'ad-add-advice "advice" "\
-Adds a piece of ADVICE to FUNCTION's list of advices in CLASS.
-If FUNCTION already has one or more pieces of advice of the specified
-CLASS then POSITION determines where the new piece will go.  The value
-of POSITION can either be `first', `last' or a number where 0 corresponds
-to `first'.  Numbers outside the range will be mapped to the closest
-extreme position.  If there was already a piece of ADVICE with the same
-name, then the position argument will be ignored and the old advice
-will be overwritten with the new one.
-    If the FUNCTION was not advised already, then its advice info will be 
-initialized.  Redefining a piece of advice whose name is part of the cache-id
-will clear the cache." nil nil)
-
-(autoload 'defadvice "advice" "\
-Defines a piece of advice for FUNCTION (a symbol).
-The syntax of `defadvice' is as follows:
-
-  (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
-    [DOCSTRING] [INTERACTIVE-FORM]
-    BODY... )
-
-FUNCTION ::= Name of the function to be advised.
-CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'.
-NAME ::= Non-nil symbol that names this piece of advice.
-POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first',
-    see also `ad-add-advice'.
-ARGLIST ::= An optional argument list to be used for the advised function
-    instead of the argument list of the original.  The first one found in
-    before/around/after-advices will be used.
-FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'.
-    All flags can be specified with unambiguous initial substrings.
-DOCSTRING ::= Optional documentation for this piece of advice.
-INTERACTIVE-FORM ::= Optional interactive form to be used for the advised
-    function.  The first one found in before/around/after-advices will be used.
-BODY ::= Any s-expression.
-
-Semantics of the various flags:
-`protect': The piece of advice will be protected against non-local exits in
-any code that precedes it.  If any around-advice of a function is protected
-then automatically all around-advices will be protected (the complete onion).
-
-`activate': All advice of FUNCTION will be activated immediately if
-FUNCTION has been properly defined prior to this application of `defadvice'.
-
-`compile': In conjunction with `activate' specifies that the resulting
-advised function should be compiled.
-
-`disable': The defined advice will be disabled, hence, it will not be used 
-during activation until somebody enables it.
-
-`preactivate': Preactivates the advised FUNCTION at macro-expansion/compile
-time.  This generates a compiled advised definition according to the current
-advice state that will be used during activation if appropriate.  Only use
-this if the `defadvice' gets actually compiled.
-
-`freeze': Expands the `defadvice' into a redefining `defun/defmacro' according
-to this particular single advice.  No other advice information will be saved.
-Frozen advices cannot be undone, they behave like a hard redefinition of
-the advised function.  `freeze' implies `activate' and `preactivate'.  The
-documentation of the advised function can be dumped onto the `DOC' file
-during preloading.
-
-Look at the file `advice.el' for comprehensive documentation." nil 'macro)
-
-;;;***
-
-;;;### (autoloads (all-annotations annotation-list annotations-at annotations-in-region annotation-at annotationp delete-annotation make-annotation) "annotations" "xemacs-base/annotations.el")
-
-(defvar make-annotation-hook nil "\
-*Function or functions to run immediately after creating an annotation.")
-
-(defvar before-delete-annotation-hook nil "\
-*Function or functions to run immediately before deleting an annotation.")
-
-(defvar after-delete-annotation-hook nil "\
-*Function or functions to run immediately after deleting an annotation.")
-
-(autoload 'make-annotation "annotations" "\
-Create a marginal annotation, displayed using GLYPH, at position POS.
-GLYPH may be either a glyph object or a string.  Use layout policy
-LAYOUT and place the annotation in buffer BUFFER.  If POS is nil, point is
-used.  If LAYOUT is nil, `whitespace' is used.  If BUFFER is nil, the
-current buffer is used.  If WITH-EVENT is non-nil, then when an annotation
-is activated, the triggering event is passed as the second arg to the
-annotation function.  If D-GLYPH is non-nil then it is used as the glyph 
-that will be displayed when button1 is down.  If RIGHTP is non-nil then
-the glyph will be displayed on the right side of the buffer instead of the
-left." nil nil)
-
-(autoload 'delete-annotation "annotations" "\
-Remove ANNOTATION from its buffer.  This does not modify the buffer text." nil nil)
-
-(autoload 'annotationp "annotations" "\
-T if OBJECT is an annotation." nil nil)
-
-(autoload 'annotation-at "annotations" "\
-Return the first annotation at POS in BUFFER.
-BUFFER defaults to the current buffer.  POS defaults to point in BUFFER." nil nil)
-
-(autoload 'annotations-in-region "annotations" "\
-Return all annotations in BUFFER between START and END inclusively." nil nil)
-
-(autoload 'annotations-at "annotations" "\
-Return a list of all annotations at POS in BUFFER.
-If BUFFER is nil, the current buffer is used.  If POS is nil, point is used." nil nil)
-
-(autoload 'annotation-list "annotations" "\
-Return a list of all annotations in BUFFER.
-If BUFFER is nil, the current buffer is used." nil nil)
-
-(autoload 'all-annotations "annotations" "\
-Return a list of all annotations in existence." nil nil)
-
-;;;***
-
-;;;### (autoloads (describe-buffer-case-table) "case-table" "xemacs-base/case-table.el")
-
-(autoload 'describe-buffer-case-table "case-table" "\
-Describe the case table of the current buffer." t nil)
-
-;;;***
-
-;;;### (autoloads (command-history-mode list-command-history repeat-matching-complex-command) "chistory" "xemacs-base/chistory.el")
-
-(autoload 'repeat-matching-complex-command "chistory" "\
-Edit and re-evaluate complex command with name matching PATTERN.
-Matching occurrences are displayed, most recent first, until you select
-a form for evaluation.  If PATTERN is empty (or nil), every form in the
-command history is offered.  The form is placed in the minibuffer for
-editing and the result is evaluated." t nil)
-
-(autoload 'list-command-history "chistory" "\
-List history of commands typed to minibuffer.
-The number of commands listed is controlled by `list-command-history-max'.
-Calls value of `list-command-history-filter' (if non-nil) on each history
-element to judge if that element should be excluded from the list.
-
-The buffer is left in Command History mode." t nil)
-
-(autoload 'command-history-mode "chistory" "\
-Major mode for examining commands from `command-history'.
-The number of commands listed is controlled by `list-command-history-max'.
-The command history is filtered by `list-command-history-filter' if non-nil.
-Use \\\\[command-history-repeat] to repeat the command on the current line.
-
-Otherwise much like Emacs-Lisp Mode except that there is no self-insertion
-and digits provide prefix arguments.  Tab does not indent.
-\\{command-history-map}
-Calls the value of `command-history-hook' if that is non-nil.
-The Command History listing is recomputed each time this mode is invoked." t nil)
-
-;;;***
-
-;;;### (autoloads (comint-dynamic-list-completions comint-dynamic-complete comint-run make-comint comint-mode) "comint" "xemacs-base/comint.el")
-
-(autoload 'comint-mode "comint" "\
-Major mode for interacting with an inferior interpreter.
-Interpreter name is same as buffer name, sans the asterisks.
-Return at end of buffer sends line as input.
-Return not at end copies rest of line to end and sends it.
-Setting variable `comint-eol-on-send' means jump to the end of the line
-before submitting new input.
-
-This mode is customised to create major modes such as Inferior Lisp
-mode, Shell mode, etc.  This can be done by setting the hooks
-`comint-input-filter-functions', `comint-input-filter', `comint-input-sender'
-and `comint-get-old-input' to appropriate functions, and the variable
-`comint-prompt-regexp' to the appropriate regular expression.
-
-An input history is maintained of size `comint-input-ring-size', and
-can be accessed with the commands \\[comint-next-input], \\[comint-previous-input], and \\[comint-dynamic-list-input-ring].
-Input ring history expansion can be achieved with the commands
-\\[comint-replace-by-expanded-history] or \\[comint-magic-space].
-Input ring expansion is controlled by the variable `comint-input-autoexpand',
-and addition is controlled by the variable `comint-input-ignoredups'.
-
-Commands with no default key bindings include `send-invisible',
-`comint-dynamic-complete', `comint-dynamic-list-filename-completions', and
-`comint-magic-space'.
-
-Input to, and output from, the subprocess can cause the window to scroll to
-the end of the buffer.  See variables `comint-output-filter-functions',
-`comint-scroll-to-bottom-on-input', and `comint-scroll-to-bottom-on-output'.
-
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it.
-
-\\{comint-mode-map}
-
-Entry to this mode runs the hooks on `comint-mode-hook'." t nil)
-
-(autoload 'make-comint "comint" "\
-Make a comint process NAME in a buffer, running PROGRAM.
-The name of the buffer is made by surrounding NAME with `*'s.
-PROGRAM should be either a string denoting an executable program to create
-via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP
-connection to be opened via `open-network-stream'.  If there is already a
-running process in that buffer, it is not restarted.  Optional third arg
-STARTFILE is the name of a file to send the contents of to the process.
-
-If PROGRAM is a string, any more args are arguments to PROGRAM." nil nil)
-
-(autoload 'comint-run "comint" "\
-Run PROGRAM in a comint buffer and switch to it.
-The buffer name is made by surrounding the file name of PROGRAM with `*'s.
-The file name is used to make a symbol name, such as `comint-sh-hook', and any
-hooks on this symbol are run in the buffer.
-See `make-comint' and `comint-exec'." t nil)
-
-(autoload 'comint-dynamic-complete "comint" "\
-Dynamically perform completion at point.
-Calls the functions in `comint-dynamic-complete-functions' to perform
-completion until a function returns non-nil, at which point completion is
-assumed to have occurred." t nil)
-
-(autoload 'comint-dynamic-list-completions "comint" "\
-List in help buffer sorted COMPLETIONS.
-Typing SPC flushes the help buffer." nil nil)
-
-;;;***
-
-;;;### (autoloads (first-error previous-error next-error compilation-minor-mode compilation-shell-minor-mode compilation-mode grep-all-files-in-current-directory-and-below grep-all-files-in-current-directory grep-find grep compile) "compile" "xemacs-base/compile.el")
-
-(defcustom compilation-mode-hook nil "*List of hook functions run by `compilation-mode' (see `run-hooks')." :type 'hook :group 'compilation)
-
-(defcustom compilation-window-height nil "*Number of lines in a compilation window.  If nil, use Emacs default." :type '(choice (const nil) integer) :group 'compilation)
-
-(defcustom compilation-buffer-name-function nil "Function to compute the name of a compilation buffer.\nThe function receives one argument, the name of the major mode of the\ncompilation buffer.  It should return a string.\nnil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'." :type 'function :group 'compilation)
-
-(defcustom compilation-finish-function nil "*Function to call when a compilation process finishes.\nIt is called with two arguments: the compilation buffer, and a string\ndescribing how the process finished." :type 'function :group 'compilation)
-
-(defcustom compilation-search-path '(nil) "*List of directories to search for source files named in error messages.\nElements should be directory names, not file names of directories.\nnil as an element means to try the default directory." :type '(repeat (choice (const :tag "Default" nil) directory)) :group 'compilation)
-
-(autoload 'compile "compile" "\
-Compile the program including the current buffer.  Default: run `make'.
-Runs COMMAND, a shell command, in a separate process asynchronously
-with output going to the buffer `*compilation*'.
-
-You can then use the command \\[next-error] to find the next error message
-and move to the source code that caused it.
-
-Interactively, prompts for the command if `compilation-read-command' is
-non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
-
-To run more than one compilation at once, start one and rename the
-`*compilation*' buffer to some other name with \\[rename-buffer].
-Then start the next one.
-
-The name used for the buffer is actually whatever is returned by
-the function in `compilation-buffer-name-function', so you can set that
-to a function that generates a unique name." t nil)
-
-(autoload 'grep "compile" "\
-Run grep, with user-specified args, and collect output in a buffer.
-While grep runs asynchronously, you can use the \\[next-error] command
-to find the text that grep hits refer to.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a grep command." t nil)
-
-(autoload 'grep-find "compile" "\
-Run grep via find, with user-specified args COMMAND-ARGS.
-Collect output in a buffer.
-While find runs asynchronously, you can use the \\[next-error] command
-to find the text that grep hits refer to.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a find command." t nil)
-
-(autoload 'grep-all-files-in-current-directory "compile" "\
-Run `grep' in all non-annoying files in the current directory.
-`Non-annoying' excludes backup files, autosave files, CVS merge files, etc.
-More specifically, this is controlled by `grep-all-files-omitted-expressions'.
-
-This function does not recurse into subdirectories.  If you want this,
-use \\[grep-all-files-in-current-directory-and-below]." t nil)
-
-(autoload 'grep-all-files-in-current-directory-and-below "compile" "\
-Run `grep' in all non-annoying files in the current directory and below.
-`Non-annoying' excludes backup files, autosave files, CVS merge files, etc.
-More specifically, this is controlled by `grep-all-files-omitted-expressions'.
-
-This function recurses into subdirectories.  If you do not want this,
-use \\[grep-all-files-in-current-directory]." t nil)
-
-(defvar compilation-minor-mode-map (let ((map (make-sparse-keymap))) (set-keymap-name map 'compilation-minor-mode-map) (define-key map "" 'compile-goto-error) (define-key map "
" 'compile-goto-error) (define-key map "" 'kill-compilation) (define-key map "î" 'compilation-next-error) (define-key map "ð" 'compilation-previous-error) (define-key map "û" 'compilation-previous-file) (define-key map "ý" 'compilation-next-file) map) "\
-Keymap for `compilation-minor-mode'.")
-
-(defvar compilation-shell-minor-mode-map (let ((map (make-sparse-keymap))) (define-key map "" 'compile-goto-error) (define-key map "Ž" 'compilation-next-error) (define-key map "" 'compilation-previous-error) (define-key map "û" 'compilation-previous-file) (define-key map "ý" 'compilation-next-file) map) "\
-Keymap for `compilation-shell-minor-mode'.")
-
-(autoload 'compilation-mode "compile" "\
-Major mode for compilation log buffers.
-\\To visit the source for a line-numbered error,
-move point to the error message line and type \\[compile-goto-error],
-or click on the line with \\[compile-mouse-goto-error].
-There is a menu of commands on \\[compile-popup-menu].
-To kill the compilation, type \\[kill-compilation].
-
-Runs `compilation-mode-hook' with `run-hooks' (which see)." t nil)
-
-(defvar compilation-shell-minor-mode nil "\
-Non-nil when in compilation-shell-minor-mode.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available but bound to keys that don't
-collide with Shell mode.")
-
-(defvar compilation-minor-mode nil "\
-Non-nil when in compilation-minor-mode.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available.")
-
-(autoload 'compilation-shell-minor-mode "compile" "\
-Toggle compilation shell minor mode.
-With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
-Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'." t nil)
-
-(add-minor-mode 'compilation-shell-minor-mode " Shell-Compile" compilation-shell-minor-mode-map 'view-minor-mode compilation-shell-minor-mode)
-
-(autoload 'compilation-minor-mode "compile" "\
-Toggle compilation minor mode.
-With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
-! \\{compilation-mode-map}" t nil)
-
-(add-minor-mode 'compilation-minor-mode " CMPL" compilation-minor-mode-map 'view-minor-mode compilation-minor-mode)
-
-(autoload 'next-error "compile" "\
-Visit next compilation error message and corresponding source code.
-
-If all the error messages parsed so far have been processed already,
-the message buffer is checked for new ones.
-
-A prefix ARGP specifies how many error messages to move;
-negative means move back to previous error messages.
-Just \\[universal-argument] as a prefix means reparse the error message buffer
-and start at the first error.
-
-\\[next-error] normally uses the most recently started compilation or
-grep buffer.  However, it can operate on any buffer with output from
-the \\[compile] and \\[grep] commands, or, more generally, on any
-buffer in Compilation mode or with Compilation Minor mode enabled.  To
-specify use of a particular buffer for error messages, type
-\\[next-error] in that buffer.
-
-Once \\[next-error] has chosen the buffer for error messages,
-it stays with that buffer until you use it in some other buffer which
-uses Compilation mode or Compilation Minor mode.
-
-See variables `compilation-parse-errors-function' and
-`compilation-error-regexp-alist' for customization ideas." t nil)
-(define-key ctl-x-map "`" 'next-error)
-
-(autoload 'previous-error "compile" "\
-Visit previous compilation error message and corresponding source code.
-
-A prefix ARGP specifies how many error messages to move;
-negative means move forward to next error messages.
-
-This operates on the output from the \\[compile] and \\[grep] commands." t nil)
-
-(autoload 'first-error "compile" "\
-Reparse the error message buffer and start at the first error.
-Visit corresponding source code.
-This operates on the output from the \\[compile] command." t nil)
-
-;;;***
-
-;;;### (autoloads (toggle-debug-on-quit toggle-debug-on-signal toggle-debug-on-error cancel-debug-on-entry debug-on-entry debug) "debug" "xemacs-base/debug.el")
-
-(autoload 'debug "debug" "\
-Enter debugger.  To return, type \\`\\[debugger-continue]'.
-Arguments are mainly for use when this is called from the internals
-of the evaluator.
-
-You may call with no args, or you may pass nil as the first arg and
-any other args you like.  In that case, the list of args after the
-first will be printed into the backtrace buffer." t nil)
-
-(autoload 'debug-on-entry "debug" "\
-Request FUNCTION to invoke debugger each time it is called.
-If you tell the debugger to continue, FUNCTION's execution proceeds.
-This works by modifying the definition of FUNCTION,
-which must be written in Lisp, not predefined.
-Use \\[cancel-debug-on-entry] to cancel the effect of this command.
-Redefining FUNCTION also cancels it." t nil)
-
-(autoload 'cancel-debug-on-entry "debug" "\
-Undo effect of \\[debug-on-entry] on FUNCTION.
-If argument is nil or an empty string, cancel for all functions." t nil)
-
-(autoload 'toggle-debug-on-error "debug" "\
-Toggle the status of debug-on-error.
-With arg, set debug-on-error iff arg is positive." t nil)
-
-(autoload 'toggle-debug-on-signal "debug" "\
-Toggle the status of debug-on-signal.
-With arg, set debug-on-signal iff arg is positive." t nil)
-
-(autoload 'toggle-debug-on-quit "debug" "\
-Toggle the status of debug-on-quit.
-With arg, set debug-on-quit iff arg is positive." t nil)
-
-;;;***
-
-;;;### (autoloads (easy-mmode-define-navigation easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap easy-mmode-define-global-mode define-minor-mode) "easy-mmode" "xemacs-base/easy-mmode.el")
-
-(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
-
-(autoload 'define-minor-mode "easy-mmode" "\
-Define a new minor mode MODE.
-This function defines the associated control variable MODE, keymap MODE-map,
-toggle command MODE, and hook MODE-hook.
-
-DOC is the documentation for the mode toggle command.
-Optional INIT-VALUE is the initial value of the mode's variable.
-Optional LIGHTER is displayed in the modeline when the mode is on.
-Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
-  If it is a list, it is passed to `easy-mmode-define-keymap'
-  in order to build a valid keymap.  It's generally better to use
-  a separate MODE-map variable than to use this argument.
-The above three arguments can be skipped if keyword arguments are
-used (see below).
-
-BODY contains code that will be executed each time the mode is (de)activated.
-  It will be executed after any toggling but before running the hooks.
-  Before the actual body code, you can write
-  keyword arguments (alternating keywords and values).
-  These following keyword arguments are supported:
-:group GROUP	Custom group name to use in all generated `defcustom' forms.
-:global GLOBAL	If non-nil specifies that the minor mode is not meant to be
-              	buffer-local, so don't make the variable MODE buffer-local.
-		By default, the mode is buffer-local.
-:init-value VAL	Same as the INIT-VALUE argument.
-:lighter SPEC	Same as the LIGHTER argument.
-:require SYM	Same as in `defcustom'.
-
-For backwards compatibility, these hooks are run each time the mode is
-\(de)activated.  When the mode is toggled, MODE-hook is always run before the
-other hook.
-MODE-hook: run if the mode is toggled.
-MODE-on-hook: run if the mode is activated.
-MODE-off-hook: run if the mode is deactivated.
- 
-\(defmacro easy-mmode-define-minor-mode
-  (MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)...)
-
-For example, you could write
-  (define-minor-mode foo-mode \"If enabled, foo on you!\"
-    nil \"Foo \" foo-keymap
-    :require 'foo :global t :group 'inconvenience
-    ...BODY CODE...)" nil 'macro)
-
-(autoload 'easy-mmode-define-global-mode "easy-mmode" "\
-Make GLOBAL-MODE out of the buffer-local minor MODE.
-TURN-ON is a function that will be called with no args in every buffer
-  and that should try to turn MODE on if applicable for that buffer.
-KEYS is a list of CL-style keyword arguments:
-:group to specify the custom group." nil 'macro)
-
-(autoload 'easy-mmode-define-keymap "easy-mmode" "\
-Return a keymap built from bindings BS.
-BS must be a list of (KEY . BINDING) where
-KEY and BINDINGS are suitable for `define-key'.
-Optional NAME is passed to `make-sparse-keymap'.
-Optional map M can be used to modify an existing map.
-ARGS is a list of additional keyword arguments." nil nil)
-
-(autoload 'easy-mmode-defmap "easy-mmode" nil nil 'macro)
-
-(autoload 'easy-mmode-defsyntax "easy-mmode" "\
-Define variable ST as a syntax-table.
-CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)." nil 'macro)
-
-(autoload 'easy-mmode-define-navigation "easy-mmode" "\
-Define BASE-next and BASE-prev to navigate in the buffer.
-RE determines the places the commands should move point to.
-NAME should describe the entities matched by RE.  It is used to build
-  the docstrings of the two functions.
-BASE-next also tries to make sure that the whole entry is visible by
-  searching for its end (by calling ENDFUN if provided or by looking for
-  the next entry) and recentering if necessary.
-ENDFUN should return the end position (with or without moving point)." nil 'macro)
-
-;;;***
-
-;;;### (autoloads (electric-buffer-list) "ebuff-menu" "xemacs-base/ebuff-menu.el")
-
-(autoload 'electric-buffer-list "ebuff-menu" "\
-Pops up a buffer describing the set of Emacs buffers.
-Vaguely like ITS lunar select buffer; combining typeoutoid buffer
-listing with menuoid buffer selection.
-
-If the very next character typed is a space then the buffer list
-window disappears.  Otherwise, one may move around in the buffer list
-window, marking buffers to be selected, saved or deleted.
-
-To exit and select a new buffer, type a space when the cursor is on
-the appropriate line of the buffer-list window.  Other commands are
-much like those of buffer-menu-mode.
-
-Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
-
-Non-null optional arg FILES-ONLY means mention only file buffers.
-When called from Lisp code, FILES-ONLY may be a regular expression,
-in which case only buffers whose names match that expression are listed,
-or an arbitrary predicate function.
-
-\\{electric-buffer-menu-mode-map}" t nil)
-
-;;;***
-
-;;;### (autoloads (electric-command-history Electric-command-history-redo-expression) "echistory" "xemacs-base/echistory.el")
-
-(autoload 'Electric-command-history-redo-expression "echistory" "\
-Edit current history line in minibuffer and execute result.
-With prefix arg NOCONFIRM, execute current line as-is without editing." t nil)
-
-(autoload 'electric-command-history "echistory" "\
-\\Major mode for examining and redoing commands from `command-history'.
-This pops up a window with the Command History listing.
-The number of command listed is controlled by `list-command-history-max'.
-The command history is filtered by `list-command-history-filter' if non-nil.
-Combines typeout Command History list window with menu like selection
-of an expression from the history for re-evaluation in the *original* buffer.
-
-The history displayed is filtered by `list-command-history-filter' if non-nil.
-
-Like Emacs-Lisp mode except that characters do not insert themselves and
-Tab and Linefeed do not indent.  Instead these commands are provided:
-\\{electric-history-map}
-
-Calls the value of `electric-command-history-hook' if that is non-nil.
-The Command History listing is recomputed each time this mode is invoked." t nil)
-
-;;;***
-
-;;;### (autoloads (format-kbd-macro read-kbd-macro edit-named-kbd-macro edit-last-kbd-macro edit-kbd-macro) "edmacro" "xemacs-base/edmacro.el")
-(define-key ctl-x-map "\C-k" 'edit-kbd-macro)
-
-(autoload 'edit-kbd-macro "edmacro" "\
-Edit a keyboard macro.
-At the prompt, type any key sequence which is bound to a keyboard macro.
-Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
-the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by
-its command name.
-With a prefix argument, format the macro in a more concise way." t nil)
-
-(autoload 'edit-last-kbd-macro "edmacro" "\
-Edit the most recently defined keyboard macro." t nil)
-
-(autoload 'edit-named-kbd-macro "edmacro" "\
-Edit a keyboard macro which has been given a name by `name-last-kbd-macro'." t nil)
-
-(autoload 'read-kbd-macro "edmacro" "\
-Read the region as a keyboard macro definition.
-The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
-See documentation for `edmacro-mode' for details.
-The resulting macro is installed as the \"current\" keyboard macro.
-
-In Lisp, may also be called with a single STRING argument in which case
-the result is returned rather than being installed as the current macro.
-The result will be a vector of keystrokes." t nil)
-
-(autoload 'format-kbd-macro "edmacro" "\
-Return the keyboard macro MACRO as a human-readable string.
-This string is suitable for passing to `read-kbd-macro'.
-Second argument VERBOSE means to put one command per line with comments.
-If VERBOSE is nil, put everything on one line." nil nil)
-
-;;;***
-
-;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "xemacs-base/ehelp.el")
-
-(autoload 'with-electric-help "ehelp" "\
-Pop up an \"electric\" help buffer.
-The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT.
-THUNK is a function of no arguments which is called to initialize the
-contents of BUFFER.  BUFFER defaults to `*Help*'.  BUFFER will be
-erased before THUNK is called unless NOERASE is non-nil.  THUNK will
-be called while BUFFER is current and with `standard-output' bound to
-the buffer specified by BUFFER.
-
-If THUNK returns nil, we display BUFFER starting at the top, and
-shrink the window to fit.  If THUNK returns non-nil, we don't do those things.
-
-After THUNK has been called, this function \"electrically\" pops up a window
-in which BUFFER is displayed and allows the user to scroll through that buffer
-in electric-help-mode. The window's height will be at least MINHEIGHT if
-this value is non-nil.
-
-If THUNK returns nil, we display BUFFER starting at the top, and
-shrink the window to fit.  If THUNK returns non-nil, we don't do those
-things.
-
-When the user exits (with `electric-help-exit', or otherwise) the help
-buffer's window disappears (i.e., we use `save-window-excursion')
-BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit." nil nil)
-
-(autoload 'electric-helpify "ehelp" nil nil nil)
-
-;;;***
-
-;;;### (autoloads (enriched-decode enriched-encode enriched-mode) "enriched" "xemacs-base/enriched.el")
-
-(autoload 'enriched-mode "enriched" "\
-Minor mode for editing text/enriched files.
-These are files with embedded formatting information in the MIME standard
-text/enriched format.
-Turning the mode on runs `enriched-mode-hook'.
-
-More information about Enriched mode is available in the file 
-etc/enriched.doc  in the Emacs distribution directory.
-
-Commands:
-
-\\\\{enriched-mode-map}" t nil)
-
-(autoload 'enriched-encode "enriched" nil nil nil)
-
-(autoload 'enriched-decode "enriched" nil nil nil)
-
-;;;***
-
-;;;### (autoloads (setenv substitute-env-vars) "env" "xemacs-base/env.el")
-
-(autoload 'substitute-env-vars "env" "\
-Substitute environment variables referred to in STRING.
-`$FOO' where FOO is an environment variable name means to substitute
-the value of that variable.  The variable name should be terminated
-with a character not a letter, digit or underscore; otherwise, enclose
-the entire variable name in braces.  Use `$$' to insert a single
-dollar sign." nil nil)
-
-(autoload 'setenv "env" "\
-Set the value of the environment variable named VARIABLE to VALUE.
-VARIABLE should be a string.  VALUE is optional; if not provided or is
-`nil', the environment variable VARIABLE will be removed.
-
-UNSET, if non-nil, means to remove VARIABLE from the environment.
-SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment
-variables in VALUE using `substitute-env-vars'.
-
-Interactively, a prefix argument means to unset the variable.
-Interactively, the current value (if any) of the variable
-appears at the front of the history list when you type in the new value.
-
-This function works by modifying `process-environment'." t nil)
-
-;;;***
-
-;;;### (autoloads (facemenu-get-face list-colors-display list-text-properties-at facemenu-remove-special facemenu-remove-props facemenu-set-read-only facemenu-set-intangible facemenu-set-invisible facemenu-make-much-smaller facemenu-make-much-larger facemenu-make-smaller facemenu-make-larger facemenu-set-size-default facemenu-set-face-from-menu facemenu-set-background facemenu-set-foreground facemenu-set-face) "facemenu" "xemacs-base/facemenu.el")
-(autoload 'facemenu-keymap "facemenu" nil t 'keymap)
-(define-key ctl-x-map "F" 'facemenu-keymap)
-
-(defvar facemenu-menu nil "\
-Facemenu top-level menu keymap.")
-
-(defvar facemenu-keymap (let ((map (make-sparse-keymap "Set face"))) (define-key map ?o 'facemenu-set-face) map) "\
-Keymap for face-changing commands.
-`Facemenu-update' fills in the keymap according to the bindings
-requested in `facemenu-keybindings'.")
-
-(defalias 'facemenu-keymap facemenu-keymap)
-
-(autoload 'facemenu-set-face "facemenu" "\
-Add FACE to the region or next character typed.
-It will be added to the top of the face list; any faces lower on the list that
-will not show through at all will be removed.
-
-Interactively, the face to be used is read with the minibuffer.
-
-If the region is active and there is no prefix argument,
-this command sets the region to the requested face.
-
-Otherwise, this command specifies the face for the next character
-inserted.  Moving point or switching buffers before
-typing a character to insert cancels the specification." t nil)
-
-(autoload 'facemenu-set-foreground "facemenu" "\
-Set the foreground color of the region or next character typed.
-The color is prompted for.  A face named `fg:color' is used (or created).
-If the region is active, it will be set to the requested face.  If
-it is inactive (even if mark-even-if-inactive is set) the next
-character that is typed (via `self-insert-command') will be set to
-the selected face.  Moving point or switching buffers before
-typing a character cancels the request." t nil)
-
-(autoload 'facemenu-set-background "facemenu" "\
-Set the background color of the region or next character typed.
-The color is prompted for.  A face named `bg:color' is used (or created).
-If the region is active, it will be set to the requested face.  If
-it is inactive (even if mark-even-if-inactive is set) the next
-character that is typed (via `self-insert-command') will be set to
-the selected face.  Moving point or switching buffers before
-typing a character cancels the request." t nil)
-
-(autoload 'facemenu-set-face-from-menu "facemenu" "\
-Set the face of the region or next character typed.
-This function is designed to be called from a menu; the face to use
-is the menu item's name.
-
-If the region is active and there is no prefix argument,
-this command sets the region to the requested face.
-
-Otherwise, this command specifies the face for the next character
-inserted.  Moving point or switching buffers before
-typing a character to insert cancels the specification." t nil)
-
-(autoload 'facemenu-set-size-default "facemenu" nil t nil)
-
-(autoload 'facemenu-make-larger "facemenu" nil t nil)
-
-(autoload 'facemenu-make-smaller "facemenu" nil t nil)
-
-(autoload 'facemenu-make-much-larger "facemenu" nil t nil)
-
-(autoload 'facemenu-make-much-smaller "facemenu" nil t nil)
-
-(autoload 'facemenu-set-invisible "facemenu" "\
-Make the region invisible.
-This sets the `invisible' text property; it can be undone with
-`facemenu-remove-special'." t nil)
-
-(autoload 'facemenu-set-intangible "facemenu" "\
-Make the region intangible: disallow moving into it.
-This sets the `intangible' text property; it can be undone with
-`facemenu-remove-special'." t nil)
-
-(autoload 'facemenu-set-read-only "facemenu" "\
-Make the region unmodifiable.
-This sets the `read-only' text property; it can be undone with
-`facemenu-remove-special'." t nil)
-
-(autoload 'facemenu-remove-props "facemenu" "\
-Remove all text properties that facemenu added to region." t nil)
-
-(autoload 'facemenu-remove-special "facemenu" "\
-Remove all the \"special\" text properties from the region.
-These special properties include `invisible', `intangible' and `read-only'." t nil)
-
-(autoload 'list-text-properties-at "facemenu" "\
-Pop up a buffer listing text-properties at LOCATION." t nil)
-
-(defalias 'facemenu-read-color 'read-color)
-
-(autoload 'list-colors-display "facemenu" "\
-Display names of defined colors, and show what they look like.
-If the optional argument LIST is non-nil, it should be a list of
-colors to display.  Otherwise, this command computes a list
-of colors that the current display can handle." t nil)
-
-(autoload 'facemenu-get-face "facemenu" "\
-Make sure FACE exists.
-If not, create it and add it to the appropriate menu.  Return the symbol.
-
-If this function creates a face named `fg:color', then it sets the
-foreground to that color.  Likewise, `bg:color' means to set the
-background.  In either case, if the color is undefined, no color is
-set and a warning is issued." nil nil)
-
-;;;***
-
-;;;### (autoloads (ffap-at-mouse ffap-menu find-file-at-point ffap-next ffap-next-guess) "ffap" "xemacs-base/ffap.el")
-
-(autoload 'ffap-next-guess "ffap" "\
-Move point to next file or URL, and return it as a string.
-If nothing is found, leave point at limit and return nil.
-Optional BACK argument makes search backwards.
-Optional LIM argument limits the search.
-Only considers strings that match `ffap-next-regexp'." nil nil)
-
-(autoload 'ffap-next "ffap" "\
-Search buffer for next file or URL, and run ffap.
-Optional argument BACK says to search backwards.
-Optional argument WRAP says to try wrapping around if necessary.
-Interactively: use a single prefix to search backwards,
-double prefix to wrap forward, triple to wrap backwards.
-Actual search is done by `ffap-next-guess'." t nil)
-
-(autoload 'find-file-at-point "ffap" "\
-Find FILENAME, guessing a default from text around point.
-If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
-With a prefix, this command behaves exactly like `ffap-file-finder'.
-If `ffap-require-prefix' is set, the prefix meaning is reversed.
-See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
-and the functions `ffap-file-at-point' and `ffap-url-at-point'.
-
-See  for latest version." t nil)
-
-(defalias 'ffap 'find-file-at-point)
-
-(autoload 'ffap-menu "ffap" "\
-Put up a menu of files and urls mentioned in this buffer.
-Then set mark, jump to choice, and try to fetch it.  The menu is
-cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
-The optional RESCAN argument (a prefix, interactively) forces
-a rebuild.  Searches with `ffap-menu-regexp'." t nil)
-
-(autoload 'ffap-at-mouse "ffap" "\
-Find file or url guessed from text around mouse click.
-Interactively, calls `ffap-at-mouse-fallback' if no guess is found.
-Return value:
-  * if a guess string is found, return it (after finding it)
-  * if the fallback is called, return whatever it returns
-  * otherwise, nil" t nil)
-
-;;;***
-
-;;;### (autoloads (constrain-to-field field-end field-beginning field-string-no-properties field-string delete-field make-field) "field" "xemacs-base/field.el")
-
-(autoload 'make-field "field" "\
-Make a field with value VALUE over the range [FROM, TO) in BUFFER.
-If omitted, BUFFER defaults to the current buffer.
-FROM and TO may be integers or markers.
-The fifth argument, FRONT-ADVANCE, if non-nil, makes the front delimiter
-advance when text is inserted there.
-The sixth argument, REAR-ADVANCE, if non-nil, makes the rear delimiter
-advance when text is inserted there." nil nil)
-
-(autoload 'delete-field "field" "\
-Delete the field surrounding POS.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS." nil nil)
-
-(autoload 'field-string "field" "\
-Return the contents of the field surrounding POS as a string.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS." nil nil)
-
-(autoload 'field-string-no-properties "field" "\
-Return the contents of the field around POS, without text-properties.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS." nil nil)
-
-(autoload 'field-beginning "field" "\
-Return the beginning of the field surrounding POS.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS.
-If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
-field, then the beginning of the *previous* field is returned.
-If LIMIT is non-nil, it is a buffer position; if the beginning of the field
-is before LIMIT, then LIMIT will be returned instead." nil nil)
-
-(autoload 'field-end "field" "\
-Return the end of the field surrounding POS.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS.
-If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
-then the end of the *following* field is returned.
-If LIMIT is non-nil, it is a buffer position; if the end of the field
-is after LIMIT, then LIMIT will be returned instead." nil nil)
-
-(autoload 'constrain-to-field "field" "\
-Return the position closest to NEW-POS that is in the same field as OLD-POS.
-
-A field is a region of text with the same `field' property.
-If NEW-POS is nil, then the current point is used instead, and set to the
-constrained position if that is different.
-
-If OLD-POS is at the boundary of two fields, then the allowable
-positions for NEW-POS depend on the value of the optional argument
-ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
-constrained to the field that has the same `field' char-property
-as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
-is non-nil, NEW-POS is constrained to the union of the two adjacent
-fields.  Additionally, if two fields are separated by another field with
-the special value `boundary', then any point within this special field is
-also considered to be `on the boundary'.
-
-If the optional argument ONLY-IN-LINE is non-nil and constraining
-NEW-POS would move it to a different line, NEW-POS is returned
-unconstrained.  This useful for commands that move by line, like
-\\[next-line] or \\[beginning-of-line], which should generally respect field
-boundaries only in the case where they can still move to the right line.
-
-If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
-a non-nil property of that name, then any field boundaries are ignored.
-
-Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil." nil nil)
-
-;;;***
-
-;;;### (autoloads (Helper-help Helper-describe-bindings) "helper" "xemacs-base/helper.el")
-
-(autoload 'Helper-describe-bindings "helper" "\
-Describe local key bindings of current mode." t nil)
-
-(autoload 'Helper-help "helper" "\
-Provide help for current mode." t nil)
-
-;;;***
-
-;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar) "imenu" "xemacs-base/imenu.el")
-
-(defvar imenu-generic-expression nil "\
-The regex pattern to use for creating a buffer index.
-
-If non-nil this pattern is passed to `imenu--generic-function'
-to create a buffer index.
-
-The value should be an alist with elements that look like this:
- (MENU-TITLE REGEXP INDEX)
-or like this:
- (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...)
-with zero or more ARGUMENTS.  The former format creates a simple element in
-the index alist when it matches; the latter creates a special element
-of the form  (NAME FUNCTION POSITION-MARKER ARGUMENTS...)
-with FUNCTION and ARGUMENTS beiong copied from `imenu-generic-expression'.
-
-MENU-TITLE is a string used as the title for the submenu or nil if the
-entries are not nested.
-
-REGEXP is a regexp that should match a construct in the buffer that is
-to be displayed in the menu; i.e., function or variable definitions,
-etc.  It contains a substring which is the name to appear in the
-menu.  See the info section on Regexps for more information.
-
-INDEX points to the substring in REGEXP that contains the name (of the
-function, variable or type) that is to appear in the menu.
-
-The variable is buffer-local.
-
-The variable `imenu-case-fold-search' determines whether or not the
-regexp matches are case sensitive. and `imenu-syntax-alist' can be
-used to alter the syntax table for the search.
-
-For example, see the value of `lisp-imenu-generic-expression' used by
-`lisp-mode' and `emacs-lisp-mode' with `imenu-syntax-alist' set
-locally to give the characters which normally have \"punctuation\"
-syntax \"word\" syntax during matching.")
-
-(make-variable-buffer-local 'imenu-generic-expression)
-
-(make-variable-buffer-local 'imenu-extract-index-name-function)
-
-(autoload 'imenu-add-to-menubar "imenu" "\
-Add an `imenu' entry to the menu bar for the current buffer.
-NAME is a string used to name the menu bar item.
-See the command `imenu' for more information." t nil)
-
-(autoload 'imenu-add-menubar-index "imenu" "\
-Add an Imenu \"Index\" entry on the menu bar for the current buffer.
-
-A trivial interface to `imenu-add-to-menubar' suitable for use in a hook." t nil)
-
-(autoload 'imenu "imenu" "\
-Jump to a place in the buffer chosen using a buffer menu or mouse menu.
-INDEX-ITEM specifies the position.  See `imenu-choose-buffer-index'
-for more information." t nil)
-
-;;;***
-
-;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro assign-last-kbd-macro-to-key name-last-kbd-macro) "macros" "xemacs-base/macros.el")
-
-(autoload 'name-last-kbd-macro "macros" "\
-Assign a name to the last keyboard macro defined.
-Argument SYMBOL is the name to define.
-The symbol's function definition becomes the keyboard macro string.
-Such a \"function\" cannot be called from Lisp, but it is a valid
-editor command." t nil)
-
-(autoload 'assign-last-kbd-macro-to-key "macros" "\
-Assign to a key sequence the last keyboard macro defined.
-Argument KEY is anything acceptable to `define-key'.." t nil)
-
-(autoload 'insert-kbd-macro "macros" "\
-Insert in buffer the definition of kbd macro NAME, as Lisp code.
-Optional second arg KEYS means also record the keys it is on
-\(this is the prefix argument, when calling interactively).
-
-This Lisp code will, when executed, define the kbd macro with the same
-definition it has now.  If you say to record the keys, the Lisp code
-will also rebind those keys to the macro.  Only global key bindings
-are recorded since executing this Lisp code always makes global
-bindings.
-
-To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
-use this command, and then save the file." t nil)
-
-(autoload 'kbd-macro-query "macros" "\
-Query user during kbd macro execution.
-With prefix argument, enters recursive edit,
- reading keyboard commands even within a kbd macro.
- You can give different commands each time the macro executes.
-Without prefix argument, asks whether to continue running the macro.
-Your options are: \\
-\\[act]	Finish this iteration normally and continue with the next.
-\\[skip]	Skip the rest of this iteration, and start the next.
-\\[exit]	Stop the macro entirely right now.
-\\[recenter]	Redisplay the frame, then ask again.
-\\[edit]	Enter recursive edit; ask again when you exit from that." t nil)
-
-(autoload 'apply-macro-to-region-lines "macros" "\
-For each complete line between point and mark, move to the beginning
-of the line, and run the last keyboard macro.
-
-When called from lisp, this function takes two arguments TOP and
-BOTTOM, describing the current region.  TOP must be before BOTTOM.
-The optional third argument MACRO specifies a keyboard macro to
-execute.
-
-This is useful for quoting or unquoting included text, adding and
-removing comments, or producing tables where the entries are regular.
-
-For example, in Usenet articles, sections of text quoted from another
-author are indented, or have each line start with `>'.  To quote a
-section of text, define a keyboard macro which inserts `>', put point
-and mark at opposite ends of the quoted section, and use
-`\\[apply-macro-to-region-lines]' to mark the entire section.
-
-Suppose you wanted to build a keyword table in C where each entry
-looked like this:
-
-    { \"foo\", foo_data, foo_function },
-    { \"bar\", bar_data, bar_function },
-    { \"baz\", baz_data, baz_function },
-
-You could enter the names in this format:
-
-    foo
-    bar
-    baz
-
-and write a macro to massage a word into a table entry:
-
-    \\C-x (
-       \\M-d { \"\\C-y\", \\C-y_data, \\C-y_function },
-    \\C-x )
-
-and then select the region of un-tablified names and use
-`\\[apply-macro-to-region-lines]' to build the table from the names.
-" t nil)
-
-;;;***
-
-;;;### (autoloads (disable-command enable-command disabled-command-hook) "novice" "xemacs-base/novice.el")
-
-(autoload 'disabled-command-hook "novice" nil nil nil)
-
-(autoload 'enable-command "novice" "\
-Allow COMMAND to be executed without special confirmation from now on.
-The user's `custom-file' is altered so that this will apply
-to future sessions." t nil)
-
-(autoload 'disable-command "novice" "\
-Require special confirmation to execute COMMAND from now on.
-The user's `custom-file' is altered so that this will apply
-to future sessions." t nil)
-
-;;;***
-
-;;;### (autoloads (outline-minor-mode outline-mode) "outline" "xemacs-base/outline.el")
-
-(defvar outline-minor-mode nil "\
-Non-nil if using Outline mode as a minor mode of some other mode.")
-
-(make-variable-buffer-local 'outline-minor-mode)
-
-(put 'outline-minor-mode 'permanent-local t)
-
-(add-minor-mode 'outline-minor-mode " Outl")
-
-(autoload 'outline-mode "outline" "\
-Set major mode for editing outlines with selective display.
-Headings are lines which start with asterisks: one for major headings,
-two for subheadings, etc.  Lines not starting with asterisks are body lines. 
-
-Body text or subheadings under a heading can be made temporarily
-invisible, or visible again.  Invisible lines are attached to the end 
-of the heading, so they move with it, if the line is killed and yanked
-back.  A heading with text hidden under it is marked with an ellipsis (...).
-
-Commands:\\
-\\[outline-next-visible-heading]   outline-next-visible-heading      move by visible headings
-\\[outline-previous-visible-heading]   outline-previous-visible-heading
-\\[outline-forward-same-level]   outline-forward-same-level        similar but skip subheadings
-\\[outline-backward-same-level]   outline-backward-same-level
-\\[outline-up-heading]   outline-up-heading		    move from subheading to heading
-
-\\[hide-body]	make all text invisible (not headings).
-\\[show-all]	make everything in buffer visible.
-
-The remaining commands are used when point is on a heading line.
-They apply to some of the body or subheadings of that heading.
-\\[hide-subtree]   hide-subtree	make body and subheadings invisible.
-\\[show-subtree]   show-subtree	make body and subheadings visible.
-\\[show-children]   show-children	make direct subheadings visible.
-		 No effect on body, or subheadings 2 or more levels down.
-		 With arg N, affects subheadings N levels down.
-\\[hide-entry]	   make immediately following body invisible.
-\\[show-entry]	   make it visible.
-\\[hide-leaves]	   make body under heading and under its subheadings invisible.
-		     The subheadings remain visible.
-\\[show-branches]  make all subheadings at all levels visible.
-
-The variable `outline-regexp' can be changed to control what is a heading.
-A line is a heading if `outline-regexp' matches something at the
-beginning of the line.  The longer the match, the deeper the level.
-
-Turning on outline mode calls the value of `text-mode-hook' and then of
-`outline-mode-hook', if they are non-nil." t nil)
-
-(autoload 'outline-minor-mode "outline" "\
-Toggle Outline minor mode.
-With arg, turn Outline minor mode on if arg is positive, off otherwise.
-See the command `outline-mode' for more information on this mode." t nil)
-
-;;;***
-
-;;;### (autoloads (read-passwd) "passwd" "xemacs-base/passwd.el")
-
-(autoload 'read-passwd "passwd" "\
-Prompts for a password in the minibuffer, and returns it as a string.
-If PROMPT may be a prompt string or an alist of elements 
-'(prompt . default).
-If optional arg CONFIRM is true, then ask the user to type the password
-again to confirm that they typed it correctly.
-If optional arg DEFAULT is provided, then it is a string to insert as
-the default choice (it is not, of course, displayed.)
-
-If running under X, the keyboard will be grabbed (with XGrabKeyboard())
-to reduce the possibility that eavesdropping is occuring.
-
-When reading a password, all keys self-insert, except for:
-\\
-	\\[read-passwd-erase-line]	Erase the entire line.
-	\\[quoted-insert]	Insert the next character literally.
-	\\[delete-backward-char]	Delete the previous character.
-	\\[exit-minibuffer]	Accept what you have typed.
-	\\[keyboard-quit]	Abort the command.
-
-The returned value is always a newly-created string.  No additional copies
-of the password remain after this function has returned.
-
-NOTE: unless great care is taken, the typed password will exist in plaintext
-form in the running image for an arbitrarily long time.  Priveleged users may
-be able to extract it from memory.  If emacs crashes, it may appear in the
-resultant core file.
-
-Some steps you can take to prevent the password from being copied around:
-
- - as soon as you are done with the returned string, destroy it with
-   (fillarray string 0).  The same goes for any default passwords
-   or password histories.
-
- - do not copy the string, as with concat or substring - if you do, be
-   sure to keep track of and destroy all copies.
-
- - do not insert the password into a buffer - if you do, be sure to 
-   overwrite the buffer text before killing it, as with the functions 
-   `passwd-erase-buffer' or `passwd-kill-buffer'.  Note that deleting
-   the text from the buffer does NOT necessarily remove the text from
-   memory.
-
- - be careful of the undo history - if you insert the password into a 
-   buffer which has undo recording turned on, the password will be 
-   copied onto the undo list, and thus recoverable.
-
- - do not pass it as an argument to a shell command - anyone will be
-   able to see it if they run `ps' at the right time.
-
-" nil nil)
-
-;;;***
-
-;;;### (autoloads (pp-eval-last-sexp pp-eval-expression pp pp-to-string) "pp" "xemacs-base/pp.el")
-
-(defalias 'pprint 'pp)
-
-(autoload 'pp-to-string "pp" "\
-Return a string containing the pretty-printed representation of OBJECT,
-any Lisp object.  Quoting characters are used when needed to make output
-that `read' can handle, whenever this is possible." nil nil)
-
-(autoload 'pp "pp" "\
-Output the pretty-printed representation of OBJECT, any Lisp object.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see)." nil nil)
-
-(autoload 'pp-eval-expression "pp" "\
-Evaluate EXPRESSION and pretty-print value into a new display buffer.
-If the pretty-printed value fits on one line, the message line is used
-instead.  Value is also consed on to front of variable  values 's
-value." t nil)
-
-(autoload 'pp-eval-last-sexp "pp" "\
-Run `pp-eval-expression' on sexp before point (which see).
-With argument, pretty-print output into current buffer.
-Ignores leading comment characters." t nil)
-
-;;;***
-
-;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "xemacs-base/regexp-opt.el")
-
-(autoload 'regexp-opt "regexp-opt" "\
-Return a regexp to match a string in STRINGS.
-Each string should be unique in STRINGS and should not contain any regexps,
-quoted or not.  If optional PAREN is non-nil, ensure that the returned regexp
-is enclosed by at least one regexp grouping construct.
-The returned regexp is typically more efficient than the equivalent regexp:
-
- (let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\")))
-   (concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close))
-
-If PAREN is `words', then the resulting regexp is additionally surrounded
-by \\=\\< and \\>." nil nil)
-
-(autoload 'regexp-opt-depth "regexp-opt" "\
-Return the depth of REGEXP.
-This means the number of regexp grouping constructs (parenthesised expressions)
-in REGEXP." nil nil)
-
-;;;***
-
-;;;### (autoloads (make-ring ringp) "ring" "xemacs-base/ring.el")
-
-(autoload 'ringp "ring" "\
-Returns t if X is a ring; nil otherwise." nil nil)
-
-(define-compatible-function-alias 'ring-p 'ringp)
-
-(autoload 'make-ring "ring" "\
-Make a ring that can contain SIZE elements." nil nil)
-
-;;;***
-
-;;;### (autoloads (shell) "shell" "xemacs-base/shell.el")
-
-(defcustom shell-dumb-shell-regexp "cmd\\(proxy\\)?\\.exe" "Regexp to match shells that don't save their command history, and\ndon't handle the backslash as a quote character.  For shells that\nmatch this regexp, Emacs will write out the command history when the\nshell finishes, and won't remove backslashes when it unquotes shell\narguments." :type 'regexp :group 'shell)
-
-(defcustom shell-prompt-pattern "^[^#$%>\n]*[#$%>] *" "Regexp to match prompts in the inferior shell.\nDefaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well.\nThis variable is used to initialise `comint-prompt-regexp' in the\nshell buffer.\n\nThis variable is only used if the variable\n`comint-use-prompt-regexp-instead-of-fields' is non-nil.\n\nThe pattern should probably not match more than one line.  If it does,\nShell mode may become confused trying to distinguish prompt from input\non lines which don't start with a prompt.\n\nThis is a fine thing to set in your `.emacs' file." :type 'regexp :group 'shell)
-
-(autoload 'shell "shell" "\
-Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*').
-Interactively, a prefix arg means to prompt for BUFFER.
-If BUFFER exists but shell process is not running, make new shell.
-If BUFFER exists and shell process is running, just switch to BUFFER.
-Program used comes from variable `explicit-shell-file-name',
- or (if that is nil) from the ESHELL environment variable,
- or else from SHELL if there is no ESHELL,
- or if there is no SHELL then from variable `shell-file-name',
- or, if all of the above are nil, \"/bin/sh\" is used.
-If a file `~/.emacs_SHELLNAME' exists, it is given as initial input
- (Note that this may lose due to a timing error if the shell
-  discards input when it starts up.)
-The buffer is put in Shell mode, giving commands for sending input
-and controlling the subjobs of the shell.  See `shell-mode'.
-See also the variable `shell-prompt-pattern'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the shell, use \\[universal-coding-system-argument]
-before \\[shell].  You can also specify this with \\[set-buffer-process-coding-system]
-in the shell buffer, after you start the shell.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-The shell file name (sans directories) is used to make a symbol name
-such as `explicit-csh-args'.  If that symbol is a variable,
-its value is used as a list of arguments when invoking the shell.
-Otherwise, one argument `-i' is passed to the shell.
-
-\(Type \\[describe-mode] in the shell buffer for a list of commands.)" t nil)
-(add-hook 'same-window-buffer-names "*shell*")
-
-;;;***
-
-;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy skeleton-proxy-new define-skeleton) "skeleton" "xemacs-base/skeleton.el")
-
-(defvar skeleton-filter 'identity "\
-Function for transforming a skeleton proxy's aliases' variable value.")
-
-(autoload 'define-skeleton "skeleton" "\
-Define a user-configurable COMMAND that enters a statement skeleton.
-DOCUMENTATION is that of the command, while the variable of the same name,
-which contains the skeleton, has a documentation to that effect.
-INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'." nil 'macro)
-
-(autoload 'skeleton-proxy-new "skeleton" "\
-Insert skeleton defined by variable of same name (see `skeleton-insert').
-Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
-If no ARG was given, but the region is visible, ARG defaults to -1 depending
-on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.
-This command can also be an abbrev expansion (3rd and 4th columns in
-\\[edit-abbrevs]  buffer: \"\"  command-name).
- 
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored." t nil)
-
-(autoload 'skeleton-proxy "skeleton" "\
-Insert skeleton defined by variable of same name (see `skeleton-insert').
-Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
-If no ARG was given, but the region is visible, ARG defaults to -1 depending
-on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.
-This command can also be an abbrev expansion (3rd and 4th columns in
-\\[edit-abbrevs]  buffer: \"\"  command-name).
-
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored." t nil)
-
-(autoload 'skeleton-insert "skeleton" "\
-Insert the complex statement skeleton SKELETON describes very concisely.
-
-With optional third REGIONS wrap first interesting point (`_') in skeleton
-around next REGIONS words, if REGIONS is positive.  If REGIONS is negative,
-wrap REGIONS preceding interregions into first REGIONS interesting positions
-\(successive `_'s) in skeleton.  An interregion is the stretch of text between
-two contiguous marked points.  If you marked A B C [] (where [] is the cursor)
-in alphabetical order, the 3 interregions are simply the last 3 regions.  But
-if you marked B A [] C, the interregions are B-A, A-[], []-C.
-
-Optional fourth STR is the value for the variable `str' within the skeleton.
-When this is non-`nil' the interactor gets ignored, and this should be a valid
-skeleton element.
-
-SKELETON is made up as (INTERACTOR ELEMENT ...).  INTERACTOR may be nil if
-not needed, a prompt-string or an expression for complex read functions.
-
-If ELEMENT is a string or a character it gets inserted (see also
-`skeleton-transformation').  Other possibilities are:
-
-	\\n	go to next line and indent according to mode
-	_	interesting point, interregion here, point after termination
-	>	indent line (or interregion if > _) according to major mode
-	&	do next ELEMENT if previous moved point
-	|	do next ELEMENT if previous didn't move point
-	-num	delete num preceding characters (see `skeleton-untabify')
-	resume:	skipped, continue here if quit is signaled
-	nil	skipped
-
-Further elements can be defined via `skeleton-further-elements'.  ELEMENT may
-itself be a SKELETON with an INTERACTOR.  The user is prompted repeatedly for
-different inputs.  The SKELETON is processed as often as the user enters a
-non-empty string.  \\[keyboard-quit] terminates skeleton insertion, but
-continues after `resume:' and positions at `_' if any.  If INTERACTOR in such
-a subskeleton is a prompt-string which contains a \".. %s ..\" it is
-formatted with `skeleton-subprompt'.  Such an INTERACTOR may also a list of
-strings with the subskeleton being repeated once for each string.
-
-Quoted Lisp expressions are evaluated evaluated for their side-effect.
-Other Lisp expressions are evaluated and the value treated as above.
-Note that expressions may not return `t' since this implies an
-endless loop.  Modes can define other symbols by locally setting them
-to any valid skeleton element.  The following local variables are
-available:
-
-	str	first time: read a string according to INTERACTOR
-		then: insert previously read string once more
-	help	help-form during interaction with the user or `nil'
-	input	initial input (string or cons with index) while reading str
-	v1, v2	local variables for memorizing anything you want
-
-When done with skeleton, but before going back to `_'-point call
-`skeleton-end-hook' if that is non-`nil'." nil nil)
-
-(autoload 'skeleton-pair-insert-maybe "skeleton" "\
-Insert the character you type ARG times.
-
-With no ARG, if `skeleton-pair' is non-nil, pairing can occur.  If the region
-is visible the pair is wrapped around it depending on `skeleton-autowrap'.
-Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a
-word, and if `skeleton-pair-filter' returns nil, pairing is performed.
-
-If a match is found in `skeleton-pair-alist', that is inserted, else
-the defaults are used.  These are (), [], {}, <> and `' for the
-symmetrical ones, and the same character twice for the others." t nil)
-
-;;;***
-
-;;;### (autoloads (reverse-region sort-columns sort-regexp-fields-numerically sort-regexp-fields sort-fields sort-float-fields sort-numeric-fields sort-pages sort-paragraphs sort-lines sort-subr) "sort" "xemacs-base/sort.el")
-
-(autoload 'sort-subr "sort" "\
-General text sorting routine to divide buffer into records and sort them.
-
-We divide the accessible portion of the buffer into disjoint pieces
-called sort records.  A portion of each sort record (perhaps all of
-it) is designated as the sort key.  The records are rearranged in the
-buffer in order by their sort keys.  The records may or may not be
-contiguous.
-
-Usually the records are rearranged in order of ascending sort key.
-If REVERSE is non-nil, they are rearranged in order of descending sort key.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-The next four arguments are functions to be called to move point
-across a sort record.  They will be called many times from within sort-subr.
-
-NEXTRECFUN is called with point at the end of the 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.
-The first record is assumed to start at the position of point when sort-subr
-is called.
-
-ENDRECFUN is called with point within the record.
-It should move point to the end of the record.
-
-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.
-
-COMPAREFUN compares the two keys.  It is called with two strings and
-should return true if the first is \"less\" than the second, just as
-for `sort'.  If nil or omitted, the default function accepts keys that
-are numbers (compared numerically) or strings (compared lexicographically)." nil nil)
-
-(autoload 'sort-lines "sort" "\
-Sort lines in region alphabetically; argument means descending order.
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort).
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order." t nil)
-
-(autoload 'sort-paragraphs "sort" "\
-Sort paragraphs in region alphabetically; argument means descending order.
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort).
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order." t nil)
-
-(autoload 'sort-pages "sort" "\
-Sort pages in region alphabetically; argument means descending order.
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort).
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order." t nil)
-
-(autoload 'sort-numeric-fields "sort" "\
-Sort lines in region numerically by the ARGth field of each line.
-Fields are separated by whitespace and numbered from 1 up.
-Specified 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.
-With a negative arg, sorts by the ARGth field counted from the right.
-Called from a program, there are three arguments:
-FIELD, BEG and END.  BEG and END specify region to sort.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-If you want to sort floating-point numbers, try `sort-float-fields'." t nil)
-
-(autoload 'sort-float-fields "sort" "\
-Sort lines in region numerically by the ARGth field of each line.
-Fields are separated by whitespace and numbered from 1 up.  Specified field
-must contain a floating point number in each line of the region.  With a
-negative arg, sorts by the ARGth field counted from the right.  Called from a
-program, there are three arguments: FIELD, BEG and END.  BEG and END specify
-region to sort." t nil)
-
-(autoload 'sort-fields "sort" "\
-Sort lines in region lexicographically by the ARGth field of each line.
-Fields are separated by whitespace and numbered from 1 up.
-With a negative arg, sorts by the ARGth field counted from the right.
-Called from a program, there are three arguments:
-FIELD, BEG and END.  BEG and END specify region to sort.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order." t nil)
-
-(autoload 'sort-regexp-fields "sort" "\
-Sort the region as specified by RECORD-REGEXP and KEY.
-RECORD-REGEXP specifies the textual units which should be sorted.
-  For example, to sort lines RECORD-REGEXP would be \"^.*$\"
-KEY specifies the part of each record (ie each match for RECORD-REGEXP)
-  is to be used for sorting.
-  If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from
-  RECORD-REGEXP is used.
-  If it is \"\\\\&\" then the whole record is used.
-  Otherwise, it is a regular-expression for which to search within the record.
-If a match for KEY is not found within a record then that record is ignored.
-
-With a negative prefix arg sorts in reverse order.
-
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-COMPAREFUN, if specified, should be a function of two arguments; it
-will be passed the keys (as strings), and should return true if the
-first is \"less\" than the second.  Otherwise the keys will be
-compared lexicographically.
-
-For example: to sort lines in the region by the first word on each line
- starting with the letter \"f\",
- RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\\"" t nil)
-
-(autoload 'sort-regexp-fields-numerically "sort" "\
-Sort the region numerically as specified by RECORD-REGEXP and KEY.
-RECORD-REGEXP specifies the textual units which should be sorted.
-  For example, to sort lines RECORD-REGEXP would be \"^.*$\"
-KEY specifies the part of each record (ie each match for RECORD-REGEXP)
-  is to be used for sorting.
-  If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from
-  RECORD-REGEXP is used.
-  If it is \"\\\\&\" then the whole record is used.
-  Otherwise, it is a regular-expression for which to search within the record.
-If a match for KEY is not found within a record then that record is ignored.
-
-With a negative prefix arg sorts in reverse order.
-
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-For example: to sort lines in the region by the first word on each line
- starting with the letter \"f\",
- RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\\"" t nil)
-
-(autoload 'sort-columns "sort" "\
-Sort lines in region alphabetically by a certain range of columns.
-For the purpose of this command, the region BEG...END includes
-the entire line that point is in and the entire line the mark is in.
-The column positions of point and mark bound the range of columns to sort on.
-A prefix argument means sort into REVERSE order.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-Note that `sort-columns' rejects text that contains tabs,
-because tabs could be split across the specified columns
-and it doesn't know how to handle that.  Also, when possible,
-it uses the `sort' utility program, which doesn't understand tabs.
-Use \\[untabify] to convert tabs to spaces before sorting." t nil)
-
-(autoload 'reverse-region "sort" "\
-Reverse the order of lines in a region.
-From a program takes two point or marker arguments, BEG and END." t nil)
-
-;;;***
-
-;;;### (autoloads (time-stamp-toggle-active time-stamp) "time-stamp" "xemacs-base/time-stamp.el")
-
-(autoload 'time-stamp "time-stamp" "\
-Update the time stamp string in the buffer.
-If you put a time stamp template anywhere in the first 8 lines of a file,
-it can be updated every time you save the file.  See the top of
-`time-stamp.el' for a sample.  The template looks like one of the following:
-    Time-stamp: <>
-    Time-stamp: \" \"
-The time stamp is written between the brackets or quotes, resulting in
-    Time-stamp: <95/01/18 10:20:51 gildea>
-Only does its thing if the variable  time-stamp-active  is non-nil.
-Typically used on  write-file-hooks  for automatic time-stamping.
-The format of the time stamp is determined by the variable  time-stamp-format.
-The variables time-stamp-line-limit, time-stamp-start, and time-stamp-end
-control finding the template." t nil)
-
-(autoload 'time-stamp-toggle-active "time-stamp" "\
-Toggle time-stamp-active, setting whether \\[time-stamp] updates a buffer.
-With arg, turn time stamping on if and only if arg is positive." t nil)
-
-;;;***
-
-;;;### (autoloads (y-or-n-p-with-timeout with-timeout run-with-idle-timer run-with-timer run-at-time) "timer-funcs" "xemacs-base/timer-funcs.el")
-
-(autoload 'run-at-time "timer-funcs" "\
-Perform an action at time TIME.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-TIME should be a string recognized by `timer-parse-time', like \"11:23pm\",
-nil meaning now, a number of seconds from now, a value from `current-time',
-or t (with non-nil REPEAT) meaning the next integral multiple of REPEAT.
-REPEAT may be an integer or floating point number.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns an itimer object which you can use in `delete-itimer'." t nil)
-
-(autoload 'run-with-timer "timer-funcs" "\
-Perform an action after a delay of SECS seconds.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-SECS and REPEAT may be integers or floating point numbers.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns an itimer object which you can use in `delete-itimer'." t nil)
-
-(autoload 'run-with-idle-timer "timer-funcs" "\
-Perform an action the next time XEmacs is idle for SECS seconds.
-The action is to call FUNCTION with arguments ARGS.
-SECS may be an integer or a floating point number.
-
-If REPEAT is non-nil, do the action each time XEmacs has been idle for
-exactly SECS seconds (that is, only once for each time XEmacs becomes idle).
-
-This function returns an itimer object which you can use in `delete-itimer'." t nil)
-(put 'with-timeout 'lisp-indent-function 1)
-
-(autoload 'with-timeout "timer-funcs" "\
-Run BODY, but if it doesn't finish in SECONDS seconds, give up.
-If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
-The call should look like:
- (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
-The timeout is checked whenever XEmacs waits for some kind of external
-event (such as keyboard input, input from subprocesses, or a certain time);
-if the program loops without waiting in any way, the timeout will not
-be detected." nil 'macro)
-
-(autoload 'y-or-n-p-with-timeout "timer-funcs" "\
-Like (y-or-n-p PROMPT), with a timeout.
-If the user does not answer after SECONDS seconds, return DEFAULT-VALUE." nil nil)
-
-;;;***
-
-;;;### (autoloads nil "timezone" "xemacs-base/timezone.el")
-
-(define-error 'invalid-date "Invalid date string")
-
-;;;***
-
-;;;### (autoloads (tq-create) "tq" "xemacs-base/tq.el")
-
-(autoload 'tq-create "tq" "\
-Create and return a transaction queue communicating with PROCESS.
-PROCESS should be a subprocess capable of sending and receiving
-streams of bytes.  It may be a local process, or it may be connected
-to a tcp server on another machine." nil nil)
-
-;;;***
-
-;;;### (autoloads (xbm-button-create) "xbm-button" "xemacs-base/xbm-button.el")
-
-(autoload 'xbm-button-create "xbm-button" "\
-Returns a list of XBM image instantiators for a button displaying TEXT.
-The list is of the form
-   (UP DOWN DISABLED)
-where UP, DOWN, and DISABLED are the up, down and disabled image
-instantiators for the button.
-
-BORDER-THICKNESS specifies how many pixels should be used for the
-borders on the edges of the buttons.  It should be a positive integer,
-or 0 to mean no border." nil nil)
-
-;;;***
-
-;;;### (autoloads (xpm-button-create) "xpm-button" "xemacs-base/xpm-button.el")
-
-(autoload 'xpm-button-create "xpm-button" "\
-Returns a list of XPM image instantiators for a button displaying TEXT.
-The list is of the form
-   (UP DOWN DISABLED)
-where UP, DOWN, and DISABLED are the up, down and disabled image
-instantiators for the button.
-
-SHADOW-THICKNESS specifies how many pixels should be used for the
-shadows on the edges of the buttons.  It should be a positive integer,
-or 0 to mean no shadows on the edges.
-FG-COLOR is the color used to display the text.  It should be a string.
-BG-COLOR is the background color the text will be displayed upon.
-It should be a string." nil nil)
-
-;;;***
-
-(provide 'xemacs-base-autoloads)
diff --git a/xemacs-packages/lisp/xemacs-base/case-table.el b/xemacs-packages/lisp/xemacs-base/case-table.el
deleted file mode 100644
index 2b139a48..00000000
--- a/xemacs-packages/lisp/xemacs-base/case-table.el
+++ /dev/null
@@ -1,142 +0,0 @@
-;;; case-table.el --- code to extend the character set and support case tables.
-
-;; Copyright (C) 1988, 1993, 1997 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: XEmacs Development Team
-;; Keywords: i18n
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not synched with FSF.
-
-;;; Commentary:
-
-;; Written by:
-;; TN/ETX/TX/UMG Howard Gayle        UUCP : seismo!enea!erix!howard
-;; Telefonaktiebolaget L M Ericsson  Phone: +46 8 719 55 65
-;; Ericsson Telecom     	     Telex: 14910 ERIC S
-;; S-126 25 Stockholm                FAX  : +46 8 719 64 82
-;; Sweden
-
-;;; Code:
-
-;;;###autoload
-(defun describe-buffer-case-table ()
-  "Describe the case table of the current buffer."
-  (interactive)
-  (let ((buffer (current-buffer))
-	(i 0)
-	ch)
-    (with-displaying-help-buffer
-     (lambda ()
-       (set-buffer standard-output)
-       (while (< i 256)
-	 (setq ch (int-to-char i))
-	 (cond ((eq (upcase ch) (downcase ch))
-		nil)
-	       ((eq ch (downcase ch buffer))
-		(insert (text-char-description ch))
-		(indent-to 16)
-		(insert "uppercase, matches "
-			(text-char-description (downcase ch))
-			"\n"))
-	       ((eq ch (upcase ch buffer))
-		(insert (text-char-description ch))
-		(indent-to 16)
-		(insert "lowercase, matches "
-			(text-char-description (upcase ch))
-			"\n"))
-	       ;;	      (t
-	       ;;	       (insert (text-char-description ch))
-	       ;;	       (indent-to 16)
-	       ;;	       (insert "case-invariant\n"))
-	       )
-	 (setq i (1+ i)))))))
-
-(defun invert-case (count)
-  "Change the case of the character just after point and move over it.
-With arg, applies to that many chars.
-Negative arg inverts characters before point but does not move."
-  (interactive "p")
-  (if (< count 0)
-      (progn (setq count (min (1- (point)) (- count)))
-	     (forward-char (- count))))
-  (while (> count 0)
-    (let ((ch (char-after)))
-      (cond ((/= (upcase ch) ch)
-	     (insert (upcase ch))
-	     (delete-char 1))
-	    ((/= (downcase ch) ch)
-	     (insert (downcase ch))
-	     (delete-char 1))
-	    (t
-	     (forward-char 1))))
-    (setq count (1- count))))
-
-(defun set-case-syntax-delims (l r table)
-  "Make characters L and R a matching pair of non-case-converting delimiters.
-TABLE is a case-table object.
-Sets the entries for L and R in TABLE,
-standard-syntax-table, and text-mode-syntax-table to indicate
-left and right delimiters."
-  (if (functionp 'put-case-table-pair)
-      (progn
-	(put-case-table-pair l l table)
-	(put-case-table-pair r r table))
-    (aset (car table) l l)
-    (aset (car table) r r))
-  (modify-syntax-entry l (concat "(" (char-to-string r) "  ")
-		       (standard-syntax-table))
-  (modify-syntax-entry l (concat "(" (char-to-string r) "  ")
-		       text-mode-syntax-table)
-  (modify-syntax-entry r (concat ")" (char-to-string l) "  ")
-		       (standard-syntax-table))
-  (modify-syntax-entry r (concat ")" (char-to-string l) "  ")
-		       text-mode-syntax-table))
-
-(defun set-case-syntax-pair (uc lc table)
-  "Make characters UC and LC a pair of inter-case-converting letters.
-TABLE is a case-table object.
-Sets the entries for characters UC and LC in
-TABLE, standard-syntax-table, and
-text-mode-syntax-table to indicate an (uppercase, lowercase)
-pair of letters."
-  (if (functionp 'put-case-table-pair)
-      (put-case-table-pair uc lc table)
-    (aset (car table) uc lc))
-  (modify-syntax-entry lc "w   " (standard-syntax-table))
-  (modify-syntax-entry lc "w   " text-mode-syntax-table)
-  (modify-syntax-entry uc "w   " (standard-syntax-table))
-  (modify-syntax-entry uc "w   " text-mode-syntax-table))
-
-(defun set-case-syntax (c syntax table)
-  "Make characters C case-invariant with syntax SYNTAX.
-TABLE is a case-table object.
-Sets the entries for character C in TABLE,
-standard-syntax-table, and text-mode-syntax-table to indicate this.
-SYNTAX should be \" \", \"w\", \".\" or \"_\"."
-  (if (functionp 'put-case-table-pair)
-      (put-case-table-pair c c table)
-    (aset (car table) c c))
-  (modify-syntax-entry c syntax (standard-syntax-table))
-  (modify-syntax-entry c syntax text-mode-syntax-table))
-
-(provide 'case-table)
-
-;;; case-table.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/chistory.el b/xemacs-packages/lisp/xemacs-base/chistory.el
deleted file mode 100644
index efe1c903..00000000
--- a/xemacs-packages/lisp/xemacs-base/chistory.el
+++ /dev/null
@@ -1,179 +0,0 @@
-;;; chistory.el --- list command history
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This really has nothing to do with list-command-history per se, but
-;; its a nice alternative to C-x ESC ESC (repeat-complex-command) and
-;; functions as a lister if given no pattern.  It's not important
-;; enough to warrant a file of its own.
-
-;;; Code:
-
-(defvar command-history-map nil)
-
-(defvar command-history-hook nil
-  "If non-nil, its value is called on entry to `command-history-mode'.")
-
-;;;###autoload
-(defun repeat-matching-complex-command (&optional pattern)
-  "Edit and re-evaluate complex command with name matching PATTERN.
-Matching occurrences are displayed, most recent first, until you select
-a form for evaluation.  If PATTERN is empty (or nil), every form in the
-command history is offered.  The form is placed in the minibuffer for
-editing and the result is evaluated."
-  (interactive "sRedo Command (regexp): ")
-  (if pattern
-      (if (string-match "[^ \t]" pattern)
-	  (setq pattern (substring pattern (match-beginning 0)))
-	(setq pattern nil)))
-  (let ((history command-history)
-	(temp)
-	(what))
-    (while (and history (not what))
-      (setq temp (car history))
-      (if (and (or (not pattern) (string-match pattern (symbol-name (car temp))))
-	       (y-or-n-p (format "Redo %S? " temp)))
-	  (setq what (car history))
-	(setq history (cdr history))))
-    (if (not what)
-	(error "Command history exhausted")
-      ;; Try to remove any useless command history element for this command.
-      (if (eq (car (car command-history)) 'repeat-matching-complex-command)
-	  (setq command-history (cdr command-history)))
-      (edit-and-eval-command "Redo: " what))))
-
-(defvar default-command-history-filter-garbage
-  '(command-history-mode
-    list-command-history
-    electric-command-history)
-  "*A list of symbols to be ignored by `default-command-history-filter'.
-It that function is given a list whose car is an element of this list,
-then it will return non-nil (indicating the list should be discarded from
-the history).
-Initially, all commands related to the command history are discarded.")
-
-(defvar list-command-history-filter 'default-command-history-filter
-  "Predicate to test which commands should be excluded from the history listing.
-If non-nil, should be the name of a function of one argument.
-It is passed each element of the command history when
-\\[list-command-history] is called.  If the filter returns non-nil for
-some element, that element is excluded from the history listing.  The
-default filter removes commands associated with the command-history.")
-
-(defun default-command-history-filter (frob)
-  "Filter commands matching `default-command-history-filter-garbage' list
-from the command history."
-  (or (not (consp frob))
-      (memq (car frob) default-command-history-filter-garbage)))
-
-(defvar list-command-history-max 32
-  "*If non-nil, maximum length of the listing produced by `list-command-history'.")
-
-;;;###autoload
-(defun list-command-history ()
-  "List history of commands typed to minibuffer.
-The number of commands listed is controlled by `list-command-history-max'.
-Calls value of `list-command-history-filter' (if non-nil) on each history
-element to judge if that element should be excluded from the list.
-
-The buffer is left in Command History mode."
-  (interactive)
-  (with-output-to-temp-buffer
-      "*Command History*"
-    (let ((history command-history)
-	  (buffer-read-only nil)
-	  (count (or list-command-history-max -1)))
-      (while (and (/= count 0) history)
-	(if (and (boundp 'list-command-history-filter)
-		 list-command-history-filter
-		 (funcall list-command-history-filter (car history)))
-	    nil
-	  (setq count (1- count))
-	  (prin1 (car history))
-	  (terpri))
-	(setq history (cdr history))))
-    (save-excursion
-      (set-buffer "*Command History*")
-      (goto-char (point-min))
-      (if (eobp)
-	  (error "No command history")
-	(Command-history-setup)))))
-
-(defun Command-history-setup (&optional majormode modename keymap)
-  (set-buffer "*Command History*")
-  (use-local-map (or keymap command-history-map))
-  (lisp-mode-variables nil)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (setq buffer-read-only t)
-  (use-local-map (or keymap command-history-map))
-  (setq major-mode (or majormode 'command-history-mode))
-  (setq mode-name (or modename "Command History")))
-
-(if command-history-map
-    nil
-  (setq command-history-map (make-sparse-keymap))
-  (set-keymap-parent command-history-map shared-lisp-mode-map)
-  (set-keymap-name command-history-map 'command-history-map)
-  (suppress-keymap command-history-map)
-  (define-key command-history-map "x" 'command-history-repeat)
-  (define-key command-history-map "\n" 'next-line)
-  (define-key command-history-map "\r" 'next-line)
-  (define-key command-history-map 'backspace 'previous-line)
-  (define-key command-history-map 'delete 'previous-line))
-
-(defun command-history-repeat ()
-  "Repeat the command shown on the current line.
-The buffer for that command is the previous current buffer."
-  (interactive)
-  (save-excursion
-    (eval (prog1
-	      (save-excursion
-		(beginning-of-line)
-		(read (current-buffer)))
-	    (set-buffer
-	     (car (cdr (buffer-list))))))))
-
-;;;###autoload
-(defun command-history-mode ()
-  "Major mode for examining commands from `command-history'.
-The number of commands listed is controlled by `list-command-history-max'.
-The command history is filtered by `list-command-history-filter' if non-nil.
-Use \\\\[command-history-repeat] to repeat the command on the current line.
-
-Otherwise much like Emacs-Lisp Mode except that there is no self-insertion
-and digits provide prefix arguments.  Tab does not indent.
-\\{command-history-map}
-Calls the value of `command-history-hook' if that is non-nil.
-The Command History listing is recomputed each time this mode is invoked."
-  (interactive)
-  (list-command-history)
-  (pop-to-buffer "*Command History*")
-  (run-hooks 'command-history-hook))
-
-(provide 'chistory)
-
-;;; chistory.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/comint-xemacs.el b/xemacs-packages/lisp/xemacs-base/comint-xemacs.el
deleted file mode 100644
index 2a123a9b..00000000
--- a/xemacs-packages/lisp/xemacs-base/comint-xemacs.el
+++ /dev/null
@@ -1,53 +0,0 @@
-;;; comint-xemacs.el --- Face customizations for comint
-
-;; Copyright (C) 1997 by Free Software Foundation, Inc.
-
-;; Author: Steven L Baur 
-;; Keywords: help, faces
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;; Declare customizable faces for comint outside the main code so it can
-;; be dumped with XEmacs.
-
-;;; Code:
-
-(defgroup comint nil
-  "General command interpreter in a window stuff."
-  :group 'processes)
-
-(defface comint-input-face '((((class color)
-			      (background dark))
-			     (:foreground "red"))
-			    (((class color)
-			      (background light))
-			     (:foreground "blue"))
-			    (t 
-			     (:bold t)))
-  "How to display user input for comint shells."
-  :group 'comint)
-
-
-
-(provide 'comint-xemacs)
-
-;;; comint-xemacs.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/comint.el b/xemacs-packages/lisp/xemacs-base/comint.el
deleted file mode 100644
index ba7cbd79..00000000
--- a/xemacs-packages/lisp/xemacs-base/comint.el
+++ /dev/null
@@ -1,2943 +0,0 @@
-;;; comint.el --- general command interpreter in a window stuff
-
-;; Copyright (C) 1988, 90, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
-
-;; Author: Olin Shivers 
-;; Adapted-by: Simon Marshall 
-;; Maintainer: XEmacs Development Team
-;; Keywords: processes
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; 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 source has diverged somewhat from the FSF version.  Please send
-;; XEmacs related bug reports to news:comp.emacs.xemacs.
-
-;; Please send me bug reports, bug fixes, and extensions, so that I can
-;; merge them into the master source.
-;;     - Olin Shivers (shivers@cs.cmu.edu)
-;;     - Simon Marshall (simon@gnu.ai.mit.edu)
-
-;; This file defines a general command-interpreter-in-a-buffer package
-;; (comint mode). The idea is that you can build specific process-in-a-buffer
-;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, ....
-;; This way, all these specific packages share a common base functionality,
-;; and a common set of bindings, which makes them easier to use (and
-;; saves code, implementation time, etc., etc.).
-
-;; Several packages are already defined using comint mode:
-;; - shell.el defines a shell-in-a-buffer mode.
-;; - cmulisp.el defines a simple lisp-in-a-buffer mode.
-;;
-;; - The file cmuscheme.el defines a scheme-in-a-buffer mode.
-;; - The file tea.el tunes scheme and inferior-scheme modes for T.
-;; - The file soar.el tunes lisp and inferior-lisp modes for Soar.
-;; - cmutex.el defines tex and latex modes that invoke tex, latex, bibtex,
-;;   previewers, and printers from within emacs.
-;; - background.el allows csh-like job control inside emacs.
-;; It is pretty easy to make new derived modes for other processes.
-
-;; For documentation on the functionality provided by comint mode, and
-;; the hooks available for customising it, see the comments below.
-;; For further information on the standard derived modes (shell,
-;; inferior-lisp, inferior-scheme, ...), see the relevant source files.
-
-;; For hints on converting existing process modes (e.g., tex-mode,
-;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode
-;; instead of shell-mode, see the notes at the end of this file.
-
-
-;; Brief Command Documentation:
-;;============================================================================
-;; Comint Mode Commands: (common to all derived modes, like shell & cmulisp
-;; mode)
-;;
-;; XEmacs rebinds m-p/M-n to looking for matching input
-;; m-p	   comint-previous-input    	    Cycle backwards in input history
-;; m-n	   comint-next-input  	    	    Cycle forwards
-;; m-r     comint-previous-matching-input   Previous input matching a regexp
-;; m-s     comint-next-matching-input       Next input that matches
-;; m-c-l   comint-show-output		    Show last batch of process output
-;; return  comint-send-input
-;; c-a	   comint-bol			    Beginning of line; skip prompt
-;; c-d	   comint-delchar-or-maybe-eof      Delete char unless at end of buff
-;; c-c c-a comint-bol                       Beginning of line; skip prompt
-;; c-c c-u comint-kill-input	    	    ^u
-;; c-c c-w backward-kill-word    	    ^w
-;; c-c c-c comint-interrupt-subjob 	    ^c
-;; c-c c-z comint-stop-subjob	    	    ^z
-;; c-c c-\ comint-quit-subjob	    	    ^\
-;; c-c c-o comint-kill-output		    Delete last batch of process output
-;; c-c c-r comint-show-output		    Show last batch of process output
-;; c-c c-l comint-dynamic-list-input-ring  List input history
-;;
-;; Not bound by default in comint-mode (some are in shell mode)
-;; comint-run				Run a program under comint-mode
-;; send-invisible			Read a line w/o echo, and send to proc
-;; comint-dynamic-complete-filename	Complete filename at point.
-;; comint-dynamic-complete-variable    Complete variable name at point.
-;; comint-dynamic-list-filename-completions List completions in help buffer.
-;; comint-replace-by-expanded-filename	Expand and complete filename at point;
-;;					replace with expanded/completed name.
-;; comint-replace-by-expanded-history	Expand history at point;
-;;					replace with expanded name.
-;; comint-magic-space                  Expand history and add (a) space(s).
-;; comint-kill-subjob			No mercy.
-;; comint-show-maximum-output          Show as much output as possible.
-;; comint-continue-subjob		Send CONT signal to buffer's process
-;;					group. Useful if you accidentally
-;;					suspend your process (with C-c C-z).
-
-;; comint-mode-hook is the comint mode hook. Basically for your keybindings.
-
-;;; Code:
-
-(require 'ring)
-
-;; Buffer Local Variables:
-;;============================================================================
-;; Comint mode buffer local variables:
-;;  comint-prompt-regexp    		string	comint-bol uses to match prompt
-;;  comint-delimiter-argument-list	list	For delimiters and arguments
-;;  comint-last-input-start		marker	Handy if inferior always echoes
-;;  comint-last-input-end		marker	For comint-kill-output command
-;;  comint-input-ring-size		integer	For the input history
-;;  comint-input-ring			ring	mechanism
-;;  comint-input-ring-index		number	...
-;;  comint-input-autoexpand		symbol	...
-;;  comint-input-ignoredups		boolean	...
-;;  comint-last-input-match		string	...
-;;  comint-dynamic-complete-functions	hook   For the completion mechanism
-;;  comint-completion-fignore		list	...
-;;  comint-file-name-chars		string	...
-;;  comint-file-name-quote-list		list	...
-;;  comint-get-old-input		function Hooks for specific
-;;  comint-input-filter-functions	hook	process-in-a-buffer
-;;  comint-output-filter-functions	hook	function modes.
-;;  comint-input-filter			function ...
-;;  comint-input-sender			function ...
-;;  comint-eol-on-send			boolean	...
-;;  comint-process-echoes		boolean	...
-;;  comint-scroll-to-bottom-on-input	symbol	For scroll behavior
-;;  comint-scroll-to-bottom-on-output	symbol	...
-;;  comint-scroll-show-maximum-output	boolean	...
-;;
-;; Comint mode non-buffer local variables:
-;;  comint-completion-addsuffix		boolean/cons	For file name
-;;  comint-completion-autolist		boolean		completion behavior
-;;  comint-completion-recexact		boolean		...
-
-(defvar comint-prompt-regexp "^"
-  "Regexp to recognise prompts in the inferior process.
-Defaults to \"^\", the null string at BOL.
-
-Good choices:
-  Canonical Lisp: \"^[^> \\n]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
-  Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
-  franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
-  kcl: \"^>+ *\"
-  shell: \"^[^#$%>\\n]*[#$%>] *\"
-  T: \"^>+ *\"
-
-The pattern should begin with \"^\".  It can match text on more than one line.
-This pattern gets handed to re-search-backward, not looking-at.
-
-This is a good thing to set in mode hooks.")
-
-(defvar comint-delimiter-argument-list ()
-  "List of characters to recognise as separate arguments in input.
-Strings comprising a character in this list will separate the arguments
-surrounding them, and also be regarded as arguments in their own right (unlike
-whitespace).  See `comint-arguments'.
-Defaults to the empty list.
-
-For shells, a good value is (?\\| ?& ?< ?> ?\\( ?\\) ?;).
-
-This is a good thing to set in mode hooks.")
-
-(defcustom comint-input-autoexpand nil
-  "*If non-nil, expand input command history references on completion.
-This mirrors the optional behavior of tcsh (its autoexpand and histlit).
-
-If the value is `input', then the expansion is seen on input.
-If the value is `history', then the expansion is only when inserting
-into the buffer's input ring.  See also `comint-magic-space' and
-`comint-dynamic-complete'.
-
-This variable is buffer-local."
-  :type '(choice (const :tag "off" nil)
-		 (const :tag "on" t)
-		 (const input)
-		 (const history))
-  :group 'comint)
-
-;; This should default to t for consistency with minibuffer history. -jwz
-(defcustom comint-input-ignoredups t
-  "*If non-nil, don't add input matching the last on the input ring.
-This mirrors the optional behavior of bash.
-
-This variable is buffer-local."
-  :type 'boolean
-  :group 'comint)
-
-(defcustom comint-input-ring-file-name nil
-  "*If non-nil, name of the file to read/write input history.
-See also `comint-read-input-ring' and `comint-write-input-ring'.
-
-This variable is buffer-local, and is a good thing to set in mode hooks."
-  :type '(choice (const :tag "None" nil)
-	         (file))
-  :group 'comint)
-
-(defcustom comint-scroll-to-bottom-on-input nil
-  "*Controls whether input to interpreter causes window to scroll.
-If nil, then do not scroll.  If t or `all', scroll all windows showing buffer.
-If `this', scroll only the selected window.
-
-The default is nil.
-
-See `comint-preinput-scroll-to-bottom'.  This variable is buffer-local."
-  :type '(choice (const :tag "off" nil)
-		 (const t)
-		 (const all)
-		 (const this))
-  :group 'comint)
-
-(defcustom comint-scroll-to-bottom-on-output nil
-  "*Controls whether interpreter output causes window to scroll.
-If nil, then do not scroll.  If t or `all', scroll all windows showing buffer.
-If `this', scroll only the selected window.
-If `others', scroll only those that are not the selected window.
-
-The default is nil.
-
-See variable `comint-scroll-show-maximum-output' and function
-`comint-postoutput-scroll-to-bottom'.  This variable is buffer-local."
-  :type '(choice (const :tag "off" nil)
-		 (const t)
-		 (const all)
-		 (const this)
-		 (const others))
-  :group 'comint)
-
-(defcustom comint-scroll-show-maximum-output t
-  "*Controls how interpreter output causes window to scroll.
-If non-nil, then show the maximum output when the window is scrolled.
-
-You may set this to an integer number of lines to keep shown, or a
-floating point percentage of the window size to keep filled.
-A negative number expresses a distance from the bottom, as when using
-a prefix argument with `recenter' (bound to `\\[recenter]').
-
-See variable `comint-scroll-to-bottom-on-output' and function
-`comint-postoutput-scroll-to-bottom'.  This variable is buffer-local."
-  :type '(choice (const :tag "Off" nil)
-		 (const :tag "On" t)
-		 (integer :tag "Number of lines" 20)
-		 (number :tag "Decimal Percent of window" .85))
-  :group 'comint)
-
-(defcustom comint-buffer-maximum-size 1024
-  "*The maximum size in lines for comint buffers.
-Comint buffers are truncated from the top to be no greater than this number, if
-the function `comint-truncate-buffer' is on `comint-output-filter-functions'."
-  :type 'integer
-  :group 'comint)
-
-(defvar comint-input-ring-size 32
-  "Size of input history ring.")
-
-(defcustom comint-process-echoes nil
-  "*If non-nil, assume that the subprocess echoes any input.
-If so, delete one copy of the input so that only one copy eventually
-appears in the buffer.
-
-This variable is buffer-local."
-  :type 'boolean
-  :group 'comint)
-
-;; AIX puts the name of the person being su'd to in from of the prompt.
-(defcustom comint-password-prompt-regexp
-  (if (eq system-type 'aix-v3)
-      "\\(\\([Oo]ld \\|[Nn]ew \\|^\\|^..*s \\)[Pp]assword\\|pass ?phrase\\):\\s *\\'"
-  "\\(\\([Oo]ld \\|[Nn]ew \\|^\\)[Pp]assword\\|pass ?phrase\\):\\s *\\'")
-  "*Regexp matching prompts for passwords in the inferior process.
-This is used by `comint-watch-for-password-prompt'."
-  :type 'regexp
-  :group 'comint)
-
-;; Here are the per-interpreter hooks.
-(defvar comint-get-old-input (function comint-get-old-input-default)
-  "Function that returns old text in comint mode.
-This function is called when return is typed while the point is in old text.
-It returns the text to be submitted as process input.  The default is
-`comint-get-old-input-default', which grabs the current line, and strips off
-leading text matching `comint-prompt-regexp'.")
-
-(defcustom comint-append-old-input t
-  "*If nil, old text selected by \\[comint-send-input] is re-sent immediately.
-If non-nil, the old text is appended to the end of the buffer,
-and a prompting message is printed.
-
-This flag does not affect the behavior of \\[comint-send-input]
-after the process output mark."
-  :type 'boolean
-  :group 'comint)
-
-(defvar comint-dynamic-complete-functions
-  '(comint-replace-by-expanded-history comint-dynamic-complete-filename)
-  "List of functions called to perform completion.
-Functions should return non-nil if completion was performed.
-See also `comint-dynamic-complete'.
-
-This is a good thing to set in mode hooks.")
-
-(defvar comint-input-filter
-  #'(lambda (str)
-      (and (not (string-match "\\`\\s *\\'" str))
-           ;; Ignore '!!' and kin
-           (> (length str) 2)))
-  "Predicate for filtering additions to input history.
-Takes one argument, the input.  If non-nil, the input may be saved on the input
-history list.  Default is to save anything longer than two characters
-that isn't all whitespace.")
-
-(defvar comint-input-filter-functions '()
-  "Functions to call before input is sent to the process.
-These functions get one argument, a string containing the text to send.
-
-This variable is buffer-local.")
-
-(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom
-					 comint-watch-for-password-prompt)
-  "Functions to call after output is inserted into the buffer.
-One possible function is `comint-postoutput-scroll-to-bottom'.
-These functions get one argument, a string containing the text as originally
-inserted.  Note that this might not be the same as the buffer contents between
-`comint-last-output-start' and the buffer's `process-mark', if other filter
-functions have already modified the buffer.
-
-This variable is buffer-local.")
-
-(defvar comint-input-sender (function comint-simple-send)
-  "Function to actually send to PROCESS the STRING submitted by user.
-Usually this is just `comint-simple-send', but if your mode needs to
-massage the input string, put a different function here.
-`comint-simple-send' just sends the string plus a newline.
-This is called from the user command `comint-send-input'.")
-
-(defcustom comint-eol-on-send t
-  "*Non-nil means go to the end of the line before sending input.
-See `comint-send-input'."
-  :type 'boolean
-  :group 'comint)
-
-(defcustom comint-mode-hook '()
-  "Called upon entry into comint-mode
-This is run before the process is cranked up."
-  :type 'hook
-  :group 'comint)
-
-;; This is initialized by the various language environments, do not
-;; Custom-ize it.
-(defvar comint-exec-hook '()
-  "Called each time a process is exec'd by `comint-exec'.
-This is called after the process is cranked up.  It is useful for things that
-must be done each time a process is executed in a comint mode buffer (e.g.,
-`(process-kill-without-query)').  In contrast, the `comint-mode-hook' is only
-executed once when the buffer is created.")
-
-(defvar comint-mode-map nil)
-
-(defvar comint-ptyp t
-  "Non-nil if communications via pty; false if by pipe.  Buffer local.
-This is to work around a bug in Emacs process signaling.")
-
-(defvar comint-input-ring nil)
-(defvar comint-last-input-start)
-(defvar comint-last-input-end)
-(defvar comint-last-output-start)
-(defvar comint-input-ring-index nil
-  "Index of last matched history element.")
-(defvar comint-matching-input-from-input-string ""
-  "Input previously used to match input history.")
-
-(put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand)
-(put 'comint-input-ring 'permanent-local t)
-(put 'comint-input-ring-index 'permanent-local t)
-(put 'comint-input-autoexpand 'permanent-local t)
-(put 'comint-input-filter-functions 'permanent-local t)
-(put 'comint-output-filter-functions 'permanent-local t)
-(put 'comint-scroll-to-bottom-on-input 'permanent-local t)
-(put 'comint-scroll-to-bottom-on-output 'permanent-local t)
-(put 'comint-scroll-show-maximum-output 'permanent-local t)
-(put 'comint-ptyp 'permanent-local t)
-
-(defvar comint-1-menubar-menu nil)
-(defconst comint-1-menubar-menu-1
-  (purecopy
-   '("Complete"
-     ["Complete Before Point" comint-dynamic-complete t]
-     ["Complete File Name" comint-dynamic-complete-filename t]
-     ["File Completion Listing" comint-dynamic-list-filename-completions t]
-     ["Expand File Name" comint-replace-by-expanded-filename t]
-     ;; this is cheesy but the easiest way to get this.
-     ["Complete Env. Variable Name" shell-dynamic-complete-environment-variable
-      :active t :included (eq 'shell-mode major-mode)]
-     ["Expand Directory Reference" shell-replace-by-expanded-directory
-      :active t :included (eq 'shell-mode major-mode)]
-     "---"
-     ("History"
-       :filter comint-history-menu-filter
-       ["Expand History Before Point" comint-replace-by-expanded-history
-	comint-input-autoexpand]
-       ["List Input History" comint-dynamic-list-input-ring t]
-       "---"
-       ))))
-
-(defvar comint-2-menubar-menu nil)
-(defconst comint-2-menubar-menu-1
-  (purecopy
-   '("In/Out"
-     ["Previous Matching Current Input"
-      comint-previous-matching-input-from-input t]
-     ["Next Matching Current Input" comint-next-matching-input-from-input t]
-     ["Previous Input" comint-previous-input t]
-     ["Next Input" comint-next-input t]
-     ["Previous Input Matching Regexp..." comint-previous-matching-input t]
-     ["Next Input Matching Regexp..." comint-next-matching-input t]
-     ["Backward Matching Input..." comint-backward-matching-input t]
-     ["Forward Matching Input..." comint-forward-matching-input t]
-     "---"
-     ["Copy Old Input" comint-copy-old-input t]
-     ["Kill Current Input" comint-kill-input t]
-     ["Show Current Output Group" comint-show-output t]
-     ["Show Maximum Output" comint-show-maximum-output t]
-     ["Goto Previous Prompt" comint-previous-prompt t]
-     ["Goto Next Prompt" comint-next-prompt t]
-     ["Kill Command Output" comint-kill-output t]
-     )))
-
-(defvar comint-history-menubar-menu nil)
-(defconst comint-history-menubar-menu-1
-  (purecopy
-   '("Signals"
-     ["Send INT"  comint-interrupt-subjob t]
-     ["Send STOP" comint-stop-subjob t]
-     ["Send CONT" comint-continue-subjob t]
-     ["Send QUIT" comint-quit-subjob t]
-     ["Send KILL" comint-kill-subjob t]
-     ["Send EOF"  comint-send-eof t]
-     )))
-
-
-
-;;;###autoload
-(defun comint-mode ()
-  "Major mode for interacting with an inferior interpreter.
-Interpreter name is same as buffer name, sans the asterisks.
-Return at end of buffer sends line as input.
-Return not at end copies rest of line to end and sends it.
-Setting variable `comint-eol-on-send' means jump to the end of the line
-before submitting new input.
-
-This mode is customised to create major modes such as Inferior Lisp
-mode, Shell mode, etc.  This can be done by setting the hooks
-`comint-input-filter-functions', `comint-input-filter', `comint-input-sender'
-and `comint-get-old-input' to appropriate functions, and the variable
-`comint-prompt-regexp' to the appropriate regular expression.
-
-An input history is maintained of size `comint-input-ring-size', and
-can be accessed with the commands \\[comint-next-input], \\[comint-previous-input], and \\[comint-dynamic-list-input-ring].
-Input ring history expansion can be achieved with the commands
-\\[comint-replace-by-expanded-history] or \\[comint-magic-space].
-Input ring expansion is controlled by the variable `comint-input-autoexpand',
-and addition is controlled by the variable `comint-input-ignoredups'.
-
-Commands with no default key bindings include `send-invisible',
-`comint-dynamic-complete', `comint-dynamic-list-filename-completions', and
-`comint-magic-space'.
-
-Input to, and output from, the subprocess can cause the window to scroll to
-the end of the buffer.  See variables `comint-output-filter-functions',
-`comint-scroll-to-bottom-on-input', and `comint-scroll-to-bottom-on-output'.
-
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it.
-
-\\{comint-mode-map}
-
-Entry to this mode runs the hooks on `comint-mode-hook'."
-  (interactive)
-  ;; Do not remove this.  All major modes must do this.
-  (kill-all-local-variables)
-  (setq major-mode 'comint-mode)
-  (setq mode-name "Comint")
-  (setq mode-line-process '(":%s"))
-  (use-local-map comint-mode-map)
-  (make-local-variable 'comint-last-input-start)
-  (setq comint-last-input-start (make-marker))
-  (set-marker comint-last-input-start (point-min))
-  (make-local-variable 'comint-last-input-end)
-  (setq comint-last-input-end (make-marker))
-  (set-marker comint-last-input-end (point-min))
-  (make-local-variable 'comint-last-output-start)
-  (setq comint-last-output-start (make-marker))
-  (make-local-variable 'comint-prompt-regexp)        ; Don't set; default
-  (make-local-variable 'comint-input-ring-size)      ; ...to global val.
-  (make-local-variable 'comint-input-ring)
-  (make-local-variable 'comint-input-ring-file-name)
-  (or (and (boundp 'comint-input-ring) comint-input-ring)
-      (setq comint-input-ring (make-ring comint-input-ring-size)))
-  (make-local-variable 'comint-input-ring-index)
-  (or (and (boundp 'comint-input-ring-index) comint-input-ring-index)
-      (setq comint-input-ring-index nil))
-  (make-local-variable 'comint-matching-input-from-input-string)
-  (make-local-variable 'comint-input-autoexpand)
-  (make-local-variable 'comint-input-ignoredups)
-  (make-local-variable 'comint-delimiter-argument-list)
-  (make-local-hook 'comint-dynamic-complete-functions)
-  (make-local-variable 'comint-completion-fignore)
-  (make-local-variable 'comint-get-old-input)
-  (make-local-hook 'comint-input-filter-functions)
-  (make-local-variable 'comint-input-filter)
-  (make-local-variable 'comint-input-sender)
-  (make-local-variable 'comint-eol-on-send)
-  (make-local-variable 'comint-scroll-to-bottom-on-input)
-  (make-local-variable 'comint-scroll-to-bottom-on-output)
-  (make-local-variable 'comint-scroll-show-maximum-output)
-  (make-local-hook 'pre-command-hook)
-  (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom nil t)
-  (make-local-hook 'comint-output-filter-functions)
-  (make-local-variable 'comint-ptyp)
-  (make-local-hook 'comint-exec-hook)
-  (make-local-variable 'comint-process-echoes)
-  (make-local-variable 'comint-file-name-chars)
-  (make-local-variable 'comint-file-name-quote-list)
-  (unless comint-1-menubar-menu
-    (easy-menu-define comint-1-menubar-menu nil ""
-		      comint-1-menubar-menu-1))
-  (easy-menu-add comint-1-menubar-menu)
-  ;; (add-submenu nil comint-2-menubar-menu)
-  (unless comint-2-menubar-menu
-    (easy-menu-define comint-2-menubar-menu nil ""
-		      comint-2-menubar-menu-1))
-  (easy-menu-add comint-2-menubar-menu)
-  ;; (add-submenu nil comint-history-menubar-menu)))
-  (unless comint-history-menubar-menu
-    (easy-menu-define comint-history-menubar-menu nil ""
-		      comint-history-menubar-menu-1))
-  (easy-menu-add comint-history-menubar-menu)
-  (run-hooks 'comint-mode-hook))
-
-(if comint-mode-map
-    nil
-  ;; Keys:
-  (setq comint-mode-map (make-sparse-keymap))
-  (if (fboundp 'set-keymap-name)
-      (set-keymap-name comint-mode-map 'comint-mode-map))
-  (define-key comint-mode-map "\ep" 'comint-previous-input)
-  (define-key comint-mode-map "\en" 'comint-next-input)
-  (define-key comint-mode-map '(control up) 'comint-previous-input)
-  (define-key comint-mode-map '(control down) 'comint-next-input)
-  (define-key comint-mode-map "\er" 'comint-previous-matching-input)
-  (define-key comint-mode-map "\es" 'comint-next-matching-input)
-  ;; (define-key comint-mode-map [?\A-\M-r] 'comint-previous-matching-input-from-input)
-  ;; (define-key comint-mode-map [?\A-\M-s] 'comint-next-matching-input-from-input)
-  ;;(define-key comint-mode-map "\e\C-l" 'comint-show-output)
-  (define-key comint-mode-map "\C-m" 'comint-send-input)
-  (define-key comint-mode-map "\C-a" 'comint-bol)
-  (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
-  (define-key comint-mode-map "\C-c\C-a" 'comint-bol)
-  (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)
-  (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)
-  (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob)
-  (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob)
-  (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob)
-  (define-key comint-mode-map "\C-c\C-m" 'comint-copy-old-input)
-  (define-key comint-mode-map "\C-c\C-o" 'comint-kill-output)
-  (define-key comint-mode-map "\C-c\C-r" 'comint-show-output)
-  (define-key comint-mode-map "\C-c\C-e" 'comint-show-maximum-output)
-  (define-key comint-mode-map "\C-c\C-l" 'comint-dynamic-list-input-ring)
-  (define-key comint-mode-map "\C-c\C-n" 'comint-next-prompt)
-  (define-key comint-mode-map "\C-c\C-p" 'comint-previous-prompt)
-  (define-key comint-mode-map "\C-c\C-d" 'comint-send-eof)
-  ;; John Rose's suggestion
-  (define-key comint-mode-map "\e}" 'comint-next-prompt)
-  (define-key comint-mode-map "\e{" 'comint-previous-prompt)
-
-  ;;#-infodock (define-key comint-mode-map 'button3 'comint-popup-menu)
-  )
-
-;;
-;; Left for infodock.  Not sure if history is right.
-;;
-(defun comint-popup-menu (event)
-  "Display the comint-mode menu."
-  (interactive "@e")
-  (let ((history (comint-make-history-menu)))
-    (popup-menu (if history
-		    (append mode-popup-menu
-			    (list "---" (cons "Command History" history)))
-		  mode-popup-menu))))
-
-(defcustom comint-history-menu-max 40
-  "*Maximum number of entries to display on the Comint command-history menu."
-  :type 'integer
-  :group 'comint)
-
-(defun comint-history-menu-filter (menu)
-  (append menu (comint-make-history-menu)))
-
-(defun comint-make-history-menu ()
-  (if (or (not (ringp comint-input-ring))
-	  (ring-empty-p comint-input-ring))
-      nil
-    (let ((menu nil)
-	  hist
-	  (index (1- (ring-length comint-input-ring)))
-	  (count 0))
-      ;; We have to build up a list ourselves from the ring vector.
-      ;; We don't want the entries to get translated in a Mule
-      ;; environment, so we use the `suffix' field of the menu entries.
-      (while (and (>= index 0)
-		  (and comint-history-menu-max
-		       (< count comint-history-menu-max)))
-	(setq hist (ring-ref comint-input-ring index)
-	      menu (cons (vector "" (list 'comint-menu-history hist) t hist)
-			 menu)
-	      count (1+ count)
-	      index (1- index)))
-      menu)))
-
-(defun comint-menu-history (string)
-  (goto-char (point-max))
-  (delete-region (process-mark (get-buffer-process (current-buffer))) (point))
-  (insert string))
-
-(defun comint-check-proc (buffer)
-  "Return t if there is a living process associated w/buffer BUFFER.
-Living means the status is `open', `run', or `stop'.
-BUFFER can be either a buffer or the name of one."
-  (let ((proc (get-buffer-process buffer)))
-    (and proc (memq (process-status proc) '(open run stop)))))
-
-;; #### Hack until FSF comint is integrated.
-(defun make-comint-1 (buffer program &optional startfile &rest switches)
-  (or (fboundp 'start-process)
-      (error "Multi-processing is not supported for this system"))
-  ;; If no process, or nuked process, crank up a new one and put buffer in
-  ;; comint mode.  Otherwise, leave buffer and existing process alone.
-  (cond ((not (comint-check-proc buffer))
-	 (save-excursion
-	   (set-buffer buffer)
-	   (comint-mode)) ; Install local vars, mode, keymap, ...
-	 (comint-exec buffer name program startfile switches)))
-  buffer)
-
-;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it ()
-;; for the second argument (program).
-;;;###autoload
-(defun make-comint (name program &optional startfile &rest switches)
-  "Make a comint process NAME in a buffer, running PROGRAM.
-The name of the buffer is made by surrounding NAME with `*'s.
-PROGRAM should be either a string denoting an executable program to create
-via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP
-connection to be opened via `open-network-stream'.  If there is already a
-running process in that buffer, it is not restarted.  Optional third arg
-STARTFILE is the name of a file to send the contents of to the process.
-
-If PROGRAM is a string, any more args are arguments to PROGRAM."
-  (apply 'make-comint-1 (get-buffer-create (concat "*" name "*")) program
-	 startfile switches))
-
-;;;###autoload
-(defun comint-run (program)
-  "Run PROGRAM in a comint buffer and switch to it.
-The buffer name is made by surrounding the file name of PROGRAM with `*'s.
-The file name is used to make a symbol name, such as `comint-sh-hook', and any
-hooks on this symbol are run in the buffer.
-See `make-comint' and `comint-exec'."
-  (interactive "sRun program: ")
-  (let ((name (file-name-nondirectory program)))
-    (switch-to-buffer (make-comint name program))
-    (run-hooks (intern-soft (concat "comint-" name "-hook")))))
-
-(defun comint-exec (buffer name command startfile switches)
-  "Start up a process in buffer BUFFER for comint modes.
-Blasts any old process running in the buffer.  Doesn't set the buffer mode.
-You can use this to cheaply run a series of processes in the same comint
-buffer.  The hook `comint-exec-hook' is run after each exec."
-  (save-excursion
-    (set-buffer buffer)
-    (let ((proc (get-buffer-process buffer)))	; Blast any old process.
-      (if proc (delete-process proc)))
-    ;; Crank up a new process
-    (let ((proc
-	   (if (consp command)
-	       (open-network-stream name buffer (car command) (cdr command))
-	     (comint-exec-1 name buffer command switches))))
-      (set-process-filter proc 'comint-output-filter)
-      (make-local-variable 'comint-ptyp)
-      (setq comint-ptyp process-connection-type) ; T if pty, NIL if pipe.
-      ;; Jump to the end, and set the process mark.
-      (goto-char (point-max))
-      (set-marker (process-mark proc) (point))
-      ;; Feed it the startfile.
-      (cond (startfile
-	     ;;This is guaranteed to wait long enough
-	     ;;but has bad results if the comint does not prompt at all
-	     ;;	     (while (= size (buffer-size))
-	     ;;	       (sleep-for 1))
-	     ;;I hope 1 second is enough!
-	     (sleep-for 1)
-	     (goto-char (point-max))
-	     (insert-file-contents startfile)
-	     (setq startfile (buffer-substring (point) (point-max)))
-	     (delete-region (point) (point-max))
-	     (comint-send-string proc startfile)))
-    (run-hooks 'comint-exec-hook)
-    buffer)))
-
-;; This auxiliary function cranks up the process for comint-exec in
-;; the appropriate environment.
-
-(defun comint-exec-1 (name buffer command switches)
-  (let ((process-environment
-	 (nconc
-	  ;; If using termcap, we specify `emacs' as the terminal type
-	  ;; because that lets us specify a width.
-	  ;; If using terminfo, we specify `dumb' because that is
-	  ;; a defined terminal type.  `emacs' is not a defined terminal type
-	  ;; and there is no way for us to define it here.
-	  ;; Some programs that use terminfo get very confused
-	  ;; if TERM is not a valid terminal type.
-	  (if (and (boundp 'system-uses-terminfo) system-uses-terminfo)
-	      (list "TERM=dumb"
-		    (format "COLUMNS=%d" (frame-width)))
-	    (list "TERM=emacs"
-		  (format "TERMCAP=emacs:co#%d:tc=unknown:" (frame-width))))
-	  (if (getenv "EMACS") nil (list "EMACS=t"))
-	  process-environment))
-	(default-directory
-	  (if (file-directory-p default-directory)
-	      default-directory
-	    "/")))
-    (apply 'start-process name buffer command switches)))
-
-;; Input history processing in a buffer
-;; ===========================================================================
-;; Useful input history functions, courtesy of the Ergo group.
-
-;; Eleven commands:
-;; comint-dynamic-list-input-ring	List history in help buffer.
-;; comint-previous-input		Previous input...
-;; comint-previous-matching-input	...matching a string.
-;; comint-previous-matching-input-from-input ... matching the current input.
-;; comint-next-input			Next input...
-;; comint-next-matching-input		...matching a string.
-;; comint-next-matching-input-from-input     ... matching the current input.
-;; comint-backward-matching-input      Backwards input...
-;; comint-forward-matching-input       ...matching a string.
-;; comint-replace-by-expanded-history	Expand history at point;
-;;					replace with expanded history.
-;; comint-magic-space			Expand history and insert space.
-;;
-;; Three functions:
-;; comint-read-input-ring              Read into comint-input-ring...
-;; comint-write-input-ring             Write to comint-input-ring-file-name.
-;; comint-replace-by-expanded-history-before-point Workhorse function.
-
-(defun comint-read-input-ring (&optional silent)
-  "Sets the buffer's `comint-input-ring' from a history file.
-The name of the file is given by the variable `comint-input-ring-file-name'.
-The history ring is of size `comint-input-ring-size', regardless of file size.
-If `comint-input-ring-file-name' is nil this function does nothing.
-
-If the optional argument SILENT is non-nil, we say nothing about a
-failure to read the history file.
-
-This function is useful for major mode commands and mode hooks.
-
-The structure of the history file should be one input command per line,
-with the most recent command last.
-See also `comint-input-ignoredups' and `comint-write-input-ring'."
-  (cond ((or (null comint-input-ring-file-name)
-	     (equal comint-input-ring-file-name ""))
-	 nil)
-	((not (file-readable-p comint-input-ring-file-name))
-	 (or silent
-	     (message "Cannot read history file %s"
-		      comint-input-ring-file-name)))
-	(t
-	 (let ((history-buf (get-buffer-create " *temp*"))
-	       (file comint-input-ring-file-name)
-	       (count 0)
-	       (ring (make-ring comint-input-ring-size)))
-	   (unwind-protect
-	       (save-excursion
-		 (set-buffer history-buf)
-		 (widen)
-		 (erase-buffer)
-		 (insert-file-contents file)
-		 ;; Save restriction in case file is already visited...
-		 ;; Watch for those date stamps in history files!
-		 (goto-char (point-max))
-		 (while (and (< count comint-input-ring-size)
-			     (re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$"
-						 nil t))
-		   (let ((history (buffer-substring (match-beginning 1)
-						    (match-end 1))))
-		     (if (or (null comint-input-ignoredups)
-			     (ring-empty-p ring)
-			     (not (string-equal (ring-ref ring 0) history)))
-			 (ring-insert-at-beginning ring history)))
-		   (setq count (1+ count))))
-	     (kill-buffer history-buf))
-	   (setq comint-input-ring ring
-		 comint-input-ring-index nil)))))
-
-(defun comint-write-input-ring ()
-  "Writes the buffer's `comint-input-ring' to a history file.
-The name of the file is given by the variable `comint-input-ring-file-name'.
-The original contents of the file are lost if `comint-input-ring' is not empty.
-If `comint-input-ring-file-name' is nil this function does nothing.
-
-Useful within process sentinels.
-
-See also `comint-read-input-ring'."
-  (cond ((or (null comint-input-ring-file-name)
-	     (equal comint-input-ring-file-name "")
-	     (null comint-input-ring) (ring-empty-p comint-input-ring))
-	 nil)
-	((not (file-writable-p comint-input-ring-file-name))
-	 (message "Cannot write history file %s" comint-input-ring-file-name))
-	(t
-	 (let* ((history-buf (get-buffer-create " *Temp Input History*"))
-		(ring comint-input-ring)
-		(file comint-input-ring-file-name)
-		(index (ring-length ring)))
-	   ;; Write it all out into a buffer first.  Much faster, but messier,
-	   ;; than writing it one line at a time.
-	   (save-excursion
-	     (set-buffer history-buf)
-	     (erase-buffer)
-	     (while (> index 0)
-	       (setq index (1- index))
-	       (insert (ring-ref ring index) ?\n))
-	     (write-region (buffer-string) nil file nil 'no-message)
-	     (kill-buffer nil))))))
-
-;; XEmacs - FSF doesn't have this.
-(defun comint-restore-window-config (conf &optional message)
-  ;; Don't obscure buffer being edited
-  (or (eq (selected-window) (minibuffer-window))
-      (message "%s" (or message "Press space to flush")))
-  (sit-for 0)
-  (if (if (fboundp 'next-command-event)
-          ;; lemacs
-          (let ((ch (next-command-event)))
-            (if (eq (event-to-character ch) ?\ )
-                t
-                (progn (setq unread-command-event ch)
-                       nil)))
-          ;; v19 FSFmacs
-          (let ((ch (read-event)))
-            (if (eq ch ?\ )
-                t
-                (progn (setq unread-command-events (list ch))
-                       nil))))
-      (set-window-configuration conf)))
-
-
-(defun comint-dynamic-list-input-ring ()
-  "List in help buffer the buffer's input history."
-  (interactive)
-  (if (or (not (ring-p comint-input-ring))
-	  (ring-empty-p comint-input-ring))
-      (message "No history")
-    (let ((history nil)
-	  (history-buffer " *Input History*")
-	  (index (1- (ring-length comint-input-ring)))
-	  (conf (current-window-configuration)))
-      ;; We have to build up a list ourselves from the ring vector.
-      (while (>= index 0)
-	(setq history (cons (ring-ref comint-input-ring index) history)
-	      index (1- index)))
-      ;; Change "completion" to "history reference"
-      ;; to make the display accurate.
-      (with-output-to-temp-buffer history-buffer
-	(display-completion-list history)
-	(set-buffer history-buffer)
-	(forward-line 3)
-	(let ((buffer-read-only nil))
-	  (while (search-backward "completion" nil 'move)
-	    (replace-match "history reference"))))
-      (comint-restore-window-config conf))))
-
-(defun comint-regexp-arg (prompt)
-  ;; Return list of regexp and prefix arg using PROMPT.
-  (let* ((minibuffer-history-sexp-flag nil)
-	 ;; Don't clobber this.
-	 (last-command last-command)
-	 (regexp (read-from-minibuffer prompt nil nil nil
-				       'minibuffer-history-search-history)))
-    (list (if (string-equal regexp "")
-	      (setcar minibuffer-history-search-history
-		      (nth 1 minibuffer-history-search-history))
-	    regexp)
-	  (prefix-numeric-value current-prefix-arg))))
-
-(defun comint-search-arg (arg)
-  ;; First make sure there is a ring and that we are after the process mark
-  (cond ((not (comint-after-pmark-p))
-	 (error "Not at command line"))
-	((or (null comint-input-ring)
-	     (ring-empty-p comint-input-ring))
-	 (error "Empty input ring"))
-	((zerop arg)
-	 ;; arg of zero resets search from beginning, and uses arg of 1
-	 (setq comint-input-ring-index nil)
-	 1)
-	(t
-	 arg)))
-
-(defun comint-search-start (arg)
-  ;; Index to start a directional search, starting at comint-input-ring-index
-  (if comint-input-ring-index
-      ;; If a search is running, offset by 1 in direction of arg
-      (mod (+ comint-input-ring-index (if (> arg 0) 1 -1))
-	   (ring-length comint-input-ring))
-    ;; For a new search, start from beginning or end, as appropriate
-    (if (>= arg 0)
-	0				       ; First elt for forward search
-      (1- (ring-length comint-input-ring)))))  ; Last elt for backward search
-
-(defun comint-previous-input-string (arg)
-  "Return the string ARG places along the input ring.
-Moves relative to `comint-input-ring-index'."
-  (ring-ref comint-input-ring (if comint-input-ring-index
-				  (mod (+ arg comint-input-ring-index)
-				       (ring-length comint-input-ring))
-				arg)))
-
-(defun comint-previous-input (arg)
-  "Cycle backwards through input history."
-  (interactive "*p")
-  (comint-previous-matching-input "." arg))
-
-(defun comint-next-input (arg)
-  "Cycle forwards through input history."
-  (interactive "*p")
-  (comint-previous-input (- arg)))
-
-(defun comint-previous-matching-input-string (regexp arg)
-  "Return the string matching REGEXP ARG places along the input ring.
-Moves relative to `comint-input-ring-index'."
-  (let* ((pos (comint-previous-matching-input-string-position regexp arg)))
-    (if pos (ring-ref comint-input-ring pos))))
-
-(defun comint-previous-matching-input-string-position (regexp arg &optional start)
-  "Return the index matching REGEXP ARG places along the input ring.
-Moves relative to START, or `comint-input-ring-index'."
-  (if (or (not (ring-p comint-input-ring))
-	  (ring-empty-p comint-input-ring))
-      (error "No history"))
-  (let* ((len (ring-length comint-input-ring))
-	 (motion (if (> arg 0) 1 -1))
-	 (n (mod (- (or start (comint-search-start arg)) motion) len))
-	 (tried-each-ring-item nil)
-	 (prev nil))
-    ;; Do the whole search as many times as the argument says.
-    (while (and (/= arg 0) (not tried-each-ring-item))
-      ;; Step once.
-      (setq prev n
-	    n (mod (+ n motion) len))
-      ;; If we haven't reached a match, step some more.
-      (while (and (< n len) (not tried-each-ring-item)
-		  (not (string-match regexp (ring-ref comint-input-ring n))))
-	(setq n (mod (+ n motion) len)
-	      ;; If we have gone all the way around in this search.
-	      tried-each-ring-item (= n prev)))
-      (setq arg (if (> arg 0) (1- arg) (1+ arg))))
-    ;; Now that we know which ring element to use, if we found it, return that.
-    (if (string-match regexp (ring-ref comint-input-ring n))
-	n)))
-
-(defun comint-previous-matching-input (regexp arg)
-  "Search backwards through input history for match for REGEXP.
-\(Previous history elements are earlier commands.)
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
-  (interactive (comint-regexp-arg "Previous input matching (regexp): "))
-  (setq arg (comint-search-arg arg))
-  (let ((pos (comint-previous-matching-input-string-position regexp arg)))
-    ;; Has a match been found?
-    (if (null pos)
-	(error "Not found")
-      (setq comint-input-ring-index pos)
-      (message "History item: %d" (1+ pos))
-      (delete-region
-       ;; Can't use kill-region as it sets this-command
-       (process-mark (get-buffer-process (current-buffer))) (point))
-      (insert (ring-ref comint-input-ring pos)))))
-
-(defun comint-next-matching-input (regexp arg)
-  "Search forwards through input history for match for REGEXP.
-\(Later history elements are more recent commands.)
-With prefix argument N, search for Nth following match.
-If N is negative, find the previous or Nth previous match."
-  (interactive (comint-regexp-arg "Next input matching (regexp): "))
-  (comint-previous-matching-input regexp (- arg)))
-
-(defun comint-previous-matching-input-from-input (arg)
-  "Search backwards through input history for match for current input.
-\(Previous history elements are earlier commands.)
-With prefix argument N, search for Nth previous match.
-If N is negative, search forwards for the -Nth following match."
-  (interactive "p")
-  (if (not (memq last-command '(comint-previous-matching-input-from-input
-				comint-next-matching-input-from-input)))
-      ;; Starting a new search
-      (setq comint-matching-input-from-input-string
-	    (buffer-substring
-	     (process-mark (get-buffer-process (current-buffer)))
-	     (point))
-	    comint-input-ring-index nil))
-  (comint-previous-matching-input
-   (concat "^" (regexp-quote comint-matching-input-from-input-string))
-   arg))
-
-(defun comint-next-matching-input-from-input (arg)
-  "Search forwards through input history for match for current input.
-\(Following history elements are more recent commands.)
-With prefix argument N, search for Nth following match.
-If N is negative, search backwards for the -Nth previous match."
-  (interactive "p")
-  (comint-previous-matching-input-from-input (- arg)))
-
-
-(defun comint-replace-by-expanded-history (&optional silent)
-  "Expand input command history references before point.
-Expansion is dependent on the value of `comint-input-autoexpand'.
-
-This function depends on the buffer's idea of the input history, which may not
-match the command interpreter's idea, assuming it has one.
-
-Assumes history syntax is like typical Un*x shells'.  However, since emacs
-cannot know the interpreter's idea of input line numbers, assuming it has one,
-it cannot expand absolute input line number references.
-
-If the optional argument SILENT is non-nil, never complain
-even if history reference seems erroneous.
-
-See `comint-magic-space' and `comint-replace-by-expanded-history-before-point'.
-
-Returns t if successful."
-  (interactive)
-  (if (and comint-input-autoexpand
-	   (string-match "!\\|^\\^" (funcall comint-get-old-input))
-	   (save-excursion (beginning-of-line)
-			   (looking-at comint-prompt-regexp)))
-      ;; Looks like there might be history references in the command.
-      (let ((previous-modified-tick (buffer-modified-tick)))
-	(message "Expanding history references...")
-	(comint-replace-by-expanded-history-before-point silent)
-	(/= previous-modified-tick (buffer-modified-tick)))))
-
-
-(defun comint-replace-by-expanded-history-before-point (silent)
-  "Expand directory stack reference before point.
-See `comint-replace-by-expanded-history'.  Returns t if successful."
-  (save-excursion
-    (let ((toend (- (save-excursion (end-of-line nil) (point)) (point)))
-	  (start (progn (comint-bol nil) (point))))
-      (while (re-search-forward
-	      "[!^]" (save-excursion (end-of-line nil) (- (point) toend)) t)
-	;; This seems a bit complex.  We look for references such as !!, !-num,
-	;; !foo, !?foo, !{bar}, !?{bar}, ^oh, ^my^, ^god^it, ^never^ends^.
-	;; If that wasn't enough, the plings can be suffixed with argument
-	;; range specifiers.
-	;; Argument ranges are complex too, so we hive off the input line,
-	;; referenced with plings, with the range string to `comint-args'.
-	(setq comint-input-ring-index nil)
-	(goto-char (match-beginning 0))
-	(cond ((or (= (preceding-char) ?\\)
-		   (comint-within-quotes start (point)))
-	       ;; The history is quoted, or we're in quotes.
-	       (goto-char (match-end 0)))
-	      ((looking-at "![0-9]+\\($\\|[^-]\\)")
-	       ;; We cannot know the interpreter's idea of input line numbers.
-	       (goto-char (match-end 0))
-	       (message "Absolute reference cannot be expanded"))
-	      ((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?")
-	       ;; Just a number of args from `number' lines backward.
-	       (let ((number (1- (string-to-number
-				  (buffer-substring (match-beginning 1)
-						    (match-end 1))))))
-		 (if (<= number (ring-length comint-input-ring))
-		     (progn
-		       (replace-match
-			(comint-args (comint-previous-input-string number)
-				     (match-beginning 2) (match-end 2))
-			t t)
-		       (setq comint-input-ring-index number)
-		       (message "History item: %d" (1+ number)))
-		   (goto-char (match-end 0))
-		   (message "Relative reference exceeds input history size"))))
-	      ((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!"))
-	       ;; Just a number of args from the previous input line.
-	       (replace-match
-		(comint-args (comint-previous-input-string 0)
-			     (match-beginning 1) (match-end 1)) t t)
-	       (message "History item: previous"))
-	      ((looking-at
-		"!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?")
-	       ;; Most recent input starting with or containing (possibly
-	       ;; protected) string, maybe just a number of args.  Phew.
-	       (let* ((mb1 (match-beginning 1)) (me1 (match-end 1))
-		      (mb2 (match-beginning 2)) (me2 (match-end 2))
-		      (exp (buffer-substring (or mb2 mb1) (or me2 me1)))
-		      (pref (if (save-match-data (looking-at "!\\?")) "" "^"))
-		      (pos (save-match-data
-			     (comint-previous-matching-input-string-position
-			      (concat pref (regexp-quote exp)) 1))))
-		 (if (null pos)
-		     (progn
-		       (goto-char (match-end 0))
-		       (or silent
-			   (progn (message "Not found")
-				  (ding))))
-		   (setq comint-input-ring-index pos)
-		   (replace-match
-		    (comint-args (ring-ref comint-input-ring pos)
-				 (match-beginning 4) (match-end 4))
-		    t t)
-		   (message "History item: %d" (1+ pos)))))
-	      ((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?")
-	       ;; Quick substitution on the previous input line.
-	       (let ((old (buffer-substring (match-beginning 1) (match-end 1)))
-		     (new (buffer-substring (match-beginning 2) (match-end 2)))
-		     (pos nil))
-		 (replace-match (comint-previous-input-string 0) t t)
-		 (setq pos (point))
-		 (goto-char (match-beginning 0))
-		 (if (not (search-forward old pos t))
-		     (or silent
-			 (error "Not found"))
-		   (replace-match new t t)
-		   (message "History item: substituted"))))
-	      (t
-	       (goto-char (match-end 0))))))))
-
-
-(defun comint-magic-space (arg)
-  "Expand input history references before point and insert ARG spaces.
-A useful command to bind to SPC.  See `comint-replace-by-expanded-history'."
-  (interactive "p")
-  (comint-replace-by-expanded-history)
-  (self-insert-command arg))
-
-(defun comint-within-quotes (beg end)
-  "Return t if the number of quotes between BEG and END is odd.
-Quotes are single and double."
-  (let ((countsq (comint-how-many-region "\\(^\\|[^\\\\]\\)\'" beg end))
-	(countdq (comint-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end)))
-    (or (= (mod countsq 2) 1) (= (mod countdq 2) 1))))
-
-(defun comint-how-many-region (regexp beg end)
-  "Return number of matches for REGEXP from BEG to END."
-  (let ((count 0))
-    (save-excursion
-      (save-match-data
-	(goto-char beg)
-	(while (re-search-forward regexp end t)
-	  (setq count (1+ count)))))
-    count))
-
-(defun comint-args (string begin end)
-  ;; From STRING, return the args depending on the range specified in the text
-  ;; from BEGIN to END.  If BEGIN is nil, assume all args.  Ignore leading `:'.
-  ;; Range can be x-y, x-, -y, where x/y can be [0-9], *, ^, $.
-  (save-match-data
-    (if (null begin)
-	(comint-arguments string 0 nil)
-      (let* ((range (buffer-substring
-		     (if (eq (char-after begin) ?:) (1+ begin) begin) end))
-	     (nth (cond ((string-match "^[*^]" range) 1)
-			((string-match "^-" range) 0)
-			((string-equal range "$") nil)
-			(t (string-to-number range))))
-	     (mth (cond ((string-match "[-*$]$" range) nil)
-			((string-match "-" range)
-			 (string-to-number (substring range (match-end 0))))
-			(t nth))))
-	(comint-arguments string nth mth)))))
-
-;; Return a list of arguments from ARG.  Break it up at the
-;; delimiters in comint-delimiter-argument-list.  Returned list is backwards.
-;(defun comint-delim-arg (arg)
-;  (if (null comint-delimiter-argument-list)
-;      (list arg)
-;    (let ((args nil)
-;	  (pos 0)
-;	  (len (length arg)))
-;      (while (< pos len)
-;	(let ((char (aref arg pos))
-;	      (start pos))
-;	  (if (memq char comint-delimiter-argument-list)
-;	      (while (and (< pos len) (eq (aref arg pos) char))
-;		(setq pos (1+ pos)))
-;	    (while (and (< pos len)
-;			(not (memq (aref arg pos)
-;				   comint-delimiter-argument-list)))
-;	      (setq pos (1+ pos))))
-;	  (setq args (cons (substring arg start pos) args))))
-;      args)))
-
-(defun comint-arguments (string nth mth)
-  "Return from STRING the NTH to MTH arguments.
-NTH and/or MTH can be nil, which means the last argument.
-Returned arguments are separated by single spaces.
-We assume whitespace separates arguments, except within quotes.
-Also, a run of one or more of a single character
-in `comint-delimiter-argument-list' is a separate argument.
-Argument 0 is the command name."
-  (let ((arg-regexp "\\(?:[^ \n\t\"'`]+\\|\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)+")
-	(args nil)
-	(pos 0)
-	(count 0))
-    (when comint-delimiter-argument-list
-      (setq arg-regexp
-	    (format "[%s]\\|%s"
-		    (regexp-quote (concat comint-delimiter-argument-list))
-		    arg-regexp)))
-    (while (and (string-match arg-regexp string pos)
-		(or (null mth) (<= count mth)))
-      (when (or (null nth) (<= nth count))
-	(push (substring string (match-beginning 0) (match-end 0)) args))
-      (setq pos (match-end 0))
-      (incf count))
-    (if (null nth)
-	(or (car args) "")
-      (mapconcat 'identity (nreverse args) " "))))
-
-;;
-;; Input processing stuff
-;;
-(defun comint-add-to-input-history (cmd)
-  "Maybe add CMD to the input history.  
-CMD is only added to the input history if `comint-input-filter'
-returns non-nil when called on CMD. If `comint-input-ignoredups' is
-non-nil then duplicates are ignored."
-  (if (and (funcall comint-input-filter cmd)
-	   (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)
-				  cmd))))
-      (ring-insert comint-input-ring cmd)))
-
-(defun comint-send-input ()
-  "Send input to process.
-After the process output mark, sends all text from the process mark to
-point as input to the process.  Before the process output mark, calls value
-of variable `comint-get-old-input' to retrieve old input, copies it to the
-process mark, and sends it.  If variable `comint-process-echoes' is nil,
-a terminal newline is also inserted into the buffer and sent to the process
-\(if it is non-nil, all text from the process mark to point is deleted,
-since it is assumed the remote process will re-echo it).
-
-Any history reference may be expanded depending on the value of the variable
-`comint-input-autoexpand'.  The list of function names contained in the value
-of `comint-input-filter-functions' is called on the input before sending it.
-The input is entered into the input history ring, if the value of variable
-`comint-input-filter' returns non-nil when called on the input.
-
-If variable `comint-eol-on-send' is non-nil, then point is moved to the
-end of line before sending the input.
-
-If variable `comint-append-old-input' is non-nil, then the results of
-calling `comint-get-old-input' are appended to the end of the buffer.
-The new input will combine with any partially-typed text already present
-after the process output mark.  Point is moved just before the newly
-appended input, and a message is displayed prompting the user to type
-\\[comint-send-input] again.
-
-The values of `comint-get-old-input', `comint-input-filter-functions' and
-`comint-input-filter' are chosen according to the command interpreter running
-in the buffer.  E.g.,
-
-If the interpreter is the csh,
-    comint-get-old-input is the default: take the current line, discard any
-        initial string matching regexp comint-prompt-regexp.
-    comint-input-filter-functions monitors input for \"cd\", \"pushd\", and
-        \"popd\" commands. When it sees one, it cd's the buffer.
-    comint-input-filter is the default: returns t if the input isn't all white
-	space.
-
-If the comint is Lucid Common Lisp,
-    comint-get-old-input snarfs the sexp ending at point.
-    comint-input-filter-functions does nothing.
-    comint-input-filter returns nil if the input matches input-filter-regexp,
-        which matches (1) all whitespace (2) :a, :c, etc.
-
-Similarly for Soar, Scheme, etc."
-  (interactive)
-  ;; Note that the input string does not include its terminal newline.
-  (let ((proc (get-buffer-process (current-buffer))))
-    (if (not proc) (error "Current buffer has no process")
-      (let* ((pmark (process-mark proc))
-	     (pmark-val (marker-position pmark))
-	     ;; XEmacs - change by John Rose: confirm before sending input if
-	     ;; not after process mark.
-	     (append-here nil)
-	     (intxt (if (>= (point) pmark-val)
-			(progn (if comint-eol-on-send (end-of-line))
-			       (buffer-substring pmark (point)))
-		      (let ((copy (funcall comint-get-old-input)))
-			(push-mark)
-			(if (not comint-append-old-input)
-			    (goto-char pmark-val)
-			  (setq append-here (point-max))
-			  (goto-char append-here))
-			(insert copy)
-			copy)))
-	     (input (if (not (eq comint-input-autoexpand 'input))
-			;; Just whatever's already there
-			intxt
-		      ;; Expand and leave it visible in buffer
-		      (comint-replace-by-expanded-history t)
-		      (buffer-substring pmark (point))))
-	     (history (if (not (eq comint-input-autoexpand 'history))
-			  (if (eq comint-input-autoexpand nil)
-			      ;; XEmacs - nil means leave it alone!
-			      input
-			    (comint-arguments input 0 nil))
-			;; This is messy 'cos ultimately the original
-			;; functions used do insertion, rather than return
-			;; strings.  We have to expand, then insert back.
-			(comint-replace-by-expanded-history t)
-			(let ((copy (buffer-substring pmark (point))))
-			  (delete-region pmark (point))
-			  (insert input)
-			  (comint-arguments copy 0 nil)))))
-	(if append-here
-	    (progn
-	      (goto-char append-here)
-	      (message
-	       (substitute-command-keys
-		"(\\[comint-send-input] to confirm)")))
-	  (if comint-process-echoes
-	      (delete-region pmark (point))
-	    (insert-before-markers ?\n))
-	  (comint-add-to-input-history history)
-	  ;; Run the input filters on the history instead
-	  ;; of the input, so that the input sentinel is called on the
-	  ;; history-expanded text and sees "cd foo" instead of "cd !$".
-	  (run-hook-with-args 'comint-input-filter-functions
-			      (concat history "\n"))
-	  (setq comint-input-ring-index nil)
-	  ;; Update the markers before we send the input
-	  ;; in case we get output amidst sending the input.
-	  (set-marker comint-last-input-start pmark)
-	  (set-marker comint-last-input-end (point))
-	  (set-marker (process-mark proc) (point))
-	  (comint-input-done)
-	  (funcall comint-input-sender proc input)
-	  (comint-input-setup)
-	  ;; FIX -- Is this necessary?
-	  ;; A kludge to prevent the delay between insert and
-	  ;; process output affecting the display.  A case for a
-	  ;; comint-send-input-hook?
-	  (run-hook-with-args 'comint-output-filter-functions
-			      (concat input "\n"))
-	  (comint-output-filter proc "")
-	  )))))
-(defun comint-input-done ()
-  "Finalized comint-input-extent so nothing more is added."
-;; Disable this for now.  I'm not sure that font-lock doesn't do better
-;;  (if (not comint-input-extent)
-;;      (comint-input-setup))
-;;  (set-extent-property comint-input-extent 'start-closed nil)
-;;  (set-extent-property comint-input-extent 'end-closed nil)
-;;  (set-extent-property comint-input-extent 'detachable t)
-  )
-
-(defun comint-input-setup ()
-  "Insure the comint-input-extent is ready."
-;; Disable this for now.  I'm not sure that font-lock doesn't do better
-;  (require 'comint-xemacs)
-;  (setq comint-input-extent (make-extent (point) (point-max)))
-;  (set-extent-property comint-input-extent 'detachable nil)
-;  (set-extent-property comint-input-extent 'start-closed t)
-;  (set-extent-property comint-input-extent 'end-closed t)
-;  (set-extent-face comint-input-extent 'comint-input-face)
-  )
-
-(defvar comint-input-extent nil
-  "Current extent used for displaying text in buffer.");
-(make-variable-buffer-local 'comint-input-extent)
-
-;; The purpose of using this filter for comint processes
-;; is to keep comint-last-input-end from moving forward
-;; when output is inserted.
-(defun comint-output-filter (process string)
-  ;; First check for killed buffer
-  (let ((oprocbuf (process-buffer process)))
-    (if (and oprocbuf (buffer-name oprocbuf))
-	(let ((obuf (current-buffer))
-	      (opoint nil) (obeg nil) (oend nil))
-	  (set-buffer oprocbuf)
-	  (setq opoint (point))
-	  (setq obeg (point-min))
-	  (setq oend (point-max))
-	  ;; Keep stuff being output (before input) from using input-extent
-;; Disable this for now.  I'm not sure that font-lock doesn't do better
-;;	  (if comint-input-extent
-;;	      (set-extent-property comint-input-extent 'start-closed nil))
-	  (let ((buffer-read-only nil)
-		(nchars (length string))
-		(ostart nil))
-	    (widen)
-	    (goto-char (process-mark process))
-	    (setq ostart (point))
-	    (if (<= (point) opoint)
-		(setq opoint (+ opoint nchars)))
-	    ;; Insert after old_begv, but before old_zv.
-	    (if (< (point) obeg)
-		(setq obeg (+ obeg nchars)))
-	    (if (<= (point) oend)
-		(setq oend (+ oend nchars)))
-	    (insert-before-markers string)
-	    ;; Don't insert initial prompt outside the top of the window.
-	    (if (= (window-start (selected-window)) (point))
-		(set-window-start (selected-window) (- (point) (length string))))
-	    (if (and comint-last-input-end
-		     (marker-buffer comint-last-input-end)
-		     (= (point) comint-last-input-end))
-		(set-marker comint-last-input-end (- comint-last-input-end nchars)))
-	    (set-marker comint-last-output-start ostart)
-	    (set-marker (process-mark process) (point))
-	    (force-mode-line-update))
-	  ;; Now insure everything inserted after (user input) is in extent
-;; Disable this for now.  I'm not sure that font-lock doesn't do better
-;;	  (if (not comint-input-extent)
-;;	      (comint-input-setup))
-;;	  (set-extent-endpoints comint-input-extent (point) (point-max))
-;;	  (set-extent-property comint-input-extent 'start-closed t)
-
-	  (narrow-to-region obeg oend)
-	  (goto-char opoint)
-	  (run-hook-with-args 'comint-output-filter-functions string)
-	  (set-buffer obuf)))))
-
-;; Use a variable for this so that new commands can be added easily.
-(defvar comint-scroll-to-bottom-on-input-commands
-  '(self-insert-command
-    mouse-yank
-    mouse-yank-at-click
-    x-insert-selection
-    comint-previous-input
-    comint-next-input
-    comint-previous-matching-input
-    comint-next-matching-input
-    comint-previous-matching-input-from-input
-    comint-next-matching-input-from-input
-    )
-  "List of functions which will cause the point to move to the end of comint buffers.")
-
-(defun comint-preinput-scroll-to-bottom ()
-  "Go to the end of buffer in all windows showing it.
-Movement occurs if point in the selected window is not after the process mark,
-and `this-command' is an insertion command.  Insertion commands recognised
-are those in `comint-scroll-to-bottom-on-input-commands'.
-Depends on the value of `comint-scroll-to-bottom-on-input'.
-
-This function should be a pre-command hook."
-  (if (and comint-scroll-to-bottom-on-input
-	   (memq this-command comint-scroll-to-bottom-on-input-commands))
-      (let* ((selected (selected-window))
-	     (current (current-buffer))
-	     (process (get-buffer-process current))
-	     (scroll comint-scroll-to-bottom-on-input))
-	(if (and process (< (point) (process-mark process))
-		 scroll (not (window-minibuffer-p selected)))
-	    (if (eq scroll 'this)
-		(goto-char (point-max))
-	      (walk-windows
-	       (function (lambda (window)
-			   (if (and (eq (window-buffer window) current)
-				    (or (eq scroll t) (eq scroll 'all)))
-			       (set-window-point window (point-max))
-			     )))
-	       'not-minibuf t))))))
-
-(defun comint-postoutput-scroll-to-bottom (string)
-  "Go to the end of buffer in all windows showing it.
-Does not scroll if the current line is the last line in the buffer.
-Depends on the value of `comint-scroll-to-bottom-on-output' and
-`comint-scroll-show-maximum-output'.
-
-This function should be in the list `comint-output-filter-functions'."
-  (let* ((selected (selected-window))
-	 (current (current-buffer))
-	 (process (get-buffer-process current))
-	 (scroll comint-scroll-to-bottom-on-output))
-    ;; Don't select windows as they're walked.
-    (if process
-	(walk-windows
-	  (function (lambda (window)
-            (if (eq (window-buffer window) current)
-	       (progn
-		 (if (and (< (window-point window)
-			     (process-mark process))
-                          (or (eq scroll t) (eq scroll 'all)
-                              ;; Maybe user wants point to jump to the end.
-                              (and (eq scroll 'this)
-                                   (eq selected window))
-                              (and (eq scroll 'others)
-                                   (not (eq selected window)))
-                              ;; If point was at the end, keep it at the end.
-                              (>= (window-point window)
-                                  (- (process-mark process) (length string)))))
-		     (set-window-point window (process-mark process)))
-		 ;; Optionally scroll so that the text
-		 ;; ends at the bottom of the window.
-		 (if (and comint-scroll-show-maximum-output
-			  (>= (window-point window)
-			      (process-mark process))
-                          ;; XEmacs - lemacs addition
-                          (not (pos-visible-in-window-p (point-max) window)))
-		     (save-excursion
-		       (set-window-point window (point-max))
-		       (recenter
-			;; XEmacs - lemacs addition
-                         (cond ((integerp comint-scroll-show-maximum-output)
-                                comint-scroll-show-maximum-output)
-                               ((floatp comint-scroll-show-maximum-output)
-                                (floor (* (window-height window)
-                                          comint-scroll-show-maximum-output)
-                                       1))
-                               (t
-                                -1))
-			 window)
-		       (sit-for 0)))
-		 ))))
-	 nil t))))
-
-(defun comint-truncate-buffer (&optional string)
-  "Truncate the buffer to `comint-buffer-maximum-size'.
-This function could be on `comint-output-filter-functions' or bound to a key."
-  (interactive)
-  (save-excursion
-    (goto-char (process-mark (get-buffer-process (current-buffer))))
-    (forward-line (- comint-buffer-maximum-size))
-    (beginning-of-line)
-    (delete-region (point-min) (point))))
-
-(defun comint-strip-ctrl-m (&optional string)
-  "Strip trailing `^M' characters from the current output group.
-This function could be on `comint-output-filter-functions' or bound to a key."
-  (interactive)
-  (let ((pmark (process-mark (get-buffer-process (current-buffer))))
-	(pos (if (interactive-p) 
-		  comint-last-input-end 
-		comint-last-output-start)))
-    (if (marker-position pos)
-	(save-excursion
-	  (goto-char pos)
-	  (while (re-search-forward "\r+$" pmark t)
-	    (replace-match "" t t))))))
-(defalias 'shell-strip-ctrl-m 'comint-strip-ctrl-m)
-
-(defun comint-show-maximum-output ()
-  "Put the end of the buffer at the bottom of the window."
-  (interactive)
-  (goto-char (point-max))
-  (recenter -1))
-
-(defun comint-get-old-input-default ()
-  "Default for `comint-get-old-input'.
-Take the current line, and discard any initial text matching
-`comint-prompt-regexp'."
-  (save-excursion
-    (beginning-of-line)
-    (comint-skip-prompt)
-    (let ((beg (point)))
-      (end-of-line)
-      (buffer-substring beg (point)))))
-
-(defun comint-copy-old-input ()
-  "Insert after prompt old input at point as new input to be edited.
-Calls `comint-get-old-input' to get old input."
-  (interactive)
-  (let ((input (funcall comint-get-old-input))
- 	(process (get-buffer-process (current-buffer))))
-    (if (not process)
-	(error "Current buffer has no process")
-      (goto-char (process-mark process))
-      (insert input))))
-
-(defun comint-skip-prompt ()
-  "Skip past the text matching regexp `comint-prompt-regexp'.
-If this takes us past the end of the current line, don't skip at all."
-  (let ((eol (save-excursion (end-of-line) (point)))
-	;; XEmacs - Arbitrary limit:  prompt can be up to 10 lines long.
-	(search-limit (save-excursion (forward-line -10) (point))))
-    (if (and (save-excursion
-	       (goto-char eol)
-	       (re-search-backward comint-prompt-regexp search-limit t))
-	     (<= (match-beginning 0) (point))
-	     (> (match-end 0) (point))
-	     (<= (match-end 0) eol))
-	(goto-char (match-end 0)))))
-
-(defun comint-after-pmark-p ()
-  "Return t if point is after the process output marker."
-  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
-    (<= (marker-position pmark) (point))))
-
-(defun comint-simple-send (proc string)
-  "Default function for sending to PROC input STRING.
-This just sends STRING plus a newline. To override this,
-set the hook `comint-input-sender'."
-  (comint-send-string proc string)
-  (comint-send-string proc "\n"))
-
-(defun comint-bol (arg)
-  "Goes to the beginning of line, then skips past the prompt, if any.
-If prefix argument is given (\\[universal-argument]) the prompt is not skipped.
-
-The prompt skip is done by skipping text matching the regular expression
-`comint-prompt-regexp', a buffer local variable."
-  (interactive "_P")
-  (let ((skip (and (null arg)
-		       ;; If the buffer's process has gone bye-bye
-		       ;; revert to being just beginning-of-line.
-		       (or (not (get-buffer-process (current-buffer)))
-			   (comint-after-pmark-p)))))
-    (beginning-of-line)
-    (if skip (comint-skip-prompt))))
-
-;; XEmacs - more like an xterm interaction model...
-(defun comint-universal-argument ()
-  "Erase the current line of input, or begin a numeric argument.
-
-In buffers with interactive subprocesses, this modified version of
-`universal-argument' erases the current line of user input just as ^U erases a
-line of text at the UNIX command prompt.
-
-Otherwise, begin a numeric argument for the following command.
-Digits or minus sign following \\[universal-argument] make up the numeric argument.
-\\[universal-argument] following the digits or minus sign ends the argument.
-\\[universal-argument] without digits or minus sign provides 4 as argument.
-Repeating \\[universal-argument] without digits or minus sign
- multiplies the argument by 4 each time."
-  (interactive)
-  (let ((proc (get-buffer-process (current-buffer))))
-    (if (and proc (> (point) (process-mark proc)))
-	(progn (comint-bol nil)
-	       (kill-region (point) (save-excursion (end-of-line) (point))))
-      (let (key)
-	(setq key (read-key-sequence nil t))
-	(while (equal (key-binding key) 'universal-argument)
-	  (setq key (read-key-sequence nil t)))))))
-
-;; These three functions are for entering text you don't want echoed or
-;; saved -- typically passwords to ftp, telnet, or somesuch.
-;; Just enter m-x send-invisible and type in your line, or add
-;; `comint-watch-for-password-prompt' to `comint-output-filter-functions'.
-
-(defun comint-read-noecho (prompt &optional stars)
-  "Read a single line of text from user without echoing, and return it.
-Prompt with argument PROMPT, a string.  Optional argument STARS causes
-input to be echoed with '*' characters on the prompt line.  Input ends with
-RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.  C-g aborts (if
-`inhibit-quit' is set because e.g. this function was called from a process
-filter and C-g is pressed, this function returns nil rather than a string).
-
-Note that the keystrokes comprising the text can still be recovered
-\(temporarily) with \\[view-lossage].  This may be a security bug for some
-applications."
-  (if (fboundp 'read-passwd)
-      (read-passwd prompt)
-    (let ((ans "")
-	  (c 0)
-	  (echo-keystrokes 0)
-	  (cursor-in-echo-area t)
-	  (message-log-max nil)		;turn of logging in GNU Emacs
-	  (inhibit-input-event-recording t) ; and XEmacs
-	  (done nil))
-      (while (not done)
-	(if stars
-	    (message "%s%s" prompt (make-string (length ans) ?*))
-	  (message "%s" prompt))
-	;; Use this instead of `read-char' to avoid "Non-character input-event".
-	(setq c (read-char-exclusive))
-	(cond ((= c ?\C-g)
-	       ;; This function may get called from a process filter, where
-	       ;; inhibit-quit is set.  In later versions of emacs read-char
-	       ;; may clear quit-flag itself and return C-g.  That would make
-	       ;; it impossible to quit this loop in a simple way, so
-	       ;; re-enable it here (for backward-compatibility the check for
-	       ;; quit-flag below would still be necessary, so this seems
-	       ;; like the simplest way to do things).
-	       (setq quit-flag t
-		     done t))
-	      ((or (= c ?\r) (= c ?\n) (= c ?\e))
-	       (setq done t))
-	      ((= c ?\C-u)
-	       (setq ans ""))
-	      ((and (/= c ?\b) (/= c ?\177))
-	       (setq ans (concat ans (char-to-string c))))
-	      ((> (length ans) 0)
-	       (setq ans (substring ans 0 -1)))))
-      (if quit-flag
-	  ;; Emulate a true quit, except that we have to return a value.
-	  (prog1
-	      (setq quit-flag nil)
-	    (message "Quit")
-	    (beep t))
-	(message "")
-	ans))))
-
-(defun send-invisible (str)
-  "Read a string without echoing.
-Then send it to the process running in the current buffer.  A new-line
-is additionally sent.  String is not saved on comint input history list.
-Security bug: your string can still be temporarily recovered with
-\\[view-lossage]."
-  (interactive "P") ; Defeat snooping via C-x ESC ESC
-  (let ((proc (get-buffer-process (current-buffer))))
-    (if (not proc)
-	(error "Current buffer has no process")
-      (comint-send-string
-       proc (if (stringp str) str (comint-read-noecho "Non-echoed text: " t)))
-      (comint-send-string proc "\n"))))
-
-(defun comint-watch-for-password-prompt (string)
-  "Prompt in the minibuffer for password and send without echoing.
-This function uses `send-invisible' to read and send a password to the buffer's
-process if STRING contains a password prompt defined by
-`comint-password-prompt-regexp'.
-
-This function could be in the list `comint-output-filter-functions'."
-  (if (string-match comint-password-prompt-regexp string)
-      (send-invisible nil)))
-
-;; Low-level process communication
-
-(defalias 'comint-send-string 'process-send-string)
-(defalias 'comint-send-region 'process-send-region)
-
-;; Random input hackage
-
-(defun comint-kill-output ()
-  "Kill all output from interpreter since last input.
-Does not delete the prompt."
-  (interactive)
-  (let ((proc (get-buffer-process (current-buffer)))
-	(replacement nil))
-    (save-excursion
-      (let ((pmark (progn (goto-char (process-mark proc))
-			  (beginning-of-line nil)
-			  (point-marker))))
-	;; kill in case we want it back...
-	(kill-region comint-last-input-end pmark)
-	(goto-char (process-mark proc))
-	(setq replacement (concat "*** output flushed ***\n"
-				  (buffer-substring pmark (point))))
-	(delete-region pmark (point))))
-    ;; Output message and put back prompt
-    (comint-output-filter proc replacement)))
-
-;; don't move cursor unless necessary...
-(defun comint-show-output ()
-  "Display start of this batch of interpreter output at top of window.
-Also put cursor there if the current position is not visible.
-If the cursor is moved, then a mark is set at its old location."
-  (interactive)
-  (let ((pos (point)))
-    (goto-char (or (marker-position comint-last-input-end) (point-max)))
-    (beginning-of-line 0)
-    (set-window-start (selected-window) (point))
-    (if (pos-visible-in-window-p pos)
-	(goto-char pos)
-      (save-excursion
-	(goto-char pos)
-	(push-mark))
-      (comint-skip-prompt))))
-
-(defun comint-interrupt-subjob ()
-  "Interrupt the current subjob."
-  (interactive)
-  (interrupt-process nil comint-ptyp))
-
-(defun comint-kill-subjob ()
-  "Send kill signal to the current subjob."
-  (interactive)
-  (kill-process nil comint-ptyp))
-
-(defun comint-quit-subjob ()
-  "Send quit signal to the current subjob."
-  (interactive)
-  (quit-process nil comint-ptyp))
-
-(defun comint-stop-subjob ()
-  "Stop the current subjob.
-WARNING: if there is no current subjob, you can end up suspending
-the top-level process running in the buffer. If you accidentally do
-this, use \\[comint-continue-subjob] to resume the process. (This
-is not a problem with most shells, since they ignore this signal.)"
-  (interactive)
-  (stop-process nil comint-ptyp))
-
-(defun comint-continue-subjob ()
-  "Send CONT signal to process buffer's process group.
-Useful if you accidentally suspend the top-level process."
-  (interactive)
-  (continue-process nil comint-ptyp))
-
-(defun comint-kill-input ()
-  "Kill all text from last stuff output by interpreter to point."
-  (interactive)
-  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
-    (if (> (point) (marker-position pmark))
-	(kill-region pmark (point)))))
-
-(defun comint-delchar-or-maybe-eof (arg)
-  "Delete ARG characters forward, or (if at eob) send an EOF to subprocess."
-  (interactive "p")
-  (if (eobp)
-      (process-send-eof)
-    (delete-char arg)))
-
-(defun comint-send-eof ()
-  "Send an EOF to the current buffer's process."
-  (interactive)
-  (process-send-eof))
-
-
-(defun comint-backward-matching-input (regexp arg)
-  "Search backward through buffer for match for REGEXP.
-Matches are searched for on lines that match `comint-prompt-regexp'.
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
-  (interactive (comint-regexp-arg "Backward input matching (regexp): "))
-  (let* ((re (concat comint-prompt-regexp ".*" regexp))
-	 (pos (save-excursion (end-of-line (if (> arg 0) 0 1))
-			      (if (re-search-backward re nil t arg)
-				  (point)))))
-    (if (null pos)
-	(progn (message "Not found")
-	       (ding))
-      (goto-char pos)
-      (comint-bol nil))))
-
-(defun comint-forward-matching-input (regexp arg)
-  "Search forward through buffer for match for REGEXP.
-Matches are searched for on lines that match `comint-prompt-regexp'.
-With prefix argument N, search for Nth following match.
-If N is negative, find the previous or Nth previous match."
-  (interactive (comint-regexp-arg "Forward input matching (regexp): "))
-  (comint-backward-matching-input regexp (- arg)))
-
-
-(defun comint-next-prompt (n)
-  "Move to end of Nth next prompt in the buffer.
-See `comint-prompt-regexp'."
-  (interactive "_p")			; XEmacs - zmacs-regions
-  (let ((paragraph-start comint-prompt-regexp))
-    (end-of-line (if (> n 0) 1 0))
-    (forward-paragraph n)
-    (comint-skip-prompt)))
-
-(defun comint-previous-prompt (n)
-  "Move to end of Nth previous prompt in the buffer.
-See `comint-prompt-regexp'."
-  (interactive "_p")			; XEmacs
-  (comint-next-prompt (- n)))
-
-;; Support for source-file processing commands.
-;;============================================================================
-;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
-;; commands that process files of source text (e.g. loading or compiling
-;; files). So the corresponding process-in-a-buffer modes have commands
-;; for doing this (e.g., lisp-load-file). The functions below are useful
-;; for defining these commands.
-;;
-;; Alas, these guys don't do exactly the right thing for Lisp, Scheme
-;; and Soar, in that they don't know anything about file extensions.
-;; So the compile/load interface gets the wrong default occasionally.
-;; The load-file/compile-file default mechanism could be smarter -- it
-;; doesn't know about the relationship between filename extensions and
-;; whether the file is source or executable. If you compile foo.lisp
-;; with compile-file, then the next load-file should use foo.bin for
-;; the default, not foo.lisp. This is tricky to do right, particularly
-;; because the extension for executable files varies so much (.o, .bin,
-;; .lbin, .mo, .vo, .ao, ...).
-
-
-;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing
-;; commands.
-;;
-;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you
-;; want to save the buffer before issuing any process requests to the command
-;; interpreter.
-;;
-;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt
-;; for the file to process.
-
-;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes)
-;;============================================================================
-;; This function computes the defaults for the load-file and compile-file
-;; commands for tea, soar, cmulisp, and cmuscheme modes.
-;;
-;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last
-;; source-file processing command. NIL if there hasn't been one yet.
-;; - SOURCE-MODES is a list used to determine what buffers contain source
-;; files: if the major mode of the buffer is in SOURCE-MODES, it's source.
-;; Typically, (lisp-mode) or (scheme-mode).
-;;
-;; If the command is given while the cursor is inside a string, *and*
-;; the string is an existing filename, *and* the filename is not a directory,
-;; then the string is taken as default. This allows you to just position
-;; your cursor over a string that's a filename and have it taken as default.
-;;
-;; If the command is given in a file buffer whose major mode is in
-;; SOURCE-MODES, then the the filename is the default file, and the
-;; file's directory is the default directory.
-;;
-;; If the buffer isn't a source file buffer (e.g., it's the process buffer),
-;; then the default directory & file are what was used in the last source-file
-;; processing command (i.e., PREVIOUS-DIR/FILE).  If this is the first time
-;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory
-;; is the cwd, with no default file. (\"no default file\" = nil)
-;;
-;; SOURCE-REGEXP is typically going to be something like (tea-mode)
-;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode)
-;; for Soar programs, etc.
-;;
-;; The function returns a pair: (default-directory . default-file).
-
-(defun comint-source-default (previous-dir/file source-modes)
-  (cond ((and buffer-file-name (memq major-mode source-modes))
-	 (cons (file-name-directory    buffer-file-name)
-	       (file-name-nondirectory buffer-file-name)))
-	(previous-dir/file)
-	(t
-	 (cons default-directory nil))))
-
-
-;; (COMINT-CHECK-SOURCE fname)
-;;============================================================================
-;; Prior to loading or compiling (or otherwise processing) a file (in the CMU
-;; process-in-a-buffer modes), this function can be called on the filename.
-;; If the file is loaded into a buffer, and the buffer is modified, the user
-;; is queried to see if he wants to save the buffer before proceeding with
-;; the load or compile.
-
-(defun comint-check-source (fname)
-  (let ((buff (get-file-buffer fname)))
-    (if (and buff
-	     (buffer-modified-p buff)
-	     (y-or-n-p (format "Save buffer %s first? " (buffer-name buff))))
-	;; save BUFF.
-	(let ((old-buffer (current-buffer)))
-	  (set-buffer buff)
-	  (save-buffer)
-	  (set-buffer old-buffer)))))
-
-
-;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
-;;============================================================================
-;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter
-;; commands that process source files (like loading or compiling a file).
-;; It prompts for the filename, provides a default, if there is one,
-;; and returns the result filename.
-;;
-;; See COMINT-SOURCE-DEFAULT for more on determining defaults.
-;;
-;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
-;; from the last source processing command.  SOURCE-MODES is a list of major
-;; modes used to determine what file buffers contain source files.  (These
-;; two arguments are used for determining defaults). If MUSTMATCH-P is true,
-;; then the filename reader will only accept a file that exists.
-;;
-;; A typical use:
-;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file
-;;                                 '(lisp-mode) t))
-
-;; This is pretty stupid about strings. It decides we're in a string
-;; if there's a quote on both sides of point on the current line.
-(defun comint-extract-string ()
-  "Return string around POINT that starts the current line, or nil."
-  (save-excursion
-    (let* ((point (point))
-	   (bol (progn (beginning-of-line) (point)))
-	   (eol (progn (end-of-line) (point)))
-	   (start (progn (goto-char point)
-			 (and (search-backward "\"" bol t)
-			      (1+ (point)))))
-	   (end (progn (goto-char point)
-		       (and (search-forward "\"" eol t)
-			    (1- (point))))))
-      (and start end
-	   (buffer-substring start end)))))
-
-(defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p)
-  (let* ((def (comint-source-default prev-dir/file source-modes))
-         (stringfile (comint-extract-string))
-	 (sfile-p (and stringfile
-		       (condition-case ()
-			   (file-exists-p stringfile)
-			 (error nil))
-		       (not (file-directory-p stringfile))))
-	 (defdir  (if sfile-p (file-name-directory stringfile)
-                      (car def)))
-	 (deffile (if sfile-p (file-name-nondirectory stringfile)
-                      (cdr def)))
-	 (ans (read-file-name (if deffile (format "%s(default %s) "
-						  prompt    deffile)
-				  prompt)
-			      defdir
-			      (concat defdir deffile)
-			      mustmatch-p)))
-    (list (expand-file-name (substitute-in-file-name ans)))))
-
-;; I am somewhat divided on this string-default feature. It seems
-;; to violate the principle-of-least-astonishment, in that it makes
-;; the default harder to predict, so you actually have to look and see
-;; what the default really is before choosing it. This can trip you up.
-;; On the other hand, it can be useful, I guess. I would appreciate feedback
-;; on this.
-;;     -Olin
-
-
-;; Simple process query facility.
-;; ===========================================================================
-;; This function is for commands that want to send a query to the process
-;; and show the response to the user. For example, a command to get the
-;; arglist for a Common Lisp function might send a "(arglist 'foo)" query
-;; to an inferior Common Lisp process.
-;;
-;; This simple facility just sends strings to the inferior process and pops
-;; up a window for the process buffer so you can see what the process
-;; responds with.  We don't do anything fancy like try to intercept what the
-;; process responds with and put it in a pop-up window or on the message
-;; line. We just display the buffer. Low tech. Simple. Works good.
-
-;; Send to the inferior process PROC the string STR. Pop-up but do not select
-;; a window for the inferior process so that its response can be seen.
-(defun comint-proc-query (proc str)
-  (let* ((proc-buf (process-buffer proc))
-	 (proc-mark (process-mark proc)))
-    (display-buffer proc-buf)
-    (set-buffer proc-buf) ; but it's not the selected *window*
-    (let ((proc-win (get-buffer-window proc-buf))
-	  (proc-pt (marker-position proc-mark)))
-      (comint-send-string proc str) ; send the query
-      (accept-process-output proc)  ; wait for some output
-      ;; Try to position the proc window so you can see the answer.
-      ;; This is bogus code. If you delete the (sit-for 0), it breaks.
-      ;; I don't know why. Wizards invited to improve it.
-      (if (not (pos-visible-in-window-p proc-pt proc-win))
-	  (let ((opoint (window-point proc-win)))
-	    (set-window-point proc-win proc-mark)
-	    (sit-for 0)
-	    (if (not (pos-visible-in-window-p opoint proc-win))
-		(push-mark opoint)
-	      (set-window-point proc-win opoint)))))))
-
-
-;; Filename/command/history completion in a buffer
-;; ===========================================================================
-;; Useful completion functions, courtesy of the Ergo group.
-
-;; Six commands:
-;; comint-dynamic-complete		Complete or expand command, filename,
-;;                                     history at point.
-;; comint-dynamic-complete-filename	Complete filename at point.
-;; comint-dynamic-list-filename-completions List completions in help buffer.
-;; comint-replace-by-expanded-filename	Expand and complete filename at point;
-;;					replace with expanded/completed name.
-;; comint-dynamic-simple-complete	Complete stub given candidates.
-
-;; These are not installed in the comint-mode keymap. But they are
-;; available for people who want them. Shell-mode installs them:
-;; (define-key shell-mode-map "\t" 'comint-dynamic-complete)
-;; (define-key shell-mode-map "\M-?"
-;;             'comint-dynamic-list-filename-completions)))
-;;
-;; Commands like this are fine things to put in load hooks if you
-;; want them present in specific modes.
-
-(defcustom comint-completion-autolist nil
-  "*If non-nil, automatically list possibilities on partial completion.
-This mirrors the optional behavior of tcsh."
-  :type 'boolean
-  :group 'comint-completion)
-
-(defcustom comint-completion-addsuffix t
-  "*If non-nil, add a `/' to completed directories, ` ' to file names.
-If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where
-DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion.
-This mirrors the optional behavior of tcsh."
-  :type 'boolean
-  :group 'comint-completion)
-
-(defcustom comint-completion-recexact nil
-  "*If non-nil, use shortest completion if characters cannot be added.
-This mirrors the optional behavior of tcsh.
-
-A non-nil value is useful if `comint-completion-autolist' is non-nil too."
-  :type 'boolean
-  :group 'comint-completion)
-
-(defcustom comint-completion-fignore nil
-  "*List of suffixes to be disregarded during file completion.
-This mirrors the optional behavior of bash and tcsh.
-
-Note that this applies to `comint-dynamic-complete-filename' only."
-  :type '(repeat (string :tag "Suffix"))
-  :group 'comint-completion)
-
-(defvar comint-file-name-prefix ""
-  "Prefix prepended to absolute file names taken from process input.
-This is used by comint's and shell's completion functions, and by shell's
-directory tracking functions.")
-
-(defvar comint-file-name-chars
-  (if (memq system-type '(ms-dos windows-nt))
-      "~/A-Za-z0-9_^$!#%&{}@`'.()-"
-    "~/A-Za-z0-9+@:_.$#%,={}-")
-  "String of characters valid in a file name.
-
-This is a good thing to set in mode hooks.")
-
-(defvar comint-file-name-quote-list nil
-  "List of characters to quote with `\\' when in a file name.
-
-This is a good thing to set in mode hooks.")
-
-
-(defun comint-directory (directory)
-  ;; Return expanded DIRECTORY, with `comint-file-name-prefix' if absolute.
-  (expand-file-name (if (file-name-absolute-p directory)
-			(concat comint-file-name-prefix directory)
-		      directory)))
-
-
-(defun comint-word (word-chars)
-  "Return the word of WORD-CHARS at point, or nil if non is found.
-Word constituents are considered to be those in WORD-CHARS, which is like the
-inside of a \"[...]\" (see `skip-chars-forward')."
-  (save-excursion
-    (let ((non-word-chars (concat "[^\\\\" word-chars "]")) (here (point)))
-      (while (and (re-search-backward non-word-chars nil 'move)
-		  ;(memq (char-after (point)) shell-file-name-quote-list)
-		  (eq (preceding-char) ?\\))
-	(backward-char 1))
-      ;; Don't go forward over a word-char (this can happen if we're at bob).
-      (if (or (not (bobp)) (looking-at non-word-chars))
-	  (forward-char 1))
-      ;; Set match-data to match the entire string.
-      (if (< (point) here)
-	  (progn (store-match-data (list (point) here))
-		 (match-string 0))))))
-
-(defun comint-substitute-in-file-name (filename)
-  "Return FILENAME with environment variables substituted.
-Supports additional environment variable syntax of the command
-interpreter (e.g., the percent notation of cmd.exe on NT)."
-  (let ((name (substitute-in-file-name filename)))
-    (if (memq system-type '(ms-dos windows-nt))
-	(let (env-var-name
-	      env-var-val)
-	  (save-match-data
-	    (while (string-match "%\\([^\\\\/]*\\)%" name)
-	      (setq env-var-name
-		    (substring name (match-beginning 1) (match-end 1)))
-	      (setq env-var-val (if (getenv env-var-name)
-				    (getenv env-var-name)
-				  ""))
-	      (setq name (replace-match env-var-val nil nil name))))))
-    name))
-
-(defun comint-match-partial-filename ()
-  "Return the filename at point, or nil if none is found.
-Environment variables are substituted.  See `comint-word'."
-  (let ((filename (comint-word comint-file-name-chars)))
-    (and filename (comint-substitute-in-file-name
-		   (comint-unquote-filename filename)))))
-
-
-(defun comint-quote-filename (filename)
-  "Return FILENAME with magic characters quoted.
-Magic characters are those in `comint-file-name-quote-list'."
-  (if (null comint-file-name-quote-list)
-      filename
-    (let ((regexp
-	   (format "\\(^\\|[^\\]\\)\\([%s]\\)"
-	    (mapconcat 'char-to-string comint-file-name-quote-list ""))))
-      (save-match-data
-	(while (string-match regexp filename)
-	  (setq filename (replace-match "\\1\\\\\\2" nil nil filename)))
-	filename))))
-
-(defun comint-unquote-filename (filename)
-  "Return FILENAME with quoted characters unquoted."
-  (if (null comint-file-name-quote-list)
-      filename
-    (save-match-data
-      (let ((i 0))
-	(while (string-match "\\\\\\(.\\)" filename i)
-	  (setq filename (replace-match "\\1" nil nil filename))
-	  (setq i (+ 1 (match-beginning 0)))))
-      filename)))
-
-
-;;;###autoload
-(defun comint-dynamic-complete ()
-  "Dynamically perform completion at point.
-Calls the functions in `comint-dynamic-complete-functions' to perform
-completion until a function returns non-nil, at which point completion is
-assumed to have occurred."
-  (interactive)
-  (run-hook-with-args-until-success 'comint-dynamic-complete-functions))
-
-
-(defun comint-dynamic-complete-filename ()
-  "Dynamically complete the filename at point.
-Completes if after a filename.  See `comint-match-partial-filename' and
-`comint-dynamic-complete-as-filename'.
-This function is similar to `comint-replace-by-expanded-filename', except that
-it won't change parts of the filename already entered in the buffer; it just
-adds completion characters to the end of the filename.  A completions listing
-may be shown in a help buffer if completion is ambiguous.
-
-Completion is dependent on the value of `comint-completion-addsuffix',
-`comint-completion-recexact' and `comint-completion-fignore', and the timing of
-completions listing is dependent on the value of `comint-completion-autolist'.
-
-Returns t if successful."
-  (interactive)
-  (if (comint-match-partial-filename)
-      (prog2 (or (window-minibuffer-p (selected-window))
-		 (message "Completing file name..."))
-	  (or (comint-dynamic-complete-as-username)
-	      (comint-dynamic-complete-as-filename)))))
-
-(defun comint-dynamic-complete-as-filename ()
-  "Dynamically complete at point as a filename.
-See `comint-dynamic-complete-filename'.  Returns t if successful."
-  (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))
-	 (completion-ignored-extensions comint-completion-fignore)
-	 ;; If we bind this, it breaks remote directory tracking in rlogin.el.
-	 ;; I think it was originally bound to solve file completion problems,
-	 ;; but subsequent changes may have made this unnecessary.  sm.
-	 ;;(file-name-handler-alist nil)
-	 (minibuffer-p (window-minibuffer-p (selected-window)))
-	 (success t)
-	 (dirsuffix (cond ((not comint-completion-addsuffix)
-			   "")
-			  ((not (consp comint-completion-addsuffix))
-			   (char-to-string directory-sep-char))
-			  (t
-			   (car comint-completion-addsuffix))))
-	 (filesuffix (cond ((not comint-completion-addsuffix)
-			    "")
-			   ((not (consp comint-completion-addsuffix))
-			    " ")
-			   (t
-			    (cdr comint-completion-addsuffix))))
-	 (filename (or (comint-match-partial-filename) ""))
-	 (pathdir (file-name-directory filename))
-	 (pathnondir (file-name-nondirectory filename))
-	 (directory (if pathdir (comint-directory pathdir) default-directory))
-	 (completion (file-name-completion pathnondir directory)))
-    (cond ((null completion)
-           (if minibuffer-p (ding) (message "No completions of %s" filename))
-           (setq success nil))
-          ((eq completion t)            ; Means already completed "file".
-           (insert filesuffix)
-           (or minibuffer-p (message "Sole completion")))
-          ((string-equal completion "") ; Means completion on "directory".
-           (comint-dynamic-list-filename-completions))
-          (t                            ; Completion string returned.
-           (let ((file (concat (file-name-as-directory directory) completion)))
-	     (insert (comint-quote-filename
-		      (substring (directory-file-name completion)
-				 (length pathnondir))))
-             (cond ((symbolp (file-name-completion completion directory))
-                    ;; We inserted a unique completion.
-		    (insert (if (file-directory-p file) dirsuffix filesuffix))
-                    (or minibuffer-p (message "Completed")))
-                   ((and comint-completion-recexact comint-completion-addsuffix
-                         (string-equal pathnondir completion)
-                         (file-exists-p file))
-                    ;; It's not unique, but user wants shortest match.
-                    (insert (if (file-directory-p file) dirsuffix filesuffix))
-                    (or minibuffer-p (message "Completed shortest")))
-                   ((or comint-completion-autolist
-                        (string-equal pathnondir completion))
-                    ;; It's not unique, list possible completions.
-                    (comint-dynamic-list-filename-completions))
-                   (t
-                    (or minibuffer-p (message "Partially completed")))))))
-    success))
-
-
-(defun comint-dynamic-complete-as-username ()
-  "Attempt to dynamically complete at point as a ~username.
-See `comint-dynamic-complete-filename'.  Returns t if successful."
-  (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))
-	 (completion-ignored-extensions comint-completion-fignore)
-	 ;; If we bind this, it breaks remote directory tracking in rlogin.el.
-	 ;; I think it was originally bound to solve file completion problems,
-	 ;; but subsequent changes may have made this unnecessary.  sm.
-	 ;;(file-name-handler-alist nil)
-	 (minibuffer-p (window-minibuffer-p (selected-window)))
-	 (success t)
-	 (dirsuffix (cond ((not comint-completion-addsuffix) "")
-			  ((not (consp comint-completion-addsuffix)) "/")
-			  (t (car comint-completion-addsuffix))))
-	 (filename (or (comint-match-partial-filename) ""))
-	 (pathdir (file-name-directory filename))
-	 (pathnondir (file-name-nondirectory filename)))
-    (if (and (fboundp 'user-name-completion-1)
-             (string-match "^[~]" pathnondir)
-             (not pathdir))
-        (let* ((user (substring pathnondir 1))
-               (compl+uniq (user-name-completion-1 user))
-               (completion (car compl+uniq))
-               (uniq (cdr compl+uniq)))
-          (cond ((null completion)
-                 (if minibuffer-p (ding) (message "No completions of %s" filename))
-                 (setq success nil))
-                ((eq completion t)           ; Means already completed "file".
-                 (insert dirsuffix)
-                 (or minibuffer-p (message "Sole completion")))
-                (t                           ; Completion string returned.
-                 (let ((file (concat "~" completion)))
-                   (insert (comint-quote-filename
-                            (substring file (length pathnondir))))
-                   (cond (uniq
-                          ;; We inserted a unique completion.
-                          (insert dirsuffix)
-                          (or minibuffer-p (message "Completed")))
-                         ((and comint-completion-recexact comint-completion-addsuffix
-                               (string-equal pathnondir file)
-                               (file-exists-p file))
-                          ;; It's not unique, but user wants shortest match.
-                          (insert dirsuffix)
-                          (or minibuffer-p (message "Completed shortest")))
-                         ((or comint-completion-autolist
-                              (string-equal pathnondir file))
-                          ;; It's not unique, list possible completions.
-                          (comint-dynamic-list-filename-completions))
-                         (t
-                          (or minibuffer-p (message "Partially completed"))))))))
-      (setq success nil))
-    success))
-
-
-(defun comint-replace-by-expanded-filename ()
-  "Dynamically expand and complete the filename at point.
-Replace the filename with an expanded, canonicalised and completed replacement.
-\"Expanded\" means environment variables (e.g., $HOME) and `~'s are replaced
-with the corresponding directories.  \"Canonicalised\" means `..'  and `.' are
-removed, and the filename is made absolute instead of relative.  For expansion
-see `expand-file-name' and `substitute-in-file-name'.  For completion see
-`comint-dynamic-complete-filename'."
-  (interactive)
-  (replace-match (expand-file-name (comint-match-partial-filename)) t t)
-  (comint-dynamic-complete-filename))
-
-
-(defun comint-dynamic-simple-complete (stub candidates)
-  "Dynamically complete STUB from CANDIDATES list.
-This function inserts completion characters at point by completing STUB from
-the strings in CANDIDATES.  A completions listing may be shown in a help buffer
-if completion is ambiguous.
-
-Returns nil if no completion was inserted.
-Returns `sole' if completed with the only completion match.
-Returns `shortest' if completed with the shortest of the completion matches.
-Returns `partial' if completed as far as possible with the completion matches.
-Returns `listed' if a completion listing was shown.
-
-See also `comint-dynamic-complete-filename'."
-  (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))
-	 (suffix (cond ((not comint-completion-addsuffix) "")
-		       ((not (consp comint-completion-addsuffix)) " ")
-		       (t (cdr comint-completion-addsuffix))))
-	 (candidates (mapcar (function (lambda (x) (list x))) candidates))
-	 (completions (all-completions stub candidates)))
-    (cond ((null completions)
- 	   (message "No completions of %s" stub)
-	   nil)
- 	  ((= 1 (length completions))	; Gotcha!
- 	   (let ((completion (car completions)))
- 	     (if (string-equal completion stub)
- 		 (message "Sole completion")
- 	       (insert (substring completion (length stub)))
- 	       (message "Completed"))
-	     (insert suffix)
-	     'sole))
- 	  (t				; There's no unique completion.
- 	   (let ((completion (try-completion stub candidates)))
- 	     ;; Insert the longest substring.
- 	     (insert (substring completion (length stub)))
- 	     (cond ((and comint-completion-recexact comint-completion-addsuffix
- 			 (string-equal stub completion)
- 			 (member completion completions))
- 		    ;; It's not unique, but user wants shortest match.
- 		    (insert suffix)
- 		    (message "Completed shortest")
-		    'shortest)
- 		   ((or comint-completion-autolist
- 			(string-equal stub completion))
- 		    ;; It's not unique, list possible completions.
- 		    (comint-dynamic-list-completions completions)
-		    'listed)
- 		   (t
-		    (message "Partially completed")
-		    'partial)))))))
-
-
-(defun comint-dynamic-list-filename-completions ()
-  "List in help buffer possible completions of the filename at point."
-  (interactive)
-  (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))
-	 ;; If we bind this, it breaks remote directory tracking in rlogin.el.
-	 ;; I think it was originally bound to solve file completion problems,
-	 ;; but subsequent changes may have made this unnecessary.  sm.
-	 ;;(file-name-handler-alist nil)
-	 (filename (or (comint-match-partial-filename) ""))
-	 (pathdir (file-name-directory filename))
-	 (pathnondir (file-name-nondirectory filename)))
-    (if (and (fboundp 'user-name-all-completions)
-             (string-match "^[~]" pathnondir)
-             (not pathdir))
-        ;; ~username completion
-        (let* ((user (substring pathnondir 1))
-               (completions (user-name-all-completions user)))
-          (if (not completions)
-              (message "No completions of %s" filename)
-            (comint-dynamic-list-completions
-             (mapcar 'comint-quote-filename
-                     (mapcar #'(lambda (p) (concat "~" p))
-                             completions)))))
-      ;; normal file completion
-      (let* ((directory (if pathdir (comint-directory pathdir) default-directory))
-             (completions (file-name-all-completions pathnondir directory)))
-        (if (not completions)
-            (message "No completions of %s" filename)
-          (comint-dynamic-list-completions
-           (mapcar 'comint-quote-filename completions)))))))
-
-
-;;;###autoload
-(defun comint-dynamic-list-completions (completions)
-  "List in help buffer sorted COMPLETIONS.
-Typing SPC flushes the help buffer."
-  (let ((conf (current-window-configuration)))
-    (with-output-to-temp-buffer "*Completions*"
-      (display-completion-list (sort completions 'string-lessp)))
-    (comint-restore-window-config conf)))
-
-;; #### - FSFmacs doesn't have this and I'm not gonna nuke it just yet, but
-;; it seems awfully redundant to have this here when compile.el does pretty
-;; much the same thing.  --Stig
-
-;;; Filename and source location extraction from a buffer.
-;;; lemacs change by John Rose
-;;; ===========================================================================
-;;; Functions for recognizing and extracting file names and line numbers.
-;;; C-c C-f attempts to extract a location from the current line, and
-;;; go to that location.
-
-;;; One command:
-;;; comint-find-source-code		Extract source location and follow it.
-
-;;; This should be installed globally, since file names and source locations
-;;; are ubiquitous.  However, don't overwrite an existing key binding.
-(if (not (lookup-key global-map "\C-c\C-f"))
-    (global-set-key "\C-c\C-f" 'comint-find-source-code))
-
-;;; Utility functions:
-;;; comint-extract-source-location	Parse source loc. from buffer or string.
-
-(defconst comint-source-location-patterns
-  '(;; grep (and cpp): file.c: 10:
-    ("\\(^\\|[ \t]\\)\\([^ \t\n]+\\): *\\([0-9]+\\):[ \t]*\\(.*\\)" (grep cpp) (2 3 4))
-    ;; cpp: #line 10 "file.c"
-    ("#\\(line\\)? *\\([0-9]+\\) *\"\\([^\"\n]+\\)\"" cpp (3 2))
-    ;; cc: "file.c", line 10
-    ("\"\\([^\"\n]+\\)\", line +\\([0-9]+\\)\\(:[ \t]+\\(.*\\)\\)?" cc (1 2 4))
-    ;; f77: line 10 of file.c
-    ("line +\\([0-9]+\\) +of +\\([^ \t\n]+\\)\\(:[ \t]+\\(.*\\)\\)?" f77 (2 1 4))
-    ;; perl: ...at file.c line 10.
-    ;; perl: ...at file.c line 10, near "foo"
-    ("^\\(.*\\) at \\([^ \t\n]+\\) line +\\([0-9]+\\)\\(\\.$\\|, \\)"
-     perl (2 3 1))
-    ;; dbx: line 10 in "file.c"
-    ("\\(^\\(.*\\)[ \t]+at \\)?line +\\([0-9]+\\) +[in of file]+ +\"\\([^\"\n]+\\)\""
-     dbx (4 3 2))
-    ;; dbx: "file.c":10
-    ("\"\\([^\"\n]+\\)\":\\([0-9]+\\)" dbx (1 2))
-    ;; centerline: "file.c:10"
-    ("\"\\([^\"\n]+\\):\\([0-9]+\\)\"" centerline (1 2))
-    ;; lint: : file.c(10)
-    (": *\\([^ \t\n)]+\\) *(\\([0-9]+\\))" lint (1 2))
-    ;; lint: file.c(10) :
-    ("\\(^\\|[ \t]\\)\\([^ \t\n)]+\\) *(\\([0-9]+\\)) *:" lint (2 3))
-    ;; lint: ( file.c(10) )
-    ("( +\\([^ \t\n)]+\\) *(\\([0-9]+\\)) +)" lint (1 2))
-    ;; troff: `file.c', line 10
-    ("[\"`']\\([^\"`'\n]+\\)[\"`'], line +\\([0-9]+\\)" troff (1 2))
-    ;; ri: "file.c" 10:
-    ("\"\\([^\"\n]+\\)\" *\\([0-9]+\\):" ri (1 2)) ;;Never heard of ri.
-    ;; mod: File file.c, line 10
-    ("[Ff]ile +\\([^ \t\n]+\\), line +\\([0-9]+\\)" mod (1 2))
-    ;; ksh: file.c[10] :
-    ("\\(^\\|[ \t]\\)\\([^ \t\n)]+\\) *\\[\\([0-9]+\\)\\] *:[ \t]+\\(.*\\)"
-     ksh (2 3 4))
-    ;; shell: file.c: syntax error at line 10
-    ("\\(^\\|[ \t]\\)\\([^ \t\n:]+\\):[ \t]+\\(.*\\)[ \t]+[, at]*line +\\([0-9]+\\)"
-     sh (2 4 3) -1)
-    )
-  "Series of regexps matching file number locations.
-Each list entry is a 3-list of a regexp, a program name, and up to 3 numbers.
-The numbers name regexp fields which will hold the file, line number,
-and associated diagnostic message (if any).
-The program name is a symbol or list of symbols, and
-is returned unexamined from `comint-extract-source-location';
-it should be a guess at who produced the message, e.g., 'cc'.
-
-In the case of multiple matches, `comint-extract-source-location'
-will return the leftmost, longest match of the highest priority.
-The priority of most patterns is 0, but a fourth element on
-the list, if present, specifies a different priority.
-
-The regexps initially stored here are based on the one in compile.el
-\(although the pattern containing 'of' must also contain 'line').
-They are also drawn from the Unix filters 'error' and 'fwarn'.
-The patterns are known to recognize errors from the following
-Un*x language processors:
-  cpp, cc, dbx, lex, f77, Centerline C, sh (Bourne), lint, mod
-The following language processors do not incorporate file names
-in every error message, and so are more difficult to accomodate:
-  yacc, pc, csh
-   ")
-
-(defun comint-extract-source-location (&optional start end commands markers)
-  "Return a 6-list of (file line command diagnostic mstart mend),
-obtained by parsing the current buffer between START and END,
-which default to the bounds of the current line.
-
-Use the list comint-source-location-patterns to guide parsing.
-
-The match returned will be on the latest line containing a match, but
-will be the earliest possible match on that line.
-
-START can also be a string, in which case it inserted in the buffer
-\"*Extract File and Line*\" and parsed there.
-
-COMMANDS is an optional list of pattern types, which has the effect of
-temporarily reducing the list comint-source-location-patterns
-to only those entries which apply to the given commands.
-
-Return NIL if there is no recognizable source location.
-
-MSTART and MEND give the limits of the matched source location.
-
-If MARKERS is true, return no strings, but rather cons cells
-of the form (beg-marker . end-marker).
-"
-  (if (not start)
-      (progn
-	(setq start (save-excursion (beginning-of-line) (point)))
-	(setq end (save-excursion (end-of-line) (point)))))
-  (if (stringp start)
-      (save-excursion
-	(set-buffer (get-buffer-create "*Extract File and Line*"))
-	(erase-buffer)
-	(insert start)
-	(comint-extract-source-location (point-min) (point-max) commands markers))
-    (let ((ptr (if (and (consp commands)
-			(consp (car commands)))
-		   (prog1 commands (setq commands nil))
-		 comint-source-location-patterns))
-	  pat
-	  (found-bol (- (point-min) 1))
-	  (found-prio -999999)
-	  found-beg
-	  found-end
-	  found-pat
-	  found-data
-	  set-found-data)
-      (setq set-found-data
-	    (function (lambda (data)
-			(while found-data
-			  (let ((m (car found-data)))
-			    (if (markerp m) (set-marker m nil)))
-			  (setq found-data (cdr found-data)))
-			(setq found-data data))))
-      (if (and commands (not (listp commands)))
-	  (setq commands (list commands)))
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region start end)
-	  (while ptr
-	    (setq pat (car ptr) ptr (cdr ptr))
-	    (goto-char (point-max))
-	    (if (and (or (null commands)
-			 (if (consp (nth 1 pat))
-			     (member (nth 1 pat) commands)
-			   ;; If (cadr pat) is a list, each list element
-			   ;; is a command that might produce this.
-			   (let ((ptr (nth 1 pat))
-				 (ismem nil))
-			     (while (and ptr (not ismem))
-			       (if (member (car ptr) commands)
-				   (setq ismem t))
-			       (setq ptr (cdr ptr)))
-			     ismem)))
-		     (re-search-backward (nth 0 pat) found-bol t))
-		(let (beg end bol prio)
-		  (setq beg (match-beginning 0))
-		  (setq end (match-end 0))
-		  (beginning-of-line)
-		  (setq bol (point))
-		  (re-search-forward (nth 0 pat))
-		  (if (> (match-beginning 0) beg)
-		      (error "comint-extract-source-location botch"))
-		  (setq beg (match-beginning 0))
-		  (setq end (match-end 0))
-		  (setq prio (or (nth 3 pat) 0))
-		  (if (or (> bol found-bol)
-			  (and (= bol found-bol)
-			       (or (> prio found-prio)
-				   (and (= prio found-prio)
-					(or (< beg found-beg)
-					    (and (= beg found-beg)
-						 (> end found-end)))))))
-		      (progn
-			(setq found-bol bol)
-			(setq found-prio prio)
-			(setq found-beg beg)
-			(setq found-end end)
-			(setq found-pat pat)
-			(funcall set-found-data (match-data)))))))))
-      (and found-data
-	   (let* ((command (nth 1 found-pat))
-		  (fields (nth 2 found-pat))
-		  (f1 (nth 0 fields))
-		  (f2 (nth 1 fields))
-		  (f3 (nth 2 fields))
-		  (get-field
-		   (function
-		    (lambda (fn)
-		      (and fn
-			   (let ((beg (match-beginning fn))
-				 (end (match-end fn)))
-			     (and beg end (> end beg)
-				  (if markers
-				      (cons (copy-marker beg) (copy-marker end))
-				    (buffer-substring beg end)))))))))
-	     (store-match-data found-data)
-	     (funcall set-found-data nil)
-	     (let ((file (funcall get-field f1))
-		   (line (funcall get-field f2))
-		   (diagnostic (funcall get-field f3))
-		   (mstart (match-beginning 0))
-		   (mend (match-end 0)))
-	       ;; (carefully use all match-data before calling string-match)
-	       (list
-		file
-		(if (and (stringp line)
-			 (prog1
-			     (string-match "\\`[0-9]+\\'" line)
-			   (store-match-data found-data)))
-		    (string-to-int line)
-		  line)
-		command
-		diagnostic
-		mstart
-		mend
-		))))
-      )))
-
-;;; Commands for extracting source locations:
-
-(defcustom comint-find-source-code-max-lines 100
-  "*Maximum number of lines to search backward for a source location,
-when using \\[comint-find-source-code\\] with an interactive prefix."
-  :type 'integer
-  :group 'comint-source)
-
-(defcustom comint-find-source-file-hook nil
-  "*Function to call instead of comint-default-find-source-file
-when comint-find-source-code parses out a file name and then wants to
-visit its buffer.  The sole argument is the file name.  The function
-must find the file, setting the current buffer, and return the file
-name.  It may also adjust the file name.  If you change this variable,
-make it buffer local."
-  :type 'function
-  :group 'comint-source)
-
-(defcustom comint-goto-source-line-hook nil
-  "*Function to call instead of comint-default-goto-source-line
-after comint-find-source-code finds a file and then wants to
-go to a line number mentioned in a source location.
-The sole argument is the line number.  The function must
-return the line number, possibly adjusted.  If you change
-this variable, make it buffer local."
-  :type 'function
-  :group 'comint-source)
-
-(defun comint-find-source-code (multi-line)
-  "Search backward from point for a source location.
-If a source location is found in the current line,
-go to that location.
-
-If MULTI-LINE is false (this is the interactive prefix flag),
-then only look for source locations in the current line.
-Otherwise, look within comint-find-source-code-max-lines
-before point.  If a source location is found on a previous line, move
-point to that location, so that another use of \\[comint-find-source-code\\]
-will go to the indicated place.
-
-If no source location is found, then try to extract a filename
-around the point, using ffap-next-guess.
-
-In any case, if the file does not exist, prompt the user for
-a pathname that does.  Sometimes the file's directory needs
-hand adjustment.
-
-This command uses comint-extract-source-location, which is customizable.
-Also, once a source file and line have been extracted, it uses
-comint-find-source-file-hook and comint-goto-source-line-hook
-to interpret them."
-  (interactive "P")
-  (let* ((beg (save-excursion
-		(if multi-line
-		    (forward-line (min 0 (- comint-find-source-code-max-lines)))
-		  (beginning-of-line))
-		(point)))
-	 (end (save-excursion (end-of-line) (point)))
-	 (res (or (comint-extract-source-location beg end)
-		  (save-excursion
-		    (save-restriction
-		      (narrow-to-region beg end)
-		      (goto-char (point-min))
-		      (let ((file (ffap-next-guess)))
-			(and file
-			     (list file nil nil nil
-				   (match-beginning 0)
-				   (match-end 0))))))
-		  (error "Not sitting on a source location."))))
-    (let ((file (nth 0 res))
-	  (line (nth 1 res))
-	  ;;(cmd (nth 2 res))
-	  (info (nth 3 res))
-	  (mbeg (nth 4 res))
-	  (mend (nth 5 res))
-	  dofind)
-      (setq dofind
-	    (not (and multi-line
-		      mend
-		      (< mend (save-excursion (beginning-of-line) (point))))))
-      (if (not dofind)
-	  (goto-char mbeg)
-	(progn
-	  (setq file
-		(funcall (or comint-find-source-file-hook
-			     'comint-default-find-source-file)
-			 file))
-	  (if line
-	      (setq line
-		    (funcall (or comint-goto-source-line-hook
-				 'comint-default-goto-source-line)
-			     line)))
-	  ))
-      (message "%s%s of %s%s%s"
-	       (if dofind
-		   "" (substitute-command-keys
-		       "Hit \\[comint-find-source-code] for "))
-	       (cond ((null line) "current line")
-		     ((numberp line) (format "line %s" line))
-		     (t line))
-	       (file-name-nondirectory file)
-	       (if info ": " "") (or info "")))))
-
-
-(defun comint-default-find-source-file (file)
-  "Action taken by \\[comint-find-source-code] when find-source-file-hook is nil.
-It calls substitute-in-file-name.  If the file does not exist, it prompts
-for the right pathname, using a similar pathname derived from a nearby
-buffer as a default.  It then calls find-file-other-window and returns the
-amended file name."
-  (setq file (substitute-in-file-name file))
-  (if (not (file-readable-p file))
-      (setq file (comint-fixup-source-file-name file)))
-  (find-file-other-window file)
-  file)
-
-(defun comint-fixup-source-file-name (file)
-  (let (dir ptr nondir bfile res)
-    (setq nondir (file-name-nondirectory file))
-    (setq ptr (buffer-list))
-    (while (and ptr (not dir))
-      (setq bfile (buffer-file-name (car ptr)))
-      (if (and bfile (equal (file-name-nondirectory bfile) nondir))
-	  (setq dir (file-name-directory bfile)
-		file (file-name-nondirectory bfile)))
-      (setq ptr (cdr ptr)))
-    (setq res
-	  (read-file-name "Source file: " dir t nil file))
-    (if (eq res t)
-	(expand-file-name file dir)
-      res)))
-
-(defun comint-default-goto-source-line (line)
-  "Action taken by \\[comint-find-source-code] when goto-source-line-hook is nil.
-It widens & pushes the mark, then does goto-line in the current buffer.
-It returns its line argument."
-  (widen)
-  (setq line (max line 0))
-  (setq line (min line (+ 1 (count-lines (point-min) (point-max)))))
-  (push-mark)
-  (goto-line line)
-  line)
-
-;; Converting process modes to use comint mode
-;; ===========================================================================
-;; The code in the Emacs 19 distribution has all been modified to use comint
-;; where needed.  However, there are `third-party' packages out there that
-;; still use the old shell mode.  Here's a guide to conversion.
-;;
-;; Renaming variables
-;; Most of the work is renaming variables and functions. These are the common
-;; ones:
-;; Local variables:
-;;	last-input-start	comint-last-input-start
-;; 	last-input-end		comint-last-input-end
-;;	shell-prompt-pattern	comint-prompt-regexp
-;;     shell-set-directory-error-hook 
-;; Miscellaneous:
-;;	shell-set-directory	
-;; 	shell-mode-map		comint-mode-map
-;; Commands:
-;;	shell-send-input	comint-send-input
-;;	shell-send-eof		comint-delchar-or-maybe-eof
-;; 	kill-shell-input	comint-kill-input
-;;	interrupt-shell-subjob	comint-interrupt-subjob
-;;	stop-shell-subjob	comint-stop-subjob
-;;	quit-shell-subjob	comint-quit-subjob
-;;	kill-shell-subjob	comint-kill-subjob
-;;	kill-output-from-shell	comint-kill-output
-;;	show-output-from-shell	comint-show-output
-;;	copy-last-shell-input	Use comint-previous-input/comint-next-input
-;;
-;; SHELL-SET-DIRECTORY is gone, its functionality taken over by
-;; SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-filter-functions.
-;; Comint mode does not provide functionality equivalent to
-;; shell-set-directory-error-hook; it is gone.
-;;
-;; comint-last-input-start is provided for modes which want to munge
-;; the buffer after input is sent, perhaps because the inferior
-;; insists on echoing the input.  The LAST-INPUT-START variable in
-;; the old shell package was used to implement a history mechanism,
-;; but you should think twice before using comint-last-input-start
-;; for this; the input history ring often does the job better.
-;;
-;; If you are implementing some process-in-a-buffer mode, called foo-mode, do
-;; *not* create the comint-mode local variables in your foo-mode function.
-;; This is not modular.  Instead, call comint-mode, and let *it* create the
-;; necessary comint-specific local variables. Then create the
-;; foo-mode-specific local variables in foo-mode.  Set the buffer's keymap to
-;; be foo-mode-map, and its mode to be foo-mode.  Set the comint-mode hooks
-;; (comint-{prompt-regexp, input-filter, input-filter-functions,
-;; get-old-input) that need to be different from the defaults.  Call
-;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself;
-;; comint-mode will take care of it. The following example, from shell.el,
-;; is typical:
-;;
-;; (defvar shell-mode-map '())
-;; (cond ((not shell-mode-map)
-;;        (setq shell-mode-map (copy-keymap comint-mode-map))
-;;        (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command)
-;;        (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command)
-;;        (define-key shell-mode-map "\t" 'comint-dynamic-complete)
-;;        (define-key shell-mode-map "\M-?"
-;;          'comint-dynamic-list-filename-completions)))
-;;
-;; (defun shell-mode ()
-;;   (interactive)
-;;   (comint-mode)
-;;   (setq comint-prompt-regexp shell-prompt-pattern)
-;;   (setq major-mode 'shell-mode)
-;;   (setq mode-name "Shell")
-;;   (use-local-map shell-mode-map)
-;;   (make-local-variable 'shell-directory-stack)
-;;   (setq shell-directory-stack nil)
-;;   (add-hook 'comint-input-filter-functions 'shell-directory-tracker)
-;;   (run-hooks 'shell-mode-hook))
-;;
-;;
-;; Note that make-comint is different from make-shell in that it
-;; doesn't have a default program argument. If you give make-shell
-;; a program name of NIL, it cleverly chooses one of explicit-shell-name,
-;; $ESHELL, $SHELL, or /bin/sh. If you give make-comint a program argument
-;; of NIL, it barfs. Adjust your code accordingly...
-;;
-;; Completion for comint-mode users
-;;
-;; For modes that use comint-mode, comint-dynamic-complete-functions is the
-;; hook to add completion functions to.  Functions on this list should return
-;; non-nil if completion occurs (i.e., further completion should not occur).
-;; You could use comint-dynamic-simple-complete to do the bulk of the
-;; completion job.
-
-
-;;; XEmacs customization
-(when (featurep 'xemacs)
-  (define-key comint-mode-map "\ep" 'comint-previous-matching-input-from-input)
-  (define-key comint-mode-map "\en" 'comint-next-matching-input-from-input)
-  (define-key comint-mode-map '(control up)
-    'comint-previous-matching-input-from-input)
-  (define-key comint-mode-map '(control down) 'comint-next-matching-input-from-input))
-
-
-;;; Do the user's customisation...
-
-(defvar comint-load-hook nil
-  "This hook is run when comint is loaded in.
-This is a good place to put keybindings.")
-
-(run-hooks 'comint-load-hook)
-
-
-(provide 'comint)
-
-;;; comint.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/compile.el b/xemacs-packages/lisp/xemacs-base/compile.el
deleted file mode 100644
index 45de71e8..00000000
--- a/xemacs-packages/lisp/xemacs-base/compile.el
+++ /dev/null
@@ -1,2368 +0,0 @@
-;;; compile.el --- run compiler as inferior of Emacs, parse error messages
-
-;; Copyright (C) 1985, 86, 87, 93, 94, 1995, 1996 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-;; Copyright (C) 2001 Ben Wing.
-
-;; Author: Roland McGrath 
-;; Maintainer: XEmacs Development Team
-;; Keywords: tools, processes
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34, with a lot of divergence.
-
-;;; Commentary:
-
-;; This package provides the compile and grep facilities documented in
-;; the Emacs user's manual.
-
-;;; Code:
-
-(defgroup compilation nil
-  "Run compiler as inferior of Emacs, parse error messages."
-  :group 'programming
-  :group 'tools
-  :group 'processes)
-
-
-;;;###autoload
-(defcustom compilation-mode-hook nil
-  "*List of hook functions run by `compilation-mode' (see `run-hooks')."
-  :type 'hook
-  :group 'compilation)
-
-;;;###autoload
-(defcustom compilation-window-height nil
-  "*Number of lines in a compilation window.  If nil, use Emacs default."
-  :type '(choice (const nil)
-		 integer)
-  :group 'compilation)
-
-;; XEmacs change
-(defvar compilation-error-list 'invalid ; only valid buffer-local
-  "List of error message descriptors for visiting erring functions.
-Each error descriptor is a cons (or nil).  Its car is a marker pointing to
-an error message.  If its cdr is a marker, it points to the text of the
-line the message is about.  If its cdr is a cons, it is a list
-\(\(DIRECTORY . FILE\) LINE [COLUMN]\).  Or its cdr may be nil if that
-error is not interesting.
-
-The value may be t instead of a list; this means that the buffer of
-error messages should be reparsed the next time the list of errors is wanted.
-
-Some other commands (like `diff') use this list to control the error
-message tracking facilities; if you change its structure, you should make
-sure you also change those packages.  Perhaps it is better not to change
-it at all.")
-
-(defvar compilation-old-error-list nil
-  "Value of `compilation-error-list' after errors were parsed.")
-
-(defvar compilation-parse-errors-function 'compilation-parse-errors
-  "Function to call to parse error messages from a compilation.
-It takes args LIMIT-SEARCH and FIND-AT-LEAST.
-If LIMIT-SEARCH is non-nil, don't bother parsing past that location.
-If FIND-AT-LEAST is non-nil, don't bother parsing after finding that
-many new errors.
-It should read in the source files which have errors and set
-`compilation-error-list' to a list with an element for each error message
-found.  See that variable for more info.")
-
-;;;###autoload
-(defcustom compilation-buffer-name-function nil
-  "Function to compute the name of a compilation buffer.
-The function receives one argument, the name of the major mode of the
-compilation buffer.  It should return a string.
-nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'."
-  :type 'function
-  :group 'compilation)
-
-;; XEmacs change
-(defcustom compilation-shell-minor-mode-menubar-menu-name "Errors"
-  "*Name of the menubar menu which displays error-navigation items."
-  :type 'string
-  :group 'compilation)
-
-;;;###autoload
-(defcustom compilation-finish-function nil
-  "*Function to call when a compilation process finishes.
-It is called with two arguments: the compilation buffer, and a string
-describing how the process finished."
-  :type 'function
-  :group 'compilation)
-
-(defvar compilation-last-buffer nil
-  "The most recent compilation buffer.
-A buffer becomes most recent when its compilation is started
-or when it is used with \\[next-error] or \\[compile-goto-error].")
-
-(defvar compilation-in-progress nil
-  "List of compilation processes now running.")
-(or (assq 'compilation-in-progress minor-mode-alist)
-    (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
-				 minor-mode-alist)))
-
-;; XEmacs change
-(defcustom compilation-always-signal-completion nil
-  "*Always give an audible signal upon compilation completion.
-By default that signal is only given if the bottom of the compilation
-buffer is not visible in its window."
-  :type 'boolean
-  :group 'compilation)
-
-(defvar compilation-parsing-end nil
-  "Position of end of buffer when last error messages were parsed.")
-
-(defvar compilation-error-message "No more errors"
-  "Message to print when no more matches are found.")
-
-(defvar compilation-num-errors-found)
-
-(defun compilation-build-compilation-error-regexp-alist ()
-  "Set the regular expressions used for parsing compiler
-errors based on the compilers listed in the variable
-`compilation-error-regexp-systems-list'.  Updates the
-variable `compilation-error-regexp-alist'."
-  (interactive)
-  (setq compilation-error-regexp-alist
-        (apply 'append
-               (mapcar
-                '(lambda (elt)
-                   (if (or (not (consp compilation-error-regexp-systems-list))
-                           (and (consp (car elt))
-                                (intersection (car elt)
-                                              compilation-error-regexp-systems-list))
-                           (memq (car elt) compilation-error-regexp-systems-list))
-                       (cdr elt)
-                     nil))
-                compilation-error-regexp-alist-alist))))
-
-(defvar compilation-error-regexp-alist-alist
-  '(
-    ;; NOTE!  See also grep-regexp-alist, below.
-
-    ;; 4.3BSD grep, cc, lint pass 1:
-    ;; 	/usr/src/foo/foo.c(8): warning: w may be used before set
-    ;; or GNU utilities:
-    ;; 	foo.c:8: error message
-    ;; or HP-UX 7.0 fc:
-    ;; 	foo.f          :16    some horrible error message
-    ;; or GNU utilities with column (GNAT 1.82):
-    ;;   foo.adb:2:1: Unit name does not match file name
-    ;; 
-    ;; We'll insist that the number be followed by a colon or closing
-    ;; paren, because otherwise this matches just about anything
-    ;; containing a number with spaces around it.
-   ((4bsd gnu)
-    ("\
-\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
-:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5)
-    )
-
-    ;; Microsoft C/C++:
-    ;;  keyboard.c(537) : warning C4005: 'min' : macro redefinition
-    ;;  d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if'
-   (msft
-    ("\\(\\([a-zA-Z]:\\)?[^:( \t\n-]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" 1 3)
-    )
-
-    ;; Borland C++, C++Builder:
-    ;;  Error ping.c 15: Unable to open include file 'sys/types.h'
-    ;;  Warning ping.c 68: Call to function 'func' with no prototype
-    ;; Or with Borland C++ Builder 6.0:
-    ;;  Error E2209 ping.c 15: Unable to open include file 'sys/types.h'
-    ;;  Warning W8065 ping.c 68: Call to function 'func' with no prototype
-   (borland
-    ("\\(Error\\|Warning\\) \\([EW][0-9]+ \\)?\\([a-zA-Z]?:?[^:( \t\n]+\\)\
- \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 3 4)
-    )
-
-    ;; 4.3BSD lint pass 2
-    ;; 	strcmp: variable # of args. llib-lc(359)  ::  /usr/src/foo/foo.c(8)
-   (4bsd
-    (".*[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$"
-     1 2)
-    )
-
-    ;; 4.3BSD lint pass 3
-    ;; 	bloofle defined( /users/wolfgang/foo.c(4) ), but never used
-    ;; This used to be
-    ;; ("[ \t(]+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2)
-    ;; which is regexp Impressionism - it matches almost anything!
-   (4bsd
-    (".*([ \t]*\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2)
-    )
-
-    ;; MIPS lint pass; looks good for SunPro lint also
-    ;;  TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomon.c due to truncation
-   (mips
-    ("[^\n ]+ (\\([0-9]+\\)) in \\([^ \n]+\\)" 2 1)
-    ;;  name defined but never used: LinInt in cmap_calc.c(199)
-    (".*in \\([^(\n]+\\)(\\([0-9]+\\))$" 1 2)
-    )
-
-    ;; Ultrix 3.0 f77:
-    ;;  fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol
-    ;; Some SGI cc version:
-    ;;  cfe: Warning 835: foo.c, line 2: something
-   ((sgi ultrix)
-    ("\\(cfe\\|fort\\): [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3)
-    )
-    ;; SGI Mipspro 7.3 compilers
-    ;; cc-1020 CC: ERROR File = CUI_App.h, Line = 735
-   (sgimipspro
-    ("^cc-[0-9]* \\(cc\\|CC\\|f77\\): \\(REMARK\\|WARNING\\|ERROR\\) File = \\(.*\\), Line = \\([0-9]*\\)" 3 4 ))
-    ;;  Error on line 3 of t.f: Execution error unclassifiable statement
-    ;; Unknown who does this:
-    ;;  Line 45 of "foo.c": bloofle undefined
-    ;; Absoft FORTRAN 77 Compiler 3.1.3
-    ;;  error on line 19 of fplot.f: spelling error?
-    ;;  warning on line 17 of fplot.f: data type is undefined for variable d
-   (of
-    ("\\(.* on \\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
-of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
-    )
-
-    ;; Apollo cc, 4.3BSD fc:
-    ;;	"foo.f", line 3: Error: syntax error near end of statement
-    ;; IBM RS6000:
-    ;;  "vvouch.c", line 19.5: 1506-046 (S) Syntax error.
-    ;; Unknown compiler:
-    ;;  File "foobar.ml", lines 5-8, characters 20-155: blah blah
-    ;; Microtec mcc68k:
-    ;;  "foo.c", line 32 pos 1; (E) syntax error; unexpected symbol: "lossage"
-    ;; GNAT (as of July 94):
-    ;;  "foo.adb", line 2(11): warning: file name does not match ...
-    ;; IBM AIX xlc compiler:
-    ;;  "src/swapping.c", line 30.34: 1506-342 (W) "/*" detected in comment.
-   (comma
-    (".*\"\\([^,\" \n\t]+\\)\", lines? \
-\\([0-9]+\\)\\([\(.]\\([0-9]+\\)\)?\\)?[:., (-]" 1 2 4)
-    )
-
-    ;; Python:
-    ;;  File "foobar.py", line 5, blah blah
-   (python
-    ("^File \"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)," 1 2)
-    )
-
-    ;; Caml compiler:
-    ;;  File "foobar.ml", lines 5-8, characters 20-155: blah blah
-   (caml
-    ("^File \"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[-0-9]*, characters? \\([0-9]+\\)" 1 2 3)
-    )
-
-    ;; MIPS RISC CC - the one distributed with Ultrix:
-    ;;	ccom: Error: foo.c, line 2: syntax error
-    ;; DEC AXP OSF/1 cc
-    ;;  /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah 
-   ((mips ultrix)
-    ("[a-z0-9/]+: \\([eE]rror\\|[wW]arning\\): \\([^,\" \n\t]+\\)[,:] \\(line \\)?\\([0-9]+\\):" 2 4)
-    )
-
-    ;; IBM AIX PS/2 C version 1.1:
-    ;;	****** Error number 140 in line 8 of file errors.c ******
-   (aix
-    (".*in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
-    )
-    ;; IBM AIX lint is too painful to do right this way.  File name
-    ;; prefixes entire sections rather than being on each line.
-
-    ;; Lucid Compiler, lcc 3.x
-    ;; E, file.cc(35,52) Illegal operation on pointers
-   (lcc
-    ("[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3)
-    )
-
-    ;; GNU messages with program name and optional column number.
-   (gnu
-    ("[a-zA-Z]?:?[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\
-\\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
-    )
-
-    ;; GNU messages with program name and optional column number
-    ;; and a severity letter after that.  nsgmls makes them.
-   (gnu
-    ("[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\
-\\([0-9]+\\):\\(\\([0-9]+\\):\\)?[A-Za-z]:" 1 2 4)
-    )
-
-    ;; jwz:
-    ;; IRIX 5.2
-    ;; cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ...
-   (sgi
-    ("[^\n]* \\([^ \n,\"]+\\), line \\([0-9]+\\):" 1 2)
-    )
-    ;; IRIX 5.2
-    ;; cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ...
-   (sgi
-    ("[^\n]*: \\([^ \n,\"]+\\): \\([0-9]+\\):" 1 2)
-    )
-
-    ;; Cray C compiler error messages
-   (cray
-    ("\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5)
-    )
-
-    ;; IBM C/C++ Tools 2.01:
-    ;;  foo.c(2:0) : informational EDC0804: Function foo is not referenced.
-    ;;  foo.c(3:8) : warning EDC0833: Implicit return statement encountered.
-    ;;  foo.c(5:5) : error EDC0350: Syntax error.
-   (ibm
-    ("\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) : " 1 2 3)
-    )
-
-    ;; IAR Systems C Compiler:
-    ;;  "foo.c",3  Error[32]: Error message
-    ;;  "foo.c",3  Warning[32]: Error message
-   (iar
-    ("\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(Error\\|Warning\\)\\[[0-9]+\\]:" 1 2)
-    )
-
-    ;; Sun ada (VADS, Solaris):
-    ;;  /home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: "," inserted
-   (ada
-    ("\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
-    )
-
-    ;; Perl -w:
-    ;; syntax error at automake line 922, near "':'"
-    ;; Perl debugging traces
-    ;; store::odrecall('File_A', 'x2') called at store.pm line 90
-   (perl
-    (".* at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 1 2)
-    )
-
-    ;; Oracle pro*c:
-    ;; Semantic error at line 528, column 5, file erosacqdb.pc:
-   (oracle
-    ("Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):"
-     3 1 2)
-    )
-
-    ;; EPC F90 compiler:
-    ;; Error 24 at (2:progran.f90) : syntax error
-   (epc
-    ("Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1)
-    )
-
-    ;; SGI IRIX MipsPro 7.3 compilers:
-    ;; cc-1070 cc: ERROR File = linkl.c, Line = 38
-    (sgimipspro
-     (".*: ERROR File = \\(.+\\), Line = \\([0-9]+\\)" 1 2)
-     (".*: WARNING File = \\(.+\\), Line = \\([0-9]+\\)" 1 2)
-     )
-
-    ;; Sun F90 error messages:
-    ;; cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3
-    (sun
-     (".* ERROR [a-zA-Z0-9 ]+, File = \\(.+\\), Line = \\([0-9]+\\), Column = \\([0-9]+\\)"
-      1 2 3)
-     )
-
-    ;; RXP - GPL XML validator at http://www.cogsci.ed.ac.uk/~richard/rxp.html:
-    ;; Error: Mismatched end tag: expected , got 
-    ;; in unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml
-    (rxp
-     ("Error:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)"
-      3 1 2)
-     )
-    ;; Warning: Start tag for undeclared element geroup
-    ;; in unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml
-    (rxp
-     ("Warning:.*\n.* line \\([0-9]+\\) char \\([0-9]+\\) of file://\\(.+\\)"
-      3 1 2)
-     )
-
-    ;; See http://ant.apache.org/faq.html
-    ;; Ant Java: works for jikes
-    (ant
-     ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([0-9]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:" 1 2 3)
-     )
-
-    ;; Ant Java: works for javac
-    (ant
-     ("^\\s-*\\[[^]]*\\]\\s-*\\(.+\\):\\([0-9]+\\):" 1 2)
-     )
-
-    ;; Ant / cygwin:
-    ;; file:G:/foobar/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found.
-   (ant
-    ("file:\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):[ \t]*\\([0-9]+\\)[: \t]" 1 3)
-    )
-   )
-  "Alist of (system regexp-alist) for building
-`compilation-error-regexp-alist'.  SYSTEM is either a system identifier,
-or a list of system identifiers.  See the variable 
-`compilation-error-regexp-systems-list'")
-
-(defvar compilation-error-regexp-alist nil
- "Alist that specifies how to match errors in compiler output.
-Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...])
-If REGEXP matches constrained to the beginning of the line, the
-FILE-IDX'th subexpression gives the file name, and the LINE-IDX'th
-subexpression gives the line number.  If COLUMN-IDX is given, the
-COLUMN-IDX'th subexpression gives the column number on that line.  If
-any FILE-FORMAT is given, each is a format string to produce a file name
-to try; %s in the string is replaced by the text matching the
-FILE-IDX'th subexpression.  Note previously REGEXP was not constrained
-to the beginning of the line, so old patterns without leading `^' or `\\n'
-may now require a leading `.*'.
-
-Note that this now gets set by the function 
-`compilation-build-compilation-error-regexp-alist' using the 
-value of the variable `compilation-error-regexp-alist-alist'")
-
-(defcustom compilation-error-regexp-systems-list 'all
-  "*This is either the symbol `all', or a list of systems for which
-compilation error regexps should be included in
-`compilation-error-regexp-alist'.  You must run the function
-`compilation-build-compilation-error-regexp-alist' after changing
-the value of this variable for the change to take effect.
-
-The list of known systems is:
-  4bsd:       Using 4bsd
-  ada:        Ada compilers
-  aix:        the operating system
-  ant:        Ant Java
-  borland:    Using Borland
-  caml:       Using caml compiler
-  comma:      Using tool that says \"foo.c\", line 12
-  cray:       Using Cray
-  epc:        Using EPC F90 compiler
-  gnu:        but of course
-  iar:        Using IAR systems compiler
-  ibm:        IBM C compilers
-  lcc:        Lucid compilers
-  mips:       Using Mips
-  msft:       Using microsoft
-  of:         Using tool that says line xx of foo.c
-  oracle:     Using Oracle pro*c
-  perl:       perl -w
-  python:     Using python
-  rxp:        Using RPX GPL XML validator
-  sgi:        Using SGI
-  sgimipspro: Using SGI Mipspro 7.3
-  sun:        Using Sun F90 compiler
-  ultrix:     Using DEC unixoid operating system
-
-See also the variable `compilation-error-regexp-alist-alist'."
-  :type '(choice (const all)
-	  (set :menu-tag "Pick"
-	       (const 4bsd)
-	       (const ada)
-	       (const aix)
-	       (const ant)
-	       (const borland)
-	       (const caml)
-	       (const comma)
-	       (const cray)
-	       (const epc)
-	       (const gnu)
-	       (const iar)
-	       (const ibm)
-	       (const lcc)
-	       (const mips)
-	       (const msft)
-	       (const of)
-	       (const oracle)
-	       (const perl)
-	       (const python)
-	       (const rxp)
-	       (const sgi)
-	       (const sgimipspro)
-	       (const sun)
-	       (const ultrix)
-	       ))
-  :set (lambda (symbol value)
-         (set-default symbol value)
-         (compilation-build-compilation-error-regexp-alist))
-  :group 'compilation)
-
-(compilation-build-compilation-error-regexp-alist)
-
-(defcustom compilation-error-screen-columns t
-  "*If non-nil, column numbers in error messages are screen columns.
-Otherwise they are interpreted as character positions, with
-each character occupying one column.
-The default is to use screen columns, which requires that the compilation
-program and Emacs agree about the display width of the characters,
-especially the TAB character."
-  :type 'boolean
-  :group 'compilation
-  :version "20.4")
-
-(defcustom compilation-read-command t
-  "*Non-nil means \\[compile] reads the compilation command to use.
-Otherwise, \\[compile] just uses the value of `compile-command'."
-  :type 'boolean
-  :group 'compilation)
-
-(defcustom compilation-ask-about-save t
-  "*Non-nil means \\[compile] asks which buffers to save before compiling.
-Otherwise, it saves all modified buffers without asking."
-  :type 'boolean
-  :group 'compilation)
-
-(defcustom compilation-ask-about-kill t
-  "*If not nil, M-x compile asks to kill a running compilation.
-Otherwise, it kills it without asking."
-  :type 'boolean
-  :group 'compilation)
-
-;; Note: the character class after the optional drive letter does not
-;; include a space to support file names with blanks.
-(defvar grep-regexp-alist
-  '(("^\\([a-zA-Z]?:?[^:(\t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
-  "Regexp used to match grep hits.  See `compilation-error-regexp-alist'.")
-
-(defcustom grep-command "grep -n "
-  "*Last grep command used in \\[grep]; default for next grep."
-  :type 'string
-  :group 'compilation)
-
-;; The system null device.
-;; #### Backward compatibility hack; recent (21.4.x and 21.5.x) XEmacsen
-;; have `null-device', but 21.1 may not.
-(defvar grep-null-device
-  (if (boundp 'null-device) null-device "/dev/null")
-  "The system null device.")
-
-(defvar grep-find-use-xargs
-  ;; XEmacs change: test xargs compatibility too, revert to non-print0 xargs
-  ;; if any xargs is available.
-  (if (condition-case nil
-	  (and
-	   (equal
-	    (call-process "find" nil nil nil grep-null-device "-print0") 0)
-	   (equal (call-process "xargs" nil nil nil "-0" "-e") 0))
-	(error nil))
-      'gnu
-    (condition-case nil (equal (call-process "xargs") 0) (error nil)))
-  "Whether \\[grep-find] uses the `xargs' utility by default.
-
-If nil, it uses `find -exec'; if `gnu', it uses `find -print0' and `xargs -0';
-if not nil and not `gnu', it uses `find -print' and `xargs'.
-
-This variable's value takes effect when `compile.el' is loaded
-by influencing the default value for the variable `grep-find-command'.")
-
-(defvar grep-find-command
-  (cond ((eq grep-find-use-xargs 'gnu)
-	 (format "find . -type f -print0 | xargs -0 -e %s" grep-command))
-	(grep-find-use-xargs
-	 (format "find . -type f -print | xargs %s" grep-command))
-	(t (cons (format "find . -type f -exec %s {} /dev/null \\;"
-			 grep-command)
-		 (+ 22 (length grep-command)))))
-  "The default find command for \\[grep-find].")
-
-;; XEmacs addition: all grep-all-files stuff
-
-(defvar grep-all-files-history nil)
-
-(defcustom grep-all-files-omitted-expressions
-  '("*~" "#*" ".#*" ",*" "*.elc" "*.obj" "*.o" "*.exe" "*.dll" "*.lib" "*.a"
-    "*.dvi" "*.class" "*.bin" "*.orig" "*.rej")
-  "List of expressions matching files to be omitted in `grep-all-files-...'.
-Each entry should be a simple name or a shell wildcard expression."
-  :type '(repeat string)
-  :group 'compilation)
-
-(defcustom grep-all-files-omitted-directories '("CVS" "RCS" "SCCS")
-  "List of directories not to recurse into in `grep-all-files-...'.
-Each entry should be a simple name or a shell wildcard expression."
-  :type '(repeat string)
-  :group 'compilation)
-
-;;;###autoload
-(defcustom compilation-search-path '(nil)
-  "*List of directories to search for source files named in error messages.
-Elements should be directory names, not file names of directories.
-nil as an element means to try the default directory."
-  :type '(repeat (choice (const :tag "Default" nil)
-			 directory))
-  :group 'compilation)
-
-(defcustom compile-command "make -k "
-  "*Last shell command used to do a compilation; default for next compilation.
-
-Sometimes it is useful for files to supply local values for this variable.
-You might also use mode hooks to specify it in certain modes, like this:
-
-    (add-hook 'c-mode-common-hook
-	      (lambda ()
-		(or (file-exists-p \"makefile\") (file-exists-p \"Makefile\")
-		    (set (make-local-variable 'compile-command)
-			 (concat \"make -k \" buffer-file-name)))))"
-  :type 'string
-  :group 'compilation)
-
-(defvar compilation-enter-directory-regexp
-  "[^\n]*: Entering directory `\\([^\n]*\\)'$"
-  "Regular expression matching lines that indicate a new current directory.
-This must contain one \\(, \\) pair around the directory name.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
-(defvar compilation-leave-directory-regexp
-  "[^\n]*: Leaving directory `\\([^\n]*\\)'$"
-  "Regular expression matching lines that indicate restoring current directory.
-This may contain one \\(, \\) pair around the name of the directory
-being moved from.  If it does not, the last directory entered \(by a
-line matching `compilation-enter-directory-regexp'\) is assumed.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
-(defvar compilation-directory-stack nil
-  "Stack of previous directories for `compilation-leave-directory-regexp'.
-The head element is the directory the compilation was started in.")
-
-(defvar compilation-exit-message-function nil "\
-If non-nil, called when a compilation process dies to return a status message.
-This should be a function of three arguments: process status, exit status,
-and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
-write into the compilation buffer, and to put in its mode line.")
-
-;; History of compile commands.
-(defvar compile-history nil)
-;; History of grep commands.
-(defvar grep-history nil)
-(defvar grep-find-history nil)
-
-;; XEmacs
-(defvar compilation-font-lock-keywords (purecopy
-  (list
-   '("^[-_.\"A-Za-z0-9/+]+\\(:\\|, line \\)[0-9]+: \\([wW]arning:\\).*$" .
-     font-lock-keyword-face)
-   '("^[-_.\"A-Za-z0-9/+]+\\(: *\\|, line \\)[0-9]+:.*$" . font-lock-function-name-face)
-   '("^[^:\n]+-[a-zA-Z][^:\n]+$" . font-lock-doc-string-face)
-   '("\\(^[-_.\"A-Za-z0-9/+]+\\)\\(: *\\|, line \\)[0-9]+" 1 font-lock-string-face t)
-   '("^[-_.\"A-Za-z0-9/+]+\\(: *[0-9]+\\|, line [0-9]+\\)" 1 bold t)
-   ))
-  "Additional expressions to highlight in Compilation mode.")
-
-;FSF's version.  Ours looks better.
-;(defvar compilation-mode-font-lock-keywords
-;  ;; This regexp needs a bit of rewriting.  What is the third grouping for?
-;  '(("^\\([a-zA-Z]?:?[^ \n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$"
-;     1 font-lock-function-name-face))
-;;;  ("^\\([^\n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 0 font-lock-keyword-face keep)
-
-;; XEmacs change
-(put 'compilation-mode 'font-lock-defaults
-     '(compilation-font-lock-keywords t))
-
-(defcustom compilation-mouse-motion-initiate-parsing nil
-  "*Should mouse motion over the compilation buffer initiate parsing?
-When set to a non-nil value, mouse motion over the compilation/grep
-buffer may initiate parsing of the error messages or grep hits.
-When this is nil, errors and grep matches will no longer be 
-highlighted until they have been parsed, but may still be selected
-with the center mouse button.  This will then initiate parsing
-and jump to the corresponding source line."
-  :type 'boolean
-  :group 'compilation)
-
-;;;###autoload
-(defun compile (command)
-  "Compile the program including the current buffer.  Default: run `make'.
-Runs COMMAND, a shell command, in a separate process asynchronously
-with output going to the buffer `*compilation*'.
-
-You can then use the command \\[next-error] to find the next error message
-and move to the source code that caused it.
-
-Interactively, prompts for the command if `compilation-read-command' is
-non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
-
-To run more than one compilation at once, start one and rename the
-\`*compilation*' buffer to some other name with \\[rename-buffer].
-Then start the next one.
-
-The name used for the buffer is actually whatever is returned by
-the function in `compilation-buffer-name-function', so you can set that
-to a function that generates a unique name."
-  (interactive
-   (if (or compilation-read-command current-prefix-arg)
-       ;; XEmacs change
-       (list (read-shell-command "Compile command: "
-                                 compile-command
-                                 ;; #### minibuffer code should do this
-                                 (if (equal (car compile-history)
-                                            compile-command)
-                                     '(compile-history . 1)
-                                     'compile-history)))
-       (list compile-command)))
-  (setq compile-command command)
-  (save-some-buffers (not compilation-ask-about-save) nil)
-  (compile-internal compile-command "No more errors"))
-
-;; run compile with the default command line
-(defun recompile ()
-  "Re-compile the program including the current buffer."
-  (interactive)
-  (save-some-buffers (not compilation-ask-about-save) nil)
-  (compile-internal compile-command "No more errors"))
-
-;;;###autoload
-(defun grep (command-args)
-  "Run grep, with user-specified args, and collect output in a buffer.
-While grep runs asynchronously, you can use the \\[next-error] command
-to find the text that grep hits refer to.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a grep command."
-  (interactive
-   ;; XEmacs change
-   (list (read-shell-command "Run grep (like this): "
-			     grep-command 'grep-history)))
-  (let ((buf (compile-internal (concat command-args " " grep-null-device)
-			       "No more grep hits" "grep"
-			       ;; Give it a simpler regexp to match.
-			       nil grep-regexp-alist)))
-    (save-excursion
-      (set-buffer buf)
-      (set (make-local-variable 'compilation-exit-message-function)
-	   ;; XEmacs change
-	   (lambda (proc msg)
-	     (let ((code (process-exit-status proc)))
-	       (if (eq (process-status proc) 'exit)
-		   (cond ((zerop code)
-			  (cons (format "finished (%d matches found)\n"
-					;; stolen from count-matches,
-					;; should be refactored by
-					;; count-matches returning
-					;; count.
-					(let ((count 0) opoint)
-					  (save-excursion
-					    (goto-char (point-min))
-					    (while (and (not (eobp))
-							(progn (setq opoint (point))
-							       (re-search-forward (caar grep-regexp-alist) nil t)))
-					      (if (= opoint (point))
-						  (forward-char 1)
-						(setq count (1+ count))))
-					    count)))
-				"matched"))
-			 ((= code 1)
-			  '("finished with no matches found\n" . "no match"))
-			 (t
-			  (cons msg code)))
-		 (cons msg code))))))))
-
-;;;###autoload
-(defun grep-find (command-args)
-  "Run grep via find, with user-specified args COMMAND-ARGS.
-Collect output in a buffer.
-While find runs asynchronously, you can use the \\[next-error] command
-to find the text that grep hits refer to.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a find command."
-  (interactive
-   ;; XEmacs change..
-   (list (read-shell-command "Run find (like this): "
-			       grep-find-command 'grep-find-history)))
-  (let ((grep-null-device nil))		; see grep
-    (grep command-args)))
-
-;; XEmacs addition
-(defalias 'find-grep 'grep-find)
-
-;; XEmacs addition: all grep-all-files stuff
-
-(defun construct-grep-all-files-command (find-segment grep-segment)
-  (let ((omit-annoying
-	 (mapconcat #'(lambda (wildcard)
-			(concat "-name '" wildcard "' -or "))
-		    grep-all-files-omitted-expressions
-		    "")))
-    (cond ((eq grep-find-use-xargs 'gnu)
-	   (format "find . %s %s -type f -print0 | xargs -0 -e %s"
-		   find-segment omit-annoying grep-segment))
-	  (grep-find-use-xargs
-	   (format "find . %s %s -type f -print | xargs %s"
-		   find-segment omit-annoying grep-segment))
-	  (t
-	   (format "find . %s %s -type f -exec %s {} /dev/null \\;"
-		   find-segment omit-annoying grep-segment)))))
-
-;;;###autoload
-(defun grep-all-files-in-current-directory (command)
-  "Run `grep' in all non-annoying files in the current directory.
-`Non-annoying' excludes backup files, autosave files, CVS merge files, etc.
-More specifically, this is controlled by `grep-all-files-omitted-expressions'.
-
-This function does not recurse into subdirectories.  If you want this,
-use \\[grep-all-files-in-current-directory-and-below]."
-  (interactive
-   (progn
-     (list (read-shell-command "Run grep (like this): "
-			       grep-command 'grep-all-files-history))))
-  (grep (construct-grep-all-files-command
-	 "-name . -or -type d -prune -or" command)))
-
-;;;###autoload
-(defun grep-all-files-in-current-directory-and-below (command)
-  "Run `grep' in all non-annoying files in the current directory and below.
-`Non-annoying' excludes backup files, autosave files, CVS merge files, etc.
-More specifically, this is controlled by `grep-all-files-omitted-expressions'.
-
-This function recurses into subdirectories.  If you do not want this,
-use \\[grep-all-files-in-current-directory]."
-  (interactive
-   (progn
-     (list (read-shell-command "Run grep (like this): "
-			       grep-command 'grep-all-files-history))))
-  (grep (construct-grep-all-files-command
-	 ;; prune all specified directories.
-	 (mapconcat #'(lambda (wildcard)
-			(concat "-name '" wildcard "' -prune -or "))
-		    grep-all-files-omitted-directories
-		    "")
-	 command)))
-
-(defun compile-internal (command error-message
-				 &optional name-of-mode parser regexp-alist
-				 name-function)
-  "Run compilation command COMMAND (low level interface).
-ERROR-MESSAGE is a string to print if the user asks to see another error
-and there are no more errors.  Third argument NAME-OF-MODE is the name
-to display as the major mode in the compilation buffer.
-
-Fourth arg PARSER is the error parser function (nil means the default).  Fifth
-arg REGEXP-ALIST is the error message regexp alist to use (nil means the
-default).  Sixth arg NAME-FUNCTION is a function called to name the buffer (nil
-means the default).  The defaults for these variables are the global values of
-\`compilation-parse-errors-function', `compilation-error-regexp-alist', and
-\`compilation-buffer-name-function', respectively.
-
-Returns the compilation buffer created."
-  (let (outbuf)
-    (save-excursion
-      (or name-of-mode
-	  (setq name-of-mode "Compilation"))
-      (setq outbuf
-	    (get-buffer-create
-	     (funcall (or name-function compilation-buffer-name-function
-			  (function (lambda (mode)
-				      (concat "*" (downcase mode) "*"))))
-		      name-of-mode)))
-      (set-buffer outbuf)
-      (let ((comp-proc (get-buffer-process (current-buffer))))
-	(if comp-proc
-	    (if (or (not (eq (process-status comp-proc) 'run))
-                    (or
-                     (not compilation-ask-about-kill)
-                     (yes-or-no-p
-                      (format "A %s process is running; kill it? "
-                              name-of-mode))))
-		(condition-case ()
-		    (progn
-		      (interrupt-process comp-proc)
-		      (sit-for 1)
-		      (delete-process comp-proc))
-		  (error nil))
-	      (error "Cannot have two processes in `%s' at once"
-		     (buffer-name))
-	      )))
-      ;; In case the compilation buffer is current, make sure we get the global
-      ;; values of compilation-error-regexp-alist, etc.
-      (kill-all-local-variables))
-    (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist))
-	  (parser (or parser compilation-parse-errors-function))
-	  (thisdir default-directory)
-	  ;; XEmacs change
-	  (buffer-save (current-buffer))
-	  outwin)
-
-      ;; XEmacs change
-      ;; Pop up the compilation buffer.
-      (setq outwin (display-buffer outbuf))
-      
-      (unwind-protect
-       (progn
-	;; Clear out the compilation buffer and make it writable.
-	;; Change its default-directory to the directory where the compilation
-	;; will happen, and insert a `cd' command to indicate this.
-	(set-buffer outbuf)
-	(setq buffer-read-only nil)
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)
-	(buffer-enable-undo (current-buffer))
-	(setq default-directory thisdir)
-	(insert "cd " thisdir "\n" command "\n")
-	(set-buffer-modified-p nil)
-
-	;; XEmacs change
-	;; set it so the window will scroll to show compile output
-	(save-window-excursion
-	  (select-window outwin)
-	  (goto-char (point-max)))
-	(setq outwin (display-buffer outbuf))
-	
-	;; XEmacs change
-	(compilation-mode name-of-mode)
-	;; (setq buffer-read-only t)  ;;; Non-ergonomic.
-	;; XEmacs change
-	(set (make-local-variable 'compile-command) command)
-	(set (make-local-variable 'compilation-parse-errors-function) parser)
-	(set (make-local-variable 'compilation-error-message) error-message)
-	(set (make-local-variable 'compilation-error-regexp-alist) regexp-alist)
-	(setq default-directory thisdir
-	      compilation-directory-stack (list default-directory))
-	(set-window-start outwin (point-min))
-	(setq mode-name name-of-mode)
-	;; XEmacs change
-;	(or (eq outwin (selected-window))
-;	    (set-window-point outwin (point-min)))
-	(compilation-set-window-height outwin)
-	;; Start the compilation.
-	(if (fboundp 'start-process)
-	    (let* ((process-environment (cons "EMACS=t" process-environment))
-		   (proc (start-process-shell-command (downcase mode-name)
-						      outbuf
-						      command)))
-	      (set-process-sentinel proc 'compilation-sentinel)
-	      (set-process-filter proc 'compilation-filter)
-	      ;; Causes problems; please investigate before using:
-	      ;(process-send-eof proc)
-	      (set-marker (process-mark proc) (point) outbuf)
-	      (setq compilation-in-progress
-		    (cons proc compilation-in-progress)))
-	  ;; No asynchronous processes available.
-	  (display-message
-	   'progress
-	   (format "Executing `%s'..." command))
-	  ; FSF
-	  ; (setq mode-line-process ":run")
-	  ; (force-mode-line-update)
-	  (sit-for 0)			;; Force redisplay
-	  (let ((status (call-process shell-file-name nil outbuf nil
-				      shell-command-switch command))))
-	  (display-message
-	   'progress
-	   (format "Executing `%s'...done" command))))
-       (set-buffer buffer-save)))
-
-    ;; Make it so the next C-x ` will use this buffer.
-    (setq compilation-last-buffer outbuf)))
-
-;; Set the height of WINDOW according to compilation-window-height.
-(defun compilation-set-window-height (window)
-  (and compilation-window-height
-       ;; Check if the window is split horizontally.
-       ;; Emacs checks window width versus frame-width:
-       ;;   (= (window-width window) (frame-width (window-frame window)))
-       ;; But XEmacs must take into account a possible left or right
-       ;; toolbar:
-       (and (window-leftmost-p (selected-window))
-	    (window-rightmost-p (selected-window)))
-       ;; If window is alone in its frame, aside from a minibuffer,
-       ;; don't change its height.
-       (not (eq window (frame-root-window (window-frame window))))
-       ;; This save-excursion prevents us from changing the current buffer,
-       ;; which might not be the same as the selected window's buffer.
-       (save-excursion
-	 (let ((w (selected-window)))
-	   (unwind-protect
-	       (progn
-		 (select-window window)
-		 (enlarge-window (- compilation-window-height
-				    (window-height))))
-	     (select-window w))))))
-
-;;;###autoload
-(defvar compilation-minor-mode-map
-  (let ((map (make-sparse-keymap)))
-    (set-keymap-name map 'compilation-minor-mode-map)
-    (define-key map "\C-c\C-c" 'compile-goto-error)
-    (define-key map "\C-m" 'compile-goto-error)
-    (define-key map "\C-c\C-k" 'kill-compilation)
-    (define-key map "\M-n" 'compilation-next-error)
-    (define-key map "\M-p" 'compilation-previous-error)
-    (define-key map "\M-{" 'compilation-previous-file)
-    (define-key map "\M-}" 'compilation-next-file)
-    map)
-  "Keymap for `compilation-minor-mode'.")
-
-;;;###autoload
-(defvar compilation-shell-minor-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\M-\C-m" 'compile-goto-error)
-    (define-key map "\M-\C-n" 'compilation-next-error)
-    (define-key map "\M-\C-p" 'compilation-previous-error)
-    (define-key map "\M-{" 'compilation-previous-file)
-    (define-key map "\M-}" 'compilation-next-file)
-    map)
-  "Keymap for `compilation-shell-minor-mode'.")
-
-(defvar compilation-mode-map
-  (let ((map (make-sparse-keymap)))
-    (set-keymap-parents map (list compilation-minor-mode-map))
-    (set-keymap-name map 'compilation-mode-map)
-    (define-key map " " 'scroll-up)
-    (define-key map "\^?" 'scroll-down)
-    (define-key map 'button2 'compile-mouse-goto-error)
-    map)
-  "Keymap for compilation log buffers.
-`compilation-minor-mode-map' is a parent of this.")
-
-;;; XEmacs menus
-
-(defun compilation-errors-exist-p (&optional buffer)
-  "Whether we are in a state where the `next-error' command will work,
-that is, whether there exist (or may exist) error targets in the *compile*
-or *grep* buffers."
-  (or buffer
-      (setq buffer (condition-case nil
-			  (compilation-find-buffer)
-			(error nil))))
-  (and buffer
-       (compilation-buffer-p buffer)
-       (save-excursion
-	 (set-buffer buffer)
-	 ;; Has errors on the list, or needs to be parsed.
-	 ;; But don't parse it now!
-	 (or (not (null compilation-error-list))
-	     (< compilation-parsing-end (point-max))))))
-
-;; XEmacs change
-(defvar compilation-shell-minor-mode-menubar-menu
-  '("Errors"
-    :filter compile-menu-filter
-    ["Stop"		comint-interrupt-subjob t]
-    "---"
-    ["First Error"	first-error		(compilation-errors-exist-p)]
-    ["Previous Error"	previous-error		(compilation-errors-exist-p)]
-    ["Next Error" 	next-error		(compilation-errors-exist-p)]
-    ))
-
-(defvar Compilation-mode-popup-menu
-  '("Compilation Mode Commands"
-    :filter compile-menu-filter
-    ["Compile..."	compile t]
-    ["Recompile"	recompile t]
-    ["Kill Compilation"	kill-compilation (get-buffer-process (current-buffer))]
-    "---"
-    ["Goto Error"	compile-goto-error	(compilation-errors-exist-p)]
-    ["Next Error" 	next-error		(compilation-errors-exist-p)]
-    ["Previous Error"	previous-error		(compilation-errors-exist-p)]
-    ["First Error"	first-error		(compilation-errors-exist-p)]
-    ))
-
-(defvar Compilation-mode-menubar-menu
-  (cons "Compile" (cdr Compilation-mode-popup-menu)))
-  
-(defvar grep-mode-popup-menu
-  '("Grep Mode Commands"
-    :filter grep-menu-filter
-    ["Grep..."		grep t]
-    ["Repeat Grep"	recompile t]
-    ["Kill Grep"	kill-compilation (get-buffer-process (current-buffer))]
-    "---"
-    ["Goto Match" compile-goto-error (default-value 'compilation-error-list)]
-    ["Next Match"	next-error (default-value 'compilation-error-list)]
-    ["Previous Match"	previous-error (default-value 'compilation-error-list)]
-    ["First Match"	first-error (default-value 'compilation-error-list)]
-    ))
-
-(defvar grep-mode-menubar-menu
-  (cons "Grep" (cdr grep-mode-popup-menu)))
-  
-(defun compile-menu-filter-1 (menu history-list item-name command-name)
-  (let ((submenu (mapcar #'(lambda (string)
-			     (vector string
-				     (list command-name string)
-				     t))
-			  history-list))
-	(existing (assoc item-name menu)))
-    (if existing
-	(progn
-	  (setcdr existing submenu)
-	  menu)
-      (nconc menu (list (cons item-name submenu))))))
-
-(defun compile-menu-filter (menu)
-  (compile-menu-filter-1 menu compile-history "Compile History" 'compile))
-
-(defun grep-menu-filter (menu)
-  (compile-menu-filter-1 menu grep-history "Grep History" 'grep))
-
-;;;###autoload
-(defun compilation-mode (&optional name-of-mode)
-  "Major mode for compilation log buffers.
-\\To visit the source for a line-numbered error,
-move point to the error message line and type \\[compile-goto-error],
-or click on the line with \\[compile-mouse-goto-error].
-There is a menu of commands on \\[compile-popup-menu].
-To kill the compilation, type \\[kill-compilation].
-
-Runs `compilation-mode-hook' with `run-hooks' (which see)."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map compilation-mode-map)
-  (setq major-mode 'compilation-mode
-	mode-name "Compilation")
-  (compilation-setup)
-  (font-lock-set-defaults)
-  (if (not name-of-mode) nil
-    (let ((sym (intern (concat name-of-mode "-mode-popup-menu"))))
-      (if (boundp sym)
-	  (setq mode-popup-menu (symbol-value sym))))
-    (if (featurep 'menubar)
-	(progn
-	  ;; make a local copy of the menubar, so our modes don't
-	  ;; change the global menubar
-	  (set-buffer-menubar current-menubar)
-	  (let ((sym (intern (concat name-of-mode "-mode-menubar-menu"))))
-	    (if (boundp sym)
-		(add-submenu nil (symbol-value sym)))))))
-  (run-hooks 'compilation-mode-hook))
-
-;; XEmacs addition, hacked by Mly
-(defun compilation-mode-motion-hook (event)
-  (mode-motion-highlight-internal
-    event
-    #'beginning-of-line
-    #'(lambda ()
-        (let* ((p (point))
-               (e (progn (end-of-line) (point)))
-               (l (progn
-                    (if (and compilation-mouse-motion-initiate-parsing
-                             (or (eq compilation-error-list 't)
-                                 (>= p compilation-parsing-end)))
-                        ;; #### Does it suck too badly to have mouse-movement
-                        ;; #### over a buffer parse errors in that buffer??
-                        (save-window-excursion
-                          (compile-reinitialize-errors nil p)))
-                    (if (and compilation-error-list
-                             (<= (car (car compilation-error-list)) p))
-                        ;; Perhaps save time by only searching tail
-                        compilation-error-list
-                        compilation-old-error-list))))
-          (if (catch 'found
-                (while l
-                  (let ((x (marker-position (car (car l)))))
-                    (cond ((< x p)
-                           (setq l (cdr l)))
-                          ((<= x e)
-                           (throw 'found t))
-                          (t
-                           (throw 'found nil)))))
-                nil)
-              (goto-char e)
-              (goto-char p))))))
-
-(defun compilation-setup ()
-  "Prepare the buffer for the compilation parsing commands to work."
-  ;; Make the buffer's mode line show process state.
-  (setq mode-line-process '(":%s"))
-  (set (make-local-variable 'compilation-error-list) nil)
-  (set (make-local-variable 'compilation-old-error-list) nil)
-  (set (make-local-variable 'compilation-parsing-end) 1)
-  (set (make-local-variable 'compilation-directory-stack) nil)
-  (make-local-variable 'compilation-error-screen-columns)
-  (setq compilation-last-buffer (current-buffer))
-  ;; XEmacs change: highlight lines, install menubar.
-  (require 'mode-motion)
-  (setq mode-motion-hook 'compilation-mode-motion-hook)
-  (make-local-hook 'mouse-track-click-hook)
-  (add-hook 'mouse-track-click-hook 'compile-mouse-maybe-goto-error t t))
-
-;;;###autoload
-(defvar compilation-shell-minor-mode nil
-  "Non-nil when in compilation-shell-minor-mode.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available but bound to keys that don't
-collide with Shell mode.")
-(make-variable-buffer-local 'compilation-shell-minor-mode)
-
-;;;###autoload
-(defvar compilation-minor-mode nil
-  "Non-nil when in compilation-minor-mode.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available.")
-(make-variable-buffer-local 'compilation-minor-mode)
-
-;;;###autoload
-(defun compilation-shell-minor-mode (&optional arg)
-  "Toggle compilation shell minor mode.
-With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
-Turning the mode on runs the normal hook `compilation-shell-minor-mode-hook'."
-  (interactive "P")
-  (if (setq compilation-shell-minor-mode (if (null arg)
-					     (null compilation-shell-minor-mode)
-					   (> (prefix-numeric-value arg) 0)))
-      (let ((mode-line-process))
-	(compilation-setup)
-	(run-hooks 'compilation-shell-minor-mode-hook)
-	(make-local-variable 'current-menubar)
-	(add-submenu nil
-		     (cons compilation-shell-minor-mode-menubar-menu-name
-			   (cdr compilation-shell-minor-mode-menubar-menu))))
-    (delete-menu-item (list compilation-shell-minor-mode-menubar-menu-name))))
-
-;;;###autoload
-(add-minor-mode 'compilation-shell-minor-mode
-		" Shell-Compile"
-		compilation-shell-minor-mode-map
-		'view-minor-mode
-		compilation-shell-minor-mode)
-
-;;;###autoload
-(defun compilation-minor-mode (&optional arg)
-  "Toggle compilation minor mode.
-With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
-! \\{compilation-mode-map}"
-  (interactive "P")
-  (if (setq compilation-minor-mode (if (null arg)
-				       (null compilation-minor-mode)
-				     (> (prefix-numeric-value arg) 0)))
-      (progn
-	(compilation-setup)
-	(run-hooks 'compilation-minor-mode-hook))))
-
-;;;###autoload
-(add-minor-mode 'compilation-minor-mode
-		" CMPL"
-		compilation-minor-mode-map
-		'view-minor-mode
-		compilation-minor-mode)
-
-(defun compilation-handle-exit (process-status exit-status msg)
-  "Write msg in the current buffer and hack its mode-line-process."
-  (let ((buffer-read-only nil)
-	(status (if compilation-exit-message-function
-		    (funcall compilation-exit-message-function
-			     process-status exit-status msg)
-		  (cons msg exit-status)))
-	(omax (point-max))
-	(opoint (point)))
-    ;; Record where we put the message, so we can ignore it
-    ;; later on.
-    (goto-char omax)
-    (insert ?\n mode-name " " (car status))
-    (forward-char -1)
-    (insert " at " (substring (current-time-string) 0 19))
-    (forward-char 1)
-    (setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
-    ;; Force mode line redisplay soon.
-    (force-mode-line-update)
-    (if (and opoint (< opoint omax))
-	(goto-char opoint))
-    (if compilation-finish-function
-	(funcall compilation-finish-function (current-buffer) msg))))
-
-;; Called when compilation process changes state.
-(defun compilation-sentinel (proc msg)
-  "Sentinel for compilation buffers."
-  ;; XEmacs change
-  (let* ((buffer (process-buffer proc))
-	 (window (get-buffer-window buffer)))
-    (if (memq (process-status proc) '(signal exit))
-	(progn
-	  (if (null (buffer-name buffer))
-	      ;; buffer killed
-	      (set-process-buffer proc nil)
-	    (let ((obuf (current-buffer))
-		  omax opoint estatus)
-	      ;; save-excursion isn't the right thing if
-	      ;; process-buffer is current-buffer
-	      (unwind-protect
-		  (progn
-		    ;; Write something in the compilation buffer
-		    ;; and hack its mode line.
-		    (set-buffer buffer)
-		    (let ((buffer-read-only nil)
-			  (status (if compilation-exit-message-function
-				      (funcall compilation-exit-message-function
-					       proc msg)
-				    (cons msg (process-exit-status proc)))))
-		      (setq omax (point-max)
-			    opoint (point))
-		      (goto-char omax)
-		      ;; Record where we put the message, so we can ignore it
-		      ;; later on.
-		      (insert ?\n mode-name " " (car status))
-		      (forward-char -1)
-		      (insert " at " (substring (current-time-string) 0 19))
-		      (forward-char 1)
-		      (setq mode-line-process
-			    (concat ":"
-				    (symbol-name (process-status proc))
-				    (if (zerop (process-exit-status proc))
-					" OK"
-					(setq estatus
-					      (format " [exit-status %d]"
-						      (process-exit-status proc))))
-				    ))
-		      ;; XEmacs - tedium should let you know when it's ended...
-		      (if (and (not compilation-always-signal-completion)
-			       window
-			       (pos-visible-in-window-p (point-max) window))
-			  nil		; assume that the user will see it...
-			(ding t 'ready)
-			(display-message
-			 'progress
-			 (format "Compilation process completed%s."
-				 (or estatus " successfully")
-				 )))
-		      ;; Since the buffer and mode line will show that the
-		      ;; process is dead, we can delete it now.  Otherwise it
-		      ;; will stay around until M-x list-processes.
-		      (delete-process proc)
-		      ;; Force mode line redisplay soon.
-		      (redraw-modeline))
-		    (if (and opoint (< opoint omax))
-			(goto-char opoint))
-		    (if compilation-finish-function
-			(funcall compilation-finish-function buffer msg)))
-		(set-buffer obuf))))
-	  (setq compilation-in-progress (delq proc compilation-in-progress))
-	  ))))
-
-(defun compilation-filter (proc string)
-  "Process filter for compilation buffers.
-Just inserts the text, but uses `insert-before-markers'."
-  (if (buffer-name (process-buffer proc))
-      (save-excursion
-	(set-buffer (process-buffer proc))
-	(let ((buffer-read-only nil))
-	  (save-excursion
-	    (goto-char (process-mark proc))
-	    (insert-before-markers string)
-	    (run-hooks 'compilation-filter-hook)
-	    (set-marker (process-mark proc) (point)))))))
-
-(defun compile-error-at-point ()
-  "Return the cdr of `compilation-old-error-list' for error containing point."
-  (compile-reinitialize-errors nil (point))
-  (let ((errors compilation-old-error-list))
-    (while (and errors
-		(> (point) (car (car errors))))
-      (setq errors (cdr errors)))
-    errors))
-
-(defsubst compilation-buffer-p (buffer)
-  (save-excursion
-    (set-buffer buffer)
-    (or compilation-shell-minor-mode compilation-minor-mode
-	(eq major-mode 'compilation-mode))))
-
-(defun compilation-next-error (n)
-  "Move point to the next error in the compilation buffer.
-Prefix arg N says how many error messages to move forwards (or
-backwards, if negative).
-Does NOT find the source line like \\[next-error]."
-  (interactive "p")
-  (or (compilation-buffer-p (current-buffer))
-      (error "Not in a compilation buffer"))
-  (setq compilation-last-buffer (current-buffer))
-
-  (let ((errors (compile-error-at-point)))
-
-    ;; Move to the error after the one containing point.
-    (goto-char (car (if (< n 0)
-			(let ((i 0)
-			      (e compilation-old-error-list))
-			  ;; See how many cdrs away ERRORS is from the start.
-			  (while (not (eq e errors))
-			    (setq i (1+ i)
-				  e (cdr e)))
-			  (if (> (- n) i)
-			      (error "Moved back past first error")
-			    (nth (+ i n) compilation-old-error-list)))
-		      (let ((compilation-error-list (cdr errors)))
-			(compile-reinitialize-errors nil nil n)
-			(if compilation-error-list
-			    (nth (1- n) compilation-error-list)
-			  (error "Moved past last error"))))))))
-
-(defun compilation-previous-error (n)
-  "Move point to the previous error in the compilation buffer.
-Prefix arg N says how many error messages to move backwards (or
-forwards, if negative).
-Does NOT find the source line like \\[next-error]."
-  (interactive "p")
-  (compilation-next-error (- n)))
-
-
-;; Given an elt of `compilation-error-list', return an object representing
-;; the referenced file which is equal to (but not necessarily eq to) what
-;; this function would return for another error in the same file.
-(defsubst compilation-error-filedata (data)
-  (setq data (cdr data))
-  (if (markerp data)
-      (marker-buffer data)
-    (car data)))
-
-;; Return a string describing a value from compilation-error-filedata.
-;; This value is not necessarily useful as a file name, but should be
-;; indicative to the user of what file's errors are being referred to.
-(defsubst compilation-error-filedata-file-name (filedata)
-  (if (bufferp filedata)
-      (buffer-file-name filedata)
-    (car filedata)))
-
-(defun compilation-next-file (n)
-  "Move point to the next error for a different file than the current one."
-  (interactive "p")
-  (or (compilation-buffer-p (current-buffer))
-      (error "Not in a compilation buffer"))
-  (setq compilation-last-buffer (current-buffer))
-
-  (let ((reversed (< n 0))
-	errors filedata)
-
-    (if (not reversed)
-	(setq errors (or (compile-error-at-point)
-			 (error "Moved past last error")))
-
-      ;; Get a reversed list of the errors up through the one containing point.
-      (compile-reinitialize-errors nil (point))
-      (setq errors (reverse compilation-old-error-list)
-	    n (- n))
-
-      ;; Ignore errors after point.  (car ERRORS) will be the error
-      ;; containing point, (cadr ERRORS) the one before it.
-      (while (and errors
-		  (< (point) (car (car errors))))
-	(setq errors (cdr errors))))
-
-    (while (> n 0)
-      (setq filedata (compilation-error-filedata (car errors)))
-
-      ;; Skip past the following errors for this file.
-      (while (equal filedata
-		    (compilation-error-filedata
-		     (car (or errors
-			      (if reversed
-				  (error "%s the first erring file"
-					 (compilation-error-filedata-file-name
-					  filedata))
-				(let ((compilation-error-list nil))
-				  ;; Parse some more.
-				  (compile-reinitialize-errors nil nil 2)
-				  (setq errors compilation-error-list)))
-			      (error "%s is the last erring file"
-				     (compilation-error-filedata-file-name
-				      filedata))))))
-	(setq errors (cdr errors)))
-
-      (setq n (1- n)))
-
-    ;; Move to the following error.
-    (goto-char (car (car (or errors
-			     (if reversed
-				 (error "This is the first erring file")
-			       (let ((compilation-error-list nil))
-				 ;; Parse the last one.
-				 (compile-reinitialize-errors nil nil 1)
-				 compilation-error-list))))))))
-
-(defun compilation-previous-file (n)
-  "Move point to the previous error for a different file than the current one."
-  (interactive "p")
-  (compilation-next-file (- n)))
-
-(defun kill-compilation ()
-  "Kill the process made by the \\[compile] command."
-  (interactive)
-  (let ((buffer (compilation-find-buffer)))
-    (if (get-buffer-process buffer)
-	(interrupt-process (get-buffer-process buffer))
-      (error "The compilation process is not running"))))
-
-
-;; Parse any new errors in the compilation buffer,
-;; or reparse from the beginning if the user has asked for that.
-(defun compile-reinitialize-errors (reparse
-                                    &optional limit-search find-at-least)
-  (save-excursion
-    ;; XEmacs change: Below we made a change to possibly change the
-    ;; selected window.  If we don't save and restore the old window
-    ;; then if we get an error such as 'no more errors' we'll end up
-    ;; in the compilation buffer.
-    (save-window-excursion
-      (set-buffer compilation-last-buffer)
-      ;; If we are out of errors, or if user says "reparse",
-      ;; discard the info we have, to force reparsing.
-      (if (or (eq compilation-error-list t)
-	      reparse)
-	  (compilation-forget-errors))
-      (if (and compilation-error-list
-	       (or (not limit-search)
-		 (> compilation-parsing-end limit-search))
-	     (or (not find-at-least)
-		 (>= (length compilation-error-list) find-at-least)))
-	;; Since compilation-error-list is non-nil, it points to a specific
-	;; error the user wanted.  So don't move it around.
-	nil
-
-      ;; XEmacs change: if the compilation buffer is already visible
-      ;; in a window, use that instead of thrashing the display.
-      (let ((w (get-buffer-window compilation-last-buffer)))
-	(if w
-	    (select-window w)
-	  (switch-to-buffer compilation-last-buffer)))
-
-      ;; This was here for a long time (before my rewrite); why? --roland
-      ;;(switch-to-buffer compilation-last-buffer)
-      (set-buffer-modified-p nil)
-      (if (< compilation-parsing-end (point-max))
-	  ;; compilation-error-list might be non-nil if we have a non-nil
-	  ;; LIMIT-SEARCH or FIND-AT-LEAST arg.  In that case its value
-	  ;; records the current position in the error list, and we must
-	  ;; preserve that after reparsing.
-	  (let ((error-list-pos compilation-error-list))
-	    (funcall compilation-parse-errors-function
-		     limit-search
-		     (and find-at-least
-			  ;; We only need enough new parsed errors to reach
-			  ;; FIND-AT-LEAST errors past the current
-			  ;; position.
-			  (- find-at-least (length compilation-error-list))))
-	    ;; Remember the entire list for compilation-forget-errors.  If
-	    ;; this is an incremental parse, append to previous list.  If
-	    ;; we are parsing anew, compilation-forget-errors cleared
-	    ;; compilation-old-error-list above.
-	    (setq compilation-old-error-list
-		  (nconc compilation-old-error-list compilation-error-list))
-	    (if error-list-pos
-		;; We started in the middle of an existing list of parsed
-		;; errors before parsing more; restore that position.
-		(setq compilation-error-list error-list-pos))
-	    ))))))
-
-;; XEmacs addition
-;; FSF has added this by 19.34, but it is highly complex, why? -sb
-(defun compile-mouse-goto-error (event)
-  "Visit the source for the error under the mouse.
-Use this command in a compilation log buffer."
-  (interactive "e")
-  (mouse-set-point event)
-  (beginning-of-line)
-  (compile-goto-error))
-
-(defun compile-goto-error (&optional argp)
-  "Visit the source for the error message point is on.
-Use this command in a compilation log buffer.  Sets the mark at point there.
-\\[universal-argument] as a prefix arg means to reparse the buffer's error messages first;
-other kinds of prefix arguments are ignored."
-  (interactive "P")
-  (or (compilation-buffer-p (current-buffer))
-      (error "Not in a compilation buffer"))
-  (setq compilation-last-buffer (current-buffer))
-  (compile-reinitialize-errors (consp argp) (point))
-
-  ;; Move to bol; the marker for the error on this line will point there.
-  (beginning-of-line)
-
-  ;; Move compilation-error-list to the elt of compilation-old-error-list
-  ;; we want.
-  (setq compilation-error-list compilation-old-error-list)
-  (while (and compilation-error-list
-	      (> (point) (car (car compilation-error-list))))
-    (setq compilation-error-list (cdr compilation-error-list)))
-
-  ;; Move to another window, so that next-error's window changes
-  ;; result in the desired setup.
-  (or (one-window-p)
-      (progn
-	(other-window -1)
-	;; other-window changed the selected buffer,
-	;; but we didn't want to do that.
-	(set-buffer compilation-last-buffer)))
-
-  (push-mark)
-  (next-error 1))
-
-;; XEmacs addition
-(defun compile-mouse-maybe-goto-error (event &optional click-count)
-  (interactive "e")
-  (if (equal (event-button event) 2)
-      (let ((buffer (current-buffer))
-	    (point (point))
-	    (config (current-window-configuration)))
-	(condition-case nil
-	    (progn
-	      (compile-mouse-goto-error event)
-	      t)
-	  (error
-	   (set-window-configuration config)
-	   (set-buffer buffer)
-	   (goto-char point)
-	   nil)))))
-
-;; Return a compilation buffer.
-;; If the current buffer is a compilation buffer, return it.
-;; If compilation-last-buffer is set to a live buffer, use that.
-;; Otherwise, look for a compilation buffer and signal an error
-;; if there are none.
-(defun compilation-find-buffer (&optional other-buffer)
-  (if (and (not other-buffer)
-	   (compilation-buffer-p (current-buffer)))
-      ;; The current buffer is a compilation buffer.
-      (current-buffer)
-    (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
-	     (compilation-buffer-p compilation-last-buffer)
-	     (or (not other-buffer) (not (eq compilation-last-buffer
-					     (current-buffer)))))
-	compilation-last-buffer
-      (let ((buffers (buffer-list)))
-	(while (and buffers (or (not (compilation-buffer-p (car buffers)))
-				(and other-buffer
-				     (eq (car buffers) (current-buffer)))))
-	  (setq buffers (cdr buffers)))
-	(if buffers
-	    (car buffers)
-	  (or (and other-buffer
-		   (compilation-buffer-p (current-buffer))
-		   ;; The current buffer is a compilation buffer.
-		   (progn
-		     (if other-buffer
-			 (message "This is the only compilation buffer."))
-		     (current-buffer)))
-	      (error "No compilation started!")))))))
-
-;;;###autoload
-(defun next-error (&optional argp)
-  "Visit next compilation error message and corresponding source code.
-
-If all the error messages parsed so far have been processed already,
-the message buffer is checked for new ones.
-
-A prefix ARGP specifies how many error messages to move;
-negative means move back to previous error messages.
-Just \\[universal-argument] as a prefix means reparse the error message buffer
-and start at the first error.
-
-\\[next-error] normally uses the most recently started compilation or
-grep buffer.  However, it can operate on any buffer with output from
-the \\[compile] and \\[grep] commands, or, more generally, on any
-buffer in Compilation mode or with Compilation Minor mode enabled.  To
-specify use of a particular buffer for error messages, type
-\\[next-error] in that buffer.
-
-Once \\[next-error] has chosen the buffer for error messages,
-it stays with that buffer until you use it in some other buffer which
-uses Compilation mode or Compilation Minor mode.
-
-See variables `compilation-parse-errors-function' and
-\`compilation-error-regexp-alist' for customization ideas."
-  (interactive "P")
-  (setq compilation-last-buffer (compilation-find-buffer))
-  (compilation-goto-locus (compilation-next-error-locus
-			   ;; We want to pass a number here only if
-			   ;; we got a numeric prefix arg, not just C-u.
-			   (and (not (consp argp))
-				(prefix-numeric-value argp))
-			   (consp argp))))
-;;;###autoload (define-key ctl-x-map "`" 'next-error)
-
-;; XEmacs change
-;;;###autoload
-(defun previous-error (&optional argp)
-  "Visit previous compilation error message and corresponding source code.
-
-A prefix ARGP specifies how many error messages to move;
-negative means move forward to next error messages.
-
-This operates on the output from the \\[compile] and \\[grep] commands."
-  (interactive "P")
-  (next-error (cond ((null argp) -1)
-		    ((numberp argp) (- argp))
-		    (t argp))))
-
-;;;###autoload
-(defun first-error ()
-  "Reparse the error message buffer and start at the first error.
-Visit corresponding source code.
-This operates on the output from the \\[compile] command."
-  (interactive)
-  (next-error '(4)))
-
-(defun compilation-next-error-locus (&optional move reparse silent)
-  "Visit next compilation error and return locus in corresponding source code.
-This operates on the output from the \\[compile] command.
-If all preparsed error messages have been processed,
-the error message buffer is checked for new ones.
-
-Returns a cons (ERROR . SOURCE) of two markers: ERROR is a marker at the
-location of the error message in the compilation buffer, and SOURCE is a
-marker at the location in the source code indicated by the error message.
-
-Optional first arg MOVE says how many error messages to move forwards (or
-backwards, if negative); default is 1.  Optional second arg REPARSE, if
-non-nil, says to reparse the error message buffer and reset to the first
-error (plus MOVE - 1).  If optional third argument SILENT is non-nil, return
-nil instead of raising an error if there are no more errors.
-
-The current buffer should be the desired compilation output buffer."
-  (or move (setq move 1))
-  (compile-reinitialize-errors reparse nil (and (not reparse)
-						(if (< move 1) 0 (1- move))))
-  (let (next-errors next-error)
-    (catch 'no-next-error
-      (save-excursion
-	(set-buffer compilation-last-buffer)
-	;; compilation-error-list points to the "current" error.
-	(setq next-errors
-	      (if (> move 0)
-		  (nthcdr (1- move)
-			  compilation-error-list)
-                ;; Zero or negative arg; we need to move back in the list.
-                (let ((n (1- move))
-                      (i 0)
-                      (e compilation-old-error-list))
-                  ;; See how many cdrs away the current error is from the start.
-                  (while (not (eq e compilation-error-list))
-                    (setq i (1+ i)
-                          e (cdr e)))
-                  (if (> (- n) i)
-                      (error "Moved back past first error")
-		    (nthcdr (+ i n) compilation-old-error-list))))
-	      next-error (car next-errors))
-	(while
-	    (if (null next-error)
-		(progn
-		  (and move (/= move 1)
-		       (error (if (> move 0)
-				  "Moved past last error"
-                                "Moved back past first error")))
-;; Forget existing error messages if compilation has finished.
-;;; XEmacs change by Barry Warsaw.
-;;; Without this, if you get a "no more errors" error, then you can't do
-;;; previous-error or goto-error until you kill the buffer.
-;		  (if (not (and (get-buffer-process (current-buffer))
-;				(eq (process-status
-;				     (get-buffer-process
-;				      (current-buffer)))
-;				    'run)))
-;		      (compilation-forget-errors))
-		  (if silent
-		      (throw 'no-next-error nil)
-		    (error (concat compilation-error-message
-				   (and (get-buffer-process (current-buffer))
-					(eq (process-status
-					     (get-buffer-process
-					      (current-buffer)))
-					    'run)
-					" yet")))))
-	      (setq compilation-error-list (cdr next-errors))
-	      (if (null (cdr next-error))
-		  ;; This error is boring.  Go to the next.
-		  t
-		(or (markerp (cdr next-error))
-		    ;; This error has a filename/lineno pair.
-		    ;; Find the file and turn it into a marker.
-		    (let* ((fileinfo (car (cdr next-error)))
-			   (cbuf (current-buffer)) ;XEmacs addition
-			   (buffer (apply 'compilation-find-file
-					  (car next-error) fileinfo)))
-		      (if (null buffer)
-			  ;; We can't find this error's file.
-			  ;; Remove all errors in the same file.
-			  (progn
-			    (setq next-errors compilation-old-error-list)
-			    (while next-errors
-			      (and (consp (cdr (car next-errors)))
-				   (equal (car (cdr (car next-errors)))
-					  fileinfo)
-				   (progn
-				     (set-marker (car (car next-errors)) nil)
-				     (setcdr (car next-errors) nil)))
-			      (setq next-errors (cdr next-errors)))
-			    ;; Look for the next error.
-			    t)
-			;; We found the file.  Get a marker for this error.
-			;; compilation-old-error-list and
-			;; compilation-error-screen-columns are buffer-local
-			;; so we must be careful to extract their value
-			;; before switching to the source file buffer.
-			(let ((errors compilation-old-error-list)
-			      (columns compilation-error-screen-columns)
-			      (last-line (nth 1 (cdr next-error)))
-			      (column (nth 2 (cdr next-error))))
-			  (set-buffer buffer)
-			  (save-excursion
-			    (save-restriction
-			      (widen)
-			      (goto-line last-line)
-			      (if (and column (> column 0))
-				  ;; Columns in error msgs are 1-origin.
-				  (if columns
-				      (move-to-column (1- column))
-				    (forward-char (1- column)))
-				(beginning-of-line))
-			      (setcdr next-error (point-marker))
-			      ;; Make all the other error messages referring
-			      ;; to the same file have markers into the buffer.
-			      (while errors
-				(and (consp (cdr (car errors)))
-				     (equal (car (cdr (car errors))) fileinfo)
-				     (let* ((this (nth 1 (cdr (car errors))))
-					    (column (nth 2 (cdr (car errors))))
-					    (lines (- this last-line)))
-				       (if (eq selective-display t)
-					   ;; When selective-display is t,
-					   ;; each C-m is a line boundary,
-					   ;; as well as each newline.
-					   (if (< lines 0)
-					       (re-search-backward "[\n\C-m]"
-								   nil 'end
-								   (- lines))
-					     (re-search-forward "[\n\C-m]"
-								nil 'end
-								lines))
-					 (forward-line lines))
-				       (if (and column (> column 1))
-					   (if columns
-					       (move-to-column (1- column))
-					     (forward-char (1- column)))
-					 (beginning-of-line))
-				       (setq last-line this)
-				       (setcdr (car errors) (point-marker))))
-				(setq errors (cdr errors)))))
-			  ;; XEmacs addition
-			  (set-buffer cbuf)))))
-                ;; If we didn't get a marker for this error, or this
-                ;; marker's buffer was killed, go on to the next one.
-                (or (not (markerp (cdr next-error)))
-                    (not (marker-buffer (cdr next-error))))))
-	  (setq next-errors compilation-error-list
-		next-error (car next-errors)))
-
-	;; XEmacs -- move this inside save-excursion
-	;; Skip over multiple error messages for the same source location,
-	;; so the next C-x ` won't go to an error in the same place.
-	(while (and compilation-error-list
-		    (equal (cdr (car compilation-error-list))
-			   (cdr next-error)))
-	  (setq compilation-error-list (cdr compilation-error-list)))
-	))
-
-    ;; XEmacs change: If a new window has to be displayed, select the other
-    ;; window to avoid swapping the position of the compilation error buffer.
-    (and next-error (get-buffer-window (marker-buffer (car next-error)))
-         (progn
-           (select-window (get-buffer-window (marker-buffer (car next-error))))
-           (other-window -1)))
-	  
-    ;; We now have a marker for the position of the error source code.
-    ;; NEXT-ERROR is a cons (ERROR . SOURCE) of two markers.
-    next-error))
-
-(defun compilation-goto-locus (next-error)
-  "Jump to an error locus returned by `compilation-next-error-locus'.
-Takes one argument, a cons (ERROR . SOURCE) of two markers.
-Selects a window with point at SOURCE, with another window displaying ERROR."
-;; XEmacs: this code is horrendous, and makes windows do all sorts of
-;; weird things when you're using separate frames for the compilation
-;; and source buffer.
-;  (if (and (window-dedicated-p (selected-window))
-;	   (eq (selected-window) (frame-root-window)))
-;      (switch-to-buffer-other-frame (marker-buffer (cdr next-error)))
-;    (switch-to-buffer (marker-buffer (cdr next-error))))
-;  (goto-char (cdr next-error))
-;  ;; If narrowing got in the way of
-;  ;; going to the right place, widen.
-;  (or (= (point) (marker-position (cdr next-error)))
-;      (progn
-;        (widen)
-;        (goto-char (cdr next-error))))
-;
-;  ;; Show compilation buffer in other window, scrolled to this error.
-;  (let* ((pop-up-windows t)
-;	 (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible)
-;		(display-buffer (marker-buffer (car next-error))))))
-;    (set-window-point w (car next-error))
-;    (set-window-start w (car next-error))
-;    (compilation-set-window-height w)))
-
-  (let* ((pop-up-windows t)
-	 (compilation-buffer (marker-buffer (car next-error)))
-	 (source-buffer (marker-buffer (cdr next-error)))
-	 ;; make sure compilation buffer is visible ...
-	 (compilation-window
-	 ;; Use an existing window if it is in a visible frame.
-	  (or (get-buffer-window compilation-buffer 'visible)
-	      ;; Pop up a window.
-	      (display-buffer compilation-buffer))))
-
-    ;; now, make the compilation buffer **STAY WHERE IT IS** and
-    ;; make sure the source buffer is visible
-
-    (select-window compilation-window)
-    (pop-to-buffer source-buffer)
-
-    ;; now put things aright in the compilation window.
-    (set-window-point compilation-window (car next-error))
-    (set-window-start compilation-window (car next-error))
-    (compilation-set-window-height compilation-window)
-
-    ;; now put things aright in the source window.
-
-    (set-buffer source-buffer)
-    (goto-char (cdr next-error))
-    ;; If narrowing got in the way of
-    ;; going to the right place, widen.
-    (or (= (point) (marker-position (cdr next-error)))
-	(progn
-	  (widen)
-	  (goto-char (cdr next-error))))))
-    
-
-;; helper routine to compilation-find-file
-(defun compare-file-to-buffer (filename buffer)
-  "compare BUFFER to FILENAME and see if they are really the same. Returns nil
-if not, BUFFER if they are"
-  (interactive "FCompare FILE : 
-bTo BUFFER : ")
-  ;; (print (format "%s %s " buffer filename))
-  (if (and (stringp filename) (bufferp buffer))
-      (save-excursion
-	(set-buffer buffer)
-	(if (equal (file-truename (buffer-file-name))
-		   (file-truename filename))
-	    buffer
-	  nil))
-    nil)
-)
-
-;; Find a buffer for file FILENAME.
-;; Search the directories in compilation-search-path.
-;; A nil in compilation-search-path means to try the
-;; current directory, which is passed in DIR.
-;; If FILENAME is not found at all, ask the user where to find it.
-;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user.
-(defun compilation-find-file (marker filename dir &rest formats)
-    (or formats (setq formats '("%s")))
-    (let* ((dirs compilation-search-path)
-	   (true-file-name (file-name-nondirectory filename))
-	   (buffer (get-buffer true-file-name)) 
-	   thisdir fmts name)
-      (flet ((push-file-name-history (name)
-	       (setq file-name-history
-		     (if minibuffer-history-uniquify
-			 (cons name (remove name file-name-history))
-		       (cons name file-name-history)))))
-	;; first see if buffer is there already
-	(if (compare-file-to-buffer buffer filename)
-	    (switch-to-buffer buffer)
-	  (progn
-	    (setq buffer nil) ; its the wrong buffer, so forget it
-	    (if (file-name-absolute-p filename)
-		;; The file name is absolute.  Use its explicit directory as
-		;; the first in the search path, and strip it from FILENAME.
-		(setq filename (abbreviate-file-name (expand-file-name filename))
-		      dirs (cons (file-name-directory filename) dirs)
-		      filename (file-name-nondirectory filename)))
-	    ;; Now search the path.
-	    (while (and dirs (null buffer))
-	      (setq thisdir (or (car dirs) dir)
-		    fmts formats)
-	      ;; For each directory, try each format string.
-	      (while (and fmts (null buffer))
-		(setq name (expand-file-name (format (car fmts) filename) thisdir)
-		      buffer (and (file-exists-p name)
-				  (progn
-				    (push-file-name-history name)
-				    (find-file-noselect name)))
-		    fmts (cdr fmts)))
-	    (setq dirs (cdr dirs)))
-	  (or buffer
-	      ;; The file doesn't exist.
-	      ;; Ask the user where to find it.
-	      ;; If he hits C-g, then the next time he does
-	      ;; next-error, he'll skip past it.
-	      (let* ((pop-up-windows t)
-		     (w (display-buffer (marker-buffer marker))))
-		(set-window-point w marker)
-		(set-window-start w marker)
-		(let ((name (expand-file-name
-			     (read-file-name
-			      (format "Find this error in: (default %s) "
-				      filename)
-			      dir filename t))))
-		  (if (file-directory-p name)
-		    (setq name (expand-file-name filename name)))
-		  (and (file-exists-p name)
-		       (progn
-			 (push-file-name-history name)
-			 (find-file-noselect name)))))))))))
-
-;; Set compilation-error-list to nil, and unchain the markers that point to the
-;; error messages and their text, so that they no longer slow down gap motion.
-;; This would happen anyway at the next garbage collection, but it is better to
-;; do it right away.
-(defun compilation-forget-errors ()
-  (while compilation-old-error-list
-    (let ((next-error (car compilation-old-error-list)))
-      (set-marker (car next-error) nil)
-      (if (markerp (cdr next-error))
-	  (set-marker (cdr next-error) nil)))
-    (setq compilation-old-error-list (cdr compilation-old-error-list)))
-  (setq compilation-error-list nil
-	compilation-directory-stack nil
-	compilation-parsing-end 1))
-
-
-(defun count-regexp-groupings (regexp)
-  "Return the number of \\( ... \\) groupings in REGEXP (a string)."
-  (let ((groupings 0)
-	(len (length regexp))
-	(i 0)
-	c)
-    (while (< i len)
-      (setq c (aref regexp i)
-	    i (1+ i))
-      (cond ((= c ?\[)
-	     ;; Find the end of this [...].
-	     (while (and (< i len)
-			 (not (= (aref regexp i) ?\])))
-	       (setq i (1+ i))))
-	    ((= c ?\\)
-	     (if (< i len)
-		 (progn
-		   (setq c (aref regexp i)
-			 i (1+ i))
-		   (if (= c ?\))
-		       ;; We found the end of a grouping,
-		       ;; so bump our counter.
-		       (setq groupings (1+ groupings))))))))
-    groupings))
-
-(defun compilation-parse-errors (limit-search find-at-least)
-  "Parse the current buffer as grep, cc or lint error messages.
-See variable `compilation-parse-errors-function' for the interface it uses."
-  (setq compilation-error-list nil)
-  (display-message 'progress "Parsing error messages...")
-  (let (;;text-buffer -- unused
-	orig orig-expanded parent-expanded
-	regexp enter-group leave-group error-group
-	alist subexpr error-regexp-groups
-	(found-desired nil)
-	(compilation-num-errors-found 0)
-        (message-freq (max 1 (/ (count-lines (point-min) (point-max)) 50))))
-
-    ;; Don't reparse messages already seen at last parse.
-    (goto-char compilation-parsing-end)
-    ;; Don't parse the first two lines as error messages.
-    ;; This matters for grep.
-    (if (bobp)
-	(progn
-	  (forward-line 2)
-	  ;; Move back so point is before the newline.
-	  ;; This matters because some error regexps use \n instead of ^
-	  ;; to be faster.
-	  (forward-char -1)))
-
-    ;; Compile all the regexps we want to search for into one.
-    (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|"
-			 "\\(" compilation-leave-directory-regexp "\\)\\|"
-			 "\\(" (mapconcat (function
-					   (lambda (elt)
-					     (concat "\\(" (car elt) "\\)")))
-					  compilation-error-regexp-alist
-					  "\\|") "\\)"))
-
-    ;; Find out how many \(...\) groupings are in each of the regexps, and set
-    ;; *-GROUP to the grouping containing each constituent regexp (whose
-    ;; subgroups will come immediately thereafter) of the big regexp we have
-    ;; just constructed.
-    (setq enter-group 1
-	  leave-group (+ enter-group
-			 (count-regexp-groupings
-			  compilation-enter-directory-regexp)
-			 1)
-	  error-group (+ leave-group
-			 (count-regexp-groupings
-			  compilation-leave-directory-regexp)
-			 1))
-
-    ;; Compile an alist (IDX FILE LINE [COL]), where IDX is the number of
-    ;; the subexpression for an entire error-regexp, and FILE and LINE (and
-    ;; possibly COL) are the numbers for the subexpressions giving the file
-    ;; name and line number (and possibly column number).
-    (setq alist (or compilation-error-regexp-alist
-		    (error "compilation-error-regexp-alist is empty!"))
-	  subexpr (1+ error-group))
-    (while alist
-      (setq error-regexp-groups
-	    (cons (list subexpr
-			(+ subexpr (nth 1 (car alist)))
-			(+ subexpr (nth 2 (car alist)))
-			;;#### This is buggy in FSFmacs
-			(let ((col (nth 3 (car alist))))
-			  (and col
-			       (+ subexpr col))))
-		  error-regexp-groups))
-      (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
-      (setq alist (cdr alist)))
-
-    ;; Set up now the expanded, abbreviated directory variables
-    ;; that compile-abbreviate-directory will need, so we can
-    ;; compute them just once here.
-    (setq orig (abbreviate-file-name default-directory)
-	  orig-expanded (abbreviate-file-name
-			 (file-truename default-directory))
-	  parent-expanded (abbreviate-file-name
-			   (expand-file-name "../" orig-expanded)))
-
-    (while (and (not found-desired)
-		;; We don't just pass LIMIT-SEARCH to re-search-forward
-		;; because we want to find matches containing LIMIT-SEARCH
-		;; but which extend past it.
-		;; Instead of using re-search-forward,
-		;; we use this loop which tries only at each line.
-		(progn
-		  (while (and (not (eobp))
-			      (not (looking-at regexp)))
-		    (forward-line 1))
-		  (not (eobp))))
-
-      ;; Move to the end of the match we just found.
-      (goto-char (match-end 0))
-
-      ;; Figure out which constituent regexp matched.
-      (cond ((match-beginning enter-group)
-	     ;; The match was the enter-directory regexp.
-	     (let ((dir
-		    (file-name-as-directory
-		     (expand-file-name
-		      (buffer-substring (match-beginning (+ enter-group 1))
-					(match-end (+ enter-group 1)))))))
-	       ;; The directory name in the "entering" message
-	       ;; is a truename.  Try to convert it to a form
-	       ;; like what the user typed in.
-	       (setq dir
-		     (compile-abbreviate-directory dir orig orig-expanded
-						   parent-expanded))
-	       (setq compilation-directory-stack
-		     (cons dir compilation-directory-stack))
-	       (and (file-directory-p dir)
-		    (setq default-directory dir)))
-
-	     (and limit-search (>= (point) limit-search)
-		  ;; The user wanted a specific error, and we're past it.
-		  ;; We do this check here (and in the leave-group case)
-		  ;; rather than at the end of the loop because if the last
-		  ;; thing seen is an error message, we must carefully
-		  ;; discard the last error when it is the first in a new
-		  ;; file (see below in the error-group case).
-		  (setq found-desired t)))
-	    
-	    ((match-beginning leave-group)
-	     ;; The match was the leave-directory regexp.
-	     (let ((beg (match-beginning (+ leave-group 1)))
-		   (stack compilation-directory-stack))
-	       (if beg
-		   (let ((dir
-			  (file-name-as-directory
-			   (expand-file-name
-			    (buffer-substring beg
-					      (match-end (+ leave-group
-							    1)))))))
-		     ;; The directory name in the "leaving" message
-		     ;; is a truename.  Try to convert it to a form
-		     ;; like what the user typed in.
-		     (setq dir
-			   (compile-abbreviate-directory dir orig orig-expanded
-							 parent-expanded))
-		     (while (and stack
-				 (not (string-equal (car stack) dir)))
-		       (setq stack (cdr stack)))))
-	       (setq compilation-directory-stack (cdr stack))
-	       (setq stack (car compilation-directory-stack))
-	       (if stack
-		   (setq default-directory stack))
-	       )
-
-	     (and limit-search (>= (point) limit-search)
-		  ;; The user wanted a specific error, and we're past it.
-		  ;; We do this check here (and in the enter-group case)
-		  ;; rather than at the end of the loop because if the last
-		  ;; thing seen is an error message, we must carefully
-		  ;; discard the last error when it is the first in a new
-		  ;; file (see below in the error-group case).
-		  (setq found-desired t)))
-	    
-	    ((match-beginning error-group)
-	     ;; The match was the composite error regexp.
-	     ;; Find out which individual regexp matched.
-	     (setq alist error-regexp-groups)
-	     (while (and alist
-			 (null (match-beginning (car (car alist)))))
-	       (setq alist (cdr alist)))
-	     (if alist
-		 (setq alist (car alist))
-	       (error "compilation-parse-errors: impossible regexp match!"))
-	     
-	     ;; Extract the file name and line number from the error message.
-	     (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes
-		   (filename (buffer-substring (match-beginning (nth 1 alist))
-					       (match-end (nth 1 alist))))
-		   (linenum (string-to-int
-			     (buffer-substring
-			      (match-beginning (nth 2 alist))
-			      (match-end (nth 2 alist)))))
-		   (column (and (nth 3 alist)
-				(match-beginning (nth 3 alist))
-				(string-to-int
-				 (buffer-substring
-				  (match-beginning (nth 3 alist))
-				  (match-end (nth 3 alist)))))))
-
-	       ;; Check for a comint-file-name-prefix and prepend it if
-	       ;; appropriate.  (This is very useful for
-	       ;; compilation-minor-mode in an rlogin-mode buffer.)
-	       (and (boundp 'comint-file-name-prefix)
-		    ;; If the file name is relative, default-directory will
-		    ;; already contain the comint-file-name-prefix (done by
-		    ;; compile-abbreviate-directory).
-		    (file-name-absolute-p filename)
-		    (setq filename (concat comint-file-name-prefix filename)))
-
-	       ;; Some compilers (e.g. Sun's java compiler, reportedly)
-	       ;; produce bogus file names like "./bar//foo.c" for the file
-	       ;; "bar/foo.c"; expand-file-name will collapse these into
-	       ;; "/foo.c" and fail to find the appropriate file.  So we look
-	       ;; for doubled slashes in the file name and fix them up in the
-	       ;; buffer.
-	       (when (fboundp 'command-line-normalize-file-name)
-		 (setq filename (command-line-normalize-file-name filename)))
-	       (setq filename (cons filename (cons default-directory
-						   (nthcdr 4 alist))))
-				     
-
-	       ;; Locate the erring file and line.
-	       ;; Cons a new elt onto compilation-error-list,
-	       ;; giving a marker for the current compilation buffer
-	       ;; location, and the file and line number of the error.
-	       (save-excursion
-		 ;; Save as the start of the error the beginning of the
-		 ;; line containing the match unless the match starts at a
-		 ;; newline, in which case the beginning of the next line.
-		 (goto-char beginning-of-match)
-		 (forward-line (if (eolp) 1 0))
-		 (let ((this (cons (point-marker)
-				   (list filename linenum column))))
-		   ;; Don't add the same source line more than once.
-		   (if (equal (cdr this) (cdr (car compilation-error-list)))
-		       nil
-		     (setq compilation-error-list
-			   (cons this
-				 compilation-error-list))
-		     (setq compilation-num-errors-found
-			   (1+ compilation-num-errors-found)))))
-	       (and (or (and find-at-least (> compilation-num-errors-found
-					      find-at-least))
-			(and limit-search (>= (point) limit-search)))
-		    ;; We have found as many new errors as the user wants,
-		    ;; or past the buffer position he indicated.  We
-		    ;; continue to parse until we have seen all the
-		    ;; consecutive errors in the same file, so the error
-                    ;; positions will be recorded as markers in this buffer
-                    ;; that might change.
-		    (cdr compilation-error-list) ; Must check at least two.
-		    (not (equal (car (cdr (nth 0 compilation-error-list)))
-				(car (cdr (nth 1 compilation-error-list)))))
-		    (progn
-		      ;; Discard the error just parsed, so that the next
-		      ;; parsing run can get it and the following errors in
-		      ;; the same file all at once.  If we didn't do this, we
-		      ;; would have the same problem we are trying to avoid
-		      ;; with the test above, just delayed until the next run!
-		      (setq compilation-error-list
-			    (cdr compilation-error-list))
-		      (goto-char beginning-of-match)
-		      (setq found-desired t)))
-	       )
-	     )
-	    (t
-	     (error "compilation-parse-errors: known groups didn't match!")))
-
-      (when (= (% compilation-num-errors-found message-freq) 0)
-        (display-message
-	 'progress
-	 (format "Parsing error messages...%d (%.0f%% of buffer)"
-                 compilation-num-errors-found
-                 ;; Use floating-point because (* 100 (point)) frequently
-                 ;; exceeds the range of Emacs Lisp integers.
-                 (/ (* 100.0 (point)) (point-max)))))
-
-;;; This is broken - it foils the logic above which is supposed to ensure
-;;; that all errors for the current file are found before we quit. 
-;      (and limit-search (>= (point) limit-search)
-;	   ;; The user wanted a specific error, and we're past it.
-;	   (setq found-desired t))
-      )
-    (setq compilation-parsing-end (if found-desired
-				      (point)
-				    ;; We have searched the whole buffer.
-				    (point-max))))
-  (setq compilation-error-list (nreverse compilation-error-list))
-  (display-message 'progress "Parsing error messages...done"))
-
-(defun compile-buffer-substring (index)
-  "Get substring matched by INDEXth subexpression."
-  (if index
-      (let ((beg (match-beginning index)))
-	(if beg (buffer-substring beg (match-end index))))))
-
-;; If directory DIR is a subdir of ORIG or of ORIG's parent,
-;; return a relative name for it starting from ORIG or its parent.
-;; ORIG-EXPANDED is an expanded version of ORIG.
-;; PARENT-EXPANDED is an expanded version of ORIG's parent.
-;; Those two args could be computed here, but we run faster by
-;; having the caller compute them just once.
-(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded)
-  ;; Apply canonical abbreviations to DIR first thing.
-  ;; Those abbreviations are already done in the other arguments passed.
-  (setq dir (abbreviate-file-name dir))
-
-  ;; Check for a comint-file-name-prefix and prepend it if appropriate.
-  ;; (This is very useful for compilation-minor-mode in an rlogin-mode
-  ;; buffer.)
-  (if (boundp 'comint-file-name-prefix)
-      (setq dir (concat comint-file-name-prefix dir)))
-
-  (if (and (> (length dir) (length orig-expanded))
-	   (string= orig-expanded
-		    (substring dir 0 (length orig-expanded))))
-      (setq dir
-	    (concat orig
-		    (substring dir (length orig-expanded)))))
-  (if (and (> (length dir) (length parent-expanded))
-	   (string= parent-expanded
-		    (substring dir 0 (length parent-expanded))))
-    (setq dir
-	  (concat (file-name-directory
-		   (directory-file-name orig))
-		  (substring dir (length parent-expanded)))))
-  dir)
-
-(provide 'compile)
-
-;;; compile.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/custom-load.el b/xemacs-packages/lisp/xemacs-base/custom-load.el
deleted file mode 100644
index 152b4e36..00000000
--- a/xemacs-packages/lisp/xemacs-base/custom-load.el
+++ /dev/null
@@ -1,40 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'extensions '("time-stamp"))
-(custom-add-loads 'change-log '("add-log"))
-(custom-add-loads 'shell '("shell"))
-(custom-add-loads 'comint-completion '("comint"))
-(custom-add-loads 'comint '("comint-xemacs" "comint"))
-(custom-add-loads 'tools '("add-log" "compile"))
-(custom-add-loads 'shell-faces '("shell"))
-(custom-add-loads 'time-stamp '("time-stamp"))
-(custom-add-loads 'keyboard '("edmacro"))
-(custom-add-loads 'data '("sort" "time-stamp"))
-(custom-add-loads 'sort '("sort"))
-(custom-add-loads 'frames '("imenu"))
-(custom-add-loads 'shell-directories '("shell"))
-(custom-add-loads 'programming '("compile"))
-(custom-add-loads 'compilation '("compile"))
-(custom-add-loads 'comint-source '("comint"))
-(custom-add-loads 'debugger '("debug"))
-(custom-add-loads 'maint '("add-log"))
-(custom-add-loads 'field '("field"))
-(custom-add-loads 'edmacro '("edmacro"))
-(custom-add-loads 'imenu '("imenu"))
-(custom-add-loads 'debug '("debug"))
-(custom-add-loads 'faces '("facemenu"))
-(custom-add-loads 'passwd '("passwd"))
-(custom-add-loads 'enriched '("enriched"))
-(custom-add-loads 'processes '("comint-xemacs" "compile" "passwd" "shell"))
-(custom-add-loads 'ffap '("ffap"))
-(custom-add-loads 'wp '("enriched"))
-(custom-add-loads 'editing '("field"))
-(custom-add-loads 'matching '("ffap" "imenu"))
-(custom-add-loads 'unix '("shell"))
-(custom-add-loads 'facemenu '("facemenu"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/debug.el b/xemacs-packages/lisp/xemacs-base/debug.el
deleted file mode 100644
index f6977d9f..00000000
--- a/xemacs-packages/lisp/xemacs-base/debug.el
+++ /dev/null
@@ -1,827 +0,0 @@
-;;; debug.el --- debuggers and related commands for XEmacs
-
-;; Copyright (C) 1985, 1986, 1994, 2001 Free Software Foundation, Inc.
-
-;; Maintainer: XEmacs Development Team
-;; Keyword: lisp, tools
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;; NB: There are lots of formatting changes in the XEmacs version. -slb
-
-;; 06/11/1997 - Converted to use char-after instead of broken
-;;  following-char. -slb
-
-;; This is a major mode documented in the Emacs manual.
-
-;;; Code:
-
-;; #### not yet implemented (require 'button)
-
-(defgroup debugger nil
-  "Debuggers and related commands for Emacs."
-  :prefix "debugger-"
-  :group 'debug)
-
-(defcustom debugger-mode-hook nil
-  "*Hooks run when `debugger-mode' is turned on."
-  :type 'hook
-  :group 'debugger
-  :version "20.3")
-
-(defcustom debugger-batch-max-lines 40
-  "*Maximum lines to show in debugger buffer in a noninteractive Emacs.
-When the debugger is entered and Emacs is running in batch mode,
-if the backtrace text has more than this many lines,
-the middle is discarded, and just the beginning and end are displayed."
-  :type 'integer
-  :group 'debugger
-  :version "21.1")
-
-(defcustom debug-function-list nil
-  "List of functions currently set for debug on entry."
-  :type '(repeat function)
-  :group 'debugger)
-
-(defcustom debugger-step-after-exit nil
-  "Non-nil means \"single-step\" after the debugger exits."
-  :type 'boolean
-  :group 'debugger)
-
-(defvar debugger-value nil
-  "This is the value for the debugger to return, when it returns.")
-
-(defvar debugger-old-buffer nil
-  "This is the buffer that was current when the debugger was entered.")
-
-(defvar debugger-previous-backtrace nil
-  "The contents of the previous backtrace (including text properties).
-This is to optimize `debugger-make-xrefs'.")
-
-;;#### This is terminally random and nigh-unmaintainable.
-;;####  (need progv in elisp...)
-(defvar debugger-outer-match-data)
-(defvar debugger-outer-load-read-function)
-(defvar debugger-outer-overriding-local-map)
-(defvar debugger-outer-overriding-terminal-local-map)
-;; FSFmacs (defvar debugger-outer-track-mouse)
-(defvar debugger-outer-last-command)
-(defvar debugger-outer-this-command)
-(defvar debugger-outer-unread-command-event)
-;; but we still save and restore it
-;; in case some user program still tries to set it.
-;; FSF: (defvar debugger-outer-unread-command-char)
-(defvar debugger-outer-unread-command-events)
-;; FSF (defvar debugger-outer-unread-post-input-method-events)
-(defvar debugger-outer-last-input-event)
-(defvar debugger-outer-last-input-char)
-(defvar debugger-outer-last-input-time)
-(defvar debugger-outer-last-command-event)
-;; FSF (defvar debugger-outer-last-nonmenu-event)
-;; FSF (defvar debugger-outer-last-event-frame)
-(defvar debugger-outer-last-command-char)
-(defvar debugger-outer-standard-input)
-(defvar debugger-outer-standard-output)
-;; FSF (defvar debugger-outer-inhibit-redisplay)
-(defvar debugger-outer-cursor-in-echo-area)
-
-;;;don't ###autoload, loadup.el does something smarter.
-(setq debugger 'debug)
-
-(defvar debugger-step-after-exit)
-(defvar debugger-old-buffer)
-(defvar debugger-value)
-
-;;;###autoload
-(defun debug (&rest debugger-args)
-  "Enter debugger.  To return, type \\`\\[debugger-continue]'.
-Arguments are mainly for use when this is called from the internals
-of the evaluator.
-
-You may call with no args, or you may pass nil as the first arg and
-any other args you like.  In that case, the list of args after the
-first will be printed into the backtrace buffer."
-  (interactive)
-  ;; FSF: (we handle this at the C level)
-;   (if inhibit-redisplay
-;       ;; Don't really try to enter debugger within an eval from redisplay.
-;       debugger-value
-  ;; XEmacs: it doesn't work to enter the debugger non-interactively
-  ;; so just print out a backtrace and exit.
-  (if (noninteractive) (apply 'early-error-handler debugger-args))
-  (message "Entering debugger...")
-  (let (debugger-value
-	(debug-on-error nil)
-	(debug-on-quit nil)
-	(debug-on-signal nil)	; XEmacs
-	(debugger-buffer (let ((default-major-mode 'fundamental-mode))
-			   (get-buffer-create "*Backtrace*")))
-	;; #### I18N3 set the debugger-buffer to output-translating
-	(debugger-old-buffer (current-buffer))
-	(debugger-step-after-exit nil)
-	;; Don't keep reading from an executing kbd macro!
-	(executing-kbd-macro nil)
-	;; Save the outer values of these vars for the `e' command
-	;; before we replace the values.
-	(debugger-outer-match-data (match-data))
-	(debugger-outer-load-read-function load-read-function)
-	(debugger-outer-overriding-local-map overriding-local-map)
- 	(debugger-outer-overriding-terminal-local-map
- 	 overriding-terminal-local-map)
-	;; FSFmacs (debugger-outer-track-mouse track-mouse)
-	(debugger-outer-last-command last-command)
-	(debugger-outer-this-command this-command)
-	(debugger-outer-unread-command-event unread-command-event)
-	(debugger-outer-unread-command-events unread-command-events)
-; 	(debugger-outer-unread-post-input-method-events
-; 	 unread-post-input-method-events)
-	(debugger-outer-last-input-event last-input-event)
-	(debugger-outer-last-input-char last-input-char)
-	(debugger-outer-last-input-time last-input-time)
-	(debugger-outer-last-command-event last-command-event)
-	;; (debugger-outer-last-nonmenu-event last-nonmenu-event)
-	;; (debugger-outer-last-event-frame last-event-frame)
-	(debugger-outer-last-command-char last-command-char)
-	(debugger-outer-standard-input standard-input)
-	(debugger-outer-standard-output standard-output)
-	;; (debugger-outer-inhibit-redisplay inhibit-redisplay)
-	(debugger-outer-cursor-in-echo-area cursor-in-echo-area))
-    ;; Set this instead of binding it, so that `q'
-    ;; will not restore it.
-    (setq overriding-terminal-local-map nil) 
-    ;; Don't let these magic variables affect the debugger itself.
-    (unwind-protect                     ;XEmacs change
-	(let ((last-command nil)
-	      (this-command nil)
-	      (unread-command-event nil)
-	      (unread-command-events nil)
-	      ; (unread-post-input-method-events nil)
-	      (last-input-event (make-event))
-	      (last-input-char -1)
-	      (last-input-time nil)
-	      (last-command-event (make-event))
-	      (last-command-char -1)
-	      overriding-local-map
-	      load-read-function
-	      ;; If we are inside a minibuffer, allow nesting
-	      ;; so that we don't get an error from the `e' command.
-	      (enable-recursive-minibuffers
-	       (or enable-recursive-minibuffers (> (minibuffer-depth) 0)))
-	      (standard-input t)
-	      (standard-output t)
-	      ;; inhibit-redisplay
-	      (cursor-in-echo-area nil))
-	  (save-excursion
-	    (save-window-excursion
-	      (pop-to-buffer debugger-buffer)
-	      (debugger-mode)
-	      (debugger-setup-buffer debugger-args)
-	      (when noninteractive
-		;; If the backtrace is long, save the beginning
-		;; and the end, but discard the middle.
-		(when (> (count-lines (point-min) (point-max))
-			 debugger-batch-max-lines)
-		  (goto-char (point-min))
-		  (forward-line (/ 2 debugger-batch-max-lines))
-		  (let ((middlestart (point)))
-		    (goto-char (point-max))
-		    (forward-line (- (/ 2 debugger-batch-max-lines)
-				     debugger-batch-max-lines))
-		    (delete-region middlestart (point)))
-		  (insert "...\n"))
-		(goto-char (point-min))
-		(message (buffer-string))
-		(kill-emacs))
-	      (if (eq (car debugger-args) 'debug)
-		  ;; Skip the frames for backtrace-debug, byte-code, and debug.
-		  (backtrace-debug 3 t))
-	      (debugger-reenable)
-	      (message "")
-	      (let (;(inhibit-trace t)
-		    (standard-output nil)
-		    (buffer-read-only t))
-		(message "")
- 		;; Make sure we unbind buffer-read-only in the right buffer.
- 		(save-excursion
- 		  (recursive-edit))))
-	    ;; XEmacs change
-	    debugger-value))
-      ;; Kill or at least neuter the backtrace buffer, so that users
-      ;; don't try to execute debugger commands in an invalid context.
-      (if (get-buffer-window debugger-buffer 'visible)
-	    ;; Still visible despite the save-window-excursion?  Maybe it
-	    ;; it's in a pop-up frame.  It would be annoying to delete and
-	    ;; recreate it every time the debugger stops, so instead we'll
-	    ;; erase it but leave it visible.
-	  (save-excursion
-	    (set-buffer debugger-buffer)
-	    (erase-buffer)
-	    (fundamental-mode))
-	  (kill-buffer debugger-buffer))
-      (set-match-data debugger-outer-match-data)
-      ;; Put into effect the modified values of these variables
-      ;; in case the user set them with the `e' command.
-      (setq load-read-function debugger-outer-load-read-function)
-      (setq overriding-local-map debugger-outer-overriding-local-map)
-      (setq overriding-terminal-local-map
-	    debugger-outer-overriding-terminal-local-map)
-      ;; FSFmacs (setq track-mouse debugger-outer-track-mouse)
-      (setq last-command debugger-outer-last-command)
-      (setq this-command debugger-outer-this-command)
-      (setq unread-command-event debugger-outer-unread-command-event)
-      (setq unread-command-events debugger-outer-unread-command-events)
-;       (setq unread-post-input-method-events
-;            debugger-outer-unread-post-input-method-events)
-      (setq last-input-event debugger-outer-last-input-event)
-      (setq last-input-char debugger-outer-last-input-char)
-      (setq last-input-time debugger-outer-last-input-time)
-      (setq last-command-event debugger-outer-last-command-event)
-      ;; (setq last-nonmenu-event debugger-outer-last-nonmenu-event)
-      ;; (setq last-event-frame debugger-outer-last-event-frame)
-      (setq last-command-char debugger-outer-last-command-char)
-      (setq standard-input debugger-outer-standard-input)
-      (setq standard-output debugger-outer-standard-output)
-      ; FSF (setq inhibit-redisplay debugger-outer-inhibit-redisplay)
-      (setq cursor-in-echo-area debugger-outer-cursor-in-echo-area)
-      (setq debug-on-next-call debugger-step-after-exit) ;do this last!
-      )))
-
-;; XEmacs
-(defun debugger-exit ()
-  (condition-case nil
-      (let ((debug-on-error nil)
-	    (debug-on-signal nil))
-        ;; Tell signal to keep searching for handlers
-        (throw 'debugger t))
-    ;; Called from an old version of Emacs, perhaps?
-    (no-catch (exit-recursive-edit))))
-
-
-(defun debugger-setup-buffer (debugger-args)
-  "Initialize the `*Backtrace*' buffer for entry to the debugger.
-That buffer should be current already."
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  ;; FSF (set-buffer-multibyte nil)
-  (let ((standard-output (current-buffer))
-	(print-escape-newlines t)
-	(print-level 8)
-	(print-length 50))
-    (backtrace))
-  (goto-char (point-min))
-  (delete-region (point)
-		 (progn
-		   ;; XEmacs change
-		   (re-search-forward "\n[* ] debug(")
-		   (forward-line 1)
-		   (point)))
-  (insert "Debugger entered")
-  ;; lambda is for debug-on-call when a function call is next.
-  ;; debug is for debug-on-entry function called.
-  (cond ((memq (car debugger-args) '(lambda debug))
-	 (insert "--entering a function:\n")
-	 (if (eq (car debugger-args) 'debug)
-	     (progn
-	       (delete-char 1)
-	       (insert ?*)
-	       (beginning-of-line))))
-	;; Exiting a function.
-	((eq (car debugger-args) 'exit)
-	 (insert "--returning value: ")
-	 (setq debugger-value (nth 1 debugger-args))
-	 (prin1 debugger-value (current-buffer))
-	 (insert ?\n)
-	 (delete-char 1)
-	 (insert ? )
-	 (beginning-of-line))
-	;; Debugger entered for an error.
-	((eq (car debugger-args) 'error)
-	 (insert "--Lisp error: ")
-	 (prin1 (nth 1 debugger-args) (current-buffer))
-	 (insert ?\n))
-	;; debug-on-call, when the next thing is an eval.
-	((eq (car debugger-args) t)
-	 (insert "--beginning evaluation of function call form:\n"))
-	;; User calls debug directly.
-	(t
-	 (insert ": ")
-	 (prin1 (if (eq (car debugger-args) 'nil)
-		    (cdr debugger-args) debugger-args)
-		(current-buffer))
-	 (insert ?\n)))
-  ;; After any frame that uses eval-buffer,
-  ;; insert a line that states the buffer position it's reading at.
-  (save-excursion
-    (while (re-search-forward "^  eval-buffer(" nil t)
-      (end-of-line)
-      (insert (format "\n  ;;; Reading at buffer position %d"
-		      (with-current-buffer (nth 2 (backtrace-frame (debugger-frame-number)))
-			(point))))))
-  (debugger-make-xrefs))
-
-(defun debugger-make-xrefs (&optional buffer)
-  "Attach cross-references to symbol names in the `*Backtrace*' buffer."
-  (interactive "b")
-  (save-excursion
-    (set-buffer (or buffer (current-buffer)))
-    (setq buffer (current-buffer))
-    (let ((buffer-read-only nil)
-	  (old-end (point-min)) (new-end (point-min)))
-      ;; If we saved an old backtrace, find the common part
-      ;; between the new and the old.
-      ;; Compare line by line, starting from the end,
-      ;; because that's the part that is likely to be unchanged.
-      (if debugger-previous-backtrace
-	  (let (old-start new-start (all-match t))
-	    (goto-char (point-max))
-	    (with-temp-buffer
-	      (insert debugger-previous-backtrace)
-	      (while (and all-match (not (bobp)))
-		(setq old-end (point))
-		(forward-line -1)
-		(setq old-start (point))
-		(with-current-buffer buffer
-		  (setq new-end (point))
-		  (forward-line -1)
-		  (setq new-start (point)))
-		(if (not (zerop
-			  (compare-buffer-substrings
-			   (current-buffer) old-start old-end
-			   buffer new-start new-end)))
-		    (setq all-match nil))))
-	    ;; Now new-end is the position of the start of the
-	    ;; unchanged part in the current buffer, and old-end is
-	    ;; the position of that same text in the saved old
-	    ;; backtrace.  But we must subtract (point-min) since strings are
-	    ;; indexed in origin 0.
-
-	    ;; Replace the unchanged part of the backtrace
-	    ;; with the text from debugger-previous-backtrace,
-	    ;; since that already has the proper xrefs.
-	    ;; With this optimization, we only need to scan
-	    ;; the changed part of the backtrace.
-	    (delete-region new-end (point-max))
-	    (goto-char (point-max))
-	    (insert (substring debugger-previous-backtrace
-			       (- old-end (point-min))))
-	    ;; Make the unchanged part of the backtrace inaccessible
-	    ;; so it won't be scanned.
-	    (narrow-to-region (point-min) new-end)))
-
-      ;; Scan the new part of the backtrace, inserting xrefs.
-      (goto-char (point-min))
-      (while (progn
-	       (skip-syntax-forward "^w_")
-	       (not (eobp)))
-	(let* ((beg (point))
-	       (end (progn (skip-syntax-forward "w_") (point)))
-	       (sym (intern-soft (buffer-substring-no-properties
-				  beg end)))
-	       (file (and sym (symbol-file sym))))
-	  (when file
-	    (goto-char beg)
-	    ;; help-xref-button needs to operate on something matched
-	    ;; by a regexp, so set that up for it.
-	    (re-search-forward "\\(\\(\\sw\\|\\s_\\)+\\)")
-	    ;; #### (help-xref-button 1 'help-function-def sym file)
-	    ))
-	(forward-line 1))
-      (widen))
-    (setq debugger-previous-backtrace (buffer-string))))
-
-(defun debugger-step-through ()
-  "Proceed, stepping through subexpressions of this expression.
-Enter another debugger on next entry to eval, apply or funcall."
-  (interactive)
-  (setq debugger-step-after-exit t)
-  (message "Proceeding, will debug on next eval or call.")
-  ;; XEmacs
-  (debugger-exit))
-
-(defun debugger-continue ()
-  "Continue, evaluating this expression without stopping."
-  (interactive)
-  ;; FSF
-;   (unless debugger-may-continue
-;     (error "Cannot continue"))
-  (message "Continuing.")
-  ;; XEmacs
-  (debugger-exit))
-
-(defun debugger-return-value (val)
-  "Continue, specifying value to return.
-This is only useful when the value returned from the debugger
-will be used, such as in a debug on exit from a frame."
-  (interactive "XReturn value (evaluated): ")
-  (setq debugger-value val)
-  (princ "Returning " t)
-  (prin1 debugger-value)
-  (exit-recursive-edit))
-
-;; XEmacs: [Moved block]
-;; Chosen empirically to account for all the frames
-;; that will exist when debugger-frame is called
-;; within the first one that appears in the backtrace buffer.
-;; Assumes debugger-frame is called from a key;
-;; will be wrong if it is called with Meta-x.
-(defconst debugger-frame-offset 8 "")
-
-(defun debugger-jump ()
-  "Continue to exit from this frame, with all debug-on-entry suspended."
-  (interactive)
-  (debugger-frame)
-  ;; Turn off all debug-on-entry functions
-  ;; but leave them in the list.
-  (let ((list debug-function-list))
-    (while list
-      (fset (car list)
-	    (debug-on-entry-1 (car list) (symbol-function (car list)) nil))
-      (setq list (cdr list))))
-  (message "Continuing through this frame")
-  (debugger-exit))
-
-(defun debugger-reenable ()
-  "Turn all debug-on-entry functions back on."
-  (let ((list debug-function-list))
-    (while list
-      (or (consp (symbol-function (car list)))
-	  (debug-convert-byte-code (car list)))
-      (fset (car list)
-	    (debug-on-entry-1 (car list) (symbol-function (car list)) t))
-      (setq list (cdr list)))))
-
-(defun debugger-frame-number ()
-  "Return number of frames in backtrace before the one point points at."
-  (save-excursion
-    (beginning-of-line)
-    (let ((opoint (point))
-	  (count 0))
-      (while (not (eq (cadr (backtrace-frame count)) 'debug))
-	(setq count (1+ count)))
-      (goto-char (point-min))
-      ;; XEmacs:#### I18N3 will not localize properly!
-      (if (or (equal (buffer-substring (point) (+ (point) 6))
-		     (gettext "Signal"))
-	      (equal (buffer-substring (point) (+ (point) 6))
-		     (gettext "Return")))
-	  (progn
-	    (search-forward ":")
-	    (forward-sexp 1)))
-      (forward-line 1)
-      (while (progn
-	       (forward-char 2)
-	       (if (eq (char-after (point)) ?\()
-		   (forward-sexp 1)
-		 (forward-sexp 2))
-	       (forward-line 1)
-	       (<= (point) opoint))
-	(if (looking-at " *;;;")
-	    (forward-line 1))
-	(setq count (1+ count)))
-      count)))
-
-(defun debugger-frame ()
-  "Request entry to debugger when this frame exits.
-Applies to the frame whose line point is on in the backtrace."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at " *;;;\\|[a-z]")
-	(error "This line is not a function call")))
-  (beginning-of-line)
-  (backtrace-debug (debugger-frame-number) t)
-  (if (eq (char-after (point)) ? )
-      (let ((buffer-read-only nil))
-	(delete-char 1)
-	(insert ?*)))
-  (beginning-of-line))
-
-(defun debugger-frame-clear ()
-  "Do not enter debugger when this frame exits.
-Applies to the frame whose line point is on in the backtrace."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at " *;;;\\|[a-z]")
-	(error "This line is not a function call")))
-  (beginning-of-line)
-  (backtrace-debug (debugger-frame-number) nil)
-  (if (eq (char-after (point)) ?*)
-      (let ((buffer-read-only nil))
-	(delete-char 1)
-	(insert ? )))
-  (beginning-of-line))
-
-(put 'debugger-env-macro 'lisp-indent-function 0)
-(defmacro debugger-env-macro (&rest body)
-  "Run BODY in original environment."
-  `(save-excursion
-    (if (null (buffer-name debugger-old-buffer))
-	;; old buffer deleted
-	(setq debugger-old-buffer (current-buffer)))
-    (set-buffer debugger-old-buffer)
-    (let ((load-read-function debugger-outer-load-read-function)
-          (overriding-terminal-local-map
-           debugger-outer-overriding-terminal-local-map)
-          (overriding-local-map debugger-outer-overriding-local-map)
-	  ;; (track-mouse debugger-outer-track-mouse)
-	  (last-command debugger-outer-last-command)
-	  (this-command debugger-outer-this-command)
-	  (unread-command-event debugger-outer-unread-command-event)
-	  (unread-command-events debugger-outer-unread-command-events)
-;           (unread-post-input-method-events
-; 	   debugger-outer-unread-post-input-method-events)
-	  (last-input-event debugger-outer-last-input-event)
-	  (last-input-char debugger-outer-last-input-char)
-	  (last-input-time debugger-outer-last-input-time)
-	  (last-command-event debugger-outer-last-command-event)
-	  ;; (last-nonmenu-event debugger-outer-last-nonmenu-event)
-	  ;; (last-event-frame debugger-outer-last-event-frame)
-	  (last-command-char debugger-outer-last-command-char)
-	  (standard-input debugger-outer-standard-input)
-	  (standard-output debugger-outer-standard-output)
-      ; (inhibit-redisplay debugger-outer-inhibit-redisplay)
-	  (cursor-in-echo-area debugger-outer-cursor-in-echo-area))
-      (set-match-data debugger-outer-match-data)
-      (prog1 (progn ,@body)
-	(setq debugger-outer-match-data (match-data)
-	      debugger-outer-load-read-function load-read-function
-	      debugger-outer-overriding-local-map overriding-local-map
-	      debugger-outer-overriding-terminal-local-map
-	      overriding-terminal-local-map
-	      ;; debugger-outer-track-mouse track-mouse
-	      debugger-outer-last-command last-command
-              debugger-outer-this-command this-command
-              debugger-outer-unread-command-event unread-command-event
-              debugger-outer-unread-command-events unread-command-events
-	      ; debugger-outer-unread-post-input-method-events
-              ; unread-post-input-method-events
-              debugger-outer-last-input-event last-input-event
-              debugger-outer-last-input-char last-input-char
-              debugger-outer-last-input-time last-input-time
-              debugger-outer-last-command-event last-command-event
-	      ;; debugger-outer-last-nonmenu-event last-nonmenu-event
-	      ;; debugger-outer-last-event-frame last-event-frame
-              debugger-outer-last-command-char last-command-char
-              debugger-outer-standard-input standard-input
-              debugger-outer-standard-output standard-output
-	      ; debugger-outer-inhibit-redisplay inhibit-redisplay
-              debugger-outer-cursor-in-echo-area cursor-in-echo-area)))))
-
-(defun debugger-eval-expression (exp)
-  "Eval an expression, in an environment like that outside the debugger."
-  (interactive
-   (list (read-from-minibuffer "Eval: "
-			       nil read-expression-map t
-			       'read-expression-history)))
-  (debugger-env-macro (eval-expression exp)))
-
-(defvar debugger-mode-map nil)
-(unless debugger-mode-map
-  (let (;(loop ? )
-	)
-    (setq debugger-mode-map (make-keymap))
-    ;; #### (set-keymap-parent debugger-mode-map button-buffer-map)
-    (suppress-keymap debugger-mode-map)
-    (define-key debugger-mode-map "-" 'negative-argument)
-    (define-key debugger-mode-map "b" 'debugger-frame)
-    (define-key debugger-mode-map "c" 'debugger-continue)
-    (define-key debugger-mode-map "j" 'debugger-jump)
-    (define-key debugger-mode-map "r" 'debugger-return-value)
-    (define-key debugger-mode-map "u" 'debugger-frame-clear)
-    (define-key debugger-mode-map "d" 'debugger-step-through)
-    (define-key debugger-mode-map "l" 'debugger-list-functions)
-    (define-key debugger-mode-map "h" 'describe-mode)
-    (define-key debugger-mode-map "q" 'top-level)
-    (define-key debugger-mode-map "e" 'debugger-eval-expression)
-    (define-key debugger-mode-map " " 'next-line)
-    (define-key debugger-mode-map "R" 'debugger-record-expression)
-    (define-key debugger-mode-map "\C-m" 'help-follow)
-    ;; #### (define-key debugger-mode-map 'button2 'push-button)
-    ))
-
-
-(defcustom debugger-record-buffer "*Debugger-record*"
-  "*Buffer name for expression values, for \\[debugger-record-expression]."
-  :type 'string
-  :group 'debugger
-  :version "20.3")
-
-(defun debugger-record-expression  (exp)
-  "Display a variable's value and record it in `*Backtrace-record*' buffer."
-  (interactive
-   (list (read-from-minibuffer
-	  "Record Eval: "
-	  nil
-	  read-expression-map t
-	  'read-expression-history)))
-  (let* ((buffer (get-buffer-create debugger-record-buffer))
-	 (standard-output buffer))
-    (princ (format "Debugger Eval (%s): " exp))
-    (princ (debugger-eval-expression exp))
-    (terpri))
-
-  (with-current-buffer (get-buffer debugger-record-buffer)
-    (save-excursion
-      (forward-line -1)
-      (message
-       (buffer-substring (point) (progn (end-of-line) (point)))))))
-
-(put 'debugger-mode 'mode-class 'special)
-
-(defun debugger-mode ()
-  "Mode for backtrace buffers, selected in debugger.
-\\
-A line starts with `*' if exiting that frame will call the debugger.
-Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'.
-
-When in debugger due to frame being exited,
-use the \\[debugger-return-value] command to override the value
-being returned from that frame.
-
-Use \\[debug-on-entry] and \\[cancel-debug-on-entry] to control
-which functions will enter the debugger when called.
-
-Complete list of commands:
-\\{debugger-mode-map}"
-  (kill-all-local-variables)
-  (setq major-mode 'debugger-mode)
-  (setq mode-name (gettext "Debugger"))	; XEmacs
-  (setq truncate-lines t)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (use-local-map debugger-mode-map)
-  (run-hooks 'debugger-mode-hook))
-
-;;;###autoload
-(defun debug-on-entry (function)
-  "Request FUNCTION to invoke debugger each time it is called.
-If you tell the debugger to continue, FUNCTION's execution proceeds.
-This works by modifying the definition of FUNCTION,
-which must be written in Lisp, not predefined.
-Use \\[cancel-debug-on-entry] to cancel the effect of this command.
-Redefining FUNCTION also cancels it."
-  (interactive "aDebug on entry (to function): ")
-  (debugger-reenable)
-  ;; Handle a function that has been aliased to some other function.
-  ;; #### We have no way of determining if a subr is unevalled
-;   (if (and (subrp (symbol-function function))
-; 	   (eq (cdr (subr-arity (symbol-function function))) 'unevalled))
-;       (error "Function %s is a special form" function))
-  (if (or (symbolp (symbol-function function))
-	  (subrp (symbol-function function)))
-      ;; Create a wrapper in which we can then add the necessary debug call.
-      (fset function `(lambda (&rest debug-on-entry-args)
-			,(interactive-form (symbol-function function))
-			(apply ',(symbol-function function)
-			       debug-on-entry-args))))
-  (or (consp (symbol-function function))
-      (debug-convert-byte-code function))
-  (or (consp (symbol-function function))
-      (error "Definition of %s is not a list" function))
-  (fset function (debug-on-entry-1 function (symbol-function function) t))
-  (or (memq function debug-function-list)
-      (push function debug-function-list))
-  function)
-
-;;;###autoload
-(defun cancel-debug-on-entry (&optional function)
-  "Undo effect of \\[debug-on-entry] on FUNCTION.
-If argument is nil or an empty string, cancel for all functions."
-  (interactive
-   (list (let ((name
-		(completing-read "Cancel debug on entry (to function): "
-				 (mapcar (lambda (sym) 
-                                           (cons (symbol-name sym) sym)) 
-                                         debug-function-list)
-				 nil t nil)))
-	   (if name (intern name)))))
-  (debugger-reenable)
-  (if (and function (not (string= function "")))
-      (progn
-	(let ((f (debug-on-entry-1 function (symbol-function function) nil)))
-	  (condition-case nil
-	      (if (and (equal (nth 1 f) '(&rest debug-on-entry-args))
-		       (eq (car (nth 3 f)) 'apply))
-		  ;; `f' is a wrapper introduced in debug-on-entry.
-		  ;; Get rid of it since we don't need it any more.
-		  (setq f (nth 1 (nth 1 (nth 3 f)))))
-	    (error nil))
-	  (fset function f))
-	(setq debug-function-list (delq function debug-function-list))
-	function)
-    (message "Cancelling debug-on-entry for all functions")
-    (mapcar 'cancel-debug-on-entry debug-function-list)))
-
-(defun debug-convert-byte-code (function)
-  (let ((defn (symbol-function function)))
-    (if (not (consp defn))
-	;; Assume a compiled-function object.
-	(let* ((body
-		(list (list 'byte-code
-			    (compiled-function-instructions defn)
-			    (compiled-function-constants defn)
-			    (compiled-function-stack-depth defn)))))
-	  (if (compiled-function-interactive defn)
-	      (setq body (cons (compiled-function-interactive defn) body)))
-	  (if (compiled-function-doc-string defn)
-	      ;; Use `documentation' here, to get the actual string,
-	      ;; in case the compiled function has a reference
-	      ;; to the .elc file.
-	      (setq body (cons (documentation function) body)))
-	  (fset function (cons 'lambda (cons
-					(compiled-function-arglist defn)
-					body)))))))
-
-(defun debug-on-entry-1 (function defn flag)
-  (if (subrp defn)
-      (error "%s is a built-in function" function)
-    (if (eq (car defn) 'macro)
-	(debug-on-entry-1 function (cdr defn) flag)
-      (or (eq (car defn) 'lambda)
-	  (error "%s not user-defined Lisp function" function))
-      (let ((tail (cddr defn)))
-	;; Skip the docstring.
-	(if (stringp (car tail)) (setq tail (cdr tail)))
-	;; Skip the interactive form.
-	(if (eq 'interactive (car-safe (car tail))) (setq tail (cdr tail)))
-	(unless (eq flag (equal (car tail) '(debug 'debug)))
-	  ;; Add/remove debug statement as needed.
-	  (if (not flag)
-	      (progn (setcar tail (cadr tail))
-		     (setcdr tail (cddr tail)))
-	    (setcdr tail (cons (car tail) (cdr tail)))
-	    (setcar tail '(debug 'debug))))
-	defn))))
-
-(defun debugger-list-functions ()
-  "Display a list of all the functions now set to debug on entry."
-  (interactive)
-  (with-output-to-temp-buffer "*Help*"
-    (if (null debug-function-list)
-	(princ "No debug-on-entry functions now\n")
-      (princ "Functions set to debug on entry:\n\n")
-      (let ((list debug-function-list))
-	(while list
-	  (prin1 (car list))
-	  (terpri)
-	  (setq list (cdr list))))
-      (princ "Note: if you have redefined a function, then it may no longer\n")
-      (princ "be set to debug on entry, even if it is in the list."))
-    (save-excursion
-      (set-buffer standard-output)
-      (help-mode))))
-
-;;; convenience functions for turning on and off debug-on varibles
-
-;;;###autoload
-(defun toggle-debug-on-error (&optional arg)
-  "Toggle the status of debug-on-error.
-With arg, set debug-on-error iff arg is positive."
-  (interactive "_P")
-  (setq debug-on-error
-        (if (null arg)
-            (not debug-on-error)
-	  (> (prefix-numeric-value arg) 0))))
-
-;;;###autoload
-(defun toggle-debug-on-signal (&optional arg)
-  "Toggle the status of debug-on-signal.
-With arg, set debug-on-signal iff arg is positive."
-  (interactive "_P")
-  (setq debug-on-signal
-        (if (null arg)
-            (not debug-on-signal)
-	  (> (prefix-numeric-value arg) 0))))
-
-;;;###autoload
-(defun toggle-debug-on-quit (&optional arg)
-  "Toggle the status of debug-on-quit.
-With arg, set debug-on-quit iff arg is positive."
-  (interactive "_P")
-  (setq debug-on-quit
-        (if (null arg)
-            (not debug-on-quit)
-	  (> (prefix-numeric-value arg) 0))))
-
-(provide 'debug)
-
-;;; debug.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/easy-mmode.el b/xemacs-packages/lisp/xemacs-base/easy-mmode.el
deleted file mode 100644
index 935d258e..00000000
--- a/xemacs-packages/lisp/xemacs-base/easy-mmode.el
+++ /dev/null
@@ -1,605 +0,0 @@
-;;; easy-mmode.el --- easy definition for major and minor modes
-
-;; Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc.
-
-;; Author: Georges Brun-Cottan 
-;; Maintainer: Stefan Monnier 
-
-;; Keywords: extensions lisp
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: GNU Emacs 21.3.
-
-;;; Commentary:
-
-;; Minor modes are useful and common.  This package makes defining a
-;; minor mode easy, by focusing on the writing of the minor mode
-;; functionalities themselves.  Moreover, this package enforces a
-;; conventional naming of user interface primitives, making things
-;; natural for the minor-mode end-users.
-
-;; For each mode, easy-mmode defines the following:
-;;       : The minor mode predicate. A buffer-local variable.
-;; -map  : The keymap possibly associated to .
-;; -hook,-on-hook,-off-hook and -mode:
-;;       see `define-minor-mode' documentation
-;;
-;; eval
-;;  (pp (macroexpand '(define-minor-mode  )))
-;; to check the result before using it.
-
-;; The order in which minor modes are installed is important.  Keymap
-;; lookup proceeds down minor-mode-map-alist, and the order there
-;; tends to be the reverse of the order in which the modes were
-;; installed.  Perhaps there should be a feature to let you specify
-;; orderings.
-
-;; Additionally to `define-minor-mode', the package provides convenient
-;; ways to define keymaps, and other helper functions for major and minor
-;; modes.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-;;; This file uses two functions that did not exist in some versions of
-;;; XEmacs: propertize and replace-regexp-in-string.  We provide these
-;;; functions here for such XEmacsen.
-;;;
-;;; FIXME: These function definitions should go into the future or
-;;; forward-compat package, once that package exists.
-
-;; XEmacs <= 21.4 does not have propertize, but XEmacs >= 21.5 dumps it (it is
-;; defined in subr.el).  Therefore, it is either defined regardless of what
-;; has been loaded already, or it won't be defined regardless of what is
-;; loaded.
-(if (not (fboundp 'propertize))
-    (defun propertize (string &rest properties)
-      "Return a copy of STRING with text properties added.
-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)))
-
-;; XEmacs <= 21.4 does not have replace-regexp-in-string, but XEmacs >= 21.5
-;; dumps it (it is defined in subr.el).  Therefore, it is either defined
-;; regardless of what has been loaded already, or it won't be defined
-;; regardless of what is loaded.
-(if (not (fboundp 'replace-regexp-in-string))
-    (defun replace-regexp-in-string (regexp rep string &optional
-				     fixedcase literal subexp start)
-      "Replace all matches for REGEXP with REP in STRING.
-
-Return a new string containing the replacements.
-
-Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
-arguments with the same names of function `replace-match'.  If START
-is non-nil, start replacements at that index in STRING.
-
-REP is either a string used as the NEWTEXT arg of `replace-match' or a
-function.  If it is a function it is applied to each match to generate
-the replacement passed to `replace-match'; the match-data at this
-point are such that match 0 is the function's argument.
-
-To replace only the first match (if any), make REGEXP match up to \\'
-and replace a sub-expression, e.g.
-  (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
-    => \" bar foo\"
-"
-      (let ((l (length string))
-	    (start (or start 0))
-	    matches str mb me)
-	(save-match-data
-	  (while (and (< start l) (string-match regexp string start))
-	    (setq mb (match-beginning 0)
-		  me (match-end 0))
-	    ;; If we matched the empty string, make sure we advance by one char
-	    (when (= me mb) (setq me (min l (1+ mb))))
-	    ;; Generate a replacement for the matched substring.
-	    ;; Operate only on the substring to minimize string consing.
-	    ;; Set up match data for the substring for replacement;
-	    ;; presumably this is likely to be faster than munging the
-	    ;; match data directly in Lisp.
-	    (string-match regexp (setq str (substring string mb me)))
-	    (setq matches
-		  (cons (replace-match (if (stringp rep)
-					   rep
-					 (funcall rep (match-string 0 str)))
-				       fixedcase literal str subexp)
-			(cons (substring string start mb) ; unmatched prefix
-			      matches)))
-	    (setq start me))
-	  ;; Reconstruct a string from the pieces.
-	  (setq matches (cons (substring string start l) matches)) ; leftover
-	  (apply #'concat (nreverse matches))))))
-
-
-(defun easy-mmode-pretty-mode-name (mode &optional lighter)
-  "Turn the symbol MODE into a string intended for the user.
-If provided LIGHTER will be used to help choose capitalization."
-  (let* ((case-fold-search t)
-	 (name (concat (replace-regexp-in-string
-			"-Minor" " minor"
-			(capitalize (replace-regexp-in-string
-				     "-mode\\'" "" (symbol-name mode))))
-		       " mode")))
-    (if (not (stringp lighter)) name
-      (setq lighter
-	    (replace-regexp-in-string "\\`\\s-+\\|\\-s+\\'" "" lighter))
-      (replace-regexp-in-string lighter lighter name t t))))
-
-;; XEmacs change: add -on-hook, -off-hook, and macro parameter documentation.
-;;;###autoload
-(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
-;;;###autoload
-(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
-  "Define a new minor mode MODE.
-This function defines the associated control variable MODE, keymap MODE-map,
-toggle command MODE, and hook MODE-hook.
-
-DOC is the documentation for the mode toggle command.
-Optional INIT-VALUE is the initial value of the mode's variable.
-Optional LIGHTER is displayed in the modeline when the mode is on.
-Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
-  If it is a list, it is passed to `easy-mmode-define-keymap'
-  in order to build a valid keymap.  It's generally better to use
-  a separate MODE-map variable than to use this argument.
-The above three arguments can be skipped if keyword arguments are
-used (see below).
-
-BODY contains code that will be executed each time the mode is (de)activated.
-  It will be executed after any toggling but before running the hooks.
-  Before the actual body code, you can write
-  keyword arguments (alternating keywords and values).
-  These following keyword arguments are supported:
-:group GROUP	Custom group name to use in all generated `defcustom' forms.
-:global GLOBAL	If non-nil specifies that the minor mode is not meant to be
-              	buffer-local, so don't make the variable MODE buffer-local.
-		By default, the mode is buffer-local.
-:init-value VAL	Same as the INIT-VALUE argument.
-:lighter SPEC	Same as the LIGHTER argument.
-:require SYM	Same as in `defcustom'.
-
-For backwards compatibility, these hooks are run each time the mode is
-\(de)activated.  When the mode is toggled, MODE-hook is always run before the
-other hook.
-MODE-hook: run if the mode is toggled.
-MODE-on-hook: run if the mode is activated.
-MODE-off-hook: run if the mode is deactivated.
- 
-\(defmacro easy-mmode-define-minor-mode
-  (MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)...\)
-
-For example, you could write
-  (define-minor-mode foo-mode \"If enabled, foo on you!\"
-    nil \"Foo \" foo-keymap
-    :require 'foo :global t :group 'inconvenience
-    ...BODY CODE...)"
-
-  ;; Allow skipping the first three args.
-  (cond
-   ((keywordp init-value)
-    (setq body (list* init-value lighter keymap body)
-	  init-value nil lighter nil keymap nil))
-   ((keywordp lighter)
-    (setq body (list* lighter keymap body) lighter nil keymap nil))
-   ((keywordp keymap) (push keymap body) (setq keymap nil)))
-
-  (let* ((mode-name (symbol-name mode))
-	 (pretty-name (easy-mmode-pretty-mode-name mode lighter))
-	 (globalp nil)
-	 (group nil)
-	 (extra-args nil)
-	 (require t)
-	 (keymap-sym (if (and keymap (symbolp keymap)) keymap
-		       (intern (concat mode-name "-map"))))
-	 (hook (intern (concat mode-name "-hook")))
-	 (hook-on (intern (concat mode-name "-on-hook")))
-	 (hook-off (intern (concat mode-name "-off-hook"))))
-
-    ;; Check keys.
-    (while (keywordp (car body))
-      (case (pop body)
-	(:init-value (setq init-value (pop body)))
-	(:lighter (setq lighter (pop body)))
-	(:global (setq globalp (pop body)))
-	(:extra-args (setq extra-args (pop body)))
-	(:group (setq group (nconc group (list :group (pop body)))))
-	(:require (setq require (pop body)))
-	(t (pop body))))
-
-    (unless group
-      ;; We might as well provide a best-guess default group.
-      (setq group
-	    ;; XEmacs: the commented-out functions are going to be in
-	    ;; 21.5.  easy-mmode will be moved to the core in any case,
-	    ;; so don't worry for now.
-	    `(:group ',(or ;(custom-current-group)
-			   (intern (replace-regexp-in-string
-				    "-mode\\'" "" mode-name))))))
-    ;; Add default properties to LIGHTER.
-;; #### FSF comments this out in 21.3.
-;     (unless (or (not (stringp lighter))
-; 		(get-text-property 0 'local-map lighter)
-; 		(get-text-property 0 'keymap lighter))
-;       (setq lighter
-; 	    (propertize lighter
-; 			'local-map modeline-minor-mode-map ; XEmacs change
-; 			'help-echo "mouse-3: minor mode menu")))
-
-    `(progn
-       ;; Define the variable to enable or disable the mode.
-       ,(if (not globalp)
-	    `(progn
-	       (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
-Use the command `%s' to change this variable." pretty-name mode))
-	       (make-variable-buffer-local ',mode))
-
-	  (let ((curfile (or (and (boundp 'byte-compile-current-file)
-				  byte-compile-current-file)
-			     load-file-name)))
-	    `(defcustom ,mode ,init-value
-	       ,(format "Non-nil if %s is enabled.
-See the command `%s' for a description of this minor-mode.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `%s'."
-			pretty-name mode mode)
-	       :set (lambda (symbol value) (funcall symbol (or value 0)))
-	       :initialize 'custom-initialize-default
-	       ,@group
-	       :type 'boolean
-	       ,@(cond
-		  ((not (and curfile require)) nil)
-		  ((not (eq require t)) `(:require ,require))
-		  (t `(:require
-		       ',(intern (file-name-nondirectory
-				  (file-name-sans-extension curfile)))))))))
-
-       ;; The actual function.
-       (defun ,mode (&optional arg ,@extra-args)
-	 ,(or doc
-	      (format (concat "Toggle %s on or off.
-Interactively, with no prefix argument, toggle the mode.
-With universal prefix ARG turn mode on.
-With zero or negative ARG turn mode off.
-\\{%s}") pretty-name keymap-sym))
-	 ;; Use `toggle' rather than (if ,mode 0 1) so that using
-	 ;; repeat-command still does the toggling correctly.
-	 (interactive (list (or current-prefix-arg 'toggle)))
-	 ;; XEmacs addition: save the old mode
-	 (let ((old-mode ,mode))
-	   (setq ,mode
-		 (cond
-		  ((eq arg 'toggle) (not ,mode))
-		  (arg (or (listp arg);; XEmacs addition: C-u alone
-			   (> (prefix-numeric-value arg) 0)))
-		  (t
-		   (if (null ,mode) t
-		     (message
-		      "Toggling %s off; better pass an explicit argument."
-		      ',mode)
-		     nil))))
-	   ,@body
-	   ;; The on/off hooks are here for backward compatibility only.
-	   ;; The on/off hooks are here for backward compatibility only.
-	   ;; XEmacs change: check mode before running hooks
-	   (and ,hook
-		(not (equal old-mode ,mode))
-		(run-hooks ',hook))
-	   (and ,hook-on
-		,mode
-		(run-hooks ',hook-on))
-	   (and ,hook-off
-		(not ,mode)
-		(run-hooks ',hook-off)))
-	 (if (interactive-p)
-	     (progn
-	       ;; see comment up at custom-current-group.
-	       ;; ,(if globalp `(customize-mark-as-set ',mode))
-	       (message ,(format "%s %%sabled" pretty-name)
-			(if ,mode "en" "dis"))))
-	 (force-mode-line-update)
-	 ;; Return the new setting.
-	 ,mode)
-
-       ;; Autoloading an easy-mmode-define-minor-mode autoloads
-       ;; everything up-to-here.
-       ;;
-       ;; XEmacs change: XEmacs does not support :autoload-end.  On the other
-       ;; hand, I don't see why we need to support it.  An autoload cookie
-       ;; just before a (define-minor-mode foo) form will generate an autoload
-       ;; form for the file with name foo.  But that's exactly right, since
-       ;; the defun created just above here has the name foo.  There are no
-       ;; other top-level forms created above here by the macro, so we're done.
-       ;;
-       ;;:autoload-end
-
-       ;; The toggle's hook.
-       (defcustom ,hook nil
-	 ,(format "Hook run at the end of function `%s'." mode-name)
-	 ,@group
-	 :type 'hook)
-
-       ;; XEmacs addition: declare the on and off hooks also
-       (defcustom ,hook-on nil
-	 ,(format "Hook to run when entering %s." mode-name)
-	 :group ,(cadr group)
-	 :type 'hook)
-
-       (defcustom ,hook-off nil
-	 ,(format "Hook to run when exiting %s." mode-name)
-	 :group ,(cadr group)
-	 :type 'hook)
-
-       ;; Define the minor-mode keymap.
-       ,(unless (symbolp keymap)	;nil is also a symbol.
-	  `(defvar ,keymap-sym
-	     (let ((m ,keymap))
-	       (cond ((keymapp m) m)
-		     ((listp m) (easy-mmode-define-keymap m))
-		     (t (error "Invalid keymap %S" ,keymap))))
-	     ,(format "Keymap for `%s'." mode-name)))
-
-       (add-minor-mode ',mode ',lighter
-		       ,(if keymap keymap-sym
-			  `(if (boundp ',keymap-sym)
-			       (symbol-value ',keymap-sym)))
-		       ;; XEmacs change: supply the AFTER and TOGGLE-FUN args
-		       t ',mode)
-
-       ;; If the mode is global, call the function according to the default.
-       ,(if globalp
-	    `(if (and load-file-name (not (equal ,init-value ,mode))
-		      ;; XEmacs addition:
-		      (not purify-flag))
-		 (eval-after-load load-file-name '(,mode (if ,mode 1 -1))))))))
-
-;;;
-;;; make global minor mode
-;;;
-
-;;;###autoload
-(defmacro easy-mmode-define-global-mode (global-mode mode turn-on
-						     &rest keys)
-  "Make GLOBAL-MODE out of the buffer-local minor MODE.
-TURN-ON is a function that will be called with no args in every buffer
-  and that should try to turn MODE on if applicable for that buffer.
-KEYS is a list of CL-style keyword arguments:
-:group to specify the custom group."
-  (let* ((global-mode-name (symbol-name global-mode))
-	 (pretty-name (easy-mmode-pretty-mode-name mode))
-	 (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
-	 (group nil)
-	 (extra-args nil)
-	 (buffers (intern (concat global-mode-name "-buffers")))
-	 (cmmh (intern (concat global-mode-name "-cmmh"))))
-
-    ;; Check keys.
-    (while (keywordp (car keys))
-      (case (pop keys)
-	(:extra-args (setq extra-args (pop keys)))
-	(:group (setq group (nconc group (list :group (pop keys)))))
-	(t (setq keys (cdr keys)))))
-
-    (unless group
-      ;; We might as well provide a best-guess default group.
-      (setq group
-	    `(:group ',(or ;(custom-current-group)
-			   (intern (replace-regexp-in-string
-				    "-mode\\'" "" (symbol-name mode)))))))
-
-    `(progn
-       ;; The actual global minor-mode
-       (define-minor-mode ,global-mode
-	 ,(format "Toggle %s in every buffer.
-With prefix ARG, turn %s on if and only if ARG is positive.
-%s is actually not turned on in every buffer but only in those
-in which `%s' turns it on."
-		  pretty-name pretty-global-name pretty-name turn-on)
-	 :global t :extra-args ,extra-args ,@group
-
-	 ;; Setup hook to handle future mode changes and new buffers.
-	 (if ,global-mode
-	     ;; XEmacs: find-file-hooks not find-file-hook
-	     (progn
-	       (add-hook 'find-file-hooks ',buffers)
-	       (add-hook 'change-major-mode-hook ',cmmh))
-	   (remove-hook 'find-file-hooks ',buffers)
-	   (remove-hook 'change-major-mode-hook ',cmmh))
-
-	 ;; Go through existing buffers.
-	 (dolist (buf (buffer-list))
-	   (with-current-buffer buf
-	     (if ,global-mode (,turn-on) (when ,mode (,mode -1))))))
-
-       ;; TODO: XEmacs does not support :autoload-end
-       ;; Autoloading easy-mmode-define-global-mode
-       ;; autoloads everything up-to-here.
-       :autoload-end
-
-       ;; List of buffers left to process.
-       (defvar ,buffers nil)
-
-       ;; The function that calls TURN-ON in each buffer.
-       (defun ,buffers ()
-	 (remove-hook 'post-command-hook ',buffers)
-	 (while ,buffers
-	   (let ((buf (pop ,buffers)))
-	     (when (buffer-live-p buf)
-	       (with-current-buffer buf (,turn-on))))))
-       (put ',buffers 'definition-name ',global-mode)
-
-       ;; The function that catches kill-all-local-variables.
-       (defun ,cmmh ()
-	 (add-to-list ',buffers (current-buffer))
-	 (add-hook 'post-command-hook ',buffers))
-       (put ',cmmh 'definition-name ',global-mode))))
-
-;;;
-;;; easy-mmode-defmap
-;;;
-
-(if (fboundp 'set-keymap-parents)
-    (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents)
-  (defun easy-mmode-set-keymap-parents (m parents)
-    (set-keymap-parent
-     m
-     (cond
-      ((not (consp parents)) parents)
-      ((not (cdr parents)) (car parents))
-      (t (let ((m (copy-keymap (pop parents))))
-	   (easy-mmode-set-keymap-parents m parents)
-	   m))))))
-
-;;;###autoload
-(defun easy-mmode-define-keymap (bs &optional name m args)
-  "Return a keymap built from bindings BS.
-BS must be a list of (KEY . BINDING) where
-KEY and BINDINGS are suitable for `define-key'.
-Optional NAME is passed to `make-sparse-keymap'.
-Optional map M can be used to modify an existing map.
-ARGS is a list of additional keyword arguments."
-  (let (inherit dense ;suppress
-		)
-    (while args
-      (let ((key (pop args))
-	    (val (pop args)))
-	(case key
-	 (:name (setq name val))
-	 (:dense (setq dense val))
-	 (:inherit (setq inherit val))
-	 (:group)
-	 ;;((eq key :suppress) (setq suppress val))
-	 (t (message "Unknown argument %s in defmap" key)))))
-    (unless (keymapp m)
-      (setq bs (append m bs))
-      (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
-    (dolist (b bs)
-      (let ((keys (car b))
-	    (binding (cdr b)))
-	(dolist (key (if (consp keys) keys (list keys)))
-	  (cond
-	   ((symbolp key)
-	    (substitute-key-definition key binding m global-map))
-	   ((null binding)
-	    (unless (keymapp (lookup-key m key)) (define-key m key binding)))
-	   ((let ((o (lookup-key m key)))
-	      (or (null o) (numberp o) (eq o 'undefined)))
-	    (define-key m key binding))))))
-    (cond
-     ((keymapp inherit) (set-keymap-parent m inherit))
-     ((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
-    m))
-
-;;;###autoload
-(defmacro easy-mmode-defmap (m bs doc &rest args)
-  `(defconst ,m
-     (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
-     ,doc))
-
-
-;;;
-;;; easy-mmode-defsyntax
-;;;
-
-(defun easy-mmode-define-syntax (css args)
-  (let ((st (make-syntax-table (plist-get args :copy)))
-	(parent (plist-get args :inherit)))
-    (dolist (cs css)
-      (let ((char (car cs))
-	    (syntax (cdr cs)))
-	(if (sequencep char)
-	    (mapcar (lambda (c) (modify-syntax-entry c syntax st)) char)
-	  (modify-syntax-entry char syntax st))))
-    ;; XEmacs change: we do not have set-char-table-parent
-    (if parent (derived-mode-merge-syntax-tables
-		(if (symbolp parent) (symbol-value parent) parent) st))
-    st))
-
-;;;###autoload
-(defmacro easy-mmode-defsyntax (st css doc &rest args)
-  "Define variable ST as a syntax-table.
-CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
-  `(progn
-     (autoload 'easy-mmode-define-syntax "easy-mmode")
-     (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
-
-
-
-;;;
-;;; easy-mmode-define-navigation
-;;;
-
-;; XEmacs change: autoload
-;;;###autoload
-(defmacro easy-mmode-define-navigation (base re &optional name endfun)
-  "Define BASE-next and BASE-prev to navigate in the buffer.
-RE determines the places the commands should move point to.
-NAME should describe the entities matched by RE.  It is used to build
-  the docstrings of the two functions.
-BASE-next also tries to make sure that the whole entry is visible by
-  searching for its end (by calling ENDFUN if provided or by looking for
-  the next entry) and recentering if necessary.
-ENDFUN should return the end position (with or without moving point)."
-  (let* ((base-name (symbol-name base))
-	 (prev-sym (intern (concat base-name "-prev")))
-	 (next-sym (intern (concat base-name "-next"))))
-    (unless name (setq name (symbol-name base-name)))
-    `(progn
-       (add-to-list 'debug-ignored-errors
-		    ,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
-       (defun ,next-sym (&optional count)
-	 ,(format "Go to the next COUNT'th %s." name)
-	 (interactive)
-	 (unless count (setq count 1))
-	 (if (< count 0) (,prev-sym (- count))
-	   (if (looking-at ,re) (incf count))
-	   (if (not (re-search-forward ,re nil t count))
-	       (if (looking-at ,re)
-		   (goto-char (or ,(if endfun `(,endfun)) (point-max)))
-		 (error ,(format "No next %s" name)))
-	     (goto-char (match-beginning 0))
-	     (when (and (eq (current-buffer) (window-buffer (selected-window)))
-			(interactive-p))
-	       (let ((endpt (or (save-excursion
-				  ,(if endfun `(,endfun)
-				     `(re-search-forward ,re nil t 2)))
-				(point-max))))
-		 ;; XEmacs change: versions < 21.5.16 have a
-		 ;; pos-visible-in-window-p that takes only 2 parameters
-		 (unless
-		     (if (eq (function-max-args #'pos-visible-in-window-p) 2)
-			 (pos-visible-in-window-p endpt nil)
-		       (pos-visible-in-window-p endpt nil t))
-		   (recenter '(0))))))))
-       (defun ,prev-sym (&optional count)
-	 ,(format "Go to the previous COUNT'th %s" (or name base-name))
-	 (interactive)
-	 (unless count (setq count 1))
-	 (if (< count 0) (,next-sym (- count))
-	   (unless (re-search-backward ,re nil t count)
-	     (error ,(format "No previous %s" name))))))))
-
-(provide 'easy-mmode)
-
-;;; easy-mmode.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/ebuff-menu.el b/xemacs-packages/lisp/xemacs-base/ebuff-menu.el
deleted file mode 100644
index 928ffa45..00000000
--- a/xemacs-packages/lisp/xemacs-base/ebuff-menu.el
+++ /dev/null
@@ -1,304 +0,0 @@
-;;; ebuff-menu.el --- electric-buffer-list mode
-
-;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik 
-;; Keywords: frames
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; Who says one can't have typeout windows in GNU Emacs?   The entry
-;; point, `electric-buffer-list' works like ^r select buffer from the
-;; ITS Emacs lunar or tmacs libraries.
-
-;;; Code:
-
-(require 'electric)
-;; XEmacs change
-(require 'buff-menu)
-
-;; this depends on the format of list-buffers (from src/buffer.c) and
-;; on stuff in lisp/buff-menu.el
-
-(defvar electric-buffer-menu-mode-map nil)
-
-;;;###autoload
-(defun electric-buffer-list (&optional files-only)
-  "Pops up a buffer describing the set of Emacs buffers.
-Vaguely like ITS lunar select buffer; combining typeoutoid buffer
-listing with menuoid buffer selection.
-
-If the very next character typed is a space then the buffer list
-window disappears.  Otherwise, one may move around in the buffer list
-window, marking buffers to be selected, saved or deleted.
-
-To exit and select a new buffer, type a space when the cursor is on
-the appropriate line of the buffer-list window.  Other commands are
-much like those of buffer-menu-mode.
-
-Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
-
-Non-null optional arg FILES-ONLY means mention only file buffers.
-When called from Lisp code, FILES-ONLY may be a regular expression,
-in which case only buffers whose names match that expression are listed,
-or an arbitrary predicate function.
-
-\\{electric-buffer-menu-mode-map}" 
-  (interactive (list (if current-prefix-arg t nil)))
-  (let (select buffer)
-    (save-window-excursion
-      (save-window-excursion (list-buffers files-only))
-      (setq buffer (window-buffer (Electric-pop-up-window "*Buffer List*")))
-      (unwind-protect
-	  (progn
-	    (set-buffer buffer)
-	    (Electric-buffer-menu-mode)
-	    (setq select
-		  (catch 'electric-buffer-menu-select
-		    (message "<<< Press Return to bury the buffer list >>>")
-		    ;; XEmacs change
-		    (if (eq (setq unread-command-events
-				  (list (next-command-event)))
-			    ?\ )
-			(progn (setq unread-command-events nil)
-			       (throw 'electric-buffer-menu-select nil)))
-		    (let ((start-point (point))
-			  (first (progn (goto-char (point-min))
-					(forward-line 2)
-					(point)))
-			  (last (progn (goto-char (point-max))
-				       (forward-line -1)
-				       (point)))
-			  (goal-column 0))
-		      ;; Use start-point if it is meaningful.
-		      (goto-char (if (or (< start-point first)
-					 (> start-point last))
-				     first
-				   start-point))
-		      (Electric-command-loop 'electric-buffer-menu-select
-					     nil
-					     t
-					     'electric-buffer-menu-looper
-					     (cons first last))))))
-	(set-buffer buffer)
-	(Buffer-menu-mode)
-	(bury-buffer buffer)
-	(message "")))
-    (if select
-	(progn (set-buffer buffer)
-	       (let ((opoint (point-marker)))
-		 (Buffer-menu-execute)
-		 (goto-char (point-min))
-		 (if (prog1 (search-forward "\n>" nil t)
-		       (goto-char opoint) (set-marker opoint nil))
-		     (Buffer-menu-select)
-		   (switch-to-buffer (Buffer-menu-buffer t))))))))
-
-(defun electric-buffer-menu-looper (state condition)
-  (cond ((and condition
-	      (not (memq (car condition) '(buffer-read-only
-					   end-of-buffer
-					   beginning-of-buffer))))
-	 (signal (car condition) (cdr condition)))
-	((< (point) (car state))
-	 (goto-char (point-min))
-	 (forward-line 2))
-	((> (point) (cdr state))
-	 (goto-char (point-max))
-	 (forward-line -1)
-	 (if (pos-visible-in-window-p (point-max))
-	     (recenter -1)))))
-
-(put 'Electric-buffer-menu-mode 'mode-class 'special)
-(defun Electric-buffer-menu-mode ()
-  "Major mode for editing a list of buffers.
-Each line describes one of the buffers in Emacs.
-Letters do not insert themselves; instead, they are commands.
-\\
-\\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
-  configuration.  If the very first character typed is a space, it
-  also has this effect.
-\\[Electric-buffer-menu-select] -- select buffer of line point is on.
-  Also show buffers marked with m in other windows,
-  deletes buffers marked with \"D\", and saves those marked with \"S\".
-\\[Buffer-menu-mark] -- mark buffer to be displayed.
-\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
-\\[Buffer-menu-save] -- mark that buffer to be saved.
-\\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
-\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
-\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
-\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
-
-\\{electric-buffer-menu-mode-map}
-
-Entry to this mode via command `electric-buffer-list' calls the value of
-`electric-buffer-menu-mode-hook' if it is non-nil."
-  (kill-all-local-variables)
-  (use-local-map electric-buffer-menu-mode-map)
-  (setq mode-name "Electric Buffer Menu")
-  (setq mode-line-buffer-identification "Electric Buffer List")
-  ;; XEmacs
-  (if (memq 'mode-name mode-line-format)
-      (progn (setq mode-line-format (copy-sequence mode-line-format))
-	     (setcar (memq 'mode-name mode-line-format) "Buffers")))
-  (make-local-variable 'Helper-return-blurb)
-  (setq Helper-return-blurb "return to buffer editing")
-  (setq truncate-lines t)
-  ;; XEmacs
-  (setq buffer-scrollbar-height 0)
-  (setq buffer-read-only t)
-  (setq major-mode 'Electric-buffer-menu-mode)
-  ;; XEmacs
-  (setq mode-motion-hook 'mode-motion-highlight-line)
-  (goto-char (point-min))
-  (if (search-forward "\n." nil t) (forward-char -1))
-  (run-hooks 'electric-buffer-menu-mode-hook))
-
-;; generally the same as Buffer-menu-mode-map
-;;  (except we don't indirect to global-map)
-(put 'Electric-buffer-menu-undefined 'suppress-keymap t)
-(if electric-buffer-menu-mode-map
-    nil
-  (let ((map (make-keymap)) (submap (make-keymap)))
-    ;(fillarray (car (cdr map)) 'Electric-buffer-menu-undefined) ; FSF
-    (let ((i 0))
-      (while (< i 128)
-	(define-key map (make-string 1 i) 'Electric-buffer-menu-undefined)
-	(setq i (1+ i))))
-    (define-key map "\e" submap)
-    ;(fillarray (car (cdr submap)) 'Electric-buffer-menu-undefined) ; FSF
-    (let ((map2 (lookup-key map "\e"))
-	   (i 0))
-      (while (< i 128)
-	(define-key map2 (make-string 1 i) 'Electric-buffer-menu-undefined)
-	(setq i (1+ i))))
-    (define-key map "\C-z" 'suspend-emacs)
-    (define-key map "v" 'Electric-buffer-menu-mode-view-buffer)
-    (define-key map (vector help-char) 'Helper-help)
-    (define-key map "?" 'Helper-describe-bindings)
-    (define-key map "\C-c" nil)
-    (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit)
-    (define-key map "\C-]" 'Electric-buffer-menu-quit)
-    (define-key map "q" 'Electric-buffer-menu-quit)
-    (define-key map " " 'Electric-buffer-menu-select)
-    (define-key map "\C-m" 'Electric-buffer-menu-select)
-    (define-key map "\C-l" 'recenter)
-    (define-key map "s" 'Buffer-menu-save)
-    (define-key map "d" 'Buffer-menu-delete)
-    (define-key map "k" 'Buffer-menu-delete)
-    (define-key map "\C-d" 'Buffer-menu-delete-backwards)
-    ;(define-key map "\C-k" 'Buffer-menu-delete)
-    (define-key map "\177" 'Buffer-menu-backup-unmark)
-    ;; XEmacs
-    (define-key map 'backspace 'Buffer-menu-backup-unmark)
-    (define-key map "~" 'Buffer-menu-not-modified)
-    (define-key map "u" 'Buffer-menu-unmark)
-    (let ((i ?0))
-      (while (<= i ?9)
-	(define-key map (char-to-string i) 'digit-argument)
-        ;;#### Urk!
-	(define-key map (concat "\e" (char-to-string i)) 'digit-argument)
-	(setq i (1+ i))))
-    (define-key map "-" 'negative-argument)
-    (define-key map "\e-" 'negative-argument)
-    (define-key map "m" 'Buffer-menu-mark)
-    (define-key map "\C-u" 'universal-argument)
-    (define-key map "\C-p" 'previous-line)
-    (define-key map "\C-n" 'next-line)
-    (define-key map "p" 'previous-line)
-    (define-key map "n" 'next-line)
-    (define-key map "\C-v" 'scroll-up)
-    (define-key map "\ev" 'scroll-down)
-    (define-key map ">" 'scroll-right)
-    (define-key map "<" 'scroll-left)
-    (define-key map "\e\C-v" 'scroll-other-window)
-    (define-key map "\e>" 'end-of-buffer)
-    (define-key map "\e<" 'beginning-of-buffer)
-    (define-key map "\e\e" nil)
-    (define-key map "\e\e\e" 'Electric-buffer-menu-quit)
-    ;; XEmacs
-    (define-key map [home] 'beginning-of-buffer)
-    (define-key map [down] 'next-line)
-    (define-key map [up] 'previous-line)
-    (define-key map [prior] 'scroll-down)
-    (define-key map [next] 'scroll-up)
-    (define-key map 'button2 'Electric-buffer-menu-mouse-select)
-    (define-key map 'button3 'Buffer-menu-popup-menu)
-    (setq electric-buffer-menu-mode-map map)))
- 
-(defun Electric-buffer-menu-exit ()
-  (interactive)
-  ;; XEmacs
-  (setq unread-command-event last-input-event)
-  ;; for robustness
-  (condition-case ()
-      (throw 'electric-buffer-menu-select nil)
-    (error (Buffer-menu-mode)
-	   (other-buffer))))
-
-(defun Electric-buffer-menu-select ()
-  "Leave Electric Buffer Menu, selecting buffers and executing changes.
-Saves buffers marked \"S\".  Deletes buffers marked \"K\".
-Selects buffer at point and displays buffers marked \">\" in other windows."
-  (interactive)
-  (throw 'electric-buffer-menu-select (point)))
-
-(defun Electric-buffer-menu-mouse-select (event)
-  (interactive "e")
-  ;; XEmacs is simpler
-  (mouse-set-point event)
-  (Electric-buffer-menu-select))
-
-(defun Electric-buffer-menu-quit ()
-  "Leave Electric Buffer Menu, restoring previous window configuration.
-Does not execute select, save, or delete commands."
-  (interactive)
-  (throw 'electric-buffer-menu-select nil))
-
-(defun Electric-buffer-menu-undefined ()
-  (interactive)
-  (ding)
-  (message "%s"
-	   (if (and (eq (key-binding "\C-c\C-c") 'Electric-buffer-menu-quit)
-		    (eq (key-binding " ") 'Electric-buffer-menu-select)
-		    (eq (key-binding (vector help-char)) 'Helper-help)
-		    (eq (key-binding "?") 'Helper-describe-bindings))
-	       (substitute-command-keys "Type C-c C-c to exit, Space to select,
-Type \\[Electric-buffer-menu-quit] to exit, \
-\\[Electric-buffer-menu-select] to select, \
-\\[Helper-help] for help, \\[Helper-describe-bindings] for commands.")))
-  (sit-for 4))
-
-(defun Electric-buffer-menu-mode-view-buffer ()
-  "View buffer on current line in Electric Buffer Menu.
-Returns to Electric Buffer Menu when done."
-  (interactive)
-  (let ((bufnam (Buffer-menu-buffer nil)))
-    (if bufnam
-	(view-buffer bufnam)
-      (ding)
-      (message "Buffer %s does not exist!" bufnam)
-      (sit-for 4))))
-
-(provide 'ebuff-menu)
-
-;;; ebuff-menu.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/echistory.el b/xemacs-packages/lisp/xemacs-base/echistory.el
deleted file mode 100644
index 48d56283..00000000
--- a/xemacs-packages/lisp/xemacs-base/echistory.el
+++ /dev/null
@@ -1,158 +0,0 @@
-;;; echistory.el --- Electric Command History Mode
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-;; Keywords: extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Code:
-
-(require 'electric)			; command loop
-(require 'chistory)			; history lister
-
-;;;###autoload
-(defun Electric-command-history-redo-expression (&optional noconfirm)
-  "Edit current history line in minibuffer and execute result.
-With prefix arg NOCONFIRM, execute current line as-is without editing."
-  (interactive "P")
-  (let (todo)
-    (save-excursion
-      (set-buffer "*Command History*")
-      (beginning-of-line)
-      (setq todo (read (current-buffer)))
-      (if (boundp 'electric-history-in-progress)
-	  (if todo (throw 'electric-history-quit (list noconfirm todo)))))))
-
-(defvar electric-history-map ())
-(if electric-history-map
-    ()
-  ;; XEmacs
-  (setq electric-history-map (make-keymap))
-  (set-keymap-name electric-history-map 'electric-history-map)
-  (set-keymap-default-binding electric-history-map 'Electric-history-undefined)
-  (define-key electric-history-map "\C-u" 'universal-argument)
-  (define-key electric-history-map " " 'Electric-command-history-redo-expression)
-  (define-key electric-history-map "!" 'Electric-command-history-redo-expression)
-  (define-key electric-history-map "\e\C-x" 'eval-sexp)
-  (define-key electric-history-map "\e\C-d" 'down-list)
-  (define-key electric-history-map "\e\C-u" 'backward-up-list)
-  (define-key electric-history-map "\e\C-b" 'backward-sexp)
-  (define-key electric-history-map "\e\C-f" 'forward-sexp)
-  (define-key electric-history-map "\e\C-a" 'beginning-of-defun)
-  (define-key electric-history-map "\e\C-e" 'end-of-defun)
-  (define-key electric-history-map "\e\C-n" 'forward-list)
-  (define-key electric-history-map "\e\C-p" 'backward-list)
-  (define-key electric-history-map "q" 'Electric-history-quit)
-  (define-key electric-history-map "\C-c" nil)
-  (define-key electric-history-map "\C-c\C-c" 'Electric-history-quit)
-  (define-key electric-history-map "\C-]" 'Electric-history-quit)
-  (define-key electric-history-map "\C-z" 'suspend-emacs)
-  (define-key electric-history-map (vector help-char) 'Helper-help)
-  ;; XEmacs
-  (define-key electric-history-map 'backspace 'previous-line)
-  (define-key electric-history-map "?" 'Helper-describe-bindings)
-  (define-key electric-history-map "\e>" 'end-of-buffer)
-  (define-key electric-history-map "\e<" 'beginning-of-buffer)
-  (define-key electric-history-map "\n" 'next-line)
-  (define-key electric-history-map "\r" 'next-line)
-  (define-key electric-history-map "\177" 'previous-line)  
-  (define-key electric-history-map "\C-n" 'next-line)
-  (define-key electric-history-map "\C-p" 'previous-line)
-  (define-key electric-history-map "\ev" 'scroll-down)
-  (define-key electric-history-map "\C-v" 'scroll-up)
-  (define-key electric-history-map [home] 'beginning-of-buffer)
-  (define-key electric-history-map [down] 'next-line)
-  (define-key electric-history-map [up] 'previous-line)
-  (define-key electric-history-map [prior] 'scroll-down)
-  (define-key electric-history-map [next] 'scroll-up)
-  (define-key electric-history-map "\C-l" 'recenter)
-  (define-key electric-history-map "\e\C-v" 'scroll-other-window))
-
-(defvar electric-command-history-hook nil
-  "If non-nil, its value is called by `electric-command-history'.")
-
-;;;###autoload
-(defun electric-command-history ()
-  "\\Major mode for examining and redoing commands from `command-history'.
-This pops up a window with the Command History listing.
-The number of command listed is controlled by `list-command-history-max'.
-The command history is filtered by `list-command-history-filter' if non-nil.
-Combines typeout Command History list window with menu like selection
-of an expression from the history for re-evaluation in the *original* buffer.
-
-The history displayed is filtered by `list-command-history-filter' if non-nil.
-
-Like Emacs-Lisp mode except that characters do not insert themselves and
-Tab and Linefeed do not indent.  Instead these commands are provided:
-\\{electric-history-map}
-
-Calls the value of `electric-command-history-hook' if that is non-nil.
-The Command History listing is recomputed each time this mode is invoked."
-  (interactive)
-  (let ((electric-history-in-progress t)
-	(old-buffer (current-buffer))
-	(todo))
-    (unwind-protect
-	(setq todo
-	      (catch 'electric-history-quit
-		(save-window-excursion
-		  (save-window-excursion
-		    (list-command-history)
-		    (set-buffer "*Command History*")
-		    (Command-history-setup 'electric-command-history
-					   "Electric History"
-					   electric-history-map))
-		  (Electric-pop-up-window "*Command History*")
-		  (run-hooks 'electric-command-history-hook)
-		  (if (eobp)
-		      (progn (ding)
-			     (message "No command history.")
-			     (throw 'electric-history-quit nil))
-		    (let ((Helper-return-blurb "return to History"))
-		      (Electric-command-loop 'electric-history-quit
-					     "->" t))))))
-      (set-buffer "*Command History*")
-      (Command-history-setup)
-      (bury-buffer (current-buffer)))
-    (if (consp todo)
-	(progn (set-buffer old-buffer)
-	       (if (car todo)
-		   (apply (car (car (cdr todo))) (cdr (car (cdr todo))))
-		 (edit-and-eval-command "Redo: " (car (cdr todo))))))))
-
-(defun Electric-history-undefined ()
-  (interactive)
-  (ding)
-  (message (substitute-command-keys "Type \\[Helper-help] for help, ? for commands, C-c C-c to quit, Space to execute"))
-  (sit-for 4))
-
-(defun Electric-history-quit ()
-  "Quit Electric Command History, restoring previous window configuration."
-  (interactive)
-  (if (boundp 'electric-history-in-progress)
-      (progn (message "")
-	     (throw 'electric-history-quit nil))))
-
-(provide 'echistory)
-
-;;; echistory.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/edmacro.el b/xemacs-packages/lisp/xemacs-base/edmacro.el
deleted file mode 100644
index 82aebcc9..00000000
--- a/xemacs-packages/lisp/xemacs-base/edmacro.el
+++ /dev/null
@@ -1,745 +0,0 @@
-;;; edmacro.el --- keyboard macro editor
-
-;; Copyright (C) 1993, 1994, 1997 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie 
-;;         Hrvoje Niksic   -- XEmacs rewrite
-;; Maintainer: Hrvoje Niksic 
-;; Version: 3.20
-;; Keywords: abbrev, internal
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-;;; Most of this file has been rewritten for XEmacs, so the
-;;; implementations are out of synch.  The original version depended
-;;; too closely on GNU Emacs key representation and the equivalence of
-;;; characters and integers to be usable.
-
-;;; Commentary:
-
-;;; Usage:
-;;
-;; The `C-x C-k' (`edit-kbd-macro') command edits a keyboard macro
-;; in a special buffer.  It prompts you to type a key sequence,
-;; which should be one of:
-;;
-;;  * RET or `C-x e' (call-last-kbd-macro), to edit the most 
-;;    recently defined keyboard macro.
-;;
-;;  * `M-x' followed by a command name, to edit a named command
-;;    whose definition is a keyboard macro.
-;;
-;;  * `C-h l' (view-lossage), to edit the 100 most recent keystrokes
-;;    and install them as the "current" macro.
-;;
-;;  * any key sequence whose definition is a keyboard macro.
-;;
-;; This file includes a version of `insert-kbd-macro' that uses the
-;; more readable format defined by these routines.
-;;
-;; Also, the `read-kbd-macro' command parses the region as
-;; a keyboard macro, and installs it as the "current" macro.
-;; This and `format-kbd-macro' can also be called directly as
-;; Lisp functions.
-
-;; The `kbd' macro is a shorter-named and more efficient form of
-;; `read-kbd-macro'.  Unlike `read-kbd-macro', it is evaluated at
-;; read-time, and doesn't bring any overhead to compiled programs.  It
-;; is recommended to use in your programs and initializations, as you
-;; needn't know the internal keysym representation.  For example:
-;;
-;; (define-key foo-mode-map (kbd "C-c ") 'foo-up)
-;;
-;; is the exact equivalent of
-;;
-;; (define-key foo-mode-map [(control ?c) up] 'foo-up)
-;;
-
-;; Type `C-h m', or see the documentation for `edmacro-mode' below,
-;; for information about the format of written keyboard macros.
-
-;; `edit-kbd-macro' formats the macro with one command per line,
-;; including the command names as comments on the right.  If the
-;; formatter gets confused about which keymap was used for the
-;; characters, the command-name comments will be wrong but that
-;; won't hurt anything.
-
-;; With a prefix argument, `edit-kbd-macro' will format the
-;; macro in a more concise way that omits the comments.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl))
-
-(defgroup edmacro nil
-  "Keyboard macro editor."
-  :group 'keyboard)
-
-(defcustom edmacro-eight-bits nil
-  "*Non-nil if edit-kbd-macro should leave 8-bit characters intact.
-Default nil means to write characters above \\177 in octal notation."
-  :type 'boolean
-  :group 'edmacro)
-
-(defcustom edmacro-format-hook nil
-  "*Hook run after formatting the keyboard macro."
-  :type 'hook
-  :group 'edmacro)
-
-(defvar edmacro-finish-hook nil)
-(defvar edmacro-store-hook nil)
-(defvar edmacro-original-buffer nil)
-
-;;; The user-level commands for editing macros.
-
-;;;###autoload (define-key ctl-x-map "\C-k" 'edit-kbd-macro)
-
-(defvar edmacro-mode-map nil)
-(unless edmacro-mode-map
-  (setq edmacro-mode-map (make-sparse-keymap))
-  (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit)
-  (define-key edmacro-mode-map "\C-c\C-q" 'edmacro-insert-key))
-
-;;;###autoload
-(defun edit-kbd-macro (keys &optional prefix finish-hook store-hook)
-  "Edit a keyboard macro.
-At the prompt, type any key sequence which is bound to a keyboard macro.
-Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
-the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by
-its command name.
-With a prefix argument, format the macro in a more concise way."
-  (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP")
-  (when (vectorp keys)
-    (setq keys (edmacro-events-to-keys keys)))
-  (let ((cmd (if (symbolp keys) keys (key-binding keys)))
-	(mac nil))
-    (cond (store-hook
-	   (setq mac keys)
-	   (setq cmd nil))
-	  ((or (eq cmd 'call-last-kbd-macro)
-	       (and (arrayp keys)
-		    (= 1 (length keys))
-		    (or (eq 'return (aref keys 0))
-			(eq ?\r (aref keys 0))
-			(equal '(control ?m) (aref keys 0)))))
-	   (or last-kbd-macro
-	       (y-or-n-p "No keyboard macro defined.  Create one? ")
-	       (keyboard-quit))
-	   (setq mac (or last-kbd-macro []))
-	   (setq cmd 'last-kbd-macro))
-	  ((eq cmd 'execute-extended-command)
-	   (setq cmd (edmacro-minibuf-read "Name of keyboard macro to edit: "))
-	   (if (string-equal cmd "")
-	   (error "No command name given"))
-	   (setq mac (symbol-function cmd)))
-	  ((eq cmd 'view-lossage)
-	   (setq mac (recent-keys))
-	   (setq cmd 'last-kbd-macro))
-	  ((null cmd)
-	   (error "Key sequence `%s' is not defined" (key-description keys)))
-	  ((symbolp cmd)
-	   (setq mac (symbol-function cmd)))
-	  (t
-	   (setq mac cmd)
-	   (setq cmd nil)))
-    (unless (arrayp mac)
-      (error "Key sequence `%s' is not a keyboard macro"
-	     (key-description keys)))
-    (message "Formatting keyboard macro...")
-    (let ((oldbuf (current-buffer))
-	  (fmt (edmacro-format-keys mac))
-	  (fmtv (edmacro-format-keys mac (not prefix)))
-	  (buf (get-buffer-create "*Edit Macro*")))
-      (message "Formatting keyboard macro...done")
-      (switch-to-buffer buf)
-      (kill-all-local-variables)
-      (use-local-map edmacro-mode-map)
-      (setq buffer-read-only nil)
-      (setq major-mode 'edmacro-mode)
-      (setq mode-name "Edit Macro")
-      (set (make-local-variable 'edmacro-original-buffer) oldbuf)
-      (set (make-local-variable 'edmacro-finish-hook) finish-hook)
-      (set (make-local-variable 'edmacro-store-hook) store-hook)
-      (erase-buffer)
-      (insert ";; Keyboard Macro Editor.  Press C-c C-c to finish; "
-	      "press C-x k RET to cancel.\n")
-      (insert ";; Original keys: " fmt "\n")
-      (unless store-hook
-	(insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n")
-	(let ((keys (where-is-internal (or cmd mac))))
-	  (if keys
-	      (dolist (key keys)
-		(insert "Key: " (edmacro-format-keys key) "\n"))
-	    (insert "Key: none\n"))))
-      (insert "\nMacro:\n\n")
-      (save-excursion
-	(insert fmtv "\n"))
-      (recenter '(4))
-      (run-hooks 'edmacro-format-hook))))
-
-;;; The next two commands are provided for convenience and backward
-;;; compatibility.
-
-;;;###autoload
-(defun edit-last-kbd-macro (&optional prefix)
-  "Edit the most recently defined keyboard macro."
-  (interactive "P")
-  (edit-kbd-macro 'call-last-kbd-macro prefix))
-
-;;;###autoload
-(defun edit-named-kbd-macro (&optional prefix)
-  "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'."
-  (interactive "P")
-  (edit-kbd-macro 'execute-extended-command prefix))
-
-;;;###autoload
-(defun read-kbd-macro (start &optional end)
-  "Read the region as a keyboard macro definition.
-The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
-See documentation for `edmacro-mode' for details.
-The resulting macro is installed as the \"current\" keyboard macro.
-
-In Lisp, may also be called with a single STRING argument in which case
-the result is returned rather than being installed as the current macro.
-The result will be a vector of keystrokes."
-  (interactive "r")
-  (if (stringp start)
-      (edmacro-parse-keys start)
-    (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end)))))
-
-;;;###autoload
-(defun format-kbd-macro (&optional macro verbose)
-  "Return the keyboard macro MACRO as a human-readable string.
-This string is suitable for passing to `read-kbd-macro'.
-Second argument VERBOSE means to put one command per line with comments.
-If VERBOSE is nil, put everything on one line."
-  (and macro (symbolp macro) (setq macro (symbol-function macro)))
-  (edmacro-format-keys (or macro last-kbd-macro) verbose))
-
-
-;;; Commands for *Edit Macro* buffer.
-
-(defun edmacro-finish-edit ()
-  (interactive)
-  (unless (eq major-mode 'edmacro-mode)
-    (error
-     "This command is valid only in buffers created by `edit-kbd-macro'"))
-  (run-hooks 'edmacro-finish-hook)
-  (let ((cmd nil) (keys nil) (no-keys nil)
-	(top (point-min)))
-    (goto-char top)
-    (let ((case-fold-search nil))
-      (while (cond ((looking-at "[ \t]*\\($\\|;;\\|REM[ \t\n]\\)")
-		    t)
-		   ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
-		    (when edmacro-store-hook
-		      (error "\"Command\" line not allowed in this context"))
-		    (let ((str (buffer-substring (match-beginning 1)
-						 (match-end 1))))
-		      (unless (equal str "")
-			(setq cmd (and (not (equal str "none"))
-				       (intern str)))
-			(and (fboundp cmd) (not (arrayp (symbol-function cmd)))
-			     (not (y-or-n-p
-				   (format "Command %s is already defined; %s"
-					   cmd "proceed? ")))
-			     (keyboard-quit))))
-		    t)
-		   ((looking-at "Key:\\(.*\\)$")
-		    (when edmacro-store-hook
-		      (error "\"Key\" line not allowed in this context"))
-		    (let ((key (edmacro-parse-keys
-				(buffer-substring (match-beginning 1)
-						  (match-end 1)))))
-		      (unless (equal key [])
-			(if (equal key [?n ?o ?n ?e])
-			    (setq no-keys t)
-			  (push key keys)
-			  (let ((b (key-binding key)))
-			    (and b (commandp b) (not (arrayp b))
-				 (or (not (fboundp b))
-				     (not (arrayp (symbol-function b))))
-				 (not (y-or-n-p
-				       (format
-					"Key `%s' is already defined; %s"
-					(edmacro-format-keys key)
-					"proceed? ")))
-				 (keyboard-quit))))))
-		    t)
-		   ((looking-at "Macro:[ \t\n]*")
-		    (goto-char (match-end 0))
-		    nil)
-		   ((eobp) nil)
-		   (t (error "Expected a `Macro:' line")))
-	(forward-line 1))
-      (setq top (point)))
-    (let* ((buf (current-buffer))
-	   (str (buffer-substring top (point-max)))
-	   (modp (buffer-modified-p))
-	   (obuf edmacro-original-buffer)
-	   (store-hook edmacro-store-hook))
-      (unless (or cmd keys store-hook (equal str ""))
-	(error "No command name or keys specified"))
-      (when modp
-	(when (buffer-name obuf)
-	  (set-buffer obuf))
-	(message "Compiling keyboard macro...")
-	(let ((mac (edmacro-parse-keys str)))
-	  (message "Compiling keyboard macro...done")
-	  (if store-hook
-	      (funcall store-hook mac)
-	    (when (eq cmd 'last-kbd-macro)
-	      (setq last-kbd-macro (and (> (length mac) 0) mac))
-	      (setq cmd nil))
-	    (when cmd
-	      (if (= (length mac) 0)
-		  (fmakunbound cmd)
-		(fset cmd mac)))
-	    (if no-keys
-		(when cmd
-		  (loop for key in (where-is-internal cmd) do
-			(global-unset-key key)))
-	      (when keys
-		(if (= (length mac) 0)
-		    (loop for key in keys do (global-unset-key key))
-		  (loop for key in keys do
-			(global-set-key key (or cmd mac)))))))))
-      (kill-buffer buf)
-      (when (buffer-name obuf)
-	(switch-to-buffer obuf)))))
-
-(defun edmacro-insert-key (key)
-  "Insert the written name of a key in the buffer."
-  (interactive "kKey to insert: ")
-  (if (bolp)
-      (insert (edmacro-format-keys key t) "\n")
-    (insert (edmacro-format-keys key) " ")))
-
-(defun edmacro-mode ()
-  "\\Keyboard Macro Editing mode.  Press
-\\[edmacro-finish-edit] to save and exit.
-To abort the edit, just kill this buffer with \\[kill-buffer] RET.
-
-Press \\[edmacro-insert-key] to insert the name of any key by typing the key.
-
-The editing buffer contains a \"Command:\" line and any number of
-\"Key:\" lines at the top.  These are followed by a \"Macro:\" line
-and the macro itself as spelled-out keystrokes: `C-x C-f foo RET'.
-
-The \"Command:\" line specifies the command name to which the macro
-is bound, or \"none\" for no command name.  Write \"last-kbd-macro\"
-to refer to the current keyboard macro (as used by \\[call-last-kbd-macro]).
-
-The \"Key:\" lines specify key sequences to which the macro is bound,
-or \"none\" for no key bindings.
-
-You can edit these lines to change the places where the new macro
-is stored.
-
-
-Format of keyboard macros during editing:
-
-Text is divided into \"words\" separated by whitespace.  Except for
-the words described below, the characters of each word go directly
-as characters of the macro.  The whitespace that separates words
-is ignored.  Whitespace in the macro must be written explicitly,
-as in \"foo SPC bar RET\".
-
- * The special words RET, SPC, TAB, DEL, BS, LFD, ESC, and NUL represent
-   special control characters.  The words must be written in uppercase.
-
- * A word in angle brackets, e.g., , , or , represents
-   a function key.  (Note that in the standard configuration, the
-   function key  and the control key RET are synonymous.)
-   You can use angle brackets on the words RET, SPC, etc., but they
-   are not required there.
-
- * Keys can be written by their ASCII code, using a backslash followed
-   by up to six octal digits.  This is the only way to represent keys
-   with codes above \\377.
-
- * One or more prefixes M- (meta), C- (control), S- (shift), A- (alt),
-   H- (hyper), and s- (super) may precede a character or key notation.
-   For function keys, the prefixes may go inside or outside of the
-   brackets:  C- = .  The prefixes may be written in
-   any order:  M-C-x = C-M-x.
-
-   Prefixes are not allowed on multi-key words, e.g., C-abc, except
-   that the Meta prefix is allowed on a sequence of digits and optional
-   minus sign:  M--123 = M-- M-1 M-2 M-3.
-
- * The `^' notation for control characters also works:  ^M = C-m.
-
- * Double angle brackets enclose command names:  <> is
-   shorthand for M-x next-line RET.
-
- * Finally, REM or ;; causes the rest of the line to be ignored as a
-   comment.
-
-Any word may be prefixed by a multiplier in the form of a decimal
-number and `*':  3* =   , and
-10*foo = foofoofoofoofoofoofoofoofoofoo.
-
-Multiple text keys can normally be strung together to form a word,
-but you may need to add whitespace if the word would look like one
-of the above notations:  `; ; ;' is a keyboard macro with three
-semicolons, but `;;;' is a comment.  Likewise, `\\ 1 2 3' is four
-keys but `\\123' is a single key written in octal, and `< right >'
-is seven keys but `' is a single function key.  When in
-doubt, use whitespace."
-  (interactive)
-  (error "This mode can be enabled only by `edit-kbd-macro'"))
-(put 'edmacro-mode 'mode-class 'special)
-
-
-(defun edmacro-int-char (int)
-  (if (fboundp 'int-char)
-      (int-char int)
-    int))
-
-(defvar edmacro-read-history nil)
-
-;; Completing read on named keyboard macros only.
-(defun edmacro-minibuf-read (prompt)
-  (intern (completing-read
-	   prompt obarray
-	   (lambda (arg)
-	     (and (commandp arg)
-		  (vectorp (symbol-function arg))))
-	   t nil 'edmacro-read-history)))
-
-
-(defvar edmacro-char-to-word
-  '((?\0 . "NUL")
-    (?\r . "RET")
-    (?\n . "LFD")
-    (?\t . "TAB")
-    (?\e . "ESC")
-    (?\  . "SPC")
-    (?\C-? . "DEL")))
-
-(defvar edmacro-modifiers
-  '(("C" . control)
-    ("M" . meta)
-    ("S" . shift)
-    ("Sh" . shift)
-    ("A" . alt)
-    ("H" . hyper)
-    ("s" . super)))
-
-;;; Parsing a human-readable keyboard macro.
-
-;; In XEmacs version of edmacro, edmacro-parse-keys always returns a
-;; vector.  edmacro-format-keys accepts a vector (but works with a
-;; string too).
-(defun edmacro-parse-keys (string)
-  (let* ((pos 0)
-	 (case-fold-search nil)
-	 res)
-    (while (and (< pos (length string))
-		(string-match "[^ \t\r\n\f]+" string pos))
-      (let ((word (substring string (match-beginning 0) (match-end 0))))
-	(setq pos (match-end 0))
-	(if (or (equal word "REM") (string-match "^;;" word))
-	    ;; Comment (discard to EOL) .
-	    (setq pos (string-match "$" string pos))
-	  (push (edmacro-parse-word word) res))))
-    (mapvector 'identity (apply 'nconc (nreverse res)))))
-
-;; Parse a "word".
-(defun edmacro-parse-word (word)
-  (let ((force-sym nil)
-	(times 1)
-	abbr)
-    (when (string-match "\\([0-9]+\\)\\*." word)
-      (setq times (string-to-int (substring word 0 (match-end 1))))
-      (setq word (substring word (1+ (match-end 1)))))
-    (when (string-match "^<\\([^<>]+\\)>$" word)
-      (setq word (match-string 1 word))
-      (setq force-sym t))
-    (let* ((word-to-sym '(("NUL" . ?\0)
-			  ("RET" . return)
-			  ("LFD" . linefeed)
-			  ("TAB" . tab)
-			  ("ESC" . escape)
-			  ("SPC" . space)
-			  ("BS" . backspace)
-			  ("DEL" . delete)))
-	   (conv (lambda (arg)
-		   ;; string-to-symbol-or-char converter
-		   (if (= (length arg) 1)
-		       (aref arg 0)
-		     (if (string-match "^<\\([^>]+\\)>$" arg)
-			 (setq arg (match-string 1 arg)))
-		     (let ((match (assoc arg word-to-sym)))
-		       (if match
-			   (cdr match)
-			 (intern arg))))))
-	   (conv-chars (lambda (arg)
-			 (let ((match (assoc arg edmacro-char-to-word)))
-			   (if match
-			       (cdr (assoc (cdr match) word-to-sym))
-			     arg))))
-	   (add
-	    (cond
-	     ((string-match "^\\\\[0-7]+" word)
-	      ;; Octal value of character.
-	      (list
-	       (edmacro-int-char
-		(hexl-octal-string-to-integer (substring word 1)))))
-	     ((string-match "^<<.+>>$" word)
-	      ;; Extended command.
-	      (nconc
-	       (list
-		(if (eq (key-binding [(meta x)])
-			'execute-extended-command)
-		    '(meta x)
-		  (or (car (where-is-internal
-			    'execute-extended-command))
-		      '(meta x))))
-	       (mapcar conv-chars (concat (substring word 2 -2) "\r"))))
-	     ((setq abbr (assoc word word-to-sym))
-	      ;; Convert to symbol.
-	      (list (cdr abbr)))
-	     ((string-match "^\\^" word)
-	      ;; ^X == C-x
-	      (if (= (length word) 2)
-		  `((control ,(aref word 1)))
-		(mapcar 'identity word)))
-	     ((string-match "^M--?[0-9]+$" word)
-	      ;; Special case: M- followed by an optional hyphen and
-	      ;; one or more digits
-	      (mapcar (lambda (digit)
-			(list 'meta digit))
-		      (substring word 2)))
-	     ((string-match "^\\([MCSsAH]\\|Sh\\)-" word)
-	      ;; Parse C-* and stuff
-	      (let ((pos1 0)
-		    (r1 nil)
-		    follow curpart prefix)
-		(while (progn (setq curpart (substring word pos1))
-			      (string-match "^\\([MCSsAH]\\|Sh\\)-"
-					    curpart))
-		  (setq prefix (assoc (match-string 1 curpart)
-				      edmacro-modifiers))
-		  (push (cdr prefix) r1)
-		  (incf pos1 (1+ (length (car prefix)))))
-		(setq follow (substring word pos1))
-		(if (equal follow "")
-		    ;; we've got something like "C-M-" -- just let it be,
-		    ;; because of the way `edmacro-format-keys' works.
-		    (mapcar 'identity word)
-		  (list (nconc (nreverse r1) (list (funcall conv follow)))))))
-	     (force-sym
-	      ;; This must be a symbol
-	      (list (intern word)))
-	     (t
-	      ;; Characters
-	      (mapcar conv-chars word))))
-	   (new nil))
-	   (loop repeat times do (setq new (append add new)))
-	   new)))
-
-;; Convert the keypress events in vector x to keys, and return a
-;; vector of keys.  If a list element is not a keypress event, ignore
-;; it.  `events-to-keys' won't quite cut it here, as it is buggy.
-(defun edmacro-events-to-keys (x &optional list)
-  (let (new)
-    (mapc (lambda (el)
-	    (cond ((key-press-event-p el)
-		   (push (let ((mods (event-modifiers el)))
-			   (if mods
-			       (append mods (list (event-key el)))
-			     (event-key el)))
-			 new))
-		  ((or (characterp el)
-		       (symbolp el)
-		       (listp el))
-		   (push el new))))
-	  x)
-    (setq new (nreverse new))
-    (if list
-	new
-      (mapvector 'identity new))))
-
-;; Collapse a list of keys into a list of function keys, if any.
-(defun edmacro-fkeys (keys)
-  (let (new k lookup)
-    (while keys
-      (setq k (nconc k (list (car keys))))
-      (setq lookup (lookup-key function-key-map (mapvector 'identity k)))
-      (cond ((vectorp lookup)
-	     (push (mapcar 'identity lookup) new)
-	     (setq k nil))
-	    ((keymapp lookup)
-	     nil)
-	    ((null lookup)
-	     (push k new)
-	     (setq k nil))
-	    (t
-	     (setq k nil)))
-      (pop keys))
-    (when (keymapp lookup)
-	(push k new))
-    (apply 'nconc (nreverse new))))
-
-;; Convert a character or symbol to string.
-(defun edmacro-conv (char-or-sym add-<>)
-  (let ((char-to-word '((?\0 . "NUL")
-			(?\r . "RET")
-			(?\n . "LFD")
-			(?\t . "TAB")
-			(?\e . "ESC")
-			(?\  . "SPC")
-			(?\C-? . "DEL")))
-	(symbol-to-char '((return . ?\r)
-			  (linefeed . ?\n)
-			  (space . ?\ )
-			  (delete . ?\C-?)
-			  (tab . ?\t)
-			  (escape . ?\e))))
-    (if (symbolp char-or-sym)
-	(if (= (length (symbol-name char-or-sym)) 1)
-	    (setq char-or-sym (aref (symbol-name char-or-sym) 0))
-	  (let ((found (assq char-or-sym symbol-to-char)))
-	    (if found
-		(setq char-or-sym (cdr found))))))
-    ;; Return:
-    (cons (symbolp char-or-sym)
-	  (if (symbolp char-or-sym)
-	      (if add-<>
-		  (concat "<" (symbol-name char-or-sym) ">")
-		(symbol-name char-or-sym))
-	    (let ((found (assq char-or-sym char-to-word)))
-	      (cond (found
-		     (cdr found))
-		    ((< char-or-sym 128)
-		     (single-key-description char-or-sym))
-		    ((and edmacro-eight-bits
-			  (>= char-or-sym 128))
-		     (char-to-string char-or-sym))
-		    (t
-		     (format "\\%o" (edmacro-int-char char-or-sym)))))))))
-
-(defun edmacro-format-1 (keys command times togetherp)
-  (let ((res "")
-	(start keys)
-	el)
-    (while keys
-      (when (not (or togetherp (eq start keys)))
-	(callf concat res " "))
-      (if (> times 1)
-	  (setq res (concat (format "%d*" times) res)))
-      (setq el (car keys))
-      (callf concat res
-	(cond ((listp el)
-	       (let ((my ""))
-		 (if (or
-		      (let (cnv)
-			(while el
-			  (let ((found (find (car el) edmacro-modifiers
-					     :key 'cdr)))
-			    (callf concat my
-			      (if found
-				  (concat (car found) "-")
-				(setq cnv (edmacro-conv (car el) nil))
-				(cdr cnv))))
-			  (pop el))
-			(car cnv))
-		      (> times 1))
-		     (concat "<" my ">")
-		   my)))
-	      (t
-	       (cdr (edmacro-conv el t)))))
-      (and (cdr keys)
-	   (memq (car keys) '(?- '- ?> ?^))
-	   (callf concat res " "))
-      (pop keys))
-    (if command
-	(callf concat res
-	  (make-string (max (- 3 (/ (length res) tab-width)) 1) ?\t)
-	  ";; "
-	  (symbol-name command)
-	  (if togetherp (format " * %d" (length start)))))
-    res))
-
-(defsubst edmacro-seq-equal (seq1 seq2)
-  (while (and seq1 seq2
-	      (equal (car seq1) (car seq2)))
-    (pop seq1)
-    (pop seq2))
-  (not seq1))
-
-;;; Formatting a keyboard macro as human-readable text.
-
-(defun edmacro-format-keys (macro &optional verbose)
-  ;; If we're dealing with events, convert them to symbols first;
-  ;; Then, collapse them into function keys, if possible.
-  (setq macro (edmacro-fkeys (edmacro-events-to-keys macro t)))
-  (let ((res ""))
-    (while macro
-      (let (key lookup (times 1) self-insert-p)
-	(loop
-	 do (setq key (nconc key (list (car macro)))
-		  macro (cdr macro)
-		  lookup (lookup-key global-map (mapvector
-						 'identity key)))
-	 while (and macro lookup (not (commandp lookup))))
-	;; keyboard macro
-	(if (vectorp lookup)
-	    (setq lookup nil))
-	(if (and (eq lookup 'self-insert-command)
-		 (= (length key) 1)
-		 (not (memq (car key)
-			    '(?\  ?\r ?\n space return linefeed tab))))
-	    (while (and (< (length key) 23)
-			(eq (lookup-key global-map (car macro))
-			    'self-insert-command)
-			(not (memq
-			      (car macro)
-			      '(?\  ?\r ?\n space return linefeed tab))))
-	      (setq key (nconc key (list (car macro)))
-		    macro (cdr macro)
-		    self-insert-p t))
-	  (let ((keysize (length key)))
-	    (while (edmacro-seq-equal key macro)
-	      (setq macro (nthcdr keysize macro))
-	      (incf times))))
-	(if (or self-insert-p
-		(null (cdr key))
-		(= times 1))
-	    (callf concat res
-	      (edmacro-format-1 key (if verbose lookup
-				      nil)
-				times self-insert-p)
-	      (and macro (if verbose "\n" " ")))
-	  (loop
-	   repeat times
-	   do
-	   (callf concat res
-	     (edmacro-format-1 key (if verbose lookup
-				     nil)
-			       1 self-insert-p)
-	     (and macro (if verbose "\n" " ")))))))
-    res))
-
-(provide 'edmacro)
-
-;;; edmacro.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/ehelp.el b/xemacs-packages/lisp/xemacs-base/ehelp.el
deleted file mode 100644
index b8d0349d..00000000
--- a/xemacs-packages/lisp/xemacs-base/ehelp.el
+++ /dev/null
@@ -1,418 +0,0 @@
-;;; ehelp.el --- bindings for electric-help mode
-
-;; Copyright (C) 1986, 1995 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik 
-;; Maintainer: FSF
-;; Keywords: help, extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This package provides a pre-packaged `Electric Help Mode' for
-;; browsing on-line help screens.  There is one entry point,
-;; `with-electric-help'; all you have to give it is a no-argument
-;; function that generates the actual text of the help into the current
-;; buffer.
-
-;; To make this the default, you must do
-;; (require 'ehelp)
-;; (define-key global-map "\C-h" 'ehelp-command)
-;; (define-key global-map [help] 'ehelp-command)
-;; (define-key global-map [f1] 'ehelp-command)
-
-;;; Code:
-
-(require 'electric)
-(defvar electric-help-map ()
-  "Keymap defining commands available in `electric-help-mode'.")
-
-(defvar electric-help-form-to-execute nil)
-
-(put 'electric-help-undefined 'suppress-keymap t)
-(if electric-help-map
-    ()
-  (let ((map (make-keymap)))
-    ;; allow all non-self-inserting keys - search, scroll, etc, but
-    ;; let M-x and C-x exit ehelp mode and retain buffer:
-    (suppress-keymap map)
-    (define-key map "\C-u" 'electric-help-undefined)
-    (define-key map [(control ?0)] 'electric-help-undefined)
-    (define-key map [(control ?1)] 'electric-help-undefined)
-    (define-key map [(control ?2)] 'electric-help-undefined)
-    (define-key map [(control ?3)] 'electric-help-undefined)
-    (define-key map [(control ?4)] 'electric-help-undefined)
-    (define-key map [(control ?5)] 'electric-help-undefined)
-    (define-key map [(control ?6)] 'electric-help-undefined)
-    (define-key map [(control ?7)] 'electric-help-undefined)
-    (define-key map [(control ?8)] 'electric-help-undefined)
-    (define-key map [(control ?9)] 'electric-help-undefined)
-    (define-key map (vector help-char) 'electric-help-help)
-    (define-key map "?" 'electric-help-help)
-    ;; XEmacs addition
-    (define-key map 'help 'electric-help-help)
-    (define-key map " " 'scroll-up)
-    (define-key map "\^?" 'scroll-down)
-    (define-key map "." 'beginning-of-buffer)
-    (define-key map "<" 'beginning-of-buffer)
-    (define-key map ">" 'end-of-buffer)
-    ;(define-key map "\C-g" 'electric-help-exit)
-    (define-key map "q" 'electric-help-exit)
-    (define-key map "Q" 'electric-help-exit)
-    ;;a better key than this?
-    (define-key map "r" 'electric-help-retain)
-    (define-key map "R" 'electric-help-retain)
-    (define-key map "\ex" 'electric-help-execute-extended)
-    (define-key map "\C-x" 'electric-help-ctrl-x-prefix)
-
-    (setq electric-help-map map)))
-
-(defun electric-help-mode ()
-  "`with-electric-help' temporarily places its buffer in this mode.
-\(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)"
-  (setq buffer-read-only t)
-  (setq mode-name "Help")
-  (setq major-mode 'help)
-  (setq modeline-buffer-identification '(" Help:  %b"))
-  (use-local-map electric-help-map)
-  (add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
-  (view-mode -1)
-  ;; this is done below in with-electric-help
-  ;(run-hooks 'electric-help-mode-hook)
-  )
-
-;;;###autoload
-(defun with-electric-help (thunk &optional buffer noerase minheight)
-  "Pop up an \"electric\" help buffer.
-The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT.
-THUNK is a function of no arguments which is called to initialize the
-contents of BUFFER.  BUFFER defaults to `*Help*'.  BUFFER will be
-erased before THUNK is called unless NOERASE is non-nil.  THUNK will
-be called while BUFFER is current and with `standard-output' bound to
-the buffer specified by BUFFER.
-
-If THUNK returns nil, we display BUFFER starting at the top, and
-shrink the window to fit.  If THUNK returns non-nil, we don't do those things.
-
-After THUNK has been called, this function \"electrically\" pops up a window
-in which BUFFER is displayed and allows the user to scroll through that buffer
-in electric-help-mode. The window's height will be at least MINHEIGHT if
-this value is non-nil.
-
-If THUNK returns nil, we display BUFFER starting at the top, and
-shrink the window to fit.  If THUNK returns non-nil, we don't do those
-things.
-
-When the user exits (with `electric-help-exit', or otherwise) the help
-buffer's window disappears (i.e., we use `save-window-excursion')
-BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
-  (setq buffer (get-buffer-create (or buffer "*Help*")))
-  (let ((one (one-window-p t))
-	(config (current-window-configuration))
-        (bury nil)
-        (electric-help-form-to-execute nil))
-    (unwind-protect
-	(save-excursion
-	  (if one (goto-char (window-start (selected-window))))
-	  (let ((pop-up-windows t))
-	    (pop-to-buffer buffer))
-	  (save-excursion
-	    (set-buffer buffer)
-	    (if (and minheight (< (window-height) minheight))
-		(enlarge-window (- minheight (window-height))))
-	    (electric-help-mode)
-	    (setq buffer-read-only nil)
-	    (or noerase
-		(erase-buffer)))
-	  (let ((standard-output buffer))
-	    (if (not (funcall thunk))
-		(progn
-		  (set-buffer buffer)
-		  (set-buffer-modified-p nil)
-		  (goto-char (point-min))
-		  (if one (shrink-window-if-larger-than-buffer (selected-window))))))
-	  (set-buffer buffer)
-	  (run-hooks 'electric-help-mode-hook)
-	  (setq buffer-read-only t)
-	  (if (eq (car-safe
-		   ;; XEmacs: Don't be screwed by minor-modes (view-minor-mode)
-		   (let ((overriding-local-map electric-help-map))
-		     (electric-help-command-loop)))
-		  'retain)
-	      (setq config (current-window-configuration))
-	    (setq bury t)))
-      (message "")
-      (set-buffer buffer)
-      (setq buffer-read-only nil)
-      (condition-case ()
-	  (funcall (or default-major-mode 'fundamental-mode))
-	(error nil))
-      (set-window-configuration config)
-      (if bury
-          (progn
-            ;;>> Perhaps this shouldn't be done.
-            ;; so that when we say "Press space to bury" we mean it
-            (replace-buffer-in-windows buffer)
-            ;; must do this outside of save-window-excursion
-            (bury-buffer buffer)))
-      (eval electric-help-form-to-execute))))
-
-(defun electric-help-command-loop ()
-  (catch 'exit
-    (if (pos-visible-in-window-p (point-max))
-	(progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
-	       ;; XEmacs change
-	       (if (equal (setq unread-command-events
-				(list (next-command-event)))
-			  '(?\ ))
-		   (progn (setq unread-command-events nil)
-			  (throw 'exit t)))))
-    (let (up down both neither
-	  (standard (and (eq (key-binding " ")
-			     'scroll-up)
-			 (eq (key-binding "\^?")
-			     'scroll-down)
-			 (eq (key-binding "q")
-			     'electric-help-exit)
-			 (eq (key-binding "r")
-			     'electric-help-retain))))
-      (Electric-command-loop
-        'exit
-	(function (lambda ()
-	  (sit-for 0) ;necessary if last command was end-of-buffer or 
-	              ;beginning-of-buffer - otherwise pos-visible-in-window-p 
-	              ;will yield a wrong result.
-	  (let ((min (pos-visible-in-window-p (point-min)))
-		(max (pos-visible-in-window-p (point-max))))
-	    (cond (isearch-mode 'noprompt)
-		  ((and min max)
-		   (cond (standard "Press q to exit, r to retain ")
-			 (neither)
-			 (t (setq neither (substitute-command-keys "Press \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
-		  (min
-		   (cond (standard "Press SPC to scroll, q to exit, r to retain ")
-			 (up)
-			 (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
-		  (max
-		   (cond (standard "Press DEL to scroll back, q to exit, r to retain ")
-			 (down)
-			 (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
-		  (t
-		   (cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ")
-			 (both)
-			 (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))))))
-		    t))))
-
-
-
-;(defun electric-help-scroll-up (arg)
-;  ">>>Doc"
-;  (interactive "P")
-;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
-;      (electric-help-exit)
-;    (scroll-up arg)))
-
-(defun electric-help-exit ()
-  ">>>Doc"
-  (interactive)
-  (throw 'exit t))
-
-(defun electric-help-retain ()
-  "Exit `electric-help', retaining the current window/buffer configuration.
-\(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
-will select it.)"
-  (interactive)
-  ;; Make sure that we don't throw twice, even if two events cause
-  ;; calling this function:
-  (if (memq 'electric-help-retain mouse-leave-buffer-hook)
-      (progn
-	(remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
-	(throw 'exit '(retain)))))
-
-
-(defun electric-help-undefined ()
-  (interactive)
-  (error "%s is undefined -- Press %s to exit"
-	 (mapconcat 'single-key-description (this-command-keys) " ")
-	 (if (eq (key-binding "q") 'electric-help-exit)
-	     "q"
-	   (substitute-command-keys "\\[electric-help-exit]"))))
-
-
-;>>> this needs to be hairified (recursive help, anybody?)
-(defun electric-help-help ()
-  (interactive)
-  (if (and (eq (key-binding "q") 'electric-help-exit)
-	   (eq (key-binding " ") 'scroll-up)
-	   (eq (key-binding "\^?") 'scroll-down)
-	   (eq (key-binding "r") 'electric-help-retain))
-      (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits")
-    (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits")))
-  (sit-for 2))
-
-
-;;;###autoload
-(defun electric-helpify (fun &optional name)
-  (let ((name (or name "*Help*")))
-    (if (save-window-excursion
-	  ;; kludge-o-rama
-	  (let* ((p (symbol-function 'print-help-return-message))
-		 (b (get-buffer name))
-		 (m (buffer-modified-p b)))
-	    (and b (not (get-buffer-window b))
-		 (setq b nil))
-	    (unwind-protect
-		(progn
-		  (message "%s..." (capitalize (symbol-name fun)))
-		  ;; with-output-to-temp-buffer marks the buffer as unmodified.
-		  ;; kludging excessively and relying on that as some sort
-		  ;;  of indication leads to the following abomination...
-		  ;;>> This would be doable without such icky kludges if either
-		  ;;>> (a) there were a function to read the interactive
-		  ;;>>     args for a command and return a list of those args.
-		  ;;>>     (To which one would then just apply the command)
-		  ;;>>     (The only problem with this is that interactive-p
-		  ;;>>      would break, but that is such a misfeature in
-		  ;;>>      any case that I don't care)
-		  ;;>>     It is easy to do this for emacs-lisp functions;
-		  ;;>>     the only problem is getting the interactive spec
-		  ;;>>     for subrs
-		  ;;>> (b) there were a function which returned a
-		  ;;>>     modification-tick for a buffer.  One could tell
-		  ;;>>     whether a buffer had changed by whether the
-		  ;;>>     modification-tick were different.
-		  ;;>>     (Presumably there would have to be a way to either
-		  ;;>>      restore the tick to some previous value, or to
-		  ;;>>      suspend updating of the tick in order to allow
-		  ;;>>      things like momentary-string-display)
-		  (and b
-		       (save-excursion
-			 (set-buffer b)
-			 (set-buffer-modified-p t)))
-		  (fset 'print-help-return-message 'ignore)
-		  (call-interactively fun)
-		  (and (get-buffer name)
-		       (get-buffer-window (get-buffer name))
-		       (or (not b)
-			   (not (eq b (get-buffer name)))
-			   (not (buffer-modified-p b)))))
-	      (fset 'print-help-return-message p)
-	      (and b (buffer-name b)
-		   (save-excursion
-		     (set-buffer b)
-		     (set-buffer-modified-p m))))))
-	(with-electric-help 'ignore name t))))
-
-
-
-;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then 
-;; continues with execute-extended-command.
-(defun electric-help-execute-extended (prefixarg)
-  (interactive "p")
-  (setq electric-help-form-to-execute '(execute-extended-command nil))
-  (electric-help-retain))
-
-;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
-;; continues with ctrl-x prefix.
-(defun electric-help-ctrl-x-prefix (prefixarg)
-  (interactive "p")
-  (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
-  (electric-help-retain))
-
-
-(defun electric-describe-key ()
-  (interactive)
-  (electric-helpify 'describe-key))
-
-(defun electric-describe-mode ()
-  (interactive)
-  (electric-helpify 'describe-mode))
-
-(defun electric-view-lossage ()
-  (interactive)
-  (electric-helpify 'view-lossage))
-
-;(defun electric-help-for-help ()
-;  "See help-for-help"
-;  (interactive)
-;  )
-
-(defun electric-describe-function ()
-  (interactive)
-  (electric-helpify 'describe-function))
-
-(defun electric-describe-variable ()
-  (interactive)
-  (electric-helpify 'describe-variable))
-
-(defun electric-describe-bindings ()
-  (interactive)
-  (electric-helpify 'describe-bindings))
-
-(defun electric-describe-syntax ()
-  (interactive)
-  (electric-helpify 'describe-syntax))
-
-(defun electric-command-apropos ()
-  (interactive)
-  (electric-helpify 'command-apropos "*Apropos*"))
-
-;(define-key help-map "a" 'electric-command-apropos)
-
-(defun electric-apropos ()
-  (interactive)
-  (electric-helpify 'apropos))
-
-
-;;;; ehelp-map
-
-(defvar ehelp-map ())
-(if ehelp-map
-    nil
-  ;; #### WTF?  Why don't we just use substitute-key-definition
-  ;; like FSF does?
-  (let ((shadow '((apropos . electric-apropos)
-		  (command-apropos . electric-command-apropos)
-		  (describe-key . electric-describe-key) 
-                  (describe-mode . electric-describe-mode)
-                  (view-lossage . electric-view-lossage) 
-                  (describe-function . electric-describe-function)
-                  (describe-variable . electric-describe-variable)
-                  (describe-bindings . electric-describe-bindings)
-                  (describe-syntax . electric-describe-syntax)))
-        (map (make-sparse-keymap)))
-    (set-keymap-name map 'ehelp-map)
-    (set-keymap-parents map (list help-map))
-    ;; Shadow bindings which would be inherited from help-map
-    ;;#### This doesn't descend into sub-keymaps
-    (map-keymap (function (lambda (key binding)
-                              (let ((tem (assq binding shadow)))
-                                (if tem
-                                    (define-key map key (cdr tem))))))
-                help-map)
-    (setq ehelp-map map)
-    (fset 'ehelp-command map)))
-
-;; Do (define-key global-map "\C-h" 'ehelp-command) if you want to win
-
-(provide 'ehelp) 
-
-;;; ehelp.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/electric.el b/xemacs-packages/lisp/xemacs-base/electric.el
deleted file mode 100644
index 70e80f23..00000000
--- a/xemacs-packages/lisp/xemacs-base/electric.el
+++ /dev/null
@@ -1,210 +0,0 @@
-;;; electric.el --- window maker and Command loop for `electric' modes.
-
-;; Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-;; Keywords: extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-; zaaaaaaap
-
-;;; Code:
-
-;; This loop is the guts for non-standard modes which retain control
-;; until some event occurs.  It is a `do-forever', the only way out is
-;; to throw.  It assumes that you have set up the keymap, window, and
-;; everything else: all it does is read commands and execute them -
-;; providing error messages should one occur (if there is no loop
-;; function - which see).  The required argument is a tag which should
-;; expect a value of nil if the user decides to punt. The second
-;; argument is the prompt to be used: if nil, use "->", if 'noprompt,
-;; don't use a prompt, if a string, use that string as prompt, and if
-;; a function of no variable, it will be evaluated in every iteration
-;; of the loop and its return value, which can be nil, 'noprompt or a
-;; string, will be used as prompt.  Given third argument non-nil, it
-;; INHIBITS quitting unless the user types C-g at toplevel.  This is
-;; so user can do things like C-u C-g and not get thrown out.  Fourth
-;; argument, if non-nil, should be a function of two arguments which
-;; is called after every command is executed.  The fifth argument, if
-;; provided, is the state variable for the function.  If the
-;; loop-function gets an error, the loop will abort WITHOUT throwing
-;; (moral: use unwind-protect around call to this function for any
-;; critical stuff).  The second argument for the loop function is the
-;; conditions for any error that occurred or nil if none.
-
-(defun Electric-command-loop (return-tag
-			      &optional prompt inhibit-quit
-					loop-function loop-state)
-
-  (let (cmd 
-        (err nil) 
-	(electrified-buffer (current-buffer)) ; XEmacs -
-        (prompt-string prompt))
-    (while t
-      (if (not (or (stringp prompt) (eq prompt nil) (eq prompt 'noprompt)))
-          (setq prompt-string (funcall prompt)))
-      (if (not (stringp prompt-string))
-          (if (eq prompt-string 'noprompt)
-              (setq prompt-string nil)
-            (setq prompt-string "->")))
-      (setq cmd (read-key-sequence prompt-string))
-      ;; XEmacs
-      (or prefix-arg (setq last-command this-command))
-      (setq last-command-event (aref cmd (1- (length cmd)))
-	    current-mouse-event
-	      (and (or (button-press-event-p last-command-event)
-		       (button-release-event-p last-command-event)
-		       (misc-user-event-p last-command-event))
-		   last-command-event)
-	    this-command (if (misc-user-event-p last-command-event)
-			     last-command-event
-                             (key-binding cmd t))
-	    cmd this-command)
-      ;; This makes universal-argument-other-key work.
-      (setq universal-argument-num-events 0)
-      (if (or (prog1 quit-flag (setq quit-flag nil))
-	      ;; XEmacs
-	      (eq (event-to-character last-input-event) (quit-char)))
-	  (progn (setq unread-command-events nil
-		       prefix-arg nil)
-		 ;; If it wasn't cancelling a prefix character, then quit.
-		 (if (or (= (length (this-command-keys)) 1)
-			 (not inhibit-quit)) ; safety
-		     (progn (ding nil 'quit) ; XEmacs - 
-			    (message "Quit")
-			    (throw return-tag nil))
-		   (setq cmd nil))))
-      (setq current-prefix-arg prefix-arg)
-      (if cmd
-	  (condition-case conditions
-	      ;; XEmacs
-	      (progn (if (eventp cmd)
-			 (progn
-			   (let ((b (current-buffer)))
-			     (dispatch-event cmd)
-			     (if (not (eq b (current-buffer)))
-				 (throw return-tag (current-buffer)))))
-		       (command-execute cmd))
-		     (setq last-command this-command)
-		     (if (or (prog1 quit-flag (setq quit-flag nil))
-			     ;; XEmacs
-			     (eq (event-to-character last-input-event)
-				 (quit-char)))
-			 (progn (setq unread-command-events nil)
-				(if (not inhibit-quit)
-				    ;; XEmacs
-				    (progn (ding nil 'quit)
-					   (message "Quit")
-					   (throw return-tag nil))
-				  (message "Quit inhibited")
-				  (ding)))))
-	    (buffer-read-only (if loop-function
-				  (setq err conditions)
-				(ding)
-				(message "Buffer is read-only")
-				(sit-for 2)))
-	    (beginning-of-buffer (if loop-function
-				     (setq err conditions)
-				   (ding)
-				   (message "Beginning of Buffer")
-				   (sit-for 2)))
-	    (end-of-buffer (if loop-function
-			       (setq err conditions)
-			     (ding)
-			     (message "End of Buffer")
-			     (sit-for 2)))
-	    (error (if loop-function
-		       (setq err conditions)
-		     (ding)
-		     (message "Error: %s"
-			      (if (eq (car conditions) 'error)
-				  (car (cdr conditions))
-				(prin1-to-string conditions)))
-		     (sit-for 2))))
-	(ding))
-      (and (not (eq (current-buffer) electrified-buffer)) ; XEmacs -
-	   (not (eq (selected-window) (minibuffer-window)))
-	   (progn (ding nil 'quit)
-		  (message "Leaving electric command loop %s."
-			   "because buffer has changed")
-		  (sit-for 2)
-		  (throw return-tag nil)))
-      (if loop-function (funcall loop-function loop-state err))))
-  ;; XEmacs - huh?  It should be impossible to ever get here...
-  (ding nil 'alarm)
-  (throw return-tag nil))
-
-;; This function is like pop-to-buffer, sort of. 
-;; The algorithm is
-;; If there is a window displaying buffer
-;; 	Select it
-;; Else if there is only one window
-;; 	Split it, selecting the window on the bottom with height being
-;; 	the lesser of max-height (if non-nil) and the number of lines in
-;;      the buffer to be displayed subject to window-min-height constraint.
-;; Else
-;; 	Switch to buffer in the current window.
-;;
-;; Then if max-height is nil, and not all of the lines in the buffer
-;; are displayed, grab the whole frame.
-;;
-;; Returns selected window on buffer positioned at point-min.
-
-(defun Electric-pop-up-window (buffer &optional max-height)
-  (let* ((win (or (get-buffer-window buffer) (selected-window)))
-	 (buf (get-buffer buffer))
-	 (one-window (one-window-p t))
-	 (pop-up-windows t)
-	 (target-height)
-	 (lines))
-    (if (not buf)
-	(error "Buffer %s does not exist" buffer)
-      (save-excursion
-	(set-buffer buf)
-	(setq lines (count-lines (point-min) (point-max)))
-	(setq target-height
-	      (min (max (if max-height (min max-height (1+ lines)) (1+ lines))
-			window-min-height)
-		   (save-window-excursion
-		     (delete-other-windows)
-		     (1- (window-height (selected-window)))))))
-      (cond ((and (eq (window-buffer win) buf))
-	     (select-window win))
-	    (one-window
-	     (goto-char (window-start win))
-	     (pop-to-buffer buffer)
-	     (setq win (selected-window))
-	     (enlarge-window (- target-height (window-height win))))
-	    (t
-	     (switch-to-buffer buf)))
-      (if (and (not max-height)
-	       (> target-height (window-height (selected-window))))
-	  (progn (goto-char (window-start win))
-		 (enlarge-window (- target-height (window-height win)))))
-      (goto-char (point-min))
-      win)))
-
-(provide 'electric)
-
-;;; electric.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/enriched.el b/xemacs-packages/lisp/xemacs-base/enriched.el
deleted file mode 100644
index 65b059f6..00000000
--- a/xemacs-packages/lisp/xemacs-base/enriched.el
+++ /dev/null
@@ -1,531 +0,0 @@
-;;; enriched.el --- read and save files in text/enriched format
-
-;; Copyright (c) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Boris Goldowsky 
-;; Adapted-by: Mike Sperber 
-;; Maintainer: XEmacs Development Team
-;; Keywords: wp, faces
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 20.2.
-
-;;; Commentary:
-
-;; This file implements reading, editing, and saving files with
-;; text-properties such as faces, levels of indentation, and true line
-;; breaks distinguished from newlines just used to fit text into the window.
-
-;; The file format used is the MIME text/enriched format, which is a
-;; standard format defined in internet RFC 1563.  All standard annotations
-;; are supported except for  and , which are currently not
-;; possible to display.
-
-;; A separate file, enriched.doc, contains further documentation and other
-;; important information about this code.  It also serves as an example
-;; file in text/enriched format.  It should be in the etc directory of your
-;; emacs distribution.
-
-;;; TODO for the XEmacs port:
-;;
-;; Currently XEmacs does not support default-text-properties.  The
-;; original enriched.el uses this to set the left-margin,
-;; right-margin, and justification properties to 'front-sticky.
-;; If you know the Right Way to fix this, contact
-;; Mike Sperber .
-
-;;; Code:
-
-(provide 'enriched)
-
-;;;
-;;; Variables controlling the display
-;;;
-
-(defgroup enriched nil
-  "Read and save files in text/enriched format"
-  :group 'wp)
-
-(defcustom enriched-verbose t
-  "*If non-nil, give status messages when reading and writing files."
-  :type 'boolean
-  :group 'enriched)
-
-;;;
-;;; Set up faces & display table
-;;;
-
-;; Emacs doesn't have a "fixed" face by default, since all faces currently
-;; have to be fixed-width.  So we just pick one that looks different from the
-;; default.
-(defface fixed
-  '((t (:bold t)))
-  "Face used for text that must be shown in fixed width.
-Currently, emacs can only display fixed-width fonts, but this may change.
-This face is used for text specifically marked as fixed-width, for example
-in text/enriched files."
-  :group 'enriched)
-
-(defface excerpt
-  '((t (:italic t)))
-  "Face used for text that is an excerpt from another document.
-This is used in enriched-mode for text explicitly marked as an excerpt."
-  :group 'enriched)
-
-(defconst enriched-display-table
-  ;; XEmacs change
-  ;; (or (copy-sequence standard-display-table)
-  ;;     (make-display-table)))
-  (make-display-table))
-(aset enriched-display-table ?\f (make-vector (1- (frame-width)) ?-))
-
-(defconst enriched-par-props '(left-margin right-margin justification)
-  "Text-properties that usually apply to whole paragraphs.
-These are set front-sticky everywhere except at hard newlines.")
-
-;;;
-;;; Variables controlling the file format
-;;;   (bidirectional)
-
-(defconst enriched-initial-annotation
-  (lambda ()
-    (format "Content-Type: text/enriched\nText-Width: %d\n\n"
-	    fill-column))
-  "What to insert at the start of a text/enriched file.
-If this is a string, it is inserted.  If it is a list, it should be a lambda
-expression, which is evaluated to get the string to insert.")
-
-(defconst enriched-annotation-format "<%s%s>"
-  "General format of enriched-text annotations.")
-
-(defconst enriched-annotation-regexp "<\\(/\\)?\\([-A-za-z0-9]+\\)>"
-  "Regular expression matching enriched-text annotations.")
-
-(defconst enriched-translations
-  '((face          (bold-italic "bold" "italic")
-		   (bold        "bold")
-		   (italic      "italic")
-		   (underline   "underline")
-		   (fixed       "fixed")
-		   (excerpt     "excerpt")
-		   (default     )
-		   (nil         enriched-encode-other-face))
-    (left-margin   (4           "indent"))
-    (right-margin  (4           "indentright"))
-    (justification (none        "nofill")
-		   (right       "flushright")
-		   (left        "flushleft")
-		   (full        "flushboth")
-		   (center      "center"))
-    (PARAMETER     (t           "param")) ; Argument of preceding annotation
-    ;; The following are not part of the standard:
-    (FUNCTION      (enriched-decode-foreground "x-color")
-		   (enriched-decode-background "x-bg-color")
-		   ;; XEmacs addition
-		   (facemenu-make-larger "bigger")
-		   (facemenu-make-smaller "smaller"))
-    (read-only     (t           "x-read-only"))
-    (unknown       (nil         format-annotate-value))
-;   (font-size     (2           "bigger")       ; unimplemented
-;                  (-2          "smaller"))
-)
-  "List of definitions of text/enriched annotations.
-See `format-annotate-region' and `format-deannotate-region' for the definition
-of this structure.")
-
-(defconst enriched-ignore
-  '(front-sticky rear-nonsticky hard)
-  "Properties that are OK to ignore when saving text/enriched files.
-Any property that is neither on this list nor dealt with by
-`enriched-translations' will generate a warning.")
-
-;;; Internal variables
-
-(defvar enriched-mode nil
-  "True if Enriched mode is in use.")
-(make-variable-buffer-local 'enriched-mode)
-
-(if (not (assq 'enriched-mode minor-mode-alist))
-    (setq minor-mode-alist
-	  (cons '(enriched-mode " Enriched")
-		minor-mode-alist)))
-
-(defcustom enriched-mode-hook nil
-  "Functions to run when entering Enriched mode.
-If you set variables in this hook, you should arrange for them to be restored
-to their old values if you leave Enriched mode.  One way to do this is to add
-them and their old values to `enriched-old-bindings'."
-  :type 'hook
-  :group 'enriched)
-
-(defvar enriched-old-bindings nil
-  "Store old variable values that we change when entering mode.
-The value is a list of \(VAR VALUE VAR VALUE...).")
-(make-variable-buffer-local 'enriched-old-bindings)
-
-;;;
-;;; Define the mode
-;;;
-
-;;;###autoload
-(defun enriched-mode (&optional arg)
-  "Minor mode for editing text/enriched files.
-These are files with embedded formatting information in the MIME standard
-text/enriched format.
-Turning the mode on runs `enriched-mode-hook'.
-
-More information about Enriched mode is available in the file 
-etc/enriched.doc  in the Emacs distribution directory.
-
-Commands:
-
-\\\\{enriched-mode-map}"
-  (interactive "P")
-  (let ((mod (buffer-modified-p)))
-    (cond ((or (<= (prefix-numeric-value arg) 0)
-	       (and enriched-mode (null arg)))
-	   ;; Turn mode off
-	   (setq enriched-mode nil)
-	   (setq buffer-file-format (delq 'text/enriched buffer-file-format))
-	   ;; restore old variable values
-	   (while enriched-old-bindings
-	     (funcall 'set (car enriched-old-bindings)
-		      (car (cdr enriched-old-bindings)))
-	     (setq enriched-old-bindings (cdr (cdr enriched-old-bindings)))))
-
-	  (enriched-mode nil)		; Mode already on; do nothing.
-
-	  (t (setq enriched-mode t)	; Turn mode on
-	     (add-to-list 'buffer-file-format 'text/enriched)
-	     ;; Save old variable values before we change them.
-	     ;; These will be restored if we exit Enriched mode.
-	     (setq enriched-old-bindings
-		   ;; XEmacs change
-		   (list ; 'buffer-display-table buffer-display-table
-			 'indent-line-function indent-line-function
-			 'default-text-properties default-text-properties))
-	     (make-local-variable 'indent-line-function)
-	     (make-local-variable 'default-text-properties)
-	     (setq indent-line-function 'indent-to-left-margin
- 		   ;; XEmacs change
- 		   ;; buffer-display-table  enriched-display-table
-		   )
-	     (use-hard-newlines 1 nil)
-	     (let ((sticky (plist-get default-text-properties 'front-sticky))
-		   (p enriched-par-props))
-	       (while p
-		 (add-to-list 'sticky (car p))
-		 (setq p (cdr p)))
-	       (if sticky
-		   (setq default-text-properties
-			 (plist-put default-text-properties
-				    'front-sticky sticky))))
-	     (run-hooks 'enriched-mode-hook)))
-    (set-buffer-modified-p mod)
-    ;; XEmacs change
-    (redraw-modeline)))
-
-;;;
-;;; Keybindings
-;;;
-
-(defvar enriched-mode-map nil
-  "Keymap for Enriched mode.")
-
-(if (null enriched-mode-map)
-    (fset 'enriched-mode-map (setq enriched-mode-map (make-sparse-keymap))))
-
-(if (not (assq 'enriched-mode minor-mode-map-alist))
-    (setq minor-mode-map-alist
-	  (cons (cons 'enriched-mode enriched-mode-map)
-		minor-mode-map-alist)))
-
-(define-key enriched-mode-map "\C-a" 'beginning-of-line-text)
-(define-key enriched-mode-map "\C-m" 'reindent-then-newline-and-indent)
-(define-key enriched-mode-map "\C-j" 'reindent-then-newline-and-indent)
-(define-key enriched-mode-map "\M-j" 'facemenu-justification-menu)
-(define-key enriched-mode-map "\M-S" 'set-justification-center)
-(define-key enriched-mode-map "\C-x\t" 'increase-left-margin)
-(define-key enriched-mode-map "\C-c\C-l" 'set-left-margin)
-(define-key enriched-mode-map "\C-c\C-r" 'set-right-margin)
-
-;;;
-;;; Some functions dealing with text-properties, especially indentation
-;;;
-
-(defun enriched-map-property-regions (prop func &optional from to)
-  "Apply a function to regions of the buffer based on a text property.
-For each contiguous region of the buffer for which the value of PROPERTY is
-eq, the FUNCTION will be called.  Optional arguments FROM and TO specify the
-region over which to scan.
-
-The specified function receives three arguments: the VALUE of the property in
-the region, and the START and END of each region."
-  (save-excursion
-    (save-restriction
-      (if to (narrow-to-region (point-min) to))
-      (goto-char (or from (point-min)))
-      (let ((begin (point))
-	    end
-	    (marker (make-marker))
-	    (val (get-text-property (point) prop)))
-	(while (setq end (text-property-not-all begin (point-max) prop val))
-	  (move-marker marker end)
-	  (funcall func val begin (marker-position marker))
-	  (setq begin (marker-position marker)
-		val (get-text-property marker prop)))
-	(if (< begin (point-max))
-	    (funcall func val begin (point-max)))))))
-
-(put 'enriched-map-property-regions 'lisp-indent-hook 1)
-
-(defun enriched-insert-indentation (&optional from to)
-  "Indent and justify each line in the region."
-  (save-excursion
-    (save-restriction
-      (if to (narrow-to-region (point-min) to))
-      (goto-char (or from (point-min)))
-      (if (not (bolp)) (forward-line 1))
-      (while (not (eobp))
-	(if (eolp)
-	    nil ; skip blank lines
-	  (indent-to (current-left-margin))
-	  (justify-current-line t nil t))
-	(forward-line 1)))))
-
-;;;
-;;; Encoding Files
-;;;
-
-;;;###autoload
-(defun enriched-encode (from to &optional orig-buf)
-  (if enriched-verbose (message "Enriched: encoding document..."))
-  (save-restriction
-    (narrow-to-region from to)
-    (delete-to-left-margin)
-    (unjustify-region)
-    (goto-char from)
-    (format-replace-strings '(("<" . "<<")))
-    (format-insert-annotations 
-     (format-annotate-region from (point-max) enriched-translations
-			     'enriched-make-annotation enriched-ignore))
-    (goto-char from)
-    (insert (if (stringp enriched-initial-annotation)
-		enriched-initial-annotation
-	      (save-excursion
-		;; Eval this in the buffer we are annotating.  This
-		;; fixes a bug which was saving incorrect File-Width
-		;; information, since we were looking at local
-		;; variables in the wrong buffer.
-		(if orig-buf (set-buffer orig-buf))
-		(funcall enriched-initial-annotation))))
-    (enriched-map-property-regions 'hard
-      (lambda (v b e)
-	(if (and v (= ?\n (char-after b)))
-	    (progn (goto-char b) (insert "\n"))))
-      (point) nil)
-    (if enriched-verbose (message nil))
-    ;; Return new end.
-    (point-max)))
-
-(defun enriched-make-annotation (name positive)
-  "Format an annotation called NAME.
-If POSITIVE is non-nil, this is the opening annotation, if nil, this is the
-matching close."
-  (cond ((stringp name)
-	 (format enriched-annotation-format (if positive "" "/") name))
-	;; Otherwise it is an annotation with parameters, represented as a list
-	(positive
-	 (let ((item (car name))
-	       (params (cdr name)))
-	   (concat (format enriched-annotation-format "" item)
-		   (mapconcat (lambda (i) (concat "" i ""))
-			      params ""))))
-	(t (format enriched-annotation-format "/" (car name)))))
-
-;; XEmacs addition
-(defun enriched-face-strip-size (face)
-  "Create a symbol from the name of FACE devoid of size information,
-i.e. remove all larger- and smaller- prefixes."
-  (let* ((face-symbol (face-name face))
-	 (face-name (symbol-name face-symbol))
-	 (old-name face-name)
-	 new-name)
-    (while
-	(not (string-equal
-	      old-name
-	      (setq new-name (replace-in-string old-name "^larger-" ""))))
-      (setq old-name new-name))
-    
-    (while
-	(not (string-equal
-	      old-name
-	      (setq new-name (replace-in-string old-name "^smaller-" ""))))
-      (setq old-name new-name))
-    
-    (if (string-equal new-name face-name)
-	face-symbol
-      (intern new-name))))
-
-(defun enriched-encode-other-face (old new)
-  "Generate annotations for random face change.
-One annotation each for foreground color, background color, italic, etc."
-  (cons (and old (enriched-face-ans old))
-	(and new (enriched-face-ans new))))
-	    
-(defun enriched-face-ans (face)
-  "Return annotations specifying FACE."
-  ;; XEmacs change (entire body of this function)
-  (let ((face-name (symbol-name face)))
-    (cond ((string-match "^fg:" face-name)
-	   (list (list "x-color" (substring face-name 3))))
-	  ((string-match "^bg:" face-name)
-	   (list (list "x-bg-color" (substring face-name 3))))
-	  ((or (string-match "^larger-" face-name)
-	       (string-match "^smaller-" face-name))
-	   (cdr (format-annotate-single-property-change
-		 'face nil (enriched-face-strip-size face)
-		 enriched-translations)))
-	  (t
-	   (let* ((fg (and (not (eq (face-foreground face)
-				    (face-foreground 'default)))
-			   (color-name (face-foreground face))))
-		  (bg (and (not (eq (face-background face)
-				    (face-background 'default)))
-			   (color-name (face-background face))))
-		  (ans '()))
-	     (if fg (setq ans (cons (list "x-color" fg) ans)))
-	     (if bg (setq ans (cons (list "x-bg-color" bg) ans)))
-	     ans)))))
-
-;; XEmacs addition
-(defun enriched-size-annotation (n annotation)
-  "Generate ANNOTATION N times."
-  (let ((l '()))
-    (while (not (zerop n))
-      (setq l (cons annotation l))
-      (setq n (1- n)))
-    l))
-
-;; XEmacs addition
-(defun enriched-encode-size (old new)
-  "Return annotations specifying SIZE."
-  (let* ((old (or old 0))
-	 (new (or new 0))
-	 (closing-annotation
-	  (enriched-size-annotation (abs old)
-				    (if (> old 0) "bigger" "smaller")))
-	 (opening-annotation
-	  (enriched-size-annotation (abs new)
-				    (if (> new 0) "bigger" "smaller"))))
-    (cons closing-annotation
-	  opening-annotation)))
-
-;;;
-;;; Decoding files
-;;;
-
-;;;###autoload
-(defun enriched-decode (from to)
-  (if enriched-verbose (message "Enriched: decoding document..."))
-  (use-hard-newlines 1 'never)
-  (save-excursion
-    (save-restriction
-      (narrow-to-region from to)
-      (goto-char from)
-
-      ;; Deal with header
-      (let ((file-width (enriched-get-file-width)))
-	(enriched-remove-header)
-
-	;; Deal with newlines
-	(while (search-forward-regexp "\n\n+" nil t)
-	  (if (current-justification)
-	      (delete-char -1))
-	  (set-hard-newline-properties (match-beginning 0) (point)))
-
-	;; Translate annotations
-	(format-deannotate-region from (point-max) enriched-translations
-				  'enriched-next-annotation)
-
-	;; Indent or fill the buffer
-	(cond (file-width		; File was filled to this width
-	       (setq fill-column file-width)
-	       (if enriched-verbose (message "Indenting..."))
-	       (enriched-insert-indentation))
-	      (t			; File was not filled.
-	       (if enriched-verbose (message "Filling paragraphs..."))
-	       (fill-region (point-min) (point-max))))
-	(if enriched-verbose (message nil)))
-      (point-max))))
-
-(defun enriched-next-annotation ()
-  "Find and return next text/enriched annotation.
-Any \"<<\" strings encountered are converted to \"<\".
-Return value is \(begin end name positive-p), or nil if none was found."
-  (while (and (search-forward "<" nil 1)
-	      (progn (goto-char (match-beginning 0))
-		     (not (looking-at enriched-annotation-regexp))))
-    (forward-char 1)
-    (if (= ?< (char-after (point)))
-	(delete-char 1)
-      ;; A single < that does not start an annotation is an error,
-      ;; which we note and then ignore.
-      (message "Warning: malformed annotation in file at %s" 
-	       (1- (point)))))
-  (if (not (eobp))
-      (let* ((beg (match-beginning 0))
-	     (end (match-end 0))
-	     (name (downcase (buffer-substring 
-			      (match-beginning 2) (match-end 2))))
-	     (pos (not (match-beginning 1))))
-	(list beg end name pos))))
-
-(defun enriched-get-file-width ()
-  "Look for file width information on this line."
-  (save-excursion
-    (if (search-forward "Text-Width: " (+ (point) 1000) t)
-	(read (current-buffer)))))
-
-(defun enriched-remove-header ()
-  "Remove file-format header at point."
-  (while (looking-at "^[-A-Za-z]+: .*\n")
-    (delete-region (point) (match-end 0)))
-  (if (looking-at "^\n")
-      (delete-char 1)))
-
-(defun enriched-decode-foreground (from to &optional color)
-  ;; XEmacs change
-  (let ((face (facemenu-get-face (intern (concat "fg:" color)))))
-    (if (not face)
-	(progn
-	  (make-face face)
-	  (message "Warning: Color \"%s\" can't be displayed." color)))
-    (list from to 'face face)))
-
-(defun enriched-decode-background (from to &optional color)
-  ;; XEmacs change
-  (let ((face (facemenu-get-face (intern (concat "bg:" color)))))
-    (if (not face)
-	(progn
-	  (make-face face)
-	  (message "Warning: Color \"%s\" can't be displayed." color)))
-    (list from to 'face face)))
-
-;;; enriched.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/env.el b/xemacs-packages/lisp/xemacs-base/env.el
deleted file mode 100644
index 4dfbab88..00000000
--- a/xemacs-packages/lisp/xemacs-base/env.el
+++ /dev/null
@@ -1,149 +0,0 @@
-;;; env.el --- functions to manipulate environment variables.
-
-;; Copyright 1991, 1994, 2001 Free Software Foundation, Inc.
-
-;; Maintainer: XEmacs Development Team
-;; Keywords: processes, unix
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 21.1.50
-
-;;; Commentary:
-
-;; UNIX processes inherit a list of name-to-string associations from their
-;; parents called their `environment'; these are commonly used to control
-;; program options.  This package permits you to set environment variables
-;; to be passed to any sub-process run under XEmacs.
-
-;;; Code:
-
-;; History list for environment variable names.
-(defvar read-envvar-name-history nil)
-
-(defun read-envvar-name (prompt &optional mustmatch)
-  "Read environment variable name, prompting with PROMPT.
-Optional second arg MUSTMATCH, if non-nil, means require existing envvar name.
-If it is also not t, RET does not exit if it does non-null completion."
-  (completing-read prompt
-		   (mapcar (function
-			    (lambda (enventry)
-			      (list (substring enventry 0
-					       (string-match "=" enventry)))))
-			   process-environment)
-		   nil mustmatch nil 'read-envvar-name-history))
-
-;; History list for VALUE argument to setenv.
-(defvar setenv-history nil)
-
-;;;###autoload
-(defun substitute-env-vars (string)
-  "Substitute environment variables referred to in STRING.
-`$FOO' where FOO is an environment variable name means to substitute
-the value of that variable.  The variable name should be terminated
-with a character not a letter, digit or underscore; otherwise, enclose
-the entire variable name in braces.  Use `$$' to insert a single
-dollar sign."
-  (let ((start 0))
-    (while (string-match
-	    ;; XEmacs change - FSF use their rx macro to generate this regexp
-	    "\\(?:\\$\\(\\(?:[a-zA-Z0-9_]\\)+\\)\\)\\|\\(?:\\${\\(\\(?:.\\|\n\\)*?\\)}\\)\\|\\$\\$"
-	    string start)
-      (cond ((match-beginning 1)
-	     (let ((value (getenv (match-string 1 string))))
-	       (setq string (replace-match (or value "") t t string)
-		     start (+ (match-beginning 0) (length value)))))
-	    ((match-beginning 2)
-	     (let ((value (getenv (match-string 2 string))))
-	       (setq string (replace-match (or value "") t t string)
-		     start (+ (match-beginning 0) (length value)))))
-	    (t
-	     (setq string (replace-match "$" t t string)
-		   start (+ (match-beginning 0) 1)))))
-    string))
-
-;;;###autoload
-(defun setenv (variable &optional value unset substitute-env-vars)
-  "Set the value of the environment variable named VARIABLE to VALUE.
-VARIABLE should be a string.  VALUE is optional; if not provided or is
-`nil', the environment variable VARIABLE will be removed.
-
-UNSET, if non-nil, means to remove VARIABLE from the environment.
-SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment
-variables in VALUE using `substitute-env-vars'.
-
-Interactively, a prefix argument means to unset the variable.
-Interactively, the current value (if any) of the variable
-appears at the front of the history list when you type in the new value.
-
-This function works by modifying `process-environment'."
-  (interactive
-   (if current-prefix-arg
-       (list (read-envvar-name "Clear environment variable: " 'exact) nil t)
-     (let* ((var (read-envvar-name "Set environment variable: " nil))
-	    (oldval (getenv var))
-	    newval
-	    oldhist)
-       ;; Don't put the current value on the history
-       ;; if it is already there.
-       (if (equal oldval (car setenv-history))
-	   (setq oldval nil))
-       ;; Now if OLDVAL is non-nil, we should add it to the history.
-       (if oldval
-	   (setq setenv-history (cons oldval setenv-history)))
-       (setq oldhist setenv-history)
-       (setq newval (read-from-minibuffer (format "Set %s to value: " var)
-					  nil nil nil 'setenv-history))
-       ;; If we added the current value to the history, remove it.
-       ;; Note that read-from-minibuffer may have added the new value.
-       ;; Don't remove that!
-       (if oldval
-	   (if (eq oldhist setenv-history)
-	       (setq setenv-history (cdr setenv-history))
-	     (setcdr setenv-history (cdr (cdr setenv-history)))))
-       ;; Here finally we specify the args to call setenv with.
-       (list var newval))))
-  (if unset 
-      (setq value nil)
-    (if substitute-env-vars
-	(setq value (substitute-env-vars value))))
-  (if (string-match "=" variable)
-      (error "Environment variable name `%s' contains `='" variable)
-    (let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
-	  (case-fold-search nil)
-	  (scan process-environment)
-	  found)
-      (if (string-equal "TZ" variable)
-	  (set-time-zone-rule value))
-      (while scan
-	(cond ((string-match pattern (car scan))
-	       (setq found t)
-	       (if (eq nil value)
-		   (setq process-environment (delq (car scan) process-environment))
-		 (setcar scan (concat variable "=" value)))
-	       (setq scan nil)))
-	(setq scan (cdr scan)))
-      (or found
-	  (if value
-	      (setq process-environment
-		    (cons (concat variable "=" value)
-			  process-environment))))))) ;FSF 21.1.50 returns value
-
-(provide 'env)
-
-;;; env.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/facemenu.el b/xemacs-packages/lisp/xemacs-base/facemenu.el
deleted file mode 100644
index b5b1eeee..00000000
--- a/xemacs-packages/lisp/xemacs-base/facemenu.el
+++ /dev/null
@@ -1,878 +0,0 @@
-;;; facemenu.el --- create a face menu for interactively adding fonts to text
-
-;; Copyright (c) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Boris Goldowsky 
-;; Adapted-by: Mike Sperber 
-;; Maintainer: XEmacs Development Team
-;; Keywords: faces
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 20.2  (but not literally)
-
-;;; Commentary:
-
-;; This file defines a menu of faces (bold, italic, etc) which allows you to
-;; set the face used for a region of the buffer.  Some faces also have
-;; keybindings, which are shown in the menu.  Faces with names beginning with
-;; "fg:" or "bg:", as in "fg:red", are treated specially.
-;; Such faces are assumed to consist only of a foreground (if "fg:") or
-;; background (if "bg:") color.  They are thus put into the color submenus
-;; rather than the general Face submenu.  These faces can also be
-;; automatically created by selecting the "Other..." menu items in the
-;; "Foreground" and "Background" submenus.
-;;
-;; The menu also contains submenus for indentation and justification-changing
-;; commands.
-
-;;; Usage:
-;; Selecting a face from the menu or typing the keyboard equivalent will
-;; change the region to use that face.  If you use transient-mark-mode and the
-;; region is not active, the face will be remembered and used for the next
-;; insertion.  It will be forgotten if you move point or make other
-;; modifications before inserting or typing anything.
-;;
-;; Faces can be selected from the keyboard as well.  
-;; The standard keybindings are C-x M-f + letter:
-;; C-x M-f i = "set italic",  C-x M-f b = "set bold", etc.
-;;
-;; Feel free to bind it to something more accessible, for instance:
-;;  (global-set-key [f5] 'facemenu-keymap)
-
-;;; Customization:
-;; An alternative set of keybindings that may be easier to type can be set up
-;; using "Alt" or "Hyper" keys.  This requires that you either have or create
-;; an Alt or Hyper key on your keyboard.  On my keyboard, there is a key
-;; labeled "Alt", but to make it act as an Alt key I have to put this command
-;; into my .xinitrc:
-;;    xmodmap -e "add Mod3 = Alt_L"
-;; Or, I can make it into a Hyper key with this:
-;;    xmodmap -e "keysym Alt_L = Hyper_L" -e "add Mod2 = Hyper_L"
-;; Check with local X-perts for how to do it on your system.
-;; Then you can define your keybindings with code like this in your .emacs:
-;;   (setq facemenu-keybindings
-;;    '((default     . [?\H-d])
-;;      (bold        . [?\H-b])
-;;      (italic      . [?\H-i])
-;;      (bold-italic . [?\H-l])
-;;      (underline   . [?\H-u])))
-;;   (facemenu-update)
-;;   (setq facemenu-keymap global-map)
-;;   (define-key global-map [?\H-c] 'facemenu-set-foreground) ; set fg color
-;;   (define-key global-map [?\H-C] 'facemenu-set-background) ; set bg color
-;;
-;; The order of the faces that appear in the menu and their keybindings can be
-;; controlled by setting the variables `facemenu-keybindings' and
-;; `facemenu-new-faces-at-end'.  List faces that you don't use in documents
-;; (eg, `region') in `facemenu-unlisted-faces'.
-
-;;; Known Problems:
-;; Bold and Italic do not combine to create bold-italic if you select them
-;; both, although most other combinations (eg bold + underline + some color)
-;; do the intuitive thing.
-;;
-;; There is at present no way to display what the faces look like in
-;; the menu itself.
-;;
-;; `edit-faces' shows the faces in a different order than
-;; this menu, which could be confusing.  I do /not/ sort the list
-;; alphabetically, because I like the default order: it puts the most
-;; basic, common fonts first.
-;;
-;; Please send me any other problems, comments or ideas.
-
-;;; Code:
-
-(provide 'facemenu)
-
-;; XEmacs
-(require 'easymenu)
-
-;;; Provide some binding for startup:
-;;;###autoload(autoload 'facemenu-keymap "facemenu" nil t 'keymap)
-;;;###autoload(define-key ctl-x-map "F" 'facemenu-keymap)
-
-(defgroup facemenu nil
-  "Create a face menu for interactively adding fonts to text."
-  :group 'faces
-  :prefix "facemenu-")
-
-(defcustom facemenu-keybindings
-  '((default     . "d")
-    (bold        . "b")
-    (italic      . "i")
-    (bold-italic . "l") ; {bold} intersect {italic} = {l}
-    (underline   . "u"))
-  "Alist of interesting faces and keybindings. 
-Each element is itself a list: the car is the name of the face,
-the next element is the key to use as a keyboard equivalent of the menu item;
-the binding is made in `facemenu-keymap'.
-
-The faces specifically mentioned in this list are put at the top of
-the menu, in the order specified.  All other faces which are defined,
-except for those in `facemenu-unlisted-faces', are listed after them, 
-but get no keyboard equivalents.
-
-If you change this variable after loading facemenu.el, you will need to call
-`facemenu-update' to make it take effect."
-  :type '(repeat (cons face string))
-  :group 'facemenu)
-
-(defcustom facemenu-new-faces-at-end t
-  "*Where in the menu to insert newly-created faces.
-This should be nil to put them at the top of the menu, or t to put them
-just before \"Other\" at the end."
-  :type 'boolean
-  :group 'facemenu)
-
-;; XEmacs -- additional faces
-(defcustom facemenu-unlisted-faces
-  '(modeline region secondary-selection highlight scratch-face
-    gui-button-face isearch hyperlink
-    modeline modeline-buffer-id modeline-mousable modeline-mousable-minor-mode
-    pointer primary-selection secondary-selection list-mode-item-selected
-    text-cursor zmacs-region
-    left-margin right-margin
-    "^font-lock-" "^gnus-" "^message-" "^ediff-" "^term-" "^vc-"
-    "^widget-" "^custom-" "^vm-")
-  "*List of faces not to include in the Face menu.
-Each element may be either a symbol, which is the name of a face, or a string,
-which is a regular expression to be matched against face names.  Matching
-faces will not be added to the menu.
-
-You can set this list before loading facemenu.el, or add a face to it before
-creating that face if you do not want it to be listed.  If you change the
-variable so as to eliminate faces that have already been added to the menu,
-call `facemenu-update' to recalculate the menu contents.
-
-If this variable is t, no faces will be added to the menu.  This is useful for
-temporarily turning off the feature that automatically adds faces to the menu
-when they are created."
-  :type '(choice (const :tag "Don't add" t)
-		 (const :tag "None" nil)
-		 (repeat (choice symbol regexp)))
-  :group 'facemenu)
-
-(defcustom facemenu-relevant-face-attributes
-  '(foreground background font underline highlight dim blinking reverse)
-  "*List of face attributes that facemenu fiddles with."
-  :type '(repeat (symbol :tag "Attribute"))
-  :group 'facemenu)
-
-(defcustom facemenu-add-face-function nil
-  "Function called at beginning of text to change or `nil'.
-This function is passed the FACE to set and END of text to change, and must
-return a string which is inserted.  It may set `facemenu-end-add-face'."
-  :type '(choice (const :tag "None" nil)
-		 function)
-  :group 'facemenu)
-
-(defcustom facemenu-end-add-face nil
-  "String to insert or function called at end of text to change or `nil'.
-This function is passed the FACE to set, and must return a string which is
-inserted."
-  :type '(choice (const :tag "None" nil)
-		 string
-		 function)
-  :group 'facemenu)
-
-(defcustom facemenu-remove-face-function nil
-  "When non-`nil' function called to remove faces.
-This function is passed the START and END of text to change.
-May also be `t' meaning to use `facemenu-add-face-function'."
-  :type '(choice (const :tag "None" nil)
-		 (const :tag "Use add-face" t)
-		 function)
-  :group 'facemenu)
-
-(easy-menu-define facemenu-face-menu ()
-   "Menu for faces"
-   `("Face"
-     ["Other..." facemenu-set-face t]))
-
-(easy-menu-define facemenu-foreground-menu ()
-  "Menu for foreground colors"
-  `("Foreground Color"
-    ["Other..." facemenu-set-foreground t]))
-
-(easy-menu-define facemenu-background-menu ()
-  "Menu for background colors"
-  `("Background Color"
-    ["Other..." facemenu-set-background t]))
-
-(easy-menu-define facemenu-size-menu ()
-  "Menu for font sizes."
-  '("Size"
-    ["Default" facemenu-set-size-default t]
-    ["Bigger" facemenu-make-larger t]
-    ["Smaller" facemenu-make-smaller t]
-    ["Much Bigger" facemenu-make-much-larger t]
-    ["Much Smaller" facemenu-make-much-smaller t]))
-
-(easy-menu-define facemenu-special-menu ()
-  "Menu for non-face text-properties."
-  '("Special"
-    ["Read-Only" facemenu-set-read-only t]
-    ["Invisible" facemenu-set-invisible t]
-    ["Intangible" facemenu-set-intangible t]
-    ["Remove Special" facemenu-remove-special t]))
-
-(easy-menu-define facemenu-justification-menu ()
-  "Menu for text justification commands."
-  '("Justification"
-    ["Center" set-justification-center t]
-    ["Full" set-justification-full t]
-    ["Right" set-justification-right t]
-    ["Unfilled" set-justification-none t]))
-
-(easy-menu-define facemenu-indentation-menu
-  ()
-  "Submenu for indentation commands."
-  '("Indentation"
-    ["Indent More" increase-left-margin t]
-    ["Indent Less" decrease-left-margin t]
-    ["Indent Right More" increase-right-margin t]
-    ["Indent Right Less" decrease-right-margin t]))
-
-;;;###autoload
-(defvar facemenu-menu nil
-  "Facemenu top-level menu keymap.")
-
-(defun facemenu-update-facemenu-menu ()
-  (easy-menu-define facemenu-menu ()
-   "Facemenu top-level menu"
-   (list "Text Properties"
-	 facemenu-face-menu
-	 facemenu-foreground-menu
-	 facemenu-background-menu
-	 facemenu-size-menu
-	 facemenu-special-menu
-	 "---"
-	 facemenu-justification-menu
-	 facemenu-indentation-menu
-	 "---"
-	 ["Remove Properties" facemenu-remove-props t]
-	 ["List Properties" list-text-properties-at t]
-	 ["Display Faces" edit-faces t]
-	 ["Display Colors" list-colors-display t])))
-
-;;;###autoload
-(defvar facemenu-keymap
-  (let ((map (make-sparse-keymap "Set face")))
-    (define-key map ?o 'facemenu-set-face)
-    map)
-  "Keymap for face-changing commands.
-`Facemenu-update' fills in the keymap according to the bindings
-requested in `facemenu-keybindings'.")
-;;;###autoload
-(defalias 'facemenu-keymap facemenu-keymap)
-
-
-;;; Internal Variables
-
-(defvar facemenu-color-alist nil
-  ;; Don't initialize here; that doesn't work if preloaded.
-  "Alist of colors, used for completion.
-If null, `facemenu-read-color' will set it.")
-
-(defun facemenu-update ()
-  "Add or update the \"Face\" menu in the menu bar.
-You can call this to update things if you change any of the menu configuration
-variables."
-  (interactive)
-
-  ;; Add each defined face to the menu.
-  (facemenu-iterate 'facemenu-add-new-face
-		    (facemenu-complete-face-list facemenu-keybindings))
-  (facemenu-update-facemenu-menu)
-  
-  ;; Global bindings:
-  (if (string-match "XEmacs" emacs-version)
-      (easy-menu-change '("Edit") (car facemenu-menu) (cdr facemenu-menu))
-    (define-key global-map [C-down-mouse-2] 'facemenu-menu)))
-
-;;;###autoload
-(defun facemenu-set-face (face &optional start end)
-  "Add FACE to the region or next character typed.
-It will be added to the top of the face list; any faces lower on the list that
-will not show through at all will be removed.
-
-Interactively, the face to be used is read with the minibuffer.
-
-If the region is active and there is no prefix argument,
-this command sets the region to the requested face.
-
-Otherwise, this command specifies the face for the next character
-inserted.  Moving point or switching buffers before
-typing a character to insert cancels the specification." 
-  (interactive (list (read-face-name "Use face: ")))
-  (setq zmacs-region-stays t) ; XEmacs
-  (barf-if-buffer-read-only)
-  (facemenu-add-new-face face)
-  (facemenu-update-facemenu-menu) ; XEmacs
-  (if (and (region-active-p)
-	   (not current-prefix-arg))
-      (let ((start (or start (region-beginning)))
-	    (end (or end (region-end))))
-	(facemenu-add-face face start end))
-    (facemenu-self-insert-face face)))
-
-;;;###autoload
-(defun facemenu-set-foreground (color &optional start end)
-  "Set the foreground color of the region or next character typed.
-The color is prompted for.  A face named `fg:color' is used \(or created).
-If the region is active, it will be set to the requested face.  If
-it is inactive \(even if mark-even-if-inactive is set) the next
-character that is typed \(via `self-insert-command') will be set to
-the selected face.  Moving point or switching buffers before
-typing a character cancels the request." 
-  (interactive (list (facemenu-read-color "Foreground color: ")))
-  (setq zmacs-region-stays t)
-  (let ((face (intern (concat "fg:" color))))
-    (or (facemenu-get-face face)
-	(error "Unknown color: %s" color))
-    (facemenu-set-face face start end)))
-
-;;;###autoload
-(defun facemenu-set-background (color &optional start end)
-  "Set the background color of the region or next character typed.
-The color is prompted for.  A face named `bg:color' is used \(or created).
-If the region is active, it will be set to the requested face.  If
-it is inactive \(even if mark-even-if-inactive is set) the next
-character that is typed \(via `self-insert-command') will be set to
-the selected face.  Moving point or switching buffers before
-typing a character cancels the request." 
-  (interactive (list (facemenu-read-color "Background color: ")))
-  (setq zmacs-region-stays t)
-  (let ((face (intern (concat "bg:" color))))
-    (or (facemenu-get-face face)
-	(error "Unknown color: %s" color))
-    (facemenu-set-face face start end)))
-
-;;;###autoload
-(defun facemenu-set-face-from-menu (face start end)
-  "Set the face of the region or next character typed.
-This function is designed to be called from a menu; the face to use
-is the menu item's name.
-
-If the region is active and there is no prefix argument,
-this command sets the region to the requested face.
-
-Otherwise, this command specifies the face for the next character
-inserted.  Moving point or switching buffers before
-typing a character to insert cancels the specification." 
-  (interactive (list last-command-event
-		     (if (and (region-active-p)
-			      (not current-prefix-arg))
-			 (region-beginning))
-		     (if (and (region-active-p)
-			      (not current-prefix-arg))
-			 (region-end))))
-  (barf-if-buffer-read-only)
-  (setq zmacs-region-stays t) ; XEmacs
-  (facemenu-get-face face)
-  (if start
-      (facemenu-add-face face start end)
-    (facemenu-self-insert-face face))) ; XEmacs
-
-;; XEmacs
-(defun facemenu-self-insert-face (face)
-  (setq self-insert-face (cond
-			  ((null self-insert-face) face)
-			  ((consp self-insert-face)
-			   (facemenu-active-faces (cons face self-insert-face)))
-			  (t
-			   (facemenu-active-faces (list face self-insert-face))))
-	self-insert-face-command this-command))
-
-(defun facemenu-face-strip-size (face)
-  "Create a symbol from the name of FACE devoid of size information,
-i.e. remove all larger- and smaller- prefixes."
-  (let* ((face-symbol (face-name face))
-	 (face-name (symbol-name face-symbol))
-	 (old-name face-name)
-	 new-name)
-    (while
-	(not (string-equal
-	      old-name
-	      (setq new-name (replace-in-string old-name "^larger-" ""))))
-      (setq old-name new-name))
-    
-    (while
-	(not (string-equal
-	      old-name
-	      (setq new-name (replace-in-string old-name "^smaller-" ""))))
-      (setq old-name new-name))
-    
-    (if (string-equal new-name face-name)
-	face-symbol
-      (intern new-name))))
-
-(defun facemenu-face-default-size (face)
-  (cond ((null face) nil)
-	((consp face) (mapcar 'facemenu-face-strip-size face))
-	(t (facemenu-face-strip-size face))))
-
-;; This file uses `put-text-property' all over.  All of these calls
-;; have been changed to `add-text-properties' in FSF, but I don't see
-;; any reason to copy that change.
-
-;;;###autoload
-(defun facemenu-set-size-default (start end)
-  (interactive "_r")
-  (put-text-property start end 'size nil)
-  (alter-text-property start end 'face 'facemenu-face-default-size))
-
-(defun facemenu-ensure-size-property (start end)
-  "Ensure that the text between START and END has a 'size text property.
-If it is not present, it is set to 0."
-  (let ((start start)
-	pos bound)
-    (while (setq pos (text-property-any start end 'size nil))
-      (setq bound (or (text-property-not-all pos end 'size nil) end))
-      (put-text-property pos bound 'size 0))))
-
-(defun facemenu-sized-face (face size)
-  "Make a face FACE larger or smaller according to SIZE.
-If SIZE is positive, it calls `make-face-larger' SIZE times,
-else it calls `make-face-smaller' -SIZE times."
-  (if (zerop size)
-      face
-    (let ((name (symbol-name face))
-	  (measure size)
-	  (change-face 'make-face-larger)
-	  prefix)
-
-      (if (> measure 0)
-	  (setq prefix "larger-")
-	(setq prefix "smaller-")
-	(setq measure (- measure))
-	(setq size (- size))
-	(setq change-face 'make-face-smaller))
-
-      (while (not (zerop measure))
-	(setq name (concat prefix name))
-	(setq measure (1- measure)))
-
-      (let ((symbol (intern name)))
-	(or (find-face symbol)
-	    (let ((face (copy-face face symbol)))
-	      (while (not (zerop size))
-		(funcall change-face face)
-		(setq size (1- size)))
-	      face))))))
-
-(defun facemenu-adjust-face-sizes (face)
-  (cond
-   ((null face) (facemenu-sized-face 'default size))
-   ((consp face) (mapcar 
-		  #'(lambda (face)
-		      (facemenu-sized-face (facemenu-face-strip-size face)
-					    size))
-		  face))
-   ;;[BV  9-Feb-97] strip-face from this face too, please!
-   (t (facemenu-sized-face (facemenu-face-strip-size face) size))))
-
-(defun facemenu-adjust-size (from to)
-  "Adjust the size of the text between FROM and TO according
-to the values of the 'size property in that region."
-  (let ((pos from)
-	bound size)
-    (while (< pos to)
-      (setq size (get-text-property pos 'size))
-      (setq bound (or (text-property-not-all pos to 'size size) to))
-      (alter-text-property pos bound 'face 'facemenu-adjust-face-sizes)
-      (setq pos bound))))
-
-(defun facemenu-change-size (from to f)
-  (facemenu-ensure-size-property from to)
-  (alter-text-property from to 'size f)
-  (facemenu-adjust-size from to))
-
-;;;###autoload
-(defun facemenu-make-larger (from to)
-  (interactive "_r")
-  (facemenu-change-size from to '1+))
-
-;;;###autoload
-(defun facemenu-make-smaller (from to)
-  (interactive "_r")
-  (facemenu-change-size from to '1-))
-
-;;;###autoload
-(defun facemenu-make-much-larger (from to)
-  (interactive "_r")
-  (facemenu-change-size from to #'(lambda (s) (+ 5 s))))
-
-;;;###autoload
-(defun facemenu-make-much-smaller (from to)
-  (interactive "_r")
-  (facemenu-change-size from to #'(lambda (s) (- s 5))))
-
-;;;###autoload
-(defun facemenu-set-invisible (start end)
-  "Make the region invisible.
-This sets the `invisible' text property; it can be undone with
-`facemenu-remove-special'."
-  (interactive "_r")
-  (put-text-property start end 'invisible t))
-
-;;;###autoload
-(defun facemenu-set-intangible (start end)
-  "Make the region intangible: disallow moving into it.
-This sets the `intangible' text property; it can be undone with
-`facemenu-remove-special'."
-  (interactive "_r")
-  ;; #### This does nothing in XEmacs.  Should use atomic-extents, but
-  ;; why bother, when that's broken, too?
-  (put-text-property start end 'intangible t))
-
-;;;###autoload
-(defun facemenu-set-read-only (start end)
-  "Make the region unmodifiable.
-This sets the `read-only' text property; it can be undone with
-`facemenu-remove-special'."
-  (interactive "_r")
-  (put-text-property start end 'read-only t))
-
-;;;###autoload
-(defun facemenu-remove-props (start end)
-  "Remove all text properties that facemenu added to region."
-  (interactive "*_r") ; error if buffer is read-only despite the next line.
-  (let ((inhibit-read-only t))
-    (remove-text-properties 
-     start end '(face nil invisible nil intangible nil 
-		 read-only nil category nil size nil))))
-
-;;;###autoload
-(defun facemenu-remove-special (start end)
-  "Remove all the \"special\" text properties from the region.
-These special properties include `invisible', `intangible' and `read-only'."
-  (interactive "*_r") ; error if buffer is read-only despite the next line.
-  (let ((inhibit-read-only t))
-    (remove-text-properties 
-     start end '(invisible nil intangible nil read-only nil))))
-
-;;;###autoload
-(defun list-text-properties-at (p)
-  "Pop up a buffer listing text-properties at LOCATION."
-  (interactive "d")
-  (let ((props (text-properties-at p))
-	category
-	str)
-    (if (null props)
-	(message "None")
-      (if (and (not (cdr (cdr props)))
-	       (not (eq (car props) 'category))
-	       (< (length (setq str (format "Text property at %d:  %s  %S"
-					    p (car props) (car (cdr props)))))
-		  (frame-width)))
-	  (message "%s" str)
-	(with-output-to-temp-buffer "*Text Properties*"
-	  (princ (format "Text properties at %d:\n\n" p))
-	  (while props
-	    (if (eq (car props) 'category)
-		(setq category (car (cdr props))))
-	    (princ (format "%-20s %S\n"
-			   (car props) (car (cdr props))))
-	    (setq props (cdr (cdr props))))
-	  (if category
-	      (progn
-		(setq props (symbol-plist category))
-		(princ (format "\nCategory %s:\n\n" category))
-		(while props
-		  (princ (format "%-20s %S\n"
-				 (car props) (car (cdr props))))
-		  (if (eq (car props) 'category)
-		      (setq category (car (cdr props))))
-		  (setq props (cdr (cdr props)))))))))))
-
-;;;###autoload
-(defalias 'facemenu-read-color 'read-color)
-
-(defun facemenu-canonicalize-color (c)
-  (downcase (replace-in-string c " " "")))
-
-(defun facemenu-unique (list)
-  "Uniquify LIST, deleting elements using `delete'.
-Return the list with subsequent duplicate items removed by side effects."
-  (let ((list list))
-    (while list
-      (setq list (setcdr list (delete (car list) (cdr list))))))
-  list)
-
-;;;###autoload
-(defun list-colors-display (&optional list)
-  "Display names of defined colors, and show what they look like.
-If the optional argument LIST is non-nil, it should be a list of
-colors to display.  Otherwise, this command computes a list
-of colors that the current display can handle."
-  (interactive)
-  (setq list
-	(facemenu-unique
-	 (mapcar 'facemenu-canonicalize-color
-		 (mapcar 'car (read-color-completion-table)))))
-  (with-output-to-temp-buffer "*Colors*"
-    (save-excursion
-      (set-buffer standard-output)
-      (let ((facemenu-unlisted-faces t)
-	    s)
-	(while list
-	  (if (not (string-match "[0-9]" (car list)))
-	      (progn
-		(setq s (point))
-		(insert (car list))
-		(indent-to 20)
-		(put-text-property s (point) 'face 
-				   (facemenu-get-face 
-				    (intern (concat "bg:" (car list)))))
-		(setq s (point))
-		(insert "  " (car list) "\n")
-		(put-text-property s (point) 'face 
-				   (facemenu-get-face 
-				    (intern (concat "fg:" (car list)))))))
-	  (setq list (cdr list)))))))
-
-(fset 'facemenu-color-values 
-	(if (fboundp 'x-color-values)
-	    'x-color-values
-	  #'(lambda (color)
-	      (color-instance-rgb-components
-	       (make-color-instance color)))))
-
-(defun facemenu-color-equal (a b)
-  "Return t if colors A and B are the same color.
-A and B should be strings naming colors.
-This function queries the window-system server to find out what the
-color names mean.  It returns nil if the colors differ or if it can't
-determine the correct answer."
-  (cond ((equal a b) t)
-	((and (equal (facemenu-color-values a)
-		     (facemenu-color-values b))))))
-
-(defun facemenu-add-face (face &optional start end)
-  "Add FACE to text between START and END.
-For each section of that region that has a different face property, FACE will
-be consed onto it, and other faces that are completely hidden by that will be
-removed from the list.
-
-As a special case, if FACE is `default', then the region is left with NO face
-text property.  Otherwise, selecting the default face would not have any
-effect."
-  (interactive "*_xFace:\nr")
-  (if (and (eq face 'default)
-	   (not (eq facemenu-remove-face-function t)))
-      (if facemenu-remove-face-function
-	  (funcall facemenu-remove-face-function start end)
-	(if (and start (< start end))
-	    (remove-text-properties start end '(face default))
-	  (setq self-insert-face 'default
-		self-insert-face-command this-command)))
-    (if facemenu-add-face-function
-	(save-excursion
-	  (if end (goto-char end))
-	  (save-excursion
-	    (if start (goto-char start))
-	    (insert-before-markers
-	     (funcall facemenu-add-face-function face end)))
-	  (if facemenu-end-add-face
-	      (insert (if (stringp facemenu-end-add-face)
-			  facemenu-end-add-face
-			(funcall facemenu-end-add-face face)))))
-      (if (and start (< start end))
-	  (let ((part-start start) part-end)
-	    (while (not (= part-start end))
-	      (setq part-end (next-single-property-change part-start 'face
-							  nil end))
-	      (let ((prev (get-text-property part-start 'face)))
-		(put-text-property part-start part-end 'face
-				   (if (null prev)
-				       face
-				     (facemenu-active-faces
-				      (cons face
-					    (if (listp prev)
-						prev
-					      (list prev)))))))
-	      (setq part-start part-end)))
-	(setq self-insert-face (if (eq last-command self-insert-face-command)
-				   (cons face (if (listp self-insert-face)
-						  self-insert-face
-						(list self-insert-face)))
-				 face)
-	      self-insert-face-command this-command)))))
-
-;; XEmacs
-(defun facemenu-face-attributes (face)
-  "Create a vector of the relevant face attributes of face FACE."
-  (mapvector #'(lambda (prop)
-		 (face-property-instance face prop))
-	     facemenu-relevant-face-attributes))
-
-(defun facemenu-active-faces (face-list)
-  "Return from FACE-LIST those faces that would be used for display.
-This means each face attribute is not specified in a face earlier in FACE-LIST
-and such a face is therefore active when used to display text."
-  (let* ((mask-atts (copy-sequence (facemenu-face-attributes (car face-list))))
-	 (default-atts (facemenu-face-attributes 'default))
-	 (active-list (list (car face-list)))
-	 (face-list (cdr face-list))
-	 (mask-len (length mask-atts)))
-    (while face-list
-      (if (let ((face-atts (facemenu-face-attributes (car face-list)))
-		(i mask-len)
-		(useful nil))
-	    (while (>= (setq i (1- i)) 0)
-	      (if (and (aref face-atts i)
-		       (or (not (aref mask-atts i))
-			   (eq (aref mask-atts i) (aref default-atts i)))
-		       (not (eq (aref face-atts i) (aref default-atts i))))
-		  (aset mask-atts i (setq useful t))))
-	    useful)
-	  (setq active-list (cons (car face-list) active-list)))
-      (setq face-list (cdr face-list)))
-    (nreverse active-list)))
-
-;;;###autoload
-(defun facemenu-get-face (symbol)
-  "Make sure FACE exists.
-If not, create it and add it to the appropriate menu.  Return the symbol.
-
-If this function creates a face named `fg:color', then it sets the
-foreground to that color.  Likewise, `bg:color' means to set the
-background.  In either case, if the color is undefined, no color is
-set and a warning is issued."
-  (let ((name (symbol-name symbol))
-	foreground)
-    (cond ((find-face symbol))
-	  ((or (setq foreground (string-match "^fg:" name))
-	       (string-match "^bg:" name))
-	   (let* ((face (make-face symbol))
-		  (color (substring name 3)))
-	     (if (color-instance-p (make-color-instance color))
-		 (if foreground
-		     (set-face-foreground face color)
-		   (set-face-background face color))
-	       (warn "Color `%s' undefined" color))))
-	  (t (make-face symbol))))
-  symbol)
-
-(defun facemenu-menu-has-face (menu face-name)
-  "Check if menu MENU has an entry for face named by string FACE-NAME.
-Returns entry if successful."
-  (facemenu-iterate
-   #'(lambda (m)
-       (and (vectorp m) 
-	    (string-equal face-name (aref m 0))
-	    m))
-   (cdr menu)))
-
-(defun facemenu-insert-menu-entry (menu before-entry name function)
-  "Insert menu item with name NAME and associated function FUNCTION
-into menu MENU before entry BEFORE-ENTRY."
-  (when (featurep 'menubar)
-    (while (not (eq (cadr menu) before-entry))
-      (setq menu (cdr menu)))
-    (setcdr menu (cons (vector name function t) (cdr menu)))))
-
-(defun facemenu-add-new-face (face)
-  "Add a FACE to the appropriate Face menu.
-Automatically called when a new face is created."
-  (let* ((name (symbol-name face))
-	 menu menu-value
-	 (key (cdr (assoc face facemenu-keybindings))))
-    (cond ((eq t facemenu-unlisted-faces))
-	  ((string-match "^fg:" name)
-	   (setq name (substring name 3)
-		 docstring (format
-			    "Select foreground color %s for subsequent insertion."
-			    name)
-		 menu 'facemenu-foreground-menu))
-	  ((string-match "^bg:" name)
-	   (setq name (substring name 3)
-		 docstring (format
-			    "Select background color %s for subsequent insertion."
-			    name)
-		 menu 'facemenu-background-menu))
-	  (t
-	   (setq docstring (format "Select face `%s' for subsequent insertion."
-				   name)
-		 menu 'facemenu-face-menu)))
-    (setq menu-value (symbol-value menu))
-    (cond ((eq t facemenu-unlisted-faces))
-	  ((memq face facemenu-unlisted-faces))
-	  ((string-match "^larger-" name))
-	  ((string-match "^smaller-" name))
-	  ;; Test against regexps in facemenu-unlisted-faces
-	  ((let ((unlisted facemenu-unlisted-faces)
-		 (matched nil))
-	     (while (and unlisted (not matched))
-	       (if (and (stringp (car unlisted))
-			(string-match (car unlisted) name))
-		   (setq matched t)
-		 (setq unlisted (cdr unlisted))))
-	     matched))
-	  (key ; has a keyboard equivalent.  These go at the front.
-	   (let ((function (intern (concat "facemenu-set-" name))))
-	     (fset function
-		   `(lambda ()
-		      ,docstring
-		      (interactive "_")
-		      (facemenu-set-face (quote ,face))))
-	     (define-key 'facemenu-keymap key function)
-	     (unless (facemenu-menu-has-face menu-value name)
-	       (set menu
-		    (cons (car menu-value)
-			  (cons (vector name function t)
-				(cdr menu-value)))))))
-	  ((facemenu-menu-has-face menu-value name))
-	  (t   ; No keyboard equivalent.  Figure out where to put it:
-	   (let ((before-entry
-		   (or (and facemenu-new-faces-at-end
-				     (facemenu-menu-has-face menu-value "Other..."))
-		       (cadr menu-value))))
-	     (facemenu-insert-menu-entry
-	      menu-value before-entry name
-	      (` (facemenu-set-face (quote (, face)))))))))
-  nil) ; Return nil for facemenu-iterate
-
-(defun facemenu-complete-face-list (&optional oldlist)
-  "Return list of all faces that look different.
-Starts with given ALIST of faces, and adds elements only if they display 
-differently from any face already on the list.
-The faces on ALIST will end up at the end of the returned list, in reverse 
-order."
-  (let ((list (nreverse (mapcar 'car oldlist))))
-    (facemenu-iterate 
-     (lambda (new-face) 
-       (if (not (memq new-face list))
-	   (setq list (cons new-face list)))
-       nil)
-     (nreverse (face-list)))
-    list))
-
-(defun facemenu-iterate (func iterate-list)
-  "Apply FUNC to each element of LIST until one returns non-nil.
-Returns the non-nil value it found, or nil if all were nil."
-  (while (and iterate-list (not (funcall func (car iterate-list))))
-    (setq iterate-list (cdr iterate-list)))
-  (car iterate-list))
-
-(facemenu-update)
-
-;;; facemenu.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/ffap.el b/xemacs-packages/lisp/xemacs-base/ffap.el
deleted file mode 100644
index 24cbff09..00000000
--- a/xemacs-packages/lisp/xemacs-base/ffap.el
+++ /dev/null
@@ -1,1732 +0,0 @@
-;;; ffap.el --- find file (or url) at point
-;;
-;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
-;;
-;; Author: Michelangelo Grigni 
-;; Created: 29 Mar 1993
-;; Keywords: files, hypermedia, matching, mouse
-;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
-;; X-Source: this file is generated from ffap.epp
-
-;; 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:
-;;
-;; Command find-file-at-point replaces find-file.  With a prefix, it
-;; behaves exactly like find-file.  Without a prefix, it first tries
-;; to guess a default file or URL from the text around the point
-;; (`ffap-require-prefix' swaps these behaviors).  This is useful for
-;; following references in situations such as mail or news buffers,
-;; README's, MANIFEST's, and so on.  Submit bugs or suggestions with
-;; M-x ffap-bug.
-;;
-;; For the default installation, byte-compile ffap.el somewhere in
-;; your `load-path' and add these two lines to your .emacs file:
-;;
-;; (require 'ffap)                      ; load the package
-;; (ffap-bindings)                      ; do default key bindings
-;;
-;; ffap-bindings makes the following global key bindings:
-;;
-;; C-x C-f       find-file-at-point (abbreviated as ffap)
-;; C-x 4 f       ffap-other-window
-;; C-x 5 f       ffap-other-frame
-;; S-mouse-3     ffap-at-mouse
-;; C-S-mouse-3   ffap-menu
-;;
-;; ffap-bindings also adds hooks to make the following local bindings
-;; in vm, gnus, and rmail:
-;;
-;; M-l         ffap-next, or ffap-gnus-next in gnus (l == "link")
-;; M-m         ffap-menu, or ffap-gnus-menu in gnus (m == "menu")
-;;
-;; If you do not like these bindings, modify the variable
-;; `ffap-bindings', or write your own.
-;;
-;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
-;; to load or autoload them before ffap.  If you use ff-paths, load it
-;; afterwards.  Try apropos {C-h a ffap RET} to get a list of the many
-;; option variables.  In particular, if ffap is slow, try these:
-;;
-;; (setq ffap-alist nil)                ; faster, dumber prompting
-;; (setq ffap-machine-p-known 'accept)  ; no pinging
-;; (setq ffap-url-regexp nil)           ; disable URL features in ffap
-;;
-;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
-;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
-;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
-;; the file and URL references within a buffer.
-;;
-;; XEmacs users might want to add this mouse-track binding:
-;; (add-hook 'mouse-track-click-hook 'ffap-mouse-track-click)
-
-
-;;; Change Log:
-;;
-;; The History and Contributors moved to ffap.LOG (same ftp site),
-;; which also has some old examples and commentary from ffap 1.5.
-
-
-;;; Todo list:
-;; * use kpsewhich
-;; * let "/path/file#key" jump to key (tag or regexp) in /path/file
-;; * find file of symbol if TAGS is loaded (like above)
-;; * break long menus into multiple panes (like imenu?)
-;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
-;; * notice "machine.dom blah blah blah path/file" (how?)
-;; * as w3 becomes standard, rewrite to rely more on its functions
-;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
-;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
-;; * handle "$(VAR)" in Makefiles
-;; * use the font-lock machinery
-
-
-;;; Code:
-
-(provide 'ffap)
-
-;; Please do not delete this variable, it is checked in bug reports.
-(defconst ffap-version "1.9-gen <97/06/29 00:26:46 mic>"
-  "The version of ffap: \"Major.Minor-Build \"")
-
-;; Allow compilation by users without Per Abrahamsen's new custom
-;; library :
-(eval-and-compile			; is this widely supported?
-  (or (featurep 'custom) (load "custom" t))
-  (if (fboundp 'custom-declare-variable) ; got it
-      nil
-    (defmacro defgroup (&rest args) "do nothing" nil)
-    (defmacro defcustom (var value doc &rest args) "just defvar"
-      (list 'defvar var value doc))
-    ))
-(require 'custom)
-
-
-(defgroup ffap nil
-  "Find file or URL at point."
-  :link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/")
-  :group 'matching)
-
-;; The code is organized in pages, separated by formfeed characters.
-;; See the next two pages for standard customization ideas.
-
-
-;;; User Variables:
-
-(defun ffap-soft-value (name &optional default)
-  "Return value of symbol with NAME, if it is interned.
-Otherwise return nil (or the optional DEFAULT value)."
-  ;; Bug: (ffap-soft-value "nil" 5) --> 5
-  (let ((sym (intern-soft name)))
-    (if (and sym (boundp sym)) (symbol-value sym) default)))
-
-(defcustom ffap-ftp-regexp
-  ;; This used to test for ange-ftp or efs being present, but it should be
-  ;; harmless (and simpler) to give it this value unconditionally.
-  "\\`/[^/:]+:"
-  "*Paths matching this regexp are treated as remote ftp paths by ffap.
-If nil, ffap neither recognizes nor generates such paths."
-  :type '(choice (const :tag "Disable" nil)
-		 (const :tag "Standard" "\\`/[^/:]+:")
-		 regexp)
-  :group 'ffap)
-
-(defcustom ffap-url-unwrap-local t
-  "*If non-nil, convert \"file:\" url to local path before prompting."
-  :type 'boolean
-  :group 'ffap)
-
-(defcustom ffap-url-unwrap-remote t
-  "*If non-nil, convert \"ftp:\" url to remote path before prompting.
-This is ignored if `ffap-ftp-regexp' is nil."
-  :type 'boolean
-  :group 'ffap)
-
-(defcustom ffap-ftp-default-user "anonymous"
-  "*User name in ftp paths generated by `ffap-host-to-path'.
-Note this name may be omitted if it equals the default
-\(either `efs-default-user' or `ange-ftp-default-user'\)."
-  :type 'string
-  :group 'ffap)
-
-(defcustom ffap-rfs-regexp
-  ;; Remote file access built into file system?  HP rfa or Andrew afs:
-  "\\`/\\(afs\\|net\\)/."
-  ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
-  "*Matching paths are treated as remote.  nil to disable."
-  :type 'regexp
-  :group 'ffap)
-
-(defvar ffap-url-regexp
-  ;; Could just use `url-nonrelative-link' of w3, if loaded.
-  ;; This regexp is not exhaustive, it just matches common cases.
-  (concat
-   "\\`\\("
-   "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
-   "\\|"
-   "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
-   "\\)."				; require one more character
-   )
-   "Regexp matching URL's.  nil to disable URL features in ffap.")
-
-(defcustom ffap-foo-at-bar-prefix "mailto"
-  "*Presumed URL prefix type of strings like \"\".
-Sensible values are nil, \"news\", or \"mailto\"."
-  :type '(choice (const "mailto")
-		 (const "news")
-		 (const :tag "Disable" nil)
-		 ;; string -- possible, but not really useful
-		 )
-  :group 'ffap)
-
-
-;;; Peanut Gallery (More User Variables):
-;;
-;; Users of ffap occasionally suggest new features.  If I consider
-;; those features interesting but not clear winners (a matter of
-;; personal taste) I try to leave options to enable them.  Read
-;; through this section for features that you like, put an appropriate
-;; enabler in your .emacs file.
-
-(defcustom ffap-dired-wildcards nil
-  ;; Suggestion from RHOGEE, 07 Jul 1994.  Disabled, dired is still
-  ;; available by "C-x C-d ", and valid filenames may
-  ;; sometimes contain wildcard characters.
-  "*A regexp matching filename wildcard characters, or nil.
-If `find-file-at-point' gets a filename matching this pattern,
-it passes it on to `dired' instead of `find-file'."
-  :type '(choice (const :tag "Disable" nil)
-		 (const :tag "Enable" "[*?][^/]*\\'")
-		 ;; regexp -- probably not useful
-		 )
-  :group 'ffap)
-
-(defcustom ffap-newfile-prompt nil
-  ;; Suggestion from RHOGEE, 11 Jul 1994.  Disabled, I think this is
-  ;; better handled by `find-file-not-found-hooks'.
-  "*Whether `find-file-at-point' prompts about a nonexistent file."
-  :type 'boolean
-  :group 'ffap)
-
-(defcustom ffap-require-prefix nil
-  ;; Suggestion from RHOGEE, 20 Oct 1994.
-  "*If set, reverses the prefix argument to `find-file-at-point'.
-This is nil so neophytes notice ffap.  Experts may prefer to disable
-ffap most of the time."
-  :type 'boolean
-  :group 'ffap)
-
-(defcustom ffap-file-finder 'find-file
-  "*The command called by `find-file-at-point' to find a file."
-  :type 'function
-  :group 'ffap)
-(put 'ffap-file-finder 'risky-local-variable t)
-
-(defcustom ffap-url-fetcher
-  (if (fboundp 'browse-url)
-      'browse-url			; rely on browse-url-browser-function
-    'w3-fetch)
-  ;; Remote control references:
-  ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
-  ;; http://home.netscape.com/newsref/std/x-remote.html
-  "*A function of one argument, called by ffap to fetch an URL.
-Reasonable choices are `w3-fetch' or a `browse-url-*' function.
-For a fancy alternative, get ffap-url.el."
-  :type '(choice (const w3-fetch)
-		 (const browse-url)	; in recent versions of browse-url
-		 (const browse-url-netscape)
-		 (const browse-url-mosaic)
-		 function)
-  :group 'ffap)
-(put 'ffap-url-fetcher 'risky-local-variable t)
-
-
-;;; Compatibility:
-;;
-;; This versions of ffap is for recent versions of both Emacs and
-;; XEmacs (including some light testing with both 20.* versions).
-;; XEmacs users no longer need the file "ffap-xe.el".  Emacs 18 is no
-;; longer supported, but try ffap-15.el.
-
-(defvar ffap-xemacs (and (string-match "XEmacs" emacs-version) t)
-  "Whether ffap thinks it is running under XEmacs.")
-
-(cond
- (ffap-xemacs
-  ;; XEmacs extents do *not* behave identically to Emacs overlays, but
-  ;; these aliases should suffice for our purposes.
-  (defalias 'ffap-make-overlay 'make-extent)
-  (defalias 'ffap-delete-overlay 'delete-extent) ; not reusable
-  (defalias 'ffap-move-overlay 'set-extent-endpoints)
-  (defalias 'ffap-overlay-put 'set-extent-property) ; 'face
-  (defalias 'ffap-find-face 'find-face)
-  (defalias 'ffap-event-buffer 'event-buffer)
-  (defun ffap-mouse-event nil current-mouse-event)
-  )
- (t					; hope for Emacs 19.3*
-  (defalias 'ffap-make-overlay 'make-overlay)
-  (defalias 'ffap-delete-overlay 'delete-overlay) ; reusable
-  (defalias 'ffap-move-overlay 'move-overlay)
-  (defalias 'ffap-overlay-put 'overlay-put) ; 'face
-  (defalias 'ffap-find-face 'internal-find-face)
-  (defun ffap-mouse-event nil		; current mouse event, or nil
-    (and (listp last-nonmenu-event) last-nonmenu-event))
-  (defun ffap-event-buffer (event)
-    (window-buffer (car (event-start event))))
-  ))
-
-
-;;; Find Next Thing in buffer (`ffap-next'):
-;;
-;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995.  Since
-;; then, broke it up into ffap-next-guess (noninteractive) and
-;; ffap-next (a command).  It now work on files as well as url's.
-
-(defcustom ffap-next-regexp
-  ;; If you want ffap-next to find URL's only, try this:
-  ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
-  ;;	  (concat "\\<" (substring ffap-url-regexp 2))))
-  ;;
-  ;; It pays to put a big fancy regexp here, since ffap-guesser is
-  ;; much more time-consuming than regexp searching:
-  "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\."
-  "*Regular expression governing movements of `ffap-next'."
-  :type 'regexp
-  :group 'ffap)
-
-(defvar ffap-next-guess nil
-  "Last value returned by `ffap-next-guess'.")
-
-(defvar ffap-string-at-point-region '(1 1)
-  "List (BEG END), last region returned by `ffap-string-at-point'.")
-
-;;;###autoload
-(defun ffap-next-guess (&optional back lim)
-  "Move point to next file or URL, and return it as a string.
-If nothing is found, leave point at limit and return nil.
-Optional BACK argument makes search backwards.
-Optional LIM argument limits the search.
-Only considers strings that match `ffap-next-regexp'."
-  (or lim (setq lim (if back (point-min) (point-max))))
-  (let (guess)
-    (while (not (or guess (eq (point) lim)))
-      (funcall (if back 're-search-backward 're-search-forward)
-	       ffap-next-regexp lim 'move)
-      (setq guess (ffap-guesser)))
-    ;; Go to end, so we do not get same guess twice:
-    (goto-char (nth (if back 0 1) ffap-string-at-point-region))
-    (setq ffap-next-guess guess)))
-
-;;;###autoload
-(defun ffap-next (&optional back wrap)
-  "Search buffer for next file or URL, and run ffap.
-Optional argument BACK says to search backwards.
-Optional argument WRAP says to try wrapping around if necessary.
-Interactively: use a single prefix to search backwards,
-double prefix to wrap forward, triple to wrap backwards.
-Actual search is done by `ffap-next-guess'."
-  (interactive
-   (cdr (assq (prefix-numeric-value current-prefix-arg)
-	      '((1) (4 t) (16 nil t) (64 t t)))))
-  (let ((pt (point))
-	(guess (ffap-next-guess back)))
-    ;; Try wraparound if necessary:
-    (and (not guess) wrap
-	 (goto-char (if back (point-max) (point-min)))
-	 (setq guess (ffap-next-guess back pt)))
-    (if guess
-	(progn
-	  (sit-for 0)			; display point movement
-	  (find-file-at-point (ffap-prompter guess)))
-      (goto-char pt)			; restore point
-      (message "No %sfiles or URL's found"
-	       (if wrap "" "more ")))))
-
-(defun ffap-next-url (&optional back wrap)
-  "Like `ffap-next', but search with `ffap-url-regexp'."
-  (interactive)
-  (let ((ffap-next-regexp ffap-url-regexp))
-    (if (interactive-p)
-	(call-interactively 'ffap-next)
-      (ffap-next back wrap))))
-
-
-;;; Machines (`ffap-machine-p'):
-
-;; I cannot decide a "best" strategy here, so these are variables.  In
-;; particular, if `Pinging...' is broken or takes too long on your
-;; machine, try setting these all to accept or reject.
-(defcustom ffap-machine-p-local 'reject	; this happens often
-  "*A symbol, one of: `ping', `accept', `reject'.
-What `ffap-machine-p' does with hostnames that have no domain."
-  :type '(choice (const ping)
-		 (const accept)
-		 (const reject))
-  :group 'ffap)
-(defcustom ffap-machine-p-known 'ping	; 'accept for speed
-  "*A symbol, one of: ping, accept, reject.
-What `ffap-machine-p' does with hostnames that have a known domain
-\(see mail-extr.el for the known domains\)."
-  :type '(choice (const ping)
-		 (const accept)
-		 (const reject))
-  :group 'ffap)
-(defcustom ffap-machine-p-unknown 'reject
-  "*A symbol, one of: ping, accept, reject.
-What `ffap-machine-p' does with hostnames that have an unknown domain
-\(see mail-extr.el for the known domains\)."
-  :type '(choice (const ping)
-		 (const accept)
-		 (const reject))
-  :group 'ffap)
-
-(defun ffap-what-domain (domain)
-  ;; Like what-domain in mail-extr.el, returns string or nil.
-  (require 'mail-extr)
-  (let ((ob (or (ffap-soft-value "mail-extr-all-top-level-domains")
-		(ffap-soft-value "all-top-level-domains")))) ; XEmacs
-    (and ob (get (intern-soft (downcase domain) ob) 'domain-name))))
-
-(defun ffap-machine-p (host &optional service quiet strategy)
-  "Decide whether HOST is the name of a real, reachable machine.
-Depending on the domain (none, known, or unknown), follow the strategy
-named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
-or `ffap-machine-p-unknown'.  Pinging uses `open-network-stream'.
-Optional SERVICE specifies the port used \(default \"discard\"\).
-Optional QUIET flag suppresses the \"Pinging...\" message.
-Optional STRATEGY overrides the three variables above.
-Returned values:
- t      means that HOST answered.
-'accept means the relevant variable told us to accept.
-\"mesg\"  means HOST exists, but does not respond for some reason."
-  ;; Try some (Emory local):
-  ;; (ffap-machine-p "ftp" nil nil 'ping)
-  ;; (ffap-machine-p "nonesuch" nil nil 'ping)
-  ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
-  ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
-  ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
-  ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
-  (if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?)
-	  (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
-      nil
-    (let* ((domain
-	    (and (string-match "\\.[^.]*$" host)
-		 (downcase (substring host (1+ (match-beginning 0))))))
-	   (what-domain (if domain (ffap-what-domain domain) "Local")))
-      (or strategy
-	  (setq strategy
-		(cond ((not domain) ffap-machine-p-local)
-		      ((not what-domain) ffap-machine-p-unknown)
-		      (t ffap-machine-p-known))))
-      (cond
-       ((eq strategy 'accept) 'accept)
-       ((eq strategy 'reject) nil)
-       ;; assume (eq strategy 'ping)
-       (t
-	(or quiet
-	    (if (stringp what-domain)
-		(message "Pinging %s (%s)..." host what-domain)
-	      (message "Pinging %s ..." host)))
-	(condition-case error
-	    (progn
-	      (delete-process
-	       (open-network-stream
-		"ffap-machine-p" nil host (or service "discard")))
-	      t)
-	  (error
-	   (let ((mesg (car (cdr error))))
-	     (cond
-	      ;; v18:
-	      ((string-match "^Unknown host" mesg) nil)
-	      ((string-match "not responding$" mesg) mesg)
-	      ;; v19:
-	      ;; (file-error "connection failed" "permission denied"
-	      ;;             "nonesuch" "ffap-machine-p")
-	      ;; (file-error "connection failed" "host is unreachable"
-	      ;;	     "gopher.house.gov" "ffap-machine-p")
-	      ;; (file-error "connection failed" "address already in use"
-	      ;;	     "ftp.uu.net" "ffap-machine-p")
-	      ((equal mesg "connection failed")
-	       (if (equal (nth 2 error) "permission denied")
-		   nil			; host does not exist
-		 ;; Other errors mean the host exists:
-		 (nth 2 error)))
-	      ;; Could be "Unknown service":
-	      (t (signal (car error) (cdr error))))))))))))
-
-
-;;; Possibly Remote Resources:
-
-(defun ffap-replace-path-component (fullname name)
-  "In remote FULLNAME, replace path with NAME.  May return nil."
-  ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
-  (let (found)
-    (mapcar
-     (function (lambda (sym) (and (fboundp sym) (setq found sym))))
-     '(
-       efs-replace-path-component
-       ange-ftp-replace-path-component
-       ange-ftp-replace-name-component
-       ))
-    (and found
-	 (fset 'ffap-replace-path-component found)
-	 (funcall found fullname name))))
-;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new")
-
-(defun ffap-file-suffix (file)
-  "Return trailing \".foo\" suffix of FILE, or nil if none."
-  (let ((pos (string-match "\\.[^./]*\\'" file)))
-    (and pos (substring file pos nil))))
-
-(defvar ffap-compression-suffixes '(".gz" ".Z")	; .z is mostly dead
-  "List of suffixes tried by `ffap-file-exists-string'.")
-
-(defun ffap-file-exists-string (file &optional nomodify)
-  ;; Early jka-compr versions modified file-exists-p to return the
-  ;; filename, maybe modified by adding a suffix like ".gz".  That
-  ;; broke the interface of file-exists-p, so it was later dropped.
-  ;; Here we document and simulate the old behavior.
-  "Return FILE \(maybe modified\) if it exists, else nil.
-When using jka-compr (a.k.a. `auto-compression-mode'), the returned
-name may have a suffix added from `ffap-compression-suffixes'.
-The optional NOMODIFY argument suppresses the extra search."
-  (cond
-   ((not file) nil)			; quietly reject nil
-   ((file-exists-p file) file)		; try unmodified first
-   ;; three reasons to suppress search:
-   (nomodify nil)
-   ((not (rassq 'jka-compr-handler file-name-handler-alist)) nil)
-   ((member (ffap-file-suffix file) ffap-compression-suffixes) nil)
-   (t					; ok, do the search
-    (let ((list ffap-compression-suffixes) try ret)
-      (while list
-	(if (file-exists-p (setq try (concat file (car list))))
-	    (setq ret try list nil)
-	  (setq list (cdr list))))
-      ret))))
-
-(defun ffap-file-remote-p (filename)
-  "If FILENAME looks remote, return it \(maybe slightly improved\)."
-  ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
-  ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path")
-  ;; (ffap-file-remote-p "/ffap.el:80")
-  (or (and ffap-ftp-regexp
-	   (string-match ffap-ftp-regexp filename)
-	   ;; Convert "/host.com://path" to "/host:/path", to handle a dieing
-	   ;; practice of advertising ftp paths as "host.dom://path".
-	   (if (string-match "//" filename)
-	       ;; (replace-match "/" nil nil filename)
-	       (concat (substring filename 0 (1+ (match-beginning 0)))
-		       (substring filename (match-end 0)))
-	     filename))
-      (and ffap-rfs-regexp
-	   (string-match ffap-rfs-regexp filename)
-	   filename)))
-
-(defun ffap-machine-at-point nil
-  "Return machine name at point if it exists, or nil."
-  (let ((mach (ffap-string-at-point 'machine)))
-    (and (ffap-machine-p mach) mach)))
-
-(defsubst ffap-host-to-path (host)
-  "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".
-Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
-  (if (equal host "localhost")
-      ""
-    (let ((user ffap-ftp-default-user))
-      ;; Avoid including the user if it is same as default:
-      (if (or (equal user (ffap-soft-value "ange-ftp-default-user"))
-	      (equal user (ffap-soft-value "efs-default-user")))
-	  (setq user nil))
-      (concat "/" user (and user "@") host ":"))))
-
-(defun ffap-fixup-machine (mach)
-  ;; Convert a hostname into an url, an ftp path, or nil.
-  (cond
-   ((not (and ffap-url-regexp (stringp mach))) nil)
-   ;; gopher.well.com
-   ((string-match "\\`gopher[-.]" mach)	; or "info"?
-    (concat "gopher://" mach "/"))
-   ;; www.ncsa.uiuc.edu
-   ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
-    (concat "http://" mach "/"))
-   ;; More cases?  Maybe "telnet:" for archie?
-   (ffap-ftp-regexp (ffap-host-to-path mach))
-   ))
-
-(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
-  "Strings not matching this fail `ffap-newsgroup-p'.")
-(defvar ffap-newsgroup-heads		; entirely inadequate
-  '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
-  "Used by `ffap-newsgroup-p' if gnus is not running.")
-
-(defun ffap-newsgroup-p (string)
-  "Return STRING if it looks like a newsgroup name, else nil."
-  (and
-   (string-match ffap-newsgroup-regexp string)
-   (let ((htbs '(gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb))
-	 (heads ffap-newsgroup-heads)
-	 htb ret)
-     (while htbs
-       (setq htb (car htbs) htbs (cdr htbs))
-       (condition-case nil
-	   (progn
-	     ;; errs: htb symbol may be unbound, or not a hash-table.
-	     ;; gnus-gethash is just a macro for intern-soft.
-	     (and (intern-soft string (symbol-value htb))
-		  (setq ret string htbs nil))
-	     ;; If we made it this far, gnus is running, so ignore "heads":
-	     (setq heads nil))
-	 (error nil)))
-     (or ret (not heads)
-	 (let ((head (string-match "\\`\\([a-z]+\\)\\." string)))
-	   (and head (setq head (substring string 0 (match-end 1)))
-		(member head heads)
-		(setq ret string))))
-     ;; Is there ever a need to modify string as a newsgroup name?
-     ret)))
-
-(defsubst ffap-url-p (string)
-  "If STRING looks like an url, return it (maybe improved), else nil."
-  (let ((case-fold-search t))
-    (and ffap-url-regexp (string-match ffap-url-regexp string)
-	 ;; I lied, no improvement:
-	 string)))
-
-;; Broke these out of ffap-fixup-url, for use of ffap-url package.
-(defsubst ffap-url-unwrap-local (url)
-  "Return URL as a local file, or nil.  Ignores `ffap-url-regexp'."
-  (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
-       (substring url (1+ (match-end 1)))))
-(defsubst ffap-url-unwrap-remote (url)
-  "Return URL as a remote file, or nil.  Ignores `ffap-url-regexp'."
-  (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
-       (concat
-	(ffap-host-to-path (substring url (match-beginning 2) (match-end 2)))
-	(substring url (match-beginning 3) (match-end 3)))))
-;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
-
-(defun ffap-fixup-url (url)
-  "Clean up URL and return it, maybe as a file name."
-  (cond
-   ((not (stringp url)) nil)
-   ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
-   ((and ffap-url-unwrap-remote ffap-ftp-regexp
-	 (ffap-url-unwrap-remote url)))
-   ((fboundp 'url-normalize-url)	; may autoload url (part of w3)
-    (url-normalize-url url))
-   (url)))
-
-
-;;; Path Handling:
-;;
-;; The upcoming ffap-alist actions need various utilities to prepare
-;; and search paths of directories.  Too many features here.
-
-;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
-;; (defun ffap-splice (func inlist)
-;;  "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
-;;  (let* ((head (cons 17 nil)) (last head))
-;;    (while inlist
-;;      (setcdr last (funcall func (car inlist)))
-;;      (setq last (ffap-last last) inlist (cdr inlist)))
-;;    (cdr head)))
-
-(defun ffap-list-env (env &optional empty)
-  "Return a list of strings parsed from environment variable ENV.
-Optional EMPTY is the default list if \(getenv ENV\) is undefined, and
-also is substituted for the first empty-string component, if there is one.
-Uses `path-separator' to separate the path into substrings."
-  ;; We cannot use parse-colon-path (files.el), since it kills
-  ;; "//" entries using file-name-as-directory.
-  ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env
-  ;; in ff-paths and bib-cite.  The EMPTY arg may help mimic kpathsea.
-  (if (or empty (getenv env))		; should return something
-      (let ((start 0) match dir ret)
-	(setq env (concat (getenv env) path-separator))
-	(while (setq match (string-match path-separator env start))
-	  (setq dir (substring env start match) start (1+ match))
-	  ;;(and (file-directory-p dir) (not (member dir ret)) ...)
-	  (setq ret (cons dir ret)))
-	(setq ret (nreverse ret))
-	(and empty (setq match (member "" ret))
-	     (progn			; allow string or list here
-	       (setcdr match (append (cdr-safe empty) (cdr match)))
-	       (setcar match (or (car-safe empty) empty))))
-	ret)))
-
-(defun ffap-reduce-path (path)
-  "Remove duplicates and non-directories from PATH list."
-  (let (ret tem)
-    (while path
-      (setq tem path path (cdr path))
-      (if (equal (car tem) ".") (setcar tem ""))
-      (or (member (car tem) ret)
-	  (not (file-directory-p (car tem)))
-	  (progn (setcdr tem ret) (setq ret tem))))
-    (nreverse ret)))
-
-(defun ffap-all-subdirs (dir &optional depth)
-  "Return list all subdirectories under DIR, starting with itself.
-Directories beginning with \".\" are ignored, and directory symlinks
-are listed but never searched (to avoid loops).
-Optional DEPTH limits search depth."
-  (and (file-exists-p dir)
-       (ffap-all-subdirs-loop (expand-file-name dir) (or depth -1))))
-
-(defun ffap-all-subdirs-loop (dir depth) ; internal
-  (setq depth (1- depth))
-  (cons dir
-	(and (not (eq depth -1))
-	     (apply 'nconc
-		    (mapcar
-		     (function
-		      (lambda (d)
-			(cond
-			 ((not (file-directory-p d)) nil)
-			 ((file-symlink-p d) (list d))
-			 (t (ffap-all-subdirs-loop d depth)))))
-		     (directory-files dir t "\\`[^.]")
-		     )))))
-
-(defvar ffap-kpathsea-depth 1
-  "Bound on depth of subdirectory search in `ffap-kpathsea-expand-path'.
-Set to 0 to avoid all searching, or nil for no limit.")
-
-(defun ffap-kpathsea-expand-path (path)
-  "Replace each \"//\"-suffixed dir in PATH by a list of its subdirs.
-The subdirs begin with the original directory, and the depth of the
-search is bounded by `ffap-kpathsea-depth'.  This is intended to mimic
-kpathsea, a library used by some versions of TeX."
-  (apply 'nconc
-	 (mapcar
-	  (function
-	   (lambda (dir)
-	     (if (string-match "[^/]//\\'" dir)
-		 (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth)
-	       (list dir))))
-	  path)))
-
-(defun ffap-locate-file (file &optional nosuffix path dir-ok)
-  ;; The Emacs 20 version of locate-library could almost replace this,
-  ;; except it does not let us override the suffix list.  The
-  ;; compression-suffixes search moved to ffap-file-exists-string.
-  "A generic path-searching function, mimics `load' by default.
-Returns path to file that \(load FILE\) would load, or nil.
-Optional NOSUFFIX, if nil or t, is like the fourth argument
-for load: whether to try the suffixes (\".elc\" \".el\" \"\").
-If a nonempty list, it is a list of suffixes to try instead.
-Optional PATH is a list of directories instead of `load-path'.
-Optional DIR-OK means that returning a directory is allowed,
-DIR-OK is already implicit if FILE looks like a directory.
-
-This uses ffap-file-exists-string, which may try adding suffixes from
-`ffap-compression-suffixes'."
-  (or path (setq path load-path))
-  (or dir-ok (setq dir-ok (equal "" (file-name-nondirectory file))))
-  (if (file-name-absolute-p file)
-      (setq path (list (file-name-directory file))
-	    file (file-name-nondirectory file)))
-  (let ((suffixes-to-try
-	 (cond
-	  ((consp nosuffix) nosuffix)
-	  (nosuffix '(""))
-	  (t '(".elc" ".el" ""))))
-	suffixes try found)
-    (while path
-      (setq suffixes suffixes-to-try)
-      (while suffixes
-	(setq try (ffap-file-exists-string
-		   (expand-file-name
-		    (concat file (car suffixes)) (car path))))
-	(if (and try (or dir-ok (not (file-directory-p try))))
-	    (setq found try suffixes nil path nil)
-	  (setq suffixes (cdr suffixes))))
-      (setq path (cdr path)))
-    found))
-
-
-;;; Action List (`ffap-alist'):
-;;
-;; These search actions depend on the major-mode or regexps matching
-;; the current name.  The little functions and their variables are
-;; deferred to the next section, at some loss of "code locality".  A
-;; good example of featuritis.  Trim this list for speed.
-
-(defvar ffap-alist
-  '(
-    ("" . ffap-completable)		; completion, slow on some systems
-    ("\\.info\\'" . ffap-info)		; gzip.info
-    ("\\`info/" . ffap-info-2)		; info/emacs
-    ("\\`[-a-z]+\\'" . ffap-info-3)	; (emacs)Top [only in the parentheses]
-    ("\\.elc?\\'" . ffap-el)		; simple.el, simple.elc
-    (emacs-lisp-mode . ffap-el-mode)	; rmail, gnus, simple, custom
-    ;; (lisp-interaction-mode . ffap-el-mode) ; maybe
-    (finder-mode . ffap-el-mode)	; type {C-h p} and try it
-    (help-mode . ffap-el-mode)		; maybe useful
-    (c++-mode . ffap-c-mode)		; search ffap-c-path
-    (cc-mode . ffap-c-mode)		; same
-    ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h
-    (fortran-mode . ffap-fortran-mode)	; FORTRAN requested by MDB
-    ("\\.[fF]\\'" . ffap-fortran-mode)
-    (tex-mode . ffap-tex-mode)		; search ffap-tex-path
-    (latex-mode . ffap-latex-mode)	; similar
-    ("\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" . ffap-tex)
-    ("\\.bib\\'" . ffap-bib)		; search ffap-bib-path
-    ("\\`\\." . ffap-home)		; .emacs, .bashrc, .profile
-    ("\\`~/" . ffap-lcd)		; |~/misc/ffap.el.Z|
-    ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)"	; no $
-     . ffap-rfc)			; "100% RFC2100 compliant"
-    (dired-mode . ffap-dired)		; maybe in a subdirectory
-    )
-  "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
-If string NAME at point (maybe \"\") is not a file or url, these pairs
-specify actions to try creating such a string.  A pair matches if either
-  KEY is a symbol, and it equals `major-mode', or
-  KEY is a string, it should match NAME as a regexp.
-On a match, \(FUNCTION NAME\) is called and should return a file, an
-url, or nil. If nil, search the alist for further matches.")
-
-(put 'ffap-alist 'risky-local-variable t)
-
-;; Example `ffap-alist' modifications:
-;;
-;; (setq ffap-alist                   ; remove a feature in `ffap-alist'
-;;	 (delete (assoc 'c-mode ffap-alist) ffap-alist))
-;;
-;; (setq ffap-alist                   ; add something to `ffap-alist'
-;;	 (cons
-;;	  (cons "^YSN[0-9]+$"
-;;		(defun ffap-ysn (name)
-;;		  (concat
-;;		   "http://www.physics.uiuc.edu/"
-;;                 "ysn/httpd/htdocs/ysnarchive/issuefiles/"
-;;		   (substring name 3) ".html")))
-;;	  ffap-alist))
-
-
-;;; Action Definitions:
-;;
-;; Define various default members of `ffap-alist'.
-
-(defun ffap-completable (name)
-  (let* ((dir (or (file-name-directory name) default-directory))
-	 (cmp (file-name-completion (file-name-nondirectory name) dir)))
-    (and cmp (concat dir cmp))))
-
-(defun ffap-home (name) (ffap-locate-file name t '("~")))
-
-(defun ffap-info (name)
-  (ffap-locate-file
-   name '("" ".info")
-   (or (ffap-soft-value "Info-directory-list")
-       (ffap-soft-value "Info-default-directory-list")
-       )))
-
-(defun ffap-info-2 (name) (ffap-info (substring name 5)))
-
-(defun ffap-info-3 (name)
-  ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
-  (and (equal (ffap-string-around) "()") (ffap-info name)))
-
-(defun ffap-el (name) (ffap-locate-file name t))
-
-(defun ffap-el-mode (name)
-  ;; If name == "foo.el" we will skip it, since ffap-el already
-  ;; searched for it once.  (This assumes the default ffap-alist.)
-  (and (not (string-match "\\.el\\'" name))
-       (ffap-locate-file name '(".el"))))
-
-(defvar ffap-c-path
-  ;; Need smarter defaults here!  Suggestions welcome.
-  '("/usr/include" "/usr/local/include"))
-(defun ffap-c-mode (name)
-  (ffap-locate-file name t ffap-c-path))
-
-(defvar ffap-fortran-path '("../include" "/usr/include"))
-
-(defun ffap-fortran-mode (name)
-  (ffap-locate-file name t ffap-fortran-path))
-
-(defvar ffap-tex-path
-  t				; delayed initialization
-  "Path where `ffap-tex-mode' looks for tex files.
-If t, `ffap-tex-init' will initialize this when needed.")
-
-(defun ffap-tex-init nil
-  ;; Compute ffap-tex-path if it is now t.
-  (and (eq t ffap-tex-path)
-       ;; this may be slow, so say something
-       (message "Initializing ffap-tex-path ...")
-       (setq ffap-tex-path
-	     (ffap-reduce-path
-	      (cons
-	       "."
-	       (ffap-kpathsea-expand-path
-		(append
-		 (ffap-list-env "TEXINPUTS")
-		 ;; (ffap-list-env "BIBINPUTS")
-		 (ffap-soft-value
-		  "TeX-macro-global"	; AUCTeX
-		  '("/usr/local/lib/tex/macros"
-		    "/usr/local/lib/tex/inputs")))))))))
-
-(defun ffap-tex-mode (name)
-  (ffap-tex-init)
-  (ffap-locate-file name '(".tex" "") ffap-tex-path))
-
-(defun ffap-latex-mode (name)
-  (ffap-tex-init)
-  ;; only rare need for ""
-  (ffap-locate-file name '(".cls" ".sty" ".tex" "") ffap-tex-path))
-
-(defun ffap-tex (name)
-  (ffap-tex-init)
-  (ffap-locate-file name t ffap-tex-path))
-
-(defvar ffap-bib-path
-  (ffap-list-env "BIBINPUTS"
-		 (ffap-reduce-path
-		  '(
-		    ;; a few wild guesses, need better
-		    "/usr/local/lib/tex/macros/bib" ; Solaris?
-		    "/usr/lib/texmf/bibtex/bib"	; Linux?
-		    ))))
-
-(defun ffap-bib (name)
-  (ffap-locate-file name t ffap-bib-path))
-
-(defun ffap-dired (name)
-  (let ((pt (point)) dir try)
-    (save-excursion
-      (and (progn
-	     (beginning-of-line)
-	     (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] "))
-	   (re-search-backward "^ *$" nil t)
-	   (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t)
-	   (file-exists-p
-	    (setq try
-		  (expand-file-name
-		   name
-		   (buffer-substring
-		    (match-beginning 1) (match-end 1)))))
-	   try))))
-
-;; Maybe a "Lisp Code Directory" reference:
-(defun ffap-lcd (name)
-  (and
-   (or
-    ;; lisp-dir-apropos output buffer:
-    (string-match "Lisp Code Dir" (buffer-name))
-    ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
-    ;; or maybe the holy LCD-Datafile itself:
-    (member (ffap-string-around) '("||" "|\n")))
-   (concat
-    ;; lispdir.el may not be loaded yet:
-    (ffap-host-to-path
-     (ffap-soft-value "elisp-archive-host"
-		      "archive.cis.ohio-state.edu"))
-    (file-name-as-directory
-     (ffap-soft-value "elisp-archive-directory"
-		      "/pub/gnu/emacs/elisp-archive/"))
-    (substring name 2))))
-
-(defvar ffap-rfc-path
-  (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt"))
-
-(defun ffap-rfc (name)
-  (format ffap-rfc-path
-	  (substring name (match-beginning 1) (match-end 1))))
-
-
-;;; At-Point Functions:
-
-(defvar ffap-string-at-point-mode-alist
-  '(
-    ;; The default, used when the `major-mode' is not found.
-    ;; Slightly controversial decisions:
-    ;; * strip trailing "@" and ":"
-    ;; * no commas (good for latex)
-    (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
-    ;; An url, or maybe a email/news message-id:
-    (url "--:=&?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")
-    ;; Find a string that does *not* contain a colon:
-    (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
-    ;; A machine:
-    (machine "-a-zA-Z0-9." "" ".")
-    ;; Mathematica paths: allow backquotes
-    (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:")
-    )
-  "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
-possibly a `major-mode' or some symbol internal to ffap
-\(such as 'file, 'url, 'machine, and 'nocolon\).
-`ffap-string-at-point' uses the data fields as follows:
-1. find a maximal string of CHARS around point,
-2. strip BEG chars before point from the beginning,
-3. Strip END chars after point from the end.")
-
-(defvar ffap-string-at-point nil
-  ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
-  "Last string returned by `ffap-string-at-point'.")
-
-(defun ffap-string-at-point (&optional mode)
-  "Return a string of characters from around point.
-MODE (defaults to `major-mode') is a symbol used to lookup string
-syntax parameters in `ffap-string-at-point-mode-alist'.
-If MODE is not found, we fall back on the symbol 'file.
-Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
-  (let* ((args
-	  (cdr
-	   (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
-	       (assq 'file ffap-string-at-point-mode-alist))))
-	 (pt (point))
-	 (str
-	  (buffer-substring
-	   (save-excursion
-	     (skip-chars-backward (car args))
-	     (skip-chars-forward (nth 1 args) pt)
-	     (setcar ffap-string-at-point-region (point)))
-	   (save-excursion
-	     (skip-chars-forward (car args))
-	     (skip-chars-backward (nth 2 args) pt)
-	     (setcar (cdr ffap-string-at-point-region) (point))))))
-    (or ffap-xemacs (set-text-properties 0 (length str) nil str))
-    (setq ffap-string-at-point str)))
-
-(defun ffap-string-around nil
-  ;; Sometimes useful to decide how to treat a string.
-  "Return string of two chars around last `ffap-string-at-point'.
-Assumes the buffer has not changed."
-  (save-excursion
-    (format "%c%c"
-	    (progn
-	      (goto-char (car ffap-string-at-point-region))
-	      (preceding-char))		; maybe 0
-	    (progn
-	      (goto-char (nth 1 ffap-string-at-point-region))
-	      (following-char))		; maybe 0
-	    )))
-
-(defun ffap-copy-string-as-kill (&optional mode)
-  ;; Requested by MCOOK.  Useful?
-  "Call `ffap-string-at-point', and copy result to `kill-ring'."
-  (interactive)
-  (let ((str (ffap-string-at-point mode)))
-    (if (equal "" str)
-	(message "No string found around point.")
-      (kill-new str)
-      ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
-      (message "Copied to kill ring: %s"  str))))
-
-(defun ffap-url-at-point nil
-  "Return url from around point if it exists, or nil."
-  ;; Could use w3's url-get-url-at-point instead.  Both handle "URL:",
-  ;; ignore non-relative links, trim punctuation.  The other will
-  ;; actually look back if point is in whitespace, but I would rather
-  ;; ffap be less aggressive in such situations.
-  (and
-   ffap-url-regexp
-   (or
-    ;; In a w3 buffer button?
-    (and (eq major-mode 'w3-mode)
-	 ;; interface recommended by wmperry:
-	 (w3-view-this-url t))
-    ;; Is there a reason not to strip trailing colon?
-    (let ((name (ffap-string-at-point 'url)))
-      (cond
-       ((string-match "^url:" name) (setq name (substring name 4)))
-       ((and (string-match "\\`[^:@]+@[^:@]+[a-zA-Z0-9]\\'" name)
-	     ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
-	     ;; Without "<>" it must be "mailto".  Otherwise could be
-	     ;; either, so consult `ffap-foo-at-bar-prefix'.
-	     (let ((prefix (if (and (equal (ffap-string-around) "<>")
-				    ;; Expect some odd characters:
-				    (string-match "[$.0-9].*[$.0-9].*@" name))
-			       ;; Could be news:
-			       ffap-foo-at-bar-prefix
-			     "mailto")))
-	       (and prefix (setq name (concat prefix ":" name))))))
-       ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
-       ((and (string-match "\\`[a-z0-9]+\\'" name) ;   
-	     (equal (ffap-string-around) "<>")
-	     ;;	(ffap-user-p name):
-	     (not (string-match "~" (expand-file-name (concat "~" name))))
-	     )
-	(setq name (concat "mailto:" name)))
-       )
-      (and (ffap-url-p name) name)
-      ))))
-
-(defvar ffap-gopher-regexp
-  "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
-  "Regexp Matching a line in a gopher bookmark (maybe indented).
-The two subexpressions are the KEY and VALUE.")
-
-(defun ffap-gopher-at-point nil
-  "If point is inside a gopher bookmark block, return its url."
-  ;; `gopher-parse-bookmark' from gopher.el is not so robust
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at ffap-gopher-regexp)
-	(progn
-	  (while (and (looking-at ffap-gopher-regexp) (not (bobp)))
-	    (forward-line -1))
-	  (or (looking-at ffap-gopher-regexp) (forward-line 1))
-	  (let ((type "1") name path host (port "70"))
-	    (while (looking-at ffap-gopher-regexp)
-	      (let ((var (intern
-			  (downcase
-			   (buffer-substring (match-beginning 1)
-					     (match-end 1)))))
-		    (val (buffer-substring (match-beginning 2)
-					   (match-end 2))))
-		(set var val)
-		(forward-line 1)))
-	    (if (and path (string-match "^ftp:.*@" path))
-		(concat "ftp://"
-			(substring path 4 (1- (match-end 0)))
-			(substring path (match-end 0)))
-	      (and (= (length type) 1)
-		   host;; (ffap-machine-p host)
-		   (concat "gopher://" host
-			   (if (equal port "70") "" (concat ":" port))
-			   "/" type path))))))))
-
-(defvar ffap-ftp-sans-slash-regexp
-  (and
-   ffap-ftp-regexp
-   ;; Note: by now, we know it is not an url.
-   ;; Icky regexp avoids: default: 123: foo::bar cs:pub
-   ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
-   "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
-  "Strings matching this are coerced to ftp paths by ffap.
-That is, ffap just prepends \"/\".  Set to nil to disable.")
-
-(defun ffap-file-at-point nil
-  "Return filename from around point if it exists, or nil.
-Existence test is skipped for names that look remote.
-If the filename is not obvious, it also tries `ffap-alist',
-which may actually result in an url rather than a filename."
-  ;; Note: this function does not need to look for url's, just
-  ;; filenames.  On the other hand, it is responsible for converting
-  ;; a pseudo-url "site.com://path" to an ftp path
-  (let* ((case-fold-search t)		; url prefixes are case-insensitive
-	 (data (match-data))
-	 (string (ffap-string-at-point)) ; uses mode alist
-	 (name
-	  (or (condition-case nil
-		  (and (not (string-match "//" string)) ; foo.com://bar
-		       (substitute-in-file-name string))
-		(error nil))
-	      string))
-	 (abs (file-name-absolute-p name))
-	 (default-directory default-directory))
-    (unwind-protect
-	(cond
-	 ;; Immediate rejects (/ and // are too common in C++):
-	 ((member name '("" "/" "//")) nil)
-	 ;; Immediately test local filenames.  If default-directory is
-	 ;; remote, you probably already have a connection.
-	 ((and (not abs) (ffap-file-exists-string name)))
-	 ;; Accept remote names without actual checking (too slow):
-	 ((if abs
-	      (ffap-file-remote-p name)
-	    ;; Try adding a leading "/" (common omission in ftp paths):
-	    (and
-	     ffap-ftp-sans-slash-regexp
-	     (string-match ffap-ftp-sans-slash-regexp name)
-	     (ffap-file-remote-p (concat "/" name)))))
-	 ;; Ok, not remote, try the existence test even if it is absolute:
-	 ((and abs (ffap-file-exists-string name)))
-	 ;; If it contains a colon, get rid of it (and return if exists)
-	 ((and (string-match path-separator name)
-	       (setq name (ffap-string-at-point 'nocolon))
-	       (ffap-file-exists-string name)))
-	 ;; File does not exist, try the alist:
-	 ((let ((alist ffap-alist) tem try case-fold-search)
-	    (while (and alist (not try))
-	      (setq tem (car alist) alist (cdr alist))
-	      (if (or (eq major-mode (car tem))
-		      (and (stringp (car tem))
-			   (string-match (car tem) name)))
-		  (and (setq try
-			     (condition-case nil
-				 (funcall (cdr tem) name)
-			       (error nil)))
-		       (setq try (or
-				  (ffap-url-p try) ; not a file!
-				  (ffap-file-remote-p try)
-				  (ffap-file-exists-string try))))))
-	    try))
-	 ;; Alist failed?  Try to guess an active remote connection
-	 ;; from buffer variables, and try once more, both as an
-	 ;; absolute and relative path on that remote host.
-	 ((let* (ffap-rfs-regexp	; suppress
-		 (remote-dir
-		  (cond
-		   ((ffap-file-remote-p default-directory))
-		   ((and (eq major-mode 'internal-ange-ftp-mode)
-			 (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$"
-				       (buffer-name)))
-		    (concat "/" (substring (buffer-name) 5 -1) ":"))
-		   ;; This is too often a bad idea:
-		   ;;((and (eq major-mode 'w3-mode)
-		   ;;	   (stringp url-current-server))
-		   ;; (host-to-ange-path url-current-server))
-		   )))
-	    (and remote-dir
-		 (or
-		  (and (string-match "\\`\\(/?~?ftp\\)/" name)
-		       (ffap-file-exists-string
-			(ffap-replace-path-component
-			 remote-dir (substring name (match-end 1)))))
-		  (ffap-file-exists-string
-		   (ffap-replace-path-component remote-dir name))))))
-	 )
-      (store-match-data data))))
-
-
-;;; Prompting (`ffap-read-file-or-url'):
-;;
-;; We want to complete filenames as in read-file-name, but also url's
-;; which read-file-name-internal would truncate at the "//" string.
-;; The solution here is to replace read-file-name-internal with
-;; `ffap-read-file-or-url-internal', which checks the minibuffer
-;; contents before attempting to complete filenames.
-
-(defun ffap-read-file-or-url (prompt guess)
-  "Read file or url from minibuffer, with PROMPT and initial GUESS."
-  (or guess (setq guess default-directory))
-  (let (dir)
-    ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
-    ;; or "w3/" or "../el/ffap.el" or "../../../"
-    (or (ffap-url-p guess)
-	(progn
-	  (or (ffap-file-remote-p guess)
-	      (setq guess
-                    (apply 'abbreviate-file-name
-			   (expand-file-name guess)
-			   ;; HACK-HOMEDIR argument for XEmacs:
-			   (if ffap-xemacs '(t)))
-		    ))
-	  (setq dir (file-name-directory guess))))
-    (setq guess
-	  (completing-read
-	   prompt
-	   'ffap-read-file-or-url-internal
-	   dir
-	   nil
-	   (if dir (cons guess (length dir)) guess)
-	   'file-name-history
-	   ))
-    (unless (ffap-url-p guess)
-      ;; Emulate (interactive "F") by returning the current directory
-      ;; if the user has simply pressed RET.
-      (when (equal (expand-file-name guess)
-		   (expand-file-name default-directory))
-	(setq guess (or (buffer-file-name) default-directory)))
-
-      ;; Do file substitution like (interactive "F"), suggested by MCOOK.
-      ;; (Don't substitute on url's, where $ is a common (VMS?)
-      ;; character.  Note: upcoming url.el package ought to handle
-      ;; this automatically.)
-      (setq guess (substitute-in-file-name guess)))
-
-    guess))
-
-(defun ffap-read-url-internal (string dir action)
-  "Complete url's from history, treating given string as valid."
-  (let ((hist (ffap-soft-value "url-global-history-hash-table")))
-    (cond
-     ((not action)
-      (or (try-completion string hist) string))
-     ((eq action t)
-      (or (all-completions string hist) (list string)))
-     ;; action == lambda, documented where?  Tests whether string is a
-     ;; valid "match".  Let us always say yes.
-     (t t))))
-
-(defun ffap-read-file-or-url-internal (string dir action)
-  (if (ffap-url-p string)
-      (ffap-read-url-internal string dir action)
-    (read-file-name-internal string dir action)))
-
-;; The rest of this page is just to work with package complete.el.
-;; This code assumes that you load ffap.el after complete.el.
-;;
-;; We must inform complete about whether our completion function
-;; will do filename style completion.  For earlier versions of
-;; complete.el, this requires a defadvice.  For recent versions
-;; there may be a special variable for this purpose.
-
-(defun ffap-complete-as-file-p nil
-  ;; Will `minibuffer-completion-table' complete the minibuffer
-  ;; contents as a filename?  Assumes the minibuffer is current.
-  ;; Note: t and non-nil mean somewhat different reasons.
-  (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
-      (not (ffap-url-p (buffer-string))) ; t
-    (memq minibuffer-completion-table
-	  '(read-file-name-internal read-directory-name-internal)) ; list
-    ))
-
-(and
- (featurep 'complete)
- (if (boundp 'PC-completion-as-file-name-predicate)
-     ;; modern version of complete.el, just set the variable:
-     (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)
-   (eval-when-compile (require 'advice))
-   (defadvice PC-do-completion (around ffap-fix act)
-     "Work with ffap."
-     (let ((minibuffer-completion-table
-	    (if (eq t (ffap-complete-as-file-p))
-		'read-file-name-internal
-	      minibuffer-completion-table)))
-       ad-do-it))))
-
-
-;;; Highlighting (`ffap-highlight'):
-;;
-;; Based on overlay highlighting in Emacs 19.28 isearch.el.
-
-(defvar ffap-highlight (and window-system t)
-  "If non-nil, ffap highlights the current buffer substring.")
-
-(defvar ffap-highlight-overlay nil
-  "Overlay \(or extent, in XEmacs\) used by `ffap-highlight'.")
-
-(defun ffap-highlight (&optional remove)
-  "If `ffap-highlight' is set, highlight the guess in this buffer.
-That is, the last buffer substring found by `ffap-string-at-point'.
-Optional argument REMOVE means to remove any such highlighting.
-Uses the face `ffap' if it is defined, or else `highlight'."
-  (cond
-   (remove
-    (and ffap-highlight-overlay
-	 (ffap-delete-overlay ffap-highlight-overlay))
-    (if ffap-xemacs (setq ffap-highlight-overlay nil)) ; extents not reusable
-    )
-   ((not ffap-highlight) nil)
-   (ffap-highlight-overlay
-    (ffap-move-overlay
-     ffap-highlight-overlay
-     (car ffap-string-at-point-region)
-     (nth 1 ffap-string-at-point-region)
-     (current-buffer)))
-   (t
-    (setq ffap-highlight-overlay
-	  (apply 'ffap-make-overlay ffap-string-at-point-region))
-    (ffap-overlay-put ffap-highlight-overlay 'face
-		      (if (ffap-find-face 'ffap)
-			  'ffap 'highlight)))))
-
-
-;;; Main Entrance (`find-file-at-point' == `ffap'):
-
-(defun ffap-guesser nil
-  "Return file or URL or nil, guessed from text around point."
-  (or (and ffap-url-regexp
-	   (ffap-fixup-url (or (ffap-url-at-point)
-			       (ffap-gopher-at-point))))
-      (ffap-file-at-point)		; may yield url!
-      (ffap-fixup-machine (ffap-machine-at-point))))
-
-(defun ffap-prompter (&optional guess)
-  ;; Does guess and prompt step for find-file-at-point.
-  ;; Extra complication for the temporary highlighting.
-  (unwind-protect
-      ;; This catch will let ffap-alist entries do their own prompting
-      ;; and then maybe skip over this prompt (ff-paths, for example).
-      (catch 'ffap-prompter
-	(ffap-read-file-or-url
-	 (if ffap-url-regexp "Find file or URL: " "Find file: ")
-	 (prog1
-	     (setq guess (or guess (ffap-guesser))) ; using ffap-alist here
-	   (and guess (ffap-highlight))
-	   )))
-    (ffap-highlight t)))
-
-;;;###autoload
-(defun find-file-at-point (&optional filename)
-  "Find FILENAME, guessing a default from text around point.
-If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
-With a prefix, this command behaves exactly like `ffap-file-finder'.
-If `ffap-require-prefix' is set, the prefix meaning is reversed.
-See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
-and the functions `ffap-file-at-point' and `ffap-url-at-point'.
-
-See  for latest version."
-  (interactive)
-  (if (and (interactive-p)
-	   (if ffap-require-prefix (not current-prefix-arg)
-	     current-prefix-arg))
-      ;; Do exactly the ffap-file-finder command, even the prompting:
-      (let (current-prefix-arg)		; we already interpreted it
-	(call-interactively ffap-file-finder))
-    (or filename (setq filename (ffap-prompter)))
-    (cond
-     ((ffap-url-p filename)
-      (let (current-prefix-arg)		; w3 2.3.25 bug, reported by KPC
-	(funcall ffap-url-fetcher filename)))
-     ;; This junk more properly belongs in a modified ffap-file-finder:
-     ((and ffap-dired-wildcards
-	   (string-match ffap-dired-wildcards filename))
-      (dired filename))
-     ((or (not ffap-newfile-prompt)
-	  (file-exists-p filename)
-	  (y-or-n-p "File does not exist, create buffer? "))
-      (funcall ffap-file-finder
-	       ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
-	       (expand-file-name filename)))
-     ;; User does not want to find a non-existent file:
-     ((signal 'file-error (list "Opening file buffer"
-				"no such file or directory"
-				filename))))))
-
-;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
-;;;###autoload
-(defalias 'ffap 'find-file-at-point)
-
-
-;;; Menu support (`ffap-menu'):
-
-(defvar ffap-menu-regexp nil
-  "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
-Make this more restrictive for faster menu building.
-For example, try \":/\" for URL (and some ftp) references.")
-
-(defvar ffap-menu-alist nil
-  "Buffer local cache of menu presented by `ffap-menu'.")
-(make-variable-buffer-local 'ffap-menu-alist)
-
-(defvar ffap-menu-text-plist
-  (cond
-   ((not window-system) nil)
-   (ffap-xemacs '(face bold highlight t)) ; keymap 
-   (t '(face bold mouse-face highlight))) ; keymap 
-  "Text properties applied to strings found by `ffap-menu-rescan'.
-These properties may be used to fontify the menu references.")
-
-;;;###autoload
-(defun ffap-menu (&optional rescan)
-  "Put up a menu of files and urls mentioned in this buffer.
-Then set mark, jump to choice, and try to fetch it.  The menu is
-cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
-The optional RESCAN argument \(a prefix, interactively\) forces
-a rebuild.  Searches with `ffap-menu-regexp'."
-  (interactive "P")
-  ;; (require 'imenu) -- no longer used, but roughly emulated
-  (if (or (not ffap-menu-alist) rescan
-	  ;; or if the first entry is wrong:
-	  (and ffap-menu-alist
-	       (let ((first (car ffap-menu-alist)))
-		 (save-excursion
-		   (goto-char (cdr first))
-		   (not (equal (car first) (ffap-guesser)))))))
-      (ffap-menu-rescan))
-  ;; Tail recursive:
-  (ffap-menu-ask
-   (if ffap-url-regexp "Find file or URL" "Find file")
-   (cons (cons "*Rescan Buffer*" -1) ffap-menu-alist)
-   'ffap-menu-cont))
-
-(defun ffap-menu-cont (choice)		; continuation of ffap-menu
-  (if (< (cdr choice) 0)
-      (ffap-menu t)			; *Rescan*
-    (push-mark)
-    (goto-char (cdr choice))
-    ;; Momentary highlight:
-    (unwind-protect
-	(progn
-	  (and ffap-highlight (ffap-guesser) (ffap-highlight))
-	  (sit-for 0)			; display
-	  (find-file-at-point (car choice)))
-      (ffap-highlight t))))
-
-(defun ffap-menu-ask (title alist cont)
-  "Prompt from a menu of choices, and then apply some action.
-Arguments are TITLE, ALIST, and CONT \(a continuation function\).
-This uses either a menu or the minibuffer depending on invocation.
-The TITLE string is used as either the prompt or menu title.
-Each \(string . data\) ALIST entry defines a choice.
-Function CONT is applied to the entry chosen by the user."
-  ;; Note: this function is used with a different continuation
-  ;; by the ffap-url add-on package.
-  ;; Could try rewriting to use easymenu.el or lmenu.el.
-  (let (choice)
-    (cond
-     ;; Emacs mouse:
-     ((and (not ffap-xemacs) (fboundp 'x-popup-menu) (ffap-mouse-event))
-      (setq choice
-	    (x-popup-menu
-	     t
-	     (list "" (cons title
-			    (mapcar (function (lambda (i) (cons (car i) i)))
-				    alist))))))
-     ;; XEmacs mouse:
-     ((and (fboundp 'popup-menu-and-execute-in-window) ; see menubar.el
-	   (ffap-mouse-event))
-      (setq choice
-	    (popup-menu-and-execute-in-window
-	     (append
-	      (list title "-")
-	      (mapcar (lambda (i) (vector (car i) (list 'quote i) t)) alist))
-	     (selected-window))))
-     ;; minibuffer with completion buffer:
-     (t
-      (let ((minibuffer-setup-hook 'minibuffer-completion-help))
-	;; Bug: prompting may assume unique strings, no "".
-	(setq choice
-	      (completing-read
-	       (format "%s (default %s): " title (car (car alist)))
-	       alist nil t
-	       ;; (cons (car (car alist)) 0)
-	       nil)))
-      (sit-for 0)			; redraw original screen
-      ;; Convert string to its entry, or else the default:
-      (setq choice (or (assoc choice alist) (car alist))))
-     )
-    (if choice
-	(funcall cont choice)
-      (message "No choice made!")	; possible with menus
-      nil)))
-
-(defun ffap-menu-rescan nil
-  "Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'.
-Applies `ffap-menu-text-plist' text properties at all matches."
-  (interactive)
-  (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
-	(range (- (point-max) (point-min)))
-	(mod (buffer-modified-p))	; was buffer modified?
-	buffer-read-only		; to set text-properties
-	item
-	;; Avoid repeated searches of the *mode-alist:
-	(major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
-			major-mode
-		      'file)))
-    (setq ffap-menu-alist nil)
-    (unwind-protect
-	(save-excursion
-	  (goto-char (point-min))
-	  (while (setq item (ffap-next-guess))
-	    (setq ffap-menu-alist (cons (cons item (point)) ffap-menu-alist))
-	    (add-text-properties (car ffap-string-at-point-region) (point)
-				 ffap-menu-text-plist)
-	    (message "Scanning...%2d%% <%s>"
-		     (/ (* 100 (- (point) (point-min))) range) item)))
-      (or mod (set-buffer-modified-p nil))))
-  (message "Scanning...done")
-  ;; Remove duplicates.
-  (setq ffap-menu-alist			; sort by item
-	(sort ffap-menu-alist
-	      (function
-	       (lambda (a b) (string-lessp (car a) (car b))))))
-  (let ((ptr ffap-menu-alist))		; remove duplicates
-    (while (cdr ptr)
-      (if (equal (car (car ptr)) (car (car (cdr ptr))))
-	  (setcdr ptr (cdr (cdr ptr)))
-	(setq ptr (cdr ptr)))))
-  (setq ffap-menu-alist			; sort by position
-	(sort ffap-menu-alist
-	      (function
-	       (lambda (a b) (< (cdr a) (cdr b)))))))
-
-
-;;; Mouse Support (`ffap-at-mouse'):
-;;
-;; See the suggested binding in ffap-bindings (near eof).
-
-(defvar ffap-at-mouse-fallback nil	; ffap-menu? too time-consuming
-  "Command invoked by `ffap-at-mouse' if nothing found at click, or nil.
-Ignored when `ffap-at-mouse' is called programmatically.")
-(put 'ffap-at-mouse-fallback 'risky-local-variable t)
-
-;;;###autoload
-(defun ffap-at-mouse (e)
-  "Find file or url guessed from text around mouse click.
-Interactively, calls `ffap-at-mouse-fallback' if no guess is found.
-Return value:
-  * if a guess string is found, return it (after finding it)
-  * if the fallback is called, return whatever it returns
-  * otherwise, nil"
-  (interactive "e")
-  (let ((guess
-	 ;; Maybe less surprising without the save-excursion?
-	 (save-excursion
-	   (mouse-set-point e)
-	   ;; Would prefer to do nothing unless click was *on* text.  How
-	   ;; to tell that the click was beyond the end of current line?
-	   (ffap-guesser))))
-    (cond
-     (guess
-      (set-buffer (ffap-event-buffer e))
-      (ffap-highlight)
-      (unwind-protect
-	  (progn
-	    (sit-for 0)			; display
-	    (message "Finding `%s'" guess)
-	    (find-file-at-point guess)
-	    guess)			; success: return non-nil
-	(ffap-highlight t)))
-     ((interactive-p)
-      (if ffap-at-mouse-fallback
-	  (call-interactively ffap-at-mouse-fallback)
-	(message "No file or url found at mouse click.")
-	nil))				; no fallback, return nil
-     ;; failure: return nil
-     )))
-
-(defvar ffap-mouse-track-clicks 3 "See `ffap-mouse-track-click'.")
-
-(defun ffap-mouse-track-click (event clicks) ; mouse-track, XEmacs only
-  "A possible entry for `mouse-track-click-hook'.
-Tries ffap-at-mouse when click count reaches `ffap-mouse-track-clicks'.
-To install, evaluate this:
-\(add-hook 'mouse-track-click-hook 'ffap-mouse-track-click\)"
-  ;; Problem: this is fairly slow as a mouse-track function.
-  (and (eq clicks ffap-mouse-track-clicks) (ffap-at-mouse event)))
-
-
-;;; ffap-other-* commands:
-;;
-;; Requested by KPC.
-
-;; There could be a real `ffap-noselect' function, but we would need
-;; at least two new user variables, and there is no w3-fetch-noselect.
-;; So instead, we just fake it with a slow save-window-excursion.
-
-(defun ffap-other-window nil
-  "Like `ffap', but put buffer in another window.
-Only intended for interactive use."
-  (interactive)
-  (switch-to-buffer-other-window
-   (save-window-excursion (call-interactively 'ffap) (current-buffer))))
-
-(defun ffap-other-frame nil
-  "Like `ffap', but put buffer in another frame.
-Only intended for interactive use."
-  (interactive)
-  ;; Extra code works around dedicated windows (noted by JENS, 7/96):
-  (let* ((win (selected-window)) (wdp (window-dedicated-p win)))
-    (unwind-protect
-	(progn
-	  (set-window-dedicated-p win nil)
-	  (switch-to-buffer-other-frame
-	   (save-window-excursion
-	     (call-interactively 'ffap)
-	     (current-buffer))))
-      (set-window-dedicated-p win wdp))))
-
-
-;;; Bug Reporter:
-
-(defun ffap-bug nil
-  "Submit a bug report for the ffap package."
-  ;; Important: keep the version string here in synch with that at top
-  ;; of file!  Could use lisp-mnt from Emacs 19, but that would depend
-  ;; on being able to find the ffap.el source file.
-  (interactive)
-  (require 'reporter)
-  (let ((reporter-prompt-for-summary-p t))
-    (reporter-submit-bug-report
-     "Michelangelo Grigni "
-     "ffap"
-     (mapcar 'intern (all-completions "ffap-" obarray 'boundp)))))
-
-(fset 'ffap-submit-bug 'ffap-bug)	; another likely name
-
-
-;;; Hooks for Gnus, VM, Rmail:
-;;
-;; If you do not like these bindings, write versions with whatever
-;; bindings you would prefer.
-
-(defun ffap-ro-mode-hook nil
-  "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
-  (local-set-key "\M-l" 'ffap-next)
-  (local-set-key "\M-m" 'ffap-menu)
-  )
-
-(defun ffap-gnus-hook nil
-  "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
-  (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's
-  ;; Note "l", "L", "m", "M" are taken:
-  (local-set-key "\M-l" 'ffap-gnus-next)
-  (local-set-key "\M-m" 'ffap-gnus-menu))
-
-(defun ffap-gnus-wrapper (form)		; used by both commands below
-  (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
-       (gnus-summary-select-article))	; get article of current line
-  ;; Preserve selected buffer, but do not do save-window-excursion,
-  ;; since we want to see any window created by the form.  Temporarily
-  ;; select the article buffer, so we can see any point movement.
-  (let ((sb (window-buffer (selected-window))))
-    (gnus-configure-windows 'article)
-    (pop-to-buffer gnus-article-buffer)
-    (widen)
-    ;; Skip headers for ffap-gnus-next (which will wrap around)
-    (if (eq (point) (point-min)) (search-forward "\n\n" nil t))
-    (unwind-protect
-	(eval form)
-      (pop-to-buffer sb))))
-
-(defun ffap-gnus-next nil
-  "Run `ffap-next' in the gnus article buffer."
-  (interactive) (ffap-gnus-wrapper '(ffap-next nil t)))
-
-(defun ffap-gnus-menu nil
-  "Run `ffap-menu' in the gnus article buffer."
-  (interactive) (ffap-gnus-wrapper '(ffap-menu)))
-
-
-;;; Offer default global bindings (`ffap-bindings'):
-
-(defvar ffap-bindings
-  (nconc
-   (if ffap-xemacs
-       '(
-	 (global-set-key '(shift button3) 'ffap-at-mouse)
-	 (global-set-key '(control shift button3) 'ffap-menu)
-	 ;; (add-hook 'mouse-track-click-hook 'ffap-mouse-track-click)
-	 )
-     '(
-       (global-set-key [S-mouse-3] 'ffap-at-mouse)
-       (global-set-key [C-S-mouse-3] 'ffap-menu)
-       ))
-   '(
-     (global-set-key "\C-x\C-f" 'find-file-at-point)
-     (global-set-key "\C-x4f"   'ffap-other-window)
-     (global-set-key "\C-x5f"   'ffap-other-frame)
-     (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
-     (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
-     (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
-     (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
-     ;; (setq dired-x-hands-off-my-keys t) ; the default
-     ))
-     "List of binding forms evaluated by function `ffap-bindings'.
-A reasonable ffap installation needs just these two lines:
-  (require 'ffap)
-  (ffap-bindings)
-Of course if you do not like these bindings, just roll your own!")
-
-(defun ffap-bindings nil
-  "Evaluate the forms in variable `ffap-bindings'."
-  (eval (cons 'progn ffap-bindings)))
-
-
-;;; ffap.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/field.el b/xemacs-packages/lisp/xemacs-base/field.el
deleted file mode 100644
index d52fcf45..00000000
--- a/xemacs-packages/lisp/xemacs-base/field.el
+++ /dev/null
@@ -1,297 +0,0 @@
-;;; field.el --- Emacs text field support
-
-;; Copyright (C) 2004 Jerry James
-
-;; Maintainer: Jerry James 
-;; Keywords: field
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3 + 09072004 CVS editfns.c.
-
-;;; Commentary:
-
-;; Emacs has a notion of a text field, which is a place to enter data
-;; (for communication with a subprocess, for example).  The Emacs
-;; implementation is written in C.  This implementation in XEmacs is in
-;; Lisp for now.  Report performance problems to the XEmacs Beta mailing
-;; list .
-
-;; This Lisp code is closely modeled after the C code in the Emacs
-;; sources.  The author will gladly consider better Lisp approaches.
-
-;; In Emacs, text fields are created by making overlays with the 'field
-;; property, or by using the text-property interface to mark a region of
-;; text with the 'field property.  However, the default "stickiness"
-;; (Emacs) or "open/closedness" (XEmacs) of text is reversed in XEmacs
-;; from Emacs.  This affects the determination of which of two adjacent
-;; fields is the relevant field.  This code:
-;;
-;; (with-temp-buffer
-;;   (insert "This is some text.\n")
-;;   (put-text-property 1  9 'field 1)
-;;   (put-text-property 9 13 'field 2)
-;;   (goto-char 9)
-;;   (insert-and-inherit "not ")
-;;   (get-char-property 9 'field))
-;;
-;; evaluates to 1 in Emacs, and 2 in XEmacs.  This file provides a
-;; function not available in Emacs, make-field, which produces
-;; Emacs-compatible fields.  When writing code intended to be compatible
-;; with Emacs, either use make-field, or explicitly set the stickiness
-;; (open/closedness) of your fields.
-
-
-;;; Code:
-
-(defgroup field nil
-  "Text fields."
-  :group 'editing)
-
-(defcustom inhibit-field-text-motion nil
-  "*Non-nil means text motion commands do not notice fields."
-  :type 'boolean
-  :group 'field)
-
-;;;###autoload
-(defun make-field (from to value &optional buffer front-advance rear-advance)
-  "Make a field with value VALUE over the range [FROM, TO) in BUFFER.
-If omitted, BUFFER defaults to the current buffer.
-FROM and TO may be integers or markers.
-The fifth argument, FRONT-ADVANCE, if non-nil, makes the front delimiter
-advance when text is inserted there.
-The sixth argument, REAR-ADVANCE, if non-nil, makes the rear delimiter
-advance when text is inserted there."
-  (let ((extent (make-extent from to buffer)))
-    (set-extent-property extent 'field value)
-    (set-extent-property extent 'start-open (not front-advance))
-    (set-extent-property extent 'end-open rear-advance)))
-
-;; The workhorse function
-(defun find-field (&optional pos merge-at-boundary beg-limit end-limit
-		   skip-start skip-stop)
-  "Return a pair (START . STOP) marking the field surrounding POS.
-If POS is nil, the value of (point) is used instead.
-If MERGE-AT-BOUNDARY is non-nil, then
- - if POS is at the very first position of a field, then the beginning of the
-   previous field is returned instead of the beginning of POS's field (since
-   the end of a field is actually also the beginning of the next input field,
-   this behavior is sometimes useful); and
- - if two fields are separated by a field with the special value `boundary',
-   and POS lies within it, then the two separated fields are considered to be
-   adjacent, and POS between them, when finding the beginning and ending of
-   the \"merged\" field.
-If BEG-LIMIT or END-LIMIT are non-nil, they limit the range of the returned
-results; they do not affect boundary behavior.
-if SKIP-START is non-nil, do not compute the START point (it is nil).
-If SKIP-STOP is non-nil, do not computer the STOP point (it is nil)."
-  (if (null pos)
-      (setq pos (point)))
-  (let ((after-field (get-char-property pos 'field nil 'after))
-	(before-field (get-char-property pos 'field nil 'before))
-	at-field-start at-field-end start stop)
-
-    ;; See if we need to handle the case where MERGE-AT-BOUNDARY is nil
-    ;; and POS is at beginning of a field, which can also be interpreted
-    ;; as the end of the previous field.  Note that the case where if
-    ;; MERGE-AT-BOUNDARY is non-nil (see docstring) is actually the more
-    ;; natural one; then we avoid treating the beginning of a field specially.
-    (unless merge-at-boundary
-      (let ((field
-	     (map-extents #'(lambda (ext ign) (extent-property ext 'field))
-			  nil pos pos nil nil 'field)))
-	(unless (eq field after-field)
-	  (setq at-field-end t))
-	(unless (eq field before-field)
-	  (setq at-field-start t))
-	;; If an inserted char would have a nil field while the surrounding
-	;; text is non-nil, we're probably not looking at a zero-length
-	;; field, but instead at a non-nil field that is not intended for
-	;; editing (such as comint's prompts).
-	(if (and (null field) at-field-start at-field-end)
-	    (setq at-field-start nil
-		  at-field-end nil))))
-
-    ;; Note about special `boundary' fields:
-    ;;
-    ;; Consider the case where the point (`.') is between the fields `x' and
-    ;; `y':
-    ;;
-    ;;   xxxx.yyyy
-    ;;
-    ;; In this situation, if MERGE-AT-BOUNDARY is non-nil, we consider the
-    ;; `x' and `y' fields as forming one big merged field, and so the end
-    ;; of the field is the end of `y'.
-    ;;
-    ;; However, if `x' and `y' are separated by a special `boundary' field
-    ;; (a field with a `field' char-property of 'boundary), then we ignore
-    ;; this special field when merging adjacent fields.  Here's the same
-    ;; situation, but with a `boundary' field between the `x' and `y' fields:
-    ;;
-    ;;   xxx.BBBByyyy
-    ;;
-    ;; Here, if point is at the end of `x', the beginning of `y', or
-    ;; anywhere in-between (within the `boundary' field), we merge all
-    ;; three fields and consider the beginning as being the beginning of
-    ;; the `x' field, and the end as being the end of the `y' field.
-
-    ;; Compute START
-    (unless skip-start
-      (if at-field-start
-	  ;; POS is at the edge of a field, and we should consider it as
-	  ;; the beginning of the following field.
-	  (setq start pos)
-	(let ((p pos))
-	  (if (and merge-at-boundary (eq before-field 'boundary))
-	      ;; Skip a `boundary' field
-	      (setq p
-		    (previous-single-property-change p 'field nil beg-limit)))
-	  (setq p (previous-single-property-change p 'field nil beg-limit))
-	  (setq start (if p p (point-min))))))
-
-    ;; Compute STOP
-    (unless skip-stop
-      (if at-field-end
-	  ;; POS is at the edge of a field, and we should consider it as
-	  ;; the end of the previous field.
-	  (setq stop pos)
-	(if (and merge-at-boundary (eq after-field 'boundary))
-	    ;; Skip a `boundary' field
-	    (setq pos (next-single-property-change pos 'field nil end-limit)))
-	(setq pos (next-single-property-change pos 'field nil end-limit))
-	(setq stop (if pos pos (point-max)))))
-
-    ;; Return (START . STOP)
-    (cons start stop)))
-
-;;;###autoload
-(defun delete-field (&optional pos)
-  "Delete the field surrounding POS.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS."
-  (let* ((field (find-field pos))
-	 (start (car field))
-	 (end (cdr field)))
-    (if (< start end)
-	(delete-region start end))))
-
-;;;###autoload
-(defun field-string (&optional pos)
-  "Return the contents of the field surrounding POS as a string.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS."
-  (let ((field (find-field pos)))
-    (buffer-substring (car field) (cdr field))))
-
-;;;###autoload
-(defun field-string-no-properties (&optional pos)
-  "Return the contents of the field around POS, without text-properties.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS."
-  (let ((field (find-field pos)))
-    (buffer-substring-no-properties (car field) (cdr field))))
-
-;;;###autoload
-(defun field-beginning (&optional pos escape-from-edge limit)
-  "Return the beginning of the field surrounding POS.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS.
-If ESCAPE-FROM-EDGE is non-nil and POS is at the beginning of its
-field, then the beginning of the *previous* field is returned.
-If LIMIT is non-nil, it is a buffer position; if the beginning of the field
-is before LIMIT, then LIMIT will be returned instead."
-  (car (find-field pos escape-from-edge limit nil nil t)))
-
-;;;###autoload
-(defun field-end (&optional pos escape-from-edge limit)
-  "Return the end of the field surrounding POS.
-A field is a region of text with the same `field' property.
-If POS is nil, the value of point is used for POS.
-If ESCAPE-FROM-EDGE is non-nil and POS is at the end of its field,
-then the end of the *following* field is returned.
-If LIMIT is non-nil, it is a buffer position; if the end of the field
-is after LIMIT, then LIMIT will be returned instead."
-  (cdr (find-field pos escape-from-edge nil limit t nil)))
-
-;;;###autoload
-(defun constrain-to-field (new-pos old-pos &optional escape-from-edge
-			   only-in-line inhibit-capture-property)
-  "Return the position closest to NEW-POS that is in the same field as OLD-POS.
-
-A field is a region of text with the same `field' property.
-If NEW-POS is nil, then the current point is used instead, and set to the
-constrained position if that is different.
-
-If OLD-POS is at the boundary of two fields, then the allowable
-positions for NEW-POS depend on the value of the optional argument
-ESCAPE-FROM-EDGE: If ESCAPE-FROM-EDGE is nil, then NEW-POS is
-constrained to the field that has the same `field' char-property
-as any new characters inserted at OLD-POS, whereas if ESCAPE-FROM-EDGE
-is non-nil, NEW-POS is constrained to the union of the two adjacent
-fields.  Additionally, if two fields are separated by another field with
-the special value `boundary', then any point within this special field is
-also considered to be `on the boundary'.
-
-If the optional argument ONLY-IN-LINE is non-nil and constraining
-NEW-POS would move it to a different line, NEW-POS is returned
-unconstrained.  This useful for commands that move by line, like
-\\[next-line] or \\[beginning-of-line], which should generally respect field
-boundaries only in the case where they can still move to the right line.
-
-If the optional argument INHIBIT-CAPTURE-PROPERTY is non-nil, and OLD-POS has
-a non-nil property of that name, then any field boundaries are ignored.
-
-Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil."
-  (let (orig-point)
-    (unless new-pos
-      (setq orig-point (point)
-	    new-pos (point)))
-    (when (and
-	   (null inhibit-field-text-motion)
-	   (not (eq new-pos old-pos))
-	   (or (get-char-property new-pos 'field)
-	       (get-char-property old-pos 'field))
-	   (or (null inhibit-capture-property)
-	       (null (get-char-property old-pos inhibit-capture-property))))
-      ;; NEW-POS is not within the same field as OLD-POS; try to move NEW-POS
-      ;; so that it is
-      (let* ((fwd (> new-pos old-pos))
-	     (field-bound
-	      (if fwd
-		  (field-end old-pos escape-from-edge new-pos)
-		(field-beginning old-pos escape-from-edge new-pos))))
-	;; See if ESCAPE-FROM-EDGE caused FIELD-BOUND to jump to the other
-	;; side of NEW-POS, which would mean that NEW-POS is already
-	;; acceptable, and it is not necessary to constrain it to FIELD-BOUND.
-	(if (and (if (< field-bound new-pos) fwd (not fwd))
-		 (or (null only-in-line)
-		     ;; Check that NEW-POS and FIELD-BOUND are on the same line
-		     (not
-		      (save-excursion
-			(goto-char new-pos)
-			(if fwd
-			    (search-forward "\n" field-bound t 1)
-			  (search-backward "\n" field-bound t 1))))))
-	    ;; Constrain NEW-POS to FIELD-BOUND
-	    (setq new-pos field-bound))
-
-	(if (and orig-point (/= new-pos orig-point))
-	    ;; The NEW-POS argument was originally nil, so automatically set
-	    ;; point.
-	    (goto-char new-pos)))))
-  new-pos)
diff --git a/xemacs-packages/lisp/xemacs-base/helper.el b/xemacs-packages/lisp/xemacs-base/helper.el
deleted file mode 100644
index 05e53e8b..00000000
--- a/xemacs-packages/lisp/xemacs-base/helper.el
+++ /dev/null
@@ -1,159 +0,0 @@
-;;; helper.el --- utility help package supporting help in electric modes
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-;; Keywords: help
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Code:
-
-;; hey, here's a helping hand.
-
-;; Bind this to a string for  in "... Other keys ".
-;; Helper-help uses this to construct help string when scrolling.
-;; Defaults to "return"
-(defvar Helper-return-blurb nil)
-
-;; Keymap implementation doesn't work too well for non-standard loops.
-;; But define it anyway for those who can use it.  Non-standard loops
-;; will probably have to use Helper-help.  You can't autoload the
-;; keymap either.
-
-
-(defvar Helper-help-map nil)
-(if Helper-help-map
-    nil
-  (setq Helper-help-map (make-keymap))
-  ;(fillarray Helper-help-map 'undefined)
-  (define-key Helper-help-map "m" 'Helper-describe-mode)
-  (define-key Helper-help-map "b" 'Helper-describe-bindings)
-  (define-key Helper-help-map "c" 'Helper-describe-key-briefly)
-  (define-key Helper-help-map "k" 'Helper-describe-key)
-  ;(define-key Helper-help-map "f" 'Helper-describe-function)
-  ;(define-key Helper-help-map "v" 'Helper-describe-variable)
-  (define-key Helper-help-map "?" 'Helper-help-options)
-  (define-key Helper-help-map (vector help-char) 'Helper-help-options)
-  (fset 'Helper-help-map Helper-help-map))
-
-(defun Helper-help-scroller ()
-  (let ((blurb (or (and (boundp 'Helper-return-blurb)
-			Helper-return-blurb)
-		   "return")))
-    (save-window-excursion
-      (goto-char (window-start (selected-window)))
-      (if (get-buffer-window "*Help*")
-	  (pop-to-buffer "*Help*")
-	(switch-to-buffer "*Help*"))
-      (goto-char (point-min))
-      (let ((continue t) state)
-	(while continue
-	  (setq state (+ (* 2 (if (pos-visible-in-window-p (point-max)) 1 0))
-			 (if (pos-visible-in-window-p (point-min)) 1 0)))
-	  (message
-	    (nth state
-		 '("Space forward, Delete back. Other keys %s"
-		   "Space scrolls forward. Other keys %s"
-		   "Delete scrolls back. Other keys %s"
-		   "Type anything to %s"))
-	    blurb)
-	  (setq continue (read-char))
-	  (cond ((and (memq continue '(?\ ?\C-v)) (< state 2))
-		 (scroll-up))
-		((= continue ?\C-l)
-		 (recenter))
-		((and (= continue ?\177) (zerop (% state 2)))
-		 (scroll-down))
-		(t (setq continue nil))))))))
-
-(defun Helper-help-options ()
-  "Describe help options."
-  (interactive)
-  (message "c (key briefly), m (mode), k (key), b (bindings)")
-  ;(message "c (key briefly), m (mode), k (key), v (variable), f (function)")
-  (sit-for 4))
-
-(defun Helper-describe-key-briefly (key)
-  "Briefly describe binding of KEY."
-  (interactive "kDescribe key briefly: ")
-  (describe-key-briefly key)
-  (sit-for 4))
-
-(defun Helper-describe-key (key)
-  "Describe binding of KEY."
-  (interactive "kDescribe key: ")
-  (save-window-excursion (describe-key key))
-  (Helper-help-scroller))
-
-(defun Helper-describe-function ()
-  "Describe a function.  Name read interactively."
-  (interactive)
-  (save-window-excursion (call-interactively 'describe-function))
-  (Helper-help-scroller))
-
-(defun Helper-describe-variable ()
-  "Describe a variable.  Name read interactively."
-  (interactive)
-  (save-window-excursion (call-interactively 'describe-variable))
-  (Helper-help-scroller))
-
-(defun Helper-describe-mode ()
-  "Describe the current mode."
-  (interactive)
-  (let ((name mode-name)
-	(documentation (documentation major-mode)))
-    (save-excursion
-      (set-buffer (get-buffer-create "*Help*"))
-      (erase-buffer)
-      (insert name " Mode\n" documentation)
-      (help-mode)))
-  (Helper-help-scroller))
-
-;;;###autoload
-(defun Helper-describe-bindings ()
-  "Describe local key bindings of current mode."
-  (interactive)
-  (message "Making binding list...")
-  (save-window-excursion (describe-bindings))
-  (Helper-help-scroller))
-
-;;;###autoload
-(defun Helper-help ()
-  "Provide help for current mode."
-  (interactive)
-  (let ((continue t) c)
-    (while continue
-      (message "Help (Type ? for further options)")
-      (setq c (read-key-sequence nil))
-      (setq c (lookup-key Helper-help-map c))
-      (cond ((eq c 'Helper-help-options)
-	     (Helper-help-options))
-	    ((commandp c)
-	     (call-interactively c)
-	     (setq continue nil))
-	    (t
-	     (ding)
-	     (setq continue nil))))))
-
-(provide 'helper)
-
-;;; helper.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/imenu.el b/xemacs-packages/lisp/xemacs-base/imenu.el
deleted file mode 100644
index 02620d79..00000000
--- a/xemacs-packages/lisp/xemacs-base/imenu.el
+++ /dev/null
@@ -1,1031 +0,0 @@
-;;; imenu.el --- Framework for mode-specific buffer indexes.
-
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
-
-;; Author: Ake Stenhoff 
-;;	   Lars Lindberg 
-;; Adapted-by: Hrvoje Niksic 
-;; Maintainer: Hrvoje Niksic 
-;; Created: 8 Feb 1994
-;; Keywords: tools
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 20.4
-
-;;; Commentary:
-
-;; Purpose of this package:
-;;   To present a framework for mode-specific buffer indexes.
-;;   A buffer index is an alist of names and buffer positions.
-;;   For instance all functions in a C-file and their positions.
-;;
-;; How it works:
-
-;;   A mode-specific function is called to generate the index.  It is
-;;   then presented to the user, who can choose from this index.
-;;
-;;   The package comes with a set of example functions for how to
-;;   utilize this package.
-
-;;   There are *examples* for index gathering functions/regular
-;;   expressions for C/C++ and Lisp/Emacs Lisp but it is easy to
-;;   customize for other modes.  A function for jumping to the chosen
-;;   index position is also supplied.
-
-;;; History:
-;;  Thanks go to
-;;  [simon] - Simon Leinen simon@lia.di.epfl.ch
-;;  [dean] - Dean Andrews ada@unison.com
-;;  [alon] - Alon Albert al@mercury.co.il
-;;  [greg] - Greg Thompson gregt@porsche.visix.COM
-;;  [wolfgang] - Wolfgang Bangerth zcg51122@rpool1.rus.uni-stuttgart.de
-;;  [kai] - Kai Grossjohann grossjoh@linus.informatik.uni-dortmund.de
-;;  [david] - David M. Smith dsmith@stats.adelaide.edu.au
-;;  [christian] - Christian Egli Christian.Egli@hcsd.hac.com
-;;  [karl] - Karl Fogel kfogel@floss.life.uiuc.edu
-
-;;; Code
-
-(eval-when-compile (require 'cl))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Customizable variables
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defgroup imenu nil
-  "Mode-specific buffer indexes."
-  :group 'matching
-  :group 'frames)
-
-(defcustom imenu-use-markers t
-  "*Non-nil means use markers instead of integers for Imenu buffer positions.
-
-Setting this to nil makes Imenu work a little faster but editing the
-buffer will make the generated index positions wrong.
-
-This might not yet be honored by all index-building functions."
-  :type 'boolean
-  :group 'imenu)
-
-
-(defcustom imenu-max-item-length 60
-  "*If a number, truncate Imenu entries to that length."
-  :type '(choice integer
-		 (const :tag "Unlimited"))
-  :group 'imenu)
-
-(defcustom imenu-auto-rescan nil
-  "*Non-nil means Imenu should always rescan the buffers."
-  :type 'boolean
-  :group 'imenu)
-
-(defcustom imenu-auto-rescan-maxout 60000 
-  "*Imenu auto-rescan is disabled in buffers larger than this size.
-This variable is buffer-local."
-  :type 'integer
-  :group 'imenu)
-
-(defcustom imenu-always-use-completion-buffer-p nil
-  "*Set this to non-nil for displaying the index in a completion buffer.
-
-`never' means never automatically display a listing of any kind.
-A value of nil (the default) means display the index as a mouse menu
-if the mouse was used to invoke `imenu'.
-Another non-nil value means always display the index in a completion buffer."
-  :type '(choice (const :tag "On Mouse" nil)
-		 (const :tag "Never" never)
-		 (sexp :tag "Always" :format "%t\n" t))
-  :group 'imenu)
-
-(defcustom imenu-sort-function nil
-  "*The function to use for sorting the index mouse-menu.
-
-Affects only the mouse index menu.
-
-Set this to nil if you don't want any sorting (faster).
-The items in the menu are then presented in the order they were found
-in the buffer.
-
-Set it to `imenu--sort-by-name' if you want alphabetic sorting.
-
-The function should take two arguments and return t if the first
-element should come before the second.  The arguments are cons cells;
-\(NAME . POSITION).  Look at `imenu--sort-by-name' for an example."
-  :type '(choice (const :tag "No sorting" nil)
-		 (const :tag "Sort by name" imenu--sort-by-name)
-		 (function :tag "Another function"))
-  :group 'imenu)
-
-(defcustom imenu-max-items 25
-  "*Maximum number of elements in a mouse menu for Imenu."
-  :type 'integer
-  :group 'imenu)
-
-(defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)"
-  "*Progress message during the index scanning of the buffer.
-If non-nil, user gets a message during the scanning of the buffer.
-
-Relevant only if the mode-specific function that creates the buffer
-index use `imenu-progress-message', and not useful if that is fast, in
-which case you might as well set this to nil."
-  :type '(choice string
-		 (const :tag "None" nil))
-  :group 'imenu)
-
-(defcustom imenu-space-replacement "."
-  "*The replacement string for spaces in index names.
-Used when presenting the index in a completion buffer to make the
-names work as tokens."
-  :type 'string
-  :group 'imenu)
-
-(defcustom imenu-level-separator ":"
-  "*The separator between index names of different levels.
-Used for making mouse-menu titles and for flattening nested indexes
-with name concatenation."
-  :type 'string
-  :group 'imenu)
-
-;;;###autoload
-(defvar imenu-generic-expression nil
-  "The regex pattern to use for creating a buffer index.
-
-If non-nil this pattern is passed to `imenu--generic-function'
-to create a buffer index.
-
-The value should be an alist with elements that look like this:
- (MENU-TITLE REGEXP INDEX)
-or like this:
- (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...)
-with zero or more ARGUMENTS.  The former format creates a simple element in
-the index alist when it matches; the latter creates a special element
-of the form  (NAME FUNCTION POSITION-MARKER ARGUMENTS...)
-with FUNCTION and ARGUMENTS beiong copied from `imenu-generic-expression'.
-
-MENU-TITLE is a string used as the title for the submenu or nil if the
-entries are not nested.
-
-REGEXP is a regexp that should match a construct in the buffer that is
-to be displayed in the menu; i.e., function or variable definitions,
-etc.  It contains a substring which is the name to appear in the
-menu.  See the info section on Regexps for more information.
-
-INDEX points to the substring in REGEXP that contains the name (of the
-function, variable or type) that is to appear in the menu.
-
-The variable is buffer-local.
-
-The variable `imenu-case-fold-search' determines whether or not the
-regexp matches are case sensitive. and `imenu-syntax-alist' can be
-used to alter the syntax table for the search.
-
-For example, see the value of `lisp-imenu-generic-expression' used by
-`lisp-mode' and `emacs-lisp-mode' with `imenu-syntax-alist' set
-locally to give the characters which normally have \"punctuation\"
-syntax \"word\" syntax during matching.")
-
-;;;###autoload
-(make-variable-buffer-local 'imenu-generic-expression)
-
-;;;; Hooks
-
-(defvar imenu-create-index-function 'imenu-default-create-index-function
-  "The function to use for creating a buffer index.
-
-It should be a function that takes no arguments and returns an index
-of the current buffer as an alist.
-
-Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION).
-Special elements look like (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...).
-A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
-The function `imenu--subalist-p' tests an element and returns t
-if it is a sub-alist.
-
-This function is called within a `save-excursion'.
-
-The variable is buffer-local.")
-(make-variable-buffer-local 'imenu-create-index-function)
-
-(defvar imenu-prev-index-position-function 'beginning-of-defun
-  "Function for finding the next index position.
-
-If `imenu-create-index-function' is set to
-`imenu-default-create-index-function', then you must set this variable
-to a function that will find the next index, looking backwards in the
-file.
-
-The function should leave point at the place to be connected to the
-index and it should return nil when it doesn't find another index.
-
-This variable is local in all buffers.")
-
-(make-variable-buffer-local 'imenu-prev-index-position-function)
-
-(defvar imenu-extract-index-name-function nil
-  "Function for extracting the index item name, given a position.
-
-This function is called after `imenu-prev-index-position-function'
-finds a position for an index item, with point at that position.
-It should return the name for that index item.
-
-This variable is local in all buffers.")
-;;;###autoload
-(make-variable-buffer-local 'imenu-extract-index-name-function)
-
-(defvar imenu-default-goto-function 'imenu-default-goto-function
-  "The default function called when selecting an Imenu item.
-The function in this variable is called when selecting a normal index-item.")
-(make-variable-buffer-local 'imenu-default-goto-function)
-
-
-(defun imenu--subalist-p (item)
-  (and (consp (cdr item)) (listp (cadr item))
-       (not (eq (car (cadr item)) 'lambda))))
-
-;; Macro to display a progress message.
-;; RELPOS is the relative position to display.
-;; If RELPOS is nil, then the relative position in the buffer
-;; is calculated.
-;; PREVPOS is the variable in which we store the last position displayed.
-(defmacro imenu-progress-message (prevpos &optional relpos reverse)
-  `(and
-    imenu-scanning-message
-    (let ((pos ,(if relpos
-		    relpos
-		  `(imenu--relative-position ,reverse))))
-      (if ,(if relpos t
-	     `(> pos (+ 5 ,prevpos)))
-	  (progn
-	    (message imenu-scanning-message pos)
-	    (setq ,prevpos pos))))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Some examples of functions utilizing the framework of this
-;;;; package.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Return the current/previous sexp and the location of the sexp (its
-;; beginning) without moving the point.
-(defun imenu-example--name-and-position ()
-  (save-excursion
-    (forward-sexp -1)
-    ;; [ydi] modified for imenu-use-markers
-    (let ((beg (if imenu-use-markers (point-marker) (point)))
-	  (end (progn (forward-sexp) (point))))
-      (cons (buffer-substring beg end)
-	    beg))))
-
-;;;
-;;; Lisp
-;;;
-
-(defun imenu-example--lisp-extract-index-name ()
-  ;; Example of a candidate for `imenu-extract-index-name-function'.
-  ;; This will generate a flat index of definitions in a lisp file.
-  (save-match-data
-    (and (looking-at "(def")
-	 (condition-case nil
-	     (progn
-	       (down-list 1)
-	       (forward-sexp 2)
-	       (let ((beg (point))
-		     (end (progn (forward-sexp -1) (point))))
-		 (buffer-substring beg end)))
-	   (error nil)))))
-
-(defun imenu-example--create-lisp-index ()
-  ;; Example of a candidate for `imenu-create-index-function'.
-  ;; It will generate a nested index of definitions.
-  (let ((index-alist '())
-	(index-var-alist '())
-	(index-type-alist '())
-	(index-unknown-alist '())
-	prev-pos)
-    (goto-char (point-max))
-    (imenu-progress-message prev-pos 0)
-    ;; Search for the function
-    (while (beginning-of-defun)
-      (imenu-progress-message prev-pos nil t)
-      (save-match-data
-	(and (looking-at "(def")
-	     (save-excursion
-	       (down-list 1)
-	       (cond
-		((looking-at "def\\(var\\|const\\)")
-		 (forward-sexp 2)
-		 (push (imenu-example--name-and-position)
-		       index-var-alist))
-		((looking-at "def\\(un\\|subst\\|macro\\|advice\\)")
-		 (forward-sexp 2)
-		 (push (imenu-example--name-and-position)
-		       index-alist))
-		((looking-at "def\\(type\\|struct\\|class\\|ine-condition\\)")
- 		 (forward-sexp 2)
- 		 (if (= (char-after (1- (point))) ?\))
- 		     (progn
- 		       (forward-sexp -1)
- 		       (down-list 1)
- 		       (forward-sexp 1)))
- 		 (push (imenu-example--name-and-position)
- 		       index-type-alist))
-		(t
-		 (forward-sexp 2)
-		 (push (imenu-example--name-and-position)
-		       index-unknown-alist)))))))
-    (imenu-progress-message prev-pos 100)
-    (and index-var-alist
-	 (push (cons "Variables" index-var-alist)
-	       index-alist))
-    (and index-type-alist
- 	 (push (cons "Types" index-type-alist)
-  	       index-alist))
-    (and index-unknown-alist
-	 (push (cons "Syntax-unknown" index-unknown-alist)
-	       index-alist))
-    index-alist))
-
-;; Regular expression to find C functions
-(defvar imenu-example--function-name-regexp-c
-  (concat
-   "^[a-zA-Z0-9]+[ \t]?"		; type specs; there can be no
-   "\\([a-zA-Z0-9_*]+[ \t]+\\)?"	; more than 3 tokens, right?
-   "\\([a-zA-Z0-9_*]+[ \t]+\\)?"
-   "\\([*&]+[ \t]*\\)?"			; pointer
-   "\\([a-zA-Z0-9_*]+\\)[ \t]*("	; name
-   ))
-
-(defun imenu-example--create-c-index (&optional regexp)
-  (let ((index-alist '())
-	prev-pos char)
-    (goto-char (point-min))
-    (imenu-progress-message prev-pos 0)
-    ;; Search for the function
-    (save-match-data
-      (while (re-search-forward
-	      (or regexp imenu-example--function-name-regexp-c)
-	      nil t)
-	(imenu-progress-message prev-pos)
-	(backward-up-list 1)
-	(save-excursion
-	  (goto-char (scan-sexps (point) 1))
-	  (setq char (following-char)))
-	;; Skip this function name if it is a prototype declaration.
-	(if (not (eq char ?\;))
-	    (push (imenu-example--name-and-position) index-alist))))
-    (imenu-progress-message prev-pos 100)
-    (nreverse index-alist)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Internal variables
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; The item to use in the index for rescanning the buffer.
-(defconst imenu--rescan-item '("*Rescan*" . -99))
-
-;; The latest buffer index.
-;; Buffer local.
-(defvar imenu--index-alist nil
-  "The buffer index computed for this buffer in Imenu.
-Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION).
-Special elements look like (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...).
-A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
-
-This variable is local in all buffers, once set.")
-
-(make-variable-buffer-local 'imenu--index-alist)
-
-(defvar imenu--last-menubar-index-alist nil
-  "The latest buffer index used to update the menu bar menu.")
-
-(make-variable-buffer-local 'imenu--last-menubar-index-alist)
-
-;; History list for 'jump-to-function-in-buffer'.
-;; Making this buffer local caused it not to work!
-(defvar imenu--history-list nil)
-
-;; Variable to which menu functions store the position.
-(defvar imenu--menu-callback-variable nil)
-
-;; Whether the menu creating functions should work for popup menus.
-;; Internal crock.
-(defvar imenu--popup-menu-p nil)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Internal support functions
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;
-;;; Sort function
-;;; Sorts the items depending on their index name.
-;;; An item looks like (NAME . POSITION).
-;;;
-(defun imenu--sort-by-name (item1 item2)
-  (string-lessp (car item1) (car item2)))
-
-(defun imenu--sort-by-position (item1 item2)
-  (< (cdr item1) (cdr item2)))
-
-(defun imenu--relative-position (&optional reverse)
-  ;; Support function to calculate relative position in buffer
-  ;; Beginning of buffer is 0 and end of buffer is 100
-  ;; If REVERSE is non-nil then the beginning is 100 and the end is 0.
-  (let ((pos (point))
-	(total (buffer-size)))
-    (and reverse (setq pos (- total pos)))
-    (if (> total 50000)
-	;; Avoid overflow from multiplying by 100!
-	(/ (1- pos) (max (/ total 100) 1))
-      (/ (* 100 (1- pos)) (max total 1)))))
-
-;; Split LIST into sublists of max length N.
-;; Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
-(defun imenu--split (list n)
-  (let ((remain list)
-	(result '())
-	(sublist '())
-	(i 0))
-    (while remain
-      (push (pop remain) sublist)
-      (incf i)
-      (and (= i n)
-	   ;; We have finished a sublist
-	   (progn (push (nreverse sublist) result)
-		  (setq i 0)
-		  (setq sublist '()))))
-    ;; There might be a sublist (if the length of LIST mod n is != 0)
-    ;; that has to be added to the result list.
-    (and sublist
-	 (push (nreverse sublist) result))
-    (nreverse result)))
-
-;;; Split the alist MENULIST into a nested alist, if it is long enough.
-;;; In any case, add TITLE to the front of the alist.
-(defun imenu--split-menu (menulist title)
-  (let (keep-at-top tail)
-    (if (memq imenu--rescan-item menulist)
-	(setq keep-at-top (cons imenu--rescan-item nil)
-	      menulist (delq imenu--rescan-item menulist)))
-    (setq tail menulist)
-    (while tail
-      (if (imenu--subalist-p (car tail))
-	  (setq keep-at-top (cons (car tail) keep-at-top)
-		menulist (delq (car tail) menulist)))
-      (setq tail (cdr tail)))
-    (if imenu-sort-function
-	(setq menulist
-	      (sort
-	       (let ((res nil)
-		     (oldlist menulist))
-		 ;; Copy list method from the cl package `copy-list'
-		 (while (consp oldlist) (push (pop oldlist) res))
-		 (if res		; in case, e.g. no functions defined
-		     (prog1 (nreverse res) (setcdr res oldlist))))
-	       imenu-sort-function)))
-    (if (> (length menulist) imenu-max-items)
-	(let ((count 0))
-	  (setq menulist
-		(mapcar
-		 (function
-		  (lambda (menu)
-		    (cons (format "From: %s" (caar menu)) menu)))
-		 (imenu--split menulist imenu-max-items)))))
-    (cons title
-	  (nconc (nreverse keep-at-top) menulist))))
-
-;;; Split up each long alist that are nested within ALIST
-;;; into nested alists.
-(defun imenu--split-submenus (alist)
-  (mapcar (function
-	   (lambda (elt)
-	     (if (and (consp elt)
-		      (stringp (car elt))
-		      (listp (cdr elt)))
-		 (imenu--split-menu (cdr elt) (car elt))
-	       elt)))
-	  alist))
-
-;;; Truncate all strings in MENULIST to imenu-max-item-length
-(defun imenu--truncate-items (menulist)
-  (mapcar (function
-	   (lambda (item)
-	     (cond
-	      ((consp (cdr item))
-	       (imenu--truncate-items (cdr item)))
-	      (t
-	       ;; truncate if necessary
-	       (if (and (numberp imenu-max-item-length)
-			(> (length (car item)) imenu-max-item-length))
-		   (setcar item (substring (car item) 0 imenu-max-item-length)))))))
-	  menulist))
-
-
-(defun imenu--make-index-alist (&optional noerror)
-  "Create an index-alist for the definitions in the current buffer.
-
-Report an error if the list is empty unless NOERROR is supplied and
-non-nil.
-
-Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION).
-Special elements look like (INDEX-NAME FUNCTION ARGUMENTS...).
-A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
-The function `imenu--subalist-p' tests an element and returns t
-if it is a sub-alist.
-
-There is one simple element with negative POSITION; that's intended
-as a way for the user to ask to recalculate the buffer's index alist."
-  (or (and imenu--index-alist
-	   (or (not imenu-auto-rescan)
-	       (and imenu-auto-rescan
-		    (> (buffer-size)  imenu-auto-rescan-maxout))))
-      ;; Get the index; truncate if necessary
-      (progn
-	(setq imenu--index-alist
-	      (save-excursion
-		(save-restriction
-		  (widen)
-		  (funcall imenu-create-index-function))))
-	(imenu--truncate-items imenu--index-alist)))
-  (or imenu--index-alist noerror
-      (error "No items suitable for an index found in this buffer"))
-  (or imenu--index-alist
-      (setq imenu--index-alist (list nil)))
-  ;; Add a rescan option to the index.
-  (cons imenu--rescan-item imenu--index-alist))
-
-;;; Find all markers in alist and makes
-;;; them point nowhere.
-;;; The top-level call uses nil as the argument;
-;;; non-nil arguments are in recursivecalls.
-(defvar imenu--cleanup-seen)
-
-(defun imenu--cleanup (&optional alist)
-  ;; If alist is provided use that list.
-  ;; If not, empty the table of lists already seen
-  ;; and use imenu--index-alist.
-  (if alist
-      (setq imenu--cleanup-seen (cons alist imenu--cleanup-seen))
-    (setq alist imenu--index-alist imenu--cleanup-seen (list alist)))
-
-  (and alist
-       (mapcar
-	(function
-	 (lambda (item)
-	   (cond
-	    ((markerp (cdr item))
-	     (set-marker (cdr item) nil))
-	    ;; Don't process one alist twice.
-	    ((memq (cdr item) imenu--cleanup-seen))
-	    ((imenu--subalist-p item)
-	     (imenu--cleanup (cdr item))))))
-	alist)
-       t))
-
-
-(defun imenu--in-alist (str alist)
-  "Check whether the string STR is contained in multi-level ALIST."
-  (let (elt head tail res)
-    (setq res nil)
-    (while alist
-      (setq elt (car alist)
-	    tail (cdr elt)
-	    alist (cdr alist)
-	    head (car elt))
-      ;; A nested ALIST element looks like
-      ;;   (INDEX-NAME (INDEX-NAME . INDEX-POSITION) ...)
-      ;; while a bottom-level element looks like
-      ;;   (INDEX-NAME . INDEX-POSITION)
-      ;; We are only interested in the bottom-level elements, so we need to
-      ;; recurse if TAIL is a list.
-      (cond ((listp tail)
-	     (if (setq res (imenu--in-alist str tail))
-		 (setq alist nil)))
-	    ((string= str head)
-	     (setq alist nil res elt))))
-    res))
-
-(defvar imenu-syntax-alist nil
-  "Alist of syntax table modifiers to use while executing `imenu--generic-function'.
-
-The car of the assocs may be either a character or a string and the
-cdr is a syntax description appropriate fo `modify-syntax-entry'.  For
-a string, all the characters in the string get the specified syntax.
-
-This is typically used to give word syntax to characters which
-normally have symbol syntax to simplify `imenu-expression'
-and speed-up matching.")
-(make-variable-buffer-local 'imenu-syntax-alist)
-
-(defun imenu-default-create-index-function ()
-  "*Wrapper for index searching functions.
-
-Moves point to end of buffer and then repeatedly calls
-`imenu-prev-index-position-function' and `imenu-extract-index-name-function'.
-Their results are gathered into an index alist."
-  ;; These should really be done by setting imenu-create-index-function
-  ;; in these major modes.  But save that change for later.
-  (cond ((and imenu-prev-index-position-function
-	      imenu-extract-index-name-function)
-	 (let ((index-alist '())
-	       prev-pos name)
-	   (goto-char (point-max))
-	   (imenu-progress-message prev-pos 0 t)
-	   ;; Search for the function
-	   (while (funcall imenu-prev-index-position-function)
-	     (imenu-progress-message prev-pos nil t)
-	     (save-excursion
-	       (setq name (funcall imenu-extract-index-name-function)))
-	     (and (stringp name)
- 		  ;; [ydi] updated for imenu-use-markers
-		  (push (cons name (if imenu-use-markers (point-marker) (point)))
-			index-alist)))
-	   (imenu-progress-message prev-pos 100 t)
-	   index-alist))
-	;; Use generic expression if possible.
-	((and imenu-generic-expression)
-	 (imenu--generic-function imenu-generic-expression))
-	(t
-	 (error "This buffer cannot use `imenu-default-create-index-function'"))))
-
-(defun imenu--replace-spaces (name replacement)
-  ;; Replace all spaces in NAME with REPLACEMENT.
-  ;; That second argument should be a string.
-  (mapconcat
-   (function
-    (lambda (ch)
-      (if (char-equal ch ?\ )
-	  replacement
-	(char-to-string ch))))
-   name
-   ""))
-
-;; Not used and would require cl at run time
-;;; (defun imenu--flatten-index-alist (index-alist &optional concat-names prefix)
-;;;   ;; Takes a nested INDEX-ALIST and returns a flat index alist.
-;;;   ;; If optional CONCAT-NAMES is non-nil, then a nested index has its
-;;;   ;; name and a space concatenated to the names of the children.
-;;;   ;; Third argument PREFIX is for internal use only.
-;;;   (mapcan
-;;;    (lambda (item)
-;;;      (let* ((name (car item))
-;;; 	    (pos (cdr item))
-;;; 	    (new-prefix (and concat-names
-;;; 			     (if prefix
-;;; 				 (concat prefix imenu-level-separator name)
-;;; 			       name))))
-;;;        (cond
-;;; 	((or (markerp pos) (numberp pos))
-;;; 	 (list (cons new-prefix pos)))
-;;; 	(t
-;;; 	 (imenu--flatten-index-alist pos new-prefix)))))
-;;;    index-alist))
-
-;;;
-;;; Generic index gathering function.
-;;;
-
-(defvar imenu-case-fold-search t
-  "Defines whether `imenu--generic-function' should fold case when matching.
-
-This buffer-local variable should be set (only) by initialization code
-for modes which use `imenu--generic-function'.  If it is not set, that
-function will use the current value of `case-fold-search' to match
-patterns.")
-
-(make-variable-buffer-local 'imenu-case-fold-search)
-
-;; Originally "Built on some ideas that Erik Naggum 
-;; once posted to comp.emacs" but since substantially re-written.
-(defun imenu--generic-function (patterns)
-  "Return an index of the current buffer as an alist.
-
-PATTERNS is an alist with elements that look like this:
- (MENU-TITLE REGEXP INDEX).
-
-MENU-TITLE is a string used as the title for the submenu or nil if the
-entries are not nested.
-
-REGEXP is a regexp that should match a construct in the buffer that is
-to be displayed in the menu; i.e., function or variable definitions,
-etc.  It contains a substring which is the name to appear in the
-menu.  See the info section on Regexps for more information.
-
-INDEX points to the substring in REGEXP that contains the name (of the
-function, variable or type) that is to appear in the menu.
-
-See `lisp-imenu-generic-expression' for an example of PATTERNS.
-
-Returns an index of the current buffer as an alist.  The elements in
-the alist look like: (INDEX-NAME . INDEX-POSITION).  They may also be
-nested index lists like (INDEX-NAME . INDEX-ALIST) depending on
-PATTERNS."
-
-  (let ((index-alist (list 'dummy))
-	prev-pos beg
-        (case-fold-search imenu-case-fold-search)
-        (old-table (syntax-table))
-        (table (copy-syntax-table (syntax-table)))
-        (slist imenu-syntax-alist))
-    ;; Modify the syntax table used while matching regexps.
-    (while slist
-      ;; The character(s) to modify may be a single char or a string.
-      (if (numberp (caar slist))
-	  (modify-syntax-entry (caar slist) (cdar slist) table)
-	(mapcar (function
-		 (lambda (c)
-		   (modify-syntax-entry c (cdar slist) table)))
-		(caar slist)))
-      (setq slist (cdr slist)))
-    (goto-char (point-max))
-    (imenu-progress-message prev-pos 0 t)
-    (unwind-protect			; for syntax table
-	(save-match-data
-	  (set-syntax-table table)
-	  ;; map over the elements of imenu-generic-expression
-	  ;; (typically functions, variables ...)
-	  (mapcar
-	   (function
-	    (lambda (pat)
-	      (let ((menu-title (car pat))
-		    (regexp (nth 1 pat))
-		    (index (nth 2 pat))
-		    (function (nth 3 pat))
-		    (rest (nthcdr 4 pat)))
-		;; Go backwards for convenience of adding items in order.
-		(goto-char (point-max))
-		(while (re-search-backward regexp nil t)
-		  (imenu-progress-message prev-pos nil t)
-		  (setq beg (match-beginning index))
-		  ;; Add this sort of submenu only when we've found an
-		  ;; item for it, avoiding empty, duff menus.
-		  (unless (assoc menu-title index-alist)
-		    (push (list menu-title) index-alist))
-		  (if imenu-use-markers
-		      (setq beg (set-marker (make-marker) beg)))
-		  (let ((item
-			 (if function
-			     (nconc (list (match-string index)
-					  beg function)
-				    rest)
-			   (cons (match-string index)
-				 beg)))
-			;; This is the desired submenu,
-			;; starting with its title (or nil).
-			(menu (assoc menu-title index-alist)))
-		    ;; Insert the item unless it is already present.
-		    (unless (member item (cdr menu))
-		      (setcdr menu
-			      (cons item (cdr menu)))))))))
-	   patterns)
-	  (set-syntax-table old-table)))
-    (imenu-progress-message prev-pos 100 t)
-    ;; Sort each submenu by position.
-    ;; This is in case one submenu gets items from two different regexps.
-    (let ((tail index-alist))
-      (while tail
-	(if (listp (car tail))
-	    (setcdr (car tail)
-		    (sort (cdr (car tail)) 'imenu--sort-by-position)))
-	(setq tail (cdr tail))))
-    (let ((main-element (assq nil index-alist)))
-      (nconc (delq main-element (delq 'dummy index-alist))
-	     (cdr main-element)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; The main functions for this package!
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun imenu--completion-buffer (index-alist &optional prompt)
-  "Let the user select from INDEX-ALIST in a completion buffer with PROMPT.
-
-Returns t for rescan and otherwise a position number."
-  ;; Create a list for this buffer only when needed.
-  (let ((name (thing-at-point 'symbol))
-	choice
-	(prepared-index-alist
-	 (mapcar
-	  (function
-	   (lambda (item)
-	     (cons (imenu--replace-spaces (car item) imenu-space-replacement)
-		   (cdr item))))
-	  index-alist)))
-    (cond (prompt)
-	  ((and name (imenu--in-alist name prepared-index-alist))
-	   (setq prompt (format "Index item (default %s): " name)))
-	  (t (setq prompt "Index item: ")))
-    (if (eq imenu-always-use-completion-buffer-p 'never)
-  	(let ((name2 (completing-read prompt
-				      prepared-index-alist
-				      nil t nil 'imenu--history-list)))
-	  (or (string= name2 "") (setq name name2)))
-      (save-window-excursion
-	;; Display the completion buffer
-	(with-output-to-temp-buffer "*Completions*"
-	  (display-completion-list
-	   (all-completions "" prepared-index-alist)))
-	;; Make a completion question
-  	(let ((name2 (completing-read prompt
-				      prepared-index-alist
-				      nil t nil 'imenu--history-list)))
-	  (or (string= name2 "") (setq name name2)))))
-    (cond ((not (stringp name))
-	   nil)
-	  ((string= name (car imenu--rescan-item))
-	   t)
-	  (t
-	   (setq choice (assoc name prepared-index-alist))
-	   (if (imenu--subalist-p choice)
-	       (imenu--completion-buffer (cdr choice) prompt)
-	     choice)))))
-
-(defun imenu--create-menu-2 (list)
-  (cond ((listp (cdr list))
-	 (imenu--create-menu-1 (car list) (cdr list)))
-	(t
-	 (vector (car list)
-		 (if imenu--popup-menu-p
-		     `(setq imenu--menu-callback-variable (quote ,list))
-		   `(imenu--menubar-select (quote ,list)))
-		 t))))
-
-(defun imenu--create-menu-1 (title list)
-  (cons title (mapcar 'imenu--create-menu-2 (delq nil list))))
-
-(defun imenu--mouse-menu (index-alist event &optional title)
-  "Let the user select from a buffer index from a mouse menu.
-
-INDEX-ALIST is the buffer index and EVENT is a mouse event.
-
-Returns t for rescan and otherwise an element or subelement of INDEX-ALIST."
-  (setq index-alist (imenu--split-submenus index-alist))
-  (let* ((menu 	(imenu--split-menu index-alist
-		 (or title (buffer-name))))
-	 (imenu--popup-menu-p t))
-    (setq menu (imenu--create-menu-1 (car menu) 
-				     (if (< 1 (length (cdr menu)))
-					 (cdr menu)
-				       (cdr (car (cdr menu))))))
-    (setq imenu--menu-callback-variable nil)
-    (popup-menu menu event)
-    ;; Wait for menu to bail out.
-    (let (event)
-      (while (not (misc-user-event-p (setq event (next-event))))
-	(dispatch-event event))
-      (dispatch-event event))
-    imenu--menu-callback-variable))
-
-(defun imenu-choose-buffer-index (&optional prompt alist)
-  "Let the user select from a buffer index and return the chosen index.
-
-If the user originally activated this function with the mouse, a mouse
-menu is used.  Otherwise a completion buffer is used and the user is
-prompted with PROMPT.
-
-If you call this function with index alist ALIST, then it lets the user
-select from ALIST.
-
-With no index alist ALIST, it calls `imenu--make-index-alist' to
-create the index alist.
-
-If `imenu-always-use-completion-buffer-p' is non-nil, then the
-completion buffer is always used, no matter if the mouse was used or
-not.
-
-The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
-  (let (index-alist
-	(mouse-triggered (or (button-press-event-p last-command-event)
-			     (button-release-event-p last-command-event)
-			     (misc-user-event-p last-command-event)))
-	(result t))
-    ;; If selected by mouse, see to that the window where the mouse is
-    ;; really is selected.
-    (and mouse-triggered
-	 (not (misc-user-event-p last-command-event))
-	 (let ((window (event-window last-command-event)))
-	   (and window
-		(select-window window))))
-    ;; Create a list for this buffer only when needed.
-    (while (eq result t)
-      (setq index-alist (if alist alist (imenu--make-index-alist)))
-      (setq result
-	    (if (and mouse-triggered
-		     (not imenu-always-use-completion-buffer-p))
-		(imenu--mouse-menu index-alist last-command-event)
-	      (imenu--completion-buffer index-alist prompt)))
-      (and (eq result t)
-	   (imenu--cleanup)
-	   (setq imenu--index-alist nil)))
-    result))
-
-;;;###autoload
-(defun imenu-add-to-menubar (name)
-  "Add an `imenu' entry to the menu bar for the current buffer.
-NAME is a string used to name the menu bar item.
-See the command `imenu' for more information."
-  (interactive "sImenu menu item name: ")
-  (if (or (and imenu-prev-index-position-function
-	       imenu-extract-index-name-function)
-	  imenu-generic-expression
-	  (not (eq imenu-create-index-function
-		   'imenu-default-create-index-function)))
-      (easy-menu-add (list name
-			   :filter 'imenu-menu-filter))
-    (error "The mode `%s' does not support Imenu" mode-name)))
-
-;;;###autoload
-(defun imenu-add-menubar-index ()
-  "Add an Imenu \"Index\" entry on the menu bar for the current buffer.
-
-A trivial interface to `imenu-add-to-menubar' suitable for use in a hook."
-  (interactive)
-  (imenu-add-to-menubar "Index"))
-
-(defvar imenu--last-menubar-filter-menu nil)
-(make-variable-buffer-local 'imenu--last-menubar-filter-menu)
-
-(defun imenu-menu-filter (&rest ignore)
-  (let ((index-alist (imenu--make-index-alist t)))
-    ;; Don't bother updating if the index-alist has not changed
-    ;; since the last time we did it.
-    (if (equal index-alist imenu--last-menubar-index-alist)
-	imenu--last-menubar-filter-menu
-      (setq imenu--last-menubar-index-alist index-alist)
-      (setq index-alist (imenu--split-submenus index-alist))
-      (let ((menu (imenu--split-menu index-alist (buffer-name))))
-	(setq imenu--last-menubar-filter-menu
-	      (cdr (imenu--create-menu-1 (car menu) 
-					 (if (< 1 (length (cdr menu)))
-					     (cdr menu)
-					   (cdr (car (cdr menu)))))))))))
-
-(defun imenu--menubar-select (item)
-  "Use Imenu to select the function or variable named in this menu item."
-  (if (equal item imenu--rescan-item)
-      (progn
-	(imenu--cleanup)
-	(setq imenu--index-alist nil))
-    (imenu item)))
-
-(defun imenu-default-goto-function (name position &optional rest)
-  "Move the point to the given position.
-
-NAME is ignored.  POSITION is where to move.  REST is also ignored.
-The ignored args just make this function have the same interface as a
-function placed in a special index-item."
-  (if (or (< position (point-min))
-	  (> position (point-max)))
-      ;; widen if outside narrowing
-      (widen))
-  (goto-char position))
-
-;;;###autoload
-(defun imenu (index-item)
-  "Jump to a place in the buffer chosen using a buffer menu or mouse menu.
-INDEX-ITEM specifies the position.  See `imenu-choose-buffer-index'
-for more information."
-  (interactive (list (imenu-choose-buffer-index)))
-  ;; Convert a string to an alist element.
-  (if (stringp index-item)
-      (setq index-item (assoc index-item (imenu--make-index-alist))))
-  (and index-item
-       (progn
-	 (push-mark)
-	 (let* ((is-special-item (listp (cdr index-item)))
-		(function
-		 (if is-special-item
-		     (nth 2 index-item) imenu-default-goto-function))
-	       (position (if is-special-item
-			     (cadr index-item) (cdr index-item)))
-	       (rest (if is-special-item (cddr index-item))))
-	   (apply function (car index-item) position rest)))))
-
-(provide 'imenu)
-
-;;; imenu.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/iso-syntax.el b/xemacs-packages/lisp/xemacs-base/iso-syntax.el
deleted file mode 100644
index 49a4620b..00000000
--- a/xemacs-packages/lisp/xemacs-base/iso-syntax.el
+++ /dev/null
@@ -1,38 +0,0 @@
-;;; iso-syntax.el --- set up case-conversion and syntax tables for ISO 8859/1
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; Written by Howard Gayle.  See case-table.el for details.
-
-;; This file exists for backward compatibility.
-;;; Code:
-
-(require 'iso8859-1)
-(provide 'iso-syntax)
-
-;;; iso-syntax.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/macros.el b/xemacs-packages/lisp/xemacs-base/macros.el
deleted file mode 100644
index a1f7f2dd..00000000
--- a/xemacs-packages/lisp/xemacs-base/macros.el
+++ /dev/null
@@ -1,242 +0,0 @@
-;;; macros.el --- non-primitive commands for keyboard macros
-
-;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc.
-
-;; Maintainer: XEmacs Development Team
-;; Keywords: abbrev
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;; Extension commands for keyboard macros.  These permit you to assign
-;; a name to the last-defined keyboard macro, expand and insert the
-;; lisp corresponding to a macro, query the user from within a macro,
-;; or apply a macro to each line in the reason.
-
-;; This file is largely superseded by edmacro.el as of XEmacs 20.1. -sb
-
-;;; Code:
-
-;;;###autoload
-(defun name-last-kbd-macro (symbol)
-  "Assign a name to the last keyboard macro defined.
-Argument SYMBOL is the name to define.
-The symbol's function definition becomes the keyboard macro string.
-Such a \"function\" cannot be called from Lisp, but it is a valid
-editor command."
-  (interactive "SName for last kbd macro: ")
-  (or last-kbd-macro
-      (error "No keyboard macro defined"))
-  (and (fboundp symbol)
-       (not (stringp (symbol-function symbol)))
-       (not (vectorp (symbol-function symbol)))
-       (error "Function %s is already defined and not a keyboard macro"
-	      symbol))
-  (if (string-equal symbol "")
-      (error "No command name given"))
-  (fset symbol last-kbd-macro))
-
-;;;###autoload
-(defun assign-last-kbd-macro-to-key (key)
-  "Assign to a key sequence the last keyboard macro defined.
-Argument KEY is anything acceptable to `define-key'.."
-  (interactive
-   (list (read-key-sequence "Key sequence for last kbd macro: ")))
-  (or last-kbd-macro
-      (error "No keyboard macro defined"))
-  (global-set-key key last-kbd-macro))
-
-;;; Moved here from edmacro.el:
-
-;;;###autoload
-(defun insert-kbd-macro (macroname &optional keys)
-  "Insert in buffer the definition of kbd macro NAME, as Lisp code.
-Optional second arg KEYS means also record the keys it is on
-\(this is the prefix argument, when calling interactively).
-
-This Lisp code will, when executed, define the kbd macro with the same
-definition it has now.  If you say to record the keys, the Lisp code
-will also rebind those keys to the macro.  Only global key bindings
-are recorded since executing this Lisp code always makes global
-bindings.
-
-To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
-use this command, and then save the file."
-  (interactive "CInsert kbd macro (name): \nP")
-  (let (definition)
-    (if (string= (symbol-name macroname) "")
-	(progn
-	  ;; XEmacs change: delete lots of stuff, use format-kbd-macro
-	  (setq definition (format-kbd-macro))
-	  (insert "(setq last-kbd-macro"))
-      (setq definition (format-kbd-macro macroname))
-      (insert (format "(defalias '%s" macroname)))
-    (if (> (length definition) 50)
-	(insert " (read-kbd-macro\n")
-      (insert "\n  (read-kbd-macro "))
-    (prin1 definition (current-buffer))
-    (insert "))\n")
-    (if keys
-	(let ((keys (where-is-internal macroname)))
-	  (while keys
-	    (insert (format "(global-set-key %S '%s)\n" (car keys) macroname))
-	    (pop keys))))))
-
-;;;###autoload
-(defun kbd-macro-query (flag)
-  "Query user during kbd macro execution.
-With prefix argument, enters recursive edit,
- reading keyboard commands even within a kbd macro.
- You can give different commands each time the macro executes.
-Without prefix argument, asks whether to continue running the macro.
-Your options are: \\
-\\[act]	Finish this iteration normally and continue with the next.
-\\[skip]	Skip the rest of this iteration, and start the next.
-\\[exit]	Stop the macro entirely right now.
-\\[recenter]	Redisplay the frame, then ask again.
-\\[edit]	Enter recursive edit; ask again when you exit from that."
-  (interactive "P")
-  (or executing-kbd-macro
-      defining-kbd-macro
-      (error "Not defining or executing kbd macro"))
-  (if flag
-      (let (executing-kbd-macro defining-kbd-macro)
-	(recursive-edit))
-    (if (not executing-kbd-macro)
-	nil
-      (let ((loop t)
-	    (msg (substitute-command-keys
-                  "Proceed with macro?\\\
- (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) ")))
-	(while loop
-	  (let ((key (let ((executing-kbd-macro nil)
-			    (defining-kbd-macro nil))
-                       (message "%s" msg)
-		       ;; XEmacs: avoid `read-char'.
-                       (next-command-event)))
-                def)
-	    (setq key (events-to-keys (vector key)))
-	    (setq def (lookup-key query-replace-map key))
-	    (cond ((eq def 'act)
-		   (setq loop nil))
-		  ((eq def 'skip)
-		   (setq loop nil)
-		   (setq executing-kbd-macro ""))
-		  ((eq def 'exit)
-		   (setq loop nil)
-		   (setq executing-kbd-macro t))
-		  ((eq def 'recenter)
-		   (recenter nil))
-		  ((eq def 'edit)
-		   (let (executing-kbd-macro defining-kbd-macro)
-		     (recursive-edit)))
-		  ((eq def 'quit)
-		   (setq quit-flag t))
-		  (t
-		   (or (eq def 'help)
-		       (ding))
-		   (with-output-to-temp-buffer "*Help*"
-		     (princ
-		      (substitute-command-keys
-		       "Specify how to proceed with keyboard macro execution.
-Possibilities: \\
-\\[act]	Finish this iteration normally and continue with the next.
-\\[skip]	Skip the rest of this iteration, and start the next.
-\\[exit]	Stop the macro entirely right now.
-\\[recenter]	Redisplay the frame, then ask again.
-\\[edit]	Enter recursive edit; ask again when you exit from that."))
-		     (save-excursion
-		       (set-buffer standard-output)
-		       (help-mode)))))))))))
-
-;;;###autoload
-(defun apply-macro-to-region-lines (top bottom &optional macro)
-  "For each complete line between point and mark, move to the beginning
-of the line, and run the last keyboard macro.
-
-When called from lisp, this function takes two arguments TOP and
-BOTTOM, describing the current region.  TOP must be before BOTTOM.
-The optional third argument MACRO specifies a keyboard macro to
-execute.
-
-This is useful for quoting or unquoting included text, adding and
-removing comments, or producing tables where the entries are regular.
-
-For example, in Usenet articles, sections of text quoted from another
-author are indented, or have each line start with `>'.  To quote a
-section of text, define a keyboard macro which inserts `>', put point
-and mark at opposite ends of the quoted section, and use
-`\\[apply-macro-to-region-lines]' to mark the entire section.
-
-Suppose you wanted to build a keyword table in C where each entry
-looked like this:
-
-    { \"foo\", foo_data, foo_function },
-    { \"bar\", bar_data, bar_function },
-    { \"baz\", baz_data, baz_function },
-
-You could enter the names in this format:
-
-    foo
-    bar
-    baz
-
-and write a macro to massage a word into a table entry:
-
-    \\C-x (
-       \\M-d { \"\\C-y\", \\C-y_data, \\C-y_function },
-    \\C-x )
-
-and then select the region of un-tablified names and use
-`\\[apply-macro-to-region-lines]' to build the table from the names.
-"
-  (interactive "r")
-  (or macro
-      (progn
-	(if (null last-kbd-macro)
-	    (error "No keyboard macro has been defined"))
-	(setq macro last-kbd-macro)))
-  (save-excursion
-    (let ((end-marker (progn
-			(goto-char bottom)
-			(beginning-of-line)
-			(point-marker)))
-	  next-line-marker)
-      (goto-char top)
-      (if (not (bolp))
-	  (forward-line 1))
-      (setq next-line-marker (point-marker))
-      (while (< next-line-marker end-marker)
-	(goto-char next-line-marker)
-	(save-excursion
-	  (forward-line 1)
-	  (set-marker next-line-marker (point)))
-	(save-excursion
-	  (let ((mark-active nil))
-	    (execute-kbd-macro (or macro last-kbd-macro)))))
-      (set-marker end-marker nil)
-      (set-marker next-line-marker nil))))
-
-(provide 'macros)
-
-(provide 'macros)
-
-;;; macros.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/novice.el b/xemacs-packages/lisp/xemacs-base/novice.el
deleted file mode 100644
index 5a6e5cc2..00000000
--- a/xemacs-packages/lisp/xemacs-base/novice.el
+++ /dev/null
@@ -1,168 +0,0 @@
-;;; novice.el --- handling of disabled commands ("novice mode") for XEmacs.
-
-;; Copyright (C) 1985-7, 1992-4, Free Software Foundation, Inc.
-
-;; Maintainer: XEmacs Development Team
-;; Keywords: internal, help
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This mode provides a hook which is, by default, attached to various
-;; putatively dangerous commands in a (probably futile) attempt to
-;; prevent lusers from shooting themselves in the feet.
-
-;;; Code:
-
-;; This function is called (by autoloading)
-;; to handle any disabled command.
-;; The command is found in this-command
-;; and the keys are returned by (this-command-keys).
-
-;;;###autoload
-;(setq disabled-command-hook 'disabled-command-hook)
-
-;;;###autoload
-(defun disabled-command-hook (&rest ignore)
-  (let (char)
-    (save-window-excursion
-     (with-output-to-temp-buffer "*Help*"
-       (let ((keys (this-command-keys)))
-	 (if (or (equal keys []) ;XEmacs kludge
-		 (eq (event-to-character (aref keys 0)) ?\r))
-	     (princ "You have invoked the disabled command ")
-	   (princ "You have typed ")
-	   (princ (key-description keys))
-	   (princ ", invoking disabled command ")))
-       (princ this-command)
-       (princ ":\n")
-       ;; Print any special message saying why the command is disabled.
-       (if (stringp (get this-command 'disabled))
-	   (princ (get this-command 'disabled)))
-       (princ (or (condition-case ()
-		      (documentation this-command)
-		    (error nil))
-		  "<< not documented >>"))
-       ;; Keep only the first paragraph of the documentation.
-       (save-excursion
-	 (set-buffer "*Help*")
-	 (goto-char (point-min))
-	 (if (search-forward "\n\n" nil t)
-	     (delete-region (1- (point)) (point-max))
-	   (goto-char (point-max))))
-       (princ "\n\n")
-       (princ "You can now type
-Space to try the command just this once,
-      but leave it disabled,
-Y to try it and enable it (no questions if you use it again),
-N to do nothing (command remains disabled).")
-       (save-excursion
-	(set-buffer standard-output)
-	(help-mode)))
-     (message "Type y, n or Space: ")
-;     (let ((cursor-in-echo-area t))
-;       (while (not (memq (setq char (downcase (read-char)))
-;			 '(?  ?y ?n)))
-;	 (ding)
-;	 (message "Please type y, n or Space: "))))
-     ;; XEmacs version
-     (let ((cursor-in-echo-area t)
-	   (inhibit-quit t)
-	   event)
-       (while (null char)
-	 (if (progn
-	       (setq event (next-command-event))
-	       (prog1
-		   (or quit-flag (eq 'keyboard-quit (key-binding event)))
-		 (setq quit-flag nil)))
-	     (progn
-	       (setq quit-flag nil)
-	       (signal 'quit '())))
-	 (let* ((key (and (key-press-event-p event) (event-key event)))
-		(rchar (and key (event-to-character event))))
-	   (if rchar (setq rchar (downcase rchar)))
-	   (cond ((eq rchar ?y)
-		  (setq char rchar))
-		 ((eq rchar ?n)
-		  (setq char rchar))
-		 ((eq rchar ? )
-		  (setq char rchar))
-		 (t
-		  (ding nil 'y-or-n-p)
-		  (discard-input)
-		  (message "Please type y, n or Space: ")))))))
-    (message nil)
-    (if (= char ?y)
-	(if (and user-init-file
-		 (not (string= "" user-init-file))
-		 (y-or-n-p "Enable command for future editing sessions also? "))
-	    (enable-command this-command)
-	  (put this-command 'disabled nil)))
-    (if (/= char ?n)
-	(call-interactively this-command))))
-
-;;;###autoload
-(defun enable-command (command)
-  "Allow COMMAND to be executed without special confirmation from now on.
-The user's `custom-file' is altered so that this will apply
-to future sessions."
-  (interactive "CEnable command: ")
-  (put command 'disabled nil)
-  (save-excursion
-   (set-buffer (find-file-noselect
-		(substitute-in-file-name custom-file)))
-   (goto-char (point-min))
-   (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
-       (delete-region
-	(progn (beginning-of-line) (point))
-	(progn (forward-line 1) (point))))
-   ;; Explicitly enable, in case this command is disabled by default
-   ;; or in case the code we deleted was actually a comment.
-   (goto-char (point-max))
-   (or (bolp) (insert "\n"))
-   (insert "(put '" (symbol-name command) " 'disabled nil)\n")
-   (save-buffer)))
-
-;;;###autoload
-(defun disable-command (command)
-  "Require special confirmation to execute COMMAND from now on.
-The user's `custom-file' is altered so that this will apply
-to future sessions."
-  (interactive "CDisable command: ")
-  (if (not (commandp command))
-      (error "Invalid command name `%s'" command))
-  (put command 'disabled t)
-  (save-excursion
-   (set-buffer (find-file-noselect
-		(substitute-in-file-name custom-file)))
-   (goto-char (point-min))
-   (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
-       (delete-region
-	(progn (beginning-of-line) (point))
-	(progn (forward-line 1) (point))))
-   (goto-char (point-max))
-   (or (bolp) (insert "\n"))
-   (insert "(put '" (symbol-name command) " 'disabled t)\n")
-   (save-buffer)))
-
-(provide 'novice)
-
-;;; novice.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/outline.el b/xemacs-packages/lisp/xemacs-base/outline.el
deleted file mode 100644
index dd668e78..00000000
--- a/xemacs-packages/lisp/xemacs-base/outline.el
+++ /dev/null
@@ -1,649 +0,0 @@
-;;; outline.el --- outline mode commands for Emacs
-
-;; Copyright (C) 1986, 1993, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: XEmacs Development Team
-;; Keywords: outlines
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; This package is a major mode for editing outline-format documents.
-;; An outline can be `abstracted' to show headers at any given level,
-;; with all stuff below hidden.  See the Emacs manual for details.
-
-;;; Code:
-
-;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
-  
-(defvar outline-regexp nil
-  "*Regular expression to match the beginning of a heading.
-Any line whose beginning matches this regexp is considered to start a heading.
-The recommended way to set this is with a Local Variables: list
-in the file it applies to.  See also outline-heading-end-regexp.")
-
-;; Can't initialize this in the defvar above -- some major modes have
-;; already assigned a local value to it.
-(or (default-value 'outline-regexp)
-    (setq-default outline-regexp "[*\^L]+"))
-  
-;; XEmacs change
-(defvar outline-heading-end-regexp (purecopy "[\n\^M]")
-  "*Regular expression to match the end of a heading line.
-You can assume that point is at the beginning of a heading when this
-regexp is searched for.  The heading ends at the end of the match.
-The recommended way to set this is with a \"Local Variables:\" list
-in the file it applies to.")
-
-;; XEmacs:  There is no point in doing this differently now. -sb
-(defvar outline-mode-prefix-map nil)
-
-(if outline-mode-prefix-map
-    nil
-  (setq outline-mode-prefix-map (make-sparse-keymap))
-  (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading)
-  (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading)
-  (define-key outline-mode-prefix-map "\C-i" 'show-children)
-  (define-key outline-mode-prefix-map "\C-s" 'show-subtree)
-  (define-key outline-mode-prefix-map "\C-d" 'hide-subtree)
-  (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading)
-  (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level)
-  (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level)
-  (define-key outline-mode-prefix-map "\C-t" 'hide-body)
-  (define-key outline-mode-prefix-map "\C-a" 'show-all)
-  (define-key outline-mode-prefix-map "\C-c" 'hide-entry)
-  (define-key outline-mode-prefix-map "\C-e" 'show-entry)
-  (define-key outline-mode-prefix-map "\C-l" 'hide-leaves)
-  (define-key outline-mode-prefix-map "\C-k" 'show-branches)
-  (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels)
-  (define-key outline-mode-prefix-map "\C-o" 'hide-other))
-
-(defvar outline-mode-menu-bar-map nil)
-(if outline-mode-menu-bar-map
-    nil
-  (setq outline-mode-menu-bar-map (make-sparse-keymap))
-
-  (define-key outline-mode-menu-bar-map [hide]
-    (cons "Hide" (make-sparse-keymap "Hide")))
-
-  (define-key outline-mode-menu-bar-map [hide hide-other]
-    '("Hide Other" . hide-other))
-  (define-key outline-mode-menu-bar-map [hide hide-sublevels]
-    '("Hide Sublevels" . hide-sublevels))
-  (define-key outline-mode-menu-bar-map [hide hide-subtree]
-    '("Hide Subtree" . hide-subtree))
-  (define-key outline-mode-menu-bar-map [hide hide-entry]
-    '("Hide Entry" . hide-entry))
-  (define-key outline-mode-menu-bar-map [hide hide-body]
-    '("Hide Body" . hide-body))
-  (define-key outline-mode-menu-bar-map [hide hide-leaves]
-    '("Hide Leaves" . hide-leaves))
-
-  (define-key outline-mode-menu-bar-map [show]
-    (cons "Show" (make-sparse-keymap "Show")))
-
-  (define-key outline-mode-menu-bar-map [show show-subtree]
-    '("Show Subtree" . show-subtree))
-  (define-key outline-mode-menu-bar-map [show show-children]
-    '("Show Children" . show-children))
-  (define-key outline-mode-menu-bar-map [show show-branches]
-    '("Show Branches" . show-branches))
-  (define-key outline-mode-menu-bar-map [show show-entry]
-    '("Show Entry" . show-entry))
-  (define-key outline-mode-menu-bar-map [show show-all]
-    '("Show All" . show-all))
-
-  (define-key outline-mode-menu-bar-map [headings]
-    (cons "Headings" (make-sparse-keymap "Headings")))
-
-  (define-key outline-mode-menu-bar-map [headings outline-backward-same-level]
-    '("Previous Same Level" . outline-backward-same-level))
-  (define-key outline-mode-menu-bar-map [headings outline-forward-same-level]
-    '("Next Same Level" . outline-forward-same-level))
-  (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading]
-    '("Previous" . outline-previous-visible-heading))
-  (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading]
-    '("Next" . outline-next-visible-heading))
-  (define-key outline-mode-menu-bar-map [headings outline-up-heading]
-    '("Up" . outline-up-heading)))
-
-(defvar outline-mode-map nil "")
-
-(if outline-mode-map
-    nil
-  ;; XEmacs change
-  ;(setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
-  (setq outline-mode-map (make-sparse-keymap 'text-mode-map))
-  (define-key outline-mode-map "\C-c" outline-mode-prefix-map)
-  (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map))
-
-;;; #+XEmacs
-(defvar outline-mode-menu
-  ;; This is the RB menu which also makes 3 menus in the menubar (like
-  ;; FSF rather than because it's good)
-  '("Outline"
-    ("Headings"
-     ["Up" outline-up-heading t]
-     ["Next" outline-next-visible-heading t]
-     ["Previous" outline-previous-visible-heading t]
-     ["Next Same Level" outline-forward-same-level t]
-     ["Previous Same Level" outline-backward-same-level t])
-    ("Show"
-     ["Show All" show-all t]
-     ["Show Entry" show-entry t]
-     ["Show Branches" show-branches t]
-     ["Show Children" show-children t]
-     ["Show Subtree" show-subtree t])
-    ("Hide"
-     ["Hide Leaves" hide-leaves t]
-     ["Hide Body" hide-body t]
-     ["Hide Entry" hide-entry t]
-     ["Hide Subtree" hide-subtree t]
-     ["Hide Other" hide-other t]
-     ["Hide Sublevels" hide-sublevels t])))
-
-;;; #+XEmacs
-(defun outline-mode-menu ()
-  (interactive)
-  (popup-menu outline-mode-menu))
-  
-;;; #+XEmacs
-;;; ?? Is this OK & if so should it be in minor mode too?
-(define-key outline-mode-map [button3] 'outline-mode-menu)
-
-;;; #+XEmacs
-(defun outline-install-menubar (&optional remove)
-  ;; install or remove the outline menus
-  ;; This is a nop if menubars aren't available
-  (when (and (featurep 'menubar) ; XEmacs
-	     current-menubar)
-    (let ((menus (cdr outline-mode-menu)) path)
-      (and (not remove)
-	   (set-buffer-menubar (copy-sequence current-menubar)))
-      (while menus
-	(setq path (list (car (car menus))))
-	(if (and remove (find-menu-item current-menubar path))
-	    (delete-menu-item path)
-	  (or (car (find-menu-item current-menubar path))
-	      (add-menu nil (car (car menus)) (cdr (car menus)) nil)))
-	(setq menus (cdr menus))))))
-
-;;;###autoload
-(defvar outline-minor-mode nil
-  "Non-nil if using Outline mode as a minor mode of some other mode.")
-;;;###autoload
-(make-variable-buffer-local 'outline-minor-mode)
-;;;###autoload
-(put 'outline-minor-mode 'permanent-local t)
-;(or (assq 'outline-minor-mode minor-mode-alist)
-;    (setq minor-mode-alist (append minor-mode-alist
-;				   (list '(outline-minor-mode " Outl")))))
-;; XEmacs: do it right.
-;;;###autoload
-(add-minor-mode 'outline-minor-mode " Outl")
-
-(defvar outline-font-lock-keywords
-  '(;; Highlight headings according to the level.
-    ("^\\(\\*+\\)[ \t]*\\(.+\\)?[ \t]*$"
-     (1 font-lock-string-face)
-     (2 (let ((len (- (match-end 1) (match-beginning 1))))
-	  (or (cdr (assq len '((1 . font-lock-function-name-face)
-			       (2 . font-lock-keyword-face)
-			       (3 . font-lock-comment-face))))
-	      font-lock-variable-name-face))
-	nil t))
-    ;; Highlight citations of the form [1] and [Mar94].
-    ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))
-  "Additional expressions to highlight in Outline mode.")
-
-;;; #+XEmacs
-(defvar outline-mode-hook nil
-  "Hook to run when entering outline-mode.")
-
-;;;###autoload
-(defun outline-mode ()
-  "Set major mode for editing outlines with selective display.
-Headings are lines which start with asterisks: one for major headings,
-two for subheadings, etc.  Lines not starting with asterisks are body lines. 
-
-Body text or subheadings under a heading can be made temporarily
-invisible, or visible again.  Invisible lines are attached to the end 
-of the heading, so they move with it, if the line is killed and yanked
-back.  A heading with text hidden under it is marked with an ellipsis (...).
-
-Commands:\\
-\\[outline-next-visible-heading]   outline-next-visible-heading      move by visible headings
-\\[outline-previous-visible-heading]   outline-previous-visible-heading
-\\[outline-forward-same-level]   outline-forward-same-level        similar but skip subheadings
-\\[outline-backward-same-level]   outline-backward-same-level
-\\[outline-up-heading]   outline-up-heading		    move from subheading to heading
-
-\\[hide-body]	make all text invisible (not headings).
-\\[show-all]	make everything in buffer visible.
-
-The remaining commands are used when point is on a heading line.
-They apply to some of the body or subheadings of that heading.
-\\[hide-subtree]   hide-subtree	make body and subheadings invisible.
-\\[show-subtree]   show-subtree	make body and subheadings visible.
-\\[show-children]   show-children	make direct subheadings visible.
-		 No effect on body, or subheadings 2 or more levels down.
-		 With arg N, affects subheadings N levels down.
-\\[hide-entry]	   make immediately following body invisible.
-\\[show-entry]	   make it visible.
-\\[hide-leaves]	   make body under heading and under its subheadings invisible.
-		     The subheadings remain visible.
-\\[show-branches]  make all subheadings at all levels visible.
-
-The variable `outline-regexp' can be changed to control what is a heading.
-A line is a heading if `outline-regexp' matches something at the
-beginning of the line.  The longer the match, the deeper the level.
-
-Turning on outline mode calls the value of `text-mode-hook' and then of
-`outline-mode-hook', if they are non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (setq selective-display t)
-  (use-local-map outline-mode-map)
-  (setq mode-name "Outline")
-  (setq major-mode 'outline-mode)
-  (define-abbrev-table 'text-mode-abbrev-table ())
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (set-syntax-table text-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat paragraph-start "\\|\\("
-				outline-regexp "\\)"))
-  ;; Inhibit auto-filling of header lines.
-  (make-local-variable 'auto-fill-inhibit-regexp)
-  (setq auto-fill-inhibit-regexp outline-regexp)
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate (concat paragraph-separate "\\|\\("
-				   outline-regexp "\\)"))
-  ;; #+XEmacs
-  (outline-install-menubar)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(outline-font-lock-keywords t))
-  (make-local-variable 'change-major-mode-hook)
-  (add-hook 'change-major-mode-hook 'show-all)
-  (run-hooks 'text-mode-hook 'outline-mode-hook))
-
-(defvar outline-minor-mode-prefix "\C-c@"
-  "*Prefix key to use for Outline commands in Outline minor mode.
-The value of this variable is checked as part of loading Outline mode.
-After that, changing the prefix key requires manipulating keymaps.")
-
-(defvar outline-minor-mode-map nil)
-(if outline-minor-mode-map
-    nil
-  (setq outline-minor-mode-map (make-sparse-keymap))
-  (define-key outline-minor-mode-map [menu-bar]
-    outline-mode-menu-bar-map)
-  (define-key outline-minor-mode-map outline-minor-mode-prefix
-    outline-mode-prefix-map))
-
-(or (assq 'outline-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons (cons 'outline-minor-mode outline-minor-mode-map)
-		minor-mode-map-alist)))
-
-;;;###autoload
-(defun outline-minor-mode (&optional arg)
-  "Toggle Outline minor mode.
-With arg, turn Outline minor mode on if arg is positive, off otherwise.
-See the command `outline-mode' for more information on this mode."
-  (interactive "P")
-  (setq outline-minor-mode
-	(if (null arg) (not outline-minor-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (if outline-minor-mode
-      (progn
-	(setq selective-display t)
-	;; #+XEmacs
-	(outline-install-menubar)
-	(run-hooks 'outline-minor-mode-hook))
-    (setq selective-display nil))
-  ;; When turning off outline mode, get rid of any ^M's.
-  (unless outline-minor-mode
-    (outline-flag-region (point-min) (point-max) ?\n)
-    ;; XEmacs change
-    (set-buffer-modified-p (buffer-modified-p))
-    ;; #+XEmacs
-    (outline-install-menubar 'remove))
-  ;; XEmacs change
-  (redraw-modeline))
-
-(defvar outline-level 'outline-level
-  "Function of no args to compute a header's nesting level in an outline.
-It can assume point is at the beginning of a header line.")
-
-;; This used to count columns rather than characters, but that made ^L
-;; appear to be at level 2 instead of 1.  Columns would be better for
-;; tab handling, but the default regexp doesn't use tabs, and anyone
-;; who changes the regexp can also redefine the outline-level variable
-;; as appropriate.
-(defun outline-level ()
-  "Return the depth to which a statement is nested in the outline.
-Point must be at the beginning of a header line.  This is actually
-the number of characters that `outline-regexp' matches."
-  (save-excursion
-    (looking-at outline-regexp)
-    (- (match-end 0) (match-beginning 0))))
-
-(defun outline-next-preface ()
-  "Skip forward to just before the next heading line.
-If there's no following heading line, stop before the newline
-at the end of the buffer."
-  (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
-			 nil 'move)
-      (goto-char (match-beginning 0)))
-  (if (memq (preceding-char) '(?\n ?\^M))
-      (forward-char -1)))
-
-(defun outline-next-heading ()
-  "Move to the next (possibly invisible) heading line."
-  (interactive)
-  (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
-			 nil 'move)
-      (goto-char (1+ (match-beginning 0)))))
-
-(defun outline-back-to-heading ()
-  "Move to previous heading line, or beg of this line if it's a heading.
-Only visible heading lines are considered."
-  (beginning-of-line)
-  (or (outline-on-heading-p)
-      (re-search-backward (concat "^\\(" outline-regexp "\\)") nil t)
-      (error "before first heading")))
-
-(defun outline-on-heading-p ()
-  "Return t if point is on a (visible) heading line."
-  (save-excursion
-    (beginning-of-line)
-    (and (bolp)
-	 (looking-at outline-regexp))))
-
-(defun outline-end-of-heading ()
-  (if (re-search-forward outline-heading-end-regexp nil 'move)
-      (forward-char -1)))
-
-(defun outline-next-visible-heading (arg)
-  "Move to the next visible heading line.
-With argument, repeats or can move backward if negative.
-A heading line is one that starts with a `*' (or that
-`outline-regexp' matches)."
-  (interactive "p")
-  (if (< arg 0)
-      (beginning-of-line)
-    (end-of-line))
-  (or (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t arg)
-      (error ""))
-  (beginning-of-line))
-
-(defun outline-previous-visible-heading (arg)
-  "Move to the previous heading line.
-With argument, repeats or can move forward if negative.
-A heading line is one that starts with a `*' (or that
-`outline-regexp' matches)."
-  (interactive "p")
-  (outline-next-visible-heading (- arg)))
-
-(defun outline-flag-region (from to flag)
-  "Hides or shows lines from FROM to TO, according to FLAG.
-If FLAG is `\\n' (newline character) then text is shown,
-while if FLAG is `\\^M' (control-M) the text is hidden."
-  (let (buffer-read-only)
-    (subst-char-in-region from to
-			  (if (= flag ?\n) ?\^M ?\n)
-			  flag t)))
-
-(defun hide-entry ()
-  "Hide the body directly following this heading."
-  (interactive)
-  (outline-back-to-heading)
-  (outline-end-of-heading)
-  (save-excursion
-   (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
-
-(defun show-entry ()
-  "Show the body directly following this heading."
-  (interactive)
-  (save-excursion
-   (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
-
-(defun hide-body ()
-  "Hide all of buffer except headings."
-  (interactive)
-  (hide-region-body (point-min) (point-max)))
-
-(defun hide-region-body (start end)
-  "Hide all body lines in the region, but not headings."
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      (if (outline-on-heading-p)
-	  (outline-end-of-heading))
-      (while (not (eobp))
-	(outline-flag-region (point)
-			     (progn (outline-next-preface) (point)) ?\^M)
-	(if (not (eobp))
-	    (progn
-	      (forward-char
-	       (if (looking-at "[\n\^M][\n\^M]")
-		   2 1))
-	      (outline-end-of-heading)))))))
-
-(defun show-all ()
-  "Show all of the text in the buffer."
-  (interactive)
-  (outline-flag-region (point-min) (point-max) ?\n))
-
-(defun hide-subtree ()
-  "Hide everything after this heading at deeper levels."
-  (interactive)
-  (outline-flag-subtree ?\^M))
-
-(defun hide-leaves ()
-  "Hide all body after this heading at deeper levels."
-  (interactive)
-  (outline-back-to-heading)
-  (outline-end-of-heading)
-  (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
-
-(defun show-subtree ()
-  "Show everything after this heading at deeper levels."
-  (interactive)
-  (outline-flag-subtree ?\n))
-
-(defun hide-sublevels (levels)
-  "Hide everything but the top LEVELS levels of headers, in whole buffer."
-  (interactive "p")
-  (if (< levels 1)
-      (error "Must keep at least one level of headers"))
-  (setq levels (1- levels))
-  (save-excursion
-    (goto-char (point-min))
-    ;; Keep advancing to the next top-level heading.
-    (while (or (and (bobp) (outline-on-heading-p))
-	       (outline-next-heading))
-      (let ((end (save-excursion (outline-end-of-subtree) (point))))
-	;; Hide everything under that.
-	(outline-flag-region (point) end ?\^M)
-	;; Show the first LEVELS levels under that.
-	(if (> levels 0)
-	    (show-children levels))
-	;; Move to the next, since we already found it.
-	(goto-char end)))))
-
-(defun hide-other ()
-  "Hide everything except for the current body and the parent headings."
-  (interactive)
-  (hide-sublevels 1)
-  (let ((last (point))
-	(pos (point)))
-    (while (save-excursion
-	     (and (re-search-backward "[\n\r]" nil t)
-		  (eq (following-char) ?\r)))
-      (save-excursion
-	(beginning-of-line)
-	(if (eq last (point))
-	    (progn
-	      (outline-next-heading)
-	      (outline-flag-region last (point) ?\n))
-	  (show-children)
-	  (setq last (point)))))))
-
-(defun outline-flag-subtree (flag)
-  (save-excursion
-    (outline-back-to-heading)
-    (outline-end-of-heading)
-    (outline-flag-region (point)
-			  (progn (outline-end-of-subtree) (point))
-			  flag)))
-
-(defun outline-end-of-subtree ()
-  (outline-back-to-heading)
-  (let ((opoint (point))
-	(first t)
-	(level (funcall outline-level)))
-    (while (and (not (eobp))
-		(or first (> (funcall outline-level) level)))
-      (setq first nil)
-      (outline-next-heading))
-    (if (memq (preceding-char) '(?\n ?\^M))
-	(progn
-	  ;; Go to end of line before heading
-	  (forward-char -1)
-	  (if (memq (preceding-char) '(?\n ?\^M))
-	      ;; leave blank line before heading
-	      (forward-char -1))))))
-
-(defun show-branches ()
-  "Show all subheadings of this heading, but not their bodies."
-  (interactive)
-  (show-children 1000))
-
-(defun show-children (&optional level)
-  "Show all direct subheadings of this heading.
-Prefix arg LEVEL is how many levels below the current level should be shown.
-Default is enough to cause the following heading to appear."
-  (interactive "P")
-  (setq level
-	(if level (prefix-numeric-value level)
-	  (save-excursion
-	    (outline-back-to-heading)
-	    (let ((start-level (funcall outline-level)))
-	      (outline-next-heading)
-	      (if (eobp)
-		  1
-		(max 1 (- (funcall outline-level) start-level)))))))
-  (save-excursion
-    (save-restriction
-      (outline-back-to-heading)
-      (setq level (+ level (funcall outline-level)))
-      (narrow-to-region (point)
-			(progn (outline-end-of-subtree)
-			       (if (eobp) (point-max) (1+ (point)))))
-      (goto-char (point-min))
-      (while (and (not (eobp))
-		  (progn
-		    (outline-next-heading)
-		    (not (eobp))))
-	(if (<= (funcall outline-level) level)
-	    (save-excursion
-	      (outline-flag-region (save-excursion
-				     (forward-char -1)
-				     (if (memq (preceding-char) '(?\n ?\^M))
-					 (forward-char -1))
-				     (point))
-				   (progn (outline-end-of-heading) (point))
-				   ?\n)))))))
-
-(defun outline-up-heading (arg)
-  "Move to the heading line of which the present line is a subheading.
-With argument, move up ARG levels."
-  (interactive "p")
-  (outline-back-to-heading)
-  (if (eq (funcall outline-level) 1)
-      (error ""))
-  (while (and (> (funcall outline-level) 1)
-	      (> arg 0)
-	      (not (bobp)))
-    (let ((present-level (funcall outline-level)))
-      (while (not (< (funcall outline-level) present-level))
-	(outline-previous-visible-heading 1))
-      (setq arg (- arg 1)))))
-
-(defun outline-forward-same-level (arg)
-  "Move forward to the ARG'th subheading at same level as this one.
-Stop at the first and last subheadings of a superior heading."
-  (interactive "p")
-  (outline-back-to-heading)
-  (while (> arg 0)
-    (let ((point-to-move-to (save-excursion
-			      (outline-get-next-sibling))))  
-      (if point-to-move-to
-	  (progn
-	    (goto-char point-to-move-to)
-	    (setq arg (1- arg)))
-	(progn
-	  (setq arg 0)
-	  (error ""))))))
-
-(defun outline-get-next-sibling ()
-  "Move to next heading of the same level, and return point or nil if none."
-  (let ((level (funcall outline-level)))
-    (outline-next-visible-heading 1)
-    (while (and (> (funcall outline-level) level)
-		(not (eobp)))
-      (outline-next-visible-heading 1))
-    (if (< (funcall outline-level) level)
-	nil
-      (point))))
-	
-(defun outline-backward-same-level (arg)
-  "Move backward to the ARG'th subheading at same level as this one.
-Stop at the first and last subheadings of a superior heading."
-  (interactive "p")
-  (outline-back-to-heading)
-  (while (> arg 0)
-    (let ((point-to-move-to (save-excursion
-			      (outline-get-last-sibling))))
-      (if point-to-move-to
-	  (progn
-	    (goto-char point-to-move-to)
-	    (setq arg (1- arg)))
-	(progn
-	  (setq arg 0)
-	  (error ""))))))
-
-(defun outline-get-last-sibling ()
-  "Move to next heading of the same level, and return point or nil if none."
-  (let ((level (funcall outline-level)))
-    (outline-previous-visible-heading 1)
-    (while (and (> (funcall outline-level) level)
-		(not (bobp)))
-      (outline-previous-visible-heading 1))
-    (if (< (funcall outline-level) level)
-	nil
-        (point))))
-
-(provide 'outline)
-
-;;; outline.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/passwd.el b/xemacs-packages/lisp/xemacs-base/passwd.el
deleted file mode 100644
index a73f2630..00000000
--- a/xemacs-packages/lisp/xemacs-base/passwd.el
+++ /dev/null
@@ -1,403 +0,0 @@
-;;; passwd.el --- Prompting for passwords semi-securely
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski 
-;; Maintainer: XEmacs Development Team
-;; Keywords: comm, extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Synched up with: Not in FSF
-
-;; Commentary:
-
-;;; Change Log:
-
-;;  Sun Jun 12 04:19:30 1994 by sandy on ibm550.sissa.it
-;;    Added support for password histories and (provide 'passwd)
-;;    (jwz says: this "history" thing is completely undocumented, you loser!)
-;; 2-Jan-95 (mon); 4:13 AM by jwz@jwz.org
-;;    Fixed Sandy's extreme keymap bogosity.  Made it invert the screen when
-;;    reading securely (this could be better; maybe use red text or something
-;;    instead...)
-;; 9-Jul-95 (fri); 4:55 AM by jwz@jwz.org
-;;    Made it work with XEmacs 19.12.
-;; 7-Jul-95 by cthomp@cs.uiuc.edu
-;;    Added variable to control inverting frame when keyboard grabbed
-
-;;; Code:
-
-(defgroup passwd nil
-  "Prompting for passwords semi-securely"
-  :group 'processes)
-
-
-(defcustom passwd-invert-frame-when-keyboard-grabbed (not (featurep 'infodock))
-  "*If non-nil swap the foreground and background colors of all faces.
-This is done while the keyboard is grabbed in order to give a visual
-clue that a grab is in effect."
-  :type 'boolean
-  :group 'passwd)
-
-(defcustom passwd-echo ?.
-  "*The character which should be echoed when typing a password,
-or nil, meaning echo nothing."
-  :type 'sexp
-  :group 'passwd)
-
-(defvar read-passwd-map
-  (let ((i 0)
-	(s (make-string 1 0))
-	map)
-    (cond ((fboundp 'set-keymap-parent)
-	   (setq map (make-keymap))
-	   (set-keymap-parent map minibuffer-local-map))
-	  (t  ; v18/FSFmacs compatibility
-	   (setq map (copy-keymap minibuffer-local-map))))
-    (if (fboundp 'set-keymap-name)
-	(set-keymap-name map 'read-passwd-map))
-
-    (while (< i 127)
-      (aset s 0 i)
-      (or (and (boundp 'meta-prefix-char) (eq (int-char i) meta-prefix-char))
-	  (define-key map s 'self-insert-command))
-      (setq i (1+ i)))
-
-    (define-key map "\C-g" 'keyboard-quit)
-    (define-key map "\C-h" 'delete-backward-char)
-    (define-key map "\r" 'exit-minibuffer)
-    (define-key map "\n" 'exit-minibuffer)
-    (define-key map "\C-u" 'passwd-erase-buffer)
-    (define-key map "\C-q" 'quoted-insert)
-    (define-key map "\177" 'delete-backward-char)
-    (define-key map "\M-n" 'passwd-next-history-element)
-    (define-key map "\M-p" 'passwd-previous-history-element)
-    map)
-  "Keymap used for reading passwords in the minibuffer.
-The \"bindings\" in this map are not real commands; only a limited
-number of commands are understood.  The important bindings are:
-\\
-	\\[passwd-erase-buffer]	Erase all input.
-	\\[quoted-insert]	Insert the next character literally.
-	\\[delete-backward-char]	Delete the previous character.
-	\\[exit-minibuffer]	Accept what you have typed.
-	\\[keyboard-quit]	Abort the command.
-
-All other characters insert themselves (but do not echo.)")
-
-;;; internal variables
-
-(defvar passwd-history nil)
-(defvar passwd-history-posn 0)
-
-;;;###autoload
-(defun read-passwd (prompt &optional confirm default)
-  "Prompts for a password in the minibuffer, and returns it as a string.
-If PROMPT may be a prompt string or an alist of elements 
-'\(prompt . default\).
-If optional arg CONFIRM is true, then ask the user to type the password
-again to confirm that they typed it correctly.
-If optional arg DEFAULT is provided, then it is a string to insert as
-the default choice (it is not, of course, displayed.)
-
-If running under X, the keyboard will be grabbed (with XGrabKeyboard())
-to reduce the possibility that eavesdropping is occuring.
-
-When reading a password, all keys self-insert, except for:
-\\
-	\\[read-passwd-erase-line]	Erase the entire line.
-	\\[quoted-insert]	Insert the next character literally.
-	\\[delete-backward-char]	Delete the previous character.
-	\\[exit-minibuffer]	Accept what you have typed.
-	\\[keyboard-quit]	Abort the command.
-
-The returned value is always a newly-created string.  No additional copies
-of the password remain after this function has returned.
-
-NOTE: unless great care is taken, the typed password will exist in plaintext
-form in the running image for an arbitrarily long time.  Priveleged users may
-be able to extract it from memory.  If emacs crashes, it may appear in the
-resultant core file.
-
-Some steps you can take to prevent the password from being copied around:
-
- - as soon as you are done with the returned string, destroy it with
-   (fillarray string 0).  The same goes for any default passwords
-   or password histories.
-
- - do not copy the string, as with concat or substring - if you do, be
-   sure to keep track of and destroy all copies.
-
- - do not insert the password into a buffer - if you do, be sure to 
-   overwrite the buffer text before killing it, as with the functions 
-   `passwd-erase-buffer' or `passwd-kill-buffer'.  Note that deleting
-   the text from the buffer does NOT necessarily remove the text from
-   memory.
-
- - be careful of the undo history - if you insert the password into a 
-   buffer which has undo recording turned on, the password will be 
-   copied onto the undo list, and thus recoverable.
-
- - do not pass it as an argument to a shell command - anyone will be
-   able to see it if they run `ps' at the right time.
-
-"
-  (save-excursion
-    (let ((input (get-buffer-create " *password*"))
-	  (passwd-history-posn 0)
-	  (read-passwd nil)
-	  passwd-history)
-      (if (listp prompt)
-	  (setq passwd-history prompt
-		default (cdr (car passwd-history))))
-      (if (should-use-dialog-box-p)
-	  (condition-case ()
-	      (popup-dialog-box (list 'built-in 'password
-				      default
-				      (lambda (pass)
-					(setq read-passwd pass))
-				      :prompt (or (car-safe prompt) prompt)
-				      :verify confirm))
-	    (error nil)))
-      (if read-passwd
-	  read-passwd
-	(set-buffer input)
-	(buffer-disable-undo input)
-	(use-local-map read-passwd-map)
-	(unwind-protect
-	    (progn
-	      (if (passwd-grab-keyboard)
-		  (passwd-secure-display))
-	      (read-passwd-1 input prompt nil default)
-	      (set-buffer input)
-
-	      (if (not confirm)
-		  (buffer-string)
-		(let ((ok nil)
-		      passwd)
-		  (while (not ok)
-		    (set-buffer input)
-		    (setq passwd (buffer-string))
-		    (read-passwd-1 input prompt "[Retype to confirm]")
-		    (if (passwd-compare-string-to-buffer passwd input)
-			(setq ok t)
-		      (fillarray passwd 0)
-		      (setq passwd nil)
-		      (beep)
-		      (read-passwd-1 input prompt "[Mismatch. Start over]")
-		      ))
-		  passwd)))
-	  ;; protected
-	  (passwd-ungrab-keyboard)
-	  (passwd-insecure-display)
-	  (passwd-kill-buffer input)
-	  (message "")
-          (sit-for 0)
-	  )))))
-
-
-(defun read-passwd-1 (buffer prompt &optional prompt2 default)
-  (set-buffer buffer)
-  (passwd-erase-buffer)
-  (if default (insert default))
-  (catch 'exit ; exit-minibuffer throws here
-    (while t
-      (set-buffer buffer)
-      (let* ((minibuffer-completion-table nil)
-	     (cursor-in-echo-area t)
-	     (echo-keystrokes 0)
-	     (inhibit-input-event-recording t)
-	     (key (passwd-read-key-sequence
-		   (concat (if (listp prompt)
-			       (car (nth passwd-history-posn passwd-history))
-			     prompt)
-			   prompt2
-			   (if passwd-echo
-			       (make-string (buffer-size) passwd-echo)))))
-	     (binding (key-binding key)))
-	(setq prompt2 nil)
-	(set-buffer buffer)		; just in case...
-	(if (fboundp 'event-to-character) ;; lemacs
-	    (setq last-command-event (aref key (1- (length key)))
-		  last-command-char (event-to-character last-command-event))
-	  ;; v18/FSFmacs compatibility
-	  (setq last-command-char (aref key (1- (length key)))))
-	(setq this-command binding)
-	(condition-case c
-	    (command-execute binding)
-	  (error
-	   (beep)
-	   (if (fboundp 'display-error)
-	       (display-error c t)
-	     ;; v18/FSFmacs compatibility
-	     (message (concat (or (get (car-safe c) 'error-message) "???")
-			      (if (cdr-safe c) ": ")
-			      (mapconcat 
-			       (function (lambda (x) (format "%s" x)))
-			       (cdr-safe c) ", "))))
-	   (sit-for 2)))
-	))))
-
-(defun passwd-previous-history-element (n)
-  (interactive "p")
-  (or passwd-history
-      (error "Password history is empty."))
-  (let ((l (length passwd-history)))
-    (setq passwd-history-posn
-	  (% (+ n passwd-history-posn) l))
-    (if (< passwd-history-posn 0)
-	(setq passwd-history-posn (+ passwd-history-posn l))))
-  (let ((obuff (current-buffer))) ; want to move point in passwd buffer
-    (unwind-protect
-	(progn
-	  (set-buffer " *password*")
-	  (passwd-erase-buffer)
-	  (insert (cdr (nth passwd-history-posn passwd-history))))
-      (set-buffer obuff))))
-
-(defun passwd-next-history-element (n)
-  (interactive "p")
-  (passwd-previous-history-element (- n)))
-
-(defun passwd-erase-buffer ()
-  ;; First erase the buffer, which will simply enlarge the gap.
-  ;; Then insert null characters until the gap is filled with them
-  ;; to prevent the old text from being visible in core files or kmem.
-  ;; (Actually use 3x the size of the buffer just to be safe - a longer
-  ;; passwd might have been typed and backspaced over.)
-  (interactive)
-  (widen)
-  (let ((s (* (buffer-size) 3)))
-    (erase-buffer)
-    (while (> s 0)
-      (insert ?\000)
-      (setq s (1- s)))
-    (erase-buffer)))
-
-(defun passwd-kill-buffer (buffer)
-  (save-excursion
-    (set-buffer buffer)
-    (buffer-disable-undo buffer)
-    (passwd-erase-buffer)
-    (set-buffer-modified-p nil))
-  (kill-buffer buffer))
-
-
-(defun passwd-compare-string-to-buffer (string buffer)
-  ;; same as (equal string (buffer-string)) but with no dangerous consing.
-  (save-excursion
-    (set-buffer buffer)
-    (goto-char (point-min))
-    (let ((L (length string))
-	  (i 0))
-      (if (/= L (- (point-max) (point-min)))
-	  nil
-	(while (not (eobp))
-	  (if (/= (following-char) (aref string i))
-	      (goto-char (point-max))
-	    (setq i (1+ i))
-	    (forward-char)))
-	(= (point) (+ i (point-min)))))))
-
-
-(defvar passwd-face-data nil)
-(defun passwd-secure-display ()
-  ;; Inverts the screen - used to indicate secure input, like xterm.
-  (when passwd-invert-frame-when-keyboard-grabbed
-    (setq passwd-face-data
-	  (delq nil (mapcar
-		     (lambda (face)
-		       (let ((fg (face-foreground-instance 
-				  face (selected-frame) nil 
-				  'no-fallback))
-			     (bg (face-background-instance
-				  face (selected-frame) nil
-				  'no-fallback)))
-			 (if (and fg bg)
-			     (list face fg bg)
-			   nil)))
-		     (face-list))))
-    (let ((rest passwd-face-data))
-      (while rest
-	(set-face-foreground (nth 0 (car rest)) (nth 2 (car rest)) (selected-frame))
-	(set-face-background (nth 0 (car rest)) (nth 1 (car rest)) (selected-frame))
-	(setq rest (cdr rest))))))
-
-(defun passwd-insecure-display ()
-  ;; Undoes the effect of `passwd-secure-display'.
-  (when passwd-invert-frame-when-keyboard-grabbed
-    (while passwd-face-data
-      (remove-face-property (nth 0 (car passwd-face-data))
-			    'foreground (selected-frame))
-      (remove-face-property (nth 0 (car passwd-face-data))
-			    'background (selected-frame))
-      (setq passwd-face-data (cdr passwd-face-data)))))
-
-(defun passwd-grab-keyboard ()
-  ;; It is officially time to give up on lemacs 19.10
-  ;; and just deal with device types.
-  (let ((lock-func (case (frame-type)
-		     (x
-		      'x-grab-keyboard)
-		     (gtk
-		      'gtk-grab-keyboard)
-		     (otherwise
-		      nil))))
-    (if (not lock-func)
-	;; There is nothing we can do...
-	nil
-      (if (funcall lock-func)
-	  ;; Grabbed it, hooray!
-	  t
-	(message "Unable to grab keyboard - waiting a second...")
-	(sleep-for 1)
-	(if (funcall lock-func)
-	    (progn
-	      (message "Keyboard grabbed on second try.")
-	      t)
-	  (beep)
-	  (message "WARNING: keyboard is insecure (unable to grab!)")
-	  (sleep-for 3)
-	  nil)))))
-
-(defun passwd-ungrab-keyboard ()
-  (case (frame-type)
-    (x (x-ungrab-keyboard))
-    (gtk (gtk-ungrab-keyboard))
-    (otherwise nil)))
-
-;; v18 compatibility
-(or (fboundp 'buffer-disable-undo)
-    (fset 'buffer-disable-undo 'buffer-flush-undo))
-
-;; read-key-sequence echoes the key sequence in Emacs 18.
-(defun passwd-read-key-sequence (prompt)
-  (let ((inhibit-quit t)
-	str)
-    (while (or (null str) (keymapp (key-binding str)))
-      (message prompt)
-      (setq str (concat str (char-to-string (read-char)))))
-    (setq quit-flag nil)
-    str))
-
-(or (string-match "^18" emacs-version)
-    (fset 'passwd-read-key-sequence 'read-key-sequence))
-
-(provide 'passwd)
-
-;;; passwd.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/pp.el b/xemacs-packages/lisp/xemacs-base/pp.el
deleted file mode 100644
index 07a50a93..00000000
--- a/xemacs-packages/lisp/xemacs-base/pp.el
+++ /dev/null
@@ -1,193 +0,0 @@
-;;; pp.el --- pretty printer for Emacs Lisp
-
-;; Copyright (C) 1989, 1993 Free Software Foundation, Inc.
-
-;; Author: Randal Schwartz 
-;; Maintainer: XEmacs Development Team
-;; Keywords: lisp, tools, language, extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;;; Code:
-
-(defvar pp-escape-newlines t 
-  "*Value of print-escape-newlines used by pp-* functions.")
-;; XEmacs changes
-(defvar pp-print-readably t
-  "*Value of `print-readably' used by pp-* functions.")
-
-;;;###autoload
-(defalias 'pprint 'pp)
-
-;;;###autoload
-(defun pp-to-string (object)
-  "Return a string containing the pretty-printed representation of OBJECT,
-any Lisp object.  Quoting characters are used when needed to make output
-that `read' can handle, whenever this is possible."
-  (save-excursion
-    (set-buffer (generate-new-buffer " pp-to-string"))
-    (unwind-protect
-	(progn
-	  (lisp-mode-variables t)
-	  (let ((print-escape-newlines pp-escape-newlines))
-	    (prin1 object (current-buffer)))
-	  (goto-char (point-min))
-	  (while (not (eobp))
-	    ;; (message "%06d" (- (point-max) (point)))
-	    (cond
-	     ((looking-at "\\s(\\|#\\s(")
-	      (while (looking-at "\\s(\\|#\\s(")
-		(forward-char 1)))
-	     ((and (looking-at "\\(quote[ \t]+\\)\\([^.)]\\)")
-		   (> (match-beginning 1) 1)
-		   (= ?\( (char-after (1- (match-beginning 1))))
-		   ;; Make sure this is a two-element list.
-		   (save-excursion
-		     (goto-char (match-beginning 2))
-		     (forward-sexp)
-		     ;; (looking-at "[ \t]*\)")
-		     ;; Avoid mucking with match-data; does this test work?
-		     (char-equal ?\) (char-after (point)))))
-	      ;; -1 gets the paren preceding the quote as well.
-	      (delete-region (1- (match-beginning 1)) (match-end 1))
-	      (insert "'")
-	      (forward-sexp 1)
-	      (if (looking-at "[ \t]*\)")
-		  (delete-region (match-beginning 0) (match-end 0))
-		(error "Malformed quote"))
-	      (backward-sexp 1))	      
-	     ((condition-case err-var
-		  (prog1 t (down-list 1))
-		(error nil))
-	      (backward-char 1)
-	      (skip-chars-backward " \t")
-	      (delete-region
-	       (point)
-	       (progn (skip-chars-forward " \t") (point)))
-	      (if (not (char-equal ?' (char-after (1- (point)))))
-		  (insert ?\n)))
-	     ((condition-case err-var
-		  (prog1 t (up-list 1))
-		(error nil))
-	      (while (looking-at "\\s)")
-		(forward-char 1))
-	      (skip-chars-backward " \t")
-	      (delete-region
-	       (point)
-	       (progn (skip-chars-forward " \t") (point)))
-	      (if (not (char-equal ?' (char-after (1- (point)))))
-		  (insert ?\n)))
-	     (t (goto-char (point-max)))))
-	  (goto-char (point-min))
-	  (indent-sexp)
-	  (buffer-string))
-      (kill-buffer (current-buffer)))))
-
-;;;###autoload
-(defun pp (object &optional stream)
-  "Output the pretty-printed representation of OBJECT, any Lisp object.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see)."
-  (princ (pp-to-string object) (or stream standard-output)))
-
-;;;###autoload
-(defun pp-eval-expression (expression)
-  "Evaluate EXPRESSION and pretty-print value into a new display buffer.
-If the pretty-printed value fits on one line, the message line is used
-instead.  Value is also consed on to front of variable  values 's
-value."
-  (interactive "xPp-eval: ")
-  (setq values (cons (eval expression) values))
-  (let* ((old-show-function temp-buffer-show-function)
-	 ;; Use this function to display the buffer.
-	 ;; This function either decides not to display it at all
-	 ;; or displays it in the usual way.
-	 (temp-buffer-show-function
-	  (function
-	   (lambda (buf)
-	     (save-excursion
-	       (set-buffer buf)
-	       (goto-char (point-min))
-	       (end-of-line 1)
-	       (if (or (< (1+ (point)) (point-max))
-		       (>= (- (point) (point-min)) (frame-width)))
-		   (let ((temp-buffer-show-function old-show-function)
-			 (old-selected (selected-window))
-			 (window (display-buffer buf)))
-		     (goto-char (point-min)) ; expected by some hooks ...
-		     (make-frame-visible (window-frame window))
-		     (unwind-protect
-			 (progn
-			   (select-window window)
-			   (run-hooks 'temp-buffer-show-hook))
-		       (select-window old-selected)))
-		 (message "%s" (buffer-substring (point-min) (point)))
-		 ))))))
-    (with-output-to-temp-buffer "*Pp Eval Output*"
-      (pp (car values)))
-    (save-excursion
-      (set-buffer "*Pp Eval Output*")
-      (let (emacs-lisp-mode-hook)
-	(emacs-lisp-mode)))))
-
-;;;###autoload
-(defun pp-eval-last-sexp (arg)
-  "Run `pp-eval-expression' on sexp before point (which see).
-With argument, pretty-print output into current buffer.
-Ignores leading comment characters."
-  (interactive "P")
-  (let ((stab (syntax-table)) (pt (point)) start exp)
-    (set-syntax-table emacs-lisp-mode-syntax-table)
-    (save-excursion
-      (forward-sexp -1)
-      ;; If first line is commented, ignore all leading comments:
-      (if (save-excursion (beginning-of-line) (looking-at "[ \t]*;"))
-	  (progn
-	    (setq exp (buffer-substring (point) pt))
-	    (while (string-match "\n[ \t]*;+" exp start)
-	      (setq start (1+ (match-beginning 0))
-		    exp (concat (substring exp 0 start)
-				(substring exp (match-end 0)))))
-	    (setq exp (read exp)))
-	(setq exp (read (current-buffer)))))
-    (set-syntax-table stab)
-    (if arg
-	(insert (pp-to-string (eval exp)))
-      (pp-eval-expression exp))))
-
-;;; Test cases for quote
-;; (pp-eval-expression ''(quote quote))
-;; (pp-eval-expression ''((quote a) (quote b)))
-;; (pp-eval-expression ''('a 'b))	; same as above
-;; (pp-eval-expression ''((quote (quote quote)) (quote quote)))
-;; These do not satisfy the quote test.
-;; (pp-eval-expression ''quote)
-;; (pp-eval-expression ''(quote))
-;; (pp-eval-expression ''(quote . quote))
-;; (pp-eval-expression ''(quote a b))
-;; (pp-eval-expression ''(quotefoo))
-;; (pp-eval-expression ''(a b))
-
-(provide 'pp)				; so (require 'pp) works
-
-;;; pp.el ends here.
diff --git a/xemacs-packages/lisp/xemacs-base/regexp-opt.el b/xemacs-packages/lisp/xemacs-base/regexp-opt.el
deleted file mode 100644
index 82ad5514..00000000
--- a/xemacs-packages/lisp/xemacs-base/regexp-opt.el
+++ /dev/null
@@ -1,278 +0,0 @@
-;;; regexp-opt.el --- generate efficient regexps to match strings
-
-;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
-
-;; Author: Simon Marshall 
-;; Maintainer: FSF
-;; Keywords: strings, regexps, extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: GNU Emacs 21.3 + paren-in-char-set fix from CVS
-;;;                  revision 1.25.  Some implementation differences in
-;;;                  regexp-opt-group and regexp-opt-charset but the APIs
-;;;                  are compatible and should return compatible (if not
-;;;                  exactly the same) regexps.
-
-;;; Commentary:
-
-;; The "opt" in "regexp-opt" stands for "optim\\(?:al\\|i\\(?:se\\|ze\\)\\)".
-;;
-;; This package generates a regexp from a given list of strings (which matches
-;; one of those strings) so that the regexp generated by:
-;;
-;; (regexp-opt strings)
-;;
-;; is equivalent to, but more efficient than, the regexp generated by:
-;;
-;; (mapconcat 'regexp-quote strings "\\|")
-;;
-;; For example:
-;;
-;; (let ((strings '("cond" "if" "when" "unless" "while"
-;; 		    "let" "let*" "progn" "prog1" "prog2"
-;; 		    "save-restriction" "save-excursion" "save-window-excursion"
-;; 		    "save-current-buffer" "save-match-data"
-;; 		    "catch" "throw" "unwind-protect" "condition-case")))
-;;   (concat "(" (regexp-opt strings t) "\\>"))
-;;  => "(\\(c\\(?:atch\\|ond\\(?:ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(?:current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(?:less\\|wind-protect\\)\\|wh\\(?:en\\|ile\\)\\)\\>"
-;;
-;; Searching using the above example `regexp-opt' regexp takes approximately
-;; two-thirds of the time taken using the equivalent `mapconcat' regexp.
-
-;; Since this package was written to produce efficient regexps, not regexps
-;; efficiently, it is probably not a good idea to in-line too many calls in
-;; your code, unless you use the following trick with `eval-when-compile':
-;;
-;; (defvar definition-regexp
-;;   (eval-when-compile
-;;     (concat "^("
-;;             (regexp-opt '("defun" "defsubst" "defmacro" "defalias"
-;;                           "defvar" "defconst") t)
-;;             "\\>")))
-;;
-;; The `byte-compile' code will be as if you had defined the variable thus:
-;;
-;; (defvar definition-regexp
-;;   "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>")
-;;
-;; Note that if you use this trick for all instances of `regexp-opt' and
-;; `regexp-opt-depth' in your code, regexp-opt.el would only have to be loaded
-;; at compile time.  But note also that using this trick means that should
-;; regexp-opt.el be changed, perhaps to fix a bug or to add a feature to
-;; improve the efficiency of `regexp-opt' regexps, you would have to recompile
-;; your code for such changes to have effect in your code.
-
-;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with
-;; thanks for ideas also to Michael Ernst, Bob Glickstein, Dan Nicolaescu and
-;; Stefan Monnier.
-;; No doubt `regexp-opt' doesn't always produce optimal regexps, so code, ideas
-;; or any other information to improve things are welcome.
-;;
-;; One possible improvement would be to compile '("aa" "ab" "ba" "bb")
-;; into "[ab][ab]" rather than "a[ab]\\|b[ab]".  I'm not sure it's worth
-;; it but if someone knows how to do it without going through too many
-;; contortions, I'm all ears.
-
-;;; Code:
-
-;;;###autoload
-(defun regexp-opt (strings &optional paren)
-  "Return a regexp to match a string in STRINGS.
-Each string should be unique in STRINGS and should not contain any regexps,
-quoted or not.  If optional PAREN is non-nil, ensure that the returned regexp
-is enclosed by at least one regexp grouping construct.
-The returned regexp is typically more efficient than the equivalent regexp:
-
- (let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\")))
-   (concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close))
-
-If PAREN is `words', then the resulting regexp is additionally surrounded
-by \\=\\< and \\>."
-  (save-match-data
-    ;; Recurse on the sorted list.
-    (let* ((max-lisp-eval-depth (* 1024 1024))
-	   (completion-ignore-case nil)
-	   (words (eq paren 'words))
-	   (open (cond ((stringp paren) paren) (paren "\\(")))
-	   (sorted-strings (sort (copy-sequence strings) 'string-lessp))
-	   (re (regexp-opt-group sorted-strings open)))
-      (if words (concat "\\<" re "\\>") re))))
-
-(defconst regexp-opt-not-groupie*-re
-  (let* ((harmless-ch "[^\\\\[]")
-         (esc-pair-not-lp "\\\\[^(]")
-         (class-harmless-ch "[^][]")
-         (class-lb-harmless "[^]:]")
-         (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?")
-         (class-lb (concat "\\[\\(" class-lb-harmless
-                           "\\|" class-lb-colon-maybe-charclass "\\)"))
-         (class
-          (concat "\\[^?]?"
-                  "\\(" class-harmless-ch
-                  "\\|" class-lb "\\)*"
-                  "\\[?]"))         ; special handling for bare [ at end of re
-         (shy-lp "\\\\(\\?:"))
-    (concat "\\(" harmless-ch "\\|" esc-pair-not-lp
-            "\\|" class "\\|" shy-lp "\\)*"))
-  "Matches any part of a regular expression EXCEPT for non-shy \"\\\\(\"s")
-
-;;;###autoload
-(defun regexp-opt-depth (regexp)
-  "Return the depth of REGEXP.
-This means the number of regexp grouping constructs (parenthesised expressions)
-in REGEXP."
-  (save-match-data
-    ;; Hack to signal an error if REGEXP does not have balanced parentheses.
-    (string-match regexp "")
-    ;; Count the number of open parentheses in REGEXP.
-    (let ((count 0) start)
-      (while
-          (progn
-            (string-match regexp-opt-not-groupie*-re regexp start)
-            (setq start ( + (match-end 0) 2))  ; +2 for "\\(" after match-end.
-            (<= start (length regexp)))
-        (setq count (1+ count)))
-      count)))
-
-;;; Workhorse functions.
-
-(eval-when-compile
-  (require 'cl))
-
-(defun regexp-opt-group (strings &optional paren lax)
-  "Return a regexp to match a string in STRINGS.
-If PAREN non-nil, output regexp parentheses around returned regexp.
-If LAX non-nil, don't output parentheses if it doesn't require them.
-Merges keywords to avoid backtracking in Emacs' regexp matcher.
-
-The basic idea is to find the shortest common prefix or suffix, remove it
-and recurse.  If there is no prefix, we divide the list into two so that
-\(at least) one half will have at least a one-character common prefix.
-
-Also we delay the addition of grouping parenthesis as long as possible
-until we're sure we need them, and try to remove one-character sequences
-so we can use character sets rather than grouping parenthesis."
-  (let* ((open-group (cond ((stringp paren) paren) (paren "\\(?:") (t "")))
-	 (close-group (if paren "\\)" ""))
-	 (open-charset (if lax "" open-group))
-	 (close-charset (if lax "" close-group)))
-    (cond
-     ;;
-     ;; If there are no strings, just return the empty string.
-     ((= (length strings) 0)
-      "")
-     ;;
-     ;; If there is only one string, just return it.
-     ((= (length strings) 1)
-      (if (= (length (car strings)) 1)
-	  (concat open-charset (regexp-quote (car strings)) close-charset)
-	(concat open-group (regexp-quote (car strings)) close-group)))
-     ;;
-     ;; If there is an empty string, remove it and recurse on the rest.
-     ((= (length (car strings)) 0)
-      (concat open-charset
-	      (regexp-opt-group (cdr strings) t t) "?"
-	      close-charset))
-     ;;
-     ;; If all are one-character strings, just return a character set.
-     ((= (length strings) (apply '+ (mapcar 'length strings)))
-      (concat open-charset
-	      (regexp-opt-charset strings)
-	      close-charset))
-     ;;
-     ;; We have a list of different length strings.
-     (t
-      (let ((prefix (try-completion "" (mapcar 'list strings)))
-	    (letters (let ((completion-regexp-list '("^.$")))
-		       (all-completions "" (mapcar 'list strings)))))
-	(cond
-	 ;;
-	 ;; If there is a common prefix, remove it and recurse on the suffixes.
-	 ((> (length prefix) 0)
-	  (let* ((length (length prefix))
-		 (suffixes (mapcar (lambda (s) (substring s length)) strings)))
-	    (concat open-group
-		    (regexp-quote prefix) (regexp-opt-group suffixes t t)
-		    close-group)))
-	 ;;
-	 ;; If there are several one-character strings, remove them and recurse
-	 ;; on the rest (first so the final regexp finds the longest match).
-	 ((> (length letters) 1)
-	  (let ((rest (let ((completion-regexp-list '("^..+$")))
-			(all-completions "" (mapcar 'list strings)))))
-	    (concat open-group
-		    (regexp-opt-group rest) "\\|" (regexp-opt-charset letters)
-		    close-group)))
-	 ;;
-	 ;; Otherwise, divide the list into those that start with a particular
-	 ;; letter and those that do not, and recurse on them.
-	 (t
-	  (let* ((char (substring (car strings) 0 1))
-		 (half1 (all-completions char (mapcar 'list strings)))
-		 (half2 (nthcdr (length half1) strings)))
-	    (concat open-group
-		    (regexp-opt-group half1) "\\|" (regexp-opt-group half2)
-		    close-group)))))))))
-
-(defun regexp-opt-charset (chars)
-  ;;
-  ;; Return a regexp to match a character in CHARS.
-  ;;
-  ;; The basic idea is to find character ranges.  Also we take care in the
-  ;; position of character set meta characters in the character set regexp.
-  ;;
-  (let* ((charwidth 256)				; Yeah, right.
-	 ;; XEmacs: use bit-vectors instead of bool-vectors
-	 (charmap (make-bit-vector charwidth 0))
-	 (charset "")
-	 (bracket "") (dash "") (caret ""))
-    ;;
-    ;; Make a character map but extract character set meta characters.
-    (dolist (char (mapcar 'string-to-char chars))
-      (case char
-	(?\]
-	 (setq bracket "]"))
-	(?^
-	 (setq caret "^"))
-	(?-
-	 (setq dash "-"))
-	(otherwise
-	 ;; XEmacs: 1
-	 (aset charmap char 1))))
-    ;;
-    ;; Make a character set from the map using ranges where applicable.
-    (dotimes (char charwidth)
-      (let ((start char))
-	(while (and (< char charwidth)
-		    ;; XEmacs: (not (zerop ...))
-		    (not (zerop (aref charmap char))))
-	  (incf char))
-	(cond ((> char (+ start 3))
-	       (setq charset (format "%s%c-%c" charset start (1- char))))
-	      ((> char start)
-	       (setq charset (format "%s%c" charset (setq char start)))))))
-    ;;
-    ;; Make sure a caret is not first and a dash is first or last.
-    (if (and (string-equal charset "") (string-equal bracket ""))
-	(concat "[" dash caret "]")
-      (concat "[" bracket charset caret dash "]"))))
-
-(provide 'regexp-opt)
-
-;;; regexp-opt.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/regi.el b/xemacs-packages/lisp/xemacs-base/regi.el
deleted file mode 100644
index 7a1a373e..00000000
--- a/xemacs-packages/lisp/xemacs-base/regi.el
+++ /dev/null
@@ -1,259 +0,0 @@
-;;; regi.el --- REGular expression Interpreting engine
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Barry A. Warsaw, Century Computing, Inc. 
-;; Maintainer: bwarsaw@python.org
-;; Created: 24-Feb-1993
-;; Version: 1.8
-;; Keywords: extensions, matching
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;;; Code:
-
-
-(defun regi-pos (&optional position col-p)
-  "Return the character position at various buffer positions.
-Optional POSITION can be one of the following symbols:
-
-`bol'  == beginning of line
-`boi'  == beginning of indentation
-`eol'  == end of line [default]
-`bonl' == beginning of next line
-`bopl' == beginning of previous line
-
-Optional COL-P non-nil returns `current-column' instead of character position."
-  (save-excursion
-    (cond
-     ((eq position 'bol)  (beginning-of-line))
-     ((eq position 'boi)  (back-to-indentation))
-     ((eq position 'bonl) (forward-line 1))
-     ((eq position 'bopl) (forward-line -1))
-     (t (end-of-line)))
-    (if col-p (current-column) (point))))
-
-(defun regi-mapcar (predlist func &optional negate-p case-fold-search-p)
-  "Build a regi frame where each element of PREDLIST appears exactly once.
-The frame contains elements where each member of PREDLIST is
-associated with FUNC, and optionally NEGATE-P and CASE-FOLD-SEARCH-P."
-  (let (frame tail)
-    (if (or negate-p case-fold-search-p)
-	(setq tail (list negate-p)))
-    (if case-fold-search-p
-	(setq tail (append tail (list case-fold-search-p))))
-    (while predlist
-      (let ((element (list (car predlist) func)))
-	(if tail
-	    (setq element (append element tail)))
-	(setq frame (append frame (list element))
-	      predlist (cdr predlist))
-	))
-    frame))
-
-
-(defun regi-interpret (frame &optional start end)
-  "Interpret the regi frame FRAME.
-If optional START and END are supplied, they indicate the region of
-interest, and the buffer is narrowed to the beginning of the line
-containing START, and beginning of the line after the line containing
-END.  Otherwise, point and mark are not set and processing continues
-until your FUNC returns the `abort' symbol (see below).  Beware!  Not
-supplying a START or END could put you in an infinite loop.
-
-A regi frame is a list of entries of the form:
-
-     (PRED FUNC [NEGATE-P [CASE-FOLD-SEARCH]])
-
-PRED is a predicate against which each line in the region is tested,
-and if a match occurs, FUNC is `eval'd.  Point is then moved to the
-beginning of the next line, the frame is reset and checking continues.
-If a match doesn't occur, the next entry is checked against the
-current line until all entries in the frame are checked.  At this
-point, if no match occurred, the frame is reset and point is moved to
-the next line.  Checking continues until every line in the region is
-checked.  Optional NEGATE-P inverts the result of PRED before FUNC is
-called and `case-fold-search' is bound to the optional value of
-CASE-FOLD-SEARCH for the PRED check.
-
-PRED can be a string, variable, function or one of the following
-symbols: t, nil, `begin', `end', and `every'.  If PRED is a string, or
-a variable or list that evaluates to a string, it is interpreted as a
-regular expression and is matched against the current line (from the
-beginning) using `looking-at'.  If PRED does not evaluate to a string,
-it is interpreted as a binary value (nil or non-nil).
-
-PRED can also be one of the following symbols:
-
-t       -- always produces a true outcome
-`begin' -- always executes before anything else
-`end'   -- always executes after everything else
-`every' -- execute after frame is matched on a line
-
-Note that NEGATE-P and CASE-FOLD-SEARCH are meaningless if PRED is one
-of these special symbols.  Only the first occurrence of each symbol in
-a frame entry is used, the rest are ignored.
-
-Your FUNC can return values which control regi processing.  If a list
-is returned from your function, it can contain any combination of the
-following elements:
-
-the symbol `continue'
-     Tells regi to continue processing frame-entries after a match,
-     instead of resetting to the first entry and advancing to the next
-     line, as is the default behavior.  When returning this symbol,
-     you must take care not to enter an infinite loop.
-
-the symbol `abort'
-     Tells regi to terminate processing this frame.  any end
-     frame-entry is still processed.
-
-the list `(frame . NEWFRAME)'
-     Tells regi to use NEWFRAME as its current frame.  In other words,
-     your FUNC can modify the executing regi frame on the fly.
-
-the list `(step . STEP)'
-     Tells regi to move STEP number of lines forward during normal
-     processing.  By default, regi moves forward 1 line.  STEP can be
-     negative, but be careful of infinite loops.
-
-You should usually take care to explicitly return nil from your
-function if no action is to take place.  Your FUNC will always be
-`eval'ed.  The following variables will be temporarily bound to some
-useful information:
-
-`curline'
-     the current line in the buffer, as a string
-
-`curframe'
-     the full, current frame being executed
-
-`curentry'
-     the current frame entry being executed."
-
-  (save-excursion
-    (save-restriction
-      (let (begin-tag end-tag every-tag current-frame working-frame donep)
-
-	;; set up the narrowed region
-	(and start
-	     end
-	     (let* ((tstart start)
-		    (start (min start end))
-		    (end   (max start end)))
-	       (narrow-to-region
-		(progn (goto-char end) (regi-pos 'bonl))
-		(progn (goto-char start) (regi-pos 'bol)))))
-
-	;; lets find the special tags and remove them from the working
-	;; frame. note that only the last special tag is used.
-	(mapcar
-	 (function
-	  (lambda (entry)
-	    (let ((pred (car entry))
-		  (func (car (cdr entry))))
-	      (cond
-	       ((eq pred 'begin) (setq begin-tag func))
-	       ((eq pred 'end)   (setq end-tag func))
-	       ((eq pred 'every) (setq every-tag func))
-	       (t
-		(setq working-frame (append working-frame (list entry))))
-	       ) ; end-cond
-	      )))
-	 frame) ; end-mapcar
-
-	;; execute the begin entry
-	(eval begin-tag)
-
-	;; now process the frame
-	(setq current-frame working-frame)
-	(while (not (or donep (eobp)))
-	  (let* ((entry            (car current-frame))
-		 (pred             (nth 0 entry))
-		 (func             (nth 1 entry))
-		 (negate-p         (nth 2 entry))
-		 (case-fold-search (nth 3 entry))
-		 match-p)
-	    (catch 'regi-throw-top
-	      (cond
-	       ;; we are finished processing the frame for this line
-	       ((not current-frame)
-		(setq current-frame working-frame) ;reset frame
-		(forward-line 1)
-		(throw 'regi-throw-top t))
-	       ;; see if predicate evaluates to a string
-	       ((stringp (setq match-p (eval pred)))
-		(setq match-p (looking-at match-p)))
-	       ) ; end-cond
-
-	      ;; now that we've done the initial matching, check for
-	      ;; negation of match
-	      (and negate-p
-		   (setq match-p (not match-p)))
-
-	      ;; if the line matched, package up the argument list and
-	      ;; funcall the FUNC
-	      (if match-p
-		   (let* ((curline (buffer-substring
-				    (regi-pos 'bol)
-				    (regi-pos 'eol)))
-			  (curframe current-frame)
-			  (curentry entry)
-			  (result (eval func))
-			  (step (or (cdr (assq 'step result)) 1))
-			  )
-		     ;; changing frame on the fly?
-		     (if (assq 'frame result)
-			 (setq working-frame (cdr (assq 'frame result))))
-
-		     ;; continue processing current frame?
-		     (if (memq 'continue result)
-			 (setq current-frame (cdr current-frame))
-		       (forward-line step)
-		       (setq current-frame working-frame))
-
-		     ;; abort current frame?
-		     (if (memq 'abort result)
-			 (progn
-			   (setq donep t)
-			   (throw 'regi-throw-top t)))
-		     ) ; end-let
-
-		;; else if no match occurred, then process the next
-		;; frame-entry on the current line
-		(setq current-frame (cdr current-frame))
-
-		) ; end-if match-p
-	      ) ; end catch
-	    ) ; end let
-
-	  ;; after every cycle, evaluate every-tag
-	  (eval every-tag)
-	  ) ; end-while
-
-	;; now process the end entry
-	(eval end-tag)))))
-
-
-(provide 'regi)
-
-;;; regi.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/ring.el b/xemacs-packages/lisp/xemacs-base/ring.el
deleted file mode 100644
index eaa48e19..00000000
--- a/xemacs-packages/lisp/xemacs-base/ring.el
+++ /dev/null
@@ -1,172 +0,0 @@
-;;; ring.el --- handle rings of items
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Maintainer: XEmacs Development Team
-;; Keywords: extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;; This code defines a ring data structure. A ring is a
-;;     (hd-index length . vector)
-;; list.  You can insert to, remove from, and rotate a ring.  When the ring
-;; fills up, insertions cause the oldest elts to be quietly dropped.
-;;
-;; In ring-ref, 0 is the index of the newest element.  Higher indexes
-;; correspond to older elements; when the index equals the ring length,
-;; it wraps to the newest element again.
-;;
-;; hd-index = vector index of the oldest ring item.
-;;         Newer items follow this item; at the end of the vector,
-;;         they wrap around to the start of the vector.
-;; length = number of items currently in the ring.
-;;         This never exceeds the length of the vector itself.
-;;
-;; These functions are used by the input history mechanism, but they can
-;; be used for other purposes as well.
-
-;;; Code:
-
-;;; User Functions:
-
-;; XEmacs change
-;;;###autoload
-(defun ringp (x) 
-  "Returns t if X is a ring; nil otherwise."
-  (and (consp x) (integerp (car x))
-       (consp (cdr x)) (integerp (car (cdr x)))
-       (vectorp (cdr (cdr x)))))
-
-;; XEmacs change
-;;;###autoload
-(define-compatible-function-alias 'ring-p 'ringp)
-
-;;;###autoload
-(defun make-ring (size)
-  "Make a ring that can contain SIZE elements."
-  (cons 0 (cons 0 (make-vector size nil))))
-
-(defun ring-insert-at-beginning (ring item)
-  "Add to RING the item ITEM.  Add it at the front, as the oldest item."
-  (let* ((vec (cdr (cdr ring)))
-         (veclen (length vec))
-         (hd (car ring))
-         (ln (car (cdr ring))))
-    (setq ln (min veclen (1+ ln))
-          hd (ring-minus1 hd veclen))
-    (aset vec hd item)
-    (setcar ring hd)
-    (setcar (cdr ring) ln)))
-
-(defun ring-plus1 (index veclen)
-  "Returns INDEX+1, with wraparound."
-  (let ((new-index (+ index 1)))
-    (if (= new-index veclen) 0 new-index)))
-
-(defun ring-minus1 (index veclen)
-  "Returns INDEX-1, with wraparound."
-  (- (if (= 0 index) veclen index) 1))
-
-(defun ring-length (ring)
-  "Returns the number of elements in the RING."
-  (car (cdr ring)))
-
-(defun ring-index (index head ringlen veclen)
-  "Converts nominal ring index INDEX to an internal index.
-The internal index refers to the items ordered from newest to oldest.
-HEAD is the index of the oldest element in the ring.
-RINGLEN is the number of elements currently in the ring.
-VECLEN is the size of the vector in the ring."
-  (setq index (mod index ringlen))
-  (mod (1- (+ head (- ringlen index))) veclen))
-
-(defun ring-empty-p (ring)
-  "Returns t if RING is empty; nil otherwise."
-  (= 0 (car (cdr ring))))
-
-(defun ring-size (ring)
-  "Returns the size of RING, the maximum number of elements it can contain."
-  (length (cdr (cdr ring))))
-
-(defun ring-copy (ring)
-  "Returns a copy of RING."
-  (let* ((vec (cdr (cdr ring)))
-	 (hd  (car ring))
-	 (ln  (car (cdr ring))))
-    (cons hd (cons ln (copy-sequence vec)))))
-
-(defun ring-insert (ring item)
-  "Insert onto ring RING the item ITEM, as the newest (last) item.
-If the ring is full, dump the oldest item to make room."
-  (let* ((vec (cdr (cdr ring)))
-         (veclen (length vec))
-         (hd (car ring))
-         (ln (car (cdr ring))))
-    (prog1
-        (aset vec (mod (+ hd ln) veclen) item)
-      (if (= ln veclen)
-          (setcar ring (ring-plus1 hd veclen))
-        (setcar (cdr ring) (1+ ln))))))
-
-(defun ring-remove (ring &optional index)
-  "Remove an item from the RING.  Return the removed item.
-If optional INDEX is nil, remove the oldest item.  If it's
-numeric, remove the element indexed."
-  (if (ring-empty-p ring)
-      (error "Ring empty")
-    (let* ((hd (car ring))
-           (ln (car (cdr ring)))
-           (vec (cdr (cdr ring)))
-           (veclen (length vec))
-           (tl (mod (1- (+ hd ln)) veclen))
-           oldelt)
-      (if (null index)
-          (setq index (1- ln)))
-      (setq index (ring-index index hd ln veclen))
-      (setq oldelt (aref vec index))
-      (while (/= index tl)
-        (aset vec index (aref vec (ring-plus1 index veclen)))
-        (setq index (ring-plus1 index veclen)))
-      (aset vec tl nil)
-      (setcar (cdr ring) (1- ln))
-      oldelt)))
-
-(defun ring-ref (ring index)
-  "Returns RING's INDEX element.
-INDEX = 0 is the most recently inserted; higher indices
-correspond to older elements.
-INDEX need not be <= the ring length; the appropriate modulo operation
-will be performed."
-  (if (ring-empty-p ring)
-      (error "Accessing an empty ring")
-    (let* ((hd (car ring))  (ln (car (cdr ring)))  (vec (cdr (cdr ring))))
-      (aref vec (ring-index index hd ln (length vec))))))
-
-(defun ring-elements (ring)
-  "Return a list of the lements of RING."
-  (mapcar #'identity (cddr ring)))
-
-;;; provide ourself:
-
-(provide 'ring)
-
-;;; ring.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/shell.el b/xemacs-packages/lisp/xemacs-base/shell.el
deleted file mode 100644
index 595b7e87..00000000
--- a/xemacs-packages/lisp/xemacs-base/shell.el
+++ /dev/null
@@ -1,1198 +0,0 @@
-;;; shell.el --- specialized comint.el for running the shell
-
-;; Copyright (C) 1988, 93, 94, 95, 96, 1997, 2000 Free Software Foundation, Inc.
-
-;; Author: Olin Shivers 
-;;	Simon Marshall 
-;; Maintainer: Pete Ware 
-;; Keywords: processes shell terminal csh tcsh bash sh
-
-;; 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.
-
-;;; Synched up with: FSF 21.3
-
-;;; Commentary:
-
-;; Please send me bug reports, bug fixes, and extensions, so that I can
-;; merge them into the master source.
-;;     - Olin Shivers (shivers@cs.cmu.edu)
-;;     - Simon Marshall (simon@gnu.org)
-
-;; This file defines a shell-in-a-buffer package (shell mode) built on
-;; top of comint mode.  This is actually cmushell with things renamed
-;; to replace its counterpart in Emacs 18.  cmushell is more
-;; featureful, robust, and uniform than the Emacs 18 version.
-
-;; Since this mode is built on top of the general command-interpreter-in-
-;; a-buffer mode (comint mode), it shares a common base functionality,
-;; and a common set of bindings, with all modes derived from comint mode.
-;; This makes these modes easier to use.
-
-;; For documentation on the functionality provided by comint mode, and
-;; the hooks available for customising it, see the file comint.el.
-;; For further information on shell mode, see the comments below.
-
-;; Needs fixin:
-;; When sending text from a source file to a subprocess, the process-mark can
-;; move off the window, so you can lose sight of the process interactions.
-;; Maybe I should ensure the process mark is in the window when I send
-;; text to the process? Switch selectable?
-
-;; YOUR .EMACS FILE
-;;=============================================================================
-;; Some suggestions for your .emacs file.
-;;
-;; ;; Define M-# to run some strange command:
-;; (eval-after-load "shell"
-;;  '(define-key shell-mode-map "\M-#" 'shells-dynamic-spell))
-
-;; Brief Command Documentation:
-;;============================================================================
-;; Comint Mode Commands: (common to shell and all comint-derived modes)
-;;
-;; m-p	    comint-previous-input    	    Cycle backwards in input history
-;; m-n	    comint-next-input  	    	    Cycle forwards
-;; m-r     comint-previous-matching-input  Previous input matching a regexp
-;; m-s     comint-next-matching-input      Next input that matches
-;; m-c-l   comint-show-output		    Show last batch of process output
-;; return  comint-send-input
-;; c-d	    comint-delchar-or-maybe-eof	    Delete char unless at end of buff.
-;; c-c c-a comint-bol                      Beginning of line; skip prompt
-;; c-c c-u comint-kill-input	    	    ^u
-;; c-c c-w backward-kill-word    	    ^w
-;; c-c c-c comint-interrupt-subjob 	    ^c
-;; c-c c-z comint-stop-subjob	    	    ^z
-;; c-c c-\ comint-quit-subjob	    	    ^\
-;; c-c c-o comint-kill-output		    Delete last batch of process output
-;; c-c c-r comint-show-output		    Show last batch of process output
-;; c-c c-h comint-dynamic-list-input-ring  List input history
-;;         send-invisible                  Read line w/o echo & send to proc
-;;         comint-continue-subjob	    Useful if you accidentally suspend
-;;					        top-level job
-;; comint-mode-hook is the comint mode hook.
-
-;; Shell Mode Commands:
-;;         shell			Fires up the shell process
-;; tab     comint-dynamic-complete	Complete filename/command/history
-;; m-?     comint-dynamic-list-filename-completions
-;;					List completions in help buffer
-;; m-c-f   shell-forward-command	Forward a shell command
-;; m-c-b   shell-backward-command	Backward a shell command
-;; 	   dirs			        Resync the buffer's dir stack
-;; 	   dirtrack-toggle		Turn dir tracking on/off
-;;         comint-strip-ctrl-m		Remove trailing ^Ms from output
-;;
-;; The shell mode hook is shell-mode-hook
-;; comint-prompt-regexp is initialised to shell-prompt-pattern, for backwards
-;; compatibility.
-
-;; Read the rest of this file for more information.
-
-;;; Code:
-
-(require 'comint)
-
-;;; Customization and Buffer Variables
-
-(defgroup shell nil
-  "Running shell from within Emacs buffers"
-  :group 'processes
-  :group 'unix)
-
-(defgroup shell-directories nil
-  "Directory support in shell mode"
-  :group 'shell)
-
-(defgroup shell-faces nil
-  "Faces in shell buffers"
-  :group 'shell)
-
-;;;###autoload
-(defcustom shell-dumb-shell-regexp "cmd\\(proxy\\)?\\.exe"
-  "Regexp to match shells that don't save their command history, and
-don't handle the backslash as a quote character.  For shells that
-match this regexp, Emacs will write out the command history when the
-shell finishes, and won't remove backslashes when it unquotes shell
-arguments."
-  :type 'regexp
-  :group 'shell)
-
-;;;###autoload
-(defcustom shell-prompt-pattern "^[^#$%>\n]*[#$%>] *"
-  "Regexp to match prompts in the inferior shell.
-Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well.
-This variable is used to initialise `comint-prompt-regexp' in the
-shell buffer.
-
-This variable is only used if the variable
-`comint-use-prompt-regexp-instead-of-fields' is non-nil.
-
-The pattern should probably not match more than one line.  If it does,
-Shell mode may become confused trying to distinguish prompt from input
-on lines which don't start with a prompt.
-
-This is a fine thing to set in your `.emacs' file."
-  :type 'regexp
-  :group 'shell)
-
-(defcustom shell-completion-fignore nil
-  "*List of suffixes to be disregarded during file/command completion.
-This variable is used to initialize `comint-completion-fignore' in the shell
-buffer.  The default is nil, for compatibility with most shells.
-Some people like (\"~\" \"#\" \"%\").
-
-This is a fine thing to set in your `.emacs' file."
-  :type '(repeat (string :tag "Suffix"))
-  :group 'shell)
-
-;jwz: turned this off; it's way too broken.
-(defvar shell-delimiter-argument-list nil ;'(?\| ?& ?< ?> ?\( ?\) ?\;
-  "List of characters to recognise as separate arguments.
-This variable is used to initialize `comint-delimiter-argument-list' in the
-shell buffer.  The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
-
-(defvar shell-file-name-chars
-  (if (memq system-type '(ms-dos windows-nt cygwin))
-      "~/A-Za-z0-9_^$!#%&{}@`'.,:()-"
-    "~/A-Za-z0-9+@:_.$#%,={}-")
-  "String of characters valid in a file name.
-This variable is used to initialize `comint-file-name-chars' in the
-shell buffer.  The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
-
-(defvar shell-file-name-quote-list
-  (if (memq system-type '(ms-dos windows-nt))
-      nil
-    (append shell-delimiter-argument-list '(?\  ?\* ?\! ?\" ?\' ?\` ?\#)))
-  "List of characters to quote when in a file name.
-This variable is used to initialize `comint-file-name-quote-list' in the
-shell buffer.  The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
-
-(defvar shell-dynamic-complete-functions
-  '(comint-replace-by-expanded-history
-    shell-dynamic-complete-environment-variable
-    shell-dynamic-complete-command
-    shell-replace-by-expanded-directory
-    comint-dynamic-complete-filename)
-  "List of functions called to perform completion.
-This variable is used to initialise `comint-dynamic-complete-functions' in the
-shell buffer.
-
-This is a fine thing to set in your `.emacs' file.")
-
-(defcustom shell-command-regexp "[^;&|\n]+"
-  "*Regexp to match a single command within a pipeline.
-This is used for directory tracking and does not do a perfect job."
-  :type 'regexp
-  :group 'shell)
-
-(defcustom shell-command-separator-regexp "[;&|\n \t]*"
-  "*Regexp to match what separates commands within a pipeline.
-This is used for directory tracking and does not do a perfect job."
-:type 'regexp
-:group 'shell)
-
-(defcustom shell-completion-execonly t
-  "*If non-nil, use executable files only for completion candidates.
-This mirrors the optional behavior of tcsh.
-
-Detecting executability of files may slow command completion considerably."
-  :type 'boolean
-  :group 'shell)
-
-(defcustom shell-multiple-shells nil
-  "*If non-nil, each time shell mode is invoked, a new shell is made"
-  :type 'boolean
-  :group 'shell)
-
-(defcustom shell-popd-regexp "popd"
-  "*Regexp to match subshell commands equivalent to popd."
-  :type 'regexp
-  :group 'shell-directories)
-
-(defcustom shell-pushd-regexp "pushd"
-  "*Regexp to match subshell commands equivalent to pushd."
-  :type 'regexp
-  :group 'shell-directories)
-
-(defcustom shell-pushd-tohome nil
-  "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd).
-This mirrors the optional behavior of tcsh."
-  :type 'boolean
-  :group 'shell-directories)
-
-(defcustom shell-pushd-dextract nil
-  "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
-This mirrors the optional behavior of tcsh."
-  :type 'boolean
-  :group 'shell-directories)
-
-(defcustom shell-pushd-dunique nil
-  "*If non-nil, make pushd only add unique directories to the stack.
-This mirrors the optional behavior of tcsh."
-  :type 'boolean
-  :group 'shell-directories)
-
-(defcustom shell-cd-regexp "cd"
-  "*Regexp to match subshell commands equivalent to cd."
-  :type 'regexp
-  :group 'shell-directories)
-
-(defcustom shell-chdrive-regexp
-  (if (memq system-type '(ms-dos windows-nt))
-      ; NetWare allows the five chars between upper and lower alphabetics.
-      "[]a-zA-Z^_`\\[\\\\]:"
-    nil)
-  "*If non-nil, is regexp used to track drive changes."
-  :type '(choice regexp
-		 (const nil))
-  :group 'shell-directories)
-
-(defcustom shell-dirtrack-verbose t
-  "*If non-nil, show the directory stack following directory change.
-This is effective only if directory tracking is enabled."
-  :type 'boolean
-  :group 'shell-directories)
-
-(defcustom shell-dirtrack-other-regexp nil
-  "*Regexp to match commands for which we call `shell-dirtrack-process-other-func'."
-  :type '(choice regexp
-		 (const nil))
-  :group 'shell-directories)
-
-;; @todo make this a full blown hook?  ?A hook which stops when a func
-;; returns t? Or nil?
-(defcustom shell-dirtrack-process-other-func nil
-  "*Function to allow external processing of directory changing commands
-which match `shell-dirtrack-other-regexp'.  This allows users to process
-arbitrary directory changing commands.  This function takes two arguments:
-  CMD  - the first word (cmd part) of the current shell command line.
-  ARG1 - the rest of the current shell command line.
-See `shell-process-popd', etc., for an example of things for which this
-function might be used.  The motivation for this was to provide a
-pushd-like command which expands ARG1 from an abbrev-table."
-  :type 'function
-  :group 'shell-directories)
-
-(defcustom explicit-shell-file-name nil
-  "*If non-nil, is file name to use for explicitly requested inferior shell."
-  :type '(choice (const :tag "None" nil) file)
-  :group 'shell)
-
-(defcustom explicit-ash-args '("-i")
-  "*List of arguments to pass to \"ash\" on startup in `shell-mode'."
-  :type '(repeat (string :tag "Argument"))
-  :group 'shell)
-
-(defcustom explicit-bash-args
-  ;; Tell bash not to use readline, except for bash 1.x which doesn't grook --noediting.
-  ;; Bash 1.x has -nolineediting, but process-send-eof cannot terminate bash if we use it.
-  (let* ((prog (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
-		   (getenv "ESHELL") shell-file-name))
-	 (name (file-name-nondirectory prog)))
-    (if (and (not purify-flag)
-	     (equal name "bash")
-	     (file-executable-p prog)
-	     (string-match "bad option"
-			   (shell-command-to-string (concat prog " --noediting"))))
-	'("-i")
-      '("--noediting" "-i")))
-  "*Args passed to inferior shell by M-x shell, if the shell is bash.
-Value is a list of strings, which may be nil."
-  :type '(repeat (string :tag "Argument"))
-  :group 'shell)
-
-(defcustom explicit-csh-args
-  (if (eq system-type 'hpux)
-      ;; -T persuades HP's csh not to think it is smarter
-      ;; than us about what terminal modes to use.
-      '("-i" "-T")
-    '("-i"))
-  "*Args passed to inferior shell by M-x shell, if the shell is csh.
-Value is a list of strings, which may be nil."
-  :type '(repeat (string :tag "Argument"))
-  :group 'shell)
-
-(defcustom explicit-ksh-args '("-i")
-  "*List of arguments to pass to \"ksh\" on startup in `shell-mode'."
-  :type '(repeat (string :tag "Argument"))
-  :group 'shell)
-
-(defcustom explicit-pdsh-args '("-i")
-  "*List of arguments to pass to \"pdksh\" on startup in `shell-mode'."
-  :type '(repeat (string :tag "Argument"))
-  :group 'shell)
-
-(defcustom explicit-tcsh-args '("-i")
-  "*List of arguments to pass to \"tcsh\" on startup in `shell-mode'."
-  :type '(repeat (string :tag "Argument"))
-  :group 'shell)
-
-(defcustom explicit-zsh-args '("-i")
-  "*List of arguments to pass to \"zsh\" on startup in `shell-mode'."
-  :type '(repeat (string :tag "Argument"))
-  :group 'shell)
-
-(defcustom shell-input-autoexpand 'history
-  "*If non-nil, expand input command history references on completion.
-This mirrors the optional behavior of tcsh (its autoexpand and histlit).
-
-If the value is `input', then the expansion is seen on input.
-If the value is `history', then the expansion is only when inserting
-into the buffer's input ring.  See also `comint-magic-space' and
-`comint-dynamic-complete'.
-
-This variable supplies a default for `comint-input-autoexpand',
-for Shell mode only."
-  :type '(choice (const :tag "off" nil)
-                (const input)
-                (const history)
-                (const :tag "on" t))
-  :group 'shell)
-
-(defvar shell-dirstack nil
-  "List of directories saved by pushd in this buffer's shell.
-Thus, this does not include the shell's current directory.")
-
-(defvar shell-dirtrackp t
-  "Non-nil in a shell buffer means directory tracking is enabled.")
-
-(defvar shell-last-dir nil
-  "Keep track of last directory for ksh `cd -' command.")
-
-(defvar shell-dirstack-query nil
-  "Command used by `shell-resync-dir' to query the shell.")
-
-(defvar shell-mode-map nil)
-(if (not shell-mode-map)
-    (let ((map (make-keymap)))
-      (set-keymap-parents map (list comint-mode-map))
-      (set-keymap-name map 'shell-mode-map)
-      (define-key map "\C-c\C-f" 'shell-forward-command)
-      (define-key map "\C-c\C-b" 'shell-backward-command)
-      (define-key map "\t" 'comint-dynamic-complete)
-      (define-key map "\M-?"  'comint-dynamic-list-filename-completions)
-      ;; XEmacs: this is a pretty common operation for those of us
-      ;; who use directory aliases ...  someone shoot me if they
-      ;; don't like this binding.  Another possibility is C-c C-s
-      ;; but that's way awkward.
-      ;; July-5-1997, Bang! -slb
-      (unless (featurep 'infodock)
-	(define-key map "\M-\C-m" 'shell-resync-dirs))
-      (setq shell-mode-map map)))
-
-(defcustom shell-mode-hook nil
-  "*Hook for customising Shell mode."
-  :type 'hook
-  :group 'shell)
-
-;; font-locking
-(defcustom shell-prompt-face 'shell-prompt-face
-  "Face for shell prompts."
-  :type 'face
-  :group 'shell-faces)
-(defcustom shell-option-face 'shell-option-face
-  "Face for command line options."
-  :type 'face
-  :group 'shell-faces)
-(defcustom shell-output-face 'shell-output-face
-  "Face for generic shell output."
-  :type 'face
-  :group 'shell-faces)
-(defcustom shell-output-2-face 'shell-output-2-face
-  "Face for grep-like output."
-  :type 'face
-  :group 'shell-faces)
-(defcustom shell-output-3-face 'shell-output-3-face
-  "Face for [N] output where N is a number."
-  :type 'face
-  :group 'shell-faces)
-
-(make-face shell-prompt-face)
-(make-face shell-option-face)
-(make-face shell-output-face)
-(make-face shell-output-2-face)
-(make-face shell-output-3-face)
-
-(defun shell-font-lock-mode-hook ()
-  (or (face-differs-from-default-p shell-prompt-face)
-      (copy-face 'font-lock-keyword-face shell-prompt-face))
-  (or (face-differs-from-default-p shell-option-face)
-      (copy-face 'font-lock-comment-face shell-option-face))
-  (or (face-differs-from-default-p shell-output-face)
-      (copy-face 'italic shell-output-face))
-  (or (face-differs-from-default-p shell-output-2-face)
-      (copy-face 'font-lock-string-face shell-output-2-face))
-  (or (face-differs-from-default-p shell-output-3-face)
-      (copy-face 'font-lock-string-face shell-output-3-face))
-  ;; we only need to do this once
-  (remove-hook 'font-lock-mode-hook 'shell-font-lock-mode-hook))
-(add-hook 'font-lock-mode-hook 'shell-font-lock-mode-hook)
-
-(defvar shell-prompt-pattern-for-font-lock nil
-  "If non-nil, pattern to use to font-lock the prompt.
-When nil, shell-prompt-pattern will be used.  Set this to a regular
-expression if you want the font-locked pattern to be different then
-the shell's prompt pattern.")
-
-(defvar shell-font-lock-keywords
-  (list '(eval . (cons (if shell-prompt-pattern-for-font-lock
-			   shell-prompt-pattern-for-font-lock
-			 shell-prompt-pattern)
-		       shell-prompt-face))
-	'("[ \t]\\([+-][^ \t\n>]+\\)" 1 shell-option-face)
-	'("^[^ \t\n]+:.*" . shell-output-2-face)
-	'("^\\[[1-9][0-9]*\\]" . shell-output-3-face)
-	'("^[^\n]+.*$" . shell-output-face))
-  "Additional expressions to highlight in Shell mode.")
-(put 'shell-mode 'font-lock-defaults '(shell-font-lock-keywords t))
-
-;;; Basic Procedures
-
-(put 'shell-mode 'mode-class 'special)
-
-(define-derived-mode shell-mode comint-mode "Shell"
-  "Major mode for interacting with an inferior shell.
-\\\\[comint-send-input] after the end of the process' output sends the text from
-    the end of process to the end of the current line.
-\\[comint-send-input] before end of process output copies the current line minus the
-    prompt to the end of the buffer and sends it (\\[comint-copy-old-input] just copies
-    the current line).
-\\[send-invisible] reads a line of text without echoing it, and sends it to
-    the shell.  This is useful for entering passwords.  Or, add the function
-    `comint-watch-for-password-prompt' to `comint-output-filter-functions'.
-
-If you want to make multiple shell buffers, rename the `*shell*' buffer
-using \\[rename-buffer] or \\[rename-uniquely] and start a new shell.
-
-If you want to make shell buffers limited in length, add the function
-`comint-truncate-buffer' to `comint-output-filter-functions'.
-
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it.
-
-`cd', `pushd' and `popd' commands given to the shell are watched by Emacs to
-keep this buffer's default directory the same as the shell's working directory.
-While directory tracking is enabled, the shell's working directory is displayed
-by \\[list-buffers] or \\[mouse-buffer-menu] in the `File' field.
-\\[dirs] queries the shell and resyncs Emacs' idea of what the current
-    directory stack is.
-\\[dirtrack-toggle] turns directory tracking on and off.
-
-\\{shell-mode-map}
-Customization: Entry to this mode runs the hooks on `comint-mode-hook' and
-`shell-mode-hook' (in that order).  Before each input, the hooks on
-`comint-input-filter-functions' are run.  After each shell output, the hooks
-on `comint-output-filter-functions' are run.
-
-Variable `shell-multiple-shells' will automatically generate a new shell each
-time it is invoked.
-
-Variables `shell-cd-regexp', `shell-chdrive-regexp', `shell-pushd-regexp'
-and `shell-popd-regexp' are used to match their respective commands,
-while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique'
-control the behavior of the relevant command.
-
-Variables `comint-completion-autolist', `comint-completion-addsuffix',
-`comint-completion-recexact' and `comint-completion-fignore' control the
-behavior of file name, command name and variable name completion.  Variable
-`shell-completion-execonly' controls the behavior of command name completion.
-Variable `shell-completion-fignore' is used to initialise the value of
-`comint-completion-fignore'.
-
-Variables `comint-input-ring-file-name' and `comint-input-autoexpand' control
-the initialisation of the input ring history, and history expansion.
-
-Variables `comint-output-filter-functions', a hook, and
-`comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
-control whether input and output cause the window to scroll to the end of the
-buffer."
-  (make-local-variable 'comint-prompt-regexp)
-  (setq comint-prompt-regexp shell-prompt-pattern)
-  (setq comint-completion-fignore shell-completion-fignore)
-  (make-local-variable 'comint-delimiter-argument-list)
-  (setq comint-delimiter-argument-list shell-delimiter-argument-list)
-  (setq comint-file-name-chars shell-file-name-chars)
-  (make-local-variable 'comint-after-partial-filename-command)
-  (setq comint-after-partial-filename-command 'shell-after-partial-filename)
-  (make-local-variable 'comint-get-current-command)
-  (setq comint-get-current-command 'shell-get-current-command)
-  (make-local-variable 'comint-dynamic-complete-command-command)
-  (setq comint-dynamic-complete-command-command 'shell-dynamic-complete-command)
-  (setq comint-file-name-quote-list shell-file-name-quote-list)
-  (setq comint-dynamic-complete-functions shell-dynamic-complete-functions)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start comint-prompt-regexp)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(shell-font-lock-keywords t))
-  (make-local-variable 'shell-dirstack)
-  (setq shell-dirstack nil)
-  (make-local-variable 'shell-last-dir)
-  (setq shell-last-dir nil)
-  (make-local-variable 'shell-dirtrackp)
-  (setq shell-dirtrackp t)
-  (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)
-  (setq comint-input-autoexpand shell-input-autoexpand)
-  ;; This is not really correct, since the shell buffer does not really
-  ;; edit this directory.  But it is useful in the buffer list and menus.
-  (make-local-variable 'list-buffers-directory)
-  (setq list-buffers-directory (expand-file-name default-directory))
-  ;; shell-dependent assignments.
-  (when (ring-empty-p comint-input-ring)
-    (let ((shell (file-name-nondirectory (car
-		   (process-command (get-buffer-process (current-buffer)))))))
-      (setq comint-input-ring-file-name
-	    (or (getenv "HISTFILE")
-		(cond ((string-equal shell "bash") "~/.bash_history")
-		      ((string-equal shell "ksh") "~/.sh_history")
-		      (t "~/.history"))))
-      (if (or (equal comint-input-ring-file-name "")
-	      (equal (file-truename comint-input-ring-file-name)
-		     (file-truename "/dev/null")))
-	  (setq comint-input-ring-file-name nil))
-      ;; Arrange to write out the input ring on exit, if the shell doesn't
-      ;; do this itself.
-      (if (and comint-input-ring-file-name
-	       (string-match shell-dumb-shell-regexp shell))
-	  (set-process-sentinel (get-buffer-process (current-buffer))
-				#'shell-write-history-on-exit))
-      (setq shell-dirstack-query
-	    (cond ((string-equal shell "sh") "pwd")
-		  ((string-equal shell "ksh") "echo $PWD ~-")
-		  (t "dirs"))))
-    (comint-read-input-ring t)
-    (shell-dirstack-message)))
-
-(defun shell-write-history-on-exit (process event)
-  "Called when the shell process is stopped.
-
-Writes the input history to a history file
-`comint-input-ring-file-name' using `comint-write-input-ring'
-and inserts a short message in the shell buffer.
-
-This function is a sentinel watching the shell interpreter process.
-Sentinels will always get the two parameters PROCESS and EVENT."
-  ;; Write history.
-  (comint-write-input-ring)
-  (let ((buf (process-buffer process)))
-    (when (buffer-live-p buf)
-      (with-current-buffer buf
-        (insert (format "\nProcess %s %s\n" process event))))))
-
-;;;###autoload
-(defun shell (&optional buffer)
-  "Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*').
-Interactively, a prefix arg means to prompt for BUFFER.
-If BUFFER exists but shell process is not running, make new shell.
-If BUFFER exists and shell process is running, just switch to BUFFER.
-Program used comes from variable `explicit-shell-file-name',
- or (if that is nil) from the ESHELL environment variable,
- or else from SHELL if there is no ESHELL,
- or if there is no SHELL then from variable `shell-file-name',
- or, if all of the above are nil, \"/bin/sh\" is used.
-If a file `~/.emacs_SHELLNAME' exists, it is given as initial input
- (Note that this may lose due to a timing error if the shell
-  discards input when it starts up.)
-The buffer is put in Shell mode, giving commands for sending input
-and controlling the subjobs of the shell.  See `shell-mode'.
-See also the variable `shell-prompt-pattern'.
-
-To specify a coding system for converting non-ASCII characters
-in the input and output to the shell, use \\[universal-coding-system-argument]
-before \\[shell].  You can also specify this with \\[set-buffer-process-coding-system]
-in the shell buffer, after you start the shell.
-The default comes from `process-coding-system-alist' and
-`default-process-coding-system'.
-
-The shell file name (sans directories) is used to make a symbol name
-such as `explicit-csh-args'.  If that symbol is a variable,
-its value is used as a list of arguments when invoking the shell.
-Otherwise, one argument `-i' is passed to the shell.
-
-\(Type \\[describe-mode] in the shell buffer for a list of commands.)"
-  (interactive
-   (list
-    (and current-prefix-arg
-	 (read-buffer "Shell buffer: " "*shell*"))))
-  (let* ((buffer-name (cond ((null buffer) "*shell*")
-			    ((stringp buffer) buffer)
-			    (t (buffer-name buffer))))
-	 (buffer (if shell-multiple-shells (generate-new-buffer buffer-name)
-		   (get-buffer-create buffer-name))))
-    ;; Pop to buffer, so that the buffer's window will be correctly set
-    ;; when we call comint (so that comint sets the COLUMNS env var properly).
-    (pop-to-buffer buffer)
-    (cond ((not (comint-check-proc buffer))
-	   (let* ((prog (or explicit-shell-file-name
-			    (getenv "ESHELL")
-			    (getenv "SHELL")
-			    shell-file-name
-			    "/bin/sh"))
-		  (name (file-name-nondirectory prog))
-		  (startfile (concat "~/.emacs_" name))
-		  (xargs-name (intern-soft (concat "explicit-" name "-args"))))
-	     (if (not (file-exists-p startfile))
-		 (setq startfile (concat "~/.emacs.d/.emacs_" name)))
-	     (setq buffer (set-buffer (apply 'make-comint-1 buffer
-					     prog
-					     (if (file-exists-p startfile)
-						 startfile)
-					     (if (and xargs-name
-						      (boundp xargs-name))
-						 (symbol-value xargs-name)
-					       '("-i")))))
-	     (shell-mode))))
-    buffer))
-
-;;; Don't do this when shell.el is loaded, only while dumping.
-;;;###autoload (add-hook 'same-window-buffer-names "*shell*")
-
-;;; Directory tracking
-;;;
-;;; This code provides the shell mode input sentinel
-;;;     SHELL-DIRECTORY-TRACKER
-;;; that tracks cd, pushd, and popd commands issued to the shell, and
-;;; changes the current directory of the shell buffer accordingly.
-;;;
-;;; This is basically a fragile hack, although it's more accurate than
-;;; the version in Emacs 18's shell.el. It has the following failings:
-;;; 1. It doesn't know about the cdpath shell variable.
-;;; 2. It cannot infallibly deal with command sequences, though it does well
-;;;    with these and with ignoring commands forked in another shell with ()s.
-;;; 3. More generally, any complex command is going to throw it. Otherwise,
-;;;    you'd have to build an entire shell interpreter in emacs lisp.  Failing
-;;;    that, there's no way to catch shell commands where cd's are buried
-;;;    inside conditional expressions, aliases, and so forth.
-;;;
-;;; The whole approach is a crock. Shell aliases mess it up. File sourcing
-;;; messes it up. You run other processes under the shell; these each have
-;;; separate working directories, and some have commands for manipulating
-;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have
-;;; commands that do *not* affect the current w.d. at all, but look like they
-;;; do (e.g., the cd command in ftp).  In shells that allow you job
-;;; control, you can switch between jobs, all having different w.d.'s. So
-;;; simply saying %3 can shift your w.d..
-;;;
-;;; The solution is to relax, not stress out about it, and settle for
-;;; a hack that works pretty well in typical circumstances. Remember
-;;; that a half-assed solution is more in keeping with the spirit of Unix,
-;;; anyway. Blech.
-;;;
-;;; One good hack not implemented here for users of programmable shells
-;;; is to program up the shell w.d. manipulation commands to output
-;;; a coded command sequence to the tty. Something like
-;;;     ESC |  |
-;;; where  is the new current working directory. Then trash the
-;;; directory tracking machinery currently used in this package, and
-;;; replace it with a process filter that watches for and strips out
-;;; these messages.
-
-(defun shell-directory-tracker (str)
-  "Tracks cd, pushd and popd commands issued to the shell.
-This function is called on each input passed to the shell.
-It watches for cd, pushd and popd commands and sets the buffer's
-default directory to track these commands.
-
-You may toggle this tracking on and off with \\[dirtrack-toggle].
-If emacs gets confused, you can resync with the shell with \\[dirs].
-
-See variables `shell-cd-regexp', `shell-chdrive-regexp', `shell-pushd-regexp',
-`shell-popd-regexp', `shell-dirtrack-other-regexp', and 
-`shell-dirtrack-process-other-func', while `shell-pushd-tohome', 
-`shell-pushd-dextract', and `shell-pushd-dunique' control the behavior of 
-the relevant command.
-
-Environment variables are expanded, see function `substitute-in-file-name'."
-  (if shell-dirtrackp
-      ;; We fail gracefully if we think the command will fail in the shell.
-      (condition-case chdir-failure
-	  (let ((start (progn (string-match
-			       (concat "^" shell-command-separator-regexp)
-			       str) ; skip whitespace
-			      (match-end 0)))
-		end cmd arg1)
-	    (while (string-match shell-command-regexp str start)
-	      (setq end (match-end 0)
-		    cmd (comint-arguments (substring str start end) 0 0)
-		    arg1 (comint-arguments (substring str start end) 1 1))
-	      (if arg1
-		  (setq arg1 (shell-unquote-argument arg1)))
-	      (cond ((string-match (concat "\\`\\(" shell-popd-regexp
-					   "\\)\\($\\|[ \t]\\)")
-				   cmd)
-		     (shell-process-popd (comint-substitute-in-file-name arg1)))
-		    ((string-match (concat "\\`\\(" shell-pushd-regexp
-					   "\\)\\($\\|[ \t]\\)")
-				   cmd)
-		     (shell-process-pushd (comint-substitute-in-file-name arg1)))
-		    ((string-match (concat "\\`\\(" shell-cd-regexp
-					   "\\)\\($\\|[ \t]\\)")
-				   cmd)
-		     (shell-process-cd (comint-substitute-in-file-name arg1)))
-		    ((and shell-chdrive-regexp
-			  (string-match (concat "\\`\\(" shell-chdrive-regexp
-						"\\)\\($\\|[ \t]\\)")
-					cmd))
-		     (shell-process-cd (comint-substitute-in-file-name cmd)))
-		    ((and shell-dirtrack-other-regexp
-			  shell-dirtrack-process-other-func
-			  (string-match (concat "\\`\\(" 
-						shell-dirtrack-other-regexp
-						"\\)\\($\\|[ \t]\\)")
-					cmd))
-		     (funcall shell-dirtrack-process-other-func
-			      ;; pass cmd so one "other-func" can handle
-			      ;; multiple commands.
-			      cmd
-			      ;; leave arg1 unchanged since we don't know
-			      ;; what `shell-dirtrack-process-other-func'
-			      ;; will want to do with it
-			      arg1)))
-	      (setq start (progn (string-match
-				  shell-command-separator-regexp str end)
-				 ;; skip again
-				 (match-end 0)))))
-	(error "Couldn't cd"))))
-
-;; Like `cd', but prepends comint-file-name-prefix to absolute names.
-(defun shell-cd-1 (dir dirstack)
-  (if shell-dirtrackp
-      (setq list-buffers-directory (file-name-as-directory
-				    (expand-file-name dir))))
-  (condition-case nil
-      (progn (if (file-name-absolute-p dir)
-                 ;;(cd-absolute (concat comint-file-name-prefix dir))
-		 (cd-absolute dir)
-	       (cd dir))
-             (setq shell-dirstack dirstack)
-             (shell-dirstack-message))
-    (file-error (message "Couldn't cd"))))
-
-(defun shell-unquote-argument (string)
-  "Remove all kinds of shell quoting from STRING."
-  (save-match-data
-    (let ((idx 0) next inside
-	  (quote-chars
-	   (if (string-match shell-dumb-shell-regexp
-			     (file-name-nondirectory
-			      (car (process-command (get-buffer-process (current-buffer))))))
-	       "['`\"]"
-	     "[\\'`\"]")))
-      (while (and (< idx (length string))
-		  (setq next (string-match quote-chars string next)))
-	(cond ((= (aref string next) ?\\)
-	       (setq string (replace-match "" nil nil string))
-	       (setq next (1+ next)))
-	      ((and inside (= (aref string next) inside))
-	       (setq string (replace-match "" nil nil string))
-	       (setq inside nil))
-	      (inside
-	       (setq next (1+ next)))
-	      (t
-	       (setq inside (aref string next))
-	       (setq string (replace-match "" nil nil string)))))
-      string)))
-
-;;; popd [+n]
-(defun shell-process-popd (arg)
-  (let ((num (or (shell-extract-num arg) 0)))
-    (cond ((and num (= num 0) shell-dirstack)
-	   (shell-cd-1 (car shell-dirstack) (cdr shell-dirstack)))
-	  ((and num (> num 0) (<= num (length shell-dirstack)))
-	   (let* ((ds (cons nil shell-dirstack))
-		  (cell (nthcdr (1- num) ds)))
-	     (rplacd cell (cdr (cdr cell)))
-	     (setq shell-dirstack (cdr ds))
-	     (shell-dirstack-message)))
-	  (t
-	   (error "Couldn't popd")))))
-
-;; Return DIR prefixed with comint-file-name-prefix as appropriate.
-(defun shell-prefixed-directory-name (dir)
-  (if (= (length comint-file-name-prefix) 0)
-      dir
-    (if (file-name-absolute-p dir)
-	;; The name is absolute, so prepend the prefix.
-	(concat comint-file-name-prefix dir)
-      ;; For relative name we assume default-directory already has the prefix.
-      (expand-file-name dir))))
-
-;;; cd [dir]
-(defun shell-process-cd (arg)
-  (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix
-						     "~"))
-		       ((string-equal "-" arg) shell-last-dir)
-		       (t (shell-prefixed-directory-name arg)))))
-    (setq shell-last-dir default-directory)
-    (shell-cd-1 new-dir shell-dirstack)))
-
-;;; pushd [+n | dir]
-(defun shell-process-pushd (arg)
-  (let ((num (shell-extract-num arg)))
-    (cond ((zerop (length arg))
-	   ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome
-	   (cond (shell-pushd-tohome
-		  (shell-process-pushd (concat comint-file-name-prefix "~")))
-		 (shell-dirstack
-		  (let ((old default-directory))
-		    (shell-cd-1 (car shell-dirstack)
-				(cons old (cdr shell-dirstack)))))
-		 (t
-		  (message "Directory stack empty."))))
-	  ((numberp num)
-	   ;; pushd +n
-	   (cond ((> num (length shell-dirstack))
-		  (message "Directory stack not that deep."))
-		 ((= num 0)
-		  (error (message "Couldn't cd")))
-		 (shell-pushd-dextract
-		  (let ((dir (nth (1- num) shell-dirstack)))
-		    (shell-process-popd arg)
-		    (shell-process-pushd default-directory)
-		    (shell-cd-1 dir shell-dirstack)))
-		 (t
-		  (let* ((ds (cons default-directory shell-dirstack))
-			 (dslen (length ds))
-			 (front (nthcdr num ds))
-			 (back (reverse (nthcdr (- dslen num) (reverse ds))))
-			 (new-ds (append front back)))
-		    (shell-cd-1 (car new-ds) (cdr new-ds))))))
-	  (t
-	   ;; pushd 
-	   (let ((old-wd default-directory))
-             (shell-cd-1 (shell-prefixed-directory-name arg)
-                         (if (or (null shell-pushd-dunique)
-                                 (not (member old-wd shell-dirstack)))
-                             (cons old-wd shell-dirstack)
-                             shell-dirstack)))))))
-
-;; If STR is of the form +n, for n>0, return n. Otherwise, nil.
-(defun shell-extract-num (str)
-  (and (string-match "^\\+[1-9][0-9]*$" str)
-       (string-to-int str)))
-
-
-(defun shell-dirtrack-toggle ()
-  "Turn directory tracking on and off in a shell buffer."
-  (interactive)
-  (if (setq shell-dirtrackp (not shell-dirtrackp))
-      (setq list-buffers-directory default-directory)
-    (setq list-buffers-directory nil))
-  (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF")))
-
-;;; For your typing convenience:
-(defalias 'dirtrack-toggle 'shell-dirtrack-toggle)
-
-(defun shell-cd (dir)
-  "Do normal `cd' to DIR, and set `list-buffers-directory'."
-  (if shell-dirtrackp
-      (setq list-buffers-directory (file-name-as-directory
-				    (expand-file-name dir))))
-  (cd dir))
-
-(defun shell-resync-dirs ()
-  "Resync the buffer's idea of the current directory stack.
-This command queries the shell with the command bound to
-`shell-dirstack-query' (default \"dirs\"), reads the next
-line output and parses it to form the new directory stack.
-DON'T issue this command unless the buffer is at a shell prompt.
-Also, note that if some other subprocess decides to do output
-immediately after the query, its output will be taken as the
-new directory stack -- you lose. If this happens, just do the
-command again."
-  (interactive)
-  (let* ((proc (get-buffer-process (current-buffer)))
-	 (pmark (process-mark proc)))
-    (goto-char pmark)
-    (insert shell-dirstack-query) (insert "\n")
-    (sit-for 0) ; force redisplay
-    (comint-send-string proc shell-dirstack-query)
-    (comint-send-string proc "\n")
-    (set-marker pmark (point))
-    (let ((pt (point))) ; wait for 1 line
-      ;; This extra newline prevents the user's pending input from spoofing us.
-      (insert "\n") (backward-char 1)
-      (while (not (looking-at ".+\n"))
-	(accept-process-output proc)
-	(goto-char pt)
-	;; kludge to cope with shells that have "stty echo" turned on.
-	;; of course this will lose if there is only one dir on the stack
-	;; and it is named "dirs"...  -jwz
-	(if (looking-at "^dirs\r?\n") (delete-region (point) (match-end 0)))
-	))
-    (goto-char pmark) (delete-char 1) ; remove the extra newline
-    ;; That's the dirlist. grab it & parse it.
-    (let* ((dl (buffer-substring (match-beginning 0) (1- (match-end 0))))
-	   (dl-len (length dl))
-	   (ds '())			; new dir stack
-	   (i 0))
-      (while (< i dl-len)
-	;; regexp = optional whitespace, (non-whitespace), optional whitespace
-	(string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
-	(setq ds (cons (concat comint-file-name-prefix
-			       (substring dl (match-beginning 1)
-					  (match-end 1)))
-		       ds))
-	(setq i (match-end 0)))
-      (let ((ds (reverse ds)))
-        (shell-cd-1 (car ds) (cdr ds))))))
-
-;;; For your typing convenience:
-(defalias 'dirs 'shell-resync-dirs)
-
-;; XEmacs addition
-(defvar shell-dirstack-message-hook nil
-  "Hook to run after a cd, pushd or popd event")
-
-;;; Show the current dirstack on the message line.
-;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo".
-;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".)
-;;; All the commands that mung the buffer's dirstack finish by calling
-;;; this guy.
-(defun shell-dirstack-message ()
-  (let* ((msg "")
-         (ds (cons default-directory shell-dirstack))
-         (home (format "^%s\\(/\\|$\\)" (regexp-quote (user-home-directory))))
-         (prefix (and comint-file-name-prefix
-		      ;; XEmacs addition: don't turn "/foo" into "foo" !!
-		      (not (= 0 (length comint-file-name-prefix)))
-                      (format "^%s\\(/\\|$\\)"
-                              (regexp-quote comint-file-name-prefix)))))
-    (while ds
-      (let ((dir (car ds)))
-	(if (string-match home dir)
-	    (setq dir (concat "~/" (substring dir (match-end 0)))))
-	;; Strip off comint-file-name-prefix if present.
-	(and prefix (string-match prefix dir)
-	     (setq dir (substring dir (match-end 0)))
-             (setcar ds dir)
-             )
-	(setq msg (concat msg dir " "))
-	(setq ds (cdr ds))))
-    (run-hooks 'shell-dirstack-message-hook)
-    (message "%s" msg)))
-
-;; This was mostly copied from shell-resync-dirs.
-(defun shell-snarf-envar (var)
-  "Return as a string the shell's value of environment variable VAR."
-  (let* ((cmd (format "printenv '%s'\n" var))
-	 (proc (get-buffer-process (current-buffer)))
-	 (pmark (process-mark proc)))
-    (goto-char pmark)
-    (insert cmd)
-    (sit-for 0)				; force redisplay
-    (comint-send-string proc cmd)
-    (set-marker pmark (point))
-    (let ((pt (point)))			; wait for 1 line
-      ;; This extra newline prevents the user's pending input from spoofing us.
-      (insert "\n") (backward-char 1)
-      (while (not (looking-at ".+\n"))
-	(accept-process-output proc)
-	(goto-char pt)))
-    (goto-char pmark) (delete-char 1)	; remove the extra newline
-    (buffer-substring (match-beginning 0) (1- (match-end 0)))))
-
-(defun shell-copy-environment-variable (variable)
-  "Copy the environment variable VARIABLE from the subshell to Emacs.
-This command reads the value of the specified environment variable
-in the shell, and sets the same environment variable in Emacs
-\(what `getenv' in Emacs would return) to that value.
-That value will affect any new subprocesses that you subsequently start
-from Emacs."
-  (interactive (list (read-envvar-name "\
-Copy Shell environment variable to Emacs: ")))
-  (setenv variable (shell-snarf-envar variable)))
-
-(defun shell-forward-command (&optional arg)
-  "Move forward across ARG shell command(s).  Does not cross lines.
-See `shell-command-regexp'."
-  (interactive "p")
-  (let ((limit (save-excursion (end-of-line nil) (point))))
-    (if (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+")
-			   limit 'move arg)
-	(skip-syntax-backward " "))))
-
-
-(defun shell-backward-command (&optional arg)
-  "Move backward across ARG shell command(s).  Does not cross lines.
-See `shell-command-regexp'."
-  (interactive "p")
-  (let ((limit (save-excursion (comint-bol nil) (point))))
-    (when (> limit (point))
-      (setq limit (line-beginning-position)))
-    (skip-syntax-backward " " limit)
-    (if (re-search-backward
-	 (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg)
-	(progn (goto-char (match-beginning 1))
-	       (skip-chars-forward ";&|")))))
-
-(defun shell-dynamic-complete-command ()
-  "Dynamically complete the command at point.
-This function is similar to `comint-dynamic-complete-filename', except that it
-searches `exec-path' (minus the trailing emacs library path) for completion
-candidates.  Note that this may not be the same as the shell's idea of the
-path.
-
-Completion is dependent on the value of `shell-completion-execonly', plus
-those that effect file completion.  See `shell-dynamic-complete-as-command'.
-
-Returns t if successful."
-  (interactive)
-  (let ((filename (comint-match-partial-filename)))
-    (if (and filename
-	     (save-match-data (not (string-match "[~/]" filename)))
-	     (eq (match-beginning 0)
-		 (save-excursion (shell-backward-command 1) (point))))
-	(prog2 (message "Completing command name...")
-	    (shell-dynamic-complete-as-command)))))
-
-
-(defun shell-dynamic-complete-as-command ()
-  "Dynamically complete at point as a command.
-See `shell-dynamic-complete-filename'.  Returns t if successful."
-  (let* ((filename (or (comint-match-partial-filename) ""))
-	 (pathnondir (file-name-nondirectory filename))
-	 (paths (cdr (reverse exec-path)))
-	 (cwd (file-name-as-directory (expand-file-name default-directory)))
-	 (ignored-extensions
-	  (and comint-completion-fignore
-	       (mapconcat (function (lambda (x) (concat (regexp-quote x) "$")))
-			  comint-completion-fignore "\\|")))
-	 (path "") (comps-in-path ()) (file "") (filepath "") (completions ()))
-    ;; Go thru each path in the search path, finding completions.
-    (while paths
-      (setq path (file-name-as-directory (comint-directory (or (car paths) ".")))
-	    comps-in-path (and (file-accessible-directory-p path)
-			       (file-name-all-completions pathnondir path)))
-      ;; Go thru each completion found, to see whether it should be used.
-      (while comps-in-path
-	(setq file (car comps-in-path)
-	      filepath (concat path file))
-	(if (and (not (member file completions))
-		 (not (and ignored-extensions
-			   (string-match ignored-extensions file)))
-		 (or (string-equal path cwd)
-		     (not (file-directory-p filepath)))
-		 (or (null shell-completion-execonly)
-		     (file-executable-p filepath)))
-	    (setq completions (cons file completions)))
-	(setq comps-in-path (cdr comps-in-path)))
-      (setq paths (cdr paths)))
-    ;; OK, we've got a list of completions.
-    (let ((success (let ((comint-completion-addsuffix nil))
-		     (comint-dynamic-simple-complete pathnondir completions))))
-      (if (and (memq success '(sole shortest)) comint-completion-addsuffix
-	       (not (file-directory-p (comint-match-partial-filename))))
-	  (insert " "))
-      success)))
-
-
-(defun shell-match-partial-variable ()
-  "Return the shell variable at point, or nil if none is found."
-  (save-excursion
-    (let ((limit (point)))
-      (if (re-search-backward "[^A-Za-z0-9_{}]" nil 'move)
-	  (or (looking-at "\\$") (forward-char 1)))
-      ;; Anchor the search forwards.
-      (if (or (eolp) (looking-at "[^A-Za-z0-9_{}$]"))
-	  nil
-	(re-search-forward "\\$?{?[A-Za-z0-9_]*}?" limit)
-	(buffer-substring (match-beginning 0) (match-end 0))))))
-
-
-(defun shell-dynamic-complete-environment-variable ()
-  "Dynamically complete the environment variable at point.
-Completes if after a variable, i.e., if it starts with a \"$\".
-See `shell-dynamic-complete-as-environment-variable'.
-
-This function is similar to `comint-dynamic-complete-filename', except that it
-searches `process-environment' for completion candidates.  Note that this may
-not be the same as the interpreter's idea of variable names.  The main problem
-with this type of completion is that `process-environment' is the environment
-which Emacs started with.  Emacs does not track changes to the environment made
-by the interpreter.  Perhaps it would be more accurate if this function was
-called `shell-dynamic-complete-process-environment-variable'.
-
-Returns non-nil if successful."
-  (interactive)
-  (let ((variable (shell-match-partial-variable)))
-    (if (and variable (string-match "^\\$" variable))
-	(prog2 (message "Completing variable name...")
-	    (shell-dynamic-complete-as-environment-variable)))))
-
-
-(defun shell-dynamic-complete-as-environment-variable ()
-  "Dynamically complete at point as an environment variable.
-Used by `shell-dynamic-complete-environment-variable'.
-Uses `comint-dynamic-simple-complete'."
-  (let* ((var (or (shell-match-partial-variable) ""))
-	 (variable (substring var (or (string-match "[^$({]\\|$" var) 0)))
-	 (variables (mapcar (function (lambda (x)
-					(substring x 0 (string-match "=" x))))
-			    process-environment))
-	 (addsuffix comint-completion-addsuffix)
-	 (comint-completion-addsuffix nil)
-	 (success (comint-dynamic-simple-complete variable variables)))
-    (if (memq success '(sole shortest))
-	(let* ((var (shell-match-partial-variable))
-	       (variable (substring var (string-match "[^$({]" var)))
-	       (protection (cond ((string-match "{" var) "}")
-				 ((string-match "(" var) ")")
-				 (t "")))
-	       (suffix (cond ((null addsuffix) "")
-			     ((file-directory-p
-			       (comint-directory (getenv variable))) "/")
-			     (t " "))))
-	  (insert protection suffix)))
-    success))
-
-
-(defun shell-replace-by-expanded-directory ()
-  "Expand directory stack reference before point.
-Directory stack references are of the form \"=digit\" or \"=-\".
-See `default-directory' and `shell-dirstack'.
-
-Returns t if successful."
-  (interactive)
-  (if (comint-match-partial-filename)
-      (save-excursion
-	(goto-char (match-beginning 0))
-	(let ((stack (cons default-directory shell-dirstack))
-	      (index (cond ((looking-at "=-/?")
-			    (length shell-dirstack))
-			   ((looking-at "=\\([0-9]+\\)/?")
-			    (string-to-number
-			     (buffer-substring
-			      (match-beginning 1) (match-end 1)))))))
-	  (cond ((null index)
-		 nil)
-		((>= index (length stack))
-		 (error "Directory stack not that deep"))
-		(t
-		 (replace-match (file-name-as-directory (nth index stack)) t t)
-		 (message "Directory item: %d" index)
-		 t))))))
-
-(provide 'shell)
-
-;;; shell.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/skeleton.el b/xemacs-packages/lisp/xemacs-base/skeleton.el
deleted file mode 100644
index b563eff2..00000000
--- a/xemacs-packages/lisp/xemacs-base/skeleton.el
+++ /dev/null
@@ -1,591 +0,0 @@
-;;; skeleton.el --- Lisp language extension for writing statement skeletons
-;; Copyright (C) 1993, 1994, 1995 by Free Software Foundation, Inc.
-
-;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-;; Maintainer: FSF
-;; Keywords: extensions, abbrev, languages, tools
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; A very concise language extension for writing structured statement
-;; skeleton insertion commands for programming language modes.  This
-;; originated in shell-script mode and was applied to ada-mode's
-;; commands which shrunk to one third.  And these commands are now
-;; user configurable.
-
-;;; Code:
-
-;; page 1:	statement skeleton language definition & interpreter
-;; page 2:	paired insertion
-;; page 3:	mirror-mode, an example for setting up paired insertion
-
-
-(defvar skeleton-transformation nil
-  "*If non-nil, function applied to literal strings before they are inserted.
-It should take strings and characters and return them transformed, or nil
-which means no transformation.
-Typical examples might be `upcase' or `capitalize'.")
-
-; this should be a fourth argument to defvar
-(put 'skeleton-transformation 'variable-interactive
-     "aTransformation function: ")
-
-
-(defvar skeleton-autowrap t
-  "Controls wrapping behaviour of functions created with `define-skeleton'.
-When the region is visible (due to `transient-mark-mode' or marking a region
-with the mouse) and this is non-`nil' and the function was called without an
-explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible
-region.
-
-We will probably delete this variable in a future Emacs version
-unless we get a substantial number of complaints about the auto-wrap
-feature.")
-
-(defvar skeleton-end-hook
-  (lambda ()
-    (or (eolp) (newline-and-indent)))
-  "Hook called at end of skeleton but before going to point of interest.
-By default this moves out anything following to next line.
-The variables `v1' and `v2' are still set when calling this.")
-
-
-;;;###autoload
-(defvar skeleton-filter 'identity
-  "Function for transforming a skeleton proxy's aliases' variable value.")
-
-(defvar skeleton-untabify t
-  "When non-`nil' untabifies when deleting backwards with element -ARG.")
-
-(defvar skeleton-newline-indent-rigidly nil
-  "When non-`nil', indent rigidly under current line for element `\\n'.
-Else use mode's `indent-line-function'.")
-
-(defvar skeleton-further-elements ()
-  "A buffer-local varlist (see `let') of mode specific skeleton elements.
-These variables are bound while interpreting a skeleton.  Their value may
-in turn be any valid skeleton element if they are themselves to be used as
-skeleton elements.")
-(make-variable-buffer-local 'skeleton-further-elements)
-
-
-(defvar skeleton-subprompt
-  (substitute-command-keys
-   "RET, \\\\[abort-recursive-edit] or \\[help-command]")
-  "*Replacement for %s in prompts of recursive subskeletons.")
-
-
-(defvar skeleton-abbrev-cleanup nil
-  "Variable used to delete the character that led to abbrev expansion.")
-
-;; XEmacs -- won't byte compile without the wrapper
-(eval-and-compile
-  (defvar skeleton-debug nil
-    "*If non-nil `define-skeleton' will override previous definition."))
-
-;; reduce the number of compiler warnings
-(defvar skeleton)
-(defvar skeleton-modified)
-(defvar skeleton-point)
-(defvar skeleton-regions)
-
-;;;###autoload
-(defmacro define-skeleton (command documentation &rest skeleton)
-  "Define a user-configurable COMMAND that enters a statement skeleton.
-DOCUMENTATION is that of the command, while the variable of the same name,
-which contains the skeleton, has a documentation to that effect.
-INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'."
-  (if skeleton-debug
-      (set command skeleton))
-  `(progn
-     (defun ,command (&optional str arg)
-       ,(concat documentation
-		(if (string-match "\n\\>" documentation)
-		    "" "\n")
-		"\n"
-		"This is a skeleton command (see `skeleton-insert').
-Normally the skeleton text is inserted at point, with nothing \"inside\".
-If there is a highlighted region, the skeleton text is wrapped
-around the region text.
-
-A prefix argument ARG says to wrap the skeleton around the next ARG words.
-A prefix argument of zero says to wrap around zero words---that is, nothing.
-This is a way of overiding the use of a highlighted region.")
-       (interactive "*P\nP")
-       (skeleton-proxy-new ',skeleton str arg))))
-
-;;;###autoload
-(defun skeleton-proxy-new (skeleton &optional str arg)
-  "Insert skeleton defined by variable of same name (see `skeleton-insert').
-Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
-If no ARG was given, but the region is visible, ARG defaults to -1 depending
-on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.
-This command can also be an abbrev expansion (3rd and 4th columns in
-\\[edit-abbrevs]  buffer: \"\"  command-name).
- 
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored."
-  (interactive "*P\nP")
-  (setq skeleton (funcall skeleton-filter skeleton))
-  (if (not skeleton)
-      (if (memq this-command '(self-insert-command
-			       skeleton-pair-insert-maybe
-			       expand-abbrev))
-	  (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
-    (skeleton-insert skeleton
-		     (if (setq skeleton-abbrev-cleanup
-			       (or (eq this-command 'self-insert-command)
-				   (eq this-command
-				       'skeleton-pair-insert-maybe)))
-			 ()
-		       ;; Pretend  C-x a e  passed its prefix arg to us
-		       (if (or arg current-prefix-arg)
-			   (prefix-numeric-value (or arg
-						     current-prefix-arg))
-			 (and skeleton-autowrap
-			      (or (eq last-command 'mouse-drag-region)
-				  (and (boundp 'transient-mark-mode)
-				       (boundp 'mark-active)
-				       transient-mark-mode mark-active))
-			      -1)))
-		     (if (stringp str)
-			 str))
-    (and skeleton-abbrev-cleanup
-	 (setq skeleton-abbrev-cleanup (point))
-	 (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t))))
-
-;; This command isn't meant to be called, only it's aliases with meaningful
-;; names are.
-;;;###autoload
-(defun skeleton-proxy (&optional str arg)
-  "Insert skeleton defined by variable of same name (see `skeleton-insert').
-Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
-If no ARG was given, but the region is visible, ARG defaults to -1 depending
-on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.
-This command can also be an abbrev expansion (3rd and 4th columns in
-\\[edit-abbrevs]  buffer: \"\"  command-name).
-
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored."
-  (interactive "*P\nP")
-  (let ((function (nth 1 (backtrace-frame 1))))
-    (if (eq function 'nth)		; uncompiled Lisp function
-	(setq function (nth 1 (backtrace-frame 5)))
-      (if (eq function 'byte-code)	; tracing byte-compiled function
-	  (setq function (nth 1 (backtrace-frame 2)))))
-    (if (not (setq function (funcall skeleton-filter (symbol-value function))))
-	(if (memq this-command '(self-insert-command
-				 skeleton-pair-insert-maybe
-				 expand-abbrev))
-	    (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
-      (skeleton-insert function
-		       (if (setq skeleton-abbrev-cleanup
-				 (or (eq this-command 'self-insert-command)
-				     (eq this-command
-					 'skeleton-pair-insert-maybe)))
-			   ()
-			 ;; Pretend  C-x a e  passed its prefix arg to us
-			 (if (or arg current-prefix-arg)
-			     (prefix-numeric-value (or arg
-						       current-prefix-arg))
-			   (and skeleton-autowrap
-				(or (eq last-command 'mouse-drag-region)
-				    (and (boundp 'transient-mark-mode)
-					 (boundp 'mark-active)
-					 transient-mark-mode mark-active))
-				-1)))
-		       (if (stringp str)
-			   str))
-      (and skeleton-abbrev-cleanup
-	   (setq skeleton-abbrev-cleanup (point))
-	   (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t)))))
-
-
-(defun skeleton-abbrev-cleanup (&rest list)
-  "Value for `post-command-hook' to remove char that expanded abbrev."
-  (if (integerp skeleton-abbrev-cleanup)
-      (progn
-	(delete-region skeleton-abbrev-cleanup (point))
-	(setq skeleton-abbrev-cleanup nil)
-	(remove-hook 'post-command-hook 'skeleton-abbrev-cleanup t))))
-
-;;;###autoload
-(defun skeleton-insert (skeleton &optional skeleton-regions str)
-  "Insert the complex statement skeleton SKELETON describes very concisely.
-
-With optional third REGIONS wrap first interesting point (`_') in skeleton
-around next REGIONS words, if REGIONS is positive.  If REGIONS is negative,
-wrap REGIONS preceding interregions into first REGIONS interesting positions
-\(successive `_'s) in skeleton.  An interregion is the stretch of text between
-two contiguous marked points.  If you marked A B C [] (where [] is the cursor)
-in alphabetical order, the 3 interregions are simply the last 3 regions.  But
-if you marked B A [] C, the interregions are B-A, A-[], []-C.
-
-Optional fourth STR is the value for the variable `str' within the skeleton.
-When this is non-`nil' the interactor gets ignored, and this should be a valid
-skeleton element.
-
-SKELETON is made up as (INTERACTOR ELEMENT ...).  INTERACTOR may be nil if
-not needed, a prompt-string or an expression for complex read functions.
-
-If ELEMENT is a string or a character it gets inserted (see also
-`skeleton-transformation').  Other possibilities are:
-
-	\\n	go to next line and indent according to mode
-	_	interesting point, interregion here, point after termination
-	>	indent line (or interregion if > _) according to major mode
-	&	do next ELEMENT if previous moved point
-	|	do next ELEMENT if previous didn't move point
-	-num	delete num preceding characters (see `skeleton-untabify')
-	resume:	skipped, continue here if quit is signaled
-	nil	skipped
-
-Further elements can be defined via `skeleton-further-elements'.  ELEMENT may
-itself be a SKELETON with an INTERACTOR.  The user is prompted repeatedly for
-different inputs.  The SKELETON is processed as often as the user enters a
-non-empty string.  \\[keyboard-quit] terminates skeleton insertion, but
-continues after `resume:' and positions at `_' if any.  If INTERACTOR in such
-a subskeleton is a prompt-string which contains a \".. %s ..\" it is
-formatted with `skeleton-subprompt'.  Such an INTERACTOR may also a list of
-strings with the subskeleton being repeated once for each string.
-
-Quoted Lisp expressions are evaluated evaluated for their side-effect.
-Other Lisp expressions are evaluated and the value treated as above.
-Note that expressions may not return `t' since this implies an
-endless loop.  Modes can define other symbols by locally setting them
-to any valid skeleton element.  The following local variables are
-available:
-
-	str	first time: read a string according to INTERACTOR
-		then: insert previously read string once more
-	help	help-form during interaction with the user or `nil'
-	input	initial input (string or cons with index) while reading str
-	v1, v2	local variables for memorizing anything you want
-
-When done with skeleton, but before going back to `_'-point call
-`skeleton-end-hook' if that is non-`nil'."
-  (and skeleton-regions
-       (setq skeleton-regions
-	     (if (> skeleton-regions 0)
-		 (list (point-marker)
-		       (save-excursion (forward-word skeleton-regions)
-				       (point-marker)))
-	       (setq skeleton-regions (- skeleton-regions))
-	       ;; copy skeleton-regions - 1 elements from `mark-ring'
-	       (let ((l1 (cons (mark-marker) mark-ring))
-		     (l2 (list (point-marker))))
-		 (while (and l1 (> skeleton-regions 0))
-		   (setq l2 (cons (car l1) l2)
-			 skeleton-regions (1- skeleton-regions)
-			 l1 (cdr l1)))
-		 (sort l2 '<))))
-       (goto-char (car skeleton-regions))
-       (setq skeleton-regions (cdr skeleton-regions)))
-  (let ((beg (point))
-	skeleton-modified skeleton-point resume: help input v1 v2)
-    (unwind-protect
-	(eval `(let ,skeleton-further-elements
-		 (skeleton-internal-list skeleton str)))
-      (run-hooks 'skeleton-end-hook)
-      (sit-for 0)
-      (or (pos-visible-in-window-p beg)
-	  (progn
-	    (goto-char beg)
-	    (recenter 0)))
-      (if skeleton-point
-	  (goto-char skeleton-point)))))
-
-(defun skeleton-read (str &optional initial-input recursive)
-  "Function for reading a string from the minibuffer within skeletons.
-PROMPT may contain a `%s' which will be replaced by `skeleton-subprompt'.
-If non-`nil' second arg INITIAL-INPUT or variable `input' is a string or
-cons with index to insert before reading.  If third arg RECURSIVE is non-`nil'
-i.e. we are handling the iterator of a subskeleton, returns empty string if
-user didn't modify input.
-While reading, the value of `minibuffer-help-form' is variable `help' if that
-is non-`nil' or a default string."
-  (let ((minibuffer-help-form (or (if (boundp 'help) (symbol-value 'help))
-				  (if recursive "\
-As long as you provide input you will insert another subskeleton.
-
-If you enter the empty string, the loop inserting subskeletons is
-left, and the current one is removed as far as it has been entered.
-
-If you quit, the current subskeleton is removed as far as it has been
-entered.  No more of the skeleton will be inserted, except maybe for a
-syntactically necessary termination."
-					 "\
-You are inserting a skeleton.  Standard text gets inserted into the buffer
-automatically, and you are prompted to fill in the variable parts.")))
-	(eolp (eolp)))
-    ;; since Emacs doesn't show main window's cursor, do something noticeable
-    (or eolp
-	(open-line 1))
-    (unwind-protect
-	(setq str (if (stringp str)
-		      (read-string (format str skeleton-subprompt)
-				   (setq initial-input
-					 (or initial-input
-					     (symbol-value 'input))))
-		    (eval str)))
-      (or eolp
-	  (delete-char 1))))
-  (if (and recursive
-	   (or (null str)
-	       (string= str "")
-	       (equal str initial-input)
-	       (equal str (car-safe initial-input))))
-      (signal 'quit t)
-    str))
-
-(defun skeleton-internal-list (skeleton &optional str recursive)
-  (let* ((start (save-excursion (beginning-of-line) (point)))
-	 (column (current-column))
-	 (line (buffer-substring start
-				 (save-excursion (end-of-line) (point))))
-	 opoint)
-    (or str
-	(setq str `(setq str (skeleton-read ',(car skeleton) nil ,recursive))))
-    (while (setq skeleton-modified (eq opoint (point))
-		 opoint (point)
-		 skeleton (cdr skeleton))
-      (condition-case quit
-	  (skeleton-internal-1 (car skeleton))
-	(quit
-	 (if (eq (cdr quit) 'recursive)
-	     (setq recursive 'quit
-		   skeleton (memq 'resume: skeleton))
-	   ;; remove the subskeleton as far as it has been shown
-	   ;; the subskeleton shouldn't have deleted outside current line
-	   (end-of-line)
-	   (delete-region start (point))
-	   (insert line)
-	   (move-to-column column)
-	   (if (cdr quit)
-	       (setq skeleton ()
-		     recursive nil)
-	     (signal 'quit 'recursive)))))))
-  ;; maybe continue loop or go on to next outer resume: section
-  (if (eq recursive 'quit)
-      (signal 'quit 'recursive)
-    recursive))
-
-
-(defun skeleton-internal-1 (element &optional literal)
-  (cond ((or (integerp element)
-	     (char-or-string-p element))
-	 (if (and (integerp element)	; -num
-		  (< element 0))
-	     (if skeleton-untabify
-		 (backward-delete-char-untabify (- element))
-	       (delete-backward-char (- element)))
-	   (insert-before-markers (if (and skeleton-transformation
-					   (not literal))
-				      (funcall skeleton-transformation element)
-				    element))))
-	((eq element '\n)		; actually (eq '\n 'n)
-	 (if (and skeleton-regions
-		  (eq (nth 1 skeleton) '_))
-	     (progn
-	       (or (eolp)
-		   (newline))
-	       (indent-region (point) (car skeleton-regions) nil))
-	   (if skeleton-newline-indent-rigidly
-	       (indent-to (prog1 (current-indentation)
-			    (newline)))
-	     (newline)
-	     (indent-according-to-mode))))
-	((eq element '>)
-	 (if (and skeleton-regions
-		  (eq (nth 1 skeleton) '_))
-	     (indent-region (point) (car skeleton-regions) nil)
-	   (indent-according-to-mode)))
-	((eq element '_)
-	 (if skeleton-regions
-	     (progn
-	       (goto-char (car skeleton-regions))
-	       (setq skeleton-regions (cdr skeleton-regions))
-	       (and (<= (current-column) (current-indentation))
-		    (eq (nth 1 skeleton) '\n)
-		    (end-of-line 0)))
-	   (or skeleton-point
-	       (setq skeleton-point (point)))))
-	((eq element '&)
-	 (if skeleton-modified
-	     (setq skeleton (cdr skeleton))))
-	((eq element '|)
-	 (or skeleton-modified
-	     (setq skeleton (cdr skeleton))))
-	((eq 'quote (car-safe element))
-	 (eval (nth 1 element)))
-	((or (stringp (car-safe element))
-	     (consp (car-safe element)))
-	 (if (symbolp (car-safe (car element)))
-	     (while (skeleton-internal-list element nil t))
-	   (setq literal (car element))
-	   (while literal
-	     (skeleton-internal-list element (car literal))
-	     (setq literal (cdr literal)))))
-	((null element))
-	((skeleton-internal-1 (eval element) t))))
-
-
-;; Maybe belongs into simple.el or elsewhere
-;###autoload
-(define-skeleton local-variables-section
-  "Insert a local variables section.  Use current comment syntax if any."
-  (completing-read "Mode: " obarray
-		   (lambda (symbol)
-		     (if (commandp symbol)
-			 (string-match "-mode$" (symbol-name symbol))))
-		   t)
-  '(save-excursion
-     (if (re-search-forward page-delimiter nil t)
-	 (error "Not on last page.")))
-  comment-start "Local Variables:" comment-end \n
-  comment-start "mode: " str
-  & -5 | '(kill-line 0) & -1 | comment-end \n
-  ( (completing-read (format "Variable, %s: " skeleton-subprompt)
-		     obarray
-		     (lambda (symbol)
-		       (or (eq symbol 'eval)
-			   (user-variable-p symbol)))
-		     t)
-    comment-start str ": "
-    (read-from-minibuffer "Expression: " nil read-expression-map nil
-			  'read-expression-history) | _
-			  comment-end \n)
-  resume:
-  comment-start "End:" comment-end \n)
-
-;; Variables and command for automatically inserting pairs like () or "".
-
-(defvar skeleton-pair nil
-  "*If this is nil pairing is turned off, no matter what else is set.
-Otherwise modes with `skeleton-pair-insert-maybe' on some keys
-will attempt to insert pairs of matching characters.")
-
-
-(defvar skeleton-pair-on-word nil
-  "*If this is nil, paired insertion is inhibited before or inside a word.")
-
-
-(defvar skeleton-pair-filter (lambda ())
-  "Attempt paired insertion if this function returns nil, before inserting.
-This allows for context-sensitive checking whether pairing is appropriate.")
-
-
-(defvar skeleton-pair-alist ()
-  "An override alist of pairing partners matched against `last-command-char'.
-Each alist element, which looks like (ELEMENT ...), is passed to
-`skeleton-insert' with no interactor.  Variable `str' does nothing.
-
-Elements might be (?` ?` _ \"''\"), (?\\( ?  _ \" )\") or (?{ \\n > _ \\n ?} >).")
-
-
-;;;###autoload
-(defun skeleton-pair-insert-maybe (arg)
-  "Insert the character you type ARG times.
-
-With no ARG, if `skeleton-pair' is non-nil, pairing can occur.  If the region
-is visible the pair is wrapped around it depending on `skeleton-autowrap'.
-Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a
-word, and if `skeleton-pair-filter' returns nil, pairing is performed.
-
-If a match is found in `skeleton-pair-alist', that is inserted, else
-the defaults are used.  These are (), [], {}, <> and `' for the
-symmetrical ones, and the same character twice for the others."
-  (interactive "*P")
-  (let ((mark (and skeleton-autowrap
-		   (or (eq last-command 'mouse-drag-region)
-		       (and (boundp 'transient-mark-mode)
-			    (boundp 'mark-active)
-			    transient-mark-mode mark-active))))
-	(skeleton-end-hook))
-    (if (or arg
-	    (not skeleton-pair)
-	    (and (not mark)
-		 (or overwrite-mode
-		     (if (not skeleton-pair-on-word) (looking-at "\\w"))
-		     (funcall skeleton-pair-filter))))
-	(self-insert-command (prefix-numeric-value arg))
-      (setq last-command-char (logand last-command-char 255))
-      (or skeleton-abbrev-cleanup
-	  (skeleton-insert
-	   (cons nil (or (assq last-command-char skeleton-pair-alist)
-			 (assq last-command-char '((?( _ ?))
-						   (?[ _ ?])
-						   (?{ _ ?})
-						   (?< _ ?>)
-						   (?` _ ?')))
-			 `(,last-command-char _ ,last-command-char)))
-	   (if mark -1))))))
-
-
-;; A more serious example can be found in sh-script.el
-;;; (defun mirror-mode ()
-;;  "This major mode is an amusing little example of paired insertion.
-;;All printable characters do a paired self insert, while the other commands
-;;work normally."
-;;  (interactive)
-;;  (kill-all-local-variables)
-;;  (make-local-variable 'skeleton-pair)
-;;  (make-local-variable 'skeleton-pair-on-word)
-;;  (make-local-variable 'skeleton-pair-filter)
-;;  (make-local-variable 'skeleton-pair-alist)
-;;  (setq major-mode 'mirror-mode
-;;	mode-name "Mirror"
-;;	skeleton-pair-on-word t
-;;	;; in the middle column insert one or none if odd window-width
-;;	skeleton-pair-filter (lambda ()
-;;			       (if (>= (current-column)
-;;				       (/ (window-width) 2))
-;;				   ;; insert both on next line
-;;				   (next-line 1)
-;;				 ;; insert one or both?
-;;				 (= (* 2 (1+ (current-column)))
-;;				    (window-width))))
-;;	;; mirror these the other way round as well
-;;	skeleton-pair-alist '((?) _ ?()
-;;			      (?] _ ?[)
-;;			      (?} _ ?{)
-;;			      (?> _ ?<)
-;;			      (?/ _ ?\\)
-;;			      (?\\ _ ?/)
-;;			      (?` ?` _ "''")
-;;			      (?' ?' _ "``"))
-;;	;; in this mode we exceptionally ignore the user, else it's no fun
-;;	skeleton-pair t)
-;;  (let ((map (make-vector 256 'skeleton-pair-insert-maybe))
-;;	(i 0))
-;;    (use-local-map `(keymap ,map))
-;;    (while (< i ? )
-;;      (aset map i nil)
-;;      (aset map (+ i 128) nil)
-;;      (setq i (1+ i))))
-;;  (run-hooks 'mirror-mode-hook))
-
-(provide 'skeleton)
-
-;; skeleton.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/sort.el b/xemacs-packages/lisp/xemacs-base/sort.el
deleted file mode 100644
index dc81d06a..00000000
--- a/xemacs-packages/lisp/xemacs-base/sort.el
+++ /dev/null
@@ -1,624 +0,0 @@
-;;; sort.el --- commands to sort text in an XEmacs buffer
-
-;; Copyright (C) 1986, 1987, 1994, 1995, 2003 Free Software Foundation, Inc.
-
-;; Author: Howie Kaye
-;; Maintainer: XEmacs Development Team
-;; Keywords: unix
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;;; This package provides the sorting facilities documented in the XEmacs
-;;; Reference Manual.
-
-;;; Code:
-
-(defgroup sort nil
-  "Commands to sort text in an Emacs buffer."
-  :group 'data)
-
-(defcustom sort-fold-case nil
-  "*Non-nil if the buffer sort functions should ignore case."
-  :group 'sort
-  :type 'boolean)
-
-;;;###autoload
-(defun sort-subr (reverse nextrecfun endrecfun &optional startkeyfun endkeyfun
-			  comparefun)
-  "General text sorting routine to divide buffer into records and sort them.
-
-We divide the accessible portion of the buffer into disjoint pieces
-called sort records.  A portion of each sort record (perhaps all of
-it) is designated as the sort key.  The records are rearranged in the
-buffer in order by their sort keys.  The records may or may not be
-contiguous.
-
-Usually the records are rearranged in order of ascending sort key.
-If REVERSE is non-nil, they are rearranged in order of descending sort key.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-The next four arguments are functions to be called to move point
-across a sort record.  They will be called many times from within sort-subr.
-
-NEXTRECFUN is called with point at the end of the 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.
-The first record is assumed to start at the position of point when sort-subr
-is called.
-
-ENDRECFUN is called with point within the record.
-It should move point to the end of the record.
-
-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.
-
-COMPAREFUN compares the two keys.  It is called with two strings and
-should return true if the first is \"less\" than the second, just as
-for `sort'.  If nil or omitted, the default function accepts keys that
-are numbers (compared numerically) or strings (compared lexicographically)."
-  ;; Heuristically try to avoid messages if sorting a small amt of text.
-  (let ((messages (> (- (point-max) (point-min)) 50000)))
-    (save-excursion
-      (if messages (message "Finding sort keys..."))
-      (let* ((sort-lists (sort-build-lists nextrecfun endrecfun
-					   startkeyfun endkeyfun))
-	     (old (reverse sort-lists))
-	     (case-fold-search sort-fold-case))
-	(if (null sort-lists)
-	    ()
-	  (or reverse (setq sort-lists (nreverse sort-lists)))
-	  (if messages (message "Sorting records..."))
-	  (setq sort-lists
-		(sort sort-lists
-		      (cond ((and (consp (car (car sort-lists)))
-				  comparefun)
-			     (function
-			      (lambda (a b)
-				(funcall comparefun
-					 (buffer-substring (car (car a))
-							   (cdr (car a)))
-					 (buffer-substring (car (car b))
-							   (cdr (car b)))))))
-			    ((consp (car (car sort-lists)))
-			     (function
-			      (lambda (a b)
-				(> 0 (compare-buffer-substrings
-				      nil (car (car a)) (cdr (car a))
-				      nil (car (car b)) (cdr (car b)))))))
-			    (comparefun
-			     (function
-			      (lambda (a b)
-				(funcall comparefun (car a) (car b)))))
-			    ((numberp (car (car sort-lists)))
-			     'car-less-than-car)
-			    (t
-			     (function
-			      (lambda (a b)
-				(string< (car a) (car b))))))))
-	  (if reverse (setq sort-lists (nreverse sort-lists)))
-	  (if messages (message "Reordering buffer..."))
-	  (sort-reorder-buffer sort-lists old)))
-      (if messages (message "Reordering buffer... Done"))))
-  nil)
-
-;; Parse buffer into records using the arguments as Lisp expressions;
-;; return a list of records.  Each record looks like (KEY STARTPOS . ENDPOS)
-;; where KEY is the sort key (a number or string),
-;; and STARTPOS and ENDPOS are the bounds of this record in the buffer.
-
-;; The records appear in the list lastmost first!
-
-(defun sort-build-lists (nextrecfun endrecfun startkeyfun endkeyfun)
-  (let ((sort-lists ())
-	(start-rec nil)
-	done key)
-    ;; Loop over sort records.
-    ;(goto-char (point-min)) -- it is the caller's responsibility to
-    ;arrange this if necessary
-    (while (not (eobp))
-      (setq start-rec (point))		;save record start
-      (setq done nil)
-      ;; Get key value, or move to start of key.
-      (setq key (catch 'key
-		  (or (and startkeyfun (funcall startkeyfun))
-		      ;; If key was not returned as value,
-		      ;; move to end of key and get key from the buffer.
-		      (let ((start (point)))
-			(funcall (or endkeyfun
-				     (prog1 endrecfun (setq done t))))
-			(cons start (point))))))
-      ;; Move to end of this record (start of next one, or end of buffer).
-      (cond ((prog1 done (setq done nil)))
-	    (endrecfun (funcall endrecfun))
-	    (nextrecfun (funcall nextrecfun) (setq done t)))
-      (if key (setq sort-lists (cons
-				 ;; consing optimization in case in which key
-				 ;; is same as record.
-				 (if (and (consp key)
-					  (equal (car key) start-rec)
-					  (equal (cdr key) (point)))
-				     (cons key key)
-				     (cons key (cons start-rec (point))))
-				sort-lists)))
-      (and (not done) nextrecfun (funcall nextrecfun)))
-    sort-lists))
-
-(defun sort-reorder-buffer (sort-lists old)
-  (let ((last (point-min))
-	(min (point-min)) (max (point-max))
-	(old-buffer (current-buffer))
-	temp-buffer)
-    (with-temp-buffer
-      ;; Record the temporary buffer.
-      (setq temp-buffer (current-buffer))
-
-      ;; Copy the sorted text into the temporary buffer.
-      (while sort-lists
-	(goto-char (point-max))
-	(insert-buffer-substring old-buffer
-				 last
-				 (nth 1 (car old)))
-	(goto-char (point-max))
-	(insert-buffer-substring old-buffer
-				 (nth 1 (car sort-lists))
-				 (cdr (cdr (car sort-lists))))
-	(setq last (cdr (cdr (car old)))
-	      sort-lists (cdr sort-lists)
-	      old (cdr old)))
-      (goto-char (point-max))
-      (insert-buffer-substring old-buffer last max)
-
-      ;; Copy the reordered text from the temporary buffer
-      ;; to the buffer we sorted (OLD-BUFFER).
-      (set-buffer old-buffer)
-      (let ((inhibit-quit t))
-	;; Make sure insertions done for reordering
-	;; do not go after any markers at the end of the sorted region,
-	;; by inserting a space to separate them.
-	(goto-char max)
-	(insert-before-markers " ")
-	;; Delete the original copy of the text.
-	(delete-region min max)
-	;; Now replace the separator " " with the sorted text.
-	(goto-char (point-max))
-	(insert-buffer-substring temp-buffer)
-	(delete-region min (1+ min))))))
-
-;;;###autoload
-(defun sort-lines (reverse beg end)
-  "Sort lines in region alphabetically; argument means descending order.
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort).
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order."
-  (interactive "P\nr")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (sort-subr reverse 'forward-line 'end-of-line))))
-
-;;;###autoload
-(defun sort-paragraphs (reverse beg end)
-  "Sort paragraphs in region alphabetically; argument means descending order.
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort).
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order."
-  (interactive "P\nr")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (sort-subr reverse
-		 (function
-		  (lambda ()
-		    (while (and (not (eobp)) (looking-at paragraph-separate))
-		      (forward-line 1))))
-		 'forward-paragraph))))
-
-;;;###autoload
-(defun sort-pages (reverse beg end)
-  "Sort pages in region alphabetically; argument means descending order.
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort).
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order."
-  (interactive "P\nr")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (sort-subr reverse
-		 (function (lambda () (skip-chars-forward "\n")))
-		 'forward-page))))
-
-(defvar sort-fields-syntax-table nil)
-(if sort-fields-syntax-table nil
-  (let ((table (make-syntax-table))
-	(i 0))
-    (while (< i 256)
-      (modify-syntax-entry i "w" table)
-      (setq i (1+ i)))
-    (modify-syntax-entry ?\  " " table)
-    (modify-syntax-entry ?\t " " table)
-    (modify-syntax-entry ?\n " " table)
-    (modify-syntax-entry ?\. "_" table)	; for floating pt. numbers. -wsr
-    (setq sort-fields-syntax-table table)))
-
-(defcustom sort-numeric-base 10
-  "*The default base used by `sort-numeric-fields'."
-  :group 'sort
-  :type 'integer)
-
-;;;###autoload
-(defun sort-numeric-fields (field beg end)
-  "Sort lines in region numerically by the ARGth field of each line.
-Fields are separated by whitespace and numbered from 1 up.
-Specified 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.
-With a negative arg, sorts by the ARGth field counted from the right.
-Called from a program, there are three arguments:
-FIELD, BEG and END.  BEG and END specify region to sort.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-If you want to sort floating-point numbers, try `sort-float-fields'."
-  (interactive "p\nr")
-  (sort-fields-1 field beg end
-		 (lambda ()
-		   (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))
-
-;; This function is commented out of 19.34.
-;;;###autoload
-(defun sort-float-fields (field beg end)
-  "Sort lines in region numerically by the ARGth field of each line.
-Fields are separated by whitespace and numbered from 1 up.  Specified field
-must contain a floating point number in each line of the region.  With a
-negative arg, sorts by the ARGth field counted from the right.  Called from a
-program, there are three arguments: FIELD, BEG and END.  BEG and END specify
-region to sort."
-  (interactive "p\nr")
-  (sort-fields-1 field beg end
-		 (function (lambda ()
-			     (sort-skip-fields field)
-			     (string-to-number
-			      (buffer-substring
-			       (point)
-			       (save-excursion
-				 (re-search-forward
-				  "[+-]?[0-9]*\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
-				 (point))))))
-		 nil))
-
-;;;###autoload
-(defun sort-fields (field beg end)
-  "Sort lines in region lexicographically by the ARGth field of each line.
-Fields are separated by whitespace and numbered from 1 up.
-With a negative arg, sorts by the ARGth field counted from the right.
-Called from a program, there are three arguments:
-FIELD, BEG and END.  BEG and END specify region to sort.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order."
-  (interactive "p\nr")
-  (sort-fields-1 field beg end
-		 (function (lambda ()
-			     (sort-skip-fields field)
-			     nil))
-		 (function (lambda () (skip-chars-forward "^ \t\n")))))
-
-(defun sort-fields-1 (field beg end startkeyfun endkeyfun)
-  (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 nil
-		       'forward-line 'end-of-line
-		       startkeyfun endkeyfun)))
-      (set-syntax-table tbl))))
-
-;; Position at the beginning of field N on the current line,
-;; assuming point is initially at the beginning of the line.
-(defun sort-skip-fields (n)
-  (if (> n 0)
-      ;; Skip across N - 1 fields.
-      (let ((i (1- n)))
-	(while (> i 0)
-	  (skip-chars-forward " \t")
-	  (skip-chars-forward "^ \t\n")
-	  (setq i (1- i)))
-	(skip-chars-forward " \t")
-	(if (eolp)
-	    (error "Line has too few fields: %s"
-		   (buffer-substring
-		    (save-excursion (beginning-of-line) (point))
-		    (save-excursion (end-of-line) (point))))))
-    (end-of-line)
-    ;; Skip back across - N - 1 fields.
-    (let ((i (1- (- n))))
-      (while (> i 0)
-	(skip-chars-backward " \t")
-	(skip-chars-backward "^ \t\n")
-	(setq i (1- i)))
-      (skip-chars-backward " \t"))
-    (if (bolp)
-	(error "Line has too few fields: %s"
-	       (buffer-substring
-		(save-excursion (beginning-of-line) (point))
-		(save-excursion (end-of-line) (point)))))
-    ;; Position at the front of the field
-    ;; even if moving backwards.
-    (skip-chars-backward "^ \t\n")))
-
-(defvar sort-regexp-fields-regexp)
-(defvar sort-regexp-record-end)
-
-;; Move to the beginning of the next match for record-regexp,
-;; and set sort-regexp-record-end to the end of that match.
-;; If the next match is empty and does not advance point,
-;; skip one character and try again.
-(defun sort-regexp-fields-next-record ()
-  (let ((oldpos (point)))
-    (and (re-search-forward sort-regexp-fields-regexp nil 'move)
-	 (setq sort-regexp-record-end (match-end 0))
-	 (if (= sort-regexp-record-end oldpos)
-	     (progn
-	       (forward-char 1)
-	       (re-search-forward sort-regexp-fields-regexp nil 'move)
-	       (setq sort-regexp-record-end (match-end 0)))
-	   t)
-	 (goto-char (match-beginning 0)))))
-
-;; History used for sort regexps.
-(defvar sort-regexp-history nil)
-
-;;;###autoload
-(defun sort-regexp-fields (reverse record-regexp key-regexp beg end
-				   &optional comparefun)
-  "Sort the region as specified by RECORD-REGEXP and KEY.
-RECORD-REGEXP specifies the textual units which should be sorted.
-  For example, to sort lines RECORD-REGEXP would be \"^.*$\"
-KEY specifies the part of each record (ie each match for RECORD-REGEXP)
-  is to be used for sorting.
-  If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from
-  RECORD-REGEXP is used.
-  If it is \"\\\\&\" then the whole record is used.
-  Otherwise, it is a regular-expression for which to search within the record.
-If a match for KEY is not found within a record then that record is ignored.
-
-With a negative prefix arg sorts in reverse order.
-
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-COMPAREFUN, if specified, should be a function of two arguments; it
-will be passed the keys (as strings), and should return true if the
-first is \"less\" than the second.  Otherwise the keys will be
-compared lexicographically.
-
-For example: to sort lines in the region by the first word on each line
- starting with the letter \"f\",
- RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\\""
-  ;; using negative prefix arg to mean "reverse" is now inconsistent with
-  ;; other sort-.*fields functions but then again this was before, since it
-  ;; didn't use the magnitude of the arg to specify anything.
-  (interactive
-   ;; retrieve the region first, since pasting into the minibuffer will
-   ;; deactivate it. (YUCK! should have per-buffer regions.)
-   (let ((beg (region-beginning))
-	 (end (region-end)))
-     (list current-prefix-arg
-	   (read-string "Regexp specifying records to sort: "
-			nil 'sort-regexp-history)
-	   (read-string "Regexp specifying key within record: "
-			nil 'sort-regexp-history)
-	   beg end)))
-  (cond ((or (equal key-regexp "") (equal key-regexp "\\&"))
-	 (setq key-regexp 0))
-	((string-match "\\`\\\\[1-9]\\'" key-regexp)
-	 (setq key-regexp (- (aref key-regexp 1) ?0))))
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (let (sort-regexp-record-end
-	    (sort-regexp-fields-regexp record-regexp))
-	(re-search-forward sort-regexp-fields-regexp nil t)
-	(setq sort-regexp-record-end (point))
-	(goto-char (match-beginning 0))
-	(sort-subr reverse
-		   'sort-regexp-fields-next-record
-		   (function (lambda ()
-			       (goto-char sort-regexp-record-end)))
-		   (function (lambda ()
-			       (let ((n 0))
-				 (cond ((numberp key-regexp)
-					(setq n key-regexp))
-				       ((re-search-forward
-					  key-regexp sort-regexp-record-end t)
-					(setq n 0))
-				       (t (throw 'key nil)))
-				 (condition-case ()
-				     (cons (match-beginning n)
-					   (match-end n))
-				   ;; if there was no such register
-				   (error (throw 'key nil))))))
-		   nil
-		   comparefun)))))
-
-;;;###autoload
-(defun sort-regexp-fields-numerically (reverse record-regexp key-regexp
-					       beg end)
-  "Sort the region numerically as specified by RECORD-REGEXP and KEY.
-RECORD-REGEXP specifies the textual units which should be sorted.
-  For example, to sort lines RECORD-REGEXP would be \"^.*$\"
-KEY specifies the part of each record (ie each match for RECORD-REGEXP)
-  is to be used for sorting.
-  If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from
-  RECORD-REGEXP is used.
-  If it is \"\\\\&\" then the whole record is used.
-  Otherwise, it is a regular-expression for which to search within the record.
-If a match for KEY is not found within a record then that record is ignored.
-
-With a negative prefix arg sorts in reverse order.
-
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-For example: to sort lines in the region by the first word on each line
- starting with the letter \"f\",
- RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\\""
-  ;; using negative prefix arg to mean "reverse" is now inconsistent with
-  ;; other sort-.*fields functions but then again this was before, since it
-  ;; didn't use the magnitude of the arg to specify anything.
-  (interactive
-   ;; retrieve the region first, since pasting into the minibuffer will
-   ;; deactivate it. (YUCK! should have per-buffer regions.)
-   (let ((beg (region-beginning))
-	 (end (region-end)))
-     (list current-prefix-arg
-	   (read-string "Regexp specifying records to sort: "
-			nil 'sort-regexp-history)
-	   (read-string "Regexp specifying key within record: "
-			nil 'sort-regexp-history)
-	   beg end)))
-  (sort-regexp-fields reverse record-regexp key-regexp beg end
-		      #'(lambda (a b)
-			  (< (string-to-number a) (string-to-number b)))))
-
-
-(defvar sort-columns-subprocess t)
-
-;;;###autoload
-(defun sort-columns (reverse &optional beg end)
-  "Sort lines in region alphabetically by a certain range of columns.
-For the purpose of this command, the region BEG...END includes
-the entire line that point is in and the entire line the mark is in.
-The column positions of point and mark bound the range of columns to sort on.
-A prefix argument means sort into REVERSE order.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-Note that `sort-columns' rejects text that contains tabs,
-because tabs could be split across the specified columns
-and it doesn't know how to handle that.  Also, when possible,
-it uses the `sort' utility program, which doesn't understand tabs.
-Use \\[untabify] to convert tabs to spaces before sorting."
-  (interactive "P\nr")
-  (save-excursion
-    (let (beg1 end1 col-beg1 col-end1 col-start col-end)
-      (goto-char (min beg end))
-      (setq col-beg1 (current-column))
-      (beginning-of-line)
-      (setq beg1 (point))
-      (goto-char (max beg end))
-      (setq col-end1 (current-column))
-      (forward-line)
-      (setq end1 (point))
-      (setq col-start (min col-beg1 col-end1))
-      (setq col-end (max col-beg1 col-end1))
-      (if (search-backward "\t" beg1 t)
-	  (error "sort-columns does not work with tabs -- use M-x untabify"))
-      (if (not (or (eq system-type 'vax-vms)
-		   (text-properties-at beg1)
-		   (< (next-property-change beg1 nil end1) end1)))
-	  ;; Use the sort utility if we can; it is 4 times as fast.
-	  ;; Do not use it if there are any properties in the region,
-	  ;; since the sort utility would lose the properties.
-	  (let ((sort-args (list (if reverse "-rt\n" "-t\n")
-				 (concat "+0." (int-to-string col-start))
-				 (concat "-0." (int-to-string col-end)))))
-	    (when sort-fold-case
-	      (push "-f" sort-args))
-	    (apply #'call-process-region beg1 end1 "sort" t t nil sort-args))
-	;; On VMS, use Emacs's own facilities.
-	(save-excursion
-	  (save-restriction
-	    (narrow-to-region beg1 end1)
-	    (goto-char beg1)
-	    (sort-subr reverse 'forward-line 'end-of-line
-		       #'(lambda () (move-to-column col-start) nil)
-		       #'(lambda () (move-to-column col-end) nil))))))))
-
-;;;###autoload
-(defun reverse-region (beg end)
-  "Reverse the order of lines in a region.
-From a program takes two point or marker arguments, BEG and END."
-  (interactive "r")
-  (if (> beg end)
-      (let (mid) (setq mid end end beg beg mid)))
-  (save-excursion
-    ;; put beg at the start of a line and end and the end of one --
-    ;; the largest possible region which fits this criteria
-    (goto-char beg)
-    (or (bolp) (forward-line 1))
-    (setq beg (point))
-    (goto-char end)
-    ;; the test for bolp is for those times when end is on an empty line;
-    ;; it is probably not the case that the line should be included in the
-    ;; reversal; it isn't difficult to add it afterward.
-    (or (and (eolp) (not (bolp))) (progn (forward-line -1) (end-of-line)))
-    (setq end (point-marker))
-    ;; the real work.  this thing cranks through memory on large regions.
-    (let (ll (do t))
-      (while do
-	(goto-char beg)
-	(setq ll (cons (buffer-substring (point) (progn (end-of-line) (point)))
-		       ll))
-	(setq do (/= (point) end))
-	(delete-region beg (if do (1+ (point)) (point))))
-      (while (cdr ll)
-	(insert (car ll) "\n")
-	(setq ll (cdr ll)))
-      (insert (car ll)))))
-
-(provide 'sort)
-
-;;; sort.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/thing.el b/xemacs-packages/lisp/xemacs-base/thing.el
deleted file mode 100644
index 8e9cb31c..00000000
--- a/xemacs-packages/lisp/xemacs-base/thing.el
+++ /dev/null
@@ -1,350 +0,0 @@
-;;; thing.el --- find language-specific contiguous pieces of text
-
-;; Copyright (C) 1997 Free Software Foundation, Inc.
-;; Copyright (C) International Computer Science Institute, 1991
-
-;; Author: David Hughes 
-;; Maintainer: XEmacs Development Team
-;; Keywords: extensions, languages
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; #### FSF has thingatpt.el, which does the same thing.  Should merge
-;; or toss this.
-
-;; I wish.  The howls of pain every time I try are too overwhelming. -slb
-
-;; Authors: David Hughes 
-;;              adapted from Martin Boyer's thing.el for imouse
-;;          Martin Boyer, IREQ 
-;;              adapted from Heinz Schmidt's thing.el for sky-mouse
-;;          Heinz Schmidt, ICSI (hws@ICSI.Berkeley.EDU)
-;;              adapted from Dan L. Pierson's epoch-thing.el
-;;          Dan L. Pierson , 2/5/90
-;;              adapted from Joshua Guttman's Thing.el
-;;          Joshua Guttman, MITRE (guttman@mitre.org)
-;;              adapted from sun-fns.el by Joshua Guttman, MITRE.
-;;
-;;
-
-;;*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-;;* FUNCTION: Things are language objects contiguous pieces of text
-;;*           whose boundaries can be defined by syntax or context.
-;;*
-;;* RELATED PACKAGES: various packages built on this.
-;;*
-;;* HISTORY:
-;;* Last edited: David Hughes 21st December 1992
-;;*  jul 21 21:00 1993 (tlp00): added a kludgy thing-filename
-;;*  Feb 22 21:00 1993 (tlp00): better merge with lucid and imouse
-;;*  Dec 21 11:11 1992 (djh): added thing-report-char-p
-;;*  Nov 23 18:00 1992 (djh): merged in Guido Bosch's ideas
-;;*  Sep 10 15:35 1992 (djh): adapted for Lucid emacs19-mouse.el
-;;*  Nov 28 17:40 1991 (mb): Cleaned up, and added thing-bigger-alist.
-;;*  May 24 00:33 1991 (hws): overworked and added syntax.
-;;* Created: 2/5/90 Dan L. Pierson
-;;*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-;;; Code:
-
-(provide 'thing)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;  Customization and Entry Point  ;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar thing-boundary-alist
-  '((?w thing-word)
-    (?_ thing-symbol)
-    (?\( thing-sexp-start)
-    (?\$ thing-sexp-start)
-    (?' thing-sexp-start)
-    (?\" thing-sexp-start)
-    (?\) thing-sexp-end)
-    (?  thing-whitespace)
-    (?< thing-comment)
-    (?. thing-next-sexp))
-  "*List of pairs of the form (SYNTAX-CHAR FUNCTION) used by
-the function `thing-boundaries'.")
-
-(defvar thing-report-char-p t
-  "*Non nil means return single char boundaries if all else fails")
-
-(defvar thing-report-whitespace t
-  "*Non nil means that whitespaces are considered as things, otherwise not.")
-
-(defvar *last-thing*
-  "The last thing found by thing-boundaries.  Used for chaining commands.")
-
-;; The variable and function `thing-region' are to avoid the continual
-;; construction of cons cells as result af the thing scanner functions.
-;; This avoids unnecessary garbage collection. Guido Bosch 
-
-(defvar thing-region (cons 'nil 'nil)
-  "Cons cell that contains a region ( . )
-The function `thing-region' updates and returns it.")
-
-(defun thing-region (beginning end)
-  "Make BEGINNING the car and END the cdr of the cons cell in the
-variable `thing-region'. Return the updated cons cell"
-  (cond ((/= beginning end)
-         (setcar thing-region beginning)
-         (setcdr thing-region end)
-         thing-region)))
-
-(defvar thing-bigger-alist
-  '((word-symbol thing-symbol)
-    (symbol thing-sexp)
-    (word-sexp thing-sexp)
-    (sexp thing-up-sexp)
-    (sexp-up thing-up-sexp)
-    (line thing-paragraph)
-    (paragraph thing-page)
-    (char thing-word)
-    (word-sentence thing-sentence)
-    (sentence thing-paragraph))
-  "List of pairs to go from one thing to a bigger thing.
-See mouse-select-bigger-thing and mouse-delete-bigger-thing.")
-
-(defvar thing-word-next nil
-  "*The next bigger thing after a word.  A symbol.
-Supported values are: word-symbol, word-sexp, and word-sentence.
-Default value is word-sentence.
-Automatically becomes local when set in any fashion.")
-(make-variable-buffer-local 'thing-word-next)
-
-(defun thing-boundaries (here)
-  "Return start and end of text object at HERE using syntax table and
-thing-boundary-alist.  Thing-boundary-alist is a list of pairs of the
-form (SYNTAX-CHAR FUNCTION) where FUNCTION takes a single position
-argument and returns a cons of places (start end) representing
-boundaries of the thing at that position.
-
-Typically:
- Left or right Paren syntax indicates an s-expression.
- The end of a line marks the line including a trailing newline.
- Word syntax indicates current word.
- Symbol syntax indicates symbol.
- If it doesn't recognize one of these it selects just the character HERE.
-
-If an error occurs  during syntax scanning, the function just prints a
-message and returns `nil'."
-  (interactive "d")
-  (setq *last-thing* nil)
-  (if (save-excursion (goto-char here) (eolp))
-      (thing-get-line here)
-    (let* ((syntax (char-syntax (char-after here)))
-           (pair (assq syntax thing-boundary-alist)))
-      (cond ((and pair
-		  (or thing-report-whitespace
-		      (not (eq (car (cdr pair)) 'thing-whitespace))))
-             (funcall (car (cdr pair)) here))
-            (thing-report-char-p
-             (setq *last-thing* 'char)
-             (thing-region here (1+ here)))
-            (t
-             nil)))))
-
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;  Code Delimiters  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun thing-symbol (here)
-  "Return start and end of symbol at HERE."
-  (cond ((or (memq (char-syntax (char-after here)) '(?_ ?w))
-             (and
-              (memq (char-syntax (char-before here)) '(?_ ?w))
-              ;; point is at the end of a symbol; look from inside the symbol
-              (setq here (1- here))))
-         (setq *last-thing* 'symbol)
-         (let ((end (scan-sexps here 1)))
-           (if end
-	       (thing-region (min here (scan-sexps end -1)) end))))))
-
-(defun thing-filename (here)
-  "Return start and end of filename at HERE."
-  (cond ((and (memq (char-syntax (char-after here)) '(?w ?_ ?.))
-	      (< here (point-max)))
-         (let (start end)
-	   (save-excursion
-	     (goto-char here)
-	     (and (re-search-forward "\\s \\|:\\s\"\\|$" nil t)
-		  (goto-char (setq end (match-beginning 0)))
-		  (or
-		   (and 
-		    (re-search-backward "[^_a-zA-Z0-9---#$.~/@]+" nil t)
-		    (setq start (+ (match-beginning 0)
-				   (if (bolp)
-				       0
-				     1))))
-		   (setq start (point-min)))
-		  (thing-region (min start here) (max here end))))))))
-;~/  
-(defun thing-sexp-start (here)
-  "Return start and end of sexp starting HERE."
-  (setq *last-thing* 'sexp-start)
-  (thing-region here (scan-sexps here 1)))
-
-(defun thing-sexp-end (here)
-  "Return start and end of sexp ending HERE."
-  (setq *last-thing* 'sexp-end)
-  (thing-region (scan-sexps (1+ here) -1) (1+ here)))
-
-(defun thing-sexp (here)
-  "Return start and end of the sexp at HERE."
-  (setq *last-thing* 'sexp)
-  (save-excursion
-    (goto-char here)
-    (thing-region (progn (backward-up-list 1) (point))
-                  (progn (forward-list 1) (point)))))
-
-(defun thing-up-sexp (here)
-  "Return start and end of the sexp enclosing the selected area."
-  (setq *last-thing* 'sexp-up)
-  ;; Keep going up and backward in sexps.  This means that thing-up-sexp
-  ;; can only be called after thing-sexp or after itself.
-  (save-excursion
-    (goto-char here)
-    (thing-region (progn 
-		    (condition-case ()
-			(backward-up-list 1) (error nil))
-		    (point))
-                  (progn 
-		    (condition-case () 
-			(forward-list 1) (error nil))
-		    (point)))))
-
-;;; Allow punctuation marks not followed by white-space to include
-;;; the subsequent sexp. Useful in foo.bar(x).baz and such.
-(defun thing-next-sexp (here)
-  "Return from HERE to the end of the sexp at HERE,
-if the character at HERE is part of a sexp."
-  (setq *last-thing* 'sexp-next)
-  (if (= (char-syntax (char-after (1+ here))) ? )
-      (thing-region here (1+ here))
-    (thing-region here
-                  (save-excursion (goto-char here) (forward-sexp) (point)))))
-
-;;; Allow click to comment-char to extend to end of line
-(defun thing-comment (here)
-  "Return rest of line from HERE to newline."
-  (setq *last-thing* 'comment)
-  (save-excursion (goto-char here)
-                  (while (= (char-syntax (preceding-char)) ?<)
-                    (forward-char -1))
-                  (thing-region (point) (progn (end-of-line) (point)))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;  Text Delimiters  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun thing-word (here)
-  "Return start and end of word at HERE."
-  (setq *last-thing* 
-	(if thing-word-next
-	    thing-word-next
-	  (setq thing-word-next
-		(cond 
-		 ((memq major-mode '(emacs-lisp-mode c-mode c++-mode
-			             fortran-mode latex-mode lisp-mode
-				     perl-mode tex-mode))
-		  'word-symbol)
-		 (t 'word-sentence)))))
-  (save-excursion
-    (goto-char here)
-    (forward-word 1)
-    (let ((end (point)))
-      (forward-word -1)
-      (thing-region (point) end))))
-
-(defun thing-sentence (here)
-  "Return start and end of the sentence at HERE."
-  (setq *last-thing* 'sentence)
-  (save-excursion
-    (goto-char here)
-    (thing-region (progn (backward-sentence) (point))
-                  (progn (forward-sentence) (point)))))
-
-(defun thing-whitespace (here)
-  "Return start to end of all of whitespace HERE."
-  (setq *last-thing* 'whitespace)
-  (save-excursion
-    (goto-char here)
-    (let ((start (progn (skip-chars-backward " \t") (1+ (point))))
-          (end (progn (skip-chars-forward " \t") (point))))
-      (if (= start end)
-          (thing-region (1- start) end)
-        (thing-region start end)))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;  Physical Delimiters  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun thing-get-line (here)
-  "Return whole of line HERE is in, with newline unless at eob."
-  (setq *last-thing* 'line)
-  (save-excursion
-    (goto-char here)
-    (let* ((start (progn (beginning-of-line 1) (point))))
-      (thing-region start (point)))))
-
-(defun thing-paragraph (here)
-  "Return start and end of the paragraph at HERE."
-  (setq *last-thing* 'paragraph)
-  (save-excursion
-    (goto-char here)
-    (thing-region (progn (backward-paragraph) (point))
-                  (progn (forward-paragraph) (point)))))
-
-(defun thing-page (here)
-  "Return start and end of the page at HERE."
-  (setq *last-thing* 'page)
-  (save-excursion
-    (goto-char here)
-    (thing-region (progn (backward-page) (point))
-                  (progn (forward-page) (point)))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;  Support functions  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun kill-thing-at-point (here)
-  "Kill text object using syntax table.
-See thing-boundaries for definition of text objects"
-  (interactive "d")
-  (let ((bounds (thing-boundaries here)))
-    (kill-region (car bounds) (cdr bounds))))
-
-(defun copy-thing-at-point (here)
-  "Copy text object using syntax table.
-See thing-boundaries for definition of text objects"
-  (interactive "d")
-  (let ((bounds (thing-boundaries here)))
-    (copy-region-as-kill (car bounds) (cdr bounds))))
-
-;;; thing.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/time-stamp.el b/xemacs-packages/lisp/xemacs-base/time-stamp.el
deleted file mode 100644
index 31990a85..00000000
--- a/xemacs-packages/lisp/xemacs-base/time-stamp.el
+++ /dev/null
@@ -1,541 +0,0 @@
-;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs
-
-;; Copyright 1989, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Maintainer's Time-stamp: <95/12/28 19:48:49 gildea>
-;; Maintainer: Stephen Gildea 
-;; Keywords: tools
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: 19.34.
-
-;;; Commentary:
-
-;; If you put a time stamp template anywhere in the first 8 lines of a file,
-;; it can be updated every time you save the file.  See the top of
-;; time-stamp.el for a sample.  The template looks like one of the following:
-;;     Time-stamp: <>
-;;     Time-stamp: " "
-;; The time stamp is written between the brackets or quotes, resulting in
-;;     Time-stamp: <95/01/18 10:20:51 gildea>
-;; Here is an example that puts the file name and time stamp in the binary:
-;; static char *time_stamp = "sdmain.c Time-stamp: <>";
-
-;; To activate automatic time stamping in GNU Emacs 19, add this code
-;; to your .emacs file:
-;; (add-hook 'write-file-hooks 'time-stamp)
-;;
-;; In Emacs 18 you will need to do this instead:
-;; (if (not (memq 'time-stamp write-file-hooks))
-;;     (setq write-file-hooks
-;;           (cons 'time-stamp write-file-hooks)))
-;; (autoload 'time-stamp "time-stamp" "Update the time stamp in a buffer." t)
-
-;; See the documentation for the function `time-stamp' for more details.
-
-;;; Change Log:
-
-;; Originally based on the 19 Dec 88 version of
-;;   date.el by John Sturdy 
-;; version 2, January 1995: replaced functions with %-escapes
-;; $Id: time-stamp.el,v 1.3 2002/09/11 17:21:05 scop Exp $
-
-;;; Code:
-
-(defgroup time-stamp nil
-  "Maintain last change time stamps in files edited by Emacs."
-  :group 'data
-  :group 'extensions)
-
-
-(defcustom time-stamp-active t
-  "*Non-nil to enable time-stamping of buffers by \\[time-stamp].
-Can be toggled by \\[time-stamp-toggle-active].
-See also the variable time-stamp-warn-inactive."
-  :type 'boolean
-  :group 'time-stamp)
-
-(defcustom time-stamp-warn-inactive t
-  "*Non-nil to have \\[time-stamp] warn if a buffer did not get time-stamped.
-A warning is printed if time-stamp-active is nil and the buffer contains
-a time stamp template that would otherwise have been updated."
-  :type 'boolean
-  :group 'time-stamp)
-
-(defcustom time-stamp-format "%02y/%02m/%02d %02H:%02M:%02S %u"
-  "*Template for the string inserted by \\[time-stamp].
-Value may be a string or a list.  (Lists are supported only for
-backward compatibility.)  A string is used verbatim except
-for character sequences beginning with %:
-
-%a  weekday name: `Monday'.		%A gives uppercase: `MONDAY'
-%b  month name: `January'.		%B gives uppercase: `JANUARY'
-%d  day of month
-%H  24-hour clock hour
-%I  12-hour clock hour
-%m  month number
-%M  minute
-%p  `am' or `pm'.			%P gives uppercase: `AM' or `PM'
-%S  seconds
-%w  day number of week, Sunday is 0
-%y  year: `1995'
-%z  time zone name: `est'.		%Z gives uppercase: `EST'
-
-Non-date items:
-%%  a literal percent character: `%'
-%f  file name without directory		%F gives absolute pathname
-%s  system name
-%u  user's login name
-%h  mail host name
-
-Decimal digits between the % and the type character specify the
-field width.  Strings are truncated on the right; numbers on the left.
-A leading zero causes numbers to be zero-filled.
-
-For example, to get the format used by the `date' command,
-use \"%3a %3b %2d %02H:%02M:%02S %Z %y\""
-  :type 'string
-  :group 'time-stamp)
-
-
-;;; Do not change time-stamp-line-limit, time-stamp-start, or
-;;; time-stamp-end in your .emacs or you will be incompatible
-;;; with other people's files!  If you must change them,
-;;; do so only in the local variables section of the file itself.
-
-(defvar time-stamp-line-limit 8	    ;Do not change!
-  "Lines of a file searched; positive counts from start, negative from end.
-The patterns `time-stamp-start' and `time-stamp-end' must be found on one
-of the first (last) `time-stamp-line-limit' lines of the file for the
-file to be time-stamped by \\[time-stamp].
-
-Do not change `time-stamp-line-limit', `time-stamp-start', or
-`time-stamp-end' for yourself or you will be incompatible
-with other people's files!  If you must change them for some application,
-do so in the local variables section of the time-stamped file itself.")
-
-
-(defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+"    ;Do not change!
-  "Regexp after which the time stamp is written by \\[time-stamp].
-See also the variables `time-stamp-end' and `time-stamp-line-limit'.
-
-Do not change `time-stamp-line-limit', `time-stamp-start', or
-`time-stamp-end' for yourself or you will be incompatible
-with other people's files!  If you must change them for some application,
-do so in the local variables section of the time-stamped file itself.")
-
-
-(defvar time-stamp-end "\\\\?[\">]"    ;Do not change!
-  "Regexp marking the text after the time stamp.
-\\[time-stamp] deletes the text between the first match of `time-stamp-start'
-and the following match of `time-stamp-end' on the same line,
-then writes the time stamp specified by `time-stamp-format' between them.
-
-Do not change `time-stamp-line-limit', `time-stamp-start', or
-`time-stamp-end' for yourself or you will be incompatible
-with other people's files!  If you must change them for some application,
-do so in the local variables section of the time-stamped file itself.")
-
-
-;;;###autoload
-(defun time-stamp ()
-  "Update the time stamp string in the buffer.
-If you put a time stamp template anywhere in the first 8 lines of a file,
-it can be updated every time you save the file.  See the top of
-`time-stamp.el' for a sample.  The template looks like one of the following:
-    Time-stamp: <>
-    Time-stamp: \" \"
-The time stamp is written between the brackets or quotes, resulting in
-    Time-stamp: <95/01/18 10:20:51 gildea>
-Only does its thing if the variable  time-stamp-active  is non-nil.
-Typically used on  write-file-hooks  for automatic time-stamping.
-The format of the time stamp is determined by the variable  time-stamp-format.
-The variables time-stamp-line-limit, time-stamp-start, and time-stamp-end
-control finding the template."
-  (interactive)
-  (let ((case-fold-search nil)
-	(need-to-warn nil)
-	start search-end)
-    (if (and (stringp time-stamp-start)
-	     (stringp time-stamp-end))
-	(save-excursion
-	  (save-restriction
-	    (widen)
-	    (if (> time-stamp-line-limit 0)
-		(progn
-		  (goto-char (setq start (point-min)))
-		  (forward-line time-stamp-line-limit)
-		  (setq search-end (point)))
-	      (goto-char (setq search-end (point-max)))
-	      (forward-line time-stamp-line-limit)
-	      (setq start (point)))
-	    (goto-char start)
-	    (while
-		(and (< (point) search-end)
-		     (re-search-forward time-stamp-start search-end 'move))
-	      (setq start (point))
-	      (end-of-line)
-	      (let ((line-end (point)))
-		(goto-char start)
-		(if (re-search-forward time-stamp-end line-end 'move)
-		    (progn
-		      (if time-stamp-active
-			  (let ((end (match-beginning 0)))
-			    (delete-region start end)
-			    (goto-char start)
-			    (insert (time-stamp-string))
-			    (setq end (point))
-			    ;; remove any tabs used to format time stamp
-			    (goto-char start)
-			    (if (search-forward "\t" end t)
-				(untabify start end)))
-			(if time-stamp-warn-inactive
-			    ;; do warning outside save-excursion
-			    (setq need-to-warn t)))
-		      (setq search-end (point))))))))
-      ;; don't signal an error in a write-file-hook
-      (message "time-stamp-start or time-stamp-end is not a string")
-      (sit-for 1))
-    (if need-to-warn
-	(progn
-	  (message "Warning: time-stamp-active is off; did not time-stamp buffer.")
-	  (sit-for 1))))
-  ;; be sure to return nil so can be used on write-file-hooks
-  nil)
-
-;;;###autoload
-(defun time-stamp-toggle-active (&optional arg)
-  "Toggle time-stamp-active, setting whether \\[time-stamp] updates a buffer.
-With arg, turn time stamping on if and only if arg is positive."
-  (interactive "P")
-  (setq time-stamp-active
-	(if (null arg)
-	    (not time-stamp-active)
-	  (> (prefix-numeric-value arg) 0)))
-  (message "time-stamp is now %s." (if time-stamp-active "active" "off")))
-
-
-(defun time-stamp-string ()
-  "Generate the new string to be inserted by \\[time-stamp]."
-  (if (stringp time-stamp-format)
-      (time-stamp-strftime time-stamp-format)
-    (time-stamp-fconcat time-stamp-format " "))) ;version 1 compatibility
-
-(defconst time-stamp-month-numbers
-  '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
-    ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
-  "Alist of months and their number.")
-
-(defconst time-stamp-month-full-names
-  ["(zero)" "January" "February" "March" "April" "May" "June"
-   "July" "August" "September" "October" "November" "December"])
-
-(defconst time-stamp-weekday-numbers
-  '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
-    ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))
-  "Alist of weekdays and their number.")
-
-(defconst time-stamp-weekday-full-names
-  ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"])
-
-(defconst time-stamp-am-pm '("am" "pm")
-  "List of strings used to denote morning and afternoon.")
-
-(defconst time-stamp-no-file "(no file)"
-  "String to use when the buffer is not associated with a file.")
-
-(defun time-stamp-strftime (format &optional time)
-  "Uses a FORMAT to format date, time, file, and user information.
-Optional second argument TIME will be used instead of the current time.
-See the description of the variable `time-stamp-format' for a description
-of the format string."
-  (let ((time-string (cond ((stringp time)
-			    time)
-			   (time
-			    (current-time-string time))
-			   (t
-			    (current-time-string))))
-	(fmt-len (length format))
-	(ind 0)
-	cur-char
-	(prev-char nil)
-	(result "")
-	field-index
-	field-width
-	field-result
-	(paren-level 0))
-    (while (< ind fmt-len)
-      (setq cur-char (aref format ind))
-      (setq
-       result
-       (concat result 
-      (cond
-       ((eq cur-char ?%)
-	(setq field-index (1+ ind))
-	(while (progn
-		 (setq ind (1+ ind))
-		 (setq cur-char (if (< ind fmt-len)
-				    (aref format ind)
-				  ?\0))
-		 (and (<= ?0 cur-char) (>= ?9 cur-char))))
-	(setq field-width (substring format field-index ind))
-	;; eat any additional args to allow for future expansion
-	(while (or (and (<= ?0 cur-char) (>= ?9 cur-char)) (eq ?. cur-char)
-		   (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
-		   (eq ?- cur-char) (eq ?+ cur-char)
-		   (eq ?\  cur-char) (eq ?# cur-char)
-		   (and (eq ?\( cur-char)
-			(not (eq prev-char ?\\))
-			(setq paren-level (1+ paren-level)))
-		   (if (and (eq ?\) cur-char)
-			    (not (eq prev-char ?\\))
-			    (> paren-level 0))
-		       (setq paren-level (1- paren-level))
-		     (and (> paren-level 0)
-			  (< ind fmt-len))))
-	  (setq ind (1+ ind))
-	  (setq prev-char cur-char)
-	  (setq cur-char (if (< ind fmt-len)
-			     (aref format ind)
-			   ?\0)))
-	(setq field-result
-	(cond
-	 ((eq cur-char ?%)
-	  "%")
-	 ((or (eq cur-char ?a)		;weekday name
-	      (eq cur-char ?A))
-	  (let ((name
-		 (aref time-stamp-weekday-full-names
-		       (cdr (assoc (substring time-string 0 3)
-				   time-stamp-weekday-numbers)))))
-	    (if (eq cur-char ?a)
-		name
-	      (upcase name))))
-	 ((or (eq cur-char ?b)		;month name
-	      (eq cur-char ?B))
-	  (let ((name
-		 (aref time-stamp-month-full-names
-		       (cdr (assoc (substring time-string 4 7)
-				   time-stamp-month-numbers)))))
-	    (if (eq cur-char ?b)
-		name
-	      (upcase name))))
-	 ((eq cur-char ?d)		;day of month, 1-31
-	  (string-to-int (substring time-string 8 10)))
-	 ((eq cur-char ?H)		;hour, 0-23
-	  (string-to-int (substring time-string 11 13)))
-	 ((eq cur-char ?I)		;hour, 1-12
-	  (let ((hour (string-to-int (substring time-string 11 13))))
-	    (cond ((< hour 1)
-		   (+ hour 12))
-		  ((> hour 12)
-		   (- hour 12))
-		  (t
-		   hour))))
-	 ((eq cur-char ?m)		;month number, 1-12
-	  (cdr (assoc (substring time-string 4 7)
-		      time-stamp-month-numbers)))
-	 ((eq cur-char ?M)		;minute, 0-59
-	  (string-to-int (substring time-string 14 16)))
-	 ((or (eq cur-char ?p)		;am or pm
-	      (eq cur-char ?P))
-	  (let ((name
-		 (if (> 12 (string-to-int (substring time-string 11 13)))
-		     (car time-stamp-am-pm)
-		   (car (cdr time-stamp-am-pm)))))
-	    (if (eq cur-char ?p)
-		name
-	      (upcase name))))
-	 ((eq cur-char ?S)		;seconds, 00-60
-	  (string-to-int (substring time-string 17 19)))
-	 ((eq cur-char ?w)		;weekday number, Sunday is 0
-	  (cdr (assoc (substring time-string 0 3) time-stamp-weekday-numbers)))
-	 ((eq cur-char ?y)		;year
-	  (string-to-int (substring time-string -4)))
-	 ((or (eq cur-char ?z)		;time zone
-	      (eq cur-char ?Z))
-	  (let ((name
-		 (if (fboundp 'current-time-zone)
-		     (car (cdr (current-time-zone time))))))
-	    (or name (setq name ""))
-	    (if (eq cur-char ?z)
-		(downcase name)
-	      (upcase name))))
-	 ((eq cur-char ?f)		;buffer-file-name, base name only
-	  (if buffer-file-name
-	      (file-name-nondirectory buffer-file-name)
-	    time-stamp-no-file))
-	 ((eq cur-char ?F)		;buffer-file-name, full path
-	  (or buffer-file-name
-	      time-stamp-no-file))
-	 ((eq cur-char ?s)		;system name
-	  (system-name))
-	 ((eq cur-char ?u)		;user name
-	  (user-login-name))
-	 ((eq cur-char ?h)		;mail host name
-	  (time-stamp-mail-host-name))
-	 ))
-	(if (string-equal field-width "")
-	    (if (numberp field-result) 
-		(number-to-string field-result)
-	      field-result)
-	  (let ((padded-result
-		 (format (format "%%%s%c"
-				 field-width
-				 (if (numberp field-result) ?d ?s))
-			 (or field-result ""))))
-	    (let ((initial-length (length padded-result))
-		  (desired-length (string-to-int field-width)))
-	      (if (> initial-length desired-length)
-		  ;; truncate strings on right, numbers on left
-		  (if (stringp field-result)
-		      (substring padded-result 0 desired-length)
-		    (substring padded-result (- desired-length)))
-		padded-result)))))
-       (t
-	(char-to-string cur-char)))))
-      (setq ind (1+ ind)))
-    result))
-
-(defun time-stamp-mail-host-name ()
-  "Return the name of the host where the user receives mail.
-This is the value of `mail-host-address' if bound and a string,
-otherwise the value of `time-stamp-mail-host' (for versions of Emacs
-before 19.29) otherwise the value of the function system-name."
-  (or (and (boundp 'mail-host-address)
-	   (stringp mail-host-address)
-	   mail-host-address)
-      (and (boundp 'time-stamp-mail-host) ;for backward compatibility
-	   (stringp time-stamp-mail-host)
-	   time-stamp-mail-host)
-      (system-name)))
-
-;;; the rest of this file is for version 1 compatibility
-
-(defun time-stamp-fconcat (list sep)
-  "Similar to (mapconcat 'funcall LIST SEP) but LIST allows literals.
-If an element of LIST is a symbol, it is funcalled to get the string to use;
-the separator SEP is used between two strings obtained by funcalling a
-symbol.  Otherwise the element itself is inserted; no separator is used
-around literals."
-  (let ((return-string "")
-	(insert-sep-p nil))
-    (while list
-      (cond ((symbolp (car list))
-	     (if insert-sep-p
-		 (setq return-string (concat return-string sep)))
-	     (setq return-string (concat return-string (funcall (car list))))
-	     (setq insert-sep-p t))
-	    (t
-	     (setq return-string (concat return-string (car list)))
-	     (setq insert-sep-p nil)))
-      (setq list (cdr list)))
-    return-string))
-
-
-;;; Some useful functions to use in time-stamp-format
-
-;;; Could generate most of a message-id with
-;;; '(time-stamp-yymmdd "" time-stamp-hhmm "@" time-stamp-mail-host-name)
-
-;;; pretty form, suitable for a title page
-
-(defun time-stamp-month-dd-yyyy ()
-  "Return the current date as a string in \"Month DD, YYYY\" form."
-  (let ((date (current-time-string)))
-    (format "%s %d, %s"
-	    (aref time-stamp-month-full-names
-		  (cdr (assoc (substring date 4 7) time-stamp-month-numbers)))
-	    (string-to-int (substring date 8 10))
-	    (substring date -4))))
-
-;;; same as __DATE__ in ANSI C
-
-(defun time-stamp-mon-dd-yyyy ()
-  "Return the current date as a string in \"Mon DD YYYY\" form.
-The first character of DD is space if the value is less than 10."
-  (let ((date (current-time-string)))
-    (format "%s %2d %s"
-	    (substring date 4 7)
-	    (string-to-int (substring date 8 10))
-	    (substring date -4))))
-
-;;; RFC 822 date
-
-(defun time-stamp-dd-mon-yy ()
-  "Return the current date as a string in \"DD Mon YY\" form."
-  (let ((date (current-time-string)))
-    (format "%02d %s %s"
-	    (string-to-int (substring date 8 10))
-	    (substring date 4 7)
-	    (substring date -2))))
-
-;;; RCS 3 date
-
-(defun time-stamp-yy/mm/dd ()
-  "Return the current date as a string in \"YY/MM/DD\" form."
-  (let ((date (current-time-string)))
-    (format "%s/%02d/%02d"
-	    (substring date -2)
-	    (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
-	    (string-to-int (substring date 8 10)))))
-
-;;; RCS 5 date
-
-(defun time-stamp-yyyy/mm/dd ()
-  "Return the current date as a string in \"YYYY/MM/DD\" form."
-  (let ((date (current-time-string)))
-    (format "%s/%02d/%02d"
-	    (substring date -4)
-	    (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
-	    (string-to-int (substring date 8 10)))))
-
-;;; ISO 8601 date
-
-(defun time-stamp-yyyy-mm-dd ()
-  "Return the current date as a string in \"YYYY-MM-DD\" form."
-  (let ((date (current-time-string)))
-    (format "%s-%02d-%02d"
-	    (substring date -4)
-	    (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
-	    (string-to-int (substring date 8 10)))))
-
-(defun time-stamp-yymmdd ()
-  "Return the current date as a string in \"YYMMDD\" form."
-  (let ((date (current-time-string)))
-    (format "%s%02d%02d"
-	    (substring date -2)
-	    (cdr (assoc (substring date 4 7) time-stamp-month-numbers))
-	    (string-to-int (substring date 8 10)))))
-
-(defun time-stamp-hh:mm:ss ()
-  "Return the current time as a string in \"HH:MM:SS\" form."
-  (substring (current-time-string) 11 19))
-
-(defun time-stamp-hhmmss ()
-  "Return the current time as a string in \"HHMMSS\" form."
-  (replace-in-string (substring (current-time-string) 11 19) ":" ""))
-
-(defun time-stamp-hhmm ()
-  "Return the current time as a string in \"HHMM\" form."
-  (let ((date (current-time-string)))
-    (concat (substring date 11 13)
-	    (substring date 14 16))))
-
-(provide 'time-stamp)
-
-;;; time-stamp.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/timer-funcs.el b/xemacs-packages/lisp/xemacs-base/timer-funcs.el
deleted file mode 100644
index b84c4706..00000000
--- a/xemacs-packages/lisp/xemacs-base/timer-funcs.el
+++ /dev/null
@@ -1,291 +0,0 @@
-;;; timer-funcs.el --- timer implementation-independent functions
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 contains functions from Emacs timer.el that do not take timer
-;; objects as parameters.  This lets us use itimers as the implementation,
-;; instead of emulated Emacs timers.  Note that a few of these functions
-;; RETURN itimers, however.
-
-;;; Code:
-
-(require 'itimer)
-
-(defun timer-next-integral-multiple-of-time (time secs)
-  "Yield the next value after TIME that is an integral multiple of SECS.
-More precisely, the next value, after TIME, that is an integral multiple
-of SECS seconds since the epoch.  SECS may be a fraction."
-  (let* ((time-base (ash 1 16))
-	 (float-time-base (float time-base))
-	 (million 1000000.0)
-	 (time-usec (+ (* million (+ (* float-time-base (nth 0 time))
-				     (nth 1 time)))
-		       (nth 2 time)))
-	 (secs-usec (* million secs))
-	 (mod-usec (mod time-usec secs-usec))
-	 (next-usec (+ (- time-usec mod-usec) secs-usec))
-	 (time-base-million (* float-time-base million)))
-    (list (floor next-usec time-base-million)
-	  (floor (mod next-usec time-base-million) million)
-	  (floor (mod next-usec million)))))
-
-(defun timer-relative-time (time secs &optional usecs)
-  "Advance TIME by SECS seconds and optionally USECS microseconds.
-SECS may be a fraction."
-  (let ((high (car time))
-	(low (if (consp (cdr time)) (nth 1 time) (cdr time)))
-	(micro (if (numberp (car-safe (cdr-safe (cdr time))))
-		   (nth 2 time)
-		 0)))
-    ;; Add
-    (if usecs (setq micro (+ micro usecs)))
-    (if (floatp secs)
-	(setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
-    (setq low (+ low (floor secs)))
-
-    ;; Normalize
-    ;; `/' rounds towards zero while `mod' returns a positive number,
-    ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
-    (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
-    (setq micro (mod micro 1000000))
-    (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
-    (setq low (logand low 65535))
-
-    (list high low (and (/= micro 0) micro))))
-
-(defun cancel-function-timers (function)
-  "Cancel all itimers scheduled by `run-at-time' which would run FUNCTION."
-  (interactive "aCancel itimers of function: ")
-  (dolist (itimer itimer-list)
-    (if (eq (itimer-function itimer) function)
-	(delete-itimer itimer))))
-
-(define-error 'invalid-repetition-interval "Invalid repetition interval")
-(define-error 'invalid-time "Invalid time format")
-
-;;;###autoload
-(defun run-at-time (time repeat function &rest args)
-  "Perform an action at time TIME.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-TIME should be a string recognized by `timer-parse-time', like \"11:23pm\",
-nil meaning now, a number of seconds from now, a value from `current-time',
-or t (with non-nil REPEAT) meaning the next integral multiple of REPEAT.
-REPEAT may be an integer or floating point number.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns an itimer object which you can use in `delete-itimer'."
-  (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
-
-  (or (null repeat)
-      (and (numberp repeat) (< 0 repeat))
-      (error 'invalid-repetition-interval repeat))
-
-  ;; Special case: nil means "now" and is useful when repeating.
-  (if (null time)
-      (setq time 0))
-
-  ;; Special case: t means the next integral multiple of REPEAT.
-  (if (and (eq time t) repeat)
-      (let ((now (current-time)))
-	(setq time
-	      (itimer-time-difference
-	       (timer-next-integral-multiple-of-time now repeat)
-	       now))))
-
-  ;; Handle relative times like "2 hours and 35 minutes"
-  (if (stringp time)
-      (let ((spec-time (timer-duration time)))
-	(if spec-time
-	    (setq time spec-time))))
-
-  ;; Handle "11:23pm" and the like.  Interpret it as meaning today
-  ;; which admittedly is rather stupid if we have passed that time
-  ;; already.  (Though only Emacs hackers hack Emacs at that time.)
-  (if (stringp time)
-      (let ((spec-time (timer-parse-time time)))
-	(if spec-time
-	    (setq time
-		  (ceiling
-		   (itimer-time-difference spec-time (current-time)))))))
-
-  (or (numberp time)
-      (error 'invalid-time time))
-
-  (apply #'start-itimer "run-at-time" function time repeat nil t args))
-
-;;;###autoload
-(defun run-with-timer (secs repeat function &rest args)
-  "Perform an action after a delay of SECS seconds.
-Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-SECS and REPEAT may be integers or floating point numbers.
-The action is to call FUNCTION with arguments ARGS.
-
-This function returns an itimer object which you can use in `delete-itimer'."
-  (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
-  (apply #'start-itimer "run-with-timer" function secs repeat nil t args))
-
-;;;###autoload
-(defun run-with-idle-timer (secs repeat function &rest args)
-  "Perform an action the next time XEmacs is idle for SECS seconds.
-The action is to call FUNCTION with arguments ARGS.
-SECS may be an integer or a floating point number.
-
-If REPEAT is non-nil, do the action each time XEmacs has been idle for
-exactly SECS seconds (that is, only once for each time XEmacs becomes idle).
-
-This function returns an itimer object which you can use in `delete-itimer'."
-  (interactive
-   (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
-	 (y-or-n-p "Repeat each time XEmacs is idle? ")
-	 (intern (completing-read "Function: " obarray 'fboundp t))))
-  (apply #'start-itimer "run-with-idle-timer" function secs
-	 (if repeat secs nil) t t args))
-
-(defun with-timeout-handler (tag)
-  (throw tag 'timeout))
-
-;;;###autoload (put 'with-timeout 'lisp-indent-function 1)
-
-;;;###autoload
-(defmacro with-timeout (list &rest body)
-  "Run BODY, but if it doesn't finish in SECONDS seconds, give up.
-If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
-The call should look like:
- (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
-The timeout is checked whenever XEmacs waits for some kind of external
-event \(such as keyboard input, input from subprocesses, or a certain time);
-if the program loops without waiting in any way, the timeout will not
-be detected."
-  (let ((seconds (car list))
-	(timeout-forms (cdr list)))
-    `(let ((with-timeout-tag (cons nil nil))
-	   with-timeout-value with-timeout-timer)
-       (unwind-protect
-	   (when (catch with-timeout-tag
-		   (progn
-		     (setq with-timeout-timer
-			   (start-itimer "with-timeout" #'with-timeout-handler
-					 ,seconds nil nil t with-timeout-tag))
-		     (setq with-timeout-value (progn ,@body))
-		     nil))
-	     ,@timeout-forms
-	     with-timeout-value)
-	 (delete-itimer with-timeout-timer)))))
-
-
-;;;###autoload
-(defun y-or-n-p-with-timeout (prompt seconds default-value)
-  "Like (y-or-n-p PROMPT), with a timeout.
-If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
-  (with-timeout (seconds default-value)
-    (y-or-n-p prompt)))
-
-(defvar timer-duration-words
-  (list (cons "microsec" 0.000001)
-	(cons "microsecond" 0.000001)
-        (cons "millisec" 0.001)
-	(cons "millisecond" 0.001)
-        (cons "sec" 1)
-	(cons "second" 1)
-	(cons "min" 60)
-	(cons "minute" 60)
-	(cons "hour" (* 60 60))
-	(cons "day" (* 24 60 60))
-	(cons "week" (* 7 24 60 60))
-	(cons "fortnight" (* 14 24 60 60))
-	(cons "month" (* 30 24 60 60))	  ; Approximation
-	(cons "year" (* 365.25 24 60 60)) ; Approximation
-	)
-  "Alist mapping temporal words to durations in seconds")
-
-(defun timer-duration (string)
-  "Return number of seconds specified by STRING, or nil if parsing fails."
-  (let ((secs 0)
-	(start 0)
-	(case-fold-search t))
-    (while (string-match
-	    "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*"
-	    string start)
-      (let ((count (if (match-beginning 1)
-		       (string-to-number (match-string 1 string))
-		     1))
-	    (itemsize (cdr (assoc (match-string 2 string)
-				  timer-duration-words))))
-	(if itemsize
-	    (setq start (match-end 0)
-		  secs (+ secs (* count itemsize)))
-	  (setq secs nil
-		start (length string)))))
-    (if (= start (length string))
-	secs
-      (if (string-match "\\`[0-9.]+\\'" string)
-	  (string-to-number string)))))
-
-(defun timer-parse-time (s)
-  "Return an encoded time represesnting the time specifed by S.
-This is a time in the same format as returned by `current-time'.  This
-function assumes that the specified time is during the current day.
-S can be of the form XXXX, X:XX, XX:XX, XXXXXX, X:XX:XX, or XX:XX:XX (military
-time), or any of the above followed by \"am\", \"AM\", \"pm\", or \"PM\".  If
-S does not describe a recognizable time, nil is returned."
-  (let ((case-fold-search t)
-	(now (decode-time))
-	hour minute second)
-    (cond ((string-match;; Hour only  XXam or XXpm
-	    "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
-	   (setq hour (+ (% (string-to-number (match-string 1 s)) 12)
-			 (if (char-equal ?a (aref s (match-beginning 2)))
-			     0 12))
-		 minute 0
-		 second 0))
-	  ((string-match;; Hour and minute  XX:XXam or XX:XXpm
-	    "^[ \t]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
-	   (setq hour (+ (% (string-to-number (match-string 1 s)) 12)
-			 (if (char-equal ?a (aref s (match-beginning 3)))
-			     0 12))
-		 minute (string-to-number (match-string 2 s))
-		 second 0))
-	  ((string-match;; Hour, minute, and seconds  XX:XX:XXam or XX:XX:XXpm
-	    "^[ \t]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
-	   (setq hour (+ (% (string-to-number (match-string 1 s)) 12)
-			 (if (char-equal ?a (aref s (match-beginning 4)))
-			     0 12))
-		 minute (string-to-number (match-string 2 s))
-		 second (string-to-number (match-string 3 s))))
-	  ((string-match;; Military time  
-	    "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)[:.]?\\([0-9][0-9]\\)?\\(\\>\\|[^ap]\\)" s)
-	   (setq hour (string-to-number (match-string 1 s))
-		 minute (string-to-number (match-string 2 s))
-		 second (if (match-beginning 3)
-			    (string-to-number (match-string 3 s))
-			  0))))
-    (if hour
-	(nconc
-	 (encode-time
-	  second minute hour (nth 3 now) (nth 4 now) (nth 5 now) (nth 8 now))
-	 '(0)))))
-
-(provide 'timer-funcs)
-
-;;; timer-funcs.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/timezone.el b/xemacs-packages/lisp/xemacs-base/timezone.el
deleted file mode 100644
index b5b7708f..00000000
--- a/xemacs-packages/lisp/xemacs-base/timezone.el
+++ /dev/null
@@ -1,430 +0,0 @@
-;;; timezone.el --- time zone package for XEmacs
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 1996, 1999 Free Software Foundation, Inc.
-
-;; Author: Masanobu Umeda
-;; Maintainer: XEmacs Development Team
-;; Keywords: news
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-
-;; Modified 1 February 1994 by Kyle Jones to fix broken
-;; timezone-floor function.
-
-;; Modified 25 January 1994 by Kyle Jones so that it will
-;; work under version 18 of Emacs.  Provided timezone-floor
-;; and timezone-abs functions.
-
-;;; Code:
-
-(defvar timezone-world-timezones
-  '(("PST" .  -800)
-    ("PDT" .  -700)
-    ("MST" .  -700)
-    ("MDT" .  -600)
-    ("CST" .  -600)
-    ("CDT" .  -500)
-    ("EST" .  -500)
-    ("EDT" .  -400)
-    ("AST" .  -400)			;by 
-    ("NST" .  -330)			;by 
-    ("UT"  .  +000)
-    ("GMT" .  +000)
-    ("BST" .  +100)
-    ("MET" .  +100)
-    ("EET" .  +200)
-    ("JST" .  +900)
-    ("GMT+1"  .  +100) ("GMT+2"  .  +200) ("GMT+3"  .  +300)
-    ("GMT+4"  .  +400) ("GMT+5"  .  +500) ("GMT+6"  .  +600)
-    ("GMT+7"  .  +700) ("GMT+8"  .  +800) ("GMT+9"  .  +900)
-    ("GMT+10" . +1000) ("GMT+11" . +1100) ("GMT+12" . +1200) ("GMT+13" . +1300)
-    ("GMT-1"  .  -100) ("GMT-2"  .  -200) ("GMT-3"  .  -300)
-    ("GMT-4"  .  -400) ("GMT-5"  .  -500) ("GMT-6"  .  -600)
-    ("GMT-7"  .  -700) ("GMT-8"  .  -800) ("GMT-9"  .  -900)
-    ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200))
-  "*Time differentials of timezone from GMT in +-HHMM form.
-This list is obsolescent, and is present only for backwards compatibility,
-because time zone names are ambiguous in practice.
-Use `current-time-zone' instead.")
-
-(defvar timezone-months-assoc
-  '(("JAN" .  1)("FEB" .  2)("MAR" .  3)
-    ("APR" .  4)("MAY" .  5)("JUN" .  6)
-    ("JUL" .  7)("AUG" .  8)("SEP" .  9)
-    ("OCT" . 10)("NOV" . 11)("DEC" . 12))
-  "Alist of first three letters of a month and its numerical representation.")
-
-(defun timezone-make-date-arpa-standard (date &optional local timezone)
-  "Convert DATE to an arpanet standard date.
-Optional 2nd argument LOCAL specifies the default local timezone of the DATE;
-if nil, GMT is assumed.
-Optional 3rd argument TIMEZONE specifies a time zone to be represented in;
-if nil, the local time zone is assumed."
-  (let ((new (timezone-fix-time date local timezone)))
-    (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2)
-			     (timezone-make-time-string
-			      (aref new 3) (aref new 4) (aref new 5))
-			     (aref new 6))
-    ))
-
-(defun timezone-make-date-sortable (date &optional local timezone)
-  "Convert DATE to a sortable date string.
-Optional 2nd argument LOCAL specifies the default local timezone of the DATE;
-if nil, GMT is assumed.
-Optional 3rd argument TIMEZONE specifies a timezone to be represented in;
-if nil, the local time zone is assumed."
-  (let ((new (timezone-fix-time date local timezone)))
-    (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2)
-				 (timezone-make-time-string
-				  (aref new 3) (aref new 4) (aref new 5)))
-    ))
-
-
-;;
-;; Parsers and Constructors of Date and Time
-;;
-
-(defun timezone-make-arpa-date (year month day time &optional timezone)
-  "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME.
-Optional argument TIMEZONE specifies a time zone."
-  (let ((zone
-	 (if (listp timezone)
-	     (let* ((m (timezone-zone-to-minute timezone))
-		    (absm (if (< m 0) (- m) m)))
-	       (format "%c%02d%02d"
-		       (if (< m 0) ?- ?+) (/ absm 60) (% absm 60)))
-	   timezone)))
-    (format "%02d %s %04d %s %s"
-	    day
-	    (capitalize (car (rassq month timezone-months-assoc)))
-	    year
-	    time
-	    zone)))
-
-(defun timezone-make-sortable-date (year month day time)
-  "Make sortable date string from YEAR, MONTH, DAY, and TIME."
-  (format "%4d%02d%02d%s"
-	  year month day time))
-
-(defun timezone-make-time-string (hour minute second)
-  "Make time string from HOUR, MINUTE, and SECOND."
-  (format "%02d:%02d:%02d" hour minute second))
-
-;;;###autoload
-(define-error 'invalid-date "Invalid date string")
-
-(defun timezone-parse-date (date)
-  "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
-Two-digit dates are `windowed'.  Those <69 have 2000 added; otherwise 1900
-is added.  Three-digit dates have 1900 added.
-TIMEZONE is nil for DATEs without a zone field.
-
-Understands the following styles:
- (1) 14 Apr 89 03:20[:12] [GMT]
- (2) Fri, 17 Mar 89 4:01[:33] [GMT]
- (3) Mon Jan 16 16:12[:37] [GMT] 1989
- (4) 6 May 1992 1641-JST (Wednesday)
- (5) 22-AUG-1993 10:59:12.82
- (6) Thu, 11 Apr 16:17:12 91 [MET]
- (7) Mon, 6  Jul 16:47:20 T 1992 [MET]
- (8) 1996-06-24 21:13:12 [GMT]
- (9) 1996-06-24 21:13-ZONE"
-  ;; XEmacs addition: surround with condition-case
-  (condition-case nil
-      (progn
- ;; Get rid of any text properties.
-  (and (stringp date)
-       (or (text-properties-at 0 date)
-	   (next-property-change 0 date))
-       (setq date (copy-sequence date))
-       (set-text-properties 0 (length date) nil date))
-  (let ((date (or date ""))
-	(year nil)
-	(month nil)
-	(day nil)
-	(time nil)
-	(zone nil))			;This may be nil.
-    (cond ((string-match
-	    "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
-	   ;; Styles: (1) and (2) with timezone and buggy timezone
-	   ;; This is most common in mail and news,
-	   ;; so it is worth trying first.
-	   (setq year 3 month 2 day 1 time 4 zone 5))
-	  ((string-match
-	    "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date)
-	   ;; Styles: (1) and (2) without timezone
-	   (setq year 3 month 2 day 1 time 4 zone nil))
-	  ((string-match
-	    "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date)
-	   ;; Styles: (6) and (7) without timezone
-	   (setq year 6 month 3 day 2 time 4 zone nil))
-	  ((string-match
-	    "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
-	   ;; Styles: (6) and (7) with timezone and buggy timezone
-	   (setq year 6 month 3 day 2 time 4 zone 7))
-	  ((string-match
-	    "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date)
-	   ;; Styles: (3) without timezone
-	   (setq year 4 month 1 day 2 time 3 zone nil))
-	  ((string-match
-	    "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date)
-	   ;; Styles: (3) with timezone
-	   (setq year 5 month 1 day 2 time 3 zone 4))
-	  ((string-match
-	    "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
-	   ;; Styles: (4) with timezone
-	   (setq year 3 month 2 day 1 time 4 zone 5))
-	  ((string-match
-	    "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
-	   ;; Styles: (5) with timezone.
-	   (setq year 3 month 2 day 1 time 4 zone 6))
-	  ((string-match
-	    "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?" date)
-	   ;; Styles: (5) without timezone.
-	   (setq year 3 month 2 day 1 time 4 zone nil))
-	  ((string-match
-	    "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
-	   ;; Styles: (8) with timezone.
-	   (setq year 1 month 2 day 3 time 4 zone 5))
-	  ((string-match
-	    "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+\\)[ \t]+\\([-+a-zA-Z0-9:]+\\)" date)
-	   ;; Styles: (8) with timezone with a colon in it.
-	   (setq year 1 month 2 day 3 time 4 zone 5))
-	  ((string-match
-	    "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)" date)
-	   ;; Styles: (8) without timezone.
-	   (setq year 1 month 2 day 3 time 4 zone nil))
-	  )
-    (when year
-      (setq year (match-string year date))
-      ;; Guess ambiguous years.  Assume years < 69 don't predate the
-      ;; Unix Epoch, so are 2000+.  Three-digit years are assumed to
-      ;; be relative to 1900.
-      (if (< (length year) 4)
-	  (let ((y (string-to-int year)))
-	    (if (< y 69)
-		(setq y (+ y 100)))
-	    (setq year (int-to-string (+ 1900 y)))))
-      (setq month
-	    (if (= (aref date (+ (match-beginning month) 2)) ?-)
-		;; Handle numeric months, spanning exactly two digits.
-		(substring date
-			   (match-beginning month)
-			   (+ (match-beginning month) 2))
-	      (let* ((string (substring date
-					(match-beginning month)
-					(+ (match-beginning month) 3)))
-		     (monthnum
-		      (cdr (assoc (upcase string) timezone-months-assoc))))
-		(if monthnum
-		    (int-to-string monthnum)))))
-      (setq day (match-string day date))
-      (setq time (match-string time date)))
-    (if zone (setq zone (match-string zone date)))
-    ;; Return a vector.
-    (if (and year month)
-	(vector year month day time zone)
-      (vector "0" "0" "0" "0" nil))))
-    (t (signal 'invalid-date (list date)))))
-
-(defun timezone-parse-time (time)
-  "Parse TIME (HH:MM:SS) and return a vector [hour minute second].
-Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."
-  (let ((time (or time ""))
-	hour minute second)
-    (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time)
-	   ;; HH:MM:SS
-	   (setq hour 1 minute 2 second 3))
-	  ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time)
-	   ;; HH:MM
-	   (setq hour 1 minute 2 second nil))
-	  ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time)
-	   ;; HHMMSS
-	   (setq hour 1 minute 2 second 3))
-	  ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time)
-	   ;; HHMM
-	   (setq hour 1 minute 2 second nil))
-	  )
-    ;; Return [hour minute second]
-    (vector
-     (if hour (match-string hour time) "0")
-     (if minute (match-string minute time) "0")
-     (if second (match-string second time) "0"))))
-
-
-;; Miscellaneous
-
-(defun timezone-zone-to-minute (timezone)
-  "Translate TIMEZONE to an integer minute offset from GMT.
-TIMEZONE can be a cons cell containing the output of current-time-zone,
-or an integer of the form +-HHMM, or a time zone name."
-  (cond
-     ((consp timezone)
-      (/ (car timezone) 60))
-     (timezone
-      (progn
-	(setq timezone
-	      (or (and (stringp timezone) (cdr (assoc (upcase timezone) timezone-world-timezones)))
-		  ;; +900
-		  timezone))
-	(if (stringp timezone)
-	    (setq timezone (string-to-int timezone)))
-	;; Taking account of minute in timezone.
-	;; HHMM -> MM
-	(let* ((abszone (timezone-abs timezone))
- 	       (minutes (+ (* 60 (/ abszone 100)) (% abszone 100))))
- 	  (if (< timezone 0) (- minutes) minutes))))
-     (t 0)))
-
-(defun timezone-time-from-absolute (date seconds)
-  "Compute the UTC time equivalent to DATE at time SECONDS after midnight.
-Return a list suitable as an argument to current-time-zone,
-or nil if the date cannot be thus represented.
-DATE is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let* ((current-time-origin 719163)
-	    ;; (timezone-absolute-from-gregorian 1 1 1970)
-	 (days (- date current-time-origin))
-	 (seconds-per-day (float 86400))
-	 (seconds (+ seconds (* days seconds-per-day)))
-	 (current-time-arithmetic-base (float 65536))
-	 (hi (timezone-floor (/ seconds current-time-arithmetic-base)))
-	 (hibase (* hi current-time-arithmetic-base))
-	 (lo (timezone-floor (- seconds hibase))))
-     (and (< (timezone-abs (- seconds (+ hibase lo))) 2) ;; Check for integer overflow.
-	  (cons hi lo))))
-
-(defun timezone-time-zone-from-absolute (date seconds)
-  "Compute the local time zone for DATE at time SECONDS after midnight.
-Return a list in the same format as current-time-zone's result,
-or nil if the local time zone could not be computed.
-DATE is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-   (and (fboundp 'current-time-zone)
-	(let ((utc-time (timezone-time-from-absolute date seconds)))
-	  (and utc-time
-	       (let ((zone (current-time-zone utc-time)))
-		 (and (car zone) zone))))))
-
-(defun timezone-fix-time (date local timezone)
-  "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector.
-If LOCAL is nil, it is assumed to be GMT.
-If TIMEZONE is nil, use the local time zone."
-  (let* ((date   (timezone-parse-date date))
-	 (year   (string-to-int (aref date 0)))
-	 (year	 (cond ((< year 69)
-			(+ year 2000))
-		       ((< year 100)
-			(+ year 1900))
-		       ((< year 1000)	; possible 3-digit years.
-			(+ year 1900))
-		       (t year)))
-	 (month  (string-to-int (aref date 1)))
-	 (day    (string-to-int (aref date 2)))
-	 (time   (timezone-parse-time (aref date 3)))
-	 (hour   (string-to-int (aref time 0)))
-	 (minute (string-to-int (aref time 1)))
-	 (second (string-to-int (aref time 2)))
-	 (local  (or (aref date 4) local)) ;Use original if defined
-	 (timezone
-	  (or timezone
-	      (timezone-time-zone-from-absolute
-	       (timezone-absolute-from-gregorian month day year)
-	       (+ second (* 60 (+ minute (* 60 hour)))))))
-	 (diff   (- (timezone-zone-to-minute timezone)
-		    (timezone-zone-to-minute local)))
-	 (minute (+ minute diff))
-	 (hour-fix (timezone-floor minute 60)))
-    (setq hour (+ hour hour-fix))
-    (setq minute (- minute (* 60 hour-fix)))
-    ;; HOUR may be larger than 24 or smaller than 0.
-    (cond ((<= 24 hour)			;24 -> 00
-	   (setq hour (- hour 24))
-	   (setq day  (1+ day))
-	   (when (< (timezone-last-day-of-month month year) day)
-	     (setq month (1+ month))
-	     (setq day 1)
-	     (when (< 12 month)
-	       (setq month 1)
-	       (setq year (1+ year)))))
-	  ((> 0 hour)
-	   (setq hour (+ hour 24))
-	   (setq day  (1- day))
-	   (when (> 1 day)
-	     (setq month (1- month))
-	     (when (> 1 month)
-	       (setq month 12)
-	       (setq year (1- year)))
-	     (setq day (timezone-last-day-of-month month year)))))
-    (vector year month day hour minute second timezone)))
-
-;; Partly copied from Calendar program by Edward M. Reingold.
-;; Thanks a lot.
-
-(defun timezone-last-day-of-month (month year)
-  "The last day in MONTH during YEAR."
-  (if (and (= month 2) (timezone-leap-year-p year))
-      29
-    (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
-
-(defun timezone-leap-year-p (year)
-  "Returns t if YEAR is a Gregorian leap year."
-  (or (and (zerop  (% year 4))
-	   (not (zerop (% year 100))))
-      (zerop (% year 400))))
-
-(defun timezone-day-number (month day year)
-  "Return the day number within the year of the date month/day/year."
-  (let ((day-of-year (+ day (* 31 (1- month)))))
-    (if (> month 2)
-	(progn
-	  (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
-	  (if (timezone-leap-year-p year)
-	      (setq day-of-year (1+ day-of-year)))))
-    day-of-year))
-
-(defun timezone-absolute-from-gregorian (month day year)
-  "The number of days between the Gregorian date 12/31/1 BC and month/day/year.
-The Gregorian date Sunday, December 31, 1 BC is imaginary."
-  (+ (timezone-day-number month day year);; Days this year
-     (* 365 (1- year));;	+ Days in prior years
-     (/ (1- year) 4);;		+ Julian leap years
-     (- (/ (1- year) 100));;	- century years
-     (/ (1- year) 400)));;	+ Gregorian leap years
-
-(defun timezone-abs (n)
-  (if (fboundp 'abs)
-      (abs n)
-    (if (< n 0) (- n) n)))
-
-(defun timezone-floor (n &optional divisor)
-  (if (fboundp 'floor)
-      (floor n divisor)
-    (if (null divisor)
-	(setq divisor 1))
-    (if (< n 0)
-	(- (/ (- divisor 1 n) divisor))
-      (/ n divisor))))
-
-(provide 'timezone)
-
-;;; timezone.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/tq.el b/xemacs-packages/lisp/xemacs-base/tq.el
deleted file mode 100644
index 1960b723..00000000
--- a/xemacs-packages/lisp/xemacs-base/tq.el
+++ /dev/null
@@ -1,124 +0,0 @@
-;;; tq.el --- utility to maintain a transaction queue
-
-;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
-
-;; Author: Scott Draves 
-;; Adapted-By: ESR
-;; Keywords: extensions
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
- 
-;;; manages receiving a stream asynchronously, 
-;;; parsing it into transactions, and then calling
-;;; handler functions
-
-;;; Our basic structure is the queue/process/buffer triple.  Each entry
-;;; of the queue is a regexp/closure/function triple.  We buffer
-;;; bytes from the process until we see the regexp at the head of the
-;;; queue.  Then we call the function with the closure and the
-;;; collected bytes.
-
-;;; Code:
-
-;;;###autoload
-(defun tq-create (process)
-  "Create and return a transaction queue communicating with PROCESS.
-PROCESS should be a subprocess capable of sending and receiving
-streams of bytes.  It may be a local process, or it may be connected
-to a tcp server on another machine."
-  (let ((tq (cons nil (cons process
-			    (generate-new-buffer
-			     (concat " tq-temp-"
-				     (process-name process)))))))
-    (set-process-filter process
-			`(lambda (proc string)
-			   (tq-filter ',tq string)))
-    tq))
-
-;;; accessors
-(defun tq-queue   (tq) (car tq))
-(defun tq-process (tq) (car (cdr tq)))
-(defun tq-buffer  (tq) (cdr (cdr tq)))
-
-(defun tq-queue-add (tq re closure fn)
-  (setcar tq (nconc (tq-queue tq)
-		    (cons (cons re (cons closure fn)) nil)))
-  'ok)
-
-(defun tq-queue-head-regexp  (tq) (car (car (tq-queue tq))))
-(defun tq-queue-head-fn      (tq) (cdr (cdr (car (tq-queue tq)))))
-(defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq)))))
-(defun tq-queue-empty        (tq) (not (tq-queue tq)))
-(defun tq-queue-pop          (tq) (setcar tq (cdr (car tq))) (null (car tq)))
-
-
-;;; must add to queue before sending!
-(defun tq-enqueue (tq question regexp closure fn)
-  "Add a transaction to transaction queue TQ.
-This sends the string QUESTION to the process that TQ communicates with.
-When the corresponding answer comes back, we call FN
-with two arguments: CLOSURE, and the answer to the question.
-REGEXP is a regular expression to match the entire answer;
-that's how we tell where the answer ends."
-  (tq-queue-add tq regexp closure fn)
-  (process-send-string (tq-process tq) question))
-
-(defun tq-close (tq)
-  "Shut down transaction queue TQ, terminating the process."
-  (delete-process (tq-process tq))
-  (kill-buffer (tq-buffer tq)))
-
-(defun tq-filter (tq string)
-  "Append STRING to the TQ's buffer; then process the new data."
-  (with-current-buffer (tq-buffer tq)
-    (goto-char (point-max))
-    (insert string)
-    (tq-process-buffer tq)))
-
-(defun tq-process-buffer (tq)
-  "Check TQ's buffer for the regexp at the head of the queue."
-  (set-buffer (tq-buffer tq))
-  (if (= 0 (buffer-size)) ()
-    (if (tq-queue-empty tq)
-	(let ((buf (generate-new-buffer "*spurious*")))
-	  (copy-to-buffer buf (point-min) (point-max))
-	  (delete-region (point-min) (point))
-	  (pop-to-buffer buf nil)
-	  (error "Spurious communication from process %s, see buffer %s"
-		 (process-name (tq-process tq))
-		 (buffer-name buf)))
-      (goto-char (point-min))
-      (if (re-search-forward (tq-queue-head-regexp tq) nil t)
-	  (let ((answer (buffer-substring (point-min) (point))))
-	    (delete-region (point-min) (point))
-	    (unwind-protect
-		(condition-case nil
-		    (funcall (tq-queue-head-fn tq)
-			     (tq-queue-head-closure tq)
-			     answer)
-		  (error nil))
-	      (tq-queue-pop tq))
-	    (tq-process-buffer tq))))))
-
-(provide 'tq)
-
-;;; tq.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/xbm-button.el b/xemacs-packages/lisp/xemacs-base/xbm-button.el
deleted file mode 100644
index cfe8d6b9..00000000
--- a/xemacs-packages/lisp/xemacs-base/xbm-button.el
+++ /dev/null
@@ -1,335 +0,0 @@
-;;; xbm-button.el --- Create XBM text buttons under XEmacs
-
-;; Copyright (C) 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Kyle E. Jones
-
-;; Author: Kyle Jones
-;; Maintainer: XEmacs Development Team
-;; Keywords: frames, internal
-
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
-;; any later version.
-
-;; XEmacs 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.
-
-;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;;; Send bug reports to kyle@wonderworks.com
-
-;;; The sole interface function is xbm-button-create.
-
-;;; Code:
-
-(provide 'xbm-button)
-
-(defvar xbm-button-version "1.00"
-  "Version string for xbm-button.")
-
-(defvar xbm-button-vertical-padding 3
-  "Number of pixels between the text and the top/bottom of the button.")
-
-(defvar xbm-button-horizontal-padding 3
-  "Number of pixels between the text and the left/right edges of the button.")
-
-(defvar xbm-button-font-pixel-lines
-  '(
-"000011000001111110000011110101111111000111111110111111110001111010011110011110111100001111011110111101111000001111000111101110000111000111110001111111000011111000011111110000111101011111111011110011101111000111011110111101110111101111011110111011111111000000000111000000000000000001110000000000011100000000011100000001100011011100000011100000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000000000000000000000000011000001000111100011110000111000111110001110011111100111100011110001000000001100000111100000010100011110000110001000000010000001110000000100000010100000000000000000000000000000000001111000110111101100000000011010100000000000000000000000100111100100000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"000011000000110011000110001100110001100011000110011000110011000110001100001100011000000110001100010000110000000111000111000111000010001100011000110001100110001100001100011001100011011011011001100001000110000010001100011000100011000100001100010011000111000000000011000000000000000000110000000000110100000000001100000001100011001100000001100000000000000000000000000000000000000000000000000000000000000001100000000000000000000000000000000000000000000000000000000000100100111001100110110011000111000111100010011011111101100110110011010000000001100011000010000010100110111001101111000000010000011001000010101000100010000000000000000000000000000000001100001100001100110000000011010100000000000000000000000101100110110000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"000101100000110011001100000100110000110011000010011000010110000010001100001100011000000110001100100000110000000111000111000111100010011000001100110001101100000110001100011001100001010011001001100001000110000010001100011000100011101000001100010010001110000000000011000000000000000000110000000000110000000110001100000000000000001100000001100000000000000000000000000000000000000000000000000000000000000001100000000000000000000000000000000000000000000000000000000001100110011001100110110011001011000100000110011010001001100010110011011000000001100100111101001111110100100011001010000000111000011010000001110001100011000000000000000000000000000100001100001100001100110000000001010100000000000000000000000101100110010000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"000101100000110011001100000100110000110011001000011001010110000010001100001100011000000110001101000000110000000101101011000101110010011000001100110001101100000110001100011001111000010011001001100001000011000100000110101101000001111000000110100000011100001111000011011000001110000110110000111001111100111100001101100011100111001101110001100111011001100011101100000111000111011000001101100111011001111011111011101110011110111011101111011101110111011110111011111101100110011000000110000011001011000111100110000000011000110100110011011000000001100101001101000101000110100011001010011000101000001100111010101001000001000000000000000000000000000100001100001100001100110011011010000000000000110000110000001100000110011000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"001000110000111110001100000000110000110011111000011111000110000000001111111100011000000110001111100000110000000101101011000100111010011000001100110011001100000110001111100000111110000011000001100001000011000100000110101101000000111000000110100000011000001001100011101110111011011101110011101100110001100110001110110001100011001101100001100011101110110001110110011101110011101110111011100011111010001001100001100110001100010001100110001000110010001100010010011101100110011000001100001100010011000100110111110000011000111100011111000001100101101011011001000101000011110011010100110101101100011110010000100011000001100000000000000001111110000100001100001000001100010011011000000000000011100000011100001000001100001000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"001111110000110001101100000000110000110011001000011001000110001111001100001100011000000110001101110000110000000101101011000100011110011000001100111110001101100110001100110000001111000011000001100001000001101000000110101101000001011100000011000000111000000111100011000110110000011000110011111100110001100110001100110001100011001111000001100011001100110001100110011000110011000110110001100011000011110001100001100110000110100000110111010000011100000110100000111001100110011000011000000011010011000000110110011000110000101110000011000011111101101011011010011111100000111001100101100101000100100111100000000011000001101111110000000000000000111111101100010000001100001000000000000000001110000000000111011000010000001100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"010000011000110001101100000100110000110011000010011000000110000110001100001100011001100110001100110000110000100100110011000100001110011000001100110000001110010110001100110001000011000011000001100001000001101000000011000110000001001110000011000001110001011001100011000110110000011000110011000000110000111100001100110001100011001101100001100011001100110001100110011000110011000110110001100011000001111001100001100110000110100000110111010000011100000110100001110001100110011000100010110011011111101100110110011000110001000110110011000010011000001001101100001010000110101000001001100100000001100011100000000011000001100000000000000001111110000100001100001000001100010000000000000000000011100000011100010000000000000100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"010000011000110001100110001100110001100011000110011000000011000110001100001100011001100110001100111000110001100100110011000100000110001100011000110000000110011100001100011101100011000011000001110011000000110000000011000110000010000110000011000011100011011011100011001110111011011101110011101100110001000000001100110001100011001100110001100011001100110001100110011101110011101110111011100011000010001001100001101110000011000000011001100000100110000011000011100100100100011001111110110011000011001100110110011000110001100110110010000000000001100100000010001010000110101000001001101000000001110011111000000001000001000000000000000000000000000100001100001100001100110011011000000001100000110110110000010000011000000110100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"111000111101111111000011111001111111000111111110111100000001111010011110011110111100111000011110011101111111101110110111101110000010000111110001111000000011111000011110011001011110000111100000111110000000110000000011000110000111001111000111100011111111001101110010111000001110000110111000111001111001111110011110111011110011011110111011110111101110111011110111000111000011011000001101100111100011110000110000110111000011000000011001100001110111000011000011111100011000111101111110011110000111100111100011110000110000111100011100000000000001100011111100001010000011110000010000110000000000111100110000000001100011000000000000000000000000000100001100001100001100110011011000000001100000000110000000010000011000000010100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111111000000000000000011000000000000000000000000000000000000000000000011000000000001100000000000000000000000000000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000000100010000000000000000000000000000000001100001100001100110001000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000011000000000000000011000000000000000000000000000000000000000000000011000000000001100000000000000000000000000000000000000000000000000000000000011100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010100000000000111111100000000000000001111000110111101100010000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-"000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111110000000000000000110000000000000000000000000000000000000000000000111100000000011110000000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
-   )
-  "List of strings representing pixel lines for the button font.")
-
-(defvar xbm-button-font-line-indices
-  '(("A" 0 10)
-    ("B" 11 19)
-    ("C" 20 28)
-    ("D" 29 38)
-    ("E" 39 47)
-    ("F" 48 56)
-    ("G" 57 66)
-    ("H" 67 77)
-    ("I" 78 82)
-    ("J" 83 90)
-    ("K" 91 100)
-    ("L" 101 109)
-    ("M" 110 121)
-    ("N" 122 132)
-    ("O" 133 142)
-    ("P" 143 151)
-    ("Q" 152 162)
-    ("R" 163 172)
-    ("S" 173 180)
-    ("T" 181 189)
-    ("U" 190 199)
-    ("V" 200 210)
-    ("W" 211 224)
-    ("X" 225 234)
-    ("Y" 235 243)
-    ("Z" 244 252)
-    ("a" 253 260)
-    ("b" 261 269)
-    ("c" 270 276)
-    ("d" 277 285)
-    ("e" 286 292)
-    ("f" 293 298)
-    ("g" 299 306)
-    ("h" 307 315)
-    ("i" 316 320)
-    ("j" 321 324)
-    ("k" 325 333)
-    ("l" 334 338)
-    ("m" 339 351)
-    ("n" 352 360)
-    ("o" 361 368)
-    ("p" 369 377)
-    ("q" 378 386)
-    ("r" 387 393)
-    ("s" 394 399)
-    ("t" 400 405)
-    ("u" 406 414)
-    ("v" 415 423)
-    ("w" 424 436)
-    ("x" 437 444)
-    ("y" 445 453)
-    ("z" 454 460)
-    ("0" 461 467)
-    ("1" 468 472)
-    ("2" 473 479)
-    ("3" 480 486)
-    ("4" 487 493)
-    ("5" 494 500)
-    ("6" 501 507)
-    ("7" 508 514)
-    ("8" 515 521)
-    ("9" 522 528)
-    ("`" 529 531)
-    ("~" 532 538)
-    ("!" 539 541)
-    ("@" 542 552)
-    ("#" 553 560)
-    ("$" 561 567)
-    ("%" 568 580)
-    ("^" 581 586)
-    ("&" 587 597)
-    ("*" 598 603)
-    ("(" 604 608)
-    (")" 609 613)
-    ("-" 614 620)
-    ("_" 621 628)
-    ("=" 629 635)
-    ("+" 636 643)
-    ("[" 644 648)
-    ("{" 649 653)
-    ("]" 654 658)
-    ("}" 659 663)
-    (";" 664 666)
-    (":" 667 669)
-    ("'" 670 672)
-    ("\"" 673 676)
-    ("," 677 679)
-    ("<" 680 686)
-    ("." 687 689)
-    (">" 690 696)
-    ("/" 697 700)
-    ("?" 701 707)
-    ("\\" 708 713)
-    ("|" 714 715)
-    (" " 716 719))
-  "Indices into the xbm-button-font-pixel-lines strings for each character.
-Format is
-  (STR START END)
-STR contains the character.
-START is where the character's pixels start in each string of
-   xbm-button-font-pixel-lines (0 is the index of the first pixel).
-END is the index of the position after the last pixel of the character.")
-
-(defun xbm-bit-lines-to-xbm-bits (&optional beg end)
-  "Convert lines of bits to a string of chars containing the bits,
-plus width and height information.  A list of the form
-   (WIDTH HEIGHT STRING)
-is returned.  WIDTH is set to be the length of the first line,
-ignoring the newline.  HEIGHT is the number of lines in the region.
-
-BEG and END specify the region containing the bit lines.  Each
-line should contain only the characters '0' or '1' and be
-terminated by a newline."
-  (or beg (setq beg (point-min)))
-  (or end (setq end (point-max)))
-  (let (octet octet-count bit-count b char width height)
-    (save-excursion
-      (save-excursion
-	(set-buffer (setq b (get-buffer-create
-			     " xbm-button-bit-lines-to-xbm")))
-	(erase-buffer))
-      (goto-char beg)
-      (setq bit-count 0
-	    height 0
-	    width (- (save-excursion (end-of-line) (point)) (point))
-	    octet 0)
-      (while (< (point) end)
-	(setq char (char-after (point)))
-	(cond ((= char ?0)
-	       (setq bit-count (1+ bit-count)))
-	      ((= char ?1)
-	       ;; least significant bit of octet is leftmost pixel.
-	       (setq octet (+ octet (expt 2 bit-count))
-		     bit-count (1+ bit-count)))
-	      ((= char ?\n)
-	       (setq height (1+ height))))
-	;; output octet whenever we have retrieved 8 bits or when
-	;; a newline is encountered.
-	(cond ((or (= bit-count 8) (= char ?\n))
-	       (save-excursion
-		 (set-buffer b)
-		 (insert-char octet))
-	       (setq bit-count 0
-		     octet 0)))
-	(forward-char 1))
-      (set-buffer b)
-      ;; otput last octet if any bits collected.
-      (cond ((not (= bit-count 0))
-	     (insert-char octet)))
-
-      (list width height (buffer-substring nil nil b)) )))
-
-;;;###autoload
-(defun xbm-button-create (text border-thickness)
-  "Returns a list of XBM image instantiators for a button displaying TEXT.
-The list is of the form
-   (UP DOWN DISABLED)
-where UP, DOWN, and DISABLED are the up, down and disabled image
-instantiators for the button.
-
-BORDER-THICKNESS specifies how many pixels should be used for the
-borders on the edges of the buttons.  It should be a positive integer,
-or 0 to mean no border."
-  (save-excursion
-    (set-buffer (get-buffer-create " xbm-button-create"))
-    (erase-buffer)
-    ;; create the correct number of lines for the pixels for the
-    ;; characters.
-    (insert-char ?\n (length xbm-button-font-pixel-lines))
-    (let ((i 0)
-	  (str (make-string 1 0))
-	  (lim (length text))
-	  (bg-char ?0)
-	  font-pixel-lines q)
-      ;; loop through text, adding the character pixels
-      (while (< i lim)
-	(aset str 0 (aref text i))
-	(if (null (setq q (assoc str xbm-button-font-line-indices)))
-	    nil ; no pixel data for this character
-	  (goto-char (point-min))
-	  (setq font-pixel-lines xbm-button-font-pixel-lines)
-	  (while font-pixel-lines
-	    (end-of-line)
-	    (if (not (bolp))
-		;; Insert space before some of the characters.
-		;; This isn't really correct for this font
-		;; but doing it right is too hard.
-		;; This isn't TeX after all.
-		(if (memq (aref str 0) '(?, ?. ?\" ?! ?| ?\' ?\`))
-		    (insert-char bg-char 1))
-	      ;; offset the start a bit from the left edge of the button
-	      (insert-char bg-char xbm-button-horizontal-padding))
-	    ;; insert the character pixels.
-	    (insert (substring (car font-pixel-lines) (nth 1 q) (nth 2 q)))
-	    (forward-line)
-	    (setq font-pixel-lines (cdr font-pixel-lines))))
-	(setq i (1+ i)))
-      ;; now offset the text from the right edge of the button.
-      (goto-char (point-min))
-      (while (not (eobp))
-	(end-of-line)
-	(insert-char bg-char xbm-button-horizontal-padding)
-	(forward-line)))
-    (let ((fg-char ?1)
-	  (bg-char ?0)
-	  i len up down disabled)
-      ;; find the length of a pixel line.
-      (goto-char (point-min))
-      (end-of-line)
-      (setq len (- (point) (point-min)))
-      ;; offset text from the top of the button
-      (goto-char (point-min))
-      (setq i xbm-button-vertical-padding)
-      (while (> i 0)
-	(insert-char bg-char len)
-	(insert ?\n)
-	(setq i (1- i)))
-      ;; offset text from the bottom of the button
-      (goto-char (point-max))
-      (setq i xbm-button-vertical-padding)
-      (while (> i 0)
-	(insert-char bg-char len)
-	(insert ?\n)
-	(setq i (1- i)))
-      ;; add borders to the pixel lines
-      (goto-char (point-min))
-      (while (not (eobp))
-	(insert-char fg-char border-thickness)
-	(end-of-line)
-	(insert-char fg-char border-thickness)
-	(forward-line))
-      ;; add top and bottom border lines
-      (setq i border-thickness)
-      (goto-char (point-min))
-      (while (> i 0)
-	(insert-char fg-char (+ len (* 2 border-thickness)))
-	(insert ?\n)
-	(setq i (1- i)))
-      (setq i border-thickness)
-      (goto-char (point-max))
-      (while (> i 0)
-	(insert-char fg-char (+ len (* 2 border-thickness)))
-	(insert ?\n)
-	(setq i (1- i)))
-      ;; convert the pixel lines to octets of xbm bit data
-      (setq up (xbm-bit-lines-to-xbm-bits)
-	    down up)
-      ;; stipple the foreground pixels for the disabled button.
-      (let ((str (make-string 1 0))
-	    (bit 0)
-	    lim line-start)
-	(aset str 0 fg-char)
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (setq lim (save-excursion (end-of-line) (point))
-		line-start (point))
-	  (while (search-forward str lim t)
-	    (if (= (% (- (point) line-start) 2) bit)
-		(subst-char-in-region (1- (point)) (point) fg-char bg-char t)))
-	  (if (zerop bit)
-	      (setq bit 1)
-	    (setq bit 0))
-	  (forward-line)))
-      (setq disabled (xbm-bit-lines-to-xbm-bits))
-
-      (list (vector 'xbm ':data up)
-	    (vector 'xbm ':data down)
-	    (vector 'xbm ':data disabled)) )))
-
-;;; xbm-button.el ends here
diff --git a/xemacs-packages/lisp/xemacs-base/xpm-button.el b/xemacs-packages/lisp/xemacs-base/xpm-button.el
deleted file mode 100644
index a1409db6..00000000
--- a/xemacs-packages/lisp/xemacs-base/xpm-button.el
+++ /dev/null
@@ -1,415 +0,0 @@
-;;; xpm-button.el --- create XPM buttons
-
-;; Copyright (C) 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Kyle E. Jones
-
-;; Author: Kyle Jones
-;; Maintainer: XEmacs Development Team
-;; Keywords: frames, internal
-
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
-;; any later version.
-
-;; XEmacs 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.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; Create XPM text buttons under XEmacs (requires 19.12 or beyond)
-
-;; Send bug reports to kyle@wonderworks.com
-
-;; Sample use of this package.
-;;(progn
-;;  (setq b (xpm-button-create "Test button" 2 "yellow" "#a0a0d0"))
-;;  (setq e (make-extent (point-max) (point-max)))
-;;  (setq g (make-glyph (nth 0 b)))
-;;  (set-extent-begin-glyph e g)
-;;  (setq g2 (make-glyph (nth 1 b)))
-;;  (setq k (make-sparse-keymap))
-;;  (define-key k 'button1 '(lambda (ev)
-;;                          (interactive "e")
-;;                          (set-extent-begin-glyph e g2)))
-;;  (define-key k 'button1up '(lambda (ev)
-;;                            (interactive "e")
-;;                            (set-extent-begin-glyph e g)))
-;;  (set-extent-property e 'keymap k))
-
-;; The sole interface function is xpm-button-create.
-
-;;; Code:
-
-(provide 'xpm-button)
-
-(defvar xpm-button-version "1.02"
-  "Version string for xpm-button.")
-
-(defvar xpm-button-vertical-padding 3
-  "Number of pixels between the text and the top/bottom of the button.")
-
-(defvar xpm-button-horizontal-padding 3
-  "Number of pixels between the text and the left/right edges of the button.")
-
-(defvar xpm-button-font-pixel-lines
-  '(
-"    xx     xxxxxx     xxxx x xxxxxxx   xxxxxxxx xxxxxxxx   xxxx x  xxxx  xxxx xxxx    xxxx xxxx xxxx xxxx     xxxx   xxxx xxx    xxx   xxxxx   xxxxxxx    xxxxx    xxxxxxx    xxxx x xxxxxxxx xxxx  xxx xxxx   xxx xxxx xxxx xxx xxxx xxxx xxxx xxx xxxxxxxx         xxx                 xxx           xxx         xxx       xx   xx xxx      xxx                                                                 x                                                            xx     x   xxxx   xxxx    xxx   xxxxx   xxx  xxxxxx  xxxx   xxxx   x        xx     xxxx      x x   xxxx    xx   x       x      xxx       x      x x                                  xxxx   xx xxxx xx         xx x x                       x  xxxx  x     x                                                                                         "
-"    xx      xx  xx   xx   xx  xx   xx   xx   xx  xx   xx  xx   xx   xx    xx   xx      xx   xx   x    xx       xxx   xxx   xxx    x   xx   xx   xx   xx  xx   xx    xx   xx  xx   xx xx xx xx  xx    x   xx     x   xx   xx   x   xx   x    xx   x  xx   xxx          xx                  xx          xx x          xx       xx   xx  xx       xx                                                                xx                                                           x  x  xxx  xx  xx xx  xx   xxx   xxxx   x  xx xxxxxx xx  xx xx  xx x         xx   xx    x     x x  xx xxx  xx xxxx       x     xx  x    x x x   x   x                                 xx    xx    xx  xx        xx x x                       x xx  xx xx    x                                                                                         "
-"   x xx     xx  xx  xx     x  xx    xx  xx    x  xx    x xx     x   xx    xx   xx      xx   xx  x     xx       xxx   xxx   xxxx   x  xx     xx  xx   xx xx     xx   xx   xx  xx    x x  xx  x  xx    x   xx     x   xx   xx   x   xxx x     xx   x  x   xxx           xx                  xx          xx       xx   xx                xx       xx                                                                xx                                                          xx  xx  xx  xx  xx xx  xx  x xx   x     xx  xx x   x  xx   x xx  xx xx        xx  x  xxxx x  xxxxxx x  x   xx  x x       xxx    xx x      xxx   xx   xx                           x    xx    xx    xx  xx         x x x                       x xx  xx  x    x                                                                                         "
-"   x xx     xx  xx  xx     x  xx    xx  xx  x    xx  x x xx     x   xx    xx   xx      xx   xx x      xx       x xx x xx   x xxx  x  xx     xx  xx   xx xx     xx   xx   xx  xxxx    x  xx  x  xx    x    xx   x     xx x xx x     xxxx      xx x      xxx    xxxx    xx xx     xxx    xx xx    xxx  xxxxx  xxxx    xx xx   xxx  xxx  xx xxx   xx  xxx xx  xx   xxx xx     xxx   xxx xx     xx xx  xxx xx  xxxx xxxxx xxx xxx  xxxx xxx xxx xxxx xxx xxx xxx xxxx xxx xxxxxx xx  xx  xx      xx     xx  x xx   xxxx  xx        xx   xx x  xx  xx xx        xx  x x  xx x   x x   xx x   xx  x x  xx   x x     xx  xxx x x x  x     x                           x    xx    xx    xx  xx  xx xx x             xx    xx      xx     xx  xx   x                                                                                         "
-"  x   xx    xxxxx   xx        xx    xx  xxxxx    xxxxx   xx         xxxxxxxx   xx      xx   xxxxx     xx       x xx x xx   x  xxx x  xx     xx  xx  xx  xx     xx   xxxxx     xxxxx     xx     xx    x    xx   x     xx x xx x      xxx      xx x      xx     x  xx   xxx xxx xxx xx xxx xxx  xxx xx  xx   xx  xx   xxx xx   xx   xx  xx xx    xx   xxx xxx xx   xxx xx  xxx xxx  xxx xxx xxx xxx   xxxxx x   x  xx    xx  xx   xx   x   xx  xx   x   xx  x   xx   x  x  xxx xx  xx  xx     xx    xx   x  xx   x  xx xxxxx     xx   xxxx   xxxxx     xx  x xx x xx xx  x   x x    xxxx  xx x x  xx x xx xx   xxxx  x    x   xx     xx                xxxxxx    x    xx    x     xx   x  xx xx             xxx      xxx    x     xx    x   x                                                                                         "
-"  xxxxxx    xx   xx xx        xx    xx  xx  x    xx  x   xx   xxxx  xx    xx   xx      xx   xx xxx    xx       x xx x xx   x   xxxx  xx     xx  xxxxx   xx xx  xx   xx  xx      xxxx    xx     xx    x     xx x      xx x xx x     x xxx      xx      xxx      xxxx   xx   xx xx     xx   xx  xxxxxx  xx   xx  xx   xx  xx   xx   xx  xxxx     xx   xx  xx  xx   xx  xx  xx   xx  xx   xx xx   xx   xx    xxxx   xx    xx  xx    xx x     xx xxx x     xxx     xx x     xxx  xx  xx  xx    xx       xx x  xx      xx xx  xx   xx    x xxx     xx    xxxxxx xx x xx xx x  xxxxxx     xxx  xx  x xx  x x   x  x  xxxx         xx     xx xxxxxx                xxxxxxx xx   x      xx    x                 xxx          xxx xx    x      xx  x                                                                                         "
-" x     xx   xx   xx xx     x  xx    xx  xx    x  xx      xx    xx   xx    xx   xx  xx  xx   xx  xx    xx    x  x  xx  xx   x    xxx  xx     xx  xx      xxx  x xx   xx  xx   x    xx    xx     xx    x     xx x       xx   xx      x  xxx     xx     xxx   x xx  xx   xx   xx xx     xx   xx  xx      xx    xxxx    xx  xx   xx   xx  xx xx    xx   xx  xx  xx   xx  xx  xx   xx  xx   xx xx   xx   xx     xxxx  xx    xx  xx    xx x     xx xxx x     xxx     xx x    xxx   xx  xx  xx   x   x xx  xx xxxxxx xx  xx xx  xx   xx   x   xx xx  xx    x  xx     x  xx xx    x x    xx x x     x  xx  x       xx   xxx         xx     xx                xxxxxx    x    xx    x     xx   x                    xxx      xxx   x             x  x                                                                                         "
-" x     xx   xx   xx  xx   xx  xx   xx   xx   xx  xx       xx   xx   xx    xx   xx  xx  xx   xx  xxx   xx   xx  x  xx  xx   x     xx   xx   xx   xx       xx  xxx    xx   xxx xx   xx    xx     xxx  xx      xx        xx   xx     x    xx     xx    xxx   xx xx xxx   xx  xxx xxx xx xxx xxx  xxx xx  xx   x        xx  xx   xx   xx  xx  xx   xx   xx  xx  xx   xx  xx  xxx xxx  xxx xxx xxx xxx   xx    x   x  xx    xx xxx     xx       xx  xx     x  xx     xx    xxx  x  x  x   xx  xxxxxx xx  xx    xx  xx  xx xx  xx   xx   xx  xx xx  x            xx  x      x   x x    xx x x     x  xx x        xxx  xxxxx        x     x                           x    xx    xx    xx  xx  xx xx        xx     xx xx xx     x     xx      xx x                                                                                         "
-"xxx   xxxx xxxxxxx    xxxxx  xxxxxxx   xxxxxxxx xxxx       xxxx x  xxxx  xxxx xxxx  xxx    xxxx  xxx xxxxxxxx xxx xx xxxx xxx     x    xxxxx   xxxx       xxxxx    xxxx  xx  x xxxx    xxxx     xxxxx       xx        xx   xx    xxx  xxxx   xxxx   xxxxxxxx  xx xxx  x xxx     xxx    xx xxx   xxx  xxxx  xxxxxx  xxxx xxx xxxx  xx xxxx xxx xxxx xxxx xxx xxx xxxx xxx   xxx    xx xx     xx xx  xxxx   xxxx    xx    xx xxx    xx       xx  xx    xxx xxx    xx    xxxxxx   xx   xxxx xxxxxx  xxxx    xxxx  xxxx   xxxx    xx    xxxx   xxx             xx   xxxxxx    x x     xxxx     x    xx          xxxx  xx         xx   xx                           x    xx    xx    xx  xx  xx xx        xx        xx        x     xx       x x                                                                                         "
-"                                                                                                                                                              xxxx                                                                                                                                          xxxxxx                xx                                              xx           xx                                                               x                                                                                                                   x                                         x   x                                 xx    xx    xx  xx   x            x                                                                                                                             "
-"                                                                                                                                                               xx                                                                                                                                          x    xx                xx                                              xx           xx                                                            xxx                                                                                                                                                               x x           xxxxxxx                xxxx   xx xxxx xx   x            x                                                                                                                              "
-"                                                                                                                                                                                                                                                                                                            xxxxx                xx                                              xxxx         xxxx                                                           xx                                                                                                                                                                                                                                                                                                                                                                     "
-   )
-  "List of strings representing pixel lines for the button font.")
-
-(defvar xpm-button-font-line-indices
-  '(("A" 0 10)
-    ("B" 11 19)
-    ("C" 20 28)
-    ("D" 29 38)
-    ("E" 39 47)
-    ("F" 48 56)
-    ("G" 57 66)
-    ("H" 67 77)
-    ("I" 78 82)
-    ("J" 83 90)
-    ("K" 91 100)
-    ("L" 101 109)
-    ("M" 110 121)
-    ("N" 122 132)
-    ("O" 133 142)
-    ("P" 143 151)
-    ("Q" 152 162)
-    ("R" 163 172)
-    ("S" 173 180)
-    ("T" 181 189)
-    ("U" 190 199)
-    ("V" 200 210)
-    ("W" 211 224)
-    ("X" 225 234)
-    ("Y" 235 243)
-    ("Z" 244 252)
-    ("a" 253 260)
-    ("b" 261 269)
-    ("c" 270 276)
-    ("d" 277 285)
-    ("e" 286 292)
-    ("f" 293 298)
-    ("g" 299 306)
-    ("h" 307 315)
-    ("i" 316 320)
-    ("j" 321 324)
-    ("k" 325 333)
-    ("l" 334 338)
-    ("m" 339 351)
-    ("n" 352 360)
-    ("o" 361 368)
-    ("p" 369 377)
-    ("q" 378 386)
-    ("r" 387 393)
-    ("s" 394 399)
-    ("t" 400 405)
-    ("u" 406 414)
-    ("v" 415 423)
-    ("w" 424 436)
-    ("x" 437 444)
-    ("y" 445 453)
-    ("z" 454 460)
-    ("0" 461 467)
-    ("1" 468 472)
-    ("2" 473 479)
-    ("3" 480 486)
-    ("4" 487 493)
-    ("5" 494 500)
-    ("6" 501 507)
-    ("7" 508 514)
-    ("8" 515 521)
-    ("9" 522 528)
-    ("`" 529 531)
-    ("~" 532 538)
-    ("!" 539 541)
-    ("@" 542 552)
-    ("#" 553 560)
-    ("$" 561 567)
-    ("%" 568 580)
-    ("^" 581 586)
-    ("&" 587 597)
-    ("*" 598 603)
-    ("(" 604 608)
-    (")" 609 613)
-    ("-" 614 620)
-    ("_" 621 628)
-    ("=" 629 635)
-    ("+" 636 643)
-    ("[" 644 648)
-    ("{" 649 653)
-    ("]" 654 658)
-    ("}" 659 663)
-    (";" 664 666)
-    (":" 667 669)
-    ("'" 670 672)
-    ("\"" 673 676)
-    ("," 677 679)
-    ("<" 680 686)
-    ("." 687 689)
-    (">" 690 696)
-    ("/" 697 700)
-    ("?" 701 707)
-    ("\\" 708 713)
-    ("|" 714 715)
-    (" " 716 719))
-  "Indices into the xpm-button-font-pixel-lines strings for each character.
-Format is
-  (STR START END)
-STR contains the character.
-START is where the character's pixels start in each string of
-   xpm-button-font-pixel-lines (0 is the index of the first pixel).
-END is the index of the position after the last pixel of the character.")
-
-(defun xpm-button-color-rgb-components (color)
-  "Return the RGB components of COLOR as a list of integers (R G B).
-16-bit values are always returned.
-#FEFEFE and rgb:fe/fe/fe style color specifications are parsed directly
-into their components."
-  (color-instance-rgb-components (make-color-instance color)))
-
-(defun xpm-button-compute-contrast-color (color)
-  "Compute a contrasting color for COLOR.
-The new color is created by xor-ing the RGB values of COLOR with all ones."
-  (let* ((rgb (xpm-button-color-rgb-components color))
-	 (r (logxor (nth 0 rgb) 65535))
-	 (g (logxor (nth 1 rgb) 65535))
-	 (b (logxor (nth 2 rgb) 65535)))
-    (format "rgb:%04x/%04x/%04x" r g b)))
-
-(defun xpm-button-compute-shadow-colors (color)
-  "Compute shadow colors for COLOR.
-COLOR should be a string naming a color.
-Returns (COLOR1 . COLOR2) where COLOR1 is the brighter shadow color
-and COLOR2 is the dimmer color."
-  (let* ((rgb (xpm-button-color-rgb-components color))
-	 (r (nth 0 rgb))
-	 (g (nth 1 rgb))
-	 (b (nth 2 rgb))
-	 (bright-r (/ (* r 12) 10))
-	 (bright-g (/ (* g 12) 10))
-	 (bright-b (/ (* b 12) 10))
-	 (dim-r (/ (* r 8) 10))
-	 (dim-g (/ (* g 8) 10))
-	 (dim-b (/ (* b 8) 10)))
-    (if (> bright-r 65535)
-	(setq bright-r 65535))
-    (if (> bright-g 65535)
-	(setq bright-g 65535))
-    (if (> bright-b 65535)
-	(setq bright-b 65535))
-    (cons (format "rgb:%04x/%04x/%04x" bright-r bright-g bright-b)
-	  (format "rgb:%04x/%04x/%04x" dim-r dim-g dim-b))))
-
-;;;###autoload
-(defun xpm-button-create (text shadow-thickness fg-color bg-color)
-  "Returns a list of XPM image instantiators for a button displaying TEXT.
-The list is of the form
-   (UP DOWN DISABLED)
-where UP, DOWN, and DISABLED are the up, down and disabled image
-instantiators for the button.
-
-SHADOW-THICKNESS specifies how many pixels should be used for the
-shadows on the edges of the buttons.  It should be a positive integer,
-or 0 to mean no shadows on the edges.
-FG-COLOR is the color used to display the text.  It should be a string.
-BG-COLOR is the background color the text will be displayed upon.
-It should be a string."
-  (save-excursion
-    (set-buffer (get-buffer-create " xpm-button"))
-    (erase-buffer)
-    ;; create the correct number of lines for the pixels for the
-    ;; characters.
-    (insert-char ?\n (length xpm-button-font-pixel-lines))
-    (let ((i 0)
-	  (str (make-string 1 0))
-	  (lim (length text))
-	  (bg-char ? )
-	  font-pixel-lines q)
-      ;; loop through text, adding the character pixels
-      (while (< i lim)
-	(aset str 0 (aref text i))
-	(if (null (setq q (assoc str xpm-button-font-line-indices)))
-	    nil ; no pixel data for this character
-	  (goto-char (point-min))
-	  (setq font-pixel-lines xpm-button-font-pixel-lines)
-	  (while font-pixel-lines
-	    (end-of-line)
-	    (if (not (bolp))
-		;; Insert space before some of the characters.
-		;; This isn't really correct for this font
-		;; but doing it right is too hard.
-		;; This isn't TeX after all.
-		(if (memq (aref str 0) '(?, ?. ?\" ?! ?| ?\' ?\`))
-		    (insert-char bg-char 1))
-	      ;; offset the start a bit from the left edge of the button
-	      (insert-char bg-char xpm-button-horizontal-padding))
-	    ;; insert the character pixels.
-	    (insert (substring (car font-pixel-lines) (nth 1 q) (nth 2 q)))
-	    (forward-line)
-	    (setq font-pixel-lines (cdr font-pixel-lines))))
-	(setq i (1+ i)))
-      ;; now offset the text from the right edge of the button.
-      (goto-char (point-min))
-      (while (not (eobp))
-	(end-of-line)
-	(insert-char bg-char xpm-button-horizontal-padding)
-	(forward-line)))
-    (let ((bright-char ?b)
-	  (dim-char ?d)
-	  (fg-char ?x)
-	  (bg-char ? )
-	  (shadow-colors (xpm-button-compute-shadow-colors bg-color))
-	  i len up-string down-string disabled-string)
-      ;; find the length of a pixel line.
-      (goto-char (point-min))
-      (end-of-line)
-      (setq len (- (point) (point-min)))
-      ;; offset text from the top of the button
-      (goto-char (point-min))
-      (setq i xpm-button-vertical-padding)
-      (while (> i 0)
-	(insert-char bg-char len)
-	(insert ?\n)
-	(setq i (1- i)))
-      ;; offset text from the bottom of the button
-      (goto-char (point-max))
-      (setq i xpm-button-vertical-padding)
-      (while (> i 0)
-	(insert-char bg-char len)
-	(insert ?\n)
-	(setq i (1- i)))
-      ;; add shadows to the pixel lines
-      (goto-char (point-min))
-      (while (not (eobp))
-	(insert-char bright-char shadow-thickness)
-	(end-of-line)
-	(insert-char dim-char shadow-thickness)
-	(forward-line))
-      ;; add top and bottom shadow lines
-      (setq i shadow-thickness)
-      (goto-char (point-min))
-      (while (> i 0)
-	(insert-char bright-char (+ len shadow-thickness i))
-	(insert-char dim-char (- shadow-thickness i))
-	(insert ?\n)
-	(setq i (1- i)))
-      (setq i shadow-thickness)
-      (goto-char (point-max))
-      (while (> i 0)
-	(insert-char bright-char i)
-	(insert-char dim-char (+ len (* 2 shadow-thickness) (- i)))
-	(insert ?\n)
-	(setq i (1- i)))
-      ;; add doublequotes, commas and XPM header goop.
-      (goto-char (point-min))
-      (while (not (eobp))
-	(insert "\"")
-	(end-of-line)
-	(insert "\",")
-	(forward-line))
-      (insert "};\n")
-      (goto-char (point-min))
-      ;; color map for the UP button
-      (insert (format
-	       "/* XPM */
-static char * button_xpm[] = {
-\"%d %d 4 1\",
-\"%c   c %s\",
-\"%c   c %s\",
-\"%c   c %s\",
-\"%c   c %s\",
-"
-	       (+ len (* shadow-thickness 2))
-	       (+ (* xpm-button-vertical-padding 2)
-		  (* shadow-thickness 2)
-		  (length xpm-button-font-pixel-lines))
-	       fg-char fg-color
-	       bg-char bg-color
-	       bright-char (car shadow-colors)
-	       dim-char (cdr shadow-colors)))
-      (setq up-string (buffer-string))
-      (delete-region (point-min) (point))
-      ;; color map for the DOWN button
-      (insert (format
-	       "/* XPM */
-static char * button_xpm[] = {
-\"%d %d 4 1\",
-\"%c   c %s\",
-\"%c   c %s\",
-\"%c   c %s\",
-\"%c   c %s\",
-"
-	       (+ len (* shadow-thickness 2))
-	       (+ (* xpm-button-vertical-padding 2)
-		  (* shadow-thickness 2)
-		  (length xpm-button-font-pixel-lines))
-	       fg-char (xpm-button-compute-contrast-color fg-color)
-	       bg-char bg-color
-	       bright-char (cdr shadow-colors)
-	       dim-char (car shadow-colors)))
-      (setq down-string (buffer-string))
-      (delete-region (point-min) (point))
-      ;; color map for the DISABLED button
-      (insert (format
-	       "/* XPM */
-static char * button_xpm[] = {
-\"%d %d 4 1\",
-\"%c   c %s\",
-\"%c   c %s\",
-\"%c   c %s\",
-\"%c   c %s\",
-"
-	       (+ len (* shadow-thickness 2))
-	       (+ (* xpm-button-vertical-padding 2)
-		  (* shadow-thickness 2)
-		  (length xpm-button-font-pixel-lines))
-	       fg-char fg-color
-	       bg-char bg-color
-	       bright-char (car shadow-colors)
-	       dim-char (cdr shadow-colors)))
-      ;; stipple the foreground pixels
-      (let ((str (make-string 1 0))
-	    (bit 0)
-	    lim line-start)
-	(aset str 0 fg-char)
-	(while (not (eobp))
-	  (setq lim (save-excursion (end-of-line) (point))
-		line-start (point))
-	  (while (search-forward str lim t)
-	    (if (= (% (- (point) line-start) 2) bit)
-		(subst-char-in-region (1- (point)) (point) fg-char bg-char t)))
-	  (if (zerop bit)
-	      (setq bit 1)
-	    (setq bit 0))
-	  (forward-line)))
-      (setq disabled-string (buffer-string))
-
-      (list (vector 'xpm ':data up-string)
-	    (vector 'xpm ':data down-string)
-	    (vector 'xpm ':data disabled-string)) )))
-
-;;; xpm-button.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/ChangeLog b/xemacs-packages/lisp/xemacs-devel/ChangeLog
deleted file mode 100644
index 2a076cec..00000000
--- a/xemacs-packages/lisp/xemacs-devel/ChangeLog
+++ /dev/null
@@ -1,821 +0,0 @@
-2005-10-12  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.72 released.
-
-2005-07-27  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.71 released.
-
-2005-07-26  Didier Verna  
-
-	* Patcher 3.8 is released.
-
-2005-07-26  Didier Verna  
-
-	* patcher.el (patcher-warning): New.
-	* patcher.el (patcher-goto-signature): Use it.
-	* patcher.el (patcher-after-send): Ditto.
-	* patcher.el (patcher-install-send-hooks): New.
-	* patcher.el (patcher-mail-compose-mail): Use it.
-	* patcher.el (patcher-mail-adapt-1): Ditto.
-	* patcher.el (patcher-mail-sendmail): Don't use the ACTIONS
-	argument of the `mail' function, to stay coherent with the others
-	methods.
-
-2005-07-26  Didier Verna  
-
-	* patcher.el (patcher-mail-or-reply-setup): Rename to
-	`patcher-mail-setup'.
-	* patcher.el (patcher-mail-1): Use it.
-	* patcher.el (patcher-reply-1): Rename to `patcher-mail-adapt-1'.
-	Use `patcher-mail-setup'.
-	* patcher.el (patcher-reply-subproject): Rename to
-	`patcher-mail-adapt-subproject'.
-	Use `patcher-mail-adapt-1'.
-	* patcher.el (patcher-reply): Rename to `patcher-mail-adapt'.
-	Use `patcher-mail-adapt-1'.
-	* patcher.el (patcher-gnus-summary-followup): New.
-	* patcher.el (patcher-gnus-summary-followup-with-original): New.
-	* patcher.el (patcher-gnus-summary-reply): New.
-	* patcher.el (patcher-gnus-summary-reply-with-original): New.
-	* patcher.el (patcher-gnus-summary-minor-mode-string): New.
-	* patcher.el (patcher-gnus-summary-minor-mode-hook): New.
-	* patcher.el (patcher-gnus-summary-minor-mode-map): New.
-	* patcher.el (patcher-gnus-summary-minor-mode): New.
-	* patcher.el (patcher-gnus-article-minor-mode-string): New.
-	* patcher.el (patcher-gnus-article-minor-mode-hook): New.
-	* patcher.el (patcher-gnus-article-minor-mode-map): New.
-	* patcher.el (patcher-gnus-article-minor-mode): New.
-	* patcher.el (patcher-insinuate-gnus): New.
-
-2005-07-25  Didier Verna  
-
-	* patcher.el (patcher-goto-subject): New.
-	* patcher.el (patcher-goto-signature): New.
-	* patcher.el (patcher-logmsg-insert-subject): Use
-	`patcher-goto-subject'.
-	* patcher.el (patcher-logmsg-commit): Ditto.
-	* patcher.el (patcher-mail-or-reply-setup): New.
-	* patcher.el (patcher-mail-1): Use it. Remove &optional modifier.
-	* patcher.el (patcher-reply-1): New.
-	* patcher.el (patcher-reply-subproject): New.
-	* patcher.el (patcher-reply): New.
-
-2004-12-07  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.70 released.
-
-2004-12-06  Ben Wing  
-
-	* profile.el:
-	Update header docs.
-
-2004-11-28  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.69 released.
-
-2004-11-27  Didier Verna  
-
-	* Patcher 3.7 is released.
-
-2004-11-15  Didier Verna  
-
-	* patcher.el (patcher-change-logs-loaded-by-us): Remove.
-	* patcher.el (patcher-change-logs): Turn into an alist.
-	* patcher.el (patcher-file-relative-name): Handle list as well as
-	string argument.
-	* patcher.el (patcher-files-string): Ditto.
-	* patcher.el (patcher-files-buffers): Ditto.
-	* patcher.el (patcher-diff-base): Handle `patcher-change-logs' as
-	an alist.
-	* patcher.el (patcher-generate-diff-1): Ditto.
-	* patcher.el (patcher-after-send): Ditto. Use it instead of
-	`patcher-change-logs-loaded-by-us'.
-
-2004-11-15  Didier Verna  
-
-	From Ben Wing 
-	* patcher.el (patcher-generate-change-logs): Move point to the
-	beginning of the inserted entry so that it's sure to be visible.
-	Clean up code and use save-restriction.
-
-	* patcher.el (patcher-diff-base):
-	* patcher.el (patcher-after-send): Keep track of whether we loaded
-	a ChangeLog and hence can kill it.
-
-2004-11-15  Didier Verna  
-
-	* patcher.el (patcher-mail-message): Remove (bogus) send-action
-	argument to message-mail call. It is handled by
-	message-exit-actions below.
-
-2004-11-23  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.68 released.
-
-2004-11-22  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.67 released.
-
-2004-11-13  Ben Wing  
-
-	* profile.el:
-	* profile.el (profile):
-	* profile.el (toggle-profiling): New.
-	Add toggle-profiling.
-
-2004-11-09  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.66 released.
-
-2004-11-08  Didier Verna  
-
-	* Patcher 3.6.2 is released.
-
-2004-09-29  Steve Youngs  
-
-	* Makefile (REQUIRES): Add ecrypto.
-
-2004-09-06  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.65 released.
-
-2004-08-31  Didier Verna  
-
-	* Patcher 3.6 is released.
-
-2004-06-30  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.64 released.
-
-2004-06-28  Jerry James  
-
-	* find-func.el: Synch with Emacs 21.3.
-	* find-func.el (find-function-space-re): New regular expression.
-	* find-func.el (find-function-regexp): Add several define-* forms.
-	* find-func.el (find-variable-regexp): Do not match defgroup.
-	* find-func.el (find-function-recenter-line): Add :type.
-	* find-func.el (find-function-search-for-symbol): Synch.
-	* find-func.el (find-function-noselect): Add autoload.
-	* find-func.el (find-function-read): Protect against 0 return
-	value of function-at-point.
-	* find-func.el (find-function-do-it): Remove unused orig-buf.
-	Quote run-hooks argument.
-	* find-func.el (find-variable-noselect): Autoload.  Add optional
-	FILE parameter.
-	* find-func.el (find-variable-at-point): Protect against 0 return
-	value of variable-at-point.
-
-2004-05-14  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.63 released.
-
-2004-05-03  Jerry James  
-
-	* profile.el (profile-results): Avoid division by zero.
-
-2004-03-30  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.62 released.
-
-2004-03-30  Steve Youngs  
-
-	* profile.el (profile-displaying-temp-buffer): New.
-	(profile-results): Use it.
-
-2004-01-13  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.61 released.
-
-2003-10-31  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.60 released.
-
-2003-10-08  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.59 released.
-
-2003-03-07  David A. Panariti  
-
-	* eldoc.el (eldoc-get-doc): Factored document string extraction
-	code out of `eldoc-print-current-symbol-info'.
-
-	(eldoc-print-current-symbol-info): Calls `eldoc-get-doc' to get
-	doc to print.
-
-	(eldoc-doc): New function.  Gets doc for current symbol and
-	displays it in the echo area.
-
-	(eldoc-insert-elisp-func-template): New function.  Converts doc
-	from `eldoc-get-doc' into a function template and inserts it at
-	point.
-
-2003-08-19  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.58 released.
-
-2003-08-15  Adrian Aichner  
-
-	* patch-keywords.el: Autoload patch-review defgroup for easier
-	integration of patch-keywords.
-
-2003-08-06  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.57 released.
-
-2003-08-06  Didier Verna  
-
-	* Patcher 3.5.2 is released.
-
-2003-07-30  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.56 released.
-
-2003-07-29  Didier Verna  
-
-	* Patcher 3.5 is released.
-
-2003-05-18  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.55 released.
-
-2003-05-14  Vin Shelton  
-
-	* Makefile (REQUIRES): Added eterm in order to find term.el.
-
-
-2003-05-14  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.54 released.
-
-2003-05-14  Steve Youngs  
-
-	* Makefile (REQUIRES): Add sh-script, net-utils.
-
-2003-04-26  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.53 released.
-
-2003-04-23  Didier Verna  
-
-	* Patcher 3.4.1 is released.
-
-2003-03-09  Ben Wing  
-
-	* Makefile:
-	Delete explicit compile:: and binkit: rules.
-	Don't add custom-load.elc to the list of generated elc's.
-	Use EXPLICIT_DOCS instead of explicitly giving the targets
-	and dependencies.
-	Delete recursive doc targets and do docs at top-level.
-
-2003-03-02  Norbert Koch  
-
-	* Makefile (VERSION): XEmacs package 1.52 released.
-
-	* Makefile (VERSION): XEmacs package 1.51 released.
-
-2003-02-13  Ben Wing  
-
-	* profile.el:
-	* profile.el (profile-results):
-	* profile.el (combine-profiling-info):
-	* profile.el (Calls): New.
-
-	Deal with new info added -- total-timing, gc-usage,
-	total-gc-usage.  Improve `profile-results' so you can specifying
-	sorting by call-count \(one C-u) or GC usage (two C-u's). (####
-	Perhaps they should be reversed?) Compress and prettify the output
-	somewhat so everything fits and make sure we don't go past 79
-	columns.  Add a bit of explanatory info at the bottom to explain
-	the compressed headers. #### Perhaps I should set truncate-lines to
-	t.
-
-2003-01-07  Didier Verna  
-
-	* Patcher 3.4 is released.
-
-2003-01-03  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.50 released.
-
-2002-12-17  Jerry James  
-
-	* Makefile (REQUIRES): Add rmail, tm, and apel due to transitive
-	dependencies on gnus.
-
-2002-12-07  Ben Wing  
-
-	* profile.el (profile-results): s/if-boundp/if (boundp)/
-	(combine-profiling-info): Ditto.
-
-2002-12-06  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.49 released.
-
-2002-11-29  Ben Wing  
-
-	* .cvsignore: Remove files now handled automatically by CVS.
-	* Makefile: Use `compile' instead of hard-coded `all'.
-
-	* profile.el:
-	* profile.el (profile-results):
-	* profile.el (profile):
-	* profile.el ('pretty-print-profiling-info): Removed.
-	* profile.el (profile-call-count-results): Removed.
-	* profile.el (profile-expression): New.
-	* profile.el (profile-command): New.
-	* profile.el (profile-key-sequence):
-	* profile.el (combine-profiling-info): New.
-	* profile.el (compile-and-profile):
-	* profile.el (compile-and-continue-profile): New.
-	* profile.el (save-profiling-info): New.
-	* profile.el (continue-profile): New.
-
-	Redo interface to eliminate major principle-of-least-surprise
-	violations and make it overall much more convenient.  Goes hand-in-
-	hand with changes on the C level, but still supports the old
-	C level interface.
-
-	Add new low-level functions save-profiling-info,
-	combine-profiling-info and (C level) set-profiling-info, which
-	together allow you full control over the profiling process and
-	allow you to properly implement things like nested profile runs,
-	combining many different profile results into a whole, etc.
-
-	Remove obsolete (4 years old) pretty-print-profiling-info.
-	Remove profile-call-count-results.  Call counts and now an
-	integral part of the profiling info, and the only real benefit
-	of this function (sort by call-count) is an argument or C-u to
-	profile-results.
-
-2002-10-15  Ville Skyttä  
-
-	* Makefile (srckit): Remove.
-
-2002-08-02  Rendhalver [Peter Brown]  
-
-	* Makefile (VERSION): XEmacs package 1.48 released.
-
-2002-07-18  Adrian Aichner  
-
-	* checkdoc.el (checkdoc-generate-compile-warnings-flag): Typo
-	fixing sync with GNU Emacs.
-	* checkdoc.el (checkdoc): Ditto (plus some re-wording).
-	* checkdoc.el (checkdoc-display-status-buffer): Ditto.
-	* checkdoc.el (checkdoc-interactive-loop): Ditto.
-	* checkdoc.el (checkdoc-next-message-error): Ditto.
-	* checkdoc.el (checkdoc-message-text-engine): Ditto.
-
-2002-07-14  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.47 released.
-
-2002-07-02  Didier Verna  
-
-	* Patcher 3.3.1 is released (oups, bugfix release).
-
-2002-07-02  Didier Verna  
-
-	* Patcher 3.3 is released.
-
-2002-06-27  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.46 released.
-
-2002-06-26  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.45 released.
-
-2002-06-24  Didier Verna  
-
-	* patcher.el: patcher 3.2 is released.
-
-2002-06-09  Adrian Aichner  
-
-	* Makefile (clean): New.  Hook in texi/Makefile.
-	* Makefile (distclean): New.  Ditto.
-
-2002-05-20  Steve Youngs  
-
-	* Makefile (VERSION): XEmacs package 1.44 released.
-
-2002-05-17  Adrian Aichner  
-
-	* Makefile (TEXI_FILES): New.
-	* Makefile (INFO_FILES): New.
-	* Makefile (html): New.
-	* patcher.el (patcher-default-gnus-group): Typo fix.
-
-2002-05-16  Didier Verna  
-
-	* Patcher 3.1 is released, with documentation !
-
-2002-03-04  Steve Youngs  
-
-	* patch-keywords.el: Conditionalise key binding on choice of MUA.
-	Update 'Commentary'.
-	(patch-keywords-insert-vm): New.
-	(patch-keywords-insert-gnus): New, renamed from
-	`patch-keywords-insert'.
-	(patch-review-mua): Enable VM.
-	(patch-keywords): Update doc string.
-	(patch-keywords-insert-vm): Update doc string.
-
-2002-02-25  Didier Verna  
-
-	* Patcher 3.0 is released.
-
-2002-02-22  Steve Youngs  
-
-	* package-info.in: Add patch-keywords.
-
-	* Makefile (REQUIRES): Add gnus for 'patch-keywords.el'.
-	(ELCS): Add patch-keywords.elc
-
-2002-01-18  Adrian Aichner  
-
-	* patch-keywords.el (patch-keywords-insert): Don't abbreviate
-	numeric keywords.
-
-2002-01-17  Steve Youngs  
-
-	* patch-keywords.el (patch-keywords): Update doc string.
-
-2002-01-16  Adrian Aichner  
-
-	* patch-keywords.el (patch-keywords): Use full release numbers.
-	(patch-keywords-insert): Use last digit of numeric keyword.
-
-2002-01-15  Adrian Aichner  
-
-	* patch-keywords.el: Typo fix.
-	(patch-keywords-message-beginning-of-line): Use
-	`patch-keywords-in-header-p' in older gnus-versions < 5.090004.
-	(patch-keywords-insert): Supply version	argument to
-	`gnus-continuum-version'.  It wasn't optional in gnus-versions
-	< 5.090004.
-
-2002-01-14  Steve Youngs  
-
-	* patch-keywords.el: New.
-
-2002-02-08  Simon Josefsson  
-
-	* elp.el: Change maintainer to XEmacs dev team exclusively.
-	Replace GNU Emacs with XEmacs in the license text.  Add note about
-	sync status.
-
-2002-01-13  Steve Youngs  
-
-	* package-info.in (provides): Update to include all provides.
-
-2002-01-10  John Paul Wallington  
-
-	* eldoc.el: use eldoc-minor-mode-string in add-minor-mode form.
-	(eldoc-minor-mode-string): fix custom type.
-
-2001-12-25  Simon Josefsson  
-
-	* elp.el: Sync with Emacs 21.1.
-	(top-level): Add years to copyright.  Change maintainer.  Remove
-	old version/last-modified.  Fix comments.  Remove comment about
-	max 18h as it has been fixed.
-	(elp-report-limit): Fix doc.
-	(elp-recycle-buffers-p): Fix doc.
-	(elp-version, elp-help-address): Removed.
-	(elp-not-profilable, elp-not-profilable-p): New function.
-	(elp-instrument-function): Don't profile profile functions.
-	(elp-instrument-function): Redo (list (list ...
-	(elp-instrument-function): Work with advice.
-	(elp-restore-function): Don't autoload.
-	(elp-restore-function): Change logic.
-	(elp-instrument-package): Error if all functions are instrumented.
-	(elp-instrument-package): Fix indentation.
-	(elp-reset-function): Fix doc.
-	(elp-get-time): Removed.
-	(elp-elapsed-time): New function.
-	(elp-wrapper): Use it.
-	(elp-wrapper): Fix doc.
-	(elp-wrapper): Change logic.
-	(elp-submit-bug-report): Removed.
-	(elp-unload-hook): New hook.
-
-2001-09-08  Adrian Aichner  
-
-	* bench.el (bench-large-lisp-file): Use expand-file-name instead
-	of concat to build path.
-	* bench.el (bench-small-lisp-file): Ditto.
-
-2001-09-04  Jeff Mincy  
-
-	* hide-copyleft.el (hide-copyleft-region): Make it interactive.
-
-2001-07-14  Steve Youngs  
-
-	* ibuffer.el: Move to edit-utils package.
-
-	* Makefile (ELCS): Remove ibuffer.elc
-
-2001-05-21  Martin Buchholz  
-
-	* hide-copyleft.el (hide-copyleft-region):
-	Remove (presumably) ancient debugging statement assigning to `x'.
-
-2001-05-22  Didier Verna  
-
-	* Patcher 2.5 is released.
-
-2001-05-16  Didier Verna  
-
-	* Patcher 2.4 is released.
-
-2001-05-11  Steve Youngs  
-
-	* ibuffer.el: New.
-
-2001-05-07  Didier Verna  
-
-	* Patcher 2.2 is released.
-
-2001-04-26  Steve Youngs  
-
-	* Makefile (REQUIRES): Add mail-lib.
-
-2001-04-25  Didier Verna  
-
-	* Patcher 2.1 is released.
-
-2001-04-12  Steve Youngs  
-
-	* patcher.el: New
-
-2001-04-10  Ben Wing  
-
-	* docref.el: Use correct name for hook.
-
-2000-12-12  Martin Buchholz  
-
-	* profile.el (profile-results): Prettier pretty-printing.
-	(For prettiest results, needs fixes to `format')
-
-2000-10-25  Yoshiki Hayashi  
-
-	* checkdoc.el: New file.
-
-2000-10-05  Martin Buchholz  
-
-	* *: Mega typo fix.
-
-2000-03-05  Martin Buchholz  
-
-	* profile.el (compile-and-profile): New.
-
-2000-05-28  Jim Radford  
-
-	* find-func.el (find-function-noselect): Aliased builtins can now
-	be found with find-function.
-
-2000-07-10  Ben Wing  
-
-	* find-func.el (find-function-regexp): augment to include various
-	define-* constructs for functions.
-	(find-variable-regexp): likewise.
-
-2000-03-04  Martin Buchholz  
-
-	* profile.el: Doc fixes.
-
-2000-01-13  Andreas Jaeger  
-
-	* regexp-opt.el: Moved to package xemacs-base since other packages
-	depend on it.
-
-	* Makefile (ELCS): Removed regexp-opt.elc.
-
-1998-09-28  Christoph Wedler  
-
-	* trace.el (trace-function-read): New function.
-	(trace-function): Use it.
-	(trace-function-background): Use it.
-
-1999-05-28  Karl M. Hegbloom  
-
-	* hide-copyleft.el: Get rid of `more-copylefts-to-hide', and just
-	customize `copylefts-to-hide'.
-
-1999-07-05  SL Baur  
-
-	* eldoc.el: Use add-minor-mode to add as a minor mode.
-	From Bob Weiner 
-
-1998-10-20  Andy Piper  
-
-	* bench.el (bench-large-lisp-file): use temp-directory rather than
-	home-grown temp-dir.
-	(bench-small-lisp-file): ditto.
-	(temp-dir): removed.
-
-1998-09-18  Noah Friedman  
-
-	* eldoc.el (eldoc-message): Check for 1-arg case, and store string
-	in eldoc-last-message without consing a new string.
-	Rearrange logic from nested if's into cond's.
-	(eldoc-print-fnsym-args): Renamed to eldoc-get-fnsym-args-string.
-	Do not print message; just return string.
-	(eldoc-get-var-docstring): Renamed from eldoc-print-var-docstring.
-	Do not print message; just return string.
-	Cache that string in eldoc-last-data.
-	(eldoc-last-data): Make into a vector.
-	(eldoc-get-fnsym-args-string): Use new data form of structure.
-	(eldoc-get-var-docstring): Here also.
-	(eldoc-last-data-store): New function.
-	(eldoc-get-fnsym-args-string): Use it.
-	(eldoc-get-var-docstring): Here also.
-	(eldoc-docstring-first-line): Minimize interim string consing.
-	Call substitute-command-keys on the result.
-	(eldoc-print-var-docstrings, eldoc-print-docstring,
-	eldoc-docstring-message): Functions removed.
-	(eldoc-docstring-format-sym-doc): New function, functionality
-	ripped out of eldoc-docstring-message.
-	(eldoc-get-fnsym-args-string, eldoc-get-var-docstring): Use it.
-
-1998-08-19  Karl M. Hegbloom  
-
-	* ielm.el (ielm-eval-input): Change `:', `::', `:::' to `!'...,
-	since the `:' is special syntax now for keyword variables.
- 	(several other occurances also changed.) I chose !, because shells
-	use that character for history expansion.
-	(ielm-eval-input): Check that `ielm-string' is not null.
- 	Integrated reversed patch from Gregory Neil Shapiro
-	.
-
-1998-08-15  SL Baur  
-
-	* eval-expr.el (eval-expr-display-message): screen-width ->
-	frame-width.
-
-1998-07-14  Jens-Ulrik Petersen  
-
-	* find-func.el: Version 0.22 released.
-	(find-function-search-for-symbol): Put error sexp into simplier
-	`format' format.
-	(find-function-do-it): Fixed problem when a symbol in current
-	buffer found in other-window.
-	Added `help-mode-map' key bindings to `find-function-at-point' and
-	`find-variable-at-point' that used to be in "help".
-
-1998-06-15  Jens-Ulrik Petersen  
-
-	* find-func.el: Version 0.21 released.
-	Improvements to the preamble.  Require "loadhist".
-	(find-function-source-path): Simplified the custom type.
-	(find-function-recenter-line): New variable to control center of
-	definition.
-	(find-function-after-hook): New variable.
-	(find-function-search-for-symbol): `regexp-quote' the symbol name:
-	needed to find-function `mapcar*' for example.  [Patch from Hrvoje
-	Niksic ]
-	(find-function-search-for-symbol): Include library name in error
-	message when symbol can't be found.
-	(find-function-noselect): Improved docstring.  Don't include
-	`library' in let [Thanks to Bob Weiner ].
-	Use `symbol-file' instead of `describe-symbol-find-file'.  Protect
-	`compiled-function-annotation' call and keep it for older
-	XEmacsen.  Use `file-name-sans-extension' for compiled functions.
-	(find-function-read): Separate `completing-read' calls for
-	variables and functions, and use `variable-history'.
-	(find-function-do-it): Mention new `find-function-recenter-line'
-	and `find-function-after-hook' in docstring.  Use them.
-	(find-function): Mention `find-function-recenter-line' and
-	`find-function-after-hook' in docstring.
-	(find-function-other-window): Remove most of docstring and add
-	reference to `find-function' instead.
-	(find-function-other-frame): Ditto.
-	(find-variable-noselect): Use `symbol-file' instead of
-	`describe-symbol-find-file'.
-	(find-variable): Mention `find-function-recenter-line' and
-	`find-function-after-hook' in docstring.
-	(find-variable-other-window): Remove most of docstring and add
-	reference to `find-variable' instead.
-	(find-variable-other-frame): Ditto.
-	(find-function-on-key): Simplified.
-
-1998-04-20  Karl M. Hegbloom  
-
-	* hide-copyleft.el (more-copylefts-to-hide): Added defcustom.
-
-1998-04-18  Hrvoje Niksic  
-
-	* profile.el (profile-results): When `internal-error-checking' is
-	non-nil, warn that the results are likely bogus.
-
-1998-03-26  Jens-Ulrik Petersen  
-
-	* find-func.el (find-function-read): Call `variable-at-point' for
-	variable and `function-at-point' for function, not the other way
-	round!
-	() Comment out keybindings with their autoload cookies to be
-	custom-friendlier.
-	() Version 0.20 released.
-
-1998-03-09  SL Baur  
-
-	* hide-copyleft.el: restored.
-
-1998-03-03  Markus Linnala  
-
-	* find-gc.el (trace-call-tree): Use make to make RTL's.
-	(find-gc-unsafe): Print output to buffer. Change
-	garbage_collecting function from Fgarbage_collect_1 to
-	garbage_collect_1.
-	(emacs-source-directory): Change default.
-	(source-files): Try to get default from src directory.
-
-1998-03-04  Jens-Ulrik Petersen  
-
-	* find-func.el (find-function-regexp): New variable, taken from
-	former constant in `find-function-noselect'.  Can now find
-	function definitions with parameters on a new line (suggested by
-	Christoph Wedler ).
-	(find-variable-regexp): New variable.
-	(find-function-search-for-symbol): New function of stuff taken out
-	of `find-function-noselect'
-	(find-function-noselect): Use it and `find-function-regexp'.
-	(find-function-read): Renamed from `find-function-read-function'.
-	With optional arg now read a variable.
-	(find-function-do-it): Added parameter to indicate if a variable
-	is being searched for.
-	(find-function): Use `find-function-read'.
-	(find-function-other-window): Ditto.
-	(find-function-other-frame): Ditto.
-	(find-variable-noselect): New function for finding the point of
-	definition of variables, modeled on `find-function-noselect'.
-	(find-variable): New function.
-	(find-variable-other-window): Ditto.
-	(find-variable-other-frame): Ditto.
-	(find-variable-at-point): New function for "help".
-	(ctl-x-map): Bind find-variable functions.
-
-1998-02-08  Kyle Jones  
-
-	* xemacs-devel/pretty-print.el: Don't bind keys when
-	  loaded.
-
-1998-02-01  SL Baur  
-
-	* eldoc.el (eldoc-mode): Append to post-command-hook.
-	From David Byers 
-
-1998-01-24  SL Baur  
-
-	* Makefile (VERSION): Update to package standard 1.0.
-
-1998-01-13  Hrvoje Niksic  
-
-	* old-prim/profile.el (profile-results): Use call-count-profile-table.
-	(profile-call-count-results): New function.
-
-1998-01-12  SL Baur  
-
-	* pretty-print.el: Reformat comments.
-
-1997-12-27  Jens-Ulrik Holger Petersen  
-
-	* pretty-print.el (pp-internal): Make it autoloaded.  Docstring typo.
-
-1997-12-17  Jens-Ulrik Holger Petersen  
-
-	* pretty-print.el (pp-internal-sexp): Protect fboundp call with
-	symbolp test.  Necessary to be able to print a value of `(-3 smthg)'
-	for example.
-
-1998-01-11  SL Baur  
-
-	* Makefile (ELCS): Add pretty-print.el.
-	Update to latest package spec.
-
-1997-12-10  Christoph Wedler  
-
-	* find-func.el (find-function-noselect): `regexp-quote'
-	function name FUNCTION.
-
-1998-01-02  SL Baur  
-
-	* _pkg.el (xemacs-devel): Updated package-provide spec.
-
-1998-01-01  SL Baur  
-
-	* ielm.el: New file.
-
-1997-12-24  SL Baur  
-
-	* elp.el: Remove bytecompile time dependency on reporter
-
-	* Makefile: Added find-func.el, regexp-opt.el, and reposition.el.
-
-1997-12-23  SL Baur  
-
-	* docref.el: Updated commentary.
-
-	* Makefile: Created.
diff --git a/xemacs-packages/lisp/xemacs-devel/_pkg.el b/xemacs-packages/lisp/xemacs-devel/_pkg.el
deleted file mode 100644
index 563fb44c..00000000
--- a/xemacs-packages/lisp/xemacs-devel/_pkg.el
+++ /dev/null
@@ -1,5 +0,0 @@
-;;;###autoload
-(package-provide 'xemacs-devel
-		 :version 1.72
-          :author-version "No-Upstream-Ver"
-		 :type 'single-file)
diff --git a/xemacs-packages/lisp/xemacs-devel/auto-autoloads.el b/xemacs-packages/lisp/xemacs-devel/auto-autoloads.el
deleted file mode 100644
index 3e43325e..00000000
--- a/xemacs-packages/lisp/xemacs-devel/auto-autoloads.el
+++ /dev/null
@@ -1,582 +0,0 @@
-;;; DO NOT MODIFY THIS FILE
-(if (featurep 'xemacs-devel-autoloads) (error "Already loaded"))
-
-;;;### (autoloads nil "_pkg" "xemacs-devel/_pkg.el")
-
-(package-provide 'xemacs-devel :version 1.72 :author-version "No-Upstream-Ver" :type 'single-file)
-
-;;;***
-
-;;;### (autoloads (checkdoc-minor-mode checkdoc-ispell-defun checkdoc-ispell-comments checkdoc-ispell-continue checkdoc-ispell-start checkdoc-ispell-message-text checkdoc-ispell-message-interactive checkdoc-ispell-interactive checkdoc-ispell-current-buffer checkdoc-ispell checkdoc-defun checkdoc-eval-defun checkdoc-message-text checkdoc-rogue-spaces checkdoc-continue checkdoc-start checkdoc-current-buffer checkdoc-eval-current-buffer checkdoc-message-interactive checkdoc-interactive checkdoc) "checkdoc" "xemacs-devel/checkdoc.el")
-
-(autoload 'checkdoc "checkdoc" "\
-Interactively check the entire buffer for style errors.
-The current status of the check will be displayed in a buffer for
-user to view as each check is completed." t nil)
-
-(autoload 'checkdoc-interactive "checkdoc" "\
-Interactively check the current buffer for doc string errors.
-Prefix argument START-HERE will start the checking from the current
-point, otherwise the check starts at the beginning of the current
-buffer.  Allows navigation forward and backwards through document
-errors.  Does not check for comment or space warnings.
-Optional argument SHOWSTATUS indicates that we should update the
-checkdoc status window instead of the usual behavior." t nil)
-
-(autoload 'checkdoc-message-interactive "checkdoc" "\
-Interactively check the current buffer for message string errors.
-Prefix argument START-HERE will start the checking from the current
-point, otherwise the check starts at the beginning of the current
-buffer.  Allows navigation forward and backwards through document
-errors.  Does not check for comment or space warnings.
-Optional argument SHOWSTATUS indicates that we should update the
-checkdoc status window instead of the usual behavior." t nil)
-
-(autoload 'checkdoc-eval-current-buffer "checkdoc" "\
-Evaluate and check documentation for the current buffer.
-Evaluation is done first because good documentation for something that
-doesn't work is just not useful.  Comments, doc strings, and rogue
-spacing are all verified." t nil)
-
-(autoload 'checkdoc-current-buffer "checkdoc" "\
-Check current buffer for document, comment, error style, and rogue spaces.
-With a prefix argument (in Lisp, the argument TAKE-NOTES),
-store all errors found in a warnings buffer,
-otherwise stop after the first error." t nil)
-
-(autoload 'checkdoc-start "checkdoc" "\
-Start scanning the current buffer for documentation string style errors.
-Only documentation strings are checked.
-Use `checkdoc-continue' to continue checking if an error cannot be fixed.
-Prefix argument TAKE-NOTES means to collect all the warning messages into
-a separate buffer." t nil)
-
-(autoload 'checkdoc-continue "checkdoc" "\
-Find the next doc string in the current buffer which has a style error.
-Prefix argument TAKE-NOTES means to continue through the whole buffer and
-save warnings in a separate buffer." t nil)
-
-(autoload 'checkdoc-rogue-spaces "checkdoc" "\
-Find extra spaces at the end of lines in the current file.
-Prefix argument TAKE-NOTES non-nil means to save warnings in a
-separate buffer.  Otherwise print a message.  This returns the error
-if there is one.
-Optional argument INTERACT permits more interactive fixing." t nil)
-
-(autoload 'checkdoc-message-text "checkdoc" "\
-Scan the buffer for occurrences of the error function, and verify text.
-Optional argument TAKE-NOTES causes all errors to be logged." t nil)
-
-(autoload 'checkdoc-eval-defun "checkdoc" "\
-Evaluate the current form with `eval-defun' and check its documentation.
-Evaluation is done first so the form will be read before the
-documentation is checked.  If there is a documentation error, then the display
-of what was evaluated will be overwritten by the diagnostic message." t nil)
-
-(autoload 'checkdoc-defun "checkdoc" "\
-Examine the doc string of the function or variable under point.
-Call `error' if the doc string has problems.  If NO-ERROR is
-non-nil, then do not call error, but call `message' instead.
-If the doc string passes the test, then check the function for rogue white
-space at the end of each line." t nil)
-
-(autoload 'checkdoc-ispell "checkdoc" "\
-Check the style and spelling of everything interactively.
-Calls `checkdoc' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc'" t nil)
-
-(autoload 'checkdoc-ispell-current-buffer "checkdoc" "\
-Check the style and spelling of the current buffer.
-Calls `checkdoc-current-buffer' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'" t nil)
-
-(autoload 'checkdoc-ispell-interactive "checkdoc" "\
-Check the style and spelling of the current buffer interactively.
-Calls `checkdoc-interactive' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-interactive'" t nil)
-
-(autoload 'checkdoc-ispell-message-interactive "checkdoc" "\
-Check the style and spelling of message text interactively.
-Calls `checkdoc-message-interactive' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-message-interactive'" t nil)
-
-(autoload 'checkdoc-ispell-message-text "checkdoc" "\
-Check the style and spelling of message text interactively.
-Calls `checkdoc-message-text' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-message-text'" t nil)
-
-(autoload 'checkdoc-ispell-start "checkdoc" "\
-Check the style and spelling of the current buffer.
-Calls `checkdoc-start' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-start'" t nil)
-
-(autoload 'checkdoc-ispell-continue "checkdoc" "\
-Check the style and spelling of the current buffer after point.
-Calls `checkdoc-continue' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-continue'" t nil)
-
-(autoload 'checkdoc-ispell-comments "checkdoc" "\
-Check the style and spelling of the current buffer's comments.
-Calls `checkdoc-comments' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-comments'" t nil)
-
-(autoload 'checkdoc-ispell-defun "checkdoc" "\
-Check the style and spelling of the current defun with Ispell.
-Calls `checkdoc-defun' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'" t nil)
-
-(autoload 'checkdoc-minor-mode "checkdoc" "\
-Toggle Checkdoc minor mode, a mode for checking Lisp doc strings.
-With prefix ARG, turn Checkdoc minor mode on iff ARG is positive.
-
-In Checkdoc minor mode, the usual bindings for `eval-defun' which is
-bound to \\ \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
-checking of documentation strings.
-
-\\{checkdoc-minor-keymap}" t nil)
-
-;;;***
-
-;;;### (autoloads (docref-setup) "docref" "xemacs-devel/docref.el")
-
-(autoload 'docref-setup "docref" "\
-Process docref cross-references in the current buffer.
-See also \\(f@docref-subst)." t nil)
-
-;;;***
-
-;;;### (autoloads (turn-on-eldoc-mode eldoc-mode) "eldoc" "xemacs-devel/eldoc.el")
-
-(defcustom eldoc-mode nil "*If non-nil, show the defined parameters for the elisp function near point.\n\nFor the emacs lisp function at the beginning of the sexp which point is\nwithin, show the defined parameters for the function in the echo area.\nThis information is extracted directly from the function or macro if it is\nin pure lisp.  If the emacs function is a subr, the parameters are obtained\nfrom the documentation string if possible.\n\nIf point is over a documented variable, print that variable's docstring\ninstead.\n\nThis variable is buffer-local." :type 'boolean :group 'eldoc)
-
-(autoload 'eldoc-mode "eldoc" "\
-*Enable or disable eldoc mode.
-See documentation for the variable of the same name for more details.
-
-If called interactively with no prefix argument, toggle current condition
-of the mode.
-If called with a positive or negative prefix argument, enable or disable
-the mode, respectively." t nil)
-
-(autoload 'turn-on-eldoc-mode "eldoc" "\
-Unequivocally turn on eldoc-mode (see variable documentation)." t nil)
-
-;;;***
-
-;;;### (autoloads (elp-results elp-instrument-package elp-instrument-list elp-instrument-function) "elp" "xemacs-devel/elp.el")
-
-(autoload 'elp-instrument-function "elp" "\
-Instrument FUNSYM for profiling.
-FUNSYM must be a symbol of a defined function." t nil)
-
-(autoload 'elp-instrument-list "elp" "\
-Instrument for profiling, all functions in `elp-function-list'.
-Use optional LIST if provided instead." t nil)
-
-(autoload 'elp-instrument-package "elp" "\
-Instrument for profiling, all functions which start with PREFIX.
-For example, to instrument all ELP functions, do the following:
-
-    \\[elp-instrument-package] RET elp- RET" t nil)
-
-(autoload 'elp-results "elp" "\
-Display current profiling results.
-If `elp-reset-after-results' is non-nil, then current profiling
-information for all instrumented functions are reset after results are
-displayed." t nil)
-
-;;;***
-
-;;;### (autoloads (eval-expr eval-expr-install) "eval-expr" "xemacs-devel/eval-expr.el")
-
-(defvar eval-expr-error-message-delay 3 "\
-*Amount of time, in seconds, to display in echo area before continuing.")
-
-(defvar eval-expr-prompt "Eval: " "\
-*Prompt used by eval-expr.")
-
-(defvar eval-expr-honor-debug-on-error t "\
-*If non-nil, do not trap evaluation errors.
-Instead, allow errors to throw user into the debugger, provided
-debug-on-error specifies that the particular error is a debuggable condition.")
-
-(defvar eval-expr-print-level (default-value 'print-level) "\
-*Like print-level, but affect results printed by `eval-expr' only.")
-
-(defvar eval-expr-print-length (default-value 'print-length) "\
-*Like print-length, but affect results printed by `eval-expr' only.")
-
-(autoload 'eval-expr-install "eval-expr" "\
-Replace standard eval-expression command with enhanced eval-expr." t nil)
-
-(autoload 'eval-expr "eval-expr" "\
-Evaluate EXPRESSION and print value in minibuffer, temp, or current buffer.
-A temp output buffer is used if there is more than one line in the
-evaluated result.
-If invoked with a prefix arg, or second lisp argument EE::INSERT-VALUE is
-non-nil, then insert final value into the current buffer at point.
-
-Value is also consed on to front of the variable `values'." t nil)
-
-;;;***
-
-;;;### (autoloads (find-variable-at-point find-function-at-point find-function-on-key find-variable-other-frame find-variable-other-window find-variable find-variable-noselect find-function-other-frame find-function-other-window find-function find-function-noselect find-function-search-for-symbol) "find-func" "xemacs-devel/find-func.el")
-
-(autoload 'find-function-search-for-symbol "find-func" "\
-Search for SYMBOL in LIBRARY.
-If VARIABLE-P is nil, `find-function-regexp' is used, otherwise
-`find-variable-regexp' is used." nil nil)
-
-(autoload 'find-function-noselect "find-func" "\
-Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
-
-Finds the Emacs Lisp library containing the definition of FUNCTION
-in a buffer and the point of the definition.  The buffer is
-not selected.
-
-If the file where FUNCTION is defined is not known, then it is
-searched for in `find-function-source-path' if non nil, otherwise
-in `load-path'." nil nil)
-
-(autoload 'find-function "find-func" "\
-Find the definition of the function near point in the current window.
-
-Finds the Emacs Lisp library containing the definition of the function
-near point (selected by `function-at-point') in a buffer and
-places point before the definition.  Point is saved in the buffer if
-it is one of the current buffers.
-
-The library where FUNCTION is defined is searched for in
-`find-function-source-path', if non nil, otherwise in `load-path'.
-See also `find-function-recenter-line' and `find-function-after-hook'." t nil)
-
-(autoload 'find-function-other-window "find-func" "\
-Find the definition of the function near point in another window.
-
-See `find-function' for more details." t nil)
-
-(autoload 'find-function-other-frame "find-func" "\
-Find the definition of the function near point in another frame.
-
-See `find-function' for more details." t nil)
-
-(autoload 'find-variable-noselect "find-func" "\
-Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL.
-
-Finds the Emacs Lisp library containing the definition of SYMBOL
-in a buffer and the point of the definition.  The buffer is
-not selected.
-
-The library where VARIABLE is defined is searched for in FILE or
-`find-function-source-path', if non nil, otherwise in `load-path'." nil nil)
-
-(autoload 'find-variable "find-func" "\
-Find the definition of the variable near point in the current window.
-
-Finds the Emacs Lisp library containing the definition of the variable
-near point (selected by `variable-at-point') in a buffer and
-places point before the definition.  Point is saved in the buffer if
-it is one of the current buffers.
-
-The library where VARIABLE is defined is searched for in
-`find-function-source-path', if non nil, otherwise in `load-path'.
-See also `find-function-recenter-line' and `find-function-after-hook'." t nil)
-
-(autoload 'find-variable-other-window "find-func" "\
-Find the definition of the variable near point in another window.
-
-See `find-variable' for more details." t nil)
-
-(autoload 'find-variable-other-frame "find-func" "\
-Find the definition of the variable near point in another frame.
-
-See `find-variable' for more details." t nil)
-
-(autoload 'find-function-on-key "find-func" "\
-Find the function that KEY invokes.  KEY is a string.
-Point is saved if FUNCTION is in the current buffer." t nil)
-
-(autoload 'find-function-at-point "find-func" "\
-Find directly the function at point in the other window." t nil)
-
-(autoload 'find-variable-at-point "find-func" "\
-Find directly the function at point in the other window." t nil)
-(define-key ctl-x-4-map "F" 'find-function-other-window)
-(define-key ctl-x-5-map "F" 'find-function-other-frame)
-(define-key ctl-x-map "K" 'find-function-on-key)
-(define-key ctl-x-map "V" 'find-variable)
-(define-key ctl-x-4-map "V" 'find-variable-other-window)
-(define-key ctl-x-5-map "V" 'find-variable-other-frame)
-(define-key help-mode-map "F" 'find-function-at-point)
-(define-key help-mode-map "V" 'find-variable-at-point)
-
-;;;***
-
-;;;### (autoloads (unhide-copyleft-region hide-copyleft-region) "hide-copyleft" "xemacs-devel/hide-copyleft.el")
-
-(autoload 'hide-copyleft-region "hide-copyleft" "\
-Make the legal drivel at the front of this file invisible.  Unhide it again
-with C-u \\[hide-copyleft-region]." t nil)
-
-(autoload 'unhide-copyleft-region "hide-copyleft" nil t nil)
-
-;;;***
-
-;;;### (autoloads (ielm) "ielm" "xemacs-devel/ielm.el")
-(add-hook 'same-window-buffer-names "*ielm*")
-
-(autoload 'ielm "ielm" "\
-Interactively evaluate Emacs Lisp expressions.
-Switches to the buffer `*ielm*', or creates it if it does not exist." t nil)
-
-;;;***
-
-;;;### (autoloads nil "patch-keywords" "xemacs-devel/patch-keywords.el")
-
-(defgroup patch-review nil "Patch submission review." :group 'mail)
-
-;;;***
-
-;;;### (autoloads (patcher-insinuate-gnus patcher-mail-adapt-subproject patcher-mail-adapt patcher-mail patcher-mail-subproject patcher-version) "patcher" "xemacs-devel/patcher.el")
-
-(autoload 'patcher-version "patcher" "\
-Show the current version of Patcher." t nil)
-
-(autoload 'patcher-mail-subproject "patcher" "\
-Prepare a mail about a patch to apply on part of a project.
-PROJECT is the name of the project (see the variables `patcher-projects'
-and `patcher-subprojects').
-SUBJECT is the subject of the mail.
-FILES is a string listing one or more files, possibly with wild cards --
-  essentially, part of a command line to be interpolated into the `diff'
-  and maybe the `commit' commands issued by Patcher.
-
-When called interactively, use a prefix (ARG) to override the value of
-the diff command to use for this project.
-
-This function is intended for one-time only subprojects.  Alternately, you
-can define subprojects in the variable `patcher-subprojects' and continue
-using `patcher-mail'.  If you call this function on a predefined subproject,
-you will have the opportunity to modify the predefined list of files or
-directories the subproject is composed of.
-
-When you use this command instead of `patcher-mail', any commits issued
-from the mail buffer (using \\\\[patcher-commit-change]) will automatically include
-the associated ChangeLogs, as well as the file(s) specified as part of
-this command.
-
-Please note that you can have multiple occurrences of a Patcher mail at
-the same time, but not more than one at a time on the same project unless
-you use `patcher-mail-subproject' and the sections of the project don't
-overlap." t nil)
-
-(autoload 'patcher-mail "patcher" "\
-Prepare a mail about a patch to apply on a project.
-PROJECT is the name of the project (see the variables `patcher-projects'
-and `patcher-subprojects').
-SUBJECT is the subject of the mail.
-
-When called interactively, use a prefix (ARG) to override the value of
-the diff command to use for this project.  Note that this is *not* the way
-to restrict the diff to certain files.  If you want to work on a subset of
-the project (e.g. some files, subdirectories etc), you have two
-alternatives:
-
-- for temporary subprojects, you can use the function
-  `patcher-mail-subproject', which lets you specify the list of modified
-  files / directories.
-- otherwise, you can also define the subprojects in the variable
-  `patcher-subprojects' and continue using this function.
-
-Please note that you can have multiple occurrences of a Patcher mail at
-the same time, but not more than one at a time on the same project unless
-you use `patcher-mail-subproject' and the sections of the project don't
-overlap." t nil)
-
-(autoload 'patcher-mail-adapt "patcher" "\
-Same as `patcher-mail', but for already started mails.
-This function is mostly designed to adapt replies or followups probably
-started with your usual MUA to Patcher.
-
-Note two differences with `patcher-mail' however:
-1. there is no SUBJECT argument to this function,
-2. no prefix argument is available to override the diff command." t nil)
-
-(autoload 'patcher-mail-adapt-subproject "patcher" "\
-Same as `patcher-mail-subproject', but for already started mails.
-This function is mostly designed to adapt replies or followups probably
-started with your usual MUA to Patcher.
-
-Note two differences with `patcher-mail-subproject' however:
-1. there is no SUBJECT argument to this function,
-2. no prefix argument is available to override the diff command." t nil)
-
-(autoload 'patcher-insinuate-gnus "patcher" "\
-This function plugs Patcher into Gnus.
-It should be called from your gnusrc file." nil nil)
-
-;;;***
-
-;;;### (autoloads (pp-internal prettyexpand-all-sexp prettyexpand-sexp macroexpand-all-sexp macroexpand-sexp pp-plist pp-variable pp-function) "pretty-print" "xemacs-devel/pretty-print.el")
-
-(autoload 'pp-function "pretty-print" "\
-Pretty print the function definition of SYMBOL in a separate buffer" t nil)
-
-(autoload 'pp-variable "pretty-print" "\
-Pretty print the variable value of SYMBOL in a separate buffer" t nil)
-
-(autoload 'pp-plist "pretty-print" "\
-Pretty print the property list of SYMBOL in a separate buffer" t nil)
-
-(autoload 'macroexpand-sexp "pretty-print" "\
-Macro expand the sexpression following point. Pretty print expansion in a
-temporary buffer. With prefix argument, replace the original
-sexpression by its expansion in the current buffer." t nil)
-
-(autoload 'macroexpand-all-sexp "pretty-print" "\
-Macro expand recursively the sexpression following point. Pretty print
-expansion in a temporary buffer. With prefix argument, replace the
-original sexpression by its expansion in the current buffer." t nil)
-
-(autoload 'prettyexpand-sexp "pretty-print" "\
-Macro expand the sexpression following point. Pretty print expansion
-in a temporary buffer. With prefix argument, replace the original
-sexpression by its expansion in the current buffer.  
-	However, calls to macros specified in the variable
-`pp-shadow-expansion-list' are not expanded, in order to make the code
-look nicer." t nil)
-
-(autoload 'prettyexpand-all-sexp "pretty-print" "\
-Macro expand recursively the sexpression following point. Pretty print
-expansion in a temporary buffer. With prefix argument, replace the
-original sexpression by its expansion in the current buffer.
-	However, calls to macros specified in the variable
-`pp-shadow-expansion-list' are not expanded, in order to make the code
-look nicer." t nil)
-
-(autoload 'pp-internal "pretty-print" "\
-Pretty print FORM in in the current buffer.
-Optional string TITLE is inserted before the pretty print." nil nil)
-
-;;;***
-
-;;;### (autoloads (compile-and-continue-profile compile-and-profile toggle-profiling profile-key-sequence profile-command profile-expression continue-profile profile save-profiling-info combine-profiling-info profile-results) "profile" "xemacs-devel/profile.el")
-
-(autoload 'profile-results "profile" "\
-Print profiling info INFO to STREAM in a pretty format.
-If INFO is omitted, the current profiling info is retrieved using
- `get-profiling-info'.
-If STREAM is omitted, the results will be displayed in a temp buffer
- using `with-output-to-temp-buffer'; otherwise, they will simply be
- printed into STREAM.  Use `standard-output' explicitly if you
- want standard output.
-If SORT-BY is `call-count' (interactively, the prefix arg), display items
- sorted by call count rather than timing.  If `gc-usage' (interactively,
- use C-u C-u), sort by GC usage." t nil)
-
-(autoload 'combine-profiling-info "profile" "\
-Add up the profiling results accumulated during many profiling sessions.
-See `profile'." nil nil)
-
-(autoload 'save-profiling-info "profile" "\
-Execute BODY, preserving the profiling info and profiling on-ness." nil 'macro)
-
-(autoload 'profile "profile" "\
-Profile FORMS and display results in a temporary buffer.
-This clears out existing profiling info, turns on profiling, executes
-the forms, turns off profiling, and displays the results.
-
-If you want to accumulate the results of multiple profiling runs, you can
-use `continue-profile', which does not clear out existing profiling info.
-
-If you are looking for high-level interactive commands for profiling key
-sequences, commands, and expressions, see `profile-key-sequence',
-`profile-command', and `profile-expression'.
-
-See also `toggle-profiling', which lets you easily profile any sequence
-of commands.
-
-If you need more control over what is profiled and what isn't, use the more
-basic functions `clear-profiling-info', `start-profiling',
-`stop-profiling', `profile-results', `get-profiling-info',
-`combine-profiling-info' and `save-profiling-info'." nil 'macro)
-
-(autoload 'continue-profile "profile" "\
-Profile FORMS, combining the results with previous profile runs.
-Display results in a temporary buffer.  Unlike `profile', this does
-not clear out existing profile information first, and will leave profiling
-on if it was already on when this macro was invoked." nil 'macro)
-
-(autoload 'profile-expression "profile" "\
-Eval EXPR, profiling the execution and displaying the results.
-With prefix, combine results with results from a previous run." t nil)
-
-(autoload 'profile-command "profile" "\
-Run COMMAND, profiling the execution and displaying the results.
-With prefix, combine results with results from a previous run." t nil)
-
-(autoload 'profile-key-sequence "profile" "\
-Dispatch the key sequence KEYS, profile the execution and show the results.
-KEYS can be a vector of keypress events, a keypress event, or a character.
-With prefix, combine results with results from a previous run." t nil)
-
-(autoload 'toggle-profiling "profile" "\
-Start profiling, or stop it and print results.
-This lets you figure out where time is being spent when executing Lisp code." t nil)
-
-(autoload 'compile-and-profile "profile" "\
-Byte compile FORMS, profile the execution, and pretty-print the results." nil 'macro)
-
-(autoload 'compile-and-continue-profile "profile" "\
-Like `compile-and-profile' but combine results with previous profile runs." nil 'macro)
-
-;;;***
-
-;;;### (autoloads (reposition-window) "reposition" "xemacs-devel/reposition.el")
-
-(autoload 'reposition-window "reposition" "\
-Make the current definition and/or comment visible.
-Further invocations move it to the top of the window or toggle the
-visibility of comments that precede it.
-  Point is left unchanged unless prefix ARG is supplied.
-  If the definition is fully onscreen, it is moved to the top of the
-window.  If it is partly offscreen, the window is scrolled to get the
-definition (or as much as will fit) onscreen, unless point is in a comment
-which is also partly offscreen, in which case the scrolling attempts to get
-as much of the comment onscreen as possible.
-  Initially `reposition-window' attempts to make both the definition and
-preceding comments visible.  Further invocations toggle the visibility of
-the comment lines.
-  If ARG is non-nil, point may move in order to make the whole defun
-visible (if only part could otherwise be made so), to make the defun line
-visible (if point is in code and it could not be made so, or if only
-comments, including the first comment line, are visible), or to make the
-first comment line visible (if point is in a comment)." t nil)
-
-;;;***
-
-;;;### (autoloads (trace-function-background trace-function) "trace" "xemacs-devel/trace.el")
-
-(defvar trace-buffer "*trace-output*" "\
-*Trace output will by default go to that buffer.")
-
-(autoload 'trace-function "trace" "\
-Traces FUNCTION with trace output going to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! The trace BUFFER will popup whenever FUNCTION is called.
-Do not use this to trace functions that switch buffers or do any other
-display oriented stuff, use `trace-function-background' instead." t nil)
-
-(autoload 'trace-function-background "trace" "\
-Traces FUNCTION with trace output going quietly to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! Trace output will quietly go to BUFFER without changing
-the window or buffer configuration at all." t nil)
-
-;;;***
-
-(provide 'xemacs-devel-autoloads)
diff --git a/xemacs-packages/lisp/xemacs-devel/bench.el b/xemacs-packages/lisp/xemacs-devel/bench.el
deleted file mode 100644
index ea7ff1cd..00000000
--- a/xemacs-packages/lisp/xemacs-devel/bench.el
+++ /dev/null
@@ -1,540 +0,0 @@
-;;; bench.el --- benchmarking utility for emacsen
-
-;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
-;; $Id: bench.el,v 1.4 2001/09/08 11:01:26 adrian Exp $	
-;; $Source: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xemacs-devel/bench.el,v $
-;; $Revision: 1.4 $
-;; $Author: adrian $
-;; $Date: 2001/09/08 11:01:26 $
-
-;; Author: Shane Holder 
-;; Adapted-By: Steve Baur 
-;; Further adapted by: Shane Holder 
-;; Keywords: internal, maint
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Commentary:
-
-;; Adapted from Shane Holder's bench.el by steve@xemacs.org.
-
-;; To run
-;; Extract the shar file in /tmp, or modify bench-lisp-file to
-;; point to the gnus.el file.
-;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or site-file
-;; M-x byte-compile-file "/tmp/bench.el"
-;; M-x load-file "/tmp/bench.elc"
-;; In the scratch buffer (bench 1)
-
-
-;; All bench marks must be named bench-mark-
-;; Results are put in bench-mark-
-
-;;; Code:
-
-;; Use elp to profile benchmarks
-(require 'cl)				;Emacs doesn't have when and cdar
-
-;-----------------------------------------------------------------------------
-(defvar bench-mark-hanoi-times nil)
-
-(defun bench-handler-hanoi (times)
-  (let ((start-time))
-  (while (> times 0)
-;    (setq start-time (bench-get-time))
-    (bench-mark-hanoi)
-;    (setq bench-mark-hanoi-times (cons (- (bench-get-time) start-time ) bench-mark-hanoi-times ))
-    (setq times (- times 1))))
-)
-
-(defun bench-mark-hanoi ()
-  "How long to complete the tower of hanoi."
-  (hanoi 4))
-
-;-----------------------------------------------------------------------------
-(defvar bench-mark-font-lock-buffer nil "buffer used for bench-mark-fontlock")
-
-(defun bench-handler-font-lock (times)
-  (setq bench-mark-font-lock-buffer (find-file bench-lisp-file))
-  (while (> times 0)
-    (bench-mark-font-lock)
-    (font-lock-mode)			; Turn it off
-    (setq times (- times 1)))
-  (kill-buffer bench-mark-font-lock-buffer)
-)
-
-(defun bench-mark-font-lock ()
-  "How long to fonitfy a large file."
-  (font-lock-fontify-buffer)
-)
-
-;-----------------------------------------------------------------------------
-(defvar bench-mark-scrolling-buffer nil "buffer used for bench-mark-scrolling")
-
-(defun bench-handler-scrolling (times)
-  (setq bench-mark-scrolling-buffer (find-file bench-lisp-file))
-  (set-buffer bench-mark-scrolling-buffer)
-;  (setq scroll-step 1)
-  (font-lock-mode -1)
-  (goto-char (point-min))		;Start at point min
-  (let ((temp-times times))
-    (while (> temp-times 0)
-      (bench-mark-scrolling-down)
-      (bench-mark-scrolling-up)
-      (setq temp-times (- temp-times 1))))
-
-  (font-lock-fontify-buffer)
-
-  (goto-char (point-min))		;Start at point min
-  (let ((temp-times times))
-    (while (> temp-times 0)
-      (bench-mark-scrolling-down-fontified)
-      (bench-mark-scrolling-up-fontified)
-      (setq temp-times (- temp-times 1))))
-  (kill-buffer bench-mark-scrolling-buffer)
-)
-
-(defun bench-mark-scrolling-down ()
-  "How long does it take to scroll down through a large file.
-Expect point to be at point min"
-  (let ((buffer-read-only t))
-    (while (< (point) (point-max))
-      (next-line 1)
-      (sit-for 0))))
-
-(defun bench-mark-scrolling-up ()
-  "How long does it take to scroll up through a large fontified ile."
-  (let ((buffer-read-only t))
-    (while (> (point) (point-min))
-      (previous-line 1)
-      (sit-for 0))))
-
-(defun bench-mark-scrolling-down-fontified ()
-  "How long does it take to scroll down through a large fontified file."
-  (let ((buffer-read-only t))
-    (goto-char (point-min))
-    (while (< (point) (point-max))
-      (next-line 1)
-      (sit-for 0))))
-
-(defun bench-mark-scrolling-up-fontified ()
-  "How long does it take to scroll up through a large fontified ile."
-  (let ((buffer-read-only t))
-    (while (> (point) (point-min))
-      (previous-line 1)
-      (sit-for 0))))
-
-;-----------------------------------------------------------------------------
-
-(defun bench-handler-make-frames (times)
-  (let ((temp-times times)
-	(frame))
-    (while (> temp-times 0)
-      (setq frame (bench-mark-make-frame)) ;Make frame
-      (bench-mark-delete-frame frame)	;Delete frame
-      (setq temp-times (- temp-times 1))))
-
-  (let ((temp-times times)
-	(frames))
-    (while (> temp-times 0)
-      (setq frames (cons (bench-mark-make-multiple-frames) frames)) ;Make frames
-      (setq temp-times (- temp-times 1)))
-
-    (setq temp-times times)
-
-    (while (> temp-times 0)
-      (bench-mark-delete-multiple-frames (car frames))	;Delete frames
-      (setq frames (cdr frames))
-      (setq temp-times (- temp-times 1))))
-
-)
-
-(defun bench-mark-make-frame ()
-  "How quickly can emacs create a new frame."
-  (make-frame))
-
-(defun bench-mark-delete-frame (frame)
-  "How quickly can emacs create a new frame."
-  (delete-frame frame))
-
-(defun bench-mark-make-multiple-frames ()
-  "How quickly can emacs create a new frame."
-  (make-frame))
-
-(defun bench-mark-delete-multiple-frames (frame)
-  "How quickly can emacs create a new frame."
-  (delete-frame frame))
-
-
-;-----------------------------------------------------------------------------
-(defconst bench-mark-make-words-buffer nil)
-(defconst bench-mark-make-words-buffer-name "*bench-mark-make-words*")
-(defconst bench-mark-make-words-number-of-words 10000)
-
-(defun bench-handler-make-words (times)
-  (setq bench-mark-make-words-buffer (get-buffer-create bench-mark-make-words-buffer-name))
-  (set-buffer bench-mark-make-words-buffer)
-  (while (> times 0)
-    (bench-mark-make-words)
-    (erase-buffer)
-    (setq times (- times 1)))
-  (kill-buffer bench-mark-make-words-buffer)
-)
-
-(defun bench-mark-make-words ()
-  "How long does it take to generate lots of random words."
-  (let ((tmp-words bench-mark-make-words-number-of-words))
-    (while (not (= tmp-words 0))
-      (let ((word-len (random 10)))
-	(while (not (= word-len 0))
-	  (insert (+ ?a (random 25)))
-	  (setq word-len (- word-len 1))))
-      (insert "\n")
-      (setq tmp-words (- tmp-words 1)))))
-
-;-----------------------------------------------------------------------------
-(defconst bench-mark-sort-words-buffer-name "*bench-mark-sort-words*")
-(defconst bench-mark-sort-words-buffer nil)
-(defconst bench-mark-sort-words-number-words 10000)
-
-(defun bench-handler-sort-words (times)
-  (setq bench-mark-sort-words-buffer (get-buffer-create bench-mark-sort-words-buffer-name))
-  (switch-to-buffer bench-mark-sort-words-buffer)
-  (while (> times 0)
-    (bench-pre-sort-words)			;Generate the random words
-    (bench-mark-sort-words)			;Sort those puppies
-    (erase-buffer)
-    (setq times (- times 1)))
-  (kill-buffer bench-mark-sort-words-buffer)
-)
-
-(defun bench-pre-sort-words ()
-  "How long does it take to generate lots of random words."
-  (let ((tmp-words bench-mark-sort-words-number-words))
-    (while (not (= tmp-words 0))
-      (let ((word-len (random 10)))
-	(while (not (= word-len 0))
-	  (insert (+ ?a (random 25)))
-	  (setq word-len (- word-len 1))))
-      (insert "\n")
-      (setq tmp-words (- tmp-words 1)))))
-
-(defun bench-mark-sort-words ()
-  (sort-lines nil (point-min) (point-max))
-)
-
-;-----------------------------------------------------------------------------
-; Byte compile a file
-(defun bench-handler-byte-compile (times)
-  (while (> times 0)
-    (bench-mark-byte-compile)
-    (setq times (- times 1)))
-)
-
-(defun bench-mark-byte-compile ()
-  "How long does it take to byte-compile a large lisp file"
-  (byte-compile-file bench-lisp-file)
-)
-
-;-----------------------------------------------------------------------------
-; Run through a loop
-
-(defconst bench-mark-loop-count 250000)
-
-(defun bench-handler-loop (times)
-  (while (> times 0)
-    (bench-mark-loop)
-    (setq times (- times 1)))
-)
-
-(defun bench-mark-loop ()
-  "How long does it take to run through a loop."
-  (let ((count bench-mark-loop-count))
-    (let ((i 0) (gcount 0))
-      (while (< i count)
-	(increment)
-	(setq i (1+ i)))
-      (message "gcount = %d" gcount))))
-
-(defun increment ()
-  "Increment a variable for bench-mark-loop."
-  (setq gcount (1+ gcount)))
-
-;-----------------------------------------------------------------------------
-(defconst bench-mark-large-list-list-size 500000
-  "Size of list to use in small list creation/garbage collection")
-(defconst bench-mark-large-list-num-lists 10)
-
-(defun bench-handler-large-list (times)
-  (let ((tmp-foo bench-mark-large-list-num-lists))
-    (while (> tmp-foo 0)
-      (bench-mark-large-list)
-      (setq tmp-foo (- tmp-foo 1))))
-)
-
-(defun bench-mark-large-list ()
-  (make-list bench-mark-large-list-list-size '1)
-)
-
-;-----------------------------------------------------------------------------
-(defun bench-mark-large-list-garbage-collect (times)
-  (garbage-collect)
-)
-
-;-----------------------------------------------------------------------------
-(defconst bench-mark-small-list-list-size 10
-  "Size of list to use in small list creation/garbage collection")
-
-(defconst bench-mark-small-list-num-lists 100000
-  "Number of lists to use in small list creation/garbage collections")
-
-(defun bench-handler-small-list (times)
-  (let ((tmp-foo bench-mark-small-list-num-lists))
-    (while (> tmp-foo 0)
-      (bench-mark-small-list)
-      (setq tmp-foo (- tmp-foo 1)))
-))
-
-(defun bench-mark-small-list ()
-  (make-list bench-mark-small-list-list-size '1)
-)
-
-;-----------------------------------------------------------------------------
-(defun bench-mark-small-list-garbage-collect (times)
-  (garbage-collect)
-)
-
-;-----------------------------------------------------------------------------
-(defconst bench-mark-insert-into-empty-buffer-num-words 100000)
-
-(defun bench-handler-insert-into-empty-buffer (times)
-  (set-buffer (get-buffer-create "*tmp*"))
-  (bench-mark-insert-into-empty-buffer)
-  (erase-buffer)
-  (kill-buffer "*tmp*")
-)
-
-(defun bench-mark-insert-into-empty-buffer ()
-  (let ((a bench-mark-insert-into-empty-buffer-num-words))
-    (while (> a 0)
-      (insert "0123456789\n")
-      (setq a (1- a))))
-)
-
-;=============================================================================
-(defconst bench-version (let ((rcsvers "$Revision: 1.4 $"))
-			  (substring rcsvers 11 (- (length rcsvers) 2)))
-  "*Version number of bench.el")
-
-(defconst bench-large-lisp-file (expand-file-name
-                                 "bench-large.el" (temp-directory))
-  "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")
-
-(defconst bench-small-lisp-file (expand-file-name
-                                 "bench-small.el" (temp-directory))
-  "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")
-
-(defconst bench-lisp-file bench-large-lisp-file)
-
-(defconst bench-pre-bench-hook nil
-  "Hook for individual bench mark initialization.")
-
-(defconst bench-post-bench-hook nil
-  "Hook for individual bench mark statistic collection.")
-
-(defconst bench-mark-function-alist 
-  '(
-    (bench-handler-hanoi . "Tower of Hanoi")
-    (bench-handler-font-lock               . "Font Lock")
-    (bench-handler-scrolling               . "Large File scrolling")
-    (bench-handler-make-frames             . "Frame Creation")
-    (bench-handler-make-words              . "Generate Words")
-    (bench-handler-sort-words              . "Sort Buffer")
-    (bench-handler-byte-compile            . "Large File bytecompilation")
-    (bench-handler-loop                    . "Loop Computation")
-    (bench-handler-large-list              . "Make a Few Large Size List")
-    (bench-mark-large-list-garbage-collect . "Garbage Collection Large Size List")
-    (bench-handler-small-list              . "Make Several Small Size List")
-    (bench-mark-small-list-garbage-collect  . "Garbage Collection Small Size List")
-    (bench-handler-insert-into-empty-buffer . "Text Insertion")
-))
-
-(defconst bench-enabled-profiling nil
-  "If non-nil and the underlying emacs supports it, do function profiling.")
-
-(defconst bench-mark-profile-buffer "*Profile*"
-  "Buffer used for collection of profiling data.")
-
-(setq gc-cons-threshold 40000000)
-
-(defconst bench-small-frame-alist '((height . 24) (width . 80)))
-(defconst bench-medium-frame-alist '((height . 48) (width . 80)))
-(defconst bench-large-frame-alist '((height . 72) (width . 80)))
-
-(defsubst bench-get-time ()
-  ;; Stolen from elp
-  ;; get current time in seconds and microseconds. I throw away the
-  ;; most significant 16 bits of seconds since I doubt we'll ever want
-  ;; to profile lisp on the order of 18 hours. See notes at top of file.
-  (let ((now (current-time)))
-    (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))
-
-(defun bench-init ()
-  "Initialize profiling for bench marking package."
-  (if (fboundp 'start-profiling)
-      (let ((buf (get-buffer-create bench-mark-profile-buffer)))
-	(erase-buffer buf)
-	(when (profiling-active-p)
-	  (stop-profiling)
-	  (clear-profiling-info)))
-    (message "Profiling not available in this XEmacs.")
-    (sit-for 2)))
-
-(defun bench-test-init ()
-  "Initialize profiling for bench marking package."
-  (if (fboundp 'start-profiling)
-      (let ((buf (get-buffer-create bench-mark-profile-buffer)))
-	(erase-buffer buf)
-	(when (profiling-active-p)
-	  (stop-profiling)
-	  (clear-profiling-info)))
-    (message "Profiling not available in this XEmacs.")
-    (sit-for 2))
-  (setq bench-lisp-file bench-small-lisp-file)
-  (setq bench-mark-make-words-number-of-words 100)
-  (setq bench-mark-sort-words-number-of-words 100)
-  (setq bench-mark-loop-count 10000)
-  (setq bench-mark-large-list-list-size 500)
-  (setq bench-mark-small-list-num-lists 100)
-  (setq bench-mark-insert-into-empty-buffer-num-words 100)
-  
-)
-
-(defun bench-profile-start (test-name)
-  "Turn on profiling for test `test-name'."
-  (when (and bench-enabled-profiling
-	     (fboundp 'start-profiling))
-    (when (profiling-active-p)
-      (stop-profiling))
-    (let ((buf (get-buffer-create bench-mark-profile-buffer)))
-      (save-excursion
-	(set-buffer buf)
-	(insert "Test `" test-name "'\n")
-	(start-profiling)))))
-
-(defun bench-profile-stop (test-name)
-  "Turn off profiling for test `test-name'."
-  (when (and bench-enabled-profiling
-	     (fboundp 'stop-profiling))
-    (stop-profiling)
-    (let ((buf (get-buffer-create bench-mark-profile-buffer)))
-      (save-excursion
-	(set-buffer buf)
-	(insert (with-output-to-string
-		 (pretty-print-profiling-info)) "\n")))
-    (clear-profiling-info)))
-
-(add-hook 'bench-pre-bench-hook 'bench-profile-start)
-(add-hook 'bench-post-bench-hook 'bench-profile-stop)
-
-(defun bench-post ()
-"Post processing of elp results"
-; I can't figure out a good way to sort the lines numerically.
-; If someone comes up with a good way, let me know.
-  (goto-char (point-min))
-  (next-line 2)
-  (sort-lines nil (point) (point-max))
-  (mail-results (current-buffer))
-)
-
-(defun bench (arg)
-  "Run a series of benchmarks."
-  (interactive "p")
-  (elp-instrument-package "bench-mark") ;Only instrument functions
-                                        ;beginning with bench-mark
-  (bench-init)
-  (if (fboundp 'byte-optimize)		;Turn off byte-compile optimization in XEmacs
-      (setq byte-optimize nil))
-  (if (fboundp 'menu-bar-mode)
-      (menu-bar-mode -1))			;Turn off menu-bar
-  (let ((benches bench-mark-function-alist))
-    (while benches
-      (let ((test-name (cdar benches)))
-	(run-hook-with-args 'bench-pre-bench-hook test-name)
-	(message "Running %s - %s." (symbol-name (caar benches)) test-name)
-	(funcall (caar benches) arg)
-	(setq benches (cdr benches))
-	(run-hook-with-args 'bench-post-bench-hook test-name))
-      ))
-  (elp-results)
-  (bench-post)
-)
-
-(defun bench-test (arg)
-  "Run all the tests but with smaller values so the tests run quicker.
-This way I don't have to sit around to see if the tests complete"
-  (interactive "p")
-  (elp-instrument-package "bench-mark") ;Only instrument functions
-                                        ;beginning with bench-mark
-  (bench-test-init)
-  (if (fboundp 'byte-optimize)		;Turn off byte-compile optimization in XEmacs
-      (setq byte-optimize nil))
-  (if (fboundp 'menu-bar-mode)
-      (menu-bar-mode -1))			;Turn off menu-bar
-  (let ((benches bench-mark-function-alist))
-    (while benches
-      (let ((test-name (cdar benches)))
-	(run-hook-with-args 'bench-pre-bench-hook test-name)
-	(message "Running %s - %s." (symbol-name (caar benches)) test-name)
-	(funcall (caar benches) arg)
-	(setq benches (cdr benches))
-	(run-hook-with-args 'bench-post-bench-hook test-name))
-      ))
-  (elp-results)
-  (bench-post)
-)
-
-
-(defconst bench-send-results-to "holder@rsn.hp.com")
-(defconst bench-subject "Bench Mark Results")
-(defconst bench-system-form (format "
-
-Please fill in as much of the following as you can
-and then hit C-cC-c to send.
-
-CPU Manufacturer (Intel,HP,DEC,etc.): 
-CPU Type (Pentium,Alpha): 
-CPU Speed: 
-RAM (in meg): 
-Emacs Version: %s
-Emacs (version): %s
-Compile line:
-Bench Version: %s
-" emacs-version (emacs-version) bench-version))
-
-(defun mail-results (buffer)
-  (mail nil bench-send-results-to bench-subject)
-  (sit-for 0)
-  (goto-char (point-max))
-  (insert bench-system-form)
-  (insert-buffer buffer)
-)
-;;; bench.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/checkdoc.el b/xemacs-packages/lisp/xemacs-devel/checkdoc.el
deleted file mode 100644
index 7fc047ae..00000000
--- a/xemacs-packages/lisp/xemacs-devel/checkdoc.el
+++ /dev/null
@@ -1,2762 +0,0 @@
-;;; checkdoc --- Check documentation strings for style requirements
-
-;;;  Copyright (C) 1997, 1998, 1999, 2000  Free Software Foundation
-
-;; Author: Eric M. Ludlam 
-;; Version: 0.7
-;; Keywords: docs, maint, lisp
-
-;; 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:
-;;
-;;   The Emacs Lisp manual has a nice chapter on how to write
-;; documentation strings.  Many stylistic suggestions are fairly
-;; deterministic and easy to check for syntactically, but also easy
-;; to forget.  The main checkdoc engine will perform the stylistic
-;; checks needed to make sure these styles are remembered.
-;;
-;; There are two ways to use checkdoc:
-;;   1) Periodically use `checkdoc' or `checkdoc-current-buffer'.
-;;      `checkdoc' is a more interactive version of
-;;      `checkdoc-current-buffer'
-;;   2) Use `checkdoc-minor-mode' to automatically check your
-;;      documentation whenever you evaluate Lisp code with C-M-x
-;;      or [menu-bar emacs-lisp eval-buffer].  Additional key-bindings
-;;      are also provided under C-c ? KEY
-;;        (require 'checkdoc)
-;;        (add-hook 'emacs-lisp-mode-hook
-;;	             '(lambda () (checkdoc-minor-mode 1)))
-;;
-;; Using `checkdoc':
-;;
-;;   The commands `checkdoc' and `checkdoc-ispell' are the top-level
-;; entry points to all of the different checks that are available.  It
-;; breaks examination of your Lisp file into four sections (comments,
-;; documentation, messages, and spacing) and indicates its current
-;; state in a status buffer.
-;;
-;;   The Comments check examines your headers, footers, and
-;; various tags (such as "Code:") to make sure that your code is ready
-;; for easy integration into existing systems.
-;;
-;;   The Documentation check deals with documentation strings
-;; and their elements that help make Emacs easier to use.
-;;
-;;   The Messages check ensures that the strings displayed in the
-;; minibuffer by some commands (such as `error' and `y-or-n-p')
-;; are consistent with the Emacs environment.
-;;
-;;   The Spacing check cleans up white-space at the end of lines.
-;;
-;;   The interface while working with documentation and messages is
-;; slightly different when being run in the interactive mode.  The
-;; interface offers several options, including the ability to skip to
-;; the next error, or back up to previous errors.  Auto-fixing is
-;; turned off at this stage, but you can use the `f' or `F' key to fix
-;; a given error (if the fix is available.)
-;;
-;; Auto-fixing:
-;;
-;;   There are four classifications of style errors in terms of how
-;; easy they are to fix.  They are simple, complex, really complex,
-;; and impossible.  (Impossible really means that checkdoc does not
-;; have a fixing routine yet.)  Typically white-space errors are
-;; classified as simple, and are auto-fixed by default.  Typographic
-;; changes are considered complex, and the user is asked if they want
-;; the problem fixed before checkdoc makes the change.  These changes
-;; can be done without asking if `checkdoc-autofix-flag' is properly
-;; set.  Potentially redundant changes are considered really complex,
-;; and the user is always asked before a change is inserted.  The
-;; variable `checkdoc-autofix-flag' controls how these types of errors
-;; are fixed.
-;;
-;; Spell checking text:
-;;
-;;   The variable `checkdoc-spellcheck-documentation-flag' can be set
-;; to customize how spell checking is to be done.  Since spell
-;; checking can be quite slow, you can optimize how best you want your
-;; checking done.  The default is 'defun, which spell checks each time
-;; `checkdoc-defun' or `checkdoc-eval-defun' is used.  Setting to nil
-;; prevents spell checking during normal usage.
-;;   Setting this variable to nil does not mean you cannot take
-;; advantage of the spell checking.  You can instead use the
-;; interactive functions `checkdoc-ispell-*' to check the spelling of
-;; your documentation.
-;;   There is a list of Lisp-specific words which checkdoc will
-;; install into Ispell on the fly, but only if Ispell is not already
-;; running.  Use `ispell-kill-ispell' to make checkdoc restart it with
-;; these words enabled.
-;;
-;; Checking parameters:
-;;
-;;   You might not always want a function to have its parameters listed
-;; in order.  When this is the case, put the following comment just in
-;; front of the documentation string: "; checkdoc-order: nil"  This
-;; overrides the value of `checkdoc-arguments-in-order-flag'.
-;;
-;;   If you specifically wish to avoid mentioning a parameter of a
-;; function in the doc string (such as a hidden parameter, or a
-;; parameter which is very obvious like events), you can have checkdoc
-;; skip looking for it by putting the following comment just in front
-;; of the documentation string: "; checkdoc-params: (args go here)"
-;;
-;; Checking message strings:
-;;
-;;   The text that follows the `error' and `y-or-n-p' commands is
-;; also checked.  The documentation for `error' clearly states some
-;; simple style rules to follow which checkdoc will auto-fix for you.
-;; `y-or-n-p' also states that it should end in a space.  I added that
-;; it should end in "? " since that is almost always used.
-;;
-;; Adding your own checks:
-;;
-;;   You can experiment with adding your own checks by setting the
-;; hooks `checkdoc-style-hooks' and `checkdoc-comment-style-hooks'.
-;; Return a string which is the error you wish to report.  The cursor
-;; position should be preserved.
-;;
-;; Error errors:
-;;
-;;   Checkdoc does not always flag errors correctly.  There are a
-;; couple ways you can coax your file into passing all of checkdoc's
-;; tests through buffer local variables.
-;;
-;;   The variable `checkdoc-verb-check-experimental-flag' can be used
-;; to turn off the check for verb-voice in case you use words that are
-;; not semantically verbs, but are still in the incomplete list.
-;;
-;;   The variable `checkdoc-symbol-words' can be a list of words that
-;; happen to also be symbols.  This is not a problem for one-word
-;; symbols, but if you use a hyphenated word that is also a symbol,
-;; then you may need this.
-;;
-;;   The symbol `checkdoc-force-docstrings-flag' can be set to nil if
-;; you have many undocumented functions you don't wish to document.
-;;
-;;   See the above section "Checking Parameters" for details about
-;; parameter checking.
-;;
-;; Dependencies:
-;;
-;;   This file requires lisp-mnt (Lisp maintenance routines) for the
-;;   comment checkers.
-;;
-;;   Requires custom for Emacs v20.
-
-;;; TO DO:
-;;   Hook into the byte compiler on a defun/defvar level to generate
-;;     warnings in the byte-compiler's warning/error buffer.
-;;   Better ways to override more typical `eval' functions.  Advice
-;;     might be good but hard to turn on/off as a minor mode.
-;;
-;;; Maybe Do:
-;;   Code sweep checks for "forbidden functions", proper use of hooks,
-;;     proper keybindings, and other items from the manual that are
-;;     not specifically docstring related.  Would this even be useful?
-
-;;; Code:
-(defvar checkdoc-version "0.7"
-  "Release version of checkdoc you are currently running.")
-
-;; From custom web page for compatibility between versions of custom:
-(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 custom-add-option (&rest args)
-      nil)
-    (defmacro defcustom (var value doc &rest args)
-      (` (defvar (, var) (, value) (, doc))))))
-
-(defvar checkdoc-xemacs-p (featurep 'xemacs))
-
-(defcustom checkdoc-autofix-flag 'semiautomatic
-  "*Non-nil means attempt auto-fixing of doc strings.
-If this value is the symbol `query', then the user is queried before
-any change is made.  If the value is `automatic', then all changes are
-made without asking unless the change is very-complex.  If the value
-is `semiautomatic' or any other value, then simple fixes are made
-without asking, and complex changes are made by asking the user first.
-The value `never' is the same as nil, never ask or change anything."
-  :group 'checkdoc
-  :type '(choice (const automatic)
-		 (const query)
-		 (const never)
-		 (const semiautomatic)
-		 ;(other :tag "semiautomatic" semiautomatic)
-		 ))
-
-(defcustom checkdoc-bouncy-flag t
-  "*Non-nil means to \"bounce\" to auto-fix locations.
-Setting this to nil will silently make fixes that require no user
-interaction.  See `checkdoc-autofix-flag' for auto-fixing details."
-  :group 'checkdoc
-  :type 'boolean)
-
-(defcustom checkdoc-force-docstrings-flag t
-  "*Non-nil means that all checkable definitions should have documentation.
-Style guide dictates that interactive functions MUST have documentation,
-and that it's good but not required practice to make non user visible items
-have doc strings."
-  :group 'checkdoc
-  :type 'boolean)
-
-(defcustom checkdoc-force-history-flag t
-  "*Non-nil means that files should have a History section or ChangeLog file.
-This helps document the evolution of, and recent changes to, the package."
-  :group 'checkdoc
-  :type 'boolean)
-
-(defcustom checkdoc-permit-comma-termination-flag nil
-  "*Non-nil means the first line of a docstring may end with a comma.
-Ordinarily, a full sentence is required.  This may be misleading when
-there is a substantial caveat to the one-line description -- the comma
-should be used when the first part could stand alone as a sentence, but
-it indicates that a modifying clause follows."
-  :group 'checkdoc
-  :type 'boolean)
-
-(defcustom checkdoc-triple-semi-comment-check-flag t
-  "*Non-nil means to check for multiple adjacent occurrences of ;;; comments.
-According to the style of Emacs code in the Lisp libraries, a block
-comment can look like this:
-;;; Title
-;;  text
-;;  text
-But when inside a function, code can be commented out using the ;;;
-construct for all lines.  When this variable is nil, the ;;; construct
-is ignored regardless of its location in the code."
-  :group 'checkdoc
-  :type 'boolean)
-
-(defcustom checkdoc-spellcheck-documentation-flag nil
-  "*Non-nil means run Ispell on text based on value.
-This is automatically set to nil if Ispell does not exist on your
-system.  Possible values are:
-
-  nil         - Don't spell-check during basic style checks.
-  defun       - Spell-check when style checking a single defun
-  buffer      - Spell-check when style checking the whole buffer
-  interactive - Spell-check during any interactive check.
-  t           - Always spell-check"
-  :group 'checkdoc
-  :type '(choice (const nil)
-		 (const defun)
-		 (const buffer)
-		 (const interactive)
-		 (const t)))
-
-(defvar checkdoc-ispell-lisp-words
-  '("alist" "emacs" "etags" "iff" "keymap" "paren" "regexp" "sexp" "xemacs")
-  "List of words that are correct when spell-checking Lisp documentation.")
-
-(defcustom checkdoc-max-keyref-before-warn 10
-  "*The number of \\ [command-to-keystroke] tokens allowed in a doc string.
-Any more than this and a warning is generated suggesting that the construct
-\\ {keymap} be used instead."
-  :group 'checkdoc
-  :type 'integer)
-
-(defcustom checkdoc-arguments-in-order-flag t
-  "*Non-nil means warn if arguments appear out of order.
-Setting this to nil will mean only checking that all the arguments
-appear in the proper form in the documentation, not that they are in
-the same order as they appear in the argument list.  No mention is
-made in the style guide relating to order."
-  :group 'checkdoc
-  :type 'boolean)
-
-(defvar checkdoc-style-hooks nil
-  "Hooks called after the standard style check is completed.
-All hooks must return nil or a string representing the error found.
-Useful for adding new user implemented commands.
-
-Each hook is called with two parameters, (DEFUNINFO ENDPOINT).
-DEFUNINFO is the return value of `checkdoc-defun-info'.  ENDPOINT is the
-location of end of the documentation string.")
-
-(defvar checkdoc-comment-style-hooks nil
-  "Hooks called after the standard comment style check is completed.
-Must return nil if no errors are found, or a string describing the
-problem discovered.  This is useful for adding additional checks.")
-
-(defvar checkdoc-diagnostic-buffer "*Style Warnings*"
-  "Name of warning message buffer.")
-
-(defcustom checkdoc-defun-regexp
-  "^(def\\(un\\|var\\|custom\\|macro\\|const\\|subst\\|advice\\|method\\)\
-\\s-+\\(\\(\\sw\\|\\s_\\)+\\)[ \t\n]+"
-  "*Regular expression used to identify a defun.
-A search leaves the cursor in front of the parameter list."
-  :group 'checkdoc
-  :type 'string)
-
-(defcustom checkdoc-verb-check-experimental-flag t
-  "*Non-nil means to attempt to check the voice of the doc string.
-This check keys off some words which are commonly misused.  See the
-variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own."
-  :group 'checkdoc
-  :type 'boolean)
-
-(defvar checkdoc-generate-compile-warnings-flag nil
-  "Non-nil means generate warnings in a buffer for browsing.
-Do not set this by hand, use a function like `checkdoc-current-buffer'
-with a universal argument.")
-
-(defcustom checkdoc-symbol-words nil
-  "A list of symbols which also happen to make good words.
-These symbol-words are ignored when unquoted symbols are searched for.
-This should be set in an Emacs Lisp file's local variables."
-  :group 'checkdoc
-  :type '(repeat (symbol :tag "Word")))
-
-(defvar checkdoc-proper-noun-list
-  '("ispell" "xemacs" "emacs" "lisp")
-  "List of words (not capitalized) which should be capitalized.")
-
-(defvar checkdoc-proper-noun-regexp
-  (let ((expr "\\<\\(")
-	(l checkdoc-proper-noun-list))
-    (while l
-      (setq expr (concat expr (car l) (if (cdr l) "\\|" ""))
-	    l (cdr l)))
-    (concat expr "\\)\\>"))
-  "Regular expression derived from `checkdoc-proper-noun-regexp'.")
-
-(defvar checkdoc-common-verbs-regexp nil
-  "Regular expression derived from `checkdoc-common-verbs-regexp'.")
-
-(defvar checkdoc-common-verbs-wrong-voice
-  '(("adds" . "add")
-    ("allows" . "allow")
-    ("appends" . "append")
-    ("applies" . "apply")
-    ("arranges" . "arrange")
-    ("brings" . "bring")
-    ("calls" . "call")
-    ("catches" . "catch")
-    ("changes" . "change")
-    ("checks" . "check")
-    ("contains" . "contain")
-    ("creates" . "create")
-    ("destroys" . "destroy")
-    ("disables" . "disable")
-    ("executes" . "execute")
-    ("evals" . "evaluate")
-    ("evaluates" . "evaluate")
-    ("finds" . "find")
-    ("forces" . "force")
-    ("gathers" . "gather")
-    ("generates" . "generate")
-    ("goes" . "go")
-    ("guesses" . "guess")
-    ("highlights" . "highlight")
-    ("holds" . "hold")
-    ("ignores" . "ignore")
-    ("indents" . "indent")
-    ("initializes" . "initialize")
-    ("inserts" . "insert")
-    ("installs" . "install")
-    ("investigates" . "investigate")
-    ("keeps" . "keep")
-    ("kills" . "kill")
-    ("leaves" . "leave")
-    ("lets" . "let")
-    ("loads" . "load")
-    ("looks" . "look")
-    ("makes" . "make")
-    ("marks" . "mark")
-    ("matches" . "match")
-    ("notifies" . "notify")
-    ("offers" . "offer")
-    ("parses" . "parse")
-    ("performs" . "perform")
-    ("prepares" . "prepare")
-    ("prepends" . "prepend")
-    ("reads" . "read")
-    ("raises" . "raise")
-    ("removes" . "remove")
-    ("replaces" . "replace")
-    ("resets" . "reset")
-    ("restores" . "restore")
-    ("returns" . "return")
-    ("runs" . "run")
-    ("saves" . "save")
-    ("says" . "say")
-    ("searches" . "search")
-    ("selects" . "select")
-    ("sets" . "set")
-    ("sex" . "s*x")
-    ("shows" . "show")
-    ("signifies" . "signify")
-    ("sorts" . "sort")
-    ("starts" . "start")
-    ("stores" . "store")
-    ("switches" . "switch")
-    ("tells" . "tell")
-    ("tests" . "test")
-    ("toggles" . "toggle")
-    ("tries" . "try")
-    ("turns" . "turn")
-    ("undoes" . "undo")
-    ("unloads" . "unload")
-    ("unmarks" . "unmark")
-    ("updates" . "update")
-    ("uses" . "use")
-    ("yanks" . "yank")
-    )
-  "Alist of common words in the wrong voice and what should be used instead.
-Set `checkdoc-verb-check-experimental-flag' to nil to avoid this costly
-and experimental check.  Do not modify this list without setting
-the value of `checkdoc-common-verbs-regexp' to nil which cause it to
-be re-created.")
-
-(defvar checkdoc-syntax-table nil
-  "Syntax table used by checkdoc in document strings.")
-
-(if checkdoc-syntax-table
-    nil
-  (setq checkdoc-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table))
-  ;; When dealing with syntax in doc strings, make sure that - are encompassed
-  ;; in words so we can use cheap \\> to get the end of a symbol, not the
-  ;; end of a word in a conglomerate.
-  (modify-syntax-entry ?- "w" checkdoc-syntax-table)
-  )
-	
-
-;;; Compatibility
-;;
-(if checkdoc-xemacs-p
-    (progn
-      (defalias 'checkdoc-make-overlay 'make-extent)
-      (defalias 'checkdoc-overlay-put 'set-extent-property)
-      (defalias 'checkdoc-delete-overlay 'delete-extent)
-      (defalias 'checkdoc-mode-line-update 'redraw-modeline)
-      (defalias 'checkdoc-call-eval-buffer 'eval-buffer)
-      )
-  (defalias 'checkdoc-make-overlay 'make-overlay)
-  (defalias 'checkdoc-overlay-put 'overlay-put)
-  (defalias 'checkdoc-delete-overlay 'delete-overlay)
-  (defalias 'checkdoc-mode-line-update 'force-mode-line-update)
-  (defalias 'checkdoc-call-eval-buffer 'eval-current-buffer)
-  )
-
-;; Emacs 20 has this handy function.
-(if (not (fboundp 'princ-list))
-    (defun princ-list (&rest args)
-      "Call `princ' on ARGS."
-      (mapcar 'princ args)))
-
-;; Emacs 20s have MULE characters which don't equate to numbers.
-(if (fboundp 'char=)
-    (defalias 'checkdoc-char= 'char=)
-  (defalias 'checkdoc-char= '=))
-
-;; Emacs 19.28 and earlier don't have the handy 'add-to-list function
-(if (fboundp 'add-to-list)
-
-    (defalias 'checkdoc-add-to-list 'add-to-list)
-
-  (defun checkdoc-add-to-list (list-var element)
-    "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet."
-    (if (not (member element (symbol-value list-var)))
-	(set list-var (cons element (symbol-value list-var)))))
-  )
-
-;; To be safe in new Emacsen, we want to read events, not characters
-(if (fboundp 'read-event)
-    (defalias 'checkdoc-read-event 'read-event)
-  (defalias 'checkdoc-read-event 'read-char))
-
-;;; User level commands
-;;
-;;;###autoload
-(defun checkdoc ()
-  "Interactively check the entire buffer for style errors.
-The current status of the check will be displayed in a buffer for
-user to view as each check is completed."
-  (interactive)
-  (let ((status (list "Checking..." "-" "-" "-"))
-	(checkdoc-spellcheck-documentation-flag
-	 (member checkdoc-spellcheck-documentation-flag
-		 '(buffer interactive t)))
-	;; if the user set autofix to never, then that breaks the
-	;; obviously requested asking implied by using this function.
-	;; Set it to paranoia level.
-	(checkdoc-autofix-flag (if (or (not checkdoc-autofix-flag)
-				       (eq checkdoc-autofix-flag 'never))
-				   'query
-				 checkdoc-autofix-flag))
-	tmp)
-    (checkdoc-display-status-buffer status)
-    ;; check the comments
-    (if (not buffer-file-name)
-	(setcar status "Not checked")
-      (if (checkdoc-file-comments-engine)
-	  (setcar status "Errors")
-	(setcar status "Ok")))
-    (setcar (cdr status) "Checking...")
-    (checkdoc-display-status-buffer status)
-    ;; Check the documentation
-    (setq tmp (checkdoc-interactive nil t))
-    (if tmp
-	(setcar (cdr status) (format "%d Errors" (length tmp)))
-      (setcar (cdr status) "Ok"))
-    (setcar (cdr (cdr status)) "Checking...")
-    (checkdoc-display-status-buffer status)
-    ;; Check the message text
-    (if (setq tmp (checkdoc-message-interactive nil t))
-	(setcar (cdr (cdr status)) (format "%d Errors" (length tmp)))
-      (setcar (cdr (cdr status)) "Ok"))
-    (setcar (cdr (cdr (cdr status))) "Checking...")
-    (checkdoc-display-status-buffer status)
-    ;; Rogue spacing
-    (if (condition-case nil
-	    (checkdoc-rogue-spaces nil t)
-	  (error t))
-	(setcar (cdr (cdr (cdr status))) "Errors")
-      (setcar (cdr (cdr (cdr status))) "Ok"))
-    (checkdoc-display-status-buffer status)))
-
-(defun checkdoc-display-status-buffer (check)
-  "Display and update the status buffer for the current checkdoc mode.
-CHECK is a vector stating the current status of each test as an
-element is the status of that level of test."
-  (let (temp-buffer-setup-hook)
-    (with-output-to-temp-buffer " *Checkdoc Status*"
-      (with-current-buffer " *Checkdoc Status*"
-	(fundamental-mode))
-      (princ-list
-       "Buffer comments and tags:  " (nth 0 check) "\n"
-       "Documentation style:       " (nth 1 check) "\n"
-       "Message/Query text style:  " (nth 2 check) "\n"
-       "Unwanted Spaces:           " (nth 3 check)
-       )))
-  (shrink-window-if-larger-than-buffer
-   (get-buffer-window " *Checkdoc Status*"))
-  (message nil)
-  (sit-for 0))
-
-;;;###autoload
-(defun checkdoc-interactive (&optional start-here showstatus)
-  "Interactively check the current buffer for doc string errors.
-Prefix argument START-HERE will start the checking from the current
-point, otherwise the check starts at the beginning of the current
-buffer.  Allows navigation forward and backwards through document
-errors.  Does not check for comment or space warnings.
-Optional argument SHOWSTATUS indicates that we should update the
-checkdoc status window instead of the usual behavior."
-  (interactive "P")
-  (let ((checkdoc-spellcheck-documentation-flag
-	 (member checkdoc-spellcheck-documentation-flag
-		 '(interactive t))))
-    (checkdoc-interactive-loop start-here showstatus 'checkdoc-next-error)))
-
-;;;###autoload
-(defun checkdoc-message-interactive (&optional start-here showstatus)
-  "Interactively check the current buffer for message string errors.
-Prefix argument START-HERE will start the checking from the current
-point, otherwise the check starts at the beginning of the current
-buffer.  Allows navigation forward and backwards through document
-errors.  Does not check for comment or space warnings.
-Optional argument SHOWSTATUS indicates that we should update the
-checkdoc status window instead of the usual behavior."
-  (interactive "P")
-  (let ((checkdoc-spellcheck-documentation-flag
-	 (member checkdoc-spellcheck-documentation-flag
-		 '(interactive t))))
-    (checkdoc-interactive-loop start-here showstatus
-			       'checkdoc-next-message-error)))
-
-(defun checkdoc-interactive-loop (start-here showstatus findfunc)
-  "Interactively loop over all errors that can be found by a given method.
-Searching starts at START-HERE.  SHOWSTATUS expresses the verbosity
-of the search, and whether ending the search will auto-exit this function.
-FINDFUNC is a symbol representing a function that will position the
-cursor, and return error message text to present to the user.  It is
-assumed that the cursor will stop just before a major sexp, which will
-be highlighted to present the user with feedback as to the offending
-style."
-  ;; Determine where to start the test
-  (let* ((begin (prog1 (point)
-		  (if (not start-here) (goto-char (point-min)))))
-	 ;; Assign a flag to spellcheck flag
-	 (checkdoc-spellcheck-documentation-flag
-	  (member checkdoc-spellcheck-documentation-flag
-		  '(buffer interactive t)))
-	 ;; Fetch the error list
-	 (err-list (list (funcall findfunc nil)))
-	 (cdo nil)
-	 (returnme nil)
-	 c)
-    (save-window-excursion
-      (if (not (car err-list)) (setq err-list nil))
-      ;; Include whatever function point is in for good measure.
-      (beginning-of-defun)
-      (while err-list
-	(goto-char (cdr (car err-list)))
-	;; The cursor should be just in front of the offending doc string
-	(if (stringp (car (car err-list)))
-	    (setq cdo (save-excursion (checkdoc-make-overlay
-				       (point) (progn (forward-sexp 1)
-						      (point)))))
-	  (setq cdo (checkdoc-make-overlay
-		     (checkdoc-error-start (car (car err-list)))
-		     (checkdoc-error-end (car (car err-list))))))
-	(unwind-protect
-	    (progn
-	      (checkdoc-overlay-put cdo 'face 'highlight)
-	      ;; Make sure the whole doc string is visible if possible.
-	      (sit-for 0)
-	      (if (and (looking-at "\"")
-		       (not (pos-visible-in-window-p
-			     (save-excursion (forward-sexp 1) (point))
-			     (selected-window))))
-		  (let ((l (count-lines (point)
-					(save-excursion
-					  (forward-sexp 1) (point)))))
-		    (if (> l (window-height))
-			(recenter 1)
-		      (recenter (/ (- (window-height) l) 2))))
-		(recenter))
-	      (message "%s (C-h,%se,n,p,q)" (checkdoc-error-text
-					      (car (car err-list)))
-		       (if (checkdoc-error-unfixable (car (car err-list)))
-			   "" "f,"))
-	      (save-excursion
-		(goto-char (checkdoc-error-start (car (car err-list))))
-		(if (not (pos-visible-in-window-p))
-		    (recenter (- (window-height) 2)))
-		(setq c (checkdoc-read-event)))
-	      (if (and (not checkdoc-xemacs-p)
-		       (not (integerp c)))
-		  (setq c ??))
-	      (cond
-	       ;; Exit condition
-	       ((checkdoc-char= c ?\C-g) (signal 'quit nil))
-	       ;; Request an auto-fix
-	       ((or (checkdoc-char= c ?y) (checkdoc-char= c ?f))
-		(checkdoc-delete-overlay cdo)
-		(setq cdo nil)
-		(goto-char (cdr (car err-list)))
-		;; `automatic-then-never' tells the autofix function
-		;; to only allow one fix to be automatic.  The autofix
-		;; function will than set the flag to 'never, allowing
-		;; the checker to return a different error.
-		(let ((checkdoc-autofix-flag 'automatic-then-never)
-		      (fixed nil))
-		  (funcall findfunc t)
-		  (setq fixed (not (eq checkdoc-autofix-flag
-				       'automatic-then-never)))
-		  (if (not fixed)
-		      (progn
-			(message "A Fix was not available.")
-			(sit-for 2))
-		    (setq err-list (cdr err-list))))
-		(beginning-of-defun)
-		(let ((pe (car err-list))
-		      (ne (funcall findfunc nil)))
-		  (if ne
-		      (setq err-list (cons ne err-list))
-		    (cond ((not err-list)
-			   (message "No More Stylistic Errors.")
-			   (sit-for 2))
-			  (t
-			   (message
-			    "No Additional style errors.  Continuing...")
-			   (sit-for 2))))))
-	       ;; Move to the next error (if available)
-	       ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\ ))
-		(let ((ne (funcall findfunc nil)))
-		  (if (not ne)
-		      (if showstatus
-			  (setq returnme err-list
-				err-list nil)
-			(if (not err-list)
-			    (message "No More Stylistic Errors.")
-			  (message "No Additional style errors.  Continuing..."))
-			(sit-for 2))
-		    (setq err-list (cons ne err-list)))))
-	       ;; Go backwards in the list of errors
-	       ((or (checkdoc-char= c ?p) (checkdoc-char= c ?\C-?))
-		(if (/= (length err-list) 1)
-		    (progn
-		      (setq err-list (cdr err-list))
-		      (goto-char (cdr (car err-list)))
-		      (beginning-of-defun))
-		  (message "No Previous Errors.")
-		  (sit-for 2)))
-	       ;; Edit the buffer recursively.
-	       ((checkdoc-char= c ?e)
-		(checkdoc-recursive-edit
-		 (checkdoc-error-text (car (car err-list))))
-		(checkdoc-delete-overlay cdo)
-		(setq err-list (cdr err-list)) ;back up the error found.
-		(beginning-of-defun)
-		(let ((ne (funcall findfunc nil)))
-		  (if (not ne)
-		      (if showstatus
-			  (setq returnme err-list
-				err-list nil)
-			(message "No More Stylistic Errors.")
-			(sit-for 2))
-		    (setq err-list (cons ne err-list)))))
-	       ;; Quit checkdoc
-	       ((checkdoc-char= c ?q)
-		(setq returnme err-list
-		      err-list nil
-		      begin (point)))
-	       ;; Goofy s tuff
-	       (t
-		(if (get-buffer-window "*Checkdoc Help*")
-		    (progn
-		      (delete-window (get-buffer-window "*Checkdoc Help*"))
-		      (kill-buffer "*Checkdoc Help*"))
-		  (with-output-to-temp-buffer "*Checkdoc Help*"
-		    (princ-list
-		     "Checkdoc Keyboard Summary:\n"
-		     (if (checkdoc-error-unfixable (car (car err-list)))
-			 ""
-		       (concat
-			"f, y    - auto Fix this warning without asking (if\
- available.)\n"
-			"         Very complex operations will still query.\n")
-		       )
-		     "e      - Enter recursive Edit.  Press C-M-c to exit.\n"
-		     "SPC, n - skip to the Next error.\n"
-		     "DEL, p - skip to the Previous error.\n"
-		     "q      - Quit checkdoc.\n"
-		     "C-h    - Toggle this help buffer."))
-		  (shrink-window-if-larger-than-buffer
-		   (get-buffer-window "*Checkdoc Help*"))))))
-	  (if cdo (checkdoc-delete-overlay cdo)))))
-    (goto-char begin)
-    (if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*"))
-    (message "Checkdoc: Done.")
-    returnme))
-
-(defun checkdoc-next-error (enable-fix)
-  "Find and return the next checkdoc error list, or nil.
-Only documentation strings are checked.
-Add error vector is of the form (WARNING . POSITION) where WARNING
-is the warning text, and POSITION is the point in the buffer where the
-error was found.  We can use points and not markers because we promise
-not to edit the buffer before point without re-executing this check.
-Argument ENABLE-FIX will enable auto-fixing while looking for the next
-error.  This argument assumes that the cursor is already positioned to
-perform the fix."
-  (if enable-fix
-      (checkdoc-this-string-valid)
-    (let ((msg nil) (p (point))
-	  (checkdoc-autofix-flag nil))
-      (condition-case nil
-	  (while (and (not msg) (checkdoc-next-docstring))
-	    (message "Searching for doc string error...%d%%"
-		     (/ (* 100 (point)) (point-max)))
-	    (if (setq msg (checkdoc-this-string-valid))
-		(setq msg (cons msg (point)))))
-	;; Quit.. restore position,  Other errors, leave alone
-	(quit (goto-char p)))
-      msg)))
-
-(defun checkdoc-next-message-error (enable-fix)
-  "Find and return the next checkdoc message related error list, or nil.
-Only text for error and `y-or-n-p' strings are checked.  See
-`checkdoc-next-error' for details on the return value.
-Argument ENABLE-FIX turns on the auto-fix feature.  This argument
-assumes that the cursor is already positioned to perform the fix."
-  (if enable-fix
-      (checkdoc-message-text-engine)
-    (let ((msg nil) (p (point)) (type nil)
-	  (checkdoc-autofix-flag nil))
-      (condition-case nil
-	  (while (and (not msg)
-		      (setq type
-			    (checkdoc-message-text-next-string (point-max))))
-	    (message "Searching for message string error...%d%%"
-		     (/ (* 100 (point)) (point-max)))
-	    (if (setq msg (checkdoc-message-text-engine type))
-		(setq msg (cons msg (point)))))
-	;; Quit.. restore position,  Other errors, leave alone
-	(quit (goto-char p)))
-      msg)))
-
-(defun checkdoc-recursive-edit (msg)
-  "Enter recursive edit to permit a user to fix some error checkdoc has found.
-MSG is the error that was found, which is displayed in a help buffer."
-  (with-output-to-temp-buffer "*Checkdoc Help*"
-    (princ-list
-     "Error message:\n  " msg
-     "\n\nEdit to fix this problem, and press C-M-c to continue."))
-  (shrink-window-if-larger-than-buffer
-   (get-buffer-window "*Checkdoc Help*"))
-  (message "When you're done editing press C-M-c to continue.")
-  (unwind-protect
-      (recursive-edit)
-    (if (get-buffer-window "*Checkdoc Help*")
-	(progn
-	  (delete-window (get-buffer-window "*Checkdoc Help*"))
-	  (kill-buffer "*Checkdoc Help*")))))
-
-;;;###autoload
-(defun checkdoc-eval-current-buffer ()
-  "Evaluate and check documentation for the current buffer.
-Evaluation is done first because good documentation for something that
-doesn't work is just not useful.  Comments, doc strings, and rogue
-spacing are all verified."
-  (interactive)
-  (checkdoc-call-eval-buffer nil)
-  (checkdoc-current-buffer t))
-
-;;;###autoload
-(defun checkdoc-current-buffer (&optional take-notes)
-  "Check current buffer for document, comment, error style, and rogue spaces.
-With a prefix argument (in Lisp, the argument TAKE-NOTES),
-store all errors found in a warnings buffer,
-otherwise stop after the first error."
-  (interactive "P")
-  (if (interactive-p) (message "Checking buffer for style..."))
-  ;; Assign a flag to spellcheck flag
-  (let ((checkdoc-spellcheck-documentation-flag
-	 (memq checkdoc-spellcheck-documentation-flag '(buffer t)))
-	(checkdoc-autofix-flag (if take-notes 'never
-				 checkdoc-autofix-flag))
-	(checkdoc-generate-compile-warnings-flag
-	 (or take-notes checkdoc-generate-compile-warnings-flag)))
-    (if take-notes
-	(checkdoc-start-section "checkdoc-current-buffer"))
-    ;; every test is responsible for returning the cursor.
-    (or (and buffer-file-name ;; only check comments in a file
-	     (checkdoc-comments))
-	(checkdoc-start)
-	(checkdoc-message-text)
-	(checkdoc-rogue-spaces)
-	(not (interactive-p))
-	(if take-notes (checkdoc-show-diagnostics))
-	(message "Checking buffer for style...Done."))))
-
-;;;###autoload
-(defun checkdoc-start (&optional take-notes)
-  "Start scanning the current buffer for documentation string style errors.
-Only documentation strings are checked.
-Use `checkdoc-continue' to continue checking if an error cannot be fixed.
-Prefix argument TAKE-NOTES means to collect all the warning messages into
-a separate buffer."
-  (interactive "P")
-  (let ((p (point)))
-    (goto-char (point-min))
-    (if (and take-notes (interactive-p))
-	(checkdoc-start-section "checkdoc-start"))
-    (if (interactive-p)
-	(call-interactively 'checkdoc-continue take-notes)
-      (checkdoc-continue take-notes))
-    ;; Go back since we can't be here without success above.
-    (goto-char p)
-    nil))
-
-;;;###autoload
-(defun checkdoc-continue (&optional take-notes)
-  "Find the next doc string in the current buffer which has a style error.
-Prefix argument TAKE-NOTES means to continue through the whole buffer and
-save warnings in a separate buffer."
-  (interactive "P")
-  (let ((wrong nil) (msg nil) (errors nil)
-	;; Assign a flag to spellcheck flag
-	(checkdoc-spellcheck-documentation-flag
-	 (member checkdoc-spellcheck-documentation-flag
-		 '(buffer t)))
-	(checkdoc-autofix-flag (if take-notes 'never
-				 checkdoc-autofix-flag))
-	(checkdoc-generate-compile-warnings-flag
-	 (or take-notes checkdoc-generate-compile-warnings-flag)))
-    (save-excursion
-      ;; If we are taking notes, encompass the whole buffer, otherwise
-      ;; the user is navigating down through the buffer.
-      (while (and (not wrong) (checkdoc-next-docstring))
-	;; OK, let's look at the doc string.
-	(setq msg (checkdoc-this-string-valid))
-	(if msg (setq wrong (point)))))
-    (if wrong
-	(progn
-	  (goto-char wrong)
-	  (if (not take-notes)
-	      (error (checkdoc-error-text msg)))))
-    (checkdoc-show-diagnostics)
-    (if (interactive-p)
-	(message "No style warnings."))))
-
-(defun checkdoc-next-docstring ()
-  "Move to the next doc string after point, and return t.
-Return nil if there are no more doc strings."
-  (if (not (re-search-forward checkdoc-defun-regexp nil t))
-      nil
-    ;; If we are in a method, a :starting symbol may exist.
-    (if (looking-at "\\s-*:\\w+") (forward-sexp 1))
-    ;; search drops us after the identifier.  The next sexp is either
-    ;; the argument list or the value of the variable.  skip it.
-    (forward-sexp 1)
-    (skip-chars-forward " \n\t")
-    t))
-
-;;; ###autoload
-(defun checkdoc-directory (dir &optional take-notes)
-  "Run checkdoc on all Emacs Lisp files in DIR.
-Prefix argument TAKE-NOTES means to continue through all files and
-save warnings in a buffer."
-  (interactive "DDirectory: \nP")
-  (let* ((files (directory-files dir t "\\.el$"))
-	 (n (length files))
-	 kill kill-me)
-    (if (and take-notes (interactive-p))
-	(checkdoc-start-section (format "checkdoc-directory: %s" dir)))
-    (while files
-      (setq kill (get-file-buffer (car files)))
-      (set-buffer (setq kill-me (find-file-noselect (car files))))
-      (if (interactive-p)
-	  (message "File %d of %d: %s" (- n (length files) -1) n
-		   (file-name-nondirectory (car files))))
-      (checkdoc-start take-notes)
-      (if (not kill) (kill-buffer kill-me))
-      (sit-for 0)
-      (setq files (cdr files)))
-    (checkdoc-show-diagnostics)))
-
-;;; ###autoload
-(defun checkdoc-comments (&optional take-notes)
-  "Find missing comment sections in the current Emacs Lisp file.
-Prefix argument TAKE-NOTES non-nil means to save warnings in a
-separate buffer.  Otherwise print a message.  This returns the error
-if there is one."
-  (interactive "P")
-  (if take-notes (checkdoc-start-section "checkdoc-comments"))
-  (if (not buffer-file-name)
-     (error "Can only check comments for a file buffer"))
-  (let* ((checkdoc-spellcheck-documentation-flag
-	  (member checkdoc-spellcheck-documentation-flag
-		  '(buffer t)))
-	 (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
-	 ;; This is just irritating when taking notes.
-	 (checkdoc-triple-semi-comment-check-flag
-	  (if take-notes nil checkdoc-triple-semi-comment-check-flag))
-	 (e (checkdoc-file-comments-engine))
-	(checkdoc-generate-compile-warnings-flag
-	 (or take-notes checkdoc-generate-compile-warnings-flag)))
-    (if e (error (checkdoc-error-text e)))
-    (checkdoc-show-diagnostics)
-    e))
-
-;;;###autoload
-(defun checkdoc-rogue-spaces (&optional take-notes interact)
-  "Find extra spaces at the end of lines in the current file.
-Prefix argument TAKE-NOTES non-nil means to save warnings in a
-separate buffer.  Otherwise print a message.  This returns the error
-if there is one.
-Optional argument INTERACT permits more interactive fixing."
-  (interactive "P")
-  (if take-notes (checkdoc-start-section "checkdoc-rogue-spaces"))
-  (let* ((checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
-	 (e (checkdoc-rogue-space-check-engine nil nil interact))
-	(checkdoc-generate-compile-warnings-flag
-	 (or take-notes checkdoc-generate-compile-warnings-flag)))
-    (if (not (interactive-p))
-	e
-      (if e
-	  (message (checkdoc-error-text e))
-	(checkdoc-show-diagnostics)
-	(message "Space Check: done.")))))
-
-;;;###autoload
-(defun checkdoc-message-text (&optional take-notes)
-  "Scan the buffer for occurrences of the error function, and verify text.
-Optional argument TAKE-NOTES causes all errors to be logged."
-  (interactive "P")
-  (if take-notes (checkdoc-start-section "checkdoc-message-text"))
-  (let* ((p (point)) e
-	 (checkdoc-autofix-flag (if take-notes 'never checkdoc-autofix-flag))
-	 (checkdoc-generate-compile-warnings-flag
-	  (or take-notes checkdoc-generate-compile-warnings-flag)))
-    (setq e (checkdoc-message-text-search))
-    (if (not (interactive-p))
-	e
-      (if e
-	  (error (checkdoc-error-text e))
-	(checkdoc-show-diagnostics)))
-    (goto-char p))
-  (if (interactive-p) (message "Checking interactive message text...done.")))
-    
-;;;###autoload
-(defun checkdoc-eval-defun ()
-  "Evaluate the current form with `eval-defun' and check its documentation.
-Evaluation is done first so the form will be read before the
-documentation is checked.  If there is a documentation error, then the display
-of what was evaluated will be overwritten by the diagnostic message."
-  (interactive)
-  (eval-defun nil)
-  (checkdoc-defun))
-
-;;;###autoload
-(defun checkdoc-defun (&optional no-error)
-  "Examine the doc string of the function or variable under point.
-Call `error' if the doc string has problems.  If NO-ERROR is
-non-nil, then do not call error, but call `message' instead.
-If the doc string passes the test, then check the function for rogue white
-space at the end of each line."
-  (interactive)
-  (save-excursion
-    (beginning-of-defun)
-    (if (not (looking-at checkdoc-defun-regexp))
-	;; I found this more annoying than useful.
-	;;(if (not no-error)
-	;;    (message "Cannot check this sexp's doc string."))
-	nil
-      ;; search drops us after the identifier.  The next sexp is either
-      ;; the argument list or the value of the variable.  skip it.
-      (goto-char (match-end 0))
-      ;; If we are in a method, a :starting symbol may exist.
-      (if (looking-at "\\s-*:\\w+") (forward-sexp 1))
-      (forward-sexp 1)
-      (skip-chars-forward " \n\t")
-      (let* ((checkdoc-spellcheck-documentation-flag
-	      (member checkdoc-spellcheck-documentation-flag
-		      '(defun t)))
-	     (beg (save-excursion (beginning-of-defun) (point)))
-	     (end (save-excursion (end-of-defun) (point)))
-	     (msg (checkdoc-this-string-valid)))
-	(if msg (if no-error
-		    (message (checkdoc-error-text msg))
-		  (error (checkdoc-error-text msg)))
-	  (setq msg (checkdoc-message-text-search beg end))
-	  (if msg (if no-error
-		      (message (checkdoc-error-text msg))
-		    (error (checkdoc-error-text msg)))
-	    (setq msg (checkdoc-rogue-space-check-engine beg end))
-	    (if msg (if no-error
-			(message (checkdoc-error-text msg))
-		      (error (checkdoc-error-text msg))))))
-	(if (interactive-p) (message "Checkdoc: done."))))))
-
-;;; Ispell interface for forcing a spell check
-;;
-
-;;;###autoload
-(defun checkdoc-ispell (&optional take-notes)
-  "Check the style and spelling of everything interactively.
-Calls `checkdoc' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc'"
-  (interactive)
-  (let ((checkdoc-spellcheck-documentation-flag t))
-    (call-interactively 'checkdoc nil current-prefix-arg)))
-
-;;;###autoload
-(defun checkdoc-ispell-current-buffer (&optional take-notes)
-  "Check the style and spelling of the current buffer.
-Calls `checkdoc-current-buffer' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'"
-  (interactive)
-  (let ((checkdoc-spellcheck-documentation-flag t))
-    (call-interactively 'checkdoc-current-buffer nil current-prefix-arg)))
-
-;;;###autoload
-(defun checkdoc-ispell-interactive (&optional take-notes)
-  "Check the style and spelling of the current buffer interactively.
-Calls `checkdoc-interactive' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-interactive'"
-  (interactive)
-  (let ((checkdoc-spellcheck-documentation-flag t))
-    (call-interactively 'checkdoc-interactive nil current-prefix-arg)))
-
-;;;###autoload
-(defun checkdoc-ispell-message-interactive (&optional take-notes)
-  "Check the style and spelling of message text interactively.
-Calls `checkdoc-message-interactive' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-message-interactive'"
-  (interactive)
-  (let ((checkdoc-spellcheck-documentation-flag t))
-    (call-interactively 'checkdoc-message-interactive nil current-prefix-arg)))
-
-;;;###autoload
-(defun checkdoc-ispell-message-text (&optional take-notes)
-  "Check the style and spelling of message text interactively.
-Calls `checkdoc-message-text' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-message-text'"
-  (interactive)
-  (let ((checkdoc-spellcheck-documentation-flag t))
-    (call-interactively 'checkdoc-message-text nil current-prefix-arg)))
-
-;;;###autoload
-(defun checkdoc-ispell-start (&optional take-notes)
-  "Check the style and spelling of the current buffer.
-Calls `checkdoc-start' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-start'"
-  (interactive)
-  (let ((checkdoc-spellcheck-documentation-flag t))
-    (call-interactively 'checkdoc-start nil current-prefix-arg)))
-
-;;;###autoload
-(defun checkdoc-ispell-continue (&optional take-notes)
-  "Check the style and spelling of the current buffer after point.
-Calls `checkdoc-continue' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-continue'"
-  (interactive)
-  (let ((checkdoc-spellcheck-documentation-flag t))
-    (call-interactively 'checkdoc-continue nil current-prefix-arg)))
-
-;;;###autoload
-(defun checkdoc-ispell-comments (&optional take-notes)
-  "Check the style and spelling of the current buffer's comments.
-Calls `checkdoc-comments' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-comments'"
-  (interactive)
-  (let ((checkdoc-spellcheck-documentation-flag t))
-    (call-interactively 'checkdoc-comments nil current-prefix-arg)))
-
-;;;###autoload
-(defun checkdoc-ispell-defun (&optional take-notes)
-  "Check the style and spelling of the current defun with Ispell.
-Calls `checkdoc-defun' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'"
-  (interactive)
-  (let ((checkdoc-spellcheck-documentation-flag t))
-    (call-interactively 'checkdoc-defun nil current-prefix-arg)))
-
-;;; Error Management
-;;
-;; Errors returned from checkdoc functions can have various
-;; features and behaviors, so we need some ways of specifying
-;; them, and making them easier to use in the wacked-out interfaces
-;; people are requesting
-(defun checkdoc-create-error (text start end &optional unfixable)
-  "Used to create the return error text returned from all engines.
-TEXT is the descriptive text of the error.  START and END define the region
-it is sensible to highlight when describing the problem.
-Optional argument UNFIXABLE means that the error has no auto-fix available.
-
-A list of the form (TEXT START END UNFIXABLE) is returned if we are not
-generating a buffered list of errors."
-  (if checkdoc-generate-compile-warnings-flag
-      (progn (checkdoc-error start text)
-	     nil)
-    (list text start end unfixable)))
-
-(defun checkdoc-error-text (err)
-  "Return the text specified in the checkdoc ERR."
-  ;; string-p part is for backwards compatibility
-  (if (stringp err) err (car err)))
-
-(defun checkdoc-error-start (err)
-  "Return the start point specified in the checkdoc ERR."
-  ;; string-p part is for backwards compatibility
-  (if (stringp err) nil (nth 1 err)))
-
-(defun checkdoc-error-end (err)
-  "Return the end point specified in the checkdoc ERR."
-  ;; string-p part is for backwards compatibility
-  (if (stringp err) nil (nth 2 err)))
-
-(defun checkdoc-error-unfixable (err)
-  "Return the t if we cannot autofix the error specified in the checkdoc ERR."
-  ;; string-p part is for backwards compatibility
-  (if (stringp err) nil (nth 3 err)))
-
-;;; Minor Mode specification
-;;
-(defvar checkdoc-minor-mode nil
-  "Non-nil in `emacs-lisp-mode' for automatic documentation checking.")
-(make-variable-buffer-local 'checkdoc-minor-mode)
-
-(checkdoc-add-to-list 'minor-mode-alist '(checkdoc-minor-mode " CDoc"))
-
-(defvar checkdoc-minor-keymap
-  (let ((map (make-sparse-keymap))
-	(pmap (make-sparse-keymap)))
-    ;; Override some bindings
-    (define-key map "\C-\M-x" 'checkdoc-eval-defun)
-    ;(define-key map "\C-x`" 'checkdoc-continue)
-    (if (not checkdoc-xemacs-p)
-	(define-key map [menu-bar emacs-lisp eval-buffer]
-	  'checkdoc-eval-current-buffer))
-    ;; Add some new bindings under C-c ?
-    (define-key pmap "x" 'checkdoc-defun)
-    (define-key pmap "X" 'checkdoc-ispell-defun)
-    (define-key pmap "`" 'checkdoc-continue)
-    (define-key pmap "~" 'checkdoc-ispell-continue)
-    (define-key pmap "s" 'checkdoc-start)
-    (define-key pmap "S" 'checkdoc-ispell-start)
-    (define-key pmap "d" 'checkdoc)
-    (define-key pmap "D" 'checkdoc-ispell)
-    (define-key pmap "b" 'checkdoc-current-buffer)
-    (define-key pmap "B" 'checkdoc-ispell-current-buffer)
-    (define-key pmap "e" 'checkdoc-eval-current-buffer)
-    (define-key pmap "m" 'checkdoc-message-text)
-    (define-key pmap "M" 'checkdoc-ispell-message-text)
-    (define-key pmap "c" 'checkdoc-comments)
-    (define-key pmap "C" 'checkdoc-ispell-comments)
-    (define-key pmap " " 'checkdoc-rogue-spaces)
-
-    ;; bind our submap into map
-    (define-key map "\C-c?" pmap)
-    map)
-  "Keymap used to override evaluation key-bindings for documentation checking.")
-
-;; Add in a menubar with easy-menu
-
-(if checkdoc-minor-keymap
-    (easy-menu-define
-     checkdoc-minor-menu checkdoc-minor-keymap "Checkdoc Minor Mode Menu"
-     '("CheckDoc"
-       ["Interactive Buffer Style Check" checkdoc t]
-       ["Interactive Buffer Style and Spelling Check" checkdoc-ispell t]
-       ["Check Buffer" checkdoc-current-buffer t]
-       ["Check and Spell Buffer" checkdoc-ispell-current-buffer t]
-       "---"
-       ["Interactive Style Check" checkdoc-interactive t]
-       ["Interactive Style and Spelling Check" checkdoc-ispell-interactive t]
-       ["Find First Style Error" checkdoc-start t]
-       ["Find First Style or Spelling  Error" checkdoc-ispell-start t]
-       ["Next Style Error" checkdoc-continue t]
-       ["Next Style or Spelling  Error" checkdoc-ispell-continue t]
-       ["Interactive Message Text Style Check" checkdoc-message-interactive t]
-       ["Interactive Message Text Style and Spelling Check"
-	checkdoc-ispell-message-interactive t]
-       ["Check Message Text" checkdoc-message-text t]
-       ["Check and Spell Message Text" checkdoc-ispell-message-text t]
-       ["Check Comment Style" checkdoc-comments buffer-file-name]
-       ["Check Comment Style and Spelling" checkdoc-ispell-comments
-	buffer-file-name]
-       ["Check for Rogue Spaces" checkdoc-rogue-spaces t]
-       "---"
-       ["Check Defun" checkdoc-defun t]
-       ["Check and Spell Defun" checkdoc-ispell-defun t]
-       ["Check and Evaluate Defun" checkdoc-eval-defun t]
-       ["Check and Evaluate Buffer" checkdoc-eval-current-buffer t]
-       )))
-;; XEmacs requires some weird stuff to add this menu in a minor mode.
-;; What is it?
-
-;; Allow re-insertion of a new keymap
-(let ((a (assoc 'checkdoc-minor-mode minor-mode-map-alist)))
-  (if a
-      (setcdr a checkdoc-minor-keymap)
-    (checkdoc-add-to-list 'minor-mode-map-alist (cons 'checkdoc-minor-mode
-						      checkdoc-minor-keymap))))
-
-;;;###autoload
-(defun checkdoc-minor-mode (&optional arg)
-  "Toggle Checkdoc minor mode, a mode for checking Lisp doc strings.
-With prefix ARG, turn Checkdoc minor mode on iff ARG is positive.
-
-In Checkdoc minor mode, the usual bindings for `eval-defun' which is
-bound to \\ \\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include
-checking of documentation strings.
-
-\\{checkdoc-minor-keymap}"
-  (interactive "P")
-  (setq checkdoc-minor-mode
-	(not (or (and (null arg) checkdoc-minor-mode)
-		 (<= (prefix-numeric-value arg) 0))))
-  (checkdoc-mode-line-update))
-
-;;; Subst utils
-;;
-(defsubst checkdoc-run-hooks (hookvar &rest args)
-  "Run hooks in HOOKVAR with ARGS."
-  (if (fboundp 'run-hook-with-args-until-success)
-      (apply 'run-hook-with-args-until-success hookvar args)
-    ;; This method was similar to above.  We ignore the warning
-    ;; since we will use the above for future Emacs versions
-    (apply 'run-hook-with-args hookvar args)))
-
-(defsubst checkdoc-create-common-verbs-regexp ()
-  "Rebuild the contents of `checkdoc-common-verbs-regexp'."
-  (or checkdoc-common-verbs-regexp
-      (setq checkdoc-common-verbs-regexp
-	    (concat "\\<\\("
-		    (mapconcat (lambda (e) (concat (car e)))
-			       checkdoc-common-verbs-wrong-voice "\\|")
-		    "\\)\\>"))))
-
-;; Profiler says this is not yet faster than just calling assoc
-;;(defun checkdoc-word-in-alist-vector (word vector)
-;;  "Check to see if WORD is in the car of an element of VECTOR.
-;;VECTOR must be sorted.  The CDR should be a replacement.  Since the
-;;word list is getting bigger, it is time for a quick bisecting search."
-;;  (let ((max (length vector)) (min 0) i
-;;	(found nil) (fw nil))
-;;    (setq i (/ max 2))
-;;    (while (and (not found) (/= min max))
-;;      (setq fw (car (aref vector i)))
-;;      (cond ((string= word fw) (setq found (cdr (aref vector i))))
-;;	    ((string< word fw) (setq max i))
-;;	    (t (setq min i)))
-;;      (setq i (/ (+ max min) 2))
-;;      )
-;;    found))
-
-;;; Checking engines
-;;
-(defun checkdoc-this-string-valid ()
-  "Return a message string if the current doc string is invalid.
-Check for style only, such as the first line always being a complete
-sentence, whitespace restrictions, and making sure there are no
-hard-coded key-codes such as C-[char] or mouse-[number] in the comment.
-See the style guide in the Emacs Lisp manual for more details."
-
-  ;; Jump over comments between the last object and the doc string
-  (while (looking-at "[ \t\n]*;")
-    (forward-line 1)
-    (beginning-of-line)
-    (skip-chars-forward " \n\t"))
-
-  (let ((fp (checkdoc-defun-info))
-	(err nil))
-    (setq
-     err
-     ;; * Every command, function, or variable intended for users to know
-     ;;   about should have a documentation string.
-     ;;
-     ;; * An internal variable or subroutine of a Lisp program might as well
-     ;;   have a documentation string.  In earlier Emacs versions, you could
-     ;;   save space by using a comment instead of a documentation string,
-     ;;   but that is no longer the case.
-     (if (and (not (nth 1 fp))		; not a variable
-	      (or (nth 2 fp)		; is interactive
-		  checkdoc-force-docstrings-flag) ;or we always complain
-	      (not (checkdoc-char= (following-char) ?\"))) ; no doc string
-	 ;; Sometimes old code has comments where the documentation should
-	 ;; be.  Let's see if we can find the comment, and offer to turn it
-	 ;; into documentation for them.
-	 (let ((have-comment nil)
-	       (comment-start ";"))
-	   (condition-case nil
-	       (progn
-		 (forward-sexp -1)
-		 (forward-sexp 1)
-		 (skip-chars-forward "\n \t")
-		 (setq have-comment (looking-at comment-start)))
-	     (error nil))
-	   (if have-comment
-	       (if (or (eq checkdoc-autofix-flag
-			   'automatic-then-never)
-		       (checkdoc-y-or-n-p
-			"Convert comment to documentation? "))
-		   (save-excursion
-		     ;; Our point is at the beginning of the comment!
-		     ;; Insert a quote, then remove the comment chars.
-		     (insert "\"")
-		     (let ((docstring-start-point (point)))
-		       (while (looking-at comment-start)
-			 (while (looking-at comment-start)
-			   (delete-char 1))
-			 (if (looking-at "[ \t]+")
-			     (delete-region (match-beginning 0) (match-end 0)))
-			 (forward-line 1)
-			 (beginning-of-line)
-			 (skip-chars-forward " \t")
-			 (if (looking-at comment-start)
-			     (progn
-			       (beginning-of-line)
-			       (zap-to-char 1 ?\;))))
-		       (beginning-of-line)
-		       (forward-char -1)
-		       (insert "\"")
-		       (forward-char -1)
-		       ;; quote any double-quote characters in the comment.
-		       (while (search-backward "\"" docstring-start-point t)
-			 (insert "\\"))
-		       (if (eq checkdoc-autofix-flag 'automatic-then-never)
-			   (setq checkdoc-autofix-flag 'never))))
-		 (checkdoc-create-error
-		  "You should convert this comment to documentation"
-		  (point) (save-excursion (end-of-line) (point))))
-	     (checkdoc-create-error
-	      (if (nth 2 fp)
-		  "All interactive functions should have documentation"
-		"All variables and subroutines might as well have a \
-documentation string")
-	      (point) (+ (point) 1) t)))))
-    (if (and (not err) (looking-at "\""))
-	(let ((old-syntax-table (syntax-table)))
-	  (unwind-protect
-	      (progn
-		(set-syntax-table checkdoc-syntax-table)
-		(checkdoc-this-string-valid-engine fp))
-	    (set-syntax-table old-syntax-table)))
-      err)))
-
-(defun checkdoc-this-string-valid-engine (fp)
-  "Return an error list or string if the current doc string is invalid.
-Depends on `checkdoc-this-string-valid' to reset the syntax table so that
-regexp short cuts work.  FP is the function defun information."
-  (let ((case-fold-search nil)
-	;; Use a marker so if an early check modifies the text,
-	;; we won't accidentally loose our place.  This could cause
-	;; end-of doc string whitespace to also delete the " char.
-	(s (point))
-	(e (if (looking-at "\"")
-	       (save-excursion (forward-sexp 1) (point-marker))
-	     (point))))
-    (or
-     ;; * *Do not* indent subsequent lines of a documentation string so that
-     ;;   the text is lined up in the source code with the text of the first
-     ;;   line.  This looks nice in the source code, but looks bizarre when
-     ;;   users view the documentation.  Remember that the indentation
-     ;;   before the starting double-quote is not part of the string!
-     (save-excursion
-       (forward-line 1)
-       (beginning-of-line)
-       (if (and (< (point) e)
-		(looking-at "\\([ \t]+\\)[^ \t\n]"))
-	   (if (checkdoc-autofix-ask-replace (match-beginning 1)
-					     (match-end 1)
-					     "Remove this whitespace? "
-					     "")
-	       nil
-	     (checkdoc-create-error
-	      "Second line should not have indentation"
-	      (match-beginning 1)
-	      (match-end 1)))))
-     ;; * Do not start or end a documentation string with whitespace.
-     (let (start end)
-       (if (or (if (looking-at "\"\\([ \t\n]+\\)")
-		   (setq start (match-beginning 1)
-			 end (match-end 1)))
-	       (save-excursion
-		 (forward-sexp 1)
-		 (forward-char -1)
-		 (if (/= (skip-chars-backward " \t\n") 0)
-		     (setq start (point)
-			   end (1- e)))))
-	   (if (checkdoc-autofix-ask-replace
-		start end "Remove this whitespace? " "")
-	       nil
-	     (checkdoc-create-error
-	      "Documentation strings should not start or end with whitespace"
-	      start end))))
-     ;; * The first line of the documentation string should consist of one
-     ;;   or two complete sentences that stand on their own as a summary.
-     ;;   `M-x apropos' displays just the first line, and if it doesn't
-     ;;   stand on its own, the result looks bad.  In particular, start the
-     ;;   first line with a capital letter and end with a period.
-     (save-excursion
-       (end-of-line)
-       (skip-chars-backward " \t\n")
-       (if (> (point) e) (goto-char e)) ;of the form (defun n () "doc" nil)
-       (forward-char -1)
-       (cond
-	((and (checkdoc-char= (following-char) ?\")
-	      ;; A backslashed double quote at the end of a sentence
-	      (not (checkdoc-char= (preceding-char) ?\\)))
-	 ;; We might have to add a period in this case
-	 (forward-char -1)
-	 (if (looking-at "[.!?]")
-	     nil
-	   (forward-char 1)
-	   (if (checkdoc-autofix-ask-replace
-		(point) (1+ (point)) "Add period to sentence? "
-		".\"" t)
-	       nil
-	     (checkdoc-create-error
-	      "First sentence should end with punctuation"
-	      (point) (1+ (point))))))
-	((looking-at "[\\!?;:.)]")
-	 ;; These are ok
-	 nil)
-        ((and checkdoc-permit-comma-termination-flag (looking-at ","))
-	 nil)
-	(t
-	 ;; If it is not a complete sentence, let's see if we can
-	 ;; predict a clever way to make it one.
-	 (let ((msg "First line is not a complete sentence")
-	       (e (point)))
-	   (beginning-of-line)
-	   (if (re-search-forward "\\. +" e t)
-	       ;; Here we have found a complete sentence, but no break.
-	       (if (checkdoc-autofix-ask-replace
-		    (1+ (match-beginning 0)) (match-end 0)
-		    "First line not a complete sentence.  Add RET here? "
-		    "\n" t)
-		   (let (l1 l2)
-		     (forward-line 1)
-		     (end-of-line)
-		     (setq l1 (current-column)
-			   l2 (save-excursion
-				(forward-line 1)
-				(end-of-line)
-				(current-column)))
-		     (if (> (+ l1 l2 1) 80)
-			 (setq msg "Incomplete auto-fix; doc string \
-may require more formatting")
-		       ;; We can merge these lines!  Replace this CR
-		       ;; with a space.
-		       (delete-char 1) (insert " ")
-		       (setq msg nil))))
-	     ;; Let's see if there is enough room to draw the next
-	     ;; line's sentence up here.  I often get hit w/
-	     ;; auto-fill moving my words around.
-	     (let ((numc (progn (end-of-line) (- 80 (current-column))))
-		   (p    (point)))
-	       (forward-line 1)
-	       (beginning-of-line)
-	       (if (and (re-search-forward "[.!?:\"]\\([ \t\n]+\\|\"\\)"
-					   (save-excursion
-					     (end-of-line)
-					     (point))
-					   t)
-			(< (current-column) numc))
-		   (if (checkdoc-autofix-ask-replace
-			p (1+ p)
-			"1st line not a complete sentence.  Join these lines? "
-			" " t)
-		       (progn
-			 ;; They said yes.  We have more fill work to do...
-			 (goto-char (match-beginning 1))
-			 (delete-region (point) (match-end 1))
-			 (insert "\n")
-			 (setq msg nil))))))
-	   (if msg
-	       (checkdoc-create-error msg s (save-excursion
-					      (goto-char s)
-					      (end-of-line)
-					      (point)))
-	     nil) ))))
-     ;; Continuation of above.  Make sure our sentence is capitalized.
-     (save-excursion
-       (skip-chars-forward "\"\\*")
-       (if (looking-at "[a-z]")
-	   (if (checkdoc-autofix-ask-replace
-		(match-beginning 0) (match-end 0)
-		"Capitalize your sentence? " (upcase (match-string 0))
-		t)
-	       nil
-	     (checkdoc-create-error
-	      "First line should be capitalized"
-	      (match-beginning 0) (match-end 0)))
-	 nil))
-     ;;   * Don't write key sequences directly in documentation strings.
-     ;;     Instead, use the `\\[...]' construct to stand for them.
-     (save-excursion
-       (let ((f nil) (m nil) (start (point))
-	     (re "[^`A-Za-z0-9_]\\([CMA]-[a-zA-Z]\\|\\(\\([CMA]-\\)?\
-mouse-[0-3]\\)\\)\\>"))
-	 ;; Find the first key sequence not in a sample
-	 (while (and (not f) (setq m (re-search-forward re e t)))
-	   (setq f (not (checkdoc-in-sample-code-p start e))))
-	 (if m
-	     (checkdoc-create-error
-	      (concat
-	       "Keycode " (match-string 1)
-	       " embedded in doc string.  Use \\\\ & \\\\[function] "
-	       "instead")
-	      (match-beginning 1) (match-end 1) t))))
-     ;; It is not practical to use `\\[...]' very many times, because
-     ;; display of the documentation string will become slow.  So use this
-     ;; to describe the most important commands in your major mode, and
-     ;; then use `\\{...}' to display the rest of the mode's keymap.
-     (save-excursion
-       (if (re-search-forward "\\\\\\\\\\[\\w+" e t
-			      (1+ checkdoc-max-keyref-before-warn))
-	   (checkdoc-create-error
-	    "Too many occurrences of \\[function].  Use \\{keymap} instead"
-	    s (marker-position e))))
-     ;; Ambiguous quoted symbol.  When a symbol is both bound and fbound,
-     ;; and is referred to in documentation, it should be prefixed with
-     ;; something to disambiguate it.  This check must be before the
-     ;; 80 column check because it will probably break that.
-     (save-excursion
-       (let ((case-fold-search t)
-	     (ret nil) mb me)
-	 (while (and (re-search-forward "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'" e t)
-		     (not ret))
-	   (let* ((ms1 (match-string 1))
-		  (sym (intern-soft ms1)))
-	     (setq mb (match-beginning 1)
-		   me (match-end 1))
-	     (if (and sym (boundp sym) (fboundp sym)
-		      (save-excursion
-			(goto-char mb)
-			(forward-word -1)
-			(not (looking-at
-			      "variable\\|option\\|function\\|command\\|symbol"))))
-		 (if (checkdoc-autofix-ask-replace
-		      mb me "Prefix this ambiguous symbol? " ms1 t)
-		     ;; We didn't actually replace anything.  Here we find
-		     ;; out what special word form they wish to use as
-		     ;; a prefix.
-		     (let ((disambiguate
-			    (completing-read
-			     "Disambiguating Keyword (default: variable): "
-			     '(("function") ("command") ("variable")
-			       ("option") ("symbol"))
-			     nil t nil nil "variable")))
-		       (goto-char (1- mb))
-		       (insert disambiguate " ")
-		       (forward-word 1))
-		   (setq ret
-			 (format "Disambiguate %s by preceding w/ \
-function,command,variable,option or symbol." ms1))))))
-	 (if ret
-	     (checkdoc-create-error ret mb me)
-	   nil)))
-     ;; * Format the documentation string so that it fits in an
-     ;;   Emacs window on an 80-column screen.  It is a good idea
-     ;;   for most lines to be no wider than 60 characters.  The
-     ;;   first line can be wider if necessary to fit the
-     ;;   information that ought to be there.
-     (save-excursion
-       (let ((start (point))
-	     (eol nil))
-	 (while (and (< (point) e)
-		     (or (progn (end-of-line) (setq eol (point))
-				(< (current-column) 80))
-			 (progn (beginning-of-line)
-				(re-search-forward "\\\\\\\\[[<{]"
-						   eol t))
-			 (checkdoc-in-sample-code-p start e)))
-	   (forward-line 1))
-	 (end-of-line)
-	 (if (and (< (point) e) (> (current-column) 80))
-	     (checkdoc-create-error
-	      "Some lines are over 80 columns wide"
-	      s (save-excursion (goto-char s) (end-of-line) (point)) ))))
-     ;; Here we deviate to tests based on a variable or function.
-     ;; We must do this before checking for symbols in quotes because there
-     ;; is a chance that just such a symbol might really be an argument.
-     (cond ((eq (nth 1 fp) t)
-	    ;; This is if we are in a variable
-	    (or
-	     ;; * The documentation string for a variable that is a
-	     ;;   yes-or-no flag should start with words such as Non-nil
-	     ;;   means..., to make it clear that all non-`nil' values are
-	     ;;   equivalent and indicate explicitly what `nil' and non-`nil'
-	     ;;   mean.
-	     ;; * If a user option variable records a true-or-false
-	     ;;   condition, give it a name that ends in `-flag'.
-
-	     ;; If the variable has -flag in the name, make sure
-	     (if (and (string-match "-flag$" (car fp))
-		      (not (looking-at "\"\\*?Non-nil\\s-+means\\s-+")))
-		 (checkdoc-create-error
-		  "Flag variable doc strings should start: Non-nil means"
-		  s (marker-position e) t))
-	     ;; If the doc string starts with "Non-nil means"
-	     (if (and (looking-at "\"\\*?Non-nil\\s-+means\\s-+")
-		      (not (string-match "-flag$" (car fp))))
-		 (if (checkdoc-y-or-n-p
-		      (format
-		       "Rename to %s and Query-Replace all occurances? "
-		       (concat (car fp) "-flag")))
-		     (progn
-		       (beginning-of-defun)
-		       (query-replace-regexp
-			(concat "\\<" (regexp-quote (car fp)) "\\>")
-			(concat (car fp) "-flag")))
-		   (checkdoc-create-error
-		    "Flag variables should end in `-flag'" s
-		    (marker-position e))))
-	     ;; Done with variables
-	     ))
-	   (t
-	    ;; This if we are in a function definition
-	    (or
-	     ;; * When a function's documentation string mentions the value
-	     ;;   of an argument of the function, use the argument name in
-	     ;;   capital letters as if it were a name for that value.  Thus,
-	     ;;   the documentation string of the function `/' refers to its
-	     ;;   second argument as `DIVISOR', because the actual argument
-	     ;;   name is `divisor'.
-
-	     ;;   Addendum:  Make sure they appear in the doc in the same
-	     ;;              order that they are found in the arg list.
-	     (let ((args (cdr (cdr (cdr (cdr fp)))))
-		   (last-pos 0)
-		   (found 1)
-		   (order (and (nth 3 fp) (car (nth 3 fp))))
-		   (nocheck (append '("&optional" "&rest") (nth 3 fp)))
-		   (inopts nil))
-	       (while (and args found (> found last-pos))
-		 (if (member (car args) nocheck)
-		     (setq args (cdr args)
-			   inopts t)
-		   (setq last-pos found
-			 found (save-excursion
-				 (re-search-forward
-				  (concat "\\<" (upcase (car args))
-					  ;; Require whitespace OR
-					  ;; ITEMth OR
-					  ;; ITEMs
-					  "\\(\\>\\|th\\>\\|s\\>\\)")
-				  e t)))
-		   (if (not found)
-		       (let ((case-fold-search t))
-			 ;; If the symbol was not found, let's see if we
-			 ;; can find it with a different capitalization
-			 ;; and see if the user wants to capitalize it.
-			 (if (save-excursion
-			       (re-search-forward
-				(concat "\\<\\(" (car args)
-					;; Require whitespace OR
-					;; ITEMth OR
-					;; ITEMs
-					"\\)\\(\\>\\|th\\>\\|s\\>\\)")
-				e t))
-			     (if (checkdoc-autofix-ask-replace
-				  (match-beginning 1) (match-end 1)
-				  (format
-				   "Argument `%s' should appear as `%s'.  Fix? "
-				   (car args) (upcase (car args)))
-				  (upcase (car args)) t)
-				 (setq found (match-beginning 1))))))
-		   (if found (setq args (cdr args)))))
-	       (if (not found)
-		   ;; It wasn't found at all!  Offer to attach this new symbol
-		   ;; to the end of the documentation string.
-		   (if (checkdoc-y-or-n-p
-			(format
-			 "Add %s documentation to end of doc string? "
-			 (upcase (car args))))
-		       ;; Now do some magic and invent a doc string.
-		       (save-excursion
-			 (goto-char e) (forward-char -1)
-			 (insert "\n"
-				 (if inopts "Optional a" "A")
-				 "rgument " (upcase (car args))
-				 " ")
-			 (insert (read-string "Describe: "))
-			 (if (not (save-excursion (forward-char -1)
-						  (looking-at "[.?!]")))
-			     (insert "."))
-			 nil)
-		     ;; Well, they don't want that.  Add ingore param?
-		     (if (checkdoc-y-or-n-p
-			  (format "Add %s to be never documented? " (car args)))
-			 (save-excursion
-			   (goto-char s)
-			   (insert "; checkdoc-params: (" (car args) ")\n")
-			   (indent-for-tab-command)
-			   )
-		       (checkdoc-create-error
-			(format
-			 "Argument `%s' should appear (as `%s') in the doc string"
-			 (car args) (upcase (car args)))
-			s (marker-position e))))
-		 (if (or (and order (eq order 'yes))
-			 (and (not order) checkdoc-arguments-in-order-flag))
-		     (if (< found last-pos)
-			 (checkdoc-create-error
-			  "Arguments occur in the doc string out of order"
-			  s (marker-position e) t)))))
-	     ;; * For consistency, phrase the verb in the first sentence of a
-	     ;;   documentation string for functions as an infinitive with
-	     ;;   "to" omitted.  For instance, use `Return the cons of A and
-	     ;;   B.' in preference to `Returns the cons of A and B.'
-	     ;;   Usually it looks good to do likewise for the rest of the
-	     ;;   first paragraph.  Subsequent paragraphs usually look better
-	     ;;   if they have proper subjects.
-	     ;;
-	     ;; This is the least important of the above tests.  Make sure
-	     ;; it occurs last.
-	     (and checkdoc-verb-check-experimental-flag
-		  (save-excursion
-		    ;; Maybe rebuild the monster-regex
-		    (checkdoc-create-common-verbs-regexp)
-		    (let ((lim (save-excursion
-				 (end-of-line)
-				 ;; check string-continuation
-				 (if (checkdoc-char= (preceding-char) ?\\)
-				     (progn (forward-line 1)
-					    (end-of-line)))
-				 (point)))
-			  (rs nil) replace original (case-fold-search t))
-		      (while (and (not rs)
-				  (re-search-forward
-				   checkdoc-common-verbs-regexp
-				   lim t))
-			(setq original (buffer-substring-no-properties
-					(match-beginning 1) (match-end 1))
-			      rs (assoc (downcase original)
-					checkdoc-common-verbs-wrong-voice))
-			(if (not rs) (error "Verb voice alist corrupted"))
-			(setq replace (let ((case-fold-search nil))
-					(save-match-data
-					  (if (string-match "^[A-Z]" original)
-					      (capitalize (cdr rs))
-					    (cdr rs)))))
-			(if (checkdoc-autofix-ask-replace
-			     (match-beginning 1) (match-end 1)
-			     (format "Use the infinitive for `%s'.  \
-Replace with `%s'? " original replace)
-			     replace t)
-			    (setq rs nil)))
-		      (if rs
-			  ;; there was a match, but no replace
-			  (checkdoc-create-error
-			   (format
-			    "Infinitive `%s' should be replaced with `%s'"
-			    original replace)
-			   (match-beginning 1) (match-end 1))))))
-	     ;; Done with functions
-	     )))
-     ;;* When a documentation string refers to a Lisp symbol, write it as
-     ;;  it would be printed (which usually means in lower case), with
-     ;;  single-quotes around it.  For example: `lambda'.  There are two
-     ;;  exceptions: write t and nil without single-quotes.  (In this
-     ;;  manual, we normally do use single-quotes for those symbols.)
-     (save-excursion
-       (let ((found nil) (start (point)) (msg nil) (ms nil))
-	 (while (and (not msg)
-		     (re-search-forward
-		      "[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]']"
-		      e t))
-	   (setq ms (match-string 1))
-	   (save-match-data
-	     ;; A . is a \s_ char, so we must remove periods from
-	     ;; sentences more carefully.
-	     (if (string-match "\\.$" ms)
-		 (setq ms (substring ms 0 (1- (length ms))))))
-	   (if (and (not (checkdoc-in-sample-code-p start e))
-		    (not (checkdoc-in-example-string-p start e))
-		    (not (member ms checkdoc-symbol-words))
-		    (setq found (intern-soft ms))
-		    (or (boundp found) (fboundp found)))
-	       (progn
-		 (setq msg (format "Add quotes around Lisp symbol `%s'? "
-				   ms))
-		 (if (checkdoc-autofix-ask-replace
-		      (match-beginning 1) (+ (match-beginning 1)
-					     (length ms))
-		      msg (concat "`" ms "'") t)
-		     (setq msg nil)
-		   (setq msg
-			 (format "Lisp symbol `%s' should appear in quotes"
-				 ms))))))
-	 (if msg
-	     (checkdoc-create-error msg (match-beginning 1)
-				    (+ (match-beginning 1)
-				       (length ms)))
-	   nil)))
-     ;; t and nil case
-     (save-excursion
-       (if (re-search-forward "\\(`\\(t\\|nil\\)'\\)" e t)
-	   (if (checkdoc-autofix-ask-replace
-		(match-beginning 1) (match-end 1)
-		(format "%s should not appear in quotes.  Remove? "
-			(match-string 2))
-		(match-string 2) t)
-	       nil
-	     (checkdoc-create-error
-	      "Symbols t and nil should not appear in `quotes'"
-	      (match-beginning 1) (match-end 1)))))
-     ;; Here is some basic sentence formatting
-     (checkdoc-sentencespace-region-engine (point) e)
-     ;; Here are common proper nouns that should always appear capitalized.
-     (checkdoc-proper-noun-region-engine (point) e)
-     ;; Make sure the doc string has correctly spelled English words
-     ;; in it.  This function is extracted due to its complexity,
-     ;; and reliance on the Ispell program.
-     (checkdoc-ispell-docstring-engine e)
-     ;; User supplied checks
-     (save-excursion (checkdoc-run-hooks 'checkdoc-style-hooks fp e))
-     ;; Done!
-     )))
-
-(defun checkdoc-defun-info nil
-  "Return a list of details about the current sexp.
-It is a list of the form:
-   (NAME VARIABLE INTERACTIVE NODOCPARAMS PARAMETERS ...)
-where NAME is the name, VARIABLE is t if this is a `defvar',
-INTERACTIVE is nil if this is not an interactive function, otherwise
-it is the position of the `interactive' call, and PARAMETERS is a
-string which is the name of each variable in the function's argument
-list.  The NODOCPARAMS is a sublist of parameters specified by a checkdoc
-comment for a given defun.  If the first element is not a string, then
-the token checkdoc-order:  exists, and TOKEN is a symbol read
-from the comment."
-  (save-excursion
-    (beginning-of-defun)
-    (let ((defun (looking-at "(def\\(un\\|macro\\|subst\\|advice\\|method\\)"))
-	  (is-advice (looking-at "(defadvice"))
-	  (is-method (looking-at "(defmethod"))
-	  (lst nil)
-	  (ret nil)
-	  (oo (make-vector 3 0)))	;substitute obarray for `read'
-      (forward-char 1)
-      (forward-sexp 1)
-      (skip-chars-forward " \n\t")
-      (setq ret
-	    (list (buffer-substring-no-properties
-		   (point) (progn (forward-sexp 1) (point)))))
-      (if (not defun)
-	  (setq ret (cons t ret))
-	;; The variable spot
-	(setq ret (cons nil ret))
-	;; Interactive
-	(save-excursion
-	  (setq ret (cons
-		     (re-search-forward "(interactive"
-					(save-excursion (end-of-defun) (point))
-					t)
-		     ret)))
-	(skip-chars-forward " \t\n")
-	(let ((bss (buffer-substring (point) (save-excursion (forward-sexp 1)
-							     (point))))
-	      ;; Overload th main obarray so read doesn't intern the
-	      ;; local symbols of the function we are checking.
-	      ;; Without this we end up cluttering the symbol space w/
-	      ;; useless symbols.
-	      (obarray oo))
-	  (if (and (symbolp (read bss)) is-method)
-	      (save-excursion
-		(setq bss (buffer-substring (progn (forward-sexp 1) (point))
-					    (save-excursion (forward-sexp 1)
-							    (point))))))
-	  ;; Ok, check for checkdoc parameter comment here
-	  (save-excursion
-	    (setq ret
-		  (cons
-		   (let ((sl1 nil))
-		     (if (re-search-forward ";\\s-+checkdoc-order:\\s-+"
-					    (save-excursion (end-of-defun)
-							    (point))
-					    t)
-			 (setq sl1 (list (cond ((looking-at "nil") 'no)
-					       ((looking-at "t") 'yes)))))
-		     (if (re-search-forward ";\\s-+checkdoc-params:\\s-+"
-					    (save-excursion (end-of-defun)
-							    (point))
-					    t)
-			 (let ((sl nil))
-			   (goto-char (match-end 0))
-			   (condition-case nil
-			       (setq lst (read (current-buffer)))
-			     (error (setq lst nil))) ; error in text
-                           (if (not (listp lst)) ; not a list of args
-                               (setq lst (list lst)))
-			   (if (and lst (not (symbolp (car lst)))) ;weird arg
-			       (setq lst nil))
-			   (while lst
-			     (setq sl (cons (symbol-name (car lst)) sl)
-				   lst (cdr lst)))
-			   (setq sl1 (append sl1 sl))))
-		     sl1)
-		   ret)))
-	  ;; Read the list of parameters, but do not put the symbols in
-	  ;; the standard obarray.
-	  (setq lst (read bss)))
-	;; If we are in a method, the first argument is itself a list;
-	(if (and is-method (listp (car lst)))
-	    (setcar lst (car (car lst))))
-	;; This is because read will intern nil if it doesn't into the
-	;; new obarray.
-	(if (not (listp lst)) (setq lst nil))
-	(if is-advice nil
-	  (while lst
-	    (setq ret (cons (symbol-name (car lst)) ret)
-		  lst (cdr lst)))))
-      (nreverse ret))))
-
-(defun checkdoc-in-sample-code-p (start limit)
-  "Return non-nil if the current point is in a code fragment.
-A code fragment is identified by an open parenthesis followed by a
-symbol which is a valid function or a word in all CAPS, or a parenthesis
-that is quoted with the ' character.  Only the region from START to LIMIT
-is is allowed while searching for the bounding parenthesis."
-  (save-match-data
-    (save-restriction
-      (narrow-to-region start limit)
-      (save-excursion
-	(and (condition-case nil (progn (up-list 1) t) (error nil))
-	     (condition-case nil (progn (forward-list -1) t) (error nil))
-	     (or (save-excursion (forward-char -1) (looking-at "'("))
-		 (and (looking-at "(\\(\\(\\w\\|[-:_]\\)+\\)[ \t\n;]")
-		      (let ((ms (buffer-substring-no-properties
-				 (match-beginning 1) (match-end 1))))
-			;; if this string is function bound, we are in
-			;; sample code.  If it has a - or : character in
-			;; the name, then it is probably supposed to be bound
-			;; but isn't yet.
-			(or (fboundp (intern-soft ms))
-			    (let ((case-fold-search nil))
-			      (string-match "^[A-Z-]+$" ms))
-			    (string-match "\\w[-:_]+\\w" ms))))))))))
-
-(defun checkdoc-in-example-string-p (start limit)
-  "Return non-nil if the current point is in an \"example string\".
-This string is identified by the characters \\\" surrounding the text.
-The text checked is between START and LIMIT."
-  (save-match-data
-    (save-excursion
-      (let ((p (point))
-	    (c 0))
-	(goto-char start)
-	(while (and (< (point) p) (re-search-forward "\\\\\"" limit t))
-	  (setq c (1+ c)))
-	(and (< 0 c) (= (% c 2) 0))))))
-
-(defun checkdoc-proper-noun-region-engine (begin end)
-  "Check all text between BEGIN and END for lower case proper nouns.
-These are Emacs centric proper nouns which should be capitalized for
-consistency.  Return an error list if any are not fixed, but
-internally skip over no answers.
-If the offending word is in a piece of quoted text, then it is skipped."
-  (save-excursion
-    (let ((case-fold-search nil)
-	  (errtxt nil) bb be
-	  (old-syntax-table (syntax-table)))
-      (unwind-protect
-	  (progn
-	    (set-syntax-table checkdoc-syntax-table)
-	    (goto-char begin)
-	    (while (re-search-forward checkdoc-proper-noun-regexp end t)
-	      (let ((text (match-string 1))
-		    (b (match-beginning 1))
-		    (e (match-end 1)))
-		(if (and (not (save-excursion
-				(goto-char b)
-				(forward-char -1)
-				(looking-at "`\\|\"\\|\\.\\|\\\\")))
-			 ;; surrounded by /, as in a URL or filename: /emacs/
-			 (not (and (= ?/ (char-after e))
-				   (= ?/ (char-before b))))
-			 (not (checkdoc-in-example-string-p begin end)))
-		    (if (checkdoc-autofix-ask-replace
-			 b e (format "Text %s should be capitalized.  Fix? "
-				     text)
-			 (capitalize text) t)
-			nil
-		      (if errtxt
-			  ;; If there is already an error, then generate
-			  ;; the warning output if applicable
-			  (if checkdoc-generate-compile-warnings-flag
-			      (checkdoc-create-error
-			       (format
-				"Name %s should appear capitalized as %s"
-				text (capitalize text))
-			       b e))
-			(setq errtxt
-			      (format
-			       "Name %s should appear capitalized as %s"
-			       text (capitalize text))
-			      bb b be e)))))))
-	(set-syntax-table old-syntax-table))
-      (if errtxt (checkdoc-create-error errtxt bb be)))))
-
-(defun checkdoc-sentencespace-region-engine (begin end)
-  "Make sure all sentences have double spaces between BEGIN and END."
-  (if sentence-end-double-space
-      (save-excursion
-	(let ((case-fold-search nil)
-	      (errtxt nil) bb be
-	      (old-syntax-table (syntax-table)))
-	  (unwind-protect
-	      (progn
-		(set-syntax-table checkdoc-syntax-table)
-		(goto-char begin)
-		(while (re-search-forward "[^.0-9]\\(\\. \\)[^ \n]" end t)
-		  (let ((b (match-beginning 1))
-			(e (match-end 1)))
-		    (if (and (not (checkdoc-in-sample-code-p begin end))
-			     (not (checkdoc-in-example-string-p begin end))
-			     (not (save-excursion
-				    (goto-char (match-beginning 1))
-				    (condition-case nil
-					(progn
-					  (forward-sexp -1)
-					  ;; piece of an abbreviation
-					  (looking-at
-					   "\\([a-z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\."))
-				      (error t)))))
-			(if (checkdoc-autofix-ask-replace
-			     b e
-			     "There should be two spaces after a period.  Fix? "
-			     ".  ")
-			    nil
-			  (if errtxt
-			      ;; If there is already an error, then generate
-			      ;; the warning output if applicable
-			      (if checkdoc-generate-compile-warnings-flag
-				  (checkdoc-create-error
-				   "There should be two spaces after a period"
-				   b e))
-			    (setq errtxt
-				  "There should be two spaces after a period"
-				  bb b be e)))))))
-	    (set-syntax-table old-syntax-table))
-	  (if errtxt (checkdoc-create-error errtxt bb be))))))
-
-;;; Ispell engine
-;;
-(eval-when-compile (require 'ispell))
-
-(defun checkdoc-ispell-init ()
-  "Initialize Ispell process (default version) with Lisp words.
-The words used are from `checkdoc-ispell-lisp-words'.  If `ispell'
-cannot be loaded, then set `checkdoc-spellcheck-documentation-flag' to
-nil."
-  (require 'ispell)
-  (if (not (symbol-value 'ispell-process)) ;Silence byteCompiler
-      (condition-case nil
-	  (progn
-	    (ispell-buffer-local-words)
-	    ;; This code copied in part from ispell.el Emacs 19.34
-	    (let ((w checkdoc-ispell-lisp-words))
-	      (while w
-		(process-send-string
-		 ;;  Silence byte compiler
-		 (symbol-value 'ispell-process)
-		 (concat "@" (car w) "\n"))
-		(setq w (cdr w)))))
-	(error (setq checkdoc-spellcheck-documentation-flag nil)))))
-
-(defun checkdoc-ispell-docstring-engine (end)
-  "Run the Ispell tools on the doc string between point and END.
-Since Ispell isn't Lisp-smart, we must pre-process the doc string
-before using the Ispell engine on it."
-  (if (or (not checkdoc-spellcheck-documentation-flag)
-	  ;; If the user wants no questions or fixing, then we must
-	  ;; disable spell checking as not useful.
-	  (not checkdoc-autofix-flag)
-	  (eq checkdoc-autofix-flag 'never))
-      nil
-    (checkdoc-ispell-init)
-    (save-excursion
-      (skip-chars-forward "^a-zA-Z")
-      (let ((word nil) (sym nil) (case-fold-search nil) (err nil))
-	(while (and (not err) (< (point) end))
-	  (if (save-excursion (forward-char -1) (looking-at "[('`]"))
-	      ;; Skip lists describing meta-syntax, or bound variables
-	      (forward-sexp 1)
-	    (setq word (buffer-substring-no-properties
-			(point) (progn
-				  (skip-chars-forward "a-zA-Z-")
-				  (point)))
-		  sym (intern-soft word))
-	    (if (and sym (or (boundp sym) (fboundp sym)))
-		;; This is probably repetitive in most cases, but not always.
-		nil
-	      ;; Find out how we spell-check this word.
-	      (if (or
-		   ;; All caps w/ option th, or s tacked on the end
-		   ;; for pluralization or numberthness.
-		   (string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word)
-		   (looking-at "}") ; a keymap expression
-		   )
-		  nil
-		(save-excursion
-		  (if (not (eq checkdoc-autofix-flag 'never))
-		      (let ((lk last-input-event))
-			(ispell-word nil t)
-			(if (not (equal last-input-event lk))
-			    (progn
-			      (sit-for 0)
-			      (message "Continuing..."))))
-		    ;; Nothing here.
-		    )))))
-	  (skip-chars-forward "^a-zA-Z"))
-	err))))
-
-;;; Rogue space checking engine
-;;
-(defun checkdoc-rogue-space-check-engine (&optional start end interact)
-  "Return a message list if there is a line with white space at the end.
-If `checkdoc-autofix-flag' permits, delete that whitespace instead.
-If optional arguments START and END are non nil, bound the check to
-this region.
-Optional argument INTERACT may permit the user to fix problems on the fly."
-  (let ((p (point))
-	(msg nil) s e (f nil))
-    (if (not start) (setq start (point-min)))
-    ;; If end is nil, it means end of buffer to search anyway
-    (or
-     ;; Check for an error if `? ' or `?\ ' is used at the end of a line.
-     ;; (It's dangerous)
-     (progn
-       (goto-char start)
-       (while (and (not msg) (re-search-forward "\\?\\\\?[ \t][ \t]*$" end t))
-	 (setq msg
-	       "Don't use `? ' at the end of a line. \
-News agents may remove it"
-	       s (match-beginning 0) e (match-end 0) f t)
-	 ;; If interactive is passed down, give them a chance to fix things.
-	 (if (and interact (y-or-n-p (concat msg ". Fix? ")))
-	     (progn
-	       (checkdoc-recursive-edit msg)
-	       (setq msg nil)
-	       (goto-char s)
-	       (beginning-of-line)))))
-     ;; Check for, and potentially remove whitespace appearing at the
-     ;; end of different lines.
-     (progn
-       (goto-char start)
-       ;; There is no documentation in the Emacs Lisp manual about this check,
-       ;; it is intended to help clean up messy code and reduce the file size.
-       (while (and (not msg) (re-search-forward "[^ \t\n;]\\([ \t]+\\)$" end t))
-	 ;; This is not a complex activity
-	 (if (checkdoc-autofix-ask-replace
-	      (match-beginning 1) (match-end 1)
-	      "White space at end of line.  Remove? " "")
-	     nil
-	   (setq msg "White space found at end of line"
-		 s (match-beginning 1) e (match-end 1))))))
-    ;; Return an error and leave the cursor at that spot, or restore
-    ;; the cursor.
-    (if msg
-	(checkdoc-create-error msg s e f)
-      (goto-char p)
-      nil)))
-
-;;; Comment checking engine
-;;
-(eval-when-compile
-  ;; We must load this to:
-  ;; a) get symbols for compile and
-  ;; b) determine if we have lm-history symbol which doesn't always exist
-  (require 'lisp-mnt))
-
-(defun checkdoc-file-comments-engine ()
-  "Return a message list if this file does not match the Emacs standard.
-This checks for style only, such as the first line, Commentary:,
-Code:, and others referenced in the style guide."
-  (if (featurep 'lisp-mnt)
-      nil
-    (require 'lisp-mnt)
-    ;; Old XEmacs don't have `lm-commentary-mark'
-    (if (and (not (fboundp 'lm-commentary-mark)) (boundp 'lm-commentary))
-	(defalias 'lm-commentary-mark 'lm-commentary)))
-  (save-excursion
-    (let* ((f1 (file-name-nondirectory (buffer-file-name)))
-	   (fn (file-name-sans-extension f1))
-	   (fe (substring f1 (length fn)))
-	   (err nil))
-      (goto-char (point-min))
-      ;; This file has been set up where ERR is a variable.  Each check is
-      ;; asked, and the function will make sure that if the user does not
-      ;; auto-fix some error, that we still move on to the next auto-fix,
-      ;; AND we remember the past errors.
-      (setq
-       err
-       ;; Lisp Maintenance checks first
-       ;; Was: (lm-verify) -> not flexible enough for some people
-       ;; * Summary at the beginning of the file:
-       (if (not (lm-summary))
-	   ;; This certifies as very complex so always ask unless
-	   ;; it's set to never
-	   (if (checkdoc-y-or-n-p "There is no first line summary!  Add one? ")
-	       (progn
-		 (goto-char (point-min))
-		 (insert ";;; " fn fe " --- " (read-string "Summary: ") "\n"))
-	     (checkdoc-create-error
-	      "The first line should be of the form: \";;; package --- Summary\""
-	      (point-min) (save-excursion (goto-char (point-min)) (end-of-line)
-					  (point))))
-	 nil))
-      (setq
-       err
-       (or
-	;; * Commentary Section
-	(if (not (lm-commentary-mark))
-	    (progn
-	      (goto-char (point-min))
-	      (cond
-	       ((re-search-forward
-		 "write\\s-+to\\s-+the\\s-+Free Software Foundation, Inc."
-		 nil t)
-		(re-search-forward "^;;\\s-*\n\\|^\n" nil t))
-	       ((or (re-search-forward "^;;; History" nil t)
-		    (re-search-forward "^;;; Code" nil t)
-		    (re-search-forward "^(require" nil t)
-		    (re-search-forward "^("))
-		(beginning-of-line)))
-	      (if (checkdoc-y-or-n-p
-		   "You should have a \";;; Commentary:\", add one? ")
-		  (insert "\n;;; Commentary:\n;; \n\n")
-		(checkdoc-create-error
-		 "You should have a section marked \";;; Commentary:\""
-		 nil nil t)))
-	  nil)
-	err))
-      (setq
-       err
-       (or
-	;; * History section.  Say nothing if there is a file ChangeLog
-	(if (or (not checkdoc-force-history-flag)
-		(file-exists-p "ChangeLog")
-		(file-exists-p "../ChangeLog")
-		(and (boundp 'change-log-default-name)
-		     (file-exists-p change-log-default-name))
-		(let ((fn 'lm-history-mark)) ;bestill byte-compiler
-		  (and (fboundp fn) (funcall fn))))
-	    nil
-	  (progn
-	    (goto-char (or (lm-commentary-mark) (point-min)))
-	    (cond
-	     ((re-search-forward
-	       "write\\s-+to\\s-+the\\s-+Free Software Foundation, Inc."
-	       nil t)
-	      (re-search-forward "^;;\\s-*\n\\|^\n" nil t))
-	     ((or (re-search-forward "^;;; Code" nil t)
-		  (re-search-forward "^(require" nil t)
-		  (re-search-forward "^("))
-	      (beginning-of-line)))
-	    (if (checkdoc-y-or-n-p
-		 "You should have a \";;; History:\", add one? ")
-		(insert "\n;;; History:\n;; \n\n")
-	      (checkdoc-create-error
-	       "You should have a section marked \";;; History:\" or use a ChangeLog"
-	       (point) nil))))
-	err))
-      (setq
-       err
-       (or
-	;; * Code section
-	(if (not (lm-code-mark))
-	    (let ((cont t))
-	      (goto-char (point-min))
-	      (while (and cont (re-search-forward "^(" nil t))
-		(setq cont (looking-at "require\\s-+")))
-	      (if (and (not cont)
-		       (checkdoc-y-or-n-p
-			"There is no ;;; Code: marker.  Insert one? "))
-		  (progn (beginning-of-line)
-			 (insert ";;; Code:\n")
-			 nil)
-		(checkdoc-create-error
-		 "You should have a section marked \";;; Code:\""
-		 (point) nil)))
-	  nil)
-	err))
-      (setq
-       err
-       (or
-	;; * A footer.  Not compartmentalized from lm-verify: too bad.
-	;;              The following is partially clipped from lm-verify
-	(save-excursion
-	  (goto-char (point-max))
-	  (if (not (re-search-backward
-		    (concat "^;;;[ \t]+" fn "\\(" (regexp-quote fe)
-			    "\\)?[ \t]+ends here[ \t]*$"
-			    "\\|^;;;[ \t]+ End of file[ \t]+"
-			    fn "\\(" (regexp-quote fe) "\\)?")
-		    nil t))
-	      (if (checkdoc-y-or-n-p "No identifiable footer!  Add one? ")
-		  (progn
-		    (goto-char (point-max))
-		    (insert "\n(provide '" fn ")\n\n;;; " fn fe " ends here\n"))
-		(checkdoc-create-error
-		 (format "The footer should be: (provide '%s)\\n;;; %s%s ends here"
-			 fn fn fe)
-		 (1- (point-max)) (point-max)))))
-	err))
-      ;; The below checks will not return errors if the user says NO
-      
-      ;; Ok, now let's look for multiple occurrences of ;;;, and offer
-      ;; to remove the extra ";" if applicable.  This pre-supposes
-      ;; that the user has semiautomatic fixing on to be useful.
-      
-      ;; In the info node (elisp)Library Headers a header is three ;
-      ;; (the header) followed by text of only two ;
-      ;; In (elisp)Comment Tips, however it says this:
-      ;; * Another use for triple-semicolon comments is for commenting out
-      ;;   lines within a function.  We use triple-semicolons for this
-      ;;   precisely so that they remain at the left margin.
-      (let ((msg nil))
-	(goto-char (point-min))
-	(while (and checkdoc-triple-semi-comment-check-flag
-		    (not msg) (re-search-forward "^;;;[^;]" nil t))
-	  ;; We found a triple, let's check all following lines.
-	  (if (not (bolp)) (progn (beginning-of-line) (forward-line 1)))
-	  (let ((complex-replace t)
-		(dont-replace nil))
-	    (while (looking-at ";;\\(;\\)[^;#]")
-	      (if (and (not dont-replace)
-		       (checkdoc-outside-major-sexp) ;in code is ok.
-		       (checkdoc-autofix-ask-replace
-			(match-beginning 1) (match-end 1)
-			"Multiple occurrences of ;;; found.  Use ;; instead? "
-			"" complex-replace))
-		  ;; Learn that, yea, the user did want to do this a
-		  ;; whole bunch of times.
-		  (setq complex-replace nil)
-		;; In this case, skip all this crap
-		(setq dont-replace t))
-	      (beginning-of-line)
-	      (forward-line 1)))))
-
-      ;; Let's spellcheck the commentary section.  This is the only
-      ;; section that is easy to pick out, and it is also the most
-      ;; visible section (with the finder).
-      (let ((cm (lm-commentary-mark)))
-	(if cm
-	    (save-excursion
-	      (goto-char (lm-commentary-mark))
-	      ;; Spellcheck between the commentary, and the first
-	      ;; non-comment line.  We could use lm-commentary, but that
-	      ;; returns a string, and Ispell wants to talk to a buffer.
-	      ;; Since the comments talk about Lisp, use the specialized
-	      ;; spell-checker we also used for doc strings.
-	      (let ((e (save-excursion (re-search-forward "^[^;]" nil t)
-				       (point))))
-		(checkdoc-sentencespace-region-engine (point) e)
-		(checkdoc-proper-noun-region-engine (point) e)
-		(checkdoc-ispell-docstring-engine e)))))
-;;; test comment out code
-;;;       (foo 1 3)
-;;;       (bar 5 7)
-      (setq
-       err
-       (or
-	;; Generic Full-file checks (should be comment related)
-	(checkdoc-run-hooks 'checkdoc-comment-style-hooks)
-	err))
-      ;; Done with full file comment checks
-      err)))
-
-(defun checkdoc-outside-major-sexp ()
-  "Return t if point is outside the bounds of a valid sexp."
-  (save-match-data
-    (save-excursion
-      (let ((p (point)))
-	(or (progn (beginning-of-defun) (bobp))
-	    (progn (end-of-defun) (< (point) p)))))))
-
-;;; `error' and `message' text verifier.
-;;
-(defun checkdoc-message-text-search (&optional beg end)
-  "Search between BEG and END for a style error with message text.
-Optional arguments BEG and END represent the boundary of the check.
-The default boundary is the entire buffer."
-  (let ((e nil)
-	(type nil))
-    (if (not (or beg end)) (setq beg (point-min) end (point-max)))
-    (goto-char beg)
-    (while (setq type (checkdoc-message-text-next-string end))
-      (setq e (checkdoc-message-text-engine type)))
-    e))
-  
-(defun checkdoc-message-text-next-string (end)
-  "Move cursor to the next checkable message string after point.
-Return the message classification.
-Argument END is the maximum bounds to search in."
-  (let ((return nil))
-    (while (and (not return)
-		(re-search-forward
-		 "(\\s-*\\(\\(\\w\\|\\s_\\)*error\\|\
-\\(\\w\\|\\s_\\)*y-or-n-p\\(-with-timeout\\)?\
-\\|checkdoc-autofix-ask-replace\\)[ \t\n]+" end t))
-      (let* ((fn (match-string 1))
-	     (type (cond ((string-match "error" fn)
-			  'error)
-			 (t 'y-or-n-p))))
-	(if (string-match "checkdoc-autofix-ask-replace" fn)
-	    (progn (forward-sexp 2)
-		   (skip-chars-forward " \t\n")))
-	(if (and (eq type 'y-or-n-p)
-		 (looking-at "(format[ \t\n]+"))
-	    (goto-char (match-end 0)))
-	(skip-chars-forward " \t\n")
-	(if (not (looking-at "\""))
-	    nil
-	  (setq return type))))
-    return))
-
-(defun checkdoc-message-text-engine (&optional type)
-  "Return or fix errors found in strings passed to a message display function.
-According to the documentation for the function `error', the error list
-should not end with a period, and should start with a capital letter.
-The function `y-or-n-p' has similar constraints.
-Argument TYPE specifies the type of question, such as `error or `y-or-n-p."
-  ;; If type is nil, then attempt to derive it.
-  (if (not type)
-      (save-excursion
-	(up-list -1)
-	(if (looking-at "(format")
-	    (up-list -1))
-	(setq type
-	      (cond ((looking-at "(error")
-		     'error)
-		    (t 'y-or-n-p)))))
-  (let ((case-fold-search nil))
-    (or
-     ;; From the documentation of the symbol `error':
-     ;; In Emacs, the convention is that error messages start with a capital
-     ;; letter but *do not* end with a period.  Please follow this convention
-     ;; for the sake of consistency.
-     (if (and (save-excursion (forward-char 1)
-			      (looking-at "[a-z]\\w+"))
-	      (not (checkdoc-autofix-ask-replace
-		    (match-beginning 0) (match-end 0)
-		    "Capitalize your message text? "
-		    (capitalize (match-string 0))
-		    t)))
-	 (checkdoc-create-error
-	  "Messages should start with a capital letter"
-	  (match-beginning 0) (match-end 0))
-       nil)
-     ;; In general, sentences should have two spaces after the period.
-     (checkdoc-sentencespace-region-engine (point)
-					   (save-excursion (forward-sexp 1)
-							   (point)))
-     ;; Look for proper nouns in this region too.
-     (checkdoc-proper-noun-region-engine (point)
-					 (save-excursion (forward-sexp 1)
-							 (point)))
-     ;; Here are message type specific questions.
-     (if (and (eq type 'error)
-	      (save-excursion (forward-sexp 1)
-			      (forward-char -2)
-			      (looking-at "\\."))
-	      (not (checkdoc-autofix-ask-replace (match-beginning 0)
-						 (match-end 0)
-						 "Remove period from error? "
-						 ""
-						 t)))
-	 (checkdoc-create-error
-	  "Error messages should *not* end with a period"
-	  (match-beginning 0) (match-end 0))
-       nil)
-     ;; `y-or-n-p' documentation explicitly says:
-     ;; It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
-     ;; I added the ? requirement.  Without it, it is unclear that we
-     ;; ask a question and it appears to be an undocumented style.
-     (if (eq type 'y-or-n-p)
-	 (if (not (save-excursion (forward-sexp 1)
-				  (forward-char -3)
-				  (not (looking-at "\\? "))))
-	     nil
-	   (if (save-excursion (forward-sexp 1)
-			       (forward-char -2)
-			       (looking-at "\\?"))
-	       ;; If we see a ?, then replace with "? ".
-	       (if (checkdoc-autofix-ask-replace
-		    (match-beginning 0) (match-end 0)
-		    "`y-or-n-p' argument should end with \"? \".  Fix? "
-		    "? " t)
-		   nil
-		 (checkdoc-create-error
-		  "`y-or-n-p' argument should end with \"? \""
-		  (match-beginning 0) (match-end 0)))
-	     (if (save-excursion (forward-sexp 1)
-				 (forward-char -2)
-				 (looking-at " "))
-		 (if (checkdoc-autofix-ask-replace
-		      (match-beginning 0) (match-end 0)
-		      "`y-or-n-p' argument should end with \"? \".  Fix? "
-		      "? " t)
-		     nil
-		   (checkdoc-create-error
-		    "`y-or-n-p' argument should end with \"? \""
-		    (match-beginning 0) (match-end 0)))
-	       (if (and ;; if this isn't true, we have a problem.
-		    (save-excursion (forward-sexp 1)
-				    (forward-char -1)
-				    (looking-at "\""))
-		    (checkdoc-autofix-ask-replace
-		     (match-beginning 0) (match-end 0)
-		     "`y-or-n-p' argument should end with \"? \".  Fix? "
-		     "? \"" t))
-		   nil
-		 (checkdoc-create-error
-		  "`y-or-n-p' argument should end with \"? \""
-		  (match-beginning 0) (match-end 0)))))))
-     ;; Now, let's just run the spell checker on this guy.
-     (checkdoc-ispell-docstring-engine (save-excursion (forward-sexp 1)
-						       (point)))
-     )))
-
-;;; Auto-fix helper functions
-;;
-(defun checkdoc-y-or-n-p (question)
-  "Like `y-or-n-p', but pays attention to `checkdoc-autofix-flag'.
-Argument QUESTION is the prompt passed to `y-or-n-p'."
-  (prog1
-      (if (or (not checkdoc-autofix-flag)
-	      (eq checkdoc-autofix-flag 'never))
-	  nil
-	(y-or-n-p question))
-    (if (eq checkdoc-autofix-flag 'automatic-then-never)
-	(setq checkdoc-autofix-flag 'never))))
-
-(defun checkdoc-autofix-ask-replace (start end question replacewith
-					   &optional complex)
-  "Highlight between START and END and queries the user with QUESTION.
-If the user says yes, or if `checkdoc-autofix-flag' permits, replace
-the region marked by START and END with REPLACEWITH.  If optional flag
-COMPLEX is non-nil, then we may ask the user a question.  See the
-documentation for `checkdoc-autofix-flag' for details.
-
-If a section is auto-replaced without asking the user, this function
-will pause near the fixed code so the user will briefly see what
-happened.
-
-This function returns non-nil if the text was replaced.
-
-This function will not modify `match-data'."
-  (if (and checkdoc-autofix-flag
-	   (not (eq checkdoc-autofix-flag 'never)))
-      (let ((o (checkdoc-make-overlay start end))
-	    (ret nil)
-	    (md (match-data)))
-	(unwind-protect
-	    (progn
-	      (checkdoc-overlay-put o 'face 'highlight)
-	      (if (or (eq checkdoc-autofix-flag 'automatic)
-		      (eq checkdoc-autofix-flag 'automatic-then-never)
-		      (and (eq checkdoc-autofix-flag 'semiautomatic)
-			   (not complex))
-		      (and (or (eq checkdoc-autofix-flag 'query) complex)
-			   (y-or-n-p question)))
-		  (save-excursion
-		    (goto-char start)
-		    ;; On the off chance this is automatic, display
-		    ;; the question anyway so the user knows what's
-		    ;; going on.
-		    (if checkdoc-bouncy-flag (message "%s -> done" question))
-		    (delete-region start end)
-		    (insert replacewith)
-		    (if checkdoc-bouncy-flag (sit-for 0))
-		    (setq ret t)))
-	      (checkdoc-delete-overlay o)
-	      (set-match-data md))
-	  (checkdoc-delete-overlay o)
-	  (set-match-data md))
-	(if (eq checkdoc-autofix-flag 'automatic-then-never)
-	    (setq checkdoc-autofix-flag 'never))
-	ret)))
-
-;;; Warning management
-;;
-(defvar checkdoc-output-font-lock-keywords
-  '(("\\(\\w+\\.el\\): \\(\\w+\\)"
-     (1 font-lock-function-name-face)
-     (2 font-lock-comment-face))
-    ("^\\(\\w+\\.el\\):" 1 font-lock-function-name-face)
-    (":\\([0-9]+\\):" 1 font-lock-constant-face))
-  "Keywords used to highlight a checkdoc diagnostic buffer.")
-
-(defvar checkdoc-output-mode-map nil
-  "Keymap used in `checkdoc-output-mode'.")
-
-(defvar checkdoc-pending-errors nil
-  "Non-nil when there are errors that have not been displayed yet.")
-
-(if checkdoc-output-mode-map
-    nil
-  (setq checkdoc-output-mode-map (make-sparse-keymap))
-  (if (not checkdoc-xemacs-p)
-      (define-key checkdoc-output-mode-map [mouse-2]
-	'checkdoc-find-error-mouse))
-  (define-key checkdoc-output-mode-map "\C-c\C-c" 'checkdoc-find-error)
-  (define-key checkdoc-output-mode-map "\C-m" 'checkdoc-find-error))
-
-(defun checkdoc-output-mode ()
-  "Create and setup the buffer used to maintain checkdoc warnings.
-\\\\[checkdoc-find-error]  - Go to this error location
-\\[checkdoc-find-error-mouse] - Goto the error clicked on."
-  (if (get-buffer checkdoc-diagnostic-buffer)
-      (get-buffer checkdoc-diagnostic-buffer)
-    (save-excursion
-      (set-buffer (get-buffer-create checkdoc-diagnostic-buffer))
-      (kill-all-local-variables)
-      (setq mode-name "Checkdoc"
-	    major-mode 'checkdoc-output-mode)
-      (set (make-local-variable 'font-lock-defaults)
-	   '((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w"))))
-      (use-local-map checkdoc-output-mode-map)
-      (run-hooks 'checkdoc-output-mode-hook)
-      (current-buffer))))
-
-(defun checkdoc-find-error-mouse (e)
-  ;; checkdoc-params: (e)
-  "Call `checkdoc-find-error' where the user clicks the mouse."
-  (interactive "e")
-  (mouse-set-point e)
-  (checkdoc-find-error))
-
-(defun checkdoc-find-error ()
-  "In a checkdoc diagnostic buffer, find the error under point."
-  (interactive)
-  (beginning-of-line)
-  (if (looking-at "#:\\([0-9]+\\):")
-      (let ((l (string-to-int (match-string 3)))
-	    (f (match-string 1)))
-	(if (not (get-buffer f))
-	    (error "Can't find buffer %s" f))
-	(switch-to-buffer-other-window (get-buffer f))
-	(goto-line l))))
-
-(defun checkdoc-buffer-label ()
-  "The name to use for a checkdoc buffer in the error list."
-  (if (buffer-file-name)
-      (file-name-nondirectory (buffer-file-name))
-    (concat "#")))
-
-(defun checkdoc-start-section (check-type)
-  "Initialize the checkdoc diagnostic buffer for a pass.
-Create the header so that the string CHECK-TYPE is displayed as the
-function called to create the messages."
-  (checkdoc-output-to-error-buffer
-   "\n\n\C-l\n*** "
-   (checkdoc-buffer-label) ": " check-type " V " checkdoc-version))
-
-(defun checkdoc-error (point msg)
-  "Store POINT and MSG as errors in the checkdoc diagnostic buffer."
-  (setq checkdoc-pending-errors t)
-  (checkdoc-output-to-error-buffer
-   "\n" (checkdoc-buffer-label) ":"
-   (int-to-string (count-lines (point-min) (or point 1))) ": "
-   msg))
-
-(defun checkdoc-output-to-error-buffer (&rest text)
-  "Place TEXT into the checkdoc diagnostic buffer."
-  (save-excursion
-    (set-buffer (checkdoc-output-mode))
-    (goto-char (point-max))
-    (apply 'insert text)))
-
-(defun checkdoc-show-diagnostics ()
-  "Display the checkdoc diagnostic buffer in a temporary window."
-  (if checkdoc-pending-errors
-      (let ((b (get-buffer checkdoc-diagnostic-buffer)))
-	(if b (progn (pop-to-buffer b)
-		     (goto-char (point-max))
-		     (re-search-backward "\C-l" nil t)
-		     (beginning-of-line)
-		     (forward-line 1)
-		     (recenter 0)))
-	(other-window -1)
-	(setq checkdoc-pending-errors nil)
-	nil)))
-
-(defgroup checkdoc nil
-  "Support for doc string checking in Emacs Lisp."
-  :prefix "checkdoc"
-  :group 'lisp
-;  :version "20.3"
-  )
-
-(custom-add-option 'emacs-lisp-mode-hook
-		   (lambda () (checkdoc-minor-mode 1)))
-
-(provide 'checkdoc)
-
-;;; checkdoc.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/custom-load.el b/xemacs-packages/lisp/xemacs-devel/custom-load.el
deleted file mode 100644
index f7a3670c..00000000
--- a/xemacs-packages/lisp/xemacs-devel/custom-load.el
+++ /dev/null
@@ -1,24 +0,0 @@
-;;; custom-load.el --- automatically extracted custom dependencies
-
-;;; Code:
-
-(autoload 'custom-add-loads "cus-load")
-
-(custom-add-loads 'extensions '("eldoc"))
-(custom-add-loads 'eldoc '("eldoc"))
-(custom-add-loads 'ielm '("ielm"))
-(custom-add-loads 'hide-copyleft '("hide-copyleft"))
-(custom-add-loads 'mail '("patch-keywords"))
-(custom-add-loads 'lisp '("checkdoc" "elp" "find-func" "ielm"))
-(custom-add-loads 'elp '("elp"))
-(custom-add-loads 'patcher-default '("patcher"))
-(custom-add-loads 'checkdoc '("checkdoc"))
-(custom-add-loads 'patcher '("patcher"))
-(custom-add-loads 'find-function '("find-func"))
-(custom-add-loads 'patcher-mail '("patcher"))
-(custom-add-loads 'patcher-projects '("patcher"))
-(custom-add-loads 'patcher-themes '("patcher"))
-(custom-add-loads 'matching '("hide-copyleft"))
-(custom-add-loads 'patch-review '("patch-keywords"))
-
-;;; custom-load.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/docref.el b/xemacs-packages/lisp/xemacs-devel/docref.el
deleted file mode 100644
index d5f4a670..00000000
--- a/xemacs-packages/lisp/xemacs-devel/docref.el
+++ /dev/null
@@ -1,287 +0,0 @@
-;;; docref.el --- Simple cross references for Elisp documentation strings
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Vadim Geshel 
-;; Created: 12 Jul 1994
-;; Keywords: docs, help, lisp
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; #### It's not clear we really wish to keep this one around.
-
-;; original name was cross-ref.el.
-
-;; This package allows you to use a simple form of cross references in
-;; your Emacs Lisp documentation strings. Cross-references look like
-;; \\(type@[label@]data), where type defines a method for retrieving
-;; reference informatin, data is used by a method routine as an argument,
-;; and label "represents" the reference in text. If label is absent, data
-;; is used instead.
-;; 
-;; Special reference labeled `back', when present, can be used to return
-;; to the previous contents of help buffer.
-;;
-;; Cross-referencing currently is intended for use in doc strings only
-;; and works only in temporary buffers (created by `with-output-to-temp-buffer').
-;; List of temp buffers in which cross-referencing is to be active is specified
-;; by variable DOCREF-BUFFERS-LIST, which contains only "*Help*" by default.
-;;
-;; Documentation strings for this package's functions and variables can serve
-;; as examples of usage.
-;;
-;;; Customization:
-;; 
-;; See source. The main customization variable is `docref-methods-alist'.
-;; It consists of (type . function) pairs, where type is a string which
-;; corresponds to type in cross-references and function is called with
-;; one argument - reference `data' - when a reference is activated.
-;;
-;;; Installation:
-;;
-;; Place this file somewhere in your load-path, byte-compiled it, and add
-;; (require 'cross-ref)
-;; to your .emacs.
-
-;;; Code:
-
-;; User customizable variables
-
-(defvar docref-highlight-p t
-  "*If non-nil, \\(f@docref-subst) highlights cross-references.
-Under window system it highlights them with face defined by
-\\(v@docref-highlight-face), on character terminal highlighted references
-look like cross-references in info mode.")
-
-(defvar docref-highlight-face 'highlight
-  "*Face used to highlight cross-references (used by \\(f@docref-subst))")
-
-(defvar docref-methods-alist
-  '(("f" . docref-describe-function)	; reference to a function documentation
-    ("v" . docref-describe-variable)	; reference to a variable documentation
-    ("F" . docref-read-file)		; reference to a file contents
-    ("s" . docref-use-string)		; reference to a string 
-    ("V" . docref-use-variable-value)	; reference to variable value
-    ("0" . beep))			; just highlighted text
-  "Alist which maps cross-reference ``types'' to retrieval functions.
-
-The car of each element is a string that serves as `type' in cross-references.
-\(See \\(f@docref-subst)).  The cdr is a function of one argument,
-to be called to find this reference.")
-
-(defvar docref-back-label "\nback"
-  "Label to use by \\(f@docref-subst) for the go-back reference.")
-
-(defvar docref-back-reference nil
-  "If non-nil, this is a go-back reference to add to the current buffer.
-The value specifies how to go back.  It should be suitable for use
-as the second argument to \\(f@docref-insert-label).
-\\(f@docref-subst) uses this to set up the go-back reference.")
-
-(defvar docref-last-active-buffer)
-
-;;;###autoload
-(defun docref-setup ()
-  "Process docref cross-references in the current buffer.
-See also \\(f@docref-subst)."
-  (interactive)
-  (docref-subst (current-buffer))
-  (docref-mode))
-
-(defvar docref-mode-map nil)
-(or docref-mode-map
-    (let ((map (make-sparse-keymap)))
-      (define-key map [mouse-2] 'docref-follow-mouse)
-      (define-key map "\C-c\C-b" 'docref-go-back)
-      (define-key map "\C-c\C-c" 'docref-follow)
-      (setq docref-mode-map map)))
-
-(defun docref-mode ()
-  "Major mode for help buffers that contain cross references.
-To follow a reference, move to it and type \\[docref-follow], or use
-\\[docref-follow-mouse].  The command \\[docref-go-back] can used to go
-back to where you came from."
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'docref-mode)
-  (setq mode-name "Docref")
-  (use-local-map docref-mode-map)
-  (run-hooks 'docref-mode-hook))
-
-(defun docref-subst (buf)
-  "Parse documentation cross-references in buffer BUF.
-
-Find cross-reference information in a buffer and
-highlight them with face defined by \\(v@docref-highlight-face).
-
-Cross-reference has the following format: \\ (TYPE[@LABEL]@DATA), where
-TYPE defines method used to retrieve xref data (like reading from file or
-calling \\(f@describe-function)), DATA is an argument to this method
-\(like file name or function name), and LABEL is displayed in text using
-\\(v@docref-highlight-face).
-
-The special reference `back' can be used to return back.
-The variable \\(v@docref-back-label) specifies the label to use for that.
-
-See \\(v@docref-methods-alist) for currently defined methods."
-  (interactive "b")
-  (save-excursion
-    (set-buffer buf)
-    (goto-char (point-min))
-    ;; The docref-seen property indicates that we have processed this
-    ;; buffer's contents already, so don't do it again.
-    (if (not (get-text-property (point-min) 'docref-seen))
-	(let ((old-modified (buffer-modified-p)))
-	  (while (re-search-forward "[\\](\\([^\)\@]+\\)\\(@[^\)\@]+\\)?@\\([^\)]*\\))"
-				    nil t)
-	    (let* ((start (match-beginning 0))
-		   (type (buffer-substring (match-beginning 1) (match-end 1)))
-		   (data (buffer-substring (match-beginning 3) (match-end 3)))
-		   (label
-		    (if (match-beginning 2)
-			(buffer-substring (+ (match-beginning 2) 1) (match-end 2))
-		      data)))
-	      (replace-match "" t)
-	      (docref-insert-label label (cons type data))))
-
-	  ;; Make a back-reference in this buffer, if desired.
-	  ;; (This is true if called from docref-follow.)
-	  (if docref-back-reference
-	      (progn
-		(goto-char (point-max))
-		(put-text-property (point-min) (1+ (point-min))
-				   'docref-back-position (point))
-		(docref-insert-label docref-back-label docref-back-reference)))
-	  (put-text-property (point-min) (1+ (point-min)) 'docref-seen t)
-	  (set-buffer-modified-p old-modified)))))
-
-(defun docref-insert-label (string ref)
-  (let ((label (concat string))
-	(pos (point)))
-    ;; decorate the label
-    (let ((leading-space-end (save-match-data
-			       (if (string-match "^\\([ \t\n]+\\)" label)
-				   (match-end 1)
-				 0)))
-	  (trailing-space-start (save-match-data
-				  (if (string-match "\\([ \t\n]+\\)$" label)
-				      (match-beginning 1)
-				    (length label)))))
-      (if docref-highlight-p	      
-;;	  XEmacs: we support faces on TTY's.
-;;	  (if (not window-system)
-;;	      (setq label
-;;		    (concat (substring label 0 leading-space-end)
-;;			    "(*note "
-;;			    (substring label leading-space-end trailing-space-start)
-;;			    ")"
-;;			    (substring label trailing-space-start)))
-	    ;; window-system
-	    (put-text-property leading-space-end
-			       trailing-space-start
-			       'face docref-highlight-face label))
-      (put-text-property 0 (length label) 'docref ref label)
-      (insert label))))
-
-(defun docref-follow-mouse (click)
-  "Follow the cross-reference that you click on."
-  (interactive "e")
-  (save-excursion
-    ;; XEmacs changes here.
-    (let* ((window (event-window click))
-	   (pos (event-point click))
-	   (docref-last-active-buffer (current-buffer)))
-      (set-buffer (window-buffer window))
-      (docref-follow pos))))
-
-(defun docref-go-back ()
-  "Go back to the previous contents of help buffer."
-  (interactive)
-  (let ((pos (get-text-property (point-min) 'docref-back-position)))
-    (if	pos
-	(docref-follow pos)
-      (error "No go-back reference"))))
-
-(defun docref-follow (&optional pos)
-  "Follow cross-reference at point.
-For the cross-reference format, see \\(f@docref-subst).
-The special reference named `back' can be used to return back"
-  (interactive)
-  (or pos (setq pos (point)))
-  (let ((docref-data (get-text-property pos 'docref)))
-    (if docref-data
-	;; There is a reference at point.  Follow it.
-	(let* ((type (car docref-data))
-	       (name (cdr docref-data))
-	       (method (assoc type docref-methods-alist))
-	       (cur-contents (buffer-string))
-	       (opoint (point))
-	       (docref-back-reference (cons "s" cur-contents))
-	       success)
-	  (if (null method)
-	      (error "Unknown cross-reference type: %s" type))
-	  (unwind-protect
-	      (save-excursion
-		(funcall (cdr method) name)
-		(setq success t))
-	    (or success
-		(progn
-		  ;; (cdr method) got an error.
-		  ;; Put back the text that we had.
-		  (erase-buffer)
-		  (insert cur-contents)
-		  (goto-char opoint)))
-	    (set-buffer-modified-p nil))))))
-
-;; Builtin methods for accessing a reference.
-
-(defun docref-describe-function (data)
-  (save-excursion
-    (if (boundp 'docref-last-active-buffer)
-	(set-buffer docref-last-active-buffer))
-    (describe-function (intern data))))
-  
-(defun docref-describe-variable (data)
-  (save-excursion
-    (if (boundp 'docref-last-active-buffer)
-	(set-buffer docref-last-active-buffer))
-    (describe-variable (intern data))))
-
-(defun docref-read-file (data)
-  (with-output-to-temp-buffer (buffer-name)
-    (erase-buffer)
-    (insert-file-contents (expand-file-name data))))
-
-(defun docref-use-string (data)
-  (with-output-to-temp-buffer (buffer-name)
-    (erase-buffer)
-    (insert data)))
-
-(defun docref-use-variable-value (data)
-  (let ((sym (intern data)))
-    (with-output-to-temp-buffer (buffer-name)
-      (erase-buffer)
-      (princ (symbol-value sym)))))
-
-(provide 'docref)
-
-;;; docref.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/eldoc.el b/xemacs-packages/lisp/xemacs-devel/eldoc.el
deleted file mode 100644
index 22ed46cd..00000000
--- a/xemacs-packages/lisp/xemacs-devel/eldoc.el
+++ /dev/null
@@ -1,662 +0,0 @@
-;;; eldoc.el --- show function arglist or variable docstring in echo area
-
-;; Copyright (C) 1996, 1997, 1998 Free Software Foundation, Inc.
-
-;; Author: Noah Friedman 
-;; Maintainer: friedman@splode.com
-;; Keywords: extensions
-;; Created: 1995-10-06
-
-;; $Id: eldoc.el,v 1.5 2002/01/10 11:36:26 youngs Exp $
-
-;; 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:
-
-;; This program was inspired by the behavior of the "mouse documentation
-;; window" on many Lisp Machine systems; as you type a function's symbol
-;; name as part of a sexp, it will print the argument list for that
-;; function.  Behavior is not identical; for example, you need not actually
-;; type the function name, you need only move point around in a sexp that
-;; calls it.  Also, if point is over a documented variable, it will print
-;; the one-line documentation for that variable instead, to remind you of
-;; that variable's meaning.
-
-;; One useful way to enable this minor mode is to put the following in your
-;; .emacs:
-;;
-;;      (autoload 'turn-on-eldoc-mode "eldoc" nil t)
-;;      (add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode)
-;;      (add-hook 'lisp-interaction-mode-hook 'turn-on-eldoc-mode)
-;;      (add-hook 'ielm-mode-hook 'turn-on-eldoc-mode)
-
-;;; Code:
-
-;; Use idle timers if available in the version of emacs running.
-;; Please don't change this to use `require'; this package works as-is in
-;; XEmacs (which doesn't have timer.el as of 19.14), and I would like to
-;; maintain compatibility with that since I must use it sometimes.  --Noah
-(or (featurep 'timer)
-    (load "timer" t))
-
-(defgroup eldoc nil
-  "Show function arglist or variable docstring in echo area."
-  :group 'extensions)
-
-;;;###autoload
-(defcustom eldoc-mode nil
-  "*If non-nil, show the defined parameters for the elisp function near point.
-
-For the emacs lisp function at the beginning of the sexp which point is
-within, show the defined parameters for the function in the echo area.
-This information is extracted directly from the function or macro if it is
-in pure lisp.  If the emacs function is a subr, the parameters are obtained
-from the documentation string if possible.
-
-If point is over a documented variable, print that variable's docstring
-instead.
-
-This variable is buffer-local."
-  :type 'boolean
-  :group 'eldoc)
-(make-variable-buffer-local 'eldoc-mode)
-
-(defcustom eldoc-idle-delay 0.50
-  "*Number of seconds of idle time to wait before printing.
-If user input arrives before this interval of time has elapsed after the
-last input, no documentation will be printed.
-
-If this variable is set to 0, no idle time is required."
-  :type 'number
-  :group 'eldoc)
-
-(defcustom eldoc-minor-mode-string " ElDoc"
-  "*String to display in mode line when Eldoc Mode is enabled; nil for none."
-  :type '(choice string
-		 (const :tag "none" nil))
-  :group 'eldoc)
-
-;; Put this minor mode on the global minor-mode-alist.
-(if (fboundp 'add-minor-mode)
-    (add-minor-mode 'eldoc-mode 'eldoc-minor-mode-string)
-  (or (assq 'eldoc-mode (default-value 'minor-mode-alist))
-      (setq-default minor-mode-alist
-		    (append (default-value 'minor-mode-alist)
-			    '((eldoc-mode eldoc-minor-mode-string))))))
-
-(defcustom eldoc-argument-case 'upcase
-  "Case to display argument names of functions, as a symbol.
-This has two preferred values: `upcase' or `downcase'.
-Actually, any name of a function which takes a string as an argument and
-returns another string is acceptable."
-  :type '(choice (const upcase) (const downcase))
-  :group 'eldoc)
-
-;; No user options below here.
-
-;; Commands after which it is appropriate to print in the echo area.
-;; Eldoc does not try to print function arglists, etc. after just any command,
-;; because some commands print their own messages in the echo area and these
-;; functions would instantly overwrite them.  But self-insert-command as well
-;; as most motion commands are good candidates.
-;; This variable contains an obarray of symbols; do not manipulate it
-;; directly.  Instead, use `eldoc-add-command' and `eldoc-remove-command'.
-(defvar eldoc-message-commands nil)
-
-;; This is used by eldoc-add-command to initialize eldoc-message-commands
-;; as an obarray.
-;; It should probably never be necessary to do so, but if you
-;; choose to increase the number of buckets, you must do so before loading
-;; this file since the obarray is initialized at load time.
-;; Remember to keep it a prime number to improve hash performance.
-(defvar eldoc-message-commands-table-size 31)
-
-;; Bookkeeping; elements are as follows:
-;;   0 - contains the last symbol read from the buffer.
-;;   1 - contains the string last displayed in the echo area for that
-;;       symbol, so it can be printed again if necessary without reconsing.
-;;   2 - 'function if function args, 'variable if variable documentation.
-(defvar eldoc-last-data (make-vector 3 nil))
-(defvar eldoc-last-message nil)
-
-;; Idle timers are supported in Emacs 19.31 and later.
-(defvar eldoc-use-idle-timer-p (fboundp 'run-with-idle-timer))
-
-;; eldoc's timer object, if using idle timers
-(defvar eldoc-timer nil)
-
-;; idle time delay currently in use by timer.
-;; This is used to determine if eldoc-idle-delay is changed by the user.
-(defvar eldoc-current-idle-delay eldoc-idle-delay)
-
-
-;;;###autoload
-(defun eldoc-mode (&optional prefix)
-  "*Enable or disable eldoc mode.
-See documentation for the variable of the same name for more details.
-
-If called interactively with no prefix argument, toggle current condition
-of the mode.
-If called with a positive or negative prefix argument, enable or disable
-the mode, respectively."
-  (interactive "P")
-  (setq eldoc-last-message nil)
-  (cond (eldoc-use-idle-timer-p
-         (add-hook 'post-command-hook 'eldoc-schedule-timer)
-         (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area))
-        (t
-         ;; Use post-command-idle-hook if defined, otherwise use
-         ;; post-command-hook.  The former is only proper to use in Emacs
-         ;; 19.30; that is the first version in which it appeared, but it
-         ;; was obsolesced by idle timers in Emacs 19.31.
-         (add-hook (if (boundp 'post-command-idle-hook)
-                  'post-command-idle-hook
-                'post-command-hook)
-              'eldoc-print-current-symbol-info)
-         ;; quick and dirty hack for seeing if this is XEmacs
-         (and (fboundp 'display-message)
-              (add-hook 'pre-command-hook
-                        'eldoc-pre-command-refresh-echo-area))))
-  (setq eldoc-mode (if prefix
-                       (>= (prefix-numeric-value prefix) 0)
-                     (not eldoc-mode)))
-  (and (interactive-p)
-       (if eldoc-mode
-           (message "eldoc-mode is enabled")
-         (message "eldoc-mode is disabled")))
-  eldoc-mode)
-
-;;;###autoload
-(defun turn-on-eldoc-mode ()
-  "Unequivocally turn on eldoc-mode (see variable documentation)."
-  (interactive)
-  (eldoc-mode 1))
-
-
-;; Idle timers are part of Emacs 19.31 and later.
-(defun eldoc-schedule-timer ()
-  (or (and eldoc-timer
-           (memq eldoc-timer timer-idle-list))
-      (setq eldoc-timer
-            (run-with-idle-timer eldoc-idle-delay t
-                                 'eldoc-print-current-symbol-info)))
-
-  ;; If user has changed the idle delay, update the timer.
-  (cond ((not (= eldoc-idle-delay eldoc-current-idle-delay))
-         (setq eldoc-current-idle-delay eldoc-idle-delay)
-         (timer-set-idle-time eldoc-timer eldoc-idle-delay t))))
-
-(defun eldoc-message (&rest args)
-  (let ((omessage eldoc-last-message))
-    (cond ((eq (car args) eldoc-last-message))
-          ((or (null args)
-               (null (car args)))
-           (setq eldoc-last-message nil))
-          ;; If only one arg, no formatting to do so put it in
-          ;; eldoc-last-message so eq test above might succeed on
-          ;; subsequent calls.
-          ((null (cdr args))
-           (setq eldoc-last-message (car args)))
-          (t
-           (setq eldoc-last-message (apply 'format args))))
-    ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages
-    ;; are recorded in a log.  Do not put eldoc messages in that log since
-    ;; they are Legion.
-    (cond ((fboundp 'display-message)
-           ;; XEmacs 19.13 way of preventing log messages.
-           (cond (eldoc-last-message
-                  (display-message 'no-log eldoc-last-message))
-                 (omessage
-                  (clear-message 'no-log))))
-          (t
-           ;; Emacs way of preventing log messages.
-           (let ((message-log-max nil))
-             (cond (eldoc-last-message
-                    (message "%s" eldoc-last-message))
-                   (omessage
-                    (message nil)))))))
-  eldoc-last-message)
-
-;; This function goes on pre-command-hook for XEmacs or when using idle
-;; timers in Emacs.  Motion commands clear the echo area for some reason,
-;; which make eldoc messages flicker or disappear just before motion
-;; begins.  This function reprints the last eldoc message immediately
-;; before the next command executes, which does away with the flicker.
-;; This doesn't seem to be required for Emacs 19.28 and earlier.
-(defun eldoc-pre-command-refresh-echo-area ()
-  (and eldoc-last-message
-       (if (eldoc-display-message-no-interference-p)
-           (eldoc-message eldoc-last-message)
-         (setq eldoc-last-message nil))))
-
-;; Decide whether now is a good time to display a message.
-(defun eldoc-display-message-p ()
-  (and (eldoc-display-message-no-interference-p)
-       (cond (eldoc-use-idle-timer-p
-              ;; If this-command is non-nil while running via an idle
-              ;; timer, we're still in the middle of executing a command,
-              ;; e.g. a query-replace where it would be annoying to
-              ;; overwrite the echo area.
-              (and (not this-command)
-                   (symbolp last-command)
-                   (intern-soft (symbol-name last-command)
-                                eldoc-message-commands)))
-             (t
-              ;; If we don't have idle timers, this function is
-              ;; running on post-command-hook directly; that means the
-              ;; user's last command is still on `this-command', and we
-              ;; must wait briefly for input to see whether to do display.
-              (and (symbolp this-command)
-                   (intern-soft (symbol-name this-command)
-                                eldoc-message-commands)
-                   (sit-for eldoc-idle-delay))))))
-
-(defun eldoc-display-message-no-interference-p ()
-  (and eldoc-mode
-       (not executing-kbd-macro)
-       ;; Having this mode operate in an active minibuffer/echo area causes
-       ;; interference with what's going on there.
-       (not cursor-in-echo-area)
-       (not (eq (selected-window) (minibuffer-window)))))
-
-
-(defun eldoc-get-doc ()
-  "Return the doc for the current symbol."
-  (let ((current-symbol (eldoc-current-symbol))
-	(current-fnsym  (eldoc-fnsym-in-current-sexp)))
-    (cond ((eq current-symbol current-fnsym)
-	   (or (eldoc-get-fnsym-args-string current-fnsym)
-	       (eldoc-get-var-docstring current-symbol)))
-	  (t
-	   (or (eldoc-get-var-docstring current-symbol)
-	       (eldoc-get-fnsym-args-string current-fnsym))))))
-
-(defun eldoc-print-current-symbol-info ()
-  (and (eldoc-display-message-p)
-       (eldoc-message (eldoc-get-doc))))
-
-(defun eldoc-insert-elisp-func-template (doc)
-  "Insert function template extracted from an eldoc help message."
-  (interactive "*")
-  (message "%s" doc)
-  (if (not doc)
-      (error "could not find doc.")
-    (if (string-match "[^(]*(\\(.*\\))[^)]*" doc)
-	(save-excursion
-	  (insert (substring doc (match-beginning 1) (match-end 1)) ")"))
-      (message "Cannot find args, none?"))))
-
-(defun eldoc-doc (&optional insert-template)
-  "Display simple help summary in echo area on demand.
-If INSERT-TEMPLATE is non-nil (interactively with prefix arg) then insert a
-function template at point.
-@todo can we add possibility of specifying what to get help on?"
-  (interactive "P")
-  (let ((doc (eldoc-get-doc)))
-    (if insert-template
-	(eldoc-insert-elisp-func-template doc)
-    (message "%s" (or doc 
-		      (format "No doc for `%s'" (eldoc-current-symbol)))))))
-
-;; Return a string containing the function parameter list, or 1-line
-;; docstring if function is a subr and no arglist is obtainable from the
-;; docstring or elsewhere.
-(defun eldoc-get-fnsym-args-string (sym)
-  (let ((args nil)
-        (doc nil))
-    (cond ((not (and sym
-                     (symbolp sym)
-                     (fboundp sym))))
-          ((and (eq sym (aref eldoc-last-data 0))
-                (eq 'function (aref eldoc-last-data 2)))
-           (setq doc (aref eldoc-last-data 1)))
-          ((subrp (eldoc-symbol-function sym))
-           (setq args (or (eldoc-function-argstring-from-docstring sym)
-                          (eldoc-docstring-first-line (documentation sym t)))))
-          (t
-           (setq args (eldoc-function-argstring sym))))
-    (cond (args
-           (setq doc (eldoc-docstring-format-sym-doc sym args))
-           (eldoc-last-data-store sym doc 'function)))
-    doc))
-
-;; Return a string containing a brief (one-line) documentation string for
-;; the variable.
-(defun eldoc-get-var-docstring (sym)
-  (cond ((and (eq sym (aref eldoc-last-data 0))
-              (eq 'variable (aref eldoc-last-data 2)))
-         (aref eldoc-last-data 1))
-        (t
-         (let ((doc (documentation-property sym 'variable-documentation t)))
-           (cond (doc
-                  (setq doc (eldoc-docstring-format-sym-doc
-                             sym (eldoc-docstring-first-line doc)))
-                  (eldoc-last-data-store sym doc 'variable)))
-           doc))))
-
-(defun eldoc-last-data-store (symbol doc type)
-  (aset eldoc-last-data 0 symbol)
-  (aset eldoc-last-data 1 doc)
-  (aset eldoc-last-data 2 type))
-
-;; Note that any leading `*' in the docstring (which indicates the variable
-;; is a user option) is removed.
-(defun eldoc-docstring-first-line (doc)
-  (and (stringp doc)
-       (substitute-command-keys
-        (save-match-data
-          (let ((start (if (string-match "^\\*" doc) (match-end 0) 0)))
-            (cond ((string-match "\n" doc)
-                   (substring doc start (match-beginning 0)))
-                  ((zerop start) doc)
-                  (t (substring doc start))))))))
-
-;; If the entire line cannot fit in the echo area, the symbol name may be
-;; truncated or eliminated entirely from the output to make room for the
-;; description.
-(defun eldoc-docstring-format-sym-doc (sym doc)
-  (save-match-data
-    (let* ((name (symbol-name sym))
-           (doclen (+ (length name) (length ": ") (length doc)))
-           ;; Subtract 1 from window width since emacs seems not to write
-           ;; any chars to the last column, at least for some terminal types.
-           (strip (- doclen (1- (window-width (minibuffer-window))))))
-      (cond ((> strip 0)
-             (let* ((len (length name)))
-               (cond ((>= strip len)
-                      (format "%s" doc))
-                     (t
-                      ;;(setq name (substring name 0 (- len strip)))
-                      ;;
-                      ;; Show the end of the partial symbol name, rather
-                      ;; than the beginning, since the former is more likely
-                      ;; to be unique given package namespace conventions.
-                      (setq name (substring name strip))
-                      (format "%s: %s" name doc)))))
-            (t
-             (format "%s: %s" sym doc))))))
-
-
-(defun eldoc-fnsym-in-current-sexp ()
-  (let ((p (point)))
-    (eldoc-beginning-of-sexp)
-    (prog1
-        ;; Don't do anything if current word is inside a string.
-        (if (= (or (char-after (1- (point))) 0) ?\")
-            nil
-          (eldoc-current-symbol))
-      (goto-char p))))
-
-(defun eldoc-beginning-of-sexp ()
-  (let ((parse-sexp-ignore-comments t))
-    (condition-case err
-        (while (progn
-                 (forward-sexp -1)
-                 (or (= (or (char-after (1- (point)))) ?\")
-                     (> (point) (point-min)))))
-      (error nil))))
-
-;; returns nil unless current word is an interned symbol.
-(defun eldoc-current-symbol ()
-  (let ((c (char-after (point))))
-    (and c
-         (memq (char-syntax c) '(?w ?_))
-         (intern-soft (current-word)))))
-
-;; Do indirect function resolution if possible.
-(defun eldoc-symbol-function (fsym)
-  (let ((defn (and (fboundp fsym)
-                   (symbol-function fsym))))
-    (and (symbolp defn)
-         (condition-case err
-             (setq defn (indirect-function fsym))
-           (error (setq defn nil))))
-    defn))
-
-(defun eldoc-function-argstring (fn)
-  (let* ((prelim-def (eldoc-symbol-function fn))
-         (def (if (eq (car-safe prelim-def) 'macro)
-                  (cdr prelim-def)
-                prelim-def))
-         (arglist (cond ((null def) nil)
-                        ((byte-code-function-p def)
-                         (if (fboundp 'compiled-function-arglist)
-                             (funcall 'compiled-function-arglist def)
-                           (aref def 0)))
-                        ((eq (car-safe def) 'lambda)
-                         (nth 1 def))
-                        (t t))))
-    (eldoc-function-argstring-format arglist)))
-
-(defun eldoc-function-argstring-format (arglist)
-  (cond ((not (listp arglist))
-         (setq arglist nil))
-        ((symbolp (car arglist))
-         (setq arglist
-               (mapcar (function (lambda (s)
-                                   (if (memq s '(&optional &rest))
-                                       (symbol-name s)
-                                     (funcall eldoc-argument-case
-                                              (symbol-name s)))))
-                       arglist)))
-        ((stringp (car arglist))
-         (setq arglist
-               (mapcar (function (lambda (s)
-                                   (if (member s '("&optional" "&rest"))
-                                       s
-                                     (funcall eldoc-argument-case s))))
-                       arglist))))
-  (concat "(" (mapconcat 'identity arglist " ") ")"))
-
-
-;; Alist of predicate/action pairs.
-;; Each member of the list is a sublist consisting of a predicate function
-;; used to determine if the arglist for a function can be found using a
-;; certain pattern, and a function which returns the actual arglist from
-;; that docstring.
-;;
-;; The order in this table is significant, since later predicates may be
-;; more general than earlier ones.
-;;
-;; Compiler note for Emacs/XEmacs versions which support dynamic loading:
-;; these functions will be compiled to bytecode, but can't be lazy-loaded
-;; even if you set byte-compile-dynamic; to do that would require making
-;; them named top-level defuns, which is not particularly desirable either.
-(defvar eldoc-function-argstring-from-docstring-method-table
-  (list
-   ;; Try first searching for args starting with symbol name.
-   ;; This is to avoid matching parenthetical remarks in e.g. sit-for.
-   (list (function (lambda (doc fn)
-                     (string-match (format "^(%s[^\n)]*)$" fn) doc)))
-         (function (lambda (doc)
-                     ;; end does not include trailing ")" sequence.
-                     (let ((end (- (match-end 0) 1)))
-                       (if (string-match " +" doc (match-beginning 0))
-                           (substring doc (match-end 0) end)
-                         "")))))
-
-   ;; Try again not requiring this symbol name in the docstring.
-   ;; This will be the case when looking up aliases.
-   (list (function (lambda (doc fn)
-                     ;; save-restriction has a pathological docstring in
-                     ;; Emacs/XEmacs 19.
-                     (and (not (eq fn 'save-restriction))
-                          (string-match "^([^\n)]+)$" doc))))
-         (function (lambda (doc)
-                     ;; end does not include trailing ")" sequence.
-                     (let ((end (- (match-end 0) 1)))
-                       (and (string-match " +" doc (match-beginning 0))
-                            (substring doc (match-end 0) end))))))
-
-   ;; Emacs subr docstring style:
-   ;;   (fn arg1 arg2 ...): description...
-   (list (function (lambda (doc fn)
-                     (string-match "^([^\n)]+):" doc)))
-         (function (lambda (doc)
-                     ;; end does not include trailing "):" sequence.
-                     (let ((end (- (match-end 0) 2)))
-                       (and (string-match " +" doc (match-beginning 0))
-                            (substring doc (match-end 0) end))))))
-
-   ;; XEmacs subr docstring style:
-   ;;   "arguments: (arg1 arg2 ...)
-   (list (function (lambda (doc fn)
-                     (string-match "^arguments: (\\([^\n)]+\\))" doc)))
-         (function (lambda (doc)
-                     ;; also skip leading paren, but the first word is
-                     ;; actually an argument, not the function name.
-                     (substring doc (match-beginning 1) (match-end 1)))))
-
-   ;; This finds the argstring for `condition-case'.  Any others?
-   (list (function (lambda (doc fn)
-                     (string-match
-                      (format "^Usage looks like \\((%s[^\n)]*)\\)\\.$" fn)
-                      doc)))
-         (function (lambda (doc)
-                     ;; end does not include trailing ")" sequence.
-                     (let ((end (- (match-end 1) 1)))
-                       (and (string-match " +" doc (match-beginning 1))
-                            (substring doc (match-end 0) end))))))
-
-   ;; This finds the argstring for `setq-default'.  Any others?
-   (list (function (lambda (doc fn)
-                     (string-match (format "^[ \t]+\\((%s[^\n)]*)\\)$" fn)
-                                   doc)))
-         (function (lambda (doc)
-                     ;; end does not include trailing ")" sequence.
-                     (let ((end (- (match-end 1) 1)))
-                       (and (string-match " +" doc (match-beginning 1))
-                            (substring doc (match-end 0) end))))))
-
-   ;; This finds the argstring for `start-process'.  Any others?
-   (list (function (lambda (doc fn)
-                     (string-match "^Args are +\\([^\n]+\\)$" doc)))
-         (function (lambda (doc)
-                     (substring doc (match-beginning 1) (match-end 1)))))
-
-   ;; These common subrs don't have arglists in their docstrings.  So cheat.
-   (list (function (lambda (doc fn)
-                     (memq fn '(and or list + -))))
-         (function (lambda (doc)
-                     ;; The value nil is a placeholder; otherwise, the
-                     ;; following string may be compiled as a docstring,
-                     ;; and not a return value for the function.
-                     ;; In interpreted lisp form they are
-                     ;; indistinguishable; it only matters for compiled
-                     ;; forms.
-                     nil
-                     "&rest args")))
-   ))
-
-(defun eldoc-function-argstring-from-docstring (fn)
-  (let ((docstring (documentation fn 'raw))
-        (table eldoc-function-argstring-from-docstring-method-table)
-        (doc nil)
-        (doclist nil))
-    (save-match-data
-      (while table
-        (cond ((funcall (car (car table)) docstring fn)
-               (setq doc (funcall (car (cdr (car table))) docstring))
-               (setq table nil))
-              (t
-               (setq table (cdr table)))))
-
-      (cond ((not (stringp doc))
-             nil)
-            ((string-match "&" doc)
-             (let ((p 0)
-                   (l (length doc)))
-               (while (< p l)
-                 (cond ((string-match "[ \t\n]+" doc p)
-                        (setq doclist
-                              (cons (substring doc p (match-beginning 0))
-                                    doclist))
-                        (setq p (match-end 0)))
-                       (t
-                        (setq doclist (cons (substring doc p) doclist))
-                        (setq p l))))
-               (eldoc-function-argstring-format (nreverse doclist))))
-            (t
-             (concat "(" (funcall eldoc-argument-case doc) ")"))))))
-
-
-;; When point is in a sexp, the function args are not reprinted in the echo
-;; area after every possible interactive command because some of them print
-;; their own messages in the echo area; the eldoc functions would instantly
-;; overwrite them unless it is more restrained.
-;; These functions do display-command table management.
-
-(defun eldoc-add-command (&rest cmds)
-  (or eldoc-message-commands
-      (setq eldoc-message-commands
-            (make-vector eldoc-message-commands-table-size 0)))
-
-  (let (name sym)
-    (while cmds
-      (setq name (car cmds))
-      (setq cmds (cdr cmds))
-
-      (cond ((symbolp name)
-             (setq sym name)
-             (setq name (symbol-name sym)))
-            ((stringp name)
-             (setq sym (intern-soft name))))
-
-      (and (symbolp sym)
-           (fboundp sym)
-           (set (intern name eldoc-message-commands) t)))))
-
-(defun eldoc-add-command-completions (&rest names)
-  (while names
-      (apply 'eldoc-add-command
-             (all-completions (car names) obarray 'fboundp))
-      (setq names (cdr names))))
-
-(defun eldoc-remove-command (&rest cmds)
-  (let (name)
-    (while cmds
-      (setq name (car cmds))
-      (setq cmds (cdr cmds))
-
-      (and (symbolp name)
-           (setq name (symbol-name name)))
-
-      (if (fboundp 'unintern)
-          (unintern name eldoc-message-commands)
-        (let ((s (intern-soft name eldoc-message-commands)))
-          (and s
-               (makunbound s)))))))
-
-(defun eldoc-remove-command-completions (&rest names)
-  (while names
-    (apply 'eldoc-remove-command
-           (all-completions (car names) eldoc-message-commands))
-    (setq names (cdr names))))
-
-
-;; Prime the command list.
-(eldoc-add-command-completions
- "backward-" "beginning-of-" "delete-other-windows" "delete-window"
- "end-of-" "forward-" "indent-for-tab-command" "goto-" "mouse-set-point"
- "next-" "other-window" "previous-" "recenter" "scroll-"
- "self-insert-command" "split-window-"
- "up-list" "down-list")
-
-(provide 'eldoc)
-
-;;; eldoc.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/elp.el b/xemacs-packages/lisp/xemacs-devel/elp.el
deleted file mode 100644
index 87a9117c..00000000
--- a/xemacs-packages/lisp/xemacs-devel/elp.el
+++ /dev/null
@@ -1,608 +0,0 @@
-;;; elp.el --- Emacs Lisp Profiler
-
-;; Copyright (C) 1994,1995,1997,1998, 2001 Free Software Foundation, Inc.
-
-;; Author:        Barry A. Warsaw
-;; Maintainer:    XEmacs Development Team 
-;; Created:       26-Feb-1994
-;; Keywords:      debugging lisp tools
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched with GNU Emacs 21.1 2001-12-25 Simon Josefsson 
-
-;;; Commentary:
-;;
-;; If you want to profile a bunch of functions, set elp-function-list
-;; to the list of symbols, then do a M-x elp-instrument-list.  This
-;; hacks those functions so that profiling information is recorded
-;; whenever they are called.  To print out the current results, use
-;; M-x elp-results.  If you want output to go to standard-output
-;; instead of a separate buffer, setq elp-use-standard-output to
-;; non-nil.  With elp-reset-after-results set to non-nil, profiling
-;; information will be reset whenever the results are displayed.  You
-;; can also reset all profiling info at any time with M-x
-;; elp-reset-all.
-;;
-;; You can also instrument all functions in a package, provided that
-;; the package follows the GNU coding standard of a common textual
-;; prefix.  Use M-x elp-instrument-package for this.
-;;
-;; If you want to sort the results, set elp-sort-by-function to some
-;; predicate function.  The three most obvious choices are predefined:
-;; elp-sort-by-call-count, elp-sort-by-average-time, and
-;; elp-sort-by-total-time.  Also, you can prune from the output, all
-;; functions that have been called fewer than a given number of times
-;; by setting elp-report-limit.
-;;
-;; Elp can instrument byte-compiled functions just as easily as
-;; interpreted functions, but it cannot instrument macros.  However,
-;; when you redefine a function (e.g. with eval-defun), you'll need to
-;; re-instrument it with M-x elp-instrument-function.  This will also
-;; reset profiling information for that function.  Elp can handle
-;; interactive functions (i.e. commands), but of course any time spent
-;; idling for user prompts will show up in the timing results.
-;;
-;; You can also designate a `master' function.  Profiling times will
-;; be gathered for instrumented functions only during execution of
-;; this master function.  Thus, if you have some defuns like:
-;;
-;;  (defun foo () (do-something-time-intensive))
-;;  (defun bar () (foo))
-;;  (defun baz () (bar) (foo))
-;;
-;; and you want to find out the amount of time spent in bar and foo,
-;; but only during execution of bar, make bar the master.  The call of
-;; foo from baz will not add to foo's total timing sums.  Use M-x
-;; elp-set-master and M-x elp-unset-master to utilize this feature.
-;; Only one master function can be set at a time.
-
-;; You can restore any function's original function definition with
-;; elp-restore-function.  The other instrument, restore, and reset
-;; functions are provided for symmetry.
-
-;; Here is a list of variable you can use to customize elp:
-;;   elp-function-list
-;;   elp-reset-after-results
-;;   elp-sort-by-function
-;;   elp-report-limit
-;;
-;; Here is a list of the interactive commands you can use:
-;;   elp-instrument-function
-;;   elp-restore-function
-;;   elp-instrument-list
-;;   elp-restore-list
-;;   elp-instrument-package
-;;   elp-restore-all
-;;   elp-reset-function
-;;   elp-reset-list
-;;   elp-reset-all
-;;   elp-set-master
-;;   elp-unset-master
-;;   elp-results
-
-;; Note that there are plenty of factors that could make the times
-;; reported unreliable, including the accuracy and granularity of your
-;; system clock, and the overhead spent in lisp calculating and
-;; recording the intervals.  I figure the latter is pretty constant,
-;; so while the times may not be entirely accurate, I think they'll
-;; give you a good feel for the relative amount of work spent in the
-;; various lisp routines you are profiling.  Note further that times
-;; are calculated using wall-clock time, so other system load will
-;; affect accuracy too.
-
-;;; Background:
-
-;; This program was inspired by the only two existing Emacs Lisp
-;; profilers that I'm aware of, Boaz Ben-Zvi's profile.el, and Root
-;; Boy Jim's profiler.el. Both were written for Emacs 18 and both were
-;; pretty good first shots at profiling, but I found that they didn't
-;; provide the functionality or interface that I wanted, so I wrote
-;; this.  I've tested elp in XEmacs 19 and Emacs 19.  There's no point
-;; in even trying to make this work with Emacs 18.
-
-;; Unlike previous profilers, elp uses Emacs 19's built-in function
-;; current-time to return interval times.  This obviates the need for
-;; both an external C program and Emacs processes to communicate with
-;; such a program, and thus simplifies the package as a whole.
-
-;; TBD:
-;; Make this act like a real profiler, so that it records time spent
-;; in all branches of execution.
-
-;;; Code:
-
-
-;; start of user configuration variables
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-
-(defgroup elp nil
-  "Emacs Lisp Profiler"
-  :group 'lisp)
-
-(defcustom elp-function-list nil
-  "*List of functions to profile.
-Used by the command `elp-instrument-list'."
-  :type '(repeat function)
-  :group 'elp)
-
-(defcustom elp-reset-after-results t
-  "*Non-nil means reset all profiling info after results are displayed.
-Results are displayed with the `elp-results' command."
-  :type 'boolean
-  :group 'elp)
-
-(defcustom elp-sort-by-function 'elp-sort-by-total-time
-  "*Non-nil specifies elp results sorting function.
-These functions are currently available:
-
-  elp-sort-by-call-count   -- sort by the highest call count
-  elp-sort-by-total-time   -- sort by the highest total time
-  elp-sort-by-average-time -- sort by the highest average times
-
-You can write you're own sort function. It should adhere to the
-interface specified by the PRED argument for the `sort' defun.  Each
-\"element of LIST\" is really a 4 element vector where element 0 is
-the call count, element 1 is the total time spent in the function,
-element 2 is the average time spent in the function, and element 3 is
-the symbol's name string."
-  :type 'function
-  :group 'elp)
-
-(defcustom elp-report-limit 1
-  "*Prevents some functions from being displayed in the results buffer.
-If a number, no function that has been called fewer than that number
-of times will be displayed in the output buffer.  If nil, all
-functions will be displayed."
-  :type '(choice integer
-		 (const :tag "Show All" nil))
-  :group 'elp)
-
-(defcustom elp-use-standard-output nil
-  "*Non-nil says to output to `standard-output' instead of a buffer."
-  :type 'boolean
-  :group 'elp)
-
-(defcustom elp-recycle-buffers-p t
-  "*nil says to not recycle the `elp-results-buffer'.
-In other words, a new unique buffer is create every time you run
-\\[elp-results]."
-  :type 'boolean
-  :group 'elp)
-
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end of user configuration variables
-
-
-(defvar elp-results-buffer "*ELP Profiling Results*"
-  "Buffer name for outputting profiling results.")
-
-(defconst elp-timer-info-property 'elp-info
-  "ELP information property name.")
-
-(defvar elp-all-instrumented-list nil
-  "List of all functions currently being instrumented.")
-
-(defvar elp-record-p t
-  "Controls whether functions should record times or not.
-This variable is set by the master function.")
-
-(defvar elp-master nil
-  "Master function symbol.")
-
-(defvar elp-not-profilable
-  '(elp-wrapper elp-elapsed-time error call-interactively apply current-time interactive-p)
-  "List of functions that cannot be profiled.
-Those functions are used internally by the profiling code and profiling
-them would thus lead to infinite recursion.")
-
-(defun elp-not-profilable-p (fun)
-  (or (memq fun elp-not-profilable)
-      (keymapp fun)
-      (condition-case nil
-	  (when (subrp (symbol-function fun))
-	    (eq 'unevalled (cdr (subr-arity (symbol-function fun)))))
-	(error nil))))
-
-
-;;;###autoload
-(defun elp-instrument-function (funsym)
-  "Instrument FUNSYM for profiling.
-FUNSYM must be a symbol of a defined function."
-  (interactive "aFunction to instrument: ")
-  ;; restore the function.  this is necessary to avoid infinite
-  ;; recursion of already instrumented functions (i.e. elp-wrapper
-  ;; calling elp-wrapper ad infinitum).  it is better to simply
-  ;; restore the function than to throw an error.  this will work
-  ;; properly in the face of eval-defun because if the function was
-  ;; redefined, only the timer info will be nil'd out since
-  ;; elp-restore-function is smart enough not to trash the new
-  ;; definition.
-  (elp-restore-function funsym)
-  (let* ((funguts (symbol-function funsym))
-	 (infovec (vector 0 0 funguts))
-	 (newguts '(lambda (&rest args))))
-    ;; We cannot profile functions used internally during profiling.
-    (when (elp-not-profilable-p funsym)
-      (error "ELP cannot profile the function: %s" funsym))
-    ;; we cannot profile macros
-    (and (eq (car-safe funguts) 'macro)
-	 (error "ELP cannot profile macro: %s" funsym))
-    ;; TBD: at some point it might be better to load the autoloaded
-    ;; function instead of throwing an error.  if we do this, then we
-    ;; probably want elp-instrument-package to be updated with the
-    ;; newly loaded list of functions.  i'm not sure it's smart to do
-    ;; the autoload here, since that could have side effects, and
-    ;; elp-instrument-function is similar (in my mind) to defun-ish
-    ;; type functionality (i.e. it shouldn't execute the function).
-    (and (eq (car-safe funguts) 'autoload)
-	 (error "ELP cannot profile autoloaded function: %s" funsym))
-    ;; put rest of newguts together
-    (if (commandp funsym)
-	(setq newguts (append newguts '((interactive)))))
-    (setq newguts (append newguts `((elp-wrapper
-				     (quote ,funsym)
-				     ,(when (commandp funsym)
-					'(interactive-p))
-				     args))))
-    ;; to record profiling times, we set the symbol's function
-    ;; definition so that it runs the elp-wrapper function with the
-    ;; function symbol as an argument.  We place the old function
-    ;; definition on the info vector.
-    ;;
-    ;; The info vector data structure is a 3 element vector.  The 0th
-    ;; element is the call-count, i.e. the total number of times this
-    ;; function has been entered.  This value is bumped up on entry to
-    ;; the function so that non-local exists are still recorded. TBD:
-    ;; I haven't tested non-local exits at all, so no guarantees.
-    ;;
-    ;; The 1st element is the total amount of time in usecs that have
-    ;; been spent inside this function.  This number is added to on
-    ;; function exit.
-    ;;
-    ;; The 2nd element is the old function definition list.  This gets
-    ;; funcall'd in between start/end time retrievals. I believe that
-    ;; this lets us profile even byte-compiled functions.
-
-    ;; put the info vector on the property list
-    (put funsym elp-timer-info-property infovec)
-
-    ;; Set the symbol's new profiling function definition to run
-    ;; elp-wrapper.
-    (let ((advice-info (get funsym 'ad-advice-info)))
-      (if advice-info
-	  (progn
-	    ;; If function is advised, don't let Advice change
-	    ;; its definition from under us during the `fset'.
-	    (put funsym 'ad-advice-info nil)
-    (fset funsym newguts)
-	    (put funsym 'ad-advice-info advice-info))
-	(fset funsym newguts)))
-
-    ;; add this function to the instrumentation list
-    (unless (memq funsym elp-all-instrumented-list)
-      (push funsym elp-all-instrumented-list))))
-
-(defun elp-restore-function (funsym)
-  "Restore an instrumented function to its original definition.
-Argument FUNSYM is the symbol of a defined function."
-  (interactive "aFunction to restore: ")
-  (let ((info (get funsym elp-timer-info-property)))
-    ;; delete the function from the all instrumented list
-    (setq elp-all-instrumented-list
-	  (delq funsym elp-all-instrumented-list))
-
-    ;; if the function was the master, reset the master
-    (if (eq funsym elp-master)
-	(setq elp-master nil
-	      elp-record-p t))
-
-    ;; zap the properties
-    (put funsym elp-timer-info-property nil)
-
-    ;; restore the original function definition, but if the function
-    ;; wasn't instrumented do nothing.  we do this after the above
-    ;; because its possible the function got un-instrumented due to
-    ;; circumstances beyond our control.  Also, check to make sure
-    ;; that the current function symbol points to elp-wrapper.  If
-    ;; not, then the user probably did an eval-defun, or loaded a
-    ;; byte-compiled version, while the function was instrumented and
-    ;; we don't want to destroy the new definition.  can it ever be
-    ;; the case that a lisp function can be compiled instrumented?
-    (and info
-	 (functionp funsym)
-	 (not (byte-code-function-p (symbol-function funsym)))
-	 (assq 'elp-wrapper (symbol-function funsym))
-	 (fset funsym (aref info 2)))))
-
-;;;###autoload
-(defun elp-instrument-list (&optional list)
-  "Instrument for profiling, all functions in `elp-function-list'.
-Use optional LIST if provided instead."
-  (interactive "PList of functions to instrument: ")
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-instrument-function list)))
-
-;;;###autoload
-(defun elp-instrument-package (prefix)
-  "Instrument for profiling, all functions which start with PREFIX.
-For example, to instrument all ELP functions, do the following:
-
-    \\[elp-instrument-package] RET elp- RET"
-  (interactive "sPrefix of package to instrument: ")
-  (if (zerop (length prefix))
-      (error "Instrumenting all Emacs functions would render Emacs unusable"))
-  (elp-instrument-list
-   (mapcar
-    'intern
-    (all-completions
-     prefix obarray
-				     (lambda (sym)
-				       (and (fboundp sym)
-	    (not (or (memq (car-safe (symbol-function sym)) '(autoload macro))
-		     (elp-not-profilable-p sym)))))))))
-
-(defun elp-restore-list (&optional list)
-  "Restore the original definitions for all functions in `elp-function-list'.
-Use optional LIST if provided instead."
-  (interactive "PList of functions to restore: ")
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-restore-function list)))
-
-(defun elp-restore-all ()
-  "Restores the original definitions of all functions being profiled."
-  (interactive)
-  (elp-restore-list elp-all-instrumented-list))
-
-
-(defun elp-reset-function (funsym)
-  "Reset the profiling information for FUNSYM."
-  (interactive "aFunction to reset: ")
-  (let ((info (get funsym elp-timer-info-property)))
-    (or info
-	(error "%s is not instrumented for profiling" funsym))
-    (aset info 0 0)			;reset call counter
-    (aset info 1 0.0)			;reset total time
-    ;; don't muck with aref 2 as that is the old symbol definition
-    ))
-
-(defun elp-reset-list (&optional list)
-  "Reset the profiling information for all functions in `elp-function-list'.
-Use optional LIST if provided instead."
-  (interactive "PList of functions to reset: ")
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-reset-function list)))
-
-(defun elp-reset-all ()
-  "Reset the profiling information for all functions being profiled."
-  (interactive)
-  (elp-reset-list elp-all-instrumented-list))
-
-(defun elp-set-master (funsym)
-  "Set the master function for profiling."
-  (interactive "aMaster function: ")
-  ;; when there's a master function, recording is turned off by
-  ;; default
-  (setq elp-master funsym
-	elp-record-p nil)
-  ;; make sure master function is instrumented
-  (or (memq funsym elp-all-instrumented-list)
-      (elp-instrument-function funsym)))
-
-(defun elp-unset-master ()
-  "Unsets the master function."
-  (interactive)
-  ;; when there's no master function, recording is turned on by default.
-  (setq elp-master nil
-	elp-record-p t))
-
-
-(defsubst elp-elapsed-time (start end)
-  (+ (* (- (car end) (car start)) 65536.0)
-     (- (car (cdr end)) (car (cdr start)))
-     (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
-
-(defun elp-wrapper (funsym interactive-p args)
-  "This function has been instrumented for profiling by the ELP.
-ELP is the Emacs Lisp Profiler.  To restore the function to its
-original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
-  ;; turn on recording if this is the master function
-  (if (and elp-master
-	   (eq funsym elp-master))
-      (setq elp-record-p t))
-  ;; get info vector and original function symbol
-  (let* ((info (get funsym elp-timer-info-property))
-	 (func (aref info 2))
-	 result)
-    (or func
-	(error "%s is not instrumented for profiling" funsym))
-    (if (not elp-record-p)
-	;; when not recording, just call the original function symbol
-	;; and return the results.
-	(setq result
-	      (if interactive-p
-		  (call-interactively func)
-		(apply func args)))
-      ;; we are recording times
-      (let (enter-time exit-time)
-	;; increment the call-counter
-	(aset info 0 (1+ (aref info 0)))
-	;; now call the old symbol function, checking to see if it
-	;; should be called interactively.  make sure we return the
-	;; correct value
-	      (if interactive-p
-	    (setq enter-time (current-time)
-		  result (call-interactively func)
-		  exit-time (current-time))
-	  (setq enter-time (current-time)
-		result (apply func args)
-		exit-time (current-time)))
-	;; calculate total time in function
-	(aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time)))
-	))
-    ;; turn off recording if this is the master function
-    (if (and elp-master
-	     (eq funsym elp-master))
-	(setq elp-record-p nil))
-    result))
-
-
-;; shut the byte-compiler up
-(defvar elp-field-len nil)
-(defvar elp-cc-len nil)
-(defvar elp-at-len nil)
-(defvar elp-et-len nil)
-
-(defun elp-sort-by-call-count (vec1 vec2)
-  ;; sort by highest call count.  See `sort'.
-  (>= (aref vec1 0) (aref vec2 0)))
-
-(defun elp-sort-by-total-time (vec1 vec2)
-  ;; sort by highest total time spent in function. See `sort'.
-  (>= (aref vec1 1) (aref vec2 1)))
-
-(defun elp-sort-by-average-time (vec1 vec2)
-  ;; sort by highest average time spent in function. See `sort'.
-  (>= (aref vec1 2) (aref vec2 2)))
-
-(defsubst elp-pack-number (number width)
-  ;; pack the NUMBER string into WIDTH characters, watching out for
-  ;; very small or large numbers
-  (if (<= (length number) width)
-      number
-    ;; check for very large or small numbers
-    (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number)
-	(concat (substring
-		 (substring number (match-beginning 1) (match-end 1))
-		 0
-		 (- width (match-end 2) (- (match-beginning 2)) 3))
-		"..."
-		(substring number (match-beginning 2) (match-end 2)))
-      (concat (substring number 0 width)))))
-
-(defun elp-output-result (resultvec)
-  ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or
-  ;; more element vector where aref 0 is the call count, aref 1 is the
-  ;; total time spent in the function, aref 2 is the average time
-  ;; spent in the function, and aref 3 is the symbol's string
-  ;; name. All other elements in the vector are ignored.
-  (let* ((cc (aref resultvec 0))
-	 (tt (aref resultvec 1))
-	 (at (aref resultvec 2))
-	 (symname (aref resultvec 3))
-	 callcnt totaltime avetime)
-    (setq callcnt (number-to-string cc)
-	  totaltime (number-to-string tt)
-	  avetime (number-to-string at))
-    ;; possibly prune the results
-    (if (and elp-report-limit
-	     (numberp elp-report-limit)
-	     (< cc elp-report-limit))
-	nil
-      (insert symname)
-      (insert-char 32 (+ elp-field-len (- (length symname)) 2))
-      ;; print stuff out, formatting it nicely
-      (insert callcnt)
-      (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2))
-      (let ((ttstr (elp-pack-number totaltime elp-et-len))
-	    (atstr (elp-pack-number avetime elp-at-len)))
-	(insert ttstr)
-	(insert-char 32 (+ elp-et-len (- (length ttstr)) 2))
-	(insert atstr))
-      (insert "\n"))))
-
-;;;###autoload
-(defun elp-results ()
-  "Display current profiling results.
-If `elp-reset-after-results' is non-nil, then current profiling
-information for all instrumented functions are reset after results are
-displayed."
-  (interactive)
-  (let ((curbuf (current-buffer))
-	(resultsbuf (if elp-recycle-buffers-p
-			(get-buffer-create elp-results-buffer)
-		      (generate-new-buffer elp-results-buffer))))
-    (set-buffer resultsbuf)
-    (erase-buffer)
-    (beginning-of-buffer)
-    ;; get the length of the longest function name being profiled
-    (let* ((longest 0)
-	   (title "Function Name")
-	   (titlelen (length title))
-	   (elp-field-len titlelen)
-	   (cc-header "Call Count")
-	   (elp-cc-len    (length cc-header))
-	   (et-header "Elapsed Time")
-	   (elp-et-len    (length et-header))
-	   (at-header "Average Time")
-	   (elp-at-len    (length at-header))
-	   (resvec
-	    (mapcar
-	     (function
-	      (lambda (funsym)
-		(let* ((info (get funsym elp-timer-info-property))
-		       (symname (format "%s" funsym))
-		       (cc (aref info 0))
-		       (tt (aref info 1)))
-		  (if (not info)
-		      (insert "No profiling information found for: "
-			      symname)
-		    (setq longest (max longest (length symname)))
-		    (vector cc tt (if (zerop cc)
-				      0.0 ;avoid arithmetic div-by-zero errors
-				    (/ (float tt) (float cc)))
-			    symname)))))
-	     elp-all-instrumented-list))
-	   )				; end let*
-      (insert title)
-      (if (> longest titlelen)
-	  (progn
-	    (insert-char 32 (- longest titlelen))
-	    (setq elp-field-len longest)))
-      (insert "  " cc-header "  " et-header "  " at-header "\n")
-      (insert-char ?= elp-field-len)
-      (insert "  ")
-      (insert-char ?= elp-cc-len)
-      (insert "  ")
-      (insert-char ?= elp-et-len)
-      (insert "  ")
-      (insert-char ?= elp-at-len)
-      (insert "\n")
-      ;; if sorting is enabled, then sort the results list. in either
-      ;; case, call elp-output-result to output the result in the
-      ;; buffer
-      (if elp-sort-by-function
-	  (setq resvec (sort resvec elp-sort-by-function)))
-      (mapcar 'elp-output-result resvec))
-    ;; now pop up results buffer
-    (set-buffer curbuf)
-    (pop-to-buffer resultsbuf)
-    ;; copy results to standard-output?
-    (if (or elp-use-standard-output noninteractive)
-	(princ (buffer-substring (point-min) (point-max))))
-    ;; reset profiling info if desired
-    (and elp-reset-after-results
-	 (elp-reset-all))))
-
-(defun elp-unload-hook ()
-  (elp-restore-all))
-
-(provide 'elp)
-
-;;; elp.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/eval-expr.el b/xemacs-packages/lisp/xemacs-devel/eval-expr.el
deleted file mode 100644
index 8ef9a487..00000000
--- a/xemacs-packages/lisp/xemacs-devel/eval-expr.el
+++ /dev/null
@@ -1,262 +0,0 @@
-;;; eval-expr.el --- enhanced eval-expression command
-
-;; Copyright (C) 1991 Free Software Foundation, Inc.
-;; Copyright (C) 1991 Joe Wells
-;; Copyright (C) 1998 Noah S. Friedman
-
-;; Author: Noah Friedman 
-;; Maintainer: friedman@splode.com
-;; Keywords: extensions
-;; Created: 1998-07-30
-
-;; $Id: eval-expr.el,v 1.2 1998/08/04 02:43:59 friedman 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:
-
-;; Updates of this program may be available via the URL
-;; http://www.splode.com/~friedman/software/emacs-lisp/
-
-;; To use this package, put this in your .emacs:
-;;
-;;    (require 'eval-expr)
-;;    (eval-expr-install)
-
-;; Highlights:
-;;
-;;   * When reading the Lisp object interactively from the minibuffer, the
-;;     minibuffer uses the Emacs Lisp Mode syntax table.  (Emacs 19.18 or
-;;     later only.)
-;;
-;;   * If you type an incomplete or otherwise syntactically invalid
-;;     expression (e.g. you forget a closing paren), you can fix your
-;;     mistake without having to type it all over again.
-;;
-;;   * Displays the result in a buffer if it is too big to fit in the echo
-;;     area.  This buffer is placed in Emacs Lisp Mode.
-;;     (If you give a prefix arg, the result is placed in the current
-;;     buffer instead of the echo area or a separate temporary buffer.)
-;;
-;;   * The variables `eval-expr-print-level' and `eval-expr-print-length'
-;;     can be used to constrain the attempt to print recursive data
-;;     structures.  These variables are independent of the global
-;;     `print-level' and `print-length' variables so that eval-expression
-;;     can be used more easily for debugging.
-
-;; This program is loosely based on an earlier implemention written by Joe
-;; Wells  called eval-expression-fix.el (last revised
-;; 1991-10-12).  That version was originally written for Emacs 18 and,
-;; while it worked with some quirky side effects in Emacs 19, created even
-;; more problems in Emacs 20 and didn't work in XEmacs at all.
-;;
-;; This rewrite should work in Emacs 19.18 or later, Emacs 20,
-;; and any version of XEmacs.  It will not work in Emacs 18.
-
-;;; Code:
-
-;;;###autoload
-(defvar eval-expr-error-message-delay 3
-  "*Amount of time, in seconds, to display in echo area before continuing.")
-
-;;;###autoload
-(defvar eval-expr-prompt "Eval: "
-  "*Prompt used by eval-expr.")
-
-;;;###autoload
-(defvar eval-expr-honor-debug-on-error t
-  "*If non-nil, do not trap evaluation errors.
-Instead, allow errors to throw user into the debugger, provided
-debug-on-error specifies that the particular error is a debuggable condition.")
-
-;;;###autoload
-(defvar eval-expr-print-level  (default-value 'print-level)
-  "*Like print-level, but affect results printed by `eval-expr' only.")
-
-;;;###autoload
-(defvar eval-expr-print-length (default-value 'print-length)
-  "*Like print-length, but affect results printed by `eval-expr' only.")
-
-(defvar eval-expr-output-buffer-name "*Eval Expression Output*")
-(defvar eval-expr-error-buffer-name  "*Eval Expression Error*")
-
-(defvar eval-expr-whitespace
-  (mapcar 'string-to-char '(" " "\t" "\n")))
-
-(defalias 'eval-expr-orig-command nil)
-
-
-;;;###autoload
-(defun eval-expr-install ()
-  "Replace standard eval-expression command with enhanced eval-expr."
-  (interactive)
-  (or (symbol-function 'eval-expr-orig-command)
-      (fset 'eval-expr-orig-command (symbol-function 'eval-expression)))
-  (defalias 'eval-expression 'eval-expr))
-
-(defun eval-expr-uninstall ()
-  "Restore original, unenhanced eval-expression command."
-  (interactive)
-  (fset 'eval-expression (symbol-function 'eval-expr-orig-command)))
-
-;;;###autoload
-(defun eval-expr (ee::expression &optional ee::insert-value)
-  "Evaluate EXPRESSION and print value in minibuffer, temp, or current buffer.
-A temp output buffer is used if there is more than one line in the
-evaluated result.
-If invoked with a prefix arg, or second lisp argument EE::INSERT-VALUE is
-non-nil, then insert final value into the current buffer at point.
-
-Value is also consed on to front of the variable `values'."
-  (interactive (list (eval-expr-read-lisp-object-minibuffer eval-expr-prompt)
-                     current-prefix-arg))
-  (let* ((ee::error nil)
-         (ee::result (cond ((and eval-expr-honor-debug-on-error
-                                 debug-on-error)
-                            (eval ee::expression))
-                           (t
-                            (condition-case ee::err-data
-                                (eval ee::expression)
-                              (error
-                               (setq ee::error ee::err-data)))))))
-    (cond (ee::error
-           (eval-expr-error-message ee::error nil t)
-           (beep t))
-          (ee::insert-value
-           (eval-expr-print 'prin1 ee::result (current-buffer)))
-          (t
-           (setq values (cons ee::result values))
-           (eval-expr-display-message eval-expr-output-buffer-name
-             (function (lambda ()
-                         (eval-expr-print 'prin1 ee::result))))))
-    ee::result))
-
-(defun eval-expr-read-lisp-object-minibuffer (prompt &optional input)
-  (or (null input)
-      (setq input (eval-expr-print 'prin1-to-string input)))
-
-  (let ((minibuffer-setup-hook minibuffer-setup-hook)
-        (retry t)
-        (result nil)
-	(expr nil)
-        (index nil)
-        (i 0))
-    (add-hook 'minibuffer-setup-hook 'eval-expr-minibuffer-setup)
-    (while retry
-      (condition-case err-data
-          (progn
-            (setq input
-                  (read-from-minibuffer prompt
-                                        (if (numberp index)
-                                            (cons input (1+ index))
-                                          input)
-                                        (and (boundp 'read-expression-map)
-                                             read-expression-map)
-                                        nil
-                                        'read-expression-history))
-
-            (setq index nil)
-            (setq result (read-from-string input))
-            (setq expr (car result))
-            (setq index (cdr result))
-            (setq i index)
-
-            ;; This mimics a useful test done in read_minbuf (which is
-            ;; called by Fread_from_minibuffer) when expflag is true.  But
-            ;; this test doesn't happen when calling Fread_from_string
-            ;; directly as we've done here, so do it now in lisp.
-            (while (< i (length input))
-              (or (memq (aref input i) eval-expr-whitespace)
-                  (error "Trailing garbage following expression"))
-              (setq i (1+ i)))
-
-            (setq retry nil))
-	(error
-         (eval-expr-error-message err-data t))))
-    expr))
-
-(defun eval-expr-minibuffer-setup ()
-  (set-syntax-table emacs-lisp-mode-syntax-table))
-
-
-;;; Display routines
-
-(defun eval-expr-error-message (condition-data &optional waitp raw-error)
-  (let ((error (car condition-data))
-        (data  (cdr condition-data))
-        (cursor-in-echo-area t)
-        (error-str nil))
-
-    (and (consp error)
-         (null (cdr error))
-         (setq error (car error)))
-
-    (and (consp data)
-         (null (cdr data))
-         (setq data (car data)))
-
-    (and (symbolp error)
-         (not raw-error)
-         (setq error-str (get error 'error-message)))
-
-    (and (eval-expr-display-message eval-expr-error-buffer-name
-           (cond ((null data)
-                  (format "Error: %s" (or error-str error)))
-                 ((eq error 'error)
-                  (format "Error: %s" data))
-                 (error-str
-                  (format "%s: %s" error-str data))
-                 (t
-                  (format "Error: %s; Data: %s" error data))))
-         waitp
-         (sit-for eval-expr-error-message-delay))))
-
-(defun eval-expr-display-message (output-buffer thunk)
-  (let* ((buffer (generate-new-buffer " *"))
-         (standard-output buffer)
-         (echo-area-p t))
-    (save-excursion
-      (set-buffer buffer)
-      (cond ((stringp thunk)  ; this is a cheat
-             (insert thunk))
-            (t
-             (funcall thunk)))
-      (goto-char (point-min))
-      (move-to-column (1- (frame-width)))
-      (cond ((and (eobp)
-                  (< (point) (window-width (minibuffer-window))))
-             (message "%s" (buffer-substring (point-min) (point-max))))
-            (t
-             (setq echo-area-p nil)
-             (with-output-to-temp-buffer output-buffer
-               (save-excursion
-                 (set-buffer output-buffer)
-                 (or (eq major-mode 'emacs-lisp-mode)
-                     (emacs-lisp-mode))
-                 (insert-buffer buffer))))))
-    (kill-buffer buffer)
-    echo-area-p))
-
-(put 'eval-expr-display-message 'lisp-indent-function 1)
-
-(defun eval-expr-print (func &rest args)
-  (let ((print-level  eval-expr-print-level)
-        (print-length eval-expr-print-length))
-    (apply func args)))
-
-(provide 'eval-expr)
-
-;;; eval-expr.el ends here.
diff --git a/xemacs-packages/lisp/xemacs-devel/find-func.el b/xemacs-packages/lisp/xemacs-devel/find-func.el
deleted file mode 100644
index 75c34981..00000000
--- a/xemacs-packages/lisp/xemacs-devel/find-func.el
+++ /dev/null
@@ -1,403 +0,0 @@
-;;; find-func.el --- find the definition of the Emacs Lisp function near point
-
-;; Copyright (C) 1997, 1999, 2001, 2004  Free Software Foundation, Inc.
-
-;; Author: Jens Petersen 
-;; Maintainer: petersen@kurims.kyoto-u.ac.jp
-;; Keywords: emacs-lisp, functions, variables
-;; Created: 97/07/25
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 21.3.
-
-;;; Commentary:
-;;
-;; The funniest thing about this is that I can't imagine why a package
-;; so obviously useful as this hasn't been written before!!
-;; 
-;; The default keybindings are the ones protected by autoload cookies at
-;; the bottom of this file.  It does pretty much what you would expect,
-;; putting the cursor at the definition of the function or variable at
-;; point.
-;;
-;; In XEmacs the source filename of every dumped or loaded Lisp symbol
-;; definition is now recorded in `load-history'.  So in XEmacs all
-;; non-primitive functions and variables can be found in principle.  (I
-;; say "in principle" since the system is not perfect.  For example
-;; although it is unusual it can happen that say a variable and function
-;; of the same name are defined in different files, which may lead to
-;; incorrect results.)  Unfortunately in Emacs, only symbols loaded from
-;; startup can be found.  It would be nice if the location of primitive
-;; functions in the C code was also recorded!
-
-;; The code started out from `describe-function', `describe-key'
-;; ("help.el") and `fff-find-loaded-emacs-lisp-function' (Noah Friedman's
-;; "fff.el").
-
-;;; Problems:
-;;
-;; o `find-function-other-frame' is not quite right when the
-;; function is in the current buffer.
-;;
-
-;;;; Code:
-
-(require 'loadhist)
-
-;;; User variables:
-
-(defgroup find-function nil
-  "Finds the definition of the Emacs Lisp symbol near point."
-;;   :prefix "find-function"
-  :group 'lisp)
-
-(defconst find-function-space-re "\\(?:\\s-\\|\n\\|;.*\n\\)+")
-
-(defcustom find-function-regexp
-  ;; Match things like (defun foo ...), (defmacro foo ...),
-  ;; (define-skeleton foo ...), (define-generic-mode 'foo ...),
-  ;;  (define-derived-mode foo ...), (define-minor-mode foo)
-  (concat
-   "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
-ine-function\\|ine-obsolete-function-alias\\|ine-compatible-function-alias\\|\
-\[^cgv\W]\\w+\\*?\\)\\|define-minor-mode\
-\\|easy-mmode-define-global-mode\\)" find-function-space-re
-   "\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)")
-  "The regexp used by `find-function' to search for a function definition.
-Note it must contain a `%s' at the place where `format'
-should insert the function name.  The default value avoids `defconst',
-`defgroup', `defvar'.
-
-Please send improvements and fixes to the maintainer."
-  :type 'regexp
-  :group 'find-function)
-
-(defcustom find-variable-regexp
-  (concat "^\\s-*(\\(def[^umag\W]\\(\\w\\|\\s_\\)+\\*?\\|define-obsolete-variable-alias\\|define-compatible-variable-alias\\)"
-	  find-function-space-re "%s\\(\\s-\\|$\\)")
-  "The regexp used by `find-variable' to search for a variable definition.
-It should match right up to the variable name.  The default value
-avoids `defun', `defmacro', `defalias', `defadvice', `defgroup'.
-
-Please send improvements and fixes to the maintainer."
-  :type 'regexp
-  :group 'find-function)
-
-(defcustom find-function-source-path nil
-  "The default list of directories where `find-function' searches.
-
-If this variable is nil then `find-function' searches `load-path' by
-default."
-  :type '(repeat directory)
-  :group 'find-function)
-
-(defcustom find-function-recenter-line 1
-  "The window line-number from which to start displaying a symbol definition.
-A value of nil implies center the beginning of the definition.
-See the function `center-to-window-line' for more information, and
-`find-function' and `find-variable'."
-  :type '(choice (const :tag "Center" nil)
-		 integer)
-  :group 'find-function)
-
-(defcustom find-function-after-hook nil
-  "Hook run after finding symbol definition.
-
-See the functions `find-function' and `find-variable'."
-  :group 'find-function)
-
-;;; Functions:
-
-;; XEmacs omission: Emacs has find-library and supporting friends here.
-;; We have the equivalent in lib-complete.el in core.
-
-;;;###autoload
-(defun find-function-search-for-symbol (symbol variable-p library)
-  "Search for SYMBOL in LIBRARY.
-If VARIABLE-P is nil, `find-function-regexp' is used, otherwise
-`find-variable-regexp' is used."
-  (if (null library)
-      (error "Don't know where `%s' is defined" symbol))
-  ;; We deviate significantly from Emacs here, due to our distinct
-  ;; find-library implementations.
-  (if (string-match "\\.el\\(c\\)\\'" library)
-      (setq library (substring library 0 (match-beginning 1))))
-  (let* ((path find-function-source-path)
-	 (filename (if (file-exists-p library)
-		       library
-		     ;; use `file-name-sans-extension' here? (if it gets fixed)
-		     (if (string-match "\\(\\.el\\)\\'" library)
-			 (setq library (substring library 0
-						  (match-beginning 1))))
-		     (or (locate-library (concat library ".el") t path)
-			 (locate-library library t path)))))
-    (if (not filename)
-	(error "The library \"%s\" is not in the path." library))
-    (with-current-buffer (find-file-noselect filename)
-      (save-match-data
-	(let ((regexp (format (if variable-p
-				  find-variable-regexp
-				find-function-regexp)
-			      (regexp-quote (symbol-name symbol))))
-	      (case-fold-search))
-	  (with-syntax-table emacs-lisp-mode-syntax-table
-	    (goto-char (point-min))
-	    (if (or (re-search-forward regexp nil t)
-		    (re-search-forward
-		     (concat "^([^ ]+" find-function-space-re "['(]"
-			     (regexp-quote (symbol-name symbol))
-			     "\\>")
-		     nil t))
-		(progn
-		  (beginning-of-line)
-		  (cons (current-buffer) (point)))
-	      (error "Cannot find definition of `%s' in library `%s'"
-		     symbol library))))))))
-
-;;;###autoload
-(defun find-function-noselect (function)
-  "Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
-
-Finds the Emacs Lisp library containing the definition of FUNCTION
-in a buffer and the point of the definition.  The buffer is
-not selected.
-
-If the file where FUNCTION is defined is not known, then it is
-searched for in `find-function-source-path' if non nil, otherwise
-in `load-path'."
-  (if (not function)
-      (error "You didn't specify a function"))
-  (let ((def (symbol-function function))
-	aliases)
-    (while (symbolp def)
-      (or (eq def function)
-	  (if aliases
-	      (setq aliases (concat aliases
-				    (format ", which is an alias for `%s'"
-					    (symbol-name def))))
-	    (setq aliases (format "`%s' an alias for `%s'"
-				  function (symbol-name def)))))
-      (setq function (symbol-function function)
-	    def (symbol-function function)))
-    ;; XEmacs difference: check for primitive functions a bit differently
-    (and (subrp (symbol-function function))
-         (if aliases
-             (error "%s which is a primitive function" aliases)
-       (error "%s is a primitive function" function)))
-    (if aliases
-	(message aliases))
-    (let ((library
-	   (cond ((eq (car-safe def) 'autoload)
-		  (nth 1 def))
-		 ((symbol-file function))
-		 ;; XEmacs addition: function annotations
-		 ((fboundp 'compiled-function-annotation)
-		  (cond ((compiled-function-p def)
-			 (file-name-sans-extension
-			  (compiled-function-annotation def)))
-			((eq 'macro (car-safe def))
-			 (and (compiled-function-p (cdr def))
-			      (file-name-sans-extension
-			       (compiled-function-annotation (cdr def))))))))))
-      (find-function-search-for-symbol function nil library))))
-
-;; XEmacs change: these functions are defined in help.el
-;(defalias 'function-at-point 'function-called-at-point)
-
-(defun find-function-read (&optional variable-p)
-  "Read and return an interned symbol, defaulting to the one near point.
-
-If the optional VARIABLE-P is nil, then a function is gotten
-defaulting to the value of the function `function-at-point', otherwise
-a variable is asked for, with the default coming from
-`variable-at-point'."
-  (let ((symb (funcall (if variable-p
-			   'variable-at-point
-			 'function-at-point)))
-	(enable-recursive-minibuffers t)
-	val)
-    (if (equal symb 0)
-	(setq symb nil))
-    (setq val (if variable-p
-		  (completing-read
-		   (concat "Find variable"
-			   (if symb
-			       (format " (default %s)" symb))
-			   ": ")
-		   obarray 'boundp t nil 'variable-history)
-		(completing-read
-		 (concat "Find function"
-			 (if symb
-			     (format " (default %s)" symb))
-			 ": ")
-		 obarray 'fboundp t nil 'function-history)))
-    (list (if (equal val "")
-	      symb
-	    (intern val)))))
-
-(defun find-function-do-it (symbol variable-p switch-fn)
-  "Find Emacs Lisp SYMBOL in a buffer and display it with SWITCH-FN.
-If VARIABLE-P is nil, a function definition is searched for, otherwise 
-a variable definition is searched for.  The start of a definition is
-centered according to the variable `find-function-recenter-line'.
-See also `find-function-after-hook'.
-
-Point is saved in the buffer if it is one of the current buffers."
-  (let* ((orig-point (point))
-	 (orig-buffers (buffer-list))
-	 (buffer-point (save-excursion
-			 (funcall (if variable-p
-				      'find-variable-noselect
-				    'find-function-noselect)
-				  symbol)))
-	 (new-buf (car buffer-point))
-	 (new-point (cdr buffer-point)))
-    (when buffer-point
-      (when (memq new-buf orig-buffers)
-	(push-mark orig-point))
-      (funcall switch-fn new-buf)
-      (goto-char new-point)
-      (recenter find-function-recenter-line)
-      (run-hooks 'find-function-after-hook))))
-
-;;;###autoload
-(defun find-function (function)
-  "Find the definition of the function near point in the current window.
-
-Finds the Emacs Lisp library containing the definition of the function
-near point (selected by `function-at-point') in a buffer and
-places point before the definition.  Point is saved in the buffer if
-it is one of the current buffers.
-
-The library where FUNCTION is defined is searched for in
-`find-function-source-path', if non nil, otherwise in `load-path'.
-See also `find-function-recenter-line' and `find-function-after-hook'."
-  (interactive (find-function-read))
-  (find-function-do-it function nil 'switch-to-buffer))
-
-;;;###autoload
-(defun find-function-other-window (function)
-  "Find the definition of the function near point in another window.
-
-See `find-function' for more details."
-  (interactive (find-function-read))
-  (find-function-do-it function nil 'switch-to-buffer-other-window))
-
-;;;###autoload
-(defun find-function-other-frame (function)
-  "Find the definition of the function near point in another frame.
-
-See `find-function' for more details."
-  (interactive (find-function-read))
-  (find-function-do-it function nil 'switch-to-buffer-other-frame))
-
-;;;###autoload
-(defun find-variable-noselect (variable &optional file)
-  "Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL.
-
-Finds the Emacs Lisp library containing the definition of SYMBOL
-in a buffer and the point of the definition.  The buffer is
-not selected.
-
-The library where VARIABLE is defined is searched for in FILE or
-`find-function-source-path', if non nil, otherwise in `load-path'."
-  (if (not variable)
-      (error "You didn't specify a variable"))
-  (and (built-in-variable-type variable)
-       (error "%s is a primitive variable" variable))
-  (let ((library (or file (symbol-file variable))))
-    (find-function-search-for-symbol variable 'variable library)))
-
-;;;###autoload
-(defun find-variable (variable)
-  "Find the definition of the variable near point in the current window.
-
-Finds the Emacs Lisp library containing the definition of the variable
-near point (selected by `variable-at-point') in a buffer and
-places point before the definition.  Point is saved in the buffer if
-it is one of the current buffers.
-
-The library where VARIABLE is defined is searched for in
-`find-function-source-path', if non nil, otherwise in `load-path'.
-See also `find-function-recenter-line' and `find-function-after-hook'."
-  (interactive (find-function-read 'variable))
-  (find-function-do-it variable t 'switch-to-buffer))
-
-;;;###autoload
-(defun find-variable-other-window (variable)
-  "Find the definition of the variable near point in another window.
-
-See `find-variable' for more details."
-  (interactive (find-function-read 'variable))
-  (find-function-do-it variable t 'switch-to-buffer-other-window))
-
-;;;###autoload
-(defun find-variable-other-frame (variable)
-  "Find the definition of the variable near point in another frame.
-
-See `find-variable' for more details."
-  (interactive (find-function-read 'variable))
-  (find-function-do-it variable t 'switch-to-buffer-other-frame))
-
-;;;###autoload
-(defun find-function-on-key (key)
-  "Find the function that KEY invokes.  KEY is a string.
-Point is saved if FUNCTION is in the current buffer."
-  (interactive "kFind function on key: ")
-  ;; XEmacs change: Avoid the complex menu code with key-or-menu-binding
-  (let ((defn (key-or-menu-binding key))
-	(key-desc (key-description key)))
-    (if (or (null defn) (integerp defn))
-        (message "%s is unbound" key-desc)
-      (if (consp defn)
-	  (message "%s runs %s" key-desc (prin1-to-string defn))
-	(find-function-other-window defn)))))
-
-;;;###autoload
-(defun find-function-at-point ()
-  "Find directly the function at point in the other window."
-  (interactive)
-  (let ((symb (function-at-point)))
-    (when symb
-      (find-function-other-window symb))))
-
-;;;###autoload
-(defun find-variable-at-point ()
-  "Find directly the function at point in the other window."
-  (interactive)
-  (let ((symb (variable-at-point)))
-    (when (and symb (not (equal symb 0)))
-      (find-variable-other-window symb))))
-
-;; XEmacs change: autoload instead of defining find-function-setup-keys
-;; FIXME: We do not have a default keybinding for find-function
-;; (define-key ctl-x-map "F" 'find-function) ; conflicts with `facemenu-keymap'
-;;;###autoload(define-key ctl-x-4-map "F" 'find-function-other-window)
-;;;###autoload(define-key ctl-x-5-map "F" 'find-function-other-frame)
-;;;###autoload(define-key ctl-x-map "K" 'find-function-on-key)
-;;;###autoload(define-key ctl-x-map "V" 'find-variable)
-;;;###autoload(define-key ctl-x-4-map "V" 'find-variable-other-window)
-;;;###autoload(define-key ctl-x-5-map "V" 'find-variable-other-frame)
-;;;###autoload(define-key help-mode-map "F" 'find-function-at-point)
-;;;###autoload(define-key help-mode-map "V" 'find-variable-at-point)
-
-(provide 'find-func)
-
-;;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64
-;;; find-func.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/find-gc.el b/xemacs-packages/lisp/xemacs-devel/find-gc.el
deleted file mode 100644
index e50215ec..00000000
--- a/xemacs-packages/lisp/xemacs-devel/find-gc.el
+++ /dev/null
@@ -1,160 +0,0 @@
-;;; find-gc.el --- detect functions that call the garbage collector
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: maint
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.30.
-
-;;; #### before this is really usable, it should be rewritten to call
-;;; Makefile to compile the files.
-
-;;; Commentary:
-
-;;; Produce in unsafe-list the set of all functions that may invoke GC.
-;;; This expects the Emacs sources to live in emacs-source-directory.
-;;; It creates a temporary working directory /tmp/esrc.
-
-;;; Code:
-
-(defvar unsafe-list nil)
-(defvar subrs-used nil)
-(defvar subrs-called nil)
-
-;; Set this to point to your XEmacs source directory.
-(defvar emacs-source-directory "/usr/src/xemacs/xemacs-20/src")
-
-;;; Functions on this list are safe, even if they appear to be able
-;;; to call the target.
-
-(defvar noreturn-list '(signal_error error Fthrow wrong_type_argument))
-
-;;; Try to load generated source-files
-(load-library (concat emacs-source-directory "/../lisp/source-files.el"))
-
-(defvar source-files nil
-  "Set this to the source files you want to check.")
-
-;;;
-
-(defun find-gc-unsafe ()
-  (setq subrs-used nil)
-  (trace-call-tree t nil)
-  (trace-use-tree)
-  (set-buffer (get-buffer-create "*gc-tmp*"))
-  (erase-buffer)
-  (find-unsafe-funcs 'Fgarbage_collect)
-  (setq unsafe-list (sort unsafe-list 'find-gc-sort-p))
-  (insert (format "%s\n" unsafe-list))
-  (setq unsafe-list nil)
-  (find-unsafe-funcs 'garbage_collect_1)
-  (setq unsafe-list (sort unsafe-list 'find-gc-sort-p))
-  (insert (format "%s\n" unsafe-list))
-  (goto-char (point-min))
-  (while (search-forward ") (" nil t)
-    (replace-match ")
- (" nil t))
-  )
-
-(defun find-gc-sort-p (x y)
-  (string-lessp (car x) (car y)))
-
-;;; This does a depth-first search to find all functions that can
-;;; ultimately call the function "target".  The result is an a-list
-;;; in unsafe-list; the cars are the unsafe functions, and the cdrs
-;;; are (one of) the unsafe functions that these functions directly
-;;; call.
-
-(defun find-unsafe-funcs (target)
-  (setq unsafe-list (list (list target)))
-  (trace-unsafe target))
-
-(defun trace-unsafe (func)
-  (let ((used (assq func subrs-used)))
-    (or used
-	(error "No subrs-used for %s" (car unsafe-list)))
-    (while (setq used (cdr used))
-      (or (assq (car used) unsafe-list)
-	  (memq (car used) noreturn-list)
-	  (progn
-	    (setq unsafe-list (cons (cons (car used) func) unsafe-list))
-	    (trace-unsafe (car used)))))))
-
-
-;;; This produces an a-list of functions in subrs-called.  The cdr of
-;;; each entry is a list of functions which the function in car calls.
-
-(defun trace-call-tree (&optional make-all delete-after)
-  (save-excursion
-    (setq subrs-called nil)
-    (let ((case-fold-search nil)
-	  name entry file)
-      ;; Stage one, make rtl files with make
-      (if make-all
-	  (call-process 
-	   "sh" nil nil nil "-c" 
-	   (format "cd %s; make dortl" emacs-source-directory file))
-	(dolist (file source-files)
-	  (princ (format "Compiling %s...\n" file))
-	  (call-process 
-	   "sh" nil nil nil "-c" 
-	   (format "cd %s; make %s.rtl" emacs-source-directory file))))
-      (set-buffer (get-buffer-create "*Trace Call Tree*"))
-      ;; Stage two, process them
-      (dolist (file source-files)
-	(erase-buffer)
-	(insert-file-contents (concat emacs-source-directory "/" file ".rtl"))
-	(while (re-search-forward ";; Function \\|(call_insn " nil t)
-          (if (= (char-after (- (point) 3)) ?o)
-              (progn
-                (looking-at "[a-zA-Z0-9_]+")
-                (setq name (intern (buffer-substring (match-beginning 0)
-                                                     (match-end 0))))
-                (princ (format "%s : %s\n" file name))
-                (setq entry (list name)
-                      subrs-called (cons entry subrs-called)))
-            (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"")
-                (progn
-                  (setq name (intern (buffer-substring (match-beginning 1)
-                                                       (match-end 1))))
-                  (or (memq name (cdr entry))
-                      (setcdr entry (cons name (cdr entry)))))))))
-      (when delete-after
-	(dolist (file source-files)
-	  (delete-file (concat emacs-source-directory "/" file ".rtl"))))
-	    )))
-
-
-;;; This produces an inverted a-list in subrs-used.  The cdr of each
-;;; entry is a list of functions that call the function in car.
-
-(defun trace-use-tree ()
-  (setq subrs-used (mapcar 'list (mapcar 'car subrs-called)))
-  (let ((ptr subrs-called)
-	p2 found)
-    (while ptr
-      (setq p2 (car ptr))
-      (while (setq p2 (cdr p2))
-	(if (setq found (assq (car p2) subrs-used))
-	    (setcdr found (cons (car (car ptr)) (cdr found)))))
-      (setq ptr (cdr ptr)))))
-
-;;; find-gc.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/hide-copyleft.el b/xemacs-packages/lisp/xemacs-devel/hide-copyleft.el
deleted file mode 100644
index ebb384f1..00000000
--- a/xemacs-packages/lisp/xemacs-devel/hide-copyleft.el
+++ /dev/null
@@ -1,161 +0,0 @@
-;;; hide-copyleft.el --- hide obnoxious copyright prologs
-
-;; Copyright (C) 1997 Sun Microsystems.
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Commentary:
-
-;; Written by Jamie Zawinski , 19-jan-91.
-;; Minor fixes by Martin Buchholz, 14-may-97.
-;; Last modified  14-may-97.
-;;
-;; I sometimes find it tiresome to have fifteen lines of copyright notice at
-;; the beginning of each file.  Meta-< does not take you to the beginning of
-;; the code, it takes you a windowfull or two away, which can be tedious on
-;; slow terminal lines.
-;;
-;; I know what the copyright notice says; so this code makes all but the first
-;; line of it be invisible, by using Emacs's selective-display feature.  The
-;; text is still present and unmodified, but it is invisible.
-;;
-;; Elide the copyright notice with "Meta-X hide-copyleft-region".  Make it
-;; visible again with "Control-U Meta-X hide-copyleft-region".  Or, if you're
-;; sure you're not gonna get sued, you can do something like this in your
-;; .emacs file:
-;;
-;;       (autoload 'hide-copyleft-region   "hide-copyleft" nil t)
-;;       (autoload 'unhide-copyleft-region "hide-copyleft" nil t)
-;;       (add-hook 'emacs-lisp-mode-hook 'hide-copyleft-region)
-;;       (add-hook 'c-mode-hook 'hide-copyleft-region)
-;;
-;; This code (obviously) has quite specific knowledge of the wording of the 
-;; various copyrights I've run across.  Let me know if you find one on which
-;; it fails.
-
-(defgroup hide-copyleft nil
-  "Hide copyright prologs."
-  :group 'matching)
-
-(defcustom copylefts-to-hide
-  ;; There are some extra backslashes in these strings to prevent this code
-  ;; from matching the definition of this list as the copyright notice!
-  '(;; GNU
-    ("free software\; you can redistribute it" .
-     "notice must be\ preserved on all")
-    ("free software\; you can redistribute it" .
-     "copy of the GNU General Public License.*\n?.*\n?.*\n?.*\n?.*\\(02139,\\|02111-1307\\)")
-    ("distributed in the hope that it will be useful\," .
-     "notice must be\ preserved on all")
-    ("free software\; you can redistribute it" .
-     "General Public License for more details\\.")
-    ;; X11
-    ("Permission to use\, copy, modify," .
-     "WITH THE USE OR PERFORMANCE")
-    ("Permission to use\, copy, modify," .
-     "without express or implied warranty")
-    ;; Motif
-    ("Copyright.*OPEN\ SOFTWARE FOUNDATION" .
-     "X Window System is a trademark of the")
-    ("THIS SOFTWARE\ IS FURNISHED UNDER A LICENSE" .
-     "X Window System is a trademark of the")
-    ;; UPenn
-    ("Permission to use\, copy, and distribute" .
-     " provided \"as is\" without")
-    ;; Evans & Sutherland, Solbourne.
-    ("Copyright 19[0-9][0-9] by " .
-     "OR PERFORMANCE OF THIS SOFTWARE\\.")
-    ;; TI Explorer
-    ("RESTRICTED RIGHTS LEGEND" . "All rights reserved\\.\\(\n;;; ?$\\)?")
-    ("^%%BeginDocumentation" . "^%%EndDocumentation")
-    )
-  "An alist of pairs of regexps which delimit copyright notices to hide.
-The first one found is hidden, so order is significant."
-  :group 'hide-copyleft
-  :type '(repeat (cons (regexp :tag "Top line")
-		       (regexp :tag "Bottom line"))))
-
-;;;###autoload
-(defun hide-copyleft-region (&optional arg)
-  "Make the legal drivel at the front of this file invisible.  Unhide it again
-with C-u \\[hide-copyleft-region]."
-  (interactive "P")
-  (if arg
-      (unhide-copyleft-region)
-    (save-excursion
-     (save-restriction
-      (if selective-display (error "selective-display is already on."))
-      (catch 'Abort
-	(let ((mod-p (buffer-modified-p))
-	      (buffer-read-only nil)
-	      (rest copylefts-to-hide)
-	      pair start end)
-	  (widen)
-	  (goto-char (point-min))
-	  (while (and rest (not pair))
-	    (save-excursion
-	      (and (re-search-forward (car (car rest)) nil t)
-		   (setq start (point))
-		   (re-search-forward (cdr (car rest)) nil t)
-		   (setq end (point)
-			 pair (car rest))))
-	    (setq rest (cdr rest)))
-	  (or pair
-	      (if (interactive-p)
-		  (error "Couldn't find a CopyLeft to hide.")
-		(throw 'Abort nil)))
-	  (goto-char end)
-	  (forward-line 1)
-	  ;; If the last line of the notice closes a C comment, don't
-	  ;; hide that line (to avoid confusion...)
-	  (if (save-excursion (forward-char -3) (looking-at "\\*/"))
-	      (forward-line -1))
-	  (setq end (point))
-	  (goto-char start)
-	  (forward-line 1)
-	  (while (< (point) end)
-	    (delete-char -1)
-	    (insert "\^M")
-	    (forward-line 1))
-	  (setq selective-display t)
-	  (set-buffer-modified-p mod-p)))))))
-
-;;;###autoload
-(defun unhide-copyleft-region ()
-  (interactive)
-  "If the legal nonsense at the top of this file is elided, make it visible again."
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (let ((mod-p (buffer-modified-p))
-	    (buffer-read-only nil)
-	    end)
-	(or (search-forward "\^M" nil t) (error "Nothing hidden here, dude."))
-	(end-of-line)
-	(setq end (point))
-	(beginning-of-line)
-	(while (search-forward "\^M" end t)
-	  (delete-char -1)
-	  (insert "\^J"))
-	(set-buffer-modified-p mod-p)
-	(setq selective-display nil)))))
-
-(provide 'hide-copyleft)
-
-;;; hide-copyleft.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/ielm.el b/xemacs-packages/lisp/xemacs-devel/ielm.el
deleted file mode 100644
index 90875c7a..00000000
--- a/xemacs-packages/lisp/xemacs-devel/ielm.el
+++ /dev/null
@@ -1,493 +0,0 @@
-;;; ielm.el --- interaction mode for Emacs Lisp
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: David Smith 
-;; Maintainer: FSF
-;; Created: 25 Feb 1994
-;; Keywords: lisp
-
-;; 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:
-
-;; Provides a nice interface to evaluating Emacs Lisp expressions.
-;; Input is handled by the comint package, and output is passed
-;; through the pretty-printer.
-
-;; To install: copy this file to a directory in your load-path, and
-;; add the following line to your .emacs file:
-;;
-;;   (autoload 'ielm "ielm" "Start an inferior Emacs Lisp session" t)
-;;
-;; For completion to work, the comint.el from Emacs 19.23 is
-;; required.  If you do not have it, or if you are running Lemacs,
-;; also add the following code to your .emacs:
-;;
-;;    (setq ielm-mode-hook
-;; 	    '(lambda nil
-;; 		 (define-key ielm-map "\t"
-;; 		    '(lambda nil (interactive) (or (ielm-tab) 
-;;                                                 (lisp-complete-symbol))))))
-
-;; To start: M-x ielm.  Type C-h m in the *ielm* buffer for more info.
-
-;; The latest version is available by WWW from 
-;;      http://mathssun5.lancs.ac.uk:2080/~maa036/elisp/dir.html
-;; or by anonymous FTP from
-;;      /anonymous@wingra.stat.wisc.edu:pub/src/emacs-lisp/ielm.el.gz
-;; or from the author: David M. Smith 
-
-;;; Code:
-
-(require 'comint)
-(require 'pp)
-
-;;; User variables
-
-(defgroup ielm nil
-  "Interaction mode for Emacs Lisp."
-  :group 'lisp)
-
-
-(defcustom ielm-noisy t
-  "*If non-nil, IELM will beep on error."
-  :type 'boolean
-  :group 'ielm)
-
-(defvar ielm-prompt "ELISP> "
-  "Prompt used in IELM.")
-
-(defcustom ielm-dynamic-return t
-  "*Controls whether \\\\[ielm-return] has intelligent behaviour in IELM.
-If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline
-and indents for incomplete sexps.  If nil, always inserts newlines."
-  :type 'boolean
-  :group 'ielm)
-
-(defcustom ielm-dynamic-multiline-inputs t
-  "*Force multiline inputs to start from column zero?
-If non-nil, after entering the first line of an incomplete sexp, a newline
-will be inserted after the prompt, moving the input to the next line.
-This gives more frame width for large indented sexps, and allows functions
-such as `edebug-defun' to work with such inputs."
-  :type 'boolean
-  :group 'ielm)
-
-(defcustom ielm-mode-hook nil
-  "*Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started."
-  :type 'hook
-  :group 'ielm)
-
-;;; System variables
-
-(defvar ielm-working-buffer nil
-  "Buffer in which IELM sexps will be evaluated.
-This variable is buffer-local.")
-
-(defvar ielm-header 
-  "*** Welcome to IELM ***  Type (describe-mode) for help.\n"
-  "Message to display when IELM is started.")
-
-(defvar ielm-map nil)
-(if ielm-map nil
-  (if (string-match "Lucid" emacs-version)
-      ;; Lemacs
-      (progn
-	(setq ielm-map (make-sparse-keymap))
-	(set-keymap-parent ielm-map comint-mode-map))
-    ;; FSF
-    (setq ielm-map (cons 'keymap comint-mode-map)))
-  (define-key ielm-map "\t" 'comint-dynamic-complete)
-  (define-key ielm-map "\C-m" 'ielm-return)
-  (define-key ielm-map "\C-j" 'ielm-send-input)
-  (define-key ielm-map "\e\C-x" 'eval-defun)         ; for consistency with
-  (define-key ielm-map "\e\t" 'lisp-complete-symbol) ; lisp-interaction-mode
-  ;; These bindings are from shared-lisp-mode-map -- can you inherit
-  ;; from more than one keymap??
-  (define-key ielm-map "\e\C-q" 'indent-sexp)      
-  (define-key ielm-map "\177" 'backward-delete-char-untabify)
-  ;; Some convenience bindings for setting the working buffer
-  (define-key ielm-map "\C-c\C-b" 'ielm-change-working-buffer)
-  (define-key ielm-map "\C-c\C-f" 'ielm-display-working-buffer)
-  (define-key ielm-map "\C-c\C-v" 'ielm-print-working-buffer))
-
-(defvar ielm-font-lock-keywords
-  (list 
-   (cons (concat "^" (regexp-quote ielm-prompt)) 'font-lock-keyword-face)
-   '("\\(^\\*\\*\\*[^*]+\\*\\*\\*\\)\\(.*$\\)" (1 font-lock-comment-face) (2 font-lock-reference-face)))
-  "Additional expressions to highlight in ielm buffers.")
-	
-;;; Completion stuff
-
-(defun ielm-tab nil
-  "Possibly indent the current line as lisp code."
-  (interactive)
-  (if (or (eq (preceding-char) ?\n)
-	  (eq (char-syntax (preceding-char)) ? ))
-      (progn
-	(ielm-indent-line)
-	t)))
-  
-(defun ielm-complete-symbol nil
-  "Complete the lisp symbol before point."
-  ;; A wrapper for lisp-complete symbol that returns non-nil if
-  ;; completion has occurred
-  (let* ((btick (buffer-modified-tick))
-	 (cbuffer (get-buffer "*Completions*"))
-	 (ctick (and cbuffer (buffer-modified-tick cbuffer))))
-    (lisp-complete-symbol)
-     ;; completion has occurred if:
-    (or 
-     ;; the buffer has been modified
-     (not (= btick (buffer-modified-tick))) 
-     ;; a completions buffer has been modified or created
-     (if cbuffer
-	 (not (= ctick (buffer-modified-tick cbuffer)))
-       (get-buffer "*Completions*")))))
-
-(defun ielm-complete-filename nil
-  "Dynamically complete filename before point, if in a string."
-  (if (nth 3 (parse-partial-sexp comint-last-input-start (point)))
-      (comint-dynamic-complete-filename)))
-     
-(defun ielm-indent-line nil
-  "Indent the current line as Lisp code if it is not a prompt line."
-  (if (save-excursion
-	(beginning-of-line)
-	(looking-at comint-prompt-regexp)) nil
-    (lisp-indent-line)))
-
-;;; Working buffer manipulation
-
-(defun ielm-print-working-buffer nil
-  "Print the current IELM working buffer's name in the echo area."
-  (interactive)
-  (message "The current working buffer is: %s" (buffer-name ielm-working-buffer)))
-
-(defun ielm-display-working-buffer nil
-  "Display the current IELM working buffer.
-Don't forget that selecting that buffer will change its value of `point'
-to its value of `window-point'!"
-  (interactive)
-  (display-buffer ielm-working-buffer)
-  (ielm-print-working-buffer))
-
-(defun ielm-change-working-buffer (buf)
-  "Change the current IELM working buffer to BUF.
-This is the buffer in which all sexps entered at the IELM prompt are
-evaluated.  You can achieve the same effect with a call to
-`set-buffer' at the IELM prompt."
-  (interactive "bSet working buffer to: ")
-  (setq ielm-working-buffer (or (get-buffer buf) (error "No such buffer")))
-  (ielm-print-working-buffer))
-
-;;; Other bindings
-
-(defun ielm-return nil
-  "Newline and indent, or evaluate the sexp before the prompt.
-Complete sexps are evaluated; for incomplete sexps inserts a newline
-and indents.  If however `ielm-dynamic-return' is nil, this always
-simply inserts a newline."
-  (interactive)
-  (if ielm-dynamic-return 
-      (let ((state       
-	     (save-excursion
-	       (end-of-line)
-	       (parse-partial-sexp (ielm-pm)
-				   (point)))))
-	(if (and (< (car state) 1) (not (nth 3 state)))
-	    (ielm-send-input)
-	  (if (and ielm-dynamic-multiline-inputs
-		   (save-excursion
-		     (beginning-of-line)
-		     (looking-at comint-prompt-regexp)))
-	      (save-excursion
-		(goto-char (ielm-pm))
-		(newline 1)))
-	  (newline-and-indent)))
-    (newline)))
-
-(defvar ielm-input)
-
-(defun ielm-input-sender (proc input)
-  ;; Just sets the variable ielm-input, which is in the scope of 
-  ;; `ielm-send-input's call.
-  (setq ielm-input input))
-
-(defun ielm-send-input nil
-  "Evaluate the Emacs Lisp expression after the prompt."
-  (interactive)
-  (let ((buf (current-buffer))
-	ielm-input)			; set by ielm-input-sender
-    (comint-send-input)			; update history, markers etc.
-    (ielm-eval-input ielm-input)))
-
-;;; Utility functions
-
-(defun ielm-is-whitespace (string)
-  "Return non-nil if STRING is all whitespace."
-  (or (string= string "") (string-match "\\`[ \t\n]+\\'" string)))
-
-(defun ielm-format-errors (errlist)
-  (let ((result ""))
-    (while errlist
-      (setq result (concat result (prin1-to-string (car errlist)) ", "))
-      (setq errlist (cdr errlist)))
-    (substring result 0 -2)))
-
-
-(defun ielm-format-error (err)
-  ;; Return a string form of the error ERR.
-  (format "%s%s"
-	  (or (get (car err) 'error-message) "Peculiar error")
-	  (if (cdr err)
-	      (format ": %s" (ielm-format-errors (cdr err)))
-	    "")))
-
-;;; Evaluation
-
-(defun ielm-eval-input (ielm-string)
-  "Evaluate the Lisp expression IELM-STRING, and pretty-print the result."
-  ;; This is the function that actually `sends' the input to the
-  ;; `inferior Lisp process'. All comint-send-input does is works out
-  ;; what that input is.  What this function does is evaluates that
-  ;; input and produces `output' which gets inserted into the buffer,
-  ;; along with a new prompt.  A better way of doing this might have
-  ;; been to actually send the output to the `cat' process, and write
-  ;; this as in output filter that converted sexps in the output
-  ;; stream to their evaluated value.  But that would have involved
-  ;; more process coordination than I was happy to deal with.
-  ;;
-  ;; NOTE: all temporary variables in this function will be in scope
-  ;; during the eval, and so need to have non-clashing names.
-  (let (ielm-form			; form to evaluate
-	ielm-pos			; End posn of parse in string
-	ielm-result			; Result, or error message
-	ielm-error-type			; string, nil if no error
-	(ielm-output	"")		; result to display
-	(ielm-wbuf ielm-working-buffer)	; current buffer after evaluation
-	(ielm-pmark (ielm-pm)))
-    (if (and (not (null ielm-string))
-	     (not (ielm-is-whitespace ielm-string)))
-	(progn
-	  (condition-case err
-	      (let (rout)
-		(setq rout (read-from-string ielm-string))
-		(setq ielm-form (car rout))
-		(setq ielm-pos (cdr rout)))
-	    (error (setq ielm-result (ielm-format-error err))
-		   (setq ielm-error-type "Read error")))
-	  (if ielm-error-type nil
-	    ;; Make sure working buffer has not been killed
-	    (if (not (buffer-name ielm-working-buffer))
-		(setq ielm-result "Working buffer has been killed"
-		      ielm-error-type "IELM Error"
-		      ielm-wbuf (current-buffer))
-	      (if (ielm-is-whitespace (substring ielm-string ielm-pos))
-		  ;; need this awful let convolution to work around
-		  ;; an Emacs bug involving local vbls and let binding
-		  (let ((!save !)
-			(!!save !!)
-			(!!!save !!!))
-		    (save-excursion
-		      (set-buffer ielm-working-buffer)
-		      (condition-case err
-			  (let ((! !save)
-				(!! !!save)
-				(!!! !!!save)
-				(ielm-obuf (current-buffer)))
-			    (setq ielm-result (eval ielm-form))
-			    (setq ielm-wbuf (current-buffer))
-			    ;; The eval may have changed current-buffer;
-			    ;; need to set it back here to avoid a bug
-			    ;; in let.  Don't want to use save-excursion
-			    ;; because we want to allow changes in point.
-			    (set-buffer ielm-obuf))
-			(error (setq ielm-result (ielm-format-error err))
-			       (setq ielm-error-type "Eval error"))
-			(quit (setq ielm-result "Quit during evaluation")
-			      (setq ielm-error-type "Eval error")))))
-		(setq ielm-error-type "IELM error")
-		(setq ielm-result "More than one sexp in input"))))
-
-	  ;; If the eval changed the current buffer, mention it here
-	  (if (eq ielm-wbuf ielm-working-buffer) nil
-	    (message "current buffer is now: %s" ielm-wbuf)
-	    (setq ielm-working-buffer ielm-wbuf))
-
-	  (goto-char ielm-pmark)
-	  (if (not ielm-error-type)
-	      (condition-case err
-		  ;; Self-referential objects cause loops in the printer, so
-		  ;; trap quits here. May as well do errors, too
-		  (setq ielm-output (concat ielm-output (pp-to-string ielm-result)))
-		(error (setq ielm-error-type "IELM Error")
-		       (setq ielm-result  "Error during pretty-printing (bug in pp)"))
-		(quit  (setq ielm-error-type "IELM Error")
-		       (setq ielm-result "Quit during pretty-printing"))))
-	  (if ielm-error-type
-	      (progn
-		(if ielm-noisy (ding))
-		(setq ielm-output (concat ielm-output "*** " ielm-error-type " ***  "))
-		(setq ielm-output (concat ielm-output ielm-result)))
-	    ;; There was no error, so shift the !!! values
-	    (setq !!! !!)
-	    (setq !! !)
-	    (setq ! ielm-result))
-	  (setq ielm-output (concat ielm-output "\n"))))
-    (if (not (null ielm-string))
-	(setq ielm-output (concat ielm-output ielm-prompt)))
-    (comint-output-filter (ielm-process) ielm-output)))
-
-;;; Process and marker utilities
-
-(defun ielm-process nil
-  ;; Return the current buffer's process.
-  (get-buffer-process (current-buffer)))
-
-(defun ielm-pm nil
-  ;; Return the process mark of the current buffer.
-  (process-mark (get-buffer-process (current-buffer))))
-
-(defun ielm-set-pm (pos)
-  ;; Set the process mark in the current buffer to POS.
-  (set-marker (process-mark (get-buffer-process (current-buffer))) pos))
-
-;;; Major mode
-
-(put 'inferior-emacs-lisp-mode 'mode-class 'special)
-
-(defun inferior-emacs-lisp-mode nil
-  "Major mode for interactively evaluating Emacs Lisp expressions.
-Uses the interface provided by `comint-mode' (which see).
-
-* \\\\[ielm-send-input] evaluates the sexp following the prompt. There must be at most
-  one top-level sexp per prompt.
-
-* \\[ielm-return] inserts a newline and indents, or evaluates a
-  complete expression (but see variable `ielm-dynamic-return').
-  Inputs longer than one line are moved to the line following the
-  prompt (but see variable `ielm-dynamic-multiline-inputs').
-
-* \\[comint-dynamic-complete] completes Lisp symbols (or filenames, within strings), 
-  or indents the line if there is nothing to complete.
-
-During evaluations, the values of the variables `!', `!!', and `!!!'
-are the results of the previous, second previous and third previous
-evaluations respectively.
-
-The current working buffer may be changed (with a call to
-`set-buffer', or with \\[ielm-change-working-buffer]), and its value
-is preserved between successive evaluations.  In this way, expressions
-may be evaluated in a different buffer than the *ielm* buffer.
-Display the name of the working buffer with \\[ielm-print-working-buffer],
-or the buffer itself with \\[ielm-display-working-buffer].
-
-Expressions evaluated by IELM are not subject to `debug-on-quit' or
-`debug-on-error'.
-
-The behaviour of IELM may be customised with the following variables:
-* To stop beeping on error, set `ielm-noisy' to nil
-* If you don't like the prompt, you can change it by setting `ielm-prompt'.
-* Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode'
-* Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook'
- (in that order).
-
-Customised bindings may be defined in `ielm-map', which currently contains:
-\\{ielm-map}"
-  (interactive)
-  (comint-mode)
-  (setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt)))
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start comint-prompt-regexp)
-  (setq comint-input-sender 'ielm-input-sender)
-  (setq comint-process-echoes nil)
-  (setq comint-dynamic-complete-functions 
-	'(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol))
-  (setq comint-get-old-input 'ielm-get-old-input)
-  (make-local-variable 'comint-completion-addsuffix)
-  (setq comint-completion-addsuffix
-	(cons (char-to-string directory-sep-char) ""))
-
-  (setq major-mode 'inferior-emacs-lisp-mode)
-  (setq mode-name "IELM")
-  (use-local-map ielm-map)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-
-  (make-local-variable 'indent-line-function)
-  (make-local-variable 'ielm-working-buffer)
-  (setq ielm-working-buffer (current-buffer))
-  (setq indent-line-function 'ielm-indent-line)
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'lisp-fill-paragraph)
-
-  ;; Value holders
-  (setq ! nil)
-  (make-local-variable '!)
-  (setq !! nil)
-  (make-local-variable '!!)
-  (setq !!! nil)
-  (make-local-variable '!!!)
-
-  ;; font-lock support
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults 
-	'(ielm-font-lock-keywords nil nil ((?! . "w") (?- . "w") (?* . "w"))))
-  
-  ;; A dummy process to keep comint happy. It will never get any input
-  (if (comint-check-proc (current-buffer)) nil
-    (start-process "ielm" (current-buffer) "cat")
-    (process-kill-without-query (ielm-process))
-    (goto-char (point-max))
-    ;; Add a silly header
-    (insert ielm-header)
-    (ielm-set-pm (point-max))
-    (comint-output-filter (ielm-process) ielm-prompt)
-    (set-marker comint-last-input-start (ielm-pm))
-    (set-process-filter (get-buffer-process (current-buffer)) 'comint-output-filter))
-  (run-hooks 'ielm-mode-hook))
-
-(defun ielm-get-old-input nil
-  ;; Return the previous input surrounding point
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at comint-prompt-regexp) nil
-      (re-search-backward comint-prompt-regexp))
-    (comint-skip-prompt)
-    (buffer-substring (point) (progn (forward-sexp 1) (point)))))
-
-;;; User command
-
-;;;###autoload (add-hook 'same-window-buffer-names "*ielm*")
-
-;;;###autoload
-(defun ielm nil
-  "Interactively evaluate Emacs Lisp expressions.
-Switches to the buffer `*ielm*', or creates it if it does not exist."
-  (interactive)
-  (if (comint-check-proc "*ielm*")
-      nil
-    (save-excursion
-      (set-buffer (get-buffer-create "*ielm*"))
-      (inferior-emacs-lisp-mode)))
-  (pop-to-buffer "*ielm*"))
-
-(provide 'ielm)
-
-;;; ielm.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/lisp-file-db.el b/xemacs-packages/lisp/xemacs-devel/lisp-file-db.el
deleted file mode 100644
index 8c3b45c7..00000000
--- a/xemacs-packages/lisp/xemacs-devel/lisp-file-db.el
+++ /dev/null
@@ -1,39 +0,0 @@
-(defvar *default-db-name* (expand-file-name "~/.xemacs/lisp-file-database")
-  "Default location of the database")
-
-(defun build-lisp-file-db (&optional db-name path rebuild)
-  "Create a database of all lisp files in the directories given by PATH.
-DB-NAME is the database name, defaulting to *default-db-name*
-PATH is a list of directories to search, defaulting to load-path.
-REBUILD "
-  (let ((path (or path load-path))
-	(db (open-database (or db-name *default-db-name*) nil nil "rw+")))
-    ;; For each entry in path, find all files in it and put them in
-    ;; the database.
-    (dolist (dir path)
-      (dolist (file (directory-files dir t nil t t))
-	;; Separate the file name and the directory.  The key is the
-	;; filename, and the value is the whole pathname.  However, if
-	;; the key already exists, DON'T put that entry in.  We want
-	;; things that occur first in load-path to override entries
-	;; later in load-path
-	(let ((fname (file-name-nondirectory file)))
-	  (put-database fname file db nil))))))
-
-(defun show-lisp-db (&optional db-name)
-  (let ((db (open-database (or db-name *default-db-name*) nil nil "r"))
-	(entries '()))
-    (map-database #'(lambda (key val)
-		      (push (cons key val) entries))
-		  db)
-    (nreverse entries)))
-
-(defun lookup-lisp-file-db (file &optional db-name)
-  (let ((name (file-name-nondirectory file))
-	(db (open-database (or db-name *default-db-name*) nil nil "r")))
-    (do* ((ext '("" ".elc" ".el") (rest ext))
-	 (entry (get-database (concat name (first ext)) db)
-		(get-database (concat name (first ext)) db)))
-	((or entry (null ext)) entry)
-      ())))
-    
diff --git a/xemacs-packages/lisp/xemacs-devel/patch-keywords.el b/xemacs-packages/lisp/xemacs-devel/patch-keywords.el
deleted file mode 100644
index 11a65a78..00000000
--- a/xemacs-packages/lisp/xemacs-devel/patch-keywords.el
+++ /dev/null
@@ -1,317 +0,0 @@
-;;; patch-keywords.el --- Insert action keywords into patch followups.
-
-;; Copyright (C) 2002 Steve Youngs
-
-;; RCS: $Id: patch-keywords.el,v 1.4 2003/08/17 09:34:55 adrian Exp $
-;; Author:        Steve Youngs 
-;; Maintainer:    Steve Youngs 
-;; Created:       2002-01-14
-;; Last-Modified: <2002-03-04 07:18:01 (steve)>
-;; Keywords:      maint
-
-;; This file is part of XEmacs
-
-;; XEmacs 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.
-
-;; XEmacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
-;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
-
-
-;;; Commentary:
-;;
-;;  This file is an aid to mailing followups to patches submitted via
-;;  email.  It adds "Reviewer Action Keywords" to the message.  These
-;;  "keywords" can later be used as an aid to patch tracking.
-
-;;  At this stage, this file is probably only useful to anyone who
-;;  reviews patches submitted to .
-
-;;  To use: 
-;;    - M-x customize-group RET patch-review RET
-;;       Change things to your liking.
-;;    - (require 'patch-keywords)
-;;       In your ~/.xemacs/init.el
-
-;;  Then when you are following up to a patch submission, just hit
-;;  'M-p'.  You'll be prompted for the keywords to apply to the
-;;  message.  You can use the history mechanism to select keywords.
-;;  Enter a null keyword (just hit 'RET') to terminate the list of
-;;  keywords.
-
-;;  The keywords are added to 3 separate places in the message.
-;;    - In abbreviated form (1st character of each keyword) enclosed
-;;      in square brackets at the start of the subject header (version
-;;      numbers are not abbreviated).
-;;
-;;    - In a "X-Reviewer-Action:" header (full keywords).
-;;
-;;    - At line 0, column 0 of the message body.
-
-;;  To see how to setup a "X-Reviewer-Action:" header, see
-;;  `gnus-posting-styles'
-
-;;  Many thanks to Adrian Aichner  for his ideas,
-;;  code examples and testing.
-
-;;; Code:
-(eval-when-compile
-  (require 'message)
-  (autoload 'gnus-continuum-version "gnus"))
-
-;;;###autoload
-(defgroup patch-review nil
-  "Patch submission review."
-  :group 'mail)
-
-(defcustom patch-keywords
-  '("APPROVE"
-    "COMMIT"
-    "FORWARD"
-    "QUERY"
-    "RECOMMEND"
-    "SUPERSEDES"
-    "VETO"
-    "21.4"
-    "21.5")
-  "List of keywords used for reviewing patches.
-
-The default values are the keywords currently used by the XEmacs
-Review Board."
-  :group 'patch-review
-  :type '(repeat (string :tag "Review Action Keyword"))
-  :tag "Action Keywords")
-
-(defcustom patch-review-mua 'gnus
-  "The MUA (Mail User Agent) you use for reviewing patches.
-
-Currently, the only MUAs that are supported are Gnus and VM.  Should
-we even bother with things like MEW or Rmail?"
-  :group 'patch-review
-  :type '(choice
-	  (item gnus)
-	  (item vm)
-	  (item mew\ \(Not\ Supported\))
-	  (item rmail\ \(Not\ Supported\)))
-  :tag "MUA")
-
-(defcustom patch-keywords-followup-to "XEmacs Beta "
-  "The address to put into the \"Mail-Followup-To:\" header.
-This is so that any further discussions relating to the submitted
-patch can take place in a separate forum."
-  :group 'patch-review
-  :type 'string
-  :tag "Followups Address")
-
-;; I use the bleeding edge Gnus (Oort 0.05), so consequently we have
-;; to define a couple of functions that aren't in the XEmacs package
-;; version of Gnus (5.8.8).  Later on they're wrapped in a version
-;; test.
-(defun patch-keywords-in-header-p ()
-  "Return t if point is in the header.
-Same as `message-point-in-header-p' which exists in Gnus Oort, but not
-in Gnus 5.8.8"
-  (save-excursion
-    (let ((p (point)))
-      (goto-char (point-min))
-      (not (re-search-forward
- 	    (concat "^" (regexp-quote mail-header-separator) "\n")
- 	    p t)))))
-
-(defun patch-keywords-message-beginning-of-line (&optional n)
-  "Move point to beginning of header value or to beginning of line.
-Optional argument N non-nil or 1, move forward N - 1 lines first.
-Same as `message-beginning-of-line' which exists in Gnus Oort, but not
-in Gnus 5.8.8."
-  (interactive "p")
-  (if (if (< (gnus-continuum-version gnus-version) 5.090004)
-	(patch-keywords-in-header-p)
-      (message-point-in-header-p))
-      (let* ((here (point))
-	     (bol (progn (beginning-of-line n) (point)))
-	     (eol (gnus-point-at-eol))
-	     (eoh (re-search-forward ": *" eol t)))
-	(if (or (not eoh) (equal here eoh))
-	    (goto-char bol)
-	  (goto-char eoh)))
-    (beginning-of-line n)))
-
-(defun patch-keywords-insert-gnus (patch-key)
-  "Insert the action keywords into patch followups.
-
-Argument PATCH-KEY A list of action keywords as defined in
-`patch-keywords'.  They may be chosen interactively via the
-history mechanism.
-
-Insert abbreviated (1st char) keywords at the beginning of the subject
-header.  Full keywords into the \"X-Reviewer-Action:\" header, if
-present, and also at the start of the message body.
-
-The \"X-Reviewer-Action:\" header can be easily inserted using
-`gnus-posting-styles'.
-
-This function also sets followups to xemacs-beta@xemacs.org."
-  (interactive
-   (let
-       ((hist patch-keywords)
-        key
-        keys)
-     (while (not
-             (string-equal
-              (setq key
-                    (read-string
-		     "Enter patch keywords (or RET to finish): " "" 'hist))
-              ""))
-       (setq keys (cons key keys)))
-     (list (mapconcat 'identity (reverse keys) " "))))
-  (if (string-equal patch-key "")
-      (error "Choose at least one patch-key from %s"
-             (mapconcat 'identity patch-keywords ", ")))
-  (save-excursion
-    ;; We need to preserve the original subject header so something
-    ;; like "fix for 21.5 not for 21.4" doesn't turn into "fix for
-    ;; 21.5not for 21.4"
-    (message-goto-subject)
-    (if (< (gnus-continuum-version gnus-version) 5.090004)
-	(patch-keywords-message-beginning-of-line)
-      (message-beginning-of-line))
-    (re-search-forward ".*$" (eolp) t)
-    (let ((oldsub (match-string 0))
-	  (keywords (concat "\\("
-			    (regexp-opt patch-keywords)
-			    "\\) ")))
-      ;; Clear the original subject (reinstate it later)
-      (if (< (gnus-continuum-version gnus-version) 5.090004)
-	  (patch-keywords-message-beginning-of-line)
-	(message-beginning-of-line))
-      (if (re-search-forward ".*$" (eolp) t)
-	  (replace-match ""))
-      ;; Insert the long patch keywords
-      (insert-string
-       (concat "[" patch-key " ]"))
-      (insert-string " ")
-      ;; Convert to abbreviated patch keywords
-      (if (< (gnus-continuum-version gnus-version) 5.090004)
-	  (patch-keywords-message-beginning-of-line)
-	(message-beginning-of-line))
-      (save-restriction
-        (narrow-to-region (point) (point-at-eol))
-        (while (re-search-forward keywords (eolp) t)
-          (let ((keyword (match-string 1)))
-            (if (save-match-data
-                  (string-match "\\`[.0-9]+\\'" keyword))
-                (replace-match (match-string 1))
-              (replace-match (substring (match-string 1) 0 1))))))
-      ;; Reinstate the original subject header after the keywords
-      (end-of-line)
-      (insert-string oldsub))
-    ;; Insert keywords into the 'X-Reviewer-Action:' header
-    (goto-line 0)
-    (if (re-search-forward "^X-Reviewer-Action: " nil t)
-	(insert-string patch-key))
-    ;; Set followups to go to xemacs-beta
-    (if (< (gnus-continuum-version gnus-version) 5.090004)
-	(message-position-on-field "Mail-Followup-To" "From")
-      (message-goto-mail-followup-to))
-    (insert-string patch-keywords-followup-to)
-    ;; Insert the keywords into the body of the message
-    (message-goto-body)
-    (insert-string patch-key)
-    (insert-string "\n\n")))
-
-(defun patch-keywords-insert-vm (patch-key)
-  "Insert the action keywords into patch followups.
-
-Argument PATCH-KEY A list of action keywords as defined in
-`patch-keywords'.  They may be chosen interactively via the
-history mechanism.
-
-Insert abbreviated (1st char) keywords at the beginning of the subject
-header.  Full keywords into the \"X-Reviewer-Action:\" header, and
-also at the start of the message body.
-
-This function also sets followups to xemacs-beta@xemacs.org."
-  (interactive
-   (let
-       ((hist patch-keywords)
-        key
-        keys)
-     (while (not
-             (string-equal
-              (setq key
-                    (read-string
-		     "Enter patch keywords (or RET to finish): " "" 'hist))
-              ""))
-       (setq keys (cons key keys)))
-     (list (mapconcat 'identity (reverse keys) " "))))
-  (if (string-equal patch-key "")
-      (error "Choose at least one patch-key from %s"
-             (mapconcat 'identity patch-keywords ", ")))
-  (save-excursion
-    ;; We need to preserve the original subject header so something
-    ;; like "fix for 21.5 not for 21.4" doesn't turn into "fix for
-    ;; 21.5not for 21.4"
-    (mail-subject)
-    (patch-keywords-message-beginning-of-line)
-    (re-search-forward ".*$" (eolp) t)
-    (let ((oldsub (match-string 0))
-	  (keywords (concat "\\("
-			    (regexp-opt patch-keywords)
-			    "\\) ")))
-      ;; Clear the original subject (reinstate it later)
-      (patch-keywords-message-beginning-of-line)
-      (if (re-search-forward ".*$" (eolp) t)
-	  (replace-match ""))
-      ;; Insert the long patch keywords
-      (insert-string
-       (concat "[" patch-key " ]"))
-      (insert-string " ")
-      ;; Convert to abbreviated patch keywords
-      (patch-keywords-message-beginning-of-line)
-      (save-restriction
-        (narrow-to-region (point) (point-at-eol))
-        (while (re-search-forward keywords (eolp) t)
-          (let ((keyword (match-string 1)))
-            (if (save-match-data
-                  (string-match "\\`[.0-9]+\\'" keyword))
-                (replace-match (match-string 1))
-              (replace-match (substring (match-string 1) 0 1))))))
-      ;; Reinstate the original subject header after the keywords
-      (end-of-line)
-      (insert-string oldsub))
-    ;; Insert keywords into the 'X-Reviewer-Action:' header
-    (goto-line 0)
-    (insert-string (concat "X-Reviewer-Action: " patch-key "\n"))
-    ;; Set followups to go to xemacs-beta
-    (goto-line 0)
-    (insert-string "Mail-Followup-To: ")
-    (insert-string (concat patch-keywords-followup-to "\n"))
-    ;; Insert the keywords into the body of the message
-    (mail-text)
-    (insert-string patch-key)
-    (insert-string "\n\n")))
-
-;; Bind 'patch-keywords-insert-MUA' to M-p.
-(cond ((string= patch-review-mua "gnus")
-       (define-key message-mode-map "\M-p" 'patch-keywords-insert-gnus))
-      ((string= patch-review-mua "vm")
-       (define-key mail-mode-map "\M-p" 'patch-keywords-insert-vm)))
-
-(provide 'patch-keywords)
-
-;;; patch-keywords.el ends here
-
-;Local Variables:
-;time-stamp-start: "Last-Modified:[ 	]+\\\\?[\"<]+"
-;time-stamp-end: "\\\\?[\">]"
-;time-stamp-line-limit: 10
-;time-stamp-format: "%4y-%02m-%02d %02H:%02M:%02S (%u)"
-;End:
diff --git a/xemacs-packages/lisp/xemacs-devel/patcher.el b/xemacs-packages/lisp/xemacs-devel/patcher.el
deleted file mode 100644
index cb55012c..00000000
--- a/xemacs-packages/lisp/xemacs-devel/patcher.el
+++ /dev/null
@@ -1,3423 +0,0 @@
-;;; patcher.el --- Utility for mailing patch information
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 Didier Verna.
-
-;; PRCS: $Id: patcher.el,v 1.23 2005/07/26 14:20:07 didierv Exp $
-
-;; Author:        Didier Verna 
-;; Maintainer:    Didier Verna 
-;; Created:       Tue Sep 28 18:12:43 1999
-;; Last Revision: Tue Aug 31 14:14:48 2004
-;; Keywords:      maint
-
-;; This file is part of Patcher.
-
-;; Patcher 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.
-
-;; Patcher 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.
-
-
-;;; Commentary:
-
-;; Contents management by FCM version 0.1.
-
-;; Patcher is an XEmacs package designed to automate and ease the
-;; maintenance of archive-based projects.  It provides assistance in
-;; building, reporting and committing patches, as well as in handling the
-;; corresponding ChangeLog entries, for example by creating skeletons.
-
-;; Patcher is fully documented.  Please refer to the documentation for
-;; information on how to use it.  All user options can be found in the
-;; "Patcher" Custom group.
-
-
-;; Suggestions for further improvements:
-
-;; #### Implement a default theme for XEmacs developpers / committers.
-
-;; #### Investigate on the notion of adding new files (it's different across
-;; RCSes).
-
-;; #### If the user answers `no' to the confirm commit question, it should be
-;; possible to edit manually the computed commit command.
-
-;; #### The subject-related strings could benefit from almost all %
-;; constructs.
-
-;; #### Provide a way to attach patches instead of inserting them as plain
-;; text.
-
-;; #### Provide a way to filter out some files from the mailed patch.  For
-;; instance, when you commit yourself, you want to have `configure' in your
-;; files, but you don't want to display a patch against it.
-
-;; #### Before sending the message, we could check that the contents is ok
-;; (like, there's no more diff errors and stuff).
-
-;; #### Implement a real error / warning mechanism.
-
-;; #### When a project is found to be out of date, we could implement
-;; something to update it and re-run patcher again.
-
-;; #### For the 'gnus mail method, add the possibility to temporarily use a
-;; different one if the user don't want to start Gnus.
-;;
-;; #### Consider doing a better job of handling overlapping patcher
-;; instances. e.g. use a different extent property for each instance,
-;; and keep a usage count for the ChangeLog files so that they're only
-;; killed when no instance uses them any more.
-;;
-;; #### Also add an option to kill, not just bury, the mail message when
-;; it's sent.
-;;
-;; #### When the message is sent, the cvs commit results window should be
-;; removed and the corresponding buffer buried.
-;;
-;; #### Have a control window to clarify the progress of everything.
-;; Make it perhaps a small buffer, above the mail message/ChangeLog
-;; buffer.  It shows what steps have been completed, what haven't, and
-;; what to do.  It should have buttons in it for the various actions.
-;; One button is for include-changelogs, one for commit, one for send
-;; the mail, and one for execute the commit.  These should be enabled
-;; or grayed out appropriately.  It should also have buttons that show
-;; the associated changelogs; clicking on a button puts that changelog
-;; buffer in the main window below the control window.  By each
-;; changelog button should be an indication of whether the changelog
-;; has been modified so far.  The control window should stay around as
-;; much as it can during the whole process (e.g. use
-;; set-buffer-dedicated-p or something), so that it's always there to
-;; drive the whole process.  One corollary is that you don't actually
-;; have to switch to the mail buffer to (e.g.) execute
-;; include-changelogs -- you just click on the control window, and it
-;; does it automatically.  also, when you execute include-changelogs,
-;; it can issue a warning if not all changelogs have been visited, and
-;; prompt you to make sure you want to continue.  Similarly, you can
-;; run include-changelogs more than once even if it succeeded the
-;; first time (e.g. for some reason you didn't like the result and
-;; deleted it), but it will prompt "are you sure?".  There could also
-;; be an "undo include-changelogs", if you make a mistake after doing
-;; include-changelogs and realize you want to go back and fix the
-;; problem and do include-changelogs again.
-
-
-
-;; Internal notes:
-
-;; - See why the ChangeLogs are represented in absolute path instead of
-;; relative to the project's directory. I can't remember, but this looks
-;; weird.
-
-
-
-;; Thanks to these people for their suggestions, testing and contributions:
-;; Adrian Aichner, Ben Wing, Karl Pflasterer, Malcolm Purvis, Norbert Koch,
-;; Raphael Poss, Stephen J. Turnbull, Steve Youngs.
-
-
-;;; Code:
-
-;; Require 'sendmail for getting `mail-header-separator'.
-;; #### Now that a fake mail sending function exists, sendmail shouldn't be
-;; #### systematically required like this.  However, since most users will
-;; #### really want do send real messages, it probably doesn't hurt to keep
-;; #### things as-is.
-(require 'sendmail)
-
-
-;; These macros are copied from bytecomp-runtime.el because they're only
-;; available in XEmacs 21.5.
-
-(defmacro patcher-globally-declare-fboundp (symbol)
-  (when (cl-compiling-file)
-    (setq symbol (eval symbol))
-    (if (not (consp symbol))
-	(setq symbol (list symbol)))
-    ;; Another hack.  This works because the autoload environment is
-    ;; currently used ONLY to suppress warnings, and the actual
-    ;; autoload definition is not used.  (NOTE: With this definition,
-    ;; we will get spurious "multiple autoloads for %s" warnings if we
-    ;; have an autoload later in the file for any functions in SYMBOL.
-    ;; This is not something that code should ever do, though.)
-    (setq byte-compile-autoload-environment
-	  (append (mapcar #'(lambda (sym) (cons sym nil)) symbol)
-		  byte-compile-autoload-environment)))
-  nil)
-
-(defmacro patcher-globally-declare-boundp (symbol)
-  (setq symbol (eval symbol))
-  (if (not (consp symbol))
-      (setq symbol (list symbol)))
-  `(progn
-     ;; (defvar FOO) has no side effects.
-     ,@(mapcar #'(lambda (sym) `(defvar ,sym)) symbol)))
-
-
-(patcher-globally-declare-boundp 'font-lock-always-fontify-immediately)
-
-
-
-;; ===========================================================================
-;; Version management
-;; ===========================================================================
-
-;; $Format: "(defconst patcher-prcs-major-version \"$ProjectMajorVersion$\")"$
-(defconst patcher-prcs-major-version "version-3-8")
-;; $Format: "(defconst patcher-prcs-minor-version \"$ProjectMinorVersion$\")"$
-(defconst patcher-prcs-minor-version "1")
-(defconst patcher-version
-  (let ((level patcher-prcs-minor-version)
-	major minor status)
-    (string-match "\\(branch\\|version\\)-\\([0-9]+\\)-\\([0-9]+\\)"
-		  patcher-prcs-major-version)
-    (setq major (match-string 2 patcher-prcs-major-version)
-	  minor (match-string 3 patcher-prcs-major-version)
-	  status (match-string 1 patcher-prcs-major-version))
-    (cond ((string= status "version")
-	   (setq level (int-to-string (1- (string-to-int level))))
-	   (if (string-equal level "0")
-	       (concat major "." minor)
-	     (concat major "." minor "." level)))
-	  ((string= status "branch")
-	   (concat major "." minor "-b" level)))
-    ))
-
-;;;###autoload
-(defun patcher-version ()
-  "Show the current version of Patcher."
-  (interactive)
-  (message "Patcher version %s" patcher-version))
-
-
-
-;; ===========================================================================
-;; General utilities
-;; ===========================================================================
-
-(defsubst patcher-message (msg &rest args)
-  ;; Print a message, letting XEmacs time to display it.  Also, handle command
-  ;; substitution.
-  (message (substitute-command-keys (apply 'format msg args)))
-  (sit-for 0))
-
-(defsubst patcher-warning (msg &rest args)
-  ;; Like `patcher-message, but triggers a Patcher warning instead.
-  (warn (substitute-command-keys (apply 'format msg args))))
-
-(defsubst patcher-error (msg &rest args)
-  ;; Like `patcher-message, but triggers a Patcher error instead.
-  (error (substitute-command-keys (apply 'format msg args))))
-
-(defmacro patcher-with-progression (msg &rest body)
-  ;; wrap BODY in "msg..." / "msg...done" messages.
-  ;; Return the value of BODY execution.
-  `(prog2
-       (patcher-message (concat ,msg "... please wait."))
-       (progn ,@body)
-     (patcher-message (concat ,msg "... done."))))
-(put 'patcher-with-progression 'lisp-indent-function 1)
-
-
-(defsubst patcher-file-relative-name (file &optional dir raw)
-  ;; Construct a filename from FILE relative to DIR (default directory if not
-  ;; given).  Unless RAW is given, force unix syntax
-  ;; #### NOTE: FILE may be either a string (a file name), or a list such as
-  ;; #### patcher-change-logs elements, whose car must then be the file name
-  ;; #### in question.
-  (and (listp file) (setq file (car file)))
-  (let ((directory-sep-char (if raw directory-sep-char ?/)))
-    (or dir (setq dir default-directory))
-    (file-relative-name (expand-file-name file (expand-file-name dir))
-			(expand-file-name dir))
-    ))
-
-(defsubst patcher-files-string (files)
-  ;; Convert FILES to a string of relative file names.  Unless RAW is given,
-  ;; force unix syntax.
-  ;; #### NOTE: FILES may be either a list of strings (file names), or a list
-  ;; #### such as the one in patcher-change-logs.
-  (mapconcat 'patcher-file-relative-name  files " "))
-
-(defun patcher-files-buffers (files &optional find)
-  ;; Find a buffer visiting each file in FILES, and return a list of
-  ;; corresponding buffers.  Skip files that are not visited, unless optional
-  ;; argument FIND is non nil.  In that case, visit the file.
-  ;; #### NOTE: FILES may be either a list of strings (file names), or a list
-  ;; #### such as the one in patcher-change-logs.
-  (let (buffer buffers)
-    (dolist (file files buffers)
-      (and (listp file) (setq file (car file)))
-      (setq buffer (or (get-file-buffer file)
-		       (and find (find-file-noselect file))))
-      (when buffer (push buffer buffers)))
-    ))
-
-(defun patcher-save-buffers (buffers)
-  ;; Offer to save some buffers.
-  ;; #### FIXME: this should be a standard function somewhere.
-  (map-y-or-n-p
-   (lambda (buffer)
-     (and (buffer-modified-p buffer)
-	  (not (buffer-base-buffer buffer))
-	  (buffer-file-name buffer)
-	  (format "Save file %s? "
-		  (buffer-file-name buffer))))
-   (lambda (buffer)
-     (save-excursion
-       (set-buffer buffer)
-       (condition-case ()
-	   (save-buffer)
-	 (error nil))))
-   buffers
-   '("buffer" "buffers" "save")))
-
-(defun patcher-goto-subject ()
-  ;; Move point to the beginning of the Subject: header's contents, if any.
-  ;; Return that position, or nil.
-  ;; #### FIXME: maybe we should issue a warning if no subject line is found ?
-  (let (pos)
-    (save-excursion
-      (goto-char (point-min))
-      (setq pos (re-search-forward "^Subject: " nil t)))
-    (and pos (goto-char pos))))
-
-(defun patcher-goto-signature ()
-  ;; Move point to the beginning of the mail signature (actually, in front of
-  ;; the signature separator), if any.  Otherwise, move point to the end of
-  ;; the message. Return that position.
-  (goto-char (point-min))
-  (if (re-search-forward
-       (cond ((eq major-mode 'mail-mode)
-	      ;; this is hard-wired in sendmail.el
-	      "\n\n-- \n")
-	     ((eq major-mode 'message-mode)
-	      message-signature-separator)
-	     (t
-	      (patcher-warning "\
-Major mode: %s.
-Your mailing method is not fully supported by Patcher.
-This is not critical though: Patcher may not find the message signature
-correctly.
-
-Please report to ."
-			       major-mode)
-	      ;; Use the standard one by default.
-	      "\n\n-- \n"))
-       nil t)
-      (goto-char (match-beginning 0))
-    ;; else: no signature
-    (goto-char (point-max))))
-
-
-
-;; ===========================================================================
-;; Projects description
-;; ===========================================================================
-
-(defgroup patcher nil
-  "Automatic archive-base project maintenance.")
-
-(defgroup patcher-default nil
-  "Default settings for Patcher project options."
-  :group 'patcher)
-
-(defcustom patcher-default-name nil
-  "*Default name for Patcher projects.
-
-This project option (a string) exists to let you define different Patcher
-projects (hence with different names) sharing a common name for the
-underlying diff and commit commands.  If set, it will be used rather than
-the real project's name."
-  :group 'patcher-default
-  :type '(choice (const :tag "Patcher name" nil)
-		 (string :tag "Other name")))
-
-(defcustom patcher-default-mail-method 'compose-mail
-  "*Default method used by Patcher to prepare a mail.
-
-Currently, there are four built-in methods: 'compose-mail \(the default),
-'sendmail, 'message, 'gnus and 'fake.  Please refer to the corresponding
-`patcher-mail-*' function for a description of each method.
-
-You can also define your own method, say `foo'.  In that case, you *must*
-provide a function named `patcher-mail-foo' which takes two arguments: a
-project descriptor and a string containing the subject of the message.
-This function must prepare a mail buffer.  If you want to do this, please
-see how it's done for the built-in methods."
-  :group 'patcher-default
-  :type '(radio (const compose-mail)
-		(const sendmail)
-		(const message)
-		(const gnus)
-		(const fake)
-		(symbol :tag "other")))
-
-(defcustom patcher-default-user-name nil
-  "*Default user full name to use when sending a Patcher mail.
-
-If not defined, `user-full-name' is used."
-  :group 'patcher-default
-  :type  '(choice (const :tag "user-full-name" nil)
-	          string))
-
-(defcustom patcher-default-user-mail nil
-  "*Default user mail address to use when sending a Patcher mail.
-
-If not defined, `user-mail-address' is used."
-  :group 'patcher-default
-  :type '(choice (const :tag "user-mail-address" nil)
-	          string))
-
-(defcustom patcher-default-to-address "xemacs-patches@xemacs.org"
-  "*Default To: header value to use when sending a Patcher mail.
-
-This variable is used by all mail methods except the 'gnus one \(see
-`patcher-default-mail-method').  If not defined, it is prompted for."
-  :group 'patcher-default
-  :type '(choice (const :tag "Ask" nil)
-		 string))
-
-(defcustom patcher-default-gnus-group nil
-  "*Default Gnus group to use when sending a Patcher mail.
-
-This variable is used only in the 'gnus mail method \(see
-`patcher-default-mail-method').  The mail sending process will behave as if
-you had typed `C-u a' in the group buffer on that Gnus group.  If not
-defined, it is prompted for."
-  :group 'patcher-default
-  :type  '(choice (const :tag "Ask" nil)
-	          string))
-
-(defcustom patcher-default-subject-prefix "[PATCH]"
-  "*Default prefix for the subject of Patcher mails.
-
-The following string transformations are performed:
-- %n: the value of the :name project option if set, or the project's name
-      in the Patcher sense.
-- %N: the project's name in the Patcher sense.
-
-A space will be inserted between the prefix and the rest of the subject,
-as appropriate.  This part of the subject is never prompted for.  See
-also `patcher-default-subject' and
-`patcher-default-subject-committed-prefix'."
-  :group 'patcher-default
-  :type 'string)
-
-(defcustom patcher-default-subject-committed-prefix "[COMMIT]"
-  "*Default prefix for the subject of Patcher mails.
-
-Same as `patcher-default-subject-prefix', but for committed patches.  If nil,
-keep the normal subject prefix."
-  :group 'patcher-default
-  :type '(choice (const :tag "Don't change" nil)
-		 string))
-
-(defcustom patcher-default-subject ""
-  "*Default subject for Patcher mails.
-
-The following string transformations are performed:
-- %n: the value of the :name project option if set, or the project's name
-      in the Patcher sense.
-- %N: the project's name in the Patcher sense.
-
-Please note that this is used *only* to provide a default value for prompted
-subjects.  Subjects are *always* prompted for.
-
-See also `patcher-default-subject-prefix' and
-`patcher-default-subject-committed-prefix', which are not subject to
-prompting."
-  :group 'patcher-default
-  :type 'string)
-
-(defcustom patcher-default-mail-prologue ""
-  "*Default string to insert at the beginning of every Patcher mail."
-  :group 'patcher-default
-  :type 'string)
-
-(defcustom patcher-default-change-logs-updating 'automatic
-  "*Controls the way ChangeLog fields are updated.
-
-Possible values and their meaning are:
-- 'automatic: \(the default) Patcher generates ChangeLog skeletons
-   automatically based on the created diff (you then have to fill up the
-   entries as needed).
-- 'manual: you are supposed to have updated the ChangeLog files by hand,
-   prior to calling Patcher.
--  nil: you don't do ChangeLogs at all."
-  :group 'patcher-default
-  :type '(radio (const :tag "Automatic" automatic)
-		(const :tag "Manual" manual)
-		(const :tag "None" nil)))
-
-(defcustom patcher-default-change-logs-user-name nil
-  "*User full name for generated ChangeLog entries.
-
-If nil, let `patch-to-change-log' decide what to use.
-Otherwise, it should be a string."
-  :group 'patcher-default
-  :type '(choice (const :tag "Default" nil)
-		 (string :tag "Other name")))
-
-(defcustom patcher-default-change-logs-user-mail nil
-  "*User mail address for generated ChangeLog entries.
-
-If nil, let `patch-to-change-log' decide what to use.
-Otherwise, it should be a string."
-  :group 'patcher-default
-  :type '(choice (const :tag "Default" nil)
-		 (string :tag "Other mail")))
-
-(defcustom patcher-default-change-logs-appearance 'verbatim
-  "*Controls the appearance of ChangeLog entries in Patcher mails.
-
-The values currently supported are:
-- 'verbatim \(the default): ChangeLog entries appear simply as text above
-   the patch.  A short line mentioning the ChangeLog file they belong to
-   is added when necessary.
-- 'packed: ChangeLog files are diff'ed, but the output is packed above the
-   rest of the patch.
-- 'patch: ChangeLog files are diff'ed, and the output appears as part of
-   the patch itself.
--  nil: ChangeLog entries don't appear at all.
-
-See also the `patcher-default-change-logs-diff-command' user option."
-  :group 'patcher-default
-  :type '(radio (const :tag "Verbatim" verbatim)
-		(const :tag "Diff, packed together" packed)
-		(const :tag "Diff, part of the patch" patch)
-		(const :tag "Don't appear in message" nil)))
-
-(defcustom patcher-default-change-logs-prologue "%f addition:"
-  "*Default string to insert just before ChangeLogs in every Patcher mail.
-
-This applies when ChangeLog additions appear verbatim in the message.
-A %f occurring in this string will be replaced with the ChangeLog file name
-(relative to the project's directory)."
-  :group 'patcher-default
-  :type 'string)
-
-(defcustom patcher-default-diff-prologue-function
-  'patcher-default-diff-prologue
-  "*Function used to insert a prologue before each diff output.
-
-Insertion must occur at current point in current buffer.
-This function should take one argument indicating the kind of diff:
-- a value of 'sources indicates a source diff only,
-- a value of 'change-logs indicates a ChangeLog diff only,
-- a value of 'mixed indicates a diff on both source and ChangeLog files.
-
-The following variables are bound (when appropriate) when this function
-is executed:
-- `name': the name of the current Patcher project,
-- `source-diff': the command used to create a source diff,
-- `change-log-diff': the command used to create a ChangeLog diff,
-- `source-files': sources files affected by the current patch,
-- `change-log-files': ChangeLog files affected by the current patch.
-
-In the case of a 'mixed diff, a nil value for `change-log-diff' indicates
-that the same command was used for both the source and ChangeLog files."
-  :group 'patcher-default
-  :type '(choice (const :tag "Default" patcher-default-diff-prologue)
-		 (const :tag "None" nil)
-		 (symbol :tag "Other")))
-
-(defcustom patcher-default-command-directory nil
-  "*Default command directory for Patcher projects.
-
-This directory (a string) can be relative to the project's directory.
-All diff and commit commands are executed from this directory if set.
-Otherwise, the project's directory is used."
-  :group 'patcher-default
-  :type  '(choice (const :tag "Same directory" nil)
-		  (string :tag "Other directory")))
-
-
-(defcustom patcher-default-pre-command ""
-  "*Default string to prefix patcher commands with.
-
-This is where you would put things like \"runsocks\"."
-  :group 'patcher-default
-  :type 'string)
-
-(defcustom patcher-default-diff-command "cvs -q diff -u %f"
-  "*Default method used by Patcher to generate a patch.
-
-The following string transformations are performed:
-- %n: the value of the :name project option if set, or the project's name
-      in the Patcher sense.
-- %N: the project's name in the Patcher sense.
-- %f: the files affected by the patch.  These files can be specified by
-      using `patcher-mail-subproject' instead of `patcher-mail' to prepare
-      the patch.  Otherwise, the %f will simply be removed."
-  :group 'patcher-default
-  :type 'string)
-
-(defcustom patcher-default-after-diff-hook nil
-  "*Hook run on the output of a Patcher diff comand.
-
-The functions in this hook should operate on the current buffer and take
-two optional arguments limiting the processing to a buffer region
-(in the absence of arguments, the whole buffer should be processed).
-
-When each function in this hook is run, the point is placed at the
-beginning of the region, and the buffer excursion is saved for you.
-
-There is a special built-in function named `patcher-prcs-diff-convert'
-that can be used in this hook in order to convert a PRCS diff output to
-a traditional one."
-  :group 'patcher-default
-  :type 'hook)
-
-(defcustom patcher-default-diff-line-filter "\\? .*"
-  "*Default line filter to pass Patcher diffs through.
-
-When inserting a diff in Patcher mails, lines matching this regexp will
-be excluded.
-
-Note: the regexp must match the whole line.  Don't add beginning and end
-of line markers to it, Patcher will do this for you.
-
-By default, local files unknown to CVS are filtered out."
-  :group 'patcher-default
-  :type 'regexp)
-
-(defcustom patcher-default-change-logs-diff-command "cvs -q diff -U 0 %f"
-  "*Command to use to generate ChangeLog diffs.
-
-This value is used when the ChangeLog appearance is either 'packed or
-'patch (see the variable `patcher-default-change-logs-appearance').
-
-If set to 'diff, use the same command as for the rest of the patch.
-Otherwise, it should be a string.
-
-The following string transformations are performed:
-- %n: the value of the :name project option if set, or the project's name
-      in the Patcher sense.
-- %N: the project's name in the Patcher sense.
-- %f: the ChangeLog filenames.
-
-Note: it is highly recommended to remove the context from ChangeLog diffs
-because they often fail to apply correctly."
-  :group 'patcher-default
-  :type '(choice (const  :tag "Project diff command" diff)
-		 (string :tag "Other diff command" "cvs -q diff -U 0 %f")))
-
-(defcustom patcher-default-commit-privilege nil
-  "*Default value for Patcher commit privilege status.
-
-If you have the privilege to commit patches yourself, you should set
-this option to t."
-  :group 'patcher-default
-  :type 'boolean)
-
-(defcustom patcher-default-commit-command "cvs commit -F %s %f"
-  "*Default method used by Patcher to commit a patch.
-
-The following string transformations are performed:
-- %n: the value of the :name project option if set, or the project's name
-      in the Patcher sense.
-- %N: the project's name in the Patcher sense.
-- %s: the name of a file containing the commit log message.
-- %S: the commit log message itself (quoted to prevent shell expansion).
-- %f: the files affected by the patch.  These files can be specified by using
-     `patcher-mail-subproject' instead of `patcher-mail' to prepare the patch.
-      Otherwise, the %f will simply be removed."
-  :group 'patcher-default
-  :type 'string)
-
-(defcustom patcher-default-confirm-commits t
-  "*Whether Patcher asks for a confirmation before doing a commit."
-  :group 'patcher-default
-  :type 'boolean)
-
-(defcustom patcher-default-committed-notice
-  "NOTE: This patch has been committed."
-  "*Notice added to a mail when the patch is committed before sending."
-  :group 'patcher-default
-  :type 'string)
-
-(defcustom patcher-default-failed-command-regexp "^cvs \\[[^]]* aborted\\]"
-  "*Default regular expression for matching the result of a failed command.
-
-Commands in question are the diff and the commit one."
-  :group 'patcher-default
-  :type 'regexp)
-
-(defcustom patcher-default-log-message-items '(subject)
-  "*Elements used to initialize a Patcher commit log message.
-
-This is nil, or a list of the following items:
-- 'subject: the subject of the corresponding Patcher mail (sans the prefix),
-- 'compressed-change-logs: the compressed ChangeLog entries for the current
-   patch.
-- 'change-logs: the ChangeLog entries for the current patch.  If some items
-   appear before the ChangeLog entries, the ChangeLogs separator will
-   automatically be included."
-  :group 'patcher-default
-  :type '(set (const :tag "Subject" subject)
-	      (const :tag "Compressed ChangeLogs" compressed-change-logs)
-	      (const :tag "ChangeLogs" change-logs)))
-
-(defcustom patcher-default-change-logs-separator
-  "-------------------- ChangeLog entries follow: --------------------"
-  "*ChangeLog entries separator for Patcher commit log messages.
-
-Either nil, or a string which will be inserted in a line of its own.
-
-See also the function `patcher-logmsg-insert-change-logs'."
-  :group 'patcher-default
-  :type 'string)
-
-(defcustom patcher-default-edit-log-message t
-  "*Whether Patcher lets you edit the commit log message.
-
-If nil, Patcher will directly use the initialization value \(see
-`patcher-default-init-log-message')."
-  :group 'patcher-default
-  :type 'boolean)
-
-(defcustom patcher-default-kill-source-files-after-sending t
-  "*Whether to kill source files after sending the mail.
-
-This is effective only when sources files have not been killed already
-\(see the variable `patcher-default-kill-source-files-after-diffing').
-
-That feature is not implemented yet."
-  :group 'patcher-default
-  :type 'boolean)
-
-(defcustom patcher-default-kill-change-logs-after-sending t
-  "*Whether to kill the ChangeLog files after sending the mail."
-  :group 'patcher-default
-  :type 'boolean)
-
-(defcustom patcher-default-kill-source-files-after-diffing t
-  "*Whether to kill source files after building the ChangeLog skeletons.
-
-These files are loaded temporarily by `patch-to-change-log'.  If this
-variable is non nil, `patch-to-change-log' will be instructed to remove
-them when they are not needed anymore.
-
-See also the variable `patcher-default-kill-source-files-after-sending'."
-  :group 'patcher-default
-  :type 'boolean)
-
-(defcustom patcher-default-themes nil
-  "*Default themes to use in Patcher projects.
-
-This is a list of theme names (symbols) that must be defined in the
-`patcher-themes' user option."
-  :group 'patcher-default
-  ;; #### NOTE: ideally, this type should be computed automatically, depending
-  ;; #### on the defined themes.  This arises the interesting question of
-  ;; #### custom dynamic types.  Without them, it's a complex thing to do.
-  :type '(repeat (symbol :tag "Theme name")))
-
-
-;; Defining these const avoids coding special cases for the :inheritance,
-;; :subdirectory, :files and :command-directory (sub)project option in the
-;; accessor functions.
-(defconst patcher-default-inheritance nil)
-(defconst patcher-default-subdirectory nil)
-(defconst patcher-default-files nil)
-
-(defconst patcher-project-options-custom-type
-  '((list :inline t :tag "Project name"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :name)
-	  (choice (const :tag "Patcher name" nil)
-		  (string :tag "Other name")))
-    (list :inline t :tag "Mail method"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :mail-method)
-	  (choice (const compose-mail)
-		  (const sendmail)
-		  (const message)
-		  (const gnus)
-		  (const fake)
-		  (symbol :tag "other")))
-    (list :inline t :tag "User name"
-	  :format "%{%t%}: %v"
-	  (const  :tag "" :value :user-name)
-	  (choice (const :tag "user-full-name" nil)
-		  string))
-    (list :inline t :tag "User mail"
-	  :format "%{%t%}: %v"
-	  (const  :tag "" :value :user-mail)
-	  (choice (const :tag "user-mail-address" nil)
-	          string))
-    (list :inline t :tag "To address"
-	  :format "%{%t%}: %v"
-	  (const  :tag "" :value :to-address)
-	  (choice (const :tag "Ask" nil)
-		  string))
-    (list :inline t :tag "Gnus group"
-	  :format "%{%t%}: %v"
-	  (const  :tag "" :value :gnus-group)
-	  (choice (const :tag "Ask" nil)
-		  string))
-    (list :inline t :tag "Subject prefix"
-	  :format "%{%t%}: %v"
-	  (const  :tag "" :value :subject-prefix)
-	  string)
-    (list :inline t :tag "Subject committed prefix"
-	  :format "%{%t%}: %v"
-	  (const  :tag "" :value :subject-committed-prefix)
-	  (choice (const :tag "None" nil)
-		  string))
-    (list :inline t :tag "Subject"
-	  :format "%{%t%}: %v"
-	  (const  :tag "" :value :subject)
-	  string)
-    (list :inline t :tag "Mail prologue"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :mail-prologue)
-	  string)
-    (list :inline t :tag "ChangeLogs updating"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :change-logs-updating)
-	  (choice (const :tag "Automatic" automatic)
-		  (const :tag "Manual" manual)
-		  (const :tag "None" nil)))
-    (list :inline t :tag "ChangeLogs user name"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :change-logs-user-name)
-	  (choice (const :tag "Default" nil)
-		  (string :tag "Other name")))
-    (list :inline t :tag "ChangeLogs user mail"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :change-logs-user-mail)
-	  (choice (const :tag "Default" nil)
-		  (string :tag "Other mail")))
-    (list :inline t :tag "ChangeLogs appearance"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :change-logs-appearance)
-	  (choice (const :tag "Verbatim" verbatim)
-		  (const :tag "Diff, packed together" packed)
-		  (const :tag "Diff, part of the patch" patch)
-		  (const :tag "Don't appear" nil)))
-    (list :inline t :tag "ChangeLogs prologue"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :change-logs-prologue)
-	  string)
-    (list :inline t :tag "Diff prologue function"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :diff-prologue-function)
-	  (choice (const :tag "Default" patcher-default-diff-prologue)
-		  (const :tag "None" nil)
-		  (symbol :tag "Other")))
-    (list :inline t :tag "Command directory"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :command-directory)
-	  (choice (const :tag "Same directory" nil)
-		  (string :tag "Other directory")))
-    (list :inline t :tag "Pre command"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :pre-command)
-	  string)
-    (list :inline t :tag "Diff command"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :diff-command)
-	  string)
-    (list :inline t :tag "After diff hook"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :after-diff-hook)
-	  hook)
-    (list :inline t :tag "Diff line filter"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :diff-line-filter)
-	  regexp)
-    (list :inline t :tag "ChangeLogs diff command"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :change-logs-diff-command)
-	  (choice (const :tag "Project diff command" diff)
-		  (string :tag "Other diff command" "cvs -q diff -U 0 %f")))
-    (list :inline t :tag "Commit privilege"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :commit-privilege)
-	  boolean)
-    (list :inline t :tag "Commit command"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :commit-command)
-	  string)
-    (list :inline t :tag "Confirm commits"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :confirm-commits)
-	  boolean)
-    (list :inline t :tag "Committed notice"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :committed-notice)
-	  string)
-    (list :inline t :tag "Failed command regexp"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :failed-command-regexp)
-	  regexp)
-    (list :inline t :tag "Log message items"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :log-message-items)
-	  (set (const :tag "Subject" subject)
-	       (const :tag "Compressed ChangeLogs" compressed-change-logs)
-	       (const :tag "ChangeLogs" change-logs)))
-    (list :inline t :tag "ChangeLogs separator"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :change-logs-separator)
-	  string)
-    (list :inline t :tag "Edit log message"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :edit-log-message)
-	  boolean)
-    (list :inline t
-	  :tag "Kill source files after sending"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :kill-source-files-after-sending)
-	  boolean)
-    (list :inline t
-	  :tag "Kill changeLogs after sending"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :kill-change-logs-after-sending)
-	  boolean)
-    (list :inline t
-	  :tag "Kill source files after diffing"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :kill-source-files-after-diffing)
-	  boolean)
-    (list :inline t :tag "Themes"
-	  :format "%{%t%}: %v"
-	  (const :tag "" :value :themes)
-	  ;; #### NOTE: ideally, this type should be computed automatically,
-	  ;; #### depending on the defined themes.  This arises the
-	  ;; #### interesting question of custom dynamic types.  Without them,
-	  ;; #### it's a complex thing to do.
-	  (repeat (symbol :tag "Theme name"))))
-  ;; This is currently useless, and would cause problems in the custom type:
-  ;; it will match the inheritance field in patcher-projects before the
-  ;; corresponding custom type definition.
-  ;;    (list :inline t :tag "Other"
-  ;;	  symbol
-  ;;	  sexp))
-  ;; Custom type elements for Patcher project options common to
-  ;; `patcher-projects' and `patcher-subprojects'.
-  )
-
-
-(defgroup patcher-themes nil
-  "Theme settings for Patcher projects."
-  :group 'patcher)
-
-(defcustom patcher-themes '()
-  "*List of themes to use in Patcher projects.
-
-Each element looks like \(NAME :OPTION VALUE ...).  NAME is the theme
-name (a symbol).  The remainder of the list is the same as in project
-descriptors (see `patcher-projects').
-
-See also `patcher-max-theme-depth'."
-  :group 'patcher-themes
-  :type `(repeat
-	  (group (symbol :tag "Theme name")
-		 ;; #### NOTE: we could be tempted to add an `inheritance'
-		 ;; #### mechanism for themes, just like for projects.
-		 ;; #### However, don't forget that a theme can contain other
-		 ;; #### themes because themes belong to
-		 ;; #### `patcher-project-options-custom-type'.
-		 (repeat :inline t :tag "Options"
-			 (choice :inline t :value (:mail-method compose-mail)
-				 ,@patcher-project-options-custom-type))
-		 ))
-  )
-
-
-(defgroup patcher-projects nil
-  "Project settings for Patcher."
-  :group 'patcher)
-
-(defcustom patcher-projects '()
-  "*List of project descriptors.
-
-Each project descriptor looks like \(NAME DIR :OPTION VALUE ...).
-- NAME is the project's name \(a string).
-- DIR is the project's root directory (a string).
-
-The remainder of the project descriptor is composed of \"project options\"
-\(keyword / value pairs).  When Patcher needs a project option, it tries
-to find it at different places:
-- First, it looks for it in the project descriptor itself.
-- If that fails, it tries to find it in the project themes, if any.
-- If that fails, it tries to find it in the inherited projects, if any.
-- If that fails, it falls back to the corresponding `patcher-default-*'
-  user option."
-  :group 'patcher-projects
-  :type `(repeat
-	  (group (string :tag "Project")
-		 (directory :tag "Project directory")
-		 (repeat :inline t :tag "Options"
-			 (choice :inline t :value (:mail-method compose-mail)
-				 ,@patcher-project-options-custom-type
-				 (list :inline t :tag "Inheritance"
-				       :format "%{%t%}: %v"
-				       (const :tag "" :value :inheritance)
-				       (repeat :tag "From"
-					       (string :tag "Project")))))
-		 ))
-  )
-
-(defcustom patcher-subprojects '()
-  "*List of Patcher subproject descriptors.
-
-Subproject descriptors are similar to project descriptors \(see the
-variable `patcher-projects') with a few exceptions:
-
-- Instead of the project directory field DIR, you specify the name of the
-  project this subproject is based on.
-- Two project options are available in addition to the standard ones:
-  - :subdirectory lets you specify a subdirectory \(of the parent
-     project's directory) in which the whole subproject resides.  There is
-     no corresponding `patcher-default-subdirectory' fallback..
-  - :files lets you specify a list of files or directories composing the
-     subproject.  Each file specification can contain wildcards.  If a
-     :subdirectory option is given, these files or directories should be
-     relative to this subdirectory.  Otherwise, they should be relative to
-     the base project's directory.  There is no corresponding
-     `patcher-default-files' variable.
-  Note that a subproject with neither a :subdirectory nor a :files option
-  behaves exactly like the corresponding base project.
-- Subprojects don't have an :inheritance mechanism.  Instead, they
-  implicitly inherit from their base project \(which in turn can inherit
-  from other projects).
-
-Note: the normal way to use predefined Patcher subprojects is to call
-`patcher-mail', *not* `patcher-mail-subproject'.  Using the former will
-directly use the set of files and/or directory you have specified.  Using
-the latter will also let you modify this set."
-  :group 'patcher-projects
-  :type `(repeat
-	  (group (string :tag "Subproject")
-		 (string :tag "Of project")
-		 (repeat :inline t :tag "Options"
-			 (choice :inline t :value (:subdirectory "")
-				 ;; #### Look inside the widget library to see
-				 ;; #### how we can modify the completion
-				 ;; #### behavior
-				 (list :inline t :tag "Subdirectory"
-				       :format "%{%t%}: %v"
-				       (const :tag "" :value :subdirectory)
-				       directory)
-				 (list :inline t :tag "Files"
-				       :format "%{%t%}: %v"
-				       (const :tag "" :value :files)
-				       (repeat :format "\n%v%i\n" file))
-				 ,@patcher-project-options-custom-type))
-		 ))
-  )
-
-
-;; Project descriptors Accessors =============================================
-
-;; #### NOTE: the accessors routines don't handle the case where the same
-;; #### option is given several times.  Only the first one is used.  This
-;; #### currently would have any sensible meaning anyway.
-
-(defsubst patcher-project-patcher-name (project)
-  (nth 0 project))
-
-(defsubst patcher-subproject-p (project)
-  ;; Return non nil if PROJECT is defined in `patcher-subprojects'.
-  (member project patcher-subprojects))
-
-(defcustom patcher-max-theme-depth 8
-  "*Maximum nesting level in Patcher themes.
-
-This option is a guard against infinite loops that might occur for wrong
-settings of Patcher themes (as themes can contain themes)."
-  :group 'patcher-themes
-  :type 'integer)
-
-(defun patcher-themes-option (themes option level)
-  ;; Look for an option in a list of themes.  Note that themes can have the
-  ;; :themes option set.  The themes tree (it shouldn't be a graph) is
-  ;; traversed in depth first.
-  (let (theme value)
-    (while (and (not value) (setq theme (pop themes)))
-      (setq theme (assoc theme patcher-themes))
-      (or theme (patcher-error "`%s': no such theme" theme))
-      (let ((theme-options (cdr theme)))
-	(setq value (member option theme-options))
-	(unless value
-	  (let ((subthemes (member :themes theme-options)))
-	    (when (> level patcher-max-theme-depth)
-	      (patcher-error "\
-Theme `%s': maximum nesting level of themes exceeded.
-Either you have an infinite loop in your theme's :themes option, or you should
-increase the value of `patcher-max-theme-depth'"
-	       (car theme)))
-	    (setq value
-		  (patcher-themes-option (cadr subthemes) option (1+ level)))
-	    ))
-	))
-    value))
-
-(defcustom patcher-max-inheritance-depth 8
-  "*Maximum nesting level in Patcher projects.
-
-This option is a guard against infinite loops that might occur for wrong
-settings of Patcher projects (as projects can inherit projects)."
-  :group 'patcher-projects
-  :type 'integer)
-
-(defun patcher-project-option-1 (project option level)
-  ;; Try to find an option in the project descriptor, otherwise, try in each
-  ;; project from the project's inheritance list.
-  ;; The whole option form is returned: '(:stuff value)
-  (when (> level patcher-max-inheritance-depth)
-    (patcher-error "\
-Project `%s': maximum nesting level of projects exceeded.
-Either you have an infinite loop in your project's inheritance, or you should
-increase the value of `patcher-max-inheritance-depth'"
-		   (patcher-project-patcher-name project)))
-  (let* ((is-subproject (patcher-subproject-p project))
-	 (options (cddr project))
-	 (value (member option options)))
-    ;; Try to find the option in themes.
-    (unless value
-      (let ((themes (member :themes options)))
-	(when themes
-	  (setq value (patcher-themes-option (cadr themes) option 0)))
-	))
-    ;; Try to find the option in inherited projects.  Note that inherited
-    ;; projects can have their :inherit option set in turn.  The inheritance
-    ;; tree (it shouldn't be a graph) is traverse in depth first.
-    (unless value
-      (let ((projs (if is-subproject
-		       (list (nth 1 project))
-		     (cadr (member :inheritance options))))
-	    proj)
-	(when projs
-	  (while (and (not value) (setq proj (pop projs)))
-	    ;; #### FIXME: what happens if we inherit from something like a
-	    ;; #### subproject which is unrelated to the current project ?
-	    (setq value (patcher-project-option-1 (assoc proj patcher-projects)
-						  option (1+ level)))))
-	))
-    ;; Now some checkings.
-    (when (and (eq option :files) value)
-      (if is-subproject
-	  ;; Return the files as a string, not as the original list.
-	  (setq value (list :files (mapconcat #'identity (cadr value) " ")))
-	;; #### NOTE: we don't normally check other user-level errors (like,
-	;; #### only projects can have an :inheritance option above).
-	;; #### However, that case is special: we have some blind calls to
-	;; #### `patcher-project-option' that could get an illegal :files
-	;; #### options  from illegal projects.  These calls are supposed to
-	;; #### return `nil' as a  result, so we perform the checking.
-	(patcher-error "Project `%s': only subprojects can have a :file option"
-		       (patcher-project-patcher-name project))
-	(setq value nil)))
-    value))
-
-(defun patcher-project-option (project option)
-  ;; Returns either a project's option, or the patcher-default-* value.
-  (let ((opt (patcher-project-option-1 project option 0)))
-    (if opt
-	(cadr opt)
-      (symbol-value
-       (intern-soft
-	(concat "patcher-default-" (substring (symbol-name option) 1))))
-      )))
-(put 'patcher-project-option 'lisp-indent-function 1)
-
-(defsubst patcher-project-name (project)
-  (let ((name (patcher-project-option project :name)))
-    (or name (patcher-project-patcher-name project))
-    ))
-
-(defun patcher-project-directory (project)
-  ;; Returns the project directory of PROJECT, possibly expanded as a project
-  ;; subdir if PROJECT is a subproject.
-  (if (patcher-subproject-p project)
-      (let ((prj (assoc (nth 1 project) patcher-projects)))
-	(unless prj
-	  (patcher-error "Can't find base project for subproject `%s'"
-			 (patcher-project-patcher-name project)))
-	(let ((subdir (patcher-project-option project :subdirectory)))
-	  (if subdir
-	      (expand-file-name subdir (patcher-project-directory prj))
-	    (patcher-project-directory prj))))
-    ;; else: (member project patcher-projects)
-    (nth 1 project)))
-
-
-;; ===========================================================================
-;; Internal utilities
-;; ===========================================================================
-
-;; #### NOTE: this is currently useless.
-(defvar patcher-instances nil
-  ;; A list of all alive instances of Patcher (an instance is dead after the
-  ;; mail has been sent.  Each element is of the form '(BUFFER_NAME . BUFFER).
-  )
-
-(defconst patcher-change-log-entry-start-regexp
-  "^[0-9]\\{4,4\\}-[0-9]\\{2,2\\}-[0-9]\\{2,2\\} "
-  ;; Regexp matching the beginning of a ChangeLog entry
-  )
-
-;; Buffer local variables ====================================================
-
-;; The following variables get local values in various Patcher buffers (mail
-;; buffer, process output buffer etc).
-
-(make-variable-buffer-local
- (defvar patcher-project nil
-   ;; Patcher project related to the current patch.  This is also set in
-   ;; auxiliary buffers.
-   ))
-
-(make-variable-buffer-local
- (defvar patcher-mail-buffer nil
-   ;; Mail buffer corresponding to Patcher auxiliary buffers.
-   ))
-
-
-;; Utility functions =========================================================
-
-;;(defun patcher-keyword-value (keyword values)
-;;  ;; Return the value of KEYWORD from a (KEY VAL ...) list.  VAL may be omitted
-;;  ;; in the list, in which case t is returned.
-;;  (let ((vals values)
-;;	key val)
-;;    (catch 'found
-;;      (while (setq key (pop vals))
-;;	(setq val (or (not (car vals))
-;;		      (if (keywordp (car vals)) t (pop vals))))
-;;	(and (eq keyword key)
-;;	     (throw 'found val))))
-;;    ))
-
-
-(defsubst patcher-substitute-name (project str)
-  ;; Replace a %N in string STR with the current project's name.
-  ;; Replace a %n in string STR with the value of :name, if set, and with the
-  ;; current project's name otherwise.
-  (let ((name (patcher-project-name project))
-	(patcher-name (patcher-project-patcher-name project))
-	case-fold-search)
-    (replace-in-string (replace-in-string str "%N" patcher-name)
-		       "%n" name)
-    ))
-
-(defun patcher-command (project command &optional files)
-  ;; Build a Patcher command from COMMAND that applies to FILES.
-  ;; This involves %n and %f substitution, and :pre-command handling.
-
-  ;; 1/ %n substitution:
-  (setq command (patcher-substitute-name project command))
-
-  ;; 2/ Force Unix syntax, and replace a %f in COMMAND with the files
-  ;; (if any) converted to a string, or append it to the end of STR.
-  (setq files (if files
-		  (replace-in-string (mapconcat #'identity files " ")
-				     "\\\\" "/")
-		""))
-  (cond ((string-match "%f" command)
-	 (setq command (replace-in-string
-			(replace-in-string command "%f" files)
-			"[ \t]+$" "")))
-	((> (length files) 0)
-	 (setq command (concat command " " files)))
-	)
-
-  ;; 3/ Prepend the :pre-command option to COMMAND, if any.
-  (let ((precmd (patcher-project-option project :pre-command)))
-    (when (> (length precmd) 0)
-      (setq command (concat precmd " " command))
-      ))
-  command)
-
-(defsubst patcher-call-process (command &optional buffer)
-  ;; Call a shell process which executes COMMAND (a string) with output to
-  ;; BUFFER (the current buffer by default).
-  (apply 'call-process shell-file-name nil (or buffer t) nil
-	 shell-command-switch (list command)))
-
-(defsubst patcher-extent (property &optional value buffer)
-  ;; Get the extent that has PROPERTY set to VALUE (t if not given) in BUFFER
-  ;; (current buffer if nil).
-  (car (mapcar-extents #'identity nil buffer nil nil nil
-		       property (or value t))))
-
-(defun patcher-process-output-buffer (&optional mail-buffer)
-  ;; Get a process output buffer for the current Patcher MAIL-BUFFER (current
-  ;; buffer by default), and prepare it.  We can reuse an already existing one
-  ;; because auxiliary buffers are currently used only in one Lisp shot, so
-  ;; there's no risk of Patcher instances overlapping.
-  (let ((project patcher-project)
-	(directory default-directory)
-	(buffer (get-buffer-create " *Patcher Process Output*")))
-    (or mail-buffer (setq mail-buffer (current-buffer)))
-    (with-current-buffer buffer
-      (cd directory)
-      (setq patcher-project project)
-      (setq patcher-mail-buffer mail-buffer)
-      (erase-buffer))
-    buffer))
-
-
-
-;; ==========================================================================
-;; ChangeLog buffers
-;; ==========================================================================
-
-(defun patcher-read-natnum (prompt &optional default-value)
-  ;; Hacked from read-number
-  ;; Read a natural number from the minibuffer, prompting with PROMPT.
-  ;; If optional second argument DEFAULT-VALUE is non-nil, return that if user
-  ;; enters an empty line.
-  (let ((pred (lambda (val) (and (integerp val) (> val 0))))
-	num)
-    (while (not (funcall pred num))
-      (setq num (condition-case ()
-		    (let ((minibuffer-completion-table nil))
-		      (read-from-minibuffer
-		       prompt (if num (prin1-to-string num)) nil t
-		       nil nil (and default-value
-				    (prin1-to-string default-value))))
-		  (input-error nil)
-		  (invalid-read-syntax nil)
-		  (end-of-file nil)))
-      (or (funcall pred num) (beep)))
-    num))
-
-(defun patcher-change-log-extent (change-log mail)
-  ;; Return (maybe after creating it) the extent in buffer CHANGE-LOG which
-  ;; has the 'patcher property set to the buffer MAIL.
-  (let ((extent (patcher-extent 'patcher mail change-log)))
-    (unless extent
-      (save-window-excursion
-	(display-buffer change-log t)
-	(let ((entries (patcher-read-natnum "Number of entries (1): " 1))
-	      beg end)
-	  (save-excursion
-	    (set-buffer change-log)
-	    (save-restriction
-	      (widen)
-	      (goto-char (point-min))
-	      (skip-chars-forward " \n\t")
-	      (unless (looking-at patcher-change-log-entry-start-regexp)
-		(patcher-error "\
-Beginning of buffer doesn't look like a ChangeLog entry."))
-	      (setq beg (point))
-	      (condition-case nil
-		  (while (> entries 0)
-		    (re-search-forward patcher-change-log-entry-start-regexp)
-		    (setq entries (1- entries)))
-		(t
-		 (patcher-error "\
-Buffer is missing %s ChangeLog entr%s to do the count."
-				entries (if (= entries 1) "y" "ies"))))
-	      (setq end
-		    (or (and (re-search-forward
-			      patcher-change-log-entry-start-regexp nil t)
-			     (progn (beginning-of-line) (point)))
-			(point-max)))
-	      (set-extent-properties (setq extent (make-extent beg end))
-		`(patcher ,mail))
-	      ))
-	  )))
-    extent))
-
-
-
-;; ==========================================================================
-;; The LogMsg buffer
-;; ==========================================================================
-
-(make-variable-buffer-local
- (defvar patcher-logmsg-file-name nil
-   ;; Name of the temporary file where the log message is stored.
-   ))
-
-(make-variable-buffer-local
- (defvar patcher-logmsg-commit-command
-   ;; Commit command used for the current Patcher LogMsg buffer.  This variable
-   ;; is needed because the user has the ability to override the command with
-   ;; a prefix argument.
-   ))
-
-(defun patcher-logmsg-compress-change-logs ()
-  ;; Compress ChangeLog entries appearing in the current buffer between FROM
-  ;; and TO.  This function compresses the output into something that conveys
-  ;; the essence of what has been changed, but much more compactly.
-  (save-excursion
-    (goto-char (point-min))
-    (let ((prologue (patcher-project-option patcher-project
-		      :change-logs-prologue)))
-      (when (> (length prologue) 0)
-	(setq prologue (concat
-			"^"
-			(replace-in-string
-			 (regexp-quote prologue) "%f" ".+")
-			"$"))
-	(delete-matching-lines prologue)))
-    (delete-matching-lines patcher-change-log-entry-start-regexp)
-    ;; Now compress the change log specs into just files, so that mostly just
-    ;; the annotations are left.
-    (let ((change-log-change-line
-	   "^\\([ \t]+\\)\\* \\(\\S-+\\)\\( (.*)\\)?:\\( New\\.\\)?"))
-      (while (re-search-forward change-log-change-line nil t)
-	(let ((beg (match-beginning 1));; Change to match-end if you want the
-	      ;; indentation.
-	      (end (match-end 0))
-	      files)
-	  (push (match-string 2) files)
-	  (forward-line 1)
-	  (while (looking-at change-log-change-line)
-	    (setq end (match-end 0))
-	    (unless (member (match-string 2) files)
-	      (push (match-string 2) files))
-	    (forward-line 1))
-	  (goto-char beg)
-	  (delete-region beg end)
-	  (insert (mapconcat 'identity (nreverse files) ", ") ":")
-	  (when (looking-at "\\s-+")
-	    (let ((p (point))
-		  (end (match-end 0)))
-	      ;; If there's no annotation at all for this change, make sure we
-	      ;; don't treat the next change as an annotation for this one!
-	      (if (save-excursion
-		    (goto-char end)
-		    (beginning-of-line)
-		    (looking-at change-log-change-line))
-		  (progn
-		    (if (looking-at "[ \t]+")
-			(delete-region p (match-end 0))))
-		(delete-region p end)
-		(insert " "))))
-	  )))
-    ;; Shrink extra blank lines.
-    (let ((blank-line "^\\s-*$"))
-      (goto-char (point-min))
-      (while (and (not (eobp))
-		  (progn (forward-line 1)
-			 (re-search-forward blank-line nil t)))
-	(delete-blank-lines))
-      (goto-char (point-min))
-      (if (looking-at blank-line)
-	  (delete-blank-lines)))
-    ))
-
-
-;; Patcher LogMsg mode ======================================================
-
-(defun patcher-logmsg-insert-subject ()
-  "Insert the Patcher mail subject into the current LogMsg buffer at point."
-  (interactive)
-  (let ((subject "(none)"))
-    (with-current-buffer patcher-mail-buffer
-      (save-excursion
-	(let ((extent (patcher-extent 'patcher-subject-prefix)))
-	  (if extent
-	      (progn
-		(goto-char (extent-end-position extent))
-		(skip-chars-forward " \t\f\r")
-		(unless (eq (point) (point-at-eol))
-		  (setq subject
-			(buffer-substring (point) (point-at-eol)))))
-	    (goto-char (point-min))
-	    (when (patcher-goto-subject)
-	      (skip-chars-forward " \t\f\r")
-	      (unless (eq (point) (point-at-eol))
-		(setq subject
-		      (buffer-substring (point) (point-at-eol))))))
-	  )))
-    (let ((doit (> (length subject) 0)))
-      (when doit (insert subject))
-      doit)
-    ))
-
-(defun patcher-logmsg-insert-change-logs (&optional separator)
-  "Insert ChangeLog entries in the current Patcher LogMsg buffer at point.
-When called interactively, use a prefix argument to also insert the
-ChangeLogs separator string defined by the :change-logs-separator project
-option."
-  (interactive "P")
-  (unless (point-at-bol)
-    (insert "\n"))
-  (when separator
-    (setq separator (patcher-project-option patcher-project
-		      :change-logs-separator))
-    (when (> (length separator) 0)
-      (insert separator "\n\n")))
-  (let ((prologue (patcher-project-option patcher-project
-		    :change-logs-prologue)))
-    (dolist (change-log (patcher-files-buffers
-			 (symbol-value-in-buffer 'patcher-change-logs
-						 patcher-mail-buffer)
-			 'find))
-      (when (> (length prologue) 0)
-	(insert (replace-in-string prologue "%f"
-				   (patcher-file-relative-name
-				    (buffer-file-name change-log)))
-		    "\n\n"))
-      (insert (extent-string
-	       ;; #### NOTE: there is an empty line at the end of this extent.
-	       (patcher-change-log-extent change-log patcher-mail-buffer))))
-    )
-  ;; -2 is because 1/ there's a spurious empty line inserted after the last
-  ;; element, and 2/ because we don't want automatic newlines at the end of
-  ;; the buffer, in case log messages are used as strings (for instance with
-  ;; PRCS).
-  (delete-char -2))
-
-(defun patcher-logmsg-insert-compressed-change-logs ()
-  "Insert compressed ChangeLog entries in the current Patcher LogMsg buffer."
-  (interactive)
-  (let ((beg (point)))
-    (patcher-logmsg-insert-change-logs)
-    (narrow-to-region beg (point))
-    (patcher-logmsg-compress-change-logs)
-    (widen)
-    ))
-
-
-;; #### NOTE: This should be defined in the Mail Buffer section, but defining
-;; #### it here avoids a compiler warning.
-(make-variable-buffer-local
- (defvar patcher-change-committed nil
-   ;; Boolean indicating whether the change has been committed already.
-   ))
-
-(defun patcher-logmsg-commit (&optional arg)
-  "Commit the change described in the current Patcher LogMsg buffer.
-When called interactively, use a prefix to override the commit command."
-  (interactive "P")
-  (let ((output-buffer (patcher-process-output-buffer patcher-mail-buffer))
-	(log-buffer (current-buffer))
-	runbuf
-	(change-logs (symbol-value-in-buffer 'patcher-change-logs
-					     patcher-mail-buffer))
-	(sources (symbol-value-in-buffer 'patcher-sources
-					 patcher-mail-buffer))
-	(pre-commit-window-config (symbol-value-in-buffer
-				   'patcher-pre-commit-window-config
-				   patcher-mail-buffer))
-	(confirm-commits (patcher-project-option patcher-project
-			   :confirm-commits)))
-    (patcher-save-buffers (patcher-files-buffers change-logs))
-    (and arg (setq patcher-logmsg-commit-command
-		   (read-shell-command "Commit command: "
-				       patcher-logmsg-commit-command)))
-    (let* ((command
-	    (patcher-command
-	     patcher-project
-	     (replace-in-string
-	      (let (case-fold-search)
-		(replace-in-string patcher-logmsg-commit-command
-				   "%S" (shell-quote-argument
-					 (buffer-substring)) t))
-	      "%s" patcher-logmsg-file-name t)
-	     (when sources
-	       (append (mapcar #'patcher-file-relative-name change-logs)
-		       sources)))))
-      ;; Maybe display the commit command, and make sure the user agrees.
-      (when (or (not confirm-commits)
-		(save-window-excursion
-		  (setq runbuf (get-buffer-create
-				"*Patcher Commit Command*"))
-		  (erase-buffer runbuf)
-		  (insert-string (format "Command to run:\n\n%s" command)
-				 runbuf)
-		  (display-buffer runbuf)
-		  (y-or-n-p "Run commit command? ")))
-	;; Write out the log message, or "(none)"
-	(and (= (point-min) (point-max)) (insert "(none)"))
-	(write-region (point-min) (point-max) patcher-logmsg-file-name
-		      nil 'silent)
-	(patcher-with-progression "Committing changes"
-	  (patcher-call-process command output-buffer))
-	;; Don't kill the log message buffer.  This will be done after sending
-	;; the message -- i.e. when we are done with this project.  We don't
-	;; kill the log message buffer now in case the user needs it later --
-	;; e.g. if the commit failed and needs to be redone (we try to detect
-	;; this, but we might not succeed in all cases.).
-	;; Try to see if the commit failed.
-	(with-current-buffer output-buffer
-	  (goto-char (point-min))
-	  (when (re-search-forward (patcher-project-option patcher-project
-				     :failed-command-regexp) nil t)
-	    (display-buffer output-buffer t)
-	    (with-current-buffer log-buffer
-	      ;; make sure substitute-command-keys is run in the right buffer
-	      (patcher-error "\
-Error during commit.  Please fix the problem and type \
-\\[patcher-logmsg-commit] to try again."))))
-	;; Otherwise, record the successful commit in the mail message.
-	;; #### NOTE: it is normal to protect the re-search-forward calls
-	;; #### against errors, because when the `fake mail' method is used,
-	;; #### neither the Subject line nore the mail-header-separator one
-	;; #### exist.
-	(with-current-buffer patcher-mail-buffer
-	  (setq patcher-change-committed t)
-	  (save-excursion
-	    ;; Possibly change the subject:
-	    (goto-char (point-min))
-	    (when (patcher-goto-subject)
-	      (let ((subject-committed-prefix
-		     (patcher-project-option patcher-project
-		       :subject-committed-prefix))
-		    (extent (patcher-extent 'patcher-subject-prefix)))
-		(when subject-committed-prefix
-		  (setq subject-committed-prefix
-			(patcher-substitute-name patcher-project
-						 subject-committed-prefix))
-		  (when extent
-		    (goto-char (extent-start-position extent))
-		    (delete-region (point) (extent-end-position extent)))
-		  (insert subject-committed-prefix)
-		  (and (looking-at "\\S-") (insert " ")))
-		))
-	    ;; Insert the `committed' notice:
-	    (goto-char (point-min))
-	    (when (re-search-forward
-		   (concat "^" (regexp-quote mail-header-separator))
-		   nil t)
-	      (forward-line 1)
-	      (let ((notice (patcher-project-option patcher-project
-			      :committed-notice)))
-		(when (> (length notice) 0)
-		  (insert notice "\n"))))
-	    ))
-	;; Bury the log message (see above).  Remove the log message window
-	;; and display the output buffer.
-	(bury-buffer log-buffer)
-	(set-window-configuration pre-commit-window-config)
-	(display-buffer output-buffer t))
-      (and runbuf (bury-buffer runbuf))
-      )))
-
-(defun patcher-logmsg-init-message ()
-  "(Re)Init the log message in the current Patcher LogMsg buffer.
-This is done conforming to the :log-message-items project option."
-  (interactive)
-  (erase-buffer)
-  (let ((items (patcher-project-option patcher-project :log-message-items))
-	(edit-log-message (patcher-project-option patcher-project
-			    :edit-log-message))
-	inserted)
-    (dolist (item items)
-      (cond ((eq item 'subject)
-	     (when inserted (insert "\n\n"))
-	     (setq inserted (patcher-logmsg-insert-subject)))
-	    ((eq item 'compressed-change-logs)
-	     (when inserted (insert "\n\n"))
-	     (patcher-logmsg-insert-compressed-change-logs)
-	     (setq inserted t))
-	    ((eq item 'change-logs)
-	     (when inserted (insert "\n\n"))
-	     (patcher-logmsg-insert-change-logs inserted))
-	    (t
-	     (patcher-error "invalid log message item: %s" item))))
-    (goto-char (point-min))
-    (if edit-log-message
-	(patcher-message "\
-Edit the log message, and press \\[patcher-logmsg-commit] when done.")
-      (patcher-logmsg-commit))
-    ))
-
-(defcustom patcher-logmsg-mode-hook nil
-  "*Hook to run after setting up Patcher-Logmsg mode."
-  :group 'patcher
-  :type 'hook)
-
-(defvar patcher-logmsg-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map [(control c) (control p) s] 'patcher-logmsg-insert-subject)
-    (define-key map [(control c) (control p) l]
-      'patcher-logmsg-insert-change-logs)
-    (define-key map [(control c) (control p) c]
-      'patcher-logmsg-insert-compressed-change-logs)
-    (define-key map [(control c) (control p) i] 'patcher-logmsg-init-message)
-    (define-key map [(control c) (control c)] 'patcher-logmsg-commit)
-    map))
-
-(defun patcher-logmsg-mode ()
-  "Major mode for Patcher commit log message management.
-You're not supposed to use this mode manually, unless you know what you're
-doing.
-
-\\{patcher-logmsg-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'patcher-logmsg)
-  (setq mode-name "Patcher-LogMsg")
-  (use-local-map patcher-logmsg-mode-map)
-  (run-hooks 'patcher-logmsg-mode-hook))
-
-
-
-;; ===========================================================================
-;; The Patcher mail buffer
-;; ===========================================================================
-
-(make-variable-buffer-local
- (defvar patcher-diff-marker nil
-   ;; Marker indicating the beginning of the diff.
-   ))
-
-(make-variable-buffer-local
- (defvar patcher-diff-command nil
-   ;; String containing the diff command to use.  This string is not supposed
-   ;; to include the files to which the command applies.  Only the command
-   ;; itself.  This variable is needed because the user has the ability to
-   ;; override the project's command by giving a prefix to
-   ;; `patcher-generate-diff'.
-   ))
-
-(make-variable-buffer-local
- (defvar patcher-sources nil
-   ;; List of files/directories command-line specification for the diff
-   ;; command.  This variable is needed because the user has the ability to
-   ;; override the project's files by calling `patcher-mail-subproject'
-   ;; instead of `patcher-mail'.
-   ))
-
-(make-variable-buffer-local
- (defvar patcher-change-logs-marker nil
-   ;; Marker indicating the beginning of the ChangeLog entries, when they are
-   ;; separated from the patch.
-   ))
-
-(make-variable-buffer-local
- (defvar patcher-change-logs nil
-   ;; List of ChangeLog absolute file names.  This is computed after the
-   ;; initial diff by `patcher-diff-base'.  Each element is a list of the form
-   ;; (FILENAME . LOADED). LOADED is a boolean indicating whether we loaded
-   ;; the file ourselves, and hence can kill it once we're done.
-   ))
-
-(make-variable-buffer-local
- (defvar patcher-pre-commit-window-config nil
-   ;; Window configuration, just prior to beginning a commit operation, so we
-   ;; can get back to it at the appropriate time later.
-   ))
-
-(make-variable-buffer-local
- (defvar patcher-logmsg-buffer nil
-   ;; Buffer containing the commit log message of the current Patcher mail.
-   ;; This buffer is not killed after the commit operation, but should when
-   ;; the message is sent.
-   ))
-
-(defmacro patcher-with-information (information &rest body)
-  `(save-window-excursion
-     (save-excursion
-       (with-output-to-temp-buffer
-	   " *Patcher Information*"
-	 (set-buffer " *Patcher Information*")
-	 (insert ,information))
-       ,@body)))
-(put 'patcher-with-information 'lisp-indent-function 1)
-
-(defsubst patcher-delete-extent-and-region (extent)
-  ;; Delete EXTENT and the corresponding region.
-  (when extent
-    (delete-region (extent-start-position extent) (extent-end-position extent)
-		   (extent-object extent))
-    (delete-extent extent)
-    ))
-
-(defun patcher-parse-region (&optional min max buffer)
-  ;; Parse a diff output between MIN and MAX in BUFFER.  Defaults to point min,
-  ;; point max and current buffer respectively.
-  ;; For each diffed file, create an extent with the following properties:
-  ;; 'patcher-change-log =  for ChangeLog files.
-  ;; 'patcher-source =  for source files.
-  ;; Return non nil if an error occured.
-  (with-current-buffer (or buffer (current-buffer))
-    (let ((file-re1 "^Index: \\(\\S-*\\)");; for archive  diff
-	  (file-re "^\\+\\+\\+ \\(\\S-*\\)");; for standard diff
-	  (basename-re "\\`\\(.*\\)/\\(.*\\)\\'")
-	  (min (or min (point-min)))
-	  (max (or max (point-max)))
-	  change-log file absfile dirname beg end)
-      (save-excursion
-	(goto-char min)
-	(save-excursion
-	  (and (re-search-forward file-re1 max t)
-	       (setq file-re file-re1)))
-	(while (re-search-forward file-re max t)
-	  (setq file (match-string 1))
-	  (if (string-match basename-re file)
-	      (setq dirname  (match-string 1 file))
-	    (setq dirname ""))
-	  (setq absfile (expand-file-name file default-directory))
-	  (setq beg (point-at-bol))
-	  (setq end (or (save-excursion
-			  (and (re-search-forward file-re max t)
-			       (point-at-bol)))
-			max))
-	  (setq change-log
-		(with-temp-buffer
-		  (cd (expand-file-name dirname default-directory))
-		  (find-change-log)))
-	  (let ((extent (make-extent beg end)))
-	    (set-extent-properties extent '(start-open t duplicable t))
-	    (set-extent-property extent
-				 (if (string= change-log absfile)
-				     'patcher-change-log
-				   'patcher-source)
-				 absfile)))
-	(goto-char min)
-	(re-search-forward (patcher-project-option patcher-project
-			     :failed-command-regexp)
-			   max t))
-      )))
-
-(defun patcher-generate-change-logs (&optional min max buffer)
-  ;; Generate ChangeLog skeletons based on the diff between MIN and MAX in
-  ;; BUFFER.  Defaults to point min, point max and current buffer respectively.
-  ;; Check `patcher-mail-buffer' first because if that is non nil, we're
-  ;; in an auxiliary buffer.  Otherwise, we're in a Patcher mail one.
-  (let ((mailbuf (or patcher-mail-buffer (current-buffer))))
-    (with-current-buffer (or buffer (current-buffer))
-      (patcher-with-progression "Generating ChangeLog skeletons"
-	(save-restriction
-	  (require 'add-log)
-	  (narrow-to-region (or min (point-min)) (or max (point-max)))
-	  (patch-to-change-log
-	   default-directory
-	   :my-name (patcher-project-option patcher-project
-					    :change-logs-user-name)
-	   :my-email (patcher-project-option patcher-project
-					     :change-logs-user-mail)
-	   :keep-source-files
-	   (not (patcher-project-option patcher-project
-					:kill-source-files-after-diffing))
-	   :extent-property 'patcher
-	   :extent-property-value mailbuf)))
-      ;; patch-to-change-log has the unfortunate side effect of burying all
-      ;; the ChangeLog buffers when it's done.  This is exactly the opposite of
-      ;; what we want, since once the ChangeLogs have been generated, the next
-      ;; step is to go visit them.  so put them (in order!) directly below the
-      ;; current buffer.
-      (let ((topbuf (car (buffer-list))))
-	(dolist (x (patcher-files-buffers
-		    (symbol-value-in-buffer 'patcher-change-logs mailbuf)))
-	  (bury-buffer x topbuf)
-	  ;; window-start ends up past the newly inserted entry, so fix that.
-	  (with-current-buffer x
-	    (let ((ex (patcher-extent 'patcher mailbuf)))
-	      (and ex (goto-char (extent-start-position ex))))))
-	(bury-buffer topbuf (car (buffer-list))))
-      )))
-
-(defun patcher-ungenerate-change-logs ()
-  ;; Delete ChangeLog skeletons created by a former call to
-  ;; `patcher-generate-change-logs', in the current Patcher mail buffer.
-  (dolist (change-log (patcher-files-buffers patcher-change-logs 'find))
-    (patcher-delete-extent-and-region
-     (patcher-change-log-extent change-log (current-buffer)))
-    (with-current-buffer change-log (save-buffer))))
-
-(defmacro patcher-map-change-log-extents (&optional buffer &rest body)
-  ;; Map BODY over all extents marking a ChangeLog contents in BUFFER.
-  `(mapcar-extents
-    (lambda (extent) ,@body)
-    nil (or ,buffer (current-buffer)) nil nil nil 'patcher-change-log))
-(put 'patcher-map-change-log-extents 'lisp-indent-function 1)
-
-(defmacro patcher-map-source-extents (&optional buffer &rest body)
-  ;; Map BODY over all extents marking a source contents in BUFFER.
-  `(mapcar-extents
-    (lambda (extent) ,@body)
-    nil (or ,buffer (current-buffer)) nil nil nil 'patcher-source))
-(put 'patcher-map-source-extents 'lisp-indent-function 1)
-
-(defun patcher-change-logs (&optional buffer)
-  ;; Return the list of ChangeLog absolute file names appearing in BUFFER
-  ;; (current buffer by default).
-  (let (change-logs)
-    (patcher-map-change-log-extents buffer
-      (let ((change-log (extent-property extent 'patcher-change-log)))
-	(push change-log change-logs)))
-    change-logs))
-
-(defun patcher-sources (&optional buffer)
-  ;; Return the list of source absolute file names appearing in BUFFER
-  ;; (current buffer by default).
-  (let (sources)
-    (patcher-map-source-extents buffer
-      (let ((source (extent-property extent 'patcher-source)))
-	(push source sources)))
-    sources))
-
-(defun patcher-remove-change-logs (&optional buffer)
-  ;; Remove ChangeLog contents from BUFFER (current buffer by default).
-  (patcher-with-progression "Removing ChangeLog contents"
-    (patcher-map-change-log-extents buffer
-      (patcher-delete-extent-and-region extent))))
-
-(patcher-globally-declare-boundp
- '(name source-diff source-files change-log-diff change-log-files))
-
-(defun patcher-default-diff-prologue (kind)
-  ;; Default function for inserting a diff prologue.
-  (cond ((eq kind 'sources)
-	 (insert name " source patch:\n"
-		 "Diff command:   " source-diff "\n"
-		 "Files affected: " source-files "\n"
-		 "\n")
-	 )
-	((eq kind 'change-logs)
-	 (insert name " ChangeLog patch:\n"
-		 "Diff command:   " change-log-diff "\n"
-		 "Files affected: " change-log-files "\n"
-		 "\n")
-	 )
-	((eq kind 'mixed)
-	 (insert name " patch:\n")
-	 (if (not change-log-diff)
-	     (insert "Diff command:             " source-diff "\n"
-		     "ChangeLog files affected: " change-log-files "\n"
-		     "Source files affected:    " source-files "\n")
-	   (insert "ChangeLog files diff command: " change-log-diff "\n"
-		   "Files affected:               " change-log-files "\n"
-		   "Source files diff command:    " source-diff "\n"
-		   "Files affected:               " source-files "\n"))
-	 (insert "\n")
-	 )
-	))
-
-(defun patcher-insert-diff (buffer)
-  ;; Insert the diff created in auxiliary BUFFER, and create the patcher-diff
-  ;; extent.  This function also filters out lines specified by the
-  ;; diff-line-filter project option.
-  (save-excursion
-    (goto-char patcher-diff-marker)
-    (let ((font-lock-always-fontify-immediately t)
-	  (pos (with-current-buffer buffer (goto-char (point-min))))
-	  (diff-line-filter
-	   (patcher-project-option patcher-project :diff-line-filter)))
-      (when diff-line-filter
-	(setq diff-line-filter (concat "^" diff-line-filter "\n"))
-	(while (re-search-forward diff-line-filter nil t nil buffer)
-	  (insert (buffer-substring pos (match-beginning 0) buffer))
-	  (setq pos (point buffer))))
-      (insert (buffer-substring pos nil buffer)))
-    (set-extent-properties (make-extent patcher-diff-marker (point))
-      '(start-open t patcher-diff t))
-    ))
-
-(defun patcher-prcs-diff-convert (&optional beg end)
-  "Patcher post-processor for PRCS diffs.
-This function removes the PRCS repository-specific path in front of
-filenames to turn the output into a standard diff output.
-This function is meant to be used as part of the :after-diff-hook
-project option"
-  (goto-char (or beg (point-min)))
-  (while (re-search-forward "^\\(Index:\\|---\\|\\+\+\\+\\) " end t)
-    (setq beg (point))
-    (skip-chars-forward "^/")
-    (forward-char 1)
-    (delete-region beg (point)))
-  )
-
-(defun patcher-run-after-diff-hook (buffer &optional beg end)
-  ;; If any, call the after-diff hooks on BUFFER (auxiliary or mail
-  ;; buffer), possibly limiting to the region (BEG END).
-  ;; #### NOTE: remember that patcher-projects is also set in auxiliary
-  ;; #### buffers.
-  (with-current-buffer buffer
-    (let ((after-diff-hook (patcher-project-option patcher-project
-			    :after-diff-hook)))
-      (when after-diff-hook
-	(patcher-with-progression "Running after diff hooks"
-	  (save-excursion
-	    (mapcar (lambda (func)
-		      (goto-char (point-min))
-		      (funcall func beg end))
-		    after-diff-hook)))))
-    ))
-
-(defun patcher-diff-all ()
-  ;; Create a global diff with both ChangeLogs and given files, insert it in
-  ;; the current Patcher mail buffer at the patcher-diff-marker position if it
-  ;; succeeded, and create the patcher-diff extent.
-  (patcher-save-buffers (patcher-files-buffers patcher-change-logs))
-  (let ((command
-	 (patcher-command patcher-project patcher-diff-command
-			  (when patcher-sources
-			    (append (mapcar #'patcher-file-relative-name
-					    patcher-change-logs)
-				    patcher-sources))))
-	(buffer (patcher-process-output-buffer)))
-    (patcher-with-progression "Generating global diff"
-      (patcher-call-process command buffer))
-    (patcher-run-after-diff-hook buffer)
-    (when (patcher-parse-region nil nil buffer)
-      (display-buffer buffer t)
-      (patcher-error "\
-Error during diff.  Please fix the problem and type \
-\\[patcher-generate-diff] to try again."))
-    (patcher-insert-diff buffer)
-    ))
-
-(defun patcher-insert-change-logs-verbatim ()
-  ;; Insert ChangeLog contents verbatim in the current Patcher mail buffer,
-  ;; and create the patcher-change-logs extent.
-  (let ((prologue
-	 (patcher-project-option patcher-project :change-logs-prologue)))
-    (patcher-with-progression "Inserting ChangeLog contents"
-      (save-excursion
-	(goto-char patcher-change-logs-marker)
-	(dolist (change-log (patcher-files-buffers patcher-change-logs 'find))
-	  (let ((extent
-		 (patcher-change-log-extent change-log (current-buffer)))
-		(beg (point)))
-	    (insert "\n")
-	    (when (> (length prologue) 0)
-	      (insert (replace-in-string prologue "%f"
-					 (patcher-file-relative-name
-					  (buffer-file-name change-log)))
-		      "\n\n"))
-	    (insert (extent-string extent))
-	    (set-extent-properties (make-extent beg (point))
-	      `(start-open t patcher-change-log
-			   ,(buffer-file-name change-log)))))
-	(set-extent-properties (make-extent patcher-change-logs-marker (point))
-	  '(start-open t patcher-change-logs t))))
-    ))
-
-(defun patcher-insert-change-logs-diff-prologue (command)
-  ;; Insert a ChangeLog diff prologue at point in current Patcher mail buffer.
-  (let ((function (patcher-project-option patcher-project
-		    :diff-prologue-function)))
-    (when function
-      (let ((name (patcher-project-name patcher-project))
-	    (change-log-files (patcher-files-string patcher-change-logs))
-	    (change-log-diff (patcher-command patcher-project command)))
-	(funcall function 'change-logs))
-      )))
-
-(defun patcher-diff-change-logs (command)
-  ;; Create a diff with only ChangeLogs, insert it in the current Patcher mail
-  ;; buffer at the patcher-change-logs-marker position if it succeeded, and
-  ;; create the patcher-change-logs extent.
-  (patcher-save-buffers (patcher-files-buffers patcher-change-logs))
-  (let ((buffer (patcher-process-output-buffer)))
-    (patcher-with-progression "Generating the ChangeLogs diff"
-      (patcher-call-process
-       (patcher-command patcher-project command
-			(mapcar #'patcher-file-relative-name
-				patcher-change-logs))
-       buffer))
-    (patcher-run-after-diff-hook buffer)
-    (when (patcher-parse-region nil nil buffer)
-      (display-buffer buffer t)
-      (patcher-error "\
-Error during diff.  Please fix the problem and type \
-\\[patcher-insert-change-logs] to try again."))
-    ;; #### FIXME: maybe check that all changelogs are diff'ed (meaning the
-    ;; #### user has not forgotten to update one of them).
-    (save-excursion
-      (goto-char patcher-change-logs-marker)
-      (patcher-insert-change-logs-diff-prologue command)
-      (let ((font-lock-always-fontify-immediately t))
-	(insert (buffer-substring nil nil buffer)))
-      (set-extent-properties (make-extent patcher-change-logs-marker (point))
-	'(start-open t patcher-change-logs t)))
-    ))
-
-(defun patcher-pack-change-logs ()
-  ;; Pack ChangeLog diffs to the change-logs marker in the current Patcher
-  ;; mail buffer, and create the patcher-change-logs extent.
-  (patcher-with-progression "Packing ChangeLog diffs"
-    (save-excursion
-      (goto-char patcher-change-logs-marker)
-      (patcher-insert-change-logs-diff-prologue patcher-diff-command)
-      (patcher-map-change-log-extents nil
-	(let ((contents (extent-string extent))
-	      (change-log (extent-property extent 'patcher-change-log))
-	      (beg (point)))
-	  (patcher-delete-extent-and-region extent)
-	  (insert contents)
-	  (set-extent-properties (make-extent beg (point))
-	    `(start-open t patcher-change-log ,change-log))))
-      (set-extent-properties (make-extent patcher-change-logs-marker (point))
-	`(start-open t patcher-change-logs t)))
-    ))
-
-(defun patcher-extent-error (extent)
-  ;; Look for an error in EXTENT.
-  ;; Update the 'patcher-error property as needed.
-  ;; Return 0 if status is unchanged, 1 if an error appeared, -1 if an error
-  ;; was fixed.
-  (let* ((old-error (if (extent-property extent 'patcher-error) 1 0))
-	 (new-error (if (save-excursion
-			  (goto-char (extent-start-position extent))
-			  (re-search-forward
-			   (patcher-project-option patcher-project
-			     :failed-command-regexp)
-			   (extent-end-position extent) t))
-			1 0))
-	 (error (- new-error old-error)))
-    (cond ((eq error 1)
-	   (set-extent-property extent 'patcher-error t))
-	  ((eq error -1)
-	   (set-extent-property extent 'patcher-error nil)))
-    error))
-
-(defun patcher-convert-change-log-diffs (command)
-  ;; Scan all ChangeLog diffs in the current Patcher mail buffer, and remake
-  ;; them one by one with the proper diff COMMAND, directly in place.
-  (save-excursion
-    (let ((diff-extent (patcher-extent 'patcher-diff))
-	  (errors 0)
-	  change-log beg end)
-      ;; #### Don't forget to start-close the diff extent !! A ChangeLog could
-      ;; #### appear at the beginning of the diff.
-      (set-extent-property diff-extent 'start-open nil)
-      (patcher-with-progression "Regenerating ChangeLog diffs"
-	(patcher-map-change-log-extents nil
-	  ;; #### WARNING: it seems that if I modify the extent contents here,
-	  ;; #### instead of deleting and recreating it, map(car)-extents goes
-	  ;; #### into an infinite loop, on all extents over and over again.
-	  (setq change-log (extent-property extent 'patcher-change-log))
-	  (goto-char (extent-start-position extent))
-	  (setq beg (point-marker))
-	  (patcher-delete-extent-and-region extent)
-	  (patcher-call-process
-	   (patcher-command patcher-project command
-			    (list (patcher-file-relative-name change-log))))
-	  (setq end (point-marker))
-	  (patcher-run-after-diff-hook (current-buffer) beg end)
-	  (setq extent (make-extent beg end))
-	  (set-extent-properties extent
-	    `(start-open t patcher-change-log ,change-log))
-	  (setq errors (+ errors (patcher-extent-error extent)))))
-      (set-extent-property diff-extent 'start-open t)
-      (and (> errors 0)
-	   (set-extent-property (patcher-extent 'patcher-diff)
-				'patcher-error errors)
-	   (patcher-error "\
-Problems during diff.  \
-Please type \\[patcher-insert-change-logs] to try again."))
-      )))
-
-(defun patcher-insert-diff-prologue (command)
-  ;; Insert a prologue at the top of the diff in the current Patcher mail
-  ;; buffer.
-  (let ((function (patcher-project-option patcher-project
-		    :diff-prologue-function)))
-    (when function
-      (let ((extent (patcher-extent 'patcher-diff))
-	    (name (patcher-project-name patcher-project))
-	    (source-diff
-	     (patcher-command patcher-project patcher-diff-command))
-	    ;; #### NOTE: maybe passing a list instead of a string would be
-	    ;; #### better.  I won't break backward compatibility though, at
-	    ;; #### least not before a major release.
-	    (source-files (patcher-files-string (patcher-sources)))
-	    (change-log-files (patcher-files-string patcher-change-logs))
-	    (change-log-diff
-	     (and (stringp command)
-		  (patcher-command patcher-project command))))
-	(set-extent-property extent 'start-open nil)
-	(save-excursion
-	  (goto-char patcher-diff-marker)
-	  (funcall function (if (symbolp command) command 'mixed)))
-	(set-extent-property extent 'start-open t)
-	))
-    ))
-
-(defun patcher-diff-base (buffer)
-  ;; Create the initial diff and deduce the ChangeLog files (these files can't
-  ;; be deduced from the variable `patcher-sources', even when set, because it
-  ;; might contain directory specifications).  No return value.
-  (patcher-with-progression "Diff'ing the project"
-    (patcher-call-process
-     (patcher-command patcher-project patcher-diff-command patcher-sources)
-     buffer))
-  (patcher-run-after-diff-hook buffer)
-  (when (patcher-parse-region nil nil buffer)
-    (display-buffer buffer t)
-    (patcher-error "\
-Error during diff.  \
-Please fix the problem and type \\[patcher-generate-diff] to try again."))
-  (unless (patcher-sources buffer)
-    (patcher-error "Your source files do not differ from the archive."))
-  (when (patcher-project-option patcher-project :change-logs-updating)
-    (setq patcher-change-logs nil)
-    (patcher-map-source-extents buffer
-      (let* ((file (extent-property extent 'patcher-source))
-	     (change-log (with-temp-buffer
-			   (cd (file-name-directory file))
-			   (find-change-log))))
-	(unless (assoc change-log patcher-change-logs)
-	  (push (cons change-log (not (get-file-buffer change-log)))
-		patcher-change-logs))))))
-
-(defun patcher-change-logs-diff-error ()
-  (patcher-error "\
-Patcher has detected a ChangeLog diff.  This can mean two things:
-
-- your project might be out of date (someone else has modified the ChangeLog
-  file in the meantime.  You should then update your project before running
-  Patcher.
-
-- you have spurious ChangeLog entries.  This happens for instance when you have
-  filled the ChangeLogs files manually, but Patcher is supposed to do so (the
-  :change-log-updating project option is 'automatic).  You should then clean up
-  your ChangeLog file before running Patcher."))
-
-(defun patcher-generate-diff-1 ()
-  ;; (Re)Create a diff in the current Patcher mail buffer.
-  (let ((buffer (patcher-process-output-buffer))
-	(updating (patcher-project-option patcher-project
-		    :change-logs-updating))
-	(appearance (patcher-project-option patcher-project
-		      :change-logs-appearance))
-	(regenerate (or (patcher-extent 'patcher-diff) patcher-change-logs)))
-    ;; Maybe clean up the place for a new diff.
-    (and regenerate
-	 (patcher-delete-extent-and-region (patcher-extent 'patcher-diff)))
-    (if (not updating)
-	;; We don't do ChangeLogs: just (re)diff the project.
-	(progn
-	  (patcher-diff-base buffer)
-	  (patcher-insert-diff buffer)
-	  (patcher-insert-diff-prologue 'sources)
-	  (patcher-message "\
-To commit your changes, type \\[patcher-commit-change]."))
-      ;; We do ChangeLogs, so deal with the formatting.
-      (cond ((eq updating 'automatic)
-	     ;; In the "automatic" case, ChangeLog contents insertion is
-	     ;; postponed until the user has edited the skeletons.  If no files
-	     ;; were specified, we have a chance to check that the project is
-	     ;; up to date: if a ChangeLog appears in the diff, the project
-	     ;; needs to be updated first.  Note that this does not catch all
-	     ;; cases though.
-	     (cond ((or (eq appearance 'verbatim)
-			(eq appearance 'packed))
-		    (let ((generate-change-logs t)
-			  (change-logs-extent
-			   (patcher-extent 'patcher-change-logs)))
-		      (when regenerate
-			(patcher-with-information
-			    (format "\
-ChangeLog skeletons for this patch have already been generated%s.
-
-If you answer `yes' to the question below, both the diff and the ChangeLog
-entries will be regenerated.  This means that current ChangeLog entries will be
-lost.  If otherwise your answer is `no', only the diff will be regenerated."
-				    (if change-logs-extent " and inserted" ""))
-			  (setq generate-change-logs (yes-or-no-p "\
-Regenerate ChangeLog skeletons ? ")))
-			(when generate-change-logs
-			  (patcher-delete-extent-and-region change-logs-extent)
-			  (patcher-ungenerate-change-logs)))
-		      (patcher-diff-base buffer)
-		      (when (if regenerate
-				(and generate-change-logs
-				     (not patcher-sources)
-				     (patcher-change-logs buffer))
-			      (and (not patcher-sources)
-				   (patcher-change-logs buffer)))
-			(patcher-change-logs-diff-error))
-		      ;; ChangeLogs appear outside the patch, so we can insert
-		      ;; the diff right now, and then generate the skeletons.
-		      (patcher-insert-diff buffer)
-		      (patcher-insert-diff-prologue 'sources)
-		      (if generate-change-logs
-			  (progn
-			    (patcher-generate-change-logs patcher-diff-marker
-							  (extent-end-position
-							   (patcher-extent
-							    'patcher-diff)))
-			    (patcher-message "\
-Please annotate the ChangeLog skeletons, \
-and type \\[patcher-insert-change-logs] to %s them."
-					     (if (eq appearance 'verbatim)
-						 "insert"
-					       "diff")))
-			;; not generate-change-logs
-			(if change-logs-extent
-			    (patcher-message "\
-To commit your changes, type \\[patcher-commit-change].")
-			  (patcher-message "\
-Please type \\[patcher-insert-change-logs] to %s the ChangeLogs"
-					   (if (eq appearance 'verbatim)
-					       "insert"
-					     "diff")))
-			)))
-		   ((eq appearance 'patch)
-		    (let ((generate-change-logs t))
-		      (when regenerate
-			(patcher-with-information "\
-ChangeLog skeletons for this patch have already been generated.
-
-If you answer `yes' to the question below, the ChangeLog entries will be
-regenerated.  This means that current ones will be lost.  If otherwise your
-answer is `no', it is assumed that you have edited the skeletons, and the
-project will be rediff'ed with them."
-			  (setq generate-change-logs (yes-or-no-p "\
-Regenerate ChangeLog skeletons ? ")))
-			(and generate-change-logs
-			     (patcher-ungenerate-change-logs)))
-		      (if generate-change-logs
-			  (progn
-			    (patcher-diff-base buffer)
-			    (when (and (not patcher-sources)
-				       (patcher-change-logs buffer))
-			      (patcher-change-logs-diff-error))
-			    ;; ChangeLogs must appear in the patch, so there's
-			    ;; no point in inserting the diff right now.  It
-			    ;; needs to be redone afterwards.
-			    (patcher-generate-change-logs nil nil buffer)
-			    (patcher-message "\
-Please annotate the ChangeLog skeletons, \
-and type \\[patcher-insert-change-logs] to create the whole diff.")
-			    )
-			;; not generate-change-logs
-			;; ChangeLogs are supposed to be written, so
-			;; everything goes as if we were in a 'manual case:
-			(let ((command (patcher-project-option patcher-project
-					 :change-logs-diff-command)))
-			  (cond ((eq command 'diff)
-				 (patcher-diff-all)
-				 (patcher-insert-diff-prologue 'mixed)
-				 )
-				((stringp command)
-				 (patcher-diff-all)
-				 (patcher-convert-change-log-diffs command)
-				 (patcher-insert-diff-prologue command)
-				 )
-				(t
-				 (patcher-error "\
-invalid `change-logs-diff-command' option: %s" command))
-				))
-			(patcher-message "\
-To commit your changes, type \\[patcher-commit-change].")
-			)))
-		   ((not appearance)
-		    (let ((generate-change-logs t))
-		      (when regenerate
-			(patcher-with-information "\
-ChangeLog skeletons for this patch have already been generated.
-
-If you answer `yes' to the question below, the ChangeLog entries will be
-regenerated.  This means that current ones will be lost.  If otherwise your
-answer is `no', the current CHangeLog entries won't be touched."
-			  (setq generate-change-logs (yes-or-no-p "\
-Regenerate ChangeLog skeletons ? ")))
-			(and generate-change-logs
-			     (patcher-ungenerate-change-logs)))
-		      (if generate-change-logs
-			  (progn
-			    (patcher-diff-base buffer)
-			    (when (and (not patcher-sources)
-				       (patcher-change-logs buffer))
-			      (patcher-change-logs-diff-error))
-			    ;; ChangeLogs do not appear, so we can insert the
-			    ;; diff right now, and then generate the
-			    ;; skeletons.
-			    (patcher-insert-diff buffer)
-			    (patcher-insert-diff-prologue 'sources)
-			    (patcher-generate-change-logs patcher-diff-marker
-							  (extent-end-position
-							   (patcher-extent
-							    'patcher-diff)))
-			    (message "\
-Please don't forget to annotate the ChangeLog skeletons.")
-			    )
-			;; not generate-change-logs
-			(patcher-diff-base buffer)
-			(patcher-remove-change-logs buffer)
-			(patcher-insert-diff buffer)
-			(patcher-insert-diff-prologue 'sources)
-			(patcher-message "\
-To commit your changes, type \\[patcher-commit-change].")
-			)))
-		   (t
-		    (patcher-error "\
-invalid `change-logs-appearance' option: %s" appearance)))
-	     )
-	    ((eq updating 'manual)
-	     ;; In the "manual" case, ChangeLogs are supposed to be already
-	     ;; written, so their insertion does not have to be postponed.  If
-	     ;; no files were specified, we have a chance to check that
-	     ;; ChangeLogs /really/ are up to date: the diff output should
-	     ;; contain all ChangeLog entries.
-	     (patcher-diff-base buffer)
-	     (when (and (not patcher-sources)
-			(not (equal (patcher-change-logs buffer)
-				    (mapcar 'car patcher-change-logs))))
-	       (patcher-error "\
-Some ChangeLog files are not updated.  \
-Please update them before running Patcher."))
-	     (cond ((eq appearance 'verbatim)
-		    ;; #### NOTE: when ChangeLog entries are part of the diff,
-		    ;; #### we could try to convert the diff to a verbatim
-		    ;; #### version  instead of calling
-		    ;; `patcher-insert-change-logs-verbatim'.
-		    (patcher-remove-change-logs buffer)
-		    (patcher-insert-diff buffer)
-		    (patcher-insert-diff-prologue 'sources)
-		    (or regenerate (patcher-insert-change-logs-verbatim)))
-		   ((eq appearance 'packed)
-		    (let ((command (patcher-project-option patcher-project
-				     :change-logs-diff-command)))
-		      (cond ((eq command 'diff)
-			     ;; We use the same diff command:
-			     (if (not patcher-sources)
-				 ;; All ChangeLogs appear in the diff.  We can
-				 ;; just move them to a pack.
-				 (progn
-				   (and regenerate
-					(patcher-remove-change-logs buffer))
-				   (patcher-insert-diff buffer)
-				   (patcher-insert-diff-prologue 'sources)
-				   (or regenerate
-				       (patcher-pack-change-logs)))
-			       ;; Otherwise, some ChangeLogs may not be there,
-			       ;; so rediff them all.
-			       (patcher-remove-change-logs buffer)
-			       (patcher-insert-diff buffer)
-			       (patcher-insert-diff-prologue 'sources)
-			       (or regenerate
-				   (patcher-diff-change-logs
-				    patcher-diff-command)))
-			     )
-			    ((stringp command)
-			     ;; The diff command is different.  We have to
-			     ;; (re)diff them anyway.
-			     (patcher-remove-change-logs buffer)
-			     (patcher-insert-diff buffer)
-			     (patcher-insert-diff-prologue 'sources)
-			     (or regenerate
-				 (patcher-diff-change-logs command))
-			     )
-			    (t
-			     (patcher-error "\
-invalid `change-logs-diff-command' option: %s" command))
-			    )))
-		   ((eq appearance 'patch)
-		    (let ((command (patcher-project-option patcher-project
-				     :change-logs-diff-command)))
-		      (cond ((eq command 'diff)
-			     (if patcher-sources
-				 ;; Some ChangeLog entries might not be
-				 ;; present, so we must rediff the whole
-				 ;; stuff.
-				 (progn
-				   (patcher-diff-all)
-				   (patcher-insert-diff-prologue 'mixed))
-			       ;; Otherwise, the ChangeLog entries are in the
-			       ;; diff.
-			       (patcher-insert-diff buffer)
-			       (patcher-insert-diff-prologue 'mixed)
-			       )
-			     )
-			    ((stringp command)
-			     (if (not patcher-sources)
-				 (progn
-				   (patcher-insert-diff buffer)
-				   (patcher-insert-diff-prologue command)
-				   (patcher-convert-change-log-diffs command))
-			       ;; else some ChangeLog entries might not be
-			       ;; present, so we must rediff the whole thing,
-			       ;; and convert each ChangeLog diff to the
-			       ;; proper command.
-			       (patcher-diff-all)
-			       (patcher-insert-diff-prologue command)
-			       (patcher-convert-change-log-diffs command)
-			       )
-			     )
-			    (t
-			     (patcher-error "\
-invalid `change-logs-diff-command' option: %s" command)
-			     ))
-		      ))
-		   ((not appearance)
-		    (patcher-remove-change-logs buffer)
-		    (patcher-insert-diff buffer)
-		    (patcher-insert-diff-prologue 'sources))
-		   (t
-		    (patcher-error "\
-invalid `change-logs-appearance' option: %s"
-				   appearance)))
-	     (patcher-message "\
-To commit your changes, type \\[patcher-commit-change]."))
-	    (t
-	     (patcher-error "invalid `change-logs-updating' option: %s"
-			    updating))
-	    ))
-    ))
-
-
-;; Patcher minor-mode ========================================================
-
-(defun patcher-insert-change-logs ()
-  "(Re)Insert ChangeLog entries in the current Patcher mail buffer."
-  (interactive)
-  (let ((updating
-	 (or (patcher-project-option patcher-project :change-logs-updating)
-	     (patcher-error "This project does not handle ChangeLogs")))
-	(appearance
-	 (or (patcher-project-option patcher-project :change-logs-appearance)
-	     (patcher-error
-	      "ChangeLogs are not supposed to appear in the message.")))
-	)
-    (cond ((or (eq updating 'automatic)
-	       (eq updating 'manual))
-	   (cond ((eq appearance 'verbatim)
-		  (or (patcher-extent 'patcher-diff)
-		      (patcher-error "Please generate the diff first."))
-		  (let* ((extent (patcher-extent 'patcher-change-logs))
-			 (do-it (or (not extent) (y-or-n-p "\
-ChangeLog entries already inserted.  Replace ? "))))
-		    (when do-it
-		      (patcher-delete-extent-and-region extent)
-		      (patcher-insert-change-logs-verbatim)))
-		  )
-		 ((eq appearance 'packed)
-		  (or (patcher-extent 'patcher-diff)
-		      (patcher-error "Please generate the diff first."))
-		  (let* ((extent (patcher-extent 'patcher-change-logs))
-			 (do-it (or (not extent) (y-or-n-p "\
-ChangeLog entries already inserted.  Replace ? "))))
-		    (when do-it
-		      (patcher-delete-extent-and-region extent)
-		      (let ((command (patcher-project-option patcher-project
-				       :change-logs-diff-command)))
-			(cond ((eq command 'diff)
-			       ;; We use the same diff command:
-			       (patcher-diff-change-logs patcher-diff-command)
-			       )
-			      ((stringp command)
-			       (patcher-diff-change-logs command)
-			       )
-			      (t
-			       (patcher-error "\
-invalid `change-logs-diff-command' option: %s" command))
-			      ))
-		      ))
-		  )
-		 ((eq appearance 'patch)
-		  (when (or (not (patcher-change-logs))
-			    (y-or-n-p "\
-ChangeLog entries already inserted.  Replace ? "))
-		    (patcher-delete-extent-and-region
-		     (patcher-extent 'patcher-diff))
-		    (let ((command (patcher-project-option patcher-project
-				     :change-logs-diff-command)))
-		      (cond ((eq command 'diff)
-			     (patcher-diff-all)
-			     (patcher-insert-diff-prologue 'mixed)
-			     )
-			    ((stringp command)
-			     (patcher-diff-all)
-			     (patcher-convert-change-log-diffs command)
-			     (patcher-insert-diff-prologue command)
-			     )
-			    (t
-			     (patcher-error "\
-invalid `change-logs-diff-command' option: %s" command))
-			    ))
-		    )
-		  )
-		 (t
-		  (patcher-error "invalid `change-logs-appearance' option: %s"
-				 appearance))
-		 )
-	   )
-	  (t
-	   (patcher-error "invalid `change-logs-updating' option: %s"
-			  updating)))
-    ))
-
-(defun patcher-commit-change (&optional arg)
-  "Prepare to, and possibly commit a change to a project's repository.
-The change is the one that is announced in the mail buffer.
-
-When called interactively, use a prefix (ARG) to override the commit
-command to use.  Note that this is not meant to modify the source and
-ChangeLog files affected by the commit: they are computed automatically."
-  (interactive "P")
-  (and patcher-change-committed
-       (patcher-error "Change already committed !"))
-  (let* ((buffer (generate-new-buffer "*Patcher Log Message*"))
-	 (project patcher-project)
-	 (directory default-directory)
-	 (mail-buffer (current-buffer)))
-    (with-current-buffer buffer
-      (patcher-logmsg-mode)
-      (cd directory)
-      (setq patcher-project project)
-      (setq patcher-mail-buffer mail-buffer)
-      (setq patcher-logmsg-file-name
-	    (replace-in-string (make-temp-name
-				(expand-file-name "patch" (temp-directory)))
-			       "\\\\" "/"))
-      (setq patcher-logmsg-commit-command
-	    (patcher-project-option patcher-project :commit-command))
-      (and arg
-	   (setq patcher-logmsg-commit-command
-		 (read-shell-command "Commit command: "
-				     patcher-logmsg-commit-command))))
-    (setq patcher-logmsg-buffer buffer)
-    (setq patcher-pre-commit-window-config (current-window-configuration))
-    (pop-to-buffer buffer)
-    (patcher-logmsg-init-message)
-    ))
-
-(defun patcher-generate-diff (&optional arg)
-  "(Re)generate the diff in the current Patcher mail buffer.
-When called interactively, use a prefix to override the diff command
-used for this project.
-
-Note that this is *not* the way to specify files affected by this patch.
-See the variable `patcher-subprojects' or the function
-`patcher-mail-subproject' for that."
-  (interactive "P")
-  (when (or (and (not (patcher-extent 'patcher-diff))
-		 (not patcher-change-logs))
-	    (y-or-n-p "Really regenerate the diff ? "))
-    (and arg (setq patcher-diff-command
-		   (read-shell-command "Diff command: " patcher-diff-command)))
-    (patcher-generate-diff-1)))
-
-(defun patcher-insert-patcher-header ()
-  ;; Insert a Patcher version header in the message.
-  (save-excursion
-    (goto-char (point-min))
-    (unless (re-search-forward "^X-Generated-By: Patcher " nil t)
-      ;; This search can fail in case of fake mail method.
-      (when (re-search-forward
-	     (concat "^" (regexp-quote mail-header-separator)) nil t)
-	(goto-char (point-at-bol))
-	(insert "X-Generated-By: " (patcher-version) "\n")))
-    ))
-
-
-(defcustom patcher-minor-mode-string " Patch"
-  "*Patcher minor mode modeline string."
-  :group 'patcher
-  :type 'string)
-
-(defcustom patcher-minor-mode-hook nil
-  "*Hooks to run after setting up Patcher minor mode."
-  :group 'patcher
-  :type 'hook)
-
-(defvar patcher-minor-mode-map
-  (let ((map (make-sparse-keymap 'patcher-minor-mode-map)))
-    (define-key map [(control c) (control p) d] 'patcher-generate-diff)
-    (define-key map [(control c) (control p) i] 'patcher-insert-change-logs)
-    (define-key map [(control c) (control p) c] 'patcher-commit-change)
-    (define-key map [(control c) (control p) v] 'patcher-version)
-    map)
-  ;; Patcher minor mode keymap.
-  )
-
-(make-variable-buffer-local
- (defvar patcher-minor-mode nil))
-
-(defun patcher-minor-mode (arg)
-  "Toggles Patcher minor mode.
-Used for mails prepared with `patcher-mail'.  You're not supposed to use
-this, unless you know what you're doing.
-
-\\{patcher-minor-mode-map}"
-  (interactive "*P")
-  (setq patcher-minor-mode
-	(if (null arg) (not patcher-minor-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (patcher-insert-patcher-header)
-  (run-hooks 'patcher-minor-mode-hook))
-
-(add-minor-mode
- 'patcher-minor-mode patcher-minor-mode-string patcher-minor-mode-map)
-
-
-;; ===========================================================================
-;; Mail preparation routines
-;; ===========================================================================
-
-(patcher-globally-declare-boundp '(message-exit-actions))
-
-
-(defvar patcher-projects-history nil
-  ;; History used for prompting patcher projects.
-  )
-
-(defvar patcher-subjects-history nil
-  ;; History used for prompting patcher mail subjects.
-  )
-
-(defgroup patcher-mail nil
-  "Mailing options for Patcher projects."
-  :group 'patcher)
-
-(defcustom patcher-mail-check-change-logs-insertion 'ask
-  "*ChangeLogs insertion checking prior to sending a Patcher mail.
-
-This option affects the behavior of Patcher when ChangeLogs are supposed
-to appear by manual insertion into the mail buffer:
-- if nil, Patcher never checks that you have inserted them, and lets you
-  send the message as-is,
-- if t, Patcher blindly aborts the sending process if you have forgotten
-  to insert the ChangeLogs in the message buffer,
-- if 'ask (the default), Patcher asks you whether you want to proceed with
-  sending or not."
-  :group 'patcher-mail
-  :type '(radio (const :tag "Never check" nil)
-		(const :tag "Abort sending upon omission" t)
-		(const :tag "Ask the user" ask)))
-
-(defcustom patcher-mail-check-commit-action 'ask
-  "*Commit action checking prior to sending a Patcher mail.
-
-This option affects the behavior of Patcher when you have set the
-:commit-privilege project option:
-- if nil, Patcher never checks that you have commited your changes,
-  and lets you send the message without having done so,
-- if t, Patcher blindly aborts the sending process if you have forgotten
-  to commit your changes,
-- if 'ask (the default), Patcher asks you whether you want to proceed with
-  sending or not."
-  :group 'patcher-mail
-  :type '(radio (const :tag "Never check" nil)
-		(const :tag "Abort sending upon omission" t)
-		(const :tag "Ask the user" ask)))
-
-(defun patcher-before-send ()
-  ;; Function hooked in the different mailing methods to perform some
-  ;; checkings prior to sending the message.
-  ;; #### NOTE: it is currently impossible (and probably not worth it) to
-  ;; #### offer an automatic ChangeLog insertion or commit operation at that
-  ;; #### point: we're already in an interactive call (the message sending
-  ;; #### pocess) and a complex trickery would be necessary in case of
-  ;; #### operation failure.  So it's simpler to just abort the sending, let
-  ;; #### the user manually fix things, and re-send the message.
-
-  ;; Check ChangeLogs insertion:
-  (let ((updating
-	 (patcher-project-option patcher-project :change-logs-updating))
-	(appearance
-	 (patcher-project-option patcher-project :change-logs-appearance)))
-    (when (and patcher-mail-check-change-logs-insertion
-	       (eq updating 'automatic) appearance)
-      (cond ((or (eq appearance 'verbatim) (eq appearance 'packed))
-	     (or (patcher-extent 'patcher-diff)
-		 (patcher-error "There's no diff in this message !"))
-	     (when (null (patcher-extent 'patcher-change-logs))
-	       (let ((proceed
-		      (or (null patcher-mail-check-change-logs-insertion)
-			  (and (eq patcher-mail-check-change-logs-insertion
-				   'ask)
-			       (y-or-n-p "\
-You did not insert the ChangeLog entries.  Proceed with sending anyway ? ")))))
-		 (unless proceed (patcher-error "\
-Sending aborted.  Please insert the ChangeLogs first."))))
-	     )
-	    ((eq appearance 'patch)
-	     (unless (patcher-change-logs)
-	       (let ((proceed
-		      (or (null patcher-mail-check-change-logs-insertion)
-			  (and (eq patcher-mail-check-change-logs-insertion
-				   'ask)
-			       (y-or-n-p "\
-You did not insert the ChangeLog entries.  Proceed with sending anyway ? ")))))
-		 (unless proceed(patcher-error "\
-Sending aborted.  Please insert the ChangeLogs first."))))
-	     )
-	    (t
-	     (patcher-error "invalid `change-logs-appearance' option: %s"
-			    appearance))
-	    )))
-  ;; Check commit operation:
-  (when (and (patcher-project-option patcher-project :commit-privilege)
-	     (not patcher-change-committed))
-    (let ((proceed (or (null patcher-mail-check-commit-action)
-		       (and (eq patcher-mail-check-commit-action 'ask)
-			    (y-or-n-p "\
-You did not commit your changes.  Proceed with sending anyway ? ")))))
-      (unless proceed (patcher-error "\
-Sending aborted.  Please commit your changes first.")))
-    ))
-
-(defun patcher-after-send (&optional unused)
-  ;; Function hooked in the different mailing methods to clean up the place
-  ;; when a Patcher mail is sent.
-  (setq patcher-instances (remassoc (buffer-name) patcher-instances))
-  (when (patcher-project-option patcher-project
-	  :kill-change-logs-after-sending)
-    (let ((buffers (patcher-files-buffers patcher-change-logs)))
-      (patcher-save-buffers buffers)
-      (dolist (b buffers)
-	(let ((ac (assoc (buffer-file-name b) patcher-change-logs)))
-	  (when (or (not ac) ;; #### ??????
-		    (cdr ac))
-	    (kill-buffer b))))))
-  (when patcher-logmsg-buffer
-    (kill-buffer patcher-logmsg-buffer))
-  ;; #### Implement kill-source-files-after-sending here.
-  (when patcher-pre-commit-window-config
-    (set-window-configuration patcher-pre-commit-window-config)))
-
-(defun patcher-install-send-hooks ()
-  ;; Install before- and after-send hooks into the MUA.
-  (cond ((eq major-mode 'mail-mode)
-	 (add-local-hook 'mail-send-hook 'patcher-before-send)
-	 (push '(patcher-after-send) mail-send-actions))
-	((eq major-mode 'message-mode)
-	 (add-local-hook 'message-send-hook 'patcher-before-send)
-	 ;; `message-exit-actions' is probably more appropriate than
-	 ;; `message-send-actions' to perform the cleanup.
-	 (push '(patcher-after-send) message-exit-actions))
-	(t
-	 (patcher-warning "\
-Major mode: %s.
-This mailing method is not fully supported by Patcher.
-This is not critical though: Patcher won't be able to perform checks or
-cleanups during mail sending.
-
-Please report to ."
-			  major-mode))))
-
-
-;; Patcher FakeMail mode ====================================================
-
-(defun patcher-fakemail-send ()
-  "Pretend to send a fake Patcher mail.
-Only perform the usual cleanup after real Patcher mails are sent."
-  (interactive)
-  (patcher-before-send)
-  (patcher-after-send)
-  (kill-buffer (current-buffer)))
-
-(defvar patcher-fakemail-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map [(control c) (control c)] 'patcher-fakemail-send)
-    map))
-
-(defun patcher-fakemail-mode ()
-  "Sets up Patcher-FakeMail major mode.
-Used for editing a fake Patcher mail.
-
-\\{patcher-fakemail-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'patcher-fakemail)
-  (setq mode-name "Patcher-FakeMail")
-  (use-local-map patcher-fakemail-mode-map)
-  (run-hooks 'patcher-logmsg-mode-hook))
-
-
-;; Interface to the different mailing methods ================================
-
-(patcher-globally-declare-fboundp
- '(gnus-alive-p gnus gnus-other-frame gnus-post-news
-		message-mail message-goto-body))
-
-(defmacro patcher-with-mail-parameters (project &rest body)
-  ;; Wrap BODY in a let construct possibly defining user-full-name and
-  ;; user-mail-address by Patcher options.
-  ;; Return the value of BODY execution.
-  ;; #### NOTE: why is it called like this ? Because I'm sure one day or
-  ;; #### another, some sucker will ask for more parameters, like the mail
-  ;; #### signature for instance ;-)
-  `(let ((user-full-name (or (patcher-project-option ,project :user-name)
-			     user-full-name))
-	 (user-mail-address (or (patcher-project-option ,project :user-mail)
-				user-mail-address)))
-    ,@body))
-(put 'patcher-with-mail-parameters 'lisp-indent-function 1)
-
-
-(defun patcher-mail-compose-mail (project subject)
-  "Prepare a patch-related mail with the `compose-mail' function.
-
-This function uses the `:to-address' project option to determine the email
-address for sending the message.  Otherwise, the address is prompted for.
-
-See also the `mail-user-agent' variable."
-
-  (patcher-with-mail-parameters project
-    (compose-mail (or (patcher-project-option project :to-address)
-		      (read-string "To address: "))
-		  subject))
-  (patcher-install-send-hooks))
-
-
-(defun patcher-mail-sendmail (project subject)
-  "Prepare a patch-related mail with the `mail' function.
-This method requires the `sendmail' library.
-
-This function uses the `:to-address' project option to determine the email
-address for sending the message.  Otherwise, the address is prompted for."
-  (require 'sendmail)
-  (patcher-with-mail-parameters project
-    (mail nil (or (patcher-project-option project :to-address)
-		  (read-string "To address: "))
-	  subject))
-  (add-local-hook 'mail-send-hook 'patcher-before-send)
-  (push '(patcher-after-send) mail-send-actions))
-
-(defun patcher-mail-message (project subject)
-  "Prepare a patch-related mail with the `message-mail' function.
-This method requires the `message' library.
-
-This function uses the `:to-address' project option to determine the email
-address for sending the message.  Otherwise, the address is prompted for."
-  (require 'message)
-  (patcher-with-mail-parameters project
-    (message-mail (or (patcher-project-option project :to-address)
-		      (read-string "To address: "))
-		  subject))
-  (add-local-hook 'message-send-hook 'patcher-before-send)
-  ;; `message-exit-actions' is probably more appropriate than
-  ;; `message-send-actions' to perform the cleanup.
-  (push '(patcher-after-send) message-exit-actions))
-
-
-(defcustom patcher-mail-run-gnus 'prompt
-  "*Whether Patcher should run Gnus.
-
-The 'gnus mailing method of Patcher needs a running Gnus session.
-If Gnus is not running at the time it is needed, Patcher can start
-it (or not) depending on this variable:
-- if nil, Patcher will abort execution,
-- it 'prompt (the default), Patcher will ask you what to do,
-- if t Patcher will unconditionally start Gnus.
-
-See also the function `patcher-mail-gnus'."
-  :group 'patcher-mail
-  :type '(radio (const :tag "never" nil)
-		(const :tag "ask user" prompt)
-		(const :tag "as needed" t)))
-
-(defcustom patcher-mail-run-gnus-other-frame t
-  "*Whether Patcher should start Gnus in a new frame.
-
-This is used in case Patcher has to start Gnus by itself \(see the
-variable `patcher-mail-run-gnus').  Possible values are:
-- nil:     start Gnus in the current frame,
-- t:       start Gnus in a new frame,
-- 'follow: start Gnus in a new frame, and also use this frame to prepare
-           the new Patcher message."
-  :group 'patcher-mail
-  :type '(radio (const :tag "Use current frame" nil)
-		(const :tag "Create new frame" t)
-		(const :tag "Create new frame, and use it for patcher" follow)
-		))
-
-(defun patcher-mail-run-gnus ()
-  ;; Start a gnus session.
-  (require 'gnus)
-  (save-excursion
-    (cond ((eq patcher-mail-run-gnus-other-frame t)
-	   (save-selected-frame (gnus-other-frame)))
-	  ((eq patcher-mail-run-gnus-other-frame 'follow)
-	   (gnus-other-frame))
-	  ((not patcher-mail-run-gnus-other-frame)
-	   (gnus))
-	  (t
-	   (patcher-error "\
-Invalid value for `patcher-mail-run-gnus-other-frame': "
-			  patcher-mail-run-gnus-other-frame)))
-    ))
-
-(defun patcher-mail-gnus (project subject)
-  "Prepare a patch-related mail with the `gnus-post-news' function.
-Don't worry, this function can also send mails ;-).  This method
-requires that you have Gnus *running* in your XEmacs session \(see
-the variable `patcher-mail-run-gnus').
-
-This function uses the `:gnus-group' project option to determine the Gnus
-group to use \(as if you had typed `C-u a' on that group in the Group
-buffer).  Otherwise, the group is prompted for."
-  (require 'gnus-util)
-  (unless (gnus-alive-p)
-    (cond ((not patcher-mail-run-gnus)
-	   (patcher-error
-	    "The 'gnus mailing method requires a running Gnus session"))
-	  ((eq patcher-mail-run-gnus t)
-	   (patcher-mail-run-gnus))
-	  ((eq patcher-mail-run-gnus 'prompt)
-	   (if (y-or-n-p "Gnus is not currently running.  Start it ? ")
-	       (patcher-mail-run-gnus)
-	     (patcher-error
-	      "The 'gnus mailing method requires a running Gnus session")))
-	  (t
-	   (patcher-error "Invalid value for `patcher-mail-run-gnus': "
-			  patcher-mail-run-gnus))
-	  ))
-  ;; This binding is necessary to let message-mode hooks perform correctly.
-  (let ((gnus-newsgroup-name (or (patcher-project-option project :gnus-group)
-				 (read-string "Gnus group name: "))))
-    (patcher-with-mail-parameters project
-      (gnus-post-news 'post gnus-newsgroup-name)))
-  (when (patcher-goto-subject)
-    (insert subject))
-  (message-goto-body)
-  (add-local-hook 'message-send-hook 'patcher-before-send)
-  ;; `message-exit-actions' is probably more appropriate than
-  ;; `message-send-actions' to perform the cleanup.
-  (push '(patcher-after-send) message-exit-actions))
-
-(defun patcher-mail-fake (project subject)
-  "Prepare a patch-related fake mail.
-Use this function if you want to do all that Patcher can do, apart from
-sending a real mail.  This function generates a fake mail buffer which acts
-as a standard Patcher mail buffer, apart from the fact that when you type
-\\\\[patcher-fakemail-send] in it, it doesn't
-really send a mail, but just clean things up."
-  (let ((buffer (generate-new-buffer "*Patcher Fake Mail*")))
-    (switch-to-buffer buffer)
-    ;; #### NOTE: Patcher asks for a subject even with the fakemail method,
-    ;; #### which is arguable.  However, even with a fake mail, one could
-    ;; #### require log message initialization from a fake subject.  We could
-    ;; #### do something more clever here.
-    (insert "Subject: " subject "\n")
-    (patcher-fakemail-mode)
-    ))
-
-(defun patcher-mail-setup (project files)
-  ;; Setup patcher-minor-mode and initialize Patcher local variables in mails
-  ;; (both generated or adapted).
-  (push (cons (buffer-name) (current-buffer)) patcher-instances)
-  (patcher-minor-mode t)
-  (setq patcher-project project)
-  (let ((command-directory
-	 (patcher-project-option patcher-project :command-directory)))
-    (when files (setq files (split-string files)))
-    (if command-directory
-	(let ((project-directory (patcher-project-directory project)))
-	  (setq command-directory
-		(expand-file-name command-directory project-directory))
-	  (cd command-directory)
-	  (setq patcher-sources
-		(if (not files)
-		    (list (patcher-file-relative-name
-			   project-directory command-directory 'raw))
-		  (mapcar
-		   (lambda (file)
-		     (patcher-file-relative-name
-		      (expand-file-name file project-directory)
-		      command-directory 'raw))
-		   files)))
-	  )
-      ;; else: (null command-directory)
-      (cd (patcher-project-directory project))
-      (setq patcher-sources files)
-      ))
-  (setq patcher-diff-command (patcher-project-option project :diff-command)))
-
-
-;; Mail generation entry points =============================================
-
-(defun patcher-mail-1 (project subject files override)
-  ;; Perform the real job of preparing the mail buffer.
-  (let ((subject-prefix (patcher-project-option project :subject-prefix))
-	extent)
-    ;; Construct the subject, maybe with an extent marking the prefix:
-    (when (> (length subject-prefix) 0)
-      (setq subject-prefix (patcher-substitute-name project subject-prefix))
-      (setq extent (make-extent 0 (length subject-prefix) subject-prefix))
-      (set-extent-properties extent
-	'(duplicable t patcher-subject-prefix t)))
-    (setq subject (concat subject-prefix
-			  (and subject-prefix (> (length subject-prefix) 0)
-			       subject (> (length subject) 0)
-			       " ")
-			  subject))
-    (funcall
-     (intern (concat "patcher-mail-"
-		     (symbol-name
-		      (patcher-project-option project :mail-method))))
-     project subject))
-  (patcher-mail-setup project files)
-  (let ((mail-prologue (patcher-project-option project :mail-prologue)))
-    (when (> (length mail-prologue) 0)
-      (insert "\n" mail-prologue)))
-  (save-excursion
-    (insert "\n\n")
-    (when (patcher-project-option project :change-logs-updating)
-      (let ((appearance
-	     (patcher-project-option project :change-logs-appearance)))
-	(when (and appearance (not (eq appearance 'patch)))
-	  (setq patcher-change-logs-marker (point-marker))
-	  (insert "\n"))))
-    (setq patcher-diff-marker (point-marker))
-    (patcher-generate-diff override)))
-
-
-;;;###autoload
-(defun patcher-mail-subproject (project subject files &optional arg)
-  "Prepare a mail about a patch to apply on part of a project.
-PROJECT is the name of the project (see the variables `patcher-projects'
-and `patcher-subprojects').
-SUBJECT is the subject of the mail.
-FILES is a string listing one or more files, possibly with wild cards --
-  essentially, part of a command line to be interpolated into the `diff'
-  and maybe the `commit' commands issued by Patcher.
-
-When called interactively, use a prefix (ARG) to override the value of
-the diff command to use for this project.
-
-This function is intended for one-time only subprojects.  Alternately, you
-can define subprojects in the variable `patcher-subprojects' and continue
-using `patcher-mail'.  If you call this function on a predefined subproject,
-you will have the opportunity to modify the predefined list of files or
-directories the subproject is composed of.
-
-When you use this command instead of `patcher-mail', any commits issued
-from the mail buffer (using \\\\[patcher-commit-change]) will automatically include
-the associated ChangeLogs, as well as the file(s) specified as part of
-this command.
-
-Please note that you can have multiple occurrences of a Patcher mail at
-the same time, but not more than one at a time on the same project unless
-you use `patcher-mail-subproject' and the sections of the project don't
-overlap."
-  (interactive
-   (let* ((prj (assoc (completing-read "Project: " (append patcher-subprojects
-							   patcher-projects)
-				       nil t nil 'patcher-projects-history)
-		      (append patcher-subprojects patcher-projects)))
-	  (sbj (read-string
-		"Subject: "
-		(let ((s (patcher-project-option prj :subject)))
-		  (when (> (length s) 0)
-		    (patcher-substitute-name prj s)))
-		patcher-subjects-history))
-	  (dir (patcher-project-directory prj))
-	  (fls (let ((default-directory (file-name-as-directory dir)))
-		 (or (let ((f (patcher-project-option prj :files)))
-		       (and f (read-shell-command "Files: " (concat f " ")
-						  nil f)))
-		     (let* ((default-file (and (buffer-file-name)
-					       (patcher-file-relative-name
-						(buffer-file-name)
-						dir 'raw)))
-			    (default-file
-			      ;; If the file is not actually underneath the
-			      ;; project, then don't suggest it as a
-			      ;; possibility.
-			      (and default-file
-				   (if (string-match "^\\.\\.$\\|^\\.\\.[/\\]"
-						     default-file)
-				       nil default-file))))
-		       (read-shell-command
-			"Files: "
-			default-file nil default-file))))))
-     (list prj sbj fls current-prefix-arg)))
-  (patcher-mail-1 project subject files (and (interactive-p) arg)))
-
-;;;###autoload
-(defun patcher-mail (project subject &optional arg)
-  "Prepare a mail about a patch to apply on a project.
-PROJECT is the name of the project (see the variables `patcher-projects'
-and `patcher-subprojects').
-SUBJECT is the subject of the mail.
-
-When called interactively, use a prefix (ARG) to override the value of
-the diff command to use for this project.  Note that this is *not* the way
-to restrict the diff to certain files.  If you want to work on a subset of
-the project (e.g. some files, subdirectories etc), you have two
-alternatives:
-
-- for temporary subprojects, you can use the function
-  `patcher-mail-subproject', which lets you specify the list of modified
-  files / directories.
-- otherwise, you can also define the subprojects in the variable
-  `patcher-subprojects' and continue using this function.
-
-Please note that you can have multiple occurrences of a Patcher mail at
-the same time, but not more than one at a time on the same project unless
-you use `patcher-mail-subproject' and the sections of the project don't
-overlap."
-  (interactive
-   (let* ((prj (assoc (completing-read "Project: " (append patcher-subprojects
-							   patcher-projects)
-				       nil t nil 'patcher-projects-history)
-		      (append patcher-subprojects patcher-projects)))
-	  (sbj (read-string
-		"Subject: "
-		(let ((s (patcher-project-option prj :subject)))
-		  (when (> (length s) 0)
-		    (patcher-substitute-name prj s)))
-		patcher-subjects-history)))
-     (list prj sbj current-prefix-arg)))
-  (patcher-mail-1 project subject (patcher-project-option project :files)
-		  (and (interactive-p) arg))
-  )
-
-
-;; Mail adaptation entry points =============================================
-
-;; #### NOTE: the prefix argument usage in patcher-mail[-subproject]
-;; #### to override the diff command is broken by design (it comes from an
-;; #### early version of Patcher): why the diff command and not any other
-;; #### option ? I'm not going to propagate this misconception here, so the
-;; #### adaptation functions don't have a prefix argument at all.
-
-(defun patcher-mail-adapt-1 (project files)
-  ;; Like `patcher-mail-1', but for already existing mails.
-  (let ((subject-prefix (patcher-project-option project :subject-prefix))
-	extent)
-    ;; Construct the subject, maybe with an extent marking the prefix:
-    (when (> (length subject-prefix) 0)
-      (setq subject-prefix (patcher-substitute-name project subject-prefix))
-      (setq extent (make-extent 0 (length subject-prefix) subject-prefix))
-      (set-extent-properties extent '(duplicable t patcher-subject-prefix t))
-      (when (patcher-goto-subject)
-	(insert subject-prefix " "))))
-  (patcher-install-send-hooks)
-  (patcher-mail-setup project files)
-  ;; #### FIXME: currently, I have simply discarded the mail-prologue
-  ;; #### insertion for adapted mails. This is because mail adaptation is
-  ;; #### mostly for replies in which you probably don't want the standard
-  ;; #### prologue. However, this could be turned into a standard option.
-  ;;  (let ((mail-prologue (patcher-project-option project :mail-prologue)))
-  ;;    (when (> (length mail-prologue) 0)
-  ;;      (insert "\n" mail-prologue)))
-  (patcher-goto-signature)
-  (when (patcher-project-option project :change-logs-updating)
-    (let ((appearance
-	   (patcher-project-option project :change-logs-appearance)))
-      (when (and appearance (not (eq appearance 'patch)))
-	(setq patcher-change-logs-marker (point-marker))
-	(insert "\n"))))
-  (setq patcher-diff-marker (point-marker))
-  (patcher-generate-diff))
-
-;;;###autoload
-(defun patcher-mail-adapt (project)
-  "Same as `patcher-mail', but for already started mails.
-This function is mostly designed to adapt replies or followups probably
-started with your usual MUA to Patcher.
-
-Note two differences with `patcher-mail' however:
-1. there is no SUBJECT argument to this function,
-2. no prefix argument is available to override the diff command."
-  (interactive
-   (list (assoc (completing-read "Project: " (append patcher-subprojects
-						     patcher-projects)
-				 nil t nil 'patcher-projects-history)
-		(append patcher-subprojects patcher-projects))))
-  (patcher-mail-adapt-1 project (patcher-project-option project :files)))
-
-;;;###autoload
-(defun patcher-mail-adapt-subproject (project files)
-  "Same as `patcher-mail-subproject', but for already started mails.
-This function is mostly designed to adapt replies or followups probably
-started with your usual MUA to Patcher.
-
-Note two differences with `patcher-mail-subproject' however:
-1. there is no SUBJECT argument to this function,
-2. no prefix argument is available to override the diff command."
-  (interactive
-   (let* ((prj (assoc (completing-read "Project: " (append patcher-subprojects
-							   patcher-projects)
-				       nil t nil 'patcher-projects-history)
-		      (append patcher-subprojects patcher-projects)))
-	  (dir (patcher-project-directory prj))
-	  (fls (let ((default-directory (file-name-as-directory dir)))
-		 (or (let ((f (patcher-project-option prj :files)))
-		       (and f (read-shell-command "Files: " (concat f " ")
-						  nil f)))
-		     (let* ((default-file (and (buffer-file-name)
-					       (patcher-file-relative-name
-						(buffer-file-name)
-						dir 'raw)))
-			    (default-file
-			      ;; If the file is not actually underneath the
-			      ;; project, then don't suggest it as a
-			      ;; possibility.
-			      (and default-file
-				   (if (string-match "^\\.\\.$\\|^\\.\\.[/\\]"
-						     default-file)
-				       nil default-file))))
-		       (read-shell-command
-			"Files: "
-			default-file nil default-file))))))
-     (list prj fls)))
-  (patcher-mail-adapt-1 project files))
-
-
-;; Patcher Gnus Summary minor mode ==========================================
-
-(patcher-globally-declare-fboundp
- '(gnus-summary-followup gnus-summary-followup-with-original
-   gnus-summary-reply gnus-summary-reply-with-original))
-
-(defun patcher-gnus-summary-followup (&optional arg)
-  "Prepare a Patcher followup from the Gnus Summary buffer.
-With a prefix argument, behave like `patcher-mail-subproject' instead of
-`patcher-mail'."
-  (interactive "P")
-  (gnus-summary-followup nil)
-  (call-interactively
-   (if arg
-       'patcher-mail-adapt-subproject
-     'patcher-mail-adapt)))
-
-(defun patcher-gnus-summary-followup-with-original (&optional arg)
-  "Prepare a Patcher followup from the Gnus Summary buffer.
-The original message is yanked.
-With a prefix argument, behave like `patcher-mail-subproject' instead of
-`patcher-mail'."
-  (interactive "P")
-  (gnus-summary-followup-with-original nil)
-  (call-interactively
-   (if arg
-       'patcher-mail-adapt-subproject
-     'patcher-mail-adapt)))
-
-(defun patcher-gnus-summary-reply (&optional arg)
-  "Prepare a Patcher reply from the Gnus Summary buffer.
-With a prefix argument, behave like `patcher-mail-subproject' instead of
-`patcher-mail'."
-  (interactive "P")
-  ;; #### NOTE: it is strange that this function's first argument is not
-  ;; #### mandatory, as in the 3 other ones.
-  (gnus-summary-reply)
-  (call-interactively
-   (if arg
-       'patcher-mail-adapt-subproject
-     'patcher-mail-adapt)))
-
-(defun patcher-gnus-summary-reply-with-original (&optional arg)
-  "Prepare a Patcher reply from the Gnus Summary buffer.
-The original message is yanked.
-With a prefix argument, behave like `patcher-mail-subproject' instead of
-`patcher-mail'."
-  (interactive "P")
-  (gnus-summary-reply-with-original nil)
-  (call-interactively
-   (if arg
-       'patcher-mail-adapt-subproject
-     'patcher-mail-adapt)))
-
-(defcustom patcher-gnus-summary-minor-mode-string " Patch"
-  "*Patcher Gnus Summary minor mode modeline string."
-  :group 'patcher
-  :type 'string)
-
-(defcustom patcher-gnus-summary-minor-mode-hook nil
-  "*Hooks to run after setting up Patcher Gnus Summary minor mode."
-  :group 'patcher
-  :type 'hook)
-
-(defvar patcher-gnus-summary-minor-mode-map
-  (let ((map (make-sparse-keymap 'patcher-minor-mode-map)))
-    (define-key map [(control c) (control p) f]
-      'patcher-gnus-summary-followup)
-    (define-key map [(control c) (control p) F]
-      'patcher-gnus-summary-followup-with-original)
-    (define-key map [(control c) (control p) r]
-      'patcher-gnus-summary-reply)
-    (define-key map [(control c) (control p) R]
-      'patcher-gnus-summary-reply-with-original)
-    map)
-  ;; Patcher Gnus Summary minor mode keymap.
-  )
-
-(make-variable-buffer-local
- (defvar patcher-gnus-summary-minor-mode nil))
-
-(defun patcher-gnus-summary-minor-mode (arg)
-  "Toggles Patcher Gnus Summary minor mode.
-Used for Patcher messages composed as Gnus replies and followups.
-You're not supposed to use this, unless you know what you're doing.
-
-\\{patcher-gnus-summary-minor-mode-map}"
-  (interactive "*P")
-  (setq patcher-gnus-summary-minor-mode
-	(if (null arg) (not patcher-gnus-summary-minor-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (run-hooks 'patcher-gnus-summary-minor-mode-hook))
-
-(add-minor-mode
- 'patcher-gnus-summary-minor-mode
- patcher-gnus-summary-minor-mode-string
- patcher-gnus-summary-minor-mode-map)
-
-
-;; Patcher Gnus Article minor mode ==========================================
-
-(defcustom patcher-gnus-article-minor-mode-string " Patch"
-  "*Patcher Gnus Article minor mode modeline string."
-  :group 'patcher
-  :type 'string)
-
-(defcustom patcher-gnus-article-minor-mode-hook nil
-  "*Hooks to run after setting up Patcher Gnus Article minor mode."
-  :group 'patcher
-  :type 'hook)
-
-(defvar patcher-gnus-article-minor-mode-map
-  (let ((map (make-sparse-keymap 'patcher-minor-mode-map)))
-    (define-key map [(control c) (control p) f]
-      'patcher-gnus-summary-followup)
-    (define-key map [(control c) (control p) F]
-      'patcher-gnus-summary-followup-with-original)
-    (define-key map [(control c) (control p) r]
-      'patcher-gnus-summary-reply)
-    (define-key map [(control c) (control p) R]
-      'patcher-gnus-summary-reply-with-original)
-    map)
-  ;; Patcher Gnus Article minor mode keymap.
-  )
-
-(make-variable-buffer-local
- (defvar patcher-gnus-article-minor-mode nil))
-
-(defun patcher-gnus-article-minor-mode (arg)
-  "Toggles Patcher Gnus Article minor mode.
-Used for Patcher messages composed as Gnus replies and followups.
-You're not supposed to use this, unless you know what you're doing.
-
-\\{patcher-gnus-article-minor-mode-map}"
-  (interactive "*P")
-  (setq patcher-gnus-article-minor-mode
-	(if (null arg) (not patcher-gnus-article-minor-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (run-hooks 'patcher-gnus-article-minor-mode-hook))
-
-(add-minor-mode
- 'patcher-gnus-article-minor-mode
- patcher-gnus-article-minor-mode-string
- patcher-gnus-article-minor-mode-map)
-
-
-;; ==========================================================================
-;; Routines to plug Patcher into external libraries
-;; ==========================================================================
-
-(patcher-globally-declare-boundp
- '(gnus-summary-mode-hook gnus-article-mode-hook))
-
-;;;###autoload
-(defun patcher-insinuate-gnus ()
-  "This function plugs Patcher into Gnus.
-It should be called from your gnusrc file."
-  (add-hook 'gnus-summary-mode-hook
-	    '(lambda () (patcher-gnus-summary-minor-mode 1)))
-  (add-hook 'gnus-article-mode-hook
-	    '(lambda () (patcher-gnus-article-minor-mode 1))))
-
-
-(provide 'patcher)
-
-;;; patcher.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/pretty-print.el b/xemacs-packages/lisp/xemacs-devel/pretty-print.el
deleted file mode 100644
index c26034c2..00000000
--- a/xemacs-packages/lisp/xemacs-devel/pretty-print.el
+++ /dev/null
@@ -1,577 +0,0 @@
-;;; pretty-print.el --- Emacs Lisp pretty printer and macro expander
-
-;; Copyright (C) 1992,1993 Guido Bosch 
-
-;; Author: Guido Bosch
-;; Maintainer: None
-;; Keywords: lisp, internal
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with:  Not in FSF.
-
-;;; Commentary:
-
-;; Please send bugs and comments to the author.
-;;
-;; 
-;; This program is still under development.  Neither the author nor
-;; CRIN-INRIA accepts responsibility to anyone for the consequences of
-;; using it or for whether it serves any particular purpose or works
-;; at all.
-;; 
-;; The package has been developed under Lucid Emacs 19, but also runs
-;; on Emacs 18, if it is compiled with the version 19 byte compiler
-;; (function `compiled-function-p' lacking).
-;;
-
-;; Installation and Usage
-;; ----------------------
-;;
-;; This package provides an Emacs Lisp sexpression pretty printer and
-;; macroexpander.  To install it, put the following line in your .emacs,
-;; default.el or site-init.el/site-run.el (for Lucid Emacs): 
-;; (require 'pp)
-;; 
-;; The package can also be made autoloadable, with the following entry 
-;; points: 
-;; (autoload 'pp-function "pp" nil t)
-;; (autoload 'pp-variable "pp" nil t)
-;; (autoload 'pp-plist     "pp" nil t)
-;; (autoload 'macroexpand-sexp "pp" nil t)
-;; (autoload 'macroexpand-all-sexp "pp" nil t)
-;; (autoload 'prettyexpand-sexp "pp" nil t)
-;; (autoload 'prettyexpand-all-sexp "pp" nil t)
-;;
-;;(define-key emacs-lisp-mode-map '(control meta m) 'macroexpand-sexp)
-;;(define-key emacs-lisp-mode-map '(control meta M) 'macroexpand-all-sexp)
-;;(define-key emacs-lisp-mode-map '(control symbol m) 'prettyexpand-sexp)
-;;(define-key emacs-lisp-mode-map '(control symbol M) 'prettyexpand-all-sexp)
-;;
-;;(define-key lisp-interaction-mode-map '(control meta m) 'macroexpand-sexp)
-;;(define-key lisp-interaction-mode-map '(control meta M) 'macroexpand-all-sexp)
-;;(define-key lisp-interaction-mode-map '(control symbol m) 'prettyexpand-sexp)
-;;(define-key lisp-interaction-mode-map '(control symbol M) 'prettyexpand-all-sexp)
-;;
-
-;; Pretty printing of the different cells of a symbol is done with the
-;; commands:
-;;
-;; 		M-x pp-function
-;; 		M-x pp-variable
-;;		M-x pp-plist
-;;
-;; They print a symbol's function definition, variable value and
-;; property list, respectively.  These commands pop up a separate
-;; window in which the pretty printed lisp object is displayed.
-;; Completion for function and variable symbols is provided. If a
-;; function is byte compiled, `pp-function' proposes to call the Emacs
-;; Lisp disassembler (this feature only works for Emacs 19, as it
-;; needs the `compiled-function-p' predicate).
-;;
-;; To use the macro expander, put the cursor at the beginning of the
-;; form to be expanded, then type
-;;
-;; 	        C-M-m 		(macroexpand-sexp)
-;; or		C-M-Sh-M  	(macroexpand-all-sexp)
-;; 
-;; Both commands will pop up a temporary window containing the
-;; macroexpanded code. The only difference is that the second command
-;; expands recursively all containing macro calls, while the first one
-;; does it only for the uppermost sexpression.  
-;; 	With a prefix argument, the macro expansion isn't displayed in a
-;; separate buffer but replaces the original code in the current
-;; buffer. Be aware: Comments will be lost.
-;; 	You can get back the original sexpression using the `undo'
-;; 	command on `C-x u'.
-;;
-;; There is also a prettyfied version of the macroexpander:
-;;
-;;		C-Sym-m		(prettyexpand-sexp)
-;; or		C-Sym-M		(prettyexpand-all-sexp)
-;; 
-;; The only difference with the corresponding macroexpand commands is 
-;; that calls to macros specified in the variable
-;; `pp-shadow-expansion-list' are not expanded, in order to make the
-;; code look nicer. This is only useful for Lucid Emacs or code that
-;; uses Dave Gillespies cl package, as it inhibits expansion of the
-;; following macros: block, eval-when, defun*, defmacro*, function*,
-;; setf.
-
-; Change History
-; 
-; $Log: pretty-print.el,v $
-; Revision 1.3  2000/10/06 09:35:05  youngs
-; Martin's Monster Mega typo patch
-;
-; Revision 1.2  1998/02/10 16:23:33  steveb
-; pretty-print fixes
-;
-; Revision 1.4  1993/03/25  14:09:52  bosch
-; Commands `prettyexpand-sexp' and `prettyexpand-all-sexp' and
-; corresponding key bindings added.  Commands pp-{function, variable}
-; rewritten. `pp-plist' added. Function `pp-internal-loop' (for Dave
-; Gillespies CL loop macro) added.
-;
-; Revision 1.3  1993/03/03  12:24:13  bosch
-; Macroexpander rewritten. Function `pp-macroexpand-all' added (snarfed
-; from Dave Gillespies cl-extra.el). Pretty printing for top level
-; defining forms added (`pp-internal-def'). Key bindings for
-; `emacs-lisp-mode-map' and `lisp-interaction-mode-map' added.  Built-in
-; variable `print-gensym' set for printinng uninterned symbols. Started
-; adding support for cl-dg (defun*, defmacro*, ...).  Minor bug fixes.
-;
-; Revision 1.2  1993/02/25  17:35:02  bosch
-; Comments about Emacs 18 compatibility added.
-;
-; Revision 1.1  1993/02/25  16:55:01  bosch
-; Initial revision
-;
-;
-;;; Code:
-
-;; TO DO LIST
-;; ----------
-;; Provide full Emacs 18 compatibility.
-
-;; Popper support
-(defvar pp-buffer-name "*Pretty Print*")
-(defvar pp-macroexpand-buffer-name "*Macro Expansion*")
-(if (featurep 'popper)
-    (or (eq popper-pop-buffers 't)
-	(setq popper-pop-buffers 
-	      (cons pp-buffer-name 
-		    (cons pp-macroexpand-buffer-name 
-			  popper-pop-buffers)))))
-
-;; User level functions
-;;;###autoload
-(defun pp-function (symbol)
-  "Pretty print the function definition of SYMBOL in a separate buffer"
-  (interactive 
-   (list (pp-read-symbol 'fboundp "Pretty print function definition of: ")))
-  (if (compiled-function-p (symbol-function symbol))
-      (if (y-or-n-p 
-	   (format "Function %s is byte compiled. Disassemble? " symbol))
-	  (disassemble (symbol-function symbol))
-	(pp-symbol-cell symbol 'symbol-function))
-    (pp-symbol-cell symbol 'symbol-function)))
-
-;;;###autoload
-(defun pp-variable (symbol)
-  "Pretty print the variable value of SYMBOL in a separate buffer"
-  (interactive
-   (list (pp-read-symbol 'boundp "Pretty print variable value of: ")))
-  (pp-symbol-cell symbol 'symbol-value))
-
-;;;###autoload
-(defun pp-plist (symbol)
-  "Pretty print the property list of SYMBOL in a separate buffer"
-  (interactive
-   (list (pp-read-symbol 'symbol-plist "Pretty print property list of: ")))
-  (pp-symbol-cell symbol 'symbol-plist))
-
-(defun pp-read-symbol (predicate prompt)
-  "Read a symbol for which  PREDICATE is true, promptiong with PROMPT."
-  (let (symbol)
-    (while (or (not symbol) (not (funcall predicate symbol)))
-      (setq symbol 
-	    (intern-soft 
-	     (completing-read
-	      prompt
-	      obarray
-	      predicate
-	      t
-	      (and symbol (symbol-name symbol))))))
-    symbol))
-
-(defun pp-symbol-cell (symbol accessor)  
-  "Pretty print the contents of the cell of SYMBOL that can be reached
-with the function ACCESSOR."
-  (with-output-to-temp-buffer pp-buffer-name
-    (set-buffer pp-buffer-name)
-    (emacs-lisp-mode)
-    (erase-buffer)
-    (pp-internal 
-     (funcall accessor symbol) 
-     (format "%s's %s is:\n" symbol accessor))
-    (terpri)))
-
-
-  
-;; Macro expansion (user level)
-
-;;;###autoload
-(defun macroexpand-sexp (&optional replace)
-  "Macro expand the sexpression following point. Pretty print expansion in a
-temporary buffer. With prefix argument, replace the original
-sexpression by its expansion in the current buffer."
-  (interactive "P")
-  (pp-macroexpand-internal 'macroexpand replace t))
-
-;;;###autoload
-(defun macroexpand-all-sexp (&optional replace)
-  "Macro expand recursively the sexpression following point. Pretty print
-expansion in a temporary buffer. With prefix argument, replace the
-original sexpression by its expansion in the current buffer."
-  (interactive "P")
-  (pp-macroexpand-internal 'pp-macroexpand-all replace t))
-
-;;;###autoload
-(defun prettyexpand-sexp (&optional replace)
-  "Macro expand the sexpression following point. Pretty print expansion
-in a temporary buffer. With prefix argument, replace the original
-sexpression by its expansion in the current buffer.  
-	However, calls to macros specified in the variable
-`pp-shadow-expansion-list' are not expanded, in order to make the code
-look nicer."
-
-  (interactive "P")
-  (pp-macroexpand-internal 'macroexpand replace))
-
-;;;###autoload
-(defun prettyexpand-all-sexp (&optional replace)
-  "Macro expand recursively the sexpression following point. Pretty print
-expansion in a temporary buffer. With prefix argument, replace the
-original sexpression by its expansion in the current buffer.
-	However, calls to macros specified in the variable
-`pp-shadow-expansion-list' are not expanded, in order to make the code
-look nicer."
-  (interactive "P")
-  (pp-macroexpand-internal 'pp-macroexpand-all replace))
-
-;; XEmacs: don't do this at load time.
-;;(define-key emacs-lisp-mode-map '(control meta m) 'macroexpand-sexp)
-;;(define-key emacs-lisp-mode-map '(control meta M) 'macroexpand-all-sexp)
-;;(define-key emacs-lisp-mode-map '(control symbol m) 'prettyexpand-sexp)
-;;(define-key emacs-lisp-mode-map '(control symbol M) 'prettyexpand-all-sexp)
-
-;;(define-key lisp-interaction-mode-map '(control meta m) 'macroexpand-sexp)
-;;(define-key lisp-interaction-mode-map '(control meta M) 'macroexpand-all-sexp)
-;;(define-key lisp-interaction-mode-map '(control symbol m) 'prettyexpand-sexp)
-;;(define-key lisp-interaction-mode-map '(control symbol M) 'prettyexpand-all-sexp)
-
-
-;; Macro expansion (internals)
-
-(defvar pp-shadow-expansion-list
-  (mapcar 'list '(block eval-when defun* defmacro* function* setf))
-  "The value of this variable is given as the optional environment
-argument of the macroexpand functions. Forms specified in this list are
-not expanded.")
-
-(defun pp-macroexpand-internal 
-  (macroexpand-function replace &optional dont-shadow)
-  "Macro expand the sexp that starts at point, using
-MACROEXPAND-FUNCTION.  If REPLACE is non-nil, replace the original
-text by its expansion, otherwise pretty print the expansion in a
-temporary buffer. With optional argument DONT-SHADOW non-nil, do not
-use the `pp-shadow-expansion-list' to inhibit expansion of some
-forms."
-
-  (interactive)
-  (let ((expansion
-	 (funcall 
-	  macroexpand-function
-	  (let ((stab (syntax-table)))
-	    (unwind-protect
-		(save-excursion
-		  (set-syntax-table emacs-lisp-mode-syntax-table)
-		  ;; (forward-sexp 1)
-		  (read (current-buffer)))
-	      (set-syntax-table stab)))
-	  (if dont-shadow 
-	      nil
-	    pp-shadow-expansion-list))))
-    (save-excursion
-      (if replace 
-	  (let ((start (point))
-		(end (progn (forward-sexp 1) (point))))
-	    (delete-region start end)
-	    (pp-internal expansion))
-	(with-output-to-temp-buffer pp-macroexpand-buffer-name
-	  (set-buffer pp-macroexpand-buffer-name)
-	  (erase-buffer)
-	  (emacs-lisp-mode)
-	  (pp-internal expansion))))))
-
-;; Internal pretty print functions
-
-;;;###autoload
-(defun pp-internal (form &optional title)
-  "Pretty print FORM in in the current buffer.
-Optional string TITLE is inserted before the pretty print."
-  (let (start)
-    (if title (princ title))
-    (setq start (point))
-    ;; print-escape-newlines must be t, otherwise we cannot use
-    ;; (current-column) to detect good line breaks
-    (let ((print-escape-newlines t)
-	  (print-gensym t)
-	  )
-      (prin1 form (current-buffer))
-      (goto-char start)
-      (pp-internal-sexp))))
-
-(defun pp-internal-sexp ()
-  "Pretty print the following sexp. 
-Point must be on or before the first character."
-
-  (skip-chars-forward " \n\t")
-  (let* ((char (following-char))
-	 (ch-class (char-syntax char))
-	 (start (point)))
-
-    (cond
-     ;; open paren
-     ((eq char ?\()
-      (down-list 1)
-      (if (memq  (char-syntax (following-char)) '(?_ ?w))
-	  (let ((symbol (read (current-buffer))))
-	    (cond ((and (symbolp symbol)
-			(fboundp symbol))
-		   (goto-char start)
-		   (pp-internal-function symbol))
-		  ((memq symbol '(lambda macro))
-		   (pp-internal-lambda))
-		  (t
-		   (goto-char start)
-		   (pp-internal-list))))
-	(up-list -1)
-	(pp-internal-list)))
-     
-     ;;symbols & strings
-     ((memq  ch-class '(?_		; symbol
-			?w		; word
-			?\"		; string
-			?\\		; escape
-			?\'		; quote (for uninterned symbols)
-			)) (forward-sexp 1))
-	
-     ;; vector
-     ((eq char ?\[) (pp-internal-list))
-     
-     ;; error otherwise
-     (t (error "pp-internal-sexp: character class not treated yet: `%c'" 
-	       ch-class)))))
-
-(defun pp-internal-function (func)
-  "Pretty print a functuion call.
-Point must be on the open paren. the function symbol may be passed as an 
-optional argument."
-  (let ((start (point))
-	(too-large (>= (save-excursion
-			 (forward-sexp 1)
-			 (current-column))
-		       fill-column))
-	(indent-info (get func lisp-indent-function)))
-    (down-list 1)
-    ;; skip over function name
-    (forward-sexp 1)
-    (cond
-     ((memq func '(let let*)) (pp-internal-let))
-
-     ((eq func 'cond) (pp-internal-cond))
-
-     ((memq func '(if while with-output-to-temp-buffer catch block))
-      (pp-internal-sexp)
-      (pp-internal-body 't))
-
-     ((eq func 'quote) (pp-internal-quote))
-
-     ((memq func '(progn 
-		    prog1 prog2
-		    save-window-excursion 
-		    save-excursion 
-		    save-restriction))
-      (pp-internal-body 't))
-
-     ((memq func '(defun defmacro defsubst defun* defmacro*))
-      (pp-internal-def))
-     
-     ((eq func 'loop) (pp-internal-loop))
-
-     ('t (pp-internal-body too-large)))))
-
-(defun pp-internal-def ()
-  (forward-sexp 1)			; skip name
-  (if (looking-at " nil")		; replace nil by () 
-      (replace-match " ()")
-    (forward-sexp 1))
-  (if (looking-at " \"")
-      ;; comment string. Replace all escaped linefeeds by real ones
-      (let ((limit (save-excursion (forward-sexp 1) (point-marker))))
-	(newline-and-indent)
-	(while (re-search-forward "\\\\n" limit t)
-	  (replace-match "\n" nil nil))
-	(goto-char limit)))
-  (pp-internal-body 't))
-
-(defun pp-internal-list ()
-  "Pretty print a list  or a vector.
-Point must be on the open paren."
-  (let ((too-large (>= (save-excursion
-			(forward-sexp 1)
-			(current-column))
-		      fill-column)))
-    (down-list 1)
-    (pp-internal-sexp)
-    (pp-internal-body too-large)))
-
-(defun pp-internal-body (&optional force-indent)
-  "Prety print a body of sexp. Stop after reaching a `)'.  If argument
-FORCE-INDENT is non-nil, break line after each sexpression of the
-body."
-  (skip-chars-forward " \n\t")
-  (let (ch-class)
-    ;; while not closing paren
-    (while (/= (setq ch-class (char-syntax (following-char))) ?\)) 
-      (if  force-indent (newline-and-indent))
-      (pp-internal-sexp))
-    (up-list 1)))
-
-(defun pp-internal-loop ()
-  "Prety print a loop body. Stop after reaching a `)'. 
-Line breaks are done before the following keywords: "
-  (forward-sexp 1)
-  (skip-chars-forward " \n\t")
-  (let (ch-class)
-    ;; while not closing paren
-    (while (/= (setq ch-class (char-syntax (following-char))) ?\))
-      (if (not (looking-at "for\\|repeat\\|with\\|while\\|until\\|always\\|never\\|thereis\\|collect\\|append\\|nconc\\|sum\\|count\\|maximize\\|minimize\\|if\\|when\\|else\\|unless\\|do\\W\\|initially\\|finally\\|return\\|named"))
-	  (pp-internal-sexp)
-	(newline-and-indent)
-	(forward-sexp 1))
-      (skip-chars-forward " \n\t"))
-    (up-list 1)))
-
-(defun pp-internal-body-list ()
-  (let ((too-large (>= (save-excursion
-			(forward-sexp 1)
-			(current-column))
-		      fill-column))
-	ch-class)
-    (down-list 1)
-    (pp-internal-sexp)
-    (while (/= (setq ch-class (char-syntax (following-char))) ?\)) 
-      (if  too-large (newline-and-indent))
-      (pp-internal-sexp))
-    (up-list 1)))
-    
-(defun pp-internal-lambda ()
-  (forward-sexp 1) ; arguments
-  (pp-internal-body 't))
-
-(defun pp-internal-let ()
-  "Pretty print a let-like  form.
-Cursor is behind function symbol."
-  (down-list 1)
-  (while (not (= (following-char) ?\)))
-    (if (= (following-char) ?\()
-	(pp-internal-body-list)
-      (forward-sexp 1))
-    (if (not (= (following-char) ?\)))
-        (newline-and-indent)))
-  (up-list 1)
-  (pp-internal-body 't))
-
-(defun pp-internal-cond ()
-  "Pretty print a cond-like  form.
-Cursor is behind function symbol."
-  (skip-chars-forward " \n\t")
-  (while (not (= (following-char) ?\)))
-    (pp-internal-body-list)
-    (if (not (= (following-char) ?\)))
-	(newline-and-indent)))
-  (up-list 1))
-
-      
-(defun pp-internal-quote ()
-  "Pretty print a quoted list.
-Cursor is behind the symbol quote."
-  (skip-chars-forward " \n\t")
-  (let ((end (point)))
-    (backward-sexp 1)
-    (delete-region (point) end)
-    (up-list -1)
-    (setq end (point))
-    (forward-sexp 1)
-    (delete-char -1)
-    (goto-char end)
-    (delete-char 1)
-    (insert "'")
-    (if (= (char-syntax (following-char)) ?\()
-	;; don't print it as sexp, because it could be (let ... ) or
-	;; (cond ... ) or whatever. 
-	(pp-internal-list)
-      (pp-internal-sexp))))
-
-
-;; Stolen form Dave Gillespies cl-extra.el
-(defun pp-macroexpand-all (form &optional env)
-  "Expand all macro calls through a Lisp FORM.
-This also does some trivial optimizations to make the form prettier."
-  (setq form (macroexpand form env))
-  (cond 
-   ((not (consp form)) form)
-   ((memq (car form) '(let let*))
-    (if (null (nth 1 form))
-	(pp-macroexpand-all (cons 'progn (cdr (cdr form))) env)
-      (cons (car form) 
-	    (cons (pp-macroexpand-lets (nth 1 form) env)
-		  (pp-macroexpand-body (cdr (cdr form)) env)))))
-   ((eq (car form) 'cond)
-    (cons (car form)
-	  (mapcar (function (lambda (x) (pp-macroexpand-body x env)))
-		  (cdr form))))
-   ((eq (car form) 'condition-case)
-    (cons (car form)
-	  (cons (nth 1 form)
-		(cons (pp-macroexpand-all (nth 2 form) env)
-		      (pp-macroexpand-lets 
-		       (cdr (cdr (cdr form))) env)))))
-   ((memq (car form) '(quote function))
-    (if (eq (car-safe (nth 1 form)) 'lambda)
-	(list (car form) 
-	      (cons 'lambda
-		    (cons (car (cdr (car (cdr form))))
-			  (pp-macroexpand-body 
-			   (cdr (cdr (car (cdr form)))) env))))
-      form))
-   ((memq (car form) '(defun defmacro))
-    (cons (car form)
-	  (cons (nth 1 form)
-		(pp-macroexpand-body (cdr (cdr form)) env))))
-   ((and (eq (car form) 'progn) (not (cdr (cdr form))))
-    (pp-macroexpand-all (nth 1 form) env))
-   (t 
-    (cons (car form) (pp-macroexpand-body (cdr form) env)))))
-
-(defun pp-macroexpand-body (body &optional env)
-  (mapcar (function (lambda (x) (pp-macroexpand-all x env))) body))
-
-(defun pp-macroexpand-lets (list &optional env)
-  (mapcar (function
-	   (lambda (x)
-	     (if (consp x) (cons (car x) (pp-macroexpand-body (cdr x) env))
-	       x))) list))
-
-(run-hooks 'pp-load-hook)
-(provide 'pp)
-
-;;; pretty-print.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/profile.el b/xemacs-packages/lisp/xemacs-devel/profile.el
deleted file mode 100644
index 1b4e29a6..00000000
--- a/xemacs-packages/lisp/xemacs-devel/profile.el
+++ /dev/null
@@ -1,416 +0,0 @@
-;;; profile.el --- basic profiling commands for XEmacs
-
-;; Copyright (C) 1996, 2002, 2003, 2004 Ben Wing.
-;; Copyright (C) 1997 Free Software Foundation.
-
-;; Author: Ben Wing 
-;; Maintainer: XEmacs Development Team
-;; Keywords: internal
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF.
-
-;;; Commentary:
-
-;; In addition to Lisp-based `elp', XEmacs provides a set of
-;; primitives able to profile evaluation of Lisp functions, created by
-;; the illustrious Ben Wing.  The functions in this file can be used
-;; to gain easy access to the internal profiling functions.
-
-;; The profiler works by catching "ticks" (actually SIGPROF signals),
-;; and looking at the current Lisp function, at the time of each tick.
-;; In addition, call counts for each function called are recorded.
-;; `profile-results' pretty-prints this information.
-
-;; Note (ELP users should read this):
-;;
-;; 1) Both function and function + descendants time are reported.
-;; 2) Number of times called is recorded for each function, as well as
-;;    Lisp allocation for the functions and for function + descendants.
-;; 3) The profiling entries include not only functions but also certain
-;;    common internal operations, such as redisplay, garbage collection,
-;;    byte-char conversion, internal-external conversion, etc.  Profiling
-;;    overhead is also recorded.
-;; 4) Each tick is equivalent to 1ms (which can be changed), but this
-;;    is CPU time (user+kernel), not the real time.
-;; 5) Only the actual funcalls are profiled.  If, in the C code, a subr
-;;    Ffoo calls Fbar directly, using Fbar(), only Ffoo will appear in
-;;    the profile.
-;; 6) When profiling complex forms, more meaningful results are achieved
-;;    by byte-compiling, e.g. with `compile-and-profile'.
-;; 7) Results will be skewed if your XEmacs is compiled with error-
-;;    checking.  The best thing is to compile with optimization and without
-;;    error-checking, before profiling.
-;; 8) If you call `profile-key-sequence' and then hit a sequence starting
-;;    with `M-x ...', the profiling will start from when you hit M-x,
-;;    and will include the reading of the rest of the command.
-
-;; There are three levels of functions:
-;;
-;; -- High-level interactive commands for profiling key sequences, commands,
-;;    and expressions (`profile-key-sequence', `profile-command',
-;;    `profile-expression'), or for interactively profiling any sequence of
-;;    commands (`toggle-profiling').
-;;
-;; -- Functions for profiling forms, optionally byte-compiled (`profile',
-;;    `continue-profile', `compile-and-profile',
-;;    `compile-and-continue-profile'), which can be conveniently executed
-;;    from the `Eval:' prompt or *scratch* buffer.  Use the `compile-and-'
-;;    versions with complex forms, for more meaningful results.
-;;
-;; -- The basic API, for complete control over the profiling process
-;;    (`clear-profiling-info', `start-profiling', `stop-profiling',
-;;     `profile-results', `get-profiling-info', `combine-profiling-info',
-;;     `save-profiling-info').
-;;
-;; For instance, to see where Gnus spends time when generating
-;; Summary buffer, go to the group buffer and press
-;; `M-x profile-key-sequence RET SPC'; or just do
-;; `M-x toggle-profiling', hit SPC, and do `M-x toggle-profiling' again.
-;; (This is especially convenient if you bind `toggle-profiling' to a
-;; keystroke.)
-
-
-;;; Code:
-
-;;; FIXME: This is (almost) a direct copy of `with-displaying-help-buffer'
-;; that exists only in 21.5 core.  When 21.5 is stable I'd suggest
-;; that this macro be removed and the call to it in `profile-results'
-;; (see fixme comment in that function) below be changed to use the
-;; macro in core.  This is here because the packages are built with
-;; 21.4 so when this file is byte-compiled it doesn't include the
-;; definition of the `with-displaying-temp-buffer'.  Which was OK for
-;; 21.4 users, but 21.5 users would lose. --SY.
-(defmacro profile-displaying-temp-buffer (name &rest body)
-  "Form which makes a help buffer with given NAME and evaluates BODY there.
-
-Use this function for displaying information in temporary buffers, where the
-user will typically view the information and then exit using
-\\\\[help-mode-quit].
-
-The buffer is put into the mode specified in `mode-for-temp-buffer'."
-  `(let* ((winconfig (current-window-configuration))
-	  (was-one-window (one-window-p))
-	  (buffer-name ,name)
-	  (help-not-visible
-	   (not (and (windows-of-buffer buffer-name) ;shortcut
-		     (memq (selected-frame)
-			   (mapcar 'window-frame
-				   (windows-of-buffer buffer-name)))))))
-    (help-register-and-maybe-prune-excess buffer-name)
-    ;; if help-sticky-window is bogus or deleted, get rid of it.
-    (if (and help-sticky-window (or (not (windowp help-sticky-window))
-				    (not (window-live-p help-sticky-window))))
-	(setq help-sticky-window nil))
-    (prog1
-	(let ((temp-buffer-show-function
-	       (if help-sticky-window
-		   #'(lambda (buffer)
-		       (set-window-buffer help-sticky-window buffer))
-		 temp-buffer-show-function)))
-	  (with-output-to-temp-buffer buffer-name
-	    (prog1 (progn ,@body)
-	      (save-excursion
-		(set-buffer standard-output)
-		(funcall mode-for-help)))))
-      (let ((helpwin (get-buffer-window buffer-name)))
-	(when helpwin
-	  ;; If the temp buffer is already displayed on this
-	  ;; frame, don't override the previous configuration
-	  (when help-not-visible
-	    (with-current-buffer (window-buffer helpwin)
-	      (setq help-window-config winconfig)))
-	  (when help-selects-help-window
-	    (select-window helpwin))
-	  (cond ((eq helpwin (selected-window))
-		 (display-message 'command
-		   (substitute-command-keys "Type \\[help-mode-quit] to remove window, \\[scroll-up] to scroll the text.")))
-		(was-one-window
-		 (display-message 'command
-		   (substitute-command-keys "Type \\[delete-other-windows] to remove window, \\[scroll-other-window] to scroll the text.")))
-		(t
-		 (display-message 'command
-		   (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the text.")))))))))
-
-(put 'profile-displaying-temp-buffer 'lisp-indent-function 1)
-
-;;;###autoload
-(defun profile-results (&optional info stream sort-by)
-  "Print profiling info INFO to STREAM in a pretty format.
-If INFO is omitted, the current profiling info is retrieved using
- `get-profiling-info'.
-If STREAM is omitted, the results will be displayed in a temp buffer
- using `with-output-to-temp-buffer'; otherwise, they will simply be
- printed into STREAM.  Use `standard-output' explicitly if you
- want standard output.
-If SORT-BY is `call-count' (interactively, the prefix arg), display items
- sorted by call count rather than timing.  If `gc-usage' (interactively,
- use C-u C-u), sort by GC usage."
-  (interactive (list nil nil (cond ((equal current-prefix-arg '(16))
-				    'gc-usage)
-				   (current-prefix-arg 'call-count))))
-  (or info (setq info (get-profiling-info)))
-  (if (not stream)
-      ;; FIXME: change this to `with-displaying-temp-buffer' when that
-      ;; exists in stable XEmacs. --SY.
-      (profile-displaying-temp-buffer "*Profiling Results*"
-	(profile-results info standard-output sort-by))
-    (let* ((standard-output stream)
-	   ;; #### Support old profile format for the moment
-	   (timing (if (consp (car info)) (copy-alist info)
-		     (loop for x being the hash-key in (getf info 'timing)
-		       using (hash-value y)
-		       collect (cons x y))))
-	   (total-timing (if (boundp 'call-count-profile-table)
-			       (make-hash-table)
-			     (getf info 'total-timing)))
-	   (call-count (if (boundp 'call-count-profile-table)
-			   call-count-profile-table
-			 (getf info 'call-count)))
-	   (gc-usage (if (boundp 'call-count-profile-table)
-			 (make-hash-table)
-		       (getf info 'gc-usage)))
-	   (total-gc-usage (if (boundp 'call-count-profile-table)
-			       (make-hash-table)
-			     (getf info 'total-gc-usage)))
-	   (spaces-for-data 41)
-	   (spaces-for-fun (- 79 spaces-for-data))
-	   maxfunlen)
-      (loop for table in (list total-timing call-count gc-usage total-gc-usage)
-	do
-	;; Add entries for any functions in other tables but no ticks
-	(loop for x being the hash-key in table using (hash-value y) do
-	  (if (not (assoc x timing))
-	      (push (cons x 0) timing))))
-      ;; Calculate the longest function
-      (setq maxfunlen
-	    (apply #'max
-		   (length "Function Name")
-		   (mapcar
-		    (lambda (el)
-		      (let ((l (length (format "%s" (car el)))))
-			(if (<= l spaces-for-fun)
-			    l 0)))
-		    timing)))
-      (princ (format "%-*sTicks/Total %%Usage Calls GC-Usage/  Total\n"
-		     maxfunlen "Function Name"))
-      (princ (make-string maxfunlen ?=))
-      (princ "=====/===== ====== ===== ========/=======\n")
-      (let ((timing-sum (float (apply #'+ (mapcar #'cdr timing))))
-	    (calls-sum 0)
-	    (gc-sum 0))
-	(dolist (entry
-		 (nreverse
-		  (sort timing
-			(cond ((eq sort-by 'call-count)
-			       #'(lambda (a b)
-				   (< (or (gethash (car a) call-count) 0)
-				      (or (gethash (car b) call-count) 0))))
-			      ((eq sort-by 'gc-usage)
-			       #'(lambda (a b)
-				   (< (or (gethash (car a) gc-usage) 0)
-				      (or (gethash (car b) gc-usage) 0))))
-			      (t #'cdr-less-than-cdr)))))
-	  (princ (format "%-*s%5d/%5d %6.3f %s %s\n"
-			 maxfunlen
-			 ;; if function too long (often lambdas or compiled
-			 ;; funs), put in a newline to keep the alignment
-			 (let ((str (format "%s" (car entry))))
-			   (if (<= (length str) maxfunlen) str
-			     (concat str "\n" (make-string maxfunlen ? ))))
-			 (cdr entry)
-			 (or (gethash (car entry) total-timing) 0)
-			 (if (zerop timing-sum)
-			     0
-			   (* 100 (/ (cdr entry) timing-sum)))
-			 (let ((count (gethash (car entry) call-count)))
-			   (if count (format "%5d" count) "     "))
-			 (let ((gcval (or (gethash (car entry) gc-usage) 0))
-			       (total-gcval
-				(or (gethash (car entry) total-gc-usage) 0)))
-			   (if (or (/= gcval 0) (/= total-gcval 0))
-			       (format "%8d/%7d" gcval total-gcval)
-			     "                "))
-			 ))
-	  (incf calls-sum (or (gethash (car entry) call-count 0)))
-	  (incf gc-sum (or (gethash (car entry) gc-usage 0)))
-	  )
-	(princ (make-string (+ maxfunlen spaces-for-data) ?-))
-	(princ (format "\n%-*s%7d      %7.3f %5d %8d\n"
-		       (- maxfunlen 2) "Total" timing-sum 100.0 calls-sum
-		       gc-sum))
-	(princ (format "\n
-Ticks/Total     = Ticks this function/this function and descendants
-Calls           = Number of calls to this function
-GC-Usage/Total  = Lisp allocation this function/this function and descendants
-One tick        = %g ms\n"
-		       (/ default-profiling-interval 1000.0)))
-	(and (boundp 'internal-error-checking)
-	     (delq 'quick-build internal-error-checking)
-	     (princ "
-WARNING: Error checking is turned on in this XEmacs.  This might make
-         the measurements very unreliable.\n"))))))
-
-;;;###autoload
-(defun combine-profiling-info (&rest info)
-  "Add up the profiling results accumulated during many profiling sessions.
-See `profile'."
-  (if (boundp 'call-count-profile-table)
-      ;; #### old format
-      (let ((hash (make-hash-table :test 'equal)))
-	(loop for i in info do
-	  (loop for (x . y) in i do
-	    (puthash x (+ y (or (gethash x hash) 0)) hash)))
-	(loop for x being the hash-key in hash using (hash-value y)
-	  collect (cons x y)))
-    (let ((ninfo (list 'timing (make-hash-table :test 'equal)
-		       'total-timing (make-hash-table :test 'equal)
-		       'call-count (make-hash-table :test 'equal)
-		       'gc-usage (make-hash-table :test 'equal)
-		       'total-gc-usage (make-hash-table :test 'equal)
-		       )))
-      (loop
-	for i in info do
-	(loop for (key hash) on i by #'cddr
-	  for reshash = (getf ninfo key) do
-	  (loop for x being the hash-key in hash using (hash-value y) do
-	    (puthash x (+ (or y 0) (or (gethash x reshash) 0)) reshash))))
-      ninfo)))
-
-;;;###autoload
-(defmacro save-profiling-info (&rest body)
-  "Execute BODY, preserving the profiling info and profiling on-ness."
-  (let ((old-profiling-info (gensym "spi"))
-	(old-was-profiling (gensym "spi")))
-  `(let ((,old-profiling-info (get-profiling-info))
-	 (,old-was-profiling (profiling-active-p)))
-     (unwind-protect
-	 (progn ,@body)
-       (if (not (eq ,old-was-profiling (profiling-active-p)))
-	   (if ,old-was-profiling (start-profiling) (stop-profiling)))
-       (set-profiling-info ,old-profiling-info)))))
-
-;;;###autoload
-(defmacro profile (&rest forms)
-  "Profile FORMS and display results in a temporary buffer.
-This clears out existing profiling info, turns on profiling, executes
-the forms, turns off profiling, and displays the results.
-
-If you want to accumulate the results of multiple profiling runs, you can
-use `continue-profile', which does not clear out existing profiling info.
-
-If you are looking for high-level interactive commands for profiling key
-sequences, commands, and expressions, see `profile-key-sequence',
-`profile-command', and `profile-expression'.
-
-See also `toggle-profiling', which lets you easily profile any sequence
-of commands.
-
-If you need more control over what is profiled and what isn't, use the more
-basic functions `clear-profiling-info', `start-profiling',
-`stop-profiling', `profile-results', `get-profiling-info',
-`combine-profiling-info' and `save-profiling-info'."
-  `(progn
-    (clear-profiling-info)
-     (unwind-protect
-	 (progn
-	   (start-profiling)
-	   ,@forms)
-       (stop-profiling))
-    (profile-results)))
-
-;;;###autoload
-(defmacro continue-profile (&rest forms)
-  "Profile FORMS, combining the results with previous profile runs.
-Display results in a temporary buffer.  Unlike `profile', this does
-not clear out existing profile information first, and will leave profiling
-on if it was already on when this macro was invoked."
-  `(let ((was-profiling (profiling-active-p)))
-     (unwind-protect
-	 (progn
-	   (start-profiling)
-	   ,@forms)
-       (unless was-profiling
-	 (stop-profiling)))
-     (profile-results)))
-
-(put 'profile 'lisp-indent-function 0)
-(put 'continue-profile 'lisp-indent-function 0)
-
-;;;###autoload
-(defun profile-expression (expr &optional arg)
-  "Eval EXPR, profiling the execution and displaying the results.
-With prefix, combine results with results from a previous run."
-  (interactive (list (read (read-string "Expression to profile: "))
-		     current-prefix-arg))
-  (if arg (continue-profile (eval expr))
-    (profile (eval expr))))
-
-;;;###autoload
-(defun profile-command (command &optional arg)
-  "Run COMMAND, profiling the execution and displaying the results.
-With prefix, combine results with results from a previous run."
-  (interactive "CCommand to profile: \nP")
-  (if arg (continue-profile (call-interactively command))
-    (profile (call-interactively command))))
-
-;;;###autoload
-(defun profile-key-sequence (keys &optional arg)
-  "Dispatch the key sequence KEYS, profile the execution and show the results.
-KEYS can be a vector of keypress events, a keypress event, or a character.
-With prefix, combine results with results from a previous run."
-  (interactive "kProfile keystroke: \nP")
-  (and (characterp keys)
-       (setq keys (character-to-event keys)))
-  (or (vectorp keys)
-      (setq keys (vector keys)))
-  (if arg (continue-profile (mapc 'dispatch-event keys))
-    (profile (mapc 'dispatch-event keys))))
-
-;;;###autoload
-(defun toggle-profiling ()
-  "Start profiling, or stop it and print results.
-This lets you figure out where time is being spent when executing Lisp code."
-  (interactive)  
-  (if (profiling-active-p) 
-      (progn  
-	(stop-profiling) 
-	(message "...Finished profiling")
-	(profile-results))
-    (message "Profiling...") 
-    (clear-profiling-info) 
-    (start-profiling)))
-
-;;;###autoload
-(defmacro compile-and-profile (&rest forms)
-  "Byte compile FORMS, profile the execution, and pretty-print the results."
-  `(progn
-     (flet ((compiled-code-being-profiled () ,@forms))
-       (byte-compile 'compiled-code-being-profiled)
-       (profile (compiled-code-being-profiled)))))
-
-;;;###autoload
-(defmacro compile-and-continue-profile (&rest forms)
-  "Like `compile-and-profile' but combine results with previous profile runs."
-  `(progn
-     (flet ((compiled-code-being-profiled () ,@forms))
-       (byte-compile 'compiled-code-being-profiled)
-       (continue-profile (compiled-code-being-profiled)))))
-
-;;; profile.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/reposition.el b/xemacs-packages/lisp/xemacs-devel/reposition.el
deleted file mode 100644
index 82e1b7f5..00000000
--- a/xemacs-packages/lisp/xemacs-devel/reposition.el
+++ /dev/null
@@ -1,202 +0,0 @@
-;;; reposition.el --- center a Lisp function or comment on the screen
-
-;; Copyright (C) 1991, 1994 Free Software Foundation, Inc.
-
-;; Author: Michael D. Ernst 
-;; Created: Jan 1991
-;; Maintainer: FSF
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;;; Commentary:
-
-;; Reposition-window makes an entire function definition or comment visible,
-;; or, if it is already visible, places it at the top of the window;
-;; additional invocations toggle the visibility of comments preceding the
-;; code.  For the gory details, see the documentation for reposition-window;
-;; rather than reading that, you may just want to play with it.
-
-;; This tries pretty hard to do the recentering correctly; the precise
-;; action depends on what the buffer looks like.  If you find a situation
-;; where it doesn't behave well, let me know.  This function is modeled
-;; after one of the same name in ZMACS, but the code is all-new and the
-;; behavior in some situations differs.
-
-;;; Code:
-
-;;;###autoload
-(defun reposition-window (&optional arg)
-  "Make the current definition and/or comment visible.
-Further invocations move it to the top of the window or toggle the
-visibility of comments that precede it.
-  Point is left unchanged unless prefix ARG is supplied.
-  If the definition is fully onscreen, it is moved to the top of the
-window.  If it is partly offscreen, the window is scrolled to get the
-definition (or as much as will fit) onscreen, unless point is in a comment
-which is also partly offscreen, in which case the scrolling attempts to get
-as much of the comment onscreen as possible.
-  Initially `reposition-window' attempts to make both the definition and
-preceding comments visible.  Further invocations toggle the visibility of
-the comment lines.
-  If ARG is non-nil, point may move in order to make the whole defun
-visible (if only part could otherwise be made so), to make the defun line
-visible (if point is in code and it could not be made so, or if only
-comments, including the first comment line, are visible), or to make the
-first comment line visible (if point is in a comment)."
-  (interactive "P")
-  (let* (;; (here (save-excursion (beginning-of-line) (point)))
-	 (here (point))
-	 ;; change this name once I've gotten rid of references to ht.
-	 ;; this is actually the number of the last screen line
-	 (ht (- (window-height (selected-window)) 2))
-	 (line (repos-count-screen-lines (window-start) (point)))
-	 (comment-height
-	  ;; The call to max deals with the case of cursor between defuns.
-	  (max 0
-	       (repos-count-screen-lines-signed
-		;; the beginning of the preceding comment
-		(save-excursion
-		  (if (not (eobp)) (forward-char 1))
-		  (end-of-defun -1)
-		  ;; Skip whitespace, newlines, and form feeds.
-		  (if (re-search-forward "[^ \t\n\f]" nil t)
-		      (backward-char 1))
-		  (point))
-		here)))
-	 (defun-height
-	   (repos-count-screen-lines-signed
-	    (save-excursion
-	      (end-of-defun 1) ; so comments associate with following defuns
-	      (beginning-of-defun 1)
-	      (point))
-	    here))
-	 ;; This must be positive, so don't use the signed version.
-	 (defun-depth (repos-count-screen-lines here
-						(save-excursion
-						  (end-of-defun 1)
-						  (point))))
-	 (defun-line-onscreen-p
-	   (and (<= defun-height line)
-		(<= (- line defun-height) ht))))
-    (cond ((or (= comment-height line)
-	       (and (= line ht)
-		    (> comment-height line)
-		    ;; if defun line offscreen, we should be in case 4
-		    defun-line-onscreen-p))
-	   ;; Either first comment line is at top of screen or (point at
-	   ;; bottom of screen, defun line onscreen, and first comment line
-	   ;; off top of screen).  That is, it looks like we just did
-	   ;; recenter-definition, trying to fit as much of the comment
-	   ;; onscreen as possible.  Put defun line at top of screen; that
-	   ;; is, show as much code, and as few comments, as possible.
-
-	   (if (and arg (> defun-depth (1+ ht)))
-	       ;; Can't fit whole defun onscreen without moving point.
-	       (progn (end-of-defun) (beginning-of-defun) (recenter 0))
-	     (recenter (max defun-height 0)))
-	   ;;(repos-debug-macro "1")
-	   )
-
-	  ((or (= defun-height line)
-	       (= line 0)
-	       (and (< line comment-height)
-		    (< defun-height 0)))
-	   ;; Defun line or cursor at top of screen, OR cursor in comment
-	   ;; whose first line is offscreen.
-	   ;; Avoid moving definition up even if defun runs offscreen;
-	   ;; we care more about getting the comment onscreen.
-
-	   (cond ((= line ht)
-		  ;; cursor on last screen line (and so in a comment)
-		  (if arg (progn (end-of-defun) (beginning-of-defun)))
-		  (recenter 0)
-		  ;;(repos-debug-macro "2a")
-		  )
-
-		 ;; This condition, copied from case 4, may not be quite right
-
-		 ((and arg (< ht comment-height))
-		  ;; Can't get first comment line onscreen.
-		  ;; Go there and try again.
-		  (forward-line (- comment-height))
-		  (beginning-of-line)
-		  ;; was (reposition-window)
-		  (recenter 0)
-		  ;;(repos-debug-macro "2b")
-		  )
-		 (t
-		  (recenter (min ht comment-height))
-		  ;;(repos-debug-macro "2c")
-		  ))
-	   ;; (recenter (min ht comment-height))
-	   )
-
-	  ((and (> (+ line defun-depth -1) ht)
-		defun-line-onscreen-p)
-	   ;; Defun runs off the bottom of the screen and the defun line
-	   ;; is onscreen.
-	   ;; Move the defun up.
-	   (recenter (max 0 (1+ (- ht defun-depth)) defun-height))
-	   ;;(repos-debug-macro "3")
-	   )
-
-	  (t
-	   ;; If on the bottom line and comment start is offscreen
-	   ;; then just move all comments offscreen, or at least as
-	   ;; far as they'll go.
-
-	   ;; Try to get as much of the comments onscreen as possible.
-	   (if (and arg (< ht comment-height))
-	       ;; Can't get defun line onscreen; go there and try again.
-	       (progn (forward-line (- defun-height))
-		      (beginning-of-line)
-		      (reposition-window))
-	     (recenter (min ht comment-height)))
-	   ;;(repos-debug-macro "4")
-	   ))))
-
-;;; This key should be bound to switch-to-other-buffer by default so
-;;; don't ###autoload it. -jwz
-(define-key esc-map "\C-l" 'reposition-window)
-
-;;; Auxiliary functions
-
-;; Return number of screen lines between START and END.
-(defun repos-count-screen-lines (start end)
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      (vertical-motion (- (point-max) (point-min))))))
-
-;; Return number of screen lines between START and END; returns a negative
-;; number if END precedes START.
-(defun repos-count-screen-lines-signed (start end)
-  (let ((lines (repos-count-screen-lines start end)))
-    (if (< start end)
-	lines
-      (- lines))))
-
-; (defmacro repos-debug-macro (case-no)
-;   (` (message
-;       (concat "Case " (, case-no) ": %s %s %s %s %s")
-;       ht line comment-height defun-height defun-depth)))
-
-;;; reposition.el ends here
diff --git a/xemacs-packages/lisp/xemacs-devel/trace.el b/xemacs-packages/lisp/xemacs-devel/trace.el
deleted file mode 100644
index c58d34c3..00000000
--- a/xemacs-packages/lisp/xemacs-devel/trace.el
+++ /dev/null
@@ -1,331 +0,0 @@
-;;; trace.el --- tracing facility for Emacs Lisp functions
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Hans Chalupsky 
-;; Created: 15 Dec 1992
-;; Keywords: tools, lisp
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: FSF 19.34.
-
-;; LCD Archive Entry:
-;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
-;; Tracing facility for Emacs Lisp functions|
-;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z|
-
-
-;;; Commentary:
-
-;; Introduction:
-;; =============
-;; A simple trace package that utilizes advice.el. It generates trace 
-;; information in a Lisp-style fashion and inserts it into a trace output
-;; buffer. Tracing can be done in the background (or silently) so that
-;; generation of trace output won't interfere with what you are currently
-;; doing.
-
-;; How to get the latest trace.el:
-;; ===============================
-;; You can get the latest version of this file either via anonymous ftp from 
-;; ftp.cs.buffalo.edu (128.205.32.9) with pathname /pub/Emacs/trace.el,
-;; or send email to hans@cs.buffalo.edu and I'll mail it to you.
-
-;; Requirement:
-;; ============
-;; trace.el needs advice.el version 2.0 or later which you can get from the
-;; same place from where you got trace.el.
-
-;; Restrictions:
-;; =============
-;; - Traced subrs when called interactively will always show nil as the
-;;   value of their arguments.
-;; - Only functions/macros/subrs that are called via their function cell will
-;;   generate trace output, hence, you won't get trace output for:
-;;   + Subrs called directly from other subrs/C-code
-;;   + Compiled calls to subrs that have special byte-codes associated
-;;     with them (e.g., car, cdr, ...)
-;;   + Macros that were expanded during compilation
-;; - All the restrictions that apply to advice.el
-
-;; Installation:
-;; =============
-;; Put this file together with advice.el (version 2.0 or later) somewhere
-;; into your Emacs `load-path', byte-compile it/them for efficiency, and
-;; put the following autoload declarations into your .emacs
-;;
-;;    (autoload 'trace-function "trace" "Trace a function" t)
-;;    (autoload 'trace-function-background "trace" "Trace a function" t)
-;;
-;; or explicitly load it with (require 'trace) or (load "trace").
-
-;; Comments, suggestions, bug reports
-;; ==================================
-;; are strongly appreciated, please email them to hans@cs.buffalo.edu.
-
-;; Usage:
-;; ======
-;; - To trace a function say `M-x trace-function' which will ask you for the
-;;   name of the function/subr/macro to trace, as well as for the buffer
-;;   into which trace output should go.
-;; - If you want to trace a function that switches buffers or does other
-;;   display oriented stuff use `M-x trace-function-background' which will
-;;   generate the trace output silently in the background without popping
-;;   up windows and doing other irritating stuff.
-;; - To untrace a function say `M-x untrace-function'.
-;; - To untrace all currently traced functions say `M-x untrace-all'.
-
-;; Examples:
-;; =========
-;;
-;;  (defun fact (n)
-;;    (if (= n 0) 1
-;;      (* n (fact (1- n)))))
-;;  fact
-;;  
-;;  (trace-function 'fact)
-;;  fact
-;;
-;;  Now, evaluating this...
-;;
-;;  (fact 4)
-;;  24
-;;
-;;  ...will generate the following in *trace-buffer*:
-;;
-;;  1 -> fact: n=4
-;;  | 2 -> fact: n=3
-;;  | | 3 -> fact: n=2
-;;  | | | 4 -> fact: n=1
-;;  | | | | 5 -> fact: n=0
-;;  | | | | 5 <- fact: 1
-;;  | | | 4 <- fact: 1
-;;  | | 3 <- fact: 2
-;;  | 2 <- fact: 6
-;;  1 <- fact: 24
-;;
-;;
-;;  (defun ack (x y z)
-;;    (if (= x 0) 
-;;        (+ y z)
-;;      (if (and (<= x 2) (= z 0)) 
-;;          (1- x)
-;;        (if (and (> x 2) (= z 0)) 
-;;            y
-;;          (ack (1- x) y (ack x y (1- z)))))))
-;;  ack
-;;
-;;  (trace-function 'ack)
-;;  ack
-;;
-;;  Try this for some interesting trace output:
-;;
-;;  (ack 3 3 1)
-;;  27
-;;
-;; 
-;; The following does something similar to the functionality of the package
-;; log-message.el by Robert Potter, which is giving you a chance to look at
-;; messages that might have whizzed by too quickly (you won't see subr
-;; generated messages though):
-;;
-;; (trace-function-background 'message "*Message Log*")
-
-
-;;; Change Log:
-
-;; Revision 2.0 1993/05/18 00:41:16 hans
-;;	* Adapted for advice.el 2.0; it now also works
-;;	  for GNU Emacs-19 and XEmacs
-;;	* Separate function `trace-function-background'
-;;	* Separate pieces of advice for foreground and background tracing
-;;	* Less insane handling of interactive trace buffer specification
-;;	* String arguments and values are now printed properly
-;;
-;; Revision 1.1 1992/12/15 22:45:15 hans
-;;	* Created, first public release
-
-
-;;; Code:
-
-(require 'advice)
-
-;; XEmacs change (leave the version # in place)
-(defconst trace-version "2.0")
-
-;;;###autoload
-(defvar trace-buffer "*trace-output*"
-  "*Trace output will by default go to that buffer.")
-
-;; Current level of traced function invocation:
-(defvar trace-level 0)
-
-;; Semi-cryptic name used for a piece of trace advice:
-(defvar trace-advice-name 'trace-function\ )
-
-;; Used to separate new trace output from previous traced runs:
-(defvar trace-separator (format "%s\n" (make-string 70 ?=)))
-
-(defun trace-entry-message (function level argument-bindings)
-  ;; Generates a string that describes that FUNCTION has been entered at
-  ;; trace LEVEL with ARGUMENT-BINDINGS.
-  (format "%s%s%d -> %s: %s\n"
-	  (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
-	  (if (> level 1) " " "")
-	  level
-	  function
-	  (mapconcat (function
-		      (lambda (binding)
-			(concat
-			 (symbol-name (ad-arg-binding-field binding 'name))
-			 "="
-			 ;; do this so we'll see strings:
-			 (prin1-to-string
-			  (ad-arg-binding-field binding 'value)))))
-		     argument-bindings
-		     " ")))
-
-(defun trace-exit-message (function level value)
-  ;; Generates a string that describes that FUNCTION has been exited at
-  ;; trace LEVEL and that it returned VALUE.
-  (format "%s%s%d <- %s: %s\n"
-	  (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
-	  (if (> level 1) " " "")
-	  level
-	  function
-	  ;; do this so we'll see strings:
-	  (prin1-to-string value)))
-
-(defun trace-make-advice (function buffer background)
-  ;; Builds the piece of advice to be added to FUNCTION's advice info
-  ;; so that it will generate the proper trace output in BUFFER
-  ;; (quietly if BACKGROUND is t).
-  (ad-make-advice
-   trace-advice-name nil t
-   (cond (background
-	  (` (advice
-	      lambda ()
-	      (let ((trace-level (1+ trace-level))
-		    (trace-buffer (get-buffer-create (, buffer))))
-		(save-excursion
-		  (set-buffer trace-buffer)
-		  (goto-char (point-max))
-		  ;; Insert a separator from previous trace output:
-		  (if (= trace-level 1) (insert trace-separator))
-		  (insert
-		   (trace-entry-message
-		    '(, function) trace-level ad-arg-bindings)))
-		ad-do-it
-		(save-excursion
-		  (set-buffer trace-buffer)
-		  (goto-char (point-max))
-		  (insert
-		   (trace-exit-message
-		    '(, function) trace-level ad-return-value)))))))
-	 (t (` (advice
-		lambda ()
-		(let ((trace-level (1+ trace-level))
-		      (trace-buffer (get-buffer-create (, buffer))))
-		  (pop-to-buffer trace-buffer)
-		  (goto-char (point-max))
-		  ;; Insert a separator from previous trace output:
-		  (if (= trace-level 1) (insert trace-separator))
-		  (insert
-		   (trace-entry-message
-		    '(, function) trace-level ad-arg-bindings))
-		  ad-do-it
-		  (pop-to-buffer trace-buffer)
-		  (goto-char (point-max))
-		  (insert
-		   (trace-exit-message
-		    '(, function) trace-level ad-return-value)))))))))
-
-(defun trace-function-internal (function buffer background)
-  ;; Adds trace advice for FUNCTION and activates it.
-  (ad-add-advice
-   function
-   (trace-make-advice function (or buffer trace-buffer) background)
-   'around 'last)
-  (ad-activate function nil))
-
-(defun trace-is-traced (function)
-  (ad-find-advice function 'around trace-advice-name))
-
-;; shamelessly stolen from find-func
-(defun trace-function-read (prompt)
-  "Read and return an interned function symbol.
-Default to the one near point."
-  (let* ((symb (function-at-point))
-	 (enable-recursive-minibuffers t)
-	 (val (completing-read
-	       (format prompt
-		       (if symb (format " (default %s)" symb) ""))
-	       obarray 'fboundp t nil 'function-history)))
-    (if (equal val "") symb (intern val))))
-
-
-;;;###autoload
-(defun trace-function (function &optional buffer)
-  "Traces FUNCTION with trace output going to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! The trace BUFFER will popup whenever FUNCTION is called.
-Do not use this to trace functions that switch buffers or do any other
-display oriented stuff, use `trace-function-background' instead."
-  (interactive
-   (list
-    (trace-function-read "Trace function%s: ")
-    (read-buffer "Output to buffer: " trace-buffer)))
-  (trace-function-internal function buffer nil))
-
-;;;###autoload
-(defun trace-function-background (function &optional buffer)
-  "Traces FUNCTION with trace output going quietly to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! Trace output will quietly go to BUFFER without changing
-the window or buffer configuration at all."
-  (interactive
-   (list
-    (trace-function-read "Trace function in background%s: ")
-    (read-buffer "Output to buffer: " trace-buffer)))
-  (trace-function-internal function buffer t))
-
-(defun untrace-function (function)
-  "Untraces FUNCTION and possibly activates all remaining advice.
-Activation is performed with `ad-update', hence remaining advice will get
-activated only if the advice of FUNCTION is currently active. If FUNCTION
-was not traced this is a noop."
-  (interactive
-   (list (ad-read-advised-function "Untrace function: " 'trace-is-traced)))
-  (cond ((trace-is-traced function)
-	 (ad-remove-advice function 'around trace-advice-name)
-	 (ad-update function))))
-
-(defun untrace-all ()
-  "Untraces all currently traced functions."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (untrace-function function)))
-
-(provide 'trace)
-
-;;; trace.el ends here
diff --git a/xemacs-packages/man/bbdb/bbdb.texinfo b/xemacs-packages/man/bbdb/bbdb.texinfo
deleted file mode 100644
index 0c6ea7b9..00000000
--- a/xemacs-packages/man/bbdb/bbdb.texinfo
+++ /dev/null
@@ -1,3978 +0,0 @@
-\input texinfo  @c -*-texinfo-*-  -*- coding: iso-latin-1 -*-
-@c %**start of header
-@setfilename bbdb.info
-@settitle Insidious Big Brother Database User Manual
-@c %**end of header
-
-@c
-@c $Id: bbdb.texinfo,v 1.9 2005/07/24 15:23:05 waider Exp $
-@c
-
-@ifinfo
-@dircategory Emacs
-@direntry
-* BBDB: (bbdb).             The Insidious Big Brother Database.
-@end direntry
-
-This file documents the Insidious Big Brother Database
-
-This is edition $Revision: 1.9 $ of the BBDB User Manual for BBDB
-version 2.34.
-
-Copyright (c) 1991-1994 Jamie Zawinski 
-
-Copyright (c) 1997-1999 Matt Simmons 
-
-Copyright (c) 2000-present The BBDB Development Team
-@end ifinfo
-
-@titlepage
-@title BBDB User Manual
-@subtitle A phone number and address database program for Emacs
-@subtitle Edition $Revision: 1.9 $, $Date: 2005/07/24 15:23:05 $
-
-@author by Jamie Zawinski, Matt Simmons and the BBDB Development Team
-@page
-Copyright @copyright{} 1991-1994 Jamie Zawinski 
-
-Copyright @copyright{} 1997-1999 Matt Simmons 
-
-Copyright @copyright{} 2000-present The BBDB Development Team
-
-@sp 2
-This is edition $Revision: 1.9 $ of the @cite{BBDB User Manual} for BBDB
-version 2.34, $Date: 2005/07/24 15:23:05 $.@refill
-
-@sp 2
-
-Permission is granted to make and distribute verbatim copies of this
-manual provided the copyright notice and this permission notice are
-preserved on fnord all copies.
-
-Permission is granted to copy and distribute modified versions of
-this manual under the conditions for verbatim copying, provided that
-the entire resulting derived work is distributed under the terms of a
-permission notice identical to this one.
-
-Permission is granted to copy and distribute translations of this
-manual into another language, under the above conditions for modified
-versions, except that this permission notice may be stated in a
-translation approved by the author.
-
-@end titlepage
-@page
-
-@node Top, Installation,,_
-@chapter BBDB
-
-@b{BBDB} is a rolodex-like database program for GNU Emacs.  @b{BBDB} stands
-for @b{@i{Insidious Big Brother Database}}, and is not, repeat, @emph{not} an
-obscure reference to the Buck Rogers TV series.
-
-It provides the following features:
-
-@itemize @bullet
-@item
-Integration with mail and news readers, with little or no
-interaction by the user: @refill
-
-@itemize @bullet
-@item
-easy (or automatic) display of the record corresponding to the sender of
-the current message; @refill
-
-@item
-automatic creation of records based on the contents of the current
-message; @refill
-
-@item
-automatic addition of data to arbitrary fields of the record
-corresponding to the sender of the current message. @refill
-@end itemize
-
-@item
-Listing all records which match a regular expression;
-
-@item
-Listing all records which match a regular expression in a particular
-field (@samp{company} or @samp{notes,} for example); @refill
-@end itemize
-
-@menu
-* Installation::		Installation
-* The BBDB::		        Overview
-* BBDB Mode::			BBDB Mode
-* Interfaces::			Interfaces to various readers
-* Reader-specific Features::    Features only available to specific readers
-* Other Packages::              Using the BBDB with other packages
-* Options::			Options
-* Utilities::                   Utilities
-* Internals::                   BBDB Internals
-* Mailing Lists::		The BBDB mailing lists
-* Changes::                     New in this version
-* The Latest Version::		Where to Get It
-* The Future::                  Known Bugs, the TODO list and EOL statements
-* Thanks::			to the Ministry of Bugs
-
-* Concept Index::		Concept Index
-* Variable Index::		Variable Index
-
-@detailmenu
- --- The Detailed Node Listing ---
-
-Installation
-
-* General Prerequisites::       General @b{BBDB} requirements
-
-File Installation
-* Normal User::                 "Normal" Installations
-* XEmacs Package::              Installing as an XEmacs package
-
-Initial Configuration
-* Initial Configuration::       How to initially set up the @b{BBDB}
-
-Manual initialization
-
-* Gnus Prep::           Initializing @b{BBDB} support for Gnus
-* MH-E Prep::           Initializing @b{BBDB} support for MH-E
-* RMAIL Prep::          Initializing @b{BBDB} support for RMAIL
-* Sendmail Prep::       Initializing @b{BBDB} support for Sendmail
-* VM Prep::             Initializing @b{BBDB} support for VM
-
-Other packages:
-
-* Message Prep::        Initializing @b{BBDB} support for Message mode
-* Reportmail Prep::     Initializing @b{BBDB} support for Reportmail
-* Supercite Prep::      Initializing @b{BBDB} support for Supercite
-* Web Browser Prep::    Initializing @b{BBDB} support for Web Browsers
-
-The @b{BBDB}
-
-* Database Fields::             Description of database fields
-* Basic Searching::             Basic database searching commands
-* Advanced Searching::          Advanced database searching commands
-* Manual Record Addition::      Adding records by hand
-
-Interfaces
-
-* Mail Reading Interfaces::		Mail Reading Interfaces
-* News Reading Interfaces::		News Reading Interfaces
-* Mail Sending Interfaces::		Mail Sending Interfaces
-
-Reader-specific Features
-
-* Gnus Features::                       Gnus-specific Features
-* VM Features::                         VM-specific Features
-
-Gnus-specific Features
-
-* Gnus Scoring::                        Store score adjustments in the @b{BBDB}
-* Gnus Summary Buffer::                 @b{BBDB} information in the Summary buffer
-* GNUS Subject List::                   @b{BBDB} information in the Subject List
-
-VM-specific features
-
-* VM Message Summary::                  @b{BBDB} information in message summary
-
-Using the @b{BBDB} with other packages
-
-* Using Message Mode::          Using the @b{BBDB} with Message Mode
-* Using Reportmail::            Using the @b{BBDB} with Reportmail
-* Using Supercite::             Using the @b{BBDB} with Supercite
-* Using Web Browsers::          Using the @b{BBDB} with Web Browsers
-
-Options
-
-* Customization Parameters::	Customization Parameters
-* Customization Hooks::		Customization Hooks
-* Predefined Hooks::		Predefined Hooks
-
-Utilities
-
-* bbdb-ftp::                    Storing FTP sites in the @b{BBDB}
-* bbdb-print::                  Print the @b{BBDB}
-* bbdb-snarf::                  Record generation from raw text
-* bbdb-srv::                    External control of the @b{BBDB}
-
-Changes in this Version
-
-* Major Changes::                Major changes in this version
-* Other Changes::                Not-so-major changes
-
-The Future
-
-* Known Bugs::          Known Bugs, and how to submit new ones
-* TODO List::           The TODO List
-* EOL Statements::      EOL (End Of Life) Statements
-
-_
-
-* Top::
-
-@end detailmenu
-@end menu
-
-@node Installation, The BBDB, Top, Top
-@section Installation
-@cindex Installation
-@cindex Makefile
-
-This program consists of several groups of files, organized by
-directory:
-
-@ifinfo
-@example
-     lisp     - the main program code for the @b{BBDB}
-     tex      - TeX support files for @xref{bbdb-print}, the @b{BBDB}
-                printing utility
-     texinfo  - the documentation files for the @b{BBDB}
-     utils    - miscellaneous external utility programs
-     misc     - things that don't fall into the above categories
-     bits     - things that have been written as add-ons for @b{BBDB}
-                but have not yet been merged with the main codebase
-@end example
-@end ifinfo
-@iftex
-@bgroup@tableindent=1.5in
-@table @b
-@item lisp
-the main program code for the BBDB
-@item tex
-@TeX@ support files for bbdb-print, the BBDB printing utility
-@item texinfo
-the documentation files for the BBDB
-@item utils
-miscellaneous external utility programs
-@item bits
-things that have been written as add-ons for @b{BBDB} but have not yet
-been merged with the main codebase
-@end table
-@egroup
-@end iftex
-
-@menu
-* General Prerequisites::       General @b{BBDB} requirements
-
-File Installation
-* Normal User::                 "Normal" Installations
-* XEmacs Package::              Installing as an XEmacs package
-
-Initial Configuration
-* Initial Configuration::       How to initially set up the @b{BBDB}
-@end menu
-
-@node General Prerequisites, Normal User, Installation, Installation
-@subsection General Prerequisites
-
-Various parts of the @b{BBDB} require extra packages to be available
-that are not part of the @b{BBDB} distribution.  Please note that with
-one exception no extra packages (beyond those which ship with both GNU
-Emacs and XEmacs) are required for the use of @b{BBDB} core
-functionality.@footnote{"Core Functionality" is defined as the parts of
-the @b{BBDB} used to implement basic record creation (@samp{M-x
-bbdb-create}) and searching (@samp{M-x bbdb}).}  This one exception
-applies to XEmacs 20.5 users - the @code{xemacs-base} package must be
-installed for the correct operation of the core @b{BBDB} functionality.
-The table below lists the requirements of the various portions of the
-@b{BBDB}.  Please note that the absence of any of the below optional
-packages will not affect core @b{BBDB} functionality.
-
-@multitable {bbdb-reportmail } {Package needed} {GNU 19.34} {GNU 20.2} {XEmacs} {XEmacs}
-@item @* BBDB file
-@tab @* Package needed
-@tab @* GNU 19.34
-@tab @* GNU 20.2
-@tab XEmacs@* @center >=20.4
-@tab XEmacs@* @center 20.5
-
-@item @code{bbdb-ftp}
-@tab EFS or @* Ange-FTP
-@tab @center B
-@tab @center B
-@tab @center B
-@tab @center P
-
-@item @code{bbdb-gnus}
-@tab Gnus[1]
-@tab @center B
-@tab @center B
-@tab @center B
-@tab @center P
-
-@item @code{bbdb-mhe}
-@tab MH-E
-@tab @center B
-@tab @center B
-@tab @center B
-@tab @center P
-
-@item @code{bbdb-reportmail}
-@tab Reportmail
-@tab
-@tab
-@tab @center B
-@tab @center P[2]
-
-@item @code{bbdb-sc}
-@tab Supercite
-@tab @center B
-@tab
-@tab @center B
-@tab @center P
-
-@item @code{bbdb-srv}
-@tab @code{gnuserv} and @* @code{itimer}
-@tab
-@tab
-@tab @center B
-@tab @center B
-
-@item @code{bbdb-vm}
-@tab VM[4]
-@tab
-@tab
-@tab @center B
-@tab @center P
-
-@item @code{bbdb-w3}
-@tab @code{browse-url}
-@tab @center B
-@tab @center B
-@tab @center B
-@tab @center P[3]
-@end multitable
-
-@* 
-@noindent
-@b{NOTES:}
-@enumerate
-@item 
-The old GNUS mail/newsreader should still work.  Please keep in mind
-that you have a relatively recent Emacs (GNU 19.34 or later, XEmacs
-19.15 or later), you are probably using Gnus. 
-@item
-As of this writing, Reportmail is available as
-part of the @code{edit-utils} package.
-@item
-As of this writing, @code{browse-url} is
-available as part of the @code{mail-lib} package.
-@item
-The source release of VM is currently required due to the use of macros
-from the VM codebase in @b{BBDB}'s VM integration.
-@end enumerate
-
-Please also note that the XEmacs package locations are as of this
-writing.  As the XEmacs 20.5 package system is still in development, the
-locations may change without warning.
-
-@node Normal User, XEmacs Package, General Prerequisites, Installation
-@subsection Normal User Installation
-@cindex Normal User Installation
-
-@subheading Configuring the compilation process
-
-First of all, you should run the @code{configure} script at the toplevel
-of the distribution.  This script will perform a number of checks on
-your system and generate the @file{Makefile}'s accordingly.
-
-The @code{configure} script also comes with a number of options that
-lets you customize the compilation process.  These options are described
-below where appropriate.
-
-@subheading Byte Compiling the Lisp files
-
-First, you need to byte-compile the appropriate @b{BBDB} Lisp files.
-While this is in theory an optional step, it is virtually required in
-practice due to speed reasons.
-
-In order to byte-compile the lisp files, an Emacs of some sort must be
-used. By default (at @code{configure} time), @code{emacs} and
-@code{xemacs} will be tried in that order. If you want to use a special
-Emacs flavor (or if you want to use @code{xemacs} at the first place),
-you should pass the @code{--with-emacs=PROG} option to @code{configure}.
-
-In order to successfully compile the @b{BBDB}, the build process also
-needs to know the location of the various optional packages.  If the
-directories containing these optional packages are in the default Emacs
-search path (the @code{load-path} variable), no other changes need be
-made for the build process to complete successfully.
-
-If the optional packages are not in the default search path, the build
-process will not find them unless explicitly told of their location(s).
-To tell the build process where to find Gnus, MH-E, and/or VM, use the
-@code{configure} options @code{--with-gnus-dir=DIR},
-@code{--with-mhe-dir=DIR}, and/or @code{--with-vm-dir=DIR} variables
-respectively.  To tell the build process where to find any other
-package(s), pass the directories containing the lisp files for the
-package(s) to the @code{configure} option @code{--with-other-dirs=DIRS}.
-If multiple directories are to be added, they should be separated by
-spaces or colons, and should @b{not} be quoted.  For example, to
-add the @file{/p/local/elisp/footnote} and @file{/p/local/elisp/sc}
-directories, call the @code{configure} script as follows:
-
-@example
-  @code{configure --with-other-dirs=/p/local/elisp/footnote:/p/local/elisp/sc}
-@end example
-
-After configuring, run one of the following commands:
-
-@ifinfo
-@example
-     @code{make bbdb}  - Build the core, mailer independent, components
-     @code{make gnus}  - Core components plus @code{Gnus} support
-     @code{make mhe}   - Core components plus @code{MH-E} support
-     @code{make rmail} - Core components plus @code{RMAIL} support
-     @code{make vm}    - Build the core components with @code{VM} support
-     @code{make all}   - Core components plus support for all mailers
-                         listed above
-@end example
-@end ifinfo
-@iftex
-@bgroup@tableindent=1.5in
-@table @b
-@item @code{make bbdb}
-Build the core, mailer independent, components
-@item @code{make gnus}
-Core components plus @code{Gnus} support
-@item @code{make mhe}
-Core components plus @code{MH-E} support
-@item @code{make rmail}
-Core components plus @code{RMAIL} support
-@item @code{make vm}
-Build the core components with @code{VM} support
-@item @code{make all}
-Core components plus support for all mailers listed above
-@end table
-@egroup
-@end iftex
-
-You can also combine the above @code{make} commands.  For example, to
-build the @b{BBDB} with support for @code{Gnus} and @code{VM}, you can
-do so by typing:
-
-@example
-make gnus vm
-@end example
-
-@subheading Moving the files to their final destination
-
-@subsubheading Lisp files
-
-As stated above, the @file{lisp} subdirectory contains the Emacs Lisp source
-files for the @b{BBDB}.  Therefore, these files must be in the Emacs
-@code{load-path}.  There are several ways of doing this, three of which are
-described below:
-
-@itemize @bullet
-@item
-Add the @file{lisp} directory from the source distribution to the
-@code{load-path}.  This will allow you to run the @b{BBDB} in-place.  This
-method is recommended for normal users or @b{BBDB} developers, especially if
-disk usage is an issue.  It is @b{not} recommended for site-wide
-installations. @refill
-
-@item
-Link the @file{lisp} directory into your @file{site-lisp} directory.  This is
-for a site-wide installation, but it is subject to the following caveat.  If you
-link the @file{lisp} directory into @file{site-lisp}, you will make life more
-difficult for yourself down the road, as you will not be able to make changes to
-the source directory (new versions, patches, etc) without having an effect on
-other users who now depend on it.  This directory will automatically be added to
-the @code{load-path} when Emacs starts. @refill
-
-@item
-Make a directory whose sole purpose in life is containing the production copies
-of the @b{BBDB} source and byte-compiled source files.  Either put this
-directory under @file{site-lisp} (or put it somewhere else and link it into
-@file{site-lisp}).  This directory will automatically be added to the
-@code{load-path} when Emacs starts.  This is the best of the three listed here,
-as it allows for a degree of separation between the (possibly changing) source
-tree and the production code.
-@end itemize
-
-@ifinfo
-@subsubheading TeX files
-
-The @file{tex} subdirectory contains the TeX support files for
-bbdb-print, the @b{BBDB} printing utility (@xref{bbdb-print}.). The
-three support files, @file{bbdb-cols.tex}, @file{bbdb-print.tex}, and
-@file{bbdb-print-brief.tex}, must be placed in a directory that is
-either on the default TeX search path or is listed in the
-@code{TEXINPUTS} environment variable. If neither of these two options
-is taken, TeX will not be able to process the file output by
-@code{bbdb-print}.
-@end ifinfo
-@iftex
-@subsubheading @TeX files
-
-The @file{tex} subdirectory contains the @TeX support files for
-bbdb-print, the @b{BBDB} printing utility (@xref{bbdb-print}). The three
-support files, @file{bbdb-cols.tex}, @file{bbdb-print.tex}, and
-@file{bbdb-print-brief.tex}, must be placed in a directory that is
-either on the default @TeX search path or is listed in the
-@code{TEXINPUTS} environment variable. If neither of these two options
-is taken, @TeX will not be able to process the file output by
-@code{bbdb-print}.
-@end iftex
-
-@subsubheading texinfo files
-
-The @file{bbdb.info} file in this directory contains the documentation
-for the @b{BBDB}.  This file should either be linked or copied to a
-directory on the default path for the @code{info} program or listed in
-the @code{INFOPATH} environment variable.
-
-@node XEmacs Package, Initial Configuration, Normal User, Installation
-@subsection XEmacs Package Installation
-@cindex XEmacs Package Installation
-
-@noindent
-@b{NOTE:} XEmacs packages are currently supported only under XEmacs
-versions after and including 20.5.  If you are not running such a version
-of XEmacs, you should install the @b{BBDB} according to the instructions
-in @ref{Normal User}.
-
-@subheading Configuring / Byte Compiling
-
-The configuration and byte-compilation procedures are the same as in the
-Normal User installation.  See @ref{Normal User}.
-
-@subheading Moving the files to their final destination
-
-Support is provided for the automatic installation of the @b{BBDB} in an
-XEmacs package directory. The following @code{configure} options are
-available for you:
-
-@table @b
-@item @code{--with-package-dir=DIR}
-This option sets the root of the XEmacs package directory.  By default,
-@file{/usr/local/lib/xemacs/site-packages} is used.
-@item @code{--with-symlinks}
-If this option is used, the installation will be done by making symbolic
-links to the sources instead of copying the files.
-@item @code{--with-linkpath=PATH}
-Without this option, the installation process uses the output of
-@code{pwd} to determine the current directory.  If something else should
-be used, you should provide an alternate name for the BBDB toplevel
-directory by using @code{--with-linkpath}.  If, for example, @code{pwd}
-returns @file{/p/local/elisp/bbdb}, but you prefer to use
-@file{/usr/local/elisp/bbdb/...} for the links, usr this:
-@code{configure --with-linkpath=/usr/local/elisp/bbdb}.  This option is
-ignored if @code{--with-symlinks} is not used.
-@end table
-
-To perform the (un)installation, use the command @code{make (un)install-pkg}.
-This will compile the @file{lisp/auto-autoloads.el} file and will
-install the appropriate files to the appropriate places.  The final
-installation tree will take the following form:
-
-@table @code
-@item $(PACKAGEDIR)/
-@table @code
-@item lisp/
-@table @code
-@item bbdb/
-   @i{@b{BBDB} lisp source files.  This directory contains a copy of all
-@code{.el} and @code{.elc} files from the @file{lisp} source directory,
-or is a symbolic link to it.}
-@end table
-@item info/
-@table @code
-@item bbdb.info*
-   @i{@b{BBDB} documentation files.  These are either copies of the info
-files from the @file{texinfo} source directory, or are symbolic links to
-them.}
-@end table
-@item etc/
-@table @code
-@item bbdb/
-@table @code
-@item tex/
-    @i{@b{BBDB} support files for bbdb-print.  This directory contains a
-copy of the appropriate files from the @file{tex} source directory, or
-is a symbolic link to it.}
-@item utils/
-    @i{@b{BBDB} miscellaneous utilities.  This directory contains a copy
-of the appropriate files from the @file{utils} source directory, or is a
-symbolic link to it.}
-@end table
-@end table
-@end table
-@end table
-
-@node Initial Configuration,  , XEmacs Package, Installation
-@subsection Initial Configuration
-@cindex Initial Configuration
-@findex bbdb-initialize
-
-The simplest way to configure the @b{BBDB} is to include the following
-forms in your Emacs configuration file:
-
-@example
-@code{(require 'bbdb)}
-@code{(bbdb-initialize)}
-@end example
-
-@b{Note:}  The forms above replace the autoloads needed for previous
-versions of the @b{BBDB}.
-
-This will set up the @b{BBDB} for basic querying and record manipulation
-(the Core Functionality referred to in the Prerequisites section).  It
-will not enable any of the mailreader-, newsreader- or other
-package-specific @b{BBDB} features.  To enable some or all of these
-features, the @code{(bbdb-initialize)} form can be enable as shown
-below.  Alternatively, the features can be enabled manually as described
-in the following sections.
-
-@subheading Modifying @code{(bbdb-initialize)}
-
-The @code{bbdb-initialize} function can be used to enable the various
-package-specific @b{BBDB} functions.  This feature activation is
-accomplished through the passing of symbols which tell the function
-which features to activate.  These symbols are outlined below and in the
-Emacs documentation for the @code{bbdb-initialize}@footnote{This
-documentation can be accessed by typing @kbd{C-h f bbdb-initialize RET}.}
-
-@subsubheading Initialization symbols for mail and news readers
-
-@table @code
-@item gnus
- Initialize support for Gnus@footnote{If you are using GNUS (not Gnus),
- and if your GNUS version is 3.14 or older, use the @code{Gnus} (note
- the capitalization) symbol.}.  If you pass the @code{gnus} symbol, you should
- probably also pass the @code{message} symbol.
-@item mh-e
- Initialize support for the MH-E mail reader.
-@item rmail
- Initialize support for the RMAIL mail reader.
-@item sendmail
- Initialize support for sendmail (@kbd{M-x mail})
-@item vm
- Initialize support for the VM mail reader.@footnote{For the VM
- initialization to work properly, you must either call
- @code{bbdb-initialize} with the @code{vm} symbol from within your VM
- initialization file (@file{~/.vm}), or you must call
- @code{bbdb-insinuate-vm} manually from within your VM initialization
- file.}
-@end table
-
-@subsubheading Initialization symbols for other packages
-
-@table @code
-@item message
- Initialize support for Message mode (the mail composition program
- included with Gnus).
-@item reportmail
- Initialize support for the Reportmail mail notification package.
-@item sc
- Initialize support for the Supercite message citation package.
- Additional initialization is required for Supercite to work with the
- @b{BBDB}.  @xref{Supercite Prep}.
-@item w3
- Initialize support for Web browsers.
-@end table
-
-@subsubheading Initialization example
-
-To initialize support for Gnus 5.5, Message mode, Supercite, and Web
-browsers, the following forms would be used:
-
-@example
-(require 'bbdb)
-(bbdb-initialize 'gnus 'message 'sc 'w3)
-@end example
-
-@subsubheading Manual initialization
-
-If your initialization needs exceed those provided by
-@code{bbdb-initialize}, refer to the following sections for a
-description of the procedures necessary for enabling @b{BBDB} support
-for the packages listed above.  The procedures described are the same as
-those carried out by the @code{bbdb-initialize} function when passed the
-appropriate symbols.  That is, the procedure listed in the RMAIL Prep
-section below is the same as than executed by @code{bbdb-initialize}
-when the @code{rmail} symbol is passed.
-
-@menu
-Mail and News readers:
-
-* Gnus Prep::           Initializing @b{BBDB} support for Gnus
-* MH-E Prep::           Initializing @b{BBDB} support for MH-E
-* RMAIL Prep::          Initializing @b{BBDB} support for RMAIL
-* Sendmail Prep::       Initializing @b{BBDB} support for Sendmail
-* VM Prep::             Initializing @b{BBDB} support for VM
-
-Other packages:
-
-* Message Prep::        Initializing @b{BBDB} support for Message mode
-* Reportmail Prep::     Initializing @b{BBDB} support for Reportmail
-* Supercite Prep::      Initializing @b{BBDB} support for Supercite
-* Web Browser Prep::    Initializing @b{BBDB} support for Web Browsers
-@end menu
-
-@node Gnus Prep, MH-E Prep, Initial Configuration, Initial Configuration
-@subsubsection Initializing @b{BBDB} support for Gnus
-
-To take advantage of the @b{Gnus} features of the @b{BBDB}, add one of
-the following forms to your Emacs configuration file: @refill
-
-@noindent
-For Gnus 3.14 or older:
-
-@code{(add-hook 'gnus-Startup-hook 'bbdb-insinuate-gnus)}
-
-@noindent
-For Gnus 3.15 or newer:
-
-@code{(add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)}
-
-@code{bbdb-insinuate-gnus} adds bindings for the default keys to
-@b{Gnus} and configures @b{Gnus} to notify the @b{BBDB} when new
-messages are loaded.  This notification is required if the @b{BBDB} is
-to be able to display @b{BBDB} entries for messages displayed in
-@b{Gnus}.
-
-@node MH-E Prep, RMAIL Prep, Gnus Prep, Initial Configuration
-@subsubsection Initializing @b{BBDB} support for MH-E
-
-To take advantage of the @b{MH-E} features of the @b{BBDB}, add the
-following form to your Emacs configuration file: @refill
-
-@example
-(add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)
-@end example
-
-@code{bbdb-insinuate-mh} adds bindings for the default keys to
-@b{MH-E} and configures @b{MH-E} to notify the @b{BBDB} when new
-messages are loaded.  This notification is required if the @b{BBDB} is
-to be able to display @b{BBDB} entries for messages displayed in
-@b{MH-E}.
-
-@node RMAIL Prep, Sendmail Prep, MH-E Prep, Initial Configuration
-@subsubsection Initializing @b{BBDB} support for RMAIL
-
-To take advantage of the @b{RMAIL} features of the @b{BBDB}, add the
-following form to your Emacs configuration file: @refill
-
-@example
-(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)
-@end example
-
-@code{bbdb-insinuate-rmail} adds bindings for the default keys to
-@b{RMAIL} and configures @b{RMAIL} to notify the @b{BBDB} when new
-messages are loaded.  This notification is required if the @b{BBDB} is
-to be able to display @b{BBDB} entries for messages displayed in
-@b{RMAIL}.
-
-@node Sendmail Prep, VM Prep, RMAIL Prep, Initial Configuration
-@subsubsection Initializing @b{BBDB} support for Sendmail
-
-To take advantage of send-mail-mode (the one invoked with @code{M-x
-mail}) features of the @b{BBDB}, add the following form to your Emacs
-configuration file: @refill
-
-@example
-(add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)
-@end example
-
-@code{bbdb-insinuate-sendmail} enables auto-completion in
-send-mail-mode.
-
-@node VM Prep, Message Prep, Sendmail Prep, Initial Configuration
-@subsubsection Initializing @b{BBDB} support for VM
-
-To take advantage of the @b{VM} features of the @b{BBDB}, either add
-@code{'vm} to the parameters of the @code{(bbdb-initialize)} form, or
-add the following form to your @file{~/.vm} file: 
-
-@example
-@code{(bbdb-insinuate-vm)}
-@end example
-
-@code{bbdb-insinuate-vm} adds bindings for the default keys to @b{VM}
-and configures @b{VM} to notify the @b{BBDB} when new messages are
-loaded.  This notification is required if the @b{BBDB} is to be able to
-display @b{BBDB} entries for messages displayed in @b{VM}.
-
-@node Message Prep, Reportmail Prep, VM Prep, Initial Configuration
-@subsubsection Initializing @b{BBDB} support for Message mode
-
-To allow the @b{BBDB} to be used in Message mode, add the following form
-to your Emacs initialization file:
-
-@example
-@code{(bbdb-insinuate-message)}
-@end example
-
-@code{bbdb-insinuate-message} adds a binding for @kbd{M-TAB} to Message
-mode.  This will enable completion of addressees based on @b{BBDB}
-records. See @ref{Using Message Mode} for more details on the operation
-of Message mode @b{BBDB} record completion.
-
-@node Reportmail Prep, Supercite Prep, Message Prep, Initial Configuration
-@subsubsection Initializing @b{BBDB} support for Reportmail
-
-To allow the Reportmail package to report information from @b{BBDB}
-records for new mail, add the following form to your Emacs
-initialization file:
-
-@example
-@code{(bbdb-insinuate-reportmail)}
-@end example
-
-@code{bbdb-insinuate-reportmail} adds to the
-@code{display-time-get-field} function to allow access to @b{BBDB}
-records during new mail information display.  See @ref{Using Reportmail}
-for more details on the operation of Reportmail with the @b{BBDB}.
-
-@node Supercite Prep, Web Browser Prep, Reportmail Prep, Initial Configuration
-@subsubsection Initializing @b{BBDB} support for Supercite
-
-To allow the @b{BBDB} to assist in the storage of Supercite citations,
-add the following form to your Emacs initialization file:
-
-@example
-@code{(bbdb-insinuate-sc)}
-@end example
-
-@code{bbdb-insinuate-sc} adds @b{BBDB} functions to two Supercite hooks
-- @code{sc-post-hook} and @code{sc-attribs-postselect-hook}.  See
-@ref{Using Supercite} for more details on the operation of Supercite
-citation management using the @b{BBDB}.
-
-Three other Supercite variables must be set/modified to allow the
-@b{BBDB} to work with it.  These variables are not automatically set as
-it would be impossible to reliably set them without interfering with
-other user customizations.  The modifications are:
-
-@table @code
-@item sc-preferred-attribution-list
-@code{"sc-consult"} should be added to the list.  An example
-configuration is:
-
-@example
-(setq sc-preferred-attribution-list
-  '("sc-lastchoice" "x-attribution" "sc-consult"
-    "initials" "firstname" "lastname"))
-@end example
-
-@item sc-attrib-selection-list
-The following form should be added to @code{sc-attrib-selection-list}:
-
-@example
-      '(("sc-from-address"
-	 ((".*" . (bbdb/sc-consult-attr
-		   (sc-mail-field "sc-from-address"))))))
-@end example
-
-@item sc-mail-glom-frame
-The following form should be added to @code{sc-mail-glom-frame}, to
-allow the retrieval of the name of a person who is a) in the @b{BBDB}
-and b) has only included their net address in the message in question.
-
-@example
-  ("^$"  (progn (bbdb/sc-default)
-            (list 'abort '(step . 0))))
-@end example
-
-An example configuration is as follows:
-
-@example
-@exdent @code{(setq sc-mail-glom-frame}
-@exdent @code{   '((begin                        (setq sc-mail-headers-start (point)))}
-@exdent @code{     ("^x-attribution:[ \t]+.*$"   (sc-mail-fetch-field t) nil t)}
-@exdent @code{     ("^\\S +:.*$"                 (sc-mail-fetch-field) nil t)}
-@exdent @code{     ("^$"                         (progn (bbdb/sc-default)}
-@exdent @code{                                   (list 'abort '(step . 0))))}
-@exdent @code{     ("^[ \t]+"                    (sc-mail-append-field))}
-@exdent @code{     (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))}
-@exdent @code{     (end                          (setq sc-mail-headers-end (point)))))}
-@end example
-@end table
-
-The above is also documented in @file{bbdb-sc.el}.  The
-@code{bbdb/sc-setup-variables} function has been provided as an example for
-Supercite variable initialization.  Please note that while
-@code{bbdb/sc-setup-variables} makes every attempt to safely configure
-the Supercite variables, it will not always work.  Specifically, the
-variables @code{sc-attrib-selection-list} and @code{sc-mail-glom-frame}
-will not be overridden if they have already been defined.
-
-@node Web Browser Prep,  , Supercite Prep, Initial Configuration
-@subsubsection Initializing @b{BBDB} support for Web Browsers
-
-To allow URLs to be added to @b{BBDB} records, add the following form to
-your Emacs initialization file:
-
-@example
-@code{(bbdb-insinuate-w3)}
-@end example
-
-@code{bbdb-insinuate-w3} adds the definition of @kbd{:} to the W3
-keymap.
-
-The other @code{bbdb-w3} functions, specifically the passing of URLs
-from @b{BBDB} records to Web browsers, do not require initialization
-within the @b{BBDB}.  They do, however, require the configuration of the
-@code{browse-url} package so it knows to which Web browser URLs are to
-be passed.  For more details on the operation of @code{bbdb-w3}, see
-@ref{Using Web Browsers}.
-
-@node The BBDB, BBDB Mode, Installation, Top
-@section The @b{BBDB}
-
-This section discusses the basics of the @b{BBDB} - an overview of the
-database's layout, and a discussion of the basic @b{BBDB} manipulation
-commands.
-
-The database itself lives in a file which is named by the variable
-@code{bbdb-file}.  If this variable is not set, the database is assumed
-to be in @file{~/.bbdb}.
-
-@menu
-* Database Fields::             Description of database fields
-* Basic Searching::             Basic database searching commands
-* Advanced Searching::          Advanced database searching commands
-* Manual Record Addition::      Adding records by hand
-@end menu
-
-@node Database Fields, Basic Searching, The BBDB, The BBDB
-@subsection Database Fields
-
-The database is organized as a set of records, where each record
-corresponds to one person or organization.  Each record has several
-fields, and each field is of one of several types.  Below, the built-in
-types are listed, followed by a description of how and why some types
-can be used more than once in a single record: @refill
-@cindex Builtin field types
-
-@multitable @columnfractions .1 .5 .4
-@item Type
-@tab Description
-@tab Notes
-
-@item @code{name}
-@tab The name of this person, or none if the record corresponds to an
-organization.
-@tab Single value, single instance.
-
-@item @code{company}
-@tab The name of this person's organization, or none.
-@tab Single value, single instance.
-
-@item @code{AKA}
-@tab A list of other names for this person.
-@tab Multiple values through commas.
-
-@item @code{net}
-@tab A list of this person's network addresses.
-@tab Multiple values through commas.
-
-@item @code{address}
-@tab A list of postal (physical) addresses for this person.
-@tab Multiple values through multiple occurences.
-
-@item @code{phone}
-@tab A list of telephone numbers for this person.
-@tab Multiple values through multiple occurences.
-
-@item @code{notes}
-@tab Random commentary.
-@tab Multiple values through multiple occurences.
-
-@end multitable
-
-The field types listed above can be classified into four categories, as
-indicated by the comments in the `Notes' column.
-
-Field types marked as "Single value, single occurrence" may only occur
-once per record.  Each occurrence can only have a single value.  For
-example, there will be only one field of type @code{name} in a record.
-It will be named @code{name}, and will contain a single value (the
-person's name).
-
-The types marked as "Multiple values through commas" are essentially the
-same as the single value, single occurrence field types, but with one
-crucial difference: they can contain multiple values in the form of a
-comma-separated list.  So, for example, while a @code{name} field with a
-value of "foo, bar" would be treated as if it contained the single value
-"foo, bar", a @code{net} field with the same data would be thought of as
-having two separate values - "foo" and "bar".  As in the single
-occurrence, single value field types, there will be only one occurrence
-of each "Multiple values through commas" field type, and the occurrence
-will have the same name as the type.
-
-The "Multiple values through multiple occurrences" field type is the
-most flexible of the four listed here.  There can be multiple
-occurrences of each type.  This type necessarily does not have the name
-restriction imposed by the previous two types.  For example, there can
-be multiple fields of the @code{address} type, none of which have to be
-named @code{address}.  One could be named @code{home}, and the other
-could be named @code{work}.
-
-Special properties of the @code{notes} field type: All user-defined
-fields that don't fit into the other predefined field types
-(@code{name}, @code{company}, @code{AKA}, @code{net}, @code{address},
-and @code{phone}) will be created as a @code{notes}-type field.  In
-addition, several of the user-defined field names are "special".  That
-is, the @b{BBDB} treats the values of these "special" fields differently
-than it does other user-defined fields.  The "special" fields are:
-
-@cindex Special Field Names
-@table @code
-@item attribution
-@vindex bbdb/sc-attribution-field
-@i{(Available only when the Supercite-specific @b{BBDB} functions have been
-enabled)} Used for the storage of Supercite attributions.  For initialization
-details, see @ref{Supercite Prep}.  For usage details, see @ref{Using
-Supercite}.  The field used can be changed by changing the value of
-@code{bbdb/sc-attribution-field}.
-@item aka
-Used to store non-primary names associated with a given record.
-@item face
-@i{(XEmacs only)} Used for the storage of image data.  This data is to be
-in the format output by @code{compface}, and commonly found in
-@code{X-Face:} headers in messages.  If face support has been compiled
-into XEmacs, the image contained in the @code{face} header will be
-displayed when the record is viewed.
-@item finger-host
-@vindex bbdb-finger-host-field
-Address used in place of the listed net address for fingering the entity
-indicated by the record. @xref{BBDB Mode}.  The field used can be changed by
-changing the value of @code{bbdb-finger-host-field}.
-@item gnus-score
-@vindex bbdb/gnus-score-field
-@b{Gnus} scoring adjustment for this person.  For initialization details, see
-@ref{Gnus Prep}.  For usage details, see @ref{Gnus Features}. The field used
-can be changed by changing the value of @code{bbdb/gnus-score-field}.
-@item mail-alias
-@cindex mail-alias definition
-Value used instead of @code{name} for completion.  @xref{Mail Sending
-Interfaces}.
-@item mail-name
-@i{(Available only when the Reportmail-specific @b{BBDB} functions have been
-enabled)}  Used for the storage of non-default names to be used in the
-reporting of new mail by Reportmail.  For initialization details,
-see @ref{Reportmail Prep}.  For usage details, see @ref{Using Reportmail}.
-@item mark-char
-The field containing the character to be used for marking a given poster
-in the Gnus Summary Buffer.  For usage details, see @ref{Gnus Summary Buffer}.
-@item tex-name
-@cindex Printing records in the database
-@findex bbdb-print
-The value of this field is used in place of the @code{name} field when
-printing the database using @code{bbdb-print}.  @xref{bbdb-print}.
-@item www
-This field contains the URL associated with the @b{BBDB} record.  Common uses
-are with @code{bbdb-snarf} (@pxref{bbdb-snarf}) and the @b{BBDB}/Web Browser
-functionality (for initialization details, see @ref{Web Browser Prep}.  For
-usage details, see @ref{Using Web Browsers}).
-@end table
-
-@node Basic Searching, Advanced Searching, Database Fields, The BBDB
-@subsection Basic searching commands
-
-You can list the contents of the database with the command
-@w{@kbd{M-x bbdb}}.  You will be prompted for a regular expression, and all
-records which match that regexp in the name, company, network address,
-or any notes fields will be displayed.@refill
-@cindex Searching the database
-@findex bbdb
-@findex bbdb-name
-@findex bbdb-company
-@findex bbdb-net
-@findex bbdb-notes
-
-A narrower search may be made by using the commands @kbd{bbdb-name},
-@kbd{bbdb-company,} @kbd{bbdb-net,} or @kbd{bbdb-notes}.  These commands
-limit their searches to the name, company, email address, and notes
-fields, respectively.  If these commands are given a prefix argument,
-the listing displayed will be one line per entry; otherwise, the full
-database entry will be shown on multiple lines.
-
-The functions described above are predefined to certain keys in the
-@code{*BBDB*} buffer.  @xref{BBDB Mode}. for more details.
-
-@cindex User-defined fields
-The @code{bbdb-notes} command will prompt for the notes field to search
-(@kbd{RET} for all).  In this way you can limit your searches to the
-contents of one particular user-defined notes field.  (You can add
-user-defined fields with the @code{bbdb-insert-new-field} command;
-@xref{BBDB Mode}.)@refill
-
-@cindex Elided display
-@cindex One-line display
-
-@node Advanced Searching, Manual Record Addition, Basic Searching, The BBDB
-@subsection Advanced searching commands
-
-The following functions can be used to search for records based on
-creation and/or modification dates.  These functions will match records
-that have @code{timestamp} and/or @code{creation-date} fields (as
-appropriate.  @xref{Predefined Hooks}. for more information on these
-fields, which are created by default.
-
-@table @code
-@findex bbdb-timestamp-older
-@item bbdb-timestamp-older
-Display all records modified before a given date.  If this function is
-called interactively, it will prompt for a date.  If it is being called
-non-interactively, the date should be provided as a string in
-@samp{yyyy-mm-dd} format.
-
-@findex bbdb-timestamp-newer
-@item bbdb-timestamp-newer
-Display all records modified after a given date.  If this function is
-called interactively, it will prompt for a date.  If it is being called
-non-interactively, the date should be provided as a string in
-@samp{yyyy-mm-dd} format.
-
-@findex bbdb-creation-older
-@item bbdb-creation-older
-Display all records created before a given date.  If this function is
-called interactively, it will prompt for a date.  If it is being called
-non-interactively, the date should be provided as a string in
-@samp{yyyy-mm-dd} format.
-
-@findex bbdb-creation-newer
-@item bbdb-creation-newer
-Display all records created after a given date.  If this function is
-called interactively, it will prompt for a date.  If it is being called
-non-interactively, the date should be provided as a string in
-@samp{yyyy-mm-dd} format.
-
-@findex bbdb-creation-no-change
-@item bbdb-creation-no-change
-Display all records that have not been changed since creation.
-@end table
-
-@node Manual Record Addition,  , Advanced Searching, The BBDB
-@subsection Manual record addition
-
-There are several ways to add new entries to the Insidious Big Brother
-Database; the most straightforward is to use @w{@kbd{M-x bbdb-create}},
-which will prompt you for all relevant information.  However, the
-easiest way is to allow them to be added automatically by one of the
-mail or news-reading interfaces (@xref{Interfaces}.). @refill
-
-@cindex Creating new records
-@cindex Adding new records
-
-There is als @w{@kbd{bbdb-snarf}} (@xref{bbdb-snarf}), which will
-attempt to create a record from a text block. Note that this depends
-on particular formatting and may not do exactly what you want.
-
-@node BBDB Mode, Interfaces, The BBDB, Top
-@section BBDB Mode
-
-@subsection Functions bound to keys in @b{BBDB} Mode
-
-When the @samp{*BBDB*} buffer is active (either summoned by one of the
-commands in the previous section [@xref{The BBDB}.] or by your mail
-or news program), a variety of commands become available for database
-manipulation.  Some of the commands listed below take numeric arguments.
-These arguments can be generated by entering the number before pressing
-the key(s) corresponding to the desired command.  The output (if any) of
-the listed commands will be displayed in the @samp{*BBDB*} buffer, and
-can be navigated through using the usual cursor motion commands.
-@cindex BBDB Mode
-@cindex *BBDB* buffer
-
-@table @kbd
-@item e
-@findex bbdb-edit-current-field
-@cindex Editing fields
-@cindex Changing fields
-(@code{bbdb-edit-current-field})  Edit the field on the current line.  If
-the cursor is in the middle of a multi-line field, such as an address or
-comments section, then the entire field is edited, not just the current
-line. @refill
-
-@item ;
-@findex bbdb-edit-notes
-(@code{bbdb-edit-notes})  A shortcut for editing the @var{notes} field. @refill
-
-@item d, C-k
-@findex bbdb-delete-current-field-or-record
-@cindex Deleting fields
-@cindex Removing fields
-(@code{bbdb-delete-current-field-or-record}) Delete the field on the
-current line.  If the current line is the first line of a record, the
-@b{BBDB} will, after prompting the user, delete the entire record from
-the database.  This may also be applied to multiple records at once by
-@kbd{*}.
-
-@item C-o
-@findex bbdb-insert-new-field
-@cindex Adding new fields
-@cindex Inserting new fields
-@cindex User-defined fields
-(@code{bbdb-insert-new-field}) Inserts a new field into the current
-record.  You are prompted (with completion) for the type of field to
-insert (@b{phone}, @b{address}, @b{notes}, etc); if the string you type
-is not a known field type, you will be asked whether to add a new field
-with the entered name of type @code{notes}.
-
-@cindex Phone numbers
-@cindex North American phone numbers
-@cindex European phone numbers
-If you are inserting a new phone-number field, you can control whether
-it is a North American or European phone number by providing a prefix
-argument.  A prefix arg of @kbd{^U} means it's to be a euronumber, and
-any other prefix arg means it's to be a a structured North American
-number.  If no prefix argument is supplied, the style used is controlled
-by the variable @code{bbdb-north-american-phone-numbers-p}. @refill
-
-@item C-x C-t
-@findex bbdb-transpose-fields
-@cindex Reordering fields
-@cindex Transposing fields
-(@code{bbdb-transpose-fields}) This is like the @code{transpose-lines}
-command, but it is for @b{BBDB} fields.  If the cursor is on a field of
-a @b{BBDB} record, that field and the previous field will be
-transposed.@refill
-
-With non-zero numeric argument @var{ARG}, the previous field is moved
-past @var{ARG} fields.  With argument 0, the field indicated by
-@i{point} is interchanged with the one indicated by @i{mark}.
-
-Both fields must be in the same record, and must be of the same basic type
-(that is, you can use this command to change the order in which phone-number
-fields are listed, but you can't use it to make an address appear before a
-phone number; the order of field types is fixed.)@refill
-
-@item n, p
-@findex bbdb-next-record
-@findex bbdb-prev-record
-(@code{bbdb-next-record}, @code{bbdb-prev-record})  Move to the next and
-previous displayed record, respectively. @refill
-
-@item t
-@findex bbdb-toggle-records-display-layout
-(@code{bbdb-toggle-records-display-layout}) Toggles the display layout of a
-record.  With a numeric argument
-of 0, the current record will be made displayed in one line layout; with any
-other argument, the current record will be shown in multi-line layout. @refill
-
-If @kbd{*t} is used instead of simply @kbd{t}, then the state of all
-records will be changed instead of just the one at point.  In this case,
-a numeric argument of 0 means that all records will unconditionally be
-made one-line layout; any other numeric argument means that all of the records
-will unconditionally be shown expanded; and no numeric argument means
-that the records are made to be in the opposite state of the record
-under point. @refill
-
-@item T
-@findex bbdb-display-record-completely
-(@code{bbdb-display-record-completely})
-Show all the fields of the current record.
-The display layout `full-multi-line' is used for this.
-@refill
-
-@item o
-@findex bbdb-omit-record
-(@code{bbdb-omit-record}) Removes the current record from the display,
-but does not delete it from the database; it merely makes it seem as if
-the most recent search had not matched this record.  With a numeric
-argument, omit the next N records.  With a negative argument, go
-backwards. @refill
-
-@item m
-@findex bbdb-send-mail
-@cindex Sending mail
-@vindex bbdb-send-mail-style
-(@code{bbdb-send-mail}) Begin composing mail to the person represented
-by the current record.  The first email address is used.  Normally, the
-mail-sending package which is used is determined by which mail-reading
-package is loaded; that is, if @b{MH-E} is loaded, then @code{mh-send}
-will be used; if @b{VM} is loaded, then @code{vm-mail} is used; if
-@b{message} is loaded, then it is used; otherwise, @code{mail} is used.
-You can override this by setting the variable
-@code{bbdb-send-mail-style} to one of the symbols @code{vm}, @code{mh},
-@code{message}, or @code{mail}. @refill
-
-If @kbd{*m} is used instead of simply @kbd{m}, then mail will be sent to
-all of the folks listed in the @samp{*BBDB*} buffer instead of just the
-person under point. @refill
-
-This function does not at present use the facility provided by
-@code{compose-mail} and @code{mail-user-agent}.  In a future version of
-the @b{BBDB}, it will.
-
-@item s, C-x C-s
-@findex bbdb-save-db
-@cindex Saving your changes
-(@code{bbdb-save-db})  Saves the @b{BBDB} file to disk.
-
-@item r
-@findex bbdb-refile-record
-@cindex Fixing mistakes
-@cindex Merging records
-(@code{bbdb-refile-record})  Merge the current record into some other record;
-that is, delete the record under point after copying all of the data
-within it into some other record.  this is useful if you realize that
-somehow a redundant record has gotten into the database, and you want to
-merge it with another. @refill
-
-If both records have names and/or companies, you are asked which to use.
-Phone numbers, addresses, and network addresses are simply concatenated.
-The first record is the record under the point; the second is prompted
-for.  Completion behavior is as dictated by the variable
-@code{bbdb-completion-type}. @refill
-
-@item M-d
-@findex bbdb-dial
-@cindex Dialling phone numbers
-(@code{bbdb-dial})  This command will attempt to dial the phone number
-currently at point, or if point is at the start of a record, the first
-phone number in the record.  An extension, if present, is disregarded.
-@refill
-
-The method of dialling is controlled by @code{bbdb-modem-dial}. If this
-variable is nil, the @b{BBDB} will play touchtones corresponding to the
-number to be dialled.  Otherwise, this variable is treated as a modem
-command string to be prepended to the number prior to feeding it to
-@code{bbdb-modem-device}. @refill
-
-The @b{BBDB} plays touchtones using @code{bbdb-sound-player} to play the
-sounds and the elements of @code{bbdb-sound-files} as the audio to be
-played.  The first ten elements of @code{bbdb-sound-files} correspond to
-the touchtones for the digits @samp{0} to @samp{9}, while the eleventh
-and twelfth elements correspond to @samp{#} and @samp{*}
-respectively. The default configuration assumes a Solaris[tm]
-installation with the demonstration sound files in
-@code{/usr/demo/SOUND/sounds}. @refill
-
-The actual number dialled depends on the following variables:
-
-@table @code
-@item bbdb-dial-local-prefix-alist 
-@vindex bbdb-dial-local-prefix-alist
-This is a list of (SEXPR REPLACEMENT) pairs.  SEXPR is evaluated to
-produce a regular expression which is then applied to the number. If it
-matches, whatever it matches is replaced by REPLACEMENT.  The match and
-replace is performed using each item in the list that matches, in
-sequence, so that the output from one item may become input to another.
-The default value for this variable is to remove
-@code{(bbdb-default-area-code)} (i.e. the value of that variable, in
-parenthesis) from the start of the number to be dialled.@refill
-
-@b{Note:} If this procedure produces a transformed number then no
-further modifications (such as prefix additions, below) will be made to
-the number before dialling.@refill
-
-Using a prefix argument to @code{bbdb-dial} disables the processing of
-this variable. The other modifiers, below, are not affected by
-this.@refill
-
-@item bbdb-dial-local-prefix
-@vindex bbdb-dial-local-prefix
-If the number to be dialled starts with a zero, it is deemed to be a
-local number, and @code{bbdb-dial-local-prefix} is prepended to it (see
-note above concerning @code{bbdb-dial-local-prefix-alist} processing,
-however).@refill
-
-@item bbdb-dial-long-distance-prefix
-@vindex bbdb-dial-long-distance-prefix
-If the number to be dialled starts with a plus sign (+), it is deemed to
-be a long distance number, and @code{bbdb-dial-long-distance-prefix} is
-prepended to it (see note above concerning
-@code{bbdb-dial-local-prefix-alist} processing, however).@refill
-
-@end table
-
-@item f
-@findex bbdb-finger
-@cindex Finger interface
-(@code{bbdb-finger})  This command fingers the network address of a
-@b{BBDB} record.  If this command is executed from the @samp{*BBDB*} buffer,
-it fingers the network address of the record which is at point; otherwise,
-it prompts in the minibuffer (with completion) for a user to finger.  With a
-numeric prefix argument, it fingers the @i{N}th network address of the
-current record; with a prefix argument of @kbd{^U}, it fingers all of them.
-The @samp{*finger*} buffer is filled asynchronously, meaning that you don't
-have to wait around for it to finish; but fingering another user before
-the first finger has finished could have unpredictable results.@refill
-
-If this command is executed from the @samp{*BBDB*} buffer, it may be prefixed
-with @kbd{*} (as in @kbd{*f} instead of simply @kbd{f}), meaning to
-finger all of the users currently listed instead of just the one under
-point.  The numeric prefix argument has the same interpretation. @refill
-
-@vindex bbdb-finger-host-field
-You can define a special network address to ``finger'' by defining a field
-@code{finger-host}.  The name of the field to be fingered can be changed
-by setting @code{bbdb-finger-host-field}.
-
-@item q
-@findex bbdb-bury-buffer
-(@code{bbdb-bury-buffer})  Hides the @samp{*BBDB*} buffer.  @b{Note:}
-This command does @b{not} kill the @samp{*BBDB*} buffer.
-
-@item ?
-@findex bbdb-help
-(@code{bbdb-help})  This displays a one-line help message in the
-minibuffer, showing some of the most common bbdb-mode commands.
-
-@item i
-@findex bbdb-info
-(@code{bbdb-info})  This documentation is displayed.  Please note that
-either @file{bbdb} or @file{bbdb.info} must be installed in one of the
-info directories known to Emacs for this command to work.
-
-@table @code
-@item bbdb-info-file
-@vindex bbdb-info-file
-If this documentation is not installed in the standard Info directory,
-then you should set this variable to the name of the texinfo-formatted
-version of this file; the @code{bbdb-info} command will use this file
-instead.@refill
-@end table
-
-@item W
-@cindex Browsing the Web page for the current record
-@findex bbdb-www
-(@code{bbdb-www})  Displays the Web page listed in the @code{www} field
-of the current record.  @xref{Using Web Browsers}.
-
-@item P
-@cindex Printing records in the database
-@findex bbdb-print
-(@code{bbdb-print})  Creates a TeX file that contains a pretty-printed version
-of @b{BBDB} records.  If prefixed by @kbd{*}, only the records currently
-displayed will print.  @xref{bbdb-print}.
-
-@item h
-@cindex Changing windows
-Moves point to another window via the @code{other-window} function.
-
-@item c
-@cindex Creating new records
-@findex bbdb-create
-(@code{bbdb-create})  Create a new database record from information
-supplied by the user.
-
-@item C
-@cindex Displaying changed records
-@findex bbdb-changed
-(@code{bbdb-changed})  Display all records that have been changed since
-the last time the database was saved.
-
-@item b
-@cindex Searching the database
-@findex bbdb
-(@code{bbdb})  Begin a new database search.  The results of the new
-search will be displayed in place of the results of the old search.
-
-@item S a, S c, S o, S n
-@cindex Searching the database
-@findex bbdb-net
-@findex bbdb-company
-@findex bbdb-notes
-@findex bbdb-name
-(@code{bbdb-net}, @code{bbdb-company}, @code{bbdb-notes},
-@code{bbdb-name})@*
-Begin a new database search.  This search will be
-limited to the net address, company, notes, or name fields,
-respectively, of database records.  @xref{Basic Searching}. for more
-details.
-
-@item *
-@findex bbdb-append-records
-@code{bbdb-append-records} will make the next display/search
-command to append its results to the BBDB buffer instead of replacing its
-content. 
-
-With an prefix arg (C-u) toggle between always append and no append.
-With an prefix arg that is a positive number append will be enabled for that
-many times.
-With any other argument append will be enabled once."@refill
-
-@end table
-
-@subsection Other database manipulation functions
-
-@table @code
-@findex bbdb-kill-older
-@item bbdb-kill-older
-If called interactively (or with a single argument - a date in
-@samp{yyyy-mm-dd} format), it will kill all records that were last
-modified before the given date as determined by the @code{timestamp}
-field.  @xref{Predefined Hooks}.  If called non-interactively with a
-date (in @samp{yyyy-mm-dd} format), a comparison function and an action
-function, the comparison function is applied to the @code{timestamp}
-field of all records, and the action function applied to those for whom
-the comparison function returns true.  If @samp{nil} is supplied as the
-comparison function, @code{string-lessp} is used.
-
-@end table
-
-@node Interfaces, Reader-specific Features, BBDB Mode, Top
-@section Interfaces
-
-The @b{BBDB} interfaces itself with several message-handling packages, but
-certain parameters control its behavior depending on whether it is
-being used from within a mail reader or a news reader. @refill
-
-In all of these packages, two new keybindings will be added:
-
-@table @kbd
-@item :
-@cindex Showing the sender of the current message
-@findex bbdb/vm-show-sender
-@findex bbdb/rmail-show-sender
-@findex bbdb/mh-show-sender
-@findex bbdb/gnus-show-sender
-(@code{bbdb/@i{package}-show-sender}) Displays the @b{BBDB} entry corresponding
-to the author of the current message.  If there is none, you will be
-asked whether to create one.  The function called is
-@code{bbdb/@i{package}-show-sender}, where @code{@i{package}} is either
-@code{gnus}, @code{mh}, @code{rmail}, or @code{vm}, depending on the
-mail or news program being used when the command is invoked.
-
-@item ;
-@cindex Annotating the sender of the current message
-@findex bbdb/vm-annotate-sender
-@findex bbdb/rmail-annotate-sender
-@findex bbdb/mh-annotate-sender
-@findex bbdb/gnus-annotate-sender
-(@code{bbdb/@i{package}-annotate-sender}) Lets you edit the @samp{notes}
-field of the @b{BBDB} record corresponding to the sender of the current
-message.  If there is no record for the current author, you will be
-asked whether to create one.  The function called is
-@code{bbdb/@i{package}-annotate-sender}, where @code{@i{package}} is
-either @code{gnus}, @code{mh}, @code{rmail}, or @code{vm}, depending on
-the mail or news program being used when the command is invoked.
-@end table
-
-These keybindings (and several other features) will not be
-available unless you call the appropriate ``insinuation''
-function; @xref{Installation}.@refill
-
-It is possible to configure @b{BBDB} so that it automatically creates a
-record when it sees a message from a person who is not in the database.
-It is also possible to have text automatically added to the notes field
-of the corresponding record depending on the contents of the message
-headers.  @xref{Customization Hooks}.@refill
-
-@menu
-* Mail Reading Interfaces::		Mail Reading Interfaces
-* News Reading Interfaces::		News Reading Interfaces
-* Mail Sending Interfaces::		Mail Sending Interfaces
-@end menu
-
-@node Mail Reading Interfaces, News Reading Interfaces, Interfaces, Interfaces
-@subsection Mail Reading Interfaces
-
-There are BBDB interfaces for the following mail readers:
-
-@itemize @bullet
-@item
-@b{Gnus}, a news- and email- reader written by Lars Magne Ingebrigtsen
-(based on @b{GNUS} by Mansanobu Umeda).
-@item
-@b{MH-E}, the Emacs interface to @b{Mail Handler} (@b{MH}), from the
-standard emacs library, but packaged separately from XEmacs since
-version 20.4.@refill
-@item
-@b{RMAIL}, from the standard emacs library (packaged separately for
-XEmacs users as of 20.4);
-@item
-@b{View Mail}, by Kyle Jones, version 5.31 or newer;
-@end itemize
-
-@node News Reading Interfaces, Mail Sending Interfaces, Mail Reading Interfaces, Interfaces
-@subsection News Reading Interfaces
-
-There are BBDB interfaces for the following news readers:
-
-@itemize @bullet
-@item
-@b{GNUS}, a newsreader written by Masanobu Umeda. @refill
-@item
-@b{Gnus}, the modern news- and email-reading incarnation of @b{GNUS}.
-@b{Gnus} is written by Lars Magne Ingebrigtsen.@refill
-@end itemize
-
-@node Mail Sending Interfaces,  , News Reading Interfaces, Interfaces
-@subsection Mail Sending Interfaces
-
-@findex bbdb-complete-name
-@vindex bbdb-dwim-net-address-allow-redundancy
-@cindex Name completion
-@cindex Mail address completion
-@cindex Address completion
-@cindex Format of completed address
-When sending mail, the keystroke @kbd{M-TAB} is bound to the
-function @code{bbdb-complete-name}.  This will take the string that
-you have typed (from point back to the preceding colon, comma, or
-the beginning of the line) and will complete that against the
-contents of the database.  What you have typed may be an initial
-subsequence of a person's full name or network address; if it
-completes ambiguously, then what you have typed will be replaced
-with the common portion of the matches.  Typing @kbd{M-TAB} again will
-show a list of possible completions.  If it completes unambiguously,
-then an address will be inserted.  The variable
-@code{bbdb-completion-type} controls whether completion is done on real
-names, or network addresses, or both. The address inserted is normally
-of the form @w{@code{User Name }}; however, if
-@code{User Name} has an address of the form
-@code{}, only the @code{} portion
-is inserted. This can be overridden by setting
-@code{bbdb-dwim-net-address-allow-redundancy} to @code{t}. @refill
-
-This binding is automatically set by the various insinuation functions
-documented earlier in this manual.  (@xref{Initial Configuration}.)
-Briefly, the forms for these functions are:
-
-@table @b
-@item Gnus
-@code{(add-hook 'gnus-Startup-hook 'bbdb-insinuate-gnus)} @i{for Gnus 3.14 or older}@*
-@code{(add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)} @i{for Gnus 3.15 or newer}
-@item MH-E
-@code{(add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)}
-@item RMAIL
-@code{(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)}
-@item sendmail
-@code{(add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)}
-@item VM
-@code{(bbdb-insinuate-vm)} @i{Add to @file{~/.vm} file}
-@end table
-
-@noindent
-The above forms should be added to your Emacs initialization file,
-except where otherwise noted.
-
-You can control what ``real name'' is inserted with the
-@code{mail-alias} field: if a record has a @code{mail-alias}
-field, then that is used instead of their @code{name} field.
-
-@vindex bbdb-completion-display-record
-If the variable @code{bbdb-completion-display-record} is true (the
-default) then when you successfully complete an address with
-@kbd{M-TAB}, the corresponding record will be appended to
-the @samp{*BBDB*} buffer.  The buffer will not be displayed if it
-is not already visible, but the record will be displayed there.
-
-@findex bbdb-yank-addresses
-@cindex Sending mail
-When sending mail, you can use the command @code{bbdb-yank-addresses}
-to CC the current message to the people currently displayed in
-the @samp{*BBDB*} buffer.  This is useful if you are in the midst of
-sending or replying to a message, and you decide to add some recipients.
-You can use one of the @kbd{M-x bbdb} commands to display the set of
-people that you want to CC the message to, and then execute this command
-to add them to the list.
-
-@unnumberedsubsec Mailing Lists and Mail Aliases
-
-@cindex Mailing lists
-@cindex Mail Aliases
-@cindex mail-alias usage
-@findex bbdb-define-all-aliases
-@findex bbdb-add-or-remove-mail-alias
-@findex define-mail-alias
-
-If you are using Jamie Zawinski's @file{mail-abbrevs.el} package, which
-uses the word-abbrev mechanism for mail aliases, then you can store your
-mail aliases in the BBDB instead of duplicating the information
-elsewhere.@refill
-
-If you want a mail alias to be defined for a person, simply add a
-@code{mail-alias} field to their record.  You may have multiple aliases
-for the same person; simply separate them with commas.@refill
-
-For convenience there is the function @code{bbdb-add-or-remove-mail-alias}
-bound to @kbd{a} which adds an alias to one or multiple records when prefixed
-by a @kbd{*}.  Called with a prefix argument @kbd{C-u} it will remove
-the given alias.@refill
-
-If more than one person has the same mail-alias, then that alias expands
-to the addresses of all of those people; in this way you can maintain
-mailing lists within the BBDB.@refill
-
-When you want to group aliases as in @code{.mailrc} you may just
-retained the group aliases in your @code{.mailrc}.
-
-To actually define the aliases which are stored in the BBDB, call the
-function @code{bbdb-define-all-aliases} from your
-@code{mail-setup-hook} (or @code{message-setup-hook} if you use
-Message mode coming with Gnus).  This will search the database, and
-call @code{define-mail-alias} to define each of the resulting
-aliases.@refill
-
-@node Reader-specific Features, Other Packages, Interfaces, Top
-@section Reader-specific Features
-
-There are features of the @b{BBDB} that are available only for specific
-mail- and news-readers.  These features are described below.
-
-The headers which are parsed for email addresses and what records are
-displayed can be controlled by the following variables:
-@vindex bbdb-get-addresses-from-headers
-@vindex bbdb-get-addresses-to-headers
-@vindex bbdb-get-addresses-headers
-@vindex bbdb-get-only-first-address-p
-@code{bbdb-get-addresses-from-headers} controls which headers are parsed
-for sender addresses when calling the show-sender function of your MUA.
-@code{bbdb-get-addresses-to-headers} controls which headers are parsed
-for recipients addresses when calling the show-all-recipients function
-of your MUA.  When using the pop up feature it will search for the
-addresses in @code{bbdb-get-addresses-headers} and display them.  By
-default it will list only the first address, but by setting
-@code{bbdb-get-only-first-address-p} to @code{nil} one will will get
-records for all addresses.
-
-If there is no MUA specific variable for ignoring certain addresses then
-those addresses matching @code{bbdb-user-mail-names} will be ignored.
-
-@b{BBDB} adds the bindings @kbd{:} for showing all senders and @kbd{;}
-for editing the notes of the sender.
-
-@menu
-* Gnus Features::                       Gnus-specific Features
-* VM Features::                         VM-specific Features
-@end menu
-
-@node Gnus Features, VM Features, Reader-specific Features, Reader-specific Features
-@subsection Gnus-specific Features
-
-The @b{BBDB} can be used to provide score information, or to integrate
-database information into the @b{Gnus} Summary buffer or the @b{GNUS}
-Subject List.
-
-@menu
-* Gnus Scoring::                        Store score adjustments in the @b{BBDB}
-* Gnus Summary Buffer::                 @b{BBDB} information in the Summary buffer
-* GNUS Subject List::                   @b{BBDB} information in the Subject List
-@end menu
-
-@node Gnus Scoring, Gnus Summary Buffer, Gnus Features, Gnus Features
-@subsubsection Scoring
-@vindex bbdb/gnus-score-field
-@vindex bbdb/gnus-score-default
-@vindex gnus-score-find-score-files-function
-
-The @b{BBDB} can provide scoring information to @b{Gnus} in one of two
-ways.
-
-@enumerate
-@item
-Articles whose authors appear in the @b{BBDB} and who have
-@code{gnus-score} fields will have their scores adjusted by the value
-contained in that field.
-@item
-Articles whose authors appear in the @b{BBDB} but who do not have
-@code{gnus-score} fields will have their scores adjusted by
-@code{bbdb/gnus-score-default}.  If @code{bbdb/gnus-score-default} is
-@code{nil}, no score adjustment will be made.
-@end enumerate
-
-The @b{BBDB} by default searches the field contained in
-@code{bbdb/gnus-score-field} for score values.  To have the @b{BBDB} use
-a different field, change the value of this variable.
-
-To enable @b{BBDB}-assisted scoring, add the @code{bbdb/gnus-score}
-function to @code{gnus-score-find-score-files-function}.  Assuming that
-you want to preserve the default value of this variable, use a form
-similar to the following:
-
-@example
-(setq gnus-score-find-score-files-function
-      '(gnus-score-find-bnews bbdb/gnus-score))
-@end example
-
-@b{Note:} The default value in @b{Gnus} 5.5 is @code{gnus-score-find-bnews}.
-Check your configuration before using the above code, as your values may
-be different.
-
-@node Gnus Summary Buffer, GNUS Subject List, Gnus Scoring, Gnus Features
-@subsubsection Gnus Summary Buffer Enhancements
-
-@b{Gnus} can use the @b{BBDB} to do one of two things:
-
-@itemize @bullet
-@item
-Mark authors in the Summary Buffer who have records in the @b{BBDB} with
-a user-defined mark character.  See Marking Posters, below.
-@item
-For authors in the Summary Buffer who also have records in the @b{BBDB},
-replace their name as listed in the Summary Buffer with their name as
-stored in the @b{BBDB}.  See Using Names from the @b{BBDB}, below.
-@end itemize
-
-@subsubheading Marking Posters
-
-Authors with records in the @b{BBDB} can be marked either with a
-user-defined mark character, or with a default one.  The marking is
-enabled by the use of a Gnus user format code, as determined by
-@code{bbdb/gnus-summary-in-bbdb-format-letter}.  This variable, which
-defaults to @samp{b}, is used to create a format code which is intended
-for use in @code{gnus-summary-line-format}.  The format code is created
-by concatenating @samp{%u} with the value of
-@code{bbdb/gnus-summary-in-bbdb-format-letter}.  In the default case
-this results in the creation of the format code @samp{%ub}.
-
-Posts are marked as follows: If the record for the poster has the field
-indicated in @code{bbdb-message-marker-field} (the default is
-@code{mark-char}), the value of that field is used as the mark
-character.@footnote{While it is possible to put a multi-character mark
-in @code{bbdb-message-marker-field} and/or in
-@code{bbdb/gnus-summary-known-poster-mark}, the resulting summary buffer
-will be misaligned as a result.  This misalignment will result from fact
-that at this time the character used to indicate posts whose authors are
-not in the @b{BBDB} is always a single character, and cannot be
-changed.}  If no such field is present, the value of
-@code{bbdb/gnus-summary-known-poster-mark} will be used instead.  If the
-author is not in the @b{BBDB}, a space will be used as the mark character.
-
-@subsubheading Using Names from the @b{BBDB}
-
-The names reported for authors of posts in the Summary buffer can be
-altered to conform to the values present in their respective @b{BBDB}
-records (if any).  This rewriting is enabled by the use of a Gnus user
-format code, as determined by
-@code{bbdb/gnus-summary-user-format-letter}.  This variable, which
-defaults to @samp{B}, is used to create a format code which is intended
-for use in @code{gnus-summary-line-format}.  The format code is created
-by concatenating @samp{%u} with the value of
-@code{bbdb/gnus-summary-user-format-letter}.  In the default case this
-results in the creation of the format code @samp{%uB}.  This format code
-is intended to @b{replace} the format code previously used in the Summary
-buffer format line to indicate the author and/or net address (usually
-@samp{%a}, @samp{%n}, and/or @samp{$N}).
-
-The effects of this format code are in two independent parts - the
-marking of known posters, and the rewriting of posters names.  The
-first, the marking of posters, occurs only when
-@code{bbdb/gnus-summary-mark-known-posters} is @code{t} (the default)
-and the posters have entries in the @b{BBDB}.  When this variable is
-true, the marking occurs as described in the previous section, Marking
-Posters, above.
-
-The poster name rewriting is done for all posters - not just for those
-with records in the @b{BBDB}.  That said, rewriting rules for posters in
-the @b{BBDB} are more flexible than for those not listed.  The rewriting is
-governed by two variables, as described below.
-
-@code{bbdb/gnus-summary-prefer-real-names} can have one of three values -
-@samp{t}, @samp{bbdb}, or @code{nil}.  In general, this variable governs
-the preference between net addresses and names.  If it is @samp{t}, the
-name (if any) will be used.  If @samp{nil}, the net address will be
-used.  The third value, @samp{bbdb}, can be used as a method for
-distinguishing between authors with records in the @b{BBDB} and those
-without.  If the variable is set to @samp{bbdb}, the name from the
-@b{BBDB} record will be used if the author has a record in the
-@b{BBDB}.  If the author is not in the @b{BBDB}, the net address from
-the message will be printed.  This variable makes little sense if
-@code{bbdb/gnus-summary-prefer-bbdb-data} is @samp{nil}, as no names
-will be printed in the Summary buffer in this case - only net addresses.
-
-@code{bbdb/gnus-summary-prefer-bbdb-data} is used to (dis)allow use of
-the @b{BBDB} for author data retrieval.  If it is @samp{t}, data from
-the @b{BBDB} will be used if available.  If it is @samp{nil}, data from
-the @b{BBDB} will not be used.
-
-@noindent
-In the following examples, assume the following:
-
-@enumerate
-@item 
-Message: @code{From: Jamie }@*
-@b{BBDB}: No record
-@item 
-Message: @code{From: Matt }@*
-@b{BBDB}: Name: @samp{Matthew}, Net: @samp{simmonmt@@purdue.edu}
-@end enumerate
-
-@multitable @columnfractions .47 .17 .18 .18
-@item @code{bbdb/gnus-summary-prefer-bbdb-data}
-@tab @center @code{t}
-@tab @center @code{t}
-@tab @center @code{nil}
-@item @code{bbdb/gnus-summary-prefer-real-names}
-@tab @center @code{t}
-@tab @center @code{bbdb}
-@tab @center @code{t}
-@item Printed in Summary buffer for
-@tab
-@tab
-@tab
-@item @center Case 1
-@tab @center Jamie
-@tab @center jwz@@netscape.com
-@tab @center Jamie
-@item @center Case 2 
-@tab @center Matthew
-@tab @center Matthew
-@tab @center Matt
-@end multitable
-
-@node GNUS Subject List,  , Gnus Summary Buffer, Gnus Features
-@subsubsection GNUS Summary Buffer Enhancements
-
-@i{This section is remarkably terse, as I don't have a copy of @b{GNUS}.
-If anybody can provide more descriptive information, please let me
-know.}
-
-@example
-(autoload 'bbdb/gnus-lines-and-from "bbdb-gnus")
-(setq gnus-optional-headers 'bbdb/gnus-lines-and-from)
-@end example
-
-@table @code
-@item bbdb/gnus-mark-known-posters
-@vindex bbdb/gnus-mark-known-posters
-@cindex GNUS Subject-buffer
-If @code{t} (the default), then the @b{GNUS} subject list will contain an
-indication of those messages posted by people who have entries in
-the Insidious Big Brother Database (they will be marked with an
-asterisk.) @refill
-
-@cindex mark-char
-You can change the character used to mark records on a record-by-record
-basis by adding a @code{mark-char} property to the record, whose value
-is be the string to display (preferably one character.) @refill
-
-@item bbdb/gnus-header-prefer-real-names
-@vindex bbdb/gnus-header-prefer-real-names
-Default: @code{nil}.  if @code{t}, then the @b{GNUS} subject list will
-display real names instead of network addresses. @refill
-
-@item bbdb/gnus-header-show-bbdb-names
-@vindex bbdb/gnus-header-show-bbdb-names
-Default: @code{t}.  If both this variable and
-the @code{bbdb/gnus-header-prefer-real-names} variable are true, then
-for news messages from people who are in your database, the name displayed
-will be the primary name from the database, rather than the one from
-the @samp{From:} line of the message.  This doesn't affect the names of
-people who aren't in the database, of course.@refill
-
-@item bbdb/gnus-lines-and-from-length
-@vindex bbdb/gnus-lines-and-from-length
-Default: 18.  The number of characters used to display @samp{From:} info in
-@b{GNUS}, if you have set @code{gnus-optional-headers} to
-@code{bbdb/gnus-lines-and-from}. @refill
-@end table
-
-@node VM Features,  , Gnus Features, Reader-specific Features
-@subsection VM-specific features
-
-The @b{BBDB} can be used to integrate database information into the
-message summary.
-
-@menu
-* VM Message Summary::                  @b{BBDB} information in message summary
-* VM what records are displayed::
-* VM automatic setup of vm-set-auto-folder-alist::
-* VM automatic adding of labels::
-@end menu
-
-@node VM Message Summary, VM what records are displayed, VM Features, VM Features
-@subsubsection VM Message Summary Enhancements
-
-@vindex vm-summary-format
-@findex vm-summary-function-B
-@cindex %F
-@cindex %UB
-VM users can cause their summary buffer to display the name of the
-message sender according to @b{BBDB} data, instead of according to the
-contents of the current message's headers.  In VM 5.40 or later, use
-the summary format control @code{%UB"} instead of @code{"%F"}, and the
-current record name will be shown there if available.  If no entry is
-found it behaves like @code{"%F"}.  See the documentation for
-@code{vm-summary-format} for more details.  Warning, this may
-significantly slow down summary generation for large folders.
-
-@node VM what records are displayed, VM automatic setup of vm-set-auto-folder-alist, VM Message Summary, VM Features
-@subsubsection VM configuration of what records the @b{BBDB} buffer shows
-
-@vindex vm-summary-uninteresting-senders
-
-Email addresses which match @code{vm-summary-uninteresting-senders} are
-ignored.
-
-The records in the @b{BBDB} buffer are listed in the same order as found.
-
-@node VM automatic setup of vm-set-auto-folder-alist, VM automatic adding of labels, VM what records are displayed, VM Features
-@subsubsection VM automatic setup of @code{vm-set-auto-folder-alist}
-
-@vindex bbdb/vm-set-auto-folder-alist-field
-VM users can setup the @code{vm-set-auto-folder-alist} automatically by
-calling @code{bbdb/vm-set-auto-folder-alist}.  This adds for each @b{BBDB}
-record containing a @code{bbdb/vm-set-auto-folder-alist-field} an entry
-to @code{vm-set-auto-folder-alist}.
-
-The record field can contain a string which is used as folder name or
-if it starts with a @code{'} it is treated as lisp expression returning
-a folder name.
-
-@node VM automatic adding of labels, , VM automatic setup of vm-set-auto-folder-alist, VM Features
-@subsubsection VM automatic adding of labels
-
-@vindex bbdb/vm-auto-add-label-list
-@vindex bbdb/vm-auto-add-label-field
-@findex bbdb/vm-auto-add-label
-
-@code{bbdb/vm-auto-add-label-list} is a
-List used by @code{bbdb/vm-auto-add-label} to automatically label messages.
-Each element in the list is either a string or a list of two strings.
-If a single string then it is used as both the field value to check for
-and the label to apply to the message.  If a list of two strings, the first
-is the field value to search for and the second is the label to apply.
-
-@code{bbdb/vm-auto-add-label-field bbdb-define-all-aliases-field} is the
-field used by @code{bbdb/vm-auto-add-label} to automatically label messages.
-Value is either a single symbol or a list of symbols of bbdb fields that
-@code{bbdb/vm-auto-add-label} uses to check for labels to apply to messages.
-Defaults to @code{bbdb-define-all-aliases-field} which is typically
-@code{mail-alias}.
-
-@code{bbdb/vm-auto-add-label} automatically adds labels to messages
-based on the @code{bbdb/vm-auto-add-label-field
-bbdb-define-all-aliases-field} field.  Add this to
-@code{bbdb-notice-hook} and if using VM each message that bbdb notices
-will be checked.  If the sender has a value in the
-@code{bbdb/vm-auto-add-label-field} in their BBDB record that matches a
-value in @code{bbdb/vm-auto-add-label-list} then a VM label will be
-added to the message.
-
-This works great when `bbdb-user-mail-names' is set.  As a result mail
-that you send to people (and copy yourself on) is labeled as well.
-
-@node Other Packages, Options, Reader-specific Features, Top
-@section Using the @b{BBDB} with other packages
-
-The @b{BBDB} adds functionality to several packages.  The following sections
-detail these augmentations.
-
-@menu
-* Using Message Mode::          Using the @b{BBDB} with Message Mode
-* Using Reportmail::            Using the @b{BBDB} with Reportmail
-* Using Supercite::             Using the @b{BBDB} with Supercite
-* Using Web Browsers::          Using the @b{BBDB} with Web Browsers
-@end menu
-
-@node Using Message Mode, Using Reportmail, Other Packages, Other Packages
-@subsection Using the @b{BBDB} with Message Mode
-
-At this time, the only feature the @b{BBDB} adds to Message mode is the binding
-to @kbd{M-TAB} which allows for @b{BBDB} record completion.
-
-@node Using Reportmail, Using Supercite, Using Message Mode, Other Packages
-@subsection Using the @b{BBDB} with Reportmail
-
-The @b{BBDB} can modify the @file{reportmail.el} package to use information
-from @b{BBDB} records when identifying the senders or recipients of e-mail
-messages.
-
-In normal operation, Reportmail displays the name and net address sender and
-recipient of incoming messages.  The @b{BBDB} can be configured to intercept
-and rewrite this information before it appears in the Emacs mode-line.  It
-first attempts to rewrite the sender and/or recipient information by
-substituting those addresses with information from the @b{BBDB}. Replacement
-information is first sought from the @code{mail-name} field in the respective
-@b{BBDB} records.  If no such field is found, the @code{name} field is
-returned.  If no @b{BBDB} record is found, no rewriting is performed.
-
-The @b{BBDB}-Reportmail augmentation is accomplished through the advising of
-the Reportmail @code{display-time-get-field} function in order to do
-a-posteriori modification of the returned value.  The augmentation uses the
-@code{bbdb/reportmail-alternate-full-name} function to retrieve data from the
-@b{BBDB} for use in rewriting.
-
-@node Using Supercite, Using Web Browsers, Using Reportmail, Other Packages
-@subsection Using the @b{BBDB} with Supercite
-
-@c 
-
-The @b{BBDB} can be used with Supercite to store attributions with @b{BBDB}
-records.  Normally, when a non-default attribution is entered for a given
-message, the entered attribution is used for that message, and is then
-discarded.  When the @b{BBDB}-Supercite augmentation is enabled, the
-non-default attribution will be added to the record (if any) for the entity
-being cited.  This poor explanation sounds complicated, but it's not.  If a
-message from @samp{Jamie Zawinski } is being replied to,
-Supercite will, by default, suggest the citation @samp{Jamie}.  If the
-non-default citation @samp{jwz} is entered, Supercite can save it with the
-@b{BBDB} record for @samp{Jamie Zawinski} in the @code{attribution} field.
-
-@c 
-
-The field used can be changed by changing the value of
-@code{bbdb/sc-attribution-field}.
-
-@node Using Web Browsers,  , Using Supercite, Other Packages
-@subsection Using the @b{BBDB} with Web Browsers
-
-The @b{BBDB}/Web Browser integration is in two parts, one which is
-automatically enabled, and one which must be manually enabled (@pxref{Web
-Browser Prep}).  The first feature added is the ability to display the URL
-associated with a given record in a Web Browser.  The second is the ability to
-add URLs to @b{BBDB} records from within W3, the Emacs Web Browser.
-
-Pressing @kbd{W} in the @code{*BBDB*} buffer while the cursor is positioned
-over a record with a @code{www} field will cause the first URL in the field to
-be loaded in a Web Browser.  This functionality uses @code{browse-url} to
-display URLs - see the documentation for @code{browse-url} for information on
-selecting the browser to be used.
-
-If W3 is used, and if the @b{BBDB}/W3 functionality has been enabled as
-described in @ref{Web Browser Prep}, pressing the @kbd{:} key will add the URL
-currently being displayed in W3 to a user-specified @b{BBDB} record.
-
-@node Options, Utilities, Other Packages, Top
-@section Options
-
-There are many variables which control the behavior of the Insidious Big
-Brother Database, and there are many hook-variables which can be used to
-modify its behavior in more complex ways.  Several pieces of functionality
-are included which use the hooks in this way. @refill
-
-@menu
-* Customization Parameters::	Customization Parameters
-* Customization Hooks::		Customization Hooks
-* Predefined Hooks::		Predefined Hooks
-@end menu
-
-@node Customization Parameters, Customization Hooks, Options, Options
-@subsection Customization Parameters
-
-@table @code
-@item bbdb-file
-@vindex bbdb-file
-The name of the file which contains your personal database.  Default:
-@file{~/.bbdb}.
-
-@item bbdb-default-area-code
-@vindex bbdb-default-area-code
-@cindex Phone numbers
-The default area code to use when prompting for a new phone number.
-Default: 415.  This must be a number, not a string.@refill
-
-@item bbdb-north-american-phone-numbers-p
-@vindex bbdb-north-american-phone-numbers-p
-@cindex North American phone numbers
-@cindex European phone numbers
-Whether syntax-checking of phone numbers should be enforced.  Default:
-@code{t}.  This only works for Bell-system phone numbers.  If this is true,
-then you can't enter invalid phone numbers, and all phone numbers are
-pretty-printed in the same way.  European phone numbers don't have as
-strict a syntax, however, so this is a harder problem for them (on which
-I am punting). @refill
-
-You can have both styles of phone number in your database by providing a
-prefix argument to the @code{bbdb-insert-new-field} command. @refill
-
-@item bbdb-check-zip-codes-p
-@vindex bbdb-check-zip-codes-p
-@vindex bbdb-legal-zip-codes
-@cindex Zip code checking 
-@cindex Checking zip codes
-@cindex Invalid zip codes
-@cindex Not a valid zip code
-@cindex List of valid zip codes
-@cindex Valid zip codes
-Whether syntax-checking of zip codes should be enforced.  Default:
-@code{t}.  If this is true, you can't enter invalid zip codes.  A zip
-code is valid if it matches one of the regular expressions in the
-variable @code{bbdb-legal-zip-codes}. @refill
-
-@item bbdb-address-formatting-alist
-@vindex bbdb-address-formatting-alist
-@cindex Formatting addresses
-@cindex Display of addresses
-@cindex Address display
-Controls the display of addresses in the buffer.  Each entry in this
-list consists of an identifying function and a formatting function.
-The identifying function must accept an address and return @code{t} if
-the associated formatting function is to be used.  The formatting
-function must insert the formatted address in the current buffer.
-Identifying functions usually base their decision on the zip code
-format or on the country name.  The default entries will format an
-address using continental style if the zip code matches
-@code{bbdb-continental-zip-regexp}.  If the zip code does not match,
-addresses are formatted in US style.
-
-@item bbdb-continental-zip-regexp
-@vindex bbdb-continental-zip-regexp
-@cindex Continental addresses
-@cindex European addresses
-Decides whether an address should be formatted using US or European
-style.  If the zip code of an address matches the regular expression,
-the European style is used.  This works only if the expression
-@code{(bbdb-address-is-continental . bbdb-format-address-continental)}
-is part of @code{bbdb-address-formatting-alist}.
-
-@item bbdb-electric-p
-@vindex bbdb-electric-p
-@cindex Electric display
-Whether bbdb mode should be @i{``electric''} like @code{electric-buffer-list}.
-Default: @code{t}.  What this means is that the BBDB buffer which pops
-up when you use it can be disposed of by pressing the space bar, at
-which point your window configuration will be restored to what it was
-before you invoked the db list.  (The @code{bbdb-mode} commands still
-work as well.) @refill
-
-There are some problems with electric modes; for example, keyboard
-macros and incremental search don't work.  (This is not a bug in BBDB,
-but in @file{electric.el}.)@refill
-
-@item bbdb-case-fold-search
-@vindex bbdb-case-fold-search
-Default: the same as @code{case-fold-search}.  @code{case-fold-search} is
-bound to this by @w{@kbd{M-x bbdb}} and related commands.  This variable lets
-the case-sensitivity of @kbd{^S} and of the bbdb searching commands be
-different.
-
-@item bbdb/mail-auto-create-p
-@vindex bbdb/mail-auto-create-p
-If this is @code{t} (the default), then @b{VM}, @b{MH}, and @b{RMAIL}
-will automatically create new bbdb records for people you receive mail
-from.  If this variable is a function name or lambda expression, then it
-is called with no arguments to decide whether an entry should be
-automatically created.  You can use this to, for example, not create
-records for messages which have reached you through a particular mailing
-list, or to only create records automatically if the mail has a
-particular subject.  See the variables
-@code{bbdb-ignore-most-messages-alist} and
-@code{bbdb-ignore-some-messages-alist} (@xref{Predefined Hooks}.) @refill
-
-@item bbdb/news-auto-create-p
-@vindex bbdb/news-auto-create-p
-@cindex Automatically creating records
-If this is @code{t} (default: @code{nil}), then @b{GNUS} will
-automatically create new @b{BBDB} records for people you read messages
-by.  If this is a function name or lambda expression, then it is called
-with no arguments to decide whether an entry should be automatically
-created.  You can use this to, for example, create or not create
-messages which have a particular subject.  See the variable
-@code{bbdb-auto-notes-alist} (@xref{Predefined Hooks}.). @refill
-
-If you want to autocreate messages based on the current newsgroup, it's
-probably a better idea to set this variable to @code{t} or @code{nil} from your
-@code{gnus-select-group-hook} instead. @refill
-
-To automatically remember users in certain groups, you can do something
-like @refill
-@example
-@exdent (setq gnus-select-group-hook
-@exdent   '(lambda ()
-@exdent      (setq bbdb/news-auto-create-p
-@exdent            (or (string= "some.news.group" gnus-newsgroup-name)
-@exdent                (string= "other.news.group" gnus-newsgroup-name)))))
-@end example
-
-@item bbdb-quiet-about-name-mismatches
-@vindex bbdb-quiet-about-name-mismatches
-If this is false (the default), then @b{BBDB} will prompt you when it notices a
-name change, that is, when the ``real name'' in a message doesn't correspond
-to a record already in the database with the same network address.  As in,
-@w{@i{``John Smith ''}} versus
-@w{@i{``John Q. Smith ''.}}  If this is true, then you will
-not be asked if you want to change it (and it will not be changed.)
-If a number then it is the number of seconds to sit-for while
-displaying the name mismatch.
-@refill
-
-@item bbdb-use-alternate-names
-@vindex bbdb-use-alternate-names
-@cindex Alternate names
-@cindex AKA
-If this is false, then the @b{BBDB} will not use the @b{AKA} field.
-Otherwise (the default) then the mail and news interfaces will ask you
-if you want to add an alternate name when a name-change is noticed, and
-will ask you whether the new name should be made the primary one.
-Note that if @code{bbdb-quiet-about-name-mismatches} is true, you will
-not be asked any questions about alternate names.
-
-@item bbdb-readonly-p
-@vindex bbdb-readonly-p
-If this is true (default: @code{nil}), then nothing will attempt to change the
-database implicitly, and you will be prevented from doing it
-explicitly.  If you have more than one emacs running at the same time,
-you might want to arrange for this to be set to @code{t} in all but one of
-them. @refill
-
-@item bbdb-auto-revert-p
-@vindex bbdb-auto-revert-p
-If this variable is true (default: @code{nil}) and the @b{BBDB} file is noticed to
-have changed on disk, it will be automatically reverted without
-prompting you first.  Otherwise you will be asked.  (But if the file has
-changed and you have made changes in memory as well, you will always be
-asked.) @refill
-
-@item bbdb-notice-auto-save-file
-@vindex bbdb-notice-auto-save-file
-@cindex Auto-save files
-If this is true (default: @code{nil}), then the @b{BBDB} will notice when its
-auto-save file is newer than the file is was read from, and will offer
-to revert. @refill
-
-@item bbdb-use-pop-up
-@vindex bbdb-use-pop-up
-@cindex Automatic display of the corresponding record
-If true (the default), display a continuously-updating @b{BBDB}
-window while in @b{VM}, @b{MH}, @b{RMAIL}, or @b{GNUS}.
-Each time a new message is selected, the record corresponding to
-that message's sender will be displayed in another window.  The
-buffer in this other window will be in bbdb-mode, and all
-corresponding commands will be available. @refill
-
-This buffer will be positioned on the screen by finding the tallest
-of the windows present, and splitting it such that the bottom
-@code{bbdb-pop-up-target-lines} lines of the window display the
-@samp{*BBDB*} buffer.  With the default configurations of @b{VM},
-@b{MH}, @b{RMAIL}, and @b{GNUS}, this means that the bbdb-list
-buffer will be just below the message-body buffer. @refill
-
-If this is the symbol @code{horiz}, then the @b{BBDB} window will be
-stacked horizontally instead of vertically, if there is room to do that
-tastefully. @refill
-
-@item bbdb-pop-up-target-lines
-@vindex bbdb-pop-up-target-lines
-Desired number of lines in a @b{VM/MH/RMAIL/GNUS} pop-up @b{BBDB} window,
-default 5. @refill
-
-@item bbdb-completion-type
-@vindex bbdb-completion-type
-@cindex Completion
-@cindex Name completion
-@cindex Mail address completion
-@cindex Address completion
-Controls the behavior of the @code{bbdb-complete-name} command.  If @code{nil}
-(the default), completion is done across the set of all full-names and
-user-ids in the database; if the symbol @code{name}, completion is
-done on real-names only; if the symbol @code{net}, completion is done
-on network addresses only; if it is @code{primary}, then completion is
-done only across the set of primary network addresses (the first address
-in the list of addresses for a given user).  If it is
-@code{primary-or-name}, completion is done across primaries and real
-names. @refill
-
-@item bbdb-expand-mail-aliases
-@vindex bbdb-expand-mail-aliases
-@cindex Completion
-@cindex Name completion
-@cindex Mail address completion
-@cindex Address completion
-If non-nil, expand mail aliases in `bbdb-complete-name'.
-@refill
-
-@item bbdb-complete-name-allow-cycling
-@vindex bbdb-complete-name-allow-cycling
-@cindex Completion
-@cindex Name completion
-@cindex Mail address completion
-@cindex Address completion
-Whether to allow cycling of email addresses when calling
-`bbdb-complete-name' on a completed address in a composition buffer."
-@refill
-
-@item bbdb-complete-name-full-completion
-@vindex bbdb-complete-name-full-completion
-@cindex Completion
-@cindex Name completion
-@cindex Mail address completion
-@cindex Address completion
-Show full expanded completion rather than partial matches.
-If t then do it always, if a number then just is the number of
-completions for a specific match is below that number.
-@refill
-
-@item bbdb-user-mail-names
-@vindex bbdb-user-mail-names
-A regular expression identifying the addresses that belong to you.  If a
-message from an address matching this is seen, the @b{BBDB} record for the
-@samp{To:} line will be shown instead of the one for the @samp{From:}
-line.  If this is @code{nil}, it will default to the value of
-@code{(user-login-name)}. @refill
-
-@item bbdb-always-add-addresses
-@vindex bbdb-always-add-addresses
-If this is @code{t}, then whenever the Insidious Big Brother Database
-notices a new email address corresponding to a person who is in the
-database, it will add it to the database.  If this is @code{nil} (the
-default), then whenever a new network address is noticed for a person in
-the database, you will be asked whether to add the address.  If this is
-the symbol @code{never} (really if it is not @code{t} and not @code{nil})
-then new network addresses will never be automatically added. @refill
-
-@item bbdb-new-nets-always-primary
-@vindex bbdb-new-nets-always-primary
-If this is @code{t}, then when the Insidious Big Brother Database adds a new
-address to a record, it will always add it to the front of the list of
-addresses, making it the primary address.  If this is @code{nil} (the default),
-then you will be asked.  If this is the symbol @code{never} (really if
-it is not @code{t} and not @code{nil}) then new network addresses will
-always be added to the end of the list. @refill
-
-@item bbdb-canonicalize-redundant-nets-p
-@vindex bbdb-canonicalize-redundant-nets-p
-If this is non-@code{nil}, redundant network addresses will be ignored.
-If a record has an address of the form @code{foo@@baz.com}, setting this
-to @code{t} will cause subsequently-noticed addresses
-like @code{foo@@bar.baz.com} to be ignored (since we already have a more
-general form of that address.)  This is similar in function to one of
-the possible uses of the variable @code{bbdb-canonicalize-net-hook}
-but is somewhat more automatic.  (This can't quite be implemented in
-terms of the canonicalize-net-hook because it needs access to the
-database to determine whether an address is redundant, and the
-canonicalize-net-hook is purely a textual manipulation which is
-performed before any database access.)
-
-@item bbdb-message-caching-enabled
-@vindex bbdb-message-caching-enabled
-Whether caching of the message->bbdb-record association should be
-used for the interfaces which support it (@b{VM}, @b{MH}, and
-@b{RMAIL}).  This can speed things up a lot.  One implication of
-this variable being true (the default) is that the
-@code{bbdb-notice-hook} will not be called each time a message is
-selected, but only the first time.  Likewise, if selecting a message
-would generate a question (whether to add an address, change the
-name, etc) you will only be asked that question the very first time
-the message is selected. @refill
-
-@item bbdb-offer-save
-@vindex bbdb-offer-save
-If @code{t} (the default), then certain actions will cause the @b{BBDB} to
-ask you whether you wish to save the database.  If @code{nil}, then the
-offer to save will never be made.  If not @code{t} and not @code{nil}, then
-any time it would ask you, it will just save it without asking. @refill
-
-@end table
-
-@node Customization Hooks, Predefined Hooks, Customization Parameters, Options
-@subsection Customization Hooks
-
-All of the hooks variables described below may be set to a symbol or
-lambda expression, which will be funcalled; or may be set to a list of
-symbols or lambda expressions, each of which will be funcalled in turn.
-Almost all hooks in Emacs work this way.  But notice that some of the
-hooks described below are called with arguments.
-
-@table @code
-@item bbdb-list-hook
-@vindex bbdb-list-hook
-Hook or hooks invoked after the bbdb-list-buffer is filled in.  Invoked
-with no arguments. @refill
-
-@item bbdb-create-hook
-@vindex bbdb-create-hook
-Hook or hooks invoked each time a new bbdb-record is created.  Invoked
-with one argument, the new record.  This is called @emph{before} the record is
-added to the database.  Note that @code{bbdb-change-hook} will be called as
-well. @refill
-
-@item bbdb-change-hook
-@vindex bbdb-change-hook
-Hook or hooks invoked each time a bbdb-record is altered.  Invoked with
-one argument, the record.  This is called @emph{before} the database buffer
-is modified.  Note that if a new bbdb record is created, both this hook and
-@code{bbdb-create-hook} will be called. @refill
-
-@item bbdb-mode-hook
-@vindex bbdb-mode-hook
-Hook or hooks invoked when the @samp{*BBDB*} buffer is created.
-
-@item bbdb-notice-hook
-@vindex bbdb-notice-hook
-Hook or hooks invoked each time a bbdb-record is ``noticed,'' that
-is, each time it is displayed by the news or mail interfaces.
-Invoked with one argument, the new record.  The record need not have
-been modified for this to be called - use @code{bbdb-change-hook} for that.
-You can use this to, for example, add something to the notes field
-based on the subject of the current message.  It is up to your hook
-to determine whether it is running in @b{GNUS}, @b{VM},
-@b{MH}, or @b{RMAIL}, and to act appropriately. @refill
-
-Also note that @code{bbdb-change-hook} will @emph{not} be called as a
-result of any modifications you may make to the record inside this
-hook. @refill
-
-Beware that if the variable @code{bbdb-message-caching-enabled} is
-true (a good idea) then when you are using @b{VM}, @b{MH}, or
-@b{RMAIL}, this hook will be called only the first time that
-message is selected.  (The @b{GNUS} interface does not use caching.)
-When debugging the value of this hook, it is a good idea to set
-caching-enabled to @code{nil}. @refill
-
-@item bbdb-after-read-db-hook
-@vindex bbdb-after-read-db-hook
-Hook or hooks invoked (with no arguments) just after the Insidious Big
-Brother Database is read in.  Note that this can be called more than once if
-the @b{BBDB} is reverted.  One possible use for this is to rename the
-@file{.bbdb} buffer; for example @refill
-
-@code{(setq bbdb-after-read-db-hook '(lambda () (rename-buffer " bbdb")))}
-
-@noindent
-will cause the buffer visiting the @code{bbdb-file} to be
-called @w{@code{" bbdb"}}.  The leading space in its name will prevent
-it from showing up in the buffer list.
-
-@item bbdb-load-hook
-@vindex bbdb-load-hook
-Hook or hooks invoked (with no arguments) when the Insidious Big Brother
-Database code is first loaded.  WARNING:  Slow functions should not be
-put on this hook, as the @b{BBDB} code will, if not loaded before, be
-loaded during the first use of @b{BBDB}-related Customization
-functions.  Slow functions should be put on @code{bbdb-initialize-hook}.
-
-@item bbdb-initialize-hook
-@vindex bbdb-initialize-hook
-@findex bbdb-initialize
-Hook or hooks invoked (with no arguments) when the
-@code{bbdb-initialize} function is called.
-
-@item bbdb-canonicalize-net-hook
-@vindex bbdb-canonicalize-net-hook
-If this is non-@code{nil}, it should be a function of one argument: a
-network address string.  (Note that, unlike the other hook-variables
-described above, this may not be a list of functions.)  Whenever the
-Insidious Big Brother Database ``notices'' a message, the corresponding
-network address will be passed to this function first, as a kind of
-``filter'' to do whatever transformations upon it you like before it is
-compared against or added to the database.  For example: it is the case
-that @code{CS.CMU.EDU} is a valid return address for all mail
-originating at a machine in the @code{.CS.CMU.EDU} domain.  So, if you
-wanted all such addresses to be canonically hashed as
-@code{user@@CS.CMU.EDU}, instead of as @code{user@@somehost.CS.CMU.EDU},
-you might set this variable to a function like this: @refill
-
-@example
-(setq bbdb-canonicalize-net-hook
-     '(lambda (addr)
-        (cond ((string-match
-                 "\\`\\([^@@]+@@\\).*\\.\\(CS\\.CMU\\.EDU\\)\\'"
-                 addr)
-               (concat (substring addr
-                         (match-beginning 1) (match-end 1))
-                       (substring addr
-                         (match-beginning 2) (match-end 2))))
-              (t addr))))
-@end example
-
-You could also use this function to rewrite UUCP-style addresses into
-domain-style addresses, or any number of other things.@refill
-
-This function will be called repeatedly until it returns a value EQ to the
-value passed in.  So multiple rewrite rules might apply to a single
-address.@refill
-
-There is an example of the use of this variable in the
-file @file{bbdb-hooks.el}: the function
-@code{sample-bbdb-canonicalize-net-hook}.@refill
-@end table
-
-@vindex bbdb-change-hook
-@findex bbdb-delete-redundant-nets
-The @code{bbdb-canonicalize-net-hook} is powerful in that it allows
-arbitrary rewriting of addresses, however, in many cases that is
-overkill.  The function @code{bbdb-delete-redundant-nets} can be
-used as a value of @code{bbdb-change-hook} to cause network addresses
-which appear to be ``redundant'' to be deleted each time a modification
-is made to a record. @refill
-
-This works as follows: suppose one gets mail from @code{user@@foo.bar.com},
-and then later gets mail from @code{user@@bar.com}.  At this point, one
-can generally delete the @code{user@@foo.bar.com} address, since the
-@code{user@@bar.com} address is more general.  (See also the
-variable `bbdb-canonicalize-redundant-nets-p', which has the effect of
-ignoring subsequent addresses from @code{user@@quux.bar.com} if the
-address @code{user@@bar.com} is already known.)@refill
-
-@node Predefined Hooks,  , Customization Hooks, Options
-@subsection Predefined Hooks
-
-@findex bbdb-timestamp-hook
-@cindex Timestamping records
-If the variable @code{bbdb-change-hook} is set to the symbol
-@code{bbdb-timestamp-hook} (the default), then every record in the
-database will have a field named @samp{timestamp}, which will always
-contain the date and time at which this record was created or last
-modified.
-
-@findex bbdb-creation-date-hook
-If the variable @code{bbdb-create-hook} is set to the symbol
-@code{bbdb-creation-date-hook} (the default), then every record in the
-database will have a field named @samp{creation-date}, which will
-contain the date and time at which this record was added to the
-database.
-
-@findex bbdb-ignore-most-messages-hook
-@vindex bbdb-ignore-most-messages-alist
-@cindex Automatically creating records
-If the variable @code{bbdb/mail-auto-create-p} is set to the symbol
-@code{bbdb-ignore-most-messages-hook}, then the variable
-@code{bbdb-ignore-most-messages-alist} will determine which messages
-should have records automatically created for them.  The format of this
-alist is @refill
-@example
-(( @var{HEADER-NAME} . @var{REGEXP} ) @dots{} )
-@end example
-@noindent
-for example,
-@example
-(("From" . "@@.*\\.maximegalon\\.edu")
- ("Subject" . "time travel"))
-@end example
-
-@noindent
-will cause @b{BBDB} entries to be made only for messages sent by
-people at Maximegalon U., or (that's @emph{or}) people posting
-about time travel. @refill
-
-There may be only one entry per header in this alist: that is, @refill
-
-@example
-(("From" . "addr1\\|addr2") @dots{} )
-@end example
-
-@noindent
-is legal, but
-
-@example
-(("From" . "addr1") ("From" . "addr2") @dots{} )
-@end example
-
-@noindent
-is not.
-
-@vindex bbdb/mail-auto-create-p
-@vindex bbdb/news-auto-create-p
-@findex bbdb-ignore-some-messages-hook
-@vindex bbdb-ignore-some-messages-alist
-If the variable @code{bbdb/mail-auto-create-p} is set to the symbol
-@code{bbdb-ignore-some-messages-hook}, then the variable
-@code{bbdb-ignore-some-messages-alist} will determine which messages
-should have records automatically created for them.  This is the exact
-inverse of the semantics of the @code{bbdb-ignore-most-messages-alist}:
-the alist specifies which messages should @emph{not} have records
-automatically created for them, instead of which should.  For
-example, @refill
-
-@example
-(("From" . "mailer.daemon")
- ("To" . "mailing-list-1\\|mailing-list-2")
- ("CC" . "mailing-list-1\\|mailing-list-2"))
-@end example
-
-@noindent
-will cause @b{BBDB} entries to not be made for messages from any mailer daemon,
-or messages sent to or @b{CC}ed to either of two mailing lists. @refill
-
-The variable @code{bbdb/news-auto-create-p} may be set to either of the
-above-mentioned functions as well, to get this behavior for netnews
-messages instead of mail messages.@refill
-
-@vindex bbdb-notice-hook
-@vindex bbdb-auto-notes-alist
-@cindex Automatically adding text to records
-If the variable @code{bbdb-notice-hook} is set to the symbol
-@code{bbdb-auto-notes-hook}, then the variable @code{bbdb-auto-notes-alist}
-may be used to automatically add text to the notes fields of the records
-corresponding to certain messages.  The format of this alist is @refill
-
-@example
-(( @var{HEADER-NAME}
-   (@var{REGEXP} . @var{STRING}) @dots{} )
-    @dots{} )
-@end example
-
-@noindent
-for example,
-
-@example
-(("To" ("-vm@@" . "VM mailing list"))
- ("Subject" ("sprocket" . "mail about sprockets")
-            ("you bonehead" . "called me a bonehead")))
-@end example
-
-@noindent
-will cause the text @code{"VM mailing list"} to be added to the notes field of
-the record corresponding to anyone you get mail from via one of the @b{VM}
-mailing lists.  If, that is, @code{bbdb/mail-auto-create-p} is set such
-that the record would have been created, or if the record already
-existed.@refill
-
-The format of elements of this list may also be
-
-@example
-(@var{REGEXP} @var{FIELD-NAME} @var{STRING})
-@end example
-@noindent
-or
-@example
-(@var{REGEXP} @var{FIELD-NAME} @var{STRING} @var{REPLACE-P})
-@end example
-
-@noindent
-meaning add the given string to the named field.  The field-name may not
-be @samp{name}, @samp{aka}, @samp{address}, @samp{phone}, or @samp{net}
-(builtin fields) but must be either @samp{notes}, @samp{company}, or the
-name of a user-defined note-field. @refill
-
-@example
-("pattern" . "string to add")
-@end example
-
-@noindent
-is equivalent to
-
-@example
-("pattern" notes "string to add")
-@end example
-
-@noindent
-@var{STRING} can contain @code{\&} or @code{\N} escapes like in the function
-@code{replace-match}.  For example, to automatically add the contents of the
-@b{organization} field of a message to the @code{company} field of a @b{BBDB}
-record, you can use this: @refill
-
-@example
-("Organization" (".*" company "\\&"))
-@end example
-
-@noindent
-(Note you need two \ to get a single \ into a lisp string literal.)
-
-If STRING is an integer @i{N}, the @i{N}th matching subexpression is
-used, so the above example could be written more efficiently as @refill
-
-@example
-("Organization" (".*" company 0))
-@end example
-
-If STRING is neither a string or an integer, it should be a function
-which is called with the contents of the field, and the result of the
-function call is used.
-
-If the @var{REPLACE-P} flag is true, then the string replaces the old
-contents instead of being appended to it.
-
-If multiple clauses match the message, all of the corresponding strings
-will be added. @refill
-
-If the string is being appended (@var{REPLACE-P} is false or not
-provided) then the new string is appended to the end of the existing
-field value, with an intervening newline.  So each piece of text
-automatically added to this field will go on its own line. @refill
-
-You can control what the separator is by putting a @code{field-separator}
-property on the symbol naming the field.  For example, to make text
-automatically added to a field named @code{newsgroups} be separated by
-commas, you could do @refill
-
-@example
-(put 'newsgroups 'field-separator "; ")
-@end example
-
-This variable works for news as well.  You might want to arrange for
-this to have a different value when in mail as when in news. @refill
-
-There may be only one entry per header in this alist: that is,@refill
-
-@example
- (("Subject" ("\\bfoo\\b" . "Foo!!")
-             ("bar" . "Bar!")))
-@end example
-
-@noindent
-will work, but
-
-@example
- (("Subject" ("\\bfoo\\b" . "Foo!!"))
-  ("Subject" ("bar" . "Bar!")))
-@end example
-
-@noindent
-will not.
-
-Here's a more complicated example: some people include bitmaps of
-themselves in their mail messages in an @b{X-Face:} header field.
-You can capture this field into the @samp{*BBDB*} with the
-following:
-
-@example
-(setq bbdb-auto-notes-alist
-      (append bbdb-auto-notes-alist
-              (list "x-face"
-                    (list (concat "[ \t\n]*\\([^ \t\n]*\\)"
-                                  "\\([ \t\n]+\\([^ \t\n]+\\)\\)?"
-                                  "\\([ \t\n]+\\([^ \t\n]+\\)\\)?"
-                                  "\\([ \t\n]+\\([^ \t\n]+\\)\\)?"
-                                  )
-                          'face
-                          "\\1\\3\\5\\7"))))
-@end example
-
-@noindent
-(The calls to @code{list} and @code{concat} are just for readability, it
-could easily be a constant.)  The tricky bit here is that it strips out
-the newlines and whitespace used for header continuation, which are not
-actually a part of the face data.  So though the mail message may have
-the face data on multiple lines, the entry in the @samp{*BBDB*} will
-be just one line.
-
-@vindex bbdb-auto-notes-ignore
-@code{bbdb-auto-notes-ignore} is an alist of headers and regexps to
-ignore in @code{bbdb-auto-notes-hook}.  Each element looks like @refill
-
-@example
-(@var{HEADER} . @var{REGEXP})
-@end example
-
-@noindent
-for example,
-
-@example
-("Organization" . "^Gatewayed from\\|^Source only")
-@end example
-
-@noindent
-would exclude the phony @code{Organization:} headers in GNU mailing-lists
-gatewayed to the @code{gnu.*} newsgroups.  Note that this exclusion
-applies only to a single field, not to the entire message.  For that,
-use the variable @code{bbdb-auto-notes-ignore-all}.
-
-@vindex bbdb-auto-notes-ignore-all
-@code{bbdb-auto-notes-ignore-all} is an alist of headers and regexps
-which cause the entire message to be ignored in @code{bbdb-auto-notes-hook}.
-Each element looks like @refill
-
-@example
-(@var{HEADER} . @var{REGEXP})
-@end example
-
-@noindent
-for example,
-
-@example
-("From" . "BLAT\\.COM")
-@end example
-
-@noindent
-would exclude any notes recording for message coming from @code{BLAT.COM}.
-Note that this is different from @code{bbdb-auto-notes-ignore}, which
-applies only to a particular header field, rather than the entire message.
-
-@node Utilities, Internals, Options, Top
-@section Utilities
-
-This section describes @b{BBDB} functionality that does not fit neatly into
-other sections.
-
-@menu
-* bbdb-ftp::                    Storing FTP sites in the @b{BBDB}
-* bbdb-print::                  Print the @b{BBDB}
-* bbdb-snarf::                  Record generation from raw text
-* bbdb-srv::                    External control of the @b{BBDB}
-@end menu
-
-@node bbdb-ftp
-@subsection @code{bbdb-ftp}
-@cindex Storing FTP sites in the BBDB
-@findex bbdb-ftp
-
-The @code{bbdb-ftp} utility enables the storage of FTP sites as @b{BBDB}
-records.  The @code{bbdb-create-ftp-site} function is used to create a
-@b{BBDB} record for an FTP site.  The command will prompt for information
-needed to create the record.  The FTP site for a given record can be accessed
-with the @code{bbdb-ftp} command.
-
-@node bbdb-print, bbdb-snarf, bbdb-ftp, Utilities
-@subsection @code{bbdb-print}
-@cindex Printing records in the database
-@findex bbdb-print
-
-@code{bbdb-print} is a utility for pretty-printing entries from the @b{BBDB}
-using TeX.  It is invoked by pressing @kbd{P} in the @code{*BBDB*} buffer -
-this will cause all records in the @b{BBDB} to be printed as governed by the
-variables described below.  If @kbd{P} is prefixed by a @kbd{*}, only the
-currently-displayed records will be printed.  Once invoked, @code{bbdb-print}
-will generate the TeX output in a buffer named @file{~/bbdb.tex} (controlled
-by @code{bbdb-print-file-name}).  The generated output will be shown, and must
-be @b{manually} saved.
-
-For each record printed, @code{bbdb-print} will look for the presence of the
-@code{tex-name} field.  If this field is found, its value will be printed
-instead of the @code{name} field for the record in question.  This field is
-intended to allow the storage of names with accents or other characters that
-would be illegal in the address portion of a message.  While other fields have
-special characters quoted by @code{bbdb-print} as described below, the
-contents of the @code{tex-name} field (if present) are used verbatim.
-
-The following variables govern the printing of records (and of the printing of
-the fields therein):
-
-@table @code
-@item bbdb-print-omit-fields
-@vindex bbdb-print-omit-fields
-This variable should be set to a list of the fields that are not to be printed
-by @code{bbdb-print}.  It defaults to:@*
-@center @code{(omit tex-name aka mail-alias)}
-
-@item bbdb-print-file-name
-@vindex bbdb-print-file-name
-The name of the file where generated TeX output is to be stored.  The default
-is @file{~/bbdb.tex}.
-
-@item bbdb-print-require
-@vindex bbdb-print-require
-The fields required for printing a record.  This allows, for example, only
-records with phone numbers to be printed.  The value of the value of the
-variable will be evaluated once for each record, and the record will be
-printed only if the evaluation returns a non-nil value.  The symbols
-@code{name}, @code{company}, @code{net}, @code{phone}, @code{address}, and
-@code{notes} will be set to the appropriate values during evaluation; they
-will be nil if the field does not exist or is elided.
-
-The value of this variable can be any lisp expression, but typically
-it will be used for a boolean combination of the field variables, as
-in the following simple examples:
-
-@itemize @bullet
-@item Print only people whose phone numbers are known:@*
-@center @code{(setq bbdb-print-require 'phone)}
-@item Print people whose names AND companies are known:@*
-@center @code{(setq bbdb-print-require '(and name company))}
-@item Print people whose names, and either addresses OR phone numbers are
-known:@*
-@center @code{(setq bbdb-print-require '(and name (or address phone))).}
-
-The default value is:@*
-@center @code{(or address phone)}
-@end itemize
-
-@item bbdb-print-alist
-@vindex bbdb-print-alist
-Formatting options for all formats of @code{bbdb-print}.  The value is an
-alist of the form@*
-@center @code{((@var{OPTION} . @var{VALUE}) (@var{OPTION} . @var{VALUE}) ...)}
-
-Separate settings can be configured using @code{bbdb-print-brief-alist} and
-@code{bbdb-print-full-alist}.  Settings in these variables will override the
-ones in @code{bbdb-print-alist}.
-
-The possible options and legal settings are:
-@table @code
-@item columns
-@code{1}, @code{2}, @code{3}, @code{4}, @code{quad} (4 little
-2-column pages per sheet) or @code{grid} (12 credit-card-sized pages per
-sheet).
-
-@item separator
-@code{0}-@code{7}, the style of heading for each letter.  @code{0}=none,
-@code{1}=line, @code{2}=boxed letters, @code{3}=large boxed letters,
-@code{4}=large letters, @code{5}=letters with lines, @code{6}=letters with
-suits, @code{7}=boxed letters with suits.
-
-@item omit-area-code
-A regular expression matching area codes to omit.
-
-@item phone-on-first-line
-If @code{t}, the first phone number will be put on the same line as the name.
-If @code{nil}, the name will be the only text on the line.  If set to a
-string, the field of type @code{phone} whose name matches the string will be
-used.  The string should be a valid regular expression.
-
-@item n-phones
-Maximum number of phone numbers to include.
-
-@item n-addresses
-Maximum number of addresses to include.
-
-@item include-files
-List of TeX files to @code{\input}.  If the filenames are not absolute, the
-files must be located somewhere in the TeX input path.
-
-@item ps-fonts
-Postscript fonts (TimesNewRoman and Courier) will be used if the value
-is non-@code{nil}.  Standard TeX fonts (ec-fonts) will be used
-otherwise.
-
-@item font-size
-The integer point size of the font to be used.
-
-@item hsize
-The horizontal dimension of the pages.  The value must be a string, and must
-be a valid TeX dimension.  Alternatively, the TeX default will be used if the
-value is @code{nil}.
-
-@item vsize
-The vertical dimension of the pages.  The value must be a string, and must
-be a valid TeX dimension.  Alternatively, the TeX default will be used if the
-value is @code{nil}.
-
-@item hoffset
-The TeX output will be offset to the right by the value of this option.  The
-value must be either a string containing a valid TeX dimension or @code{nil}
-or @code{0} to use the default TeX horizontal offset.
-
-@item voffset
-The TeX output will be offset downward by the value of this option.  The
-value must be either a string containing a valid TeX dimension or @code{nil}
-or @code{0} to use the default TeX vertical offset.
-
-@item quad-hsize
-Horizontal size to be used for the individual pages in the quad format.  The
-value must be a string containing a valid TeX dimension.
-
-@item quad-vsize
-Vertical size to be used for the individual pages in the quad format.  The
-value must be a string containing a valid TeX dimension.
-@end table
-
-The default value is
-@example
-((omit-area-code . "(@var{AREA-CODE})")
- (phone-on-first-line . "^[ \t]*$")
- (ps-fonts . nil)
- (font-size . 6)
- (quad-hsize . "3.15in")
- (quad-vsize . "4.5in"))
-@end example
-
-Where @var{AREA-CODE} is the value of @code{bbdb-default-area-code} or
-@samp{000} if there is no default area code.
-
-@item bbdb-print-brief-alist
-@vindex bbdb-print-brief-alist
-Extra options for the @code{bbdb-print} brief format.  The value(s) of
-this variable can either supplement or override the values in
-@code{bbdb-print-alist}.  The format and possible values of this variable are
-as in @code{bbdb-print-alist}, described above.
-
-The default value is
-@example
-((columns . 1)
- (separator . 1)
- (n-phones . 2)
- (n-addresses . 1)
- (include-files "bbdb-print-brief" "bbdb-cols"))
-@end example
-
-@item bbdb-print-full-alist
-@vindex bbdb-print-full-alist
-Extra options for the @code{bbdb-print} non-brief format.  The value(s) of
-this variable can either supplement or override the values in
-@code{bbdb-print-alist}.  The format and possible values of this variable are
-as in @code{bbdb-print-alist}, described above.
-
-The default value is
-@example
-((columns . 3)
- (separator . 2)
- (include-files "bbdb-print" "bbdb-cols"))
-@end example
-
-@item bbdb-print-prolog
-@vindex bbdb-print-prolog
-TeX statements to include at the beginning of the @code{bbdb-print} output
-file.
-
-@item bbdb-print-epilog
-@vindex bbdb-print-epilog
-TeX statements to include at the end of the @code{bbdb-print} output file.
-
-@end table
-
-@node bbdb-snarf, bbdb-srv, bbdb-print, Utilities
-@subsection @code{bbdb-snarf}
-
-@code{bbdb-snarf} provides the ability to generate @b{BBDB} records from raw
-text.  If invoked as @code{bbdb-snarf}, it attempts to generate the record
-from the information around point (the cursor).  If invoked as
-@code{bbdb-snarf-region}@footnote{@code{bbdb-snarf} is actually a wrapper for
-@code{bbdb-snarf-region} that determines the relevant region and passes it
-on.}, the active region is used to generate the record.
-
-@noindent
-@b{Restrictions:}
-
-@enumerate
-@item
-@code{bbdb-snarf} currently recognizes only US-style phone numbers.
-@item
-@code{bbdb-snarf} works best with things that look like mailing addresses.
-@end enumerate
-
-@noindent
-Example of an address that @code{bbdb-snarf} will recognize:
-
-@example
-another test person
-1234 Gridley St.
-Los Angeles, CA 91342
-555-1212
-test@@person.net
-http://www.foo.bar/
-other stuff about this person
-@end example
-
-@node bbdb-srv,  , bbdb-snarf, Utilities
-@subsection @code{bbdb-srv}
-
-@code{bbdb-srv} provides the ability to initiate the display of @b{BBDB}
-records from outside of Emacs.  This allows external programs to cause
-the @b{BBDB} record for a given person to appear in the running Emacs
-when, for example, mail is recieved from that person.  One specific
-application, described below, is the integration of Netscape and the
-@b{BBDB}, allowing the display of @b{BBDB} records corresponding to Mail
-and/or News messages displayed in Netscape.
-
-@code{bbdb-srv} is composed of two parts - an external Perl script
-(@file{utils/bbdb-srv.pl}), and an Emacs Lisp file
-(@file{lisp/bbdb-srv.el}).  The external portion is used to send
-commands to the internal portion.
-
-@b{NOTE:} @code{bbdb-srv} requires @code{gnuserv} and @code{itimer},
-both included with XEmacs. @code{gnuserv} must be started with the
-@code{gnuserv-start} command before @code{bbdb-srv} can be used.
-
-In it's most basic form, mail or news headers are passed to the Perl
-script.  The Perl script then causes the @b{BBDB} record (if any)
-corresponding to the passed headers to be displayed in the running
-Emacs.  While @code{bbdb-srv} will operate with just a @samp{From:}
-field, it works better when passed both @samp{From:} and @samp{To:}
-headers.  When @code{bbdb-srv} notices that the logged-in user is named
-in the @samp{From:} header, it will attempt to display the record (if
-any) for the person named in the @samp{To:} header.  If no @samp{To:}
-header is passed, it falls back on the record (if any) for the logged-in
-user (the person named in the @samp{From:} header).
-
-An example manual invocation of @code{bbdb-srv} is as follows:
-
-@example
-% cat |bbdb-srv.pl
-From: Jamie Zawinski 
-To: Matt Simmons 
-@key{CTRL-D}
-@end example
-
-If the invoking user is Jamie Zawinski, the record for Matt Simmons (if
-any) will be displayed.  If the invoking user is not Jamie Zawinski, the
-record for Jamie Zawinski (if any) will be displayed.
-
-As mentioned above @code{bbdb-srv} can be used with Netscape Mail and
-Netscape News.  Please note that it can only be used with the UNIX
-versions 3.0b2 and greater of these applications.  To allow Netscape to
-use @code{bbdb-srv}, set the @samp{NS_MSG_DISPLAY_HOOK} variable to
-@code{bbdb-srv.pl}@footnote{Use the full path to @code{bbdb-srv.pl} if
-it is not in the default path.} as follows:
-
-@noindent
-Bourne Shell (@file{/bin/sh}) and variants:
-@example
-# NS_MSG_DISPLAY_HOOK bbdb-srv.pl
-# export NS_MSG_DISPLAY_HOOK
-@end example
-
-@noindent
-C-Shell (@file{/bin/csh}) and variants:
-@example
-% setenv NS_MSG_DISPLAY_HOOK bbdb-srv.pl
-@end example
-
-The following variables can be used to customize the behavior of
-@code{bbdb-srv}:
-
-@table @code
-@vindex bbdb/srv-auto-create-p
-@item bbdb/srv-auto-create-p
-This variable is similar to @code{bbdb/news-auto-create-p} and
-@code{bbdb/mail-auto-create-p}.  That is, when headers are passed in to
-@code{bbdb-srv}, a new @b{BBDB} record can be created if none exists,
-depending on the value of this variable.  Possible values are:
-@table @asis
-@item @code{t}
-Automatically create new @b{BBDB} records if the headers passed in do
-not correspond to an already-existing record.
-@item @code{nil}
-Do not automatically create new @b{BBDB} records.
-@item @var{FUNCTION}
-@var{FUNCTION} is called.  If it returns @code{t}, a record will be
-created for the person named in the @samp{From:} header.  If it returns
-@code{nil}, no record will be created.
-
-A suggested function for use is
-@code{bbdb/srv-auto-create-mail-news-dispatcher}.  This function will
-attempt to determine the source of the passed headers - whether they
-were part of a mail message or of a news article.  The action (if any)
-dictated by the value of either @code{bbdb/mail-auto-create-p} or
-@code{bbdb/news-auto-create-p}, based on the determined source of the
-passed headers.
-
-@end table
-
-@vindex bbdb/srv-display-delay
-@item bbdb/srv/display-delay
-@code{bbdb-srv} pauses between displaying the records corresponding to
-each passed set of headers.  This variable controls the length of time
-(in seconds) of the delay between the display of different records.
-Note when setting this variable that only one set of headers can be
-queued at a time.  If three sets of headers are passed to
-@code{bbdb-srv} in less than the delay time, only the first and last
-will be displayed.
-@end table
-
-@node Internals, Mailing Lists, Utilities, Top
-@section Internals
-
-@b{This section is currently a dumping ground for things that should
-eventually go here, but were found elsewhere in the file.}
-
-@b{INFORMATION IN THIS SECTION IS FOR INFORMATIONAL PURPOSES ONLY.  IT
-SHOULD NOT BE TAKEN AS DOCUMENTATION OF AN EXTERNAL API.  EVERYTHING
-LISTED BELOW IS SUBJECT TO CHANGE WITHOUT NOTICE}
-
-The first time you use
-one of the @b{BBDB} commands, this file is read into an emacs buffer, and
-remains there.  As you make changes to the database, this buffer is
-changed as well, ensuring that if it is auto-saved, it will be saved in
-its most current state. @refill
-
-@subsection BBDB data file format
-
-The data file is arranged in a hierarchical fashion.  At the top level
-are vectors, with one vector per database record.  It is @b{very}
-important that each vector be on its own line, as the BBDB builds and
-stores markers based on this layout.  The markers are then used to
-increase the speed of database modifications (more on this later).  The
-record vectors contain the individual fields of the record.  These
-fields can be of any type, but are currently integers, strings, lists of
-strings, alists, vectors, or lists of vectors.  In the case of fields
-that contain one or more vectors, they can be further broken down in
-terms of the fields of their component vectors.
-
-In an effort to provide a more concrete example to illustrate the above,
-and to provide a reference for database accessor and modifier functions,
-we describe the database format below.  This description starts with the
-fields of the individual record vectors, and drills down through the
-vectors used by some of the fields.
-
-@subsubsection Record Vectors
-
-@multitable @columnfractions .13 .19 .36 .32
-@item @b{Name}
-@tab  @b{Type}
-@tab  @b{Accessor and Modifier}
-@tab  @b{Description}
-
-@item First name
-@tab  String
-@tab  @code{bbdb-record-firstname}@*
-      @code{bbdb-record-set-firstname}
-@tab  Entity's first name
-
-@item Last name
-@tab  String
-@tab  @code{bbdb-record-lastname}@*
-      @code{bbdb-record-set-lastname}
-@tab  Entity's last name
-
-@item AKAs
-@tab  List of Strings
-@tab  @code{bbdb-record-aka}@*
-      @code{bbdb-record-set-aka}
-@tab  Alternate names for entity
-
-@item Company
-@tab  String
-@tab  @code{bbdb-record-company}@*
-      @code{bbdb-record-set-company}
-@tab  Company with which entity is associated
-
-@item Phones
-@tab  List of Vectors
-@tab  @code{bbdb-record-phones}@*
-      @code{bbdb-record-set-phones}
-@tab  List of phone number vectors
-
-@item Addresses
-@tab  List of Vectors
-@tab  @code{bbdb-record-addresses}@*
-      @code{bbdb-record-set-addresses}
-@tab  List of address vectors
-
-@item Net address
-@tab  List of Strings
-@tab  @code{bbdb-record-net}@*
-      @code{bbdb-record-set-net}
-@tab  List of network addresses
-
-@item Notes
-@tab  String or Alist
-@tab  @code{bbdb-record-raw-notes}@*
-      @code{bbdb-record-set-raw-notes}
-@tab  String or Association list of note fields (strings)
-
-@item Cache
-@tab  Vector
-@tab  @code{bbdb-record-cache}@*
-      @code{bbdb-record-set-cache}
-@tab  Record cache.@*
-      @i{Internal version only.}
-
-@end multitable
-
-The phone, address and cache vector fields are described below.  Please
-note that, as indicated in the table above, the cache is present only in
-the internal version of the database - it is not written out as part of
-the @file{.bbdb} file.
-
-In addition, the accessor and modifier functions for the notes alist
-are described.
-
-@subsubsection Phone Vectors
-
-To access the fields in the below table, you must first get the list of
-phone vectors using the @code{bbdb-record-phones} function.  Note that
-if you alter the phones field with the @code{bbdb-record-set-phones}
-function, you are altering the entire phones list for the given record.
-Use the modifier functions below for modifications to individual phone
-vectors.
-
-@multitable @columnfractions .13 .19 .36 .32
-@item @b{Name}
-@tab  @b{Type}
-@tab  @b{Accessor and Modifier}
-@tab  @b{Description}
-
-@item Location
-@tab  String
-@tab  @code{bbdb-phone-location}@*
-      @code{bbdb-phone-set-location}
-@tab  Phone number identifier
-
-@item Area
-@tab  Integer
-@tab  @code{bbdb-phone-area}@*
-      @code{bbdb-phone-set-area}
-@tab  Area code for phone number
-
-@item Exchange
-@tab  Integer
-@tab  @code{bbdb-phone-exchange}@*
-      @code{bbdb-phone-set-exchange}
-@tab  Exchange (aka prefix) for phone number
-
-@item Suffix
-@tab  Integer
-@tab  @code{bbdb-phone-suffix}@*
-      @code{bbdb-phone-set-suffix}
-@tab  Suffix for phone number
-
-@item Extension
-@tab  Integer
-@tab  @code{bbdb-phone-extension}@*
-      @code{bbdb-phone-set-extension}
-@tab  Phone number extension (@samp{0} if none)
-
-@end multitable
-
-@subsubsection Address Vectors
-
-To access the fields in the below table, you must first get the list of
-address vectors using the @code{bbdb-record-addresses} function.  Note
-that if you alter the addresses field with the
-@code{bbdb-record-set-addresses} function, you are altering the entire
-addresses list for the given record.  Use the modifier functions below
-for modifications to individual address vectors.
-
-@multitable @columnfractions .13 .19 .36 .32
-@item @b{Name}
-@tab  @b{Type}
-@tab  @b{Accessor and Modifier}
-@tab  @b{Description}
-
-@item Location
-@tab  String
-@tab  @code{bbdb-address-location}@*
-      @code{bbdb-address-set-location}
-@tab  Address identifier
-
-@item Streets
-@tab  List
-@tab  @code{bbdb-address-streets}@*
-      @code{bbdb-address-set-streets}
-@tab  List of street address lines.  @code{nil} if none.
-
-@item Street3
-@tab  String
-@tab  @code{bbdb-address-street3}@*
-      @code{bbdb-address-set-street3}
-@tab  Third line of street address.  ``'' if none.
-
-@item City
-@tab  String
-@tab  @code{bbdb-address-city}@*
-      @code{bbdb-address-set-city}
-@tab  City name
-
-@item State
-@tab  String
-@tab  @code{bbdb-address-state}@*
-      @code{bbdb-address-set-state}
-@tab  State abbreviation
-
-@item Zip
-@tab  Integer (american)
-      List (non-american)
-@tab  @code{bbdb-address-zip}@*
-      @code{bbdb-address-set-zip}
-@tab  Zip code
-
-@item Country
-@tab String
-@tab @code{bbdb-address-country}@*
-     @code{bbdb-address-set-country}
-@tab Country
-
-@end multitable
-
-@subsubsection Cache Vector
-
-This vector is present only in the internal database representation.  It
-is not written out to the database file because it contains information
-aggregated from the rest of the record that is reconstructed when the
-database is read.  To write the cache information to the database file
-would increase the risk of database inconsistency, and would violate the
-principles of normalization.
-
-To access the cache fields using the functions listed below that begin
-with @code{bbdb-cache-}, you must first get the cache vector using the
-@code{bbdb-record-cache} function.  The functions that begin with
-@code{bbdb-record-} get the cache vector internally.  Note that if you
-alter the cache field in the high-level record with the
-@code{bbdb-record-set-cache} function, you are altering the entire cache
-vector for the given record.  Use the modifier functions below for
-modifications to individual cache fields.
-
-@multitable @columnfractions .15 .17 .36 .32
-@item @b{Name}
-@tab  @b{Type}
-@tab  @b{Accessor and Modifier}
-@tab  @b{Description}
-
-@item Name Cache
-@tab  String
-@tab  @code{bbdb-cache-namecache}@*
-      @code{bbdb-cache-set-namecache}
-@tab  Preconcatenated name of entity
-
-@item Sort Key
-@tab  String
-@tab  @code{bbdb-cache-sortkey}@*
-      @code{bbdb-cache-set-sortkey}
-@tab  Preconcatenated sort key for record
-
-@item Marker
-@tab  Marker
-@tab  @code{bbdb-cache-marker}@*
-      @code{bbdb-record-marker}@*
-      @code{bbdb-cache-set-marker}@*
-      @code{bbdb-record-set-marker}@*
-@tab  Marker in @file{.bbdb} for start of record
-
-@item Deleted
-@tab  Boolean
-@tab  @code{bbdb-cache-deleted-p}@*
-      @code{bbdb-record-deleted-p}@*
-      @code{bbdb-cache-set-deleted-p}@*
-      @code{bbdb-record-set-deleted-p}
-@tab  Set to @code{t} if record has been deleted, @code{nil} if not
-
-@end multitable
-
-The functions listed above will return @code{nil} if their respective
-cache fields are not set.  The functions listed below will return the
-value of their cache fields if set, but will also build (and set) the
-correct field values if the fields are unset:
-
-@table @code
-@item bbdb-record-name
-Return the name in the Name Cache field of the cache (if set).  If
-the name has not been built yet (if the field is @code{nil}), the name is
-built, stored in the Name Cache field, and returned.
-
-@item bbdb-record-sortkey
-Return the name it the Sort Key field of the cache (if set).  If the
-Sort Key field has not yet been set (if the field is @code{nil}), the
-Sort Key is built, stored in the Sort Key field, and returned.
-
-@end table
-
-@subsubsection Notes String or Alist
-
-If there is only a single note for a given record, the notes field for
-that record will be a string.  If there is more than one note, the notes
-field will be an association list (alist) with elements of the form
-
-@center ( @var{NAME} . @var{VALUE} )
-
-@noindent
-where @var{NAME} is the symbol for the name of the note, and
-@var{VALUE} is the value of the note.
-
-@subsubsection Example BBDB record
-
-@node Mailing Lists, Changes, Internals, Top
-@section Mailing Lists
-
-(If you are looking for a way to create mailing lists with @b{BBDB}, you
-should be looking at the section on @xref{Mail Sending Interfaces}.)
-
-There are three mailing lists for the @b{BBDB}.
-@code{bbdb-info@@lists.sourceforge.net} gets moderate traffic, and is
-intended for the discussion and distribution of development versions of
-the @b{BBDB}. Users of development versions of the @b{BBDB} should be
-subscribed to this list. It is also to this list that bugs should be
-reported. @xref{Known Bugs}. for instructions on submitting bug reports.
-
-The second mailing list @code{bbdb-announce@@lists.sourceforge.net} has
-very low volume. Any user of the @b{BBDB} should consider subscribing to
-this list, as new releases and security issues will be posted here.
-
-A third mailing list, @code{bbdb-cvs@@lists.sourceforge.net}, is
-intended for developers to follow the changes made to the @b{BBDB}
-development version. Developers of the @b{BBDB} should consider to
-subscribe to this list.
-
-@node Changes, The Latest Version, Mailing Lists, Top
-@section Changes in this Version
-
-@menu
-* Major Changes::                Major changes in this version
-* Other Changes::                Not-so-major changes
-@end menu
-
-@node Major Changes, Other Changes, Changes, Changes
-@subsection Major Changes
-
-@subsubheading Database File Version Change
-
-(the following version-migration text will move in a future version.  It is in
-this section currently because new users will likely not experience it)
-
-There has been a version change in the @b{BBDB} database file.  The new
-version supports non-US zip codes, and an additional ``Country'' field
-in addresses.
-
-An automatic version-migration mechanism has been implemented that allows
-older version @file{.bbdb} files to either be migrated to the new version, or
-used as-is without migrating.  When the @b{BBDB} detects a database file with
-an old version, it will display the features that have been introduced @b{in
-the database file} from the time of the older version's implementation.  It
-will offer the choice of migration or use of the @b{BBDB} with the
-older-version file.
-
-If migration is chosen, the database file will be automatically changed to the
-new format.  If migration is declined, the file will kept in the older format
-in the @code{.bbdb} buffer, but will be stored internally in the new format.
-When changes need to be made to the @code{.bbdb} buffer, changed records will
-be reverse-migrated from their internal version to that of the disk file.
-
-@node Other Changes,  , Major Changes, Changes
-@subsection Other Changes
-
-@subsubheading TeX Output
-
-By default, ec fonts are used for TeX output instead of cm fonts. With
-the @code{ps-fonts} option set in @code{bbdb-print-alist}, TimesNewRoman
-and Courier fonts are used.
-
-@itemize @bullet
-@end itemize
-
-@node The Latest Version, The Future, Changes, Top
-@section The Latest Version
-
-@noindent
-Released versions of the @b{BBDB} can be found at the
-following site:
-
-@itemize @bullet
-@item
-WWW: @code{http://bbdb.sourceforge.net}
-@item
-FTP: @code{ftp://ftp.sourceforge.net/pub/bbdb}
-@end itemize
-
-@noindent
-Development versions of the @b{BBDB} can be obtained in the
-following ways:
-
-@itemize @bullet
-@item
-WWW: @code{http://bbdb.sourceforge.net}
-@item
-Anonymous CVS: See @code{http://bbdb.sourceforge.net} for instructions.
-@end itemize
-
-Users of development versions of the @b{BBDB} should subscribe to the
-@code{bbdb-info} mailing list.  @xref{Mailing Lists}.
-
-@node The Future,  , The Latest Version, Top
-@section The Future
-
-The future consists of Bugs and Features.
-
-@menu
-* Known Bugs::          Known Bugs, and how to submit new ones
-* TODO List::           The TODO List
-* EOL Statements::      EOL (End Of Life) Statements
-@end menu
-
-@node Known Bugs, TODO List, The Future, The Future
-@subsection Known Bugs
-
-@enumerate
-@item
-@b{@kbd{M-TAB} conflicts with ispell.}  Workaround: The binding
-installed by the @b{BBDB} for address completion/expansion conflicts with
-that used by ispell.  The suggested workarounds are to rebind the ispell
-key (the @b{BBDB} binding is not configurable at this time), to manually
-invoke ispell via @kbd{M-x}, or to not use ispell completion functionality
-in @b{BBDB}-enabled message composition buffers. The following is an
-example of such a rebinding, supplied by Kai Großjohan:
-
-@lisp
-(defun my-message-mode-keys ()
-  (define-key message-mode-map (kbd "M-TAB") 'bbdb-complete-name))
-  (add-hook 'message-mode-hook 'my-message-mode-keys)
-@end lisp
-
-@item
-@b{@b{BBDB} and abbrev expansion is inconsistent.}  Workaround:
-Currently, @kbd{M-TAB} must be used to expand/complete against @b{BBDB}
-names and net addresses, and @kbd{TAB} must be used to expand abbrevs (the
-values in the @code{mail-alias} field).  Unification is planned for a
-future version.
-
-@item
-@b{The @code{*BBDB*} buffer does not always come up when the first
-article in a Gnus Summary Buffer is selected.}  Workaround:  Pressing
-@kbd{g} to reload the article.  This will cause the @code{*BBDB*} buffer
-to be displayed.
-
-@item
-@b{Expansion will fail when the name to be expanded is a subset of
-the name for another record.}  For example, if you have entries for
-@samp{John} and @samp{Johnathan}, you will not be able to expand the
-name for @samp{John}.  Workaround:  Use the net address for the subset
-name (@samp{John} in this example).
-
-@end enumerate
-
-@cindex Bug Reports
-It is commonly known that there are no bugs in the @b{BBDB}. Bugs
-found in defiance of this rule should be submitted using @kbd{M-x
-bbdb-submit-bug-report}.  These bug reports will bbe sent to the
-@code{bbdb-info} mailing list (@pxref{Mailing Lists}) and are
-available from public archives.  Other big brothers may be reading
-your bug reports.
-
-@node TODO List, EOL Statements, Known Bugs, The Future
-@subsection TODO List
-
-@subsubheading The Near Future
-
-@itemize @bullet
-@item
-Add bbdb/@i{MUA}-delete-sender-record
-
-@item
-Configurable completion.  Should allow user to specify "complete on
-names first, then nets", etc.
-
-@item
-More variables for upgrading.  Specifically a variable that lets users
-specify extra fields for upgrading (an alist @samp{(a . b)} that says
-field @samp{a} should be upgraded the same way as field @samp{b}.
-
-@item
-Change all functions that switch on MUAs to use compose-mail (ex:
-@code{bbdb-send-mail-internal}).
-
-@item
-Soren Dayton's method for generically extending the @b{BBDB} with
-special-purpose fields
-
-@item
-Sorting records on alternate keys.  @code{bbdb-sort-by} from Boris
-Goldowsky.
-@c nnml:bbdb-maint
-
-@item
-Sorting individual types of fields - Sam Steingold's method.
-
-@item
-Button 3 menus (Mark Moll and Soren Dayton)
-
-@c @item
-@c @b{BBDB}-controlled mail splitting in Gnus.  Add hook for Soren to make
-@c splitting better.  Routine from Brian Edmonds.
-@c Anyone have contact info for Soren Dayton?
-
-@item
-Conditionalized erasure of properties when text is pasted into the @b{BBDB}.
-
-@item
-Should notice when there are @samp{Reply-To:} addresses.@refill
-
-@item
-Should have a command for merging together two divergent copies of
-a @file{.bbdb} file (in case you read mail on one machine and news on
-another, for instance.)@refill
-
-@item
-The @samp{*BBDB*} buffer should be resized to exactly fit what it's
-displaying, even when not in ``electric'' mode.@refill
-
-@item
-It should be possible to do completion on last names as well as first
-names.@refill
-
-@item
-The BBDB buffer is left at the top of the stack when GNUS is exited
-because GNUS runs its exit-hooks too early.  This should be fixed.@refill
-
-@item
-String area codes (German area codes can begin with zeroes) patch from
-@code{Michael Sperber }
-
-@c @item
-@c Internationalization of addresses.  Country code to control formats for
-@c printing, etc.  Country->Format mapping.
-
-@item
-Default country variable, similar to @code{bbdb-default-area-code}.
-
-@item
-Make format self-describing in comment
-
-@item
-ISO-8859-x characters in records for printing.
-
-@item
-Prefix for @kbd{W} (@code{bbdb-www}) command to allow selection of
-different addresses.
-
-@item
-Generalized buttons (via extents) for fields.  Example: @samp{(a . b)}
-means create button that calls @samp{b} for each entry in the @samp{a}
-field.
-
-@item
-Remove support for GNUS.  Start with lisp Makefile (remove nntp and gnus
-loads).
-
-@item
-More flexible auto-addition.  Conditionalizing of addition (conditions
-or supplied function).  Prompt if multiple records that meet criteria exist.
-
-@item
-Different output formats.  See Toby Speight's @code{}
-and Bin Mu's @code{<199801221605.KAA23663@@DerivaTech.Com>}.
-
-@item
-Generalized area-code-split program that could split, for example, based
-on input copied (or straight fetch of page) from the Bellcore NANP page.
-
-@item
-Print multivalue (comma-separated) fields with one value per line
-
-@item
-Easier BBDB extension.  See @code{}
-from Soren Dayton.
-
-@item
-Take birthdays from the @b{BBDB}, add them to calendar.  From Boris
-Goldowsky.
-@c In nnml:bbdb-maint
-
-@item
-Make mail aliases file for other mailers.  From Boris Goldowsky.
-@c In nnml:bbdb-maint
-
-@item
-Various patches from Boris Goldowsky in @file{bbdb-ext}.
-
-@item
-Various other patches:
-@itemize @minus
-@item
-@code{bbdb-filters-0.2}
-@item
-@code{bbdb-frame.el}
-@item
-@code{bbdb-letter-1.0}
-@item
-@code{bbdb-plz}
-@item
-@code{bbdb-query}
-@item
-@code{country}
-@item
-@code{country-info}
-@end itemize
-@noindent
-Note that these files have not been investigated.  They may or
-may not be incorporated.
-
-@item
-Ability to remove all properties from copied strings.
-
-@end itemize
-
-
-@subsubheading Not-So-Near Future
-
-@itemize @bullet
-@item
-Fix Gnus scoring so it rebuilds when gnus-score disappears
-
-@item
-Multiline note fields
-
-@item
-Change key to be some kind of unique number
-
-@item
-There should be better support for non-American addresses and phone
-numbers.  This might be Near Future if somebody volunteers to send me patches.
-
-@item
-Should reimplement ``electric'' mode to not be so broken.@refill
-
-@item
-The @kbd{*C-o} keystroke should add a field to all displayed records.
-Perhaps @kbd{*;} should append some text to an arbitrary field of all
-displayed records. @refill
-
-@item
-Multiple @file{.bbdb} files with precedence relationships.  See Wes
-Hardaker's @*@code{}
-
-@item
-Automatically grab information about a person from their sig.  See
-Graham Clark's @code{info-bbdb} post
-@code{<6282.199706161624@@havra.dcs.ed.ac.uk>} and Adrian Aichner's
-@code{info-bbdb} post
-@code{}.  Would like to have
-@code{bbdb-snarf} attack the sig then compare the snarfed data with the
-header data.
-
-@end itemize
-
-@subsubheading Thoughts
-
-@itemize @bullet
-@item
-Are there enough hooks?
-
-@item
-The interfaces should share more code. @refill
-
-@item
-The @code{bbdb-create-internal} function should be more forgiving.@refill
-
-@item
-More @kbd{*} commands in general, including @kbd{*d}.
-@end itemize
-
-@node EOL Statements,  , TODO List, The Future
-@subsection End of Life (EOL) Statements
-
-The items in the following list describe items for which support will be
-removed in coming versions of the @b{BBDB}.  The items listed are
-guaranteed to be supported and present only until the EOL date.  They
-may be removed without warning at any time thereafter.
-
-@enumerate
-@item
-@code{advertized-bbdb-delete-current-field-or-record}@*
-Support for this function will be removed for version 2.2.  It is
-recommended that all code depending on this variable be switched to use
-@code{bbdb-delete-current-field-or-record}.  The two functions have the
-same calling conventions and effects.  This EOL statement was added for
-version 2.1.
-
-@item
-Support for the GNUS (not Gnus) newsreader@*
-The GNUS-specific parts of the @b{BBDB} will be actively removed for the
-2.2 release.  No further maintenance and/or bugfixes are planned for
-GNUS code at this time.  This EOL statement was added for version 2.1.
-@end enumerate
-
-@node Thanks,  , , Top
-@section Thanks
-
-Thanks to everyone on the info-bbdb mailing list for many useful
-suggestions. This hack would be far less insidious without their input!
-
-@subheading Thanks list for versions after 2.00.06.
-@c I'm trying to include as many code contributors as possible here. It
-@c doesn't happen without your help!
-
-Thanks to Alex Schroeder, Ronan Waide, Thomas DeWeese, Robert Fenk,
-Didier Verna, Bill Carpenter.
-
-@subheading Thanks list for versions after 1.51 prior to and including 2.00.06.
-
-Thanks to Adrian Aichner, Kees de Bruin, David Carlton, Soren Dayton,
-Brian Edmonds, Boris Goldowsky, Seth Golub, John Heidemann, Christopher
-Kline, Carsten Leonhardt, Hrvoje Niksic, Jens-Ulrik Hoger Petersen,
-Colin Rafferty, Matt Simmons, Sam Steingold, Marco Walther, Christoph
-Wedler.
-
-@subheading Thanks list for versions prior to and including 1.51.
-
-And special thanks to Sebastian Kremer, Joe Wells, Todd Kaufmann, Andy
-Norman, Ivan Vazquez, Stewart Clamen, Roland McGrath, Dave Brennan,
-Kimball Collins, Dirk Grunwald, Philippe Queinnec, Boris Putanec, Dave
-Disser, Francois Felix Ingrand, Sean Owens, Guido Bosch, Lance Brown,
-Tom Emerson, George Hartzell, Luis Miguel Silveira, Kimmo Suominen,
-Derek Upham, David Zuhn, Rod Whitby, Richard Mlynarik.
-
-Last, but not least, thanks to Jamie Zawinski for writing @b{BBDB} in the
-first place.
-
-@ifinfo
-@node _,,,(dir)
-@unnumbered _
-@example
-in.sid.i.ous aj   \in-'sid-e-*s\
-   [L insidiosus, fr. insidiae ambush, fr. insidere to sit in, sit on,
-      fr. in- + sedere to sit -- more at SIT]
-     1  a : awaiting a chance to entrap  TREACHEROUS
-        b : harmful but enticing  SEDUCTIVE
-     2  a : having a gradual and cumulative effect  SUBTLE
-        b of a disease
-          : developing so gradually as to be well established before
-            becoming apparent
-  in.sid.i.ous.ly av
-  in.sid.i.ous.ness n
-@end example
-
-
-
-@menu
-* Top::
-@end menu
-
-@end ifinfo
-
-@node Concept Index, Variable Index,, Top
-@unnumbered Concept Index
-@printindex cp
-
-@node Variable Index,  , Concept Index, Top
-@unnumbered Variable Index
-@printindex vr
-
-@contents
-@bye
diff --git a/xemacs-packages/man/ediff/ediff.texi b/xemacs-packages/man/ediff/ediff.texi
deleted file mode 100644
index a76abd45..00000000
--- a/xemacs-packages/man/ediff/ediff.texi
+++ /dev/null
@@ -1,2530 +0,0 @@
-\input texinfo                  @c -*-texinfo-*-
-@c documentation for Ediff
-@c Written by Michael Kifer
-
-@comment %**start of header (This is for running Texinfo on a region.)
-
-@comment Using ediff.info instead of ediff in setfilename breaks DOS.
-@comment @setfilename ediff
-@comment @setfilename ediff.info
-@setfilename ../info/ediff
-
-@settitle Ediff User's Manual
-@synindex vr cp
-@synindex fn cp
-@synindex pg cp
-@synindex ky cp
-
-@iftex
-@finalout
-@end iftex
-@c      @smallbook
-@comment %**end of header (This is for running Texinfo on a region.)
-
-@copying
-This file documents Ediff, a comprehensive visual interface to Unix diff
-and patch utilities.
-
-Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-   2003, 2004, 2005, 2006 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU
-Manual'', and with the Back-Cover Texts as in (a) below.  A copy of the
-license is included in the section entitled ``GNU Free Documentation
-License'' in the Emacs manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software.  Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License.  If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-@end quotation
-@end copying
-
-@dircategory Editors
-@direntry
-* Ediff: (ediff).       A visual interface for comparing and merging programs.
-@end direntry
-
-@titlepage
-@title Ediff User's Manual
-@sp 4
-@subtitle Ediff version 2.76.1
-@sp 1
-@subtitle January 2002
-@sp 5
-@author Michael Kifer
-@page
-
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-
-@node Top, Introduction, (dir), (dir)
-
-
-@menu
-* Introduction::                About Ediff.
-* Major Entry Points::          How to use Ediff.
-* Session Commands::            Ediff commands used within a session.
-* Registry of Ediff Sessions::  Keeping track of multiple Ediff sessions.
-* Session Groups::              Comparing and merging directories.
-* Remote and Compressed Files::  You may want to know about this.
-* Customization::               How to make Ediff work the way YOU want.
-* Credits::                     Thanks to those who helped.
-* Index::
-@end menu
-
-@node Introduction, Major Entry Points, Top, Top
-@chapter Introduction
-
-@cindex Comparing files and buffers
-@cindex Merging files and buffers
-@cindex Patching files and buffers
-@cindex Finding differences
-
-Ediff provides a convenient way for simultaneous browsing through
-the differences between a pair (or a triple) of files or buffers
-(which are called @samp{variants} for our purposes).  The
-files being compared, file-A, file-B, and file-C (if applicable) are
-shown in separate windows (side by side, one above the another, or in
-separate frames), and the differences are highlighted as you step
-through them.  You can also copy difference regions from one buffer to
-another (and recover old differences if you change your mind).
-
-Another powerful feature is the ability to merge a pair of files into a
-third buffer.  Merging with an ancestor file is also supported.
-Furthermore, Ediff is equipped with directory-level capabilities that
-allow the user to conveniently launch browsing or merging sessions on
-groups of files in two (or three) different directories.
-
-In addition, Ediff can apply a patch to a file and then let you step through
-both files, the patched and the original one, simultaneously,
-difference-by-difference.  You can even apply a patch right out of a mail
-buffer, i.e., patches received by mail don't even have to be saved.  Since
-Ediff lets you copy differences between variants, you can, in effect, apply
-patches selectively (i.e., you can copy a difference region from
-@file{file.orig} to @file{file}, thereby undoing any particular patch that
-you don't like).
-
-Ediff even understands multi-file patches and can apply them interactively!
-(Ediff can recognize multi-file patches only if they are in the context
-format or GNU unified format.  All other patches are treated as 1-file
-patches.  Ediff is [hopefully] using the same algorithm as @code{patch} to
-determine which files need to be patched.)
-
-Ediff is aware of version control, which lets you compare
-files with their older versions.  Ediff also works with remote and
-compressed files, automatically ftp'ing them over and uncompressing them.
-@xref{Remote and Compressed Files}, for details.
-
-This package builds upon ideas borrowed from Emerge, and several of Ediff's
-functions are adaptations from Emerge.  Although Ediff subsumes and greatly
-extends Emerge, much of the functionality in Ediff is influenced by Emerge.
-The architecture and the interface are, of course, drastically different.
-
-@node Major Entry Points, Session Commands, Introduction, Top
-@chapter Major Entry Points
-
-When Ediff starts up, it displays a small control window, which accepts the
-Ediff commands and two or three windows displaying the files to be compared
-or merged. The control window can be in its own small frame or it can be
-part of a bigger frame that displays other buffers. In any case, it is
-important that the control window be active (i.e., be the one receiving the
-keystrokes) when you use Ediff. You can switch to other Emacs buffers at
-will and even edit the files currently being compared with Ediff and then
-switch back to Ediff at any time by activating the appropriate Emacs windows.
-
-Ediff can be invoked interactively using the following functions, which can
-be run either from the minibuffer or from the menu bar.  In the menu bar,
-all Ediff's entry points belong to three submenus of the Tools menu:
-Compare, Merge, and Apply Patch.
-
-@table @code
-@item ediff-files
-@itemx ediff
-@findex ediff-files
-@findex ediff
-Compare two files.
-
-@item ediff-backup
-@findex ediff-backup
-Compare a file with its backup. If there are several numerical backups, use
-the latest. If the file is itself a backup, then compare it with its
-original.
-
-@item ediff-buffers
-@findex ediff-buffers
-Compare two buffers.
-
-@item ediff-files3
-@itemx ediff3
-@findex ediff-files3
-@findex ediff3
-Compare three files.
-
-@item ediff-buffers3
-@findex ediff-buffers3
-Compare three buffers.
-
-@item edirs
-@itemx ediff-directories
-@findex edirs
-@findex ediff-directories
- Compare files common to two directories.
-@item edirs3
-@itemx ediff-directories3
-@findex edirs3
-@findex ediff-directories3
- Compare files common to three directories.
-@item edir-revisions
-@itemx ediff-directory-revisions
-@findex ediff-directory-revisions
-@findex edir-revisions
- Compare versions of files in a given directory.  Ediff selects only the
-files that are under version control.
-@item edir-merge-revisions
-@itemx ediff-merge-directory-revisions
-@findex edir-merge-revisions
-@findex ediff-merge-directory-revisions
- Merge versions of files in a given directory.  Ediff selects only the
-files that are under version control.
-@item edir-merge-revisions-with-ancestor
-@itemx ediff-merge-directory-revisions-with-ancestor
-@findex edir-merge-revisions-with-ancestor
-@findex ediff-merge-directory-revisions-with-ancestor
- Merge versions of files in a given directory using other versions as
-ancestors.  Ediff selects only the files that are under version control.
-
-@item ediff-windows-wordwise
-@findex ediff-windows-wordwise
-Compare windows word-by-word.
-
-@item ediff-windows-linewise
-@findex ediff-windows-linewise
-Compare windows line-by-line.
-
-@item ediff-regions-wordwise
-@findex ediff-regions-wordwise
-Compare regions word-by-word.  The regions can come from the same buffer
-and they can even overlap.  You will be asked to specify the buffers that
-contain the regions, which you want to compare. For each buffer, you will
-also be asked to mark the regions to be compared. Pay attention to the
-messages that appear in the minibuffer.
-
-@item ediff-regions-linewise
-@findex ediff-regions-linewise
-Similar to @code{ediff-windows-linewise}, but compares the regions
-line-by-line. See @code{ediff-windows-linewise} for more details.
-
-@item ediff-revision
-@findex ediff-revision
- Compare versions of the current buffer, if the buffer is visiting
- a file under version control.
-
-@item ediff-patch-file
-@itemx epatch
-@findex ediff-patch-file
-@findex epatch
-
-Patch a file or multiple files, then compare.  If the patch applies to just
-one file, Ediff will invoke a regular comparison session.  If it is a
-multi-file patch, then a session group interface will be used and the user
-will be able to patch the files selectively.  @xref{Session Groups}, for
-more details.
-
-Since the patch might be in a buffer or a file, you will be asked which is
-the case. To avoid this extra prompt, you can invoke this command with a
-prefix argument.  With an odd prefix argument, Ediff assumes the patch
-is in a file; with an even argument, a buffer is assumed.
-
-Note that @code{ediff-patch-file} will actually use the @code{patch}
-utility to change the original files on disk.  This is not that
-dangerous, since you will always have the original contents of the file
-saved in another file that has the extension @file{.orig}.
-Furthermore, if the file is under version control, then you can always back
-out to one of the previous versions (see the section on Version Control in
-the Emacs manual).
-
-@code{ediff-patch-file} is careful about versions control: if the file
-to be patched is checked in, then Ediff will offer to check it out, because
-failing to do so may result in the loss of the changes when the file is
-checked out the next time.
-
-If you don't intend to modify the file via the patch and just want to see
-what the patch is all about (and decide later), then
-@code{ediff-patch-buffer} might be a better choice.
-
-@item ediff-patch-buffer
-@itemx epatch-buffer
-@findex ediff-patch-buffer
-@findex epatch-buffer
-Patch a buffer, then compare.  The buffer being patched and the file visited
-by that buffer (if any) is @emph{not} modified.  The result of the patch
-appears in some other buffer that has the name ending with @emph{_patched}.
-
-This function would refuse to apply a multifile patch to a buffer.  Use
-@code{ediff-patch-file} for that (and when you want the original file to be
-modified by the @code{patch} utility).
-
-Since the patch might be in a buffer or a file, you will be asked which is
-the case. To avoid this extra prompt, you can invoke this command with a
-prefix argument.  With an odd prefix argument, Ediff assumes the patch
-is in a file; with an even argument, a buffer is assumed.
-
-@item ediff-merge-files
-@itemx ediff-merge
-@findex ediff-merge-files
-@findex ediff-merge
-Merge two files.
-
-@item ediff-merge-files-with-ancestor
-@itemx ediff-merge-with-ancestor
-@findex ediff-merge-files-with-ancestor
-@findex ediff-merge-with-ancestor
-Like @code{ediff-merge}, but with a third ancestor file.
-
-@item ediff-merge-buffers
-@findex ediff-merge-buffers
-Merge two buffers.
-
-@item ediff-merge-buffers-with-ancestor
-@findex ediff-merge-buffers-with-ancestor
-Same but with ancestor.
-
-
-@item edirs-merge
-@itemx ediff-merge-directories
-@findex edirs-merge
-@findex ediff-merge-directories
- Merge files common to two directories.
-@item edirs-merge-with-ancestor
-@itemx ediff-merge-directories-with-ancestor
-@findex edirs-merge-with-ancestor
-@findex ediff-merge-directories-with-ancestor
- Same but using files in a third directory as ancestors.
- If a pair of files doesn't have an ancestor in the ancestor-directory, you
- will still be able to merge them without the ancestor.
-
-@item ediff-merge-revisions
-@findex ediff-merge-revisions
-Merge two versions of the file visited by the current buffer.
-
-@item ediff-merge-revisions-with-ancestor
-@findex ediff-merge-revisions-with-ancestor
-Same but with ancestor.
-
-@item ediff-documentation
-@findex ediff-documentation
-Brings up this manual.
-
-@item ediff-show-registry
-@itemx eregistry
-Brings up Ediff session registry.  This feature enables you to quickly find
-and restart active Ediff sessions.
-@end table
-
-@noindent
-If you want Ediff to be loaded from the very beginning of your Emacs
-session, you should put this line in your @file{~/.emacs} file:
-
-@example
-(require 'ediff)
-@end example
-
-@noindent
-Otherwise, Ediff will be loaded automatically when you use one of the
-above functions, either directly or through the menus.
-
-When the above functions are invoked, the user is prompted for all the
-necessary information---typically the files or buffers to compare, merge, or
-patch.  Ediff tries to be smart about these prompts.  For instance, in
-comparing/merging files, it will offer the visible buffers as defaults.  In
-prompting for files, if the user enters a directory, the previously input
-file name will be appended to that directory.  In addition, if the variable
-@code{ediff-use-last-dir} is not @code{nil}, Ediff will offer
-previously entered directories as defaults (which will be maintained
-separately for each type of file, A, B, or C).
-@vindex @code{ediff-use-last-dir}
-
-All the above functions use the POSIX @code{diff} or @code{diff3} programs
-to find differences between two files.  They process the @code{diff} output
-and display it in a convenient form.  At present, Ediff understands only
-the plain output from diff.  Options such as @samp{-c} are not supported,
-nor is the format produced by incompatible file comparison programs such as
-the VMS version of @code{diff}.
-
-The functions @code{ediff-files}, @code{ediff-buffers},
-@code{ediff-files3}, @code{ediff-buffers3} first display the coarse,
-line-based difference regions, as reported by the @code{diff} program.  The
-total number of difference regions and the current difference number are
-always displayed in the mode line of the control window.
-
-Since @code{diff} may report fairly large chunks of text as being different,
-even though the difference may be localized to just a few words or even
-to the white space or line breaks, Ediff further @emph{refines} the
-regions to indicate which exact words differ.  If the only difference is
-in the white space and line breaks, Ediff says so.
-
-On a color display, fine differences are highlighted with color; on a
-monochrome display, they are underlined.  @xref{Highlighting Difference
-Regions}, for information on how to customize this.
-
-The commands @code{ediff-windows-wordwise},
-@code{ediff-windows-linewise}, @code{ediff-regions-wordwise} and
-@code{ediff-regions-linewise} do comparison on parts of existing Emacs
-buffers.  The commands @code{ediff-windows-wordwise} and
-@code{ediff-regions-wordwise} are intended for relatively small segments
-of buffers (e.g., up to 100 lines, depending on the speed of your machine),
-as they perform comparison on the basis of words rather than lines.
-(Word-wise comparison of large chunks of text can be slow.)
-
-To compare large regions, use @code{ediff-regions-linewise}.  This
-command displays differences much like @code{ediff-files} and
-@code{ediff-buffers}.
-
-The functions @code{ediff-patch-file} and @code{ediff-patch-buffer} apply a
-patch to a file or a buffer and then run Ediff on the appropriate
-files/buffers, displaying the difference regions.
-
-The entry points @code{ediff-directories}, @code{ediff-merge-directories},
-etc., provide a convenient interface for comparing and merging files in
-different directories.  The user is presented with Dired-like interface from
-which one can run a group of related Ediff sessions.
-
-For files under version control, @code{ediff-revision} lets you compare
-the file visited by the current buffer to one of its checked-in versions.
-You can also compare two checked-in versions of the visited file.
-Moreover, the functions @code{ediff-directory-revisions},
-@code{ediff-merge-directory-revisions}, etc., let you run a group of
-related Ediff sessions by taking a directory and comparing (or merging)
-versions of files in that directory.
-
-@node Session Commands, Registry of Ediff Sessions, Major Entry Points, Top
-@chapter Session Commands
-
-All Ediff commands are displayed in a Quick Help window, unless you type
-@kbd{?} to shrink the window to just one line.  You can redisplay the help
-window by typing @kbd{?} again.  The Quick Help commands are detailed below.
-
-Many Ediff commands take numeric prefix arguments.  For instance, if you
-type a number, say 3, and then @kbd{j} (@code{ediff-jump-to-difference}),
-Ediff moves to the third difference region.  Typing 3 and then @kbd{a}
-(@code{ediff-diff-to-diff}) copies the 3d difference region from variant A
-to variant B.  Likewise, 4 followed by @kbd{ra} restores the 4th difference
-region in buffer A (if it was previously written over via the command
-@kbd{a}).
-
-Some commands take negative prefix arguments as well.  For instance, typing
-@kbd{-} and then @kbd{j} will make the last difference region
-current.  Typing @kbd{-2} then @kbd{j} makes the penultimate difference
-region current, etc.
-
-Without the prefix argument, all commands operate on the currently
-selected difference region.  You can make any difference region
-current using the various commands explained below.
-
-For some commands, the actual value of the prefix argument is
-immaterial.  However, if supplied, the prefix argument may modify the
-command (see @kbd{ga}, @kbd{gb}, and @kbd{gc}).
-
-@menu
-* Quick Help Commands::             Frequently used commands.
-* Other Session Commands::          Commands that are not bound to keys.
-@end menu
-
-@node Quick Help Commands,Other Session Commands,,Session Commands
-@section Quick Help Commands
-
-@table @kbd
-@item ?
-@kindex ?
-Toggles the Ediff Quick Help window ON and OFF.
-@item G
-@kindex G
-Prepares a mail buffer for sending a praise or a curse to the Ediff maintainer.
-
-@item E
-@kindex E
-Brings up the top node of this manual, where you can find further
-information on the various Ediff functions and advanced issues, such as
-customization, session groups, etc.
-
-@item v
-@kindex v
-Scrolls up buffers A and B (and buffer C where appropriate) in a
-coordinated fashion.
-@item V
-@kindex V
-Scrolls the buffers down.
-
-@item <
-@kindex <
-Scrolls the buffers to the left simultaneously.
-@item >
-@kindex >
-Scrolls buffers to the right.
-
-@item wd
-@kindex wd
-Saves the output from the diff utility, for further reference.
-
-With prefix argument, saves the plain output from @code{diff} (see
-@code{ediff-diff-program} and @code{ediff-diff-options}).  Without the
-argument, it saves customized @code{diff} output (see
-@code{ediff-custom-diff-program} and @code{ediff-custom-diff-options}), if
-it is available.
-
-@item wa
-@kindex wa
-Saves buffer A, if it was modified.
-@item wb
-@kindex wb
-Saves buffer B, if it was modified.
-@item wc
-@kindex wc
-Saves buffer C, if it was modified (if you are in a session that
-compares three files simultaneously).
-
-@item a
-@kindex a
-@emph{In comparison sessions:}
-Copies the current difference region (or the region specified as the prefix
-to this command) from buffer A to buffer B.
-Ediff saves the old contents of buffer B's region; it can
-be restored via the command @kbd{rb}, which see.
-
-@emph{In merge sessions:}
-Copies the current difference region (or the region specified as the prefix
-to this command) from buffer A to the merge buffer.  The old contents of
-this region in buffer C can be restored via the command @kbd{r}.
-
-@item b
-@kindex b
-Works similarly, but copies the current difference region from buffer B to
-buffer A (in @emph{comparison sessions}) or the merge buffer (in
-@emph{merge sessions}).
-
-Ediff saves the old contents of the difference region copied over; it can
-be reinstated via the command @kbd{ra} in comparison sessions and
-@kbd{r} in merge sessions.
-
-@item ab
-@kindex ab
-Copies the current difference region (or the region specified as the prefix
-to this command) from buffer A to buffer B.  This (and the next five)
-command is enabled only in sessions that compare three files
-simultaneously.  The old region in buffer B is saved and can be restored
-via the command @kbd{rb}.
-@item ac
-@kindex ac
-Copies the difference region from buffer A to buffer C.
-The old region in buffer C is saved and can be restored via the command
-@kbd{rc}.
-@item ba
-@kindex ba
-Copies the difference region from buffer B to buffer A.
-The old region in buffer A is saved and can be restored via the command
-@kbd{ra}.
-@item bc
-@kindex bc
-Copies the difference region from buffer B to buffer C.
-The command @kbd{rc} undoes this.
-@item ca
-@kindex ca
-Copies the difference region from buffer C to buffer A.
-The command @kbd{ra} undoes this.
-@item cb
-@kindex cb
-Copies the difference region from buffer C to buffer B.
-The command @kbd{rb} undoes this.
-
-@item p
-@itemx DEL
-@kindex p
-@kindex DEL
-Makes the previous difference region current.
-@item n
-@itemx SPC
-@kindex n
-@kindex SPC
-Makes the next difference region current.
-
-@item j
-@itemx -j
-@itemx Nj
-@kindex j
-Makes the very first difference region current.
-
-@kbd{-j} makes the last region current.  Typing a number, N, and then `j'
-makes the difference region N current.  Typing -N (a negative number) then
-`j' makes current the region Last - N.
-
-@item ga
-@kindex ga
-Makes current the difference region closest to the position of the point in
-buffer A.
-
-However, with a prefix argument, Ediff would position all variants
-around the area indicated by the current point in buffer A: if
-the point is inside a difference region, then the variants will be
-positioned at this difference region.  If the point is not in any difference
-region, then it is in an area where all variants agree with each other.  In
-this case, the variants will be positioned so that each would display this
-area (of agreement).
-@item gb
-@kindex gb
-Makes current the difference region closest to the position of the point in
-buffer B.
-
-With a prefix argument, behaves like @kbd{ga}, but with respect to buffer B.
-@item gc
-@kindex gc
-@emph{In merge sessions:}
-makes current the difference region closest to the point in the merge buffer.
-
-@emph{In 3-file comparison sessions:}
-makes current the region closest to the point in buffer C.
-
-With a prefix argument, behaves like @kbd{ga}, but with respect to buffer C.
-
-@item !
-@kindex !
-Recomputes the difference regions, bringing them up to date.  This is often
-needed because it is common to do all sorts of editing during Ediff
-sessions, so after a while, the highlighted difference regions may no
-longer reflect the actual differences among the buffers.
-
-@item *
-@kindex *
-Forces refinement of the current difference region, which highlights the exact
-words of disagreement among the buffers.  With a negative prefix argument,
-unhighlights the current region.
-
-Forceful refinement may be needed if Ediff encounters a difference region
-that is larger than @code{ediff-auto-refine-limit}.  In this situation,
-Ediff doesn't do automatic refinement in order to improve response time.
-(Ediff doesn't auto-refine on dumb terminals as well, but @kbd{*} still
-works there.  However, the only useful piece of information it can tell you
-is whether or not the difference regions disagree only in the amount of
-white space.)
-
-This command is also useful when the highlighted fine differences are
-no longer current, due to user editing.
-
-@item m
-@kindex m
-Displays the current Ediff session in a frame as wide as the physical
-display.  This is useful when comparing files side-by-side.  Typing `m' again
-restores the original size of the frame.
-
-@item |
-@kindex |
-Toggles the horizontal/vertical split of the Ediff display.  Horizontal
-split is convenient when it is possible to compare files
-side-by-side.  If the frame in which files are displayed is too narrow
-and lines are cut off, typing @kbd{m} may help some.
-
-@item @@
-@kindex @@
-Toggles auto-refinement of difference regions (i.e., automatic highlighting
-of the exact words that differ among the variants).  Auto-refinement is
-turned off on devices where Emacs doesn't support highlighting.
-
-On slow machines, it may be advantageous to turn auto-refinement off.  The
-user can always forcefully refine specific difference regions by typing
-@kbd{*}.
-
-@item h
-@kindex h
-Cycles between full highlighting, the mode where fine differences are not
-highlighted (but computed), and the mode where highlighting is done with
-@acronym{ASCII} strings.  The latter is not really recommended, unless on a dumb TTY.
-
-@item r
-@kindex r
-Restores the old contents of the region in the merge buffer.
-(If you copied a difference region from buffer A or B into the merge buffer
-using the commands @kbd{a} or @kbd{b}, Ediff saves the old contents of the
-region in case you change your mind.)
-
-This command is enabled in merge sessions only.
-
-@item ra
-@kindex ra
-Restores the old contents of the current difference region in buffer A,
-which was previously saved when the user invoked one of these commands:
-@kbd{b}, @kbd{ba}, @kbd{ca}, which see.  This command is enabled in
-comparison sessions only.
-@item rb
-@kindex rb
-Restores the old contents of the current difference region in buffer B,
-which was previously saved when the user invoked one of these commands:
-@kbd{a}, @kbd{ab}, @kbd{cb}, which see.  This command is enabled in
-comparison sessions only.
-@item rc
-@kindex rc
-Restores the old contents of the current difference region in buffer C,
-which was previously saved when the user invoked one of these commands:
-@kbd{ac}, @kbd{bc}, which see.  This command is enabled in 3-file
-comparison sessions only.
-
-@item ##
-@kindex ##
-Tell Ediff to skip over regions that disagree among themselves only in the
-amount of white space and line breaks.
-
-Even though such regions will be skipped over, you can still jump to any
-one of them by typing the region number and then `j'.  Typing @kbd{##}
-again puts Ediff back in the original state.
-
-@item #c
-@kindex #c
-@vindex ediff-ignore-case-option
-@vindex ediff-ignore-case-option3
-@vindex ediff-ignore-case
-Toggle case sensitivity in the diff program. All diffs are recomputed.
-Case sensitivity is controlled by the variables
-@code{ediff-ignore-case-option}, @code{ediff-ignore-case-option3},
-and @code{ediff-ignore-case}, which are explained elsewhere.
-
-@item #h
-@itemx #f
-@kindex #f
-@kindex #h
-Ediff works hard to ameliorate the effects of boredom in the workplace...
-
-Quite often differences are due to identical replacements (e.g., the word
-`foo' is replaced with the word `bar' everywhere).  If the number of regions
-with such boring differences exceeds your tolerance threshold, you may be
-tempted to tell Ediff to skip these regions altogether (you will still be able
-to jump to them via the command @kbd{j}).  The above commands, @kbd{#h}
-and @kbd{#f}, may well save your day!
-
-@kbd{#h} prompts you to specify regular expressions for each
-variant.  Difference regions where each variant's region matches the
-corresponding regular expression will be skipped from then on.  (You can
-also tell Ediff to skip regions where at least one variant matches its
-regular expression.)
-
-@kbd{#f} does dual job: it focuses on regions that match the corresponding
-regular expressions.  All other regions will be skipped
-over.  @xref{Selective Browsing}, for more.
-
-@item A
-@kindex A
-Toggles the read-only property in buffer A.
-If file A is under version control and is checked in, it is checked out
-(with your permission).
-@item B
-@kindex B
-Toggles the read-only property in buffer B.
-If file B is under version control and is checked in, it is checked out.
-@item C
-@kindex C
-Toggles the read-only property in buffer C (in 3-file comparison sessions).
-If file C is under version control and is checked in, it is checked out.
-
-@item ~
-@kindex ~
-Swaps the windows where buffers A and B are displayed.  If you are comparing
-three buffers at once, then this command would rotate the windows among
-buffers A, B, and C.
-
-@item i
-@kindex i
-Displays all kinds of useful data about the current Ediff session.
-@item D
-@kindex D
-Runs @code{ediff-custom-diff-program} on the variants and displays the
-buffer containing the output.  This is useful when you must send the output
-to your Mom.
-
-With a prefix argument, displays the plain @code{diff} output.
-@xref{Patch and Diff Programs}, for details.
-
-@item R
-@kindex R
-Displays a list of currently active Ediff sessions---the Ediff Registry.
-You can then restart any of these sessions by either clicking on a session
-record or by putting the cursor over it and then typing the return key.
-
-(Some poor souls leave so many active Ediff sessions around that they loose
-track of them completely...  The `R' command is designed to save these
-people from the recently discovered Ediff Proficiency Syndrome.)
-
-Typing @kbd{R} brings up Ediff Registry only if it is typed into an Ediff
-Control Panel.  If you don't have a control panel handy, type this in the
-minibuffer: @kbd{M-x eregistry}.  @xref{Registry of Ediff Sessions}.
-
-@item M
-@kindex M
-Shows the session group buffer that invoked the current Ediff session.
-@xref{Session Groups}, for more information on session groups.
-
-@item z
-@kindex z
-Suspends the current Ediff session.  (If you develop a condition known as
-Repetitive Ediff Injury---a serious but curable illness---you must change
-your current activity.  This command tries hard to hide all Ediff-related
-buffers.)
-
-The easiest way to resume a suspended Ediff session is through the registry
-of active sessions.  @xref{Registry of Ediff Sessions}, for details.
-@item q
-@kindex q
-Terminates this Ediff session.  With a prefix argument (e.g.,@kbd{1q}), asks
-if you also want to delete the buffers of the variants.
-Modified files and the results of merges are never deleted.
-
-@item %
-@kindex %
-Toggles narrowing in Ediff buffers.  Ediff buffers may be narrowed if you
-are comparing only parts of these buffers via the commands
-@code{ediff-windows-*} and @code{ediff-regions-*}, which see.
-
-@item C-l
-@kindex C-l
-Restores the usual Ediff window setup.  This is the quickest way to resume
-an Ediff session, but it works only if the control panel of that session is
-visible.
-
-@item $$
-@kindex $$
-While merging with an ancestor file, Ediff is determined to reduce user's
-wear and tear by saving him and her much of unproductive, repetitive
-typing.  If it notices that, say, file A's difference region is identical to
-the same difference region in the ancestor file, then the merge buffer will
-automatically get the difference region taken from buffer B.  The rationale
-is that this difference region in buffer A is as old as that in the
-ancestor buffer, so the contents of that region in buffer B represents real
-change.
-
-You may want to ignore such `obvious' merges and concentrate on difference
-regions where both files `clash' with the ancestor, since this means that
-two different people have been changing this region independently and they
-had different ideas on how to do this.
-
-The above command does this for you by skipping the regions where only one
-of the variants clashes with the ancestor but the other variant agrees with
-it.  Typing @kbd{$$} again undoes this setting.
-
-@item $*
-@kindex $*
-When merging files with large number of differences, it is sometimes
-convenient to be able to skip the difference regions for which you already
-decided which variant is most appropriate. Typing @kbd{$*} will accomplish
-precisely this.
-
-To be more precise, this toggles the check for whether the current merge is
-identical to its default setting, as originally decided by Ediff.  For
-instance, if Ediff is merging according to the `combined' policy, then the
-merge region is skipped over if it is different from the combination of the
-regions in buffers A and B.  (Warning: swapping buffers A and B will confuse
-things in this respect).  If the merge region is marked as `prefer-A' then
-this region will be skipped if it differs from the current difference
-region in buffer A, etc.
-
-@item /
-@kindex /
-Displays the ancestor file during merges.
-@item &
-@kindex &
-In some situations, such as when one of the files agrees with the ancestor file
-on a difference region and the other doesn't, Ediff knows what to do: it copies
-the current difference region from the second buffer into the merge buffer.
-
-In other cases, the right course of action is not that clearcut, and Ediff
-would use a default action.  The above command changes the default action.
-The default action can be @samp{default-A} (choose the region from buffer
-A), @samp{default-B} (choose the region from buffer B), or @samp{combined}
-(combine the regions from the two buffers).
-@xref{Merging and diff3}, for further details.
-
-The command @kbd{&} also affects the regions in the merge buffers that have
-@samp{default-A}, @samp{default-B}, or @samp{combined} status, provided
-they weren't changed with respect to the original.  For instance, if such a
-region has the status @samp{default-A} then changing the default action to
-@samp{default-B} will also replace this merge-buffer's region with the
-corresponding region from buffer B.
-
-@item s
-@kindex s
-Causes the merge window shrink to its minimum size, thereby exposing as much
-of the variant buffers as possible.  Typing `s' again restores
-the original size of that window.
-
-With a positive prefix argument, this command enlarges the merge window.
-E.g., @kbd{4s} increases the size of the window by about 4 lines, if
-possible.  With a negative numeric argument, the size of the merge window
-shrinks by that many lines, if possible.  Thus, @kbd{-s} shrinks the window
-by about 1 line and @kbd{-3s} by about 3 lines.
-
-This command is intended only for temporary viewing; therefore, Ediff
-restores window C to its original size whenever it makes any other change
-in the window configuration.  However, redisplaying (@kbd{C-l}) or jumping
-to another difference does not affect window C's size.
-
-The split between the merge window and the variant windows is controlled by
-the variable @code{ediff-merge-window-share}, which see.
-
-@item +
-@kindex +
-Combines the difference regions from buffers A and B and copies the
-result into the merge buffer.  @xref{Merging and diff3}, and the
-variables @code{ediff-combine-diffs} and @code{ediff-combination-pattern}.
-
-
-@item =
-@kindex =
-You may run into situations when a large chunk of text in one file has been
-edited and then moved to a different place in another file.  In such a case,
-these two chunks of text are unlikely to belong to the same difference
-region, so the refinement feature of Ediff will not be able to tell you
-what exactly differs inside these chunks.  Since eyeballing large pieces of
-text is contrary to human nature, Ediff has a special command to help
-reduce the risk of developing a cataract.
-
-In other situations, the currently highlighted region might be big and you
-might want to reconcile of them interactively.
-
-All of this can be done with the above command, @kbd{=}, which
-compares regions within Ediff buffers.  Typing @kbd{=} creates a
-child Ediff session for comparing regions in buffers A, B, or
-C as follows.
-
-First, you will be asked whether you want to compare the fine differences
-between the currently highlighted buffers on a word-by-word basis. If you
-accept, a child Ediff session will start using the currently highlighted
-regions. Ediff will let you step over the differences word-wise.
-
-If you reject the offer, you will be asked to select regions of your choice.
-
-@emph{If you are comparing 2 files or buffers:}
-Ediff will ask you to select regions in buffers A and B.
-
-@emph{If you are comparing 3 files or buffers simultaneously:} Ediff will
-ask you to choose buffers and then select regions inside those buffers.
-
-@emph{If you are merging files or buffers (with or without ancestor):}
-Ediff will ask you to choose which buffer (A or B) to compare with the
-merge buffer and then select regions in those buffers.
-
-@end table
-
-@node Other Session Commands,,Quick Help Commands,Session Commands
-@section Other Session Commands
-
-The following commands can be invoked from within any Ediff session,
-although some of them are not bound to a key.
-
-@table @code
-@item eregistry
-@itemx ediff-show-registry
-@findex eregistry
-@findex ediff-show-registry
-This command brings up the registry of active Ediff sessions.  Ediff
-registry is a device that can be used to resume any active Ediff session
-(which may have been postponed because the user switched to some other
-activity).  This command is also useful for switching between multiple
-active Ediff sessions that are run at the same time.  The function
-@code{eregistry} is an alias for @code{ediff-show-registry}.
-@xref{Registry of Ediff Sessions}, for more information on this registry.
-
-@item ediff-toggle-multiframe
-@findex ediff-toggle-multiframe
-Changes the display from the multi-frame mode (where the quick help window
-is in a separate frame) to the single-frame mode (where all Ediff buffers
-share the same frame), and vice versa.  See
-@code{ediff-window-setup-function} for details on how to make either of
-these modes the default one.
-
-This function can also be invoked from the Menubar.  However, in some
-cases, the change will take place only after you execute one of the Ediff
-commands, such as going to the next difference or redisplaying.
-
-@item ediff-toggle-use-toolbar
-@findex ediff-toggle-use-toolbar
-Available in XEmacs only.  The Ediff toolbar provides quick access to some
-of the common Ediff functions.  This function toggles the display of the
-toolbar.  If invoked from the menubar, the function may take sometimes
-effect only after you execute an Ediff command, such as going to the next
-difference.
-
-@item ediff-use-toolbar-p
-@vindex ediff-use-toolbar-p
-The use of the toolbar can also be specified via the variable
-@code{ediff-use-toolbar-p} (default is @code{t}).  This variable can be set
-only in @file{.emacs} --- do @strong{not} change it interactively.  Use the
-function @code{ediff-toggle-use-toolbar} instead.
-
-@item ediff-revert-buffers-then-recompute-diffs
-@findex ediff-revert-buffers-then-recompute-diffs
-This command reverts the buffers you are comparing and recomputes their
-differences.  It is useful when, after making changes, you decided to
-make a fresh start, or if at some point you changed the files being
-compared but want to discard any changes to comparison buffers that were
-done since then.
-
-This command normally asks for confirmation before reverting files.
-With a prefix argument, it reverts files without asking.
-
-
-@item ediff-profile
-@findex ediff-profile
-Ediff has an admittedly primitive (but useful) facility for profiling
-Ediff's commands.  It is meant for Ediff maintenance---specifically, for
-making it run faster.  The function @code{ediff-profile} toggles
-profiling of ediff commands.
-@end table
-
-@node Registry of Ediff Sessions, Session Groups, Session Commands, Top
-@chapter Registry of Ediff Sessions
-
-Ediff maintains a registry of all its invocations that are
-still @emph{active}.  This feature is very convenient for switching among
-active Ediff sessions or for quickly restarting a suspended Ediff session.
-
-The focal point of this activity is a buffer
-called @emph{*Ediff Registry*}.  You can display this buffer by typing
-@kbd{R} in any Ediff Control Buffer or Session Group Buffer
-(@pxref{Session Groups}), or by typing
-@kbd{M-x eregistry} into the Minibuffer.
-The latter would be the fastest way to bring up the registry
-buffer if no control or group buffer is displayed in any of the visible
-Emacs windows.
-If you are in a habit of running multiple long Ediff sessions and often need to
-suspend, resume, or switch between them, it may be a good idea to have the
-registry buffer permanently displayed in a separate, dedicated window.
-
-The registry buffer has several convenient key bindings.
-For instance, clicking mouse button 2 or typing
-@kbd{RET} or @kbd{v} over any session record resumes that session.
-Session records in the registry buffer provide a fairly complete
-description of each session, so it is usually easy to identify the right
-session to resume.
-
-Other useful commands are bound to @kbd{SPC} (next registry record)
-and @kbd{DEL} (previous registry record).  There are other commands as well,
-but you don't need to memorize them, since they are listed at the top of
-the registry buffer.
-
-@node Session Groups, Remote and Compressed Files, Registry of Ediff Sessions, Top
-@chapter Session Groups
-
-Several major entries of Ediff perform comparison and merging on
-directories.  On entering @code{ediff-directories},
-@code{ediff-directories3},
-@code{ediff-merge-directories},
-@code{ediff-merge-directories-with-ancestor},
-@code{ediff-directory-revisions},
-@code{ediff-merge-directory-revisions}, or
-@code{ediff-merge-directory-revisions-with-ancestor},
-the user is presented with a
-Dired-like buffer that lists files common to the directories involved along
-with their sizes.  (The list of common files can be further filtered through
-a regular expression, which the user is prompted for.)  We call this buffer
-@emph{Session Group Panel} because all Ediff sessions associated with the
-listed files will have this buffer as a common focal point.
-
-Clicking button 2 or typing @kbd{RET} or @kbd{v} over a
-record describing files invokes Ediff in the appropriate mode on these
-files.  You can come back to the session group buffer associated with a
-particular invocation of Ediff by typing @kbd{M} in Ediff control buffer of
-that invocation.
-
-Many commands are available in the session group buffer; some are
-applicable only to certain types of work.  The relevant commands are always
-listed at the top of each session group buffer, so there is no need to
-memorize them.
-
-In directory comparison or merging, a session group panel displays only the
-files common to all directories involved.  The differences are kept in a
-separate @emph{directory difference buffer} and are conveniently displayed
-by typing @kbd{D} to the corresponding session group panel.  Thus, as an
-added benefit, Ediff can be used to compare the contents of up to three
-directories.
-
-@cindex Directory difference buffer
-Sometimes it is desirable to copy some files from one directory to another
-without exiting Ediff. The @emph{directory difference buffer}, which is
-displayed by typing @kbd{D} as discussed above, can be used for this
-purpose. If a file is, say, in Ediff's Directory A, but is missing in
-Ediff's Directory B (Ediff will refuse to override existing files), then
-typing @kbd{C} or clicking mouse button 2 over that file (which must be
-displayed in directory difference buffer) will copy that file from
-Directory A to Directory B.
-
-Session records in session group panels are also marked with @kbd{+}, for
-active sessions, and with @kbd{-}, for finished sessions.
-
-Sometimes, it is convenient to exclude certain sessions from a group.
-Usually this happens when the user doesn't intend to run Ediff of certain
-files in the group, and the corresponding session records just add clutter
-to the session group buffer.  To help alleviate this problem, the user can
-type @kbd{h} to mark a session as a candidate for exclusion and @kbd{x} to
-actually hide the marked sessions.  There actions are reversible: with a
-prefix argument, @kbd{h} unmarks the session under the cursor, and @kbd{x}
-brings the hidden sessions into the view (@kbd{x} doesn't unmark them,
-though, so the user has to explicitly unmark the sessions of interest).
-
-Group sessions also understand the command @kbd{m}, which marks sessions
-for future operations (other than hiding) on a group of sessions.  At present,
-the only such group-level operation is the creation of a multi-file patch.
-
-@vindex ediff-autostore-merges
-For group sessions created to merge files, Ediff can store all merges
-automatically in a directory.  The user is asked to specify such directory
-if the value of @code{ediff-autostore-merges} is non-@code{nil}.  If the value is
-@code{nil}, nothing is done to the merge buffers---it will be the user's
-responsibility to save them.  If the value is @code{t}, the user will be
-asked where to save the merge buffers in all merge jobs, even those that do
-not originate from a session group.  It the value is neither @code{nil} nor
-@code{t}, the merge buffer is saved @emph{only} if this merge session was
-invoked from a session group.  This behavior is implemented in the function
-@code{ediff-maybe-save-and-delete-merge}, which is a hook in
-@code{ediff-quit-merge-hook}.  The user can supply a different hook, if
-necessary.
-
-The variable @code{ediff-autostore-merges} is buffer-local, so it can be
-set on a per-buffer basis.  Therefore, use @code{setq-default} to change
-this variable globally.
-
-@cindex Multi-file patches
-A multi-file patch is a concatenated output of several runs of the Unix
-@code{diff} command (some versions of @code{diff} let you create a
-multi-file patch in just one run).  Ediff facilitates creation of
-multi-file patches as follows.  If you are in a session group buffer
-created in response to @code{ediff-directories} or
-@code{ediff-directory-revisions}, you can mark (by typing @kbd{m}) the
-desired Ediff sessions and then type @kbd{P} to create a
-multi-file patch of those marked sessions.
-Ediff will then display a buffer containing the patch.
-The patch is generated by invoking @code{diff} on all marked individual
-sessions (represented by files) and session groups (represented by
-directories).  Ediff will also recursively descend into any @emph{unmarked}
-session group and will search for marked sessions there.  In this way, you
-can create multi-file patches that span file subtrees that grow out of
-any given directory.
-
-In an @code{ediff-directories} session, it is enough to just mark the
-requisite sessions.  In @code{ediff-directory-revisions} revisions, the
-marked sessions must also be active, or else Ediff will refuse to produce a
-multi-file patch.  This is because, in the latter-style sessions, there are
-many ways to create diff output, and it is easier to handle by running
-Ediff on the inactive sessions.
-
-Last, but not least, by typing @kbd{==}, you can quickly find out which
-sessions have identical entries, so you won't have to run Ediff on those
-sessions.  This, however, works only on local, uncompressed files.
-For compressed or remote files, this command won't report anything.
-Likewise, you can use @kbd{=h} to mark sessions with identical entries
-for hiding or, with @kbd{=m}, for further operations.
-
-The comparison operations @kbd{==}, @kbd{=h}, and @kbd{=m} can recurse into
-subdirectories to see if they have identical contents (so the user will not
-need to descend into those subdirectories manually). These commands ask the
-user whether or not to do a recursive descent.
-
-
-
-@node Remote and Compressed Files, Customization, Session Groups, Top
-@chapter Remote and Compressed Files
-
-Ediff works with remote, compressed, and encrypted files.  Ediff
-supports @file{ange-ftp.el}, @file{jka-compr.el}, @file{uncompress.el}
-and @file{crypt++.el}, but it may work with other similar packages as
-well.  This means that you can compare files residing on another
-machine, or you can apply a patch to a file on another machine.  Even
-the patch itself can be a remote file!
-
-When patching compressed or remote files, Ediff does not rename the source
-file (unlike what the @code{patch} utility would usually do).  Instead, the
-source file retains its name and the result of applying the patch is placed
-in a temporary file that has the suffix @file{_patched} attached.
-Generally, this applies to files that are handled using black magic, such
-as special file handlers (ange-ftp and some compression and encryption
-packages also use this method).
-
-Regular files are treated by the @code{patch} utility in the usual manner,
-i.e., the original is renamed into @file{source-name.orig} and the result
-of the patch is placed into the file source-name (@file{_orig} is used
-on systems like VMS, DOS, etc.)
-
-@node Customization, Credits, Remote and Compressed Files, Top
-@chapter Customization
-
-Ediff has a rather self-explanatory interface, and in most cases you
-won't need to change anything.  However, should the need arise, there are
-extensive facilities for changing the default behavior.
-
-Most of the customization can be done by setting various variables in the
-@file{.emacs} file.  Some customization (mostly window-related
-customization and faces) can be done by putting appropriate lines in
-@file{.Xdefaults}, @file{.xrdb}, or whatever X resource file is in use.
-
-With respect to the latter, please note that the X resource
-for Ediff customization is `Ediff', @emph{not} `emacs'.
-@xref{Window and Frame Configuration},
-@xref{Highlighting Difference Regions}, for further details.  Please also
-refer to Emacs manual for the information on how to set Emacs X resources.
-
-@menu
-* Hooks::                       Customization via the hooks.
-* Quick Help Customization::    How to customize Ediff's quick help feature.
-* Window and Frame Configuration::  Controlling the way Ediff displays things.
-* Selective Browsing::          Advanced browsing through difference regions.
-* Highlighting Difference Regions::  Controlling highlighting.
-* Narrowing::                   Comparing regions, windows, etc.
-* Refinement of Difference Regions::  How to control the refinement process.
-* Patch and Diff Programs::     Changing the utilities that compute differences
-                                and apply patches.
-* Merging and diff3::           How to customize Ediff in its Merge Mode.
-* Support for Version Control::  Changing the version control package.
-                                 You are not likely to do that.
-* Customizing the Mode Line::   Changing the look of the mode line in Ediff.
-* Miscellaneous::               Other customization.
-* Notes on Heavy-duty Customization::  Customization for the gurus.
-@end menu
-
-@node Hooks, Quick Help Customization, Customization, Customization
-@section Hooks
-
-The bulk of customization can be done via the following hooks:
-
-@table @code
-@item ediff-load-hook
-@vindex ediff-load-hook
-This hook can be used to change defaults after Ediff is loaded.
-
-@item ediff-before-setup-hook
-@vindex ediff-before-setup-hook
-Hook that is run just before Ediff rearranges windows to its liking.
-Can be used to save windows configuration.
-
-@item ediff-keymap-setup-hook
-@vindex ediff-keymap-setup-hook
-@vindex ediff-mode-map
-This hook can be used to alter bindings in Ediff's keymap,
-@code{ediff-mode-map}.  These hooks are
-run right after the default bindings are set but before
-@code{ediff-load-hook}.  The regular user needs not be concerned with this
-hook---it is provided for implementors of other Emacs packages built on top
-of Ediff.
-
-@item ediff-before-setup-windows-hook
-@itemx ediff-after-setup-windows-hook
-@vindex ediff-before-setup-windows-hook
-@vindex ediff-after-setup-windows-hook
-These two hooks are called before and after Ediff sets up its window
-configuration.  These hooks are run each time Ediff rearranges windows to
-its liking. This happens whenever it detects that the user changed the
-windows setup.
-
-@item ediff-suspend-hook
-@itemx ediff-quit-hook
-@vindex ediff-suspend-hook
-@vindex ediff-quit-hook
-These two hooks are run when you suspend or quit Ediff.  They can be
-used to set desired window configurations, delete files Ediff didn't
-want to clean up after exiting, etc.
-
-By default, @code{ediff-quit-hook} holds one hook function,
-@code{ediff-cleanup-mess}, which cleans after Ediff, as appropriate in
-most cases.  You probably won't want to change it, but you might
-want to add other hook functions.
-
-Keep in mind that hooks executing before @code{ediff-cleanup-mess} start
-in @code{ediff-control-buffer;} they should also leave
-@code{ediff-control-buffer} as the current buffer when they finish.
-Hooks that are executed after @code{ediff-cleanup-mess} should expect
-the current buffer be either buffer A or buffer B.
-@code{ediff-cleanup-mess} doesn't kill the buffers being compared or
-merged (see @code{ediff-cleanup-hook}, below).
-
-@item ediff-cleanup-hook
-@vindex ediff-cleanup-hook
-This hook is run just before @code{ediff-quit-hook}.  This is a good
-place to do various cleanups, such as deleting the variant buffers.
-Ediff provides a function, @code{ediff-janitor}, as one such possible
-hook, which you can add to @code{ediff-cleanup-hook} with
-@code{add-hooks}.
-
-@findex ediff-janitor
-This function kills buffers A, B, and, possibly, C, if these buffers aren't
-modified.  In merge jobs, buffer C is never deleted.  However, the side
-effect of using this function is that you may not be able to compare the
-same buffer in two separate Ediff sessions: quitting one of them will
-delete this buffer in another session as well.
-
-@item ediff-quit-merge-hook
-@vindex ediff-quit-merge-hook
-@vindex ediff-autostore-merges
-@findex ediff-maybe-save-and-delete-merge
-This hook is called when Ediff quits a merge job.  By default, the value is
-@code{ediff-maybe-save-and-delete-merge}, which is a function that attempts
-to save the merge buffer according to the value of
-@code{ediff-autostore-merges}, as described later.
-
-@item ediff-before-setup-control-frame-hook
-@itemx ediff-after-setup-control-frame-hook
-@vindex ediff-before-setup-control-frame-hook
-@vindex ediff-after-setup-control-frame-hook
-These two hooks run before and after Ediff sets up the control frame.
-They can be used to relocate Ediff control frame when Ediff runs in a
-multiframe mode (i.e., when the control buffer is in its own dedicated
-frame).  Be aware that many variables that drive Ediff are local to
-Ediff Control Panel (@code{ediff-control-buffer}), which requires
-special care in writing these hooks.  Take a look at
-@code{ediff-default-suspend-hook} and @code{ediff-default-quit-hook} to
-see what's involved.
-
-@item ediff-startup-hook
-@vindex ediff-startup-hook
-This hook is run at the end of Ediff startup.
-
-@item ediff-select-hook
-@vindex ediff-select-hook
-This hook is run after Ediff selects the next difference region.
-
-@item ediff-unselect-hook
-@vindex ediff-unselect-hook
-This hook is run after Ediff unselects the current difference region.
-
-@item ediff-prepare-buffer-hook
-@vindex ediff-prepare-buffer-hook
-This hook is run for each Ediff buffer (A, B, C) right after the buffer
-is arranged.
-
-@item ediff-display-help-hook
-@vindex ediff-display-help-hook
-Ediff runs this hook each time after setting up the help message.  It
-can be used to alter the help message for custom packages that run on
-top of Ediff.
-
-@item ediff-mode-hook
-@vindex ediff-mode-hook
-This hook is run just after Ediff mode is set up in the control
-buffer.  This is done before any Ediff window is created.  You can use it to
-set local variables that alter the look of the display.
-
-@item ediff-registry-setup-hook
-@vindex ediff-registry-setup-hook
-Hooks run after setting up the registry for all active Ediff session.
-@xref{Session Groups}, for details.
-@item ediff-before-session-group-setup-hook
-@vindex ediff-before-session-group-setup-hook
-Hooks run before setting up a control panel for a group of related Ediff
-sessions. Can be used, for example, to save window configuration to restore
-later.
-@item ediff-after-session-group-setup-hook
-@vindex ediff-after-session-group-setup-hook
-Hooks run after setting up a control panel for a group of related Ediff
-sessions.  @xref{Session Groups}, for details.
-@item ediff-quit-session-group-hook
-@vindex ediff-quit-session-group-hook
-Hooks run just before exiting a session group.
-@item ediff-meta-buffer-keymap-setup-hook
-@vindex ediff-meta-buffer-keymap-setup-hook
-@vindex ediff-meta-buffer-map
-Hooks run just after setting up the @code{ediff-meta-buffer-map} --- the
-map that controls key bindings in the meta buffer.  Since
-@code{ediff-meta-buffer-map} is a local variable, you can set different
-bindings for different kinds of meta buffers.
-@end table
-
-@node Quick Help Customization, Window and Frame Configuration, Hooks, Customization
-@section Quick Help Customization
-@vindex ediff-use-long-help-message
-@vindex ediff-control-buffer
-@vindex ediff-startup-hook
-@vindex ediff-help-message
-
-Ediff provides quick help using its control panel window.  Since this window
-takes a fair share of the screen real estate, you can toggle it off by
-typing @kbd{?}.  The control window will then shrink to just one line and a
-mode line, displaying a short help message.
-
-The variable @code{ediff-use-long-help-message} tells Ediff whether
-you use the short message or the long one.  By default, it
-is set to @code{nil}, meaning that the short message is used.
-Set this to @code{t}, if you want Ediff to use the long
-message by default.  This property can always be changed interactively, by
-typing @kbd{?} into Ediff Control Buffer.
-
-If you want to change the appearance of the help message on a per-buffer
-basis, you must use @code{ediff-startup-hook} to change the value of
-the variable @code{ediff-help-message}, which is local to
-@code{ediff-control-buffer}.
-
-@node Window and Frame Configuration, Selective Browsing, Quick Help Customization, Customization
-@section Window and Frame Configuration
-
-On a non-windowing display, Ediff sets things up in one frame, splitting
-it between a small control window and the windows for buffers A, B, and C.
-The split between these windows can be horizontal or
-vertical, which can be changed interactively by typing @kbd{|} while the
-cursor is in the control window.
-
-On a window display, Ediff sets up a dedicated frame for Ediff Control
-Panel and then it chooses windows as follows: If one of the buffers
-is invisible, it is displayed in the currently selected frame.  If
-a buffer is visible, it is displayed in the frame where it is visible.
-If, according to the above criteria, the two buffers fall into the same
-frame, then so be it---the frame will be shared by the two.  The same
-algorithm works when you type @kbd{C-l} (@code{ediff-recenter}), @kbd{p}
-(@code{ediff-previous-difference}), @kbd{n}
-(@code{ediff-next-difference}), etc.
-
-The above behavior also depends on whether the current frame is splittable,
-dedicated, etc.  Unfortunately, the margin of this book is too narrow to
-present the details of this remarkable algorithm.
-
-The upshot of all this is that you can compare buffers in one frame or
-in different frames.  The former is done by default, while the latter can
-be achieved by arranging buffers A, B (and C, if applicable) to be seen in
-different frames.  Ediff respects these arrangements, automatically
-adapting itself to the multi-frame mode.
-
-Ediff uses the following variables to set up its control panel
-(a.k.a.@: control buffer, a.k.a.@: quick help window):
-
-@table @code
-@item ediff-control-frame-parameters
-@vindex ediff-control-frame-parameters
-You can change or augment this variable including the font, color,
-etc.  The X resource name of Ediff Control Panel frames is @samp{Ediff}.  Under
-X-windows, you can use this name to set up preferences in your
-@file{~/.Xdefaults}, @file{~/.xrdb}, or whatever X resource file is in
-use.  Usually this is preferable to changing
-@code{ediff-control-frame-parameters} directly.  For instance, you can
-specify in @file{~/.Xdefaults} the color of the control frame
-using the resource @samp{Ediff*background}.
-
-In general, any X resource pertaining the control frame can be reached
-via the prefix @code{Ediff*}.
-
-@item ediff-control-frame-position-function
-@vindex ediff-control-frame-position-function
-The preferred way of specifying the position of the control frame is by
-setting the variable @code{ediff-control-frame-position-function} to an
-appropriate function.
-The default value of this variable is
-@code{ediff-make-frame-position}.  This function places the control frame in
-the vicinity of the North-East corner of the frame displaying buffer A.
-
-@findex ediff-make-frame-position
-@end table
-
-The following variables can be used to adjust the location produced by
-@code{ediff-make-frame-position} and for related customization.
-
-@table @code
-@item ediff-narrow-control-frame-leftward-shift
-@vindex ediff-narrow-control-frame-leftward-shift
-Specifies the number of characters for shifting
-the control frame from the rightmost edge of frame A when the control
-frame is displayed as a small window.
-
-@item ediff-wide-control-frame-rightward-shift
-@vindex ediff-wide-control-frame-rightward-shift
-Specifies the rightward shift of the control frame
-from the left edge of frame A when the control frame shows the full
-menu of options.
-
-@item ediff-control-frame-upward-shift
-@vindex ediff-control-frame-upward-shift
-Specifies the number of pixels for the upward shift
-of the control frame.
-
-@item ediff-prefer-iconified-control-frame
-@vindex ediff-prefer-iconified-control-frame
-If this variable is @code{t}, the control frame becomes iconified
-automatically when you toggle the quick help message off.  This saves
-valuable real estate on the screen.  Toggling help back will deiconify
-the control frame.
-
-To start Ediff with an iconified Control Panel, you should set this
-variable to @code{t} and @code{ediff-prefer-long-help-message} to
-@code{nil} (@pxref{Quick Help Customization}).  This behavior is useful
-only if icons are allowed to accept keybord input (which depend on the
-window manager and other factors).
-@end table
-
-@findex ediff-setup-windows
-To make more creative changes in the way Ediff sets up windows, you can
-rewrite the function @code{ediff-setup-windows}.  However, we believe
-that detaching Ediff Control Panel from the rest and making it into a
-separate frame offers an important opportunity by allowing you to
-iconify that frame.  The icon will usually accept all of the Ediff
-commands, but will free up valuable real estate on your screen (this may
-depend on your window manager, though).
-
-The following variable controls how windows are set up:
-
-@table @code
-@item ediff-window-setup-function
-@vindex ediff-window-setup-function
-The multiframe setup is done by the
-@code{ediff-setup-windows-multiframe} function, which is the default on
-windowing displays.  The plain setup, one where all windows are always
-in one frame, is done by @code{ediff-setup-windows-plain}, which is the
-default on a non-windowing display (or in an xterm window).  In fact,
-under Emacs, you can switch freely between these two setups by executing
-the command @code{ediff-toggle-multiframe} using the Minibuffer of the
-Menubar.
-@findex ediff-setup-windows-multiframe
-@findex ediff-setup-windows-plain
-@findex ediff-toggle-multiframe
-
-If you don't like any of these setups, write your own function.  See the
-documentation for @code{ediff-window-setup-function} for the basic
-guidelines.  However, writing window setups is not easy, so you should
-first take a close look at @code{ediff-setup-windows-plain} and
-@code{ediff-setup-windows-multiframe}.
-@end table
-
-You can run multiple Ediff sessions at once, by invoking Ediff several
-times without exiting previous Ediff sessions.  Different sessions
-may even operate on the same pair of files.
-
-Each session has its own Ediff Control Panel and all the regarding a
-particular session is local to the associated control panel buffer.  You
-can switch between sessions by suspending one session and then switching
-to another control panel.  (Different control panel buffers are
-distinguished by a numerical suffix, e.g., @samp{Ediff Control Panel<3>}.)
-
-@node Selective Browsing, Highlighting Difference Regions, Window and Frame Configuration, Customization
-@section Selective Browsing
-
-Sometimes it is convenient to be able to step through only some difference
-regions, those that match certain regular expressions, and to ignore all
-others.  On other occasions, you may want to ignore difference regions that
-match some regular expressions, and to look only at the rest.
-
-The commands @kbd{#f} and @kbd{#h} let you do precisely this.
-
-Typing @kbd{#f} lets you specify regular expressions that match difference
-regions you want to focus on.
-We shall call these regular expressions @var{regexp-A}, @var{regexp-B} and
-@var{regexp-C}.
-Ediff will then start stepping through only those difference regions
-where the region in buffer A matches @var{regexp-A} and/or the region in
-buffer B matches @var{regexp-B}, etc.  Whether `and' or `or' will be used
-depends on how you respond to a question.
-
-When scanning difference regions for the aforesaid regular expressions,
-Ediff narrows the buffers to those regions.  This means that you can use
-the expressions @kbd{\`} and @kbd{\'} to tie search to the beginning or end
-of the difference regions.
-
-On the other hand, typing @kbd{#h} lets you specify (hide) uninteresting
-regions.  That is, if a difference region in buffer A matches
-@var{regexp-A}, the corresponding region in buffer B matches @var{regexp-B}
-and (if applicable) buffer C's region matches @var{regexp-C}, then the
-region will be ignored by the commands @kbd{n}/@key{SPC}
-(@code{ediff-next-difference}) and @kbd{p}/@key{DEL}
-(@code{ediff-previous-difference}) commands.
-
-Typing @kbd{#f} and @kbd{#h} toggles selective browsing on and off.
-
-Note that selective browsing affects only @code{ediff-next-difference}
-and @code{ediff-previous-difference}, i.e., the commands
-@kbd{n}/@key{SPC} and @kbd{p}/@key{DEL}.  @kbd{#f} and @kbd{#h} do not
-change the position of the point in the buffers.  And you can still jump
-directly (using @kbd{j})  to any numbered
-difference.
-
-Users can supply their own functions to specify how Ediff should do
-selective browsing.  To change the default Ediff function, add a function to
-@code{ediff-load-hook} which will do the following assignments:
-
-@example
-(setq ediff-hide-regexp-matches-function 'your-hide-function)
-(setq ediff-focus-on-regexp-matches-function 'your-focus-function)
-@end example
-
-@strong{Useful hint}: To specify a regexp that matches everything, don't
-simply type @key{RET} in response to a prompt.  Typing @key{RET} tells Ediff
-to accept the default value, which may not be what you want.  Instead, you
-should enter something like @key{^} or @key{$}.  These match every
-line.
-
-You can use the status command, @kbd{i}, to find out whether
-selective browsing is currently in effect.
-
-The regular expressions you specified are kept in the local variables
-@code{ediff-regexp-focus-A}, @code{ediff-regexp-focus-B},
-@code{ediff-regexp-focus-C}, @code{ediff-regexp-hide-A},
-@code{ediff-regexp-hide-B}, @code{ediff-regexp-hide-C}.  Their default value
-is the empty string (i.e., nothing is hidden or focused on).  To change the
-default, set these variables in @file{.emacs} using @code{setq-default}.
-
-In addition to the ability to ignore regions that match regular
-expressions, Ediff can be ordered to start skipping over certain
-``uninteresting'' difference regions.  This is controlled by the following
-variable:
-
-@table @code
-@item ediff-ignore-similar-regions
-@vindex ediff-ignore-similar-regions
-If @code{t}, causes Ediff to skip over "uninteresting" difference regions,
-which are the regions where the variants differ only in the amount of the
-white space and newlines.  This feature can be toggled on/off interactively,
-via the command @kbd{##}.
-@end table
-
-@strong{Please note:} in order for this feature to work, auto-refining of
-difference regions must be on, since otherwise Ediff won't know if there
-are fine differences between regions.  On devices where Emacs can display
-faces, auto-refining is a default, but it is not turned on by default on
-text-only terminals.  In that case, you must explicitly turn auto-refining
-on (such as, by typing @kbd{@@}).
-
-@strong{Reassurance:} If many such uninteresting regions appear in a row,
-Ediff may take a long time to skip over them because it has to compute fine
-differences of all intermediate regions.  This delay does not indicate any
-problem.
-
-@vindex ediff-ignore-case-option
-@vindex ediff-ignore-case-option3
-@vindex ediff-ignore-case
-Finally, Ediff can be told to ignore the case of the letters. This behavior
-can be toggled with @kbd{#c} and it is controlled with three variables:
-Toggle case sensitivity in the diff program. All diffs are recomputed.
-Case sensitivity is controlled by the variables
-@code{ediff-ignore-case-option}, @code{ediff-ignore-case-option3}, and
-@code{ediff-ignore-case}.
-
-The variable @code{ediff-ignore-case-option} specifies the option to pass
-to the diff program for comparing two files or buffers. For GNU
-@code{diff}, this option is @code{"-i"}. The variable
-@code{ediff-ignore-case-option3} specifies the option to pass to the
-@code{diff3} program in order to make it case-insensitive. GNU @code{diff3}
-does not have such an option, so when merging or comparing three files with
-this program, ignoring the letter case is not supported.
-
-The variable @code{ediff-ignore-case} controls whether Ediff starts out by
-ignoring letter case or not. It can be set in @file{.emacs} using
-@code{setq-default}.
-
-@node Highlighting Difference Regions, Narrowing, Selective Browsing, Customization
-@section Highlighting Difference Regions
-
-The following variables control the way Ediff highlights difference
-regions:
-
-@table @code
-@item ediff-before-flag-bol
-@itemx ediff-after-flag-eol
-@itemx ediff-before-flag-mol
-@itemx ediff-after-flag-mol
-@vindex ediff-before-flag-bol
-@vindex ediff-after-flag-eol
-@vindex ediff-before-flag-mol
-@vindex ediff-after-flag-mol
-These variables hold strings that Ediff uses to mark the beginning and the
-end of the differences found in files A, B, and C on devices where Emacs
-cannot display faces.  Ediff uses different flags to highlight regions that
-begin/end at the beginning/end of a line or in a middle of a line.
-
-@item ediff-current-diff-face-A
-@itemx ediff-current-diff-face-B
-@itemx ediff-current-diff-face-C
-@vindex ediff-current-diff-face-A
-@vindex ediff-current-diff-face-B
-@vindex ediff-current-diff-face-C
-Ediff uses these faces to highlight current differences on devices where
-Emacs can display faces.  These and subsequently described faces can be set
-either in @file{.emacs} or in @file{.Xdefaults}.  The X resource for Ediff
-is @samp{Ediff}, @emph{not} @samp{emacs}.  Please refer to Emacs manual for
-the information on how to set X resources.
-@item ediff-fine-diff-face-A
-@itemx ediff-fine-diff-face-B
-@itemx ediff-fine-diff-face-C
-@vindex ediff-fine-diff-face-A
-@vindex ediff-fine-diff-face-B
-@vindex ediff-fine-diff-face-C
-Ediff uses these faces to show the fine differences between the current
-differences regions in buffers A, B, and C, respectively.
-
-@item ediff-even-diff-face-A
-@itemx ediff-even-diff-face-B
-@itemx ediff-even-diff-face-C
-@itemx ediff-odd-diff-face-A
-@itemx ediff-odd-diff-face-B
-@itemx ediff-odd-diff-face-C
-@vindex ediff-even-diff-face-A
-@vindex ediff-even-diff-face-B
-@vindex ediff-even-diff-face-C
-@vindex ediff-odd-diff-face-A
-@vindex ediff-odd-diff-face-B
-@vindex ediff-odd-diff-face-C
-Non-current difference regions are displayed using these alternating
-faces.  The odd and the even faces are actually identical on monochrome
-displays, because without colors options are limited.
-So, Ediff uses italics to highlight non-current differences.
-
-@item ediff-force-faces
-@vindex ediff-force-faces
-Ediff generally can detect when Emacs is running on a device where it can
-use highlighting with faces.  However, if it fails to determine that faces
-can be used, the user can set this variable to @code{t} to make sure that
-Ediff uses faces to highlight differences.
-
-@item ediff-highlight-all-diffs
-@vindex ediff-highlight-all-diffs
-Indicates whether---on a windowind display---Ediff should highlight
-differences using inserted strings (as on text-only terminals) or using
-colors and highlighting.  Normally, Ediff highlights all differences, but
-the selected difference is highlighted more visibly.  One can cycle through
-various modes of highlighting by typing @kbd{h}.  By default, Ediff starts
-in the mode where all difference regions are highlighted.  If you prefer to
-start in the mode where unselected differences are not highlighted, you
-should set @code{ediff-highlight-all-diffs} to @code{nil}.  Type @kbd{h} to
-restore highlighting for all differences.
-
-Ediff lets you switch between the two modes of highlighting.  That is,
-you can switch interactively from highlighting using faces to
-highlighting using string flags, and back.  Of course, switching has
-effect only under a windowing system.  On a text-only terminal or in an
-xterm window, the only available option is highlighting with strings.
-@end table
-
-@noindent
-If you want to change the default settings for @code{ediff-force-faces} and
-@code{ediff-highlight-all-diffs}, you must do it @strong{before} Ediff is
-loaded.
-
-You can also change the defaults for the faces used to highlight the
-difference regions.  There are two ways to do this.  The simplest and the
-preferred way is to use the customization widget accessible from the
-menubar.  Ediff's customization group is located under "Tools", which in
-turn is under "Programming".  The faces that are used to highlight
-difference regions are located in the "Highlighting" subgroup of the Ediff
-customization group.
-
-The second, much more arcane, method to change default faces is to include
-some Lisp code in @file{~/.emacs}.  For instance,
-
-@example
-(setq ediff-current-diff-face-A
-      (copy-face 'bold-italic 'ediff-current-diff-face-A))
-@end example
-
-@noindent
-would use the pre-defined fase @code{bold-italic} to highlight the current
-difference region in buffer A (this face is not a good choice, by the way).
-
-If you are unhappy with just @emph{some} of the aspects of the default
-faces, you can modify them when Ediff is being loaded using
-@code{ediff-load-hook}.  For instance:
-
-@smallexample
-(add-hook 'ediff-load-hook
-          (lambda ()
-            (set-face-foreground
-              ediff-current-diff-face-B "blue")
-            (set-face-background
-              ediff-current-diff-face-B "red")
-            (make-face-italic
-              ediff-current-diff-face-B)))
-@end smallexample
-
-@strong{Please note:} to set Ediff's faces, use only @code{copy-face}
-or @code{set/make-face-@dots{}} as shown above. Emacs' low-level
-face-manipulation functions should be avoided.
-
-@node Narrowing, Refinement of Difference Regions, Highlighting Difference Regions, Customization
-@section Narrowing
-
-If buffers being compared are narrowed at the time of invocation of
-Ediff, @code{ediff-buffers} will preserve the narrowing range.  However,
-if @code{ediff-files} is invoked on the files visited by these buffers,
-that would widen the buffers, since this command is defined to compare the
-entire files.
-
-Calling @code{ediff-regions-linewise} or @code{ediff-windows-linewise}, or
-the corresponding @samp{-wordwise} commands, narrows the variants to the
-particular regions being compared.  The original accessible ranges are
-restored when you quit Ediff.  During the command, you can toggle this
-narrowing on and off with the @kbd{%} command.
-
-These two variables control this narrowing behavior:
-
-@table @code
-@item ediff-start-narrowed
-@vindex ediff-start-narrowed
-If @code{t}, Ediff narrows the display to the appropriate range when it
-is invoked with an @samp{ediff-regions@dots{}} or
-@samp{ediff-windows@dots{}} command.  If @code{nil}, these commands do
-not automatically narrow, but you can still toggle narrowing on and off
-by typing @kbd{%}.
-
-@item ediff-quit-widened
-@vindex ediff-quit-widened
-Controls whether on quitting Ediff should restore the accessible range
-that existed before the current invocation.
-@end table
-
-@node Refinement of Difference Regions, Patch and Diff Programs, Narrowing, Customization
-@section Refinement of Difference Regions
-
-Ediff has variables to control the way fine differences are
-highlighted.  This feature gives you control over the process of refinement.
-Note that refinement ignores spaces, tabs, and newlines.
-
-@table @code
-@item ediff-auto-refine
-@vindex ediff-auto-refine
-This variable controls whether fine differences within regions are
-highlighted automatically (``auto-refining'').  The default is yes
-(@samp{on}).
-
-On a slow machine, automatic refinement may be painful.  In that case,
-you can turn auto-refining on or off interactively by typing
-@kbd{@@}.  You can also turn off display of refining that has
-already been done.
-
-When auto-refining is off, fine differences are shown only for regions
-for which these differences have been computed and saved before.  If
-auto-refining and display of refining are both turned off, fine
-differences are not shown at all.
-
-Typing @kbd{*} computes and displays fine differences for the current
-difference region, regardless of whether auto-refining is turned on.
-
-@item ediff-auto-refine-limit
-@vindex ediff-auto-refine-limit
-If auto-refining is on, this variable limits the size of the regions to
-be auto-refined.  This guards against the possible slowdown that may be
-caused by extraordinary large difference regions.
-
-You can always refine the current region by typing @kbd{*}.
-
-@item ediff-forward-word-function
-@vindex ediff-forward-word-function
-This variable controls how fine differences are computed.  The
-value must be a Lisp function that determines how the current difference
-region should be split into words.
-
-@vindex ediff-diff-program
-@vindex ediff-forward-word-function
-@findex ediff-forward-word
-Fine differences are computed by first splitting the current difference
-region into words and then passing the result to
-@code{ediff-diff-program}.  For the default forward word function (which is
-@code{ediff-forward-word}), a word is a string consisting of letters,
-@samp{-}, or @samp{_}; a string of punctuation symbols; a string of digits,
-or a string consisting of symbols that are neither space, nor a letter.
-
-This default behavior is controlled by four variables: @code{ediff-word-1},
-..., @code{ediff-word-4}.  See the on-line documentation for these variables
-and for the function @code{ediff-forward-word} for an explanation of how to
-modify these variables.
-@vindex ediff-word-1
-@vindex ediff-word-2
-@vindex ediff-word-3
-@vindex ediff-word-4
-@end table
-
-Sometimes, when a region has too many differences between the variants,
-highlighting of fine differences is inconvenient, especially on
-color displays.  If that is the case, type @kbd{*} with a negative
-prefix argument.  This unhighlights fine differences for the current
-region.
-
-To unhighlight fine differences in all difference regions, use the
-command @kbd{@@}.  Repeated typing of this key cycles through three
-different states: auto-refining, no-auto-refining, and no-highlighting
-of fine differences.
-
-@node Patch and Diff Programs, Merging and diff3, Refinement of Difference Regions, Customization
-@section Patch and Diff Programs
-
-This section describes variables that specify the programs to be used for
-applying patches and for computing the main difference regions (not the
-fine difference regions):
-
-@table @code
-@item ediff-diff-program
-@itemx ediff-diff3-program
-@vindex ediff-patch-program
-@vindex ediff-diff-program
-@vindex ediff-diff3-program
-These variables specify the programs to use to produce differences
-and do patching.
-
-@item ediff-diff-options
-@itemx ediff-diff3-options
-@vindex ediff-patch-options
-@vindex ediff-diff-options
-@vindex ediff-diff3-options
-These variables specify the options to pass to the above utilities.
-
-In @code{ediff-diff-options}, it may be useful to specify options
-such as @samp{-w} that ignore certain kinds of changes.  However,
-Ediff does not let you use the option @samp{-c}, as it doesn't recognize this
-format yet.
-
-@item ediff-coding-system-for-read
-@vindex ediff-coding-system-for-read
-This variable specifies the coding system to use when reading the output
-that the programs @code{diff3} and @code{diff} send to Emacs. The default
-is @code{raw-text}, and this should work fine in Unix and in most
-cases under Windows NT/95/98/2000. There are @code{diff} programs
-for which the default option doesn't work under Windows. In such cases,
-@code{raw-text-dos} might work. If not, you will have to experiment with
-other coding systems or use GNU diff.
-
-@item ediff-patch-program
-The program to use to apply patches.  Since there are certain
-incompatibilities between the different versions of the patch program, the
-best way to stay out of trouble is to use a GNU-compatible version.
-Otherwise, you may have to tune the values of the variables
-@code{ediff-patch-options}, @code{ediff-backup-specs}, and
-@code{ediff-backup-extension} as described below.
-@item ediff-patch-options
-Options to pass to @code{ediff-patch-program}.
-
-Note: the `-b' and `-z' options should be specified in
-`ediff-backup-specs', not in @code{ediff-patch-options}.
-
-It is recommended to pass the `-f' option to the patch program, so it won't
-ask questions.  However, some implementations don't accept this option, in
-which case the default value of this variable should be changed.
-
-@item ediff-backup-extension
-Backup extension used by the patch program.  Must be specified, even if
-@code{ediff-backup-specs} is given.
-@item ediff-backup-specs
-Backup directives to pass to the patch program.
-Ediff requires that the old version of the file (before applying the patch)
-is saved in a file named @file{the-patch-file.extension}.  Usually
-`extension' is `.orig', but this can be changed by the user, and may also be
-system-dependent.  Therefore, Ediff needs to know the backup extension used
-by the patch program.
-
-Some versions of the patch program let the user specify `-b backup-extension'.
-Other versions only permit `-b', which (usually) assumes the extension `.orig'.
-Yet others force you to use `-z'.
-
-Note that both `ediff-backup-extension' and `ediff-backup-specs' must be
-properly set.  If your patch program takes the option `-b', but not
-`-b extension', the variable `ediff-backup-extension' must still
-be set so Ediff will know which extension to use.
-
-@item ediff-custom-diff-program
-@itemx ediff-custom-diff-options
-@vindex ediff-custom-diff-program
-@vindex ediff-custom-diff-options
-@findex ediff-save-buffer
-Because Ediff limits the options you may want to pass to the @code{diff}
-program, it partially makes up for this drawback by letting you save the
-output from @code{diff} in your preferred format, which is specified via
-the above two variables.
-
-The output generated by @code{ediff-custom-diff-program} (which doesn't
-even have to be a standard-style @code{diff}!)@: is not used by Ediff.  It is
-provided exclusively so that you can
-refer to
-it later, send it over email, etc.  For instance, after reviewing the
-differences, you may want to send context differences to a colleague.
-Since Ediff ignores the @samp{-c} option in
-@code{ediff-diff-program}, you would have to run @code{diff -c} separately
-just to produce the list of differences.  Fortunately,
-@code{ediff-custom-diff-program} and @code{ediff-custom-diff-options}
-eliminate this nuisance by keeping a copy of a difference list in the
-desired format in a buffer that can be displayed via the command @kbd{D}.
-
-@item ediff-patch-default-directory
-@vindex ediff-patch-default-directory
-Specifies the default directory to look for patches.
-
-@end table
-
-@noindent
-@strong{Warning:} Ediff does not support the output format of VMS
-@code{diff}.  Instead, make sure you are using some implementation of POSIX
-@code{diff}, such as @code{gnudiff}.
-
-@node Merging and diff3, Support for Version Control, Patch and Diff Programs, Customization
-@section Merging and diff3
-
-Ediff supports three-way comparison via the functions @code{ediff-files3} and
-@code{ediff-buffers3}.  The interface is the same as for two-way comparison.
-In three-way comparison and merging, Ediff reports if any two difference
-regions are identical.  For instance, if the current region in buffer A
-is the same as the region in buffer C, then the mode line of buffer A will
-display @samp{[=diff(C)]} and the mode line of buffer C will display
-@samp{[=diff(A)]}.
-
-Merging is done according to the following algorithm.
-
-If a difference region in one of the buffers, say B, differs from the ancestor
-file while the region in the other buffer, A, doesn't, then the merge buffer,
-C, gets B's region.  Similarly when buffer A's region differs from
-the ancestor and B's doesn't, A's region is used.
-
-@vindex ediff-default-variant
-If both regions in buffers A and B differ from the ancestor file, Ediff
-chooses the region according to the value of the variable
-@code{ediff-default-variant}.  If its value is @code{default-A} then A's
-region is chosen.  If it is @code{default-B} then B's region is chosen.
-If it is @code{combined} then the region in buffer C will look like
-this:
-
-@comment Use @set to avoid triggering merge conflict detectors like CVS.
-@set seven-left <<<<<<<
-@set seven-right >>>>>>>
-@example
-@value{seven-left} variant A
-the difference region from buffer A
-@value{seven-right} variant B
-the difference region from buffer B
-####### Ancestor
-the difference region from the ancestor buffer, if available
-======= end
-@end example
-
-The above is the default template for the combined region. The user can
-customize this template using the variable
-@code{ediff-combination-pattern}.
-
-@vindex ediff-combination-pattern
-The variable @code{ediff-combination-pattern} specifies the template that
-determines how the combined merged region looks like.  The template is
-represented as a list of the form @code{(STRING1 Symbol1 STRING2 Symbol2
-STRING3 Symbol3 STRING4)}. The symbols here must be atoms of the form
-@code{A}, @code{B}, or @code{Ancestor}. They determine the order in which
-the corresponding difference regions (from buffers A, B, and the ancestor
-buffer) are displayed in the merged region of buffer C.  The strings in the
-template determine the text that separates the aforesaid regions. The
-default template is
-
-@smallexample
-("@value{seven-left} variant A" A "@value{seven-right} variant B" B
-   "####### Ancestor" Ancestor "======= end")
-@end smallexample
-
-@noindent
-(this is one long line) and the corresponding combined region is shown
-above. The order in which the regions are shown (and the separator
-strings) can be changed by changing the above template. It is even
-possible to add or delete region specifiers in this template (although
-the only possibly useful such modification seems to be the deletion of
-the ancestor).
-
-In addition to the state of the difference, Ediff displays the state of the
-merge for each region.  If a difference came from buffer A by default
-(because both regions A and B were different from the ancestor and
-@code{ediff-default-variant} was set to @code{default-A}) then
-@samp{[=diff(A) default-A]} is displayed in the mode line.  If the
-difference in buffer C came, say, from buffer B because the difference
-region in that buffer differs from the ancestor, but the region in buffer A
-does not (if merging with an ancestor) then @samp{[=diff(B) prefer-B]} is
-displayed.  The indicators default-A/B and prefer-A/B are inspired by
-Emerge and have the same meaning.
-
-Another indicator of the state of merge is @samp{combined}.  It appears
-with any difference region in buffer C that was obtained by combining
-the difference regions in buffers A and B as explained above.
-
-In addition to the state of merge and state of difference indicators, while
-merging with an ancestor file or buffer, Ediff informs the user when the
-current difference region in the (normally invisible) ancestor buffer is
-empty via the @emph{AncestorEmpty} indicator.  This helps determine if the
-changes made to the original in variants A and B represent pure insertion
-or deletion of text: if the mode line shows @emph{AncestorEmpty} and the
-corresponding region in buffers A or B is not empty, this means that new
-text was inserted.  If this indicator is not present and the difference
-regions in buffers A or B are non-empty, this means that text was
-modified.  Otherwise, the original text was deleted.
-
-Although the ancestor buffer is normally invisible, Ediff maintains
-difference regions there and advances the current difference region
-accordingly.  All highlighting of difference regions is provided in the
-ancestor buffer, except for the fine differences.  Therefore, if desired, the
-user can put the ancestor buffer in a separate frame and watch it
-there.  However, on a TTY, only one frame can be visible at any given time,
-and Ediff doesn't support any single-frame window configuration where all
-buffers, including the ancestor buffer, would be visible.  However, the
-ancestor buffer can be displayed by typing @kbd{/} to the control
-window.  (Type @kbd{C-l} to hide it again.)
-
-Note that the state-of-difference indicators @samp{=diff(A)} and
-@samp{=diff(B)} above are not redundant, even in the presence of a
-state-of-merge indicator.  In fact, the two serve different purposes.
-
-For instance, if the mode line displays @samp{=diff(B) prefer(B)} and
-you copy a difference region from buffer A to buffer C then
-@samp{=diff(B)} will change to @samp{diff-A} and the mode line will
-display @samp{=diff(A) prefer-B}.  This indicates that the difference
-region in buffer C is identical to that in buffer A, but originally
-buffer C's region came from buffer B.  This is useful to know because
-you can recover the original difference region in buffer C by typing
-@kbd{r}.
-
-
-Ediff never changes the state-of-merge indicator, except in response to
-the @kbd{!} command (see below), in which case the indicator is lost.
-On the other hand, the state-of-difference indicator is changed
-automatically by the copying/recovery commands, @kbd{a}, @kbd{b}, @kbd{r},
-@kbd{+}.
-
-The @kbd{!} command loses the information about origins of the regions
-in the merge buffer (default-A, prefer-B, or combined).  This is because
-recomputing differences in this case means running @code{diff3} on
-buffers A, B, and the merge buffer, not on the ancestor buffer.  (It
-makes no sense to recompute differences using the ancestor file, since
-in the merging mode Ediff assumes that you have not edited buffers A and
-B, but that you may have edited buffer C, and these changes are to be
-preserved.)  Since some difference regions may disappear as a result of
-editing buffer C and others may arise, there is generally no simple way
-to tell where the various regions in the merge buffer came from.
-
-In three-way comparison, Ediff tries to disregard regions that consist
-entirely of white space.  For instance, if, say, the current region in
-buffer A consists of the white space only (or if it is empty), Ediff will
-not take it into account for the purpose of computing fine differences.  The
-result is that Ediff can provide a better visual information regarding the
-actual fine differences in the non-white regions in buffers B and
-C.  Moreover, if the regions in buffers B and C differ in the white space
-only, then a message to this effect will be displayed.
-
-@vindex ediff-merge-window-share
-In the merge mode, the share of the split between window C (the window
-displaying the merge-buffer) and the windows displaying buffers A and B
-is controlled by the variable @code{ediff-merge-window-share}.  Its
-default value is 0.5.  To make the merge-buffer window smaller, reduce
-this amount.
-
-We don't recommend increasing the size of the merge-window to more than
-half the frame (i.e., to increase the value of
-@code{ediff-merge-window-share}) to more than 0.5, since it would be
-hard to see the contents of buffers A and B.
-
-You can temporarily shrink the merge window to just one line by
-typing @kbd{s}.  This change is temporary, until Ediff finds a reason to
-redraw the screen.  Typing @kbd{s} again restores the original window size.
-
-With a positive prefix argument, the @kbd{s} command will make the merge
-window slightly taller.  This change is persistent.  With `@kbd{-}' or
-with a negative prefix argument, the command @kbd{s} makes the merge
-window slightly shorter.  This change also persistent.
-
-@vindex ediff-show-clashes-only
-Ediff lets you automatically ignore the regions where only one of the
-buffers A and B disagrees with the ancestor.  To do this, set the
-variable @code{ediff-show-clashes-only} to non-@code{nil}.
-
-You can toggle this feature interactively by typing @kbd{$$}.
-
-Note that this variable affects only the show next/previous difference
-commands.  You can still jump directly to any difference region directly
-using the command @kbd{j} (with a prefix argument specifying the difference
-number).
-
-@vindex ediff-autostore-merges
-@vindex ediff-quit-merge-hook
-@findex ediff-maybe-save-and-delete-merge
-The variable @code{ediff-autostore-merges} controls what happens to the
-merge buffer when Ediff quits.  If the value is @code{nil}, nothing is done
-to the merge buffer---it will be the user's responsibility to save it.
-If the value is @code{t}, the user will be asked where to save the buffer
-and whether to delete it afterwards.  It the value is neither @code{nil} nor
-@code{t}, the merge buffer is saved @emph{only} if this merge session was
-invoked from a group of related Ediff session, such as those that result
-from @code{ediff-merge-directories},
-@code{ediff-merge-directory-revisions}, etc.
-@xref{Session Groups}.  This behavior is implemented in the function
-@code{ediff-maybe-save-and-delete-merge}, which is a hook in
-@code{ediff-quit-merge-hook}.  The user can supply a different hook, if
-necessary.
-
-The variable @code{ediff-autostore-merges} is buffer-local, so it can be
-set in a per-buffer manner.  Therefore, use @code{setq-default} to globally
-change this variable.
-
-@vindex ediff-merge-filename-prefix
-When merge buffers are saved automatically as directed by
-@code{ediff-autostore-merges}, Ediff attaches a prefix to each file, as
-specified by the variable @code{ediff-merge-filename-prefix}. The default
-is @code{merge_}, but this can be changed by the user.
-
-@node Support for Version Control, Customizing the Mode Line, Merging and diff3, Customization
-@section Support for Version Control
-
-
-Ediff supports version control and lets you compare versions of files
-visited by Emacs buffers via the function @code{ediff-revision}.  This
-feature is controlled by the following variables:
-
-@table @code
-@item ediff-version-control-package
-@vindex ediff-version-control-package
-A symbol.  The default is @samp{vc}.
-
-If you are like most Emacs users, Ediff will use VC as the version control
-package.  This is the standard Emacs interface to RCS, CVS, and SCCS.
-
-However, if your needs are better served by other interfaces, you will
-have to tell Ediff which version control package you are using, e.g.,
-@example
-(setq ediff-version-control-package 'rcs)
-@end example
-
-Apart from the standard @file{vc.el}, Ediff supports three other interfaces
-to version control: @file{rcs.el}, @file{pcl-cvs.el} (recently renamed
-pcvs.el), and @file{generic-sc.el}.  The package @file{rcs.el} is written
-by Sebastian Kremer  and is available as
-@example
-@file{ftp.cs.buffalo.edu:pub/Emacs/rcs.tar.Z}
-@file{ftp.uni-koeln.de:/pub/gnu/emacs/rcs.tar.Z}
-@end example
-@pindex @file{vc.el}
-@pindex @file{rcs.el}
-@pindex @file{pcl-cvs.el}
-@pindex @file{generic-sc.el}
-@end table
-
-Ediff's interface to the above packages allows the user to compare the
-versions of the current buffer or to merge them (with or without an
-ancestor-version).  These operations can also be performed on directories
-containing files under version control.
-
-In case of @file{pcl-cvs.el}, Ediff can also be invoked via the function
-@code{run-ediff-from-cvs-buffer}---see the documentation string for this
-function.
-
-@node Customizing the Mode Line, Miscellaneous, Support for Version Control, Customization
-@section Customizing the Mode Line
-
-When Ediff is running, the mode line of @samp{Ediff Control Panel}
-buffer shows the current difference number and the total number of
-difference regions in the two files.
-
-The mode line of the buffers being compared displays the type of the
-buffer (@samp{A:}, @samp{B:}, or @samp{C:}) and (usually) the file name.
-Ediff tries to be intelligent in choosing the mode line buffer
-identification.  In particular, it works well with the
-@file{uniquify.el} and @file{mode-line.el} packages (which improve on
-the default way in which Emacs displays buffer identification).  If you
-don't like the way Ediff changes the mode line, you can use
-@code{ediff-prepare-buffer-hook} to modify the mode line.
-@vindex ediff-prepare-buffer-hook
-@pindex @file{uniquify.el}
-@pindex @file{mode-line.el}
-
-@node Miscellaneous, Notes on Heavy-duty Customization, Customizing the Mode Line, Customization
-@section Miscellaneous
-
-Here are a few other variables for customizing Ediff:
-
-@table @code
-@item ediff-split-window-function
-@vindex ediff-split-window-function
-Controls the way you want the window be split between file-A and file-B
-(and file-C, if applicable).  It defaults to the vertical split
-(@code{split-window-vertically}, but you can set it to
-@code{split-window-horizontally}, if you so wish.
-Ediff also lets you switch from vertical to horizontal split and back
-interactively.
-
-Note that if Ediff detects that all the buffers it compares are displayed in
-separate frames, it assumes that the user wants them to be so displayed
-and stops splitting windows.  Instead, it arranges for each buffer to
-be displayed in a separate frame.  You can switch to the one-frame mode
-by hiding one of the buffers A/B/C.
-
-You can also swap the windows where buffers are displayed by typing
-@kbd{~}.
-
-@item ediff-merge-split-window-function
-@vindex ediff-merge-split-window-function
-Controls how windows are
-split between buffers A and B in the merge mode.
-This variable is like @code{ediff-split-window-function}, but it defaults
-to @code{split-window-horizontally} instead of
-@code{split-window-vertically}.
-
-@item ediff-make-wide-display-function
-@vindex ediff-make-wide-display-function
-The value is a function to be called to widen the frame for displaying
-the Ediff buffers.  See the on-line documentation for
-@code{ediff-make-wide-display-function} for details.  It is also
-recommended to look into the source of the default function
-@code{ediff-make-wide-display}.
-
-You can toggle wide/regular display by typing @kbd{m}.  In the wide
-display mode, buffers A, B (and C, when applicable) are displayed in a
-single frame that is as wide as the entire workstation screen.  This is
-useful when files are compared side-by-side.  By default, the display is
-widened without changing its height.
-
-@item ediff-use-last-dir
-@vindex ediff-use-last-dir
-Controls the way Ediff presents the
-default directory when it prompts the user for files to compare.  If
-@code{nil},
-Ediff uses the default directory of the current buffer when it
-prompts the user for file names.  Otherwise, it will use the
-directories it had previously used for files A, B, or C, respectively.
-
-@item ediff-no-emacs-help-in-control-buffer
-@vindex ediff-no-emacs-help-in-control-buffer
-If @code{t}, makes @kbd{C-h}
-behave like the @key{DEL} key, i.e., it will move you back to the previous
-difference rather than invoking help.  This is useful when, in an xterm
-window or a text-only terminal, the Backspace key is bound to @kbd{C-h} and is
-positioned more conveniently than the @key{DEL} key.
-
-@item ediff-toggle-read-only-function
-@vindex ediff-toggle-read-only-function
-This variable's value is a function that Ediff uses to toggle
-the read-only property in its buffers.
-
-The default function that Ediff uses simply toggles the read-only property,
-unless the file is under version control.  For a checked-in file under
-version control, Ediff first tries to check the file out.
-
-@item ediff-make-buffers-readonly-at-startup nil
-@vindex ediff-make-buffers-readonly-at-startup
-If @code{t}, all variant buffers are made read-only at Ediff startup.
-
-@item ediff-keep-variants
-@vindex @code{ediff-keep-variants}
-The default is @code{t}, meaning that the buffers being compared or merged will
-be preserved when Ediff quits.  Setting this to @code{nil} causes Ediff to
-offer the user a chance to delete these buffers (if they are not modified).
-Supplying a prefix argument to the quit command (@code{q}) temporarily
-reverses the meaning of this variable.  This is convenient when the user
-prefers one of the behaviors most of the time, but occasionally needs the
-other behavior.
-
-However, Ediff temporarily resets this variable to @code{t} if it is
-invoked via one of the "buffer" jobs, such as @code{ediff-buffers}.
-This is because it is all too easy to loose day's work otherwise.
-Besides, in a "buffer" job, the variant buffers have already been loaded
-prior to starting Ediff, so Ediff just preserves status quo here.
-
-Using @code{ediff-cleanup-hook}, one can make Ediff delete the variants
-unconditionally (e.g., by making @code{ediff-janitor} into one of these hooks).
-@item ediff-grab-mouse
-@vindex @code{ediff-grab-mouse}
-Default is @code{t}.  Normally, Ediff grabs mouse and puts it in its
-control frame.  This is useful since the user can be sure that when he
-needs to type an Ediff command the focus will be in an appropriate Ediff's
-frame.  However, some users prefer to move the mouse by themselves.  The
-above variable, if set to @code{maybe}, will prevent Ediff from grabbing
-the mouse in many situations, usually after commands that may take more
-time than usual.  In other situation, Ediff will continue grabbing the mouse
-and putting it where it believes is appropriate.  If the value is
-@code{nil}, then mouse is entirely user's responsibility.
-Try different settings and see which one is for you.
-@end table
-
-
-@node Notes on Heavy-duty Customization, , Miscellaneous, Customization
-@section Notes on Heavy-duty Customization
-
-Some users need to customize Ediff in rather sophisticated ways, which
-requires different defaults for different kinds of files (e.g., SGML,
-etc.).  Ediff supports this kind of customization in several ways.  First,
-most customization variables are buffer-local.  Those that aren't are
-usually accessible from within Ediff Control Panel, so one can make them
-local to the panel by calling make-local-variable from within
-@code{ediff-startup-hook}.
-
-Second, the function @code{ediff-setup} accepts an optional sixth
-argument which has the form @code{((@var{var-name-1} .@: @var{val-1})
-(@var{var-name-2} .@: @var{val-2}) @dots{})}.  The function
-@code{ediff-setup} sets the variables in the list to the respective
-values, locally in the Ediff control buffer.  This is an easy way to
-throw in custom variables (which usually should be buffer-local) that
-can then be tested in various hooks.
-
-Make sure the variable @code{ediff-job-name} and @code{ediff-word-mode} are set
-properly in this case, as some things in Ediff depend on this.
-
-Finally, if you want custom-tailored help messages, you can set the
-variables @code{ediff-brief-help-message-function} and
-@code{ediff-long-help-message-function}
-to functions that return help strings.
-@vindex ediff-startup-hook
-@findex ediff-setup
-@vindex ediff-job-name
-@vindex ediff-word-mode
-@vindex ediff-brief-help-message-function
-@vindex ediff-long-help-message-function
-
-When customizing Ediff, some other variables are useful, although they are
-not user-definable.  They are local to the Ediff control buffer, so this
-buffer must be current when you access these variables.  The control buffer
-is accessible via the variable @code{ediff-control-buffer}, which is also
-local to that buffer.  It is usually used for checking if the current buffer
-is also the control buffer.
-
-Other variables of interest are:
-@table @code
-@item ediff-buffer-A
-The first of the data buffers being compared.
-
-@item ediff-buffer-B
-The second of the data buffers being compared.
-
-@item ediff-buffer-C
-In three-way comparisons, this is the third buffer being compared.
-In merging, this is the merge buffer.
-In two-way comparison, this variable is @code{nil}.
-
-@item ediff-window-A
-The window displaying buffer A.  If buffer A is not visible, this variable
-is @code{nil} or it may be a dead window.
-
-@item ediff-window-B
-The window displaying buffer B.
-
-@item ediff-window-C
-The window displaying buffer C, if any.
-
-@item ediff-control-frame
-A dedicated frame displaying the control buffer, if it exists.  It is
-non-@code{nil} only if Ediff uses the multiframe display, i.e., when
-the control buffer is in its own frame.
-@end table
-
-@node Credits, Index, Customization, Top
-@chapter Credits
-
-Ediff was written by Michael Kifer .  It was inspired
-by emerge.el written by Dale R.@: Worley .  An idea due to
-Boris Goldowsky  made it possible to highlight
-fine differences in Ediff buffers.  Alastair Burt 
-ported Ediff to XEmacs, Eric Freudenthal 
-made it work with VC, Marc Paquette  wrote the
-toolbar support package for Ediff, and Hrvoje Niksic 
-adapted it to the Emacs customization package.
-
-Many people provided help with bug reports, feature suggestions, and advice.
-Without them, Ediff would not be nearly as useful as it is today.
-Here is a hopefully full list of contributors:
-
-@example
-Adrian Aichner (aichner@@ecf.teradyne.com),
-Drew Adams (drew.adams@@oracle.com),
-Steve Baur (steve@@xemacs.org),
-Neal Becker (neal@@ctd.comsat.com),
-E.@: Jay Berkenbilt (ejb@@ql.org),
-Alastair Burt (burt@@dfki.uni-kl.de),
-Paul Bibilo (peb@@delcam.co.uk),
-Kevin Broadey (KevinB@@bartley.demon.co.uk),
-Harald Boegeholz (hwb@@machnix.mathematik.uni-stuttgart.de),
-Bradley A.@: Bosch (brad@@lachman.com),
-Michael D.@: Carney (carney@@ltx-tr.com),
-Jin S.@: Choi (jin@@atype.com),
-Scott Cummings (cummings@@adc.com),
-Albert Dvornik (bert@@mit.edu),
-Eric Eide (eeide@@asylum.cs.utah.edu),
-Paul Eggert (eggert@@twinsun.com),
-Urban Engberg (ue@@cci.dk),
-Kevin Esler (esler@@ch.hp.com),
-Robert Estes (estes@@ece.ucdavis.edu),
-Jay Finger (jayf@@microsoft.com),
-Xavier Fornari (xavier@@europe.cma.fr),
-Eric Freudenthal (freudent@@jan.ultra.nyu.edu),
-Job Ganzevoort (Job.Ganzevoort@@cwi.nl),
-Felix Heinrich Gatzemeier (felix.g@@tzemeier.info),
-Boris Goldowsky (boris@@cs.rochester.edu),
-Allan Gottlieb (gottlieb@@allan.ultra.nyu.edu),
-Aaron Gross (aaron@@bfr.co.il),
-Thorbjoern Hansen (thorbjoern.hansen@@mchp.siemens.de),
-Marcus Harnisch (marcus_harnisch@@mint-tech.com),
-Steven E. Harris (seh@@panix.com),
-Aaron S. Hawley (Aaron.Hawley@@uvm.edu),
-Xiaoli Huang (hxl@@epic.com),
-Andreas Jaeger (aj@@suse.de),
-Lars Magne Ingebrigtsen (larsi@@ifi.uio.no),
-Larry Gouge (larry@@itginc.com),
-Karl Heuer (kwzh@@gnu.org),
-(irvine@@lks.csi.com),
-(jaffe@@chipmunk.cita.utoronto.ca),
-David Karr (dkarr@@nmo.gtegsc.com),
-Norbert Kiesel (norbert@@i3.informatik.rwth-aachen.de),
-Leigh L Klotz (klotz@@adoc.xerox.com),
-Fritz Knabe (Fritz.Knabe@@ecrc.de),
-Heinz Knutzen (hk@@informatik.uni-kiel.d400.de),
-Andrew Koenig (ark@@research.att.com),
-Hannu Koivisto (azure@@iki.fi),
-Ken Laprade (laprade@@dw3f.ess.harris.com),
-Will C Lauer (wcl@@cadre.com),
-Richard Levitte (levitte@@e.kth.se),
-Mike Long (mike.long@@analog.com),
-Dave Love (d.love@@dl.ac.uk),
-Martin Maechler (maechler@@stat.math.ethz.ch),
-Simon Marshall (simon@@gnu.org),
-Paul C. Meuse (pmeuse@@delcomsys.com),
-Richard Mlynarik (mly@@adoc.xerox.com),
-Stefan Monnier (monnier@@cs.yale.edu),
-Chris Murphy (murphycm@@sun.aston.ac.uk),
-Erik Naggum (erik@@naggum.no),
-Eyvind Ness (Eyvind.Ness@@hrp.no),
-Ray Nickson (nickson@@cs.uq.oz.au),
-Dan Nicolaescu (dann@@ics.uci.edu),
-David Petchey (petchey_david@@jpmorgan.com),
-Benjamin Pierce (benjamin.pierce@@cl.cam.ac.uk),
-Francois Pinard (pinard@@iro.umontreal.ca),
-Tibor Polgar (tlp00@@spg.amdahl.com),
-David Prince (dave0d@@fegs.co.uk),
-Paul Raines (raines@@slac.stanford.edu),
-Stefan Reicher (xsteve@@riic.at),
-Charles Rich (rich@@merl.com),
-Bill Richter (richter@@math.nwu.edu),
-C.S.@: Roberson (roberson@@aur.alcatel.com),
-Kevin Rodgers (kevin.rodgers@@ihs.com),
-Sandy Rutherford (sandy@@ibm550.sissa.it),
-Heribert Schuetz (schuetz@@ecrc.de),
-Andy Scott (ascott@@pcocd2.intel.com),
-Axel Seibert (axel@@tumbolia.ppp.informatik.uni-muenchen.de),
-Vin Shelton (acs@@xemacs.org),
-Scott O. Sherman (Scott.Sherman@@mci.com),
-Richard Stallman (rms@@gnu.org),
-Richard Stanton (stanton@@haas.berkeley.edu),
-Sam Steingold (sds@@goems.com),
-Ake Stenhoff (etxaksf@@aom.ericsson.se),
-Stig (stig@@hackvan.com),
-Peter Stout (Peter_Stout@@cs.cmu.edu),
-Chuck Thompson (cthomp@@cs.uiuc.edu),
-Ray Tomlinson (tomlinso@@bbn.com),
-Raymond Toy (toy@@rtp.ericsson.se),
-Stephen J. Turnbull  (stephen@@xemacs.org),
-Jan Vroonhof (vroonhof@@math.ethz.ch),
-Colin Walters (walters@@cis.ohio-state.edu),
-Philippe Waroquiers (philippe.waroquiers@@eurocontrol.be),
-Klaus Weber (gizmo@@zork.north.de),
-Ben Wing (ben@@xemacs.org),
-Tom Wurgler (twurgler@@goodyear.com),
-Steve Youngs (youngs@@xemacs.org),
-Ilya Zakharevich (ilya@@math.ohio-state.edu),
-Eli Zaretskii (eliz@@is.elta.co.il)
-@end example
-
-@node Index, , Credits, Top
-@unnumbered Index
-@printindex cp
-
-@setchapternewpage odd
-@contents
-@bye
-
-@ignore
-   arch-tag: 165ecb88-d03c-44b1-a921-b93f50b05b46
-@end ignore
diff --git a/xemacs-packages/man/edit-utils/edit-utils.texi b/xemacs-packages/man/edit-utils/edit-utils.texi
deleted file mode 100644
index 2b92841b..00000000
--- a/xemacs-packages/man/edit-utils/edit-utils.texi
+++ /dev/null
@@ -1,3969 +0,0 @@
-@c -*-texinfo-*-
-@c
-@c Copyright (C) 2002, 2003 Free Software Foundation, Inc.
-@c Copyright (C) 2003 Jake Colman
-@c
-@c @setfilename edit-utils.info
-@settitle Editing Utilities for XEmacs
-@ifinfo
-@dircategory XEmacs Editor
-@direntry
-* Edit Utilities: (edit-utils).	Editing Utilities for XEmacs.
-@end direntry
-@end ifinfo
-
-@c @copying
-This manual is part of XEmacs.
-
-XEmacs 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.
-
-XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-@c @end copying
-
-@node Top, Copying, (dir), (dir)
-@chapter The Editing Utilities Package
-
-@ifinfo
-This Info file contains the manual for the Editing Utilities package.
-@end ifinfo
-
-The node name for each entry in the menu is the name of the elisp file
-containing the code that implements the functionality described.  It is
-highly recommended that you briefly peruse the elisp source code since it can
-provide valuable information on usage and technique.  This can easily be done
-by typing @code{C-x 4 l  RET} where  is the name of the
-elisp file to be loaded.
-
-@menu
-* Copying::                     Why this manual is GPL, and what that means
-
-Buffer and Window Management
-* compare-w::		        Comparing Windows
-* detached-minibuf::	        Detached Minibuffers
-* iswitchb::	                Convenient Buffer Switching
-* permanent-buffers::           Permanent Buffers
-* rsz-minibuf::                 Self-Resizing Minibuffer
-* search-buffers::              Searching Many Buffers
-* uniquify::                    Meaningful Unique Names
-* winring::                     Window Configuration Rings
-* autorevert::                  Reverting Buffers
-
-Editing Help
-* foldout::                     Folding Extensions for Outline-Mode
-* func-menu::		        Jump to a Function Within a Buffer.
-* id-select::                   Select Syntax-Driven Regions in a Buffer
-* outl-mouse::                  Outline-Mode Mouse Commands
-* page-ext::			Extended Page Handling Commands
-* power-macros::		Power Macros - Keyboard Macros Made Easy
-* redo::			Redo/Undo System
-* scroll-in-place::		Scrolling In Place
-* setnu::                       VI-style Line Number Mode
-* vertical-mode::		Vertical Mode - Editing of Vertical Text
-* align::                       Align Text to a Specific Column, By Regexp
-* allout::                      Extensive Outline Mode
-* narrow-stack::                Extending the built-in narrowing functions
-
-File Management
-* backup-dir::	                Specify Directories to be Used for Backup Files
-
-Session Management
-* bookmark::			Create annotated bookmarks
-* desktop::			Save Partial Status of Emacs When Killed
-* recent-files::                Recent File Navigation
-* resume::			Resuming a Suspended Emacs Job
-* saveconf::                    Save Buffer/Window Configuration Between Sessions
-* savehist::		        Save Minibuffer History
-* saveplace::                   Automatically Save Place in Files
-* where-was-i-db::              Keep Persistent State in Visited Files
-
-Abbreviations
-* completion::                  Completion
-* dabbrev::                     Dynamic Abbreviations
-* hippie-exp::		        Hippie Expand
-* icomplete::                   Interactive Minibuffer Completion
-* tempo::                       Flexible Template Insertion
-
-Display, Faces, and Highlighting:
-* avoid::                       Move Mouse Pointer Out of the Way of Editing
-* blink-cursor::		Blinking Cursor
-* fast-lock::                   Speeding Up Font Lock Mode
-* lazy-lock::                   Lazy Demand-Driven Fontification
-* lazy-shot::	                Another Lazy Demand-Driven Fontification
-* mic-paren::                   Advanced Highlighting of Matching Parentheses
-* paren::			Highlight (Un)matching Parens and Whole Expressions
-* shell-font::                  Decorate a Shell Buffer With Fonts
-* highline::                    Highlight the Current Line in the Buffer
-
-Low-Level Editing Hacks:
-* after-save-commands::	        Hooks Invoked After Saving a File
-* atomic-extents::              Indivisible Blocks of Text
-* array::                       Table and Array Editor
-
-Menu and Toolbar Support:
-* floating-toolbar::            Floating Toolbar
-* The Toolbar Utilities::	Creating and Managing Toolbars and Buttons.
-
-Miscellaneous:
-* flow-ctrl::                   Flow Control
-* makesum::			Generate Summary of All Key Binding
-* man::                         Browse UNIX manual pages
-
-Undocumented:
-* abbrevlist::                  Abbreviation List
-* file-part::                   Treat a Section of a Buffer as a Separate File
-* info-look::                   Major-Mode-Sensitive Info Index Lookup Facility
-* live-icon::                   Make Frame Icons Represent Current Frame Contents
-* mode-motion+::		Per Mode/Buffer Mouse Tracking With Highlighting
-* popper::                      Shrink-Wrapped Temporary Windows
-* reportmail::                  Display Time and Load in Mode Line
-* balloon-help::                Balloon Help and Tooltips
-* blink-paren::	                Blinking Parentheses
-* edit-faces::                  Face Editor
-* lispm-fonts::                 lispm-fonts
-* big-menubar::                 Big Menubar
-* tree-menu::                   tree-menu.el
-
-Appendices:
-* XEmacs License::		The GNU General Public License
-@end menu
-
-@node Copying, compare-w, Top, Top
-@chapter Copying
-
-This document may be redistributed, verbatim or in modified form, under
-the terms of the GNU General Public License, version 2 or any later
-version.  The same terms apply to the libraries it documents.  A copy
-of the General Public License is provided as an Appendix.
-
-Most XEmacs documentation has its own license, which is an ancestor of
-the GNU Free Documentation License (@dfn{FDL}), and whose terms are
-quite similar to those imposed by GNU on Emacs documentation.  Why is
-this manual licensed differently (under the GNU General Public License,
-or @dfn{GPL}), and why does it have to be distributed separately from
-the XEmacs User's Guide and the XEmacs Lisp Reference Manual?
-
-Taking the second question first, XEmacs is @dfn{community-owned}
-software.  That is, unlike GNU Emacs, there is no monopoly copyright
-holder.  Many of us, including the original Lucid authors, have
-contributed our copyrights to the Free Software Foundation (FSF), and of
-course much content is derived from GNU Emacs, and therefore is held by
-the FSF.  Another large chunk is held by Sun Microsystems, and a few
-individual authors hold copyright to thousands of lines each.  But many
-individuals hold copyright to only a few dozen lines.  Like the Linux
-kernel, copyright ownership is distributed throughout a community.
-
-However, its license is ``copyleft,'' @emph{i.e.}, it @emph{requires}
-that you redistribute it under terms @emph{identical} to those under
-which you received it, unless you have explicit permission of the
-copyright holder.  Because of the multiple owners, determining the
-ownership of any given part of XEmacs is tedious, and perhaps
-impossible.  For practical purposes, then, the license of any
-substantial chunk of existing XEmacs content cannot be changed, except
-to a later version of the GPL, for those parts under GPL.  (That is due
-to the @emph{explicit} permission to change to a later version of the
-GPL, present in every file of XEmacs.)
-
-Unfortunately, this severe restriction means that the GPL, FDL, and the
-XEmacs documentation license (@dfn{XDL}) are @emph{mutually
-incompatible}.  That is, content licensed under any of the GPL, FDL, or
-XDL @emph{may not} be mixed with content licensed under either of the
-other two without changing the license of some of the content.  But this
-requires permission of the copyright holder, which is often difficult or
-impossible to get.
-
-For example, you @emph{may not} take comments or docstrings from XEmacs
-code and add them to the Lispref to mend a gap in the latter's coverage.
-You @emph{may not} copy text from the Lispref into docstrings in the
-code.  And you @emph{may not} copy text from the GNU Emacs Lisp
-Reference to the XEmacs Lisp Reference Manual.  (In this case it is at
-least trivial to ask permission, although it is rather unclear whether
-it would be granted.)
-
-In fact, parts of this document were derived by copying from XEmacs code
-under the GPL, without any further permission from the authors.  Thus,
-this document must be distributed under the GPL, as a ``volume''
-separate from the XEmacs documentation under the XDL.  Note that the
-``mere aggregation'' clauses allow us to distribute in the same
-tarball.  But incorporating it as a node in the Lispref is prohibited,
-even if done by inclusion.
-
-A bit of advocacy:
-
-If you look carefully at the additional restrictions imposed by the
-soi-disant "free" documentation licenses, you discover that they are
-simply proprietary restrictions guaranteeing a certain amount of
-@emph{unpaid} political advertising to the Free Software Foundation and
-GNU Project (and in the case of the FDL, this is extended to commercial
-advertising by authors of original or derived works).  Whether this is
-``ethically justified'' or not is a difficult question.  What is certain
-is that there is little social benefit to these terms (since the license
-documents themselves contain the advocacy and must be included with any
-distribution).
-
-I conclude it makes sense for XEmacs to reduce its restrictions, where
-possible, to the ``least common denominator,'' the GNU General Public
-License.
-
-@node compare-w, detached-minibuf, Copying, Top
-@chapter Comparing Windows
-
-This package provides one entry point, compare-windows.  It compares text
-starting from point in two adjacent windows, advancing point until it finds a
-difference.  There are variables to permit ignoring of whitespace
-differences, or case differences, or both.
-
-@node detached-minibuf, iswitchb, compare-w, Top
-@chapter Detached Minibuffers
-
-This package creates a standalone minibuffer in its own frame.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET detached-minibuf RET
-@end example
-
-@node iswitchb, permanent-buffers, detached-minibuf, Top
-@chapter Convenient Buffer Switching
-
-With this package installed, as you type in a substring, the list of buffers
-currently matching the substring are displayed as you type.  The list is
-ordered so that the most recent buffers visited come at the start of the
-list.  The buffer at the start of the list will be the one visited when you
-press return.  By typing more of the substring, the list is narrowed down so
-that gradually the buffer you want will be at the top of the list.
-Alternatively, you can use @kbd{C-s} and @kbd{C-r} to rotate buffer names in
-the list until the one you want is at the top of the list.  Completion is
-also available so that you can see what is common to all of the matching
-buffers as you type.
-
-For example, let's say we have two buffers called "123456" and "123", with
-"123456" the most recent. When I use @samp{iswitchb}, I first of all get
-presented with the list of all the buffers
-
-@samp{iswitch @{123456,123@}}
-
-If I then press @kbd{2}:
-
-@samp{iswitch 2[3]@{123456,123@}}
-
-The list in @{@} are the matching buffers, most recent first (buffers visible
-in the current frame are put at the end of the list by default).  At any time
-I can select the item at the head of the list by pressing @kbd{RET}.  I can
-also bring the put the first element at the end of the list by pressing
-@kbd{C-s}, or put the last element at the head of the list by pressing
-@kbd{C-r}.  The item in [] indicates what can be added to my input by
-pressing @kbd{TAB}.  In this case, I will get @samp{3} added to my input.
-So, press @kbd{TAB}:
-
-@samp{iswitch 23@{123456,123@}}
-
-At this point, I still have two matching buffers.  If I want the first buffer
-in the list, I simply press @kbd{RET}.  If I wanted the second in the list, I
-could press @kbd{C-s} to move it to the top of the list and then @kbd{RET} to
-select it.
-
-However, If I type @kbd{4}, I only have one match left:
-
-@samp{iswitch 234[123456] [Matched]}
-
-Since there is only one matching buffer left, it is given in @samp{[]} and we
-see the text @samp{[Matched]} afterwards.  I can now press @kbd{TAB} or
-@kbd{RET} to go to that buffer.
-
-If however, I now type @kbd{a}:
-
-@samp{iswitch 234a [No match]}
-
-There are no matching buffers.  If I press @kbd{RET} or @kbd{TAB}, I can be
-prompted to create a new buffer called "234a".
-
-Of course, where this function comes in really useful is when you can specify
-the buffer using only a few keystrokes.  In the above example, the quickest
-way to get to the "123456" buffer would be just to type @kbd{4} and then
-@kbd{RET} (assuming there isn't any newer buffer with "4" in its name).
-
-To see a full list of all matching buffers in a separate buffer, hit @kbd{?}
-or press @kbd{TAB} when there are no further completions to the substring.
-Repeated @kbd{TAB} presses will scroll you through this separate buffer.
-
-The buffer at the head of the list can be killed by pressing @kbd{C-k}.  If
-the buffer needs saving, you will be queried before the buffer is killed.
-
-If you find that the file you are after is not in a buffer, you can press
-@kbd{C-x C-f} to immediately drop into find-file.
-
-To see the doc string of iswitchb for full keybindings and features, type:
-
-@example
-  M-x describe-function RET iswitchb
-@end example
-
-@menu
-* Customization: iswitchb-cust.
-* Changing the Display::
-* Regexp Matching::
-* Replacement for read-buffer::
-@end menu
-
-@node iswitchb-cust, Changing the Display, iswitchb, iswitchb
-@section Customization
-
-To configure the package, type:
-
-@example
-  M-x customize-group RET iswitchb RET
-@end example
-
-To install this package on the default keys used for buffer switching, type:
-
-@example
-  M-x iswitchb-default-keybindings RET
-@end example
-
-To modify the default keybindings, use the hook provided.  For example, the
-following code can be added to your initialization file:
-
-@example
-  (add-hook 'iswitchb-define-mode-map-hook 'iswitchb-my-keys)
-
-  (defun iswitchb-my-keys ()
-    "Add my keybindings for iswitchb."
-    (define-key iswitchb-mode-map " " 'iswitchb-next-match)
-    )
-@end example
-
-@node Changing the Display, Regexp Matching, iswitchb-cust, iswitchb
-@section Changing the Display
-
-If you have many matching buffers, they may not all fit onto one line of the
-minibuffer.  In this case, you should use @code{(resize-minibuffer-mode)}
-@xref{rsz-minibuf}.  You can also limit iswitchb so that it only shows a
-certain number of lines.  To do this, see the documentation for
-@code{iswitchb-minibuffer-setup-hook}.
-
-By default, the list of current buffers is most recent first, oldest last,
-with the exception that the buffers visible in the current frame are put at
-the end of the list.  A hook exists to allow other functions to order the
-list.  For example, if you add:
-
-@example
-  (add-hook 'iswitchb-make-buflist-hook 'iswitchb-summaries-to-end)
-@end example
-
-then all buffers matching "Summary" are moved to the end of the list.  (I
-find this handy for keeping the INBOX Summary and so on out of the way.)  It
-also moves buffers matching "output\*$" to the end of the list (these are
-created by AUC TeX when compiling.)  Other functions could be made available
-which alter the list of matching buffers (either deleting or rearranging
-elements.)
-
-If you have font-lock loaded, the first matching buffer is highlighted.  To
-switch this off, set @code{(setq iswitchb-use-fonts nil)}. I don't use
-font-lock that much, so I've hardcoded the faces.  If this is too harsh, let
-me know.  Colouring of the matching buffer name was suggested by Carsten
-Dominik (dominik@@strw.leidenuniv.nl)
-
-@node Regexp Matching, Replacement for read-buffer, Changing the Display, iswitchb
-@section Regexp Matching
-
-There is limited provision for regexp matching within @code{iswitchb},
-enabled through @code{iswitchb-regexp}.  This allows you to type @kbd{c$} for
-example and see all buffer names ending in `c'.  This facility is quite
-limited though in two respects.  First, you can't currently type in
-expressions like `[0-9]' directly -- you have to type them in when
-@code{iswitchb-regexp} is @code{nil} and then toggle on the regexp
-functionality.  Likewise, don't enter an expression containing `\' in regexp
-mode.  If you try, iswitchb gets confused, so just hit @kbd{C-g} and try
-again.  Secondly, no completion mechanism is currently offered when regexp
-searching.
-
-@node Replacement for read-buffer,  , Regexp Matching, iswitchb
-@section Replacement for read-buffer
-
-iswitchb-read-buffer has been written to be a drop in replacement for the
-normal buffer selection routine @code{read-buffer}.  To use iswitch for all
-buffer selections in Emacs, add: @code{(setq read-buffer-function
-'iswitchb-read-buffer)} (This variable should be present in Emacs 20.3+)
-XEmacs users can get the same behaviour by doing: @code{(defalias
-'read-buffer 'iswitchb-read-buffer)} since @code{read-buffer} is defined in
-lisp.
-
-@node permanent-buffers, rsz-minibuf, iswitchb, Top
-@chapter Permanent Buffers
-
-A permanent buffer is a buffer that you don't want to kill, mainly used for
-testing or temporary stuff. The *scratch* buffer is the most famous example
-of what could be a permanent buffer. This package allows you to define
-several permanent buffers (the scratch buffer can be one of them) that will
-never disappear. If you kill them or save their contents, they will be
-regenerated. You can also specify a set of lisp forms to eval in the buffer
-when it is (re)generated.
-
-This package is implemented in a minor-mode fashion. You can customize the
-default value of @code{permanent-buffers-mode} or use
-@code{turn-on-permanent-buffers} at startup. Within an XEmacs session, use
-@code{permanent-buffers-mode} or @code{turn-o[n|ff]-permanent-buffers}. You
-might also want to customize @code{permanent-buffers-alist}.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET permanent-buffers RET
-@end example
-
-@node rsz-minibuf, search-buffers, permanent-buffers, Top
-@chapter Self-Resizing Minibuffer
-
-This package allows the entire contents (or as much as possible) of the
-minibuffer to be visible at once when typing.  As the end of a line is
-reached, the minibuffer will resize itself.  When the user is done typing,
-the minibuffer will return to its original size.
-
-In window systems where it is possible to have a frame in which the
-minibuffer is the only window, the frame itself can be resized.
-
-Note that the minibuffer and echo area are not the same!  They simply happen
-to occupy roughly the same place on the frame.  Messages put in the echo area
-will not cause any resizing by this package.
-
-This package is considered a minor mode but it doesn't put anything in
-minor-mode-alist because this mode is specific to the minibuffer, which has
-no modeline.
-
-To invoke this mode, type:
-
-@example
-  M-x resize-minibuffer-mode RET
-@end example
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET resize-minibuffer RET
-@end example
-
-@node search-buffers, uniquify, rsz-minibuf, Top
-@chapter Searching Many Buffers
-
-This package searches all live buffers for REGEXP and presents matching lines
-in a separate buffer with hyperlinks to their occurrences.
-
-After creating countless buffers in an XEmacs session, the user can execute
-the following:
-
-@example
-  M-x list-matches-in-buffers RET \ RET .* RET
-@end example
-
-to find all matches of the single word "problem" in any of them.  The result
-is presented in a buffer named "*Matches for "\" in buffers*" with
-hyperlinks to any occurrence.  User may navigate to the next (@kbd{n}) or
-previous (@kbd{p}) match.
-
-@node uniquify, winring, search-buffers, Top
-@chapter Meaningful Unique Names
-
-Emacs' standard method for making buffer names unique adds <2>, <3>, etc. to
-the end of (all but one of) the buffers.  This file replaces that behavior,
-for buffers visiting files and dired buffers, with a uniquification that adds
-parts of the file name until the buffer names are unique.  For instance,
-buffers visiting @file{/u/mernst/tmp/Makefile} and
-@file{/usr/projects/zaphod/Makefile} would be named @samp{Makefile|tmp} and
-@samp{Makefile|zaphod}, respectively (instead of @samp{Makefile} and
-@samp{Makefile<2>}).  Other buffer name styles are also available.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET uniquify RET
-@end example
-
-@node winring, autorevert, uniquify, Top
-@chapter Window Configuration Rings
-
-This package provides lightweight support for circular rings of window
-configurations.  A window configuration is the layout of windows and
-associated buffers within a frame.  There is always at least one
-configuration on the ring, the current configuration.  You can create new
-configurations and cycle through the layouts in either direction.  You can
-also delete configurations from the ring (except the last one of course!).
-Window configurations are named, and you can jump to and delete named
-configurations.
-
-Window configuration rings are frame specific.  That is, each frame has its
-own ring which can be cycled through independently of other frames.
-
-You are always looking at the current window configuration for each frame,
-which consists of the windows in the frame, the buffers in those windows, and
-point in the current buffer.  As you run commands such as @kbd{C-x 4 b},
-@kbd{C-x 2}, and @kbd{C-x 0} you are modifying the current window
-configuration.  When you jump to a new configuration, the layout that existed
-before the jump is captured, and the ring is rotated to the selected
-configuration.  Window configurations are captured with
-@code{current-window-configuration}, however winring also saves point for the
-current buffer.
-
-To use, add the following to your initialization file:
-
-@example
-  (winring-initialize)
-@end example
-
-Note that by default, this binds the winring keymap to the @kbd{C-x 7}
-prefix, but you can change this by setting the value of
-@code{winring-keymap-prefix}, before you call @code{winring-initialize}.
-
-The following commands are defined:
-
-@table @kbd
-
-@item C-x 7 n 
-
-Create a new window configuration.  The new configuration will contain a
-single buffer, the one named in the variable
-@code{winring-new-config-buffer-name}.
-
-With @kbd{C-u}, winring prompts for the name of the new configuration.  If
-you don't use @kbd{C-u} the function in @code{winring-name-generator} will be
-called to get the new configuration's name.
-
-@item C-x 7 2 
-
-Create a duplicate of the current window configuration.  C-u
-has the same semantics as with @kbd{C-x 7 c}.
-
-@item C-x 7 j 
-
-Jump to a named configuration (prompts for the name).
-
-@item C-x 7 0
-
-Kill the current window configuration and rotate to the previous layout on
-the ring.  You cannot delete the last configuration in the ring.  With
-@kbd{C-u}, prompts for the name of the configuration to kill.
-
-@item C-x 7 o
-
-Go to the next configuration on the ring.
-
-@item C-x 7 p
-
-Go to the previous configuration on the ring.
-
-Note that the sequence `C-x 7 o C-x 7 p' is a no-op; it leaves you in the
-same configuration you were in before the sequence.
-
-@item C-x 7 r
-
-Rename the current window configuration.
-
-@item C-x 7 b
-
-Submit a bug report on winring.
-
-@item C-x 7 v
-
-Echo the winring version.
-
-@end table
-
-As mentioned, window configuration names can be displayed in the modeline.
-The default value of @code{winring-show-names} is currently @code{nil} by
-default. Set it to @code{t} to activate.  If you don't like the position in
-the modeline where winring names are shown, you can change this by passing in
-your own modeline hacker function to @code{winring-initialize}.
-
-@menu
-* History::
-* Related Packages::
-@end menu
-
-@node History, Related Packages, winring, winring
-@section History
-
-A long long time ago there was a package called `wicos' written by Heikki
-Suopanki, which was based on yet another earlier package called `screens'
-also written by Suopanki.  This in turn was based on the Unix tty session
-manager `screen' (unrelated to Emacs) by Oliver Laumann, Juergen Weigert, and
-Michael Schroeder.
-
-Wicos essentially provided fancy handling for window configurations.  I liked
-the basic ideas, but wicos broke with later versions of Emacs and XEmacs.  I
-re-implemented just the functionality I wanted, simplifying things in the
-process, and porting the code to run with XEmacs 19 and 20, and Emacs 20 (I
-don't know if winring works in Emacs 19.34).
-
-Wicos used the M-o prefix which I've recently changed to C-x 7 as the
-default, by suggestion of RMS.  Wicos also had some support for multiple
-frames, and saving configurations on all visible frames, but it didn't work
-too well, and I like frame independent rings better.
-
-@node Related Packages,  , History, winring
-@section Related Packages
-
-I know of a few other related packages:
-
-@itemize @bullet
-
-@item
-
-`escreen' by Noah Friedman.  A much more ambitious package that does Emacs
-window session management.  Very cool, but I wanted something more
-lightweight.
-
-@item 
-
-`wconfig' by Bob Weiner as part of Hyperbole.  I think wconfig is similar in
-spirit to winring; it seems to have also have named window configurations,
-but not frame-specific window rings.
-
-@item
-
-`winner' by Ivar Rummelhoff.  This package comes with Emacs 20, and appears
-to differ from winring by providing undo/redo semantics to window
-configuration changes.  winner is a minor mode and does seem to support
-frame-specific window rings.
-
-@item
-
-window-xemacs' by the XEmacs Development Team.  It appears that this package,
-which is specific to XEmacs (and perhaps just XEmacs 20) implements stacks of
-window configurations which are frame independent.
-
-@end itemize
-
-Please feel free to email me if my rendition of history, or my
-explanation of the related packages, is inaccurate.
-
-@node autorevert, backup-dir, winring, Top
-@chapter Reverting Buffers
-
-Whenever a file that Emacs is editing has been changed by another program the
-user normally has to execute the command `revert-buffer' to load the new
-content of the file into Emacs.
-
-This package is defined in autorevert.el and contains two minor modes: Global
-Auto-Revert Mode and Auto-Revert Mode.  Both modes automatically revert
-buffers whenever the corresponding files have been changed on disk.
-
-Auto-Revert Mode can be activated for individual buffers.  Global Auto-Revert
-Mode applies to all file buffers.
-
-Both modes operate by checking the time stamp of all files at intervals of
-`auto-revert-interval'.  The default is every five seconds.  The check is
-aborted whenever the user actually uses Emacs.  You should never even notice
-that this package is active (except that your buffers will be reverted, of
-course).
-
-@menu
-* Auto-Revert Usage::		How to use the package.
-@end menu
-
-@node Auto-Revert Usage,  , autorevert, autorevert
-@section Auto-Revert Usage
-
-To configure the package, type:
-
-@example
-  M-x customize-group RET auto-revert RET
-@end example
-
-To activate Auto-Revert for a specific buffer, go to the buffer and type:
-
-@example
-  M-x auto-revert-mode RET
-@end example
-
-To activate Global Auto-Revert Mode, type:
-
-@example
-  M-x global-auto-revert-mode RET
-@end example
-
-To activate Global Auto-Revert Mode every time Emacs is started customize the
-option `global-auto-revert-mode' or the following line could be added to your
-initialization file:
-
-@example
-  (global-auto-revert-mode 1)
-@end example
-
-The function `turn-on-auto-revert-mode' could be added to any major mode hook
-to activate Auto-Revert Mode for all buffers in that mode.  For example, the
-following line will activate Auto-Revert Mode in all C mode buffers:
-
-@example
-  (add-hook 'c-mode-hook 'turn-on-auto-revert-mode)
-@end example
-
-@node backup-dir, bookmark, autorevert, Top
-@chapter Specify Directories to be Used for Backup Files
-
-Allows backup files to be optionally stored in some directories, based on the
-value of the alist, @code{bkup-backup-directory-info}.  This variable is a
-list of lists of the form @code{(FILE-REGEXP BACKUP-DIR OPTIONS ...)}.  If
-the filename to be backed up matches @code{FILE-REGEXP}, or
-@code{FILE-REGEXP} is @code{t}, then @code{BACKUP-DIR} is used as the path
-for its backups.  Directories may begin with "/" to specify an absolute
-pathname.
-
-If @code{BACKUP-DIR} does not exist and @code{OPTIONS} contains the symbol
-@code{ok-create}, then it is created if possible.  Otherwise the usual
-behavior (backup in the same directory as the file) results.
-
-If @code{OPTIONS} contains the symbol @code{full-path}, then the full path of
-the file being backed up is prepended to the backup file name, with each "/"
-replaced by a "!".  This is intended for cases where an absolute backup path
-is used.  If @code{OPTIONS} contains @code{prepend-name} in addition to
-@code{full-path}, then the file name is prepended rather than appended to the
-path component when forming the backup name.
-
-If @code{OPTIONS} contains the symbol @code{search-upward} and the backup
-directory @code{BACKUP-DIR} is a relative path, then a directory with that
-name is searched for starting at the current directory and proceeding upward
-(.., ../.., etc) until one is found of that name or the root is reached, and
-if one is found it is used as the backup directory.
-
-Finally, if no @code{FILE-REGEXP} matches the file name being backed up, then
-the usual behavior results.
-
-These lines from my initialization file load this library and set the values
-I like:
-
-@example
-  (require 'backup-dir)
-  (setq bkup-backup-directory-info
-        '(("/home/greg/.*" "/~/.backups/" ok-create full-path prepend-name)
-          ("^/[^/:]+:"     ".backups/") ; handle EFS files specially: don't 
-          ("^/[^/:]+:"     "./")        ; search-upward... its very slow
-          (t               ".backups/"
-                           full-path prepend-name search-upward)))
-@end example
-
-The package also provides a new function, @code{find-file-latest-backup} to
-find the latest backup file for the current buffer's file.
-
-This package is based on @file{files.el} from XEmacs 20.3 and overrides
-functions defined there.
-
-@node bookmark, desktop, backup-dir, Top
-@chapter Create annotated bookmarks
-
-This package is for setting "bookmarks" in files.  A bookmark associates a
-string with a location in a certain file.  Thus, you can navigate your way to
-that location by providing the string.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET bookmark RET
-@end example
-
-@node desktop, recent-files, bookmark, Top
-@chapter Save Partial Status of Emacs When Killed
-
-Save the Desktop, i.e.,
-
-@itemize @bullet
-
-@item 
-some global variables
-
-@item 
-the list of buffers with associated files.  For each buffer also
-
-@itemize @bullet
-
-@item 
-the major mode
-
-@item 
-the default directory
-
-@item 
-the point
-
-@item 
-the mark & mark-active
-
-@item 
-buffer-read-only
-
-@item 
-some local variables
-
-@end itemize
-
-@end itemize
-
-To use this, first put these two lines at the bottom of your initialization
-file (the later the better):
-
-@example
-  (desktop-load-default)
-  (desktop-read)
-@end example
-
-Between these two lines you may wish to add something that updates the
-variables @code{desktop-globals-to-save} and/or
-@code{desktop-locals-to-save}.  If for instance you want to save the local
-variable @code{foobar} for every buffer in which it is local, you could add
-the line
-
-@example
-  (setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save))
-@end example
-
-To avoid saving excessive amounts of data you may also wish to add something
-like the following
-
-@example
-  (add-hook 'kill-emacs-hook
-            '(lambda ()
-               (desktop-truncate search-ring 3)
-               (desktop-truncate regexp-search-ring 3)))
-@end example
-
-which will make sure that no more than three search items are saved.  You
-must place this line @emph{after} the @code{(desktop-load-default)} line.
-See also the variable @code{desktop-save-hook}.
-
-Start Emacs in the root directory of your "project". The desktop saver is
-inactive by default.  You activate it by typing @code{M-x desktop-save RET}.
-When you exit the next time the above data will be saved.  This ensures that
-all the files you were editing will be reloaded the next time you start Emacs
-from the same directory and that points will be set where you left them.  If
-you save a desktop file in your home directory it will act as a default
-desktop when you start Emacs from a directory that doesn't have its own.  I
-never do this, but you may want to.
-
-Some words on minor modes: Most minor modes are controlled by buffer-local
-variables, which have a standard save / restore mechanism.  To handle all
-minor modes, we take the following approach: (1) check whether the variable
-name from @code{minor-mode-alist} is also a function; and (2) use translation
-table @code{desktop-minor-mode-table} in the case where the two names are not
-the same.
-
-By the way: don't use @file{desktop.el} to customize Emacs -- the standard
-XEmacs initialization file is used for that.  Saving global default values
-for buffers is an example of misuse.
-
-PLEASE NOTE: The kill ring can be saved as specified by the variable
-@code{desktop-globals-to-save} (by default it isn't).  This may result in saving
-things you did not mean to keep.  Use @code{M-x desktop-clear RET}.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET desktop RET
-@end example
-
-@node recent-files, resume, desktop, Top
-@chapter Recent File Navigation
-
-To install @file{recent-files}, put the following statements into your
-initialization file
-
-@example
-  (recent-files-initialize)
-@end example
-
-@file{recent-files} adds the menu "Recent Files" (or whatever name you
-choose, (@pxref{recentf-cust,Customization}) to Emacs's menubar. Its entries
-are the files (and directories) that have recently been opened by Emacs. You
-can open one of these files again by selecting its entry in the "Recent
-Files" menu. The list of file entries in this menu is preserved from one
-Emacs session to another. You can prevent Emacs from saving this list by
-selecting "Don't save recent-files list on exit" from the menu. If you have
-disabled saving, you can re-enable it by selecting "Save recent-files list on
-exit".
-
-The menu has permanent and non-permanent entries. Permanent entries are
-marked with an asterisk in front of the filename. The non-permanent entries
-are hidden in a submenu.
-
-Each time you open a file in Emacs, it is added as a non-permanent entry to
-the menu. The value of @code{recent-files-number-of-entries} determines how
-many non-permanent entries are held in the menu. When the number of
-non-permanent entries reaches this value, the least recently added
-non-permanent entry is removed from the menu when another non-permanent entry
-is added. It is not removed from the list, though; it may reappear when
-entries are deleted from the list. The number of entries saved to disk is the
-value of the variable @code{recent-files-number-of-saved-entries}.
-
-Permanent entries are not removed from the menu. You can make a file entry
-permanent by selecting "Make  permanent" (where  is the name
-of the current buffer) when the current buffer holds this file. "Make
- non-permanent" makes the file entry of the current buffer
-non-permanent.
-
-The command "Kill buffer  and delete entry" is handy when you have
-accidentally opened a file but want to keep neither the buffer nor the entry.
-
-You can erase the list of non-permanent entries by selecting "Erase
-non-permanent entries" from the menu.
-
-@menu
-* Customization: recentf-cust.
-@end menu
-
-@node recentf-cust,  , recent-files, recent-files
-@section Customization
-
-There are lots of variables to control the behaviour of
-recent-files. You do not have to change any of them if you like it
-as it comes out of the box. However, you may want to look at these
-options to make it behave different.
-
-@table @code
-
-@item recent-files-number-of-entries
-Controls how many non-permanent entries are shown in the
-recent-files list.  The default is 15. 
-
-@item recent-files-number-of-saved-entries
-Controls how many non-permanent entries are saved to disk when
-Emacs exits or recent-files-save-the-list is called. The
-default is 50.
-
-@item recent-files-save-file
-The name of the file where the recent-files list is saved
-between Emacs session. You probably don't need to change this.
-The default is ".recent-files.el" in your home directory.
-
-@item recent-files-dont-include
-A list of regular expressions for files that should not be
-included into the recent-files list. This list is empty by
-default. For instance, a list to exclude all .newsrc
-files, all auto-save-files, and all files in the /tmp
-directory (but not the /tmp directory itself) would look
-like this:
-
-@example
-  (setq recent-files-dont-include
-        '("/\\.newsrc" "~$" "^/tmp/."))
-@end example
-
-The default is empty.
-
-@item recent-files-use-full-names
-If the value of this variable is non-nil, the full pathnames of
-the files are shown in the recent-files menu. Otherwise only
-the filename part (or the last name component if it is a
-directory) is shown in the menu. The default it t, i.e. show
-full names.
-
-@item recent-files-filename-replacements
-This is a list of pairs of regular expressions and replacement
-strings. If a filename matches one of the regular expressions,
-the matching part is replaced by the replacement string for
-display in the recent-files menu.
-Example: My home directory is "/users/mmc/nickel/". I want to
-replace it with "~/". I also want to replace the directory
-"/imports/teleservices/mmc/avc2/", where I work a lot, with
-".../avc2/". The list then looks like
-
-@example
-  (setq recent-files-filename-replacements
-        '(("/users/mmc/nickel/" . "~/")
-          ("/imports/teleservices/mmc/avc2/" . ".../avc2/")))
-@end example
-
-Only the first match is replaced. So, if you have several
-entries in this list that may match a filename simultaneously,
-put the one you want to match (usually the most special) in
-front of the others. The default is to replace the home
-directory with "~".
-
-@item recent-files-sort-function
-Contains a function symbol to sort the display of filenames in
-the recent-files menu. Supplied are two functions,
-@code{recent-files-dont-sort} and @code{recent-files-sort-alphabetically}.
-The first, which is the default, preserves the order of "most
-recent on top". 
-
-@item recent-files-permanent-submenu
-If this variable is non-nil, the permanent entries are put into
-a separate submenu of the recent-files menu. The default is
-nil.
-
-@item recent-files-non-permanent-submenu
-If this variable is non-nil, the non-permanent entries are put
-into a separate submenu of the recent-files menu. The default
-is currently t, but probably should be nil, and we may change it
-back. (You can set both @code{recent-files-permanent-submenu} and
-@code{recent-files-non-permanent-submenu} to t to have both lists in
-separate submenus.)
-
-@item recent-files-commands-submenu
-If this variable is non-nil, the commands if recent-files are
-placed in a submenu of the recent-files menu. The default is
-nil.
-
-@item recent-files-commands-submenu-title
-If the commands are placed in a submenu, this string is used as
-the title of the submenu. The default is "Commands...".
-
-@item recent-files-actions-on-top
-If this variable is non-nil, the "action" menu entries ("Make
- permanent" etc.) are put on top of the menu. Otherwise
-they appear below the file entries or submenus. The default is
-nil.
-
-@item recent-files-permanent-first
-If this variable is t, the permanent entries are put first in
-the recent-files menu, i.e. above the non-permanent entries. If
-the value is nil, non-permanent entries appear first. If the
-value is neither t nor nil, the entries are sorted according to
-recent-files-sort-function. The default is 'sort.
-
-@item recent-files-find-file-command
-This variable contains the command to execute when a file entry
-is selected from the menu. Usually this will be @code{find-file},
-which is the default.
-
-@end table
-
-@node resume, saveconf, recent-files, Top
-@chapter Resuming a Suspended Emacs Job
-
-This library not documented.  Please contribute!
-
-@node saveconf, savehist, resume, Top
-@chapter Save Buffer/Window Configuration Between Sessions
-
-This package of functions gives Emacs the ability to remember which files
-were being visited, the windows that were on them, and the value of point in
-their buffers the last Emacs session in the same directory.  This is an
-emulation of an old Gosling Emacs feature.
-
-The relevant commands are @code{save-context} and @code{recover-context}.
-
-Most of the time you'll want an Emacs session's context saved even if you
-choose not to recover it later.  To avoid having to manually @code{M-x
-save-context} at each emacs exit, put the line:
-
-@example
-  (setq auto-save-and-recover-context t)
-@end example
-
-in your initialization file or in @file{default.el} in the lisp directory of
-the Emacs distribution.  The context will then automatically be saved when
-Emacs exits.
-
-By default only the contexts of visible buffers (buffers with windows on
-them) are saved.  Setting the variable save-buffer-context to t causes the
-contexts of all buffers to be saved.
-
-To use the package put these lines
-
-@example
-  (require 'saveconf)
-  (if (null (cdr command-line-args))
-      (setq inihibit-startup-message (recover-context)))
-@end example
-
-at the end of your initialization file or the @file{default.el} file in the
-lisp directory of the Emacs distribution.  This causes the context saved in
-the current directory to be recovered whenever Emacs is invoked without any
-arguments.
-
-@node savehist, saveplace, saveconf, Top
-@chapter Save Minibuffer History
-
-Many editors (e.g. Vim) have the feature of saving minibuffer history to an
-external file after exit.  This package provides the same feature in Emacs.
-When Emacs is about the exit, @code{savehist-save} will dump the contents of
-various minibuffer histories (as determined by
-@code{savehist-history-variables}) to a save file (@file{~/.emacs-history} by
-default).  Although the package was designed for saving the minibuffer
-histories, any variables can be saved that way.
-
-To use savehist, put the following in your initialization file:
-
-@example
-  (savehist-load)
-@end example
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET savehist RET
-@end example
-
-@node saveplace, where-was-i-db, savehist, Top
-@chapter Automatically Save Place in Files
-
-Automatically save place in files, so that visiting them later (even during a
-different Emacs session) automatically moves point to the saved position,
-when the file is first found.  Uses the value of buffer-local variable
-@code{save-place} to determine whether to save position or not.
-
-To use this package, put the following in your initialization file:
-
-@example
-  (require 'saveplace)
-@end example
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET saveplace RET
-@end example
-
-@node where-was-i-db, completion, saveplace, Top
-@chapter Keep Persistent State in Visited Files
-
-This library will make XEmacs keep track of where you were last time you
-visited a file.  It hopes to become a standard and favored XEmacs feature on
-setups with Berkeley DB installed.
-
-It works by installing functions on the @code{find-file-hooks} and on the
-buffer-local @code{kill-buffer-hook}.  When a buffer is killed, if it was
-visiting a file, and place saving has been enabled for it, a database entry
-is made, saving the location of @code{point}.  When you visit a file, the
-database is queried, keyed on @code{buffer-file-name}, and if an entry is
-found, point is set to the value retrieved, and place saving is enabled again
-for that buffer.
-
-There is a command, which is initially not bound to a keystroke in
-this incarnation; and may never be, since I think completion works
-well enough:
-
-@example
-  M-x toggle-where-was-i 
-@end example
-
-which, using auto-completion, can be entered as 
-
-@example
-  M-x tog TAB w TAB
-@end example
-
-that will turn place saving on and off on a per-file, buffer- local basis.
-If @code{where-was-i-db} has been turned off in a buffer and then you kill
-it, or exit XEmacs, any record for that file will be purged from the
-database, and you'll start at the top of the file next time you open it, with
-place saving turned off there.
-
-Place saving is automatically still `on' when you visit a file you'd toggled
-it on for in a previous session or visitation.  (That's the point of it,
-after all.)
-
-Toggling place saving on in a buffer visiting a file is all that is required
-to cause the @code{where-was-i-db} feature to be autoloaded, as
-@code{toggle-where-was-i} will call on @code{install-where-was-i} if the
-`wwi-ffh' has not yet been installed.  That WILL NOT cause this feature to be
-automatically enabled in your next XEmacs invocation, however.  For that, you
-must customize and save @code{wwi-auto-install-on-startup-flag}.  There is
-more information about this in its docstring.
-
-This feature can be unloaded with:
-
-@example
-  C-u M-x install-where-was-i
-@end example
-
-which will call @code{unload-feature}, as well as traverse the
-@code{buffer-list} removing the buffer-local @code{kill-buffer-hook}
-installed by this program.  Note that any buffers that got place saving
-enabled by having had an entry in the database for them when they were first
-visited (thus restoring point to where it was the last time you had visited
-the file), will not have an updated entry made, nor the old entry removed (as
-would happen if you @code{toggle-where-was-i} to off in just that buffer),
-after you uninstall this feature like that.
-
-If you toggle it on again in a buffer visiting a file, then kill that buffer,
-the point will be saved for it.  When you kill the other buffers that had
-place saving enabled before you uninstalled the feature with @kbd{C-u M-x
-install-where-was-i}, no @code{where-was-i-db} database update will happen
-for them, since their buffer-local @code{kill-buffer-hook} will have been
-cleaned of the member @code{wwi-save-where-i-am}, the function that writes
-the @code{point} entry to the database when a buffer is killed.  If you then
-re-visit one of those files, point will get restored to the location it did
-the last time you visited that file with @code{where-was-i-db} installed.
-
-To remove a file from the place saving database, simply visit it, @kbd{M-x
-toggle-where-was-i} to switch @code{where-was-i-db} off, then kill that
-buffer.  You can see how this works by looking at the definition of
-@code{wwi-save-where-i-am}.
-
-After a period of time, the database of saved file positions will become
-cluttered with the names of files that no longer exist.  You may vacume out
-the crumbs using:
-
-@example
-  M-x wwi-vacume-where-was-i-db
-@end example
-
-which will prompt you for an optional regular expression to match files you
-want records removed for.  It will traverse the database and remove entries
-for file names that either match the regexp, or that are @code{(not
-(file-exists-p file-name))}. The main reason for this command is the removal
-of stale entries, for files that no longer exist on the filesystem.
-
-Note also that running @code{wwi-vacume-where-was-i-db} will cause EFS
-traffic, if you've saved your place in any remote files.  Don't be surprised
-if your dialing daemon picks up the phone when you run the vacume function.
-You should be able to purge the database of all EFS entries with a simple
-regular expression passed to @code{wwi-vacume-where-was-i-db}.  Of course,
-you might not want to do that, for obvious reasons.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET where-was-i RET
-@end example
-
-
-@node completion, dabbrev, where-was-i-db, Top
-@chapter Completion
-
-To load this package, add the following to your initialization file:
-
-@example
-  (require 'completion)
-@end example
-
-After you type a few characters, pressing the "complete" key inserts the rest
-of the word you are likely to type.
-
-This watches all the words that you type and remembers them.  When typing a
-new word, pressing "complete" (@kbd{C-return}) "completes" the word by
-inserting the most recently used word that begins with the same characters.
-If you press meta-return repeatedly, it cycles through all the words it knows
-about.
-
-If you like the completion then just continue typing, it is as if you entered
-the text by hand.  If you want the inserted extra characters to go away, type
-@kbd{C-w} or delete.  More options are described below.
-
-The guesses are made in the order of the most recently "used".  Typing in a
-word and then typing a separator character (such as a space) "uses" the word.
-So does moving a cursor over the word.  If no words are found, it uses an
-extended version of dynamic abbreviation @xref{dabbrev}.
-
-Completions are automatically saved to a file between sessions.
-
-Completion enables programmers to enter longer, more descriptive variable
-names while typing fewer keystrokes than they normally would.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET completion RET
-@end example
-
-@node dabbrev, hippie-exp, completion, Top
-@chapter Dynamic Abbreviations
-
-The purpose with this package is to let you write just a few characters of
-words you've written earlier to be able to expand them.
-
-To expand a word, just put the point right after the word and press @kbd{M-/}
-(@code{dabbrev-expand}) or @kbd{M-C-/} (@code{dabbrev-completion}).
-
-Check out the customizable variables to learn about all the features of this
-package.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET dabbrev RET
-@end example
-
-@node hippie-exp, icomplete, dabbrev, Top
-@chapter Hippie Expand
-
-@code{hippie-expand} is a single function for a lot of different kinds of
-completions and expansions.  Called repeatedly it tries all possible
-completions in succession.  Which kinds of completions to try, and in which
-order, is determined by the contents of
-@code{hippie-expand-try-functions-list}.  Much customization of
-@code{hippie-expand} can be made by changing the order of, removing, or
-inserting new functions in this list.  Given a positive numeric argument,
-@code{hippie-expand} jumps directly ARG functions forward in this list.
-Given some other argument (a negative argument or just @kbd{C-u}) it undoes
-the tried completion.
-
-If the variable @code{hippie-expand-verbose} is non-nil, @code{hippie-expand}
-outputs in a message which try-function in the list that is used
-currently (ie. was used currently and will be tried first the next time).
-
-The variable @code{hippie-expand-max-buffers} determines in how many buffers,
-apart from the current, to search for expansions in.  It is used by the
-try-functions named "-all-buffers".  The variable
-@code{hippie-expand-ignore-buffers} is a list of regexps matching buffer
-names (as strings) or major modes (as atoms) of buffers that should not be
-searched by the try-functions named "-all-buffers".  See also the macro
-@code{make-hippie-expand-function} below.
-
-A short description of the current try-functions in this file:
-
-@table @code
-
-@item try-complete-file-name
-Very convenient to have in any buffer, and not just in the minibuffer or
-(some) shell-mode.  It goes through all possible completions instead of just
-completing as much as is unique.
-
-@item try-complete-file-name-partially
-To insert in the list just before @code{try-complete-file-name} for those who
-want first to get a file name completed only as many characters as is unique.
-
-@item try-expand-all-abbrevs
-Can be removed if you don't use abbrevs.  Otherwise it looks through all
-abbrev-tables, starting with the local followed by the global.
-
-@item try-expand-line
-Searches the buffer for an entire line that begins exactly as the current
-line.  Convenient sometimes, for example as a substitute for (or complement
-to) the history list in shell-like buffers.  At other times, only confusing.
-
-@item try-expand-line-all-buffers
-Like @code{try-expand-line} but searches in all buffers (except the current).
-(This may be a little slow, don't use it unless you are really fond of
-@code{hippie-expand}.)
-
-@item `try-expand-list
-Tries to expand the text back to the nearest open delimiter, to a whole list
-from the buffer. Convenient for example when writing lisp or TeX.
-
-@item try-expand-list-all-buffers
-Like @code{try-expand-list} but searches in all buffers (except the current).
-
-@item try-expand-dabbrev
-Works exactly as @code{dabbrev-expand} (but of course in a way compatible
-with the other try-functions).
-
-@item try-expand-dabbrev-all-buffers
-Perhaps the most useful of them, like @code{dabbrev-expand} but searches all
-Emacs buffers (except the current) for matching words.  (No, I don't find
-this one particularly slow.)
-
-@item try-expand-dabbrev-visible
-Searches the currently visible parts of all windows.  Can be put before
-@code{try-expand-dabbrev-all-buffers} to first try the expansions you can
-see.
-
-@item try-expand-dabbrev-from-kill
-Searches the kill ring for a suitable completion of the word.  Good to have,
-just in case the word was not found elsewhere.
-
-@item try-expand-whole-kill
-Tries to complete text with a whole entry from the kill ring.  May be good if
-you don't know how far up in the kill-ring the required entry is, and don't
-want to mess with "Choose Next Paste".
-
-@item try-complete-lisp-symbol
-Like @code{lisp-complete-symbol}, but goes through all possibilities instead
-of completing what is unique.  Might be tedious (usually a lot of possible
-completions) and since its function is much like @code{lisp-complete-symbol},
-which already has a key of its own, you might want to remove this.
-
-@item try-complete-lisp-symbol-partially
-To insert in the list just before @code{try-complete-lisp-symbol} for those
-who first want to get completion of what is unique in the name.
-
-@end table
-
-Not all of the above functions are by default in
-@code{hippie-expand-try-functions-list}.  This variable is better set in your
-initialization file to make @code{hippie-expand} behave maximally convenient
-according to personal taste.  Also, instead of loading the variable with all
-kinds of try-functions above, it might be an idea to use
-@code{make-hippie-expand-function} to construct different
-@code{hippie-expand}-like functions, with different try-lists and bound to
-different keys. It is also possible to make
-@code{hippie-expand-try-functions-list} a buffer local variable, and let it
-depend on the mode (by setting it in the mode-hooks).
-
-@node icomplete, tempo, hippie-exp, Top
-@chapter Interactive Minibuffer Completion
-
-Loading this package implements a more fine-grained minibuffer completion
-feedback scheme.  Prospective completions are concisely indicated within the
-minibuffer itself, with each successive keystroke.
-
-See @code{icomplete-completions} docstring for a description of the icomplete
-display format.
-
-See the @code{icomplete-minibuffer-setup-hook} docstring for a means to
-customize icomplete setup for interoperation with other minibuffer-oriented
-packages.
-
-To activate @code{icomplete mode}, load the package and use the
-@code{icomplete-mode} function.  You can subsequently deactivate it by
-invoking the function @code{icomplete-mode} with a negative prefix-arg
-@kbd{(C-U -1 ESC-x icomplete-mode}).  Also, you can prevent activation of the
-mode during package load by first setting the variable @code{icomplete-mode}
-to nil.  Icompletion can be enabled any time after the package is loaded by
-invoking @code{icomplete-mode} without a prefix arg.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET icomplete RET
-@end example
-
-@node tempo, avoid, icomplete, Top
-@chapter Flexible Template Insertion
-
-This file provides a simple way to define powerful templates, or macros, if
-you wish. It is mainly intended for, but not limited to, other programmers to
-be used for creating shortcuts for editing certain kind of documents. It was
-originally written to be used by a HTML editing mode written by Nelson Minar
-, and his @file{html-helper-mode.el} is probably the
-best example of how to use this program.
-
-A template is defined as a list of items to be inserted in the current buffer
-at point. Some of the items can be simple strings, while other can control
-formatting or define special points of interest in the inserted text.
-
-If a template defines a "point of interest" that point is inserted in a
-buffer-local list of "points of interest" that the user can jump between with
-the commands @code{tempo-backward-mark} and @code{tempo-forward-mark}. If the
-template definer provides a prompt for the point, and the variable
-@code{tempo-interactive} is non-nil, the user will be prompted for a string
-to be inserted in the buffer, using the minibuffer.
-
-The template can also define one point to be replaced with the current region
-if the template command is called with a prefix (or a non-nil argument).
-
-More flexible templates can be created by including lisp symbols, which will
-be evaluated as variables, or lists, which will be evaluated as lisp
-expressions.
-
-See the documentation for @code{tempo-define-template} for the different
-items that can be used to define a tempo template.
-
-One of the more powerful features of tempo templates are automatic
-completion. With every template can be assigned a special tag that should be
-recognized by @code{tempo-complete-tag} and expanded to the complete
-template. By default the tags are added to a global list of template tags,
-and are matched against the last word before point. But if you assign your
-tags to a specific list, you can also specify another method for matching
-text in the buffer against the tags. In the HTML mode, for instance, the tags
-are matched against the text between the last `<' and point.
-
-When defining a template named @code{foo}, a symbol named
-@code{tempo-template-foo} will be created whose value as a variable will be
-the template definition, and its function value will be an interactive
-function that inserts the template at the point.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET tempo RET
-@end example
-
-@node avoid, blink-cursor, tempo, Top
-@chapter Move Mouse Pointer Out of the Way of Editing
-
-For those who are annoyed by the mouse pointer obscuring text, this mode
-moves the mouse pointer - either just a little out of the way, or all the way
-to the corner of the frame.  To use, type @code{M-x mouse-avoidance-mode}.
-To set up permanently, add the following to your initialization file:
-
-@example
-  (if window-system (mouse-avoidance-mode 'animate))
-@end example
-
-The @code{'animate} can be @code{'jump} or @code{'banish} or @code{'exile} or
-@code{'protean} if you prefer.  See the documentation for function
-@code{mouse-avoidance-mode} for details of the different modes.
-
-For added silliness, make the animatee animate by put something similar to
-the following into your initialization file:
-
-@example
-  (if window-system
-      (mouse-avoidance-set-pointer-shape
-       (eval (nth (random 4)
-                  '(x-pointer-man x-pointer-spider
-                                  x-pointer-gobbler x-pointer-gumby)))))
-@end example
-
-For completely random pointer shape, replace the @code{setq} above with
-@code{(setq x-pointer-shape (mouse-avoidance-random-shape))}.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET avoid RET
-@end example
-
-@node blink-cursor, fast-lock, avoid, Top
-@chapter Blinking Cursor
-
-To activate this package, type:
-
-@example
-  M-x blink-cursor-mode RET
-@end example
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET blink-cursor RET
-@end example
-
-@node fast-lock, lazy-lock, blink-cursor, Top
-@chapter Speeding Up Font Lock Mode
-
-Lazy Lock mode is a Font Lock support mode.  It makes visiting a file in Font
-Lock mode faster by restoring its face text properties from automatically
-saved associated Font Lock cache files.
-
-See also the lazy-lock package.  (But don't use the two at the same time!)
-
-To use this package, add the following to your initialization file:
-
-@example
-  (setq font-lock-support-mode 'fast-lock-mode)
-@end example
-
-Start up a new Emacs and use font-lock as usual (except that you can use the
-so-called "gaudier" fontification regexps on big files without frustration).
-
-When you visit a file (which has @code{font-lock-mode} enabled) that has a
-corresponding Font Lock cache file associated with it, the Font Lock cache
-will be loaded from that file instead of being generated by Font Lock code.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET fast-lock RET
-@end example
-
-@node lazy-lock, lazy-shot, fast-lock, Top
-@chapter Lazy Demand-Driven Fontification
-
-The purpose of this library is to make visiting buffers in
-@code{font-lock-mode} faster by making fontification demand-driven and
-stealthy.  Fontification only occurs when, and where, necessary.
-
-See also the fast-lock and lazy-shot packages.  (But don't use them at the
-same time as lazy-lock!)
-
-To use this package, add the following to your initialization file:
-
-@example
-  (setq font-lock-support-mode 'lazy-lock-mode)
-@end example
-
-Start up a new XEmacs and use font-lock as usual (except that you can use the
-so-called "gaudier" fontification regexps on big files without frustration).
-
-In a buffer (which has @code{font-lock-mode} enabled) which is at least
-@code{lazy-lock-minimum-size} characters long, only the visible portion of
-the buffer will be fontified.  Motion around the buffer will fontify those
-visible portions that were not previous fontified.
-
-If stealth fontification is enabled, fontification will occur in invisible
-parts of the buffer after @code{lazy-lock-stealth-time} seconds of idle time.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET lazy-lock RET
-@end example
-
-@node lazy-shot, mic-paren, lazy-lock, Top
-@chapter Another Lazy Demand-Driven Fontification
-
-This is an experimental demand based font-lock implementation.  It is
-experimental in the sense that it relies on C support from the redisplay
-engine, that is experimental.  The code in this file is more or less
-finished.  The C code support experimental because the current design is
-rumoured to be ugly.  Secondly because XEmacs does actually display the
-"un-font-locked" parts of the buffer first, the user notices flashing as the
-buffer is repainted with color/fonts.
-
-To use this package, add the following to your initialization file:
-
-@example
-  (add-hook 'font-lock-mode-hook 'turn-on-lazy-shot)
-@end example
-
-Do not use in combination with @code{lazy-lock}.
-
-@example
-  M-x customize-group RET lazy-shot RET
-@end example
-
-@node mic-paren, paren, lazy-shot, Top
-@chapter Advanced Highlighting of Matching Parentheses
-
-Load this file, activate it and Emacs will display highlighting on whatever
-parenthesis (and paired delimiter if you like this) matches the one before or
-after point. This is an extension to the paren.el file distributed with
-Emacs. The default behaviour is similar to paren.el but more
-sophisticated. Normally you can try all default settings to enjoy mic-paren.
-
-Or - if you are a LaTeX writer like the current maintainer - try the
-following additional setup in your initialization file:
-
-@example
-  ;; In LaTeX-mode we want this
-  (add-hook 'LaTeX-mode-hook
-            (function (lambda ()
-                        (paren-toggle-matching-quoted-paren 1)
-                        (paren-toggle-matching-paired-delimiter 1))))
-@end example
-
-Or - if you are programming in C like languages - try also:
-
-@example
-  (add-hook 'c-mode-common-hook
-            (function (lambda ()
-                         (paren-toggle-open-paren-context 1))))
-@end example
-
-@file{mic-paren.el} is an extension and replacement to the packages
-@file{paren.el} and @file{stig-paren.el} for Emacs. When mic-paren is active
-Emacs normal parenthesis matching is deactivated. Instead parenthesis
-matching will be performed as soon as the cursor is positioned at a
-parenthesis. The matching parenthesis (or the entire expression between the
-parentheses) is highlighted until the cursor is moved away from the
-parenthesis.
-
-Features include:
-
-@itemize @bullet
-
-@item
-
-Both forward and backward parenthesis matching (simultaneously if cursor is
-between two expressions).
-
-@item
-
-Indication of mismatched parentheses.
-
-@item
-
-Recognition of "escaped" (also often called "quoted") parentheses.
-
-@item
-
-Option to match "escaped" parens too, especially in (La)TeX-mode
-(e.g. matches expressions like "\(foo bar\)" properly).
-
-@item
-
-Offers two functions as replacement for @code{forward-sexp} and
-@code{backward-sexp} which handle properly quoted parens (s.a.). These new
-functions can automatically be bounded to the original binding of the
-standard @code{forward-sexp} and @code{backward-sexp} functions.
-
-@item
-
-Option to activate matching of paired delimiter (i.e. characters with syntax
-'$'). This is useful for writing in LaTeX-mode for example.
-
-@item
-
-Option to select in which situations (always, never, if match, if mismatch)
-the entire expression should be highlighted or only the matching parenthesis.
-
-@item
-
-Message describing the match when the matching parenthesis is off-screen
-(vertical and/or horizontal). Message contains either the linenumber or the
-number of lines between the two matching parens. Option to select in which
-cases this message should be displayed.
-
-@item
-
-Optional delayed highlighting (useful on slow systems),
-
-@item
-
-Functions to activate/deactivate @file{mic-paren.el} are provided.
-
-@item
-
-Numerous options to control the behaviour and appearance of
-@file{mic-paren.el}.
-
-@end itemize
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET mic-paren-matching RET
-@end example
-
-@node paren, shell-font, mic-paren, Top
-@chapter Highlight (Un)matching Parens and Whole Expressions
-
-This package highlights matching parens (or whole sexps) for easier editing
-of source code, particularly lisp source code.
-
-The @code{paren-highlight} hook function runs after each command and checks
-to see if the cursor is at a parenthesis.  If so, then it highlights, in one
-of several ways, the matching parenthesis.
-
-Priority is given to matching parentheses right before the cursor because
-that's what makes sense when you're typing a lot of closed parentheses.  This
-is especially intuitive if you frequently use @code{forward-sexp}
-(@kbd{M-C-f}) and @code{backward-sexp} (@kbd{M-C-b}) to maneuver around in
-source code.
-
-Different faces are used for matching and mismatching parens so that it is
-easier to see mistakes as you type them.  Audible feedback is optional.
-
-If a (mis)matching paren is offscreen, then a message is sent to the
-modeline.
-
-If @code{paren-mode} is @code{sexp}, entire S-expressions are highlighted
-instead of just matching parens.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET paren-matching RET
-@end example
-
-@node shell-font, highline, paren, Top
-@chapter Decorate a Shell Buffer With Fonts
-
-Do this: @code{(add-hook 'shell-mode-hook 'install-shell-fonts)}
-and the prompt in your shell-buffers will appear bold-italic, process
-output will appear in normal face, and typein will appear in bold.
-
-The faces @code{shell-prompt}, @code{shell-input} and @code{shell-output} can
-be modified as desired, for example, @code{(copy-face 'italic
-'shell-prompt)}.
-
-@node highline, after-save-commands, shell-font, Top
-@chapter Highlight the Current Line in the Buffer
-
-This package is a minor mode to highlight the current line in buffer.
-
-The mode supports the following modes of operation:
-
-@itemize @bullet
-
-@item LOCAL highline
-@item GLOBAL highline
-@item INDIRECT highline
-
-@end itemize
-
-Both Local and Global minor modes may be in use at the same time.
-
-Indirect highline (@code{highline-view-on}, @code{highline-view-off} and
-@code{highline-view-mode}) is useful when you wish to have various "visions"
-of the same buffer.  Indirect highline uses an indirect buffer to get the
-"vision" of the buffer.  So, if you kill an indirect buffer, the base buffer
-is not affected; if you kill the base buffer, all indirect buffer related
-with the base buffer is automagically killed.  Also, any text
-insertion/deletion in any indirect or base buffer is updated in all related
-buffers.
-
-@menu
-* Key Bindings and Example Usage: highline-keys.
-* Hooks: highline-hooks.
-* Options: highline-options.
-@end menu
-
-@node highline-keys, highline-hooks, highline, highline
-@section Key Bindings and Example Usage
-
-It might be useful to set up some global key bindings as follows:
-
-@example
-  (global-set-key "\C-c\C-a"     'highline-on)
-  (global-set-key "\C-c\C-b"     'highline-off)
-  (global-set-key "\C-c\C-l"     'highline-local-mode)
-  (global-set-key "\C-c\C-d"     'highline-mode-on)
-  (global-set-key "\C-c\C-e"     'highline-mode-off)
-  (global-set-key "\C-c\C-g"     'highline-mode)
-  (global-set-key "\C-c\C-c"     'highline-customize)
-  (global-set-key "\C-c\C-v\C-n" 'highline-view-on)
-  (global-set-key "\C-c\C-v\C-f" 'highline-view-off)
-  (global-set-key "\C-c\C-v\C-t" 'highline-view-mode)
-@end example
-
-As an example, try to insert this in your .emacs file:
-
-@example
-  (require 'highline)
-  ;; Turn on local highlighting for Dired (C-x d)
-  (add-hook 'dired-after-readin-hook 'highline-on)
-  ;; Turn on local highlighting for list-buffers (C-x C-b)
-  (defadvice list-buffers (after highlight-line activate)
-    (save-excursion
-      (set-buffer "*Buffer List*")
-      (highline-on)))
-@end example
-
-@node highline-hooks, highline-options, highline-keys, highline
-@section Hooks
-
-highline has the following hook variables:
-
-@table @code
-
-@item highline-hook
-It is evaluated always when highline is turned on globally.
-
-@item highline-local-hook
-It is evaluated always when highline is turned on locally.
-
-@item highline-view-hook
-It is evaluated always when indirect highline is turned on.
-
-@item highline-load-hook
-It is evaluated after highline package is loaded.
-
-@end table
-
-@node highline-options,  , highline-hooks, highline
-@section Options
-
-This is a brief description of highline options.  Please see the options
-declarations in the code for more detail.
-
-@table @code
-
-@item highline-face			
-Specify face used to highlight the current line.
-
-@item highline-vertical-face
-Specify face used to highlight other than current line.
-
-@item highline-line
-Specify which part of line should be highlighted.
-
-@item highline-vertical
-Specify how many vertical lines should be highlighted.
-
-@item highline-verbose
-Non-nil means generate messages.
-
-@item highline-ignore-regexp
-Specify regexp for buffers to ignore.
-
-@item highline-priority
-Specify highline overlay priority.
-
-@item highline-selected-window
-Non-nil means highlight current line on	current window.
-
-@end table
-
-To configure this package, type:
-
-@example
-  M-x highline-customize RET
-@end example
-
-@node after-save-commands, atomic-extents, highline, Top
-@chapter Hooks Invoked After Saving a File
-
-Set up a list of file-name matching regular expressions associated with shell
-commands or lisp forms to run after saving the file.
-
-This is good for things like running @code{newaliases(1)} on
-@file{/etc/aliases}, @code{xrdb(1)} on @file{~/.Xresources}, installing a new
-@file{~/.crontab}, as well as for sending signals to daemons whose
-configuration files you've just finished editing.
-
-It is much safer and more powerful than using exec statements in "Local
-Variables" sections, and can safely be used by root for system administration
-tasks.  The shell command can run about anything you can think of.
-
-See variable @code{After-save-alist} for more information.
-
-@node atomic-extents, array, after-save-commands, Top
-@chapter Indivisible Blocks of Text
-
-Point is not allowed to fall inside of an atomic extent.  This has the effect
-of making all text covered by an atomic extent be treated as a single object.
-Normally point will be adjusted to an end of an atomic extent in the
-direction of motion.  If point appears inside of an atomic extent (via
-@code{goto-char} for example), point will be adjusted to the side closest to
-the entry point.
-
-To make this feature available, add the following to your initialization
-file:
-
-@example
-  (require 'atomic-extents)
-@end example
-
-To make an extent atomic use the command:
-
-@example
-  (set-extent-property # 'atomic t)
-@end example
-
-@node array, floating-toolbar, atomic-extents, Top
-@chapter Table and Array Editor
-
-Commands for editing a buffer interpreted as a rectangular array or matrix of
-whitespace-separated strings.  You specify the array dimensions and some
-other parameters at startup time.
-
-@node floating-toolbar, The Toolbar Utilities, array, Top
-@chapter Floating Toolbar
-
-The command @code{floating-toolbar} pops up a small frame containing a
-toolbar.  The command should be bound to a button-press event.  If the mouse
-press happens over an extent that has a non-nil @code{'floating-toolbar}
-property, the value of that property is the toolbar instantiator that will be
-displayed.  Otherwise the toolbar displayed is taken from the variable
-@code{floating-toolbar}.  This variable can be made buffer local to produce
-buffer local floating toolbars.
-
-@code{floating-toolbar-or-popup-mode-menu} works like @code{floating-toolbar}
-except that if no toolbar is found, @code{popup-mode-menu} is called.
-
-@code{floating-toolbar-from-extent-or-popup-mode-menu} works like
-@code{floating-toolbar-or-popup-mode-menu} except only extent local toolbars
-are used; the value of floating-toolbar is not used.
-
-Add the following line to your initialization file:
-
-@example
-  (require 'floating-toolbar)
-@end example
-
-You will also need to bind a mouse click to @code{floating-toolbar} or to
-@code{floating-toolbar-or-popup-mode-menu}.
-
-@node The Toolbar Utilities, foldout, floating-toolbar, Top
-@chapter The Toolbar Utilities
-@cindex toolbar
-
-The toolbar utilities are a set of Emacs commands and Lisp functions for
-convenient creation and management of toolbars.  Common usages such as
-creating and adding toolbar buttons to invoke commands and keyboard
-macros are implemented as user commands.  Convenience APIs are provided
-to create buttons, add them to toolbars, kill them from toolbars, and
-finding a particular button, or a button with certain content, in a
-toolbar.
-
-The toolbar utilities are implemented in three files:
-
-@table @file
-@item toolbar-utils.el
-
-The toolbar utility APIs and user commands.
-
-@item edit-toolbar.el
-
-The near-WYSIWYG toolbar editor by Peter D. Pezaris.
-
-@item xemacs-toolbar.el
-
-The XEmacs compatibility API for programs that should also run under GNU
-Emacs.
-@end table
-
-The author would like to thank Jeff Miller and Peter D. Pezaris for the
-original API and the toolbar editor, respectively, and David Kastrup and
-Jamie Zawinski for the pedal-gluteal impetus that resulted in the recent
-revision of these libraries described in this manual.
-
-@menu
-* Adding Buttons on the Fly::		Quick and convenient.
-* The Toolbar Editor::			Power tools for customization.
-* APIs for Adding and Killing::		For Lisp programmers.
-* APIs for Search::                     Button, button, who's got the button?
-* Toolbar Portability::			The @file{xemacs-toolbar.el} library.
-@end menu
-
-@node Adding Buttons on the Fly, The Toolbar Editor, The Toolbar Utilities, The Toolbar Utilities
-@section Adding Buttons on the Fly
-
-@defvr Group edit-toolbar
-
-Customize group of tools for interactive editing and non-interactive 
-management of toolbars.
-@end defvr
-
-@defvar toolbar-button-default-position
-Default position for adding toolbar
-buttons on the fly.  The value may be a non-negative integer (0 is
-leftmost), or one of the symbols @code{left}, @code{right}, or
-@code{extreme-right}.  @code{left} is synonymous with 0, and
-@code{extreme-right} is synonymous with @code{(length toolbar)}.
-@code{right} specifies placing a new item at the right end of the
-flush-left group of buttons.
-
-Default value: @code{right}.  Customize type: sexp.
-
-See also @samp{toolbar-add-button}, @ref{APIs for Adding and Killing}.
-@end defvar
-
-@deffn Command toolbar-add-button-on-the-fly description command label &optional position locale
-
-Add an button at @var{position} to the default toolbar of the selected
-window.  Returns @code{t}.
-
-The return value may change.  Tell stephen@@xemacs.org what value you
-think would be (most) useful.
-
-@table @var
-@item description
-A string describing the action, and displayed as help.
-
-@item command
-An interactive command (ie, a symbol with an interactive function
-definition) implementing the action.
-
-@item label
-A string used to label the button.
-
-@item position
-Optional.  A position (a non-negative integer, or one of the
-symbols @code{left}, @code{right}, or @code{extreme-right}.
-
-Default: @code{right}.
-
-@item locale
-Optional.  A specifier locale, defaulting to the current buffer.  If
-current-buffer-only is not what you want, and you don't understand
-specifier locales, use @code{global}.  It's safe and probably does what
-you want.
-@end table
-@end deffn
-
-@deffn Command toolbar-add-kbd-macro mac icon is-file
-Add a button invoking a keyboard macro to the toolbar.
-The button is added at the end of the left group.
-
-@table @var
-@item mac
-A keyboard macro name, or the empty string or nil to use a copy of
-the last keyboard macro defined.
-
-@item icon
-A string specifying the icon to be used.  If @var{is-file} is
-non-@code{nil}, it is interpreted as the name of an image file, and
-searched for using @code{locate-data-file}.  Otherwise it is used
-verbatim as a label.
-
-@item is-file
-Determines the treatment of @var{icon} (q.v.).
-@end table
-
-Used interactively, prompts for the macro name @var{mac} and an
-@var{icon}.  @var{is-file} is non-@code{nil} if a prefix argument was
-used.
-@end deffn
-
-@defun toolbar-add-execute-macro-button
-
-Add a button to the global toolbar to execute the last keyboard macro.
-
-Unlike @code{toolbar-add-kbd-macro}, this does not copy the macro.  The
-macro executed will change with redefinitions.
-
-Due to a simple implementation, this button will not appear in buffers with
-local toolbars if invoked after the toolbar is installed.  If you like this
-button, it's probably best to invoke this function in your init file.
-@end defun
-
-@defun toolbar-execute-last-kbd-macro
-Toolbar thunk which executes the most recently defined keyboard macro.
-@end defun
-
-@deffn Command restore-initial-toolbar
-Restores the default toolbar defined by @code{initial-toolbar-spec}.
-
-There is also a cache of killed buttons in @code{button-palette}.
-@end deffn
-
-@node The Toolbar Editor, APIs for Adding and Killing, Adding Buttons on the Fly, The Toolbar Utilities
-@section The Toolbar Editor
-
-To use @file{edit-toolbar.el}, simply type @kbd{M-x edit-toolbar RET}.
-
-For help on the various commands you can type @key{?} in a
-@samp{edit-toolbar} buffer.  To save a modified toolbar type @kbd{C-x
-C-s} in an @samp{edit-toolbar} buffer.  If you want to use a saved
-toolbar in your future XEmacs sessions, add the following line of code
-to your init file:
-
-@example
-  (load "~/.xemacs/.toolbar")
-@end example
-
-Here is a table of commands and bindings available in
-@samp{edit-toolbar-mode}.  These commands are also available from the
-@samp{Edit Toolbar} menu.
-
-@table @kbd
-@item q
-
-@samp{edit-toolbar-quit}:  Bury the @samp{edit-toolbar} buffer.
-
-@item p
-@itemx DEL
-
-@samp{edit-toolbar-previous}:  Select the previous item (line).
-
-@item n
-@itemx SPC
-@itemx RET
-
-@samp{edit-toolbar-next}:    Select the next item (line).
-
-@item ?
-
-@samp{describe-mode}:  Help.
-
-@item f
-
-@samp{edit-toolbar-set-function}:  Set the command for the current button.
-
-@item h
-
-@samp{edit-toolbar-set-help}:  Set the help string for the current button.
-
-@item a
-
-@samp{edit-toolbar-add-button}:  Add a new empty button.
-
-@item 2
-
-@samp{edit-toolbar-add-separator-2D-narrow}:  Add a new narrow 2D
-fixed-width spacer.
-
-@item @@
-
-@samp{edit-toolbar-add-separator-2D-wide}:  Add a new wide 2D fixed-width
-spacer.
-
-@item 3
-
-@samp{edit-toolbar-add-separator-3D-narrow}:  Add a new narrow 3D
-fixed-width spacer.
-
-@item #
-
-@samp{edit-toolbar-add-separator-3D-wide}:  Add a new wide 3D fixed-width
-spacer.
-
-@item R
-
-@samp{edit-toolbar-add-separator-right-left}:  Place the filler
-separator, which expands to create a flush-left group of buttons and
-spacers and a flush-right group.
-
-@item c
-
-@samp{edit-toolbar-copy}:  Copy the selected button.
-
-@item d
-
-@samp{edit-toolbar-down}:  Reorder the buttons by moving the selected
-button down (to the right on a horizontal toolbar).
-
-@item u
-
-@samp{edit-toolbar-up}:  Reorder the buttons by moving the selected
-button up (to the left on a horizontal toolbar).
-
-@item k
-
-@samp{edit-toolbar-kill}:  Kill the selected button.
-
-@item s
-@itemx C-x C-s
-
-@samp{edit-toolbar-save}:  Save the current buffer to
-@file{~/.xemacs/.toolbar} in a format that allows it to be reloaded.
-
-@item r
-
-@samp{edit-toolbar-restore}:  Restore the original toolbar (ie, before
-this editing session started).
-
-@end table
-
-@node APIs for Adding and Killing, APIs for Search, The Toolbar Editor, The Toolbar Utilities
-@section APIs for Adding and Killing
-
-@defvar button-palette
-List of buttons cut from toolbars.
-
-Note this is actually a toolbar descriptor.
-@end defvar
-
-@defun toolbar-add-item toolbar-spec item &optional position
-Add @var{item} to @var{toolbar-spec} at @var{position}, and return
-@var{toolbar-spec}.  Uses functions that alter list structure.
-
-@table @var
-@item item
-A toolbar button or spacer specification (eg, from
-@code{toolbar-new-button} or @code{toolbar-new-spacer}).
-@item toolbar-spec
-A toolbar descriptor (eg, from @code{toolbar-new-toolbar}).
-@item position
-Optional.  A non-negative integer, with 0 being the extreme left and
-\(length @var{toolbar-spec}) the extreme right.  The symbols
-@code{left}, @code{right}, and @code{extreme-right} are also accepted.
-@code{left} is synonymous with 0.  @code{right} places @var{item} at the
-right end of the left group of buttons.  @code{extreme-right} places
-@var{item} at the extreme right of the toolbar, creating a right group
-if one does not exist.
-@end table
-
-#### This function does not yet support inserting the group delimiter nil
-as an explicit item.
-
-@var{position} may be greater than (length @var{toolbar-spec}), in which
-case it is truncated to (length @var{toolbar-spec}).  Note that
-@code{(length @var{toolbar-spec})} is not synonymous with @code{right}
-or @code{extreme-right} (@code{extreme-right} will create a right group
-if it doesn't already exist).
-@end defun
-
-@defun toolbar-new-button icon-spec command help-string &optional initially-disabled
-Return a checked toolbar button specification.
-
-@table @var
-@item icon-spec
-A list of glyphs (from @code{make-glyph}), a glyph, or a
-string to use as the button's icon.  If a string or single glyph, it will
-be used for the button-up glyph.  If a list, it may contain 1 to 6 glyphs,
-which XEmacs will use for button up, button down, button disabled, button
-up with caption, button down with caption, and button disabled with caption,
-in that order.  Missing or nil glyphs will be defaulted.  (#### Strings as
-list elements are not supported but could be.)
-
-@item command
-The (interactive) command to invoke when the button is pressed.
-
-@item help-string
-A string briefly describing the command, displayed in the echo area or
-as balloon help when the pointer enters the button.
-
-@item initially-disabled
-Optional.  If non-@code{nil}, specifies that the button should initially
-be disabled.
-
-See @code{default-toolbar} or the Lispref (@pxref{Toolbars, , ,
-lispref}) for more information.
-@end table
-@end defun
-
-@defun toolbar-new-spacer style &optional size
-Returns a checked toolbar spacer ``button''.
-
-@table @var
-@item style
-One of the symbols @code{2d} or @code{3d}, indicating whether the area is
-displayed without shadows (giving it a flat appearance), or with shadows
-(giving it a raised, 3-D appearance).  There is no default.
-#### We may set a default style.  Tell stephen@@xemacs.org which you use.
-
-@item size
-Specifies the length, in pixels, of the blank area.  If omitted,
-it defaults to a device-specific value (8 pixels for X devices).
-@end table
-@end defun
-
-@defun make-toolbar-instantiator &optional toolbar-spec domain
-Return a checked toolbar instantiator, a list of vectors.
-
-@table @var
-@item toolbar-spec
-May be a list of buttons (ie, a toolbar descriptor, see
-@code{default-toolbar}), a toolbar specifier object, a symbol whose
-value is a toolbar specifier object, or @code{nil}.  If @code{nil},
-returns a null list.  If a toolbar specifier object or variable
-containing one, the specification for DOMAIN is used.  If non-nil, DOMAIN
-must be a window, a frame, or a device, otherwise it defaults to the selected
-window (see @code{specifier-instance}).  The list thus generated is checked and
-returned.
-
-If @var{toolbar-spec} is a list, it is copied; it is safe to pass other
-packages' toolbar initializers to this function.  However, you probably
-do not want to change any of the objects in the returned specification.
-They are returned as is, not copied.
-
-See @code{default-toolbar} or the Lispref (@pxref{Toolbars, , ,
-lispref}) for more information.
-@end table
-@end defun
-
-@defun toolbar-kill-item-pos pos &optional toolbar locale
-Kill the item at position @var{pos} of @var{toolbar} in @var{locale}.
-Killed buttons are prepended to @code{button-palette}.
-
-@var{locale} defaults to @code{global}.  If there are multiple specs for
-@var{locale}, take the first one.
-
-This function currently does not accept symbolic positions a la
-@code{toolbar-add-item}.  Use @code{toolbar-find-item} to locate whole
-buttons and spacers, and @code{toolbar-find-button} to locate buttons by
-characteristics.  See also @code{toolbar-find-button-by-icon},
-@code{toolbar-find-button-by-command}, and
-@code{toolbar-find-button-by-help-string}.
-@end defun
-
-@node APIs for Search, Toolbar Portability, APIs for Adding and Killing, The Toolbar Utilities
-@section APIs for Search
-
-@defun toolbar-find-button item &optional toolbar locale
-Return the position of a button containing @var{item} in its
-specification. 
-
-@table @var
-@item item
-May specify a button, spacer, icon, command, help string, or nil.  If
-@var{item} is nil, find the separator between the group of buttons to be
-left justified, and the group to be right justified.  (Distinctions
-among the various ``search key types'' are somewhat heuristic but are
-probably reliable enough to use in library code.)
-
-@item toolbar
-If non-@code{nil}, search it; otherwise search the default toolbar.
-
-@item locale
-If non-@code{nil}, get @var{toolbar}'s descriptor in that locale,
-otherwise use the @code{global} locale.
-@end table
-@end defun
-
-@defun toolbar-find-item item &optional toolbar locale
-Return the position of @var{item}, a button, spacer, or nil.
-@var{toolbar} and @var{locale} determine the descriptor to be searched.
-
-If @var{item} is nil, find the separator between the group of buttons to
-be left justified, and the group to be right justified.  If there are
-several matching items, the first is returned.  If none is found, return
-nil.
-@end defun
-
-@defun toolbar-find-button-by-icon icon &optional toolbar locale
-Return the position of a button with icon @var{icon}.
-@var{icon} must be a list of glyphs or a symbols whose value is a list
-of glyphs.
-@var{toolbar} and @var{locale} determine the descriptor to be searched.
-
-If there are several matching buttons, the first is returned.
-@end defun
-
-@defun toolbar-find-button-by-command cmd &optional toolbar locale
-Return the position of a button invoking command CMD.  @var{toolbar} and
-@var{locale} determine the descriptor to be searched.
-
-If there are several matching buttons, the first is returned.
-@end defun
-
-@defun toolbar-find-button-by-help-string str &optional toolbar locale
-
-Return the position of a button with help-string @var{str}.
-@var{toolbar} and @var{locale} determine the descriptor to be searched.
-
-If there are several matching buttons, the first is returned.
-This function will not find spacers.
-@end defun
-
-@defun toolbar-find-button-by-element object index toolbar locale &optional thunk
-Return the position of a button containing @var{object} in element
-@var{index}.  @var{toolbar} and @var{locale} determine the descriptor to
-be searched.
-
-Optional argument @var{thunk} is a function of one argument which is
-used to normalize @var{object} for comparison.
-
-If there are several matching buttons, the first is returned.
-This function will not find spacers.
-@end defun
-
-@node Toolbar Portability,  , APIs for Search, The Toolbar Utilities
-@section Toolbar API Portability to GNU Emacs
-@cindex GNU Emacs compatibility
-@cindex compatibility libraries, GNU Emacs
-
-The @file{xemacs-toolbar.el} library provides XEmacs toolbar
-compatibility functions for GNU Emacs.
-
-Third-party maintainers may use the same APIs in GNU Emacs as in XEmacs.
-Simply provide this library with your own code, and load it
-conditionally:
-
-@example
-  (if (featurep 'xemacs)
-      (require 'toolbar-utils)
-    (require 'toolbar-utils "xemacs-toolbar"))
-@end example
-
-XEmacs features that are not present in GNU Emacs will be ignored, and
-various arguments with different semantics will be defaulted appropriately.
-
-User commands such as @code{toolbar-add-kbd-macro} and advanced features
-such as the toolbar editor and the button cache are not presently
-provided.
-
-@node foldout, func-menu, The Toolbar Utilities, Top
-@chapter Folding Extensions for Outline-Mode
-
-This file provides folding editor extensions for @code{outline-mode} and
-@code{outline-minor-mode} buffers.  What's a "folding editor"?  Read on...
-
-Imagine you're in an @code{outline-mode} buffer and you've hidden all the
-text and subheadings under your level-1 headings.  You now want to look at
-the stuff hidden under one of these headings.  Normally you'd do @kbd{C-c
-C-e} @code{(show-entry)} to expose the body or @kbd{C-c C-i} to expose the
-child (level-2) headings.
-
-With foldout, you do @kbd{C-c C-z} (@code{foldout-zoom-subtree}).  This
-exposes the body and child subheadings and narrows the buffer so that only
-the level-1 heading, the body and the level-2 headings are visible.  If you
-now want to look under one of the level-2 headings, position the cursor on it
-and do @kbd{C-c C-z} again.  This exposes the level-2 body and its level-3
-child subheadings and narrows the buffer again.  You can keep on zooming in
-on successive subheadings as much as you like.  A string in the modeline
-tells you how deep you've gone.
-
-When zooming in on a heading you might only want to see the child
-subheadings.  You do this by specifying a numeric argument: @kbd{C-u C-c C-z}.
-You can specify the number of levels of children too (c.f. @code{show-children}):
-e.g. @kbd{M-2 C-c C-z} exposes two levels of child subheadings.  Alternatively,
-you might only be interested in the body.  You do this by specifying a
-negative argument: @kbd{M-- C-c C-z}.  You can also cause the whole subtree
-to be expanded, similar to @kbd{C-c C-s} (@code{show-subtree}), by specifying
-a zero argument: @kbd{M-0 C-c C-z}.
-
-While you're zoomed in you can still use outline-mode's exposure and hiding
-functions.  It won't upset foldout at all.  Also, since the buffer is
-narrowed, "global" editing actions will only affect the stuff under the
-zoomed-in heading.  This is useful for restricting changes to a particular
-chapter or section of your document.
-
-You unzoom (exit) a fold by doing @kbd{C-c C-x} (@code{foldout-exit-fold}).
-This hides all the text and subheadings under the top-level heading and
-returns you to the previous view of the buffer.  Specifying a numeric
-argument exits that many folds.  Specifying a zero argument exits *all*
-folds.
-
-You might want to exit a fold *without* hiding the text and subheadings.  You
-do this by specifying a negative argument.  For example, @kbd{M--2 C-c C-x}
-exits two folds and leaves the text and subheadings exposed.
-
-Foldout also provides mouse bindings for entering and exiting folds and for
-showing and hiding text.  Hold down Meta and Control, then click a mouse
-button as follows:-
-
-@itemize @bullet
-
-@item mouse-1 (@code{foldout-mouse-zoom}) zooms in on the heading clicked on:
-
-@itemize @minus
-
-@item single click -- expose body
-
-@item double click -- expose subheadings
-
-@item triple click -- expose body and subheadings
-
-@item quad click -- expose entire subtree
-
-@end itemize
-
-@item mouse-2 (@code{foldout-mouse-show}) exposes text under the heading clicked on:
-
-@itemize @minus
-
-@item single click -- expose body
-
-@item double click -- expose subheadings
-
-@item triple click -- expose body and subheadings
-
-@item quad click -- expose entire subtree
-
-@end itemize
-
-@item mouse-3 (@code{foldout-mouse-hide-or-exit}) hides text under the
-heading clicked on or exits the fold:
-
-@itemize @minus
-
-@item single click -- hide subtree
-
-@item double click -- exit fold and hide text
-
-@item triple click -- exit fold without hiding text
-
-@item quad click -- exit all folds and hide text
-
-@end itemize
-
-@end itemize
-
-You can change the modifier keys used by setting
-@code{foldout-mouse-modifiers}.
-
-To use foldout, put this in your initialization file:
-
-@example
-  (require 'foldout)
-@end example
-
-If you don't want it loaded until you need it, try this instead:
-
-@example
-  (eval-after-load "outline" '(require 'foldout))
-@end example
-
-@node func-menu, id-select, foldout, Top
-@chapter Jump to a Function Within a Buffer.
-
-Suppose you have a file with a lot of functions in it. Well, this package
-makes it easy to jump to any of those functions. The names of the functions
-in the current buffer are automatically put into a menubar menu, you select
-one of the function-names and the point is moved to that very function. The
-mark is pushed on the mark-ring, so you can easily go back to where you
-were. Alternatively, you can use enter the name of the desired function via
-the minibuffer which offers completing read input. In addition, the name of
-the function before point is optionally displayed in the modeline.
-
-The following modes are supported: 
-
-Ada, Assembly, BibTex, C++, C, Dired, Ehdm, ELisp, FORTRAN, Ksh, Latex,
-Lelisp, Makefile, Maple, Modula2, Modula3, Outline, Objective-C, Pascal,
-Perl, Postscript, Prolog, PVS, Python, SGML, Scheme, Tcl, Verilog, Manual,
-Ruby, JavaScript
-
-To install this package, add the following to your initialization file:
-
-@example
-  (add-hook 'find-file-hooks 'fume-setup-buffer)
-  (add-hook 'Manual-mode-hook 'turn-on-fume-mode)
-@end example
-
-@node id-select, outl-mouse, func-menu, Top
-@chapter Select Syntax-Driven Regions in a Buffer
-
-This is a radically cool, drop in mouse and keyboard-based library for
-selecting successively bigger syntactical regions within a buffer.  Simply
-load this library and you are ready to try it out by double-clicking on
-various kinds of characters in different buffer major modes.  You'll quickly
-get the hang of it.  (It also provides a command to jump between beginning
-and end tags within HTML and SGML buffers.)
-
-A great deal of smarts are built-in so that it does the right thing almost
-all of the time; many other attempts at similar behavior such as
-@file{thing.el} fail to deal with many file format complexities.
-
-Double clicks of the Selection Key (left mouse key) at the same point will
-select bigger and bigger regions with each successive use.  The first double
-click selects a region based upon the character at the point of the click.
-For example, with the point over an opening or closing grouping character,
-such as @{ or @}, the whole grouping is selected, e.g. a C function.  When on
-an _ or - within a programming language variable name, the whole name is
-selected.  The type of selection is displayed in the minibuffer as feedback.
-When using a language based mainly on indenting, like Bourne shell, a double
-click on the first alpha character of a line, such as an if statement,
-selects the whole statement.
-
-This whole package is driven by a single function, available in mouse and
-keyboard forms, that first marks a region based on the syntax category of the
-character following point.  Successive invocations mark larger and larger
-regions until the whole buffer is marked.  See the documentation for the
-function, @code{id-select-syntactical-region}, for the kinds of syntax
-categories handled.
-
-Loading this package automatically installs its functionality on double-clicks
-(or higher) of the left mouse key.  (See the documentation for the variable,
-@code{mouse-track-click-hook}, for how this is done.)  A single click of the
-left button will remove the region and reset point.
-
-The function, @code{id-select-thing}, may be bound to a key to provide the
-same syntax-driven region selection functionality. @kbd{C-c C-m} is a
-reasonable site-wide choice since this key is seldom used and it mnemonically
-indicates marking something.  @kbd{C-c s} may be preferred as a personal
-binding.
-
-Use @kbd{C-g} to unmark the region when done.  Use,
-@code{id-select-thing-with-mouse}, if you want to bind this to a mouse key
-and thereby use single clicks instead of double clicks.
-
-Three other commands are also provided:
-
-@table @code
-
-@item id-select-and-copy-thing
-mark and copy the syntactical unit to the kill ring 
-
-@item id-select-and-kill-thing
-kill the syntactical unit at point
-
-@item id-select-goto-matching-tag
-In HTML and SGML modes (actually any listed in the variable,
-`id-select-markup-modes'), moves point to the start of the tag paired with
-the closest tag that point is within or which it precedes, so you can quickly
-jump back and forth between open and close tags.
-
-@end table
-
-To autoload this package via mouse usage, add the following line to one of
-your initialization files:
-
-@example
-  (add-hook 'mouse-track-click-hook 'id-select-double-click-hook)
-@end example
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET id-select RET
-@end example
-
-@node outl-mouse, page-ext, id-select, Top
-@chapter Outline-Mode Mouse Commands
-
-Defines @kbd{mouse button one} to hide blocks when clicked on
-outline-up-arrow and expand blocks when clicked on outline-down-arrow.
-Features are activated when @code{outline-minor-mode} or @code{outline-mode}
-are turned on. There is also a menu for each glyph on @kbd{mouse button 3}.
-
-To use, add the following to your initialization file:
-
-@example
-  (require 'outl-mouse)
-@end example
-
-If you use func-menu all the time and want outl-mouse on all the time as well
-then specify @code{(setq outline-sync-with-func-menu t)}.  Outlining will
-then be turned on when func-menu is activated.
-
-If you want mac-style outlining then set @code{outline-mac-style} to t.  If
-you want the outline arrows on the left then set
-@code{outline-glyphs-on-left} to t. If you have xpm then arrows are much
-better defined.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET outl-mouse RET
-@end example
-
-@node page-ext, power-macros, outl-mouse, Top
-@chapter Extended Page Handling Commands
-
-The page commands are helpful in several different contexts.  For example,
-programmers often divide source files into sections using the
-@code{page-delimiter}; you can use the @code{pages-directory} command to list
-the sections.
-
-You may use the page commands to handle an address list or other small data
-base.  Put each address or entry on its own page.  The first line of text in
-each page is a `header line' and is listed by the @code{pages-directory} or
-@code{pages-directory-for-addresses} command.
-
-@menu
-* Key Assignments: page-ext-keys.
-* Using the Page Commands: page-ext-using.
-* Address List or Small Database: page-ext-addr.
-@end menu
-
-@node page-ext-keys, page-ext-using, page-ext, page-ext
-@section Key Assignments
-
-The current page commands are:
-
-@multitable {pages-directory-for-addresses} {C-x C-p  (change this to C-x C-p C-m)}
-
-@item forward-page      @tab  C-x ]
-@item backward-page     @tab  C-x [
-@item narrow-to-page    @tab  C-x p
-@item count-lines-page  @tab  C-x l
-@item mark-page         @tab  C-x C-p  (change this to C-x C-p C-m)
-@item sort-pages        @tab  not bound
-@item what-page         @tab  not bound
-
-@end multitable
-
-The new page handling commands all use @kbd{C-x C-p} as a prefix.  This means
-that the key binding for @code{mark-page} must be changed.  Otherwise, no
-other changes are made to the current commands or their bindings.
-
-The extended page handling commands are:
-
-@multitable {pages-directory-for-addresses} {C-x C-p  (change this to C-x C-p C-m)}
-
-@item next-page                      @tab  C-x C-p C-n
-@item previous-page                  @tab  C-x C-p C-p
-@item search-pages                   @tab  C-x C-p C-s
-@item add-new-page                   @tab  C-x C-p C-a
-@item sort-pages-buffer              @tab  C-x C-p s      
-@item set-page-delimiter             @tab  C-x C-p C-l
-@item pages-directory                @tab  C-x C-p C-d   
-@item pages-directory-for-addresses  @tab  C-x C-p d
-@item pages-directory-goto           @tab  C-c C-c
-
-@end multitable
-
-@node page-ext-using, page-ext-addr, page-ext-keys, page-ext
-@section Using the Page Commands
-
-The page commands are helpful in several different contexts.  For example,
-programmers often divide source files into sections using the
-@code{page-delimiter}; you can use the @code{pages-directory} command to list
-the sections.
-
-You may change the buffer local value of the @code{page-delimiter} with the
-@code{set-page-delimiter} command.  This command is bound to @kbd{C-x C-p
-C-l}. The command prompts you for a new value for the @code{page-delimiter}.
-Called with a prefix-arg, the command resets the value of the page-delimiter
-to its original value.
-
-You may set several user options:
-
-@table @code
-
-@item pages-directory-buffer-narrowing-p 
-Causes the @code{pages-directory-goto} command to narrow to the destination
-page.
-
-@item pages-directory-for-adding-page-narrowing-p 
-Causes the @code{add-new-page} command to narrow to the new entry.
-
-@item pages-directory-for-adding-new-page-before-current-page-p
-Causes the @code{add-new-page} command to insert a new page before current
-page.
-
-@end table
-
-These variables are all true by default.
-
-@node page-ext-addr,  , page-ext-using, page-ext
-@section Address List or Small Database
-
-You may use the page commands to handle an address list or other small data
-base.  Put each address or entry on its own page.  The first line of text in
-each page is a `header line' and is listed by the @code{pages-directory} or
-@code{pages-directory-for-addresses} command.
-
-Specifically:
-
-@enumerate
-
-@item
-
-Begin each entry with a `page-delimiter' (which is, by default, `^L' at the
-beginning of the line).
-
-@item
-
-The first line of text in each entry is the `heading line'; it will appear in
-the pages-directory-buffer which is constructed using the @kbd{C-x C-p C-d}
-(@code{pages-directory}) command or the @kbd{C-x C-p d}
-(@code{pages-directory-for-addresses}) command.
-
-The heading line may be on the same line as the page-delimiter or it may
-follow after.  It is the first non-blank line on the page.  Conventionally,
-the heading line is placed on the line immediately following the line
-containing page-delimiter.
-
-@item
-
-Follow the heading line with the body of the entry.  The body extends up to
-the next `page-delimiter'.  The body may be of any length.  It is
-conventional to place a blank line after the last line of the body.
-
-@end enumerate
-
-For example, a file might look like this:
-
-@example
-    FSF
-    Free Software Foundation
-    59 Temple Place - Suite 330
-    Boston, MA 02111-1307  USA.
-    (617) 542-5942
-    gnu@@prep.ai.mit.edu
-
-    
-    House Subcommittee on Intellectual Property,
-    U.S. House of Representatives,
-    Washington, DC  20515
-
-    Congressional committee concerned with permitting or preventing
-    monopolistic restrictions on the use of software technology.
-
-    
-    George Lakoff
-    ``Women, Fire, and Dangerous Things:
-    What Categories Reveal about the Mind''
-    1987, Univ. of Chicago Press
-
-    About philosophy, Whorfian effects, and linguistics.
-
-     
-    OBI   (On line text collection.)
-    Open Book Initiative
-    c/o Software Tool & Die
-    1330 Beacon St, Brookline, MA 02146 USA
-    (617) 739-0202 
-    obi@@world.std.com
-@end example
-
-In this example, the heading lines are:
-
-@example
-    FSF
-    House Subcommittee on Intellectual Property
-    George Lakoff
-    OBI (On line text collection.)
-@end example
-
-The @kbd{C-x C-p s} (@code{sort-pages-buffer}) command sorts the entries in
-the buffer alphabetically.
-
-You may use any of the page commands, including the @code{next-page},
-@code{previous-page}, @code{add-new-page}, @code{mark-page}, and
-@code{search-pages} commands.
-
-You may use either the @kbd{C-x C-p d} (@code{pages-directory-for-addresses})
-or the @kbd{C-x C-p C-d} (@code{pages-directory}) command to construct and
-display a directory of all the heading lines.
-
-In the directory, you may position the cursor over a heading line and type
-@kbd{C-c C-c} (@code{pages-directory-goto}) to go to the entry to which it
-refers in the pages buffer.
-
-You can type @kbd{C-c C-p C-a} (@code{add-new-page}) to add a new entry in
-the pages buffer or address file.  This is the same command you use to add a
-new entry when you are in the pages buffer or address file.
-
-If you wish, you may create several different directories, one for each
-different buffer.
-
-@code{`pages-directory-for-addresses} assumes a default addresses file.  You
-do not need to specify the addresses file but merely type @kbd{C-x C-p d}
-from any buffer.  The command finds the file, constructs a directory for it,
-and switches you to the directory.  If you call the command with a prefix
-arg, @kbd{C-u C-x C-p d}, it prompts you for a file name.
-
-You may customize the addresses commands:
-
-@table @code
-
-@item pages-addresses-file-name
-Determines the name of the addresses file; by default it is "~/addresses".
-
-@item pages-directory-for-addresses-goto-narrowing-p
-Determines whether @code{pages-directory-goto} narrows the addresses
-buffer to the entry, which it does by default.
-
-@item pages-directory-for-addresses-buffer-keep-windows-p
-Determines whether @code{pages-directory-for-addresses} deletes other windows
-to show as many lines as possible on the screen or works in the usual Emacs
-manner and keeps other windows.  Default is to keep other windows.
-
-@item pages-directory-for-adding-addresses-narrowing-p
-Determines whether @code{pages-directory-for-addresses} narrows the addresses
-buffer to a new entry when you are adding that entry.  Default is to narrow
-to new entry, which means you see a blank screen before you write the new
-entry.
-
-@end table
-
-Call the @code{pages-directory} command from the buffer for which you want a
-directory created; it creates a directory for the buffer and pops you to the
-directory.
-
-The @code{pages-directory} command has several options:
-
-@enumerate
-
-@item
-
-Called with a prefix arg, @kbd{C-u C-x C-p C-d}, the @code{pages-directory}
-prompts you for a regular expression and only lists only those header lines
-that are part of pages that contain matches to the regexp.  In the example
-above, @kbd{C-u C-x C-p C-d 617 RET} would match the telephone area code of
-the first and fourth entries, so only the header lines of those two entries
-would appear in the pages-directory-buffer.
-
-@item
-
-Called with a numeric argument, the @code{pages-directory} command lists the
-number of lines in each page.  This is helpful when you are printing
-hardcopy.
-
-@item
-
-Called with a negative numeric argument, the @code{pages-directory} command
-lists the lengths of pages whose contents match a regexp.
-
-@end enumerate
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET pages RET
-@end example
-
-@node power-macros, redo, page-ext, Top
-@chapter Power Macros - Keyboard Macros Made Easy
-
-Keyboard Macros are a very powerful tool, if you know how to use them the
-right way!  Without this extension it is, however, a bit difficult in Emacs
-to define and maintain several macros at a time. This problem is solved with
-this package.
-
-When you have loaded this package Emacs will, upon completion of macro
-definition, ask you which key you want to assign this macro to and ask for a
-description of the macro. If something is already bound to this key, Emacs
-will ask you whether you want to override this binding. Furthermore, this
-package also takes care of saving the macro to your initialization file for
-later Emacs sessions.
-
-The description for all the defined macros may be obtained with the function
-`pm-manage-macros'. Using this function you can also manage your
-power-macros.
-
-To execute this function, type:
-
-@example
-  M-x pm-manage-macros RET
-@end example
-
-To configure the package, type:
-
-@example
-  M-x customize-group RET power-macros RET
-@end example
-
-@node redo, scroll-in-place, power-macros, Top
-@chapter Redo/Undo System
-
-Emacs' normal undo system allows you to undo an arbitrary number of buffer
-changes.  These undos are recorded as ordinary buffer changes themselves.  So
-when you break the chain of undos by issuing some other command, you can then
-undo all the undos.  The chain of recorded buffer modifications therefore
-grows without bound, truncated only at garbage collection time.
-
-The redo/undo system is different in two ways:
-
-@enumerate
-
-@item
-
-The undo/redo command chain is only broken by a buffer modification.  You can
-move around the buffer or switch buffers and still come back and do more
-undos or redos.
-
-@item
-
-The @code{redo} command rescinds the most recent undo without recording the
-change as a _new_ buffer change.  It completely reverses the effect of the
-undo, which includes making the chain of buffer modification records shorter
-by one, to counteract the effect of the undo command making the record list
-longer by one.
-
-@end enumerate
-
-To use this package, add the following to your initialization file:
-
-@example
-  (require 'redo)
-@end example
-
-@node scroll-in-place, setnu, redo, Top
-@chapter Scrolling In Place
-
-This library provides improved vertical scrolling commands for GNU Emacs.
-
-@menu
-* Features: sip-features.
-* Commands and Functions: sip-commands.
-* Installation: sip-install.
-* Advanced Customization: sip-customize
-@end menu
-
-@node sip-features, sip-commands, scroll-in-place, scroll-in-place
-@section Features
-
-The new vertical scrolling commands offer the following features:
-
-@itemize @bullet
-
-@item
-
-When a scrolling command is executed, GNU Emacs tries to keep point as close
-as possible to its original window position (window line and column).  This
-is what "scroll in place" means: point stays "in place" within the window.
-(There are times when point must be moved from its original window position
-in order to execute the scroll; see below.)
-
-The variable @code{scroll-in-place}, which is true by default, determines
-whether or not the standard GNU Emacs scrolling commands (@code{scroll-down},
-@code{scroll-up}, @code{scroll-other-window-down}, and
-@code{scroll-other-window}) use the "in place" features listed here.  When
-@code{scroll-in-place} is nil the standard GNU Emacs scrolling commands
-essentially just call the original versions of themselves.  (Note that even
-when @code{scroll-in-place} is nil the new versions of @code{scroll-down} and
-@code{scroll-up} have slightly different behavior when a minibuffer window is
-the selected window.  See below.)
-
-It is possible to turn off (or turn on) "in place" scrolling for certain
-buffers by making buffer-local bindings of the variable
-@code{scroll-in-place} for those buffers.  The variable
-@code{scroll-in-place} is not usually buffer-local, but you can make it so if
-you desire.
-
-@item
-
-Because the improved scrolling commands keep point at its original window
-position, these scrolling commands are "reversible."  The @code{scroll-up}
-command undoes the effect of the immediately previous @code{scroll-down}
-command (if any) and vice versa.  In other words, if you scroll up and then
-immediately scroll back down, the window configuration is restored to its
-exact original state.  This allows you to browse through a buffer more
-easily, as you can always get back to the original configuration.
-
-Note, however, that the improved scrolling commands are guaranteed to be
-reversible only if there are no intervening non-scrolling commands.  Also, if
-you give a prefix argument to a scrolling command (in order to specify the
-number of lines to scroll by), previous scrolling commands may no longer be
-reversible.  More specifically, if the new prefix argument has a different
-magnitude than the previous scrolling distance, then any previous scrolling
-commands are not reversible.  The new prefix argument takes precedence.
-
-You might find it useful to think of the scrolling commands as forming
-"chains."  A scrolling command either starts or continues a chain.  By
-issuing a non-scrolling command or by changing the number of lines to be
-scrolled, you break the chain.  (Note that simply changing the scrolling
-direction won't break the chain; changing the absolute number of lines to be
-scrolled is what breaks the chain.)  Scrolling commands are guaranteed to be
-reversible only within the current chain.  Hopefully that's clear enough.
-
-@item
-
-When a scrolling command is given a prefix argument (which specifies the
-number of lines to scroll by), then that argument becomes the default
-scrolling distance for all immediately subsequent scrolling commands.  This
-means that you can easily set the scrolling distance for a chain of scrolling
-commands.  Note that a new prefix argument or any non- scrolling command
-breaks the chain (as described above), and any further scrolling commands
-will use the usual defaults (or the prefix argument you specify at that time,
-of course).
-
-However, there are cases in which one doesn't want the current scrolling
-command to use the default scrolling distance that was set by the previous
-scrolling command.  For example, suppose that you had special commands that
-scrolled one line up and one line down.  When you invoke one of these
-commands, the "in place" scrolling routines set the default scrolling
-distance to be just one line.  Now suppose that you use one of your special
-commands and then immediately invoke @code{scroll-up} (@kbd{C-v}), expecting
-it to scroll by a near windowful of text.  You would be disappointed ---
-because the previous command set the default scrolling distance to be just
-one line, @code{scroll-up} just scrolls by one line.
-
-To solve this problem, "scroll-in-place" allows you to divide scrolling
-commands into separate "groups."  Commands in a group can only form chains
-with (and therefore, inherit defaults from) commands in the same group.
-(Note that no command can be in more than one group.)  If you invoke a
-scrolling command that is not in the same group as that of the immediately
-previous scrolling command, then the previous chain is broken and you start a
-new chain --- with a new set of defaults.
-
-So to solve the problem described above, you could put your one-line
-scrolling commands in their own group.  Once that is done, the standard
-scrolling commands will not form chains with your one-line scrolling
-commands, and therefore will not use the default scrolling distance set by
-those commands.  Problem solved!
-
-By default, all "in place" scrolling commands are in a single group.  If you
-want to partition some commands into separate groups, you must do that
-yourself @emph{before} any "in place" commands are invoked.  For more
-information about grouping commands, see the documentation for the variables
-@code{scroll-command-groups} and @code{scroll-default-command-group}.
-
-@item
-
-The improved scrolling commands will avoid displaying empty lines past the
-end of the buffer when possible.  In other words, just as you can't see "dead
-space" before the beginning of the buffer text, the new scrolling commands
-try to avoid displaying "dead space" past the end of the buffer text.  This
-behavior is somewhat configurable; see the documentation for the variable
-@code{scroll-allow-blank-lines-past-eob}.
-
-Dead space will be displayed if it is necessary in order to make a previous
-scrolling action reversible, however.
-
-@item
-
-If the scrolling commands cannot keep point at its initial window position
-(because a buffer boundary is on screen and the window can't be scrolled as
-far as necessary to keep point at the right place), point is allowed to
-temporarily stray from its initial window position.  That is, point moves the
-correct number of window lines, even if it means that it has to stray from
-its desired window position.  This straying is undone when (and if) the
-scrolling action is reversed.
-
-@item
-
-If a scrolling command tries to move point past a buffer boundary, point is
-instead moved to the boundary (the beginning or the end of the buffer as
-appropriate) and an appropriate message is displayed.  This motion is
-reversible, of course.
-
-However, if point was already at the buffer boundary when the scrolling
-command was invoked, the command signals an appropriate error instead.
-
-@item
-
-When a minibuffer window is the selected window, the new versions of
-@code{scroll-up} and @code{scroll-down} either scroll the window in the
-variable @code{minibuffer-scroll-window} (which is usually the window of
-completions) or the @code{next-window} if there is no
-@code{minibuffer-scroll-window}.  This is usually much more useful than
-scrolling the minibuffer itself.  (Note that this feature is available even
-when the variable @code{scroll-in-place} is nil.)
-
-@item
-
-When a scrolling command is scrolling a window other than the selected
-window, it will signal an appropriate buffer boundary error if the window
-cannot be scrolled (because the appropriate buffer boundary is already
-visible).  This means that an error is signalled even in cases that would be
-allowed (by "straying" point or by moving it to the buffer boundary) if the
-window were selected.
-
-(If an error were not signalled in these cases, then there would be many
-cases in which the last scroll in a particular direction would appear to do
-nothing because only the point position would change --- the displayed text
-would stay the same!  To avoid these cases the scrolling commands signal
-boundary errors "prematurely" when the window to be scrolled is not
-selected.)
-
-@end itemize
-
-@node sip-commands, sip-install, sip-features, scroll-in-place
-@section Command and Functions
-
-This library provides the following "in place" versions of GNU Emacs'
-standard vertical scrolling commands:
-
-@itemize @bullet
-@item scroll-down-in-place
-@item scroll-up-in-place
-@item scroll-other-window-down-in-place
-@item scroll-other-window-in-place
-@end itemize
-
-The variable @code{scroll-in-place}, which is true by default, determines
-whether or not the new versions of the standard GNU Emacs scrolling commands
-(@code{scroll-down}, @code{scroll-up}, @code{scroll-other-window-down}, and
-@code{scroll-other-window}) use the "in place" features listed above.  When
-@code{scroll-in-place} is nil the standard GNU Emacs scrolling commands
-essentially just call the original versions of themselves.  (Note that even
-when @code{scroll-in-place} is nil the new versions of @code{scroll-down} and
-@code{scroll-up} have slightly different behavior when a minibuffer window is
-the selected window.  See the feature list above.)
-
-NOTE that this package redefines the standard GNU Emacs commands
-@code{scroll-down}, @code{scroll-up}, @code{scroll-other-window-down}, and
-@code{scroll-other-window} (in order to check the variable
-@code{scroll-in-place}, as described above).  The command
-@code{scroll-other-window-down} first appeared as a standard command in the
-FSF's GNU Emacs 19.26.
-
-This package also provides the following functions and variables which are
-of use to programmers:
-
-@itemize @bullet
-@item scroll-window
-@item scroll-window-in-place
-@item scroll-window-in-place-continue-sequence
-@item scroll-default-lines (variable)
-@item scroll-command-groups (variable)
-@end itemize
-
-The @code{scroll-window-in-place} function is the heart of the "in place"
-scrolling commands.  @code{scroll-window} is a function that checks the
-variable @code{scroll-in-place} and calls the appropriate scrolling function
-(either @code{scroll-window-in-place} or one of the original versions of
-@code{scroll-down} and @code{scroll-up}).  The function
-@code{scroll-window-in-place-continue-sequence} is provided in order to
-preserve running "chains" of scrolling commands as described above.
-
-The variable @code{scroll-default-lines} determines the default scrolling
-distance when a new chain of "in place" scrolling commands begins.  If this
-variable is not a number, then the default distance is the height of the
-window to be scrolled minus @code{next-screen-context-lines}.  The variable
-@code{scroll-command-groups} contains the explicit groups of "in place"
-scrolling commands; for more information read the variable documentation.
-
-@node sip-install, sip-customize, sip-commands, scroll-in-place
-@section Installation
-
-To use this package, you simply need to load it from within your
-initialization file:
-
-@example
-  (require 'scroll-in-place)
-@end example
-
-By default, this package provides for the standard GNU Emacs vertical
-scrolling commands (@code{scroll-down}, @code{scroll-up},
-@code{scroll-other-window-down}, and @code{scroll-other-window}) to use the
-"in place" features.  If you would rather not have this, set the variable
-@code{(setq scroll-in-place nil)}.
-
-When @code{scroll-in-place} is nil you will have to bind keys in order to
-call the "in place" scrolling commands.  For example, you might want to do
-the following:
-
-@example
-  (global-set-key "\M-v" 'scroll-down-in-place)
-  (global-set-key "\C-v" 'scroll-up-in-place)
-@end example
-
-@node sip-customize,  , sip-install, scroll-in-place
-@section Advanced Customization
-
-If you want to partition certain "in place" scrolling commands into separate
-groups, you should do something like the following:
-
-@example
-  ;; Make one group containing the commands `scroll-down-one-line' and
-  ;; `scroll-up-one-line'.  (These are not standard GNU Emacs commands.)
-  (setq scroll-command-groups
-        (list '(scroll-down-one-line scroll-up-one-line)))
-@end example
-
-You could write the `scroll-down-one-line' command like this:
-
-@example
-  (defun scroll-down-one-line (arg)
-    "Scroll down one line, or number of lines specified by prefix arg."
-    (interactive "P")
-    (let ((scroll-default-lines 1))
-      (scroll-down-in-place arg)))
-@end example
-
-If you want to disable "in place" scrolling for windows that display a
-particular buffer (while leaving it available in other windows), you can make
-@code{scroll-in-place} a buffer-local variable for that buffer and then bind
-that local copy of @code{scroll-in-place} to nil.  This is the kind of thing
-that one generally does in a major mode hook.  For example, you can disable
-"in place" scrolling of GNUS article windows with the following code:
-
-@example
-  (setq gnus-article-mode-hook
-        (function (lambda ()
-                    (make-local-variable 'scroll-in-place)
-                    (setq scroll-in-place nil))))
-  ;; Set the variable `gnus-Article-mode-hook' instead if you are using
-  ;; an old version of GNUS, say version 3.13 or 3.14.
-@end example
-
-The variable @code{scroll-allow-blank-lines-past-eob} can also be made local
-to particular buffers, if you desire.  (But why would you want to do that?)
-
-@node setnu, vertical-mode, scroll-in-place, Top
-@chapter VI-style Line Number Mode
-
-This library activates VI-style line numbering for a buffer.
-
-@code{M-x setnu-mode} toggles the line number mode on and off.
-
-@code{turn-on-setnu-mode} is useful for adding to a major-mode hook variable.
-
-@example
-  (add-hook 'text-mode-hook 'turn-on-setnu-mode)
-@end example
-
-to automatically turn on line numbering when entering text-mode.
-
-@node vertical-mode, align, setnu, Top
-@chapter Vertical Mode - Editing of Vertical Text
-
-This minor mode allows you to conveniently edit things that are oriented
-vertically (like tables in computer programs): after each action, cursor
-moves down. Therefore, to move block of text to the right, you simply enter
-vertical mode and then hold @kbd{spacebar}, waiting for autorepeat to do the
-job for you.
-
-@node align, allout, vertical-mode, Top
-@chapter Align Text to a Specific Column, By Regexp
-
-This mode allows you to align regions in a context-sensitive fashion.  The
-classic use is to align assignments:
-
-@example
-  int a = 1;
-  short foo = 2;
-  double blah = 4;
-@end example
-
-becomes
-
-@example
-  int    a    = 1;
-  short  foo  = 2;
-  double blah = 4;
-@end example
-
-@menu
-* Align Usage::		How to use the package.
-@end menu
-
-@node Align Usage,  , align, align
-@section Align Usage
-
-To configure the package, type:
-
-@example
-  M-x customize-group RET align RET
-@end example
-
-There are several variables which define how certain "categories" of syntax
-are to be treated.  These variables go by the name `align-CATEGORY-modes'.
-For example, "c++" is such a category.  There are several rules which apply
-to c++, but since several other languages have a syntax similar to c++ (e.g.,
-c, java, etc), these modes are treated as belonging to the same category.
-
-If you want to add a new mode under a certain category, just customize that
-list, or add the new mode manually.  For example, to make jde-mode a c++
-category mode, use this code in your initialization file:
-
-@example
-  (setq align-c++-modes (cons 'jde-mode align-c++-modes))
-@end example
-
-In some programming modes, it's useful to have the aligner run only after
-indentation is performed.  To achieve this, customize or set the variable
-`align-indent-before-aligning' to t.
-
-@node allout, narrow-stack, align, Top
-@chapter Extensive Outline Mode
-
-Allout outline mode provides extensive outline formatting and manipulation
-beyond standard emacs outline mode (@pxref{Outline Mode,,,xemacs}).  It
-provides for structured editing of outlines, as well as navigation and
-exposure.  It also provides for syntax-sensitive text like programming
-languages.  (For an example, see the allout code itself, which is organized
-in ;; an outline framework.)
- 
-In addition to outline navigation and exposure, allout includes:
-
-@itemize @bullet
-
-@item topic-oriented repositioning, cut, and paste
-
-@item integral outline exposure-layout
-
-@item incremental search with dynamic exposure and reconcealment of hidden
-text
-
-@item automatic topic-number maintenance
-
-@item "Hot-spot" operation, for single-keystroke maneuvering and exposure
-control. (See the outline-mode docstring.)
-
-@end itemize 
- 
-and many other features.
- 
-To configure the package, type:
-
-@example
-  M-x customize-group RET allout RET
-@end example
-
-To use the allout package in place of the standard outline package, add the
-following bit of code
-
-@lisp 
-(require 'outline "allout") 
-@end lisp 
-
-to your initialization file.  This will ensure that all the functions
-provided by the outline package will be loaded from the new allout package
-instead.
-
-The outline menubar additions provide quick reference to many of the
-features, and see the docstring of the variable `outline-init' for
-instructions on priming your emacs session for automatic activation of
-outline-mode.
- 
-See the docstring of the variables `outline-layout' and
-`outline-auto-activation' for details on automatic activation of allout
-outline-mode as a minor mode.
-
-By default, allout mode does not fontify the buffer. To get Font Lock to work
-put the following into your initialization file (adapted from the standard
-outline mode):
-
-@example
-  (defvar rf-allout-font-lock-keywords
-    '(;;
-      ;; Highlight headings according to the level.
-      (eval . (list (concat "^\\(" outline-regexp "\\).+")
-                    0 '(or (cdr (assq (outline-depth)
-                                      '((1 . font-lock-function-name-face)
-                                        (2 . font-lock-variable-name-face)
-                                        (3 . font-lock-keyword-face)
-                                        (4 . font-lock-builtin-face)
-                                        (5 . font-lock-comment-face)
-                                        (6 . font-lock-constant-face)
-                                        (7 . font-lock-type-face)
-                                        (8 . font-lock-string-face))))
-                           font-lock-warning-face)
-                    nil t)))
-    "Additional expressions to highlight in Outline mode.")
-
-  ;; add font-lock to allout mode
-  (defun rf-allout-font-lock-hook ()
-    (set (make-local-variable 'font-lock-defaults)
-         '(rf-allout-font-lock-keywords t nil nil outline-back-to-current-heading)))
-
-  (add-hook 'outline-mode-hook 'rf-allout-font-lock-hook)
-@end example
-
-@node narrow-stack, flow-ctrl, allout, Top
-@chapter Extending the built-in narrowing functions
-
-Narrowing, as implemented in Emacs has one limitation, namely that it is not
-possible to narrow within a narrowing, and then widen again to the previous
-narrowing.  This package implements an extension to narrowing, which makes
-this possible.
-
-To activate this extension type @code{M-x narrow-stack-mode} or add
-@code{(narrow-stack-mode)} to your initialization file.
- 
-@node flow-ctrl, makesum, narrow-stack, Top
-@chapter Flow Control
-
-Terminals that use XON/XOFF flow control can cause problems with GNU Emacs
-users.  This file contains Emacs Lisp code that makes it easy for a user to
-deal with this problem, when using such a terminal.
-
-To invoke these adjustments, a user need only invoke the function
-@code{enable-flow-control-on} with a list of terminal types specified in the
-initialization file.  As arguments, give it the names of one or more terminal
-types in use by that user which require flow control adjustments.  Here's an
-example:
-
-@example
-  (enable-flow-control-on "vt200" "vt300" "vt101" "vt131")
-@end example
-
-Portability note: This uses @code{(getenv "TERM")}, and therefore probably
-won't work outside of UNIX-like environments.
-
-@node makesum, man, flow-ctrl, Top
-@chapter Generate Summary of All Key Binding
-
-Displays a nice human-readable summary of all keybindings in a two-column
-format.
-
-To invoke this command, type:
-
-@example
-  M-x make-command-summary RET
-@end example
-
-@node man, abbrevlist, makesum, Top
-@chapter Browse UNIX manual pages
-
-This library defines the command @code{manual-entry} to browse Unix manual
-pages.
-
-To invoke this command, type:
-
-@example
-  M-x manual-entry RET
-@end example
-
-For ease of use, autocompletion on @code{M-x man} will work just fine.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET man RET
-@end example
-
-@node abbrevlist, file-part, man, Top
-@chapter Abbreviation List
-
-This library not documented.  Please contribute!
-
-@node file-part, info-look, abbrevlist, Top
-@chapter Treat a Section of a Buffer as a Separate File
-
-This library not documented.  Please contribute!
-
-@node info-look, live-icon, file-part, Top
-@chapter Major-Mode-Sensitive Info Index Lookup Facility
-
-This library not documented.  Please contribute!
-
-@node live-icon, mode-motion+, info-look, Top
-@chapter Make Frame Icons Represent Current Frame Contents
-
-This library not documented.  Please contribute!
-
-@node mode-motion+, popper, live-icon, Top
-@chapter Per Mode/Buffer Mouse Tracking With Highlighting
-
-This library not documented.  Please contribute!
-
-@node popper, reportmail, mode-motion+, Top
-@chapter Shrink-Wrapped Temporary Windows
-
-This library not documented.  Please contribute!
-
-@node reportmail, balloon-help, popper, Top
-@chapter Display Time and Load in Mode Line
-
-This library not documented.  Please contribute!
-
-@node balloon-help, blink-paren, reportmail, Top
-@chapter Balloon Help and Tooltips
-
-This library not documented.  Please contribute!
-
-@node blink-paren, edit-faces, balloon-help, Top
-@chapter Blinking Parentheses
-
-This library not documented.  Please contribute!
-
-@node edit-faces, lispm-fonts, blink-paren, Top
-@chapter Face Editor
-
-This library not documented.  Please contribute!
-
-@node lispm-fonts, big-menubar, edit-faces, Top
-@chapter lispm-fonts
-
-This library not documented.  Please contribute!
-
-@node big-menubar, tree-menu, lispm-fonts, Top
-@chapter Big Menubar
-
-This library not documented.  Please contribute!
-
-@node tree-menu, XEmacs License, big-menubar, Top
-@chapter tree-menu
-
-This library not documented.  Please contribute!
-
-@node XEmacs License,  , tree-menu, Top
-@chapter XEmacs License
-@unnumbered GNU GENERAL PUBLIC LICENSE
-@center Version 2, June 1991
-
-@display
-Copyright @copyright{} 1989, 1991 Free Software Foundation, Inc.
-675 Mass Ave, Cambridge, MA 02139, USA
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-@end display
-
-@unnumberedsec Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software---to make sure the software is free for all its users.  This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it.  (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.)  You can apply it to
-your programs, too.
-
-  When we speak of free software, we are referring to freedom, not
-price.  Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
-  To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
-  For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have.  You must make sure that they, too, receive or can get the
-source code.  And you must show them these terms so they know their
-rights.
-
-  We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
-  Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software.  If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
-  Finally, any free program is threatened constantly by software
-patents.  We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary.  To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.
-
-@iftex
-@unnumberedsec TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-@end iftex
-@ifinfo
-@center TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-@end ifinfo
-
-@enumerate 0
-@item
-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.
-
-@item
-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.
-
-@item
-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:
-
-@enumerate a
-@item
-You must cause the modified files to carry prominent notices
-stating that you changed the files and the date of any change.
-
-@item
-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.
-
-@item
-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.)
-@end enumerate
-
-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.
-
-@item
-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:
-
-@enumerate a
-@item
-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,
-
-@item
-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,
-
-@item
-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.)
-@end enumerate
-
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@iftex
-@heading NO WARRANTY
-@end iftex
-@ifinfo
-@center NO WARRANTY
-@end ifinfo
-
-@item
-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.
-
-@item
-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 enumerate
-
-@iftex
-@heading END OF TERMS AND CONDITIONS
-@end iftex
-@ifinfo
-@center END OF TERMS AND CONDITIONS
-@end ifinfo
-
-@page
-@unnumberedsec 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.
-
-@smallexample
-@var{one line to give the program's name and an idea of what it does.}
-Copyright (C) 19@var{yy}  @var{name of author}
-
-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., 675 Mass Ave, Cambridge, MA 02139, USA.
-@end smallexample
-
-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:
-
-@smallexample
-Gnomovision version 69, Copyright (C) 19@var{yy} @var{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.
-@end smallexample
-
-The hypothetical commands @samp{show w} and @samp{show c} should show
-the appropriate parts of the General Public License.  Of course, the
-commands you use may be called something other than @samp{show w} and
-@samp{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:
-
-@smallexample
-@group
-Yoyodyne, Inc., hereby disclaims all copyright
-interest in the program `Gnomovision'
-(which makes passes at compilers) written
-by James Hacker.
-
-@var{signature of Ty Coon}, 1 April 1989
-Ty Coon, President of Vice
-@end group
-@end smallexample
-
-This General Public License does not permit incorporating your program into
-proprietary programs.  If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library.  If this is what you want to do, use the GNU Library General
-Public License instead of this License.
-
diff --git a/xemacs-packages/man/edit-utils/tempo.texi b/xemacs-packages/man/edit-utils/tempo.texi
deleted file mode 100644
index ced39836..00000000
--- a/xemacs-packages/man/edit-utils/tempo.texi
+++ /dev/null
@@ -1,599 +0,0 @@
-\input texinfo        @c -*-texinfo-*-
-@c %**start of header
-@setfilename tempo.info
-@settitle Tempo manual
-@setchapternewpage odd
-@iftex
-@afourpaper
-@end iftex
-@c %**end of header
-
-@set EDITION 0.0(prerelease)
-@set VERSION 1.2.3
-@set UPDATED 8 June 1995
-@set UPDATED-MONTH June 1995
-
-@ifinfo
-This is Edition @value{EDITION},
-last updated @value{UPDATED},
-of @cite{the Tempo manual},
-for @code{tempo.el} version @value{VERSION}.
-
-Copyright @copyright{} 1995 David Kågedal
-     
-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.
-     
-@ignore
-Permission is granted to process this file through TeX and print the
-results, provided the printed document carries a copying permission
-notice identical to this one except for the removal of this paragraph
-(this paragraph not being relevant to the printed manual).
-     
-@end ignore
-Permission is granted to copy and distribute modified versions of this
-manual under the conditions for verbatim copying, provided also that the
-section entitled ``Copying''is included exactly as in the original, and
-provided that the entire resulting derived work is distributed under the
-terms of a permission notice identical to this one.
-     
-Permission is granted to copy and distribute translations of this manual
-into another language, under the above conditions for modified versions,
-except that this permission notice may be stated in a translation
-approved by the Free Software Foundation.
-@end ifinfo
-
-@titlepage
-@title Tempo
-@subtitle A template package for GNU Emacs
-@subtitle Edition @value{EDITION}
-@subtitle @value{UPDATED-MONTH}
-@author David K@aa{}gedal 
-
-@page
-@vskip 0pt plus 1filll
-
-Copyright @copyright{} 1995 David K@aa{}gedal
-
-This manual is availible on anonymous @code{ftp} from
-@file{ftp.lysator.liu.se}, in the directory @file{/pub/emacs}.
-
-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.
-     
-Permission is granted to copy and distribute modified versions of this
-manual under the conditions for verbatim copying, provided also that the
-section entitled ``Copying'' is included exactly as in the original, and
-provided that the entire resulting derived work is distributed under the
-terms of a permission notice identical to this one.
-     
-Permission is granted to copy and distribute translations of this manual
-into another language, under the above conditions for modified versions,
-except that this permission notice may be stated in a translation
-approved by the Free Software Foundation.
-@end titlepage
-
-@ifinfo
-@node Top, Overview, (dir), (dir)
-@top Tempo
-
-This is Edition @value{EDITION}, last updated @value{UPDATED}, of the
-manual for @code{tempo.el} version @value{VERSION}.
-
-Tempo is a template writing package for GNU Emacs.
-
-@menu
-* Overview::                    An overview of tempo
-* Templates::                   Templates
-* Options::                     Controlling tempo behaviour
-* The mark list::               The mark list
-* The save list::               The save list
-* Adding tempo::                Adding tempo support
-* Concept index::               Concept index
-* Function index::              Function index
-* Variable index::              Variable index
-* Copying::                     The terms of this distribution
-
- --- The Detailed Node Listing ---
-
-Overview
-
-* A short example::             Example
-* Basics::                      Tempo basics
-* Tags overview::               Tag lists and automatic completion
-
-Templates
-
-* Syntax::                      Template syntax
-* Elements::                    Template elements
-* Defining your own elements::  Defining your own elements
-@end menu
-
-@end ifinfo
-
-@node Overview, Templates, Top, Top
-@chapter Overview
-
-Tempo is a package that provides writers and users of Emacs editing
-modes with functions for creating and inserting templates into an Emacs
-buffer in a convenient way. The template insertion commands can be bound
-to keys or can be automatically expanded from words written in the
-buffer.
-
-@menu
-* A short example::             Example
-* Basics::                      Tempo basics
-* Tags overview::               Tag lists and automatic completion
-@end menu
-
-@node A short example, Basics, Overview, Overview
-@comment  node-name,  next,  previous,  up
-@section A short example
-
-A good way to get a general idea of what @code{tempo} is about is
-through an introductory example. The follwoing short example of a
-@code{tempo} template builds a template for inserting a for loop in a C
-program.
-
-@lisp
-(tempo-define-template "c-for"
-                       '("for ("
-                         (p "Initialization: ") ","
-                         (p "Increment: ") ","
-                         (p "End condition: ") " @{" n>
-                         r n>
-                         "@}" > %))
-@end lisp
-
-This creates a command @code{tempo-template-c-for} which, when executed,
-inserts the following at the point:
-
-@example
-for (@point{},,) @{
-    
-@}
-@end example
-
-The point is placed at the @point{}, which is not included in the
-text. The command @kbd{M-x tempo-forward-mark} will, at this point, move
-the point to after the first comma. Successive executions will move the
-point to after the second comma, to the second line and to after the
-closing brace. In a mode customized for tempo, @code{tempo-forward-mark}
-will of course be bound to some convenient keystroke combination.
-
-If the variable @code{tempo-interactive} was set to non-nil, the result
-would have been a little different. Instead of inserting nothing inside
-the parenthesis, the user would be prompted for the text to be written
-in the three positions, with the prompt strings @samp{Initialization:},
-@samp{Increment:} and @samp{End condition:}, respectively, and the point
-would be placed on the second line, properly indented.
-
-Also, if there was a currently active region (@pxref{Mark,Regions,The
-Mark and the Region,emacs,the GNU Emacs Manual}), and the template
-command was used with a prefix argument (such as @kbd{C-u M-x
-tempo-template-c-for}) the for loop would be inserted around the region,
-so that the contents of the region would be placed between the the
-opening and closing braces.
-
-@node Basics, Tags overview, A short example, Overview
-@section Tempo basics
-
-The most inportant function in tempo is @code{tempo-define-template},
-which defines a template, together with a function to insert
-it. @xref{Syntax}, for a complete description of this function.
-
-A simple definition has the form
-
-@lisp
-(tempo-define-template @var{name} @var{elements})
-@end lisp
-
-When this is evaluated, the variable @code{tempo-template-@var{name}} is
-bound to @var{elements}, and the function @code{tempo-template-@var{name}}
-is a command that will insert the template when invoked.
-
-The @var{elements} is supplied as a list whose elements have different
-meanings. Strings are simply inserted and lisp expressions are evaluated
-to strings. There are also some symbols with special meanings, such as:
-
-@table @code
-@item p
-@itemx (p @var{prompt} [@var{name}])
-The symbol @code{p} marks a ``hot spot'' in a template. When this is
-encountered, the current position of the point is saved as a marker and
-saved on the @code{tempo-marks} list. These marks can later easily be
-jumped to with the functions @code{tempo-forward-mark} and
-@code{tempo-backward-mark}.
-
-If the form @code{(p @var{prompt})} is used, and the variable
-@code{tempo-interactive} is non-@code{nil}, @var{prompt} is used to
-prompt the user for a string in the minibuffer. If
-@code{tempo-interactive} is @code{nil}, it works just like a single
-@code{p}.
-
-@item r
-@itemx (r @var{prompt})
-This works very much like @code{p}, but when the template was invoked
-with a prefix (as with @kbd{C-u @var{template-cmd}}) and a region is
-active, the template will be wrapped around the region, so that the text
-of the region is placed where the @code{r} element is.
-
-@item >
-A greater-than sign in a template means that the current line should be
-indented according to the current mode. The function @code{indent-line}
-is called, which usually gives the desired result. not that often it is
-advisable to insert the @code{>} after the text to be put on the line,
-to help the indention function.
-
-@end table
-
-There are many more thing you can put in a template, but the above are
-some of the more essential. @xref{Elements}, for a full description of the
-possible template elements.
-
-@node Tags overview,  , Basics, Overview
-@section Tag lists and automatic completion
-
-If you supply a third argument @var{tag} to
-@code{tempo-define-template}, it can be used as an abbrevation for the
-template. If you gave the C for-loop in the example above a third
-argument @code{"for"}, you could use the completion capabilities in
-tempo. If you write in a buffer (with the point at @point{}):
-
-@example
-for@point{}
-@end example
-
-and type @kbd{M-x tempo-complete-tag}, the string @samp{foo} would be
-replaced by the for-loop template. For this to be really useful,
-@code{tempo-complete-tag} should be bound to a convenient keystroke. But
-there is more power in this command. If you have defined a template with
-the tag @samp{procedure} you can hit @kbd{M-x tempo-complete-tag} as
-soon as you have written a unique prefix of the word. For example
-
-@example
-proc@point{}
-@end example
-
-could expand to
-
-@example
-procedure @point{}();
-begin
-
-end;
-@end example
-
-when you type @kbd{M-x tempo-complete-tag} had you defined a Pascal
-@code{procedure} template with the tag @samp{procedure}. If there is no
-unique match, @code{tempo-complete-tag} will complete the tag as much as
-possible, and show a buffer with the possible completions. You can then
-type another character, which will hopefully make it unique and press
-@kbd{M-x tempo-complete-tag} again.
-
-Unfortunaly, there is no good way to use the mouse in the completion
-buffer, although it claims to be so.
-
-@node Templates, Options, Overview, Top
-@chapter Templates
-
-@iftex
-This chapter describes the syntax and semantics of templates defined by
-@code{tempo-define-template}. The first section deals with the syntax of
-the function itself, while the second section describes the different
-template elements.
-@end iftex
-
-@ifinfo
-This node describes the syntax and semantics of templates defined by
-@code{tempo-define-template}. The first part deals with the syntax of
-the function itself, while the second part describes the different
-template elements.
-@end ifinfo
-
-@menu
-* Syntax::                      Template syntax
-* Elements::                    Template elements
-* Defining your own elements::  Defining your own elements
-@end menu
-
-@node Syntax, Elements, Templates, Templates
-@section Template syntax
-@cindex Defining new templates
-@cindex Writing templates
-@cindex Templates
-
-Templates are defined with the function @code{tempo-define-tempalate}.
-
-@defun tempo-define-template name elements [tag documentation [taglist]]]
-Define a template named @code{tempo-template-@var{name}}.
-
-This function creates a template and binds it to a new variable named
-@code{tempo-template-@var{name}}. It also creates a new command under
-the same name. This command expands the template at the current point,
-when invoked.
-
-The parameter @var{elements} is a list of template elements. The
-possible elements are described in @ref{Elements}.
-
-If a @var{tag} is supplied, it must be a string which is placed in
-@var{taglist} or @code{tempo-tags}. This string is used for automatic
-completion. When @code{tempo-complete-tag} is called and @var{tag} is
-matched, the template template defined with @var{tag} is
-inserted. (@pxref{Tags overview} for more information on tags and tag
-lists)
-@end defun
-
-@node Elements, Defining your own elements, Syntax, Templates
-@section Template elements
-@cindex Elements
-@cindex Template elements
-
-These are the predefined elements you can use in a template definition:
-
-@table @code
-@item @var{STRING}
-A string in a template is first run through the string preprocessors in
-@code{tempo-insert-string-functions} and the result is inserted.
-
-@item p
-This denotes an ``interesting'' position in the template. When the
-template is expanded, this position is remembered with a mark on the
-tempo-marks list. @xref{The mark list}.
-
-@item r
-This works in a similar way to the above @code{p} element, but if the
-template command is given a prefix command, the current region is placed
-here. This means that the preceding part of the template is expanded
-before the region, and the rest is expanded after. There can be only one
-@code{r} in a template. If @code{transient-mark-mode} is active
-(@pxref{Mark,Regions,The Mark and the Region,emacs,the GNU Emacs
-Manual}) the current region is used and the prefix argument is ignored.
-
-If the variable @code{tempo-insert-region} is non-nil, the behaviour of
-the @code{r} element is reversed.
-
-@item (p @var{prompt} [@var{name} [@var{noinsert}]])
-@itemx (P @var{prompt} [@var{name} [@var{noinsert}]])
-@itemx (r @var{prompt} [@var{name} [@var{noinsert}]])
-If the variable @code{tempo-interactive} is nil, the elements @code{(p
-@dots{}))} and @code{(P @dots{})} work exactly like a single @code{p},
-and @code{(r @dots{})} works like a single @code{r}.
-
-But, if you set @code{tempo-interactive} to @code{t} the user is
-prompted for a string to insert when the template is expanded. The
-prompt is taken from the @code{prompt} parameter. The element @code{(P
-@dots{})} works like @code{(p @dots{})} with the exception that
-@code{tempo-interactive} is forced to @code{t}, which means that the
-user will always (almost always, see below) be prompted.
-
-If you provide a @var{name} to any of these, and interactive prompting
-is taking place, the resulting string is saved in a local list so it can
-be inserted again later with the @code{(s @dots{})} element. @xref{The
-save list}, for more detailed information.
-
-As a special case, if the save list already contains something under
-@var{name}, it is used directly, and no prompting is done, even with a
-@code{(P @dots{})} element.
-
-The third argument, @var{noinsert}, disables insertion of text. If
-@code{tempo-interactive} it non-@code{nil}, and a @var{name} has been
-provided, normally a string is read through the minibuffer and then
-inserted and saved. When @var{noinsert} is non-@code{nil}, nothing is
-inserted, and the text is only saved for later.
-
-@ignore
-@item (v @var{name} @var{prompt})
-This element simply prompts for a string and saves it as @var{name}. The
-prompt is taken from @var{prompt}. Nothing is inserted.
-@end ignore
-
-Stylistic conventions (invented by me) dictates that these elements
-should be placed as early as possible in template definitions.
-
-@item r>
-This element works like @code{r}, but it also indents the region it is
-expanded around.
-
-@item (s @var{name})
-This looks up @var{name} in the save list and inserts what it
-finds. Note that if it finds a string, it is not run through the string
-preprocessors.
-
-@item &
-An ampersand inserts a newline if there are characters other than
-whitespace before the current point on the line. Otherwise it does
-nothing. This means that it makes sure that the following text always
-starts a new line, possibly with some leading whitespace.
-
-@item %
-A percent sign inserts a newline it there are characters other than
-whitespace after the current point on the line. Otherwise it does
-nothing.
-
-@item n
-Simply inserts a newline character.
-
-@item >
-This does not insert any text. Instead it indents the line according to
-the major mode, by calling @code{indent-according-to-mode}. Note that in
-order to get best results, you often should place this after the text
-you want to place on the line, as this could affect the indentation.
-
-@item n>
-Inserts a newline and indents line. It is the same as a @code{n}
-followed by a @code{>}.
-
-@item o
-Works like @code{%}, but leaves the point on the first line. Note that
-this can cause great confusion if you are not careful. If the @code{o}
-is the first element in a template which is inserted at the beginning of
-a line, strange things happen. This is due to odd behaviour in
-@code{open-line}.
-
-@item nil
-A @code{nil} element is simply igonred. That means that a lisp
-expression (see below) that returns nil does not insert anything.
-
-@item (l @var{element1} @var{element2}@dots{})
-This element is most useful as a return value from a lisp expression
-(see below). It inserts the elements using the same rules as all
-template elements.
-
-@item @i{Anything else}
-All unrecognized elements are checked to see if it is a user-defined
-elemet. @xref{Defining your own elements}. If isn't, it is assumed to be
-a lisp expression and is evaluated in a normal fashion. The result from
-such an expression is taken as a template element an is inserted
-according to the usual rules. If you don't want to insert anything, make
-your expression return @code{nil}. If you want to insert more than one
-element, use the @code{(l @var{element1} @var{element2}@dots{})}
-element.
-
-@end table
-
-@node Defining your own elements,  , Elements, Templates
-@section Defining your own elements
-@cindex Defining elements
-@cindex User-defined elements
-@cindex Adding elements
-
-The variable @code{tempo-user-elements} contains a list of functions to
-call when an unrecognized element is found.
-
-@defvar tempo-user-elements
-A list of functions. When @code{tempo-insert} is called with an element
-it doesn't recognize, it checks this list by calling each function with
-the element as the single argument. A function in this list should take
-a single element as argument and return @code{nil} for elements it
-doesn't recognize. If it does recognize an element, it should return
-another element to be inserted, e.g. a string. If the function wants to
-return an authorative @code{nil}, it could return either @code{""} or
-@code{(l)}.
-@end defvar
-
-Do not use any one-charachter tags for your own elements. These are
-reserved for future tempo enhancements.
-
-@node Options, The mark list, Templates, Top
-@chapter Controlling tempo behaviour
-@cindex Customization
-@cindex User options
-
-There are some options available for the end user of tempo templates.
-
-@defopt tempo-interactive
-Controls whether templates should prompt the user for strings to insert
-via the minibuffer or let the user edit them in place. This affects the
-behaviour of the template elements @code{(p @dots{})} and @code{(r
-@dots{})}.
-@end defopt
-
-@defopt tempo-insert-region
-Controls the behaviour of the @code{r}, @code{r>} and @code{(r @dots{})}
-tags. If this variable is @code{nil}, @code{r} elements will be treated
-just like @code{p} elements, unless the template command is given a
-prefix (or a non-nil argument), in which case the template will be
-inserted around the region. @xref{Elements}, for further information. If
-this variable is non-@code{nil}, the behaviour is reversed.
-
-In Transient Mark mode, this option is unused.
-@end defopt
-
-
-@node The mark list, The save list, Options, Top
-@chapter The mark list
-
-When a @code{p} or @code{r} element is inserted, or when
-@code{tempo-interactive} is nil and a @code{(p @dots{})}, @code{(P
-@dots{})} or @code{(r @dots{})} element is inserted, the current
-position in the buffer is remembered for later. A mark is created and
-stored in the variable @code{tepo-marks}.
-
-There are two functions for moving between these marks.
-
-@defun tempo-forward-mark
-Move the point to the first mark on the mark list that is after the
-point. If there is no such mark, nothing happens.
-@end defun
-
-@defun tempo-backward-mark
-Move the point to the last mark on the mark lit that is before the
-point. If there is no such mark, nothing happens.
-@end defun
-
-This function adds marks to the mark list.
-
-@defun tempo-insert-mark mark
-Inserts @var{mark} in the mark list, while keeping the list sorted. If
-there already is a mark at the same position, only one mark is kept.
-@end defun
-
-@node The save list, Adding tempo, The mark list, Top
-@chapter The save list
-
-In a template, different elements can be saved for later with the
-function @code{tempo-save-named} on a data structure called the
-@dfn{save list}. The most obvious way to do this, is to supply a
-@var{name} argument to the @code{(p @dots{})} element or one of its
-likes, but it can also be done programmatically with an explicit call to
-@code{tempo-save-named}.
-
-@vindex tempo-named-insertions
-Every saved element is saved in the list
-@code{tempo-named-insertions}. After inserting a template, this list is
-cleared, so things saved in it does not live between insertions. You
-should use ordinary variables for that.
-
-The following two functions could be used from inside a template.
-
-@defun tempo-save-named name data
-Save @var{data} on the save list under the name @var{name}. The function
-returns nil.
-@end defun
-
-@defun tempo-lookup-named name
-Lookup some saved data under the name @var{name}.  Returns the data if
-@var{name} was found, and @code{nil} otherwise.
-@end defun
-
-The following functions deal with the save list, but should be
-considered internal to tempo.
-
-@defun tempo-insert-named name
-Insert the previous insertion saved under a named specified in
-@var{name}.  If there is no such name saved, a tempo mark is inserted.
-
-Note that if the data is a string, it will not be run through the string
-processor.
-@end defun
-
-@defun tempo-forget-insertions
-Clears the save list.
-@end defun
-
-@node Adding tempo, Concept index, The save list, Top
-@chapter Adding tempo support
-
-@node Concept index, Function index, Adding tempo, Top
-@chapter Concept index
-
-@printindex cp
-
-@node Function index, Variable index, Concept index, Top
-@chapter Function index
-
-@printindex fn
-
-@node Variable index, Copying, Function index, Top
-@chapter Variable index
-
-@printindex vr
-
-@node Copying,  , Variable index, Top
-@chapter Copying
-
-@contents
-@bye
diff --git a/xemacs-packages/man/mail-lib/smtpmail.texi b/xemacs-packages/man/mail-lib/smtpmail.texi
deleted file mode 100644
index 26fd77ea..00000000
--- a/xemacs-packages/man/mail-lib/smtpmail.texi
+++ /dev/null
@@ -1,412 +0,0 @@
-\input texinfo  @c -*-texinfo-*-
-@setfilename ../info/smtpmail
-@settitle Emacs SMTP Library
-@syncodeindex vr fn
-@copying
-Copyright @copyright{} 2003, 2004 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU Manual'',
-and with the Back-Cover Texts as in (a) below.  A copy of the license
-is included in the section entitled ``GNU Free Documentation License''
-in the Emacs manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software.  Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License.  If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-@end quotation
-@end copying
-
-@dircategory Emacs
-@direntry
-* SMTP: (smtpmail). Emacs library for sending mail via SMTP.
-@end direntry
-
-@titlepage
-@title{Emacs SMTP Library}
-@subtitle{An Emacs package for sending mail via SMTP}
-@author{Simon Josefsson, Alex Schroeder}
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-@contents
-
-@ifnottex
-@node Top
-@top Emacs SMTP Library
-
-@insertcopying
-@end ifnottex
-
-@menu
-* How Mail Works::	Brief introduction to mail concepts.
-* Emacs Speaks SMTP::   How to use the SMTP library in Emacs.
-* Authentication::	Authenticating yourself to the server.
-* Queued delivery::	Sending mail without an internet connection.
-* Server workarounds::	Mail servers with special requirements.
-* Debugging::		Tracking down problems.
-
-Indices
-
-* Index::		Index over variables and functions.
-@end menu
-
-@node How Mail Works
-@chapter How Mail Works
-
-@cindex SMTP
-@cindex MTA
-   On the internet, mail is sent from mail host to mail host using the
-simple mail transfer protocol (SMTP).  To send and receive mail, you
-must get it from and send it to a mail host.  Every mail host runs a
-mail transfer agent (MTA) such as Exim that accepts mails and passes
-them on.  The communication between a mail host and other clients does
-not necessarily involve SMTP, however.  Here is short overview of what
-is involved.
-
-@cindex MUA
-   The mail program --- also called a mail user agent (MUA) ---
-usually sends outgoing mail to a mail host.  When your computer is
-permanently connected to the internet, it might even be a mail host
-itself.  In this case, the MUA will pipe mail to the
-@file{/usr/lib/sendmail} application.  It will take care of your mail
-and pass it on to the next mail host.
-
-@cindex ISP
-   When you are only connected to the internet from time to time, your
-internet service provider (ISP) has probably told you which mail host
-to use.  You must configure your MUA to use that mail host.  Since you
-are reading this manual, you probably want to configure Emacs to use
-SMTP to send mail to that mail host.  More on that in the next
-section.
-
-@cindex MDA
-   Things are different when reading mail.  The mail host responsible
-for your mail keeps it in a file somewhere.  The messages get into the
-file by way of a mail delivery agent (MDA) such as procmail.  These
-delivery agents often allow you to filter and munge your mails before
-you get to see it.  When your computer is that mail host, this file is
-called a spool, and sometimes located in the directory
-@file{/var/spool/mail/}.  All your MUA has to do is read mail from the
-spool, then.
-
-@cindex POP3
-@cindex IMAP
-   When your computer is not always connected to the internet, you
-must get the mail from the remote mail host using a protocol such as
-POP3 or IMAP.  POP3 essentially downloads all your mail from the mail
-host to your computer.  The mail is stored in some file on your
-computer, and again, all your MUA has to do is read mail from the
-spool.
-
-   When you read mail from various machines, downloading mail from the
-mail host to your current machine is not convenient.  In that case,
-you will probably want to use the IMAP protocol.  Your mail is kept on
-the mail host, and you can read it while you are connected via IMAP to
-the mail host.
-
-@cindex Webmail
-   So how does reading mail via the web work, you ask.  In that case,
-the web interface just allows you to remote-control a MUA on the web
-host.  Whether the web host is also a mail host, and how all the
-pieces interact is completely irrelevant.  You usually cannot use
-Emacs to read mail via the web, unless you use software that parses
-the ever-changing HTML of the web interface.
-
-@node Emacs Speaks SMTP
-@chapter Emacs Speaks SMTP
-
-   Emacs includes a package for sending your mail to a SMTP server and
-have it take care of delivering it to the final destination, rather
-than letting the MTA on your local system take care of it.  This can
-be useful if you don't have a MTA set up on your host, or if your
-machine is often disconnected from the internet.
-
-  Sending mail via SMTP requires configuring your mail user agent
-(@pxref{Mail Methods,,,emacs}) to use the SMTP library.  How to do
-this should be described for each mail user agent; for the default
-mail user agent the variable @code{send-mail-function} (@pxref{Mail
-Sending,,,emacs}) is used; for the Message and Gnus user agents the
-variable @code{message-send-mail-function} (@pxref{Mail
-Variables,,,message}) is used.
-
-@example
-;; If you use the default mail user agent.
-(setq send-mail-function 'smtpmail-send-it)
-;; If you use Message or Gnus.
-(setq message-send-mail-function 'smtpmail-send-it)
-@end example
-
-  Before using SMTP you must find out the hostname of the SMTP server
-to use.  Your system administrator should provide you with this
-information, but often it is the same as the server you receive mail
-from.
-
-@table @code
-@item smtpmail-smtp-server
-@vindex smtpmail-smtp-server
-@vindex SMTPSERVER
-  The variable @code{smtpmail-smtp-server} controls the hostname of
-the server to use.  It is a string with an IP address or hostname.  It
-defaults to the contents of the @env{SMTPSERVER} environment
-variable, or, if empty, the contents of
-@code{smtpmail-default-smtp-server}.
-
-@item smtpmail-default-smtp-server
-@vindex smtpmail-default-smtp-server
-  The variable @code{smtpmail-default-smtp-server} controls the
-default hostname of the server to use.  It is a string with an IP
-address or hostname.  It must be set before the SMTP library is
-loaded.  It has no effect if set after the SMTP library has been
-loaded, or if @code{smtpmail-smtp-server} is defined.  It is usually
-set by system administrators in a site wide initialization file.
-@end table
-
-The following example illustrates what you could put in
-@file{~/.emacs} to set the SMTP server name.
-
-@example
-;; Send mail using SMTP via mail.example.org.
-(setq smtpmail-smtp-server "mail.example.org")
-@end example
-
-@cindex Mail Submission
-SMTP is normally used on the registered ``smtp'' TCP service port 25.
-Some environments use SMTP in ``Mail Submission'' mode, which uses
-port 587.  Using other ports is not uncommon, either for security by
-obscurity purposes, port forwarding, or otherwise.
-
-@table @code
-@item smtpmail-smtp-service
-@vindex smtpmail-smtp-service
-  The variable @code{smtpmail-smtp-service} controls the port on the
-server to contact.  It is either a string, in which case it will be
-translated into an integer using system calls, or an integer.
-@end table
-
-The following example illustrates what you could put in
-@file{~/.emacs} to set the SMTP service port.
-
-@example
-;; Send mail using SMTP on the mail submission port 587.
-(setq smtpmail-smtp-service 587)
-@end example
-
-@node Authentication
-@chapter Authentication
-
-@cindex SASL
-@cindex CRAM-MD5
-@cindex LOGIN
-@cindex STARTTLS
-Many environments require SMTP clients to authenticate themselves
-before they are allowed to route mail via a server.  The two following
-variables contains the authentication information needed for this.
-The first variable, @code{smtpmail-auth-credentials}, instructs the
-SMTP library to use a SASL authentication step, currently only the
-CRAM-MD5 and LOGIN mechanisms are supported and will be selected in
-that order if the server support both.
-
-The second variable, @code{smtpmail-starttls-credentials}, instructs
-the SMTP library to connect to the server using STARTTLS.  This means
-the protocol exchange may be integrity protected and confidential by
-using TLS, and optionally also authentication of the client.  This
-feature uses the elisp package @file{starttls.el} (see it for more
-information on customization), which in turn require that at least one
-of the following external tools are installed:
-
-@enumerate
-@item
-The GNUTLS command line tool @samp{gnutls-cli}, you can get it from
-@url{http://www.gnu.org/software/gnutls/}.  This is the recommended
-tool, mainly because it can verify the server certificates.
-
-@item
-The @samp{starttls} external program, you can get it from
-@file{starttls-*.tar.gz} from @uref{ftp://ftp.opaopa.org/pub/elisp/}.
-@end enumerate
-
-It is not uncommon to use both these mechanisms, e.g., to use STARTTLS
-to achieve integrity and confidentiality and then use SASL for client
-authentication.
-
-@table @code
-@item smtpmail-auth-credentials
-@vindex smtpmail-auth-credentials
-  The variable @code{smtpmail-auth-credentials} contains a list of
-hostname, port, username and password tuples.  When the SMTP library
-connects to a host on a certain port, this variable is searched to
-find a matching entry for that hostname and port.  If an entry is
-found, the authentication process is invoked and the credentials are
-used.
-
-The hostname field follows the same format as
-@code{smtpmail-smtp-server} (i.e., a string) and the port field the
-same format as @code{smtpmail-smtp-service} (i.e., a string or an
-integer).  The username and password fields, which either can be
-@code{nil} to indicate that the user is prompted for the value
-interactively, should be strings with the username and password,
-respectively, information that is normally provided by system
-administrators.
-
-@item smtpmail-starttls-credentials
-@vindex smtpmail-starttls-credentials
-  The variable @code{smtpmail-starttls-credentials} contains a list of
-tuples with hostname, port, name of file containing client key, and
-name of file containing client certificate.  The processing is similar
-to the previous variable.  The client key and certificate may be
-@code{nil} if you do not wish to use client authentication.
-@end table
-
-The following example illustrates what you could put in
-@file{~/.emacs} to enable both SASL authentication and STARTTLS.  The
-server name (@code{smtpmail-smtp-server}) is @var{hostname}, the
-server port (@code{smtpmail-smtp-service}) is @var{port}, and the
-username and password are @var{username} and @var{password}
-respectively.
-
-@example
-;; Authenticate using this username and password against my server.
-(setq smtpmail-auth-credentials
-      '(("@var{hostname}" "@var{port}" "@var{username}" "@var{password}")))
-
-;; Note that if @var{port} is an integer, you must not quote it as a
-;; string.  Normally @var{port} should be the integer 25, and the example
-;; become:
-(setq smtpmail-auth-credentials
-      '(("@var{hostname}" 25 "@var{username}" "@var{password}")))
-
-;; Use STARTTLS without authentication against the server.
-(setq smtpmail-starttls-credentials
-      '(("@var{hostname}" "@var{port}" nil nil)))
-@end example
-
-@node Queued delivery
-@chapter Queued delivery
-
-@cindex Dialup connection
-If you connect to the internet via a dialup connection, or for some
-other reason don't have permanent internet connection, sending mail
-will fail when you are not connected.  The SMTP library implements
-queued delivery, and the following variable control its behaviour.
-
-@table @code
-@item smtpmail-queue-mail
-@vindex smtpmail-queue-mail
-  The variable @code{smtpmail-queue-mail} controls whether a simple
-off line mail sender is active.  This variable is a boolean, and
-defaults to @code{nil} (disabled).  If this is non-@code{nil}, mail is
-not sent immediately but rather queued in the directory
-@code{smtpmail-queue-dir} and can be later sent manually by invoking
-@code{smtpmail-send-queued-mail} (typically when you connect to the
-internet).
-
-@item smtpmail-queue-dir
-@vindex smtpmail-queue-dir
-  The variable @code{smtpmail-queue-dir} specifies the name of the
-directory to hold queued messages.  It defaults to
-@file{~/Mail/queued-mail/}.
-@end table
-
-@findex smtpmail-send-queued-mail
-  The function @code{smtpmail-send-queued-mail} can be used to send
-any queued mail when @code{smtpmail-queue-mail} is enabled.  It is
-typically invoked interactively with @kbd{M-x
-smtpmail-send-queued-mail RET} when you are connected to the internet.
-
-@node Server workarounds
-@chapter Server workarounds
-
-Some SMTP servers have special requirements.  The following variables
-implement support for common requirements.
-
-@table @code
-
-@item smtpmail-local-domain
-@vindex smtpmail-local-domain
-  The variable @code{smtpmail-local-domain} controls the hostname sent
-in the first @code{EHLO} or @code{HELO} command sent to the server.
-It should only be set if the @code{system-name} function returns a
-name that isn't accepted by the server.  Do not set this variable
-unless your server complains.
-
-@item smtpmail-sendto-domain
-@vindex smtpmail-sendto-domain
-  The variable @code{smtpmail-sendto-domain} makes the SMTP library
-add @samp{@@} and the specified value to recipients specified in the
-message when they are sent using the @code{RCPT TO} command.  Some
-configurations of sendmail requires this behaviour.  Don't bother to
-set this unless you have get an error like:
-
-@example
-	Sending failed; SMTP protocol error
-@end example
-
-when sending mail, and the debug buffer (@pxref{Debugging})) contains
-an error such as:
-
-@example
-	RCPT TO: @var{someone}
-	501 @var{someone}: recipient address must contain a domain
-@end example
-
-@end table
-
-
-@node Debugging
-@chapter Debugging
-
-Sometimes delivery fails, often with the generic error message
-@samp{Sending failed; SMTP protocol error}.  Enabling one or both of
-the following variables and inspecting a trace buffer will often give
-clues to the reason for the error.
-
-@table @code
-
-@item smtpmail-debug-info
-@vindex smtpmail-debug-info
-  The variable @code{smtpmail-debug-info} controls whether to print
-the SMTP protocol exchange in the minibuffer, and retain the entire
-exchange in a buffer @samp{*trace of SMTP session to @var{server}*},
-where @var{server} is the name of the mail server to which you send
-mail.
-
-@item smtpmail-debug-verb
-@vindex smtpmail-debug-verb
-  The variable @code{smtpmail-debug-verb} controls whether to send the
-@code{VERB} token to the server.  The @code{VERB} server instructs the
-server to be more verbose, and often also to attempt final delivery
-while your SMTP session is still running.  It is usually only useful
-together with @code{smtpmail-debug-info}.  Note that this may cause
-mail delivery to take considerable time if the final destination
-cannot accept mail.
-
-@end table
-
-@node Index
-@chapter Index
-
-@section Concept Index
-
-@printindex cp
-
-@section Function and Variable Index
-
-@printindex fn
-
-@contents
-@bye
-
-@ignore
-   arch-tag: 6316abdf-b366-4562-87a2-f37e8f894b6f
-@end ignore
diff --git a/xemacs-packages/man/os-utils/os-utils.texi b/xemacs-packages/man/os-utils/os-utils.texi
deleted file mode 100644
index 198b3278..00000000
--- a/xemacs-packages/man/os-utils/os-utils.texi
+++ /dev/null
@@ -1,826 +0,0 @@
-@c -*-texinfo-*-
-@c
-@c Copyright (C) 2002, 2003 Free Software Foundation, Inc.
-@c Copyright (C) 2003 Jake Colman
-@c
-@c @setfilename os-utils.info
-@settitle Operating System Utilities for XEmacs
-@ifinfo
-@dircategory XEmacs Editor
-@direntry
-* OS Utilities: (os-utils).	Operating System Utilities for XEmacs.
-@end direntry
-@end ifinfo
-
-@copying
-This manual is part of XEmacs.
-
-XEmacs 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.
-
-XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-@end copying
-
-@node Top, Copying, (dir), (dir)
-@chapter The Operating System Utilities Package
-
-@ifinfo
-This Info file contains the manual for the Operating System Utilities package.
-@end ifinfo
-
-The node name for each entry in the menu is the name of the elisp file
-containing the code that implements the functionality described.  It is
-highly recommended that you briefly peruse the elisp source code since it can
-provide valuable information on usage and technique.  This can easily be done
-by typing @code{C-x 4 l  RET} where  is the name of the
-elisp file to be loaded.
-
-@menu
-* Copying::                     Why this manual is GPL, and what that means
-
-Archive Management
-* tar-mode::                    Simple Editing of TAR Files
-* arc-mode::                    Simple Editing of Archives
-
-Compression/Decompression
-* crypt::                       Handling for Compressed and Encrypted Files
-* jka-compr::                   Reading/Writing/Loading Compressed Files
-* uncompress::                  Auto-Decompression Hook for Visiting .Z Files
-
-Communications
-* telnet::                      Execute a Telnet Session From Within an Emacs Buffer
-* ssh::                         Remote Login Interface Using SSH
-* ftelnet::                     Remote Login Interface Using Telnet
-* rlogin::                      Remote Login Interface Using rlogin
-* mchat::                       Multicast Chatting
-* kermit::                      Using Shell Mode With Kermit
-* terminal::                    Terminal Emulator
-
-Miscellaneous
-* spell::                       Spelling Correction
-* background::                  Fun With Background Jobs
-* inf-lisp::                    Inferior-Lisp Mode
-* ledit::                       ledit
-
-Appendices:
-* XEmacs License::              The GNU General Public License
-@end menu
-
-@node Copying, tar-mode, Top, Top
-@chapter Copying
-
-This document may be redistributed, verbatim or in modified form, under
-the terms of the GNU General Public License, version 2 or any later
-version.  The same terms apply to the libraries it documents.  A copy
-of the General Public License is provided as an Appendix.
-
-Most XEmacs documentation has its own license, which is an ancestor of
-the GNU Free Documentation License (@dfn{FDL}), and whose terms are
-quite similar to those imposed by GNU on Emacs documentation.  Why is
-this manual licensed differently (under the GNU General Public License,
-or @dfn{GPL}), and why does it have to be distributed separately from
-the XEmacs User's Guide and the XEmacs Lisp Reference Manual?
-
-Taking the second question first, XEmacs is @dfn{community-owned}
-software.  That is, unlike GNU Emacs, there is no monopoly copyright
-holder.  Many of us, including the original Lucid authors, have
-contributed our copyrights to the Free Software Foundation (FSF), and of
-course much content is derived from GNU Emacs, and therefore is held by
-the FSF.  Another large chunk is held by Sun Microsystems, and a few
-individual authors hold copyright to thousands of lines each.  But many
-individuals hold copyright to only a few dozen lines.  Like the Linux
-kernel, copyright ownership is distributed throughout a community.
-
-However, its license is ``copyleft,'' @emph{i.e.}, it @emph{requires}
-that you redistribute it under terms @emph{identical} to those under
-which you received it, unless you have explicit permission of the
-copyright holder.  Because of the multiple owners, determining the
-ownership of any given part of XEmacs is tedious, and perhaps
-impossible.  For practical purposes, then, the license of any
-substantial chunk of existing XEmacs content cannot be changed, except
-to a later version of the GPL, for those parts under GPL.  (That is due
-to the @emph{explicit} permission to change to a later version of the
-GPL, present in every file of XEmacs.)
-
-Unfortunately, this severe restriction means that the GPL, FDL, and the
-XEmacs documentation license (@dfn{XDL}) are @emph{mutually
-incompatible}.  That is, content licensed under any of the GPL, FDL, or
-XDL @emph{may not} be mixed with content licensed under either of the
-other two without changing the license of some of the content.  But this
-requires permission of the copyright holder, which is often difficult or
-impossible to get.
-
-For example, you @emph{may not} take comments or docstrings from XEmacs
-code and add them to the Lispref to mend a gap in the latter's coverage.
-You @emph{may not} copy text from the Lispref into docstrings in the
-code.  And you @emph{may not} copy text from the GNU Emacs Lisp
-Reference to the XEmacs Lisp Reference Manual.  (In this case it is at
-least trivial to ask permission, although it is rather unclear whether
-it would be granted.)
-
-In fact, parts of this document were derived by copying from XEmacs code
-under the GPL, without any further permission from the authors.  Thus,
-this document must be distributed under the GPL, as a ``volume''
-separate from the XEmacs documentation under the XDL.  Note that the
-``mere aggregation'' clauses allow us to distribute in the same
-tarball.  But incorporating it as a node in the Lispref is prohibited,
-even if done by inclusion.
-
-A bit of advocacy:
-
-If you look carefully at the additional restrictions imposed by the
-soi-disant "free" documentation licenses, you discover that they are
-simply proprietary restrictions guaranteeing a certain amount of
-@emph{unpaid} political advertising to the Free Software Foundation and
-GNU Project (and in the case of the FDL, this is extended to commercial
-advertising by authors of original or derived works).  Whether this is
-``ethically justified'' or not is a difficult question.  What is certain
-is that there is little social benefit to these terms (since the license
-documents themselves contain the advocacy and must be included with any
-distribution).
-
-I conclude it makes sense for XEmacs to reduce its restrictions, where
-possible, to the ``least common denominator,'' the GNU General Public
-License.
-
-@node tar-mode, arc-mode, Copying, Top
-@chapter Simple Editing of TAR Files
-
-This package attempts to make dealing with Unix 'tar' archives easier.  When
-this code is loaded, visiting a file whose name ends in '.tar' will cause the
-contents of that archive file to be displayed in a Dired-like listing.  It is
-then possible to use the customary Dired keybindings to extract sub-files
-from that archive, either by reading them into their own editor buffers, or
-by copying them directly to arbitrary files on disk.  It is also possible to
-delete sub-files from within the tar file and write the modified archive back
-to disk, or to edit sub-files within the archive and re-insert the modified
-files into the archive.  See the documentation string of @code{tar-mode} for
-more info.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET tar RET
-@end example
-
-@node arc-mode, crypt, tar-mode, Top
-@chapter Simple Editing of Archives
-
-This library not documented.  Please contribute!
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET archive RET
-@end example
-
-@node crypt, jka-compr, arc-mode, Top
-@chapter Handling for Compressed and Encrypted Files
-
-The basic purpose of this package of Lisp functions is to recognize
-automatically encrypted and encoded (i.e., compressed) files when they are
-first visited or written.  The BUFFER corresponding to the file is decoded
-and/or decrypted before it is presented to the user.  The file itself is
-unchanged on the disk.  When the buffer is subsequently saved to disk, a hook
-function re-encodes the buffer before the actual disk write takes place.
-
-This package recognizes all sorts of compressed files by a magic number at
-the beginning of these files but uses a heuristic to detect encrypted files.
-If you are asked for an encryption key for a file that is in fact not
-encrypted, just hit RET and the file will be accepted as is, and the crypt
-minor mode will not be entered.
-
-Other types of encoding programs may be added to this package by using the
-variable @code{crypt-encoding-alist} which contains a table of encoding
-programs such as @code{compress}, @code{gzip} (GNU zip), @code{freeze}, and
-@code{compact}.
-
-This new extended version of crypt now monitors the filename extensions of
-buffers that are written out using @code{write-file} (@kbd{C-x C-w}).  If the
-filename extension matches one of the extensions listed in
-@code{crypt-encoding-alist}, then this package will write the file out using
-the corresponding encoding (compression) method. This is done whether or not
-the buffer originated from a previously encoded (compressed) file.
-
-Thus, if the user is editing a file that may or may not have been encoded
-originally (e.g., @file{foobar.Z} or @file{foobar}) and decides to write it
-to a different file (e.g., @file{barfoo} or @file{barfoo.z} or
-@file{barfoo.C}).  This package will examine the filename extension and write
-the buffer in plain format or an alternate encoding (compression) format by
-searching through the entries in the table of encoding methods
-@code{crypt-encoding-alist}.  This change in encoding state is done
-automatically if the variable @code{crypt-auto-write-buffer} is t otherwise
-the user is asked.
-
-To use this package, put the line @code{(require 'crypt)} in your
-initialization file.  Do not bother trying to autoload this file; this
-package uses @code{find-file} and @code{write-file} hooks and thus should be
-loaded the first time you visit any sort of file.  Any package loaded after
-this one that appends something to @code{write-file-hooks} will not be
-executed because this package writes out the file.  Other packages that
-append to @code{write-file-hooks} should either be modified to prepend to
-that hook or be loaded before this one (preferably the former).
-
-NOTE: encryption users should set @code{crypt-encryption-type} to one of the
-values in @code{crypt-encryption-alist}.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET compression RET
-@end example
-
-@node jka-compr, uncompress, crypt, Top
-@chapter Reading/Writing/Loading Compressed Files
-
-This package implements low-level support for reading, writing, and loading
-compressed files.  It hooks into the low-level file I/O functions (including
-@code{write-region} and @code{insert-file-contents}) so that they
-automatically compress or uncompress a file if the file appears to need it
-(based on the extension of the file name).  Packages like Rmail, VM, GNUS,
-and Info should be able to work with compressed files without modification.
-
-The operation of this package should be transparent to the user (except for
-messages appearing when a file is being compressed or uncompressed).
-
-The variable, @code{jka-compr-compression-info-list} can be used to customize
-@code{jka-compr} to work with other compression programs.  The default value
-of this variable allows @code{jka-compr} to work with Unix compress and gzip.
-
-To activate this package, add the following to your initialization file:
-
-@example
-  (toggle-auto-compression 1 t)  ; enable compression/decompression
-@end example
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET jka-compr RET
-@end example
-
-@node uncompress, telnet, jka-compr, Top
-@chapter Auto-Decompression Hook for Visiting .Z Files
-
-This package can be used to arrange for automatic uncompress of compressed
-files when they are visited.  All that's necessary is to load it.  This can
-conveniently be done from your initialization file.
-
-@code{M-x auto-compression-mode} is a more modern replacement for this
-package.
-
-@node telnet, ssh, uncompress, Top
-@chapter Execute a Telnet Session From Within an Emacs Buffer
-
-This mode is intended to be used for telnet or rsh to a remote host;
-@code{telnet} and @code{rsh} are the two entry points.  Multiple telnet or
-rsh sessions are supported.
-
-Normally, input is sent to the remote telnet/rsh line-by-line, as you type
-@kbd{RET} or @kbd{LFD}.  @kbd{C-c C-c} sends a @kbd{C-c} to the remote
-immediately; @kbd{C-c C-z} sends @kbd{C-z} immediately.  @kbd{C-c C-q}
-followed by any character sends that character immediately.
-
-All @kbd{RET} characters are filtered out of the output coming back from the
-remote system.  The mode tries to do other useful translations based on what
-it sees coming back from the other system before the password query.  It
-knows about UNIX, ITS, TOPS-20 and Explorer systems.
-
-You can use the global @code{telnet-host-properties} to associate a telnet
-program and login name with each host you regularly telnet to.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET telnet RET
-@end example
-
-@node ssh, ftelnet, telnet, Top
-@chapter Remote Login Interface Using SSH
-
-This package provides support for remote logins using @code{ssh}.  The
-package is layered on top of shell.el; the code here only accounts for the
-variations needed to handle a remote process, e.g. directory tracking and the
-sending of some special characters.
-
-If you wish for ssh mode to prompt you in the minibuffer for passwords when a
-password prompt appears, just enter @code{M-x send-invisible} and type in
-your line, or add @code{comint-watch-for-password-prompt} to
-@code{comint-output-filter-functions}.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET ssh RET
-@end example
-
-@node ftelnet, rlogin, ssh, Top
-@chapter Remote Login Interface Using Telnet
-
-This package provides support for remote logins using @code{telnet}.  The
-package is layered on top of shell.el; the code here only accounts for the
-variations needed to handle a remote process, e.g. directory tracking and the
-sending of some special characters.
-
-If you wish for ftelnet mode to prompt you in the minibuffer for passwords
-when a password prompt appears, just enter @kbd{M-x send-invisible} and type
-in your line, or add @code{comint-watch-for-password-prompt} to
-@code{comint-output-filter-functions}.
-
-@node rlogin, mchat, ftelnet, Top
-@chapter Remote Login Interface Using rlogin
-
-This package provides support for remote logins using @code{rlogin}.  The
-package is layered on top of shell.el; the code here only accounts for the
-variations needed to handle a remote process, e.g. directory tracking and the
-sending of some special characters.
-
-If you wish for rlogin mode to prompt you in the minibuffer for passwords
-when a password prompt appears, just enter @kbd{M-x send-invisible} and type
-in your line, or add @code{comint-watch-for-password-prompt} to
-@code{comint-output-filter-functions}.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET rlogin RET
-@end example
-
-@node mchat, kermit, rlogin, Top
-@chapter Multicast Chatting
-
-MChat is a package allowing a conversation to take place between a
-potentially infinite number of people across the Internet. It uses the
-Multicast support that has been added to XEmacs in the early 21.0 days. At
-that time a rudimentary version of MChat was written, merely to illustrate
-the feature, and almost nobody knew it, apart from the other
-developers. This version is much improved and completely backwards
-incompatible ;-).
-
-NOTE: before using this package, you most likely have to customize the
-@code{mchat-nsl-method} first. It specifies a program like @code{nsl} or
-@code{nslookup} in order to retrieve the IP number of your machine.
-
-The main entry point to the package is the @code{mchat} function which allows
-you to open a multicast group based on the MChat protocol. There are a number
-a variables that can be customized and their doc-string should be
-self-explanatory. You might also want to look at the bindings (@kbd{C-h b})
-in MChat buffers, or at the menubar entries to get an idea of what you can
-do.
-
-WARNING: the current version (but there's also a limitation in the internals
-of XEmacs's processes) doesn't let you send messages longer than 500 octets
-or so, including the protocol header. I plan to change this in the future
-(see the todo list).
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET mchat RET
-@end example
-
-@node kermit, terminal, mchat, Top
-@chapter Using Shell Mode With Kermit
-
-This library not documented.  Please contribute!
-
-@node terminal, spell, kermit, Top
-@chapter Terminal Emulator
-
-This library not documented.  Please contribute!
-
-@node spell, background, terminal, Top
-@chapter Spelling Correction
-
-This mode provides an Emacs interface to the UNIX spell(1) program.  Entry
-points are @code{spell-buffer}, @code{spell-word}, @code{spell-region} and
-@code{spell-string}.  These facilities are documented in the Emacs user's
-manual.
-
-@node background, inf-lisp, spell, Top
-@chapter Fun With Background Jobs
-
-This library not documented.  Please contribute!
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET background RET
-@end example
-
-@node inf-lisp, ledit, background, Top
-@chapter Inferior-Lisp Mode
-
-This library not documented.  Please contribute!
-
-@node ledit, XEmacs License, inf-lisp, Top
-@chapter ledit
-
-This library not documented.  Please contribute!
-
-@node XEmacs License,  , ledit, Top
-@chapter XEmacs License
-@unnumbered GNU GENERAL PUBLIC LICENSE
-@center Version 2, June 1991
-
-@display
-Copyright @copyright{} 1989, 1991 Free Software Foundation, Inc.
-675 Mass Ave, Cambridge, MA 02139, USA
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-@end display
-
-@unnumberedsec Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software---to make sure the software is free for all its users.  This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it.  (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.)  You can apply it to
-your programs, too.
-
-  When we speak of free software, we are referring to freedom, not
-price.  Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
-  To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
-  For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have.  You must make sure that they, too, receive or can get the
-source code.  And you must show them these terms so they know their
-rights.
-
-  We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
-  Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software.  If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
-  Finally, any free program is threatened constantly by software
-patents.  We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary.  To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.
-
-@iftex
-@unnumberedsec TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-@end iftex
-@ifinfo
-@center TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-@end ifinfo
-
-@enumerate 0
-@item
-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.
-
-@item
-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.
-
-@item
-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:
-
-@enumerate a
-@item
-You must cause the modified files to carry prominent notices
-stating that you changed the files and the date of any change.
-
-@item
-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.
-
-@item
-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.)
-@end enumerate
-
-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.
-
-@item
-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:
-
-@enumerate a
-@item
-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,
-
-@item
-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,
-
-@item
-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.)
-@end enumerate
-
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@iftex
-@heading NO WARRANTY
-@end iftex
-@ifinfo
-@center NO WARRANTY
-@end ifinfo
-
-@item
-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.
-
-@item
-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 enumerate
-
-@iftex
-@heading END OF TERMS AND CONDITIONS
-@end iftex
-@ifinfo
-@center END OF TERMS AND CONDITIONS
-@end ifinfo
-
-@page
-@unnumberedsec 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.
-
-@smallexample
-@var{one line to give the program's name and an idea of what it does.}
-Copyright (C) 19@var{yy}  @var{name of author}
-
-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., 675 Mass Ave, Cambridge, MA 02139, USA.
-@end smallexample
-
-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:
-
-@smallexample
-Gnomovision version 69, Copyright (C) 19@var{yy} @var{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.
-@end smallexample
-
-The hypothetical commands @samp{show w} and @samp{show c} should show
-the appropriate parts of the General Public License.  Of course, the
-commands you use may be called something other than @samp{show w} and
-@samp{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:
-
-@smallexample
-@group
-Yoyodyne, Inc., hereby disclaims all copyright
-interest in the program `Gnomovision'
-(which makes passes at compilers) written
-by James Hacker.
-
-@var{signature of Ty Coon}, 1 April 1989
-Ty Coon, President of Vice
-@end group
-@end smallexample
-
-This General Public License does not permit incorporating your program into
-proprietary programs.  If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library.  If this is what you want to do, use the GNU Library General
-Public License instead of this License.
diff --git a/xemacs-packages/man/pgg/pgg.texi b/xemacs-packages/man/pgg/pgg.texi
deleted file mode 100644
index abbec8a1..00000000
--- a/xemacs-packages/man/pgg/pgg.texi
+++ /dev/null
@@ -1,399 +0,0 @@
-\input texinfo                  @c -*-texinfo-*-
-
-@setfilename pgg.info
-
-@set VERSION 0.1
-
-
-@copying
-This file describes the PGG.
-
-Copyright (C) 2003, 2004 Free Software Foundation, Inc.
-Copyright (C) 2001 Daiki Ueno.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 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
-
-@dircategory Emacs
-@direntry
-* PGG: (pgg).   Emacs interface to various PGP implementations.
-@end direntry
-
-@settitle PGG @value{VERSION}
-
-
-@titlepage
-@title PGG
-
-@author by Daiki Ueno
-@page
-
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-@page
-
-@node Top
-@top PGG
-This manual describes PGG.  PGG is an interface library between Emacs
-and various tools for secure communication.  PGG also provides a simple
-user interface to encrypt, decrypt, sign, and verify MIME messages.
-
-@menu
-* Overview::                    What PGG is.
-* Prerequisites::               Complicated stuff you may have to do.
-* How to use::                  Getting started quickly.
-* Architecture::                
-* Parsing OpenPGP packets::     
-* Function Index::              
-* Variable Index::              
-@end menu
-
-@node Overview
-@chapter Overview
-
-PGG is an interface library between Emacs and various tools for secure
-communication.  Even though Mailcrypt has similar feature, it does not
-deal with detached PGP messages, normally used in PGP/MIME
-infrastructure.  This was the main reason why I wrote the new library.
-
-PGP/MIME is an application of MIME Object Security Services (RFC1848).
-The standard is documented in RFC2015.
-
-@node Prerequisites
-@chapter Prerequisites
-
-PGG requires at least one implementation of privacy guard system.
-This document assumes that you have already obtained and installed them
-and that you are familiar with its basic functions.
-
-By default, PGG uses GnuPG, but Pretty Good Privacy version 2 or version
-5 are also supported.  If you are new to such a system, I recommend that
-you should look over the GNU Privacy Handbook (GPH) which is available
-at @uref{http://www.gnupg.org/gph/}.
-
-@node How to use
-@chapter How to use
-
-The toplevel interface of this library is quite simple, and only
-intended to use with public-key cryptographic operation.
-
-To use PGG, evaluate following expression at the beginning of your
-application program.
-
-@lisp
-(require 'pgg)
-@end lisp
-
-If you want to check existence of pgg.el at runtime, instead you can
-list autoload setting for desired functions as follows.
-
-@lisp
-(autoload 'pgg-encrypt-region "pgg"
-  "Encrypt the current region." t)
-(autoload 'pgg-decrypt-region "pgg"
-  "Decrypt the current region." t)
-(autoload 'pgg-sign-region "pgg"
-  "Sign the current region." t)
-(autoload 'pgg-verify-region "pgg"
-  "Verify the current region." t)
-(autoload 'pgg-insert-key "pgg"
-  "Insert the ASCII armored public key." t)
-(autoload 'pgg-snarf-keys-region "pgg"
-  "Import public keys in the current region." t)
-@end lisp
-
-@menu
-* User Commands::               
-* Selecting an implementation::  
-* Caching passphrase::          
-* Default user identity::	
-@end menu
-
-@node User Commands
-@section User Commands
-
-At this time you can use some cryptographic commands.  The behavior of
-these commands relies on a fashion of invocation because they are also
-intended to be used as library functions.  In case you don't have the
-signer's public key, for example, the function @code{pgg-verify-region}
-fails immediately, but if the function had been called interactively, it
-would ask you to retrieve the signer's public key from the server.
-
-@deffn Command pgg-encrypt-region start end recipients &optional sign
-Encrypt the current region between @var{start} and @var{end} for
-@var{recipients}.  When the function were called interactively, you
-would be asked about the recipients.
-
-If encryption is successful, it replaces the current region contents (in
-the accessible portion) with the resulting data.
-
-If optional argument @var{sign} is non-@code{nil}, the function is
-request to do a combined sign and encrypt.  This currently only work
-with GnuPG.
-@end deffn
-
-@deffn Command pgg-decrypt-region start end
-Decrypt the current region between @var{start} and @var{end}.  If
-decryption is successful, it replaces the current region contents (in
-the accessible portion) with the resulting data.
-@end deffn
-
-@deffn Command pgg-sign-region start end &optional cleartext
-Make the signature from text between @var{start} and @var{end}.  If the
-optional third argument @var{cleartext} is non-@code{nil}, or the
-function is called interactively, it does not create a detached
-signature.  In such a case, it replaces the current region contents (in
-the accessible portion) with the resulting data.
-@end deffn
-
-@deffn Command pgg-verify-region start end &optional signature fetch
-Verify the current region between @var{start} and @var{end}.  If the
-optional third argument @var{signature} is non-@code{nil}, or the function
-is called interactively, it is treated as the detached signature of the
-current region.
-
-If the optional 4th argument @var{fetch} is non-@code{nil}, or the
-function is called interactively, we attempt to fetch the signer's
-public key from the key server.
-@end deffn
-
-@deffn Command pgg-insert-key
-Retrieve the user's public key and insert it as ASCII-armored format.
-@end deffn
-
-@deffn Command pgg-snarf-keys-region start end
-Collect public keys in the current region between @var{start} and
-@var{end}, and add them into the user's keyring.
-@end deffn
-
-@node Selecting an implementation
-@section Selecting an implementation
-
-Since PGP has a long history and there are a number of PGP
-implementations available today, the function which each one has differs
-considerably.  For example, if you are using GnuPG, you know you can
-select cipher algorithm from 3DES, CAST5, BLOWFISH, and so on, but on
-the other hand the version 2 of PGP only supports IDEA.
-
-By default, if the variable @code{pgg-scheme} is not set, PGG searches the
-registered scheme for an implementation of the requested service
-associated with the named algorithm.  If there are no match, PGG uses
-@code{pgg-default-scheme}.  In other words, there are two options to
-control which command is used to process the incoming PGP armors.  One
-is for encrypting and signing, the other is for decrypting and
-verifying.
-
-@defvar pgg-scheme
-Force specify the scheme of PGP implementation for decrypting and verifying.
-The value can be @code{gpg}, @code{pgp}, and @code{pgp5}.
-@end defvar
-
-@defvar pgg-default-scheme
-Force specify the scheme of PGP implementation for encrypting and signing.
-The value can be @code{gpg}, @code{pgp}, and @code{pgp5}.
-@end defvar
-
-@node Caching passphrase
-@section Caching passphrase
-
-PGG uses a simple passphrase caching mechanism, which is enabled by
-default.
-
-@defvar pgg-cache-passphrase
-If non-@code{nil}, store passphrases.  The default value of this
-variable is @code{t}.  If you were worry about security issue, however,
-you could stop caching with setting it @code{nil}.
-@end defvar
-
-@defvar pgg-passphrase-cache-expiry
-Elapsed time for expiration in seconds.
-@end defvar
-
-@node Default user identity
-@section Default user identity
-
-The PGP implementation is usually able to select the proper key to use
-for signing and decryption, but if you have more than one key, you may
-need to specify the key id to use.
-
-@defvar pgg-default-user-id
-User ID of your default identity.  It defaults to the value returned
-by @samp{(user-login-name)}.  You can customize this variable.
-@end defvar
-
-@defvar pgg-gpg-user-id
-User ID of the GnuPG default identity.  It defaults to @samp{nil}.
-This overrides @samp{pgg-default-user-id}.  You can customize this
-variable.
-@end defvar
-
-@defvar pgg-pgp-user-id
-User ID of the PGP 2.x/6.x default identity.  It defaults to
-@samp{nil}.  This overrides @samp{pgg-default-user-id}.  You can
-customize this variable.
-@end defvar
-
-@defvar pgg-pgp5-user-id
-User ID of the PGP 5.x default identity.  It defaults to @samp{nil}.
-This overrides @samp{pgg-default-user-id}.  You can customize this
-variable.
-@end defvar
-
-@node Architecture
-@chapter Architecture
-
-PGG introduces the notion of a "scheme of PGP implementation" (used
-interchangeably with "scheme" in this document).  This term refers to a
-singleton object wrapped with the luna object system.
-
-Since PGG was designed for accessing and developing PGP functionality,
-the architecture had to be designed not just for interoperability but
-also for extensiblity.  In this chapter we explore the architecture
-while finding out how to write the PGG backend.
-
-@menu
-* Initializing::                
-* Backend methods::             
-* Getting output::              
-@end menu
-
-@node Initializing
-@section Initializing
-
-A scheme must be initialized before it is used.
-It had better guarantee to keep only one instance of a scheme.
-
-The following code is snipped out of @file{pgg-gpg.el}.  Once an
-instance of @code{pgg-gpg} scheme is initialized, it's stored to the
-variable @code{pgg-scheme-gpg-instance} and will be reused from now on.
-
-@lisp
-(defvar pgg-scheme-gpg-instance nil)
-
-(defun pgg-make-scheme-gpg ()
-  (or pgg-scheme-gpg-instance
-      (setq pgg-scheme-gpg-instance
-	    (luna-make-entity 'pgg-scheme-gpg))))
-@end lisp
-
-The name of the function must follow the
-regulation---@code{pgg-make-scheme-} follows the backend name.
-
-@node Backend methods
-@section Backend methods
-
-In each backend, these methods must be present.  The output of these
-methods is stored in special buffers (@ref{Getting output}), so that
-these methods must tell the status of the execution.
-
-@deffn Method pgg-scheme-lookup-key scheme string &optional type
-Return keys associated with @var{string}.  If the optional third
-argument @var{type} is non-@code{nil}, it searches from the secret
-keyrings.
-@end deffn
-
-@deffn Method pgg-scheme-encrypt-region scheme start end recipients &optional sign
-Encrypt the current region between @var{start} and @var{end} for
-@var{recipients}.  If @var{sign} is non-@code{nil}, do a combined sign
-and encrypt.  If encryption is successful, it returns @code{t},
-otherwise @code{nil}.
-@end deffn
-
-@deffn Method pgg-scheme-decrypt-region scheme start end
-Decrypt the current region between @var{start} and @var{end}.  If
-decryption is successful, it returns @code{t}, otherwise @code{nil}.
-@end deffn
-
-@deffn Method pgg-scheme-sign-region scheme start end &optional cleartext
-Make the signature from text between @var{start} and @var{end}.  If the
-optional third argument @var{cleartext} is non-@code{nil}, it does not
-create a detached signature.  If signing is successful, it returns
-@code{t}, otherwise @code{nil}.
-@end deffn
-
-@deffn Method pgg-scheme-verify-region scheme start end &optional signature
-Verify the current region between @var{start} and @var{end}.  If the
-optional third argument @var{signature} is non-@code{nil}, it is treated
-as the detached signature of the current region.  If the signature is
-successfully verified, it returns @code{t}, otherwise @code{nil}.
-@end deffn
-
-@deffn Method pgg-scheme-insert-key scheme
-Retrieve the user's public key and insert it as ASCII-armored format.
-On success, it returns @code{t}, otherwise @code{nil}.
-@end deffn
-
-@deffn Method pgg-scheme-snarf-keys-region scheme start end
-Collect public keys in the current region between @var{start} and
-@var{end}, and add them into the user's keyring.
-On success, it returns @code{t}, otherwise @code{nil}.
-@end deffn
-
-@node Getting output
-@section Getting output
-
-The output of the backend methods (@ref{Backend methods}) is stored in
-special buffers, so that these methods must tell the status of the
-execution.
-
-@defvar pgg-errors-buffer
-The standard error output of the execution of the PGP command is stored
-here.
-@end defvar
-
-@defvar pgg-output-buffer
-The standard output of the execution of the PGP command is stored here.
-@end defvar
-
-@defvar pgg-status-buffer
-The rest of status information of the execution of the PGP command is
-stored here.
-@end defvar
-
-@node Parsing OpenPGP packets
-@chapter Parsing OpenPGP packets
-
-The format of OpenPGP messages is maintained in order to publish all
-necessary information needed to develop interoperable applications.
-The standard is documented in RFC 2440.
-
-PGG has its own parser for the OpenPGP packets.
-
-@defun pgg-parse-armor string
-List the sequence of packets in @var{string}.
-@end defun
-
-@defun pgg-parse-armor-region start end
-List the sequence of packets in the current region between @var{start}
-and @var{end}.
-@end defun
-
-@defvar pgg-ignore-packet-checksum
-If non-@code{nil}, don't check the checksum of the packets.
-@end defvar
-
-@node Function Index
-@chapter Function Index
-@printindex fn
-
-@node Variable Index
-@chapter Variable Index
-@printindex vr
-
-@summarycontents
-@contents
-@bye
-
-@c End:
-
-@ignore
-   arch-tag: 0c205838-34b9-41a5-b9d7-49ae57ccac85
-@end ignore
diff --git a/xemacs-packages/man/prog-modes/prog-modes.texi b/xemacs-packages/man/prog-modes/prog-modes.texi
deleted file mode 100644
index 8b151c95..00000000
--- a/xemacs-packages/man/prog-modes/prog-modes.texi
+++ /dev/null
@@ -1,2625 +0,0 @@
-@c -*-texinfo-*-
-@c
-@c Copyright (C) 2002, 2003 Free Software Foundation, Inc.
-@c Copyright (C) 2003 Jake Colman 
-@c Copyright (C) 2004 Ville Skyttä 
-@c
-@c @setfilename prog-modes.info
-@settitle Programming Modes for XEmacs
-@ifinfo
-@dircategory XEmacs Editor
-@direntry
-* Programming Modes: (prog-modes).	Programming Modes for XEmacs.
-@end direntry
-@end ifinfo
-
-@ignore
-@copying
-This manual is part of XEmacs.
-
-XEmacs 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.
-
-XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
-Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-@end copying
-@end ignore
-
-@node Top, Copying, (dir), (dir)
-@chapter The Programming Modes Package
-
-@ifinfo
-This Info file contains the manual for the Programming Modes package.
-@end ifinfo
-
-The node name for each entry in the menu is the name of the elisp file
-containing the code that implements the functionality described.  It is
-highly recommended that you briefly peruse the elisp source code since it can
-provide valuable information on usage and technique.  This can easily be done
-by typing @code{C-x 4 l  RET} where  is the name of the
-elisp file to be loaded.
-
-In many cases, the @code{customize} command can be used to customize a
-package's options.  For those packages that support @code{customize}, the
-appropriate command is given.  Otherwise, peruse the code as described above
-to learn how to set the package's options.
-
-When you have entered a mode, you may get more info on the capabilities of
-that mode by pressing @kbd{C-h m}. You may also get online help describing
-functions provided by the mode by pressing @code{C-h f }.
-
-@menu
-* Copying::                     
-
-* asm-mode::                    Editing Assembler Code
-* autoconf-mode::               Editing Autoconf Input Files
-* awk-mode::                    Editing AWK Code
-* cl-indent::                   Enhanced Lisp-Indent Mode
-* cvs::                         Light CVS Support
-* diff-mode::                   Viewing and Editing Context Diffs
-* eiffel::                      Editing Eiffel Code
-* icon::                        Editing Icon Code
-* javascript-mode::             Editing JavaScript Code
-* ksh-mode::                    Editing Shell Script (sh, ksh, bash) Code
-* lua-mode::                    Editing Lua Code
-* m4-mode::                     Editing m4 Code
-* make-mode::                   Editing Makefiles
-* mode-compile::                Compiling Files According to Major-Mode
-* modula2::                     Editing Modula-2 Code
-* old-c-mode::                  Editing C Code
-* p4::                          Integration with Perforce Version Control
-* pascal::                      Editing Pascal Code
-* php-mode::                    Editing PHP Code
-* postscript::                  Editing PostScript Programs
-* prolog::                      Editing and Running Prolog Code
-* rexx-mode::                   Editing REXX Code
-* rpm-spec-mode::               Editing RPM Spec Files
-* simula::                      Editing SIMULA 87 Code
-* sql::                         Specialized Mode for SQL Interpreters
-* tcl::                         Editing Tcl Code
-* teco::                        Teco Interpreter
-* uil-mode::                    Editing Motif UIL Code
-* verilog-mode::                Editing Verilog HDL Source
-* vrml-mode::                   Editing VRML (.wrl) Files
-
-* XEmacs License::              XEmacs License
-@end menu
-
-@node Copying, asm-mode, Top, Top
-@chapter Copying
-
-This document may be redistributed, verbatim or in modified form, under
-the terms of the GNU General Public License, version 2 or any later
-version.  The same terms apply to the libraries it documents.  A copy
-of the General Public License is provided as an Appendix.
-
-Most XEmacs documentation has its own license, which is an ancestor of
-the GNU Free Documentation License (@dfn{FDL}), and whose terms are
-quite similar to those imposed by GNU on Emacs documentation.  Why is
-this manual licensed differently (under the GNU General Public License,
-or @dfn{GPL}), and why does it have to be distributed separately from
-the XEmacs User's Guide and the XEmacs Lisp Reference Manual?
-
-Taking the second question first, XEmacs is @dfn{community-owned}
-software.  That is, unlike GNU Emacs, there is no monopoly copyright
-holder.  Many of us, including the original Lucid authors, have
-contributed our copyrights to the Free Software Foundation (FSF), and of
-course much content is derived from GNU Emacs, and therefore is held by
-the FSF.  Another large chunk is held by Sun Microsystems, and a few
-individual authors hold copyright to thousands of lines each.  But many
-individuals hold copyright to only a few dozen lines.  Like the Linux
-kernel, copyright ownership is distributed throughout a community.
-
-However, its license is ``copyleft,'' @emph{i.e.}, it @emph{requires}
-that you redistribute it under terms @emph{identical} to those under
-which you received it, unless you have explicit permission of the
-copyright holder.  Because of the multiple owners, determining the
-ownership of any given part of XEmacs is tedious, and perhaps
-impossible.  For practical purposes, then, the license of any
-substantial chunk of existing XEmacs content cannot be changed, except
-to a later version of the GPL, for those parts under GPL.  (That is due
-to the @emph{explicit} permission to change to a later version of the
-GPL, present in every file of XEmacs.)
-
-Unfortunately, this severe restriction means that the GPL, FDL, and the
-XEmacs documentation license (@dfn{XDL}) are @emph{mutually
-incompatible}.  That is, content licensed under any of the GPL, FDL, or
-XDL @emph{may not} be mixed with content licensed under either of the
-other two without changing the license of some of the content.  But this
-requires permission of the copyright holder, which is often difficult or
-impossible to get.
-
-For example, you @emph{may not} take comments or docstrings from XEmacs
-code and add them to the Lispref to mend a gap in the latter's coverage.
-You @emph{may not} copy text from the Lispref into docstrings in the
-code.  And you @emph{may not} copy text from the GNU Emacs Lisp
-Reference to the XEmacs Lisp Reference Manual.  (In this case it is at
-least trivial to ask permission, although it is rather unclear whether
-it would be granted.)
-
-In fact, parts of this document were derived by copying from XEmacs code
-under the GPL, without any further permission from the authors.  Thus,
-this document must be distributed under the GPL, as a ``volume''
-separate from the XEmacs documentation under the XDL.  Note that the
-``mere aggregation'' clauses allow us to distribute in the same
-tarball.  But incorporating it as a node in the Lispref is prohibited,
-even if done by inclusion.
-
-A bit of advocacy:
-
-If you look carefully at the additional restrictions imposed by the
-soi-disant "free" documentation licenses, you discover that they are
-simply proprietary restrictions guaranteeing a certain amount of
-@emph{unpaid} political advertising to the Free Software Foundation and
-GNU Project (and in the case of the FDL, this is extended to commercial
-advertising by authors of original or derived works).  Whether this is
-``ethically justified'' or not is a difficult question.  What is certain
-is that there is little social benefit to these terms (since the license
-documents themselves contain the advocacy and must be included with any
-distribution).
-
-I conclude it makes sense for XEmacs to reduce its restrictions, where
-possible, to the ``least common denominator,'' the GNU General Public
-License.
-
-@node asm-mode, autoconf-mode, Copying, Top
-@chapter Editing Assembler Code
-
-This mode is used for editing Assembler code.  The mode is automatically
-invoked for buffers visiting any file ending with one of the following
-extensions: @file{.s}, @file{.S}, @file{.asm}.
-
-The mode is based on text-mode.  It defines a private abbrev table that can
-be used to save abbrevs for assembler mnemonics.  It binds just five keys:
-
-@table @kbd
-
-@item TAB
-Tab to next tab stop
-
-@item :
-Outdent preceding label, tab to tab stop
-
-@item comment char 
-Place or move comment.  @code{asm-comment-char} specifies which character
-this is; you can use a different character in different Asm mode buffers.
-Alternatively, you may set this variable in @code{asm-mode-set-comment-hook},
-which is called near the beginning of mode initialization.
-
-@item C-j, C-m
-Newline and tab to tab stop
-
-@end table
-
-Code is automatically indented to the first tab stop level.
-
-Turning on Asm mode runs the hook @code{asm-mode-hook} at the end of
-initialization.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET asm RET
-@end example
-
-@node autoconf-mode, awk-mode, asm-mode, Top
-@chapter Editing Autoconf Input Files
-
-This mode is used for editing autoconf input files.  It is automatically
-invoked for buffers visiting the following types of files:
-
-@itemize @bullet
-
-@item any file ending with an extension of @file{.m4} 
-
-@item any file named @file{configure} ending with an extension of either
-@file{.in} or @file{.ac}.  
-
-@end itemize
-
-To configure this package please view the source code.  This can be done by
-typing @kbd{C-x 4 l autoconf-mode}.
-
-@menu
-* About Autoconf: about-autoconf.
-@end menu
-
-@node about-autoconf,  , autoconf-mode, autoconf-mode
-@section About Autoconf
-
-Autoconf is an extensible package of m4 macros that produce shell scripts to
-automatically configure software source code packages. These scripts can
-adapt the packages to many kinds of UNIX-like systems without manual user
-intervention. Autoconf creates a configuration script for a package from a
-template file that lists the operating system features that the package can
-use, in the form of m4 macro calls.
-
-@node awk-mode, cl-indent, autoconf-mode, Top
-@chapter Editing AWK Code 
-
-This mode is used for editing Awk code.  It is automatically invoked for
-buffers visiting the following types of files:
-
-@itemize @bullet
-
-@item any file ending with an extension of @file{.awk}.
-
-@item any file that has an interpretor line (the "shebang" line) specifying
-"awk".  
-
-@end itemize
-
-The mode operates much like C mode except for the syntax of comments.  It
-uses the same keymap as C mode and has the same variables for customizing
-indentation.  It has its own abbrev table and its own syntax table.
-
-Turning on AWK mode calls the value of the variable @code{awk-mode-hook} with
-no arguments, if that value is non-nil.
-
-NOTE: This library is obsolete.  Support for AWK is now available directly
-via the cc-mode package.  @xref{AWK Mode, , , cc-mode, CC Mode Manual}., for
-details.
-
-@menu
-* About Awk: about-awk.
-@end menu
-
-@node about-awk,  , awk-mode, awk-mode
-@section About Awk
-
-Awk is a text-processing programming language.  It is a useful and simple
-tool for manipulating text.
-
-@node cl-indent, cvs, awk-mode, Top
-@chapter Enhanced Lisp-Indent Mode
-
-This package provides an extension to lisp-mode.  It supplies a single entry
-point, @code{common-lisp-indent-function}, which performs indentation in the
-preferred style for Common Lisp code.  To enable it add the following to your
-@code{user-init-file}:
-
-@example
-  (setq lisp-indent-function 'common-lisp-indent-function)
-@end example
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET lisp-indent RET
-@end example
-
-@node cvs, diff-mode, cl-indent, Top
-@chapter Light CVS Support
-
-This package provides simple CVS support within the editing session.
-
-The package provides the following features:
-
-@itemize @bullet
-
-@item Displays the CVS revision in the mode line.
-@item Compares file changes between CVS revisions using @code{ediff}.
-@item Keystrokes and menu entries to execute `cvs status', `cvs log' and `cvsann'.
-@item Simple interface to `cvs commit' and `cvs update' commands.
-@item Status listing per directory.
-@item @code{msb} support (better buffer selection).
-@item @code{dired} support.
-@item Softlink tree support.
-@item Little module support (status and update).
-
-@end itemize
-
-To install this library, add the following to your @code{user-init-file}:
-
-@example
-  (require 'cvs)
-@end example
-
-To configure this package please view the source code.  This can be done by
-typing @kbd{C-x 4 l cvs}.
-
-For related packages please see @ref{Top, PCL-CVS, , pcl-cvs, Pcl-cvs -
-The Emacs Front-End to CVS}. and @ref{Version Control, , ,xemacs, The XEmacs
-Editor}.
-
-@menu
-* About CVS: about-cvs.
-@end menu
-
-@node about-cvs,  , cvs, cvs
-@section About CVS
-
-CVS is the Concurrent Versions System, an open-source network-transparent
-version control system.  More information on CVS can be found at
-@uref{http://www.cvshome.org/,CVS Home}.
-
-@node diff-mode, eiffel, cvs, Top
-@chapter Viewing and Editing Context Diffs
-
-This mode facilitates viewing and editing of context diffs.  It is
-automatically invoked buffers visiting any file ending with one of the
-following extensions: @file{.diff}, @file{.diffs}, @file{.patch}, @file{.rej}.
-
-The mode provides support for font-lock, outline, navigation commands,
-editing and various conversions as well as jumping.
-
-The following key mappings are defined:
-
-@multitable {M-delete  } {diff-reverse-direction}
-@item @code{C-c}             @tab << Prefix Command >>
-@item @code{M-A}             @tab diff-ediff-patch
-@item @code{M-C}             @tab diff-unified->context
-@item @code{M-K}             @tab diff-file-kill
-@item @code{M-N}             @tab diff-file-next
-@item @code{M-P}             @tab diff-file-prev
-@item @code{M-R}             @tab diff-reverse-direction
-@item @code{M-U}             @tab diff-context->unified
-@item @code{M-W}             @tab widen
-@item @code{M-k}             @tab diff-hunk-kill
-@item @code{M-n}             @tab diff-hunk-next
-@item @code{M-o}             @tab diff-goto-source
-@item @code{M-p}             @tab diff-hunk-prev
-@item @code{M-r}             @tab diff-restrict-view
-@item @code{M-@{}            @tab diff-file-prev
-@item @code{M-@}}            @tab diff-file-next
-@item @code{M-delete}        @tab scroll-down
-@item @code{M-return}        @tab diff-goto-source
-@item @code{M-space}         @tab scroll-up
-@item @code{M-C-m}           @tab diff-goto-source
-
-@item @code{C-c C-a}         @tab diff-apply-hunk
-@item @code{C-c C-c}         @tab diff-goto-source
-@item @code{C-c C-s}         @tab diff-split-hunk
-@item @code{C-c C-t}         @tab diff-test-hunk
-@end multitable
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET diff-mode RET
-@end example
-
-@node eiffel, icon, diff-mode, Top
-@chapter Editing Eiffel Code
-
-This mode is used for editing Eiffel code.  It is automatically invoked for
-buffers visiting any file ending in an extension of @file{.e}.
-
-The following key mappings are defined:
-
-@multitable {C-c C-c  } {diff-reverse-direction}
-@item @code{return}          @tab reindent-then-newline-and-indent
-@item @code{C-c}             @tab << Prefix Command >>
-@item @code{C-j}             @tab newline-and-indent
-@item @code{C-x}             @tab << Prefix Command >>
-@item @code{M-'}             @tab eif-feature-quote
-@item @code{M-q}             @tab eif-fill-paragraph
-@item @code{M-C-a}           @tab eif-beginning-of-feature
-@item @code{M-C-e}           @tab eif-end-of-feature
-@item @code{M-C-q}           @tab eif-indent-construct
-@item @code{C-c C-c}         @tab eif-compile
-@item @code{C-c C-o}         @tab eif-set-compile-options
-@item @code{C-c C-r}         @tab eif-run
-@item @code{C-c C-s}         @tab eif-short
-@item @code{C-x n}           @tab << Prefix Command >>
-@item @code{C-x n d}         @tab eif-narrow-to-feature
-@end multitable
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET eiffel RET
-@end example
-
-@menu
-* About Eiffel: about-eiffel.
-@end menu
-
-@node about-eiffel,  , eiffel, eiffel
-@section About Eiffel
-
-The Eiffel programming language was created by Bertrand Meyer and developed
-by his company, Interactive Software Engineering (ISE) of Goleta, CA in 1985.
-More information on Eiffel can be found at
-@uref{http://www.engin.umd.umich.edu/CIS/course.des/cis400/eiffel/eiffel.html,the
-Eiffel Web Site}.
-
-@node icon, javascript-mode, eiffel, Top
-@chapter Editing Icon Code
-
-This mode is used for editing Icon code.  It is automatically invoked for
-buffers visiting any file ending in an extension of @file{.icn}.
-
-The mode provides the following features:
-
-@itemize @bullet
-@item Expression and list commands understand all Icon brackets.
-@item Tab indents for Icon code.
-@item Paragraphs are separated by blank lines only.
-@item Delete converts tabs to spaces as it moves back.
-@end itemize
-
-The following key mappings are defined:
-
-@multitable {M-backspace  } {backward-delete-char-untabify}
-@item @code{@{}              @tab electric-icon-brace
-@item @code{@}}              @tab electric-icon-brace
-@item @code{delete}          @tab backward-delete-char-untabify
-@item @code{menu-bar}        @tab << Prefix command "Icon" >>
-@item @code{M-backspace}     @tab mark-icon-function
-@item @code{M-C-a}           @tab beginning-of-icon-defun
-@item @code{M-C-e}           @tab end-of-icon-defun
-@item @code{M-C-h}           @tab mark-icon-function
-@item @code{M-C-q}           @tab indent-icon-exp
-@end multitable
-
-The variables controlling indentation style are:
-
-@table @code
-
-@item icon-tab-always-indent
-Non-nil means TAB in Icon mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.
-
-@item icon-auto-newline
-Non-nil means automatically newline before and after braces
-inserted in Icon code.
-
-@item icon-indent-level
-Indentation of Icon statements within surrounding block.
-The surrounding block's indentation is the indentation
-of the line on which the open-brace appears.
-
-@item icon-continued-statement-offset
-Extra indentation given to a substatement, such as the
-then-clause of an if or body of a while.
-
-@item icon-continued-brace-offset
-Extra indentation given to a brace that starts a substatement.
-This is in addition to `icon-continued-statement-offset'.
-
-@item icon-brace-offset
-Extra indentation for line if it starts with an open brace.
-
-@item icon-brace-imaginary-offset
-An open brace following other text is treated as if it were
-this far to the right of the start of its line.
-
-@end table
-
-Turning on Icon mode calls the value of the variable @code{icon-mode-hook}
-with no args, if that value is non-nil.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET icon RET
-@end example
-
-@menu
-* About Icon: about-icon.
-@end menu
-
-@node about-icon,  , icon, icon
-@section About Icon
-
-Icon is a high-level, general-purpose programming language with a large
-repertoire of features for processing data structures and character
-strings. Icon is an imperative, procedural language with a syntax reminiscent
-of C and Pascal, but with semantics at a much higher level.  More information
-on Icon can be found at @uref{http://www.cs.arizona.edu/icon/,The Icon
-Programming Language}.
-
-@node javascript-mode, ksh-mode, icon, Top
-@chapter Editing JavaScript Code
-
-This mode is used for editing JavaScript code.  It is automatically invoked
-for buffers visiting any file ending in an extension of @file{.js} or
-@file{.pac}.
-
-See the documentation for @code{c++-mode}: JavaScript mode is an extension of
-it (@pxref{Top, CC Mode, , cc-mode, CC Mode Manual}).  Use the hook
-@code{javascript-mode-hook} to execute custom code when entering JavaScript
-mode.
-
-The following key mappings are defined:
-
-@multitable {M-C-kp-right  } {c-show-syntactic-information}
-@item @code{#}               @tab c-electric-pound
-@item @code{(, )}            @tab c-electric-paren
-@item @code{*}               @tab c-electric-star
-@item @code{,}               @tab c-electric-semi&comma
-@item @code{/}               @tab c-electric-slash
-@item @code{:}               @tab c-electric-colon
-@item @code{;}               @tab c-electric-semi&comma
-@item @code{<}               @tab c-electric-lt-gt
-@item @code{>}               @tab c-electric-lt-gt
-@item @code{@{}              @tab c-electric-brace
-@item @code{@}}              @tab c-electric-brace
-@item @code{backspace}       @tab c-electric-backspace
-@item @code{delete}          @tab c-electric-delete
-@item @code{return}          @tab c-context-line-break
-@item @code{tab}             @tab c-indent-command
-@item @code{C-c}             @tab << Prefix Command >>
-@item @code{C-i}             @tab c-indent-command
-@item @code{C-m}             @tab c-context-line-break
-@item @code{C-x}             @tab << Prefix Command >>
-@item @code{M-a}             @tab c-beginning-of-statement
-@item @code{M-c}             @tab c-comment-edit-at-point
-@item @code{M-e}             @tab c-end-of-statement
-@item @code{M-j}             @tab c-indent-new-comment-line
-@item @code{M-q}             @tab c-fill-paragraph
-@item @code{M-backspace}     @tab backward-kill-word
-@item @code{M-backward}      @tab backward-kill-word
-@item @code{M-delete}        @tab backward-kill-word
-@item @code{M-linefeed}      @tab c-indent-new-comment-line
-@item @code{M-C-h}           @tab backward-kill-word
-@item @code{M-C-j}           @tab c-indent-new-comment-line
-@item @code{M-C-q}           @tab c-indent-exp
-@item @code{M-C-kp-left}     @tab c-beginning-of-statement
-@item @code{M-C-kp-right}    @tab c-end-of-statement
-@item @code{M-C-left}        @tab c-beginning-of-statement
-@item @code{M-C-right}       @tab c-end-of-statement
-@item @code{C-c .}           @tab c-set-style
-@item @code{C-c C-\}         @tab c-backslash-region
-@item @code{C-c C-a}         @tab c-toggle-auto-state
-@item @code{C-c C-b}         @tab c-submit-bug-report
-@item @code{C-c C-c}         @tab comment-region
-@item @code{C-c C-d}         @tab c-toggle-hungry-state
-@item @code{C-c C-n}         @tab c-forward-conditional
-@item @code{C-c C-o}         @tab c-set-offset
-@item @code{C-c C-p}         @tab c-backward-conditional
-@item @code{C-c C-q}         @tab c-indent-defun
-@item @code{C-c C-s}         @tab c-show-syntactic-information
-@item @code{C-c C-t}         @tab c-toggle-auto-hungry-state
-@item @code{C-c C-u}         @tab c-up-conditional
-@item @code{C-x f}           @tab c-fill-paragraph
-@end multitable
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET javascript RET
-@end example
-
-@menu
-* About JavaScript: about-javascript.
-@end menu
-
-@node about-javascript,  , javascript-mode, javascript-mode
-@section About JavaScript
-
-JavaScript is a compact, object-based scripting language for developing
-client and server Internet applications.
-
-@node ksh-mode, lua-mode, javascript-mode, Top
-@chapter Editing Shell Script (sh, ksh, bash) Code
-
-This mode is used for editing shell scripts written for the Bourne (sh), Korn
-(ksh) or Bourne Again (bash) shells.  It is NOT automatically invoked for any
-particular file extension.  To invoke this mode while editing a file, type
-@code{M-x ksh-mode}.
-
-The following key mappings are defined:
-
-@multitable {C-c tab  } {reindent-then-newline-and-indent}
-@item @code{linefeed}        @tab reindent-then-newline-and-indent
-@item @code{tab}             @tab ksh-indent-line
-@item @code{C-c}             @tab << Prefix Command >>
-@item @code{C-i}             @tab ksh-indent-line
-@item @code{C-j}             @tab reindent-then-newline-and-indent
-@item @code{M-tab}           @tab ksh-complete-symbol
-@item @code{M-C-i}           @tab ksh-complete-symbol
-@item @code{C-c tab}         @tab ksh-completion-init-and-pickup
-@item @code{C-c C-i}         @tab ksh-completion-init-and-pickup
-@end multitable
-
-The variables controlling indentation style are:
-
-@table @code
-
-@item ksh-indent
-Indentation of ksh statements with respect to containing block.
-Default value is 2.
-
-@item ksh-case-indent
-Additional indentation for statements under case items.
-Default value is nil which will align the statements one position 
-past the ")" of the pattern.
-
-@item ksh-case-item-offset
-Additional indentation for case items within a case statement.
-Default value is 2.
-
-@item ksh-group-offset
-Additional indentation for keywords "do" and "then".
-Default value is -2.
-
-@item ksh-brace-offset
-Additional indentation of "@{" under functions or brace groupings.
-Default value is 0.
-
-@item ksh-multiline-offset
-Additional indentation of line that is preceded of a line ending with a
-@code{\} to make it continue on next line.
-
-@item ksh-tab-always-indent
-Controls the operation of the @code{TAB} key. If t (the default), always
-reindent the current line.  If nil, indent the current line only if
-point is at the left margin or in the line's indentation; otherwise
-insert a tab.
-
-@item ksh-match-and-tell
-If non-nil echo in the minibuffer the matching compound command
-for the "done", "@}", "fi", or "esac". Default value is t.
-
-@item ksh-align-to-keyword
-Controls whether nested constructs align from the keyword or
-the current indentation. If non-nil, indentation will be relative to
-the column the keyword starts. If nil, indentation will be relative to
-the current indentation of the line the keyword is on.
-The default value is non-nil.
-
-@item ksh-comment-regexp
-Regular expression used to recognize comments. Customize to support
-ksh-like languages. Default value is "\s *#".
-
-@end table
-
-An example of how to set up this mode is as follows:
-
-@example
-  (setq ksh-mode-hook
-       (function (lambda ()
-          (font-lock-mode 1)             ;; font-lock the buffer
-          (setq ksh-indent 8)
-	  (setq ksh-group-offset -8)
-	  (setq ksh-brace-offset -8)   
-          (setq ksh-tab-always-indent t)
-          (setq ksh-match-and-tell t)
-          (setq ksh-align-to-keyword t)	;; Turn on keyword alignment
-	  )))
-@end example
-
-To configure this package please view the source code.  This can be done by
-typing @kbd{C-x 4 l ksh-mode}.
-
-For a related package, see @code{sh-script}.
-
-@node lua-mode, m4-mode, ksh-mode, Top
-@chapter Editing Lua Code
-
-This mode is used for editing Lua code.  It is automatically invoked for
-buffers visiting any file ending in the extension @file{.lua}.
-
-To configure this mode, type:
-
-@example
-  M-x customize-group RET lua RET
-@end example
-
-@menu
-* About Lua: about-lua.
-@end menu
-
-@node about-lua,  , lua-mode, lua-mode
-@section About Lua
-
-Lua is a powerful light-weight programming language designed for
-extending applications.  Lua is also frequently used as a
-general-purpose, stand-alone language.  More information on Lua can be
-found at @uref{http://www.lua.org/,The Programming Language Lua}.
-
-@node m4-mode, make-mode, lua-mode, Top
-@chapter Editing m4 Code
-
-This mode is used for editing m4 macro definitions.  It is NOT automatically
-invoked for any particular file extension.  To invoke this mode while editing
-a file, type @code{M-x m4-mode}.
-
-The mode has most of the syntax right (i.e., sexp motion commands work, but
-function motion commands don't).  It also sets up font-lock for colorization.
-
-To configure this package please view the source code.  This can be done by
-typing @kbd{C-x 4 l m4-mode}.
-
-NOTE: The preferred package for editing m4 code is autoconf mode.
-@xref{autoconf-mode}., for details.
-
-@menu
-* About m4: about-m4.
-@end menu
-
-@node about-m4,  , m4-mode, m4-mode
-@section About m4
-
-m4 is a general purpose macro processor that can be used to preprocess C and
-assembly language programs, among other things. Besides the straightforward
-replacement of one string of text by another, m4 lets you perform:
-
-@itemize @bullet
-
-@item integer arithmetic 
-@item file inclusion 
-@item conditional macro expansion 
-@item string and substring manipulation 
-
-@end itemize
-
-@node make-mode, mode-compile, m4-mode, Top
-@chapter Editing Makefiles
-
-This mode is used for editing Makefiles.  It is automatically invoked for
-for buffers visiting the following types of files:
-
-@itemize @bullet
-
-@item any file ending with an extension of @file{.ma?ke?} or @file{.am} 
-
-@item any file named @file{GNU[Mm]akefile} or @file{[Mm]akefile} with an
-extension of @file{.in}.
-
-@item any file that has an interpretor line (the "shebang" line) specifying
-"make".
-
-@end itemize
-
-The mode knows about Makefile syntax and defines @kbd{M-n} and @kbd{M-p} to
-move to next and previous productions.
-
-The keys @kbd{$}, @kbd{=}, @kbd{:} and @kbd{.} are electric; they try to help
-you fill in a macro reference, macro definition, ordinary target name, or
-special target name, respectively.  Such names are completed using a list of
-targets and macro names parsed out of the makefile.  This list is
-automatically updated, if necessary, whenever you invoke one of these
-commands.  You can force it to be updated with @kbd{C-c C-p}.
-
-The command @kbd{C-c C-f} adds certain filenames in the current directory as
-targets.  You can filter out filenames by setting the variable
-@code{makefile-ignored-files-in-pickup-regex}.
-
-The command @kbd{C-c C-u} grinds for a bit, then pops up a report buffer
-showing which target names are up-to-date with respect to their
-prerequisites, which targets are out-of-date, and which have no
-prerequisites.
-
-The command @kbd{C-c C-b} pops up a browser window listing all target and
-macro names.  You can mark or unmark items wit @kbd{C-c SPC}, and insert all
-marked items back in the Makefile with @kbd{C-c TAB}.
-
-The command @kbd{C-c TAB} in the makefile buffer inserts a GNU make builtin.
-You will be prompted for the builtin's args.
-
-The following key mappings are defined:
-
-@multitable {C-c return  } {makefile-browser-insert-selection-and-quit}
-@item @code{C-c}             @tab << Prefix Command >>
-@item @code{M-n}             @tab makefile-next-dependency
-@item @code{M-p}             @tab makefile-previous-dependency
-@item @code{M-tab}           @tab makefile-complete
-@item @code{M-C-i}           @tab makefile-complete
-@item @code{C-c :}           @tab makefile-insert-target-ref
-@item @code{C-c tab}         @tab makefile-insert-gmake-function
-@item @code{C-c C-\}         @tab makefile-backslash-region
-@item @code{C-c C-b}         @tab makefile-switch-to-browser
-@item @code{C-c C-c}         @tab comment-region
-@item @code{C-c C-f}         @tab makefile-pickup-filenames-as-targets
-@item @code{C-c C-i}         @tab makefile-insert-gmake-function
-@item @code{C-c C-p}         @tab makefile-pickup-everything
-@item @code{C-c C-u}         @tab makefile-create-up-to-date-overview
-@end multitable
-
-In the browser, use the following keys:
-
-@multitable {C-c return  } {makefile-browser-insert-selection-and-quit}
-@item @code{I}               @tab makefile-browser-insert-selection-and-quit
-@item @code{i}               @tab makefile-browser-insert-selection
-@item @code{n}               @tab makefile-browser-next-line
-@item @code{p}               @tab makefile-browser-previous-line
-@item @code{q}               @tab makefile-browser-quit
-@item @code{space}           @tab makefile-browser-toggle
-@item @code{C-c}             @tab << Prefix Command >>
-@item @code{C-n}             @tab makefile-browser-next-line
-@item @code{C-p}             @tab makefile-browser-previous-line
-@item @code{C-c return}      @tab makefile-browser-insert-continuation
-@item @code{C-c C-m}         @tab makefile-browser-insert-continuation
-@end multitable
-
-Makefile mode can be configured by modifying the following variables:
-
-@table @code
-
-@item makefile-browser-buffer-name:
-Name of the macro- and target browser buffer.
-
-@item makefile-target-colon:
-The string that gets appended to all target names
-inserted by @code{makefile-insert-target}.
-":" or "::" are quite common values.
-
-@item makefile-macro-assign:
-The string that gets appended to all macro names
-inserted by @code{makefile-insert-macro}.
-The normal value should be " = ", since this is what
-standard make expects.  However, newer makes such as dmake
-allow a larger variety of different macro assignments, so you
-might prefer to use " += " or " := " .
-
-@item makefile-tab-after-target-colon:
-If you want a @code{TAB} (instead of a space) to be appended after the
-target colon, then set this to a non-nil value.
-
-@item makefile-browser-leftmost-column:
-Number of blanks to the left of the browser selection mark.
-
-@item makefile-browser-cursor-column:
-Column in which the cursor is positioned when it moves
-up or down in the browser.
-
-@item makefile-browser-selected-mark:
-String used to mark selected entries in the browser.
-
-@item makefile-browser-unselected-mark:
-String used to mark unselected entries in the browser.
-
-@item makefile-browser-auto-advance-after-selection-p:
-If this variable is set to a non-nil value the cursor
-will automagically advance to the next line after an item
-has been selected in the browser.
-
-@item makefile-pickup-everything-picks-up-filenames-p:
-If this variable is set to a non-nil value then
-@code{makefile-pickup-everything} also picks up filenames as targets
-(i.e. it calls @code{makefile-pickup-filenames-as-targets}), otherwise
-filenames are omitted.
-
-@item makefile-cleanup-continuations-p:
-If this variable is set to a non-nil value then Makefile mode
-will assure that no line in the file ends with a backslash
-(the continuation character) followed by any whitespace.
-This is done by silently removing the trailing whitespace, leaving
-the backslash itself intact.
-IMPORTANT: Please note that enabling this option causes Makefile mode
-to MODIFY A FILE WITHOUT YOUR CONFIRMATION when "it seems necessary".
-
-@item makefile-browser-hook:
-A function or list of functions to be called just before the
-browser is entered. This is executed in the makefile buffer.
-
-@item makefile-special-targets-list:
-List of special targets. You will be offered to complete
-on one of those in the minibuffer whenever you enter a `.'.
-at the beginning of a line in Makefile mode.
-
-@end table
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET makefile RET
-@end example
-
-@menu
-* About Make: about-make.
-@end menu
-
-@node about-make,  , make-mode, make-mode
-@section About Make
-
-A Makefile is used by a `make' utility to automatically determine which
-pieces of a large program need to be recompiled, and to issue the commands to
-recompile them.  @xref{Top, Make, , make, GNU Make Manual}., for details.
-
-@node mode-compile, modula2, make-mode, Top
-@chapter Compiling Files According to Major-Mode
-
-The @code{compile} command is very rudimentary in its creation of its
-compilation command, using "make -k" by default.  This package provides an
-intelligent replacement for the @code{compile} command. @xref{Compilation, ,
-,xemacs, The XEmacs Editor}., for details.
-
-The @code{mode-compile} command functions as a layer above @code{compile}.
-Its purpose is mainly to build a smarter compile command for @code{compile}
-to execute. This compile command is built according to number of parameters:
-
-@itemize @bullet
-
-@item the major-mode
-@item presence or absence of a makefile in the current directory
-@item the @code{buffer-file-name} and extension
-@item contents of the current buffer (`main' function, "#!/path/shell", ...)
-@item and more ... (see below)
-
-@end itemize
-
-Most of these parameters are highly customizable through Emacs Lisp variables
-(to be set in your @code{user-init-file} or through the Customization menu).
-Running @code{mode-compile} after a universal-argument (@kbd{C-u}) allows
-remote compilations; the user is prompted for the host name to execute the
-compilation command.  The @code{mode-compile-kill} function terminates a
-running compilation session launched by @code{mode-compile}.
-
-By default, @code{mode-compile} is very verbose and waits a user-specified
-number of seconds after displaying each message to give the user time to read
-it.  The variables @code{mode-compile-expert-p} and
-@code{mode-compile-reading-time} can be used to change this behaviour.  On
-Windows-based systems, the variable @code{mode-compile-other-frame-p} will
-create a new frame and launch the compilation command in it.
-
-@menu
-* compile-cust::                Customization
-* compile-compilation-mode::    compilation-mode
-* compile-makefile-mode::       makefile-mode
-* compile-emacs-lisp-mode::     emacs-lisp-mode, lisp-interaction-mode
-* compile-dired-mode::          dired-mode
-* compile-sh-mode::             sh-mode, csh-mode, zsh-mode
-* compile-c?perl-mode::         c?perl-mode
-* compile-tcl-mode::            tcl-mode
-* compile-c-mode::              c-mode, c++-mode
-* compile-ada-mode::            ada-mode
-* compile-fortran-mode::        fortran-mode
-* compile-java-mode::           java-mode
-* compile-python-mode::         python-mode
-* compile-message-mode::        message-mode
-* compile-catchall::            Miscellaneous Modes
-@end menu
-
-@node compile-cust, compile-compilation-mode, mode-compile, mode-compile
-@section Customization
-
-This section explains how the @code{compile-command} is built according
-to the @code{major-mode} and how to customize it.  The major modes currently
-supported are:
-
-@multitable {lisp-interaction-mode} {lisp-interaction-mode} {lisp-interaction-mode}
-
-@item ada-mode              @tab c++-mode           @tab c-mode
-@item c?perl-mode           @tab compilation-mode   @tab csh-mode
-@item dired-mode            @tab emacs-lisp-mode    @tab fortran-mode
-@item fundamental-mode      @tab indented-text-mode @tab java-mode
-@item lisp-interaction-mode @tab makefile-mode      @tab python-mode
-@item sh-mode               @tab tcl-mode           @tab text-mode
-@item zsh-mode
-
-@end multitable
-
-For other modes a default behaviour is provided.
-
-When running @code{mode-compile} or @code{mode-compile-kill} the hooks
-@code{mode-compile-(before|after)-(compile|kill)-hook} are executed.  The
-current buffer can be automatically saved if
-@code{mode-compile-always-save-buffer-p} is set to @code{t}.  All the
-modified buffers can be automatically saved if @code{mode-compile-save-all-p}
-is set to @code{t}.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET compilation RET
-@end example
-
-@node compile-compilation-mode, compile-makefile-mode, compile-cust, mode-compile
-@section compilation-mode
-
-Calls @code{compile} with the last compile command.
-
-@node compile-makefile-mode, compile-emacs-lisp-mode, compile-compilation-mode, mode-compile
-@section makefile-mode
-
-The makefile is run with make through @code{compile} (user is prompted for
-the rule to run, see variable @code{mode-compile-preferred-default-makerule}
-to see how a default choice could be selected).
-
-@node compile-emacs-lisp-mode, compile-dired-mode, compile-makefile-mode, mode-compile
-@section emacs-lisp-mode, lisp-interaction-mode
-
-If the buffer is a @file{.el} file we @code{byte-compile} it to produce a
-@file{.elc} file.  Otherwise, just @code{byte-compile} the buffer (this does
-not use @code{compile} but @code{byte-compile}).
-
-@node compile-dired-mode, compile-sh-mode, compile-emacs-lisp-mode, mode-compile
-@section dired-mode
-
-Find a @file{makefile} in the directory and run make with it (like in
-@code{makefile-mode}), else try to @code{byte-recompile} all @file{.el} files
-older than their associated @file{.elc} files (unlike
-@code{byte-recompile-directory} this is not recursive), finally if no
-@file{.el} files are present ask compilation command to user by calling
-@code{default-compile}.  To find a @file{makefile} a regexp is provided which
-name is @code{mode-compile-makefile-regexp}.
-
-@node compile-sh-mode, compile-c?perl-mode, compile-dired-mode, mode-compile
-@section sh-mode, csh-mode, zsh-mode
-
-Run "[cz]?sh" with debugging arguments as specified in
-@code{[cz]?sh-dbg-flags} on the currently edited file.
-
-@node compile-c?perl-mode, compile-tcl-mode, compile-sh-mode, mode-compile
-@section c?perl-mode
-
-Run file with "perl -w" (can step through errors with compile's @code{next-error}
-command).
-
-@node compile-tcl-mode, compile-c-mode, compile-c?perl-mode, mode-compile
-@section tcl-mode
-
-Run file with "wish" (can step through errors with compile's
-@code{next-error} command).
-
-@node compile-c-mode, compile-ada-mode, compile-tcl-mode, mode-compile
-@section c-mode, c++-mode
-
-First it tries to see if there is a @file{makefile} in the
-directory. Makefiles to look for are specified by the variable
-@code{mode-compile-makefile-regexp}.  If yes two cases could happen: there is
-only one makefile so use it, or there is more than one (sometimes when you
-need to write portable soft you could have some makefiles by system:
-SunOs.make, HP.make ...), in that case prompt to user for choice (with smart
-completion).  Once the makefile has been selected it extract the rules from
-it and ask to user to choose a rule to make (with smart completion, see
-variable @code{mode-compile-preferred-default-makerule} to see how a default
-choice could be selected).
-
-There are some cases where no makefiles are present (YES I KNOW this is bad
-practice but you sometimes have no need to write a Makefile). In that case
-the function tries to build the most intelligent compilation command by using
-the favourite user C/C++ compiler: value of environment variable "CC" or
-"CXX" or first found, in the PATH, of compilers specified in variable
-@code{cc-compilers-list} or @code{c++-compilers-list}.  Then it looks for the
-environment variable "CFLAGS" of "CXXFLAGS" to append to the compiler command,
-finds the file to compile: .(c|cc|C|cpp) (see *)
-and asks for confirmation.  If you really trust mode-compile will build the
-correct command and want to bypass confirmation you could set the variable
-@code{mode-compile-never-edit-command-p} to @code{t}.
-
-@node compile-ada-mode, compile-fortran-mode, compile-c-mode, mode-compile
-@section ada-mode
-
-Same as c/c++-mode but run Ada compiler on the Ada file.  There are no
-companion file and no way to find a main function in Ada.
-
-@node compile-fortran-mode, compile-java-mode, compile-ada-mode, mode-compile
-@section fortran-mode
-
-Same as c-mode but run Fortran compiler on .[Ff](or)? files.
-
-@node compile-java-mode, compile-python-mode, compile-fortran-mode, mode-compile
-@section java-mode
-
-Same as c-mode but call "javac" without the -o option on .java files
-
-@node compile-python-mode, compile-message-mode, compile-java-mode, mode-compile
-@section python-mode
-
-Run file with "python" (can step through errors with compile's
-@code{next-error} command).
-
-@node compile-message-mode, compile-catchall, compile-python-mode, mode-compile
-@section message-mode
-
-Run @code{message-send}.
-
-@node compile-catchall,  , compile-message-mode, mode-compile
-@section Miscellaneous Modes
-
-This handles @code{fundamental-mode}, @code{text-mode},
-@code{indented-text-mode} and any unknown modes.
-
-Try to guess what the file is by
-
-@itemize @bullet
-
-@item Looking at its name and extension (see variable
-@code{mode-compile-filename-regexp-alist}).
-
-@item Looking at string "#!/path/shell" at first line to extract shell to run
-the script with (see variable @code{mode-compile-shell-alist}).
-
-@item Looking at a makefile in current directory.
-
-@item Calling @code{compile} with the last compile command which is asked to
-be edited by user
-
-@end itemize
-
-The @code{kill-compile} command is then bound dynamically (buffer-local).
-
-@node modula2, old-c-mode, mode-compile, Top
-@chapter Editing Modula-2 Code
-
-This mode is used for editing Modula-2 code.  It is NOT automatically invoked
-for any particular file extension.  To invoke this mode while editing a file,
-type @code{M-x modula-2-mode}.
-
-The mode provides convenient abbrevs for Modula-2 keywords, knows about the
-standard layout rules, and supports a native compile command.
-
-All control constructs of Modula-2 can be reached by typing C-c followed by
-the first character of the construct.
-
-The following key mappings are defined:
-
-@multitable {C-c C-z suspend Emacs} {Control-c Control-w with}
-@item C-c b begin             @tab C-c c case
-@item C-c d definition        @tab C-c e else
-@item C-c f for               @tab C-c h header
-@item C-c i if                @tab C-c m module
-@item C-c l loop              @tab C-c o or
-@item C-c p procedure         @tab Control-c Control-w with
-@item C-c r record            @tab C-c s stdio
-@item C-c t type              @tab C-c u until
-@item C-c v var               @tab C-c w while
-@item C-c x export            @tab C-c y import
-@item C-c @{ begin-comment    @tab C-c @} end-comment
-@item C-c C-z suspend Emacs   @tab C-c C-t toggle
-@item C-c C-c compile         @tab M-x m2-next-error next-error
-@item C-c C-l link
-@end multitable
-
-Following are some important variables:
-
-@table @code
-@item m2-indent
-controls the number of spaces for each indentation.
-@item m2-compile-command
-holds the command to compile a Modula-2 program.
-@item m2-link-command 
-holds the command to link a Modula-2 program.
-@end table
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET modula2 RET
-@end example
-
-@menu
-* About Modula-2: about-modula2.
-@end menu
-
-@node about-modula2,  , modula2, modula2
-@section About Modula-2
-
-Modula-2 is a programming language developed by Niklaus Wirth at ETH in
-Zurich, Switzerland in the late 70's. Wirth also developed Algol-W, Pascal,
-Modula, and Oberon.
-
-Modula-2 corrects some of the deficiencies of Pascal. It is suitable for
-learning programming, for large projects written and maintained in the
-fashion of professional software engineers, and for real time embedded
-systems. Modula-2 is small, expressive, easy to learn and to read.
-
-@node old-c-mode, p4, modula2, Top
-@chapter Editing C Code
-
-This is a smart editing mode for C code.  It knows a lot about C syntax and
-tries to position the cursor according to C layout conventions.  You can
-change the details of the layout style with option variables.
-
-The mode provides the following features:
-
-@itemize @bullet
-@item Expression and list commands understand all C brackets.
-@item Tab indents for C code.
-@item Comments are delimited with /* ... */.
-@item Paragraphs are separated by blank lines only.
-@item Delete converts tabs to spaces as it moves back.
-@end itemize
-
-The variables controlling indentation style are:
-
-@table @code
-
-@item c-tab-always-indent
-Non-nil means TAB in C mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.
-
-@item c-auto-newline
-Non-nil means automatically newline before and after braces,
-and after colons and semicolons, inserted in C code.
-
-@item c-indent-level
-Indentation of C statements within surrounding block.
-The surrounding block's indentation is the indentation
-of the line on which the open-brace appears.
-
-@item c-continued-statement-offset
-Extra indentation given to a substatement, such as the
-then-clause of an if or body of a while.
-
-@item c-continued-brace-offset
-Extra indentation given to a brace that starts a substatement.
-This is in addition to c-continued-statement-offset.
-
-@item c-brace-offset
-Extra indentation for line if it starts with an open brace.
-
-@item c-brace-imaginary-offset
-An open brace following other text is treated as if it were
-this far to the right of the start of its line.
-
-@item c-argdecl-indent
-Indentation level of declarations of C function arguments.
-
-@item c-label-offset
-Extra indentation for line that is a label, or case or default.
-
-@end table
-
-NOTE: This package has been obsoleted by the cc-mode package (@pxref{Top, CC
-Mode, , cc-mode, CC Mode Manual}).  cc-mode can be quite slow, however, on
-large files, even on fast machines.  This version works with no problems on
-the XEmacs source code and is very very fast.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET old-c RET
-@end example
-
-@node p4, pascal, old-c-mode, Top
-@chapter Integration with Perforce Version Control
-
-This package provides simple integration with Perforce Version Control.
-
-To use this package, add the following line to your @code{user-init-file}:
-
-@example
-  (load-library "p4")
-@end example
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET p4 RET
-@end example
-
-@menu
-* About Perforce: about-perforce.
-@end menu
-
-@node about-perforce,  , p4, p4
-@section About Perforce
-
-The Perforce SCM System features comprehensive software configuration
-management capabilities built around a scalable client/server
-architecture. Requiring only TCP/IP, developers can access the Perforce
-Server through a variety of Perforce clients (Windows GUI, Web, or
-Command-Line). Perforce can be deployed quickly and easily, and requires
-minimal administration1, even for large or distributed sites.
-
-More information on Perforce can be found at @uref{http://www.perforce.com/}.
-
-@node pascal, php-mode, p4, Top
-@chapter Editing Pascal Code
-
-This mode is used for editing Pascal code.  It is automatically invoked for
-buffers visiting any file ending with an extension of @file{.pas}.
-
-The mode provides the following capabilities:
-
-@itemize @bullet
-@item TAB indents for Pascal code.  
-@item Delete converts tabs to spaces as it moves back.
-@item @code{pascal-complete-word} completes the word around current point
-with respect \ to position in code
-@item @code{pascal-show-completions} shows all possible completions at this
-point.
-@end itemize
-
-Other useful functions are:
-
-@table @code
-@item pascal-mark-defun
-Mark function.
-
-@item pascal-insert-block
-insert begin ... end;
-
-@item pascal-star-comment
-insert (* ... *)
-
-@item pascal-comment-area
-Put marked area in a comment, fixing nested comments.
-
-@item pascal-uncomment-area
-Uncomment an area commented with @code{pascal-comment-area}.
-
-@item pascal-beg-of-defun
-Move to beginning of current function.
-
-@item pascal-end-of-defun
-Move to end of current function.
-
-@item pascal-goto-defun
-Goto function prompted for in the minibuffer.
-
-@item pascal-outline
-Enter pascal-outline-mode (see also pascal-outline).
-
-@end table
-
-The variables controlling indentation/edit style are:
-
-@table @code
-
-@item pascal-indent-level
-Indentation of Pascal statements with respect to containing block.
-
-@item pascal-case-indent
-Indentation for case statements.
-
-@item pascal-auto-newline
-Non-nil means automatically newline after semicolons and the punctuation
-mark after an end.
-
-@item pascal-tab-always-indent
-Non-nil means TAB in Pascal mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.
-
-@item pascal-auto-endcomments
-Non-nil means a comment @{ ... @} is set after the ends which ends cases and
-functions. The name of the function or case will be set between the braces.
-
-@item pascal-auto-lineup
-List of contexts where auto lineup of :'s or ='s should be done.
-
-@end table
-
-See also the user variables @code{pascal-type-keywords},
-@code{pascal-start-keywords} and @code{pascal-separator-keywords}.
-
-Turning on Pascal mode calls the value of the variable
-@code{pascal-mode-hook} with no args, if that value is non-nil.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET pascal RET
-@end example
-
-@node php-mode, postscript, pascal, Top
-@chapter Editing PHP Code
-
-PHP mode is a major mode for editing PHP source code.  It is
-automatically invoked for buffers visiting the following files of files:
-
-@itemize @bullet
-@item any file ending with one of the following extensions: @file{.phps},
-@file{.php3}, @file{.php4}
-@item any file ending with the extension @file{.phtml}
-@item any file ending with the extension @file{.inc}
-@end itemize
-
-The mode is an extension of cc-mode; thus it inherits all cc-mode's
-navigation functionality (@pxref{Top, CC Mode, , cc-mode, CC Mode Manual}).
-But it colors according to the PHP grammar and indents according to the PEAR
-coding guidelines.  It also includes a couple of handy IDE-type features such
-as documentation search and a source and class browser.
-
-For colorization, turn on @code{global-font-lock} or add the following to
-your @code{user-init-file}:
-
-@example
-  (add-hook 'php-mode-user-hook 'turn-on-font-lock)
-@end example
-
-To use abbrev-mode, add lines like this to your @code{user-init-file}:
-
-@example
-  (add-hook 'php-mode-user-hook
-    '(lambda () (define-abbrev php-mode-abbrev-table "ex" "extends")))
-@end example
-
-To make php-mode compatible with html-mode, see @uref{http://php-mode.sourceforge.net/}.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET php RET
-@end example
-
-@menu
-* About PHP: about-php.
-@end menu
-
-@node about-php,  , php-mode, php-mode
-@section About PHP
-
-PHP is a widely-used general-purpose scripting language that is especially
-suited for Web development and can be embedded into HTML.  For more
-information, see @uref{http://www.php.net/}.
-
-@node postscript, prolog, php-mode, Top
-@chapter Editing PostScript Programs
-
-This mode is used for editing PostScript programs.  It is automatically
-invoked for buffers visiting any file ending with an extension of @file{.cps}
-or @file{.ps}.
-
-@code{C-c C-c} will send the contents of the buffer to the NeWS server using
-psh(1).  @code{C-c |} sends the current region.  @code{C-c !} starts an
-interactive psh(1) window which will be used for subsequent @code{C-c C-c} or
-@code{C-c |} commands.
-
-In this mode, @code{TAB} and @code{M-C-\} attempt to indent code based on the
-position of @{@}, [], and begin/end pairs.  The variable
-@code{ps-indent-level} controls the amount of indentation used inside arrays
-and begin/end pairs.
-
-The following key mappings are defined:
-
-@multitable {C-c C-c  } {<< Prefix Command >>}
-@item @code{tab}             @tab ps-tab
-@item @code{C-c}             @tab << Prefix Command >>
-@item @code{C-i}             @tab ps-tab
-@item @code{C-c !}           @tab ps-shell
-@item @code{C-c |}           @tab ps-execute-region
-@item @code{C-c C-c}         @tab ps-execute-buffer
-@end multitable
-
-@code{M-x postscript-mode} calls the value of the variable
-@code{postscript-mode-hook} with no args, if that value is non-nil.
-
-To configure this package please view the source code.  This can be done by
-typing @kbd{C-x 4 l postscript}.
-
-@menu
-* About PostScript: about-postscript.
-@end menu
-
-@node about-postscript,  , postscript, postscript
-@section About PostScript
-
-PostScript is a programming language optimized for printing graphics and text
-(whether on paper, film, or CRT is immaterial). In the jargon of the day, it
-is a page description language. It was introduced by Adobe in 1985 and first
-(to my knowledge) appeared in the Apple LaserWriter. The main purpose of
-PostScript was to provide a convenient language in which to describe images
-in a device independent manner. This device independence means that the image
-is described without reference to any specific device features (e.g. printer
-resolution) so that the same description could be used on any PostScript
-printer (say, a LaserWriter or a Linotron) without modification.
-
-@node prolog, rexx-mode, postscript, Top
-@chapter Editing and Running Prolog Code
-
-This mode is used for editing Prolog code.  It is automatically invoked for
-buffers visiting any file ending with an of extension @file{.prolog}.
-
-The mode knows about Prolog syntax and comments, and can send regions to an
-inferior Prolog interpreter process.
-
-Blank lines and `%%...' separate paragraphs.  `%'s start comments.
-
-The following key mappings are defined:
-
-@multitable {M-C-x  } {prolog-consult-region}
-@item @code{tab}             @tab prolog-indent-line
-@item @code{C-i}             @tab prolog-indent-line
-@item @code{M-C-x}           @tab prolog-consult-region
-@end multitable
-
-Entry to this mode calls the value of @code{prolog-mode-hook} if that value
-is non-nil.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET prolog RET
-@end example
-
-@node rexx-mode, rpm-spec-mode, prolog, Top
-@chapter Editing REXX Code
-
-This mode is used for editing REXX code.  It is automatically invoked for
-buffers visiting the following types of files:
-
-@itemize @bullet
-@item any file ending with an extension of @file{.rexx}.  
-@item any file that has an interpretor line (the "shebang" line) specifying "rexx".
-@end itemize
-
-The following key mappings are defined:
-
-@multitable {backspace  } {backward-delete-char-untabify}
-@item @code{backspace}       @tab backward-delete-char-untabify
-@item @code{return}          @tab rexx-indent-and-newline
-@item @code{tab}             @tab rexx-indent-command
-@item @code{C-c}             @tab << Prefix Command >>
-@item @code{C-i}             @tab rexx-indent-command
-@item @code{C-m}             @tab rexx-indent-and-newline
-@item @code{C-c C-c}         @tab rexx-debug
-@item @code{C-c C-p}         @tab rexx-find-matching-do
-@end multitable
-
-The following variables control indentation style:
-
-@table @code
-
-@item rexx-indent
-
-The basic indentation for do-blocks.
-
-@item rexx-end-indent 
-
-The relative offset of the \"end\" statement. 0 places it in the same column
-as the statements of the block. Setting it to the same value as rexx-indent
-places the \"end\" under the do-line.
-
-@item rexx-cont-indent
-
-The indention for lines following \"then\", \"else\" and \",\" (continued)
-lines.
-
-@item rexx-tab-always-indent
-
-Non-nil means TAB in REXX mode should always reindent the current line,
-regardless of where in the line the point is when the TAB command is used.
-
-@end table
-
-If you have set @code{rexx-end-indent} to a nonzero value, you probably want
-to remap @kbd{RETURN} to @code{rexx-indent-newline-indent}. It makes sure
-that lines indents correctly when you press @kbd{RETURN}.
-
-An extensive abbreviation table consisting of all the keywords of REXX are
-supplied.  Expanded keywords are converted into upper case making it easier
-to distinguish them.  To use this feature the buffer must be in
-@code{abbrev-mode}. (See example below.)
-
-Turning on REXX mode calls the value of the variable @code{rexx-mode-hook}
-with no args, if that value is non-nil.
-
-For example:
-
-@example
-  (setq rexx-mode-hook '(lambda ()
-                          (setq rexx-indent 4)
-                          (setq rexx-end-indent 4)
-                          (setq rexx-cont-indent 4)
-                          (local-set-key \"\\C-m\" 'rexx-indent-newline-indent)
-                          (abbrev-mode 1)
-                          ))
-@end example
-
-will make the END aligned with the DO/SELECT.  It will indent blocks and
-IF-statements four steps and make sure that the END jumps into the correct
-position when RETURN is pressed.  Finally it will use the abbrev table to
-convert all REXX keywords into upper case.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET rexx RET
-@end example
-
-@menu
-* About REXX: about-rexx.
-@end menu
-
-@node about-rexx,  , rexx-mode, rexx-mode
-@section About REXX
-
-REXX is a programming language designed by Michael Cowlishaw of IBM UK
-Laboratories.  Rexx is an acronym which stands for "Restructured Extended
-Executor Language".  In Mike's own words: "REXX is a procedural language that
-allows programs and algorithms to be written in a clear and structured way."
-
-@node rpm-spec-mode, simula, rexx-mode, Top
-@chapter Editing RPM Spec Files
-
-This mode is used for editing spec files for building RPM packages.
-It is automatically invoked for buffers visiting any file ending with an
-extension of @file{.spec?}  or @file{.spec.in}.
-
-The mode much like C mode except for the syntax of comments.  It uses the
-same keymap as C mode and has the same variables for customizing indentation.
-It has its own abbrev table and its own syntax table. @xref{Top, CC Mode, ,
-cc-mode, CC Mode Manual}., for details.
-
-Turning on RPM spec mode calls the value of the variable
-@code{rpm-spec-mode-hook} with no args, if that value is non-nil.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET rpm-spec RET
-@end example
-
-@menu
-* About RPM: about-rpm.
-@end menu
-
-@node about-rpm,  , rpm-spec-mode, rpm-spec-mode
-@section About RPM
-
-The RPM Package Manager (RPM) is a powerful command line driven package
-management system capable of installing, uninstalling, verifying, querying,
-and updating computer software packages. Each software package consists of an
-archive of files along with information about the package like its version, a
-description, and the like. There is also a related API ("Application Program
-Interface"), permitting advanced developers to bypass 'shelling out' to a
-command line, and to manage such transactions from within a native coding
-language.
-
-For more information, see @uref{http://www.rpm.org/}.
-
-@node simula, sql, rpm-spec-mode, Top
-@chapter Editing SIMULA 87 Code
-
-This mode is used for editing SIMULA code.  It is NOT automatically
-invoked for any particular file extension.  To invoke this mode while editing
-a file, type @code{M-x simula-mode}.
-
-The mode knows about Simula syntax and standard indentation commands.  It
-also provides convenient abbrevs for Simula keywords.
-
-The following key mappings are defined:
-
-@multitable {C-c C-d  } {simula-forward-down-level}
-@item @code{:}               @tab simula-electric-label
-@item @code{tab}             @tab simula-indent-command
-@item @code{C-c}             @tab << Prefix Command >>
-@item @code{C-i}             @tab simula-indent-command
-@item @code{C-c C-d}         @tab simula-forward-down-level
-@item @code{C-c C-n}         @tab simula-next-statement
-@item @code{C-c C-p}         @tab simula-previous-statement
-@item @code{C-c C-u}         @tab simula-backward-up-level
-@end multitable
-
-The following variables controlling indentation style:
-
-@table @code
-
-@item simula-tab-always-indent
-Non-nil means TAB in SIMULA mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.
-
-@item simula-indent-level
-Indentation of SIMULA statements with respect to containing block.
-
-@item simula-substatement-offset
-Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.
-
-@item simula-continued-statement-offset
-Extra indentation for lines not starting a statement or substatement,
-e.g. a nested FOR-loop.  If value is a list, each line in a multiple-
-line continued statement will have the car of the list extra indentation
-with respect to the previous line of the statement.
-
-@item simula-label-offset -4711
-Offset of SIMULA label lines relative to usual indentation.
-
-@item simula-if-indent '(0 . 0)
-Extra indentation of THEN and ELSE with respect to the starting IF.
-Value is a cons cell, the car is extra THEN indentation and the cdr
-extra ELSE indentation.  IF after ELSE is indented as the starting IF.
-
-@item simula-inspect-indent '(0 . 0)
-Extra indentation of WHEN and OTHERWISE with respect to the
-corresponding INSPECT.  Value is a cons cell, the car is
-extra WHEN indentation and the cdr extra OTHERWISE indentation.
-
-@item simula-electric-indent nil
-If this variable is non-nil, `simula-indent-line'
-will check the previous line to see if it has to be reindented.
-
-@item simula-abbrev-keyword 'upcase
-Determine how SIMULA keywords will be expanded.  Value is one of
-the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table',
-or nil if they should not be changed.
-
-@item simula-abbrev-stdproc 'abbrev-table
-Determine how standard SIMULA procedure and class names will be
-expanded. Value is one of the symbols `upcase', `downcase', `capitalize',
-(as in) `abbrev-table', or nil if they should not be changed.
-
-@end table
-
-Turning on SIMULA mode calls the value of the variable
-@code{simula-mode-hook} with no arguments, if that value is non-nil.
-
-Warning: @code{simula-mode-hook} should not read in an abbrev file without
-calling the function @code{simula-install-standard-abbrevs} afterwards,
-preferably not at all.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET simula RET
-@end example
-
-@menu
-* About SIMULA: about-simula.
-@end menu
-
-@node about-simula,  , simula, simula
-@section About SIMULA
-
-The SIMULA programming language was designed and built by Ole-Johan Dahl and
-Kristen Nygaard at the Norwegian Computing Center (NCC) in Oslo between 1962
-and 1967. It was originally designed and implemented as a language for
-discrete event simulation, but was later extended and reimplemented as a full
-scale general purpose programming language.
-
-For more information, see
-@uref{http://www.engin.umd.umich.edu/CIS/course.des/cis400/simula/simula.html}.
-
-@node sql, tcl, simula, Top
-@chapter Specialized Mode for SQL Interpreters
-
-This package provides a @code{sql-mode} and a @code{sql-interactive-mode}.
-The goals were two simple modes providing syntactic highlighting.  The
-interactive mode had to provide a command-line history; the other mode had to
-provide "send region/buffer to SQL interpreter" functions.  "simple" in this
-context means easy to use, easy to maintain and little or no bells and
-whistles.
-
-@code{sql-interactive-mode} is used to interact with a SQL interpreter
-process in a SQLi buffer (usually called `*SQL*').  The SQLi buffer
-is created by calling a SQL interpreter-specific entry function.  Do
-@emph{not} call @code{sql-interactive-mode} by itself.
-
-The list of currently supported interpreters and the corresponding entry
-function used to create the SQLi buffers is shown with @kbd{M-x sql-help}.
-
-Since @code{sql-interactive-mode} is built on top of the general
-command-interpreter-in-a-buffer mode (comint mode), it shares a common base
-functionality, and a common set of bindings, with all modes derived from
-comint mode.  This makes these modes easier to use.
-
-@code{sql-mode} can be used to keep editing SQL statements.  The SQL
-statements can be sent to the SQL process in the SQLi buffer.
-
-For documentation on the functionality provided by comint mode, and the hooks
-available for customizing it, see the file @file{comint.el}.
-
-Hint for newbies: take a look at @code{dabbrev-expand}, @code{abbrev-mode},
-and @code{imenu-add-menubar-index}.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET SQL RET
-@end example
-
-@node tcl, teco, sql, Top
-@chapter Editing Tcl Code
-
-This mode is used to edit Tcl code.  The mode is automatically invoked
-for buffers visiting the following types of files:
-
-@itemize @bullet
-@item any file ending with an extension of @file{.tcl} or @file{.exp}.  
-@item any file that has an interpretor line (the "shebang" line) specifying
-"scope", "wish", "tcl", "tclsh", or "expect".
-@end itemize
-
-The mode provides the following capabilities:
-
-@itemize @bullet
-@item Expression and list commands understand all Tcl brackets.
-@item Tab indents for Tcl code.
-@item Paragraphs are separated by blank lines only.
-@item Delete converts tabs to spaces as it moves back.
-@end itemize
-
-The variables controlling indentation style are:
-
-@table @code
-
-@item tcl-indent-level
-Indentation of Tcl statements within surrounding block.
-
-@item tcl-continued-indent-level
-Indentation of continuation line relative to first line of command.
-
-@end table
-
-The variables controlling user interaction with mode (see variable
-documentation for details) are:
-
-@table @code
-
-@item tcl-tab-always-indent
-Controls action of TAB key.
-
-@item tcl-auto-newline
-Non-nil means automatically newline before and after braces, brackets,
-and semicolons inserted in Tcl code.
-
-@item tcl-electric-hash-style
-Controls action of `#' key.
-
-@item tcl-use-hairy-comment-detector
-If t, use more complicated, but slower, comment detector.
-This variable is only used in Emacs 19.
-
-@item tcl-use-smart-word-finder
-If not nil, use a smarter, Tcl-specific way to find the current
-word when looking up help on a Tcl command.
-
-@end table
-
-Turning on Tcl mode calls the value of the variable @code{tcl-mode-hook} with
-no args, if that value is non-nil.  Read the documentation for
-@code{tcl-mode-hook} to see what kinds of interesting hook functions already
-exist.
-
-The following key mappings are defined:
-
-@multitable {M-backspace  } {backward-delete-char-untabify}
-@item @code{#}                @tab tcl-electric-hash
-@item @code{;}                @tab tcl-electric-char
-@item @code{[}                @tab tcl-electric-char
-@item @code{]}                @tab tcl-electric-char
-@item @code{@{}               @tab tcl-electric-char
-@item @code{@}}               @tab tcl-electric-brace
-@item @code{delete}           @tab backward-delete-char-untabify
-@item @code{tab}              @tab tcl-indent-command
-@item @code{C-c}              @tab << Prefix Command >>
-@item @code{C-i}              @tab tcl-indent-command
-@item @code{M-;}              @tab tcl-indent-for-comment
-@item @code{M-backspace}      @tab tcl-mark-defun
-@item @code{M-C-a}            @tab tcl-beginning-of-defun
-@item @code{M-C-e}            @tab tcl-end-of-defun
-@item @code{M-C-h}            @tab tcl-mark-defun
-@item @code{M-C-q}            @tab indent-tcl-exp
-@item @code{M-C-x}            @tab tcl-eval-defun
-@item @code{C-c tab}          @tab tcl-help-on-word
-@item @code{C-c C-b}          @tab tcl-submit-bug-report
-@item @code{C-c C-c}          @tab comment-region
-@item @code{C-c C-f}          @tab tcl-load-file
-@item @code{C-c C-i}          @tab tcl-help-on-word
-@item @code{C-c C-s}          @tab switch-to-tcl
-@item @code{C-c C-t}          @tab inferior-tcl
-@item @code{C-c C-v}          @tab tcl-eval-defun
-@item @code{C-c C-x}          @tab tcl-eval-region
-@end multitable
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET tcl RET
-@end example
-
-@menu
-* About Tcl: about-tcl.
-@end menu
-
-@node about-tcl,  , tcl, tcl
-@section About Tcl
-
-Tcl (Tool Command Language) is used by over half a million developers
-worldwide and has become a critical component in thousands of
-corporations. It has a simple and programmable syntax and can be either used
-as a standalone application or embedded in application programs. Best of all,
-Tcl is open source so it's completely free.
-
-Tk is a graphical user interface toolkit that makes it possible to create
-powerful GUIs incredibly quickly. It proved so popular that it now ships with
-all distributions of Tcl.
-
-For more information, see @uref{http://www.tcl.tk/software/tcltk/}.
-
-@node teco, uil-mode, tcl, Top
-@chapter Teco Interpreter
-
-This package implements a Teco Interpreter.
-
-To configure this package please view the source code.  This can be done by
-typing @kbd{C-x 4 l teco}.
-
-@node uil-mode, verilog-mode, teco, Top
-@chapter Editing Motif UIL Code
-
-This mode is used to edit Motif UIL files.  It is automatically invoked
-for buffers visiting any file ending with an extension of @file{.uil}.
-
-This mode is much like C mode except for the syntax of comments.  It uses the
-same keymap as C mode and has the same variables for customizing indentation.
-It has its own abbrev table and its own syntax table. @xref{Top, CC Mode, ,
-cc-mode, CC Mode Manual}., for details.
-
-Turning on uilmode calls the value of the variable @code{uil-mode-hook} with
-no args, if that value is non-nil.
-
-To configure this package please view the source code.  This can be done by
-typing @kbd{C-x 4 l uil-mode}.
-
-@menu
-* About UIL: about-uil.
-@end menu
-
-@node about-uil,  , uil-mode, uil-mode
-@section About UIL
-
-The Motif user interface language (UIL) is a specification language for
-describing the initial state of a Motif application's user interface.
-
-@node verilog-mode, vrml-mode, uil-mode, Top
-@chapter Editing Verilog HDL Source
-
-This mode is used to edit Verilog source files.  It is automatically invoked
-for buffers visiting any file ending with one of the following extensions:
-@file{.vh?}, @file{.dv}, @file{.vlog}, and @file{.verilog}.
-
-The mode provides the following features:
-
-@itemize @bullet
-@item NEWLINE, TAB indents for Verilog code.
-@item Delete converts tabs to spaces as it moves back.
-@item Supports highlighting.
-@end itemize
-
-The variables controlling indentation/edit style are:
-
-@table @code
-
-@item verilog-indent-level
-Indentation of Verilog statements with respect to containing block.
-
-@item verilog-indent-level-module
-Absolute indentation of Module level Verilog statements.
-Set to 0 to get initial and always statements lined up
-on the left side of your screen.
-
-@item  verilog-indent-level-declaration
-Indentation of declarations with respect to containing block.
-Set to 0 to get them list right under containing block.
-
-@item verilog-indent-level-behavioral
-Indentation of first begin in a task or function block
-Set to 0 to get such code to lined up underneath the task or function keyword
-
-@item verilog-indent-level-directive
-Indentation of `ifdef/`endif blocks
-
-@item `verilog-cexp-indent
-Indentation of Verilog statements broken across lines i.e.:
-@example
-  if (a)
-   begin
-@end example
-
-@item verilog-case-indent
-Indentation for case statements.
-
-@item verilog-auto-newline
-Non-nil means automatically newline after semicolons and the punctuation
-mark after an end.
-
-@item verilog-auto-indent-on-newline
-Non-nil means automatically indent line after newline
-
-@item verilog-tab-always-indent
-Non-nil means TAB in Verilog mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.
-
-@item verilog-indent-begin-after-if
-Non-nil means to indent begin statements following a preceding
-if, else, while, for and repeat statements, if any.  otherwise,
-the begin is lined up with the preceding token.  If t, you get:
-@example
-  if (a)
-     begin // amount of indent based on `verilog-cexp-indent'
-@end example
-
-otherwise you get:
-@example
-  if (a)
-  begin
-@end example
-
-@item verilog-auto-endcomments
-Non-nil means a comment /* ... */ is set after the ends which ends
-cases, tasks, functions and modules.
-The type and name of the object will be set between the braces.
-
-@item verilog-minimum-comment-distance
-Minimum distance (in lines) between begin and end required before a comment
-will be inserted.  Setting this variable to zero results in every
-end acquiring a comment; the default avoids too many redundant
-comments in tight quarters.
-
-@item verilog-auto-lineup
-List of contexts where auto lineup of :'s or ='s should be done.
-
-@end table
-
-Turning on Verilog mode calls the value of the variable
-@code{verilog-mode-hook} with no args, if that value is non-nil.
-
-Other useful functions are:
-
-@table @code
-
-@item verilog-complete-word
-complete word with appropriate possibilities (functions, verilog keywords...)
-
-@item verilog-comment-region
-Put marked area in a comment, fixing nested comments.
-
-@item verilog-uncomment-region
-Uncomment an area commented with @code{verilog-comment-region}.
-
-@item verilog-insert-block
-insert begin ... end;
-
-@item verilog-star-comment
-insert /* ... */
-
-@item verilog-mark-defun
-Mark function.
-
-@item verilog-beg-of-defun
-Move to beginning of current function.
-
-@item verilog-end-of-defun
-Move to end of current function.
-
-@item verilog-label-be
-Label matching begin ... end, fork ... join and case ... endcase statements
-
-@item verilog-sk-always
-Insert a always @@(AS) begin .. end block
-
-@item verilog-sk-begin
-Insert a begin .. end block
-
-@item verilog-sk-case
-Insert a case block, prompting for details
-
-@item verilog-sk-else
-Insert an else begin .. end block
-
-@item verilog-sk-for
-Insert a for (...) begin .. end block, prompting for details
-
-@item verilog-sk-generate
-Insert a generate .. endgenerate block
-
-@item verilog-sk-header
-Insert a nice header block at the top of file
-
-@item verilog-sk-initial
-Insert an initial begin .. end block
-
-@item verilog-sk-fork
-Insert a fork begin .. end .. join block
-
-@item verilog-sk-module
-Insert a module .. (/*AUTOARG*/);.. endmodule block
-
-@item verilog-sk-primitive
-Insert a primitive .. (.. );.. endprimitive block
-
-@item verilog-sk-repeat
-Insert a repeat (..) begin .. end block
-
-@item verilog-sk-specify
-Insert a specify .. endspecify block
-
-@item verilog-sk-task
-Insert a task .. begin .. end endtask block
-
-@item verilog-sk-while
-Insert a while (...) begin .. end block, prompting for details
-
-@item verilog-sk-casex
-Insert a casex (...) item: begin.. end endcase block, prompting for details
-
-@item verilog-sk-casez
-Insert a casez (...) item: begin.. end endcase block, prompting for details
-
-@item verilog-sk-if
-Insert an if (..) begin .. end block
-
-@item verilog-sk-else-if
-Insert an else if (..) begin .. end block
-
-@item verilog-sk-comment
-Insert a comment block
-
-@item verilog-sk-assign
-Insert an assign .. = ..; statement
-
-@item verilog-sk-function
-Insert a function .. begin .. end endfunction block
-
-@item verilog-sk-input
-Insert an input declaration, prompting for details
-
-@item verilog-sk-output
-Insert an output declaration, prompting for details
-
-@item verilog-sk-state-machine
-Insert a state machine definition, prompting for details!
-
-@item verilog-sk-inout
-Insert an inout declaration, prompting for details
-
-@item verilog-sk-wire
-Insert a wire declaration, prompting for details
-
-@item verilog-sk-reg
-Insert a register declaration, prompting for details"
-
-@end table
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET verilog-mode RET
-@end example
-
-@menu
-* About Verilog: about-verilog.
-@end menu
-
-@node about-verilog,  , verilog-mode, verilog-mode
-@section About Verilog
-
-Verilog HDL is a hardware description language used to design and document
-electronic systems. Verilog HDL allows designers to design at various levels
-of abstraction. It is the most widely used HDL with a user community of more
-than 50,000 active designers.
-
-For more information, see @uref{http://www.verilog.com/}.
-
-@node vrml-mode, XEmacs License, verilog-mode, Top
-@chapter Editing VRML (.wrl) Files
-
-This mode is used for editing VRML files.  It is automatically invoked for
-buffers visiting any file ending with an extension of @file{.wrl}.
-
-The mode has the following features:
-
-@itemize @bullet
-@item Expression and list commands understand all VRML brackets.
-@item Tab indents for VRML code.
-@item Paragraphs are separated by blank lines only.
-@item Delete converts tabs to spaces as it moves back.
-
-@end itemize
-
-The variables controlling indentation style are:
-
-@table @code
-
-@item vrml-indent-level
-Indentation of VRML statements within surrounding block.
-
-@end table
-
-The variables controlling user interaction with mode (see variable
-documentation for details) are:
-
-@table @code
-
-@item vrml-tab-always-indent
-Controls action of TAB key.
-
-@item vrml-auto-newline
-Non-nil means automatically newline before and after braces
-inserted in VRML code.
-
-@end table
-
-Turning on VRML mode calls the value of the variable @code{vrml-mode-hook}
-with no args, if that value is non-nil.  Read the documentation for
-@code{vrml-mode-hook} to see what kinds of interesting hook functions already
-exist.
-
-To configure this package, type:
-
-@example
-  M-x customize-group RET vrml RET
-@end example
-
-@node XEmacs License,  , vrml-mode, Top
-@chapter XEmacs License
-@unnumbered GNU GENERAL PUBLIC LICENSE
-@center Version 2, June 1991
-
-@display
-Copyright @copyright{} 1989, 1991 Free Software Foundation, Inc.
-675 Mass Ave, Cambridge, MA 02139, USA
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-@end display
-
-@unnumberedsec Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software---to make sure the software is free for all its users.  This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it.  (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.)  You can apply it to
-your programs, too.
-
-  When we speak of free software, we are referring to freedom, not
-price.  Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
-  To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
-  For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have.  You must make sure that they, too, receive or can get the
-source code.  And you must show them these terms so they know their
-rights.
-
-  We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
-  Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software.  If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
-  Finally, any free program is threatened constantly by software
-patents.  We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary.  To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.
-
-@iftex
-@unnumberedsec TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-@end iftex
-@ifinfo
-@center TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-@end ifinfo
-
-@enumerate 0
-@item
-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.
-
-@item
-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.
-
-@item
-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:
-
-@enumerate a
-@item
-You must cause the modified files to carry prominent notices
-stating that you changed the files and the date of any change.
-
-@item
-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.
-
-@item
-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.)
-@end enumerate
-
-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.
-
-@item
-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:
-
-@enumerate a
-@item
-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,
-
-@item
-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,
-
-@item
-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.)
-@end enumerate
-
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@item
-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.
-
-@iftex
-@heading NO WARRANTY
-@end iftex
-@ifinfo
-@center NO WARRANTY
-@end ifinfo
-
-@item
-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.
-
-@item
-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 enumerate
-
-@iftex
-@heading END OF TERMS AND CONDITIONS
-@end iftex
-@ifinfo
-@center END OF TERMS AND CONDITIONS
-@end ifinfo
-
-@page
-@unnumberedsec 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.
-
-@smallexample
-@var{one line to give the program's name and an idea of what it does.}
-Copyright (C) 19@var{yy}  @var{name of author}
-
-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., 675 Mass Ave, Cambridge, MA 02139, USA.
-@end smallexample
-
-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:
-
-@smallexample
-Gnomovision version 69, Copyright (C) 19@var{yy} @var{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.
-@end smallexample
-
-The hypothetical commands @samp{show w} and @samp{show c} should show
-the appropriate parts of the General Public License.  Of course, the
-commands you use may be called something other than @samp{show w} and
-@samp{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:
-
-@smallexample
-@group
-Yoyodyne, Inc., hereby disclaims all copyright
-interest in the program `Gnomovision'
-(which makes passes at compilers) written
-by James Hacker.
-
-@var{signature of Ty Coon}, 1 April 1989
-Ty Coon, President of Vice
-@end group
-@end smallexample
-
-This General Public License does not permit incorporating your program into
-proprietary programs.  If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library.  If this is what you want to do, use the GNU Library General
-Public License instead of this License.
diff --git a/xemacs-packages/man/re-builder/re-builder.texi b/xemacs-packages/man/re-builder/re-builder.texi
deleted file mode 100644
index 22f2438b..00000000
--- a/xemacs-packages/man/re-builder/re-builder.texi
+++ /dev/null
@@ -1,287 +0,0 @@
-\input texinfo   @c -*-texinfo-*-
-
-@c Manual for the XEmacs re-builder package.
-
-@c ** #### something uses these headers, find out how and explain here
-@c %**start of header
-@setfilename re-builder.info
-@settitle Visual development of regular expressions
-@setchapternewpage odd
-@c %**end of header
-
-@c Version values, for easy modification
-@set VERSION 1.2
-@set UPDATED Sunday, July 24, 2005
-
-@c ** Many people seem to prefer this footenote style
-@footnotestyle end
-
-@direntry
-* re-builder::                Write regular expressions with visual feedback.
-@end direntry
-
-@c ** It is often convenient to use a macro for names which have unusual
-@c ** spelling or formatting conventions.
-@c Macro to make formatting of the package name consistent.
-@macro pkgname
-@i{re-builder}
-@end macro
-
-@c Copying permissions, et al
-@c Note that this whole section is repeated thrice, once for the Info
-@c version, once for TeX, and once for HTML.
-@c Note that if you combine this document with others' work, you may
-@c need to change the permissions statement.  Make sure you do so in all
-@c three places.
-@c #### Probably not the right place for HTML.
-@html
-This file documents the @pkgname{} XEmacs package, which provides visual
-feedback when developing regular expressions.
-
-This documentation was taken from the source file, @file{re-builder.el},
-which is subject to the following conditions; because of the nature of
-the GNU GPL, this file is as a result also subject to those conditions. 
-     
-Copyright @copyright{} 1999, 2000, 2001, 2002, 2004 Free Software
-Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
-later version.
-
-GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
-for more details.
-
-You should have received a copy of the GNU General Public License along
-with GNU Emacs; see the file COPYING.  If not, write to the Free
-Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-End of permissions notice.
-@end html
-
-@ifinfo
-This file documents the @pkgname{} XEmacs package, which provides visual
-feedback when developing regular expressions.
-
-This documentation was taken from the source file, @file{re-builder.el},
-which is subject to the following conditions; because of the nature of
-the GNU GPL, this file is as a result also subject to those conditions. 
-     
-Copyright @copyright{} 1999, 2000, 2001, 2002, 2004 Free Software
-Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
-later version.
-
-GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
-for more details.
-
-You should have received a copy of the GNU General Public License along
-with GNU Emacs; see the file COPYING.  If not, write to the Free
-Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-End of permissions notice.
-@end ifinfo
-
-@tex
-
-@titlepage
-@title R
-@subtitle Last updated @value{UPDATED}
-
-@author Detlev Zundel. Texinfo conversion by Aidan Kehoe. 
-@page
-This file documents the @pkgname{} XEmacs package, which provides visual
-feedback when developing regular expressions.
-
-This documentation was taken from the source file, @file{re-builder.el},
-which is subject to the following conditions; because of the nature of
-the GNU GPL, this file is as a result also subject to those conditions. 
-
-@vskip 0pt plus 1filll     
-Copyright @copyright{} 1999, 2000, 2001, 2002, 2004 Free Software
-Foundation, Inc.
-
-This file is part of GNU Emacs.
-
-GNU Emacs is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
-later version.
-
-GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
-for more details.
-
-You should have received a copy of the GNU General Public License along
-with GNU Emacs; see the file COPYING.  If not, write to the Free
-Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-     
-@end titlepage
-@page
-
-@end tex
-
-@ifnottex
-@node Top, Copying, (dir), (dir)
-@top Re-builder on XEmacs
-
-When I have to come up with regular expressions that are more
-complex than simple string matchers, especially if they contain sub
-expressions, I find myself spending quite some time in the
-`development cycle'.  `re-builder' aims to shorten this time span
-so I can get on with the more interesting bits.
-
-With it you can have immediate visual feedback about how well the
-regexp behaves to your expectations on the intended data.
-
-This is version @value{VERSION} of the @pkgname{} manual, last updated on
-@value{UPDATED}.
-
-@end ifnottex
-
-@menu
-* Copying::                     @pkgname{} copying conditions.
-* Overview::                    @pkgname{} history and general information.
-
-For general users:
-* Usage::                       An overview of the operation of @pkgname{}.
-* Regex Types::                 Types of regular expression handled.
-* Questions::                   A couple of selected queries. 
-@end menu
-
-@node Copying, Overview, Top, Top
-@chapter @pkgname{} Copying Conditions
-
-@c ** CHECK THE COPYRIGHT DATE(S) AND HOLDER(S)!
-
-Copyright (C) 1999, 2000, 2001, 2002, 2004 Free Software Foundation, Inc.
-
-@pkgname{} 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.
-
-@pkgname{} 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 XEmacs; see the file COPYING.  If not, write to the
-Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.
-
-@node Overview, Usage, Copying, Top
-@chapter An Overview of @pkgname{}
-
-When I have to come up with regular expressions that are more complex
-than simple string matchers, especially if they contain sub expressions,
-I find myself spending quite some time in the `development cycle'.
-@pkgname{} aims to shorten this time span so I can get on with the more
-interesting bits.
-
-With it you can have immediate visual feedback about how well the regexp
-behaves to your expectations on the intended data.
-
-@node Usage, Regex Types, Overview, Top
-@chapter Operation of @pkgname{}
-
-When called up, with @kbd{M-x re-builder RET}, @pkgname{} attaches
-itself to the current buffer which becomes its target buffer, where all
-the matching is done.  The active window is split so you have a view on
-the data while authoring the RE.  If the edited expression is valid the
-matches in the target buffer are marked automatically with colored
-overlays (for non-color displays see below) giving you feedback over the
-extents of the matched (sub) expressions.  The (non-)validity is shown
-only in the modeline without throwing the errors at you.  If you want to
-know the reason why RE Builder considers it as invalid call
-@kbd{reb-force-update} (@kbd{C-c C-u}) which should reveal the error.
-
-The target buffer can be changed with @code{reb-change-target-buffer}
-(@kbd{C-c C-b}).  Changing the target buffer automatically removes
-the overlays from the old buffer and displays the new one in the
-target window.
-
-@pkgname{} keeps the focus while updating the matches in the target
-buffer so corrections are easily incorporated.  If you are satisfied
-with the result you can paste the RE to the kill-ring with
-@code{reb-copy} (@kbd{C-c C-w}) (the copied RE and current syntax is
-displayed in the echo area), quit @pkgname{} (@kbd{C-c C-q}) and use
-it wherever you need it.
-
-As the automatic updates can take some time on large buffers, they can
-be limited by @code{reb-auto-match-limit} so that they should not have a
-negative impact on the editing.  Setting it to nil makes even the auto
-updates go all the way.  Forcing an update overrides this limit allowing
-an easy way to see all matches.
-
-@node Regex Types, Questions, Usage, Top
-@chapter Regex Types
-
-Currently @pkgname{} understands six different forms of input, namely
-@code{lisp-re}, @code{perl}, @code{read}, @code{rx}, @code{sregex},
-and @code{string} syntax.  Read syntax and string syntax are both
-delimited by @code{"}s and behave according to their name.  With the
-@code{perl} and @code{string} syntax there's no need to escape the
-backslashes and double quotes simplifying the editing somewhat.  The
-other four allow editing of symbolic regular expressions supported by
-the packages of the same name.  (@code{lisp-re} is a package by me and
-its support may go away as it is nearly the same as the @code{sregex}
-package in Emacs)
-
-Note that the @code{sregex,} @code{rx} and @code{lisp-re} syntaxes will
-only be available in XEmacs if you've installed them yourself.
-
-Editing symbolic expressions is done through a major mode derived
-from @code{emacs-lisp-mode} so you'll get all the good stuff like
-automatic indentation and font-locking etc.
-
-When editing a symbolic regular expression, only the first expression
-in the RE Builder buffer is considered, which helps limiting the
-extent of the expression like the @code{"}s do for the text modes.
-For the @code{sregex} syntax the function @code{sregex} is applied to
-the evaluated expression read.  So you can use quoted arguments with
-something like '("findme") or you can construct arguments to your
-heart's content with a valid ELisp expression.  The compiled string
-form will be copied by @code{reb-copy}.  If you want to take a glance
-at the corresponding string you can temporarily change the input
-syntax using @code{reb-change-syntax} (@kbd{C-c C-i}).  The current RE
-syntax is also displayed in the modeline.
-
-Changing the input syntax is transparent (for the obvious exception
-non-symbolic -> symbolic) so you can change your mind as often as you
-like.
-
-There is also a shortcut function, @code{reb-toggle-case} (@kbd{C-c
-C-c}), for toggling the @code{case-fold-search} variable in the target
-buffer with an immediate update.
-
-@node Questions, , Regex Types, Top
-@chapter Questions
-
-Q: But what if my display cannot show colored overlays?
-
-A: Then the cursor will flash around the matched text making it stand
-out.
-
-Q: But how can I then make out the sub-expressions?
-
-A: That's where the `sub-expression mode' comes in.  In it only the
-digit keys are assigned to perform an update that will flash the
-corresponding subexp only.
diff --git a/xemacs-packages/man/speedbar/speedbar.texi b/xemacs-packages/man/speedbar/speedbar.texi
deleted file mode 100644
index 1b60ece0..00000000
--- a/xemacs-packages/man/speedbar/speedbar.texi
+++ /dev/null
@@ -1,1296 +0,0 @@
-\input texinfo   @c -*-texinfo-*-
-@c
-@c $Id: speedbar.texi,v 1.6 2002/08/09 22:08:30 youngs Exp $
-@c
-
-@c This file is part of GNU Emacs
-
-@c GNU Emacs is free software; you can redistribute it and/or modify it
-@c under the terms of the GNU General Public License as published by the
-@c Free Software Foundation; either version 2 of the License, or (at
-@c your option) any later version.
-
-@c GNU Emacs is distributed in the hope that it will be useful, but
-@c WITHOUT ANY WARRANTY; without even the implied warranty of
-@c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-@c General Public License for more details.
-
-@c You should have received a copy of the GNU General Public License
-@c along with Emacs; see the file COPYING.  If not, write to the Free
-@c Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-@setfilename speedbar.info
-@settitle Speedbar: File/Tag summarizing utility
-
-@dircategory Emacs
-@direntry
-* Speedbar: (speedbar).        File/Tag summarizing utility.
-@end direntry
-@ifnottex
-Copyright @copyright{} 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
-
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with the
-Invariant Sections being ``The GNU Manifesto'', ``Distribution'' and
-``GNU GENERAL PUBLIC LICENSE'', with the Front-Cover texts being ``A GNU
-Manual'', and with the Back-Cover Texts as in (a) below.  A copy of the
-license is included in the section entitled ``GNU Free Documentation
-License'' in the Emacs manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software.  Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License.  If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-@end ifnottex
-
-@titlepage
-@sp 10
-@center @titlefont{Speedbar}
-@sp 2
-@center Eric Ludlam
-@vskip 0pt plus 1 fill
-@page
-@vskip 0pt plus 1filll
-Copyright @copyright{} 1999, 2000 Free Software Foundation, Inc.
-@sp 1
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with the
-Invariant Sections being ``The GNU Manifesto'', ``Distribution'' and
-``GNU GENERAL PUBLIC LICENSE'', with the Front-Cover texts being ``A GNU
-Manual'', and with the Back-Cover Texts as in (a) below.  A copy of the
-license is included in the section entitled ``GNU Free Documentation
-License'' in the Emacs manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software.  Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License.  If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-@end titlepage
-
-@syncodeindex fn cp
-
-@node Top, , , (dir)Top
-@comment  node-name,  next,  previous,  up
-
-Speedbar is a program for Emacs which can be used to summarize
-information related to the current buffer.  Its original inspiration
-is the `explorer' often used in modern development environments, office
-packages, and web browsers.
-
-Speedbar displays a narrow frame in which a tree view is shown.  This
-tree view defaults to containing a list of files and directories.  Files
-can be `expanded' to list tags inside. Directories can be expanded to
-list the files within itself.  Each file or tag can be jumped to
-immediately.
-
-Speedbar expands upon `explorer' windows by maintaining context with the
-user.  For example, when using the file view, the current buffer's file
-is highlighted.  Speedbar also mimics the explorer windows by providing
-multiple display modes.  These modes come in two flavors.  Major display
-modes remain consistent across buffers, and minor display modes appear
-only when a buffer of the applicable type is shown.  This allows
-authors of other packages to provide speedbar summaries customized to
-the needs of that mode.
-
-Throughout this manual, activities are defined as `clicking on', or
-`expanding' items.  Clicking means using using @kbd{Mouse-2} on a
-button.  Expanding refers to clicking on an expansion button to display
-an expanded summary of the entry the expansion button is
-on.  @xref{Basic Navigation}.
-
-@menu
-* Introduction::     Basics of speedbar.
-* Basic Navigation:: Basics of speedbar common between all modes.
-* File Mode::        Summarizing files.
-* Buffer Mode::      Summarizing buffers.
-* Minor Modes::      Additional minor modes such as Info and RMAIL.
-* Customizing::      Changing speedbar behavior.
-* Extending::        Extend speedbar for your own project.
-* Index::
-@end menu
-
-@node Introduction, Basic Navigation, , Top
-@comment  node-name,  next,  previous,  up
-@chapter Introduction
-@cindex introduction
-
-To start using speedbar use the command @kbd{M-x speedbar RET} or select
-it from the Tools menu in versions of Emacs with speedbar installed by
-default.  This command will open a new frame to summarize the local
-files.  On X Window systems or on MS-Windows, speedbar's frame is twenty
-characters wide, and will mimic the height of the frame from which it
-was started.  It positions itself to the left or right of the frame you
-started it from.
-
-To use speedbar effectively, it is important to understand its
-relationship with the frame you started it from.  This frame is the
-@dfn{attached frame} which speedbar will use as a reference point.  Once
-started, speedbar watches the contents of this frame, and attempts to
-make its contents relevant to the buffer loaded into the attached
-frame.  In addition, all requests made in speedbar that require the
-display of another buffer will display in the attached frame.
-
-When used in terminal mode, the new frame appears the same size as the
-terminal.  Since it is not visible while working in the attached frame,
-speedbar will save time by using the @dfn{slowbar mode}, where no tracking is
-done until speedbar is requested to show itself (i.e., the speedbar's
-frame becomes the selected frame).
-
-@cindex @code{speedbar-get-focus}
-The function to use when switching between frames using the keyboard is
-@code{speedbar-get-focus}.  This function will toggle between frames, and
-it's useful to bind it to a key in terminal mode.  @xref{Customizing}.
-
-@node Basic Navigation, File Mode, Introduction, Top
-@comment  node-name,  next,  previous,  up
-@chapter Basic Navigation
-
-Speedbar can display different types of data, and has several display
-and behavior modes.  These modes all have a common behavior, menu
-system, and look.  If one mode is learned, then the other modes are easy
-to use.
-
-@menu
-* Basic Key Bindings::
-* Basic Visuals::
-* Mouse Bindings::
-* Displays Submenu::
-@end menu
-
-@node Basic Key Bindings, Basic Visuals, Basic Navigation, Basic Navigation
-@comment  node-name,  next,  previous,  up
-@section Basic Key Bindings
-@cindex key bindings
-
-These key bindings are common across all modes:
-
-@table @kbd
-@item delete, SPC
-@cindex scrolling in speedbar
-Scroll up and down one page.
-@item Q
-@cindex quitting speedbar
-Quit speedbar, and kill the frame.
-@item q
-Quit speedbar, and hide the frame.  This makes it faster to restore the
-speedbar frame, than if you press @kbd{Q}.
-@item g
-@cindex refresh speedbar display
-Refresh whatever contents are in speedbar.
-@item t
-@cindex slowbar mode
-Toggle speedbar to and from slowbar mode.  In slowbar mode, frame
-tracking is not done.
-@item n
-@itemx p
-@cindex navigation
-Move, respectively, to the next or previous item.  A summary of that
-item will be displayed in the attached frame's minibuffer.
-@item M-n
-@itemx M-p
-Move to the next or previous item in a restricted fashion.  If a list is
-open, the cursor will skip over it.  If the cursor is in an open list,
-it will not leave it.
-@item C-M-n
-@itemx C-M-n
-Move forwards and backwards across extended groups.  This lets you
-quickly skip over all files, directories, or other common sub-items at
-the same current depth.
-@item C-x b
-Switch buffers in the attached frame.
-@end table
-
-Speedbar can handle multiple modes.  Two are provided by default.
-These modes are File mode, and Buffers mode.  There are accelerators to
-switch into these different modes.
-
-@cindex mode switching hotkeys
-@table @kbd
-@item b
-Switch into Quick Buffers mode (@pxref{Buffer Mode}).  After one use, the
-previous display mode is restored.
-@item f
-Switch into File mode.
-@item r
-Switch back to the previous mode.
-@end table
-
-Some modes provide groups, lists and tags.  @xref{Basic Visuals}.  When
-these are available, some additional common bindings are available.
-
-@cindex common keys
-@table @kbd
-@item RET
-@itemx e
-Edit/Open the current group or tag.  This behavior is dependent on the
-mode.  In general, files or buffers are opened in the attached frame,
-and directories or group nodes are expanded locally.
-@item +
-@itemx =
-Expand the current group, displaying sub items.
-When used with a prefix argument, any data that may have been cached is
-flushed.  This is similar to a power click.  @xref{Mouse Bindings}.
-@item -
-Contract the current group, hiding sub items.
-@end table
-
-@node Basic Visuals, Mouse Bindings, Basic Key Bindings, Basic Navigation
-@comment  node-name,  next,  previous,  up
-@section Basic Visuals
-@cindex visuals
-
-Speedbar has visual cues for indicating different types of data.  These
-cues are used consistently across the different speedbar modes to make
-them easier to interpret.
-
-At a high level, in File mode, there are directory buttons, sub
-directory buttons, file buttons, tag buttons, and expansion buttons.
-This makes it easy to use the mouse to navigate a directory tree, and
-quickly view files, or a summary of those files.
-
-The most basic visual effect used to distinguish between these button
-types is color and mouse highlighting.  Anything the mouse highlights
-can be clicked on and is called a button (@pxref{Mouse Bindings}).
-Anything not highlighted by the mouse will not be clickable.
-
-Text in speedbar consists of four different types of data.  Knowing how
-to read these textual elements will make it easier to navigate by
-identifying the types of data available.
-
-@subsubsection Groups
-@cindex groups
-
-Groups summarize information in a single line, and provide a high level
-view of more complex systems, like a directory tree, or manual chapters.
-
-Groups appear at different indentation levels, and are prefixed with a
-@samp{+} in some sort of `box'.  The group name will summarize the
-information within it, and the expansion box will display that
-information inline.  In File mode, directories and files are `groups'
-where the @samp{+} is surrounded by brackets like this:
-
-@example
-<+> include
-<-> src
- [+] foo.c
-@end example
-
-In this example, we see both open and closed directories, in addition to
-a file.  The directories have a box consisting of angle brackets, and a
-file uses square brackets.
-
-In all modes, a group can be `edited' by pressing @kbd{RET}, meaning a
-file will be opened, or a directory explicitly opened in speedbar.  A
-group can be expanded or contracted using @kbd{+} or
-@kbd{-}.  @xref{Basic Key Bindings}.
-
-Sometimes groups may have a @samp{?} in its indicator box.  This means
-that it is a group type, but there are no contents, or no known way of
-extracting contents of that group.
-
-When a group has been expanded, the indicator button changes from
-@samp{+} to @samp{-}.  This indicates that the contents are being shown.
-Click the @samp{-} button to contract the group, or hide the contents
-currently displayed.
-
-@subsubsection Tags
-@cindex tags
-
-Tags are the leaf nodes of the tree system.  Tags are generally prefixed
-with a simple character, such as @samp{>}.  Tags can only be jumped to using
-@kbd{RET} or @kbd{e}.
-
-@subsubsection Boolean Flags
-
-Sometimes a group or tag is given a boolean flag.  These flags appear as
-extra text characters at the end of the line.  File mode uses boolean
-flags, such as a @samp{*} to indicate that a file has been checked out
-of a versioning system.
-
-For additional flags, see
-@c Note to self, update these to sub-nodes which are more relevant.
-@ref{File Mode}, and @ref{Version Control}.
-
-@subsubsection Unadorned Text
-
-Unadorned text generally starts in column 0, without any special symbols
-prefixing them.  In Buffers mode different buffer groups are prefixed
-with a description of what the following buffers are (Files, scratch
-buffers, and invisible buffers.)
-
-Unadorned text will generally be colorless, and not clickable.
-
-@subsubsection Color Cues
-
-Each type of Group, item indicator, and label is given a different
-color.  The colors chosen are dependent on whether the background color
-is light or dark.
-Of important note is that the `current item', which may be a buffer or
-file name, is highlighted red, and underlined.
-
-Colors can be customized from the group @code{speedbar-faces}.  Some
-modes, such as for Info, will use the Info colors instead of default
-speedbar colors as an indication of what is currently being displayed.
-
-The face naming convention mirrors the File display mode.  Modes which
-do not use files will attempt to use the same colors on analogous
-entries.
-
-@node Mouse Bindings, Displays Submenu, Basic Visuals, Basic Navigation
-@comment  node-name,  next,  previous,  up
-@section Mouse Bindings
-@cindex mouse bindings
-
-The mouse has become a common information navigation tool.  Speedbar
-will use the mouse to navigate file systems, buffer lists, and other
-data.  The different textual cues provide buttons which can be clicked
-on (@pxref{Basic Visuals}).  Anything that highlights can be clicked on
-with the mouse, or affected by the menu.
-
-The mouse bindings are:
-
-@table @kbd
-@item Mouse-1
-Move cursor to that location.
-@item Mouse-2
-@itemx Double-Mouse-1
-Activate the current button.  @kbd{Double-Mouse-1} is called a @dfn{double
-click} on other platforms, and is useful for windows users with two
-button mice.
-@c Isn't it true that with two-button mice, the right button is Mouse-2?
-@c On GNU/Linux, the right button is Mouse-3.
-@item S-Mouse-2
-@itemx S-Double-Mouse-1
-@cindex power click
-This has the same effect as @kbd{Mouse-2}, except it is called a power
-click.  This means that if a group with an expansion button @samp{+} is
-clicked, any caches are flushed, and subitems re-read.  If it is a name,
-it will be opened in a new frame.
-@item Mouse-3
-Activate the speedbar menu.  The item selected affects the line clicked,
-not the line where the cursor was.
-@item Mouse-1 @r{(mode line)}
-Activate the menu.  This affects the item the cursor is on before the
-click, since the mouse was not clicked on anything.
-@item C-Mouse-1
-Buffers sub-menu.  The buffer in the attached frame is switched.
-@end table
-
-When the mouse moves over buttons in speedbar, details of that item
-should be displayed in the minibuffer of the attached frame.  Sometimes
-this can contain extra information such as file permissions, or tag
-location.
-
-@node Displays Submenu, , Mouse Bindings, Basic Navigation
-@comment  node-name,  next,  previous,  up
-@section Displays Submenu
-@cindex displays submenu
-
-You can display different data by using different display modes.  These
-specialized modes make it easier to navigate the relevant pieces of
-information, such as files and directories, or buffers.
-
-In the main menu, found by clicking @kbd{Mouse-3}, there is a submenu
-labeled @samp{Displays}.  This submenu lets you easily choose between
-different display modes.
-
-The contents are modes currently loaded into emacs.  By default, this
-would include Files, Quick Buffers, and Buffers.  Other major display
-modes such as Info are loaded separately.
-
-@node File Mode, Buffer Mode, Basic Navigation, Top
-@comment  node-name,  next,  previous,  up
-@chapter File Mode
-@cindex file mode
-
-File mode displays a summary of your current directory.  You can display
-files in the attached frame, or summarize the tags found in files.  You
-can even see if a file is checked out of a version control system, or
-has some associated object file.
-
-Advanced behavior, like copying and renaming files, is also provided.
-
-@menu
-* Directory Display::   What the display means.
-* Hidden Files::        How to display hidden files.
-* File Key Bindings::   Performing file operations.
-@end menu
-
-@node Directory Display, Hidden Files, File Mode, File Mode
-@comment  node-name,  next,  previous,  up
-@section Directory Display
-@cindex directory display
-
-There are three major sections in the display.  The first line or two is
-the root directory speedbar is currently viewing.  You can jump to one
-of the parent directories by clicking on the name of the directory you
-wish to jump to.
-
-Next, directories are listed.  A directory starts with the group
-indicator button @samp{<+>}.  Clicking the directory name makes speedbar
-load that directory as the root directory for its display.  Clicking the
-@samp{<+>} button will list all directories and files beneath.
-
-Next, files are listed.  Files start with the group indicator @samp{[+]}
-or @samp{[?]}.  You can jump to a file in the attached frame by clicking
-on the file name.  You can expand a file and look at its tags by
-clicking on the @samp{[+]} symbol near the file name.
-
-A typical session might look like this:
-
-@example
-~/lisp/
-<+> checkdoc
-<+> eieio
-<-> speedbar
- [+] Makefile
- [+] rpm.el #
- [+] sb-gud.el #
- [+] sb-info.el #
- [+] sb-rmail.el #
- [+] sb-w3.el
- [-] speedbar.el *!
-  @{+@} Types
-  @{+@} Variables
-  @{+@} def (group)
-  @{+@} speedbar-
- [+] speedbar.texi *
-<+> testme
-[+] align.el
-[+] autoconf.el
-@end example
-
-In this example, you can see several directories.  The directory
-@file{speedbar} has been opened inline.  Inside the directory
-@file{speedbar}, the file @file{speedbar.el} has its tags exposed.
-These tags are extensive, and they are summarized into tag groups.
-
-Files get additional boolean flags associated with them.  Valid flags are:
-
-@cindex file flags
-@table @code
-@item *
-This file has been checked out of a version control
-system.  @xref{Version Control}.
-@cindex @code{speedbar-obj-alist}
-@item #
-This file has an up to date object file associated with it.  The
-variable @code{speedbar-obj-alist} defines how speedbar determines this
-value.
-@item !
-This file has an out of date object file associated with it.
-@end table
-
-A Tag group is prefixed with the symbol @samp{@{+@}}.  Clicking this
-symbol will show all symbols that have been organized into that group.
-Different types of files have unique tagging methods as defined by their
-major mode.  Tags are generated with either the @code{imenu} package, or
-through the @code{etags} interface.
-
-Tag groups are defined in multiple ways which make it easier to find the
-tag you are looking for.  Imenu keywords explicitly create groups, and
-speedbar will automatically create groups if tag lists are too long.
-
-In our example, Imenu created the groups @samp{Types} and
-@samp{Variables}.  All remaining top-level symbols are then regrouped
-based on the variable @code{speedbar-tag-hierarchy-method}.  The
-subgroups @samp{def} and @samp{speedbar-} are groupings where the first
-few characters of the given symbols are specified in the group name.
-Some group names may say something like @samp{speedbar-t to speedbar-v},
-indicating that all symbols which alphabetically fall between those
-categories are included in that sub-group.  @xref{Tag Hierarchy Methods}.
-
-@node Hidden Files, File Key Bindings, Directory Display, File Mode
-@comment  node-name,  next,  previous,  up
-@section Hidden Files
-@cindex hidden files
-
-On GNU and Unix systems, a hidden file is a file whose name starts
-with a period.  They are hidden from a regular directory listing
-because the user is not generally interested in them.
-
-In speedbar, a hidden file is a file which isn't very interesting and
-might prove distracting to the user.  Any uninteresting files are
-removed from the File display.  There are two levels of uninterest in
-speedbar.  The first level of uninterest are files which have no
-expansion method, or way of extracting tags.  You can define which
-files are interesting with
-@code{speedbar-supported-extension-expressions}.  The second level is
-any file that matches the same pattern used for completion in
-@code{find-file}.  This is derived from the variable
-@code{completion-ignored-extensions}.  This filter will override the
-supported extensions, so beif you add something to be supported, and
-it doesn't appear, check for this.
-
-You can toggle the display of uninteresting files from the toggle menu
-item @samp{Show All Files}.  This will display all level one hidden files.
-These files will be shown with a @samp{?} indicator.  Level 2 hidden
-files will still not be shown.
-
-Object files fall into the category of level 2 hidden files.  You can
-determine their presence by the @samp{#} and @samp{!} file indicators.
-@xref{Directory Display}.
-
-@node File Key Bindings, , Hidden Files, File Mode
-@comment  node-name,  next,  previous,  up
-@section File Key Bindings
-@cindex file key bindings
-
-File mode has key bindings permitting different file system operations
-such as copy or rename.  These commands all operate on the @dfn{current
-file}.  In this case, the current file is the file at point, or clicked
-on when pulling up the menu.
-
-@table @kbd
-@item U
-Move the entire speedbar display up one directory.
-@item I
-Display information in the minibuffer about this line.  This is the same
-information shown when navigating with @kbd{n} and @kbd{p}, or moving
-the mouse over an item.
-@item B
-Byte compile the Emacs Lisp file on this line.
-@item L
-Load the Emacs Lisp file on this line.  If a @file{.elc} file exists,
-optionally load that.
-@item C
-Copy the current file to some other location.
-@item R
-Rename the current file, possibly moving it to some other location.
-@item D
-Delete the current file.
-@item O
-Delete the current file's object file.  Use the symbols @samp{#} and
-@samp{!} to determine if there is an object file available.
-@end table
-
-One menu item toggles the display of all available files.  By default,
-only files which Emacs understands, and knows how to convert into a tag
-list, are shown.  By showing all files, additional files such as text files are
-also displayed, but they are prefixed with the @samp{[?]} symbol.  This
-means that it is a file, but Emacs doesn't know how to expand it.
-
-@node Buffer Mode, Minor Modes, File Mode, Top
-@comment  node-name,  next,  previous,  up
-@chapter Buffer Mode
-@cindex buffer mode
-
-Buffer mode is very similar to File mode, except that instead of
-tracking the current directory and all files available there, the
-current list of Emacs buffers is shown.
-
-These buffers can have their tags expanded in the same way as files,
-and uses the same unknown file indicator (@pxref{File Mode}).
-
-Buffer mode does not have file operation bindings, but the following
-buffer specific key bindings are available:
-
-@table @kbd
-@item k
-Kill this buffer.  Do not touch its file.
-@item r
-Revert this buffer, reloading from disk.
-@end table
-
-In addition to Buffer mode, there is also Quick Buffer mode.  In fact,
-Quick Buffers is bound to the @kbd{b} key.  The only difference between
-Buffers and Quick Buffers is that after one operation  is performed
-which affects the attached frame, the display is immediately reverted to
-the last displayed mode.
-
-Thus, if you are in File mode, and you need quick access to a buffer,
-press @kbd{b}, click on the buffer you want, and speedbar will revert
-back to File mode.
-
-@node Minor Modes, Customizing, Buffer Mode, Top
-@comment  node-name,  next,  previous,  up
-@chapter Minor Display Modes
-@cindex minor display modes
-
-For some buffers, a list of files and tags makes no sense.  This could
-be because files are not currently in reference (such as web pages), or
-that the files you might be interested have special properties (such as
-email folders.)
-
-In these cases, a minor display mode is needed.  A minor display mode
-will override any major display mode currently being displayed for the
-duration of the specialized buffer's use.  Minor display modes
-will follow the general rules of their major counterparts in terms of
-key bindings and visuals, but will have specialized behaviors.
-
-@menu
-* RMAIL::  Managing folders in speedbar
-* Info::   Browsing topics in speedbar
-* GDB::    Managing the current stack trace in speedbar
-@end menu
-
-@node RMAIL, Info, Minor Modes, Minor Modes
-@comment  node-name,  next,  previous,  up
-@section RMAIL
-@cindex RMAIL
-
-When using RMAIL, speedbar will display two sections.  The first is a
-layer one reply button.  Clicking here will initialize a reply buffer
-showing only this email address in the @samp{To:} field.
-
-The second section lists all RMAIL folders in the same directory as your
-main RMAIL folder.  The general rule is that RMAIL folders always appear
-in all caps, or numbers.  It is possible to save mail in folders with
-lower case letters, but there is no clean way of detecting such RMAIL folders
-without opening them all.
-
-Each folder can be visited by clicking the name.  You can move mail from
-the current RMAIL folder into a different folder by clicking the
-@samp{} button.  The @samp{M} stands for Move.
-
-In this way you can manage your existing RMAIL folders fairly easily
-using the mouse.
-
-@node Info, GDB, RMAIL, Minor Modes
-@comment  node-name,  next,  previous,  up
-@section Info
-@cindex Info
-
-When browsing Info files, all local relevant information is displayed in
-the info buffer and a topical high-level view is provided in speedbar.
-All top-level info nodes are shown in the speedbar frame, and can be
-jumped to by clicking the name.
-
-You can open these nodes with the @samp{[+]} button to see what sub-topics
-are available.  Since these sub-topics are not examined until you click
-the @samp{[+]} button, sometimes a @samp{[?]} will appear when you click on
-a @samp{[+]}, indicating that there are no sub-topics.
-
-@node GDB, , Info, Minor Modes
-@comment  node-name,  next,  previous,  up
-@section GDB
-@cindex gdb
-@cindex gud
-
-If you are debugging an application with GDB in Emacs, speedbar can show
-you the current stack when the current buffer is the @file{*gdb*}
-buffer.  Usually, it will just report that there is no stack, but when
-the application is stopped, the current stack will be shown.
-
-You can click on any stack element and gdb will move to that stack
-level.  You can then check variables local to that level at the GDB
-prompt.
-
-This mode has the unfortunate side-effect of breaking GDB's repeat
-feature when you hit @kbd{RET} since your previous command is overridden
-with a stack fetching command.
-
-@node Customizing, Extending, Minor Modes, Top
-@comment  node-name,  next,  previous,  up
-@chapter Customizing
-@cindex customizing
-
-Speedbar is highly customizable, with a plethora of control elements.
-Since speedbar is so visual and reduces so much information, this is an
-important aspect of its behavior.
-
-In general, there are three custom groups you can use to quickly modify
-speedbar's behavior.
-
-@table @code
-@item speedbar
-Basic speedbar behaviors.
-@item speedbar-vc
-Customizations regarding version control handling.
-@item speedbar-faces
-Customize speedbar's many colors and fonts.
-@end table
-
-@menu
-* Frames and Faces::        Visible behaviors.
-* Tag Hierarchy Methods::   Customizing how tags are displayed.
-* Version Control::         Adding new VC detection modes.
-* Hooks::                   The many hooks you can use.
-@end menu
-
-@node Frames and Faces, Tag Hierarchy Methods, Customizing, Customizing
-@comment  node-name,  next,  previous,  up
-@section Frames and Faces
-@cindex faces
-@cindex frame parameters
-
-There are several faces speedbar generates to provide a consistent
-color scheme across display types.  You can customize these faces using
-your favorite method.  They are:
-
-@table @asis
-@cindex @code{speedbar-button-face}
-@item speedbar-button-face
-Face used on expand/contract buttons.
-@cindex @code{speedbar-file-face}
-@item speedbar-file-face
-Face used on Files.  Should also be used on non-directory like nodes.
-@cindex @code{speedbar-directory-face}
-@item speedbar-directory-face
-Face used for directories, or nodes which consist of groups of other nodes.
-@cindex @code{speedbar-tag-face}
-@item speedbar-tag-face
-Face used for tags in a file, or for leaf items.
-@cindex @code{speedbar-selected-face}
-@item speedbar-selected-face
-Face used to highlight the selected item.  This would be the current
-file being edited.
-@cindex @code{speedbar-highlight-face}
-@item speedbar-highlight-face
-Face used when the mouse passes over a button.
-@end table
-
-You can also customize speedbar's initial frame parameters.  How this is
-accomplished is dependent on your platform being Emacs or XEmacs.
-
-@cindex @code{speedbar-frame-parameters}, Emacs
-In Emacs, change the alist @code{speedbar-frame-parameters}.  This
-variable is used to set up initial details.  Height is also
-automatically added when speedbar is created, though you can override
-it.
-
-@cindex @code{speedbar-frame-plist}, XEmacs
-In XEmacs, change the plist @code{speedbar-frame-plist}.  This is the
-XEmacs way of doing the same thing.
-
-@node Tag Hierarchy Methods, Version Control, Frames and Faces, Customizing
-@comment  node-name,  next,  previous,  up
-@section Tag Hierarchy Methods
-@cindex tag hierarchy
-@cindex tag groups
-@cindex tag sorting
-
-When listing tags within a file, it is possible to get an annoyingly
-long list of entries.  Imenu (which generates the tag list in Emacs)
-will group some classes of items automatically.   Even here, however,
-some tag groups can be quite large.
-
-@cindex @code{speedbar-tag-hierarchy-method}
-To solve this problem, tags can be grouped into logical units through a
-hierarchy processor.  The specific variable to use is
-@code{speedbar-tag-hierarchy-method}.  There are several methods that
-can be applied in any order.  They are:
-
-@table @code
-@cindex @code{speedbar-trim-words-tag-hierarchy}
-@item speedbar-trim-words-tag-hierarchy
-Find a common prefix for all elements of a group, and trim it off.
-@cindex @code{speedbar-prefix-group-tag-hierarchy}
-@item speedbar-prefix-group-tag-hierarchy
-If a group is too large, place sets of tags into bins based on common
-prefixes.
-@cindex @code{speedbar-simple-group-tag-hierarchy}
-@item speedbar-simple-group-tag-hierarchy
-Take all items in the top level list not in a group, and stick them into
-a @samp{Tags} group.
-@cindex @code{speedbar-sort-tag-hierarchy}
-@item speedbar-sort-tag-hierarchy
-Sort all items, leaving groups on top.
-@end table
-
-You can also add your own functions to reorganize tags as you see fit.
-
-Some other control variables are:
-
-@table @code
-@cindex @code{speedbar-tag-group-name-minimum-length}
-@item speedbar-tag-group-name-minimum-length
-Default value: 4.
-
-The minimum length of a prefix group name before expanding.  Thus, if
-the @code{speedbar-tag-hierarchy-method} includes
-@code{speedbar-prefix-group-tag-hierarchy} and one such group's common
-characters is less than this number of characters, then the group name
-will be changed to the form of:
-
-@example
-worda to wordb
-@end example
-
-instead of just
-
-@example
-word
-@end example
-
-This way we won't get silly looking listings.
-
-@cindex @code{speedbar-tag-split-minimum-length}
-@item speedbar-tag-split-minimum-length
-Default value: 20.
-
-Minimum length before we stop trying to create sub-lists in tags.
-This is used by all tag-hierarchy methods that break large lists into
-sub-lists.
-
-@cindex @code{speedbar-tag-regroup-maximum-length}
-@item speedbar-tag-regroup-maximum-length
-Default value: 10.
-
-Maximum length of submenus that are regrouped.
-If the regrouping option is used, then if two or more short subgroups
-are next to each other, then they are combined until this number of
-items is reached.
-@end table
-
-@node Version Control, Hooks, Tag Hierarchy Methods, Customizing
-@comment  node-name,  next,  previous,  up
-@section Version Control
-@cindex version control
-@cindex vc extensions
-
-When using the file mode in speedbar, information regarding a version
-control system adds small details to the display.  If a file is in a
-version control system, and is ``checked out'' or ``locked'' locally, an
-asterisk @samp{*} appears at the end of the file name.  In addition,
-the directory name for Version Control systems are left out of the
-speedbar display.
-
-@cindex @code{speedbar-directory-unshown-regexp}
-You can easily add new version control systems into speedbar's detection
-scheme.  To make a directory ``disappear'' from the list, use the variable
-@code{speedbar-directory-unshown-regexp}.
-
-@cindex @code{speedbar-vc-path-enable-hook}
-Next, you need to write entries for two hooks.  The first is
-@code{speedbar-vc-path-enable-hook} which will enable a VC check in the
-current directory for the group of files being checked.  Your hook
-function should take one parameter (the directory to check) and return
-@code{t} if your VC method is in control here.
-
-@cindex @code{speedbar-vc-in-control-hook}
-The second function is @code{speedbar-vc-in-control-hook}.  This hook
-takes two parameters, the @var{path} of the file to check, and the
-@var{file} name.  Return @code{t} if you want to have the asterisk
-placed near this file.
-
-@cindex @code{speedbar-vc-indicator}
-Lastly, you can change the VC indicator using the variable
-@code{speedbar-vc-indicator}, and specify a single character string.
-
-@node Hooks, , Version Control, Customizing
-@comment  node-name,  next,  previous,  up
-@section Hooks
-@cindex hooks
-
-There are several hooks in speedbar allowing custom behaviors to be
-added.  Available hooks are:
-
-@table @code
-@cindex @code{speedbar-visiting-file-hook}
-@item speedbar-visiting-file-hook
-Hooks run when speedbar visits a file in the selected frame.
-@cindex @code{speedbar-visiting-tag-hook}
-@item speedbar-visiting-tag-hook
-Hooks run when speedbar visits a tag in the selected frame.
-@cindex @code{speedbar-load-hook}
-@item speedbar-load-hook
-Hooks run when speedbar is loaded.
-@cindex @code{speedbar-reconfigure-keymaps-hook}
-@item speedbar-reconfigure-keymaps-hook
-Hooks run when the keymaps are regenerated.  Keymaps are reconfigured
-whenever modes change.  This will let you add custom key bindings.
-@cindex @code{speedbar-before-popup-hook}
-@item speedbar-before-popup-hook
-Hooks called before popping up the speedbar frame.
-New frames are often popped up when ``power clicking'' on an item to view
-it.
-@cindex @code{speedbar-before-delete-hook}
-@item speedbar-before-delete-hook
-Hooks called before deleting or hiding the speedbar frame.
-@cindex @code{speedbar-mode-hook}
-@item speedbar-mode-hook
-Hooks called after creating a speedbar buffer.
-@cindex @code{speedbar-timer-hook}
-@item speedbar-timer-hook
-Hooks called after running the speedbar timer function.
-@cindex @code{speedbar-scanner-reset-hook}
-@item speedbar-scanner-reset-hook
-Hook called whenever generic scanners are reset.
-Set this to implement your own scanning or rescan safe functions with
-state data.
-@end table
-
-@node Extending, Index, Customizing, Top
-@comment  node-name,  next,  previous,  up
-@chapter Extending
-@cindex extending
-
-Speedbar can run different types of Major display modes such as Files
-(@pxref{File Mode}), and Buffers (@pxref{Buffer Mode}).  It can also manage
-different minor display modes for use with buffers handling specialized
-data.
-
-These major and minor display modes are handled through an extension
-system which permits specialized keymaps and menu extensions, in
-addition to a unique rendering function.  You can also specify a wide
-range of tagging functions.  The default uses @code{imenu}, but new
-tagging methods can be easily added.  In this chapter, you will
-learn how to write your own major or minor display modes, and how to
-create specialized tagging functions.
-
-@menu
-* Minor Display Modes::    How to create a minor display mode.
-* Major Display Modes::    How to create a major display mode.
-* Tagging Extensions::     How to create your own tagging methods.
-* Creating a display::     How to insert buttons and hierarchies.
-@end menu
-
-@node Minor Display Modes, Major Display Modes, Extending, Extending
-@section Minor Display Modes
-@cindex create minor display mode
-
-A @dfn{minor display mode} is a mode useful when using a specific type of
-buffer.  This mode might not be useful for any other kind of data or
-mode, or may just be more useful that a files or buffers based mode when
-working with a specialized mode.
-
-Examples that already exist for speedbar include RMAIL, Info, and gdb.
-These modes display information specific to the major mode shown in the
-attached frame.
-
-To enable a minor display mode in your favorite Major mode, follow these
-steps.  The string @samp{@var{name}} is the name of the major mode being
-augmented with speedbar.
-
-@enumerate
-@item
-Create the keymap variable @code{@var{name}-speedbar-key-map}.
-
-@item
-Create a function, named whatever you like, which assigns values into your
-keymap.  Use this command to create the keymap before assigning
-bindings:
-
-@smallexample
-    (setq @var{name}-speedbar-key-map (speedbar-make-specialized-keymap))
-@end smallexample
-
-This function creates a special keymap for use in speedbar.
-
-@item
-Call your install function, or assign it to a hook like this:
-
-@smallexample
-(if (featurep 'speedbar)
-    (@var{name}-install-speedbar-variables)
-  (add-hook 'speedbar-load-hook '@var{name}-install-speedbar-variables))
-@end smallexample
-
-@item
-Create an easymenu compatible vector named
-@code{@var{name}-speedbar-menu-items}.  This will be spliced into
-speedbar's control menu.
-
-@item
-Create a function called @code{@var{name}-speedbar-buttons}.  This function
-should take one variable, which is the buffer for which it will create
-buttons.   At this time @code{(current-buffer)} will point to the
-uncleared speedbar buffer.
-@end enumerate
-
-When writing @code{@var{name}-speedbar-buttons}, the first thing you will
-want to do is execute a check to see if you need to re-create your
-display.  If it needs to be cleared, you need to erase the speedbar
-buffer yourself, and start drawing buttons.  @xref{Creating a display}.
-
-@node Major Display Modes, Tagging Extensions, Minor Display Modes, Extending
-@section Major Display Modes
-@cindex create major display mode
-
-Creating a @dfn{Major Display Mode} for speedbar requires authoring a keymap,
-an easy-menu segment, and writing several functions.  These items can be
-given any name, and are made the same way as in a minor display mode
-(@pxref{Minor Display Modes}).  Once this is done, these items need to be
-registered.
-
-Because this setup activity may or may not have speedbar available when
-it is being loaded, it is necessary to create an install function.  This
-function should create and initialize the keymap, and add your
-expansions into the customization tables.
-
-@cindex @code{speedbar-make-specialized-keymap}
-When creating the keymap, use the function
-@code{speedbar-make-specialized-keymap} instead of other keymap making
-functions.  This will provide you with the initial bindings needed.
-Some common speedbar functions you might want to bind are:
-
-@table @code
-@cindex @code{speedbar-edit-line}
-@item speedbar-edit-line
-Edit the item on the current line.
-@cindex @code{speedbar-expand-line}
-@item speedbar-expand-line
-Expand the item under the cursor.
-With a numeric argument (@kbd{C-u}), flush cached data before expanding.
-@cindex @code{speedbar-contract-line}
-@item speedbar-contract-line
-Contract the item under the cursor.
-@end table
-
-@cindex @code{speedbar-line-path}
-These function require that function @code{speedbar-line-path} be
-correctly overloaded to work.
-
-Next, register your extension like this;
-
-@example
-  (speedbar-add-expansion-list '("MyExtension"
-                                 MyExtension-speedbar-menu-items
-                                 MyExtension-speedbar-key-map
-                                 MyExtension-speedbar-buttons))
-@end example
-
-There are no limitations to the names you use.
-
-The first parameter is the string representing your display mode.
-The second parameter is a variable name containing an easymenu compatible
-menu definition.  This will be stuck in the middle of speedbar's menu.
-The third parameter is the variable name containing the keymap we
-discussed earlier.
-The last parameter is a function which draws buttons for your mode.
-This function must take two parameters.  The directory currently being
-displayed, and the depth at which you should start rendering buttons.
-The function will then draw (starting at the current cursor position)
-any buttons deemed necessary based on the input parameters.
-@xref{Creating a display}.
-
-Next, you need to register function overrides.  This may look something
-like this:
-
-@example
-(speedbar-add-mode-functions-list
- '("MYEXTENSION"
-   (speedbar-item-info . MyExtension-speedbar-item-info)
-   (speedbar-line-path . MyExtension-speedbar-line-path)))
-@end example
-
-The first element in the list is the name of you extension.  The second
-is an alist of functions to overload.  The function to overload is
-first, followed by what you want called instead.
-
-For @code{speedbar-line-path} your function should take an optional DEPTH
-parameter.  This is the starting depth for heavily indented lines.  If
-it is not provided, you can derive it like this:
-
-@example
-(save-match-data
-  (if (not depth)
-      (progn
-        (beginning-of-line)
-        (looking-at "^\\([0-9]+\\):")
-        (setq depth (string-to-int (match-string 1)))))
-@end example
-
-@noindent
-where the depth is stored as invisible text at the beginning of each
-line.
-
-The path returned should be the full path name of the file associated
-with that line.  If the cursor is on a tag, then the file containing
-that tag should be returned.  This is critical for built in file based
-functions to work (meaning less code for you to write).  If your display
-does not deal in files, you do not need to overload this function.
-
-@cindex @code{speedbar-item-info}
-The function @code{speedbar-item-info}, however, is very likely to need
-overloading.  This function takes no parameters and must derive a text
-summary to display in the minibuffer.
-
-There are several helper functions you can use if you are going to use
-built in tagging.  These functions can be @code{or}ed since each one
-returns non-nil if it displays a message.  They are:
-
-@table @code
-@cindex @code{speedbar-item-info-file-helper}
-@item speedbar-item-info-file-helper
-This takes an optional @var{filename} parameter.  You can derive your own
-filename, or it will derive it using a (possibly overloaded) function
-@code{speedbar-line-file}.  It shows details about a file.
-@cindex @code{speedbar-item-info-tag-helper}
-@item speedbar-item-info-tag-helper
-If the current line is a tag, then display information about that tag,
-such as its parent file, and location.
-@end table
-
-Your custom function might look like this:
-
-@example
-(defun MyExtension-item-info ()
-  "Display information about the current line."
-  (or (speedbar-item-info-tag-helper)
-      (message "Interesting detail.")))
-@end example
-
-Once you have done all this, speedbar will show an entry in the
-@samp{Displays} menu declaring that your extension is available.
-
-@node Tagging Extensions, Creating a display, Major Display Modes, Extending
-@section Tagging Extensions
-
-It is possible to create new methods for tagging files in speedbar.
-To do this, you need two basic functions, one function to fetch the
-tags from a buffer, the other to insert them below the filename.
-
-@defun my-fetch-dynamic-tags file
-Parse @var{file} for a list of tags.  Return the list, or @code{t} if
-there was an error.  @var{file} is not necessarily available as an
-buffer when your function is called.  Be sure to load it if it is needed
-with code like this:
-
-@example
-(save-excursion
-  (set-buffer (find-file-noselect file))
-  ...
-  )
-@end example
-@end defun
-
-The non-error return value can be anything, as long as it can be
-inserted by its paired function:
-
-@defun my-insert-tag-list level lst
-Insert a list of tags @var{lst} started at indentation level
-@var{level}.  Creates buttons for each tag, and provides any other
-display information required.
-@end  defun
-
-@cindex @code{speedbar-create-tag-hierarchy}
-It is often useful to use @code{speedbar-create-tag-hierarchy} on your
-token list.  See that function's documentation for details on what it
-requires.
-
-@cindex @code{speedbar-dynamic-tags-function-list}
-Once these two functions are written, modify the variable
-@code{speedbar-dynamic-tags-function-list} to include your parser at the
-beginning, like this:
-
-@example
-(add-to-list 'speedbar-dynamic-tags-function-list
-	     '(my-fetch-dynamic-tags  . my-insert-tag-list))
-@end example
-
-If your parser is only good for a few types of files, make sure that it
-is either a buffer local modification, or that the tag generator returns
-@code{t} for non valid buffers.
-
-@node Creating a display, , Tagging Extensions, Extending
-@section Creating a display
-@cindex creating a display
-
-Rendering a display in speedbar is completely flexible.  When your
-button function is called, see @ref{Minor Display Modes}, and @ref{Major
-Display Modes}, you have control to @code{insert} anything you want.
-
-The conventions allow almost anything to be inserted, but several helper
-functions are provided to make it easy to create the standardized
-buttons.
-
-To understand the built in functions, each `button' in speedbar consists
-of four important pieces of data.  The text to be displayed, token
-data to be associated with the text, a function to call, and some face to
-display it in.
-
-When a function is provided, then that text becomes mouse activated,
-meaning the mouse will highlight the text.
-
-Additionally, for data which can form deep trees, each line is given a
-depth which indicates how far down the tree it is.  This information is
-stored in invisible text at the beginning of each line, and is used by
-the navigation commands.
-
-@defun speedbar-insert-button text face mouse function &optional token prevline
-This function inserts one button into the current location.
-@var{text} is the text to insert.  @var{face} is the face in which it
-will be displayed.   @var{mouse} is the face to display over the text
-when the mouse passes over it.  @var{function} is called whenever the
-user clicks on the text.
-
-The optional argument @var{token} is extra data to associated with the
-text.  Lastly @var{prevline} should be non-nil if you want this line to
-appear directly after the last button which was created instead of on
-the next line.
-@end defun
-
-@defun speedbar-make-tag-line exp-button-type exp-button-char exp-button-function exp-button-data tag-button tag-button-function tag-button-data tag-button-face depth
-
-Create a tag line with @var{exp-button-type} for the small expansion
-button.  This is the button that expands or contracts a node (if
-applicable), and @var{exp-button-char} the character in it (@samp{+},
-@samp{-}, @samp{?},
-etc).  @var{exp-button-function} is the function to call if it's clicked
-on.  Button types are @code{'bracket}, @code{'angle}, @code{'curly},
-@code{'expandtag}, @code{'statictag}, or nil.  @var{exp-button-data} is
-extra data attached to the text forming the expansion button.
-
-Next, @var{tag-button} is the text of the tag.
-@var{tag-button-function} is the function to call if clicked on, and
-@var{tag-button-data} is the data to attach to the text field (such a
-tag positioning, etc).  @var{tag-button-face} is a face used for this
-type of tag.
-
-Lastly, @var{depth} shows the depth of expansion.
-
-This function assumes that the cursor is in the speedbar window at the
-position to insert a new item, and that the new item will end with a CR.
-@end defun
-
-@defun speedbar-insert-generic-list level list expand-fun find-fun
-
-At @var{level}, (the current indentation level desired) insert a generic
-multi-level alist @var{list}.  Associations with lists get @samp{@{+@}}
-tags (to expand into more nodes) and those with positions or other data
-just get a @samp{>} as the indicator.  @samp{@{+@}} buttons will have the
-function @var{expand-fun} and the token is the @code{cdr} list.  The
-token name will have the function @var{find-fun} and not token.
-
-Each element of the list can have one of these forms:
-
-@table @code
-@item (@var{name} . marker-or-number)
-One tag at this level.
-@item (@var{name} (@var{name} . marker-or-number) (@var{name} . marker-or-number) ... )
-One group of tags.
-@item (@var{name} marker-or-number (@var{name} . marker-or-number) ... )
-One Group of tags where the group has a starting position.
-@end table
-
-When you use @code{speedbar-insert-generic-list}, there are some
-variables you can set buffer-locally to change the behavior.  The most
-obvious is @code{speedbar-tag-hierarchy-method}.
-@xref{Tag Hierarchy Methods}.
-
-@defvar speedbar-generic-list-group-expand-button-type
-This is the button type used for groups of tags, whether expanded
-or added in via a hierarchy method.  Two good values are
-@code{'curly} and @code{'expandtag}.  Curly is the default button, and
-@code{'expandtag} is useful if the groups also has a position.
-@end defvar
-
-@defvar speedbar-generic-list-tag-button-type
-This is the button type used for a single tag.
-Two good values are @code{nil} and @code{'statictag}.
-@code{nil} is the default, and @code{'statictag} has the same width as
-@code{'expandtag}.
-@end defvar
-
-@end defun
-
-@node Index, , Extending, Top
-@comment  node-name,  next,  previous,  up
-@unnumbered Concept Index
-@printindex cp
-
-@bye
-@c  LocalWords:  speedbar's xref slowbar kbd subsubsection
-@c  LocalWords:  keybindings
diff --git a/xemacs-packages/man/tramp/tramp.texi b/xemacs-packages/man/tramp/tramp.texi
deleted file mode 100644
index 89773534..00000000
--- a/xemacs-packages/man/tramp/tramp.texi
+++ /dev/null
@@ -1,2405 +0,0 @@
-\input texinfo   @c -*-texinfo-*-
-@c %**start of header
-@setfilename ../info/tramp
-@settitle TRAMP User Manual
-@setchapternewpage odd
-@c %**end of header
-
-@c This is *so* much nicer :)
-@footnotestyle end
-
-@c In the Tramp CVS, the version number is auto-frobbed from
-@c configure.ac, so you should edit that file and run
-@c "autoconf && ./configure" to change the version number.
-
-@c Additionally, flags are set with respect to the Emacs flavor; and
-@c depending whether Tramp is packaged into (X)Emacs, or standalone.
-
-@include trampver.texi
-
-@c Macros for formatting a filename.
-@c trampfn is for a full filename, trampfnmhp means method, host, localname
-@c were given, and so on.
-@macro trampfn(method, user, host, localname)
-@value{prefix}@value{method}@value{user}@@@value{host}@value{postfix}@value{localname}
-@end macro
-
-@copying
-Copyright @copyright{} 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006
-Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU
-Manual'', and with the Back-Cover Texts as in (a) below.  A copy of the
-license is included in the section entitled ``GNU Free Documentation
-License'' in the Emacs manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software.  Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License.  If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-@end quotation
-@end copying
-
-@c Entries for @command{install-info} to use
-@dircategory @value{emacsname}
-@direntry
-* TRAMP: (tramp).                Transparent Remote Access, Multiple Protocol
-                                 @value{emacsname} remote file access via rsh and rcp.
-@end direntry
-
-@tex
-
-@titlepage
-@title @value{tramp} version @value{trampver} User Manual
-
-@author by Daniel Pittman
-@author based on documentation by Kai Gro@ss{}johann
-
-@page
-@insertcopying
-
-@end titlepage
-@page
-
-@end tex
-
-@ifnottex
-@node Top, Overview, (dir), (dir)
-@top @value{tramp} version @value{trampver} User Manual
-
-This file documents @value{tramp} version @value{trampver}, a remote file
-editing package for @value{emacsname}.
-
-@value{tramp} stands for `Transparent Remote (file) Access, Multiple
-Protocol'.  This package provides remote file editing, similar to
-@value{ftppackagename}.
-
-The difference is that @value{ftppackagename} uses FTP to transfer
-files between the local and the remote host, whereas @value{tramp} uses a
-combination of @command{rsh} and @command{rcp} or other work-alike
-programs, such as @command{ssh}/@command{scp}.
-
-You can find the latest version of this document on the web at
-@uref{http://www.gnu.org/software/tramp/}.
-
-@c Pointer to the other Emacs flavor is necessary only in case of
-@c standalone installation.
-@ifset installchapter
-The manual has been generated for @value{emacsname}.
-@ifinfo
-If you want to read the info pages for @value{emacsothername}, you
-should read in @ref{Installation} how to create them.
-@end ifinfo
-@ifhtml
-If you're using the other Emacs flavor, you should read the
-@uref{@value{emacsotherfilename}, @value{emacsothername}} pages.
-@end ifhtml
-@end ifset
-
-@ifhtml
-@ifset jamanual
-This manual is also available as a @uref{@value{japanesemanual},
-Japanese translation}.
-@end ifset
-
-The latest release of @value{tramp} is available for
-@uref{ftp://ftp.gnu.org/gnu/tramp/, download}, or you may see
-@ref{Obtaining Tramp} for more details, including the CVS server
-details.
-
-@value{tramp} also has a @uref{http://savannah.gnu.org/projects/tramp/,
-Savannah Project Page}.
-@end ifhtml
-
-There is a mailing list for @value{tramp}, available at
-@email{tramp-devel@@gnu.org}, and archived at
-@uref{http://lists.gnu.org/archive/html/tramp-devel/, the
-@value{tramp} Mail Archive}.
-@ifhtml
-Older archives are located at
-@uref{http://sourceforge.net/mailarchive/forum.php?forum=tramp-devel,
-SourceForge Mail Archive} and
-@uref{http://www.mail-archive.com/emacs-rcp@@ls6.cs.uni-dortmund.de/,
-The Mail Archive}.
-@c in HTML output, there's no new paragraph.
-@*@*
-@end ifhtml
-
-@insertcopying
-
-@end ifnottex
-
-@menu
-* Overview::                    What @value{tramp} can and cannot do.
-
-For the end user:
-
-* Obtaining Tramp::             How to obtain @value{tramp}.
-* History::                     History of @value{tramp}.
-@ifset installchapter
-* Installation::                Installing @value{tramp} with your @value{emacsname}.
-@end ifset
-* Configuration::               Configuring @value{tramp} for use.
-* Usage::                       An overview of the operation of @value{tramp}.
-* Bug Reports::                 Reporting Bugs and Problems.
-* Frequently Asked Questions::  Questions and answers from the mailing list.
-* Concept Index::               An item for each concept.
-
-For the developer:
-
-* Version Control::             The inner workings of remote version control.
-* Files directories and localnames::  How file names, directories and localnames are mangled and managed.
-* Issues::                      Debatable Issues and What Was Decided.
-
-@detailmenu
- --- The Detailed Node Listing ---
-@c
-@ifset installchapter
-Installing @value{tramp} with your @value{emacsname}
-
-* Installation parameters::     Parameters in order to control installation.
-* Load paths::                  How to plug-in @value{tramp} into your environment.
-* Japanese manual::             Japanese manual.
-
-@end ifset
-
-Configuring @value{tramp} for use
-
-* Connection types::            Types of connections made to remote machines.
-* Inline methods::              Inline methods.
-* External transfer methods::   External transfer methods.
-* Multi-hop Methods::           Connecting to a remote host using multiple hops.
-* Default Method::              Selecting a default method.
-* Customizing Methods::         Using Non-Standard Methods.
-* Customizing Completion::      Selecting config files for user/host name completion.
-* Password caching::            Reusing passwords for several connections.
-* Remote Programs::             How @value{tramp} finds and uses programs on the remote machine.
-* Remote shell setup::          Remote shell setup hints.
-* Windows setup hints::         Issues with Cygwin ssh.
-* Auto-save and Backup::        Auto-save and Backup.
-
-Using @value{tramp}
-
-* Filename Syntax::             @value{tramp} filename conventions.
-* Multi-hop filename syntax::   Multi-hop filename conventions.
-* Filename completion::         Filename completion.
-* Dired::                       Dired.
-* Compilation::                 Compile remote files.
-
-The inner workings of remote version control
-
-* Version Controlled Files::    Determining if a file is under version control.
-* Remote Commands::             Executing the version control commands on the remote machine.
-* Changed workfiles::           Detecting if the working file has changed.
-* Checking out files::          Bringing the workfile out of the repository.
-* Miscellaneous Version Control::  Things related to Version Control that don't fit elsewhere.
-
-Things related to Version Control that don't fit elsewhere
-
-* Remote File Ownership::       How VC determines who owns a workfile.
-* Back-end Versions::           How VC determines what release your RCS is.
-
-How file names, directories and localnames are mangled and managed
-
-* Localname deconstruction::    Breaking a localname into its components.
-
-@end detailmenu
-@end menu
-
-@node Overview
-@chapter An overview of @value{tramp}
-@cindex overview
-
-After the installation of @value{tramp} into your @value{emacsname},
-you will be able to access files on remote machines as though they
-were local.  Access to the remote file system for editing files,
-version control, and @code{dired} are transparently enabled.
-
-Your access to the remote machine can be with the @command{rsh},
-@command{rlogin}, @command{telnet} programs or with any similar
-connection method.  This connection must pass @acronym{ASCII}
-successfully to be usable but need not be 8-bit clean.
-
-The package provides support for @command{ssh} connections out of the
-box, one of the more common uses of the package.  This allows
-relatively secure access to machines, especially if @command{ftp}
-access is disabled.
-
-The majority of activity carried out by @value{tramp} requires only that
-the remote login is possible and is carried out at the terminal.  In
-order to access remote files @value{tramp} needs to transfer their content
-to the local machine temporarily.
-
-@value{tramp} can transfer files between the machines in a variety of ways.
-The details are easy to select, depending on your needs and the
-machines in question.
-
-The fastest transfer methods (for large files) rely on a remote file
-transfer package such as @command{rcp}, @command{scp} or
-@command{rsync}.
-
-If the remote copy methods are not suitable for you, @value{tramp} also
-supports the use of encoded transfers directly through the shell.
-This requires that the @command{mimencode} or @command{uuencode} tools
-are available on the remote machine.  These methods are generally
-faster for small files.
-
-Within these limitations, @value{tramp} is quite powerful.  It is worth
-noting that, as of the time of writing, it is far from a polished
-end-user product.  For a while yet you should expect to run into rough
-edges and problems with the code now and then.
-
-It is finished enough that the developers use it for day to day work but
-the installation and setup can be a little difficult to master, as can
-the terminology.
-
-@value{tramp} is still under active development and any problems you encounter,
-trivial or major, should be reported to the @value{tramp} developers.
-@xref{Bug Reports}.
-
-
-@subsubheading Behind the scenes
-@cindex behind the scenes
-@cindex details of operation
-@cindex how it works
-
-This section tries to explain what goes on behind the scenes when you
-access a remote file through @value{tramp}.
-
-Suppose you type @kbd{C-x C-f} and enter part of an @value{tramp} file name,
-then hit @kbd{@key{TAB}} for completion.  Suppose further that this is
-the first time that @value{tramp} is invoked for the host in question.  Here's
-what happens:
-
-@itemize
-@item
-@value{tramp} discovers that it needs a connection to the host.  So it
-invokes @samp{telnet @var{host}} or @samp{rsh @var{host} -l
-@var{user}} or a similar tool to connect to the remote host.
-Communication with this process happens through an
-@value{emacsname} buffer, that is, the output from the remote end
-goes into a buffer.
-
-@item
-The remote host may prompt for a login name (for @command{telnet}).
-The login name is given in the file name, so @value{tramp} sends the
-login name and a newline.
-
-@item
-The remote host may prompt for a password or pass phrase (for
-@command{rsh} or for @command{telnet} after sending the login name).
-@value{tramp} displays the prompt in the minibuffer, asking you for the
-password or pass phrase.
-
-You enter the password or pass phrase.  @value{tramp} sends it to the remote
-host, followed by a newline.
-
-@item
-@value{tramp} now waits for the shell prompt or for a message that the login
-failed.
-
-If @value{tramp} sees neither of them after a certain period of time (a minute,
-say), then it issues an error message saying that it couldn't find the
-remote shell prompt and shows you what the remote host has sent.
-
-If @value{tramp} sees a @samp{login failed} message, it tells you so,
-aborts the login attempt and allows you to try again.
-
-@item
-Suppose that the login was successful and @value{tramp} sees the shell prompt
-from the remote host.  Now @value{tramp} invokes @command{/bin/sh} because
-Bourne shells and C shells have different command
-syntaxes.@footnote{Invoking @command{/bin/sh} will fail if your login
-shell doesn't recognize @samp{exec /bin/sh} as a valid command.
-Maybe you use the Scheme shell @command{scsh}@dots{}}
-
-After the Bourne shell has come up, @value{tramp} sends a few commands to
-ensure a good working environment.  It turns off echoing, it sets the
-shell prompt, and a few other things.
-
-@item
-Now the remote shell is up and it good working order.  Remember, what
-was supposed to happen is that @value{tramp} tries to find out what files exist
-on the remote host so that it can do filename completion.
-
-So, @value{tramp} basically issues @command{cd} and @command{ls} commands and
-also sometimes @command{echo} with globbing.  Another command that is
-often used is @command{test} to find out whether a file is writable or a
-directory or the like.  The output of each command is parsed for the
-necessary operation.
-
-@item
-Suppose you are finished with filename completion, have entered @kbd{C-x
-C-f}, a full file name and hit @kbd{@key{RET}}.  Now comes the time to
-transfer the file contents from the remote host to the local host so
-that you can edit them.
-
-See above for an explanation of how @value{tramp} transfers the file contents.
-
-For inline transfers, @value{tramp} issues a command like @samp{mimencode -b
-/path/to/remote/file}, waits until the output has accumulated in the
-buffer that's used for communication, then decodes that output to
-produce the file contents.
-
-For out-of-band transfers, @value{tramp} issues a command like the following:
-@example
-rcp user@@host:/path/to/remote/file /tmp/tramp.4711
-@end example
-It then reads the local temporary file @file{/tmp/tramp.4711} into a
-buffer and deletes the temporary file.
-
-@item
-You now edit the buffer contents, blithely unaware of what has happened
-behind the scenes.  (Unless you have read this section, that is.)  When
-you are finished, you type @kbd{C-x C-s} to save the buffer.
-
-@item
-Again, @value{tramp} transfers the file contents to the remote host either
-inline or out-of-band.  This is the reverse of what happens when reading
-the file.
-@end itemize
-
-I hope this has provided you with a basic overview of what happens
-behind the scenes when you open a file with @value{tramp}.
-
-
-@c For the end user
-@node Obtaining Tramp
-@chapter Obtaining Tramp.
-@cindex obtaining Tramp
-
-@value{tramp} is freely available on the Internet and the latest
-release may be downloaded from
-@uref{ftp://ftp.gnu.org/gnu/tramp/}. This release includes the full
-documentation and code for @value{tramp}, suitable for installation.
-But GNU Emacs (22 or later) includes @value{tramp} already, and there
-is a @value{tramp} package for XEmacs, as well.  So maybe it is easier
-to just use those.  But if you want the bleeding edge, read
-on@dots{...}
-
-For the especially brave, @value{tramp} is available from CVS.  The CVS
-version is the latest version of the code and may contain incomplete
-features or new issues. Use these versions at your own risk.
-
-Instructions for obtaining the latest development version of @value{tramp}
-from CVS can be found by going to the Savannah project page at the
-following URL and then clicking on the CVS link in the navigation bar
-at the top.
-
-@noindent
-@uref{http://savannah.gnu.org/projects/tramp/}
-
-@noindent
-Or follow the example session below:
-
-@example
-] @strong{cd ~/@value{emacsdir}}
-] @strong{export CVS_RSH="ssh"}
-] @strong{cvs -z3 -d:ext:anoncvs@@savannah.gnu.org:/cvsroot/tramp co tramp}
-@end example
-
-@noindent
-You should now have a directory @file{~/@value{emacsdir}/tramp}
-containing the latest version of @value{tramp}. You can fetch the latest
-updates from the repository by issuing the command:
-
-@example
-] @strong{cd ~/@value{emacsdir}/tramp}
-] @strong{export CVS_RSH="ssh"}
-] @strong{cvs update -d}
-@end example
-
-@noindent
-Once you've got updated files from the CVS repository, you need to run
-@command{autoconf} in order to get an up-to-date @file{configure}
-script:
-
-@example
-] @strong{cd ~/@value{emacsdir}/tramp}
-] @strong{autoconf}
-@end example
-
-
-@node History
-@chapter History of @value{tramp}
-@cindex history
-@cindex development history
-
-Development was started end of November 1998.  The package was called
-@file{rssh.el}, back then.  It only provided one method to access a
-file, using @command{ssh} to log in to a remote host and using
-@command{scp} to transfer the file contents.  After a while, the name
-was changed to @file{rcp.el}, and now it's @value{tramp}.  Along the way,
-many more methods for getting a remote shell and for transferring the
-file contents were added.  Support for VC was added.
-
-The most recent addition of major features were the multi-hop methods
-added in April 2000 and the unification of @value{tramp} and Ange-FTP
-filenames in July 2002.
-
-@c Installation chapter is necessary only in case of standalone
-@c installation.  Text taken from trampinst.texi.
-@ifset installchapter
-@include trampinst.texi
-@end ifset
-
-@node Configuration
-@chapter Configuring @value{tramp} for use
-@cindex configuration
-
-@cindex default configuration
-@value{tramp} is (normally) fully functional when it is initially installed.
-It is initially configured to use the @command{ssh} program to connect
-to the remote host and to use base64 or uu encoding to transfer the
-files through that shell connection.  So in the easiest case, you just
-type @kbd{C-x C-f} and then enter the filename
-@file{@value{prefix}@var{user}@@@var{machine}@value{postfix}@var{/path/to.file}}.
-
-On some hosts, there are problems with opening a connection.  These are
-related to the behavior of the remote shell.  See @xref{Remote shell
-setup}, for details on this.
-
-If you do not wish to use these commands to connect to the remote
-host, you should change the default connection and transfer method
-that @value{tramp} uses.  There are several different methods that @value{tramp}
-can use to connect to remote machines and transfer files
-(@pxref{Connection types}).
-
-If you don't know which method is right for you, see @xref{Default
-Method}.
-
-
-@menu
-* Connection types::            Types of connections made to remote machines.
-* Inline methods::              Inline methods.
-* External transfer methods::   External transfer methods.
-* Multi-hop Methods::           Connecting to a remote host using multiple hops.
-* Default Method::              Selecting a default method.
-                                  Here we also try to help those who
-                                  don't have the foggiest which method
-                                  is right for them.
-* Customizing Methods::         Using Non-Standard Methods.
-* Customizing Completion::      Selecting config files for user/host name completion.
-* Password caching::            Reusing passwords for several connections.
-* Remote Programs::             How @value{tramp} finds and uses programs on the remote machine.
-* Remote shell setup::          Remote shell setup hints.
-* Windows setup hints::         Issues with Cygwin ssh.
-* Auto-save and Backup::        Auto-save and Backup.
-@end menu
-
-
-@node Connection types
-@section Types of connections made to remote machines.
-@cindex connection types, overview
-
-There are two basic types of transfer methods, each with its own
-advantages and limitations.  Both types of connection make use of a
-remote shell access program such as @command{rsh}, @command{ssh} or
-@command{telnet} to connect to the remote machine.
-
-This connection is used to perform many of the operations that @value{tramp}
-requires to make the remote file system transparently accessible from
-the local machine. It is only when visiting files that the methods
-differ.
-
-@cindex inline methods
-@cindex external transfer methods
-@cindex external methods
-@cindex out-of-band methods
-@cindex methods, inline
-@cindex methods, external transfer
-@cindex methods, out-of-band
-Loading or saving a remote file requires that the content of the file
-be transfered between the two machines. The content of the file can be
-transfered over the same connection used to log in to the remote
-machine or the file can be transfered through another connection using
-a remote copy program such as @command{rcp}, @command{scp} or
-@command{rsync}.  The former are called @dfn{inline methods}, the
-latter are called @dfn{out-of-band methods} or @dfn{external transfer
-methods} (@dfn{external methods} for short).
-
-The performance of the external transfer methods is generally better
-than that of the inline methods, at least for large files.  This is
-caused by the need to encode and decode the data when transferring
-inline.
-
-The one exception to this rule are the @command{scp} based transfer
-methods.  While these methods do see better performance when actually
-transferring files, the overhead of the cryptographic negotiation at
-startup may drown out the improvement in file transfer times.
-
-External transfer methods should be configured such a way that they
-don't require a password (with @command{ssh-agent}, or such alike).
-If it isn't possible, you should consider @ref{Password caching},
-otherwise you will be prompted for a password every copy action.
-
-@cindex multi-hop methods
-@cindex methods, multi-hop
-A variant of the inline methods are the @dfn{multi-hop methods}.
-These methods allow you to connect a remote host using a number `hops',
-each of which connects to a different host.  This is useful if you are
-in a secured network where you need to go through a bastion host to
-connect to the outside world.
-
-
-@node Inline methods
-@section Inline methods
-@cindex inline methods
-@cindex methods, inline
-
-The inline methods in @value{tramp} are quite powerful and can work in
-situations where you cannot use an external transfer program to connect.
-Inline methods are the only methods that work when connecting to the
-remote machine via telnet.  (There are also strange inline methods which
-allow you to transfer files between @emph{user identities} rather than
-hosts, see below.)
-
-These methods depend on the existence of a suitable encoding and
-decoding command on remote machine.  Locally, @value{tramp} may be able to
-use features of @value{emacsname} to decode and encode the files or
-it may require access to external commands to perform that task.
-
-@cindex uuencode
-@cindex mimencode
-@cindex base-64 encoding
-@value{tramp} checks the availability and usability of commands like
-@command{mimencode} (part of the @command{metamail} package) or
-@command{uuencode} on the remote host.  The first reliable command
-will be used.  The search path can be customized, see @ref{Remote
-Programs}.
-
-If both commands aren't available on the remote host, @value{tramp}
-transfers a small piece of Perl code to the remote host, and tries to
-apply it for encoding and decoding.
-
-
-@table @asis
-@item @option{rsh}
-@cindex method rsh
-@cindex rsh method
-
-Connect to the remote host with @command{rsh}.  Due to the unsecure
-connection it is recommended for very local host topology only.
-
-On operating systems which provide the command @command{remsh} instead
-of @command{rsh}, you can use the method @option{remsh}.  This is true
-for HP-UX or Cray UNICOS, for example.
-
-
-@item @option{ssh}
-@cindex method ssh
-@cindex ssh method
-
-Connect to the remote host with @command{ssh}.  This is identical to
-the previous option except that the @command{ssh} package is used,
-making the connection more secure.
-
-There are also two variants, @option{ssh1} and @option{ssh2}, that
-call @samp{ssh -1} and @samp{ssh -2}, respectively.  This way, you can
-explicitly select whether you want to use the SSH protocol version 1
-or 2 to connect to the remote host.  (You can also specify in
-@file{~/.ssh/config}, the SSH configuration file, which protocol
-should be used, and use the regular @option{ssh} method.)
-
-Two other variants, @option{ssh1_old} and @option{ssh2_old}, use the
-@command{ssh1} and @command{ssh2} commands explicitly.  If you don't
-know what these are, you do not need these options.
-
-All the methods based on @command{ssh} have an additional kludgy
-feature: you can specify a host name which looks like @file{host#42}
-(the real host name, then a hash sign, then a port number).  This
-means to connect to the given host but to also pass @code{-p 42} as
-arguments to the @command{ssh} command.
-
-
-@item @option{telnet}
-@cindex method telnet
-@cindex telnet method
-
-Connect to the remote host with @command{telnet}.  This is as unsecure
-as the @option{rsh} method.
-
-
-@item @option{su}
-@cindex method su
-@cindex su method
-
-This method does not connect to a remote host at all, rather it uses
-the @command{su} program to allow you to edit files as another user.
-
-
-@item @option{sudo}
-@cindex method sudo
-@cindex sudo method
-
-This is similar to the @option{su} method, but it uses @command{sudo}
-rather than @command{su} to become a different user.
-
-Note that @command{sudo} must be configured to allow you to start a
-shell as the user.  It would be nice if it was sufficient if
-@command{ls} and @command{mimencode} were allowed, but that is not
-easy to implement, so I haven't got around to it, yet.
-
-
-@item @option{sshx}
-@cindex method sshx
-@cindex sshx method
-
-As you would expect, this is similar to @option{ssh}, only a little
-different.  Whereas @option{ssh} opens a normal interactive shell on
-the remote host, this option uses @samp{ssh -t -t @var{host} -l
-@var{user} /bin/sh} to open a connection.  This is useful for users
-where the normal login shell is set up to ask them a number of
-questions when logging in.  This procedure avoids these questions, and
-just gives @value{tramp} a more-or-less `standard' login shell to work
-with.
-
-Note that this procedure does not eliminate questions asked by
-@command{ssh} itself.  For example, @command{ssh} might ask ``Are you
-sure you want to continue connecting?'' if the host key of the remote
-host is not known.  @value{tramp} does not know how to deal with such a
-question (yet), therefore you will need to make sure that you can log
-in without such questions.
-
-This is also useful for Windows users where @command{ssh}, when
-invoked from an @value{emacsname} buffer, tells them that it is not
-allocating a pseudo tty.  When this happens, the login shell is wont
-to not print any shell prompt, which confuses @value{tramp} mightily.
-For reasons unknown, some Windows ports for @command{ssh} require the
-doubled @samp{-t} option.
-
-This supports the @samp{-p} kludge.
-
-
-@item @option{krlogin}
-@cindex method krlogin
-@cindex km krlogin
-@cindex Kerberos (with krlogin method)
-
-This method is also similar to @option{ssh}.  It only uses the
-@command{krlogin -x} command to log in to the remote host.
-
-
-@item @option{plink}
-@cindex method plink
-@cindex plink method
-
-This method is mostly interesting for Windows users using the PuTTY
-implementation of SSH.  It uses @samp{plink -ssh} to log in to the
-remote host.
-
-Additionally, the method @option{plink1} is provided, which calls
-@samp{plink -1 -ssh} in order to use SSH protocol version 1
-explicitely.
-
-CCC: Do we have to connect to the remote host once from the command
-line to accept the SSH key?  Maybe this can be made automatic?
-
-CCC: Does @command{plink} support the @samp{-p} option?  @value{tramp} will
-support that, anyway.
-
-@end table
-
-
-
-@node External transfer methods
-@section External transfer methods
-@cindex methods, external transfer
-@cindex methods, out-of-band
-@cindex external transfer methods
-@cindex out-of-band methods
-
-The external transfer methods operate through multiple channels, using
-the remote shell connection for many actions while delegating file
-transfers to an external transfer utility.
-
-This saves the overhead of encoding and decoding that multiplexing the
-transfer through the one connection has with the inline methods.
-
-If you want to use an external transfer method you should be able to
-execute the transfer utility to copy files to and from the remote
-machine without any interaction.
-
-@cindex ssh-agent
-This means that you will need to use @command{ssh-agent} if you use the
-@command{scp} program for transfers, or maybe your version of
-@command{scp} accepts a password on the command line.@footnote{PuTTY's
-@command{pscp} allows you to specify the password on the command line.}
-If you use @command{rsync} via @command{ssh} then the same rule must
-apply to that connection.
-
-If you cannot get an external method to run without asking for a
-password you should consider @ref{Password caching}.
-
-
-@table @asis
-@item @option{rcp}  ---  @command{rsh} and @command{rcp}
-@cindex method rcp
-@cindex rcp method
-@cindex rcp (with rcp method)
-@cindex rsh (with rcp method)
-
-This method uses the @command{rsh} and @command{rcp} commands to connect
-to the remote machine and transfer files.  This is probably the fastest
-connection method available.
-
-The alternative method @option{remcp} uses the @command{remsh} and
-@command{rcp} commands.  It should be applied on machines where
-@command{remsh} is used instead of @command{rsh}.
-
-
-@item @option{scp}  ---  @command{ssh} and @command{scp}
-@cindex method scp
-@cindex scp method
-@cindex scp (with scp method)
-@cindex ssh (with scp method)
-
-Using @command{ssh} to connect to the remote host and @command{scp} to
-transfer files between the machines is the best method for securely
-connecting to a remote machine and accessing files.
-
-The performance of this option is also quite good. It may be slower than
-the inline methods when you often open and close small files however.
-The cost of the cryptographic handshake at the start of an @command{scp}
-session can begin to absorb the advantage that the lack of encoding and
-decoding presents.
-
-There are also two variants, @option{scp1} and @option{scp2}, that
-call @samp{ssh -1} and @samp{ssh -2}, respectively.  This way, you can
-explicitly select whether you want to use the SSH protocol version 1
-or 2 to connect to the remote host.  (You can also specify in
-@file{~/.ssh/config}, the SSH configuration file, which protocol
-should be used, and use the regular @option{scp} method.)
-
-Two other variants, @option{scp1_old} and @option{scp2_old}, use the
-@command{ssh1} and @command{ssh2} commands explicitly.  If you don't
-know what these are, you do not need these options.
-
-All the @command{ssh} based methods support the kludgy @samp{-p}
-feature where you can specify a port number to connect to in the host
-name.  For example, the host name @file{host#42} tells @value{tramp} to
-specify @samp{-p 42} in the argument list for @command{ssh}.
-
-
-@item @option{rsync}  ---  @command{ssh} and @command{rsync}
-@cindex method rsync
-@cindex rsync method
-@cindex rsync (with rsync method)
-@cindex ssh (with rsync method)
-
-Using the @command{ssh} command to connect securely to the remote
-machine and the @command{rsync} command to transfer files is almost
-identical to the @option{scp} method.
-
-While @command{rsync} performs much better than @command{scp} when
-transferring files that exist on both hosts, this advantage is lost if
-the file exists only on one side of the connection.
-
-The @command{rsync} based method may be considerably faster than the
-@command{rcp} based methods when writing to the remote system. Reading
-files to the local machine is no faster than with a direct copy.
-
-This method supports the @samp{-p} hack.
-
-
-@item @option{scpx} --- @command{ssh} and @command{scp}
-@cindex method scpx
-@cindex scpx method
-@cindex scp (with scpx method)
-@cindex ssh (with scpx method)
-
-As you would expect, this is similar to @option{scp}, only a little
-different.  Whereas @option{scp} opens a normal interactive shell on
-the remote host, this option uses @samp{ssh -t -t @var{host} -l
-@var{user} /bin/sh} to open a connection.  This is useful for users
-where the normal login shell is set up to ask them a number of
-questions when logging in.  This procedure avoids these questions, and
-just gives @value{tramp} a more-or-less `standard' login shell to work
-with.
-
-This is also useful for Windows users where @command{ssh}, when
-invoked from an @value{emacsname} buffer, tells them that it is not
-allocating a pseudo tty.  When this happens, the login shell is wont
-to not print any shell prompt, which confuses @value{tramp} mightily.
-
-This method supports the @samp{-p} hack.
-
-
-@item @option{pscp} --- @command{plink} and @command{pscp}
-@cindex method pscp
-@cindex pscp method
-@cindex pscp (with pscp method)
-@cindex plink (with pscp method)
-@cindex PuTTY (with pscp method)
-
-This method is similar to @option{scp}, but it uses the
-@command{plink} command to connect to the remote host, and it uses
-@command{pscp} for transferring the files.  These programs are part
-of PuTTY, an SSH implementation for Windows.
-
-CCC: Does @command{plink} support the @samp{-p} hack?
-
-
-@item @option{fcp} --- @command{fsh} and @command{fcp}
-@cindex method fcp
-@cindex fcp method
-@cindex fsh (with fcp method)
-@cindex fcp (with fcp method)
-
-This method is similar to @option{scp}, but it uses the @command{fsh}
-command to connect to the remote host, and it uses @command{fcp} for
-transferring the files.  @command{fsh/fcp} are a front-end for
-@command{ssh} which allow for reusing the same @command{ssh} session
-for submitting several commands.  This avoids the startup overhead of
-@command{scp} (which has to establish a secure connection whenever it
-is called).  Note, however, that you can also use one of the inline
-methods to achieve a similar effect.
-
-This method uses the command @samp{fsh @var{host} -l @var{user}
-/bin/sh -i} to establish the connection, it does not work to just say
-@command{fsh @var{host} -l @var{user}}.
-
-@cindex method fsh
-@cindex fsh method
-
-There is no inline method using @command{fsh} as the multiplexing
-provided by the program is not very useful in our context.  @value{tramp}
-opens just one connection to the remote host and then keeps it open,
-anyway.
-
-
-@item @option{ftp}
-@cindex method ftp
-@cindex ftp method
-
-This is not a native @value{tramp} method. Instead of, it forwards all
-requests to @value{ftppackagename}.
-@ifset xemacs
-This works only for unified filenames, see @ref{Issues}.
-@end ifset
-
-
-@item @option{smb} --- @command{smbclient}
-@cindex method smb
-@cindex smb method
-
-This is another not natural @value{tramp} method.  It uses the
-@command{smbclient} command on different Unices in order to connect to
-an SMB server.  An SMB server might be a Samba (or CIFS) server on
-another UNIX host or, more interesting, a host running MS Windows.  So
-far, it is tested towards MS Windows NT, MS Windows 2000, and MS
-Windows XP.
-
-The first directory in the localname must be a share name on the remote
-host.  Remember, that the @code{$} character in which default shares
-usually end, must be written @code{$$} due to environment variable
-substitution in file names.  If no share name is given (i.e. remote
-directory @code{/}), all available shares are listed.
-
-Since authorization is done on share level, you will be prompted
-always for a password if you access another share on the same host.
-This can be suppressed by @ref{Password caching}.
-
-MS Windows uses for authorization both a user name and a domain name.
-Because of this, the @value{tramp} syntax has been extended: you can
-specify a user name which looks like @code{user%domain} (the real user
-name, then a percent sign, then the domain name).  So, to connect to
-the machine @code{melancholia} as user @code{daniel} of the domain
-@code{BIZARRE}, and edit @file{.emacs} in the home directory (share
-@code{daniel$}) I would specify the filename
-@file{@value{prefix}smb@value{postfixsinglehop}daniel%BIZARRE@@melancholia@value{postfix}/daniel$$/.emacs}.
-
-The domain name as well as the user name are optional.  If no user
-name is specified at all, the anonymous user (without password
-prompting) is assumed.  This is different from all other @value{tramp}
-methods, where in such a case the local user name is taken.
-
-The @option{smb} method supports the @samp{-p} hack.
-
-@strong{Please note:} If @value{emacsname} runs locally under MS
-Windows, this method isn't available.  Instead of, you can use UNC
-file names like @file{//melancholia/daniel$$/.emacs}.  The only
-disadvantage is that there's no possibility to specify another user
-name.
-
-@end table
-
-@node Multi-hop Methods
-@section Connecting to a remote host using multiple hops
-@cindex multi-hop methods
-@cindex methods, multi-hop
-
-Sometimes, the methods described before are not sufficient.  Sometimes,
-it is not possible to connect to a remote host using a simple command.
-For example, if you are in a secured network, you might have to log in
-to a `bastion host' first before you can connect to the outside world.
-Of course, the target host may also require a bastion host.  The format
-of multi-hop filenames is slightly different than the format of normal
-@value{tramp} methods.
-
-@cindex method multi
-@cindex multi method
-A multi-hop file name specifies a method, a number of hops, and a
-localname (path name on the remote system).  The method name is always
-@option{multi}.
-
-Each hop consists of a @dfn{hop method} specification, a user name and
-a host name.  The hop method can be an inline method only.  The
-following hop methods are (currently) available:
-
-@table @option
-@item telnet
-@cindex hop method telnet
-@cindex telnet hop method
-
-Uses the well-known @command{telnet} program to connect to the host.
-Whereas user name and host name are supplied in the file name, the
-user is queried for the password.
-
-@item rsh
-@cindex hop method rsh
-@cindex rsh hop method
-
-This uses @command{rsh} to connect to the host.  You do not need to
-enter a password unless @command{rsh} explicitly asks for it.
-
-The variant @option{remsh} uses the @command{remsh} command.  It
-should be applied on machines where @command{remsh} is used instead of
-@command{rsh}.
-
-@item ssh
-@cindex hop method ssh
-@cindex ssh hop method
-
-This uses @command{ssh} to connect to the host.  You might have to enter
-a password or a pass phrase.
-
-@item su
-@cindex hop method su
-@cindex su hop method
-
-This method does not actually contact a different host, but it allows
-you to become a different user on the host you're currently on.  This
-might be useful if you want to edit files as root, but the remote host
-does not allow remote root logins.  In this case you can use
-@option{telnet}, @option{rsh} or @option{ssh} to connect to the
-remote host as a non-root user, then use an @option{su} hop to become
-root.  But @option{su} need not be the last hop in a sequence, you could
-also use it somewhere in the middle, if the need arises.
-
-Even though you @emph{must} specify both user and host with an
-@option{su} hop, the host name is ignored and only the user name is
-used.
-
-@item sudo
-@cindex hop method sudo
-@cindex sudo hop method
-
-This is similar to the @option{su} hop, except that it uses
-@command{sudo} rather than @command{su} to become a different user.
-
-@end table
-
-Some people might wish to use port forwarding with @command{ssh} or
-maybe they have to use a nonstandard port.  This can be accomplished
-by putting a stanza in @file{~/.ssh/config} for the account which
-specifies a different port number for a certain host name.  But it can
-also be accomplished within @value{tramp}, by adding a multi-hop method.
-For example:
-
-@lisp
-(add-to-list
- 'tramp-multi-connection-function-alist
- '("sshf" tramp-multi-connect-rlogin "ssh %h -l %u -p 4400%n"))
-@end lisp
-
-Now you can use an @option{sshf} hop which connects to port 4400 instead of
-the standard port.
-
-
-@node Default Method
-@section Selecting a default method
-@cindex default method
-
-@vindex tramp-default-method
-When you select an appropriate transfer method for your typical usage
-you should set the variable @code{tramp-default-method} to reflect that
-choice.  This variable controls which method will be used when a method
-is not specified in the @value{tramp} file name.  For example:
-
-@lisp
-(setq tramp-default-method "scp")
-@end lisp
-
-@vindex tramp-default-method-alist
-You can also specify different methods for certain user/host
-combinations, via the variable @code{tramp-default-method-alist}.  For
-example, the following two lines specify to use the @option{ssh}
-method for all user names matching @samp{john} and the @option{rsync}
-method for all host names matching @samp{lily}.  The third line
-specifies to use the @option{su} method for the user @samp{root} on
-the machine @samp{localhost}.
-
-@lisp
-(add-to-list 'tramp-default-method-alist '("" "john" "ssh"))
-(add-to-list 'tramp-default-method-alist '("lily" "" "rsync"))
-(add-to-list 'tramp-default-method-alist
-             '("\\`localhost\\'" "\\`root\\'" "su"))
-@end lisp
-
-@noindent
-See the documentation for the variable
-@code{tramp-default-method-alist} for more details.
-
-External transfer methods are normally preferable to inline transfer
-methods, giving better performance.
-
-@xref{Inline methods}.
-@xref{External transfer methods}.
-@xref{Multi-hop Methods}.
-
-Another consideration with the selection of transfer methods is the
-environment you will use them in and, especially when used over the
-Internet, the security implications of your preferred method.
-
-The @option{rsh} and @option{telnet} methods send your password as
-plain text as you log in to the remote machine, as well as
-transferring the files in such a way that the content can easily be
-read from other machines.
-
-If you need to connect to remote systems that are accessible from the
-Internet, you should give serious thought to using @option{ssh} based
-methods to connect. These provide a much higher level of security,
-making it a non-trivial exercise for someone to obtain your password
-or read the content of the files you are editing.
-
-
-@subsection Which method is the right one for me?
-@cindex choosing the right method
-
-Given all of the above, you are probably thinking that this is all fine
-and good, but it's not helping you to choose a method!  Right you are.
-As a developer, we don't want to boss our users around but give them
-maximum freedom instead.  However, the reality is that some users would
-like to have some guidance, so here I'll try to give you this guidance
-without bossing you around.  You tell me whether it works @dots{}
-
-My suggestion is to use an inline method.  For large files, out-of-band
-methods might be more efficient, but I guess that most people will want
-to edit mostly small files.
-
-I guess that these days, most people can access a remote machine by
-using @command{ssh}.  So I suggest that you use the @option{ssh}
-method.  So, type @kbd{C-x C-f
-@value{prefix}ssh@value{postfixsinglehop}root@@otherhost@value{postfix}/etc/motd
-@key{RET}} to edit the @file{/etc/motd} file on the other host.
-
-If you can't use @option{ssh} to log in to the remote host, then
-select a method that uses a program that works.  For instance, Windows
-users might like the @option{plink} method which uses the PuTTY
-implementation of @command{ssh}.  Or you use Kerberos and thus like
-@option{krlogin}.
-
-For the special case of editing files on the local host as another
-user, see the @option{su} or @option{sudo} methods.  They offer
-shortened syntax for the @samp{root} account, like
-@file{@value{prefix}su@value{postfixsinglehop}@value{postfix}/etc/motd}.
-
-People who edit large files may want to consider @option{scp} instead
-of @option{ssh}, or @option{pscp} instead of @option{plink}.  These
-out-of-band methods are faster than inline methods for large files.
-Note, however, that out-of-band methods suffer from some limitations.
-Please try first whether you really get a noticeable speed advantage
-from using an out-of-band method!  Maybe even for large files, inline
-methods are fast enough.
-
-
-@node Customizing Methods
-@section Using Non-Standard Methods
-@cindex customizing methods
-@cindex using non-standard methods
-@cindex create your own methods
-
-There is a variable @code{tramp-methods} which you can change if the
-predefined methods don't seem right.
-
-For the time being, I'll refer you to the Lisp documentation of that
-variable, accessible with @kbd{C-h v tramp-methods @key{RET}}.
-
-
-@node Customizing Completion
-@section Selecting config files for user/host name completion
-@cindex customizing completion
-@cindex selecting config files
-@vindex tramp-completion-function-alist
-
-The variable @code{tramp-completion-function-alist} is intended to
-customize which files are taken into account for user and host name
-completion (@pxref{Filename completion}).  For every method, it keeps
-a set of configuration files, accompanied by a Lisp function able to
-parse that file.  Entries in @code{tramp-completion-function-alist}
-have the form (@var{method} @var{pair1} @var{pair2} ...).
-
-Each @var{pair} is composed of (@var{function} @var{file}).
-@var{function} is responsible to extract user names and host names
-from @var{file} for completion.  There are two functions which access
-this variable:
-
-@defun tramp-get-completion-function method
-This function returns the list of completion functions for @var{method}.
-
-Example:
-@example
-(tramp-get-completion-function "rsh")
-
-     @result{} ((tramp-parse-rhosts "/etc/hosts.equiv")
-         (tramp-parse-rhosts "~/.rhosts"))
-@end example
-@end defun
-
-@defun tramp-set-completion-function method function-list
-This function sets @var{function-list} as list of completion functions
-for @var{method}.
-
-Example:
-@example
-(tramp-set-completion-function "ssh"
- '((tramp-parse-sconfig "/etc/ssh_config")
-   (tramp-parse-sconfig "~/.ssh/config")))
-
-     @result{} ((tramp-parse-sconfig "/etc/ssh_config")
-         (tramp-parse-sconfig "~/.ssh/config"))
-@end example
-@end defun
-
-The following predefined functions parsing configuration files exist:
-
-@table @asis
-@item @code{tramp-parse-rhosts}
-@findex tramp-parse-rhosts
-
-This function parses files which are syntactical equivalent to
-@file{~/.rhosts}.  It returns both host names and user names, if
-specified.
-
-@item @code{tramp-parse-shosts}
-@findex tramp-parse-shosts
-
-This function parses files which are syntactical equivalent to
-@file{~/.ssh/known_hosts}.  Since there are no user names specified
-in such files, it can return host names only.
-
-@item @code{tramp-parse-sconfig}
-@findex tramp-parse-shosts
-
-This function returns the host nicknames defined by @code{Host} entries
-in @file{~/.ssh/config} style files.
-
-@item @code{tramp-parse-shostkeys}
-@findex tramp-parse-shostkeys
-
-SSH2 parsing of directories @file{/etc/ssh2/hostkeys/*} and
-@file{~/ssh2/hostkeys/*}.  Hosts are coded in file names
-@file{hostkey_@var{portnumber}_@var{host-name}.pub}.  User names
-are always @code{nil}.
-
-@item @code{tramp-parse-sknownhosts}
-@findex tramp-parse-shostkeys
-
-Another SSH2 style parsing of directories like
-@file{/etc/ssh2/knownhosts/*} and @file{~/ssh2/knownhosts/*}.  This
-case, hosts names are coded in file names
-@file{@var{host-name}.@var{algorithm}.pub}.  User names are always @code{nil}.
-
-@item @code{tramp-parse-hosts}
-@findex tramp-parse-hosts
-
-A function dedicated to @file{/etc/hosts} style files.  It returns
-host names only.
-
-@item @code{tramp-parse-passwd}
-@findex tramp-parse-passwd
-
-A function which parses @file{/etc/passwd} like files.  Obviously, it
-can return user names only.
-
-@item @code{tramp-parse-netrc}
-@findex tramp-parse-netrc
-
-Finally, a function which parses @file{~/.netrc} like files.
-@end table
-
-If you want to keep your own data in a file, with your own structure,
-you might provide such a function as well.  This function must meet
-the following conventions:
-
-@defun my-tramp-parse file
-@var{file} must be either a file name on your host, or @code{nil}. The
-function must return a list of (@var{user} @var{host}), which are
-taken as candidates for user and host name completion.
-
-Example:
-@example
-(my-tramp-parse "~/.my-tramp-hosts")
-
-     @result{} ((nil "toto") ("daniel" "melancholia"))
-@end example
-@end defun
-
-
-@node Password caching
-@section Reusing passwords for several connections.
-@cindex passwords
-
-Sometimes it is necessary to connect to the same remote host several
-times.  Reentering passwords again and again would be annoying, when
-the choosen method does not support access without password prompt
-throught own configuration.
-
-By default, @value{tramp} caches the passwords entered by you.  They will
-be reused next time if a connection needs them for the same user name
-and host name, independant of the connection method.
-
-@vindex password-cache-expiry
-Passwords are not saved permanently, that means the password caching
-is limited to the lifetime of your @value{emacsname} session.  You
-can influence the lifetime of password caching by customizing the
-variable @code{password-cache-expiry}.  The value is the number of
-seconds how long passwords are cached.  Setting it to @code{nil}
-disables the expiration.
-
-@findex tramp-clear-passwd
-A password is removed from the cache if a connection isn't established
-successfully.  You can remove a password from the cache also by
-executing @kbd{M-x tramp-clear-passwd} in a buffer containing a
-related remote file or directory.
-
-@vindex password-cache
-If you don't like this feature for security reasons, password caching
-can be disabled totally by customizing the variable
-@code{password-cache} (setting it to @code{nil}).
-
-Implementation Note: password caching is based on the package
-password.el in No Gnus.  For the time being, it is activated only when
-this package is seen in the @code{load-path} while loading @value{tramp}.
-@ifset installchapter
-If you don't use No Gnus, you can take password.el from the @value{tramp}
-@file{contrib} directory, see @ref{Installation parameters}.
-@end ifset
-It will be activated mandatory once No Gnus has found its way into
-@value{emacsname}.
-
-
-@node Remote Programs
-@section How @value{tramp} finds and uses programs on the remote machine.
-
-@value{tramp} depends on a number of programs on the remote host in order to
-function, including @command{ls}, @command{test}, @command{find} and
-@command{cat}.
-
-In addition to these required tools, there are various tools that may be
-required based on the connection method. See @ref{Inline methods} and
-@ref{External transfer methods} for details on these.
-
-Certain other tools, such as @command{perl} (or @command{perl5}) and
-@command{grep} will be used if they can be found. When they are
-available, they are used to improve the performance and accuracy of
-remote file access.
-
-@vindex tramp-remote-path
-When @value{tramp} connects to the remote machine, it searches for the
-programs that it can use. The variable @var{tramp-remote-path} controls
-the directories searched on the remote machine.
-
-By default, this is set to a reasonable set of defaults for most
-machines. It is possible, however, that your local (or remote ;) system
-administrator has put the tools you want in some obscure local
-directory.
-
-In this case, you can still use them with @value{tramp}. You simply need to
-add code to your @file{.emacs} to add the directory to the remote path.
-This will then be searched by @value{tramp} when you connect and the software
-found.
-
-To add a directory to the remote search path, you could use code such
-as:
-
-@lisp
-@i{;; We load @value{tramp} to define the variable.}
-(require 'tramp)
-@i{;; We have @command{perl} in "/usr/local/perl/bin"}
-(add-to-list 'tramp-remote-path "/usr/local/perl/bin")
-@end lisp
-
-
-@node Remote shell setup
-@comment  node-name,  next,  previous,  up
-@section Remote shell setup hints
-@cindex remote shell setup
-@cindex @file{.profile} file
-@cindex @file{.login} file
-@cindex shell init files
-
-As explained in the @ref{Overview} section, @value{tramp} connects to the
-remote host and talks to the shell it finds there.  Of course, when you
-log in, the shell executes its init files.  Suppose your init file
-requires you to enter the birth date of your mother; clearly @value{tramp}
-does not know this and hence fails to log you in to that host.
-
-There are different possible strategies for pursuing this problem.  One
-strategy is to enable @value{tramp} to deal with all possible situations.
-This is a losing battle, since it is not possible to deal with
-@emph{all} situations.  The other strategy is to require you to set up
-the remote host such that it behaves like @value{tramp} expects.  This might
-be inconvenient because you have to invest a lot of effort into shell
-setup before you can begin to use @value{tramp}.
-
-The package, therefore, pursues a combined approach.  It tries to
-figure out some of the more common setups, and only requires you to
-avoid really exotic stuff.  For example, it looks through a list of
-directories to find some programs on the remote host.  And also, it
-knows that it is not obvious how to check whether a file exists, and
-therefore it tries different possibilities.  (On some hosts and
-shells, the command @command{test -e} does the trick, on some hosts
-the shell builtin doesn't work but the program @command{/usr/bin/test
--e} or @command{/bin/test -e} works.  And on still other hosts,
-@command{ls -d} is the right way to do this.)
-
-Below you find a discussion of a few things that @value{tramp} does not deal
-with, and that you therefore have to set up correctly.
-
-@table @asis
-@item @var{shell-prompt-pattern}
-@vindex shell-prompt-pattern
-
-After logging in to the remote host, @value{tramp} has to wait for the remote
-shell startup to finish before it can send commands to the remote
-shell.  The strategy here is to wait for the shell prompt.  In order to
-recognize the shell prompt, the variable @code{shell-prompt-pattern} has
-to be set correctly to recognize the shell prompt on the remote host.
-
-Note that @value{tramp} requires the match for @code{shell-prompt-pattern}
-to be at the end of the buffer.  Many people have something like the
-following as the value for the variable: @code{"^[^>$][>$] *"}.  Now
-suppose your shell prompt is @code{a  c $ }.  In this case,
-@value{tramp} recognizes the @code{>} character as the end of the prompt,
-but it is not at the end of the buffer.
-
-@item @var{tramp-shell-prompt-pattern}
-@vindex tramp-shell-prompt-pattern
-
-This regular expression is used by @value{tramp} in the same way as
-@code{shell-prompt-pattern}, to match prompts from the remote shell.
-This second variable exists because the prompt from the remote shell
-might be different from the prompt from a local shell --- after all,
-the whole point of @value{tramp} is to log in to remote hosts as a
-different user.  The default value of
-@code{tramp-shell-prompt-pattern} is the same as the default value of
-@code{shell-prompt-pattern}, which is reported to work well in many
-circumstances.
-
-@item @command{tset} and other questions
-@cindex Unix command tset
-@cindex tset Unix command
-
-Some people invoke the @command{tset} program from their shell startup
-scripts which asks the user about the terminal type of the shell.
-Maybe some shells ask other questions when they are started.  @value{tramp}
-does not know how to answer these questions.  There are two approaches
-for dealing with this problem.  One approach is to take care that the
-shell does not ask any questions when invoked from @value{tramp}.  You can
-do this by checking the @code{TERM} environment variable, it will be
-set to @code{dumb} when connecting.
-
-@vindex tramp-terminal-type
-The variable @code{tramp-terminal-type} can be used to change this value
-to @code{dumb}.
-
-The other approach is to teach @value{tramp} about these questions.  See
-the variables @code{tramp-actions-before-shell} and
-@code{tramp-multi-actions} (for multi-hop connections).
-
-
-@item Environment variables named like users in @file{.profile}
-
-If you have a user named frumple and set the variable @code{FRUMPLE} in
-your shell environment, then this might cause trouble.  Maybe rename
-the variable to @code{FRUMPLE_DIR} or the like.
-
-This weird effect was actually reported by a @value{tramp} user!
-
-
-@item Non-Bourne commands in @file{.profile}
-
-After logging in to the remote host, @value{tramp} issues the command
-@command{exec /bin/sh}.  (Actually, the command is slightly
-different.)  When @command{/bin/sh} is executed, it reads some init
-files, such as @file{~/.shrc} or @file{~/.profile}.
-
-Now, some people have a login shell which is not @code{/bin/sh} but a
-Bourne-ish shell such as bash or ksh.  Some of these people might put
-their shell setup into the files @file{~/.shrc} or @file{~/.profile}.
-This way, it is possible for non-Bourne constructs to end up in those
-files.  Then, @command{exec /bin/sh} might cause the Bourne shell to
-barf on those constructs.
-
-As an example, imagine somebody putting @command{export FOO=bar} into
-the file @file{~/.profile}.  The standard Bourne shell does not
-understand this syntax and will emit a syntax error when it reaches
-this line.
-
-Another example is the tilde (@code{~}) character, say when adding
-@file{~/bin} to @code{$PATH}.  Many Bourne shells will not expand this
-character, and since there is usually no directory whose name consists
-of the single character tilde, strange things will happen.
-
-What can you do about this?
-
-Well, one possibility is to make sure that everything in @file{~/.shrc}
-and @file{~/.profile} on all remote hosts is Bourne-compatible.  In the
-above example, instead of @command{export FOO=bar}, you might use
-@command{FOO=bar; export FOO} instead.
-
-The other possibility is to put your non-Bourne shell setup into some
-other files.  For example, bash reads the file @file{~/.bash_profile}
-instead of @file{~/.profile}, if the former exists.  So bash
-aficionados just rename their @file{~/.profile} to
-@file{~/.bash_profile} on all remote hosts, and Bob's your uncle.
-
-The @value{tramp} developers would like to circumvent this problem, so
-if you have an idea about it, please tell us.  However, we are afraid
-it is not that simple: before saying @command{exec /bin/sh},
-@value{tramp} does not know which kind of shell it might be talking
-to.  It could be a Bourne-ish shell like ksh or bash, or it could be a
-csh derivative like tcsh, or it could be zsh, or even rc.  If the
-shell is Bourne-ish already, then it might be prudent to omit the
-@command{exec /bin/sh} step.  But how to find out if the shell is
-Bourne-ish?
-
-@end table
-
-
-@node Auto-save and Backup
-@section Auto-save and Backup configuration
-@cindex auto-save
-@cindex backup
-@ifset emacs
-@vindex backup-directory-alist
-@end ifset
-@ifset xemacs
-@vindex bkup-backup-directory-info
-@end ifset
-
-Normally, @value{emacsname} writes backup files to the same directory
-as the original files, but this behavior can be changed via the
-variable
-@ifset emacs
-@code{backup-directory-alist}.
-@end ifset
-@ifset xemacs
-@code{bkup-backup-directory-info}.
-@end ifset
-In connection with @value{tramp}, this can have unexpected side effects.
-Suppose that you specify that all backups should go to the directory
-@file{~/.emacs.d/backups/}, and then you edit the file
-@file{@value{prefix}su@value{postfixsinglehop}root@@localhost@value{postfix}/etc/secretfile}.
-The effect is that the backup file will be owned by you and not by
-root, thus possibly enabling others to see it even if they were not
-intended to see it.
-
-When
-@ifset emacs
-@code{backup-directory-alist}
-@end ifset
-@ifset xemacs
-@code{bkup-backup-directory-info}
-@end ifset
-is @code{nil} (the default), such problems do not occur.
-
-Therefore, it is usefull to set special values for @value{tramp}
-files.  For example, the following statement effectively `turns off'
-the effect of
-@ifset emacs
-@code{backup-directory-alist}
-@end ifset
-@ifset xemacs
-@code{bkup-backup-directory-info}
-@end ifset
-for @value{tramp} files:
-
-@ifset emacs
-@lisp
-(add-to-list 'backup-directory-alist
-             (cons tramp-file-name-regexp nil))
-@end lisp
-@end ifset
-@ifset xemacs
-@lisp
-(require 'backup-dir)
-(add-to-list 'bkup-backup-directory-info
-             (list tramp-file-name-regexp ""))
-@end lisp
-@end ifset
-
-Another possibility is to use the @value{tramp} variable
-@ifset emacs
-@code{tramp-backup-directory-alist}.
-@end ifset
-@ifset xemacs
-@code{tramp-bkup-backup-directory-info}.
-@end ifset
-This variable has the same meaning like
-@ifset emacs
-@code{backup-directory-alist}.
-@end ifset
-@ifset xemacs
-@code{bkup-backup-directory-info}.
-@end ifset
-If a @value{tramp} file is backed up, and DIRECTORY is an absolute
-local file name, DIRECTORY is prepended with the @value{tramp} file
-name prefix of the file to be backed up.
-
-@noindent
-Example:
-
-@ifset emacs
-@lisp
-(add-to-list 'backup-directory-alist
-             (cons "." "~/.emacs.d/backups/"))
-(setq tramp-backup-directory-alist backup-directory-alist)
-@end lisp
-@end ifset
-@ifset xemacs
-@lisp
-(require 'backup-dir)
-(add-to-list 'bkup-backup-directory-info
-             (list "." "~/.emacs.d/backups/" 'full-path))
-(setq tramp-bkup-backup-directory-info bkup-backup-directory-info)
-@end lisp
-@end ifset
-
-@noindent
-The backup file name of
-@file{@value{prefix}su@value{postfixsinglehop}root@@localhost@value{postfix}/etc/secretfile}
-would be
-@ifset emacs
-@file{@value{prefix}su@value{postfixsinglehop}root@@localhost@value{postfix}~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile~}
-@end ifset
-@ifset xemacs
-@file{@value{prefix}su@value{postfixsinglehop}root@@localhost@value{postfix}~/.emacs.d/backups/![su!root@@localhost]!etc!secretfile~}
-@end ifset
-
-The same problem can happen with auto-saving files.
-@ifset emacs
-Since @value{emacsname} 21, the variable
-@code{auto-save-file-name-transforms} keeps information, on which
-directory an auto-saved file should go.  By default, it is initialized
-for @value{tramp} files to the local temporary directory.
-
-On some versions of @value{emacsname}, namely the version built for
-Debian GNU/Linux, the variable @code{auto-save-file-name-transforms}
-contains the directory where @value{emacsname} was built.  A
-workaround is to manually set the variable to a sane value.
-
-If auto-saved files should go into the same directory as the original
-files, @code{auto-save-file-name-transforms} should be set to @code{nil}.
-
-Another possibility is to set the variable
-@code{tramp-auto-save-directory} to a proper value.
-@end ifset
-@ifset xemacs
-For this purpose you can set the variable @code{auto-save-directory}
-to a proper value.
-@end ifset
-
-
-@node Windows setup hints
-@section Issues with Cygwin ssh
-@cindex Cygwin, issues
-
-This section needs a lot of work!  Please help.
-
-@cindex method sshx with Cygwin
-@cindex sshx method with Cygwin
-The recent Cygwin installation of @command{ssh} works only with a
-Cygwinized @value{emacsname}.  You can check it by typing @kbd{M-x
-eshell}, and starting @kbd{ssh test.machine}.  The problem is evident
-if you see a message like this:
-
-@example
-Pseudo-terminal will not be allocated because stdin is not a terminal.
-@end example
-
-Older @command{ssh} versions of Cygwin are told to cooperate with
-@value{tramp} selecting @option{sshx} as the connection method.  You
-can find information about setting up Cygwin in their FAQ at
-@uref{http://cygwin.com/faq/}.
-
-@cindex method scpx with Cygwin
-@cindex scpx method with Cygwin
-If you wish to use the @option{scpx} connection method, then you might
-have the problem that @value{emacsname} calls @command{scp} with a
-Windows filename such as @code{c:/foo}.  The Cygwin version of
-@command{scp} does not know about Windows filenames and interprets this
-as a remote filename on the host @code{c}.
-
-One possible workaround is to write a wrapper script for @option{scp}
-which converts the Windows filename to a Cygwinized filename.
-
-@cindex Cygwin and ssh-agent
-@cindex SSH_AUTH_SOCK and @value{emacsname} on Windows
-If you want to use either @option{ssh} based method on Windows, then
-you might encounter problems with @command{ssh-agent}.  Using this
-program, you can avoid typing the pass-phrase every time you log in.
-However, if you start @value{emacsname} from a desktop shortcut, then
-the environment variable @code{SSH_AUTH_SOCK} is not set and so
-@value{emacsname} and thus @value{tramp} and thus @command{ssh} and
-@command{scp} started from @value{tramp} cannot communicate with
-@command{ssh-agent}.  It works better to start @value{emacsname} from
-the shell.
-
-If anyone knows how to start @command{ssh-agent} under Windows in such a
-way that desktop shortcuts can profit, please holler.  I don't really
-know anything at all about Windows@dots{}
-
-
-@node Usage
-@chapter Using @value{tramp}
-@cindex using @value{tramp}
-
-Once you have installed @value{tramp} it will operate fairly transparently. You
-will be able to access files on any remote machine that you can log in
-to as though they were local.
-
-Files are specified to @value{tramp} using a formalized syntax specifying the
-details of the system to connect to.  This is similar to the syntax used
-by the @value{ftppackagename} package.
-
-@cindex type-ahead
-Something that might happen which surprises you is that
-@value{emacsname} remembers all your keystrokes, so if you see a
-password prompt from @value{emacsname}, say, and hit @kbd{@key{RET}}
-twice instead of once, then the second keystroke will be processed by
-@value{emacsname} after @value{tramp} has done its thing.  Why, this
-type-ahead is normal behavior, you say.  Right you are, but be aware
-that opening a remote file might take quite a while, maybe half a
-minute when a connection needs to be opened.  Maybe after half a
-minute you have already forgotten that you hit that key!
-
-@menu
-* Filename Syntax::             @value{tramp} filename conventions.
-* Multi-hop filename syntax::   Multi-hop filename conventions.
-* Filename completion::         Filename completion.
-* Dired::                       Dired.
-* Compilation::                 Compile remote files.
-@end menu
-
-
-@node Filename Syntax
-@section @value{tramp} filename conventions
-@cindex filename syntax
-@cindex filename examples
-
-To access the file @var{localname} on the remote machine @var{machine} you
-would specify the filename
-@file{@value{prefix}@var{machine}@value{postfix}@var{localname}}.
-This will connect to @var{machine} and transfer the file using the
-default method.  @xref{Default Method}.
-
-Some examples of @value{tramp} filenames are shown below.
-
-@table @file
-@item @value{prefix}melancholia@value{postfix}.emacs
-Edit the file @file{.emacs} in your home directory on the machine
-@code{melancholia}.
-
-@item @value{prefix}melancholia.danann.net@value{postfix}.emacs
-This edits the same file, using the fully qualified domain name of
-the machine.
-
-@item @value{prefix}melancholia@value{postfix}~/.emacs
-This also edits the same file --- the @file{~} is expanded to your
-home directory on the remote machine, just like it is locally.
-
-@item @value{prefix}melancholia@value{postfix}~daniel/.emacs
-This edits the file @file{.emacs} in the home directory of the user
-@code{daniel} on the machine @code{melancholia}. The @file{~}
-construct is expanded to the home directory of that user on the remote
-machine.
-
-@item @value{prefix}melancholia@value{postfix}/etc/squid.conf
-This edits the file @file{/etc/squid.conf} on the machine
-@code{melancholia}.
-
-@end table
-
-Unless you specify a different name to use, @value{tramp} will use the
-current local user name as the remote user name to log in with. If you
-need to log in as a different user, you can specify the user name as
-part of the filename.
-
-To log in to the remote machine as a specific user, you use the syntax
-@file{@value{prefix}@var{user}@@@var{machine}@value{postfix}/@var{path/to.file}}.
-That means that connecting to @code{melancholia} as @code{daniel} and
-editing @file{.emacs} in your home directory you would specify
-@file{@value{prefix}daniel@@melancholia@value{postfix}.emacs}.
-
-It is also possible to specify other file transfer methods
-(@pxref{Default Method}) as part of the filename.
-@ifset emacs
-This is done by putting the method before the user and host name, as
-in
-@file{@value{prefix}@var{method}@value{postfixsinglehop}}
-(Note the trailing colon).
-@end ifset
-@ifset xemacs
-This is done by replacing the initial
-@file{@value{prefix}} with
-@file{@value{prefix}@value{postfixsinglehop}}.
-(Note the trailing slash!).
-@end ifset
-The user, machine and file specification remain the same.
-
-So, to connect to the machine @code{melancholia} as @code{daniel},
-using the @option{ssh} method to transfer files, and edit @file{.emacs}
-in my home directory I would specify the filename
-@file{@value{prefix}ssh@value{postfixsinglehop}daniel@@melancholia@value{postfix}.emacs}.
-
-
-@node Multi-hop filename syntax
-@section Multi-hop filename conventions
-@cindex filename syntax for multi-hop files
-@cindex multi-hop filename syntax
-
-The syntax of multi-hop file names is necessarily slightly different
-than the syntax of other @value{tramp} file names.  Here's an example
-multi-hop file name:
-
-@example
-@value{prefix}multi@value{postfixsinglehop}rsh@value{postfixmultihop}out@@gate@value{postfixsinglehop}telnet@value{postfixmultihop}kai@@real.host@value{postfix}/path/to.file
-@end example
-
-This is quite a mouthful.  So let's go through it step by step.  The
-file name consists of three parts.
-@ifset emacs
-The parts are separated by colons
-@end ifset
-@ifset xemacs
-The parts are separated by slashes and square brackets.
-@end ifset
-The first part is @file{@value{prefix}multi}, the method
-specification.  The second part is
-@file{rsh@value{postfixmultihop}out@@gate@value{postfixsinglehop}telnet@value{postfixmultihop}kai@@real.host}
-and specifies the hops.  The final part is @file{/path/to.file} and
-specifies the file name on the remote host.
-
-The first part and the final part should be clear.  See @ref{Multi-hop
-Methods}, for a list of alternatives for the method specification.
-
-The second part can be subdivided again into components, so-called
-hops.  In the above file name, there are two hops,
-@file{rsh@value{postfixmultihop}out@@gate} and
-@file{telnet@value{postfixmultihop}kai@@real.host}.
-
-Each hop can @emph{again} be subdivided into (three) components, the
-@dfn{hop method}, the @dfn{user name} and the @dfn{host name}.  The
-meaning of the second and third component should be clear, and the hop
-method says what program to use to perform that hop.
-
-The first hop, @file{rsh@value{postfixmultihop}out@@gate},
-says to use @command{rsh} to log in as user @code{out} to the host
-@code{gate}.  Starting at that host, the second hop,
-@file{telnet@value{postfixmultihop}kai@@real.host}, says to
-use @command{telnet} to log in as user @code{kai} to host
-@code{real.host}.
-
-@xref{Multi-hop Methods}, for a list of possible hop method values.
-The variable @code{tramp-multi-connection-function-alist} contains the
-list of possible hop methods and information on how to execute them,
-should you want to add your own.
-
-
-@node Filename completion
-@section Filename completion
-@cindex filename completion
-
-Filename completion works with @value{tramp} for both completing methods,
-user names and machine names (except multi hop methods) as well as for
-files on remote machines.
-
-If you, for example, type @kbd{C-x C-f @value{prefix}t
-@key{TAB}}, @value{tramp} might give you as result the choice for
-
-@example
-@ifset emacs
-@value{prefixsinglehop}telnet@value{postfixsinglehop}				   tmp/
-@value{prefixsinglehop}toto@value{postfix}
-@end ifset
-@ifset xemacs
-@value{prefixsinglehop}telnet@value{postfixsinglehop}				   @value{prefixsinglehop}toto@value{postfix}
-@end ifset
-@end example
-
-@samp{@value{prefixsinglehop}telnet@value{postfixsinglehop}}
-is a possible completion for the respective method,
-@ifset emacs
-@samp{tmp/} stands for the directory @file{/tmp} on your local
-machine,
-@end ifset
-and @samp{@value{prefixsinglehop}toto@value{postfix}}
-might be a host @value{tramp} has detected in your @file{~/.ssh/known_hosts}
-file (given you're using default method @option{ssh}).
-
-If you go on to type @kbd{e @key{TAB}}, the minibuffer is completed to
-@samp{@value{prefix}telnet@value{postfixsinglehop}}.
-Next @kbd{@key{TAB}} brings you all machine names @value{tramp} detects in
-your @file{/etc/hosts} file, let's say
-
-@example
-@value{prefixsinglehop}telnet@value{postfixsinglehop}127.0.0.1@value{postfix}		   @value{prefixsinglehop}telnet@value{postfixsinglehop}192.168.0.1@value{postfix}
-@value{prefixsinglehop}telnet@value{postfixsinglehop}localhost@value{postfix}		   @value{prefixsinglehop}telnet@value{postfixsinglehop}melancholia.danann.net@value{postfix}
-@value{prefixsinglehop}telnet@value{postfixsinglehop}melancholia@value{postfix}
-@end example
-
-Now you can choose the desired machine, and you can continue to
-complete file names on that machine.
-
-As filename completion needs to fetch the listing of files from the
-remote machine, this feature is sometimes fairly slow.  As @value{tramp}
-does not yet cache the results of directory listing, there is no gain
-in performance the second time you complete filenames.
-
-If the configuration files (@pxref{Customizing Completion}), which
-@value{tramp} uses for analysis of completion, offer user names, those user
-names will be taken into account as well.
-
-
-@node Dired
-@section Dired
-@cindex dired
-
-@value{tramp} works transparently with dired, enabling you to use this powerful
-file management tool to manage files on any machine you have access to
-over the Internet.
-
-If you need to browse a directory tree, Dired is a better choice, at
-present, than filename completion.  Dired has its own cache mechanism
-and will only fetch the directory listing once.
-
-
-@node Compilation
-@section Compile remote files
-@cindex compile
-@cindex recompile
-
-@value{tramp} provides commands for compilation of files on remote
-machines.  In order to get them loaded, you need to require
-@file{tramp-util.el}:
-
-@lisp
-(require 'tramp-util)
-@end lisp
-
-Afterwards, you can use the commands @code{tramp-compile} and
-@code{tramp-recompile} instead of @code{compile} and @code{recompile},
-respectively; @inforef{Compilation, ,@value{emacsdir}}.  This does not
-work for the @option{ftp} and @option{smb} methods.
-
-The corresponding key bindings and menu entries calling these commands
-are redefined automatically for buffers associated with remote files.
-
-After finishing the compilation, you can use the usual commands like
-@code{previous-error}, @code{next-error} and @code{first-error} for
-navigation in the @file{*Compilation*} buffer.
-
-
-@node Bug Reports
-@chapter Reporting Bugs and Problems
-@cindex bug reports
-
-Bugs and problems with @value{tramp} are actively worked on by the development
-team. Feature requests and suggestions are also more than welcome.
-
-The @value{tramp} mailing list is a great place to get information on working
-with @value{tramp}, solving problems and general discussion and advice on topics
-relating to the package.
-
-The mailing list is at @email{tramp-devel@@gnu.org}.  Messages sent to
-this address go to all the subscribers. This is @emph{not} the address
-to send subscription requests to.
-
-Subscribing to the list is performed via
-@uref{http://lists.gnu.org/mailman/listinfo/tramp-devel/,
-the @value{tramp} Mail Subscription Page}.
-
-To report a bug in @value{tramp}, you should execute @kbd{M-x tramp-bug}. This
-will automatically generate a buffer with the details of your system and
-@value{tramp} version.
-
-When submitting a bug report, please try to describe in excruciating
-detail the steps required to reproduce the problem, the setup of the
-remote machine and any special conditions that exist.  You should also
-check that your problem is not described already in @xref{Frequently
-Asked Questions}.
-
-If you can identify a minimal test case that reproduces the problem,
-include that with your bug report. This will make it much easier for the
-development team to analyze and correct the problem.
-
-@node Frequently Asked Questions
-@chapter Frequently Asked Questions
-@cindex frequently asked questions
-@cindex FAQ
-
-@itemize @bullet
-@item
-Where can I get the latest @value{tramp}?
-
-@value{tramp} is available under the URL below.
-
-@noindent
-@uref{ftp://ftp.gnu.org/gnu/tramp/}
-
-@noindent
-There is also a Savannah project page.
-
-@noindent
-@uref{http://savannah.gnu.org/projects/tramp/}
-
-
-@item
-Which systems does it work on?
-
-The package has been used successfully on GNU Emacs 20, GNU Emacs 21
-and GNU Emacs 22, as well as XEmacs 21.  XEmacs 20 is more
-problematic, see the notes in @file{tramp.el}.  I don't think anybody
-has really tried it on GNU Emacs 19.
-
-The package was intended to work on Unix, and it really expects a
-Unix-like system on the remote end (except the @option{smb} method),
-but some people seemed to have some success getting it to work on MS
-Windows NT/2000/XP @value{emacsname}.
-
-There is some informations on @value{tramp} on NT at the following URL;
-many thanks to Joe Stoy for providing the information:
-@uref{ftp://ftp.comlab.ox.ac.uk/tmp/Joe.Stoy/}
-
-@c The link is broken. I've contacted Tom for clarification. Michael.
-@ignore
-The above mostly contains patches to old ssh versions; Tom Roche has a
-Web page with instructions:
-@uref{http://www4.ncsu.edu/~tlroche/plinkTramp.html}
-@end ignore
-
-??? Is the XEmacs info correct?
-
-??? Can somebody provide some information for getting it to work on NT
-Emacs?  I think there was some issue with @command{ssh}?
-
-
-@item
-@value{tramp} does not connect to the remote host
-
-When @value{tramp} does not connect to the remote host, there are two
-reasons heading the bug mailing list:
-
-@itemize @minus
-
-@item
-Unknown characters in the prompt
-
-@value{tramp} needs to recognize the prompt on the remote machine
-after execution any command.  This is not possible, when the prompt
-contains unknown characters like escape sequences for coloring.  This
-should be avoided on the remote side.  @xref{Remote shell setup}. for
-setting the regular expression detecting the prompt.
-
-@item
-@value{tramp} doesn't transfer strings with more than 500 characters
-correctly
-
-On some few systems, the implementation of @code{process-send-string}
-seems to be broken for longer strings.  This case, you should
-customize the variable @code{tramp-chunksize} to 500.  For a
-description how to determine whether this is necessary see the
-documentation of @code{tramp-chunksize}.
-@end itemize
-
-
-@item
-File name completion does not work with @value{tramp}
-
-When you log in to the remote machine, do you see the output of
-@command{ls} in color? If so, this may be the cause of your problems.
-
-@command{ls} outputs @acronym{ANSI} escape sequences that your terminal
-emulator interprets to set the colors.  These escape sequences will
-confuse @value{tramp} however.
-
-In your @file{.bashrc}, @file{.profile} or equivalent on the remote
-machine you probably have an alias configured that adds the option
-@option{--color=yes} or @option{--color=auto}.
-
-You should remove that alias and ensure that a new login @emph{does not}
-display the output of @command{ls} in color.  If you still cannot use
-filename completion, report a bug to the @value{tramp} developers.
-
-
-@item
-File name completion does not work in large directories
-
-@value{tramp} uses globbing for some operations.  (Globbing means to use the
-shell to expand wildcards such as `*.c'.)  This might create long
-command lines, especially in directories with many files.  Some shells
-choke on long command lines, or don't cope well with the globbing
-itself.
-
-If you have a large directory on the remote end, you may wish to execute
-a command like @samp{ls -d * ..?* > /dev/null} and see if it hangs.
-Note that you must first start the right shell, which might be
-@command{/bin/sh}, @command{ksh} or @command{bash}, depending on which
-of those supports tilde expansion.
-
-
-@item
-How can I get notified when @value{tramp} file transfers are complete?
-
-The following snippet can be put in your @file{~/.emacs} file.  It
-makes @value{emacsname} beep after reading from or writing to the
-remote host.
-
-@lisp
-(defadvice tramp-handle-write-region
-  (after tramp-write-beep-advice activate)
- " make tramp beep after writing a file."
- (interactive)
- (beep))
-(defadvice tramp-handle-do-copy-or-rename-file
-  (after tramp-copy-beep-advice activate)
- " make tramp beep after copying a file."
- (interactive)
- (beep))
-(defadvice tramp-handle-insert-file-contents
-  (after tramp-copy-beep-advice activate)
- " make tramp beep after copying a file."
- (interactive)
- (beep))
-@end lisp
-
-
-@item
-There's this @file{~/.sh_history} file on the remote host which keeps
-growing and growing.  What's that?
-
-Sometimes, @value{tramp} starts @command{ksh} on the remote host for
-tilde expansion.  Maybe @command{ksh} saves the history by default.
-@value{tramp} tries to turn off saving the history, but maybe you have
-to help.  For example, you could put this in your @file{.kshrc}:
-
-@example
-if [ -f $HOME/.sh_history ] ; then
-   /bin/rm $HOME/.sh_history
-fi
-if [ "$@{HISTFILE-unset@}" != "unset" ] ; then
-   unset HISTFILE
-fi
-if [ "$@{HISTSIZE-unset@}" != "unset" ] ; then
-   unset HISTSIZE
-fi
-@end example
-
-
-@item
-How can I disable @value{tramp}?
-
-Shame on you, why did you read until now?
-
-@ifset emacs
-If you just want to have @value{ftppackagename} as default remote
-files access package, you should apply the following code:
-
-@lisp
-(setq tramp-default-method "ftp")
-@end lisp
-@end ifset
-
-Unloading @value{tramp} can be achieved by applying @kbd{M-x
-tramp-unload-tramp}.
-@ifset emacs
-This resets also the @value{ftppackagename} plugins.
-@end ifset
-@end itemize
-
-
-@c For the developer
-@node Version Control
-@chapter The inner workings of remote version control
-@cindex Version Control
-
-Unlike @value{ftppackagename}, @value{tramp} has full shell access to the
-remote machine. This makes it possible to provide version control for
-files accessed under @value{tramp}.
-
-The actual version control binaries must be installed on the remote
-machine, accessible in the directories specified in
-@var{tramp-remote-path}.
-
-This transparent integration with the version control systems is one of
-the most valuable features provided by @value{tramp}, but it is far from perfect.
-Work is ongoing to improve the transparency of the system.
-
-@menu
-* Version Controlled Files::    Determining if a file is under version control.
-* Remote Commands::             Executing the version control commands on the remote machine.
-* Changed workfiles::           Detecting if the working file has changed.
-* Checking out files::          Bringing the workfile out of the repository.
-* Miscellaneous Version Control::  Things related to Version Control that don't fit elsewhere.
-@end menu
-
-
-@node Version Controlled Files
-@section Determining if a file is under version control
-
-The VC package uses the existence of on-disk revision control master
-files to determine if a given file is under revision control. These file
-tests happen on the remote machine through the standard @value{tramp} mechanisms.
-
-
-@node Remote Commands
-@section Executing the version control commands on the remote machine
-
-There are no hooks provided by VC to allow intercepting of the version
-control command execution. The calls occur through the
-@code{call-process} mechanism, a function that is somewhat more
-efficient than the @code{shell-command} function but that does not
-provide hooks for remote execution of commands.
-
-To work around this, the functions @code{vc-do-command} and
-@code{vc-simple-command} have been advised to intercept requests for
-operations on files accessed via @value{tramp}.
-
-In the case of a remote file, the @code{shell-command} interface is
-used, with some wrapper code, to provide the same functionality on the
-remote machine as would be seen on the local machine.
-
-
-@node Changed workfiles
-@section Detecting if the working file has changed
-
-As there is currently no way to get access to the mtime of a file on a
-remote machine in a portable way, the @code{vc-workfile-unchanged-p}
-function is advised to call an @value{tramp} specific function for remote files.
-
-The @code{tramp-vc-workfile-unchanged-p} function uses the functioning VC
-diff functionality to determine if any changes have occurred between the
-workfile and the version control master.
-
-This requires that a shell command be executed remotely, a process that
-is notably heavier-weight than the mtime comparison used for local
-files. Unfortunately, unless a portable solution to the issue is found,
-this will remain the cost of remote version control.
-
-
-@node Checking out files
-@section Bringing the workfile out of the repository
-
-VC will, by default, check for remote files and refuse to act on them
-when checking out files from the repository. To work around this
-problem, the function @code{vc-checkout} knows about @value{tramp} files and
-allows version control to occur.
-
-
-@node Miscellaneous Version Control
-@section Things related to Version Control that don't fit elsewhere
-
-Minor implementation details, &c.
-
-@menu
-* Remote File Ownership::       How VC determines who owns a workfile.
-* Back-end Versions::           How VC determines what release your RCS is.
-@end menu
-
-
-@node Remote File Ownership
-@subsection How VC determines who owns a workfile
-
-@value{emacsname} provides the @code{user-full-name} function to
-return the login name of the current user as well as mapping from
-arbitrary user id values back to login names. The VC code uses this
-functionality to map from the uid of the owner of a workfile to the
-login name in some circumstances.
-
-This will not, for obvious reasons, work if the remote system has a
-different set of logins. As such, it is necessary to delegate to the
-remote machine the job of determining the login name associated with a
-uid.
-
-Unfortunately, with the profusion of distributed management systems such
-as @code{NIS}, @code{NIS+} and @code{NetInfo}, there is no simple,
-reliable and portable method for performing this mapping.
-
-Thankfully, the only place in the VC code that depends on the mapping of
-a uid to a login name is the @code{vc-file-owner} function. This returns
-the login of the owner of the file as a string.
-
-This function has been advised to use the output of @command{ls} on the
-remote machine to determine the login name, delegating the problem of
-mapping the uid to the login to the remote system which should know more
-about it than I do.
-
-
-@node Back-end Versions
-@subsection How VC determines what release your RCS is
-
-VC needs to know what release your revision control binaries you are
-running as not all features VC supports are available with older
-versions of @command{rcs(1)}, @command{cvs(1)} or @command{sccs(1)}.
-
-The default implementation of VC determines this value the first time it
-is needed and then stores the value globally to avoid the overhead of
-executing a process and parsing its output each time the information is
-needed.
-
-Unfortunately, life is not quite so easy when remote version control
-comes into the picture. Each remote machine may have a different version
-of the version control tools and, while this is painful, we need to
-ensure that unavailable features are not used remotely.
-
-To resolve this issue, @value{tramp} currently takes the sledgehammer
-approach of making the release values of the revision control tools
-local to each @value{tramp} buffer, forcing VC to determine these values
-again each time a new file is visited.
-
-This has, quite obviously, some performance implications. Thankfully,
-most of the common operations performed by VC do not actually require
-that the remote version be known. This makes the problem far less
-apparent.
-
-Eventually these values will be captured by @value{tramp} on a system by
-system basis and the results cached to improve performance.
-
-
-@node Files directories and localnames
-@chapter How file names, directories and localnames are mangled and managed.
-
-@menu
-* Localname deconstruction::    Breaking a localname into its components.
-@end menu
-
-
-@node Localname deconstruction
-@section Breaking a localname into its components.
-
-@value{tramp} file names are somewhat different, obviously, to ordinary file
-names. As such, the lisp functions @code{file-name-directory} and
-@code{file-name-nondirectory} are overridden within the @value{tramp}
-package.
-
-Their replacements are reasonably simplistic in their approach. They
-dissect the filename, call the original handler on the localname and
-then rebuild the @value{tramp} file name with the result.
-
-This allows the platform specific hacks in the original handlers to take
-effect while preserving the @value{tramp} file name information.
-
-
-@node Issues
-@chapter Debatable Issues and What Was Decided
-
-@itemize @bullet
-@item The uuencode method does not always work.
-
-Due to the design of @value{tramp}, the encoding and decoding programs
-need to read from stdin and write to stdout.  On some systems,
-@command{uudecode -o -} will read stdin and write the decoded file to
-stdout, on other systems @command{uudecode -p} does the same thing.
-But some systems have uudecode implementations which cannot do this at
-all---it is not possible to call these uudecode implementations with
-suitable parameters so that they write to stdout.
-
-Of course, this could be circumvented: the @code{begin foo 644} line
-could be rewritten to put in some temporary file name, then
-@command{uudecode} could be called, then the temp file could be
-printed and deleted.
-
-But I have decided that this is too fragile to reliably work, so on some
-systems you'll have to do without the uuencode methods.
-
-@item @value{tramp} does not work on XEmacs 20.
-
-This is because it requires the macro @code{with-timeout} which does not
-appear to exist in XEmacs 20.  I'm somewhat reluctant to add an
-emulation macro to @value{tramp}, but if somebody who uses XEmacs 20 steps
-forward and wishes to implement and test it, please contact me or the
-mailing list.
-
-@item The @value{tramp} filename syntax differs between GNU Emacs and XEmacs.
-
-The GNU Emacs maintainers wish to use a unified filename syntax for
-Ange-FTP and @value{tramp} so that users don't have to learn a new
-syntax.  It is sufficient to learn some extensions to the old syntax.
-
-For the XEmacs maintainers, the problems caused from using a unified
-filename syntax are greater than the gains.  The XEmacs package system
-uses EFS for downloading new packages.  So, obviously, EFS has to be
-installed from the start.  If the filenames were unified, @value{tramp}
-would have to be installed from the start, too.
-
-@ifset xemacs
-@strong{Note:} If you'ld like to use a similar syntax like
-@value{ftppackagename}, you need the following settings in your init
-file:
-
-@lisp
-(setq tramp-unified-filenames t)
-(require 'tramp)
-@end lisp
-
-The autoload of the @value{emacsname} @value{tramp} package must be
-disabled.  This can be achieved by setting file permissions @code{000}
-to the files @file{.../xemacs-packages/lisp/tramp/auto-autoloads.el*}.
-
-In case of unified filenames, all @value{emacsname} download sites
-are added to @code{tramp-default-method-alist} with default method
-@option{ftp} @xref{Default Method}.  These settings shouldn't be touched
-for proper working of the @value{emacsname} package system.
-
-The syntax for unified filenames is described in the @value{tramp} manual
-for @value{emacsothername}.
-@end ifset
-@end itemize
-
-@node Concept Index
-@comment node-name,    next,  previous,      up
-@unnumbered Concept Index
-@printindex cp
-@contents
-@c End of tramp.texi - the TRAMP User Manual
-@bye
-
-@c TODO
-@c
-@c * Say something about the .login and .profile files of the remote
-@c   shells.
-@c * Explain how tramp.el works in principle: open a shell on a remote
-@c   host and then send commands to it.
-@c * Mention that bookmarks are a cool feature to go along with Tramp.
-@c * Make terminology "inline" vs "out-of-band" consistent.
-@c   It seems that "external" is also used instead of "out-of-band".
-
-@c * M. Albinus
-@c ** Use `filename' resp. `file name' consistently.
-@c ** Use `host' resp. `machine' consistently.
-@c ** Consistent small or capitalized words especially in menues.
-
-@ignore
-   arch-tag: f96dd66e-6dd3-4c92-8d77-9c56205ba808
-@end ignore
diff --git a/xemacs-packages/man/tramp/tramp_ja.texi b/xemacs-packages/man/tramp/tramp_ja.texi
deleted file mode 100644
index 35f0f7e1..00000000
--- a/xemacs-packages/man/tramp/tramp_ja.texi
+++ /dev/null
@@ -1,2172 +0,0 @@
-\input texinfo   @c -*-mode: texinfo; coding: euc-jp;-*-
-@c %**start of header
-@setfilename ../info/tramp_ja
-@settitle TRAMP User Manual
-@setchapternewpage odd
-@documentlanguage ja
-@documentencoding euc-jp
-@c %**end of header
-
-@c XXX This is a euc-jp file. I know it is better to use iso-2022-jp 
-@c XXX for htmlizing, but makeinfo doesn't work with it. 
-@c XXX I found the patch for wide-character, but it doesn't seems to 
-@c XXX work with iso-2022-jp.
-@c XXX http://www02.u-page.so-net.ne.jp/xa2/fukusaka/linux/
-
-@c XXX Notice for Japanese translation
-@c XXX I use `@ifset ja' for the contents only in Japanese version and
-@c XXX the translator's comment.
-@clear ja
-@set ja
-
-@c This is *so* much nicer :)
-@footnotestyle end
-
-@c In the Tramp CVS, the version number is auto-frobbed from
-@c configure.ac, so you should edit that file and run
-@c "autoconf && ./configure" to change the version number.
-@c XXX VERSION and UPDATED are Japanese manual's version and update date.
-@c XXX If we need original's one, we MUST use literal version and date
-@c XXX strings.
-@c XXX
-@c XXX This translation is based on tramp.texi rev. 2.98
-@c XXX
-
-@c Additionally, flags are set with respect to the Emacs flavor; and
-@c depending whether Tramp is packaged into (X)Emacs, or standalone.
-
-@include trampver.texi
-
-@c Macros for formatting a filename.
-@c trampfn is for a full filename, trampfnmhp means method, host, localname
-@c were given, and so on.
-@macro trampfn(method, user, host, localname)
-@value{prefix}@value{method}@value{user}@@@value{host}@value{postfix}@value{localname}
-@end macro
-
-@copying
-Copyright @copyright{} 1999, 2000, 2001, 2002, 2003 Free Software
-Foundation, Inc.
-
-@quotation     
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU
-Manual'', and with the Back-Cover Texts as in (a) below.  A copy of the
-license is included in the section entitled ``GNU Free Documentation
-License'' in the Emacs manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software.  Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License.  If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-@end quotation
-@end copying
-
-@c Entries for @command{install-info} to use
-@dircategory Emacs
-@direntry
-* TRAMP-ja: (tramp_ja).          Transparent Remote Access, Multiple Protocol
-                                 Emacs remote file access via rsh and rcp
-                                 (Japanese).
-@end direntry
-
-@tex
-
-@titlepage
-@title @value{tramp} version @value{trampver} User Manual
-
-@author by Daniel Pittman
-@author based on documentation by Kai Gro@ss{}johann
-
-@page
-@insertcopying
-
-@end titlepage
-@page
-
-@end tex
-
-@ifnottex
-@node Top, Overview, (dir), (dir)
-@top @value{tramp} version @value{trampver} ¥æ¡¼¥¶¡¼¥Þ¥Ë¥å¥¢¥ë
-
-¤³¤Î¥Õ¥¡¥¤¥ë¤Ï @value{tramp} version @value{trampver} ¤Ë¤Ä¤¤¤ÆÀâÌÀ¤·¤Þ¤¹¡£
-@value{tramp} ¤Ï @value{emacsname} ¤Ë¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤ÎÊÔ½¸µ¡Ç½¤òÄ󶡤¹¤ë
-¥Ñ¥Ã¥±¡¼¥¸¤Ç¤¹¡£
-
-@value{tramp} ¤Ï `Transparent Remote (file) Access, Multiple Protocol'
-¤Îά¾Î¤Ç¤¹¡£¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ï @value{ftppackagename} ¤Î¤è¤¦¤Ê
-¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤ÎÊÔ½¸µ¡Ç½¤òÄ󶡤·¤Þ¤¹¡£
-
-°Û¤Ê¤ëÅÀ¤Ï¥Õ¥¡¥¤¥ë¤ÎžÁ÷ÊýË¡¤Ç¤¹¡£@value{ftppackagename} ¤Ï¡¢
-¥í¡¼¥«¥ë¥Û¥¹¥È¤È¥ê¥â¡¼¥È¥Û¥¹¥È´Ö¤Î¥Õ¥¡¥¤¥ëžÁ÷¤Ë FTP ¤ò»ÈÍѤ·¤Þ¤¹¡£
-°ìÊý @value{tramp} ¤Ï¡¢@command{rsh} ¤È @command{rcp} ¤¢¤ë¤¤¤Ï¾¤ÎƱ¤¸¤è¤¦
-¤ÊƯ¤­¤ò¤¹¤ë¥×¥í¥°¥é¥à¡¢Î㤨¤Ð @command{ssh} ¤ä @command{scp}¤ò»ÈÍѤ·
-¤Þ¤¹¡£
-
-¤³¤Î¥É¥­¥å¥á¥ó¥È¤ÎºÇ¿·¥Ð¡¼¥¸¥ç¥ó¤Ï web ¥µ¥¤¥È
-@uref{http://www.freesoftware.fsf.org/tramp/}
-¤Ë¤¢¤ê¤Þ¤¹¡£
-
-@c Pointer to the other Emacs flavor is necessary only in case of
-@c standalone installation.  Text taken from trampinst.texi.
-@ifset installchapter
-The manual has been generated for @value{emacsname}.
-@ifinfo
-If you want to read the info pages for @value{emacsothername}, you
-should read in @ref{Installation} how to create them.
-@end ifinfo
-@ifhtml
-If you're using the other Emacs flavour, you should read the
-@uref{@value{emacsotherfilename}, @value{emacsothername}} pages.
-@end ifhtml
-@end ifset
-
-@ifhtml
-¤³¤Î¥Þ¥Ë¥å¥¢¥ë¤Ë¤Ï @uref{tramp_ja.html, ÆüËܸìÌõ}¤¬Â¸ºß¤·¤Þ¤¹¡£
-
-@ifset ja
-[ÌõÃí: ¤½¤¦¡¢¤¢¤Ê¤¿¤¬Æɤó¤Ç¤¤¤ë¡¢¤³¤ì¤¬ÆüËܸìÌõ¤Ç¤¹ :-)]
-@end ifset
-
-ºÇ¿·¤Î @value{tramp} ¤Ï
-@uref{http://savannah.gnu.org/download/tramp/,download}
-¤Ë¤¢¤ê¤Þ¤¹¡£¾ÜºÙ¤Ï @ref{Obtaining Tramp} ¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£
-CVS ¥µ¡¼¥Ð¡¼¤Ë¤Ä¤¤¤Æ¤ÎÀâÌÀ¤â¤¢¤ê¤Þ¤¹¡£
-
-¤Þ¤¿¡¢ @uref{https://savannah.gnu.org/projects/tramp/,
-Savannah Project Page} ¤Ë¤â @value{tramp} ¤Î¾ðÊ󤬤¢¤ê¤Þ¤¹¡£
-@end ifhtml
-
-@value{tramp}¤Î¤¿¤á¤Î¥á¡¼¥ê¥ó¥°¥ê¥¹¥È @email{tramp-devel@@mail.freesoftware.fsf.org},
-¤¬Â¸ºß¤·¤Þ¤¹¡£¥¢¡¼¥«¥¤¥Ö¤ÏÄ̾ï¤Î Savannah ¥¢¡¼¥«¥¤¥Ö¤ÈƱ¤¸¾ì½ê¤È¡¢
-@uref{http://www.mail-archive.com/emacs-rcp@@ls6.cs.uni-dortmund.de/}
-¤Ë¤¢¤ê¤Þ¤¹¡£
-
-@insertcopying
-
-@end ifnottex
-
-@menu
-* Overview::                    @value{tramp} ¤Ç²Äǽ¤Ê»ö¡¢ÉÔ²Äǽ¤Ê»ö
-
-¥¨¥ó¥É¥æ¡¼¥¶¡¼¸þ¤±:
-
-* Obtaining Tramp::             @value{tramp} ¤ÎÆþ¼êÊýË¡
-* History::                     @value{tramp} ¤ÎÎò»Ë
-@ifset installchapter
-* Installation::                @value{tramp} ¤Î¥¤¥ó¥¹¥È¡¼¥ë
-@end ifset
-* Configuration::               @value{tramp} ¤ÎÀßÄê
-* Usage::                       @value{tramp} ¤Î»È¤¤Êý
-* Bug Reports::                 ¥Ð¥°¤äÌäÂê¤ÎÊó¹ð
-* Frequently Asked Questions::  ¤è¤¯¤¢¤ë¼ÁÌä¤È¤½¤ÎÅú
-* Concept Index::               ¤½¤ì¤¾¤ì¤Î³µÇ°¤Ë¤Ä¤¤¤Æ¤Î¹àÌÜ
-
-³«È¯¼Ô¸þ¤±:
-
-* Version Control::             ¥ê¥â¡¼¥È¥Ð¡¼¥¸¥ç¥ó¥³¥ó¥È¥í¡¼¥ë¤ÎÆâÉôÆ°ºî
-* Files directories and localnames:: ¥Õ¥¡¥¤¥ë̾¡¢¥Ç¥£¥ì¥¯¥È¥ê¡¢¥í¡¼¥«¥ë̾¤¬¤É¤Î¤è¤¦¤Ë
-                                ÊÑ´¹¤µ¤ì(mangled)¡¢´ÉÍý¤µ¤ì¤ë¤«
-* Issues::			µÄÏÀ¤Î;ÃϤ¬¤¢¤ëÅÀ¤È²¿¤¬·èÄꤵ¤ì¤Æ¤¤¤ë¤«
-
-@detailmenu
- --- ¾ÜºÙ¤Ê¥Î¡¼¥É¤Î°ìÍ÷ ---
-@c
-@ifset installchapter
-¤¢¤Ê¤¿¤Î @value{emacsname} ¤Ë @value{tramp} ¤òƳÆþ¤¹¤ë
-
-* Installation parameters::     ¥¤¥ó¥¹¥È¡¼¥ë¤ÎºÝ¤Î¥Ñ¥é¥á¡¼¥¿
-* Load paths::                  ¤¢¤Ê¤¿¤Î´Ä¶­¤Ë @value{tramp} ¤òÁȤ߹þ¤àÊýË¡
-
-@end ifset
-
-@value{tramp} ¤ÎÀßÄê
-
-* Connection types::            ¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤ÎÀܳ¤Î¼ïÎà
-* Inline methods::              ¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É
-* External transfer methods::   ³°ÉôžÁ÷¥á¥½¥Ã¥É
-* Multi-hop Methods::           ¥Þ¥ë¥Á¥Û¥Ã¥×¤ò»ÈÍѤ·¤¿¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤ÎÀܳ
-* Default Method::              ¥Ç¥Õ¥©¥ë¥È¤Î¥á¥½¥Ã¥É¤ÎÁªÂò
-* Customizing Methods::         Èóɸ½à¤Î¥á¥½¥Ã¥É¤ò»È¤¦
-* Customizing Completion::      ¥æ¡¼¥¶¡¿¥Û¥¹¥È̾Êä´°¤Î¤¿¤á¤ÎÀßÄê¥Õ¥¡¥¤¥ë¤ÎÁªÂò
-* Remote Programs::             ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç @value{tramp} ¤¬¥×¥í¥°¥é¥à¤òȯ¸«¡¢»ÈÍѤ¹¤ëÊýË¡
-* Remote shell setup::          ¥ê¥â¡¼¥È¥·¥§¥ëÀßÄê¤Î¥Ò¥ó¥È
-* Windows setup hints::         Cygwin ssh ¤Ë¤Þ¤Ä¤ï¤ë»öÊÁ
-* Auto-save and Backup::        Auto-save ¤È¥Ð¥Ã¥¯¥¢¥Ã¥×
-
-@value{tramp} ¤Î»È¤¤Êý
-
-* Filename Syntax::             @value{tramp} ¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê
-* Multi-hop filename syntax::   ¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê
-* Filename completion::         ¥Õ¥¡¥¤¥ë̾¤ÎÊä´°
-* Dired::                       Dired
-
-¥ê¥â¡¼¥È¥Ð¡¼¥¸¥ç¥ó¥³¥ó¥È¥í¡¼¥ë¤ÎÆâÉôÆ°ºî
-
-* Version Controlled Files::    ¥Õ¥¡¥¤¥ë¤¬¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤µ¤ì¤Æ¤¤¤ë¤«¤É¤¦¤«¤ÎȽÃÇ
-* Remote Commands::             ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥³¥Þ¥ó¥É¤Î¼Â¹Ô
-* Changed workfiles::           ºî¶È¥Õ¥¡¥¤¥ë¤ÎÊѹ¹¤Îȯ¸«
-* Checking out files::          ºî¶È¥Õ¥¡¥¤¥ë¤Î¥ê¥Ý¥¸¥È¥ê¤«¤é¤Î¼èÆÀ
-* Miscellaneous Version Control::  ¤½¤Î¾¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Ë´Ø·¸¤¹¤ë»ö
-
-¤½¤Î¾¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Ë´Ø·¸¤¹¤ë»ö
-
-* Remote File Ownership::       VC ¤¬¥ï¡¼¥¯¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼¤òÄ´¤Ù¤ëÊýË¡
-* Back-end Versions::           VC ¤¬ RCS ¤Î¥Ð¡¼¥¸¥ç¥ó¤òÄ´¤Ù¤ëÊýË¡
-
-¥Õ¥¡¥¤¥ë̾¡¢¥Ç¥£¥ì¥¯¥È¥ê¡¢¥í¡¼¥«¥ë̾¤¬¤É¤Î¤è¤¦¤ËÊÑ´¹¤µ¤ì(mangled)¡¢´ÉÍý¤µ¤ì¤ë¤«
-
-* Localname deconstruction::    ¥í¡¼¥«¥ë̾¤ÎÍ×ÁǤؤÎʬ²ò
-
-@end detailmenu
-@end menu
-
-@node Overview
-@chapter @value{tramp} ¤Î³µÍ×
-@cindex overview
-
-@value{emacsname} ¤Ë @value{tramp} ¤ò¥¤¥ó¥¹¥È¡¼¥ë¤¹¤ë¤È¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å
-¤Î¥Õ¥¡¥¤¥ë¤Ë¥í¡¼¥«¥ë¥Õ¥¡¥¤¥ë¤ÈƱ¤¸¤è¤¦¤Ê´¶³Ð¤Ç¥¢¥¯¥»¥¹¤Ç¤­¤Þ¤¹¡£
-¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¥·¥¹¥Æ¥à¾å¤Î¥Õ¥¡¥¤¥ë¤ÎÊÔ½¸¡¢¥Ð¡¼¥¸¥ç¥ó¥³¥ó¥È¥í¡¼¥ë¡¢
-@command{dired} ¤òÆ©²áŪ¤Ë¼Â¹Ô¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤Î¥¢¥¯¥»¥¹¤Ë¤Ï¡¢@command{rsh} ¤ä @command{rlogin}¡¢
-@command{telnet} ¥³¥Þ¥ó¥É¡¢¤¢¤ë¤¤¤Ï¤³¤ì¤é¤ËÎà»÷¤·¤¿ÀܳÊýË¡¤ò»ÈÍÑ
-¤·¤Þ¤¹¡£¤³¤ì¤é¤Î¥³¥Þ¥ó¥É¤Ï ASCII ¤òÄ̲ᤵ¤»¤ë¤³¤È¤¬²Äǽ¤Ç¤Ê¤±¤ì¤Ð
-¤Ê¤ê¤Þ¤»¤ó¤¬¡¢8-bit ¥¯¥ê¡¼¥ó¤Ç¤¢¤ëɬÍפϤ¢¤ê¤Þ¤»¤ó¡£
-
-¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤ÏÊ̤Υޥ·¥ó¤Ø¤Î @command{ssh} Àܳ¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£
-¤³¤ì¤Ï¡¢¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Î¤â¤Ã¤È¤â°ìÈÌŪ¤Ê»È¤¤Êý¤Î¤Ò¤È¤Ä¤Ç¤¹¡£ÆÃ¤Ë 
-@command{ftp}¥¢¥¯¥»¥¹¤¬µö²Ä¤µ¤ì¤Æ¤¤¤Ê¤¤¾ì¹ç¤Ë¤â¡¢Â¾¤Î¥Þ¥·¥ó¤Ø¤Î
-Èæ³ÓŪ¥»¥­¥å¥¢¤Ê¥¢¥¯¥»¥¹¤¬²Äǽ¤È¤Ê¤ê¤Þ¤¹¡£
-
-@value{tramp} ¤Ë¤è¤Ã¤Æ¼Â¹Ô¤µ¤ì¤ë¥¢¥¯¥Æ¥£¥Ó¥Æ¥£¤Î¤Û¤È¤ó¤É¤Ï¡¢¥ê¥â¡¼¥È
-¥í¥°¥¤¥ó¤¬²Äǽ¤Ç¡¢Ã¼Ëö¾å¤Ç¼Â¹Ô¤Ç¤­¤ë¤³¤È¤À¤±¤òÍ׵ᤷ¤Þ¤¹¡£¥ê¥â¡¼¥È
-¥Õ¥¡¥¤¥ë¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤¿¤á¤Ë¡¢@value{tramp} ¤Ï¥Õ¥¡¥¤¥ë¤ÎÆâÍƤò°ì»þŪ
-¤Ë¥í¡¼¥«¥ë¥Þ¥·¥ó¤ËžÁ÷¤·¤Þ¤¹¡£
-
-@value{tramp} ¤Ï¡¢¤µ¤Þ¤¶¤Þ¤ÊÊýË¡¤Ç¥Þ¥·¥ó´Ö¤Î¥Õ¥¡¥¤¥ëžÁ÷¤ò¤ª¤³¤Ê¤¤¤Þ¤¹¡£
-žÁ÷ÊýË¡¤Ï´Êñ¤ËÁªÂò¤Ç¤­¡¢¤¢¤Ê¤¿¤Î¥Ë¡¼¥º¤È¥Þ¥·¥ó´Ä¶­¤Ë±þ¤¸¤Æ»È¤¤
-¤ï¤±¤ë»ö¤¬¤Ç¤­¤Þ¤¹¡£
-
-(Â礭¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ)¤â¤Ã¤È¤â®¤¤Å¾Á÷¥á¥½¥Ã¥É¤Ï¡¢¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤Î
-žÁ÷¥Ñ¥Ã¥±¡¼¥¸¡¢¤¿¤È¤¨¤Ð @command{rcp}¡¢@command{scp}¡¢@command{rsync}
-¤ò»È¤¦¤â¤Î¤Ç¤¹¡£¤³¤ì¤é¤Î¥á¥½¥Ã¥É¤Ï¡¢¥Õ¥¡¥¤¥ë¤Î¥³¥Ô¡¼¥³¥Þ¥ó¥É¤¬¥ê¥â¡¼¥È
-¥Þ¥·¥ó¤Î¥Ñ¥¹¥ï¡¼¥É¤ò¤¿¤º¤Í¤Ê¤¤¾ì¹ç¤Ë¤Î¤ßÍ­¸ú¤Ç¤¹¡£
-
-¤â¤·¡¢¥ê¥â¡¼¥È¥³¥Ô¡¼¥á¥½¥Ã¥É¤¬»È¤¨¤Ê¤¤¾ì¹ç¤Î¤¿¤á¤Ë¡¢@value{tramp} ¤Ï¡¢
-¥·¥§¥ë¤òľÀÜÍøÍѤ·¤¿Éä¹æ²½Å¾Á÷ÊýË¡¤ò¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤Þ¤¹¡£¤³¤ÎÊýË¡¤ò»È¤¦
-¤¿¤á¤Ë¤Ï¡¢@command{mimencode} ¤« @command{uuencode} ¤¬¥ê¥â¡¼¥È¥Þ¥·¥ó
-¾å¤Ë¸ºß¤·¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£¤³¤ì¤é¤Ï°ìÈ̤˾®¤µ¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ®¤¤
-ÊýË¡¤Ç¤¹¡£
-
-¾åµ­¤ÎÀ©¸ÂÆâ¤Ç¤¢¤ì¤Ð¡¢@value{tramp} ¤ÏÈó¾ï¤Ë¥Ñ¥ï¥Õ¥ë¤Ç¤¹¡£¤¿¤À¤·¡¢Ãí°Õ¤·¤Æ
-¤ª¤«¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¤Î¤Ï¡¢¸½ºß¤Î @value{tramp} ¤Ï¡¢¥¨¥ó¥É¥æ¡¼¥¶¡¼¸þ¤±¤ÎÀöÎý
-¤µ¤ì¤¿À½ÉʤȤϤۤɱ󤤾õÂ֤Ǥ¢¤ë¤È¤¤¤¦¤³¤È¤Ç¤¹¡£¤â¤¦¤·¤Ð¤é¤¯¤Î´Ö¤Ï¡¢»þ¡¹
-¤Á¤ç¤Ã¤Èº¤¤Ã¤¿»ö¤Ë¤Ê¤Ã¤¿¤ê¡¢¥³¡¼¥É¤ËÌäÂ꤬¤¢¤ë¤«¤â¤·¤ì¤Ê¤¤¤È¤¤¤¦¤³¤È¤ò
-ǰƬ¤Ë¤ª¤¤¤Æ¤ª¤¤¤Æ¤¯¤À¤µ¤¤¡£
-
-¤¹¤Ç¤Ë³«È¯¼Ô¤¬Æü¡¹¤Îºî¶È¤Ë»È¤¦»ö¤¬¤Ç¤­¤ëÄøÅ٤ˤϰÂÄꤷ¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢
-¥¤¥ó¥¹¥È¡¼¥ë¤ÈÀßÄê¤ò³Ð¤¨¤ë¤Î¤Ï¡¢ÀìÌçÍѸì¤Î¤»¤¤¤Ç¼ã´³Æñ¤·¤¤¤Ç¤·¤ç¤¦¡£
-
-@value{tramp} ¤Ï¡¢¤Þ¤À¥¢¥¯¥Æ¥£¥Ö¤Ë³«È¯¤ò¤·¤Æ¤¤¤ëºÇÃæ¤Ç¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢¤É¤ó¤Ê
-º³ºÙ¤ÊÌäÂê¤Ç¤¢¤Ã¤Æ¤â¡¢¤¼¤Ò @value{tramp} ³«È¯¼Ô¤ËÊó¹ð¤·¤Æ¤¯¤À¤µ¤¤¡£
-@xref{Bug Reports}.
-
-
-@subsubheading ÉñÂæ¤Î΢¦
-@cindex behind the scenes
-@cindex details of operation
-@cindex how it works
-
-¤³¤Î¥»¥¯¥·¥ç¥ó¤Ç¤Ï¡¢@value{tramp} ¤ò»È¤¤¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤Ë¥¢¥¯¥»¥¹¤·¤¿»þ¤Ë¡¢
-ÉñÂæ¤Î΢¦¤Ç²¿¤¬¤ª¤³¤Ã¤Æ¤¤¤ë¤«¤òÀâÌÀ¤·¤Þ¤¹¡£
-
-@kbd{C-x C-f} ¤È¥¿¥¤¥×¤·¡¢@value{tramp} ¤Î¥Õ¥¡¥¤¥ë̾¤Î°ìÉô¤òÆþÎϤ·¤Þ¤¹¡£
-¤½¤ì¤«¤é¡¢¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤Î¤¿¤á¤Ë @kbd{@key{TAB}} ¤ò²¡¤·¤Þ¤¹¡£¤³¤ì
-¤¬¤½¤Î¥Û¥¹¥È¤ËÂФ¹¤ë½é¤á¤Æ¤Î @value{tramp} ¤Îµ¯Æ°¤Î¾ì¹ç¡¢°Ê²¼¤Î¤è¤¦¤Ê»ö
-¤¬¤ª¤³¤ê¤Þ¤¹¡£
-
-@itemize
-@item
-@value{tramp} ¤Ï¡¢Â¾¤Î¥Û¥¹¥È¤Ø¤ÎÀܳ¤¬É¬Íפʻö¤òǧ¼±¤·¤Þ¤¹¡£¤½¤ì¤«¤é
-@samp{telnet @var{host}} ¤« @samp{rsh @var{host} -l @var{user}} ¤¢¤ë¤¤
-¤Ï¡¢¤½¤Î¾¤Î¥ê¥â¡¼¥È¥Û¥¹¥È¤ØÀܳ¤¹¤ë¤¿¤á¤Î¥Ä¡¼¥ë¤òµ¯Æ°¤·¤Þ¤¹¡£¤³¤ì¤é¤Î
-¥×¥í¥»¥¹¤È¤Î¥³¥ß¥å¥Ë¥±¡¼¥·¥ç¥ó¤Ï @value{emacsname} ¤Î¥Ð¥Ã¥Õ¥¡¤ò·Ðͳ¤·
-¤Æ¤ª¤³¤Ê¤ï¤ì¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢¥ê¥â¡¼¥È¦¤«¤é¤Î½ÐÎϤϤ³¤Î¥Ð¥Ã¥Õ¥¡¤Ë½ÐÎÏ
-¤µ¤ì¤Þ¤¹¡£
-
-@item
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ï¡¢¥í¥°¥¤¥ó̾¤Î¥×¥í¥ó¥×¥È¤òɽ¼¨¤·¤Þ¤¹(@command{telnet} 
-¤Î¾ì¹ç)¡£¥í¥°¥¤¥ó̾¤ÏÆþÎϤµ¤ì¤¿¥Õ¥¡¥¤¥ë̾¤Ë´Þ¤Þ¤ì¤Æ¤¤¤ë¤Î¤Ç¡¢@value{tramp} 
-¤Ï¥í¥°¥¤¥ó̾¤È²þ¹Ô¤òÁ÷¿®¤·¤Þ¤¹¡£
-
-@item
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ï¡¢¥Ñ¥¹¥ï¡¼¥É¤¢¤ë¤¤¤Ï¥Ñ¥¹¥Õ¥ì¡¼¥º¤Î¥×¥í¥ó¥×¥È¤òɽ¼¨
-¤·¤Þ¤¹(¤³¤ì¤Ï@command{rsh} ¤Î¾ì¹ç¤Ç¤¹¡£@command{telnet} ¤Î¾ì¹ç¤Ï¥í¥°
-¥¤¥ó̾¤òÁ÷¿®¤·¤¿¸å¤Ëɽ¼¨¤µ¤ì¤Þ¤¹)¡£@value{tramp} ¤Ï¥ß¥Ë¥Ð¥Ã¥Õ¥¡¤Ë¥×¥í¥ó
-¥×¥È¤òɽ¼¨¤·¡¢¥Ñ¥¹¥ï¡¼¥É¤Þ¤¿¤Ï¥Ñ¥¹¥Õ¥ì¡¼¥º¤ò¤¿¤º¤Í¤Þ¤¹¡£
-
-¥Ñ¥¹¥ï¡¼¥É¤«¥Ñ¥¹¥Õ¥ì¡¼¥º¤òÆþÎϤ¹¤ë¤È¡¢@value{tramp} ¤Ï¤½¤ì¤ò¥ê¥â¡¼¥È¥Û¥¹¥È
-¤ËÁ÷¿®¤·¡¢¼¡¤Ë²þ¹Ô¤òÁ÷¿®¤·¤Þ¤¹¡£
-
-@item
-@value{tramp} ¤Ï¡¢¥·¥§¥ë¥×¥í¥ó¥×¥È¤«¥í¥°¥¤¥ó¤Ë¼ºÇÔ¤·¤¿»Ý¤Î¥á¥Ã¥»¡¼¥¸¤òÂÔ¤Á
-¤Þ¤¹¡£
-
-¤â¤·¡¢@value{tramp} ¤¬¡¢°ìÄê»þ´Ö(¤¿¤È¤¨¤Ð°ìʬ)ÂԤäƤ⡢¤³¤ì¤é¤Î¥á¥Ã¥»¡¼¥¸¤ò
-ȯ¸«¤¹¤ë¤³¤È¤¬¤Ç¤­¤Ê¤«¤Ã¤¿¤é¡¢¥ê¥â¡¼¥È¥·¥§¥ë¤Î¥×¥í¥ó¥×¥È¤òȯ¸«¤Ç¤­¤Ê¤«¤Ã
-¤¿»Ý¤Î¥á¥Ã¥»¡¼¥¸¤ò½ÐÎϤ·¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤«¤éÁ÷¿®¤µ¤ì¤¿¥á¥Ã¥»¡¼¥¸¤òɽ¼¨
-¤·¤Þ¤¹¡£
-
-¤â¤·¡¢@value{tramp} ¤¬ @samp{login failed} ¤È¤¤¤¦¥á¥Ã¥»¡¼¥¸¤òȯ¸«¤·¤¿¤é¡¢¤½¤ì¤ò
-ɽ¼¨¤·¡¢¥í¥°¥¤¥ó¤òÃæ»ß¤·¤Þ¤¹¡£¤³¤ì¤ÇºÆ¤Ó¥í¥°¥¤¥ó¤ò»î¤ß¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-@item
-¥í¥°¥¤¥ó¤ËÀ®¸ù¤·¡¢@value{tramp} ¤¬¥·¥§¥ë¥×¥í¥ó¥×¥È¤òȯ¸«¤·¤¿¤È¤·¤Þ¤¹¡£¤³¤³¤Ç¡¢
-@value{tramp} ¤Ï @command{/bin/sh} ¤òµ¯Æ°¤·¤Þ¤¹¡£¤³¤ì¤Ï¡¢Bourne ¥·¥§¥ë¤È C 
-¥·¥§¥ë¤Ç¤Ïʸˡ¤¬°Û¤Ê¤ë¤¿¤á¤Ç¤¹¡£@footnote{¥í¥°¥¤¥ó¥·¥§¥ë¤¬ 
-@samp{exec /bin/sh} ¤òÀµ¤·¤¤¥³¥Þ¥ó¥É¤È¤·¤Æǧ¼±¤»¤º¤Ë @command{/bin/sh}
-¤Îµ¯Æ°¤Ë¼ºÇÔ¤¹¤ë¤³¤È¤¬¤¢¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤¿¤Ö¤ó¡¢¤¢¤Ê¤¿¤Ï Scheme ¥·¥§¥ë 
-@command{scsh} ¤ò»È¤Ã¤Æ¤¤¤ë¤Î¤Ç¤·¤ç¤¦@dots{}}
-
-Bourne ¥·¥§¥ë¤¬µ¯Æ°¤µ¤ì¤¿¤é¡¢@value{tramp} ¤Ï³Î¼Â¤ËÆ°ºî¤¹¤ë´Ä¶­¤ò½àÈ÷¤¹¤ë¤¿¤á
-¤Ë¤¤¤¯¤Ä¤«¤Î¥³¥Þ¥ó¥É¤òÁ÷¿®¤·¤Þ¤¹¡£echo ¤ò¥ª¥Õ¤Ë¤·¡¢¥·¥§¥ë¥×¥í¥ó¥×¥È¤òÀßÄê
-¤·¤¿¤ê¡¢¤½¤Î¾¤¤¤¯¤Ä¤«¤Î»ö¤ò¤ª¤³¤Ê¤¤¤Þ¤¹¡£
-
-@item
-¤µ¤Æ¡¢¥ê¥â¡¼¥È¥·¥§¥ë¤¬µ¯Æ°¤µ¤ì¤­¤Á¤ó¤ÈÆ°ºî¤¹¤ë¾õÂ֤ˤʤê¤Þ¤·¤¿¡£¤³¤³¤Ç¡¢
-²¿¤¬¤ª¤³¤ë¤Ï¤º¤À¤Ã¤¿¤«»×¤¤¤À¤·¤Æ¤¯¤À¤µ¤¤¡£¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤Ë¤É¤Î¤è¤¦¤Ê
-¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤¹¤ë¤«¤ò @value{tramp} ¤¬Ä´¤Ù¡¢¥Õ¥¡¥¤¥ë̾¤òÊä´°¤Ç¤­¤ë¤è¤¦¤Ë¤Ê¤ë
-¤³¤È¤Ç¤¹¡£
-
-@value{tramp} ¤Ï @command{cd} ¤È @command{ls} ¥³¥Þ¥ó¥É¡¢¤½¤·¤Æ»þ¡¹ globbing 
-¤µ¤ì¤¿ @command{echo} ¤ò¼Â¹Ô¤·¤Þ¤¹¡£¤³¤ì°Ê³°¤Ë¡¢¥Õ¥¡¥¤¥ë¤¬½ñ¤­¹þ¤ß²Äǽ
-¤«¤É¤¦¤«¡¢¥Ç¥£¥ì¥¯¥È¥ê¤«¤É¤¦¤«Åù¤òÄ´¤Ù¤ë¤¿¤á¤Ë @command{test} ¤¬¡¢¤·¤Ð
-¤·¤Ð»ÈÍѤµ¤ì¤Þ¤¹¡£¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤ò¤ª¤³¤Ê¤¦¤¿¤á¤Ë¡¢¤¹¤Ù¤Æ¤Î¥³¥Þ¥ó¥É¤Î½Ð
-ÎϤϥѡ¼¥¹¤µ¤ì¤Þ¤¹¡£
-
-@item
-¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤¬´°Î»¤·¡¢@kbd{C-xC-f}¤È´°Á´¤Ê¥Õ¥¡¥¤¥ë̾¤òÆþÎϤ·¡¢
-@kbd{@key{RET}} ¤ò²¡¤·¤¿¤È¤·¤Þ¤·¤ç¤¦¡£¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤¹¤ë¤¿¤á¤Ë¡¢¥ê¥â¡¼¥È
-¥Û¥¹¥È¤«¤é¥í¡¼¥«¥ë¥Û¥¹¥È¤Ë¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòžÁ÷¤¹¤ë»þ¤¬¤è¤¦¤ä¤¯¤ä¤Ã¤Æ
-¤­¤Þ¤·¤¿¡£
-
-@value{tramp} ¤¬¤É¤Î¤è¤¦¤Ë¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòžÁ÷¤¹¤ë¤Î¤«¤È¤¤¤¦ÀâÌÀ¤Ï¡¢¾å¤ò¸«¤Æ
-¤¯¤À¤µ¤¤¡£
-
-¥¤¥ó¥é¥¤¥óžÁ÷¤Î¤¿¤á¤Ë¡¢@value{tramp} ¤Ï @samp{mimencode -b /path/to/remote/file}
-¤Î¤è¤¦¤Ê¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤·¡¢½ÐÎϤ¬¥³¥ß¥å¥Ë¥±¡¼¥·¥ç¥ó¤Î¤¿¤á¤Î¥Ð¥Ã¥Õ¥¡¤Ë
-ÃßÀѤµ¤ì¤ë¤Þ¤ÇÂÔ¤Á¤Þ¤¹¡£¤½¤·¤Æ¡¢¥Õ¥¡¥¤¥ë¤ÎÃæ¿È¤òºîÀ®¤¹¤ë¤¿¤á¤Ë¡¢½ÐÎϤò
-Éü¹æ²½¤·¤Þ¤¹¡£
-
-out-of-band žÁ÷¤Î¤¿¤á¤Ë¡¢@value{tramp} ¤Ï°Ê²¼¤Î¤è¤¦¤Ê¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤·¤Þ¤¹:
-@example
-rcp user@@host:/path/to/remote/file /tmp/tramp.4711
-@end example
-¤½¤·¤Æ¡¢¥í¡¼¥«¥ë¤Ê°ì»þ¥Õ¥¡¥¤¥ë @file{/tmp/tramp.4711} ¤ò¥Ð¥Ã¥Õ¥¡¤ËÆɤß
-¹þ¤ß¡¢°ì»þ¥Õ¥¡¥¤¥ë¤òºï½ü¤·¤Þ¤¹¡£
-
-@item
-º£¡¢¤¢¤Ê¤¿¤Ï¥Ð¥Ã¥Õ¥¡¤ÎÆâÍƤòÊÔ½¸¤·¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢¹¬±¿¤Ë¤âÉñÂæ΢¤Ç²¿¤¬
-¤ª¤³¤Ã¤Æ¤¤¤ë¤Î¤«¤Ëµ¤¤¬¤Ä¤­¤Þ¤»¤ó(¤³¤Î¥»¥¯¥·¥ç¥ó¤òÆɤà¤Þ¤Ç¤Ï¡¢¤½¤¦¤Ç¤·¤ç¤¦)¡£
-ºî¶È¤¬½ª¤ê¡¢¥Ð¥Ã¥Õ¥¡¤òÊݸ¤¹¤ë¤¿¤á¤Ë @kbd{C-x C-s} ¤ò²¡¤·¤Þ¤¹¡£
-
-@item
-ºÆ¤Ó¡¢@value{tramp} ¤Ï¥Õ¥¡¥¤¥ë¤ÎÆâÍƤò¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥¤¥ó¥é¥¤¥ó¤« out-of-band
-¥á¥½¥Ã¥É¤ÇžÁ÷¤·¤Þ¤¹¡£¤³¤³¤Ç¤Ï¥Õ¥¡¥¤¥ë¤òÆɤ߻þ¤Ë¤ª¤³¤Ã¤Æ¤¤¤ë»ö¤ÈµÕ¤Î¤³¤È
-¤¬¤ª¤³¤Ã¤Æ¤¤¤Þ¤¹¡£
-
-@end itemize
-
-¤³¤ÎÀâÌÀ¤Ç¡¢@value{tramp} ¤ò»È¤¤¥Õ¥¡¥¤¥ë¤ò¥ª¡¼¥×¥ó¤·¤¿»þ¤ËÉñÂæ΢¤Ç¤ª¤³¤Ã¤Æ¤¤¤ë
-»ö¤ò¤ï¤«¤Ã¤Æ¤â¤é¤¨¤ë¤³¤È¤ò´ê¤Ã¤Æ¤¤¤Þ¤¹¡£
-
-
-@c For the end user
-@node Obtaining Tramp
-@chapter Tramp ¤ÎÆþ¼êÊýË¡
-@cindex obtaining Tramp
-
-@value{tramp} ¤Ï¡¢¥¤¥ó¥¿¡¼¥Í¥Ã¥È¾å¤Ç¥Õ¥ê¡¼¤ËÇÛÉÛ¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ºÇ¿·ÈǤÏ
-@uref{http://savannah.nongnu.org/download/tramp/}
-¤«¤é¥À¥¦¥ó¥í¡¼¥É²Äǽ¤Ç¤¹¡£¤³¤ÎÃæ¤Ë¤Ï¡¢¥¤¥ó¥¹¥È¡¼¥ë¤ËɬÍ×¤Ê @value{tramp}
-¤Î¤¹¤Ù¤Æ¤Î¥É¥­¥å¥á¥ó¥È¤È¥½¡¼¥¹¥³¡¼¥É¤¬´Þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢Emacs
-(21.4 ¤«¤½¤ì°Ê¹ß¤Î¤â¤Î) ¤Ï¡¢@value{tramp} ¤ò´Þ¤ó¤Ç¤ª¤ê¡¢XEmacs ¤Ë¤â @value{tramp}
-¤Î¥Ñ¥Ã¥±¡¼¥¸¤¬¤¢¤ê¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢¤½¤ì¤é¤ò»È¤¦Êý¤¬¤¿¤Ö¤ó´Êñ¤Ç¤·¤ç¤¦¡£
-¤·¤«¤·¡¢¤â¤·ºÇ¿·¤Î³«È¯ÈǤòµá¤á¤ë¤Î¤Ç¤¢¤ì¤Ð¡¢Â³¤­¤òÆɤó¤Ç²¼¤µ¤¤@dots{...}
-
-ËÁ¸±²È¤Î¤¿¤á¤Ë @value{tramp} ¤Ï CVS ¤«¤é¤âÆþ¼ê²Äǽ¤Ç¤¹¡£CVS ¤«¤éÆþ¼ê¤·¤¿
-¥Ð¡¼¥¸¥ç¥ó¤Ï¥½¡¼¥¹¥³¡¼¥É¤ÎºÇ¿·¥Ð¡¼¥¸¥ç¥ó¤Ç¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢ÉÔ´°Á´¤Ê
-µ¡Ç½¤ä¿·¤¿¤ÊÌäÂê¤ò¤«¤«¤¨¤Æ¤¤¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤³¤Î¥Ð¡¼¥¸¥ç¥ó¤Ï¼«Ê¬
-¤ÎÀÕǤ¤Ç»ÈÍѤ·¤Æ¤¯¤À¤µ¤¤¡£
-
-@value{tramp} ¤ÎºÇ¿·¤Î³«È¯¥Ð¡¼¥¸¥ç¥ó¤ò CVS ¤«¤éÆþ¼ê¤¹¤ëÊýË¡¤Ï¡¢°Ê²¼¤Ë¼¨¤¹
-Savannah ¥×¥í¥¸¥§¥¯¥È¥Ú¡¼¥¸¤Ë¹Ô¤Ã¤Æ°ìÈÖ¾å¤Î¥Ê¥Ó¥²¡¼¥·¥ç¥ó¥Ð¡¼¤Ë¤¢¤ë
-CVS ¤Î¥ê¥ó¥¯¤ò¥¯¥ê¥Ã¥¯¤¹¤ì¤Ð¸«¤ë¤³¤È¤¬½ÐÍè¤Þ¤¹¡£
-
-@noindent
-@uref{http://savannah.gnu.org/projects/tramp/}
-
-@noindent
-¤â¤·¤¯¤Ï¡¢°Ê²¼¤Î¥»¥Ã¥·¥ç¥ó¤ÎÎã¤Ë½¾¤Ã¤Æ²¼¤µ¤¤¡£
-
-@example
-] @strong{cd ~/@value{emacsdir}}
-] @strong{cvs -d:pserver:anoncvs@@subversions.gnu.org:/cvsroot/tramp login}
-
-CVS password: @strong{(just hit RET here)}
-@dots{}
-
-] @strong{cvs -z3 -d:pserver:anoncvs@@subversions.gnu.org:/cvsroot/tramp co tramp}
-@end example
-
-¤³¤ì¤Ç¡¢@value{tramp} ¤ÎºÇ¿·¥Ð¡¼¥¸¥ç¥ó¤¬´Þ¤Þ¤ì¤ë¥Ç¥£¥ì¥¯¥È¥ê @file{~/@value{emacsdir}/tramp}
-¤¬ºîÀ®¤µ¤ì¤ë¤Ï¤º¤Ç¤¹¡£°Ê²¼¤Î¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤¹¤ë¤³¤È¤Ë¤è¤ê¡¢ºÇ¿·¤Î¥Ð¡¼¥¸¥ç¥ó
-¤Ë¹¹¿·¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹:
-
-@example
-] @strong{cd ~/@value{emacsdir}/tramp}
-] @strong{cvs update -d}
-@end example
-
-@noindent
-CVS ¥ê¥Ý¥¸¥È¥ê¤«¤é¥Õ¥¡¥¤¥ë¤ò¹¹¿·¤·¤¿¤é¡¢¿·¤·¤¤ @file{configure} ¥¹¥¯¥ê¥×¥È
-¤òÀ¸À®¤¹¤ë¤¿¤á¤Ë @command{autoconf} ¤ò¼Â¹Ô¤¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹:
-
-@example
-] @strong{cd ~/@value{emacsdir}/tramp}
-] @strong{autoconf}
-@end example
-
-
-@node History
-@chapter @value{tramp} ¤ÎÎò»Ë
-@cindex history
-@cindex development history
-
-@value{tramp} ¤Î³«È¯¤Ï 1998 ǯ¤Î 11·î²¼½Ü¤Ë»Ï¤Þ¤ê¤Þ¤·¤¿¡£¤½¤ÎÅö»þ¤Ï¡¢¤³¤Î
-¥Ñ¥Ã¥±¡¼¥¸¤Ï @file{rssh.el} ¤È¸Æ¤Ð¤ì¤Æ¤¤¤Þ¤·¤¿¡£¥Õ¥¡¥¤¥ë¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤¿¤á
-¤Î¤¿¤Ã¤¿¤Ò¤È¤Ä¤Î¥á¥½¥Ã¥É¤¬¤¢¤ë¤À¤±¤Ç¡¢@command{ssh} ¤ò»ÈÍѤ·¥ê¥â¡¼¥È
-¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤·¡¢@command{scp} ¤Ç¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòžÁ÷¤·¤Æ¤¤¤Þ¤·¤¿¡£
-¤·¤Ð¤é¤¯¤·¤Æ¡¢Ì¾Á°¤¬ @file{rcp.el} ¤ËÊѤï¤ê¡¢º£¤Ï @value{tramp} ¤È¸Æ¤Ð¤ì¤Æ¤¤¤Þ¤¹¡£
-¤³¤ì¤Ëȼ¤¤¡¢¥ê¥â¡¼¥È¥·¥§¥ë¤òµ¯Æ°¤·¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòžÁ÷¤¹¤ë¿¤¯¤Î¥á¥½¥Ã¥É
-¤¬Äɲ䵤ì¤Þ¤·¤¿¡£¤Þ¤¿¡¢VC ¥µ¥Ý¡¼¥È¤âÄɲ䵤ì¤Þ¤·¤¿¡£
-
-¤â¤Ã¤È¤âºÇ¶á¤ÎÂ礭¤Êµ¡Ç½Äɲäϡ¢2000ǯ4·î¤Î¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É¤ÎÄɲäȡ¢
-2002ǯ7·î¤Î @value{tramp} ¤Ë¤ª¤±¤ë¥Õ¥¡¥¤¥ë̾¤È Ange-FTP ¤Ë¤ª¤±¤ë¥Õ¥¡¥¤¥ë̾¤Î
-Åý°ì¤Ç¤¹¡£
-
-@c Installation chapter is necessary only in case of standalone
-@c installation.  Text taken from trampinst.texi.
-@ifset installchapter
-@include trampinst.texi
-@end ifset
-
-@node Configuration
-@chapter @value{tramp} ¤ÎÀßÄê
-@cindex configuration
-
-@cindex default configuration
-@value{tramp} ¤Ï(Ä̾ï)¥¤¥ó¥¹¥È¡¼¥ë¤¹¤ë¤À¤±¤Ç´°Á´¤Ëµ¡Ç½¤·¤Þ¤¹¡£½é´ü¾õÂ֤Ǥϡ¢
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤ÎÀܳ¤Ë @command{ssh} ¥×¥í¥°¥é¥à¤ò»ÈÍѤ·¡¢base64 ¥¨¥ó
-¥³¡¼¥Ç¥£¥ó¥°¤â¤·¤¯¤Ï uu ¥¨¥ó¥³¡¼¥Ç¥£¥ó¥°¤ò»ÈÍѤ¹¤ë¤è¤¦¤ËÀßÄꤵ¤ì¤Æ¤¤¤Þ
-¤¹¡£ ½¾¤Ã¤ÆºÇ¤â´Êñ¤Ê¾ì¹ç¤Ë¤Ï @kbd{C-x C-f} ¤ÈÂǤÁ¹þ¤ó¤Ç¥Õ¥¡¥¤¥ë̾
-@file{@value{prefix}@var{user}@@@var{machine}@value{postfix}@var{/path/to.file}}.
-¤òÆþÎϤ¹¤ë¤À¤±¤Ç¤¹¡£
-
-¥Û¥¹¥È¤Ë¤è¤Ã¤Æ¤Ï¡¢Àܳ¤ò³ÎΩ¤¹¤ë¤Î¤ËÌäÂ꤬µ¯¤­¤ë¤³¤È¤¬¤¢¤ê¤Þ¤¹¡£¤³¤ì¤Ï¡¢
- remote shell ¤Î¿¶¤ëÉñ¤¤¤Ë¤è¤ë¤â¤Î¤Ç¤¹¡£¤³¤Î¾ÜºÙ¤Ë¤Ä¤¤¤Æ¤Ï @xref{Remote
-shell setup}, ¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£
-
-¤â¤·¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤È¤ÎÀܳ¤Ë¤³¤ì¤é¤Î¥³¥Þ¥ó¥É¤ò»ÈÍѤ·¤¿¤¯¤Ê¤¤¾ì¹ç¤Ï¡¢
-@value{tramp} ¤Î¥Ç¥Õ¥©¥ë¥È¤ÎÀܳ¤ÈžÁ÷¥á¥½¥Ã¥É¤òÊѹ¹¤·¤Æ¤¯¤À¤µ¤¤¡£¥ê¥â¡¼¥È
-¥Þ¥·¥ó¤ËÀܳ¤·¥Õ¥¡¥¤¥ë¤òžÁ÷¤¹¤ë¤Î¤Ë»È¤¦¤³¤È¤Î¤Ç¤­¤ë @value{tramp} ¤Î¥á¥½¥Ã¥É
-¤¬¤¤¤¯¤Ä¤«¤¢¤ê¤Þ¤¹ (@pxref{Connection types})¡£
-
-¤É¤Î¥á¥½¥Ã¥É¤¬¤Õ¤µ¤ï¤·¤¤¤«¤ï¤«¤é¤Ê¤¤¤Ê¤é¼¡¤ò¸«¤Æ²¼¤µ¤¤: @xref{Default Method}.
-
-
-@menu
-* Connection types::            ¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤ÎÀܳ¤Î¼ïÎà
-* Inline methods::              ¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É
-* External transfer methods::   ³°ÉôžÁ÷¥á¥½¥Ã¥É
-* Multi-hop Methods::           ¥Þ¥ë¥Á¥Û¥Ã¥×¤ò»ÈÍѤ·¤¿¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤ÎÀܳ
-* Default Method::              ¥Ç¥Õ¥©¥ë¥È¤Î¥á¥½¥Ã¥É¤ÎÁªÂò
-                                  ¤³¤³¤Ç¤Ï¤É¤Î¥á¥½¥Ã¥É¤ò»È¤¨¤Ð¤è¤¤¤«
-                                  ¤ï¤«¤é¤Ê¤¤¿Í¤Î¤ª¼êÅÁ¤¤¤â¤·¤Þ¤¹¡£
-* Customizing Methods::         Èóɸ½à¤Î¥á¥½¥Ã¥É¤ò»È¤¦
-* Customizing Completion::      ¥æ¡¼¥¶/¥Û¥¹¥È̾Êä´°¤Î¤¿¤á¤ÎÀßÄê¥Õ¥¡¥¤¥ë¤ÎÁªÂò
-* Remote Programs::             ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç @value{tramp} ¤¬¥×¥í¥°¥é¥à¤òȯ¸«¡¢»ÈÍѤ¹¤ëÊýË¡
-* Remote shell setup::          ¥ê¥â¡¼¥È¥·¥§¥ëÀßÄê¤Î¥Ò¥ó¥È
-* Windows setup hints::         Cygwin ssh ¤Ë¤Þ¤Ä¤ï¤ë»öÊÁ
-* Auto-save and Backup::        Auto-save ¤È¥Ð¥Ã¥¯¥¢¥Ã¥×
-@end menu
-
-
-@node Connection types
-@section ¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤ÎÀܳ¤Î¼ïÎà
-@cindex connection types, overview
-
-žÁ÷¥á¥½¥Ã¥É¤Ë¤ÏÆó¤Ä¤Î´ðËÜŪ¤Ê¥¿¥¤¥×¤¬¤¢¤ê¡¢¤½¤ì¤¾¤ì¤ËĹ½ê¡¢Ã»½ê¤¬
-¤¢¤ê¤Þ¤¹¡£Î¾¼Ô¤È¤â¤Ë¡¢@command{rsh} ¤ä @command{ssh}¡¢@command{telnet} 
-¤Î¤è¤¦¤Ê¥ê¥â¡¼¥È¥·¥§¥ë¤Ë¥¢¥¯¥»¥¹¤¹¤ë¥×¥í¥°¥é¥à¤ò»ÈÍѤ·¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó
-¤ËÀܳ¤·¤Þ¤¹¡£
-
-¤³¤Î¥³¥Í¥¯¥·¥ç¥ó¤Ï¡¢@value{tramp} ¤¬¥í¡¼¥«¥ë¥Þ¥·¥ó¤«¤é¥ê¥â¡¼¥È¥Þ¥·¥ó¤ØÆ©²áŪ
-¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤¿¤á¤Ë¡¢¤µ¤Þ¤¶¤Þ¤Ê¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤ò¤ª¤³¤Ê¤¦¤¿¤á¤Ë»È¤ï¤ì¤Þ¤¹¡£
-¥Õ¥¡¥¤¥ë¤ò¥ª¡¼¥×¥ó¤·¤¿»þ¤Î¥á¥½¥Ã¥É¤¬°Û¤Ê¤ë¤À¤±¤Ç¤¹¡£
-
-@cindex inline methods
-@cindex external transfer methods
-@cindex external methods
-@cindex out-of-band methods
-@cindex methods, inline
-@cindex methods, external transfer
-@cindex methods, out-of-band
-¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤òÆɤ߹þ¤ó¤À¤ê¡¢Êݸ¤¹¤ë»þ¤Ë¤Ï¡¢Æó¤Ä¤Î¥Þ¥·¥ó´Ö¤Ç¥Õ¥¡¥¤¥ë
-¤ÎÆâÍƤòžÁ÷¤¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£¥Õ¥¡¥¤¥ë¤ÎÆâÍƤϡ¢¥Þ¥·¥ó¤Ë¥í¥°¥¤¥ó¤·¤¿¤Î
-¤ÈƱ¤¸¥³¥Í¥¯¥·¥ç¥ó¤«¡¢@command{rcp} ¤ä @command{scp}¡¢@command{rsync}
-¤Ê¤É¤Î¥ê¥â¡¼¥È¥³¥Ô¡¼¥×¥í¥°¥é¥à¤ò»ÈÍѤ·¤¿Ê̤Υ³¥Í¥¯¥·¥ç¥ó¤ÇžÁ÷¤µ¤ì¤Þ¤¹¡£
-Á°¼Ô¤Ï @dfn{¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É}¡¢¸å¼Ô¤Ï @dfn{out-of-band ¥á¥½¥Ã¥É} ¤¢¤ë¤¤¤Ï
-@dfn{³°ÉôžÁ÷¥á¥½¥Ã¥É} (ά¤·¤Æ @dfn{³°Éô¥á¥½¥Ã¥É}) ¤È¤è¤Ð¤ì¤Þ¤¹¡£
-
-¾¯¤Ê¤¯¤È¤âÂ礭¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ¤Ï¡¢°ìÈ̤˳°ÉôžÁ÷¥á¥½¥Ã¥É¤ÎÀ­Ç½¤Ï
-¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤è¤ê¤¹¤°¤ì¤Æ¤¤¤Þ¤¹¡£¤½¤ÎÍýͳ¤Ï¡¢¥¤¥ó¥é¥¤¥óžÁ÷¤Ç¤Ï
-¥Ç¡¼¥¿¤ÎÉä¹æ²½¡¢Éü¹æ²½¤ò¤ª¤³¤Ê¤¦É¬Íפ¬¤¢¤ë¤«¤é¤Ç¤¹¡£
-
-¤³¤Î¥ë¡¼¥ë¤ÎÍ£°ì¤ÎÎã³°¤Ï¡¢@command{scp} ¤ò»ÈÍѤ¹¤ëžÁ÷¥á¥½¥Ã¥É¤Ç¤¹¡£
-¤³¤ì¤é¤Î¥á¥½¥Ã¥É¤Î¼ÂºÝ¤Î¥Õ¥¡¥¤¥ëžÁ÷¤ÎÀ­Ç½¤Ï¹â¤¤¤Î¤Ç¤¹¤¬¡¢Å¾Á÷³«»Ï»þ
-¤Î°Å¹æ²½¤Ë¤«¤«¤ï¤ë¥Í¥´¥·¥¨¡¼¥·¥ç¥ó¤Î¥ª¡¼¥Ð¡¼¥Ø¥Ã¥É¤¬¥Õ¥¡¥¤¥ëžÁ÷¤ÎÀ­Ç½
-¤òÄ¢¾Ã¤·¤Ë¤·¤Þ¤¹¡£
-
-³°ÉôžÁ÷¥á¥½¥Ã¥É¤ò»È¤¦¤¿¤á¤Ë¤Ï¡¢¥ê¥â¡¼¥È¥³¥Ô¡¼¥³¥Þ¥ó¥É¤¬ÂÐÏÃŪ¤Ç¤Ê¤¤¡¢
-¤Ä¤Þ¤ê¥³¥Þ¥ó¥É¤¬¥Ñ¥¹¥ï¡¼¥É¤Î¤¿¤á¤Ë¥×¥í¥ó¥×¥È¤ò½ÐÎϤ·¤Ê¤¤¤³¤È¤¬É¬ÍפǤ¹¡£
-¤â¤·¡¢¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤʤ·¤Î¥ê¥â¡¼¥È¥³¥Ô¡¼¥³¥Þ¥ó¥É¤ò»È¤¦»ö¤¬¤Ç¤­¤Ê¤¤¤Î¤Ç
-¤¢¤ì¤Ð¡¢¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ò»È¤¦É¬Íפ¬¤¢¤ê¤Þ¤¹¡£
-
-@cindex multi-hop methods
-@cindex methods, multi-hop
-¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Î°ì¼ï¤Ë¡¢@dfn{¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É} ¤¬¤¢¤ê¤Þ¤¹¡£
-¤³¤Î¥á¥½¥Ã¥É¤ò»È¤¦¤È¡¢¤¤¤¯¤Ä¤«¤Î¥Û¥Ã¥×¤ò»È¤¤¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤ØÀܳ
-¤Ç¤­¤Þ¤¹¡£¤³¤ì¤Ï¡¢¤¢¤Ê¤¿¤¬¥»¥­¥å¥¢¤Ê¥Í¥Ã¥È¥ï¡¼¥¯¤ÎÃæ¤Ë¤¤¤Æ¡¢Í׺ɥۥ¹¥È
-¤ò·Ðͳ¤·¤Æ³°Éô¤ËÀܳ¤¹¤ë¾ì¹ç¤ËÊØÍø¤Ç¤¹¡£
-
-
-@node Inline methods
-@section ¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É
-@cindex inline methods
-@cindex methods, inline
-
-@value{tramp} ¤Î¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ÏÂçÊѶ¯ÎϤǡ¢³°ÉôžÁ÷¥á¥½¥Ã¥É¤ò»È¤¦»ö¤¬
-¤Ç¤­¤Ê¤¤¾õ¶·¤Ç¤âÆ°ºî¤·¤Þ¤¹¡£¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Ï¡¢telnet ·Ðͳ¤Ç¥ê¥â¡¼¥È
-¥Þ¥·¥ó¤ËÀܳ¤·¤Æ¤¤¤ë»þ¤ËÆ°ºî¤¹¤ëÍ£°ì¤Î¥á¥½¥Ã¥É¤Ç¤¹(¥Û¥¹¥È´Ö¤Ç¤Ê¤¯ 
-@emph{¥æ¡¼¥¶¡¼} ´Ö¤Î¥Õ¥¡¥¤¥ëžÁ÷¤ò²Äǽ¤Ë¤¹¤ë¡¢¤Á¤ç¤Ã¤ÈÊѤï¤Ã¤¿¥á¥½¥Ã¥É
-¤â¤¢¤ê¤Þ¤¹¡£°Ê²¼¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤)¡£
-
-¤³¤ì¤é¤Î¥á¥½¥Ã¥É¤ò»È¤¦¤¿¤á¤Ë¤Ï¡¢Éä¹æ²½¡¢Éü¹æ²½¤Î¤¿¤á¤Î¥³¥Þ¥ó¥É¤¬¥ê¥â¡¼¥È
-¥Þ¥·¥ó¾å¤Ë¸ºß¤·¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£¥í¡¼¥«¥ë¥Þ¥·¥ó¾å¤Ç¤Ï¡¢@value{tramp} ¤Ï
-¥Õ¥¡¥¤¥ë¤òÉü¹æ²½¡¢Éä¹æ²½¤¹¤ë Emacs ¤Îµ¡Ç½¤ò»È¤¦¤«¡¢³°Éô¥³¥Þ¥ó¥É¤ò»ÈÍÑ
-¤·¤Þ¤¹¡£
-
-@cindex uuencode
-@cindex mimencode
-@cindex base-64 encoding
-@value{tramp} ¤Ï¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¤ª¤¤¤Æ @command{mimencode}
-(@command{metamail} ¥Ñ¥Ã¥±¡¼¥¸¤Î°ìÉô) ¤ä @command{uuencode} ¤È¤¤¤Ã¤¿
-¥³¥Þ¥ó¥É¤Î¸ºß¤È¡¢¤½¤ì¤¬»È¤¨¤ë¤«¤É¤¦¤«¤òÄ´¤Ù¤Þ¤¹¡£ºÇ½é¤Î¿®Íê¤Ç¤­¤ë¥³¥Þ¥ó¥É¤¬
-»È¤ï¤ì¤Þ¤¹¡£¸¡º÷¥Ñ¥¹¤ò¥«¥¹¥¿¥Þ¥¤¥º¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£@ref{Remote
-Programs} ¤ò»²¾È¤·¤Æ²¼¤µ¤¤¡£
-
-¤â¤·¤É¤Á¤é¤Î¥³¥Þ¥ó¥É¤â¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë̵¤«¤Ã¤¿¾ì¹ç¡¢ @value{tramp} ¤Ï¾®¤µ¤Ê
-Perl ¤Î¥³¡¼¥É¤ò¥ê¥â¡¼¥È¥Û¥¹¥È¤ËžÁ÷¤·¡¢¤½¤ì¤ò¥¨¥ó¥³¡¼¥É¤ä¥Ç¥³¡¼¥É¤ËÍѤ¤
-¤è¤¦¤È¤·¤Þ¤¹¡£
-
-
-@table @asis
-@item @option{rsh}
-@cindex method rsh
-@cindex rsh method
-
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë @command{rsh} ¤ÇÀܳ¤·¤Þ¤¹¡£¥»¥­¥å¥¢¤Ç¤Ê¤¤Àܳ¤Î°Ù¡¢
-¶Ë¤á¤Æ¥í¡¼¥«¥ë¤Ê¥Û¥¹¥È¥È¥Ý¥í¥¸¡¼°Ê³°¤ËÍѤ¤¤ë¤Ù¤­¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£
-
-@command{rsh} ¤ÎÂå¤ï¤ê¤Ë @command{remsh} ¥³¥Þ¥ó¥É¤òÄ󶡤¹¤ë¥ª¥Ú¥ì¡¼¥Æ
-¥£¥ó¥°¥·¥¹¥Æ¥à¤Ç¤Ï¥á¥½¥Ã¥É @option{remsh} ¤ò»È¤¦¤³¤È¤â¤Ç¤­¤Þ¤¹¡£Î㤨¤Ð
-HP-UX ¤ä Cray UNICOS ¤Î¾ì¹ç¤¬¤¢¤Æ¤Ï¤Þ¤ê¤Þ¤¹¡£
-
-
-@item @option{ssh}
-@cindex method ssh
-@cindex ssh method
-
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë @command{ssh} ¤ÇÀܳ¤·¤Þ¤¹¡£@command{ssh} ¥Ñ¥Ã¥±¡¼¥¸
-¤òÍѤ¤¤ÆÀܳ¤ò¤è¤ê¥»¥­¥å¥¢¤Ë¤·¤Æ¤¤¤ë¤³¤È¤ò½ü¤±¤ÐÀè¤Û¤É¤Î¥ª¥×¥·¥ç¥ó¤ÈƱ
-¤¸¤Ç¤¹¡£
-
-@option{ssh1} ¤È @option{ssh2} ¤È¤¤¤¦Æó¤Ä¤ÎÊѼ郎¤¢¤ê¡¢¤½¤ì¤¾¤ì¤Ï
-@samp{ssh -1} ¤È @samp{ssh -2} ¤ò¸Æ¤Ó½Ð¤·¤Þ¤¹¡£¤³¤Î¤è¤¦¤Ë¤·¤Æ¡¢
-SSH ¥×¥í¥È¥³¥ë¥Ð¡¼¥¸¥ç¥ó 1 ¤È 2 ¤Î¤É¤Á¤é¤òÍѤ¤¤Æ¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ
-¤¹¤ë¤«¤òÌÀ¼¨Åª¤ËÁªÂò¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£(SSH ¤ÎÀßÄê¥Õ¥¡¥¤¥ë @file{~/.ssh/config}
-¤Ç¤É¤Á¤é¤Î¥×¥í¥È¥³¥ë¤òÍѤ¤¤ë¤«»ØÄꤷ¡¢Ä̾ï¤Î @option{ssh} ¥á¥½¥Ã¥É¤òÍѤ¤¤ë
-¤³¤È¤â¤Ç¤­¤Þ¤¹¡£)
-
-¤Þ¤¿¤½¤Î¤Û¤«¤Ë¡¢ @option{ssh1_old} ¤È @option{ssh2_old} ¤È¤¤¤¦Æó¤Ä¤ÎÊѼ郎
-¸ºß¤·¡¢ÌÀ¼¨Åª¤Ë @command{ssh1} ¥³¥Þ¥ó¥É¤È @command{ssh2} ¥³¥Þ¥ó¥É¤ò»È¤¤¤Þ¤¹¡£
-¤½¤ì¤é¤¬²¿¤«ÃΤé¤Ê¤¤¤Ê¤é¡¢¤³¤ì¤é¤Î¥ª¥×¥·¥ç¥ó¤Ï¤¢¤Ê¤¿¤Ë¤ÏɬÍפ¢¤ê¤Þ¤»¤ó¡£
-
-@command{ssh} ¤Ë´ð¤Å¤¯Á´¤Æ¤Î¥á¥½¥Ã¥É¤Ï¡¢¥¯¥ë¡¼¥¸ÅªÆÃħ¤ò»ý¤Á¤Þ¤¹:
-@file{host#42} ¤Î¤è¤¦¤Ë¤·¤Æ(¼Â¥Û¥¹¥È̾¤Ë³¤±¤Æ¥Ï¥Ã¥·¥åµ­¹æ¡¢¤½¤·¤Æ¥Ý¡¼¥ÈÈÖ¹æ)
-¥Û¥¹¥È̾¤ò»ØÄꤹ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¤³¤ì¤Î°ÕÌ£¤Ï¡¢»ØÄꤷ¤¿¥Û¥¹¥È¤ËÀܳ¤¹¤ëºÝ¤Ë¡¢
-@command{ssh} ¥³¥Þ¥ó¥É¤Î°ú¿ô¤È¤·¤Æ @code{-p 42} ¤òÅϤ¹¤È¤¤¤¦¤³¤È¤Ç¤¹¡£
-
-
-@item @option{telnet}
-@cindex method telnet
-@cindex telnet method
-
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë @command{telnet} ¤ÇÀܳ¤·¤Þ¤¹¡£¤³¤ì¤Ï @option{rsh} ¥á¥½¥Ã¥É
-¤ÈƱÍͤ˥»¥­¥å¥¢¤Ç¤Ê¤¤ÊýË¡¤Ç¤¹¡£
-
-
-@item @option{su}
-@cindex method su
-@cindex su method
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤·¤Þ¤»¤ó¡£¤½¤Î¤«¤ï¤ê¤Ë @command{su}
-¥×¥í¥°¥é¥à¤ò»È¤¦¤³¤È¤Ç¾¤Î¥æ¡¼¥¶¤È¤·¤Æ¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤¹¤ë¤³¤È¤ò²Äǽ¤È
-¤·¤Þ¤¹¡£
-
-
-@item @option{sudo}
-@cindex method sudo
-@cindex sudo method
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï¡¢@option{su} ¥á¥½¥Ã¥É¤Ë»÷¤Æ¤¤¤Þ¤¹¤¬¡¢°ã¤¦¥æ¡¼¥¶¡¼¤Ë¤Ê¤ë
-¤¿¤á¤Ë @command{su} ¤Ç¤Ê¤¯ @command{sudo} ¤ò»ÈÍѤ·¤Þ¤¹¡£
-
-¤½¤Î¥æ¡¼¥¶¡¼¤Ç¥·¥§¥ë¤òµ¯Æ°¤Ç¤­¤ë¤è¤¦¤Ë¡¢@command{sudo} ¤¬ÀßÄꤵ¤ì¤Æ¤¤¤Ê
-¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¤³¤È¤ËÃí°Õ¤·¤Æ¤¯¤À¤µ¤¤¡£@command{ls} ¤È @command{mimedecode} 
-¤Îµ¯Æ°¤Îµö²Ä¤À¤±¤Ç½½Ê¬¤Ç¤¢¤ì¤Ð¤è¤¤¤Î¤Ç¤¹¤¬¡¢¤½¤Î¤è¤¦¤Ë¼ÂÁõ¤¹¤ë¤Î¤Ï´Êñ¤Ç¤Ï
-¤Ê¤¯¡¢¤Þ¤À̵Íý¤Ç¤¹¡£
-
-
-@item @option{sshx}
-@cindex method sshx
-@cindex sshx method
-@cindex Cygwin (with sshx method)
-
-¤ªÊ¬¤«¤ê¤Î¤è¤¦¤Ë¡¢¤³¤ì¤Ï @option{ssh} ¤È¤Á¤ç¤Ã¤È°ã¤Ã¤¿Îà»÷ʪ¤Ç¤¹¡£
-@option{ssh} ¤¬¥ê¥â¡¼¥È¥Û¥¹¥È¤ÇÄ̾ï¤ÎÂÐÏÃŪ¥·¥§¥ë¤ò³«¤¯¤Î¤ËÂФ·¡¢
-¤³¤Î¥ª¥×¥·¥ç¥ó¤Ï @samp{ssh -t -t @var{host} -l @var{user} /bin/sh}
-¤ò»È¤Ã¤ÆÀܳ¤ò¹Ô¤Ê¤¤¤Þ¤¹¡£¤³¤ÎÊýË¡¤Ï¡¢Ä̾ï¤Î¥í¥°¥¤¥ó¥·¥§¥ë¤¬¡¢¥í¥°¥¤¥ó
-¤ÎºÝ¤Ë¼ÁÌä¤ò¤·¤Æ¤¯¤ë¤è¤¦¤ËÀßÄꤷ¤Æ¤¢¤ë¾ì¹ç¤ËÍ­ÍѤǤ¹¡£¤³¤Î¼ê½ç¤Ë¤è¤ê
-¤½¤ì¤é¤Î¼ÁÌä¤ò²óÈò¤·¤Æ¡¢`ɸ½àŪ¤Ê' ¥í¥°¥¤¥ó¥·¥§¥ë¤ò @value{tramp} ¤Ë»È¤ï¤»
-¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-¤³¤Î¼ê³¤­¤Ï @command{ssh} ¼«¿È¤«¤é¤Î¼ÁÌä¤òÇÓ½ü¤·¤Ê¤¤¤³¤È¤ËÃí°Õ¤·¤Æ²¼
-¤µ¤¤¡£Î㤨¤Ð¥ê¥â¡¼¥È¥Û¥¹¥È¤Î¥Û¥¹¥È¸°¤¬Ì¤ÃΤÎʪ¤Ç¤¢¤ë¾ì¹ç¤Ë¡¢``Are you
-sure you want to continue connecting?'' ¤È @command{ssh} ¤¬¿Ö¤¤¤Æ¤¯¤ë
-¤«¤â¤·¤ì¤Þ¤»¤ó¡£@value{tramp}  ¤Ï(º£¤Î¤È¤³¤í)¤½¤Î¤è¤¦¤Ê¼ÁÌä¤ò°·¤¦ÊýË¡¤òÃΤé
-¤Ê¤¤¤Î¤Ç¡¢¤½¤Î¤è¤¦¤Ê¼ÁÌä¤ò¤µ¤ì¤Ê¤¤¤Ç¥í¥°¥¤¥ó¤Ç¤­¤ë¤è¤¦¤Ë¤·¤Æ¤ª¤¯É¬Íפ¬
-¤¢¤ê¤Þ¤¹¡£
-
-¤³¤Î¼ê½ç¤Ï¡¢ @command{ssh} ¤ò Emacs ¥Ð¥Ã¥Õ¥¡¤«¤é¸Æ¤Ö¤È pseudo tty ¤ò³ä
-¤êÅö¤Æ¤Æ¤Ê¤¤¤È¸À¤ï¤ì¤Æ¤·¤Þ¤¦ Windows ¥æ¡¼¥¶¤Ë¤È¤Ã¤Æ¤âÍ­ÍѤǤ¹¡£¤³¤Î»þ¡¢
-¥í¥°¥¤¥ó¥·¥§¥ë¤Ï¥·¥§¥ë¥×¥í¥ó¥×¥È¤ò°ìÀÚɽ¼¨¤·¤è¤¦¤È¤·¤Ê¤¯¤Æ¡¢¤½¤ì¤Ï
-@value{tramp} ¤òÂçÊѺ®Í𤵤»¤Æ¤·¤Þ¤¤¤Þ¤¹¡£Ì¤ÃΤÎÍýͳ¤Ë¤è¤ê¡¢¤¤¤¯¤Ä¤«¤Î
-@command{ssh} ¤Î Windows ¤Ø¤Î°Ü¿¢ÈÇ(¤¿¤Ö¤ó Cygwin ¤Î¤â¤Î¤â)¤Ï  @samp{-t}
-¥ª¥×¥·¥ç¥ó¤òÆó¤Ä½Å¤Í¤Æ»È¤¦¤³¤È¤òÍ׵ᤷ¤Þ¤¹¡£
-
-¤³¤ì¤Ï @samp{-p} ¥¯¥ë¡¼¥¸¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£
-
-
-@item @option{krlogin}
-@cindex method krlogin
-@cindex km krlogin
-@cindex Kerberos (with krlogin method)
-
-¤³¤Î¥á¥½¥Ã¥É¤â @option{ssh} ¤Ë»÷¤Æ¤¤¤Þ¤¹¡£¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤¹¤ë¤Î¤Ë
-@command{krlogin -x} ¥³¥Þ¥ó¥É¤ò»È¤¦¤À¤±¤Ç¤¹¡£
-
-
-@item @option{plink}
-@cindex method plink
-@cindex plink method
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï SSH ¤Î PuTTY ¼ÂÁõ¤ò»È¤Ã¤Æ¤¤¤ë Windows ¥æ¡¼¥¶¤Ë¤È¤Ã¤Æ
-¤È¤Æ¤â¶½Ì£¿¼¤¤¤â¤Î¤Ç¤¹¡£¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤¹¤ë¤Î¤Ë @samp{plink -ssh}
-¤ò»È¤¤¤Þ¤¹¡£
-
-¤µ¤é¤Ë¥á¥½¥Ã¥É @option{plink1} ¤¬Ä󶡤µ¤ì¤Þ¤¹¡£¤½¤ì¤Ï
-ÌÀ¼¨Åª¤Ë SSH ¥×¥í¥È¥³¥ë¥Ð¡¼¥¸¥ç¥ó 1 ¤ò»È¤¦¤¿¤á¤Ë
-@samp{plink -1 -ssh} ¤ò¸Æ¤Ó½Ð¤·¤Þ¤¹¡£
-
-CCC: SSH key ¤ò¼õÍý¤¹¤ë¤¿¤á¤Ë¥³¥Þ¥ó¥É¥é¥¤¥ó¤«¤é¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø·Ò¤°É¬ÍפÏ
-¤¢¤ë¤Î¤«? ¤³¤ì¤Ï¼«Æ°²½¤Ç¤­¤Ê¤¤¤«?
-
-CCC: @command{plink} ¤Ï @samp{-p} ¥ª¥×¥·¥ç¥ó¤ò¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤ë¤«? ¤¤¤º¤ì¤Ë
-¤»¤è @value{tramp} ¤Ï¤½¤ì¤ò¥µ¥Ý¡¼¥È¤¹¤ë¡£
-
-@end table
-
-
-
-@node External transfer methods
-@section ³°ÉôžÁ÷¥á¥½¥Ã¥É
-@cindex methods, external transfer
-@cindex methods, out-of-band
-@cindex external transfer methods
-@cindex out-of-band methods
-
-
-³°ÉôžÁ÷¥á¥½¥Ã¥É¤ÏÊ£¿ô¤Î¥Á¥ã¥Í¥ë¤ò»ÈÍѤ·¤Þ¤¹¡£¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤Î¤¿¤á¤Ë
-¥ê¥â¡¼¥È¥·¥§¥ë¤Î¥³¥Í¥¯¥·¥ç¥ó¤ò»È¤¤¡¢¥Õ¥¡¥¤¥ëžÁ÷¤Ë¤Ï¡¢³°Éô¥×¥í¥°¥é¥à
-¤ò»È¤¤¤Þ¤¹¡£
-
-¤³¤ì¤Ï¡¢¥¤¥ó¥é¥¤¥óžÁ÷»þ¤Î¡¢¤Ò¤È¤Ä¤Î¥³¥Í¥¯¥·¥ç¥ó¤ò»È¤Ã¤¿Â¿½Å²½Å¾Á÷¤Î¤¿¤á
-¤ÎÉä¹æ²½¡¢Éü¹æ²½¤Î¥ª¡¼¥Ð¡¼¥Ø¥Ã¥É¤òºï¸º¤·¤Þ¤¹¡£
-
-³°ÉôžÁ÷¥á¥½¥Ã¥É¤ò»È¤¤¤¿¤¤¾ì¹ç¤Ï¡¢¥Õ¥¡¥¤¥ë¤ò¥³¥Ô¡¼¤¹¤ë¤¿¤á¤ÎžÁ÷¥æ¡¼¥Æ¥£
-¥ê¥Æ¥£¤¬¡¢¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤʤ·¤Ç¼Â¹Ô¤Ç¤­¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£
-
-@cindex ssh-agent
-¤Ä¤Þ¤ê¡¢@command{scp} ¤ò»È¤¦¾ì¹ç¤ä¡¢»È¤Ã¤Æ¤¤¤ë @command{scp} ¤¬¥³¥Þ¥ó¥É
-¥é¥¤¥ó¤Ç¥Ñ¥¹¥ï¡¼¥É¤ò¼õ¤±ÉÕ¤±¤ë¥Ð¡¼¥¸¥ç¥ó¤Î¾ì¹ç¤Ë¤Ï¡¢@command{ssh-agent}
-¤ò»È¤¦É¬Íפ¬¤¢¤ë¤È¤¤¤¦¤³¤È¤Ç¤¹¡£@footnote{PuTTY's @command{pscp} ¤Ç¤Ï
-¥³¥Þ¥ó¥É¥é¥¤¥ó¤Ç¥Ñ¥¹¥ï¡¼¥É¤ò»ØÄê¤Ç¤­¤Þ¤¹¡£}
-@command{ssh} ·Ðͳ¤Ç @command{rsync} ¤ò»È¤¦¾ì¹ç¤âƱÍͤǤ¹¡£
-
-¤â¤·¡¢¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤʤ·¤Ç @command{scp} ¤ò¼Â¹Ô¤¹¤ë¤³¤È¤¬¤Ç¤­¤Ê¤¤¤¬¡¢
-¥³¥Í¥¯¥·¥ç¥ó¤ò¥»¥­¥å¥¢¤Ë¤¹¤ë¤¿¤á¤Ë @command{ssh} ¤ò»È¤¤¤¿¤¤¾ì¹ç¤Ï¡¢
-@command{ssh} ¥Ù¡¼¥¹¤Î¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£
-
-
-@table @asis
-@item @option{rcp}  ---  @command{rsh} ¤È @command{rcp}
-@cindex method rcp
-@cindex rcp method
-@cindex rcp (with rcp method)
-@cindex rsh (with rcp method)
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï @command{rsh} ¤È @command{rcp} ¤ò»È¤¤¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó
-¤ËÀܳ¡¢¥Õ¥¡¥¤¥ëžÁ÷¤ò¤ª¤³¤Ê¤¤¤Þ¤¹¡£¤ª¤½¤é¤¯ºÇ®¤Î¥á¥½¥Ã¥É¤Ç¤¹¡£
-
-¤â¤¦°ì¤ÄÊ̤Υ᥽¥Ã¥É @option{remcp} ¤Ç¤Ï @command{remsh} ¥³¥Þ¥ó¥É¤È
-@command{rcp} ¥³¥Þ¥ó¥É¤ò»È¤¤¤Þ¤¹¡£¤³¤ì¤Ï @command{rsh} ¤ÎÂå¤ï¤ê¤Ë
-@command{remsh} ¤¬»È¤ï¤ì¤ë¥Þ¥·¥ó¾å¤Ç»È¤ï¤ì¤ë¤Ù¤­¤Ç¤¹¡£
-
-
-@item @option{scp}  ---  @command{ssh} ¤È @command{scp}
-@cindex method scp
-@cindex scp method
-@cindex scp (with scp method)
-@cindex ssh (with scp method)
-
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤ÎÀܳ¤Î¤¿¤á¤Î @command{ssh} ¤ä¡¢¥Þ¥·¥ó´Ö¤Î¥Õ¥¡¥¤¥ëžÁ÷
-¤Î¤¿¤á¤Î @command{scp} ¤Ï¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ø¤Î¥»¥­¥å¥¢¤ÊÀܳ¤È¥Õ¥¡¥¤¥ë
-¥¢¥¯¥»¥¹¤Î¤¿¤á¤Ë¤ÏºÇÎɤΥ᥽¥Ã¥É¤Ç¤¹¡£
-
-¤³¤Î¥ª¥×¥·¥ç¥ó¤ÎÀ­Ç½¤âÍ¥¤ì¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢¾®¤µ¤¤¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥×¥ó¡¢
-¥¯¥í¡¼¥º¤òÉÑÈˤ˷«¤êÊÖ¤¹¾ì¹ç¤Ï¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤è¤êÃÙ¤¯¤Ê¤ê¤Þ¤¹¡£
-@command{scp}¥»¥Ã¥·¥ç¥ó³«»Ï»þ¤Î°Å¹æ²½¤Î¤¿¤á¤Î¥Ï¥ó¥É¥·¥§¡¼¥¯¤Î¥³¥¹¥È¤Ï¡¢
-Éä¹æ²½¡¢Éü¹æ²½¤ò¤ª¤³¤Ê¤ï¤Ê¤¤ÍøÅÀ¤òÄ¢¾Ã¤·¤Ë¤·¤Þ¤¹¡£
-
-@option{scp1} ¤È @option{scp2} ¤È¤¤¤¦Æó¤Ä¤ÎÊѼ郎¤¢¤ê¡¢¤½¤ì¤¾¤ì¤Ï
-@samp{ssh -1} ¤È @samp{ssh -2} ¤ò¸Æ¤Ó½Ð¤·¤Þ¤¹¡£¤³¤Î¤è¤¦¤Ë¤·¤Æ¡¢
-SSH ¥×¥í¥È¥³¥ë¥Ð¡¼¥¸¥ç¥ó 1 ¤È 2 ¤Î¤É¤Á¤é¤òÍѤ¤¤Æ¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ
-¤¹¤ë¤«¤òÌÀ¼¨Åª¤ËÁªÂò¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£(SSH ¤ÎÀßÄê¥Õ¥¡¥¤¥ë @file{~/.ssh/config}
-¤Ç¤É¤Á¤é¤Î¥×¥í¥È¥³¥ë¤òÍѤ¤¤ë¤«»ØÄꤷ¡¢Ä̾ï¤Î @option{scp} ¥á¥½¥Ã¥É¤òÍѤ¤¤ë
-¤³¤È¤â¤Ç¤­¤Þ¤¹¡£)
-
-¤Þ¤¿¤½¤Î¤Û¤«¤Ë¡¢ @option{scp1_old} ¤È @option{scp2_old} ¤È¤¤¤¦Æó¤Ä¤ÎÊѼ郎
-¸ºß¤·¡¢ÌÀ¼¨Åª¤Ë @command{ssh1} ¥³¥Þ¥ó¥É¤È @command{ssh2} ¥³¥Þ¥ó¥É¤ò»È¤¤¤Þ¤¹¡£
-¤½¤ì¤é¤¬²¿¤«ÃΤé¤Ê¤¤¤Ê¤é¡¢¤³¤ì¤é¤Î¥ª¥×¥·¥ç¥ó¤Ï¤¢¤Ê¤¿¤Ë¤ÏɬÍפ¢¤ê¤Þ¤»¤ó¡£
-
-@command{ssh} ¤Ë´ð¤Å¤¯Á´¤Æ¤Î¥á¥½¥Ã¥É¤Ï¡¢ @samp{-p} ¤Ë´Ø¤¹¤ë¥¯¥ë¡¼¥¸Åª
-ÆÃħ¤ò»ý¤Ã¤Æ¤ª¤ê¡¢¥Û¥¹¥È̾¤ÎÃæ¤Ç¥Ý¡¼¥ÈÈÖ¹æ¤ò»ØÄê¤Ç¤­¤Þ¤¹¡£Î㤨¤Ð¥Û¥¹¥È
-̾¤ò @file{host#42} ¤È¤¹¤ë¤³¤È¤Ç @command{ssh} ¥³¥Þ¥ó¥É¤Î°ú¿ô¥ê¥¹¥È¤Ë
-@code{-p 42} ¤ò»ØÄꤹ¤ë¤è¤¦¤Ë @value{tramp} ¤Ë»Ø¼¨¤Ç¤­¤Þ¤¹¡£
-
-
-@item @option{rsync}  ---  @command{ssh} ¤È @command{rsync}
-@cindex method rsync
-@cindex rsync method
-@cindex rsync (with rsync method)
-@cindex ssh (with rsync method)
-
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥»¥­¥å¥¢¤ËÀܳ¤¹¤ë¤¿¤á¤Ë @command{ssh} ¥³¥Þ¥ó¥É¤ò¡¢
-¥Õ¥¡¥¤¥ëžÁ÷¤Î¤¿¤á¤Ë @command{rsync} ¤ò»È¤¦¤Î¤¬¡¢@option{scp}
-¥á¥½¥Ã¥É¤ÎÆÃħ¤Ç¤¹¡£
-
-ξ¦¤Î¥Û¥¹¥È¾å¤Ë¸ºß¤¹¤ë¥Õ¥¡¥¤¥ë¤òžÁ÷¤¹¤ë¾ì¹ç¡¢@command{rsync} ¤Ï
-@command{scp} ¤è¤ê¹âÀ­Ç½¤Ç¤¹¡£¤³¤ÎÍøÅÀ¤Ï¡¢¥Õ¥¡¥¤¥ë¤¬ÊÒ¦¤Î¥Û¥¹¥È¤Ë
-¤·¤«¤Ê¤¤¾ì¹ç¤Ë¤Ï¼º¤Ê¤ï¤ì¤Þ¤¹¡£
-
-¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤Ø½ñ¤­¹þ¤à¾ì¹ç¡¢@command{rsync} ¥Ù¡¼¥¹¤Î¥á¥½¥Ã¥É¤Ï
-@command{rcp} ¥Ù¡¼¥¹¤Î¥á¥½¥Ã¥É¤è¤ê¤«¤Ê¤ê®¤¤¤Ç¤·¤ç¤¦¡£¤·¤«¤·¡¢¥í¡¼¥«¥ë
-¥Þ¥·¥ó¤Î¥Õ¥¡¥¤¥ë¤òÆɤ߹þ¤à¾ì¹ç¤Ï¡¢Ä¾ÀÜ¥³¥Ô¡¼¤¹¤ë¤è¤ê®¤¯¤¢¤ê¤Þ¤»¤ó¡£
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï @samp{-p} ¥Ï¥Ã¥¯¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£
-
-
-@item @option{scpx} --- @command{ssh} ¤È @command{scp}
-@cindex method scpx
-@cindex scpx method
-@cindex scp (with scpx method)
-@cindex ssh (with scpx method)
-@cindex Cygwin (with scpx method)
-
-ÁÛÁüÄ̤ꡢ¤³¤Î¥á¥½¥Ã¥É¤Ï @option{scp} ¤È¤è¤¯»÷¤Æ¤¤¤Þ¤¹¡£@option{scp} ¤¬
-¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤ÇÄ̾ï¤ÎÂÐÏÃŪ¥·¥§¥ë¤òµ¯Æ°¤¹¤ë¤Î¤ËÂФ·¤Æ¡¢¤³¤Î¥ª¥×¥·¥ç¥ó
-¤Ï¥³¥Í¥¯¥·¥ç¥ó¤ò¥ª¡¼¥×¥ó¤¹¤ë¤¿¤á¤Ë @samp{ssh -t -t @var{host} -l
-@var{user} /bin/sh}
-¤ò»È¤¤¤Þ¤¹¡£¤³¤Î¥ª¥×¥·¥ç¥ó¤Ï¡¢Ä̾ï¤Î¥í¥°¥¤¥ó¥·¥§¥ë¤¬¥í¥°¥¤¥ó»þ¤Ë¤¤¤¯¤Ä¤«
-¤Î¼ÁÌä¤ò¤ª¤³¤Ê¤¦¤è¤¦¤ËÀßÄꤵ¤ì¤Æ¤¤¤ë¾ì¹ç¤ËÌò¤ËΩ¤Á¤Þ¤¹¡£¤³¤Î¼ê½ç¤Ë¤è¤ê
-¤½¤ì¤é¤Î¼ÁÌä¤ò²óÈò¤·¤Æ¡¢`ɸ½àŪ¤Ê' ¥í¥°¥¤¥ó¥·¥§¥ë¤ò @value{tramp} ¤Ë»È¤ï¤»
-¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-¤³¤Î¼ê½ç¤Ï Windows ¥æ¡¼¥¶¤Ë¤È¤Ã¤Æ @command{ssh} ¤ò Emacs ¥Ð¥Ã¥Õ¥¡¤«¤é
-¸Æ¤Ö¤È pseudo tty ¤ò³ä¤êÅö¤Æ¤Æ¤Ê¤¤¤È¸À¤ï¤ì¤Æ¤·¤Þ¤¦¾ì¹ç¤Ë¤âÍ­ÍѤǤ¹¡£
-¤³¤Î»þ¥í¥°¥¤¥ó¥·¥§¥ë¤Ï¥·¥§¥ë¥×¥í¥ó¥×¥È¤ò°ìÀÚɽ¼¨¤·¤Ê¤¤¤¿¤á¤Ë @value{tramp}
-¤ÏÂçÊѺ®Í𤷤Ƥ·¤Þ¤¤¤Þ¤¹¡£¤¿¤Ö¤ó¤³¤ì¤Ï Cygwin ¤Ë°Ü¿¢¤µ¤ì¤¿SSH ¤Î¾ì¹ç¤Ë
-Åö¤Æ¤Ï¤Þ¤ê¤Þ¤¹¡£
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï @samp{-p} ¥Ï¥Ã¥¯¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£
-
-
-@item @option{pscp} --- @command{plink} ¤È @command{pscp}
-@cindex method pscp
-@cindex pscp method
-@cindex pscp (with pscp method)
-@cindex plink (with pscp method)
-@cindex PuTTY (with pscp method)
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï @option{scp} ¤Ë»÷¤Æ¤¤¤Þ¤¹¤¬¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤¹¤ë¤Î
-¤Ë @command{plink} ¥³¥Þ¥ó¥É¤ò»È¤¤¡¢¥Õ¥¡¥¤¥ë¤òžÁ÷¤¹¤ë¤Î¤Ë @command{pscp}
-¤ò»È¤¤¤Þ¤¹¡£¤³¤ì¤é¤Î¥³¥Þ¥ó¥É¤Ï Windows ÍѤΠSSH ¼ÂÁõ¤Ç¤¢¤ë PuTTY ¤Ë
-´Þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£
-
-CCC: @command{plink} ¤Ï @samp{-p} ¥Ï¥Ã¥¯¤ò¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤ë¤«?
-
-
-@item @option{fcp} --- @command{fsh} ¤È @command{fcp}
-@cindex method fcp
-@cindex fcp method
-@cindex fsh (with fcp method)
-@cindex fcp (with fcp method)
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï @option{scp} ¤Ë»÷¤Æ¤¤¤Þ¤¹¤¬¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤¹¤ë¤Î
-¤Ë @command{fsh} ¥³¥Þ¥ó¥É¤ò»È¤¤¡¢¥Õ¥¡¥¤¥ë¤òžÁ÷¤¹¤ë¤Î¤Ë @command{fcp}
-¤ò»È¤¤¤Þ¤¹¡£ @command{fsh/fcp} ¤Ï @command{ssh} ¤Î¥Õ¥í¥ó¥È¥¨¥ó¥É¤Ç¡¢
-Ʊ°ì¤Î @command{ssh} ¥»¥Ã¥·¥ç¥ó¤òºÆÍøÍѤ·¤Æ¤¤¤¯¤Ä¤«¤Î¥³¥Þ¥ó¥É¤òÁ÷¤ë¤³
-¤È¤ò²Äǽ¤È¤·¤Þ¤¹¡£¤³¤ì¤Ë¤è¤ê¡¢@command{scp} ¤Îµ¯Æ°¤Ë¤«¤«¤ë¥ª¡¼¥Ð¡¼¥Ø¥Ã¥É
-(¸Æ¤Ð¤ì¤ëÅ٤˥»¥­¥å¥¢¤ÊÀܳ¤ò³ÎΩ¤·¤Ê¤¤¤È¤¤¤±¤Ê¤¤)¤ò²óÈò¤Ç¤­¤Þ¤¹¡£
-°ìÊý¡¢Æ±Íͤθú²Ì¤òÆÀ¤ë¤¿¤á¤Ë¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Î¤É¤ì¤«¤òÍѤ¤¤ë¤³¤È¤â
-¤Ç¤­¤ë¤³¤È¤òÃí°Õ¤·¤Æ¤ª¤­¤Þ¤¹¡£
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï¥³¥Þ¥ó¥É @samp{fsh @var{host} -l @var{user} /bin/sh -i}
-¤ò»È¤Ã¤ÆÀܳ¤ò³ÎΩ¤·¤Þ¤¹¡£Ã±¤Ë @command{fsh @var{host} -l @var{user}}
-¤È¤·¤¿¤À¤±¤Ç¤ÏÆ°¤­¤Þ¤»¤ó¡£
-
-@cindex method fsh
-@cindex fsh method
-@command{fsh} ¥×¥í¥°¥é¥à¤¬Ä󶡤¹¤ë¿½Å²½¤Ï²æ¡¹¤Îʸ̮¤Ç¤Ï¤½¤ì¤Û¤ÉÍ­ÍѤÇ
-¤Ï¤Ê¤¤¤Î¤Ç¡¢¤½¤ì¤òÍѤ¤¤ë¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Ï¸ºß¤·¤Þ¤»¤ó¡£¤½¤ÎÂå¤ï¤ê
-@value{tramp} ¤Ïñ¤Ë¥ê¥â¡¼¥È¥Û¥¹¥È¤Ø¤Î°ì¤Ä¤ÎÀܳ¤ò³«¤­¡¢¤½¤ÎÀܳ¤òÊÝ»ý¤·¤Þ¤¹¡£
-
-
-@ifset emacs
-@item @option{ftp}
-@cindex method ftp
-@cindex ftp method
-
-¤³¤ì¤Ï @value{tramp} Æȼ«¤Î¥á¥½¥Ã¥É¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£¤½¤ÎÂå¤ï¤ê¤ËÁ´¤Æ¤ÎÍ×µá¤ò
-@value{ftppackagename} ¤ËžÁ÷¤·¤Þ¤¹¡£
-@end ifset
-
-
-@item @option{smb} --- @command{smbclient}
-@cindex method smb
-@cindex smb method
-
-¤³¤ì¤Ï¤Þ¤¿Ê̤Π@value{tramp} Æȼ«¤Ç¤Ê¤¤¥á¥½¥Ã¥É¤Ç¤¹¡£@command{smbclient} 
-¥³¥Þ¥ó¥É¤òÊ̤ΠUnices ¾å¤Ç»È¤Ã¤Æ¡¢SMB ¥µ¡¼¥Ð¤Ø¤ÎÀܳ¤ò¹Ô¤Ê¤¤¤Þ¤¹¡£
-SMB ¥µ¡¼¥Ð¤ÏÊ̤ΠUNIX ¥Û¥¹¥È¾å¤Î Samba (¤â¤·¤¯¤Ï CIFS) ¥µ¡¼¥Ð¤Ç¤¢¤ë¤«
-¤â¤·¤ì¤Þ¤»¤ó¤·¡¢¤µ¤é¤Ë¶½Ì£¿¼¤¤¤³¤È¤Ë¡¢MS Windows ¤¬Æ°¤¤¤Æ¤¤¤ë¥Û¥¹¥È¤Ç
-¤¢¤ë¤«¤â¤·¤ì¤Ê¤¤¤Î¤Ç¤¹¡£º£¤Î¤È¤³¤í¡¢MS Windows NT¡¢MS Windows 2000¡¢
-¤ª¤è¤Ó MS Windows XP ¤ËÂФ·¤Æ¥Æ¥¹¥È¤µ¤ì¤Æ¤¤¤Þ¤¹¡£
-
-¥í¡¼¥«¥ë̾¤ÎÀèƬ¤Î¥Ç¥£¥ì¥¯¥È¥ê¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¤Ç¤Î¶¦Í­Ì¾¤Ç¤Ê¤±¤ì¤Ð¤Ê¤ê
-¤Þ¤»¤ó¡£Ä̾ï¥Ç¥Õ¥©¥ë¥È¤Î¶¦Í­¤Î½ªÃ¼¤Ïʸ»ú @code{$} ¤Ç¤¹¤¬¡¢¥Õ¥¡¥¤¥ë̾¤Î
-´Ä¶­ÊÑ¿ô¤Ë¤è¤ëŸ³«¤Î¤¿¤á¡¢¤½¤ì¤ò @code{$$} ¤È½ñ¤¯É¬Íפ¬¤¢¤ë¤³¤È¤ò²±¤¨¤Æ
-¤ª¤¤¤Æ²¼¤µ¤¤¡£¤â¤·¡¢¶¦Í­Ì¾¤¬Í¿¤¨¤é¤ì¤Ê¤±¤ì¤Ð(¤¹¤Ê¤ï¤Á¥ê¥â¡¼¥È¥Ç¥£¥ì¥¯¥È¥ê
-¤¬ @code{/} ¤Î¾ì¹ç)¡¢Á´¤Æ¤ÎÍøÍѲÄǽ¤Ê¶¦Í­¤¿¤Á¤¬É½¼¨¤µ¤ì¤Þ¤¹¡£
-
-ǧ²Ä¤Ï¶¦Í­¥ì¥Ù¥ë¤Ç¤Ê¤µ¤ì¤Æ¤¤¤ë¤Î¤Ç¡¢Æ±¤¸¥Û¥¹¥È¤Ç¤¢¤Ã¤Æ¤âÊ̤ζ¦Í­¤Ë¥¢¥¯
-¥»¥¹¤¹¤ë¤Èɬ¤º¥Ñ¥¹¥ï¡¼¥É¤òµá¤á¤é¤ì¤Þ¤¹¡£¥»¥­¥å¥ê¥Æ¥£¾å¤ÎÍýͳ¤«¤é¥Ñ¥¹¥ï
-¡¼¥É¤Ï¥­¥ã¥Ã¥·¥å¤µ¤ì¤Þ¤»¤ó¡£
-
-MS Windows ¤Ïǧ²Ä¤Î¤¿¤á¤Ë¥æ¡¼¥¶Ì¾¤È¥É¥á¥¤¥ó̾¤ÎξÊý¤òÍѤ¤¤Þ¤¹¡£¤³¤Î¤¿
-¤á¡¢@value{tramp} ¹½Ê¸¤Ï³ÈÄ¥¤µ¤ì¤Þ¤·¤¿: ¥æ¡¼¥¶Ì¾¤ò»ØÄꤹ¤ëºÝ¤Ë @code{user%domain}
-(¼Â¥æ¡¼¥¶Ì¾¡¢¥Ñ¡¼¥»¥ó¥Èµ­¹æ¡¢¥É¥á¥¤¥ó̾)¤Î¤è¤¦¤Ë½ñ¤¯¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-¤·¤¿¤¬¤Ã¤Æ¡¢¥Þ¥·¥ó @code{melancholia} ¤Ë¥É¥á¥¤¥ó @code{BIZARRE} ¤Î¥æ¡¼¥¶
-@code{daniel} ¤È¤·¤ÆÀܳ¤·¤Æ¡¢¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê (¶¦Í­ @code{daniel$})
-¤Ë¤¢¤ë @file{.emacs} ¤òÊÔ½¸¤¹¤ë¾ì¹ç¡¢¥Õ¥¡¥¤¥ë̾¤ò
-@file{@value{prefix}smb@value{postfixsinglehop}daniel%BIZARRE@@melancholia@value{postfix}/daniel$$/.emacs}
-¤È»ØÄꤷ¤Þ¤¹¡£
-
-¥É¥á¥¤¥ó̾¤ä¥æ¡¼¥¶Ì¾¤ÏÉÕ¤±¤Ê¤¤¤³¤È¤â¤Ç¤­¤Þ¤¹¡£¤â¤·¥æ¡¼¥¶Ì¾¤¬»ØÄꤵ¤ì¤Ê
-¤±¤ì¤Ðƿ̾¥æ¡¼¥¶(¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤÎɬÍפ¬¤Ê¤¤)¤¬²¾Äꤵ¤ì¤Þ¤¹¡£¤³¤ì¤Ï¾¤Î
-Á´¤Æ¤Î @value{tramp} ¥á¥½¥Ã¥É¤È°Û¤Ê¤ê¤Þ¤¹¡£Â¾¤Î¥á¥½¥Ã¥É¤ÇƱ¤¸¾õ¶·¤Î¾ì¹ç¤Ë¤Ï
-¥í¡¼¥«¥ë¥æ¡¼¥¶Ì¾¤¬»È¤ï¤ì¤Þ¤¹¡£
-
-@option{smb} ¥á¥½¥Ã¥É¤Ï @samp{-p} ¥Ï¥Ã¥¯¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£
-
-@strong{Ãí°Õ¤·¤Æ²¼¤µ¤¤:} ¤â¤· Emacs ¤¬¥í¡¼¥«¥ë¤Î MS Windows ¤Î²¼¤ÇÆ°¤¤
-¤Æ¤¤¤ë¤Ê¤é¤Ð¤³¤Î¥á¥½¥Ã¥É¤ÏÍøÍѤǤ­¤Þ¤»¤ó¡£¤½¤ÎÂå¤ï¤ê¤Ë¡¢
-@file{//melancholia/daniel$$/.emacs} ¤Î¤è¤¦¤Ê UNC ¥Õ¥¡¥¤¥ë̾¤ò»È¤¦¤³¤È
-¤¬¤Ç¤­¤Þ¤¹¡£Í£°ì¤Î·çÅÀ¤Ï¾¤Î¥æ¡¼¥¶Ì¾¤ò»ØÄꤹ¤ë¤¿¤á¤ÎÊýË¡¤¬Ìµ¤¤¤³¤È¤Ç¤¹¡£
-
-@end table
-
-@node Multi-hop Methods
-@section Ê£¿ô¤Î¥Û¥Ã¥×¤ò»È¤¤¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤¹¤ë
-@cindex multi-hop methods
-@cindex methods, multi-hop
-
-¤³¤ì¤Þ¤Ç¤ËÀâÌÀ¤·¤¿¥á¥½¥Ã¥É¤Ç¤ÏÉÔ½½Ê¬¤Ê»ö¤¬¤¢¤ê¤Þ¤¹¡£¥·¥ó¥×¥ë¤Ê¥á¥½¥Ã¥É¤ò
-»È¤Ã¤Æ¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤Ç¤­¤Ê¤¤¤³¤È¤¬¤¢¤ê¤Þ¤¹¡£¤¿¤È¤¨¤Ð¡¢¥»¥­¥å¥¢¤Ê
-¥Í¥Ã¥È¥ï¡¼¥¯¤ÎÃæ¤Ë¤¤¤ë¾ì¹ç¡¢³°Éô¤ËÀܳ¤¹¤ëÁ°¤Ë¤Þ¤ºÍ׺ɥۥ¹¥È¤Ë¥í¥°¥¤¥ó
-¤·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¤Ç¤·¤ç¤¦¡£¤â¤Á¤í¤ó¡¢¥¿¡¼¥²¥Ã¥È¥Û¥¹¥È¤ÏÍ׺ɥۥ¹¥È¤âÍ×µá
-¤·¤Þ¤¹¡£¥Þ¥ë¥Á¥Û¥Ã¥×¤Î¥Õ¥¡¥¤¥ë̾¤Î¥Õ¥©¡¼¥Þ¥Ã¥È¤Ï¡¢Ä̾ï¤Î @value{tramp} ¤Î
-¥á¥½¥Ã¥É¤È¤¹¤³¤·°Û¤Ê¤ê¤Þ¤¹¡£
-
-@cindex method multi
-@cindex multi method
-¥Þ¥ë¥Á¥Û¥Ã¥×¤Î¥Õ¥¡¥¤¥ë̾¤Ï¡¢¥á¥½¥Ã¥É̾¡¢¥Û¥Ã¥×¿ô¡¢¥í¡¼¥«¥ë̾(¥ê¥â¡¼¥È
-¥·¥¹¥Æ¥à¾å¤Î¥Ñ¥¹Ì¾)¤ò»ØÄꤷ¤Þ¤¹¡£¥á¥½¥Ã¥É̾¤Ï¾ï¤Ë @option{multi} ¤Ç¤¹¡£
-
-³Æ¥Û¥Ã¥×¤Ï @dfn{¥Û¥Ã¥×¥á¥½¥Ã¥É} »ØÄê¡¢¤Ä¤Þ¤ê¥æ¡¼¥¶Ì¾¤È¥Û¥¹¥È̾¤«¤éÀ®¤ê
-¤Þ¤¹¡£¥Û¥Ã¥×¥á¥½¥Ã¥É¤Ï¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤Î¤ß¤Ë¤Ê¤êÆÀ¤Þ¤¹¡£°Ê²¼¤Î¥Û¥Ã¥×
-¥á¥½¥Ã¥É¤¬(º£¤Î¤È¤³¤í)ÍøÍѲÄǽ¤Ç¤¹:
-
-@table @option
-@item telnet
-@cindex hop method telnet
-@cindex telnet hop method
-
-¥Û¥¹¥È¤Ø¤ÎÀܳ¤Ë¤è¤¯ÃΤé¤ì¤¿ @command{telnet} ¥×¥í¥°¥é¥à¤ò»ÈÍѤ·¤Þ¤¹¡£
-¥æ¡¼¥¶¡¼Ì¾¤È¥Û¥¹¥È̾¤Ï¥Õ¥¡¥¤¥ë̾¤ÎÃæ¤Ë´Þ¤Þ¤ì¡¢¥Ñ¥¹¥ï¡¼¥É¤ò¤¿¤º¤Í¤é¤ì¤Þ¤¹¡£
-
-@item rsh
-@cindex hop method rsh
-@cindex rsh hop method
-
-¥Û¥¹¥È¤Ø¤ÎÀܳ¤Ë @command{rsh} ¤ò»ÈÍѤ·¤Þ¤¹¡£@command{rsh} ¤¬¥Ñ¥¹¥ï¡¼¥É
-¤ò¤¿¤º¤Í¤ë»þ°Ê³°¤Ï¡¢¥Ñ¥¹¥ï¡¼¥É¤òÆþÎϤ¹¤ëɬÍפϤ¢¤ê¤Þ¤»¤ó¡£
-
-¤³¤ÎÊѼï @option{remsh} ¤Ï @command{remsh} ¥³¥Þ¥ó¥É¤ò»È¤¤¤Þ¤¹¡£¤³¤ì¤Ï
-@command{rsh} ¤ÎÂå¤ï¤ê¤Ë @command{remsh} ¤¬»È¤ï¤ì¤ë¥Þ¥·¥ó¾å¤Ç»È¤ï¤ì¤ë
-¤Ù¤­¤Ç¤¹¡£
-
-@item ssh
-@cindex hop method ssh
-@cindex ssh hop method
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï¥Û¥¹¥È¤Ø¤ÎÀܳ¤Î¤¿¤á¤Ë @command{ssh} ¤ò»ÈÍѤ·¤Þ¤¹¡£¥Ñ¥¹¥ï¡¼¥É
-¤«¥Ñ¥¹¥Õ¥ì¡¼¥º¤òÆþÎϤ¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£
-
-@item su
-@cindex hop method su
-@cindex su hop method
-
-¤³¤Î¥á¥½¥Ã¥É¤Ï¾¤Î¥Û¥¹¥È¤Ø¤Þ¤Ã¤¿¤¯¥¢¥¯¥»¥¹¤·¤Þ¤»¤ó¡£¤½¤Î¤«¤ï¤ê¡¢º£¤¤¤ë
-¥Û¥¹¥È¾å¤Ç¾¤Î¥æ¡¼¥¶¡¼¤Ë¤Ê¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¤³¤ì¤Ï¡¢root ¤È¤·¤Æ¥Õ¥¡¥¤¥ë
-¤òÊÔ½¸¤·¤¿¤¤¤¬¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¤Ï¥ê¥â¡¼¥È¤«¤é¤Î root ¤Î¥í¥°¥¤¥ó¤òµö²Ä¤·¤Æ
-¤¤¤Ê¤¤¾ì¹ç¤ËÌò¤ËΩ¤Á¤Þ¤¹¡£¤³¤Î¤è¤¦¤Ê¾ì¹ç¡¢°ìÈ̥桼¥¶¡¼¤Ç¤Î¥ê¥â¡¼¥È¥Û¥¹¥È
-¤Ø¤ÎÀܳ¤Ë @option{telnet}¡¢@option{rsh} ¤¢¤ë¤¤¤Ï @option{ssh} ¤ò»È¤¦
-¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¤½¤ì¤«¤é¡¢root ¤Ë¤Ê¤ë¤¿¤á¤Ë @option{su} ¥Û¥Ã¥×¤ò»È¤¤¤Þ¤¹¡£
-@option{su} ¤Ï°ìÏ¢¤Î¥·¡¼¥¯¥¨¥ó¥¹Ãæ¤ÎºÇ¸å¤Î¥Û¥Ã¥×¤Ç¤¢¤ëɬÍפϤ¢¤ê¤Þ¤»¤ó¡£
-ɬÍפǤ¢¤ì¤Ð¥Û¥Ã¥×Ãæ¤Î¤É¤³¤Ç¤Ç¤â»È¤¦¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-@option{su} ¥Û¥Ã¥×¤È°ì½ï¤Ë¥æ¡¼¥¶¡¼¤È¥Û¥¹¥ÈξÊý¤ò»ØÄꤷ¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£
-¤·¤«¤·¤Ê¤¬¤é¡¢¥Û¥¹¥È̾¤Ï̵»ë¤µ¤ì¥æ¡¼¥¶¡¼Ì¾¤À¤±¤¬»ÈÍѤµ¤ì¤Þ¤¹¡£
-
-@item sudo
-@cindex hop method sudo
-@cindex sudo hop method
-
-¤³¤ì¤Ï @option{su} ¥Û¥Ã¥×¤Ë»÷¤Æ¤¤¤Þ¤¹¡£°ã¤¦¥æ¡¼¥¶¡¼¤Ë¤Ê¤ë¤¿¤á¤Ë
-@command{su} ¤Ç¤Ê¤¯ @command{sudo} ¤ò»ÈÍѤ¹¤ëÅÀ¤¬°Û¤Ê¤ê¤Þ¤¹¡£
-
-@end table
-
-@command{ssh} ¤òÍѤ¤¤Æ¥Ý¡¼¥È¥Õ¥©¥ï¡¼¥É¤ò¤·¤¿¤¤¾ì¹ç¤ä¡¢É¸½àŪ¤Ç¤Ê¤¤¥Ý¡¼¥È¤ò
-»ÈÍѤ·¤Ê¤±¤ì¤Ð¤Ê¤é¤Ê¤¤¾ì¹ç¤¬¤¢¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤½¤Î¤è¤¦¤Ê¾ì¹ç¤Ë¤Ï¡¢
-¥Û¥¹¥È̾¤´¤È¤Ë°Û¤Ê¤ë¥Ý¡¼¥ÈÈÖ¹æ¤ò»ØÄꤷ¤¿µ­½Ò¤ò @file{~/.ssh/config} ¤Ë
-½ñ¤­¹þ¤à¤³¤È¤Ç¼Â¸½¤Ç¤­¤Þ¤¹¡£¤·¤«¤·¤Ê¤¬¤é¡¢¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É¤ò»È¤¨¤Ð
-¤½¤ì¤Ï @value{tramp} ¤ÎÏÈÆâ¤Ç¼Â¸½¤¹¤ë¤³¤È¤â¤Ç¤­¤Þ¤¹¡£Î㤨¤Ð:
-
-@lisp
-(add-to-list
- 'tramp-multi-connection-function-alist
- '("sshf" tramp-multi-connect-rlogin "ssh %h -l %u -p 4400%n"))
-@end lisp
-
-¤È¤¹¤ì¤Ð¡¢ @code{sshf} ¥Û¥Ã¥×¤òÍѤ¤¤Æ¡¢É¸½àŪ¤Ê¥Ý¡¼¥È¤ÎÊѤï¤ê¤Ë 4400 ÈÖ
-¥Ý¡¼¥È¤Ø·Ò¤°¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-
-@node Default Method
-@section ¥Ç¥Õ¥©¥ë¥È¤Î¥á¥½¥Ã¥É¤ÎÁªÂò
-@cindex default method
-
-@vindex tramp-default-method
-ÉáÃʤ褯»È¤¦Å¬ÀڤʞÁ÷¥á¥½¥Ã¥É¤òÁªÂò¤¹¤ë¤Ë¤Ï¡¢ÊÑ¿ô @code{tramp-default-method}
-¤òÀßÄꤷ¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£¤³¤ÎÊÑ¿ô¤Ë¤Ï @value{tramp} ¥Õ¥¡¥¤¥ë̾¤Ë¥á¥½¥Ã¥É¤¬
-»ØÄꤵ¤ì¤Ê¤«¤Ã¤¿»þ¤Ë»ÈÍѤµ¤ì¤ë¥Ç¥Õ¥©¥ë¥È¤Î¥á¥½¥Ã¥É¤òÀßÄꤷ¤Þ¤¹¡£
-Î㤨¤Ð:
-
-@lisp
-(setq tramp-default-method "scp")
-@end lisp
-
-@vindex tramp-default-method-alist
-ÊÑ¿ô @code{tramp-default-method-alist} ¤ò»È¤Ã¤ÆÆÃÄê¤Î¥æ¡¼¥¶/¥Û¥¹¥È¤Î
-ÁȤ߹ç¤ï¤»¤ËÂФ·¤Æ°Û¤Ê¤Ã¤¿¥á¥½¥Ã¥É¤ò»ØÄꤹ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£Î㤨¤Ð
-¼¡¤Î2¹Ô¤Ï¡¢¥æ¡¼¥¶Ì¾¤¬ @samp{john} ¤Ë¥Þ¥Ã¥Á¤¹¤ë¾ì¹ç¤Ë¤Ï @option{ssh}
-¥á¥½¥Ã¥É¤òÍѤ¤¡¢¥Û¥¹¥È̾¤¬ @samp{lily} ¤Ë¥Þ¥Ã¥Á¤¹¤ë¾ì¹ç¤Ë¤Ï @option{rsync}
-¥á¥½¥Ã¥É¤òÍѤ¤¤Þ¤¹¡£3¹ÔÌܤϥޥ·¥ó @samp{localhost} ¾å¤Î¥æ¡¼¥¶@samp{root}
-¤ËÂФ·¤Æ @option{su} ¥á¥½¥Ã¥É¤ò»È¤¦¤è¤¦¤Ë»ØÄꤷ¤Þ¤¹¡£
-
-@lisp
-(add-to-list 'tramp-default-method-alist '("" "john" "ssh"))
-(add-to-list 'tramp-default-method-alist '("lily" "" "rsync"))
-(add-to-list 'tramp-default-method-alist
-             '("\\`localhost\\'" "\\`root\\'" "su"))
-@end lisp
-
-@noindent
-¤µ¤é¤Ê¤ë¾ÜºÙ¤Ë¤Ä¤¤¤Æ¤ÏÊÑ¿ô @code{tramp-default-method-alist} ¤Î¥É¥­¥å¥á¥ó¥È
-¤ò¸«¤Æ²¼¤µ¤¤¡£
-
-°ìÈÌŪ¤Ë¤Ï¡¢¥¤¥ó¥é¥¤¥óžÁ÷¥á¥½¥Ã¥É¤è¤ê¤Ï³°ÉôžÁ÷¥á¥½¥Ã¥É¤òÁª¤Ö¤Ù¤­¤Ç¤¹¡£
-³°ÉôžÁ÷¥á¥½¥Ã¥É¤Ï¥¤¥ó¥é¥¤¥ó¤è¤ê¹âÀ­Ç½¤Ç¤¹¡£¤·¤«¤·¡¢³°ÉôžÁ÷¥á¥½¥Ã¥É¤Ï¡¢
-¥Ñ¥¹¥ï¡¼¥ÉÆþÎϤʤ·¤Ç¥í¥°¥¤¥ó¤Ç¤­¤Ê¤¤¥ê¥â¡¼¥È¥Þ¥·¥ó¤¬¤¿¤¯¤µ¤ó¤¢¤ë¾ì¹ç¤Ï
-Ìò¤ËΩ¤Á¤Þ¤»¤ó¡£
-
-@xref{Inline methods}.
-@xref{External transfer methods}.
-@xref{Multi-hop Methods}.
-
-žÁ÷¥á¥½¥Ã¥É¤ÎÁªÂò¤ò¤¹¤ë»þ¤Ë¾¤Ë¹Íθ¤¹¤Ù¤­»ö¤Ï¡¢¤½¤ì¤é¤ò»È¤¦´Ä¶­¤È¡¢
-Æä˥¤¥ó¥¿¡¼¥Í¥Ã¥È¾å¤Ç»È¤¦¾ì¹ç¤¢¤Ê¤¿¤ÎÁªÂò¤·¤¿¥á¥½¥Ã¥É¤Î¥»¥­¥å¥ê¥Æ¥£
-¤È¤Î´Ø·¸¤Ç¤¹¡£
-
-@command{rsh} ¤È @command{telnet} ¥á¥½¥Ã¥É¤Ï¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë¥í¥°¥¤¥ó
-¤¹¤ë»þ¤Ë¡¢¥Ñ¥¹¥ï¡¼¥É¤ò¥×¥ì¥¤¥ó¥Æ¥­¥¹¥È¤ÇÁ÷¿®¤·¤Þ¤¹¡£¥Õ¥¡¥¤¥ëžÁ÷¤âƱ¤¸
-ÊýË¡¤Ç¤ª¤³¤Ê¤¦¤Î¤Ç¡¢Â¾¤â¥Þ¥·¥ó¤«¤é¥Õ¥¡¥¤¥ë¤ÎÆâÍƤò´Êñ¤ËÆɤळ¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-¥¤¥ó¥¿¡¼¥Í¥Ã¥È¤«¤é¥¢¥¯¥»¥¹²Äǽ¤Ê¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤ËÀܳ¤¹¤ëɬÍפ¬¤¢¤ë¾ì¹ç¡¢
-Àܳ¤Ë @command{ssh} ¥Ù¡¼¥¹¤Î¥á¥½¥Ã¥É¤ò»ÈÍѤ¹¤ë¤³¤È¤ò¿¿·õ¤Ë¹Í¤¨¤ë¤Ù¤­¤Ç¤¹¡£
-¤³¤Î¥á¥½¥Ã¥É¤Ï¡¢¹â¤¤¥ì¥Ù¥ë¤Î¥»¥­¥å¥ê¥Æ¥£¤òÄ󶡤·¡¢Ã¯¤«¤¬¥Ñ¥¹¥ï¡¼¥É¤òÆþ¼ê
-¤·¤¿¤ê¡¢ÊÔ½¸¤·¤Æ¤¤¤ë¥Õ¥¡¥¤¥ë¤ÎÆâÍƤòÆɤó¤À¤ê¤¹¤ë¤³¤È¤òº¤Æñ¤Ë¤·¤Þ¤¹¡£
-
-
-@subsection »ä¤Ï¤É¤Î¥á¥½¥Ã¥É¤ò»È¤¦¤Ù¤­¤«?
-@cindex choosing the right method
-
-¤³¤³¤Þ¤Ç¤ÎÀâÌÀ¤Ç¡¢¤³¤ì¤ÏÁ´¤¯¤¹¤Ð¤é¤·¤¯¤ÆÎɤ¤¤â¤Î¤À¤¬¡¢¤·¤«¤·¤Ê¤¬¤é¥á¥½¥Ã¥É
-¤òÁª¤ÖÊýË¡¤Ë¤Ä¤¤¤Æ¤Ï²¿¤Î½õ¸À¤â¤µ¤ì¤Æ¤Ê¤¤¤è! ¤È»×¤¦¤³¤È¤È»×¤¤¤Þ¤¹¡£³Î¤«¤Ë¡£
-³«È¯¼Ô¤È¤·¤Æ¤Ï¡¢¥æ¡¼¥¶¤òµí¼ª¤í¤¦¤È¤Ï»×¤Ã¤Æ¤Ê¤¯¤Æ¡¢Âå¤ï¤ê¤ËºÇÂç¸Â¤Î¼«Í³ÅÙ¤ò
-Í¿¤¨¤è¤¦¤È¹Í¤¨¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¤Ê¤¬¤é¼ÂºÝ¤Ë¤Ï¥æ¡¼¥¶¤ÎÃæ¤Ë¤Ï¼ê°ú¤­¤òµá¤á¤ë
-¿Í¤âµï¤ë¤Ç¤·¤ç¤¦¡£¤½¤³¤Ç¤³¤³¤Ç¤Ï¤¢¤Ê¤¿¤ò»ÙÇÛ¤¹¤ë¤³¤È¤Ê¤¯¼ê°ú¤­¤òÍ¿¤¨¤ë¤³¤È
-¤ò»î¤ß¤Þ¤¹¡£¤³¤ì¤¬¤¦¤Þ¤¯¹Ô¤Ã¤¿¤«¶µ¤¨¤Æ²¼¤µ¤¤¤Í @dots{}
-
-»ä¤ÎÄó°Æ¤Ï¡¢¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ò»È¤¦¤³¤È¤Ç¤¹¡£Â礭¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ¤Ï
-out-of-band ¥á¥½¥Ã¥É¤ÎÊý¤¬Í­¸ú¤«¤â¤·¤ì¤Þ¤»¤ó¤¬¡¢¤Û¤È¤ó¤É¤Î¿Í¤Ï¾®¤µ¤Ê
-¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤·¤¿¤¤¤È»×¤¦¤È¿ä¬¤·¤Þ¤¹¡£
-
-º£Æü¤Ç¤Ï¡¢¤Û¤È¤ó¤É¤Î¿Í¤¬¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë @code{ssh} ¤ò»È¤Ã¤Æ¥¢¥¯¥»¥¹
-¤Ç¤­¤ë¤È¿ä¬¤·¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ @code{ssh} ¥á¥½¥Ã¥É¤ò»È¤¦¤³¤È¤òÄó°Æ¤·¤Þ¤¹¡£
-¤Ä¤Þ¤ê¡¢Â¾¤Î¥Û¥¹¥È¤Î @file{/etc/motd} ¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤¹¤ë¤¿¤á¤Ë¤Ï
-@kbd{C-x C-f /ssh:root@@otherhost:/etc/motd @key{RET}} ¤ÈÆþÎϤ¹¤ì¤Ð¤è¤¤
-¤Ç¤¹¡£
-
-¤â¤·¡¢@code{ssh} ¤ò»È¤Ã¤Æ¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤Ç¤­¤Ê¤¤¤Ê¤é¡¢Æ°ºî¤¹¤ë
-¥×¥í¥°¥é¥à¤ò»È¤¦¥á¥½¥Ã¥É¤òÁªÂò¤·¤Þ¤¹¡£Î㤨¤Ð Windows ¥æ¡¼¥¶¤Ï @code{ssh}
-¤Î PuTTY ¼ÂÁõ¤ò»È¤¦ @code{plink} ¥á¥½¥Ã¥É¤ò¹¥¤à¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤Þ¤¿¡¢
-Kerberos ¤ò»È¤Ã¤Æ¤¤¤ë¤Ê¤é @code{krlogin} ¤ò¹¥¤à¤Ç¤·¤ç¤¦¡£
-
-ÆÃÊ̤ʾì¹ç¤È¤·¤Æ¥í¡¼¥«¥ë¥Û¥¹¥È¤Î¥Õ¥¡¥¤¥ë¤òÊ̤Υ桼¥¶¤È¤·¤ÆÊÔ½¸¤·¤¿¤¤¾ì¹ç
-¤Ë¤Ï @code{su} ¥á¥½¥Ã¥É¤â¤·¤¯¤Ï @code{sudo} ¥á¥½¥Ã¥É¤ò»²¾È¤·¤Æ²¼¤µ¤¤¡£
-
-Â礭¤Ê¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤¹¤ë¿Í¤Ï @code{ssh} ¤ÎÂå¤ï¤ê¤Ë @code{scp} ¡¢¤â¤·¤¯¤Ï
-@code{plink} ¤ÎÂå¤ï¤ê¤Ë @code{pscp} ¤ÎÍøÍѤò¹Í¤¨¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£
-¤³¤ì¤é¤Î out-of-band ¥á¥½¥Ã¥É¤ÏÂ礭¤Ê¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ¤Ï¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É
-¤è¤ê¤â¹â®¤Ç¤¹¡£¤·¤«¤·¡¢out-of-band ¥á¥½¥Ã¥É¤¿¤Á¤Ï¤¤¤¯¤Ä¤«¤ÎÀ©¸Â
-¤ò¼õ¤±¤ë¤«¤â¤·¤ì¤Ê¤¤¤³¤È¤ËÃí°Õ¤·¤Æ²¼¤µ¤¤¡£ºÇ½é¤ËËÜÅö¤Ë¸²Ãø¤Ê®ÅÙŪ¤Ê
-Í¥°Ì¤ò out-of-band ¥á¥½¥Ã¥É¤ÇÆÀ¤é¤ì¤ë¤«»î¤·¤Æ²¼¤µ¤¤!¤ª¤½¤é¤¯Â礭¤Ê¥Õ¥¡¥¤¥ë
-¤ËÂФ·¤Æ¤â¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤¿¤Á¤Ï½½Ê¬¹â®¤À¤È»×¤¤¤Þ¤¹¡£
-
-»ä¤¬¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É¤ÎÍøÍѤòÄó°Æ¤¹¤ëÍýͳ¤Ï¡¢¤½¤ì¤é¤Ï¥ê¥â¡¼¥È¦¤¬
-¥Ñ¥¹¥ï¡¼¥É¤òʹ¤¤¤Æ¤­¤¿¤È¤·¤Æ¤âÆ°ºî¤¹¤ë¤«¤é¤Ç¤¹¡£out-of-band ¥á¥½¥Ã¥É
-¤Ï¤½¤Î¤è¤¦¤Ê¾õ¶·¤Ç¤ÏÆ°ºî¤·¤Þ¤»¤ó¡£¤Þ¤¿¡¢¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É¤¿¤Á¤Ï
-ËܼÁŪ¤Ë¥¤¥ó¥é¥¤¥ó¤Ç¤¹¡£
-
-
-@node Customizing Methods
-@section Èóɸ½à¤Î¥á¥½¥Ã¥É¤ò»È¤¦
-@cindex customizing methods
-@cindex using non-standard methods
-@cindex create your own methods
-
-»öÁ°¤ËÄêµÁ¤µ¤ì¤¿¥á¥½¥Ã¥É¤À¤±¤Ç¤ÏÉÔ½½Ê¬¤Ê¾ì¹ç¤Ë¡¢¤½¤ì¤òÊѹ¹¤¹¤ë¤¿¤á¤Î 
-@code{tramp-methods} ¤È¤¤¤¦ÊÑ¿ô¤¬¤¢¤ê¤Þ¤¹¡£
-
-Êѹ¹¤¬É¬Íפˤʤä¿»þ¤Î¤¿¤á¤Ë¡¢¤³¤ÎÊÑ¿ô¤Î Lisp ¥É¥­¥å¥á¥ó¥È¤Ë¤Ä¤¤¤Æ½Ò¤Ù¤Æ
-¤ª¤­¤Þ¤¹¡£¥É¥­¥å¥á¥ó¥È¤Ï @kbd{C-h v tramp-methods @key{RET}} ¤Ç»²¾È¤¹¤ë
-¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-
-@node Customizing Completion
-@section ¥æ¡¼¥¶/¥Û¥¹¥È̾Êä´°¤Î¤¿¤á¤ÎÀßÄê¥Õ¥¡¥¤¥ë¤ÎÁªÂò
-@cindex customizing completion
-@cindex selecting config files
-@vindex tramp-completion-function-alist
-
-ÊÑ¿ô @code{tramp-completion-function-alist} ¤Ï¡¢¥æ¡¼¥¶Ì¾¤È¥Û¥¹¥È̾¤Î
-Êä´° (@pxref{Filename completion}) ¤ÎºÝ¤Ë¤É¤Î¥Õ¥¡¥¤¥ë¤¿¤Á¤ò¹Íθ¤ËÆþ¤ì
-¤ë¤«¤ò¥«¥¹¥¿¥Þ¥¤¥º¤¹¤ë¤¿¤á¤Ë¤¢¤ê¤Þ¤¹¡£¤³¤ÎÊÑ¿ô¤Ï³Æ¡¹¤Î¥á¥½¥Ã¥É¤ËÂФ·¤Æ¡¢
-ÀßÄê¥Õ¥¡¥¤¥ë¤Î½¸¹ç¤È¤½¤Î¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤Ç¤­¤ë Lisp ´Ø¿ô¤È¤ÎÁȤòÊÝ»ý¤·
-¤Þ¤¹¡£@code{tramp-completion-function-alist} ¤Î¥¨¥ó¥È¥ê¤Ï
-(@var{method} @var{pair1} @var{pair2} ...) ¤Î·Á¼°¤ò¤È¤ê¤Þ¤¹¡£
-
-¤½¤ì¤¾¤ì¤Î @var{pair} ¤Ï (@var{function} @var{file}) ¤«¤éÀ®¤ê¤Þ¤¹¡£
-@var{function} ¤ÏÊä´°¤ÎºÝ¤Ë @var{file} ¤«¤é¥æ¡¼¥¶Ì¾¤È¥Û¥¹¥È̾¤ò¼è¤ê½Ð
-¤¹¤Î¤Ë»È¤ï¤ì¤Þ¤¹¡£¤³¤ÎÊÑ¿ô¤Ë¥¢¥¯¥»¥¹¤¹¤ëÆó¤Ä¤Î´Ø¿ô¤¬¤¢¤ê¤Þ¤¹:
-
-@defun tramp-get-completion-function method
-¤³¤Î´Ø¿ô¤Ï @var{method} ¤ËÂФ¹¤ëÊä´°´Ø¿ô¤Î¥ê¥¹¥È¤òÊÖ¤·¤Þ¤¹¡£
-
-Example:
-@example
-(tramp-get-completion-function "rsh")
-
-     @result{} ((tramp-parse-rhosts "/etc/hosts.equiv")
-         (tramp-parse-rhosts "~/.rhosts"))
-@end example
-@end defun
-
-@defun tramp-set-completion-function method function-list
-¤³¤Î´Ø¿ô¤Ï @var{method} ¤ËÂФ¹¤ëÊä´°´Ø¿ô¤Î¥ê¥¹¥È¤ò @var{function-list}
-¤ËÀßÄꤷ¤Þ¤¹¡£
-
-Example:
-@example
-(tramp-set-completion-function "ssh"
- '((tramp-parse-sconfig "/etc/ssh_config")
-   (tramp-parse-sconfig "~/.ssh/config")))
-
-     @result{} ((tramp-parse-sconfig "/etc/ssh_config")
-         (tramp-parse-sconfig "~/.ssh/config"))
-@end example
-@end defun
-
-ÀßÄê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤¹¤ë¤¿¤á¤Î°Ê²¼¤Î´Ø¿ô¤¬¤¢¤é¤«¤¸¤áÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹:
-
-@table @asis
-@item @code{tramp-parse-rhosts}
-@findex tramp-parse-rhosts
-
-¤³¤Î´Ø¿ô¤Ï¹½Ê¸Åª¤Ë @file{~/.rhosts} ¤ÈÅù²Á¤Ê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤·¤Þ¤¹¡£¤â¤·
-½ñ¤«¤ì¤Æ¤¤¤ì¤Ð¥Û¥¹¥È̾¤È¥æ¡¼¥¶Ì¾¤ÎξÊý¤òÊÖ¤·¤Þ¤¹¡£
-
-@item @code{tramp-parse-shosts}
-@findex tramp-parse-shosts
-
-¤³¤Î´Ø¿ô¤Ï¹½Ê¸Åª¤Ë @file{~/.ssh/known_hosts} ¤ÈÅù²Á¤Ê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤·¤Þ¤¹¡£
-¤½¤Î¥Õ¥¡¥¤¥ë¤Ë¤Ï¥æ¡¼¥¶Ì¾¤Ï½ñ¤«¤ì¤Æ¤¤¤Ê¤¤¤Î¤Ç¥Û¥¹¥È̾¤Î¤ß¤òÊÖ¤·¤Þ¤¹¡£
-
-@item @code{tramp-parse-sconfig}
-@findex tramp-parse-shosts
-
-¤³¤Î´Ø¿ô¤Ï @file{~/.ssh/config} ·Á¼°¤Î¥Õ¥¡¥¤¥ë¤Î @code{Host} ¥¨¥ó¥È¥ê¤Ç
-ÄêµÁ¤µ¤ì¤¿¥Û¥¹¥È¤Î¤¢¤À¤Ê¤òÊÖ¤·¤Þ¤¹¡£
-
-@item @code{tramp-parse-hosts}
-@findex tramp-parse-hosts
-
-@file{/etc/hosts} ·Á¼°¤Î¥Õ¥¡¥¤¥ë¤Î¤¿¤á¤Î´Ø¿ô¤Ç¤¹¡£¥Û¥¹¥È̾¤Î¤ß¤òÊÖ¤·¤Þ¤¹¡£
-
-@item @code{tramp-parse-passwd}
-@findex tramp-parse-passwd
-
-@file{/etc/passwd} ¤Î¤è¤¦¤Ê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤¹¤ë´Ø¿ô¤Ç¤¹¡£ÅöÁ³¤Ê¤¬¤é¥æ¡¼¥¶
-̾¤Î¤ß¤òÊÖ¤·¤Þ¤¹¡£
-
-@item @code{tramp-parse-netrc}
-@findex tramp-parse-netrc
-
-ºÇ¸å¤Ë¡¢¤³¤ì¤Ï @file{~/.netrc} ¤Î¤è¤¦¤Ê¥Õ¥¡¥¤¥ë¤ò¥Ñ¡¼¥¹¤¹¤ë´Ø¿ô¤Ç¤¹¡£
-@end table
-
-¤â¤·Æȼ«¤Î¥Ç¡¼¥¿¤òÆȼ«¤Î¹½Â¤¤Ç¥Õ¥¡¥¤¥ë¤ËÊÝ»ý¤·¤¿¤¤¤Ê¤é¡¢¤³¤Î¤è¤¦¤Ê´Ø¿ô
-¤òÄ󶡤¹¤ì¤Ð¤è¤¤¤Ç¤¹¡£¤³¤Î´Ø¿ô¤Ï°Ê²¼¤Î´·½¬¤Ë¹çÃפ¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£
-
-@defun my-tramp-parse file
-@var{file} ¤Ï¤¢¤Ê¤¿¤Î¥Û¥¹¥È¤Ë¤¢¤ë¥Õ¥¡¥¤¥ë̾¤â¤·¤¯¤Ï @code{nil} ¤Î¤¤¤º¤ì¤«
-¤Ç¤¹¡£¤³¤Î´Ø¿ô¤Ï (@var{user} @var{host}) ¤Î¥ê¥¹¥È¤òÊÖ¤µ¤Í¤Ð¤Ê¤ê¤Þ¤»¤ó¡£
-¤½¤ì¤é¤Ï¥æ¡¼¥¶/¥Û¥¹¥È̾Êä´°¤Î¸õÊä¤È¤·¤Æ»È¤ï¤ì¤Þ¤¹¡£
-
-Example:
-@example
-(my-tramp-parse "~/.my-tramp-hosts")
-
-     @result{} ((nil "toto") ("daniel" "melancholia"))
-@end example
-@end defun
-
-
-@node Remote Programs
-@section ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç @value{tramp} ¤¬¥×¥í¥°¥é¥à¤òȯ¸«¡¢»ÈÍѤ¹¤ëÊýË¡
-
-@value{tramp} ¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤Î¤¤¤¯¤Ä¤«¤Î¥×¥í¥°¥é¥à¡¢@command{ls}¡¢
-@command{test}¡¢@command{find} ¤½¤·¤Æ @command{cat} ¤Ë°Í¸¤·¤Æ¤¤¤Þ¤¹¡£
-
-¤³¤ì¤é¤Î¥Ä¡¼¥ë¤Ë¤¯¤ï¤¨¡¢¥³¥Í¥¯¥·¥ç¥ó¥á¥½¥Ã¥É¤Î¤¿¤á¤Ë¤¤¤¯¤Ä¤«¤Î¥Ä¡¼¥ë¤¬
-ɬÍפǤ¹¡£¾ÜºÙ¤Ï @ref{Inline methods} ¤È @ref{External transfer methods} 
-¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£
-
-¤¤¤¯¤Ä¤«¤Î¾¤Î¥Ä¡¼¥ë¡¢@command{perl} (¤¢¤ë¤¤¤Ï @command{perl5}) ¤È
-@command{grep} ¤¬Â¸ºß¤¹¤ì¤Ð¤½¤ì¤é¤â»ÈÍѤµ¤ì¤Þ¤¹¡£¤³¤ì¤Ï¡¢À­Ç½¤È
-¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¥¢¥¯¥»¥¹¤ÎÀµ³Î¤µ¤Î¸þ¾å¤Î¤¿¤á¤Ç¤¹¡£
-
-@vindex tramp-remote-path
-@value{tramp} ¤Ï¥ê¥â¡¼¥È¥Þ¥·¥ó¤ËÀܳ¤·¤¿»þ¤Ë¡¢»ÈÍѲÄǽ¥×¥í¥°¥é¥à¤ò¸¡º÷¤·¤Þ¤¹¡£
-ÊÑ¿ô @var{tramp-remote-path} ¤Ï¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç¸¡º÷¤µ¤ì¤ë¥Ç¥£¥ì¥¯¥È¥ê
-¤òÀ©¸æ¤·¤Þ¤¹¡£
-
-¥Ç¥Õ¥©¥ë¥È¤Ç¿¤¯¤Î¥Þ¥·¥ó¤Ë¤È¤Ã¤ÆŬÀڤʥѥ¹¤¬ÀßÄꤵ¤ì¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·
-¤Ê¤¬¤é¡¢¥í¡¼¥«¥ë(¤¢¤ë¤¤¤Ï¥ê¥â¡¼¥È)¥·¥¹¥Æ¥à¤Î´ÉÍý¼Ô¤¬¡¢É¬Íפʥġ¼¥ë¤ò
-¤Ø¤ó¤Ô¤Ê¥Ç¥£¥ì¥¯¥È¥ê¤Ë¥¤¥ó¥¹¥È¡¼¥ë¤·¤Æ¤¤¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£
-
-¤³¤Î¤è¤¦¤Ê¾ì¹ç¤Ç¤â @value{tramp} ¤ò»È¤¦»ö¤¬¤Ç¤­¤Þ¤¹¡£Ã±¤Ë¡¢É¬Íפʥǥ£¥ì¥¯¥È¥ê
-¤ò¥ê¥â¡¼¥È¥Ñ¥¹¤ËÄɲ乤륳¡¼¥É¤ò @file{.emacs} ¤Ë½ñ¤¯¤À¤±¤Ç¤¹¡£¤³¤ì¤Ç
-Àܳ»þ¤Ë @value{tramp} ¤Ë¤è¤ê¡¢Äɲä·¤¿¥Ç¥£¥ì¥¯¥È¥ê¤¬¸¡º÷¤µ¤ì¥×¥í¥°¥é¥à¤¬
-ȯ¸«¤µ¤ì¤Þ¤¹¡£
-
-¥ê¥â¡¼¥È¥µ¡¼¥Á¥Ñ¥¹¤Ë¥Ç¥£¥ì¥¯¥È¥ê¤òÄɲ乤뤿¤á¤Ë¤Ï¡¢°Ê²¼¤Î¤è¤¦¤Ê
-¥³¡¼¥É¤ò»È¤Ã¤Æ¤¯¤À¤µ¤¤:
-
-@lisp
-@i{;; ÊÑ¿ô¤òÄêµÁ¤¹¤ë¤¿¤á¤Ë @value{tramp} ¤ò¥í¡¼¥É¤¹¤ë}
-(require 'tramp)
-@i{;; @command{perl} ¤¬ "/usr/local/perl/bin" ¤Ë¤¢¤ë}
-(add-to-list 'tramp-remote-path "/usr/local/perl/bin")
-@end lisp
-
-@node Remote shell setup
-@comment  node-name,  next,  previous,  up
-@section ¥ê¥â¡¼¥È¥·¥§¥ë¤ÎÀßÄê¤Î¥Ò¥ó¥È
-@cindex remote shell setup
-@cindex @file{.profile} file
-@cindex @file{.login} file
-@cindex shell init files
-
-@ref{Overview} ¤ÎÀá¤ÇÀâÌÀ¤·¤¿¤è¤¦¤Ë¡¢@value{tramp} ¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÀܳ¤·¡¢
-¤½¤³¤Ë¤¢¤ë¥·¥§¥ë¤ÈÂÐÏä·¤Þ¤¹¡£¤â¤Á¤í¤ó¥í¥°¥¤¥ó¤¹¤ëºÝ¤Ë¤Ï¥·¥§¥ë¤Ï¤½¤Î
-½é´ü²½¥Õ¥¡¥¤¥ë¤ò¼Â¹Ô¤·¤Þ¤¹¡£Î㤨¤Ð¤¢¤Ê¤¿¤Î½é´ü²½¥Õ¥¡¥¤¥ë¤¬¤¢¤Ê¤¿¤Î¤ªÊì
-¤µ¤ó¤ÎÃÂÀ¸Æü¤òÆþÎϤµ¤»¤ë¤è¤¦¤Ë¤Ê¤Ã¤Æ¤¤¤¿¤È¤·¤Þ¤·¤ç¤¦; ÅöÁ³ @value{tramp}
-¤Ï¤½¤Î¤³¤È¤òÃΤé¤Ê¤¤¤Î¤Ç¡¢¤½¤Î¥Û¥¹¥È¤Ø¤Î¥í¥°¥¤¥ó¤Ë¼ºÇÔ¤·¤Þ¤¹¡£
-
-¤³¤ÎÌäÂê¤òÄɵ᤹¤ë¤¿¤á¤Ë¡¢¤¤¤¯¤Ä¤«¤ÎÀïά¤¬¹Í¤¨¤é¤ì¤Þ¤¹¡£°ì¤Ä¤Ï¡¢@value{tramp}
-¤¬¤¹¤Ù¤Æ¤Î²Äǽ¤Ê¾õ¶·¤ËÂбþ¤Ç¤­¤ë¤è¤¦¤Ë¤¹¤ë¤³¤È¤Ç¤¹¡£¤³¤ì¤Ï¾ÃÌ×Àï¤Ç¤¹¡£
-²¿¸Î¤Ê¤é @emph{Á´¤Æ¤Î} ¾õ¶·¤ò°·¤¦¤³¤È¤ÏÉÔ²Äǽ¤À¤«¤é¤Ç¤¹¡£Ê̤μê¤È¤·¤Æ¡¢
-@value{tramp} ¤Î´üÂÔÄ̤ê¤Ë¿¶¤ëÉñ¤¦¤è¤¦¤Ë¡¢¤¢¤Ê¤¿¤Ë¥ê¥â¡¼¥È¥Û¥¹¥È¤ÎÀßÄê¤ò¤·¤Æ
-¤¤¤¿¤À¤¯¤È¤¤¤¦¤³¤È¤â½ÐÍè¤Þ¤¹¡£¤·¤«¤·¤³¤ì¤ÏÉÔÊؤ«¤â¤·¤ì¤Þ¤»¤ó¡£²¿¸Î¤Ê¤é
-@value{tramp} ¤ò»È¤¤»Ï¤á¤ë¤è¤êÀè¤Ë¡¢¥·¥§¥ë¤ÎÀßÄê¤Ë¿¤¯¤ÎÏ«ÎϤò³ä¤¯É¬Íפ¬¤¢¤ë
-¤Î¤Ç¤¹¤«¤é¡£
-
-¤½¤Î¤³¤È¤«¤é¡¢¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ç¤Ï¤½¤ì¤é¤òÁȤ߹ç¤ï¤»¤¿ÊýË¡¤ò¤È¤ê¤Þ¤¹¡£
-¤¤¤¯¤Ä¤«¤Î¤¢¤ê¤Õ¤ì¤¿ÀßÄê¤Ë¤Ä¤¤¤Æ¤ÏÍý²ò¤·¤è¤¦¤È¤·¤Æ¤¯¤ì¤Æ¡¢¤¢¤Ê¤¿¤Ë¤Ï
-ËÜÅö¤ËÆðۤÊÀßÄê¤À¤±¤òÈò¤±¤ë¤è¤¦¤Ëµá¤á¤Þ¤¹¡£Î㤨¤Ð¡¢¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤Ç
-¤¢¤ë¥×¥í¥°¥é¥à¤ò¸«¤Ä¤±¤ë¤¿¤á¤Ë¤Ï¡¢¥Ç¥£¥ì¥¯¥È¥ê¤Î°ìÍ÷¤òÄ´¤Ù¤Þ¤¹¡£
-¤½¤·¤Æ¤Þ¤¿¡¢¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤¹¤ë¤«¤ò¤É¤¦¤«Ä´¤Ù¤ëÊýË¡¤È¤¤¤¦¤Î¤âÌÀ¤é¤«¤Ç¤Ï
-¤Ê¤¤¤Î¤Ç¡¢¤¤¤¯¤Ä¤«¤Î°Û¤Ê¤ë²ÄǽÀ­¤ò»î¤·¤Æ¤¯¤ì¤Þ¤¹¡£
-(¤¢¤ë¥Û¥¹¥È¤È¥·¥§¥ë¤Ë¤ª¤¤¤Æ¤Ï¡¢@code{test -e} ¥³¥Þ¥ó¥É¤¬¤½¤ÎÌòÌܤò²Ì¤¿¤¹¡£
-Ê̤Υۥ¹¥È¡¢¥·¥§¥ë¤ËÂФ·¤Æ¤Ï¥·¥§¥ë¤ÎÁȤ߹þ¤ß¥³¥Þ¥ó¥É¤ÏƯ¤«¤Ê¤¤¤¬¡¢
-@code{/usr/bin/test -e} ¤ä @code{/bin/test -e} ¤Ê¤é¤¦¤Þ¤¯Æ¯¤¯¡£
-¤½¤·¤Æ¤µ¤é¤ËÊ̤Υۥ¹¥È¤Ç¤Ï @code{ls -d} ¤¬¤½¤ÎÊýË¡¤È¤·¤ÆƯ¤¯¡£)
-
-°Ê²¼¤Ç¤Ï¡¢@value{tramp} ¤¬¼è¤ê°·¤Ã¤Æ¤¯¤ì¤Ê¤¤¡¢¤Ä¤Þ¤ê¤¢¤Ê¤¿¤¬Àµ¤·¤¯ÀßÄꤹ¤ëɬÍ×
-¤Î¤¢¤ë¤¤¤¯¤Ä¤«¤Î»öÊÁ¤Ë¤Ä¤¤¤Æ½Ò¤Ù¤Þ¤¹¡£
-
-@table @asis
-@item @var{shell-prompt-pattern}
-@vindex shell-prompt-pattern
-
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤·¤¿¸å¡¢@value{tramp} ¤¬¥ê¥â¡¼¥È¥·¥§¥ë¤ËÌ¿Îá¤òÁ÷¤ì¤ë
-¤è¤¦¤Ë¤Ê¤ëÁ°¤Ë¡¢¥ê¥â¡¼¥È¥·¥§¥ë¤Î¥»¥Ã¥È¥¢¥Ã¥×¤¬½ªÎ»¤¹¤ë¤Î¤òÂÔ¤ÄɬÍפ¬¤¢¤ê
-¤Þ¤¹¡£¥·¥§¥ë¥×¥í¥ó¥×¥È¤òǧ¼±¤¹¤ë°Ù¤Ë¡¢ÊÑ¿ô @code{shell-prompt-pattern}
-¤ò¥ê¥â¡¼¥È¥Û¥¹¥È¤Î¥·¥§¥ë¥×¥í¥ó¥×¥È¤òǧ¼±½ÐÍè¤ë¤è¤¦¤ËÀßÄꤷ¤Æ¤ª¤¯É¬Íפ¬
-¤¢¤ê¤Þ¤¹¡£
-
-@value{tramp} ¤Ï @code{shell-prompt-pattern} ¤ËÂФ·¤Æ¥Ð¥Ã¥Õ¥¡ËöÈø¤Ç¥Þ¥Ã¥Á¤¹
-¤ë¤³¤È¤òÍ׵᤹¤ë¤³¤È¤ËÃí°Õ¤·¤Æ²¼¤µ¤¤¡£Â¿¤¯¤Î¿Í¤Ï¤³¤ÎÊÑ¿ô¤ÎÃͤȤ·¤Æ¼¡¤Î
-¤è¤¦¤Ê¤â¤Î¤ò»ØÄꤷ¤Æ¤¤¤Þ¤¹: @code{"^[^>$][>$] *"}¡£¤³¤³¤Ç¤¢¤Ê¤¿¤Î¥·¥§¥ë
-¥×¥í¥ó¥×¥È¤¬ @code{a  c $ } ¤Î¤è¤¦¤Ê¤â¤Î¤À¤Ã¤¿¤È¤·¤Þ¤·¤ç¤¦¡£¤³¤Î¾ì¹ç¡¢
-@value{tramp} ¤Ïʸ»ú@code{>} ¤ò¥×¥í¥ó¥×¥È¤Î½ªÃ¼¤Èǧ¼±¤·¤Þ¤¹¤¬¡¢¤½¤ì¤Ï¥Ð¥Ã¥Õ¥¡
-¤Î½ªÃ¼¤Ë¤Ï¤¢¤ê¤Þ¤»¤ó¡£
-
-@item @var{tramp-shell-prompt-pattern}
-@vindex tramp-shell-prompt-pattern
-
-¤³¤ÎÀµµ¬É½¸½¤Ï @code{shell-prompt-pattern} ¤ÈƱÍͤ˥ê¥â¡¼¥È¥·¥§¥ë¤Î
-¥×¥í¥ó¥×¥È¤Ë¥Þ¥Ã¥Á¤¹¤ë¤â¤Î¤È¤·¤Æ»È¤ï¤ì¤Þ¤¹¡£¤³¤ÎÆó¤ÄÌܤÎÊÑ¿ô¤Ï¥ê¥â¡¼¥È
-¥·¥§¥ë¤Î¥×¥í¥ó¥×¥È¤¬¥í¡¼¥«¥ë¥·¥§¥ë¤È°Û¤Ê¤ë²ÄǽÀ­¤¬¤¢¤ë¤Î¤Ç¸ºß¤·¤Þ¤¹¡£
-¤È¤Ë¤«¤¯ @value{tramp} ¤ÎÍ×ÅÀ¤Ï¥ê¥â¡¼¥È¥Û¥¹¥È¤ËÊ̤Υ桼¥¶¤È¤·¤Æ¥í¥°¥¤¥ó¤¹¤ë
-¤³¤È¤Ç¤¹¡£@code{tramp-shell-prompt-pattern} ¤Î¥Ç¥Õ¥©¥ë¥È¤ÎÃͤÏ
-@code{shell-prompt-pattern} ¤Î¥Ç¥Õ¥©¥ë¥ÈÃͤÈƱ°ì¤Î¤â¤Î¤Ç¤¹¤¬¡¢Â¿¤¯¤Î¾õ¶·
-¤Ç¤½¤ì¤Ï¤¦¤Þ¤¯Æ¯¤¯¤ÈÊó¹ð¤µ¤ì¤Æ¤¤¤Þ¤¹¡£
-
-@item @code{tset} ¤È¤½¤Î¾¤Î¼ÁÌä
-@cindex Unix command tset
-@cindex tset Unix command
-
-¥·¥§¥ë¤Îµ¯Æ°¥¹¥¯¥ê¥×¥È¤«¤é @code{tset} ¥×¥í¥°¥é¥à¤ò¸Æ¤Ó½Ð¤·¡¢
-¥·¥§¥ë¤ÎüËö¤Î¼ïÎà¤ò¿Ò¤Í¤ë¤è¤¦¤Ë¤·¤Æ¤¤¤ë¾ì¹ç¤¬¤¢¤ê¤Þ¤¹¡£¤¿¤Ö¤ó
-¥·¥§¥ë¤Ë¤è¤Ã¤Æ¤Ï¤½¤Î¾¤Î¼ÁÌä¤òµ¯Æ°»þ¤Ë¤·¤Æ¤¯¤ë¾ì¹ç¤â¤¢¤ë¤Ç¤·¤ç¤¦¡£
-@value{tramp} ¤Ï¤³¤ì¤é¤Î¼ÁÌä¤ËÅú¤¨¤ëÊýË¡¤òÃΤê¤Þ¤»¤ó¡£¤³¤ÎÌäÂê¤ò°·¤¦¤Ë¤Ï
-Æó¤Ä¤Î¥¢¥×¥í¡¼¥Á¤¬¤¢¤ê¤Þ¤¹¡£°ì¤Ä¤Î¥¢¥×¥í¡¼¥Á¤Ï¡¢¥·¥§¥ë¤¬ @value{tramp} ¤«¤é
-¸Æ¤Ó½Ð¤µ¤ì¤¿¤È¤­¤Ë²¿¤Î¼ÁÌä¤â¤·¤Ê¤¤¤è¤¦¤Ë¤·¤Æ¤ª¤¯¤³¤È¤Ç¤¹¡£¤½¤Î¤¿¤á¤Ë¤Ï
-´Ä¶­ÊÑ¿ô @code{TERM} ¤òÄ´¤Ù¤Æ²¼¤µ¤¤¡£¤½¤ì¤ÏÀܳ»þ¤Ë @code{dumb} ¤ËÀßÄê
-¤µ¤ì¤Þ¤¹¡£
-
-@vindex tramp-terminal-type
-ÊÑ¿ô @code{tramp-terminal-type} ¤Ë¤è¤ê¤³¤ÎÃͤò @code{dumb} ¤ËÊѹ¹¤¹¤ë
-¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-Ê̤Υ¢¥×¥í¡¼¥Á¤Ï @value{tramp} ¤Ë¤³¤ì¤é¤Î¼ÁÌä¤ò¶µ¤¨¤Æ¤ª¤¯¤³¤È¤Ç¤¹¡£ÊÑ¿ô
-@code{tramp-actions-before-shell} ¤ª¤è¤Ó @code{tramp-multi-actions}
-(¥Þ¥ë¥Á¥Û¥Ã¥×Àܳ¤Î¾ì¹ç) ¤ò»²¾È¤·¤Æ²¼¤µ¤¤¡£
-
-
-@item @file{.profile} Ãæ¤Î´Ä¶­ÊÑ¿ô¤Ç¡¢¥æ¡¼¥¶¤ÈƱ¤¸Ì¾Á°¤Î¤â¤Î¤¿¤Á
-
-frumple ¤È¤¤¤¦Ì¾Á°¤Î¥æ¡¼¥¶¤¬µï¤¿¤È¤·¤Æ¡¢ÊÑ¿ô @code{FRUMPLE} ¤ò¥·¥§¥ë´Ä¶­
-¤ÇÀßÄꤷ¤Æ¤¤¤ë¾ì¹ç¡¢ÉÔ¶ñ¹ç¤¬µ¯¤­¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£
-@code{FRUMPLE_DIR} ¤È¤«¤½¤Î¤è¤¦¤Ê¤â¤Î¤Ë²þ̾¤¹¤ë¤Î¤¬¤è¤¤¤Ç¤·¤ç¤¦¡£
-
-´ñ̯¤Ê¸ú²Ì¤¬¼ÂºÝ¤Ë @value{tramp} ¥æ¡¼¥¶¤«¤éÊó¹ð¤µ¤ì¤Æ¤¤¤Þ¤¹!
-
-
-@item @file{.profile} Ãæ¤Î Non-Bourne ¥³¥Þ¥ó¥É¤¿¤Á
-
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Ë¥í¥°¥¤¥ó¤·¤¿¸å¡¢@value{tramp} ¤Ï¥³¥Þ¥ó¥É @code{exec /bin/sh}
-¤òȯ¹Ô¤·¤Þ¤¹¡£ (¼ÂºÝ¤Ë¤Ï¥³¥Þ¥ó¥É¤Ï¤Á¤ç¤Ã¤È°Û¤Ê¤ê¤Þ¤¹¤¬¡£)
-@code{/bin/sh} ¤¬¼Â¹Ô¤µ¤ì¤ë»þ¤Ë¡¢¤¤¤¯¤Ä¤«¤Î½é´ü²½¥Õ¥¡¥¤¥ë¤¬Æɤ߹þ¤Þ¤ì¤Þ¤¹¡£
-Î㤨¤Ð @file{~/.shrc} ¤ä @file{~/.profile} ¤Ç¤¹¡£
-
-¤³¤³¤Ç¡¢¥í¥°¥¤¥ó¥·¥§¥ë¤¬ @code{/bin/sh} ¤Ç¤Ï¤Ê¤¯¡¢ bash ¤ä ksh ¤È¤¤¤Ã¤¿
-Bourne Ū¤Ê¥·¥§¥ë¤Ç¤¢¤Ã¤¿¾ì¹ç¡¢¿Í¤Ë¤è¤Ã¤Æ¤Ï @code{~/.shrc} ¤ä @code{~/.profile}.
-¤Ë¥·¥§¥ë¤ÎÀßÄê¤ò½ñ¤¤¤Æ¤¤¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤½¤Î¾ì¹ç¤Ë¡¢Bourne ¤Ç¤Ê¤¤¹½À®Êª
-¤¬¤½¤ì¤é¤Î¥Õ¥¡¥¤¥ë¤Ë½ñ¤«¤ì¤Æ¤¤¤ë²ÄǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£¤½¤¦¤¹¤ë¤È¡¢@code{exec /bin/sh}
-¤Ë¤è¤Ã¤Æ Bourne ¥·¥§¥ë¤Ï¤½¤ì¤é¤òÌᤷ¤Æ¤·¤Þ¤¤¤Þ¤¹¡£
-
-Î㤨¤Ð @file{~/.profile} ¥Õ¥¡¥¤¥ë¤Ë @code{export FOO=bar} ¤È½ñ¤¤¤Æ¤¢¤Ã¤¿
-¤È¤¹¤ë¤È¡¢É¸½àŪ¤Ê Bourne ¥·¥§¥ë¤Ï¤³¤Î¹½Ê¸¤òÍý²ò¤Ç¤­¤Ê¤¤¤Î¤Ç¡¢¤³¤Î¹Ô¤Ë
-Åþ㤹¤ë¤È¥·¥ó¥¿¥Ã¥¯¥¹¥¨¥é¡¼¤òÊÖ¤·¤Þ¤¹¡£
-
-Ê̤ÎÎã¤È¤·¤Æ¤Ï¥Á¥ë¥À (@code{~}) ʸ»ú¤¬¤¢¤ê¤Þ¤¹¡£Î㤨¤Ð @code{$PATH} ¤Ë
-@file{~/bin} ¤òÉÕ¤±²Ã¤¨¤ë¾ì¹ç¤Ç¤¹¡£ ¿¤¯¤Î Bourne ¥·¥§¥ë¤Ï¤³¤Îʸ»ú¤òŸ³«
-¤»¤º¡¢ÉáÄ̤Ï̾Á°¤¬¥Á¥ë¥À°ìʸ»ú¤Î¥Ç¥£¥ì¥¯¥È¥ê¤Ï¸ºß¤·¤Ê¤¤¤Î¤Ç¤ª¤«¤·¤Ê¤³¤È
-¤¬µ¯¤³¤ë¤Ç¤·¤ç¤¦¡£
-
-¤³¤ì¤ËÂФ·¤Æ²¿¤ò¤¹¤ì¤Ð¤è¤¤¤Î¤«?
-
-°ì¤Ä¤ÎÊýË¡¤È¤·¤Æ¤ÏÁ´¤Æ¤Î¥ê¥â¡¼¥È¥Û¥¹¥È¾å¤Î @file{~/.shrc} ¤È
-@file{~/.profile} ¤ÎÃæ¤ÎÁ´¤Æ¤¬ Bourne-¸ß´¹¤Ç¤¢¤ë¤è¤¦¤Ë¤¹¤ë¤³¤È¤Ç¤¹¡£
-¾å¤ÎÎã¤Ç¤Ï¡¢@code{export FOO=bar} ¤ÎÂå¤ï¤ê¤Ë @code{FOO=bar; export FOO}
-¤È½ñ¤±¤Ð¤è¤¤¤Ç¤·¤ç¤¦¡£
-
-Ê̤ÎÊýË¡¤È¤·¤Æ¤Ï¡¢non-Bourne ¥·¥§¥ë¤ÎÀßÄê¤òÊ̤Υե¡¥¤¥ë¤Ë½ñ¤¯¤³¤È¤Ç¤¹¡£
-Î㤨¤Ð¡¢bash ¤Ï¥Õ¥¡¥¤¥ë @file{~/.bash_profile} ¤¬¤¢¤ì¤Ð @file{~/.profile}
-¤ÎÂå¤ï¤ê¤Ë¤½¤ì¤òÆɤ߹þ¤ß¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ bash ¥Õ¥¡¥ó¤ÏÁ´¤Æ¤Î¥ê¥â¡¼¥È¥Û¥¹¥È
-¾å¤Î @file{~/.profile} ¤ò @file{~/.bash_profile} ¤Ë²þ̾¤·¤Æ¤ª¤±¤ÐÂç¾æÉפǤ¹¡£
-
-@value{tramp} ¤Î³«È¯¼Ô¤Ï¤³¤ÎÌäÂê¤ò²óÈò¤·¤¿¤¤¤È¹Í¤¨¤Æ¤¤¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ¤³¤ì¤Ë
-´Ø¤¹¤ë¥¢¥¤¥Ç¥¢¤¬¤¢¤ì¤Ð¤¼¤Ò¶µ¤¨¤Æ²¼¤µ¤¤¡£¤·¤«¤·¤Ê¤¬¤é¡¢¤³¤ì¤Ï¤½¤¦Ã±½ã¤Ç¤Ï
-¤Ê¤¤¤È¹Í¤¨¤Æ¤¤¤Þ¤¹: @code{exec /bin/sh} ¤È¸Æ¤ÖÁ°¤Ë¤Ï¡¢@value{tramp} ¤Ï¤É¤Î
-¼ïÎà¤Î¥·¥§¥ë¤ÈÂÐÏ䷤Ƥ¤¤ë¤Î¤«ÃΤé¤Ê¤¤¤Î¤Ç¤¹¡£¤½¤ì¤Ï ksh ¤ä bash ¤È¤¤¤Ã¤¿
-Bourne Ū¤Ê¥·¥§¥ë¤Ç¤¢¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¤·¡¢csh ¤«¤éÇÉÀ¸¤·¤¿ tcsh ¤Î¤è¤¦¤Ê
-¤â¤Î¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤â¤·¤¯¤Ï zsh ¤ä¡¢¤Ï¤¿¤Þ¤¿ rc ¤Ç¤¢¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£
-¤â¤·¥·¥§¥ë¤¬¤¹¤Ç¤Ë Bourne Ū¤Ê¤â¤Î¤Ç¤¢¤ë¤Ê¤é @code{exec /bin/sh} ¤ÎÃʳ¬¤ò
-¾Êά¤¹¤ë¤Î¤¬·üÌ¿¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤·¤«¤·¡¢¤É¤¦¤ä¤Ã¤Æ¥·¥§¥ë¤¬ Bourne Ū¤À¤È
-ÃΤë¤Î¤Ç¤·¤ç¤¦¤«?
-
-@end table
-
-
-@node Auto-save and Backup
-@section Auto-save ¤È¥Ð¥Ã¥¯¥¢¥Ã¥×¤ÎÀßÄê
-@cindex auto-save
-@cindex backup
-@vindex backup-directory-alist
-
-auto-save ¤ÎÀâÌÀ¤Ï̤´°À®¤Ç¤¹¡£
-
-Ä̾ï Emacs ¤Ï¥ª¥ê¥¸¥Ê¥ë¤Î¥Õ¥¡¥¤¥ë¤ÈƱ¤¸¥Ç¥£¥ì¥¯¥È¥ê¤Ë¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡
-¥¤¥ë¤òÊݸ¤·¤Þ¤¹¤¬¡¢¤³¤ÎµóÆ°¤ÏÊÑ¿ô @code{backup-directory-alist} ¤òÄÌ
-¤·¤ÆÊѹ¹¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£@value{tramp} ¤òÍѤ¤¤¿Àܳ¤Ë¤ª¤¤¤Æ¤³¤Î¤³¤È¤Ïͽ
-´ü¤·¤Ê¤¤ÉûºîÍѤò¤â¤¿¤é¤¹²ÄǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£Î㤨¤ÐÁ´¤Æ¤Î¥Ð¥Ã¥¯¥¢¥Ã¥×¤¬¥Ç
-¥£¥ì¥¯¥È¥ê @file{~/.emacs.d/backups/} ¤Ë¹Ô¤¯¤è¤¦¤Ë¤Ê¤Ã¤Æ¤¤¤¿¤È¤·¤Æ¡¢¥Õ
-¥¡¥¤¥ë @file{/su:root@@localhost:/etc/secretfile} ¤òÊÔ½¸¤·¤¿¤È¤·¤Þ¤·¤ç
-¤¦¡£¤½¤Î·ë²Ì¤Ï¡¢¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡¥¤¥ë¤Ï root ¤Ç¤Ï¤Ê¤¯¤¢¤Ê¤¿¤Î½êÍ­¤È¤Ê¤ê¡¢
-¤·¤¿¤¬¤Ã¤Æ¤¿¤È¤¨¤½¤Î¤Ä¤â¤ê¤¬¤Ê¤«¤Ã¤¿¤È¤·¤Æ¤â¤½¤ì¤¬Â¾¼Ô¤«¤é¸«¤Æ¤·¤Þ¤¦²Ä
-ǽÀ­¤¬¤¢¤ê¤Þ¤¹¡£
-
-@code{backup-directory-alist} ¤¬ nil (¥Ç¥Õ¥©¥ë¥È) ¤Ç¤¢¤ì¤Ð¤½¤Î¤è¤¦¤ÊÌä
-Âê¤Ï¤ª¤³¤ê¤Þ¤»¤ó¡£
-
-¤â¤·¤¢¤Ê¤¿¤¬¤½¤ÎÊÑ¿ô¤ò¥«¥¹¥¿¥Þ¥¤¥º¤·¤¿¤¤¤Ê¤é¡¢@value{tramp} ¤Î¥Õ¥¡¥¤¥ë¤ËÂÐ
-¤·¤ÆÆÃÊ̤ÊÀßÄê¤ò¹Ô¤Ê¤¦¤È¤¤¤¦²óÈòË¡¤¬¤¢¤ê¤Þ¤¹¡£Î㤨¤Ð°Ê²¼¤Îµ­½Ò¤Ë¤è¤ê¡¢
-@value{tramp} ¤Î¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ¸ú²ÌŪ¤Ë @code{backup-directory-alist} ¤Î¸ú
-²Ì¤ò¾Ã¤·¤Þ¤¹:
-
-@lisp
-(require 'tramp)
-(add-to-list 'backup-directory-alist
-             (cons tramp-file-name-regexp nil))
-@end lisp
-
-
-@node Windows setup hints
-@section Cygwin ssh ¤Ë¤Þ¤Ä¤ï¤ë»öÊÁ
-@cindex Cygwin, issues
-
-¤³¤ÎÀá¤Ï¤¿¤¯¤µ¤ó¤Î»Å»ö¤¬É¬ÍפǤ¹! ¤É¤¦¤«¼êÅÁ¤Ã¤Æ²¼¤µ¤¤¡£
-
-@cindex method sshx with Cygwin
-@cindex sshx method with Cygwin
-¤â¤·¤¢¤Ê¤¿¤¬ Cygwin ¤Ç¥¤¥ó¥¹¥È¡¼¥ë¤·¤¿ ssh (¥¤¥ó¥¹¥È¡¼¥é¤ÇÌÀ¼¨Åª¤ËÁªÂò
-¤¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹) ¤ò»È¤Ã¤Æ¤¤¤ë¤Ê¤é¡¢Àܳ¥á¥½¥Ã¥É¤È¤·¤Æ @code{sshx} ¤ò
-ÁªÂò¤¹¤ë¤À¤±¤Ç¥Þ¥·¥ó¤Î³°¤Ë½Ð¤é¤ì¤ë¤Ï¤º¤Ç¤¹¡£Cygwin ¤Î¥»¥Ã¥È¥¢¥Ã¥×¤Ë
-¤Ä¤¤¤Æ¤Î¾ðÊó¤Ï @uref{http://cygwin.com/faq/} ¤Ë¤¢¤ëÈà¤é¤Î FAQ ¤ÇÆÀ¤ë
-¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-@cindex method scpx with Cygwin
-@cindex scpx method with Cygwin
-¤â¤· @code{scpx} Àܳ¥á¥½¥Ã¥É¤ò»È¤¤¤¿¤¤¤È»×¤Ã¤¿¤Ê¤é¡¢Emacs ¤¬ @code{c:/foo}
-¤Î¤è¤¦¤Ê Windows ¥Õ¥¡¥¤¥ë̾¤òȼ¤Ê¤Ã¤Æ @code{scp} ¤ò¸Æ¤Ö»þ¤ËÌäÂ꤬µ¯¤­¤ë
-¤«¤â¤·¤ì¤Þ¤»¤ó¡£Cygwin ÈǤΠ@code{scp} ¤Ï Windows ¥Õ¥¡¥¤¥ë̾¤Ë¤Ä¤¤¤ÆÃΤé
-¤Ê¤¤¤Î¤Ç¡¢¤½¤ì¤ò¥Û¥¹¥È @code{c} ¾å¤Î¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë̾¤È²ò¼á¤·¤Æ¤·¤Þ¤¤¤Þ¤¹¡£
-
-°ì¤Ä¤Î²Äǽ¤Ê²óÈòË¡¤È¤·¤Æ¤Ï¡¢Windows ¥Õ¥¡¥¤¥ë̾¤ò Cygwin ¤Î¥Õ¥¡¥¤¥ë̾¤Ë
-ÊÑ´¹¤¹¤ë¥é¥Ã¥Ñ¡¼¥¹¥¯¥ê¥×¥È¤ò½ñ¤¯¤³¤È¤Ç¤¹¡£
-
-Ê̤βóÈòË¡¤È¤·¤Æ¤Ï Emacs ¤ò Cygwin ¾å¤ÇÆ°¤«¤¹¤«¡¢¤â¤·¤¯¤Ï Cygwin ÈǤÎ
-Emacs ¤ò»È¤¦¤³¤È¤¬¤¢¤ë¤È»×¤¤¤Þ¤¹¡£
-
-@cindex Cygwin and ssh-agent
-@cindex SSH_AUTH_SOCK and Emacs on Windows
-²¿¤é¤«¤Î @code{ssh} ¤Ë´ð¤Å¤¯¥á¥½¥Ã¥É¤ò Windows ¾å¤Ç»È¤¤¤¿¤¤¾ì¹ç¡¢
-@code{ssh-agent} ¤Ë´Ø¤¹¤ëÌäÂê¤ËÁø¶ø¤¹¤ë¤«¤â¤·¤ì¤Þ¤»¤ó¡£¤³¤Î¥×¥í¥°¥é¥à
-¤ò»È¤¦¤È¡¢¥í¥°¥¤¥ó¤ÎºÝ¤ËËè²ó¥Ñ¥¹¥Õ¥ì¡¼¥º¤òÆþÎϤ¹¤ë¤³¤È¤òÈò¤±¤ë¤³¤È¤¬
-¤Ç¤­¤Þ¤¹ (¤Þ¤¿¡¢@code{scpx} ¥á¥½¥Ã¥É¤Ï @code{ssh-agent} ¤ò»È¤¦¤³¤È¤ò
-Í׵ᤷ¤Þ¤¹¡£¤Ê¤¼¤Ê¤é¤½¤ì¤Ï¥Ñ¥¹¥ï¡¼¥É¤ä¥Ñ¥¹¥Õ¥ì¡¼¥º¤òÆþÎϤµ¤»¤Æ¤¯¤ì¤Ê¤¤
-¤«¤é¤Ç¤¹)¡£¤·¤«¤·¤Ê¤¬¤é¡¢Emacs ¤ò¥Ç¥¹¥¯¥È¥Ã¥×¥·¥ç¡¼¥È¥«¥Ã¥È¤«¤éµ¯Æ°¤·¤¿
-¤Ê¤é¡¢´Ä¶­ÊÑ¿ô @code{SSH_AUTH_SOCK} ¤ÏÀßÄꤵ¤ì¤Ê¤¤¤Î¤Ç¡¢ Emacs ¤½¤·¤Æ
-@value{tramp}¡¢ ¤½¤·¤Æ @value{tramp} ¤«¤éµ¯Æ°¤µ¤ì¤ë @code{ssh} ¤ª¤è¤Ó @code{scp} 
-¤Ï @code{ssh-agent} ¤ÈÄÌ¿®¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤»¤ó¡£Emacs ¤ò¥·¥§¥ë¤«¤éµ¯Æ°
-¤¹¤ì¤Ð¤¦¤Þ¤¯Æ°¤­¤Þ¤¹¡£
-
-¤â¤·Ã¯¤« Windows ¾å¤Ç¥Ç¥¹¥¯¥È¥Ã¥×¥·¥ç¡¼¥È¥«¥Ã¥È¤¬²¸·Ã¤ò¼õ¤±¤é¤ì¤ë¤è¤¦¤Ê¡¢
-@code{ssh-agent} ¤Îµ¯Æ°ÊýË¡¤òÃΤäƤ¤¤¿¤é¶«¤ó¤Ç²¼¤µ¤¤¡£»ä¤ÏËÜÅö¤Ë Windows
-¤Ë¤Ä¤¤¤Æ¤Ï²¿¤âÃΤé¤Ê¤¤¤Î¤Ç¤¹@dots{}
-
-
-@node Usage
-@chapter @value{tramp} ¤Î»È¤¤Êý
-@cindex using @value{tramp}
-
-@value{tramp} ¤ò¥¤¥ó¥¹¥È¡¼¥ë¤¹¤ë¤È¡¢@value{tramp} ¤Ï´°Á´¤ËÆ©²áŪ¤ËÆ°ºî¤·¤Þ¤¹¡£
-¥í¥°¥¤¥ó²Äǽ¤Ê¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥Õ¥¡¥¤¥ë¤Ë¡¢¤¢¤¿¤«¤â¥í¡¼¥«¥ë¥Õ¥¡¥¤¥ë
-¤Î¤è¤¦¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-@value{tramp} ¤Ç¤Ï¡¢formalized ¥·¥ó¥¿¥Ã¥¯¥¹¤ò»È¤¤¥Õ¥¡¥¤¥ë¤ò»ØÄꤷ¤Þ¤¹¡£¤³¤ì¤Ï¡¢
-@value{ftppackagename} ¥Ñ¥Ã¥±¡¼¥¸¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤Ë»÷¤Æ¤¤¤Þ¤¹¡£
-
-@cindex type-ahead
-¤¢¤Ê¤¿¤ò¶Ã¤«¤»¤ë¤³¤È¤¬µ¯¤³¤êÆÀ¤Þ¤¹¡£ Emacs ¤ÏÁ´¤Æ¤Î¥­¡¼ÆþÎϤò²±¤¨¤Æ¤¤¤Þ¤¹¡£
-¤·¤¿¤¬¤Ã¤Æ Emacs ¤«¤é¤Î¥Ñ¥¹¥ï¡¼¥É¥×¥í¥ó¥×¥È¤òÌܤˤ·¤Æ @kbd{@key{RET}}
-¤ò°ì²ó¤Ç¤Ê¤¯Æó²óᤤ¤¿¾ì¹ç¡¢Æó²óÌܤΥ­¡¼ÆþÎÏ¤Ï @value{tramp} ¤¬Æ°ºî¤·¤¿¸å¤Ç
-Emacs ¤Ç½èÍý¤µ¤ì¤Þ¤¹¡£²¿¸Î¤³¤ÎÀè¹ÔÆþÎϤ¬Ä̾ï¤ÎµóÆ°¤«¤È»×¤¦¤Ç¤·¤ç¤¦¡£
-¤¢¤Ê¤¿¤ÏÀµ¤·¤¤¡¢¤·¤«¤·¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤ò³«¤¯¤Ë¤Ï¤·¤Ð¤é¤¯¤Î»þ´Ö¤¬¤«¤«¤ê¡¢
-Àܳ¤¬³«¤«¤ì¤ë¤Þ¤Ç¤Ë30É䫤«¤ë¤«¤â¤·¤ì¤Ê¤¤¤È¤¤¤¦¤³¤È¤Ëµ¤ÉÕ¤¤¤Æ²¼¤µ¤¤¡£
-¤ª¤½¤é¤¯30Éøå¤Ë¤Ï¤½¤Î¥­¡¼¤òᤤ¤¿¤³¤È¤ò¤¹¤Ç¤Ë˺¤ì¤Æ¤¤¤ë¤Ç¤·¤ç¤¦!
-
-@menu
-* Filename Syntax::             @value{tramp} ¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê
-* Multi-hop filename syntax::   ¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê
-* Filename completion::         ¥Õ¥¡¥¤¥ë̾Êä´°
-* Dired::                       Dired
-@end menu
-
-
-@node Filename Syntax
-@section @value{tramp} ¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê
-@cindex filename syntax
-@cindex filename examples
-
-¥ê¥â¡¼¥È¥Þ¥·¥ó @var{machine} ¾å¤Î¥Õ¥¡¥¤¥ë @var{localname} ¤Ë¥¢¥¯¥»¥¹¤¹
-¤ë¤¿¤á¤Ë¤Ï¡¢¥Õ¥¡¥¤¥ë̾
-@file{@value{prefix}@var{machine}@value{postfix}@var{localname}}.
-¤ò»ØÄꤷ¤Æ¤¯¤À¤µ¤¤¡£¤³¤ì¤Ç¡¢ @var{machine} ¤ËÀܳ¤·¡¢¥Ç¥Õ¥©¥ë¥È¥á¥½¥Ã¥É
-¤ò»ÈÍѤ·¤Æ¥Õ¥¡¥¤¥ë¤¬Å¾Á÷¤µ¤ì¤Þ¤¹¡£@xref{Default Method}.
-
-@value{tramp} ¤Î¥Õ¥¡¥¤¥ë̾¤ÎÎã¤ò°Ê²¼¤Ëµó¤²¤Þ¤¹¡£
-
-@table @file
-@item @value{prefix}melancholia@value{postfix}.emacs
-¥Þ¥·¥ó @code{melancholia} ¾å¤Î¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤Ë¤¢¤ë @file{.emacs}¤ò
-ÊÔ½¸¤·¤Þ¤¹¡£
-
-@item @value{prefix}melancholia.danann.net@value{postfix}.emacs
-´°Á´¤Ê¥Û¥¹¥È̾(FQDN)¤ò»È¤¤¡¢¾å¤ÈƱ¤¸¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤·¤Þ¤¹¡£
-
-@item @value{prefix}melancholia@value{postfix}~/.emacs
-¤³¤ì¤â¤Þ¤¿Æ±¤¸¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤·¤Þ¤¹¡£@file{~} ¤Ï¡¢¥í¡¼¥«¥ë¤Î¾ì¹ç¤È
-ƱÍͤˡ¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤ËŸ³«¤µ¤ì¤Þ¤¹¡£
-
-@item @value{prefix}melancholia@value{postfix}~daniel/.emacs
-¥Þ¥·¥ó @code{melancholia} ¾å¤Î¥æ¡¼¥¶¡¼ @code{daniel} ¤Î¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê
-¤Ë¤¢¤ë¥Õ¥¡¥¤¥ë @file{.emacs} ¤òÊÔ½¸¤·¤Þ¤¹¡£@file{~<¥æ¡¼¥¶¡¼>} ¹½Ê¸¤Ï
-¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥æ¡¼¥¶¡¼¤Î¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤ËŸ³«¤µ¤ì¤Þ¤¹¡£
-
-@item @value{prefix}melancholia@value{postfix}/etc/squid.conf
-¥Þ¥·¥ó @code{melancholia} ¾å¤Î¥Õ¥¡¥¤¥ë @file{/etc/squid.conf} ¤òÊÔ½¸
-¤·¤Þ¤¹¡£
-
-@end table
-
-°ã¤¦Ì¾Á°¤ò»È¤¦¤è¤¦¤Ë»ØÄꤷ¤Ê¤¤¸Â¤ê¡¢@value{tramp} ¤Ï¸½ºß¤Î¥í¡¼¥«¥ë¤Ê¥æ¡¼¥¶Ì¾
-¤ò¥í¥°¥¤¥ó¤Î¤¿¤á¤Î¥ê¥â¡¼¥È¥æ¡¼¥¶¡¼Ì¾¤È¤·¤Æ»È¤¤¤Þ¤¹¡£¤â¤·¡¢°ã¤¦¥æ¡¼¥¶¡¼¤Ç
-¥í¥°¥¤¥ó¤¹¤ëɬÍפ¬¤¢¤ë¾ì¹ç¤Ï¡¢¥Õ¥¡¥¤¥ë̾¤Î°ìÉô¤È¤·¤Æ¥æ¡¼¥¶¡¼Ì¾¤ò»ØÄꤹ¤ë
-¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-»ØÄꤷ¤¿¥æ¡¼¥¶¡¼¤Ç¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë¥í¥°¥¤¥ó¤¹¤ëɬÍפ¬¤¢¤ë¾ì¹ç¡¢
-@file{@value{prefix}@var{user}@@@var{machine}@value{postfix}/@var{path/to.file}}
-¤È¤¤¤¦¥·¥ó¥¿¥Ã¥¯¥¹¤ò»ÈÍѤ·¤Æ¤¯¤À¤µ¤¤¡£¤Ä¤Þ¤ê¡¢ @code{melancholia} ¤Ë¥æ¡¼¥¶¡¼
-@code{daniel} ¤È¤·¤ÆÀܳ¤·¤Æ¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤Î @file{.emacs} ¤òÊÔ½¸
-¤¹¤ë¾ì¹ç¡¢@file{@value{prefix}daniel@@melancholia@value{postfix}.emacs}
-¤ò»ØÄꤹ¤ì¤Ð¤è¤¤¤Î¤Ç¤¹¡£
-
-¥Õ¥¡¥¤¥ë̾¤Î°ìÉô¤È¤·¤Æ¡¢Â¾¤Î¥Õ¥¡¥¤¥ëžÁ÷¥á¥½¥Ã¥É(@pxref{Default Method})
-¤ò»ØÄꤹ¤ë¤³¤È¤â¤Ç¤­¤Þ¤¹¡£
-@ifset emacs
-¤½¤¦¤¹¤ë¤Ë¤Ï°Ê²¼¤Î¤è¤¦¤Ë¤·¤Æ¡¢¥æ¡¼¥¶Ì¾¡¢¥Û¥¹¥È̾¤è¤êÁ°¤Ë¥á¥½¥Ã¥É¤ò½ñ¤­¤Þ¤¹¡£
-@file{@value{prefix}@var{method}@value{postfixsinglehop}}
-(ËöÈø¤Î¥³¥í¥ó¤ËÃí°Õ)¡£
-@end ifset
-@ifset xemacs
-¤½¤¦¤¹¤ë¤Ë¤ÏºÇ½é¤Î @file{@value{prefix}} ¤ò
-@file{@value{prefix}@value{postfixsinglehop}}
-¤ÇÃÖ¤­´¹¤¨¤Þ¤¹¡£(ËöÈø¤Î¥¹¥é¥Ã¥·¥å¤ËÃí°Õ!)
-@end ifset
-¥æ¡¼¥¶¡¼¡¢¥Þ¥·¥ó¡¢¥Õ¥¡¥¤¥ë¤Î»ØÄê¤Ïº£¤Þ¤Ç¤ÈƱ¤¸¤Ç¤¹¡£
-
-¥Þ¥·¥ó @code{melancholia} ¤Ë @code{daniel} ¤È¤·¤ÆÀܳ¤·¡¢¥Õ¥¡¥¤¥ëžÁ÷¤Ë
-@option{ssh} ¥á¥½¥Ã¥É¤ò»È¤¤¡¢¥Û¡¼¥à¥Ç¥£¥ì¥¯¥È¥ê¤Î @file{.emacs} ¤òÊÔ½¸¤¹¤ë
-¤¿¤á¤Ë¤Ï¡¢¥Õ¥¡¥¤¥ë̾
-@file{@value{prefix}ssh@value{postfixsinglehop}daniel@@melancholia@value{postfix}.emacs}
-¤ò»ØÄꤷ¤Þ¤¹¡£
-
-
-@node Multi-hop filename syntax
-@section ¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤Î¤­¤Þ¤ê
-@cindex filename syntax for multi-hop files
-@cindex multi-hop filename syntax
-
-¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤Ï¡¢ÅöÁ³¤Î¤³¤È¤Ê¤¬¤é¡¢Â¾¤Î @value{tramp} 
-¤Î¥Õ¥¡¥¤¥ë̾¤È¼ã´³°Û¤Ê¤ê¤Þ¤¹¡£°Ê²¼¤Ë¡¢¥Þ¥ë¥Á¥Û¥Ã¥×¥Õ¥¡¥¤¥ë̾¤ÎÎã¤ò
-¤¢¤²¤Þ¤¹¡£ºÇ½é¤¬ Emacs ¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤Ç¼¡¤¬ XEmacs ¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤Ë¤è
-¤ë¤â¤Î¤Ç¤¹:
-
-@example
-@value{prefix}multi@value{postfixsinglehop}rsh@value{postfixmultihop}out@@gate@value{postfixsinglehop}telnet@value{postfixmultihop}kai@@real.host@value{postfix}/path/to.file
-@end example
-
-¤³¤ì¤ÏÈó¾ï¤Ë½ÅÍפʤΤǡ¢¤Ò¤È¤Ä¤Ò¤È¤ÄÀâÌÀ¤·¤Þ¤·¤ç¤¦¡£¥Õ¥¡¥¤¥ë̾¤Ï
-3¤Ä¤ÎÉôʬ¤«¤éÀ®¤ê¡¢
-@ifset emacs
-³ÆÉô¤Ï¥³¥í¥ó¤Ç¶èÀÚ¤é¤ì¤Þ¤¹¡£
-@end ifset
-@ifset xemacs
-³ÆÉô¤Ï¥¹¥é¥Ã¥·¥å¤È³Ñ³ç¸Ì¤Ç¶èÀÚ¤é¤ì¤Þ¤¹¡£
-@end ifset
-ºÇ½é¤Î¥Ñ¡¼¥È @file{@value{prefix}multi} ¤Ï¥á¥½¥Ã¥É¤Î»ØÄê¤Ç¤¹¡£
-ÆóÈÖÌܤΥѡ¼¥È¤Ï
-@file{rsh@value{postfixmultihop}out@@gate@value{postfixsinglehop}telnet@value{postfixmultihop}kai@@real.host}
-¤Ç¥Û¥Ã¥×¤ò»ØÄꤷ¤Þ¤¹¡£ºÇ¸å¤Î¥Ñ¡¼¥È¤Ï @file{/path/to.file} ¤Ç¡¢¥ê¥â¡¼¥È
-¥Û¥¹¥È¾å¤Î¥Õ¥¡¥¤¥ë̾¤ò»ØÄꤷ¤Þ¤¹¡£
-
-ºÇ½é¤ÈºÇ¸å¤Î¥Ñ¡¼¥È¤ÏÌÀÇò¤Ç¤·¤ç¤¦¡£@ref{Multi-hop Methods}¤Ë»ØÄê²Äǽ
-¤Ê¥á¥½¥Ã¥É¤Î°ìÍ÷¤¬¤¢¤ê¤Þ¤¹¡£
-
-ÆóÈÖÌܤΥѡ¼¥È¤Ï¡¢ºÆ¤Ó¥³¥ó¥Ý¡¼¥Í¥ó¥È¤Ë¡¢¤Ä¤Þ¤ê¥Û¥Ã¥×¤¿¤Á(hops) ¤Ëʬ³ä
-¤µ¤ì¤ë¤³¤È¤¬¤¢¤ê¤Þ¤¹¡£¾åµ­¤Î¥Õ¥¡¥¤¥ë̾¤Ë¤Ï¡¢Æó¤Ä¤Î¥Û¥Ã¥×¤¿¤Á¡¢
-@file{rsh@value{postfixmultihop}out@@gate} ¤ª¤è¤Ó
-@file{telnet@value{postfixmultihop}kai@@real.host}
-¤¬´Þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£
-
-¤½¤ì¤¾¤ì¤Î¥Û¥Ã¥×¤Ï¡¢@emph{ºÆ¤Ó}(3¤Ä¤Î)¥³¥ó¥Ý¡¼¥Í¥ó¥È¡¢
-@dfn{¥Û¥Ã¥×¥á¥½¥Ã¥É}¡¢@dfn{¥æ¡¼¥¶¡¼Ì¾}¡¢@dfn{¥Û¥¹¥È̾}¤Ëʬ³ä¤µ¤ì¤ë¤³¤È¤¬
-¤¢¤ê¤Þ¤Þ¤¹¡£ÆóÈÖÌÜ¡¢»°ÈÖÌܤΥ³¥ó¥Ý¡¼¥Í¥ó¥È¤Î°ÕÌ£¤ÏÌÀÇò¤Ç¤¹¡£¥Û¥Ã¥×¥á¥½¥Ã¥É¤Ï¡¢
-¤³¤Î¥Û¥Ã¥×¤Ç¤É¤Î¤è¤¦¤Ê¥×¥í¥°¥é¥à¤ò»È¤¦¤«¤ò°ÕÌ£¤·¤Æ¤¤¤Þ¤¹¡£
-
-ºÇ½é¤Î¥Û¥Ã¥× @file{rsh@value{postfixmultihop}out@@gate} ¤Ï¡¢
-¥Û¥¹¥È @code{gate} ¤Ë¥æ¡¼¥¶¡¼ @code{out} ¤È¤·¤Æ¥í¥°¥¤¥ó¤¹¤ë¤¿¤á¤Ë
-@command{rsh} ¤ò»È¤¦¤È¤¤¤¦°ÕÌ£¤Ç¤¹¡£ÆóÈÖÌܤΥۥå×
- @file{telnet@value{postfixmultihop}kai@@real.host}@file{telnet@value{postfixmultihop}kai@@real.host}
-¤Ï¡¢¤³¤Î¥Û¥¹¥È¤«¤é¥Û¥¹¥È @code{real.host} ¤Ë¥æ¡¼¥¶¡¼ @code{kai}¤Ç¥í¥°
-¥¤¥ó¤¹¤ë¤¿¤á¤Ë @command{telnet} ¤ò»È¤¦¤È¤¤¤¦°ÕÌ£¤Ç¤¹¡£
-
-@xref{Multi-hop Methods}. ¤³¤³¤Ë¥Û¥Ã¥×¥á¥½¥Ã¥É¤Î°ìÍ÷¤¬¤¢¤ê¤Þ¤¹¡£
-ÊÑ¿ô @code{tramp-multi-connection-function-alist} ¤Ë¤Ï¡¢ÁªÂò²Äǽ¤Ê¥Û¥Ã¥×
-¥á¥½¥Ã¥É¤Î¥ê¥¹¥È¤È¤½¤ì¤é¤ò¤É¤Î¤è¤¦¤Ë¼Â¹Ô¤¹¤ë¤«¤È¤¤¤¦¾ðÊ󤬴ޤޤì¤Æ¤¤¤Þ¤¹¡£
-¤¢¤Ê¤¿¤¬ºî¤Ã¤¿¥á¥½¥Ã¥É¤ò¤³¤ÎÊÑ¿ô¤ËÄɲ䷤Ƥ¯¤À¤µ¤¤¡£
-
-
-@node Filename completion
-@section ¥Õ¥¡¥¤¥ë̾Êä´°
-@cindex filename completion
-
-@value{tramp} ¤Î¥Õ¥¡¥¤¥ë̾Êä´°¤Ï¥ê¥â¡¼¥È¥Þ¥·¥ó¤Î¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤Ë²Ã¤¨¤Æ
-¥á¥½¥Ã¥É¡¢¥æ¡¼¥¶Ì¾¤ª¤è¤Ó¥Þ¥·¥ó̾(¥Þ¥ë¥Á¥Û¥Ã¥×¥á¥½¥Ã¥É¤¿¤Á¤Ï½ü¤¯)¤Ë
-ÂФ·¤ÆƯ¤­¤Þ¤¹¡£
-
-Î㤨¤Ð @kbd{C-x C-f @value{prefix}t@key{TAB}} ¤ÈÆþÎϤ¹¤ë¤È
-@value{tramp} ¤Ï°Ê²¼¤ÎÁªÂò»è¤òÊÖ¤·¤Þ¤¹¡£
-
-@example
-@ifset emacs
-@value{prefixsinglehop}telnet@value{postfixsinglehop}				   tmp/
-@value{prefixsinglehop}toto@value{postfix}
-@end ifset
-@ifset xemacs
-@value{prefixsinglehop}telnet@value{postfixsinglehop}				   @value{prefixsinglehop}toto@value{postfix}
-@end ifset
-@end example
-
-@samp{@value{prefixsinglehop}telnet@value{postfixsinglehop}}
-¤Ï¥á¥½¥Ã¥É¤ÎÊä´°¤Ç¤¢¤ê¡¢
-@ifset emacs
-@samp{tmp/} ¤Ï¥í¡¼¥«¥ë¥Þ¥·¥ó¾å¤Î¥Ç¥£¥ì¥¯¥È¥ê @file{/tmp} ¤Ç¤¢¤ê¡¢
-@end ifset
-@samp{@value{prefixsinglehop}toto@value{postfix}}
-¤Ï @value{tramp} ¤¬¥Õ¥¡¥¤¥ë @file{~/.ssh/known_hosts} ¤«¤é¸¡½Ð¤·¤¿¥Û¥¹¥È̾
-¤Ç¤¹(¥Ç¥Õ¥©¥ë¥È¥á¥½¥Ã¥É @option{ssh} ¤ò»È¤Ã¤Æ¤¤¤ë¾ì¹ç)¡£
-
-³¤±¤Æ @kbd{e @key{TAB}} ¤È¤¹¤ì¤Ð¡¢¥ß¥Ë¥Ð¥Ã¥Õ¥¡¤Ï
-@samp{@value{prefix}telnet@value{postfixsinglehop}}
-¤ÈÊä´°¤µ¤ì¤Þ¤¹¡£¼¡¤Î @kbd{@key{TAB}} ¤Ç¤Ï @value{tramp} ¤¬¥Õ¥¡¥¤¥ë @file{/etc/hosts}
-¤«¤é¸¡½Ð¤·¤¿Á´¤Æ¤Î¥Þ¥·¥ó̾¤òµó¤²¤Þ¤¹¡£Î㤨¤Ð¡¢
-
-@example
-@value{prefixsinglehop}telnet@value{postfixsinglehop}127.0.0.1@value{postfix}		   @value{prefixsinglehop}telnet@value{postfixsinglehop}192.168.0.1@value{postfix}
-@value{prefixsinglehop}telnet@value{postfixsinglehop}localhost@value{postfix}		   @value{prefixsinglehop}telnet@value{postfixsinglehop}melancholia.danann.net@value{postfix}
-@value{prefixsinglehop}telnet@value{postfixsinglehop}melancholia@value{postfix}
-@end example
-
-¤³¤³¤Ç´õ˾¤Î¥Þ¥·¥ó¤òÁªÂò¤¹¤ë¤³¤È¤¬¤Ç¤­¡¢Â³¤±¤Æ¤½¤Î¥Þ¥·¥ó¾å¤Î¥Õ¥¡¥¤¥ë̾
-¤òÊä´°¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£
-
-¥Õ¥¡¥¤¥ë̾Êä´°¤Ï¥ê¥â¡¼¥È¥Þ¥·¥ó¤«¤é¥Õ¥¡¥¤¥ë¥ê¥¹¥È¤ò¼è¤ê´ó¤»¤ëɬÍפ¬
-¤¢¤ë¤¿¤á¤Ë¡¢¤·¤Ð¤·¤Ð¤È¤Æ¤âÃÙ¤¯¤Ê¤ê¤Þ¤¹¡£º£¤Î½ê @value{tramp} ¤Ï¥Ç¥£¥ì¥¯¥È¥ê
-¥ê¥¹¥È¤ò¥­¥ã¥Ã¥·¥å¤·¤Ê¤¤¤Î¤ÇÆó²óÌܤΥե¡¥¤¥ë̾Êä´°¤Ç¤â¥Ñ¥Õ¥©¡¼¥Þ¥ó¥¹
-¾å¤Î°ã¤¤¤Ï¸½¤ì¤Þ¤»¤ó¡£
-
-@value{tramp} ¤¬Êä´°¤Î²òÀϤËÍѤ¤¤ëÀßÄê¥Õ¥¡¥¤¥ë (@pxref{Customizing Completion})
-¤¬¥æ¡¼¥¶Ì¾¤òÄ󶡤·¤¿¾ì¹ç¡¢¤½¤ì¤é¤Î¥æ¡¼¥¶Ì¾¤â¹Í褵¤ì¤Þ¤¹¡£
-
-
-@node Dired
-@section Dired
-@cindex dired
-
-@value{tramp} ¤Ï dired ¾å¤Ç¤âÆ©²áŪ¤ËÆ°ºî¤·¤Þ¤¹¡£¤³¤Î¶¯ÎϤʥե¡¥¤¥ë´ÉÍý
-¥Ä¡¼¥ë¤ò»È¤¤¡¢¥¤¥ó¥¿¡¼¥Í¥Ã¥È¤ò·Ðͳ¤·¥¢¥¯¥»¥¹²Äǽ¤Ê¤¹¤Ù¤Æ¤Î¥Þ¥·¥ó¾å¤Î
-¥Õ¥¡¥¤¥ë¤ò´ÉÍý¤Ç¤­¤Þ¤¹¡£
-
-¥Ç¥£¥ì¥¯¥È¥ê¥Ä¥ê¡¼¤ò¥Ö¥é¥¦¥º¤·¤¿¤¤¾ì¹ç¤Ï¡¢º£¤Î¤È¤³¤í¥Õ¥¡¥¤¥ë̾¤ÎÊä´°
-¤è¤ê dired ¤ò»È¤¦¤Û¤¦¤¬Îɤ¤¤Ç¤·¤ç¤¦¡£dired ¤Ï¼«¿È¤Ç¥­¥ã¥Ã¥·¥å¤Î»ÅÁȤß
-¤ò¤â¤Ã¤Æ¤¤¤ë¤Î¤Ç¡¢¥Õ¥¡¥¤¥ë°ìÍ÷¤ò°ìÅÙ¤·¤«¼èÆÀ¤·¤Þ¤»¤ó¡£
-
-
-@node Bug Reports
-@chapter ¥Ð¥°¤äÌäÂê¤ÎÊó¹ð
-@cindex bug reports
-
-@value{tramp} ¤Î¥Ð¥°¤äÌäÂê¤Ï¡¢³«È¯¥Á¡¼¥à¤Ë¤è¤Ã¤Æ¥¢¥¯¥Æ¥£¥Ö¤Ë²ò·è¤µ¤ì¤Æ¤¤¤Þ¤¹¡£
-»ÅÍͤ˴ؤ¹¤ë¥ê¥¯¥¨¥¹¥È¤äÄó°Æ¤â´¿·Þ¤·¤Þ¤¹¡£
-
-@value{tramp} ¥á¡¼¥ê¥ó¥°¥ê¥¹¥È¤Ï¡¢@value{tramp} ¤Î¾ðÊó¤òÆþ¼ê¤·¤¿¤ê¡¢ÌäÂê¤Î²ò·è¤ä¡¢
-°ìÈÌŪ¤ÊµÄÏÀ¡¢¤½¤·¤Æ¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ë´Ø·¸¤¹¤ëÏÃÂê¤Ø¤Î¥¢¥É¥Ð¥¤¥¹¤ËºÇŬ
-¤Î¾ì½ê¤Ç¤¹¡£
-
-¥á¡¼¥ê¥ó¥°¥ê¥¹¥È¤Ï @email{tramp-devel@@mail.freesoftware.fsf.org} ¤Ç¤¹¡£
-¤³¤Î¥¢¥É¥ì¥¹¤Ë¥á¥Ã¥»¡¼¥¸¤ò¤òÁ÷¤ë¤È¤¹¤Ù¤Æ¤Î¹ÖÆɼԤËÆϤ­¤Þ¤¹¡£
-¤³¤ì¤Ï¹ÖÆɤΥꥯ¥¨¥¹¥È¤òÁ÷¿®¤¹¤ë¤¿¤á¤Î¥¢¥É¥ì¥¹¤Ç¤Ï @emph{¤¢¤ê¤Þ¤»¤ó}¡£
-
-¥á¡¼¥ê¥ó¥°¥ê¥¹¥È¤ò¹ÖÆɤ¹¤ë¤¿¤á¤Î¥Ø¥ë¥×¤òÆþ¼ê¤¹¤ë¤Ë¤Ï¡¢¥µ¥Ö¥¸¥§¥¯¥È¤Ë
-@samp{help} ¤È½ñ¤¤¤¿¥á¡¼¥ë¤ò´ÉÍýÍѤΥ¢¥É¥ì¥¹
-@email{tramp-devel-request@@mail.freesoftware.fsf.org} ¤ËÁ÷¿®¤·¤Æ¤¯¤À¤µ¤¤¡£
-
-@value{tramp} ¤Î¥Ð¥°Êó¹ð¤ò¤¹¤ë¾ì¹ç¤Ë¤Ï¡¢@kbd{M-x tramp-bug} ¤ò¼Â¹Ô¤·¤Æ¤¯¤À¤µ¤¤¡£
-¤³¤ì¤Ï¡¢¤¢¤Ê¤¿¤Î¥·¥¹¥Æ¥à¤Î¾ÜºÙ¤ä @value{tramp} ¤Î¥Ð¡¼¥¸¥ç¥ó¾ðÊó¤ò´Þ¤à¥Ð¥Ã¥Õ¥¡
-¤ò¼«Æ°Åª¤ËÀ¸À®¤·¤Þ¤¹¡£
-
-¥Ð¥°Êó¹ð¤òÄó½Ð¤¹¤ë»þ¤Ë¤Ï¡¢ÌäÂê¤òºÆ¸½¤¹¤ë¼ê½ç¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¤ÎÀßÄê¡¢
-¤â¤·Â¸ºß¤¹¤ë¤Î¤Ç¤¢¤ì¤ÐÆüì¤Ê¾ò·ï¤ò¡¢¤·¤Ä¤³¤¤¤°¤é¤¤¾ÜºÙ¤Ëµ­½Ò¤·¤Æ¤¯
-¤À¤µ¤¤¡£¤â¤·²Äǽ¤Ê¤é¡¢´Êñ¤ÊºÆ¸½¼ê½ç¤âµ­½Ò¤·¤Æ¤¯¤À¤µ¤¤¡£
-
-¤â¤·¡¢ÌäÂê¤òºÆ¸½¤¹¤ë¤¿¤á¤Î´Êñ¤Ê¥Æ¥¹¥È¥±¡¼¥¹¤¬¤ï¤«¤ì¤Ð¡¢¤½¤ì¤ò¥Ð¥°
-Êó¹ð¤Ë´Þ¤á¤Æ¤¯¤À¤µ¤¤¡£¤³¤ì¤Ë¤è¤ê¡¢³«È¯¥Á¡¼¥à¤¬¥Ð¥°¤òÆͤ­»ß¤á¡¢½¤Àµ
-¤¹¤ë¤Î¤¬Íưפˤʤê¤Þ¤¹¡£
-
-
-@node Frequently Asked Questions
-@chapter ¤è¤¯¤¢¤ë¼ÁÌä¤È¤½¤ÎÅú
-@cindex frequently asked questions
-@cindex FAQ
-
-@itemize @bullet
-@item
-ºÇ¿·¤Î @value{tramp} ¤Ï¤É¤³¤«¤éÆþ¼ê¤Ç¤­¤Þ¤¹¤«?
-
-@value{tramp} ¤Ï°Ê²¼¤Î URL ¤ÇÆþ¼ê²Äǽ¤Ç¤¹
-
-@noindent
-@uref{http://savannah.nongnu.org/download/tramp/}
-
-@noindent
-¤Þ¤¿ Savannah ¤Î¥×¥í¥¸¥§¥¯¥È¥Ú¡¼¥¸¤â¤¢¤ê¤Þ¤¹¡£
-
-@noindent
-@uref{https://savannah.gnu.org/projects/tramp/}
-
-@item
-¤É¤Î¤è¤¦¤Ê¥·¥¹¥Æ¥à¾å¤ÇÆ°ºî¤·¤Þ¤¹¤«?
-
-¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ï¡¢Emacs 20 ¤È Emacs 21 ¾å¤ÇÆ°ºî¤·¤Þ¤¹¡£XEmacs 20 ¾å¤Ç¤Ï
-ÌäÂ꤬¤¢¤ê¤Þ¤¹¡£@file{tramp.el} ¤Î¥³¥á¥ó¥È¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£Emacs 19 
-¤Ç»î¤·¤¿¿Í¤¬¤¤¤ë¤Î¤«¤É¤¦¤«¤ÏÃΤê¤Þ¤»¤ó¡£
-
-¤³¤Î¥Ñ¥Ã¥±¡¼¥¸¤Ï Unix ¾å¤ÇÆ°ºî¤¹¤ë¤è¤¦¤ËÀ߷פµ¤ì¤Æ¤¤¤Þ¤¹¡£¤½¤·¤Æ¥ê¥â¡¼¥È
-¦¤â Unix É÷¤Î¥·¥¹¥Æ¥à¤Ç¤¢¤ë¤³¤È¤ò´üÂÔ¤·¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¡¢NT Emacs ¾å¤Ç
-Æ°ºî¤µ¤»¤ë¤³¤È¤ËÀ®¸ù¤·¤¿¿Í¤¬²¿¿Í¤«¤¤¤ë¤è¤¦¤Ç¤¹¡£
-
-°Ê²¼¤Î URL ¤Ë¤Ï¡¢Tramp ¤ò NT ¤Ç»È¤¦¤¿¤á¤Î¾ðÊ󤬤¢¤ê¤Þ¤¹; Joe Stoy
-¤Ë¤Ï¾ðÊó¤ÎÄ󶡤ËÂФ·¤Æ¿¼¤¯´¶¼Õ¤·¤Þ¤¹:
-@uref{ftp://ftp.comlab.ox.ac.uk/tmp/Joe.Stoy/}
-
-¾åµ­¤Ï¤â¤Ã¤Ñ¤é¸Å¤¤¥Ð¡¼¥¸¥ç¥ó¤Î ssh ¤Ø¤Î¥Ñ¥Ã¥Á¤¬¤ª¤¤¤Æ¤¢¤ê¤Þ¤¹; Tom Roche
-¤Î Web page ¤Ë¤âÀâÌÀ¤¬¤¢¤ê¤Þ¤¹:
-@uref{http://www4.ncsu.edu/~tlroche/plinkTramp.html}
-
-??? XEmacs ¤Î¾ðÊó¤ÏÀµ¤·¤¤¤Î¤Ç¤·¤ç¤¦¤«?
-
-??? 狼¡¢NT Emacs ¾å¤ÇÆ°¤«¤¹¤¿¤á¤Î¾ðÊó¤ò¶µ¤¨¤Æ¤¯¤À¤µ¤¤¡£¤¿¤Ö¤ó¡¢@command{ssh}
-´Ø·¸¤ÎÌäÂ꤬¤¢¤ë¤Î¤Ç¤Ï¤Ê¤¤¤«¤È»×¤¤¤Þ¤¹¡£
-
-@item
-@value{emacsname} ¤Ç @value{ftppackagename} ¤¬µ¯Æ°¤µ¤ì¤Æ¤·¤Þ¤¤¤Þ¤¹
-
-@ifset emacs
-ftp ¥á¥½¥Ã¥É¤Ë¤è¤ê¥Õ¥¡¥¤¥ë¤òÍ׵᤹¤ë¤È¡¢@value{tramp} ¤Ë¤è¤Ã¤Æ
-@value{ftppackagename} ¤¬¼«Æ°Åª¤ËÆɤ߹þ¤Þ¤ì¤Þ¤¹¡£ÉÔ¹¬¤Ê¤³¤È¤Ë¤¤¤¯¤Ä¤«¤Î
-Lisp ¥Ñ¥Ã¥±¡¼¥¸¤Ï @value{ftppackagename} ¥Õ¥¡¥¤¥ë̾¥Ï¥ó¥É¥é¤òÍ­¸ú¤Ë
-¤·¤Æ¤·¤Þ¤¤¤Þ¤¹¡£@kbd{C-h v file-name-handler-alist} ¤È¤¹¤ë¤È¤½¤ì¤ò³Î¤«
-¤á¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹:
-
-@example
-file-name-handler-alist's value is 
-(("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
- ("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
- ("^/[^/]*$" . tramp-completion-file-name-handler)
- ("\\`/[^/:]+:" . tramp-file-name-handler)
- ("\\`/:" . file-name-non-special))
-@end example
-
-¤É¤Î¥Ñ¥Ã¥±¡¼¥¸¤¬ @value{ftppackagename} ¤òÆɤ߹þ¤Þ¤»¤Æ¤¤¤ë¤«Ä´¤Ù¤Æ
-¤¼¤Ò¥Ð¥°¥ì¥Ý¡¼¥È¤ò½Ð¤·¤Æ²¼¤µ¤¤¡£
-
-²óÈòË¡¤È¤·¤Æ¤Ï¡¢@file{~/.emacs} ¤Ç @value{tramp} ¤è¤êÀè¤Ë @value{ftppackagename}
-¤ò require ¤·¤Æ¤ª¤¯¤³¤È¤Ç¤¹¡£²¿¸Î¤Ê¤é @value{tramp} ¤Ï @code{file-name-handler-alist}
-Æâ¤ÎÅÐÏ¿¤òÀ°Íý¤¹¤ë¤«¤é¤Ç¤¹:
-
-@lisp
-;; @value{ftppackagename} ¤ò²¾¤Ë require ¤¹¤ë
-(require 'ange-ftp)
-;; @value{tramp} ¤¬ @code{file-name-handler-alist} ¤òÀ°Íý¤¹¤ë
-(require 'tramp)
-@end lisp
-@end ifset
-
-@ifset xemacs
-¤¹¤Ù¤Æ¤Î¸Å¤¤¥Ð¡¼¥¸¥ç¥ó¤Î @value{tramp} ¤¬ @value{emacsname} @value{emacsname}
-¤òÀµ¤·¤¯¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤ë¤ï¤±¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£¤Þ¤ººÇ½é¤Ë¡¢ºÇ¿·¤Î @value{tramp}
-¤¬¥¤¥ó¥¹¥È¡¼¥ë¤µ¤ì¤Æ¤¤¤ë¤«¤É¤¦¤«¤ò³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£
-
-¤â¤·ºÇ¿·¤Î¥Ð¡¼¥¸¥ç¥ó¤Ê¤é¡¢ @value{ftppackagename} ¥Ï¥ó¥É¥é¡¼¤¬¼Â¹Ô
-¤µ¤ì¤ë¤¿¤á¤Î¾ò·ï¤òÀµ³Î¤ËÄ´¤Ù¤Æ¤¯¤À¤µ¤¤¡£¤â¤·²Äǽ¤Ê¤é¡¢¥Ö¥ì¡¼¥¯¥Ý¥¤¥ó¥È
-¤ò @code{efs-ftp-path} ¤ËÀßÄꤷ¤Æ¡¢¥Ð¥°Êó¹ð¤È°ì½ï¤Ë¥¹¥¿¥Ã¥¯¥È¥ì¡¼¥¹¤ò
-Á÷¤Ã¤Æ¤¯¤À¤µ¤¤¡£¤³¤ì¤é¤Î¾ðÊ󤬤¢¤ë¤È¡¢³«È¯¼Ô¤¬²¿¤¬´Ö°ã¤Ã¤Æ¤¤¤ë¤Î¤«¤òȯ
-¸«¤¹¤ë¤³¤È¤¬Íưפˤʤê¤Þ¤¹¡£
-@end ifset
-
-
-@item
-@value{tramp} ¤ò»È¤¦¤È¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤¬¤Ç¤­¤Þ¤»¤ó
-
-¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë¥í¥°¥¤¥ó¤·¤¿»þ¤Ë¡¢@command{ls} ¤Î½ÐÎϤ¬¿§ÉÕ¤­¤Ë¤Ê¤Ã¤Æ
-¤¤¤Þ¤»¤ó¤«? ¤â¤·¡¢¤½¤¦¤Ê¤é¡¢¤½¤ì¤¬¸¶°ø¤Ç¤¹¡£
-
-@command{ls} ¤Ï¡¢Ã¼Ëö¥¨¥ß¥å¥ì¡¼¥¿¡¼¤¬¿§¤òÊѹ¹¤¹¤ë¤¿¤á¤Î @acronym{ANSI} 
-¥¨¥¹¥±¡¼¥×¥·¡¼¥¯¥¨¥ó¥¹¤ò½ÐÎϤ·¤Þ¤¹¡£¤·¤«¤·¤Ê¤¬¤é¡¢¤³¤Î¥¨¥¹¥±¡¼¥×
-¥·¡¼¥¯¥¨¥ó¥¹¤Ï @value{tramp} ¤òº®Í𤵤»¤Þ¤¹¡£
-
-¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î @file{.bashrc}¡¢@file{.profile} ¤¢¤ë¤¤¤ÏƱ¤¸¤è¤¦¤Ê
-ÀßÄê¥Õ¥¡¥¤¥ë¤Ë¡¢@option{--color=yes} ¤Þ¤¿¤Ï @option{--color=auto}
-¤¬Äɲ䵤줿ÀßÄê¤Î alias ¤¬¤¢¤ë¤Ï¤º¤Ç¤¹¡£
-
-¤³¤Î alias ¤òºï½ü¤·¡¢¿·¤·¤¯¥í¥°¥¤¥ó¤·¤¿»þ¤Î @command{ls} ¤Î½ÐÎϤ¬
-¿§ÉÕ¤­¤Çɽ¼¨¤µ¤ì @emph{¤Ê¤¤} ¤³¤È¤ò³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£¤â¤·¡¢¤³¤ì¤Ç¤â
-¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤¬Àµ¾ï¤ËÆ°ºî¤·¤Ê¤¤¾ì¹ç¤Ï¡¢@value{tramp} ³«È¯¼Ô¤Ë¥Ð¥°Êó¹ð
-¤ò¤·¤Æ¤¯¤À¤µ¤¤¡£
-
-
-@item
-µðÂç¤Ê¥Ç¥£¥ì¥¯¥È¥ê¤ÎÃæ¤Ç¤Ï¥Õ¥¡¥¤¥ë̾¤ÎÊä´°¤¬Æ°ºî¤·¤Þ¤»¤ó
-
-@value{tramp} ¤Ï¤¤¤¯¤Ä¤«¤Î¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤Ç globbing ¤ò»ÈÍѤ·¤Þ¤¹¡£(globbing
-¤È¤Ï¡¢`*.c' ¤Î¤è¤¦¤Ê¥ï¥¤¥ë¥É¥«¡¼¥ÉŸ³«¤Î¤¿¤á¤Ë¥·¥§¥ë¤ò»È¤¦¤³¤È¤Ç¤¹)
-¤³¤ì¤Ï¡¢¤¿¤¯¤µ¤ó¤Î¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤¹¤ë¥Ç¥£¥ì¥¯¥È¥ê¤Ç¤ÏŤ¤¥³¥Þ¥ó¥É¥é¥¤¥ó
-¤òºî¤ê¤Þ¤¹¡£¤¤¤¯¤Ä¤«¤Î¥·¥§¥ë¤Ç¤ÏŤ¤¥³¥Þ¥ó¥É¥é¥¤¥ó¤ò¤±¤º¤ê¤È¤Ã¤¿¤ê¡¢
-¤¢¤ë¤¤¤Ï globbing ¼«¿È¤ò½èÍý¤Ç¤­¤Þ¤»¤ó¡£
-
-¥ê¥â¡¼¥È¥Û¥¹¥È¦¤ËµðÂç¤Ê¥Ç¥£¥ì¥¯¥È¥ê¤¬¤¢¤ë¾ì¹ç¤Ï¡¢
-@samp{ls -d * ..?* > /dev/null} ¤Î¤è¤¦¤Ê¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤·¡¢¥Ï¥ó¥°¤¹¤ë¤«
-¤É¤¦¤«¤ò³Îǧ¤·¤Æ¤¯¤À¤µ¤¤¡£Ãí°Õ¤¹¤ëɬÍפ¬¤¢¤ë¤Î¤Ï¡¢ºÇ½é¤ËÀµ¤·¤¤¥·¥§¥ë¡¢
-@command{/bin/sh}¡¢@command{ksh} ¤¢¤ë¤¤¤Ï @command{bash}¡¢¤Ä¤Þ¤ê tilde ¤Î
-Ÿ³«¤ò¥µ¥Ý¡¼¥È¤¹¤ë¥·¥§¥ë¤«¤é»î¤¹¤Ù¤­¤À¤È¤¤¤¦»ö¤Ç¤¹¡£
-
-
-@item
-@value{tramp} ¤Ï¤É¤Î¤è¤¦¤Ê¼ïÎà¤Î¥·¥¹¥Æ¥à¤ÇÆ°ºî¤·¤Þ¤¹¤«
-
-@value{tramp} ¤Ï¡¢¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤¬ Unix É÷¤Î¥·¥¹¥Æ¥à¤Ç¤¢¤ë»ö¤òÁ°Äó¤Ë¤·¤Æ
-¤¤¤Þ¤¹¡£¤Þ¤¿¡¢¥í¡¼¥«¥ë¥·¥¹¥Æ¥à¤â Unix É÷¤Î¥·¥¹¥Æ¥à¤Î¤Û¤¦¤¬Ë¾¤Þ¤·¤¤¤Ç
-¤·¤ç¤¦¡£¤·¤«¤·¡¢¤¹¤³¤·½¤Àµ¤¹¤ì¤Ð¡¢@value{tramp} ¤Ï NT ¾å¤Ç¤âÆ°ºî¤¹¤ë¤Ï¤º¤Ç¤¹¡£
-
-
-@item
-@value{tramp} ¤Î¥Õ¥¡¥¤¥ëžÁ÷¤¬´°Î»¤·¤¿»þ¤ËÄÌÃΤµ¤»¤ë¤Ë¤Ï¤É¤¦¤¹¤ì¤Ð¤¤¤¤¤Ç¤·¤ç¤¦¤«?
-
-°Ê²¼¤Î¥³¡¼¥É¤ò¡¢@file{~/.emacs} ¤ËÄɲ䷤Ƥ¯¤À¤µ¤¤¡£¤³¤ì¤Ç¡¢¥ê¥â¡¼¥È
-¥Û¥¹¥È¤ËÂФ¹¤ëÆɤ߽ñ¤­¤Î¸å¤Ë¡¢Emacs ¤¬ beep ²»¤ò¤Ê¤é¤·¤Æ¤¯¤ì¤Þ¤¹¡£
-
-@lisp
-(defadvice tramp-handle-write-region
-  (after tramp-write-beep-advice activate)
- " make tramp beep after writing a file."
- (interactive)
- (beep))
-(defadvice tramp-handle-do-copy-or-rename-file
-  (after tramp-copy-beep-advice activate)
- " make tramp beep after copying a file."
- (interactive)
- (beep))
-(defadvice tramp-handle-insert-file-contents
-  (after tramp-copy-beep-advice activate)
- " make tramp beep after copying a file."
- " make tramp beep after copying a file."
- (interactive)
- (beep))
-@end lisp
-
-
-@item
-¥ê¥â¡¼¥È¥Û¥¹¥È¤Î @file{~/.sh_history} ¤È¤¤¤¦¥Õ¥¡¥¤¥ë¤¬ÈîÂ礷³¤±¤Æ¤¤¤Þ
-¤¹¡£¤³¤ì¤Ï²¿¤Ç¤¹¤«?
-
-@value{tramp} ¤Ï¥Æ¥£¥ë¥ÀŸ³«¤Î°Ù¤Ë¡¢¤·¤Ð¤·¤Ð¥ê¥â¡¼¥È¥Û¥¹¥È¤Ç @code{ksh} ¤ò
-µ¯Æ°¤·¤Þ¤¹¡£¤¿¤Ö¤ó @code{ksh} ¤Ï¥Ç¥Õ¥©¥ë¥È¤ÇÍúÎò¤òÊݸ¤·¤Þ¤¹¡£@value{tramp}
-¤ÏÍúÎò¤ÎÊݸ¤òÄä»ß¤·¤è¤¦¤È»î¤ß¤Þ¤¹¤¬¡¢¤¢¤Ê¤¿¤¬¼ê½õ¤±¤ò¤¹¤ëɬÍפ¬¤¢¤ë
-¤«¤â¤·¤ì¤Þ¤»¤ó¡£Î㤨¤Ð¡¢¤¢¤Ê¤¿¤Î @file{.kshrc} ¤Ë¤³¤ì¤òÆþ¤ì¤Æ¤¯¤À¤µ¤¤:
-
-@example
-if [ -f $HOME/.sh_history ] ; then
-   /bin/rm $HOME/.sh_history
-fi
-if [ "$@{HISTFILE-unset@}" != "unset" ] ; then
-   unset HISTFILE
-fi
-if [ "$@{HISTSIZE-unset@}" != "unset" ] ; then
-   unset HISTSIZE
-fi
-@end example
-
-
-@item @value{tramp} ¤¬ 500 ʸ»ú¤ò±Û¤¨¤ëʸ»úÎó¤òÀµ¤·¤¯Å¾Á÷¤·¤Þ¤»¤ó¡£
-
-¤¤¤¯¤Ä¤«¤Îµ©¤Ê¥·¥¹¥Æ¥à¤Ç¤Ï¡¢@code{process-send-string} ¤Î¼ÂÁõ¤¬
-Ť¤Ê¸»úÎó¤ËÂФ·¤Æ²õ¤ì¤Æ¤¤¤Þ¤¹¡£¤³¤Î¾ì¹ç¡¢ÊÑ¿ô @code{tramp-chunksize}
-¤ò 500 ¤Ë¥«¥¹¥¿¥Þ¥¤¥º¤·¤Þ¤¹¡£¤³¤ì¤¬É¬Íפ«¤É¤¦¤«¤ò¤É¤¦¤ä¤Ã¤ÆÃΤ뤫¤Ï
-@code{tramp-chunksize} ¤ÎÀâÌÀ¤ò¸«¤Æ²¼¤µ¤¤¡£
-
-@end itemize
-
-
-@c For the developer
-@node Version Control
-@chapter ¥ê¥â¡¼¥È¥Ð¡¼¥¸¥ç¥ó¥³¥ó¥È¥í¡¼¥ë¤ÎÆâÉôÆ°ºî
-@cindex Version Control
-
-@value{ftppackagename} ¤È°Û¤Ê¤ê¡¢@value{tramp} ¤Ï¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥·¥§¥ë¤ò¼Â¹Ô
-¤·¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤Æ¡¢@value{tramp} ¤ò»È¤¤¥¢¥¯¥»¥¹¤·¤¿¥Õ¥¡¥¤¥ë¤Î¥Ð¡¼¥¸¥ç¥ó
-´ÉÍý¤ò¤ª¤³¤Ê¤¦»ö¤¬¤Ç¤­¤Þ¤¹¡£
-
-¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤ò¤ª¤³¤Ê¤¦¥Ð¥¤¥Ê¥ê¤¬¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ë¥¤¥ó¥¹¥È¡¼¥ë¤µ¤ì¤Æ
-¤¤¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£¤½¤·¤Æ¡¢@var{tramp-remote-path} ¤Ç»ØÄꤵ¤ì¤¿
-¥Ç¥£¥ì¥¯¥È¥ê¤ËÃÖ¤«¤ì¤Æ¡¢¥¢¥¯¥»¥¹²Äǽ¤Ç¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¡£
-
-¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤ÎÆ©²áŪ¤ÊÅý¹ç¤Ï¡¢@value{tramp} ¤Î¤â¤Ã¤È¤â²ÁÃͤΤ¢¤ë
-µ¡Ç½¤Î¤Ò¤È¤Ä¤Ç¤¹¡£¤·¤«¤·¡¢¤Þ¤À´°Á´¤Ë¤Ï¤Û¤É±ó¤¤¾õÂ֤Ǥ¹¡£¥·¥¹¥Æ¥à¤ÎÆ©²á
-À­¤ò¸þ¾å¤µ¤»¤ë¤¿¤á¤Îºî¶È¤¬Â³¤±¤é¤ì¤Æ¤¤¤Þ¤¹¡£
-
-@menu
-* Version Controlled Files::    ¥Õ¥¡¥¤¥ë¤¬¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤µ¤ì¤Æ¤¤¤ë¤«¤É¤¦¤«¤ÎȽÃÇ
-* Remote Commands::             ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Ç¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥³¥Þ¥ó¥É¤Î¼Â¹Ô
-* Changed workfiles::           ºî¶È¥Õ¥¡¥¤¥ë¤ÎÊѹ¹¤Îȯ¸«
-* Checking out files::          ºî¶È¥Õ¥¡¥¤¥ë¤Î¥ê¥Ý¥¸¥È¥ê¤«¤é¤Î¼èÆÀ
-* Miscellaneous Version Control::  ¤½¤Î¾¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Ë´Ø·¸¤¹¤ë»ö
-@end menu
-
-
-@node Version Controlled Files
-@section ¥Õ¥¡¥¤¥ë¤¬¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤µ¤ì¤Æ¤¤¤ë¤«¤É¤¦¤«¤ÎȽÃÇ
-
-VC ¥Ñ¥Ã¥±¡¼¥¸¤Ï¡¢¥Ç¥£¥¹¥¯¾å¤Î¥Þ¥¹¥¿¡¼¥Õ¥¡¥¤¥ë¤Î¸ºß¤ò¤â¤È¤Ë¡¢»ØÄꤵ¤ì¤¿
-¥Õ¥¡¥¤¥ë¤¬¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Î´ÉÍý²¼¤Ë¤¢¤ë¤«¤É¤¦¤«¤òȽÃǤ·¤Þ¤¹¡£
-¤³¤ì¤é¤Î¥Õ¥¡¥¤¥ë¤Î¥Æ¥¹¥È¤Ï¡¢É¸½àŪ¤Ê @value{tramp} ¤Î»ÅÁȤߤò»È¤¤¥ê¥â¡¼¥È
-¥Þ¥·¥ó¾å¤Ç¼Â¹Ô¤µ¤ì¤Þ¤¹¡£
-
-
-@node Remote Commands
-@section ¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥³¥Þ¥ó¥É¤Î¼Â¹Ô
-
-¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Î¥³¥Þ¥ó¥É¤Î¼Â¹Ô¤ò²£¼è¤ê¤¹¤ë¤³¤È¤Î¤Ç¤­¤ë VC ÍѤΠ
-hook ¤Ï¸ºß¤·¤Þ¤»¤ó¡£@code{call-process} ¤Î»ÅÁȤߤò»È¤¤¡¢
-´Ø¿ô¸Æ¤Ó½Ð¤·¤¬È¯À¸¤·¤Þ¤¹¡£´Ø¿ô¤Ï @code{shell-command} ¤è¤ê¡¢¼ã´³
-¸úΨŪ¤Ç¤¹¤¬¡¢¥ê¥â¡¼¥È¤Ç¥³¥Þ¥ó¥É¤ò¼Â¹Ô¤¹¤ë¤¿¤á¤Î hook ¤ÏÍÑ°Õ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó¡£
-
-¤È¤ê¤¢¤¨¤ºÆ°ºî¤µ¤»¤ë¤¿¤á¤Ë¡¢´Ø¿ô @code{vc-do-command} ¤È 
-@code{vc-simple-command} ¤Ë¡¢@value{tramp} ¤ò·Ðͳ¤·¥¢¥¯¥»¥¹¤µ¤ì¤¿¥Õ¥¡¥¤¥ë¤Ø¤Î
-¥ª¥Ú¥ì¡¼¥·¥ç¥ó¤Î¤¿¤á¤Î¥ê¥¯¥¨¥¹¥È¤ò²£¼è¤¹¤ë¤³¤È¤¬ÄÌÃΤµ¤ì¤Þ¤¹¡£
-
-¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤Î¾ì¹ç¡¢¥í¡¼¥«¥ë¥Þ¥·¥ó¤ÈƱ¤¸µ¡Ç½¤òÄ󶡤¹¤ë¤¿¤á¤Ë¡¢
-@code{shell-command} ¥¤¥ó¥¿¡¼¥Õ¥§¡¼¥¹¤¬¡¢¤¤¤¯¤Ä¤«¤Î¥é¥Ã¥Ñ¡¼¥³¡¼¥É¤È
-¶¦¤Ë»ÈÍѤµ¤ì¤Þ¤¹¡£
-
-
-@node Changed workfiles
-@section ºî¶È¥Õ¥¡¥¤¥ë¤ÎÊѹ¹¤Îȯ¸«
-
-º£¤Î¤È¤³¤í¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î¥Õ¥¡¥¤¥ë¤Î mtime ¤ò¼èÆÀ¤¹¤ë°Ü¿¢À­¤Î¹â¤¤
-ÊýË¡¤Ï¸ºß¤·¤Þ¤»¤ó¡£@code{vc-workfile-unchanged-p} ´Ø¿ô¤Ë¡¢¥ê¥â¡¼¥È
-¥Õ¥¡¥¤¥ë¤Î¤¿¤á¤Ë @value{tramp} ¤Î´Ø¿ô¤Î¸Æ¤Ó½Ð¤·¤¬ÄÌÃΤµ¤ì¤Þ¤¹¡£
-
-@code{tramp-vc-workfile-unchanged-p} ´Ø¿ô¤Ï¡¢ºî¶È¥Õ¥¡¥¤¥ë¤È¥Ð¡¼¥¸¥ç¥ó
-´ÉÍý¥Þ¥¹¥¿¥Õ¥¡¥¤¥ë¤ÎÊѹ¹ÅÀ¤òÄ´¤Ù¤ë¤¿¤á¤Ë VC ¤Î diff µ¡Ç½¤ò»ÈÍѤ·¤Þ¤¹¡£
-
-¤³¤ì¤ò¼Â¸½¤¹¤ë¤¿¤á¤Ë¤Ï¡¢¥ê¥â¡¼¥È¤Ç¤Î¥·¥§¥ë¥³¥Þ¥ó¥É¤¬¼Â¹Ô²Äǽ¤Ç¤Ê¤ì¤Ð
-¤Ê¤ê¤Þ¤»¤ó¡£¤³¤Î½èÍý¤Ï¡¢¥í¡¼¥«¥ë¥Õ¥¡¥¤¥ë¤Ç»È¤ï¤ì¤ë mtime ¤Î¼èÆÀ¤è¤ê
-½Å¤¤½èÍý¤Ç¤¹¡£»ÄÇ°¤Ê¤¬¤é¡¢°Ü¿¢À­¤Î¹â¤¤²ò·èÊýË¡¤¬¸«¤Ä¤«¤ë¤Þ¤Ç¤Ï¡¢¥ê¥â¡¼¥È
-¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤Î¥³¥¹¥È¤Ï¤³¤Î¤Þ¤Þ¤Ç¤·¤ç¤¦¡£
-
-
-@node Checking out files
-@section ºî¶È¥Õ¥¡¥¤¥ë¤Î¥ê¥Ý¥¸¥È¥ê¤«¤é¤Î¼èÆÀ
-
-¥Ç¥Õ¥©¥ë¥È¤Ç¤Ï¡¢VC ¤Ï¥ê¥â¡¼¥È¥Õ¥¡¥¤¥ë¤ò¥Á¥§¥Ã¥¯¤·¡¢¥ê¥Ý¥¸¥È¥ê¤«¤é¥Á¥§¥Ã¥¯
-¥¢¥¦¥È¤µ¤ì¤¿¥Õ¥¡¥¤¥ë¤¬¤¢¤ë¾ì¹ç¤Ï¡¢¥Á¥§¥Ã¥¯¥¢¥¦¥È¤ò¤ª¤³¤Ê¤¤¤Þ¤»¤ó¡£¤³¤ÎÌäÂê
-¤ò²ò·è¤¹¤ë¤¿¤á¤Ë¡¢´Ø¿ô @code{vc-checkout} ¤Ï @value{tramp} ¥Õ¥¡¥¤¥ë¤ò¶èÊ̤·¡¢
-¥Ð¡¼¥¸¥ç¥ó´ÉÍý¤ò¤ª¤³¤Ê¤¦¤³¤È¤ò²Äǽ¤Ë¤·¤Þ¤¹¡£
-
-
-@node Miscellaneous Version Control
-@section ¤½¤Î¾¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Ë´Ø·¸¤¹¤ë»ö
-
-¤³¤Þ¤«¤Ê¼ÂÁõ¤Î¾ÜºÙ¡¢¤½¤Î¾¡£
-
-@menu
-* Remote File Ownership::       VC ¤¬¥ï¡¼¥¯¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼¤òÄ´¤Ù¤ëÊýË¡
-* Back-end Versions::           VC ¤¬ RCS ¤Î¥Ð¡¼¥¸¥ç¥ó¤òÄ´¤Ù¤ëÊýË¡
-@end menu
-
-
-@node Remote File Ownership
-@subsection VC ¤¬¥ï¡¼¥¯¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼¤òÄ´¤Ù¤ëÊýË¡
-
-Emacs ¤Ï¡¢Ç¤°Õ¤Î¥æ¡¼¥¶¡¼ ID ¤ÎÃÍ¤È¥í¥°¥¤¥ó̾¤ò¥Þ¥Ã¥Ô¥ó¥°¤¹¤ë¤Î¤ÈƱÍͤˡ¢
-¸½ºß¤Î¥æ¡¼¥¶¡¼¤Î¥í¥°¥¤¥ó̾¤ò¤«¤¨¤¹´Ø¿ô @code{user-full-name} ¤òÍÑ°Õ¤·¤Æ
-¤¤¤Þ¤¹¡£VC ¤Ï¡¢¤¤¤¯¤Ä¤«¤Î¾õ¶·¤Ç¡¢¥ï¡¼¥¯¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼¤Î uid ¤«¤é¥í¥°
-¥¤¥ó̾¤Ø¤Î¥Þ¥Ã¥×µ¡Ç½¤ò»ÈÍѤ·¤Þ¤¹¡£
-
-¤³¤ì¤Ï¡¢¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤¬°Û¤Ê¤ë¥í¥°¥¤¥ó¥»¥Ã¥È¤ò»ý¤Ä¾ì¹ç¤Ë¤Ï¡¢¤¢¤­¤é¤«
-¤ËÀµ¤·¤¯Æ°ºî¤·¤Þ¤»¤ó¡£¤·¤¿¤¬¤Ã¤Æ¡¢uid ¤ËÂбþ¤¹¤ë¥í¥°¥¤¥ó̾¤Î·èÄê¤ò¥ê¥â¡¼¥È
-¥Þ¥·¥ó¤Ë¤ª¤³¤Ê¤ï¤»¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£
-
-»ÄÇ°¤Ê¤¬¤é¡¢@code{NIS}¡¢@code{NIS+}¤½¤·¤Æ @code{NetInfo} ¤Î¤è¤¦¤Ê¡¢
-ʬ»¶´ÉÍý¥·¥¹¥Æ¥à ¤ò»È¤¦¾ì¹ç¡¢¥·¥ó¥×¥ë¤Ç¡¢¿®ÍêÀ­¤¬¤¢¤ê¡¢°Ü¿¢À­¤Î¹â¤¤
-¥Þ¥Ã¥Ô¥ó¥°¤ÎÊýË¡¤Ï¸ºß¤·¤Þ¤»¤ó¡£
-
-¤¢¤ê¤¬¤¿¤¤»ö¤Ë¡¢uid ¤«¤é¥í¥°¥¤¥ó̾¤Ø¤Î¥Þ¥Ã¥Ô¥ó¥°¤Ë°Í¸¤¹¤ë VC ¤Î¥³¡¼¥É¤Ï¡¢
-´Ø¿ô @code{vc-file-owner} ¤Ò¤È¤Ä¤À¤±¤Ç¤¹¡£¤³¤Î´Ø¿ô¤Ï¡¢¥Õ¥¡¥¤¥ë¤Î¥ª¡¼¥Ê¡¼
-¤Î¥í¥°¥¤¥ó̾¤òʸ»úÎó¤È¤·¤ÆÊÖ¤·¤Þ¤¹¡£
-
-¥í¥°¥¤¥ó̾¤ò·èÄꤹ¤ë¤¿¤á¤Ë¡¢¤³¤Î´Ø¿ô¤Ë¡¢¥ê¥â¡¼¥È¥Þ¥·¥ó¾å¤Î @command{ls} 
-¤Î½ÐÎϤò»ÈÍѤ¹¤ë¤³¤È¤¬ÄÌÃΤµ¤ì¤Þ¤¹¡£uid ¤«¤é¥í¥°¥¤¥ó̾¤Î¥Þ¥Ã¥Ô¥ó¥°¤ò¡¢
-»ä¤è¤ê¤½¤ì¤é¤Ë¤Ä¤¤¤ÆÎɤ¯ÃΤäƤ¤¤ë¤Ï¤º¤Î¥ê¥â¡¼¥È¥·¥¹¥Æ¥à¤Ë°Ñ¾ù¤·¤Þ¤¹¡£
-
-
-@node Back-end Versions
-@subsection VC ¤¬ RCS ¤Î¥Ð¡¼¥¸¥ç¥ó¤òÄ´¤Ù¤ëÊýË¡
-
-VC ¤Ï¡¢¤É¤Î¥ê¥ê¡¼¥¹¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Î¥Ð¥¤¥Ê¥ê¤ò»È¤Ã¤Æ¤¤¤ë¤«¤ò
-ÃΤëɬÍפ¬¤¢¤ê¤Þ¤¹¡£¤³¤ì¤Ï¡¢VC ¤¬¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤ë¤¹¤Ù¤Æ¤Îµ¡Ç½¤ò¡¢¸Å¤¤
-¥Ð¡¼¥¸¥ç¥ó¤Î@command{rcs(1)}¡¢@command{cvs(1)}¡¢@command{sccs(1)}¤¬Äó¶¡
-¤·¤Æ¤¤¤ë¤ï¤±¤Ç¤Ï̵¤¤¤«¤é¤Ç¤¹¡£
-
-VC ¤Î¥Ç¥Õ¥©¥ë¥È¤Î¼ÂÁõ¤Ç¤Ï¡¢ºÇ½é¤ËɬÍפˤʤä¿»þ¤Ë¡¢¤³¤ÎÃͤò·èÄꤷ¤Þ¤¹¡£
-¤³¤ì¤Ï¡¢É¬Íפˤʤä¿»þ¤ËËè²ó¥×¥í¥»¥¹¤ò¼Â¹Ô¤·¡¢¤½¤Î½ÐÎϤò¥Ñ¡¼¥¹¤¹¤ë¤³¤È¤Î
-¥ª¡¼¥Ð¡¼¥Ø¥Ã¥É¤ò¤µ¤±¤ë¤¿¤á¤Ç¤¹¡£
-
-¤¤¤«¤·¡¢¥ê¥â¡¼¥È¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥·¥¹¥Æ¥à¤Î»ö¤¬´Ø·¸¤·¤Æ¤¯¤ë¤È¡¢¿ÍÀ¸¤Ï
-¤½¤ì¤Û¤É´Êñ¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£¥ê¥â¡¼¥È¥Þ¥·¥ó¤Ï¤½¤ì¤¾¤ì¡¢°Û¤Ê¤ë¥Ð¡¼¥¸¥ç¥ó
-¤Î¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥Ä¡¼¥ë¤ò¤â¤Ã¤Æ¤¤¤Þ¤¹¡£¤³¤ì¤¬º¤Æñ¤Ê´Ö¤Ï¡¢Â¸ºß¤·¤Ê¤¤µ¡Ç½
-¤¬¡¢¥ê¥â¡¼¥È¤Ç»ÈÍѤµ¤ì¤Ê¤¤¤³¤È¤òÊݾڤ¹¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£
-
-¤³¤ÎÌäÂê¤ò²ò·è¤¹¤ë¤¿¤á¤Ë¡¢¸½ºß¤Î @value{tramp} ¤Ï¡¢¥Ð¡¼¥¸¥ç¥ó´ÉÍý¥Ä¡¼¥ë¤Î
-¥Ð¡¼¥¸¥ç¥óÈÖ¹æ¤ò @value{tramp} ¥Ð¥Ã¥Õ¥¡Ëè¤Ë¥í¡¼¥«¥ë¤ÊÊÑ¿ô¤Ë¤·¡¢¿·¤·¤¤
-¥Õ¥¡¥¤¥ë¤ò³«¤¯¤¿¤Ó¤ËVC ¤Ë¤³¤ÎÃͤò·èÄꤵ¤»¤ë¤È¤¤¤¦ÎϤº¤¯¤Î¥¢¥×¥í¡¼¥Á
-¤òºÎÍѤ·¤Æ¤¤¤Þ¤¹¡£
-
-¤³¤ì¤Ï¤¢¤­¤é¤«¤ËÀ­Ç½¤Ë±Æ¶Á¤·¤Þ¤¹¡£¤¢¤ê¤¬¤¿¤¤¤³¤È¤Ë¡¢VC ¤Ë¤è¤Ã¤Æ¤ª¤³¤Ê¤ï¤ì¤ë
-¤Û¤È¤ó¤É¤Î½èÍý¤Ï¡¢¼ÂºÝ¤Ë¤Ï¥ê¥â¡¼¥È¤Î¥Ð¡¼¥¸¥ç¥ó¤òÃΤ뤳¤È¤òɬÍפȤ·¤Þ¤»¤ó¡£
-¤·¤¿¤¬¤Ã¤Æ¡¢¤½¤ì¤Û¤ÉÌäÂê¤Ë¤Ê¤ê¤Þ¤»¤ó¡£
-
-ºÇ½ªÅª¤Ë¤Ï¡¢¤³¤ì¤é¤ÎÊÑ¿ô¤Ï @value{tramp} ¤Ë¤è¤Ã¤Æ¥·¥¹¥Æ¥àËè¤ËÄ´¤Ù¤é¤ì¡¢
-¤½¤Î·ë²Ì¤ÏÀ­Ç½¤ò²þÁ±¤¹¤ë¤¿¤á¤Ë¥­¥ã¥Ã¥·¥å¤µ¤ì¤ë¤è¤¦¤Ë¤Ê¤ë¤Ç¤·¤ç¤¦¡£
-
-
-@node Files directories and localnames
-@chapter ¥Õ¥¡¥¤¥ë̾¡¢¥Ç¥£¥ì¥¯¥È¥ê¡¢¥í¡¼¥«¥ë̾¤¬¤É¤Î¤è¤¦¤ËÊÑ´¹¤µ¤ì(mangled)¡¢´ÉÍý¤µ¤ì¤ë¤«
-
-@menu
-* Localname deconstruction::         ¥í¡¼¥«¥ë̾¤Îʬ²ò
-@end menu
-
-
-@node Localname deconstruction
-@section ¥í¡¼¥«¥ë̾¤Îʬ²ò
-
-@value{tramp} ¤Î¥Õ¥¡¥¤¥ë̾¤ÏÉáÄ̤Υե¡¥¤¥ë̾¤È¤ÏÌÀ¤é¤«¤Ë°Û¤Ê¤Ã¤Æ¤¤¤Þ¤¹¡£
-¤·¤¿¤¬¤Ã¤Æ¡¢lisp ¤Î´Ø¿ô @code{file-name-directory} ¤È 
-@code{file-name-nondirectory} ¤Ï¡¢@value{tramp} ¥Ñ¥Ã¥±¡¼¥¸Æâ¤Ç¾å½ñ¤­¤µ¤ì¤Æ
-¤¤¤Þ¤¹¡£
-
-´Ø¿ô¤ÎÃÖ¤­´¹¤¨¤Ï¥·¥ó¥×¥ë¤«¤ÄŬÀÚ¤ÊÊýË¡¤Ç¤¹¡£¥Õ¥¡¥¤¥ë̾¤òʬ²ò¤·¡¢
-¥í¡¼¥«¥ë̾¤ËÂФ·¤Æ¥ª¥ê¥¸¥Ê¥ë¤Î¥Ï¥ó¥É¥é¡¼¤¬¤è¤Ð¤ì¤Þ¤¹¡£¤½¤·¤Æ¡¢
-¤½¤Î·ë²Ì¤ò¤â¤È¤Ë @value{tramp} ¥Õ¥¡¥¤¥ë̾¤¬ºÆ¹½À®¤µ¤ì¤Þ¤¹¡£
-
-¤³¤ì¤Ë¤è¤ê¡¢@value{tramp} ¥Õ¥¡¥¤¥ë̾¤Î¾ðÊó¤ò°·¤¦¾ì¹ç¤â¡¢¥×¥é¥Ã¥È¥Û¡¼¥à¸ÇÍ­¤Î
-¥ª¥ê¥¸¥Ê¥ë¥Ï¥ó¥É¥é¡¼¤Î¥Ï¥Ã¥¯¤ÏÍ­¸ú¤Ç¤¹¡£
-
-
-@node Issues
-@chapter ¸¡Æ¤²ÝÂê¤È·èÄê»ö¹à
-
-@itemize @bullet
-@item uuencode ¥á¥½¥Ã¥É¤¬¤¤¤Ä¤âÆ°ºî¤¹¤ë¤ï¤±¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó
-
-@value{tramp} ¤ÎÀß·×¾å¤ÎÍýͳ¤Ç¡¢Éä¹æ²½¤ÈÉü¹æ²½¤ò¤ª¤³¤Ê¤¦¥×¥í¥°¥é¥à¤Ïɸ½à
-ÆþÎϤ«¤éÆɤ߹þ¤ß¡¢É¸½à½ÐÎϤ˽ñ¤­¹þ¤àɬÍפ¬¤¢¤ê¤Þ¤¹¡£¤¤¤¯¤Ä¤«¤Î¥·¥¹¥Æ¥à
-¤Ç¤Ï¡¢@code{uudecode -o -} ¤Çɸ½àÆþÎϤ«¤éÆɤ߹þ¤ß¡¢Éü¹æ²½¤µ¤ì¤¿¥Õ¥¡¥¤¥ë
-¤òɸ½à½ÐÎϤ˽ñ¤­¹þ¤ß¤Þ¤¹¡£Â¾¤Î¥·¥¹¥Æ¥à¤Ç¤Ï¡¢@code{uudecode -p} ¤¬Æ±¤¸
-Æ°ºî¤ò¤·¤Þ¤¹¡£¤·¤«¤·¡¢¤¤¤¯¤Ä¤«¤Î¥·¥¹¥Æ¥à¤Î uudecode ¤Î¼ÂÁõ¤Ç¤Ï¡¢¤³¤ì¤é
-¤Î¤³¤È¤¬Á´¤¯¤Ç¤­¤Þ¤»¤ó¡£¤³¤ì¤é¤Î uudecode ¤Î¼ÂÁõ¤Ë¡¢É¸½à½ÐÎϤ˽ñ¤­¹þ¤à
-¤¿¤á¤ËŬÀڤʥѥé¥á¡¼¥¿¤òÅϤ·¤Æ¸Æ¤Ö¤³¤È¤ÏÉÔ²Äǽ¤Ç¤¹¡£
-
-¤â¤Á¤í¤ó¡¢¤³¤ì¤ò²óÈò¤¹¤ë»ö¤Ï²Äǽ¤Ç¤¹¡£¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë̾¤òÄɲ乤ë
-¤¿¤á¤Ë @code{begin foo 644} ¹Ô¤ò½ñ¤­¤«¤¨¤ì¤Ð¡¢@code{uudecode} ¤ò¸Æ¤Ö¤³¤È
-¤¬¤Ç¤­¤Þ¤¹¡£¤½¤·¤Æ¥Æ¥ó¥Ý¥é¥ê¥Õ¥¡¥¤¥ë¤òɽ¼¨¤·ºï½ü¤·¤Þ¤¹¡£
-
-¤·¤«¤·¡¢¤³¤ÎÊýË¡¤Ï¤¢¤Þ¤ê¤Ë¤â¿®ÍêÀ­¤¬Ä㤤¤¿¤á¡¢¤¤¤¯¤Ä¤«¤Î¥·¥¹¥Æ¥à¤Ç¤Ï
-uuencode ¥á¥½¥Ã¥É¤ò»ÈÍѤǤ­¤Ê¤¤¤Þ¤Þ¤Ë¤·¤Æ¤ª¤¯»ö¤Ë¤·¤Þ¤·¤¿¡£
-
-@item @value{tramp} ¤Ï XEmacs 20 ¾å¤ÇÆ°¤­¤Þ¤»¤ó
-
-¤³¤ì¤Ï¡¢XEmacs 20 ¤Ë¸ºß¤·¤Ê¤¤¥Þ¥¯¥í @code{with-timeout} ¤ò»È¤Ã¤Æ¤¤¤ë
-¤«¤é¤Ç¤¹¡£»ä¤Ï¡¢¥¨¥ß¥å¥ì¡¼¥·¥ç¥ó¤Î¤¿¤á¤Î¥Þ¥¯¥í¤ò @value{tramp} ¤ËÄɲ乤ë
-¤³¤È¤Ë¡¢¤¢¤Þ¤ê¾è¤êµ¤¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£¤·¤«¤·¡¢XEmacs 20 ¥æ¡¼¥¶¡¼¤Î狼¤¬
-ÀѶËŪ¤Ë¼ÂÁõ¤È¥Æ¥¹¥È¤ò¤·¤¿¤¤¤È¹Í¤¨¤Æ¤¤¤ë¤Î¤Ç¤¢¤ì¤Ð¡¢»ä¤«¥á¡¼¥ê¥ó¥°¥ê¥¹¥È
-¤ËÏ¢Íí¤·¤Æ¤¯¤À¤µ¤¤¡£
-
-@item @value{tramp} ¥Õ¥¡¥¤¥ë̾¤Î¥·¥ó¥¿¥Ã¥¯¥¹¤¬ Emacs ¤È XEmacs ¤Ç°ã¤¤¤Þ¤¹¡£
-
-Emacs ¤Î¥á¥ó¥Æ¥Êã¤Ï¡¢¥æ¡¼¥¶¤¬¿·¤·¤¤¥·¥ó¥¿¥Ã¥¯¥¹¤òÊÙ¶¯¤¹¤ëɬÍפ¬¤Ê¤¤¤è
-¤¦¤Ë Ange-FTP ¤È @value{tramp} ¤ÇÅý°ì¤µ¤ì¤¿¥Õ¥¡¥¤¥ë̾¥·¥ó¥¿¥Ã¥¯¥¹¤ò»È¤¤¤¿¤¤
-¤È˾¤ó¤Ç¤¤¤Þ¤¹¡£
-
-XEmacs ¤Î¥á¥ó¥Æ¥Ê¤Ë¤È¤Ã¤Æ¤Ï¡¢Åý°ì¤µ¤ì¤¿¥Õ¥¡¥¤¥ë̾¥·¥ó¥¿¥Ã¥¯¥¹¤òÍѤ¤¤ë
-¤³¤È¤Ë¤è¤ëÍø±×¤è¤ê¤â¤½¤Î¤³¤È¤Ë¤è¤ëÌäÂê¤ÎÊý¤¬Â礭¤¤¤Ç¤¹¡£
-XEmacs ¤Î¥Ñ¥Ã¥±¡¼¥¸¥·¥¹¥Æ¥à¤Ï¥Ñ¥Ã¥±¡¼¥¸¤ò¥À¥¦¥ó¥í¡¼¥É¤¹¤ë¤Î¤Ë EFS ¤ò
-»È¤¤¤Þ¤¹¡£¤·¤¿¤¬¤Ã¤ÆÌÀ¤é¤«¤Ë EFS ¤ÏºÇ½é¤«¤é¥¤¥ó¥¹¥È¡¼¥ë¤µ¤ì¤Æ¤¤¤ë¤Ï¤º
-¤Ç¤¹¡£¤â¤·¥Õ¥¡¥¤¥ë̾¤¬Åý°ì¤µ¤ì¤Æ¤¤¤¿¤È¤¹¤ë¤È¡¢@value{tramp} ¤â¤Þ¤¿ºÇ½é¤«¤é
-¥¤¥ó¥¹¥È¡¼¥ë¤µ¤ì¤Æ¤¤¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¡£
-
-@end itemize
-
-@node Concept Index
-@comment node-name,    next,  previous,      up
-@unnumbered Concept Index
-@printindex cp
-@contents
-@c End of tramp_ja.texi - the TRAMP User Manual
-@bye
-
-@c TODO
-@c
-@c * Say something about the .login and .profile files of the remote
-@c   shells.
-@c * Explain how tramp.el works in principle: open a shell on a remote
-@c   host and then send commands to it.
-@c * Mention that bookmarks are a cool feature to go along with Tramp.
-@c * Make terminology "inline" vs "out-of-band" consistent.
-@c   It seems that "external" is also used instead of "out-of-band".
-
-@c * M. Albinus
-@c ** Use `filename' resp. `file name' consistently.
-@c ** Use `host' resp. `machine' consistently.
-@c ** Consistent small or capitalized words especially in menues.
diff --git a/xemacs-packages/man/xemacs-devel/patcher.texi b/xemacs-packages/man/xemacs-devel/patcher.texi
deleted file mode 100644
index f95c89e7..00000000
--- a/xemacs-packages/man/xemacs-devel/patcher.texi
+++ /dev/null
@@ -1,2000 +0,0 @@
-\input texinfo
-
-@c patcher.texi --- Patcher documentation
-
-@c Copyright (C) 2002, 2003, 2004 Didier Verna.
-
-@c PRCS: $Id: patcher.texi,v 1.13 2005/07/26 14:20:11 didierv Exp $
-
-@c Author:        Didier Verna 
-@c Maintainer:    Didier Verna 
-@c Created:       Sun Apr 21 21:34:06 2002 under XEmacs 21.5 (beta 1)
-@c Last Revision: Tue Aug 31 14:14:48 2004
-
-@c This file is part of Patcher.
-
-@c Patcher is free software; you can redistribute it and/or modify
-@c it under the terms of the GNU General Public License version 2,
-@c as published by the Free Software Foundation.
-
-@c Patcher is distributed in the hope that it will be useful,
-@c but WITHOUT ANY WARRANTY; without even the implied warranty of
-@c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-@c GNU General Public License for more details.
-
-@c You should have received a copy of the GNU General Public License
-@c along with this program; if not, write to the Free Software
-@c Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-
-@c Commentary:
-
-@c Contents management by FCM version 0.1-b2.
-
-@c #### TODO:
-@c - Add a section on how to setup Patcher for PRCS.
-@c   Or better yet: provide default themes from which people would get
-@c   inspiration.
-
-
-@c %** start of header
-@setfilename patcher.info
-@settitle Patcher
-@setchapternewpage odd
-@setcontentsaftertitlepage
-@dircategory Emacs
-@direntry
-* Patcher: (patcher). Automatic archive-based projects maintenance.
-@end direntry
-@c %** end of header
-
-
-@c ====================================================================
-@c Definitions
-@c ====================================================================
-@set VERSION 3.8
-@set COPYRIGHT_DATE 1999, 2000, 2001, 2002, 2003, 2004, 2005
-
-
-@c ====================================================================
-@c Copyright
-@c ====================================================================
-@ifinfo
-This file contains the documentation for Patcher version
-@value{VERSION}, an XEmacs package for automating the maintenance of
-archive-based projects.
-
-Copyright @copyright{} @value{COPYRIGHT_DATE} Didier Verna.
-
-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.
-
-@ignore
-Permission is granted to process this file through TeX and print the
-results, provided the printed document carries a copying permission
-notice identical to this one except for the removal of this paragraph
-(this paragraph not being relevant to the printed manual).
-
-@end ignore
-Permission is granted to copy and distribute modified versions of this
-manual under the conditions for verbatim copying, provided also that the
-sections entitled ``Copying'' and ``GNU General Public License'' are
-included exactly as in the original, and provided that the entire
-resulting derived work is distributed under the terms of a permission
-notice identical to this one.
-
-Permission is granted to copy and distribute translations of this manual
-into another language, under the above conditions for modified versions,
-except that this permission notice may be stated in a translation
-approved by the Free Software Foundation.
-@end ifinfo
-
-
-
-@c ====================================================================
-@c Title Page
-@c ====================================================================
-@titlepage
-@title Patcher
-@subtitle Automatic archive-based projects maintenance from within XEmacs
-@subtitle Version @value{VERSION}
-@author Didier Verna <@email{didier@@xemacs.org}>
-@page
-@vskip 0pt plus 1filll
-Copyright @copyright{} @value{COPYRIGHT_DATE} Didier Verna.
-
-
-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.
-
-Permission is granted to copy and distribute modified versions of this
-manual under the conditions for verbatim copying, provided also that the
-sections entitled ``Copying'' and ``GNU General Public License'' are
-included exactly as in the original, and provided that the entire
-resulting derived work is distributed under the terms of a permission
-notice identical to this one.
-
-Permission is granted to copy and distribute translations of this manual
-into another language, under the above conditions for modified versions,
-except that this permission notice may be stated in a translation
-approved by the Free Software Foundation.
-@end titlepage
-
-
-
-@c ====================================================================
-@c Master menu
-@c ====================================================================
-@ifnottex
-@node Top, Copying, , (dir)
-@comment  node-name,  next,  previous,  up
-@top Patcher
-
-Patcher is an XEmacs package designed to automate and ease the
-maintenance of archive-based projects. It provides assistance in
-building, reporting and committing patches, as well as in handling the
-corresponding ChangeLog entries, for example by creating skeletons.
-
-This info file documents Patcher version @value{VERSION}.
-
-@menu
-* Copying::          The GNU General Public License
-* Introduction::     What Patcher is all about
-* Installation::     How to get and install Patcher
-* Quick Start::      For the brave and the impatient
-* User Manual::      A step-by-step guide to using Patcher
-* Variables Index::
-* Functions Index::
-* Keystrokes Index::
-@end menu
-
-Patcher is developed by Didier Verna @email{didier@@xemacs.org}.
-
-@end ifnottex
-
-
-
-@c ====================================================================
-@c Copying
-@c ====================================================================
-@node Copying, Introduction, Top, Top
-@comment  node-name,  next,  previous,  up
-@unnumbered Copying
-
-Patcher 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 Software Foundation.
-
-Patcher 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.
-
-
-
-@c ====================================================================
-@c Introduction
-@c ====================================================================
-@node Introduction, Installation, Copying, Top
-@comment  node-name,  next,  previous,  up
-@chapter Introduction
-
-When a project becomes important in size, or when the development is
-performed cooperatively by several people across the Internet, it is a
-common practice to help maintaining it by using a development control
-system. Such tools (CVS, PRCS, to name a few) usually work by
-maintaining a centralized project archive (also called a repository)
-that keeps track of the history of the changes, lets you develop
-different ``branches'' at the same time and perform operations like
-merges between these different project branches.
-
-In such ``archive-based'' maintenance models, making the project evolve
-usually involves repeatedly the same few steps, some of which can be
-tedious: you work on your local copy of the project; once you're
-satisfied with your changes, you create a patch by diffing your local
-copy against the project's archive; then (or progressively), you
-construct the ChangeLog entries. Finally, you propose your changes by
-sending a mail to the developers list with your patch and the ChangeLog
-entries included, hoping that your proposition will be accepted. If
-you're one of the maintainers, you will still probably send the message
-to the list, simply announcing the modification, and immediately commit
-the patch with an informative log message.
-
-Patcher is an XEmacs package designed to automate this process. Patcher
-can't work on the project for you. However, as soon as you give it some
-basic knowledge on the project structure and repository, it can
-automatically build a patch by comparing your local copy with the
-repository, create ChangeLog entries, prepare a mail announcing the
-changes, and even commit the patch for you with a informative log
-message. All of this is done in just a few keystrokes. Additionally,
-Patcher can perform some sanity checks, like verifying that your local
-copy is up-to-date, that you did not forget some ChangeLog entries, that
-the commit operation went well and so on.
-
-If you're brave and impatient, and want to start using the basics of
-Patcher as soon as possible, see @ref{Quick Start}. It is recommended to
-read it anyway, since it gives an overview of how Patcher works. If you
-know the basics and want a more detailed guide, see @ref{User Manual}.
-
-Enjoy using Patcher !
-
-
-
-@c ====================================================================
-@c Installation
-@c ====================================================================
-@node Installation, Quick Start, Introduction, Top
-@comment  node-name,  next,  previous,  up
-@chapter Installation
-
-@menu
-* Distribution::                How to get Patcher
-* Requirements::                What you need to get Patcher running
-* Insinuation::                 How to plug Patcher into other libraries
-@end menu
-
-
-@c Distribution =======================================================
-@node Distribution, Requirements, , Installation
-@comment  node-name,  next,  previous,  up
-@section Distribution
-
-Patcher is available either as a standalone package, or as part of the
-standard @file{xemacs-devel} XEmacs package.
-
-You can get @file{xemacs-devel} in three different ways:
-@itemize @bullet
-@item
-You can install @file{xemacs-devel} from within XEmacs via the package
-user interface (accessible from the @samp{Tools} menu or via @kbd{M-x
-list-packages}).
-
-@item
-You can also download the @file{xemacs-devel--pkg.tar.gz}
-tarball from @uref{ftp://ftp.xemacs.org/pub/xemacs/packages/}, and
-unpack it where you put the other packages.
-
-@item
-@file{xemacs-devel} sources are available from the XEmacs CVS
-repository. The module name is @samp{xemacs-devel}. See
-@uref{http://www.xemacs.org/Develop/cvsaccess.html} for more information
-about the XEmacs CVS repository.
-@end itemize
-
-
-I also provide Patcher as a standalone package. This is mainly for my
-personal usage (when developing and debugging new versions) but you
-might want to use it if you're not interested in the rest of
-@file{xemacs-devel}. The standalone version of Patcher can be found at
-@uref{http://www.lrde.epita.fr/~didier/comp/development/software.php}.
-You will also find different inlined versions of this documentation at
-that place. For installation instructions, please read the
-@file{INSTALL} file.
-
-
-@c Requirements =======================================================
-@node Requirements, Insinuation, Distribution, Installation
-@comment  node-name,  next,  previous,  up
-@section Requirements
-
-Patcher currently works only with XEmacs 21.4 or later. I'm not sure it
-works with earlier versions of XEmacs, but I'm sure it does @strong{not}
-work with GNU Emacs (see below).
-
-Patcher might also have some other requirements, depending on how you use
-it:
-
-@itemize @bullet
-@item
-If you let Patcher create ChangeLogs for you (@pxref{ChangeLogs
-Handling}), you will need the @file{add-log} library from the
-@file{xemacs-base} package, version 1.48 or later, installed on your
-system. That's actually the may reason for Patcher not being able to run
-in GNU Emacs, though I have not tried to port it yet.
-
-@item
-If you want to send mails from Patcher (@pxref{Mail Methods}), you will
-need a mail user agent. Patcher currently supports @file{sendmail},
-@file{message} and @file{Gnus} natively and through the
-@file{compose-mail} interface. Other MUA might be partly supported when
-used with @code{compose-mail}. Patcher will probably suffer from non
-critical deficiencies in that case however (it will issue warnings).
-@end itemize
-
-
-@c Insinuation ========================================================
-@node Insinuation, , Requirements, Installation
-@comment  node-name,  next,  previous,  up
-@section Insinuation
-
-With a proper installation of Patcher (either way), you don't need any
-special trickery in your @file{.emacs} file because all entry points to
-the library should be autoloaded.
-
-However, Patcher has the ability to hook into external libraries, but
-won't do so unless requested. Currently, Patcher has hooks for Gnus
-only. If you're using Gnus as your MUA, you might want to add the
-following line to your @file{gnusrc} file:
-
-@example
-(patcher-insinuate-gnus)
-@end example
-
-This will add some facilities described along the text.
-
-
-
-@c ====================================================================
-@c Quick Start
-@c ====================================================================
-@node Quick Start, User Manual, Installation, Top
-@comment  node-name,  next,  previous,  up
-@chapter Quick Start
-
-In this chapter, we quickly setup the basic Patcher configuration for
-hacking on XEmacs. Adapt the example as you wish. Let's make some
-assumptions first:
-
-@itemize @bullet
-@item
-You own a computer.
-
-@item
-You have the @file{add-log} library from the @file{xemacs-base} package,
-version 1.48 or later, installed on your system.
-
-@item
-You're using XEmacs from the CVS repository.
-
-@item
-Your local copy of the repository is located in
-@file{/usr/local/src/XEmacs-21.5}.
-
-@item
-Your local copy of the repository is up-to-date, but you've done some
-hacking in the sources that you'd like to submit.
-
-@item
-Since you're lazy, you didn't write the ChangeLog entries yet.
-@end itemize
-
-
-@menu
-* Setting up Patcher::     Making Patcher aware of your project
-* Calling Patcher::        Preparing a patch and a message
-* Filling the ChangeLogs:: Patcher only creates skeletons
-* Filling the Message::    You should insert the ChangeLog entries
-* Committing the Patch::   Applying your modifications to the archive
-* Sending the Message::    Telling people about your modifications
-@end menu
-
-
-@c The Project Descriptor =============================================
-@node Setting up Patcher, Calling Patcher, Quick Start, Quick Start
-@comment  node-name,  next,  previous,  up
-@section Setting up Patcher
-
-The first thing to do is to make patcher aware of your ``XEmacs''
-project. Put this in your @file{.emacs} file:
-
-@lisp
-(setq patcher-projects
-      '(("XEmacs" "/usr/local/src/XEmacs-21.5"
-         :to-address "xemacs-patches@@xemacs.org")
-        ))
-@end lisp
-
-@vindex patcher-projects
-As you can imagine, @code{patcher-projects} is a user option in which
-you store information about the projects you want to manage with
-Patcher. It is actually a list of what's called @dfn{project
-descriptors}. Here's the meaning of the only project descriptor we have
-in the example above: we have a project named ``XEmacs'', located in
-@file{/usr/local/src/XEmacs-21.5} and for which emails should be sent to
-@email{xemacs-patches@@xemacs.org}.
-
-Note the particular syntax for specifying the mailing address. This is
-what's called a @dfn{project option}. Contrary to the project's name and
-directory, which are mandatory and always appear as the first and second
-elements of a project descriptor, project options are optional and can
-appear in any order.
-
-
-@c Calling Patcher ====================================================
-@node Calling Patcher, Filling the ChangeLogs, Setting up Patcher, Quick Start
-@comment  node-name,  next,  previous,  up
-@section Calling Patcher
-
-Now you want to build a patch with your changes, and prepare a message
-to submit them. The way Patcher works is currently to setup the message
-first, and then to control all subsequent operations from there. In
-other words, to create a patch, you actually ask Patcher to prepare a
-mail. Type this:
-
-@lisp
-M-x patcher-mail
-@end lisp
-
-@findex patcher-mail
-First, you're prompted (with completion) for a project name (the first
-element of each project descriptor, remember ?). We currently only have
-an ``XEmacs'' project, so hitting @kbd{TAB} will directly fill the
-minibuffer in with this only choice. Then, you're prompted for a subject
-line that will be used in the mail. Say something sensible.
-
-Three operations are now executed in turn:
-
-@enumerate
-@item
-@vindex patcher-default-to-address
-@vindex :to-address
-Patcher prepares a mail buffer. The message will be sent to the address
-you specified with the @code{:to-address} project option, and the
-subject line now reads ``[PATCH] something sensible''.
-
-@item
-Patcher now builds the patch. The command used to do this is @samp{cvs
--q diff -u} (this is also a project option). Upon successful completion
-of this command (we assume that's indeed the case), the patch is
-inserted into the mail buffer. Some information about the patch is
-provided just above it (the command used, the files affected and so on).
-
-@item
-Finally, Patcher generates ChangeLog skeletons from what it understands
-of the patch. This involves visiting the appropriate ChangeLog files,
-and creating initial entries.
-@end enumerate
-
-
-@c Filling the ChangeLogs =============================================
-@node Filling the ChangeLogs, Filling the Message, Calling Patcher, Quick Start
-@comment  node-name,  next,  previous,  up
-@section Filling the ChangeLogs
-
-Patcher has just created initial ChangeLog entries for you. You must now
-browse through the ChangeLog file(s) and fill the entries as you see
-fit. Once you're done, you can very well save the ChangeLog buffers.
-However, don't kill them ! Don't even think about it. Patcher still
-needs them. Now, please return to the mail buffer.
-
-
-@c Inserting the ChangeLog entries ====================================
-@node Filling the Message, Committing the Patch, Filling the ChangeLogs, Quick Start
-@comment  node-name,  next,  previous,  up
-@section Filling the message
-
-Now that you're satisfied with your ChangeLog entries and you've
-returned to the mail buffer, you want to write some explanation text in
-the message. I'll let you do that. You also want to insert the ChangeLog
-entries corresponding to your patch, since they are usually much more
-readable than the patch itself.
-
-@findex patcher-insert-change-logs
-@kindex C-c C-p i
-Inserting your ChangeLog entries in the mail buffer is as simple as
-typing @samp{C-c C-p i}. This actually calls the function
-@code{patcher-insert-change-logs}, which places them just above the
-patch, with a short information line (per ChangeLog file) on top.
-
-
-@c Committing the Patch ===============================================
-@node Committing the Patch, Sending the Message, Filling the Message, Quick Start
-@comment  node-name,  next,  previous,  up
-@section Committing the Patch
-
-If you have commit access to your project, you should read this.
-Otherwise, you may directly see @ref{Sending the Message}.
-
-Committing your changes involves three steps: preparing the commit
-command, preparing the commit log message, and actually committing the
-changes. Although Patcher can do all of this in one shot, it lets you
-control each step by default.
-
-@findex patcher-commit-change
-@kindex C-c C-p c
-In order to start the commit process, simply type @samp{C-c C-p c}. This
-calls the function @code{patcher-commit-change}. Congratulations. You've
-just been transported to a new buffer, the @code{*Patcher Log Message*}
-buffer. This buffer lets you edit the log message that will accompany
-your commit. Note that the message is initialized with the subject line
-of your mail. This is also a project option.
-
-@findex patcher-logmsg-commit
-@kindex C-c C-c
-Once you're satisfied with the log message, type @samp{C-c C-c}. This
-calls the function @code{patcher-logmsg-commit}, which computes the
-commit command to use. The command is displayed in a special buffer, the
-@code{*Patcher Commit Command*} buffer. The default commit command is
-@samp{cvs commit}, which of course is also a project option. Note that
-Patcher stores the log message in a temporary file and uses the
-@option{-F} @kbd{cvs commit} option. Finally, note that Patcher has
-automatically appended the affected ChangeLog files to the commit
-command.
-
-At this point, you have the opportunity to abort the commit operation.
-Otherwise, answer positively and the commit will be executed. If you had
-not previously saved the ChangeLog files, Patcher will do it for you
-just before committing.
-
-
-@c Sending the Message ================================================
-@node Sending the Message, , Committing the Patch, Quick Start
-@comment  node-name,  next,  previous,  up
-@section Sending the Message
-
-Sending the message has actually nothing to do with Patcher. It depends
-on the method you use for sending mails, but will usually be done via a
-@samp{C-c C-c} command of some sort. On thing to note however: if you've
-committed your changes via Patcher, the message has been slightly
-modified: the subject line now reads ``[COMMIT] something sensible''
-instead of ``[PATCH] @dots{}'', and a short commit notice has been
-inserted just at the beginning of the message's body.
-
-That's it. That was easy. Congratulations on your first shot at Patcher,
-anyway ! Of course, Patcher is much more powerful and customizable than
-what has been described in this chapter. For a complete documentation on
-how to use and customize Patcher, please refer to @ref{User Manual}.
-
-
-
-@c ====================================================================
-@c User Manual
-@c ====================================================================
-@node User Manual, Variables Index, Quick Start, Top
-@comment  node-name,  next,  previous,  up
-@chapter User Manual
-
-This chapter provides a step-by-step guide to using Patcher. Everything
-there is to know about Patcher is here, though the features are
-introduced progressively.
-
-All user options that are going to be presented in this manual can be
-found in the @code{patcher} customization group, or a subgroup of it.
-
-@menu
-* Project Descriptors::  The project specification mechanism
-* Mail Preparation::     Customizing Patcher messages
-* Patch Generation::     Specifying how a patch is to be constructed
-* ChangeLogs Handling::  How Patcher behaves with respect to ChangeLogs
-* Project Check In::     Committing your changes from Patcher
-* Mail Sending::         Sending the message and cleaning up the place
-* More On Commands::     Error handling and other generalities
-* More On Subprojects::  Defining permanent subprojects
-@end menu
-
-@ignore
-The manual is currently organized in a rather sequential way: one
-chapter for source patches, one for ChangeLogs. This might not be the
-best way to do it. Another way is to split the information in terms of
-patch/ChangeLog creation, and Patch/ChangeLog appearance in messages.
-@end ignore
-
-@c Project Descriptors ================================================
-@node Project Descriptors, Mail Preparation, User Manual, User Manual
-@comment  node-name,  next,  previous,  up
-@section Project Descriptors
-
-@vindex patcher-projects
-Projects specifications are stored in @code{patcher-projects}. This user
-option is actually a list of @dfn{project descriptors}. Each project
-descriptor has the following form: @samp{(@var{NAME} @var{DIR}
-@var{:OPTION} @var{VALUE} @dots{})}
-
-@vindex patcher-default-to-address
-@vindex :to-address
-@var{NAME} is a string naming your project, @var{DIR} is a string
-specifying the directory in which it resides. The remainder of a project
-descriptor is a sequence of zero or more option/value pairs, that we
-call @dfn{project options}. All option names start with a colon. The
-type of a value depends on the corresponding option. For example, there
-is a project option named @code{:to-address}, whose value should be a
-string giving the email address to which you want to send Patcher
-messages.
-
-When Patcher needs the value for a particular project option, it looks
-for it directly in the project descriptor, but also in other places.
-This process is described below.
-
-@menu
-* Themes::                 Collections of options
-* Project inheritance::    Getting options from other projects
-* Fallbacks::              Default values for project options
-* Retrieval::              The process of getting an option's value
-* Inheritance or theme ?:: The proper way to factor out option values
-@end menu
-
-@node Themes, Project inheritance, , Project Descriptors
-@comment  node-name,  next,  previous,  up
-@subsection Themes
-
-If you have several projects sharing the same option set, you might want
-to setup a theme. Themes are named collections of project options.
-
-@vindex patcher-themes
-Themes are stored in the @code{patcher-themes} user option. This option
-is a list of themes. Each theme has the following form:
-@samp{(@var{NAME} @var{:OPTION} @var{VALUE} @dots{})}.
-
-@var{NAME} is the theme's name (a symbol). The remainder of the list is
-a sequence of zero or more option/value pairs, just like in project
-descriptors.
-
-@vindex patcher-default-themes
-@vindex :themes
-In order to use a theme in a given project, a @code{:themes} project
-option is provided. It is a list of theme names (symbols). Use this
-option in your project descriptor, and the project will implicitly
-inherit all options from the corresponding theme.
-
-One important note: as @code{:themes} is a project option, it can appear
-in a theme. In other words, themes can inherit from other themes. When
-Patcher tries to retrieve an option, the themes tree is traversed in
-depth first.
-
-@vindex patcher-max-theme-depth
-Because themes can contain themes, a bogus setting might lead to an
-infinite loop (a cycle in a theme graph). To prevent this, the
-@code{patcher-max-theme-depth} user option is provided. It represents
-the expected maximum theme nesting level, and defaults to 8.
-
-
-@node Project inheritance, Fallbacks, Themes, Project Descriptors
-@comment  node-name,  next,  previous,  up
-@subsection Project inheritance
-
-When two projects are very similar, you might want to use the project
-inheritance mechanism described below.
-
-@vindex :inheritance
-There is a special project option called @code{:inheritance}. This
-option must be a list of project names (strings). The inheritance of a
-project defines a list of projects from which to inherit options.
-
-One important note: inherited projects might have their own
-@code{:inheritance} option set to other projects in turn. In other
-words, the project inheritance can be more than one level deep. When
-Patcher tries to retrieve an option, the inheritance tree is traversed
-in depth first.
-
-@vindex patcher-max-inheritance-depth
-Because inherited projects can inherit from projects, a bogus setting
-might lead to an infinite loop (a cycle in a project graph). To prevent
-this, the @code{patcher-max-inheritance-depth} user option is provided.
-It represents the expected maximum project inheritance level, and
-defaults to 8.
-
-The @code{:inheritance} project option is somewhat special in the sense
-that it can't appear in a theme. We will encounter other exceptions
-later in this manual.
-
-
-@node Fallbacks, Retrieval, Project inheritance, Project Descriptors
-@comment  node-name,  next,  previous,  up
-@subsection Fallbacks
-
-@vindex patcher-default-to-address
-@vindex :to-address
-For each existing project option, Patcher also has a @dfn{fallback} user
-option with a default value that would be shared among all (or some of)
-your projects. The name of the fallback is obtained by replacing the
-colon in the project option's name with the prefix
-@code{patcher-default-}. For example, the fallback corresponding to the
-@code{:to-address} project option is named
-@code{patcher-default-to-address}.
-
-The @code{:inheritance} project option is also special in the sense that
-it doesn't have a corresponding fallback. We will encounter other
-exceptions later in this manual.
-
-In the remainder of this manual, we will rarely mention the fallbacks
-again. When we introduce a new project option, just remember that it
-always has a corresponding fallback (well, not always, as you just
-discovered).
-
-
-@node Retrieval, Inheritance or theme ?, Fallbacks, Project Descriptors
-@comment  node-name,  next,  previous,  up
-@subsection Retrieval
-
-When Patcher needs the value of a particular project option, it looks
-for it in the following manner:
-
-@itemize @bullet
-@item
-First, it looks directly in the project descriptor to see if the option
-is given.
-
-@item
-@vindex patcher-default-themes
-@vindex :themes
-@vindex patcher-themes
-If that fails, it next tries the given themes, if any. This involves
-recursively traversing the project's themes tree. Options successfully
-retrieved in themes are said to be @dfn{themed}.
-
-@item
-@vindex :inheritance
-If that still fails, it then tries the inherited projects, if any. This
-involves recursively traversing the project's inheritance tree. Options
-successfully retrieved in inherited projects are said to be
-@dfn{inherited}. Note that in turn, such options could have been
-actually themed in the inherited project.
-
-@item
-If that fails again, it finally falls back to the value given in the
-corresponding fallback (if it exists). In such a case, the option is
-said to be @dfn{fallbacked}.
-@end itemize
-
-Note that a value of @code{nil} for a project option @strong{is an
-actual value}. It is not equivalent to an option being unset. As a
-consequence, if Patcher finds a project option with a value of
-@code{nil} somewhere, it will use it and stop the search, even if a non
-nil value could be retrieved later from a theme, an inherited project or
-a fallback. This provides you with a way to annihilate themed,
-inherited or fallbacked options.
-
-
-@node Inheritance or theme ?, , Retrieval, Project Descriptors
-@comment  node-name,  next,  previous,  up
-@subsection Inheritance or theme ?
-
-At that point, you might be wondering why the themes and inheritance
-concepts were both designed, since they actually perform very similar
-tasks. Good question. Here is a good answer.
-
-Projects might share options for different reasons. For example, my
-``XEmacs'' (source) and ``XEmacs Packages'' projects share many options
-(@code{To:} address, @code{From:} address, diff and commit commands and
-so on) because they both relate to XEmacs. On the other hand I have
-personal but totally unrelated projects that share the same commands
-because they are all handled through a local PRCS archive.
-
-In other words, you should rather use the inheritance mechanism when
-projects relate to each other, and the theme mechanism for settings that
-are orthogonal the projects they apply to.
-
-
-
-@c Mail Preparation ===================================================
-@node Mail Preparation, Patch Generation, Project Descriptors, User Manual
-@comment  node-name,  next,  previous,  up
-@section Mail Preparation
-
-Patcher currently uses the mail buffers as ``master'' buffers for
-controlling all operations: building a patch, creating the ChangeLog
-entries, committing@dots{} all is done from the mail buffer. Note
-however that you don't need to actually send mails to use Patcher
-(@pxref{Fake Mail Method}).
-
-To use Patcher on a certain project, you start by preparing a (possibly
-fake) mail. There are several ways to do so: you could start a brand new
-message, ``adapt'' a message already in preparation to Patcher, or even
-compose some sort of a Patcher reply to another message.
-
-@defun patcher-mail
-Start composing a brand new Patcher message. This function interactively
-prompts you for the name of the project and for a (mail) subject line.
-@end defun
-
-@defun patcher-mail-adapt
-Assuming that you are already editing a message (with your usual MUA),
-this function ``adapts'' it to Patcher by prompting you for the name of
-a project. Note that this function does @emph{not} prompt you for a
-subject.
-@end defun
-
-If you're using Gnus to read mail and have properly insinuated it
-(@pxref{Insinuation}), Patcher offers different Gnus-like ways to answer
-mails and adapt them to Patcher. All the functions below are available
-from both the Gnus Summary and the Article buffer.
-
-@defun patcher-gnus-summary-followup
-@kindex C-c C-p f
-Compose a followup to the article, and adapt it to Patcher. This
-function is bound to @kbd{C-c C-p f}.
-@end defun
-
-@defun patcher-gnus-summary-followup-with-original
-@kindex C-c C-p F
-Idem, but also cite the original article. This function is bound to
-@kbd{C-c C-p F}.
-@end defun
-
-@defun patcher-gnus-summary-reply
-@kindex C-c C-p r
-Like @code{patcher-gnus-summary-followup}, but compose a reply. This
-function is bound to @kbd{C-c C-p r}.
-@end defun
-
-@defun patcher-gnus-summary-reply-with-original
-@kindex C-c C-p R
-Idem, but also cite the original article. This function is bound to
-@kbd{C-c C-p R}.
-@end defun
-
-
-In any case, Patcher starts working on the project (by first creating
-the patch) after the message is prepared. Because of this, we'll start
-by reviewing the mail-related customizations you might want to setup.
-
-@menu
-* Mail Methods::          Using a particular mailer
-* Message Customization:: Specifying initial contents for messages
-@end menu
-
-@node Mail Methods, Message Customization, Mail Preparation, Mail Preparation
-@comment  node-name,  next,  previous,  up
-@subsection Mail Methods
-
-@vindex patcher-default-mail-method
-@vindex :mail-method
-Since there are different mail packages working in XEmacs, Patcher
-supports different methods for preparing messages. You can specify the
-method you prefer in the @code{:mail-method} project option. The value
-must be a symbol.
-
-@menu
-* Standard Mail Methods:: Patcher supports standard mail packages
-* Fake Mail Method::      Patcher supports not sending mails
-* Other Mail Methods::    Patcher supports everything
-@end menu
-
-@node Standard Mail Methods, Fake Mail Method, Mail Methods, Mail Methods
-@comment  node-name,  next,  previous,  up
-@subsubsection Standard Mail Methods
-
-Patcher currently supports @file{sendmail}, @file{message} and
-@file{Gnus} natively and through the @file{compose-mail} interface.
-Other MUA might be partly supported when used with @code{compose-mail}.
-Patcher will probably suffer from non critical deficiencies in that case
-however (it will issue warnings).
-
-@table @code
-@item compose-mail
-@findex compose-mail
-@findex patcher-mail-compose-mail
-@vindex mail-user-agent
-This is the default. It is implemented via the function
-@code{patcher-mail-compose-mail} which calls @code{compose-mail} to
-prepare the message. If you are not familiar with @samp{compose-mail},
-you might also want to throw an eye to the user option
-@code{mail-user-agent}. If your project does not specify an address to
-send the message to (@pxref{Message Customization}), it is prompted for.
-
-@item sendmail
-@findex mail
-@findex patcher-mail-sendmail
-A direct interface to the @code{mail} function from the @code{sendmail}
-package. It is implemented via the function
-@code{patcher-mail-sendmail}. If your project does not specify an
-address to send the message to (@pxref{Message Customization}), it is
-prompted for.
-
-@item message
-@findex message-mail
-@findex patcher-mail-message
-A direct interface to the @code{message-mail} function from the
-@code{message} library (it is part of @code{Gnus}). It is implemented
-via the function @code{patcher-mail-message}. If your project does not
-specify an address to send the message to (@pxref{Message
-Customization}), it is prompted for.
-
-@item gnus
-@findex gnus-post-news
-@findex patcher-mail-gnus
-A direct interface to the @code{gnus-post-news} function from the
-@code{Gnus} package (it can also send mails@dots{}). It is implemented
-via the function @code{patcher-mail-gnus}. This mail method is
-interesting when you maintain a special mail group for messages that you
-send with Patcher, most probably because they are sent to some
-mailing-list, such as @email{xemacs-patches@@xemacs.org}.
-
-@vindex patcher-default-gnus-group
-@vindex :gnus-group
-This method uses a Gnus group name and acts as if you had type @samp{C-u
-a} on that group in the @code{*Group*} buffer, hence honoring the group
-parameters and posting-styles. If your project does not specify a Gnus
-group name (@pxref{Message Customization}), it is prompted for.
-@end table
-
-This last mail method is special in the sense that it requires a running
-Gnus session to work. If that's needed, Patcher can start Gnus for you
-in several ways, according to the following user options:
-
-@table @code
-@item patcher-mail-run-gnus
-@vindex patcher-mail-run-gnus
-If @code{nil}, Patcher will never start Gnus and abort the operation
-instead. If @code{t}, Patcher will always start Gnus when needed. If
-@code{'prompt}, Patcher will ask you what (you want) to do. This is the
-default behavior.
-
-@item patcher-mail-run-gnus-other-frame
-@vindex patcher-mail-run-gnus-other-frame
-Used when Patcher has to start Gnus by itself. If @code{nil}, continue
-using the current frame. If @code{t}, start Gnus in another frame (this
-is the default). If @code{'follow}, start Gnus in another frame, and use
-this new frame to prepare the Patcher mail.
-@end table
-
-@node Fake Mail Method, Other Mail Methods, Standard Mail Methods, Mail Methods
-@comment  node-name,  next,  previous,  up
-@subsubsection Fake Mail Method
-
-@findex patcher-mail-fake
-At that point, you might be wondering why the mail method is a project
-option and not simply a user option, since you probably only use one
-mail agent at all. Right. But you might one day work on projects for
-which you don't need to send messages at all. This could happen if you
-start using Patcher on a project of your own for instance. For that
-reason, there is a @code{fake} mail method available. It is implemented
-via the @code{patcher-mail-fake} function and calls no particular mail
-user agent. Once you type @samp{C-c C-c} to virtually send the fake
-message, it only performs some cleanup.
-
-All right. But did we really need this fake method ? I mean, one could
-use the usual mail method, and simply not send the message in the end.
-Huh, yeah, ok@dots{} Actually, it is very probable that in a future
-release of Patcher, the mail buffer won't be the master buffer anymore,
-and mail sending will be just another optional step in the process. In
-that case, the mail method is likely to move away from project option
-to standard user option.
-
-@node Other Mail Methods, , Fake Mail Method, Mail Methods
-@comment  node-name,  next,  previous,  up
-@subsubsection Other Mail Methods
-
-@vindex patcher-default-mail-method
-@vindex :mail-method
-If you're not satisfied with the provided mail methods (want a @code{vm}
-one ?), you can provide your own, more or less. Here's what to do: set
-your @code{:mail-method} project option to, say, @code{foo}, and write
-your own function which must be named @code{patcher-mail-foo}.
-
-This function must take two arguments (a project descriptor and a string
-containing the subject of the message), and prepare a mail buffer. If
-you want to do this, you should see how it's done for the built-in
-methods.
-
-Note that the mail adaptation facility won't be available for your
-custom method. For that, I would have to hack the internals of Patcher.
-
-
-@node Message Customization, , Mail Methods, Mail Preparation
-@comment  node-name,  next,  previous,  up
-@subsection Message Customization
-
-When preparing a message, Patcher can fill some parts of it for you.
-Here's a list of mail-related project options.
-
-@table @code
-@item :user-name
-@vindex patcher-default-user-name
-@vindex :user-name
-The name (your name) to use when composing the message. It will affect
-the @code{From:} header. This option is used by all mail methods but
-@code{fake}. If not given, @code{user-full-name} is used.
-
-@item :user-mail
-@vindex patcher-default-user-mail
-@vindex :user-mail
-The mail (your mail) address to use when composing the message. It will
-affect the @code{From:} header. This option is used by all mail methods but
-@code{fake}. If not given, @code{user-mail-address} is used.
-
-@item :to-address
-@vindex patcher-default-to-address
-@vindex :to-address
-The address to send messages to (a string). This option is used by all
-mail methods but @code{gnus} and @code{fake}. If not given, it is
-prompted for when calling @code{patcher-mail}.
-
-@item :gnus-group
-@vindex patcher-default-gnus-group
-@vindex :gnus-group
-The Gnus group name to use for posting messages (a string). This option
-is used only by the @code{gnus} mail method. If not given, it is
-prompted for when calling @code{patcher-mail}.
-
-Note that if you configured your name and mail in Gnus, for instance
-through posting styles, these configurations take precedence over the
-corresponding Patcher options.
-
-@item :subject-prefix
-@vindex patcher-default-subject-prefix
-@vindex :subject-prefix
-A prefix for the subject line of messages. It can be @code{nil} or a
-string. By default, ``[PATCH]'' is used. This part of subjects is never
-prompted for. A @samp{%n} occurring in this string will be replaced with
-the project name. Also, a space is inserted between the prefix and the
-remainder of the subject, when appropriate.
-
-@item :subject
-@vindex patcher-default-subject
-@vindex :subject
-A default value for prompted subjects (a string). A @samp{%n} occurring
-in this string will be replaced with the project's name
-(@pxref{Subproject Naming}). Please note that this is used @strong{only}
-to provide a default value for prompted subjects. Subjects are
-@strong{always} prompted for.
-
-@item :mail-prologue
-A prologue to insert just at the top of a message body (a string).
-@end table
-
-@c Patch Generation ===================================================
-@node Patch Generation, ChangeLogs Handling, Mail Preparation, User Manual
-@comment  node-name,  next,  previous,  up
-@section Patch Generation
-
-Patcher creates patches by diffing your local copy of the project
-against the repository. This is done automatically after preparing a
-message, so you shouldn't normally bother to do it manually. That
-situation might still happen from time to time, like, if you further
-modify the sources, or if the initial operation failed for some reason
-(@pxref{More On Commands}).
-
-@findex patcher-generate-diff
-@kindex C-c C-p d
-The way to (re)generate the patch manually is to call
-@code{patcher-generate-diff} from the mail buffer. This function is
-bound to @samp{C-c C-p d} in this buffer. You can both customize the
-diff command used to (re)generate the patch, and restrict the diff to a
-subset of the project's files.
-
-When possible, Patcher also tries to check that your project is
-up-to-date with respect to the archive, and will inform you otherwise.
-
-@menu
-* Diff Command::        Specifying the command to generate the patch
-* After Diff Hook::     Tweaking the diff output
-* Diff Line Filter::    Omitting lines from the diff output
-* Patch Restriction::   Specifying the files affected by the patch
-* Patcher Instances::   You can have several instances of Patcher
-* Diff Prologue::       A header is inserted above the patch
-@end menu
-
-By the way, (re)generating the patch does not necessarily mean that it
-is directly inserted into the mail buffer. This also depends on the
-ChangeLogs behavior (@pxref{ChangeLogs Handling}).
-
-@node Diff Command, After Diff Hook, Patch Generation, Patch Generation
-@comment  node-name,  next,  previous,  up
-@subsection Diff Command
-
-@vindex patcher-default-diff-command
-@vindex :diff-command
-@findex patcher-mail
-The diff command used to generate the patch is specified by the
-@code{:diff-command} project option. By default, the command used is
-@samp{cvs -q diff -u}. You can also punctually change this command by
-calling @code{patcher-mail} or @code{patcher-generate-diff} with a
-prefix argument. Patcher will then prompt you for a new command and use
-it exclusively for this particular patch.
-
-For detail about the format of this option, see @ref{Patch Restriction}.
-See also @ref{More On Commands}.
-
-
-@node After Diff Hook, Diff Line Filter, Diff Command, Patch Generation
-@comment  node-name,  next,  previous,  up
-@subsection After Diff Hook
-
-Sometimes, you might want to tweak a little the diff output before doing
-anything with it, for instance, before generating ChangeLog skeletons
-(@pxref{ChangeLogs Handling}), or simply inserting it into the mail
-buffer.
-
-@vindex patcher-default-after-diff-hook
-@vindex :after-diff-hook
-In order to do that, you might want to use the @code{:after-diff-hook}
-project option. It should be a list of function names (symbols) that
-will be called after each diff output. Each function should take two
-optional arguments delimiting a region to process (no arguments means
-process the whole buffer) and work in the current buffer. The point is
-originally placed at the beginning of the region, and the buffer
-excursion is saved for you.
-
-@findex patcher-prcs-diff-convert
-Note: Patcher provides a special function named
-@code{patcher-prcs-diff-convert} that can be used in this hook in order
-to convert PRCS diff output to a traditional one.
-
-
-@node Diff Line Filter, Patch Restriction, After Diff Hook, Patch Generation
-@comment  node-name,  next,  previous,  up
-@subsection Diff Line Filter
-When generating a global diff, that is, without specifying the files
-affected by the patch explicitly (@pxref{Patch Restriction}), some
-uninformative lines might be present in the output. A typical example is
-files present in your local copy but unknown to the CVS server. Such
-files are indicated by a question mark in diff outputs.
-
-@vindex patcher-default-diff-line-filter
-@vindex :diff-line-filter
-Patcher has a project option named @code{:diff-line-filter} that lets
-filter out such unwanted lines when inserting the diff in the mail
-buffer. This must be a regular expression matching a whole line. Caution
-however: do not put beginning or end of lines markers in your regexp.
-Patcher will do it for you.
-
-By default, the value is @code{"\\? .*"}, which excludes files unknown
-to the CVS server.
-
-@node Patch Restriction, Patcher Instances, Diff Line Filter, Patch Generation
-@comment  node-name,  next,  previous,  up
-@subsection Patch Restriction
-
-Sometimes, you don't want to generate a global patch, but instead work
-on a subset of the project's files. Patcher understands this concept as
-working on a @dfn{subproject}.
-
-As for working on whole projects, there are several alternatives to
-start working on a subproject:
-
-@defun patcher-mail-subproject
-@findex patcher-mail
-This function behaves exactly like @code{patcher-mail}, except that it
-also prompts you for the files affected by the patch. You can specify
-files as well as directories, use wildcards, just as you would construct
-a command line diff.
-@end defun
-
-@defun patcher-mail-adapt-subproject
-@findex patcher-mail-adapt
-Idem, with respect to @code{patcher-mail-adapt}.
-@end defun
-
-@findex patcher-gnus-summary-followup
-@findex patcher-gnus-summary-followup-with-original
-@findex patcher-gnus-summary-reply
-@findex patcher-gnus-summary-reply-with-original
-Finally, all the Gnus-specific reply functions (@pxref{Mail
-Preparation}) take an optional prefix argument that make them work on
-subprojects.
-
-
-Two important things are to be kept in mind when working on subprojects:
-@itemize @bullet
-@item
-It is not necessary (it is even forbidden) to specify the ChangeLog
-files. Patcher will automatically find them for you. In other words,
-only specify source files, not ChangeLog files.
-
-@item
-@findex patcher-mail
-@findex patcher-mail-subproject
-@findex patcher-generate-diff
-Don't mistake the prefix argument of @code{patcher-mail},
-@code{patcher-mail-subproject} and @code{patcher-generate-diff} as a way
-to specify files. It is not meant for that. It is meant only to
-temporarily modify the diff command itself, not the files to which it
-applies.
-@end itemize
-
-@vindex patcher-default-diff-command
-@vindex :diff-command
-When working on a subproject, Patcher uses the same diff command as the
-one used for the whole project, that is, the value of the
-@code{:diff-command} project option. In the case of a subproject
-however, Patcher has to know where to put the files on the command line
-(even if it's usually the last part of it). This is done with the special
-construct @samp{%f}: a @samp{%f} appearing in the diff command will be
-replaced with the specified files (and the computed ChangeLog files) for
-a subproject, and will simply be removed when working on the whole
-project.
-
-As an example, given that the default diff command used by Patcher is
-@code{cvs -q diff -u}, you should know understand that the default value
-for @code{patcher-default-diff-command} is @samp{cvs -q diff -u %f}. Do
-you ?
-
-There is another special construct available in this command: a
-@samp{%n} will be replaced with the project's name (@pxref{Subproject
-Naming}). This is useful in commands with weird options syntax, like
-PRCS.
-
-For a more advanced way of handling subprojects, see @ref{More On
-Subprojects}.
-
-@node Patcher Instances, Diff Prologue, Patch Restriction, Patch Generation
-@comment  node-name,  next,  previous,  up
-@subsection Patcher Instances
-
-The concept of subprojects brings up the question of having Patcher
-working on different patches at the same time. It is possible under some
-conditions:
-
-@itemize @bullet
-@item
-You can have as many simultaneous Patcher instances as you want on
-different projects (you would not define two projects sharing the same
-directory, would you ?).
-
-@item
-You can have as many simultaneous Patcher instances as you want on the
-same project, as long as there is no overlapping between each
-subproject. This means that you can't have source files, or even
-ChangeLog files in common.
-@end itemize
-
-This last point will be subject to improvements in the future.
-
-
-@node Diff Prologue, , Patcher Instances, Patch Generation
-@comment  node-name,  next,  previous,  up
-@subsection Diff Prologue
-
-Patcher can (and does) insert a special prologue just above a patch in
-the message in preparation. This prologue gives information such as the
-diff command used, the files affected and so on.
-
-@vindex patcher-default-diff-prologue-function
-@vindex :diff-prologue-function
-@findex patcher-default-diff-prologue
-The function used to generate this prologue can be specified with the
-@code{:diff-prologue-function} project option. A value of @code{nil}
-means don't insert any prologue. By default, the internal function
-@code{patcher-default-diff-prologue} is used. If you want to provide
-your own, here how to do it.
-
-Your function should take one argument indicating the kind of diff (a
-symbol), and perform insertion at current point in the current buffer.
-The possible values for the argument are:
-
-@table @code
-@item sources
-indicates a source diff only,
-
-@item change-logs
-indicates a ChangeLog diff only,
-
-@item mixed
-indicates a diff on both source and ChangeLog files.
-@end table
-
-The following variables are bound (when appropriate) when this function
-is executed:
-
-@table @code
-@item name
-the name of the current Patcher project,
-@item source-diff
-the command used to create a source diff,
-@item change-log-diff
-the command used to create a ChangeLog diff,
-@item source-files
-sources files affected by the current patch,
-@item change-log-files
-ChangeLog files affected by the current patch.
-@end table
-
- In the case of a mixed diff, a @code{nil} value for
-@code{change-log-diff} indicates that the same command was used for both
-the source and ChangeLog files.
-
-
-
-@c ChangeLog Handling =================================================
-@node ChangeLogs Handling, Project Check In, Patch Generation, User Manual
-@comment  node-name,  next,  previous,  up
-@section ChangeLogs Handling
-
-ChangeLogs management in Patcher involves two aspects: how ChangeLog
-entries are created, and how they appear in the messages. Both aspects
-can be customized beyond your craziest dreams.
-
-@menu
-* ChangeLogs Updating::   How Patcher deals with ChangeLogs
-* ChangeLogs Appearance:: How ChangeLogs appear in messages
-* ChangeLogs Prologue::   A header is inserted above the ChangeLogs
-@end menu
-
-@node ChangeLogs Updating, ChangeLogs Appearance, ChangeLogs Handling, ChangeLogs Handling
-@comment  node-name,  next,  previous,  up
-@subsection ChangeLogs Action
-
-@vindex patcher-default-change-logs-updating
-@vindex :change-logs-updating
-The way Patcher deals with ChangeLogs is controlled via the
-@code{:change-logs-updating} project option. Its value must be a symbol
-from the following:
-
-@table @code
-@item automatic
-This is the default. Each time you (re)generate a diff, Patcher
-(re)creates ChangeLog skeletons in the appropriate ChangeLog files, by
-analyzing the generated diff. You then have to fill the entries
-manually.
-@findex patch-to-change-log
-@strong{Caution}: the diff analysis is not done by Patcher directly, but
-by the function @code{patch-to-change-log} from the @code{add-log}
-library from the @code{xemacs-base} package. Only standard diff and cvs
-diff output are currently supported, both in unified format only.
-
-@item manual
-Patcher assumes that you create ChangeLog entries manually, as you write
-code, so it won't create ChangeLogs skeletons. It is important to
-understand that in this situation, ChangeLog entries @strong{must} have
-been written @strong{before} you call Patcher. Patcher won't let you
-write them in the process.
-
-@item none
-The project doesn't have ChangeLog files. Patcher won't try to create
-ChangeLog entries, and won't expect that you have written some either.
-@end table
-
-@vindex patcher-default-change-logs-user-name
-@vindex :change-logs-user-name
-@vindex patcher-default-change-logs-user-mail
-@vindex :change-logs-user-mail
-@findex patch-to-change-log
-@vindex user-full-name
-@vindex user-mail-address
-If you're working in @code{automatic} updating mode, Patcher has two
-other project options that give you some control on the created entries:
-@code{:change-logs-user-name} and @code{:change-logs-user-mail}. As you
-might expect, these are strings defining your name and mail address for
-ChangeLog entries'headers. When @code{nil}, Patcher lets the function
-@code{patch-to-change-log} decide what to use (most probably what the
-user options @code{user-full-name} and @code{user-mail-address} say).
-
-@vindex patcher-default-kill-source-files-after-diffing
-@vindex :kill-source-files-after-diffing
-Here's a last point to mention about the @code{automatic} updating mode.
-In order to build the ChangeLog skeletons, the source files must be
-visited. Patcher has a @code{:kill-source-files-after-diffing} project
-option that lets you decide whether you want to kill the source buffers
-just after diffing or not. The value can be either @code{nil} or
-@code{t}. By default, the behavior is to preserve the source files,
-since you might need them for reference when filling the ChangeLog
-entries.
-
-If you're working in @code{manual} updating mode, Patcher might still
-need to know the affected ChangeLog files (for the commit process) and
-your exact ChangeLog entries in each of these files (for insertion in
-the message). The ChangeLog files are automatically deduced from the
-patch. When that's required, however, you will be presented with each
-ChangeLog file in turn, and invited to precise the number of ChangeLog
-entries concerning this patch. These entries must of course appear at
-the top of the file.
-
-Finally, note that an updating mode of @code{none} is the only case
-where ChangeLog files are regarded as normal ones if present. As a
-consequence, that is a case where it is not forbidden to list them
-explicitly as part of a subproject (@pxref{Patch Restriction}),
-although I don't see why you would want to do that.
-
-@node ChangeLogs Appearance,  ChangeLogs Prologue, ChangeLogs Updating, ChangeLogs Handling
-@comment  node-name,  next,  previous,  up
-@subsection ChangeLogs Appearance
-
-@findex patcher-insert-change-logs
-@kindex C-c C-p i
-When Patcher has to deal with ChangeLog files, you insert ChangeLog
-entries in the message buffer by calling the function
-@code{patcher-insert-change-logs}. It is bound to @samp{C-c C-p i} in
-the mail buffer. Note that if ChangeLogs are written in advance, you
-don't have to do that, as Patcher will do it automatically. You have to
-call this function by hand only in @code{automatic} updating mode
-(@pxref{ChangeLogs Updating}).
-
-In all circumstances however, you can use this function to
-@strong{reinsert} the ChangeLog entries into the mail buffer. That might
-come in handy if you further modified them after the initial insertion
-(it's never too late to fix a typo).
-
-@vindex patcher-default-change-logs-appearance
-@vindex :change-logs-appearance
-The appearance of ChangeLog entries in the message is controlled by the
-@code{:change-logs-appearance} project option. Its value must be a
-symbol from the following:
-
-@table @code
-@item verbatim
-This is the default. ChangeLog entries appear just as text in the
-message, above the patch. Most people prefer this kind of appearance
-since it is the most readable.
-
-@item packed
-ChangeLog entries appear as a patch (they are diff'ed against the
-archive). This patch is however distinct from the source patch, and
-appears above it.
-
-@item patch
-ChangeLog entries appear as a patch (they are diff'ed against the
-archive), and this patch is integrated into the source patch. In other
-words, the message looks like a global patch integrating both the
-sources and the ChangeLogs.
-@end table
-
-@vindex patcher-default-change-logs-diff-command
-@vindex :change-logs-diff-command
-When the ChangeLogs appearance is either @code{packed} or @code{patch},
-the diff command used to generate the patch is controlled by the
-@code{:change-logs-diff-command} project option. The value can be the
-symbol @code{diff}, meaning that the same diff command is to be used as
-for the sources (@pxref{Diff Command}), or it can be a string specifying
-an alternate command.
-
-When diffing ChangeLog files, it is strongly recommended that you remove
-contexts from the diff, because otherwise, ChangeLog patches often fail
-to apply correctly.
-
-@vindex patcher-default-diff-command
-@vindex :diff-command
-As in the case of the @code{:diff-command} project option (@pxref{Patch
-Restriction}), a @code{%f} serves to indicate where to put the ChangeLog
-files on the diff command line, and a @samp{%n} is replaced with the
-project's name (@pxref{Subproject Naming}). See also @ref{More On
-Commands}.
-
-@vindex patcher-default-change-logs-diff-command
-@vindex :change-logs-diff-command
-Given these two remarks, you should now understand why the default value
-for @code{patcher-default-change-logs-diff-command} is @samp{cvs -q diff
--U 0 %f}.
-
-@node ChangeLogs Prologue, , ChangeLogs Appearance, ChangeLogs Handling
-@comment  node-name,  next,  previous,  up
-@subsection ChangeLogs Prologue
-
-ChangeLog prologues are small pieces of informative text that Patcher
-adds above each ChangeLog insertion in the mail buffer.
-
-@vindex patcher-default-change-logs-prologue
-@vindex :change-logs-prologue
-When the ChangeLogs appearance is @code{verbatim}, Patcher inserts one
-prologue per ChangeLog file. The prologue's contents is controlled by
-the @code{:change-logs-prologue} project option (a string). A @samp{%f}
-appearing in this string will be replaced with the ChangeLog filename.
-The default value for @code{patcher-default-change-logs-prologue} is
-@code{"%f addition:"}.
-
-@vindex patcher-default-diff-prologue-function
-@vindex :diff-prologue-function
-@findex patcher-default-diff-prologue
-When the ChangeLogs appearance is @code{packed}, Patcher inserts only
-one prologue for the whole ChangeLogs patch. When @code{patch}, there is
-a single prologue for both the ChangeLogs and the sources. For
-customizing the prologue in both of these cases, see @ref{Diff
-Prologue}.
-
-
-@c Project Check In ===================================================
-@node Project Check In, Mail Sending, ChangeLogs Handling, User Manual
-@comment  node-name,  next,  previous,  up
-@section Project Check In
-
-@findex patcher-commit-change
-@kindex C-c C-p c
-If you have the privilege to commit your changes yourself, you might do
-so directly from the mail buffer, as the last operation before actually
-sending the message. This is done by calling the function
-@code{patcher-commit-change} which is bound to @samp{C-c C-p c} in the
-mail buffer.
-
-Committing directly from Patcher has the advantage that both the commit
-command line and the commit log message (@pxref{Log Message Handling})
-are constructed automatically. Of course, you still have an in-depth
-control on the commit process.
-
-@menu
-* Commit Command::       Specifying the command to commit the patch
-* Log Message Handling:: Building a commit log message
-* Commit Operation::     Actually committing your changes
-@end menu
-
-@node Commit Command, Log Message Handling, Project Check In, Project Check In
-@comment  node-name,  next,  previous,  up
-@subsection Commit Command
-
-@findex patcher-commit-change
-@vindex patcher-default-commit-command
-@vindex :commit-command
-The command used to to commit a patch is specified by the
-@code{:commit-command} project option (a string). You can also
-temporarily change the command in question by calling
-@code{patcher-commit-change} with a prefix argument. As usual, note that
-this prefix argument is not meant to modify the affected files on the
-command line. It's meant only to punctually modify the commit command
-itself. The affected files are computed automatically by Patcher.
-
-The commit command accepts (and maybe requires) special constructs:
-
-@itemize
-@item
-A @code{%n} occurring in the string will be replaced with the project's
-name (@pxref{Subproject Naming}).
-
-@item
-A @code{%f} occurring in the string will be replaced with the files
-affected by the patch (ChangeLogs included, this time), or discarded if
-the patch is global.
-
-@item
-A @code{%s} occurring in the string will be replaced with the name of
-a file containing the commit log message (@pxref{Log Message Handling}).
-This file is a temporary file handled by Patcher.
-
-@item
-A @code{%S} occurring in the string will be replaced with the commit log
-message itself (@pxref{Log Message Handling}). Since the intent here is
-to use the message as a command-line argument, it is quoted against
-shell expansion.
-@end itemize
-
-Please note that a @code{%f} is required in your commit commands, unless
-you know for sure that you will never ever work on a subproject
-(@pxref{Patch Restriction}). But you never know that. Besides, you
-should always also provide either a @code{%s} or a @code{%S}, unless
-your archival software does not support log messages.
-
-@vindex patcher-default-commit-command
-@vindex :commit-command
-Given that, you should now understand why the default value for
-@code{patcher-default-commit-command} is @samp{cvs commit -F %s %f}.
-
-@node Log Message Handling, Commit Operation, Commit Command, Project Check In
-@comment  node-name,  next,  previous,  up
-@subsection Log Message Handling
-
-Most project management tools understand the concept of a @dfn{log
-message}: a short yet informative message that accompany the commit
-operation, which is also stored in the repository.
-
-Before a commit operation, Patcher always builds an initial log message,
-based on certain elements under your control (@pxref{Log Message
-Elements}). Afterwards, you can decide on whether you want some further
-(manual) edition of log message, or whether you want to commit
-immediately.
-
-@vindex patcher-default-edit-log-message
-@vindex :edit-log-message
-The @code{:edit-log-message} project option lets you specify this
-behavior. If @code{t} (the default), you will be able to manually edit
-the log message. If @code{nil}, Patcher will proceed directly to the
-commit operation.
-
-Please note that Patcher stores log messages in temporary files that
-will be used later by the commit command.
-
-@menu
-* Log Message Elements:: Elements Patcher can add automatically
-* Log Message Editing::  Manually modifying the log message
-@end menu
-
-@node Log Message Elements, Log Message Editing, Log Message Handling, Log Message Handling
-@comment  node-name,  next,  previous,  up
-@subsubsection Log Message Elements
-
-@vindex patcher-default-log-message-items
-@vindex :log-message-items
-Patcher has the ability to initialize the log message with different
-elements. These elements are specified with the
-@code{:log-message-items} project option. Its value is either
-@code{nil}, meaning that you don't want any initialization, or a list of
-symbols specifying the elements you desire. The available items are:
-
-@table @code
-@item subject
-The subject of the message. The subject's prefix is automatically
-removed.
-
-@item compressed-change-logs
-The ``compressed'' ChangeLog entries. Only the most important part of
-the ChangeLogs is preserved, so the entries appear in a more compact
-fashion.
-
-@item change-logs
-The raw ChangeLog entries.
-@end table
-
-@vindex patcher-default-change-logs-separator
-@vindex :change-logs-separator
-By default, only the message's subject is used. When using more than one
-item, they appear in the order specified above. If anything appears
-before the raw ChangeLog entries, a separator string is used. This
-string is specified by the @code{:change-logs-separator} project option.
-By default the string looks like ``--- ChangeLog entries follow: ---''.
-
-
-@node Log Message Editing, , Log Message Elements, Log Message Handling
-@comment  node-name,  next,  previous,  up
-@subsubsection Log Message Editing
-
-If so required, Patcher lets you manually edit the log message after
-having initialized it. Log message edition happens in a special buffer,
-the @code{*Patcher Log Message*} buffer.
-
-While editing this buffer, commands to insert the items described in
-@ref{Log Message Elements} are at your disposal. These commands perform
-insertion at point:
-
-@table @code
-@item patcher-logmsg-insert-subject
-@findex patcher-logmsg-insert-subject
-@kindex C-c C-p s
-Bound to @samp{C-c C-p s}. Insert the message's subject (sans the
-prefix).
-
-@item patcher-logmsg-insert-compressed-change-logs
-@findex patcher-logmsg-insert-compressed-change-logs
-@kindex C-c C-p c
-Bound to @samp{C-c C-p c}. Insert the compressed ChangeLog entries.
-
-@item patcher-logmsg-insert-change-logs
-@findex patcher-logmsg-insert-change-logs
-@kindex C-c C-p l
-Bound to @samp{C-c C-p l}. Insert the raw ChangeLog entries. Use a
-prefix argument if you also want the ChangeLogs separator string to be
-inserted.
-@end table
-
-@findex patcher-logmsg-init-message
-@kindex C-c C-p i
-In addition to these commands, you can also completely reinitialize the
-log message according to the specified items, by calling the function
-@code{patcher-logmsg-init-message}, bound to @samp{C-c C-p i}. Caution:
-this command first erases the buffer.
-
-@findex patcher-logmsg-commit
-@kindex C-c C-c
-Finally, once you're happy with your log message, you proceed to the
-commit operation by calling the function @code{patcher-logmsg-commit},
-bound to @samp{C-c C-c}.
-
-@node Commit Operation, , Log Message Handling, Project Check In
-@comment  node-name,  next,  previous,  up
-@subsection Commit Operation
-
-@kindex C-c C-p c
-@kindex C-c C-c
-The commit operation occurs after typing @samp{C-c C-p c} from the mail
-buffer, if you have not required log message edition, or after typing
-@samp{C-c C-c} from the @code{*Patcher Log Message*} buffer otherwise.
-
-@vindex patcher-default-confirm-commits
-@vindex :confirm-commits
-At that point, Patcher has constructed a proper commit command. You
-still have an option to abort the process, though: the
-@code{:confirm-commits} project option lets you specify whether to
-require confirmation before committing. If @code{t} (the default),
-Patcher will display the constructed commit command and ask for a
-confirmation before proceeding. If @code{nil}, Patcher will commit
-immediately.
-
-After the commit operation, Patcher changes some parts of the mail
-buffer in the following manner:
-
-@itemize @bullet
-@item
-@vindex patcher-default-subject-committed-prefix
-@vindex :subject-committed-prefix
-The subject prefix is changed to that specified by the
-@code{:subject-committed-prefix} project option (a string), unless it is
-@code{nil}. By default, ``[COMMIT]'' is used.
-
-@item
-@vindex patcher-default-committed-notice
-@vindex :committed-notice
-A commit notice is added right at the beginning of the message's body.
-This notice is specified by the @code{:committed-notice} project option.
-It can be @code{nil} or a string. By default, it reads ``NOTE: this
-patch has been committed.''.
-@end itemize
-
-
-@c Mail Sending =======================================================
-@node Mail Sending, More On Commands, Project Check In, User Manual
-@comment  node-name,  next,  previous,  up
-@section Mail Sending
-
-Sending the message will most probably be done by typing @samp{C-c C-c}
-in the mail buffer. This is also the case when you're using the fake
-mail method, by the way.
-
-@menu
-* Before Sending:: Patcher does some checkings
-* After Sending::  patcher does some cleanup
-@end menu
-
-@node Before Sending, After Sending, Mail Sending, Mail Sending
-@comment  node-name,  next,  previous,  up
-@subsection Before Sending
-
-There are circumstances in which Patcher will perform some checkings on
-your message when you send it, just before it is actually sent:
-
-@itemize @bullet
-@item ChangeLogs insertion
-
-@vindex patcher-mail-check-change-logs-insertion
-In case of manual ChangeLog insertion (@pxref{ChangeLogs Appearance}),
-Patcher can check that you have indeed inserted the ChangeLog entries
-before sending the message. This behavior is controlled by the
-@code{patcher-mail-check-change-logs-insertion} user option. A value of
-@code{nil} means never check (the message will be sent as-is). A value
-of t means check, and abort the sending if the ChangeLog entries are
-missing. A value of @code{ask} (the default) means ask for your opinion
-on this terrible matter.
-
-@item Commit Operation
-
-@vindex patcher-default-commit-privilege
-@vindex :commit-privilege
-Patcher has a @code{:commit-privilege} project option; a boolean
-specifying whether you're likely to commit your changes by yourself.
-
-@vindex patcher-mail-check-commit-action
-In case of commit privilege, Patcher can check that you have indeed
-committed your changes before sending the message. This behavior is
-controlled by the @code{patcher-mail-check-commit-action} user option. A
-value of @code{nil} means never check (the message will be sent as-is).
-A value of t means check, and abort the sending if the commit operation
-has not been performed. A value of @code{ask} (the default) means ask
-for your opinion on this rather unfortunate situation.
-@end itemize
-
-
-Two notes on these checkings:
-
-@itemize @bullet
-@item
-For uninteresting technical reasons, Patcher does not currently (and
-will probably never) offer you an automatic ChangeLogs insertion or
-commit operation, at mail sending time, but just abort the sending
-process in some circumstances. That's not a big deal though.
-
-@item
-For other uninteresting technical reasons, these checkings require a
-native knowledge of your mail user agent. Patcher does not currently
-support all mail user agents on earth (I'll add them on demand however).
-If that's the case, you will be warned and invited to send me a message.
-Also, you can send me one on April 21st: it's my birthday.
-@end itemize
-
-@node After Sending, , Before Sending, Mail Sending
-@comment  node-name,  next,  previous,  up
-@subsection After Sending
-
-After sending the message, Patcher also performs some cleanup
-operations, that you can customize. The cleanup is controlled by the
-following project options. Each one is a boolean option which defaults
-to @code{t}.
-
-@table @code
-@item :kill-source-files-after-sending
-@vindex patcher-default-kill-source-files-after-sending
-@vindex :kill-source-files-after-sending
-Whether to kill source files after sending the message. If @code{nil},
-the source files will remain visited.
-
-@item :kill-change-logs-after-sending
-@vindex patcher-default-kill-change-logs-after-sending
-@vindex :kill-change-logs-after-sending
-Whether to kill ChangeLog files after sending the message. If
-@code{nil}, the ChangeLog files will remain visited.
-@end table
-
-
-@c More On Commands ===================================================
-@node More On Commands, More On Subprojects, Mail Sending, User Manual
-@comment  node-name,  next,  previous,  up
-@section More On Commands
-
-This section deals with information that apply to all commands used by
-Patcher (diff and commit operations).
-
-@menu
-* Prefixing Commands::  Bypassing a firewall
-* Error Handling::      Dealing with errors
-@end menu
-
-@node Prefixing Commands, Error Handling, , More On Commands
-@comment  node-name,  next,  previous,  up
-@subsection Prefixing Commands
-
-If you're working on a distant archive and you're behind a firewall, you
-might need to prefix all your commands with something like
-@code{runsocks}. Of course, this can be done manually in all your
-command settings, but Patcher offers you a simpler way to do it.
-
-@vindex patcher-default-pre-command
-@vindex :pre-command
-There is a project option named @code{:pre-command} which can be used
-for this kind of thing. It must be a string that will be prepended to
-all operations performed by Patcher.
-
-
-@node Error Handling, , Prefixing Commands, More On Commands
-@comment  node-name,  next,  previous,  up
-@subsection Error Handling
-
-@vindex patcher-default-failed-command-regexp
-@vindex :failed-command-regexp
-From time to time, commands may fail for different reasons. Patcher
-tracks the failures in these commands and lets you know when that
-happens. The @code{:failed-command-regexp} project option lets you
-specify a regular expression to match with the output of an aborted
-command. By default, the value is @code{"^cvs \\[[^]]* aborted\\]"}.
-
-
-@c More On Subprojects ===============================================
-@node More On Subprojects, , More On Commands, User Manual
-@comment  node-name,  next,  previous,  up
-@section More On Subprojects
-
-We've already seen how to work punctually on a subproject, that is, on a
-subset of a project's files (@pxref{Patch Restriction}). If you happen
-to work more than once on the same project subset, it will quickly
-become annoying to have to specify explicitly the same files over and
-over again. Patcher offers you a way to permanently define subprojects.
-
-@menu
-* Defining Subprojects::  Storing subprojects definitions
-* Subproject Naming::     When different projects have the same name
-* Command Directory::     For non local revision control systems
-@end menu
-
-
-@node Defining Subprojects, Subproject Naming, , More On Subprojects
-@comment  node-name,  next,  previous,  up
-@subsection Defining Subprojects
-
-@vindex patcher-subprojects
-The user option @code{patcher-subprojects} stores a list of
-@dfn{subproject descriptors}. A subproject descriptor is almost the same
-as a project descriptor, with a few exceptions:
-
-@itemize @bullet
-@item
-Instead of the project directory field (the second field in a project
-descriptor), you rather specify the name of the project this subproject
-is based on.
-
-@item
-In addition to the standard project options we've already seen, two
-subproject options are available:
-@table @code
-@item :subdirectory
-@vindex :subdirectory
-This lets you specify a subdirectory of the original project's directory
-in which the whole subproject resides.
-
-@item :files
-@vindex :files
-This lets you specify a list of files or directories composing the
-subproject. Each file specification can contain wildcards. If a
-@code{:subdirectory} subproject option is given, these files or
-directories should be relative to this subdirectory. Otherwise, they
-should be relative to the parent project's directory.
-@end table
-
-Please note that these subproject options have no corresponding fallback
-(that would be meaningless). They can't appear in a theme either.
-
-@item
-@vindex :inheritance
-Subprojects don't have an @code{:inheritance} mechanism. Instead, they
-implicitly inherit from their base project (which in turn can inherit
-from other projects).
-@end itemize
-
-Here are some important remarks about subprojects:
-
-@itemize @bullet
-@item
-@vindex :subdirectory
-@vindex :files
-A subproject with neither a @code{:subdirectory} nor a @code{:files}
-option is exactly the same as the base project, apart from project
-options that you would override.
-
-@item
-@findex patcher-mail
-@findex patcher-mail-subproject
-@findex patcher-mail-adapt
-@findex patcher-mail-adapt-subproject
-Since permanent subprojects are defined statically, they should be used
-with the normal Patcher functions like @code{patcher-mail}. You don't
-need to use the @code{*-subproject} versions any more.
-
-@item
-Because of that, projects and subprojects can't have names in common. If
-that happens to be the case, Patcher will blindly use a subproject
-rather than a project of that name
-
-@item
-So what happens if you persist in using a @code{*-subproject} function
-on a permanent subproject ? Well, you punctually work on a
-subsubproject@dots{}
-@end itemize
-
-
-@node Subproject Naming, Command Directory, Defining Subprojects, More On Subprojects
-@comment  node-name,  next,  previous,  up
-@subsection Subproject Naming
-
-@vindex patcher-projects
-@vindex patcher-subprojects
-As you already know, Patcher distinguishes projects by their @var{NAME}
-field in the @code{patcher-projects} and @code{patcher-subprojects} user
-options. This is problematic, however, if you define different patcher
-projects for a single physical project, and the commands require the
-project's name. That might for instance be the case with PRCS
-(decidedly) weird options syntax.
-
-@vindex patcher-default-name
-@vindex :name
-To remedy this problem, patcher provides a @code{:name} project option.
-If set, it will actually be used for all @code{%n} substitutions where
-the project's name (in the Patcher sense) would normally be used.
-
-If you want to use the project's name in the Patcher sense, regardless
-of the value of the @code{:name} option, use @code{%N} instead of
-@code{%n}.
-
-
-@node Command Directory, , Subproject Naming, More On Subprojects
-@comment  node-name,  next,  previous,  up
-@subsection Command Directory
-
-Some revision control systems, like CVS, work on a per-file basis. Some
-others, like PRCS, work only globally. This has an important implication
-for subprojects being sudirectories of other projects. Indeed, while
-CVS, for instance, can be executed anywhere, PRCS can only be run in the
-base project's root directory.
-
-@vindex :command-directory
-@vindex patcher-default-command-directory
-If you want to define projects for which the revision control system can
-be executed in only one directory, Patcher provides you with the
-@code{:command-directory} project option (a string). This directory can
-be specified relative to the project's directory (but note that it must
-go upwards).
-
-All commands (diff and commit ones) will be executed from there. Also,
-note that the command directory does not change the way you might
-specify files. Patcher modifies all needed paths automatically to handle
-the command directory properly.
-
-
-@c ====================================================================
-@c Variables Index
-@c ====================================================================
-@node Variables Index, Functions Index, User Manual, Top
-@comment  node-name,  next,  previous,  up
-@unnumbered Variables Index
-@printindex vr
-
-
-@c ====================================================================
-@c Functions Index
-@c ====================================================================
-@node Functions Index,  Keystrokes Index, Variables Index, Top
-@comment  node-name,  next,  previous,  up
-@unnumbered Functions Index
-@printindex fn
-
-
-@c ====================================================================
-@c Keystrokes Index
-@c ====================================================================
-@node Keystrokes Index,  , Functions Index, Top
-@comment  node-name,  next,  previous,  up
-@unnumbered Keystrokes Index
-@printindex ky
-
-
-@bye
-
-@c Don't add stuff under this line !!
-@c patcher.texi ends here
diff --git a/xemacs-packages/pkginfo/MANIFEST.bbdb b/xemacs-packages/pkginfo/MANIFEST.bbdb
deleted file mode 100644
index 41fa8bd1..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.bbdb
+++ /dev/null
@@ -1,59 +0,0 @@
-pkginfo/MANIFEST.bbdb
-lisp/bbdb/ChangeLog
-lisp/bbdb/INSTALL
-lisp/bbdb/README
-lisp/bbdb/_pkg.el
-lisp/bbdb/auto-autoloads.el
-lisp/bbdb/auto-autoloads.elc
-lisp/bbdb/bbdb-com.el
-lisp/bbdb/bbdb-com.elc
-lisp/bbdb/bbdb-ftp.el
-lisp/bbdb/bbdb-ftp.elc
-lisp/bbdb/bbdb-gnus.el
-lisp/bbdb/bbdb-gnus.elc
-lisp/bbdb/bbdb-gui.el
-lisp/bbdb/bbdb-gui.elc
-lisp/bbdb/bbdb-hooks.el
-lisp/bbdb/bbdb-hooks.elc
-lisp/bbdb/bbdb-merge.el
-lisp/bbdb/bbdb-merge.elc
-lisp/bbdb/bbdb-mhe.el
-lisp/bbdb/bbdb-mhe.elc
-lisp/bbdb/bbdb-migrate.el
-lisp/bbdb/bbdb-migrate.elc
-lisp/bbdb/bbdb-print.el
-lisp/bbdb/bbdb-print.elc
-lisp/bbdb/bbdb-reportmail.el
-lisp/bbdb/bbdb-reportmail.elc
-lisp/bbdb/bbdb-rmail.el
-lisp/bbdb/bbdb-rmail.elc
-lisp/bbdb/bbdb-sc.el
-lisp/bbdb/bbdb-sc.elc
-lisp/bbdb/bbdb-snarf.el
-lisp/bbdb/bbdb-snarf.elc
-lisp/bbdb/bbdb-srv.el
-lisp/bbdb/bbdb-srv.elc
-lisp/bbdb/bbdb-vm.el
-lisp/bbdb/bbdb-vm.elc
-lisp/bbdb/bbdb-w3.el
-lisp/bbdb/bbdb-w3.elc
-lisp/bbdb/bbdb-whois.el
-lisp/bbdb/bbdb-whois.elc
-lisp/bbdb/bbdb-xemacs.el
-lisp/bbdb/bbdb-xemacs.elc
-lisp/bbdb/bbdb.el
-lisp/bbdb/bbdb.elc
-lisp/bbdb/custom-load.el
-lisp/bbdb/custom-load.elc
-info/bbdb.info
-man/bbdb/bbdb.texinfo
-etc/bbdb/bbdb-213-310.el
-etc/bbdb/bbdb-415-510.el
-etc/bbdb/bbdb-areacode-split.pl
-etc/bbdb/bbdb-cid.pl
-etc/bbdb/bbdb-srv.pl
-etc/bbdb/bbdb-to-netscape.el
-etc/bbdb/bbdb-unlazy-lock.pl
-etc/bbdb/tex/bbdb-cols.tex
-etc/bbdb/tex/bbdb-print-brief.tex
-etc/bbdb/tex/bbdb-print.tex
diff --git a/xemacs-packages/pkginfo/MANIFEST.c-support b/xemacs-packages/pkginfo/MANIFEST.c-support
deleted file mode 100644
index dde35bc1..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.c-support
+++ /dev/null
@@ -1,21 +0,0 @@
-pkginfo/MANIFEST.c-support
-lisp/c-support/ChangeLog
-lisp/c-support/_pkg.el
-lisp/c-support/auto-autoloads.el
-lisp/c-support/auto-autoloads.elc
-lisp/c-support/c-comment-edit.el
-lisp/c-support/c-comment-edit.elc
-lisp/c-support/c-fill.el
-lisp/c-support/c-fill.elc
-lisp/c-support/c-style.el
-lisp/c-support/c-style.elc
-lisp/c-support/cmacexp.el
-lisp/c-support/cmacexp.elc
-lisp/c-support/ctypes.el
-lisp/c-support/ctypes.elc
-lisp/c-support/custom-load.el
-lisp/c-support/custom-load.elc
-lisp/c-support/hideif.el
-lisp/c-support/hideif.elc
-lisp/c-support/hideshow.el
-lisp/c-support/hideshow.elc
diff --git a/xemacs-packages/pkginfo/MANIFEST.ecrypto b/xemacs-packages/pkginfo/MANIFEST.ecrypto
deleted file mode 100644
index ecb7934e..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.ecrypto
+++ /dev/null
@@ -1,37 +0,0 @@
-pkginfo/MANIFEST.ecrypto
-lisp/ecrypto/ChangeLog
-lisp/ecrypto/_pkg.el
-lisp/ecrypto/ascii-armor.el
-lisp/ecrypto/ascii-armor.elc
-lisp/ecrypto/auto-autoloads.el
-lisp/ecrypto/auto-autoloads.elc
-lisp/ecrypto/blowfish.el
-lisp/ecrypto/blowfish.elc
-lisp/ecrypto/custom-load.el
-lisp/ecrypto/custom-load.elc
-lisp/ecrypto/des.el
-lisp/ecrypto/des.elc
-lisp/ecrypto/encrypt.el
-lisp/ecrypto/encrypt.elc
-lisp/ecrypto/hex-util.el
-lisp/ecrypto/hex-util.elc
-lisp/ecrypto/md4.el
-lisp/ecrypto/md4.elc
-lisp/ecrypto/md5-dl.el
-lisp/ecrypto/md5-dl.elc
-lisp/ecrypto/md5-el.el
-lisp/ecrypto/md5-el.elc
-lisp/ecrypto/md5.el
-lisp/ecrypto/md5.elc
-lisp/ecrypto/paranoid.el
-lisp/ecrypto/paranoid.elc
-lisp/ecrypto/password.el
-lisp/ecrypto/password.elc
-lisp/ecrypto/rander.el
-lisp/ecrypto/rander.elc
-lisp/ecrypto/rc16.el
-lisp/ecrypto/rc16.elc
-lisp/ecrypto/rijndael.el
-lisp/ecrypto/rijndael.elc
-lisp/ecrypto/sha1.el
-lisp/ecrypto/sha1.elc
diff --git a/xemacs-packages/pkginfo/MANIFEST.ediff b/xemacs-packages/pkginfo/MANIFEST.ediff
deleted file mode 100644
index 33a3025c..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.ediff
+++ /dev/null
@@ -1,58 +0,0 @@
-pkginfo/MANIFEST.ediff
-lisp/ediff/ChangeLog
-lisp/ediff/README
-lisp/ediff/_pkg.el
-lisp/ediff/auto-autoloads.el
-lisp/ediff/auto-autoloads.elc
-lisp/ediff/custom-load.el
-lisp/ediff/custom-load.elc
-lisp/ediff/ediff-diff.el
-lisp/ediff/ediff-diff.elc
-lisp/ediff/ediff-help.el
-lisp/ediff/ediff-help.elc
-lisp/ediff/ediff-hook.el
-lisp/ediff/ediff-hook.elc
-lisp/ediff/ediff-init.el
-lisp/ediff/ediff-init.elc
-lisp/ediff/ediff-merg.el
-lisp/ediff/ediff-merg.elc
-lisp/ediff/ediff-mult.el
-lisp/ediff/ediff-mult.elc
-lisp/ediff/ediff-ptch.el
-lisp/ediff/ediff-ptch.elc
-lisp/ediff/ediff-tbar.el
-lisp/ediff/ediff-tbar.elc
-lisp/ediff/ediff-util.el
-lisp/ediff/ediff-util.elc
-lisp/ediff/ediff-vers.el
-lisp/ediff/ediff-vers.elc
-lisp/ediff/ediff-wind.el
-lisp/ediff/ediff-wind.elc
-lisp/ediff/ediff.el
-lisp/ediff/ediff.elc
-info/ediff.info
-man/ediff/ediff.texi
-etc/ediff/ediff-A-up.xbm
-etc/ediff/ediff-A-up.xpm
-etc/ediff/ediff-A-xx.xpm
-etc/ediff/ediff-B-up.xbm
-etc/ediff/ediff-B-up.xpm
-etc/ediff/ediff-B-xx.xpm
-etc/ediff/ediff-help.xbm
-etc/ediff/ediff-help.xpm
-etc/ediff/ediff-next.xbm
-etc/ediff/ediff-next.xpm
-etc/ediff/ediff-prev.xbm
-etc/ediff/ediff-prev.xpm
-etc/ediff/ediff-quit.xbm
-etc/ediff/ediff-quit.xpm
-etc/ediff/ediff-refine.xbm
-etc/ediff/ediff-refine.xpm
-etc/ediff/ediff-save-xx.xbm
-etc/ediff/ediff-save-xx.xpm
-etc/ediff/ediff-save.xbm
-etc/ediff/ediff-save.xpm
-etc/ediff/ediff-toggle-split-up.xbm
-etc/ediff/ediff-toggle-split-up.xpm
-etc/ediff/ediff-update.xbm
-etc/ediff/ediff-update.xpm
diff --git a/xemacs-packages/pkginfo/MANIFEST.edit-utils b/xemacs-packages/pkginfo/MANIFEST.edit-utils
deleted file mode 100644
index 71efc766..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.edit-utils
+++ /dev/null
@@ -1,147 +0,0 @@
-pkginfo/MANIFEST.edit-utils
-lisp/edit-utils/ChangeLog
-lisp/edit-utils/_pkg.el
-lisp/edit-utils/abbrevlist.el
-lisp/edit-utils/abbrevlist.elc
-lisp/edit-utils/after-save-commands.el
-lisp/edit-utils/after-save-commands.elc
-lisp/edit-utils/align.el
-lisp/edit-utils/align.elc
-lisp/edit-utils/allout.el
-lisp/edit-utils/allout.elc
-lisp/edit-utils/array.el
-lisp/edit-utils/array.elc
-lisp/edit-utils/atomic-extents.el
-lisp/edit-utils/atomic-extents.elc
-lisp/edit-utils/auto-autoloads.el
-lisp/edit-utils/auto-autoloads.elc
-lisp/edit-utils/autorevert.el
-lisp/edit-utils/autorevert.elc
-lisp/edit-utils/avoid.el
-lisp/edit-utils/avoid.elc
-lisp/edit-utils/backup-dir.el
-lisp/edit-utils/backup-dir.elc
-lisp/edit-utils/balloon-help.el
-lisp/edit-utils/balloon-help.elc
-lisp/edit-utils/big-menubar.el
-lisp/edit-utils/big-menubar.elc
-lisp/edit-utils/blink-cursor.el
-lisp/edit-utils/blink-cursor.elc
-lisp/edit-utils/blink-paren.el
-lisp/edit-utils/blink-paren.elc
-lisp/edit-utils/bookmark.el
-lisp/edit-utils/bookmark.elc
-lisp/edit-utils/compare-w.el
-lisp/edit-utils/compare-w.elc
-lisp/edit-utils/completion.el
-lisp/edit-utils/completion.elc
-lisp/edit-utils/crm.el
-lisp/edit-utils/crm.elc
-lisp/edit-utils/custom-load.el
-lisp/edit-utils/custom-load.elc
-lisp/edit-utils/dabbrev.el
-lisp/edit-utils/dabbrev.elc
-lisp/edit-utils/desktop.el
-lisp/edit-utils/desktop.elc
-lisp/edit-utils/detached-minibuf.el
-lisp/edit-utils/detached-minibuf.elc
-lisp/edit-utils/edit-faces.el
-lisp/edit-utils/edit-faces.elc
-lisp/edit-utils/edit-toolbar.el
-lisp/edit-utils/edit-toolbar.elc
-lisp/edit-utils/fast-lock.el
-lisp/edit-utils/fast-lock.elc
-lisp/edit-utils/file-part.el
-lisp/edit-utils/file-part.elc
-lisp/edit-utils/floating-toolbar.el
-lisp/edit-utils/floating-toolbar.elc
-lisp/edit-utils/flow-ctrl.el
-lisp/edit-utils/flow-ctrl.elc
-lisp/edit-utils/foldout.el
-lisp/edit-utils/foldout.elc
-lisp/edit-utils/func-menu.el
-lisp/edit-utils/func-menu.elc
-lisp/edit-utils/highline.el
-lisp/edit-utils/highline.elc
-lisp/edit-utils/hippie-exp.el
-lisp/edit-utils/hippie-exp.elc
-lisp/edit-utils/icomplete.el
-lisp/edit-utils/icomplete.elc
-lisp/edit-utils/id-select.el
-lisp/edit-utils/id-select.elc
-lisp/edit-utils/info-look.el
-lisp/edit-utils/info-look.elc
-lisp/edit-utils/iswitchb.el
-lisp/edit-utils/iswitchb.elc
-lisp/edit-utils/lazy-lock.el
-lisp/edit-utils/lazy-lock.elc
-lisp/edit-utils/lazy-shot.el
-lisp/edit-utils/lazy-shot.elc
-lisp/edit-utils/lispm-fonts.el
-lisp/edit-utils/lispm-fonts.elc
-lisp/edit-utils/live-icon.el
-lisp/edit-utils/live-icon.elc
-lisp/edit-utils/makesum.el
-lisp/edit-utils/makesum.elc
-lisp/edit-utils/man.el
-lisp/edit-utils/man.elc
-lisp/edit-utils/mic-paren.el
-lisp/edit-utils/mic-paren.elc
-lisp/edit-utils/mode-motion+.el
-lisp/edit-utils/mode-motion+.elc
-lisp/edit-utils/narrow-stack.el
-lisp/edit-utils/narrow-stack.elc
-lisp/edit-utils/outl-mouse.el
-lisp/edit-utils/outl-mouse.elc
-lisp/edit-utils/page-ext.el
-lisp/edit-utils/page-ext.elc
-lisp/edit-utils/paren.el
-lisp/edit-utils/paren.elc
-lisp/edit-utils/permanent-buffers.el
-lisp/edit-utils/permanent-buffers.elc
-lisp/edit-utils/popper.el
-lisp/edit-utils/popper.elc
-lisp/edit-utils/power-macros.el
-lisp/edit-utils/power-macros.elc
-lisp/edit-utils/recent-files.el
-lisp/edit-utils/recent-files.elc
-lisp/edit-utils/redo.el
-lisp/edit-utils/redo.elc
-lisp/edit-utils/reportmail.el
-lisp/edit-utils/reportmail.elc
-lisp/edit-utils/resume.el
-lisp/edit-utils/resume.elc
-lisp/edit-utils/rsz-minibuf.el
-lisp/edit-utils/rsz-minibuf.elc
-lisp/edit-utils/saveconf.el
-lisp/edit-utils/saveconf.elc
-lisp/edit-utils/savehist.el
-lisp/edit-utils/savehist.elc
-lisp/edit-utils/saveplace.el
-lisp/edit-utils/saveplace.elc
-lisp/edit-utils/scroll-in-place.el
-lisp/edit-utils/scroll-in-place.elc
-lisp/edit-utils/search-buffers.el
-lisp/edit-utils/search-buffers.elc
-lisp/edit-utils/setnu.el
-lisp/edit-utils/setnu.elc
-lisp/edit-utils/shell-font.el
-lisp/edit-utils/shell-font.elc
-lisp/edit-utils/tempo.el
-lisp/edit-utils/tempo.elc
-lisp/edit-utils/toolbar-utils.el
-lisp/edit-utils/toolbar-utils.elc
-lisp/edit-utils/tree-menu.el
-lisp/edit-utils/tree-menu.elc
-lisp/edit-utils/uniquify.el
-lisp/edit-utils/uniquify.elc
-lisp/edit-utils/vertical-mode.el
-lisp/edit-utils/vertical-mode.elc
-lisp/edit-utils/where-was-i-db.el
-lisp/edit-utils/where-was-i-db.elc
-lisp/edit-utils/winring.el
-lisp/edit-utils/winring.elc
-info/edit-utils.info
-info/tempo.info
-man/edit-utils/edit-utils.texi
-man/edit-utils/tempo.texi
diff --git a/xemacs-packages/pkginfo/MANIFEST.mail-lib b/xemacs-packages/pkginfo/MANIFEST.mail-lib
deleted file mode 100644
index cfafff1f..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.mail-lib
+++ /dev/null
@@ -1,47 +0,0 @@
-pkginfo/MANIFEST.mail-lib
-lisp/mail-lib/ChangeLog
-lisp/mail-lib/_pkg.el
-lisp/mail-lib/auto-autoloads.el
-lisp/mail-lib/auto-autoloads.elc
-lisp/mail-lib/base64.el
-lisp/mail-lib/base64.elc
-lisp/mail-lib/browse-url-xemacs.el
-lisp/mail-lib/browse-url-xemacs.elc
-lisp/mail-lib/browse-url.el
-lisp/mail-lib/browse-url.elc
-lisp/mail-lib/custom-load.el
-lisp/mail-lib/custom-load.elc
-lisp/mail-lib/highlight-headers.el
-lisp/mail-lib/highlight-headers.elc
-lisp/mail-lib/mail-abbrevs.el
-lisp/mail-lib/mail-abbrevs.elc
-lisp/mail-lib/mail-extr.el
-lisp/mail-lib/mail-extr.elc
-lisp/mail-lib/mail-utils.el
-lisp/mail-lib/mail-utils.elc
-lisp/mail-lib/mailheader.el
-lisp/mail-lib/mailheader.elc
-lisp/mail-lib/netrc.el
-lisp/mail-lib/netrc.elc
-lisp/mail-lib/pop3.el
-lisp/mail-lib/pop3.elc
-lisp/mail-lib/reporter.el
-lisp/mail-lib/reporter.elc
-lisp/mail-lib/rfc2104.el
-lisp/mail-lib/rfc2104.elc
-lisp/mail-lib/rfc822.el
-lisp/mail-lib/rfc822.elc
-lisp/mail-lib/rmail-mini.el
-lisp/mail-lib/rmail-mini.elc
-lisp/mail-lib/rmailout.el
-lisp/mail-lib/rmailout.elc
-lisp/mail-lib/sendmail.el
-lisp/mail-lib/sendmail.elc
-lisp/mail-lib/smtpmail.el
-lisp/mail-lib/smtpmail.elc
-lisp/mail-lib/starttls.el
-lisp/mail-lib/starttls.elc
-lisp/mail-lib/tls.el
-lisp/mail-lib/tls.elc
-info/smtpmail.info
-man/mail-lib/smtpmail.texi
diff --git a/xemacs-packages/pkginfo/MANIFEST.net-utils b/xemacs-packages/pkginfo/MANIFEST.net-utils
deleted file mode 100644
index 9af41bb5..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.net-utils
+++ /dev/null
@@ -1,37 +0,0 @@
-pkginfo/MANIFEST.net-utils
-lisp/net-utils/ChangeLog
-lisp/net-utils/_pkg.el
-lisp/net-utils/auto-autoloads.el
-lisp/net-utils/auto-autoloads.elc
-lisp/net-utils/browse-cltl2.el
-lisp/net-utils/browse-cltl2.elc
-lisp/net-utils/custom-load.el
-lisp/net-utils/custom-load.elc
-lisp/net-utils/dig.el
-lisp/net-utils/dig.elc
-lisp/net-utils/dns-mode.el
-lisp/net-utils/dns-mode.elc
-lisp/net-utils/dns.el
-lisp/net-utils/dns.elc
-lisp/net-utils/feedmail.el
-lisp/net-utils/feedmail.elc
-lisp/net-utils/google-query.el
-lisp/net-utils/google-query.elc
-lisp/net-utils/metamail.el
-lisp/net-utils/metamail.elc
-lisp/net-utils/mozmail.el
-lisp/net-utils/mozmail.elc
-lisp/net-utils/net-utils.el
-lisp/net-utils/net-utils.elc
-lisp/net-utils/rcompile.el
-lisp/net-utils/rcompile.elc
-lisp/net-utils/shadowfile.el
-lisp/net-utils/shadowfile.elc
-lisp/net-utils/webjump.el
-lisp/net-utils/webjump.elc
-lisp/net-utils/webster-www.el
-lisp/net-utils/webster-www.elc
-lisp/net-utils/xemacsbug.el
-lisp/net-utils/xemacsbug.elc
-lisp/net-utils/xml.el
-lisp/net-utils/xml.elc
diff --git a/xemacs-packages/pkginfo/MANIFEST.os-utils b/xemacs-packages/pkginfo/MANIFEST.os-utils
deleted file mode 100644
index 70d60047..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.os-utils
+++ /dev/null
@@ -1,41 +0,0 @@
-pkginfo/MANIFEST.os-utils
-lisp/os-utils/ChangeLog
-lisp/os-utils/_pkg.el
-lisp/os-utils/arc-mode.el
-lisp/os-utils/arc-mode.elc
-lisp/os-utils/auto-autoloads.el
-lisp/os-utils/auto-autoloads.elc
-lisp/os-utils/background.el
-lisp/os-utils/background.elc
-lisp/os-utils/crypt.el
-lisp/os-utils/crypt.elc
-lisp/os-utils/custom-load.el
-lisp/os-utils/custom-load.elc
-lisp/os-utils/ftelnet.el
-lisp/os-utils/ftelnet.elc
-lisp/os-utils/inf-lisp.el
-lisp/os-utils/inf-lisp.elc
-lisp/os-utils/jka-compr.el
-lisp/os-utils/jka-compr.elc
-lisp/os-utils/kermit.el
-lisp/os-utils/kermit.elc
-lisp/os-utils/ledit.el
-lisp/os-utils/ledit.elc
-lisp/os-utils/mchat.el
-lisp/os-utils/mchat.elc
-lisp/os-utils/rlogin.el
-lisp/os-utils/rlogin.elc
-lisp/os-utils/spell.el
-lisp/os-utils/spell.elc
-lisp/os-utils/ssh.el
-lisp/os-utils/ssh.elc
-lisp/os-utils/tar-mode.el
-lisp/os-utils/tar-mode.elc
-lisp/os-utils/telnet.el
-lisp/os-utils/telnet.elc
-lisp/os-utils/terminal.el
-lisp/os-utils/terminal.elc
-lisp/os-utils/uncompress.el
-lisp/os-utils/uncompress.elc
-info/os-utils.info
-man/os-utils/os-utils.texi
diff --git a/xemacs-packages/pkginfo/MANIFEST.perl-modes b/xemacs-packages/pkginfo/MANIFEST.perl-modes
deleted file mode 100644
index 2ac09d0f..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.perl-modes
+++ /dev/null
@@ -1,11 +0,0 @@
-pkginfo/MANIFEST.perl-modes
-lisp/perl-modes/ChangeLog
-lisp/perl-modes/_pkg.el
-lisp/perl-modes/auto-autoloads.el
-lisp/perl-modes/auto-autoloads.elc
-lisp/perl-modes/cperl-mode.el
-lisp/perl-modes/cperl-mode.elc
-lisp/perl-modes/custom-load.el
-lisp/perl-modes/custom-load.elc
-lisp/perl-modes/perl-mode.el
-lisp/perl-modes/perl-mode.elc
diff --git a/xemacs-packages/pkginfo/MANIFEST.pgg b/xemacs-packages/pkginfo/MANIFEST.pgg
deleted file mode 100644
index d1fb83e3..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.pgg
+++ /dev/null
@@ -1,22 +0,0 @@
-pkginfo/MANIFEST.pgg
-lisp/pgg/ChangeLog
-lisp/pgg/README
-lisp/pgg/_pkg.el
-lisp/pgg/auto-autoloads.el
-lisp/pgg/auto-autoloads.elc
-lisp/pgg/custom-load.el
-lisp/pgg/custom-load.elc
-lisp/pgg/pgg-def.el
-lisp/pgg/pgg-def.elc
-lisp/pgg/pgg-gpg.el
-lisp/pgg/pgg-gpg.elc
-lisp/pgg/pgg-parse.el
-lisp/pgg/pgg-parse.elc
-lisp/pgg/pgg-pgp.el
-lisp/pgg/pgg-pgp.elc
-lisp/pgg/pgg-pgp5.el
-lisp/pgg/pgg-pgp5.elc
-lisp/pgg/pgg.el
-lisp/pgg/pgg.elc
-info/pgg.info
-man/pgg/pgg.texi
diff --git a/xemacs-packages/pkginfo/MANIFEST.prog-modes b/xemacs-packages/pkginfo/MANIFEST.prog-modes
deleted file mode 100644
index 0303a0a5..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.prog-modes
+++ /dev/null
@@ -1,69 +0,0 @@
-pkginfo/MANIFEST.prog-modes
-lisp/prog-modes/ChangeLog
-lisp/prog-modes/_pkg.el
-lisp/prog-modes/asm-mode.el
-lisp/prog-modes/asm-mode.elc
-lisp/prog-modes/auto-autoloads.el
-lisp/prog-modes/auto-autoloads.elc
-lisp/prog-modes/autoconf-mode.el
-lisp/prog-modes/autoconf-mode.elc
-lisp/prog-modes/awk-mode.el
-lisp/prog-modes/awk-mode.elc
-lisp/prog-modes/cl-indent.el
-lisp/prog-modes/cl-indent.elc
-lisp/prog-modes/custom-load.el
-lisp/prog-modes/custom-load.elc
-lisp/prog-modes/cvs.el
-lisp/prog-modes/cvs.elc
-lisp/prog-modes/diff-mode.el
-lisp/prog-modes/diff-mode.elc
-lisp/prog-modes/eiffel.el
-lisp/prog-modes/eiffel.elc
-lisp/prog-modes/icon.el
-lisp/prog-modes/icon.elc
-lisp/prog-modes/javascript-mode.el
-lisp/prog-modes/javascript-mode.elc
-lisp/prog-modes/ksh-mode.el
-lisp/prog-modes/ksh-mode.elc
-lisp/prog-modes/lua-mode.el
-lisp/prog-modes/lua-mode.elc
-lisp/prog-modes/m4-mode.el
-lisp/prog-modes/m4-mode.elc
-lisp/prog-modes/make-mode.el
-lisp/prog-modes/make-mode.elc
-lisp/prog-modes/mode-compile.el
-lisp/prog-modes/mode-compile.elc
-lisp/prog-modes/modula2.el
-lisp/prog-modes/modula2.elc
-lisp/prog-modes/old-c-mode.el
-lisp/prog-modes/old-c-mode.elc
-lisp/prog-modes/p4.el
-lisp/prog-modes/p4.elc
-lisp/prog-modes/pascal.el
-lisp/prog-modes/pascal.elc
-lisp/prog-modes/php-mode.el
-lisp/prog-modes/php-mode.elc
-lisp/prog-modes/postscript.el
-lisp/prog-modes/postscript.elc
-lisp/prog-modes/prolog.el
-lisp/prog-modes/prolog.elc
-lisp/prog-modes/rexx-mode.el
-lisp/prog-modes/rexx-mode.elc
-lisp/prog-modes/rpm-spec-mode.el
-lisp/prog-modes/rpm-spec-mode.elc
-lisp/prog-modes/simula.el
-lisp/prog-modes/simula.elc
-lisp/prog-modes/sql.el
-lisp/prog-modes/sql.elc
-lisp/prog-modes/tcl.el
-lisp/prog-modes/tcl.elc
-lisp/prog-modes/teco.el
-lisp/prog-modes/teco.elc
-lisp/prog-modes/uil-mode.el
-lisp/prog-modes/uil-mode.elc
-lisp/prog-modes/verilog-mode.el
-lisp/prog-modes/verilog-mode.elc
-lisp/prog-modes/vrml-mode.el
-lisp/prog-modes/vrml-mode.elc
-info/prog-modes.info
-man/prog-modes/prog-modes.texi
diff --git a/xemacs-packages/pkginfo/MANIFEST.python-modes b/xemacs-packages/pkginfo/MANIFEST.python-modes
deleted file mode 100644
index 26764c78..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.python-modes
+++ /dev/null
@@ -1,13 +0,0 @@
-pkginfo/MANIFEST.python-modes
-lisp/python-modes/ChangeLog
-lisp/python-modes/_pkg.el
-lisp/python-modes/auto-autoloads.el
-lisp/python-modes/auto-autoloads.elc
-lisp/python-modes/custom-load.el
-lisp/python-modes/custom-load.elc
-lisp/python-modes/pydoc-el-README
-lisp/python-modes/pydoc.el
-lisp/python-modes/pydoc.elc
-lisp/python-modes/python-mode.el
-lisp/python-modes/python-mode.elc
-etc/python-modes/pydoc_lisp.py
diff --git a/xemacs-packages/pkginfo/MANIFEST.re-builder b/xemacs-packages/pkginfo/MANIFEST.re-builder
deleted file mode 100644
index 775bad55..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.re-builder
+++ /dev/null
@@ -1,11 +0,0 @@
-pkginfo/MANIFEST.re-builder
-lisp/re-builder/ChangeLog
-lisp/re-builder/_pkg.el
-lisp/re-builder/auto-autoloads.el
-lisp/re-builder/auto-autoloads.elc
-lisp/re-builder/custom-load.el
-lisp/re-builder/custom-load.elc
-lisp/re-builder/re-builder.el
-lisp/re-builder/re-builder.elc
-info/re-builder.info
-man/re-builder/re-builder.texi
diff --git a/xemacs-packages/pkginfo/MANIFEST.sh-script b/xemacs-packages/pkginfo/MANIFEST.sh-script
deleted file mode 100644
index f75c263c..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.sh-script
+++ /dev/null
@@ -1,11 +0,0 @@
-pkginfo/MANIFEST.sh-script
-lisp/sh-script/ChangeLog
-lisp/sh-script/_pkg.el
-lisp/sh-script/auto-autoloads.el
-lisp/sh-script/auto-autoloads.elc
-lisp/sh-script/custom-load.el
-lisp/sh-script/custom-load.elc
-lisp/sh-script/executable.el
-lisp/sh-script/executable.elc
-lisp/sh-script/sh-script.el
-lisp/sh-script/sh-script.elc
diff --git a/xemacs-packages/pkginfo/MANIFEST.speedbar b/xemacs-packages/pkginfo/MANIFEST.speedbar
deleted file mode 100644
index 27c96845..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.speedbar
+++ /dev/null
@@ -1,58 +0,0 @@
-pkginfo/MANIFEST.speedbar
-lisp/speedbar/ChangeLog
-lisp/speedbar/_pkg.el
-lisp/speedbar/auto-autoloads.el
-lisp/speedbar/auto-autoloads.elc
-lisp/speedbar/bigclock.el
-lisp/speedbar/bigclock.elc
-lisp/speedbar/custom-load.el
-lisp/speedbar/custom-load.elc
-lisp/speedbar/dframe.el
-lisp/speedbar/dframe.elc
-lisp/speedbar/rpm.el
-lisp/speedbar/rpm.elc
-lisp/speedbar/sb-ant.el
-lisp/speedbar/sb-ant.elc
-lisp/speedbar/sb-box-minus.xpm
-lisp/speedbar/sb-box-plus.xpm
-lisp/speedbar/sb-box.xpm
-lisp/speedbar/sb-chk.xpm
-lisp/speedbar/sb-dir-minus.xpm
-lisp/speedbar/sb-dir-plus.xpm
-lisp/speedbar/sb-dir.xpm
-lisp/speedbar/sb-doc-minus.xpm
-lisp/speedbar/sb-doc-plus.xpm
-lisp/speedbar/sb-doc.xpm
-lisp/speedbar/sb-gud.el
-lisp/speedbar/sb-gud.elc
-lisp/speedbar/sb-html.el
-lisp/speedbar/sb-html.elc
-lisp/speedbar/sb-image.el
-lisp/speedbar/sb-image.elc
-lisp/speedbar/sb-info.el
-lisp/speedbar/sb-info.elc
-lisp/speedbar/sb-info.xpm
-lisp/speedbar/sb-label.xpm
-lisp/speedbar/sb-mail.xpm
-lisp/speedbar/sb-obj.xpm
-lisp/speedbar/sb-objod.xpm
-lisp/speedbar/sb-pg-minus.xpm
-lisp/speedbar/sb-pg-plus.xpm
-lisp/speedbar/sb-pg.xpm
-lisp/speedbar/sb-rmail.el
-lisp/speedbar/sb-rmail.elc
-lisp/speedbar/sb-ro.xpm
-lisp/speedbar/sb-tag-gt.xpm
-lisp/speedbar/sb-tag-minus.xpm
-lisp/speedbar/sb-tag-plus.xpm
-lisp/speedbar/sb-tag-type.xpm
-lisp/speedbar/sb-tag-v.xpm
-lisp/speedbar/sb-tag.xpm
-lisp/speedbar/sb-texinfo.el
-lisp/speedbar/sb-texinfo.elc
-lisp/speedbar/sb-w3.el
-lisp/speedbar/sb-w3.elc
-lisp/speedbar/speedbar.el
-lisp/speedbar/speedbar.elc
-info/speedbar.info
-man/speedbar/speedbar.texi
diff --git a/xemacs-packages/pkginfo/MANIFEST.texinfo b/xemacs-packages/pkginfo/MANIFEST.texinfo
deleted file mode 100644
index 50466ca3..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.texinfo
+++ /dev/null
@@ -1,23 +0,0 @@
-pkginfo/MANIFEST.texinfo
-lisp/texinfo/ChangeLog
-lisp/texinfo/_pkg.el
-lisp/texinfo/auto-autoloads.el
-lisp/texinfo/auto-autoloads.elc
-lisp/texinfo/custom-load.el
-lisp/texinfo/custom-load.elc
-lisp/texinfo/detexinfo.el
-lisp/texinfo/detexinfo.elc
-lisp/texinfo/informat.el
-lisp/texinfo/informat.elc
-lisp/texinfo/makeinfo.el
-lisp/texinfo/makeinfo.elc
-lisp/texinfo/tex-mode.el
-lisp/texinfo/tex-mode.elc
-lisp/texinfo/texinfmt.el
-lisp/texinfo/texinfmt.elc
-lisp/texinfo/texinfo.el
-lisp/texinfo/texinfo.elc
-lisp/texinfo/texnfo-tex.el
-lisp/texinfo/texnfo-tex.elc
-lisp/texinfo/texnfo-upd.el
-lisp/texinfo/texnfo-upd.elc
diff --git a/xemacs-packages/pkginfo/MANIFEST.text-modes b/xemacs-packages/pkginfo/MANIFEST.text-modes
deleted file mode 100644
index 5beb8cfe..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.text-modes
+++ /dev/null
@@ -1,73 +0,0 @@
-pkginfo/MANIFEST.text-modes
-lisp/text-modes/ChangeLog
-lisp/text-modes/_pkg.el
-lisp/text-modes/ansi-color.el
-lisp/text-modes/ansi-color.elc
-lisp/text-modes/apache-mode.el
-lisp/text-modes/apache-mode.elc
-lisp/text-modes/auto-autoloads.el
-lisp/text-modes/auto-autoloads.elc
-lisp/text-modes/autoinsert.el
-lisp/text-modes/autoinsert.elc
-lisp/text-modes/crontab.el
-lisp/text-modes/crontab.elc
-lisp/text-modes/css-mode.el
-lisp/text-modes/css-mode.elc
-lisp/text-modes/custom-load.el
-lisp/text-modes/custom-load.elc
-lisp/text-modes/desktop-entry-mode.el
-lisp/text-modes/desktop-entry-mode.elc
-lisp/text-modes/filladapt.el
-lisp/text-modes/filladapt.elc
-lisp/text-modes/flyspell.el
-lisp/text-modes/flyspell.elc
-lisp/text-modes/folding.el
-lisp/text-modes/folding.elc
-lisp/text-modes/hexl.el
-lisp/text-modes/hexl.elc
-lisp/text-modes/htmlize.el
-lisp/text-modes/htmlize.elc
-lisp/text-modes/image-mode.el
-lisp/text-modes/image-mode.elc
-lisp/text-modes/iso-acc.el
-lisp/text-modes/iso-acc.elc
-lisp/text-modes/iso-ascii.el
-lisp/text-modes/iso-ascii.elc
-lisp/text-modes/iso-cvt.el
-lisp/text-modes/iso-cvt.elc
-lisp/text-modes/iso-insert.el
-lisp/text-modes/iso-insert.elc
-lisp/text-modes/iso-swed.el
-lisp/text-modes/iso-swed.elc
-lisp/text-modes/nroff-mode.el
-lisp/text-modes/nroff-mode.elc
-lisp/text-modes/po-compat.el
-lisp/text-modes/po-compat.elc
-lisp/text-modes/po-mode.el
-lisp/text-modes/po-mode.elc
-lisp/text-modes/rtf-support.el
-lisp/text-modes/rtf-support.elc
-lisp/text-modes/scribe.el
-lisp/text-modes/scribe.elc
-lisp/text-modes/swedish.el
-lisp/text-modes/swedish.elc
-lisp/text-modes/tabify.el
-lisp/text-modes/tabify.elc
-lisp/text-modes/tpum.el
-lisp/text-modes/tpum.elc
-lisp/text-modes/underline.el
-lisp/text-modes/underline.elc
-lisp/text-modes/whitespace-mode.el
-lisp/text-modes/whitespace-mode.elc
-lisp/text-modes/whitespace-visual-mode.el
-lisp/text-modes/whitespace-visual-mode.elc
-lisp/text-modes/whitespace.el
-lisp/text-modes/whitespace.elc
-lisp/text-modes/winmgr-mode.el
-lisp/text-modes/winmgr-mode.elc
-lisp/text-modes/ws-mode.el
-lisp/text-modes/ws-mode.elc
-lisp/text-modes/xpm-mode.el
-lisp/text-modes/xpm-mode.elc
-lisp/text-modes/xrdb-mode.el
-lisp/text-modes/xrdb-mode.elc
diff --git a/xemacs-packages/pkginfo/MANIFEST.tramp b/xemacs-packages/pkginfo/MANIFEST.tramp
deleted file mode 100644
index 20a42c9d..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.tramp
+++ /dev/null
@@ -1,30 +0,0 @@
-pkginfo/MANIFEST.tramp
-lisp/tramp/ChangeLog
-lisp/tramp/ChangeLog.upstream
-lisp/tramp/_pkg.el
-lisp/tramp/auto-autoloads.el
-lisp/tramp/auto-autoloads.elc
-lisp/tramp/custom-load.el
-lisp/tramp/custom-load.elc
-lisp/tramp/tramp-efs.el
-lisp/tramp/tramp-efs.elc
-lisp/tramp/tramp-ftp.el
-lisp/tramp/tramp-ftp.elc
-lisp/tramp/tramp-smb.el
-lisp/tramp/tramp-smb.elc
-lisp/tramp/tramp-util.el
-lisp/tramp/tramp-util.elc
-lisp/tramp/tramp-uu.el
-lisp/tramp/tramp-uu.elc
-lisp/tramp/tramp-vc.el
-lisp/tramp/tramp-vc.elc
-lisp/tramp/tramp.el
-lisp/tramp/tramp.elc
-lisp/tramp/trampcache.el
-lisp/tramp/trampcache.elc
-lisp/tramp/trampver.el
-lisp/tramp/trampver.elc
-info/tramp.info
-info/tramp_ja.info
-man/tramp/tramp.texi
-man/tramp/tramp_ja.texi
diff --git a/xemacs-packages/pkginfo/MANIFEST.xemacs-base b/xemacs-packages/pkginfo/MANIFEST.xemacs-base
deleted file mode 100644
index 66cc1265..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.xemacs-base
+++ /dev/null
@@ -1,92 +0,0 @@
-pkginfo/MANIFEST.xemacs-base
-lisp/xemacs-base/ChangeLog
-lisp/xemacs-base/_pkg.el
-lisp/xemacs-base/add-log.el
-lisp/xemacs-base/add-log.elc
-lisp/xemacs-base/advice.el
-lisp/xemacs-base/advice.elc
-lisp/xemacs-base/annotations.el
-lisp/xemacs-base/annotations.elc
-lisp/xemacs-base/assoc.el
-lisp/xemacs-base/assoc.elc
-lisp/xemacs-base/auto-autoloads.el
-lisp/xemacs-base/auto-autoloads.elc
-lisp/xemacs-base/case-table.el
-lisp/xemacs-base/case-table.elc
-lisp/xemacs-base/chistory.el
-lisp/xemacs-base/chistory.elc
-lisp/xemacs-base/comint-xemacs.el
-lisp/xemacs-base/comint-xemacs.elc
-lisp/xemacs-base/comint.el
-lisp/xemacs-base/comint.elc
-lisp/xemacs-base/compile.el
-lisp/xemacs-base/compile.elc
-lisp/xemacs-base/custom-load.el
-lisp/xemacs-base/custom-load.elc
-lisp/xemacs-base/debug.el
-lisp/xemacs-base/debug.elc
-lisp/xemacs-base/easy-mmode.el
-lisp/xemacs-base/easy-mmode.elc
-lisp/xemacs-base/ebuff-menu.el
-lisp/xemacs-base/ebuff-menu.elc
-lisp/xemacs-base/echistory.el
-lisp/xemacs-base/echistory.elc
-lisp/xemacs-base/edmacro.el
-lisp/xemacs-base/edmacro.elc
-lisp/xemacs-base/ehelp.el
-lisp/xemacs-base/ehelp.elc
-lisp/xemacs-base/electric.el
-lisp/xemacs-base/electric.elc
-lisp/xemacs-base/enriched.el
-lisp/xemacs-base/enriched.elc
-lisp/xemacs-base/env.el
-lisp/xemacs-base/env.elc
-lisp/xemacs-base/facemenu.el
-lisp/xemacs-base/facemenu.elc
-lisp/xemacs-base/ffap.el
-lisp/xemacs-base/ffap.elc
-lisp/xemacs-base/field.el
-lisp/xemacs-base/field.elc
-lisp/xemacs-base/helper.el
-lisp/xemacs-base/helper.elc
-lisp/xemacs-base/imenu.el
-lisp/xemacs-base/imenu.elc
-lisp/xemacs-base/iso-syntax.el
-lisp/xemacs-base/iso-syntax.elc
-lisp/xemacs-base/macros.el
-lisp/xemacs-base/macros.elc
-lisp/xemacs-base/novice.el
-lisp/xemacs-base/novice.elc
-lisp/xemacs-base/outline.el
-lisp/xemacs-base/outline.elc
-lisp/xemacs-base/passwd.el
-lisp/xemacs-base/passwd.elc
-lisp/xemacs-base/pp.el
-lisp/xemacs-base/pp.elc
-lisp/xemacs-base/regexp-opt.el
-lisp/xemacs-base/regexp-opt.elc
-lisp/xemacs-base/regi.el
-lisp/xemacs-base/regi.elc
-lisp/xemacs-base/ring.el
-lisp/xemacs-base/ring.elc
-lisp/xemacs-base/shell.el
-lisp/xemacs-base/shell.elc
-lisp/xemacs-base/skeleton.el
-lisp/xemacs-base/skeleton.elc
-lisp/xemacs-base/sort.el
-lisp/xemacs-base/sort.elc
-lisp/xemacs-base/thing.el
-lisp/xemacs-base/thing.elc
-lisp/xemacs-base/time-stamp.el
-lisp/xemacs-base/time-stamp.elc
-lisp/xemacs-base/timer-funcs.el
-lisp/xemacs-base/timer-funcs.elc
-lisp/xemacs-base/timezone.el
-lisp/xemacs-base/timezone.elc
-lisp/xemacs-base/tq.el
-lisp/xemacs-base/tq.elc
-lisp/xemacs-base/xbm-button.el
-lisp/xemacs-base/xbm-button.elc
-lisp/xemacs-base/xpm-button.el
-lisp/xemacs-base/xpm-button.elc
-etc/./enriched.doc
diff --git a/xemacs-packages/pkginfo/MANIFEST.xemacs-devel b/xemacs-packages/pkginfo/MANIFEST.xemacs-devel
deleted file mode 100644
index 6de8e447..00000000
--- a/xemacs-packages/pkginfo/MANIFEST.xemacs-devel
+++ /dev/null
@@ -1,43 +0,0 @@
-pkginfo/MANIFEST.xemacs-devel
-lisp/xemacs-devel/ChangeLog
-lisp/xemacs-devel/_pkg.el
-lisp/xemacs-devel/auto-autoloads.el
-lisp/xemacs-devel/auto-autoloads.elc
-lisp/xemacs-devel/bench.el
-lisp/xemacs-devel/bench.elc
-lisp/xemacs-devel/checkdoc.el
-lisp/xemacs-devel/checkdoc.elc
-lisp/xemacs-devel/custom-load.el
-lisp/xemacs-devel/custom-load.elc
-lisp/xemacs-devel/docref.el
-lisp/xemacs-devel/docref.elc
-lisp/xemacs-devel/eldoc.el
-lisp/xemacs-devel/eldoc.elc
-lisp/xemacs-devel/elp.el
-lisp/xemacs-devel/elp.elc
-lisp/xemacs-devel/eval-expr.el
-lisp/xemacs-devel/eval-expr.elc
-lisp/xemacs-devel/find-func.el
-lisp/xemacs-devel/find-func.elc
-lisp/xemacs-devel/find-gc.el
-lisp/xemacs-devel/find-gc.elc
-lisp/xemacs-devel/hide-copyleft.el
-lisp/xemacs-devel/hide-copyleft.elc
-lisp/xemacs-devel/ielm.el
-lisp/xemacs-devel/ielm.elc
-lisp/xemacs-devel/lisp-file-db.el
-lisp/xemacs-devel/lisp-file-db.elc
-lisp/xemacs-devel/patch-keywords.el
-lisp/xemacs-devel/patch-keywords.elc
-lisp/xemacs-devel/patcher.el
-lisp/xemacs-devel/patcher.elc
-lisp/xemacs-devel/pretty-print.el
-lisp/xemacs-devel/pretty-print.elc
-lisp/xemacs-devel/profile.el
-lisp/xemacs-devel/profile.elc
-lisp/xemacs-devel/reposition.el
-lisp/xemacs-devel/reposition.elc
-lisp/xemacs-devel/trace.el
-lisp/xemacs-devel/trace.elc
-info/patcher.info
-man/xemacs-devel/patcher.texi
-- 
2.47.3